summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c')
-rw-r--r--Build/source/texk/web2c/AUTHORS27
-rw-r--r--Build/source/texk/web2c/ChangeLog7441
-rw-r--r--Build/source/texk/web2c/INSTALL262
-rw-r--r--Build/source/texk/web2c/Makefile.in1156
-rw-r--r--Build/source/texk/web2c/NEWS398
-rw-r--r--Build/source/texk/web2c/PROJECTS63
-rw-r--r--Build/source/texk/web2c/README31
-rw-r--r--Build/source/texk/web2c/acconfig.h51
-rw-r--r--Build/source/texk/web2c/aleph.rc36
-rw-r--r--Build/source/texk/web2c/alephdir/Makefile74
-rw-r--r--Build/source/texk/web2c/alephdir/aleph.c480
-rw-r--r--Build/source/texk/web2c/alephdir/aleph.defines74
-rw-r--r--Build/source/texk/web2c/alephdir/aleph.mak197
-rw-r--r--Build/source/texk/web2c/alephdir/aleph.mk184
-rw-r--r--Build/source/texk/web2c/alephdir/aleph.version1
-rw-r--r--Build/source/texk/web2c/alephdir/alephbis.c331
-rw-r--r--Build/source/texk/web2c/alephdir/alephextra-rc1.h36
-rw-r--r--Build/source/texk/web2c/alephdir/alephextra-rc2.h37
-rw-r--r--Build/source/texk/web2c/alephdir/alephextra.h37
-rw-r--r--Build/source/texk/web2c/alephdir/alephmem.h129
-rw-r--r--Build/source/texk/web2c/alephdir/ceostuff.ch72
-rw-r--r--Build/source/texk/web2c/alephdir/com-supp-w32.ch26
-rw-r--r--Build/source/texk/web2c/alephdir/com16bit-rc1.ch2507
-rw-r--r--Build/source/texk/web2c/alephdir/com16bit-rc2.ch2755
-rw-r--r--Build/source/texk/web2c/alephdir/comchar.ch20
-rw-r--r--Build/source/texk/web2c/alephdir/comdir.ch20
-rw-r--r--Build/source/texk/web2c/alephdir/comfi.ch20
-rw-r--r--Build/source/texk/web2c/alephdir/comfilter.ch123
-rw-r--r--Build/source/texk/web2c/alephdir/comfont.ch20
-rw-r--r--Build/source/texk/web2c/alephdir/comocp.ch141
-rw-r--r--Build/source/texk/web2c/alephdir/compar.ch20
-rw-r--r--Build/source/texk/web2c/alephdir/comsrcspec.ch346
-rw-r--r--Build/source/texk/web2c/alephdir/comstr.ch20
-rw-r--r--Build/source/texk/web2c/alephdir/comtrans.ch20
-rw-r--r--Build/source/texk/web2c/alephdir/comw32.ch77
-rw-r--r--Build/source/texk/web2c/alephdir/eo16bit-rc1.ch696
-rw-r--r--Build/source/texk/web2c/alephdir/eo16bit-rc2.ch696
-rw-r--r--Build/source/texk/web2c/alephdir/eo16bit-rc3.ch759
-rw-r--r--Build/source/texk/web2c/alephdir/eobase.ch5548
-rw-r--r--Build/source/texk/web2c/alephdir/eochar-rc1.ch0
-rw-r--r--Build/source/texk/web2c/alephdir/eochar-rc2.ch158
-rw-r--r--Build/source/texk/web2c/alephdir/eocprt.ch11
-rw-r--r--Build/source/texk/web2c/alephdir/eoeqtb.ch23
-rw-r--r--Build/source/texk/web2c/alephdir/eoext.ch114
-rw-r--r--Build/source/texk/web2c/alephdir/eofix.ch6
-rw-r--r--Build/source/texk/web2c/alephdir/eofmt.ch6
-rw-r--r--Build/source/texk/web2c/alephdir/eomega.ech53
-rw-r--r--Build/source/texk/web2c/alephdir/eomem-rc1.ch321
-rw-r--r--Build/source/texk/web2c/alephdir/eomem-rc2.ch330
-rw-r--r--Build/source/texk/web2c/alephdir/eomem-rc3.ch498
-rw-r--r--Build/source/texk/web2c/alephdir/eonewdir-rc1.ch0
-rw-r--r--Build/source/texk/web2c/alephdir/eonewdir-rc2.ch52
-rw-r--r--Build/source/texk/web2c/alephdir/eopage-rc1.ch0
-rw-r--r--Build/source/texk/web2c/alephdir/eopage-rc2.ch180
-rw-r--r--Build/source/texk/web2c/alephdir/eover-rc1.ch21
-rw-r--r--Build/source/texk/web2c/alephdir/eover-rc2.ch230
-rw-r--r--Build/source/texk/web2c/alephdir/etex.ch6176
-rw-r--r--Build/source/texk/web2c/alephdir/om16bit.ch2635
-rw-r--r--Build/source/texk/web2c/alephdir/omchar.ch84
-rw-r--r--Build/source/texk/web2c/alephdir/omdir.ch3048
-rw-r--r--Build/source/texk/web2c/alephdir/omega.ch045
-rw-r--r--Build/source/texk/web2c/alephdir/omega.ch1155
-rw-r--r--Build/source/texk/web2c/alephdir/omega.ch283
-rw-r--r--Build/source/texk/web2c/alephdir/omfi.ch246
-rw-r--r--Build/source/texk/web2c/alephdir/omfilter.ch942
-rw-r--r--Build/source/texk/web2c/alephdir/omfont.ch2373
-rw-r--r--Build/source/texk/web2c/alephdir/omocp.ch1068
-rw-r--r--Build/source/texk/web2c/alephdir/ompar.ch798
-rw-r--r--Build/source/texk/web2c/alephdir/omstr.ch875
-rw-r--r--Build/source/texk/web2c/alephdir/omtrans.ch782
-rw-r--r--Build/source/texk/web2c/alephdir/omxml.ch1975
-rw-r--r--Build/source/texk/web2c/bibtex.ch1291
-rw-r--r--Build/source/texk/web2c/bibtex.rc34
-rw-r--r--Build/source/texk/web2c/bibtex.web11652
-rw-r--r--Build/source/texk/web2c/c-auto.in105
-rw-r--r--Build/source/texk/web2c/config.h117
-rwxr-xr-xBuild/source/texk/web2c/configure5117
-rw-r--r--Build/source/texk/web2c/configure.in368
-rw-r--r--Build/source/texk/web2c/cpascal.h277
-rw-r--r--Build/source/texk/web2c/ctangleboot.c1620
-rw-r--r--Build/source/texk/web2c/ctiedir/ChangeLog34
-rw-r--r--Build/source/texk/web2c/ctiedir/Makefile51
-rw-r--r--Build/source/texk/web2c/ctiedir/README75
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie-k.c1166
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie-k.ch461
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.155
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.c1111
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.cf114
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.cf226
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.cf313
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.chf.gen26
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.inc4
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.inc11
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.inc21
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.master.gen19
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.tie16
-rw-r--r--Build/source/texk/web2c/ctiedir/ctie.w1280
-rw-r--r--Build/source/texk/web2c/ctiedir/ctiedoc.tex242
-rw-r--r--Build/source/texk/web2c/cwebboot.c1345
-rw-r--r--Build/source/texk/web2c/cwebdir/Makefile195
-rw-r--r--Build/source/texk/web2c/cwebdir/README98
-rw-r--r--Build/source/texk/web2c/cwebdir/c++lib.w85
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-amiga.ch17
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-bs.ch229
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-mac.ch150
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-man.ch22
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-os2.ch24
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-pc.ch33
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-ql.ch332
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-vms.ch81
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-w2c.ch620
-rw-r--r--Build/source/texk/web2c/cwebdir/comm-w32.ch94
-rw-r--r--Build/source/texk/web2c/cwebdir/common.c1242
-rw-r--r--Build/source/texk/web2c/cwebdir/common.h192
-rw-r--r--Build/source/texk/web2c/cwebdir/common.w1418
-rw-r--r--Build/source/texk/web2c/cwebdir/ctang-bs.ch202
-rw-r--r--Build/source/texk/web2c/cwebdir/ctang-man.ch22
-rw-r--r--Build/source/texk/web2c/cwebdir/ctang-pc.ch24
-rw-r--r--Build/source/texk/web2c/cwebdir/ctang-ql.ch25
-rw-r--r--Build/source/texk/web2c/cwebdir/ctang-vms.ch35
-rw-r--r--Build/source/texk/web2c/cwebdir/ctang-w2c.ch375
-rw-r--r--Build/source/texk/web2c/cwebdir/ctang-w32.ch66
-rw-r--r--Build/source/texk/web2c/cwebdir/ctangle.c1566
-rw-r--r--Build/source/texk/web2c/cwebdir/ctangle.rc34
-rw-r--r--Build/source/texk/web2c/cwebdir/ctangle.w1554
-rw-r--r--Build/source/texk/web2c/cwebdir/cweav-bs.ch302
-rw-r--r--Build/source/texk/web2c/cwebdir/cweav-man.ch22
-rw-r--r--Build/source/texk/web2c/cwebdir/cweav-pc.ch39
-rw-r--r--Build/source/texk/web2c/cwebdir/cweav-ql.ch32
-rw-r--r--Build/source/texk/web2c/cwebdir/cweav-vms.ch37
-rw-r--r--Build/source/texk/web2c/cwebdir/cweav-w2c.ch768
-rw-r--r--Build/source/texk/web2c/cwebdir/cweav-w32.ch52
-rw-r--r--Build/source/texk/web2c/cwebdir/cweave.rc34
-rw-r--r--Build/source/texk/web2c/cwebdir/cweave.w4651
-rw-r--r--Build/source/texk/web2c/cwebdir/cweb.1138
-rw-r--r--Build/source/texk/web2c/cwebdir/cweb.el215
-rw-r--r--Build/source/texk/web2c/cwebdir/cwebmac.tex539
-rw-r--r--Build/source/texk/web2c/cwebdir/cwebman.tex1761
-rw-r--r--Build/source/texk/web2c/cwebdir/depend.mak0
-rw-r--r--Build/source/texk/web2c/cwebdir/makefile.bs60
-rw-r--r--Build/source/texk/web2c/cwebdir/prod.w307
-rw-r--r--Build/source/texk/web2c/cwebdir/readme.ql84
-rw-r--r--Build/source/texk/web2c/depend.mak1244
-rw-r--r--Build/source/texk/web2c/depend.mk1007
-rw-r--r--Build/source/texk/web2c/doc/Makefile.in63
-rw-r--r--Build/source/texk/web2c/doc/README7
-rw-r--r--Build/source/texk/web2c/doc/install.texi347
-rw-r--r--Build/source/texk/web2c/doc/ref.tex29
-rw-r--r--Build/source/texk/web2c/doc/ref.txi130
-rw-r--r--Build/source/texk/web2c/doc/texinfo.bst1256
-rw-r--r--Build/source/texk/web2c/doc/web2c.cps846
-rw-r--r--Build/source/texk/web2c/doc/web2c.info4739
-rw-r--r--Build/source/texk/web2c/doc/web2c.texi4409
-rw-r--r--Build/source/texk/web2c/doc/win32.mak42
-rw-r--r--Build/source/texk/web2c/dvicopy.ch651
-rw-r--r--Build/source/texk/web2c/dvicopy.rc34
-rw-r--r--Build/source/texk/web2c/dvicopy.web4480
-rw-r--r--Build/source/texk/web2c/dvitomp.ch860
-rw-r--r--Build/source/texk/web2c/dvitomp.mk27
-rw-r--r--Build/source/texk/web2c/dvitomp.rc35
-rw-r--r--Build/source/texk/web2c/dvitomp.web1688
-rw-r--r--Build/source/texk/web2c/dvitype.ch695
-rw-r--r--Build/source/texk/web2c/dvitype.rc32
-rw-r--r--Build/source/texk/web2c/dvitype.web2506
-rw-r--r--Build/source/texk/web2c/eomega.rc36
-rw-r--r--Build/source/texk/web2c/eomegadir/eo16bit-rc1.ch696
-rw-r--r--Build/source/texk/web2c/eomegadir/eo16bit-rc2.ch795
-rw-r--r--Build/source/texk/web2c/eomegadir/eobase.ch5542
-rw-r--r--Build/source/texk/web2c/eomegadir/eocprt.ch10
-rw-r--r--Build/source/texk/web2c/eomegadir/eoeqtb.ch23
-rw-r--r--Build/source/texk/web2c/eomegadir/eoext.ch114
-rw-r--r--Build/source/texk/web2c/eomegadir/eofix.ch54
-rw-r--r--Build/source/texk/web2c/eomegadir/eofix2.ch150
-rw-r--r--Build/source/texk/web2c/eomegadir/eofmt.ch35
-rw-r--r--Build/source/texk/web2c/eomegadir/eomega.defines74
-rw-r--r--Build/source/texk/web2c/eomegadir/eomega.ech69
-rw-r--r--Build/source/texk/web2c/eomegadir/eomega.mak193
-rw-r--r--Build/source/texk/web2c/eomegadir/eomega.mk174
-rw-r--r--Build/source/texk/web2c/eomegadir/eomegaextra.h37
-rw-r--r--Build/source/texk/web2c/eomegadir/eomem-rc1.ch321
-rw-r--r--Build/source/texk/web2c/eomegadir/eomem-rc2.ch498
-rw-r--r--Build/source/texk/web2c/eomegadir/eonewdir-rc1.ch0
-rw-r--r--Build/source/texk/web2c/eomegadir/eonewdir-rc2.ch52
-rw-r--r--Build/source/texk/web2c/eomegadir/eover-rc1.ch21
-rw-r--r--Build/source/texk/web2c/eomegadir/eover-rc2.ch173
-rw-r--r--Build/source/texk/web2c/eomegadir/omega.ch045
-rw-r--r--Build/source/texk/web2c/eomegadir/omega.ch1155
-rw-r--r--Build/source/texk/web2c/eomegadir/omega.ch283
-rw-r--r--Build/source/texk/web2c/eomegadir/primitives.tex12
-rw-r--r--Build/source/texk/web2c/etex.rc46
-rw-r--r--Build/source/texk/web2c/etexdir/ChangeLog271
-rw-r--r--Build/source/texk/web2c/etexdir/INSTALL98
-rw-r--r--Build/source/texk/web2c/etexdir/README16
-rw-r--r--Build/source/texk/web2c/etexdir/etex.ch6181
-rw-r--r--Build/source/texk/web2c/etexdir/etex.fix2
-rw-r--r--Build/source/texk/web2c/etexdir/etex.mak242
-rw-r--r--Build/source/texk/web2c/etexdir/etex.mk213
-rw-r--r--Build/source/texk/web2c/etexdir/etex_gen.tex286
-rw-r--r--Build/source/texk/web2c/etexdir/etexextra.in34
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip.diffs356
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip.fot46
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip.log4281
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip.out4
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip.pl833
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip.tex1249
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip.typ20
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip1.in2
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip2.in1
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etrip3.in1
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etripin.log40
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/etripman.tex436
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/texmf.cnf46
-rw-r--r--Build/source/texk/web2c/etexdir/etrip/trip2.in1
-rw-r--r--Build/source/texk/web2c/etexdir/tex.ch022
-rw-r--r--Build/source/texk/web2c/etexdir/tex.ch119
-rw-r--r--Build/source/texk/web2c/etexdir/tex.ech111
-rw-r--r--Build/source/texk/web2c/fmtutil.in133
-rw-r--r--Build/source/texk/web2c/gftodmem.h7
-rw-r--r--Build/source/texk/web2c/gftodvi.ch715
-rw-r--r--Build/source/texk/web2c/gftodvi.rc32
-rw-r--r--Build/source/texk/web2c/gftodvi.web4393
-rw-r--r--Build/source/texk/web2c/gftopk.ch449
-rw-r--r--Build/source/texk/web2c/gftopk.rc32
-rw-r--r--Build/source/texk/web2c/gftopk.web2188
-rw-r--r--Build/source/texk/web2c/gftype.ch380
-rw-r--r--Build/source/texk/web2c/gftype.rc32
-rw-r--r--Build/source/texk/web2c/gftype.web1394
-rw-r--r--Build/source/texk/web2c/help.h443
-rw-r--r--Build/source/texk/web2c/kpathsea.mk7
-rw-r--r--Build/source/texk/web2c/lib/ChangeLog2063
-rw-r--r--Build/source/texk/web2c/lib/Makefile.in32
-rw-r--r--Build/source/texk/web2c/lib/README2
-rw-r--r--Build/source/texk/web2c/lib/alloca.c504
-rw-r--r--Build/source/texk/web2c/lib/basechsuffix.c42
-rw-r--r--Build/source/texk/web2c/lib/chartostring.c22
-rw-r--r--Build/source/texk/web2c/lib/coredump.c58
-rw-r--r--Build/source/texk/web2c/lib/depend.mak355
-rw-r--r--Build/source/texk/web2c/lib/depend.mk140
-rw-r--r--Build/source/texk/web2c/lib/eofeoln.c65
-rw-r--r--Build/source/texk/web2c/lib/fprintreal.c14
-rw-r--r--Build/source/texk/web2c/lib/input2int.c47
-rw-r--r--Build/source/texk/web2c/lib/inputint.c20
-rw-r--r--Build/source/texk/web2c/lib/main.c42
-rw-r--r--Build/source/texk/web2c/lib/mfmpi386.asm144
-rw-r--r--Build/source/texk/web2c/lib/mfmpw32.c189
-rw-r--r--Build/source/texk/web2c/lib/openclose.c251
-rw-r--r--Build/source/texk/web2c/lib/printversion.c58
-rw-r--r--Build/source/texk/web2c/lib/texmfmp.c2250
-rw-r--r--Build/source/texk/web2c/lib/uexit.c20
-rw-r--r--Build/source/texk/web2c/lib/usage.c35
-rw-r--r--Build/source/texk/web2c/lib/version.c6
-rw-r--r--Build/source/texk/web2c/lib/win32.mak62
-rw-r--r--Build/source/texk/web2c/lib/win32main.c30
-rw-r--r--Build/source/texk/web2c/lib/zround.c41
-rw-r--r--Build/source/texk/web2c/man/ChangeLog641
-rw-r--r--Build/source/texk/web2c/man/Makefile.in80
-rw-r--r--Build/source/texk/web2c/man/README260
-rw-r--r--Build/source/texk/web2c/man/amslatex.min108
-rw-r--r--Build/source/texk/web2c/man/amstex.man69
-rw-r--r--Build/source/texk/web2c/man/bibtex.man146
-rw-r--r--Build/source/texk/web2c/man/cweb.man133
-rw-r--r--Build/source/texk/web2c/man/dmp.man60
-rw-r--r--Build/source/texk/web2c/man/dvicopy.man22
-rw-r--r--Build/source/texk/web2c/man/dvitomp.man17
-rw-r--r--Build/source/texk/web2c/man/dvitype.man74
-rw-r--r--Build/source/texk/web2c/man/eplain.man103
-rw-r--r--Build/source/texk/web2c/man/etex.man429
-rw-r--r--Build/source/texk/web2c/man/gftodvi.man167
-rw-r--r--Build/source/texk/web2c/man/gftopk.man103
-rw-r--r--Build/source/texk/web2c/man/gftype.man97
-rw-r--r--Build/source/texk/web2c/man/initex.min147
-rw-r--r--Build/source/texk/web2c/man/lamstex.min67
-rw-r--r--Build/source/texk/web2c/man/latex.man70
-rw-r--r--Build/source/texk/web2c/man/makempx.man89
-rw-r--r--Build/source/texk/web2c/man/mf.man501
-rw-r--r--Build/source/texk/web2c/man/mft.man134
-rw-r--r--Build/source/texk/web2c/man/mpost.man478
-rw-r--r--Build/source/texk/web2c/man/mpto.man68
-rw-r--r--Build/source/texk/web2c/man/newer.man41
-rw-r--r--Build/source/texk/web2c/man/omega.man292
-rw-r--r--Build/source/texk/web2c/man/patgen.man170
-rw-r--r--Build/source/texk/web2c/man/pdfetex.man487
-rw-r--r--Build/source/texk/web2c/man/pdftex.man479
-rw-r--r--Build/source/texk/web2c/man/pdftexman.m4671
-rw-r--r--Build/source/texk/web2c/man/pdfxtex.man481
-rw-r--r--Build/source/texk/web2c/man/pktogf.man103
-rw-r--r--Build/source/texk/web2c/man/pktype.man85
-rw-r--r--Build/source/texk/web2c/man/pltotf.man74
-rw-r--r--Build/source/texk/web2c/man/pooltype.man45
-rw-r--r--Build/source/texk/web2c/man/slitex.min39
-rw-r--r--Build/source/texk/web2c/man/spell.add236
-rw-r--r--Build/source/texk/web2c/man/tangle.man180
-rw-r--r--Build/source/texk/web2c/man/tex.man541
-rw-r--r--Build/source/texk/web2c/man/tftopl.man117
-rw-r--r--Build/source/texk/web2c/man/vftovp.man100
-rw-r--r--Build/source/texk/web2c/man/virtex.min81
-rw-r--r--Build/source/texk/web2c/man/vptovf.man68
-rw-r--r--Build/source/texk/web2c/man/weave.man77
-rw-r--r--Build/source/texk/web2c/man/win32.mak72
-rw-r--r--Build/source/texk/web2c/metapost.mk97
-rw-r--r--Build/source/texk/web2c/mf-supp-w32.ch77
-rw-r--r--Build/source/texk/web2c/mf.ch2251
-rw-r--r--Build/source/texk/web2c/mf.rc37
-rw-r--r--Build/source/texk/web2c/mf.tex34385
-rw-r--r--Build/source/texk/web2c/mf.web23114
-rw-r--r--Build/source/texk/web2c/mft.ch1201
-rw-r--r--Build/source/texk/web2c/mft.rc32
-rw-r--r--Build/source/texk/web2c/mft.web1980
-rw-r--r--Build/source/texk/web2c/mftalk.h43
-rw-r--r--Build/source/texk/web2c/mp-supp-w32.ch77
-rw-r--r--Build/source/texk/web2c/mp.ch2136
-rw-r--r--Build/source/texk/web2c/mp.web23247
-rw-r--r--Build/source/texk/web2c/mpost.rc40
-rw-r--r--Build/source/texk/web2c/mpware/ChangeLog467
-rw-r--r--Build/source/texk/web2c/mpware/Makefile.in62
-rw-r--r--Build/source/texk/web2c/mpware/README6
-rw-r--r--Build/source/texk/web2c/mpware/depend.mak75
-rw-r--r--Build/source/texk/web2c/mpware/depend.mk21
-rw-r--r--Build/source/texk/web2c/mpware/dmp.c1326
-rw-r--r--Build/source/texk/web2c/mpware/dmp.rc34
-rw-r--r--Build/source/texk/web2c/mpware/makempx.in181
-rw-r--r--Build/source/texk/web2c/mpware/mpto.c365
-rw-r--r--Build/source/texk/web2c/mpware/mpto.rc34
-rw-r--r--Build/source/texk/web2c/mpware/newer.c144
-rw-r--r--Build/source/texk/web2c/mpware/win32.mak75
-rw-r--r--Build/source/texk/web2c/omega.rc37
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/README12
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/com-supp-w32.ch26
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/com16bit.ch2482
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comchar.ch20
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comdir.ch20
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comfi.ch20
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comfilter.ch123
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comfont.ch20
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comocp.ch141
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/compar.ch20
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comsrcspec.ch343
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comstr.ch20
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comtrans.ch20
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comw32.ch77
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/comxml.ch20
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/om16bit.ch2635
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omchar.ch84
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omdir.ch3050
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omega.c480
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omega.defines73
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omega.mak272
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omega.mk173
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omega.version1
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omegabis.c298
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omegaextra.h32
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omegamem.h129
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omfi.ch246
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omfilter.ch924
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omfont.ch2373
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omocp.ch1068
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/ompar.ch862
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omstr.ch875
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omtrans.ch782
-rw-r--r--Build/source/texk/web2c/omegadir-1.15/omxml.ch1975
-rw-r--r--Build/source/texk/web2c/omegadir/README12
-rw-r--r--Build/source/texk/web2c/omegadir/com-supp-w32.ch26
-rw-r--r--Build/source/texk/web2c/omegadir/com16bit.ch2749
-rw-r--r--Build/source/texk/web2c/omegadir/comchar.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/comdir.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/comfi.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/comfilter.ch123
-rw-r--r--Build/source/texk/web2c/omegadir/comfont.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/comnode.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/comocp.ch141
-rw-r--r--Build/source/texk/web2c/omegadir/compar.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/comsrcspec.ch345
-rw-r--r--Build/source/texk/web2c/omegadir/comstr.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/comtrans.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/comw32.ch77
-rw-r--r--Build/source/texk/web2c/omegadir/comxml.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/om16bit.ch2828
-rw-r--r--Build/source/texk/web2c/omegadir/omchar.ch84
-rw-r--r--Build/source/texk/web2c/omegadir/omdir.ch4174
-rw-r--r--Build/source/texk/web2c/omegadir/omega.c624
-rw-r--r--Build/source/texk/web2c/omegadir/omega.defines74
-rw-r--r--Build/source/texk/web2c/omegadir/omega.mak270
-rw-r--r--Build/source/texk/web2c/omegadir/omega.mk240
-rw-r--r--Build/source/texk/web2c/omegadir/omega.version1
-rw-r--r--Build/source/texk/web2c/omegadir/omegabis.c339
-rw-r--r--Build/source/texk/web2c/omegadir/omegaextra.h38
-rw-r--r--Build/source/texk/web2c/omegadir/omegamem.h145
-rw-r--r--Build/source/texk/web2c/omegadir/omfi.ch246
-rw-r--r--Build/source/texk/web2c/omegadir/omfilter.ch925
-rw-r--r--Build/source/texk/web2c/omegadir/omfont.ch2373
-rw-r--r--Build/source/texk/web2c/omegadir/omnode.ch20
-rw-r--r--Build/source/texk/web2c/omegadir/omocp.ch1068
-rw-r--r--Build/source/texk/web2c/omegadir/ompar.ch1629
-rw-r--r--Build/source/texk/web2c/omegadir/omstr.ch875
-rw-r--r--Build/source/texk/web2c/omegadir/omtrans.ch822
-rw-r--r--Build/source/texk/web2c/omegadir/omxml.ch2099
-rw-r--r--Build/source/texk/web2c/omegafonts/Makefile.in72
-rw-r--r--Build/source/texk/web2c/omegafonts/char_routines.c901
-rw-r--r--Build/source/texk/web2c/omegafonts/char_routines.h91
-rw-r--r--Build/source/texk/web2c/omegafonts/depend.mak0
-rw-r--r--Build/source/texk/web2c/omegafonts/dimen_routines.c324
-rw-r--r--Build/source/texk/web2c/omegafonts/dimen_routines.h38
-rw-r--r--Build/source/texk/web2c/omegafonts/dvi.h93
-rw-r--r--Build/source/texk/web2c/omegafonts/error_routines.c184
-rw-r--r--Build/source/texk/web2c/omegafonts/error_routines.h47
-rw-r--r--Build/source/texk/web2c/omegafonts/extra_routines.c479
-rw-r--r--Build/source/texk/web2c/omegafonts/extra_routines.h88
-rw-r--r--Build/source/texk/web2c/omegafonts/font_routines.c757
-rw-r--r--Build/source/texk/web2c/omegafonts/font_routines.h98
-rw-r--r--Build/source/texk/web2c/omegafonts/header_routines.c651
-rw-r--r--Build/source/texk/web2c/omegafonts/header_routines.h109
-rw-r--r--Build/source/texk/web2c/omegafonts/lex.yy.c-dist3390
-rw-r--r--Build/source/texk/web2c/omegafonts/ligkern_routines.c576
-rw-r--r--Build/source/texk/web2c/omegafonts/ligkern_routines.h67
-rw-r--r--Build/source/texk/web2c/omegafonts/list_routines.c256
-rw-r--r--Build/source/texk/web2c/omegafonts/list_routines.h104
-rw-r--r--Build/source/texk/web2c/omegafonts/manifests.h280
-rw-r--r--Build/source/texk/web2c/omegafonts/omfonts.c323
-rw-r--r--Build/source/texk/web2c/omegafonts/omfonts.h50
-rw-r--r--Build/source/texk/web2c/omegafonts/out_ofm.c209
-rw-r--r--Build/source/texk/web2c/omegafonts/out_ofm.h36
-rw-r--r--Build/source/texk/web2c/omegafonts/out_routines.c381
-rw-r--r--Build/source/texk/web2c/omegafonts/out_routines.h50
-rw-r--r--Build/source/texk/web2c/omegafonts/param_routines.c154
-rw-r--r--Build/source/texk/web2c/omegafonts/param_routines.h30
-rw-r--r--Build/source/texk/web2c/omegafonts/parse_ofm.c594
-rw-r--r--Build/source/texk/web2c/omegafonts/parse_ofm.h58
-rw-r--r--Build/source/texk/web2c/omegafonts/parser.h35
-rw-r--r--Build/source/texk/web2c/omegafonts/pl.l482
-rw-r--r--Build/source/texk/web2c/omegafonts/pl.y544
-rw-r--r--Build/source/texk/web2c/omegafonts/print_routines.c727
-rw-r--r--Build/source/texk/web2c/omegafonts/print_routines.h105
-rw-r--r--Build/source/texk/web2c/omegafonts/win32.mak81
-rw-r--r--Build/source/texk/web2c/omegafonts/y_tab.c-dist2030
-rw-r--r--Build/source/texk/web2c/omegafonts/y_tab.h-dist214
-rw-r--r--Build/source/texk/web2c/omegaware/ChangeLog0
-rw-r--r--Build/source/texk/web2c/omegaware/odvicopy.ch710
-rw-r--r--Build/source/texk/web2c/omegaware/odvicopy.web4688
-rw-r--r--Build/source/texk/web2c/omegaware/odvitype.ch767
-rw-r--r--Build/source/texk/web2c/omegaware/odvitype.web2594
-rw-r--r--Build/source/texk/web2c/omegaware/ofm2opl.ch461
-rw-r--r--Build/source/texk/web2c/omegaware/ofm2opl.web2322
-rw-r--r--Build/source/texk/web2c/omegaware/opl2ofm.ch337
-rw-r--r--Build/source/texk/web2c/omegaware/opl2ofm.web4363
-rw-r--r--Build/source/texk/web2c/omegaware/otangle.ch474
-rw-r--r--Build/source/texk/web2c/omegaware/otangle.web3328
-rw-r--r--Build/source/texk/web2c/omegaware/ovf2ovp.ch610
-rw-r--r--Build/source/texk/web2c/omegaware/ovf2ovp.web3138
-rw-r--r--Build/source/texk/web2c/omegaware/ovp2ovf.ch320
-rw-r--r--Build/source/texk/web2c/omegaware/ovp2ovf.web5071
-rw-r--r--Build/source/texk/web2c/otangle.rc35
-rw-r--r--Build/source/texk/web2c/otps/ChangeLog21
-rw-r--r--Build/source/texk/web2c/otps/Makefile.in52
-rw-r--r--Build/source/texk/web2c/otps/depend.mak67
-rw-r--r--Build/source/texk/web2c/otps/depend.mk53
-rw-r--r--Build/source/texk/web2c/otps/lex.yy.c-dist1988
-rwxr-xr-xBuild/source/texk/web2c/otps/mkocp6
-rwxr-xr-xBuild/source/texk/web2c/otps/mkofm3
-rw-r--r--Build/source/texk/web2c/otps/otp.h73
-rw-r--r--Build/source/texk/web2c/otps/otp.l129
-rw-r--r--Build/source/texk/web2c/otps/otp.y325
-rw-r--r--Build/source/texk/web2c/otps/otp2ocp.c173
-rw-r--r--Build/source/texk/web2c/otps/outocp.c228
-rw-r--r--Build/source/texk/web2c/otps/routines.c549
-rw-r--r--Build/source/texk/web2c/otps/routines.h148
-rw-r--r--Build/source/texk/web2c/otps/win32.mak70
-rw-r--r--Build/source/texk/web2c/otps/y_tab.c-dist1707
-rw-r--r--Build/source/texk/web2c/otps/y_tab.h-dist82
-rw-r--r--Build/source/texk/web2c/otps/yystype.h31
-rw-r--r--Build/source/texk/web2c/patgen.ch261
-rw-r--r--Build/source/texk/web2c/patgen.rc34
-rw-r--r--Build/source/texk/web2c/patgen.web1978
-rw-r--r--Build/source/texk/web2c/pdfetex.rc42
-rw-r--r--Build/source/texk/web2c/pdfetexdir/ChangeLog69
-rw-r--r--Build/source/texk/web2c/pdfetexdir/Makefile.in3
l---------Build/source/texk/web2c/pdfetexdir/NEWS1
l---------Build/source/texk/web2c/pdfetexdir/README1
-rw-r--r--Build/source/texk/web2c/pdfetexdir/extratime.ch131
-rw-r--r--Build/source/texk/web2c/pdfetexdir/pdfetex.ch182
-rw-r--r--Build/source/texk/web2c/pdfetexdir/pdfetex.ch2242
-rw-r--r--Build/source/texk/web2c/pdfetexdir/pdfetex.defines105
-rw-r--r--Build/source/texk/web2c/pdfetexdir/pdfetex.h50
-rw-r--r--Build/source/texk/web2c/pdfetexdir/pdfetex.mak164
-rw-r--r--Build/source/texk/web2c/pdfetexdir/pdfetex.mk133
-rw-r--r--Build/source/texk/web2c/pdfetexdir/pdfetexextra.in41
-rw-r--r--Build/source/texk/web2c/pdfetexdir/tex.ch042
-rw-r--r--Build/source/texk/web2c/pdfetexdir/tex.ch145
-rw-r--r--Build/source/texk/web2c/pdfetexdir/tex.ch221
-rw-r--r--Build/source/texk/web2c/pdftex.rc41
-rw-r--r--Build/source/texk/web2c/pdftexdir/ChangeLog104
-rw-r--r--Build/source/texk/web2c/pdftexdir/Makefile.in60
-rw-r--r--Build/source/texk/web2c/pdftexdir/NEWS400
-rw-r--r--Build/source/texk/web2c/pdftexdir/README90
-rw-r--r--Build/source/texk/web2c/pdftexdir/avl.c890
-rw-r--r--Build/source/texk/web2c/pdftexdir/avl.h123
-rw-r--r--Build/source/texk/web2c/pdftexdir/avlstuff.c131
-rw-r--r--Build/source/texk/web2c/pdftexdir/avlstuff.h29
-rw-r--r--Build/source/texk/web2c/pdftexdir/change-files.txt132
-rw-r--r--Build/source/texk/web2c/pdftexdir/depend.mak0
-rw-r--r--Build/source/texk/web2c/pdftexdir/depend.mk54
-rw-r--r--Build/source/texk/web2c/pdftexdir/epdf.c75
-rw-r--r--Build/source/texk/web2c/pdftexdir/epdf.h103
-rw-r--r--Build/source/texk/web2c/pdftexdir/hz.ch1935
-rw-r--r--Build/source/texk/web2c/pdftexdir/image.h104
-rw-r--r--Build/source/texk/web2c/pdftexdir/macnames.c312
-rw-r--r--Build/source/texk/web2c/pdftexdir/mapfile.c1150
-rw-r--r--Build/source/texk/web2c/pdftexdir/misc.ch21
-rw-r--r--Build/source/texk/web2c/pdftexdir/noligatures.ch116
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdfstrcmp.ch609
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.ch6853
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.defines105
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.h50
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.mak199
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.mk201
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex2.ch89
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftexextra.in40
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftexlib.mk76
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftoepdf.cc1072
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftosrc.cc130
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftosrc.rc35
-rw-r--r--Build/source/texk/web2c/pdftexdir/pkin.c427
-rw-r--r--Build/source/texk/web2c/pdftexdir/ptexlib.h219
-rw-r--r--Build/source/texk/web2c/pdftexdir/ptexmac.h196
-rw-r--r--Build/source/texk/web2c/pdftexdir/randoms.ch569
-rw-r--r--Build/source/texk/web2c/pdftexdir/tex.ch042
-rw-r--r--Build/source/texk/web2c/pdftexdir/tex.ch139
-rw-r--r--Build/source/texk/web2c/pdftexdir/tex.pch355
-rw-r--r--Build/source/texk/web2c/pdftexdir/ttf2afm.c998
-rw-r--r--Build/source/texk/web2c/pdftexdir/ttf2afm.rc35
-rw-r--r--Build/source/texk/web2c/pdftexdir/utils.c1129
-rw-r--r--Build/source/texk/web2c/pdftexdir/vadjust.ch273
-rw-r--r--Build/source/texk/web2c/pdftexdir/vfpacket.c116
-rw-r--r--Build/source/texk/web2c/pdftexdir/win32.mak71
-rw-r--r--Build/source/texk/web2c/pdftexdir/writeenc.c145
-rw-r--r--Build/source/texk/web2c/pdftexdir/writefont.c318
-rw-r--r--Build/source/texk/web2c/pdftexdir/writeimg.c354
-rw-r--r--Build/source/texk/web2c/pdftexdir/writejpg.c227
-rw-r--r--Build/source/texk/web2c/pdftexdir/writepng.c593
-rw-r--r--Build/source/texk/web2c/pdftexdir/writet1.c1780
-rw-r--r--Build/source/texk/web2c/pdftexdir/writet3.c389
-rw-r--r--Build/source/texk/web2c/pdftexdir/writettf.c1257
-rw-r--r--Build/source/texk/web2c/pdftexdir/writettf.h130
-rw-r--r--Build/source/texk/web2c/pdftexdir/writezip.c82
-rw-r--r--Build/source/texk/web2c/pktogf.ch494
-rw-r--r--Build/source/texk/web2c/pktogf.rc32
-rw-r--r--Build/source/texk/web2c/pktogf.web1727
-rw-r--r--Build/source/texk/web2c/pktype.ch366
-rw-r--r--Build/source/texk/web2c/pktype.rc34
-rw-r--r--Build/source/texk/web2c/pktype.web1158
-rw-r--r--Build/source/texk/web2c/pltotf.ch300
-rw-r--r--Build/source/texk/web2c/pltotf.rc34
-rw-r--r--Build/source/texk/web2c/pltotf.web2514
-rw-r--r--Build/source/texk/web2c/pooltype.ch170
-rw-r--r--Build/source/texk/web2c/pooltype.rc34
-rw-r--r--Build/source/texk/web2c/pooltype.web430
-rw-r--r--Build/source/texk/web2c/stamp-auto.in1
-rw-r--r--Build/source/texk/web2c/stamp-h.in0
-rw-r--r--Build/source/texk/web2c/tangle.ch816
-rw-r--r--Build/source/texk/web2c/tangle.rc34
-rw-r--r--Build/source/texk/web2c/tangle.web3325
-rw-r--r--Build/source/texk/web2c/tangleboot.p902
-rw-r--r--Build/source/texk/web2c/tests/allbib.aux3
-rw-r--r--Build/source/texk/web2c/tests/allbib.tex13
-rw-r--r--Build/source/texk/web2c/tests/apalike.bst1101
-rw-r--r--Build/source/texk/web2c/tests/batch.tex10
-rw-r--r--Build/source/texk/web2c/tests/check.log1685
-rw-r--r--Build/source/texk/web2c/tests/cmr10.600gfbin0 -> 24148 bytes
-rw-r--r--Build/source/texk/web2c/tests/cmr10.pkbin0 -> 11048 bytes
-rw-r--r--Build/source/texk/web2c/tests/cmr10.pl980
-rw-r--r--Build/source/texk/web2c/tests/cmr10.tfmbin0 -> 1296 bytes
-rw-r--r--Build/source/texk/web2c/tests/cmr7.tfmbin0 -> 1300 bytes
-rw-r--r--Build/source/texk/web2c/tests/cmr8.tfmbin0 -> 1292 bytes
-rw-r--r--Build/source/texk/web2c/tests/cmti10.tfmbin0 -> 1480 bytes
-rw-r--r--Build/source/texk/web2c/tests/cmtt10.tfmbin0 -> 768 bytes
-rw-r--r--Build/source/texk/web2c/tests/cmtt8.tfmbin0 -> 768 bytes
-rw-r--r--Build/source/texk/web2c/tests/dict58
-rw-r--r--Build/source/texk/web2c/tests/eight.texbin0 -> 1163 bytes
-rw-r--r--Build/source/texk/web2c/tests/end.tex1
-rw-r--r--Build/source/texk/web2c/tests/exampl.aux45
-rw-r--r--Build/source/texk/web2c/tests/exampl.tex13
-rw-r--r--Build/source/texk/web2c/tests/gray.tfmbin0 -> 704 bytes
-rw-r--r--Build/source/texk/web2c/tests/hello.tex2
-rw-r--r--Build/source/texk/web2c/tests/io.mf23
-rw-r--r--Build/source/texk/web2c/tests/just.texi2
-rw-r--r--Build/source/texk/web2c/tests/label.mp4
-rw-r--r--Build/source/texk/web2c/tests/label.mpx11
-rw-r--r--Build/source/texk/web2c/tests/logo8.tfmbin0 -> 264 bytes
-rw-r--r--Build/source/texk/web2c/tests/longtfm.tex5
-rw-r--r--Build/source/texk/web2c/tests/magic.tex3
-rw-r--r--Build/source/texk/web2c/tests/memtest.tex13
-rw-r--r--Build/source/texk/web2c/tests/mltextst.tex200
-rw-r--r--Build/source/texk/web2c/tests/mptest.mp45
-rw-r--r--Build/source/texk/web2c/tests/mptest.mpx19
-rw-r--r--Build/source/texk/web2c/tests/one.two.mf2
-rw-r--r--Build/source/texk/web2c/tests/one.two.mp2
-rw-r--r--Build/source/texk/web2c/tests/one.two.tex2
-rw-r--r--Build/source/texk/web2c/tests/online.mf5
-rw-r--r--Build/source/texk/web2c/tests/openout.mp12
-rw-r--r--Build/source/texk/web2c/tests/openout.tex5
-rw-r--r--Build/source/texk/web2c/tests/pagenum.dvibin0 -> 408 bytes
-rw-r--r--Build/source/texk/web2c/tests/pagenum.tex11
-rw-r--r--Build/source/texk/web2c/tests/patgen.in16
-rw-r--r--Build/source/texk/web2c/tests/patterns14
-rw-r--r--Build/source/texk/web2c/tests/plain.mft26
-rw-r--r--Build/source/texk/web2c/tests/pplr.dvibin0 -> 10516 bytes
-rw-r--r--Build/source/texk/web2c/tests/pplr.tfmbin0 -> 2004 bytes
-rw-r--r--Build/source/texk/web2c/tests/ptmr.dvibin0 -> 10556 bytes
-rw-r--r--Build/source/texk/web2c/tests/ptmr.tfmbin0 -> 2744 bytes
-rw-r--r--Build/source/texk/web2c/tests/ptmr.vfbin0 -> 1976 bytes
-rw-r--r--Build/source/texk/web2c/tests/ptmr.vpl2621
-rw-r--r--Build/source/texk/web2c/tests/rpsyr.tfmbin0 -> 1408 bytes
-rw-r--r--Build/source/texk/web2c/tests/rptmr.tfmbin0 -> 1280 bytes
-rw-r--r--Build/source/texk/web2c/tests/story.dvibin0 -> 668 bytes
-rw-r--r--Build/source/texk/web2c/tests/testex.err5
-rw-r--r--Build/source/texk/web2c/tests/testex.mp21
-rw-r--r--Build/source/texk/web2c/tests/testex.tex7
-rw-r--r--Build/source/texk/web2c/tests/translate34
-rw-r--r--Build/source/texk/web2c/tests/uno.dos1
-rw-r--r--Build/source/texk/web2c/tests/write18.tex2
-rw-r--r--Build/source/texk/web2c/tests/xampl.bib356
-rw-r--r--Build/source/texk/web2c/tex-supp-w32.ch86
-rw-r--r--Build/source/texk/web2c/tex.ch5808
-rw-r--r--Build/source/texk/web2c/tex.rc37
-rw-r--r--Build/source/texk/web2c/tex.web24970
-rw-r--r--Build/source/texk/web2c/texmfmem.h250
-rw-r--r--Build/source/texk/web2c/texmfmp-help.h509
-rw-r--r--Build/source/texk/web2c/texmfmp.h286
-rw-r--r--Build/source/texk/web2c/tftopl.ch439
-rw-r--r--Build/source/texk/web2c/tftopl.rc34
-rw-r--r--Build/source/texk/web2c/tftopl.web1591
-rw-r--r--Build/source/texk/web2c/tiedir/MANIFEST21
-rw-r--r--Build/source/texk/web2c/tiedir/Makefile.cweb38
-rw-r--r--Build/source/texk/web2c/tiedir/README58
-rw-r--r--Build/source/texk/web2c/tiedir/tie-w2c.ch109
-rw-r--r--Build/source/texk/web2c/tiedir/tie.139
-rw-r--r--Build/source/texk/web2c/tiedir/tie.1.dvibin0 -> 1804 bytes
-rw-r--r--Build/source/texk/web2c/tiedir/tie.1.nroffed66
-rw-r--r--Build/source/texk/web2c/tiedir/tie.c920
-rw-r--r--Build/source/texk/web2c/tiedir/tie.cf114
-rw-r--r--Build/source/texk/web2c/tiedir/tie.cf219
-rw-r--r--Build/source/texk/web2c/tiedir/tie.cf35
-rw-r--r--Build/source/texk/web2c/tiedir/tie.chf.gen19
-rw-r--r--Build/source/texk/web2c/tiedir/tie.master.gen14
-rw-r--r--Build/source/texk/web2c/tiedir/tie.rc34
-rw-r--r--Build/source/texk/web2c/tiedir/tie.tie15
-rw-r--r--Build/source/texk/web2c/tiedir/tie.w1297
-rw-r--r--Build/source/texk/web2c/tiedir/tiedoc.tex176
-rw-r--r--Build/source/texk/web2c/triptrap/README96
-rw-r--r--Build/source/texk/web2c/triptrap/mftrap.diffs100
-rw-r--r--Build/source/texk/web2c/triptrap/mftrap.fot59
-rw-r--r--Build/source/texk/web2c/triptrap/mftrap.log4266
-rw-r--r--Build/source/texk/web2c/triptrap/mftrap.pl490
-rw-r--r--Build/source/texk/web2c/triptrap/mftrap1.in3
-rw-r--r--Build/source/texk/web2c/triptrap/mftrap2.in1
-rw-r--r--Build/source/texk/web2c/triptrap/mftrapin.log179
-rw-r--r--Build/source/texk/web2c/triptrap/mptrap.diffs621
-rw-r--r--Build/source/texk/web2c/triptrap/mptrap.fot82
-rw-r--r--Build/source/texk/web2c/triptrap/mptrap.log4755
-rw-r--r--Build/source/texk/web2c/triptrap/mptrap.pl520
-rw-r--r--Build/source/texk/web2c/triptrap/mptrap.readme50
-rw-r--r--Build/source/texk/web2c/triptrap/mptrap1.in3
-rw-r--r--Build/source/texk/web2c/triptrap/mptrap2.in2
-rw-r--r--Build/source/texk/web2c/triptrap/mptrapin.log198
-rw-r--r--Build/source/texk/web2c/triptrap/mtrap.035
-rw-r--r--Build/source/texk/web2c/triptrap/mtrap.139
-rw-r--r--Build/source/texk/web2c/triptrap/mtrap.log1108
-rw-r--r--Build/source/texk/web2c/triptrap/mtrap.mp202
-rw-r--r--Build/source/texk/web2c/triptrap/texmf.cnf91
-rw-r--r--Build/source/texk/web2c/triptrap/trap.14825
-rw-r--r--Build/source/texk/web2c/triptrap/trap.14985
-rw-r--r--Build/source/texk/web2c/triptrap/trap.15043
-rw-r--r--Build/source/texk/web2c/triptrap/trap.151219
-rw-r--r--Build/source/texk/web2c/triptrap/trap.19714
-rw-r--r--Build/source/texk/web2c/triptrap/trap.20058
-rw-r--r--Build/source/texk/web2c/triptrap/trap.521
-rw-r--r--Build/source/texk/web2c/triptrap/trap.614
-rw-r--r--Build/source/texk/web2c/triptrap/trap.mf170
-rw-r--r--Build/source/texk/web2c/triptrap/trap.mp215
-rw-r--r--Build/source/texk/web2c/triptrap/trap.mpx27
-rw-r--r--Build/source/texk/web2c/triptrap/trap.typ210
-rw-r--r--Build/source/texk/web2c/triptrap/trapf.pl105
-rw-r--r--Build/source/texk/web2c/triptrap/trapman.tex400
-rw-r--r--Build/source/texk/web2c/triptrap/trip.diffs147
-rw-r--r--Build/source/texk/web2c/triptrap/trip.fot83
-rw-r--r--Build/source/texk/web2c/triptrap/trip.log7295
-rw-r--r--Build/source/texk/web2c/triptrap/trip.pl833
-rw-r--r--Build/source/texk/web2c/triptrap/trip.tex448
-rw-r--r--Build/source/texk/web2c/triptrap/trip.typ1215
-rw-r--r--Build/source/texk/web2c/triptrap/trip1.in2
-rw-r--r--Build/source/texk/web2c/triptrap/trip2.in1
-rw-r--r--Build/source/texk/web2c/triptrap/tripin.log465
-rw-r--r--Build/source/texk/web2c/triptrap/tripman.tex413
-rw-r--r--Build/source/texk/web2c/triptrap/tripos.tex3
-rw-r--r--Build/source/texk/web2c/triptrap/writeo1
-rw-r--r--Build/source/texk/web2c/triptrap/writeo.210
-rw-r--r--Build/source/texk/web2c/vftovp.ch654
-rw-r--r--Build/source/texk/web2c/vftovp.rc34
-rw-r--r--Build/source/texk/web2c/vftovp.web2368
-rw-r--r--Build/source/texk/web2c/vptovf.ch301
-rw-r--r--Build/source/texk/web2c/vptovf.rc34
-rw-r--r--Build/source/texk/web2c/vptovf.web3177
-rw-r--r--Build/source/texk/web2c/weave.ch430
-rw-r--r--Build/source/texk/web2c/weave.rc34
-rw-r--r--Build/source/texk/web2c/weave.web4904
-rw-r--r--Build/source/texk/web2c/web2c/ChangeLog1108
-rw-r--r--Build/source/texk/web2c/web2c/Makefile.in71
-rw-r--r--Build/source/texk/web2c/web2c/README18
-rw-r--r--Build/source/texk/web2c/web2c/coerce.h54
-rw-r--r--Build/source/texk/web2c/web2c/common.defines208
-rwxr-xr-xBuild/source/texk/web2c/web2c/convert116
-rw-r--r--Build/source/texk/web2c/web2c/convert.bat77
-rw-r--r--Build/source/texk/web2c/web2c/cvtbib.sed12
-rw-r--r--Build/source/texk/web2c/web2c/cvtmf1.sed9
-rw-r--r--Build/source/texk/web2c/web2c/cvtmf2.sed6
-rw-r--r--Build/source/texk/web2c/web2c/depend.mak133
-rw-r--r--Build/source/texk/web2c/web2c/depend.mk70
-rw-r--r--Build/source/texk/web2c/web2c/fixwrites.c450
-rw-r--r--Build/source/texk/web2c/web2c/kps.c78
-rw-r--r--Build/source/texk/web2c/web2c/lex.yy.c-dist2492
-rw-r--r--Build/source/texk/web2c/web2c/main.c273
-rw-r--r--Build/source/texk/web2c/web2c/mfmp.defines5
-rw-r--r--Build/source/texk/web2c/web2c/regfix.c133
-rw-r--r--Build/source/texk/web2c/web2c/splitup.c215
-rw-r--r--Build/source/texk/web2c/web2c/texmf.defines87
-rw-r--r--Build/source/texk/web2c/web2c/web2c.h72
-rw-r--r--Build/source/texk/web2c/web2c/web2c.l321
-rw-r--r--Build/source/texk/web2c/web2c/web2c.rc34
-rw-r--r--Build/source/texk/web2c/web2c/web2c.y1405
-rw-r--r--Build/source/texk/web2c/web2c/win32.mak99
-rw-r--r--Build/source/texk/web2c/web2c/y_tab.c-dist3530
-rw-r--r--Build/source/texk/web2c/web2c/y_tab.h-dist160
-rw-r--r--Build/source/texk/web2c/win32.mak1259
-rw-r--r--Build/source/texk/web2c/window/ChangeLog313
-rw-r--r--Build/source/texk/web2c/window/Makefile.in37
-rw-r--r--Build/source/texk/web2c/window/README2
-rw-r--r--Build/source/texk/web2c/window/amiga.c363
-rw-r--r--Build/source/texk/web2c/window/depend.mak0
-rw-r--r--Build/source/texk/web2c/window/depend.mk182
-rw-r--r--Build/source/texk/web2c/window/epsf.c176
-rw-r--r--Build/source/texk/web2c/window/hp2627.c252
-rw-r--r--Build/source/texk/web2c/window/mftalk.c273
-rw-r--r--Build/source/texk/web2c/window/next.c177
-rw-r--r--Build/source/texk/web2c/window/regis.c105
-rw-r--r--Build/source/texk/web2c/window/suntools.c214
-rw-r--r--Build/source/texk/web2c/window/tek.c143
-rw-r--r--Build/source/texk/web2c/window/trap.c50
-rw-r--r--Build/source/texk/web2c/window/uniterm.c184
-rw-r--r--Build/source/texk/web2c/window/win32.c415
-rw-r--r--Build/source/texk/web2c/window/win32.mak48
-rw-r--r--Build/source/texk/web2c/window/x11-Xlib.c280
-rw-r--r--Build/source/texk/web2c/window/x11-Xt.c370
-rw-r--r--Build/source/texk/web2c/withenable.ac152
752 files changed, 489169 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/AUTHORS b/Build/source/texk/web2c/AUTHORS
new file mode 100644
index 00000000000..4048947993c
--- /dev/null
+++ b/Build/source/texk/web2c/AUTHORS
@@ -0,0 +1,27 @@
+Donald Knuth conceived and implemented TeX, Metafont, and WEB.
+John Hobby wrote MetaPost (partially derived from Metafont) and dvitomp.
+Peter Breitenlohner wrote dvicopy.
+Tomas Rokicki wrote gftopk, pktogf, and pktype.
+Frank Liang wrote patgen version 1, and Peter Breitenlohner did patgen 2.
+Oren Patashnik wrote BibTeX.
+Michael Ferguson and Bernd Raichle wrote the MLTeX extensions.
+Ignacio Zabala implemented DOC, the prototype for WEB.
+
+Howard Trickey and Pavel Curtis initially ported TeX and related
+ programs to Unix.
+Paul Richards initially ported Metafont.
+Pierre MacKay initially ported the MFware programs.
+Richard Furuta initially ported some of the TeXware programs.
+Ulrik Vieth initially adapted MetaPost to Kpathsea.
+
+Tomas Rokicki wrote the original TeX to C program.
+Tim Morgan made most of the subsequent changes.
+
+Dozens of other people have contributed to porting, bug fixes, and other
+improvements. (The names are recorded in the ChangeLogs to the best of
+my knowledgement. Do not hesitate to contact me with corrections.)
+
+Karl Berry <kb@mail.tug.org> maintained the distribution for several
+years. Version 7.0 was the last to be released by him.
+
+Olaf Weber <olaf@infovore.xs4all.nl> is the current maintainer.
diff --git a/Build/source/texk/web2c/ChangeLog b/Build/source/texk/web2c/ChangeLog
new file mode 100644
index 00000000000..8571a64a2e9
--- /dev/null
+++ b/Build/source/texk/web2c/ChangeLog
@@ -0,0 +1,7441 @@
+2005-09-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch [53.1370]: Since we generate a string in all cases, we
+ need to erase it in all cases. Reported by Han The Thanh
+ <hanthethanh@gmail.com>, diagnosed by Akira Kakuto
+ <kakuto@fsci.fuk.kindai.ac.jp>.
+
+2005-08-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * bibtex.ch: Make the buffer and related arrays grow dynamically.
+ Fixes a bug reported by Kevin Cahill <cahill@unm.edu>.
+
+2005-08-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: An \immediate\write18 on the '**' prompt would crash
+ TeX, because the log file isn't open yet. Reported by Jerzy
+ B. Ludwichowski <Jerzy.Ludwichowski@uni.torun.pl>. Since we
+ always log something for \write18, so lets also log the command
+ when \write18 is disabled, instead of merely showing that
+ something was attempted.
+
+2005-08-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Fix missing double-quote.
+
+ * texmfmp-help.h [Aleph,eTeX,pdfeTeX]: Document -etex switch.
+
+ * doc/web2c.texi: Correct missing entries in a table.
+
+2005-07-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: libkpathsea is entirely in LGPL.
+
+ * vftovp.ch: Remove misplaced semicolon.
+
+ * texmfmp.h: Disable IPC when compiling with __DJGPP__. (Should
+ really be done in configure script.)
+
+ * texmfmp.h: Remove references to pdfxtex. Add
+ get_seconds_and_micros prototype.
+
+2005-07-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * weave.ch: Increase max_bytes to 65530. We're bumping to the
+ 16-bit limits here.
+
+ * tex.ch: Significantly increase the ssup_trie_size.
+
+ * metapost.mk: Fix build rules/dependencies for mpware.
+
+ * Makefile.in: Fix build rules for mpware.
+
+ * vftovp.ch: Report the name of tfm files that we cannot find or
+ find to be unusable. Reported by Patrick Gundlach.
+
+2005-06-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * withenable.ac: Remove one pair of brackets from
+ --with-editor-CMD help text.
+
+2005-06-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/Makefile.in: Replace ac_include with kpse_include. From
+ Peter Breitenlohner.
+
+ * withenable.ac: Fully quote arguments of AC_AG_WITH. From Peter
+ Breitenlohner.
+
+ * configure.in: Syntax changes to match autoconf2.5x. From Peter
+ Breitenlohner. To version 7.5.5.
+
+ * Makefile.in: Change ac_include to kpse_include. From Peter
+ Breitenlohner.
+
+2005-06-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.web: Update for MetaPost 0.901.
+
+ * mp.ch: Update for MetaPost 0.901.
+
+ * cpascal.h: Add xreallocarray(). Requested by Hartmut Henkel
+ <hartmut_henkel@gmx.de>.
+
+2005-06-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * metapost.mk, dvitomp.mk, Makefile.in: Break out the metapost and
+ dvitomp related makefile rules into separate makefile fragments.
+
+ * doc/web2c.texi: Update description of newer.
+
+2005-04-12 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mf.ch [38.788]: Use |get_job_name| so the --jobname switch can
+ be used to replace "mfput".
+ [38.793]: Interface of |get_job_name| changed.
+ * mp.ch [35.765]: Use |get_job_name| so the --jobname switch can
+ be used to replace "mpout".
+ [35.770]: Interface of |get_job_name| changed.
+ * tex.ch [29.534]: Use |get_job_name| so the --jobname switch can
+ be used to replace "texput".
+ [29.537]: Interface to |get_job_name| changed.
+ This is part of a group of changes that fixes pdftex bug 302.
+ http://sarovar.org/tracker/?func=detail&atid=493&aid=302&group_id=106
+
+2005-02-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (aleph-dist): Remove generated file, make sure
+ aleph.version file exists.
+
+2005-02-05 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (uninstall, uninstall-exec, uninstall-data): Dummy
+ target added so make uninstall doesn't stop here.
+
+2005-01-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/Makefile.in: Change POSTINSTALL to POST_INSTALL.
+
+ * tiedir/tie.1: Man page corrections from Eric S. Raymond
+ <esr@thyrsus.com>.
+
+2005-01-08 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Correct check whether otangle is needed. From
+ Kenta MURATA <muraken20@yahoo.co.jp>.
+
+ * withenable.ac: Update references to e-Omega to Aleph. From
+ Kenta MURATA <muraken20@yahoo.co.jp>.
+
+2004-12-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Version 7.5.4.
+
+ * doc/web2c.texi: Version 7.5.4.
+
+ * tex.ch: Shuffle the \eof18 code around a bit.
+
+2004-12-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch [16.211,46.1049]: I18N fix for |print_mode|, adding
+ |print_in_mode| function to account for differences in declination
+ etc. After Wlodzimierz Bzyl <matwb@univ.gda.pl>.
+
+ * mf.ch [28.585]: Sufficiently pathological code can overflow the
+ serial_no counter: add a check for this. From Thorsten Dahlheimer
+ <tdahlheim@gmx.net>.
+
+ * mp.ch [24.539]: Sufficiently pathological code can overflow the
+ serial_no counter: add a check for this. From Thorsten Dahlheimer
+ <tdahlheim@gmx.net>.
+
+ * tex.ch: Implement \ifeof18 to test whether \write18 is enabled.
+ A variant of the code submitted by Heiko Oberdiek
+ <oberdiek@uni-freiburg.de>.
+
+2004-12-20 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * withenable.ac: Don't define IPC in c-auto.h if --enable-ipc
+ wasn't given.
+
+ * Makefile.in: configure depends on withenable.ac.
+
+2004-12-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Old versions of flex don't support -l, but don't
+ support --version either, so use the latter to test whether the
+ former should be used. From Thomas.
+
+ * withenable.ac: Add --with-mf-x-toolkit option to replace
+ --with-x-toolkit. The latter couldn't be shared between mf and
+ xdvi any more.
+
+ * Makefile.in (tex-check, bibtex-check, dvicopy-check,
+ dvitomp-check, mpost-check): Add TEXMFCNF=../kpathsea to the
+ environment so the check works even if installation is not yet
+ complete. From Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+ * Makefile.in (install-data): Don't install cwebdir/cweb.1; this
+ page now lives under .../man.
+
+ * Makefile.in (tangle.p): Depend on tangleboot, not $(TANGLEBOOT).
+ This means we build tangleboot even when cross-compiling. The
+ reason is that some versions of make get confused if we depend on
+ ./tangleboot but only have rules with tangleboot as the target.
+ (ctangle.c,cweb.c): As above for $(CTANGLEBOOT).
+ Problem reported for Digital UNIX 4.0E make by Bernhard Simon
+ <simon@zid.tuwien.ac.at>.
+
+2004-11-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (afmts): alambda -> lamed. Restrict the use of FF
+ to comments, as some make implementations cannot deal with it
+ otherwise.
+
+2004-09-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Changes made by Karl Berry.
+
+2004-08-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dvitomp.ch: A more complete implementation of the color stack.
+ Slight modification of code provided by Eddie Kohler
+ <kohler@cs.ucla.edu>.
+
+2004-08-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Document -output-directory.
+
+ * doc/install.texi: Correct cross-references for building formats.
+
+ * cpascal.h (output_directory): Added global variable.
+
+ * triptrap/texmf.cnf: Correct settings for main_memory.
+
+ * texmfmp-help.h: Add -output-directory to the help texts.
+
+ * dvitomp.ch: Allow for a variable number of spaces between the
+ 'color push' special name and its argument. From Eddie Kohler
+ <kohler@cs.ucla.edu>.
+
+2004-08-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Create etexdir in build tree if we're compiling
+ e-TeX.
+
+2004-08-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.ch, mf.ch, tex.ch: |main_memory| is a size, while |mem_top|
+ is an index, so we need to subtract 1 when deriving |mem_top| from
+ |main_memory|. In a similar vein, we need to add 1 when
+ allocating the |mem| array. This may seem like nitpicking, but
+ matters for the trip and trap tests.
+
+2004-08-26 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * Makefile.in (patgen-check): Provide non-trivial test data.
+
+ * tests/dict, tests/patgen.in, tests/patterns, tests/translate:
+ Input data for patgen-check.
+
+ * tests/patout, tests/pattmp.4: New files.
+ Output from patgen-check.
+
+2004-08-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * patgen.ch: Typo fixed by Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+ * patgen.web: Typo fixed by Peter Breitenlohner
+ <peb@mppmu.mpg.de>. (New version 2.3, August 2004).
+
+ * Makefile.in (etex-dist,pdftex-dist): Account for etex.version
+ and pdftex.version as generated files.
+
+2004-08-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch [23.328]: Ensure that |source_filename_stack|[|in_open|]
+ and |full_source_filename_stack|[|in_open|] are initialized.
+
+ * tex.ch: Revise the file:line:error code to produce the correct
+ filename in the presence of \scantokens (an e-TeX extension). If
+ we're not reading from a file at all, fall back on the TeX-style
+ messages. This change introduces |print_file_line| to keep the
+ amount of code in the |print_err| macro under control.
+
+2004-08-23 Karl Berry <karl@tug.org>.
+
+ * doc/web2c.texi: An extensive update.
+
+2004-08-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * config.h: Clean the define of TEXDLL up. From Jan Nieuwenhuizen
+ <janneke@gnu.org>.
+
+2004-08-05 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch [29.530] prompt_file_name: don't allow the use of the
+ empty string for a file name. After Taco Hoekwater
+ <taco@elvenkind.com>.
+
+ * mf.ch [38.786] prompt_file_name: don't allow the use of the
+ empty string for a file name.
+
+ * mp.ch [35.763] prompt_file_name: don't allow the use of the
+ empty string for a file name.
+
+2004-08-01 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (post-dist-$(distname)): Ensure that
+ texk/web2c/tests/xampl.bib is actually in the distributed tarball.
+ (bibtex-check): BIBINPUTS should only need $(srcdir)/tests.
+
+2004-07-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Undo changes from --option to -option. This
+ generated too many differences with the TeX-live sources at this
+ time.
+
+2004-07-23 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * tex.ch: Reorganize handling of banner string in order to
+ reduce interference between eTeX, pdfTeX, and web2c change
+ files.
+
+2004-07-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Use singe dash for -ini, -progname etc. Use
+ explicit -ini and -progname when running the trip test, because
+ the argv[0] name becomes lt-tex when using shared libraries, and
+ we have settings in triptrap/texmf.cnf that are sensitive to this.
+
+ * Makefile.in (bibtex-check): Add BIBINPUTS or check can fail.
+
+2004-07-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Reorganize handling of integer parameters in order to
+ reduce interference between eTeX, pdfTeX, and web2c change files.
+ From Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+ * fmtutil.in: Update from Thomas.
+
+2004-07-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mf.ch [42.912]: Remove this simplification of the web code,
+ which is no longer a valid assumption now that we're back to the
+ old print system.
+
+ * mp.ch: A smaller set of changes than for mf.ch, as in version
+ 0.64 the |print|, |print_char|, |print_visible_char| system
+ previously implemented in the mp.ch change file was merged into
+ mp.web. Remove a reference to |slow_print| that was overlooked
+ earlier.
+
+ * mf.ch: Extensive changes to the print routines, to mirror what
+ was done for tex.ch (q.v.).
+
+ * tex.ch: Extensive changes to fix a problem with the encTeX
+ merge. Original TeX used |slow_print|, |print|, and |print_char|
+ for printing. This had been changed to |print|, |print_char|, and
+ |print_visible_char|, where the new |print_char| did the expansion
+ of unprintable characters to "escaped sequences" on the fly.
+ encTeX, it turns out, is too tightly interwoven with the old way
+ of doing things, leading to some strange breakage. So we've
+ largely reverted the code. In particular, we now store the
+ "escaped sequences" for non-ASCII characters again as strings, and
+ later decide on-the-fly whether to use those or just pass through.
+ This simplifies the change file, and narrows the distance to the
+ encTeX code.
+
+ * texmfmp.h (setupcharset): Removed.
+ (readtcxfile): Added. Unlike setupcharset, this function doesn't
+ initialize the xchr/xord/xprn arrays, it just updates them from a
+ tcx file. The name of the must be in the global
+ translate_filename.
+
+ * config.h: Add second argument to call of usagehelp. This is the
+ email address for bug reports. If NULL, the default address for
+ web2c is used.
+
+ * bibtex.ch: Add second argument to call of usagehelp.
+
+ * dvicopy.ch: Add second argument to call of usagehelp.
+
+ * dvitomp.ch: Add second argument to call of usagehelp.
+
+ * dvitype.ch: Add second argument to call of usagehelp.
+
+ * gftodvi.ch: Add second argument to call of usagehelp.
+
+ * gftopk.ch: Add second argument to call of usagehelp.
+
+ * gftype.ch: Add second argument to call of usagehelp.
+
+ * mft.ch: Add second argument to call of usagehelp.
+
+ * patgen.ch: Add second argument to call of usagehelp.
+
+ * pktogf.ch: Add second argument to call of usagehelp.
+
+ * pktype.ch: Add second argument to call of usagehelp.
+
+ * pltotf.ch: Add second argument to call of usagehelp.
+
+ * pooltype.ch: Add second argument to call of usagehelp.
+
+ * tangle.ch: Add second argument to call of usagehelp.
+
+ * tftopl.ch: Add second argument to call of usagehelp.
+
+ * vptovf.ch: Add second argument to call of usagehelp.
+
+ * vftovp.ch: Add second argument to call of usagehelp.
+
+ * weave.ch: Add second argument to call of usagehelp.
+
+ * cwebdir/comm-w2c.ch: Add second argument to call of usagehelp.
+
+2004-07-12 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp-help.h: Correct help strings of pdf*tex family. From
+ Akira Kakuto <kakuto@fsci.fuk.kindai.ac.jp>.
+
+2004-07-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Move the creation of the format-related links to
+ format-related install rules; this seems to be a better place for
+ them, as the links are pointless without the corresponding
+ formats. Make the install-*-pool rules depend on the pool file in
+ question. Remove TEXMF=$(texmf) from the dumpenv; the
+ TEXMFCNF=../kpathsea should get us a texmf.cnf with suitable
+ absolute paths.
+
+ * tex.ch: Correct date in encTeX_banner.
+
+2004-07-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: No m4 quoting needed in the KPSE_CROSS_BUILD_VAR
+ calls. The default of $BUILDLDFLAGS must be $BUILDXLDFLAGS.
+
+ * Makefile.in (web2c/fixwrites,web2c/spitup,web2c/web2c): These
+ also depend on web2c/kps.c.
+ [TANGLEBOOT,CTANGLEBOOT,TANGLE,CTANGLE,OTANGLE,TIE]: Add these
+ variabled so the build can use programs other than what is built.
+ Used when cross-compiling.
+
+ * configure.in: Add KPSE_CROSS_BUILD_VAR and KPSE_CROSS_PATH_PROG
+ invocations to set up cross-compiling. To cross-compile, you need
+ to have tangle, ctangle, otangle, and tie available on the build
+ machine.
+
+ * weave.ch: Set |max_names| to 10220, so we can still (barely)
+ handle pdfetex. Clearly a larger reworking is on the horizon.
+
+ * tex.ch: Change |mubyte_incs| into a boolean.
+
+2004-07-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Update to encTeX from Petr Olsak. These fix three bugs.
+ These bugs are seen only in encTeX mode when \mubytein=1 and in
+ very rare cases. Petr's explanation follows:
+
+ 1) If the control sequence is converted by \mubyte table but it is
+ not shrunk then the non-converted alternative of control sequence
+ is really used. It can be possible only if one-byte to one-byte
+ conversion is used and declared by \mubyte primitive. More common
+ is to use \mubyte for multi-byte to one-byte conversion. In such
+ situation, there is no problem because control sequence is
+ schrunk. Thanks to Wlodzimierz Bzyl for bugreport.
+
+ \def\aXb{xx}
+ \mubyte X Y\endmubyte
+ \mubytein=1
+ \aYb % writes "undefined control sequence \aXb" because
+ % error message is converted but real control sequence
+ % is not converted and \aYb is undefined.
+
+ 2) If multi-byte to one-byte conversion is done during scanning of
+ control sequence name with the result: one-letter control
+ sequence, then this control sequence is not connected with
+ "native" one-letter control sequence but the new "multi-letter
+ control sequence" is allocated with only one letter in real.
+
+ \def\X{xx} % one-letter control sequence is defined
+ \mubyte X YZ\endmubyte
+ \mubytein=1
+ \YZ % writes "undefined control sequence \X" because \YZ is
+ % converted to \X but allocated as multi-letter control
+ % sequence, but one-letter control sequence is defined
+
+ 3) If \catcode`\^^@=11 or 7 and if control sequence is terminated
+ by generated control sequence (from \mubyte conversion) then the
+ result of reading is unpredictable.
+
+ \def\XXX{xx}
+ \mubyte \XXX YZ\endmubyte
+ \mubytein=1 \relaxYZ % it is OK: \relax followed by \XXX
+ \par\catcode`\^^@=11
+ \relaxYZ % bad reading: \relaxYZ control sequence not defined
+
+2004-06-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Updates to make conversion to HTML easier, from
+ Karl Berry.
+
+2004-06-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/install.texi: Remove reference to --enable-auto-core. That
+ part of the code should be considered terminally broken.
+
+2004-06-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: If the end-of-line character was disabled, we'd end up
+ dropping the last characters of filenames. Fixed by checking for
+ end-of-line only if we've just seen a space, which could be the
+ end-of-line space. Reported by Werner Lemberg <wl@gnu.org>.
+
+2004-06-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.ch: Moving the re-parsing of |name_of_file| back to
+ |start_input|. The string administration gets confused if this is
+ done in |make_file_name|.
+
+ * tex.ch: Typo in comment. Remove some redundant material out of
+ the change file. Replace ' ' with " " in a number of places --
+ this is the difference between the external coding and the
+ internal ASCII-based coding of characters. Since the external
+ coding is ASCII on all platforms we currently compile on, this is
+ a place where mistakes in the web2c sources can linger.
+
+ * mf.ch: More changes to support spaces in filenames. In
+ particular, keep quotes around |cur_name|, |cur_ext|, and
+ |cur_area| iff these contain spaces. This incurs complications
+ because we re-parse |name_of_file| into these components after
+ opening a file. The file-printing routine is changed to ensure
+ that we print quotes if needed, but do not print any quotes
+ contained in the parameters themselves.
+
+ * mp.ch: More changes to support spaces in filenames. In
+ particular, keep quotes around |cur_name|, |cur_ext|, and
+ |cur_area| iff these contain spaces. This incurs complications
+ because we re-parse |name_of_file| into these components after
+ opening a file. The file-printing routine is changed to ensure
+ that we print quotes if needed, but do not print any quotes
+ contained in the parameters themselves.
+
+2004-06-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.ch: Larger |max_in_open|, |param_size|, |max_write_files|.
+
+ * tex.ch: More changes to support spaces in filenames. In
+ particular, keep quotes around |cur_name|, |cur_ext|, and
+ |cur_area| iff these contain spaces. This incurs complications
+ because we re-parse |name_of_file| into these components after
+ opening a file. The file-printing routine is changed to ensure
+ that we print quotes if needed, but do not print any quotes
+ contained in the parameters themselves.
+
+2004-06-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.ch: A slight change to ensure double quotes do not appear in
+ error messages when a filename has to be quoted.
+
+ * mf.ch: A slight change to ensure double quotes do not appear in
+ error messages when a filename has to be quoted.
+
+ * tex.ch: When dealing with a filename with unbalanced quotes,
+ still stop scanning when the buffer ends. Also a slight
+ modification to prevent double quotes from appearing in error
+ messages.
+
+2004-06-01 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Delete some MLTeX code that was duplicated accidentally.
+
+2004-05-31 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mf.ch, mp.ch: xprn must be ASCII_code -- we story only 0 or 1
+ there, and 'boolean' is a full 4-byte entity. Worse, dummy_xprn
+ was already an ASCII_code, so in the presence of a TCX file we
+ didn't correctly undump the base/mem.
+
+2004-05-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * cpascal.h: Remove -oem code.
+
+2004-05-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.ch: In mpost, we need to use str_stop to find the end of a
+ string. Reported by Wlodzimierz Bzyl <matwb@univ.gda.pl>.
+
+2004-05-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch [5.58]: Remove code implementing the locale-dependent
+ printing. The most generous evaluation is that this was an
+ experiment that failed. The desired effect of having printable
+ eight-bit characters is handled through different mechanisms.
+
+ * Makefile.in: fmtutil-related changes from Thomas. May not be
+ completely correct yet.
+
+ * fmtutil.in: New version from TeX-live.
+
+ * texmfmp-help.h: Correct helptexts of pdf*tex for format
+ extensions.
+
+2004-05-12 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * weave.ch: Increase max_refs and max_names for pdf*TeX.
+ Requested by Hartmut Henkel <hartmut_henkel@gmx.de>.
+
+2004-05-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (ctie.c): Name of the change file changed from
+ ctie.ch to ctie-k.ch.
+
+ * web2c/ctiedir: update to latest source from ctan.
+
+2004-05-09 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Add rules to compile, install, and distribute ctie.
+
+ * Add ctie to distribution, it lives in web2c/ctiedir.
+
+ * Makefile.in (post-dist-$(distname)): Remove cweb.c when creating
+ a distribution. Must be done explicitly because cweb is not a
+ program itself.
+ (ctangleboot.c, cwebboot.c): Make these rules more robust in the
+ presence of timestamp problems. You could get a empty files and a
+ failed build otherwise.
+
+2004-05-08 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (install-mf-links, install-mpost-links,
+ install-tex-links): Do not create initex, virtex, inimf, virmf,
+ inimpost, virmpost links on installation. These are all way more
+ trouble than they're worth.
+
+ * mp.ch: Use TEXMF_POOL_NAME and TEXMF_ENGINE_NAME, and replace
+ hard-coded mf.pool with pool_name in messages.
+
+ * mf.ch: Use TEXMF_POOL_NAME and TEXMF_ENGINE_NAME, and replace
+ hard-coded mf.pool with pool_name in messages.
+
+ * tex.ch: Change TEX_POOL_NAME and TEX_ENGINE_NAME into
+ TEXMF_POOL_NAME and TEXMF_ENGINE_NAME.
+
+ * texmfmp.h: Change TEXPOOLNAME and TEXENGINENAME into
+ TEXMFPOOLNAME and TEXMFENGINENAME.
+
+ * doc/web2c.texi: Document -halt-on-error.
+
+ * texmfmp-help.h: Document -halt-on-error.
+
+ * Makefile.in: Correct dependencies on $(basedir), $(memdir),
+ instead of $(fmtdir). This matters now that they differ.
+
+ * Makefile.in: Include md5 dir in libs-dist target.
+
+ * Makefile.in: Remove $(all_formats); it has become obsolete.
+ Simplify clean pattern now that only one format extension is left.
+ * Makefile.in: We use .fmt as the extension for all formats. This
+ means that latex.fmt gets built by e-TeX (as requested by the
+ LaTeX2e group). So remove that target from the rules for TeX.
+
+ * texmfmp-help.h: Change the various -*fmt options to actually
+ spell -fmt.
+
+ * tex.ch: Implement halt-on-error, and quoted filenames.
+
+ * mf.ch: Implement halt-on-error, and quoted filenames.
+
+ * mp.ch: Implement halt-on-error, and quoted filenames.
+
+2004-05-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Remove eomega-related code. Add aleph-dist target.
+
+ * configure.in: Remove e-Omega code. Enable pdflib for all
+ members of the pdfTeX family.
+
+ * texmfmp-help.h: Add -8bit to help text.
+
+ * doc/web2c.texi: Document interaction between -8bit and TCX.
+
+ * doc/web2c.texi: Document -8bit option.
+
+ * mp.ch: Add a magic number to the dump, add engine name to dump,
+ dump xord, xchr, xprn, so a TCX file during INI is persistent.
+
+ * mf.ch: Add a magic number to the dump, add engine name to dump,
+ dump xord, xchr, xprn, so a TCX file during INI is persistent.
+
+ * tex.ch: Always dump the xord, xchr, and xprn arrays, so loading
+ a TCX file in INI mode will change these defaults for all users of
+ the format. Implement an 8bit option that switches all characters
+ to printable by default. Reorganize the code a bit.
+
+2004-04-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch [5.71]: An error in the encTeX merge (not encTeX itself)
+ made TeX ignore commands given at the error "?" prompt. Reported
+ by Akira Kakuto <kakuto@fsci.fuk.kindai.ac.jp>.
+
+2004-04-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Modify error messages involving tex.pool, so they use
+ pool_name instead of the hard-coded name. Implement checking for
+ the name of the engine, which is now stored in the format file.
+
+ * texmfmp.h: Add proper definitons of TEXENGINENAME for each
+ engine.
+
+2004-04-08 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * bibtex.ch [10]: Add 'hack0' to initialize jmp9998. This had to
+ be moved up because otherwise we could end up doing the longjmp
+ before the setjmp. Reported by Sven Luther
+ <luther@dpt-info.u-strasbg.fr>.
+
+2004-03-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Change type of parse_first_line_p,
+ file_line_error_style_p, and shell_escape_p from boolean to
+ c_int_type. They're used as booleans in the Pascal code, but
+ tri-state in the C code.
+
+ * texmfmp-help.h: Document -no-shell-escape, -no-parse-first-line,
+ -no-file-line-error.
+
+ * doc/web2c.texi: Document -no-shell-escape, -no-file-line-error,
+ -no-parse-first-line.
+
+2004-03-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp-help.h: Bring help text up-to-date.
+
+ * tex.ch: Simplify some of the encTeX-related code.
+
+ * configure.in: Add test for Aleph.
+
+ * Makefile.in: Reorganization to mode pdftexlib-related code to
+ its own makefile fragment. Also rewrite the rules for the engines
+ so it becomes easier to omit specific engines from the default
+ compilation.
+
+2004-03-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * cpascal.h: Add definition of floor() for dvitomp. After Hartmut
+ Henkel <hartmut_henkel@gmx.de>.
+
+ * dvitomp.ch [49,50]: For the code to work, Hobby notes that we
+ need |round|(|x|-0.5) to be equal to $\lfloor x\rfloor$. For
+ Pascal's |round| function this is emphatically not true. After
+ Hartmut Henkel <hartmut_henkel@gmx.de>.
+
+ * dvitomp.ch: Support for color specials, like those generated by
+ the colordvi package. From Eddie Kohler <kohler@cs.ucla.edu>.
+
+2004-03-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Clarify use of special_printing in comment.
+
+2004-03-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dvitomp.ch [57]: Off-by-one error in virtual font handling.
+ From Hartmut Henkel <hartmut_henkel@gmx.de>.
+
+ * tex.ch: Correct comment so the file weaves properly.
+
+2004-03-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: encTeX merge. Code from Petr Olsak, with modifications
+ to match the rest of web2c better.
+
+2004-03-18 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in [testenv]: somehow the LC_ALL=C got dropped.
+
+2004-03-17 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Double sup_font_mem_size to 2000000.
+
+ * triptrap/texmf.cnf: Add mem_bot.tex and mem_bot.initex, set
+ main_memory.{ini,}tex to 3000.
+
+ * tex.ch: Make mem_bot configurable (0 and 1 only allowed values).
+ Used for the trip test.
+
+2004-03-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Modifications for Aleph.
+
+ * texmfmp.h: Mods for Aleph.
+
+ * texmfmem.h: Add Aleph.
+
+ * texmfmp-help.h [Aleph]: ALEPHHELP.
+
+2004-02-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tangle.ch: Treat pool files as binary files, not text files
+ (matters on some platforms).
+
+ * pooltype.ch: Treat pool files as binary files, not text files
+ (matters on some platforms).
+
+ * mp.ch [43.1195]: Use kpse_fontmap_format to find psfonts.map.
+
+ * tex.ch: Rename is_printable to xprn.
+
+ * mp.ch: Rename is_printable to xprn.
+
+ * mf.ch: Rename is_printable to xprn.
+
+ * withenable.ac: Add --without-pdfxtex.
+
+ * texmfmp.h (undumpint): Treat WIN32 as if REGFIX is set.
+
+ * texmfmp.h: Add define for kpsefontmapformat.
+
+ * texmfmp.h: Add support for pdfxTeX.
+
+ * fmtutil.in: Sync with TeXlive.
+
+ * configure.in: Add support for pdfxTeX.
+
+ * configure.in: If LEX is (autodetected) flex, add -l option. We
+ need this for omegafonts.
+
+ * help.h [MFT]: Allow several -style options.
+
+ * mft.ch: Implement multiple style files (multiple -s options) for
+ mft.
+
+ * patgen.ch: Increase trie_size, triec_size. Do not remove the
+ close_in, close_out operations.
+
+ * tex.ch [6.82]: Do not force scroll_mode for file:line:error
+ style messages.
+
+ * cwebdir/comm-w2c.ch: Correct documentation of CWEBINPUTS.
+ Initialise kpathsea_debug.
+
+2004-01-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Initialize source_filename_stack[0],
+ full_source_filename_stack[0] -- these can be read under some
+ circumstances. Found by Krank Küster <frank@kuesterei.ch>.
+
+ * tex.ch: Correct printing of |src_specials| when weaving.
+
+2003-10-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Work around flex 2.5.x issue (affecting pl.l in
+ the Omega code) by adding -l flag if we're using flex. From
+ Thomas.
+
+2003-02-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Version 7.5.2.
+
+ * configure.in: Version 7.5.2.
+
+ * Makefile.in: Remove vestiges of --with-etex=tex option.
+ (mf-clean): There is no $(mfw_o).
+ (install-data): install-dumps is conditional on --disable-fmtutil.
+
+ * configure.in (--enable-fmtutil): Implementation.
+ (--without-etex): Simplify --with-etex to an on/off switch.
+ (--with-mf-nowin): Simplify --with-mfw to an on/off switch for a
+ binary that is guaranteed to contain no windowing support.
+
+ * fmtutil.in: Replace occurrences of @TEXBIN@ with tex.
+
+ * withenable.ac (--without-etex): Replaces complex --with-etex
+ rule.
+ (--with-mf-nowin): Replaces complex --with-mfw rule.
+ (--enable-fmtutil): Just the help text.
+
+2003-02-17 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Version 7.5.1.
+
+ * configure.in: Version 7.5.1.
+
+ * Makefile.in (gftodvi-clean): Remove gftodvi.h.
+ (gftopk-clean): Remove gftopk.h.
+ (programs): Add $(pdftosrc).
+
+ * fmtutil.in: Remove mfw rule (sync with teTeX/TeX live).
+
+ * withenable.ac: New option: --enable-fmtutil.
+
+ * doc/Makefile.in: Need to add kpathsea.mk, as we now use libtool
+ in the clean rule, and it isnt' found otherwise.
+
+2003-02-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * triptrap/tripin.log: Update from Knuth for TeX 3.141592.
+
+ * triptrap/trip.typ: Update from Knuth for TeX 3.141592.
+
+ * triptrap/trip.tex: Update from Knuth for TeX 3.141592.
+
+ * triptrap/trip.log: Update from Knuth for TeX 3.141592.
+
+ * triptrap/trip.fot: Update from Knuth for TeX 3.141592.
+
+ * triptrap/mftrapin.log: Update from Knuth for MF 2.71828.
+
+ * triptrap/trap.typ: Update from Knuth for MF 2.71828.
+
+ * triptrap/mftrap.log: Update from Knuth for MF 2.71828.
+
+ * triptrap/mftrap.fot: Update from Knuth for MF 2.71828.
+
+ * weave.web: WEAVE 4.4 from Knuth - same version number, minor
+ change.
+
+ * tangle.web: TANGLE 4.5 from Knuth: prevents modno-comments from
+ being split across lines.
+
+ * vftovp.web: VFtoVP 1.3 from Knuth: made out_as_fix tell the
+ truth in overflow cases.
+
+ * mf.web: MF 2.71828 from Knuth: suppressed autorounding in
+ dangerous cases.
+
+ * tex.web: TeX 3.141592 from Knuth: fixed \xleaders, glueset,
+ weird alignments.
+
+ * tex.ch: Update banner for TeX 3.141592.
+
+ * Makefile.in (vptovf-clean): Correct typo.
+ (tangleboot.p): Copy from srcdir if it isn't in builddir, otherwise
+ builds outside the source dir are broken.
+
+2003-02-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Version 7.5.0.
+
+ * configure.in: Version 7.5.0.
+
+ * Makefile.in: From klibtool to libtool. Based on patches from
+ Albert Chin-A-Young <china@thewrittenword.com>.
+
+ * Makefile.in: Various changes to make e-TeX the engine under
+ LaTeX2e.
+ (dvicopy-check): Add VFFONTS definition.
+ (programs): mpost was mentioned twice.
+ (web-dist): Remove eomega.web file, as it is a generated one.
+
+ * mft.ch [8]: Increase max_bytes and max_names.
+
+2003-02-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Version 7.4.6.
+
+ * configure.in: Version 7.4.6. e-Omega support.
+
+ * withenable.ac: e-Omega support.
+
+ * texmfmp.h: e-Omega support.
+
+ * texmfmp-help.h: e-Omega support.
+
+ * texmfmem.h: e-Omega support.
+
+ * config.h: NO_FMTBASE_SHARE -> NO_DUMP_SHARE. Was overlooked for
+ a long time. Found by Nix <nix@esperi.demon.co.uk>.
+
+ * Makefile.in: Rewritten to a more "modular" structure: rules
+ related to one target are now mostly found together. Rules for
+ e-TeX, pdfTeX and so on are now mostly in the subsidiary
+ makefiles.
+
+2003-01-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Version 7.4.5.
+
+ * configure.in (AC_CHECK_FUNCS): Add mkstemp, mktemp.
+ Version 7.4.5.
+
+2003-01-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * withenable.ac: Indicate that --with-mfw=yes is currently the
+ default.
+
+ * fmtutil.in: Add comment on how to change the engine for LaTeX to
+ e-TeX. From Thomas.
+
+2003-01-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch [5.58/59]: Check the is_printable array when writing to
+ files, but check isprint(3) when printing to the terminal or the
+ log file.
+
+ * Makefile.in: Add pdftosrc to compiled programs.
+
+ * cwebdir/comm-w2c.ch: Use DEV_NULL instead of hard-coding
+ /dev/null. Reported by Fabrice Popineau.
+
+2003-01-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Version 7.4.4.
+
+ * doc/web2c.texi: Version 7.4.4.
+
+2003-01-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (testenv): Use LC_ALL=C, not LANG=C, as only the
+ former will actually force the locale to C.
+
+2003-01-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Increase ssup_max_strings, sup_main_memory,
+ sup_pool_size, so the large consumers can eat their fill.
+
+ * Makefile.in (install-links): Omega formats end in .oft now.
+ Spotted by Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+2003-01-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Version 7.4.3.
+
+ * configure.in: Version 7.4.3.
+
+2003-01-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * cwebdir/cweav-w2c.ch: Remove 'k' from banner.
+
+ * cwebdir/ctang-w2c.ch: Remove 'k' from banner, we're already
+ declaring we're part of web2c, and this is more consistent with
+ the other programs.
+
+ * cwebdir/comm-w2c.ch: Add --help and --version option, after code
+ supplied by Julian Gilbey.
+
+ * help.h [CWEB]: Add CWEAVEHELP and CTANGLEHELP.
+
+ * Makefile.in [testenv]: Add LANG=C to trip environment for
+ consistent results.
+
+2002-12-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * cwebdir/comm-w2c.ch: Remove code that adds ".web", kpathsea will
+ handle this. Ensure that when kpse_find_file returns a filename,
+ it is used for #line directives and such.
+
+2002-12-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Version 7.4.2.
+
+ * doc/web2c.texi: Version 7.4.2.
+
+ * doc/Makefile.in (install-data): Test for web2c.info explicitly
+ in current directory, because some versions of make prepend the
+ source dir path otherwise. From Thomas Esser
+ <te@dbs.uni-hannover.de>.
+
+ * Makefile.in (clean): Add 'mf' to the targets always removed.
+ (mf): Explicit target needed if --with-mfw=yes was given.
+ Thanks to Dragan Milicic <dragan@math.utah.edu>.
+
+2002-12-20 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Version 7.4.1.
+
+ * doc/web2c.texi: Version 7.4.1.
+
+2002-12-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * cwebdir/cweav-w2c.ch (reduce, squash): While creating the
+ prototypes I got the order of the arguments wrong.
+
+2002-12-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Version 7.4.0.
+
+ * configure.in: Version 7.4.0.
+
+ * Makefile.in: Changes for mf/mf-nowin handling. From Thomas.
+
+ * Makefile.in: Remove references to the share/* files.
+
+ * share/*: Remove files from this subdirectory. They are the kind
+ of files that should be distributed in the texmf tree.
+
+ * cwebdir/cweav-w2c.ch: Add prototype information.
+
+ * cwebdir/ctang-w2c.ch: Add prototype information.
+
+ * cwebdir/comm-w2c.ch: Add prototype information.
+
+2002-11-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.ch [46.1307]: A previous change dropped the call of
+ fix_date_and_time in non-ini mode, so we always got the date of
+ the creation of the mem file. Repoerted by Hartmut Henkel
+ <hartmut_henkel@gmx.de>.
+
+ * bibtex.ch [106]: Correct logic of comparison.
+
+ * bibtex.ch [106]: Make sure name_length is at least as long as
+ the length of the extension before checking for the extension.
+
+ * bibtex.ch [106]: Check for aux extension '.aux' not 'aux'. When
+ '.aux' is already present, take that into account when generating
+ the derived filenames. Reported by Emmanuel Jeandel
+ <ejeandel@ens-lyon.fr>.
+
+2002-11-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mf.ch [3.36]: write_ln instead of write for '! End of file on
+ the terminal... why?' message. From Hartmut Henkel
+ <hartmut_henkel@gmx.de>.
+
+ * mp.ch [3.36]: write_ln instead of write for '! End of file on
+ the terminal... why?' message. From Hartmut Henkel
+ <hartmut_henkel@gmx.de>.
+
+2002-11-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * cwebdir/comm-w2c.ch: Add copyright + license (public domain).
+
+ * cwebdir/ctang-w2c.ch: Add copyright + license (public domain).
+
+ * cwebdir/cweav-w2c.ch: Add copyright + license (public domain).
+
+ * doc/web2c.texi: To 7.3.11.
+
+ * cwebdir/cweav-w2c.ch: Increase max_file_name_length from 60 to
+ 1024.
+
+ * cwebdir/ctang-w2c.ch: Increase max_file_name_length from 60 to
+ 1024.
+
+ * cwebdir/comm-w2c.ch: Increase max_file_name_length from 60 to
+ 1024.
+
+ * configure.in: To 7.3.11.
+
+ * bibtex.ch [32,33]: Characters in the range [128..255] would be
+ dropped by some of BibTeX's internal functions, like purify$.
+ Allow them to pass through.
+
+ * Makefile.in: Remove libs/xpdf/aconf.h when creating a
+ distribution for pdftex.
+
+2002-11-12 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (install-links): Misspelled pdffmts; found by Joern
+ Clausen <joern@techfak.uni-bielefeld.de>.
+
+ * doc/web2c.texi: Correct expansion of GPL.
+
+ * Makefile.in: Use $(man1dir) for manual pages.
+
+2002-11-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Version 7.3.10.
+
+ * cwebdir/ctang-w2c.ch: Cleanup comments.
+
+ * cwebdir/comm-w2c.ch: Cleanup comments.
+
+ * cwebdir/cweav-w2c.ch: Cleanup comments.
+
+ * Makefile.in: Renaming of tie.ch to tie-w2c.ch. Install the
+ ctangle and cweave manual pages. Like the tie manual page, these
+ really should be updated for web2c.
+
+ * tie.ch -> tie-w2c.ch: Renaming to get a more consistent naming
+ convention.
+
+ * tiedir/tie.c: Reverting to the original from tie-2.4, as the way
+ in which tie.c is generated has changed: now we run ctangle during
+ the build.
+
+ * cwebdir/{ctang,comm,cweav}-w2c.ch: Changefiles to have CWEB use
+ kpathsea. First implementation by Wlodek Bzyl, with modifications
+ by Olaf Weber.
+
+ * cwebdir: Adding the sources of CWEB here.
+
+ * Makefile.in: Changes to support the addition of CWEB. Also use
+ the opportunity to remove shared_env, which is a dead variable.
+
+ * Makefile.in (install-data): Install fmtutil.cnf.
+
+ * fmtutil.in: New file. Used by teTeX, but not (at present!) by a
+ "bare" web2c installation, if such a thing exists anymore.
+
+ * share/typeface.map: Update to 2002-10-12.
+
+ * share/special.map: Add 'vn' for Vietnamese CM.
+
+ * doc/web2c.texi: Document the -parse-first-line option.
+
+ * texmfmp-help.h: Document the -parse-first-line option.
+
+ * tex.ch: Commented out: add code to 29.523 to set the
+ kpse_program_name to the name of the format found. This can be
+ both a good and a bad idea: its sets the format name properly in
+ case we do something like 'tex &latex file.tex' (when we want the
+ latex search paths) but is almost certainly wrong if we have
+ 'latex &mylatex file.tex' (when we also want the latex search
+ paths).
+
+ * mp.ch: Commented out: add code to 35.755 that would set the
+ kpse_program_name to the name of the format found.
+
+ * mf.ch: Commented out: add change to 38.788 that would set the
+ kpse program name to the name of the format found.
+
+ * cpascal.h: Add kpseresetprogramname to the defined symbols.
+
+2002-10-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp-help.h: Document -oft option (which was renamed to match
+ the extension name).
+
+ * doc/web2c.texi: Version 7.3.9.
+
+ * configure.in: Version 7.3.9.
+
+ * Makefile.in: Changes to get the Omega dump file extension from
+ fmt to oft.
+
+2002-10-20 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Use the -jobname option when dumping formats,
+ bases, mems.
+
+ * share/supplier.map: Update to 2002-3-3.
+
+ * share/typeface.map: Update to 2002-4-4.
+
+ * doc/web2c.texi: Document -jobname option. Correct description
+ of -fmt, -efmt, -base, -mem options, as they no longer set the
+ name to of the dumpfile written in ini mode.
+
+ * texmfmp-help.h: Document -jobname option in help texts.
+
+ * mf.ch [38.793]: Add support for --jobname option.
+
+ * mp.ch [35.770]: Add support for --jobname option.
+
+ * tex.ch [29.537]: Add support for the --jobname option.
+
+ * tangle.ch [50,53,58,63,116,...]: Make unambig_length a variable,
+ with default def_unambig_length. Implement the optional
+ case-smashing and underline-retention.
+
+ * doc/web2c.texi: Document the new options of tangle.
+
+ * help.h [TANGLEHELP]: Document the new options.
+
+2002-10-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Version to 7.3.8.
+
+ * NEWS: Updates for 7.3.8.
+
+ * doc/web2c.texi: Typo.
+
+ * tex.ch: Settle on text for the not-TeX banner -- just add a 'k'
+ to the name, so we get TeXk, e-TeXk, pdfTeXk, and so on.
+
+2002-10-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch [3.32]: Add parse_first_line_p variable.
+ [5.31]: Print not-TeX banner if parse_first_line_p is true.
+ [29.536]: Write not-TeX banner to log file when parse_first_line_p
+ is true; also when file_line_error_style_p is true (was omitted
+ earlier).
+
+ * mp.ch [1.13]: Add parse_first_line_p variable.
+
+ * mf.ch [1.13]: Add parse_first_line_p variable.
+
+ * doc/web2c.texi: Add warning about non-conformity of source
+ specials.
+
+ * tex.ch [5.16]: TeX would claim that source specials are enabled
+ when file:line:error styles were enabled.
+
+ * configure.in: TeXlive merge: changes to the cxx_runtime_hack
+ code.
+
+ * config.h [WIN32]: TeXlive merge.
+
+ * Makefile.in: Inhibit parallel makes, as these cause trouble with
+ the way the rules are (currently) written. Remove references to
+ libtiff. TeXlive merge.
+
+2002-07-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Update notes on the --src option.
+
+ * tex.ch [47.1091]: Back out the change that moved the generation
+ of src_specials. It in turn led to markedly different results in
+ "normal" input that is considerably more common than the
+ constructions that prompted the change. The upshot is that at
+ present I know of _no_ non-intrusive way to implement source
+ specials, and enabling them may break your documents in unexpected
+ ways. Found by the ever vigilant Akira Kakuto
+ <kakuto@fsci.fuk.kindai.ac.jp>, for which my thanks.
+
+2002-06-09 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * bibtex.ch [324]: Add comments clarifying the change and its
+ limitation.
+
+ * bibtex.ch [324]: When breaking output lines, try to avoid
+ splitting a \% combination. Reported by Agthorr
+ <agthorr@barsoom.org>.
+
+2002-06-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Insert a newline after the "file:line:error enabled"
+ console message.
+
+ * tex.ch: Implement banner change for source specials. Also
+ implement the printing of additional lines if source specials,
+ \write18, or file:line:error style messages are enabled. Change
+ the source specials to use a "frozen" \special token so that
+ redefinition of \special doesn't affect the working of this
+ option. Delay the generation of everypar source specials until
+ after the \everypar processing has been done, because they could
+ be easily "captured" otherwise (reported by Petr Olsak
+ <olsak@math.feld.cvut.cz>).
+
+ * doc/web2c.texi: Note that enabling source specials can have
+ unexped effects.
+
+2002-04-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Replace the use of a '#.#' pattern to comment out
+ options with the use of '#! '. Requested by Gerben Wierda.
+
+ * configure.in: Add implementation of --with-cxx-runtime-hack: it
+ allows the GNU C++ libraries to be statically linked, which makes
+ binaries marginally more transportable between hosts.
+
+ * Makefile.in (pdftex,pdfetex): Add @CXXLDEXTRA@ to support the
+ --with-cxx-runtime-hack option.
+
+ * withenable.ac: Add --with-cxx-runtime-hack option. (Thomas
+ Esser).
+
+2002-03-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dvitomp.ch [5]: Increase virtual_space to accomodate Korean
+ users. Suggested by Kong Hoon Lee <konghoon@dreamwiz.com>.
+
+2001-12-17 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Increase trie_op_size (and match with neg_trie_op_size)
+ to accomodate larger hyphenation tables. Value suggested by
+ Thomas Esser <te@informatik.uni-hannover.de>.
+
+2001-11-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Version 7.3.7.
+
+ * configure.in: Version 7.3.7.
+
+ * configure.in: Add AC_C_INLINE, to deal with the fact that pdfTeX
+ likes to use inline functions.
+
+2001-11-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: ipc_on must be c_int_type, not integer, because it is
+ used in the option code.
+
+ * Makefile.in (pdftex-dist): Add xpdf sources to this tarball.
+ (libs-dist): New target for additional libraries used by pdftex.
+ (bibtex-check): Use the just-created texmf.cnf, not an already
+ installed one.
+
+2001-11-20 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * share/variant.map: Update.
+
+ * share/typeface.map: Update.
+
+ * share/supplier.map: Update.
+
+ * share/adobe.map: Update.
+
+2001-11-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Changes to keep C++ compilers from choking.
+
+ * mp.ch: Changes to keep C++ compilers from choking.
+
+ * bibtex.ch: Changes to keep C++ compilers from choking.
+
+2001-11-18 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Version 7.3.6.
+
+ * tiedir/tie.c: Regenerated for tie.w and tie.ch.
+
+ * doc/web2c.texi: Update version. Document --recorder option.
+
+ * vftovp.ch: Changes to keep C++ compilers from choking.
+
+ * texmfmp-help.h: Document --recorder option.
+
+ * tex.ch: Changes to keep C++ compilers from choking. Add support
+ for the filename recorder.
+
+ * mp.ch: Changes to keep C++ compilers from choking. Add support
+ for the filename recorder.
+
+ * mf.ch: Changes to keep C++ compilers from choking. Add support
+ for the filename recorder.
+
+ * gftodvi.ch: Changes to keep C++ compilers from choking.
+
+ * dvitype.ch: Changes to keep C++ compilers from choking.
+
+ * dvitomp.ch: Changes to keep C++ compilers from choking.
+
+ * dvicopy.ch: Changes to keep C++ compilers from choking.
+
+ * cpascal.h: Additions for the filename recorder.
+
+ * bibtex.ch: Changes to keep C++ compilers from choking.
+
+ * NEWS:
+
+ * Makefile.in (tie): Link tie with lib.
+
+2001-11-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Check for headers sys/time.h, sys/timeb.h, and
+ functions gettimeofday, ftime.
+
+ * tangle.ch: Increase limits for constants and expressions to
+ allow tangle to build otangle.
+
+ * Makefile.in: Drop otangleboot target; otangle will be built by
+ tangle, not by itself.
+
+2001-11-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Update date, add documentation for
+ -file-line-error-style and -src-specials.
+
+ * texmfmp-help.h: Update help for -file-line-error-style and
+ -src-specials.
+
+ * configure.in: Version 7.3.5.
+
+ * tex.ch: Change the calls of xmalloc_array to account for the new
+ interface.
+
+ * mp.ch: Change the calls of xmalloc_array to account for the new
+ interface.
+
+ * mf.ch: Change the calls of xmalloc_array to account for the new
+ interface.
+
+ * cpascal.h (stringcast): Added to help the Omega people push
+ their sources through a C++ compiler.
+
+ * cpascal.h (xmallocarray): Moved from texmfmp.h, as Omega wants
+ to use it in more places. Note that the interface changed!
+
+ * texmfmp.h (xmallocarray): Moved to cpascal.h for the Omega
+ merge.
+
+ * Makefile.in (prereq-check): Explicitly require a 'progname'
+ argument to set the program name, instead of allowing such an
+ option to be part of the 'files' argument.
+
+2001-11-01 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (tangleboot.p): Test whether ./tangle exists -- this
+ rule can be triggered if tangleboot.p's timestamp is too old.
+
+2001-10-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: To 7.3.4.
+
+ * doc/web2c.texi: xref correction.
+
+ * tex.ch: Increase trie size. Add support for source specials.
+
+ * tangle.ch [8]: Increase max_names, max_tests to 10000.
+
+ * configure.in: Check for libm added. If it is there, we do
+ unconditionally link it, which is probably wrong.
+
+ * Makefile.in [makeargs]: Add LDFLAGS.
+
+2001-10-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * cpascal.h: Add defines for kpsesetprogramname and kpsempformat.
+
+ * help.h [MFT]: Add -metapost description.
+
+ * mft.ch: Support for METAPOST files. Based on changes supplied
+ by Wlodek Bzyl <matwb@univ.gda.pl>.
+
+ * texmfmp-help.h: Add IPC help text to etex, pdftex, pdfetex.
+
+ * mp.ch: Make path_size a configuration option.
+
+2001-10-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * weave.ch: Modify usage/usage_help invocation. Use kpathsea to
+ find web and change files.
+
+ * vftovp.ch: Modify usage/usage_help invocation.
+
+ * vptovf.ch: Modify usage/usage_help invocation.
+
+ * tftopl.ch: Modify usage/usage_help invocation.
+
+ * texmfmp-help.h: Remove double end-of-comment.
+
+ * tex.ch: Modifications for file:line:error style messages.
+
+ * tangle.ch: Modify usage/usage_help invocation. Find web and
+ change files using kpathsea.
+
+ * pooltype.ch: Modify usage/usage_help invocation.
+
+ * pltotf.ch: Modify usage/usage_help invocation.
+
+ * pktype.ch: Modify usage/usage_help invocation.
+
+ * pktogf.ch: Modify usage/usage_help invocation.
+
+ * patgen.ch: Modify usage/usage_help invocation.
+
+ * mp.ch: Modifications for file:line:error style messages.
+
+ * mft.ch: Modify usage/usage_help invocation.
+
+ * mf.ch: Modifications for file:line:error style messages.
+
+ * gftype.ch: Modify usage/usage_help invocation.
+
+ * gftopk.ch: Modify usage/usage_help invocation.
+
+ * gftodvi.ch: Modify usage/usage_help invocation.
+
+ * dvitype.ch: Modify usage/usage_help invocation.
+
+ * dvitomp.ch: Modify usage/usage_help invocation.
+
+ * dvicopy.ch [5]: Increase max_fonts.
+ [7]: Rename integer types to names that do not collide with the new
+ C99 names.
+ [system-dependent]: Modiy usage/usage_help invocation.
+
+ * cpascal.h (readln): Remove macro, add function prototype.
+ (kpsewebformat): Added.
+
+ * config.h (usage,usage_help): Change/add prototypes.
+
+ * bibtex.ch: Changes to usage/usage_help invocation.
+
+ * Makefile.in: install-programs [OMEGA]: add install-links for
+ omegadir sub-make.
+
+2001-10-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mf.ch [48.1200]: mf.web was changed to use 4-diget years, so
+ that change could be removed here.
+
+ * tex.ch [50.1328]: Master tex.web was changed to print 4-digit
+ years, so that change is removed here.
+
+2001-09-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tangle.ch: Add "parametric2" macros, which are macros where the
+ argument is delimited by [] instead of ().
+
+2001-04-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * cpascal.h (readln): Accept both CR and LF as end-of-line
+ characters.
+
+2000-08-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Replace the ugly ""$(var) construct with something
+ more robust. Thanks Thomas.
+
+ * config.h: Make sure we get the right c-auto.h. From Han The
+ Tanh.
+
+ * Makefile.in: Changes to support omega 1.15. Earlier versions
+ are implicitly no longer supported because of these.
+
+ * configure.in: Changes to support omega 1.15.
+
+2000-08-05 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Bump version, year.
+
+ * configure.in: Update for 7.3.3.
+
+ * NEWS: Update for 7.3.3.
+
+ * mf.ch: Read buf_size from texmf.cnf, just like TeX and MP do.
+
+2000-04-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/ref.tex: Update reference codes for the bib files I'm using.
+
+ * mp.ch [35.782]: Use the kpse_mp_format for "readfrom" files,
+ instead of no path at all.
+
+ * vftovp.ch [25]: Both nl and lig_size are in words, so the
+ multiplication is not needed. Found by "C.M. Connelly"
+ <c@eskimo.com> and Melissa O'Neill <oneill@cs.sfu.ca>.
+
+ * tftopl.ch [20]: Both nl and lig_size are in words, so the
+ multiplication is not needed. Found by "C.M. Connelly"
+ <c@eskimo.com> and Melissa O'Neill <oneill@cs.sfu.ca>.
+
+2000-04-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tangle.ch: Increase zz.
+
+ * doc/web2c.texi: Document the win32-specific -oem option. From
+ Fabrice.
+
+ * cpascal.h [OEM]: Additions for oem.c, from Fabrice.
+
+2000-04-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * patgen.ch: Correct off-by-one in filename generation of
+ pattmp.x.
+
+2000-04-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dvitype.ch: Fix parsing of --output-level option to match
+ documentation. Spotted by DEK.
+
+2000-04-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dvicopy.ch: Increase max_widths, max_packets, max_bytes.
+
+ * configure.in: If fmtutil.in is found, create fmtutil.cnf.
+
+ * cpascal.h (readln): Explicit int to get rid of warning.
+
+ * Makefile.in: Changes for pdfTeX, from Han The Thanh
+ <thanh@informatics.muni.cz>.
+
+ * configure.in: Some of the "special hacks" that allow for
+ cross-compilation have been moved to acspecific.m4. From Han The
+ Thanh <thanh@informatics.muni.cz>.
+
+2000-04-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Correction: -translation-file -> translate-file.
+ Spotted by Etienne Riga <etienne.riga@skynet.be>.
+
+2000-03-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.ch: Parametrize the size of the line buffer. From Fabrice
+ Popineau <Fabrice.Popineau@supelec.fr>
+
+2000-03-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Allow spaces in the path leading up to the texmf tree.
+ (But not in the tree itself.) From Stefan Haller <stk@snafu.de>.
+
+ * mp.ch: Allow spaces in the path leading up to the texmf tree.
+ (But not in the tree itself.) After Stefan Haller <stk@snafu.de>.
+
+ * mf.ch: Allow spaces in the path leading up to the texmf tree.
+ (But not in the tree itself.) From Stefan Haller <stk@snafu.de>.
+
+2000-03-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.ch: i18n fix modeled on that for TeX.
+
+ * mf.ch: i18n fixes modeled on those for TeX.
+
+2000-03-01 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Several changes for i18n, from Wlodzimierz Bzyl
+ <matwb@monika.univ.gda.pl>.
+
+1999-09-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * patgen.ch: Correct filename generation to generate the extension
+ of pattmp.x. Reported by Werner Lemberg <wl@gnu.org>.
+
+1999-06-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dvitomp.ch: A checksum failure should result in a warning, but
+ not in a non-zero return code. This was done correctly in one
+ location, wrong in another. Reported by Berthold Höllmann.
+
+1999-05-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Update version to 7.3.1.
+
+ * NEWS: Update for 7.3.1.
+
+ * doc/web2c.texi: Update version info.
+
+ * share/bitstrea.map, share/special.map, share/texfonts.map,
+ share/typeface.map, share/urw.map: Updates provided by Thomas.
+
+ * share/linot-cd.map: linotype-cd.map, new fontmap file.
+
+ * share/cp8bit.tcx, share/kam-cs.tcx, share/kam-t1.tcx: New files
+ (received through Thomas Esser).
+
+1999-05-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * New set of share/*tcx files from Staszek Wawrykiewicz
+ <StaW@gust.org.pl>.
+
+ * tex.ch: Bump sup_buf_size to 300000. Several other constants
+ should probably be increased as well.
+
+ * Makefile.in: Several changes to get pdftex compilation to work
+ better.
+
+ * AUTHORS: Update to reflect current maintainer situation.
+
+ * README: Added my email address.
+
+1999-03-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch: Increase sup_nest_size, sup_param_size, sup_stack_size.
+
+ * configure.in: Bump WEB2CVERSION to 7.3.
+
+1999-03-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * withenable.ac: Remove AM_MAINTAINER_MODE,
+ --with-mktextex-default option.
+
+ * acconfig.h: Remove definition of MAKE_TEX_TEX_BY_DEFAULT.
+
+ * configure.in: Include kpathsea/withenable.ac for the definition
+ of texmfmain in the Makefile.
+
+1999-03-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Updates for tcx files, with many thanks to
+ "Staszek Wawrykiewicz" <StaW@gust.org.pl>.
+
+ * withenable.ac: Add AM_MAINTAINER_MODE.
+
+ * help.h: Update help strings for tcx files.
+
+ * acconfig.h: New file, with the web2c-specific configuration
+ parts.
+
+ * configure.in: Additions to make the configuration process work.
+
+ * config.h: Now include c-auto.h now that kpathsea/config.h
+ doesn't do this anymore.
+
+1999-02-18 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (pdftex-dist): Don't include pdftex's *.o files.
+
+1999-02-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmem.h: Changes to support Omega. From John Plaice.
+
+1999-02-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.h [!Omega]: Code changes to enable writing the tcx file
+ name to terminal and log.
+ [pdfTeX,pdfeTeX]: Remove inclusion (moved to coerce.h).
+
+ * tex.ch: Write the name of the tcx file (if any) to terminal and
+ log.
+
+ * mp.ch: Write the name of the tcx file (if any) to terminal and
+ log.
+
+ * mf.ch: Write the name of the tcx file (if any) to terminal and
+ log.
+
+ * Makefile.in: Compiler pdftex before pdfetex. Fixes to
+ distribution-creating code.
+
+1999-02-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.h (calledit,blankrectangle,paintrow): These are now
+ declared in the web2c/coerce.h file.
+
+ * configure.in: Only configure xpdf dir if pdftex is selected.
+
+ * Makefile.in: Add rules for pdfetex.efmt and pdfelatex.efmt.
+ Correct typos. From Thomas and Sebastian.
+
+1999-02-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mft.ch: Fix for weaving from Simon Cozens <simon@brecon.co.uk>.
+
+ * config.h [!WIN32]: Remove define of __cdecl.
+
+ * bibtex.ch: Corrections from Oren Patashnik
+ <opbibtex@cs.stanford.edu>. Fix for weaving from Simon Cozens
+ <simon@brecon.co.uk>.
+
+ * Makefile.in: Changes for packaging to account for the extra texk
+ directory level. Different handling of formats to be able to cope
+ when the list is empty, as it is for teTeX.
+
+1999-01-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * doc/web2c.texi: Correct typography of pdfTeX.
+
+ * texmfmp.h (getrandomseed): Add declaration.
+
+ * mp.ch (46.1307): Make init_randoms call get_random_seed. After
+ Fabrice.
+
+ * help.h: %&ini never worked, correct help strings.
+
+ * cpascal.h [WIN32]: Add pragma to quiet compiler. From Fabrice.
+ (aopenin): Open always in binary mode. From Fabrice.
+ (mainbody): Add TEXDLL, by Fabrice.
+
+ * config.h: Change inclusion guard from CONFIG_H to
+ WEB2C_CONFIG_H.
+ [WIN32]: Add definition of TEXDLL. From Fabrice.
+
+ * pktype.web: Updated version from Knuth, which had somehow been
+ overlooked for quite a while.
+
+1999-01-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * share/typeface.map: Update from Karl.
+
+ * share/special.map: Update from Karl.
+
+1999-01-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * share/*.tcx: New set of tcx files from Staszek Wawrykiewicz
+ <StaW@gust.org.pl>.
+
+ * withenable.ac: New option: --with-pdfetex.
+
+ * texmfmp.h: Support for pdfeTeX from Thomas Esser. pdftex.pool
+ is no longer a special case.
+
+ * tex.ch: Mention pdfeTeX in opening comment.
+
+ * help.h: Help string for pdfeTeX. From Thomas Esser.
+
+ * configure.in: Add support for pdfeTeX, from Thomas Esser.
+
+ * Makefile.in: Add support for pdfeTeX, from Thomas Esser.
+
+ * withenable.ac: Include the --with-mfw option.
+
+ * dvicopy.ch: Ensure that the --max-pages and --page-start options
+ actually work.
+
+ * configure.in: Introduce --with-mfw option, to be able to
+ generate window-capable MF as a separate executable called mfw.
+
+ * Makefile.in: Support for --with-mfw option.
+
+1999-01-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.h: Prototypes from open_in_name_ok and open_out_name_ok.
+
+ * mp.ch, tex.ch, mf.ch: Replace open_name_ok with open_in_name_ok
+ and open_out_name_ok where appropriate.
+
+ * share/texfonts.map: Change softkey-???? to skey???.
+
+ * share/*.map: Update for fontname 2.2.
+
+ * share/*.tcx: New files: tables for tcx support.
+
+1999-01-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * vftovp.ch: Since we may print the VPL on stdout, put all
+ terminal output on stderr. Add a newline if the VPL ends with the
+ BAD TFM OR VF comment.
+
+ * tftopl.ch: Since we may print the PL to stdout, all terminal
+ output should go to stderr.
+
+ * texmfmp.h: setupcharset is now used by all but Omega.
+
+ * tex.ch: Enable TCX files for TeX, clean up no-longer-current
+ comments. Based on code provided by Wlodzimierz Bzyl
+ <matwb@monika.univ.gda.pl>.
+
+ * mp.ch: Enable TCX files for MP. Based on code provided by
+ Wlodzimierz Bzyl <matwb@monika.univ.gda.pl>.
+
+ * mf.ch: Enable TCX files for MF. Based on code provided by
+ Wlodzimierz Bzyl <matwb@monika.univ.gda.pl>.
+
+ * cpascal.h: Remove NONASCII define. It was unconditional
+ already, and this cleans up some code.
+
+ * Makefile.in: Install tcx files, fix --output-comment test to
+ account for change of email address.
+
+1999-01-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * share/special.map: Update for new lh fonts.
+
+ * doc/Makefile.in: Change of ../make/*.make to ../make/*.mk.
+
+ * withenable.ac: Remove checks for zlib and pnglib, improve
+ handling of --with-* options for MF.
+
+ * mp.ch [44.1238]: Prepare for tcx code by safeguarding PS output.
+
+ * configure.in: Special code to handle cross-compilation with
+ djgpp. Better handling of --with-x options. Changes for
+ reorganization of non-kpathsea library sources. C++ compiler
+ check for PDFTeX.
+
+ * bibtex.ch: Many fixes, as suggested by Oren Patashnik.
+
+ * Makefile.in: Change of ../make/*.make to ../make/*.mk. PDFTeX
+ related corrections from Thomas.
+
+ * dvitomp.ch [32]: Bugfix: local_only is indexed by internal
+ font numbers.
+
+1999-01-05 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dvtype.web: Update from Knuth.
+
+ * dvitype.ch: Minor change necessary to accomodate update.
+
+ * gftopk.web: Update from Knuth.
+
+1998-12-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * vptovf.ch: Bugfix for 128 no longer required after update of
+ vptovf.web.
+
+ * tex.ch: Add strings_free configuration variable & checks. This
+ ensures the string pool is resized if necessary after load. Not
+ doing this caused core dumps in some cases. Bug reported by
+ Tobias Burnus <burnus@gmx.de>.
+
+ * configure.in: Configure in xpdf subdir for pdftex.
+
+ * Makefile.in: Add support for changes to to pdftex.
+
+1998-10-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * README.HPUX: Removed because the changes to tex.ch made it
+ unnecessary.
+
+ * tex.ch [1.12], [8.110], [51.1332]: Change definition of
+ min_halfword and initialization of mem_bot to make the code more
+ portable. Remove a test that would now prevent extra_mem_bot
+ being used.
+
+1998-07-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * bibtex.ch: Changes to get all information in the logfile when
+ the -terse option is used. With many thanks to Oren Patashnik
+ <opbibtex@cs.stanford.edu> for his assistance.
+
+ * vptovf.ch: Enlarged some constants, as suggested by Wayne
+ G. Sullivan <wgs@maths.ucd.ie>.
+
+ * vftovp.ch: Enlarged some constants, as suggested by Wayne
+ G. Sullivan <wgs@maths.ucd.ie>.
+
+ * tftopl.ch: Enlarged some constants, as suggested by Wayne
+ G. Sullivan <wgs@maths.ucd.ie>.
+
+ * pltotf.ch: Enlarged some constants, as suggested by Wayne
+ G. Sullivan <wgs@maths.ucd.ie>.
+
+ * mf.ch: Use open_name_ok to check names of files opened for
+ reading.
+
+ * mp.ch: Rename open_out_name_ok to open_name_ok, and use also to
+ check names of files opened for reading.
+
+ * tex.ch: Rename open_out_name_ok to open_name_ok, use it also to
+ check the names of files opened for reading.
+
+ * texmfmp.h: Rename openoutnameok to opennameok.
+
+ * tex.ch (49.1275): Include cur_name adjusting code from changes
+ to (29.537).
+
+Sun May 31 17:12:14 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Corrected pdftex.a to libpdf.a, ozlib to zlib.
+ Change echoed message to refer to texklib.tar.gz instead of
+ texmflib.tar.gz.
+
+ * cpascal.h: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * tangle.ch: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * mf.ch: Rename toint to intcast, because SCO usurped the former.
+ Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * mp.ch: Rename toint to intcast, because SCO usurped the former.
+ Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * pltotf.ch: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * tex.ch: Rename toint to intcast, because SCO usurped the former.
+ Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+ Correct the print_csnames function so that it doesn't print
+ entries in the hash table twice. Thanks to Berthold Horn for
+ pointing this out.
+
+ * gftodvi.ch: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * dvitype.ch: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * dvitomp.ch: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * dvicopy.ch: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * tftopl.ch: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+ * vftovp.ch: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+ Enlarge some contstants. Suggested by Wayne G. Sullivan
+ <wgs@maths.ucd.ie>.
+
+ * vptovf.ch: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+ Correct a bug that led to invalid vf files being created in some
+ circumstances. From Wayne G. Sullivan <wgs@maths.ucd.ie>.
+
+Fri Apr 24 21:36:09 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in, configure.in: Minor fixes in build rules of libpng,
+ zlib. From Thomas Esser.
+
+Tue Mar 24 19:20:13 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mp.web: New upstream source from John Hobby: version 0.641.
+
+Tue Mar 3 14:16:57 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in (WEB2CVERSION): version 7.2.
+
+Wed Feb 25 20:20:26 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Used `test ... -o test ...' which is always wrong,
+ changed `-o' to `||'. Spotted by Andreas Schott <ays@rzg.mpg.de>.
+
+Fri Feb 20 17:14:33 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * configure.in: Tests moved over from withenable.ac.
+
+ * withenable.ac: Boilerplating, and move some tests to
+ configure.in, to make it possible to distinguish between default
+ settings and user choices.
+
+ * doc/install.texi: Update with --with-epsfwin switch.
+
+Tue Feb 10 21:15:06 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * withenable.ac: Add --with-epsfwin option. From Mathias
+ Herberts.
+
+ * doc/web2c.texi: Document epsf driver.
+
+Fri Feb 6 17:56:53 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (pdftex.fmt, pdflatex.fmt): Do not require an .ini
+ file to exist.
+
+Tue Feb 3 17:06:40 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (mltex.fmt, mllatex.fmt): Don't use .ini files.
+
+ * dvitomp.web: Incorporate a bug fix by John Hobby, as modified by
+ Peter Breitenlohner.
+
+Sun Feb 1 15:50:06 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * bibtex.ch: fptr -> f_ptr.
+
+ * dvitomp.web: Correct version number and date in printed title.
+
+ * mf.ch (49.1204): Remove trailing _ from inf_ and sup_ because
+ tangle doesn't like them.
+
+ * mp.ch (46.1298): Remove trailing _ from inf_ and sup_ because
+ tangle doesn't like them.
+
+ * mp.web: takescaled -> take_scaled.
+
+ * patgen.ch: readln -> read_ln; writeln -> write_ln.
+
+ * tangle.ch (8): Increase unambig_length to 32.
+ (58): Remove the conversion to uppercase, to match 63.
+
+ * tex.ch (51.1332): Remove trailing _ from inf_ and sup_ because
+ tangle doesn't like them.
+
+ * share/special.map: Version 2.7, from Karl Berry.
+
+Fri Jan 30 21:17:07 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * share/special.map: Update from Sebastian Rahtz
+ <s.rahtz@elsevier.co.uk>.
+
+Thu Jan 29 16:08:10 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (tex-check): Use WEB2C instead of MKTEXSCRIPT.
+
+ * mp.ch, dvitomp.ch: Update for version 0.64.
+
+ * mp.web, dvitomp.web: Version 0.64, from John Hobby.
+
+ * triptrap/mtrap.0 triptrap/mtrap.1 triptrap/mtrap.log
+ triptrap/mtrap.mp triptrap/trap.148 triptrap/trap.149
+ triptrap/trap.150 triptrap/ triptrap/ triptrap/ triptrap/trap.151
+ triptrap/trap.197 triptrap/trap.200 triptrap/trap.5
+ triptrap/trap.6: New files from John Hobby.
+
+Wed Jan 28 20:44:40 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * dvitomp.ch: Version number 0.632a.
+
+ * dvitomp.web, dvitomp.ch: Version number set to 0.632a. Note
+ that the modifications are a stopgap, until John Hoppy releases an
+ updated version.
+
+ * tex.ch (50.1325): undump_upper_check_things was supplied with
+ the wrong upper limit.
+
+ * share/special.map: New version from Thomas Esser.
+
+Fri Jan 23 15:03:49 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * dvitomp.ch, dvitomp.web: Various fixes from Peter
+ Breitenlohner.
+
+ * mf.ch (48.1200): Four-digit years.
+ (49.1211): Make %& lines work reliably.
+
+ * mp.ch (45.1249): Four-digit years.
+ (46.1298): Make %& lines work reliably.
+
+ * tex.ch (50.1328): Use four-digit years.
+ (51.1337): Make %& lines work reliably.
+
+ * texmfmem.h: Changes for Omega, to make its dumps
+ endian-independent. After John Plaice.
+
+Sat Jan 17 09:37:23 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * wmftalk.h renamed to mftalk.h. From Mathias Herberts
+ <Mathias.Herberts@irisa.fr>
+
+ * withenable.ac: --with-mftalk defined NEXTWIN, not MFTALKWIN.
+ From Mathias Herberts <Mathias.Herberts@irisa.fr>
+
+Wed Jan 14 21:23:56 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * tex.ch: Added warning for the unwary on the advice of Peter
+ Breitenlohner. Comment fixes from Peter.
+
+Tue Jan 13 08:31:52 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (dvitomp-check): Let DVItoMP look in ./tests for
+ ptmr.vf.
+
+ * dvitomp.ch ([65] l.1152): Correct a bug in dvitomp.web, that
+ prevents the font name from being printed as part of the error
+ message.
+
+ * Makefile.in (check-tex): Correction of typo, set TMPDIR to ..,
+ so that the PATH settings continue to work when the target is used
+ from the source directory. From Eli Zaretskii.
+
+Fri Jan 9 21:13:39 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Many changes, related to putting omegaware files in
+ omegaware directory.
+ (all, default): Make manual pages.
+
+Sun Jan 4 16:00:54 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Change for manual pages.
+
+Thu Jan 1 15:52:39 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Add an all-dist target (maintainer only) and change
+ the names of the etex, omega, and pdftex tarballs.
+
+Tue Dec 30 17:49:51 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (etex.efmt, elatex.efmt): Expand contents of
+ {etex,elatex}.ini files.
+ (check-pooltype): In e-TeX compatibility mode there's no tex.pool, but
+ an etex.pool. Both after Peter Breitenlohner.
+
+ * Makefile.in: Add man directory to targets. Correct PATH setting
+ for the nonesuch test in check-tex.
+
+ * configure.in: Added man/Makefile to AC_OUTPUT.
+
+Thu Dec 18 20:37:48 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (check-tex): Make the nonesuch test work when we
+ haven't installed the scripts yet.
+
+ * doc/web2c.texi: Correction of -maketex -> -mktex, and a few
+ others.
+
+ * help.h: Change spelling of -maketex option to -mktex.
+
+Tue Dec 16 19:11:05 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * PROJECTS: Add info on overflow bug.
+
+ * help.h: Reformatted text for IPC-related switches.
+
+Sat Dec 13 23:03:46 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.h [TeX]: Add definitions for flushdvi.
+
+ * tex.ch ([32.640] l.12690): Somewhat cleaner code for the IPC
+ fflushes.
+
+Fri Dec 12 10:25:43 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * help.h: Correct some messages for the change of MakeTeX to
+ mktex.
+
+ * tex.ch ([32.640] l.12690): Add fflush(dvi_file) in two places of
+ the IPC code; the buffering caused problems. After Gregor
+ Hoffleit & Richard Hutchinson.
+
+ * weave.ch: Increase max_bytes, so that we can weave Omega.
+
+ * doc/web2c.texi: Updated for changes to shell_enabled and
+ openout_any variables.
+
+Wed Dec 3 17:38:53 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (install-fmts): The choice is between @TEX@ and
+ @CTEX@, not @TEX@ and @ETEX@.
+
+Tue Dec 2 12:57:17 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (extraclean): Be more thorough.
+
+ * Makefile.in (mf.base, mpost.mem): Use --base=mf, --mem=mpost
+ option.
+
+Mon Dec 1 19:07:00 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * doc/web2c.texi: Update for -interaction option.
+
+ * mfmpw32.c: New file from Fabrice Popineau.
+
+ * help.h: Updated for the --interaction option.
+
+ * mf.ch (6.68, 6.69, 48.1199): Add support for --interaction
+ option.
+
+ * mp.ch (6.83, 6.84, 45.1293): Support for --interaction option.
+
+ * tex.ch (6.73, 6,74, 50.1327): Support for the --interaction
+ option.
+
+ * Makefile.in (install-links): Links are cheap on UNIX, so install
+ links for all kinds of *ini* and *vir*.
+
+Sun Nov 30 13:32:25 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * withenable.ac: Change --with-maketextex to --with-mktextex as a
+ consequence of the great renaming.
+
+Sat Nov 29 13:07:49 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * tex.ch (29.530): Assume empty suffix means TeX input file.
+ (29.537): Don't strip ".tex" suffix, don't give ".tex" suffix to
+ prompt_file_name.
+ (29.537) [Init]: New rules for determining dump file name.
+
+ * mp.ch (35.770) [init]: Implement new rule for determining name
+ of dump file.
+
+ * mf.ch (38.793) [init]: Implement new rules to determine name of
+ dump file.
+
+ * Makefile.in (*.{fmt,emft,base,mem}): Changes for new name
+ generation rules for formats.
+
+ * Makefile.in (*-check): Changes for checking outside the source
+ dir.
+ (*-dist): Add versions of the added packages to the names of their
+ tarballs.
+
+ * configure.in: Create stamp-auto. From Peter Breitenlohner.
+
+Tue Nov 25 18:29:47 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Conditionalize tex-check, include etex-check.
+ From Peter Breitenlohner.
+
+Mon Nov 24 17:26:40 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Changes to let make check work outside the source
+ tree.
+
+ * configure.in: Create a tests subdirectory if necessary.
+
+Sat Nov 22 19:27:47 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Change ?w2c-$(version).tar.gz names to
+ ?web2c-$(version).tar.gz in the etex-dist, omega-dist, pdftex-dist
+ targets.
+
+ * README: Add references to etexdir/README, omegadir/README, and
+ pdftexdir/README.
+
+ * doc/web2c.texi: Minor updates.
+
+Fri Nov 21 15:22:53 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Add a tex2.c/tex2.o file to tex_c/tex_o.
+
+Wed Nov 19 17:13:31 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * share/skey1250.map, share/skey1555.map, share/texfonts.map: Name
+ change of softkey-*.map to skey*.map.
+
+ * Makefile.in: Definition of LN_S removed, it is included from
+ common.make.
+ Explicit rules for tangling e-TeX and PDFTeX. Corrected the rule
+ for tangling Omega.
+ (dist): Ensure the fontname *.map files are included.
+ (gftopk-check, pktogf-check, pktype-check): cmr10.600pk is renamed to
+ cmr10.pk.
+ (depend): Make depend in $(otps) as well.
+
+ * texmfmp.h [NeXT]: More compile-time endianness tests.
+
+ * withenable.ac: Change formatting of help text to make it line up
+ better.
+
+Sun Nov 16 11:41:08 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (install-links): Add "" to prevent syntax errors.
+
+Sat Nov 15 21:33:28 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * withenable.ac: Add an --with-omega option, so that omega can be
+ selectively disabled if so desired.
+
+ * texmfmp.h: Definition of Xchr removed. Additions for Omega.
+ The added definitions for PDFTeX now come from an external file.
+
+ * help.h: Help messages for e-TeX, PDFTeX, and Omega and friends.
+ Since these messages are highly web2c-specific, and unlikely to
+ change much, there seems to be little reason to move them to
+ external files.
+
+ * cpascal.h: Put definition of Xchr in this file, because Omega
+ likes it. Also other additions to support Omega.
+
+ * configure.in: Add support for conditionally using Omega.
+
+ * Makefile.in: Many changes to support building Omega.
+
+Fri Nov 14 16:39:32 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Add very primitive kludge for the creation of
+ matching e-TeX and PDFTeX distributions.
+
+ * Makefile.in (web-dist): Remove etex.web and pdftex.web for the
+ web-distribution.
+
+ * Makefile.in (dist): Include tiedir in distribution.
+
+ * Add tie-2.4 to the distribution. It lives in web2c/tiedir.
+
+ * texmfmp.h [eTeX]: TEXPOOLNAME changes; [PDFTeX]: define
+ PDFTEXPOOLNAME.
+
+ * help.h: Include a help header for e-TeX and PDFTeX.
+
+ * Makefile.in: Changes to accomodate e-TeX and PDFTeX.
+
+ * configure.in: Change @ETEXTEX@ to @CTEX@.
+
+ * withenable.ac: Add --with-pdftex, --with-etex,
+ --with-system-zlib, and --with-system-pnglib options.
+
+ * configure.in: Add support for pdfTeX and e-TeX related options.
+
+Thu Nov 13 23:49:10 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.h: Include code to test for endianess when compiling.
+ When the BYTE_ORDER macros are available, this improves the
+ ability to cross-compile.
+
+Mon Nov 10 13:15:21 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * configure.in (WEB2CVERSION): Version 7.1.
+
+Thu Nov 6 20:29:35 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * triptrap/texmf.cnf: Bumped pool_size from 32000 to 40000.
+
+ * mf.ch: Bump max_font_dimen from 50 to 60.
+
+ * bibtex.ch: Bump buf_size and glob_str_size from 3000 to 5000.
+
+Tue Nov 4 19:11:59 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Get rid of CVS dir.
+
+Wed Oct 29 11:43:30 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * withenable.ac: Correction: dump-noshare -> dump-share.
+
+ * configure.in: Do not include ../kpathsea/xt.ac at the top,
+ because that puts the tests for X before the defaults that
+ withenable.ac sets up.
+ * withenable.ac: Include ../kpathsea/xt.ac here.
+
+ * withenable.ac: Add quotes to make --with-editor='vim +%d %s'
+ work, rather than require --with-editor='"vim +%d %s"'.
+
+Tue Oct 28 21:35:37 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Use cp -p when creating a distribution.
+
+Mon Oct 27 16:22:54 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * withenable.ac: sinclude(../kpathsea/xt.ac) and
+ sinclude(kpathsea/xt.ac) are apparently superfluous.
+
+Tue Oct 21 23:35:47 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Somewhat saner handling of triptrap dir when
+ creating a distribution.
+
+Mon Oct 20 08:05:31 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Replace y.tab with y_tab.
+
+ * doc/ref.bib: Preserve capitalisation in titles.
+
+ * cpascal.h: Undef `read' if it is already defined, before
+ defining it. Don't set console device to binary on WIN32. From
+ Fabrice Popineau.
+
+ * config.h [WIN32]: Add WIN32WIN define. From Fabrice Popineau.
+
+Fri Oct 17 10:37:38 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * cpascal.h [__DJGPP__]: Set stdin/stdout to binary, but not if
+ they are the console device. From Eli Zaretskii
+ <eliz@is.elta.co.il>.
+
+Thu Oct 16 20:39:27 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Add target depend:: to remake dependencies in
+ subdirectories.
+
+ * Makefile.in (tex_c, tex_o): After the last changes to tex.ch, we
+ no longer have a tex2.c.
+
+ * tex.ch: Replace 'xlparen' by '@=(@>' and 'xrparen' by '@=)@>'.
+ Compare ./web2c/cvttex.sed: Obsolete file. Also, various changes
+ for e-TeX (small rearrangements, introduces Init..Tini, remove
+ tabs and trailing blanks). From Peter Breitenlohner
+ <peb@mppmu.mpg.de>.
+
+ * doc/web2c.texi: Remove documentation of -extend-jobname option.
+ * help.h [TeX] Remove description of -extend-jobname option.
+ * mp.ch: Get mpost to handle filenames with multiple dots better.
+ * mf.ch: Get mf to handle filenames with multiple dots better.
+ * tex.ch: Numerous changes to remove the extend-jobname stuff, and
+ replace it with a sane handling of filenames with more than one
+ dot. See especially end_name and start_input.
+
+Wed Oct 15 17:37:07 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in ($(proglib)): Added stamp-auto to the dependencies.
+
+Sun Oct 12 11:50:58 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * tex.ch [53.1374]: Check name of file before opening it, not
+ afterwards.
+ * mp.ch [35.783]: Check name of file with open_out_name_ok before
+ trying to open it for writing instead of afterwards.
+
+Fri Oct 3 11:10:15 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * tangle.ch ([64] Delayed pool file opening.): Use
+ basename_change_suffix to obtain a reasonable name for the pool
+ file.
+
+ * vptovf.ch (6 Open VPL file): Print version_string instead of
+ repeating the banner.
+
+ * doc/web2c.texi: Correct description of -extend-jobname option.
+
+ * help.h [TEXHELP]: Correct description of -extend-jobname option.
+ * tex.ch (29.517): Changed logic to fix extend-jobname=never
+ problem.
+
+Thu Oct 2 18:06:11 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * doc/web2c.texi: Some minor corrections, suggested by "Tomasz
+ J. Cholewo" <tjchol01@mecca.spd.louisville.edu>.
+
+ * tex.ch: A patch to allow printing of non-ascii characters. From
+ Bernd Raichle <raichle@informatik.uni-stuttgart.de>.
+
+Wed Oct 1 23:29:54 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * configure.in: Fix for faulty link window/x11.c.
+
+Tue Sep 30 11:15:35 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Corrected path to rename.
+
+ * Makefile.in (version_files): removed.
+ * configure.in: Added definitions of WEB2CVERSION.
+ * Makefile.in: Let version = @WEB2CVERSION@.
+
+ * doc/Makefile.in: Use the add-info-toc script for the top level.
+
+ * tangle.ch: Increase max_toks from 50000 to 60000, max_names from
+ 4000 to 6000
+ (was 5000).
+
+ * c-auto.h.in (YYTEXT_UCHAR): added to solve the unsigned char
+ yytext[] bug. (From Thomas Esser <te@informatik.uni-hannover.de>)
+
+Sat Apr 19 16:11:24 1997 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Add .latex and .ini as another special case.
+ From: Henk Vosmeijer <vosmeijer@nfra.nl> and te.
+
+Fri Mar 21 16:45:28 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (tex.fmt, latex.fmt, mf.base, mpost.mem): Include
+ $(makeargs) when calling prereq-check so that any path
+ changes (e.g., $(prefix)) get propagated.
+ Bug from: jumper@lens.sri.com (Greg Jumper), among others.
+
+Mon Feb 24 17:02:14 1997 Karl Berry <karl@cs.umb.edu>
+
+ * vptovf.ch (max_kerns, hash_size, max_lig_steps): Increase
+ for psfonts.
+ From: Sebastian Rahtz <s.rahtz@elsevier.co.uk>.
+
+Thu Feb 6 11:27:23 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Version 7.0.
+
+ * tftopl.ch (tfm_size, lig_size, hash_size): Increase to match vptovf.
+ From Richard.
+
+ * vptovf.ch (max_kerns): Increase to 10007, a prime > 10000.
+ From Richard.
+
+ * tex.ch: Oops, .drv should be .drv, not .dtx!
+ From Fabrice and Thomas.
+
+ * Makefile.in (default): Depend on info. From Tim.
+
+Tue Feb 4 14:16:19 1997 Karl Berry <karl@cs.umb.edu>
+
+ * triptrap/mptrapin.log: Missed updating this.
+
+Mon Feb 3 17:11:45 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (windowlink): Forgot to include $(x_tool_libs).
+
+Sat Feb 1 17:17:19 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (x_ext_lib): New variable.
+ (windowlink): Use it.
+
+ * configure.in: Fix test for -lXext to include $X_EXTRA_LIBS
+ (needed on Solaris at least). Introduce $x_tool_libs variable
+ for toolkit libraries -lXt -lXext, only leave -lX11 in $wlibs.
+ From Ulrik.
+
+ * tex.ch: Make main_memory changes more robust.
+ Change ssup_max_strings and ssup_hyph_size to 65535.
+ From Wayne.
+
+Fri Jan 31 17:57:14 1997 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Make .drv a special case.
+
+Mon Jan 27 22:34:18 1997 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * dvitomp.web, mp.web: New files (version 0.632) from John Hobby.
+ * dvitomp.ch, mp.ch: Minor update to reflect changes in WEB files.
+
+ * triptrap: Need to update master files for mptrap test.
+
+Fri Jan 17 16:56:37 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (post-dist): Ungnuify doc/Makefile.in.
+
+Wed Jan 15 22:40:11 1997 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * mp.ch: : Allow tabs as field seperators in psfonts.map.
+
+Thu Jan 16 09:58:24 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (socketlibs): New variable.
+ (tex): Include it in the link.
+ * withenable.ac (--enable-ipc): Check for -lsocket.
+ Needed on Solaris, at least.
+ From: Richard Walker <Richard.Walker@cs.anu.edu.au>.
+
+ * tex.ch (ssup_trie_opcode, ssup_trie_size): Change to 65535.
+
+Fri Jan 3 09:02:34 1997 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch (trie_op_size, neg_trie_op_size): Change to 1501.
+ From Braams.
+
+Sun Dec 15 16:50:39 1996 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: ifdef-out the TCX file stuff.
+
+Mon Dec 9 00:50:56 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * bibtex.ch, dvicopy.ch, dvitype.ch: Make messages consistent
+ if called with no arguments.
+
+Sun Dec 8 16:32:50 1996 Karl Berry <karl@cs.umb.edu>
+
+ * bibtex.ch (standard_input, standard_output): Make globals here.
+ Initialize in main program.
+
+ * cpascal.h (makebinaryfile) [WIN32]: Define.
+ (resetbin, rewritebin): New macros.
+ (FOPENRBINMODE): Define.
+ (standardinput, standardoutput): Remove, these are in bibtex.ch now.
+
+ * config.h (unlink) [!unlink]: Add condition.
+ * dvicopy.ch, dvitomp.ch, dvitype.ch, gftodvi.ch, gftopk.ch,
+ mp.ch, pktogf.ch, pltotf.ch, vftovp.ch, vptovf.ch: Distinguish
+ between text and binary files, sigh.
+ From Fabrice.
+
+Fri Dec 6 17:44:15 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmem.h: Add conditionals and comments for Omega.
+ * texmfmp.h ({ocp,ofm}openin): New macros.
+
+Tue Dec 3 14:56:54 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.h (ipcpage) [IPC]: Give correct prototype.
+ From: Gregor Hoffleit <flight@mathi.uni-heidelberg.de>.
+
+Sun Dec 1 11:56:39 1996 Karl Berry <karl@cs.umb.edu>
+
+ * bibtex.ch (max_glob_strs): Increase to 20 for indxcite.
+
+Tue Dec 3 13:44:28 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * Makefile.in (mostlyclean): Call $(MAKE) $@, not $(MAKE) $$target.
+
+Tue Dec 3 01:45:33 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * triptrap/texmf.cnf: Correct max_strings.mpost.
+
+ * dvitomp.ch: Duplicate banner line for use in print_version.
+
+Wed Nov 27 09:55:04 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (distclean): Don't remove tangleboot.p.
+ (all_subdirs): Add doc, so it gets cleaned.
+
+Tue Nov 26 11:57:25 1996 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in: If --with-x-toolkit is set, set with_x.
+ Also protect --with tests from (unusual) values starting with -.
+
+ * Makefile.in (install_makeargs): Remove INSTALL_LIBTOOL_PROGRAM
+ again, there's no way to pass it down since its value is
+ subdirectory-relative.
+ (mft-check): Use $(srcdir)/.. instead of ../$(srcdir).
+ (mpost-check): Set MAKEMPX_BINDIR so we get the distribution's
+ tex, newer, etc., not anything installed
+
+Mon Nov 25 15:04:40 1996 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in: Only set with_x=no if it hasn't already been set.
+
+Fri Nov 22 17:17:03 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (mpost-check): Run tests/mptest.
+ * tests/mptest.mp: New file from Ulrik to test various bugs.
+
+ * mp.ch: Fix from John Hobby to allow invalid big number inside
+ btex..etex. Will probably appear in the next mp.web.
+
+Sun Nov 10 16:02:08 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (install-data): Install from doc, too.
+ Install mp.pool, not mpost.pool.
+ Call mkdirchain.
+ From Ulrik.
+
+ * configure.in: Do X testing here,
+ * withenable.ac: Instead of here; sinclude ../kpathsea/xt.ac instead.
+
+ * withenable.ac (maketextex-default): Test $withval, not $enableval.
+ From: Gerd Neugebauer <gerd@mailhost.uni-koblenz.de>.
+
+Thu Oct 31 19:27:56 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (texinfo.fmt): Simplify dump rule for recent Texinfo's.
+ From: Stephen Gildea <gildea@intouchsys.com>.
+
+Sun Oct 27 05:15:03 1996 Karl Berry <karl@cs.umb.edu>
+
+ * patgen.web: New version from peb to avoid division by zero.
+ * patgen.ch: Remove my hack that did this.
+
+Fri Oct 25 15:11:43 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Include doc stuff in distribution.
+
+Thu Oct 24 12:56:47 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Rename the mp binary to mpost, because there is a
+ Sun OpenWindows program by that name, plus a sort-of-freeware
+ version thereof. Sigh, sigh, sigh. Reported by Thomas.
+
+Wed Oct 23 17:19:29 1996 Karl Berry <karl@cs.umb.edu>
+
+ * help.h: Extra blank line in vftovp's help.
+
+ * patgen.ch: Avoid division by zero when printing the efficiency.
+
+Tue Oct 22 13:14:26 1996 Karl Berry <karl@cs.umb.edu>
+
+ * triptrap/texmf.cnf (MPXCOMMAND): Turn off with 0,
+ not none, which feature I guess I removed from callmakempx
+ at some point.
+
+ * Makefile.in (default, all): Depend on formats, not
+ $(fmts) $(bases) $(mems). We weren't remaking the formats.
+
+ * Makefile.in (trip, trap, mptrap): @echo to stderr, no use
+ redirecting it to the file we tell them to look at.
+
+ * mf.ch: Initialize char_class[255]; somehow the loop was changed
+ to stop at 254?!
+
+ * triptrap/texmf.cnf: Oops, can't have comments on the same line
+ as variable definitions.
+
+Sun Oct 20 18:00:16 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (mpware_sources): New variable.
+ ($(mpware)): New target, replacing mpware.
+ (always): No longer needed.
+
+Tue Oct 15 17:23:40 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (version_files): Add mpto.c and newer.c in mpware/.
+
+Mon Oct 14 11:09:28 1996 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (makebinaryfile) [!WIN32]: Define as a no-op.
+ * dvicopy.ch: Have to change stdin/stdout to be ``binary'' files.
+ * config.h (DllImport) [_WIN32]: Define.
+ * Changes for NT from: Fabrice POPINEAU <popineau@esemetz.ese-metz.fr>.
+
+ * weave.ch (max_toks, max_texts),
+ * tangle.ch (max_texts): Increase for tex2pdf.
+
+Sun Oct 13 16:54:11 1996 Karl Berry <karl@cs.umb.edu>
+
+ * patgen.ch: Patch the new call to get_input.
+
+ * dvicopy.web: Update (just a doc change) from peb.
+ * patgen.web: Update to version 2.2 from peb.
+
+ * tests: Rename directory from check/, for the sake of Gnits.
+
+Tue Oct 8 16:10:31 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (lib_sources): Add printversion.c.
+ (version_files): Add makempx.in.
+
+Mon Oct 7 17:12:03 1996 Karl Berry <karl@cs.umb.edu>
+
+ * *.ch: Oops, turns out printversionandexit needs more arguments.
+ * cpascal.h: Change decl.
+
+Sun Oct 6 18:02:27 1996 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (kpathseaversionstring): Remove this.
+ (printversionandexit): Declare this.
+ *.ch: Call the latter with the program banner.
+
+Sun Sep 8 19:14:09 1996 Karl Berry <karl@cs.umb.edu>
+
+ * mp.ch: Fix help message reference to MPtoTeX.
+
+Sat Sep 7 17:34:36 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (default all): Make $(fmts) $(bases) $(mems) by default.
+
+Fri Sep 6 15:03:35 1996 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in: Call AC_PROG_RANLIB.
+
+Wed Aug 14 16:31:42 1996 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Make .ins a ``known'' extension, too.
+
+Sun Aug 4 15:51:41 1996 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (kpathseaversionstring): Need to restore _'s.
+
+ * *.ch: print_ln (kpathsea_version_string) with --version.
+
+Fri Jul 26 15:47:35 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Remove co.make.
+
+Wed Jul 24 10:24:37 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (dist_subdirs, all_subdirs): Remove man.
+
+Sat Jun 8 13:15:40 1996 K. Berry <kb@cs.umb.edu>
+
+ * Makefile.in: Use $(kpathsea_link) instead of $(link_command).
+
+Sat Jun 1 13:12:44 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.h (openoutnameok): Move outside of #ifdef TeX conditional.
+
+Mon May 27 13:27:38 1996 Karl Berry <karl@cs.umb.edu>
+
+ * config.h: Use #if __STDC__, not #ifdef.
+
+Sat May 25 15:30:52 1996 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Doc fix.
+
+Fri May 24 11:12:07 1996 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (TEXHELP): Document -extend-jobname.
+ * tex.ch: Implement it.
+
+ * dvitype.ch (name_size): Increase to 1000. We should dynamically
+ allocate all these arrays, but it doesn't seem worth the trouble
+ to delay the release even more.
+
+Thu May 23 16:53:38 1996 Karl Berry <karl@cs.umb.edu>
+
+ * bibtex.ch: Dynamically (re)allocate the wiz_fn_space array
+ wiz_functions, as Nelson has reached the limit.
+
+Mon May 13 17:27:23 1996 Karl Berry <karl@cs.umb.edu>
+
+ * *.ch: Include program name in `need <however many> arguments' error.
+
+Mon May 6 14:42:09 1996 Karl Berry <karl@cs.umb.edu>
+
+ * dvitype.ch: Doc fixes.
+
+Fri May 3 17:34:29 1996 Karl Berry <karl@cs.umb.edu>
+
+ * withenable.ac: Use AC_ARG_WITH instead of AC_ARG_ENABLE for
+ maketextex-default.
+ Turn off MakeTeXTeX by default, as intended.
+ Remove maketexmf-default -- that is in kpathsea now.
+
+Thu May 2 14:14:38 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (dist_subdirs): Add contrib, rename data to share.
+
+ * kpathsea.make (c_auto_h_dir): Restore this.
+
+Mon Apr 29 16:09:10 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in ({tex,mp,mf}.pool): Add these targets along with the
+ .p's, since they get made at the same time. We never depend on them.
+
+Sun Apr 28 15:06:15 1996 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in (pb_AC_ASM_UNDERSCORE): Add call to new routine.
+ From: Peter Breitenlohner <peb@MPPMU.MPG.DE>.
+
+Sat Apr 27 17:11:00 1996 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Add changes from Wayne for dynamically allocated number
+ of hyphenation exceptions.
+
+Mon Apr 22 11:47:17 1996 Karl Berry <karl@cs.umb.edu>
+
+ * pktogf.ch: Correct call to kpse_open_file.
+
+Sun Apr 21 17:27:02 1996 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (MFHELP, TEXHELP): Document [-no]-maketex.
+
+Wed Mar 13 15:43:00 1996 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in (AC_OUTPUT): Add doc/Makefile.
+
+Tue Mar 12 15:27:37 1996 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch (hyph_size): Increase to 1009.
+
+Sun Mar 10 15:56:35 1996 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch (\openout): Don't log if the log file isn't open yet.
+
+ * bibtex.ch (glob_str_size): Increase to buf_size. Suggested by Ulrik.
+ Could dynamically allocate it (and global_strs, etc.), a la
+ entry_strs, but time is fleeting.
+
+Fri Feb 23 11:23:27 1996 Karl Berry <karl@cs.umb.edu>
+
+ * bibtex.ch: Doc fix.
+
+Sun Feb 18 16:18:54 1996 Karl Berry <karl@cs.umb.edu>
+
+ * (most).ch: Change xopenfile calls to kpse_find_file.
+
+Sat Feb 17 15:22:59 1996 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch (\openout): Log what we open, and disallow some filenames.
+ * texmfmp.h (openoutnameok): Declare this.
+
+Fri Feb 16 17:55:12 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.h (NONASCII): Define this.
+
+Thu Feb 15 14:11:58 1996 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Set kpse_make_tex_discard_errors if interaction = batchmode.
+ * mf.ch, mp.ch: Likewise.
+ * Makefile.in (tex-check): Include check that this works.
+ * texmfmp.h: Include <kpathsea/tex-make.h>.
+ * cpascal.h (kpsemaketexdiscarderrors): New macro.
+
+ * data: Rename to `share'.
+ * Makefile.in: Uses changed.
+
+Wed Feb 14 11:25:03 1996 Karl Berry <karl@cs.umb.edu>
+
+ * mf.ch, mp.ch: Incorporate patches for length of single-character
+ unprintable strings, per message to tex-implementors.
+ From: vieth@thphy.uni-duesseldorf.de (Ulrik Vieth).
+ Date: Wed, 20 Dec 1995 13:43:52 +0100.
+
+Sat Feb 10 15:17:45 1996 Karl Berry <karl@cs.umb.edu>
+
+ * mf.ch: Use halfp where possible (from Andreas Scherer).
+
+ * tex.ch: Add copyright clarification (from bernd).
+
+ * help.h ({TEX,MF,MP}HELP): -program is really -progname.
+
+ * tex.ch, mf.ch, mp.ch: Remove word `default' in ``Can't find the
+ default ___ foo.''
+
+Fri Feb 9 15:46:31 1996 Karl Berry <karl@cs.umb.edu>
+
+ * withenable.ac: --with-maketexpk etc. moved to
+ kpathsea/withenable.ac.
+
+Sat Feb 3 15:45:15 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (DEFS): Move to common.make.
+
+Sun Dec 31 16:46:23 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (kpsefindmft): Add to underscore-less list.
+
+Fri Dec 29 17:17:02 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: misc.make is now clean.make.
+
+Tue Dec 26 15:04:10 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (program_files): Add *.ac.
+ * withenable.ac: New file.
+
+ * configure.in (maketex*): Fix doc strings.
+
+Mon Dec 18 11:29:44 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (programs): New target.
+
+Sun Dec 17 15:10:09 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Add support for dumping interesting parts of the .fmt
+ file, to aid in debugging latex, etc. Suggested by David Carlisle.
+
+Tue Dec 12 15:57:15 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (install-links): Make dependency of install-exec,
+ rather than install-data.
+ (install-exec): Install the pool files as well.
+ From Ulrik.
+
+ * mf.ch, mp.ch: Module number corrections, etc., from Ulrik.
+
+Mon Dec 11 12:59:16 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (tex-check): Add run of Bernd's mltextst.tex, and
+ add that file to check/.
+
+ * weave.ch: Remove bogus increment of optind that prevented
+ recognition of the change file.
+
+Sun Dec 10 14:58:38 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (post-dist): Include tangleboot.p.
+
+ * mf.ch: Back to disallowing 8-bit characters.
+ * mp.ch: Disallow in general, but allow when |tex_flushing|.
+ From Ulrik.
+
+ * Makefile.in (check/check.log): New target.
+ (pre-dist): Depend on it.
+
+ * mft.ch: Use kpse_find_mft.
+
+ * Makefile.in (triptrap): Rename from mptriptrap. From Ulrik.
+
+ * triptrap/texmf.cnf: Remove pool_size.mp, since it was being
+ treated as 32000 anyway. From Ulrik.
+
+ * cpascal.h: Doc fix, from a comment by Andreas S.
+
+ * Makefile.in (install-man): New target, dependency of
+ install-data.
+ (install-links): Don't install tex as a link, it's the binary.
+ From: Joern Clausen <joern@techfak.uni-bielefeld.de> (among others).
+
+Sat Dec 9 20:26:51 1995 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * cpascal.h (kpsemftformat): Add this for MFT style files.
+
+Sun Dec 3 13:42:33 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mp.ch: Make character 255 invalid here, too.
+ Allow input filenames like `one.two.mp'.
+
+ * tex.ch: .dtx is another special case for TeX input.
+
+Fri Dec 1 16:15:32 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mf.ch, mp.ch, mft.ch: Patches from Ulrik to allow 8-bit
+ input. (Although bugs remain.)
+
+Mon Nov 27 11:10:53 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (install-links): Install mltex as a link to virtex.
+
+Sun Nov 26 13:40:01 1995 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (TEXHELP): Document -mltex.
+
+Fri Nov 24 13:16:13 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (install-data): Avoid use of basename here.
+
+Thu Nov 23 15:20:24 1995 Karl Berry <karl@cs.umb.edu>
+
+ * dvicopy.web, dvicopy.ch: Update for version 1.5.
+
+Wed Nov 22 13:04:50 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mft.ch: Treat tab and form feed like spaces on input.
+
+ * {weave,tangle,mft,patgen,vptovf,pltotf}.ch: Increase input line
+ length limit to 3000. From Ulrik.
+
+Sun Nov 19 16:05:06 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (program_files): Remove tangleboot.p.
+ (dist): Don't include various files in check/.
+ (distclean): Remove tangleboot.
+ (clean): Remove *.fmt, etc.
+ From John I.
+
+Sat Nov 18 17:05:37 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (distclean): Remove *extra.c. From Peter Dyballa.
+
+ * tex.ch: String recycling changes from Bernd.
+
+Fri Nov 17 13:22:31 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mp.ch (open_write_file): Needs modification for Amiga. From
+ Andreas S.
+
+ * gftodvi.ch (start_gf): Initialize arg_buf_ptr. From Andreas S.
+
+ * help.h (TEXHELP, MFHELP, MPHELP): Document new option -program.
+
+ * tangle.ch, weave.ch: Correct logic for finding chg_name. From
+ Ulrik and Andreas S.
+
+ * cpascal.h (libcfree): Use this name instead of cfree, which
+ historically exists on some systems.
+ * tex.ch, mf.ch, mp.ch: Change the calls.
+
+ * dvitomp.ch, gftodvi.ch: abs => fabs. From Ulrik.
+
+Thu Nov 16 16:18:11 1995 Karl Berry <karl@cs.umb.edu>
+
+ * weave.ch, vptovf.ch, tangle.ch, pltotf.ch, patgen.ch: Call
+ kpse_set_progname. From Gregor Hoffleit.
+
+ * Makefile.in (install-exec): make install-exec in mpware.
+ (clean): Remove junk from mptriptrap.
+ (install-links, install-fmts, etc.): Various fixes.
+ From Ulrik.
+
+ * config.h (AMIGAWIN) [AMIGA]: Define this. From Andreas Scherer.
+
+Sun Nov 12 16:05:44 1995 Karl Berry <karl@cs.umb.edu>
+
+ * gftype.ch (parse_arguments): Had <> -1 instead of = -1 when
+ checking the getopt_return_val.
+
+ * mf.ch, mp.ch (ab_vs_cd): Remove assembler possibility for this,
+ since it's not an inner loop function. From Wayne.
+
+ * mp.ch: Allow more comment characters in psfonts.map.
+ Make all error messages use `psfonts.map' consistently. From Ulrik.
+
+ * help.h (TEXHELP): -shell-escape instead of -noshell. Alphabetize
+ all (excepting -help/-version).
+
+ * tex.ch: Adding logging of system, disable by default, convert to
+ external character set. Suggested by Bernd, Nelson, et al.
+
+ * Makefile.in (dvitomp-check): Use ./dvitomp.
+
+Mon Oct 30 17:04:19 1995 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (MPHELP): Corrections from John Hobby.
+
+Sun Oct 22 16:47:23 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (mems, bases, fmts, formats, mptriptrap): New
+ targets. Reported by Ulrik.
+ (web2c, .ch.p, tangle.p): Use $(shared_env). From Simon.
+ (tex.fmt, latex.fmt): Missing \ before \input. Reported by Tim.
+ (install-links): Install vir* links as well as ini*. Reported by Tim.
+
+Sat Oct 7 17:48:43 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (install-links): Also depend on install-mems. From Ulrik.
+
+Fri Oct 6 16:26:13 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Use ./<program> instead of just <program>, in the
+ *-check targets and trip. From Wayne.
+
+ * help.h ({TEX,MF,MP}HELP: Document %&ini.
+
+Mon Oct 2 15:55:57 1995 Karl Berry <karl@cs.umb.edu>
+
+ * pooltype.ch: Call kpse_set_progname.
+
+Sat Sep 30 15:06:57 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Add \write18 and -output-comment support.
+ * help.h (TEX_HELP): Document the options.
+
+Sat Sep 23 15:05:06 1995 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in (strtol): Move this test to kpathsea, since we
+ can only use it once.
+
+Wed Sep 20 16:22:54 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Chop off an extension of .ltx, .texi, or .texinfo after
+ all, when making the jobname.
+
+Sun Sep 17 11:48:34 1995 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in: Enable MakeTeXMF and MakeTeXTFM by default.
+
+Sat Sep 9 16:26:01 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (install-data): Install the *.map files.
+ (dist): Put the .tcx and .map files in a subdir `data'.
+
+Thu Sep 7 12:43:02 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (lib_sources): Remove xopenfile.c.
+
+Mon Sep 4 17:15:43 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (xopenfile): Moved to kpathsea.
+
+Fri Sep 1 17:43:05 1995 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in: Doc fix.
+ * texmfmem.h: Doc fix.
+
+Thu Aug 31 13:36:09 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (odd): Maybe x & 1 is better than x % 2.
+ (half, halfp, roundscaled, roundfraction, floorscaled,
+ floorunscaled): Define these.
+ * mf.ch, mp.ch (ab_vs_cd) [ASM_SCALED_FRACTION]: ifdef this, and
+ use the routines above.
+ * configure.in: If Linux, set and substitute for @system_optimize@.
+
+Wed Aug 30 16:30:56 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmem.h: Remove junkx and junky in LittleEndian case.
+ Reported by Wayne.
+
+ * config.h (NO_DUMP_SHARE): Renamed from NO_FMTBASE_SWAP.
+
+Fri Aug 25 13:21:31 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (prereq-lose, tex.fmt, latex.fmt, mp.mem, etc.): New
+ targets, mostly copied from the old Makefiles. Run kpsewhich to
+ make sure the input files are there first.
+
+Thu Aug 24 19:13:02 1995 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (TEXHELP, MPHELP, MFHELP): Mention the &DUMPFILE capability.
+
+Tue Aug 22 11:44:08 1995 Karl Berry <karl@cs.umb.edu>
+
+ * kpathsea.make (c_auto_h_dir): Define this.
+
+ * dvitype.ch: Don't call xfclose if we didn't open the tfm file.
+
+Mon Aug 21 16:43:39 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (FOPENRMODE): Define this.
+ * dvitype.ch (open_tfm_file): Don't call xopenfile, since we don't
+ want to exit if no TFM file.
+
+Fri Aug 18 09:21:14 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (program_files): Put .tcx files here.
+
+Tue Aug 8 14:56:49 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (putbyte): Swallow semicolon.
+
+Thu Aug 3 11:32:07 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (dist): Only remake triptrapdiffs if necessary.
+
+Tue Aug 1 19:26:21 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Merge Wayne's dynamic font sizing changes.
+ * texmfmem.h (B0, B1): Declare as short, instead of quarterword.
+
+Mon Jul 31 17:46:11 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mp.ch, mf.ch, tex.ch: Omit $ from setup_bound_var calls.
+
+Sat Jul 29 13:13:31 1995 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in: Generate mpware/Makefile.
+
+ * texmfmp.h: Rename from texmf.h.
+
+ * dvitomp.ch, dvitomp.web: New files.
+ * Makefile.in: Add rules to make dvitomp.
+ * help.h (DVITOMPHELP): Define this.
+
+Fri Jul 28 11:10:46 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mp.ch: Dynamically allocate/set str_pool, string_vacancies,
+ etc., for the sake of the mptrap test.
+
+ * Makefile.in (post-dist): Include *.sed. From Greg.
+
+ * kpathsea.make (kpathsea_parent): Define as ../.., not using
+ $(top_srcdir). From Greg.
+
+ * mp.ch (copy_old_name): Null-terminate.
+
+ * triptrap/texmf.cnf (MPXCOMMAND): Set to `none'.
+
+Thu Jul 27 17:56:18 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mp.ch (more_name): Rewrite to make last . the one that counts
+ for the extension. And change jobname setting accordingly.
+
+ * Makefile.in (all_subdirs): Add window.
+
+Tue Jul 25 13:17:28 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mp.ch: malloc old_file_name.
+
+Mon Jul 24 17:45:42 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (mptrap): New target.
+ (trap): Rename some trap.* files to avoid conflicts.
+
+Sun Jul 23 11:43:51 1995 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (MPHELP): Define this.
+
+Sat Jul 22 14:20:50 1995 Karl Berry <karl@cs.umb.edu>
+
+ * *.ch: Reformat changes to get rid of extra % lines, etc.
+
+ * Makefile.in (mp, mfpextra.c): New target.
+ (mp_o, mp_c): New variables.
+ * texmfmem.h: Include MP in #ifdef's and comments.
+
+Fri Jul 21 15:31:17 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.h (undumpuppercheckthings): New macro.
+ * tex.ch (hyf_next, font_name, font_area): Use it. These base
+ types are unsigned, so comparing to 0 is redundant.
+
+ * mf.ch: Dynamicize main memory, a la TeX. Now with a memory size
+ of 3001, we pass the trap test. Whew.
+
+Thu Jul 20 13:48:40 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.h (put[24]bytes): Define these again.
+ * mf.ch: Use them instead of the default for tfm_two and tfm_four.vb
+
+ * mf.ch: Dynamically set error_line, half_error_line,
+ max_print_line, gf_buf, gf_buf_size. This is for the trap test.
+
+Wed Jul 19 11:31:00 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch (dvi_buf_size): Rename all occurrences of dvibuf_size.
+
+Tue Jul 18 14:09:15 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (install-links): Install links for inimf and initex.
+
+ * configure.in: Check for -lposix giving us sigemptyset.
+ From: bernt@weinberg.pop.bio.aau.dk (Bernt Guldbrandtsen).
+
+Mon Jul 17 13:08:32 1995 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in: Change default to not include X support.
+
+ * Makefile.in (mf): Add dependency on $(windowlib), and link with
+ $(windowlink).
+ $(windowlib): New variable, target, etc.
+ * window: New directory for the window support.
+
+ * configure.in: Use NO_DUMP_SHARE rather than NO_FMTBASE_SHARE, in
+ preparation for Metapost.
+
+Sun Jul 16 14:19:04 1995 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in (ipc, auto-dump): AC_ARG_ENABLE these.
+
+Sat Jul 15 16:04:13 1995 Karl Berry <karl@cs.umb.edu>
+
+ * acconfig.h: Make this a symlink to ../kpathsea/acconfig.h, as
+ with everything else.
+ * configure.in: Start adding all the --with's and --enable's.
+
+ * tex.ch: Patches from Wayne to allow extending the hash table via
+ a hash_extra value.
+
+Fri Jul 14 14:36:47 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Regenerate the first 256 strings if the user changed
+ which characters are printable.
+
+Thu Jul 13 14:09:19 1995 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (TEXHELP): Document -translate-file.
+ * texmf.h (setupcharset): Declare this.
+ * tex.ch (is_printable): Declare this new array.
+
+Sat Jul 8 13:54:13 1995 Karl Berry <karl@cs.umb.edu>
+
+ * bibtex.ch (stat, tats): Enable these by default.
+
+ * cpascal.h (BIB_XRETALLOC): Slight front end to XRETALLOC for
+ BibTeX's dynamic arrays.
+
+Wed Jul 5 17:47:03 1995 Karl Berry <karl@cs.umb.edu>
+
+ * bibtex.ch: Begin merging changes for dynamic array allocation.
+ From Nelson.
+
+Thu Jun 29 19:06:31 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch (font_bc, font_ec): Do not check these unsigned char
+ values against the range [0,255] when undumping.
+
+ * tex.ch: Use fputs instead of wterm for string variables
+ name_of_file, TEX_format_default.
+ * mf.ch: Likewise.
+
+ * help.h (TEX_IPC_HELP): Split this out from TEXHELP.
+
+Wed Jun 21 15:35:09 1995 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (MFHELP, TEXHELP): Document -base and -fmt respectively.
+
+ * tex.ch: Restore checking of various arrays when undumping.
+ * texmf.h (undumpcheckedthings): Macro to do the checking.
+
+Tue Jun 20 19:53:38 1995 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (TEXHELP) [IPC]: Document -ipc and -ipc-start.
+
+Fri Jun 16 11:45:48 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Add IPC changes.
+ From: Shamim Mohamed <shamim@howland.isu.edu>
+ From: Tomas G. Rokicki <rokicki@CS.Stanford.EDU>
+
+Tue Jun 13 11:30:57 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch (max_font_max): Increase to 1000, why not.
+ * mf.ch (tfm_out, tfm_two, tfm_four, tfm_qqqq): Leave default
+ definitions.
+
+ * kpathsea.make (kpathsea_parent): Use $(top_srcdir). From Greg.
+
+Sat Jun 10 19:25:10 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.h: Include c-pathch.h.
+
+ * tex.ch: Add changes to allow > 256 fonts.
+ * texmfmem.h (fmemoryword): New type.
+ From: wgs@maths.ucd.ie (Wayne G. Sullivan) and
+ From: Bernd Raichle <raichle@azu.informatik.uni-stuttgart.de>.
+
+Thu Jun 8 20:11:43 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mf.ch: Use IS_AREA_SEP here, too.
+
+Sun Jun 4 13:56:08 1995 Karl Berry <karl@cs.umb.edu>
+
+ * config.h (unlink) [UNLINK_MISSING && HAVE_REMOVE]: Define as remove.
+
+ * mft.ch: No longer need special case in input_ln, eof itself
+ checks now.
+ * {tangle,weave}.ch: Avoid /dev/null by just leaving the variable
+ name NULL.
+
+ * tex.ch (area_delimiter): Do : stuff for Amiga. From Andreas Scherer.
+
+ * texmf.h (initscreen, updatescreen, blankrectangle, paintrow):
+ Add prototypes for these.
+
+ * Makefile.in (post-dist): Work on this.
+
+Sat Jun 3 11:45:32 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Redo setup_bound_var to allow _'s in the names the user sees.
+
+ * bibtex.ch (ent_str_size): Double to 200. From Nelson.
+
+ * texmf.h (setupboundvariable): Declare this.
+
+Fri Jun 2 17:37:36 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch: Merge in Wayne's dynamic array diffs.
+ (hash_size, hash_prime): Increase to 10000 and 8501 for no
+ particular reason.
+
+ * texmf.h (xmallocarray): Add one to element size.
+
+Thu Jun 1 11:45:11 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch, mf.ch: If input file is foo.tex, output goes to foo.dvi,
+ not foo.tex.dvi! Fix from May 28 change.
+
+ * tex.ch (trie_size): Increase to 50000 to support U[KS] English,
+ French, and German.
+ From: Richard Walker <Richard.Walker@cs.anu.edu.au>.
+ (nest_size): Increase to 100.
+ From: lamport@src.dec.com.
+
+ * {tex,mf,bibtex,gftodvi}.ch (name_of_file): Declare as a pointer
+ to text_char, not char, so 8-bit filenames get echoed in correctly
+ in ^^ notation. From: thorinn@diku.dk (Lars Mathiesen).
+
+Sun May 28 17:45:33 1995 Karl Berry <karl@cs.umb.edu>
+
+ * tex.ch, mf.ch: If input file is a.b.{tex,mf}, jobname is a.b, so
+ we write to a.b.log. From rs@purple.in-ulm.de (Ralph Schleicher).
+
+ * vptovf.ch: Increase sizes of constants (Sebastian).
+
+Sat May 27 17:15:46 1995 Karl Berry <karl@cs.umb.edu>
+
+ * dvi{type,copy}.ch: Add options to replace the dialogue.
+
+Fri May 26 17:34:06 1995 Karl Berry <karl@cs.umb.edu>
+
+ * config.h (strtol) [!HAVE_STRTOL]: Declare this.
+ * configure.in (strtol): AC_CHECK_FUNCS for it.
+
+ * cpascal.h (addressofint): Rename to just addressof.
+ * *.ch: Change calls.
+
+Wed May 24 19:37:25 1995 Karl Berry <karl@cs.umb.edu>
+
+ * help.h, *.ch: Finish -help and -version for all but dvitype.
+
+Sat May 20 13:02:04 1995 Karl Berry <karl@cs.umb.edu>
+
+ * *.ch: Use new usage(1, 'progname').
+
+ * cpascal.h (basenamechangesuffix): Take three args now.
+ *.ch: Change calls.
+
+Fri May 19 19:29:06 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (findsuffix): Another in the underscore list.
+
+ * help.h (GFTOPK): Define help string.
+ * gftopk.ch: Add -help and -version support.
+
+Tue May 16 15:47:02 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (removesuffix): Add this to the underscore list.
+
+ * help.h (MFT, PATGEN, VFTOVP): Define help string.
+ * {vftovp,patgen,mft}.ch: Add -help and -version support.
+
+Sun May 14 11:14:46 1995 Karl Berry <karl@fosse>
+
+ * texmf.h (bytefile, wordfile): Do not define here.
+ * mf.ch, tex.ch (alpha_file, byte_file, word_file): Keep these
+ declarations.
+
+Tue May 9 15:47:55 1995 Karl Berry <karl@cs.umb.edu>
+
+ * help.h (PKTYPE, GFTYPE, TFTOPL, PKTOGF): Define *HELP strings.
+ * {pktogf,tftopl,gftype,pktype}.ch: Add -help and -version support.
+
+Mon May 8 12:05:05 1995 Karl Berry <karl@cs.umb.edu>
+
+ * pooltype.ch: Append `pool' if necessary.
+
+Sat May 6 11:24:01 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (lib_sources): Add usage.c.
+ * config.h (usage): Declare it.
+
+Fri May 5 17:48:13 1995 Karl Berry <karl@cs.umb.edu>
+
+ * pooltype.ch: Write the usage function in C now, passing in the
+ help string.
+
+Thu May 4 19:41:05 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h: Include help.h.
+ * help.h: New file for help messages.
+
+Fri Apr 28 13:45:08 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h: Include kpathsea/tex-file.h here.
+ * *.ch: Don't bother including it in only the relevant change files.
+
+ * cpascal.h (alphafile, fileptr): Don't bother defining these.
+ * bibtex.ch (alpha_file): Define as text.
+
+Tue Apr 25 13:43:13 1995 Karl Berry <karl@cs.umb.edu>
+
+ * *.ch: Don't bother changing program statements or removing
+ compiler directives now.
+
+ * *.ch: Use ^char instead of c_string where possible.
+
+ * Makefile.in: Clean up clean rules, etc.
+
+ * Update all .web files from 21 March 1995 Knuth archive. (bibtex,
+ dvicopy, and pktogf are not included.) New versions for dvitype (3.5),
+ mf (2.718), pltotf (3.5), tangle (4.4), tex (3.14159), and
+ vptovf (1.4).
+
+Sun Apr 23 10:54:58 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (mfextra.c, texextra.c): Don't just link, substitute
+ for which one we are.
+
+Sat Apr 22 13:22:09 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mf.ch (format_ident): Don't set to INIMF unless we are.
+
+ * texmf.h (kpsetexpoolformat): Define this.
+ (write_out): Let's try always using fwrite. Shouldn't it be more
+ efficient than write(2)?
+ (xmallocarray): New routine for the hyphenation tries.
+
+ * tex.ch: Avoid special case for first bad_pool; instead, change
+ a_close to not complain about already-closed files.
+ * tex.ch: Use kpathsea routines and constants.
+
+ * mf.ch: Copy pool file in correctly.
+
+Fri Apr 21 11:16:12 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h: Include progname.h.
+ (putbyte): Check return status.
+
+ * Makefile.in (web2c_programs): Remove regfix.
+
+ * cpascal.h, texmf.h: Add prototypes.
+
+ * mf.ch (debug, gubed): Use the cpp symbol MF_DEBUG, instead of
+ DEBUG, which kpathsea uses. Use kpathsea routines and constants.
+
+Tue Apr 18 11:03:55 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (cfree): Define this.
+
+ * texmf.h (dump_path): Define as the kpse_*_fmt, not the old path name.
+
+Mon Apr 17 10:00:04 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Add rules for Metafont and TeX.
+
+Fri Apr 14 15:30:34 1995 Karl Berry <karl@cs.umb.edu>
+
+ * dvicopy.ch, dvitype.ch, gftopk.ch: Use xfseek and xftell instead
+ of checked_fseek.
+ * cpascal.h (checked_fseek): Remove this.
+
+ * cpascal.h (open_input, open_output, aclose): Declare with prototypes.
+
+Tue Apr 11 13:15:51 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (bibtex.c): Depend on bibtex.cvtsed.
+
+Mon Apr 10 17:07:52 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (standardinput, standardoutput): Do not conditionalize
+ these on BibTeX.
+
+Tue Apr 4 15:22:08 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (web2c/web2c): Dependency is now on web2c/main.c,
+ not web2c/web2c.c.
+
+ * cpascal.h (kpse{bib,bst}format): Add these.
+
+ * bibtex.ch: Don't use file_name_size as an array size.
+
+Sun Mar 19 17:53:01 1995 Karl Berry <karl@cs.umb.edu>
+
+ * gftodvi.ch: Add -help, -version, change help message.
+
+Sat Mar 18 17:24:47 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (input): #define as stdin.
+ (kpsefindvf): Also use this for dvicopy.
+
+Fri Mar 10 10:52:09 1995 Karl Berry <karl@cs.umb.edu>
+
+ * *.ch (arg_options): Don't bother defining this, we never use it
+ any more.
+
+Thu Mar 9 15:50:12 1995 Karl Berry <karl@cs.umb.edu>
+
+ * acconfig.h: Warn that this is not the right thing to edit to fix
+ configuration problems.
+
+Tue Feb 21 13:41:25 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (output): Define as stdout.
+ * *.ch: Don't bother to redefine `output' as `stdout'.
+
+Mon Feb 20 15:24:31 1995 Karl Berry <karl@cs.umb.edu>
+
+ * *.ch: Rationalize argument parsing and usage messages.
+
+ * cpascal.h (kpsefind{mf,tex}): Define these.
+
+Sun Feb 5 15:26:28 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (basenamechangesuffix): Declare this.
+
+Tue Jan 10 11:43:27 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.h (glueratio): Move to here from config.h.
+ * config.h (ourpaths.h): No longer needed.
+ (link, getname, etc.): Move to cpascal.h.
+
+ * cpascal.h (nil): Define to be NULL.
+ * pktogf.ch: Use nil instead of NULL.
+
+Sat Jan 7 16:31:15 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (kpseinitprog): Add this.
+
+Tue Jan 3 15:19:52 1995 Karl Berry <karl@cs.umb.edu>
+
+ * config.h: getopt.h is in kpathsea now.
+
+Mon Dec 19 13:22:04 1994 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (kpsefindfile): Add this -- more _ synonyms.
+ (kpse{pk,vf}format): And this.
+
+Sun Dec 18 16:33:29 1994 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (flush): May as well define `break' as fflush in the
+ change files, and remove this.
+ * *.ch: Redefine `break' as `fflush' instead of `flush'.
+
+Sat Dec 17 13:40:19 1994 Karl Berry <karl@cs.umb.edu>
+
+ * vptovf.ch: Use cmdline instead of argv, rename gargv to argv,
+ make the filenames be C strings, and extend them if necessary.
+
+ * config.h (chartostring): Declare it.
+ (setpaths): Remove this.
+ * cpascal.h: Doc fix.
+
+ * tangle.ch (Parse arguments): Use char_to_string instead of
+ make_suffix_char.
+ * weave.ch (Define the option...): Use char_to_string for -x.
+
+Thu Nov 24 13:34:16 1994 Karl Berry <karl@cs.umb.edu>
+
+ * vptovf.ch (hash_size, max_kerns): Increase per Sebastian.
+
+Tue Nov 15 11:47:35 1994 Karl Berry <karl@cs.umb.edu>
+
+ * cpascal.h (kpsesetprogname): Define to
+ kpse_set_progname. Gosh, this is annoying.
+
+Mon Nov 14 13:28:04 1994 Karl Berry <karl@cs.umb.edu>
+
+ * {patgen,pooltype,pltotf,tftopl}.ch: Rewrite for argv changes, etc.
+
+ * cpascal.h (vstrcpy, vstrcat): Toss these. Change callers.
+
+ * *.ch: Rename c_char_pointer to c_string.
+
+ * config.h (argv): Rename to cmdline, and make a function.
+ * main.c (cmdline): Renamed from argv.
+ (gargv): Rename to argv.
+ (makesuffixchar): Declare.
+
+Sun Nov 13 16:19:27 1994 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in, Makefile.in: Update for Autoconf 2.0.
+
+Sun Nov 6 15:57:17 1994 Karl Berry <karl@cs.umb.edu>
+
+ * acconfig.h: Incorporate c-auto.h.top (and remove that file), for
+ Autoconf 2.0.
+
+Fri Oct 28 11:13:56 1994 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (tangle.c, tftopl.c): Depend on $(web2c_aux)
+ $(web2c_programs).
+
+ * tangle.ch: Redo argument parsing using getopt, extend_filename, etc.
+
+ * cpascal.h (extendfilename): Add this to _ list.
+
+Thu Oct 27 17:58:50 1994 Karl Berry <karl@cs.umb.edu>
+
+ * tftopl.ch (tfm_name, pl_name): Declare as C strings; call
+ kpse_find_tfm.
+
+ * cpascal.h (reset, rewrite): Call plain xfopen, not xfopen_pas.
+
+Mon Oct 10 16:23:13 1994 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (web2c_makeargs): Don't pass LEX et al.
+ (lib_makeargs): Don't pass RANLIB and LN.
+
+Sun Sep 25 16:49:30 1994 Karl Berry <karl@cs.umb.edu>
+
+ * configure.in (AC_OUTPUT): Generate man/Makefile, changes for new
+ source directories.
+ * Makefile.in: Everything changes.
+
+Fri May 27 12:37:36 1994 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.top: (XVIEWWIN, X10WIN): Take these out.
+
+ * tex.man, mf.man: Take out references to USE_MAKETEX*.
+
+Tue Apr 26 14:05:22 1994 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in: Use AC_FIND_XTRA, for Autoconf 1.9.
+
+Mon Apr 18 13:22:21 1994 Karl Berry (karl@ra.cs.umb.edu)
+
+ * configure.in, Makefile.in: Changes for the new configure.
+
+Sun Apr 17 16:16:28 1994 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Makefile.in (top_srcdir): Define this for configure to substitute.
+
+Sat Mar 12 10:19:04 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec): Install relative vir* links, instead
+ of absolute. From Simon.
+
+Wed Feb 23 06:54:49 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (manpages): Pass infodir down. From Ken Yap.
+
+Wed Feb 2 11:00:09 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Tue Feb 1 11:21:23 1994 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in (wlibs) [X11WIN]: Run AC_HAVE_LIBRARY for Xext, and
+ include it if we have it.
+
+ * Makefile.in (do-kpathsea): Depend on *.c and *.h from
+ $(kpathsea_srcdir), not $(kpathsea_dir).
+
+ * configure.in [SUNWIN]: Link sun.c to sun-sunview.c in this case.
+
+Sat Jan 22 14:24:51 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Fri Jan 14 16:02:35 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-fmts): The var is `fmtdir', not `formatdir'.
+
+Sat Dec 18 13:37:17 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (makeargs): Pass DEFS.
+
+Wed Dec 15 06:29:49 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (*formats*): Rename to fmts.
+ (formats): New target to do both bases and formats.
+
+Sun Dec 12 19:13:44 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (manpages): Don't bother to pass cmsources.
+
+Sun Nov 14 02:31:54 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (web2c): do-kpathsea before do-lib.
+
+ * Makefile.in (manpages, installargs): texfontdir => fontdir.
+
+ * Makefile.in (version): No separate texmf_version and
+ web2c_version any more.
+
+Thu Nov 11 11:11:05 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (xincludedir, xlibdir, wlibs): Rename.
+
+Sun Nov 7 14:15:14 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (makeargs, etc.): Don't pass srcdir down. From
+ harlan@cms-stl.com.
+
+ * configure.in (AC_LONG_64_BITS): Invoke this.
+
+Sat Nov 6 13:29:57 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in (HP2626WIN, etc.): Don't check for the WIN symbols
+ that we don't need.
+
+Thu Oct 28 14:28:55 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in: Call AC_FIND_X and AC_FIND_XTRA.
+
+Sun Oct 3 13:56:24 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in: Rewrite to include common.ac.
+
+Sat Oct 2 17:50:30 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-*): Don't reassign PATH, just invoke
+ mkdirchain explicitly.
+
+ * Makefile.in: Begin rewrite.
+
+Sun Aug 22 19:15:05 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-*): mkdirchain is in the top level.
+
+Tue Aug 3 12:56:31 1993 Karl Berry (karl@cs.umb.edu)
+
+ * aclocal.m4 (AC_X11_LOCATION): Rewrite tests to use for loops.
+
+Sat Jul 31 11:36:03 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in: Remove AC_PREFIX.
+
+Fri Jul 30 12:42:55 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in [hayley]: Make this ifdef, update dist target, etc.
+
+Wed Jul 21 19:47:00 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (configclean): New target.
+
+Sat Jul 3 00:36:33 1993 Paul Eggert (eggert@twinsun.com)
+
+ * aclocal.m4: If -L/usr/openwin/lib is used, then prefer
+ -I/usr/openwin/include. Fix typo: uname's output was being discarded.
+ These patches are for Solaris 2.2.
+
+Tue May 25 10:08:43 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in (AC_HAVE_HEADERS): Test for `pwd.h'.
+
+Sat May 22 11:22:21 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (web{,2c}-dist): Run gzip -9.
+
+Tue May 18 14:06:04 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-*): mkdirchain on install dirs, and put
+ mkdirchain in the dist.
+
+Sun May 9 10:38:46 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (extraclean): Remove *.i *.s. Changes for kpathsea.
+
+Sat Apr 24 16:42:42 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (makeargs): Add $(MAKEARGS).
+
+Sat Apr 10 14:58:32 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in: Do AC_XENIR_DIR after AC_DIR_HEADER.
+
+Fri Apr 2 06:42:08 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (texinputdir, mfinputdir): Change default paths to
+ .../inputs.
+
+Mon Mar 29 08:55:12 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in (*WIN): Put $wlibs after the necessary libraries,
+ instead of before.
+
+Thu Mar 25 16:00:11 1993 Karl Berry (karl@cs.umb.edu)
+
+ * aclocal.m4 (AC_ISC_WLIBS): Merge into AC_X11_LOCATION; also
+ check for -ldnet (from Martyn.Johnson@cl.cam.ac.uk).
+ * configure.in (AC_ISC_WLIBS): Remove.
+
+Sun Feb 28 11:02:19 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in (XVIEWWIN): Use -lX11.
+
+Mon Feb 22 17:41:46 1993 Karl Berry (karl@apollo.cs.umb.edu)
+
+ * Version 5.851d.
+
+ * Makefile.in (install-exec): Run install-exec in subprograms, not
+ install.
+ (install-data): Do install-data in subdirs.
+
+Sun Feb 21 08:27:14 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in (SMALLBibTeX): Forgot $ in test, hence always set
+ up for small BibTeX.
+
+ * configure.in (AC_PROG_CC, AC_PROG_CPP): Call explicitly, instead
+ of relying on AC_GCC_TRADITIONAL. Apparently require/provide
+ aren't reliable.
+
+ * Makefile.in (dist): Remove lib/paths.h from the distribution.
+
+Sun Feb 14 11:29:23 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (lib/paths.h): Only use texformats once.
+
+Tue Feb 9 14:22:05 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (topfiles): Add I*.
+ * INSTALL: New file from README.
+
+Sun Feb 7 20:09:01 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (web2c-dist): make tangleboot instead of depending
+ on do-tangle.
+
+Fri Jan 29 11:27:38 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (common-trip): New target.
+ (tr[ai]p): Use it.
+
+Thu Jan 28 07:27:24 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (web2c-dist): Make tangleboot.c.
+
+Tue Jan 26 16:48:36 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in: Remove texware and mfware.
+
+ * Makefile.in (triptrapdirs): Change to {dvi,font}util; merge the
+ contents of texware and mfware with the other directories.
+
+Mon Jan 25 11:36:37 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-{formats,bases}): Depend on
+ {formats,bases}, not do-&.
+
+ * Makefile.in (trip, trap): New targets.
+ (triptrap): Depend on them.
+ (run-trip, run-trap): Likewise.
+
+Sun Jan 24 12:06:28 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in: Add AC_CONST.
+
+ * Makefile.in (web2c-dist): Rename the lex and yacc output so it
+ doesn't get used.
+
+ * Makefile.in (run-trap): Depend on triptrap.
+
+ * configure.in: Do AC_DECLARE_YYTEXT last, to work around a bug in
+ Autoconf 1.3.
+
+Sat Jan 9 15:22:37 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (configure, config.status): cd $(srcdir) first.
+
+Fri Jan 1 14:23:47 1993 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in (AC_USG, AC_MEMORY_H): Delete.
+ (AC_HAVE_HEADERS): Call for string.h and memory.h.
+
+Wed Dec 23 07:00:53 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (topfiles): Don't use the .W2C suffix.
+ (web2c-dist): Don't rename ChangeLog.
+ * *.W2C: Remove suffix.
+
+Sun Dec 13 14:04:31 1992 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in: Check for window systems via c-auto.h.in.
+
+ * configure.in: Don't bother to copy the distributed tex, mf,
+ bibtex change files; the Makefiles will do it.
+
+ * Makefile.in (c-sources): New target.
+
+Sat Dec 12 14:08:35 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distdir): Unpack into web2c-*.
+
+ * configure.in: Use sed instead of patch to make the small change
+ files.
+
+ * configure.in: Create Makefiles in subdirectories.
+
+Thu Dec 10 10:35:18 1992 Karl Berry (karl@cs.umb.edu)
+
+ * GNUmakefile.in (GNUmakefile): Add $(srcdir) to dependency, and
+ use $(SHELL) instead of sh.
+ (config.status): Use $(SHELL).
+
+Sun Oct 25 05:58:21 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (web2c-dist): Dist the .gdbinit files.
+
+Sun Oct 18 13:44:48 1992 Karl Berry (karl@cs.umb.edu)
+
+ * configure.in (AC_INIT): Use MACHINES.W2C instead of tex/tex.web
+ for the unique file. (melvin@math.psu.edu)
+
+Sat Oct 17 17:47:00 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (run-tr[ai]p): Pass $(makeargs), so $(LN) is
+ propagated. (From metcalf@catfish.LCS.MIT.EDU.)
+
+Thu Oct 15 08:35:14 1992 Karl Berry (karl@cs.umb.edu)
+
+ * configure: Ran Autoconf 1.2.
+
+Thu Oct 1 17:02:24 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (stamp-{bases,formats}): pass $(makeargs) down.
+
+Thu Sep 24 10:55:07 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install*): use $(LN) instead of `ln', so symlinks
+ are used if they are supported.
+
+ * configure.in: link with -lolgx if we are using xview.
+ (mroth@afit.af.mil)
+
+ * Makefile.in (dist): remove tangleboot.o.
+
+Sun Sep 20 12:53:09 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (config.status): use sh to run configure --no-create.
+
+ * Makefile.in (realclean): OK, don't remove configure.
+
+Thu Sep 17 08:42:41 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (exec_prefix): new variable.
+ (bindir): use it.
+
+ * Makefile.in (install*): mkdir prefix directories.
+
+Mon Sep 14 18:00:57 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (config.status): new target.
+ (Makefile): depend on config.status.
+
+Sat Sep 12 16:00:24 1992 Karl Berry (karl@hayley)
+
+ * README.W2C: briefly discuss Autoconf.
+
+Thu Sep 10 08:59:26 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (dist): include COPYING* from our master directory,
+ not the source directory.
+
+ * Makefile.in (realclean): remove configure.
+
+Tue Sep 8 16:50:06 1992 Karl Berry (karl@hayley)
+
+ * configure.in: test for more Unix variants.
+
+Fri Sep 4 08:58:06 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (extraclean): new target.
+
+Thu Aug 27 08:57:15 1992 Karl Berry (karl@hayley)
+
+ * configure: regenerated from Autoconf 1.1.
+
+Wed Aug 12 16:33:30 1992 Karl Berry (karl@hayley)
+
+ * README.W2C: aldebaran has a different name now.
+
+Sat Aug 8 10:12:23 1992 Karl Berry (karl@hayley)
+
+ * makefile.in (configure, Makefile): new targets.
+
+Sat Aug 1 08:08:49 1992 Karl Berry (karl@hayley)
+
+ * configure.in: grep for `#define', not just `define'.
+
+Fri Jul 31 17:03:11 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (dist): include our aclocal.m4.
+
+ * configure.in: missed one of the grep -s's.
+
+ * Makefile.in (LIBS): include $(extralibs).
+
+Sat Jul 25 14:46:59 1992 Karl Berry (karl@hayley)
+
+ * configure.in: test if patch is available, and if not, issue a
+ warning.
+
+ * configure.in: redirect grep output, instead of relying on -s.
+
+Wed Jul 22 09:14:20 1992 Karl Berry (karl@hayley)
+
+ * configure.in: update for Autoconf 1.0.
+
+Mon Jul 13 08:37:18 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (formats): don't do etex by default.
+
+Fri Jul 3 11:44:22 1992 Karl Berry (karl@hayley)
+
+ * MACHINES.W2C: update from bernd.
+
+ * configure.in: check for XVIEWWIN.
+
+Thu Jul 2 15:24:41 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (cflags): remove.
+ (coptimize): change to CFLAGS.
+
+ * Run Autoconf 0.119.
+
+Thu Jun 25 07:51:10 1992 Karl Berry (karl@hayley)
+
+ * configure.in: called AC_PROG_CPP twice.
+
+Tue Jun 23 09:14:32 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (manext): default to `1', not `l'.
+
+Sun Jun 14 11:08:41 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (web2c-dist): show the sizes of tangleboot.*.
+
+Thu Jun 11 08:59:40 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (.NOEXPORT): new target, since Autoconf doesn't add
+ it automatically any more.
+
+Thu Jun 4 08:25:25 1992 Karl Berry (karl@hayley)
+
+ * configure.in (AC_HEADER_FILE): rename to AC_CONFIG_HEADER, for
+ Autoconf 0.115.
+
+Fri May 29 16:38:27 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (installargs): include $(makeargs), in case the
+ person didn't `make all' first.
+
+Sat May 16 10:09:14 1992 Karl Berry (karl@hayley)
+
+ * configure.in: PROG_CPP must come before GCC_TRADITIONAL.
+
+Fri May 15 09:47:03 1992 Karl Berry (karl@hayley)
+
+ * configure.in: add AC_GCC_TRADITIONAL and AC_PROG_CPP.
+
+ * configure.in: AC_HEADER_MISSING is now AC_HEADER_CHECK.
+
+Thu May 14 19:20:57 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Wed May 13 08:54:33 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (VPATH): change for new Autoconf.
+
+Tue Apr 28 10:17:23 1992 Karl Berry (karl@hayley)
+
+ * configure.in: Autoconf's prefix is now AC_, not M_.
+
+Sat Apr 25 09:04:59 1992 Karl Berry (karl@hayley)
+
+ * README.W2C: various fixes.
+
+ * AUTHORS.W2C: new file, shortening README.
+
+Thu Apr 23 06:38:46 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in: fix clean targets for latest GNU stds.
+ (bases): pass localmodes.
+ (makeargs): pass MFLAGS.
+ Above from Andreas.
+
+ * README.W2C, configure.in: Refer to site.h.in.
+ * Makefile.in (web2c-dist): distribute it.
+ (prefix): set to /usr/local.
+
+ * Makefile.in (.NOEXPORT): remove, as configure automatically adds
+ it now.
+
+ * Makefile.in (installargs): mfpool was going to the wrong place.
+
+Wed Apr 22 08:41:18 1992 Karl Berry (karl@hayley)
+
+ * configure.in: M_SIGTYPE is now M_RETSIGTYPE.
+
+ * configure.in: use M_LN_S.
+ * Makefile.in (LN): set to @LN_S@.
+
+ * MACHINES.W2C (DEC 5000/250, Ultrix 4.2a): from Elizabeth.
+
+ * Makefile.in (formats): remove \ at end of comment line, as
+ Ultrix make can't handle it.
+
+Mon Apr 20 06:32:10 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (check): an alias for `run-triptrap'.
+
+Sun Apr 19 11:54:41 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (distclean): add as another alias for `realclean'.
+
+Fri Apr 17 08:52:06 1992 Karl Berry (karl@hayley)
+
+ * Version 5.851b.
+
+Tue Apr 14 17:26:32 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (web/tangleboot.c): just make tangleboot.c.
+
+ * Makefile.in (clean-triptrap): just remove tex/tex.p and mf/mf.p,
+ as we don't want to remove the change files configure constructed.
+
+Mon Apr 13 09:00:39 1992 Karl Berry (karl@hayley)
+
+ * configure.in: do M_PREFIX before M_FLEX, so we can guess
+ $(prefix)/lib/libfl.a for the flex library.
+
+Fri Apr 10 17:02:56 1992 Karl Berry (karl@hayley)
+
+ * Makefile.in (web2c-dist): remove */c*.ch in what get distributed.
+
+ * configure.in: don't mess up if small vs. bib TeX/MF/BibTeX
+ changes from configure to configure.
+
+ * Makefile.in (infodir): remove this, as we don't have Texinfo
+ documentation (yet).
+
+ * README.W2C: correct numbering.
+
+ * MACHINES.W2C: add entry for Sun 3/SunOS 4.0.3 from Elizabeth.
+
+Wed Apr 8 15:47:02 1992 Karl Berry (karl@hayley)
+
+ * README.VMS: new file.
+
+Fri Apr 3 11:56:13 1992 Karl Berry (karl@hayley)
+
+ * configure.in, Makefile.in: guess $(prefix) automatically.
+
+Fri Apr 3 09:54:21 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Thu Apr 2 17:19:09 1992 Karl Berry (karl at claude.cs.umb.edu)
+
+ * Makefile.in: make stamp-web2c depend on stamp-lib, etc.
+
+Thu Apr 2 13:51:45 1992 Karl Berry (karl at ra.cs.umb.edu)
+
+ * Makefile.in (tangleboot.pas): change to tangleboot.c.
+
+Mon Mar 30 08:01:35 1992 Karl Berry (karl at hayley)
+
+ * Makefile.in: use $(MAKE), not make.
+
+Sun Mar 22 09:26:20 1992 Karl Berry (karl at hayley)
+
+ * configure.in: don't make a link to lib/site.h, it's already there.
+
+ * Makefile.in (mfargs): new variable.
+ (programs): pass $(mfargs) if we are doing mf.
+ (web2c): remove this.
+
+Sat Mar 21 09:08:31 1992 Karl Berry (karl at hayley)
+
+ * Makefile.in (web-dist, web2c-dist): redo.
+
+ * configure.in: test for site.h in lib/.
+
+ * site.h (TEXPOOLNAME): new macro for installers to redefine.
+
+ * Makefile.in (*manpages): don't pass SITEDIR; pass srcdir instead.
+
+Fri Mar 20 15:53:21 1992 Karl Berry (karl at hayley)
+
+ * configure.in: do M_X11_LOCATION.
+
+ * README.W2C: document these changes.
+ * Makefile.in (install-programs): rename from install. Make
+ `install' install everything. Also, go into subdirectories to
+ do the installation.
+ (install-manpages): don't pass INSTALL_PROGRAM.
+ (dist): do both web2c-dist and web-dist.
+ (mostlyclean): new clean target.
+
+Sat Mar 7 10:18:41 1992 Karl Berry (karl at hayley)
+
+ * configure.in: change config-auto.h to c-auto.h.
+
+Fri Feb 14 07:56:42 1992 Karl Berry (karl at hayley)
+
+ * configure.in (wlibs): put the -l's here directly, instead of
+ setting to a make variable.
+ * Makefile.in (*lib): remove the variables.
+
+Tue Feb 11 09:56:01 1992 Karl Berry (karl at hayley)
+
+ * configure.in: test for memcpy et al. in <memory.h> only.
+
+ * configure.in: test for <limits.h> missing.
+
+ * configure.in (extrawlibs): remove this, just assign to wlibs.
+
+ * Makefile.in (copt): never mind, use CC.
+
+Sun Feb 9 09:54:27 1992 Karl Berry (karl at hayley)
+
+ * Makefile.in (copt): new variable, for ISC's -posix.
+
+ * Makefile.in (realclean): remove Makefile and config.status.
+
+Sat Feb 1 16:03:05 1992 Karl Berry (karl at hayley)
+
+ * site.h-dist: remove subdirectory stuff. Add GFFONTS and PKFONTS.
+
+Fri Jan 24 09:11:29 1992 Karl Berry (karl at hayley)
+
+ * configure.in: do M_CHAR_UNSIGNED, and test for endianness here.
+ * config: gets removed.
+ * site.h: gets copied from config.
+ * Makefile.in (cflags): don't include -I$(configdir).
+ (configdir): remove.
+
+Wed Jan 15 11:33:54 1992 Karl Berry (karl at hayley)
+
+ * Makefile.in (libsources): do not include xchdir.c and xgetcwd.c,
+ as they're no longer needed.
+ * configure.in: don't test for getwd missing anymore.
+
+Tue Jan 14 08:47:38 1992 Karl Berry (karl at hayley)
+
+ * Makefile.in (makeargs): pass wlibs.
+
+Sun Jan 12 07:35:37 1992 Karl Berry (karl at hayley)
+
+ * Makefile.in (CFLAGS): define and pass down `cflags', instead, as
+ TeX and BibTeX need to add additional -D's.
+
+ * Makefile.in (.NOEXPORT): include this target to stop arg list
+ problems with GNU make.
+
+ * Makefile.in (clean-triptrap): call `make realclean', not
+ `veryclean'.
+
+Sat Jan 11 11:59:27 1992 Karl Berry (karl at hayley)
+
+ * rename `common' to `lib'.
+
+ * configure.in: new file to automatically generate the configure
+ script with autoconf.
+
+Wed Jan 8 07:44:02 1992 Karl Berry (karl at hayley)
+
+ * configure (extrawlibs): include -lnsl_s, as ISC's X11R4 stuff
+ needs it.
+
+Tue Jan 7 11:24:54 1992 Karl Berry (karl at hayley)
+
+ * Makefile.in (install targets): use INSTALL_PROGRAM and
+ INSTALL_DATA appropriately; pass to subdirs.
+
+ * start ChangeLogs in subdirectories.
+
+Fri Jan 3 13:20:09 1992 Karl Berry (karl at hayley)
+
+ * texware/pltotf.ch (main block): exit 0. No, rescind that; the
+ error code was from something else, as we already exit (0) in
+ common/main.c (main).
+
+Sun Sep 1 13:26:11 1991 Karl Berry (karl at hayley)
+
+ * fontutil/vftovp.ch (Read the preamble, Read and store a font):
+ don't output anything unless -verbose is set.
+
+ * fontutil/vftovp.ch (Set init...): initialize vpl_name to optind
+ + 2, not + 1; initialize the others to be optind and optind + 1.
+
+Thu Aug 29 17:46:31 1991 Karl Berry (karl at hayley)
+
+ * Makefile.in (INSTALL_PROGRAM): new variable.
+ (INSTALL): rename from `install'.
+ (INSTALL_DATA): rename from `INSTALLDATA'; change uses.
+ (prefix, libdir): new variables.
+ (bindir, mandir, texlibdir, mflibdir): use prefix.
+
+Sat Aug 24 06:37:52 1991 Karl Berry (karl at hayley)
+
+ * tex/Makefile (formats): add `amslatex.fmt'.
+ (amslatex.fmt): new target.
+ * Makefile.in (formats): likewise.
+ * README (Format files): describe it. Also add ``canonical
+ sources'' for the formats.
+
+Fri Aug 23 09:11:50 1991 Karl Berry (karl at hayley)
+
+ * Makefile-dist: rename to Makefile.in.
+ * configure (makefiledist): likewise.
+
+Mon Aug 12 08:14:18 1991 Karl Berry (karl at fosse)
+
+ * bibtex/bibtex.ch (pool_size): decrease to 512K from 5.12M.
+
+ * Makefile (install-formats, install-bases): don't do `-mkdir' in
+ the middle of the rule.
+
+ * common/common.defines (bytepointer): rename to pointertobyte,
+ since dvicopy defines a `bytepointer'.
+ * common/extra.h (bytepointer): likewise.
+ * texware/tftopl.ch: change uses.
+
+ * mf/Makefile (makeargs): update.
+
+Sun Aug 11 08:33:44 1991 Karl Berry (karl at fosse)
+
+ * common/common.h [STRING_MISSING]: don't include <strings.h> if
+ `index' is already defined.
+
+ * common/texmf.c: include <ctype.h>.
+
+ * common/getopt.c [_AIX]: indent the `#pragma alloca', since
+ otherwise we get `undefined control' from hc.
+
+ * configure (systemtypes): fix sed commands to remove the final .h.
+
+Sat Aug 10 12:23:24 1991 Karl Berry (karl at hayley)
+
+ * web2c/web2c.yacc (fixup_var_list): add the temp symbol used for
+ arrays with negative lower bounds to the symbol table.
+
+ * web2c/web2c.c (yytext): don't declare this, since we do in
+ web2c.h.
+
+ * texware/tftopl.ch (Read the whole input file): malloc the tfm
+ array if the file size is larger than the static size.
+ * common/common.defines (xmalloc, xrealloc, bytepointer,
+ casttobytepointer): declare these.
+ * common/extra.h (bytepointer, casttobytepointer): define these.
+
+Mon Jul 22 06:01:41 1991 Karl Berry (karl at hayley)
+
+ * config/s-{esv3,ultrix4.2}.h: new files.
+ * configure: update for those systems.
+
+Fri Jul 19 08:32:18 1991 Karl Berry (karl at hayley)
+
+ * configure (statusfile): define to be $configdir/statusfile;
+ always test if the s- file exists.
+
+Sat Jul 13 10:49:01 1991 Karl Berry (karl at hayley)
+
+ * Makefile-dist (proginstall, fileinstall): change names to
+ `INSTALL' and `INSTALLDATA'.
+
+ * Makefile-dist (RANLIB): new variable.
+ (makeargs): pass it down.
+ * mf/MFwindow/Makefile (window.a): unconditionally use RANLIB,
+ since it will always be set.
+ * common/Makefile: make a library out of the common files.
+ * */Makefile (commono): reference the library.
+
+ * fontutil/vftovp.ch: implement -verbose, -charcode-format, and
+ output to stdout a la tftopl.
+ * man/vftovp.man: document this.
+
+ * texware/{pl,tf}to{tf,pl}: don't print the banner until after
+ we've read the input file.
+
+ * fontutil/vptovf.ch: implement -verbose a la pltotf.
+ * man/vptovf.man: document this.
+
+Mon Jul 8 10:52:26 1991 Karl Berry (karl at hayley)
+
+ * common/common.h (integer): move comment about changing
+ fixwrites.c if integer changes here, from README.W2C.
+
+ * texware/tftopl.ch: new option -charcode-format.
+ (out_char): output the character code in the format requested.
+ * man/tftopl.man: document this.
+ * common/common.defines (vstrcat): new declaration.
+ * web2c/fixwrites.c (main): add ASCIIall to the list of variable
+ names who get output as characters. What a crock.
+
+ * tex/Makefile (*.fmt): don't print the \font definitions.
+
+Thu Jul 4 07:16:39 1991 Karl Berry (karl at hayley)
+
+ * common/texmf.c: put the memory_word stuff back in `texmfmem.h',
+ and redo the Makefiles; we can't include it before the types
+ have been defined.
+
+ * */Makefile (SITEDIR): change to ../config.
+
+ * web2c/web2c.h (yytext) [!DECLARE_YYTEXT_TYPE]: new type definition.
+
+ * web2c/web2c.yacc: lowercase `TRUE' and `FALSE'.
+
+ * web2c/Makefile (web2cy.c): unconditionally move the new .h and
+ .c files.
+
+ * common/Makefile (endian.h, endian): remove these targets; this
+ is now generated by configure.
+
+ * Makefile-dist: rearrange so that configure can easily edit it.
+
+Wed Jul 3 17:01:25 1991 Karl Berry (karl at hayley)
+
+ * common/texmf.c (input_line): don't throw away trailing form
+ feeds on the line.
+
+ * common/texmf.h (twohalves): throw in another two bytes of junk
+ if we are BigTeX or BigMF.
+
+Mon Jul 1 06:31:18 1991 Karl Berry (karl at hayley)
+
+ * common/getopt*: update to new versions.
+
+ * */*.[ch]: rationalize includes.
+
+ * site.h: move system stuff out; it will be determined by the
+ configuration file.
+ * defaults.h: remove; it, too, will be part of the configuration
+ file.
+ * common/extra.c [BSD]: conditionalize <dirent.h> on
+ DIRENT_MISSING, instead.
+ (PATH_DELIMITER): move to common.h.
+
+Sun Jun 30 13:44:09 1991 Karl Berry (karl at hayley)
+
+ * web2c/symtab.h: fold into web2c.h.
+ * web2c/Makefile (web2c*.o): remove dependency on symtab.h.
+
+ * defaults.h [__HIGHC__]: move to common.h.
+ (FILENAMESIZE): define to 512 if it isn't already defined.
+
+ * common/common.h (index, rindex): conditionalize on
+ `STRING_MISSING'. Define to be str[r]chr.
+ (getenv, atof): don't declare if we have <stdlib.h>.
+ * */*.c: change uses of [r]index to str[r]chr.
+
+ * {mf,tex}/c{mf,tex}big.ch: don't include "mfmem.h" or "texmem.h"
+ after all.
+ * common/texmf.h: include contents of memory_word structure.
+
+ * common/common.h [!index]: declare `index' to be a routine
+ returning a `char *'.
+ * web2c/regfix.c: include common.h.
+ (From wittig@gmdzi.gmd.de.)
+
+ * common/extra.c (space_terminate): use xord, not xchr.
+ * common/texmf.c (input_line): remove all space characters from
+ the end of the input line, not just spaces and tabs.
+ (topenin): use xord if NONASCII, and get rid of trailing
+ whitespace.
+ (These changes from raichle@azu.informatik.uni-stuttgart.de.
+
+ * common/{main,texmf}.c [ATARI_ST]: define _stksize (from
+ ridderbusch.pad@nixdorf.com).
+
+ * Makefile (SITEDIR): make default be `pwd', to simplify things.
+ * mf/MFwindow/Makefile (SITEDIR): lose the `..' in
+ -I../$(SITEDIR). (From S.P.Q.Rahtz@ecs.southampton.ac.uk.)
+
+ * common/{fileio,texmf}.c [FUNNNY_CORE_DUMP}: don't do the funny
+ core dump stuff if we're BibTeX (from elisabet@max.u.washington.edu).
+
+ * {tex,mf}/small.diff: new file to replace the big patches. Now
+ big is the default.
+
+ * bibtex/small.diff: new patch to go backwards from the big BibTeX
+ to the small one.
+ * README (Changing constants): document this.
+
+ * common/extra.c (checked_fopen): return NULL at the end, even
+ though we don't really return, to stop compiler warnings. (from
+ steele@ecn.purdue.edu).
+
+ * common/extra.c (checked_fopen): before we hand the string to
+ perror, make it into a C string (from
+ kabal@aldebaran.insl.mcgill.ca).
+
+ * tex/Makefile (latex.fmt): remove comment about hacked lplain
+ (from kabal@aldebaran.insl.mcgill.ca).
+
+ * web2c/Makefile (web2cy.c): Print a message about expected s/r
+ conflicts. Also use -v when invoking yacc.
+ (clean): remove `y.output'.
+
+ * Makefile (install-formats, install-bases): do `install dir1/file
+ dir2/file' instead of `install dir1/file dir2', since Ultrix
+ install is broken (in yet another way) (from
+ scole@doorstop.berkeley.edu).
+
+ * man/{pktogf,pktype,vftovp,gftodvi,gftopk,gftype,tftopl}.man:
+ document that we look in `.' first.
+
+Sat Jun 29 08:14:12 1991 Karl Berry (karl at hayley)
+
+ * common/extra.c (cwdtestreadaccess): new routine to look in `.'
+ before anything else.
+ * common/extra.defines (cwdtestreadaccess): declare it for Pascal.
+ * dviutil/dvicopy.ch (VF: Open |vf_file|...),
+ fontutil/{pktogf.ch, pktype.ch, vftovp.ch},
+ mfware/{gftodvi.ch,gftopk.ch,gftype.ch},
+ texware/tftopl.ch: use it to open input files.
+
+Fri Jun 28 16:40:10 1991 Karl Berry (karl at hayley)
+
+ * mf/convert: insert `volatile's to avoid MIPS C compiler bugs
+ (from lgy@newton.phys.washington.edu).
+ * defaults.h (volatile) [!__STDC__]: define to be the empty
+ string.
+
+ * common/texmf.c (get_date_and_time): use `time_t' instead of
+ `long' for `time's return type.
+
+ * bibtex/bibtex.ch: comment out hacks to do the setjmp/longjmp.
+ * bibtex/convert: don't put in the setjmp/longjmp.
+
+ * Makefile (CCLD): new command to do the link step (suggested by
+ herber@fnalf.fnal.gov). Change */Makefile to use it, and the
+ makeargs variable to pass it down.
+
+ * {mf,tex,mfware}/memory.h: rename this, to include conflicts with
+ a system <memory.h>. (from newton@gumby.cs.caltech.edu).
+ * {mf,tex,mfware}/Makefile: rename memory.h here, too.
+
+ * Makefile: replace all bare `if's with `-if' (from
+ kmr@nada.kth.se).
+
+ * defaults.h: (integer): move from site.h-dist.
+
+ * common/texmf.c: always include <sys/types.h>.
+
+ * common/texmf.c [HANDLE_INTERRUPTS]: remove this conditional,
+ since we unconditionally defined it, anyway.
+
+ * site.h-dist (schar) [ANSI]: change conditional to use __STDC__.
+
+Sun Jun 9 12:27:01 1991 Karl Berry (karl at hayley)
+
+ * tex/ctex.ch: apply trie.diff; we'll always have a big
+ hyphenation trie, instead of requiring the installer to patch
+ it.
+
+Wed May 8 07:31:19 1991 Karl Berry (karl at hayley)
+
+ * Makefile (stamp-{bases,formats}): make dependent on ini{mf,tex}.
+ * {mf,tex}/Makefile ({*.base,*.fmt}): likewise.
+
+ * mf/cmf.ch (max_strings): change default for small Metafont to
+ 3000: when modes.mf and plain are loaded, there is only room for
+ 250 user strings.
+ (string_vacancies): change to 10000.
+
+Fri May 3 06:46:05 1991 Karl Berry (karl at hayley)
+
+ * texware/{pl,tf}to{tf,pl}.ch, mfware/gftodvi.ch: declare verbose
+ as an integer, not a boolean.
+
+Wed May 1 17:04:03 1991 Karl Berry (karl at hayley)
+
+ * texware/pltotf.ch (Constants): increase some sizes some more.
+
+Wed Apr 17 11:26:55 1991 Karl Berry (karl at hayley)
+
+ * man/Makefile (install): don't unconditionally do mkdir $(mandir).
+
+Tue Apr 16 14:14:49 1991 Karl Berry (karl at ra.cs.umb.edu)
+
+ * Version 5.84b.
+
+ * README.W2C: remove reference to bigbibtex.ch.
+
+ * dviutil: new dvicopy.web and dvicopy.ch from
+ xitikgun@ddathd21.bitnet.
+
+Tue Apr 9 10:58:39 1991 Karl Berry (karl at ra.cs.umb.edu)
+
+ * common/texmf.c (do_undump) [REGFIX]: use a temporary so we can
+ use the & operator.
+
+ * MACHINES.W2C (Sun 4/470 and SunOS 4.1.1): from
+ casterln@are.berkeley.edu.
+
+ * Makefile (siteh): remove this.
+ (stamp-common): remove dependency on it.
+
+Tue Apr 2 16:23:02 1991 Karl Berry (karl at ra.cs.umb.edu)
+
+ * Version 5.84a.
+
+ * web/tangleboot.c: bring up to date.
+
+Tue Apr 2 13:28:35 1991 Karl Berry (karl at churchy.gnu.ai.mit.edu)
+
+ * common/endian.c: define the symbol `WEB2C_BIG_ENDIAN', since
+ <sys/machine.h> .
+ * common/texmf.c (do_dump, do_undump): use that name.
+
+Tue Apr 2 09:52:55 1991 Karl Berry (karl at godwin)
+
+ * bibtex/bibtex.ch: make `big' BibTeX the default.
+
+ * common/extra.h (gargv): make declaration extern.
+
+ * web2c/web2c.c (ii): remove second declaration.
+
+ * web/tangle.ch, fontutil/vptovf.ch, mfware/gftype.ch,
+ texware/pltotf.ch: change version numbers in banner.
+
+Thu Mar 28 14:28:01 1991 Karl Berry (karl at apple-gunkies)
+
+ * mf/Makefile (run-trap): specify the current directory to find
+ trap.tfm and trap.72270gf.
+
+ * all Makefiles: add alloca.o to the common object files.
+
+ * Makefile (triptrap): new dependency `stamp-common'.
+
+ * common/Makefile (endian.h): use `./endian', not just `endian'.
+
+Tue Mar 26 14:05:00 1991 Karl Berry (karl at ds5000)
+
+ * Makefile (install-formats, install-bases): don't quit if the
+ mkdir fails on the installation directory.
+
+ * tex/tex.web, fontutil/pktogf.web: new versions.
+ * fontutil/pktogf.ch: change version number.
+
+ * Makefile (web2c): define as just `web2c', and rename the
+ directory. All the scripts use that name.
+
+Tue Mar 26 13:48:36 1991 Karl Berry (karl at ra.cs.umb.edu)
+
+ * common/texmf.c (time): remove this declaration, since different
+ systems want a different return type. (from bush@evax.uta.edu)
+
+Mon Mar 25 08:25:36 1991 Karl Berry (karl at hayley)
+
+ * Makefile (stamp-web2c): remove all dependencies.
+ * web2c: change directory name to include version number.
+ (web2c): new variable to define the name of the web2c directory.
+
+Fri Mar 22 10:40:22 1991 Karl Berry (karl at hayley)
+
+ * common/extra.c (setpaths): use a string version of the
+ PATH_DELIMITER when concatenating paths.
+ (PATH_DELIMITER_STR): new macro.
+
+ * mf/MFwindow/x11-xt.c (mf_x11_updatescreen): remove redundant
+ stuff after #endif.
+
+ * web2c/{web2c.h,web2c.c}: remove redundant preprocessor definitions.
+
+ * web2c/web2c.c (my_output); don't always output a space after
+ every token. [no, rescind that, some sed scripts depend on the
+ existing form of output.]
+
+ * common/extra.c (getwd): don't initialize the automatic
+ structure; cc can't handle it.
+
+ * Makefile, */Makefile: use LDFLAGS at the beginning of linking
+ lines, and LOADLIBES at the end.
+
+ * COPYING.W2C: new file necessary for getopt; refer to it in
+ README.
+
+Tue Mar 19 15:19:35 1991 Karl Berry (karl at hayley)
+
+ * mfware/gftopk.ch (open_pk_file): don't search backwards through
+ garbage for a `/' (found by mackay@cs.washington.edu).
+ * fontutil/pktogf.ch (open_gf_file): likewise.
+
+Mon Mar 18 13:48:34 1991 Karl Berry (karl at hayley)
+
+ * {tex,mf}/Makefile ({tex,mf}-extra.o): remove the C file before
+ creating the link.
+
+Fri Mar 15 10:41:22 1991 Karl Berry (karl at hayley)
+
+ * site.h-dist (SPRINTF_RETURN_TYPE): remove this; it's caused
+ about a zillion times more trouble than it's worth.
+
+ * mfware/gftodvi.ch: change default extension to `2602gf',
+ following dek's change for art.
+
+ * tex/ctex.ch: we're now at version 3.14.
+ (Also new versions of gftodvi.web and mf.web, but they don't
+ require any changes to the change files.)
+
+Sun Feb 3 11:22:13 1991 Karl Berry (karl at hayley)
+
+ * mfware/gftodvi.ch: only print final newline if verbose.
+
+Sat Feb 2 09:54:14 1991 Karl Berry (karl at hayley)
+
+ * tex/Makefile (etex.fmt): create the aux file before running initex.
+
+ These two changes from jmr@nada.kth.se make calling checked_fopen more
+ than once with the same argument (as happens with weave patgen.web
+ patgen.ch) work.
+ * common/extra.c (checked_fopen): leave the arg as a Pascal string.
+ * common/fileio.c (open_input): terminate the result that comes
+ back from checked_fopen with a null.
+
+ * common/texmf.h (dumpint): use do...while (0) to prevent syntax
+ errors.
+
+ * PROJECTS.W2C: remove the ones that have been implemented.
+
+Sat Jan 19 15:44:26 1991 Karl Berry (karl at hayley)
+
+ * man/gftodvi.man: document the new options.
+
+ * */Makefile (commonh): add common.h to the list.
+
+ * common/common.h: include <math.h>.
+
+ * mfware/gftodvi.ch: implement -overflow-label-offset.
+ * common/extra.h (optiontable): another new abbreviation to help
+ in arg parsing.
+ * common/common.defines (strcmp, atof, optiontable): new
+ declarations.
+
+ * mfware/gftodvi.ch: changes to implement -verbose.
+
+ * most .ch files: fix the \title.
+
+Mon Jan 14 09:28:20 1991 Karl Berry (karl at hayley)
+
+ * mf/Makefile (inimf): don't depend on $(windowlib), and don't
+ link with $(libs); it just wastes disk space.
+ * common/texmf.c [INI]: undefine all window symbols.
+
+ * man/dvitype.man: fix mismatched parentheses.
+
+ * man/tftopl.man: document the new option and the path searching.
+
+ * common/extra.c (make_c_string): replace spurious call to
+ `space_terminate' with `null_terminate'.
+
+ * texware/tftopl.ch: changes to implement -verbose; also write to
+ stdout if no output file is specified; also call set_paths
+ to do path searching for the TFM file.
+
+ * texware/pltotf.ch (usage): remove; just print it inline.
+
+Sun Jan 13 16:57:01 1991 Karl Berry (karl at hayley)
+
+ These changes from ken@csis.dit.csiro.au:
+ * site.h: add TANDY as a possibility.
+ * defaults.h (FILENAMESIZE) [TANDY]: define to be smaller.
+ * common/extra.c (end_with_null, end_with_space): rename to
+ `null_terminate' and `space_terminate'.
+ * common/texmf.c (interrupt_handler): rename to `catch_interrupt'.
+ * web/tangle.ch (web_file_name, change_file_name): rename to
+ `web_name' and `chg_name'.
+ * web2c/web2c.yacc (function_return_type): rename to
+ `fn_return_type'.
+
+Sun Jan 6 13:41:08 1991 Karl Berry (karl at hayley)
+
+ * site.h: remove HAVE_GETWD -- now we supply our own.
+
+ * Makefile (x11lib): don't include -lXext.
+
+ * common/main.c (argv): check if we're beyond the end of argv.
+
+ * texware/pltotf.ch: changes for silent running unless `-verbose'
+ is specified.
+
+ * common/extra.h (address_of_int): rename to addressofint.
+
+Fri Jan 4 15:38:40 1991 Karl Berry (karl at hayley)
+
+ * man/Makefile (sedscript): use _ in the patterns, so
+ `TEXFONTS_SUBDIR' et al. work. (from drl@vuse.vanderbilt.edu)
+
+Sat Dec 29 13:52:41 1990 Karl Berry (karl at hayley)
+
+ * mfware/gftodvi.ch (Finish the \.{DVI}...): print a newline
+ before exiting.
+
+ * mfware/gftodvi.ch (Get ready to convert...): add only 1 inch
+ before typesetting the overflow labels.
+
+ * common/main.c (gargv): do not make static.
+ * common/extra.h (gargv): declare.
+ * common/extra.c (getwd, checked_{{open,ch}dir,{l,}stat): new
+ routines to find the pathname of the current directory.
+
+Wed Dec 26 09:21:56 1990 Karl Berry (karl at hayley)
+
+ * mfware/gftodvi.ch: put the progress report back in.
+
+Mon Dec 17 09:35:24 1990 Karl Berry (karl at hayley)
+
+ * README.W2C (Online output from MF): we have two versions of the
+ Suntools support now; mackay@cs.washington.edu sent one based on
+ the Sunview definitions, instead of gfx_hs.
+
+ * *.WEB2C: rename to *.W2C for compatibility with the Unix TeX
+ distribution.
+
+ * common/extra.c (getwd): new routine.
+ * site.h-dist (HAVE_GETWD): remove this definition; now everybody
+ has it.
+
+ * site.h-dist (FUNNY_CORE_DUMP): new symbol to make core dumps for
+ a preloaded TeX or MF by giving a strange filename.
+ * common/{extra,fileio}.c: use FUNNY_CORE_DUMP, instead of BSD,
+ for the condition.
+
+Sat Dec 8 13:01:18 1990 Karl Berry (karl at hayley)
+
+ * {tex,mf}/Makefile ({tex,mf}-extra.o): make a link to $(extrac)
+ and compile it, instead of compiling $(extrac), so that parallel
+ computation work properly.
+
+ * tex/Makefile (latex.fmt, slitex.fmt): the files are called
+ `lplain' and `splain' again, instead of `lplain3' and `splain3'.
+
+Thu Nov 29 10:54:55 1990 Karl Berry (karl at hayley)
+
+ * man/tex.man: don't put @TEXINPUTS@ at the beginning of a line,
+ since it might start with `.' (from
+ kabal@aldebaran.insl.mcgill.ca).
+
+Tue Nov 20 10:21:43 1990 Karl Berry (karl at hayley)
+
+ * MACHINES: add info for ESIX on a 386, from uri@ibm.com.
+
+Mon Nov 19 07:04:10 1990 Karl Berry (karl at hayley)
+
+ * texware/pltotf.ch (System-dependent changes): parse arguments
+ using getopt.
+ * common/common.defines (gargv, optind, getoptstruct,
+ getoptlongonly, addressofint, name, hasarg, flag, val): new
+ definitions.
+ * common/extra.h (addressofint, hasarg, getoptlongonly): new
+ definitions.
+
+Sun Nov 18 08:22:18 1990 Karl Berry (karl at hayley)
+
+ * common/texmf.c (initscreen): use the MFTERM envvar, if set, to
+ determine the user's desired display type.
+ * man/mf.man: document this.
+
+ * common/texmf.c (do_dump): swap the bytes in memory back again
+ after dumping, since we use some of those values.
+
+ * web2c/web2c.yacc (P_F_DEC_PART): allow this to be empty.
+
+ * tex/ctex.ch (\input, \openin changes): allow names like
+ `foo.bar.tex', and look for `foo' before `foo.tex'.
+
+ * common/texmf.c (swap_items): new routine.
+ (do_dump, do_undump): call it, instead of doing bit operations to
+ pack and unpack the bytes.
+
+ * common/endian.c: new file.
+ * common/Makefile (endian.h): new target.
+ (all): make endian.h.
+ * tex/Makefile, mf/Makefile (extrah): add endian.h to the definition.
+
+Tue Nov 13 07:29:45 1990 Karl Berry (karl at hayley)
+
+ * common/extra.c (setpaths): use PATH_DELIMITER instead of ":".
+
+Wed Nov 7 06:44:01 1990 Karl Berry (karl at hayley)
+
+ * common/texmf.c (do_dump): handle dumping 8-byte and 2-byte items.
+ (dump_four): new routine.
+
+ * mf/cmf.ch (clear_terminal): define to do nothing.
+ * tex/ctex.ch (clear_terminal): likewise.
+
+Tue Nov 6 15:02:51 1990 Karl Berry (karl at hayley)
+
+ * common/texmf.h ((un)dumpthings): call new routines, do_(un)dump.
+ * common/texmf.c (do_(un)dump): define them to always write and
+ read BigEndian files.x
+
+ * common/texmf.h (generic_(un)dump): call (un)dumpthings.
+
+ These changes from rusty@belch.berkeley.edu:
+ * web/Makefile (veryclean): remove tangle.h.
+
+ * web2c/Makefile (clean): remove lex.yy.c.
+
+ * Makefile (LN): new variable.
+ (triptrap): pass LN down.
+ * mf/Makefile, tex/Makefile: use $(LN) instead of `ln'.
+
+ * site.h-dist (schar) [ANSI]: define to be signed char (from
+ lgy@newton.phys.washington.edu).
+
+Sun Nov 4 09:32:55 1990 Karl Berry (karl at hayley)
+
+ * README.WEB2C: Advertise TUG.
+
+ * mf/Makefile (cmmf.base): input cmbase, not cm.
+
+ * These changes suggested by chris@mimsy.umd.edu:
+ * common/texmf.c (bsd_clear_terminal, bsd_wake_up_terminal):
+ remove these, since the user should control the terminal.
+ * common/texmf.h (same) [BSD]: remove ifdef's that used
+ those routines.
+ * tex/ctex.ch (clear_terminal): define to do nothing.
+
+ * common/texmf.c: do not include <sys/fcntl.h>, since we don't
+ use the fcntl system call.
+
+Thu Nov 1 08:53:47 1990 Karl Berry (karl at hayley)
+
+ * bibtex/Makefile (bibtex.o): do -Dbswap=bswapp.
+
+ * mfware/Makefile (mft.o): do -Dlink=link_array.
+
+ * Makefile (INSTALL): use -c, for Ultrix's sake.
+ * install: explicitly exit 0 if $(bindir) et al. exist (from
+ dick@sprite.stanford.edu).
+
+Tue Oct 30 09:08:47 1990 Karl Berry (karl at hayley)
+
+ * tex/ctex.ch (@<Declare act...) (for \openin): try to open the
+ file without the .tex extension.
+
+ * tex/bigtrie.diff: new file (from jmr@nada.kth.se).
+
+Thu Oct 25 08:56:19 1990 Karl Berry (karl at hayley)
+
+ * tex/trie.diff (trie): line got truncated at 80 characters (from
+ piet@cs.ruu.nl).
+
+Tue Oct 23 09:17:57 1990 Karl Berry (karl at hayley)
+
+ * common/texmf.c (input_line, calledit): break lines longer than
+ 80 characters.
+
+Sat Oct 20 11:13:04 1990 Karl Berry (karl at hayley)
+
+ * common/texmf.c (initscreen) [!TRAP]: cosmetic changes.
+
+ * common/extra.c (string_copy): declare in the old C style, not
+ the new.
+
+ * tex/trie.diff: update to new version.
+
+Fri Oct 19 17:38:55 1990 Karl Berry (karl at claude)
+
+ * bibtex/convert: put the sed commands that change (pdstype) to
+ (buftype) back.
+
+ * bibtex/Makefile (bibtex.c): make it depend on `convert'.
+
+ * Makefile (BibTeX): new target.
+
+Fri Oct 12 13:03:58 1990 Karl Berry (karl at spiff.ai.mit.edu)
+
+ * Version 5.8a.
+
+ * mf/fixcoerce.h: restore redefinition of tfmqqqq.
+
+ * common/convert: set a variable to `basename $pascalfile .p`.
+
+ * common/extra.c (do_subdir_path): assign result of expand_colon
+ to dir_list, not temp.
+
+ * web2c/fixwrites.c (main): fix output for pltotf.
+
+Wed Oct 10 16:41:54 1990 Karl Berry (karl at spiff.ai.mit.edu)
+
+ * web2c/fixwrites.c [ANSI] (bare): give definition as a char.
+
+Sun Oct 7 05:02:58 1990 Karl Berry (karl at sprite)
+
+ * common/extra.h (abs): cast the operands to integer, so the tests
+ on quarterwords in Metafont work properly (it took three days to
+ find this one...argh).
+
+Wed Oct 3 14:17:32 1990 Karl Berry (karl at sprite)
+
+ * common/extra.c (S_ISDIR): define if it's not defined, instead of
+ if we're not _POSIX_SOURCE.
+
+ * web2c/fixwrites.c [ANSI] (bare): give prototype as a char.
+
+Wed Oct 3 15:20:34 1990 Karl Berry (karl at hal)
+
+ * tex/Makefile (clean): remove .fmt and .aux files here.
+ * mf/Makefile (clean): remove .base files here.
+
+ * web/Makefile (tangle.p): add an extra sh -c for the sake of the
+ broken AIX sh; also, add $(CFLAGS) to the tangleboot compilation.
+
+Mon Oct 1 10:14:51 1990 Karl Berry (karl at aten)
+
+ * web2c/fixwrites.c: don't extern strcpy et al.
+
+ * mfware/gftopk.ch: fix bobble in banner.
+
+Wed Sep 26 05:56:36 1990 Karl Berry (karl at hayley)
+
+ * common/extra.c (S_ISDIR) [!_POSIX_SOURCE]: define S_ISDIR correctly.
+
+ * common/extra.c (expand_colon): new routine.
+ (do_path, do_subdir_path): call it.
+
+Tue Sep 25 07:24:58 1990 Karl Berry (karl at hayley)
+
+ * common/extra.c (do_path): don't copy from temp if it's null.
+
+ * Makefile (install, install-formats, install-formats): do test -d
+ before running mkdir.
+
+ * Makefile (web-dist, web2c-dist): use the name src-$(version) for
+ the top-level directory.
+
+ * tex/Makefile (run-trip), mf/Makefile (run-trap): throw away the
+ output from the first run.
+
+ * web2c/{web2c,splitup}.c: declare argc as an int.
+
+ * new versions of the web files from DEK, and hence new versions
+ of the change files.
+
+Sun Sep 23 06:24:01 1990 Karl Berry (karl at hayley)
+
+ * bibtex/Makefile (bibtex); put LDFLAGS at the end.
+ * mfware/Makefile (gftodvi): missing ).
+
+Sat Sep 22 07:38:02 1990 Karl Berry (karl at hayley)
+
+ * common/extra.c (do_path): don't replace extra :'s in the middle
+ of the paths.
+ (insert_string): delete.
+
+ * site.h (TEXFONTS_SUBDIR, ...): new symbols.
+ * common/extra.c (setpaths): use them.
+ (do_subdir_path): new routine.
+ (do_path): remove subdirectory stuff.
+
+ * common/fileio.c (open_output): test *f, not f, to see if the
+ open succeeded.
+
+ * common/texmf.c [HANDLE_INTERRUPTS]: include <sys/types.h>, if
+ POSIX.
+
+ * web2c/fixwrites.c: use FILENAMESIZE to define `filename'.
+
+ * web/Makefile (tangle.p): missing a $.
+
+ * common/extra.c (S_ISDIR): new macro.
+ (is_dir): use it.
+
+ * common/common.h: new file.
+ * web2c/web2c.h: include it.
+ * common/extra.h: include it.
+ * web2c/fixwrites.c: include it.
+
+ * web2c/Makefile (web2cl.c): prepend site.h before the lex output,
+ so flex.skel will have the preprocessor symbols defined.
+
+ * web2c/Makefile (fixwrites, splitup, regfix): use LDFLAGS in
+ addition to CFLAGS.
+
+ * Makefile (stamp-web2c): make this depend on the web2c
+ executables, as well as the sources.
+
+ * site.h: another possibility for the OS is POSIX.
+ * web2c/web2c.h [ANSI]: don't declare sprintf if ANSI or
+ _POSIX_SOURCE is defined.
+ [FLEX]: change conditional symbol to FLEX_SCANNER.
+ * web2c/Makefile (web2c): include LEXLIB, not -ll.
+ * web2c/splitup.c: include web2c.h, instead of redefining TRUE,
+ FALSE, sprintf, and the like.
+
+ * common/extra.c (setpaths): use the symbol VFFONTS to initialize
+ the envvar if it is defined.
+ site.h: put in a prototype definition for VFFONTS.
+
+Tue Sep 18 16:45:04 1990 Karl Berry (karl at hayley)
+
+ * Makefile (web-dist): make the directory of the tar file be
+ web2c-<version>, not just `web2c'.
+
+ * common/fileio.c (open_output): try to open the file in the dir
+ specified by TEXMFOUTPUT, if opening it in the cwd fails
+ (suggested by lgy@newton.phys.washington.edu).
+ * man/{tex,mf,bibtex}.man: document this.
+
+Sun Sep 16 07:50:08 1990 Karl Berry (karl at hayley)
+
+ * README, PROBLEMS, PROJECTS: rename with .WEB2C suffix, to be
+ closer to what's on the Unix TeX tape.
+
+Thu Sep 13 07:09:18 1990 Karl Berry (karl at hayley)
+
+ * Makefile (install-manpages): pass SITEDIR in.
+ * man/Makefile (sedscript): remove dependency on
+ $(SITEDIR)/Makefile. (These changes from alien@essex.ac.uk.)
+
+ * tex/bigtex.diff, mf/bigmf.diff: don't increase max_quarterword,
+ thus perhaps saving some memory (from morgan@ics.uci.edu).
+
+Tue Sep 11 06:42:43 1990 Karl Berry (karl at hayley)
+
+ * common/extra.c: don't give getcwd a prototype unless ANSI is
+ defined (from maj@computer-lab.cambridge.ac.uk).
+
+Thu Sep 6 05:56:20 1990 Karl Berry (karl at hayley)
+
+ * Makefile (x11lib), mf/Makefile (x11lib): include Xext.
+
+Tue Sep 4 09:45:54 1990 Karl Berry (karl at hayley)
+
+ * Makefile (install*): use $(proginstall) or $(fileinstall), as
+ appropriate.
+ (fileinstall, proginstall): new variables.
+
+Sun Sep 2 15:51:35 1990 Karl Berry (karl at hayley)
+
+ * site.h-dist (HAVE_GETWD): new option for people who are
+ fortunate enough to have this.
+ * common/extra.c (getcwd) [HAVE_GETWD]: define this in terms of
+ getwd (from morgan@ics.uci.edu).
+
+Fri Aug 31 15:17:19 1990 Karl Berry (karl at hayley)
+
+ * These changes from andy@csvax.cs.caltech.edu.
+
+ * mf/MFwindow/tek.c [SYSV]: define bzero and bcmp as memset and
+ memcmp.
+
+ * common/extra.c: always include <sys/types.h> and <sys/stat.h>,
+ since is_dir needs them.
+
+ * */Makefile (link commands): put $(LDFLAGS) at the end of the
+ command, instead of the beginning.
+
+ * web/Makefile (tangle.p): use an already-compiled tangle if
+ possible, and include LDFLAGS instead of CFLAGS when making tangle
+ from tangleboot.c.
+
+ * site.h-dist (ANSI): say they must have sprintf declared if they
+ defined this.
+
+Thu Aug 30 15:58:05 1990 Karl Berry (karl at hayley)
+
+ * These changes from andy@csvax.cs.caltech.edu.
+
+ * dviutil/dvicopy.ch: don't define cur_name to use text_char.
+
+ * web2c/fixwrites.c: declare bare to take an int, not a char, and
+ define it to return an int.
+
+ * common/extra.h, web2c/web2c.h, web2c/splitup: only declare
+ sprintf if ANSI is not defined, since a prototype with `...'
+ doesn't match a function without a prototype.
+
+Sun Aug 26 10:45:48 1990 Karl Berry (karl at aten)
+
+ * Version 5.0e.
+
+ * Makefile (install-manpages): quote $(INSTALL).
+ * man/Makefile (all, install): make dependent on stamp-manpages, so
+ sed isn't invoked every time.
+ (clean): remove stamp-manpages.
+
+ * MACHINES: add info for the HP9000 machines from
+ mark@comp.vuw.ac.nz.
+
+Sat Aug 25 12:00:50 1990 Karl Berry (karl at hayley)
+
+ * Makefile (alldirs): add `dviutil'.
+ (install): install dvicopy.
+
+ * common/extra.c (do_path): add a null after the path delimiter.
+
+ * dviutil/dvicopy.ch: restore lines truncated in transmission.
+ * dviutil/Makefile: prepend `.' to suffix lines.
+
+Thu Aug 23 06:44:28 1990 Karl Berry (karl at claude)
+
+ * {tex,mf}/Makefile (triptex, trapmf): make dependent on $(iobjs)
+ and $(commono).
+
+ * common/extra.c (do_path): don't take strlen of an integer.
+
+ * web2c/Makefile (veryclean): remove yacc.*.
+
+Wed Aug 22 06:16:03 1990 Karl Berry (karl at hayley)
+
+ * Makefile (FORMATINSTALL): new variable; defines installation
+ commands for .fmt's and .base's.
+
+ * common/extra.c (do_path): use PATH_DELIMITER instead of ':'.
+
+ * {tex,mf}/Makefile: use tex.fmt and mf.base when making other
+ formats or bases.
+
+ * Makefile (YACC, LEX): new variables.
+ (stamp-web2c): pass them down when compiling web2c.
+
+ * common/extra.c (do_path): do chdirs to the directories in the
+ path.
+
+ * common/extra.{c,h} (ztoint) [sequent]: remove this, since
+ the Sequent compiler doesn't have the casting problem any more.
+
+Thu Aug 16 15:24:02 1990 Karl Berry (karl at apollo)
+
+ * common/extra.c (do_path): don't look for subdirectories if we
+ used the default value (sometimes).
+
+ * common/extra.c (do_path): only look for subdirectories
+ conditionally.
+ (setpaths): don't look for subdirectories in all paths.
+
+ * common/extra.c (do_path): don't clobber the path as we check for
+ subdirectories.
+
+ * tex/Makefile (run-trip), mf/Makefile (run-trap): remove
+ trip.tex/trap.mf before linking
+
+Wed Aug 15 08:45:28 1990 Karl Berry (karl at hayley)
+
+ * web/tangleboot.{pas,c}: update these.
+
+ * Makefile (install-formats, install-bases, install): move the
+ commands for the first two from the third.
+
+ * mfware/mft.ch (open_input): use MF_INPUT_PATH to open the .mf
+ file.
+ * man/mft.man: document this.
+
+ * site.h (MAXPATHLEN): remove this; we allocate the storage
+ dynamically now.
+ * man/{tex,mf}.man: don't refer to MAXPATHLEN.
+ * common/extra.c (xmalloc, xrealloc): new routines.
+
+ * common/extra.c (do_path): find all the subdirectories here, and
+ add them to the path.
+ (testreadaccess): remove the subdirectory checking here.
+
+ * tex/ctex.ch (\S552): initialize bchar_label[null_font], et al.,
+ to avoid arbitrary font_info data as being interpreted as lig/kern
+ programs (from Chris Thompson).
+
+ * common/extra.c (setpaths): take an argument saying which paths
+ to initialize.
+ * common/common.defines (setpaths): declare to be a procedure with
+ parameters.
+ * common/extra.h (...PATHBIT): new macros to define that argument.
+ * common/common.defines (...PATHBIT): make them available to the
+ change files.
+ * bibtex/bibtex.ch (get_the_top_level_aux_file_name),
+ fontutil/pktogf.ch (PK_to_GF), pktype.ch (PKtype), vftovp.ch
+ (VFtoVP), mfware/gftodvi.ch (GFtoDVI), gftopk.ch (initialize),
+ gftype.ch (initialize), mft.ch (scan_args), texware/dvitype.ch
+ (DVItype), dviutil/dvicopy.ch (DVIcopy), mf/cmf.ch, tex/ctex.ch:
+ change call to set_paths.
+
+ * common/{extra.c, extra.h, common.defines): define another
+ path-searching constant, VFFILEPATH, which uses the environment
+ variable VFFONTS.
+ * dviutil: new subdirectory to hold dvicopy, whose change file
+ uses VFFILEPATH (from xitikgun@ddathd21.bitnet).
+ * fontutil/vftovp.ch: use VFFILEPATH.
+ * man/vftovp.man: document this.
+
+ * common/{extra,fileio}.c (terminate_with_space,
+ terminate_with_null): rename to `end_with_space' and
+ `end_with_null', so brain-dead linkers that only look at the first
+ 16 characters don't break.
+
+Tue Aug 14 11:32:35 1990 Karl Berry (karl at aten)
+
+ * common/extra.c (do_path): allocate an extra byte for the
+ trailing null.
+
+Mon Aug 13 14:45:06 1990 Karl Berry (karl at aten)
+
+ * Makefile (fmts): add picplus.
+ * tex/Makefile (fmts): likewise.
+
+ * man/Makefile (manfiles): remove trailing \ from last item in list.
+
+ * {bibtex,mf,tex}/Makefile: remove form feeds.
+
+Sun Aug 12 10:23:12 1990 Karl Berry (karl at hayley)
+
+ * web/tangle.ch (scan_args): if a `.' occurs before a `/' in a
+ filename, don't count it as starting the extension.
+ * web/weave.ch (scan_args): likewise.
+ Probably other programs need to be fixed in the same way.
+
+ * common/convert: pass the name of file being converted to
+ fixwrites.
+ * web2c/fixwrites.c: convert vptovf error messages properly.
+ (These changes from rokicki@neon.stanford.edu.)
+
+Fri Aug 10 09:02:31 1990 Karl Berry (karl at hayley)
+
+ * mf/cmf.ch: fix another casting problem (from
+ xitikgun@ddathd21.bitnet).
+
+Wed Aug 8 06:43:28 1990 Karl Berry (karl at hayley)
+
+ * common/extra.c (DO_PATH): replace this macro with a routine, and
+ expand extra `:'s into the system default.
+ (insert_string): new routine.
+ * site.h: warn them not to put extra `:'s in the system default.
+ * man/{almost everything}: document this.
+
+ * mfware/gftodvi.ch, fontutil/vftovp.ch: break up huge case
+ statement (from maj@computer-lab.cambridge.ac.uk).
+ * PROBLEMS: remove old fix for the huge case statements.
+
+Tue Aug 7 07:19:32 1990 Karl Berry (karl at hayley)
+
+ * mf/Makefile (run-trap): run `./trapmf', not just `trapmf'.
+ * tex/Makefile (run-trip): analogously.
+ * Makefile (web2c-dist): rename site.h to site.h-dist.
+ (These changes from dorab@twinsun.com.)
+
+Fri Aug 3 15:55:53 1990 Karl Berry (karl at hayley)
+
+ * Makefile (install): add links for plain.fmt and plain.base.
+
+ * PROBLEMS: add patches for the 3b2 for the old TeX (from
+ oc@vmp.com).
+
+Tue Jul 31 11:43:38 1990 Karl Berry (karl at hayley)
+
+ * mf/Makefile: add missing quote (from dick@sprite.stanford.edu).
+
+Fri Jul 13 06:48:15 1990 Karl Berry (karl at hayley)
+
+ * Makefile: remove ^L's.
+
+Sun Jul 8 06:44:06 1990 Karl Berry (karl at hayley)
+
+ * common/extra.c (fprint_pascal_string): new routine.
+ (printpascalstring): call it.
+ (errprintpascalstring): new routine.
+ * common/common.defines: declare errprintpascalstring.
+ * texware/dvitype.ch: use it when printing the TFM file name.
+
+ * common/extra.c (READABLE_FILE): new macro.
+ (testreadaccess): use it, instead of using access(2) directly.
+
+ * tex/trie.h: delete.
+ * tex/trie.diff: new file with diffs for a larger trie size (from
+ xitikgun@ddathd21.bitnet).
+ * common/texmf.defines: remove trie definitions.
+
+ * bibtex/bibtex32.diff: new file with diffs for a big BibTeX (from
+ beebe@science.utah.edu).
+
+ * mf/trapenv: define GFFONTS.
+
+Mon Jun 18 08:37:41 1990 Karl Berry (karl at hayley)
+
+ * site.h (schar) [AIX]: define to be INT.
+ * web2c/web2c.yacc (SIMPLE_TYPE): output UNSIGNED_SHORT_STRING
+ instead of "unsigned short", and define the former to be "int" for
+ AIX.
+
+Thu May 31 14:14:18 1990 Karl Berry (karl at aten)
+
+ * common/fileio.c (open_input): don't call funny_core_dump if
+ we're bibtex.
+
+ * common/extra.c (is_dir): don't declare as static.
+
+ * web2c/{fixwrites,regfix}.c (remove_newline): don't use
+ ANSI-style declarations.
+
+ * mf/MFwindow/x11-Xt.c: declare functions as static, if they're
+ defined that way.
+
+ * mf/MFwindow/x10.c (sprintf): don't declare it.
+
+ * common/texmf.c (funny_core_dump): don't define as static.
+
+ * web/tangle.ch: incorporate changes to only open the pool file if
+ it's actually used (from xitigkun@ddathd21.bitnet).
+
+Wed May 30 07:10:10 1990 Karl Berry (karl at hayley)
+
+ * common/extra.c (testreadaccess): initialize ok to zero, improve
+ the loop logic.
+
+Sun May 27 10:21:22 1990 Karl Berry (karl at hayley)
+
+ * common/extra.h, web2c/splitup.c, web2c/web2c.h: declare sprintf
+ using SPRINTF_RETURN_TYPE.
+ * site.h: define it.
+
+Sat May 26 07:55:54 1990 Karl Berry (karl at hayley)
+
+ * common/texmf.c (input_line): do not worry about NONASCII or
+ characters going out of range when we fill up `buffer'.
+
+ * web2c/{fixwrites,regfix}.c: replace calls to gets(3) with calls
+ to fgets(3).
+
+ * tex/trie.h: new file to help implement larger hyphenation tries.
+ * common/common.defines (trl, trc, tro, trb, trieentry): new
+ fields and a type, for the same reason.
+ (from xitikgun@ddathd21.bitnet, but the diff to ctex.ch has not
+ been created yet).
+
+ * common/texmf.c, mf/MFwindow/uniterm.c: merge Uniterm support
+ from T. Hageman.
+
+Tue May 22 09:56:01 1990 Karl Berry (karl at hayley)
+
+ * common/extra.c (testreadaccess): close the directories in the
+ path after we search them for subdirectories.
+
+ * tex/tex-extra.c (main): set up TEXformatdefault with the format
+ from the program name, instead of the first line of input (from
+ ramshaw@src.dec.com).
+
+Sun May 20 12:03:12 1990 Karl Berry (karl at hayley)
+
+ * web/tangle.ch (<Get |web_file_name|...>): make sure the web name
+ ends with a space. Ditto for the change file.
+
+Thu May 17 10:43:00 1990 Karl Berry (karl at hayley)
+
+ * web2c/web2c.c (initialize): check the result of the fopen (from
+ lonhyn@gulag.nas.nasa.gov).
+
+Mon May 14 07:16:47 1990 Karl Berry (karl at hayley)
+
+ * texware/dvitype.ch: use testreadaccess and other common
+ routines; output to stdout.
+ * web/{tangle,weave}.ch: use common routines.
+
+ * fontutil/{extra.?, futil.defines, convert}: move to new
+ subdirectory `common'.
+
+ * tex/Makefile (run-trip): set the environment before running
+ triptex.
+ tripenv: new file.
+ * mf/Makefile, mf/trapenv: analogously.
+
+Sun May 13 10:09:02 1990 Karl Berry (karl at hayley)
+
+ * web2c/web2c.c (main): only print the number of symbols if
+ `debug' is set.
+
+ * texware/texware.h (unsignedcharargv): new macro for dvitype.
+
+ * {texware/texware.h, mfware/mfware.h} (reset, rewrite): cast the
+ filename argument to char *.
+
+ * web2c/web2c.yacc (do_proc_args): add an & if we're generating
+ ANSI code, and have a var parameter (from andy@csvax.caltech.edu).
+
+ * defaults.h [High C on an IBM]: add pragma's (from bells@ibm.com).
+
+ * tex/ctex.ch (a_open_in): try to open the input file without
+ .tex, if opening with .tex fails (from Tom Hageman via
+ vens@hgrrug5.bitnet).
+
+ * {mf,tex}/extra.c (calledit) [NONASCII]: use xchr (from Tom
+ Hageman via vens@hgrrug5.bitnet).
+
+ * Makefile (run-triptrap): split up into two targets, run-trip and
+ run-trap.
+
+ * tex/Makefile (fmts): new target.
+ (tex.fmt, et al.): run initex to make these.
+ * mf/Makefile (bases): new target.
+ (mf.base, cmmf.base): run inimf to make these.
+ (From beebe@science.utah.edu.)
+
+ * Makefile (manpages, install-manpages): new targets.
+ man: new directory with the man pages
+ (from ken@cs.rochester.edu).
+
+ * mfware/gftodvi.ch (open_gf_file): don't bother defining
+ packed_font_file_path, since we don't use it.
+ * mfware/gftype.ch (open_gf_file): ditto.
+
+Sun May 6 08:24:27 1990 Karl Berry (karl at hayley)
+
+ (All the following from andy@csvax.caltech.edu)
+ * web2c/web2c.lex (input, unput): declare if they're not #defined.
+
+ * web/weavext.c (strcpy, strcat): add `const'.
+
+ * mfware/mfwarext.c (sprintf): declare differently for SYSV and ANSI.
+ tex/extra.c, mf/extra.c, web/tanglext.c, texware/texwarext.c: ditto.
+
+ * mfware/mfware.h (openf) [ANSI]: declare it.
+
+ * fontutil/extra.c (testreadaccess): handle absolute path names
+ correctly.
+
+ * web/Makefile (tangle.p): do `./tangle' instead of `tangle',
+ since not everyone has . in their path (from
+ beebe@science.utah.edu).
+
+Sat May 5 12:17:32 1990 Karl Berry (karl at hayley)
+
+ * texware/{pltotf,tftopl}.ch (main): don't print a newline at the
+ end.
+
+ * web2c/web2c.yacc (FUNCTION_HEAD): only print the function name
+ if debug is true.
+
+ * mfware/gftopk.ch (comment): increase array size by one, to leave
+ room for the trailing null.
+
+ * mfware/Makefile (CFLAGS): remove -Dlink=link_array.
+
+Fri May 4 21:51:16 1990 Karl Berry (karl at hayley)
+
+ * mfware/gftodvi.ch (open_tfm_file): use tex_font_file_path, not
+ generic_font_file_path (from morgan@ics.uci.edu).
+
+Fri Apr 27 07:22:50 1990 Karl Berry (karl at hayley)
+
+ * Makefile (install): make work with install, not just cp (from
+ grunwald@foobar.colorado.edu).
+
+ * tex/ctex.ch: define hash_size and hash_prime, so that LaTeX
+ works with the small TeX.
+
+ * web2c/web2c.c [HP]: yytext is an unsigned char (from
+ pfs@kc.abdn.ac.uk).
+
+ * mf/extra.c (calledit): remove the xor with 0x80.
+
+ * site.h: warn about bibtex and -DANSI not mixing.
+
+Wed Apr 18 11:44:49 1990 Karl Berry (karl at aten)
+
+ * Version 5.0c. (5.0b was released by Tim.)
+
+ * web/Makefile: (.ch.p): invoke ./tangle instead of `tangle'.
+
+ * site.h: change default glueratio to `float'.
+
+ * web/Makefile (tangle.p): put the ``until...done'' in an sh -c,
+ for the sake of Ultrix (from maj@computer-lab.cambridge.ac.uk).
+
+ * PROBLEMS: add patch for yacc problem (from justin@crim.ca).
+
+Mon Apr 16 08:03:52 1990 Karl Berry (karl at hayley)
+
+ * site.h: do not unconditionally (un)define the symbols.
+
+Thu Apr 12 21:33:41 1990 Karl Berry (karl at hayley)
+
+ * tex/extra.c (calledit): do not xor with 0x80 (from
+ ekrell@ulysses.att.com).
+
+Fri Apr 6 20:40:20 1990 Karl Berry (karl at hayley)
+
+ * {tex,mf}/extra.c (zinputln): have to test against 255, not 127.
+
+ * web/Makefile: touch tangle.h (from colin@umist.ac.uk).
+
+Wed Apr 4 16:10:03 1990 Karl Berry (karl at aten)
+
+ * PROBLEMS: cc and gftodvi/vftovp don't mix.
+
+Thu Mar 29 07:50:15 1990 Karl Berry (karl at mole.ai.mit.edu)
+
+ * Version 5.0a (with ken's changes to the change files).
+
+Tue Mar 27 08:01:20 1990 Karl Berry (karl at hayley)
+
+ * web2c/web2c.yacc (FUNCTION_HEAD): check for debug before
+ printing out the function name.
+
+ * texware/Makefile (pltotf): don't put this on two lines.
+
+Fri Mar 23 18:46:49 1990 Karl Berry (karl at aten)
+
+ * Version 4.893c.
+
+ * web2c/Makefile: do test ... instead of [ ... ].
+ mf/MFwindow/Makefile: use $(SHELL) instead of /bin/sh.
+
+Thu Mar 22 18:20:38 1990 Karl Berry (karl at aten)
+
+ * texware/dvitypext.c: declare packrealnameoffile to be void, even
+ if ANSI is not defined, else Ultrix loses.
+
+Fri Mar 9 08:38:56 1990 Karl Berry (karl at hayley)
+
+ * defaults.h, site.h: move ANSI from the former back to the
+ latter, since some systems want it.
+
+ * bibtex/bibtex.ch (int_to_ASCII): use `the_int' instead of `int'
+ as the first parameter name; some cc's bomb with `int'.
+ (from rusty@garnet.berkeley.edu)
+
+ * texware/dvitypext.c (packrealnameoffile): return type is void.
+
+ * */Makefile (veryclean): remove backup files, core files.
+ */Makefile: use $(SHELL) ./<script> instead of ./<script>.
+ web/Makefile: define SHELL.
+ (mackay@cs.washington.edu supplied these changes.)
+
+Fri Mar 2 17:27:22 1990 Karl Berry (karl at hayley)
+
+ * texware/dvitype.ch: make input be 8 bits, like the rest of the
+ programs.
+
+Sun Feb 25 20:36:19 1990 Karl Berry (karl at hayley)
+
+ * {mf,tex}/ini_to_tr[ai]p: save the .h file we're editing.
+
+Thu Feb 22 21:06:49 1990 Karl Berry (karl at hayley)
+
+ * */Makefile: change $(RM) to rm.
+
+ * texware/texware.h: do not cast the result of getc to char, for
+ the sake of Ultrix.
+
+Sat Feb 17 07:36:50 1990 Karl Berry (karl at hayley)
+
+ * README: Make the instructions for bootstrapping tangle correct.
+
+ * Makefile (dist): tangleboot.pas is in web, not web2c.
+
+ * {mfware,texware,web,web2c}/Makefile: remove $(CFLAGS) from the
+ load lines.
+
+ * bibtex/bibext.c: move conditional on BSD to after #include
+ "site.h" (from bsuggs@hac.arpa.com).
+
+ * web2c/Makefile (web2cy.c): do `-if', since one of the commands
+ exits with bad status under Ultrix.
+
+bibtex:
+Mon Feb 21 14:49:52 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: srcdir changes from simon.
+
+Wed Feb 2 11:00:09 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Mon Jan 24 07:33:17 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Sun Nov 7 14:26:23 1993 Karl Berry (karl@cs.umb.edu)
+
+ * convert: Remove call to sync.
+
+Fri Nov 5 15:50:55 1993 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.ch (option_index): Declare as int.
+
+Tue Oct 12 14:07:15 1993 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.ch (verbose): Declare as int.
+
+Sun Oct 3 12:41:46 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (cbibtex.ch): Don't chmod 444.
+ (commonh): paths.h is in kpathsea.
+ (commono): kpathsea.a has its own variable now.
+ (*clean): Include standard targets.
+ (program): New variable.
+
+Sun May 23 06:17:53 1993 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.ch (max_bib_files): Increase to 1000.
+
+Sun May 9 10:10:01 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Remove $(srcdir) for paths.h.
+ (commono): Add kpathsea library.
+
+Fri Apr 30 15:07:24 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Add paths.h.
+
+Sat Apr 10 16:41:18 1993 Karl Berry (karl@cs.umb.edu)
+
+ * convert: Don't sync unless /bin/sync exists.
+
+Fri Apr 9 16:07:24 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Define as config.h.
+
+Thu Mar 25 16:59:08 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (openinout.c): Remove the file before making the link.
+
+Sat Mar 13 11:44:46 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (CPPFLAGS): Add @DEFS@, for -DHAVE_CONFIG_H.
+
+ * convert: Use cpascal.h instead of pascal.h.
+
+Sun Feb 21 08:27:23 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Version 5.851d.
+
+Fri Feb 19 13:21:01 1993 Karl Berry (karl@cs.umb.edu)
+
+ * small.sed (max_ent_strs): Restore to 3000.
+
+Tue Feb 16 17:53:06 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec, install-data): New targets.
+
+Mon Feb 15 12:06:14 1993 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.ch (27): Allow any character as input.
+
+Tue Jan 26 17:09:10 1993 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.ch (banner): Use version_string.
+
+Sun Jan 3 13:28:45 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Remove Makefile.
+
+Thu Dec 17 07:36:44 1992 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.ch (198): @d int == `the_int', instead of doing the
+ substitution ourselves.
+
+ * bibtex.ch: Move command-line processing to the existing section
+ that handles it.
+
+ * Makefile.in (libs): $(fileio) => $(fileioo).
+
+Wed Dec 16 18:03:32 1992 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.ch: Put in option parsing; make min_crossrefs a variable,
+ instead of a constant.
+
+Sun Dec 13 14:24:35 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (c-sources): New target.
+
+Sat Dec 12 14:07:37 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+ * small.sed: New file to replace small.diff.
+
+Mon Nov 16 08:09:07 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile (cbibtex.ch): New target. (Copy from bibtex.ch.)
+
+ * bibtex.ch (lex_class): Make RET be white_space.
+
+Sun Nov 1 16:20:05 1992 Kathy Hargreaves (letters@red.cs.umb.edu)
+
+ * bibtex.ch (max_bib_files): increase to 100.
+
+Thu Sep 24 11:04:03 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile (openinout.c): avoid use of $<.
+
+Fri Sep 4 08:58:58 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+ (distclean): don't remove backup files etc. here.
+
+Wed Aug 19 08:39:55 1992 Karl Berry (karl@hayley)
+
+ * Makefile (openinout.c): new target.
+ (clean): remove it.
+
+Wed Aug 12 16:16:28 1992 Karl Berry (karl@hayley)
+
+ * Makefile (fileioo): use the default compilation rule.
+
+Wed Jul 15 11:52:40 1992 Karl Berry (karl@hayley)
+
+ * bibtex.ch, small.diff: don't change the value of min_crossrefs.
+
+Sun Jul 5 07:23:23 1992 Karl Berry (karl@hayley)
+
+ * convert (sed): change `/bin/sed' to `sed'.
+
+ * bibtex.ch: avoid lines >= 80 chars.
+
+Fri Jul 3 11:59:50 1992 Karl Berry (karl@hayley)
+
+ * Makefile (bibtex.p): depend on cbibtex.ch, not bibtex.ch.
+
+Thu Jul 2 16:04:37 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CPPFLAGS): new variable
+ (.c.o): use it.
+ (cflags): change to CFLAGS.
+
+Thu May 14 19:21:10 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Sat Apr 25 09:18:17 1992 Karl Berry (karl@hayley)
+
+ * convert: sync after the pipe.
+
+ * Makefile (libs): new var to abbreviate `../libs.a $(LIBS)'.
+ (bibtex): use it.
+
+ * Makefile (distclean): new target.
+
+Thu Apr 23 12:07:32 1992 Karl Berry (karl@hayley)
+
+ * Makefile: fix clean targets (from Andreas).
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Sun Apr 12 11:46:24 1992 Karl Berry (karl@hayley)
+
+ * bibtex.ch: use BSTINPUTS to look for the BST file instead of
+ TEXINPUTS.
+
+Sat Apr 11 10:31:57 1992 Karl Berry (karl@hayley)
+
+ * bibtex.ch (388): remove mutually exclusive test, instead of
+ fixing it.
+
+Fri Apr 10 17:26:30 1992 Karl Berry (karl@hayley)
+
+ * small.diff: remake this so it works properly.
+
+ * Makefile (mostlyclean): remove cbibtex.ch.
+ (.ch.p): tangle with cbibtex.ch.
+
+Fri Apr 3 09:53:25 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Mon Mar 30 11:20:11 1992 Karl Berry (karl at hayley)
+
+ * bibtex.ch (388): fix mutually exclusive tests.
+
+Fri Mar 20 16:14:05 1992 Karl Berry (karl at hayley)
+
+ * Makefile (mostlyclean): new name for `clean'.
+ (clean): what `realclean' used to be.
+ (realclean): nothing to do anymore.
+ (install): install the program.
+
+Fri Jan 24 09:08:31 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+ * bibtex.ch (max_ent_strs): reduce to 10000, as the previous value
+ allocated 2.5MB (even this allocates 1MB).
+
+Sun Jan 12 09:16:54 1992 Karl Berry (karl at hayley)
+
+ * Makefile (bibtex.o): remove -Dbswap=bswapp. Why did I do this?
+
+ * Makefile (fileioh): no longer exists.
+
+ * convert (../common): now ../lib.
+
+Sat Jan 11 16:53:05 1992 Karl Berry (karl at hayley)
+
+ * bibtex.ch (FILENAMESIZE): rename to `PATH_MAX'.
+
+ * Makefile: redo for new configuration.
+
+Tue Jan 7 16:09:55 1992 Karl Berry (karl at hayley)
+
+ * bibtex.ch (10/main program): exit with bad status if history >
+ warning_message.
+Mon Feb 21 14:50:08 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: srcdir changes from simon.
+
+Thu Feb 10 10:00:49 1994 Karl Berry (karl@cs.umb.edu)
+
+ * dvicopy.ch: Don't print fontname twice when it can't be opened.
+ Increase table sizes.
+
+dviutil:
+Wed Feb 2 11:00:09 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Mon Jan 24 07:33:33 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Tue Oct 12 13:35:28 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Simplify kpathsea references.
+
+Sun Oct 3 12:56:06 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): paths.h is in kpathsea.
+ (commono): kpathsea.a has its own variable now.
+ (*clean): Include standard targets.
+ (program): New variable.
+ (install): Use it.
+
+Fri May 21 14:08:08 1993 Karl Berry (karl@cs.umb.edu)
+
+ * dvitype.ch (open_{dvi,tfm}_file): Don't declare unused variable i.
+
+Sun May 9 10:10:48 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Remove $(srcdir) for paths.h.
+ (commono): Add kpathsea library.
+
+Fri Apr 30 15:07:41 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Add paths.h.
+
+Fri Apr 9 16:07:39 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Define as config.h.
+
+Sat Mar 13 12:10:31 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (CPPFLAGS): Add @DEFS@, for -DHAVE_CONFIG_H.
+
+Sun Feb 21 08:27:57 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Version 5.851d.
+
+Tue Feb 16 17:53:43 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec, install-data): New targets.
+
+Tue Jan 26 16:38:05 1993 Karl Berry (karl@cs.umb.edu)
+
+ * *.ch (banner): Use version_string.
+
+ * Makefile.in: Merge dvitype from texware.
+
+Sun Jan 3 13:29:30 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Remove Makefile.
+
+Sun Dec 13 14:25:12 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (c-sources): New target.
+
+Sat Dec 12 14:52:23 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+Fri Sep 4 09:00:58 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+ (distclean): don't remove backup files etc. here.
+
+Thu Jul 2 16:06:12 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CPPFLAGS): new variable
+ (.c.o): use it.
+ (cflags): change to CFLAGS.
+
+Thu May 14 19:21:26 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Fri Apr 3 09:54:34 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Fri Mar 20 16:21:18 1992 Karl Berry (karl at hayley)
+
+ * Makefile (mostlyclean): new name for `clean'.
+ (clean): what `realclean' used to be.
+ (realclean): nothing to do anymore.
+ (install): install the program.
+
+Fri Jan 24 09:21:22 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+Sun Jan 12 08:49:00 1992 Karl Berry (karl at hayley)
+
+ * dvicopy.ch: `cwd_test_read_access' is gone.
+
+Following is the ChangeLog from texware, before I merged the contents
+of that directory with the others. (26 January 1993)
+
+Sat Jan 23 10:23:08 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tftopl.ch: Output error messages to stderr.
+
+Sun Jan 3 13:33:35 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Remove Makefile.
+
+Fri Dec 18 13:16:08 1992 Karl Berry (karl@cs.umb.edu)
+
+ * tftopl.c (Set init...): Extend `tfm_name' with ".tfm" if necessary.
+
+Sun Dec 13 14:28:24 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (c-sources): New target.
+
+Sat Dec 12 15:23:14 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+Fri Sep 4 09:04:31 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+ (distclean): don't remove backup files etc. here.
+
+Wed Aug 19 08:27:16 1992 Karl Berry (karl@hayley)
+
+ * Makefile (tftopl.o): use default compilation rule.
+
+ * pltotf.ch: rename `index' to `index_var'.
+
+Wed Aug 12 16:34:13 1992 Karl Berry (karl@hayley)
+
+ * Makefile (pltotf.o): use default compilation rule.
+
+Thu Jul 2 16:09:37 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CPPFLAGS): new variable
+ (.c.o): use it.
+ (cflags): change to CFLAGS.
+
+Thu Jun 4 08:18:28 1992 Karl Berry (karl@hayley)
+
+ * {tftopl,pltotf}.ch: rename `class' to `class_var' because of AIX
+ brain-damage.
+
+Thu May 14 19:22:33 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Sat Apr 25 09:38:16 1992 Karl Berry (karl@hayley)
+
+ * Makefile (distclean): new target.
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Fri Apr 3 09:56:04 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Sat Mar 21 11:40:36 1992 Karl Berry (karl at hayley)
+
+ * Makefile (patgen): use patgen2.
+ * patgen2.{web,ch}: new files.
+
+Fri Mar 20 16:29:58 1992 Karl Berry (karl at hayley)
+
+ * Makefile (mostlyclean): new name for `clean'.
+ (clean): what `realclean' used to be.
+ (realclean): nothing to do anymore.
+ (install): install the program.
+
+Wed Mar 18 09:09:54 1992 Karl Berry (karl at hayley)
+
+ * dvitype.ch (max_widths): increase to 25000.
+
+Sun Feb 2 07:54:09 1992 Karl Berry (karl at hayley)
+
+ * tftopl.ch (argument_is): change `option_table' to
+ `long_options', for the new getopt.
+
+Fri Jan 24 09:20:36 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+Sun Jan 12 07:49:54 1992 Karl Berry (karl at hayley)
+
+ * tftopl.ch: `cwd_test_read_access' is gone.
+
+ * Makefile (vftovp.o, vptovf.o): remove the -Dlink, as it is now
+ in common.h.
+
+Wed Jan 8 07:43:23 1992 Karl Berry (karl at hayley)
+
+ * tftopl.ch (cast_to_pointer_to_byte): the name seems to be
+ `cast_to_byte_pointer'.
+
+fontutil:
+Mon Feb 21 14:30:23 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: srcdir changes from simon.
+
+ * gftodmem.h: Move to ../lib.
+
+Wed Feb 2 11:00:09 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Mon Jan 24 07:33:41 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Sat Nov 6 13:46:52 1993 Karl Berry (karl@cs.umb.edu)
+
+ * vftovp.ch (out_char): Don't offset index into xchr by 31. From
+ dak@pool.informatik.rwth-aachen.de.
+
+ * tftopl.ch (Usage): Squeeze onto one line.
+
+Fri Nov 5 15:49:15 1993 Karl Berry (karl@cs.umb.edu)
+
+ * {gftodvi,vftovp,vptovf,pltotf,tftopl}.ch (option_index): Declare
+ as int.
+
+Tue Oct 12 14:07:42 1993 Karl Berry (karl@cs.umb.edu)
+
+ * gftodvi.ch (verbose): Declare as int.
+ * {pl,tf}to{tf,pl}.ch: Likewise.
+ * {vf,vp}to{vp,vf}.ch: Likewise.
+
+Sun Oct 3 13:00:05 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): paths.h is in kpathsea.
+ (commono): kpathsea.a has its own variable now.
+ (*clean): Include standard targets.
+ (program): New variable.
+ (install): Use it.
+
+Fri May 21 14:09:13 1993 Karl Berry (karl@cs.umb.edu)
+
+ * gf{type,topk}.ch (open_gf_file): Remove unused var j.
+ * pk{type,togf}.ch (open_pk_file): Likewise.
+
+Fri May 14 14:36:50 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tftopl.ch (index_var): Oops, that's a type, not a variable.
+
+Sun May 9 10:10:51 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Remove $(srcdir) for paths.h.
+ (commono): Add kpathsea library.
+
+Thu May 6 16:04:32 1993 Karl Berry (karl@cs.umb.edu)
+
+ * pktype.ch (53): Expand out writeln statement to avoid undefined
+ evaluation order problem.
+
+Fri Apr 30 15:07:43 1993 Karl Berry (karl@cs.umb.edu)
+
+ * vptovf.ch, vftovp.ch, mft.ch (class): Rename to `class_var'.
+
+ * Makefile.in (commonh): Add paths.h.
+
+Fri Apr 9 16:07:42 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Define as config.h.
+
+Sat Mar 13 11:24:09 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (CPPFLAGS): Add @DEFS@, for -DHAVE_CONFIG_H.
+
+ * pktogf.ch (37): Do addition of 2 2^31's in two assignments, to
+ avoid compiler rearrangements.
+
+Sun Feb 21 08:27:39 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Version 5.851d.
+
+Tue Feb 16 17:53:48 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec, install-data): New targets.
+
+Tue Jan 26 16:19:58 1993 Karl Berry (karl@cs.umb.edu)
+
+ * *.ch (banner): Use version_string.
+
+ * Merge mfware and tftopl/pltotf.
+
+Sun Dec 13 14:26:16 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (c-sources): New target.
+
+Sun Jan 10 16:07:32 1993 Karl Berry (karl@cs.umb.edu)
+
+ * gftopk.ch (max_row): Increase to 100,000. (From Wayne Sullivan.)
+
+Sun Jan 3 13:32:20 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Remove Makefile.
+
+Sun Dec 13 14:27:45 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (c-sources): New target.
+
+Sat Dec 12 14:59:21 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+Fri Sep 4 09:01:36 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+ (distclean): don't remove backup files etc. here.
+
+Wed Aug 12 16:17:10 1992 Karl Berry (karl@hayley)
+
+ * {vf,vp}to{vp,vf}.ch (index): @d to be `index_type'.
+ * Makefile ({vf,vp}to{vp,vf}.o): use default compilation rule.
+
+ * Makefile (CPPFLAGS): new variable
+ (.c.o): use it.
+ (cflags): change to CFLAGS.
+
+Sun Jun 21 09:20:35 1992 Karl Berry (karl@io)
+
+ * vftovp.ch: don't compare o to set_char_0, since that's always true.
+
+Thu May 14 19:21:32 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Fri Apr 10 15:13:27 1992 Karl Berry (karl@hayley)
+
+ * gftopk.ch (81--83): don't add anything to the font comment.
+
+Fri Apr 3 09:54:48 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Thu Mar 26 07:00:04 1992 Karl Berry (karl at hayley)
+
+ * Makefile (clean): don't remove *.h, as gftodmem.h goes away.
+
+Fri Mar 20 16:23:32 1992 Karl Berry (karl at hayley)
+
+ * Makefile (mostlyclean): new name for `clean'.
+ (clean): what `realclean' used to be.
+ (realclean): nothing to do anymore.
+ (install): install the program.
+
+Sun Feb 2 08:01:42 1992 Karl Berry (karl at hayley)
+
+ * vftovp.ch (argument_is): use `long_options', not `option_table'.
+
+ * gftodvi.ch (argument_is): use `long_options' instead of
+ `option_table'.
+
+Fri Jan 24 09:21:12 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+Sun Jan 12 07:49:14 1992 Karl Berry (karl at hayley)
+
+ * pktype.ch, pktogf.ch, vftovp.ch: `cwd_test_read_access' is gone.
+
+ * Makefile (vftovp.o, vptovf.o): remove the -Dlink, as it is now
+ in common.h.
+
+ * gftopk.ch, gftype.ch: `cwd_test_read_access' is gone.
+
+mf:
+Mon Feb 21 13:24:21 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: srcdir changes from simon.
+
+Wed Feb 2 11:01:01 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Tue Feb 1 18:01:19 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (extrah): Include mfd.h and texmfmem.h here.
+ (commonh): No texmfmem.h here.
+
+Mon Jan 24 07:34:01 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Mon Jan 17 14:30:09 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (iextra.o): Depend on mfd.h.
+
+Sat Dec 11 13:23:35 1993 Karl Berry (karl@cs.umb.edu)
+
+ * convert: coerce.fix has been renamed coerce.add.
+
+Sun Dec 5 15:22:43 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (windowlibs): Put x_extra_libs here.
+ (LIBS): Not here.
+
+Sat Dec 4 16:51:57 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (*objs): Depend on $(extrah) and $(commonh).
+ (mf?.o): Depend only on mf?.c.
+
+Thu Nov 11 11:18:06 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (x_{include,lib}_flags): Renamed from x{include,lib}dir.
+
+Sun Nov 7 14:26:10 1993 Karl Berry (karl@cs.umb.edu)
+
+ * convert: Remove call to sync.
+ * Makefile.in (mfd.h): Instead, touch mfd.h after it finishes
+ running, to ensure the timestamp will be later.
+
+Tue Nov 2 16:00:16 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (objs): Add mf10.o.
+
+Tue Oct 12 13:34:00 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Simplify kpathsea references.
+
+Sun Oct 3 13:11:05 1993 Karl Berry (karl@cs.umb.edu)
+
+ * fixcoerce.h: Rename to coerce.add.
+ * convert: Similarly.
+
+ * Makefile.in (commonh): paths.h is in kpathsea.
+ (commono): kpathsea.a has its own variable now.
+ (*clean): Include standard targets.
+ (program): New variable.
+ (install): Use it.
+
+Tue May 18 14:05:03 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-*): mkdirchain on install dirs.
+
+Sun May 9 10:10:53 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Remove $(srcdir) for paths.h.
+ (commono): Add kpathsea library.
+
+Fri Apr 30 15:07:45 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Add paths.h.
+
+Fri Apr 23 10:41:11 1993 Karl Berry (karl@cs.umb.edu)
+
+ * convert: Remove volatile's for the MIPS compiler, as they no
+ longer have any effect.
+
+Fri Apr 16 08:01:53 1993 Karl Berry (karl@cs.umb.edu)
+
+ * mf.ch: Doc fix.
+
+Sat Apr 10 16:42:43 1993 Karl Berry (karl@cs.umb.edu)
+
+ * convert: Don't sync unless /bin/sync exists.
+
+Fri Apr 9 16:07:46 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Define as config.h.
+
+Thu Mar 25 16:58:34 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (openinout.c): Remove the file before making the link.
+
+Sat Mar 13 12:10:46 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (CPPFLAGS): Add @DEFS@, for -DHAVE_CONFIG_H.
+
+Sun Feb 28 10:51:08 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (clean-trap): Don't install mfd.h.bak if it has the
+ trap constants.
+
+Sun Feb 21 08:28:22 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Version 5.851d.
+
+Tue Feb 16 17:54:50 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec, install-data): New targets.
+
+Sun Feb 14 11:25:51 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (iobjs, vobjs): Don't include $(objs), and depend on
+ mfd.h.
+ (inimf, virmf): Include $(objs.)
+
+Fri Feb 12 07:36:49 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (clean): Remove iextra.c.
+ (mostlyclean): Remove trap.mf.
+
+Wed Jan 27 07:14:55 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (run-trap): {mf,tex}ware => {dvi,font}util.
+
+Tue Jan 26 11:44:29 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install): Change `exit 0' to true.
+
+ * Makefile.in (iextra.c, inimf.c): New targets.
+ (iextra.o, initex.o): Just do the compilation.
+
+Mon Jan 25 10:38:57 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (clean-trap): Remove trapmf and stamp-trap.
+
+ * Makefile.in (CPPFLAGS): Don't need -I. any more.
+
+Sun Jan 24 11:35:16 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (iextra.o): $(LN) to $(extrac), instead of compiling
+ directly.
+
+ * Makefile.in (mf-extra): Rename to vextra.
+
+ * Makefile.in (cmf.ch): Don't use $@.
+
+ * Makefile.in (run-trap): Depend on trapmf.
+
+ * Makefile.in (mostlyclean): Remove trap files explicitly, as we
+ don't want to remove trap.sed.
+
+ * Makefile.in (mfsrcdir): Define with `mf', not `tex'!
+
+Sat Jan 16 08:46:33 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (mfsrcdir): New variable; use it in various rules.
+
+Thu Jan 14 08:04:47 1993 Karl Berry (karl@cs.umb.edu)
+
+ * small.sed (pool_size): Increase to 36000. From tim@maths.tcd.ie.
+
+Sun Jan 3 13:16:32 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Remove Makefile.
+
+ * Makefile.in (check): New target, synonym for run-trap.
+
+Sun Dec 13 09:45:53 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (clean-trap, c-sources): New targets.
+
+ * Makefile.in (stamp-trap): Use sed instead of ini_to_trap.
+
+Sat Dec 12 13:15:03 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+ * small.sed: New file.
+
+ * Makefile (stamp-trap): Change dependency to `stamp-convert'.
+
+Mon Nov 16 08:16:51 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile (cmf.ch): New target.
+
+Sun Oct 11 11:23:26 1992 Karl Berry (karl@cs.umb.edu)
+
+ * convert (sed): Don't use /bin/sed, as GNU sed works as of 1.10.
+
+Thu Sep 24 11:03:39 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile (openinout.c): avoid use of $<.
+
+Thu Sep 17 08:41:26 1992 Karl Berry (karl@hayley)
+
+ * Makefile (install): use filename in install target names.
+
+Fri Sep 4 09:02:57 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+ (distclean): don't remove backup files etc. here.
+
+Wed Aug 19 08:22:57 1992 Karl Berry (karl@hayley)
+
+ * Makefile (openinout.c): new target.
+ (clean): remove it.
+
+ * Makefile (CPPFLAGS): we need -I. for mfd.h.
+
+Wed Aug 12 16:28:18 1992 Karl Berry (karl@hayley)
+
+ * Makefile (iextra.o): include $(CPPFLAGS); remove `-I.'.
+ (inimf.o): likewise.
+ (mf-extra.c): new target.
+ (mf-extra.o); depend on it (and use default compilation rule).
+ (fileioo): use default compilation rule.
+
+Sat Jul 25 17:51:03 1992 Karl Berry (karl@hayley)
+
+ * Makefile (makeargs): pass CFLAGS, not cflags.
+
+Sun Jul 5 07:28:13 1992 Karl Berry (karl@hayley)
+
+ * Makefile (clean): remove inimf.c, trap.*, mf-extra.c here.
+
+Thu Jul 2 16:08:00 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CPPFLAGS): new variable
+ (.c.o): use it.
+ (cflags): change to CFLAGS.
+
+Tue Jun 23 10:19:45 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CC): change default to `gcc -posix'.
+
+Thu May 14 19:21:57 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Sat Apr 25 09:36:23 1992 Karl Berry (karl@hayley)
+
+ * Makefile (distclean): new target.
+
+ * convert: sync after the pipeline.
+
+Thu Apr 23 12:05:51 1992 Karl Berry (karl@hayley)
+
+ * Makefile: fix clean targets, fix inimf/virmf/etc. to reflect
+ reality. From Andreas.
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Sat Apr 11 09:18:59 1992 Karl Berry (karl@hayley)
+
+ * mf.ch (pack_file_name, pack_buffered_name): don't fill the
+ name_of_file array completely.
+
+Fri Apr 10 17:25:07 1992 Karl Berry (karl@hayley)
+
+ * mf.ch: new file for configure to make cmf.ch from.
+ * Makefile (mostlyclean): remove cmf.ch.
+
+Fri Apr 3 09:55:30 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Mon Mar 30 07:57:08 1992 Karl Berry (karl at hayley)
+
+ * Makefile (clean, mostlyclean, windowlib, trapmf): use $(MAKE),
+ not `make'.
+
+Sun Mar 29 17:06:04 1992 Karl Berry (karl at hayley)
+
+ * ini_to_trap: change some more constants.
+
+ * mf.web: new verion from dek.
+ * cmf.ch: update version number.
+
+Sun Mar 22 06:33:42 1992 Karl Berry (karl at fosse)
+
+ * Makefile (makeargs): don't bother to pass variables for linking.
+
+Sat Mar 21 10:40:57 1992 Karl Berry (karl at hayley)
+
+ * cmf.ch (38.789): check for the extension being irrelevant.
+
+Fri Mar 20 15:30:00 1992 Karl Berry (karl at hayley)
+
+ * Makefile (mostlyclean): new name for `clean'.
+ (clean): what `realclean' used to be.
+ (realclean): nothing to do anymore.
+ (install): install the program.
+
+ * cmf.ch (4.51): set name_length to strlen pool_name.
+
+Fri Jan 24 09:21:17 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+Wed Jan 15 12:59:29 1992 Karl Berry (karl at hayley)
+
+ * cmf.ch (input): same changes as in TeX.
+
+Sun Jan 12 09:18:03 1992 Karl Berry (karl at hayley)
+
+ * cmf.ch (memory structure): include "texmfmem.h", omitting the
+ ../common.
+
+ * Makefile (fileioh): no longer exists.
+
+Tue Jan 7 15:52:24 1992 Karl Berry (karl at hayley)
+
+ * ctex.ch (opening input files): do `name_length + 5 <
+ file_name_size', not `name_length < file_name_size + 5'. From
+ tony@marcam.dsir.govt.nz.
+
+mp:
+Wed Apr 12 18:50:13 1995 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * mp.ch: complete rewrite, merging material from ../mf/mf.ch
+ and the original mp.ch.
+
+Tue Apr 11 17:53:15 1995 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * Makefile: discarded, will be regenerated from Makefile.in
+ during configure run.
+
+ * Makefile.in: complete rewrite, based on ../mf/Makefile.in.
+
+ * convert: replaced by modified version of ../mf/convert script.
+ Removed execute permission, using sh -c in the Makefile instead.
+
+ * mp.def: discarded, using ../lib/texmf.defines instead.
+
+ * mp.h: discarded, using the web2c header files from ../lib.
+ (Actually moved to MPtime subdirectory for use in timing test.)
+
+ * mpext.c: discarded, using routines from ../lib/lib.a instead.
+ Moved code for callmakempx() to file ../lib/openinout.c.
+
+ * mpmath.c: preserved without changes. Ccomments refererring to
+ site.h are no longer applicable when using ../lib/c-auto.h instead.
+
+ * pathexp.c: moved to ../mpware as only DMP uses the pathexpand()
+ function. MetaPost and DVItoMP use Kpathsea routines instead.
+
+ * fixcoerce.h: discarded, using ../mf/coerce.add instead.
+
+ * fix.lex: discarded, apparently no longer needed in web2c-6.1.
+
+ * ini_to_trap: discarded, using sed script trap.sed instead of
+ shell script that invokes ed. Also added sed script small.sed.
+
+ * trapdir: renamed to MPtrap, for consistency with ../mf/MFtrap.
+
+ * trapmp: replaced by modified version of ../mp/trapenv script.
+ Removed execute permission, using sh -c in the Makefile instead.
+ Also rename etrapmp target to trapmp in the Makefile.
+
+Mon Apr 11 18:32:00 1995 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * created subdirectory MPtime for timing test files not needed
+ for production version of MetaPost.
+
+ * mp.h, test_mpd.h, mathtest.c, time.c, pmath.c: moved to MPtime.
+
+ * mpmath.c: copied to MPtime and renamed to cmath.c for use in
+ timing test. Changed #include "mpd.h" to include "test_mpd.h".
+
+ * site.h, defaults.h: copied from top-level directory to MPtime.
+ Renamed site.h to site.h.orig and copied to site.h.{system-type}.
+
+tex:
+Thu Feb 24 06:02:39 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (tex.p): Use a tab, not eight spaces, in the
+ commented-out mltex lines. From Eric.Picheral@univ-rennes1.fr.
+
+Mon Feb 21 13:25:52 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: srcdir changes from simon.
+
+Wed Feb 2 11:01:18 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Tue Feb 1 13:26:25 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (extrah): Include texd.h and texmfmem.h here.
+ (commonh): No texmfmem.h here.
+
+ * Makefile.in (tex.p): Add commented out additions for MLTeX.
+
+Mon Jan 24 07:34:13 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Mon Jan 17 14:29:27 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (iextra.o): Depend on texd.h.
+
+Wed Dec 15 06:29:41 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (formats): Rename to fmts.
+
+Tue Dec 7 13:45:05 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tex.ch: Invoke MakeTeXTeX for \openin.
+ From carlisle@cs.man.ac.uk.
+
+ * patgen.ch: Doc fix.
+
+Sat Dec 4 16:28:27 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (*objs): Depend on $(extrah) and $(commonh).
+ (tex?.o): Depend only on tex?.c.
+
+Fri Dec 3 08:58:50 1993 Karl Berry (karl@cs.umb.edu)
+
+ * patgen.ch (filnam): Add a trailing space to filnam, and declare
+ it to be one character larger. From jmr.
+
+Sun Nov 14 11:58:13 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install*): texfontdir => fontdir.
+
+Sun Nov 7 14:25:54 1993 Karl Berry (karl@cs.umb.edu)
+
+ * convert: Remove call to sync.
+ * Makefile.in (mfd.h): Instead, touch mfd.h after it finishes
+ running, to ensure the timestamp will be later.
+
+Tue Nov 2 13:33:41 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tex.ch (banner): At version 3.1415 now.
+ * tex.web: Update from Knuth.
+
+ * Makefile.in (objs): Add tex9.o and rename $(tex9_o) to extra_tex_obj.
+
+ * openinout.c (make_tex_file): Return a boolean, not a string.
+
+Tue Oct 12 13:33:02 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Simplify kpathsea references.
+
+Sun Oct 3 13:18:18 1993 Karl Berry (karl@cs.umb.edu)
+
+ * fixcoerce.h: Rename to coerce.add.
+ * convert: Similarly.
+
+ * Makefile.in (commonh): paths.h is in kpathsea.
+ (commono): kpathsea.a has its own variable now.
+ (*clean): Include standard targets.
+ (program): New variable.
+ (install): Use it.
+
+Tue Jun 29 16:22:54 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Doc fix.
+
+Mon May 31 08:19:11 1993 Karl Berry (karl@cs.umb.edu)
+
+ * trip.sed (negtrieopsize): Change to -500.
+
+Tue May 18 14:04:07 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-*): mkdirchain on install dirs.
+
+Sun May 9 10:10:54 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Remove $(srcdir) for paths.h.
+ (commono): Add kpathsea library.
+
+Tue May 4 10:24:29 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (extraclean): Do not depend on distclean; remove
+ CONTENTS.tex and tex.tex.
+
+Fri Apr 30 15:08:01 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (patgen2): Rename to patgen throughout.
+
+ * Makefile.in (commonh): Add paths.h.
+
+Fri Apr 16 07:27:03 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tex.ch: Doc fix.
+
+Sat Apr 10 16:42:35 1993 Karl Berry (karl@cs.umb.edu)
+
+ * convert: Don't sync unless /bin/sync exists.
+
+Fri Apr 9 16:07:52 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Define as config.h.
+
+Sat Mar 13 12:10:53 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (CPPFLAGS): Add @DEFS@, for -DHAVE_CONFIG_H.
+
+Fri Mar 12 15:48:57 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (tex9.o): Depend on tex9.c, not tex8.c!
+
+Sun Feb 28 10:47:06 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (clean-trip): Don't reinstall texd.h if it has the
+ trip constants.
+
+ * Makefile.in (clean-trip): Remove triptex, not tripmf.
+
+Sun Feb 21 08:28:26 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Version 5.851d.
+
+Tue Feb 16 17:56:03 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec, install-data): New targets.
+
+Mon Feb 15 10:19:12 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tex.ch (563): Call make_tex_tfm if the first open fails.
+
+ * tex.ch: Only call a_open_in without the .tex if we actually
+ changed anything; call make_tex_tex if everything before fails,
+ and if that succeeds, call a_open_in again.
+
+ * tex.ch: Comment out term_offset thing.
+
+Sun Feb 14 11:24:37 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (iobjs, vobjs): Don't include $(objs), and depend on
+ texd.h.
+ (initex, virtex): Include $(objs).
+
+Sun Feb 7 10:22:45 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install): Fix logic for overwriting texfonts.map.
+
+ * Makefile.in (.p.c, .ch.p): New suffix rules for patgen.
+
+Sat Jan 30 10:31:01 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install): Correct texfonts.map installation.
+
+Wed Jan 27 07:14:28 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (run-trip): {mf,tex}ware => {dvi,font}util.
+
+Tue Jan 26 11:44:45 1993 Karl Berry (karl@cs.umb.edu)
+
+ * *.ch (banner): Use version_string.
+
+ * Makefile.in: Merge in patgen.
+
+ * Makefile.in (install): Change `exit 0' to true.
+
+ * Makefile.in (install): Install texfonts.map.
+
+ * Makefile.in (iextra.c, initex.c): New targets.
+ (iextra.o, initex.o): Just do the compilation.
+
+Mon Jan 25 10:39:13 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (clean-trip): Remove tripmf and stamp-trip.
+
+ * Makefile.in (CPPFLAGS): Don't need -I now.
+
+Sun Jan 24 11:34:27 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (tex-extra): Rename to vextra.
+
+ * Makefile.in (iextra.o): $(LN) to $(extrac), instead of compiling
+ it directly.
+
+ * Makefile.in (ctex.ch): Don't use $@.
+
+ * Makefile.in (mostlyclean): Remove trip files explicitly, to
+ avoid removing trip.sed.
+
+ * Makefile.in (stamp-trip): Depend on trip.sed in $(texsrcdir).
+
+Sat Jan 16 09:00:49 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tex.ch (trie_size): Increase to 30,000 for
+ English/German/Portuguese.
+
+Thu Jan 14 08:02:01 1993 Karl Berry (karl@cs.umb.edu)
+
+ * small.sed (font_mem_size, hash_size, pool_size, max_strings,
+ string_vacancies): Increase the small sizes somewhat. The result
+ still runs on a 3b1, so I suspect it will run on anything. From
+ andy@scp.caltech.edu.
+
+Sun Jan 3 13:14:39 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Remove Makefile.
+
+ * Makefile.in (DIFF, DIFFFLAGS): New variables.
+ (run-trip): Use them (in appropriate places) instead of `diff', so
+ spiff can be used if it's available (and desired).
+ (check): New target, synonym for run-trip.
+
+Sun Dec 13 14:13:02 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (clean-trip, c-sources): New targets.
+
+Sat Dec 12 14:08:07 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+ * small.sed: New file.
+
+Mon Nov 16 08:16:33 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile (ctex.ch): New target.
+
+Sat Nov 14 18:50:20 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile (run-trip): Run tftopl on the trip.tfm we create, and
+ diff the result with the original PL file.
+
+Tue Oct 27 08:15:12 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile (objs): Use $(tex9_o), which is empty by default.
+
+ * tex.ch (mem_top): Improve comment.
+
+Sun Oct 18 13:55:54 1992 Karl Berry (karl@cs.umb.edu)
+
+ * tex.ch (trie_op_size): Define as 751, since that's prime.
+
+ * tex.ch (neg_trie_op_size): Improve comments, and use it in
+ [43.944] where useful.
+
+Thu Sep 24 11:03:02 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile (openinout.c): avoid use of $<.
+
+Thu Sep 17 08:42:01 1992 Karl Berry (karl@hayley)
+
+ * Makefile (install): use filename in install target names.
+
+Fri Sep 4 09:04:06 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+ (distclean): don't remove backup files etc. here.
+
+Wed Aug 19 08:22:27 1992 Karl Berry (karl@hayley)
+
+ * Makefile (openinout.c): new target.
+ (clean): remove it.
+
+ * Makefile (CPPFLAGS): we need -I. for texd.h.
+
+Wed Aug 12 16:28:18 1992 Karl Berry (karl@hayley)
+
+ * Makefile (iextra.o): include $(CPPFLAGS); remove `-I.'.
+ (initex.o): likewise.
+ (tex-extra.c): new target.
+ (tex-extra.o); depend on it (and use default compilation rule).
+ (fileioo): use default compilation rule.
+
+Sat Jul 25 17:51:18 1992 Karl Berry (karl@hayley)
+
+ * Makefile (amstex.fmt): don't bother with \dump on the command
+ line, since amstex.ini includes it.
+
+ * Makefile (makeargs): pass CFLAGS, not cflags.
+
+Sun Jul 5 07:28:40 1992 Karl Berry (karl@hayley)
+
+ * Makefile (clean): remove trip.*, initex.c, tex-extra.c here.
+
+Fri Jul 3 11:50:49 1992 Karl Berry (karl@hayley)
+
+ * small.diff (hash_size, hash_prime): increase to 3500 and 2981
+ for LaTeX. (From bernd.)
+
+Thu Jul 2 16:09:45 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CPPFLAGS): new variable
+ (.c.o): use it.
+ (cflags): change to CFLAGS.
+
+Thu May 21 09:22:33 1992 Karl Berry (karl@hayley)
+
+ * tex.ch: warn that increasing max_quarterword makes texmfmem.h
+ break.
+
+Thu May 14 19:22:23 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Thu May 7 07:29:59 1992 Karl Berry (karl@hayley)
+
+ * Makefile (tex9.[co]): new targets (not used in our dist).
+
+Sat Apr 25 08:56:54 1992 Karl Berry (karl@hayley)
+
+ * convert: sync after the pipeline.
+
+ * Makefile (distclean): new target.
+
+ * Makefile (amstex.fmt): don't use &./tex.
+ (amslatex.fmt): be more explicit about AMSLaTeX's horrible
+ installation scheme.
+
+Thu Apr 23 12:04:49 1992 Karl Berry (karl@hayley)
+
+ * Makefile (initex, virtex): changes from Andreas to reflect
+ reality; fix clean targets.
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Sat Apr 11 09:19:41 1992 Karl Berry (karl@hayley)
+
+ * tex.ch (pack_file_name, pack_buffered_name): don't fill the
+ name_of_file array completely.
+
+Fri Apr 10 17:03:41 1992 Karl Berry (karl@hayley)
+
+ * tex.ch: new file for configure to make ctex.ch from.
+ * Makefile (mostlyclean): remove ctex.ch.
+
+ * Makefile (default): make it `all'.
+
+Fri Apr 3 09:55:55 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Mon Mar 30 07:59:29 1992 Karl Berry (karl at hayley)
+
+ * Makefile (triptex): use $(MAKE), not make.
+
+Sun Mar 29 15:44:30 1992 Karl Berry (karl at hayley)
+
+ * ini_to_trip: change additional constants.
+
+ * tex.web: new version from dek.
+ * tex.ch: update version number.
+
+Sat Mar 21 11:09:06 1992 Karl Berry (karl at hayley)
+
+ * ctex.ch (pool_name): define to be `TEX_POOL_NAME', instead of
+ hardwiring `tex.pool'.
+
+Fri Mar 20 15:29:22 1992 Karl Berry (karl at hayley)
+
+ * Makefile (mostlyclean): new name for `clean'.
+ (clean): what `realclean' used to be.
+ (realclean): nothing to do anymore.
+ (install): install the program.
+
+ * ctex.ch (4.51): set name_length to the strlen of pool_name.
+
+Sun Mar 1 07:09:28 1992 Karl Berry (karl at hayley)
+
+ * ctex.ch (font_mem_size): increase to 100,000.
+
+Fri Jan 24 07:41:25 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+ * ctex.ch (\input, \openin): don't try .tex if the filename is
+ already the maximal length; otherwise foo.aux gets found
+ as foo.aux.tex under system V, when foo is 14 characters long.
+
+Tue Jan 21 17:20:17 1992 Karl Berry (karl at hayley)
+
+ * ctex.ch (pool_size): increase to 124,000.
+ (string_vacancies): to 100,000.
+
+Wed Jan 15 10:12:30 1992 Karl Berry (karl at hayley)
+
+ * ctex.ch (\input, \openin): if cur_ext=".tex", don't append .tex,
+ and reset it before trying without suffix.
+
+ * ctex.ch (max_strings): increase to 15000.
+
+Tue Jan 14 08:52:24 1992 Karl Berry (karl at hayley)
+
+ * ctex.ch (\input, \openin): try to find foo.tex before foo.
+ (From bent@ragged.dartmouth.edu.)
+
+ * Makefile (*.fmt): do not remove the \font lines from the output
+ via grep, as then prompts do not appear.
+
+Sun Jan 12 09:17:40 1992 Karl Berry (karl at hayley)
+
+ * ctex.ch (memory structure): include "texmfmem.h", omitting the
+ ../common.
+
+ * Makefile (fileioh): no longer exists.
+
+Tue Jan 7 15:51:28 1992 Karl Berry (karl at hayley)
+
+ * ctex.ch (opening input files): do `name_length + 5 <
+ file_name_size', not `name_length < file_name_size + 5'. From
+ tony@marcam.dsir.govt.nz.
+
+web:
+Mon Feb 21 14:51:24 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: srcdir changes from simon.
+
+Wed Feb 2 11:00:09 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Mon Jan 24 07:27:36 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Sun Jan 23 16:56:45 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (mostlyclean): Remove tangleboot.
+
+Tue Nov 30 16:19:06 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (tangle.web): Exit 1 if we get here.
+
+Sun Nov 7 14:52:11 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (tangle.web): New target, telling people to retrieve
+ web.tar.gz.
+
+Tue Oct 12 13:32:07 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Simplify kpathsea references.
+
+Sun May 9 10:10:56 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Remove $(srcdir) for paths.h.
+ (commono): Add kpathsea library.
+
+Fri Apr 30 15:08:11 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Add paths.h.
+
+Fri Apr 9 16:07:56 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commonh): Define as config.h.
+
+Sat Mar 13 12:10:56 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (CPPFLAGS): Add @DEFS@, for -DHAVE_CONFIG_H.
+
+Sun Feb 21 08:28:31 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Version 5.851d.
+
+Tue Feb 16 17:58:10 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec, install-data): New targets.
+
+Fri Feb 12 07:37:51 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (mostlyclean): Remove pooltype.
+
+Sun Feb 7 20:10:46 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (tangleboot.c): Use $(MAKE), not make.
+
+Tue Jan 26 16:36:45 1993 Karl Berry (karl@cs.umb.edu)
+
+ * *.ch (banner): Use version_string.
+
+ * Makefile.in: Merge pooltype from texware.
+
+Sun Jan 3 13:34:00 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Remove Makefile.
+
+Sun Dec 13 14:28:37 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (c-sources): New target.
+
+Sat Dec 12 14:19:16 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+Fri Sep 4 09:05:12 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+ (distclean): don't remove backup files etc. here.
+
+Wed Aug 19 08:35:14 1992 Karl Berry (karl@hayley)
+
+ * Makefile (tangleboot): use tangleboot.o as arg, not tangleboot.c.
+
+Sat Jul 25 17:52:34 1992 Karl Berry (karl@hayley)
+
+ * Makefile (tangleboot): depend on tangleboot.o.
+ (tangleboot.o): new target.
+
+Thu Jul 2 16:10:15 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CPPFLAGS): new variable
+ (.c.o): use it.
+ (cflags): change to CFLAGS.
+
+Tue Jun 23 10:14:23 1992 Karl Berry (karl@hayley)
+
+ * Makefile (tangleboot.c): make all in lib and web2c before trying
+ to `convert'.
+
+Sun Jun 21 16:42:00 1992 Karl Berry (karl@io)
+
+ * Makefile (realclean): don't remove tangleboot after all.
+
+Thu May 14 19:22:40 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Wed May 13 10:52:36 1992 Karl Berry (karl@hayley)
+
+ * Makefile (clean): can't remove *.[pch], since tangleboot goes away.
+
+Sat Apr 25 09:40:18 1992 Karl Berry (karl@hayley)
+
+ * Makefile (libs): new var.
+ (distclean): new target.
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Wed Apr 15 03:59:25 1992 Karl Berry (karl@fosse)
+
+ * Makefile (mostlyclean): remove tangleboot.
+
+Tue Apr 14 17:25:29 1992 Karl Berry (karl@hayley)
+
+ * Makefile (tangleboot.[ch]): new targets.
+ (tangleboot): depend on tangleboot.h, not tangle.h.
+ (clean): remove tangle.h.
+
+Mon Apr 13 09:10:07 1992 Karl Berry (karl@hayley)
+
+ * Makefile (tangle.p): depend on tangleboot; remove the loop.
+ (tangleboot): new target.
+
+Fri Apr 3 09:56:16 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Thu Apr 2 13:48:21 1992 Karl Berry (karl at ds1.cs.umb.edu)
+
+ * Makefile (clean): don't remove *.c; we need tangleboot.
+
+Sun Mar 29 15:24:51 1992 Karl Berry (karl at hayley)
+
+ * {tangle,weave}.web: new versions from dek.
+ * {tangle,weave}.ch: update version numbers.
+
+Fri Jan 24 09:20:20 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+Tue Jan 7 16:29:30 1992 Karl Berry (karl at hayley)
+
+ * Makefile (tangle.p): use quotes instead of \'s, for ptx. (From
+ maddog@sequent.com.)
diff --git a/Build/source/texk/web2c/INSTALL b/Build/source/texk/web2c/INSTALL
new file mode 100644
index 00000000000..8a26c522b76
--- /dev/null
+++ b/Build/source/texk/web2c/INSTALL
@@ -0,0 +1,262 @@
+Contents:
+
+Installation
+ `configure' options
+ Compile-time options
+ Additional targets
+ Trip, trap, and mptrap: Torture tests
+ Runtime options
+
+
+Installation
+************
+
+ Installing Web2c is mostly the same as installing any other
+Kpathsea-using program. Therefore, for the basic steps involved, *note
+Installation: (kpathsea)Installation.. (A copy is in the file
+`kpathsea/INSTALL'.)
+
+ One peculiarity to Web2c is that the source distribution comes in two
+files: `web.tar.gz' and `web2c.tar.gz'. You must retrieve and unpack
+them both. (We have two because the former archive contains the very
+large and seldom-changing original WEB source files.) *Note
+unixtex.ftp: (kpathsea)unixtex.ftp.
+
+ Another peculiarity is the MetaPost program. Although it has been
+installed previously as `mp', as of Web2c 7.0 the installed name is now
+`mpost', to avoid conflict with the `mp' program that does
+prettyprinting. This approach was recommended by the MetaPost author,
+John Hobby. If you as the TeX administrator wish to make it available
+under its shorter name as well, you will have to set up a link or some
+such yourself. And of course individual users can do the same.
+
+ For solutions to common installation problems and information on how
+to report a bug, see the file `kpathsea/BUGS' (*note Bugs:
+(kpathsea)Bugs.). See also the Web2c home page,
+`http://www.tug.org/web2c'.
+
+ Points worth repeating:
+
+ * Before starting the standard compilation and installation you must
+ install the basic fonts, macros, and other library files. *Note
+ Installation: (kpathsea)Installation.
+
+ * If you do not wish to use the standard file locations, see *Note
+ Changing search paths: (kpathsea)Changing search paths.
+
+ * Some Web2c features are enabled or disabled at `configure' time,
+ as described in the first section below.
+
+`configure' options
+===================
+
+ This section gives pointers to descriptions of the `--with' and
+`--enable' `configure' arguments that Web2c accepts. Some are specific
+to Web2c, others are generic to all Kpathsea-using programs.
+
+ For a list of all the options `configure' accepts, run `configure
+--help'. The generic options are listed first, and the
+package-specific options come last.
+
+ For a description of the generic options (which mainly allow you to
+specify installation directories) and basic `configure' usage, *note
+Running `configure' scripts: (autoconf)Invoking configure. (a copy is
+in the file `kpathsea/CONFIGURE').
+
+`--disable-dump-share'
+ Do not make fmt/base/mem files sharable across different endian
+ architectures. *Note Hardware and memory dumps::.
+
+`--without-maketexmf-default'
+`--without-maketexpk-default'
+`--without-maketextfm-default'
+`--with-maketextex-default'
+ Enable or disable the dynamic generation programs. *Note MakeTeX
+ configuration: (kpathsea)MakeTeX configuration. The defaults are
+ the inverse of the options, i.e., everything is enabled except
+ `MakeTeXTeX'.
+
+`--enable-auto-core'
+ Dump `core' if the input file is
+ `HackyInputFileNameForCoreDump.tex'. *Note Preloaded
+ executables::.
+
+`--enable-shared'
+ Build Kpathsea as a shared library. *Note Shared library:
+ (kpathsea)Shared library.
+
+`--with-editor=CMD'
+ Change the default editor invoked by the `e' interactive command.
+ *Note Editor invocation::.
+
+`--with-hp2627win'
+`--with-mftalkwin'
+`--with-nextwin'
+`--with-regiswin'
+`--with-suntoolswin'
+`--with-tektronixwin'
+`--with-unitermwin'
+`--with-x'
+`--with-x-toolkit=KIT'
+`--with-x11win'
+`--with-x11'
+ Define Metafont graphics support; by default, no graphics support
+ is enabled. *Note Online Metafont graphics::.
+
+`--x-includes=DIR'
+`--x-libraries=DIR'
+ Define the locations of the X11 include files and libraries; by
+ default, `configure' does its best to guess). *Note Optional
+ Features: (autoconf)Optional Features. A copy is in
+ `kpathsea/CONFIGURE'.
+
+Compile-time options
+====================
+
+ In addition to the `configure' options listed in the previous
+section, there are a few things that can be affected at compile-time
+with C definitions, rather than with `configure'. Using any of these
+is unusual.
+
+ To specify extra compiler flags (`-DNAME' in this case), the simplest
+thing to do is:
+ make XCFLAGS="CCOPTIONS"
+ You can also set the `CFLAGS' environment variable before running
+`configure'. *Note configure environment: (kpathsea)configure
+environment.
+
+Anyway, here are the possibilities:
+
+`-DFIXPT'
+`-DNO_MF_ASM'
+ Use the original WEB fixed-point routines for Metafont and MetaPost
+ arithmetic calculations regarding fractions. By default,
+ assembly-language routines are used on x86 hardware with GNU C
+ (unless `NO_MF_ASM' is defined), and floating-point routines are
+ used otherwise.
+
+`-DIPC_DEBUG'
+ Report on various interprocess communication activities. *Note
+ IPC and TeX: IPC and TeX.
+
+Additional targets
+==================
+
+ Web2c has several Make targets besides the standard ones. You can
+invoke these either in the top level directory of the source
+distribution (the one containing `kpathsea/' and `web2c/'), or in the
+`web2c/' directory.
+
+`c-sources'
+ Make only the C files, translated from the Web sources, presumably
+ because you want to take them to a non-Unix machine.
+
+`formats'
+`install-formats'
+ Make or install all the memory dumps (*note Memory dumps::.). By
+ default, the standard plain formats plus `latex.fmt' are made. You
+ can add other formats by redefining the `fmts', `bases', and
+ `mems' variables. See the top of `web2c/Makefile' for the
+ possibilities.
+
+`fmts'
+`install-fmts'
+ Make or install the TeX `.fmt' files. *Note initex invocation::.
+
+`bases'
+`install-bases'
+ Make or install the Metafont `.base' files. *Note inimf
+ invocation::.
+
+`mems'
+`install-mems'
+ Make or install the MetaPost `.mem' files. *Note inimpost
+ invocation::.
+
+`triptrap'
+`trip'
+`trap'
+`mptrap'
+ To run the torture tests for TeX, Metafont, and MetaPost
+ (respectively). See the next section.
+
+Trip, trap, and mptrap: Torture tests
+=====================================
+
+ To validate your TeX, Metafont, and MetaPost executables, run `make
+triptrap'. This runs the trip, trap, and mptrap "torture tests". See
+the files `triptrap/tripman.tex', `triptrap/trapman.tex', and
+`triptrap/mptrap.readme' for detailed information and background on the
+tests.
+
+ The differences between your executables' behavior and the standard
+values will show up on your terminal. The usual differences (these are
+all acceptable) are:
+
+ * string usage and table sizes;
+
+ * glue set ratios;
+
+ * `down4', `right4', and `y4' commands in DVItype output;
+
+ * dates and times.
+
+Any other differences are trouble. The most common culprit in the past
+has been compiler bugs, especially when optimizing. *Note TeX or
+Metafont failing: (kpathsea)TeX or Metafont failing.
+
+ The files `trip.diffs', `mftrap.diffs', and `mptrap.diffs' in the
+`triptrap' directory show the standard diffs against the original
+output. If you diff your diffs against these files, you should come up
+clean. For example
+ make trip >&mytrip.diffs
+ diff triptrap/trip.diffs mytrip.diffs
+
+ To run the tests separately, use the targets `trip', `trap', and
+`mptrap'.
+
+ To run simple tests for all the programs as well as the torture tests,
+run `make check'. You can compare the output to the distributed file
+`tests/check.log' if you like.
+
+Runtime options
+===============
+
+ Besides the configure- and compile-time options described in the
+previous sections, you can control a number of parameters (in
+particular, array sizes) in the `texmf.cnf' runtime file read by
+Kpathsea (*note Config files: (kpathsea)Config files.).
+
+ Rather than exhaustively listing them here, please see the last
+section of the distributed `kpathsea/texmf.cnf'. Some of the more
+interesting values:
+
+`main_memory'
+ Total words of memory available, for TeX, Metafont, and MetaPost.
+ Must remake the format file after changing.
+
+`extra_mem_bot'
+ Extra space for "large" TeX data structures: boxes, glue,
+ breakpoints, et al. If you use PiCTeX, you may well want to set
+ this.
+
+`font_mem_size'
+ Words of font info available for TeX; this is approximately the
+ total size of all TFM files read.
+
+`hash_extra'
+ Additional space for the hash table of control sequence names.
+ Approximately 10,000 control sequences can be stored in the main
+ hash table; if you have a large book with numerous
+ cross-references, this might not be enough, and thus you will want
+ to set `hash_extra'.
+
+ Of course, ideally all arrays would be dynamically expanded as
+necessary, so the only limiting factor would be the amount of swap space
+available. Unfortunately, implementing this is extremely difficult, as
+the fixed size of arrays is assumed in many places throughout the source
+code. These runtime limits are a practical compromise between the
+compile-time limits in previous versions, and truly dynamic arrays. (On
+the other hand, the Web2c BibTeX implementation does do dynamic
+reallocation of some arrays.)
+
diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in
new file mode 100644
index 00000000000..85cea88ebe7
--- /dev/null
+++ b/Build/source/texk/web2c/Makefile.in
@@ -0,0 +1,1156 @@
+# Makefile for web2c --kb@mail.tug.org. Public domain.
+# $Id: //depot/Build/source.development/TeX/texk/web2c/Makefile.in#66 $
+version = @WEB2CVERSION@
+
+# This makefile uses static rules with many targets (to be compatible to
+# non-gnu make) and will not work correctly when parallelized.
+# So we switch off parallel makes with gnu make.
+.NOTPARALLEL:
+
+# These lines define the memory dumps that fmts/bases/mems will make and
+# install-fmts/install-bases/install-mems will install. plain.* is
+# created automatically (as a link). See the Formats node in
+# doc/web2c.texi for details on the fmts.
+fmts = olatex.fmt # amstex.fmt eplain.fmt texinfo.fmt
+efmts = latex.fmt
+pdffmts = pdfolatex.fmt
+pdfefmts = pdflatex.fmt
+afmts = lamed.fmt
+ofmts = lambda.fmt
+eofmts = elambda.fmt
+bases = # I do not recommend building cmmf.base.
+mems = # mfplain.mem is probably not generally useful.
+
+# The name of the file that defines your local devices for Metafont.
+# (Only relevant during `make bases'.) I recommend `modes.mf', which
+# defines all known modes, plus useful definitions for all fonts. It's
+# available from ftp://ftp.tug.org/tex/modes.mf, among other places.
+localmodes = modes
+
+kpse_include ../make/paths.mk
+
+# Used for triptrap.
+DIFF = diff
+DIFFFLAGS =
+
+.SUFFIXES: # get rid of .p.o
+kpse_include ../make/common.mk
+kpse_include ../make/programs.mk
+
+CXX = @CXX@
+CXXLD = $(CXX)
+cxx_link_command = $(CXXLD) -o $@ $(LDFLAGS)
+kpathsea_cxx_link = $(LIBTOOL) --mode=link $(cxx_link_command)
+
+@MAINT@ifeq ($(CC), gcc)
+@MAINT@XDEFS = -Wimplicit -Wreturn-type -Wcomment -Wformat
+@MAINT@endif
+
+# Make `#include <X11/...>' and `-lX...' work.
+# This matches xdvik.
+# wlibs is substituted by web2c's configure, LIBS by general configure
+# routines, and the others by AC_PATH_XTRA.
+# All the x_... variables will be empty if we aren't supporting X.
+x_cppflags = @X_CFLAGS@
+x_ldflags = @X_LIBS@
+x_pre_libs = @X_PRE_LIBS@
+x_extra_libs = @X_EXTRA_LIBS@
+x_tool_libs = @x_tool_libs@
+x_ext_lib = @x_ext_lib@
+wlibs = @wlibs@
+# Follow the library order used in X11R6 itself:
+# -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11 (some may not be present).
+windowlink = $(windowlib) $(x_ldflags) $(x_tool_libs) $(x_pre_libs) $(x_ext_lib) $(wlibs) $(x_extra_libs)
+
+# With --enable-ipc, TeX may need to link with -lsocket.
+socketlibs = @socketlibs@
+
+common_makeargs = $(MFLAGS) CC='$(CC)' CFLAGS='$(CFLAGS)' LDFLAGS='$(LDFLAGS)' $(XMAKEARGS)
+window_makeargs = x_cppflags='$(x_cppflags)' $(common_makeargs)
+install_makeargs = INSTALL='$(INSTALL)' INSTALL_DATA='$(INSTALL_DATA)' \
+ INSTALL_PROGRAM='$(INSTALL_PROGRAM)' \
+ $(makevars) $(common_makeargs)
+
+proglib = lib/lib.a
+windowlib = window/window.a
+
+# The sh script that does the conversion:
+web2c = srcdir=$(srcdir) $(SHELL) $(srcdir)/web2c/convert
+# Additional dependencies:
+web2c_common = web2c/convert web2c/common.defines
+web2c_programs = web2c/fixwrites web2c/splitup web2c/web2c
+web2c_texmf = $(web2c_common) $(web2c_programs) web2c/texmf.defines web2c/coerce.h
+
+# The helper programs:
+TANGLEBOOT = @TANGLEBOOT@
+CTANGLEBOOT = @CTANGLEBOOT@
+TANGLE = @TANGLE@
+CTANGLE = @CTANGLE@
+TIE = @TIE@
+
+# Calling tangle
+tangle = WEBINPUTS=$(srcdir) $(TANGLE)
+ctangle = $(CTANGLE)
+tie = $(TIE)
+
+# The environment for making dumps.
+# No need to specify TEXMF, as ../kpathsea/texmf.cnf should contain
+# suitable absolute paths at this point. Those are converted to
+# SELFAUTO* paths on installation.
+dumpenv = TEXMFCNF=../kpathsea
+
+# Unfortunately, suffix rules can't have dependencies, or multiple
+# targets, and we can't assume all makes supports pattern rules.
+#.SUFFIXES: .p .c .ch .p
+#.p.c: # really depends on $(web2c_programs), and generates .h.
+# $(web2c) $*
+#.ch.p: # really depends on tangle; for mf/mp/tex, also generates .pool
+# ./tangle $(srcdir)/$*.web $<
+
+# These definitions have to come before the rules that expand them.
+# The *{ini,[0-2]}.c files are created by splitup, run as part of convert.
+# {mf,mp,tex}extra.c are created from lib/texmfmp.c, below.
+
+# Prevent Make from deleting the intermediate forms.
+.PRECIOUS: %.ch %.p %.c
+
+tex = tex
+mf = mf
+@MFN@mfn = mf-nowin
+#
+default all: programs manpages doc/web2c.info @FMU@ dumps
+check: dumps
+
+bibtex: bibtex.o
+ $(kpathsea_link) bibtex.o $(LOADLIBES)
+bibtex.c bibtex.h: $(web2c_common) $(web2c_programs) web2c/cvtbib.sed bibtex.p
+ $(web2c) bibtex
+bibtex.p: tangle bibtex.web bibtex.ch
+ $(tangle) bibtex bibtex
+check: bibtex-check
+bibtex-check: bibtex
+ test -f tests/exampl.aux || \
+ cp $(srcdir)/tests/exampl.aux tests/exampl.aux
+ TEXMFCNF=../kpathsea \
+ BSTINPUTS=$(srcdir)/tests \
+ BIBINPUTS=$(srcdir)/tests \
+ ./bibtex tests/exampl
+clean:: bibtex-clean
+bibtex-clean:
+ $(LIBTOOL) --mode=clean rm -f bibtex
+ rm -f bibtex.o bibtex.c bibtex.h bibtex.p
+ rm -f tests/exampl.blg tests/exampl.bbl
+
+ctie: ctie.o
+ $(kpathsea_link) ctie.o $(LOADLIBES)
+ctie.c: ctangle ctiedir/ctie.w ctiedir/ctie-k.ch
+ CWEBINPUTS=$(srcdir)/ctiedir $(ctangle) ctie.w ctie-k.ch
+clean:: ctie-clean
+ctie-clean:
+ $(LIBTOOL) --mode=clean rm -f ctie
+ rm -f ctie.o ctie.c
+
+cweave: cweave.o cweb.o
+ $(kpathsea_link) cweave.o cweb.o $(LOADLIBES)
+cweave.c: ctangle cwebdir/cweave.w cwebdir/cweav-w2c.ch
+ CWEBINPUTS=$(srcdir)/cwebdir $(ctangle) cweave cweav-w2c
+check: cweave-check
+cweave-check: cweave
+ CWEBINPUTS=$(srcdir)/cwebdir ./cweave common.w
+clean:: cweave-clean
+cweave-clean:
+ $(LIBTOOL) --mode=clean rm -f cweave
+ rm -f cweave.o cweave.c
+ rm -f common.tex common.scn common.idx
+
+dvicopy: dvicopy.o
+ $(kpathsea_link) dvicopy.o $(LOADLIBES)
+dvicopy.c dvicopy.h: $(web2c_common) $(web2c_programs) dvicopy.p
+ $(web2c) dvicopy
+dvicopy.p: tangle dvicopy.web dvicopy.ch
+ $(tangle) dvicopy dvicopy
+check: dvicopy-check
+dvicopy-check: dvicopy
+ TEXMFCNF=../kpathsea \
+ ./dvicopy $(srcdir)/tests/story tests/xstory.dvi
+# Redirect stderr so the terminal output will end up in the log file.
+ (TFMFONTS=$(srcdir)/tests VFFONTS=$(srcdir)/tests ./dvicopy \
+ <$(srcdir)/tests/pplr.dvi \
+ >tests/xpplr.dvi) 2>&1
+clean:: dvicopy-clean
+dvicopy-clean:
+ $(LIBTOOL) --mode=clean rm -f dvicopy
+ rm -f dvicopy.o dvicopy.c dvicopy.h dvicopy.p
+ rm -f tests/xstory.dvi tests/xpplr.dvi
+
+## dvitomp is a special case
+kpse_include dvitomp.mk
+##
+
+dvitype: dvitype.o
+ $(kpathsea_link) dvitype.o $(LOADLIBES)
+dvitype.c dvitype.h: $(web2c_common) $(web2c_programs) dvitype.p
+ $(web2c) dvitype
+dvitype.p: tangle dvitype.web dvitype.ch
+ $(tangle) dvitype dvitype
+check: dvitype-check
+dvitype-check: dvitype
+ ./dvitype -show-opcodes $(srcdir)/tests/story >tests/xstory.dvityp
+ ./dvitype --p=\*.\*.2 $(srcdir)/tests/pagenum.dvi >tests/xpagenum.typ
+clean:: dvitype-clean
+dvitype-clean:
+ $(LIBTOOL) --mode=clean rm -f dvitype
+ rm -f dvitype.o dvitype.c dvitype.h dvitype.p
+ rm -f tests/xstory.dvityp tests/xpagenum.typ
+
+gftodvi: gftodvi.o
+ $(kpathsea_link) gftodvi.o $(LOADLIBES)
+gftodvi.c gftodvi.h: $(web2c_common) $(web2c_programs) gftodvi.p
+ $(web2c) gftodvi
+gftodvi.p: tangle gftodvi.web gftodvi.ch
+ $(tangle) gftodvi gftodvi
+check: gftodvi-check
+gftodvi-check: gftodvi
+ TFMFONTS=$(srcdir)/tests ./gftodvi -verbose \
+ $(srcdir)/tests/cmr10.600gf
+ mv cmr10.dvi tests/xcmr10.dvi
+clean:: gftodvi-clean
+gftodvi-clean:
+ $(LIBTOOL) --mode=clean rm -f gftodvi
+ rm -f gftodvi.o gftodvi.c gftodvi.h gftodvi.p
+ rm -f tests/xcmr10.dvi
+
+gftopk: gftopk.o
+ $(kpathsea_link) gftopk.o $(LOADLIBES)
+gftopk.c gftopk.h: $(web2c_common) $(web2c_programs) gftopk.p
+ $(web2c) gftopk
+gftopk.p: tangle gftopk.web gftopk.ch
+ $(tangle) gftopk gftopk
+check: gftopk-check
+gftopk-check: gftopk
+ ./gftopk -verbose $(srcdir)/tests/cmr10.600gf tests/xcmr10.pk
+ ./gftopk $(srcdir)/tests/cmr10.600gf cmr10.pk && rm cmr10.pk
+clean:: gftopk-clean
+gftopk-clean:
+ $(LIBTOOL) --mode=clean rm -f gftopk
+ rm -f gftopk.o gftopk.c gftopk.h gftopk.p
+ rm -f tests/xcmr10.pk
+
+gftype: gftype.o
+ $(kpathsea_link) gftype.o $(LOADLIBES)
+gftype.c gftype.h: $(web2c_common) $(web2c_programs) gftype.p
+ $(web2c) gftype
+gftype.p: tangle gftype.web gftype.ch
+ $(tangle) gftype gftype
+check: gftype-check
+gftype-check: gftype
+ ./gftype $(srcdir)/tests/cmr10.600gf >tests/xcmr10.gft1
+ ./gftype -m -i $(srcdir)/tests/cmr10.600gf >tests/xcmr10.gft2
+clean:: gftype-clean
+gftype-clean:
+ $(LIBTOOL) --mode=clean rm -f gftype
+ rm -f gftype.o gftype.c gftype.h gftype.p
+ rm -f tests/xcmr10.gft1 tests/xcmr10.gft2
+
+mft: mft.o
+ $(kpathsea_link) mft.o $(LOADLIBES)
+mft.c mft.h: $(web2c_common) $(web2c_programs) mft.p
+ $(web2c) mft
+mft.p: tangle mft.web mft.ch
+ $(tangle) mft mft
+check: mft-check
+mft-check: mft
+ ./mft $(srcdir)/tests/io; mv io.tex tests/io.tex
+clean:: mft-clean
+mft-clean:
+ $(LIBTOOL) --mode=clean rm -f mft
+ rm -f mft.o mft.c mft.h mft.p
+ rm -f tests/io.tex
+
+patgen: patgen.o
+ $(kpathsea_link) patgen.o $(LOADLIBES)
+patgen.c patgen.h: $(web2c_common) $(web2c_programs) patgen.p
+ $(web2c) patgen
+patgen.p: tangle patgen.web patgen.ch
+ $(tangle) patgen patgen
+check: patgen-check
+patgen-check: patgen
+ ./patgen $(srcdir)/tests/dict $(srcdir)/tests/patterns tests/xpatout \
+ $(srcdir)/tests/translate <$(srcdir)/tests/patgen.in
+clean:: patgen-clean
+patgen-clean:
+ $(LIBTOOL) --mode=clean rm -f patgen
+ rm -f patgen.o patgen.c patgen.h patgen.p
+ rm -f tests/xpatout pattmp.4
+
+pktogf: pktogf.o
+ $(kpathsea_link) pktogf.o $(LOADLIBES)
+pktogf.c pktogf.h: $(web2c_common) $(web2c_programs) pktogf.p
+ $(web2c) pktogf
+pktogf.p: tangle pktogf.web pktogf.ch
+ $(tangle) pktogf pktogf
+check: pktogf-check
+pktogf-check: pktogf
+ ./pktogf -verbose $(srcdir)/tests/cmr10.pk tests/xcmr10.600gf
+ ./pktogf $(srcdir)/tests/cmr10.pk && rm cmr10.gf
+clean:: pktogf-clean
+pktogf-clean:
+ $(LIBTOOL) --mode=clean rm -f pktogf
+ rm -f pktogf.o pktogf.c pktogf.h pktogf.p
+ rm -f tests/xcmr10.600gf
+
+pktype: pktype.o
+ $(kpathsea_link) pktype.o $(LOADLIBES)
+pktype.c pktype.h: $(web2c_common) $(web2c_programs) pktype.p
+ $(web2c) pktype
+pktype.p: tangle pktype.web pktype.ch
+ $(tangle) pktype pktype
+check: pktype-check
+pktype-check: pktype
+ ./pktype $(srcdir)/tests/cmr10.pk >tests/xcmr10.pktyp
+clean:: pktype-clean
+pktype-clean:
+ $(LIBTOOL) --mode=clean rm -f pktype
+ rm -f pktype.o pktype.c pktype.h pktype.p
+ rm -f tests/xcmr10.pktyp
+
+pltotf: pltotf.o
+ $(kpathsea_link) pltotf.o $(LOADLIBES)
+pltotf.c pltotf.h: $(web2c_common) $(web2c_programs) pltotf.p
+ $(web2c) pltotf
+pltotf.p: tangle pltotf.web pltotf.ch
+ $(tangle) pltotf pltotf
+check: pltotf-check
+pltotf-check: pltotf
+ ./pltotf -verbose $(srcdir)/tests/cmr10 tests/xcmr10
+clean:: pltotf-clean
+pltotf-clean:
+ $(LIBTOOL) --mode=clean rm -f pltotf
+ rm -f pltotf.o pltotf.c pltotf.h pltotf.p
+ rm -f tests/xcmr10.tfm
+
+pooltype: pooltype.o
+ $(kpathsea_link) pooltype.o $(LOADLIBES)
+pooltype.c pooltype.h: $(web2c_common) $(web2c_programs) pooltype.p
+ $(web2c) pooltype
+pooltype.p: tangle pooltype.web pooltype.ch
+ $(tangle) pooltype pooltype
+check: pooltype-check
+pooltype-check: tex.pool
+pooltype-check: pooltype
+ ./pooltype tex.pool >tests/xtexpool.typ
+clean:: pooltype-clean
+pooltype-clean:
+ $(LIBTOOL) --mode=clean rm -f pooltype
+ rm -f pooltype.o pooltype.c pooltype.h pooltype.p
+ rm -f tests/xtexpool.typ
+
+tie: tie.o
+ $(kpathsea_link) tie.o $(LOADLIBES)
+tie.c: ctangle tiedir/tie.w tiedir/tie-w2c.ch
+ CWEBINPUTS=$(srcdir)/tiedir $(ctangle) tie.w tie-w2c.ch
+clean:: tie-clean
+tie-clean:
+ $(LIBTOOL) --mode=clean rm -f tie
+ rm -f tie.o tie.c
+
+tftopl: tftopl.o
+ $(kpathsea_link) tftopl.o $(LOADLIBES)
+tftopl.c tftopl.h: $(web2c_common) $(web2c_programs) tftopl.p
+ $(web2c) tftopl
+tftopl.p: tangle tftopl.web tftopl.ch
+ $(tangle) tftopl tftopl
+check: tftopl-check
+tftopl-check: tftopl
+ ./tftopl -verbose $(srcdir)/tests/cmr10 tests/xcmr10
+clean:: tftopl-clean
+tftopl-clean:
+ $(LIBTOOL) --mode=clean rm -f tftopl
+ rm -f tftopl.o tftopl.c tftopl.h tftopl.p
+ rm -f tests/xcmr10.pl
+
+vftovp: vftovp.o
+ $(kpathsea_link) vftovp.o $(LOADLIBES)
+vftovp.c vftovp.h: $(web2c_common) $(web2c_programs) vftovp.p
+ $(web2c) vftovp
+vftovp.p: tangle vftovp.web vftovp.ch
+ $(tangle) vftovp vftovp
+check: vftovp-check
+vftovp-check: vftovp
+ TFMFONTS=$(srcdir)/tests ./vftovp -verbose $(srcdir)/tests/ptmr ptmr tests/xptmr
+clean:: vftovp-clean
+vftovp-clean:
+ $(LIBTOOL) --mode=clean rm -f vftovp
+ rm -f vftop.o vftovp.c vftovp.h vftovp.p
+ rm -f tests/xptmr.vpl
+
+vptovf: vptovf.o
+ $(kpathsea_link) vptovf.o $(LOADLIBES)
+vptovf.c vptovf.h: $(web2c_common) $(web2c_programs) vptovf.p
+ $(web2c) vptovf
+vptovf.p: tangle vptovf.web vptovf.ch
+ $(tangle) vptovf vptovf
+check: vptovf-check
+vptovf-check: vptovf
+ ./vptovf $(srcdir)/tests/ptmr tests/xptmr tests/xptmr
+clean:: vptovf-clean
+vptovf-clean:
+ $(LIBTOOL) --mode=clean rm -f vptovf
+ rm -f vptovf.o vptovf.c vptovf.h vptovf.p
+ rm -f tests/xptmr.vf tests/xptmr.tfm
+
+weave: weave.o
+ $(kpathsea_link) weave.o $(LOADLIBES)
+weave.c weave.h: $(web2c_common) $(web2c_programs) weave.p
+ $(web2c) weave
+weave.p: tangle weave.web weave.ch
+ $(tangle) weave weave
+check: weave-check
+weave-check: weave
+ ./weave $(srcdir)/pooltype
+clean:: weave-clean
+weave-clean:
+ $(LIBTOOL) --mode=clean rm -f weave
+ rm -f weave.o weave.c weave.h weave.p
+ rm -f pooltype.tex
+
+#
+# Defines that are common to the texmf programs.
+
+triptrap: trip trap mptrap
+testdir = $(srcdir)/triptrap
+testenv = TEXMFCNF=$(testdir)
+dvitype_args = -output-level=2 -dpi=72.27 -page-start='*.*.*.*.*.*.*.*.*.*'
+
+#
+# Metafont
+mf_c = mfini.c mf0.c mf1.c mf2.c
+mf_o = mfini.o mf0.o mf1.o mf2.o mfextra.o
+mfn_o = mfini.o mf0.o mf1.o mf2.o mfnowin.o
+mf: $(mf_o) $(windowlib)
+ $(kpathsea_link) $(mf_o) $(windowlink) $(LOADLIBES)
+mf-nowin: $(mfn_o) window/trap.o
+ $(kpathsea_link) $(mfn_o) window/trap.o $(LOADLIBES)
+mfnowin.o: mfnowin.c
+ $(compile) -DMFNOWIN -c $< -o $@
+$(mf_c) mfcoerce.h mfd.h: mf.p $(web2c_texmf) web2c/cvtmf1.sed web2c/cvtmf2.sed
+ $(web2c) mf
+mfextra.c: lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/mf/ $(srcdir)/lib/texmfmp.c >$@
+mfnowin.c: lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/mf/ $(srcdir)/lib/texmfmp.c >$@
+mf.p mf.pool: tangle mf.web mf.ch
+ $(tangle) mf.web mf.ch
+check: mf-check
+mf-check: trap mf.base
+ ./mf --progname=mf '&./mf \tracingstats:=1; end.'
+ ./mf --progname=mf $(srcdir)/tests/online
+ ./mf --progname=mf $(srcdir)/tests/one.two
+ ./mf --progname=mf $(srcdir)/tests/uno.dos
+clean:: mf-clean
+mf-clean: trap-clean
+ $(LIBTOOL) --mode=clean rm -f mf
+ $(LIBTOOL) --mode=clean rm -f mf-nowin
+ rm -f $(mf_c) mfcoerce.h mfd.h mf.p mf.pool
+ rm -f $(mf_o) mfextra.c
+ rm -f $(mfn_o) mfnowin.c
+ rm -f mf.base mf.log
+ rm -f mfput.log online.2602gf online.log one.two.log uno.log
+
+# Can't run trap and mptrap in parallel, because both write trap.{log,tfm}.
+trap: mf tftopl gftype trap-clean
+ @echo ">>> See $(testdir)/mftrap.diffs for example of acceptable diffs." >&2
+ $(LN) $(testdir)/trap.mf . # get same filename in log
+ -$(SHELL) -c '$(testenv) ./mf --progname=inimf <$(testdir)/mftrap1.in >mftrapin.fot'
+ mv trap.log mftrapin.log
+ -diff $(testdir)/mftrapin.log mftrapin.log
+ -$(SHELL) -c '$(testenv) ./mf --progname=inimf <$(testdir)/mftrap2.in >mftrap.fot'
+ mv trap.log mftrap.log
+ mv trap.tfm mftrap.tfm
+ -diff $(testdir)/mftrap.fot mftrap.fot
+ -diff $(testdir)/mftrap.log mftrap.log
+ ./tftopl ./mftrap.tfm mftrap.pl
+ -diff $(testdir)/mftrap.pl mftrap.pl
+ $(SHELL) -c '$(testenv) ./gftype -m -i ./trap.72270gf >trap.typ'
+ -diff $(testdir)/trap.typ trap.typ
+
+trap-clean:
+ rm -f trap.mf trap.base
+ rm -f mftrapin.fot mftrapin.log
+ rm -f mftrap.fot mftrap.log mftrap.tfm
+ rm -f mftrap.pl trap.72270gf trap.typ
+#
+# MetaPost
+kpse_include metapost.mk
+#
+# TeX
+tex_c = texini.c tex0.c tex1.c tex2.c
+tex_o = texini.o tex0.o tex1.o tex2.o texextra.o
+tex: $(tex_o)
+ $(kpathsea_link) $(tex_o) $(socketlibs) $(LOADLIBES)
+$(tex_c) texcoerce.h texd.h: tex.p $(web2c_texmf)
+ $(web2c) tex
+texextra.c: lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/tex/ $(srcdir)/lib/texmfmp.c >$@
+tex.p tex.pool: tangle tex.web tex.ch
+ $(tangle) tex.web tex.ch
+check: tex-check
+tex-check: trip tex.fmt
+# Test truncation (but don't bother showing the warning msg).
+ ./tex --progname=tex --output-comment="`cat $(srcdir)/PROJECTS`" \
+ $(srcdir)/tests/hello 2>/dev/null \
+ && ./dvitype hello.dvi | grep olaf@infovore.xs4all.nl >/dev/null
+# \openout should show up in \write's.
+ ./tex --progname=tex $(srcdir)/tests/openout && grep xfoo openout.log
+# one.two.tex -> one.two.log
+ ./tex --progname=tex $(srcdir)/tests/one.two && ls -l one.two.log
+# uno.dos -> uno.log
+ ./tex --progname=tex $(srcdir)/tests/uno.dos && ls -l uno.log
+ ./tex --progname=tex $(srcdir)/tests/just.texi && ls -l just.log
+ -./tex --progname=tex $(srcdir)/tests/batch.tex
+ ./tex --progname=tex --shell $(srcdir)/tests/write18 | grep echo
+ TEXMFCNF=../kpathsea \
+ ./tex --mltex --progname=initex --ini $(srcdir)/tests/mltextst
+ -./tex </dev/null
+ -PATH=`pwd`:$(kpathsea_dir):$(kpathsea_srcdir):$$PATH \
+ WEB2C=$(kpathsea_srcdir) TMPDIR=.. \
+ ./tex --progname=tex '\nonstopmode\font\foo=nonesuch\end'
+clean:: tex-clean
+tex-clean: trip-clean
+ $(LIBTOOL) --mode=clean rm -f tex
+ rm -f $(tex_o) $(tex_c) texextra.c texcoerce.h texd.h
+ rm -f tex.p tex.pool
+ rm -f tex.fmt tex.log
+ rm -f hello.dvi hello.log xfoo.out openout.log on.two.log uno.log
+ rm -f just.log batch.log write18.log mltextst.log texput.log
+ rm -f missfont.log
+ rm -rf tfm
+
+trip: dvitype pltotf tftopl tex trip-clean
+ @echo ">>> See $(testdir)/trip.diffs for example of acceptable diffs." >&2
+ ./pltotf $(testdir)/trip.pl trip.tfm
+ ./tftopl ./trip.tfm trip.pl
+ -diff $(testdir)/trip.pl trip.pl
+ $(LN) $(testdir)/trip.tex . # get same filename in log
+ -$(SHELL) -c '$(testenv) ./tex --progname=initex --ini <$(testdir)/trip1.in >tripin.fot'
+ mv trip.log tripin.log
+ -diff $(testdir)/tripin.log tripin.log
+# May as well test non-ini second time through.
+ -$(SHELL) -c '$(testenv) ./tex --progname=tex <$(testdir)/trip2.in >trip.fot'
+ -diff $(testdir)/trip.fot trip.fot
+# We use $(DIFF) instead of `diff' only for those files where there
+# might actually be legitimate numerical differences.
+ -$(DIFF) $(DIFFFLAGS) $(testdir)/trip.log trip.log
+ $(SHELL) -c '$(testenv) ./dvitype $(dvitype_args) trip.dvi >trip.typ'
+ -$(DIFF) $(DIFFFLAGS) $(testdir)/trip.typ trip.typ
+
+trip-clean:
+ rm -f trip.tfm trip.pl trip.tex trip.fmt tripin.fot tripin.log
+ rm -f trip.fot trip.log trip.dvi trip.typ tripos.tex 8terminal.tex
+ rm -rf tfm
+#
+# Helper makefile fragment for pdf*tex.
+kpse_include pdftexdir/pdftexlib.mk
+#
+# Makefile fragments:
+kpse_include etexdir/etex.mk
+kpse_include omegadir/omega.mk
+kpse_include alephdir/aleph.mk
+kpse_include pdftexdir/pdftex.mk
+kpse_include pdfetexdir/pdfetex.mk
+#
+# Common
+programs = bibtex ctangle ctie cweave dvicopy dvitomp dvitype gftodvi gftopk \
+ gftype mft $(odvicopy) $(odvitype) $(otangle) patgen pktogf pktype pltotf \
+ pooltype tangle tftopl tie $(ttf2afm) vftovp vptovf weave
+engines = $(tex) $(etex) $(mf) $(mfn) $(mpost) \
+ $(omega) $(aleph) \
+ $(pdftex) $(pdfetex)
+
+programs: $(programs) $(engines) $(mpware_programs) \
+ $(omegafonts_programs) $(otps_programs) $(pdftosrc)
+
+# Additional dependencies for relinking.
+# Note that each program and engine already depends on $(web2c_programs).
+$(web2c_programs) tangleboot ctangleboot: $(kpathsea) $(proglib)
+
+#
+# Bootstrapping tangle requires making it with itself. We use the opportunity
+# to create an up-to-date tangleboot as well.
+tangle: tangle.o
+ $(kpathsea_link) tangle.o $(LOADLIBES)
+ $(MAKE) $(common_makeargs) tangleboot.p
+tangle.c tangle.h: tangle.p
+ $(web2c) tangle
+# tangle.p is a special case, since it is needed to compile itself. We
+# convert and compile the (distributed) tangleboot.p to make a tangle
+# which we use to make the other programs. We depend on tangleboot, even
+# though we might not use it.
+tangle.p: tangleboot tangle.web tangle.ch
+ WEBINPUTS=$(srcdir) $(TANGLEBOOT) tangle tangle
+tangle.web:
+ @echo "You seem to be missing tangle.web, perhaps because you" >&2
+ @echo "didn't retrieve web.tar.gz, only web2c.tar.gz." >&2
+ @echo "You need both." >&2
+ @echo >&2
+ @echo "web.tar.gz should be available from the" >&2
+ @echo "same place that you got web2c.tar.gz." >&2
+ @echo "In any case, you can get it from" >&2
+ @echo "ftp://ftp.tug.org/tex/web.tar.gz." >&2
+ false
+clean:: tangle-clean
+tangle-clean:
+ $(LIBTOOL) --mode=clean rm -f tangle
+ rm -f tangle.o tangle.c tangle.h tangle.p
+
+tangleboot: tangleboot.o
+ $(kpathsea_link) tangleboot.o $(LOADLIBES)
+tangleboot.c tangleboot.h: stamp-tangle $(web2c_programs) $(web2c_common)
+ $(web2c) tangleboot
+# tangleboot.p is in the distribution
+stamp-tangle: tangleboot.p
+ date >stamp-tangle
+# This is not run unless tangle.web or tangle.ch is changed.
+# Only try to run ./tangle if it actually exists, otherwise
+# just touch tangleboot.p and build tangle.
+tangleboot.p: tangle.web tangle.ch
+ if [ -r $(TANGLE) ] || [ -r $(TANGLE).exe ]; then \
+ WEBINPUTS=$(srcdir) $(TANGLE) tangle tangle; \
+ mv tangle.p tangleboot.p; \
+ elif [ -r tangleboot.p ]; then \
+ touch tangleboot.p; \
+ else \
+ cp $(srcdir)/tangleboot.p .; \
+ fi
+ date >stamp-tangle
+ $(MAKE) $(common_makeargs) tangle
+clean:: tangleboot-clean
+tangleboot-clean:
+ $(LIBTOOL) --mode=clean rm -f tangleboot
+ rm -f tangleboot.o tangleboot.c tangleboot.h
+
+# Bootstrapping ctangle requires making it with itself. We use the opportunity
+# to create an up-to-date ctangleboot as well.
+ctangle: ctangle.o cweb.o
+ $(kpathsea_link) ctangle.o cweb.o $(LOADLIBES)
+ $(MAKE) $(common_makeargs) ctangleboot.c cwebboot.c
+# ctangle.c is a special case, since it is needed to compile itself.
+ctangle.c: ctangleboot cwebdir/ctangle.w cwebdir/ctang-w2c.ch
+ CWEBINPUTS=$(srcdir)/cwebdir $(CTANGLEBOOT) ctangle ctang-w2c
+cweb.c: ctangleboot cwebdir/common.w cwebdir/comm-w2c.ch
+ CWEBINPUTS=$(srcdir)/cwebdir $(CTANGLEBOOT) common comm-w2c cweb.c
+clean:: ctangle-clean
+clean:: cweb-clean
+ctangle-clean:
+ $(LIBTOOL) --mode=clean rm -f ctangle
+ rm -f ctangle.o ctangle.c
+cweb-clean:
+ rm -f cweb.o cweb.c
+
+ctangleboot: ctangleboot.o cwebboot.o
+ $(kpathsea_link) ctangleboot.o cwebboot.o $(LOADLIBES)
+# ctangleboot.c is in the distribution
+stamp-ctangle: ctangleboot.c cwebboot.c
+ctangleboot.c: cwebdir/ctangle.w cwebdir/ctang-w2c.ch
+ if [ -r $(CTANGLE) ] || [ -r $(CTANGLE).exe ]; then \
+ CWEBINPUTS=$(srcdir)/cwebdir $(CTANGLE) ctangle ctang-w2c; \
+ mv ctangle.c ctangleboot.c; \
+ elif [ -r ctangleboot.c ]; then \
+ touch ctangleboot.c; \
+ else \
+ cp $(srcdir)/ctangleboot.c .; \
+ fi
+ date >stamp-ctangle
+ $(MAKE) $(common_makeargs) ctangle
+cwebboot.c: cwebdir/common.w cwebdir/comm-w2c.ch
+ if [ -r $(CTANGLE) ] || [ -r $(CTANGLE).exe ]; then \
+ CWEBINPUTS=$(srcdir)/cwebdir $(CTANGLE) common comm-w2c cweb.c; \
+ mv cweb.c cwebboot.c; \
+ elif [ -r cwebboot.c ]; then \
+ touch cwebboot.c; \
+ else \
+ cp $(srcdir)/cwebboot.c .; \
+ fi
+ date >stamp-ctangle
+ $(MAKE) $(common_makeargs) ctangle
+clean:: ctangleboot-clean
+clean:: cwebboot-clean
+ctangleboot-clean:
+ $(LIBTOOL) --mode=clean rm -f ctangleboot
+ rm -f ctangleboot.o
+cwebboot-clean:
+ rm -f cwebboot.o
+
+# Even web2c itself uses the library.
+# It's annoying to have to give all the filenames here,
+# but texmfmp.c is an exception.
+lib_sources = lib/alloca.c lib/basechsuffix.c lib/chartostring.c \
+ lib/eofeoln.c lib/fprintreal.c lib/input2int.c lib/inputint.c lib/main.c \
+ lib/openclose.c lib/printversion.c lib/uexit.c lib/usage.c lib/version.c \
+ lib/zround.c
+$(proglib): $(lib_sources) stamp-auto
+ cd lib && $(MAKE) $(common_makeargs)
+
+# No exceptions in this library.
+window_sources = $(srcdir)/window/*.c
+$(windowlib): mfd.h $(window_sources)
+ cd window && $(MAKE) $(window_makeargs)
+window/trap.o: $(srcdir)/window/trap.c
+ cd window && $(MAKE) $(common_makeargs) trap.o
+
+# The web2c program consists of several executables.
+web2c/fixwrites: web2c/fixwrites.c web2c/kps.c
+ cd web2c && $(MAKE) $(common_makeargs) fixwrites
+web2c/splitup: web2c/splitup.c web2c/kps.c
+ cd web2c && $(MAKE) $(common_makeargs) splitup
+web2c/web2c: web2c/main.c web2c/web2c.h web2c/web2c.l web2c/web2c.y web2c/kps.c
+ cd web2c && $(MAKE) $(common_makeargs) web2c
+
+kpse_include ../make/tkpathsea.mk
+
+#
+# Making dumps.
+all_fmts = tex.fmt $(fmts)
+all_bases = mf.base $(bases)
+all_mems = mpost.mem $(mems)
+
+dumps: fmts bases mems
+fmts: $(all_fmts)
+bases: $(all_bases)
+mems: $(all_mems)
+
+tex.fmt: tex
+ $(dumpenv) $(MAKE) progname=tex files="plain.tex cmr10.tfm" prereq-check
+ $(dumpenv) ./tex --progname=tex --jobname=tex --ini \\input plain \\dump </dev/null
+
+#latex.fmt: tex
+# $(dumpenv) $(MAKE) progname=latex files="latex.ltx" prereq-check
+# $(dumpenv) ./tex --progname=latex --jobname=latex --ini \\input latex.ltx </dev/null
+
+olatex.fmt: tex
+ $(dumpenv) $(MAKE) progname=olatex files="latex.ltx" prereq-check
+ $(dumpenv) ./tex --progname=olatex --jobname=olatex --ini \\input latex.ltx </dev/null
+
+mltex.fmt: tex
+ $(dumpenv) $(MAKE) progname=mltex files="plain.tex cmr10.tfm" prereq-check
+ $(dumpenv) ./tex --mltex --progname=mltex --jobname=mltex --ini \\input plain \\dump </dev/null
+
+#mllatex.fmt: tex
+# $(dumpenv) $(MAKE) progname=mllatex files="latex.ltx" prereq-check
+# $(dumpenv) ./tex --mltex --progname=mllatex --jobname=mllatex --ini \\input latex.ltx </dev/null
+
+mf.base: mf
+ $(dumpenv) $(MAKE) progname=mf files="plain.mf cmr10.mf $(localmodes).mf" prereq-check
+ $(dumpenv) ./mf --progname=mf --jobname=mf --ini \\input plain input $(localmodes) dump </dev/null
+
+mpost.mem: mpost
+ $(dumpenv) $(MAKE) progname=mpost files=plain.mp prereq-check
+ $(dumpenv) ./mpost --progname=mpost --jobname=mpost --ini \\input plain dump </dev/null
+
+# This is meant to be called recursively, with $(files) set.
+prereq-check: $(kpathsea_dir)/kpsewhich
+ $(kpathsea_dir)/kpsewhich --progname=$(progname) $(files) >/dev/null || $(MAKE) prereq-lose >/dev/null
+
+prereq-lose:
+ @echo "You seem to be missing input files necessary to make the" >&2
+ @echo "basic formats (some or all of: $(files))." >&2
+ @echo "Perhaps you've defined the default paths incorrectly, or" >&2
+ @echo "perhaps you have environment variables set pointing" >&2
+ @echo "to an incorrect location. See ../kpathsea/BUGS." >&2
+ @echo >&2
+ @echo "If you simply do not have the files, you can" >&2
+ @echo "retrieve a minimal set of input files from CTAN hosts." >&2
+ false
+
+$(kpathsea_dir)/kpsewhich: $(kpathsea)
+
+amstex.fmt: tex
+ $(dumpenv) ./tex --progname=amstex --jobname=amstex --ini amstex.ini </dev/null
+
+# Texinfo changes the escape character from `\' to `@'.
+texinfo.fmt: tex.fmt
+ $(dumpenv) ./tex --progname=texinfo --jobname=texinfo --ini texinfo @dump </dev/null
+
+eplain.fmt: tex.fmt
+ touch eplain.aux # Makes cross-reference warnings work right.
+ $(dumpenv) ./tex --progname=eplain --jobname=eplain --ini \&./tex eplain \\dump </dev/null
+
+#
+install: install-exec install-data
+install-exec:: install-programs @FMU@ install-links
+install-data:: install-tex-data install-mf-data install-mpost-data
+install-dumps: install-tex-dumps install-mf-dumps install-mpost-dumps
+
+# Installation directories.
+$(bindir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(bindir)
+$(texpooldir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(texpooldir)
+$(mfpooldir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(mfpooldir)
+$(mppooldir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(mppooldir)
+$(fmtdir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(fmtdir)
+$(basedir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(basedir)
+$(memdir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(memdir)
+$(web2cdir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(web2cdir)
+
+# Installing the programs.
+install-programs: $(programs) $(bindir)
+ for p in $(programs); do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+
+# Installation of each of the three main engines.
+install-tex: install-tex-exec install-tex-data
+install-mf: install-mf-exec install-mf-data
+install-mpost: install-mpost-exec install-mpost-data
+
+install-tex-exec: @FMU@ install-tex-links
+install-mf-exec: @FMU@ install-mf-links
+install-mpost-exec: @FMU@ install-mpost-links
+
+install-tex-data: install-tex-pool @FMU@ install-tex-dumps
+install-mf-data: install-mf-pool @FMU@ install-mf-dumps
+install-mpost-data: install-mpost-pool @FMU@ install-mpost-dumps
+
+install-tex-dumps: install-tex-fmts
+install-mf-dumps: install-mf-bases
+install-mpost-dumps: install-mpost-mems
+
+# Actual binaries.
+install-programs: install-tex-programs
+install-tex-programs: tex $(bindir)
+ tex="tex"; \
+ for p in $$tex; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+install-programs: install-mf-programs
+install-mf-programs: mf $(mfn) $(bindir)
+ mf="mf $(mfn)"; \
+ for p in $$mf; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+install-programs: install-mpost-programs
+install-mpost-programs: mpost $(bindir)
+ mpost="mpost"; \
+ for p in $$mpost; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+
+# The links to {mf,mp,tex} for each format and for {ini,vir}{mf,mp,tex},
+# plus the equivalents for e-TeX, Omega, and pdf[ex]TeX.
+install-links: install-tex-links
+install-tex-links: install-tex-programs
+ #cd $(bindir) && (rm -f initex virtex; \
+ # $(LN) tex initex; $(LN) tex virtex)
+
+install-links: install-mf-links
+install-mf-links: install-mf-programs
+ #cd $(bindir) && (rm -f inimf virmf; \
+ # $(LN) mf inimf; $(LN) mf virmf)
+
+install-links: install-mpost-links
+install-mpost-links: install-mpost-programs
+ #cd $(bindir) && (rm -f inimpost virmpost; \
+ # $(LN) mpost inimpost; $(LN) mpost virmpost)
+
+# Always do plain.*, so examples from the TeXbook (etc.) will work.
+install-fmts: install-tex-fmts
+install-tex-fmts: fmts $(fmtdir)
+ fmts="$(all_fmts)"; \
+ for f in $$fmts; do $(INSTALL_DATA) $$f $(fmtdir)/$$f; done
+ cd $(fmtdir) && (rm -f plain.fmt; $(LN) tex.fmt plain.fmt)
+ fmts="$(fmts)"; \
+ for f in $$fmts; do base=`basename $$f .fmt`; \
+ (cd $(bindir) && (rm -f $$base; $(LN) tex $$base)); done
+
+install-bases: install-mf-bases
+install-mf-bases: bases $(basedir)
+ bases="$(all_bases)"; \
+ for f in $$bases; do $(INSTALL_DATA) $$f $(basedir)/$$f; done
+ cd $(basedir) && (rm -f plain.base; $(LN) mf.base plain.base)
+ bases="$(bases)"; \
+ for f in $$bases; do base=`basename $$f .base`;\
+ (cd $(bindir) && (rm -f $$base; $(LN) mf $$base)); done
+
+install-mems: install-mpost-mems
+install-mpost-mems: mems $(memdir)
+ mems="$(all_mems)"; \
+ for f in $$mems; do $(INSTALL_DATA) $$f $(memdir)/$$f; done
+ cd $(memdir) && (rm -f plain.mem; $(LN) mpost.mem plain.mem)
+ mems="$(mems)"; \
+ for f in $$mems; do base=`basename $$f .mem`; \
+ (cd $(bindir) && (rm -f $$base; $(LN) mpost $$base)); done
+
+install-tex-pool: tex.pool $(texpooldir)
+ $(INSTALL_DATA) tex.pool $(texpooldir)/tex.pool
+install-mf-pool: mf.pool $(mfpooldir)
+ $(INSTALL_DATA) mf.pool $(mfpooldir)/mf.pool
+install-mpost-pool: mp.pool $(mppooldir)
+ $(INSTALL_DATA) mp.pool $(mppooldir)/mp.pool
+
+# Auxiliary files.
+install-data:: $(web2cdir)
+ cd doc && $(MAKE) $(install_makeargs) install-data
+ cd man && $(MAKE) $(install_makeargs) install-data
+ $(INSTALL_DATA) $(srcdir)/tiedir/tie.1 $(man1dir)/tie.$(manext)
+ $(INSTALL_DATA) $(srcdir)/ctiedir/ctie.1 $(man1dir)/ctie.$(manext)
+ $(INSTALL_DATA) fmtutil.cnf $(web2cdir)/fmtutil.cnf
+
+# Dummy target.
+uninstall uninstall-exec uninstall-data:
+ @echo "*** Warning: uninstall is a dummy target in web2c/Makefile"
+
+# The distribution comes with up-to-date .info* files,
+# so this should never be used unless something goes wrong
+# with the unpacking, or you modify the manual.
+doc/web2c.info:
+ cd doc && $(MAKE) info
+info dvi:
+ cd doc && $(MAKE) $@
+
+# Manual pages
+manpages:
+ cd man && $(MAKE) all
+
+#
+# make dist won't work for anyone but me. Sorry.
+
+@MAINT@all-dist: dist web-dist etex-dist omega-dist aleph-dist pdftex-dist libs-dist
+@MAINT@
+@MAINT@distname = web2c
+@MAINT@program_files = PROJECTS *.ac *.ch tangleboot.p
+@MAINT@# The files that omega places in the main directory.
+@MAINT@omega_files = omegamem.h {odvicopy,odvitype,otangle}.{web,ch}
+@MAINT@
+@MAINT@triptrapdiffs: triptrap/trip.diffs triptrap/mftrap.diffs triptrap/mptrap.diffs
+@MAINT@triptrap/trip.diffs: tex
+@MAINT@ $(MAKE) trip | tail +1 >triptrap/trip.diffs
+@MAINT@triptrap/mftrap.diffs: mf
+@MAINT@ $(MAKE) trap | tail +1 >triptrap/mftrap.diffs
+@MAINT@triptrap/mptrap.diffs: mpost
+@MAINT@ $(MAKE) mptrap | tail +1 >triptrap/mptrap.diffs
+@MAINT@
+@MAINT@tests/check.log: $(programs) $(engines)
+@MAINT@ $(MAKE) check | tail +1 >tests/check.log
+@MAINT@
+@MAINT@dist_subdirs = doc lib $(mpware) tests web2c window
+@MAINT@pre-dist-$(distname): depend triptrapdiffs tests/check.log tangleboot.p
+@MAINT@ cd web2c && $(MAKE) lex.yy.c y_tab.c
+@MAINT@ cd doc && $(MAKE) doc dvi
+@MAINT@
+@MAINT@post-dist-$(distname):
+@MAINT@# Make the subdirectories.
+@MAINT@ for d in $(dist_subdirs); do \
+@MAINT@ mkdir -p $(texk_distdir)/$(distname)/$$d; done
+@MAINT@# Link files in subdirectories.
+@MAINT@ for f in `find $(dist_subdirs) \
+@MAINT@ \( -name README \
+@MAINT@ -o -name convert \
+@MAINT@ -o -name ChangeLog \
+@MAINT@ -o -name 'coerce.*' \
+@MAINT@ -o -name ref.aux \
+@MAINT@ -o -name ref.bbl \
+@MAINT@ -o -name ref.tex \
+@MAINT@ -o -name ref.txi \
+@MAINT@ -o -name texinfo.bst \
+@MAINT@ -o -name web2c.cps \
+@MAINT@ -o -name web2c.aux \
+@MAINT@ -o -name '*.asm' \
+@MAINT@ -o -name '*.[chly]' \
+@MAINT@ -o -name '*.defines' \
+@MAINT@ -o -name '*.in' \
+@MAINT@ -o -name '*.info*' \
+@MAINT@ -o -name '*.map' \
+@MAINT@ -o -name '*.sed' \
+@MAINT@ -o -name '*.tcx' \
+@MAINT@ -o -name '*.texi' \
+@MAINT@ \) -print`; do \
+@MAINT@ ln $$f $(distdir)/`dirname $$f`; done
+@MAINT@# Handle the dependeny files in the subdirectories.
+@MAINT@ for d in lib $(mpware) web2c window; do \
+@MAINT@ cp -p $$d/depend.mk $(texk_distdir)/$(distname)/$$d; done
+@MAINT@# Other subdirectories.
+@MAINT@ mkdir $(distdir)/triptrap && cd $(distdir)/triptrap && \
+@MAINT@ for i in ../../../../triptrap/*; do \
+@MAINT@ if test -f $$i; then ln -s $$i .; fi; done
+@MAINT@ mkdir $(distdir)/tiedir && cd $(distdir)/tiedir && \
+@MAINT@ for i in ../../../../tiedir/*; do \
+@MAINT@ if test -f $$i; then ln -s $$i .; fi; done
+@MAINT@ mkdir $(distdir)/ctiedir && cd $(distdir)/ctiedir && \
+@MAINT@ for i in ../../../../ctiedir/*; do \
+@MAINT@ if test -f $$i; then ln -s $$i .; fi; done
+@MAINT@ mkdir $(distdir)/cwebdir && cd $(distdir)/cwebdir && \
+@MAINT@ for i in ../../../../cwebdir/*; do \
+@MAINT@ if test -f $$i; then ln -s $$i .; fi; done
+@MAINT@ mkdir $(distdir)/cwebdir/examples && cd $(distdir)/cwebdir/examples && \
+@MAINT@ for i in ../../../../cwebdir/examples/*; do \
+@MAINT@ if test -f $$i; then ln -s $$i .; fi; done
+@MAINT@ mkdir $(distdir)/man && cd $(distdir)/man && \
+@MAINT@ for i in ../../../../man/*; do \
+@MAINT@ if test -f $$i; then ln -s $$i .; fi; done;
+@MAINT@ cd $(distdir)/man && rm -f *.1 Makefile sedscript
+@MAINT@ rm -f $(distdir)/window/x11.c
+@MAINT@ rm -f $(distdir)/tests/patgen.in
+@MAINT@ cd $(distdir)/tests && (rm just.texi; ln -s ../../../../tests/* .; rm -f x* CVS)
+@MAINT@ cd $(distdir)/tests && rm -f missfont.log ptmr.mpx io.tex exampl.b??
+@MAINT@# We supply the flex/bison output in case the user can't generate them.
+@MAINT@ cd $(distdir)/web2c; ../../../../../rename 's/$$/-dist/' lex.yy.c y_tab.[ch]
+@MAINT@# Remove cruft.
+@MAINT@ cd $(distdir); rm -f $(addsuffix .c, $(programs) tangleboot)
+@MAINT@ cd $(distdir); rm -f $(addsuffix .h, $(programs) tangleboot)
+@MAINT@ cd $(distdir); rm -f etex.ch omega.ch aleph.ch
+@MAINT@ cd $(distdir); rm -f pdftex.ch pdfetex.ch
+@MAINT@ cd $(distdir); bash -c "rm -f tests/x* tests/allbib.{bbl,blg,dvi,log}"
+@MAINT@ cd $(distdir)/tests && ln -s ../../../../tests/xampl.bib .
+@MAINT@ cd $(distdir); bash -c "rm -f $(omega_files) alephmem.h"
+@MAINT@ cd $(distdir); bash -c "rm -f cweb.c *{coerce,d}.h"
+@MAINT@ cd $(distdir); bash -c "rm -f omega*.c aleph*.c"
+@MAINT@ cd $(distdir); bash -c "rm -f tex*.c etex*.c"
+@MAINT@ cd $(distdir); bash -c "rm -f pdftex*.c pdfetex*.c"
+@MAINT@ cd $(distdir); bash -c "rm -f mf*.c mp*.c"
+@MAINT@ cd $(distdir); bash -c "rm -f macnames.c *extra.c"
+@MAINT@ touch $(distdir)/doc/*.info*
+@MAINT@
+@MAINT@web-dist:
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@ mkdir -p $(distdir)
+@MAINT@ for f in *.web; do ln $$f $(distdir); done
+@MAINT@ rm -f $(distdir)/etex.web $(distdir)/omega.web $(distdir)/aleph.web
+@MAINT@ rm -f $(distdir)/pdftex.web $(distdir)/pdfetex.web
+@MAINT@ cd $(distdir); bash -c "rm -f $(omega_files)"
+@MAINT@ chmod -w $(distdir)/*
+@MAINT@ GZIP=-9 tar czf web-$(version).tar.gz $(top_distdir)
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@
+@MAINT@etex-dist: etexdir/etex.version
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@ mkdir -p $(distdir)/etexdir
+@MAINT@ cp -rp etexdir/* $(distdir)/etexdir
+@MAINT@ rm -rf $(distdir)/etexdir/CVS $(distdir)/etexdir/*/CVS
+@MAINT@ rm -f $(distdir)/etexdir/etexextra.h $(distdir)/etexdir/etex.version
+@MAINT@ GZIP=-9 tar czf web2c-$(version)-etex-`cat etexdir/etex.version`.tar.gz $(top_distdir)
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@
+@MAINT@omega-dist:
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@ mkdir -p $(distdir)/omegadir
+@MAINT@ mkdir -p $(distdir)/omegaware $(distdir)/omegafonts $(distdir)/otps
+@MAINT@ cp -p omegadir/* $(distdir)/omegadir
+@MAINT@ cd omegafonts && $(MAKE) lex.yy.c y_tab.c
+@MAINT@ for f in omegafonts/*.[chly] omegafonts/*.in; do cp -p $$f $(distdir)/omegafonts; done
+@MAINT@ cp -p omegaware/* $(distdir)/omegaware
+@MAINT@ cd otps && $(MAKE) lex.yy.c y_tab.c
+@MAINT@ for f in otps/*.[chly] otps/*.in; do cp -p $$f $(distdir)/otps; done
+@MAINT@ cp -p otps/mkocp otps/mkofm $(distdir)/otps
+@MAINT@# We supply the flex/bison output in case the user can't generate them.
+@MAINT@ cd $(distdir)/omegafonts; ../../../../../rename 's/$$/-dist/' lex.yy.c y_tab.[ch]
+@MAINT@ cd $(distdir)/otps; ../../../../../rename 's/$$/-dist/' lex.yy.c y_tab.[ch]
+@MAINT@ GZIP=-9 tar czf web2c-$(version)-omega-`cat omegadir/omega.version`.tar.gz $(top_distdir)
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@
+@MAINT@aleph-dist: alephdir/aleph.version
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@ mkdir -p $(distdir)/alephdir
+@MAINT@ cp -p alephdir/* $(distdir)/alephdir
+@MAINT@ @echo "*** Removing generated files ***"
+@MAINT@ rm -f $(distdir)/alephdir/alephextra.h
+@MAINT@ GZIP=-9 tar czf web2c-$(version)-aleph-`cat alephdir/aleph.version`.tar.gz $(top_distdir)
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@
+@MAINT@pdftex-dist: pdftexdir/pdftex.version
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@ mkdir -p $(distdir)/pdftexdir $(distdir)/pdfetexdir
+@MAINT@ cp -rp pdftexdir/* $(distdir)/pdftexdir
+@MAINT@ cp -rp pdfetexdir/* $(distdir)/pdfetexdir
+@MAINT@ rm -rf $(distdir)/pdf*texdir/CVS $(distdir)/pdf*texdir/*/CVS
+@MAINT@ rm -f $(distdir)/pdf*texdir/Makefile
+@MAINT@ rm -f $(distdir)/pdf*texdir/*.[oa]
+@MAINT@ rm -f $(distdir)/pdf*texdir/*/config.*
+@MAINT@ rm -f $(distdir)/pdf*texdir/*/Makefile
+@MAINT@ rm -f $(distdir)/pdf*texdir/*/*.[oa]
+@MAINT@ rm -f $(distdir)/pdf*texdir/*/*/Makefile
+@MAINT@ rm -f $(distdir)/pdf*texdir/*/*/*.[ao]
+@MAINT@ rm -f $(distdir)/pdf*texdir/*/*/pdftoepdf.cc
+@MAINT@ rm -f $(distdir)/pdf*texdir/*/*/epdf.h
+@MAINT@ rm -f $(distdir)/pdf*texdir/pdf*texextra.h
+@MAINT@ rm -f $(distdir)/pdf*texdir/pdf*tex.version
+@MAINT@ mkdir -p $(top_distdir)/libs/xpdf
+@MAINT@ cp -rp $(top_srcdir)/../../libs/xpdf/* $(top_distdir)/libs/xpdf
+@MAINT@ rm -rf $(top_distdir)/libs/xpdf/CVS $(top_distdir)/libs/xpdf/*/CVS
+@MAINT@ rm -f $(top_distdir)/libs/xpdf/Makefile
+@MAINT@ rm -f $(top_distdir)/libs/xpdf/config.*
+@MAINT@ rm -f $(top_distdir)/libs/xpdf/aconf.h
+@MAINT@ rm -f $(top_distdir)/libs/xpdf/*/Makefile
+@MAINT@ rm -f $(top_distdir)/libs/xpdf/*/*.[oa]
+@MAINT@ rm -f $(top_distdir)/libs/xpdf/*/c-auto.h
+@MAINT@ GZIP=-9 tar czf web2c-$(version)-pdftex-`cat pdftexdir/pdftex.version`.tar.gz $(top_distdir)
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@
+@MAINT@libs-dist:
+@MAINT@ rm -rf $(top_distdir)
+@MAINT@ mkdir -p $(libs_distdir)/zlib
+@MAINT@ cp -rp $(top_srcdir)/../../libs/zlib/* $(libs_distdir)/zlib
+@MAINT@ mkdir -p $(libs_distdir)/libpng
+@MAINT@ cp -rp $(top_srcdir)/../../libs/libpng/* $(libs_distdir)/libpng
+@MAINT@ mkdir -p $(libs_distdir)/md5
+@MAINT@ cp -rp $(top_srcdir)/../../libs/md5/* $(libs_distdir)/md5
+@MAINT@ rm -f $(libs_distdir)/*/Makefile
+@MAINT@ rm -f $(libs_distdir)/*/config.*
+@MAINT@ rm -f $(libs_distdir)/*/c-auto.h
+@MAINT@ rm -f $(libs_distdir)/*/*.[oa]
+@MAINT@ GZIP=-9 tar czf web2c-$(version)-pdftexlibs.tar.gz $(top_distdir)
+@MAINT@ rm -rf $(top_distdir)
+
+kpse_include ../make/dist.mk
+
+kpse_include ../make/config.mk
+
+@MAINT@$(srcdir)/configure: $(srcdir)/withenable.ac
+
+#
+
+installcheck:
+ cd $(srcdir)/tests && bibtex allbib
+ mf '\mode:=ljfour; input logo10' && tftopl logo10.tfm >/dev/null
+ tex '\nonstopmode \tracingstats=1 \input story \bye'
+
+#
+# Cleaning.
+all_subdirs = doc lib man $(mpware) web2c window $(omegafonts) $(otps) $(pdftexdir) $(pdfetexdir)
+
+# Having a multiple-target rule with the subdir loop fails because of
+# the dependencies introduced by clean.mk. Yet, we want the
+# dependencies here at the top level so that distclean will run the
+# clean rules, etc. So, sigh, put the subdir loop in each target and
+# only run it if we have a Makefile. Alternatively, we could do as
+# Automake does.
+
+mostlyclean:: tangleboot-clean ctangleboot-clean
+ test ! -r lib/Makefile \
+ || for d in $(all_subdirs); do (cd $$d && $(MAKE) $@); done
+clean::
+ test ! -r lib/Makefile \
+ || for d in $(all_subdirs); do (cd $$d && $(MAKE) $@); done
+ rm -f *.log *.fmt *.base *.mem *.fls *.ofl *.aux
+distclean::
+ test ! -r lib/Makefile \
+ || for d in $(all_subdirs); do (cd $$d && $(MAKE) $@); done
+ rm -f fmtutil.cnf
+extraclean::
+ test ! -r lib/Makefile \
+ || for d in $(all_subdirs); do (cd $$d && $(MAKE) $@); done
+maintainer-clean::
+ test ! -r lib/Makefile \
+ || for d in $(all_subdirs); do (cd $$d && $(MAKE) $@); done
+
+kpse_include ../make/clean.mk
+
+@MAINT@depend::
+@MAINT@ for d in lib $(mpware) web2c window $(otps); do \
+@MAINT@ (cd $$d && $(MAKE) depend); done
+
+kpse_include ../make/rdepend.mk
+kpse_include depend.mk
+
+#
+# Local variables:
+# page-delimiter: "^# \f"
+# End:
diff --git a/Build/source/texk/web2c/NEWS b/Build/source/texk/web2c/NEWS
new file mode 100644
index 00000000000..29317455abe
--- /dev/null
+++ b/Build/source/texk/web2c/NEWS
@@ -0,0 +1,398 @@
+This file records noteworthy changes.
+7.5.5
+* BibTeX: dynamically resize the buffer (and related arrays).
+* MP: Version 0.9
+* mpware: Brought to the equivalent of version 0.9.
+* e-TeX, Aleph, pdfeTeX: You can use -ini -etex to start etex mode now
+ instead of prepending an asterisk.
+
+7.5.4 (6 February 2005)
+* TeX: \ifeof18 is false if \write18 is enabled.
+* MF, MP: Prevent pathological code from overflowing the "serial number"
+ counter for independent variables.
+
+7.5.3 (28 November 2004)
+* ctie: New program, from Julian Gilbey.
+* TeX, MF, MP: We now save the name of the engine in the dump, in
+ order to be able to give better error messages in case a dump
+ written by another engine is being read.
+* TeX, MF, MP: We now dump the xord, xchr, and xprn arrays, so if
+ if a TCX file was loaded in INI mode, that will be retained
+ when the dump is loaded. (Doesn't apply to Omega family.)
+* TeX, MF, MP: Add -8bit option, which makes all characters
+ printable by default. Note that a TCX file can change this.
+ (Doesn't apply to Omega family.)
+* TeX, MF, MP: In TCX files, a third number (0 or 1) can be
+ used to set printability. (Doesn't apply to Omega family.)
+* TeX: Include encTeX extension.
+* mft: Allow more than one -style option.
+* pdfxTeX: New.
+* DVItoMP: Now supports color specials, like those added by the
+ colordvi package. Note that this feature should be considered
+ experimental, and may change in the future.
+* PATGEN: Peter Breitenlohner fixed some typos in text in patgen.web.
+
+7.5.2 (19 February 2003)
+* e-TeX: Remove last bits of support for installing it as 'tex'.
+* Makefile fixes.
+
+7.5.1 (17 February 2003)
+* New upstream sources from Knuth.
+* Lots of little fixes to the new makefiles.
+
+7.5.0 (15 February 2003)
+* Use libtool.
+* Use e-TeX, pdfeTeX as the engine for the latex, pdflatex format.
+
+7.4.6 (7 February 2003)
+* Makefile structure changed.
+* e-Omega: New
+
+7.4.5 (28 January 2003)
+* TeX: Obey locale setting only for terminal and log file.
+* METAFONT, MetaPost: Do not care about locale settings at all.
+
+7.4.4 (16 January 2003)
+* TeX: Increase maximum size of max_strings, main_memory, and pool_size.
+
+7.4.3 (11 January 2003)
+* CWEB: Add --help and --version options.
+* CWEB: Support both .w and and .web suffixes.
+* CWEB: When adding #line directives, put in the path, not just the filename.
+
+7.4.2 (23 December 2002)
+* Minor fixes to makefiles.
+
+7.4.1 (20 December 2002)
+* cweave: Fixed hangs caused by wrong argument order in two prototypes.
+
+7.4.0 (14 December 2002)
+* Using 7.4.x numbers now because the interface of kpathsea has changed in
+ ABI-incompatible ways.
+* share/*: Stop shipping fontmap files and tcx files in the web2c tarball.
+* CWEB: Add protypes to code through the change files.
+* BibTeX: Names ending in 'aux' were not handled correctly.
+* METAPost: Handle date and time privitives correctly, instead of having
+ them give the date of the mem file.
+
+7.3.11 (13 November 2002)
+* BibTeX: purify$ would strip characters with code >= 128 from its argument.
+ This has now changed to just passing them through. This should have no
+ effect if you don't use such characters in the input, but may result in
+ different output otherwise. Note that other aspects, like proper sorting
+ of such characters are not handled at all.
+* CWEB: Increase the maximum length of the names of the input files.
+
+7.3.10 (11 November 2002)
+* Added the CWEB programs. Thanks to Wlodek Bzyl.
+
+7.3.9 (22 October 2002)
+* TeX, METAFONT, METAPost: Add --jobname option to set the jobname. This
+ supercedes the use of --fmt, --efmt, --mem, and --base to set the name of
+ the format to be dumped in ini mode.
+* TANGLE: New options --length, --lowercase, --uppercase, --mixedcase,
+ --underline, --strict, --loose. These affect the output generated by
+ tangle.
+
+7.3.8 (11 October 2002)
+* BibTeX: do not split \% in an output line.
+* TeX: mention active extensions.
+* TeX: change name/banner if extensions that break strict compatibility with
+ Knuth's TeX are active.
+* web2c: splitup now uses a command-line switch to determine how after
+ how many lines it should split the sources.
+
+7.3.7 (27 November 2001)
+* Minor release, again incorporates internal changes to help Omega.
+* Update of the fontmaps.
+
+7.3.6 (18 November 2001)
+* Minor release, again incorporates internal changes to help Omega.
+* TeX, METAFONT, MetaPost:
+ New option --recorder which enables a filename recorder. A file
+ with extension .fls is created which contains the names of the
+ files opened for reading or writing.
+
+7.3.5 (10 November 2001)
+* Minor release, incorporate many changes due to developments of Omega.
+ These are mainly internal.
+
+7.3.4 (30 October 2001)
+* Minor release, incorporates most of the features also in TeX-live 6,
+ which is known as release 7.3.3.1.
+* TANGLE: As an extension, you can define parametric macros where '[' and ']'
+ delimit the argument.
+* MFT: Support METAPOST sources.
+* MPTO: Add -tex=program option. Buffer is now configurable.
+
+7.3.3 (5 August 2000)
+* Minor release.
+* METAFONT: Obey buf_size from texmf.cnf instead of using a hard-coded value.
+
+7.3.2 (19 April 2000)
+* Minor release containing bugfixes for 7.3.1. Web2C 7.3.1 was not released
+ on CTAN, only in teTeX 1.0
+* The TeX-live 5 CD contains Web2C 7.3.1x, which is based on the 7.3.1 release
+ and contains some changes that have yet to be merged into the main tree. In
+ particular, the code for "C-style" error messages and the code for source
+ specials has not been merged yet.
+
+7.3.1 (30 May 1999)
+* Minor release containing bugfixes for 7.3. Web2C 7.3 was not released
+ on CTAN, only on the TeX-live 4 CD.
+
+7.3 (26 March 1999)
+* New upstream sources from Knuth.
+* TeX, METAFONT, MetaPost:
+ (Re)introduction of TCX files.
+* Increased capacity of several programs.
+* Support for pdfeTeX added.
+* Long-standing bugs in VFtoPL and TFtoPL, which led to corrupted TFM
+ files being generated, have been fixed.
+
+7.2 (15 March 1998)
+* New upstream version of MetaPost: 0.64.
+* TeX, METAFONT, MetaPost:
+ Allow for more restrictions on the files written by \openout.
+* TeX, METAFONT, MetaPost:
+ New option --interaction, which can be used to set batchmode, nonstopmode,
+ scrollmode, or errorstopmode. Thus we can replace a construct like
+ tex '\batchmode \input foo'
+ with
+ tex --interaction=batchmode foo
+ and have a %&format line select the correct format.
+* When %&format selects a format, the search paths are changed to conform
+ to that format.
+* TeX, METAFONT, MetaPost:
+ During an "ini" run, the name of the format to be dumped can be set with
+ the --fmt/--efmt/--base/--mem options.
+* web2c: Extensive support for building e-TeX, Omega, a PDFTeX.
+* web2c: The manual pages are back.
+
+7.1 (10 November 1997)
+* Some MSDOS/Win32 support added to the sources.
+* BibTeX: increased capacity.
+* VPtoVF: Increased capacity.
+* TeX, METAFONT, MetaPost:
+ - File foo.bar.tex results in \jobname foo.bar, hence foo.bar.{log,dvi,...}.
+ This as opposed to foo and foo.{log,dvi,...} which it how it used to be in
+ version 6. In 7.0 situation was confusing, as the heuristics used would
+ sometimes result in the extension being stripped, sometimes not.
+* TeX:
+ - The -extend-jobname option has been removed.
+ - Printing of non-ASCII characters in diagnostics, code by Bernd Raichle.
+ - All three of LF, CR, and CRLF are recognized end-of-line tokens.
+* web2c:
+ - Some support for e-TeX added to convert.
+
+7.0 (6 February 1997)
+* Update from Knuth for tex, mf, dvitype, pltotf, vptovf, and tangle,
+ John Hobby's MetaPost (and support programs) included,
+ update from P. Breitenlohner to dvicopy 1.5 and patgen 2.3.
+* Update for kpathsea 3.0.
+* Texinfo manual written.
+* Amiga, OS/2, Windows NT support in the sources.
+* TeX:
+ - if -shell-escape or shell_escape in texmf.cnf is enabled,
+ \write18{str} passes str to system(3) for processing by sh.
+ - MLTeX extensions (\charsubdef, etc.) can be enabled at runtime.
+ - Many array sizes can be set dynamically, in texmf.cnf.
+ - MakeTeXTFM installed and enabled by default.
+ - IPC communications to an external program for incremental DVI reading.
+ - texfonts.map applies to TFM files, as originally intended.
+ - More than 256 fonts are allowed.
+ - DVI comment (with timestamp) can be overridden.
+ - tex.web's consistency checks on .fmt files restored.
+* Metafont:
+ - A few array sizes can be set dynamically, in texmf.cnf.
+ - X11 support disabled by default; configure --with-x to enable it.
+ - MakeTeXMF enabled and installed by default.
+* TeX, Metafont, MetaPost:
+ - If the first line of the main input file starts with %&, the rest of
+ the line is used as the fmt/base/mem file (if it can be found),
+ except that %&ini means initex/inimf/inimpost.
+ - One binary: initex/mf/mpost capabilities merged with virtex/mf/mpost.
+ - New option -progname sets program name independently of argv[0].
+ - Eight-bit filenames are output correctly in ^^ notation, instead of
+ always being simplified to ^^@.
+ - MakeTeX* scripts can be named and disabled via texmf.cnf.
+ - MakeTeX* scripts are silent if \batchmode is in effect.
+ - TEXMFINI environment variable checked for pool/fmt/base/mem lookups.
+ - \openout (TeX) and write (MP) by default will not write to files
+ whose names start with `.'.
+ - ``Small'' versions no longer supported without source hacking.
+ - Length bug regarding single non-ASCII characters in MF and MP fixed.
+* BibTeX:
+ - Some arrays dynamically reallocated as needed, other sizes increased.
+ - Default behavior is verbose; new -terse option changes that.
+ - Statistics are written to the .blg file.
+ - Does not look at TEXINPUTS to find .bst files, but does check
+ TEXBIB (after BIBINPUTS).
+ - Does not interactively ask for the top-level .aux name.
+* All programs:
+ - Supply default extensions and default output files.
+ - Support the standard --help and --version options.
+ - Filenames not arbitrarily restricted in length.
+ - Output written in the current directory, not the directory of
+ an input file. (Most interesting for tangle.)
+ - Times-Roman etc. work as font names, via texfonts.map and subsidiaries.
+* dvitype prints decimal opcode numbers with --show-opcodes.
+* bibtex and gftodvi never interactively ask for filenames;
+ dvitype and dvicopy do not enter interactive dialogues.
+* mft looks in MFTINPUTS, not TEXINPUTS.
+* Configuration:
+ - Optional features are enabled via configure --with-* and --enable-*
+ options. Run configure --help.
+ - There is no small TeX, Metafont, or MetaPost. If you want it, you'll
+ have to change the change files, #define SMALL* yourself, and do
+ whatever else is necessary yourself.
+* Source hierarchy substantially simplified.
+* Web2c:
+ - Support for ifndef...endifn, a la ifdef.
+ - Support for const expressions.
+ - Can generate ANSI code.
+
+Version 6.1 (3 February 1994)
+* foo.bar found before foo.tex (found before foo).
+* configure links sun.c to sun-sunview.c if SUNWIN is defined.
+* -DLONG_64_BITS is supplied automatically (if appropriate).
+* Various changes for configure --srcdir.
+* Sample MakeTeX* scripts included.
+
+Version 6.0 (24 January 1994)
+* Default paths changed.
+* Update for TeX 3.1415, etc.
+* Change to use the kpathsea library, a la dvipsk and xdvik.
+
+* TeX's \openin command invokes MakeTeXTeX just like \input.
+
+* TeX & Metafont:
+ - 16-byte values can be dumped, thus allowing native `long' on the DEC Alpha.
+ - But 32-bit integers are used if sharable format files are desired,
+ even on 64-bit machines.
+ - Interrupts are accepted when waiting for input.
+
+* Online output support in Metafont for Regis terminals and the NeXT.
+* gftopk can handle characters with up to 100,000 rows.
+* vftovp's -charcode-format=ascii works properly.
+* patgen doesn't give bizarre numeric output where it should be text.
+
+* configuration:
+ - -lX11 is used for OpenWindows.
+ - The MakeTeX... scripts are individually selectable by default, and
+ can always be invoked if certain environment variables are set.
+ - The subdirectory trick using st_nlink can be turned off.
+
+* Makefiles:
+ - man/Makefile doesn't remove itself at `clean'.
+ - {tex,mf}/clean-tr[ia]p doesn't reinstall a {tex,mf}d.h with the test
+ constants.
+ - web2c/Makefile removes lex and yacc output at `clean'.
+ - mkdirchain invoked as an absolute filename.
+
+* web2c:
+ - sync is no longer invoked; instead the Makefiles touch texd.h and
+ mfd.h after they are finished.
+
+Version 5.851d (22 February 1993)
+
+* A file `texfonts.map' allows arbitrary mapping of font names (as given
+ to, for instance, \font) to filenames.
+
+* Metafont & TeX:
+ - If a .tex, .tfm, or .mf file can't be found, MakeTeX{TeX,TFM,MF} is
+ invoked before giving up, as in dvips' MakeTeXPK.
+ - Sharable format/base files load faster on LittleEndian machines.
+ - TEXMFOUTPUT is only used for those files which can't be written in
+ the current directory, instead of all files after the first such.
+ Its usage is also reflected in the `... written on ...' messages at
+ the end of the run.
+ - If the DISPLAY environment variable is set, Metafont assumes you are
+ running under X11 for the purposes of online output (instead of
+ relying on the TERM or MFTERM envvar).
+ - Checks for write errors on DVI/GF output.
+ - Unusual glue values no longer make TeX dump core on some systems.
+
+* BibTeX:
+ - The cross-reference feature works as documented (I had foolishly
+ changed the default value of min_crossrefs to eliminate it).
+ - New option -min-crossrefs=<number> to change it dynamically.
+ - New option -verbose; without it, normal reportage is eliminated.
+ - Maximum number of .bib files increased to 100.
+ - Non-printable-ASCII characters in .bib files are preserved.
+
+* TeXware:
+ - tftopl adds a default extension `.tfm' to the input file if necessary.
+
+* web2c:
+ - Unsigned types are used where possible to represent Pascal
+ subranges. Among other things, this eliminates a system dependency
+ in creating format/base files (small_number was defined as `schar',
+ which varies between systems).
+
+* configuration:
+ - Unpacks into web2c-<version> instead of src-<version>.*.
+ - site.h merged into lib/c-auto.h.in and ./Makefile.in.
+ - sed is used instead of patch to make the ``small'' change files.
+ - sed is used instead of ed to make the trip/trap files.
+ - The configure script looks in more directories for the X libraries
+ and include files, and is generated from the latest version of Autoconf.
+ - mfware and texware directories merged into the others.
+ - The web2c version is defined in one place, so system information can
+ be added to the banners more easily.
+
+* Makefiles:
+ - Makefiles in subdirectories are created by configure.
+ - $(srcdir) (i.e., compiling in a different directory) is closer to working.
+ - Stamp files are not used at the top level, or for {tex,mf}/convert.
+ - New targets install-data and install-exec, to only install
+ architecture-(in)dependent files.
+
+* PROBLEMS.W2C has some notes on compiling and using these programs
+ under DOS, contributed by melvin@math.psu.edu.
+
+* The man pages have been significantly updated and improved by
+ beebe@math.utah.edu.
+
+* The original web files haven't changed.
+
+Release 4.893b:
+* Include patches from Tim to web2c to turn off the verbose output,
+ unless -d is supplied to web2c.
+* Change $(AR) in the MFwindow Makefile to `ar'.
+* Try to get the base file from the program name in Metafont, as well in
+ TeX. Implication: mf.script and tex.script are no longer supplied,
+ since a link to plain.{base,fmt} named {mf,tex}.{base,fmt} suffices.
+ `make install' doesn't create these links, since they only need to be
+ done once.
+* Move some stuff from site.h that should never be changed to a new
+ file, defaults.h. Add a new definition, SIGNAL_HANDLER_RETURN_TYPE, to
+ site.h, to get rid of the warnings in {tex,mf}/extra.c.
+* Use a sed script, contributed by eggert@twinsun.com, instead of the
+ awk script, at the beginning of the pipeline.
+* Fix an unsigned comparison problem in pltotf, that made cc produce
+ infinite ligature loops when converting trip.pl.
+* Change threshold in Metafont, and f in tftopl, so broken C compilers
+ (like some versions of pcc) don't get confused.
+* Port vftovp and vptovf. Move pktogf and pktype to fontutil.
+* Allow more than 500 kern pairs in pltotf.
+* Change the first parameter to {mf,extra}/extra.c to *filename from
+ filename[].
+* Use a better hack for the mutually recursive procedures in pltotf et al.,
+ from Tor Lillqvist <tml@hemuli.atk.vtt.fi>.
+
+Release 2.993+1.9 = 4.893a:
+Sebastian contributed the updates to ctex.ch, tftopl.ch, and pltotf.ch.
+Karl did the cmf.ch update.
+
+Release 3.0:
+Brings everything up to the new 8-bit versions.
+Almost every file has changed at least somewhat, so I'm not going to
+list all the changes. Here are some highlights:
+* char is now 0..255 instead of 0..127 in *.defines.
+* `packed' is no longer ignored as part of an identifier (e.g., `packed_trie').
+* new Makefiles to make it easier to do the trip/trap test, and with all
+ the support programs integrated.
+* ctex.ch has a hack to get around trie_op_hash being an array with a
+ negative lower bound.
+* pltotf.ch has a hack to get around mutually recursive routines.
diff --git a/Build/source/texk/web2c/PROJECTS b/Build/source/texk/web2c/PROJECTS
new file mode 100644
index 00000000000..15fa996c873
--- /dev/null
+++ b/Build/source/texk/web2c/PROJECTS
@@ -0,0 +1,63 @@
+Here are some things left to do. If you would like to contribute, send
+mail to me (olaf@infovore.xs4all.nl) first.
+
+* Use binary mode for all files (but do obey end-of-line conventions for
+ the specific platforms.
+
+* Give TeX more options:
+ output filename:lineno: msg on error
+ change prompt from `\n*' (for simpler cut-and-paste)
+
+* Have bibtex -verbose print full pathnames.
+
+* Make TeX--XeT a configure-time or runtime option?
+
+* Deal with the configure tests that prevent cross-compilation:
+ - Remove use of schar (in dvicopy, mf, pktogf, and tangle).
+ - Learn endianness at runtime, include both Big and LittleEndian
+ versions in code, call appropriate one.
+ - Figure out what to do about the sizeof long test.
+
+* Reallocate memory arrays as needed instead of just allocating once at
+ the beginning.
+
+* Possibly use spiff when doing the triptrap comparisons, so acceptable
+ differences can be eliminated.
+
+* Make web2c handle fields correctly, i.e., to put the field identifier
+ in the symbol table of the type, instead of the global symbol table.
+ This would simplify the GFtoDVI change file a fair amount.
+
+* Make web2c handle variant records. This would make the TeX, Metafont,
+ and GFtoDVI change files all simpler.
+
+* Implement overflow checking for adding and subtracting dimensions.
+ According to Knuth "a few dozen checks" would be needed (section 104).
+ Knuth calls the chances of it occuring unlikely, but unfortunately you
+ will get a bad DVI file when it does. The following source demonstrates
+ the problem.
+%
+\newcount \loopcount
+\newcount \limit
+\limit = 3570
+\hfuzz = \maxdimen
+\showboxdepth = -\maxdimen
+\showboxbreadth = -\maxdimen
+\overfullrule = 0 pt
+\tracingonline = 1 \scrollmode
+\loop
+\message {\the \limit}
+\setbox 0 = \hbox
+{\loopcount = 0
+ \loop
+ M%
+ \ifnum \loopcount < \limit
+ \advance \loopcount by 1
+ \repeat
+}%
+\message {\the \wd 0}
+\advance \limit by 1
+\iftrue
+\repeat
+\end
+%
diff --git a/Build/source/texk/web2c/README b/Build/source/texk/web2c/README
new file mode 100644
index 00000000000..4e2494995b6
--- /dev/null
+++ b/Build/source/texk/web2c/README
@@ -0,0 +1,31 @@
+This directory contains Web2c, a system which converts TeX, Metafont,
+and other related WEB programs to C. By itself, it is not a complete,
+ready-to-run, TeX distribution (I recommend teTeX for that, available on
+CTAN:/systems/tetex). Nor is it a general-purpose Pascal-to-C or
+WEB-to-C translator.
+
+Web2c is electronically distributed in two files: the web files, in
+web.tar.gz, and the Web2c-specific files, in web2c.tar.gz. If you
+already have the web files for a particular Knuthian version, you need
+not re-retrieve them. Web2c changes irregularly wrt Knuth's updates.
+
+See `NEWS' for changes by release, `ChangeLog` for all changes.
+See `INSTALL' for installation instructions.
+See `PROJECTS' for future improvements you might like to work on.
+See `../kpathsea/BUGS' for details on reporting bugs.
+
+If present, see etexdir/README, omegadir/README, and pdftexdir/README
+for details on building those packages.
+
+Web2c is free software. The files I wrote (originally for the Free
+Software Foundation) are covered by the GNU General Public License --
+see the file COPYING. Knuth's original sources are covered by their
+own copyright -- see the beginning of tex.web, mf.web, etc. You can get
+the original files on their own from CTAN:/systems/knuth; you can get
+MetaPost from ftp://netlib.att.com/netlib/research/metapost.tar.Z
+(see also http://cm.bell-labs.com/who/hobby/MetaPost.html).
+
+kb@mail.tug.org
+Member of the League for Programming Freedom -- write lpf@uunet.uu.net.
+
+olaf@infovore.xs4all.nl
diff --git a/Build/source/texk/web2c/acconfig.h b/Build/source/texk/web2c/acconfig.h
new file mode 100644
index 00000000000..a97a0853282
--- /dev/null
+++ b/Build/source/texk/web2c/acconfig.h
@@ -0,0 +1,51 @@
+/* acconfig.h -- used by autoheader when generating c-auto.in.
+
+ If you're thinking of editing acconfig.h to fix a configuration
+ problem, don't. Edit the c-auto.h file created by configure,
+ instead. Even better, fix configure to give the right answer. */
+
+/* Guard against double inclusion. */
+#ifndef WEB2C_C_AUTO_H
+#define WEB2C_C_AUTO_H
+
+/* web2c: the version string. */
+#define WEB2CVERSION "REPLACE-WITH-WEB2CVERSION"
+
+@TOP@
+
+/* Define if you get clashes concerning wchar_t, between X's include
+ files and system includes. */
+#undef FOIL_X_WCHAR_T
+
+/* tex: Define to enable --ipc. */
+#undef IPC
+
+/* web2c: Define if gcc asm needs _ on external symbols. */
+#undef ASM_NEEDS_UNDERSCORE
+
+/* web2c: Define when using system-specific files for arithmetic. */
+#undef ASM_SCALED_FRACTION
+
+/* web2c: Define to enable HackyInputFileNameForCoreDump.tex. */
+#undef FUNNY_CORE_DUMP
+
+/* web2c: Define to disable architecture-independent dump files.
+ Faster on LittleEndian architectures. */
+#undef NO_DUMP_SHARE
+
+/* web2c: Default editor for interactive `e' option. */
+#define EDITOR "vi +%d %s"
+
+/* web2c: Window system support for Metafont. */
+#undef EPSFWIN
+#undef HP2627WIN
+#undef MFTALKWIN
+#undef NEXTWIN
+#undef REGISWIN
+#undef SUNWIN
+#undef TEKTRONIXWIN
+#undef UNITERMWIN
+#undef X11WIN
+
+@BOTTOM@
+#endif /* !WEB2C_C_AUTO_H */
diff --git a/Build/source/texk/web2c/aleph.rc b/Build/source/texk/web2c/aleph.rc
new file mode 100644
index 00000000000..0ed378ac06b
--- /dev/null
+++ b/Build/source/texk/web2c/aleph.rc
@@ -0,0 +1,36 @@
+/* aleph.rc: aleph resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " Aleph 3.141592--1.15--2.1--RC2"
+
+#define VER_INTERNALNAME_STR TEXLIVE_LIBRARYPREFIX_STR "aleph"
+#define VER_ORIGINALFILENAME_STR TEXLIVE_LIBRARYPREFIX_STR "aleph.dll"
+
+#define VER_FILEDESCRIPTION_STR "Aleph DLL"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (c) 2002-2003 the e-Omega task force"
+#define VER_LEGALTRADEMARKS_STR "TeX is a trademark of the American \
+Mathematical Society."
+
+#include <texlive.version>
+
+/* aleph.rc ends here */
diff --git a/Build/source/texk/web2c/alephdir/Makefile b/Build/source/texk/web2c/alephdir/Makefile
new file mode 100644
index 00000000000..c04d858db9b
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/Makefile
@@ -0,0 +1,74 @@
+# Files used to create an Aleph without e-TeX extensions
+noaleph_files = \
+ om16bit.ch \
+ omstr.ch \
+ omfont.ch \
+ omchar.ch \
+ omfi.ch \
+ ompar.ch \
+ omocp.ch \
+ omfilter.ch \
+ omtrans.ch \
+ omdir.ch \
+
+# Files to add e-TeX extensions to Aleph
+aleph_build=rc1
+
+aleph_files = \
+ eobase.ch \
+ eofmt.ch \
+ eomem-$(aleph_build).ch \
+ eo16bit-$(aleph_build).ch \
+ eoext.ch \
+ eoeqtb.ch \
+ eofix.ch \
+ eocprt.ch \
+ eonewdir-$(aleph_build).ch \
+ eover-$(aleph_build).ch \
+ eopage-$(aleph_build).ch \
+ eochar-$(aleph_build).ch
+
+new_tex = tex-new.web
+old_tex = tex-old.web
+
+localdir = c:/texmf/miktex/bin/
+tie = $(localdir)tie.exe
+tangle = $(localdir)tangle.exe
+weave = $(localdir)weave.exe
+
+sourcedir = c:/sorci/miktex/miktex/
+
+rm = rm
+cp = cp
+
+all: aleph.p aleph.pdf
+
+etex.web: $(old_tex) etex.ch
+ $(tie) -m etex.web $(old_tex) etex.ch
+
+noaleph.web: $(new_tex) $(noaleph_files)
+ $(tie) -m noaleph.web $(new_tex) $(noaleph_files)
+
+aleph.web: noaleph.web $(aleph_files)
+ $(tie) -m aleph.web noaleph.web $(aleph_files)
+ $(cp) aleph.web aleph-$(aleph_build).web
+
+aleph.p aleph.pool: aleph.web
+ $(tangle) aleph.web nul.ch aleph.p aleph.pool
+ $(cp) aleph.pool aleph-$(aleph_build).pool
+
+aleph.tex: aleph.web
+ $(weave) aleph.web nul aleph.tex
+
+aleph.pdf: aleph.tex
+ pdftex aleph
+ $(cp) aleph.pdf aleph-$(aleph_build).pdf
+
+clean:
+ $(rm) -f noaleph.web
+ $(rm) -f aleph.web
+ $(rm) -f aleph.tex
+ $(rm) -f aleph.pdf
+ $(rm) -f aleph.log
+ $(rm) -f aleph.p
+ $(rm) -f aleph.pool
diff --git a/Build/source/texk/web2c/alephdir/aleph.c b/Build/source/texk/web2c/alephdir/aleph.c
new file mode 100644
index 00000000000..ffb921c1be1
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/aleph.c
@@ -0,0 +1,480 @@
+/* aleph.c: C routines to support the Aleph Pascal Web distribution
+ * based on omega.c from the Omega project
+
+This file is part of the Aleph project
+
+Copyleft (c) 2004 the Aleph team
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#define EXTERN extern
+#include "alephd.h"
+
+void
+btestin(void)
+{
+ string fname =
+ kpse_find_file (nameoffile + 1, kpse_program_binary_format, true);
+
+ if (fname) {
+ libcfree(nameoffile);
+ nameoffile = xmalloc(2+strlen(fname));
+ namelength = strlen(fname);
+ strcpy(nameoffile+1, fname);
+ }
+ else {
+ libcfree(nameoffile);
+ nameoffile = xmalloc(2);
+ namelength = 0;
+ nameoffile[0] = 0;
+ nameoffile[1] = 0;
+ }
+}
+
+int
+getfilemode P2C(FILE *, f, int, def)
+{
+ int c,m;
+ if ((def==0)||(feof(f))) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0x5c) {
+ if (feof(f)) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0) m=4;
+ else m=1;
+ ungetc(c,f);
+ c=0x5c;
+ }
+ }
+ else if (c==0x25) {
+ if (feof(f)) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0) m=4;
+ else m=1;
+ ungetc(c,f);
+ c=0x25;
+ }
+ }
+ else if (c==0xe0) m=2;
+ else if (c==0x6c) m=2;
+ else if (c==0) {
+ if (feof(f)) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0x5c) m=3;
+ else if (c==0x25) m=3;
+ else m=def;
+ ungetc(c,f);
+ c=0;
+ }
+ }
+ else m=def;
+ ungetc(c,f);
+ }
+ return m;
+}
+
+int
+getc_two_LE P1C(FILE *, f)
+{
+ register int i,j;
+ i = getc(f);
+ if (i==EOF) { return i; }
+ j = getc(f);
+ if (j==EOF) { return j; }
+ return ((j<<8)|i);
+}
+
+void
+ungetc_two_LE P2C(int, c, FILE *, f)
+{
+ ungetc((c>>8), f);
+ ungetc((c&0377), f);
+}
+
+int
+getc_two P1C(FILE *, f)
+{
+ register int i,j;
+ i = getc(f);
+ if (i==EOF) { return i; }
+ j = getc(f);
+ if (j==EOF) { return j; }
+ return ((i<<8)|j);
+}
+
+void
+ungetc_two P2C(int, c, FILE *, f)
+{
+ ungetc((c&0377), f);
+ ungetc((c>>8), f);
+}
+
+extern boolean zpnewinputln ();
+
+boolean
+newinputln P4C(FILE *,f, halfword,themode, halfword,translation, boolean,bypass)
+{
+ return zpnewinputln((alphafile)f,
+ (halfword)themode,
+ (halfword)translation,
+ (boolean) bypass);
+}
+
+boolean
+new_input_line P2C(FILE *, f, halfword, themode)
+{
+ register int i=EOF;
+
+ last = first;
+ otpinputend = 0;
+
+ if (themode==1) {
+ while ((otpinputend < ocpbufsize) && ((i = getc (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc(f); if (i != '\n') ungetc(i,f);
+ }
+ } else if (themode==2) {
+ while ((otpinputend < ocpbufsize) && ((i = getc (f)) != EOF) &&
+ (i != 0x25))
+ otpinputbuf[++otpinputend] = i;
+ } else if (themode==3) {
+ while ((otpinputend < ocpbufsize) && ((i = getc_two (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc_two(f); if (i != '\n') ungetc_two(i,f);
+ }
+ } else /* themode==4 */ {
+ while ((otpinputend < ocpbufsize) && ((i = getc_two_LE (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc_two_LE(f); if (i != '\n') ungetc_two_LE(i,f);
+ }
+ }
+
+ if (i == EOF && otpinputend == 0)
+ return false;
+
+ /* We didn't get the whole line because our buffer was too small.
+*/
+ if (i != EOF && (((themode!=2) && (i != '\n')) || ((themode==2) && (i != 0x25))))
+ {
+ (void) fprintf (stderr,
+ "! Unable to read an entire line---ocp_buf_size=%ld.\n",ocpbufsize);
+ (void) fprintf (stderr, "Please increase ocp_buf_size in texmf.cnf.\n");
+ uexit (1);
+ }
+
+ return true;
+}
+
+extern memoryword ziniteqtbentry () ;
+
+hashword hashtable[HASHTABLESIZE];
+
+void
+inithhashtable P1H(void)
+{
+ int i;
+ for (i=0; i<HASHTABLESIZE; i++) {
+ hashtable[i].p = -1;
+ }
+
+}
+
+hashword *
+createeqtbpos P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return runner;
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return runner;
+ }
+ runner->p = p;
+ runner->mw = ziniteqtbentry(p);
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return runner;
+}
+
+memoryword *
+createeqtbptr P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return (&(runner->mw));
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return (&(runner->mw));
+ }
+ runner->p = p;
+ runner->mw = ziniteqtbentry(p);
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return (&(runner->mw));
+}
+
+hashword *
+createxeqlevel P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return runner;
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return runner;
+ }
+ runner->p = p;
+ runner->mw.cint = 1;
+ runner->mw.cint1 = 0;
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return runner;
+}
+
+hashword *
+createhashpos P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return runner;
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return runner;
+ }
+ runner->p = p;
+ runner->mw.cint = 0;
+ runner->mw.cint1 = 0;
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return runner;
+}
+
+void
+dumphhashtable P1H(void)
+{
+ int i;
+ hashword *runner;
+ for (i=0; i<HASHTABLESIZE; i++) {
+ runner=&(hashtable[i]);
+ if (runner->p != -1) {
+ dumpint(-i);
+ while (runner->p != -1) {
+ dumpint(runner->p);
+ dumpwd(runner->mw);
+ runner=runner->ptr;
+ }
+ }
+ }
+ dumpint(-HASHTABLESIZE);
+}
+
+void
+undumphhashtable P1H(void)
+{
+ int i,j;
+ hashword *runner;
+ j=0;
+ undumpint(i);
+ while (j<HASHTABLESIZE) {
+ i = (-i);
+ while (j<i) {
+ hashtable[j].p = -1;
+ j++;
+ }
+ if (i<HASHTABLESIZE) {
+ runner = &(hashtable[j]);
+ undumpint(i);
+ while (i>=0) {
+ runner->p = i;
+ undumpwd(runner->mw);
+ undumpint(i);
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ runner = runner->ptr;
+ }
+ runner->p = -1;
+ j++;
+ }
+ }
+}
+
+void
+odateandtime P4C(int,timecode, int,daycode, int,monthcode, int,yearcode)
+{
+ integer tc,dc,mc,yc;
+ dateandtime(tc,dc,mc,yc);
+ setneweqtbint(timecode,tc);
+ setneweqtbint(daycode,dc);
+ setneweqtbint(monthcode,mc);
+ setneweqtbint(yearcode,yc);
+}
+
+memoryword **fonttables;
+static int font_entries = 0;
+
+void
+allocatefonttable P2C(int, font_number, int, font_size)
+{
+ int i;
+ if (font_entries==0) {
+ fonttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ font_entries=256;
+ } else if ((font_number==256)&&(font_entries==256)) {
+ fonttables = xrealloc(fonttables, 65536);
+ font_entries=65536;
+ }
+ fonttables[font_number] =
+ (memoryword *) xmalloc((font_size+1)*sizeof(memoryword));
+ fonttables[font_number][0].cint = font_size;
+ fonttables[font_number][0].cint1 = 0;
+ for (i=1; i<=font_size; i++) {
+ fonttables[font_number][i].cint = 0;
+ fonttables[font_number][i].cint1 = 0;
+ }
+}
+
+void
+dumpfonttable P2C(int, font_number, int, words)
+{
+ fonttables[font_number][0].cint=words;
+ dumpthings(fonttables[font_number][0], fonttables[font_number][0].cint+1);
+}
+
+void
+undumpfonttable(font_number)
+int font_number;
+{
+ memoryword sizeword;
+ if (font_entries==0) {
+ fonttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ font_entries=256;
+ } else if ((font_number==256)&&(font_entries==256)) {
+ fonttables = xrealloc(fonttables, 65536);
+ font_entries=65536;
+ }
+
+ undumpthings(sizeword,1);
+ fonttables[font_number] =
+ (memoryword *) xmalloc((sizeword.cint+1)*sizeof(memoryword));
+ fonttables[font_number][0].cint = sizeword.cint;
+ undumpthings(fonttables[font_number][1], sizeword.cint);
+}
+
+memoryword **fontsorttables;
+static int fontsort_entries = 0;
+
+void
+allocatefontsorttable P2C(int, fontsort_number, int, fontsort_size)
+{
+ int i;
+ if (fontsort_entries==0) {
+ fontsorttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ fontsort_entries=256;
+ } else if ((fontsort_number==256)&&(fontsort_entries==256)) {
+ fontsorttables = xrealloc(fontsorttables, 65536);
+ fontsort_entries=65536;
+ }
+ fontsorttables[fontsort_number] =
+ (memoryword *) xmalloc((fontsort_size+1)*sizeof(memoryword));
+ fontsorttables[fontsort_number][0].cint = fontsort_size;
+ fontsorttables[fontsort_number][0].cint1 = 0;
+ for (i=1; i<=fontsort_size; i++) {
+ fontsorttables[fontsort_number][i].cint = 0;
+ fontsorttables[fontsort_number][i].cint1 = 0;
+ }
+}
+
+void
+dumpfontsorttable P2C(int, fontsort_number, int, words)
+{
+ fontsorttables[fontsort_number][0].cint=words;
+ dumpthings(fontsorttables[fontsort_number][0],
+ fontsorttables[fontsort_number][0].cint+1);
+}
+
+void
+undumpfontsorttable(fontsort_number)
+int fontsort_number;
+{
+ memoryword sizeword;
+ if (fontsort_entries==0) {
+ fontsorttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ fontsort_entries=256;
+ } else if ((fontsort_number==256)&&(fontsort_entries==256)) {
+ fontsorttables = xrealloc(fontsorttables, 65536);
+ fontsort_entries=65536;
+ }
+
+ undumpthings(sizeword,1);
+ fontsorttables[fontsort_number] =
+ (memoryword *) xmalloc((sizeword.cint+1)*sizeof(memoryword));
+ fontsorttables[fontsort_number][0].cint = sizeword.cint;
+ undumpthings(fontsorttables[fontsort_number][1], sizeword.cint);
+}
+
+int **ocptables;
+static int ocp_entries = 0;
+
+void
+allocateocptable P2C(int, ocp_number, int, ocp_size)
+{
+ int i;
+ if (ocp_entries==0) {
+ ocptables = (int **) xmalloc(256*sizeof(int**));
+ ocp_entries=256;
+ } else if ((ocp_number==256)&&(ocp_entries==256)) {
+ ocptables = xrealloc(ocptables, 65536);
+ ocp_entries=65536;
+ }
+ ocptables[ocp_number] =
+ (int *) xmalloc((1+ocp_size)*sizeof(int));
+ ocptables[ocp_number][0] = ocp_size;
+ for (i=1; i<=ocp_size; i++) {
+ ocptables[ocp_number][i] = 0;
+ }
+}
+
+void
+dumpocptable P1C(int, ocp_number)
+{
+ dumpthings(ocptables[ocp_number][0], ocptables[ocp_number][0]+1);
+}
+
+void
+undumpocptable P1C(int, ocp_number)
+{
+ int sizeword;
+ if (ocp_entries==0) {
+ ocptables = (int **) xmalloc(256*sizeof(int**));
+ ocp_entries=256;
+ } else if ((ocp_number==256)&&(ocp_entries==256)) {
+ ocptables = xrealloc(ocptables, 65536);
+ ocp_entries=65536;
+ }
+ undumpthings(sizeword,1);
+ ocptables[ocp_number] =
+ (int *) xmalloc((1+sizeword)*sizeof(int));
+ ocptables[ocp_number][0] = sizeword;
+ undumpthings(ocptables[ocp_number][1], sizeword);
+}
diff --git a/Build/source/texk/web2c/alephdir/aleph.defines b/Build/source/texk/web2c/alephdir/aleph.defines
new file mode 100644
index 00000000000..1d866c493b0
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/aleph.defines
@@ -0,0 +1,74 @@
+{ aleph.defines: Web declarations of Aleph
+
+This file is part of Aleph,
+which is based on the web2c distribution of TeX,
+
+Copyleft (c) 2002--2004 the Aleph task force
+
+Aleph is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Aleph is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Aleph; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+}
+
+@define function newinputln ();
+@define function getfilemode ();
+@define function newinputline ();
+@define function neweqtb ();
+@define function neweqtbint ();
+@define function neweqtbsc ();
+@define function newequiv ();
+@define function newequiv1 ();
+@define function neweqlevel ();
+@define function neweqtype ();
+
+@define function newhashnext ();
+@define function newhashtext ();
+@define function newxeqlevel ();
+
+@define procedure odateandtime ();
+@define procedure allocatefonttable ();
+@define procedure dumpfonttable ();
+@define procedure undumpfonttable ();
+@define procedure allocatefontsorttable ();
+@define procedure dumpfontsorttable ();
+@define procedure undumpfontsorttable ();
+@define procedure allocateocptable ();
+@define procedure dumpocptable ();
+@define procedure undumpocptable ();
+@define procedure initeqtbtable;
+@define procedure dumpeqtbtable;
+@define procedure undumpeqtbtable;
+@define procedure setneweqtb ();
+@define procedure setneweqtbint ();
+@define procedure setneweqtbsc ();
+@define procedure setequiv ();
+@define procedure setequiv1 ();
+@define procedure seteqtype ();
+@define procedure seteqlevel ();
+@define procedure btestin ;
+@define procedure runexternalocp ();
+@define procedure changealephfilename ();
+
+@define procedure sethashnext ();
+@define procedure sethashtext ();
+@define procedure setintzero ();
+@define procedure setintone ();
+
+@define var fonttables;
+@define var fontsorttables;
+@define var ocptables;
+
+@define var ocptemp;
+
+{ end of aleph.defines }
diff --git a/Build/source/texk/web2c/alephdir/aleph.mak b/Build/source/texk/web2c/alephdir/aleph.mak
new file mode 100644
index 00000000000..cde20b5cb85
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/aleph.mak
@@ -0,0 +1,197 @@
+################################################################################
+#
+# Makefile : Aleph, Web2C win32.mak makefile fragment to build Aleph
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/03/20 16:42:18 popineau>
+#
+################################################################################
+
+# Aleph itself.
+
+aleph_build = rc2
+
+# We build aleph
+aleph = $(objdir)\aleph.exe
+!ifdef TEX_DLL
+aleph = $(aleph) $(objdir)\$(library_prefix)aleph.dll
+!endif
+
+# The C sources.
+aleph_c = aleph.c
+aleph_o = $(objdir)\aleph.obj $(objdir)\alephfirst.obj $(objdir)\alephbis.obj
+
+# Generation of the web and ch files.
+
+alephdir = .\alephdir
+
+#
+# e-Omega is build without the xml support
+# so we can't reuse aleph.web and aleph.ch
+# we need to build stripped down versions
+#
+aleph_files = \
+# $(alephdir)\omnode.ch \
+ $(alephdir)\om16bit.ch \
+ $(alephdir)\omstr.ch \
+ $(alephdir)\omfont.ch \
+ $(alephdir)\omchar.ch \
+ $(alephdir)\omfi.ch \
+ $(alephdir)\ompar.ch \
+ $(alephdir)\omocp.ch \
+ $(alephdir)\omfilter.ch \
+ $(alephdir)\omtrans.ch \
+ $(alephdir)\omdir.ch \
+ $(alephdir)\eobase.ch \
+ $(alephdir)\eofmt.ch \
+ $(alephdir)\eomem-$(aleph_build).ch \
+ $(alephdir)\eo16bit-$(aleph_build).ch \
+ $(alephdir)\eoext.ch \
+ $(alephdir)\eoeqtb.ch \
+ $(alephdir)\eofix.ch \
+ $(alephdir)\eocprt.ch \
+ $(alephdir)\eonewdir-$(aleph_build).ch \
+ $(alephdir)\eover-$(aleph_build).ch \
+ $(alephdir)\eopage-$(aleph_build).ch \
+ $(alephdir)\eochar-$(aleph_build).ch
+
+aleph_changefiles = \
+# $(alephdir)\omega.ch0 \
+# $(alephdir)\comnode.ch \
+ $(alephdir)\com16bit-$(aleph_build).ch \
+ $(alephdir)\comstr.ch \
+ $(alephdir)\comfont.ch \
+ $(alephdir)\comchar.ch \
+ $(alephdir)\comfi.ch \
+ $(alephdir)\compar.ch \
+ $(alephdir)\comocp.ch \
+ $(alephdir)\comfilter.ch \
+ $(alephdir)\comtrans.ch \
+ $(alephdir)\comdir.ch \
+# $(alephdir)\comxml.ch \
+ $(alephdir)\comsrcspec.ch \
+ $(alephdir)\ceostuff.ch \
+ $(alephdir)\comw32.ch \
+# $(alephdir)\omega.ch1 \
+# $(alephdir)\eomega.ech \
+# $(alephdir)\omega.ch2
+
+# Linking
+!ifdef TEX_DLL
+$(ojbdir)\$(library_prefix)aleph.exp: $(objdir)\$(library_prefix)aleph.lib
+
+$(objdir)\$(library_prefix)aleph.lib: $(aleph_o)
+ $(archive) /DEF $(aleph_o)
+
+$(objdir)\$(library_prefix)aleph.dll: $(aleph_o) $(objdir)\$(library_prefix)aleph.exp $(objdir)\aleph.res $(alephlibsdep) $(kpathsealib) $(proglib)
+ $(link_dll) $(**) $(conlibs)
+
+$(objdir)\aleph.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)aleph.lib $(proglib)
+ $(link) $(**) $(socketslib) $(conlibs)
+!else
+$(objdir)\aleph.exe: $(aleph_o) $(objdir)\win32main.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(socketlibs) $(conlibs)
+!endif
+
+# The C files
+$(aleph_c) alephcoerce.h alephd.h: aleph.p $(web2c_texmf)
+ $(web2c) aleph
+# Additional C files, just copy them.
+alephfirst.c: alephdir\aleph.c
+ -$(del) $@
+ $(copy) $(srcdir)\alephdir\aleph.c $@
+alephbis.c: alephdir\alephbis.c
+ -$(del) $@
+ $(copy) $(srcdir)\alephdir\alephbis.c $@
+alephmem.h: alephdir\alephmem.h
+ -$(del) $@
+ $(copy) $(srcdir)\alephdir\alephmem.h $@
+
+# The Pascal file
+aleph.p aleph.pool: $(objdir)\otangle.exe aleph.web aleph.ch
+ $(objdir)\otangle aleph.web aleph.ch
+
+# Generation of the web and ch files.
+aleph.web: $(objdir)\tie.exe tex.web $(aleph_files)
+ $(objdir)\tie.exe -m $@ tex.web $(aleph_files)
+
+aleph.ch: $(objdir)\tie.exe aleph.web $(aleph_changefiles)
+ $(objdir)\tie.exe -c $@ aleph.web $(aleph_changefiles)
+
+# Check: right now all we do is build the format.
+check: aleph-check
+aleph-check: aleph aleph.afmt
+# Cleaning up from building aleph
+clean:: aleph-clean
+aleph-clean:
+ -@echo $(verbose) & ( \
+ for %%i in ($(aleph_c) alephextra.c alephcoerce.h alephd.h \
+ alephfirst.c alephbis.c aleph.p aleph.pool \
+ aleph.web aleph.ch) do $(del) %%i $(redir_stderr) \
+ )
+#
+# Dumps.
+# all_afmts = aleph.afmt $(afmts)
+
+# dumps: afmts
+# afmts: $(all_afmts)
+
+# aleph.afmt: $(aleph)
+# $(dumpenv) $(make) progname=aleph files="omega.tex" prereq-check
+# $(dumpenv) .\$(objdir)\aleph --ini --progname=aleph --jobname=aleph "\\input omega.tex \\dump" < nul
+#
+# elambda.afmt: $(aleph)
+# $(dumpenv) $(make) progname=elambda files="lambda.tex" prereq-check
+# $(dumpenv) .\$(objdir)\aleph --ini --progname=elambda --progname=elambda --jobname=elambda "\\input lambda.tex" < nul
+
+
+#
+# Installation.
+install-aleph: install-aleph-exec install-aleph-data
+install-aleph-exec: install-aleph-links
+# install-aleph-data: install-aleph-dumps
+install-aleph-dumps: install-aleph-fmts
+
+# The actual binary executables and pool files.
+install-programs: install-aleph-programs
+install-aleph-programs: $(aleph) $(bindir)
+ -@echo $(verbose) & ( \
+ for %%p in ($(aleph)) do copy %%p $(bindir) $(redir_stdout) \
+ )
+
+# install-links: install-aleph-links
+install-aleph-links: install-aleph-programs
+# -@echo $(verbose) & ( \
+# pushd $(bindir) & \
+# $(del) inialeph.exe viraleph.exe & \
+# $(lnexe) .\aleph.exe .\inialeph.exe & \
+# $(lnexe) .\aleph.exe .\viraleph.exe & \
+# popd \
+# ) $(redir_stdout)
+ -@echo $(verbose) & ( \
+ if not "$(afmts)"=="" \
+ for %%i in ($(afmts)) do \
+ pushd $(bindir) & \
+ $(del) .\%%~ni.exe & \
+ $(lnexe) .\aleph.exe $(bindir)\%%~ni.exe & \
+ popd \
+ ) $(redir_stdout)
+
+# install-fmts: install-aleph-fmts
+install-aleph-fmts: afmts $(fmtdir)
+ -@echo $(verbose) & ( \
+ if not "$(afmts)"=="" \
+ for %%f in ($(afmts)) do $(copy) %%f $(fmtdir)\%%f $(redir_stdout) \
+ ) $(redir_stdout)
+
+# Auxiliary files.
+install-data:: install-aleph-data
+install-aleph-data: $(texpooldir)
+ @$(copy) aleph.pool $(texpooldir)\aleph.pool $(redir_stdout)
+
+# end of aleph.mak
+#
+# Local variables:
+# page-delimiter: "^# \f"
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/alephdir/aleph.mk b/Build/source/texk/web2c/alephdir/aleph.mk
new file mode 100644
index 00000000000..b519e4b000b
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/aleph.mk
@@ -0,0 +1,184 @@
+# Makefile fragment for Aleph and web2c. --infovore@xs4all.nl. Public domain.
+# This fragment contains the parts of the makefile that are most likely to
+# differ between releases of Aleph.
+
+alephdir = alephdir
+calephdir = alephdir
+
+Makefile: $(alephdir)/aleph.mk
+#
+# Aleph itself.
+
+# We build aleph
+aleph = @ALEPH@ aleph
+alephbuild=rc2
+
+# The C sources.
+aleph_c = alephini.c aleph0.c aleph1.c aleph2.c aleph3.c
+aleph_o = alephini.o aleph0.o aleph1.o aleph2.o \
+ alephextra.o aleph.o alephbis.o \
+ aleph3.o
+
+# Linking
+aleph: $(aleph_o)
+ $(kpathsea_link) $(aleph_o) $(socketlibs) $(LOADLIBES)
+
+# The C files
+$(aleph_c) alephcoerce.h alephd.h: aleph.p $(web2c_texmf)
+ $(web2c) aleph
+alephextra.c: lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/aleph/ $(srcdir)/lib/texmfmp.c >$@
+$(alephdir)/alephextra.h: $(alephdir)/alephextra-$(alephbuild).h
+ -rm -f $@
+ test -d $(alephdir) || mkdir $(alephdir)
+ cp $(srcdir)/$(alephdir)/alephextra-$(alephbuild).h $@
+
+# Additional C files, just copy them.
+aleph.c: $(calephdir)/aleph.c
+ -rm -f $@
+ cp $(srcdir)/$(calephdir)/aleph.c $@
+alephbis.c: $(calephdir)/alephbis.c
+ -rm -f $@
+ cp $(srcdir)/$(calephdir)/alephbis.c $@
+alephmem.h: $(calephdir)/alephmem.h
+ -rm -f $@
+ cp $(srcdir)/$(calephdir)/alephmem.h $@
+
+# The Pascal file
+aleph.p aleph.pool: otangle aleph.web aleph.ch
+ $(OTANGLE) aleph.web aleph.ch
+
+# Generation of the web and ch files.
+aleph.web: tie tex.web $(alephdir)/aleph.mk
+aleph.web: $(alephdir)/om16bit.ch
+aleph.web: $(alephdir)/omstr.ch
+aleph.web: $(alephdir)/omfont.ch
+aleph.web: $(alephdir)/omchar.ch
+aleph.web: $(alephdir)/omfi.ch
+aleph.web: $(alephdir)/ompar.ch
+aleph.web: $(alephdir)/omocp.ch
+aleph.web: $(alephdir)/omfilter.ch
+aleph.web: $(alephdir)/omtrans.ch
+aleph.web: $(alephdir)/omdir.ch
+aleph.web: $(alephdir)/eobase.ch
+aleph.web: $(alephdir)/eofmt.ch
+aleph.web: $(alephdir)/eomem-$(alephbuild).ch
+aleph.web: $(alephdir)/eo16bit-$(alephbuild).ch
+aleph.web: $(alephdir)/eoext.ch
+aleph.web: $(alephdir)/eoeqtb.ch
+aleph.web: $(alephdir)/eofix.ch
+aleph.web: $(alephdir)/eocprt.ch
+aleph.web: $(alephdir)/eonewdir-$(alephbuild).ch
+aleph.web: $(alephdir)/eover-$(alephbuild).ch
+aleph.web: $(alephdir)/eopage-$(alephbuild).ch
+aleph.web: $(alephdir)/eochar-$(alephbuild).ch
+ $(TIE) -m aleph.web $(srcdir)/tex.web \
+ $(srcdir)/$(alephdir)/om16bit.ch \
+ $(srcdir)/$(alephdir)/omstr.ch \
+ $(srcdir)/$(alephdir)/omfont.ch \
+ $(srcdir)/$(alephdir)/omchar.ch \
+ $(srcdir)/$(alephdir)/omfi.ch \
+ $(srcdir)/$(alephdir)/ompar.ch \
+ $(srcdir)/$(alephdir)/omocp.ch \
+ $(srcdir)/$(alephdir)/omfilter.ch \
+ $(srcdir)/$(alephdir)/omtrans.ch \
+ $(srcdir)/$(alephdir)/omdir.ch \
+ $(srcdir)/$(alephdir)/eobase.ch \
+ $(srcdir)/$(alephdir)/eofmt.ch \
+ $(srcdir)/$(alephdir)/eomem-$(alephbuild).ch \
+ $(srcdir)/$(alephdir)/eo16bit-$(alephbuild).ch \
+ $(srcdir)/$(alephdir)/eoext.ch \
+ $(srcdir)/$(alephdir)/eoeqtb.ch \
+ $(srcdir)/$(alephdir)/eofix.ch \
+ $(srcdir)/$(alephdir)/eocprt.ch \
+ $(srcdir)/$(alephdir)/eonewdir-$(alephbuild).ch \
+ $(srcdir)/$(alephdir)/eover-$(alephbuild).ch \
+ $(srcdir)/$(alephdir)/eopage-$(alephbuild).ch \
+ $(srcdir)/$(alephdir)/eochar-$(alephbuild).ch
+aleph.ch: tie aleph.web $(alephdir)/aleph.mk
+aleph.ch: $(calephdir)/com16bit-$(alephbuild).ch
+aleph.ch: $(calephdir)/comstr.ch
+aleph.ch: $(calephdir)/comfont.ch
+aleph.ch: $(calephdir)/comchar.ch
+aleph.ch: $(calephdir)/comfi.ch
+aleph.ch: $(calephdir)/compar.ch
+aleph.ch: $(calephdir)/comocp.ch
+aleph.ch: $(calephdir)/comfilter.ch
+aleph.ch: $(calephdir)/comtrans.ch
+aleph.ch: $(calephdir)/comdir.ch
+aleph.ch: $(calephdir)/comsrcspec.ch
+aleph.ch: $(calephdir)/ceostuff.ch
+ $(TIE) -c aleph.ch aleph.web \
+ $(srcdir)/$(calephdir)/com16bit-$(alephbuild).ch \
+ $(srcdir)/$(calephdir)/comstr.ch \
+ $(srcdir)/$(calephdir)/comfont.ch \
+ $(srcdir)/$(calephdir)/comchar.ch \
+ $(srcdir)/$(calephdir)/comfi.ch \
+ $(srcdir)/$(calephdir)/compar.ch \
+ $(srcdir)/$(calephdir)/comocp.ch \
+ $(srcdir)/$(calephdir)/comfilter.ch \
+ $(srcdir)/$(calephdir)/comtrans.ch \
+ $(srcdir)/$(calephdir)/comdir.ch \
+ $(srcdir)/$(calephdir)/comsrcspec.ch \
+ $(srcdir)/$(calephdir)/ceostuff.ch
+# Check: right now all we do is build the format.
+check: @ALEPH@ aleph-check
+aleph-check: aleph aleph.fmt
+# Cleaning up from building aleph
+clean:: aleph-clean
+aleph-clean:
+ $(LIBTOOL) --mode=clean $(RM) aleph
+ rm -f $(aleph_c) alephextra.c alephcoerce.h alephd.h
+ rm -f $(alephdir)/alephextra.h
+ rm -f aleph.c alephbis.c alephmem.h
+ rm -f aleph.p aleph.pool aleph.web aleph.ch
+
+#
+# Dumps.
+all_afmts = aleph.fmt $(afmts)
+
+dumps: @ALEPH@ afmts
+afmts: $(all_afmts)
+
+afmtdir = $(web2cdir)/aleph
+$(afmtdir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(afmtdir)
+
+aleph.fmt: aleph
+ $(dumpenv) $(MAKE) progname=aleph files="omega.ini" prereq-check
+ $(dumpenv) ./aleph --ini --progname=aleph --jobname=aleph \\input omega.tex \\dump </dev/null
+lamed.fmt: aleph
+ $(dumpenv) $(MAKE) progname=lamed files="lambda.tex" prereq-check
+ $(dumpenv) ./aleph --ini --progname=lamed --jobname=lamed \\input lambda.tex </dev/null
+
+#
+# Installation.
+install-aleph: install-aleph-exec install-aleph-data
+install-aleph-exec: install-aleph-programs install-aleph-links
+install-aleph-data: install-aleph-pool @FMU@ install-aleph-dumps
+install-aleph-dumps: install-aleph-fmts
+
+# The actual binary executables and pool files.
+install-programs: @ALEPH@ install-aleph-programs
+install-aleph-programs: aleph $(bindir)
+ for p in aleph; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+
+install-links: @ALEPH@ install-aleph-links
+install-aleph-links: install-aleph-programs
+ #cd $(bindir) && (rm -f inialeph viraleph; \
+ # $(LN) aleph inialeph; $(LN) aleph viraleph)
+
+install-fmts: @ALEPH@ install-aleph-fmts
+install-aleph-fmts: afmts $(afmtdir)
+ afmts="$(all_afmts)"; \
+ for f in $$afmts; do $(INSTALL_DATA) $$f $(afmtdir)/$$f; done
+ afmts="$(afmts)"; \
+ for f in $$afmts; do base=`basename $$f .fmt`; \
+ (cd $(bindir) && (rm -f $$base; $(LN) aleph $$base)); done
+
+# Auxiliary files.
+install-data:: @ALEPH@ install-aleph-data
+install-aleph-pool: aleph.pool $(texpooldir)
+ $(INSTALL_DATA) aleph.pool $(texpooldir)/aleph.pool
+
+# end of aleph.mk
diff --git a/Build/source/texk/web2c/alephdir/aleph.version b/Build/source/texk/web2c/alephdir/aleph.version
new file mode 100644
index 00000000000..17490a66bbf
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/aleph.version
@@ -0,0 +1 @@
+1.15-2.1-rc4
diff --git a/Build/source/texk/web2c/alephdir/alephbis.c b/Build/source/texk/web2c/alephdir/alephbis.c
new file mode 100644
index 00000000000..45594d422f5
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/alephbis.c
@@ -0,0 +1,331 @@
+/* alephbis.c: C routines to support external OCPs
+ * based on omegabis.c from the Omega project
+
+This file is part of the Aleph project
+
+Copyleft (c) 2004 the Aleph team
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#define EXTERN extern
+#include <stdlib.h>
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+#include "alephd.h"
+#undef read
+
+#if 1
+
+void
+runexternalocp P1C(string, external_ocp_name)
+{
+ char *in_file_name;
+ char *out_file_name;
+ FILE *in_file;
+ FILE *out_file;
+ int in_file_fd;
+ int out_file_fd;
+ char command_line[400];
+ int i;
+ unsigned c;
+ int c_in;
+#ifdef WIN32
+ char *tempenv;
+
+#define null_string(s) ((s == NULL) || (*s == '\0'))
+
+ tempenv = getenv("TMPDIR");
+ if (null_string(tempenv))
+ tempenv = getenv("TEMP");
+ if (null_string(tempenv))
+ tempenv = getenv("TMP");
+ if (null_string(tempenv))
+ tempenv = "c:/tmp"; /* "/tmp" is not good if we are on a CD-ROM */
+ in_file_name = concat(tempenv, "/__aleph__in__XXXXXX");
+ mktemp(in_file_name);
+ in_file = fopen(in_file_name, FOPEN_WBIN_MODE);
+#else
+
+#if HAVE_MKSTEMP
+ in_file_name = xstrdup("/tmp/__aleph__in__XXXXXX");
+ in_file_fd = mkstemp(in_file_name);
+ in_file = fdopen(in_file_fd, FOPEN_WBIN_MODE);
+#else
+#if HAVE_MKTEMP
+ in_file_name = xstrdup("/tmp/__aleph__in__XXXXXX");
+ mktemp(in_file_name);
+#else
+ in_file_name = xstrdup(tmpnam(NULL));
+#endif /* HAVE_MKTEMP */
+ in_file = fopen(in_file_name, FOPEN_WBIN_MODE);
+#endif /* HAVE_MKSTEMP */
+
+#endif /* WIN32 */
+
+ if (in_file == NULL)
+ fprintf(stderr, "aleph: error opening file: %s\n", strerror(errno));
+
+ for (i=1; i<=otpinputend; i++) {
+ c = otpinputbuf[i];
+ if (c>0xffff) {
+ fprintf(stderr, "Aleph does not currently support 31-bit chars\n");
+ exit(1);
+ }
+ if (c>0x4000000) {
+ fputc(0xfc | ((c>>30) & 0x1), in_file);
+ fputc(0x80 | ((c>>24) & 0x3f), in_file);
+ fputc(0x80 | ((c>>18) & 0x3f), in_file);
+ fputc(0x80 | ((c>>12) & 0x3f), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c>0x200000) {
+ fputc(0xf8 | ((c>>24) & 0x3), in_file);
+ fputc(0x80 | ((c>>18) & 0x3f), in_file);
+ fputc(0x80 | ((c>>12) & 0x3f), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c>0x10000) {
+ fputc(0xf0 | ((c>>18) & 0x7), in_file);
+ fputc(0x80 | ((c>>12) & 0x3f), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c>0x800) {
+ fputc(0xe0 | ((c>>12) & 0xf), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c>0x80) {
+ fputc(0xc0 | ((c>>6) & 0x1f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else {
+ fputc(c & 0x7f, in_file);
+ }
+ }
+ fclose(in_file);
+
+#define advance_cin if ((c_in = fgetc(out_file)) == -1) { \
+ fprintf(stderr, "File contains bad char\n"); \
+ goto end_of_while; \
+ }
+
+#ifdef WIN32
+ out_file_name = concat(tempenv, "/__aleph__out__XXXXXX");
+ mktemp(out_file_name);
+ out_file = fopen(out_file_name, FOPEN_RBIN_MODE);
+#else
+
+#if HAVE_MKSTEMP
+ out_file_name = xstrdup("/tmp/__aleph__out__XXXXXX");
+ out_file_fd = mkstemp(out_file_name);
+ out_file = fdopen(out_file_fd, FOPEN_RBIN_MODE);
+#else
+#if HAVE_MKTEMP
+ out_file_name = xstrdup("/tmp/__aleph__out__XXXXXX");
+ mktemp(out_file_name);
+#else
+ out_file_name = xstrdup(tmpnam(NULL));
+#endif /* HAVE_MKTEMP */
+ out_file = fopen(out_file_name, FOPEN_RBIN_MODE);
+#endif /* HAVE_MKSTEMP */
+
+#endif /* WIN32 */
+
+ if (out_file == NULL)
+ fprintf(stderr, "aleph: error opening file: %s\n", strerror(errno));
+
+ sprintf(command_line, "%s <%s >%s\n",
+ external_ocp_name+1, in_file_name, out_file_name);
+ system(command_line);
+ otpoutputend = 0;
+ otpoutputbuf[otpoutputend] = 0;
+ while ((c_in = fgetc(out_file)) != -1) {
+ if (c_in>=0xfc) {
+ c = (c_in & 0x1) << 30;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 24;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 18;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 12;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else if (c_in>=0xf8) {
+ c = (c_in & 0x3) << 24;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 18;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 12;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else if (c_in>=0xf0) {
+ c = (c_in & 0x7) << 18;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 12;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else if (c_in>=0xe0) {
+ c = (c_in & 0xf) << 12;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else if (c_in>=0x80) {
+ c = (c_in & 0x1f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else {
+ c = c_in & 0x7f;
+ }
+ otpoutputbuf[++otpoutputend] = c;
+ }
+
+end_of_while:
+ remove(in_file_name);
+ remove(out_file_name);
+}
+
+#else
+
+void
+runexternalocp P1C(string, external_ocp_name)
+{
+ int outpipes[2], inpipes[2];
+ char *outbuf;
+ char *inbuf;
+ int n;
+ int chars_read_in, chars_to_go_out;
+ int myerrno;
+
+#ifdef WIN32
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+ HANDLE hIn, hOut, hPipeIn, hPipeOut;
+ SECURITY_ATTRIBUTES sa = { sizeof(SECURITY_ATTRIBUTES), NULL, TRUE };
+ DWORD ret = 0;
+
+ /* Make pipes to send data from the parent to the child. The parent
+ writes to outpipes[0], and the child reads from outpipes[1]. */
+ _pipe (outpipes, 0, _O_BINARY);
+ /* Make pipes to send data from the child to the parent. The child
+ writes to inpipes[0], and the parent reads from inpipes[1]. */
+ _pipe (inpipes, 0, _O_BINARY);
+
+ ZeroMemory( &si, sizeof(STARTUPINFO) );
+ si.cb = sizeof(STARTUPINFO);
+ si.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
+ si.wShowWindow = SW_SHOW;
+ si.hStdInput = _get_osfhandle(outpipes[0]);
+ si.hStdOutput = _get_osfhandle(inpipes[1]);
+ si.hStdError = _get_osfhandle(_fileno(stderr));
+
+ /* Close unnecessary pipes. */
+ close (outpipes[1]);
+ close (inpipes[0]);
+
+ if (CreateProcess(external_ocp_name+1,
+ NULL, /* Use lpApplicationName */
+ NULL,
+ NULL,
+ TRUE, /* bInheritHandles */
+ 0,
+ NULL,
+ NULL,
+ &si,
+ &pi) == 0) {
+ fprintf(stderr, "Failed to create process for %s (Error %d).\n", external_ocp_name+1, GetLastError());
+ return;
+ }
+
+#else /* ! WIN32 */
+
+ /* Make pipes to send data from the parent to the child. The parent
+ writes to outpipes[0], and the child reads from outpipes[1]. */
+ pipe (outpipes);
+ /* Make pipes to send data from the child to the parent. The child
+ writes to inpipes[0], and the parent reads from inpipes[1]. */
+ pipe (inpipes);
+
+ /* For a child process. */
+ if (fork () == 0)
+ {
+ /* This part is executed by the child process. It translates
+ lower case letters to upper case. */
+
+ char *prog = external_ocp_name+1;
+ char *args[] = {external_ocp_name+1, NULL};
+
+ /* Close unnecessary pipes. They are for the parent. */
+ close (outpipes[1]);
+ close (inpipes[0]);
+
+ /* Connect pipes to stdin and stdout. */
+ dup2 (outpipes[0], 0);
+ dup2 (inpipes[1], 1);
+
+ /* Overlays a new process image on an old process. */
+ execv (prog, args);
+
+ /* We should never reach here. */
+ }
+ else
+ {
+ /* Close unnecessary pipes. They are for the child. */
+ close (outpipes[0]);
+ close (inpipes[1]);
+
+#endif /* WIN32 */
+
+/* Here is the interesting part */
+ outbuf = ((char *) otpinputbuf)+2;
+ inbuf = ((char *) otpoutputbuf)+2;
+ chars_to_go_out = 2*otpinputend;
+ chars_read_in = 0;
+ while ((n = write (outpipes[1], outbuf, chars_to_go_out))>0) {
+fprintf(stderr, "Wrote (1) %d characters\n", n);
+ outbuf+=n;
+ chars_to_go_out-=n;
+ if (chars_to_go_out==0) goto done_writing;
+/*
+ n = read (inpipes[0], inbuf, 1024);
+fprintf(stderr, "Read (1) %d characters\n", n);
+ inbuf+=n;
+ chars_read_in+=n;
+*/
+ }
+fprintf(stderr, "Wrote (2) %d characters\n", n);
+
+done_writing:
+ close (outpipes[1]);
+ while ((n = read (inpipes[0], inbuf, 1024)) > 0) {
+fprintf(stderr, "Read (2) %d characters\n", n);
+ inbuf+=n;
+ chars_read_in+=n;
+ }
+fprintf(stderr, "Read (3) %d characters\n", n);
+ otpoutputend = chars_read_in / 2;
+
+ close (inpipes[0]);
+#ifndef WIN32
+ }
+#endif
+}
+
+#endif
diff --git a/Build/source/texk/web2c/alephdir/alephextra-rc1.h b/Build/source/texk/web2c/alephdir/alephextra-rc1.h
new file mode 100644
index 00000000000..516577b59c4
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/alephextra-rc1.h
@@ -0,0 +1,36 @@
+/* alephextra.h: banner etc. for Aleph.
+
+ This is included by Aleph, from ../alephextra.c
+ (generated from ../lib/texmfmp.c).
+
+This file is part of Aleph.
+
+Copyleft (c) 2004 the Aleph team
+
+Aleph is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Aleph is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Aleph; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define BANNER "This is Aleph, Version 3.141592--1.15--2.1 (RC1)"
+#define COPYRIGHT_HOLDER "the Aleph task force"
+#define AUTHOR NULL
+#define PROGRAM_HELP ALEPHHELP
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "inialeph"
+#define VIR_PROGRAM "viraleph"
diff --git a/Build/source/texk/web2c/alephdir/alephextra-rc2.h b/Build/source/texk/web2c/alephdir/alephextra-rc2.h
new file mode 100644
index 00000000000..99d0a2be53c
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/alephextra-rc2.h
@@ -0,0 +1,37 @@
+/* alephextra.h: banner etc. for Aleph.
+
+ This is included by Aleph, from ../alephextra.c
+ (generated from ../lib/texmfmp.c).
+
+This file is part of Aleph.
+
+Copyleft (c) 2004 the Aleph team
+
+Aleph is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Aleph is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Aleph; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define BANNER "This is Aleph, Version 3.141592-1.15-2.1-rc4"
+#define COPYRIGHT_HOLDER "the Aleph task force"
+#define AUTHOR NULL
+#define PROGRAM_HELP ALEPHHELP
+#define BUG_ADDRESS "tex-k@mail.tug.org"
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "inialeph"
+#define VIR_PROGRAM "viraleph"
diff --git a/Build/source/texk/web2c/alephdir/alephextra.h b/Build/source/texk/web2c/alephdir/alephextra.h
new file mode 100644
index 00000000000..99d0a2be53c
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/alephextra.h
@@ -0,0 +1,37 @@
+/* alephextra.h: banner etc. for Aleph.
+
+ This is included by Aleph, from ../alephextra.c
+ (generated from ../lib/texmfmp.c).
+
+This file is part of Aleph.
+
+Copyleft (c) 2004 the Aleph team
+
+Aleph is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Aleph is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Aleph; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define BANNER "This is Aleph, Version 3.141592-1.15-2.1-rc4"
+#define COPYRIGHT_HOLDER "the Aleph task force"
+#define AUTHOR NULL
+#define PROGRAM_HELP ALEPHHELP
+#define BUG_ADDRESS "tex-k@mail.tug.org"
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "inialeph"
+#define VIR_PROGRAM "viraleph"
diff --git a/Build/source/texk/web2c/alephdir/alephmem.h b/Build/source/texk/web2c/alephdir/alephmem.h
new file mode 100644
index 00000000000..28704c3aacf
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/alephmem.h
@@ -0,0 +1,129 @@
+/* alephmem.h: C declarations for types and accessing routines in aleph.c
+
+This file is part of the Aleph project, which
+is based on the web2c distribution of TeX.
+
+Copyleft (c) 2004 the Aleph team
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+
+extern boolean new_input_line ();
+extern boolean newinputln ();
+extern int getc_two ();
+extern int getfilemode ();
+extern void ungetc_two ();
+extern int ocptemp;
+
+#define newinputline(stream, mode, flag) new_input_line (stream, mode)
+
+extern memoryword **fonttables;
+extern memoryword **fontsorttables;
+extern int **ocptables;
+
+typedef struct hashw
+{
+ integer p;
+ struct hashw *ptr;
+ memoryword mw;
+} hashword;
+
+extern hashword hashtable[];
+extern hashword *createhashpos();
+extern hashword *createeqtbpos();
+extern hashword *createxeqlevel();
+extern void inithhashtable();
+extern void dumphhashtable();
+extern void undumphhashtable();
+extern void allocatefonttable();
+extern void dumpfonttable();
+extern void undumpfonttable();
+extern void allocatefontsorttable();
+extern void dumpfontsorttable();
+extern void undumpfontsorttable();
+extern void allocateocptable();
+extern void dumpocptable();
+extern void undumpocptable();
+extern void odateandtime();
+extern void btestin();
+extern void runexternalocp();
+
+#define initeqtbtable() inithhashtable();
+#define dumpeqtbtable() dumphhashtable();
+#define undumpeqtbtable() undumphhashtable();
+
+#define HASHTABLESIZE 23123
+#define neweqtb(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw) : \
+ (createeqtbpos(a)->mw))
+#define neweqtbint(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint) : \
+ (createeqtbpos(a)->mw.cint))
+#define neweqtbsc(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint) : \
+ (createeqtbpos(a)->mw.cint))
+#define newequiv(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.rh) : \
+ (createeqtbpos(a)->mw.hh.rh))
+#define newequiv1(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint1) : \
+ (createeqtbpos(a)->mw.cint1))
+#define neweqlevel(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b1) : \
+ (createeqtbpos(a)->mw.hh.b1))
+#define neweqtype(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b0) : \
+ (createeqtbpos(a)->mw.hh.b0))
+#define setneweqtb(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw=v) : \
+ (createeqtbpos(a)->mw=v))
+#define setneweqtbint(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint=v) : \
+ (createeqtbpos(a)->mw.cint=v))
+#define setneweqtbsc(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint=v) : \
+ (createeqtbpos(a)->mw.cint=v))
+#define setequiv(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.rh=v) : \
+ (createeqtbpos(a)->mw.hh.rh=v))
+#define setequiv1(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint1=v) : \
+ (createeqtbpos(a)->mw.cint1=v))
+#define seteqlevel(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b1=v) : \
+ (createeqtbpos(a)->mw.hh.b1=v))
+#define seteqtype(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b0=v) : \
+ (createeqtbpos(a)->mw.hh.b0=v))
+
+#define newhashnext(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.LH) : \
+ (createhashpos(a)->mw.hh.v.LH))
+#define newhashtext(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.RH) : \
+ (createhashpos(a)->mw.hh.v.RH))
+#define sethashnext(a,d) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.LH=d) : \
+ (createhashpos(a)->mw.hh.v.LH=d))
+#define sethashtext(a,d) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.RH=d) : \
+ (createhashpos(a)->mw.hh.v.RH=d))
+
+#define newxeqlevel(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint) : \
+ (createxeqlevel(a)->mw.cint))
+
+#define setintzero(w,a) ((w).cint=(a))
+#define setintone(w,a) ((w).cint1=(a))
diff --git a/Build/source/texk/web2c/alephdir/ceostuff.ch b/Build/source/texk/web2c/alephdir/ceostuff.ch
new file mode 100644
index 00000000000..06d7e6afd85
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/ceostuff.ch
@@ -0,0 +1,72 @@
+% still more web2c stuff for the e-TeX part of Aleph
+% this will be merged into the others soon
+
+@x [51.1332] l.24203 (ca.) texarray
+ line_stack:=xmalloc_array (integer, max_in_open);
+@y
+ line_stack:=xmalloc_array (integer, max_in_open);
+ eof_seen:=xmalloc_array (boolean, max_in_open);
+ grp_stack:=xmalloc_array (save_pointer, max_in_open);
+ if_stack:=xmalloc_array (pointer, max_in_open);
+@z
+
+@x [51.1337] l.24371 (ca.) texarray
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+ hyph_root:=0; hyph_start:=0;
+@z
+
+@x [53a.1379] l.??? -etex command line switch
+@!init if (buffer[loc]="*")and(format_ident=" (INIALEPH)") then
+@y
+@!init if (etex_p or(buffer[loc]="*"))and(format_ident=" (INIALEPH)") then
+@z
+
+@x [53a.1379] l.??? -etex command line switch
+ incr(loc); eTeX_mode:=1; {enter extended mode}
+@y
+ if (buffer[loc]="*") then incr(loc);
+ eTeX_mode:=1; {enter extended mode}
+@z
+
+@x [53a.1383] l.??? -etex command line switch
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+@y
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+@!etex_p: boolean; {was the -etex option specified}
+@z
+
+@x [53a.???] l.??? texarray
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+@y
+@!eof_seen : ^boolean; {has eof been seen?}
+@z
+
+@x [53a.???] l.??? texarray
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+@y
+@!grp_stack : ^save_pointer; {initial |cur_boundary|}
+@!if_stack : ^pointer; {initial |cond_ptr|}
+@z
+
+@x [53a.???] l.??? texarray
+hyph_root:=0; hyph_start:=0;
+@y
+@z
+
+% @x [54/web2c.???] l.??? needed earlier
+% replacement, but always existing character |font_bc[f]|.
+% @^inner loop@>
+%
+% @<Declare additional functions for ML\TeX@>=
+% function effective_char(@!err_p:boolean;
+% @y
+% replacement, but always existing character |font_bc[f]|.
+% @^inner loop@>
+%
+% @<Declare \eTeX\ procedures for sc...@>=
+% function effective_char(@!err_p:boolean;
+% @z
+
diff --git a/Build/source/texk/web2c/alephdir/com-supp-w32.ch b/Build/source/texk/web2c/alephdir/com-supp-w32.ch
new file mode 100644
index 00000000000..f886235b99d
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/com-supp-w32.ch
@@ -0,0 +1,26 @@
+@x
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@y
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@!halt_on_error_p:boolean; {allow only one error.}
+@z
+
+@x
+ ready_already:=0;
+@y
+ ready_already:=0;
+ texmf_finish_job;
+@z
+
+@x
+print_char("."); show_context;
+@y
+if not file_line_error_style_p then begin
+ print_char("."); show_context
+end;
+
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+
+@z
diff --git a/Build/source/texk/web2c/alephdir/com16bit-rc1.ch b/Build/source/texk/web2c/alephdir/com16bit-rc1.ch
new file mode 100644
index 00000000000..8ee1d54c5cc
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/com16bit-rc1.ch
@@ -0,0 +1,2507 @@
+% com16bit.ch: Aleph version of file tex.ch
+%
+% tex.ch for C compilation with web2c, derived from various other change files.
+% By Tim Morgan, UC Irvine ICS Department, and many others.
+%
+% (05/28/86) ETM Started with TeX 2.0
+% (06/03/87) ETM Brought up to TeX 2.2
+% (09/26/87) ETM Brought up to TeX 2.3
+% (10/01/87) ETM Brought up to TeX 2.5
+% (12/21/87) ETM Brought up to TeX 2.7
+% (01/14/88) ETM Brought up to TeX 2.9
+% (02/20/88) PAM Revised format and module numbers
+% (03/01/88) ETM Eliminated some unused variables and unnecesary tests
+% (05/09/88) ETM Added yet another casting bug fix
+% (06/21/88) ETM Brought up to TeX version 2.93
+% (12/11/88) ETM Brought up to TeX version 2.94
+% (01/12/89) PAM Brought up to TeX version 2.95
+% (02/14/89) ETM Brought up to TeX version 2.96
+% (03/10/89) ETM Brought up to TeX version 2.98
+% (07/06/89) ETM Brought up to TeX version 2.991
+% (11/30/89) KB To version 2.992 (8-bit).
+% (01/10/90) SR To version 2.993.
+% (03/27/90) KY To version 3.0.
+% (more recent changes in ChangeLog)
+%
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+%
+% The module numbers in this change file refer to TEX.WEB 3.141592 as
+% of March, 1995 (published as Donald E. Knuth, TeX: The Program,
+% Volume B of Computers & Typesetting).
+
+@x [0.0] l.83 - WEAVE: print changes only.
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+@y 83
+ \def\?##1]{\hbox{Changes to \hbox to 1em{\hfil##1}.\ }}
+ }
+\let\maybe=\iffalse
+@z
+
+@x
+@d banner=='This is Aleph, Version 3.141592--1.15--2.1 (RC1)' {printed when \TeX\ starts}
+@y
+@d banner=='This is Aleph, Version 3.141592--1.15--2.1 (RC1)' {printed when \TeX\ starts}
+@d banner_k=='This is Alephk, Version 3.141592--1.15--2.1 (RC1)' {printed when \TeX\ starts}
+@z
+
+@x [1.4] l.233 - program header
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \TeX\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+@y
+@z
+
+@x [1.4] l.243 - labels in outer block not needed
+program OMEGA; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+@y
+program OMEGA; {all file names are defined dynamically}
+@z
+
+@x [1.6] l.267 - labels in outer block not needed
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d end_of_TEX=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
+ {key control points}
+@y
+@ For Web2c, labels are not declared in the main program, but
+we still have to declare the symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d final_end=9999 {this label marks the ending of the program}
+@z
+
+% Here we change these WEB symbols, which are used much as #ifdef's
+% are in C, into something which will get translated into actual #ifdef's.
+@x [1.7] l.292 - debug..gubed, stat..tats
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==ifdef('TEXMF_DEBUG')
+@d gubed==endif('TEXMF_DEBUG')
+@z
+@x [1.7] l.297 - debug..gubed, stat..tats
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@y
+@d stat==ifdef('STAT')
+@d tats==endif('STAT')
+@z
+
+@x [1.8] l.312 - Same, for `init...tini'.
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y 312
+@d init==ifdef('INITEX')
+@d tini==endif('INITEX')
+@z
+
+@x [1.8] l.319 - init...tini is dynamic
+@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
+@y 318
+@!init
+if ini_version then
+ begin @<Initialize table entries (done by \.{INITEX} only)@>@;
+ end;
+@+tini
+@z
+
+@x [1.11] l.375 - Compile-time constants: most removed for dynamic allocation.
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@y
+@d file_name_size == maxint
+@d ssup_error_line = 255
+@d ssup_max_strings ==200000
+{Larger values may be used, but then the arrays consume much more memory.}
+@d ssup_trie_opcode == 65535
+@d ssup_trie_size == 4194303
+
+@d ssup_hyph_size == 65535 {Changing this requires changing (un)dumping!}
+@d iinf_hyphen_size == 610 {Must be not less than |hyph_prime|!}
+
+@<Constants...@>=
+@!mem_bot=0; {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+ {Use |mem_bot=0| for compilers which cannot decrement pointers.}
+@z
+
+@x
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TeXformats:ALEPH.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@y
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@!hash_offset=514; {smallest index in hash array, i.e., |hash_base| }
+ {Use |hash_offset=0| for compilers which cannot decrement pointers.}
+@!trie_op_size=15011; {space for ``opcodes'' in the hyphenation patterns;
+ best if relatively prime to 313, 361, and 1009.}
+@!neg_trie_op_size=-15011; {for lower |trie_op_hash| array bound;
+ must be equal to |-trie_op_size|.}
+@!min_trie_op=0; {first possible trie op code for any language}
+@!max_trie_op=ssup_trie_opcode; {largest possible trie opcode for any language}
+@!pool_name=TEX_POOL_NAME; {this is configurable, for the sake of ML-\TeX}
+ {string of length |file_name_size|; tells where the string pool appears}
+@#
+@!inf_main_memory = 2000000;
+@!sup_main_memory = 16000000;
+
+@!inf_trie_size = 80000;
+@!sup_trie_size = ssup_trie_size;
+
+@!inf_max_strings = 100000;
+@!sup_max_strings = ssup_max_strings;
+
+@!inf_strings_free = 100;
+@!sup_strings_free = sup_max_strings;
+
+@!inf_buf_size = 500;
+@!sup_buf_size = 200000;
+
+@!inf_nest_size = 40;
+@!sup_nest_size = 400;
+
+@!inf_max_in_open = 6;
+@!sup_max_in_open = 127;
+
+@!inf_param_size = 60;
+@!sup_param_size = 600;
+
+@!inf_save_size = 600;
+@!sup_save_size = 40000;
+
+@!inf_stack_size = 200;
+@!sup_stack_size = 3000;
+
+@!inf_dvi_buf_size = 800;
+@!sup_dvi_buf_size = 65536;
+
+@!inf_pool_size = 32000;
+@!sup_pool_size = 10000000;
+@!inf_pool_free = 1000;
+@!sup_pool_free = sup_pool_size;
+@!inf_string_vacancies = 8000;
+@!sup_string_vacancies = sup_pool_size - 23000;
+
+@!sup_hyph_size = ssup_hyph_size;
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@z
+
+@x [1.12] l.427 - Constants that are WEB numeric macros.
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions;
+ if you change this, you should also change |iinf_hyphen_size|.}
+@z
+
+@x [1.16] l.498 - Use C macros for `incr' and `decr'.
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@y
+@z
+
+% The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x [2.19] l.565 - data type text_char is 8-bit ASCII_code
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+% [3.26] name_of_file is no longer an array. And change the destination
+% type to text_char, which fixes:
+%
+% Date: 19 Sep 1994 10:38:24 +0200
+% From: thorinn@diku.dk (Lars Mathiesen)
+% When echoed to the screen and in the log, character codes
+% above '177 in file names are shown wrongly (typically as ^@).
+%
+@x [3.26] l.789 - name_of_file is no longer an array
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@y
+@!name_of_file:^char;
+@z
+
+@x [3.27] l.794 - Do file opening in C.
+@ The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `{\bf packed array
+$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\TeX\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\TeX's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@ All of the file opening functions are defined in C.
+@z
+
+@x [3.28] l.850 - Do file closing in C.
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+These procedures should not generate error messages if a file is
+being closed before it has been successfully opened.
+
+@p procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var f:word_file); {close a word file}
+begin close(f);
+end;
+@y
+@ And all the file closing routines as well.
+@z
+
+@x [3.30] l.888 - Array size of input buffer is determined at runtime.
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@y
+@!buffer:^ASCII_code; {lines of characters being read}
+@z
+
+@x [3.31] l.933 - Do `input_ln' in C.
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=f^; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+We define |input_ln| in C, for efficiency.
+@z
+
+% [3.32] `term_in' and `term_out' are standard input and output.
+% Declare the variables that used to be constants.
+@x [3.32] l.961 - `term_in' and `term_out' are standard input and output.
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+@y
+@d term_in==stdin {the terminal as an input file}
+@d term_out==stdout {the terminal as an output file}
+
+@<Glob...@>=
+@!init
+@!ini_version:boolean; {are we \.{INITEX}?}
+@!dump_option:boolean; {was the dump name option used?}
+@!dump_line:boolean; {was a \.{\%\AM format} line seen?}
+tini@/
+@#
+@!bound_default:integer; {temporary for setup}
+@!bound_name:^char; {temporary for setup}
+@#
+@!main_memory:integer; {total memory words allocated in initex}
+@!extra_mem_bot:integer; {|mem_min:=mem_bot-extra_mem_bot| except in \.{INITEX}}
+@!mem_min:integer; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!mem_top:integer; {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|,
+ equal to |mem_max| in \.{INITEX}, else not greater than |mem_max|}
+@!extra_mem_top:integer; {|mem_max:=mem_top+extra_mem_top| except in \.{INITEX}}
+@!mem_max:integer; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!error_line:integer; {width of context lines on terminal error messages}
+@!half_error_line:integer; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@!max_strings:integer; {maximum number of strings; must not exceed |max_halfword|}
+@!strings_free:integer; {strings available after format loaded}
+@!string_vacancies:integer; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size:integer; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!pool_free:integer;{pool space free after format loaded}
+@!hyph_size:integer; {maximun number of hyphen exceptions}
+@!trie_size:integer; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX. 50000 is
+ needed for English, German, and Portuguese.}
+@!buf_size:integer; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!stack_size:integer; {maximum number of simultaneous input sources}
+@!max_in_open:integer; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!param_size:integer; {maximum number of simultaneous macro parameters}
+@!nest_size:integer; {maximum number of semantic levels simultaneously active}
+@!save_size:integer; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@z
+
+@x [3.33] l.964 - We don't need to open terminal files.
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+@y
+@ Here is how to open the terminal files. |t_open_out| does nothing.
+|t_open_in|, on the other hand, does the work of ``rescanning,'' or getting
+any command line arguments the user has provided. It's defined in C.
+
+@d t_open_out == {output already open for text output}
+@z
+
+@x [3.34] l.982 - Flushing output to terminal files.
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@y
+these operations can be specified with {\mc UNIX}. |update_terminal|
+does an |fflush|. |clear_terminal| is redefined
+to do nothing, since the user should control the terminal.
+@^system dependencies@>
+
+@d update_terminal == fflush (term_out)
+@d clear_terminal == do_nothing
+@z
+
+@x [3.35] l.1017 - Do `input_ln' in C => section not needed.
+@<Report overflow of the input buffer, and abort@>=
+if format_ident=0 then
+ begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+ end
+else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+@y
+Routine is implemented in C; part of module is, however, needed for e-TeX.
+
+@<Report overflow of the input buffer, and abort@>=
+ begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+@z
+
+@x [3.37] l.1055 - |init_terminal|, reading the command line.
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+@y
+@ The following program does the required initialization.
+Iff anything has been specified on the command line, then |t_open_in|
+will return with |last > first|.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+if last > first then
+ begin loc := first;
+ while (loc < last) and (buffer[loc]=' ') do incr(loc);
+ if loc < last then
+ begin init_terminal := true; goto exit;
+ end;
+ end;
+@z
+
+@x [3.37] l.1068 - |init_terminal|, output missing newline.
+ write(term_out,'! End of file on the terminal... why?');
+@y
+ write_ln(term_out,'! End of file on the terminal... why?');
+@z
+
+@x [4.38] l.1126 - Array size for string pool is determined at runtime.
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@y
+@!pool_pointer = integer; {for variables that point into |str_pool|}
+@!str_number = 0..ssup_max_strings; {for variables that point into |str_start|}
+@z
+
+@x [4.39] l.1131 - Dynamically size pool arrays.
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start_ar : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@!str_pool: ^packed_ASCII_code; {the characters}
+@!str_start_ar : ^pool_pointer; {the starting pointers}
+@z
+
+@x [4.47] l.1237 - string recycling
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+@y
+@p @t\4@>@<Declare additional routines for string recycling@>@/
+
+@!init function get_strings_started:boolean; {initializes the string pool,
+@z
+
+% [4.51] Open the pool file using a path, and can't do string
+% assignments directly. (`strcpy' and `strlen' work here because
+% `pool_name' is a constant string, and thus ends in a null and doesn't
+% start with a space.)
+@x [4.51] l.1314 - Open the pool file.
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+@y
+name_length := strlen (pool_name);
+name_of_file := xmalloc_array (char, name_length + 1);
+strcpy (name_of_file+1, pool_name); {copy the string}
+if a_open_in (pool_file, kpse_texpool_format) then
+@z
+
+@x [4.51] l.1322 - Make `OMEGA.POOL' lowercase, and change how it's read.
+else bad_pool('! I can''t read ALEPH.POOL.')
+@y
+else bad_pool('! I can''t read ', pool_name, '; bad path?')
+@z
+@x [4.52] l.1326 - Make `OMEGA.POOL' lowercase, and change how it's read.
+begin if eof(pool_file) then bad_pool('! ALEPH.POOL has no check sum.');
+@.ALEPH.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+@y
+begin if eof(pool_file) then bad_pool('! ', pool_name, ' has no check sum.');
+@.ALEPH.POOL has no check sum@>
+read(pool_file,m); read(pool_file,n); {read two digits of string length}
+@z
+@x [4.52] l.1332 - Make `ALEPH.POOL' lowercase, and change how it's read.
+ bad_pool('! ALEPH.POOL line doesn''t begin with two digits.');
+@y
+ bad_pool('! ', pool_name, ' line doesn''t begin with two digits.');
+@z
+@x [4.53] l.1354 - Make `ALEPH.POOL' lowercase, and change how it's read.
+ bad_pool('! ALEPH.POOL check sum doesn''t have nine digits.');
+@y
+ bad_pool('! ', pool_name, ' check sum doesn''t have nine digits.');
+@z
+@x [4.53] l.1360 - Make `OMEGA.POOL' lowercase, and change how it's read.
+done: if a<>@$ then bad_pool('! ALEPH.POOL doesn''t match; OTANGLE me again.');
+@y
+done: if a<>@$ then
+ bad_pool('! ', pool_name, ' doesn''t match; otangle me again (or fix the path).');
+@z
+
+@x [5.54] l.1422 - error_line
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+@y
+@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for
+@z
+
+@x [5.61] l.1556 - Print rest of banner, eliminate misleading `(no format preloaded)'.
+wterm(eTeX_banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+@y
+wterm(eTeX_banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+@z
+
+@x [6.73] l.1732 - Add unspecified_mode.
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@y
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d unspecified_mode=4 {extra value for command-line switch}
+@z
+
+@x [6.73] l.1738 - Add interaction_option.
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@y
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@!interaction_option:batch_mode..unspecified_mode; {set from command line}
+@z
+
+@x [6.74] l.1740 - Allow override by command line switch.
+@ @<Set init...@>=interaction:=error_stop_mode;
+@y
+@ @<Set init...@>=if interaction_option=unspecified_mode then
+ interaction:=error_stop_mode
+else
+ interaction:=interaction_option;
+@z
+
+% [6.81] Eliminate nonlocal goto, since C doesn't have them.
+% Plus, it's nicer just to do an exit with the appropriate status code
+% under Unix. We call it `uexit' because there's a WEB symbol called
+% `exit' already. We use a C macro to change `uexit' back to `exit'.
+@x [6.81] l.1852 - Eliminate nonlocal goto, since C doesn't have them.
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+@y
+@d do_final_end==begin
+ update_terminal;
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+ uexit(1)
+ else
+ uexit(0);
+ end
+
+@<Error hand...@>=
+procedure jump_out;
+begin
+close_files_and_terminate;
+do_final_end;
+end;
+@z
+
+@x [6.84] l.1888 - Implement the switch-to-editor option.
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@y
+line ready to be edited.
+We do this by calling the external procedure |call_edit| with a pointer to
+the filename, its length, and the line number.
+However, here we just set up the variables that will be used as arguments,
+since we don't want to do the switch-to-editor until after TeX has closed
+its files.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@d edit_file==input_stack[base_ptr]
+@z
+
+@x [6.84] l.1903 - Implement the switch-to-editor option.
+"E": if base_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ slow_print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+@y
+"E": if base_ptr>0 then
+ begin edit_name_start:=str_start(edit_file.name_field);
+ edit_name_length:=str_start(edit_file.name_field+1) -
+ str_start(edit_file.name_field);
+ edit_line:=line;
+ jump_out;
+@z
+
+% [7.104] `remainder' is a library routine on some systems, so change
+% its name to avoid conflicts.
+@x [7.104] l.2227 - avoid name conflicts with lib routine remainder()
+|remainder|, holds the remainder after a division.
+
+@<Glob...@>=
+@y
+|remainder|, holds the remainder after a division.
+
+@d remainder==tex_remainder
+
+@<Glob...@>=
+@z
+
+@x [7.109] l.2352 - Define glue_ratio in C.
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+@y
+@z
+
+@x [8.112] l.2435 - Efficiency.
+macros are simplified in the obvious way when |min_quarterword=0|.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+macros are simplified in the obvious way when |min_quarterword=0|.
+So they have been simplified here in the obvious way.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item from a quarterword}
+@d hi(#)==# {to put a sixteen-bit item into a halfword}
+@d ho(#)==# {to take a sixteen-bit item from a halfword}
+@z
+
+% [8.113] We've put the memory structure into the include file
+% `texmf.h', since it's too hard to translate automatically.
+@x [8.113] l.2453 - data structures for main memory
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case four_choices of
+ 1: (@!int:integer);
+ 2: (@!gr:glue_ratio);
+ 3: (@!hh:two_halves);
+ 4: (@!qqqq:four_quarters);
+ end;
+@y
+@!quarterword = min_quarterword..max_quarterword;
+@!halfword = min_halfword..max_halfword;
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@=#include "texmfmem.h";@>
+@=#include "alephmem.h";@>
+@z
+
+% [9.116] Change `mem' to `zmem', so we can define mem to be a register
+% pointer to the memory array for speed.
+@x [9.116] l.2545 - definition of main memory array
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@y
+@!yzmem : ^memory_word; {the big dynamic storage area}
+@!zmem : ^memory_word; {the big dynamic storage area}
+@z
+
+% [9.127] Fix casting problem in C.
+% There are several of these. They come from the rules C uses for
+% comparing signed and unsigned quantities. Just doing the comparison
+% can result in incorrect evaluation wrt the way Pascal would do it.
+@x [9.127] l.2739 - Fix casting problem in C.
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+@y 2738
+if r>intcast(p+1) then @<Allocate from the top of node |p| and |goto found|@>;
+@z
+
+% [11.165] Fix the word `free' so that it doesn't conflict with the
+% standard C library routine of the same name.
+@x [11.165] l.3364 - avoid conflict with lib function free()
+are debugging.)
+@y
+are debugging.)
+
+@d free==free_arr
+@z
+
+@x [11.165] l.3367 - dummy |free| and |was_free| arrays
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [mem_min..mem_max] of boolean;
+@y
+ {The debug memory arrays have not been mallocated yet.}
+@!debug @!free: packed array [0..9] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [0..9] of boolean;
+@z
+
+@x [12.174] l.3526 - Eliminate unsigned comparisons to zero.
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+@y
+ begin @<Print the font identifier for |font(p)|@>;
+@z
+
+@x [12.176] l.3563 - Eliminate unsigned comparisons to zero.
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+@y
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin @<Print the font identifier for |font(p)|@>;
+@z
+
+@x [12.186] l.3747 - Don't worry about strange floating point values.
+ if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
+ else if abs(g)>float_constant(20000) then
+@y 3747
+ { The Unix |pc| folks removed this restriction with a remark that
+ invalid bit patterns were vanishingly improbable, so we follow
+ their example without really understanding it.
+ |if abs(mem[p+glue_offset].int)<@'4000000 then print('?.?')|
+ |else| }
+ if fabs(g)>float_constant(20000) then
+@z
+
+
+@x [16.213] l.4321 - texarray
+@!nest:array[0..nest_size] of list_state_record;
+@y
+@!nest:^list_state_record;
+@z
+
+@x [16.215] l.4344 - remove mem[] reference from initialize.
+@<Start a new current page@>;
+@y
+@/{The following piece of code is a copy of module 991:}
+page_contents:=empty; page_tail:=page_head; {|link(page_head):=null;|}@/
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+page_depth:=0; page_max_depth:=0;
+@z
+
+@x [17.241] l.5219 - Do `fix_date_and_time' in C.
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+It calls a macro-defined |date_and_time| routine. |date_and_time|
+in turn is a C macro, which calls |get_date_and_time|, passing
+it the addresses of the day, month, etc., so they can be set by the
+routine. |get_date_and_time| also sets up interrupt catching if that
+is conditionally compiled in the C code.
+@^system dependencies@>
+
+@d fix_date_and_time==o_date_and_time(int_base+time_code,
+ int_base+day_code,
+ int_base+month_code,
+ int_base+year_code)
+@z
+
+@x [18.262] l.5584 - Remove more unsigned comparisons to zero.
+else if (newtext(p)<0)or(newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@y
+else if (newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@z
+
+@x [19.271] l.5872 - texarray
+@!save_stack : array[0..save_size] of memory_word;
+@y
+@!save_stack : ^memory_word;
+@z
+
+@x [22.301] l.6432 - texarray
+@!input_stack : array[0..stack_size] of in_state_record;
+@y
+@!input_stack : ^in_state_record;
+@z
+
+@x [22.304] l.6536 - texarray
+@!input_file : array[1..max_in_open] of alpha_file;
+@!input_file_mode : array[1..max_in_open] of halfword;
+@!input_file_translation : array[1..max_in_open] of halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+@y
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@z
+
+@x [22.308] l.6701 - texarray
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+@y
+@!param_stack: ^pointer;
+ {token list pointers for parameters}
+@z
+
+@x [23.331] l.7071 - init source file name stacks
+begin input_ptr:=0; max_in_stack:=0;
+@y
+begin input_ptr:=0; max_in_stack:=0;
+source_filename_stack[0]:=0;full_source_filename_stack[0]:=0;
+@z
+
+@x [29.513] l.9951 - Area and extension rules for filenames.
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@y
+@ The file names we shall deal with have the
+following structure: If the name contains `\./' or `\.:'
+(for Amiga only), the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the last
+`\..' to the end, otherwise the file extension is null.
+@z
+
+@x [29.513] l.9963 - Area and extension rules for filenames.
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+@y
+@!area_delimiter:pool_pointer; {the most recent `\./', if any}
+@!ext_delimiter:pool_pointer; {the most recent `\..', if any}
+@z
+
+@x [29.514] l.9973 - TeX area directories.
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+In C, the default paths are specified separately.
+@z
+
+@x [29.516] l.9994 - filenames: more_name
+ if (c=">")or(c=":") then
+@y
+ if IS_DIR_SEP(c) then
+@z
+
+@x [29.516] l.9997 - filenames: more_name
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
+@y
+ else if c="." then ext_delimiter:=cur_length;
+@z
+
+@x [29.517] l.10002 - end_name: string recycling
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+@y
+@ The third.
+@^system dependencies@>
+If a string is already in the string pool, the function
+|slow_make_string| does not create a new string but returns this string
+number, thus saving string space. Because of this new property of the
+returned string number it is not possible to apply |flush_string| to
+these strings.
+
+@p procedure end_name;
+var temp_str: str_number; {result of file name cache lookups}
+@!j: pool_pointer; {running index}
+@z
+
+@x [29.517] l.10011 - end_name: string recycling
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+@y
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ temp_str:=search_string(cur_area);
+ if temp_str>0 then
+ begin cur_area:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start(str_ptr+1) to pool_ptr-1 do
+ begin str_pool[j-area_delimiter]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-area_delimiter; {update |pool_ptr|}
+ end;
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=slow_make_string;
+@z
+
+@x [29.517] l.10016 - end_name: string recycling
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+@y
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+ decr(str_ptr); {undo extension string to look at name part}
+ temp_str:=search_string(cur_name);
+ if temp_str>0 then
+ begin cur_name:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start(str_ptr+1) to pool_ptr-1 do
+ begin str_pool[j-ext_delimiter+area_delimiter+1]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-ext_delimiter+area_delimiter+1; {update |pool_ptr|}
+ end;
+ cur_ext:=slow_make_string; {remake extension string}
+@z
+
+% [29.519] In pack_file_name, leave room for the extra null we append at
+% the end of a filename.
+@x [29.519] l.10047 - pack_file_name, leave room for the extra null
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file:= xmalloc_array(char, 1 + length(a) + length(n) + length(e));
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+@z
+
+@x [29.519] l.10051 - pack_file_name, append the extra null
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.520] l.10060 - filenames: default format.
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+@y
+Under {\mc UNIX} we don't give the area part, instead depending
+on the path searching that will happen during file opening. Also, the
+length will be set in the main program.
+
+@d format_area_length=0 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+@z
+
+@x [29.521] l.10066 - filenames: default format, where `plain.fmt' is.
+@!TEX_format_default:packed array[1..format_default_length] of char;
+
+@ @<Set init...@>=
+TEX_format_default:='TeXformats:plain.fmt';
+@y
+@!format_default_length: integer;
+@!TEX_format_default: ^char;
+
+@ We set the name of the default format file and the length of that name
+in C, instead of Pascal, since we want them to depend on the name of the
+program.
+@z
+
+@x [29.523] l.10095 - Change to pack_buffered_name as with pack_file_name.
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file := xmalloc_array (char, 1 + n + (b - a + 1) + format_ext_length);
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@z
+
+@x [29.523] l.10100 - Change to pack_buffered_name as with pack_file_name.
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.524] l.10118 - Format file opening: only try once, with path searching.
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(fmt_file) then goto found;
+ pack_buffered_name(format_area_length,loc,j-1);
+ {now try the system format file area}
+ if w_open_in(fmt_file) then goto found;
+@y
+ pack_buffered_name(0,loc,j-1); {Kpathsea does everything}
+ if w_open_in(fmt_file) then goto found;
+@z
+
+@x [29.524] l.10124 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
+@y
+ wterm ('Sorry, I can''t find the format `');
+ fputs (name_of_file + 1, stdout);
+ wterm ('''; will try `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''.');
+@z
+
+@x [29.524] l.10132 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('I can''t find the PLAIN format file!');
+@.I can't find PLAIN...@>
+@y
+ wterm ('I can''t find the format file `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''!');
+@.I can't find the format...@>
+@z
+
+@x [29.530] l.10239 - prompt_file_name: No default extension is TeX input file.
+if e=".tex" then show_context;
+@y
+if (e=".tex") or (e="") then show_context;
+@z
+
+@x [29.532] l.10263 - avoid conflict, `logname' in <unistd.h> on some systems.
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@y
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d log_name == texmf_log_name
+@z
+
+@x [29.534] l.10285 - Adjust for C string conventions.
+@!months:packed array [1..36] of char; {abbreviations of month names}
+@y
+@!months:^char;
+j:integer;
+@z
+
+@x [29.534] l. - Send the job_name to the file recorder.
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+@y
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+pack_job_name(".ofl");
+recorder_change_filename(stringcast(name_of_file+1));
+@z
+
+@x [29.536] l.10324 - Print rest of banner.
+begin wlog(eTeX_banner);
+@y
+begin wlog(eTeX_banner);
+wlog(version_string);
+@z
+
+@x [29.536] l.10327 - Adjust for C string conventions.
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@y
+months := ' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@z
+
+% [29.537] Use a path when calling a_open_in to do a \input; also, try
+% to open the file with and without the `.tex' extension, regardless of
+% whether the file already has an extension. This allows filenames like
+% `foo' and `foo.bar.tex', as well as `foo.tex' and `foo.bar'.
+@x [29.537] l.10338 - start_input
+begin scan_file_name; {set |cur_name| to desired file name}
+if cur_ext="" then cur_ext:=".tex";
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,TEX_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+@y
+var temp_str: str_number; k: integer;
+begin scan_file_name; {set |cur_name| to desired file name}
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ tex_input_type := 1; {Tell |open_input| we are \.{\\input}.}
+ {Kpathsea tries all the various ways to get the file.}
+ if open_in_name_ok(name_of_file+1)
+ and a_open_in(cur_file, kpse_tex_format) then
+ {At this point |name_of_file| contains the actual name found.
+ We extract the |cur_area|, |cur_name|, and |cur_ext| from it.}
+ begin k:=1;
+ name_in_progress:=true;
+ begin_name;
+ while (k<=name_length)and(more_name(name_of_file[k])) do
+ incr(k);
+ end_name;
+ name_in_progress:=false;
+ goto done;
+ end;
+@z
+
+@x [29.537] l.10348 - start_input: don't force ".tex" extension.
+ prompt_file_name("input file name",".tex");
+@y
+ prompt_file_name("input file name","");
+@z
+
+@x [29.537] l.10350 - start_input: string recycling
+done: name:=a_make_name_string(cur_file);
+@y
+done: name:=a_make_name_string(cur_file);
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@z
+
+@x [29.537] l.10352 - start_input: use different heuristic for initex.
+ begin job_name:=cur_name; open_log_file;
+@y
+ begin job_name:=get_job_name; open_log_file;
+@z
+
+@x [29.537] l.10359 - start_input: don't return filename to string pool.
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string; name:=cur_name;
+ end;
+@y
+@z
+
+@x [30.563] l.10943 - Don't use TEX_font_area.
+if aire="" then pack_file_name(nom,TEX_font_area,".ofm")
+else pack_file_name(nom,aire,".ofm");
+if not b_open_in(tfm_file) then abort;
+@y
+{|kpse_find_file| will append the |".ofm"| or |".tfm"|,
+ and avoid searching the disk before the font alias files as well.}
+pack_file_name(nom,aire,"");
+if not ofm_open_in(tfm_file) then abort;
+@z
+
+% [30.564] Reading the tfm file. As a special case, whenever we open a
+% tfm file, we read its first byte into `tfm_temp' right away. TeX
+% looks at `fbyte' before calling `fget', so it ends up seeing every
+% byte. This is Pascal-like I/O.
+@x [30.564] l.10956 - reading the tfm file, define fget & fbyte
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@y
+@d fget==tfm_temp:=getc(tfm_file)
+@d fbyte==tfm_temp
+@z
+
+% [32.575] We only want `eof' on the TFM file to be true if we
+% previously had EOF, not if we're at EOF now. This is like `feof', and
+% unlike our implementation of `eof' elsewhere.
+@x [32.575] l.11161 - Reading the tfm file, replace eof() by feof().
+if eof(tfm_file) then abort;
+@y
+if feof(tfm_file) then abort;
+@z
+
+@x [32.595] l.11860 - texarray
+@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:dvi_index; {half of |dvi_buf_size|}
+@!dvi_limit:dvi_index; {end of the current half buffer}
+@!dvi_ptr:dvi_index; {the next available buffer address}
+@y
+@!dvi_buf:^real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:integer; {half of |dvi_buf_size|}
+@!dvi_limit:integer; {end of the current half buffer}
+@!dvi_ptr:integer; {the next available buffer address}
+@z
+
+@x [32.597] l.11886 - write_dvi done in C.
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+In C, we use a macro to call |fwrite| or |write| directly, writing all
+the bytes in one shot. Much better even than writing four
+bytes at a time.
+@z
+
+@x [32.617] l.12261 - Use output_comment if the user set it. Assume it's short enough.
+ old_setting:=selector; selector:=new_string;
+@y
+if output_comment then
+ begin l:=strlen(output_comment); dvi_out(l);
+ for s:=0 to l-1 do dvi_out(output_comment[s]);
+ end
+else begin {the default code is unchanged}
+ old_setting:=selector; selector:=new_string;
+@z
+
+@x [32.617] l.12268 - Use output_comment if the user set it.
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+@y
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+end;
+@z
+
+% We output each portion of the page as we get to it, if we are using
+% IPC, so that the previewer (TeXView) can display it immediately. [SPM]
+@x [32.640] l.12690 - IPC
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+@y
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+ifdef ('IPC')
+if ipc_on>0 then
+ begin if dvi_limit=half_buf then
+ begin write_dvi(half_buf, dvi_buf_size-1);
+ flush_dvi;
+ dvi_gone:=dvi_gone+half_buf;
+ end;
+ if dvi_ptr>0 then
+ begin write_dvi(0, dvi_ptr-1);
+ flush_dvi;
+ dvi_offset:=dvi_offset+dvi_ptr; dvi_gone:=dvi_gone+dvi_ptr;
+ end;
+ dvi_ptr:=0; dvi_limit:=dvi_buf_size;
+ ipc_page(dvi_gone);
+ end;
+endif ('IPC');
+@z
+
+@x [32.642] l.12742 - Use dvi_offset instead of dvi_buf_size with IPC stuff.
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+@y
+ifdef ('IPC')
+ k:=7-((3+dvi_offset+dvi_ptr) mod 4); {the number of 223's}
+endif ('IPC')
+ifndef ('IPC')
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+endifn ('IPC')
+@z
+
+@x [38.859] l.16855 - Fix a casting/expression evaluation problem.
+if abs(fit_class-fitness(r))>1 then d:=d+adj_demerits;
+@y
+if abs(intcast(fit_class)-intcast(fitness(r)))>1 then d:=d+adj_demerits;
+@z
+
+@x [39.875] l.17170 - Another casting problem.
+ begin line_diff:=line_number(r)-best_line;
+@y
+ begin line_diff:=intcast(line_number(r))-intcast(best_line);
+@z
+
+@x [42.920] l.18068 - bigtrie: allow larger hyphenation tries.
+@!trie_pointer=0..trie_size; {an index into |trie|}
+@y
+@!trie_pointer=0..ssup_trie_size; {an index into |trie|}
+@z
+
+@x [42.921] l.18075 - bigtrie: allow larger hyphenation tries.
+@!trie:array[trie_pointer] of two_halves; {|trie_link|, |trie_char|, |trie_op|}
+@y
+{We will dynamically allocate this arrays.}
+@!trie:^two_halves; {|trie_link|}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18126 m.925
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+@y 18126
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+This is a clever scheme which saves the need for a hash link array.
+However, it is difficult to increase the size of the hyphen exception
+arrays. To make this easier, the ordered hash has been replaced by
+a simple hash, using an additional array |hyph_link|. The value
+|0| in |hyph_link[k]| means that there are no more entries corresponding
+to the specific hash chain. When |hyph_link[k]>0|, the next entry in
+the hash chain is |hyph_link[k]-1|. This value is used because the
+arrays start at |0|.
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18134 m.925
+@!hyph_pointer=0..hyph_size; {an index into the ordered hash table}
+@y 18134
+@!hyph_pointer=0..ssup_hyph_size; {index into hyphen exceptions hash table;
+ enlarging this requires changing (un)dump code}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18137 m.926
+@!hyph_word:array[hyph_pointer] of str_number; {exception words}
+@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions}
+@!hyph_count:hyph_pointer; {the number of words in the exception dictionary}
+@y 18139
+@!hyph_word: ^str_number; {exception words}
+@!hyph_list: ^pointer; {list of hyphen positions}
+@!hyph_link: ^hyph_pointer; {link array for hyphen exceptions hash table}
+@!hyph_count:integer; {the number of words in the exception dictionary}
+@!hyph_next:integer; {next free slot in hyphen exceptions hash table}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18145 m.928
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null;
+ end;
+hyph_count:=0;
+@y 18148
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null; hyph_link[z]:=0;
+ end;
+hyph_count:=0;
+hyph_next:=hyph_prime+1; if hyph_next>hyph_size then hyph_next:=hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18163 m.930
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_size;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+not_found: decr(hn)
+@y 18170
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_prime;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ h:=hyph_link[h]; if h=0 then goto not_found;
+ decr(h);
+ end;
+not_found: decr(hn)
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18172 m.931
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)<hn then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start(k);
+ repeat if so(str_pool[u])<hc[j] then goto not_found;
+ if so(str_pool[u])>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@y 18184
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start(k);
+ repeat
+ if so(str_pool[u])<>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@z
+
+% The GNU C compiler complains of unused variables.
+@x
+@!s,@!t:str_number; {strings being compared or stored}
+@y
+@!s:str_number; {strings being compared or stored}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18274 m.939
+ begin h:=(h+h+hc[j]) mod hyph_size;
+@y 18274
+ begin h:=(h+h+hc[j]) mod hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18281 m.940
+@ @<Insert the \(p)pair |(s,p)|...@>=
+if hyph_count=hyph_size then overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+hyph_word[h]:=s; hyph_list[h]:=p
+@y 18290
+@ @<Insert the \(p)pair |(s,p)|...@>=
+ if hyph_next <= hyph_prime then
+ while (hyph_next>0) and (hyph_word[hyph_next-1]>0) do decr(hyph_next);
+if (hyph_count=hyph_size)or(hyph_next=0) then
+ overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if hyph_link[h]=0 then
+ begin
+ hyph_link[h]:=hyph_next;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime;
+ if hyph_next > hyph_prime then incr(hyph_next);
+ end;
+ h:=hyph_link[h]-1;
+ end;
+
+found: hyph_word[h]:=s; hyph_list[h]:=p
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18292 m.941
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+k:=hyph_word[h];
+if length(k)<length(s) then goto found;
+if length(k)>length(s) then goto not_found;
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+found:q:=hyph_list[h]; hyph_list[h]:=p; p:=q;@/
+t:=hyph_word[h]; hyph_word[h]:=s; s:=t;
+not_found:
+@y 18303
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h];
+if length(k)<>length(s) then goto not_found;
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+{repeat hyphenation exception; flushing old data}
+flush_string; s:=hyph_word[h]; {avoid |slow_make_string|!}
+decr(hyph_count);
+{ We could also |flush_list(hyph_list[h]);|, but it interferes
+ with \.{trip.log}. }
+goto found;
+not_found:
+@z
+
+@x [43.943] l.18346 - web2c can't parse negative lower bounds in arrays. Sorry.
+@!init@! trie_op_hash:array[-trie_op_size..trie_op_size] of 0..trie_op_size;
+@y
+@!init@! trie_op_hash:array[neg_trie_op_size..trie_op_size] of 0..trie_op_size;
+@z
+
+@x [43.944] l.18365 - web2c can't parse negative lower bounds in arrays. Sorry
+var h:-trie_op_size..trie_op_size; {trial hash location}
+@y
+var h:neg_trie_op_size..trie_op_size; {trial hash location}
+@z
+
+@x [43.944] l.18370 - Another casting problem, and use |neg_trie_op_size|.
+begin h:=abs(n+313*d+361*v+1009*cur_lang) mod (trie_op_size+trie_op_size)
+ - trie_op_size;
+@y
+begin h:=abs(intcast(n)+313*intcast(d)+361*intcast(v)+1009*intcast(cur_lang))
+ mod (trie_op_size - neg_trie_op_size)
+ + neg_trie_op_size;
+@z
+
+@x [43.947] l.18438 - Dynamically allocate arrays, and a casting problem.
+@!init @!trie_c:packed array[trie_pointer] of ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:packed array[trie_pointer] of quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:packed array[trie_pointer] of trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:packed array[trie_pointer] of trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:packed array[trie_pointer] of trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@y
+@!init @!trie_c:^ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:^quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:^trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:^trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:^trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@z
+
+@x [43.948] l.18471 - Another casting problem.
+begin h:=abs(trie_c[p]+1009*trie_o[p]+@|
+ 2718*trie_l[p]+3142*trie_r[p]) mod trie_size;
+@y
+begin h:=abs(intcast(trie_c[p])+1009*intcast(trie_o[p])+@|
+ 2718*intcast(trie_l[p])+3142*intcast(trie_r[p])) mod trie_size;
+@z
+
+@x [43.590] l.18524 - Dynamically allocate & larger tries.
+@!init@!trie_taken:packed array[1..trie_size] of boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:array[ASCII_code] of trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@y
+@!init@!trie_taken: ^boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:^trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@z
+
+@x [43.951] l.18539 - Dynamically allocate.
+trie_not_ready:=true; trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+trie_not_ready:=true;
+@z
+
+%%
+%% We can rewrite the original code after "main_loop_move+2" upto the
+%% "tail_append(lig_stack)" in module 1036 as
+%%
+%
+% main_loop_move+2:
+% if font_bc[main_f]<=cur_chr then
+% if cur_chr<=font_ec[main_f] then
+% begin main_i:=char_info(main_f)(cur_l);
+% if char_exists(main_i) goto main_loop_move+3;
+% end;
+% char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+% main_loop_move+3:
+% tail_append(lig_stack) {|main_loop_lookahead| is next}
+%
+
+@x [49.1252] l.23230 - INI = VIR, so have to do runtime test.
+hyph_data: if cur_chr=1 then
+ begin @!init new_patterns; goto done;@;@+tini@/
+@y 23215
+hyph_data: if cur_chr=1 then
+ begin @!init if ini_version then
+ begin new_patterns; goto done; end; @;@+tini@/
+@z
+
+@x
+@!flushable_string:str_number; {string not yet referenced}
+@y
+@z
+
+% undo Knuth's change because
+% a) the string is already replaced in |scan_file_name| and therefore
+% b) the wrong string will get flushed!!!
+%
+@x [49.1260] l.23331 new_font: string recycling -- already done
+flushable_string:=str_ptr-1;
+@y
+@z
+
+% If you don't want to remove code with the following change,
+% please replace the former change by
+%
+% @x
+% flushable_string:=str_ptr-1;
+% @y
+% if cur_name=str_ptr-1 then
+% flushable_string:=str_ptr-1
+% else
+% flushable_string:=str_ptr; {number of a non-existing}
+% @z
+%
+% otherwise the wrong string will get removed by |flush_string|!!
+%
+@x [49.1260] l.23334 new_font: string recycling -- already done
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name(f);
+ end;
+ if s>0 then
+@y
+ begin if s>0 then
+@z
+
+@x [49.1265] if batchmode, mktex... scripts should be silent.
+interaction:=cur_chr;
+@y
+interaction:=cur_chr;
+if interaction = batch_mode
+then kpse_make_tex_discard_errors := 1
+else kpse_make_tex_discard_errors := 0;
+@z
+
+@x [49.1275] l.23441 - Same stuff as for \input, this time for \openin.
+ if cur_ext="" then cur_ext:=".tex";
+ pack_cur_name;
+ if a_open_in(read_file[n]) then read_open[n]:=just_open;
+@y
+ pack_cur_name;
+ tex_input_type:=0; {Tell |open_input| we are \.{\\openin}.}
+ if open_in_name_ok(name_of_file+1)
+ and a_open_in(read_file[n], kpse_tex_format) then
+ begin k:=1;
+ name_in_progress:=true;
+ begin_name;
+ while (k<=name_length)and(more_name(name_of_file[k])) do
+ incr(k);
+ end_name;
+ name_in_progress:=false;
+ read_open[n]:=just_open;
+ end;
+@z
+
+@x [50.1301] l.23679 - INI = VIR, so runtime test.
+format_ident:=" (INIALEPH)";
+@y
+if ini_version then format_ident:=" (INIALEPH)";
+@z
+
+% The GNU C compiler complains of unused variables.
+@x [50.1302] l.23690 - Eliminate now-unused variable `w' in `store_fmt_file'.
+var j,@!k,@!l:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!w: four_quarters; {four ASCII codes}
+@y
+var j,@!k:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!format_engine: ^char;
+@z
+
+@x [50.1303] l.23722 - Ditto, for `load_fmt_file'.
+@!w: four_quarters; {four ASCII codes}
+@y
+@!format_engine: ^char;
+@z
+
+@x [50.1305] l.23751 - Do dumping and undumping of fmt files in C.
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+@y
+@z
+@x [1306]
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@y
+@z
+@x [still 1306] debug format file
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@y
+@d format_debug_end(#)==
+ write_ln (stderr, ' = ', #);
+ end;
+@d format_debug(#)==
+ if debug_format_file then begin
+ write (stderr, 'fmtdebug:', #);
+ format_debug_end
+@d undump_size_end_end(#)==
+ too_small(#)@+else format_debug (#)(x); undump_end_end
+@z
+
+@x [50,1307] l.23779 - texarray
+dump_int(@$);@/
+@y
+dump_int(@"57325458); {Web2C \TeX's magic constant: "W2TX"}
+{Align engine to 4 bytes with one or more trailing NUL}
+x:=strlen(engine_name);
+format_engine:=xmalloc_array(char,x+4);
+strcpy(format_engine, engine_name);
+for k:=x to x+3 do format_engine[k]:=0;
+x:=x+4-(x mod 4);
+dump_int(x);dump_things(format_engine[0], x);
+libc_free(format_engine);@/
+dump_int(@$);@/
+dump_int(max_halfword);@/
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23784 m.1307
+dump_int(hyph_size)
+@y 23784
+dump_int(hyph_prime)
+@z
+
+@x [50.1308] l.23793 - texarray
+x:=fmt_file^.int;
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@/@<Undump the \eTeX\ state@>@/
+undump_int(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(x);
+if x<>mem_top then goto bad_fmt;
+@y
+@+init
+if ini_version then
+ begin libc_free(str_pool); libc_free(str_start_ar); libc_free(yzmem);
+ end;
+@+tini
+undump_int(x);
+format_debug('string pool checksum')(x);
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+undump_int(x);
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+@/@<Undump the \eTeX\ state@>@/
+
+undump_int(x); format_debug ('mem_bot')(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(mem_top); format_debug ('mem_top')(mem_top);
+if mem_bot+1100>mem_top then goto bad_fmt;
+
+
+head:=contrib_head; tail:=contrib_head;
+ page_tail:=page_head; {page initialization}
+
+mem_min := mem_bot - extra_mem_bot;
+mem_max := mem_top + extra_mem_top;
+
+yzmem:=xmalloc_array (memory_word, mem_max - mem_min);
+zmem := yzmem - mem_min; {this pointer arithmetic fails with some compilers}
+mem := zmem;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23804 m.1308
+if x<>hyph_size then goto bad_fmt
+@y 23804
+if x<>hyph_prime then goto bad_fmt
+@z
+
+% [1309] Make dumping/undumping more efficient by doing whole arrays at
+% a time, via fread/fwrite in texmfmp.c.
+@x [50.1309] l.23814 - Make dumping/undumping more efficient.
+for k:=too_big_char to str_ptr do dump_int(str_start(k));
+k:=0;
+while k+4<pool_ptr do
+ begin dump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; dump_four_ASCII;
+@y
+dump_things(str_start(too_big_char), str_ptr-too_big_char+1);
+dump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1310] l.23829 - Make dumping/undumping more efficient.
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings)('max strings')(str_ptr);
+for k:=too_big_char to str_ptr do undump(0)(pool_ptr)(str_start(k));
+k:=0;
+while k+4<pool_ptr do
+ begin undump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; undump_four_ASCII;
+@y
+undump_size(0)(sup_pool_size-pool_free)('string pool size')(pool_ptr);
+if pool_size<pool_ptr+pool_free then
+ pool_size:=pool_ptr+pool_free;
+undump_size(0)(sup_max_strings-strings_free)('sup strings')(str_ptr);@/
+if max_strings<str_ptr+strings_free then
+ max_strings:=str_ptr+strings_free;
+str_start_ar:=xmalloc_array(pool_pointer, max_strings-biggest_char);
+undump_things(str_start(too_big_char), str_ptr-too_big_char+1);
+str_pool:=xmalloc_array(packed_ASCII_code, pool_size);
+undump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1311] l.23850 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do dump_wd(mem[k]);
+@y
+repeat dump_things(mem[p], q+2-p);
+@z
+
+@x [50.1311] l.23855 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do dump_wd(mem[k]);
+@y
+dump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1311] l.23858 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
+@y
+dump_things(mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+@x [50.1312] l.23873 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do undump_wd(mem[k]);
+@y
+repeat undump_things(mem[p], q+2-p);
+@z
+
+@x [50.1312] l.23878 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do undump_wd(mem[k]);
+@y
+undump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1312] l.23888 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
+@y
+undump_things (mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24058 m.1324
+dump_int(hyph_count);
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k); dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@y 24061
+dump_int(hyph_count);
+if hyph_next <= hyph_prime then hyph_next:=hyph_size;
+dump_int(hyph_next);{minumum value of |hyphen_size| needed}
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k+65536*hyph_link[k]);
+ {assumes number of hyphen exceptions does not exceed 65535}
+ dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@z
+
+@x [50.1324] l.24066 - Make dumping/undumping more efficient - trie
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(max_hyph_char);
+dump_int(trie_op_ptr);
+for k:=1 to trie_op_ptr do
+ begin dump_int(hyf_distance[k]);
+ dump_int(hyf_num[k]);
+ dump_int(hyf_next[k]);
+ end;
+@y
+dump_things(trie[0],trie_max+1);
+dump_int(max_hyph_char);
+dump_int(trie_op_ptr);
+dump_things(hyf_distance[1], trie_op_ptr);
+dump_things(hyf_num[1], trie_op_ptr);
+dump_things(hyf_next[1], trie_op_ptr);
+@z
+
+@x [50.1325] l.24086 - Make dumping/undumping more efficient - trie
+@<Undump the hyphenation tables@>=
+@y
+{This is only used for the hyphenation tries below, and the size is
+ always |j+1|.}
+@d xmalloc_and_undump(#) ==
+ if not # then #:=xmalloc_array(two_halves, j+1);
+ undump_things(#[0], j+1);
+
+@<Undump the hyphenation tables@>=
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24087 m.1325
+undump(0)(hyph_size)(hyph_count);
+for k:=1 to hyph_count do
+ begin undump(0)(hyph_size)(j);
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+@y 24092
+undump_size(0)(hyph_size)('hyph_size')(hyph_count);
+undump_size(hyph_prime)(hyph_size)('hyph_size')(hyph_next);
+j:=0;
+for k:=1 to hyph_count do
+ begin undump_int(j); if j<0 then goto bad_fmt;
+ if j>65535 then
+ begin hyph_next:= j div 65536; j:=j - hyph_next * 65536; end
+ else hyph_next:=0;
+ if (j>=hyph_size)or(hyph_next>hyph_size) then goto bad_fmt;
+ hyph_link[j]:=hyph_next;
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+ {|j| is now the largest occupied location in |hyph_word|}
+ incr(j);
+ if j<hyph_prime then j:=hyph_prime;
+ hyph_next:=j;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime else
+ if hyph_next >= hyph_prime then incr(hyph_next);
+@z
+
+
+@x [50.1325] l.24094 - Make dumping/undumping more efficient - trie
+for k:=0 to j do undump_hh(trie[k]);
+undump_int(max_hyph_char);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+for k:=1 to j do
+ begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
+ undump(0)(63)(hyf_num[k]);
+ undump(min_quarterword)(max_quarterword)(hyf_next[k]);
+ end;
+@y
+{The first array has not been allocated yet unless we're \.{INITEX};
+ we do that precisely so we don't allocate more space than necessary.}
+xmalloc_and_undump(trie);
+undump_int(max_hyph_char);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+{I'm not sure we have such a strict limitation (64) on these values, so
+ let's leave them unchecked.}
+undump_things(hyf_distance[1], j);
+undump_things(hyf_num[1], j);
+undump_upper_check_things(max_quarterword, hyf_next[1], j);
+@z
+
+@x [50.1327] l.24117 - Allow command line to override dumped value.
+undump(batch_mode)(error_stop_mode)(interaction);
+@y
+undump(batch_mode)(error_stop_mode)(interaction);
+if interaction_option<>unspecified_mode then interaction:=interaction_option;
+@z
+
+% [50.1327] As with TFM files, `eof' here means `have we previously
+% encountered the end-of-file', not `are we at the end of the file'.
+@x [50.1327] l.24120 - dumping/undumping, replace eof() by feof()
+if (x<>69069)or eof(fmt_file) then goto bad_fmt
+@y
+if (x<>69069)or feof(fmt_file) then goto bad_fmt
+@z
+
+@x [50.1328] l.24124 - Eliminate probably wrong word `preloaded' from format_idents.
+print(" (preloaded format="); print(job_name); print_char(" ");
+@y
+print(" (format="); print(job_name); print_char(" ");
+@z
+
+@x [51.1332] l.24203 - make the main program a procedure, for eqtb hack.
+@p begin @!{|start_here|}
+@y
+@d const_chk(#)==begin if # < inf@&# then # := inf@&# else
+ if # > sup@&# then # := sup@&# end
+
+{|setup_bound_var| stuff duplicated in \.{mf.ch}.}
+@d setup_bound_var(#)==bound_default:=#; setup_bound_var_end
+@d setup_bound_var_end(#)==bound_name:=#; setup_bound_var_end_end
+@d setup_bound_var_end_end(#)==
+ setup_bound_variable(address_of(#), bound_name, bound_default);
+
+@p procedure main_body;
+begin @!{|start_here|}
+
+{Always start the file recorder?}
+ {|recorder_enabled:=true;|}
+
+{Bounds that may be set from the configuration file. We want the user to
+ be able to specify the names with underscores, but \.{TANGLE} removes
+ underscores, so we're stuck giving the names twice, once as a string,
+ once as the identifier. How ugly.}
+ setup_bound_var (1000000)('main_memory')(main_memory);
+ {|memory_word|s for |mem| in \.{INITEX}}
+ setup_bound_var (0)('extra_mem_top')(extra_mem_top);
+ {increase high mem in \.{VIRTEX}}
+ setup_bound_var (0)('extra_mem_bot')(extra_mem_bot);
+ {increase low mem in \.{VIRTEX}}
+ setup_bound_var (300000)('pool_size')(pool_size);
+ setup_bound_var (200000)('string_vacancies')(string_vacancies);
+ setup_bound_var (5000)('pool_free')(pool_free); {min pool avail after fmt}
+ setup_bound_var (100000)('max_strings')(max_strings);
+ setup_bound_var (100)('strings_free')(strings_free);
+ setup_bound_var (20000)('trie_size')(trie_size);
+ {if |ssup_trie_size| increases, recompile}
+ setup_bound_var (659)('hyph_size')(hyph_size);
+ setup_bound_var (20000)('buf_size')(buf_size);
+ setup_bound_var (50)('nest_size')(nest_size);
+ setup_bound_var (15)('max_in_open')(max_in_open);
+ setup_bound_var (60)('param_size')(param_size);
+ setup_bound_var (4000)('save_size')(save_size);
+ setup_bound_var (300)('stack_size')(stack_size);
+ setup_bound_var (16384)('dvi_buf_size')(dvi_buf_size);
+ setup_bound_var (79)('error_line')(error_line);
+ setup_bound_var (50)('half_error_line')(half_error_line);
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ const_chk (main_memory);
+@+init
+ if ini_version then begin
+ extra_mem_top := 0;
+ extra_mem_bot := 0;
+ end;
+@+tini
+ if extra_mem_bot>sup_main_memory then extra_mem_bot:=sup_main_memory;
+ if extra_mem_top>sup_main_memory then extra_mem_top:=sup_main_memory;
+ mem_top := mem_bot + main_memory;
+ mem_min := mem_bot;
+ mem_max := mem_top;
+
+ {Check other constants against their sup and inf.}
+ const_chk (trie_size);
+ const_chk (hyph_size);
+ const_chk (buf_size);
+ const_chk (nest_size);
+ const_chk (max_in_open);
+ const_chk (param_size);
+ const_chk (save_size);
+ const_chk (stack_size);
+ const_chk (dvi_buf_size);
+ const_chk (pool_size);
+ const_chk (string_vacancies);
+ const_chk (pool_free);
+ const_chk (max_strings);
+ const_chk (strings_free);
+ if error_line > ssup_error_line then error_line := ssup_error_line;
+
+ {array memory allocation}
+ buffer:=xmalloc_array (ASCII_code, buf_size);
+ nest:=xmalloc_array (list_state_record, nest_size);
+ save_stack:=xmalloc_array (memory_word, save_size);
+ input_stack:=xmalloc_array (in_state_record, stack_size);
+ input_file:=xmalloc_array (alpha_file, max_in_open);
+ input_file_mode:=xmalloc_array (halfword, max_in_open);
+ input_file_translation:=xmalloc_array (halfword, max_in_open);
+ line_stack:=xmalloc_array (integer, max_in_open);
+ param_stack:=xmalloc_array (halfword, param_size);
+ dvi_buf:=xmalloc_array (real_eight_bits, dvi_buf_size);
+ hyph_word:=xmalloc_array (str_number, hyph_size);
+ hyph_list:=xmalloc_array (halfword, hyph_size);
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+@+init
+if ini_version then begin
+ yzmem:=xmalloc_array (memory_word, mem_top - mem_bot);
+ zmem := yzmem - mem_bot; {Some compilers require |mem_bot=0|}
+
+ str_start_ar:=xmalloc_array (pool_pointer, max_strings-biggest_char);
+ str_pool:=xmalloc_array (packed_ASCII_code, pool_size);
+end;
+@+tini
+@z
+
+@x [51.1332] l.24215 - INI = VIR, so pool init needs runtime test
+@!init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+@y
+@+init if ini_version then
+ begin if not get_strings_started then goto final_end;
+ init_prim; {call |primitive| for each primitive}
+ init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+ end;
+@+tini@/
+@z
+
+@x [51.1332] l.24225 - main
+end_of_TEX: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+@y
+close_files_and_terminate;
+final_end: do_final_end;
+end {|main_body|};
+@z
+
+@x [51.1333] l.24254 - Print new line before termination; switch to editor if necessary.
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+@y
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+print_ln;
+if (edit_name_start<>0) and (interaction>batch_mode) then
+ call_edit(str_pool,edit_name_start,edit_name_length,edit_line);
+@z
+
+@x [51.1334] l. - Remove reference to fontmemsize
+ wlog_ln(', out of ',font_mem_size:1,' for ',font_max-font_base:1);@/
+@y
+@z
+
+@x [51.1335] l.24335 - Only do dump if ini.
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+ store_fmt_file; return;@+tini@/
+@y
+ begin @!init if ini_version then
+ begin for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+ store_fmt_file; return;
+ end;@+tini@/
+@z
+
+@x [51.1337] l.24361 - Handle %&format in all cases.
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+if (format_ident=0)or(buffer[loc]="&")or dump_line then
+@z
+
+@x [51.1337] l.24371 - Allocate hyphenation tries.
+fix_date_and_time;@/
+@y
+fix_date_and_time;@/
+
+@!init
+if trie_not_ready then begin {initex without format loaded}
+ trie:=xmalloc_array (two_halves, trie_size);
+
+ trie_c:=xmalloc_array (ASCII_code, trie_size);
+ trie_o:=xmalloc_array (quarterword, trie_size);
+ trie_l:=xmalloc_array (trie_pointer, trie_size);
+ trie_r:=xmalloc_array (trie_pointer, trie_size);
+ trie_hash:=xmalloc_array (trie_pointer, trie_size);
+ trie_taken:=xmalloc_array (boolean, trie_size);
+ trie_min:=xmalloc_array (trie_pointer, too_big_char);
+
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+ end;
+ tini@/
+
+@z
+
+% [52.1338] Core-dump in debugging mode on 0 input. Under Unix, it's
+% not possible to portably switch into the debugger while a program is
+% running. The best approximation is to do a core dump, then run the
+% debugger on it later.
+@x [52.1338] l.24411 - Core-dump in debugging mode on 0 input.
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+@y
+ dump_core {do something to cause a core dump}
+@z
+
+% The GNU C compiler complains of unused variables.
+@x
+procedure do_extension;
+var i,@!j,@!k:integer; {all-purpose integers}
+@!p,@!q,@!r:pointer; {all-purpose pointers}
+@y
+procedure do_extension;
+var @!k:integer; {all-purpose integers}
+@!p:pointer; {all-purpose pointers}
+@z
+
+% [53.1350] (new_write_whatsit) Allow 18 as a \write stream. We never
+% refer to an actual file, though, so we don't need to change the
+% write_file or write_open arrays. We provide for disabling this at
+% runtime, for paranoids.
+@x [53.1350] l.24609 - system: Allow 18 as a \write stream.
+ else if cur_val>15 then cur_val:=16;
+@y
+ else if (cur_val>15) and (cur_val <> 18) then cur_val:=16;
+@z
+
+@x [53.1370] l.24770 - system: (write_out) \write18{foo} => system(foo).
+begin @<Expand macros in the token list
+@y
+@!d:integer; {number of characters in incomplete current string}
+@!clobbered:boolean; {system string is ok?}
+begin @<Expand macros in the token list
+@z
+
+@x [53.1370] l.24773 - system: (write_out) \write18{foo} => system(foo).
+if write_open[j] then selector:=j
+@y
+if shell_enabled_p and (j=18) then
+ begin selector := new_string;
+ end
+else if write_open[j] then selector:=j
+@z
+
+% Then call system(3) on that string.
+@x [53.1370] l.24779 - system: (write_out) \write18{foo} => system(foo).
+flush_list(def_ref); selector:=old_setting;
+@y
+flush_list(def_ref);
+if j=18 then
+ begin if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ print_nl("system(");
+ for d:=0 to cur_length-1 do
+ begin {|print| gives up if passed |str_ptr|, so do it by hand.}
+ print(so(str_pool[str_start(str_ptr)+d])); {N.B.: not |print_char|}
+ end;
+ print(")...");
+ if shell_enabled_p then
+ begin str_room(1); append_char(0); {Append a null byte to the expansion.}
+ clobbered:=false;
+ for d:=0 to cur_length-1 do {Convert to external character set.}
+ begin str_pool[str_start(str_ptr)+d]:=xchr[str_pool[str_start(str_ptr)+d]];
+ if (str_pool[str_start(str_ptr)+d]=null_code)
+ and (d<cur_length-1) then clobbered:=true;
+ {minimal checking: NUL not allowed in argument string of |system|()}
+ end;
+ if clobbered then print("clobbered")
+ else begin {We have the string; run system(3). We don't have anything
+ reasonable to do with the return status, unfortunately discard it.}
+ for d:=0 to cur_length-1 do {Convert to external character set.}
+ begin
+ outside_string_array[d]:=xchr[str_pool[str_start(str_ptr)+d]];
+ end;
+ outside_string_array[cur_length]:=null_code;
+ system(outside_string_array);
+ print("executed");
+ end;
+ pool_ptr:=str_start(str_ptr); {erase the string}
+ end
+ else begin print("disabled");
+ end;
+ print_char("."); print_nl(""); print_ln;
+end;
+selector:=old_setting;
+@z
+
+@x [53.1373] Need new local.
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+@y
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+ @!old_setting:0..max_selector;
+@z
+
+@x [53.1374] Disallow certain \openout filenames, and log results.
+ while not a_open_out(write_file[j]) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+@y
+ while not a_open_out(write_file[j])
+ or not open_out_name_ok(name_of_file+1) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+ {If on first line of input, log file is not ready yet, so don't log.}
+ if log_opened then begin
+ old_setting:=selector;
+ if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ print_nl("\openout");
+ print_int(j);
+ print(" = `");
+ print_file_name(cur_name,cur_area,cur_ext);
+ print("'."); print_nl(""); print_ln;
+ selector:=old_setting;
+ end;
+@z
+
+@x [54.1376] l.24903 - Add editor-switch variables to globals.
+@* \[54] System-dependent changes.
+@y
+@* \[54/web2c] System-dependent changes for Web2c.
+Here are extra variables for Web2c. (This numbering of the
+system-dependent section allows easy integration of Web2c and e-\TeX, etc.)
+@^<system dependencies@>
+
+@<Glob...@>=
+@!edit_name_start: pool_pointer; {where the filename to switch to starts}
+@!edit_name_length,@!edit_line: integer; {what line to start editing at}
+@!ipc_on: integer; {level of IPC action, 0 for none [default]}
+
+@ The |edit_name_start| will be set to point into |str_pool| somewhere after
+its beginning if \TeX\ is supposed to switch to an editor on exit.
+
+@<Set init...@>=
+edit_name_start:=0;
+
+@ These are used when we regenerate the representation of the first 256
+strings.
+
+@<Global...@> =
+@!save_str_ptr: str_number;
+@!save_pool_ptr: pool_pointer;
+@!shell_enabled_p: c_int_type;
+@!output_comment: ^char;
+@!k,l: 0..65535; {used by `Make the first 256 strings', etc.}
+
+@ When debugging a macro package, it can be useful to see the exact
+control sequence names in the format file. For example, if ten new
+csnames appear, it's nice to know what they are, to help pinpoint where
+they came from. (This isn't a truly ``basic'' printing procedure, but
+that's a convenient module in which to put it.)
+
+@<Basic printing procedures@> =
+procedure print_csnames (hstart:integer; hfinish:integer);
+var c,h:integer;
+begin
+ write_ln(stderr, 'fmtdebug:csnames from ', hstart, ' to ', hfinish, ':');
+ for h := hstart to hfinish do begin
+ if newtext(h) > 0 then begin {if have anything at this position}
+ for c := str_start(newtext(h)) to str_start(newtext(h) + 1) - 1
+ do begin
+ put_byte(str_pool[c], stderr); {print the characters}
+ end;
+ write_ln(stderr, '|');
+ end;
+ end;
+end;
+
+@ Are we printing extra info as we read the format file?
+
+@<Glob...@> =
+@!debug_format_file: boolean;
+
+
+@* \[54/web2c-string] The string recycling routines. \TeX{} uses 2
+upto 4 {\it new\/} strings when scanning a filename in an \.{\\input},
+\.{\\openin}, or \.{\\openout} operation. These strings are normally
+lost because the reference to them are not saved after finishing the
+operation. |search_string| searches through the string pool for the
+given string and returns either 0 or the found string number.
+
+@<Declare additional routines for string recycling@>=
+function search_string(@!search:str_number):str_number;
+label found;
+var result: str_number;
+@!s: str_number; {running index}
+@!len: integer; {length of searched string}
+begin result:=0; len:=length(search);
+if len=0 then {trivial case}
+ begin result:=""; goto found;
+ end
+else begin s:=search-1; {start search with newest string below |s|; |search>1|!}
+ while s>65535 do {first 65536 strings depend on implementation!!}
+ begin if length(s)=len then
+ if str_eq_str(s,search) then
+ begin result:=s; goto found;
+ end;
+ decr(s);
+ end;
+ end;
+found:search_string:=result;
+end;
+
+@ The following routine is a variant of |make_string|. It searches
+the whole string pool for a string equal to the string currently built
+and returns a found string. Otherwise a new string is created and
+returned. Be cautious, you can not apply |flush_string| to a replaced
+string!
+
+@<Declare additional routines for string recycling@>=
+function slow_make_string : str_number;
+label exit;
+var s: str_number; {result of |search_string|}
+@!t: str_number; {new string}
+begin t:=make_string; s:=search_string(t);
+if s>0 then
+ begin flush_string; slow_make_string:=s; return;
+ end;
+slow_make_string:=t;
+exit:end;
+
+
+@* \[54] System-dependent changes.
+@z
diff --git a/Build/source/texk/web2c/alephdir/com16bit-rc2.ch b/Build/source/texk/web2c/alephdir/com16bit-rc2.ch
new file mode 100644
index 00000000000..f9064e84937
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/com16bit-rc2.ch
@@ -0,0 +1,2755 @@
+% com16bit.ch: Aleph version of file tex.ch
+%
+% tex.ch for C compilation with web2c, derived from various other change files.
+% By Tim Morgan, UC Irvine ICS Department, and many others.
+%
+% (05/28/86) ETM Started with TeX 2.0
+% (06/03/87) ETM Brought up to TeX 2.2
+% (09/26/87) ETM Brought up to TeX 2.3
+% (10/01/87) ETM Brought up to TeX 2.5
+% (12/21/87) ETM Brought up to TeX 2.7
+% (01/14/88) ETM Brought up to TeX 2.9
+% (02/20/88) PAM Revised format and module numbers
+% (03/01/88) ETM Eliminated some unused variables and unnecesary tests
+% (05/09/88) ETM Added yet another casting bug fix
+% (06/21/88) ETM Brought up to TeX version 2.93
+% (12/11/88) ETM Brought up to TeX version 2.94
+% (01/12/89) PAM Brought up to TeX version 2.95
+% (02/14/89) ETM Brought up to TeX version 2.96
+% (03/10/89) ETM Brought up to TeX version 2.98
+% (07/06/89) ETM Brought up to TeX version 2.991
+% (11/30/89) KB To version 2.992 (8-bit).
+% (01/10/90) SR To version 2.993.
+% (03/27/90) KY To version 3.0.
+% (more recent changes in ChangeLog)
+%
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+%
+% The module numbers in this change file refer to TEX.WEB 3.141592 as
+% of March, 1995 (published as Donald E. Knuth, TeX: The Program,
+% Volume B of Computers & Typesetting).
+
+@x [0.0] l.83 - WEAVE: print changes only.
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+@y 83
+ \def\?##1]{\hbox{Changes to \hbox to 1em{\hfil##1}.\ }}
+ }
+\let\maybe=\iffalse
+@z
+
+@x
+@d banner=='This is Aleph, Version 3.141592-',Omega_version_banner,'-',eTeX_version_banner,'-',Aleph_version_banner {printed when \TeX\ starts}
+@y
+@d banner=='This is Aleph, Version 3.141592-',Omega_version_banner,'-',eTeX_version_banner,'-',Aleph_version_banner {printed when \TeX\ starts}
+@d banner_k=='This is Alephk, Version 3.141592-',Omega_version_banner,'-',eTeX_version_banner,'-',Aleph_version_banner {printed when \TeX\ starts}
+@z
+
+@x [1.4] l.233 - program header
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \TeX\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+@y
+@z
+
+@x [1.4] l.243 - labels in outer block not needed
+program OMEGA; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+@y
+program OMEGA; {all file names are defined dynamically}
+@z
+
+@x [1.6] l.267 - labels in outer block not needed
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d end_of_TEX=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
+ {key control points}
+@y
+@ For Web2c, labels are not declared in the main program, but
+we still have to declare the symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d final_end=9999 {this label marks the ending of the program}
+@z
+
+% Here we change these WEB symbols, which are used much as #ifdef's
+% are in C, into something which will get translated into actual #ifdef's.
+@x [1.7] l.292 - debug..gubed, stat..tats
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==ifdef('TEXMF_DEBUG')
+@d gubed==endif('TEXMF_DEBUG')
+@z
+@x [1.7] l.297 - debug..gubed, stat..tats
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@y
+@d stat==ifdef('STAT')
+@d tats==endif('STAT')
+@z
+
+@x [1.8] l.312 - Same, for `init...tini'.
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y 312
+@d init==ifdef('INITEX')
+@d tini==endif('INITEX')
+@z
+
+@x [1.8] l.319 - init...tini is dynamic
+@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
+@y 318
+@!init
+if ini_version then
+ begin @<Initialize table entries (done by \.{INITEX} only)@>@;
+ end;
+@+tini
+@z
+
+@x [1.11] l.375 - Compile-time constants: most removed for dynamic allocation.
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@y
+@d file_name_size == maxint
+@d ssup_error_line = 255
+@d ssup_max_strings ==200000
+{Larger values may be used, but then the arrays consume much more memory.}
+@d ssup_trie_opcode == 65535
+@d ssup_trie_size == @"3FFFFF
+
+@d ssup_hyph_size == 65535 {Changing this requires changing (un)dumping!}
+@d iinf_hyphen_size == 610 {Must be not less than |hyph_prime|!}
+
+@<Constants...@>=
+@!mem_bot=0; {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+ {Use |mem_bot=0| for compilers which cannot decrement pointers.}
+@z
+
+@x
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TeXformats:ALEPH.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@y
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@!hash_offset=514; {smallest index in hash array, i.e., |hash_base| }
+ {Use |hash_offset=0| for compilers which cannot decrement pointers.}
+@!trie_op_size=15011; {space for ``opcodes'' in the hyphenation patterns;
+ best if relatively prime to 313, 361, and 1009.}
+@!neg_trie_op_size=-15011; {for lower |trie_op_hash| array bound;
+ must be equal to |-trie_op_size|.}
+@!min_trie_op=0; {first possible trie op code for any language}
+@!max_trie_op=ssup_trie_opcode; {largest possible trie opcode for any language}
+@!pool_name=TEXMF_POOL_NAME; {this is configurable, for the sake of ML-\TeX}
+ {string of length |file_name_size|; tells where the string pool appears}
+@!engine_name=TEXMF_ENGINE_NAME; {the name of this engine}
+@#
+@!inf_main_memory = 2000000;
+@!sup_main_memory = 16000000;
+
+@!inf_trie_size = 80000;
+@!sup_trie_size = ssup_trie_size;
+
+@!inf_max_strings = 100000;
+@!sup_max_strings = ssup_max_strings;
+
+@!inf_strings_free = 100;
+@!sup_strings_free = sup_max_strings;
+
+@!inf_buf_size = 500;
+@!sup_buf_size = 200000;
+
+@!inf_nest_size = 40;
+@!sup_nest_size = 400;
+
+@!inf_max_in_open = 6;
+@!sup_max_in_open = 127;
+
+@!inf_param_size = 60;
+@!sup_param_size = 600;
+
+@!inf_save_size = 600;
+@!sup_save_size = 40000;
+
+@!inf_stack_size = 200;
+@!sup_stack_size = 3000;
+
+@!inf_dvi_buf_size = 800;
+@!sup_dvi_buf_size = 65536;
+
+@!inf_pool_size = 32000;
+@!sup_pool_size = 10000000;
+@!inf_pool_free = 1000;
+@!sup_pool_free = sup_pool_size;
+@!inf_string_vacancies = 8000;
+@!sup_string_vacancies = sup_pool_size - 23000;
+
+@!sup_hyph_size = ssup_hyph_size;
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@z
+
+@x [1.12] l.427 - Constants that are WEB numeric macros.
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions;
+ if you change this, you should also change |iinf_hyphen_size|.}
+@z
+
+@x [1.16] l.498 - Use C macros for `incr' and `decr'.
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@y
+@z
+
+% The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x [2.19] l.565 - data type text_char is 8-bit ASCII_code
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+% [3.26] name_of_file is no longer an array. And change the destination
+% type to text_char, which fixes:
+%
+% Date: 19 Sep 1994 10:38:24 +0200
+% From: thorinn@diku.dk (Lars Mathiesen)
+% When echoed to the screen and in the log, character codes
+% above '177 in file names are shown wrongly (typically as ^@).
+%
+@x [3.26] l.789 - name_of_file is no longer an array
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@y
+@!name_of_file:^char;
+@z
+
+@x [3.27] l.794 - Do file opening in C.
+@ The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `{\bf packed array
+$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\TeX\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\TeX's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@ All of the file opening functions are defined in C.
+@z
+
+@x [3.28] l.850 - Do file closing in C.
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+These procedures should not generate error messages if a file is
+being closed before it has been successfully opened.
+
+@p procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var f:word_file); {close a word file}
+begin close(f);
+end;
+@y
+@ And all the file closing routines as well.
+@z
+
+@x [3.30] l.888 - Array size of input buffer is determined at runtime.
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@y
+@!buffer:^ASCII_code; {lines of characters being read}
+@z
+
+@x [3.31] l.933 - Do `input_ln' in C.
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=f^; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+We define |input_ln| in C, for efficiency.
+@z
+
+% [3.32] `term_in' and `term_out' are standard input and output.
+% Declare the variables that used to be constants.
+@x [3.32] l.961 - `term_in' and `term_out' are standard input and output.
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+@y
+@d term_in==stdin {the terminal as an input file}
+@d term_out==stdout {the terminal as an output file}
+
+@<Glob...@>=
+@!init
+@!ini_version:boolean; {are we \.{INITEX}?}
+@!dump_option:boolean; {was the dump name option used?}
+@!dump_line:boolean; {was a \.{\%\AM format} line seen?}
+tini@/
+@#
+@!bound_default:integer; {temporary for setup}
+@!bound_name:^char; {temporary for setup}
+@#
+@!main_memory:integer; {total memory words allocated in initex}
+@!extra_mem_bot:integer; {|mem_min:=mem_bot-extra_mem_bot| except in \.{INITEX}}
+@!mem_min:integer; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!mem_top:integer; {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|,
+ equal to |mem_max| in \.{INITEX}, else not greater than |mem_max|}
+@!extra_mem_top:integer; {|mem_max:=mem_top+extra_mem_top| except in \.{INITEX}}
+@!mem_max:integer; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!error_line:integer; {width of context lines on terminal error messages}
+@!half_error_line:integer; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@!max_strings:integer; {maximum number of strings; must not exceed |max_halfword|}
+@!strings_free:integer; {strings available after format loaded}
+@!string_vacancies:integer; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size:integer; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!pool_free:integer;{pool space free after format loaded}
+@!hyph_size:integer; {maximun number of hyphen exceptions}
+@!trie_size:integer; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX. 50000 is
+ needed for English, German, and Portuguese.}
+@!buf_size:integer; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!stack_size:integer; {maximum number of simultaneous input sources}
+@!max_in_open:integer; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!param_size:integer; {maximum number of simultaneous macro parameters}
+@!nest_size:integer; {maximum number of semantic levels simultaneously active}
+@!save_size:integer; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@!quoted_filename:boolean; {current filename is quoted}
+@z
+
+@x [3.33] l.964 - We don't need to open terminal files.
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+@y
+@ Here is how to open the terminal files. |t_open_out| does nothing.
+|t_open_in|, on the other hand, does the work of ``rescanning,'' or getting
+any command line arguments the user has provided. It's defined in C.
+
+@d t_open_out == {output already open for text output}
+@z
+
+@x [3.34] l.982 - Flushing output to terminal files.
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@y
+these operations can be specified with {\mc UNIX}. |update_terminal|
+does an |fflush|. |clear_terminal| is redefined
+to do nothing, since the user should control the terminal.
+@^system dependencies@>
+
+@d update_terminal == fflush (term_out)
+@d clear_terminal == do_nothing
+@z
+
+@x [3.35] l.1017 - Do `input_ln' in C => section not needed.
+@<Report overflow of the input buffer, and abort@>=
+if format_ident=0 then
+ begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+ end
+else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+@y
+Routine is implemented in C; part of module is, however, needed for e-TeX.
+
+@<Report overflow of the input buffer, and abort@>=
+ begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+@z
+
+@x [3.37] l.1055 - |init_terminal|, reading the command line.
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+@y
+@ The following program does the required initialization.
+Iff anything has been specified on the command line, then |t_open_in|
+will return with |last > first|.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+if last > first then
+ begin loc := first;
+ while (loc < last) and (buffer[loc]=' ') do incr(loc);
+ if loc < last then
+ begin init_terminal := true; goto exit;
+ end;
+ end;
+@z
+
+@x [3.37] l.1068 - |init_terminal|, output missing newline.
+ write(term_out,'! End of file on the terminal... why?');
+@y
+ write_ln(term_out,'! End of file on the terminal... why?');
+@z
+
+@x [4.38] l.1126 - Array size for string pool is determined at runtime.
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@y
+@!pool_pointer = integer; {for variables that point into |str_pool|}
+@!str_number = 0..ssup_max_strings; {for variables that point into |str_start|}
+@z
+
+@x [4.39] l.1131 - Dynamically size pool arrays.
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start_ar : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@!str_pool: ^packed_ASCII_code; {the characters}
+@!str_start_ar : ^pool_pointer; {the starting pointers}
+@z
+
+@x [4.47] l.1237 - string recycling
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+@y
+@p @t\4@>@<Declare additional routines for string recycling@>@/
+
+@!init function get_strings_started:boolean; {initializes the string pool,
+@z
+
+% [4.51] Open the pool file using a path, and can't do string
+% assignments directly. (`strcpy' and `strlen' work here because
+% `pool_name' is a constant string, and thus ends in a null and doesn't
+% start with a space.)
+@x [4.51] l.1314 - Open the pool file.
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+@y
+name_length := strlen (pool_name);
+name_of_file := xmalloc_array (char, name_length + 1);
+strcpy (name_of_file+1, pool_name); {copy the string}
+if a_open_in (pool_file, kpse_texpool_format) then
+@z
+
+@x [4.51] l.1322 - Make `OMEGA.POOL' lowercase, and change how it's read.
+else bad_pool('! I can''t read ALEPH.POOL.')
+@y
+else bad_pool('! I can''t read ', pool_name, '; bad path?')
+@z
+@x [4.52] l.1326 - Make `OMEGA.POOL' lowercase, and change how it's read.
+begin if eof(pool_file) then bad_pool('! ALEPH.POOL has no check sum.');
+@.ALEPH.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+@y
+begin if eof(pool_file) then bad_pool('! ', pool_name, ' has no check sum.');
+@.ALEPH.POOL has no check sum@>
+read(pool_file,m); read(pool_file,n); {read two digits of string length}
+@z
+@x [4.52] l.1332 - Make `ALEPH.POOL' lowercase, and change how it's read.
+ bad_pool('! ALEPH.POOL line doesn''t begin with two digits.');
+@y
+ bad_pool('! ', pool_name, ' line doesn''t begin with two digits.');
+@z
+@x [4.53] l.1354 - Make `ALEPH.POOL' lowercase, and change how it's read.
+ bad_pool('! ALEPH.POOL check sum doesn''t have nine digits.');
+@y
+ bad_pool('! ', pool_name, ' check sum doesn''t have nine digits.');
+@z
+@x [4.53] l.1360 - Make `OMEGA.POOL' lowercase, and change how it's read.
+done: if a<>@$ then bad_pool('! ALEPH.POOL doesn''t match; OTANGLE me again.');
+@y
+done: if a<>@$ then
+ bad_pool('! ', pool_name, ' doesn''t match; otangle me again (or fix the path).');
+@z
+
+@x [5.54] l.1422 - error_line
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+@y
+@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for
+@z
+
+@x [5.61] l.1556 - Print rest of banner, eliminate misleading `(no format preloaded)'.
+wterm(eTeX_banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+@y
+wterm(eTeX_banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+@z
+
+@x [6.73] l.1732 - Add unspecified_mode.
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@y
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d unspecified_mode=4 {extra value for command-line switch}
+@z
+
+@x [6.73] l.1738 - Add interaction_option.
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@y
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@!interaction_option:batch_mode..unspecified_mode; {set from command line}
+@z
+
+@x [6.74] l.1740 - Allow override by command line switch.
+@ @<Set init...@>=interaction:=error_stop_mode;
+@y
+@ @<Set init...@>=if interaction_option=unspecified_mode then
+ interaction:=error_stop_mode
+else
+ interaction:=interaction_option;
+@z
+
+% [6.81] Eliminate nonlocal goto, since C doesn't have them.
+% Plus, it's nicer just to do an exit with the appropriate status code
+% under Unix. We call it `uexit' because there's a WEB symbol called
+% `exit' already. We use a C macro to change `uexit' back to `exit'.
+@x [6.81] l.1852 - Eliminate nonlocal goto, since C doesn't have them.
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+@y
+@d do_final_end==begin
+ update_terminal;
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+ uexit(1)
+ else
+ uexit(0);
+ end
+
+@<Error hand...@>=
+procedure jump_out;
+begin
+close_files_and_terminate;
+do_final_end;
+end;
+@z
+
+@x [6.84] l.1888 - Implement the switch-to-editor option.
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@y
+line ready to be edited.
+We do this by calling the external procedure |call_edit| with a pointer to
+the filename, its length, and the line number.
+However, here we just set up the variables that will be used as arguments,
+since we don't want to do the switch-to-editor until after TeX has closed
+its files.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@d edit_file==input_stack[base_ptr]
+@z
+
+@x [6.84] l.1903 - Implement the switch-to-editor option.
+"E": if base_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ slow_print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+@y
+"E": if base_ptr>0 then
+ begin edit_name_start:=str_start(edit_file.name_field);
+ edit_name_length:=str_start(edit_file.name_field+1) -
+ str_start(edit_file.name_field);
+ edit_line:=line;
+ jump_out;
+@z
+
+% [7.104] `remainder' is a library routine on some systems, so change
+% its name to avoid conflicts.
+@x [7.104] l.2227 - avoid name conflicts with lib routine remainder()
+|remainder|, holds the remainder after a division.
+
+@<Glob...@>=
+@y
+|remainder|, holds the remainder after a division.
+
+@d remainder==tex_remainder
+
+@<Glob...@>=
+@z
+
+@x [7.109] l.2352 - Define glue_ratio in C.
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+@y
+@z
+
+@x [8.112] l.2435 - Efficiency.
+macros are simplified in the obvious way when |min_quarterword=0|.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+macros are simplified in the obvious way when |min_quarterword=0|.
+So they have been simplified here in the obvious way.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item from a quarterword}
+@d hi(#)==# {to put a sixteen-bit item into a halfword}
+@d ho(#)==# {to take a sixteen-bit item from a halfword}
+@z
+
+% [8.113] We've put the memory structure into the include file
+% `texmf.h', since it's too hard to translate automatically.
+@x [8.113] l.2453 - data structures for main memory
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case four_choices of
+ 1: (@!int:integer);
+ 2: (@!gr:glue_ratio);
+ 3: (@!hh:two_halves);
+ 4: (@!qqqq:four_quarters);
+ end;
+@y
+@!quarterword = min_quarterword..max_quarterword;
+@!halfword = min_halfword..max_halfword;
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@=#include "texmfmem.h";@>
+@=#include "alephmem.h";@>
+@z
+
+% [9.116] Change `mem' to `zmem', so we can define mem to be a register
+% pointer to the memory array for speed.
+@x [9.116] l.2545 - definition of main memory array
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@y
+@!yzmem : ^memory_word; {the big dynamic storage area}
+@!zmem : ^memory_word; {the big dynamic storage area}
+@z
+
+% [9.127] Fix casting problem in C.
+% There are several of these. They come from the rules C uses for
+% comparing signed and unsigned quantities. Just doing the comparison
+% can result in incorrect evaluation wrt the way Pascal would do it.
+@x [9.127] l.2739 - Fix casting problem in C.
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+@y 2738
+if r>intcast(p+1) then @<Allocate from the top of node |p| and |goto found|@>;
+@z
+
+% [11.165] Fix the word `free' so that it doesn't conflict with the
+% standard C library routine of the same name.
+@x [11.165] l.3364 - avoid conflict with lib function free()
+are debugging.)
+@y
+are debugging.)
+
+@d free==free_arr
+@z
+
+@x [11.165] l.3367 - dummy |free| and |was_free| arrays
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [mem_min..mem_max] of boolean;
+@y
+ {The debug memory arrays have not been mallocated yet.}
+@!debug @!free: packed array [0..9] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [0..9] of boolean;
+@z
+
+@x [12.174] l.3526 - Eliminate unsigned comparisons to zero.
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+@y
+ begin @<Print the font identifier for |font(p)|@>;
+@z
+
+@x [12.176] l.3563 - Eliminate unsigned comparisons to zero.
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+@y
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin @<Print the font identifier for |font(p)|@>;
+@z
+
+@x [12.186] l.3747 - Don't worry about strange floating point values.
+ if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
+ else if abs(g)>float_constant(20000) then
+@y 3747
+ { The Unix |pc| folks removed this restriction with a remark that
+ invalid bit patterns were vanishingly improbable, so we follow
+ their example without really understanding it.
+ |if abs(mem[p+glue_offset].int)<@'4000000 then print('?.?')|
+ |else| }
+ if fabs(g)>float_constant(20000) then
+@z
+
+
+@x [16.213] l.4321 - texarray
+@!nest:array[0..nest_size] of list_state_record;
+@y
+@!nest:^list_state_record;
+@z
+
+@x [16.215] l.4344 - remove mem[] reference from initialize.
+@<Start a new current page@>;
+@y
+@/{The following piece of code is a copy of module 991:}
+page_contents:=empty; page_tail:=page_head; {|link(page_head):=null;|}@/
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+page_depth:=0; page_max_depth:=0;
+@z
+
+@x [17.241] l.5219 - Do `fix_date_and_time' in C.
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+It calls a macro-defined |date_and_time| routine. |date_and_time|
+in turn is a C macro, which calls |get_date_and_time|, passing
+it the addresses of the day, month, etc., so they can be set by the
+routine. |get_date_and_time| also sets up interrupt catching if that
+is conditionally compiled in the C code.
+@^system dependencies@>
+
+@d fix_date_and_time==o_date_and_time(int_base+time_code,
+ int_base+day_code,
+ int_base+month_code,
+ int_base+year_code)
+@z
+
+@x [18.262] l.5584 - Remove more unsigned comparisons to zero.
+else if (newtext(p)<0)or(newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@y
+else if (newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@z
+
+@x [19.271] l.5872 - texarray
+@!save_stack : array[0..save_size] of memory_word;
+@y
+@!save_stack : ^memory_word;
+@z
+
+@x [22.301] l.6432 - texarray
+@!input_stack : array[0..stack_size] of in_state_record;
+@y
+@!input_stack : ^in_state_record;
+@z
+
+@x [22.304] l.6536 - texarray
+@!input_file : array[1..max_in_open] of alpha_file;
+@!input_file_mode : array[1..max_in_open] of halfword;
+@!input_file_translation : array[1..max_in_open] of halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+@y
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@z
+
+@x [22.308] l.6701 - texarray
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+@y
+@!param_stack: ^pointer;
+ {token list pointers for parameters}
+@z
+
+@x [23.328] l.7043 - keep top of source_filename_stack initialized
+incr(in_open); push_input; index:=in_open;
+@y
+incr(in_open); push_input; index:=in_open;
+source_filename_stack[index]:=0;full_source_filename_stack[index]:=0;
+@z
+
+@x [23.331] l.7071 - init source file name stacks
+begin input_ptr:=0; max_in_stack:=0;
+@y
+begin input_ptr:=0; max_in_stack:=0;
+source_filename_stack[0]:=0;full_source_filename_stack[0]:=0;
+@z
+
+@x [28.501] l.9747 - \eof18
+if_eof_code: begin scan_four_bit_int; b:=(read_open[cur_val]=closed);
+ end;
+@y
+if_eof_code: begin scan_four_bit_int_or_18;
+ if cur_val=18 then b:=not shell_enabled_p
+ else b:=(read_open[cur_val]=closed);
+ end;
+@z
+
+@x [29.513] l.9951 - Area and extension rules for filenames.
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@y
+@ The file names we shall deal with have the
+following structure: If the name contains `\./' or `\.:'
+(for Amiga only), the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the last
+`\..' to the end, otherwise the file extension is null.
+@z
+
+@x [29.513] l.9963 - Area and extension rules for filenames.
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+@y
+@!area_delimiter:pool_pointer; {the most recent `\./', if any}
+@!ext_delimiter:pool_pointer; {the most recent `\..', if any}
+@z
+
+@x [29.514] l.9973 - TeX area directories.
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+In C, the default paths are specified separately.
+@z
+
+@x [29.515] l.9995 - filenames: quoted
+begin area_delimiter:=0; ext_delimiter:=0;
+@y
+begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false;
+@z
+
+@x [29.516] l.9992 - filenames: more_name
+begin if c=" " then more_name:=false
+@y
+begin if (c=" ") and stop_at_space and (not quoted_filename) then
+ more_name:=false
+else if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+ end
+@z
+
+@x [29.516] l.9994 - filenames: more_name
+ if (c=">")or(c=":") then
+@y
+ if IS_DIR_SEP(c) then
+@z
+
+@x [29.516] l.9997 - filenames: more_name
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
+@y
+ else if c="." then ext_delimiter:=cur_length;
+@z
+
+@x [29.517] l.10002 - end_name: string recycling
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+@y
+@ The third.
+@^system dependencies@>
+If a string is already in the string pool, the function
+|slow_make_string| does not create a new string but returns this string
+number, thus saving string space. Because of this new property of the
+returned string number it is not possible to apply |flush_string| to
+these strings.
+
+@p procedure end_name;
+var temp_str: str_number; {result of file name cache lookups}
+@!j,@!s,@!t: pool_pointer; {running indices}
+@!must_quote:boolean; {whether we need to quote a string}
+@z
+
+@x [29.517] l.10022 - end_name: spaces in filenames
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+@y
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+str_room(6); {Room for quotes, if needed.}
+{add quotes if needed}
+if area_delimiter<>0 then begin
+ {maybe quote |cur_area|}
+ must_quote:=false;
+ s:=str_start(str_ptr);
+ t:=str_start(str_ptr)+area_delimiter;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+ if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+ area_delimiter:=area_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+ end;
+{maybe quote |cur_name|}
+s:=str_start(str_ptr)+area_delimiter;
+if ext_delimiter=0 then t:=pool_ptr else t:=str_start(str_ptr)+ext_delimiter-1;
+must_quote:=false;
+j:=s;
+while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+if ext_delimiter<>0 then begin
+ {maybe quote |cur_ext|}
+ s:=str_start(str_ptr)+ext_delimiter-1;
+ t:=pool_ptr;
+ must_quote:=false;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+ if must_quote then begin
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ pool_ptr:=pool_ptr+2;
+ end;
+ end;
+@z
+
+@x [29.517] l.10011 - end_name: string recycling
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+@y
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ temp_str:=search_string(cur_area);
+ if temp_str>0 then
+ begin cur_area:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start(str_ptr+1) to pool_ptr-1 do
+ begin str_pool[j-area_delimiter]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-area_delimiter; {update |pool_ptr|}
+ end;
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=slow_make_string;
+@z
+
+@x [29.517] l.10016 - end_name: string recycling
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+@y
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+ decr(str_ptr); {undo extension string to look at name part}
+ temp_str:=search_string(cur_name);
+ if temp_str>0 then
+ begin cur_name:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start(str_ptr+1) to pool_ptr-1 do
+ begin str_pool[j-ext_delimiter+area_delimiter+1]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-ext_delimiter+area_delimiter+1; {update |pool_ptr|}
+ end;
+ cur_ext:=slow_make_string; {remake extension string}
+@z
+
+@x [29.518] l.10042 - print_file_name: quote if spaces in names.
+begin slow_print(a); slow_print(n); slow_print(e);
+@y
+var must_quote: boolean; {whether to quote the filename}
+@!j:pool_pointer; {index into |str_pool|}
+begin
+must_quote:=false;
+if a<>0 then begin
+ j:=str_start(a);
+ while (not must_quote) and (j<>str_start(a+1)) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if n<>0 then begin
+ j:=str_start(n);
+ while (not must_quote) and (j<>str_start(n+1)) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if e<>0 then begin
+ j:=str_start(e);
+ while (not must_quote) and (j<>str_start(e+1)) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+{FIXME: Alternative is to assume that any filename that has to be quoted has
+ at least one quoted component...if we pick this, a number of insertions
+ of |print_file_name| should go away.
+|must_quote|:=((|a|<>0)and(|str_pool|[|str_start|(|a|)]=""""))or
+ ((|n|<>0)and(|str_pool|[|str_start|(|n|)]=""""))or
+ ((|e|<>0)and(|str_pool|[|str_start|(|e|)]=""""));}
+if must_quote then print_char("""");
+if a<>0 then
+ for j:=str_start(a) to str_start(a+1)-1 do
+ if so(str_pool[j])<>"""" then
+ print_char(so(str_pool[j]));
+if n<>0 then
+ for j:=str_start(n) to str_start(n+1)-1 do
+ if so(str_pool[j])<>"""" then
+ print_char(so(str_pool[j]));
+if e<>0 then
+ for j:=str_start(e) to str_start(e+1)-1 do
+ if so(str_pool[j])<>"""" then
+ print_char(so(str_pool[j]));
+if must_quote then print_char("""");
+@z
+
+@x [29.519] l.10051 - have append_to_name skip quotes.
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+% [29.519] In pack_file_name, leave room for the extra null we append at
+% the end of a filename.
+@x [29.519] l.10047 - pack_file_name, leave room for the extra null
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file:= xmalloc_array(char, 1 + length(a) + length(n) + length(e));
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+@z
+
+@x [29.519] l.10051 - pack_file_name, append the extra null
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.520] l.10060 - filenames: default format.
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+@y
+Under {\mc UNIX} we don't give the area part, instead depending
+on the path searching that will happen during file opening. Also, the
+length will be set in the main program.
+
+@d format_area_length=0 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+@z
+
+@x [29.521] l.10066 - filenames: default format, where `plain.fmt' is.
+@!TEX_format_default:packed array[1..format_default_length] of char;
+
+@ @<Set init...@>=
+TEX_format_default:='TeXformats:plain.fmt';
+@y
+@!format_default_length: integer;
+@!TEX_format_default: ^char;
+
+@ We set the name of the default format file and the length of that name
+in C, instead of Pascal, since we want them to depend on the name of the
+program.
+@z
+
+@x [29.523] l.10095 - Change to pack_buffered_name as with pack_file_name.
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file := xmalloc_array (char, 1 + n + (b - a + 1) + format_ext_length);
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@z
+
+@x [29.523] l.10100 - Change to pack_buffered_name as with pack_file_name.
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.524] l.10118 - Format file opening: only try once, with path searching.
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(fmt_file) then goto found;
+ pack_buffered_name(format_area_length,loc,j-1);
+ {now try the system format file area}
+ if w_open_in(fmt_file) then goto found;
+@y
+ pack_buffered_name(0,loc,j-1); {Kpathsea does everything}
+ if w_open_in(fmt_file) then goto found;
+@z
+
+@x [29.524] l.10124 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
+@y
+ wterm ('Sorry, I can''t find the format `');
+ fputs (name_of_file + 1, stdout);
+ wterm ('''; will try `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''.');
+@z
+
+@x [29.524] l.10132 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('I can''t find the PLAIN format file!');
+@.I can't find PLAIN...@>
+@y
+ wterm ('I can''t find the format file `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''!');
+@.I can't find the format...@>
+@z
+
+@x [29.525] l.10163 - make_name_string
+ make_name_string:=make_string;
+ end;
+@y
+ make_name_string:=make_string;
+ end;
+ {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to
+ match the contents of |name_of_file|.}
+ k:=1;
+ name_in_progress:=true;
+ begin_name;
+ stop_at_space:=false;
+ while (k<=name_length)and(more_name(name_of_file[k])) do
+ incr(k);
+ stop_at_space:=true;
+ end_name;
+ name_in_progress:=false;
+@z
+
+@x [29.526] l.10194 - stop scanning file name if we're at end-of-line.
+ if not more_name(cur_chr) then goto done;
+@y
+ {If |cur_chr| is a space and we're not scanning a token list, check
+ whether we're at the end of the buffer. Otherwise we end up adding
+ spurious spaces to file names in some cases.}
+ if (cur_chr=" ") and (state<>token_list) and (loc>limit) then goto done;
+ if not more_name(cur_chr) then goto done;
+@z
+
+@x [29.530] l.10245 - prompt_file_name: prevent empty filenames.
+var k:0..buf_size; {index into |buffer|}
+@y
+var k:0..buf_size; {index into |buffer|}
+@!saved_cur_name:str_number; {to catch empty terminal input}
+@z
+
+@x [29.530] l.10252 - prompt_file_name: No default extension is TeX input file.
+if e=".tex" then show_context;
+@y
+if (e=".tex") or (e="") then show_context;
+@z
+
+@x [29.530] l.10258 - prompt_file_name: prevent empty filenames.
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+@y
+saved_cur_name:=cur_name;
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+if length(cur_name)=0 then cur_name:=saved_cur_name;
+@z
+
+@x [29.532] l.10263 - avoid conflict, `logname' in <unistd.h> on some systems.
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@y
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d log_name == texmf_log_name
+@z
+
+@x [29.534] l.10285 - Adjust for C string conventions.
+@!months:packed array [1..36] of char; {abbreviations of month names}
+@y
+@!months:^char;
+j:integer;
+@z
+
+@x [29.534] l. - Send the job_name to the file recorder.
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+@y
+begin old_setting:=selector;
+if job_name=0 then job_name:=get_job_name("texput");
+pack_job_name(".ofl");
+recorder_change_filename(stringcast(name_of_file+1));
+@z
+
+@x [29.536] l.10324 - Print rest of banner.
+begin wlog(eTeX_banner);
+@y
+begin wlog(eTeX_banner);
+wlog(version_string);
+@z
+
+@x [29.536] l.10327 - Adjust for C string conventions.
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@y
+months := ' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@z
+
+% [29.537] Use a path when calling a_open_in to do a \input; also, try
+% to open the file with and without the `.tex' extension, regardless of
+% whether the file already has an extension. This allows filenames like
+% `foo' and `foo.bar.tex', as well as `foo.tex' and `foo.bar'.
+@x [29.537] l.10338 - start_input
+begin scan_file_name; {set |cur_name| to desired file name}
+if cur_ext="" then cur_ext:=".tex";
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,TEX_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+@y
+var temp_str: str_number; k: integer;
+begin scan_file_name; {set |cur_name| to desired file name}
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ tex_input_type := 1; {Tell |open_input| we are \.{\\input}.}
+ {Kpathsea tries all the various ways to get the file.}
+ if open_in_name_ok(name_of_file+1)
+ and a_open_in(cur_file, kpse_tex_format) then
+ goto done;
+@z
+
+@x [29.537] l.10348 - start_input: don't force ".tex" extension.
+ prompt_file_name("input file name",".tex");
+@y
+ prompt_file_name("input file name","");
+@z
+
+@x [29.537] l.10350 - start_input: string recycling
+done: name:=a_make_name_string(cur_file);
+@y
+done: name:=a_make_name_string(cur_file);
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@z
+
+@x [29.537] l.10352 - start_input: use different heuristic for initex.
+ begin job_name:=cur_name; open_log_file;
+@y
+ begin job_name:=get_job_name(cur_name); open_log_file;
+@z
+
+@x [29.537] l.10359 - start_input: don't return filename to string pool.
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string; name:=cur_name;
+ end;
+@y
+@z
+
+@x [30.563] l.10943 - Don't use TEX_font_area.
+if aire="" then pack_file_name(nom,TEX_font_area,".ofm")
+else pack_file_name(nom,aire,".ofm");
+if not b_open_in(tfm_file) then abort;
+@y
+{|kpse_find_file| will append the |".ofm"| or |".tfm"|,
+ and avoid searching the disk before the font alias files as well.}
+pack_file_name(nom,aire,"");
+if not ofm_open_in(tfm_file) then abort;
+@z
+
+% [30.564] Reading the tfm file. As a special case, whenever we open a
+% tfm file, we read its first byte into `tfm_temp' right away. TeX
+% looks at `fbyte' before calling `fget', so it ends up seeing every
+% byte. This is Pascal-like I/O.
+@x [30.564] l.10956 - reading the tfm file, define fget & fbyte
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@y
+@d fget==tfm_temp:=getc(tfm_file)
+@d fbyte==tfm_temp
+@z
+
+% [32.575] We only want `eof' on the TFM file to be true if we
+% previously had EOF, not if we're at EOF now. This is like `feof', and
+% unlike our implementation of `eof' elsewhere.
+@x [32.575] l.11161 - Reading the tfm file, replace eof() by feof().
+if eof(tfm_file) then abort;
+@y
+if feof(tfm_file) then abort;
+@z
+
+@x [32.595] l.11860 - texarray
+@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:dvi_index; {half of |dvi_buf_size|}
+@!dvi_limit:dvi_index; {end of the current half buffer}
+@!dvi_ptr:dvi_index; {the next available buffer address}
+@y
+@!dvi_buf:^real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:integer; {half of |dvi_buf_size|}
+@!dvi_limit:integer; {end of the current half buffer}
+@!dvi_ptr:integer; {the next available buffer address}
+@z
+
+@x [32.597] l.11886 - write_dvi done in C.
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+In C, we use a macro to call |fwrite| or |write| directly, writing all
+the bytes in one shot. Much better even than writing four
+bytes at a time.
+@z
+
+@x [32.617] l.12261 - Use output_comment if the user set it. Assume it's short enough.
+ old_setting:=selector; selector:=new_string;
+@y
+if output_comment then
+ begin l:=strlen(output_comment); dvi_out(l);
+ for s:=0 to l-1 do dvi_out(output_comment[s]);
+ end
+else begin {the default code is unchanged}
+ old_setting:=selector; selector:=new_string;
+@z
+
+@x [32.617] l.12268 - Use output_comment if the user set it.
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+@y
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+end;
+@z
+
+% We output each portion of the page as we get to it, if we are using
+% IPC, so that the previewer (TeXView) can display it immediately. [SPM]
+@x [32.640] l.12690 - IPC
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+@y
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+ifdef ('IPC')
+if ipc_on>0 then
+ begin if dvi_limit=half_buf then
+ begin write_dvi(half_buf, dvi_buf_size-1);
+ flush_dvi;
+ dvi_gone:=dvi_gone+half_buf;
+ end;
+ if dvi_ptr>0 then
+ begin write_dvi(0, dvi_ptr-1);
+ flush_dvi;
+ dvi_offset:=dvi_offset+dvi_ptr; dvi_gone:=dvi_gone+dvi_ptr;
+ end;
+ dvi_ptr:=0; dvi_limit:=dvi_buf_size;
+ ipc_page(dvi_gone);
+ end;
+endif ('IPC');
+@z
+
+@x [32.642] l.12742 - Use dvi_offset instead of dvi_buf_size with IPC stuff.
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+@y
+ifdef ('IPC')
+ k:=7-((3+dvi_offset+dvi_ptr) mod 4); {the number of 223's}
+endif ('IPC')
+ifndef ('IPC')
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+endifn ('IPC')
+@z
+
+@x [32.642] l.12773 - use print_file_name
+ print_nl("Output written on "); slow_print(output_file_name);
+@y
+ print_nl("Output written on "); print_file_name(0, output_file_name, 0);
+@z
+
+@x [38.859] l.16855 - Fix a casting/expression evaluation problem.
+if abs(fit_class-fitness(r))>1 then d:=d+adj_demerits;
+@y
+if abs(intcast(fit_class)-intcast(fitness(r)))>1 then d:=d+adj_demerits;
+@z
+
+@x [39.875] l.17170 - Another casting problem.
+ begin line_diff:=line_number(r)-best_line;
+@y
+ begin line_diff:=intcast(line_number(r))-intcast(best_line);
+@z
+
+@x [42.920] l.18068 - bigtrie: allow larger hyphenation tries.
+@!trie_pointer=0..trie_size; {an index into |trie|}
+@y
+@!trie_pointer=0..ssup_trie_size; {an index into |trie|}
+@z
+
+@x [42.921] l.18075 - bigtrie: allow larger hyphenation tries.
+@!trie:array[trie_pointer] of two_halves; {|trie_link|, |trie_char|, |trie_op|}
+@y
+{We will dynamically allocate this arrays.}
+@!trie:^two_halves; {|trie_link|}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18126 m.925
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+@y 18126
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+This is a clever scheme which saves the need for a hash link array.
+However, it is difficult to increase the size of the hyphen exception
+arrays. To make this easier, the ordered hash has been replaced by
+a simple hash, using an additional array |hyph_link|. The value
+|0| in |hyph_link[k]| means that there are no more entries corresponding
+to the specific hash chain. When |hyph_link[k]>0|, the next entry in
+the hash chain is |hyph_link[k]-1|. This value is used because the
+arrays start at |0|.
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18134 m.925
+@!hyph_pointer=0..hyph_size; {an index into the ordered hash table}
+@y 18134
+@!hyph_pointer=0..ssup_hyph_size; {index into hyphen exceptions hash table;
+ enlarging this requires changing (un)dump code}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18137 m.926
+@!hyph_word:array[hyph_pointer] of str_number; {exception words}
+@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions}
+@!hyph_count:hyph_pointer; {the number of words in the exception dictionary}
+@y 18139
+@!hyph_word: ^str_number; {exception words}
+@!hyph_list: ^pointer; {list of hyphen positions}
+@!hyph_link: ^hyph_pointer; {link array for hyphen exceptions hash table}
+@!hyph_count:integer; {the number of words in the exception dictionary}
+@!hyph_next:integer; {next free slot in hyphen exceptions hash table}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18145 m.928
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null;
+ end;
+hyph_count:=0;
+@y 18148
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null; hyph_link[z]:=0;
+ end;
+hyph_count:=0;
+hyph_next:=hyph_prime+1; if hyph_next>hyph_size then hyph_next:=hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18163 m.930
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_size;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+not_found: decr(hn)
+@y 18170
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_prime;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ h:=hyph_link[h]; if h=0 then goto not_found;
+ decr(h);
+ end;
+not_found: decr(hn)
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18172 m.931
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)<hn then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start(k);
+ repeat if so(str_pool[u])<hc[j] then goto not_found;
+ if so(str_pool[u])>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@y 18184
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start(k);
+ repeat
+ if so(str_pool[u])<>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@z
+
+% The GNU C compiler complains of unused variables.
+@x
+@!s,@!t:str_number; {strings being compared or stored}
+@y
+@!s:str_number; {strings being compared or stored}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18274 m.939
+ begin h:=(h+h+hc[j]) mod hyph_size;
+@y 18274
+ begin h:=(h+h+hc[j]) mod hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18281 m.940
+@ @<Insert the \(p)pair |(s,p)|...@>=
+if hyph_count=hyph_size then overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+hyph_word[h]:=s; hyph_list[h]:=p
+@y 18290
+@ @<Insert the \(p)pair |(s,p)|...@>=
+ if hyph_next <= hyph_prime then
+ while (hyph_next>0) and (hyph_word[hyph_next-1]>0) do decr(hyph_next);
+if (hyph_count=hyph_size)or(hyph_next=0) then
+ overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if hyph_link[h]=0 then
+ begin
+ hyph_link[h]:=hyph_next;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime;
+ if hyph_next > hyph_prime then incr(hyph_next);
+ end;
+ h:=hyph_link[h]-1;
+ end;
+
+found: hyph_word[h]:=s; hyph_list[h]:=p
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18292 m.941
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+k:=hyph_word[h];
+if length(k)<length(s) then goto found;
+if length(k)>length(s) then goto not_found;
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+found:q:=hyph_list[h]; hyph_list[h]:=p; p:=q;@/
+t:=hyph_word[h]; hyph_word[h]:=s; s:=t;
+not_found:
+@y 18303
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h];
+if length(k)<>length(s) then goto not_found;
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+{repeat hyphenation exception; flushing old data}
+flush_string; s:=hyph_word[h]; {avoid |slow_make_string|!}
+decr(hyph_count);
+{ We could also |flush_list(hyph_list[h]);|, but it interferes
+ with \.{trip.log}. }
+goto found;
+not_found:
+@z
+
+@x [43.943] l.18346 - web2c can't parse negative lower bounds in arrays. Sorry.
+@!init@! trie_op_hash:array[-trie_op_size..trie_op_size] of 0..trie_op_size;
+@y
+@!init@! trie_op_hash:array[neg_trie_op_size..trie_op_size] of 0..trie_op_size;
+@z
+
+@x [43.944] l.18365 - web2c can't parse negative lower bounds in arrays. Sorry
+var h:-trie_op_size..trie_op_size; {trial hash location}
+@y
+var h:neg_trie_op_size..trie_op_size; {trial hash location}
+@z
+
+@x [43.944] l.18370 - Another casting problem, and use |neg_trie_op_size|.
+begin h:=abs(n+313*d+361*v+1009*cur_lang) mod (trie_op_size+trie_op_size)
+ - trie_op_size;
+@y
+begin h:=abs(intcast(n)+313*intcast(d)+361*intcast(v)+1009*intcast(cur_lang))
+ mod (trie_op_size - neg_trie_op_size)
+ + neg_trie_op_size;
+@z
+
+@x [43.947] l.18438 - Dynamically allocate arrays, and a casting problem.
+@!init @!trie_c:packed array[trie_pointer] of ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:packed array[trie_pointer] of quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:packed array[trie_pointer] of trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:packed array[trie_pointer] of trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:packed array[trie_pointer] of trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@y
+@!init @!trie_c:^ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:^quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:^trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:^trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:^trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@z
+
+@x [43.948] l.18471 - Another casting problem.
+begin h:=abs(trie_c[p]+1009*trie_o[p]+@|
+ 2718*trie_l[p]+3142*trie_r[p]) mod trie_size;
+@y
+begin h:=abs(intcast(trie_c[p])+1009*intcast(trie_o[p])+@|
+ 2718*intcast(trie_l[p])+3142*intcast(trie_r[p])) mod trie_size;
+@z
+
+@x [43.590] l.18524 - Dynamically allocate & larger tries.
+@!init@!trie_taken:packed array[1..trie_size] of boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:array[ASCII_code] of trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@y
+@!init@!trie_taken: ^boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:^trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@z
+
+@x [43.951] l.18539 - Dynamically allocate.
+trie_not_ready:=true; trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+trie_not_ready:=true;
+@z
+
+%%
+%% We can rewrite the original code after "main_loop_move+2" upto the
+%% "tail_append(lig_stack)" in module 1036 as
+%%
+%
+% main_loop_move+2:
+% if font_bc[main_f]<=cur_chr then
+% if cur_chr<=font_ec[main_f] then
+% begin main_i:=char_info(main_f)(cur_l);
+% if char_exists(main_i) goto main_loop_move+3;
+% end;
+% char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+% main_loop_move+3:
+% tail_append(lig_stack) {|main_loop_lookahead| is next}
+%
+
+@x [49.1252] l.23230 - INI = VIR, so have to do runtime test.
+hyph_data: if cur_chr=1 then
+ begin @!init new_patterns; goto done;@;@+tini@/
+@y 23215
+hyph_data: if cur_chr=1 then
+ begin @!init if ini_version then
+ begin new_patterns; goto done; end; @;@+tini@/
+@z
+
+@x
+@!flushable_string:str_number; {string not yet referenced}
+@y
+@z
+
+% undo Knuth's change because
+% a) the string is already replaced in |scan_file_name| and therefore
+% b) the wrong string will get flushed!!!
+%
+@x [49.1260] l.23331 new_font: string recycling -- already done
+flushable_string:=str_ptr-1;
+@y
+@z
+
+% If you don't want to remove code with the following change,
+% please replace the former change by
+%
+% @x
+% flushable_string:=str_ptr-1;
+% @y
+% if cur_name=str_ptr-1 then
+% flushable_string:=str_ptr-1
+% else
+% flushable_string:=str_ptr; {number of a non-existing}
+% @z
+%
+% otherwise the wrong string will get removed by |flush_string|!!
+%
+@x [49.1260] l.23334 new_font: string recycling -- already done
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name(f);
+ end;
+ if s>0 then
+@y
+ begin if s>0 then
+@z
+
+@x [49.1265] if batchmode, mktex... scripts should be silent.
+interaction:=cur_chr;
+@y
+interaction:=cur_chr;
+if interaction = batch_mode
+then kpse_make_tex_discard_errors := 1
+else kpse_make_tex_discard_errors := 0;
+@z
+
+@x [49.1275] l.23441 - Same stuff as for \input, this time for \openin.
+ if cur_ext="" then cur_ext:=".tex";
+ pack_cur_name;
+ if a_open_in(read_file[n]) then read_open[n]:=just_open;
+@y
+ pack_cur_name;
+ tex_input_type:=0; {Tell |open_input| we are \.{\\openin}.}
+ if open_in_name_ok(name_of_file+1)
+ and a_open_in(read_file[n], kpse_tex_format) then
+ read_open[n]:=just_open;
+@z
+
+@x [50.1301] l.23679 - INI = VIR, so runtime test.
+format_ident:=" (INIALEPH)";
+@y
+if ini_version then format_ident:=" (INIALEPH)";
+@z
+
+% The GNU C compiler complains of unused variables.
+% Add format_engine.
+@x [50.1302] l.23690 - Eliminate now-unused variable `w' in `store_fmt_file'.
+var j,@!k,@!l:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!w: four_quarters; {four ASCII codes}
+@y
+var j,@!k:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!format_engine: ^char;
+@z
+
+@x [50.1303] l.23722 - Ditto, for `load_fmt_file'.
+@!w: four_quarters; {four ASCII codes}
+@y
+@!format_engine: ^char;
+@z
+
+@x [50.1305] l.23751 - Do dumping and undumping of fmt files in C.
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+@y
+@z
+@x [1306]
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@y
+@z
+@x [still 1306] debug format file
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@y
+@d format_debug_end(#)==
+ write_ln (stderr, ' = ', #);
+ end;
+@d format_debug(#)==
+ if debug_format_file then begin
+ write (stderr, 'fmtdebug:', #);
+ format_debug_end
+@d undump_size_end_end(#)==
+ too_small(#)@+else format_debug (#)(x); undump_end_end
+@z
+
+@x [50,1307] l.23779 - texarray
+dump_int(@$);@/
+@y
+dump_int(@"57325458); {Web2C \TeX's magic constant: "W2TX"}
+{Align engine to 4 bytes with one or more trailing NUL}
+x:=strlen(engine_name);
+format_engine:=xmalloc_array(char,x+4);
+strcpy(format_engine, engine_name);
+for k:=x to x+3 do format_engine[k]:=0;
+x:=x+4-(x mod 4);
+dump_int(x);dump_things(format_engine[0], x);
+libc_free(format_engine);@/
+dump_int(@$);@/
+dump_int(max_halfword);@/
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23784 m.1307
+dump_int(hyph_size)
+@y 23784
+dump_int(hyph_prime)
+@z
+
+@x [50.1308] l.23793 - texarray
+x:=fmt_file^.int;
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@/@<Undump the \eTeX\ state@>@/
+undump_int(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(x);
+if x<>mem_top then goto bad_fmt;
+@y
+@+init
+if ini_version then
+ begin libc_free(str_pool); libc_free(str_start_ar); libc_free(yzmem);
+ end;
+@+tini
+undump_int(x);
+format_debug('format magic number')(x);
+if x<>@"57325458 then goto bad_fmt; {not a format file}
+undump_int(x);
+format_debug('engine name size')(x);
+if (x<0) or (x>256) then goto bad_fmt; {corrupted format file}
+format_engine:=xmalloc_array(char, x);
+undump_things(format_engine[0], x);
+format_engine[x-1]:=0; {force string termination, just in case}
+if strcmp(engine_name, format_engine) then
+ begin wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' was written by ', format_engine);
+ libc_free(format_engine);
+ goto bad_fmt;
+end;
+libc_free(format_engine);
+undump_int(x);
+format_debug('string pool checksum')(x);
+if x<>@$ then begin {check that strings are the same}
+ wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' doesn''t match ', pool_name);
+ goto bad_fmt;
+end;
+undump_int(x);
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+@/@<Undump the \eTeX\ state@>@/
+
+undump_int(x); format_debug ('mem_bot')(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(mem_top); format_debug ('mem_top')(mem_top);
+if mem_bot+1100>mem_top then goto bad_fmt;
+
+
+head:=contrib_head; tail:=contrib_head;
+ page_tail:=page_head; {page initialization}
+
+mem_min := mem_bot - extra_mem_bot;
+mem_max := mem_top + extra_mem_top;
+
+yzmem:=xmalloc_array (memory_word, mem_max - mem_min + 1);
+zmem := yzmem - mem_min; {this pointer arithmetic fails with some compilers}
+mem := zmem;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23804 m.1308
+if x<>hyph_size then goto bad_fmt
+@y 23804
+if x<>hyph_prime then goto bad_fmt
+@z
+
+% [1309] Make dumping/undumping more efficient by doing whole arrays at
+% a time, via fread/fwrite in texmfmp.c.
+@x [50.1309] l.23814 - Make dumping/undumping more efficient.
+for k:=too_big_char to str_ptr do dump_int(str_start(k));
+k:=0;
+while k+4<pool_ptr do
+ begin dump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; dump_four_ASCII;
+@y
+dump_things(str_start(too_big_char), str_ptr-too_big_char+1);
+dump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1310] l.23829 - Make dumping/undumping more efficient.
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings)('max strings')(str_ptr);
+for k:=too_big_char to str_ptr do undump(0)(pool_ptr)(str_start(k));
+k:=0;
+while k+4<pool_ptr do
+ begin undump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; undump_four_ASCII;
+@y
+undump_size(0)(sup_pool_size-pool_free)('string pool size')(pool_ptr);
+if pool_size<pool_ptr+pool_free then
+ pool_size:=pool_ptr+pool_free;
+undump_size(0)(sup_max_strings-strings_free)('sup strings')(str_ptr);@/
+if max_strings<str_ptr+strings_free then
+ max_strings:=str_ptr+strings_free;
+str_start_ar:=xmalloc_array(pool_pointer, max_strings-biggest_char);
+undump_things(str_start(too_big_char), str_ptr-too_big_char+1);
+str_pool:=xmalloc_array(packed_ASCII_code, pool_size);
+undump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1311] l.23850 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do dump_wd(mem[k]);
+@y
+repeat dump_things(mem[p], q+2-p);
+@z
+
+@x [50.1311] l.23855 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do dump_wd(mem[k]);
+@y
+dump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1311] l.23858 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
+@y
+dump_things(mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+@x [50.1312] l.23873 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do undump_wd(mem[k]);
+@y
+repeat undump_things(mem[p], q+2-p);
+@z
+
+@x [50.1312] l.23878 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do undump_wd(mem[k]);
+@y
+undump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1312] l.23888 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
+@y
+undump_things (mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24058 m.1324
+dump_int(hyph_count);
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k); dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@y 24061
+dump_int(hyph_count);
+if hyph_next <= hyph_prime then hyph_next:=hyph_size;
+dump_int(hyph_next);{minumum value of |hyphen_size| needed}
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k+65536*hyph_link[k]);
+ {assumes number of hyphen exceptions does not exceed 65535}
+ dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@z
+
+@x [50.1324] l.24066 - Make dumping/undumping more efficient - trie
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(max_hyph_char);
+dump_int(trie_op_ptr);
+for k:=1 to trie_op_ptr do
+ begin dump_int(hyf_distance[k]);
+ dump_int(hyf_num[k]);
+ dump_int(hyf_next[k]);
+ end;
+@y
+dump_things(trie[0],trie_max+1);
+dump_int(max_hyph_char);
+dump_int(trie_op_ptr);
+dump_things(hyf_distance[1], trie_op_ptr);
+dump_things(hyf_num[1], trie_op_ptr);
+dump_things(hyf_next[1], trie_op_ptr);
+@z
+
+@x [50.1325] l.24086 - Make dumping/undumping more efficient - trie
+@<Undump the hyphenation tables@>=
+@y
+{This is only used for the hyphenation tries below, and the size is
+ always |j+1|.}
+@d xmalloc_and_undump(#) ==
+ if not # then #:=xmalloc_array(two_halves, j+1);
+ undump_things(#[0], j+1);
+
+@<Undump the hyphenation tables@>=
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24087 m.1325
+undump(0)(hyph_size)(hyph_count);
+for k:=1 to hyph_count do
+ begin undump(0)(hyph_size)(j);
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+@y 24092
+undump_size(0)(hyph_size)('hyph_size')(hyph_count);
+undump_size(hyph_prime)(hyph_size)('hyph_size')(hyph_next);
+j:=0;
+for k:=1 to hyph_count do
+ begin undump_int(j); if j<0 then goto bad_fmt;
+ if j>65535 then
+ begin hyph_next:= j div 65536; j:=j - hyph_next * 65536; end
+ else hyph_next:=0;
+ if (j>=hyph_size)or(hyph_next>hyph_size) then goto bad_fmt;
+ hyph_link[j]:=hyph_next;
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+ {|j| is now the largest occupied location in |hyph_word|}
+ incr(j);
+ if j<hyph_prime then j:=hyph_prime;
+ hyph_next:=j;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime else
+ if hyph_next >= hyph_prime then incr(hyph_next);
+@z
+
+
+@x [50.1325] l.24094 - Make dumping/undumping more efficient - trie
+for k:=0 to j do undump_hh(trie[k]);
+undump_int(max_hyph_char);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+for k:=1 to j do
+ begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
+ undump(0)(63)(hyf_num[k]);
+ undump(min_quarterword)(max_quarterword)(hyf_next[k]);
+ end;
+@y
+{The first array has not been allocated yet unless we're \.{INITEX};
+ we do that precisely so we don't allocate more space than necessary.}
+xmalloc_and_undump(trie);
+undump_int(max_hyph_char);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+{I'm not sure we have such a strict limitation (64) on these values, so
+ let's leave them unchecked.}
+undump_things(hyf_distance[1], j);
+undump_things(hyf_num[1], j);
+undump_upper_check_things(max_quarterword, hyf_next[1], j);
+@z
+
+@x [50.1327] l.24117 - Allow command line to override dumped value.
+undump(batch_mode)(error_stop_mode)(interaction);
+@y
+undump(batch_mode)(error_stop_mode)(interaction);
+if interaction_option<>unspecified_mode then interaction:=interaction_option;
+@z
+
+% [50.1327] As with TFM files, `eof' here means `have we previously
+% encountered the end-of-file', not `are we at the end of the file'.
+@x [50.1327] l.24120 - dumping/undumping, replace eof() by feof()
+if (x<>69069)or eof(fmt_file) then goto bad_fmt
+@y
+if (x<>69069)or feof(fmt_file) then goto bad_fmt
+@z
+
+@x [50.1328] l.24124 - Eliminate probably wrong word `preloaded' from format_idents.
+print(" (preloaded format="); print(job_name); print_char(" ");
+@y
+print(" (format="); print(job_name); print_char(" ");
+@z
+
+@x [51.1332] l.24203 - make the main program a procedure, for eqtb hack.
+@p begin @!{|start_here|}
+@y
+@d const_chk(#)==begin if # < inf@&# then # := inf@&# else
+ if # > sup@&# then # := sup@&# end
+
+{|setup_bound_var| stuff duplicated in \.{mf.ch}.}
+@d setup_bound_var(#)==bound_default:=#; setup_bound_var_end
+@d setup_bound_var_end(#)==bound_name:=#; setup_bound_var_end_end
+@d setup_bound_var_end_end(#)==
+ setup_bound_variable(address_of(#), bound_name, bound_default);
+
+@p procedure main_body;
+begin @!{|start_here|}
+
+{Always start the file recorder?}
+ {|recorder_enabled:=true;|}
+
+{Bounds that may be set from the configuration file. We want the user to
+ be able to specify the names with underscores, but \.{TANGLE} removes
+ underscores, so we're stuck giving the names twice, once as a string,
+ once as the identifier. How ugly.}
+ setup_bound_var (1000000)('main_memory')(main_memory);
+ {|memory_word|s for |mem| in \.{INITEX}}
+ setup_bound_var (0)('extra_mem_top')(extra_mem_top);
+ {increase high mem in \.{VIRTEX}}
+ setup_bound_var (0)('extra_mem_bot')(extra_mem_bot);
+ {increase low mem in \.{VIRTEX}}
+ setup_bound_var (300000)('pool_size')(pool_size);
+ setup_bound_var (200000)('string_vacancies')(string_vacancies);
+ setup_bound_var (5000)('pool_free')(pool_free); {min pool avail after fmt}
+ setup_bound_var (100000)('max_strings')(max_strings);
+ setup_bound_var (100)('strings_free')(strings_free);
+ setup_bound_var (20000)('trie_size')(trie_size);
+ {if |ssup_trie_size| increases, recompile}
+ setup_bound_var (659)('hyph_size')(hyph_size);
+ setup_bound_var (20000)('buf_size')(buf_size);
+ setup_bound_var (50)('nest_size')(nest_size);
+ setup_bound_var (15)('max_in_open')(max_in_open);
+ setup_bound_var (60)('param_size')(param_size);
+ setup_bound_var (4000)('save_size')(save_size);
+ setup_bound_var (300)('stack_size')(stack_size);
+ setup_bound_var (16384)('dvi_buf_size')(dvi_buf_size);
+ setup_bound_var (79)('error_line')(error_line);
+ setup_bound_var (50)('half_error_line')(half_error_line);
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ const_chk (main_memory);
+@+init
+ if ini_version then begin
+ extra_mem_top := 0;
+ extra_mem_bot := 0;
+ end;
+@+tini
+ if extra_mem_bot>sup_main_memory then extra_mem_bot:=sup_main_memory;
+ if extra_mem_top>sup_main_memory then extra_mem_top:=sup_main_memory;
+ {|mem_top| is an index, |main_memory| a size}
+ mem_top := mem_bot + main_memory -1;
+ mem_min := mem_bot;
+ mem_max := mem_top;
+
+ {Check other constants against their sup and inf.}
+ const_chk (trie_size);
+ const_chk (hyph_size);
+ const_chk (buf_size);
+ const_chk (nest_size);
+ const_chk (max_in_open);
+ const_chk (param_size);
+ const_chk (save_size);
+ const_chk (stack_size);
+ const_chk (dvi_buf_size);
+ const_chk (pool_size);
+ const_chk (string_vacancies);
+ const_chk (pool_free);
+ const_chk (max_strings);
+ const_chk (strings_free);
+ if error_line > ssup_error_line then error_line := ssup_error_line;
+
+ {array memory allocation}
+ buffer:=xmalloc_array (ASCII_code, buf_size);
+ nest:=xmalloc_array (list_state_record, nest_size);
+ save_stack:=xmalloc_array (memory_word, save_size);
+ input_stack:=xmalloc_array (in_state_record, stack_size);
+ input_file:=xmalloc_array (alpha_file, max_in_open);
+ input_file_mode:=xmalloc_array (halfword, max_in_open);
+ input_file_translation:=xmalloc_array (halfword, max_in_open);
+ line_stack:=xmalloc_array (integer, max_in_open);
+ param_stack:=xmalloc_array (halfword, param_size);
+ dvi_buf:=xmalloc_array (real_eight_bits, dvi_buf_size);
+ hyph_word:=xmalloc_array (str_number, hyph_size);
+ hyph_list:=xmalloc_array (halfword, hyph_size);
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+@+init
+if ini_version then begin
+ yzmem:=xmalloc_array (memory_word, mem_top - mem_bot + 1);
+ zmem := yzmem - mem_bot; {Some compilers require |mem_bot=0|}
+
+ str_start_ar:=xmalloc_array (pool_pointer, max_strings-biggest_char);
+ str_pool:=xmalloc_array (packed_ASCII_code, pool_size);
+end;
+@+tini
+@z
+
+@x [51.1332] l.24215 - INI = VIR, so pool init needs runtime test
+@!init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+@y
+@+init if ini_version then
+ begin if not get_strings_started then goto final_end;
+ init_prim; {call |primitive| for each primitive}
+ init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+ end;
+@+tini@/
+@z
+
+@x [51.1332] l.24225 - main
+end_of_TEX: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+@y
+close_files_and_terminate;
+final_end: do_final_end;
+end {|main_body|};
+@z
+
+@x [51.1333] l.24254 - Print new line before termination; switch to editor if necessary.
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+@y
+ print_file_name(0, log_name, 0); print_char(".");
+ end;
+ end;
+print_ln;
+if (edit_name_start<>0) and (interaction>batch_mode) then
+ call_edit(str_pool,edit_name_start,edit_name_length,edit_line);
+@z
+
+@x [51.1334] l. - Remove reference to fontmemsize
+ wlog_ln(', out of ',font_mem_size:1,' for ',font_max-font_base:1);@/
+@y
+@z
+
+@x [51.1335] l.24335 - Only do dump if ini.
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+ store_fmt_file; return;@+tini@/
+@y
+ begin @!init if ini_version then
+ begin for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+ store_fmt_file; return;
+ end;@+tini@/
+@z
+
+@x [51.1337] l.24361 - Handle %&format in all cases.
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+if (format_ident=0)or(buffer[loc]="&")or dump_line then
+@z
+
+@x [51.1337] l.24371 - Allocate hyphenation tries.
+fix_date_and_time;@/
+@y
+fix_date_and_time;@/
+
+@!init
+if trie_not_ready then begin {initex without format loaded}
+ trie:=xmalloc_array (two_halves, trie_size);
+
+ trie_c:=xmalloc_array (ASCII_code, trie_size);
+ trie_o:=xmalloc_array (quarterword, trie_size);
+ trie_l:=xmalloc_array (trie_pointer, trie_size);
+ trie_r:=xmalloc_array (trie_pointer, trie_size);
+ trie_hash:=xmalloc_array (trie_pointer, trie_size);
+ trie_taken:=xmalloc_array (boolean, trie_size);
+ trie_min:=xmalloc_array (trie_pointer, too_big_char);
+
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+ end;
+ tini@/
+
+@z
+
+% [52.1338] Core-dump in debugging mode on 0 input. Under Unix, it's
+% not possible to portably switch into the debugger while a program is
+% running. The best approximation is to do a core dump, then run the
+% debugger on it later.
+@x [52.1338] l.24411 - Core-dump in debugging mode on 0 input.
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+@y
+ dump_core {do something to cause a core dump}
+@z
+
+% The GNU C compiler complains of unused variables.
+@x
+procedure do_extension;
+var i,@!j,@!k:integer; {all-purpose integers}
+@!p,@!q,@!r:pointer; {all-purpose pointers}
+@y
+procedure do_extension;
+var @!k:integer; {all-purpose integers}
+@!p:pointer; {all-purpose pointers}
+@z
+
+% [53.1350] (new_write_whatsit) Allow 18 as a \write stream. We never
+% refer to an actual file, though, so we don't need to change the
+% write_file or write_open arrays. We provide for disabling this at
+% runtime, for paranoids.
+@x [53.1350] l.24609 - system: Allow 18 as a \write stream.
+ else if cur_val>15 then cur_val:=16;
+@y
+ else if (cur_val>15) and (cur_val <> 18) then cur_val:=16;
+@z
+
+@x [53.1370] l.24770 - system: (write_out) \write18{foo} => system(foo).
+begin @<Expand macros in the token list
+@y
+@!d:integer; {number of characters in incomplete current string}
+@!clobbered:boolean; {system string is ok?}
+begin @<Expand macros in the token list
+@z
+
+@x [53.1370] l.24773 - system: (write_out) \write18{foo} => system(foo).
+if write_open[j] then selector:=j
+@y
+if j=18 then selector := new_string
+else if write_open[j] then selector:=j
+@z
+
+% Then call system(3) on that string.
+@x [53.1370] l.24779 - system: (write_out) \write18{foo} => system(foo).
+flush_list(def_ref); selector:=old_setting;
+@y
+flush_list(def_ref);
+if j=18 then
+ begin if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ {If the log file isn't open yet, we can only send output to the terminal.
+ Calling |open_log_file| from here seems to result in bad data in the log.}
+ if not log_opened then selector:=term_only;
+ print_nl("system(");
+ for d:=0 to cur_length-1 do
+ begin {|print| gives up if passed |str_ptr|, so do it by hand.}
+ print(so(str_pool[str_start(str_ptr)+d])); {N.B.: not |print_char|}
+ end;
+ print(")...");
+ if shell_enabled_p then
+ begin str_room(1); append_char(0); {Append a null byte to the expansion.}
+ clobbered:=false;
+ for d:=0 to cur_length-1 do {Convert to external character set.}
+ begin str_pool[str_start(str_ptr)+d]:=xchr[str_pool[str_start(str_ptr)+d]];
+ if (str_pool[str_start(str_ptr)+d]=null_code)
+ and (d<cur_length-1) then clobbered:=true;
+ {minimal checking: NUL not allowed in argument string of |system|()}
+ end;
+ if clobbered then print("clobbered")
+ else begin {We have the string; run system(3). We don't have anything
+ reasonable to do with the return status, unfortunately discard it.}
+ for d:=0 to cur_length-1 do {Convert to external character set.}
+ begin
+ outside_string_array[d]:=xchr[str_pool[str_start(str_ptr)+d]];
+ end;
+ outside_string_array[cur_length]:=null_code;
+ system(outside_string_array);
+ print("executed");
+ end;
+ end
+ else begin print("disabled");
+ end;
+ print_char("."); print_nl(""); print_ln;
+ pool_ptr:=str_start(str_ptr); {erase the string}
+end;
+selector:=old_setting;
+@z
+
+@x [53.1373] Need new local.
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+@y
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+ @!old_setting:0..max_selector;
+@z
+
+@x [53.1374] Disallow certain \openout filenames, and log results.
+ while not a_open_out(write_file[j]) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+@y
+ while not a_open_out(write_file[j])
+ or not open_out_name_ok(name_of_file+1) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+ {If on first line of input, log file is not ready yet, so don't log.}
+ if log_opened then begin
+ old_setting:=selector;
+ if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ print_nl("\openout");
+ print_int(j);
+ print(" = `");
+ print_file_name(cur_name,cur_area,cur_ext);
+ print("'."); print_nl(""); print_ln;
+ selector:=old_setting;
+ end;
+@z
+
+@x [54.1376] l.24903 - Add editor-switch variables to globals.
+@* \[54] System-dependent changes.
+@y
+@* \[54/web2c] System-dependent changes for Web2c.
+Here are extra variables for Web2c. (This numbering of the
+system-dependent section allows easy integration of Web2c and e-\TeX, etc.)
+@^<system dependencies@>
+
+@<Glob...@>=
+@!edit_name_start: pool_pointer; {where the filename to switch to starts}
+@!edit_name_length,@!edit_line: integer; {what line to start editing at}
+@!ipc_on: c_int_type; {level of IPC action, 0 for none [default]}
+@!stop_at_space: boolean; {whether |more_name| returns false for space}
+
+@ The |edit_name_start| will be set to point into |str_pool| somewhere after
+its beginning if \TeX\ is supposed to switch to an editor on exit.
+
+@<Set init...@>=
+edit_name_start:=0;
+stop_at_space:=true;
+
+@ These are used when we regenerate the representation of the first 256
+strings.
+
+@<Global...@> =
+@!save_str_ptr: str_number;
+@!save_pool_ptr: pool_pointer;
+@!shell_enabled_p: c_int_type;
+@!output_comment: ^char;
+@!k,l: 0..65535; {used by `Make the first 256 strings', etc.}
+
+@ When debugging a macro package, it can be useful to see the exact
+control sequence names in the format file. For example, if ten new
+csnames appear, it's nice to know what they are, to help pinpoint where
+they came from. (This isn't a truly ``basic'' printing procedure, but
+that's a convenient module in which to put it.)
+
+@<Basic printing procedures@> =
+procedure print_csnames (hstart:integer; hfinish:integer);
+var c,h:integer;
+begin
+ write_ln(stderr, 'fmtdebug:csnames from ', hstart, ' to ', hfinish, ':');
+ for h := hstart to hfinish do begin
+ if newtext(h) > 0 then begin {if have anything at this position}
+ for c := str_start(newtext(h)) to str_start(newtext(h) + 1) - 1
+ do begin
+ put_byte(str_pool[c], stderr); {print the characters}
+ end;
+ write_ln(stderr, '|');
+ end;
+ end;
+end;
+
+@ Are we printing extra info as we read the format file?
+
+@<Glob...@> =
+@!debug_format_file: boolean;
+
+
+@ A helper for printing file:line:error style messages. Look for a
+filename in |full_source_filename_stack|, and if we fail to find
+one fall back on the non-file:line:error style.
+
+@<Basic print...@>=
+procedure print_file_line;
+var level: 0..max_in_open;
+begin
+ level:=in_open;
+ while (level>0) and (full_source_filename_stack[level]=0) do
+ decr(level);
+ if level=0 then
+ print_nl("! ")
+ else begin
+ print_nl (""); print (full_source_filename_stack[level]); print (":");
+ if level=in_open then print_int (line)
+ else print_int (line_stack[index+1-(in_open-level)]);
+ print (": ");
+ end;
+end;
+
+@ To be able to determine whether \.{\\write18} is enabled from within
+\TeX\ we also implement \.{\\eof18}. We sort of cheat by having an
+additional route |scan_four_bit_int_or_18| which is the same as
+|scan_four_bit_int| except it also accepts the value 18.
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_four_bit_int_or_18;
+begin scan_int;
+if (cur_val<0)or((cur_val>15)and(cur_val<>18)) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@* \[54/web2c-string] The string recycling routines. \TeX{} uses 2
+upto 4 {\it new\/} strings when scanning a filename in an \.{\\input},
+\.{\\openin}, or \.{\\openout} operation. These strings are normally
+lost because the reference to them are not saved after finishing the
+operation. |search_string| searches through the string pool for the
+given string and returns either 0 or the found string number.
+
+@<Declare additional routines for string recycling@>=
+function search_string(@!search:str_number):str_number;
+label found;
+var result: str_number;
+@!s: str_number; {running index}
+@!len: integer; {length of searched string}
+begin result:=0; len:=length(search);
+if len=0 then {trivial case}
+ begin result:=""; goto found;
+ end
+else begin s:=search-1; {start search with newest string below |s|; |search>1|!}
+ while s>65535 do {first 65536 strings depend on implementation!!}
+ begin if length(s)=len then
+ if str_eq_str(s,search) then
+ begin result:=s; goto found;
+ end;
+ decr(s);
+ end;
+ end;
+found:search_string:=result;
+end;
+
+@ The following routine is a variant of |make_string|. It searches
+the whole string pool for a string equal to the string currently built
+and returns a found string. Otherwise a new string is created and
+returned. Be cautious, you can not apply |flush_string| to a replaced
+string!
+
+@<Declare additional routines for string recycling@>=
+function slow_make_string : str_number;
+label exit;
+var s: str_number; {result of |search_string|}
+@!t: str_number; {new string}
+begin t:=make_string; s:=search_string(t);
+if s>0 then
+ begin flush_string; slow_make_string:=s; return;
+ end;
+slow_make_string:=t;
+exit:end;
+
+@* \[54] System-dependent changes.
+@z
diff --git a/Build/source/texk/web2c/alephdir/comchar.ch b/Build/source/texk/web2c/alephdir/comchar.ch
new file mode 100644
index 00000000000..2f83aa2ab8a
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comchar.ch
@@ -0,0 +1,20 @@
+% comchar.ch: Local adaptations for file omchar.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/alephdir/comdir.ch b/Build/source/texk/web2c/alephdir/comdir.ch
new file mode 100644
index 00000000000..cf41e790053
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comdir.ch
@@ -0,0 +1,20 @@
+% comdir.ch: Local adaptations for file omdir.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/alephdir/comfi.ch b/Build/source/texk/web2c/alephdir/comfi.ch
new file mode 100644
index 00000000000..3d5b2487ca5
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comfi.ch
@@ -0,0 +1,20 @@
+% comfi.ch: Local adapatations for file omfi.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/alephdir/comfilter.ch b/Build/source/texk/web2c/alephdir/comfilter.ch
new file mode 100644
index 00000000000..70dcb9a9bde
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comfilter.ch
@@ -0,0 +1,123 @@
+% comfilter.ch: Local adaptations for file omfilter.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x
+@!inf_ocp_list_size = 1000;
+@y
+@!inf_ocp_list_size = 1000;
+@!sup_ocp_buf_size = 1000000;
+@!inf_ocp_buf_size = 1000;
+@!sup_ocp_stack_size = 1000000;
+@!inf_ocp_stack_size = 1000;
+@z
+%---------------------------------------
+@x
+@!ocp_list_size:integer;
+@y
+@!ocp_list_size:integer;
+@!ocp_buf_size:integer;
+@!ocp_stack_size:integer;
+@z
+%---------------------------------------
+@x
+for k:=0 to active_max_ptr-1 do dump_wd(active_info[k]);
+print_ln; print_int(active_max_ptr); print(" words of active ocps");
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+for k:=0 to active_max_ptr-1 do undump_wd(active_info[k]);
+@y
+dump_things(active_info[0], active_max_ptr);
+print_ln; print_int(active_max_ptr); print(" words of active ocps");
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+undump_things(active_info[0], active_max_ptr);
+@z
+%---------------------------------------
+@x
+ setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+@y
+ setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+ setup_bound_var(1000)('ocp_buf_size')(ocp_buf_size);
+ setup_bound_var(1000)('ocp_stack_size')(ocp_stack_size);
+@z
+%---------------------------------------
+@x
+ ocp_list_list:=xmalloc_array (ocp_list_index, ocp_list_size);
+@y
+ ocp_list_list:=xmalloc_array (ocp_list_index, ocp_list_size);
+ otp_init_input_buf:=xmalloc_array (quarterword, ocp_buf_size);
+ otp_input_buf:=xmalloc_array (quarterword, ocp_buf_size);
+ otp_output_buf:=xmalloc_array (quarterword, ocp_buf_size);
+ otp_stack_buf:=xmalloc_array (quarterword, ocp_stack_size);
+ otp_calcs:=xmalloc_array (halfword, ocp_stack_size);
+ otp_states:=xmalloc_array (halfword, ocp_stack_size);
+@z
+%---------------------------------------
+@x
+@!otp_init_input_buf:array[0..20000] of quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:array[0..20000] of quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:array[0..20000] of quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:array[0..1000] of quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:array[0..1000] of halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:array[0..1000] of halfword;
+@y
+@!otp_init_input_buf:^quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:^quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:^quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:^quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:^halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:^halfword;
+@z
diff --git a/Build/source/texk/web2c/alephdir/comfont.ch b/Build/source/texk/web2c/alephdir/comfont.ch
new file mode 100644
index 00000000000..b5934f0589a
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comfont.ch
@@ -0,0 +1,20 @@
+% comfonts.ch: Local adaptations for file omfonts.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/alephdir/comocp.ch b/Build/source/texk/web2c/alephdir/comocp.ch
new file mode 100644
index 00000000000..27c052d70e7
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comocp.ch
@@ -0,0 +1,141 @@
+% comcop.ch: Local adaptations for file omocp.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@y
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@!sup_ocp_list_size = 1000000;
+@!inf_ocp_list_size = 1000;
+@z
+%---------------------------------------
+@x
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@y
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@!ocp_list_size:integer;
+@z
+%---------------------------------------
+@x
+if not b_open_in(ocp_file) then ocp_abort("opening file");
+@y
+if not ocp_open_in(ocp_file) then ocp_abort("opening file");
+@z
+%---------------------------------------
+@x
+@d ocpget==get(ocp_file)
+@d ocpbyte==ocp_file^
+@y
+@d ocpget==ocp_temp:=getc(ocp_file)
+@d ocpbyte==ocp_temp
+@z
+%---------------------------------------
+@x
+@!ocp_list_info:array[ocp_list_index] of memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
+@y
+@!ocp_list_info:^memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:^memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:^ocp_list_index;
+@z
+%---------------------------------------
+@x
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
+dump_int(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ dump_int(ocp_list_list[k]);
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
+@y
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+dump_things(ocp_list_info[0], ocp_listmem_ptr);
+dump_int(ocp_list_ptr);
+dump_things(ocp_list_list[null_ocp_list], ocp_list_ptr+1-null_ocp_list);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+dump_things(ocp_lstack_info[0], ocp_lstackmem_ptr)
+@z
+%---------------------------------------
+@x
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
+undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do
+ undump_int(ocp_list_list[k]);
+undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
+@y
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+undump_things(ocp_list_info[0], ocp_listmem_ptr);
+undump_size(0)(1000000)('ocp list max')(ocp_list_ptr);
+undump_things(ocp_list_list[null_ocp_list], ocp_list_ptr+1-null_ocp_list);
+undump_size(0)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+undump_things(ocp_lstack_info[0], ocp_lstackmem_ptr)
+@z
+%---------------------------------------
+@x
+ setup_bound_var (79)('max_print_line')(max_print_line);
+@y
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+@z
+%---------------------------------------
+@x
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+@y
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+ ocp_list_info:=xmalloc_array (memory_word, ocp_list_size);
+ ocp_lstack_info:=xmalloc_array (memory_word, ocp_list_size);
+ ocp_list_list:=xmalloc_array (ocp_list_index, ocp_list_size);
+@z
diff --git a/Build/source/texk/web2c/alephdir/compar.ch b/Build/source/texk/web2c/alephdir/compar.ch
new file mode 100644
index 00000000000..42251993dd0
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/compar.ch
@@ -0,0 +1,20 @@
+% Local adaptations for file ompar.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/alephdir/comsrcspec.ch b/Build/source/texk/web2c/alephdir/comsrcspec.ch
new file mode 100644
index 00000000000..46ee017ee95
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comsrcspec.ch
@@ -0,0 +1,346 @@
+@x
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@!quoted_filename:boolean; {current filename is quoted}
+@y
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@!quoted_filename:boolean; {current filename is quoted}
+@!special_loc:pointer;
+@!special_token:halfword;
+
+@!parse_first_line_p:c_int_type; {parse the first line for options}
+@!file_line_error_style_p:c_int_type; {format messages as file:line:error}
+@!halt_on_error_p:boolean; {allow only on error.}
+
+@!src_specials_p : boolean;
+@!insert_src_special_auto : boolean;
+@!insert_src_special_every_par : boolean;
+@!insert_src_special_every_parend : boolean;
+@!insert_src_special_every_cr : boolean;
+@!insert_src_special_every_math : boolean;
+@!insert_src_special_every_hbox : boolean;
+@!insert_src_special_every_vbox : boolean;
+@!insert_src_special_every_display : boolean;
+@z
+
+@x
+wterm(eTeX_banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+@y
+if src_specials_p or file_line_error_style_p or parse_first_line_p then
+ wterm(banner_k)
+else
+ wterm(eTeX_banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+if shell_enabled_p then begin
+ wterm_ln(' \write18 enabled.')
+end;
+if src_specials_p then begin
+ wterm_ln(' Source specials enabled.')
+end;
+if file_line_error_style_p then begin
+ wterm_ln(' file:line:error style messages enabled.')
+end;
+if parse_first_line_p then begin
+ wterm_ln(' %&-line parsing enabled.')
+end;
+@z
+
+@x
+ print_nl("! "); print(#);
+@y
+ if file_line_error_style_p then print_file_line
+ else print_nl("! ");
+ print(#);
+@z
+
+@x
+print_char("."); show_context;
+@y
+print_char("."); show_context;
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+@z
+
+@x
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@y
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@!source_filename_stack : ^str_number;
+@!full_source_filename_stack : ^str_number;
+@z
+
+@x
+begin wlog(eTeX_banner);
+wlog(version_string);
+@y
+begin if src_specials_p or file_line_error_style_p or parse_first_line_p
+then
+ wlog(banner_k)
+else
+ wlog(eTeX_banner);
+wlog(version_string);
+if shell_enabled_p then begin
+ wlog_cr;
+ wlog('\write18 enabled.')
+end;
+if src_specials_p then begin
+ wlog_cr;
+ wlog(' Source specials enabled.')
+end;
+if file_line_error_style_p then begin
+ wlog_cr;
+ wlog(' file:line:error style messages enabled.')
+end;
+if parse_first_line_p then begin
+ wlog_cr;
+ wlog(' %&-line parsing enabled.');
+end;
+@z
+
+%% ** 537 ******************************************************************
+
+@x
+done: name:=a_make_name_string(cur_file);
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@y
+done: name:=a_make_name_string(cur_file);
+source_filename_stack[in_open]:=name;
+full_source_filename_stack[in_open]:=make_full_name_string;
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@z
+
+%%@x
+%%if term_offset+length(name)>max_print_line-2 then print_ln
+%%else if (term_offset>0)or(file_offset>0) then print_char(" ");
+%%print_char("("); incr(open_parens); slow_print(name); update_terminal;
+%%@y
+%%if term_offset+length(full_source_filename_stack[in_open])>max_print_line-2 then print_ln
+%%else if (term_offset>0)or(file_offset>0) then print_char(" ");
+%%print_char("("); incr(open_parens); slow_print(full_source_filename_stack[in_open]); update_terminal;
+%%@z
+
+%% ** 774 ******************************************************************
+
+ @x
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @y
+if (insert_src_special_every_cr and head<>tail) then insert_src_special;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @z
+
+%% ** 799 ******************************************************************
+
+ @x
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @y
+if (insert_src_special_every_cr) then insert_src_special;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @z
+
+%% ** 1034 ******************************************************************
+
+@x
+@<Append character |cur_chr|...@>=
+adjust_space_factor;@/
+@y
+@<Append character |cur_chr|...@>=
+if ((head=tail) and (mode>0)) then begin
+ if (insert_src_special_auto) then append_src_special;
+end;
+adjust_space_factor;@/
+@z
+
+%% ** 1083 ******************************************************************
+
+ @x
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ @y
+ if (insert_src_special_every_vbox) then insert_src_special;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ @z
+
+ @x
+ if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+ @y
+ if (insert_src_special_every_hbox) then insert_src_special;
+ if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+ @z
+
+%% ** 1091 ******************************************************************
+% Disabled, prevents merge with web2c's tex.ch.
+ @x
+ if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+ @y
+ if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ if (insert_src_special_every_par) then insert_src_special;@+
+ end;
+ @z
+
+%% insert source special at par because this is disabled above
+@x
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+@y
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ if (insert_src_special_every_par) then insert_src_special;@+
+ end;
+@z
+
+%% ** 1096 ******************************************************************
+
+ @x fixme: etex conflict
+ else line_break(widow_penalty);
+ @y
+ else begin
+ if (insert_src_special_every_parend) then insert_src_special;
+ line_break(widow_penalty);
+ end;
+ @z
+
+%% ** 1139 ******************************************************************
+
+@x
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+if (insert_src_special_every_math) then insert_src_special;
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+
+%% ** 1145 ******************************************************************
+
+ @x
+if every_display<>null then begin_token_list(every_display,every_display_text);
+ @y
+if (insert_src_special_every_display) then append_src_special;
+if every_display<>null then begin_token_list(every_display,every_display_text);
+ @z
+
+%% ** 1167 ******************************************************************
+
+@x
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@y
+ if (insert_src_special_every_vbox) then insert_src_special;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@z
+
+%% ** 1313 ******************************************************************
+
+@x
+dump_int(par_loc); dump_int(write_loc);@/
+@y
+dump_int(par_loc); dump_int(write_loc); dump_int(special_loc);@/
+@z
+
+%% ** 1314 ******************************************************************
+
+@x
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+@y
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+undump(hash_base)(frozen_control_sequence)(special_loc);
+special_token:=cs_token_flag+special_loc;@/
+@z
+
+@x
+ line_stack:=xmalloc_array (integer, max_in_open);
+@y
+ line_stack:=xmalloc_array (integer, max_in_open);
+ source_filename_stack:=xmalloc_array (str_number, max_in_open);
+ full_source_filename_stack:=xmalloc_array (str_number, max_in_open);
+@z
+
+%% ** 1344 ******************************************************************
+
+@x
+primitive("special",extension,special_node);@/
+@y
+primitive("special",extension,special_node);@/
+special_loc:=cur_val; special_token:=cs_token_flag+special_loc;@/
+@z
+
+%% ** 1379 ******************************************************************
+
+@x
+@* \[55] Index.
+@y
+
+@ @<Declare action procedures for use by |main_control|@>=
+
+procedure insert_src_special;
+var toklist, p, q : pointer;
+begin
+ if (source_filename_stack[in_open] > 0 and is_new_source (source_filename_stack[in_open], line)) then begin
+ toklist := get_avail;
+ p := toklist;
+ info(p) := special_token;
+ link(p) := get_avail; p := link(p);
+ info(p) := left_brace_token+"{";
+ q := str_toks (make_src_special (source_filename_stack[in_open], line));
+ link(p) := link(temp_head);
+ p := q;
+ link(p) := get_avail; p := link(p);
+ info(p) := right_brace_token+"}";
+ ins_list (toklist);
+ remember_source_info (source_filename_stack[in_open], line);
+ end;
+end;
+
+procedure append_src_special;
+var p, q : pointer;
+begin
+ if (source_filename_stack[in_open] > 0 and is_new_source (source_filename_stack[in_open], line)) then begin
+ new_whatsit (special_node, write_node_size);
+ write_stream(tail) := null;
+ def_ref := get_avail;
+ token_ref_count(def_ref) := null;
+ q := str_toks (make_src_special (source_filename_stack[in_open], line));
+ link(def_ref) := link(temp_head);
+ write_tokens(tail) := def_ref;
+ remember_source_info (source_filename_stack[in_open], line);
+ end;
+end;
+
+@* \[55] Index.
+@z
+
diff --git a/Build/source/texk/web2c/alephdir/comstr.ch b/Build/source/texk/web2c/alephdir/comstr.ch
new file mode 100644
index 00000000000..636874bd68d
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comstr.ch
@@ -0,0 +1,20 @@
+% comstr.ch: Local adaptations for file omstr.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/alephdir/comtrans.ch b/Build/source/texk/web2c/alephdir/comtrans.ch
new file mode 100644
index 00000000000..e954fd14fd5
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comtrans.ch
@@ -0,0 +1,20 @@
+% comtrans.ch: Local adaptations for file omtrans.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/alephdir/comw32.ch b/Build/source/texk/web2c/alephdir/comw32.ch
new file mode 100644
index 00000000000..12afcb2d09e
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/comw32.ch
@@ -0,0 +1,77 @@
+@x
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@y
+@!file_line_error_style_p:boolean; {format error messages as file:line:error}
+@!halt_on_error_p:boolean; {stop at first error.}
+@!quoted_filename : boolean;
+@z
+
+@x l:1927
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+@y
+ ready_already:=0;
+ texmf_finish_job;
+ if (history <> spotless) and (history <> warning_issued) then
+@z
+
+@x l:10101
+begin area_delimiter:=0; ext_delimiter:=0;
+@y
+begin area_delimiter:=0; ext_delimiter:=0;
+quoted_filename:=false;
+@z
+
+@x l:10111
+begin if c=" " then more_name:=false
+else begin str_room(1); append_char(c); {contribute |c| to the current string}
+@y
+begin
+if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+end;
+if (c=" ") and (not quoted_filename) then more_name:=false
+else begin
+ if (c="*") then c:=" "
+ else if (c="?") then c:="~";
+ str_room(1); append_char(c); {contribute |c| to the current string}
+@z
+
+@x l:10175
+begin slow_print(a); slow_print(n); slow_print(e);
+@y
+begin texmf_print_filename (a, n, e);
+@z
+
+@x l:10184
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+@x l:13060
+ print_nl("Output written on "); slow_print(output_file_name);
+@y
+ print_nl("Output written on "); texmf_print_filename(0, output_file_name, 0);
+@z
+
+@x
+begin @!{|start_here|}
+@y
+begin @!{|start_here|}
+
+ texmf_start_job;
+@z
+
+@x l:24891
+ slow_print(log_name); print_char(".");
+ end;
+@y
+ texmf_print_filename(0, log_name, 0); print_char(".");
+ end;
+@z
diff --git a/Build/source/texk/web2c/alephdir/eo16bit-rc1.ch b/Build/source/texk/web2c/alephdir/eo16bit-rc1.ch
new file mode 100644
index 00000000000..87872aa2d3e
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eo16bit-rc1.ch
@@ -0,0 +1,696 @@
+% This is an \Aleph change file; it brings \eTeX register numbers
+% from 32767 ($2^{15}-1$) to 65535 ($2^{16}-1), to bring it on line
+% with \Omega
+% Noticeably, since Omega has 16-bit quarterwords, it is possible
+% to do so without changing much.
+% Notice that we do this for marks register: everything else is
+% brought to level with Omega in eomem.ch
+%----------------------------------------
+@x Section 53a onwards l.4600
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+@y
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=65535;
+max_reg_help_line:="A register number must be between 0 and 65535.";
+@z
+%----------------------------------------
+@x l.4607
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+@y
+@ There is one doubly linked tree, to handle the sparse array of the up
+to 65535 additional mark classes.
+The root of the tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains eight bits (two
+hexadecimal digits) of the mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (which is always |mark_val|). The |sa_used| field in the
+index nodes counts how many of the 16 pointers are non-null.
+@z
+%----------------------------------------
+@x l.4630
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@y
+The |sa_index| field in the nodes for array elements contains the eight
+bits plus 256 times the type. The type field is actually ignored,
+since we only use this hoop-jumpings for marks registers (the code
+will probably get a rewrite to get in line with the rest of the
+(e-)Omega stuf, anyway, so \dots)
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==7 {the additional box registers}
+@d mark_val=8 {the additional mark classes}
+@z
+%----------------------------------------
+@x
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+@y
+@ The root of the tree for the additional mark classes is kept
+in |sa_mark|.
+
+@<Glob...@>=
+@!sa_mark:pointer; {pointer to sparse array of marks}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+@z
+%----------------------------------------
+@x l.4681
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then set_equiv(box_base+cur_val,#)@+else set_sa_box(#)
+@#
+
+{ FIXME: needs debugging (sparse arrays) }
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@y
+@ Given a type |t| (which is always |mark_val|) and a sixteen-bit number |n|,
+the |find_sa_element| procedure returns (in |cur_ptr|) a pointer to the node
+for the corresponding array element, or |null| when no such element exists.
+The third parameter |w| is set |true| if the element must exist, e.g., because
+it is about to be modified. The procedure has two main branches: one follows
+the existing tree structure, the other (only used when |w| is |true|) creates
+the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+{FIXME: needs debugging}
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin
+begin if t<>mark_val then begin
+ cur_ptr:=null;
+ return;
+end; end;
+cur_ptr:=sa_mark;
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_mark:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ FIXME OBSOLETE The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number.
+
+@ Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 256) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+{FIXME: will be removed}
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+{FIXME: will be removed}
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<number_regs then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end;
+{
+|else begin if t<=dimen_val then| {a count or dimen register}
+| begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;|
+| sa_num(cur_ptr):=n;|
+| end|
+| else begin cur_ptr:=get_node(pointer_node_size);|
+| if t<=mu_val then| {a skip or muskip register}
+| begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);|
+| end|
+| else sa_ptr(cur_ptr):=null; |{a box or token list register}
+| end;|
+| sa_ref(cur_ptr):=null;| {all registers have a reference count}
+| end;|
+}
+sa_index(cur_ptr):=256*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ set_equiv(box_base+cur_val,#)
+@#
+
+{FIXME: will be removed}
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if false then {was |if sa_index(q)<dimen_val_limit then|}
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if false then {was |sa_index(q)<mu_val_limit then|}
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin
+ sa_mark:=null {was |sa_root[i]:=null|}; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if false {was |sa_index(q)<dimen_val_limit|} then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+{
+|if p=null then print_char("?")| {this can't happen}
+|else begin t:=sa_type(p);|
+| if t<box_val then print_cmd_chr(register,p)|
+| else if t=box_val then|
+| begin print_esc("box"); print_sa_num(p);|
+| end|
+| else if t=tok_val then print_cmd_chr(toks_register,p)|
+| else print_char("?");| {this can't happen either}
+| print_char("=");|
+| if t=int_val then print_int(sa_int(p))|
+| else if t=dimen_val then|
+| begin print_scaled(sa_dim(p)); print("pt");|
+| end|
+| else begin p:=sa_ptr(p);|
+| if t=glue_val then print_spec(p,"pt")|
+| else if t=mu_val then print_spec(p,"mu")|
+| else if t=box_val then|
+| if p=null then print("void")|
+| else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);|
+| end|
+| else if t=tok_val then|
+| begin if p<>null then show_token_list(link(p),null,32);|
+| end|
+| else print_char("?");| {this can't happen either}
+| end;|
+| end;|
+}
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@z
+%----------------------------------------
+% TODO: l.5029+: will the simply be removed?
+% (i.e.: cases which cannot happen (anymore)?)
+%----------------------------------------
+@x
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+@y
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if false {was |i<dimen_val_limit|} then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=i {was |i:=tok_val_limit|};
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if false {was |sa_index(p)<mu_val_limit|} then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if false {was |sa_index(p)<box_val_limit|} then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+@z
+%----------------------------------------
+@x
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@y
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin {|if sa_index(p)>=dimen_val_limit then|} sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if false {was |sa_index(p)<dimen_val_limit|} then
+ if false {was |sa_index(sa_chain)<dimen_val_limit|} then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if false {was |sa_index(p)<dimen_val_limit|} then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@z
diff --git a/Build/source/texk/web2c/alephdir/eo16bit-rc2.ch b/Build/source/texk/web2c/alephdir/eo16bit-rc2.ch
new file mode 100644
index 00000000000..87872aa2d3e
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eo16bit-rc2.ch
@@ -0,0 +1,696 @@
+% This is an \Aleph change file; it brings \eTeX register numbers
+% from 32767 ($2^{15}-1$) to 65535 ($2^{16}-1), to bring it on line
+% with \Omega
+% Noticeably, since Omega has 16-bit quarterwords, it is possible
+% to do so without changing much.
+% Notice that we do this for marks register: everything else is
+% brought to level with Omega in eomem.ch
+%----------------------------------------
+@x Section 53a onwards l.4600
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+@y
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=65535;
+max_reg_help_line:="A register number must be between 0 and 65535.";
+@z
+%----------------------------------------
+@x l.4607
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+@y
+@ There is one doubly linked tree, to handle the sparse array of the up
+to 65535 additional mark classes.
+The root of the tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains eight bits (two
+hexadecimal digits) of the mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (which is always |mark_val|). The |sa_used| field in the
+index nodes counts how many of the 16 pointers are non-null.
+@z
+%----------------------------------------
+@x l.4630
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@y
+The |sa_index| field in the nodes for array elements contains the eight
+bits plus 256 times the type. The type field is actually ignored,
+since we only use this hoop-jumpings for marks registers (the code
+will probably get a rewrite to get in line with the rest of the
+(e-)Omega stuf, anyway, so \dots)
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==7 {the additional box registers}
+@d mark_val=8 {the additional mark classes}
+@z
+%----------------------------------------
+@x
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+@y
+@ The root of the tree for the additional mark classes is kept
+in |sa_mark|.
+
+@<Glob...@>=
+@!sa_mark:pointer; {pointer to sparse array of marks}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+@z
+%----------------------------------------
+@x l.4681
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then set_equiv(box_base+cur_val,#)@+else set_sa_box(#)
+@#
+
+{ FIXME: needs debugging (sparse arrays) }
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@y
+@ Given a type |t| (which is always |mark_val|) and a sixteen-bit number |n|,
+the |find_sa_element| procedure returns (in |cur_ptr|) a pointer to the node
+for the corresponding array element, or |null| when no such element exists.
+The third parameter |w| is set |true| if the element must exist, e.g., because
+it is about to be modified. The procedure has two main branches: one follows
+the existing tree structure, the other (only used when |w| is |true|) creates
+the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+{FIXME: needs debugging}
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin
+begin if t<>mark_val then begin
+ cur_ptr:=null;
+ return;
+end; end;
+cur_ptr:=sa_mark;
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_mark:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ FIXME OBSOLETE The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number.
+
+@ Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 256) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+{FIXME: will be removed}
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+{FIXME: will be removed}
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<number_regs then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end;
+{
+|else begin if t<=dimen_val then| {a count or dimen register}
+| begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;|
+| sa_num(cur_ptr):=n;|
+| end|
+| else begin cur_ptr:=get_node(pointer_node_size);|
+| if t<=mu_val then| {a skip or muskip register}
+| begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);|
+| end|
+| else sa_ptr(cur_ptr):=null; |{a box or token list register}
+| end;|
+| sa_ref(cur_ptr):=null;| {all registers have a reference count}
+| end;|
+}
+sa_index(cur_ptr):=256*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ set_equiv(box_base+cur_val,#)
+@#
+
+{FIXME: will be removed}
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if false then {was |if sa_index(q)<dimen_val_limit then|}
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if false then {was |sa_index(q)<mu_val_limit then|}
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin
+ sa_mark:=null {was |sa_root[i]:=null|}; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if false {was |sa_index(q)<dimen_val_limit|} then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+{
+|if p=null then print_char("?")| {this can't happen}
+|else begin t:=sa_type(p);|
+| if t<box_val then print_cmd_chr(register,p)|
+| else if t=box_val then|
+| begin print_esc("box"); print_sa_num(p);|
+| end|
+| else if t=tok_val then print_cmd_chr(toks_register,p)|
+| else print_char("?");| {this can't happen either}
+| print_char("=");|
+| if t=int_val then print_int(sa_int(p))|
+| else if t=dimen_val then|
+| begin print_scaled(sa_dim(p)); print("pt");|
+| end|
+| else begin p:=sa_ptr(p);|
+| if t=glue_val then print_spec(p,"pt")|
+| else if t=mu_val then print_spec(p,"mu")|
+| else if t=box_val then|
+| if p=null then print("void")|
+| else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);|
+| end|
+| else if t=tok_val then|
+| begin if p<>null then show_token_list(link(p),null,32);|
+| end|
+| else print_char("?");| {this can't happen either}
+| end;|
+| end;|
+}
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@z
+%----------------------------------------
+% TODO: l.5029+: will the simply be removed?
+% (i.e.: cases which cannot happen (anymore)?)
+%----------------------------------------
+@x
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+@y
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if false {was |i<dimen_val_limit|} then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=i {was |i:=tok_val_limit|};
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if false {was |sa_index(p)<mu_val_limit|} then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if false {was |sa_index(p)<box_val_limit|} then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+@z
+%----------------------------------------
+@x
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@y
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin {|if sa_index(p)>=dimen_val_limit then|} sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if false {was |sa_index(p)<dimen_val_limit|} then
+ if false {was |sa_index(sa_chain)<dimen_val_limit|} then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if false {was |sa_index(p)<dimen_val_limit|} then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@z
diff --git a/Build/source/texk/web2c/alephdir/eo16bit-rc3.ch b/Build/source/texk/web2c/alephdir/eo16bit-rc3.ch
new file mode 100644
index 00000000000..dcd5c3c3905
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eo16bit-rc3.ch
@@ -0,0 +1,759 @@
+% This is an \Aleph change file; it brings \eTeX register numbers
+% from 32767 ($2^{15}-1$) to 65535 ($2^{16}-1), to bring it on line
+% with \Omega
+% Noticeably, since Omega has 16-bit quarterwords, it is possible
+% to do so without changing much.
+% Notice that we do this for marks register: everything else is
+% brought to level with Omega in eomem.ch
+%----------------------------------------
+@x Section 53a onwards l.4600
+@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
+dimen, skip, muskip, box, and token registers. As in \TeX\ the first
+256 registers of each kind are realized as arrays in the table of
+equivalents; the additional registers are realized as tree structures
+built from variable-size nodes with individual registers existing only
+when needed. Default values are used for nonexistent registers: zero
+for count and dimen values, |zero_glue| for glue (skip and muskip)
+values, void for boxes, and |null| for token lists (and current marks
+discussed below).
+
+Similarly there are 32768 mark classes; the command \.{\\marks}|n|
+creates a mark node for a given mark class |0<=n<=32767| (where
+\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
+the |fire_up| routine) and the |vsplit| routine maintain the current
+values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
+|split_bot_mark| for each mark class. They are accessed as
+\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
+\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
+are realized as |cur_mark| array. The additional current marks are
+again realized as tree structure with individual mark classes existing
+only when needed.
+
+@<Generate all \eTeX...@>=
+primitive("marks",mark,marks_code);
+@!@:marks_}{\.{\\marks} primitive@>
+primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
+@!@:top_marks_}{\.{\\topmarks} primitive@>
+primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
+@!@:first_marks_}{\.{\\firstmarks} primitive@>
+primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
+@!@:bot_marks_}{\.{\\botmarks} primitive@>
+primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
+@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
+primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
+@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
+
+@ The |scan_register_num| procedure scans a register number that must
+not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?scan_register_num; forward;@t\2@>
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>max_reg_num) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2(max_reg_help_line)("I changed this one to zero.");
+ int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Initialize variables for \eTeX\ comp...@>=
+max_reg_num:=255;
+max_reg_help_line:="A register number must be between 0 and 255.";
+
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+@y
+@ \eOmega\ (in extended mode) supports 65536 (i.e., $2^{16}$) count,
+dimen, skip, muskip, box, and token registers. They are
+implemented as in \TeX.
+
+There are 32768 mark classes; the command \.{\\marks}|n|
+creates a mark node for a given mark class |0<=n<=32767| (where
+\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
+the |fire_up| routine) and the |vsplit| routine maintain the current
+values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
+|split_bot_mark| for each mark class. They are accessed as
+\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
+\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
+are realized as |cur_mark| array. The additional current marks are
+again realized as tree structure with individual mark classes existing
+only when needed.
+
+@<Generate all \eTeX...@>=
+primitive("marks",mark,marks_code);
+@!@:marks_}{\.{\\marks} primitive@>
+primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
+@!@:top_marks_}{\.{\\topmarks} primitive@>
+primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
+@!@:first_marks_}{\.{\\firstmarks} primitive@>
+primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
+@!@:bot_marks_}{\.{\\botmarks} primitive@>
+primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
+@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
+primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
+@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
+
+@ The |scan_register_num| procedure scans a (token) register number.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?scan_register_num; forward;@t\2@>
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>max_reg_num) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2(max_reg_help_line)("I changed this one to zero.");
+ int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Initialize variables for \eTeX\ comp...@>=
+max_reg_num:=255;
+max_reg_help_line:="A register number must be between 0 and 255.";
+
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32727.";
+@z
+%----------------------------------------
+@x l.4607
+@ @<Glob...@>=
+@!max_reg_num: halfword; {largest allowed register number}
+@!max_reg_help_line: str_number; {first line of help message}
+
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+@y
+@ @<Glob...@>=
+@!max_reg_num: halfword; {largest allowed register number}
+@!max_reg_help_line: str_number; {first line of help message}
+
+@ There is one doubly linked tree, to handle the sparse array of the up
+to 32727 additional mark classes.
+The root of the tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains eight bits (two
+hexadecimal digits) of the mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (which is always |mark_val|). The |sa_used| field in the
+index nodes counts how many of the 16 pointers are non-null.
+@z
+%----------------------------------------
+@x l.4630
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@y
+The |sa_index| field in the nodes for array elements contains the eight
+bits plus 256 times the type. The type field is actually ignored,
+since we only use this hoop-jumpings for marks registers (the code
+will probably get a rewrite to get in line with the rest of the
+(e-)Omega stuf, anyway, so \dots)
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d mark_val=7 {the additional mark classes}
+@z
+%----------------------------------------
+@x
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+@y
+@ The root of the tree for the additional mark classes is kept
+in |sa_mark|.
+
+@<Glob...@>=
+@!sa_mark:pointer; {pointer to sparse array of marks}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+@z
+%----------------------------------------
+@x l.4681
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then set_equiv(box_base+cur_val,#)@+else set_sa_box(#)
+@#
+
+{ FIXME: needs debugging (sparse arrays) }
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@y
+@ Given a type |t| (which is always |mark_val|) and a sixteen-bit number |n|,
+the |find_sa_element| procedure returns (in |cur_ptr|) a pointer to the node
+for the corresponding array element, or |null| when no such element exists.
+The third parameter |w| is set |true| if the element must exist, e.g., because
+it is about to be modified. The procedure has two main branches: one follows
+the existing tree structure, the other (only used when |w| is |true|) creates
+the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+{FIXME: needs debugging}
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin
+if t<>mark_val then begin
+ confusion("sparse arrays, finding")
+ cur_ptr:=null;
+ return;
+end;
+cur_ptr:=sa_mark;
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_mark:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 256) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+
+@<Create a new array element...@>=
+{|if t=mark_val then|} {a mark class} {check not needed}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end;
+{|else begin|}
+{| confusion("sparse arrays, creating");|}
+{|end|}
+sa_index(cur_ptr):=256*t+i; sa_lev(cur_ptr):=level_one
+
+@z
+%----------------------------------------
+% TODO: l.5029+: will the simply be removed?
+% (i.e.: cases which cannot happen (anymore)?)
+%----------------------------------------
+@x l.5078
+@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
+etc., as well as for references to sparse array elements defined by
+`\.{\\countdef}', etc.
+
+@<Cases of |register| for |print_cmd_chr|@>=
+begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
+ cmd:=sa_type(chr_code)
+else begin cmd:=chr_code-mem_bot; chr_code:=null;
+ end;
+if cmd=int_val then print_esc("count")
+else if cmd=dimen_val then print_esc("dimen")
+else if cmd=glue_val then print_esc("skip")
+else print_esc("muskip");
+if chr_code<>null then print_sa_num(chr_code);
+end
+
+@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
+well as for references to sparse array elements defined by
+`\.{\\toksdef}'.
+
+@<Cases of |toks_register| for |print_cmd_chr|@>=
+begin print_esc("toks");
+if chr_code<>mem_bot then print_sa_num(chr_code);
+end
+
+@ When a shorthand definition for an element of one of the sparse arrays
+is destroyed, we must reduce the reference count.
+
+@<Cases for |eq_destroy|@>=
+toks_register,register:
+ if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
+ delete_sa_ref(equiv_field(w));
+
+@ The task to maintain (change, save, and restore) register values is
+essentially the same when the register is realized as sparse array
+element or entry in |eqtb|. The global variable |sa_chain| is the head
+of a linked list of entries saved at the topmost level |sa_level|; the
+lists for lowel levels are kept in special save stack entries.
+
+@<Glob...@>=
+@!sa_chain: pointer; {chain of saved sparse array entries}
+@!sa_level: quarterword; {group level for |sa_chain|}
+
+@ @<Set init...@>=
+sa_chain:=null; sa_level:=level_zero;
+
+@ The individual saved items are kept in pointer or word nodes similar
+to those used for the array elements: a word node with value zero is,
+however, saved as pointer node with the otherwise impossible |sa_index|
+value |tok_val_limit|.
+
+@d sa_loc==sa_ref {location of saved item}
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+
+@ The procedure |sa_def| assigns a new value to sparse array elements,
+and saves the former value if appropriate. This procedure is used only
+for skip, muskip, box, and token list registers. The counterpart of
+|sa_def| for count and dimen registers is called |sa_w_def|.
+
+@d sa_define(#)==if e then
+ if global then gsa_def(#)@+else sa_def(#)
+ else define
+@#
+@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
+ begin find_sa_element(box_val,cur_val,true);
+ if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
+ end
+@#
+@d sa_word_define(#)==if e then
+ if global then gsa_w_def(#)@+else sa_w_def(#)
+ else word_define(#)
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_def(@!p:pointer;@!e:halfword);
+ {new data for sparse array elements}
+begin add_sa_ref(p);
+if sa_ptr(p)=e then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ sa_destroy(p);
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
+ sa_lev(p):=cur_level; sa_ptr(p):=e;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+@#
+procedure sa_w_def(@!p:pointer;@!w:integer);
+begin add_sa_ref(p);
+if sa_int(p)=w then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)<>cur_level then sa_save(p);
+ sa_lev(p):=cur_level; sa_int(p):=w;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+
+@ The |sa_def| and |sa_w_def| routines take care of local definitions.
+@^global definitions@>
+Global definitions are done in almost the same way, but there is no need
+to save old values, and the new value is associated with |level_one|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+@#
+procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_lev(p):=level_one; sa_int(p):=w;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+
+@ The |sa_restore| procedure restores the sparse array entries pointed
+at by |sa_chain|
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@y
+@ @<Cases of |register| for |print_cmd_chr|@>=
+begin cmd:=chr_code-mem_bot;
+if cmd=int_val then print_esc("count")
+else if cmd=dimen_val then print_esc("dimen")
+else if cmd=glue_val then print_esc("skip")
+else print_esc("muskip");
+end
+
+@ @<Cases of |toks_register| for |print_cmd_chr|@>=
+print_esc("toks")
+
+@ @<Cases for |eq_destroy|@>=
+{empty section}
+
+@z
diff --git a/Build/source/texk/web2c/alephdir/eobase.ch b/Build/source/texk/web2c/alephdir/eobase.ch
new file mode 100644
index 00000000000..4f39aeca005
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eobase.ch
@@ -0,0 +1,5548 @@
+% vim: ft=change
+% TODO: sparse arrays
+% This is the first of the set of
+% WEB change file containing code for various features extending Omega;
+% these files define the Aleph program, and are designed to be applied
+% to omega.web (Version 3.141592--1.15) compiled without XML support.
+% This change-file is heavily based on etex.ch,
+% defining version 2.1 of e-TeX.
+
+% ATTENTION: The software is currently in pre-alpha stage.
+
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+% e-TeX and NTS are trademarks of the NTS group.
+
+% All line numbers refer to TEX.WEB 3.14159 as of March 21, 1995.
+% TODO: double line number reference, having them for both TEX.WEB
+% and (X)OMEGA.WEB
+
+@x limbo l.1 - this is Aleph
+% (C) 1994--2000 by John Plaice and Yannis Haralambous.
+@y
+% (C) 2002--2004 by Giuseppe Bilotta and the Aleph task force;
+% all rights are reserved.
+%
+% Aleph is directly derived from e-TeX, an extension of
+% Donald E. Knuth's TeX developed by Peter Breitenlohner and
+% the NTS team, and Omega, another extension of TeX, developed by
+% John Plaice and Yannis Haralambous.
+
+% Aleph is designed in the form of a set of WEB changefiles
+% to be applied to Omega (version 3.141592--1.15)
+% compiled without XML support. The changefiles are heavily based
+% on the e-TeX 2.1 changefiles.
+
+% Omega is copyright (C) 1994--2000 by John Plaice and Yannis Haralambous.
+@z
+%---------------------------------------
+@x limbo l.1 - this is e-TeX
+%
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+% Copying of this file is authorized only if (1) you are D. E. Knuth, or if
+% (2) you make absolutely no changes to your copy. (The WEB system provides
+% for alterations via an auxiliary file; the master file should stay intact.)
+% See Appendix H of the WEB manual for hints on how to install this program.
+% And see Appendix A of the TRIP manual for details about how to validate it.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+@y
+
+% e-TeX is copyright (C) 1994,98 by the NTS team; all rights are reserved.
+
+% e-TeX and NTS are trademarks of the NTS group.
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+
+% e-TeX is directly derived from Donald E. Knuth's TeX;
+% the change history which follows and the reward offered for finders of
+% bugs refer specifically to TeX; they should not be taken as referring
+% to e-TeX, although the change history is relevant in that it
+% demonstrates the evolutionary path followed. This program is not TeX;
+% that name is reserved strictly for the program which is the creation
+% and sole responsibility of Professor Knuth.
+@z
+%---------------------------------------
+@x limbo l.50 - e-TeX history
+% Although considerable effort has been expended to make the TeX program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the author hopes that users enjoy it.
+@y
+% A preliminary version of TeX--XeT was released in April 1992.
+% TeX--XeT version 1.0 was released in June 1992,
+% version 1.1 prevented arith overflow in glue computation (Oct 1992).
+% A preliminary e-TeX version 0.95 was operational in March 1994.
+% Version 1.0beta was released in May 1995.
+% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995).
+% Version 1.02beta allowed 256 mark classes (March 1996).
+% Version 1.1 changed \group{type,level} -> \currentgroup{type,level},
+% first public release (October 1996).
+% Version 2.0 development was started in March 1997;
+% fixed a ligature-\beginR bug in January 1998;
+% was released in March 1998.
+% Version 2.1 fixed a marks bug (when min_halfword<>0) (January 1999).
+
+% Aleph includes all the e-TeX extensions, except for TeX--XeT and
+% some optimizations.
+
+% Release Candidate 0 was released in Janurary 2003.
+% Release Candidate 1 was released in June 2003.
+% fixed Omega overfull box bug
+% Release Candidate 2 has to be released
+% fixed Omega overfull rule bug
+% fixed Omega leader tripping bug
+% reorganized source code
+
+% Although considerable effort has been expended to make the Aleph program
+% correct and reliable, no warranty is implied; the authors disclaim any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the authors hope that users enjoy it.
+@z
+%---------------------------------------
+@x limbo l.61 - e-TeX logo, TeXXeT
+\let\mc=\ninerm % medium caps for names like SAIL
+@y
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\eTeX{$\varepsilon$-\TeX}
+\def\Aleph{$\aleph$}
+% \font\revrm=xbmc10 % for right-to-left text
+% % to generate xbmc10 (i.e., reflected cmbx10) use a file
+% % xbmc10.mf containing:
+% %+++++++++++++++++++++++++++++++++++++++++++++++++
+% % if unknown cmbase: input cmbase fi
+% % extra_endchar := extra_endchar &
+% % "currentpicture:=currentpicture " &
+% % "reflectedabout((.5[l,r],0),(.5[l,r],1));";
+% % input cmbx10
+% %+++++++++++++++++++++++++++++++++++++++++++++++++
+% \ifx\beginL\undefined % this is TeX
+ \def\XeT{X\kern-.125em\lower.5ex\hbox{E}\kern-.1667emT}
+ \def\TeXeT{\TeX-\hbox{\revrm \XeT}} % for TeX-XeT
+ \def\TeXXeT{\TeX-\hbox{\revrm -\XeT}} % for TeX--XeT
+% \else
+% \ifx\eTeXversion\undefined % this is \TeXeT
+% \def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT
+% \def\TeXXeT{\TeX-{\revrm\beginR\TeX-\endR}} % for TeX--XeT
+% \else % this is \eTeX
+% \def\TeXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX\endR}} % for TeX-XeT
+% \def\TeXXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX-\endR}} % for TeX--XeT
+% \fi
+% \fi
+@z
+%---------------------------------------
+@x limbo l.64 - bug fix (print only changed modules)
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+@y
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\def\grp{\.{\char'173...\char'175}}
+@z
+%---------------------------------------
+@x limbo l.80 - e-TeX basic
+\def\title{$\Omega$ (OMEGA)}
+@y
+\def\title{\Aleph\ (ALEPH)}
+% system dependent redefinitions of \title should come later
+% and should use:
+% \toks0=\expandafter{\title}
+% \edef\title{...\the\toks0...}
+\let\maybe=\iffalse % print only changed modules
+\let\maybe=\iftrue % print everything
+@z
+%---------------------------------------
+@x [1] m.1 l.91 - this is e-TeX
+This is $\Omega$, a document compiler intended to simplify high-quality
+@y
+This is \Aleph, an extension of $\Omega$. $\Omega$ is a document compiler
+intended to simplify high-quality
+@z
+%---------------------------------------
+@x [1] m.2 l.179 - e-TeX basic
+If this program is changed, the resulting system should not be called
+@y
+This program contains code from both the $\Omega$ (developed by
+John Plaice and Yannis Haralambous) and \eTeX\
+(developed by Peter Breitenlohner and the NTS team) extensions
+to \TeX, therefore this program is called `\Aleph' and not
+@z
+%---------------------------------------
+@x [1] m.2 l.185 - e-TeX basic
+November 1984].
+@y
+November 1984].
+
+A similar test suite called the ``\.{e-BUMP} test'' is (or will be made)
+available for helping to determine whether a particular implementation deserves
+to be known as `\Aleph'.
+@z
+%---------------------------------------
+@x [1] m.2 l.187 - e-TeX basic
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@y
+@d banner=='This is Aleph, Version 3.141592--1.15--2.1' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.141592--1.15--2.1' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@#
+@d eTeX_banner=='This is Aleph, Version ',eTeX_version_string
+ {printed when \eTeX\ starts}
+@#
+@d OMEGA==ALEPH {change program name into |ALEPH|}
+@#
+@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|}
+@z
+%---------------------------------------
+@x [1] m.15 l.493 - e-TeX basic
+@d not_found=45 {go here when you've found nothing}
+@y
+@d not_found=45 {go here when you've found nothing}
+@d not_found1=46 {like |not_found|, when there's more than one}
+@d not_found2=47 {like |not_found|, when there's more than two}
+@d not_found3=48 {like |not_found|, when there's more than three}
+@d not_found4=49 {like |not_found|, when there's more than four}
+@z
+%---------------------------------------
+@x [5] m.61 l.1556 - e-TeX basic
+wterm(banner);
+@y
+wterm(eTeX_banner);
+@z
+%---------------------------------------
+@x [10] m.141 l.2965 - e-TeX marks
+This field occupies a full word instead of a halfword, because
+there's nothing to put in the other halfword; it is easier in \PASCAL\ to
+use the full word than to risk leaving garbage in the unused half.
+@y
+In addition there is a |mark_class| field that contains the mark class.
+@z
+%---------------------------------------
+@x [10] m.141 l.2971 - e-TeX marks
+@d mark_ptr(#)==mem[#+1].int {head of the token list for a mark}
+@y
+@d mark_ptr(#)==link(#+1) {head of the token list for a mark}
+@d mark_class(#)==info(#+1) {the mark class}
+@z
+%---------------------------------------
+@x [10] m.142 l.2980 - e-TeX marks
+@d adjust_ptr==mark_ptr {vertical list to be moved out of horizontal list}
+@y
+@d adjust_ptr(#)==mem[#+1].int
+ {vertical list to be moved out of horizontal list}
+@z
+%---------------------------------------
+% @x [10] m.147 l.3069 - e-TeX TeXXeT
+% the amount of surrounding space inserted by \.{\\mathsurround}.
+% @y
+% the amount of surrounding space inserted by \.{\\mathsurround}.
+%
+% In addition a |math_node| with |subtype>after| and |width=0| will be
+% (ab)used to record a regular |math_node| reinserted after being
+% discarded at a line break or one of the text direction primitives (
+% \.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} ).
+% @z
+%---------------------------------------
+% @x [10] m.147 l.3073 - e-TeX TeXXeT
+% @d after=1 {|subtype| for math node that winds up a formula}
+% @y
+% @d after=1 {|subtype| for math node that winds up a formula}
+% @#
+% @d M_code=2
+% @d begin_M_code=M_code+before {|subtype| for \.{\\beginM} node}
+% @d end_M_code=M_code+after {|subtype| for \.{\\endM} node}
+% @d L_code=4
+% @d begin_L_code=L_code+begin_M_code {|subtype| for \.{\\beginL} node}
+% @d end_L_code=L_code+end_M_code {|subtype| for \.{\\endL} node}
+% @d R_code=L_code+L_code
+% @d begin_R_code=R_code+begin_M_code {|subtype| for \.{\\beginR} node}
+% @d end_R_code=R_code+end_M_code {|subtype| for \.{\\endR} node}
+% @#
+% @d end_LR(#)==odd(subtype(#))
+% @d end_LR_type(#)==(L_code*(subtype(#) div L_code)+end_M_code)
+% @d begin_LR_type(#)==(#-after+before)
+% @z
+%---------------------------------------
+% @x [12] m.175 l.3546 - e-TeX TeXXeT
+% math_node: print_char("$");
+% @y
+% math_node: if subtype(p)>=L_code then print("[]")
+% else print_char("$");
+% @z
+%---------------------------------------
+% @x [12] m.184 l.3713 - e-TeX TeXXeT
+% begin print(", shifted "); print_scaled(shift_amount(p));
+% end;
+% @y
+% begin print(", shifted "); print_scaled(shift_amount(p));
+% end;
+% if eTeX_ex then @<Display if this box is never to be reversed@>;
+% @z
+%---------------------------------------
+% @x [12] m.192 l.3811 - e-TeX TeXXeT
+% begin print_esc("math");
+% @y
+% if subtype(p)>after then
+% begin if end_LR(p) then print_esc("end")
+% else print_esc("begin");
+% if subtype(p)>R_code then print_char("R")
+% else if subtype(p)>L_code then print_char("L")
+% else print_char("M");
+% end else
+% begin print_esc("math");
+% @z
+%---------------------------------------
+@x [12] m.196 l.3844 - e-TeX marks
+begin print_esc("mark"); print_mark(mark_ptr(p));
+@y
+begin print_esc("mark");
+if mark_class(p)<>0 then
+ begin print_char("s"); print_int(mark_class(p));
+ end;
+print_mark(mark_ptr(p));
+@z
+%---------------------------------------
+@x [15] m.208 l.4081 - e-TeX saved_items
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+@y
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+ {( or \.{\\pagediscards}, \.{\\splitdiscards} )}
+@z
+%---------------------------------------
+% @x [15] m.208 l.4091 - e-TeX TeXXeT
+% @d valign=33 {vertical table alignment ( \.{\\valign} )}
+% @y
+% @d valign=33 {vertical table alignment ( \.{\\valign} )}
+% {or text direction directives ( \.{\\beginL}, etc.~)}
+% @z
+%---------------------------------------
+@x [15] m.208 l.4107 - e-TeX middle
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+@y
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+ {( or \.{\\middle} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4151 - e-TeX basic
+ \.{\\insertpenalties} )}
+@y
+ \.{\\insertpenalties} )}
+ {( or \.{\\interactionmode} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4153 - e-TeX penalties
+@d set_shape=set_box_dimen+1
+ {specify fancy paragraph shape ( \.{\\parshape} )}
+@y
+@d set_shape=set_box_dimen+1
+ {specify fancy paragraph shape ( \.{\\parshape} )}
+ {(or \.{\\interlinepenalties}, etc.~)}
+@z
+%---------------------------------------
+@x [15] m.209 l.4163 - e-TeX protected
+@d prefix=divide+1
+ {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@y
+@d prefix=divide+1
+ {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+ {( or \.{\\protected} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4166 - e-TeX read_line
+@d read_to_cs=shorthand_def+1
+ {read into a control sequence ( \.{\\read} )}
+@y
+@d read_to_cs=shorthand_def+1
+ {read into a control sequence ( \.{\\read} )}
+ {( or \.{\\readline} )}
+@z
+%---------------------------------------
+@x [15] m.210 l.4181 - e-TeX scan_tokens
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+@y
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+ {( or \.{\\scantokens} )}
+@z
+%---------------------------------------
+@x [15] m.210 l.4186 - e-TeX unexpanded
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+@y
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+ {( or \.{\\unexpanded}, \.{\\detokenize} )}
+@z
+%---------------------------------------
+@x [16] m.212 l.4289 - e-TeX basic
+user's output routine.
+@y
+user's output routine.
+
+A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX.
+In vertical modes it is known as |LR_save| and holds the LR stack when a
+paragraph is interrupted by a displayed formula. In display math mode
+it is known as |LR_box| and holds a pointer to a prototype box for the
+display. In math mode it is known as |delim_ptr| and points to the most
+recent |left_noad| or |middle_noad| of a |math_left_group|.
+
+In \Aleph it is only used in this last sense.
+@z
+%---------------------------------------
+@x [16] m.212 l.4304 - e-TeX basic
+ @!head_field,@!tail_field: pointer;
+@y
+ @!head_field,@!tail_field: pointer;
+ @!eTeX_aux_field: pointer;
+@z
+%---------------------------------------
+@x [16] m.213 l.4311 - e-TeX basic
+@d tail==cur_list.tail_field {final node on current list}
+@y
+@d tail==cur_list.tail_field {final node on current list}
+@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX}
+@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group}
+@z
+%---------------------------------------
+@x [16] m.215 l.4342 - e-TeX basic
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+@y
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+eTeX_aux:=null;
+@z
+%---------------------------------------
+@x [16] m.216 l.4358 push_nest - e-TeX basic
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+eTeX_aux:=null;
+@z
+%---------------------------------------
+@x [17] m.230 l.4712 - e-TeX basic, penalties
+@d output_routine_loc=local_base+1 {points to token list for \.{\\output}}
+@d every_par_loc=local_base+2 {points to token list for \.{\\everypar}}
+@d every_math_loc=local_base+3 {points to token list for \.{\\everymath}}
+@d every_display_loc=local_base+4 {points to token list for \.{\\everydisplay}}
+@d every_hbox_loc=local_base+5 {points to token list for \.{\\everyhbox}}
+@d every_vbox_loc=local_base+6 {points to token list for \.{\\everyvbox}}
+@d every_job_loc=local_base+7 {points to token list for \.{\\everyjob}}
+@d every_cr_loc=local_base+8 {points to token list for \.{\\everycr}}
+@d err_help_loc=local_base+9 {points to token list for \.{\\errhelp}}
+@d ocp_trace_level_base=local_base+10
+@y
+@d inter_line_penalties_loc=local_base+1 {additional penalties between lines}
+@d club_penalties_loc=local_base+2 {penalties for creating club lines}
+@d widow_penalties_loc=local_base+3 {penalties for creating widow lines}
+@d display_widow_penalties_loc=local_base+4 {ditto, just before a display}
+@d token_base=local_base+5 {table of token list parameters}
+@d output_routine_loc=token_base {points to token list for \.{\\output}}
+@d every_par_loc=token_base+1 {points to token list for \.{\\everypar}}
+@d every_math_loc=token_base+2 {points to token list for \.{\\everymath}}
+@d every_display_loc=token_base+3 {points to token list for \.{\\everydisplay}}
+@d every_hbox_loc=token_base+4 {points to token list for \.{\\everyhbox}}
+@d every_vbox_loc=token_base+5 {points to token list for \.{\\everyvbox}}
+@d every_job_loc=token_base+6 {points to token list for \.{\\everyjob}}
+@d every_cr_loc=token_base+7 {points to token list for \.{\\everycr}}
+@d every_eof_loc=token_base+8 {points to token list for \.{\\everyeof}}
+@d err_help_loc=token_base+9 {points to token list for \.{\\errhelp}}
+@d ocp_trace_level_base=token_base+10
+@z
+%---------------------------------------
+@x [17] m.231 l.4787 - e-TeX basic
+ othercases print_esc("errhelp")
+@y
+ @/@<Cases of |assign_toks| for |print_cmd_chr|@>@/
+ othercases print_esc("errhelp")
+@z
+%---------------------------------------
+% FIXME moved to init_eqtb_entry --see later
+% @x [17] m.232 l.4805 - e-TeX penalties
+% eq_level(par_shape_loc):=level_one;@/
+% @y
+% eq_level(par_shape_loc):=level_one;@/
+% for k:=par_shape_loc+1 to token_base-1 do
+% eqtb[k]:=eqtb[par_shape_loc];
+% @z
+%---------------------------------------
+@x [17] m.233 l.4833 - e-TeX penalties
+if n=par_shape_loc then
+ begin print_esc("parshape"); print_char("=");
+ if par_shape_ptr=null then print_char("0")
+ else print_int(info(par_shape_ptr));
+@y
+if n<token_base then
+ begin print_cmd_chr(set_shape,n); print_char("=");
+ if equiv(n)=null then print_char("0")
+ else if n>par_shape_loc then
+ begin print_int(penalty(equiv(n))); print_char(" ");
+ print_int(penalty(equiv(n)+1));
+ if penalty(equiv(n))>1 then print_esc("ETC.");
+ end
+ else print_int(info(par_shape_ptr));
+@z
+%---------------------------------------
+% FIXME: in this section and in the next
+% we should remove pre_display_direction[_code]
+% stuff, both here and down below
+@x [17] m.236 l.4955 - e-TeX basic
+@d dir_base=int_base+int_pars
+@y
+@d tracing_assigns_code=int_pars {show assignments}
+@d tracing_groups_code=int_pars+1 {show save/restore groups}
+@d tracing_ifs_code=int_pars+2 {show conditionals}
+@d tracing_scan_tokens_code=int_pars+3 {show pseudo file open and close}
+@d tracing_nesting_code=int_pars+4
+ {show incomplete groups and ifs within files}
+@d pre_display_direction_code=int_pars+5 {text direction preceding a display}
+@d last_line_fit_code=int_pars+6 {adjustment for last line of paragraph}
+@d saving_vdiscards_code=int_pars+7 {save items discarded from vlists}
+@d saving_hyph_codes_code=int_pars+8 {save hyphenation codes for languages}
+@d eTeX_state_code=int_pars+9 {\eTeX\ state variables}
+@d dir_base=int_base+eTeX_state_code+eTeX_states
+@z
+%---------------------------------------
+@x [17] m.236 l.5016 - e-TeX basic
+@d error_context_lines==int_par(error_context_lines_code)
+@y
+@d error_context_lines==int_par(error_context_lines_code)
+@d tracing_assigns==int_par(tracing_assigns_code)
+@d tracing_groups==int_par(tracing_groups_code)
+@d tracing_ifs==int_par(tracing_ifs_code)
+@d tracing_scan_tokens==int_par(tracing_scan_tokens_code)
+@d tracing_nesting==int_par(tracing_nesting_code)
+@d pre_display_direction==int_par(pre_display_direction_code)
+@d last_line_fit==int_par(last_line_fit_code)
+@d saving_vdiscards==int_par(saving_vdiscards_code)
+@d saving_hyph_codes==int_par(saving_hyph_codes_code)
+@z
+%---------------------------------------
+@x [17] m.237 l.5081 print_param - e-TeX basic
+othercases print("[unknown integer parameter!]")
+@y
+@/@<Cases for |print_param|@>@/
+othercases print("[unknown integer parameter!]")
+@z
+%---------------------------------------
+% FIXED(?): moved to init_eqtb_entry in
+% omega.web at l.5813
+@x [17] m.232 l.4805 - e-TeX penalties
+ { Region 4 }
+ else if (p>=par_shape_loc) and
+ (p<=toks_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+@y
+ { Region 4 }
+ else if (p>=par_shape_loc) and
+ (p< token_base) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=shape_ref;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=token_base) and
+ (p<=toks_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+@z
+%---------------------------------------
+@x [18] m.264 l.5612 primitive - e-TeX basic
+@!j:small_number; {index into |buffer|}
+@y
+@!j:0..buf_size; {index into |buffer|}
+@z
+%---------------------------------------
+@x [18] m.264 l.5616 primitive - e-TeX basic
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+@y
+ {we will move |s| into the (possibly non-empty) |buffer|}
+ if first+l>buf_size+1 then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
+@z
+%---------------------------------------
+@x [18] m.265 l.5691 - e-TeX penalties
+primitive("parshape",set_shape,0);@/
+@y
+primitive("parshape",set_shape,par_shape_loc);@/
+@z
+%---------------------------------------
+@x [18] m.265 l.5708 - e-TeX sparse arrays
+primitive("toks",toks_register,0);@/
+@y
+primitive("toks",toks_register,mem_bot);@/
+@z
+%---------------------------------------
+@x [18] m.266 l.5741 - e-TeX cond
+expand_after: print_esc("expandafter");
+@y
+expand_after: if chr_code=0 then print_esc("expandafter")
+ @<Cases of |expandafter| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5747 - e-TeX marks
+mark: print_esc("mark");
+@y
+mark: begin print_esc("mark");
+ if chr_code>0 then print_char("s");
+ end;
+@z
+%---------------------------------------
+@x [18] m.266 l.5758 - e-TeX read_line
+read_to_cs: print_esc("read");
+@y
+read_to_cs: if chr_code=0 then print_esc("read")
+ @<Cases of |read| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5762 - e-TeX penalties
+set_shape: print_esc("parshape");
+@y
+set_shape: case chr_code of
+ par_shape_loc: print_esc("parshape");
+ @<Cases of |set_shape| for |print_cmd_chr|@>@;@/
+ end; {there are no other cases}
+@z
+%---------------------------------------
+@x [18] m.266 l.5763 - e-TeX unexpanded
+the: print_esc("the");
+@y
+the: if chr_code=0 then print_esc("the")
+ @<Cases of |the| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5764 - e-TeX sparse arrays
+toks_register: print_esc("toks");
+@y
+toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+% @x [18] m.266 l.5766 - e-TeX TeXXeT
+% valign: print_esc("valign");
+% @y
+% valign: if chr_code=0 then print_esc("valign")@/
+% @<Cases of |valign| for |print_cmd_chr|@>;
+% @z
+%---------------------------------------
+@x [19] m.268 l.5800 - e-TeX sparse arrays
+interpreted in one of four ways:
+@y
+interpreted in one of five ways:
+@z
+%---------------------------------------
+@x [19] m.268 l.5820 - e-TeX tracing
+the entries for that group.
+@y
+the entries for that group.
+Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
+source line number at which the current level of grouping was entered.
+
+\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a
+chain of sparse array entries to be restored at the end of the current
+group. Furthermore |save_index(p)| and |save_level(p)| should replace
+the values of |sa_chain| and |sa_level| respectively.
+@z
+%---------------------------------------
+% FIXME restore_sa safe? (sparse arrays)
+@x [19] m.268 l.5830 - e-TeX basic
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@y
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@d restore_sa=4 {|save_type| when sparse array entries should be restored}
+
+@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
+@z
+%---------------------------------------
+@x [19] m.273 l.5888 - e-TeX tracing
+@ The following macro is used to test if there is room for up to six more
+@y
+@ The following macro is used to test if there is room for up to seven more
+@z
+%---------------------------------------
+@x [19] m.273 l.5894 check_full_save_stack - e-TeX tracing
+ if max_save_stack>save_size-6 then overflow("save size",save_size);
+@y
+ if max_save_stack>save_size-7 then overflow("save size",save_size);
+@z
+%---------------------------------------
+@x [19] m.274 l.5916 new_save_level - e-TeX tracing
+begin check_full_save_stack;
+@y
+begin check_full_save_stack;
+if eTeX_ex then
+ begin saved(0):=line; incr(save_ptr);
+ end;
+@z
+%---------------------------------------
+@x [19] m.274 l.5923 new_save_level - e-TeX tracing
+cur_boundary:=save_ptr; incr(cur_level); incr(save_ptr); cur_group:=c;
+@y
+cur_boundary:=save_ptr; cur_group:=c;
+@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/
+incr(cur_level); incr(save_ptr);
+@z
+%---------------------------------------
+@x [19] m.275 l.5941 eq_destroy - e-TeX sparse arrays
+othercases do_nothing
+@y
+@/@<Cases for |eq_destroy|@>@/
+othercases do_nothing
+@z
+%---------------------------------------
+@x [19] m.277 l.5963 - e-TeX tracing
+the call, since |eq_save| makes the necessary test.
+@y
+the call, since |eq_save| makes the necessary test.
+
+@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#);
+ tats
+@z
+%---------------------------------------
+@x [19] m.277 l.5967 eq_define - e-TeX tracing
+begin if eq_level(p)=cur_level then eq_destroy(new_eqtb(p))
+@y
+label exit;
+begin if eTeX_ex and(eq_type(p)=t)and(equiv(p)=e) then
+ begin assign_trace(p,"reassigning")@;@/
+ eq_destroy(new_eqtb(p)); return;
+ end;
+assign_trace(p,"changing")@;@/
+if eq_level(p)=cur_level then eq_destroy(new_eqtb(p))
+@z
+%---------------------------------------
+@x [19] m.277 l.5970 eq_define - e-TeX tracing
+end;
+@y
+assign_trace(p,"into")@;@/
+exit:end;
+@z
+%---------------------------------------
+@x [19] m.278 l.5977 eq_word_define - e-TeX tracing
+begin if xeq_level(p)<>cur_level then
+@y
+label exit;
+begin if eTeX_ex and(eqtb[p].int=w) then
+ begin assign_trace(p,"reassigning")@;@/
+ return;
+ end;
+assign_trace(p,"changing")@;@/
+if xeq_level(p)<>cur_level then
+@z
+%---------------------------------------
+@x [19] m.278 l.5981 eq_word_define - e-TeX tracing
+end;
+@y
+assign_trace(p,"into")@;@/
+exit:end;
+@z
+%---------------------------------------
+@x [19] m.279 l.5990 geq_define - e-TeX tracing
+begin eq_destroy(new_eqtb(p));
+set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e);
+@y
+begin assign_trace(p,"globally changing")@;@/
+begin eq_destroy(new_eqtb(p));
+set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e);
+end;
+assign_trace(p,"into")@;@/
+@z
+%---------------------------------------
+@x [19] m.279 l.5995 geq_word_define - e-TeX tracing
+begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one);
+@y
+begin assign_trace(p,"globally changing")@;@/
+begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one);
+end;
+assign_trace(p,"into")@;@/
+@z
+%---------------------------------------
+@x [19] m.281 l.6012 - e-TeX tracing
+@p@t\4@>@<Declare the procedure called |restore_trace|@>@;@/
+@y
+@p
+@z
+%---------------------------------------
+@x [19] m.281 l.6019 unsave - e-TeX optimized \aftergroup
+begin if cur_level>level_one then
+@y
+@!a:boolean; {have we already processed an \.{\\aftergroup} ?}
+begin a:=false;
+if cur_level>level_one then
+@z
+%---------------------------------------
+% FIXME restore_sa usage
+@x [19] m.282 l.6033 - e-TeX sparse arrays
+ else begin if save_type(save_ptr)=restore_old_value then
+@y
+ else if save_type(save_ptr)=restore_sa then
+ begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr);
+ end
+ else begin if save_type(save_ptr)=restore_old_value then
+@z
+%---------------------------------------
+@x [19] m.282 l.6041 - e-TeX tracing
+done: cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr)
+@y
+done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/
+if grp_stack[in_open]=cur_boundary then group_warning;
+ {groups possibly not properly nested with files}
+cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr);
+if eTeX_ex then decr(save_ptr)
+@z
+%---------------------------------------
+@x [19] m.284 l.6067 - e-TeX tracing
+@ @<Declare the procedure called |restore_trace|@>=
+@y
+@ @<Declare \eTeX\ procedures for tr...@>=
+@z
+%---------------------------------------
+@x [20] m.289 l.6155 - e-TeX protected
+@d end_match_token=@"E0000 {$2^16\cdot|end_match|$}
+@y
+@d end_match_token=@"E0000 {$2^16\cdot|end_match|$}
+@d protected_token=@"E0001 {$2^16\cdot|end_match|+1$}
+@z
+%---------------------------------------
+@x [20] m.294 l.6280 - e-TeX protected
+end_match: print("->");
+@y
+end_match: if c=0 then print("->");
+@z
+%---------------------------------------
+@x [20] m.296 l.6301 print_meaning - e-TeX marks
+else if cur_cmd=top_bot_mark then
+@y
+else if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then
+@z
+%---------------------------------------
+@x [21] m.298 l.6375 print_cmd_chr - e-TeX protected
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@y
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+var n:integer; {temp variable}
+@z
+%---------------------------------------
+@x [21] m.299 l.6394 show_cur_cmd_chr - e-TeX tracing
+@p procedure show_cur_cmd_chr;
+@y
+@p procedure show_cur_cmd_chr;
+var n:integer; {level of \.{\\if...\\fi} nesting}
+@!l:integer; {line where \.{\\if} started}
+@!p:pointer;
+@z
+%---------------------------------------
+@x [21] m.299 l.6399 show_cur_cmd_chr - e-TeX tracing
+print_cmd_chr(cur_cmd,cur_chr); print_char("}");
+@y
+print_cmd_chr(cur_cmd,cur_chr);
+if tracing_ifs>0 then
+ if cur_cmd>=if_test then if cur_cmd<=fi_or_else then
+ begin print(": ");
+ if cur_cmd=fi_or_else then
+ begin print_cmd_chr(if_test,cur_if); print_char(" ");
+ n:=0; l:=if_line;
+ end
+ else begin n:=1; l:=line;
+ end;
+ p:=cond_ptr;
+ while p<>null do
+ begin incr(n); p:=link(p);
+ end;
+ print("(level "); print_int(n); print_char(")"); print_if_line(l);
+ end;
+print_char("}");
+@z
+%---------------------------------------
+% FIXME: What about \write18 compatibility?
+@x [22] m.303 l.6475 show_context - e-TeX scan_tokens
+the terminal, under control of the procedure |read_toks|.)
+@y
+the terminal, under control of the procedure |read_toks|.)
+Finally |18<=name<=19| indicates that we are reading a pseudo file
+created by the \.{\\scantokens} command.
+@z
+%---------------------------------------
+@x [22] m.307 l.6692 - e-TeX basic
+@d mark_text=14 {|token_type| code for \.{\\topmark}, etc.}
+@d write_text=15 {|token_type| code for \.{\\write}}
+@y
+@d every_eof_text=14 {|token_type| code for \.{\\everyeof}}
+@d mark_text=15 {|token_type| code for \.{\\topmark}, etc.}
+@d write_text=16 {|token_type| code for \.{\\write}}
+@z
+%---------------------------------------
+@x [22] m.311 l.6749 show_context - e-TeX scan_tokens
+ if (name>17) or (base_ptr=0) then bottom_line:=true;
+@y
+ if (name>19) or (base_ptr=0) then bottom_line:=true;
+@z
+%---------------------------------------
+@x [22] m.313 l.6794 - e-TeX scan_tokens
+else begin print_nl("l."); print_int(line);
+@y
+else if index<>in_open then {input from a pseudo file}
+ begin print_nl("l."); print_int(line_stack[index+1]);
+ end
+else begin print_nl("l."); print_int(line);
+@z
+%---------------------------------------
+@x [22] m.314 l.6814 - e-TeX basic
+every_cr_text: print_nl("<everycr> ");
+@y
+every_cr_text: print_nl("<everycr> ");
+every_eof_text: print_nl("<everyeof> ");
+@z
+%---------------------------------------
+@x [23] m.326 l.7009 - e-TeX optimized \aftergroup
+begin t:=cur_tok; cur_tok:=p; back_input; cur_tok:=t;
+@y
+begin t:=cur_tok; cur_tok:=p;
+if a then
+ begin p:=get_avail; info(p):=cur_tok; link(p):=loc; loc:=p; start:=p;
+ if cur_tok<right_brace_limit then
+ if cur_tok<left_brace_limit then decr(align_state)
+ else incr(align_state);
+ end
+else begin back_input; a:=eTeX_ex;
+ end;
+cur_tok:=t;
+@z
+%---------------------------------------
+@x [23] m.328 l.7037 begin_file_reading - e-TeX every_eof, tracing_nesting
+incr(in_open); push_input; index:=in_open;
+@y
+incr(in_open); push_input; index:=in_open;
+eof_seen[index]:=false;
+grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr;
+@z
+%---------------------------------------
+% FIXME: What about \write18 compatibility?
+@x [23] m.329 l.7047 end_file_reading - e-TeX scan_tokens
+if name>17 then a_close(cur_file); {forget it}
+@y
+if (name=18)or(name=19) then pseudo_close else
+if name>17 then a_close(cur_file); {forget it}
+@z
+%---------------------------------------
+@x [23] m.331 l.7066 - e-TeX tracing_nesting
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+@y
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+grp_stack[0]:=0; if_stack[0]:=null;
+@z
+%---------------------------------------
+@x [24] m.362 l.7538 - e-TeX scan_tokens, every_eof
+if not force_eof then
+@y
+if not force_eof then
+ if name<=19 then
+ begin if pseudo_input then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+ end
+ else
+@z
+%---------------------------------------
+@x [24] m.362 l.7541 - e-TeX every_eof
+ else force_eof:=true;
+@y
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+@z
+%---------------------------------------
+@x [24] m.362 l.7544 - e-TeX scan_tokens
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+@y
+ begin if tracing_nesting>0 then
+ if (grp_stack[in_open]<>cur_boundary)or@|
+ (if_stack[in_open]<>cond_ptr) then file_warning;
+ {give warning for some unfinished groups and/or conditionals}
+ if name>=19 then
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ end;
+@z
+%---------------------------------------
+@x [25] m.366 l.7630 - e-TeX basic
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+@y
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/
+@z
+%---------------------------------------
+@x [25] m.366 l.7637 expand - e-TeX cond
+procedure expand;
+@y
+procedure expand;
+label reswitch;
+@z
+%---------------------------------------
+@x [25] m.366 l.7648 expand - e-TeX cond
+if cur_cmd<call then @<Expand a nonmacro@>
+@y
+reswitch:
+if cur_cmd<call then @<Expand a nonmacro@>
+@z
+%---------------------------------------
+@x [25] m.367 l.7659 - e-TeX cond
+expand_after:@<Expand the token after the next token@>;
+@y
+expand_after:if cur_chr=0 then @<Expand the token after the next token@>
+ else @<Negate a boolean conditional and |goto reswitch|@>;
+@z
+%---------------------------------------
+@x [25] m.377 l.7779 - e-TeX scan_tokens
+input: if chr_code=0 then print_esc("input")@+else print_esc("endinput");
+@y
+input: if chr_code=0 then print_esc("input")
+ @/@<Cases of |input| for |print_cmd_chr|@>@/
+ else print_esc("endinput");
+@z
+%---------------------------------------
+@x [25] m.378 l.7782 - e-TeX scan_tokens
+if cur_chr>0 then force_eof:=true
+@y
+if cur_chr=1 then force_eof:=true
+@/@<Cases for |input|@>@/
+@z
+%---------------------------------------
+@x [25] m.382 l.7838 - e-TeX marks
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@y
+@d marks_code==5 {add this for \.{\\topmarks} etc.}
+@#
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@z
+%---------------------------------------
+@x [25] m.385 l.7870 - e-TeX marks
+top_bot_mark: case chr_code of
+@y
+top_bot_mark: begin case (chr_code mod marks_code) of
+@z
+%---------------------------------------
+@x [25] m.385 l.7876 - e-TeX marks
+ endcases;
+@y
+ endcases;
+ if chr_code>=marks_code then print_char("s");
+ end;
+@z
+%---------------------------------------
+@x [25] m.386 l.7882 - e-TeX marks
+begin if cur_mark[cur_chr]<>null then
+ begin_token_list(cur_mark[cur_chr],mark_text);
+@y
+begin t:=cur_chr mod marks_code;
+if cur_chr>=marks_code then scan_register_num@+else cur_val:=0;
+if cur_val=0 then cur_ptr:=cur_mark[t]
+else @<Compute the mark pointer for mark type |t| and class |cur_val|@>;
+if cur_ptr<>null then begin_token_list(cur_ptr,mark_text);
+@z
+%---------------------------------------
+@x [25] m.389 l.7945 macro_call - e-TeX protected
+if info(r)<>end_match_token then
+@y
+if info(r)=protected_token then r:=link(r);
+if info(r)<>end_match_token then
+@z
+%---------------------------------------
+@x [26] m.409 l.8255 - e-TeX basic
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@y
+@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@;
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@z
+%---------------------------------------
+@x [26] m.411 l.8299 - e-TeX sparse arrays
+|glue_val|, or |mu_val|.
+@y
+|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes
+cannot have these values)
+@z
+%---------------------------------------
+@x [26] m.411 l.8302 - e-TeX sparse arrays
+primitive("count",register,int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mu_val);
+@y
+primitive("count",register,mem_bot+int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,mem_bot+dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,mem_bot+glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mem_bot+mu_val);
+@z
+%---------------------------------------
+@x [26] m.412 l.8312 - e-TeX sparse arrays
+register: if chr_code=int_val then print_esc("count")
+ else if chr_code=dimen_val then print_esc("dimen")
+ else if chr_code=glue_val then print_esc("skip")
+ else print_esc("muskip");
+@y
+register: @<Cases of |register| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [26] m.413 l.8328 scan_something_internal - e-TeX basic
+var m:halfword; {|chr_code| part of the operand token}
+@y
+label exit;
+var m:halfword; {|chr_code| part of the operand token}
+@!q:halfword; {general purpose index}
+@!i:four_quarters; {character info}
+@z
+%---------------------------------------
+@x [26] m.413 l.8354 scan_something_internal - e-TeX basic
+end;
+@y
+exit:end;
+@z
+%---------------------------------------
+@x [26] m.415 l.8375 - e-TeX sparse arrays
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+@y
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else cur_val:=equiv(m);
+ cur_val_level:=tok_val;
+@z
+%---------------------------------------
+@x [26] m.416 l.8390 - e-TeX basic
+|glue_val|, |input_line_no_code|, or |badness_code|.
+
+@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@y
+|glue_val|, |last_node_type_code|, |input_line_no_code|, |badness_code|,
+|eTeX_version_code|, or one of the other codes for \eTeX\ extensions.
+
+@d last_node_type_code=glue_val+1 {code for \.{\\lastnodetype}}
+@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+3 {code for \.{\\badness}}
+@d eTeX_int=glue_val+4 {first of \eTeX\ codes for integers}
+@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions}
+@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue}
+@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue}
+@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions}
+@z
+%---------------------------------------
+@x [26] m.417 l.8425 - e-TeX interaction_mode
+@+else print_esc("insertpenalties");
+@y
+@/@<Cases of |set_page_int| for |print_cmd_chr|@>@/
+@+else print_esc("insertpenalties");
+@z
+%---------------------------------------
+@x [26] m.417 l.8434 - e-TeX basic
+ othercases print_esc("badness")
+@y
+ @/@<Cases of |last_item| for |print_cmd_chr|@>@/
+ othercases print_esc("badness")
+@z
+%---------------------------------------
+@x [26] m.419 l.8457 - e-TeX interaction_mode
+begin if m=0 then cur_val:=dead_cycles@+else cur_val:=insert_penalties;
+@y
+begin if m=0 then cur_val:=dead_cycles
+@/@<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>@/
+else cur_val:=insert_penalties;
+@z
+%---------------------------------------
+@x [26] m.420 l.8462 - e-TeX sparse arrays
+begin
+ scan_eight_bit_int;
+ if box(cur_val)=null then cur_val:=0 @+else
+ cur_val:=mem[box(cur_val)+m].sc;
+@y
+begin
+ scan_register_num;
+ fetch_box(q);
+ if q=null then cur_val:=0 @+else
+ cur_val:=mem[q+m].sc;
+@z
+%---------------------------------------
+@x [26] m.423 l.8487 - e-TeX penalties
+begin if par_shape_ptr=null then cur_val:=0
+@y
+begin if m>par_shape_loc then @<Fetch a penalties array element@>
+else if par_shape_ptr=null then cur_val:=0
+@z
+%---------------------------------------
+% @x [26] m.424 l.8493 - e-TeX TeXXeT
+% implemented. The reference count for \.{\\lastskip} will be updated later.
+% @y
+% implemented. The reference count for \.{\\lastskip} will be updated later.
+% A final \.{\\endM} node is temporarily removed.
+% @z
+%---------------------------------------
+@x [26] m.424 l.8499 - e-TeX basic
+if cur_chr>glue_val then
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+@y
+if m>last_node_type_code then
+ if m>=eTeX_glue then @<Process an expression and |return|@>@;
+ else if m>=eTeX_dim then
+ begin case m of
+ @/@<Cases for fetching a dimension value@>@/
+ end; {there are no other cases}
+ cur_val_level:=dimen_val;
+ end
+ else begin case m of
+ input_line_no_code: cur_val:=line;
+ badness_code: cur_val:=last_badness;
+ @/@<Cases for fetching an integer value@>@/
+ end; {there are no other cases}
+@z
+%---------------------------------------
+@x [26] m.424 l.8505 - e-TeX last_node_type
+ cur_val_level:=cur_chr;
+@y
+ if cur_chr=last_node_type_code then
+ begin cur_val:=int_val;
+ if (tail=head)or(mode=0) then cur_val:=-1;
+ end
+ else cur_val_level:=cur_chr;
+@z
+%---------------------------------------
+% @x [26] m.424 l.8507 - e-TeX TeXXeT
+% case cur_chr of
+% @y
+% begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+% remove_end_M;
+% case cur_chr of
+% @z
+%---------------------------------------
+@x [26] m.424 l.8513 - e-TeX last_node_type
+ end;
+@y
+ end;
+ last_node_type_code:
+ if (type(tail)<>math_node)or(subtype(tail)<>end_M_code) then
+ if type(tail)<=unset_node then cur_val:=type(tail)+1
+ else cur_val:=unset_node+2;
+@z
+%---------------------------------------
+% @x [26] m.424 l.8514 - e-TeX TeXXeT
+% end {there are no other cases}
+% @y
+% end; {there are no other cases}
+% if LR_temp<>null then insert_end_M;
+% end
+% @z
+%---------------------------------------
+@x [26] m.424 l.8519 - e-TeX last_node_type
+ glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+@y
+ glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+ last_node_type_code: cur_val:=last_node_type;
+@z
+%---------------------------------------
+% FIXME might need work
+@x [26] m.427 l.8535 - e-TeX sparse arrays
+begin scan_eight_bit_int;
+case m of
+@y
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+@z
+%---------------------------------------
+@x [26] m.427 l.8542 - e-TeX sparse arrays
+cur_val_level:=m;
+@y
+ end;
+@z
+%---------------------------------------
+@x [26] m.461 l.9070 - e-TeX expr
+exit:end;
+@y
+exit:end;
+@#
+@<Declare procedures needed for expressions@>@;
+@z
+%---------------------------------------
+@x [27] m.464 l.9129 - e-TeX basic
+@p function str_toks(@!b:pool_pointer):pointer;
+@y
+@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
+function str_toks(@!b:pool_pointer):pointer;
+@z
+%---------------------------------------
+@x [27] m.465 l.9154 the_toks - e-TeX unexpanded
+@p function the_toks:pointer;
+@y
+@p function the_toks:pointer;
+label exit;
+@z
+%---------------------------------------
+@x [27] m.465 l.9158 the_toks - e-TeX unexpanded
+begin get_x_token; scan_something_internal(tok_val,false);
+@y
+@!c:small_number; {value of |cur_chr|}
+begin @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>;@/
+get_x_token; scan_something_internal(tok_val,false);
+@z
+%---------------------------------------
+@x [27] m.465 l.9172 the_toks - e-TeX unexpanded
+end;
+@y
+exit:end;
+@z
+%---------------------------------------
+@x [27] m.469 l.9223 - e-TeX basic
+ othercases print_esc("jobname")
+@y
+ @/@<Cases of |convert| for |print_cmd_chr|@>@/
+ othercases print_esc("jobname")
+@z
+%---------------------------------------
+@x [27] m.470 l.9232 conv_toks - e-TeX basic
+@!c:number_code..job_name_code; {desired type of conversion}
+@y
+@!c:small_number; {desired type of conversion}
+@z
+%---------------------------------------
+@x [27] m.471 l.9249 - e-TeX basic
+end {there are no other cases}
+@y
+@/@<Cases of `Scan the argument for command |c|'@>@/
+end {there are no other cases}
+@z
+%---------------------------------------
+@x [27] m.472 l.9265 - e-TeX basic
+end {there are no other cases}
+@y
+@/@<Cases of `Print the result of command |c|'@>@/
+end {there are no other cases}
+@z
+%---------------------------------------
+@x [27] m.478 l.9374 - e-TeX protected
+ if cur_cmd<=max_command then goto done2;
+@y
+ if cur_cmd>=call then
+ if info(link(cur_chr))=protected_token then
+ begin cur_cmd:=relax; cur_chr:=no_expand_flag;
+ end;
+ if cur_cmd<=max_command then goto done2;
+@z
+%---------------------------------------
+@x [27] m.482 l.9422 read_toks - e-TeX read_line
+@p procedure read_toks(@!n:integer;@!r:pointer);
+@y
+@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword);
+@z
+%---------------------------------------
+@x [27] m.483 l.9448 - e-TeX read_line
+loop@+ begin get_token;
+@y
+@<Handle \.{\\readline} and |goto done|@>;@/
+loop@+ begin get_token;
+@z
+%---------------------------------------
+@x [28] m.487 l.9500 - e-TeX cond
+@d if_char_code=0 { `\.{\\if}' }
+@y
+@d unless_code=32 {amount added for `\.{\\unless}' prefix}
+@#
+@d if_char_code=0 { `\.{\\if}' }
+@z
+%---------------------------------------
+@x [28] m.488 l.9555 - e-TeX cond
+if_test: case chr_code of
+@y
+if_test: begin if chr_code>=unless_code then print_esc("unless");
+case chr_code mod unless_code of
+@z
+%---------------------------------------
+@x [28] m.488 l.9572 - e-TeX cond
+ othercases print_esc("if")
+ endcases;
+@y
+ @/@<Cases of |if_test| for |print_cmd_chr|@>@/
+ othercases print_esc("if")
+ endcases;
+end;
+@z
+%---------------------------------------
+@x [28] m.494 l.9646 pass_text - e-TeX tracing
+done: scanner_status:=save_scanner_status;
+@y
+done: scanner_status:=save_scanner_status;
+if tracing_ifs>0 then show_cur_cmd_chr;
+@z
+%---------------------------------------
+@x [28] m.496 l.9662 - e-TeX tracing_nesting
+begin p:=cond_ptr; if_line:=if_line_field(p);
+@y
+begin if if_stack[in_open]=cond_ptr then if_warning;
+ {conditionals possibly not properly nested with files}
+p:=cond_ptr; if_line:=if_line_field(p);
+@z
+%---------------------------------------
+@x [28] m.498 l.9699 conditional - e-TeX cond
+begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+@y
+@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?}
+begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
+is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+if is_unless then b:=not b;
+@z
+%---------------------------------------
+@x [28] m.501 l.9742 - e-TeX cond
+if_false_code: b:=false;
+@y
+if_false_code: b:=false;
+@/@<Cases for |conditional|@>@/
+@z
+%---------------------------------------
+@x [28] m.505 l.9781 - e-TeX sparse arrays
+begin scan_eight_bit_int; p:=box(cur_val);
+@y
+begin scan_register_num; fetch_box(p);
+@z
+%---------------------------------------
+@x [28] m.510 l.9871 - e-TeX cond
+if cur_chr>if_limit then
+@y
+begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+if cur_chr>if_limit then
+@z
+%---------------------------------------
+@x [28] m.510 l.9882 - e-TeX cond
+ end
+@y
+ end;
+end
+@z
+%---------------------------------------
+@x [29] m.536 l.10324 - e-TeX basic
+begin wlog(banner);
+@y
+begin wlog(eTeX_banner);
+@z
+%---------------------------------------
+@x [29] m.536 l.10331 - e-TeX basic
+end
+@y
+if eTeX_ex then
+ begin; wlog_cr; wlog('entering extended mode');
+ end;
+end
+@z
+%---------------------------------------
+@x [30] m.581 l.11263 char_warning - e-TeX tracing
+begin if tracing_lost_chars>0 then
+@y
+var old_setting: integer; {saved value of |tracing_online|}
+begin if tracing_lost_chars>0 then
+ begin old_setting:=tracing_online;
+ if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+@z
+%---------------------------------------
+@x [30] m.581 l.11270 char_warning - e-TeX tracing
+end;
+@y
+ tracing_online:=old_setting;
+ end;
+end;
+@z
+%---------------------------------------
+% @x [32] m.616 l.12238 - e-TeX TeXXeT
+% this is essentially the depth of |push| commands in the \.{DVI} output.
+% @y
+% this is essentially the depth of |push| commands in the \.{DVI} output.
+%
+% For mixed direction text (\TeXXeT) the current text direction is called
+% |cur_dir|. As the box being shipped out will never be used again and
+% soon be recycled, we can simply reverse any R-text (i.e., right-to-left)
+% segments of hlist nodes as well as complete hlist nodes embedded in such
+% segments. Moreover this can be done iteratively rather than recursively.
+% There are, however, two complications related to leaders that require
+% some additional bookkeeping: (1)~One and the same hlist node might be
+% used more than once (but never inside both L- and R-text); and
+% (2)~leader boxes inside hlists must be aligned with respect to the left
+% edge of the original hlist.
+%
+% A math node is changed into a kern node whenever the text direction
+% remains the same, it is replaced by an |edge_node| if the text direction
+% changes; the subtype of an an |hlist_node| inside R-text is changed to
+% |reversed| once its hlist has been reversed.
+% @!@^data structure assumptions@>
+% @z
+%---------------------------------------
+% @x [32] m.616 l.12240 - e-TeX TeXXeT
+% @d synch_h==if cur_h<>dvi_h then
+% @y
+% @d reversed=min_quarterword+1 {subtype for an |hlist_node| whose hlist
+% has been reversed}
+% @d dlist=min_quarterword+2 {subtype for an |hlist_node| from display math mode}
+% @d left_to_right=0
+% @d right_to_left=1
+% @d reflected==1-cur_dir {the opposite of |cur_dir|}
+% @#
+% @d synch_h==if cur_h<>dvi_h then
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12300 hlist_out - e-TeX add_glue
+% @!g_order: glue_ord; {applicable order of infinity for glue}
+% @y
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12308 hlist_out - e-TeX TeXXeT
+% @!edge:scaled; {left edge of sub-box, or right edge of leader space}
+% @y
+% @!edge:scaled; {right edge of sub-box or leader space}
+% @!prev_p:pointer; {one step behind |p|}
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12309 hlist_out - e-TeX add_glue
+% @!glue_temp:real; {glue value before rounding}
+% begin this_box:=temp_ptr; g_order:=glue_order(this_box);
+% @y
+% begin this_box:=temp_ptr;
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12315 hlist_out - e-TeX TeXXeT
+% save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+% @y
+% save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v;
+% prev_p:=this_box+list_offset;
+% if eTeX_ex then
+% begin @<Initialize the LR stack@>;
+% if subtype(this_box)=dlist then
+% if cur_dir=right_to_left then
+% begin cur_dir:=left_to_right; cur_h:=cur_h-width(this_box);
+% end
+% else subtype(this_box):=min_quarterword;
+% if (cur_dir=right_to_left)and(subtype(this_box)<>reversed) then
+% @<Reverse the complete hlist and set the subtype to |reversed|@>;
+% end;
+% left_edge:=cur_h;
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12318 hlist_out - e-TeX TeXXeT
+% prune_movements(save_loc);
+% @y
+% if eTeX_ex then
+% begin @<Check for LR anomalies at the end of |hlist_out|@>;
+% if subtype(this_box)=dlist then cur_dir:=right_to_left;
+% end;
+% prune_movements(save_loc);
+% @z
+%---------------------------------------
+% @x [32] m.620 l.12337 - e-TeX TeXXeT
+% p:=link(p);
+% @y
+% prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|}
+% p:=link(p);
+% @z
+%---------------------------------------
+% @x [32] m.622 l.12362 - e-TeX TeXXeT
+% kern_node,math_node:cur_h:=cur_h+width(p);
+% @y
+% kern_node:cur_h:=cur_h+width(p);
+% math_node:begin if eTeX_ex then
+% @<Adjust \(t)the LR stack for the |hlist_out| routine; if necessary
+% reverse an hlist segment and |goto reswitch|@>;
+% cur_h:=cur_h+width(p);
+% end;
+% @z
+%---------------------------------------
+% @x [32] m.622 l.12364 - e-TeX TeXXeT
+% othercases do_nothing
+% @y
+% @/@<Cases of |hlist_out| that arise in mixed direction text only@>@;
+% othercases do_nothing
+% @z
+%---------------------------------------
+% @x [32] m.622 l.12369 - e-TeX TeXXeT
+% next_p:p:=link(p);
+% @y
+% next_p:prev_p:=p; p:=link(p);
+% @z
+%---------------------------------------
+% @x [32] m.623 l.12376 - e-TeX TeXXeT
+% temp_ptr:=p; edge:=cur_h;
+% @y
+% temp_ptr:=p; edge:=cur_h+width(p);
+% if cur_dir=right_to_left then cur_h:=edge;
+% @z
+%---------------------------------------
+% @x [32] m.623 l.12379 - e-TeX TeXXeT
+% cur_h:=edge+width(p); cur_v:=base_line;
+% @y
+% cur_h:=edge; cur_v:=base_line;
+% @z
+%---------------------------------------
+% @x [32] m.625 l.12401 - e-TeX add_glue
+% begin if g_sign=stretching then
+% begin if stretch_order(g)=g_order then
+% begin vet_glue(float(glue_set(this_box))*stretch(g));
+% @^real multiplication@>
+% rule_wd:=rule_wd+round(glue_temp);
+% end;
+% end
+% else if shrink_order(g)=g_order then
+% begin vet_glue(float(glue_set(this_box))*shrink(g));
+% rule_wd:=rule_wd-round(glue_temp);
+% end;
+% end;
+% @y
+% add_glue(rule_wd);
+% @z
+%---------------------------------------
+% @x [32] m.626 l.12428 - e-TeX TeXXeT
+% edge:=cur_h+rule_wd; lx:=0;
+% @y
+% if cur_dir=right_to_left then cur_h:=cur_h-10;
+% edge:=cur_h+rule_wd; lx:=0;
+% @z
+%---------------------------------------
+% @x [32] m.626 l.12434 - e-TeX TeXXeT
+% cur_h:=edge-10; goto next_p;
+% @y
+% if cur_dir=right_to_left then cur_h:=edge
+% else cur_h:=edge-10;
+% goto next_p;
+% @z
+%---------------------------------------
+% @x [32] m.628 l.12473 - e-TeX TeXXeT
+% synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+% @y
+% synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+% if cur_dir=right_to_left then cur_h:=cur_h+leader_wd;
+% @z
+%---------------------------------------
+% @x [32] m.629 l.12489 vlist_out - e-TeX add_glue
+% @!g_order: glue_ord; {applicable order of infinity for glue}
+% @y
+% @z
+%---------------------------------------
+% @x [32] m.629 l.12498 vlist_out - e-TeX add_glue
+% @!glue_temp:real; {glue value before rounding}
+% begin this_box:=temp_ptr; g_order:=glue_order(this_box);
+% @y
+% begin this_box:=temp_ptr;
+% @z
+%---------------------------------------
+% @x [32] m.632 l.12544 - e-TeX TeXXeT
+% cur_h:=left_edge+shift_amount(p); {shift the box right}
+% @y
+% if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p)
+% else cur_h:=left_edge+shift_amount(p); {shift the box right}
+% @z
+%---------------------------------------
+% @x [32] m.633 l.12556 - e-TeX TeXXeT
+% begin synch_h; synch_v;
+% dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+% @y
+% begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
+% synch_h; synch_v;
+% dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+% cur_h:=left_edge;
+% @z
+%---------------------------------------
+% @x [32] m.634 l.12564 - e-TeX add_glue
+% begin if g_sign=stretching then
+% begin if stretch_order(g)=g_order then
+% begin vet_glue(float(glue_set(this_box))*stretch(g));
+% @^real multiplication@>
+% rule_ht:=rule_ht+round(glue_temp);
+% end;
+% end
+% else if shrink_order(g)=g_order then
+% begin vet_glue(float(glue_set(this_box))*shrink(g));
+% rule_ht:=rule_ht-round(glue_temp);
+% end;
+% end;
+% @y
+% add_glue(rule_ht);
+% @z
+%---------------------------------------
+% @x [32] m.637 l.12619 - e-TeX TeXXeT
+% begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/
+% @y
+% begin if cur_dir=right_to_left then
+% cur_h:=left_edge-shift_amount(leader_box)
+% else cur_h:=left_edge+shift_amount(leader_box);
+% synch_h; save_h:=dvi_h;@/
+% @z
+%---------------------------------------
+% @x [32] m.638 l.12656 ship_out - e-TeX TeXXeT
+% @<Ship box |p| out@>;
+% @y
+% @<Ship box |p| out@>;
+% if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>;
+% @z
+%---------------------------------------
+% @x [33] m.649 l.12876 hpack - e-TeX TeXXeT
+% h:=0; @<Clear dimensions to zero@>;
+% @y
+% h:=0; @<Clear dimensions to zero@>;
+% if TeXXeT_en then @<Initialize the LR stack@>;
+% @z
+%---------------------------------------
+% @x [33] m.649 l.12886 hpack - e-TeX TeXXeT
+% exit: hpack:=r;
+% @y
+% exit: if TeXXeT_en then @<Check for LR anomalies at the end of |hpack|@>;
+% hpack:=r;
+% @z
+%---------------------------------------
+% @x [33] m.651 l.12910 - e-TeX TeXXeT
+% kern_node,math_node: x:=x+width(p);
+% @y
+% kern_node: x:=x+width(p);
+% math_node: begin x:=x+width(p);
+% if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>;
+% end;
+% @z
+%---------------------------------------
+@x [34] m.687 l.13480 - e-TeX middle
+\TeX's \.{\\left} and \.{\\right}. The |nucleus| of such noads is
+@y
+\TeX's \.{\\left} and \.{\\right} as well as \eTeX's \.{\\middle}.
+The |nucleus| of such noads is
+@z
+%---------------------------------------
+@x [34] m.687 l.13497 - e-TeX middle
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@y
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@d middle_noad==1 {|subtype| of right noad representing \.{\\middle}}
+@z
+%---------------------------------------
+@x [34] m.696 l.13670 - e-TeX middle
+right_noad: begin print_esc("right"); print_delimiter(nucleus(p));
+ end;
+end;
+if subtype(p)<>normal then
+ if subtype(p)=limits then print_esc("limits")
+ else print_esc("nolimits");
+if type(p)<left_noad then print_subsidiary_data(nucleus(p),".");
+@y
+right_noad: begin if subtype(p)=normal then print_esc("right")
+ else print_esc("middle");
+ print_delimiter(nucleus(p));
+ end;
+end;
+if type(p)<left_noad then
+ begin if subtype(p)<>normal then
+ if subtype(p)=limits then print_esc("limits")
+ else print_esc("nolimits");
+ print_subsidiary_data(nucleus(p),".");
+ end;
+@z
+%---------------------------------------
+@x [36] m.727 l.14268 - e-TeX middle
+done_with_noad: r:=q; r_type:=type(r);
+@y
+done_with_noad: r:=q; r_type:=type(r);
+if r_type=right_noad then
+ begin r_type:=left_noad; cur_style:=style; @<Set up the values...@>;
+ end;
+@z
+%---------------------------------------
+@x [36] m.760 l.14929 - e-TeX middle
+ r_type:=t;
+@y
+ if type(q)=right_noad then t:=open_noad;
+ r_type:=t;
+@z
+%---------------------------------------
+@x [36] m.762 l.14970 make_left_right - e-TeX middle
+begin if style<script_style then cur_size:=text_size
+else cur_size:=script_size*((style-text_style) div 2);
+@y
+begin cur_style:=style; @<Set up the values...@>;
+@z
+%---------------------------------------
+@x [37] m.785 l.15461 align_peek - e-TeX protected
+begin restart: align_state:=1000000; @<Get the next non-blank non-call token@>;
+@y
+begin restart: align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+@z
+%---------------------------------------
+@x [37] m.791 l.15572 fin_col - e-TeX protected
+align_state:=1000000; @<Get the next non-blank non-call token@>;
+@y
+align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+@z
+%---------------------------------------
+% @x [37] m.807 l.15834 - e-TeX TeXXeT
+% begin type(q):=hlist_node; width(q):=width(p);
+% @y
+% begin type(q):=hlist_node; width(q):=width(p);
+% if nest[nest_ptr-1].mode_field=mmode then subtype(q):=dlist; {for |ship_out|}
+% @z
+%---------------------------------------
+% @x [37] m.808 l.15852 - e-TeX TeXXeT
+% n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+% @y
+% n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+% subtype(r):=min_quarterword; {for |ship_out|}
+% @z
+%---------------------------------------
+@x [38] m.814 l.15975 - e-TeX penalties
+There is one explicit parameter: |final_widow_penalty| is the amount of
+additional penalty to be inserted before the final line of the paragraph.
+@y
+There is one explicit parameter: |d| is true for partial paragraphs
+preceding display math mode; in this case the amount of additional
+penalty inserted before the final line is |display_widow_penalty|
+instead of |widow_penalty|.
+@z
+%---------------------------------------
+@x [38] m.815 l.16002 line_break - e-TeX penalties
+procedure line_break(@!final_widow_penalty:integer);
+@y
+procedure line_break(@!d:boolean);
+@z
+%---------------------------------------
+@x [38] m.815 l.16012 - e-TeX basic
+end;
+@y
+end;
+@#
+@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@>
+@z
+%---------------------------------------
+@x [38] m.816 l.16032 - e-TeX last_line_fit
+final_par_glue:=new_param_glue(par_fill_skip_code);
+link(tail):=final_par_glue;
+@y
+final_par_glue:=new_param_glue(par_fill_skip_code);
+link(tail):=final_par_glue;
+last_line_fill:=link(tail);
+@z
+%---------------------------------------
+@x [38] m.819 l.16097 - e-TeX last_line_fit
+@d active_node_size=3 {number of words in active nodes}
+@y
+@d active_node_size_normal=3 {number of words in normal active nodes}
+@z
+%---------------------------------------
+% FIXME might need fixes; TeX has 6 backgrounds
+% Omega has 7. Why the difference?
+@x [38] m.827 l.16260 - e-TeX last_line_fit
+background[7]:=shrink(q)+shrink(r);
+@y
+background[7]:=shrink(q)+shrink(r);
+@<Check for special treatment of last line of paragraph@>;
+@z
+%---------------------------------------
+@x [38] m.829 l.16311 try_break - e-TeX last_line_fit
+label exit,done,done1,continue,deactivate;
+@y
+label exit,done,done1,continue,deactivate,found,not_found;
+@z
+%---------------------------------------
+@x [38] m.845 l.16603 - e-TeX last_line_fit
+total_demerits(q):=minimal_demerits[fit_class];
+@y
+total_demerits(q):=minimal_demerits[fit_class];
+if do_last_line_fit then
+ @<Store \(a)additional data in the new active node@>;
+@z
+%---------------------------------------
+@x [38] m.846 l.16616 - e-TeX last_line_fit
+print(" t="); print_int(total_demerits(q));
+@y
+print(" t="); print_int(total_demerits(q));
+if do_last_line_fit then @<Print additional data in the new active node@>;
+@z
+%---------------------------------------
+@x [38] m.851 l.16715 - e-TeX last_line_fit
+if (b>inf_bad)or(pi=eject_penalty) then
+@y
+if do_last_line_fit then @<Adjust \(t)the additional data for last line@>;
+found:
+if (b>inf_bad)or(pi=eject_penalty) then
+@z
+%---------------------------------------
+@x [38] m.852 l.16739 - e-TeX last_line_fit
+ begin b:=0; fit_class:=decent_fit; {infinite stretch}
+@y
+ begin if do_last_line_fit then
+ begin if cur_p=null then {the last line of a paragraph}
+ @<Perform computations for last line and |goto found|@>;
+ shortfall:=0;
+ end;
+ b:=0; fit_class:=decent_fit; {infinite stretch}
+@z
+%---------------------------------------
+@x [38] m.855 l.16796 - e-TeX last_line_fit
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+@y
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+ if do_last_line_fit then
+ @<Store \(a)additional data for this feasible break@>;
+@z
+%---------------------------------------
+@x [39] m.863 l.16969 - e-TeX last_line_fit
+ end;@+tats@/
+@y
+ end;@+tats@/
+if do_last_line_fit then @<Adjust \(t)the final line of the paragraph@>;
+@z
+%---------------------------------------
+@x [39] m.864 l.16980 - e-TeX last_line_fit
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+@y
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+if do_last_line_fit then
+ @<Initialize additional fields of the first active node@>;
+@z
+%---------------------------------------
+% @x [39] m.866 l.17030 - e-TeX TeXXeT
+% math_node: begin auto_breaking:=(subtype(cur_p)=after); kern_break;
+% @y
+% math_node: begin if subtype(cur_p)<L_code then auto_breaking:=end_LR(cur_p);
+% kern_break;
+% @z
+%---------------------------------------
+@x [39] m.876 l.17192 - e-TeX penalties
+post_line_break(final_widow_penalty)
+@y
+post_line_break(d)
+@z
+%---------------------------------------
+@x [39] m.877 l.17206 post_line_break - e-TeX penalties
+procedure post_line_break(@!final_widow_penalty:integer);
+@y
+procedure post_line_break(@!d:boolean);
+@z
+%---------------------------------------
+% @x [39] m.877 l.17216 post_line_break - e-TeX TeXXeT
+% begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+% @y
+% @!LR_ptr:pointer; {stack of LR codes}
+% begin LR_ptr:=LR_save;
+% @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+% @z
+%---------------------------------------
+% @x [39] m.877 l.17229 post_line_break - e-TeX TeXXeT
+% prev_graf:=best_line-1;
+% @y
+% prev_graf:=best_line-1;
+% LR_save:=LR_ptr;
+% @z
+%---------------------------------------
+% @x [39] m.879 l.17259 - e-TeX TeXXeT
+% r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
+% @y
+% r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
+% if type(q)=math_node then if TeXXeT_en then
+% @<Adjust \(t)the LR stack for the |post_line_break| routine@>;
+% @z
+%---------------------------------------
+% @x [39] m.880 l.17276 - e-TeX TeXXeT
+% @<Modify the end of the line to reflect the nature of the break and to include
+% \.{\\rightskip}; also set the proper value of |disc_break|@>;
+% @y
+% if TeXXeT_en then
+% @<Insert LR nodes at the beginning of the current line and adjust
+% the LR stack based on LR nodes in this line@>;
+% @<Modify the end of the line to reflect the nature of the break and to include
+% \.{\\rightskip}; also set the proper value of |disc_break|@>;
+% if TeXXeT_en then @<Insert LR nodes at the end of the current line@>;
+% @z
+%---------------------------------------
+% @x [39] m.881 l.17299 - e-TeX TeXXeT
+% else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+% @y
+% else if type(q)=kern_node then width(q):=0
+% else if type(q)=math_node then
+% begin width(q):=0;
+% if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>;
+% end;
+% @z
+%---------------------------------------
+% FIXME possible conflict
+@x [39] m.890 l.17395 - e-TeX penalties
+ if passive_pen_inter(cur_p)<>0 then
+ pen:=passive_pen_inter(cur_p)
+ else pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+@y
+ q:=inter_line_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=penalty(q+r);
+ end
+ else begin
+ if passive_pen_inter(cur_p)<>0 then
+ pen:=passive_pen_inter(cur_p)
+ else pen:=inter_line_penalty;
+ end;
+ q:=club_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line-prev_graf;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if d then q:=display_widow_penalties_ptr
+ else q:=widow_penalties_ptr;
+ if q<>null then
+ begin r:=best_line-cur_line-1;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line+2=best_line then
+ if d then pen:=pen+display_widow_penalty
+ else pen:=pen+widow_penalty;
+@z
+%---------------------------------------
+@x [40] m.891 l.17460 - e-TeX hyph_codes
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+@y
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+set_hyph_index;
+@z
+%---------------------------------------
+@x [40] m.896 l.17529 - e-TeX hyph_codes
+ if lc_code(c)<>0 then
+ if (lc_code(c)=c)or(uc_hyph>0) then goto done2
+@y
+ set_lc_code(c);
+ if hc[0]<>0 then
+ if (hc[0]=c)or(uc_hyph>0) then goto done2
+@z
+%---------------------------------------
+@x [40] m.897 l.17546 - e-TeX hyph_codes
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+ if hn=63 then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=lc_code(c); hyf_bchar:=non_char;
+@y
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+ if hn=63 then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char;
+@z
+%---------------------------------------
+@x [40] m.898 l.17572 - e-TeX hyph_codes
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+ if j=63 then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=lc_code(c);@/
+@y
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+ if j=63 then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=hc[0];@/
+@z
+%---------------------------------------
+@x [42] m.934 l.18211 new_hyph_exceptions - e-TeX hyph_codes
+label reswitch, exit, found, not_found;
+@y
+label reswitch, exit, found, not_found, not_found1;
+@z
+%---------------------------------------
+@x [42] m.934 l.18221 new_hyph_exceptions - e-TeX hyph_codes
+set_cur_lang;
+@y
+set_cur_lang;
+@!init if trie_not_ready then
+ begin hyph_index:=0; goto not_found1;
+ end;
+tini@/
+set_hyph_index;
+not_found1:
+@z
+%---------------------------------------
+@x [42] m.937 l.18253 - e-TeX hyph_codes
+else begin if lc_code(cur_chr)=0 then
+@y
+else begin set_lc_code(cur_chr);
+ if hc[0]=0 then
+@z
+%---------------------------------------
+@x [42] m.937 l.18261 - e-TeX hyph_codes
+ begin incr(n); hc[n]:=lc_code(cur_chr);
+@y
+ begin incr(n); hc[n]:=hc[0];
+@z
+%---------------------------------------
+@x [43] m.952 l.18549 - e-TeX hyph_codes
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+@y
+hyph_root:=compress_trie(hyph_root);
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+@z
+%---------------------------------------
+@x [43] m.958 l.18637 - e-TeX hyph_codes
+if trie_root=0 then {no patterns were given}
+@y
+if trie_max=0 then {no patterns were given}
+@z
+%---------------------------------------
+@x [43] m.958 l.18641 - e-TeX hyph_codes
+else begin trie_fix(trie_root); {this fixes the non-holes in |trie|}
+@y
+else begin if hyph_root>0 then trie_fix(hyph_root);
+ if trie_root>0 then trie_fix(trie_root); {this fixes the non-holes in |trie|}
+@z
+%---------------------------------------
+@x [43] m.960 l.18684 new_patterns - e-TeX hyph_codes
+ brace@>;
+@y
+ brace@>;
+ if saving_hyph_codes>0 then
+ @<Store hyphenation codes for current language@>;
+@z
+%---------------------------------------
+@x [43] m.966 l.18791 init_trie - e-TeX hyph_codes
+@<Move the data into |trie|@>;
+@y
+if hyph_root<>0 then @<Pack all stored |hyph_codes|@>;
+@<Move the data into |trie|@>;
+@z
+%---------------------------------------
+@x [44] m.968 l.18807 - e-TeX saved_items
+whenever this is possible without backspacing.
+@y
+whenever this is possible without backspacing.
+
+When the second argument |s| is |false| the deleted nodes are destroyed,
+otherwise they are collected in a list starting at |split_disc|.
+@z
+%---------------------------------------
+@x [44] m.968 l.18814 prune_page_top - e-TeX saved_items
+@p function prune_page_top(@!p:pointer):pointer; {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q:pointer; {temporary variable for list manipulation}
+@y
+@p function prune_page_top(@!p:pointer;@!s:boolean):pointer;
+ {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q,@!r:pointer; {temporary variables for list manipulation}
+@z
+%---------------------------------------
+@x [44] m.968 l.18825 prune_page_top - e-TeX saved_items
+ link(prev_p):=p; flush_node_list(q);
+@y
+ link(prev_p):=p;
+ if s then
+ begin if split_disc=null then split_disc:=q@+else link(r):=q;
+ r:=q;
+ end
+ else flush_node_list(q);
+@z
+%---------------------------------------
+@x [44] m.977 l.18992 vsplit - e-TeX marks, sparse arrays
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+@y
+@p @t\4@>@<Declare the function called |do_marks|@>@;
+function vsplit(@!n:halfword; @!h:scaled):pointer;
+@z
+%---------------------------------------
+% FIXME incompatible?
+@x [44] m.977 l.18998 vsplit - e-TeX sparse arrays
+begin v:=box(n); vdir:=box_dir(v);
+@y
+begin cur_val:=n; fetch_box(v); vdir:=box_dir(v);
+@z
+%---------------------------------------
+% FIXME: how to detach this from sparse arrays?
+@x [44] m.977 l.18999 vsplit - e-TeX marks, saved_items
+if split_first_mark<>null then
+@y
+flush_node_list(split_disc); split_disc:=null;
+if sa_mark<>null then
+ if do_marks(vsplit_init,0,sa_mark) then sa_mark:=null;
+if split_first_mark<>null then
+@z
+%---------------------------------------
+@x [44] m.977 l.19007 vsplit - e-TeX saved_items
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+@y
+q:=prune_page_top(q,saving_vdiscards>0);
+p:=list_ptr(v); free_node(v,box_node_size);
+@z
+%---------------------------------------
+% FIXME might be incompatible?
+@x [44] m.977 l.19008 vsplit - e-TeX sparse arrays
+if q=null then set_equiv(box_base+n,null)
+ {the |eq_level| of the box stays the same}
+else set_equiv(box_base+n,vpack(q,natural));
+@y
+if q<>null then q:=vpack(q,natural);
+change_box(q); {the |eq_level| of the box stays the same}
+@z
+%---------------------------------------
+@x [44] m.979 l.19033 - e-TeX marks
+ if split_first_mark=null then
+@y
+ if mark_class(p)<>0 then @<Update the current marks for |vsplit|@>
+ else if split_first_mark=null then
+@z
+%---------------------------------------
+@x [45] m.982 l.19167 - e-TeX last_node_type
+The variables |last_penalty| and |last_kern| are similar. And
+@y
+The variables |last_penalty|, |last_kern|, and |last_node_type|
+are similar. And
+@z
+%---------------------------------------
+@x [45] m.982 l.19180 - e-TeX last_node_type
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@y
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@!last_node_type:integer; {used to implement \.{\\lastnodetype}}
+@z
+%---------------------------------------
+@x [45] m.991 l.19317 - e-TeX last_node_type
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+@y
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+last_node_type:=-1;
+@z
+%---------------------------------------
+@x [45] m.996 l.19384 - e-TeX last_node_type
+last_penalty:=0; last_kern:=0;
+@y
+last_penalty:=0; last_kern:=0;
+last_node_type:=type(p)+1;
+@z
+%---------------------------------------
+@x [45] m.999 l.19421 - e-TeX saved_items
+link(contrib_head):=link(p); link(p):=null; flush_node_list(p)
+@y
+link(contrib_head):=link(p); link(p):=null;
+if saving_vdiscards>0 then
+ begin if page_disc=null then page_disc:=p@+else link(tail_page_disc):=p;
+ tail_page_disc:=p;
+ end
+else flush_node_list(p)
+@z
+%---------------------------------------
+% FIXME: sparse arrays?
+@x [45] m.1012 l.19661 fire_up - e-TeX marks
+if bot_mark<>null then
+@y
+if sa_mark<>null then
+ if do_marks(fire_up_init,0,sa_mark) then sa_mark:=null;
+if bot_mark<>null then
+@z
+%---------------------------------------
+@x [45] m.1012 l.19669 fire_up - e-TeX marks
+if (top_mark<>null)and(first_mark=null) then
+@y
+if sa_mark<>null then
+ if do_marks(fire_up_done,0,sa_mark) then sa_mark:=null;
+if (top_mark<>null)and(first_mark=null) then
+@z
+%---------------------------------------
+@x [45] m.1014 l.19706 - e-TeX marks
+ else if type(p)=mark_node then @<Update the values of
+@y
+ else if type(p)=mark_node then
+ if mark_class(p)<>0 then @<Update the current marks for |fire_up|@>
+ else @<Update the values of
+@z
+%---------------------------------------
+@x [45] m.1021 l.19818 - e-TeX saved_items
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+@y
+ ins_ptr(p):=prune_page_top(broken_ptr(r),false);
+@z
+%---------------------------------------
+@x [45] m.1023 l.19854 - e-TeX saved_items
+ship_out(box(255)); set_equiv(box_base+255,null);
+@y
+flush_node_list(page_disc); page_disc:=null;
+ship_out(box(255)); set_equiv(box_base+255,null);
+@z
+%---------------------------------------
+@x [45] m.1026 l.19896 - e-TeX saved_items
+pop_nest; build_page;
+@y
+flush_node_list(page_disc); page_disc:=null;
+pop_nest; build_page;
+@z
+%---------------------------------------
+@x [47] m.1070 l.20697 normal_paragraph - e-TeX penalties
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+@y
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+if inter_line_penalties_ptr<>null then
+ eq_define(inter_line_penalties_loc,shape_ref,null);
+@z
+%---------------------------------------
+% FIXME incompatible?
+% @x [47] m.1071 l.20718 - e-TeX sparse arrays
+% |box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}';
+% codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}'
+% through `\.{\\global\\setbox255}';
+% code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513|
+% through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}',
+% @y
+% |global_box_flag-1| represent `\.{\\setbox0}' through `\.{\\setbox32767}';
+% codes |global_box_flag| through |ship_out_flag-1| represent
+% `\.{\\global\\setbox0}' through `\.{\\global\\setbox32767}';
+% code |ship_out_flag| represents `\.{\\shipout}'; and codes |leader_flag|
+% through |leader_flag+2| represent `\.{\\leaders}', `\.{\\cleaders}',
+% @z
+%---------------------------------------
+@x [47] m.1071 l.20732 - e-TeX sparse arrays
+@d ship_out_flag==box_flag+(number_regs+number_regs)
+ {context code for `\.{\\shipout}'}
+@y
+@d global_box_flag==box_flag+(number_regs+number_regs) {context code for `\.{\\global\\setbox0}'}
+@d ship_out_flag==global_box_flag+1 {context code for `\.{\\shipout}'}
+@z
+%---------------------------------------
+@x [47] m.1075 l.20815 box_end - e-TeX sparse arrays
+var p:pointer; {|ord_noad| for new box in math mode}
+@y
+var p:pointer; {|ord_noad| for new box in math mode}
+@!a:small_number; {global prefix}
+@z
+%---------------------------------------
+% FIXME: might not work this way
+@x [47] m.1077 l.20853 - e-TeX sparse arrays
+if box_context<box_flag+number_regs then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box)
+@y
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+@z
+%---------------------------------------
+@x [47] m.1079 l.20885 begin_box - e-TeX sparse arrays
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+@y
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+@z
+%---------------------------------------
+% @x [47] m.1080 l.20901 - e-TeX TeXXeT
+% since |head| is a one-word node.
+% @y
+% since |head| is a one-word node.
+% A final \.{\\endM} node is temporarily removed.
+% @z
+%---------------------------------------
+% @x [47] m.1080 l.20914 - e-TeX TeXXeT
+% if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+% @<Remove the last box, unless it's part of a discretionary@>;
+% @y
+% begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+% remove_end_M;
+% if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+% @<Remove the last box, unless it's part of a discretionary@>;
+% if LR_temp<>null then insert_end_M;
+% end;
+% @z
+%---------------------------------------
+@x [47] m.1082 l.20935 - e-TeX sparse arrays
+begin scan_eight_bit_int; n:=cur_val;
+@y
+begin scan_register_num; n:=cur_val;
+@z
+%---------------------------------------
+% @x [47] m.1096 l.21119 - e-TeX penalties, TeXXeT
+% else line_break(widow_penalty);
+% @y
+% else line_break(false);
+% if LR_save<>null then
+% begin flush_list(LR_save); LR_save:=null;
+% end;
+% @z
+%---------------------------------------
+@x [47] m.1101 l.21175 make_mark - e-TeX marks
+begin p:=scan_toks(false,true); p:=get_node(small_node_size);
+@y
+@!c:halfword; {the mark class}
+begin if cur_chr=0 then c:=0
+else begin scan_register_num; c:=cur_val;
+ end;
+p:=scan_toks(false,true); p:=get_node(small_node_size);
+mark_class(p):=c;
+@z
+%---------------------------------------
+% @x [47] m.1105 l.21203 - e-TeX TeXXeT
+% will be deleted, if present.
+% @y
+% will be deleted, if present.
+% A final \.{\\endM} node is temporarily removed.
+% @z
+%---------------------------------------
+% @x [47] m.1105 l.21213 delete_last - e-TeX TeXXeT
+% else begin if not is_char_node(tail) then if type(tail)=cur_chr then
+% @y
+% else begin if not is_char_node(tail) then
+% begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+% remove_end_M;
+% if type(tail)=cur_chr then
+% @z
+%---------------------------------------
+% @x [47] m.1105 l.21224 delete_last - e-TeX TeXXeT
+% end;
+% @y
+% if LR_temp<>null then insert_end_M;
+% end;
+% end;
+% @z
+%---------------------------------------
+@x [47] m.1108 l.21262 - e-TeX saved_items
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+@y
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+ @<Cases of |un_vbox| for |print_cmd_chr|@>@/
+@z
+%---------------------------------------
+@x [47] m.1110 l.21272 unpackage - e-TeX saved_items
+label exit;
+@y
+label done, exit;
+@z
+%---------------------------------------
+@x [47] m.1110 l.21275 unpackage - e-TeX saved_items, sparse arrays
+begin c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+@y
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+@z
+%---------------------------------------
+% FIXME: might be incompatible
+@x [47] m.1110 l.21287 unpackage - e-TeX sparse arrays
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@y
+else begin link(tail):=list_ptr(p);
+change_box(null);
+@z
+%---------------------------------------
+@x [47] m.1110 l.21290 unpackage - e-TeX saved_items
+while link(tail)<>null do tail:=link(tail);
+@y
+done:
+while link(tail)<>null do tail:=link(tail);
+@z
+%---------------------------------------
+% @x [47] m.1130 l.21562 - e-TeX TeXXeT
+% vmode+halign,hmode+valign:init_align;
+% @y
+% vmode+halign:init_align;
+% hmode+valign:@<Cases of |main_control| for |hmode+valign|@>@; init_align;
+% @z
+%---------------------------------------
+% @x [48] m.1138 l.21629 init_math - e-TeX TeXXeT
+% procedure init_math;
+% label reswitch,found,not_found,done;
+% var w:scaled; {new or partial |pre_display_size|}
+% @y
+% @t\4@>@<Declare subprocedures for |init_math|@>@;
+% procedure init_math;
+% label reswitch,found,not_found,done;
+% var w:scaled; {new or partial |pre_display_size|}
+% @!j:pointer; {prototype box for display}
+% @!x:integer; {new |pre_display_direction|}
+% @z
+%---------------------------------------
+% @x [48] m.1145 l.21687 - e-TeX TeXXeT, penalties
+% begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+% begin pop_nest; w:=-max_dimen;
+% end
+% else begin line_break(display_widow_penalty);@/
+% @y
+% begin j:=null; w:=-max_dimen;
+% if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+% @<Prepare for display after an empty paragraph@>
+% else begin line_break(true);@/
+% @z
+%---------------------------------------
+% @x [48] m.1145 l.21700 - e-TeX TeXXeT
+% eq_word_define(dimen_base+pre_display_size_code,w);
+% @y
+% eq_word_define(dimen_base+pre_display_size_code,w);
+% LR_box:=j;
+% if eTeX_ex then eq_word_define(int_base+pre_display_direction_code,x);
+% @z
+%---------------------------------------
+% @x [48] m.1146 l.21708 - e-TeX TeXXeT
+% v:=shift_amount(just_box)+2*quad(cur_font); w:=-max_dimen;
+% p:=list_ptr(just_box);
+% @y
+% @<Prepare for display after a non-empty paragraph@>;
+% @z
+%---------------------------------------
+% @x [48] m.1146 l.21723 - e-TeX TeXXeT
+% done:
+% @y
+% done:
+% @<Finish the natural width computation@>
+% @z
+%---------------------------------------
+% @x [48] m.1147 l.21734 - e-TeX TeXXeT
+% kern_node,math_node: d:=width(p);
+% @y
+% kern_node: d:=width(p);
+% @t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@;
+% @z
+%---------------------------------------
+@x [48] m.1185 l.22243 - e-TeX middle
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+@y
+ if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(delim_ptr);
+ link(delim_ptr):=incompleat_noad; link(incompleat_noad):=p;
+@z
+%---------------------------------------
+@x [48] m.1189 l.22288 - e-TeX middle
+else print_esc("right");
+@y
+@/@<Cases of |left_right| for |print_cmd_chr|@>@/
+else print_esc("right");
+@z
+%---------------------------------------
+@x [48] m.1191 l.22297 math_left_right - e-TeX middle
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+@y
+@!q:pointer; {resulting mlist}
+begin t:=cur_chr;
+if (t<>left_noad)and(cur_group<>math_left_group) then
+@z
+%---------------------------------------
+% FIXME: might be incompatible?
+@x [48] m.1191 l.22302 math_left_right - e-TeX middle
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+@y
+ if t=middle_noad then
+ begin type(p):=right_noad; subtype(p):=middle_noad;
+ end;
+ if t=left_noad then q:=p
+ else begin q:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+ end;
+ if t<>right_noad then
+ begin push_math(math_left_group); link(head):=q; tail:=p;
+ delim_ptr:=p;
+ end
+ else begin
+@z
+%---------------------------------------
+@x [48] m.1191 l.22308 math_left_right - e-TeX middle
+ info(nucleus(tail)):=p;
+@y
+ info(nucleus(tail)):=q;
+@z
+%---------------------------------------
+@x [48] m.1192 l.22316 - e-TeX middle
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+@y
+ print_err("Extra ");
+ if t=middle_noad then
+ begin print_esc("middle");
+@.Extra \\middle.@>
+ help1("I'm ignoring a \middle that had no matching \left.");
+ end
+ else begin print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ end;
+@z
+%---------------------------------------
+% @x [48] m.1194 l.22331 after_math - e-TeX TeXXeT
+% procedure after_math;
+% @y
+% @t\4@>@<Declare subprocedures for |after_math|@>@;
+% procedure after_math;
+% @z
+%---------------------------------------
+% @x [48] m.1194 l.22338 after_math - e-TeX TeXXeT
+% begin danger:=false;
+% @y
+% begin danger:=false;
+% @<Retrieve the prototype box@>;
+% @z
+%---------------------------------------
+% @x [48] m.1194 l.22345 after_math - e-TeX TeXXeT
+% mlist_to_hlist; a:=hpack(link(temp_head),natural);
+% @y
+% mlist_to_hlist; a:=hpack(link(temp_head),natural);
+% subtype(a):=dlist;
+% @z
+%---------------------------------------
+% @x [48] m.1194 l.22348 after_math - e-TeX TeXXeT
+% danger:=false;
+% @y
+% danger:=false;
+% @<Retrieve the prototype box@>;
+% @z
+%---------------------------------------
+% @x [48] m.1199 l.22435 - e-TeX TeXXeT
+% w:=width(b); z:=display_width; s:=display_indent;
+% @y
+% w:=width(b); z:=display_width; s:=display_indent;
+% if pre_display_direction<0 then s:=-s-z;
+% @z
+%---------------------------------------
+% @x [48] m.1199 l.22450 - e-TeX TeXXeT
+% resume_after_display
+% @y
+% @<Flush the prototype box@>;
+% resume_after_display
+% @z
+%---------------------------------------
+% @x [48] m.1202 l.22492 - e-TeX TeXXeT
+% d:=half(z-w);
+% @y
+% subtype(b):=dlist;
+% d:=half(z-w);
+% @z
+%---------------------------------------
+% @x [48] m.1203 l.22513 - e-TeX TeXXeT
+% begin shift_amount(a):=s; append_to_vlist(a);
+% @y
+% begin app_display(j,a,0);
+% @z
+%---------------------------------------
+% @x [48] m.1204 l.22528 - e-TeX TeXXeT
+% shift_amount(b):=s+d; append_to_vlist(b)
+% @y
+% app_display(j,b,d)
+% @z
+%---------------------------------------
+% @x [48] m.1205 l.22533 - e-TeX TeXXeT
+% shift_amount(a):=s+z-width(a);
+% append_to_vlist(a);
+% @y
+% app_display(j,a,z-width(a));
+% @z
+%---------------------------------------
+% @x [48] m.1206 l.22552 - e-TeX TeXXeT
+% pop_nest;
+% @y
+% flush_node_list(LR_box);
+% pop_nest;
+% @z
+%---------------------------------------
+@x [49] m.1208 l.22577 - e-TeX protected
+control sequence can be defined to be `\.{\\long}' or `\.{\\outer}', and
+it might or might not be expanded. The prefixes `\.{\\global}', `\.{\\long}',
+@y
+control sequence can be defined to be `\.{\\long}', `\.{\\protected}',
+or `\.{\\outer}', and it might or might not be expanded. The prefixes
+`\.{\\global}', `\.{\\long}', `\.{\\protected}',
+@z
+%---------------------------------------
+@x [49] m.1209 l.22603 - e-TeX protected
+ else print_esc("global");
+@y
+ @/@<Cases of |prefix| for |print_cmd_chr|@>@/
+ else print_esc("global");
+@z
+%---------------------------------------
+@x [49] m.1211 l.22665 prefixed_command - e-TeX tracing
+ @<Discard erroneous prefixes and |return|@>;
+@y
+ @<Discard erroneous prefixes and |return|@>;
+ if tracing_commands>2 then if eTeX_ex then show_cur_cmd_chr;
+@z
+%---------------------------------------
+@x [49] m.1213 l.22686 - e-TeX protected
+if (cur_cmd<>def)and(a mod 4<>0) then
+@y
+if a>=8 then
+ begin j:=protected_token; a:=a-8;
+ end
+else j:=0;
+if (cur_cmd<>def)and((a mod 4<>0)or(j<>0)) then
+@z
+%---------------------------------------
+@x [49] m.1218 l.22749 - e-TeX protected
+ q:=scan_toks(true,e); define(p,call+(a mod 4),def_ref);
+@y
+ q:=scan_toks(true,e);
+ if j<>0 then
+ begin q:=get_avail; info(q):=j; link(q):=link(def_ref);
+ link(def_ref):=q;
+ end;
+ define(p,call+(a mod 4),def_ref);
+@z
+%---------------------------------------
+@x [49] m.1224 l.22840 - e-TeX sparse arrays
+ othercases begin scan_eight_bit_int;
+@y
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+@z
+%---------------------------------------
+@x [49] m.1225 l.22853 - e-TeX read_line
+read_to_cs: begin scan_int; n:=cur_val;
+@y
+read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1225 l.22861 - e-TeX read_line
+ p:=cur_cs; read_toks(n,p); define(p,call,cur_val);
+@y
+ p:=cur_cs; read_toks(n,p,j); define(p,call,cur_val);
+@z
+%---------------------------------------
+@x [49] m.1226 l.22870 - e-TeX sparse arrays
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@y
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true;
+ p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@z
+%---------------------------------------
+@x [49] m.1226 l.22880 - e-TeX sparse arrays
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+@y
+ begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+@z
+%---------------------------------------
+@x [49] m.1226 l.22888 - e-TeX sparse arrays
+ define(p,call,def_ref);
+@y
+ sa_define(p,def_ref)(p,call,def_ref);
+@z
+%---------------------------------------
+@x [49] m.1227 l.22893 - e-TeX sparse arrays
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+@y
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_ptr)
+ else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+@z
+%---------------------------------------
+@x [49] m.1236 l.23009 do_register_command - e-TeX sparse arrays
+begin q:=cur_cmd;
+@y
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@z
+%---------------------------------------
+@x [49] m.1236 l.23024 do_register_command - e-TeX sparse arrays
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+@y
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
+@z
+%---------------------------------------
+@x [49] m.1237 l.23046 - e-TeX sparse arrays
+p:=cur_chr; scan_eight_bit_int;
+@y
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+@z
+%---------------------------------------
+@x [49] m.1237 l.23053 - e-TeX sparse arrays
+end;
+found:
+@y
+ end;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=new_eqtb_int(l);
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+@z
+%---------------------------------------
+@x [49] m.1238 l.23059 - e-TeX sparse arrays
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@y
+ if q=advance then cur_val:=cur_val+w;
+@z
+%---------------------------------------
+@x [49] m.1239 l.23066 - e-TeX sparse arrays
+begin q:=new_spec(cur_val); r:=equiv(l);
+@y
+begin q:=new_spec(cur_val); r:=s;
+@z
+%---------------------------------------
+@x [49] m.1240 l.23086 - e-TeX sparse arrays
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+@y
+ if p=int_val then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin r:=new_spec(s);
+@z
+%---------------------------------------
+@x [49] m.1241 l.23108 - e-TeX sparse arrays
+set_box: begin scan_eight_bit_int;
+ if global then n:=number_regs+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+@y
+set_box: begin scan_register_num;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@z
+%---------------------------------------
+@x [49] m.1246 l.23179 alter_integer - e-TeX interaction_mode
+var c:0..1; {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+@y
+var c:small_number;
+ {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+@/@<Cases for |alter_integer|@>@/
+@z
+%---------------------------------------
+@x [49] m.1247 l.23188 alter_box_dimen - e-TeX sparse arrays
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+@y
+@!b:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1248 l.23197 - e-TeX penalties
+set_shape: begin scan_optional_equals; scan_int; n:=cur_val;
+ if n<=0 then p:=null
+@y
+set_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val;
+ if n<=0 then p:=null
+ else if q>par_shape_loc then
+ begin n:=(cur_val div 2)+1; p:=get_node(2*n+1); info(p):=n;
+ n:=cur_val; mem[p+1].int:=n; {number of penalties}
+ for j:=p+2 to p+n+1 do
+ begin scan_int; mem[j].int:=cur_val; {penalty values}
+ end;
+ if not odd(n) then mem[p+n+2].int:=0; {unused}
+ end
+@z
+%---------------------------------------
+@x [49] m.1248 l.23207 - e-TeX penalties
+ define(par_shape_loc,shape_ref,p);
+@y
+ define(q,shape_ref,p);
+@z
+%---------------------------------------
+@x [49] m.1292 l.23581 - e-TeX show_groups
+ show_lists:print_esc("showlists");
+@y
+ show_lists:print_esc("showlists");
+ @<Cases of |xray| for |print_cmd_chr|@>@;@/
+@z
+%---------------------------------------
+@x [49] m.1293 l.23588 show_whatever - e-TeX show_ifs
+var p:pointer; {tail of a token list to show}
+@y
+var p:pointer; {tail of a token list to show}
+@!t:small_number; {type of conditional being shown}
+@!m:normal..or_code; {upper bound on |fi_or_else| codes}
+@!l:integer; {line where that conditional began}
+@!n:integer; {level of \.{\\if...\\fi} nesting}
+@z
+%---------------------------------------
+@x [49] m.1293 l.23594 show_whatever - e-TeX show_groups
+othercases @<Show the current value of some parameter or register,
+@y
+@<Cases for |show_whatever|@>@;@/
+othercases @<Show the current value of some parameter or register,
+@z
+%---------------------------------------
+@x [49] m.1295 l.23629 - e-TeX protected
+call: print("macro");
+long_call: print_esc("long macro");
+outer_call: print_esc("outer macro");
+long_outer_call: begin print_esc("long"); print_esc("outer macro");
+@y
+call,long_call,outer_call,long_outer_call: begin n:=cmd-call;
+ if info(link(chr_code))=protected_token then n:=n+4;
+ if odd(n div 4) then print_esc("protected");
+ if odd(n) then print_esc("long");
+ if odd(n div 2) then print_esc("outer");
+ if n>0 then print_char(" ");
+ print("macro");
+@z
+%---------------------------------------
+@x [49] m.1296 l.23637 - e-TeX sparse arrays
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+@y
+begin scan_register_num; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+@z
+%---------------------------------------
+@x [50] m.1307 l.23779 - e-TeX basic
+dump_int(@$);@/
+@y
+dump_int(@$);@/
+@<Dump the \eTeX\ state@>@/
+@z
+%---------------------------------------
+@x [50] m.1308 l.23794 - e-TeX basic
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@y
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@/@<Undump the \eTeX\ state@>@/
+@z
+%---------------------------------------
+@x [50] m.1311 l.23848 - e-TeX sparse arrays
+dump_int(lo_mem_max); dump_int(rover);
+@y
+dump_int(lo_mem_max); dump_int(rover);
+if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+@z
+%---------------------------------------
+@x [50] m.1312 l.23871 - e-TeX sparse arrays
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+@y
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+if eTeX_ex then for k:=int_val to tok_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24065 - e-TeX hyph_codes
+dump_int(trie_max);
+@y
+dump_int(trie_max);
+dump_int(hyph_start);
+@z
+%---------------------------------------
+@x [50] m.1325 l.24093 - e-TeX hyph_codes
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+@y
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+undump(0)(j)(hyph_start);
+@z
+%---------------------------------------
+@x [51] m.1335 l.24313 final_cleanup - tracing
+ print_int(cur_level-level_one); print_char(")");
+@y
+ print_int(cur_level-level_one); print_char(")");
+ if eTeX_ex then show_save_groups;
+@z
+%---------------------------------------
+@x [51] m.1335 l.24336 final_cleanup - e-TeX marks, saved_items
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+@y
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+@z
+%---------------------------------------
+@x [51] m.1336 l.24345 ] m.1336 l.24340 init_prim - e-TeX basic
+begin no_new_control_sequence:=false;
+@y
+begin no_new_control_sequence:=false;
+first:=0;
+@z
+%---------------------------------------
+@x [51] m.1337 l.24360 - e-TeX basic
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+@<Enable \eTeX, if requested@>@;@/
+if (format_ident=0)or(buffer[loc]="&") then
+@z
+%---------------------------------------
+@x [51] m.1337 l.24368 - e-TeX basic
+ end;
+@y
+ end;
+if eTeX_ex then wterm_ln('entering extended mode');
+@z
+%---------------------------------------
+@x [53] m.1363 l.24715 - e-TeX hyph_codes
+adv_past(s)
+@y
+if subtype(s)=language_node then
+ begin cur_lang:=what_lang(s); l_hyf:=what_lhm(s); r_hyf:=what_rhm(s);
+ set_hyph_index;
+ end
+@z
+%---------------------------------------
+@x [54] m.1379 l.24903 - e-TeX additions
+@* \[54] System-dependent changes.
+@y
+@* \[53a] The extended features of \eTeX.
+The program has two modes of operation: (1)~In \TeX\ compatibility mode
+it fully deserves the name \TeX\ and there are neither extended features
+nor additional primitive commands. There are, however, a few
+modifications that would be legitimate in any implementation of \TeX\
+such as, e.g., preventing inadequate results of the glue to \.{DVI}
+unit conversion during |ship_out|. (2)~In extended mode there are
+additional primitive commands and the extended features of \eTeX\ are
+available.
+
+The distinction between these two modes of operation initially takes
+place when a `virgin' \.{eINITEX} starts without reading a format file.
+Later on the values of all \eTeX\ state variables are inherited when
+\.{eVIRTEX} (or \.{eINITEX}) reads a format file.
+
+The code below is designed to work for cases where `$|init|\ldots|tini|$'
+is a run-time switch.
+
+@<Enable \eTeX, if requested@>=
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+ begin no_new_control_sequence:=false;
+ @<Generate all \eTeX\ primitives@>@;
+ incr(loc); eTeX_mode:=1; {enter extended mode}
+ @<Initialize variables for \eTeX\ extended mode@>@;
+ end;
+tini@;@/
+if not no_new_control_sequence then {just entered extended mode ?}
+ no_new_control_sequence:=true@+else
+
+@ The \eTeX\ features available in extended mode are grouped into two
+categories: (1)~Some of them are permanently enabled and have no
+semantic effect as long as none of the additional primitives are
+executed. (2)~The remaining \eTeX\ features are optional and can be
+individually enabled and disabled. For each optional feature there is
+an \eTeX\ state variable named \.{\\...state}; the feature is enabled,
+resp.\ disabled by assigning a positive, resp.\ non-positive value to
+that integer.
+
+@d eTeX_state_base=int_base+eTeX_state_code
+@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable}
+@#
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+@d eTeX_revision_code=6 {command code for \.{\\eTeXrevision}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+eTeX_version_code: print_esc("eTeXversion");
+
+@ @<Cases for fetching an integer value@>=
+eTeX_version_code: cur_val:=eTeX_version;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+eTeX_revision_code: print_esc("eTeXrevision");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+eTeX_revision_code: do_nothing;
+
+@ @<Cases of `Print the result of command |c|'@>=
+eTeX_revision_code: print(eTeX_revision);
+
+@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?}
+
+@<Glob...@>=
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+
+@ @<Initialize table entries...@>=
+eTeX_mode:=0; {initially we are in compatibility mode}
+@<Initialize variables for \eTeX\ compatibility mode@>@;
+
+@ @<Dump the \eTeX\ state@>=
+dump_int(eTeX_mode);
+for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+
+@ @<Undump the \eTeX\ state@>=
+undump(0)(1)(eTeX_mode);
+if eTeX_ex then
+ begin @<Initialize variables for \eTeX\ extended mode@>@;
+ end
+else begin @<Initialize variables for \eTeX\ compatibility mode@>@;
+ end;
+
+@ The |eTeX_enabled| function simply returns its first argument as
+result. This argument is |true| if an optional \eTeX\ feature is
+currently enabled; otherwise, if the argument is |false|, the function
+gives an error message.
+
+@<Declare \eTeX\ procedures for use...@>=
+function eTeX_enabled(@!b:boolean;@!j:quarterword;@!k:halfword):boolean;
+begin if not b then
+ begin print_err("Improper "); print_cmd_chr(j,k);
+ help1("Sorry, this optional e-TeX feature has been disabled."); error;
+ end;
+eTeX_enabled:=b;
+end;
+
+@ First we implement the additional \eTeX\ parameters in the table of
+equivalents.
+
+@<Generate all \eTeX...@>=
+primitive("everyeof",assign_toks,every_eof_loc);
+@!@:every_eof_}{\.{\\everyeof} primitive@>
+primitive("tracingassigns",assign_int,int_base+tracing_assigns_code);@/
+@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@>
+primitive("tracinggroups",assign_int,int_base+tracing_groups_code);@/
+@!@:tracing_groups_}{\.{\\tracinggroups} primitive@>
+primitive("tracingifs",assign_int,int_base+tracing_ifs_code);@/
+@!@:tracing_ifs_}{\.{\\tracingifs} primitive@>
+primitive("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code);@/
+@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@>
+primitive("tracingnesting",assign_int,int_base+tracing_nesting_code);@/
+@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@>
+{ FIXME: the next two should be commented }
+primitive("predisplaydirection",
+ assign_int,int_base+pre_display_direction_code);@/
+@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@>
+primitive("lastlinefit",assign_int,int_base+last_line_fit_code);@/
+@!@:last_line_fit_}{\.{\\lastlinefit} primitive@>
+primitive("savingvdiscards",assign_int,int_base+saving_vdiscards_code);@/
+@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@>
+primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/
+@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@>
+
+@ @d every_eof==equiv(every_eof_loc)
+
+@<Cases of |assign_toks| for |print_cmd_chr|@>=
+every_eof_loc: print_esc("everyeof");
+
+@ @<Cases for |print_param|@>=
+tracing_assigns_code:print_esc("tracingassigns");
+tracing_groups_code:print_esc("tracinggroups");
+tracing_ifs_code:print_esc("tracingifs");
+tracing_scan_tokens_code:print_esc("tracingscantokens");
+tracing_nesting_code:print_esc("tracingnesting");
+{ FIXME: the next one should be commented }
+pre_display_direction_code:print_esc("predisplaydirection");
+last_line_fit_code:print_esc("lastlinefit");
+saving_vdiscards_code:print_esc("savingvdiscards");
+saving_hyph_codes_code:print_esc("savinghyphcodes");
+
+@ In order to handle \.{\\everyeof} we need an array |eof_seen| of
+boolean variables.
+
+@<Glob...@>=
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+
+@ The |print_group| procedure prints the current level of grouping and
+the name corresponding to |cur_group|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure print_group(@!e:boolean);
+label exit;
+begin case cur_group of
+ bottom_level: begin print("bottom level"); return;
+ end;
+ simple_group,semi_simple_group:
+ begin if cur_group=semi_simple_group then print("semi ");
+ print("simple");
+ end;
+ hbox_group,adjusted_hbox_group:
+ begin if cur_group=adjusted_hbox_group then print("adjusted ");
+ print("hbox");
+ end;
+ vbox_group: print("vbox");
+ vtop_group: print("vtop");
+ align_group,no_align_group:
+ begin if cur_group=no_align_group then print("no ");
+ print("align");
+ end;
+ output_group: print("output");
+ disc_group: print("disc");
+ insert_group: print("insert");
+ vcenter_group: print("vcenter");
+ math_group,math_choice_group,math_shift_group,math_left_group:
+ begin print("math");
+ if cur_group=math_choice_group then print(" choice")
+ else if cur_group=math_shift_group then print(" shift")
+ else if cur_group=math_left_group then print(" left");
+ end;
+ end; {there are no other cases}
+print(" group (level "); print_int(qo(cur_level)); print_char(")");
+if saved(-1)<>0 then
+ begin if e then print(" entered at line ") else print(" at line ");
+ print_int(saved(-1));
+ end;
+exit:end;
+
+@ The |group_trace| procedure is called when a new level of grouping
+begins (|e=false|) or ends (|e=true|) with |saved(-1)| containing the
+line number.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure group_trace(@!e:boolean);
+begin begin_diagnostic; print_char("{");
+if e then print("leaving ") else print("entering ");
+print_group(e); print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ The \.{\\currentgrouplevel} and \.{\\currentgrouptype} commands return
+the current level of grouping and the type of the current group
+respectively.
+
+@d current_group_level_code=eTeX_int+1 {code for \.{\\currentgrouplevel}}
+@d current_group_type_code=eTeX_int+2 {code for \.{\\currentgrouptype}}
+
+@<Generate all \eTeX...@>=
+primitive("currentgrouplevel",last_item,current_group_level_code);
+@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@>
+primitive("currentgrouptype",last_item,current_group_type_code);
+@!@:current_group_type_}{\.{\\currentgrouptype} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_group_level_code: print_esc("currentgrouplevel");
+current_group_type_code: print_esc("currentgrouptype");
+
+@ @<Cases for fetching an integer value@>=
+current_group_level_code: cur_val:=cur_level-level_one;
+current_group_type_code: cur_val:=cur_group;
+
+@ The \.{\\currentiflevel}, \.{\\currentiftype}, and
+\.{\\currentifbranch} commands return the current level of conditionals
+and the type and branch of the current conditional.
+
+@d current_if_level_code=eTeX_int+3 {code for \.{\\currentiflevel}}
+@d current_if_type_code=eTeX_int+4 {code for \.{\\currentiftype}}
+@d current_if_branch_code=eTeX_int+5 {code for \.{\\currentifbranch}}
+
+@<Generate all \eTeX...@>=
+primitive("currentiflevel",last_item,current_if_level_code);
+@!@:current_if_level_}{\.{\\currentiflevel} primitive@>
+primitive("currentiftype",last_item,current_if_type_code);
+@!@:current_if_type_}{\.{\\currentiftype} primitive@>
+primitive("currentifbranch",last_item,current_if_branch_code);
+@!@:current_if_branch_}{\.{\\currentifbranch} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_if_level_code: print_esc("currentiflevel");
+current_if_type_code: print_esc("currentiftype");
+current_if_branch_code: print_esc("currentifbranch");
+
+@ @<Cases for fetching an integer value@>=
+current_if_level_code: begin q:=cond_ptr; cur_val:=0;
+ while q<>null do
+ begin incr(cur_val); q:=link(q);
+ end;
+ end;
+current_if_type_code: if cond_ptr=null then cur_val:=0
+ else if cur_if<unless_code then cur_val:=cur_if+1
+ else cur_val:=-(cur_if-unless_code+1);
+current_if_branch_code:
+ if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1
+ else if if_limit=fi_code then cur_val:=-1
+ else cur_val:=0;
+
+@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and
+\.{\\fontcharic} commands return information about a character in a
+font.
+
+@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}}
+@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}}
+@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}}
+@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}}
+
+@<Generate all \eTeX...@>=
+primitive("fontcharwd",last_item,font_char_wd_code);
+@!@:font_char_wd_}{\.{\\fontcharwd} primitive@>
+primitive("fontcharht",last_item,font_char_ht_code);
+@!@:font_char_ht_}{\.{\\fontcharht} primitive@>
+primitive("fontchardp",last_item,font_char_dp_code);
+@!@:font_char_dp_}{\.{\\fontchardp} primitive@>
+primitive("fontcharic",last_item,font_char_ic_code);
+@!@:font_char_ic_}{\.{\\fontcharic} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+font_char_wd_code: print_esc("fontcharwd");
+font_char_ht_code: print_esc("fontcharht");
+font_char_dp_code: print_esc("fontchardp");
+font_char_ic_code: print_esc("fontcharic");
+
+@ @<Cases for fetching a dimension value@>=
+font_char_wd_code,
+font_char_ht_code,
+font_char_dp_code,
+font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
+ if (font_bc(q)<=cur_val)and(font_ec(q)>=cur_val) then
+ begin i:=char_info(q)(qi(cur_val));
+ case m of
+ font_char_wd_code: cur_val:=char_width(q)(i);
+ font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
+ font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
+ font_char_ic_code: cur_val:=char_italic(q)(i);
+ end; {there are no other cases}
+ end
+ else cur_val:=0;
+ end;
+
+@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength}
+commands return the indent and length parameters of the current
+\.{\\parshape} specification.
+
+@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}}
+@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}}
+@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}}
+
+@<Generate all \eTeX...@>=
+primitive("parshapelength",last_item,par_shape_length_code);
+@!@:par_shape_length_}{\.{\\parshapelength} primitive@>
+primitive("parshapeindent",last_item,par_shape_indent_code);
+@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@>
+primitive("parshapedimen",last_item,par_shape_dimen_code);
+@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+par_shape_length_code: print_esc("parshapelength");
+par_shape_indent_code: print_esc("parshapeindent");
+par_shape_dimen_code: print_esc("parshapedimen");
+
+@ @<Cases for fetching a dimension value@>=
+par_shape_length_code,
+par_shape_indent_code,
+par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int;
+ if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0
+ else begin if q=2 then
+ begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2;
+ end;
+ if cur_val>info(par_shape_ptr) then cur_val:=info(par_shape_ptr);
+ cur_val:=mem[par_shape_ptr+2*cur_val-q].sc;
+ end;
+ cur_val_level:=dimen_val;
+ end;
+
+@ The \.{\\showgroups} command displays all currently active grouping
+levels.
+
+@d show_groups=4 { \.{\\showgroups} }
+
+@<Generate all \eTeX...@>=
+primitive("showgroups",xray,show_groups);
+@!@:show_groups_}{\.{\\showgroups} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_groups:print_esc("showgroups");
+
+@ @<Cases for |show_whatever|@>=
+show_groups: begin begin_diagnostic; show_save_groups;
+ end;
+
+@ @<Types...@>=
+@!save_pointer=0..save_size; {index into |save_stack|}
+
+@ The modifications of \TeX\ required for the display produced by the
+|show_save_groups| procedure were first discussed by Donald~E. Knuth in
+{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990.
+@^Knuth, Donald Ervin@>
+
+In order to understand a group type we also have to know its mode.
+Since unrestricted horizontal modes are not associated with grouping,
+they are skipped when traversing the semantic nest.
+
+@<Declare \eTeX\ procedures for use...@>=
+procedure show_save_groups;
+label found1,found2,found,done;
+var p:0..nest_size; {index into |nest|}
+@!m:-mmode..mmode; {mode}
+@!v:save_pointer; {saved value of |save_ptr|}
+@!l:quarterword; {saved value of |cur_level|}
+@!c:group_code; {saved value of |cur_group|}
+@!a:-1..1; {to keep track of alignments}
+@!i:integer;
+@!j:quarterword;
+@!s:str_number;
+begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array}
+v:=save_ptr; l:=cur_level; c:=cur_group;
+save_ptr:=cur_boundary; decr(cur_level);@/
+a:=1;
+print_nl(""); print_ln;
+loop@+begin print_nl("### "); print_group(true);
+ if cur_group=bottom_level then goto done;
+ repeat m:=nest[p].mode_field;
+ if p>0 then decr(p) else m:=vmode;
+ until m<>hmode;
+ print(" (");
+ case cur_group of
+ simple_group: begin incr(p); goto found2;
+ end;
+ hbox_group,adjusted_hbox_group: s:="hbox";
+ vbox_group: s:="vbox";
+ vtop_group: s:="vtop";
+ align_group: if a=0 then
+ begin if m=-vmode then s:="halign" else s:="valign";
+ a:=1; goto found1;
+ end
+ else begin if a=1 then print("align entry") else print_esc("cr");
+ if p>=a then p:=p-a;
+ a:=0; goto found;
+ end;
+ no_align_group:
+ begin incr(p); a:=-1; print_esc("noalign"); goto found2;
+ end;
+ output_group:
+ begin print_esc("output"); goto found;
+ end;
+ math_group: goto found2;
+ disc_group,math_choice_group:
+ begin if cur_group=disc_group then print_esc("discretionary")
+ else print_esc("mathchoice");
+ for i:=1 to 3 do if i<=saved(-2) then print("{}");
+ goto found2;
+ end;
+ insert_group:
+ begin if saved(-2)=255 then print_esc("vadjust")
+ else begin print_esc("insert"); print_int(saved(-2));
+ end;
+ goto found2;
+ end;
+ vcenter_group: begin s:="vcenter"; goto found1;
+ end;
+ semi_simple_group: begin incr(p); print_esc("begingroup"); goto found;
+ end;
+ math_shift_group:
+ begin if m=mmode then print_char("$")
+ else if nest[p].mode_field=mmode then
+ begin print_cmd_chr(eq_no,saved(-2)); goto found;
+ end;
+ print_char("$"); goto found;
+ end;
+ math_left_group:
+ begin if type(nest[p+1].eTeX_aux_field)=left_noad then print_esc("left")
+ else print_esc("middle");
+ goto found;
+ end;
+ end; {there are no other cases}
+ @<Show the box context@>;
+ found1: print_esc(s); @<Show the box packaging info@>;
+ found2: print_char("{");
+ found: print_char(")"); decr(cur_level);
+ cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+ end;
+done: save_ptr:=v; cur_level:=l; cur_group:=c;
+end;
+
+@ @<Show the box packaging info@>=
+if saved(-2)<>0 then
+ begin print_char(" ");
+ if saved(-3)=exactly then print("to") else print("spread");
+ print_scaled(saved(-2)); print("pt");
+ end
+
+@ @<Show the box context@>=
+i:=saved(-4);
+if i<>0 then
+ if i<box_flag then
+ begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
+ if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
+ print_scaled(abs(i)); print("pt");
+ end
+ else if i<ship_out_flag then
+ begin if i>=global_box_flag then
+ begin print_esc("global"); i:=i-(global_box_flag-box_flag);
+ end;
+ print_esc("setbox"); print_int(i-box_flag); print_char("=");
+ end
+ else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
+
+@ The |scan_general_text| procedure is much like |scan_toks(false,false)|,
+but will be invoked via |expand|, i.e., recursively.
+@^recursion@>
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_general_text; forward;@t\2@>
+
+@ The token list (balanced text) created by |scan_general_text| begins
+at |link(temp_head)| and ends at |cur_val|. (If |cur_val=temp_head|,
+the list is empty.)
+
+@<Declare \eTeX\ procedures for tok...@>=
+procedure scan_general_text;
+label found;
+var s:normal..absorbing; {to save |scanner_status|}
+@!w:pointer; {to save |warning_index|}
+@!d:pointer; {to save |def_ref|}
+@!p:pointer; {tail of the token list being built}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!unbalance:halfword; {number of unmatched left braces}
+begin s:=scanner_status; w:=warning_index; d:=def_ref;
+scanner_status:=absorbing; warning_index:=cur_cs;
+def_ref:=get_avail; token_ref_count(def_ref):=null; p:=def_ref;
+scan_left_brace; {remove the compulsory left brace}
+unbalance:=1;
+loop@+ begin get_token;
+ if cur_tok<right_brace_limit then
+ if cur_cmd<right_brace then incr(unbalance)
+ else begin decr(unbalance);
+ if unbalance=0 then goto found;
+ end;
+ store_new_token(cur_tok);
+ end;
+found: q:=link(def_ref); free_avail(def_ref); {discard reference count}
+if q=null then cur_val:=temp_head @+ else cur_val:=p;
+link(temp_head):=q;
+scanner_status:=s; warning_index:=w; def_ref:=d;
+end;
+
+@ The \.{\\showtokens} command displays a token list.
+
+@d show_tokens=5 { \.{\\showtokens} , must be odd! }
+
+@<Generate all \eTeX...@>=
+primitive("showtokens",xray,show_tokens);
+@!@:show_tokens_}{\.{\\showtokens} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_tokens:print_esc("showtokens");
+
+@ The \.{\\unexpanded} primitive prevents expansion of tokens much as
+the result from \.{\\the} applied to a token variable. The
+\.{\\detokenize} primitive converts a token list into a list of
+character tokens much as if the token list were written to a file. We
+use the fact that the command modifiers for \.{\\unexpanded} and
+\.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe}
+are even.
+
+@<Generate all \eTeX...@>=
+primitive("unexpanded",the,1);@/
+@!@:unexpanded_}{\.{\\unexpanded} primitive@>
+primitive("detokenize",the,show_tokens);@/
+@!@:detokenize_}{\.{\\detokenize} primitive@>
+
+@ @<Cases of |the| for |print_cmd_chr|@>=
+else if chr_code=1 then print_esc("unexpanded")
+else print_esc("detokenize")
+
+@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>=
+if odd(cur_chr) then
+ begin c:=cur_chr; scan_general_text;
+ if c=1 then the_toks:=cur_val
+ else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
+ p:=get_avail; link(p):=link(temp_head);
+ token_show(p); flush_list(p);
+ selector:=old_setting; the_toks:=str_toks(b);
+ end;
+ return;
+ end
+
+@ The \.{\\showifs} command displays all currently active conditionals.
+
+@d show_ifs=6 { \.{\\showifs} }
+
+@<Generate all \eTeX...@>=
+primitive("showifs",xray,show_ifs);
+@!@:show_ifs_}{\.{\\showifs} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_ifs:print_esc("showifs");
+
+@
+@d print_if_line(#)==if #<>0 then
+ begin print(" entered on line "); print_int(#);
+ end
+
+@<Cases for |show_whatever|@>=
+show_ifs: begin begin_diagnostic; print_nl(""); print_ln;
+ if cond_ptr=null then
+ begin print_nl("### "); print("no active conditionals");
+ end
+ else begin p:=cond_ptr; n:=0;
+ repeat incr(n); p:=link(p);@+until p=null;
+ p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit;
+ repeat print_nl("### level "); print_int(n); print(": ");
+ print_cmd_chr(if_test,t);
+ if m=fi_code then print_esc("else");
+ print_if_line(l);
+ decr(n); t:=subtype(p); l:=if_line_field(p); m:=type(p); p:=link(p);
+ until p=null;
+ end;
+ end;
+
+@ The \.{\\interactionmode} primitive allows to query and set the
+interaction mode.
+
+@<Generate all \eTeX...@>=
+primitive("interactionmode",set_page_int,2);
+@!@:interaction_mode_}{\.{\\interactionmode} primitive@>
+
+@ @<Cases of |set_page_int| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("interactionmode")
+
+@ @<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>=
+else if m=2 then cur_val:=interaction
+
+@ @<Declare \eTeX\ procedures for use...@>=
+procedure@?new_interaction; forward;@t\2@>
+
+@ @<Cases for |alter_integer|@>=
+else if c=2 then
+ begin if (cur_val<batch_mode)or(cur_val>error_stop_mode) then
+ begin print_err("Bad interaction mode");
+@.Bad interaction mode@>
+ help2("Modes are 0=batch, 1=nonstop, 2=scroll, and")@/
+ ("3=errorstop. Proceed, and I'll ignore this case.");
+ int_error(cur_val);
+ end
+ else begin cur_chr:=cur_val; new_interaction;
+ end;
+ end
+
+@ The |middle| feature of \eTeX\ allows one ore several \.{\\middle}
+delimiters to appear between \.{\\left} and \.{\\right}.
+
+@<Generate all \eTeX...@>=
+primitive("middle",left_right,middle_noad);
+@!@:middle_}{\.{\\middle} primitive@>
+
+@ @<Cases of |left_right| for |print_cmd_chr|@>=
+else if chr_code=middle_noad then print_esc("middle")
+
+@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens}
+primitive.
+
+@<Generate all \eTeX...@>=
+primitive("scantokens",input,2);
+@!@:scan_tokens_}{\.{\\scantokens} primitive@>
+
+@ @<Cases of |input| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("scantokens")
+
+@ @<Cases for |input|@>=
+else if cur_chr=2 then pseudo_start
+
+@ The global variable |pseudo_files| is used to maintain a stack of
+pseudo files. The |info| field of each pseudo file points to a linked
+list of variable size nodes representing lines not yet processed: the
+|info| field of the first word contains the size of this node, all the
+following words contain ASCII codes.
+
+@<Glob...@>=
+@!pseudo_files:pointer; {stack of pseudo files}
+
+@ @<Set init...@>=
+pseudo_files:=null;
+
+@ The |pseudo_start| procedure initiates reading from a pseudo file.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?pseudo_start; forward;@t\2@>
+
+@ @<Declare \eTeX\ procedures for tok...@>=
+procedure pseudo_start;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!s:str_number; {string to be converted into a pseudo file}
+@!l,@!m:pool_pointer; {indices into |str_pool|}
+@!p,@!q,@!r:pointer; {for list construction}
+@!w: four_quarters; {four ASCII codes}
+@!nl,@!sz:integer;
+begin scan_general_text;
+old_setting:=selector; selector:=new_string;
+token_show(temp_head); selector:=old_setting;
+flush_list(link(temp_head));
+str_room(1); s:=make_string;
+@<Convert string |s| into a new pseudo file@>;
+flush_string;
+@<Initiate input from new pseudo file@>;
+end;
+
+@ @<Convert string |s| into a new pseudo file@>=
+str_pool[pool_ptr]:=si(" "); l:=str_start(s);
+nl:=si(new_line_char);
+p:=get_avail; q:=p;
+while l<pool_ptr do
+ begin m:=l;
+ while (l<pool_ptr)and(str_pool[l]<>nl) do incr(l);
+ sz:=(l-m+7)div 4;
+ if sz=1 then sz:=2;
+ r:=get_node(sz); link(q):=r; q:=r; info(q):=hi(sz);
+ while sz>2 do
+ begin decr(sz); incr(r);
+ w.b0:=qi(so(str_pool[m])); w.b1:=qi(so(str_pool[m+1]));
+ w.b2:=qi(so(str_pool[m+2])); w.b3:=qi(so(str_pool[m+3]));
+ mem[r].qqqq:=w; m:=m+4;
+ end;
+ w.b0:=qi(" "); w.b1:=qi(" "); w.b2:=qi(" "); w.b3:=qi(" ");
+ if l>m then
+ begin w.b0:=qi(so(str_pool[m]));
+ if l>m+1 then
+ begin w.b1:=qi(so(str_pool[m+1]));
+ if l>m+2 then
+ begin w.b2:=qi(so(str_pool[m+2]));
+ if l>m+3 then w.b3:=qi(so(str_pool[m+3]));
+ end;
+ end;
+ end;
+ mem[r+1].qqqq:=w;
+ if str_pool[l]=nl then incr(l);
+ end;
+info(p):=link(p); link(p):=pseudo_files; pseudo_files:=p
+
+@ @<Initiate input from new pseudo file@>=
+begin_file_reading; {set up |cur_file| and new level of input}
+line:=0; limit:=start; loc:=limit+1; {force line read}
+if tracing_scan_tokens>0 then
+ begin if term_offset>max_print_line-3 then print_ln
+ else if (term_offset>0)or(file_offset>0) then print_char(" ");
+ name:=19; print("( "); incr(open_parens); update_terminal;
+ end
+else name:=18
+
+@ Here we read a line from the current pseudo file into |buffer|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+function pseudo_input: boolean; {inputs the next line or returns |false|}
+var p:pointer; {current line from pseudo file}
+@!sz:integer; {size of node |p|}
+@!w:four_quarters; {four ASCII codes}
+@!r:pointer; {loop index}
+begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+p:=info(pseudo_files);
+if p=null then pseudo_input:=false
+else begin info(pseudo_files):=link(p); sz:=ho(info(p));
+ if 4*sz-3>=buf_size-last then
+ @<Report overflow of the input buffer, and abort@>;
+ last:=first;
+ for r:=p+1 to p+sz-1 do
+ begin w:=mem[r].qqqq;
+ buffer[last]:=w.b0; buffer[last+1]:=w.b1;
+ buffer[last+2]:=w.b2; buffer[last+3]:=w.b3;
+ last:=last+4;
+ end;
+ if last>=max_buf_stack then max_buf_stack:=last+1;
+ while (last>first)and(buffer[last-1]=" ") do decr(last);
+ free_node(p,sz);
+ pseudo_input:=true;
+ end;
+end;
+
+@ When we are done with a pseudo file we `close' it.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure pseudo_close; {close the top level pseudo file}
+var p,@!q: pointer;
+begin p:=link(pseudo_files); q:=info(pseudo_files);
+free_avail(pseudo_files); pseudo_files:=p;
+while q<>null do
+ begin p:=q; q:=link(p); free_node(p,ho(info(p)));
+ end;
+end;
+
+@ @<Dump the \eTeX\ state@>=
+while pseudo_files<>null do pseudo_close; {flush pseudo files}
+
+@ @<Generate all \eTeX...@>=
+primitive("readline",read_to_cs,1);@/
+@!@:read_line_}{\.{\\readline} primitive@>
+
+@ @<Cases of |read| for |print_cmd_chr|@>=
+else print_esc("readline")
+
+@ @<Handle \.{\\readline} and |goto done|@>=
+if j=1 then
+ begin while loc<=limit do {current line not yet finished}
+ begin cur_chr:=buffer[loc]; incr(loc);
+ if cur_chr=" " then cur_tok:=space_token
+ @+else cur_tok:=cur_chr+other_token;
+ store_new_token(cur_tok);
+ end;
+ goto done;
+ end
+
+@ Here we define the additional conditionals of \eTeX\ as well as the
+\.{\\unless} prefix.
+
+@d if_def_code=17 { `\.{\\ifdefined}' }
+@d if_cs_code=18 { `\.{\\ifcsname}' }
+@d if_font_char_code=19 { `\.{\\iffontchar}' }
+
+@<Generate all \eTeX...@>=
+primitive("unless",expand_after,1);@/
+@!@:unless_}{\.{\\unless} primitive@>
+primitive("ifdefined",if_test,if_def_code);
+@!@:if_defined_}{\.{\\ifdefined} primitive@>
+primitive("ifcsname",if_test,if_cs_code);
+@!@:if_cs_name_}{\.{\\ifcsname} primitive@>
+primitive("iffontchar",if_test,if_font_char_code);
+@!@:if_font_char_}{\.{\\iffontchar} primitive@>
+
+@ @<Cases of |expandafter| for |print_cmd_chr|@>=
+else print_esc("unless")
+
+@ @<Cases of |if_test| for |print_cmd_chr|@>=
+if_def_code:print_esc("ifdefined");
+if_cs_code:print_esc("ifcsname");
+if_font_char_code:print_esc("iffontchar");
+
+@ The result of a boolean condition is reversed when the conditional is
+preceded by \.{\\unless}.
+
+@<Negate a boolean conditional and |goto reswitch|@>=
+begin get_token;
+if (cur_cmd=if_test)and(cur_chr<>if_case_code) then
+ begin cur_chr:=cur_chr+unless_code; goto reswitch;
+ end;
+print_err("You can't use `"); print_esc("unless"); print("' before `");
+@.You can't use \\unless...@>
+print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+help1("Continue, and I'll forget that it ever happened.");
+back_error;
+end
+
+@ The conditional \.{\\ifdefined} tests if a control sequence is
+defined.
+
+We need to reset |scanner_status|, since \.{\\outer} control sequences
+are allowed, but we might be scanning a macro definition or preamble.
+
+@<Cases for |conditional|@>=
+if_def_code:begin save_scanner_status:=scanner_status;
+ scanner_status:=normal;
+ get_next; b:=(cur_cmd<>undefined_cs);
+ scanner_status:=save_scanner_status;
+ end;
+
+@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter}
+\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new
+control sequence will be entered into the hash table (once all tokens
+preceding the mandatory \.{\\endcsname} have been expanded).
+
+@<Cases for |conditional|@>=
+if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
+ repeat get_x_token;
+ if cur_cs=0 then store_new_token(cur_tok);
+ until cur_cs<>0;
+ if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
+ @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
+ flush_list(n);
+ b:=(eq_type(cur_cs)<>undefined_cs);
+ end;
+
+@ @<Look up the characters of list |n| in the hash table...@>=
+m:=first; p:=link(n);
+while p<>null do
+ begin if m>=max_buf_stack then
+ begin max_buf_stack:=m+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[m]:=info(p) mod @'400; incr(m); p:=link(p);
+ end;
+if m>first+1 then
+ cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|}
+else if m=first then cur_cs:=null_cs {the list is empty}
+else cur_cs:=single_base+buffer[first] {the list has length one}
+
+@ The conditional \.{\\iffontchar} tests the existence of a character in
+a font.
+
+@<Cases for |conditional|@>=
+if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
+ if (font_bc(n)<=cur_val)and(font_ec(n)>=cur_val) then
+ b:=char_exists(char_info(n)(qi(cur_val)))
+ else b:=false;
+ end;
+
+@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
+command for macro definitions. Such macros are protected against
+expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
+or during \.{\\write}.
+
+@<Generate all \eTeX...@>=
+primitive("protected",prefix,8);
+@!@:protected_}{\.{\\protected} primitive@>
+
+@ @<Cases of |prefix| for |print_cmd_chr|@>=
+else if chr_code=8 then print_esc("protected")
+
+@ The |get_x_or_protected| procedure is like |get_x_token| except that
+protected macros are not expanded.
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
+ and expands non-protected macros}
+label exit;
+begin loop@+begin get_token;
+ if cur_cmd<=max_command then return;
+ if (cur_cmd>=call)and(cur_cmd<end_template) then
+ if info(link(cur_chr))=protected_token then return;
+ expand;
+ end;
+exit:end;
+
+@ A group entered (or a conditional started) in one file may end in a
+different file. Such slight anomalies, although perfectly legitimate,
+may cause errors that are difficult to locate. In order to be able to
+give a warning message when such anomalies occur, \eTeX\ uses the
+|grp_stack| and |if_stack| arrays to record the initial |cur_boundary|
+and |cond_ptr| values for each input file.
+
+@<Glob...@>=
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+
+@ When a group ends that was apparently entered in a different input
+file, the |group_warning| procedure is invoked in order to update the
+|grp_stack|. If moreover \.{\\tracingnesting} is positive we want to
+give a warning message. The situation is, however, somewhat complicated
+by two facts: (1)~There may be |grp_stack| elements without a
+corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g.,
+error insertions from the terminal); and (2)~the relevant information is
+recorded in the |name_field| of the |input_stack| only loosely
+synchronized with the |in_open| variable indexing |grp_stack|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure group_warning;
+var i:0..max_in_open; {index into |grp_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ {store current state}
+i:=in_open; w:=false;
+while (grp_stack[i]=cur_boundary)and(i>0) do
+ begin @<Set variable |w| to indicate if this case should be reported@>;
+ grp_stack[i]:=save_index(save_ptr); decr(i);
+ end;
+if w then
+ begin print_nl("Warning: end of "); print_group(true);
+@.Warning: end of...@>
+ print(" of a different file"); print_ln;
+ if tracing_nesting>1 then show_context;
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+
+@ This code scans the input stack in order to determine the type of the
+current input file.
+
+@<Set variable |w| to...@>=
+if tracing_nesting>0 then
+ begin while (input_stack[base_ptr].state_field=token_list)or@|
+ (input_stack[base_ptr].index_field>i) do decr(base_ptr);
+ if input_stack[base_ptr].name_field>17 then w:=true;
+ end
+
+@ When a conditional ends that was apparently started in a different
+input file, the |if_warning| procedure is invoked in order to update the
+|if_stack|. If moreover \.{\\tracingnesting} is positive we want to
+give a warning message (with the same complications as above).
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure if_warning;
+var i:0..max_in_open; {index into |if_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ {store current state}
+i:=in_open; w:=false;
+while if_stack[i]=cond_ptr do
+ begin @<Set variable |w| to...@>;
+ if_stack[i]:=link(cond_ptr); decr(i);
+ end;
+if w then
+ begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if);
+@.Warning: end of...@>
+ print_if_line(if_line); print(" of a different file"); print_ln;
+ if tracing_nesting>1 then show_context;
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+
+@ Conversely, the |file_warning| procedure is invoked when a file ends
+and some groups entered or conditionals started while reading from that
+file are still incomplete.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure file_warning;
+var p:pointer; {saved value of |save_ptr| or |cond_ptr|}
+@!l:quarterword; {saved value of |cur_level| or |if_limit|}
+@!c:quarterword; {saved value of |cur_group| or |cur_if|}
+@!i:integer; {saved value of |if_line|}
+begin p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary;
+while grp_stack[in_open]<>save_ptr do
+ begin decr(cur_level);
+ print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+ print_group(true); print(" is incomplete");@/
+ cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+ end;
+save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values}
+p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line;
+while if_stack[in_open]<>cond_ptr do
+ begin print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+ print_cmd_chr(if_test,cur_if);
+ if if_limit=fi_code then print_esc("else");
+ print_if_line(if_line); print(" is incomplete");@/
+ if_line:=if_line_field(cond_ptr); cur_if:=subtype(cond_ptr);
+ if_limit:=type(cond_ptr); cond_ptr:=link(cond_ptr);
+ end;
+cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values}
+print_ln;
+if tracing_nesting>1 then show_context;
+if history=spotless then history:=warning_issued;
+end;
+
+@ Here are the additional \eTeX\ primitives for expressions.
+
+@<Generate all \eTeX...@>=
+primitive("numexpr",last_item,eTeX_expr-int_val+int_val);
+@!@:num_expr_}{\.{\\numexpr} primitive@>
+primitive("dimexpr",last_item,eTeX_expr-int_val+dimen_val);
+@!@:dim_expr_}{\.{\\dimexpr} primitive@>
+primitive("glueexpr",last_item,eTeX_expr-int_val+glue_val);
+@!@:glue_expr_}{\.{\\glueexpr} primitive@>
+primitive("muexpr",last_item,eTeX_expr-int_val+mu_val);
+@!@:mu_expr_}{\.{\\muexpr} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+eTeX_expr-int_val+int_val: print_esc("numexpr");
+eTeX_expr-int_val+dimen_val: print_esc("dimexpr");
+eTeX_expr-int_val+glue_val: print_esc("glueexpr");
+eTeX_expr-int_val+mu_val: print_esc("muexpr");
+
+@ This code for reducing |cur_val_level| and\slash or negating the
+result is similar to the one for all the other cases of
+|scan_something_internal|, with the difference that |scan_expr| has
+already increased the reference count of a glue specification.
+
+@<Process an expression and |return|@>=
+begin if m<eTeX_mu then
+ begin case m of
+ @/@<Cases for fetching a glue value@>@/
+ end; {there are no other cases}
+ cur_val_level:=glue_val;
+ end
+else if m<eTeX_expr then
+ begin case m of
+ @/@<Cases for fetching a mu value@>@/
+ end; {there are no other cases}
+ cur_val_level:=mu_val;
+ end
+else begin cur_val_level:=m-eTeX_expr+int_val; scan_expr;
+ end;
+while cur_val_level>level do
+ begin if cur_val_level=glue_val then
+ begin m:=cur_val; cur_val:=width(m); delete_glue_ref(m);
+ end
+ else if cur_val_level=mu_val then mu_error;
+ decr(cur_val_level);
+ end;
+if negative then
+ if cur_val_level>=glue_val then
+ begin m:=cur_val; cur_val:=new_spec(m); delete_glue_ref(m);
+ @<Negate all three glue components of |cur_val|@>;
+ end
+ else negate(cur_val);
+return;
+end
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_expr; forward;@t\2@>
+
+@ The |scan_expr| procedure scans and evaluates an expression.
+
+@<Declare procedures needed for expressions@>=
+@t\4@>@<Declare subprocedures for |scan_expr|@>
+procedure scan_expr; {scans and evaluates an expression}
+label restart, continue, found;
+var a,@!b:boolean; {saved values of |arith_error|}
+@!l:small_number; {type of expression}
+@!r:small_number; {state of expression so far}
+@!s:small_number; {state of term so far}
+@!o:small_number; {next operation or type of next factor}
+@!e:integer; {expression so far}
+@!t:integer; {term so far}
+@!f:integer; {current factor}
+@!n:integer; {numerator of combined multiplication and division}
+@!p:pointer; {top of expression stack}
+@!q:pointer; {for stack manipulations}
+begin l:=cur_val_level; a:=arith_error; b:=false; p:=null;
+@<Scan and evaluate an expression |e| of type |l|@>;
+if b then
+ begin print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+ help2("I can't evaluate this expression,")@/
+ ("since the result is out of range.");
+ error;
+ if l>=glue_val then
+ begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e);
+ end
+ else e:=0;
+ end;
+arith_error:=a; cur_val:=e; cur_val_level:=l;
+end;
+
+@ Evaluating an expression is a recursive process: When the left
+parenthesis of a subexpression is scanned we descend to the next level
+of recursion; the previous level is resumed with the matching right
+parenthesis.
+
+@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen}
+@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen}
+@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen}
+@d expr_mult=3 {$\langle\it term\rangle$ \.* seen}
+@d expr_div=4 {$\langle\it term\rangle$ \./ seen}
+@d expr_scale=5 {$\langle\it term\rangle$ \.*
+ $\langle\it factor\rangle$ \./ seen}
+
+@<Scan and eval...@>=
+restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0;
+continue: if s=expr_none then o:=l@+else o:=int_val;
+@<Scan a factor |f| of type |o| or start a subexpression@>;
+found: @<Scan the next operator and set |o|@>;
+arith_error:=b;
+@<Make sure that |f| is in the proper range@>;
+case s of @<Cases for evaluation of the current term@>@;
+end; {there are no other cases}
+if o>expr_sub then s:=o@+else @<Evaluate the current expression@>;
+b:=arith_error;
+if o<>expr_none then goto continue;
+if p<>null then @<Pop the expression stack and |goto found|@>
+
+@ @<Scan the next op...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"+" then o:=expr_add
+else if cur_tok=other_token+"-" then o:=expr_sub
+else if cur_tok=other_token+"*" then o:=expr_mult
+else if cur_tok=other_token+"/" then o:=expr_div
+else begin o:=expr_none;
+ if p=null then
+ begin if cur_cmd<>relax then back_input;
+ end
+ else if cur_tok<>other_token+")" then
+ begin print_err("Missing ) inserted for expression");
+@.Missing ) inserted@>
+ help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't.");
+ back_error;
+ end;
+ end
+
+@ @<Scan a factor...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"(" then
+ @<Push the expression stack and |goto restart|@>;
+back_input;
+if o=int_val then scan_int
+else if o=dimen_val then scan_normal_dimen
+else if o=glue_val then scan_normal_glue
+else scan_mu_glue;
+f:=cur_val
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_normal_glue; forward;@t\2@>@/
+procedure@?scan_mu_glue; forward;@t\2@>
+
+@ Here we declare to trivial procedures in order to avoid mutually
+recursive procedures with parameters.
+
+@<Declare procedures needed for expressions@>=
+procedure scan_normal_glue;
+begin scan_glue(glue_val);
+end;
+@#
+procedure scan_mu_glue;
+begin scan_glue(mu_val);
+end;
+
+@ Parenthesized subexpressions can be inside expressions, and this
+nesting has a stack. Seven local variables represent the top of the
+expression stack: |p| points to pushed-down entries, if any; |l|
+specifies the type of expression currently beeing evaluated; |e| is the
+expression so far and |r| is the state of its evaluation; |t| is the
+term so far and |s| is the state of its evaluation; finally |n| is the
+numerator for a combined multiplication and division, if any.
+
+@d expr_node_size=4 {number of words in stack entry for subexpressions}
+@d expr_e_field(#)==mem[#+1].int {saved expression so far}
+@d expr_t_field(#)==mem[#+2].int {saved term so far}
+@d expr_n_field(#)==mem[#+3].int {saved numerator}
+
+@<Push the expression...@>=
+begin q:=get_node(expr_node_size); link(q):=p; type(q):=l;
+subtype(q):=4*s+r;
+expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n;
+p:=q; l:=o; goto restart;
+end
+
+@ @<Pop the expression...@>=
+begin f:=e; q:=p;
+e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q);
+s:=subtype(q) div 4; r:=subtype(q) mod 4;
+l:=type(q); p:=link(q); free_node(q,expr_node_size);
+goto found;
+end
+
+@ We want to make sure that each term and (intermediate) result is in
+the proper range. Integer values must not exceed |infinity|
+($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen|
+($2^{30}-1$). We avoid the absolute value of an integer, because this
+might fail for the value $-2^{31}$ using 32-bit arithmetic.
+
+@d num_error(#)== {clear a number or dimension and set |arith_error|}
+ begin arith_error:=true; #:=0;
+ end
+@d glue_error(#)== {clear a glue spec and set |arith_error|}
+ begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue);
+ end
+
+@<Make sure that |f|...@>=
+if (l=int_val)or(s>expr_sub) then
+ begin if (f>infinity)or(f<-infinity) then num_error(f);
+ end
+else if l=dimen_val then
+ begin if abs(f)>max_dimen then num_error(f);
+ end
+else begin if (abs(width(f))>max_dimen)or@|
+ (abs(stretch(f))>max_dimen)or@|
+ (abs(shrink(f))>max_dimen) then glue_error(f);
+ end
+
+@ Applying the factor |f| to the partial term |t| (with the operator
+|s|) is delayed until the next operator |o| has been scanned. Here we
+handle the first factor of a partial term. A glue spec has to be copied
+unless the next operator is a right parenthesis; this allows us later on
+to simply modify the glue components.
+
+@d normalize_glue(#)==
+ if stretch(#)=0 then stretch_order(#):=normal;
+ if shrink(#)=0 then shrink_order(#):=normal
+
+@<Cases for evaluation of the current term@>=
+expr_none: if (l>=glue_val)and(o<>expr_none) then
+ begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t);
+ end
+ else t:=f;
+
+@ When a term |t| has been completed it is copied to, added to, or
+subtracted from the expression |e|.
+
+@d expr_add_sub(#)==add_or_sub(#,r=expr_sub)
+@d expr_a(#)==expr_add_sub(#,max_dimen)
+
+@<Evaluate the current expression@>=
+begin s:=expr_none;
+if r=expr_none then e:=t
+else if l=int_val then e:=expr_add_sub(e,t,infinity)
+else if l=dimen_val then e:=expr_a(e,t)
+else @<Compute the sum or difference of two glue specs@>;
+r:=o;
+end
+
+@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum
+(for |negative=false|) or difference (for |negative=true|) of |x| and
+|y|, provided the absolute value of the result does not exceed
+|max_answer|.
+
+@<Declare subprocedures for |scan_expr|@>=
+function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer;
+var a:integer; {the answer}
+begin if negative then negate(y);
+if x>=0 then
+ if y<=max_answer-x then a:=x+y@+else num_error(a)
+else if y>=-max_answer-x then a:=x+y@+else num_error(a);
+add_or_sub:=a;
+end;
+
+@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and
+|shrink_order(e)>normal| implies |shrink(e)<>0|.
+
+@<Compute the sum or diff...@>=
+begin width(e):=expr_a(width(e),width(t));
+if stretch_order(e)=stretch_order(t) then
+ stretch(e):=expr_a(stretch(e),stretch(t))
+else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then
+ begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t);
+ end;
+if shrink_order(e)=shrink_order(t) then
+ shrink(e):=expr_a(shrink(e),shrink(t))
+else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then
+ begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t);
+ end;
+delete_glue_ref(t); normalize_glue(e);
+end
+
+@ If a multiplication is followed by a division, the two operations are
+combined into a `scaling' operation. Otherwise the term |t| is
+multiplied by the factor |f|.
+
+@d expr_m(#)==#:=nx_plus_y(#,f,0)
+
+@<Cases for evaluation of the current term@>=
+expr_mult: if o=expr_div then
+ begin n:=f; o:=expr_scale;
+ end
+ else if l=int_val then t:=mult_integers(t,f)
+ else if l=dimen_val then expr_m(t)
+ else begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t));
+ end;
+
+@ Here we divide the term |t| by the factor |f|.
+
+@d expr_d(#)==#:=quotient(#,f)
+
+@<Cases for evaluation of the current term@>=
+expr_div: if l<glue_val then expr_d(t)
+ else begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t));
+ end;
+
+@ The function |quotient(n,d)| computes the rounded quotient
+$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive.
+
+@<Declare subprocedures for |scan_expr|@>=
+function quotient(@!n,@!d:integer):integer;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+begin if d=0 then num_error(a)
+else begin if d>0 then negative:=false
+ else begin negate(d); negative:=true;
+ end;
+ if n<0 then
+ begin negate(n); negative:=not negative;
+ end;
+ a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!}
+ if d+n>=0 then incr(a);
+ if negative then negate(a);
+ end;
+quotient:=a;
+end;
+
+@ Here the term |t| is multiplied by the quotient $n/f$.
+
+@d expr_s(#)==#:=fract(#,n,f,max_dimen)
+
+@<Cases for evaluation of the current term@>=
+expr_scale: if l=int_val then t:=fract(t,n,f,infinity)
+ else if l=dimen_val then expr_s(t)
+ else begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t));
+ end;
+
+@ Finally, the function |fract(x,n,d,max_answer)| computes the integer
+$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive
+and the result does not exceed |max_answer|. We can't use floating
+point arithmetic since the routine must produce identical results in all
+cases; and it would be too dangerous to multiply by~|n| and then divide
+by~|d|, in separate operations, since overflow might well occur. Hence
+this subroutine simulates double precision arithmetic, somewhat
+analogous to \MF's |make_fraction| and |take_fraction| routines.
+
+@d too_big=88 {go here when the result is too big}
+
+@<Declare subprocedures for |scan_expr|@>=
+function fract(@!x,@!n,@!d,@!max_answer:integer):integer;
+label found, found1, too_big, done;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+@!f:integer; {a proper fraction}
+@!h:integer; {smallest integer such that |2*h>=d|}
+@!r:integer; {intermediate remainder}
+@!t:integer; {temp variable}
+begin if d=0 then goto too_big;
+a:=0;
+if d>0 then negative:=false
+else begin negate(d); negative:=true;
+ end;
+if x<0 then
+ begin negate(x); negative:=not negative;
+ end
+else if x=0 then goto done;
+if n<0 then
+ begin negate(n); negative:=not negative;
+ end;
+t:=n div d;
+if t>max_answer div x then goto too_big;
+a:=t*x; n:=n-t*d;
+if n=0 then goto found;
+t:=x div d;
+if t>(max_answer-a) div n then goto too_big;
+a:=a+t*n; x:=x-t*d;
+if x=0 then goto found;
+if x<n then
+ begin t:=x; x:=n; n:=t;
+ end; {now |0<n<=x<d|}
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@;
+if f>(max_answer-a) then goto too_big;
+a:=a+f;
+found: if negative then negate(a);
+goto done;
+too_big: num_error(a);
+done: fract:=a;
+end;
+
+@ The loop here preserves the following invariant relations
+between |f|, |x|, |n|, and~|r|:
+(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$;
+(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$
+and $n$.
+
+Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|,
+because the latter could overflow.
+
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>=
+f:=0; r:=(d div 2)-d; h:=-r;
+loop@+begin if odd(n) then
+ begin r:=r+x;
+ if r>=0 then
+ begin r:=r-d; incr(f);
+ end;
+ end;
+ n:=n div 2;
+ if n=0 then goto found1;
+ if x<h then x:=x+x
+ else begin t:=x-d; x:=t+x; f:=f+n;
+ if x<n then
+ begin if x=0 then goto found1;
+ t:=x; x:=n; n:=t;
+ end;
+ end;
+ end;
+found1:
+
+@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and
+\.{\\glueshrinkorder} commands return the stretch and shrink components
+and their orders of ``infinity'' of a glue specification.
+
+@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}}
+@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}}
+@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}}
+@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}}
+
+@<Generate all \eTeX...@>=
+primitive("gluestretchorder",last_item,glue_stretch_order_code);
+@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@>
+primitive("glueshrinkorder",last_item,glue_shrink_order_code);
+@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@>
+primitive("gluestretch",last_item,glue_stretch_code);
+@!@:glue_stretch_}{\.{\\gluestretch} primitive@>
+primitive("glueshrink",last_item,glue_shrink_code);
+@!@:glue_shrink_}{\.{\\glueshrink} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+glue_stretch_order_code: print_esc("gluestretchorder");
+glue_shrink_order_code: print_esc("glueshrinkorder");
+glue_stretch_code: print_esc("gluestretch");
+glue_shrink_code: print_esc("glueshrink");
+
+@ @<Cases for fetching an integer value@>=
+glue_stretch_order_code, glue_shrink_order_code:
+ begin scan_normal_glue; q:=cur_val;
+ if m=glue_stretch_order_code then cur_val:=stretch_order(q)
+ else cur_val:=shrink_order(q);
+ delete_glue_ref(q);
+ end;
+
+@ @<Cases for fetching a dimension value@>=
+glue_stretch_code, glue_shrink_code:
+ begin scan_normal_glue; q:=cur_val;
+ if m=glue_stretch_code then cur_val:=stretch(q)
+ else cur_val:=shrink(q);
+ delete_glue_ref(q);
+ end;
+
+@ The \.{\\mutoglue} and \.{\\gluetomu} commands convert ``math'' glue
+into normal glue and vice versa; they allow to manipulate math glue with
+\.{\\gluestretch} etc.
+
+@d mu_to_glue_code=eTeX_glue {code for \.{\\mutoglue}}
+@d glue_to_mu_code=eTeX_mu {code for \.{\\gluetomu}}
+
+@<Generate all \eTeX...@>=
+primitive("mutoglue",last_item,mu_to_glue_code);
+@!@:mu_to_glue_}{\.{\\mutoglue} primitive@>
+primitive("gluetomu",last_item,glue_to_mu_code);
+@!@:glue_to_mu_}{\.{\\gluetomu} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+mu_to_glue_code: print_esc("mutoglue");
+glue_to_mu_code: print_esc("gluetomu");
+
+@ @<Cases for fetching a glue value@>=
+mu_to_glue_code: scan_mu_glue;
+
+@ @<Cases for fetching a mu value@>=
+glue_to_mu_code: scan_normal_glue;
+
+{ FIXME: next chapter is about sparse arrays; how does it cope with Omega? }
+
+@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
+dimen, skip, muskip, box, and token registers. As in \TeX\ the first
+256 registers of each kind are realized as arrays in the table of
+equivalents; the additional registers are realized as tree structures
+built from variable-size nodes with individual registers existing only
+when needed. Default values are used for nonexistent registers: zero
+for count and dimen values, |zero_glue| for glue (skip and muskip)
+values, void for boxes, and |null| for token lists (and current marks
+discussed below).
+
+Similarly there are 32768 mark classes; the command \.{\\marks}|n|
+creates a mark node for a given mark class |0<=n<=32767| (where
+\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
+the |fire_up| routine) and the |vsplit| routine maintain the current
+values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
+|split_bot_mark| for each mark class. They are accessed as
+\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
+\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
+are realized as |cur_mark| array. The additional current marks are
+again realized as tree structure with individual mark classes existing
+only when needed.
+
+@<Generate all \eTeX...@>=
+primitive("marks",mark,marks_code);
+@!@:marks_}{\.{\\marks} primitive@>
+primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
+@!@:top_marks_}{\.{\\topmarks} primitive@>
+primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
+@!@:first_marks_}{\.{\\firstmarks} primitive@>
+primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
+@!@:bot_marks_}{\.{\\botmarks} primitive@>
+primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
+@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
+primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
+@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
+
+@ The |scan_register_num| procedure scans a register number that must
+not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?scan_register_num; forward;@t\2@>
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>max_reg_num) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2(max_reg_help_line)("I changed this one to zero.");
+ int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Initialize variables for \eTeX\ comp...@>=
+max_reg_num:=255;
+max_reg_help_line:="A register number must be between 0 and 255.";
+
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+
+@ @<Glob...@>=
+@!max_reg_num: halfword; {largest allowed register number}
+@!max_reg_help_line: str_number; {first line of help message}
+
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@#
+@d index_node_size=9 {size of an index node}
+@d sa_index==type {a four-bit address or a type or both}
+@d sa_used==subtype {count of non-null pointers}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure new_index(@!i:quarterword; @!q:pointer);
+var k:small_number; {loop index}
+begin cur_ptr:=get_node(index_node_size); sa_index(cur_ptr):=i;
+sa_used(cur_ptr):=0; link(cur_ptr):=q;
+for k:=1 to index_node_size-1 do {clear all 16 pointers}
+ mem[cur_ptr+k]:=sa_null;
+end;
+
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then set_equiv(box_base+cur_val,#)@+else set_sa_box(#)
+@#
+
+{ FIXME: needs debugging (sparse arrays) }
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ Here we compute the pointer to the current mark of type |t| and mark
+class |cur_val|.
+
+@<Compute the mark pointer...@>=
+begin find_sa_element(mark_val,cur_val,false);
+if cur_ptr<>null then
+ if odd(t) then cur_ptr:=link(cur_ptr+(t div 2)+1)
+ else cur_ptr:=info(cur_ptr+(t div 2)+1);
+end
+
+@ The current marks for all mark classes are maintained by the |vsplit|
+and |fire_up| routines and are finally destroyed (for \.{INITEX} only)
+@.INITEX@>
+by the |final_cleanup| routine. Apart from updating the current marks
+when mark nodes are encountered, these routines perform certain actions
+on all existing mark classes. The recursive |do_marks| procedure walks
+through the whole tree or a subtree of existing mark class nodes and
+preforms certain actions indicted by its first parameter |a|, the action
+code. The second parameter |l| indicates the level of recursion (at
+most four); the third parameter points to a nonempty tree or subtree.
+The result is |true| if the complete tree or subtree has been deleted.
+
+@d vsplit_init==0 {action code for |vsplit| initialization}
+@d fire_up_init==1 {action code for |fire_up| initialization}
+@d fire_up_done==2 {action code for |fire_up| completion}
+@d destroy_marks==3 {action code for |final_cleanup|}
+@#
+@d sa_top_mark(#)==info(#+1) {\.{\\topmarks}|n|}
+@d sa_first_mark(#)==link(#+1) {\.{\\firstmarks}|n|}
+@d sa_bot_mark(#)==info(#+2) {\.{\\botmarks}|n|}
+@d sa_split_first_mark(#)==link(#+2) {\.{\\splitfirstmarks}|n|}
+@d sa_split_bot_mark(#)==info(#+3) {\.{\\splitbotmarks}|n|}
+
+@<Declare the function called |do_marks|@>=
+function do_marks(@!a,@!l:small_number;@!q:pointer):boolean;
+var i:small_number; {a four bit index}
+begin if l<4 then {|q| is an index node}
+ begin for i:=0 to 15 do
+ begin get_sa_ptr;
+ if cur_ptr<>null then if do_marks(a,l+1,cur_ptr) then delete_sa_ptr;
+ end;
+ if sa_used(q)=0 then
+ begin free_node(q,index_node_size); q:=null;
+ end;
+ end
+else {|q| is the node for a mark class}
+ begin case a of
+ @<Cases for |do_marks|@>@;
+ end; {there are no other cases}
+ if sa_bot_mark(q)=null then if sa_split_bot_mark(q)=null then
+ begin free_node(q,mark_class_node_size); q:=null;
+ end;
+ end;
+do_marks:=(q=null);
+end;
+
+@ At the start of the |vsplit| routine the existing |split_fist_mark|
+and |split_bot_mark| are discarded.
+
+@<Cases for |do_marks|@>=
+vsplit_init: if sa_split_first_mark(q)<>null then
+ begin delete_token_ref(sa_split_first_mark(q)); sa_split_first_mark(q):=null;
+ delete_token_ref(sa_split_bot_mark(q)); sa_split_bot_mark(q):=null;
+ end;
+
+@ We use again the fact that |split_first_mark=null| if and only if
+|split_bot_mark=null|.
+
+@<Update the current marks for |vsplit|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_split_first_mark(cur_ptr)=null then
+ begin sa_split_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end
+else delete_token_ref(sa_split_bot_mark(cur_ptr));
+sa_split_bot_mark(cur_ptr):=mark_ptr(p);
+add_token_ref(mark_ptr(p));
+end
+
+@ At the start of the |fire_up| routine the old |top_mark| and
+|first_mark| are discarded, whereas the old |bot_mark| becomes the new
+|top_mark|. An empty new |top_mark| token list is, however, discarded
+as well in order that mark class nodes can eventually be released. We
+use again the fact that |bot_mark<>null| implies |first_mark<>null|; it
+also knows that |bot_mark=null| implies |top_mark=first_mark=null|.
+
+@<Cases for |do_marks|@>=
+fire_up_init: if sa_bot_mark(q)<>null then
+ begin if sa_top_mark(q)<>null then delete_token_ref(sa_top_mark(q));
+ delete_token_ref(sa_first_mark(q)); sa_first_mark(q):=null;
+ if link(sa_bot_mark(q))=null then {an empty token list}
+ begin delete_token_ref(sa_bot_mark(q)); sa_bot_mark(q):=null;
+ end
+ else add_token_ref(sa_bot_mark(q));
+ sa_top_mark(q):=sa_bot_mark(q);
+ end;
+
+@ @<Cases for |do_marks|@>=
+fire_up_done: if (sa_top_mark(q)<>null)and(sa_first_mark(q)=null) then
+ begin sa_first_mark(q):=sa_top_mark(q); add_token_ref(sa_top_mark(q));
+ end;
+
+@ @<Update the current marks for |fire_up|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_first_mark(cur_ptr)=null then
+ begin sa_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end;
+if sa_bot_mark(cur_ptr)<>null then delete_token_ref(sa_bot_mark(cur_ptr));
+sa_bot_mark(cur_ptr):=mark_ptr(p); add_token_ref(mark_ptr(p));
+end
+
+@ Here we use the fact that the five current mark pointers in a mark
+class node occupy the same locations as the first five pointers of
+an index node. For systems using a run-time switch to distinguish
+between \.{VIRTEX} and \.{INITEX}, the codewords `$|init|\ldots|tini|$'
+surrounding the following piece of code should be removed.
+@.INITEX@>
+@^system dependencies@>
+
+@<Cases for |do_marks|@>=
+@!init destroy_marks: for i:=top_mark_code to split_bot_mark_code do
+ begin get_sa_ptr;
+ if cur_ptr<>null then
+ begin delete_token_ref(cur_ptr); put_sa_ptr(null);
+ end;
+ end;
+tini
+
+@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
+etc., as well as for references to sparse array elements defined by
+`\.{\\countdef}', etc.
+
+@<Cases of |register| for |print_cmd_chr|@>=
+begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
+ cmd:=sa_type(chr_code)
+else begin cmd:=chr_code-mem_bot; chr_code:=null;
+ end;
+if cmd=int_val then print_esc("count")
+else if cmd=dimen_val then print_esc("dimen")
+else if cmd=glue_val then print_esc("skip")
+else print_esc("muskip");
+if chr_code<>null then print_sa_num(chr_code);
+end
+
+@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
+well as for references to sparse array elements defined by
+`\.{\\toksdef}'.
+
+@<Cases of |toks_register| for |print_cmd_chr|@>=
+begin print_esc("toks");
+if chr_code<>mem_bot then print_sa_num(chr_code);
+end
+
+@ When a shorthand definition for an element of one of the sparse arrays
+is destroyed, we must reduce the reference count.
+
+@<Cases for |eq_destroy|@>=
+toks_register,register:
+ if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
+ delete_sa_ref(equiv_field(w));
+
+@ The task to maintain (change, save, and restore) register values is
+essentially the same when the register is realized as sparse array
+element or entry in |eqtb|. The global variable |sa_chain| is the head
+of a linked list of entries saved at the topmost level |sa_level|; the
+lists for lowel levels are kept in special save stack entries.
+
+@<Glob...@>=
+@!sa_chain: pointer; {chain of saved sparse array entries}
+@!sa_level: quarterword; {group level for |sa_chain|}
+
+@ @<Set init...@>=
+sa_chain:=null; sa_level:=level_zero;
+
+@ The individual saved items are kept in pointer or word nodes similar
+to those used for the array elements: a word node with value zero is,
+however, saved as pointer node with the otherwise impossible |sa_index|
+value |tok_val_limit|.
+
+@d sa_loc==sa_ref {location of saved item}
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+
+@ The procedure |sa_def| assigns a new value to sparse array elements,
+and saves the former value if appropriate. This procedure is used only
+for skip, muskip, box, and token list registers. The counterpart of
+|sa_def| for count and dimen registers is called |sa_w_def|.
+
+@d sa_define(#)==if e then
+ if global then gsa_def(#)@+else sa_def(#)
+ else define
+@#
+@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
+ begin find_sa_element(box_val,cur_val,true);
+ if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
+ end
+@#
+@d sa_word_define(#)==if e then
+ if global then gsa_w_def(#)@+else sa_w_def(#)
+ else word_define(#)
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_def(@!p:pointer;@!e:halfword);
+ {new data for sparse array elements}
+begin add_sa_ref(p);
+if sa_ptr(p)=e then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ sa_destroy(p);
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
+ sa_lev(p):=cur_level; sa_ptr(p):=e;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+@#
+procedure sa_w_def(@!p:pointer;@!w:integer);
+begin add_sa_ref(p);
+if sa_int(p)=w then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)<>cur_level then sa_save(p);
+ sa_lev(p):=cur_level; sa_int(p):=w;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+
+@ The |sa_def| and |sa_w_def| routines take care of local definitions.
+@^global definitions@>
+Global definitions are done in almost the same way, but there is no need
+to save old values, and the new value is associated with |level_one|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+@#
+procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_lev(p):=level_one; sa_int(p):=w;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+
+@ The |sa_restore| procedure restores the sparse array entries pointed
+at by |sa_chain|
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+
+{FIXME: |last_line_fit| might be incompatible with Omega}
+
+@ When the value of |last_line_fit| is positive, the last line of a
+(partial) paragraph is treated in a special way and we need additional
+fields in the active nodes.
+
+@d active_node_size_extended=5 {number of words in extended active nodes}
+@d active_short(#)==mem[#+3].sc {|shortfall| of this line}
+@d active_glue(#)==mem[#+4].sc {corresponding glue stretch or shrink}
+
+@<Glob...@>=
+@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph}
+@!do_last_line_fit:boolean; {special algorithm for last line of paragraph?}
+@!active_node_size:small_number; {number of words in active nodes}
+@!fill_width:array[0..2] of scaled; {infinite stretch components of
+ |par_fill_skip|}
+@!best_pl_short:array[very_loose_fit..tight_fit] of scaled; {|shortfall|
+ corresponding to |minimal_demerits|}
+@!best_pl_glue:array[very_loose_fit..tight_fit] of scaled; {corresponding
+ glue stretch or shrink}
+
+@ The new algorithm for the last line requires that the stretchability
+|par_fill_skip| is infinite and the stretchability of |left_skip| plus
+|right_skip| is finite.
+
+@<Check for special...@>=
+do_last_line_fit:=false; active_node_size:=active_node_size_normal;
+ {just in case}
+if last_line_fit>0 then
+ begin q:=glue_ptr(last_line_fill);
+ if (stretch(q)>0)and(stretch_order(q)>normal) then
+ if (background[3]=0)and(background[4]=0)and(background[5]=0) then
+ begin do_last_line_fit:=true;
+ active_node_size:=active_node_size_extended;
+ fill_width[0]:=0; fill_width[1]:=0; fill_width[2]:=0;
+ fill_width[stretch_order(q)-1]:=stretch(q);
+ end;
+ end
+
+@ @<Other local variables for |try_break|@>=
+@!g:scaled; {glue stretch or shrink of test line, adjustment for last line}
+
+@ Here we initialize the additional fields of the first active node
+representing the beginning of the paragraph.
+
+@<Initialize additional fields of the first active node@>=
+begin active_short(q):=0; active_glue(q):=0;
+end
+
+@ Here we compute the adjustment |g| and badness |b| for a line from |r|
+to the end of the paragraph. When any of the criteria for adjustment is
+violated we fall through to the normal algorithm.
+
+The last line must be too short, and have infinite stretch entirely due
+to |par_fill_skip|.
+
+@<Perform computations for last line and |goto found|@>=
+begin if (active_short(r)=0)or(active_glue(r)<=0) then goto not_found;
+ {previous line was neither stretched nor shrunk, or was infinitely bad}
+if (cur_active_width[3]<>fill_width[0])or@|
+ (cur_active_width[4]<>fill_width[1])or@|
+ (cur_active_width[5]<>fill_width[2]) then goto not_found;
+ {infinite stretch of this line not entirely due to |par_fill_skip|}
+if active_short(r)>0 then g:=cur_active_width[2]
+else g:=cur_active_width[6];
+if g<=0 then goto not_found; {no finite stretch resp.\ no shrink}
+arith_error:=false; g:=fract(g,active_short(r),active_glue(r),max_dimen);
+if last_line_fit<1000 then g:=fract(g,last_line_fit,1000,max_dimen);
+if arith_error then
+ if active_short(r)>0 then g:=max_dimen@+else g:=-max_dimen;
+if g>0 then
+ @<Set the value of |b| to the badness of the last line for stretching,
+ compute the corresponding |fit_class, and |goto found||@>
+else if g<0 then
+ @<Set the value of |b| to the badness of the last line for shrinking,
+ compute the corresponding |fit_class, and |goto found||@>;
+not_found:end
+
+@ These badness computations are rather similar to those of the standard
+algorithm, with the adjustment amount |g| replacing the |shortfall|.
+
+@<Set the value of |b| to the badness of the last line for str...@>=
+begin if g>shortfall then g:=shortfall;
+if g>7230584 then if cur_active_width[2]<1663497 then
+ begin b:=inf_bad; fit_class:=very_loose_fit; goto found;
+ end;
+b:=badness(g,cur_active_width[2]);
+if b>12 then
+ if b>99 then fit_class:=very_loose_fit
+ else fit_class:=loose_fit
+else fit_class:=decent_fit;
+goto found;
+end
+
+@ @<Set the value of |b| to the badness of the last line for shr...@>=
+begin if -g>cur_active_width[6] then g:=-cur_active_width[6];
+b:=badness(-g,cur_active_width[6]);
+if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
+goto found;
+end
+
+@ Vanishing values of |shortfall| and |g| indicate that the last line is
+not adjusted.
+
+@<Adjust \(t)the additional data for last line@>=
+begin if cur_p=null then shortfall:=0;
+if shortfall>0 then g:=cur_active_width[2]
+else if shortfall<0 then g:=cur_active_width[6]
+else g:=0;
+end
+
+@ For each feasible break we record the shortfall and glue stretch or
+shrink (or adjustment).
+
+@<Store \(a)additional data for this feasible break@>=
+begin best_pl_short[fit_class]:=shortfall; best_pl_glue[fit_class]:=g;
+end
+
+@ Here we save these data in the active node representing a potential
+line break.
+
+@<Store \(a)additional data in the new active node@>=
+begin active_short(q):=best_pl_short[fit_class];
+active_glue(q):=best_pl_glue[fit_class];
+end
+
+@ @<Print additional data in the new active node@>=
+begin print(" s="); print_scaled(active_short(q));
+if cur_p=null then print(" a=")@+else print(" g=");
+print_scaled(active_glue(q));
+end
+
+@ Here we either reset |do_last_line_fit| or adjust the |par_fill_skip|
+glue.
+
+@<Adjust \(t)the final line of the paragraph@>=
+if active_short(best_bet)=0 then do_last_line_fit:=false
+else begin q:=new_spec(glue_ptr(last_line_fill));
+ delete_glue_ref(glue_ptr(last_line_fill));
+ width(q):=width(q)+active_short(best_bet)-active_glue(best_bet);
+ stretch(q):=0; glue_ptr(last_line_fill):=q;
+ end
+
+@ When reading \.{\\patterns} while \.{\\savinghyphcodes} is positive
+the current |lc_code| values are stored together with the hyphenation
+patterns for the current language. They will later be used instead of
+the |lc_code| values for hyphenation purposes.
+
+The |lc_code| values are stored in the linked trie analogous to patterns
+$p_1$ of length~1, with |hyph_root=trie_r[0]| replacing |trie_root| and
+|lc_code(p_1)| replacing the |trie_op| code. This allows to compress
+and pack them together with the patterns with minimal changes to the
+existing code.
+
+@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|}
+
+@<Initialize table entries...@>=
+hyph_root:=0; hyph_start:=0;
+
+@ @<Store hyphenation codes for current language@>=
+begin c:=cur_lang; first_child:=false; p:=0;
+repeat q:=p; p:=trie_r[q];
+until (p=0)or(c<=so(trie_c[p]));
+if (p=0)or(c<so(trie_c[p])) then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>;
+q:=p; {now node |q| represents |cur_lang|}
+@<Store all current |lc_code| values@>;
+end
+
+@ We store all nonzero |lc_code| values, overwriting any previously
+stored values (and possibly wasting a few trie nodes that were used
+previously and are not needed now). We always store at least one
+|lc_code| value such that |hyph_index| (defined below) will not be zero.
+
+@<Store all current |lc_code| values@>=
+p:=trie_l[q]; first_child:=true;
+for c:=0 to 255 do
+ if (lc_code(c)>0)or((c=255)and first_child) then
+ begin if p=0 then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>
+ else trie_c[p]:=si(c);
+ trie_o[p]:=qi(lc_code(c));
+ q:=p; p:=trie_r[q]; first_child:=false;
+ end;
+if first_child then trie_l[q]:=0@+else trie_r[q]:=0
+
+@ We must avoid to ``take'' location~1, in order to distinguish between
+|lc_code| values and patterns.
+
+@<Pack all stored |hyph_codes|@>=
+begin if trie_root=0 then for p:=0 to 255 do trie_min[p]:=p+2;
+first_fit(hyph_root); trie_pack(hyph_root);
+hyph_start:=trie_ref[hyph_root];
+end
+
+@ The global variable |hyph_index| will point to the hyphenation codes
+for the current language.
+
+@d set_hyph_index== {set |hyph_index| for current language}
+ if trie_char(hyph_start+cur_lang)<>qi(cur_lang)
+ then hyph_index:=0 {no hyphenation codes for |cur_lang|}
+ else hyph_index:=trie_link(hyph_start+cur_lang)
+@#
+@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
+ if hyph_index=0 then hc[0]:=lc_code(#)
+ else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0
+ else hc[0]:=qo(trie_op(hyph_index+#))
+
+@<Glob...@>=
+@!hyph_start:trie_pointer; {root of the packed trie for |hyph_codes|}
+@!hyph_index:trie_pointer; {pointer to hyphenation codes for |cur_lang|}
+
+@ When |saving_vdiscards| is positive then the glue, kern, and penalty
+nodes removed by the page builder or by \.{\\vsplit} from the top of a
+vertical list are saved in special lists instead of being discarded.
+
+@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder}
+@d page_disc==disc_ptr[last_box_code] {first item removed by page builder}
+@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}}
+
+@<Glob...@>=
+@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers}
+
+@ @<Set init...@>=
+page_disc:=null; split_disc:=null;
+
+@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
+command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
+distinguished by their |chr_code| values |last_box_code| and
+|vsplit_code|. These |chr_code| values are larger than |box_code| and
+|copy_code|.
+
+@<Generate all \eTeX...@>=
+primitive("pagediscards",un_vbox,last_box_code);@/
+@!@:page_discards_}{\.{\\pagediscards} primitive@>
+primitive("splitdiscards",un_vbox,vsplit_code);@/
+@!@:split_discards_}{\.{\\splitdiscards} primitive@>
+
+@ @<Cases of |un_vbox| for |print_cmd_chr|@>=
+else if chr_code=last_box_code then print_esc("pagediscards")
+else if chr_code=vsplit_code then print_esc("splitdiscards")
+
+@ @<Handle saved items and |goto done|@>=
+begin link(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null;
+goto done;
+end
+
+@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
+and \.{\\displaywidowpenalties} commands allow to define arrays of
+penalty values to be used instead of the corresponding single values.
+
+@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc)
+@d club_penalties_ptr==equiv(club_penalties_loc)
+@d widow_penalties_ptr==equiv(widow_penalties_loc)
+@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc)
+
+@<Generate all \eTeX...@>=
+primitive("interlinepenalties",set_shape,inter_line_penalties_loc);@/
+@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@>
+primitive("clubpenalties",set_shape,club_penalties_loc);@/
+@!@:club_penalties_}{\.{\\clubpenalties} primitive@>
+primitive("widowpenalties",set_shape,widow_penalties_loc);@/
+@!@:widow_penalties_}{\.{\\widowpenalties} primitive@>
+primitive("displaywidowpenalties",set_shape,display_widow_penalties_loc);@/
+@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@>
+
+@ @<Cases of |set_shape| for |print_cmd_chr|@>=
+inter_line_penalties_loc: print_esc("interlinepenalties");
+club_penalties_loc: print_esc("clubpenalties");
+widow_penalties_loc: print_esc("widowpenalties");
+display_widow_penalties_loc: print_esc("displaywidowpenalties");
+
+@ @<Fetch a penalties array element@>=
+begin scan_int;
+if (equiv(m)=null)or(cur_val<0) then cur_val:=0
+else begin if cur_val>penalty(equiv(m)) then cur_val:=penalty(equiv(m));
+ cur_val:=penalty(equiv(m)+cur_val);
+ end;
+end
+
+@* \[54] System-dependent changes.
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/alephdir/eochar-rc1.ch b/Build/source/texk/web2c/alephdir/eochar-rc1.ch
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eochar-rc1.ch
diff --git a/Build/source/texk/web2c/alephdir/eochar-rc2.ch b/Build/source/texk/web2c/alephdir/eochar-rc2.ch
new file mode 100644
index 00000000000..8c6fba10ada
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eochar-rc2.ch
@@ -0,0 +1,158 @@
+% Fix the Omega \char<..> primitives
+%---------------------------------------
+@x
+@d assign_font_dimen=assign_mu_glue+1
+ {user-defined font dimension ( \.{\\fontdimen} )}
+@y
+@d assign_font_dimen=assign_mu_glue+1
+ {font dimension ( \.{\\fontdimen} ), \.{\\charwd}, \.{\\charht}, etc}
+@d font_dimen_code=0
+@d char_width_code=font_dimen_code+1
+@d char_height_code=char_width_code+1
+@d char_depth_code=char_height_code+1
+@d char_italic_code=char_depth_code+1
+@z
+%---------------------------------------
+@x [26] m.416 l.8407 - Omega char dimensions
+primitive("fontdimen",assign_font_dimen,0);@/
+@!@:font_dimen_}{\.{\\fontdimen} primitive@>
+@y
+primitive("fontdimen",assign_font_dimen,font_dimen_code);@/
+@!@:font_dimen_}{\.{\\fontdimen} primitive@>
+primitive("charwd",assign_font_dimen,char_width_code);@/
+@!@:char_width_}{\.{\\charwd} primitive@>
+primitive("charht",assign_font_dimen,char_height_code);@/
+@!@:char_height_}{\.{\\charht} primitive@>
+primitive("chardp",assign_font_dimen,char_depth_code);@/
+@!@:char_depth_}{\.{\\chardp} primitive@>
+primitive("charit",assign_font_dimen,char_italic_code);@/
+@!@:char_italic_}{\.{\\charit} primitive@>
+@z
+%---------------------------------------
+@x [26] m.416 l.8425 - Omega char dimensions
+assign_font_dimen: print_esc("fontdimen");
+@y
+assign_font_dimen: if chr_code=font_dimen_code then print_esc("fontdimen")
+else if chr_code=char_width_code then print_esc("charwd")
+else if chr_code=char_height_code then print_esc("charht")
+else if chr_code=char_depth_code then print_esc("chardp")
+else if chr_code=char_italic_code then print_esc("charit")
+else print("[unknown fontdimen code!]");
+@z
+%---------------------------------------
+@x CLEAN UP FROM OMEGA
+primitive("charwd",set_box_dimen,(width_offset+3));
+@!@:charwd_}{\.{\\charwd} primitive@>
+primitive("charht",set_box_dimen,(height_offset+3));
+@!@:charht_}{\.{\\charht} primitive@>
+primitive("chardp",set_box_dimen,(depth_offset+3));
+@!@:chardp_}{\.{\\chardp} primitive@>
+primitive("charit",set_box_dimen,(depth_offset+4));
+@!@:charit_}{\.{\\charit} primitive@>
+@y
+@z
+%---------------------------------------
+@x
+else if chr_code=(width_offset+3) then print_esc("charwd")
+else if chr_code=(height_offset+3) then print_esc("charht")
+else if chr_code=(depth_offset+3) then print_esc("chardp")
+else print_esc("charit");
+@y
+else print("[unknown box dimen!]");
+@z
+%---------------------------------------
+@x
+@ @<Fetch a box dimension@>=
+if m<=3 then
+begin
+ scan_register_num;
+ fetch_box(q);
+ if q=null then cur_val:=0 @+else
+ cur_val:=mem[q+m].sc;
+ cur_val_level:=dimen_val;
+end
+else
+begin
+ scan_char_num;
+ if m=(width_offset+3) then begin
+ cur_val:= char_width(main_f)(char_info(main_f)(cur_val))
+ end
+ else if m=(height_offset+3) then begin
+ cur_val:= char_height(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else if m=(depth_offset+3) then begin
+ cur_val:= char_depth(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else begin
+ cur_val:= char_italic(main_f)(char_info(main_f)(cur_val));
+ end;
+ cur_val_level:=dimen_val;
+end
+@y
+@ @<Fetch a box dimension@>=
+if m<=height_offset then begin
+ scan_register_num;
+ fetch_box(q);
+ if q=null then cur_val:=0 @+else
+ cur_val:=mem[q+m].sc;
+ cur_val_level:=dimen_val;
+end
+else begin
+ confusion("boxdimen");
+ { something wrong with the code ...}
+end
+@z
+%---------------------------------------
+@x [26] m.419 l.8461 - Omega char dimensions
+@ @<Fetch a font dimension@>=
+begin find_font_dimen(false);
+font_info(dimen_font)(font_file_size(dimen_font)).sc:=0;
+scanned_result(font_info(dimen_font)(cur_val).sc)(dimen_val);
+end
+@y
+@ @<Fetch a font dimension@>=
+if m=font_dimen_code then begin find_font_dimen(false);
+ font_info(dimen_font)(font_file_size(dimen_font)).sc:=0;
+ scanned_result(font_info(dimen_font)(cur_val).sc)(dimen_val);
+ end
+else
+ begin scan_char_num;
+ if m=char_width_code then begin
+ cur_val:= char_width(main_f)(char_info(main_f)(cur_val))
+ end
+ else if m=char_height_code then begin
+ cur_val:= char_height(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else if m=char_depth_code then begin
+ cur_val:= char_depth(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else if m=char_italic_code then begin
+ cur_val:= char_italic(main_f)(char_info(main_f)(cur_val));
+ end
+ else confusion("fontdimen");
+ cur_val_level:=dimen_val;
+ end
+@z
+%---------------------------------------
+@x
+assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen;
+ font_info(dimen_font)(k).sc:=cur_val;
+ end;
+@y
+assign_font_dimen: begin
+ n:=cur_chr;
+ if n=font_dimen_code then begin
+ find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen;
+ font_info(dimen_font)(k).sc:=cur_val;
+ end
+ else begin
+ print_err("Invalid dimension assignment");
+ help2("You tried to assign a character dimension.")@/
+ ("This is not allowed. Proceed; I'll ignore the assignment.");
+ error;
+ scan_char_num; scan_optional_equals; scan_normal_dimen;
+ end
+end;
+@z
diff --git a/Build/source/texk/web2c/alephdir/eocprt.ch b/Build/source/texk/web2c/alephdir/eocprt.ch
new file mode 100644
index 00000000000..6c82b5f26bd
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eocprt.ch
@@ -0,0 +1,11 @@
+@x
+wterm_ln('Copyright (c) 1994--2000 John Plaice and Yannis Haralambous');
+@y
+wterm_ln('Copyright (c) 2002--2004 the Aleph task force');
+@z
+@x
+print_nl("Copyright (c) 1994--2000 John Plaice and Yannis Haralambous");
+@y
+print_nl("Copyright (c) 2002--2004 the Aleph task force");
+@z
+
diff --git a/Build/source/texk/web2c/alephdir/eoeqtb.ch b/Build/source/texk/web2c/alephdir/eoeqtb.ch
new file mode 100644
index 00000000000..f2ce7917a57
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eoeqtb.ch
@@ -0,0 +1,23 @@
+% This changefile gets rid of all the remaining eqtb references
+% and fixes other similar issues
+% (hopefully ...)
+%----------------------------------------
+@x
+begin if eTeX_ex and(eqtb[p].int=w) then
+@y
+begin if eTeX_ex and(new_eqtb_int(p)=w) then
+@z
+%----------------------------------------
+% eomega.web line 29099
+@x
+@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable}
+@y
+@d eTeX_state(#)==new_eqtb_int(eTeX_state_base+#) {an \eTeX\ state variable}
+@z
+%----------------------------------------
+@x
+@d eTeX_revision_code=6 {command code for \.{\\eTeXrevision}}
+@y
+@d eTeX_revision_code=job_name_code+1 {command code for \.{\\eTeXrevision}}
+@z
+
diff --git a/Build/source/texk/web2c/alephdir/eoext.ch b/Build/source/texk/web2c/alephdir/eoext.ch
new file mode 100644
index 00000000000..f9afaa8db2c
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eoext.ch
@@ -0,0 +1,114 @@
+% vim ft=ch
+% Dealing with extended formats
+% and changing the last Omega references to Aleph
+@x
+@<Read the other strings from the \.{OMEGA.POOL} file and return |true|,
+@y
+@<Read the other strings from the \.{ALEPH.POOL} file and return |true|,
+@z
+%----------------------------------------
+@x
+else bad_pool('! I can''t read OMEGA.POOL.')
+@.I can't read OMEGA.POOL@>
+
+@ @<Read one string...@>=
+begin if eof(pool_file) then bad_pool('! OMEGA.POOL has no check sum.');
+@.OMEGA.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+if m='*' then @<Check the pool check sum@>
+else begin if (m<"0")or(m>"9")or@|
+ (n<"0")or(n>"9") then
+ bad_pool('! OMEGA.POOL line doesn''t begin with two digits.');
+@.OMEGA.POOL line doesn't...@>
+@y
+else bad_pool('! I can''t read ALEPH.POOL.')
+@.I can't read ALEPH.POOL@>
+
+@ @<Read one string...@>=
+begin if eof(pool_file) then bad_pool('! ALEPH.POOL has no check sum.');
+@.ALEPH.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+if m='*' then @<Check the pool check sum@>
+else begin if (m<"0")or(m>"9")or@|
+ (n<"0")or(n>"9") then
+ bad_pool('! ALEPH.POOL line doesn''t begin with two digits.');
+@.ALEPH.POOL line doesn't...@>
+@z
+%----------------------------------------
+@x
+ bad_pool('! OMEGA.POOL check sum doesn''t have nine digits.');
+@.OMEGA.POOL check sum...@>
+ a:=10*a+n-"0";
+ if k=9 then goto done;
+ incr(k); read(pool_file,n);
+ end;
+done: if a<>@$ then bad_pool('! OMEGA.POOL doesn''t match; OTANGLE me again.');
+@.OMEGA.POOL doesn't match@>
+@y
+ bad_pool('! ALEPH.POOL check sum doesn''t have nine digits.');
+@.ALEPH.POOL check sum...@>
+ a:=10*a+n-"0";
+ if k=9 then goto done;
+ incr(k); read(pool_file,n);
+ end;
+done: if a<>@$ then bad_pool('! ALEPH.POOL doesn''t match; OTANGLE me again.');
+@.ALEPH.POOL doesn't match@>
+@z
+%----------------------------------------
+@x
+print_err("Omega capacity exceeded, sorry [");
+@y
+print_err("Aleph capacity exceeded, sorry [");
+@z
+%----------------------------------------
+@x
+ print("Omega output, Version 3.141592--1.15, ");
+@y
+ print("Aleph output, Version 3.141592--1.15--2.1, ");
+@z
+%----------------------------------------
+@x
+ print_err("Patterns can be loaded only by INIOMEGA");
+@y
+ print_err("Patterns can be loaded only by INIALEPH");
+@z
+%----------------------------------------
+@x
+format_ident:=" (INIOMEGA)";
+@y
+format_ident:=" (INIALEPH)";
+@z
+%----------------------------------------
+@x
+ print_nl("(\dump is performed only by INIOMEGA)"); return;
+@:dump_}{\.{\\dump...only by INIOMEGA}@>
+@y
+ print_nl("(\dump is performed only by INIALEPH)"); return;
+@:dump_}{\.{\\dump...only by INIALEPH}@>
+@z
+%----------------------------------------
+@x
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+@y
+@!init if (buffer[loc]="*")and(format_ident=" (INIALEPH)") then
+@z
+%%% The following lines would let Aleph start in enhanced mode
+% %----------------------------------------
+% @x
+% incr(loc); eTeX_mode:=1; {enter extended mode}
+% @y
+% if (buffer[loc]="*") then incr(loc);
+% eTeX_mode:=1; {enter extended mode}
+% @z
+% %----------------------------------------
+% @x
+% eTeX_mode:=0; {initially we are in compatibility mode}
+% @y
+% eTeX_mode:=1; {initially we are in extended mode}
+% @z
+% %----------------------------------------
+% @x
+% for j:=0 to eTeX_states-1 do set_new_eqtb_int(eTeX_state_base+j,0); {disable all enhancements}
+% @y
+% for j:=0 to eTeX_states-1 do set_new_eqtb_int(eTeX_state_base+j,1); {enable all enhancements}
+% @z
diff --git a/Build/source/texk/web2c/alephdir/eofix.ch b/Build/source/texk/web2c/alephdir/eofix.ch
new file mode 100644
index 00000000000..b0492857d31
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eofix.ch
@@ -0,0 +1,6 @@
+% l. 8515
+@x
+ if (type(tail)<>math_node)or(subtype(tail)<>end_M_code) then
+@y
+ if (type(tail)<>math_node) then
+@z
diff --git a/Build/source/texk/web2c/alephdir/eofmt.ch b/Build/source/texk/web2c/alephdir/eofmt.ch
new file mode 100644
index 00000000000..183e9499fe7
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eofmt.ch
@@ -0,0 +1,6 @@
+% XOMEGA.WEB l.428
+@x
+@!pool_name='TeXformats:OMEGA.POOL ';
+@y
+@!pool_name='TeXformats:ALEPH.POOL ';
+@z
diff --git a/Build/source/texk/web2c/alephdir/eomega.ech b/Build/source/texk/web2c/alephdir/eomega.ech
new file mode 100644
index 00000000000..952bcac1497
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eomega.ech
@@ -0,0 +1,53 @@
+% This is `tex.ech' in text format as of Jan 14, 1998,
+% for web2c-7.0 and e-TeX Version 2.0;eNov23 as of Nov 25, 1997,
+% made by B. Raichle and P. Breitenlohner.
+% Copyright (C) 1994,97 by the NTS team; all rights are reserved.
+
+@x [51.1332] l.24203 (ca.) texarray
+ xmalloc_array (line_stack, max_in_open);
+@y
+ xmalloc_array (line_stack, max_in_open);
+ xmalloc_array (eof_seen, max_in_open);
+ xmalloc_array (grp_stack, max_in_open);
+ xmalloc_array (if_stack, max_in_open);
+@z
+
+@x [51.1337] l.24371 (ca.) texarray
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+ hyph_root:=0; hyph_start:=0;
+@z
+
+@x [53a.???] l.??? texarray
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+@y
+@!eof_seen : ^boolean; {has eof been seen?}
+@z
+
+@x [53a.???] l.??? texarray
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+@y
+@!grp_stack : ^save_pointer; {initial |cur_boundary|}
+@!if_stack : ^pointer; {initial |cond_ptr|}
+@z
+
+@x [53a.???] l.??? texarray
+hyph_root:=0; hyph_start:=0;
+@y
+@z
+
+% @x [54/web2c.???] l.??? needed earlier
+% replacement, but always existing character |font_bc[f]|.
+% @^inner loop@>
+%
+% @<Declare additional functions for ML\TeX@>=
+% function effective_char(@!err_p:boolean;
+% @y
+% replacement, but always existing character |font_bc[f]|.
+% @^inner loop@>
+%
+% @<Declare \eTeX\ procedures for sc...@>=
+% function effective_char(@!err_p:boolean;
+% @z
diff --git a/Build/source/texk/web2c/alephdir/eomem-rc1.ch b/Build/source/texk/web2c/alephdir/eomem-rc1.ch
new file mode 100644
index 00000000000..6bba75066b1
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eomem-rc1.ch
@@ -0,0 +1,321 @@
+% vim ft=ch
+% This file is part of the e-Omega project
+% Purpouse of this file: adapting e-TeX to Omega memory management
+% Most registers are reverted to the Omega model. The only exception
+% is markings.
+%---------------------------------------
+ @x eobase.ch l.672
+begin if eTeX_ex and(eqtb[p].int=w) then
+ @y
+begin if eTeX_ex and(new_eqtb_int(p)=w) then
+ @z
+%---------------------------------------
+@x eobase.ch l.1071
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else cur_val:=equiv(m);
+ cur_val_level:=tok_val;
+@y
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+@z
+%----------------------------------------
+@x l.1220
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+@y
+begin scan_eight_bit_int;
+case m of
+@z
+%---------------------------------------
+@x
+ end;
+@y
+cur_val_level:=m;
+@z
+%----------------------------------------
+@x l.1420
+ if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+@y
+ if eTeX_ex and(tracing_lost_chars>1) then set_new_eqtb_int(int_base+tracing_online_code,1);
+@z
+%----------------------------------------
+@x
+ tracing_online:=old_setting;
+@y
+ set_new_eqtb_int(int_base+tracing_online_code,old_setting);
+@z
+%----------------------------------------
+@x eobase.ch l.2309
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+@y
+if box_context<box_flag+number_regs then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box)
+@z
+%---------------------------------------
+@x eobase.ch l.2328
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+@y
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+@z
+%---------------------------------------
+@x eobase.ch l.2359
+begin scan_register_num; n:=cur_val;
+@y
+begin scan_eight_bit_int; n:=cur_val;
+@z
+%---------------------------------------
+@x eobase.ch l.2422
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+@y
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2431
+else begin link(tail):=list_ptr(p);
+change_box(null);
+@y
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@z
+%----------------------------------------
+@x eobase.ch l.2698
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+@y
+ othercases begin scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2726
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true;
+ p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@y
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@z
+%---------------------------------------
+@x eobase.ch l.2746
+ begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+@y
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+@z
+%---------------------------------------
+@x eobase.ch l.2754
+ sa_define(p,def_ref)(p,call,def_ref);
+@y
+ define(p,call,def_ref);
+@z
+%---------------------------------------
+@x eobase.ch l.2770
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_ptr)
+ else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+@y
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+@z
+%---------------------------------------
+@x eobase.ch l.2792
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@y
+begin q:=cur_cmd;
+@z
+%----------------------------------------
+@x eobase.ch l.2802
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
+@y
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2809
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+@y
+p:=cur_chr; scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2823
+ end;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=new_eqtb_int(l);
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+@y
+end;
+found:
+@z
+%---------------------------------------
+@x eobase.ch l.2832
+ if q=advance then cur_val:=cur_val+w;
+@y
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2838
+begin q:=new_spec(cur_val); r:=s;
+@y
+begin q:=new_spec(cur_val); r:=equiv(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2847
+ if p=int_val then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin r:=new_spec(s);
+@y
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+@z
+%---------------------------------------
+@x eobase.ch l.2859
+set_box: begin scan_register_num;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@y
+set_box: begin scan_eight_bit_int;
+ if global then n:=number_regs+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+@z
+%---------------------------------------
+@x eobase.ch l.2883
+@!b:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+@y
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1296 l.23637 - e-TeX sparse arrays
+begin scan_register_num; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+@y
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+@z
+%----------------------------------------
+@x eobase.ch l.2979
+if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+@y
+@z
+%----------------------------------------
+@x eobase.ch l.2986
+if eTeX_ex then for k:=int_val to tok_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+@y
+@z
+@x l. 3132
+for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+@y
+for j:=0 to eTeX_states-1 do set_new_eqtb_int(eTeX_state_base+j,0); {disable all enhancements}
+@z
diff --git a/Build/source/texk/web2c/alephdir/eomem-rc2.ch b/Build/source/texk/web2c/alephdir/eomem-rc2.ch
new file mode 100644
index 00000000000..dd91d3128be
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eomem-rc2.ch
@@ -0,0 +1,330 @@
+% vim ft=ch
+% This file is part of the e-Omega project
+% Purpouse of this file: adapting e-TeX to Omega memory management
+% Most registers are reverted to the Omega model. The only exception
+% is markings.
+%---------------------------------------
+ @x eobase.ch l.672
+begin if eTeX_ex and(eqtb[p].int=w) then
+ @y
+begin if eTeX_ex and(new_eqtb_int(p)=w) then
+ @z
+%---------------------------------------
+@x eobase.ch l.1071
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else cur_val:=equiv(m);
+ cur_val_level:=tok_val;
+@y
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+@z
+%----------------------------------------
+@x l.1220
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+@y
+begin scan_eight_bit_int;
+case m of
+@z
+%---------------------------------------
+@x
+ end;
+@y
+cur_val_level:=m;
+@z
+%----------------------------------------
+@x l.1420
+ if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+@y
+ if eTeX_ex and(tracing_lost_chars>1) then set_new_eqtb_int(int_base+tracing_online_code,1);
+@z
+%----------------------------------------
+@x
+ tracing_online:=old_setting;
+@y
+ set_new_eqtb_int(int_base+tracing_online_code,old_setting);
+@z
+%---------------------------------------
+@x l.2336
+@d global_box_flag==box_flag+(number_regs+number_regs) {context code for `\.{\\global\\setbox0}'}
+@d ship_out_flag==global_box_flag+1 {context code for `\.{\\shipout}'}
+@y
+@d global_box_flag==(box_flag+number_regs) {context code for `\.{\\global\\setbox0}'}
+@d max_global_box_flag==(global_box_flag+number_regs)
+@d ship_out_flag==(max_global_box_flag+1) {context code for `\.{\\shipout}'}
+@z
+%----------------------------------------
+@x eobase.ch l.2309
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+@y
+if box_context<global_box_flag then
+ eq_define(box_base+box_context-box_flag,box_ref,cur_box)
+else geq_define(box_base+box_context-global_box_flag,box_ref,cur_box)
+@z
+%---------------------------------------
+@x eobase.ch l.2328
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+@y
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+@z
+%---------------------------------------
+@x eobase.ch l.2359
+begin scan_register_num; n:=cur_val;
+@y
+begin scan_eight_bit_int; n:=cur_val;
+@z
+%---------------------------------------
+@x eobase.ch l.2422
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+@y
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2431
+else begin link(tail):=list_ptr(p);
+change_box(null);
+@y
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@z
+%----------------------------------------
+@x eobase.ch l.2698
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+@y
+ othercases begin scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2726
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true;
+ p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@y
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@z
+%---------------------------------------
+@x eobase.ch l.2746
+ begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+@y
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+@z
+%---------------------------------------
+@x eobase.ch l.2754
+ sa_define(p,def_ref)(p,call,def_ref);
+@y
+ define(p,call,def_ref);
+@z
+%---------------------------------------
+@x eobase.ch l.2770
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_ptr)
+ else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+@y
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+@z
+%---------------------------------------
+@x eobase.ch l.2792
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@y
+begin q:=cur_cmd;
+@z
+%----------------------------------------
+@x eobase.ch l.2802
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
+@y
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2809
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+@y
+p:=cur_chr; scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2823
+ end;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=new_eqtb_int(l);
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+@y
+end;
+found:
+@z
+%---------------------------------------
+@x eobase.ch l.2832
+ if q=advance then cur_val:=cur_val+w;
+@y
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2838
+begin q:=new_spec(cur_val); r:=s;
+@y
+begin q:=new_spec(cur_val); r:=equiv(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2847
+ if p=int_val then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin r:=new_spec(s);
+@y
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+@z
+%---------------------------------------
+@x eobase.ch l.2859
+set_box: begin scan_register_num;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@y
+set_box: begin scan_eight_bit_int;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@z
+%---------------------------------------
+@x eobase.ch l.2883
+@!b:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+@y
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1296 l.23637 - e-TeX sparse arrays
+begin scan_register_num; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+@y
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+@z
+%----------------------------------------
+@x eobase.ch l.2979
+if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+@y
+@z
+%----------------------------------------
+@x eobase.ch l.2986
+if eTeX_ex then for k:=int_val to tok_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+@y
+@z
+@x l. 3132
+for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+@y
+for j:=0 to eTeX_states-1 do set_new_eqtb_int(eTeX_state_base+j,0); {disable all enhancements}
+@z
diff --git a/Build/source/texk/web2c/alephdir/eomem-rc3.ch b/Build/source/texk/web2c/alephdir/eomem-rc3.ch
new file mode 100644
index 00000000000..c531d831006
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eomem-rc3.ch
@@ -0,0 +1,498 @@
+% vim ft=ch
+% This file is part of the e-Omega project
+% Purpouse of this file: adapting e-TeX to Omega memory management
+% Most registers are reverted to the Omega model. The only exception
+% is markings.
+%---------------------------------------
+@x l.571
+primitive("toks",toks_register,mem_bot);@/
+@y
+primitive("toks",toks_register,0);@/
+@z
+%---------------------------------------
+@x l.615
+toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>;
+@y
+toks_register: print_esc("toks");
+@z
+%---------------------------------------
+@x l.628
+interpreted in one of five ways:
+@y
+interpreted in one of four ways:
+@z
+%---------------------------------------
+@x l.634
+the entries for that group.
+Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
+source line number at which the current level of grouping was entered.
+
+\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a
+chain of sparse array entries to be restored at the end of the current
+group. Furthermore |save_index(p)| and |save_level(p)| should replace
+the values of |sa_chain| and |sa_level| respectively.
+@y
+the entries for that group.
+Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
+source line number at which the current level of grouping was entered.
+@z
+%---------------------------------------
+@x l.647
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@d restore_sa=4 {|save_type| when sparse array entries should be restored}
+
+@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
+@y
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+
+@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
+@z
+%---------------------------------------
+ @x eobase.ch l.672
+begin if eTeX_ex and(eqtb[p].int=w) then
+ @y
+begin if eTeX_ex and(new_eqtb_int(p)=w) then
+ @z
+%---------------------------------------
+@x l.686
+@/@<Cases for |eq_destroy|@>@/
+othercases do_nothing
+@y
+othercases do_nothing
+@z
+%---------------------------------------
+@x l.774
+ else if save_type(save_ptr)=restore_sa then
+ begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr);
+ end
+ else begin if save_type(save_ptr)=restore_old_value then
+@y
+ else begin if save_type(save_ptr)=restore_old_value then
+@z
+%---------------------------------------
+@x l.1065
+|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes
+cannot have these values)
+@y
+|glue_val|, or |mu_val|.
+@z
+%---------------------------------------
+@x l.1072
+primitive("count",register,mem_bot+int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,mem_bot+dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,mem_bot+glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mem_bot+mu_val);
+@y
+primitive("count",register,int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mu_val);
+@z
+%---------------------------------------
+@x l.1090
+register: @<Cases of |register| for |print_cmd_chr|@>;
+@y
+register: if chr_code=int_val then print_esc("count")
+ else if chr_code=dimen_val then print_esc("dimen")
+ else if chr_code=glue_val then print_esc("skip")
+ else print_esc("muskip");
+@z
+%---------------------------------------
+@x eobase.ch l.1114
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else cur_val:=equiv(m);
+ cur_val_level:=tok_val;
+@y
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+@z
+%---------------------------------------
+@x l.1173
+begin
+ scan_register_num;
+ fetch_box(q);
+ if q=null then cur_val:=0 @+else
+ cur_val:=mem[q+m].sc;
+@y
+begin
+ scan_eight_bit_int;
+ if box(cur_val)=null then cur_val:=0 @+else
+ cur_val:=mem[box(cur_val)+m].sc;
+@z
+%----------------------------------------
+@x l.1263
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+@y
+begin scan_eight_bit_int;
+case m of
+@z
+%---------------------------------------
+@x
+ end;
+@y
+cur_val_level:=m;
+@z
+%---------------------------------------
+@x l.1437
+begin scan_register_num; fetch_box(p);
+@y
+begin scan_eight_bit_int; p:=box(cur_val);
+@z
+%----------------------------------------
+@x l.1479
+ if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+@y
+ if eTeX_ex and(tracing_lost_chars>1) then set_new_eqtb_int(int_base+tracing_online_code,1);
+@z
+%----------------------------------------
+@x
+ tracing_online:=old_setting;
+@y
+ set_new_eqtb_int(int_base+tracing_online_code,old_setting);
+@z
+%---------------------------------------
+@x l.2188
+begin cur_val:=n; fetch_box(v); vdir:=box_dir(v);
+@y
+begin v:=box(n); vdir:=box_dir(v);
+@z
+%---------------------------------------
+@x l.2212
+if q<>null then q:=vpack(q,natural);
+change_box(q); {the |eq_level| of the box stays the same}
+@y
+if q=null then set_equiv(box_base+n,null)
+ {the |eq_level| of the box stays the same}
+else set_equiv(box_base+n,vpack(q,natural));
+@z
+%---------------------------------------
+@x l.2336
+@d global_box_flag==box_flag+(number_regs+number_regs) {context code for `\.{\\global\\setbox0}'}
+@d ship_out_flag==global_box_flag+1 {context code for `\.{\\shipout}'}
+@y
+@d ship_out_flag==box_flag+(number_regs+number_regs)
+ {context code for `\.{\\shipout}'}
+@z
+%---------------------------------------
+@x l.2344
+var p:pointer; {|ord_noad| for new box in math mode}
+@!a:small_number; {global prefix}
+@y
+var p:pointer; {|ord_noad| for new box in math mode}
+@z
+%----------------------------------------
+@x l.2351
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+@y
+if box_context<box_flag+number_regs then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box)
+@z
+%---------------------------------------
+@x l. 2367
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+@y
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+@z
+%---------------------------------------
+@x eobase.ch l.2359
+begin scan_register_num; n:=cur_val;
+@y
+begin scan_eight_bit_int; n:=cur_val;
+@z
+%---------------------------------------
+@x eobase.ch l.2467
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+@y
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2431
+else begin link(tail):=list_ptr(p);
+change_box(null);
+@y
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@z
+%----------------------------------------
+@x eobase.ch l.2743
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+@y
+ othercases begin scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2769
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true;
+ p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@y
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@z
+%---------------------------------------
+@x eobase.ch l.2789
+ begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+@y
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+@z
+%---------------------------------------
+@x eobase.ch l.2799
+ sa_define(p,def_ref)(p,call,def_ref);
+@y
+ define(p,call,def_ref);
+@z
+%---------------------------------------
+@x eobase.ch l.2805
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_ptr)
+ else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+@y
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+@z
+%---------------------------------------
+@x eobase.ch l.2792
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@y
+begin q:=cur_cmd;
+@z
+%----------------------------------------
+@x eobase.ch l.2802
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
+@y
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2809
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+@y
+p:=cur_chr; scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2823
+ end;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=new_eqtb_int(l);
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+@y
+end;
+found:
+@z
+%---------------------------------------
+@x eobase.ch l.2832
+ if q=advance then cur_val:=cur_val+w;
+@y
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2838
+begin q:=new_spec(cur_val); r:=s;
+@y
+begin q:=new_spec(cur_val); r:=equiv(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2847
+ if p=int_val then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin r:=new_spec(s);
+@y
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+@z
+%---------------------------------------
+@x eobase.ch l.2859
+set_box: begin scan_register_num;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@y
+set_box: begin scan_eight_bit_int;
+ if global then n:=number_regs+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+@z
+%---------------------------------------
+@x eobase.ch l.2925
+@!b:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+@y
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+@z
+%---------------------------------------
+@x l.2998
+begin scan_register_num; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+@y
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+@z
+%----------------------------------------
+@x eobase.ch l.3023
+if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+@y
+@z
+%----------------------------------------
+@x eobase.ch l.3030
+if eTeX_ex then for k:=int_val to tok_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+@y
+@z
+@x l. 3181
+for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+@y
+for j:=0 to eTeX_states-1 do set_new_eqtb_int(eTeX_state_base+j,0); {disable all enhancements}
+@z
+%----------------------------------------
+@x l.3558
+@ @<Show the box context@>=
+i:=saved(-4);
+if i<>0 then
+ if i<box_flag then
+ begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
+ if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
+ print_scaled(abs(i)); print("pt");
+ end
+ else if i<ship_out_flag then
+ begin if i>=global_box_flag then
+ begin print_esc("global"); i:=i-(global_box_flag-box_flag);
+ end;
+ print_esc("setbox"); print_int(i-box_flag); print_char("=");
+ end
+ else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
+@y
+@ @<Show the box context@>=
+i:=saved(-4);
+if i<>0 then
+ if i<box_flag then
+ begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
+ if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
+ print_scaled(abs(i)); print("pt");
+ end
+ else if i<ship_out_flag then
+ begin if i>=box_flag+number_regs then
+ begin print_esc("global"); i:=i-number_regs;
+ end;
+ print_esc("setbox"); print_int(i-box_flag); print_char("=");
+ end
+ else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
+@z
diff --git a/Build/source/texk/web2c/alephdir/eonewdir-rc1.ch b/Build/source/texk/web2c/alephdir/eonewdir-rc1.ch
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eonewdir-rc1.ch
diff --git a/Build/source/texk/web2c/alephdir/eonewdir-rc2.ch b/Build/source/texk/web2c/alephdir/eonewdir-rc2.ch
new file mode 100644
index 00000000000..9cdab96ab09
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eonewdir-rc2.ch
@@ -0,0 +1,52 @@
+% Backport some 1.23 dir primitives to 1.15
+% namely, \boxdir
+% NOT \nextfakemath, which requires too many changes
+
+@x
+@d assign_dir=register+1 {(\.{\\pagedir}, \.{\\textdir})}
+@d max_internal=assign_dir
+ {the largest code that can follow \.{\\the}}
+@y
+@d assign_next_fake_math=register+1 {(\.{\\nextfakemath})} {unused}
+@d assign_box_dir=register+2 {(\.{\\boxdir})}
+@d assign_dir=register+3 {(\.{\\pagedir}, \.{\\textdir})}
+@d max_internal=assign_dir
+ {the largest code that can follow \.{\\the}}
+@z
+
+@x
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_dir: scanned_result(new_eqtb_int(m))(dir_val);
+@y
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_box_dir: begin
+ scan_eight_bit_int;
+ m:=cur_val;
+ if box(m)<>null then cur_val:=box_dir(box(m))
+ else cur_val:=0;
+ cur_val_level:=dir_val;
+ end;
+assign_dir: scanned_result(new_eqtb_int(m))(dir_val);
+@z
+
+@x [47] m.1071
+primitive("xleaders",leader_ship,x_leaders);
+@!@:x_leaders_}{\.{\\xleaders} primitive@>
+@y
+primitive("xleaders",leader_ship,x_leaders);
+@!@:x_leaders_}{\.{\\xleaders} primitive@>
+primitive("boxdir",assign_box_dir,0);
+@!@:box_dir}{\.{\\boxdir} primitive@>
+@z
+
+@x [47] m.1073
+any_mode(make_box): begin_box(0);
+@y
+any_mode(make_box): begin_box(0);
+any_mode(assign_box_dir): begin scan_eight_bit_int;
+ cur_box:=box(cur_val);
+ scan_optional_equals; scan_dir;
+ if cur_box<>null then box_dir(cur_box):=cur_val;
+ end;
+@z
+
diff --git a/Build/source/texk/web2c/alephdir/eopage-rc1.ch b/Build/source/texk/web2c/alephdir/eopage-rc1.ch
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eopage-rc1.ch
diff --git a/Build/source/texk/web2c/alephdir/eopage-rc2.ch b/Build/source/texk/web2c/alephdir/eopage-rc2.ch
new file mode 100644
index 00000000000..d55cc6a154c
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eopage-rc2.ch
@@ -0,0 +1,180 @@
+% vim ft=ch
+% Fix page dimension bugs
+% TODO : not there yet for BLB?
+@x
+emergency_stretch_code:print_esc("emergencystretch");
+othercases print("[unknown dimen parameter!]")
+endcases;
+end;
+@y
+emergency_stretch_code:print_esc("emergencystretch");
+page_width_code:print_esc("pagewidth");
+page_height_code:print_esc("pageheight");
+page_right_offset_code:print_esc("pagerightoffset");
+page_bottom_offset_code:print_esc("pagebottomoffset");
+othercases print("[unknown dimen parameter!]")
+endcases;
+end;
+@z
+
+@x
+@ @<Ship box |p| out@>=
+@<Update the values of |max_h| and |max_v|; but if the page is too large,
+ |goto done|@>;
+@<Initialize variables as |ship_out| begins@>;
+page_loc:=dvi_offset+dvi_ptr;
+dvi_out(bop);
+for k:=0 to 9 do dvi_four(count(k));
+dvi_four(last_bop); last_bop:=page_loc;
+dvi_direction:=page_direction;
+case box_direction(dvi_direction) of
+dir_TL_,dir_LT_: begin
+ end;
+dir_TR_,dir_RT_: begin
+ dvi_right(page_right_offset);
+ end;
+dir_RB_,dir_BR_: begin
+ dvi_right(page_right_offset);
+ dvi_down(page_bottom_offset);
+ end;
+dir_BL_,dir_LB_: begin
+ dvi_down(page_bottom_offset);
+ end;
+end;
+cur_h:=h_offset;
+cur_v:=height(p)+v_offset;
+case box_direction(dvi_direction) of
+dir_TL_: begin
+ dvi_down(cur_v);
+ dvi_right(cur_h);
+ end;
+dir_TR_: begin
+ dvi_down(cur_v);
+ dvi_right(-cur_h);
+ end;
+dir_LT_: begin
+ dvi_right(cur_v);
+ dvi_down(cur_h);
+ end;
+dir_LB_: begin
+ dvi_right(cur_v);
+ dvi_down(-cur_h);
+ end;
+dir_BL_: begin
+ dvi_down(-cur_v);
+ dvi_right(cur_h);
+ end;
+dir_BR_: begin
+ dvi_down(-cur_v);
+ dvi_right(-cur_h);
+ end;
+dir_RT_: begin
+ dvi_right(-cur_v);
+ dvi_down(cur_h);
+ end;
+dir_RB_: begin
+ dvi_right(-cur_v);
+ dvi_down(-cur_h);
+ end;
+end;
+dvi_h:=cur_h;
+dvi_v:=cur_v;
+temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+done:
+
+@y
+@ @<Ship box |p| out@>=
+@<Update the values of |max_h| and |max_v|; but if the page is too large,
+ |goto done|@>;
+@<Initialize variables as |ship_out| begins@>;
+page_loc:=dvi_offset+dvi_ptr;
+dvi_out(bop);
+for k:=0 to 9 do dvi_four(count(k));
+dvi_four(last_bop); last_bop:=page_loc;
+dvi_direction:=page_direction;
+case box_direction(dvi_direction) of
+dir_TL_,dir_LT_: begin
+ end;
+dir_TR_,dir_RT_: begin
+ dvi_right(page_width-page_right_offset);
+ dvi_h:=-page_right_offset;
+ end;
+dir_RB_,dir_BR_: begin
+ dvi_right(page_width-page_right_offset);
+ dvi_down(page_height-page_bottom_offset);
+ dvi_h:=-page_right_offset;
+ dvi_v:=-page_bottom_offset;
+ end;
+dir_BL_,dir_LB_: begin
+ dvi_down(page_height-page_bottom_offset);
+ dvi_v:=-page_bottom_offset;
+ end;
+end;
+cur_h:=h_offset;
+cur_v:=height(p)+v_offset;
+case box_direction(dvi_direction) of
+dir_TL_: begin
+ dvi_right(cur_h);
+ dvi_down(cur_v);
+ end;
+dir_TR_: begin
+ dvi_right(-cur_h);
+ dvi_down(cur_v);
+ end;
+dir_LT_: begin
+ dvi_right(cur_v);
+ dvi_down(cur_h);
+ end;
+dir_LB_: begin
+ dvi_right(cur_v);
+ dvi_down(-cur_h);
+ end;
+dir_BL_: begin
+ dvi_right(cur_h);
+ dvi_down(-cur_v);
+ end;
+dir_BR_: begin
+ dvi_right(-cur_h);
+ dvi_down(-cur_v);
+ end;
+dir_RT_: begin
+ dvi_right(-cur_v);
+ dvi_down(cur_h);
+ end;
+dir_RB_: begin
+ dvi_right(-cur_v);
+ dvi_down(-cur_h);
+ end;
+end;
+temp_ptr:=p;
+dvi_h:=dvi_h+cur_h;
+dvi_v:=dvi_v+cur_v;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+done:
+
+@z
+
+@x
+set_new_eqtb_sc(dimen_base+page_bottom_offset_code,page_height-9472573);
+ {-2 inches}
+set_new_eqtb_sc(dimen_base+page_right_offset_code,page_width-9472573);
+ {-2 inches}
+@y
+set_new_eqtb_sc(dimen_base+page_bottom_offset_code,4736287); {1 inch}
+set_new_eqtb_sc(dimen_base+page_right_offset_code,4736287); {1 inch}
+@z
+
+@x
+{
+|primitive("pagerightoffset",assign_dimen,dimen_base+page_right_offset_code);|
+|primitive("pagebottomoffset",assign_dimen,dimen_base+page_bottom_offset_code);|
+}
+@y
+primitive("pagerightoffset",assign_dimen,dimen_base+page_right_offset_code);
+primitive("pagebottomoffset",assign_dimen,dimen_base+page_bottom_offset_code);
+@z
+
+
diff --git a/Build/source/texk/web2c/alephdir/eover-rc1.ch b/Build/source/texk/web2c/alephdir/eover-rc1.ch
new file mode 100644
index 00000000000..f1545177a82
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eover-rc1.ch
@@ -0,0 +1,21 @@
+@x
+@d banner=='This is Aleph, Version 3.141592--1.15--2.1' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.141592--1.15--2.1' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@#
+@d eTeX_banner=='This is Aleph, Version ',eTeX_version_string
+ {printed when \eTeX\ starts}
+@y
+@d banner=='This is Aleph, Version 3.141592--1.15--2.1 (RC1)' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.141592--1.15--2.1 (RC1)' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@d Aleph_version=0 { \.{\\Alephversion} } {TODO: make accessible}
+@d Aleph_revision==".2 (RC1)" { \.{\\Alephrevision} } {TODO: make accessible}
+@#
+@d eTeX_banner==banner
+ {printed when \eTeX\ starts}
+@z
diff --git a/Build/source/texk/web2c/alephdir/eover-rc2.ch b/Build/source/texk/web2c/alephdir/eover-rc2.ch
new file mode 100644
index 00000000000..d43b817c88c
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eover-rc2.ch
@@ -0,0 +1,230 @@
+% Aleph version-specific stuff;
+% * we define the banner and everything to be
+% Aleph specific (with Aleph version numbering
+% added to the sequence --yes, I know it sucks)
+% * we add both \eTeX-like and \OMEGA-like
+% commands to display the version
+@x
+@d banner=='This is Aleph, Version 3.141592--1.15--2.1' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.141592--1.15--2.1' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@#
+@d eTeX_banner=='This is Aleph, Version ',eTeX_version_string
+ {printed when \eTeX\ starts}
+@y
+@d eTeX_version_banner=='2.1' {current \eTeX\ version}
+@d Omega_version_banner=='1.15' {current \Omega\ version}
+@d Aleph_version_banner=='0.0-rc4' {current \Aleph\ version}
+@d eTeX_version_string=="2.1" {current \eTeX\ version}
+@d Omega_version_string=="1.15" { \.{\\OmegaVersion} }
+@d Aleph_version_string=="0.0" { \.{\\AlephVersion} }
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d Omega_version=1 { \.{\\Omegaversion} }
+@d Aleph_version=0 { \.{\\Alephversion} }
+@d eTeX_minor_version=1 { \.{\\eTeXminorversion} }
+@d Omega_minor_version=15 { \.{\\Omegaminorversion} }
+@d Aleph_minor_version=0 { \.{\\Alephminorversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@d Omega_revision==".15" { \.{\\Omegarevision} }
+@d Aleph_revision==".0" { \.{\\Alephrevision} }
+@#
+@d banner=='This is Aleph, Version 3.141592-',Omega_version_banner,'-',eTeX_version_banner,'-',Aleph_version_banner {printed when \TeX\ starts}
+@d eTeX_banner==banner
+ {printed when \eTeX\ starts}
+@z
+
+% === Aleph history ===
+%----------------------------------------
+% Version: 0.0 (RC0)
+% Internal name: the successfull merge
+% Achievement: main executable that would run
+% Release date: 20030131
+%----------------------------------------
+% Version: 0.0 (RC1)
+% Internal name: the successfull trip (NOT)
+% Achievement: fixed the major 'trip' bug
+% making Aleph usable for
+% production use
+% Release date: 20030511
+%----------------------------------------
+% Version: 0.0 (RC2)
+% Internal name: the name change
+% Achievement: add \boxdir
+% add versioning info
+% add version-retrieving commands
+% fix \overfullrule>0pt
+% fix \charit
+% fix non-TLT text offset
+% fix leaders crashing or stalling
+% Release date: 20040322
+%----------------------------------------
+% Version: 0.0 (RC3)
+% Internal name: Oh Tea Peas
+% Achievement: fix some OTP/OCP-related bugs
+% Release date: 20040609
+%----------------------------------------
+% Version: 0.0 (RC4)
+% Internal name: Nothing really
+% Achievement: adapt to latest web2c changes
+% Release date: 20040909
+%----------------------------------------
+
+@x
+@d eTeX_int=glue_val+4 {first of \eTeX\ codes for integers}
+@y
+@d Aleph_int=glue_val+4 {first of \Aleph\ codes for integers}
+@d Aleph_int_num=5 {number of \Aleph\ integers}
+@d eTeX_int=Aleph_int+Aleph_int_num {first of \eTeX\ codes for integers}
+@z
+
+@x
+@d omega_code=5 {command code for \.{\\OmegaVersion}}
+@d job_name_code=6 {command code for \.{\\jobname}}
+@y
+@d etex_code=5 {command code for \.{\\eTeXVersion}}
+@d omega_code=6 {command code for \.{\\OmegaVersion}}
+@d aleph_code=7 {command code for \.{\\AlephVersion}}
+@d job_name_code=8 {command code for \.{\\jobname}}
+@z
+
+@x
+primitive("OmegaVersion",convert,omega_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+@y
+primitive("eTeXVersion",convert,etex_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+primitive("OmegaVersion",convert,omega_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+primitive("AlephVersion",convert,aleph_code);@/
+@!@:aleph_version_}{\.{\\AlephVersion} primitive@>
+@z
+
+% NOTE: we also put jobname in its own
+% field. Why was it not put there?
+@x
+ omega_code: print_esc("OmegaVersion");
+ @/@<Cases of |convert| for |print_cmd_chr|@>@/
+ othercases print_esc("jobname")
+@y
+ etex_code: print_esc("eTeXVersion");
+ omega_code: print_esc("OmegaVersion");
+ aleph_code: print_esc("AlephVersion");
+ job_name_code: print_esc("jobname");
+ @/@<Cases of |convert| for |print_cmd_chr|@>@/
+ othercases print_esc("???")
+@z
+
+@x
+omega_code:;
+job_name_code: if job_name=0 then open_log_file;
+@y
+etex_code: do_nothing;
+omega_code: do_nothing;
+aleph_code: do_nothing;
+job_name_code: if job_name=0 then open_log_file;
+@z
+
+@x
+omega_code: print("1.15");
+job_name_code: print(job_name);
+@y
+etex_code: print(eTeX_version_string);
+omega_code: print(Omega_version_string);
+aleph_code: print(Aleph_version_string);
+job_name_code: print(job_name);
+@z
+
+@x
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+@d eTeX_revision_code=job_name_code+1 {command code for \.{\\eTeXrevision}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+eTeX_version_code: print_esc("eTeXversion");
+
+@ @<Cases for fetching an integer value@>=
+eTeX_version_code: cur_val:=eTeX_version;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+eTeX_revision_code: print_esc("eTeXrevision");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+eTeX_revision_code: do_nothing;
+
+@ @<Cases of `Print the result of command |c|'@>=
+eTeX_revision_code: print(eTeX_revision);
+@y
+@d Aleph_version_code=Aleph_int {code for \.{\\Alephversion}}
+@d Omega_version_code=Aleph_int+1 {code for \.{\\Omegaversion}}
+@d Aleph_minor_version_code=Aleph_int+2 {code for \.{\\Alephminorversion}}
+@d Omega_minor_version_code=Aleph_int+3 {code for \.{\\Omegaminorversion}}
+@d eTeX_minor_version_code=Aleph_int+4 {code for \.{\\eTeXminorversion}}
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+@d Aleph_revision_code=job_name_code+1 {command code for \.{\\Alephrevision}}
+@d Omega_revision_code=job_name_code+2 {command code for \.{\\Omegarevision}}
+@d eTeX_revision_code=job_name_code+3 {command code for \.{\\eTeXrevision}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("Alephversion",last_item,Aleph_version_code);
+@!@:eTeX_version_}{\.{\\Alephversion} primitive@>
+primitive("Omegaversion",last_item,Omega_version_code);
+@!@:eTeX_version_}{\.{\\Omegaversion} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("Alephminorversion",last_item,Aleph_minor_version_code);
+@!@:eTeX_minor_version_}{\.{\\Alephminorversion} primitive@>
+primitive("Omegaminorversion",last_item,Omega_minor_version_code);
+@!@:eTeX_minor_version_}{\.{\\Omegaminorversion} primitive@>
+primitive("eTeXminorversion",last_item,eTeX_minor_version_code);
+@!@:eTeX_minor_version_}{\.{\\eTeXminorversion} primitive@>
+primitive("Alephrevision",convert,Aleph_revision_code);@/
+@!@:eTeX_revision_}{\.{\\Alephrevision} primitive@>
+primitive("Omegarevision",convert,Omega_revision_code);@/
+@!@:eTeX_revision_}{\.{\\Omegarevision} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+Aleph_version_code: print_esc("Alephversion");
+Omega_version_code: print_esc("Omegaversion");
+eTeX_version_code: print_esc("eTeXversion");
+Aleph_minor_version_code: print_esc("Alephminorversion");
+Omega_minor_version_code: print_esc("Omegaminorversion");
+eTeX_minor_version_code: print_esc("eTeXminorversion");
+
+@ @<Cases for fetching an integer value@>=
+Aleph_version_code: cur_val:=Aleph_version;
+Omega_version_code: cur_val:=Omega_version;
+eTeX_version_code: cur_val:=eTeX_version;
+Aleph_minor_version_code: cur_val:=Aleph_minor_version;
+Omega_minor_version_code: cur_val:=Omega_minor_version;
+eTeX_minor_version_code: cur_val:=eTeX_minor_version;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+Aleph_revision_code: print_esc("Alephrevision");
+Omega_revision_code: print_esc("Omegarevision");
+eTeX_revision_code: print_esc("eTeXrevision");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+Aleph_revision_code: do_nothing;
+Omega_revision_code: do_nothing;
+eTeX_revision_code: do_nothing;
+
+@ @<Cases of `Print the result of command |c|'@>=
+Aleph_revision_code: print(Aleph_revision);
+Omega_revision_code: print(Omega_revision);
+eTeX_revision_code: print(eTeX_revision);
+@z
diff --git a/Build/source/texk/web2c/alephdir/etex.ch b/Build/source/texk/web2c/alephdir/etex.ch
new file mode 100644
index 00000000000..318fa959b0e
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/etex.ch
@@ -0,0 +1,6176 @@
+% This is etex.ch in text format, as of January 31, 1999.
+% WEB change file containing code for various features extending TeX;
+% to be applied to tex.web (Version 3.14159) in order to define the
+% e-TeX program.
+
+% e-TeX is copyright (C) 1994,98 by the NTS team; all rights are reserved.
+% Copying of this file is authorized only if (1) you are a member of the
+% NTS team, or if (2) you make absolutely no changes to your copy.
+% (Programs such as PATCHWEB, TIE, or WEBMERGE allow the application of
+% several change files to tex.web; the master files tex.web and etex.ch
+% should stay intact.)
+
+% See etex_gen.tex for hints on how to install this program.
+% And see etripman.tex for details about how to validate it.
+
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+% e-TeX and NTS are trademarks of the NTS group.
+
+% All line numbers refer to TEX.WEB 3.14159 as of March 21, 1995.
+
+@x limbo l.1 - this is e-TeX
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+% Copying of this file is authorized only if (1) you are D. E. Knuth, or if
+% (2) you make absolutely no changes to your copy. (The WEB system provides
+% for alterations via an auxiliary file; the master file should stay intact.)
+% See Appendix H of the WEB manual for hints on how to install this program.
+% And see Appendix A of the TRIP manual for details about how to validate it.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+@y
+% e-TeX is copyright (C) 1994,98 by the NTS team; all rights are reserved.
+% Copying of this file is authorized only if (1) you are a member of the
+% NTS team, or if (2) you make absolutely no changes to your copy.
+% (Programs such as PATCHWEB, TIE, or WEBMERGE allow the application of
+% several change files to tex.web; the master files tex.web and etex.ch
+% should stay intact.)
+
+% See etex_gen.tex for hints on how to install this program.
+% And see etripman.tex for details about how to validate it.
+
+% e-TeX and NTS are trademarks of the NTS group.
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+
+% This program is directly derived from Donald E. Knuth's TeX;
+% the change history which follows and the reward offered for finders of
+% bugs refer specifically to TeX; they should not be taken as referring
+% to e-TeX, although the change history is relevant in that it
+% demonstrates the evolutionary path followed. This program is not TeX;
+% that name is reserved strictly for the program which is the creation
+% and sole responsibility of Professor Knuth.
+@z
+%---------------------------------------
+@x limbo l.50 - e-TeX history
+% Although considerable effort has been expended to make the TeX program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the author hopes that users enjoy it.
+@y
+% A preliminary version of TeX--XeT was released in April 1992.
+% TeX--XeT version 1.0 was released in June 1992,
+% version 1.1 prevented arith overflow in glue computation (Oct 1992).
+% A preliminary e-TeX version 0.95 was operational in March 1994.
+% Version 1.0beta was released in May 1995.
+% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995).
+% Version 1.02beta allowed 256 mark classes (March 1996).
+% Version 1.1 changed \group{type,level} -> \currentgroup{type,level},
+% first public release (October 1996).
+% Version 2.0 development was started in March 1997;
+% fixed a ligature-\beginR bug in January 1998;
+% was released in March 1998.
+% Version 2.1 fixed a marks bug (when min_halfword<>0) (January 1999).
+
+% Although considerable effort has been expended to make the e-TeX program
+% correct and reliable, no warranty is implied; the authors disclaim any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the authors hope that users enjoy it.
+@z
+%---------------------------------------
+@x limbo l.61 - e-TeX logo, TeXXeT
+\let\mc=\ninerm % medium caps for names like SAIL
+@y
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\eTeX{$\varepsilon$-\TeX}
+\font\revrm=xbmc10 % for right-to-left text
+% to generate xbmc10 (i.e., reflected cmbx10) use a file
+% xbmc10.mf containing:
+%+++++++++++++++++++++++++++++++++++++++++++++++++
+% if unknown cmbase: input cmbase fi
+% extra_endchar := extra_endchar &
+% "currentpicture:=currentpicture " &
+% "reflectedabout((.5[l,r],0),(.5[l,r],1));";
+% input cmbx10
+%+++++++++++++++++++++++++++++++++++++++++++++++++
+\ifx\beginL\undefined % this is TeX
+ \def\XeT{X\kern-.125em\lower.5ex\hbox{E}\kern-.1667emT}
+ \def\TeXeT{\TeX-\hbox{\revrm \XeT}} % for TeX-XeT
+ \def\TeXXeT{\TeX-\hbox{\revrm -\XeT}} % for TeX--XeT
+\else
+ \ifx\eTeXversion\undefined % this is \TeXeT
+ \def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT
+ \def\TeXXeT{\TeX-{\revrm\beginR\TeX-\endR}} % for TeX--XeT
+ \else % this is \eTeX
+ \def\TeXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX\endR}} % for TeX-XeT
+ \def\TeXXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX-\endR}} % for TeX--XeT
+ \fi
+\fi
+@z
+%---------------------------------------
+@x limbo l.64 - bug fix (print only changed modules)
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+@y
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\def\grp{\.{\char'173...\char'175}}
+@z
+%---------------------------------------
+@x limbo l.80 - e-TeX basic
+\def\title{\TeX82}
+@y
+\def\title{\eTeX}
+% system dependent redefinitions of \title should come later
+% and should use:
+% \toks0=\expandafter{\title}
+% \edef\title{...\the\toks0...}
+\let\maybe=\iffalse % print only changed modules
+@z
+%---------------------------------------
+@x [1] m.1 l.91 - this is e-TeX
+This is \TeX, a document compiler intended to produce typesetting of high
+@y
+This is \eTeX, a program derived from and extending the capabilities of
+\TeX, a document compiler intended to produce typesetting of high
+@z
+%---------------------------------------
+@x [1] m.2 l.179 - e-TeX basic
+If this program is changed, the resulting system should not be called
+@y
+This program contains code for various features extending \TeX,
+therefore this program is called `\eTeX' and not
+@z
+%---------------------------------------
+@x [1] m.2 l.185 - e-TeX basic
+November 1984].
+@y
+November 1984].
+
+A similar test suite called the ``\.{e-TRIP} test'' is available for
+helping to determine whether a particular implementation deserves to be
+known as `\eTeX'.
+@z
+%---------------------------------------
+@x [1] m.2 l.187 - e-TeX basic
+@d banner=='This is TeX, Version 3.14159' {printed when \TeX\ starts}
+@y
+@d banner=='This is TeX, Version 3.14159' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.14159-2.1' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@#
+@d eTeX_banner=='This is e-TeX, Version ',eTeX_version_string
+ {printed when \eTeX\ starts}
+@#
+@d TEX==ETEX {change program name into |ETEX|}
+@#
+@d TeXXeT_code=0 {the \TeXXeT\ feature is optional}
+@#
+@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|}
+@z
+%---------------------------------------
+@x [1] m.15 l.493 - e-TeX basic
+@d not_found=45 {go here when you've found nothing}
+@y
+@d not_found=45 {go here when you've found nothing}
+@d not_found1=46 {like |not_found|, when there's more than one}
+@d not_found2=47 {like |not_found|, when there's more than two}
+@d not_found3=48 {like |not_found|, when there's more than three}
+@d not_found4=49 {like |not_found|, when there's more than four}
+@z
+%---------------------------------------
+@x [5] m.61 l.1556 - e-TeX basic
+wterm(banner);
+@y
+wterm(eTeX_banner);
+@z
+%---------------------------------------
+@x [10] m.141 l.2965 - e-TeX marks
+This field occupies a full word instead of a halfword, because
+there's nothing to put in the other halfword; it is easier in \PASCAL\ to
+use the full word than to risk leaving garbage in the unused half.
+@y
+In addition there is a |mark_class| field that contains the mark class.
+@z
+%---------------------------------------
+@x [10] m.141 l.2971 - e-TeX marks
+@d mark_ptr(#)==mem[#+1].int {head of the token list for a mark}
+@y
+@d mark_ptr(#)==link(#+1) {head of the token list for a mark}
+@d mark_class(#)==info(#+1) {the mark class}
+@z
+%---------------------------------------
+@x [10] m.142 l.2980 - e-TeX marks
+@d adjust_ptr==mark_ptr {vertical list to be moved out of horizontal list}
+@y
+@d adjust_ptr(#)==mem[#+1].int
+ {vertical list to be moved out of horizontal list}
+@z
+%---------------------------------------
+@x [10] m.147 l.3069 - e-TeX TeXXeT
+the amount of surrounding space inserted by \.{\\mathsurround}.
+@y
+the amount of surrounding space inserted by \.{\\mathsurround}.
+
+In addition a |math_node| with |subtype>after| and |width=0| will be
+(ab)used to record a regular |math_node| reinserted after being
+discarded at a line break or one of the text direction primitives (
+\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} ).
+@z
+%---------------------------------------
+@x [10] m.147 l.3073 - e-TeX TeXXeT
+@d after=1 {|subtype| for math node that winds up a formula}
+@y
+@d after=1 {|subtype| for math node that winds up a formula}
+@#
+@d M_code=2
+@d begin_M_code=M_code+before {|subtype| for \.{\\beginM} node}
+@d end_M_code=M_code+after {|subtype| for \.{\\endM} node}
+@d L_code=4
+@d begin_L_code=L_code+begin_M_code {|subtype| for \.{\\beginL} node}
+@d end_L_code=L_code+end_M_code {|subtype| for \.{\\endL} node}
+@d R_code=L_code+L_code
+@d begin_R_code=R_code+begin_M_code {|subtype| for \.{\\beginR} node}
+@d end_R_code=R_code+end_M_code {|subtype| for \.{\\endR} node}
+@#
+@d end_LR(#)==odd(subtype(#))
+@d end_LR_type(#)==(L_code*(subtype(#) div L_code)+end_M_code)
+@d begin_LR_type(#)==(#-after+before)
+@z
+%---------------------------------------
+@x [12] m.175 l.3546 - e-TeX TeXXeT
+math_node: print_char("$");
+@y
+math_node: if subtype(p)>=L_code then print("[]")
+ else print_char("$");
+@z
+%---------------------------------------
+@x [12] m.184 l.3713 - e-TeX TeXXeT
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+@y
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+ if eTeX_ex then @<Display if this box is never to be reversed@>;
+@z
+%---------------------------------------
+@x [12] m.192 l.3811 - e-TeX TeXXeT
+begin print_esc("math");
+@y
+if subtype(p)>after then
+ begin if end_LR(p) then print_esc("end")
+ else print_esc("begin");
+ if subtype(p)>R_code then print_char("R")
+ else if subtype(p)>L_code then print_char("L")
+ else print_char("M");
+ end else
+begin print_esc("math");
+@z
+%---------------------------------------
+@x [12] m.196 l.3844 - e-TeX marks
+begin print_esc("mark"); print_mark(mark_ptr(p));
+@y
+begin print_esc("mark");
+if mark_class(p)<>0 then
+ begin print_char("s"); print_int(mark_class(p));
+ end;
+print_mark(mark_ptr(p));
+@z
+%---------------------------------------
+@x [15] m.208 l.4081 - e-TeX saved_items
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+@y
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+ {( or \.{\\pagediscards}, \.{\\splitdiscards} )}
+@z
+%---------------------------------------
+@x [15] m.208 l.4091 - e-TeX TeXXeT
+@d valign=33 {vertical table alignment ( \.{\\valign} )}
+@y
+@d valign=33 {vertical table alignment ( \.{\\valign} )}
+ {or text direction directives ( \.{\\beginL}, etc.~)}
+@z
+%---------------------------------------
+@x [15] m.208 l.4107 - e-TeX middle
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+@y
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+ {( or \.{\\middle} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4151 - e-TeX basic
+ \.{\\insertpenalties} )}
+@y
+ \.{\\insertpenalties} )}
+ {( or \.{\\interactionmode} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4153 - e-TeX penalties
+@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
+@y
+@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
+ {(or \.{\\interlinepenalties}, etc.~)}
+@z
+%---------------------------------------
+@x [15] m.209 l.4163 - e-TeX protected
+@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@y
+@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+ {( or \.{\\protected} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4166 - e-TeX read_line
+@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
+@y
+@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
+ {( or \.{\\readline} )}
+@z
+%---------------------------------------
+@x [15] m.210 l.4181 - e-TeX scan_tokens
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+@y
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+ {( or \.{\\scantokens} )}
+@z
+%---------------------------------------
+@x [15] m.210 l.4186 - e-TeX unexpanded
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+@y
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+ {( or \.{\\unexpanded}, \.{\\detokenize} )}
+@z
+%---------------------------------------
+@x [16] m.212 l.4289 - e-TeX basic
+user's output routine.
+@y
+user's output routine.
+
+A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX.
+In vertical modes it is known as |LR_save| and holds the LR stack when a
+paragraph is interrupted by a displayed formula. In display math mode
+it is known as |LR_box| and holds a pointer to a prototype box for the
+display. In math mode it is known as |delim_ptr| and points to the most
+recent |left_noad| or |middle_noad| of a |math_left_group|.
+@z
+%---------------------------------------
+@x [16] m.212 l.4304 - e-TeX basic
+ @!head_field,@!tail_field: pointer;
+@y
+ @!head_field,@!tail_field: pointer;
+ @!eTeX_aux_field: pointer;
+@z
+%---------------------------------------
+@x [16] m.213 l.4311 - e-TeX basic
+@d tail==cur_list.tail_field {final node on current list}
+@y
+@d tail==cur_list.tail_field {final node on current list}
+@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX}
+@d LR_save==eTeX_aux {LR stack when a paragraph is interrupted}
+@d LR_box==eTeX_aux {prototype box for display}
+@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group}
+@z
+%---------------------------------------
+@x [16] m.215 l.4342 - e-TeX basic
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+@y
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+eTeX_aux:=null;
+@z
+%---------------------------------------
+@x [16] m.216 l.4358 push_nest - e-TeX basic
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+eTeX_aux:=null;
+@z
+%---------------------------------------
+@x [17] m.230 l.4712 - e-TeX basic, penalties
+@d output_routine_loc=local_base+1 {points to token list for \.{\\output}}
+@d every_par_loc=local_base+2 {points to token list for \.{\\everypar}}
+@d every_math_loc=local_base+3 {points to token list for \.{\\everymath}}
+@d every_display_loc=local_base+4 {points to token list for \.{\\everydisplay}}
+@d every_hbox_loc=local_base+5 {points to token list for \.{\\everyhbox}}
+@d every_vbox_loc=local_base+6 {points to token list for \.{\\everyvbox}}
+@d every_job_loc=local_base+7 {points to token list for \.{\\everyjob}}
+@d every_cr_loc=local_base+8 {points to token list for \.{\\everycr}}
+@d err_help_loc=local_base+9 {points to token list for \.{\\errhelp}}
+@d toks_base=local_base+10 {table of 256 token list registers}
+@y
+@d inter_line_penalties_loc=local_base+1 {additional penalties between lines}
+@d club_penalties_loc=local_base+2 {penalties for creating club lines}
+@d widow_penalties_loc=local_base+3 {penalties for creating widow lines}
+@d display_widow_penalties_loc=local_base+4 {ditto, just before a display}
+@d token_base=local_base+5 {table of token list parameters}
+@d output_routine_loc=token_base {points to token list for \.{\\output}}
+@d every_par_loc=token_base+1 {points to token list for \.{\\everypar}}
+@d every_math_loc=token_base+2 {points to token list for \.{\\everymath}}
+@d every_display_loc=token_base+3 {points to token list for \.{\\everydisplay}}
+@d every_hbox_loc=token_base+4 {points to token list for \.{\\everyhbox}}
+@d every_vbox_loc=token_base+5 {points to token list for \.{\\everyvbox}}
+@d every_job_loc=token_base+6 {points to token list for \.{\\everyjob}}
+@d every_cr_loc=token_base+7 {points to token list for \.{\\everycr}}
+@d every_eof_loc=token_base+8 {points to token list for \.{\\everyeof}}
+@d err_help_loc=token_base+9 {points to token list for \.{\\errhelp}}
+@d toks_base=token_base+10 {table of 256 token list registers}
+@z
+%---------------------------------------
+@x [17] m.231 l.4787 - e-TeX basic
+ othercases print_esc("errhelp")
+@y
+ @/@<Cases of |assign_toks| for |print_cmd_chr|@>@/
+ othercases print_esc("errhelp")
+@z
+%---------------------------------------
+@x [17] m.232 l.4805 - e-TeX penalties
+eq_level(par_shape_loc):=level_one;@/
+@y
+eq_level(par_shape_loc):=level_one;@/
+for k:=par_shape_loc+1 to token_base-1 do
+ eqtb[k]:=eqtb[par_shape_loc];
+@z
+%---------------------------------------
+@x [17] m.233 l.4833 - e-TeX penalties
+if n=par_shape_loc then
+ begin print_esc("parshape"); print_char("=");
+ if par_shape_ptr=null then print_char("0")
+ else print_int(info(par_shape_ptr));
+@y
+if n<token_base then
+ begin print_cmd_chr(set_shape,n); print_char("=");
+ if equiv(n)=null then print_char("0")
+ else if n>par_shape_loc then
+ begin print_int(penalty(equiv(n))); print_char(" ");
+ print_int(penalty(equiv(n)+1));
+ if penalty(equiv(n))>1 then print_esc("ETC.");
+ end
+ else print_int(info(par_shape_ptr));
+@z
+%---------------------------------------
+@x [17] m.236 l.4955 - e-TeX basic
+@d count_base=int_base+int_pars {256 user \.{\\count} registers}
+@y
+@d tracing_assigns_code=int_pars {show assignments}
+@d tracing_groups_code=int_pars+1 {show save/restore groups}
+@d tracing_ifs_code=int_pars+2 {show conditionals}
+@d tracing_scan_tokens_code=int_pars+3 {show pseudo file open and close}
+@d tracing_nesting_code=int_pars+4
+ {show incomplete groups and ifs within files}
+@d pre_display_direction_code=int_pars+5 {text direction preceding a display}
+@d last_line_fit_code=int_pars+6 {adjustment for last line of paragraph}
+@d saving_vdiscards_code=int_pars+7 {save items discarded from vlists}
+@d saving_hyph_codes_code=int_pars+8 {save hyphenation codes for languages}
+@d eTeX_state_code=int_pars+9 {\eTeX\ state variables}
+@d count_base=int_base+eTeX_state_code+eTeX_states
+ {256 user \.{\\count} registers}
+@z
+%---------------------------------------
+@x [17] m.236 l.5016 - e-TeX basic
+@d error_context_lines==int_par(error_context_lines_code)
+@y
+@d error_context_lines==int_par(error_context_lines_code)
+@d tracing_assigns==int_par(tracing_assigns_code)
+@d tracing_groups==int_par(tracing_groups_code)
+@d tracing_ifs==int_par(tracing_ifs_code)
+@d tracing_scan_tokens==int_par(tracing_scan_tokens_code)
+@d tracing_nesting==int_par(tracing_nesting_code)
+@d pre_display_direction==int_par(pre_display_direction_code)
+@d last_line_fit==int_par(last_line_fit_code)
+@d saving_vdiscards==int_par(saving_vdiscards_code)
+@d saving_hyph_codes==int_par(saving_hyph_codes_code)
+@z
+%---------------------------------------
+@x [17] m.237 l.5081 print_param - e-TeX basic
+othercases print("[unknown integer parameter!]")
+@y
+@/@<Cases for |print_param|@>@/
+othercases print("[unknown integer parameter!]")
+@z
+%---------------------------------------
+@x [18] m.264 l.5612 primitive - e-TeX basic
+@!j:small_number; {index into |buffer|}
+@y
+@!j:0..buf_size; {index into |buffer|}
+@z
+%---------------------------------------
+@x [18] m.264 l.5616 primitive - e-TeX basic
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+@y
+ {we will move |s| into the (possibly non-empty) |buffer|}
+ if first+l>buf_size+1 then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
+@z
+%---------------------------------------
+@x [18] m.265 l.5691 - e-TeX penalties
+primitive("parshape",set_shape,0);@/
+@y
+primitive("parshape",set_shape,par_shape_loc);@/
+@z
+%---------------------------------------
+@x [18] m.265 l.5708 - e-TeX sparse arrays
+primitive("toks",toks_register,0);@/
+@y
+primitive("toks",toks_register,mem_bot);@/
+@z
+%---------------------------------------
+@x [18] m.266 l.5741 - e-TeX cond
+expand_after: print_esc("expandafter");
+@y
+expand_after: if chr_code=0 then print_esc("expandafter")
+ @<Cases of |expandafter| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5747 - e-TeX marks
+mark: print_esc("mark");
+@y
+mark: begin print_esc("mark");
+ if chr_code>0 then print_char("s");
+ end;
+@z
+%---------------------------------------
+@x [18] m.266 l.5758 - e-TeX read_line
+read_to_cs: print_esc("read");
+@y
+read_to_cs: if chr_code=0 then print_esc("read")
+ @<Cases of |read| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5762 - e-TeX penalties
+set_shape: print_esc("parshape");
+@y
+set_shape: case chr_code of
+ par_shape_loc: print_esc("parshape");
+ @<Cases of |set_shape| for |print_cmd_chr|@>@;@/
+ end; {there are no other cases}
+@z
+%---------------------------------------
+@x [18] m.266 l.5763 - e-TeX unexpanded
+the: print_esc("the");
+@y
+the: if chr_code=0 then print_esc("the")
+ @<Cases of |the| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5764 - e-TeX sparse arrays
+toks_register: print_esc("toks");
+@y
+toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5766 - e-TeX TeXXeT
+valign: print_esc("valign");
+@y
+valign: if chr_code=0 then print_esc("valign")@/
+ @<Cases of |valign| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [19] m.268 l.5800 - e-TeX sparse arrays
+interpreted in one of four ways:
+@y
+interpreted in one of five ways:
+@z
+%---------------------------------------
+@x [19] m.268 l.5820 - e-TeX tracing
+the entries for that group.
+@y
+the entries for that group.
+Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
+source line number at which the current level of grouping was entered.
+
+\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a
+chain of sparse array entries to be restored at the end of the current
+group. Furthermore |save_index(p)| and |save_level(p)| should replace
+the values of |sa_chain| and |sa_level| respectively.
+@z
+%---------------------------------------
+@x [19] m.268 l.5830 - e-TeX basic
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@y
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@d restore_sa=4 {|save_type| when sparse array entries should be restored}
+
+@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
+@z
+%---------------------------------------
+@x [19] m.273 l.5888 - e-TeX tracing
+@ The following macro is used to test if there is room for up to six more
+@y
+@ The following macro is used to test if there is room for up to seven more
+@z
+%---------------------------------------
+@x [19] m.273 l.5894 check_full_save_stack - e-TeX tracing
+ if max_save_stack>save_size-6 then overflow("save size",save_size);
+@y
+ if max_save_stack>save_size-7 then overflow("save size",save_size);
+@z
+%---------------------------------------
+@x [19] m.274 l.5916 new_save_level - e-TeX tracing
+begin check_full_save_stack;
+@y
+begin check_full_save_stack;
+if eTeX_ex then
+ begin saved(0):=line; incr(save_ptr);
+ end;
+@z
+%---------------------------------------
+@x [19] m.274 l.5923 new_save_level - e-TeX tracing
+cur_boundary:=save_ptr; incr(cur_level); incr(save_ptr); cur_group:=c;
+@y
+cur_boundary:=save_ptr; cur_group:=c;
+@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/
+incr(cur_level); incr(save_ptr);
+@z
+%---------------------------------------
+@x [19] m.275 l.5941 eq_destroy - e-TeX sparse arrays
+othercases do_nothing
+@y
+@/@<Cases for |eq_destroy|@>@/
+othercases do_nothing
+@z
+%---------------------------------------
+@x [19] m.277 l.5963 - e-TeX tracing
+the call, since |eq_save| makes the necessary test.
+@y
+the call, since |eq_save| makes the necessary test.
+
+@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#);
+ tats
+@z
+%---------------------------------------
+@x [19] m.277 l.5967 eq_define - e-TeX tracing
+begin if eq_level(p)=cur_level then eq_destroy(eqtb[p])
+@y
+label exit;
+begin if eTeX_ex and(eq_type(p)=t)and(equiv(p)=e) then
+ begin assign_trace(p,"reassigning")@;@/
+ eq_destroy(eqtb[p]); return;
+ end;
+assign_trace(p,"changing")@;@/
+if eq_level(p)=cur_level then eq_destroy(eqtb[p])
+@z
+%---------------------------------------
+@x [19] m.277 l.5970 eq_define - e-TeX tracing
+end;
+@y
+assign_trace(p,"into")@;@/
+exit:end;
+@z
+%---------------------------------------
+@x [19] m.278 l.5977 eq_word_define - e-TeX tracing
+begin if xeq_level[p]<>cur_level then
+@y
+label exit;
+begin if eTeX_ex and(eqtb[p].int=w) then
+ begin assign_trace(p,"reassigning")@;@/
+ return;
+ end;
+assign_trace(p,"changing")@;@/
+if xeq_level[p]<>cur_level then
+@z
+%---------------------------------------
+@x [19] m.278 l.5981 eq_word_define - e-TeX tracing
+end;
+@y
+assign_trace(p,"into")@;@/
+exit:end;
+@z
+%---------------------------------------
+@x [19] m.279 l.5990 geq_define - e-TeX tracing
+begin eq_destroy(eqtb[p]);
+eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
+@y
+begin assign_trace(p,"globally changing")@;@/
+begin eq_destroy(eqtb[p]);
+eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
+end;
+assign_trace(p,"into")@;@/
+@z
+%---------------------------------------
+@x [19] m.279 l.5995 geq_word_define - e-TeX tracing
+begin eqtb[p].int:=w; xeq_level[p]:=level_one;
+@y
+begin assign_trace(p,"globally changing")@;@/
+begin eqtb[p].int:=w; xeq_level[p]:=level_one;
+end;
+assign_trace(p,"into")@;@/
+@z
+%---------------------------------------
+@x [19] m.281 l.6012 - e-TeX tracing
+@p@t\4@>@<Declare the procedure called |restore_trace|@>@;@/
+@y
+@p
+@z
+%---------------------------------------
+@x [19] m.281 l.6019 unsave - e-TeX optimized \aftergroup
+begin if cur_level>level_one then
+@y
+@!a:boolean; {have we already processed an \.{\\aftergroup} ?}
+begin a:=false;
+if cur_level>level_one then
+@z
+%---------------------------------------
+@x [19] m.282 l.6033 - e-TeX sparse arrays
+ else begin if save_type(save_ptr)=restore_old_value then
+@y
+ else if save_type(save_ptr)=restore_sa then
+ begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr);
+ end
+ else begin if save_type(save_ptr)=restore_old_value then
+@z
+%---------------------------------------
+@x [19] m.282 l.6041 - e-TeX tracing
+done: cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr)
+@y
+done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/
+if grp_stack[in_open]=cur_boundary then group_warning;
+ {groups possibly not properly nested with files}
+cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr);
+if eTeX_ex then decr(save_ptr)
+@z
+%---------------------------------------
+@x [19] m.284 l.6067 - e-TeX tracing
+@ @<Declare the procedure called |restore_trace|@>=
+@y
+@ @<Declare \eTeX\ procedures for tr...@>=
+@z
+%---------------------------------------
+@x [20] m.289 l.6155 - e-TeX protected
+@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
+@y
+@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
+@d protected_token=@'7001 {$2^8\cdot|end_match|+1$}
+@z
+%---------------------------------------
+@x [20] m.294 l.6280 - e-TeX protected
+end_match: print("->");
+@y
+end_match: if c=0 then print("->");
+@z
+%---------------------------------------
+@x [20] m.296 l.6301 print_meaning - e-TeX marks
+else if cur_cmd=top_bot_mark then
+@y
+else if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then
+@z
+%---------------------------------------
+@x [21] m.298 l.6375 print_cmd_chr - e-TeX protected
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@y
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+var n:integer; {temp variable}
+@z
+%---------------------------------------
+@x [21] m.299 l.6394 show_cur_cmd_chr - e-TeX tracing
+@p procedure show_cur_cmd_chr;
+@y
+@p procedure show_cur_cmd_chr;
+var n:integer; {level of \.{\\if...\\fi} nesting}
+@!l:integer; {line where \.{\\if} started}
+@!p:pointer;
+@z
+%---------------------------------------
+@x [21] m.299 l.6399 show_cur_cmd_chr - e-TeX tracing
+print_cmd_chr(cur_cmd,cur_chr); print_char("}");
+@y
+print_cmd_chr(cur_cmd,cur_chr);
+if tracing_ifs>0 then
+ if cur_cmd>=if_test then if cur_cmd<=fi_or_else then
+ begin print(": ");
+ if cur_cmd=fi_or_else then
+ begin print_cmd_chr(if_test,cur_if); print_char(" ");
+ n:=0; l:=if_line;
+ end
+ else begin n:=1; l:=line;
+ end;
+ p:=cond_ptr;
+ while p<>null do
+ begin incr(n); p:=link(p);
+ end;
+ print("(level "); print_int(n); print_char(")"); print_if_line(l);
+ end;
+print_char("}");
+@z
+%---------------------------------------
+@x [22] m.303 l.6475 show_context - e-TeX scan_tokens
+the terminal, under control of the procedure |read_toks|.)
+@y
+the terminal, under control of the procedure |read_toks|.)
+Finally |18<=name<=19| indicates that we are reading a pseudo file
+created by the \.{\\scantokens} command.
+@z
+%---------------------------------------
+@x [22] m.307 l.6692 - e-TeX basic
+@d mark_text=14 {|token_type| code for \.{\\topmark}, etc.}
+@d write_text=15 {|token_type| code for \.{\\write}}
+@y
+@d every_eof_text=14 {|token_type| code for \.{\\everyeof}}
+@d mark_text=15 {|token_type| code for \.{\\topmark}, etc.}
+@d write_text=16 {|token_type| code for \.{\\write}}
+@z
+%---------------------------------------
+@x [22] m.311 l.6749 show_context - e-TeX scan_tokens
+ if (name>17) or (base_ptr=0) then bottom_line:=true;
+@y
+ if (name>19) or (base_ptr=0) then bottom_line:=true;
+@z
+%---------------------------------------
+@x [22] m.313 l.6794 - e-TeX scan_tokens
+else begin print_nl("l."); print_int(line);
+@y
+else if index<>in_open then {input from a pseudo file}
+ begin print_nl("l."); print_int(line_stack[index+1]);
+ end
+else begin print_nl("l."); print_int(line);
+@z
+%---------------------------------------
+@x [22] m.314 l.6814 - e-TeX basic
+every_cr_text: print_nl("<everycr> ");
+@y
+every_cr_text: print_nl("<everycr> ");
+every_eof_text: print_nl("<everyeof> ");
+@z
+%---------------------------------------
+@x [23] m.326 l.7009 - e-TeX optimized \aftergroup
+begin t:=cur_tok; cur_tok:=p; back_input; cur_tok:=t;
+@y
+begin t:=cur_tok; cur_tok:=p;
+if a then
+ begin p:=get_avail; info(p):=cur_tok; link(p):=loc; loc:=p; start:=p;
+ if cur_tok<right_brace_limit then
+ if cur_tok<left_brace_limit then decr(align_state)
+ else incr(align_state);
+ end
+else begin back_input; a:=eTeX_ex;
+ end;
+cur_tok:=t;
+@z
+%---------------------------------------
+@x [23] m.328 l.7037 begin_file_reading - e-TeX every_eof, tracing_nesting
+incr(in_open); push_input; index:=in_open;
+@y
+incr(in_open); push_input; index:=in_open;
+eof_seen[index]:=false;
+grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr;
+@z
+%---------------------------------------
+@x [23] m.329 l.7047 end_file_reading - e-TeX scan_tokens
+if name>17 then a_close(cur_file); {forget it}
+@y
+if (name=18)or(name=19) then pseudo_close else
+if name>17 then a_close(cur_file); {forget it}
+@z
+%---------------------------------------
+@x [23] m.331 l.7066 - e-TeX tracing_nesting
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+@y
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+grp_stack[0]:=0; if_stack[0]:=null;
+@z
+%---------------------------------------
+@x [24] m.362 l.7538 - e-TeX scan_tokens, every_eof
+if not force_eof then
+@y
+if not force_eof then
+ if name<=19 then
+ begin if pseudo_input then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+ end
+ else
+@z
+%---------------------------------------
+@x [24] m.362 l.7541 - e-TeX every_eof
+ else force_eof:=true;
+@y
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+@z
+%---------------------------------------
+@x [24] m.362 l.7544 - e-TeX scan_tokens
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+@y
+ begin if tracing_nesting>0 then
+ if (grp_stack[in_open]<>cur_boundary)or@|
+ (if_stack[in_open]<>cond_ptr) then file_warning;
+ {give warning for some unfinished groups and/or conditionals}
+ if name>=19 then
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ end;
+@z
+%---------------------------------------
+@x [25] m.366 l.7630 - e-TeX basic
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+@y
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/
+@z
+%---------------------------------------
+@x [25] m.366 l.7637 expand - e-TeX cond
+procedure expand;
+@y
+procedure expand;
+label reswitch;
+@z
+%---------------------------------------
+@x [25] m.366 l.7648 expand - e-TeX cond
+if cur_cmd<call then @<Expand a nonmacro@>
+@y
+reswitch:
+if cur_cmd<call then @<Expand a nonmacro@>
+@z
+%---------------------------------------
+@x [25] m.367 l.7659 - e-TeX cond
+expand_after:@<Expand the token after the next token@>;
+@y
+expand_after:if cur_chr=0 then @<Expand the token after the next token@>
+ else @<Negate a boolean conditional and |goto reswitch|@>;
+@z
+%---------------------------------------
+@x [25] m.377 l.7779 - e-TeX scan_tokens
+input: if chr_code=0 then print_esc("input")@+else print_esc("endinput");
+@y
+input: if chr_code=0 then print_esc("input")
+ @/@<Cases of |input| for |print_cmd_chr|@>@/
+ else print_esc("endinput");
+@z
+%---------------------------------------
+@x [25] m.378 l.7782 - e-TeX scan_tokens
+if cur_chr>0 then force_eof:=true
+@y
+if cur_chr=1 then force_eof:=true
+@/@<Cases for |input|@>@/
+@z
+%---------------------------------------
+@x [25] m.382 l.7838 - e-TeX marks
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@y
+@d marks_code==5 {add this for \.{\\topmarks} etc.}
+@#
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@z
+%---------------------------------------
+@x [25] m.385 l.7870 - e-TeX marks
+top_bot_mark: case chr_code of
+@y
+top_bot_mark: begin case (chr_code mod marks_code) of
+@z
+%---------------------------------------
+@x [25] m.385 l.7876 - e-TeX marks
+ endcases;
+@y
+ endcases;
+ if chr_code>=marks_code then print_char("s");
+ end;
+@z
+%---------------------------------------
+@x [25] m.386 l.7882 - e-TeX marks
+begin if cur_mark[cur_chr]<>null then
+ begin_token_list(cur_mark[cur_chr],mark_text);
+@y
+begin t:=cur_chr mod marks_code;
+if cur_chr>=marks_code then scan_register_num@+else cur_val:=0;
+if cur_val=0 then cur_ptr:=cur_mark[t]
+else @<Compute the mark pointer for mark type |t| and class |cur_val|@>;
+if cur_ptr<>null then begin_token_list(cur_ptr,mark_text);
+@z
+%---------------------------------------
+@x [25] m.389 l.7945 macro_call - e-TeX protected
+if info(r)<>end_match_token then
+@y
+if info(r)=protected_token then r:=link(r);
+if info(r)<>end_match_token then
+@z
+%---------------------------------------
+@x [26] m.409 l.8255 - e-TeX basic
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@y
+@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@;
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@z
+%---------------------------------------
+@x [26] m.411 l.8299 - e-TeX sparse arrays
+|glue_val|, or |mu_val|.
+@y
+|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes
+cannot have these values)
+@z
+%---------------------------------------
+@x [26] m.411 l.8302 - e-TeX sparse arrays
+primitive("count",register,int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mu_val);
+@y
+primitive("count",register,mem_bot+int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,mem_bot+dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,mem_bot+glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mem_bot+mu_val);
+@z
+%---------------------------------------
+@x [26] m.412 l.8312 - e-TeX sparse arrays
+register: if chr_code=int_val then print_esc("count")
+ else if chr_code=dimen_val then print_esc("dimen")
+ else if chr_code=glue_val then print_esc("skip")
+ else print_esc("muskip");
+@y
+register: @<Cases of |register| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [26] m.413 l.8328 scan_something_internal - e-TeX basic
+var m:halfword; {|chr_code| part of the operand token}
+@y
+label exit;
+var m:halfword; {|chr_code| part of the operand token}
+@!q:halfword; {general purpose index}
+@!i:four_quarters; {character info}
+@z
+%---------------------------------------
+@x [26] m.413 l.8354 scan_something_internal - e-TeX basic
+end;
+@y
+exit:end;
+@z
+%---------------------------------------
+@x [26] m.415 l.8375 - e-TeX sparse arrays
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+@y
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else cur_val:=equiv(m);
+ cur_val_level:=tok_val;
+@z
+%---------------------------------------
+@x [26] m.416 l.8390 - e-TeX basic
+|glue_val|, |input_line_no_code|, or |badness_code|.
+
+@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@y
+|glue_val|, |last_node_type_code|, |input_line_no_code|, |badness_code|,
+|eTeX_version_code|, or one of the other codes for \eTeX\ extensions.
+
+@d last_node_type_code=glue_val+1 {code for \.{\\lastnodetype}}
+@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+3 {code for \.{\\badness}}
+@d eTeX_int=glue_val+4 {first of \eTeX\ codes for integers}
+@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions}
+@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue}
+@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue}
+@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions}
+@z
+%---------------------------------------
+@x [26] m.417 l.8425 - e-TeX interaction_mode
+@+else print_esc("insertpenalties");
+@y
+@/@<Cases of |set_page_int| for |print_cmd_chr|@>@/
+@+else print_esc("insertpenalties");
+@z
+%---------------------------------------
+@x [26] m.417 l.8434 - e-TeX basic
+ othercases print_esc("badness")
+@y
+ @/@<Cases of |last_item| for |print_cmd_chr|@>@/
+ othercases print_esc("badness")
+@z
+%---------------------------------------
+@x [26] m.419 l.8457 - e-TeX interaction_mode
+begin if m=0 then cur_val:=dead_cycles@+else cur_val:=insert_penalties;
+@y
+begin if m=0 then cur_val:=dead_cycles
+@/@<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>@/
+else cur_val:=insert_penalties;
+@z
+%---------------------------------------
+@x [26] m.420 l.8462 - e-TeX sparse arrays
+begin scan_eight_bit_int;
+if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc;
+@y
+begin scan_register_num; fetch_box(q);
+if q=null then cur_val:=0 @+else cur_val:=mem[q+m].sc;
+@z
+%---------------------------------------
+@x [26] m.423 l.8487 - e-TeX penalties
+begin if par_shape_ptr=null then cur_val:=0
+@y
+begin if m>par_shape_loc then @<Fetch a penalties array element@>
+else if par_shape_ptr=null then cur_val:=0
+@z
+%---------------------------------------
+@x [26] m.424 l.8493 - e-TeX TeXXeT
+implemented. The reference count for \.{\\lastskip} will be updated later.
+@y
+implemented. The reference count for \.{\\lastskip} will be updated later.
+A final \.{\\endM} node is temporarily removed.
+@z
+%---------------------------------------
+@x [26] m.424 l.8499 - e-TeX basic
+if cur_chr>glue_val then
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+@y
+if m>last_node_type_code then
+ if m>=eTeX_glue then @<Process an expression and |return|@>@;
+ else if m>=eTeX_dim then
+ begin case m of
+ @/@<Cases for fetching a dimension value@>@/
+ end; {there are no other cases}
+ cur_val_level:=dimen_val;
+ end
+ else begin case m of
+ input_line_no_code: cur_val:=line;
+ badness_code: cur_val:=last_badness;
+ @/@<Cases for fetching an integer value@>@/
+ end; {there are no other cases}
+@z
+%---------------------------------------
+@x [26] m.424 l.8505 - e-TeX last_node_type
+ cur_val_level:=cur_chr;
+@y
+ if cur_chr=last_node_type_code then
+ begin cur_val:=int_val;
+ if (tail=head)or(mode=0) then cur_val:=-1;
+ end
+ else cur_val_level:=cur_chr;
+@z
+%---------------------------------------
+@x [26] m.424 l.8507 - e-TeX TeXXeT
+ case cur_chr of
+@y
+ begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+ remove_end_M;
+ case cur_chr of
+@z
+%---------------------------------------
+@x [26] m.424 l.8513 - e-TeX last_node_type
+ end;
+@y
+ end;
+ last_node_type_code:
+ if (type(tail)<>math_node)or(subtype(tail)<>end_M_code) then
+ if type(tail)<=unset_node then cur_val:=type(tail)+1
+ else cur_val:=unset_node+2;
+@z
+%---------------------------------------
+@x [26] m.424 l.8514 - e-TeX TeXXeT
+ end {there are no other cases}
+@y
+ end; {there are no other cases}
+ if LR_temp<>null then insert_end_M;
+ end
+@z
+%---------------------------------------
+@x [26] m.424 l.8519 - e-TeX last_node_type
+ glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+@y
+ glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+ last_node_type_code: cur_val:=last_node_type;
+@z
+%---------------------------------------
+@x [26] m.427 l.8535 - e-TeX sparse arrays
+begin scan_eight_bit_int;
+case m of
+@y
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+@z
+%---------------------------------------
+@x [26] m.427 l.8542 - e-TeX sparse arrays
+cur_val_level:=m;
+@y
+ end;
+@z
+%---------------------------------------
+@x [26] m.461 l.9070 - e-TeX expr
+exit:end;
+@y
+exit:end;
+@#
+@<Declare procedures needed for expressions@>@;
+@z
+%---------------------------------------
+@x [27] m.464 l.9129 - e-TeX basic
+@p function str_toks(@!b:pool_pointer):pointer;
+@y
+@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
+function str_toks(@!b:pool_pointer):pointer;
+@z
+%---------------------------------------
+@x [27] m.465 l.9154 the_toks - e-TeX unexpanded
+@p function the_toks:pointer;
+@y
+@p function the_toks:pointer;
+label exit;
+@z
+%---------------------------------------
+@x [27] m.465 l.9158 the_toks - e-TeX unexpanded
+begin get_x_token; scan_something_internal(tok_val,false);
+@y
+@!c:small_number; {value of |cur_chr|}
+begin @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>;@/
+get_x_token; scan_something_internal(tok_val,false);
+@z
+%---------------------------------------
+@x [27] m.465 l.9172 the_toks - e-TeX unexpanded
+end;
+@y
+exit:end;
+@z
+%---------------------------------------
+@x [27] m.469 l.9223 - e-TeX basic
+ othercases print_esc("jobname")
+@y
+ @/@<Cases of |convert| for |print_cmd_chr|@>@/
+ othercases print_esc("jobname")
+@z
+%---------------------------------------
+@x [27] m.470 l.9232 conv_toks - e-TeX basic
+@!c:number_code..job_name_code; {desired type of conversion}
+@y
+@!c:small_number; {desired type of conversion}
+@z
+%---------------------------------------
+@x [27] m.471 l.9249 - e-TeX basic
+end {there are no other cases}
+@y
+@/@<Cases of `Scan the argument for command |c|'@>@/
+end {there are no other cases}
+@z
+%---------------------------------------
+@x [27] m.472 l.9265 - e-TeX basic
+end {there are no other cases}
+@y
+@/@<Cases of `Print the result of command |c|'@>@/
+end {there are no other cases}
+@z
+%---------------------------------------
+@x [27] m.478 l.9374 - e-TeX protected
+ if cur_cmd<=max_command then goto done2;
+@y
+ if cur_cmd>=call then
+ if info(link(cur_chr))=protected_token then
+ begin cur_cmd:=relax; cur_chr:=no_expand_flag;
+ end;
+ if cur_cmd<=max_command then goto done2;
+@z
+%---------------------------------------
+@x [27] m.482 l.9422 read_toks - e-TeX read_line
+@p procedure read_toks(@!n:integer;@!r:pointer);
+@y
+@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword);
+@z
+%---------------------------------------
+@x [27] m.483 l.9448 - e-TeX read_line
+loop@+ begin get_token;
+@y
+@<Handle \.{\\readline} and |goto done|@>;@/
+loop@+ begin get_token;
+@z
+%---------------------------------------
+@x [28] m.487 l.9500 - e-TeX cond
+@d if_char_code=0 { `\.{\\if}' }
+@y
+@d unless_code=32 {amount added for `\.{\\unless}' prefix}
+@#
+@d if_char_code=0 { `\.{\\if}' }
+@z
+%---------------------------------------
+@x [28] m.488 l.9555 - e-TeX cond
+if_test: case chr_code of
+@y
+if_test: begin if chr_code>=unless_code then print_esc("unless");
+case chr_code mod unless_code of
+@z
+%---------------------------------------
+@x [28] m.488 l.9572 - e-TeX cond
+ othercases print_esc("if")
+ endcases;
+@y
+ @/@<Cases of |if_test| for |print_cmd_chr|@>@/
+ othercases print_esc("if")
+ endcases;
+end;
+@z
+%---------------------------------------
+@x [28] m.494 l.9646 pass_text - e-TeX tracing
+done: scanner_status:=save_scanner_status;
+@y
+done: scanner_status:=save_scanner_status;
+if tracing_ifs>0 then show_cur_cmd_chr;
+@z
+%---------------------------------------
+@x [28] m.496 l.9662 - e-TeX tracing_nesting
+begin p:=cond_ptr; if_line:=if_line_field(p);
+@y
+begin if if_stack[in_open]=cond_ptr then if_warning;
+ {conditionals possibly not properly nested with files}
+p:=cond_ptr; if_line:=if_line_field(p);
+@z
+%---------------------------------------
+@x [28] m.498 l.9699 conditional - e-TeX cond
+begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+@y
+@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?}
+begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
+is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+if is_unless then b:=not b;
+@z
+%---------------------------------------
+@x [28] m.501 l.9742 - e-TeX cond
+if_false_code: b:=false;
+@y
+if_false_code: b:=false;
+@/@<Cases for |conditional|@>@/
+@z
+%---------------------------------------
+@x [28] m.505 l.9781 - e-TeX sparse arrays
+begin scan_eight_bit_int; p:=box(cur_val);
+@y
+begin scan_register_num; fetch_box(p);
+@z
+%---------------------------------------
+@x [28] m.510 l.9871 - e-TeX cond
+if cur_chr>if_limit then
+@y
+begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+if cur_chr>if_limit then
+@z
+%---------------------------------------
+@x [28] m.510 l.9882 - e-TeX cond
+ end
+@y
+ end;
+end
+@z
+%---------------------------------------
+@x [29] m.536 l.10324 - e-TeX basic
+begin wlog(banner);
+@y
+begin wlog(eTeX_banner);
+@z
+%---------------------------------------
+@x [29] m.536 l.10331 - e-TeX basic
+end
+@y
+if eTeX_ex then
+ begin; wlog_cr; wlog('entering extended mode');
+ end;
+end
+@z
+%---------------------------------------
+@x [30] m.581 l.11263 char_warning - e-TeX tracing
+begin if tracing_lost_chars>0 then
+@y
+var old_setting: integer; {saved value of |tracing_online|}
+begin if tracing_lost_chars>0 then
+ begin old_setting:=tracing_online;
+ if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+@z
+%---------------------------------------
+@x [30] m.581 l.11270 char_warning - e-TeX tracing
+end;
+@y
+ tracing_online:=old_setting;
+ end;
+end;
+@z
+%---------------------------------------
+@x [32] m.616 l.12238 - e-TeX TeXXeT
+this is essentially the depth of |push| commands in the \.{DVI} output.
+@y
+this is essentially the depth of |push| commands in the \.{DVI} output.
+
+For mixed direction text (\TeXXeT) the current text direction is called
+|cur_dir|. As the box being shipped out will never be used again and
+soon be recycled, we can simply reverse any R-text (i.e., right-to-left)
+segments of hlist nodes as well as complete hlist nodes embedded in such
+segments. Moreover this can be done iteratively rather than recursively.
+There are, however, two complications related to leaders that require
+some additional bookkeeping: (1)~One and the same hlist node might be
+used more than once (but never inside both L- and R-text); and
+(2)~leader boxes inside hlists must be aligned with respect to the left
+edge of the original hlist.
+
+A math node is changed into a kern node whenever the text direction
+remains the same, it is replaced by an |edge_node| if the text direction
+changes; the subtype of an an |hlist_node| inside R-text is changed to
+|reversed| once its hlist has been reversed.
+@!@^data structure assumptions@>
+@z
+%---------------------------------------
+@x [32] m.616 l.12240 - e-TeX TeXXeT
+@d synch_h==if cur_h<>dvi_h then
+@y
+@d reversed=min_quarterword+1 {subtype for an |hlist_node| whose hlist
+ has been reversed}
+@d dlist=min_quarterword+2 {subtype for an |hlist_node| from display math mode}
+@d left_to_right=0
+@d right_to_left=1
+@d reflected==1-cur_dir {the opposite of |cur_dir|}
+@#
+@d synch_h==if cur_h<>dvi_h then
+@z
+%---------------------------------------
+@x [32] m.619 l.12300 hlist_out - e-TeX add_glue
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@y
+@z
+%---------------------------------------
+@x [32] m.619 l.12308 hlist_out - e-TeX TeXXeT
+@!edge:scaled; {left edge of sub-box, or right edge of leader space}
+@y
+@!edge:scaled; {right edge of sub-box or leader space}
+@!prev_p:pointer; {one step behind |p|}
+@z
+%---------------------------------------
+@x [32] m.619 l.12309 hlist_out - e-TeX add_glue
+@!glue_temp:real; {glue value before rounding}
+begin this_box:=temp_ptr; g_order:=glue_order(this_box);
+@y
+begin this_box:=temp_ptr;
+@z
+%---------------------------------------
+@x [32] m.619 l.12315 hlist_out - e-TeX TeXXeT
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+@y
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v;
+prev_p:=this_box+list_offset;
+if eTeX_ex then
+ begin @<Initialize the LR stack@>;
+ if subtype(this_box)=dlist then
+ if cur_dir=right_to_left then
+ begin cur_dir:=left_to_right; cur_h:=cur_h-width(this_box);
+ end
+ else subtype(this_box):=min_quarterword;
+ if (cur_dir=right_to_left)and(subtype(this_box)<>reversed) then
+ @<Reverse the complete hlist and set the subtype to |reversed|@>;
+ end;
+left_edge:=cur_h;
+@z
+%---------------------------------------
+@x [32] m.619 l.12318 hlist_out - e-TeX TeXXeT
+prune_movements(save_loc);
+@y
+if eTeX_ex then
+ begin @<Check for LR anomalies at the end of |hlist_out|@>;
+ if subtype(this_box)=dlist then cur_dir:=right_to_left;
+ end;
+prune_movements(save_loc);
+@z
+%---------------------------------------
+@x [32] m.620 l.12337 - e-TeX TeXXeT
+ p:=link(p);
+@y
+ prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|}
+ p:=link(p);
+@z
+%---------------------------------------
+@x [32] m.622 l.12362 - e-TeX TeXXeT
+kern_node,math_node:cur_h:=cur_h+width(p);
+@y
+kern_node:cur_h:=cur_h+width(p);
+math_node:begin if eTeX_ex then
+ @<Adjust \(t)the LR stack for the |hlist_out| routine; if necessary
+ reverse an hlist segment and |goto reswitch|@>;
+ cur_h:=cur_h+width(p);
+ end;
+@z
+%---------------------------------------
+@x [32] m.622 l.12364 - e-TeX TeXXeT
+othercases do_nothing
+@y
+@/@<Cases of |hlist_out| that arise in mixed direction text only@>@;
+othercases do_nothing
+@z
+%---------------------------------------
+@x [32] m.622 l.12369 - e-TeX TeXXeT
+next_p:p:=link(p);
+@y
+next_p:prev_p:=p; p:=link(p);
+@z
+%---------------------------------------
+@x [32] m.623 l.12376 - e-TeX TeXXeT
+ temp_ptr:=p; edge:=cur_h;
+@y
+ temp_ptr:=p; edge:=cur_h+width(p);
+ if cur_dir=right_to_left then cur_h:=edge;
+@z
+%---------------------------------------
+@x [32] m.623 l.12379 - e-TeX TeXXeT
+ cur_h:=edge+width(p); cur_v:=base_line;
+@y
+ cur_h:=edge; cur_v:=base_line;
+@z
+%---------------------------------------
+@x [32] m.625 l.12401 - e-TeX add_glue
+ begin if g_sign=stretching then
+ begin if stretch_order(g)=g_order then
+ begin vet_glue(float(glue_set(this_box))*stretch(g));
+@^real multiplication@>
+ rule_wd:=rule_wd+round(glue_temp);
+ end;
+ end
+ else if shrink_order(g)=g_order then
+ begin vet_glue(float(glue_set(this_box))*shrink(g));
+ rule_wd:=rule_wd-round(glue_temp);
+ end;
+ end;
+@y
+ add_glue(rule_wd);
+@z
+%---------------------------------------
+@x [32] m.626 l.12428 - e-TeX TeXXeT
+ edge:=cur_h+rule_wd; lx:=0;
+@y
+ if cur_dir=right_to_left then cur_h:=cur_h-10;
+ edge:=cur_h+rule_wd; lx:=0;
+@z
+%---------------------------------------
+@x [32] m.626 l.12434 - e-TeX TeXXeT
+ cur_h:=edge-10; goto next_p;
+@y
+ if cur_dir=right_to_left then cur_h:=edge
+ else cur_h:=edge-10;
+ goto next_p;
+@z
+%---------------------------------------
+@x [32] m.628 l.12473 - e-TeX TeXXeT
+synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+@y
+synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+if cur_dir=right_to_left then cur_h:=cur_h+leader_wd;
+@z
+%---------------------------------------
+@x [32] m.629 l.12489 vlist_out - e-TeX add_glue
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@y
+@z
+%---------------------------------------
+@x [32] m.629 l.12498 vlist_out - e-TeX add_glue
+@!glue_temp:real; {glue value before rounding}
+begin this_box:=temp_ptr; g_order:=glue_order(this_box);
+@y
+begin this_box:=temp_ptr;
+@z
+%---------------------------------------
+@x [32] m.632 l.12544 - e-TeX TeXXeT
+ cur_h:=left_edge+shift_amount(p); {shift the box right}
+@y
+ if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p)
+ else cur_h:=left_edge+shift_amount(p); {shift the box right}
+@z
+%---------------------------------------
+@x [32] m.633 l.12556 - e-TeX TeXXeT
+ begin synch_h; synch_v;
+ dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+@y
+ begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
+ synch_h; synch_v;
+ dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+ cur_h:=left_edge;
+@z
+%---------------------------------------
+@x [32] m.634 l.12564 - e-TeX add_glue
+ begin if g_sign=stretching then
+ begin if stretch_order(g)=g_order then
+ begin vet_glue(float(glue_set(this_box))*stretch(g));
+@^real multiplication@>
+ rule_ht:=rule_ht+round(glue_temp);
+ end;
+ end
+ else if shrink_order(g)=g_order then
+ begin vet_glue(float(glue_set(this_box))*shrink(g));
+ rule_ht:=rule_ht-round(glue_temp);
+ end;
+ end;
+@y
+ add_glue(rule_ht);
+@z
+%---------------------------------------
+@x [32] m.637 l.12619 - e-TeX TeXXeT
+begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/
+@y
+begin if cur_dir=right_to_left then
+ cur_h:=left_edge-shift_amount(leader_box)
+ else cur_h:=left_edge+shift_amount(leader_box);
+synch_h; save_h:=dvi_h;@/
+@z
+%---------------------------------------
+@x [32] m.638 l.12656 ship_out - e-TeX TeXXeT
+@<Ship box |p| out@>;
+@y
+@<Ship box |p| out@>;
+if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>;
+@z
+%---------------------------------------
+@x [33] m.649 l.12876 hpack - e-TeX TeXXeT
+h:=0; @<Clear dimensions to zero@>;
+@y
+h:=0; @<Clear dimensions to zero@>;
+if TeXXeT_en then @<Initialize the LR stack@>;
+@z
+%---------------------------------------
+@x [33] m.649 l.12886 hpack - e-TeX TeXXeT
+exit: hpack:=r;
+@y
+exit: if TeXXeT_en then @<Check for LR anomalies at the end of |hpack|@>;
+hpack:=r;
+@z
+%---------------------------------------
+@x [33] m.651 l.12910 - e-TeX TeXXeT
+ kern_node,math_node: x:=x+width(p);
+@y
+ kern_node: x:=x+width(p);
+ math_node: begin x:=x+width(p);
+ if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>;
+ end;
+@z
+%---------------------------------------
+@x [34] m.687 l.13480 - e-TeX middle
+\TeX's \.{\\left} and \.{\\right}. The |nucleus| of such noads is
+@y
+\TeX's \.{\\left} and \.{\\right} as well as \eTeX's \.{\\middle}.
+The |nucleus| of such noads is
+@z
+%---------------------------------------
+@x [34] m.687 l.13497 - e-TeX middle
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@y
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@d middle_noad==1 {|subtype| of right noad representing \.{\\middle}}
+@z
+%---------------------------------------
+@x [34] m.696 l.13670 - e-TeX middle
+right_noad: begin print_esc("right"); print_delimiter(nucleus(p));
+ end;
+end;
+if subtype(p)<>normal then
+ if subtype(p)=limits then print_esc("limits")
+ else print_esc("nolimits");
+if type(p)<left_noad then print_subsidiary_data(nucleus(p),".");
+@y
+right_noad: begin if subtype(p)=normal then print_esc("right")
+ else print_esc("middle");
+ print_delimiter(nucleus(p));
+ end;
+end;
+if type(p)<left_noad then
+ begin if subtype(p)<>normal then
+ if subtype(p)=limits then print_esc("limits")
+ else print_esc("nolimits");
+ print_subsidiary_data(nucleus(p),".");
+ end;
+@z
+%---------------------------------------
+@x [36] m.727 l.14268 - e-TeX middle
+done_with_noad: r:=q; r_type:=type(r);
+@y
+done_with_noad: r:=q; r_type:=type(r);
+if r_type=right_noad then
+ begin r_type:=left_noad; cur_style:=style; @<Set up the values...@>;
+ end;
+@z
+%---------------------------------------
+@x [36] m.760 l.14929 - e-TeX middle
+ r_type:=t;
+@y
+ if type(q)=right_noad then t:=open_noad;
+ r_type:=t;
+@z
+%---------------------------------------
+@x [36] m.762 l.14970 make_left_right - e-TeX middle
+begin if style<script_style then cur_size:=text_size
+else cur_size:=16*((style-text_style) div 2);
+@y
+begin cur_style:=style; @<Set up the values...@>;
+@z
+%---------------------------------------
+@x [37] m.785 l.15461 align_peek - e-TeX protected
+begin restart: align_state:=1000000; @<Get the next non-blank non-call token@>;
+@y
+begin restart: align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+@z
+%---------------------------------------
+@x [37] m.791 l.15572 fin_col - e-TeX protected
+align_state:=1000000; @<Get the next non-blank non-call token@>;
+@y
+align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+@z
+%---------------------------------------
+@x [37] m.807 l.15834 - e-TeX TeXXeT
+ begin type(q):=hlist_node; width(q):=width(p);
+@y
+ begin type(q):=hlist_node; width(q):=width(p);
+ if nest[nest_ptr-1].mode_field=mmode then subtype(q):=dlist; {for |ship_out|}
+@z
+%---------------------------------------
+@x [37] m.808 l.15852 - e-TeX TeXXeT
+n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+@y
+n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+subtype(r):=min_quarterword; {for |ship_out|}
+@z
+%---------------------------------------
+@x [38] m.814 l.15975 - e-TeX penalties
+There is one explicit parameter: |final_widow_penalty| is the amount of
+additional penalty to be inserted before the final line of the paragraph.
+@y
+There is one explicit parameter: |d| is true for partial paragraphs
+preceding display math mode; in this case the amount of additional
+penalty inserted before the final line is |display_widow_penalty|
+instead of |widow_penalty|.
+@z
+%---------------------------------------
+@x [38] m.815 l.16002 line_break - e-TeX penalties
+procedure line_break(@!final_widow_penalty:integer);
+@y
+procedure line_break(@!d:boolean);
+@z
+%---------------------------------------
+@x [38] m.815 l.16012 - e-TeX basic
+end;
+@y
+end;
+@#
+@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@>
+@z
+%---------------------------------------
+@x [38] m.816 l.16032 - e-TeX last_line_fit
+link(tail):=new_param_glue(par_fill_skip_code);
+@y
+link(tail):=new_param_glue(par_fill_skip_code);
+last_line_fill:=link(tail);
+@z
+%---------------------------------------
+@x [38] m.819 l.16097 - e-TeX last_line_fit
+@d active_node_size=3 {number of words in active nodes}
+@y
+@d active_node_size_normal=3 {number of words in normal active nodes}
+@z
+%---------------------------------------
+@x [38] m.827 l.16260 - e-TeX last_line_fit
+background[6]:=shrink(q)+shrink(r);
+@y
+background[6]:=shrink(q)+shrink(r);
+@<Check for special treatment of last line of paragraph@>;
+@z
+%---------------------------------------
+@x [38] m.829 l.16311 try_break - e-TeX last_line_fit
+label exit,done,done1,continue,deactivate;
+@y
+label exit,done,done1,continue,deactivate,found,not_found;
+@z
+%---------------------------------------
+@x [38] m.845 l.16603 - e-TeX last_line_fit
+total_demerits(q):=minimal_demerits[fit_class];
+@y
+total_demerits(q):=minimal_demerits[fit_class];
+if do_last_line_fit then
+ @<Store \(a)additional data in the new active node@>;
+@z
+%---------------------------------------
+@x [38] m.846 l.16616 - e-TeX last_line_fit
+print(" t="); print_int(total_demerits(q));
+@y
+print(" t="); print_int(total_demerits(q));
+if do_last_line_fit then @<Print additional data in the new active node@>;
+@z
+%---------------------------------------
+@x [38] m.851 l.16715 - e-TeX last_line_fit
+if (b>inf_bad)or(pi=eject_penalty) then
+@y
+if do_last_line_fit then @<Adjust \(t)the additional data for last line@>;
+found:
+if (b>inf_bad)or(pi=eject_penalty) then
+@z
+%---------------------------------------
+@x [38] m.852 l.16739 - e-TeX last_line_fit
+ begin b:=0; fit_class:=decent_fit; {infinite stretch}
+@y
+ begin if do_last_line_fit then
+ begin if cur_p=null then {the last line of a paragraph}
+ @<Perform computations for last line and |goto found|@>;
+ shortfall:=0;
+ end;
+ b:=0; fit_class:=decent_fit; {infinite stretch}
+@z
+%---------------------------------------
+@x [38] m.855 l.16796 - e-TeX last_line_fit
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+@y
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+ if do_last_line_fit then
+ @<Store \(a)additional data for this feasible break@>;
+@z
+%---------------------------------------
+@x [39] m.863 l.16969 - e-TeX last_line_fit
+ end;@+tats@/
+@y
+ end;@+tats@/
+if do_last_line_fit then @<Adjust \(t)the final line of the paragraph@>;
+@z
+%---------------------------------------
+@x [39] m.864 l.16980 - e-TeX last_line_fit
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+@y
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+if do_last_line_fit then
+ @<Initialize additional fields of the first active node@>;
+@z
+%---------------------------------------
+@x [39] m.866 l.17030 - e-TeX TeXXeT
+math_node: begin auto_breaking:=(subtype(cur_p)=after); kern_break;
+@y
+math_node: begin if subtype(cur_p)<L_code then auto_breaking:=end_LR(cur_p);
+ kern_break;
+@z
+%---------------------------------------
+@x [39] m.876 l.17192 - e-TeX penalties
+post_line_break(final_widow_penalty)
+@y
+post_line_break(d)
+@z
+%---------------------------------------
+@x [39] m.877 l.17206 post_line_break - e-TeX penalties
+procedure post_line_break(@!final_widow_penalty:integer);
+@y
+procedure post_line_break(@!d:boolean);
+@z
+%---------------------------------------
+@x [39] m.877 l.17216 post_line_break - e-TeX TeXXeT
+begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+@y
+@!LR_ptr:pointer; {stack of LR codes}
+begin LR_ptr:=LR_save;
+@<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+@z
+%---------------------------------------
+@x [39] m.877 l.17229 post_line_break - e-TeX TeXXeT
+prev_graf:=best_line-1;
+@y
+prev_graf:=best_line-1;
+LR_save:=LR_ptr;
+@z
+%---------------------------------------
+@x [39] m.879 l.17259 - e-TeX TeXXeT
+ r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
+@y
+ r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
+ if type(q)=math_node then if TeXXeT_en then
+ @<Adjust \(t)the LR stack for the |post_line_break| routine@>;
+@z
+%---------------------------------------
+@x [39] m.880 l.17276 - e-TeX TeXXeT
+@<Modify the end of the line to reflect the nature of the break and to include
+ \.{\\rightskip}; also set the proper value of |disc_break|@>;
+@y
+if TeXXeT_en then
+ @<Insert LR nodes at the beginning of the current line and adjust
+ the LR stack based on LR nodes in this line@>;
+@<Modify the end of the line to reflect the nature of the break and to include
+ \.{\\rightskip}; also set the proper value of |disc_break|@>;
+if TeXXeT_en then @<Insert LR nodes at the end of the current line@>;
+@z
+%---------------------------------------
+@x [39] m.881 l.17299 - e-TeX TeXXeT
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+@y
+ else if type(q)=kern_node then width(q):=0
+ else if type(q)=math_node then
+ begin width(q):=0;
+ if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>;
+ end;
+@z
+%---------------------------------------
+@x [39] m.890 l.17395 - e-TeX penalties
+ begin pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+@y
+ begin q:=inter_line_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=penalty(q+r);
+ end
+ else pen:=inter_line_penalty;
+ q:=club_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line-prev_graf;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if d then q:=display_widow_penalties_ptr
+ else q:=widow_penalties_ptr;
+ if q<>null then
+ begin r:=best_line-cur_line-1;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line+2=best_line then
+ if d then pen:=pen+display_widow_penalty
+ else pen:=pen+widow_penalty;
+@z
+%---------------------------------------
+@x [40] m.891 l.17460 - e-TeX hyph_codes
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+@y
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+set_hyph_index;
+@z
+%---------------------------------------
+@x [40] m.896 l.17529 - e-TeX hyph_codes
+ if lc_code(c)<>0 then
+ if (lc_code(c)=c)or(uc_hyph>0) then goto done2
+@y
+ set_lc_code(c);
+ if hc[0]<>0 then
+ if (hc[0]=c)or(uc_hyph>0) then goto done2
+@z
+%---------------------------------------
+@x [40] m.897 l.17546 - e-TeX hyph_codes
+ if lc_code(c)=0 then goto done3;
+ if hn=63 then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=lc_code(c); hyf_bchar:=non_char;
+@y
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if hn=63 then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char;
+@z
+%---------------------------------------
+@x [40] m.898 l.17572 - e-TeX hyph_codes
+ if lc_code(c)=0 then goto done3;
+ if j=63 then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=lc_code(c);@/
+@y
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if j=63 then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=hc[0];@/
+@z
+%---------------------------------------
+@x [42] m.934 l.18211 new_hyph_exceptions - e-TeX hyph_codes
+label reswitch, exit, found, not_found;
+@y
+label reswitch, exit, found, not_found, not_found1;
+@z
+%---------------------------------------
+@x [42] m.934 l.18221 new_hyph_exceptions - e-TeX hyph_codes
+set_cur_lang;
+@y
+set_cur_lang;
+@!init if trie_not_ready then
+ begin hyph_index:=0; goto not_found1;
+ end;
+tini@/
+set_hyph_index;
+not_found1:
+@z
+%---------------------------------------
+@x [42] m.937 l.18253 - e-TeX hyph_codes
+else begin if lc_code(cur_chr)=0 then
+@y
+else begin set_lc_code(cur_chr);
+ if hc[0]=0 then
+@z
+%---------------------------------------
+@x [42] m.937 l.18261 - e-TeX hyph_codes
+ begin incr(n); hc[n]:=lc_code(cur_chr);
+@y
+ begin incr(n); hc[n]:=hc[0];
+@z
+%---------------------------------------
+@x [43] m.952 l.18549 - e-TeX hyph_codes
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+@y
+hyph_root:=compress_trie(hyph_root);
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+@z
+%---------------------------------------
+@x [43] m.958 l.18637 - e-TeX hyph_codes
+if trie_root=0 then {no patterns were given}
+@y
+if trie_max=0 then {no patterns were given}
+@z
+%---------------------------------------
+@x [43] m.958 l.18641 - e-TeX hyph_codes
+else begin trie_fix(trie_root); {this fixes the non-holes in |trie|}
+@y
+else begin if hyph_root>0 then trie_fix(hyph_root);
+ if trie_root>0 then trie_fix(trie_root); {this fixes the non-holes in |trie|}
+@z
+%---------------------------------------
+@x [43] m.960 l.18684 new_patterns - e-TeX hyph_codes
+ brace@>;
+@y
+ brace@>;
+ if saving_hyph_codes>0 then
+ @<Store hyphenation codes for current language@>;
+@z
+%---------------------------------------
+@x [43] m.966 l.18791 init_trie - e-TeX hyph_codes
+@<Move the data into |trie|@>;
+@y
+if hyph_root<>0 then @<Pack all stored |hyph_codes|@>;
+@<Move the data into |trie|@>;
+@z
+%---------------------------------------
+@x [44] m.968 l.18807 - e-TeX saved_items
+whenever this is possible without backspacing.
+@y
+whenever this is possible without backspacing.
+
+When the second argument |s| is |false| the deleted nodes are destroyed,
+otherwise they are collected in a list starting at |split_disc|.
+@z
+%---------------------------------------
+@x [44] m.968 l.18814 prune_page_top - e-TeX saved_items
+@p function prune_page_top(@!p:pointer):pointer; {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q:pointer; {temporary variable for list manipulation}
+@y
+@p function prune_page_top(@!p:pointer;@!s:boolean):pointer;
+ {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q,@!r:pointer; {temporary variables for list manipulation}
+@z
+%---------------------------------------
+@x [44] m.968 l.18825 prune_page_top - e-TeX saved_items
+ link(prev_p):=p; flush_node_list(q);
+@y
+ link(prev_p):=p;
+ if s then
+ begin if split_disc=null then split_disc:=q@+else link(r):=q;
+ r:=q;
+ end
+ else flush_node_list(q);
+@z
+%---------------------------------------
+@x [44] m.977 l.18992 vsplit - e-TeX marks, sparse arrays
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+@y
+@p @t\4@>@<Declare the function called |do_marks|@>@;
+function vsplit(@!n:halfword; @!h:scaled):pointer;
+@z
+%---------------------------------------
+@x [44] m.977 l.18998 vsplit - e-TeX sparse arrays
+begin v:=box(n);
+@y
+begin cur_val:=n; fetch_box(v);
+@z
+%---------------------------------------
+@x [44] m.977 l.18999 vsplit - e-TeX marks, saved_items
+if split_first_mark<>null then
+@y
+flush_node_list(split_disc); split_disc:=null;
+if sa_mark<>null then
+ if do_marks(vsplit_init,0,sa_mark) then sa_mark:=null;
+if split_first_mark<>null then
+@z
+%---------------------------------------
+@x [44] m.977 l.19007 vsplit - e-TeX saved_items
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+@y
+q:=prune_page_top(q,saving_vdiscards>0);
+p:=list_ptr(v); free_node(v,box_node_size);
+@z
+%---------------------------------------
+@x [44] m.977 l.19008 vsplit - e-TeX sparse arrays
+if q=null then box(n):=null {the |eq_level| of the box stays the same}
+else box(n):=vpack(q,natural);
+@y
+if q<>null then q:=vpack(q,natural);
+change_box(q); {the |eq_level| of the box stays the same}
+@z
+%---------------------------------------
+@x [44] m.979 l.19033 - e-TeX marks
+ if split_first_mark=null then
+@y
+ if mark_class(p)<>0 then @<Update the current marks for |vsplit|@>
+ else if split_first_mark=null then
+@z
+%---------------------------------------
+@x [45] m.982 l.19167 - e-TeX last_node_type
+The variables |last_penalty| and |last_kern| are similar. And
+@y
+The variables |last_penalty|, |last_kern|, and |last_node_type|
+are similar. And
+@z
+%---------------------------------------
+@x [45] m.982 l.19180 - e-TeX last_node_type
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@y
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@!last_node_type:integer; {used to implement \.{\\lastnodetype}}
+@z
+%---------------------------------------
+@x [45] m.991 l.19317 - e-TeX last_node_type
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+@y
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+last_node_type:=-1;
+@z
+%---------------------------------------
+@x [45] m.996 l.19384 - e-TeX last_node_type
+last_penalty:=0; last_kern:=0;
+@y
+last_penalty:=0; last_kern:=0;
+last_node_type:=type(p)+1;
+@z
+%---------------------------------------
+@x [45] m.999 l.19421 - e-TeX saved_items
+link(contrib_head):=link(p); link(p):=null; flush_node_list(p)
+@y
+link(contrib_head):=link(p); link(p):=null;
+if saving_vdiscards>0 then
+ begin if page_disc=null then page_disc:=p@+else link(tail_page_disc):=p;
+ tail_page_disc:=p;
+ end
+else flush_node_list(p)
+@z
+%---------------------------------------
+@x [45] m.1012 l.19661 fire_up - e-TeX marks
+if bot_mark<>null then
+@y
+if sa_mark<>null then
+ if do_marks(fire_up_init,0,sa_mark) then sa_mark:=null;
+if bot_mark<>null then
+@z
+%---------------------------------------
+@x [45] m.1012 l.19669 fire_up - e-TeX marks
+if (top_mark<>null)and(first_mark=null) then
+@y
+if sa_mark<>null then
+ if do_marks(fire_up_done,0,sa_mark) then sa_mark:=null;
+if (top_mark<>null)and(first_mark=null) then
+@z
+%---------------------------------------
+@x [45] m.1014 l.19706 - e-TeX marks
+ else if type(p)=mark_node then @<Update the values of
+@y
+ else if type(p)=mark_node then
+ if mark_class(p)<>0 then @<Update the current marks for |fire_up|@>
+ else @<Update the values of
+@z
+%---------------------------------------
+@x [45] m.1021 l.19818 - e-TeX saved_items
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+@y
+ ins_ptr(p):=prune_page_top(broken_ptr(r),false);
+@z
+%---------------------------------------
+@x [45] m.1023 l.19854 - e-TeX saved_items
+ship_out(box(255)); box(255):=null;
+@y
+flush_node_list(page_disc); page_disc:=null;
+ship_out(box(255)); box(255):=null;
+@z
+%---------------------------------------
+@x [45] m.1026 l.19896 - e-TeX saved_items
+pop_nest; build_page;
+@y
+flush_node_list(page_disc); page_disc:=null;
+pop_nest; build_page;
+@z
+%---------------------------------------
+@x [47] m.1070 l.20697 normal_paragraph - e-TeX penalties
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+@y
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+if inter_line_penalties_ptr<>null then
+ eq_define(inter_line_penalties_loc,shape_ref,null);
+@z
+%---------------------------------------
+@x [47] m.1071 l.20718 - e-TeX sparse arrays
+|box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}';
+codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox255}';
+code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513|
+through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}',
+@y
+|global_box_flag-1| represent `\.{\\setbox0}' through `\.{\\setbox32767}';
+codes |global_box_flag| through |ship_out_flag-1| represent
+`\.{\\global\\setbox0}' through `\.{\\global\\setbox32767}';
+code |ship_out_flag| represents `\.{\\shipout}'; and codes |leader_flag|
+through |leader_flag+2| represent `\.{\\leaders}', `\.{\\cleaders}',
+@z
+%---------------------------------------
+@x [47] m.1071 l.20732 - e-TeX sparse arrays
+@d ship_out_flag==box_flag+512 {context code for `\.{\\shipout}'}
+@d leader_flag==box_flag+513 {context code for `\.{\\leaders}'}
+@y
+@d global_box_flag==@'10000100000 {context code for `\.{\\global\\setbox0}'}
+@d ship_out_flag==@'10000200000 {context code for `\.{\\shipout}'}
+@d leader_flag==@'10000200001 {context code for `\.{\\leaders}'}
+@z
+%---------------------------------------
+@x [47] m.1075 l.20815 box_end - e-TeX sparse arrays
+var p:pointer; {|ord_noad| for new box in math mode}
+@y
+var p:pointer; {|ord_noad| for new box in math mode}
+@!a:small_number; {global prefix}
+@z
+%---------------------------------------
+@x [47] m.1077 l.20853 - e-TeX sparse arrays
+if box_context<box_flag+256 then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-256+box_context,box_ref,cur_box)
+@y
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+@z
+%---------------------------------------
+@x [47] m.1079 l.20885 begin_box - e-TeX sparse arrays
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ box(cur_val):=null; {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+@y
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ change_box(null); {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+@z
+%---------------------------------------
+@x [47] m.1080 l.20901 - e-TeX TeXXeT
+since |head| is a one-word node.
+@y
+since |head| is a one-word node.
+A final \.{\\endM} node is temporarily removed.
+@z
+%---------------------------------------
+@x [47] m.1080 l.20914 - e-TeX TeXXeT
+ if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+ @<Remove the last box, unless it's part of a discretionary@>;
+@y
+ begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+ remove_end_M;
+ if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+ @<Remove the last box, unless it's part of a discretionary@>;
+ if LR_temp<>null then insert_end_M;
+ end;
+@z
+%---------------------------------------
+@x [47] m.1082 l.20935 - e-TeX sparse arrays
+begin scan_eight_bit_int; n:=cur_val;
+@y
+begin scan_register_num; n:=cur_val;
+@z
+%---------------------------------------
+@x [47] m.1096 l.21119 - e-TeX penalties, TeXXeT
+ else line_break(widow_penalty);
+@y
+ else line_break(false);
+ if LR_save<>null then
+ begin flush_list(LR_save); LR_save:=null;
+ end;
+@z
+%---------------------------------------
+@x [47] m.1101 l.21175 make_mark - e-TeX marks
+begin p:=scan_toks(false,true); p:=get_node(small_node_size);
+@y
+@!c:halfword; {the mark class}
+begin if cur_chr=0 then c:=0
+else begin scan_register_num; c:=cur_val;
+ end;
+p:=scan_toks(false,true); p:=get_node(small_node_size);
+mark_class(p):=c;
+@z
+%---------------------------------------
+@x [47] m.1105 l.21203 - e-TeX TeXXeT
+will be deleted, if present.
+@y
+will be deleted, if present.
+A final \.{\\endM} node is temporarily removed.
+@z
+%---------------------------------------
+@x [47] m.1105 l.21213 delete_last - e-TeX TeXXeT
+else begin if not is_char_node(tail) then if type(tail)=cur_chr then
+@y
+else begin if not is_char_node(tail) then
+ begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+ remove_end_M;
+ if type(tail)=cur_chr then
+@z
+%---------------------------------------
+@x [47] m.1105 l.21224 delete_last - e-TeX TeXXeT
+ end;
+@y
+ if LR_temp<>null then insert_end_M;
+ end;
+ end;
+@z
+%---------------------------------------
+@x [47] m.1108 l.21262 - e-TeX saved_items
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+@y
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+ @<Cases of |un_vbox| for |print_cmd_chr|@>@/
+@z
+%---------------------------------------
+@x [47] m.1110 l.21272 unpackage - e-TeX saved_items
+label exit;
+@y
+label done, exit;
+@z
+%---------------------------------------
+@x [47] m.1110 l.21275 unpackage - e-TeX saved_items, sparse arrays
+begin c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+@y
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+@z
+%---------------------------------------
+@x [47] m.1110 l.21287 unpackage - e-TeX sparse arrays
+else begin link(tail):=list_ptr(p); box(cur_val):=null;
+@y
+else begin link(tail):=list_ptr(p); change_box(null);
+@z
+%---------------------------------------
+@x [47] m.1110 l.21290 unpackage - e-TeX saved_items
+while link(tail)<>null do tail:=link(tail);
+@y
+done:
+while link(tail)<>null do tail:=link(tail);
+@z
+%---------------------------------------
+@x [47] m.1130 l.21562 - e-TeX TeXXeT
+vmode+halign,hmode+valign:init_align;
+@y
+vmode+halign:init_align;
+hmode+valign:@<Cases of |main_control| for |hmode+valign|@>@; init_align;
+@z
+%---------------------------------------
+@x [48] m.1138 l.21629 init_math - e-TeX TeXXeT
+procedure init_math;
+label reswitch,found,not_found,done;
+var w:scaled; {new or partial |pre_display_size|}
+@y
+@t\4@>@<Declare subprocedures for |init_math|@>@;
+procedure init_math;
+label reswitch,found,not_found,done;
+var w:scaled; {new or partial |pre_display_size|}
+@!j:pointer; {prototype box for display}
+@!x:integer; {new |pre_display_direction|}
+@z
+%---------------------------------------
+@x [48] m.1145 l.21687 - e-TeX TeXXeT, penalties
+begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+ begin pop_nest; w:=-max_dimen;
+ end
+else begin line_break(display_widow_penalty);@/
+@y
+begin j:=null; w:=-max_dimen;
+if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+ @<Prepare for display after an empty paragraph@>
+else begin line_break(true);@/
+@z
+%---------------------------------------
+@x [48] m.1145 l.21700 - e-TeX TeXXeT
+eq_word_define(dimen_base+pre_display_size_code,w);
+@y
+eq_word_define(dimen_base+pre_display_size_code,w);
+LR_box:=j;
+if eTeX_ex then eq_word_define(int_base+pre_display_direction_code,x);
+@z
+%---------------------------------------
+@x [48] m.1146 l.21708 - e-TeX TeXXeT
+v:=shift_amount(just_box)+2*quad(cur_font); w:=-max_dimen;
+p:=list_ptr(just_box);
+@y
+@<Prepare for display after a non-empty paragraph@>;
+@z
+%---------------------------------------
+@x [48] m.1146 l.21723 - e-TeX TeXXeT
+done:
+@y
+done:
+@<Finish the natural width computation@>
+@z
+%---------------------------------------
+@x [48] m.1147 l.21734 - e-TeX TeXXeT
+kern_node,math_node: d:=width(p);
+@y
+kern_node: d:=width(p);
+@t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@;
+@z
+%---------------------------------------
+@x [48] m.1185 l.22243 - e-TeX middle
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+@y
+ if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(delim_ptr);
+ link(delim_ptr):=incompleat_noad; link(incompleat_noad):=p;
+@z
+%---------------------------------------
+@x [48] m.1189 l.22288 - e-TeX middle
+else print_esc("right");
+@y
+@/@<Cases of |left_right| for |print_cmd_chr|@>@/
+else print_esc("right");
+@z
+%---------------------------------------
+@x [48] m.1191 l.22297 math_left_right - e-TeX middle
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+@y
+@!q:pointer; {resulting mlist}
+begin t:=cur_chr;
+if (t<>left_noad)and(cur_group<>math_left_group) then
+@z
+%---------------------------------------
+@x [48] m.1191 l.22302 math_left_right - e-TeX middle
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
+@y
+ if t=middle_noad then
+ begin type(p):=right_noad; subtype(p):=middle_noad;
+ end;
+ if t=left_noad then q:=p
+ else begin q:=fin_mlist(p); unsave; {end of |math_left_group|}
+ end;
+ if t<>right_noad then
+ begin push_math(math_left_group); link(head):=q; tail:=p;
+ delim_ptr:=p;
+ end
+ else begin
+@z
+%---------------------------------------
+@x [48] m.1191 l.22308 math_left_right - e-TeX middle
+ info(nucleus(tail)):=p;
+@y
+ info(nucleus(tail)):=q;
+@z
+%---------------------------------------
+@x [48] m.1192 l.22316 - e-TeX middle
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+@y
+ print_err("Extra ");
+ if t=middle_noad then
+ begin print_esc("middle");
+@.Extra \\middle.@>
+ help1("I'm ignoring a \middle that had no matching \left.");
+ end
+ else begin print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ end;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22331 after_math - e-TeX TeXXeT
+procedure after_math;
+@y
+@t\4@>@<Declare subprocedures for |after_math|@>@;
+procedure after_math;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22338 after_math - e-TeX TeXXeT
+begin danger:=false;
+@y
+begin danger:=false;
+@<Retrieve the prototype box@>;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22345 after_math - e-TeX TeXXeT
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+@y
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ subtype(a):=dlist;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22348 after_math - e-TeX TeXXeT
+ danger:=false;
+@y
+ danger:=false;
+ @<Retrieve the prototype box@>;
+@z
+%---------------------------------------
+@x [48] m.1199 l.22435 - e-TeX TeXXeT
+w:=width(b); z:=display_width; s:=display_indent;
+@y
+w:=width(b); z:=display_width; s:=display_indent;
+if pre_display_direction<0 then s:=-s-z;
+@z
+%---------------------------------------
+@x [48] m.1199 l.22450 - e-TeX TeXXeT
+resume_after_display
+@y
+@<Flush the prototype box@>;
+resume_after_display
+@z
+%---------------------------------------
+@x [48] m.1202 l.22492 - e-TeX TeXXeT
+d:=half(z-w);
+@y
+subtype(b):=dlist;
+d:=half(z-w);
+@z
+%---------------------------------------
+@x [48] m.1203 l.22513 - e-TeX TeXXeT
+ begin shift_amount(a):=s; append_to_vlist(a);
+@y
+ begin app_display(j,a,0);
+@z
+%---------------------------------------
+@x [48] m.1204 l.22528 - e-TeX TeXXeT
+shift_amount(b):=s+d; append_to_vlist(b)
+@y
+app_display(j,b,d)
+@z
+%---------------------------------------
+@x [48] m.1205 l.22533 - e-TeX TeXXeT
+ shift_amount(a):=s+z-width(a);
+ append_to_vlist(a);
+@y
+ app_display(j,a,z-width(a));
+@z
+%---------------------------------------
+@x [48] m.1206 l.22552 - e-TeX TeXXeT
+pop_nest;
+@y
+flush_node_list(LR_box);
+pop_nest;
+@z
+%---------------------------------------
+@x [49] m.1208 l.22577 - e-TeX protected
+control sequence can be defined to be `\.{\\long}' or `\.{\\outer}', and
+it might or might not be expanded. The prefixes `\.{\\global}', `\.{\\long}',
+@y
+control sequence can be defined to be `\.{\\long}', `\.{\\protected}',
+or `\.{\\outer}', and it might or might not be expanded. The prefixes
+`\.{\\global}', `\.{\\long}', `\.{\\protected}',
+@z
+%---------------------------------------
+@x [49] m.1209 l.22603 - e-TeX protected
+ else print_esc("global");
+@y
+ @/@<Cases of |prefix| for |print_cmd_chr|@>@/
+ else print_esc("global");
+@z
+%---------------------------------------
+@x [49] m.1211 l.22665 prefixed_command - e-TeX tracing
+ @<Discard erroneous prefixes and |return|@>;
+@y
+ @<Discard erroneous prefixes and |return|@>;
+ if tracing_commands>2 then if eTeX_ex then show_cur_cmd_chr;
+@z
+%---------------------------------------
+@x [49] m.1213 l.22686 - e-TeX protected
+if (cur_cmd<>def)and(a mod 4<>0) then
+@y
+if a>=8 then
+ begin j:=protected_token; a:=a-8;
+ end
+else j:=0;
+if (cur_cmd<>def)and((a mod 4<>0)or(j<>0)) then
+@z
+%---------------------------------------
+@x [49] m.1218 l.22749 - e-TeX protected
+ q:=scan_toks(true,e); define(p,call+(a mod 4),def_ref);
+@y
+ q:=scan_toks(true,e);
+ if j<>0 then
+ begin q:=get_avail; info(q):=j; link(q):=link(def_ref);
+ link(def_ref):=q;
+ end;
+ define(p,call+(a mod 4),def_ref);
+@z
+%---------------------------------------
+@x [49] m.1224 l.22840 - e-TeX sparse arrays
+ othercases begin scan_eight_bit_int;
+@y
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+@z
+%---------------------------------------
+@x [49] m.1225 l.22853 - e-TeX read_line
+read_to_cs: begin scan_int; n:=cur_val;
+@y
+read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1225 l.22861 - e-TeX read_line
+ p:=cur_cs; read_toks(n,p); define(p,call,cur_val);
+@y
+ p:=cur_cs; read_toks(n,p,j); define(p,call,cur_val);
+@z
+%---------------------------------------
+@x [49] m.1226 l.22870 - e-TeX sparse arrays
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@y
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true;
+ p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@z
+%---------------------------------------
+@x [49] m.1226 l.22880 - e-TeX sparse arrays
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+@y
+ begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+@z
+%---------------------------------------
+@x [49] m.1226 l.22888 - e-TeX sparse arrays
+ define(p,call,def_ref);
+@y
+ sa_define(p,def_ref)(p,call,def_ref);
+@z
+%---------------------------------------
+@x [49] m.1227 l.22893 - e-TeX sparse arrays
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+@y
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_ptr)
+ else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+@z
+%---------------------------------------
+@x [49] m.1236 l.23009 do_register_command - e-TeX sparse arrays
+begin q:=cur_cmd;
+@y
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@z
+%---------------------------------------
+@x [49] m.1236 l.23024 do_register_command - e-TeX sparse arrays
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+@y
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
+@z
+%---------------------------------------
+@x [49] m.1237 l.23046 - e-TeX sparse arrays
+p:=cur_chr; scan_eight_bit_int;
+@y
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+@z
+%---------------------------------------
+@x [49] m.1237 l.23053 - e-TeX sparse arrays
+end;
+found:
+@y
+ end;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=eqtb[l].int
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+@z
+%---------------------------------------
+@x [49] m.1238 l.23059 - e-TeX sparse arrays
+ if q=advance then cur_val:=cur_val+eqtb[l].int;
+@y
+ if q=advance then cur_val:=cur_val+w;
+@z
+%---------------------------------------
+@x [49] m.1239 l.23066 - e-TeX sparse arrays
+begin q:=new_spec(cur_val); r:=equiv(l);
+@y
+begin q:=new_spec(cur_val); r:=s;
+@z
+%---------------------------------------
+@x [49] m.1240 l.23086 - e-TeX sparse arrays
+ if p=int_val then cur_val:=mult_integers(eqtb[l].int,cur_val)
+ else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0)
+ else cur_val:=x_over_n(eqtb[l].int,cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+@y
+ if p=int_val then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin r:=new_spec(s);
+@z
+%---------------------------------------
+@x [49] m.1241 l.23108 - e-TeX sparse arrays
+set_box: begin scan_eight_bit_int;
+ if global then n:=256+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+@y
+set_box: begin scan_register_num;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@z
+%---------------------------------------
+@x [49] m.1246 l.23179 alter_integer - e-TeX interaction_mode
+var c:0..1; {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+@y
+var c:small_number;
+ {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+@/@<Cases for |alter_integer|@>@/
+@z
+%---------------------------------------
+@x [49] m.1247 l.23188 alter_box_dimen - e-TeX sparse arrays
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+@y
+@!b:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1248 l.23197 - e-TeX penalties
+set_shape: begin scan_optional_equals; scan_int; n:=cur_val;
+ if n<=0 then p:=null
+@y
+set_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val;
+ if n<=0 then p:=null
+ else if q>par_shape_loc then
+ begin n:=(cur_val div 2)+1; p:=get_node(2*n+1); info(p):=n;
+ n:=cur_val; mem[p+1].int:=n; {number of penalties}
+ for j:=p+2 to p+n+1 do
+ begin scan_int; mem[j].int:=cur_val; {penalty values}
+ end;
+ if not odd(n) then mem[p+n+2].int:=0; {unused}
+ end
+@z
+%---------------------------------------
+@x [49] m.1248 l.23207 - e-TeX penalties
+ define(par_shape_loc,shape_ref,p);
+@y
+ define(q,shape_ref,p);
+@z
+%---------------------------------------
+@x [49] m.1292 l.23581 - e-TeX show_groups
+ show_lists:print_esc("showlists");
+@y
+ show_lists:print_esc("showlists");
+ @<Cases of |xray| for |print_cmd_chr|@>@;@/
+@z
+%---------------------------------------
+@x [49] m.1293 l.23588 show_whatever - e-TeX show_ifs
+var p:pointer; {tail of a token list to show}
+@y
+var p:pointer; {tail of a token list to show}
+@!t:small_number; {type of conditional being shown}
+@!m:normal..or_code; {upper bound on |fi_or_else| codes}
+@!l:integer; {line where that conditional began}
+@!n:integer; {level of \.{\\if...\\fi} nesting}
+@z
+%---------------------------------------
+@x [49] m.1293 l.23594 show_whatever - e-TeX show_groups
+othercases @<Show the current value of some parameter or register,
+@y
+@<Cases for |show_whatever|@>@;@/
+othercases @<Show the current value of some parameter or register,
+@z
+%---------------------------------------
+@x [49] m.1295 l.23629 - e-TeX protected
+call: print("macro");
+long_call: print_esc("long macro");
+outer_call: print_esc("outer macro");
+long_outer_call: begin print_esc("long"); print_esc("outer macro");
+@y
+call,long_call,outer_call,long_outer_call: begin n:=cmd-call;
+ if info(link(chr_code))=protected_token then n:=n+4;
+ if odd(n div 4) then print_esc("protected");
+ if odd(n) then print_esc("long");
+ if odd(n div 2) then print_esc("outer");
+ if n>0 then print_char(" ");
+ print("macro");
+@z
+%---------------------------------------
+@x [49] m.1296 l.23637 - e-TeX sparse arrays
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+@y
+begin scan_register_num; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+@z
+%---------------------------------------
+@x [50] m.1307 l.23779 - e-TeX basic
+dump_int(@$);@/
+@y
+dump_int(@$);@/
+@<Dump the \eTeX\ state@>@/
+@z
+%---------------------------------------
+@x [50] m.1308 l.23794 - e-TeX basic
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@y
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@/@<Undump the \eTeX\ state@>@/
+@z
+%---------------------------------------
+@x [50] m.1311 l.23848 - e-TeX sparse arrays
+dump_int(lo_mem_max); dump_int(rover);
+@y
+dump_int(lo_mem_max); dump_int(rover);
+if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+@z
+%---------------------------------------
+@x [50] m.1312 l.23871 - e-TeX sparse arrays
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+@y
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+if eTeX_ex then for k:=int_val to tok_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24065 - e-TeX hyph_codes
+dump_int(trie_max);
+@y
+dump_int(trie_max);
+dump_int(hyph_start);
+@z
+%---------------------------------------
+@x [50] m.1325 l.24093 - e-TeX hyph_codes
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+@y
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+undump(0)(j)(hyph_start);
+@z
+%---------------------------------------
+@x [51] m.1335 l.24313 final_cleanup - tracing
+ print_int(cur_level-level_one); print_char(")");
+@y
+ print_int(cur_level-level_one); print_char(")");
+ if eTeX_ex then show_save_groups;
+@z
+%---------------------------------------
+@x [51] m.1335 l.24336 final_cleanup - e-TeX marks, saved_items
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+@y
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+@z
+%---------------------------------------
+@x [51] m.1336 l.24345 ] m.1336 l.24340 init_prim - e-TeX basic
+begin no_new_control_sequence:=false;
+@y
+begin no_new_control_sequence:=false;
+first:=0;
+@z
+%---------------------------------------
+@x [51] m.1337 l.24360 - e-TeX basic
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+@<Enable \eTeX, if requested@>@;@/
+if (format_ident=0)or(buffer[loc]="&") then
+@z
+%---------------------------------------
+@x [51] m.1337 l.24368 - e-TeX basic
+ end;
+@y
+ end;
+if eTeX_ex then wterm_ln('entering extended mode');
+@z
+%---------------------------------------
+@x [53] m.1363 l.24715 - e-TeX hyph_codes
+adv_past(s)
+@y
+if subtype(s)=language_node then
+ begin cur_lang:=what_lang(s); l_hyf:=what_lhm(s); r_hyf:=what_rhm(s);
+ set_hyph_index;
+ end
+@z
+%---------------------------------------
+@x [54] m.1379 l.24903 - e-TeX additions
+@* \[54] System-dependent changes.
+@y
+@* \[53a] The extended features of \eTeX.
+The program has two modes of operation: (1)~In \TeX\ compatibility mode
+it fully deserves the name \TeX\ and there are neither extended features
+nor additional primitive commands. There are, however, a few
+modifications that would be legitimate in any implementation of \TeX\
+such as, e.g., preventing inadequate results of the glue to \.{DVI}
+unit conversion during |ship_out|. (2)~In extended mode there are
+additional primitive commands and the extended features of \eTeX\ are
+available.
+
+The distinction between these two modes of operation initially takes
+place when a `virgin' \.{eINITEX} starts without reading a format file.
+Later on the values of all \eTeX\ state variables are inherited when
+\.{eVIRTEX} (or \.{eINITEX}) reads a format file.
+
+The code below is designed to work for cases where `$|init|\ldots|tini|$'
+is a run-time switch.
+
+@<Enable \eTeX, if requested@>=
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+ begin no_new_control_sequence:=false;
+ @<Generate all \eTeX\ primitives@>@;
+ incr(loc); eTeX_mode:=1; {enter extended mode}
+ @<Initialize variables for \eTeX\ extended mode@>@;
+ end;
+tini@;@/
+if not no_new_control_sequence then {just entered extended mode ?}
+ no_new_control_sequence:=true@+else
+
+@ The \eTeX\ features available in extended mode are grouped into two
+categories: (1)~Some of them are permanently enabled and have no
+semantic effect as long as none of the additional primitives are
+executed. (2)~The remaining \eTeX\ features are optional and can be
+individually enabled and disabled. For each optional feature there is
+an \eTeX\ state variable named \.{\\...state}; the feature is enabled,
+resp.\ disabled by assigning a positive, resp.\ non-positive value to
+that integer.
+
+@d eTeX_state_base=int_base+eTeX_state_code
+@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable}
+@#
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+@d eTeX_revision_code=6 {command code for \.{\\eTeXrevision}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+eTeX_version_code: print_esc("eTeXversion");
+
+@ @<Cases for fetching an integer value@>=
+eTeX_version_code: cur_val:=eTeX_version;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+eTeX_revision_code: print_esc("eTeXrevision");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+eTeX_revision_code: do_nothing;
+
+@ @<Cases of `Print the result of command |c|'@>=
+eTeX_revision_code: print(eTeX_revision);
+
+@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?}
+
+@<Glob...@>=
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+
+@ @<Initialize table entries...@>=
+eTeX_mode:=0; {initially we are in compatibility mode}
+@<Initialize variables for \eTeX\ compatibility mode@>@;
+
+@ @<Dump the \eTeX\ state@>=
+dump_int(eTeX_mode);
+for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+
+@ @<Undump the \eTeX\ state@>=
+undump(0)(1)(eTeX_mode);
+if eTeX_ex then
+ begin @<Initialize variables for \eTeX\ extended mode@>@;
+ end
+else begin @<Initialize variables for \eTeX\ compatibility mode@>@;
+ end;
+
+@ The |eTeX_enabled| function simply returns its first argument as
+result. This argument is |true| if an optional \eTeX\ feature is
+currently enabled; otherwise, if the argument is |false|, the function
+gives an error message.
+
+@<Declare \eTeX\ procedures for use...@>=
+function eTeX_enabled(@!b:boolean;@!j:quarterword;@!k:halfword):boolean;
+begin if not b then
+ begin print_err("Improper "); print_cmd_chr(j,k);
+ help1("Sorry, this optional e-TeX feature has been disabled."); error;
+ end;
+eTeX_enabled:=b;
+end;
+
+@ First we implement the additional \eTeX\ parameters in the table of
+equivalents.
+
+@<Generate all \eTeX...@>=
+primitive("everyeof",assign_toks,every_eof_loc);
+@!@:every_eof_}{\.{\\everyeof} primitive@>
+primitive("tracingassigns",assign_int,int_base+tracing_assigns_code);@/
+@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@>
+primitive("tracinggroups",assign_int,int_base+tracing_groups_code);@/
+@!@:tracing_groups_}{\.{\\tracinggroups} primitive@>
+primitive("tracingifs",assign_int,int_base+tracing_ifs_code);@/
+@!@:tracing_ifs_}{\.{\\tracingifs} primitive@>
+primitive("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code);@/
+@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@>
+primitive("tracingnesting",assign_int,int_base+tracing_nesting_code);@/
+@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@>
+primitive("predisplaydirection",
+ assign_int,int_base+pre_display_direction_code);@/
+@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@>
+primitive("lastlinefit",assign_int,int_base+last_line_fit_code);@/
+@!@:last_line_fit_}{\.{\\lastlinefit} primitive@>
+primitive("savingvdiscards",assign_int,int_base+saving_vdiscards_code);@/
+@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@>
+primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/
+@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@>
+
+@ @d every_eof==equiv(every_eof_loc)
+
+@<Cases of |assign_toks| for |print_cmd_chr|@>=
+every_eof_loc: print_esc("everyeof");
+
+@ @<Cases for |print_param|@>=
+tracing_assigns_code:print_esc("tracingassigns");
+tracing_groups_code:print_esc("tracinggroups");
+tracing_ifs_code:print_esc("tracingifs");
+tracing_scan_tokens_code:print_esc("tracingscantokens");
+tracing_nesting_code:print_esc("tracingnesting");
+pre_display_direction_code:print_esc("predisplaydirection");
+last_line_fit_code:print_esc("lastlinefit");
+saving_vdiscards_code:print_esc("savingvdiscards");
+saving_hyph_codes_code:print_esc("savinghyphcodes");
+
+@ In order to handle \.{\\everyeof} we need an array |eof_seen| of
+boolean variables.
+
+@<Glob...@>=
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+
+@ The |print_group| procedure prints the current level of grouping and
+the name corresponding to |cur_group|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure print_group(@!e:boolean);
+label exit;
+begin case cur_group of
+ bottom_level: begin print("bottom level"); return;
+ end;
+ simple_group,semi_simple_group:
+ begin if cur_group=semi_simple_group then print("semi ");
+ print("simple");
+ end;
+ hbox_group,adjusted_hbox_group:
+ begin if cur_group=adjusted_hbox_group then print("adjusted ");
+ print("hbox");
+ end;
+ vbox_group: print("vbox");
+ vtop_group: print("vtop");
+ align_group,no_align_group:
+ begin if cur_group=no_align_group then print("no ");
+ print("align");
+ end;
+ output_group: print("output");
+ disc_group: print("disc");
+ insert_group: print("insert");
+ vcenter_group: print("vcenter");
+ math_group,math_choice_group,math_shift_group,math_left_group:
+ begin print("math");
+ if cur_group=math_choice_group then print(" choice")
+ else if cur_group=math_shift_group then print(" shift")
+ else if cur_group=math_left_group then print(" left");
+ end;
+ end; {there are no other cases}
+print(" group (level "); print_int(qo(cur_level)); print_char(")");
+if saved(-1)<>0 then
+ begin if e then print(" entered at line ") else print(" at line ");
+ print_int(saved(-1));
+ end;
+exit:end;
+
+@ The |group_trace| procedure is called when a new level of grouping
+begins (|e=false|) or ends (|e=true|) with |saved(-1)| containing the
+line number.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure group_trace(@!e:boolean);
+begin begin_diagnostic; print_char("{");
+if e then print("leaving ") else print("entering ");
+print_group(e); print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ The \.{\\currentgrouplevel} and \.{\\currentgrouptype} commands return
+the current level of grouping and the type of the current group
+respectively.
+
+@d current_group_level_code=eTeX_int+1 {code for \.{\\currentgrouplevel}}
+@d current_group_type_code=eTeX_int+2 {code for \.{\\currentgrouptype}}
+
+@<Generate all \eTeX...@>=
+primitive("currentgrouplevel",last_item,current_group_level_code);
+@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@>
+primitive("currentgrouptype",last_item,current_group_type_code);
+@!@:current_group_type_}{\.{\\currentgrouptype} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_group_level_code: print_esc("currentgrouplevel");
+current_group_type_code: print_esc("currentgrouptype");
+
+@ @<Cases for fetching an integer value@>=
+current_group_level_code: cur_val:=cur_level-level_one;
+current_group_type_code: cur_val:=cur_group;
+
+@ The \.{\\currentiflevel}, \.{\\currentiftype}, and
+\.{\\currentifbranch} commands return the current level of conditionals
+and the type and branch of the current conditional.
+
+@d current_if_level_code=eTeX_int+3 {code for \.{\\currentiflevel}}
+@d current_if_type_code=eTeX_int+4 {code for \.{\\currentiftype}}
+@d current_if_branch_code=eTeX_int+5 {code for \.{\\currentifbranch}}
+
+@<Generate all \eTeX...@>=
+primitive("currentiflevel",last_item,current_if_level_code);
+@!@:current_if_level_}{\.{\\currentiflevel} primitive@>
+primitive("currentiftype",last_item,current_if_type_code);
+@!@:current_if_type_}{\.{\\currentiftype} primitive@>
+primitive("currentifbranch",last_item,current_if_branch_code);
+@!@:current_if_branch_}{\.{\\currentifbranch} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_if_level_code: print_esc("currentiflevel");
+current_if_type_code: print_esc("currentiftype");
+current_if_branch_code: print_esc("currentifbranch");
+
+@ @<Cases for fetching an integer value@>=
+current_if_level_code: begin q:=cond_ptr; cur_val:=0;
+ while q<>null do
+ begin incr(cur_val); q:=link(q);
+ end;
+ end;
+current_if_type_code: if cond_ptr=null then cur_val:=0
+ else if cur_if<unless_code then cur_val:=cur_if+1
+ else cur_val:=-(cur_if-unless_code+1);
+current_if_branch_code:
+ if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1
+ else if if_limit=fi_code then cur_val:=-1
+ else cur_val:=0;
+
+@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and
+\.{\\fontcharic} commands return information about a character in a
+font.
+
+@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}}
+@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}}
+@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}}
+@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}}
+
+@<Generate all \eTeX...@>=
+primitive("fontcharwd",last_item,font_char_wd_code);
+@!@:font_char_wd_}{\.{\\fontcharwd} primitive@>
+primitive("fontcharht",last_item,font_char_ht_code);
+@!@:font_char_ht_}{\.{\\fontcharht} primitive@>
+primitive("fontchardp",last_item,font_char_dp_code);
+@!@:font_char_dp_}{\.{\\fontchardp} primitive@>
+primitive("fontcharic",last_item,font_char_ic_code);
+@!@:font_char_ic_}{\.{\\fontcharic} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+font_char_wd_code: print_esc("fontcharwd");
+font_char_ht_code: print_esc("fontcharht");
+font_char_dp_code: print_esc("fontchardp");
+font_char_ic_code: print_esc("fontcharic");
+
+@ @<Cases for fetching a dimension value@>=
+font_char_wd_code,
+font_char_ht_code,
+font_char_dp_code,
+font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
+ if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
+ begin i:=char_info(q)(qi(cur_val));
+ case m of
+ font_char_wd_code: cur_val:=char_width(q)(i);
+ font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
+ font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
+ font_char_ic_code: cur_val:=char_italic(q)(i);
+ end; {there are no other cases}
+ end
+ else cur_val:=0;
+ end;
+
+@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength}
+commands return the indent and length parameters of the current
+\.{\\parshape} specification.
+
+@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}}
+@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}}
+@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}}
+
+@<Generate all \eTeX...@>=
+primitive("parshapelength",last_item,par_shape_length_code);
+@!@:par_shape_length_}{\.{\\parshapelength} primitive@>
+primitive("parshapeindent",last_item,par_shape_indent_code);
+@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@>
+primitive("parshapedimen",last_item,par_shape_dimen_code);
+@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+par_shape_length_code: print_esc("parshapelength");
+par_shape_indent_code: print_esc("parshapeindent");
+par_shape_dimen_code: print_esc("parshapedimen");
+
+@ @<Cases for fetching a dimension value@>=
+par_shape_length_code,
+par_shape_indent_code,
+par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int;
+ if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0
+ else begin if q=2 then
+ begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2;
+ end;
+ if cur_val>info(par_shape_ptr) then cur_val:=info(par_shape_ptr);
+ cur_val:=mem[par_shape_ptr+2*cur_val-q].sc;
+ end;
+ cur_val_level:=dimen_val;
+ end;
+
+@ The \.{\\showgroups} command displays all currently active grouping
+levels.
+
+@d show_groups=4 { \.{\\showgroups} }
+
+@<Generate all \eTeX...@>=
+primitive("showgroups",xray,show_groups);
+@!@:show_groups_}{\.{\\showgroups} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_groups:print_esc("showgroups");
+
+@ @<Cases for |show_whatever|@>=
+show_groups: begin begin_diagnostic; show_save_groups;
+ end;
+
+@ @<Types...@>=
+@!save_pointer=0..save_size; {index into |save_stack|}
+
+@ The modifications of \TeX\ required for the display produced by the
+|show_save_groups| procedure were first discussed by Donald~E. Knuth in
+{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990.
+@^Knuth, Donald Ervin@>
+
+In order to understand a group type we also have to know its mode.
+Since unrestricted horizontal modes are not associated with grouping,
+they are skipped when traversing the semantic nest.
+
+@<Declare \eTeX\ procedures for use...@>=
+procedure show_save_groups;
+label found1,found2,found,done;
+var p:0..nest_size; {index into |nest|}
+@!m:-mmode..mmode; {mode}
+@!v:save_pointer; {saved value of |save_ptr|}
+@!l:quarterword; {saved value of |cur_level|}
+@!c:group_code; {saved value of |cur_group|}
+@!a:-1..1; {to keep track of alignments}
+@!i:integer;
+@!j:quarterword;
+@!s:str_number;
+begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array}
+v:=save_ptr; l:=cur_level; c:=cur_group;
+save_ptr:=cur_boundary; decr(cur_level);@/
+a:=1;
+print_nl(""); print_ln;
+loop@+begin print_nl("### "); print_group(true);
+ if cur_group=bottom_level then goto done;
+ repeat m:=nest[p].mode_field;
+ if p>0 then decr(p) else m:=vmode;
+ until m<>hmode;
+ print(" (");
+ case cur_group of
+ simple_group: begin incr(p); goto found2;
+ end;
+ hbox_group,adjusted_hbox_group: s:="hbox";
+ vbox_group: s:="vbox";
+ vtop_group: s:="vtop";
+ align_group: if a=0 then
+ begin if m=-vmode then s:="halign" else s:="valign";
+ a:=1; goto found1;
+ end
+ else begin if a=1 then print("align entry") else print_esc("cr");
+ if p>=a then p:=p-a;
+ a:=0; goto found;
+ end;
+ no_align_group:
+ begin incr(p); a:=-1; print_esc("noalign"); goto found2;
+ end;
+ output_group:
+ begin print_esc("output"); goto found;
+ end;
+ math_group: goto found2;
+ disc_group,math_choice_group:
+ begin if cur_group=disc_group then print_esc("discretionary")
+ else print_esc("mathchoice");
+ for i:=1 to 3 do if i<=saved(-2) then print("{}");
+ goto found2;
+ end;
+ insert_group:
+ begin if saved(-2)=255 then print_esc("vadjust")
+ else begin print_esc("insert"); print_int(saved(-2));
+ end;
+ goto found2;
+ end;
+ vcenter_group: begin s:="vcenter"; goto found1;
+ end;
+ semi_simple_group: begin incr(p); print_esc("begingroup"); goto found;
+ end;
+ math_shift_group:
+ begin if m=mmode then print_char("$")
+ else if nest[p].mode_field=mmode then
+ begin print_cmd_chr(eq_no,saved(-2)); goto found;
+ end;
+ print_char("$"); goto found;
+ end;
+ math_left_group:
+ begin if type(nest[p+1].eTeX_aux_field)=left_noad then print_esc("left")
+ else print_esc("middle");
+ goto found;
+ end;
+ end; {there are no other cases}
+ @<Show the box context@>;
+ found1: print_esc(s); @<Show the box packaging info@>;
+ found2: print_char("{");
+ found: print_char(")"); decr(cur_level);
+ cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+ end;
+done: save_ptr:=v; cur_level:=l; cur_group:=c;
+end;
+
+@ @<Show the box packaging info@>=
+if saved(-2)<>0 then
+ begin print_char(" ");
+ if saved(-3)=exactly then print("to") else print("spread");
+ print_scaled(saved(-2)); print("pt");
+ end
+
+@ @<Show the box context@>=
+i:=saved(-4);
+if i<>0 then
+ if i<box_flag then
+ begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
+ if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
+ print_scaled(abs(i)); print("pt");
+ end
+ else if i<ship_out_flag then
+ begin if i>=global_box_flag then
+ begin print_esc("global"); i:=i-(global_box_flag-box_flag);
+ end;
+ print_esc("setbox"); print_int(i-box_flag); print_char("=");
+ end
+ else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
+
+@ The |scan_general_text| procedure is much like |scan_toks(false,false)|,
+but will be invoked via |expand|, i.e., recursively.
+@^recursion@>
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_general_text; forward;@t\2@>
+
+@ The token list (balanced text) created by |scan_general_text| begins
+at |link(temp_head)| and ends at |cur_val|. (If |cur_val=temp_head|,
+the list is empty.)
+
+@<Declare \eTeX\ procedures for tok...@>=
+procedure scan_general_text;
+label found;
+var s:normal..absorbing; {to save |scanner_status|}
+@!w:pointer; {to save |warning_index|}
+@!d:pointer; {to save |def_ref|}
+@!p:pointer; {tail of the token list being built}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!unbalance:halfword; {number of unmatched left braces}
+begin s:=scanner_status; w:=warning_index; d:=def_ref;
+scanner_status:=absorbing; warning_index:=cur_cs;
+def_ref:=get_avail; token_ref_count(def_ref):=null; p:=def_ref;
+scan_left_brace; {remove the compulsory left brace}
+unbalance:=1;
+loop@+ begin get_token;
+ if cur_tok<right_brace_limit then
+ if cur_cmd<right_brace then incr(unbalance)
+ else begin decr(unbalance);
+ if unbalance=0 then goto found;
+ end;
+ store_new_token(cur_tok);
+ end;
+found: q:=link(def_ref); free_avail(def_ref); {discard reference count}
+if q=null then cur_val:=temp_head @+ else cur_val:=p;
+link(temp_head):=q;
+scanner_status:=s; warning_index:=w; def_ref:=d;
+end;
+
+@ The \.{\\showtokens} command displays a token list.
+
+@d show_tokens=5 { \.{\\showtokens} , must be odd! }
+
+@<Generate all \eTeX...@>=
+primitive("showtokens",xray,show_tokens);
+@!@:show_tokens_}{\.{\\showtokens} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_tokens:print_esc("showtokens");
+
+@ The \.{\\unexpanded} primitive prevents expansion of tokens much as
+the result from \.{\\the} applied to a token variable. The
+\.{\\detokenize} primitive converts a token list into a list of
+character tokens much as if the token list were written to a file. We
+use the fact that the command modifiers for \.{\\unexpanded} and
+\.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe}
+are even.
+
+@<Generate all \eTeX...@>=
+primitive("unexpanded",the,1);@/
+@!@:unexpanded_}{\.{\\unexpanded} primitive@>
+primitive("detokenize",the,show_tokens);@/
+@!@:detokenize_}{\.{\\detokenize} primitive@>
+
+@ @<Cases of |the| for |print_cmd_chr|@>=
+else if chr_code=1 then print_esc("unexpanded")
+else print_esc("detokenize")
+
+@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>=
+if odd(cur_chr) then
+ begin c:=cur_chr; scan_general_text;
+ if c=1 then the_toks:=cur_val
+ else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
+ p:=get_avail; link(p):=link(temp_head);
+ token_show(p); flush_list(p);
+ selector:=old_setting; the_toks:=str_toks(b);
+ end;
+ return;
+ end
+
+@ The \.{\\showifs} command displays all currently active conditionals.
+
+@d show_ifs=6 { \.{\\showifs} }
+
+@<Generate all \eTeX...@>=
+primitive("showifs",xray,show_ifs);
+@!@:show_ifs_}{\.{\\showifs} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_ifs:print_esc("showifs");
+
+@
+@d print_if_line(#)==if #<>0 then
+ begin print(" entered on line "); print_int(#);
+ end
+
+@<Cases for |show_whatever|@>=
+show_ifs: begin begin_diagnostic; print_nl(""); print_ln;
+ if cond_ptr=null then
+ begin print_nl("### "); print("no active conditionals");
+ end
+ else begin p:=cond_ptr; n:=0;
+ repeat incr(n); p:=link(p);@+until p=null;
+ p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit;
+ repeat print_nl("### level "); print_int(n); print(": ");
+ print_cmd_chr(if_test,t);
+ if m=fi_code then print_esc("else");
+ print_if_line(l);
+ decr(n); t:=subtype(p); l:=if_line_field(p); m:=type(p); p:=link(p);
+ until p=null;
+ end;
+ end;
+
+@ The \.{\\interactionmode} primitive allows to query and set the
+interaction mode.
+
+@<Generate all \eTeX...@>=
+primitive("interactionmode",set_page_int,2);
+@!@:interaction_mode_}{\.{\\interactionmode} primitive@>
+
+@ @<Cases of |set_page_int| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("interactionmode")
+
+@ @<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>=
+else if m=2 then cur_val:=interaction
+
+@ @<Declare \eTeX\ procedures for use...@>=
+procedure@?new_interaction; forward;@t\2@>
+
+@ @<Cases for |alter_integer|@>=
+else if c=2 then
+ begin if (cur_val<batch_mode)or(cur_val>error_stop_mode) then
+ begin print_err("Bad interaction mode");
+@.Bad interaction mode@>
+ help2("Modes are 0=batch, 1=nonstop, 2=scroll, and")@/
+ ("3=errorstop. Proceed, and I'll ignore this case.");
+ int_error(cur_val);
+ end
+ else begin cur_chr:=cur_val; new_interaction;
+ end;
+ end
+
+@ The |middle| feature of \eTeX\ allows one ore several \.{\\middle}
+delimiters to appear between \.{\\left} and \.{\\right}.
+
+@<Generate all \eTeX...@>=
+primitive("middle",left_right,middle_noad);
+@!@:middle_}{\.{\\middle} primitive@>
+
+@ @<Cases of |left_right| for |print_cmd_chr|@>=
+else if chr_code=middle_noad then print_esc("middle")
+
+@ In constructions such as
+$$\vbox{\halign{\.{#}\hfil\cr
+{}\\vbox to \\vsize\{\cr
+\hskip 25pt \\vskip 0pt plus 0.0001fil\cr
+\hskip 25pt ...\cr
+\hskip 25pt \\vfil\\penalty-200\\vfilneg\cr
+\hskip 25pt ...\}\cr}}$$
+the stretch components of \.{\\vfil} and \.{\\vfilneg} compensate;
+in standard \TeX\ they may get modified in order to prevent arithmetic
+overflow during |ship_out| when each of them is multiplied by a large
+|glue_set| value.
+
+In \eTeX\ the conversion from stretch or shrink components of glue to
+\.{DVI} units is performed by the |do_glue| function defined below.
+
+In extended mode the |do_glue| function adds up the relevant stretch (or
+shrink) components of consecutive glue nodes and converts the glue nodes
+into equivalent kern nodes; during this process glue specifications may
+be recycled. The accumulated stretch or shrink is then multiplied by
+|glue_set(this_box)| and returned as result. Since one and the same box
+may be used several times inside leaders the result is also added to the
+width of the first or only kern node; the subtype of the glue node(s)
+remains unchanged. The consecutive glue nodes may be separated by
+insert, mark, adjust, kern, and penalty nodes.
+
+@d add_glue(#)==#:=#+do_glue(this_box,p)
+@#
+@d add_stretch_shrink== {accumulate stretch or shrink amount}
+if g_sign=stretching then
+ begin if stretch_order(g)=g_order then s:=s+stretch(g);
+ end
+else begin if shrink_order(g)=g_order then s:=s-shrink(g);
+ end
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+function do_glue(@!this_box,@!p:pointer):scaled;
+label continue, next_p, done;
+var q:pointer; {list traverser}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!s:scaled; {accumulated stretch or shrink}
+@!glue_temp:real; {glue value before rounding}
+begin g_order:=glue_order(this_box); g_sign:=glue_sign(this_box);
+s:=0; add_stretch_shrink;
+if not eTeX_ex or(subtype(p)>=a_leaders) then goto done;
+q:=p;
+continue: type(q):=kern_node; width(q):=width(g);
+fast_delete_glue_ref(g);
+next_p: q:=link(q);
+if (q<>null) and not is_char_node(q) then case type(q) of
+ins_node,mark_node,adjust_node,kern_node,penalty_node: goto next_p;
+glue_node: if subtype(q)<a_leaders then
+ begin g:=glue_ptr(q); add_stretch_shrink; goto continue;
+ end;
+othercases do_nothing
+endcases;@/
+done: if s<>0 then
+ begin vet_glue(float(glue_set(this_box))*s); s:=round(glue_temp);
+@^real multiplication@>
+ if type(p)=kern_node then width(p):=width(p)+s;
+ end;
+do_glue:=s;
+end;
+
+@ The optional |TeXXeT| feature of \eTeX\ contains the code for mixed
+left-to-right and right-to-left typesetting. This code is inspired by
+but different from \TeXeT\ as presented by Donald~E. Knuth and Pierre
+MacKay in {\sl TUGboat\/} {\bf 8}, 14--25, 1987.
+@^Knuth, Donald Ervin@>
+@^MacKay, Pierre@>
+
+In order to avoid confusion with \TeXeT\ the present implementation of
+mixed direction typesetting is called \TeXXeT. It differs from \TeXeT\
+in several important aspects: (1)~Right-to-left text is reversed
+explicitely by the |ship_out| routine and is written to a normal \.{DVI}
+file without any |begin_reflect| or |end_reflect| commands; (2)~a
+|math_node| is (ab)used instead of a |whatsit_node| to record the
+\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} text direction
+primitives in order to keep the influence on the line breaking algorithm
+for pure left-to-right text as small as possible; (3)~right-to-left text
+interrupted by a displayed equation is automatically resumed after that
+equation; and (4)~the |valign| command code with a non-zero command
+modifier is (ab)used for the text direction primitives.
+
+Nevertheless there is a subtle difference between \TeX\ and \TeXXeT\
+that may influence the line breaking algorithm for pure left-to-right
+text. When a paragraph containing math mode material is broken into
+lines \TeX\ may generate lines where math mode material is not enclosed
+by properly nested \.{\\mathon} and \.{\\mathoff} nodes. Unboxing such
+lines as part of a new paragraph may have the effect that hyphenation is
+attempted for `words' originating from math mode or that hyphenation is
+inhibited for words originating from horizontal mode.
+
+In \TeXXeT\ additional \.{\\beginM}, resp.\ \.{\\endM} math nodes are
+supplied at the start, resp.\ end of lines such that math mode material
+inside a horizontal list always starts with either \.{\\mathon} or
+\.{\\beginM} and ends with \.{\\mathoff} or \.{\\endM}. These
+additional nodes are transparent to operations such as \.{\\unskip},
+\.{\\lastpenalty}, or \.{\\lastbox} but they do have the effect that
+hyphenation is never attempted for `words' originating from math mode
+and is never inhibited for words originating from horizontal mode.
+
+@d TeXXeT_state==eTeX_state(TeXXeT_code)
+@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?}
+
+@<Cases for |print_param|@>=
+eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate");
+
+@ @<Generate all \eTeX...@>=
+primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code);
+@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@>
+primitive("beginL",valign,begin_L_code);
+@!@:beginL_}{\.{\\beginL} primitive@>
+primitive("endL",valign,end_L_code);
+@!@:endL_}{\.{\\endL} primitive@>
+primitive("beginR",valign,begin_R_code);
+@!@:beginR_}{\.{\\beginR} primitive@>
+primitive("endR",valign,end_R_code);
+@!@:endR_}{\.{\\endR} primitive@>
+
+@ @<Cases of |valign| for |print_cmd_chr|@>=
+else case chr_code of
+ begin_L_code: print_esc("beginL");
+ end_L_code: print_esc("endL");
+ begin_R_code: print_esc("beginR");
+ othercases print_esc("endR")
+ endcases
+
+@ @<Cases of |main_control| for |hmode+valign|@>=
+if cur_chr>0 then
+ begin if eTeX_enabled(TeXXeT_en,cur_cmd,cur_chr) then
+@.Improper \\beginL@>
+@.Improper \\endL@>
+@.Improper \\beginR@>
+@.Improper \\endR@>
+ tail_append(new_math(0,cur_chr));
+ end
+else
+
+@ An hbox with subtype dlist will never be reversed, even when embedded
+in right-to-left text.
+
+@<Display if this box is never to be reversed@>=
+if (type(p)=hlist_node)and(subtype(p)=dlist) then print(", display")
+
+@ A number of routines are based on a stack of one-word nodes whose
+|info| fields contain |end_M_code|, |end_L_code|, or |end_R_code|. The
+top of the stack is pointed to by |LR_ptr|.
+
+When the stack manipulation macros of this section are used below,
+variable |LR_ptr| might be the global variable declared here for |hpack|
+and |ship_out|, or might be local to |post_line_break|.
+
+@d put_LR(#)==begin temp_ptr:=get_avail; info(temp_ptr):=#;
+ link(temp_ptr):=LR_ptr; LR_ptr:=temp_ptr;
+ end
+@#
+@d push_LR(#)==put_LR(end_LR_type(#))
+@#
+@d pop_LR==begin temp_ptr:=LR_ptr; LR_ptr:=link(temp_ptr);
+ free_avail(temp_ptr);
+ end
+
+@<Glob...@>=
+@!LR_temp:pointer; {holds a temporarily removed \.{\\endM} node}
+@!LR_ptr:pointer; {stack of LR codes for |hpack|, |ship_out|, and |init_math|}
+@!LR_problems:integer; {counts missing begins and ends}
+@!cur_dir:small_number; {current text direction}
+
+@ @<Set init...@>=
+LR_temp:=null; LR_ptr:=null; LR_problems:=0; cur_dir:=left_to_right;
+
+@ @<Insert LR nodes at the beg...@>=
+begin q:=link(temp_head);
+if LR_ptr<>null then
+ begin temp_ptr:=LR_ptr; r:=q;
+ repeat s:=new_math(0,begin_LR_type(info(temp_ptr))); link(s):=r; r:=s;
+ temp_ptr:=link(temp_ptr);
+ until temp_ptr=null;
+ link(temp_head):=r;
+ end;
+while q<>cur_break(cur_p) do
+ begin if not is_char_node(q) then
+ if type(q)=math_node then @<Adjust \(t)the LR stack for the |p...@>;
+ q:=link(q);
+ end;
+end
+
+@ @<Adjust \(t)the LR stack for the |p...@>=
+if end_LR(q) then
+ begin if LR_ptr<>null then if info(LR_ptr)=end_LR_type(q) then pop_LR;
+ end
+else push_LR(q)
+
+@ We use the fact that |q| now points to the node with \.{\\rightskip} glue.
+
+@<Insert LR nodes at the end...@>=
+if LR_ptr<>null then
+ begin s:=temp_head; r:=link(s);
+ while r<>q do
+ begin s:=r; r:=link(s);
+ end;
+ r:=LR_ptr;
+ while r<>null do
+ begin temp_ptr:=new_math(0,info(r));
+ link(s):=temp_ptr; s:=temp_ptr; r:=link(r);
+ end;
+ link(s):=q;
+ end
+
+@ Special \.{\\beginM} and \.{\\endM} nodes are inserted in cases where
+math nodes are discarded during line breaking or end up in different
+lines. When the current lists ends with an \.{\\endM} node that node is
+temporarily removed and later reinserted when the last node is to be
+inspected or removed. A final \.{\\endM} preceded by a |char_node| will
+not be removed.
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure remove_end_M;
+var @!p:pointer; {runs through the current list}
+begin p:=head;
+while link(p)<>tail do p:=link(p);
+if not is_char_node(p) then
+ begin LR_temp:=tail; link(p):=null; tail:=p;
+ end;
+end;
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure insert_end_M;
+label done;
+var @!p:pointer; {runs through the current list}
+begin if not is_char_node(tail) then
+ if (type(tail)=math_node)and(subtype(tail)=begin_M_code) then
+ begin free_node(LR_temp,small_node_size); p:=head;
+ while link(p)<>tail do p:=link(p);
+ free_node(tail,small_node_size); link(p):=null; tail:=p; goto done;
+ end;
+link(tail):=LR_temp; tail:=LR_temp;
+done: LR_temp:=null;
+end;
+
+@ @<Initialize the LR stack@>=
+put_LR(before) {this will never match}
+
+@ @<Adjust \(t)the LR stack for the |hp...@>=
+if end_LR(p) then
+ if info(LR_ptr)=end_LR_type(p) then pop_LR
+ else begin incr(LR_problems); type(p):=kern_node; subtype(p):=explicit;
+ end
+else push_LR(p)
+
+@ @<Check for LR anomalies at the end of |hp...@>=
+begin if info(LR_ptr)<>before then
+ begin while link(q)<>null do q:=link(q);
+ repeat temp_ptr:=q; q:=new_math(0,info(LR_ptr)); link(temp_ptr):=q;
+ LR_problems:=LR_problems+10000; pop_LR;
+ until info(LR_ptr)=before;
+ end;
+if LR_problems>0 then
+ begin @<Report LR problems@>; goto common_ending;
+ end;
+pop_LR;
+if LR_ptr<>null then confusion("LR1");
+@:this can't happen LR1}{\quad LR1@>
+end
+
+@ @<Report LR problems@>=
+begin print_ln; print_nl("\endL or \endR problem (");@/
+print_int(LR_problems div 10000); print(" missing, ");@/
+print_int(LR_problems mod 10000); print(" extra");@/
+LR_problems:=0;
+end
+
+@ Breaking a paragraph into lines while \TeXXeT\ is disabled may result
+in lines whith unpaired math nodes. Such hlists are silently accepted
+in the absence of text direction directives.
+
+@d LR_dir(#)==(subtype(#) div R_code) {text direction of a `math node'}
+
+@<Adjust \(t)the LR stack for the |hl...@>=
+begin if end_LR(p) then
+ if info(LR_ptr)=end_LR_type(p) then pop_LR
+ else begin if subtype(p)>L_code then incr(LR_problems);
+ end
+else begin push_LR(p);
+ if LR_dir(p)<>cur_dir then
+ @<Reverse an hlist segment and |goto reswitch|@>;
+ end;
+type(p):=kern_node;
+end
+
+@ @<Check for LR anomalies at the end of |hl...@>=
+begin while info(LR_ptr)<>before do
+ begin if info(LR_ptr)>L_code then LR_problems:=LR_problems+10000;
+ pop_LR;
+ end;
+pop_LR;
+end
+
+@ @d edge_node=style_node {a |style_node| does not occur in hlists}
+@d edge_node_size=style_node_size {number of words in an edge node}
+@d edge_dist(#)==depth(#) {new |left_edge| position relative to |cur_h|
+ (after |width| has been taken into account)}
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+function new_edge(@!s:small_number;@!w:scaled):pointer;
+ {create an edge node}
+var p:pointer; {the new node}
+begin p:=get_node(edge_node_size); type(p):=edge_node; subtype(p):=s;
+width(p):=w; edge_dist(p):=0; {the |edge_dist| field will be set later}
+new_edge:=p;
+end;
+
+@ @<Cases of |hlist_out| that arise...@>=
+edge_node: begin cur_h:=cur_h+width(p);
+ left_edge:=cur_h+edge_dist(p); cur_dir:=subtype(p);
+ end;
+
+@ We detach the hlist, start a new one consisting of just one kern node,
+append the reversed list, and set the width of the kern node.
+
+@<Reverse the complete hlist...@>=
+begin save_h:=cur_h; temp_ptr:=p; p:=new_kern(0); link(prev_p):=p;
+cur_h:=0; link(p):=reverse(this_box,null); width(p):=-cur_h;
+cur_h:=save_h; subtype(this_box):=reversed;
+end
+
+@ We detach the remainder of the hlist, replace the math node by
+an edge node, and append the reversed hlist segment to it; the tail of
+the reversed segment is another edge node and the remainder of the
+original list is attached to it.
+
+@<Reverse an hlist segment...@>=
+begin save_h:=cur_h; temp_ptr:=link(p); rule_wd:=width(p);
+free_node(p,small_node_size);
+cur_dir:=reflected; p:=new_edge(cur_dir,rule_wd); link(prev_p):=p;
+cur_h:=cur_h-left_edge+rule_wd;
+link(p):=reverse(this_box,new_edge(reflected,0));
+edge_dist(p):=cur_h; cur_dir:=reflected; cur_h:=save_h;
+goto reswitch;
+end
+
+@ The |reverse| function defined here is responsible to reverse the
+nodes of an hlist (segment). The first parameter |this_box| is the
+enclosing hlist node, the second parameter |t| is to become the tail of
+the reversed list, and the global variable |temp_ptr| is the head of the
+list to be reversed. We remove nodes from the original list and add them
+to the head of the new one.
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+function reverse(@!this_box,@!t:pointer):pointer;
+label reswitch,next_p,done;
+var l:pointer; {the new list}
+@!p:pointer; {the current node}
+@!q:pointer; {the next node}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!m,@!n:halfword; {count of unmatched math nodes}
+begin g_sign:=glue_sign(this_box);
+l:=t; p:=temp_ptr; m:=min_halfword; n:=min_halfword;
+loop@+ begin while p<>null do
+ @<Move node |p| to the new list and go to the next node;
+ or |goto done| if the end of the reflected segment has been reached@>;
+ if (t=null)and(m=min_halfword)and(n=min_halfword) then goto done;
+ p:=new_math(0,info(LR_ptr)); LR_problems:=LR_problems+10000;
+ {manufacture one missing math node}
+ end;
+done:reverse:=l;
+end;
+
+@ @<Move node |p| to the new list...@>=
+reswitch: if is_char_node(p) then
+ repeat f:=font(p); c:=character(p);
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+ q:=link(p); link(p):=l; l:=p; p:=q;
+ until not is_char_node(p)
+else @<Move the non-|char_node| |p| to the new list@>
+
+@ @<Move the non-|char_node| |p| to the new list@>=
+begin q:=link(p);
+case type(p) of
+hlist_node,vlist_node,rule_node,kern_node: rule_wd:=width(p);
+@t\4@>@<Cases of |reverse| that need special treatment@>@;
+edge_node: confusion("LR2");
+@:this can't happen LR2}{\quad LR2@>
+othercases goto next_p
+endcases;@/
+cur_h:=cur_h+rule_wd;
+next_p: link(p):=l;
+if type(p)=kern_node then if (rule_wd=0)or(l=null) then
+ begin free_node(p,small_node_size); p:=l;
+ end;
+l:=p; p:=q;
+end
+
+@ Here we have to remember that |add_glue| may have converted the glue
+node into a kern node. If this is not the case we try to covert the
+glue node into a rule node.
+
+@<Cases of |reverse|...@>=
+glue_node: begin g:=glue_ptr(p); rule_wd:=width(g);
+if g_sign<>normal then add_glue(rule_wd);
+if subtype(p)>=a_leaders then
+ begin temp_ptr:=leader_ptr(p);
+ if type(temp_ptr)=rule_node then
+ begin delete_glue_ref(g); free_node(p,small_node_size);
+ p:=temp_ptr; width(p):=rule_wd;
+ end;
+ end;
+end;
+
+@ A ligature node is replaced by a char node.
+
+@<Cases of |reverse|...@>=
+ligature_node: begin flush_node_list(lig_ptr(p));
+temp_ptr:=p; p:=get_avail; mem[p]:=mem[lig_char(temp_ptr)]; link(p):=q;
+free_node(temp_ptr,small_node_size); goto reswitch;
+end;
+
+@ Math nodes in an inner reflected segment are modified, those at the
+outer level are changed into kern nodes.
+
+@<Cases of |reverse|...@>=
+math_node: begin rule_wd:=width(p);
+if end_LR(p) then
+ if info(LR_ptr)<>end_LR_type(p) then
+ begin type(p):=kern_node; incr(LR_problems);
+ end
+ else begin pop_LR;
+ if n>min_halfword then
+ begin decr(n); decr(subtype(p)); {change |after| into |before|}
+ end
+ else begin type(p):=kern_node;
+ if m>min_halfword then decr(m)
+ else @<Finish the reversed hlist segment and |goto done|@>;
+ end;
+ end
+else begin push_LR(p);
+ if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
+ begin incr(n); incr(subtype(p)); {change |before| into |after|}
+ end
+ else begin type(p):=kern_node; incr(m);
+ end;
+ end;
+end;
+
+@ Finally we have found the end of the hlist segment to be reversed; the
+final math node is released and the remaining list attached to the
+edge node terminating the reversed segment.
+
+@<Finish the reversed...@>=
+begin free_node(p,small_node_size);
+link(t):=q; width(t):=rule_wd; edge_dist(t):=-cur_h-rule_wd; goto done;
+end
+
+@ @<Check for LR anomalies at the end of |s...@>=
+begin if LR_problems>0 then
+ begin @<Report LR problems@>; print_char(")"); print_ln;
+ end;
+if (LR_ptr<>null)or(cur_dir<>left_to_right) then confusion("LR3");
+@:this can't happen LR3}{\quad LR3@>
+end
+
+@ Some special actions are required for displayed equation in paragraphs
+with mixed direction texts. First of all we have to set the text
+direction preceding the display.
+
+@<Set the value of |x| to the text direction before the display@>=
+if LR_save=null then x:=0
+else if info(LR_save)>=R_code then x:=-1@+else x:=1
+
+@ @<Prepare for display after an empty...@>=
+begin pop_nest; @<Set the value of |x|...@>;
+end
+
+@ When calculating the natural width, |w|, of the final line preceding
+the display, we may have to copy all or part of its hlist. We copy,
+however, only those parts of the original list that are relevant for the
+computation of |pre_display_size|.
+@^data structure assumptions@>
+
+@<Declare subprocedures for |init_math|@>=
+procedure just_copy(@!p,@!h,@!t:pointer);
+label found,not_found;
+var @!r:pointer; {current node being fabricated for new list}
+@!words:0..5; {number of words remaining to be copied}
+begin while p<>null do
+ begin words:=1; {this setting occurs in more branches than any other}
+ if is_char_node(p) then r:=get_avail
+ else case type(p) of
+ hlist_node,vlist_node: begin r:=get_node(box_node_size);
+ mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
+ words:=5; list_ptr(r):=null; {this affects |mem[r+5]|}
+ end;
+ rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size;
+ end;
+ ligature_node: begin r:=get_avail; {only |font| and |character| are needed}
+ mem[r]:=mem[lig_char(p)]; goto found;
+ end;
+ kern_node,math_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+ glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p));
+ glue_ptr(r):=glue_ptr(p); leader_ptr(r):=null;
+ end;
+ whatsit_node:@<Make a partial copy of the whatsit...@>;
+ othercases goto not_found
+ endcases;
+ while words>0 do
+ begin decr(words); mem[r+words]:=mem[p+words];
+ end;
+ found: link(h):=r; h:=r;
+ not_found: p:=link(p);
+ end;
+link(h):=t;
+end;
+
+@ When the final line ends with R-text, the value |w| refers to the line
+reflected with respect to the left edge of the enclosing vertical list.
+
+@<Prepare for display after a non-empty...@>=
+if eTeX_ex then @<Let |j| be the prototype box for the display@>;
+v:=shift_amount(just_box);
+@<Set the value of |x|...@>;
+if x>=0 then
+ begin p:=list_ptr(just_box); link(temp_head):=null;
+ end
+else begin v:=-v-width(just_box);
+ p:=new_math(0,begin_L_code); link(temp_head):=p;
+ just_copy(list_ptr(just_box),p,new_math(0,end_L_code));
+ cur_dir:=right_to_left;
+ end;
+v:=v+2*quad(cur_font);
+if TeXXeT_en then @<Initialize the LR stack@>
+
+@ @<Finish the natural width computation@>=
+if TeXXeT_en then
+ begin while LR_ptr<>null do pop_LR;
+ if LR_problems<>0 then
+ begin w:=max_dimen; LR_problems:=0;
+ end;
+ end;
+cur_dir:=left_to_right; flush_node_list(link(temp_head))
+
+@ In the presence of text direction directives we assume that any LR
+problems have been fixed by the |hpack| routine. If the final line
+contains, however, text direction directives while \TeXXeT\ is disabled,
+then we set |w:=max_dimen|.
+
+@<Cases of `Let |d| be the natural...@>=
+math_node: begin d:=width(p);
+ if TeXXeT_en then @<Adjust \(t)the LR stack for the |init_math| routine@>
+ else if subtype(p)>=L_code then
+ begin w:=max_dimen; goto done;
+ end;
+ end;
+edge_node: begin d:=width(p); cur_dir:=subtype(p);
+ end;
+
+@ @<Adjust \(t)the LR stack for the |i...@>=
+if end_LR(p) then
+ begin if info(LR_ptr)=end_LR_type(p) then pop_LR
+ else if subtype(p)>L_code then
+ begin w:=max_dimen; goto done;
+ end
+ end
+else begin push_LR(p);
+ if LR_dir(p)<>cur_dir then
+ begin just_reverse(p); p:=temp_head;
+ end;
+ end
+
+@ @<Declare subprocedures for |init_math|@>=
+procedure just_reverse(@!p:pointer);
+label found,done;
+var l:pointer; {the new list}
+@!t:pointer; {tail of reversed segment}
+@!q:pointer; {the next node}
+@!m,@!n:halfword; {count of unmatched math nodes}
+begin m:=min_halfword; n:=min_halfword;
+if link(temp_head)=null then
+ begin just_copy(link(p),temp_head,null); q:=link(temp_head);
+ end
+else begin q:=link(p); link(p):=null; flush_node_list(link(temp_head));
+ end;
+t:=new_edge(cur_dir,0); l:=t; cur_dir:=reflected;
+while q<>null do
+ if is_char_node(q) then
+ repeat p:=q; q:=link(p); link(p):=l; l:=p;
+ until not is_char_node(q)
+ else begin p:=q; q:=link(p);
+ if type(p)=math_node then
+ @<Adjust \(t)the LR stack for the |just_reverse| routine@>;
+ link(p):=l; l:=p;
+ end;
+goto done;
+found:width(t):=width(p); link(t):=q; free_node(p,small_node_size);
+done:link(temp_head):=l;
+end;
+
+@ @<Adjust \(t)the LR stack for the |j...@>=
+if end_LR(p) then
+ if info(LR_ptr)<>end_LR_type(p) then
+ begin type(p):=kern_node; incr(LR_problems);
+ end
+ else begin pop_LR;
+ if n>min_halfword then
+ begin decr(n); decr(subtype(p)); {change |after| into |before|}
+ end
+ else begin if m>min_halfword then decr(m)@+else goto found;
+ type(p):=kern_node;
+ end;
+ end
+else begin push_LR(p);
+ if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
+ begin incr(n); incr(subtype(p)); {change |before| into |after|}
+ end
+ else begin type(p):=kern_node; incr(m);
+ end;
+ end
+
+@ The prototype box is an hlist node with the width, glue set, and shift
+amount of |just_box|, i.e., the last line preceding the display. Its
+hlist reflects the current \.{\\leftskip} and \.{\\rightskip}.
+
+@<Let |j| be the prototype box for the display@>=
+begin if right_skip=zero_glue then j:=new_kern(0)
+else j:=new_param_glue(right_skip_code);
+if left_skip=zero_glue then p:=new_kern(0)
+else p:=new_param_glue(left_skip_code);
+link(p):=j; j:=new_null_box; width(j):=width(just_box);
+shift_amount(j):=shift_amount(just_box); list_ptr(j):=p;
+glue_order(j):=glue_order(just_box); glue_sign(j):=glue_sign(just_box);
+glue_set(j):=glue_set(just_box);
+end
+
+@ At the end of a displayed equation we retrieve the prototype box.
+
+@<Local variables for finishing...@>=
+@!j:pointer; {prototype box}
+
+@ @<Retrieve the prototype box@>=
+if mode=mmode then j:=LR_box
+
+@ @<Flush the prototype box@>=
+flush_node_list(j)
+
+@ The |app_display| procedure used to append the displayed equation
+and\slash or equation number to the current vertical list has three
+parameters: the prototype box, the hbox to be appended, and the
+displacement of the hbox in the display line.
+
+@<Declare subprocedures for |after_math|@>=
+procedure app_display(@!j,@!b:pointer;@!d:scaled);
+var z:scaled; {width of the line}
+@!s:scaled; {move the line right this much}
+@!e:scaled; {distance from right edge of box to end of line}
+@!x:integer; {|pre_display_direction|}
+@!p,@!q,@!r,@!t,@!u:pointer; {for list manipulation}
+begin s:=display_indent; x:=pre_display_direction;
+if x=0 then shift_amount(b):=s+d
+else begin z:=display_width; p:=b;
+ @<Set up the hlist for the display line@>;
+ @<Package the display line@>;
+ end;
+append_to_vlist(b);
+end;
+
+@ Here we construct the hlist for the display, starting with node |p|
+and ending with node |q|. We also set |d| and |e| to the amount of
+kerning to be added before and after the hlist (adjusted for the
+prototype box).
+
+@<Set up the hlist for the display line@>=
+if x>0 then e:=z-d-width(p)
+else begin e:=d; d:=z-e-width(p);
+ end;
+if j<>null then
+ begin b:=copy_node_list(j); height(b):=height(p); depth(b):=depth(p);
+ s:=s-shift_amount(b); d:=d+s; e:=e+width(b)-z-s;
+ end;
+if subtype(p)=dlist then q:=p {display or equation number}
+else begin {display and equation number}
+ r:=list_ptr(p); free_node(p,box_node_size);
+ if r=null then confusion("LR4");
+ if x>0 then
+ begin p:=r;
+ repeat q:=r; r:=link(r); {find tail of list}
+ until r=null;
+ end
+ else begin p:=null; q:=r;
+ repeat t:=link(r); link(r):=p; p:=r; r:=t; {reverse list}
+ until r=null;
+ end;
+ end
+
+@ In the presence of a prototype box we use its shift amount and width
+to adjust the values of kerning and add these values to the glue nodes
+inserted to cancel the \.{\\leftskip} and \.{\\rightskip}. If there is
+no prototype box (because the display is preceded by an empty
+paragraph), or if the skip parameters are zero, we just add kerns.
+
+The |cancel_glue| macro creates and links a glue node that is, together
+with another glue node, equivalent to a given amount of kerning. We can
+use |j| as temporary pointer, since all we need is |j<>null|.
+
+@d cancel_glue(#)==j:=new_skip_param(#); cancel_glue_cont
+@d cancel_glue_cont(#)==link(#):=j; cancel_glue_cont_cont
+@d cancel_glue_cont_cont(#)==link(j):=#; cancel_glue_end
+@d cancel_glue_end(#)==j:=glue_ptr(#); cancel_glue_end_end
+@d cancel_glue_end_end(#)==
+stretch_order(temp_ptr):=stretch_order(j);
+shrink_order(temp_ptr):=shrink_order(j); width(temp_ptr):=#-width(j);
+stretch(temp_ptr):=-stretch(j); shrink(temp_ptr):=-shrink(j)
+
+@<Package the display line@>=
+if j=null then
+ begin r:=new_kern(0); t:=new_kern(0); {the widths will be set later}
+ end
+else begin r:=list_ptr(b); t:=link(r);
+ end;
+u:=new_math(0,end_M_code);
+if type(t)=glue_node then {|t| is \.{\\rightskip} glue}
+ begin cancel_glue(right_skip_code)(q)(u)(t)(e); link(u):=t;
+ end
+else begin width(t):=e; link(t):=u; link(q):=t;
+ end;
+u:=new_math(0,begin_M_code);
+if type(r)=glue_node then {|r| is \.{\\leftskip} glue}
+ begin cancel_glue(left_skip_code)(u)(p)(r)(d); link(r):=u;
+ end
+else begin width(r):=d; link(r):=p; link(u):=r;
+ if j=null then
+ begin b:=hpack(u,natural); shift_amount(b):=s;
+ end
+ else list_ptr(b):=u;
+ end
+
+@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens}
+primitive.
+
+@<Generate all \eTeX...@>=
+primitive("scantokens",input,2);
+@!@:scan_tokens_}{\.{\\scantokens} primitive@>
+
+@ @<Cases of |input| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("scantokens")
+
+@ @<Cases for |input|@>=
+else if cur_chr=2 then pseudo_start
+
+@ The global variable |pseudo_files| is used to maintain a stack of
+pseudo files. The |info| field of each pseudo file points to a linked
+list of variable size nodes representing lines not yet processed: the
+|info| field of the first word contains the size of this node, all the
+following words contain ASCII codes.
+
+@<Glob...@>=
+@!pseudo_files:pointer; {stack of pseudo files}
+
+@ @<Set init...@>=
+pseudo_files:=null;
+
+@ The |pseudo_start| procedure initiates reading from a pseudo file.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?pseudo_start; forward;@t\2@>
+
+@ @<Declare \eTeX\ procedures for tok...@>=
+procedure pseudo_start;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!s:str_number; {string to be converted into a pseudo file}
+@!l,@!m:pool_pointer; {indices into |str_pool|}
+@!p,@!q,@!r:pointer; {for list construction}
+@!w: four_quarters; {four ASCII codes}
+@!nl,@!sz:integer;
+begin scan_general_text;
+old_setting:=selector; selector:=new_string;
+token_show(temp_head); selector:=old_setting;
+flush_list(link(temp_head));
+str_room(1); s:=make_string;
+@<Convert string |s| into a new pseudo file@>;
+flush_string;
+@<Initiate input from new pseudo file@>;
+end;
+
+@ @<Convert string |s| into a new pseudo file@>=
+str_pool[pool_ptr]:=si(" "); l:=str_start[s];
+nl:=si(new_line_char);
+p:=get_avail; q:=p;
+while l<pool_ptr do
+ begin m:=l;
+ while (l<pool_ptr)and(str_pool[l]<>nl) do incr(l);
+ sz:=(l-m+7)div 4;
+ if sz=1 then sz:=2;
+ r:=get_node(sz); link(q):=r; q:=r; info(q):=hi(sz);
+ while sz>2 do
+ begin decr(sz); incr(r);
+ w.b0:=qi(so(str_pool[m])); w.b1:=qi(so(str_pool[m+1]));
+ w.b2:=qi(so(str_pool[m+2])); w.b3:=qi(so(str_pool[m+3]));
+ mem[r].qqqq:=w; m:=m+4;
+ end;
+ w.b0:=qi(" "); w.b1:=qi(" "); w.b2:=qi(" "); w.b3:=qi(" ");
+ if l>m then
+ begin w.b0:=qi(so(str_pool[m]));
+ if l>m+1 then
+ begin w.b1:=qi(so(str_pool[m+1]));
+ if l>m+2 then
+ begin w.b2:=qi(so(str_pool[m+2]));
+ if l>m+3 then w.b3:=qi(so(str_pool[m+3]));
+ end;
+ end;
+ end;
+ mem[r+1].qqqq:=w;
+ if str_pool[l]=nl then incr(l);
+ end;
+info(p):=link(p); link(p):=pseudo_files; pseudo_files:=p
+
+@ @<Initiate input from new pseudo file@>=
+begin_file_reading; {set up |cur_file| and new level of input}
+line:=0; limit:=start; loc:=limit+1; {force line read}
+if tracing_scan_tokens>0 then
+ begin if term_offset>max_print_line-3 then print_ln
+ else if (term_offset>0)or(file_offset>0) then print_char(" ");
+ name:=19; print("( "); incr(open_parens); update_terminal;
+ end
+else name:=18
+
+@ Here we read a line from the current pseudo file into |buffer|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+function pseudo_input: boolean; {inputs the next line or returns |false|}
+var p:pointer; {current line from pseudo file}
+@!sz:integer; {size of node |p|}
+@!w:four_quarters; {four ASCII codes}
+@!r:pointer; {loop index}
+begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+p:=info(pseudo_files);
+if p=null then pseudo_input:=false
+else begin info(pseudo_files):=link(p); sz:=ho(info(p));
+ if 4*sz-3>=buf_size-last then
+ @<Report overflow of the input buffer, and abort@>;
+ last:=first;
+ for r:=p+1 to p+sz-1 do
+ begin w:=mem[r].qqqq;
+ buffer[last]:=w.b0; buffer[last+1]:=w.b1;
+ buffer[last+2]:=w.b2; buffer[last+3]:=w.b3;
+ last:=last+4;
+ end;
+ if last>=max_buf_stack then max_buf_stack:=last+1;
+ while (last>first)and(buffer[last-1]=" ") do decr(last);
+ free_node(p,sz);
+ pseudo_input:=true;
+ end;
+end;
+
+@ When we are done with a pseudo file we `close' it.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure pseudo_close; {close the top level pseudo file}
+var p,@!q: pointer;
+begin p:=link(pseudo_files); q:=info(pseudo_files);
+free_avail(pseudo_files); pseudo_files:=p;
+while q<>null do
+ begin p:=q; q:=link(p); free_node(p,ho(info(p)));
+ end;
+end;
+
+@ @<Dump the \eTeX\ state@>=
+while pseudo_files<>null do pseudo_close; {flush pseudo files}
+
+@ @<Generate all \eTeX...@>=
+primitive("readline",read_to_cs,1);@/
+@!@:read_line_}{\.{\\readline} primitive@>
+
+@ @<Cases of |read| for |print_cmd_chr|@>=
+else print_esc("readline")
+
+@ @<Handle \.{\\readline} and |goto done|@>=
+if j=1 then
+ begin while loc<=limit do {current line not yet finished}
+ begin cur_chr:=buffer[loc]; incr(loc);
+ if cur_chr=" " then cur_tok:=space_token
+ @+else cur_tok:=cur_chr+other_token;
+ store_new_token(cur_tok);
+ end;
+ goto done;
+ end
+
+@ Here we define the additional conditionals of \eTeX\ as well as the
+\.{\\unless} prefix.
+
+@d if_def_code=17 { `\.{\\ifdefined}' }
+@d if_cs_code=18 { `\.{\\ifcsname}' }
+@d if_font_char_code=19 { `\.{\\iffontchar}' }
+
+@<Generate all \eTeX...@>=
+primitive("unless",expand_after,1);@/
+@!@:unless_}{\.{\\unless} primitive@>
+primitive("ifdefined",if_test,if_def_code);
+@!@:if_defined_}{\.{\\ifdefined} primitive@>
+primitive("ifcsname",if_test,if_cs_code);
+@!@:if_cs_name_}{\.{\\ifcsname} primitive@>
+primitive("iffontchar",if_test,if_font_char_code);
+@!@:if_font_char_}{\.{\\iffontchar} primitive@>
+
+@ @<Cases of |expandafter| for |print_cmd_chr|@>=
+else print_esc("unless")
+
+@ @<Cases of |if_test| for |print_cmd_chr|@>=
+if_def_code:print_esc("ifdefined");
+if_cs_code:print_esc("ifcsname");
+if_font_char_code:print_esc("iffontchar");
+
+@ The result of a boolean condition is reversed when the conditional is
+preceded by \.{\\unless}.
+
+@<Negate a boolean conditional and |goto reswitch|@>=
+begin get_token;
+if (cur_cmd=if_test)and(cur_chr<>if_case_code) then
+ begin cur_chr:=cur_chr+unless_code; goto reswitch;
+ end;
+print_err("You can't use `"); print_esc("unless"); print("' before `");
+@.You can't use \\unless...@>
+print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+help1("Continue, and I'll forget that it ever happened.");
+back_error;
+end
+
+@ The conditional \.{\\ifdefined} tests if a control sequence is
+defined.
+
+We need to reset |scanner_status|, since \.{\\outer} control sequences
+are allowed, but we might be scanning a macro definition or preamble.
+
+@<Cases for |conditional|@>=
+if_def_code:begin save_scanner_status:=scanner_status;
+ scanner_status:=normal;
+ get_next; b:=(cur_cmd<>undefined_cs);
+ scanner_status:=save_scanner_status;
+ end;
+
+@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter}
+\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new
+control sequence will be entered into the hash table (once all tokens
+preceding the mandatory \.{\\endcsname} have been expanded).
+
+@<Cases for |conditional|@>=
+if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
+ repeat get_x_token;
+ if cur_cs=0 then store_new_token(cur_tok);
+ until cur_cs<>0;
+ if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
+ @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
+ flush_list(n);
+ b:=(eq_type(cur_cs)<>undefined_cs);
+ end;
+
+@ @<Look up the characters of list |n| in the hash table...@>=
+m:=first; p:=link(n);
+while p<>null do
+ begin if m>=max_buf_stack then
+ begin max_buf_stack:=m+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[m]:=info(p) mod @'400; incr(m); p:=link(p);
+ end;
+if m>first+1 then
+ cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|}
+else if m=first then cur_cs:=null_cs {the list is empty}
+else cur_cs:=single_base+buffer[first] {the list has length one}
+
+@ The conditional \.{\\iffontchar} tests the existence of a character in
+a font.
+
+@<Cases for |conditional|@>=
+if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
+ if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
+ b:=char_exists(char_info(n)(qi(cur_val)))
+ else b:=false;
+ end;
+
+@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
+command for macro definitions. Such macros are protected against
+expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
+or during \.{\\write}.
+
+@<Generate all \eTeX...@>=
+primitive("protected",prefix,8);
+@!@:protected_}{\.{\\protected} primitive@>
+
+@ @<Cases of |prefix| for |print_cmd_chr|@>=
+else if chr_code=8 then print_esc("protected")
+
+@ The |get_x_or_protected| procedure is like |get_x_token| except that
+protected macros are not expanded.
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
+ and expands non-protected macros}
+label exit;
+begin loop@+begin get_token;
+ if cur_cmd<=max_command then return;
+ if (cur_cmd>=call)and(cur_cmd<end_template) then
+ if info(link(cur_chr))=protected_token then return;
+ expand;
+ end;
+exit:end;
+
+@ A group entered (or a conditional started) in one file may end in a
+different file. Such slight anomalies, although perfectly legitimate,
+may cause errors that are difficult to locate. In order to be able to
+give a warning message when such anomalies occur, \eTeX\ uses the
+|grp_stack| and |if_stack| arrays to record the initial |cur_boundary|
+and |cond_ptr| values for each input file.
+
+@<Glob...@>=
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+
+@ When a group ends that was apparently entered in a different input
+file, the |group_warning| procedure is invoked in order to update the
+|grp_stack|. If moreover \.{\\tracingnesting} is positive we want to
+give a warning message. The situation is, however, somewhat complicated
+by two facts: (1)~There may be |grp_stack| elements without a
+corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g.,
+error insertions from the terminal); and (2)~the relevant information is
+recorded in the |name_field| of the |input_stack| only loosely
+synchronized with the |in_open| variable indexing |grp_stack|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure group_warning;
+var i:0..max_in_open; {index into |grp_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ {store current state}
+i:=in_open; w:=false;
+while (grp_stack[i]=cur_boundary)and(i>0) do
+ begin @<Set variable |w| to indicate if this case should be reported@>;
+ grp_stack[i]:=save_index(save_ptr); decr(i);
+ end;
+if w then
+ begin print_nl("Warning: end of "); print_group(true);
+@.Warning: end of...@>
+ print(" of a different file"); print_ln;
+ if tracing_nesting>1 then show_context;
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+
+@ This code scans the input stack in order to determine the type of the
+current input file.
+
+@<Set variable |w| to...@>=
+if tracing_nesting>0 then
+ begin while (input_stack[base_ptr].state_field=token_list)or@|
+ (input_stack[base_ptr].index_field>i) do decr(base_ptr);
+ if input_stack[base_ptr].name_field>17 then w:=true;
+ end
+
+@ When a conditional ends that was apparently started in a different
+input file, the |if_warning| procedure is invoked in order to update the
+|if_stack|. If moreover \.{\\tracingnesting} is positive we want to
+give a warning message (with the same complications as above).
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure if_warning;
+var i:0..max_in_open; {index into |if_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ {store current state}
+i:=in_open; w:=false;
+while if_stack[i]=cond_ptr do
+ begin @<Set variable |w| to...@>;
+ if_stack[i]:=link(cond_ptr); decr(i);
+ end;
+if w then
+ begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if);
+@.Warning: end of...@>
+ print_if_line(if_line); print(" of a different file"); print_ln;
+ if tracing_nesting>1 then show_context;
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+
+@ Conversely, the |file_warning| procedure is invoked when a file ends
+and some groups entered or conditionals started while reading from that
+file are still incomplete.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure file_warning;
+var p:pointer; {saved value of |save_ptr| or |cond_ptr|}
+@!l:quarterword; {saved value of |cur_level| or |if_limit|}
+@!c:quarterword; {saved value of |cur_group| or |cur_if|}
+@!i:integer; {saved value of |if_line|}
+begin p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary;
+while grp_stack[in_open]<>save_ptr do
+ begin decr(cur_level);
+ print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+ print_group(true); print(" is incomplete");@/
+ cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+ end;
+save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values}
+p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line;
+while if_stack[in_open]<>cond_ptr do
+ begin print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+ print_cmd_chr(if_test,cur_if);
+ if if_limit=fi_code then print_esc("else");
+ print_if_line(if_line); print(" is incomplete");@/
+ if_line:=if_line_field(cond_ptr); cur_if:=subtype(cond_ptr);
+ if_limit:=type(cond_ptr); cond_ptr:=link(cond_ptr);
+ end;
+cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values}
+print_ln;
+if tracing_nesting>1 then show_context;
+if history=spotless then history:=warning_issued;
+end;
+
+@ Here are the additional \eTeX\ primitives for expressions.
+
+@<Generate all \eTeX...@>=
+primitive("numexpr",last_item,eTeX_expr-int_val+int_val);
+@!@:num_expr_}{\.{\\numexpr} primitive@>
+primitive("dimexpr",last_item,eTeX_expr-int_val+dimen_val);
+@!@:dim_expr_}{\.{\\dimexpr} primitive@>
+primitive("glueexpr",last_item,eTeX_expr-int_val+glue_val);
+@!@:glue_expr_}{\.{\\glueexpr} primitive@>
+primitive("muexpr",last_item,eTeX_expr-int_val+mu_val);
+@!@:mu_expr_}{\.{\\muexpr} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+eTeX_expr-int_val+int_val: print_esc("numexpr");
+eTeX_expr-int_val+dimen_val: print_esc("dimexpr");
+eTeX_expr-int_val+glue_val: print_esc("glueexpr");
+eTeX_expr-int_val+mu_val: print_esc("muexpr");
+
+@ This code for reducing |cur_val_level| and\slash or negating the
+result is similar to the one for all the other cases of
+|scan_something_internal|, with the difference that |scan_expr| has
+already increased the reference count of a glue specification.
+
+@<Process an expression and |return|@>=
+begin if m<eTeX_mu then
+ begin case m of
+ @/@<Cases for fetching a glue value@>@/
+ end; {there are no other cases}
+ cur_val_level:=glue_val;
+ end
+else if m<eTeX_expr then
+ begin case m of
+ @/@<Cases for fetching a mu value@>@/
+ end; {there are no other cases}
+ cur_val_level:=mu_val;
+ end
+else begin cur_val_level:=m-eTeX_expr+int_val; scan_expr;
+ end;
+while cur_val_level>level do
+ begin if cur_val_level=glue_val then
+ begin m:=cur_val; cur_val:=width(m); delete_glue_ref(m);
+ end
+ else if cur_val_level=mu_val then mu_error;
+ decr(cur_val_level);
+ end;
+if negative then
+ if cur_val_level>=glue_val then
+ begin m:=cur_val; cur_val:=new_spec(m); delete_glue_ref(m);
+ @<Negate all three glue components of |cur_val|@>;
+ end
+ else negate(cur_val);
+return;
+end
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_expr; forward;@t\2@>
+
+@ The |scan_expr| procedure scans and evaluates an expression.
+
+@<Declare procedures needed for expressions@>=
+@t\4@>@<Declare subprocedures for |scan_expr|@>
+procedure scan_expr; {scans and evaluates an expression}
+label restart, continue, found;
+var a,@!b:boolean; {saved values of |arith_error|}
+@!l:small_number; {type of expression}
+@!r:small_number; {state of expression so far}
+@!s:small_number; {state of term so far}
+@!o:small_number; {next operation or type of next factor}
+@!e:integer; {expression so far}
+@!t:integer; {term so far}
+@!f:integer; {current factor}
+@!n:integer; {numerator of combined multiplication and division}
+@!p:pointer; {top of expression stack}
+@!q:pointer; {for stack manipulations}
+begin l:=cur_val_level; a:=arith_error; b:=false; p:=null;
+@<Scan and evaluate an expression |e| of type |l|@>;
+if b then
+ begin print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+ help2("I can't evaluate this expression,")@/
+ ("since the result is out of range.");
+ error;
+ if l>=glue_val then
+ begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e);
+ end
+ else e:=0;
+ end;
+arith_error:=a; cur_val:=e; cur_val_level:=l;
+end;
+
+@ Evaluating an expression is a recursive process: When the left
+parenthesis of a subexpression is scanned we descend to the next level
+of recursion; the previous level is resumed with the matching right
+parenthesis.
+
+@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen}
+@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen}
+@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen}
+@d expr_mult=3 {$\langle\it term\rangle$ \.* seen}
+@d expr_div=4 {$\langle\it term\rangle$ \./ seen}
+@d expr_scale=5 {$\langle\it term\rangle$ \.*
+ $\langle\it factor\rangle$ \./ seen}
+
+@<Scan and eval...@>=
+restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0;
+continue: if s=expr_none then o:=l@+else o:=int_val;
+@<Scan a factor |f| of type |o| or start a subexpression@>;
+found: @<Scan the next operator and set |o|@>;
+arith_error:=b;
+@<Make sure that |f| is in the proper range@>;
+case s of @<Cases for evaluation of the current term@>@;
+end; {there are no other cases}
+if o>expr_sub then s:=o@+else @<Evaluate the current expression@>;
+b:=arith_error;
+if o<>expr_none then goto continue;
+if p<>null then @<Pop the expression stack and |goto found|@>
+
+@ @<Scan the next op...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"+" then o:=expr_add
+else if cur_tok=other_token+"-" then o:=expr_sub
+else if cur_tok=other_token+"*" then o:=expr_mult
+else if cur_tok=other_token+"/" then o:=expr_div
+else begin o:=expr_none;
+ if p=null then
+ begin if cur_cmd<>relax then back_input;
+ end
+ else if cur_tok<>other_token+")" then
+ begin print_err("Missing ) inserted for expression");
+@.Missing ) inserted@>
+ help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't.");
+ back_error;
+ end;
+ end
+
+@ @<Scan a factor...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"(" then
+ @<Push the expression stack and |goto restart|@>;
+back_input;
+if o=int_val then scan_int
+else if o=dimen_val then scan_normal_dimen
+else if o=glue_val then scan_normal_glue
+else scan_mu_glue;
+f:=cur_val
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_normal_glue; forward;@t\2@>@/
+procedure@?scan_mu_glue; forward;@t\2@>
+
+@ Here we declare to trivial procedures in order to avoid mutually
+recursive procedures with parameters.
+
+@<Declare procedures needed for expressions@>=
+procedure scan_normal_glue;
+begin scan_glue(glue_val);
+end;
+@#
+procedure scan_mu_glue;
+begin scan_glue(mu_val);
+end;
+
+@ Parenthesized subexpressions can be inside expressions, and this
+nesting has a stack. Seven local variables represent the top of the
+expression stack: |p| points to pushed-down entries, if any; |l|
+specifies the type of expression currently beeing evaluated; |e| is the
+expression so far and |r| is the state of its evaluation; |t| is the
+term so far and |s| is the state of its evaluation; finally |n| is the
+numerator for a combined multiplication and division, if any.
+
+@d expr_node_size=4 {number of words in stack entry for subexpressions}
+@d expr_e_field(#)==mem[#+1].int {saved expression so far}
+@d expr_t_field(#)==mem[#+2].int {saved term so far}
+@d expr_n_field(#)==mem[#+3].int {saved numerator}
+
+@<Push the expression...@>=
+begin q:=get_node(expr_node_size); link(q):=p; type(q):=l;
+subtype(q):=4*s+r;
+expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n;
+p:=q; l:=o; goto restart;
+end
+
+@ @<Pop the expression...@>=
+begin f:=e; q:=p;
+e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q);
+s:=subtype(q) div 4; r:=subtype(q) mod 4;
+l:=type(q); p:=link(q); free_node(q,expr_node_size);
+goto found;
+end
+
+@ We want to make sure that each term and (intermediate) result is in
+the proper range. Integer values must not exceed |infinity|
+($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen|
+($2^{30}-1$). We avoid the absolute value of an integer, because this
+might fail for the value $-2^{31}$ using 32-bit arithmetic.
+
+@d num_error(#)== {clear a number or dimension and set |arith_error|}
+ begin arith_error:=true; #:=0;
+ end
+@d glue_error(#)== {clear a glue spec and set |arith_error|}
+ begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue);
+ end
+
+@<Make sure that |f|...@>=
+if (l=int_val)or(s>expr_sub) then
+ begin if (f>infinity)or(f<-infinity) then num_error(f);
+ end
+else if l=dimen_val then
+ begin if abs(f)>max_dimen then num_error(f);
+ end
+else begin if (abs(width(f))>max_dimen)or@|
+ (abs(stretch(f))>max_dimen)or@|
+ (abs(shrink(f))>max_dimen) then glue_error(f);
+ end
+
+@ Applying the factor |f| to the partial term |t| (with the operator
+|s|) is delayed until the next operator |o| has been scanned. Here we
+handle the first factor of a partial term. A glue spec has to be copied
+unless the next operator is a right parenthesis; this allows us later on
+to simply modify the glue components.
+
+@d normalize_glue(#)==
+ if stretch(#)=0 then stretch_order(#):=normal;
+ if shrink(#)=0 then shrink_order(#):=normal
+
+@<Cases for evaluation of the current term@>=
+expr_none: if (l>=glue_val)and(o<>expr_none) then
+ begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t);
+ end
+ else t:=f;
+
+@ When a term |t| has been completed it is copied to, added to, or
+subtracted from the expression |e|.
+
+@d expr_add_sub(#)==add_or_sub(#,r=expr_sub)
+@d expr_a(#)==expr_add_sub(#,max_dimen)
+
+@<Evaluate the current expression@>=
+begin s:=expr_none;
+if r=expr_none then e:=t
+else if l=int_val then e:=expr_add_sub(e,t,infinity)
+else if l=dimen_val then e:=expr_a(e,t)
+else @<Compute the sum or difference of two glue specs@>;
+r:=o;
+end
+
+@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum
+(for |negative=false|) or difference (for |negative=true|) of |x| and
+|y|, provided the absolute value of the result does not exceed
+|max_answer|.
+
+@<Declare subprocedures for |scan_expr|@>=
+function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer;
+var a:integer; {the answer}
+begin if negative then negate(y);
+if x>=0 then
+ if y<=max_answer-x then a:=x+y@+else num_error(a)
+else if y>=-max_answer-x then a:=x+y@+else num_error(a);
+add_or_sub:=a;
+end;
+
+@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and
+|shrink_order(e)>normal| implies |shrink(e)<>0|.
+
+@<Compute the sum or diff...@>=
+begin width(e):=expr_a(width(e),width(t));
+if stretch_order(e)=stretch_order(t) then
+ stretch(e):=expr_a(stretch(e),stretch(t))
+else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then
+ begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t);
+ end;
+if shrink_order(e)=shrink_order(t) then
+ shrink(e):=expr_a(shrink(e),shrink(t))
+else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then
+ begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t);
+ end;
+delete_glue_ref(t); normalize_glue(e);
+end
+
+@ If a multiplication is followed by a division, the two operations are
+combined into a `scaling' operation. Otherwise the term |t| is
+multiplied by the factor |f|.
+
+@d expr_m(#)==#:=nx_plus_y(#,f,0)
+
+@<Cases for evaluation of the current term@>=
+expr_mult: if o=expr_div then
+ begin n:=f; o:=expr_scale;
+ end
+ else if l=int_val then t:=mult_integers(t,f)
+ else if l=dimen_val then expr_m(t)
+ else begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t));
+ end;
+
+@ Here we divide the term |t| by the factor |f|.
+
+@d expr_d(#)==#:=quotient(#,f)
+
+@<Cases for evaluation of the current term@>=
+expr_div: if l<glue_val then expr_d(t)
+ else begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t));
+ end;
+
+@ The function |quotient(n,d)| computes the rounded quotient
+$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive.
+
+@<Declare subprocedures for |scan_expr|@>=
+function quotient(@!n,@!d:integer):integer;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+begin if d=0 then num_error(a)
+else begin if d>0 then negative:=false
+ else begin negate(d); negative:=true;
+ end;
+ if n<0 then
+ begin negate(n); negative:=not negative;
+ end;
+ a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!}
+ if d+n>=0 then incr(a);
+ if negative then negate(a);
+ end;
+quotient:=a;
+end;
+
+@ Here the term |t| is multiplied by the quotient $n/f$.
+
+@d expr_s(#)==#:=fract(#,n,f,max_dimen)
+
+@<Cases for evaluation of the current term@>=
+expr_scale: if l=int_val then t:=fract(t,n,f,infinity)
+ else if l=dimen_val then expr_s(t)
+ else begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t));
+ end;
+
+@ Finally, the function |fract(x,n,d,max_answer)| computes the integer
+$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive
+and the result does not exceed |max_answer|. We can't use floating
+point arithmetic since the routine must produce identical results in all
+cases; and it would be too dangerous to multiply by~|n| and then divide
+by~|d|, in separate operations, since overflow might well occur. Hence
+this subroutine simulates double precision arithmetic, somewhat
+analogous to \MF's |make_fraction| and |take_fraction| routines.
+
+@d too_big=88 {go here when the result is too big}
+
+@<Declare subprocedures for |scan_expr|@>=
+function fract(@!x,@!n,@!d,@!max_answer:integer):integer;
+label found, found1, too_big, done;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+@!f:integer; {a proper fraction}
+@!h:integer; {smallest integer such that |2*h>=d|}
+@!r:integer; {intermediate remainder}
+@!t:integer; {temp variable}
+begin if d=0 then goto too_big;
+a:=0;
+if d>0 then negative:=false
+else begin negate(d); negative:=true;
+ end;
+if x<0 then
+ begin negate(x); negative:=not negative;
+ end
+else if x=0 then goto done;
+if n<0 then
+ begin negate(n); negative:=not negative;
+ end;
+t:=n div d;
+if t>max_answer div x then goto too_big;
+a:=t*x; n:=n-t*d;
+if n=0 then goto found;
+t:=x div d;
+if t>(max_answer-a) div n then goto too_big;
+a:=a+t*n; x:=x-t*d;
+if x=0 then goto found;
+if x<n then
+ begin t:=x; x:=n; n:=t;
+ end; {now |0<n<=x<d|}
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@;
+if f>(max_answer-a) then goto too_big;
+a:=a+f;
+found: if negative then negate(a);
+goto done;
+too_big: num_error(a);
+done: fract:=a;
+end;
+
+@ The loop here preserves the following invariant relations
+between |f|, |x|, |n|, and~|r|:
+(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$;
+(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$
+and $n$.
+
+Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|,
+because the latter could overflow.
+
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>=
+f:=0; r:=(d div 2)-d; h:=-r;
+loop@+begin if odd(n) then
+ begin r:=r+x;
+ if r>=0 then
+ begin r:=r-d; incr(f);
+ end;
+ end;
+ n:=n div 2;
+ if n=0 then goto found1;
+ if x<h then x:=x+x
+ else begin t:=x-d; x:=t+x; f:=f+n;
+ if x<n then
+ begin if x=0 then goto found1;
+ t:=x; x:=n; n:=t;
+ end;
+ end;
+ end;
+found1:
+
+@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and
+\.{\\glueshrinkorder} commands return the stretch and shrink components
+and their orders of ``infinity'' of a glue specification.
+
+@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}}
+@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}}
+@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}}
+@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}}
+
+@<Generate all \eTeX...@>=
+primitive("gluestretchorder",last_item,glue_stretch_order_code);
+@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@>
+primitive("glueshrinkorder",last_item,glue_shrink_order_code);
+@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@>
+primitive("gluestretch",last_item,glue_stretch_code);
+@!@:glue_stretch_}{\.{\\gluestretch} primitive@>
+primitive("glueshrink",last_item,glue_shrink_code);
+@!@:glue_shrink_}{\.{\\glueshrink} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+glue_stretch_order_code: print_esc("gluestretchorder");
+glue_shrink_order_code: print_esc("glueshrinkorder");
+glue_stretch_code: print_esc("gluestretch");
+glue_shrink_code: print_esc("glueshrink");
+
+@ @<Cases for fetching an integer value@>=
+glue_stretch_order_code, glue_shrink_order_code:
+ begin scan_normal_glue; q:=cur_val;
+ if m=glue_stretch_order_code then cur_val:=stretch_order(q)
+ else cur_val:=shrink_order(q);
+ delete_glue_ref(q);
+ end;
+
+@ @<Cases for fetching a dimension value@>=
+glue_stretch_code, glue_shrink_code:
+ begin scan_normal_glue; q:=cur_val;
+ if m=glue_stretch_code then cur_val:=stretch(q)
+ else cur_val:=shrink(q);
+ delete_glue_ref(q);
+ end;
+
+@ The \.{\\mutoglue} and \.{\\gluetomu} commands convert ``math'' glue
+into normal glue and vice versa; they allow to manipulate math glue with
+\.{\\gluestretch} etc.
+
+@d mu_to_glue_code=eTeX_glue {code for \.{\\mutoglue}}
+@d glue_to_mu_code=eTeX_mu {code for \.{\\gluetomu}}
+
+@<Generate all \eTeX...@>=
+primitive("mutoglue",last_item,mu_to_glue_code);
+@!@:mu_to_glue_}{\.{\\mutoglue} primitive@>
+primitive("gluetomu",last_item,glue_to_mu_code);
+@!@:glue_to_mu_}{\.{\\gluetomu} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+mu_to_glue_code: print_esc("mutoglue");
+glue_to_mu_code: print_esc("gluetomu");
+
+@ @<Cases for fetching a glue value@>=
+mu_to_glue_code: scan_mu_glue;
+
+@ @<Cases for fetching a mu value@>=
+glue_to_mu_code: scan_normal_glue;
+
+@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
+dimen, skip, muskip, box, and token registers. As in \TeX\ the first
+256 registers of each kind are realized as arrays in the table of
+equivalents; the additional registers are realized as tree structures
+built from variable-size nodes with individual registers existing only
+when needed. Default values are used for nonexistent registers: zero
+for count and dimen values, |zero_glue| for glue (skip and muskip)
+values, void for boxes, and |null| for token lists (and current marks
+discussed below).
+
+Similarly there are 32768 mark classes; the command \.{\\marks}|n|
+creates a mark node for a given mark class |0<=n<=32767| (where
+\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
+the |fire_up| routine) and the |vsplit| routine maintain the current
+values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
+|split_bot_mark| for each mark class. They are accessed as
+\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
+\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
+are realized as |cur_mark| array. The additional current marks are
+again realized as tree structure with individual mark classes existing
+only when needed.
+
+@<Generate all \eTeX...@>=
+primitive("marks",mark,marks_code);
+@!@:marks_}{\.{\\marks} primitive@>
+primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
+@!@:top_marks_}{\.{\\topmarks} primitive@>
+primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
+@!@:first_marks_}{\.{\\firstmarks} primitive@>
+primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
+@!@:bot_marks_}{\.{\\botmarks} primitive@>
+primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
+@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
+primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
+@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
+
+@ The |scan_register_num| procedure scans a register number that must
+not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?scan_register_num; forward;@t\2@>
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>max_reg_num) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2(max_reg_help_line)("I changed this one to zero.");
+ int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Initialize variables for \eTeX\ comp...@>=
+max_reg_num:=255;
+max_reg_help_line:="A register number must be between 0 and 255.";
+
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+
+@ @<Glob...@>=
+@!max_reg_num: halfword; {largest allowed register number}
+@!max_reg_help_line: str_number; {first line of help message}
+
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@#
+@d index_node_size=9 {size of an index node}
+@d sa_index==type {a four-bit address or a type or both}
+@d sa_used==subtype {count of non-null pointers}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure new_index(@!i:quarterword; @!q:pointer);
+var k:small_number; {loop index}
+begin cur_ptr:=get_node(index_node_size); sa_index(cur_ptr):=i;
+sa_used(cur_ptr):=0; link(cur_ptr):=q;
+for k:=1 to index_node_size-1 do {clear all 16 pointers}
+ mem[cur_ptr+k]:=sa_null;
+end;
+
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then box(cur_val):=#@+else set_sa_box(#)
+@#
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin sa_ptr(cur_ptr):=#; add_sa_ref(cur_ptr); delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ Here we compute the pointer to the current mark of type |t| and mark
+class |cur_val|.
+
+@<Compute the mark pointer...@>=
+begin find_sa_element(mark_val,cur_val,false);
+if cur_ptr<>null then
+ if odd(t) then cur_ptr:=link(cur_ptr+(t div 2)+1)
+ else cur_ptr:=info(cur_ptr+(t div 2)+1);
+end
+
+@ The current marks for all mark classes are maintained by the |vsplit|
+and |fire_up| routines and are finally destroyed (for \.{INITEX} only)
+@.INITEX@>
+by the |final_cleanup| routine. Apart from updating the current marks
+when mark nodes are encountered, these routines perform certain actions
+on all existing mark classes. The recursive |do_marks| procedure walks
+through the whole tree or a subtree of existing mark class nodes and
+preforms certain actions indicted by its first parameter |a|, the action
+code. The second parameter |l| indicates the level of recursion (at
+most four); the third parameter points to a nonempty tree or subtree.
+The result is |true| if the complete tree or subtree has been deleted.
+
+@d vsplit_init==0 {action code for |vsplit| initialization}
+@d fire_up_init==1 {action code for |fire_up| initialization}
+@d fire_up_done==2 {action code for |fire_up| completion}
+@d destroy_marks==3 {action code for |final_cleanup|}
+@#
+@d sa_top_mark(#)==info(#+1) {\.{\\topmarks}|n|}
+@d sa_first_mark(#)==link(#+1) {\.{\\firstmarks}|n|}
+@d sa_bot_mark(#)==info(#+2) {\.{\\botmarks}|n|}
+@d sa_split_first_mark(#)==link(#+2) {\.{\\splitfirstmarks}|n|}
+@d sa_split_bot_mark(#)==info(#+3) {\.{\\splitbotmarks}|n|}
+
+@<Declare the function called |do_marks|@>=
+function do_marks(@!a,@!l:small_number;@!q:pointer):boolean;
+var i:small_number; {a four bit index}
+begin if l<4 then {|q| is an index node}
+ begin for i:=0 to 15 do
+ begin get_sa_ptr;
+ if cur_ptr<>null then if do_marks(a,l+1,cur_ptr) then delete_sa_ptr;
+ end;
+ if sa_used(q)=0 then
+ begin free_node(q,index_node_size); q:=null;
+ end;
+ end
+else {|q| is the node for a mark class}
+ begin case a of
+ @<Cases for |do_marks|@>@;
+ end; {there are no other cases}
+ if sa_bot_mark(q)=null then if sa_split_bot_mark(q)=null then
+ begin free_node(q,mark_class_node_size); q:=null;
+ end;
+ end;
+do_marks:=(q=null);
+end;
+
+@ At the start of the |vsplit| routine the existing |split_fist_mark|
+and |split_bot_mark| are discarded.
+
+@<Cases for |do_marks|@>=
+vsplit_init: if sa_split_first_mark(q)<>null then
+ begin delete_token_ref(sa_split_first_mark(q)); sa_split_first_mark(q):=null;
+ delete_token_ref(sa_split_bot_mark(q)); sa_split_bot_mark(q):=null;
+ end;
+
+@ We use again the fact that |split_first_mark=null| if and only if
+|split_bot_mark=null|.
+
+@<Update the current marks for |vsplit|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_split_first_mark(cur_ptr)=null then
+ begin sa_split_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end
+else delete_token_ref(sa_split_bot_mark(cur_ptr));
+sa_split_bot_mark(cur_ptr):=mark_ptr(p);
+add_token_ref(mark_ptr(p));
+end
+
+@ At the start of the |fire_up| routine the old |top_mark| and
+|first_mark| are discarded, whereas the old |bot_mark| becomes the new
+|top_mark|. An empty new |top_mark| token list is, however, discarded
+as well in order that mark class nodes can eventually be released. We
+use again the fact that |bot_mark<>null| implies |first_mark<>null|; it
+also knows that |bot_mark=null| implies |top_mark=first_mark=null|.
+
+@<Cases for |do_marks|@>=
+fire_up_init: if sa_bot_mark(q)<>null then
+ begin if sa_top_mark(q)<>null then delete_token_ref(sa_top_mark(q));
+ delete_token_ref(sa_first_mark(q)); sa_first_mark(q):=null;
+ if link(sa_bot_mark(q))=null then {an empty token list}
+ begin delete_token_ref(sa_bot_mark(q)); sa_bot_mark(q):=null;
+ end
+ else add_token_ref(sa_bot_mark(q));
+ sa_top_mark(q):=sa_bot_mark(q);
+ end;
+
+@ @<Cases for |do_marks|@>=
+fire_up_done: if (sa_top_mark(q)<>null)and(sa_first_mark(q)=null) then
+ begin sa_first_mark(q):=sa_top_mark(q); add_token_ref(sa_top_mark(q));
+ end;
+
+@ @<Update the current marks for |fire_up|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_first_mark(cur_ptr)=null then
+ begin sa_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end;
+if sa_bot_mark(cur_ptr)<>null then delete_token_ref(sa_bot_mark(cur_ptr));
+sa_bot_mark(cur_ptr):=mark_ptr(p); add_token_ref(mark_ptr(p));
+end
+
+@ Here we use the fact that the five current mark pointers in a mark
+class node occupy the same locations as the the first five pointers of
+an index node. For systems using a run-time switch to distinguish
+between \.{VIRTEX} and \.{INITEX}, the codewords `$|init|\ldots|tini|$'
+surrounding the following piece of code should be removed.
+@.INITEX@>
+@^system dependencies@>
+
+@<Cases for |do_marks|@>=
+@!init destroy_marks: for i:=top_mark_code to split_bot_mark_code do
+ begin get_sa_ptr;
+ if cur_ptr<>null then
+ begin delete_token_ref(cur_ptr); put_sa_ptr(null);
+ end;
+ end;
+tini
+
+@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
+etc., as well as for references to sparse array elements defined by
+`\.{\\countdef}', etc.
+
+@<Cases of |register| for |print_cmd_chr|@>=
+begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
+ cmd:=sa_type(chr_code)
+else begin cmd:=chr_code-mem_bot; chr_code:=null;
+ end;
+if cmd=int_val then print_esc("count")
+else if cmd=dimen_val then print_esc("dimen")
+else if cmd=glue_val then print_esc("skip")
+else print_esc("muskip");
+if chr_code<>null then print_sa_num(chr_code);
+end
+
+@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
+well as for references to sparse array elements defined by
+`\.{\\toksdef}'.
+
+@<Cases of |toks_register| for |print_cmd_chr|@>=
+begin print_esc("toks");
+if chr_code<>mem_bot then print_sa_num(chr_code);
+end
+
+@ When a shorthand definition for an element of one of the sparse arrays
+is destroyed, we must reduce the reference count.
+
+@<Cases for |eq_destroy|@>=
+toks_register,register:
+ if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
+ delete_sa_ref(equiv_field(w));
+
+@ The task to maintain (change, save, and restore) register values is
+essentially the same when the register is realized as sparse array
+element or entry in |eqtb|. The global variable |sa_chain| is the head
+of a linked list of entries saved at the topmost level |sa_level|; the
+lists for lowel levels are kept in special save stack entries.
+
+@<Glob...@>=
+@!sa_chain: pointer; {chain of saved sparse array entries}
+@!sa_level: quarterword; {group level for |sa_chain|}
+
+@ @<Set init...@>=
+sa_chain:=null; sa_level:=level_zero;
+
+@ The individual saved items are kept in pointer or word nodes similar
+to those used for the array elements: a word node with value zero is,
+however, saved as pointer node with the otherwise impossible |sa_index|
+value |tok_val_limit|.
+
+@d sa_loc==sa_ref {location of saved item}
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+
+@ The procedure |sa_def| assigns a new value to sparse array elements,
+and saves the former value if appropriate. This procedure is used only
+for skip, muskip, box, and token list registers. The counterpart of
+|sa_def| for count and dimen registers is called |sa_w_def|.
+
+@d sa_define(#)==if e then
+ if global then gsa_def(#)@+else sa_def(#)
+ else define
+@#
+@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
+ begin find_sa_element(box_val,cur_val,true);
+ if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
+ end
+@#
+@d sa_word_define(#)==if e then
+ if global then gsa_w_def(#)@+else sa_w_def(#)
+ else word_define(#)
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_def(@!p:pointer;@!e:halfword);
+ {new data for sparse array elements}
+begin add_sa_ref(p);
+if sa_ptr(p)=e then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ sa_destroy(p);
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
+ sa_lev(p):=cur_level; sa_ptr(p):=e;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+@#
+procedure sa_w_def(@!p:pointer;@!w:integer);
+begin add_sa_ref(p);
+if sa_int(p)=w then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)<>cur_level then sa_save(p);
+ sa_lev(p):=cur_level; sa_int(p):=w;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+
+@ The |sa_def| and |sa_w_def| routines take care of local definitions.
+@^global definitions@>
+Global definitions are done in almost the same way, but there is no need
+to save old values, and the new value is associated with |level_one|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+@#
+procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_lev(p):=level_one; sa_int(p):=w;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+
+@ The |sa_restore| procedure restores the sparse array entries pointed
+at by |sa_chain|
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+
+@ When the value of |last_line_fit| is positive, the last line of a
+(partial) paragraph is treated in a special way and we need additional
+fields in the active nodes.
+
+@d active_node_size_extended=5 {number of words in extended active nodes}
+@d active_short(#)==mem[#+3].sc {|shortfall| of this line}
+@d active_glue(#)==mem[#+4].sc {corresponding glue stretch or shrink}
+
+@<Glob...@>=
+@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph}
+@!do_last_line_fit:boolean; {special algorithm for last line of paragraph?}
+@!active_node_size:small_number; {number of words in active nodes}
+@!fill_width:array[0..2] of scaled; {infinite stretch components of
+ |par_fill_skip|}
+@!best_pl_short:array[very_loose_fit..tight_fit] of scaled; {|shortfall|
+ corresponding to |minimal_demerits|}
+@!best_pl_glue:array[very_loose_fit..tight_fit] of scaled; {corresponding
+ glue stretch or shrink}
+
+@ The new algorithm for the last line requires that the stretchability
+|par_fill_skip| is infinite and the stretchability of |left_skip| plus
+|right_skip| is finite.
+
+@<Check for special...@>=
+do_last_line_fit:=false; active_node_size:=active_node_size_normal;
+ {just in case}
+if last_line_fit>0 then
+ begin q:=glue_ptr(last_line_fill);
+ if (stretch(q)>0)and(stretch_order(q)>normal) then
+ if (background[3]=0)and(background[4]=0)and(background[5]=0) then
+ begin do_last_line_fit:=true;
+ active_node_size:=active_node_size_extended;
+ fill_width[0]:=0; fill_width[1]:=0; fill_width[2]:=0;
+ fill_width[stretch_order(q)-1]:=stretch(q);
+ end;
+ end
+
+@ @<Other local variables for |try_break|@>=
+@!g:scaled; {glue stretch or shrink of test line, adjustment for last line}
+
+@ Here we initialize the additional fields of the first active node
+representing the beginning of the paragraph.
+
+@<Initialize additional fields of the first active node@>=
+begin active_short(q):=0; active_glue(q):=0;
+end
+
+@ Here we compute the adjustment |g| and badness |b| for a line from |r|
+to the end of the paragraph. When any of the criteria for adjustment is
+violated we fall through to the normal algorithm.
+
+The last line must be too short, and have infinite stretch entirely due
+to |par_fill_skip|.
+
+@<Perform computations for last line and |goto found|@>=
+begin if (active_short(r)=0)or(active_glue(r)<=0) then goto not_found;
+ {previous line was neither stretched nor shrunk, or was infinitely bad}
+if (cur_active_width[3]<>fill_width[0])or@|
+ (cur_active_width[4]<>fill_width[1])or@|
+ (cur_active_width[5]<>fill_width[2]) then goto not_found;
+ {infinite stretch of this line not entirely due to |par_fill_skip|}
+if active_short(r)>0 then g:=cur_active_width[2]
+else g:=cur_active_width[6];
+if g<=0 then goto not_found; {no finite stretch resp.\ no shrink}
+arith_error:=false; g:=fract(g,active_short(r),active_glue(r),max_dimen);
+if last_line_fit<1000 then g:=fract(g,last_line_fit,1000,max_dimen);
+if arith_error then
+ if active_short(r)>0 then g:=max_dimen@+else g:=-max_dimen;
+if g>0 then
+ @<Set the value of |b| to the badness of the last line for stretching,
+ compute the corresponding |fit_class, and |goto found||@>
+else if g<0 then
+ @<Set the value of |b| to the badness of the last line for shrinking,
+ compute the corresponding |fit_class, and |goto found||@>;
+not_found:end
+
+@ These badness computations are rather similar to those of the standard
+algorithm, with the adjustment amount |g| replacing the |shortfall|.
+
+@<Set the value of |b| to the badness of the last line for str...@>=
+begin if g>shortfall then g:=shortfall;
+if g>7230584 then if cur_active_width[2]<1663497 then
+ begin b:=inf_bad; fit_class:=very_loose_fit; goto found;
+ end;
+b:=badness(g,cur_active_width[2]);
+if b>12 then
+ if b>99 then fit_class:=very_loose_fit
+ else fit_class:=loose_fit
+else fit_class:=decent_fit;
+goto found;
+end
+
+@ @<Set the value of |b| to the badness of the last line for shr...@>=
+begin if -g>cur_active_width[6] then g:=-cur_active_width[6];
+b:=badness(-g,cur_active_width[6]);
+if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
+goto found;
+end
+
+@ Vanishing values of |shortfall| and |g| indicate that the last line is
+not adjusted.
+
+@<Adjust \(t)the additional data for last line@>=
+begin if cur_p=null then shortfall:=0;
+if shortfall>0 then g:=cur_active_width[2]
+else if shortfall<0 then g:=cur_active_width[6]
+else g:=0;
+end
+
+@ For each feasible break we record the shortfall and glue stretch or
+shrink (or adjustment).
+
+@<Store \(a)additional data for this feasible break@>=
+begin best_pl_short[fit_class]:=shortfall; best_pl_glue[fit_class]:=g;
+end
+
+@ Here we save these data in the active node representing a potential
+line break.
+
+@<Store \(a)additional data in the new active node@>=
+begin active_short(q):=best_pl_short[fit_class];
+active_glue(q):=best_pl_glue[fit_class];
+end
+
+@ @<Print additional data in the new active node@>=
+begin print(" s="); print_scaled(active_short(q));
+if cur_p=null then print(" a=")@+else print(" g=");
+print_scaled(active_glue(q));
+end
+
+@ Here we either reset |do_last_line_fit| or adjust the |par_fill_skip|
+glue.
+
+@<Adjust \(t)the final line of the paragraph@>=
+if active_short(best_bet)=0 then do_last_line_fit:=false
+else begin q:=new_spec(glue_ptr(last_line_fill));
+ delete_glue_ref(glue_ptr(last_line_fill));
+ width(q):=width(q)+active_short(best_bet)-active_glue(best_bet);
+ stretch(q):=0; glue_ptr(last_line_fill):=q;
+ end
+
+@ When reading \.{\\patterns} while \.{\\savinghyphcodes} is positive
+the current |lc_code| values are stored together with the hyphenation
+patterns for the current language. They will later be used instead of
+the |lc_code| values for hyphenation purposes.
+
+The |lc_code| values are stored in the linked trie analogous to patterns
+$p_1$ of length~1, with |hyph_root=trie_r[0]| replacing |trie_root| and
+|lc_code(p_1)| replacing the |trie_op| code. This allows to compress
+and pack them together with the patterns with minimal changes to the
+existing code.
+
+@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|}
+
+@<Initialize table entries...@>=
+hyph_root:=0; hyph_start:=0;
+
+@ @<Store hyphenation codes for current language@>=
+begin c:=cur_lang; first_child:=false; p:=0;
+repeat q:=p; p:=trie_r[q];
+until (p=0)or(c<=so(trie_c[p]));
+if (p=0)or(c<so(trie_c[p])) then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>;
+q:=p; {now node |q| represents |cur_lang|}
+@<Store all current |lc_code| values@>;
+end
+
+@ We store all nonzero |lc_code| values, overwriting any previously
+stored values (and possibly wasting a few trie nodes that were used
+previously and are not needed now). We always store at least one
+|lc_code| value such that |hyph_index| (defined below) will not be zero.
+
+@<Store all current |lc_code| values@>=
+p:=trie_l[q]; first_child:=true;
+for c:=0 to 255 do
+ if (lc_code(c)>0)or((c=255)and first_child) then
+ begin if p=0 then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>
+ else trie_c[p]:=si(c);
+ trie_o[p]:=qi(lc_code(c));
+ q:=p; p:=trie_r[q]; first_child:=false;
+ end;
+if first_child then trie_l[q]:=0@+else trie_r[q]:=0
+
+@ We must avoid to ``take'' location~1, in order to distinguish between
+|lc_code| values and patterns.
+
+@<Pack all stored |hyph_codes|@>=
+begin if trie_root=0 then for p:=0 to 255 do trie_min[p]:=p+2;
+first_fit(hyph_root); trie_pack(hyph_root);
+hyph_start:=trie_ref[hyph_root];
+end
+
+@ The global variable |hyph_index| will point to the hyphenation codes
+for the current language.
+
+@d set_hyph_index== {set |hyph_index| for current language}
+ if trie_char(hyph_start+cur_lang)<>qi(cur_lang)
+ then hyph_index:=0 {no hyphenation codes for |cur_lang|}
+ else hyph_index:=trie_link(hyph_start+cur_lang)
+@#
+@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
+ if hyph_index=0 then hc[0]:=lc_code(#)
+ else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0
+ else hc[0]:=qo(trie_op(hyph_index+#))
+
+@<Glob...@>=
+@!hyph_start:trie_pointer; {root of the packed trie for |hyph_codes|}
+@!hyph_index:trie_pointer; {pointer to hyphenation codes for |cur_lang|}
+
+@ When |saving_vdiscards| is positive then the glue, kern, and penalty
+nodes removed by the page builder or by \.{\\vsplit} from the top of a
+vertical list are saved in special lists instead of being discarded.
+
+@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder}
+@d page_disc==disc_ptr[last_box_code] {first item removed by page builder}
+@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}}
+
+@<Glob...@>=
+@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers}
+
+@ @<Set init...@>=
+page_disc:=null; split_disc:=null;
+
+@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
+command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
+distinguished by their |chr_code| values |last_box_code| and
+|vsplit_code|. These |chr_code| values are larger than |box_code| and
+|copy_code|.
+
+@<Generate all \eTeX...@>=
+primitive("pagediscards",un_vbox,last_box_code);@/
+@!@:page_discards_}{\.{\\pagediscards} primitive@>
+primitive("splitdiscards",un_vbox,vsplit_code);@/
+@!@:split_discards_}{\.{\\splitdiscards} primitive@>
+
+@ @<Cases of |un_vbox| for |print_cmd_chr|@>=
+else if chr_code=last_box_code then print_esc("pagediscards")
+else if chr_code=vsplit_code then print_esc("splitdiscards")
+
+@ @<Handle saved items and |goto done|@>=
+begin link(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null;
+goto done;
+end
+
+@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
+and \.{\\displaywidowpenalties} commands allow to define arrays of
+penalty values to be used instead of the corresponding single values.
+
+@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc)
+@d club_penalties_ptr==equiv(club_penalties_loc)
+@d widow_penalties_ptr==equiv(widow_penalties_loc)
+@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc)
+
+@<Generate all \eTeX...@>=
+primitive("interlinepenalties",set_shape,inter_line_penalties_loc);@/
+@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@>
+primitive("clubpenalties",set_shape,club_penalties_loc);@/
+@!@:club_penalties_}{\.{\\clubpenalties} primitive@>
+primitive("widowpenalties",set_shape,widow_penalties_loc);@/
+@!@:widow_penalties_}{\.{\\widowpenalties} primitive@>
+primitive("displaywidowpenalties",set_shape,display_widow_penalties_loc);@/
+@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@>
+
+@ @<Cases of |set_shape| for |print_cmd_chr|@>=
+inter_line_penalties_loc: print_esc("interlinepenalties");
+club_penalties_loc: print_esc("clubpenalties");
+widow_penalties_loc: print_esc("widowpenalties");
+display_widow_penalties_loc: print_esc("displaywidowpenalties");
+
+@ @<Fetch a penalties array element@>=
+begin scan_int;
+if (equiv(m)=null)or(cur_val<0) then cur_val:=0
+else begin if cur_val>penalty(equiv(m)) then cur_val:=penalty(equiv(m));
+ cur_val:=penalty(equiv(m)+cur_val);
+ end;
+end
+
+@* \[54] System-dependent changes.
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/alephdir/om16bit.ch b/Build/source/texk/web2c/alephdir/om16bit.ch
new file mode 100644
index 00000000000..12d8b49d023
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/om16bit.ch
@@ -0,0 +1,2635 @@
+% om16bit.ch: Basic changes to TeX data structures allowing all
+% 8-bit entities to become 32-bit entities, in particular
+% characters and glyphs.
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+@x limbo l.1 - Omega
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+@y
+% This program is copyright
+% (C) 1994--2000 by John Plaice and Yannis Haralambous.
+% It is designed to be a change file for D. E. Knuth's TeX version 3.141592.
+%
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+@z
+%---------------------------------------
+@x limbo l.80
+\def\title{\TeX82}
+@y
+\def\title{$\Omega$ (OMEGA)}
+@z
+%---------------------------------------
+@x [1] m.1 l.90 - Omega
+This is \TeX, a document compiler intended to produce typesetting of high
+quality.
+The \PASCAL\ program that follows is the definition of \TeX82, a standard
+@:PASCAL}{\PASCAL@>
+@!@:TeX82}{\TeX82@>
+@y
+This is $\Omega$, a document compiler intended to simplify high-quality
+typesetting for many of the world's languages. It is an extension
+of D. E. Knuth's \TeX, which was designed essentially for the
+typesetting of languages using the Latin alphabet.
+
+The $\Omega$ system loosens many of the restrictions imposed by~\TeX:
+register numbers are no longer limited to 8~bits; fonts may have more
+than 256~characters; more than 256~fonts may be used; etc. In addition,
+$\Omega$ allows much more complex ligature mechanisms between characters,
+thereby simplifying the typesetting of alphabets that have preserved
+their calligraphic traditions.
+
+The \PASCAL\ program that follows is a modification of the definition of \TeX82,
+a standard @:PASCAL}{\PASCAL@> @!@:TeX82}{\TeX82@>
+@z
+%---------------------------------------
+@x [1] m.1 l.97 - Omega
+will be obtainable on a great variety of computers.
+
+@y
+will be obtainable on a great variety of computers.
+
+As little as possible is changed in this document. This means that
+unless the contrary is explicitly stated, references to \TeX\ in the
+documentation are equally applicable to~$\Omega$. References to `the
+author' in the documentation are to D. E. Knuth.
+
+@z
+%---------------------------------------
+@x [1] m.2 l.187 - Omega
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@y
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@z
+%---------------------------------------
+@x [1] m.4 l.243
+program TEX; {all file names are defined dynamically}
+@y
+program OMEGA; {all file names are defined dynamically}
+@z
+%---------------------------------------
+@x [1] m.11 l.392 - Omega
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@y
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@z
+%---------------------------------------
+@x [1] m.11 l.412 - Omega
+@!pool_name='TeXformats:TEX.POOL ';
+@y
+@!pool_name='TeXformats:OMEGA.POOL ';
+@z
+%---------------------------------------
+@x [1] m.12 l.437 - Omega
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@d biggest_char=65535 {the largest allowed character number;
+ must be |<=max_quarterword|}
+@d too_big_char=65536 {|biggest_char+1|}
+@d special_char=65537 {|biggest_char+2|}
+@d number_chars=65536 {|biggest_char+1|}
+@d biggest_reg=65535 {the largest allowed register number;
+ must be |<=max_quarterword|}
+@d number_regs=65536 {|biggest_reg+1|}
+@d font_biggest=65535 {the real biggest font}
+@d number_fonts=font_biggest-font_base+2
+@d number_math_fonts=768
+@d math_font_biggest=767
+@d text_size=0 {size code for the largest size in a family}
+@d script_size=256 {size code for the medium size in a family}
+@d script_script_size=512 {size code for the smallest size in a family}
+@d biggest_lang=255
+@d too_big_lang=256
+@z
+%---------------------------------------
+@x [8] m.110 l.2355 - Omega
+In order to make efficient use of storage space, \TeX\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a (signed) |glue_ratio|, or a small number of
+fields that are one half or one quarter of the size used for storing
+integers.
+
+@y
+In order to make efficient use of storage space, \TeX\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a (signed) |glue_ratio|, or a small number of
+fields that are one half or one quarter of the size used for storing
+integers.
+
+That is the description for \TeX. For $\Omega$, we are going to keep
+the same terminology, except that |quarterword| is going to refer to
+16~bits, and |halfword| is going to refer to 32~bits. So, in fact,
+a |memory_word| will take 64 bits, and, on a 64-bit machine, will run
+smaller than \TeX\ will!
+
+@z
+%---------------------------------------
+@x [8] m.110 l.2378 - Omega
+Since we are assuming 32-bit integers, a halfword must contain at least
+16 bits, and a quarterword must contain at least 8 bits.
+@^system dependencies@>
+But it doesn't hurt to have more bits; for example, with enough 36-bit
+words you might be able to have |mem_max| as large as 262142, which is
+eight times as much memory as anybody had during the first four years of
+\TeX's existence.
+
+N.B.: Valuable memory space will be dreadfully wasted unless \TeX\ is compiled
+by a \PASCAL\ that packs all of the |memory_word| variants into
+the space of a single integer. This means, for example, that |glue_ratio|
+words should be |short_real| instead of |real| on some computers. Some
+\PASCAL\ compilers will pack an integer whose subrange is `|0..255|' into
+an eight-bit field, but others insist on allocating space for an additional
+sign bit; on such systems you can get 256 values into a quarterword only
+if the subrange is `|-128..127|'.
+
+@y
+@z
+%---------------------------------------
+@x [8] m.110 l.2406 - Omega
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y
+@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|}
+@d min_halfword=0 {smallest allowable value in a |halfword|}
+@d max_halfword=@"3FFFFFFF {largest allowable value in a |halfword|}
+@z
+%---------------------------------------
+@x [8] m.111 l.2416 - Omega
+if (min_quarterword>0)or(max_quarterword<127) then bad:=11;
+if (min_halfword>0)or(max_halfword<32767) then bad:=12;
+@y
+if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11;
+if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12;
+@z
+%---------------------------------------
+@x [8] m.111 l.2423 - Omega
+if font_max>font_base+256 then bad:=16;
+@y
+if font_max>font_base+@"10000 then bad:=16;
+@z
+%---------------------------------------
+@x [8] m.111 l.2426 - Omega
+if max_quarterword-min_quarterword<255 then bad:=19;
+@y
+if max_quarterword-min_quarterword<@"FFFF then bad:=19;
+@z
+%---------------------------------------
+@x [10] m.134 l.2832 - Omega
+Note that the format of a |char_node| allows for up to 256 different
+fonts and up to 256 characters per font; but most implementations will
+probably limit the total number of fonts to fewer than 75 per job,
+and most fonts will stick to characters whose codes are
+less than 128 (since higher codes
+are more difficult to access on most keyboards).
+
+Extensions of \TeX\ intended for oriental languages will need even more
+than $256\times256$ possible characters, when we consider different sizes
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+and styles of type. It is suggested that Chinese and Japanese fonts be
+handled by representing such characters in two consecutive |char_node|
+entries: The first of these has |font=font_base|, and its |link| points
+to the second;
+the second identifies the font and the character dimensions.
+The saving feature about oriental characters is that most of them have
+the same box dimensions. The |character| field of the first |char_node|
+is a ``\\{charext}'' that distinguishes between graphic symbols whose
+dimensions are identical for typesetting purposes. (See the \MF\ manual.)
+Such an extension of \TeX\ would not be difficult; further details are
+left to the reader.
+@y
+Note that the format of a |char_node| allows for up to 65536 different
+fonts and up to 65536 characters per font.
+@z
+%---------------------------------------
+@x [15] m.208 l.4127 - Omega
+@d min_internal=68 {the smallest code that can follow \.{\\the}}
+@d char_given=68 {character code defined by \.{\\chardef}}
+@d math_given=69 {math code defined by \.{\\mathchardef}}
+@d last_item=70 {most recent item ( \.{\\lastpenalty},
+ \.{\\lastkern}, \.{\\lastskip} )}
+@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}}
+@y
+@d min_internal=end_cs_name+1 {the smallest code that can follow \.{\\the}}
+@d char_given=min_internal {character code defined by \.{\\chardef}}
+@d math_given=char_given+1 {math code defined by \.{\\mathchardef}}
+@d omath_given=math_given+1 {math code defined by \.{\\omathchardef}}
+@d last_item=omath_given+1 {most recent item ( \.{\\lastpenalty},
+ \.{\\lastkern}, \.{\\lastskip} )}
+@d max_non_prefixed_command=last_item
+ {largest command code that can't be \.{\\global}}
+@z
+%---------------------------------------
+@x [15] m.209 l.4138 - Omega
+@d toks_register=71 {token list register ( \.{\\toks} )}
+@d assign_toks=72 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
+@d assign_int=73 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
+@d assign_dimen=74 {user-defined length ( \.{\\hsize}, etc.~)}
+@d assign_glue=75 {user-defined glue ( \.{\\baselineskip}, etc.~)}
+@d assign_mu_glue=76 {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
+@d assign_font_dimen=77 {user-defined font dimension ( \.{\\fontdimen} )}
+@d assign_font_int=78 {user-defined font integer ( \.{\\hyphenchar},
+ \.{\\skewchar} )}
+@d set_aux=79 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
+@d set_prev_graf=80 {specify state info ( \.{\\prevgraf} )}
+@d set_page_dimen=81 {specify state info ( \.{\\pagegoal}, etc.~)}
+@d set_page_int=82 {specify state info ( \.{\\deadcycles},
+ \.{\\insertpenalties} )}
+@d set_box_dimen=83 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
+@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
+@d def_code=85 {define a character code ( \.{\\catcode}, etc.~)}
+@d def_family=86 {declare math fonts ( \.{\\textfont}, etc.~)}
+@d set_font=87 {set current font ( font identifiers )}
+@d def_font=88 {define a font file ( \.{\\font} )}
+@d register=89 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d max_internal=89 {the largest code that can follow \.{\\the}}
+@d advance=90 {advance a register or parameter ( \.{\\advance} )}
+@d multiply=91 {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=92 {divide a register or parameter ( \.{\\divide} )}
+@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=94 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
+@d def=97 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=98 {set a box ( \.{\\setbox} )}
+@d hyph_data=99 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d max_command=100 {the largest command code seen at |big_switch|}
+@y
+@d toks_register=max_non_prefixed_command+1
+ {token list register ( \.{\\toks} )}
+@d assign_toks=toks_register+1
+ {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
+@d assign_int=assign_toks+1
+ {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
+@d assign_dimen=assign_int+1
+ {user-defined length ( \.{\\hsize}, etc.~)}
+@d assign_glue=assign_dimen+1
+ {user-defined glue ( \.{\\baselineskip}, etc.~)}
+@d assign_mu_glue=assign_glue+1
+ {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
+@d assign_font_dimen=assign_mu_glue+1
+ {user-defined font dimension ( \.{\\fontdimen} )}
+@d assign_font_int=assign_font_dimen+1
+ {user-defined font integer ( \.{\\hyphenchar}, \.{\\skewchar} )}
+@d set_aux=assign_font_int+1
+ {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
+@d set_prev_graf=set_aux+1
+ {specify state info ( \.{\\prevgraf} )}
+@d set_page_dimen=set_prev_graf+1
+ {specify state info ( \.{\\pagegoal}, etc.~)}
+@d set_page_int=set_page_dimen+1
+ {specify state info ( \.{\\deadcycles},
+ \.{\\insertpenalties} )}
+@d set_box_dimen=set_page_int+1
+ {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
+@d set_shape=set_box_dimen+1
+ {specify fancy paragraph shape ( \.{\\parshape} )}
+@d def_code=set_shape+1
+ {define a character code ( \.{\\catcode}, etc.~)}
+@d def_family=def_code+1
+ {declare math fonts ( \.{\\textfont}, etc.~)}
+@d set_font=def_family+1
+ {set current font ( font identifiers )}
+@d def_font=set_font+1
+ {define a font file ( \.{\\font} )}
+@d register=def_font+1
+ {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d max_internal=register
+ {the largest code that can follow \.{\\the}}
+@d advance=max_internal+1
+ {advance a register or parameter ( \.{\\advance} )}
+@d multiply=advance+1
+ {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=multiply+1
+ {divide a register or parameter ( \.{\\divide} )}
+@d prefix=divide+1
+ {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=prefix+1
+ {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=let+1
+ {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@d read_to_cs=shorthand_def+1
+ {read into a control sequence ( \.{\\read} )}
+@d def=read_to_cs+1
+ {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=def+1
+ {set a box ( \.{\\setbox} )}
+@d hyph_data=set_box+1
+ {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=hyph_data+1
+ {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d max_command=set_interaction
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.220 l.4486 - Omega
+@d eq_level(#)==eq_level_field(eqtb[#]) {level of definition}
+@d eq_type(#)==eq_type_field(eqtb[#]) {command code for equivalent}
+@d equiv(#)==equiv_field(eqtb[#]) {equivalent value}
+@y
+@d eq_level(#)==new_eq_level(#) {level of definition}
+@d eq_type(#)==new_eq_type(#) {command code for equivalent}
+@d equiv(#)==new_equiv(#) {equivalent value}
+@d equiv1(#)==new_equiv1(#) {equivalent value}
+@z
+%---------------------------------------
+@x [17] m.222 l.4496 - Omega
+In the first region we have 256 equivalents for ``active characters'' that
+act as control sequences, followed by 256 equivalents for single-character
+control sequences.
+@y
+In the first region we have |number_chars| equivalents for ``active characters''
+that act as control sequences, followed by |number_chars| equivalents for
+single-character control sequences.
+@z
+%---------------------------------------
+@x [17] m.222 l.4507 - Omega
+@d single_base=active_base+256 {equivalents of one-character control sequences}
+@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}}
+@y
+@d single_base=active_base+number_chars
+ {equivalents of one-character control sequences}
+@d null_cs=single_base+number_chars {equivalent of \.{\\csname\\endcsname}}
+@z
+%---------------------------------------
+@x [17] m.222 l.4530 - Omega
+eq_type(undefined_control_sequence):=undefined_cs;
+equiv(undefined_control_sequence):=null;
+eq_level(undefined_control_sequence):=level_zero;
+for k:=active_base to undefined_control_sequence-1 do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+@y
+set_eq_type(undefined_control_sequence,undefined_cs);
+set_equiv(undefined_control_sequence,null);
+set_eq_level(undefined_control_sequence,level_zero);
+@z
+%---------------------------------------
+@x [17] m.224 l.4547 - Omega
+@ Region 3 of |eqtb| contains the 256 \.{\\skip} registers, as well as the
+glue parameters defined here. It is important that the ``muskip''
+parameters have larger numbers than the others.
+@y
+@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers,
+as well as the glue parameters defined here. It is important that the
+``muskip'' parameters have larger numbers than the others.
+@z
+%---------------------------------------
+@x [17] m.224 l.4572 - Omega
+@d skip_base=glue_base+glue_pars {table of 256 ``skip'' registers}
+@d mu_skip_base=skip_base+256 {table of 256 ``muskip'' registers}
+@d local_base=mu_skip_base+256 {beginning of region 4}
+@y
+@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers}
+@d mu_skip_base=skip_base+number_regs
+ {table of |number_regs| ``muskip'' registers}
+@d local_base=mu_skip_base+number_regs {beginning of region 4}
+@z
+%---------------------------------------
+@x [17] m.228 l.4685 - Omega
+equiv(glue_base):=zero_glue; eq_level(glue_base):=level_one;
+eq_type(glue_base):=glue_ref;
+for k:=glue_base+1 to local_base-1 do eqtb[k]:=eqtb[glue_base];
+@y
+set_equiv(glue_base,zero_glue); set_eq_level(glue_base,level_one);
+set_eq_type(glue_base,glue_ref);
+@z
+%---------------------------------------
+@x [17] m.230 l.4721 - Omega
+@d toks_base=local_base+10 {table of 256 token list registers}
+@d box_base=toks_base+256 {table of 256 box registers}
+@d cur_font_loc=box_base+256 {internal font number outside math mode}
+@d math_font_base=cur_font_loc+1 {table of 48 math font numbers}
+@d cat_code_base=math_font_base+48
+ {table of 256 command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings}
+@d uc_code_base=lc_code_base+256 {table of 256 uppercase mappings}
+@d sf_code_base=uc_code_base+256 {table of 256 spacefactor mappings}
+@d math_code_base=sf_code_base+256 {table of 256 math mode mappings}
+@d int_base=math_code_base+256 {beginning of region 5}
+@y
+@d toks_base=local_base+10 {table of |number_regs| token list registers}
+@d box_base=toks_base+number_regs {table of |number_regs| box registers}
+@d cur_font_loc=box_base+number_regs {internal font number outside math mode}
+@d math_font_base=cur_font_loc+1
+ {table of |number_math_fonts| math font numbers}
+@d cat_code_base=math_font_base+number_math_fonts
+ {table of |number_chars| command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+number_chars
+ {table of |number_chars| lowercase mappings}
+@d uc_code_base=lc_code_base+number_chars
+ {table of |number_chars| uppercase mappings}
+@d sf_code_base=uc_code_base+number_chars
+ {table of |number_chars| spacefactor mappings}
+@d math_code_base=sf_code_base+number_chars
+ {table of |number_chars| math mode mappings}
+@d int_base=math_code_base+number_chars {beginning of region 5}
+@z
+%---------------------------------------
+@x [17] m.232 l.4802 - Omega
+@d var_code==@'70000 {math code meaning ``use the current family''}
+
+@<Initialize table entries...@>=
+par_shape_ptr:=null; eq_type(par_shape_loc):=shape_ref;
+eq_level(par_shape_loc):=level_one;@/
+for k:=output_routine_loc to toks_base+255 do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+box(0):=null; eq_type(box_base):=box_ref; eq_level(box_base):=level_one;
+for k:=box_base+1 to box_base+255 do eqtb[k]:=eqtb[box_base];
+cur_font:=null_font; eq_type(cur_font_loc):=data;
+eq_level(cur_font_loc):=level_one;@/
+for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc];
+equiv(cat_code_base):=0; eq_type(cat_code_base):=data;
+eq_level(cat_code_base):=level_one;@/
+for k:=cat_code_base+1 to int_base-1 do eqtb[k]:=eqtb[cat_code_base];
+for k:=0 to 255 do
+ begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000;
+ end;
+cat_code(carriage_return):=car_ret; cat_code(" "):=spacer;
+cat_code("\"):=escape; cat_code("%"):=comment;
+cat_code(invalid_code):=invalid_char; cat_code(null_code):=ignore;
+for k:="0" to "9" do math_code(k):=hi(k+var_code);
+for k:="A" to "Z" do
+ begin cat_code(k):=letter; cat_code(k+"a"-"A"):=letter;@/
+ math_code(k):=hi(k+var_code+@"100);
+ math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/
+ lc_code(k):=k+"a"-"A"; lc_code(k+"a"-"A"):=k+"a"-"A";@/
+ uc_code(k):=k; uc_code(k+"a"-"A"):=k;@/
+ sf_code(k):=999;
+ end;
+@y
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+
+@<Initialize table entries...@>=
+set_equiv(par_shape_loc,null); set_eq_type(par_shape_loc,shape_ref);
+set_eq_level(par_shape_loc,level_one);@/
+set_equiv(cat_code_base+carriage_return,car_ret);
+set_equiv(cat_code_base+" ",spacer);
+set_equiv(cat_code_base+"\",escape);
+set_equiv(cat_code_base+"%",comment);
+set_equiv(cat_code_base+invalid_code,invalid_char);
+set_equiv(cat_code_base+null_code,ignore);
+for k:="0" to "9" do set_equiv(math_code_base+k,hi(k+var_code));
+for k:="A" to "Z" do
+ begin set_equiv(cat_code_base+k,letter);
+ set_equiv(cat_code_base+k+"a"-"A",letter);@/
+ set_equiv(math_code_base+k,hi(k+var_code+@"10000));
+ set_equiv(math_code_base+k+"a"-"A",hi(k+"a"-"A"+var_code+@"10000));@/
+ set_equiv(lc_code_base+k,k+"a"-"A");
+ set_equiv(lc_code_base+k+"a"-"A",k+"a"-"A");@/
+ set_equiv(uc_code_base+k,k);
+ set_equiv(uc_code_base+k+"a"-"A",k);@/
+ set_equiv(sf_code_base+k,999);
+ end;
+@z
+%---------------------------------------
+@x [17] m.234 l.4857 - Omega
+@ @<Show the font identifier in |eqtb[n]|@>=
+begin if n=cur_font_loc then print("current font")
+else if n<math_font_base+16 then
+ begin print_esc("textfont"); print_int(n-math_font_base);
+ end
+else if n<math_font_base+32 then
+ begin print_esc("scriptfont"); print_int(n-math_font_base-16);
+ end
+else begin print_esc("scriptscriptfont"); print_int(n-math_font_base-32);
+ end;
+print_char("=");@/
+print_esc(hash[font_id_base+equiv(n)].rh);
+ {that's |font_id_text(equiv(n))|}
+@y
+@ @<Show the font identifier in |eqtb[n]|@>=
+begin if n=cur_font_loc then print("current font")
+else if n<math_font_base+script_size then
+ begin print_esc("textfont"); print_int(n-math_font_base);
+ end
+else if n<math_font_base+script_script_size then
+ begin print_esc("scriptfont"); print_int(n-math_font_base-script_size);
+ end
+else begin print_esc("scriptscriptfont");
+ print_int(n-math_font_base-script_script_size);
+ end;
+print_char("=");@/
+print_esc(newtext(font_id_base+equiv(n)));
+ {that's |font_id_text(equiv(n))|}
+@z
+%---------------------------------------
+@x [17] m.236 l.4955 - Omega
+@d count_base=int_base+int_pars {256 user \.{\\count} registers}
+@d del_code_base=count_base+256 {256 delimiter code mappings}
+@d dimen_base=del_code_base+256 {beginning of region 6}
+@#
+@d del_code(#)==eqtb[del_code_base+#].int
+@d count(#)==eqtb[count_base+#].int
+@d int_par(#)==eqtb[int_base+#].int {an integer parameter}
+@y
+@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers}
+@d del_code_base=count_base+number_regs {|number_chars| delimiter code mappings}
+@d dimen_base=del_code_base+number_chars {beginning of region 6}
+@#
+@d del_code0(#)==new_equiv(del_code_base+#)
+@d del_code1(#)==new_equiv1(del_code_base+#)
+@d count(#)==new_eqtb_int(count_base+#)
+@d int_par(#)==new_eqtb_int(int_base+#) {an integer parameter}
+@z
+%---------------------------------------
+@x [17] m.240 l.5213 - Omega
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
+escape_char:="\"; end_line_char:=carriage_return;
+for k:=0 to 255 do del_code(k):=-1;
+del_code("."):=0; {this null delimiter is used in error recovery}
+@y
+set_new_eqtb_int(int_base+mag_code,1000);
+set_new_eqtb_int(int_base+tolerance_code,10000);
+set_new_eqtb_int(int_base+hang_after_code,1);
+set_new_eqtb_int(int_base+max_dead_cycles_code,25);
+set_new_eqtb_int(int_base+escape_char_code,"\");
+set_new_eqtb_int(int_base+end_line_char_code,carriage_return);
+set_equiv(del_code_base+".",0);
+set_equiv1(del_code_base+".",0);
+ {this null delimiter is used in error recovery}
+
+@ @<Set newline character to -1@>=
+set_new_eqtb_int(int_base+new_line_char_code,-1)
+
+@ @<Set newline character to nl@>=
+set_new_eqtb_int(int_base+new_line_char_code,nl)
+
+@z
+%---------------------------------------
+@x [17] m.242 l.5240 - Omega
+print_char("="); print_int(eqtb[n].int);
+@y
+print_char("="); print_int(new_eqtb_int(n));
+@z
+%---------------------------------------
+@x [17] m.247 l.5273 - Omega
+here, and the 256 \.{\\dimen} registers.
+@y
+here, and the |number_regs| \.{\\dimen} registers.
+@z
+%---------------------------------------
+@x [17] m.247 l.5298 - Omega
+ {table of 256 user-defined \.{\\dimen} registers}
+@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|}
+@#
+@d dimen(#)==eqtb[scaled_base+#].sc
+@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity}
+@y
+ {table of |number_regs| user-defined \.{\\dimen} registers}
+@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|}
+@#
+@d dimen(#)==new_eqtb_sc(scaled_base+(#))
+@d dimen_par(#)==new_eqtb_sc(dimen_base+(#)) {a scaled quantity}
+@z
+%---------------------------------------
+@x [17] m.250 l.5405 - Omega
+for k:=dimen_base to eqtb_size do eqtb[k].sc:=0;
+@y
+
+@ @p function init_eqtb_entry (p:pointer):memory_word;
+var mw:memory_word;
+begin
+ { Regions 1 and 2 }
+ if (p>=active_base) and
+ (p<=undefined_control_sequence) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+ { Region 3 }
+ else if (p>=glue_base) and
+ (p<=local_base+1) then begin
+ equiv_field(mw):=zero_glue;
+ eq_type_field(mw):=glue_ref;
+ eq_level_field(mw):=level_one;
+ end
+ { Region 4 }
+ else if (p>=par_shape_loc) and
+ (p<=toks_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+ else if (p>=box_base) and
+ (p<=box_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=box_ref;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=cur_font_loc) and
+ (p<=math_font_base+math_font_biggest) then begin
+ equiv_field(mw):=null_font;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=cat_code_base) and
+ (p<=cat_code_base+biggest_char) then begin
+ equiv_field(mw):=other_char;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=lc_code_base) and
+ (p<=uc_code_base+biggest_char) then begin
+ equiv_field(mw):=0;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=sf_code_base) and
+ (p<=sf_code_base+biggest_char) then begin
+ equiv_field(mw):=1000;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=math_code_base) and
+ (p<=math_code_base+biggest_char) then begin
+ equiv_field(mw):=hi(p-math_code_base);
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ { Region 5 }
+ else if (p>=int_base) and (p<=del_code_base-1) then begin
+ setintzero(mw,0);
+ setintone(mw,0);
+ end
+ else if (p>=del_code_base) and (p<=del_code_base+biggest_char) then begin
+ setintzero(mw,-1);
+ setintone(mw,-1);
+ end
+ { Region 6 }
+ else if (p>=dimen_base) and (p<=eqtb_size) then begin
+ setintzero(mw,0);
+ setintone(mw,0);
+ end
+ else begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end;
+ init_eqtb_entry:=mw;
+end;
+
+@z
+%---------------------------------------
+@x [17] m.251 l.5411 - Omega
+print_char("="); print_scaled(eqtb[n].sc); print("pt");
+@y
+print_char("="); print_scaled(new_eqtb_sc(n)); print("pt");
+@z
+%---------------------------------------
+@x [17] m.254 l.5435 - Omega
+@ The last two regions of |eqtb| have fullword values instead of the
+three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary,
+but \TeX\ needs to store the |eq_level| information in another array
+called |xeq_level|.
+
+@<Glob...@>=
+@!eqtb:array[active_base..eqtb_size] of memory_word;
+@!xeq_level:array[int_base..eqtb_size] of quarterword;
+@y
+@ The last two regions of |eqtb| have fullword values instead of the
+three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary,
+but \TeX\ needs to store the |eq_level| information in another array
+called |xeq_level|.
+
+@d xeq_level(#) == new_xeq_level(eqtb_size+eqtb_size+#)
+@d set_xeq_level(#) == set_new_eqtb_int(eqtb_size+eqtb_size+#)
+@z
+%---------------------------------------
+@x [17] m.255 l.5439 - Omega
+for k:=int_base to eqtb_size do xeq_level[k]:=level_one;
+@y
+@z
+%---------------------------------------
+@x [17] m.255 l.5446 - Omega
+for q:=active_base to box_base+255 do
+@y
+for q:=active_base to box_base+biggest_reg do
+@z
+%---------------------------------------
+@x [18] m.256 l.5477 - Omega
+@d next(#) == hash[#].lh {link for coalesced lists}
+@d text(#) == hash[#].rh {string number for control sequence name}
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name}
+
+@<Glob...@>=
+@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
+ {the hash table}
+@y
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@d newtext(#) == new_hash_text(eqtb_size+#)
+@d newnext(#) == new_hash_next(eqtb_size+#)
+@d settext(#) == set_hash_text(eqtb_size+#)
+@d setnext(#) == set_hash_next(eqtb_size+#)
+
+@<Glob...@>=
+@z
+%---------------------------------------
+@x [18] m.257 l.5491 - Omega
+next(hash_base):=0; text(hash_base):=0;
+for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base];
+@y
+@z
+%---------------------------------------
+@x [18] m.258 l.5497 - Omega
+hash_used:=frozen_control_sequence; {nothing is used}
+cs_count:=0;
+eq_type(frozen_dont_expand):=dont_expand;
+text(frozen_dont_expand):="notexpanded:";
+@y
+hash_used:=frozen_control_sequence; {nothing is used}
+cs_count:=0;
+set_eq_type(frozen_dont_expand,dont_expand);
+settext(frozen_dont_expand,"notexpanded:");
+@z
+%---------------------------------------
+@x [18] m.259 l.5514 - Omega
+@!k:pointer; {index in |buffer| array}
+begin @<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+begin if text(p)>0 then if length(text(p))=l then
+ if str_eq_buf(text(p),j) then goto found;
+ if next(p)=0 then
+ begin if no_new_control_sequence then
+ p:=undefined_control_sequence
+ else @<Insert a new control sequence after |p|, then make
+ |p| point to it@>;
+ goto found;
+ end;
+ p:=next(p);
+ end;
+found: id_lookup:=p;
+@y
+@!k:pointer; {index in |buffer| array}
+@!newstring:integer;
+begin @<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+begin if newtext(p)>0 then if length(newtext(p))=l then
+ if str_eq_buf(newtext(p),j) then goto found;
+ if newnext(p)=0 then
+ begin if no_new_control_sequence then
+ p:=undefined_control_sequence
+ else @<Insert a new control sequence after |p|, then make
+ |p| point to it@>;
+ goto found;
+ end;
+ p:=newnext(p);
+ end;
+found: id_lookup:=p;
+@z
+%---------------------------------------
+@x [18] m.260 l.5532 - Omega
+begin if text(p)>0 then
+ begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until text(hash_used)=0; {search for an empty location in |hash|}
+ next(p):=hash_used; p:=hash_used;
+ end;
+str_room(l); d:=cur_length;
+while pool_ptr>str_start[str_ptr] do
+ begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr];
+ end; {move current string up to make room for another}
+for k:=j to j+l-1 do append_char(buffer[k]);
+text(p):=make_string; pool_ptr:=pool_ptr+d;
+@y
+begin if newtext(p)>0 then
+ begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until newtext(hash_used)=0; {search for an empty location in |hash|}
+ setnext(p,hash_used); p:=hash_used;
+ end;
+str_room(l); d:=cur_length;
+while pool_ptr>str_start[str_ptr] do
+ begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr];
+ end; {move current string up to make room for another}
+for k:=j to j+l-1 do append_char(buffer[k]);
+newstring:=make_string;
+settext(p,newstring); pool_ptr:=pool_ptr+d;
+@z
+%---------------------------------------
+@x [18] m.262 l.5584 - Omega
+else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@.NONEXISTENT@>
+else begin print_esc(text(p));
+@y
+else if (newtext(p)<0)or(newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@.NONEXISTENT@>
+else begin print_esc(newtext(p));
+@z
+%---------------------------------------
+@x [18] m.263 l.5601 - Omega
+else print_esc(text(p));
+@y
+else print_esc(newtext(p));
+@z
+%---------------------------------------
+@x [18] m.264 l.5610 - Omega
+@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
+var k:pool_pointer; {index into |str_pool|}
+@!j:small_number; {index into |buffer|}
+@!l:small_number; {length of the string}
+begin if s<256 then cur_val:=s+single_base
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+ flush_string; text(cur_val):=s; {we don't want to have the string twice}
+ end;
+eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o;
+@y
+@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
+var k:pool_pointer; {index into |str_pool|}
+@!j:small_number; {index into |buffer|}
+@!l:small_number; {length of the string}
+begin if s<=biggest_char then cur_val:=s+single_base
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+ flush_string; settext(cur_val,s); {we don't want to have the string twice}
+ end;
+set_eq_level(cur_val,level_one); set_eq_type(cur_val,c);
+set_equiv(cur_val,o);
+@z
+%---------------------------------------
+@x [18] m.265 l.5648 - Omega
+primitive("delimiter",delim_num,0);@/
+@!@:delimiter_}{\.{\\delimiter} primitive@>
+@y
+primitive("delimiter",delim_num,0);@/
+@!@:delimiter_}{\.{\\delimiter} primitive@>
+primitive("odelimiter",delim_num,1);@/
+@!@:delimiter_}{\.{\\odelimiter} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5656 - Omega
+text(frozen_end_group):="endgroup"; eqtb[frozen_end_group]:=eqtb[cur_val];@/
+@y
+settext(frozen_end_group,"endgroup");
+set_new_eqtb(frozen_end_group,new_eqtb(cur_val));@/
+@z
+%---------------------------------------
+@x [18] m.265 l.5673 - Omega
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("mathchar",math_char_num,0);@/
+@!@:math_char_}{\.{\\mathchar} primitive@>
+@y
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("mathchar",math_char_num,0);@/
+@!@:math_char_}{\.{\\mathchar} primitive@>
+primitive("omathaccent",math_accent,1);@/
+@!@:math_accent_}{\.{\\omathaccent} primitive@>
+primitive("omathchar",math_char_num,1);@/
+@!@:math_char_}{\.{\\omathchar} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5697 - Omega
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+@y
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+primitive("oradical",radical,1);@/
+@!@:radical_}{\.{\\oradical} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5701 - Omega
+primitive("relax",relax,256); {cf.\ |scan_file_name|}
+@!@:relax_}{\.{\\relax} primitive@>
+text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/
+@y
+primitive("relax",relax,too_big_char); {cf.\ |scan_file_name|}
+@!@:relax_}{\.{\\relax} primitive@>
+settext(frozen_relax,"relax");
+set_new_eqtb(frozen_relax,new_eqtb(cur_val));@/
+@z
+%---------------------------------------
+@x [19] m.276 l.5951 - Omega
+else begin save_stack[save_ptr]:=eqtb[p]; incr(save_ptr);
+@y
+else begin save_stack[save_ptr]:=new_eqtb(p); incr(save_ptr);
+@z
+%---------------------------------------
+@x [19] m.277 l.5967 - Omega
+begin if eq_level(p)=cur_level then eq_destroy(eqtb[p])
+else if cur_level>level_one then eq_save(p,eq_level(p));
+eq_level(p):=cur_level; eq_type(p):=t; equiv(p):=e;
+@y
+begin if eq_level(p)=cur_level then eq_destroy(new_eqtb(p))
+else if cur_level>level_one then eq_save(p,eq_level(p));
+set_eq_level(p,cur_level); set_eq_type(p,t); set_equiv(p,e);
+@z
+%---------------------------------------
+@x [19] m.278 l.5980 - Omega
+@p procedure eq_word_define(@!p:pointer;@!w:integer);
+begin if xeq_level[p]<>cur_level then
+ begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level;
+ end;
+eqtb[p].int:=w;
+end;
+@y
+@p procedure eq_word_define(@!p:pointer;@!w:integer);
+begin if xeq_level(p)<>cur_level then
+ begin eq_save(p,xeq_level(p)); set_xeq_level(p,cur_level);
+ end;
+set_new_eqtb_int(p,w);
+end;
+
+procedure del_eq_word_define(@!p:pointer;@!w,wone:integer);
+begin if xeq_level(p)<>cur_level then
+ begin eq_save(p,xeq_level(p)); set_xeq_level(p,cur_level);
+ end;
+set_equiv(p,w); set_equiv1(p,wone);
+end;
+
+@z
+%---------------------------------------
+@x [19] m.279 l.5990 - Omega
+begin eq_destroy(eqtb[p]);
+eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
+end;
+@#
+procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
+begin eqtb[p].int:=w; xeq_level[p]:=level_one;
+end;
+@y
+begin eq_destroy(new_eqtb(p));
+set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e);
+end;
+@#
+procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
+begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one);
+end;
+
+procedure del_geq_word_define(@!p:pointer;@!w,wone:integer);
+ {global |del_eq_word_define|}
+begin set_equiv(p,w); set_equiv1(p,wone); set_xeq_level(p,level_one);
+end;
+@z
+%---------------------------------------
+@x [19] m.282 l.6036 - Omega
+ else save_stack[save_ptr]:=eqtb[undefined_control_sequence];
+@y
+ else save_stack[save_ptr]:=new_eqtb(undefined_control_sequence);
+@z
+%---------------------------------------
+@x [19] m.283 l.6056 - Omega
+ else begin eq_destroy(eqtb[p]); {destroy the current value}
+ eqtb[p]:=save_stack[save_ptr]; {restore the saved value}
+ @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+ end
+else if xeq_level[p]<>level_one then
+ begin eqtb[p]:=save_stack[save_ptr]; xeq_level[p]:=l;
+@y
+ else begin eq_destroy(new_eqtb(p)); {destroy the current value}
+ set_new_eqtb(p,save_stack[save_ptr]); {restore the saved value}
+ @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+ end
+else if xeq_level(p)<>level_one then
+ begin set_new_eqtb(p,save_stack[save_ptr]); set_xeq_level(p,l);
+@z
+%---------------------------------------
+@x [20] m.289 l.6129 - Omega
+number $2^8m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{12}-1$@>| is larger than
+@y
+number $2^16m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{20}-1$@>| is larger than
+@z
+%---------------------------------------
+@x [20] m.289 l.6142 - Omega
+@d cs_token_flag==@'7777 {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~256, less~1}
+@d left_brace_token=@'0400 {$2^8\cdot|left_brace|$}
+@d left_brace_limit=@'1000 {$2^8\cdot(|left_brace|+1)$}
+@d right_brace_token=@'1000 {$2^8\cdot|right_brace|$}
+@d right_brace_limit=@'1400 {$2^8\cdot(|right_brace|+1)$}
+@d math_shift_token=@'1400 {$2^8\cdot|math_shift|$}
+@d tab_token=@'2000 {$2^8\cdot|tab_mark|$}
+@d out_param_token=@'2400 {$2^8\cdot|out_param|$}
+@d space_token=@'5040 {$2^8\cdot|spacer|+|" "|$}
+@d letter_token=@'5400 {$2^8\cdot|letter|$}
+@d other_token=@'6000 {$2^8\cdot|other_char|$}
+@d match_token=@'6400 {$2^8\cdot|match|$}
+@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
+@y
+@d cs_token_flag=@"FFFFF {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~65536, less~1}
+@d max_char_val=@"10000 {to separate char and command code}
+@d left_brace_token=@"10000 {$2^16\cdot|left_brace|$}
+@d left_brace_limit=@"20000 {$2^16\cdot(|left_brace|+1)$}
+@d right_brace_token=@"20000 {$2^16\cdot|right_brace|$}
+@d right_brace_limit=@"30000 {$2^16\cdot(|right_brace|+1)$}
+@d math_shift_token=@"30000 {$2^16\cdot|math_shift|$}
+@d tab_token=@"40000 {$2^16\cdot|tab_mark|$}
+@d out_param_token=@"50000 {$2^16\cdot|out_param|$}
+@d space_token=@"A0020 {$2^16\cdot|spacer|+|" "|$}
+@d letter_token=@"B0000 {$2^16\cdot|letter|$}
+@d other_token=@"C0000 {$2^16\cdot|other_char|$}
+@d match_token=@"D0000 {$2^16\cdot|match|$}
+@d end_match_token=@"E0000 {$2^16\cdot|end_match|$}
+@z
+%---------------------------------------
+@x [20] m.293 l.6256 - Omega
+else begin m:=info(p) div @'400; c:=info(p) mod @'400;
+@y
+else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val;
+@z
+%---------------------------------------
+@x [21] m.298 l.6375 - Omega
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@y
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@z
+%---------------------------------------
+@x [24] m.334 l.7110 - Omega
+primitive("par",par_end,256); {cf. |scan_file_name|}
+@y
+primitive("par",par_end,too_big_char); {cf. |scan_file_name|}
+@z
+%---------------------------------------
+@x [24] m.357 l.7462 - Omega
+ else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400;
+@y
+ else begin cur_cmd:=t div max_char_val; cur_chr:=t mod max_char_val;
+@z
+%---------------------------------------
+@x [24] m.358 l.7479 - Omega
+@d no_expand_flag=257 {this characterizes a special variant of |relax|}
+@y
+@d no_expand_flag=special_char {this characterizes a special variant of |relax|}
+@z
+%---------------------------------------
+@x [24] m.365 l.7606 - Omega
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+@z
+%---------------------------------------
+@x [25] m.374 l.7728 - Omega
+ begin eq_define(cur_cs,relax,256); {N.B.: The |save_stack| might change}
+@y
+ begin eq_define(cur_cs,relax,too_big_char);
+ {N.B.: The |save_stack| might change}
+@z
+%---------------------------------------
+@x [25] m.374 l.7750 - Omega
+ buffer[j]:=info(p) mod @'400; incr(j); p:=link(p);
+@y
+ buffer[j]:=info(p) mod max_char_val; incr(j); p:=link(p);
+@z
+%---------------------------------------
+@x [25] m.380 l.7812 - Omega
+done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+done: if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+@z
+%---------------------------------------
+@x [25] m.381 l.7824 - Omega
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+@z
+%---------------------------------------
+@x [25] m.391 l.7985 - Omega
+if (info(r)>match_token+255)or(info(r)<match_token) then s:=null
+@y
+if (info(r)>=end_match_token)or(info(r)<match_token) then s:=null
+@z
+%---------------------------------------
+@x [26] m.407 l.8161 - Omega
+@ The |scan_left_brace| routine is called when a left brace is supposed to be
+the next non-blank token. (The term ``left brace'' means, more precisely,
+a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |left_brace|.
+
+@p procedure scan_left_brace; {reads a mandatory |left_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>left_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A left brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
+ cur_chr:="{"; incr(align_state);
+ end;
+end;
+@y
+@ The |scan_left_brace| routine is called when a left brace is supposed to be
+the next non-blank token. (The term ``left brace'' means, more precisely,
+a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |left_brace|.
+
+@p procedure scan_left_brace; {reads a mandatory |left_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>left_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A left brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
+ cur_chr:="{"; incr(align_state);
+ end;
+end;
+
+@ The |scan_right_brace| routine is called when a right brace is supposed to be
+the next non-blank token. (The term ``right brace'' means, more precisely,
+a character whose catcode is |right_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |right_brace|.
+
+@p procedure scan_right_brace; {reads a mandatory |right_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>right_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A right brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=right_brace_token+"}"; cur_cmd:=right_brace;
+ cur_chr:="}"; incr(align_state);
+ end;
+end;
+@z
+%---------------------------------------
+@x [26] m.410 l.8293 - Omega
+@!cur_val:integer; {value returned by numeric scanners}
+@y
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@z
+%---------------------------------------
+@x [26] m.413 l.8335 - Omega
+assign_int: scanned_result(eqtb[m].int)(int_val);
+assign_dimen: scanned_result(eqtb[m].sc)(dimen_val);
+@y
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_dimen: scanned_result(new_eqtb_sc(m))(dimen_val);
+@z
+%---------------------------------------
+@x [26] m.413 l.8345 - Omega
+char_given,math_given: scanned_result(cur_chr)(int_val);
+@y
+char_given,math_given,omath_given: scanned_result(cur_chr)(int_val);
+@z
+%---------------------------------------
+@x [26] m.414 l.8356 - Omega
+@ @<Fetch a character code from some table@>=
+begin scan_char_num;
+if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val)
+else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else scanned_result(eqtb[m+cur_val].int)(int_val);
+@y
+@ @<Fetch a character code from some table@>=
+begin scan_char_num;
+if m=math_code_base then begin
+ cur_val1:=ho(math_code(cur_val));
+ if ((cur_val1 div @"1000000)>8) or
+ (((cur_val1 mod @"1000000) div @"10000)>15) or
+ ((cur_val1 mod @"10000)>255) then
+ begin print_err("Extended mathchar used as mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and ""7FFF.")@/
+ ("I changed this one to zero."); int_error(cur_val1); cur_val1:=0;
+ end;
+ cur_val1:=((cur_val1 div @"1000000)*@"1000) +
+ (((cur_val1 mod @"1000000) div @"10000)*@"100) +
+ (cur_val1 mod @"10000);
+ scanned_result(cur_val1)(int_val)
+ end
+else if m=(math_code_base+256) then
+ scanned_result(ho(math_code(cur_val)))(int_val)
+else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else scanned_result(new_eqtb_int(m+cur_val))(int_val);
+@z
+%---------------------------------------
+@x [26] m.433 l.8593 - Omega
+procedure scan_eight_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2("A register number must be between 0 and 255.")@/
+@y
+procedure scan_eight_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_reg) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2("A register number must be between 0 and 65535.")@/
+@z
+%---------------------------------------
+@x [26] m.434 l.8604 - Omega
+procedure scan_char_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad character code");
+@.Bad character code@>
+ help2("A character number must be between 0 and 255.")@/
+@y
+procedure scan_char_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_char) then
+ begin print_err("Bad character code");
+@.Bad character code@>
+ help2("A character number must be between 0 and 65535.")@/
+@z
+%---------------------------------------
+@x [26] m.435 l.8618 - Omega
+procedure scan_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>15) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@y
+procedure scan_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>15) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_big_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 255,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@z
+%---------------------------------------
+@x [26] m.436 l.8629 - Omega
+procedure scan_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@y
+procedure scan_real_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+cur_val := ((cur_val div @"1000) * @"1000000) +
+ (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+end;
+
+procedure scan_big_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@"7FFFFFF) then
+ begin print_err("Bad extended mathchar");
+@.Bad mathchar@>
+ help2("An extended mathchar number must be between 0 and ""7FFFFFF.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@z
+%---------------------------------------
+@x [26] m.437 l.8640 - Omega
+procedure scan_twenty_seven_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@y
+procedure scan_twenty_seven_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+cur_val1 := (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+cur_val := cur_val div @"1000;
+cur_val := ((cur_val div @"1000) * @"1000000) +
+ (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+end;
+
+procedure scan_fifty_one_bit_int;
+var iiii:integer;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter (first part) must be between 0 and 2^{27}-1.")
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+iiii:=cur_val;
+scan_int;
+if (cur_val<0)or(cur_val>@"FFFFFF) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+help2("A numeric delimiter (second part) must be between 0 and 2^{24}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+cur_val1:=cur_val;
+cur_val:=iiii;
+end;
+
+procedure scan_string_argument;
+var s:integer;
+begin
+scan_left_brace;
+get_x_token;
+while (cur_cmd<>right_brace) do
+ begin
+ if (cur_cmd=letter) or (cur_cmd=other_char) then begin
+ str_room(1); append_char(cur_chr);
+ end
+ else if (cur_cmd=spacer) then begin
+ str_room(1); append_char(" ");
+ end
+ else begin
+ print("Bad token appearing in string argument");
+ end;
+ get_x_token;
+ end;
+s:=make_string;
+if str_eq_str("mi",s) then s:="mi";
+if str_eq_str("mo",s) then s:="mo";
+if str_eq_str("mn",s) then s:="mn";
+cur_val:=s;
+end;
+@z
+%---------------------------------------
+@x [26] m.442 l.8720 - Omega
+if cur_val>255 then
+ begin print_err("Improper alphabetic constant");
+@y
+if cur_val>biggest_char then
+ begin print_err("Improper alphabetic constant");
+@z
+%---------------------------------------
+@x [27] m.468 l.9200 - Omega
+@d job_name_code=5 {command code for \.{\\jobname}}
+@y
+@d omega_code=5 {command code for \.{\\OmegaVersion}}
+@d job_name_code=6 {command code for \.{\\jobname}}
+@z
+%---------------------------------------
+@x [27] m.468 l.9200 - Omega
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+@y
+primitive("OmegaVersion",convert,omega_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+@z
+%---------------------------------------
+@x [27] m.469 l.9223 - Omega
+ othercases print_esc("jobname")
+@y
+ omega_code: print_esc("OmegaVersion");
+ othercases print_esc("jobname")
+@z
+%---------------------------------------
+@x [27] m.471 l.9248 - Omega
+job_name_code: if job_name=0 then open_log_file;
+@y
+omega_code:;
+job_name_code: if job_name=0 then open_log_file;
+@z
+%---------------------------------------
+@x [27] m.472 l.9258 - Omega
+job_name_code: print(job_name);
+@y
+omega_code: print("1.15");
+job_name_code: print(job_name);
+@z
+%---------------------------------------
+@x [28] m.491 l.9610 - Omega
+text(frozen_fi):="fi"; eqtb[frozen_fi]:=eqtb[cur_val];
+@y
+settext(frozen_fi,"fi"); set_new_eqtb(frozen_fi,new_eqtb(cur_val));
+@z
+%---------------------------------------
+@x [28] m.506 l.9802 - Omega
+if (cur_cmd>active_char)or(cur_chr>255) then {not a character}
+ begin m:=relax; n:=256;
+@y
+if (cur_cmd>active_char)or(cur_chr>biggest_char) then {not a character}
+ begin m:=relax; n:=too_big_char;
+@z
+%---------------------------------------
+@x [28] m.506 l.9808 - Omega
+if (cur_cmd>active_char)or(cur_chr>255) then
+ begin cur_cmd:=relax; cur_chr:=256;
+@y
+if (cur_cmd>active_char)or(cur_chr>biggest_char) then
+ begin cur_cmd:=relax; cur_chr:=too_big_char;
+@z
+%---------------------------------------
+@x [29] m.526 l.10178 - Omega
+loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character}
+@y
+loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then
+ {not a character}
+@z
+%---------------------------------------
+@x [37] m.780 l.15354 - Omega
+@d span_code=256 {distinct from any character}
+@d cr_code=257 {distinct from |span_code| and from any character}
+@y
+@d span_code=special_char {distinct from any character}
+@d cr_code=span_code+1 {distinct from |span_code| and from any character}
+@z
+%---------------------------------------
+@x [37] m.780 l.15364 - Omega
+text(frozen_cr):="cr"; eqtb[frozen_cr]:=eqtb[cur_val];@/
+primitive("crcr",car_ret,cr_cr_code);
+@!@:cr_cr_}{\.{\\crcr} primitive@>
+text(frozen_end_template):="endtemplate"; text(frozen_endv):="endtemplate";
+eq_type(frozen_endv):=endv; equiv(frozen_endv):=null_list;
+eq_level(frozen_endv):=level_one;@/
+eqtb[frozen_end_template]:=eqtb[frozen_endv];
+eq_type(frozen_end_template):=end_template;
+@y
+settext(frozen_cr,"cr");
+set_new_eqtb(frozen_cr,new_eqtb(cur_val));@/
+primitive("crcr",car_ret,cr_cr_code);
+@!@:cr_cr_}{\.{\\crcr} primitive@>
+settext(frozen_end_template,"endtemplate"); settext(frozen_endv,"endtemplate");
+set_eq_type(frozen_endv,endv); set_equiv(frozen_endv,null_list);
+set_eq_level(frozen_endv,level_one);@/
+set_new_eqtb(frozen_end_template,new_eqtb(frozen_endv));
+set_eq_type(frozen_end_template,end_template);
+@z
+%---------------------------------------
+@x [37] m.798 l.15651 - Omega
+if n>max_quarterword then confusion("256 spans"); {this can happen, but won't}
+@^system dependencies@>
+@:this can't happen 256 spans}{\quad 256 spans@>
+@y
+if n>max_quarterword then confusion("too many spans");
+ {this can happen, but won't}
+@^system dependencies@>
+@:this can't happen too many spans}{\quad too many spans@>
+@z
+%---------------------------------------
+@x [37] m.804 l.15794 - Omega
+ overfull_rule:=0; {prevent rule from being packaged}
+ p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save;
+@y
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,0);
+ {prevent rule from being packaged}
+ p:=hpack(preamble,saved(1),saved(0));
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,rule_save);
+@z
+%---------------------------------------
+@x [37] m.827 l.16255 - Omega
+check_shrinkage(left_skip); check_shrinkage(right_skip);@/
+@y
+if (shrink_order(left_skip)<>normal)and(shrink(left_skip)<>0) then
+ begin set_equiv(glue_base+left_skip_code,finite_shrink(left_skip));
+ end;
+if (shrink_order(right_skip)<>normal)and(shrink(right_skip)<>0) then
+ begin set_equiv(glue_base+right_skip_code,finite_shrink(right_skip));
+ end;
+@z
+%---------------------------------------
+@x [40] m.891 l.17434 - Omega
+$c_1$ will be treated as nonletters. The |hyphen_char| for that font
+must be between 0 and 255, otherwise hyphenation will not be attempted.
+@y
+$c_1$ will be treated as nonletters. The |hyphen_char| for that font must
+be between 0 and |biggest_char|, otherwise hyphenation will not be attempted.
+@z
+%---------------------------------------
+@x [40] m.892 l.17469 - Omega
+@!hc:array[0..65] of 0..256; {word to be hyphenated}
+@!hn:small_number; {the number of positions occupied in |hc|}
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@!hf:internal_font_number; {font number of the letters in |hc|}
+@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase}
+@!hyf_char:integer; {hyphen character of the relevant font}
+@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest}
+@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
+@!hyf_bchar:halfword; {boundary character after $c_n$}
+@y
+@!hc:array[0..65] of 0..too_big_char; {word to be hyphenated}
+@!hn:small_number; {the number of positions occupied in |hc|}
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@!hf:internal_font_number; {font number of the letters in |hc|}
+@!hu:array[0..63] of 0..too_big_char;
+ {like |hc|, before conversion to lowercase}
+@!hyf_char:integer; {hyphen character of the relevant font}
+@!cur_lang,@!init_cur_lang:0..biggest_lang;
+ {current hyphenation table of interest}
+@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
+@!hyf_bchar:halfword; {boundary character after $c_n$}
+@!max_hyph_char:integer;
+
+@ @<Set initial values of key variables@>=
+max_hyph_char:=too_big_lang;
+
+@z
+%---------------------------------------
+@x [40] m.893 l.17483 - Omega
+@!c:0..255; {character being considered for hyphenation}
+@y
+@!c:ASCII_code; {character being considered for hyphenation}
+@z
+%---------------------------------------
+@x [40] m.896 l.17534 - Omega
+if hyf_char>255 then goto done1;
+@y
+if hyf_char>biggest_char then goto done1;
+@z
+%---------------------------------------
+@x [40] m.897 l.17546 - Omega
+ if lc_code(c)=0 then goto done3;
+@y
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+@z
+%---------------------------------------
+@x [40] m.898 l.17572 - Omega
+ if lc_code(c)=0 then goto done3;
+@y
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+@z
+%---------------------------------------
+@x [41] m.903 l.17648 - Omega
+ begin hu[0]:=256; init_lig:=false;
+@y
+ begin hu[0]:=max_hyph_char; init_lig:=false;
+@z
+%---------------------------------------
+@x [41] m.903 l.17660 - Omega
+found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null;
+@y
+found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null;
+@z
+%---------------------------------------
+@x [41] m.905 l.17707 - Omega
+getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=256$,
+we consider $x_j$ to be an implicit left boundary character; in this
+case |j| must be strictly less than~|n|. There is a
+parameter |bchar|, which is either 256 or an implicit right boundary character
+@y
+getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=|max_hyph_char|$,
+we consider $x_j$ to be an implicit left boundary character; in this
+case |j| must be strictly less than~|n|. There is a
+parameter |bchar|, which is either |max_hyph_char|
+or an implicit right boundary character
+@z
+%---------------------------------------
+@x [41] m.916 l.17980 - Omega
+ begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256;
+@y
+ begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char;
+@z
+%---------------------------------------
+@x [42] m.921 l.18079 - Omega
+@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language}
+@y
+@!op_start:array[0..biggest_lang] of 0..trie_op_size;
+ {offset for current language}
+@z
+%---------------------------------------
+@x [42] m.923 l.18086 - Omega
+hyphenation algorithm is quite short. In the following code we set |hc[hn+2]|
+to the impossible value 256, in order to guarantee that |hc[hn+3]| will
+@y
+hyphenation algorithm is quite short. In the following code we set |hc[hn+2]| to
+the impossible value |max_hyph_char|, in order to guarantee that |hc[hn+3]| will
+@z
+%---------------------------------------
+@x [42] m.923 l.18095 - Omega
+hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters}
+@y
+hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters}
+@z
+%---------------------------------------
+@x [42] m.934 l.18206 - Omega
+@d set_cur_lang==if language<=0 then cur_lang:=0
+ else if language>255 then cur_lang:=0
+@y
+@d set_cur_lang==if language<=0 then cur_lang:=0
+ else if language>biggest_lang then cur_lang:=0
+@z
+%---------------------------------------
+@x [43] m.943 l.18348 - Omega
+@!trie_used:array[ASCII_code] of quarterword;
+ {largest opcode used so far for this language}
+@!trie_op_lang:array[1..trie_op_size] of ASCII_code;
+@y
+@!trie_used:array[0..biggest_lang] of quarterword;
+ {largest opcode used so far for this language}
+@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang;
+@z
+%---------------------------------------
+@x [43] m.945 l.18400 - Omega
+for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
+@y
+for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
+@z
+%---------------------------------------
+@x [43] m.946 l.18416 - Omega
+for k:=0 to 255 do trie_used[k]:=min_quarterword;
+@y
+for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;
+@z
+%---------------------------------------
+@x [43] m.947 l.18438 - Omega
+@!init @!trie_c:packed array[trie_pointer] of packed_ASCII_code;
+@y
+@!init @!trie_c:packed array[trie_pointer] of ASCII_code;
+@z
+%---------------------------------------
+@x [43] m.952 l.18551 - Omega
+for p:=0 to 255 do trie_min[p]:=p+1;
+@y
+for p:=0 to biggest_char do trie_min[p]:=p+1;
+@z
+%---------------------------------------
+@x [43] m.953 l.18569 - Omega
+@!ll:1..256; {upper limit of |trie_min| updating}
+@y
+@!ll:1..too_big_char; {upper limit of |trie_min| updating}
+@z
+%---------------------------------------
+@x [43] m.953 l.18573 - Omega
+ @<Ensure that |trie_max>=h+256|@>;
+@y
+ @<Ensure that |trie_max>=h+max_hyph_char|@>;
+@z
+%---------------------------------------
+@x [43] m.954 l.18582 - Omega
+@ By making sure that |trie_max| is at least |h+256|, we can be sure that
+|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
+never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
+
+@<Ensure that |trie_max>=h+256|@>=
+if trie_max<h+256 then
+ begin if trie_size<=h+256 then overflow("pattern memory",trie_size);
+@y
+@ By making sure that |trie_max| is at least |h+max_hyph_char|,
+we can be sure that
+|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
+never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
+
+@<Ensure that |trie_max>=h+max_hyph_char|@>=
+if trie_max<h+max_hyph_char then
+ begin if trie_size<=h+max_hyph_char then overflow("pattern memory",trie_size);
+@z
+%---------------------------------------
+@x [43] m.954 l.18592 - Omega
+ until trie_max=h+256;
+@y
+ until trie_max=h+max_hyph_char;
+@z
+%---------------------------------------
+@x [43] m.956 l.18607 - Omega
+if l<256 then
+ begin if z<256 then ll:=z @+else ll:=256;
+@y
+if l<max_hyph_char then
+ begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char;
+@z
+%---------------------------------------
+@x [43] m.958 l.18637 - Omega
+if trie_root=0 then {no patterns were given}
+ begin for r:=0 to 256 do trie[r]:=h;
+ trie_max:=256;
+@y
+if trie_root=0 then {no patterns were given}
+ begin for r:=0 to max_hyph_char do trie[r]:=h;
+ trie_max:=max_hyph_char;
+@z
+%---------------------------------------
+@x [43] m.962 l.18714 - Omega
+@ @<Append a new letter or a hyphen level@>=
+if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
+ begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter}
+ else begin cur_chr:=lc_code(cur_chr);
+ if cur_chr=0 then
+ begin print_err("Nonletter");
+@.Nonletter@>
+ help1("(See Appendix H.)"); error;
+ end;
+ end;
+@y
+@ @<Append a new letter or a hyphen level@>=
+if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
+ begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter}
+ else begin cur_chr:=lc_code(cur_chr);
+ if cur_chr=0 then
+ begin print_err("Nonletter");
+@.Nonletter@>
+ help1("(See Appendix H.)"); error;
+ end;
+ end;
+ if cur_chr>max_hyph_char then max_hyph_char:=cur_chr;
+@z
+%---------------------------------------
+@x [43] m.966 l. - Omega
+procedure init_trie;
+var @!p:trie_pointer; {pointer for initialization}
+@!j,@!k,@!t:integer; {all-purpose registers for initialization}
+@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
+@!h:two_halves; {template used to zero out |trie|'s holes}
+begin @<Get ready to compress the trie@>;
+@y
+procedure init_trie;
+var @!p:trie_pointer; {pointer for initialization}
+@!j,@!k,@!t:integer; {all-purpose registers for initialization}
+@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
+@!h:two_halves; {template used to zero out |trie|'s holes}
+begin
+incr(max_hyph_char);
+@<Get ready to compress the trie@>;
+@z
+%---------------------------------------
+@x [44] m.977 l.19008 - Omega
+if q=null then box(n):=null {the |eq_level| of the box stays the same}
+else box(n):=vpack(q,natural);
+@y
+if q=null then set_equiv(box_base+n,null)
+ {the |eq_level| of the box stays the same}
+else set_equiv(box_base+n,vpack(q,natural));
+@z
+%---------------------------------------
+@x [45] m.992 l.24928 - Omega
+flush_node_list(box(n)); box(n):=null;
+@y
+flush_node_list(box(n)); set_equiv(box_base+n,null);
+@z
+%---------------------------------------
+@x [45] m.994 l.19364 - Omega
+@!n:min_quarterword..255; {insertion box number}
+@y
+@!n:min_quarterword..biggest_reg; {insertion box number}
+@z
+%---------------------------------------
+@x [45] m.1012 l.19655 - Omega
+@!n:min_quarterword..255; {insertion box number}
+@y
+@!n:min_quarterword..biggest_reg; {insertion box number}
+@z
+%---------------------------------------
+@x [45] m.1014 l.19710 - Omega
+split_top_skip:=save_split_top_skip;
+@y
+set_equiv(glue_base+split_top_skip_code,save_split_top_skip);
+@z
+%---------------------------------------
+@x [45] m.1017 l.19753 - Omega
+save_vbadness:=vbadness; vbadness:=inf_bad;
+save_vfuzz:=vfuzz; vfuzz:=max_dimen; {inhibit error messages}
+box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth);
+vbadness:=save_vbadness; vfuzz:=save_vfuzz;
+@y
+save_vbadness:=vbadness;
+set_new_eqtb_int(int_base+vbadness_code,inf_bad);
+save_vfuzz:=vfuzz;
+set_new_eqtb_sc(dimen_base+vfuzz_code,max_dimen);
+ {inhibit error messages}
+set_equiv(box_base+255,
+ vpackage(link(page_head),best_size,exactly,page_max_depth));
+set_new_eqtb_int(int_base+vbadness_code,save_vbadness);
+set_new_eqtb_sc(dimen_base+vfuzz_code,save_vfuzz);
+@z
+%---------------------------------------
+@x [45] m.1018 l.19774 - Omega
+ if box(n)=null then box(n):=new_null_box;
+@y
+ if box(n)=null then set_equiv(box_base+n,new_null_box);
+@z
+%---------------------------------------
+@x [45] m.1021 l.19817 - Omega
+ split_top_skip:=split_top_ptr(p);
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+ if ins_ptr(p)<>null then
+ begin temp_ptr:=vpack(ins_ptr(p),natural);
+ height(p):=height(temp_ptr)+depth(temp_ptr);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+box(n):=vpack(temp_ptr,natural);
+@y
+ set_equiv(glue_base+split_top_skip_code,split_top_ptr(p));
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+ if ins_ptr(p)<>null then
+ begin temp_ptr:=vpack(ins_ptr(p),natural);
+ height(p):=height(temp_ptr)+depth(temp_ptr);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+set_equiv(box_base+n,vpack(temp_ptr,natural));
+@z
+%---------------------------------------
+@x [45] m.1023 l.19854 - Omega
+ship_out(box(255)); box(255):=null;
+@y
+ship_out(box(255)); set_equiv(box_base+255,null);
+@z
+%---------------------------------------
+@x [46] m.1046 l.20339 - Omega
+non_math(math_given), non_math(math_comp), non_math(delim_num),
+@y
+non_math(math_given), non_math(omath_given),
+non_math(math_comp), non_math(delim_num),
+@z
+%---------------------------------------
+@x [47] m.1071 l.20718 - Omega
+|box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}';
+codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox255}';
+code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513|
+through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}',
+@y
+|box_flag+biggest_reg| represent `\.{\\setbox0}' through
+`\.{\\setbox}|biggest_reg|'; codes |box_flag+biggest_reg+1| through
+|box_flag+2*biggest_reg| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox}|biggest_reg|'; code |box_flag+2*number_regs|
+represents `\.{\\shipout}'; and codes |box_flag+2*number_regs+1|
+through |box_flag+2*number_regs+3| represent `\.{\\leaders}', `\.{\\cleaders}',
+@z
+%---------------------------------------
+@x [47] m.1071 l.20732 - Omega
+@d ship_out_flag==box_flag+512 {context code for `\.{\\shipout}'}
+@d leader_flag==box_flag+513 {context code for `\.{\\leaders}'}
+@y
+@d ship_out_flag==box_flag+(number_regs+number_regs)
+ {context code for `\.{\\shipout}'}
+@d leader_flag==ship_out_flag+1 {context code for `\.{\\leaders}'}
+@z
+%---------------------------------------
+@x [47] m.1077 l.20853 - Omega
+if box_context<box_flag+256 then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-256+box_context,box_ref,cur_box)
+@y
+if box_context<box_flag+number_regs then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box)
+@z
+%---------------------------------------
+@x [47] m.1079 l.20888 - Omega
+ box(cur_val):=null; {the box becomes void, at the same level}
+@y
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+@z
+%---------------------------------------
+@x [47] m.1100 l.21156 - Omega
+ if saved(0)<255 then
+@y
+ if saved(0)<>255 then
+@z
+%---------------------------------------
+@x [47] m.1109 l.21265 - Omega
+@ The |un_hbox| and |un_vbox| commands unwrap one of the 256 current boxes.
+@y
+@ The |un_hbox| and |un_vbox| commands unwrap one of the current boxes.
+@z
+%---------------------------------------
+@x [47] m.1110 l.21287 - Omega
+else begin link(tail):=list_ptr(p); box(cur_val):=null;
+@y
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@z
+%---------------------------------------
+@x [47] m.1117 l.21342 - Omega
+ if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c);
+@y
+ if c>=0 then if c<=biggest_char then
+ pre_break(tail):=new_character(cur_font,c);
+@z
+%---------------------------------------
+@x [48] m.1151 l.21810 - Omega
+@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are
+broken down into subfields called |math_type| and either |info| or
+|(fam,character)|. The job of |scan_math| is to figure out what to place
+in one of these principal fields; it looks at the subformula that
+comes next in the input, and places an encoding of that subformula
+into a given word of |mem|.
+
+@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
+
+@<Declare act...@>=
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:case cur_cmd of
+letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
+ end;
+math_given: c:=cur_chr;
+delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod 256);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div 256) mod 16;
+exit:end;
+@y
+@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are
+broken down into subfields called |math_type| and either |info| or
+|(fam,character)|. The job of |scan_math| is to figure out what to place
+in one of these principal fields; it looks at the subformula that
+comes next in the input, and places an encoding of that subformula
+into a given word of |mem|.
+
+@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
+
+@<Declare act...@>=
+@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
+
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:
+case cur_cmd of
+letter,other_char,char_given: begin
+ c:=ho(math_code(cur_chr));
+ if c=@"8000000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin
+ if cur_chr=0 then scan_fifteen_bit_int
+ else scan_big_fifteen_bit_int;
+ c:=cur_val;
+ end;
+math_given: begin
+ c := ((cur_chr div @"1000) * @"1000000) +
+ (((cur_chr mod @"1000) div @"100) * @"10000) +
+ (cur_chr mod @"100);
+ end;
+omath_given: begin c:=cur_chr;
+ end;
+delim_num: begin
+ if cur_chr=0 then scan_twenty_seven_bit_int
+ else scan_fifty_one_bit_int;
+ c:=cur_val;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod @"10000);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div @"10000) mod @"100;
+exit:end;
+@z
+%---------------------------------------
+@x [48] m.1154 l.21860 - Omega
+mmode+letter,mmode+other_char,mmode+char_given:
+ set_math_char(ho(math_code(cur_chr)));
+mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
+ set_math_char(ho(math_code(cur_chr)));
+ end;
+mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val);
+ end;
+mmode+math_given: set_math_char(cur_chr);
+mmode+delim_num: begin scan_twenty_seven_bit_int;
+ set_math_char(cur_val div @'10000);
+@y
+mmode+letter,mmode+other_char,mmode+char_given:
+ set_math_char(ho(math_code(cur_chr)));
+mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
+ set_math_char(ho(math_code(cur_chr)));
+ end;
+mmode+math_char_num: begin
+ if cur_chr=0 then scan_fifteen_bit_int
+ else scan_big_fifteen_bit_int;
+ set_math_char(cur_val);
+ end;
+mmode+math_given: begin
+ set_math_char(((cur_chr div @"1000) * @"1000000) +
+ (((cur_chr mod @"1000) div @"100) * @"10000) +
+ (cur_chr mod @"100));
+ end;
+mmode+omath_given: begin
+ set_math_char(cur_chr);
+ end;
+mmode+delim_num: begin
+ if cur_chr=0 then scan_twenty_seven_bit_int
+ else scan_fifty_one_bit_int;
+ set_math_char(cur_val);
+@z
+%---------------------------------------
+@x [48] m.1155 l.21878 - Omega
+procedure set_math_char(@!c:integer);
+var p:pointer; {the new noad}
+begin if c>=@'100000 then
+ @<Treat |cur_chr|...@>
+else begin p:=new_noad; math_type(nucleus(p)):=math_char;
+ character(nucleus(p)):=qi(c mod 256);
+ fam(nucleus(p)):=(c div 256) mod 16;
+ if c>=var_code then
+ begin if fam_in_range then fam(nucleus(p)):=cur_fam;
+ type(p):=ord_noad;
+ end
+ else type(p):=ord_noad+(c div @'10000);
+ link(tail):=p; tail:=p;
+ end;
+end;
+@y
+procedure set_math_char(@!c:integer);
+var p,q,r:pointer; {the new noad}
+begin if c>=@"8000000 then
+ @<Treat |cur_chr|...@>
+else begin p:=new_noad; math_type(nucleus(p)):=math_char;
+ character(nucleus(p)):=qi(c mod @"10000);
+ fam(nucleus(p)):=(c div @"10000) mod @"100;
+ if c>=var_code then
+ begin if fam_in_range then fam(nucleus(p)):=cur_fam;
+ type(p):=ord_noad;
+ end
+ else type(p):=ord_noad+(c div @"1000000);
+ link(tail):=p; tail:=p;
+ end;
+end;
+@z
+%---------------------------------------
+@x [48] m.1160 l.21966 - Omega
+procedure scan_delimiter(@!p:pointer;@!r:boolean);
+begin if r then scan_twenty_seven_bit_int
+else begin @<Get the next non-blank non-relax...@>;
+ case cur_cmd of
+ letter,other_char: cur_val:=del_code(cur_chr);
+ delim_num: scan_twenty_seven_bit_int;
+ othercases cur_val:=-1
+ endcases;
+ end;
+if cur_val<0 then @<Report that an invalid delimiter code is being changed
+ to null; set~|cur_val:=0|@>;
+small_fam(p):=(cur_val div @'4000000) mod 16;
+small_char(p):=qi((cur_val div @'10000) mod 256);
+large_fam(p):=(cur_val div 256) mod 16;
+large_char(p):=qi(cur_val mod 256);
+@y
+procedure scan_delimiter(@!p:pointer;@!r:integer);
+begin if r=1 then scan_twenty_seven_bit_int
+else if r=2 then scan_fifty_one_bit_int
+else begin @<Get the next non-blank non-relax...@>;
+ case cur_cmd of
+ letter,other_char: begin
+ cur_val:=del_code0(cur_chr); cur_val1:=del_code1(cur_chr);
+ end;
+ delim_num: if cur_chr=0 then scan_twenty_seven_bit_int
+ else scan_fifty_one_bit_int;
+ othercases begin cur_val:=-1; cur_val1:=-1; end;
+ endcases;
+ end;
+if cur_val<0 then begin @<Report that an invalid delimiter code is being changed
+ to null; set~|cur_val:=0|@>;
+ cur_val1:=0;
+ end;
+small_fam(p):=(cur_val div @"10000) mod @"100;
+small_char(p):=qi(cur_val mod @"10000);
+large_fam(p):=(cur_val1 div @"10000) mod @"100;
+large_char(p):=qi(cur_val1 mod @"10000);
+@z
+%---------------------------------------
+@x [48] m.1163 l.22005 - Omega
+scan_delimiter(left_delimiter(tail),true); scan_math(nucleus(tail));
+@y
+scan_delimiter(left_delimiter(tail),cur_chr+1); scan_math(nucleus(tail));
+@z
+%---------------------------------------
+@x [48] m.1165 l.22012 - Omega
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+math_type(accent_chr(tail)):=math_char;
+scan_fifteen_bit_int;
+character(accent_chr(tail)):=qi(cur_val mod 256);
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
+scan_math(nucleus(tail));
+end;
+@y
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+math_type(accent_chr(tail)):=math_char;
+if cur_chr=0 then scan_fifteen_bit_int
+else scan_big_fifteen_bit_int;
+character(accent_chr(tail)):=qi(cur_val mod @"10000);
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div @"10000) mod @"100;
+scan_math(nucleus(tail));
+end;
+@z
+%---------------------------------------
+@x [48] m.1174 l.22085 - Omega
+@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
+@y
+@z
+%---------------------------------------
+@x [48] m.1188 l.22284 - Omega
+text(frozen_right):="right"; eqtb[frozen_right]:=eqtb[cur_val];
+@y
+settext(frozen_right,"right");
+set_new_eqtb(frozen_right,new_eqtb(cur_val));
+@z
+%---------------------------------------
+@x [49] m.1214 l.22700 - Omega
+@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
+@y
+@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
+@d del_word_define(#)==if global
+ then del_geq_word_define(#)@+else del_eq_word_define(#)
+@z
+%---------------------------------------
+@x [49] m.1216 l.22734 - Omega
+text(frozen_protection):="inaccessible";
+@y
+settext(frozen_protection,"inaccessible");
+@z
+%---------------------------------------
+@x [49] m.1222 l.22789 - Omega
+@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
+@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
+@d count_def_code=2 {|shorthand_def| for \.{\\countdef}}
+@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
+@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
+@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
+@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+
+@<Put each...@>=
+primitive("chardef",shorthand_def,char_def_code);@/
+@!@:char_def_}{\.{\\chardef} primitive@>
+primitive("mathchardef",shorthand_def,math_char_def_code);@/
+@!@:math_char_def_}{\.{\\mathchardef} primitive@>
+@y
+@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
+@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
+@d omath_char_def_code=2 {|shorthand_def| for \.{\\omathchardef}}
+@d count_def_code=3 {|shorthand_def| for \.{\\countdef}}
+@d dimen_def_code=4 {|shorthand_def| for \.{\\dimendef}}
+@d skip_def_code=5 {|shorthand_def| for \.{\\skipdef}}
+@d mu_skip_def_code=6 {|shorthand_def| for \.{\\muskipdef}}
+@d toks_def_code=7 {|shorthand_def| for \.{\\toksdef}}
+
+@<Put each...@>=
+primitive("chardef",shorthand_def,char_def_code);@/
+@!@:char_def_}{\.{\\chardef} primitive@>
+primitive("mathchardef",shorthand_def,math_char_def_code);@/
+@!@:math_char_def_}{\.{\\mathchardef} primitive@>
+primitive("omathchardef",shorthand_def,omath_char_def_code);@/
+@!@:math_char_def_}{\.{\\omathchardef} primitive@>
+@z
+%---------------------------------------
+@x [49] m.1224 l.22833 - Omega
+shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
+ scan_optional_equals;
+ case n of
+ char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
+ end;
+@y
+shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs;
+ define(p,relax,too_big_char); scan_optional_equals;
+ case n of
+ char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_real_fifteen_bit_int;
+ define(p,math_given,cur_val);
+ end;
+ omath_char_def_code: begin scan_big_fifteen_bit_int;
+ define(p,omath_given,cur_val);
+ end;
+@z
+%---------------------------------------
+@x [49] m.1230 l. - Omega
+primitive("mathcode",def_code,math_code_base);
+@!@:math_code_}{\.{\\mathcode} primitive@>
+primitive("lccode",def_code,lc_code_base);
+@!@:lc_code_}{\.{\\lccode} primitive@>
+primitive("uccode",def_code,uc_code_base);
+@!@:uc_code_}{\.{\\uccode} primitive@>
+primitive("sfcode",def_code,sf_code_base);
+@!@:sf_code_}{\.{\\sfcode} primitive@>
+primitive("delcode",def_code,del_code_base);
+@!@:del_code_}{\.{\\delcode} primitive@>
+@y
+primitive("mathcode",def_code,math_code_base);
+@!@:math_code_}{\.{\\mathcode} primitive@>
+primitive("omathcode",def_code,math_code_base+256);
+@!@:math_code_}{\.{\\omathcode} primitive@>
+primitive("lccode",def_code,lc_code_base);
+@!@:lc_code_}{\.{\\lccode} primitive@>
+primitive("uccode",def_code,uc_code_base);
+@!@:uc_code_}{\.{\\uccode} primitive@>
+primitive("sfcode",def_code,sf_code_base);
+@!@:sf_code_}{\.{\\sfcode} primitive@>
+primitive("delcode",def_code,del_code_base);
+@!@:del_code_}{\.{\\delcode} primitive@>
+primitive("odelcode",def_code,del_code_base+256);
+@!@:del_code_}{\.{\\odelcode} primitive@>
+@z
+%---------------------------------------
+@x [49] m.1232 l.22990 - Omega
+def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
+ p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+ if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
+ begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+ if p<del_code_base then print("), should be in the range 0..")
+ else print("), should be at most ");
+ print_int(n);
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val:=0;
+ end;
+ if p<math_code_base then define(p,data,cur_val)
+ else if p<del_code_base then define(p,data,hi(cur_val))
+ else word_define(p,cur_val);
+@y
+def_code: begin
+ if cur_chr=(del_code_base+256) then begin
+ p:=cur_chr-256; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int; cur_val1:=cur_val; scan_int; {backwards}
+ if (cur_val1>@"FFFFFF) or (cur_val>@"FFFFFF) then
+ begin print_err("Invalid code ("); print_int(cur_val1); print(" ");
+ print_int(cur_val);
+ print("), should be at most ""FFFFFF ""FFFFFF");
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val1:=0; cur_val:=0;
+ end;
+ del_word_define(p,cur_val1,cur_val);
+ end
+ else begin
+ @<Let |n| be the largest legal code value, based on |cur_chr|@>;
+ p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+ if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
+ begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+ if p<del_code_base then print("), should be in the range 0..")
+ else print("), should be at most ");
+ print_int(n);
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val:=0;
+ end;
+ if p<math_code_base then define(p,data,cur_val)
+ else if p<(math_code_base+256) then begin
+ if cur_val=@"8000 then cur_val:=@"8000000
+ else cur_val:=((cur_val div @"1000) * @"1000000) +
+ (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+ define(p,data,hi(cur_val));
+ end
+ else if p<del_code_base then define(p-256,data,hi(cur_val))
+ else begin
+ cur_val1:=cur_val div @"1000;
+ cur_val1:=(cur_val1 div @"100)*@"10000 + (cur_val1 mod @"100);
+ cur_val:=cur_val mod @"1000;
+ cur_val:=(cur_val div @"100)*@"10000 + (cur_val mod @"100);
+ del_word_define(p,cur_val1,cur_val);
+ end;
+ end;
+@z
+%---------------------------------------
+@x [49] m.1233 l.22990 - Omega
+if cur_chr=cat_code_base then n:=max_char_code
+else if cur_chr=math_code_base then n:=@'100000
+else if cur_chr=sf_code_base then n:=@'77777
+else if cur_chr=del_code_base then n:=@'77777777
+else n:=255
+@y
+if cur_chr=cat_code_base then n:=max_char_code
+else if cur_chr=math_code_base then n:=@'100000
+else if cur_chr=(math_code_base+256) then n:=@"8000000
+else if cur_chr=sf_code_base then n:=@'77777
+else if cur_chr=del_code_base then n:=@'77777777
+else n:=biggest_char
+@z
+%---------------------------------------
+@x [49] m.1234 l.22990 - Omega
+def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val;
+@y
+def_family: begin p:=cur_chr; scan_big_four_bit_int; p:=p+cur_val;
+@z
+%---------------------------------------
+@x [49] m.1238 l.23059 - Omega
+ if q=advance then cur_val:=cur_val+eqtb[l].int;
+@y
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@z
+%---------------------------------------
+@x [49] m.1240 l.23086 - Omega
+ if p=int_val then cur_val:=mult_integers(eqtb[l].int,cur_val)
+ else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0)
+ else cur_val:=x_over_n(eqtb[l].int,cur_val)
+@y
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+@z
+%---------------------------------------
+@x [49] m.1241 l.23109 - Omega
+ if global then n:=256+cur_val@+else n:=cur_val;
+@y
+ if global then n:=number_regs+cur_val@+else n:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1289 l.23546 - Omega
+|cs_token_flag+active_base| is a multiple of~256.
+@y
+|cs_token_flag+active_base| is a multiple of~|max_char_val|.
+@z
+%---------------------------------------
+@x [49] m.1289 l.23552 - Omega
+ begin c:=t mod 256;
+@y
+ begin c:=t mod max_char_val;
+@z
+%---------------------------------------
+@x [50] m.1313 l.23892 - Omega
+@<Dump regions 1 to 4 of |eqtb|@>;
+@<Dump regions 5 and 6 of |eqtb|@>;
+@y
+dump_eqtb_table;
+@z
+%---------------------------------------
+@x [50] m.1314 l.23904 - Omega
+@<Undump regions 1 to 6 of |eqtb|@>;
+@y
+undump_eqtb_table;
+@z
+%---------------------------------------
+@x [50] m.1315 l.23904 - Omega
+@ The table of equivalents usually contains repeated information, so we dump it
+in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the
+format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra
+copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$.
+
+@<Dump regions 1 to 4 of |eqtb|@>=
+k:=active_base;
+repeat j:=k;
+while j<int_base-1 do
+ begin if (equiv(j)=equiv(j+1))and(eq_type(j)=eq_type(j+1))and@|
+ (eq_level(j)=eq_level(j+1)) then goto found1;
+ incr(j);
+ end;
+l:=int_base; goto done1; {|j=int_base-1|}
+found1: incr(j); l:=j;
+while j<int_base-1 do
+ begin if (equiv(j)<>equiv(j+1))or(eq_type(j)<>eq_type(j+1))or@|
+ (eq_level(j)<>eq_level(j+1)) then goto done1;
+ incr(j);
+ end;
+done1:dump_int(l-k);
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+k:=j+1; dump_int(k-l);
+until k=int_base
+
+@ @<Dump regions 5 and 6 of |eqtb|@>=
+repeat j:=k;
+while j<eqtb_size do
+ begin if eqtb[j].int=eqtb[j+1].int then goto found2;
+ incr(j);
+ end;
+l:=eqtb_size+1; goto done2; {|j=eqtb_size|}
+found2: incr(j); l:=j;
+while j<eqtb_size do
+ begin if eqtb[j].int<>eqtb[j+1].int then goto done2;
+ incr(j);
+ end;
+done2:dump_int(l-k);
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+k:=j+1; dump_int(k-l);
+until k>eqtb_size
+
+@ @<Undump regions 1 to 6 of |eqtb|@>=
+k:=active_base;
+repeat undump_int(x);
+if (x<1)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do undump_wd(eqtb[j]);
+k:=k+x;
+undump_int(x);
+if (x<0)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do eqtb[j]:=eqtb[k-1];
+k:=k+x;
+until k>eqtb_size
+@y
+
+@z
+%---------------------------------------
+@x [50] m.1318 l.23967 - Omega
+@<Dump the hash table@>=
+dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used;
+for p:=hash_base to hash_used do if text(p)<>0 then
+ begin dump_int(p); dump_hh(hash[p]); incr(cs_count);
+ end;
+for p:=hash_used+1 to undefined_control_sequence-1 do dump_hh(hash[p]);
+dump_int(cs_count);@/
+print_ln; print_int(cs_count); print(" multiletter control sequences")
+@y
+@<Dump the hash table@>=
+dump_int(hash_used);
+@z
+%---------------------------------------
+@x [50] m.1319 l.23976 - Omega
+undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1;
+repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]);
+until p=hash_used;
+for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]);
+undump_int(cs_count)
+@y
+undump(hash_base)(frozen_control_sequence)(hash_used);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24066 - Omega
+for k:=0 to trie_max do dump_hh(trie[k]);
+@y
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(max_hyph_char);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24078 - Omega
+for k:=255 downto 0 do if trie_used[k]>min_quarterword then
+@y
+for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then
+@z
+%---------------------------------------
+@x [50] m.1325 l.24094 - Omega
+for k:=0 to j do undump_hh(trie[k]);
+@y
+for k:=0 to j do undump_hh(trie[k]);
+undump_int(max_hyph_char);
+@z
+%---------------------------------------
+@x [50] m.1325 l.24101 - Omega
+init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/
+k:=256;
+@y
+init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/
+k:=biggest_lang+1;
+@z
+%---------------------------------------
+@x [50] m.1326 l.24100 - Omega
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+tracing_stats:=0
+@y
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+set_new_eqtb_int(int_base+tracing_stats_code,0)
+@z
+%---------------------------------------
+@x [53] m.1341 l.24506 - Omega
+@d what_lang(#)==link(#+1) {language number, in the range |0..255|}
+@y
+@d what_lang(#)==link(#+1) {language number, in the range |0..biggest_lang|}
+@z
+%---------------------------------------
+@x [53] m.1370
+@!write_file:array[0..15] of alpha_file;
+@y
+@!outside_string_array: array[0..1000] of 0..255;
+@!write_file:array[0..15] of alpha_file;
+@z
+%---------------------------------------
+@x [53] m. l.24761 - Omega
+text(end_write):="endwrite"; eq_level(end_write):=level_one;
+eq_type(end_write):=outer_call; equiv(end_write):=null;
+@y
+settext(end_write,"endwrite"); set_eq_level(end_write,level_one);
+set_eq_type(end_write,outer_call); set_equiv(end_write,null);
+@z
+%---------------------------------------
+@x [53] m.1376 l.24878 - Omega
+else if language>255 then l:=0
+@y
+else if language>biggest_lang then l:=0
+@z
+%---------------------------------------
+@x [53] m.1377 l.24893 - Omega
+ else if cur_val>255 then clang:=0
+@y
+ else if cur_val>biggest_lang then clang:=0
+@z
+%---------------------------------------
+@x [54]
+This section should be replaced, if necessary, by any special
+modifications of the program
+that are necessary to make \TeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@y
+@* \[54] $\Omega$ changes.
+
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/alephdir/omchar.ch b/Build/source/texk/web2c/alephdir/omchar.ch
new file mode 100644
index 00000000000..9c18ce96750
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omchar.ch
@@ -0,0 +1,84 @@
+% omchar.ch: Primitives to access the components of font metric files.
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [26] m.416 l.8407 - Omega char dimensions
+primitive("dp",set_box_dimen,depth_offset);
+@!@:dp_}{\.{\\dp} primitive@>
+@y
+primitive("dp",set_box_dimen,depth_offset);
+@!@:dp_}{\.{\\dp} primitive@>
+primitive("charwd",set_box_dimen,(width_offset+3));
+@!@:charwd_}{\.{\\charwd} primitive@>
+primitive("charht",set_box_dimen,(height_offset+3));
+@!@:charht_}{\.{\\charht} primitive@>
+primitive("chardp",set_box_dimen,(depth_offset+3));
+@!@:chardp_}{\.{\\chardp} primitive@>
+primitive("charit",set_box_dimen,(depth_offset+4));
+@!@:charit_}{\.{\\charit} primitive@>
+@z
+%---------------------------------------
+@x [26] m.416 l.8425 - Omega char dimensions
+set_box_dimen: if chr_code=width_offset then print_esc("wd")
+else if chr_code=height_offset then print_esc("ht")
+else print_esc("dp");
+@y
+set_box_dimen: if chr_code=width_offset then print_esc("wd")
+else if chr_code=height_offset then print_esc("ht")
+else if chr_code=depth_offset then print_esc("dp")
+else if chr_code=(width_offset+3) then print_esc("charwd")
+else if chr_code=(height_offset+3) then print_esc("charht")
+else if chr_code=(depth_offset+3) then print_esc("chardp")
+else print_esc("charit");
+@z
+%---------------------------------------
+@x [26] m.419 l.8461 - Omega char dimensions
+begin scan_eight_bit_int;
+if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc;
+cur_val_level:=dimen_val;
+end
+@y
+if m<=3 then
+begin
+ scan_eight_bit_int;
+ if box(cur_val)=null then cur_val:=0 @+else
+ cur_val:=mem[box(cur_val)+m].sc;
+ cur_val_level:=dimen_val;
+end
+else
+begin
+ scan_char_num;
+ if m=(width_offset+3) then begin
+ cur_val:= char_width(main_f)(char_info(main_f)(cur_val))
+ end
+ else if m=(height_offset+3) then begin
+ cur_val:= char_height(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else if m=(depth_offset+3) then begin
+ cur_val:= char_depth(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else begin
+ cur_val:= char_italic(main_f)(char_info(main_f)(cur_val));
+ end;
+ cur_val_level:=dimen_val;
+end
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/alephdir/omdir.ch b/Build/source/texk/web2c/alephdir/omdir.ch
new file mode 100644
index 00000000000..b4afb7f68f6
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omdir.ch
@@ -0,0 +1,3048 @@
+% omdir.ch: Primitives to deal with multiple-direction text
+%
+% This file is part of the Omega projet, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%-------------------------
+@x [10] m.135
+@d hlist_node=0 {|type| of hlist nodes}
+@d box_node_size=7 {number of words to allocate for a box node}
+@d width_offset=1 {position of |width| field in a box node}
+@d depth_offset=2 {position of |depth| field in a box node}
+@d height_offset=3 {position of |height| field in a box node}
+@d width(#) == mem[#+width_offset].sc {width of the box, in sp}
+@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp}
+@d height(#) == mem[#+height_offset].sc {height of the box, in sp}
+@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp}
+@d list_offset=5 {position of |list_ptr| field in a box node}
+@d list_ptr(#) == link(#+list_offset) {beginning of the list inside the box}
+@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
+@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
+@d normal=0 {the most common case when several cases are named}
+@d stretching = 1 {glue setting applies to the stretch components}
+@d shrinking = 2 {glue setting applies to the shrink components}
+@d glue_offset = 6 {position of |glue_set| in a box node}
+@d glue_set(#) == mem[#+glue_offset].gr
+ {a word of type |glue_ratio| for glue setting}
+@y
+@d hlist_node=0 {|type| of hlist nodes}
+@d box_node_size=8 {number of words to allocate for a box node}
+@d width_offset=1 {position of |width| field in a box node}
+@d depth_offset=2 {position of |depth| field in a box node}
+@d height_offset=3 {position of |height| field in a box node}
+@d width(#) == mem[#+width_offset].sc {width of the box, in sp}
+@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp}
+@d height(#) == mem[#+height_offset].sc {height of the box, in sp}
+@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp}
+@d list_offset=5 {position of |list_ptr| field in a box node}
+@d list_ptr(#) == link(#+list_offset) {beginning of the list inside the box}
+@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
+@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
+@d normal=0 {the most common case when several cases are named}
+@d stretching = 1 {glue setting applies to the stretch components}
+@d shrinking = 2 {glue setting applies to the shrink components}
+@d glue_offset = 6 {position of |glue_set| in a box node}
+@d glue_set(#) == mem[#+glue_offset].gr
+ {a word of type |glue_ratio| for glue setting}
+@d dir_offset = 7 {position of |box_dir| in a box node}
+@d box_dir(#) == mem[#+dir_offset].int
+@z
+%-------------------------
+@x [10] m.136
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+new_null_box:=p;
+@y
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+box_dir(p):=text_direction;
+new_null_box:=p;
+@z
+%-------------------------
+@x [10] m.138
+@d rule_node=2 {|type| of rule nodes}
+@d rule_node_size=4 {number of words to allocate for a rule node}
+@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
+@d is_running(#) == (#=null_flag) {tests for a running dimension}
+@y
+@d rule_node=2 {|type| of rule nodes}
+@d rule_node_size=5 {number of words to allocate for a rule node}
+@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
+@d is_running(#) == (#=null_flag) {tests for a running dimension}
+@d rule_dir(#)==info(#+4)
+@z
+%-------------------------
+@x [10] m.139
+@p function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+new_rule:=p;
+end;
+@y
+@p function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+rule_dir(p):=-1;
+new_rule:=p;
+end;
+@z
+%-------------------------
+@x [10] m.176
+procedure print_rule_dimen(@!d:scaled); {prints dimension in rule node}
+begin if is_running(d) then print_char("*") else print_scaled(d);
+@.*\relax@>
+end;
+@y
+procedure print_rule_dimen(@!d:scaled); {prints dimension in rule node}
+begin if is_running(d) then print_char("*") else print_scaled(d);
+@.*\relax@>
+end;
+@#
+procedure print_dir(d:integer);
+begin
+print(dir_names[dir_primary[d]]);
+print(dir_names[dir_secondary[d]]);
+print(dir_names[dir_tertiary[d]]);
+end;
+@z
+%-------------------------
+@x [12] m.184
+@ @<Display box |p|@>=
+begin if type(p)=hlist_node then print_esc("h")
+else if type(p)=vlist_node then print_esc("v")
+else print_esc("unset");
+print("box("); print_scaled(height(p)); print_char("+");
+print_scaled(depth(p)); print(")x"); print_scaled(width(p));
+if type(p)=unset_node then
+ @<Display special fields of the unset node |p|@>
+else begin @<Display the value of |glue_set(p)|@>;
+ if shift_amount(p)<>0 then
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+ end;
+node_list_display(list_ptr(p)); {recursive call}
+end
+@y
+@ @<Display box |p|@>=
+begin if type(p)=hlist_node then print_esc("h")
+else if type(p)=vlist_node then print_esc("v")
+else print_esc("unset");
+print("box("); print_scaled(height(p)); print_char("+");
+print_scaled(depth(p)); print(")x"); print_scaled(width(p));
+if type(p)=unset_node then
+ @<Display special fields of the unset node |p|@>
+else begin @<Display the value of |glue_set(p)|@>;
+ if shift_amount(p)<>0 then
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+ print(", direction "); print_dir(box_dir(p));
+ end;
+node_list_display(list_ptr(p)); {recursive call}
+end
+@z
+%-------------------------
+@x [10] m.206
+hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size);
+ mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
+@y
+hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size);
+ mem[r+7]:=mem[p+7]; mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5];
+ {copy the last three words}
+@z
+%-------------------------
+@x [15] m.209
+@d max_internal=register
+ {the largest code that can follow \.{\\the}}
+@y
+@d assign_dir=register+1 {(\.{\\pagedir}, \.{\\textdir})}
+@d max_internal=assign_dir
+ {the largest code that can follow \.{\\the}}
+@z
+%-------------------------
+@x [16] m.212
+ @!aux_field: memory_word;
+@y
+ @!aux_field: memory_word;
+ @!dirs_field: halfword;
+ @!math_field: integer;
+@z
+%-------------------------
+@x [16] m.212
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@y
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@d dir_save==cur_list.dirs_field {dir stack when a paragraph is interrupted}
+@d dir_math_save==cur_list.math_field
+ {should begin/end dir nodes be placed around mathematics?}
+@z
+%-------------------------
+@x [16] m.215
+prev_graf:=0; shown_mode:=0;
+@y
+prev_graf:=0; shown_mode:=0;
+dir_save:=null; dir_math_save:=false;
+@z
+%-------------------------
+@x [16] m.216 l.4351
+@ @p @<LOCAL: Declare |make_local_par_node|@>;
+@y
+@ @p @<LOCAL: Declare |make_local_par_node|@>;
+
+@ @p @<DIR: Declare |new_dir|@>;
+@z
+%-------------------------
+@x [16] m.216
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+dir_save:=null; dir_math_save:=false;
+@z
+%-------------------------
+@x [16] m.217
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+@y
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+@z
+%-------------------------
+@x [17] m.236
+@d int_pars=58 {total number of integer parameters}
+@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers}
+@y
+@d no_local_dirs_code=58
+@d level_local_dir_code=59
+@d int_pars=61 {total number of integer parameters}
+@d dir_base=int_base+int_pars
+@d page_direction_code=0
+@d body_direction_code=1
+@d par_direction_code=2
+@d text_direction_code=3
+@d math_direction_code=4
+@d dir_pars=5
+@d count_base=dir_base+dir_pars {|number_regs| user \.{\\count} registers}
+@z
+%-------------------------
+@x [17] m.238
+@d no_local_whatsits==int_par(no_local_whatsits_code)
+@y
+@d no_local_whatsits==int_par(no_local_whatsits_code)
+@d no_local_dirs==int_par(no_local_dirs_code)
+@d level_local_dir==int_par(level_local_dir_code)
+@d dir_par(#)==new_eqtb_int(dir_base+#) {a direction parameter}
+@d page_direction==dir_par(page_direction_code)
+@d body_direction==dir_par(body_direction_code)
+@d par_direction==dir_par(par_direction_code)
+@d text_direction==dir_par(text_direction_code)
+@d math_direction==dir_par(math_direction_code)
+@z
+%-------------------------
+@x [17] m.240
+set_new_eqtb_int(int_base+end_line_char_code,carriage_return);
+@y
+set_new_eqtb_int(int_base+end_line_char_code,carriage_return);
+set_new_eqtb_int(int_base+level_local_dir_code,level_one);
+@z
+%-------------------------
+@x [17] m.247
+@d dimen_pars=21 {total number of dimension parameters}
+@y
+@d page_width_code=21
+@d page_height_code=22
+@d page_right_offset_code=23
+@d page_bottom_offset_code=24
+@d dimen_pars=25 {total number of dimension parameters}
+@z
+%-------------------------
+@x [17] m.247
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@y
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@d page_width==dimen_par(page_width_code)
+@d page_height==dimen_par(page_height_code)
+@d page_right_offset==dimen_par(page_right_offset_code)
+@d page_bottom_offset==dimen_par(page_bottom_offset_code)
+@z
+%-------------------------
+@x [26] m.410
+@d int_val=0 {integer values}
+@d dimen_val=1 {dimension values}
+@d glue_val=2 {glue specifications}
+@d mu_val=3 {math glue specifications}
+@d ident_val=4 {font identifier}
+@d tok_val=5 {token lists}
+
+@<Glob...@>=
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@!cur_val_level:int_val..tok_val; {the ``level'' of this value}
+@y
+@d int_val=0 {integer values}
+@d dimen_val=1 {dimension values}
+@d glue_val=2 {glue specifications}
+@d mu_val=3 {math glue specifications}
+@d dir_val=4 {directions}
+@d ident_val=5 {font identifier}
+@d tok_val=6 {token lists}
+
+@<Glob...@>=
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@!cur_val_level:int_val..dir_val; {the ``level'' of this value}
+@z
+%-------------------------
+@x [26] m.413
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+@y
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_dir: scanned_result(new_eqtb_int(m))(dir_val);
+@z
+%-------------------------
+@x [26] m.437
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_eight_bit_int;
+@y
+@
+@d dir_T=0
+@d dir_L=1
+@d dir_B=2
+@d dir_R=3
+@d dir_eq_end(#)==(#)
+@d dir_eq(#)==(#)=dir_eq_end
+@d dir_ne_end(#)==(#)
+@d dir_ne(#)==(#)<>dir_ne_end
+@d dir_opposite_end(#)==((#) mod 4)
+@d dir_opposite(#)==(((#)+2) mod 4)=dir_opposite_end
+@d dir_parallel_end(#)==((#) mod 2)
+@d dir_parallel(#)==((#) mod 2)=dir_parallel_end
+@d dir_orthogonal_end(#)==(# mod 2)
+@d dir_orthogonal(#)==((#) mod 2)<>dir_orthogonal_end
+@d dir_next_end(#)==((#) mod 4)
+@d dir_next(#)==(((#)+3) mod 4)=dir_next_end
+@d dir_prev_end(#)==((#) mod 4)
+@d dir_prev(#)==(((#)+1) mod 4)=dir_prev_end
+
+{box directions}
+@d dir_TL_=0
+@d dir_TR_=1
+@d dir_LT_=2
+@d dir_LB_=3
+@d dir_BL_=4
+@d dir_BR_=5
+@d dir_RT_=6
+@d dir_RB_=7
+
+{font directions}
+@d dir__LT= 0
+@d dir__LL= 1
+@d dir__LB= 2
+@d dir__LR= 3
+@d dir__RT= 4
+@d dir__RL= 5
+@d dir__RB= 6
+@d dir__RR= 7
+@d dir__TT= 8
+@d dir__TL= 9
+@d dir__TB=10
+@d dir__TR=11
+@d dir__BT=12
+@d dir__BL=13
+@d dir__BB=14
+@d dir__BR=15
+
+@d is_mirrored(#)==dir_opposite(dir_primary[#])(dir_tertiary[#])
+@d is_rotated(#)==dir_parallel(dir_secondary[#])(dir_tertiary[#])
+@d font_direction(#)==(# mod 16)
+@d box_direction(#)==(# div 4)
+
+@d scan_single_dir(#)==begin
+if scan_keyword("T") then #:=dir_T
+else if scan_keyword("L") then #:=dir_L
+else if scan_keyword("B") then #:=dir_B
+else if scan_keyword("R") then #:=dir_R
+else begin
+ print_err("Bad direction"); cur_val:=0;
+ goto exit;
+ end
+end
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_dir;
+var d1,d2,d3: integer;
+begin
+get_x_token;
+if cur_cmd=assign_dir then begin
+ cur_val:=new_eqtb_int(cur_chr);
+ goto exit;
+ end
+else back_input;
+scan_single_dir(d1);
+scan_single_dir(d2);
+if dir_parallel(d1)(d2) then begin
+ print_err("Bad direction"); cur_val:=0;
+ goto exit;
+ end;
+scan_single_dir(d3);
+cur_val:=d1*8+dir_rearrange[d2]*4+d3;
+exit:
+end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_eight_bit_int;
+@z
+%-------------------------
+@x [27] m.463
+@p function scan_rule_spec:pointer;
+label reswitch;
+var q:pointer; {the rule node being created}
+begin q:=new_rule; {|width|, |depth|, and |height| all equal |null_flag| now}
+if cur_cmd=vrule then width(q):=default_rule
+else begin height(q):=default_rule; depth(q):=0;
+ end;
+@y
+@p function scan_rule_spec:pointer;
+label reswitch;
+var q:pointer; {the rule node being created}
+begin q:=new_rule; {|width|, |depth|, and |height| all equal |null_flag| now}
+if cur_cmd=vrule then begin
+ width(q):=default_rule;
+ rule_dir(q):=body_direction;
+ end
+else begin
+ height(q):=default_rule; depth(q):=0;
+ rule_dir(q):=text_direction;
+end;
+@z
+%-------------------------
+@x [27] m.465
+ int_val:print_int(cur_val);
+@y
+ int_val:print_int(cur_val);
+ dir_val:print_dir(cur_val);
+@z
+%-------------------------
+@x [30] m.550
+@d offset_false_bchar=offset_bchar+1
+@d offset_ivalues_start=offset_false_bchar+1
+@y
+@d offset_false_bchar=offset_bchar+1
+@d offset_natural_dir=offset_false_bchar+1
+@d offset_ivalues_start=offset_natural_dir+1
+@z
+%-------------------------
+@x [30] m.550
+@d font_false_bchar(#)==font_info(#)(offset_false_bchar).int
+@y
+@d font_false_bchar(#)==font_info(#)(offset_false_bchar).int
+@d font_natural_dir(#)==font_info(#)(offset_natural_dir).int
+@z
+%-------------------------
+@x [30] m.560
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled;offset:quarterword):internal_font_number; {input a \.{TFM} file}
+@y
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled;offset:quarterword;natural_dir:integer):internal_font_number;
+ {input a \.{TFM} file}
+@z
+%-------------------------
+@x [30] m.560
+font_offset(f):=offset;
+@y
+font_offset(f):=offset;
+font_natural_dir(f):=natural_dir;
+@z
+%-------------------------
+@x [31] m.586
+@d set_rule=132 {typeset a rule and move right}
+@y
+@d set_rule=132 {typeset a rule and move right}
+@d put1==133 {typeset a character without moving}
+@z
+%-------------------------
+@x [31] m.586
+@d right1=143 {move right}
+@y
+@d right1==143 {move right}
+@d right4==146 {move right, 4 bytes}
+@z
+%-------------------------
+@x [31] m.586
+@d down1=157 {move down}
+@y
+@d down1=157 {move down}
+@d down4=160 {move down, 4 bytes}
+@z
+%-------------------------
+@x [32] m.607
+@p procedure movement(@!w:scaled;@!o:eight_bits);
+label exit,found,not_found,2,1;
+var mstate:small_number; {have we seen a |y| or |z|?}
+@!p,@!q:pointer; {current and top nodes on the stack}
+@!k:integer; {index into |dvi_buf|, modulo |dvi_buf_size|}
+begin q:=get_node(movement_node_size); {new node for the top of the stack}
+width(q):=w; location(q):=dvi_offset+dvi_ptr;
+if o=down1 then
+ begin link(q):=down_ptr; down_ptr:=q;
+ end
+else begin link(q):=right_ptr; right_ptr:=q;
+ end;
+@<Look at the other stack entries until deciding what sort of \.{DVI} command
+ to generate; |goto found| if node |p| is a ``hit''@>;
+@<Generate a |down| or |right| command for |w| and |return|@>;
+found: @<Generate a |y0| or |z0| command in order to reuse a previous
+ appearance of~|w|@>;
+exit:end;
+@y
+@d dvi_set(#)==oval:=#-font_offset(f); ocmd:=set1; out_cmd
+@d dvi_put(#)==oval:=#-font_offset(f); ocmd:=put1; out_cmd
+@d dvi_set_rule_end(#)==dvi_four(#)
+@d dvi_set_rule(#)==dvi_out(set_rule); dvi_four(#); dvi_set_rule_end
+@d dvi_put_rule_end(#)==dvi_four(#)
+@d dvi_put_rule(#)==dvi_out(put_rule); dvi_four(#); dvi_put_rule_end
+@d dvi_right(#)==dvi_out(right4); dvi_four(#);
+@d dvi_left(#)==dvi_out(right4); dvi_four(-#);
+@d dvi_down(#)==dvi_out(down4); dvi_four(#);
+@d dvi_up(#)==dvi_out(down4); dvi_four(-#);
+
+@p procedure movement(@!w:scaled;@!o:eight_bits);
+label exit,found,not_found,2,1;
+var mstate:small_number; {have we seen a |y| or |z|?}
+@!p,@!q:pointer; {current and top nodes on the stack}
+@!k:integer; {index into |dvi_buf|, modulo |dvi_buf_size|}
+begin
+case box_direction(dvi_direction) of
+ dir_TL_: begin
+ end;
+ dir_TR_: begin
+ if o=right1 then negate(w);
+ end;
+ dir_LT_: begin
+ if o=right1 then o:=down1
+ else o:=right1;
+ end;
+ dir_LB_: begin
+ if o=right1 then begin
+ o:=down1; negate(w);
+ end
+ else o:=right1;
+ end;
+ dir_BL_: begin
+ if o=down1 then negate(w);
+ end;
+ dir_BR_: begin
+ negate(w);
+ end;
+ dir_RT_: begin
+ if o=right1 then o:=down1
+ else begin o:=right1; negate(w);
+ end;
+ end;
+ dir_RB_: begin
+ if o=right1 then o:=down1 else o:=right1;
+ negate(w);
+ end;
+ end;
+if false then begin
+q:=get_node(movement_node_size); {new node for the top of the stack}
+width(q):=w; location(q):=dvi_offset+dvi_ptr;
+if o=down1 then
+ begin link(q):=down_ptr; down_ptr:=q;
+ end
+else begin link(q):=right_ptr; right_ptr:=q;
+ end;
+@<Look at the other stack entries until deciding what sort of \.{DVI} command
+ to generate; |goto found| if node |p| is a ``hit''@>;
+end;
+@<Generate a |down| or |right| command for |w| and |return|@>;
+found: @<Generate a |y0| or |z0| command in order to reuse a previous
+ appearance of~|w|@>;
+exit:end;
+@z
+%-------------------------
+@x [32] m.610
+info(q):=yz_OK;
+@y
+@z
+%-------------------------
+@x [32] m.617
+dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
+@y
+dvi_h:=0; dvi_v:=0; cur_h:=0; cur_v:=0; dvi_f:=null_font;
+@z
+%-------------------------
+@x [32] m.619
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+@y
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+c_wd,c_ht,c_dp: scaled;
+ {the real width, height and depth of the character}
+c_htdp: quarterword; {height-depth entry in |char_info|}
+c_info: four_quarters; {|char_info| entry}
+edge_v: scaled;
+edge_h: scaled;
+effective_horizontal: scaled;
+basepoint_horizontal: scaled;
+basepoint_vertical: scaled;
+saving_h: scaled;
+saving_v: scaled;
+save_direction: integer;
+dir_tmp,dir_ptr:pointer;
+dvi_dir_h,dvi_dir_ptr,dvi_temp_ptr:integer;
+@z
+%-------------------------
+@x [32] m.619
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+@y
+save_direction:=dvi_direction;
+dvi_direction:=box_dir(this_box);
+@<DIR: Initialize |dir_ptr| for |ship_out|@>;
+saving_h:=dvi_h; saving_v:=dvi_v;
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+cur_h:=saving_h; cur_v:=saving_v;
+synch_h; synch_v;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+dvi_direction:=save_direction;
+@<DIR: Reset |dir_ptr|@>;
+@z
+%-------------------------
+@x [32] m.620
+ oval:=c-font_offset(f); ocmd:=set1; out_cmd;@/
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+@y
+ c_info:=char_info(f)(c);
+ c_htdp:=height_depth(c_info);
+ if is_rotated(dvi_direction) then begin
+ c_ht:=char_width(f)(c_info) div 2;
+ c_wd:=char_height(f)(c_htdp)+char_depth(f)(c_htdp);
+ end
+ else begin
+ c_ht:=char_height(f)(c_htdp);
+ c_dp:=char_depth(f)(c_htdp);
+ c_wd:=char_width(f)(c_info);
+ end;
+ cur_h:=cur_h+c_wd;
+ if (font_natural_dir(f)<>-1) then
+ case font_direction(dvi_direction) of
+ dir__LT,dir__LB: begin
+ dvi_set(c);
+ end;
+ dir__RT,dir__RB: begin
+ dvi_put(c);
+ dvi_left(c_wd);
+ end;
+ dir__TL,dir__TR: begin
+ dvi_put(c);
+ dvi_down(c_wd);
+ end;
+ dir__BL,dir__BR: begin
+ dvi_put(c);
+ dvi_up(c_wd);
+ end;
+ dir__LL,dir__LR: begin
+ dvi_put(c);
+ dvi_right(c_wd);
+ end;
+ dir__RL,dir__RR: begin
+ dvi_put(c);
+ dvi_left(c_wd);
+ end;
+ dir__TT,dir__TB: begin
+ dvi_put(c);
+ dvi_down(c_wd);
+ end;
+ dir__BT,dir__BB: begin
+ dvi_put(c);
+ dvi_up(c_wd);
+ end;
+ end
+ else
+ case font_direction(dvi_direction) of
+ dir__LT: begin
+ dvi_set(c);
+ end;
+ dir__LB: begin
+ dvi_down(c_ht);
+ dvi_set(c);
+ dvi_up(c_ht);
+ end;
+ dir__RT: begin
+ dvi_left(c_wd);
+ dvi_put(c);
+ end;
+ dir__RB: begin
+ dvi_left(c_wd);
+ dvi_down(c_ht);
+ dvi_put(c);
+ dvi_up(c_ht);
+ end;
+ dir__TL: begin
+ dvi_down(c_wd);
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ end;
+ dir__TR: begin
+ dvi_down(c_wd);
+ dvi_left(c_dp);
+ dvi_put(c);
+ dvi_right(c_dp);
+ end;
+ dir__BL: begin
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ dvi_up(c_wd);
+ end;
+ dir__BR: begin
+ dvi_left(c_dp);
+ dvi_put(c);
+ dvi_right(c_dp);
+ dvi_up(c_wd);
+ end;
+ dir__LL,dir__LR: begin
+ dvi_down(c_ht);
+ dvi_put(c);
+ dvi_up(c_ht);
+ dvi_right(c_wd);
+ end;
+ dir__RL,dir__RR: begin
+ dvi_left(c_wd);
+ dvi_down(c_ht);
+ dvi_put(c);
+ dvi_up(c_ht);
+ end;
+ dir__TT,dir__TB: begin
+ dvi_down(c_wd);
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ end;
+ dir__BT,dir__BB: begin
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ dvi_up(c_wd);
+ end;
+ end;
+@z
+%-------------------------
+@x [32] m.622
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+@y
+rule_node: begin
+ if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
+ then begin
+ rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ end
+ else begin
+ rule_ht:=width(p) div 2;
+ rule_dp:=width(p) div 2;
+ rule_wd:=height(p)+depth(p);
+ end;
+ goto fin_rule;
+ end;
+@z
+%-------------------------
+@x [32] m.623
+if list_ptr(p)=null then cur_h:=cur_h+width(p)
+else begin save_h:=dvi_h; save_v:=dvi_v;
+ cur_v:=base_line+shift_amount(p); {shift the box down}
+ temp_ptr:=p; edge:=cur_h;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge+width(p); cur_v:=base_line;
+ end
+@y
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
+ then begin
+ effective_horizontal:=width(p);
+ basepoint_vertical:=0;
+ if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(p)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ effective_horizontal:=height(p)+depth(p);
+ if not (is_mirrored(box_dir(p))) then
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(p)
+ else
+ basepoint_horizontal:=depth(p)
+ else
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=depth(p)
+ else
+ basepoint_horizontal:=height(p);
+ if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
+ basepoint_vertical:= -(width(p) div 2)
+ else
+ basepoint_vertical:= (width(p) div 2);
+ end;
+if not (is_mirrored(dvi_direction)) then
+ basepoint_vertical := basepoint_vertical + shift_amount(p)
+ {shift the box `down'}
+else
+ basepoint_vertical := basepoint_vertical - shift_amount(p);
+ {shift the box `up'}
+if list_ptr(p)=null then cur_h:=cur_h + effective_horizontal
+else begin
+ temp_ptr:=p; edge:=cur_h; cur_h:=cur_h + basepoint_horizontal;
+ edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+ synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge+effective_horizontal; cur_v:=base_line;
+ end
+end
+@z
+%-------------------------
+@x [32] m.624
+ dvi_out(set_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+@y
+ case font_direction(dvi_direction) of
+ dir__LT: begin
+ dvi_set_rule(rule_ht)(rule_wd);
+ end;
+ dir__LB: begin
+ dvi_down(rule_ht);
+ dvi_set_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__RT: begin
+ dvi_left(rule_wd);
+ dvi_put_rule(rule_ht)(rule_wd);
+ end;
+ dir__RB: begin
+ dvi_left(rule_wd);
+ dvi_down(rule_ht);
+ dvi_put_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__TL: begin
+ dvi_down(rule_wd);
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ end;
+ dir__TR: begin
+ dvi_down(rule_wd);
+ dvi_put_rule(rule_wd)(rule_ht);
+ end;
+ dir__BL: begin
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ dir__BR: begin
+ dvi_put_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ end;
+@z
+%-------------------------
+@x [32] m.626
+leader_wd:=width(leader_box);
+@y
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+ then leader_wd:=width(leader_box)
+else
+ leader_wd:=height(leader_box)+depth(leader_box);
+@z
+-------------------------
+@x [32] m.628
+@<Output a leader box at |cur_h|, ...@>=
+begin cur_v:=base_line+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/
+synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_v:=save_v; dvi_h:=save_h; cur_v:=base_line;
+cur_h:=save_h+leader_wd+lx;
+end
+@y
+@<Output a leader box at |cur_h|, ...@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+ then begin
+ basepoint_vertical:=0;
+ if dir_opposite(dir_secondary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(leader_box)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ if not (is_mirrored(box_dir(leader_box))) then
+ if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(leader_box)
+ else
+ basepoint_horizontal:=depth(leader_box)
+ else
+ if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=depth(leader_box)
+ else
+ basepoint_horizontal:=height(leader_box);
+ if dir_eq(dir_secondary[box_dir(leader_box)])(dir_primary[dvi_direction]) then
+ basepoint_vertical:= -(width(leader_box) div 2)
+ else
+ basepoint_vertical:= (width(leader_box) div 2);
+ end;
+if not (is_mirrored(dvi_direction)) then
+ basepoint_vertical := basepoint_vertical + shift_amount(leader_box)
+ {shift the box `down'}
+else
+ basepoint_vertical := basepoint_vertical - shift_amount(leader_box);
+ {shift the box `up'}
+temp_ptr:=leader_box;
+edge_h:=cur_h; cur_h:=cur_h + basepoint_horizontal;
+edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_h:=save_h; dvi_v:=save_v;
+cur_h:=edge_h+leader_wd+lx; cur_v:=base_line;
+end
+@z
+%-------------------------
+@x [32] m.629
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box);
+top_edge:=cur_v;
+while p<>null do @<Output node |p| for |vlist_out| and move to the next node,
+ maintaining the condition |cur_h=left_edge|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+@y
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+@!save_direction: integer;
+@!effective_vertical: scaled;
+@!basepoint_horizontal: scaled;
+@!basepoint_vertical: scaled;
+@!edge_v: scaled;
+@!saving_v: scaled;
+@!saving_h: scaled;
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+saving_v:=dvi_v; saving_h:=dvi_h;
+save_direction:=dvi_direction;
+dvi_direction:=box_dir(this_box);
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box);
+top_edge:=cur_v;
+while p<>null do @<Output node |p| for |vlist_out| and move to the next node,
+ maintaining the condition |cur_h=left_edge|@>;
+cur_v:=saving_v; cur_h:=saving_h;
+synch_v; synch_h;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+dvi_direction:=save_direction;
+@z
+%-------------------------
+@x [32] m.631
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+@y
+rule_node: begin
+ if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
+ then begin
+ rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ end
+ else begin
+ rule_ht:=width(p) div 2;
+ rule_dp:=width(p) div 2;
+ rule_wd:=height(p)+depth(p);
+ end;
+ goto fin_rule;
+ end;
+@z
+%-------------------------
+@x [32] m.632
+@<Output a box in a vlist@>=
+if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
+else begin cur_v:=cur_v+height(p); synch_v;
+ save_h:=dvi_h; save_v:=dvi_v;
+ cur_h:=left_edge+shift_amount(p); {shift the box right}
+ temp_ptr:=p;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_v:=save_v+depth(p); cur_h:=left_edge;
+ end
+@y
+@<Output a box in a vlist@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
+ then begin
+ effective_vertical:=height(p)+depth(p);
+ if (type(p)=hlist_node) and (is_mirrored(box_dir(p))) then
+ basepoint_vertical:=depth(p)
+ else
+ basepoint_vertical:=height(p);
+ if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(p)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ effective_vertical:=width(p);
+ if not (is_mirrored(box_dir(p))) then
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(p)
+ else
+ basepoint_horizontal:=depth(p)
+ else
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=depth(p)
+ else
+ basepoint_horizontal:=height(p);
+ if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
+ basepoint_vertical:=0
+ else
+ basepoint_vertical:=width(p);
+ end;
+basepoint_horizontal := basepoint_horizontal + shift_amount(p);
+ {shift the box `right'}
+if list_ptr(p)=null then begin
+ cur_v:=cur_v+effective_vertical;
+ end
+else begin
+ synch_h; synch_v; edge_v:=cur_v;
+ cur_h:=left_edge + basepoint_horizontal;
+ cur_v:=cur_v + basepoint_vertical;
+ synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+ temp_ptr:=p;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=left_edge; cur_v:=edge_v + effective_vertical;
+ end
+end
+@z
+%-------------------------
+@x [32] m.633
+ dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+@y
+ case font_direction(dvi_direction) of
+ dir__LT: begin
+ dvi_put_rule(rule_ht)(rule_wd);
+ end;
+ dir__LB: begin
+ dvi_down(rule_ht);
+ dvi_put_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__RT: begin
+ dvi_left(rule_wd);
+ dvi_set_rule(rule_ht)(rule_wd);
+ end;
+ dir__RB: begin
+ dvi_down(rule_ht);
+ dvi_left(rule_wd);
+ dvi_set_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__TL: begin
+ dvi_down(rule_wd);
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ dir__TR: begin
+ dvi_down(rule_wd);
+ dvi_put_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ dir__BL: begin
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ end;
+ dir__BR: begin
+ dvi_put_rule(rule_wd)(rule_ht);
+ end;
+ end;
+@z
+%-------------------------
+@x [32] m.635
+leader_ht:=height(leader_box)+depth(leader_box);
+@y
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+ then leader_ht:=height(leader_box)+depth(leader_box)
+else
+ leader_ht:=width(leader_box);
+@z
+%-------------------------
+@x [32] m.637
+@<Output a leader box at |cur_v|, ...@>=
+begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/
+cur_v:=cur_v+height(leader_box); synch_v; save_v:=dvi_v;
+temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_v:=save_v; dvi_h:=save_h; cur_h:=left_edge;
+cur_v:=save_v-height(leader_box)+leader_ht+lx;
+end
+@y
+@<Output a leader box at |cur_v|, ...@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+ then begin
+ effective_vertical:=height(leader_box)+depth(leader_box);
+ if (type(leader_box)=hlist_node) and (is_mirrored(box_dir(leader_box))) then
+ basepoint_vertical:=depth(leader_box)
+ else
+ basepoint_vertical:=height(leader_box);
+ if dir_opposite(dir_secondary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(leader_box)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ effective_vertical:=width(leader_box);
+ if not (is_mirrored(box_dir(leader_box))) then
+ if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(leader_box)
+ else
+ basepoint_horizontal:=depth(leader_box)
+ else
+ if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=depth(leader_box)
+ else
+ basepoint_horizontal:=height(leader_box);
+ if dir_eq(dir_secondary[box_dir(leader_box)])(dir_primary[dvi_direction]) then
+ basepoint_vertical:= width(leader_box)
+ else
+ basepoint_vertical:= 0;
+ end;
+basepoint_horizontal := basepoint_horizontal + shift_amount(leader_box);
+ {shift the box `right'}
+temp_ptr:=leader_box;
+cur_h:=left_edge + basepoint_horizontal;
+edge_v:=cur_v ;
+cur_v:=cur_v + basepoint_vertical;
+synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_h:=save_h; dvi_v:=save_v;
+cur_h:=left_edge; cur_v:=edge_v+leader_ht+lx;
+end
+@z
+%-------------------------
+@x [32] m.640
+cur_v:=height(p)+v_offset; temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+@y
+dvi_direction:=page_direction;
+case box_direction(dvi_direction) of
+dir_TL_,dir_LT_: begin
+ end;
+dir_TR_,dir_RT_: begin
+ dvi_right(page_right_offset);
+ end;
+dir_RB_,dir_BR_: begin
+ dvi_right(page_right_offset);
+ dvi_down(page_bottom_offset);
+ end;
+dir_BL_,dir_LB_: begin
+ dvi_down(page_bottom_offset);
+ end;
+end;
+cur_h:=h_offset;
+cur_v:=height(p)+v_offset;
+case box_direction(dvi_direction) of
+dir_TL_: begin
+ dvi_down(cur_v);
+ dvi_right(cur_h);
+ end;
+dir_TR_: begin
+ dvi_down(cur_v);
+ dvi_right(-cur_h);
+ end;
+dir_LT_: begin
+ dvi_right(cur_v);
+ dvi_down(cur_h);
+ end;
+dir_LB_: begin
+ dvi_right(cur_v);
+ dvi_down(-cur_h);
+ end;
+dir_BL_: begin
+ dvi_down(-cur_v);
+ dvi_right(cur_h);
+ end;
+dir_BR_: begin
+ dvi_down(-cur_v);
+ dvi_right(-cur_h);
+ end;
+dir_RT_: begin
+ dvi_right(-cur_v);
+ dvi_down(cur_h);
+ end;
+dir_RB_: begin
+ dvi_right(-cur_v);
+ dvi_down(-cur_h);
+ end;
+end;
+dvi_h:=cur_h;
+dvi_v:=cur_v;
+temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+@z
+%-------------------------
+@x [33] m.644
+@d exactly=0 {a box dimension is pre-specified}
+@d additional=1 {a box dimension is increased from the natural one}
+@d natural==0,additional {shorthand for parameters to |hpack| and |vpack|}
+@y
+@d exactly=0 {a box dimension is pre-specified}
+@d additional=1 {a box dimension is increased from the natural one}
+@d natural==0,additional {shorthand for parameters to |hpack| and |vpack|}
+
+@<Glob...@>=
+pack_direction:integer;
+spec_direction:integer;
+
+@z
+%-------------------------
+@x [33] m.645
+@p procedure scan_spec(@!c:group_code;@!three_codes:boolean);
+ {scans a box specification and left brace}
+label found;
+var @!s:integer; {temporarily saved value}
+@!spec_code:exactly..additional;
+begin if three_codes then s:=saved(0);
+if scan_keyword("to") then spec_code:=exactly
+@.to@>
+else if scan_keyword("spread") then spec_code:=additional
+@.spread@>
+else begin spec_code:=additional; cur_val:=0;
+ goto found;
+ end;
+scan_normal_dimen;
+found: if three_codes then
+ begin saved(0):=s; incr(save_ptr);
+ end;
+saved(0):=spec_code; saved(1):=cur_val; save_ptr:=save_ptr+2;
+new_save_level(c); scan_left_brace;
+end;
+@y
+@p procedure scan_spec(@!c:group_code;@!three_codes:boolean);
+ {scans a box specification and left brace}
+label found;
+var @!s:integer; {temporarily saved value}
+@!spec_code:exactly..additional;
+begin if three_codes then s:=saved(0);
+if (c<>align_group) and (c<>vcenter_group) then begin
+ if scan_keyword("dir") then begin
+ scan_dir; spec_direction:=cur_val;
+ end;
+ end;
+if scan_keyword("to") then spec_code:=exactly
+@.to@>
+else if scan_keyword("spread") then spec_code:=additional
+@.spread@>
+else begin spec_code:=additional; cur_val:=0;
+ goto found;
+ end;
+scan_normal_dimen;
+found: if three_codes then
+ begin saved(0):=s; incr(save_ptr);
+ end;
+saved(0):=spec_code; saved(1):=cur_val;
+if (c<>align_group) and (c<>vcenter_group) then begin
+ saved(2):=spec_direction;
+ @<DIR: Adjust |text_dir_ptr| for |scan_spec|@>;
+ save_ptr:=save_ptr+4;
+ new_save_level(c); scan_left_brace;
+ eq_word_define(dir_base+body_direction_code,spec_direction);
+ eq_word_define(dir_base+par_direction_code,spec_direction);
+ eq_word_define(dir_base+text_direction_code,spec_direction);
+ eq_word_define(int_base+level_local_dir_code,cur_level);
+ end
+else begin
+ save_ptr:=save_ptr+2;
+ new_save_level(c); scan_left_brace;
+ end;
+spec_direction:=-1;
+end;
+@z
+%-------------------------
+@x [33] m.649
+@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+label reswitch, common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!q:pointer; {trails behind |p|}
+@!h,@!d,@!x:scaled; {height, depth, and natural width}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+@!f:internal_font_number; {the font in a |char_node|}
+@!i:four_quarters; {font information about a |char_node|}
+@!hd:eight_bits; {height and depth indices for a character}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+@y
+@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+label reswitch, common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!q:pointer; {trails behind |p|}
+@!h,@!d,@!x:scaled; {height, depth, and natural width}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+@!f:internal_font_number; {the font in a |char_node|}
+@!i:four_quarters; {font information about a |char_node|}
+@!hd:eight_bits; {height and depth indices for a character}
+@!dir_tmp,@!dir_ptr:pointer; {for managing the direction stack}
+@!hpack_dir:integer; {the current direction}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+if pack_direction=-1 then
+ box_dir(r):=text_direction
+else begin
+ box_dir(r):=pack_direction; pack_direction:=-1;
+ end;
+hpack_dir:=box_dir(r);
+@<DIR: Initialize |dir_ptr| for |hpack|@>;
+@z
+%-------------------------
+@x [33] m.649
+exit: hpack:=r;
+@y
+exit:
+@<DIR: Reset |dir_ptr|@>;
+hpack:=r;
+@z
+%-------------------------
+@x [33] m.653
+@<Incorporate box dimensions into the dimensions of the hbox...@>=
+begin x:=x+width(p);
+if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+if height(p)-s>h then h:=height(p)-s;
+if depth(p)+s>d then d:=depth(p)+s;
+end
+@y
+@<Incorporate box dimensions into the dimensions of the hbox...@>=
+begin
+if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
+ if dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[hpack_dir]) then begin
+ x:=x+height(p)+depth(p);
+ s:=shift_amount(p);
+ if (width(p) div 2)-s>h then h:=(width(p) div 2)-s;
+ if (width(p) div 2)+s>d then d:=(width(p) div 2)+s;
+ end
+ else if (type(p)=hlist_node) and (is_mirrored(hpack_dir)) then begin
+ x:=x+width(p);
+ s:=shift_amount(p);
+ if depth(p)-s>h then h:=depth(p)-s;
+ if height(p)+s>d then d:=height(p)+s;
+ end
+ else begin
+ x:=x+width(p);
+ s:=shift_amount(p);
+ if height(p)-s>h then h:=height(p)-s;
+ if depth(p)+s>d then d:=depth(p)+s;
+ end
+ end
+else begin
+ x:=x+width(p);
+ if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+ if height(p)-s>h then h:=height(p)-s;
+ if depth(p)+s>d then d:=depth(p)+s;
+ end;
+end
+@z
+%-------------------------
+@x [33] m.654
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+x:=x+char_width(f)(i);@/
+s:=char_height(f)(hd);@+if s>h then h:=s;
+s:=char_depth(f)(hd);@+if s>d then d:=s;
+p:=link(p);
+end
+@y
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+if is_rotated(hpack_dir) then begin
+ x:=x+char_height(f)(hd)+char_depth(f)(hd);@/
+ s:=char_width(f)(i) div 2;@+if s>h then h:=s;
+ s:=char_width(f)(i) div 2;@+if s>d then d:=s;
+ end
+else if dir_opposite(dir_tertiary[hpack_dir])(dir_tertiary[box_dir(r)])
+ then begin
+ x:=x+char_width(f)(i);@/
+ s:=char_depth(f)(hd);@+if s>h then h:=s;
+ s:=char_height(f)(hd);@+if s>d then d:=s;
+ end
+else begin
+ x:=x+char_width(f)(i);@/
+ s:=char_height(f)(hd);@+if s>h then h:=s;
+ s:=char_depth(f)(hd);@+if s>d then d:=s;
+ end;
+p:=link(p);
+end
+@z
+%-------------------------
+@x [33] m.666
+@ @<Report an overfull hbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
+ begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
+ begin while link(q)<>null do q:=link(q);
+ link(q):=new_rule;
+ width(link(q)):=overfull_rule;
+ end;
+@y
+@ @<Report an overfull hbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
+ begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
+ begin while link(q)<>null do q:=link(q);
+ link(q):=new_rule; rule_dir(link(q)):=box_dir(r);
+ width(link(q)):=overfull_rule;
+ end;
+@z
+%-------------------------
+@x [33] m.668
+@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled):
+ pointer;
+label common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!w,@!d,@!x:scaled; {width, depth, and natural height}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
+@y
+@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled):
+ pointer;
+label common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!w,@!d,@!x:scaled; {width, depth, and natural height}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
+if pack_direction=-1 then
+ box_dir(r):=body_direction
+else begin
+ box_dir(r):=pack_direction; pack_direction:=-1;
+ end;
+@z
+%-------------------------
+@x [33] m.670
+@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
+begin x:=x+d+height(p); d:=depth(p);
+if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+if width(p)+s>w then w:=width(p)+s;
+end
+@y
+@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
+begin
+if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
+ if dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[box_dir(r)]) then begin
+ x:=x+d+(width(p) div 2); d:=width(p) div 2;
+ s:=shift_amount(p);
+ if depth(p)+height(p)+s>w then w:=depth(p)+height(p)+s;
+ end
+ else if (type(p)=hlist_node) and (is_mirrored(box_dir(p))) then begin
+ x:=x+d+depth(p); d:=height(p);
+ s:=shift_amount(p);
+ if width(p)+s>w then w:=width(p)+s;
+ end
+ else begin
+ x:=x+d+height(p); d:=depth(p);
+ s:=shift_amount(p);
+ if width(p)+s>w then w:=width(p)+s;
+ end
+ end
+else
+ begin x:=x+d+height(p); d:=depth(p);
+ if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+ if width(p)+s>w then w:=width(p)+s;
+ end;
+end
+@z
+%-------------------------
+@x [33] m.679
+ begin d:=width(baseline_skip)-prev_depth-height(b);
+ if d<line_skip_limit then p:=new_param_glue(line_skip_code)
+ else begin p:=new_skip_param(baseline_skip_code);
+ width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
+ end;
+ link(tail):=p; tail:=p;
+ end;
+link(tail):=b; tail:=b; prev_depth:=depth(b);
+@y
+ begin
+ if (type(b)=hlist_node) and (is_mirrored(box_dir(b))) then
+ d:=width(baseline_skip)-prev_depth-depth(b)
+ else
+ d:=width(baseline_skip)-prev_depth-height(b);
+ if d<line_skip_limit then p:=new_param_glue(line_skip_code)
+ else begin p:=new_skip_param(baseline_skip_code);
+ width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
+ end;
+ link(tail):=p; tail:=p;
+ end;
+link(tail):=b; tail:=b;
+if (type(b)=hlist_node) and (is_mirrored(box_dir(b))) then
+ prev_depth:=height(b)
+else
+ prev_depth:=depth(b);
+@z
+%-------------------------
+@x [35] m.704
+@p function fraction_rule(@!t:scaled):pointer;
+ {construct the bar for a fraction}
+var p:pointer; {the new node}
+begin p:=new_rule; height(p):=t; depth(p):=0; fraction_rule:=p;
+end;
+@y
+@p function fraction_rule(@!t:scaled):pointer;
+ {construct the bar for a fraction}
+var p:pointer; {the new node}
+begin p:=new_rule; rule_dir(p):=math_direction;
+height(p):=t; depth(p):=0; fraction_rule:=p;
+end;
+@z
+%-------------------------
+@x [35] m.705
+@p function overbar(@!b:pointer;@!k,@!t:scaled):pointer;
+var p,@!q:pointer; {nodes being constructed}
+begin p:=new_kern(k); link(p):=b; q:=fraction_rule(t); link(q):=p;
+p:=new_kern(t); link(p):=q; overbar:=vpack(p,natural);
+end;
+@y
+@p function overbar(@!b:pointer;@!k,@!t:scaled):pointer;
+var p,@!q:pointer; {nodes being constructed}
+begin p:=new_kern(k); link(p):=b; q:=fraction_rule(t); link(q):=p;
+p:=new_kern(t); link(p):=q;
+pack_direction:=math_direction; overbar:=vpack(p,natural);
+end;
+@z
+%-------------------------
+@x [36] m.735
+procedure make_under(@!q:pointer);
+var p,@!x,@!y: pointer; {temporary registers for box construction}
+@!delta:scaled; {overall height plus depth}
+begin x:=clean_box(nucleus(q),cur_style);
+p:=new_kern(3*default_rule_thickness); link(x):=p;
+link(p):=fraction_rule(default_rule_thickness);
+y:=vpack(x,natural);
+delta:=height(y)+depth(y)+default_rule_thickness;
+height(y):=height(x); depth(y):=delta-height(y);
+info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+end;
+@y
+procedure make_under(@!q:pointer);
+var p,@!x,@!y: pointer; {temporary registers for box construction}
+@!delta:scaled; {overall height plus depth}
+begin x:=clean_box(nucleus(q),cur_style);
+p:=new_kern(3*default_rule_thickness); link(x):=p;
+link(p):=fraction_rule(default_rule_thickness);
+pack_direction:=math_direction; y:=vpack(x,natural);
+delta:=height(y)+depth(y)+default_rule_thickness;
+height(y):=height(x); depth(y):=delta-height(y);
+info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+end;
+@z
+%-------------------------
+@x [36] m.738
+ y:=vpack(y,natural); width(y):=width(x);
+@y
+ pack_direction:=math_direction;
+ y:=vpack(y,natural); width(y):=width(x);
+@z
+%-------------------------
+@x [36] m.759
+x:=vpack(x,natural); shift_amount(x):=shift_down;
+@y
+pack_direction:=math_direction;
+x:=vpack(x,natural); shift_amount(x):=shift_down;
+@z
+%-------------------------
+@x [38] m.814
+@!internal_right_box_width:integer; {running \.{\\localrightbox} width}
+@!temp_no_whatsits:integer; {used when closing group}
+
+@ @<Set init...@>=
+@y
+@!internal_right_box_width:integer; {running \.{\\localrightbox} width}
+@!paragraph_dir:integer; {main direction of paragraph}
+@!line_break_dir:integer; {current direction within paragraph}
+@!break_c_htdp:quarterword; {height-depth entry in |char_info|}
+@!temp_no_whatsits:integer; {used when closing group}
+@!temp_no_dirs:integer; {used when closing group}
+@!temporary_dir:integer;
+@!dir_ptr,@!dir_tmp,@!dir_rover:pointer;
+
+@ @<Set init...@>=
+temp_no_whatsits:=0; temp_no_dirs:=0; temporary_dir:=0;
+dir_ptr:=null; dir_tmp:=null; dir_rover:=null;
+@z
+%-------------------------
+@x [39] m.816
+link(tail):=new_param_glue(par_fill_skip_code);
+@y
+final_par_glue:=new_param_glue(par_fill_skip_code);
+link(tail):=final_par_glue;
+@z
+%-------------------------
+@x [38] m.816
+init_cur_lang:=prev_graf mod @'200000;
+init_l_hyf:=prev_graf div @'20000000;
+init_r_hyf:=(prev_graf div @'200000) mod @'100;
+@y
+init_cur_lang:=prev_graf mod @'200000;
+init_l_hyf:=prev_graf div @'20000000;
+init_r_hyf:=(prev_graf div @'200000) mod @'100;
+paragraph_dir:=local_par_dir(link(head));
+line_break_dir:=paragraph_dir;
+@<DIR: Initialize |dir_ptr| for |line_break|@>;
+@z
+%-------------------------
+@x [39] m.821
+@!pass_number:halfword; {the number of passive nodes allocated on this pass}
+@y
+@!pass_number:halfword; {the number of passive nodes allocated on this pass}
+@!final_par_glue:pointer;
+@z
+%-------------------------
+@x [38] m.841
+@<Subtract the width of node |v|...@>=
+if is_char_node(v) then
+ begin f:=font(v);
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+else case type(v) of
+ ligature_node: begin f:=font(lig_char(v));@/
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]-width(v);
+@y
+@<Subtract the width of node |v|...@>=
+if is_char_node(v) then
+ begin f:=font(v);
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(v)));
+ break_width[1]:=break_width[1]-char_height(f)(break_c_htdp)
+ -char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+else case type(v) of
+ ligature_node: begin f:=font(lig_char(v));@/
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(v))));
+ break_width[1]:=break_width[1]-char_height(f)(break_c_htdp)
+ -char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(v)])(dir_primary[line_break_dir]))
+ then break_width[1]:=break_width[1]-width(v)
+ else
+ break_width[1]:=break_width[1]-(depth(v)+height(v));
+ rule_node,kern_node:
+ break_width[1]:=break_width[1]-width(v);
+@z
+%-------------------------
+@x [38] m.842
+@ @<Add the width of node |s| to |b...@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]+width(s);
+@y
+@ @<Add the width of node |s| to |b...@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(s)));
+ break_width[1]:=break_width[1]+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(s))));
+ break_width[1]:=break_width[1]+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(s)])(dir_primary[line_break_dir]))
+ then break_width[1]:=break_width[1]+width(s)
+ else
+ break_width[1]:=break_width[1]+(depth(s)+height(s));
+ rule_node,kern_node:
+ break_width[1]:=break_width[1]+width(s);
+@z
+%-------------------------
+@x [38] m.844
+passive_right_box_width(q):=internal_right_box_width;
+@y
+passive_right_box_width(q):=internal_right_box_width;
+@z
+%-------------------------
+@x [38] m.866
+hlist_node,vlist_node,rule_node: act_width:=act_width+width(cur_p);
+@y
+hlist_node,vlist_node:
+if not (dir_orthogonal(dir_primary[box_dir(cur_p)])(dir_primary[line_break_dir]))
+then act_width:=act_width+width(cur_p)
+else act_width:=act_width+(depth(cur_p)+height(cur_p));
+rule_node: act_width:=act_width+width(cur_p);
+@z
+%-------------------------
+@x [38] m.866
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+@y
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(cur_p))));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+@z
+%-------------------------
+@x [38] m.867
+act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+@y
+if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(cur_p)));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+else
+ act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+@z
+%-------------------------
+@x [38] m.870
+@ @<Add the width of node |s| to |disc_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ disc_width:=disc_width+width(s);
+@y
+@ @<Add the width of node |s| to |disc_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(s)));
+ disc_width:=disc_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(s))));
+ disc_width:=disc_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(s)])(dir_primary[line_break_dir]))
+ then disc_width:=disc_width+width(s)
+ else disc_width:=disc_width+(depth(s)+height(s));
+ rule_node,kern_node:
+ disc_width:=disc_width+width(s);
+@z
+%-------------------------
+@x [38] m.871
+@ @<Add the width of node |s| to |act_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ act_width:=act_width+width(s);
+@y
+@ @<Add the width of node |s| to |act_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(s)));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(s))));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(s)])(dir_primary[line_break_dir]))
+ then act_width:=act_width+width(s)
+ else act_width:=act_width+(depth(s)+height(s));
+ rule_node,kern_node:
+ act_width:=act_width+width(s);
+@z
+%-------------------------
+@x [39] m.877
+@ The total number of lines that will be set by |post_line_break|
+is |best_line-prev_graf-1|. The last breakpoint is specified by
+|break_node(best_bet)|, and this passive node points to the other breakpoints
+via the |prev_break| links. The finishing-up phase starts by linking the
+relevant passive nodes in forward order, changing |prev_break| to
+|next_break|. (The |next_break| fields actually reside in the same memory
+space as the |prev_break| fields did, but we give them a new name because
+of their new significance.) Then the lines are justified, one by one.
+
+@d next_break==prev_break {new name for |prev_break| after links are reversed}
+
+@<Declare subprocedures for |line_break|@>=
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@!disc_break:boolean; {was the current break at a discretionary node?}
+@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
+@!cur_width:scaled; {width of line number |cur_line|}
+@!cur_indent:scaled; {left margin of line number |cur_line|}
+@!t:quarterword; {used for replacement counts in discretionary nodes}
+@!pen:integer; {use when calculating penalties between lines}
+@!cur_line: halfword; {the current line number being justified}
+begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+ first breakpoint@>;
+cur_line:=prev_graf+1;
+repeat @<Justify the line ending at breakpoint |cur_p|, and append it to the
+ current vertical list, together with associated penalties and other
+ insertions@>;
+incr(cur_line); cur_p:=next_break(cur_p);
+if cur_p<>null then if not post_disc_break then
+ @<Prune unwanted nodes at the beginning of the next line@>;
+until cur_p=null;
+if (cur_line<>best_line)or(link(temp_head)<>null) then
+ confusion("line breaking");
+@:this can't happen line breaking}{\quad line breaking@>
+prev_graf:=best_line-1;
+end;
+@y
+@ The total number of lines that will be set by |post_line_break|
+is |best_line-prev_graf-1|. The last breakpoint is specified by
+|break_node(best_bet)|, and this passive node points to the other breakpoints
+via the |prev_break| links. The finishing-up phase starts by linking the
+relevant passive nodes in forward order, changing |prev_break| to
+|next_break|. (The |next_break| fields actually reside in the same memory
+space as the |prev_break| fields did, but we give them a new name because
+of their new significance.) Then the lines are justified, one by one.
+
+The |post_line_break| must also keep an dir stack, so that it can
+output end direction instructions at the ends of lines
+and begin direction instructions at the beginnings of lines.
+
+@d next_break==prev_break {new name for |prev_break| after links are reversed}
+
+@<Declare subprocedures for |line_break|@>=
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@!disc_break:boolean; {was the current break at a discretionary node?}
+@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
+@!cur_width:scaled; {width of line number |cur_line|}
+@!cur_indent:scaled; {left margin of line number |cur_line|}
+@!t:quarterword; {used for replacement counts in discretionary nodes}
+@!pen:integer; {use when calculating penalties between lines}
+@!cur_line: halfword; {the current line number being justified}
+begin dir_ptr:=dir_save;
+@<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+ first breakpoint@>;
+cur_line:=prev_graf+1;
+repeat @<Justify the line ending at breakpoint |cur_p|, and append it to the
+ current vertical list, together with associated penalties and other
+ insertions@>;
+incr(cur_line); cur_p:=next_break(cur_p);
+if cur_p<>null then if not post_disc_break then
+ @<Prune unwanted nodes at the beginning of the next line@>;
+until cur_p=null;
+if (cur_line<>best_line)or(link(temp_head)<>null) then
+ confusion("line breaking");
+@:this can't happen line breaking}{\quad line breaking@>
+prev_graf:=best_line-1; dir_save:=dir_ptr;
+end;
+@z
+%-------------------------
+@x [39] m.880
+@<Justify the line ending at breakpoint |cur_p|, and append it...@>=
+@<Modify the end of the line to reflect the nature of the break and to include
+ \.{\\rightskip}; also set the proper value of |disc_break|@>;
+@<Put the \(l)\.{\\leftskip} glue at the left and detach this line@>;
+@y
+@<Justify the line ending at breakpoint |cur_p|, and append it...@>=
+@<DIR: Insert dir nodes at the beginning of the current line@>;
+@<DIR: Adjust the dir stack based on dir nodes in this line@>;
+@<Modify the end of the line to reflect the nature of the break and to include
+ \.{\\rightskip}; also set the proper value of |disc_break|@>;
+@<Put the \(l)\.{\\leftskip} glue at the left and detach this line@>;
+@z
+%-------------------------
+@x [39] m.881
+ if passive_right_box(cur_p)<>null then begin
+ r:=temp_head;
+ while link(r)<>q do r:=link(r);
+ s:=copy_node_list(passive_right_box(cur_p));
+ link(r):=s;
+ link(s):=q;
+ end;
+ delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+@y
+ if passive_right_box(cur_p)<>null then begin
+ r:=temp_head;
+ while link(r)<>q do r:=link(r);
+ @<DIR: Insert dir nodes at the end of the current line@>;
+ s:=copy_node_list(passive_right_box(cur_p));
+ link(r):=s;
+ link(s):=q;
+ end
+ else begin
+ r:=temp_head;
+ while link(r)<>q do r:=link(r);
+ @<DIR: Insert dir nodes at the end of the current line@>;
+ end;
+ delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+r:=q;
+@<DIR: Insert dir nodes at the end of the current line@>;
+@z
+%-------------------------
+@x [39] m.888
+append_to_vlist(just_box);
+if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+adjust_tail:=null
+@y
+append_to_vlist(just_box);
+if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+adjust_tail:=null
+@z
+%-------------------------
+@x [39] m.888
+adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly);
+@y
+adjust_tail:=adjust_head;
+pack_direction:=paragraph_dir;
+just_box:=hpack(q,cur_width,exactly);
+@z
+%-------------------------
+@x [44] m.977
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+ {extracts a page of height |h| from box |n|}
+label exit,done;
+var v:pointer; {the box to be split}
+p:pointer; {runs through the vlist}
+q:pointer; {points to where the break occurs}
+begin v:=box(n);
+if split_first_mark<>null then
+ begin delete_token_ref(split_first_mark); split_first_mark:=null;
+ delete_token_ref(split_bot_mark); split_bot_mark:=null;
+ end;
+@<Dispense with trivial cases of void or bad boxes@>;
+q:=vert_break(list_ptr(v),h,split_max_depth);
+@<Look at all the marks in nodes before the break, and set the final
+ link to |null| at the break@>;
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+@y
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+ {extracts a page of height |h| from box |n|}
+label exit,done;
+var v:pointer; {the box to be split}
+vdir:integer; {the direction of the box to be split}
+p:pointer; {runs through the vlist}
+q:pointer; {points to where the break occurs}
+begin v:=box(n); vdir:=box_dir(v);
+if split_first_mark<>null then
+ begin delete_token_ref(split_first_mark); split_first_mark:=null;
+ delete_token_ref(split_bot_mark); split_bot_mark:=null;
+ end;
+@<Dispense with trivial cases of void or bad boxes@>;
+q:=vert_break(list_ptr(v),h,split_max_depth);
+@<Look at all the marks in nodes before the break, and set the final
+ link to |null| at the break@>;
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+pack_direction:=vdir;
+@z
+%-------------------------
+@x [45] m.1001
+if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+else width(temp_ptr):=0;
+@y
+if (type(p)=hlist_node) and (is_mirrored(body_direction)) then begin
+ if width(temp_ptr)>depth(p) then width(temp_ptr):=width(temp_ptr)-depth(p)
+ else width(temp_ptr):=0;
+ end
+else begin
+ if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+ else width(temp_ptr):=0;
+ end;
+@z
+%-------------------------
+@x [45] m.1002
+begin page_total:=page_total+page_depth+height(p);
+page_depth:=depth(p);
+@y
+begin
+if (type(p)=hlist_node) and (is_mirrored(body_direction)) then begin
+ page_total:=page_total+page_depth+depth(p);
+ page_depth:=height(p);
+ end
+else begin
+ page_total:=page_total+page_depth+height(p);
+ page_depth:=depth(p);
+ end;
+@z
+%-------------------------
+@x [45] m.1017
+set_equiv(box_base+255,
+ vpackage(link(page_head),best_size,exactly,page_max_depth));
+@y
+pack_direction:=body_direction;
+set_equiv(box_base+255,
+ vpackage(link(page_head),best_size,exactly,page_max_depth));
+@z
+%-------------------------
+@x [45] m.1021
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+@y
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+pack_direction:=body_direction;
+@z
+%-------------------------
+@x [47] m.1063
+non_math(left_brace): begin
+ new_save_level(simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ end;
+any_mode(begin_group): begin
+ new_save_level(semi_simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ end;
+any_mode(end_group):
+ if cur_group=semi_simple_group then begin
+ temp_no_whatsits:=no_local_whatsits;
+ unsave;
+ if temp_no_whatsits<>0 then
+ if abs(mode)=hmode then @<LOCAL: Add local paragraph node@>;
+ end
+ else off_save;
+@y
+non_math(left_brace): begin
+ new_save_level(simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ eq_word_define(int_base+no_local_dirs_code,0);
+ end;
+any_mode(begin_group): begin
+ new_save_level(semi_simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ eq_word_define(int_base+no_local_dirs_code,0);
+ end;
+any_mode(end_group):
+ if cur_group=semi_simple_group then begin
+ temp_no_whatsits:=no_local_whatsits;
+ temp_no_dirs:=no_local_dirs;
+ temporary_dir:=text_direction;
+ if dir_level(text_dir_ptr)=cur_level then
+ @<DIR: Remove from |text_dir_ptr|@>;
+ unsave;
+ if abs(mode)=hmode then begin
+ if temp_no_dirs<>0 then begin
+ @<DIR: Add local dir node@>;
+ dir_dir(tail):=temporary_dir-64;
+ end;
+ if temp_no_whatsits<>0 then
+ @<LOCAL: Add local paragraph node@>;
+ end
+ end
+ else off_save;
+@z
+%-------------------------
+@x [47] m.1068
+simple_group: begin
+ temp_no_whatsits:=no_local_whatsits;
+ unsave;
+ if temp_no_whatsits<>0 then
+ if abs(mode)=hmode then @<LOCAL: Add local paragraph node@>;
+ end;
+@y
+simple_group: begin
+ temp_no_whatsits:=no_local_whatsits;
+ temp_no_dirs:=no_local_dirs;
+ temporary_dir:=text_direction;
+ if dir_level(text_dir_ptr)=cur_level then
+ @<DIR: Remove from |text_dir_ptr|@>;
+ unsave;
+ if abs(mode)=hmode then begin
+ if temp_no_dirs<>0 then begin
+ @<DIR: Add local dir node@>;
+ dir_dir(tail):=temporary_dir-64;
+ end;
+ if temp_no_whatsits<>0 then
+ @<LOCAL: Add local paragraph node@>;
+ end
+ end;
+@z
+%-------------------------
+@x [47] m.1083
+begin k:=cur_chr-vtop_code; saved(0):=box_context;
+if k=hmode then
+ if (box_context<box_flag)and(abs(mode)=vmode) then
+ scan_spec(adjusted_hbox_group,true)
+ else scan_spec(hbox_group,true)
+else begin if k=vmode then scan_spec(vbox_group,true)
+ else begin scan_spec(vtop_group,true); k:=vmode;
+ end;
+ normal_paragraph;
+ end;
+push_nest; mode:=-k;
+@y
+begin k:=cur_chr-vtop_code; saved(0):=box_context;
+case abs(mode) of
+vmode: spec_direction:=body_direction;
+hmode: spec_direction:=text_direction;
+mmode: spec_direction:=math_direction;
+end;
+if k=hmode then
+ if (box_context<box_flag)and(abs(mode)=vmode) then
+ scan_spec(adjusted_hbox_group,true)
+ else scan_spec(hbox_group,true)
+else begin if k=vmode then scan_spec(vbox_group,true)
+ else begin scan_spec(vtop_group,true); k:=vmode;
+ end;
+ normal_paragraph;
+ end;
+push_nest; mode:=-k;
+@z
+%-------------------------
+@x [47] m.1086
+procedure package(@!c:small_number);
+var h:scaled; {height of box}
+@!p:pointer; {first node in a box}
+@!d:scaled; {max depth}
+begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3;
+if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
+else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
+ if c=vtop_code then @<Readjust the height and depth of |cur_box|,
+ for \.{\\vtop}@>;
+ end;
+pop_nest; box_end(saved(0));
+end;
+@y
+procedure package(@!c:small_number);
+var h:scaled; {height of box}
+@!p:pointer; {first node in a box}
+@!d:scaled; {max depth}
+begin d:=box_max_depth; unsave; save_ptr:=save_ptr-5;
+pack_direction:=saved(3);
+if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
+else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
+ if c=vtop_code then @<Readjust the height and depth of |cur_box|,
+ for \.{\\vtop}@>;
+ end;
+if saved(4)<>null then
+ @<DIR: Adjust back |text_dir_ptr| for |scan_spec|@>;
+pop_nest; box_end(saved(0));
+end;
+@z
+%-------------------------
+@x [47] m.1091
+procedure new_graf(@!indented:boolean);
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ tail:=new_null_box; link(link(head)):=tail; width(tail):=par_indent;@+
+ end;
+@y
+procedure new_graf(@!indented:boolean);
+var p,q,dir_graf_tmp:pointer;
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+q:=tail;
+dir_rover:=text_dir_ptr;
+while dir_rover<>null do
+ begin
+ if (link(dir_rover)<>null) or (dir_dir(dir_rover)<>par_direction) then
+ begin
+ dir_graf_tmp:=new_dir(dir_dir(dir_rover));
+ link(dir_graf_tmp):=link(q); link(q):=dir_graf_tmp;
+ end;
+ dir_rover:=link(dir_rover);
+ end;
+q:=head;
+while link(q)<>null do q:=link(q);
+tail:=q;
+@z
+%-------------------------
+@x [47] m.1096
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+ else line_break(widow_penalty);
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@y
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+ else line_break(widow_penalty);
+ if dir_save<>null then
+ begin flush_node_list(dir_save); dir_save:=null;
+ end;
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@z
+%-------------------------
+@x [48] m.1136
+procedure push_math(@!c:group_code);
+begin push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
+end;
+@y
+procedure push_math(@!c:group_code);
+begin
+if math_direction<>text_direction then dir_math_save:=true;
+push_nest; mode:=-mmode; incompleat_noad:=null;
+@<DIR: |new_save_level| math@>;
+end;
+@z
+%-------------------------
+@x [48] m.1174
+begin unsave; p:=fin_mlist(null);
+@y
+begin @<DIR: |unsave| math@>; p:=fin_mlist(null);
+@z
+%-------------------------
+@x [48] m.1186
+math_group: begin unsave; decr(save_ptr);@/
+@y
+math_group: begin @<DIR: |unsave| math@>; decr(save_ptr);@/
+@z
+%-------------------------
+@x [48] m.1191
+ else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
+@y
+ else begin p:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+@z
+%-------------------------
+@x [48] m.1194
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ unsave; decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+@y
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ @<DIR: |unsave| math@>;
+ decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+@z
+%-------------------------
+@x [48] m.1196
+@<Finish math in text@>=
+begin tail_append(new_math(math_surround,before));
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+tail_append(new_math(math_surround,after));
+space_factor:=1000; unsave;
+end
+@y
+@<Finish math in text@> =
+begin tail_append(new_math(math_surround,before));
+if dir_math_save then
+ @<Append a begin direction to the tail of the current list@>;
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+if dir_math_save then
+ @<Append an end direction to the tail of the current list@>;
+dir_math_save:=false;
+tail_append(new_math(math_surround,after));
+space_factor:=1000;
+@<DIR: |unsave| math@>;
+end
+@z
+%-------------------------
+@x [48] m.1200
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+unsave; prev_graf:=prev_graf+3;
+@y
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+@<DIR: |unsave| math@>;
+prev_graf:=prev_graf+3;
+@z
+%-------------------------
+@x [49] m.1210
+any_mode(assign_int),
+@y
+any_mode(assign_int),
+any_mode(assign_dir),
+@z
+%-------------------------
+@x [49] m.1228
+assign_dimen: begin p:=cur_chr; scan_optional_equals;
+ scan_normal_dimen; word_define(p,cur_val);
+ end;
+@y
+assign_dir: begin
+ @<DIR: Assign direction codes@>
+ end;
+assign_dimen: begin p:=cur_chr; scan_optional_equals;
+ scan_normal_dimen; word_define(p,cur_val);
+ end;
+@z
+%-------------------------
+@x [49] m.1257
+@!flushable_string:str_number; {string not yet referenced}
+@y
+@!natural_dir:integer;{the natural direction of the font}
+@!flushable_string:str_number; {string not yet referenced}
+@z
+%-------------------------
+@x [49] m.1257
+if scan_keyword("offset") then begin
+ scan_int;
+ offset:=cur_val;
+ if (cur_val<0) then begin
+ print_err("Illegal offset has been changed to 0");
+ help1("The offset must be bigger than 0."); int_error(cur_val);
+ offset:=0;
+ end
+ end
+else offset:=0;
+name_in_progress:=false;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s,offset);
+@y
+if scan_keyword("offset") then begin
+ scan_int;
+ offset:=cur_val;
+ if (cur_val<0) then begin
+ print_err("Illegal offset has been changed to 0");
+ help1("The offset must be bigger than 0."); int_error(cur_val);
+ offset:=0;
+ end
+ end
+else offset:=0;
+if scan_keyword("naturaldir") then begin
+ scan_dir;
+ natural_dir:=cur_val;
+ end
+else natural_dir:=-1;
+name_in_progress:=false;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s,offset,natural_dir);
+@z
+%-------------------------
+@x [51] m.1337
+if (loc<limit)and(cat_code(buffer[loc])<>escape) then start_input;
+ {\.{\\input} assumed}
+@y
+if (loc<limit)and(cat_code(buffer[loc])<>escape) then start_input;
+ {\.{\\input} assumed}
+@<DIR: Initialize |text_dir_ptr|@>;
+@z
+%-------------------------
+@x [53] m.1341
+@d language_node=4 {|subtype| in whatsits that change the current language}
+@y
+@d language_node=4 {|subtype| in whatsits that change the current language}
+@d dir_node_size=4 {number of words in change direction node}
+@d dir_dir(#)==info(#+1) {keep the direction to be taken}
+@d dir_level(#)==link(#+1) {the save level at which the direction was defined}
+@d dir_dvi_ptr(#)==info(#+2) {for reflecting dvi output}
+@d dir_dvi_h(#)==info(#+3) {for reflecting dvi output}
+@z
+%-------------------------
+@x [53] m.1342
+@!write_open:array[0..17] of boolean;
+@y
+@!write_open:array[0..17] of boolean;
+@!neg_wd:scaled;
+@!pos_wd:scaled;
+@!neg_ht:scaled;
+@!dvi_direction:integer;
+@!dir_primary:array[0..31] of 0..31;
+@!dir_secondary:array[0..31] of 0..31;
+@!dir_tertiary:array[0..31] of 0..31;
+@!dir_rearrange:array[0..3] of 0..31;
+@!dir_names:array[0..3] of str_number;
+@!text_dir_ptr:pointer;
+@!text_dir_tmp:pointer;
+@z
+%-------------------------
+@x [53] m.1343
+for k:=0 to 17 do write_open[k]:=false;
+@y
+for k:=0 to 17 do write_open[k]:=false;
+set_new_eqtb_int(dir_base+page_direction_code,0);
+set_new_eqtb_int(dir_base+body_direction_code,0);
+set_new_eqtb_int(dir_base+par_direction_code,0);
+set_new_eqtb_int(dir_base+text_direction_code,0);
+set_new_eqtb_int(dir_base+math_direction_code,0);
+pack_direction:=-1;
+set_new_eqtb_sc(dimen_base+page_height_code,55380984); {29.7cm}
+set_new_eqtb_sc(dimen_base+page_width_code,39158276); {21cm}
+set_new_eqtb_sc(dimen_base+page_bottom_offset_code,page_height-9472573);
+ {-2 inches}
+set_new_eqtb_sc(dimen_base+page_right_offset_code,page_width-9472573);
+ {-2 inches}
+for k:= 0 to 7 do begin
+ dir_primary [k ]:=dir_T;
+ dir_primary [k+ 8]:=dir_L;
+ dir_primary [k+16]:=dir_B;
+ dir_primary [k+24]:=dir_R;
+ end;
+for k:= 0 to 3 do begin
+ dir_secondary[k ]:=dir_L;
+ dir_secondary[k+ 4]:=dir_R;
+ dir_secondary[k+ 8]:=dir_T;
+ dir_secondary[k+12]:=dir_B;
+
+ dir_secondary[k+16]:=dir_L;
+ dir_secondary[k+20]:=dir_R;
+ dir_secondary[k+24]:=dir_T;
+ dir_secondary[k+28]:=dir_B;
+ end;
+for k:=0 to 7 do begin
+ dir_tertiary[k*4 ]:=dir_T;
+ dir_tertiary[k*4+1]:=dir_L;
+ dir_tertiary[k*4+2]:=dir_B;
+ dir_tertiary[k*4+3]:=dir_R;
+ end;
+dir_rearrange[0]:=0;
+dir_rearrange[1]:=0;
+dir_rearrange[2]:=1;
+dir_rearrange[3]:=1;
+dir_names[0]:="T";
+dir_names[1]:="L";
+dir_names[2]:="B";
+dir_names[3]:="R";
+@z
+%-------------------------
+@x [53] m.1344
+@d local_par_node=6 {|subtype| in whatsits for local paragraph node}
+@y
+@d local_par_node=6 {|subtype| in whatsits for local paragraph node}
+@d dir_node=7 {|subtype| in whatsits for change direction node}
+@z
+%-------------------------
+@x [53] m.1344
+primitive("localinterlinepenalty",assign_int,local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,local_broken_penalty_code);@/
+@y
+primitive("localinterlinepenalty",assign_int,local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,local_broken_penalty_code);@/
+primitive("pagedir",assign_dir,dir_base+page_direction_code);@/
+primitive("bodydir",assign_dir,dir_base+body_direction_code);@/
+primitive("pardir",assign_dir,dir_base+par_direction_code);@/
+primitive("textdir",assign_dir,dir_base+text_direction_code);@/
+primitive("mathdir",assign_dir,dir_base+math_direction_code);@/
+primitive("pageheight",assign_dimen,dimen_base+page_height_code);@/
+primitive("pagewidth",assign_dimen,dimen_base+page_width_code);@/
+{
+|primitive("pagerightoffset",assign_dimen,dimen_base+page_right_offset_code);|
+|primitive("pagebottomoffset",assign_dimen,dimen_base+page_bottom_offset_code);|
+}
+@z
+%-------------------------
+@x [53] m.1346
+ set_language_code:print_esc("setlanguage");
+ othercases print("[unknown extension!]")
+ endcases;
+@y
+ set_language_code:print_esc("setlanguage");
+ othercases print("[unknown extension!]")
+ endcases;
+@z
+%-------------------------
+@x [53] m.1348
+set_language_code:@<Implement \.{\\setlanguage}@>;
+@y
+set_language_code:@<Implement \.{\\setlanguage}@>;
+@z
+%-------------------------
+@x [53] m.1356
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+@y
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+dir_node:
+ if dir_dir(p)<0 then begin
+ print_esc("enddir"); print(" "); print_dir(dir_dir(p)+64);
+ end
+ else begin
+ print_esc("begindir"); print(" "); print_dir(dir_dir(p));
+ end;
+@z
+%-------------------------
+@x [53] m.1357
+close_node,language_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+@y
+close_node,language_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+dir_node: begin r:=get_node(dir_node_size);
+ words:=dir_node_size;
+ end;
+@z
+%-------------------------
+@x [53] m.1358
+close_node,language_node: free_node(p,small_node_size);
+@y
+close_node,language_node: free_node(p,small_node_size);
+dir_node: free_node(p,dir_node_size);
+@z
+%-------------------------
+@x [53] m.1360
+@ @<Incorporate a whatsit node into an hbox@>=do_nothing
+@y
+@ @<Incorporate a whatsit node into an hbox@>=
+begin
+if subtype(p)=dir_node then
+ begin
+ @<DIR: Adjust the dir stack for the |hpack| routine@>;
+ end;
+end
+@z
+%-------------------------
+@x [53] m.1362
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p) else @<LOCAL: Advance past a |local_paragraph| node@>
+@y
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p) else @<LOCAL: Advance past a |local_paragraph| node@>
+else @<DIR: Adjust the dir stack for the |line_break| routine@>
+@z
+%-------------------------
+@x [53] m.1366
+@ @<Output the whatsit node |p| in an hlist@>=
+out_what(p)
+@y
+@ @<Output the whatsit node |p| in an hlist@>=
+if subtype(p)<>dir_node then out_what(p)
+else @<Output a reflection instruction if the direction has changed@>
+@z
+%-------------------------
+@x
+@d local_par_size==7
+@y
+@d local_par_dir(#)==mem[#+7].int
+@d local_par_size==8
+@z
+%-------------------------
+@x
+make_local_par_node:=p;
+@y
+local_par_dir(p):=par_direction;
+make_local_par_node:=p;
+@z
+%-------------------------
+@x
+@ @<LOCAL: local paragraph node@>=
+((type(q)=whatsit_node) and (subtype(q)=local_par_node))
+
+@y
+@ @<LOCAL: local paragraph node@>=
+((type(q)=whatsit_node) and (subtype(q)=local_par_node))
+
+@ @<DIR: Assign direction codes@>=
+case cur_chr of
+dir_base+page_direction_code: begin
+ if its_all_over then begin
+ scan_dir;
+ eq_word_define(dir_base+page_direction_code,cur_val);
+ end;
+ end;
+dir_base+body_direction_code: begin
+ if its_all_over then begin
+ scan_dir;
+ eq_word_define(dir_base+body_direction_code,cur_val);
+ end;
+ end;
+dir_base+par_direction_code: begin
+ scan_dir;
+ eq_word_define(dir_base+par_direction_code,cur_val);
+ end;
+dir_base+text_direction_code: begin scan_dir;
+ if (no_local_dirs>0) and (abs(mode)=hmode) then begin
+ @<DIR: Add local dir node@>;
+ dir_dir(tail):=dir_dir(tail)-64;
+ end;
+ if dir_level(text_dir_ptr)=cur_level then
+ @<DIR: Remove from |text_dir_ptr|@>;
+ eq_word_define(dir_base+text_direction_code,cur_val);
+ @<DIR: Add to |text_dir_ptr|@>;
+ if abs(mode)=hmode then
+ begin
+ @<DIR: Add local dir node@>;
+ dir_level(tail):=cur_level;
+ end;
+ eq_word_define(int_base+no_local_dirs_code,no_local_dirs+1);
+ eq_word_define(int_base+level_local_dir_code,cur_level);
+ end;
+dir_base+math_direction_code: begin scan_dir;
+ eq_word_define(dir_base+math_direction_code,cur_val);
+ end;
+end;
+
+@
+@d push_dir(#)==
+begin dir_tmp:=new_dir(#);
+link(dir_tmp):=dir_ptr; dir_ptr:=dir_tmp;
+dir_ptr:=dir_tmp;
+end
+
+@d push_dir_node(#)==
+begin dir_tmp:=get_node(dir_node_size);
+type(dir_tmp):=whatsit_node; subtype(dir_tmp):=dir_node;
+dir_dir(dir_tmp):=dir_dir(#);
+dir_level(dir_tmp):=dir_level(#);
+dir_dvi_h(dir_tmp):=dir_dvi_h(#);
+dir_dvi_ptr(dir_tmp):=dir_dvi_ptr(#);
+link(dir_tmp):=dir_ptr; dir_ptr:=dir_tmp;
+end
+
+@d pop_dir_node==
+begin dir_tmp:=dir_ptr;
+dir_ptr:=link(dir_tmp);
+free_node(dir_tmp,dir_node_size);
+end
+
+@ @<DIR: Declare |new_dir|@>=
+function new_dir(s:small_number): pointer;
+var p:pointer; {the new node}
+begin p:=get_node(dir_node_size); type(p):=whatsit_node;
+subtype(p):=dir_node; dir_dir(p):=s;
+dir_dvi_h(p):=0; dir_dvi_ptr(p):=-1;
+dir_level(p):=cur_level; new_dir:=p;
+end
+
+@ @<Append a begin direction to the tail of the current list@>=
+tail_append(new_dir(math_direction))
+
+@ @<Append an end direction to the tail of the current list@>=
+tail_append(new_dir(math_direction-64))
+
+@ @<DIR: Add local dir node@>=
+tail_append(new_dir(text_direction))
+
+@ @<DIR: Adjust the dir stack for the |line_break| routine@>=
+if subtype(cur_p)=dir_node then
+begin
+if dir_dir(cur_p)>=0 then begin
+ line_break_dir:=dir_dir(cur_p);
+ push_dir_node(cur_p);
+ end
+else begin
+ pop_dir_node;
+ line_break_dir:=dir_dir(dir_ptr);
+ end
+end
+
+@ @<DIR: Adjust the dir stack for the |hpack| routine@>=
+begin
+if dir_dir(p)>=0 then begin
+ hpack_dir:=dir_dir(p);
+ push_dir_node(p);
+ end
+else begin
+ pop_dir_node;
+ hpack_dir:=dir_dir(dir_ptr);
+ end
+end
+
+@ @<DIR: Insert dir nodes at the beginning of the current line@>=
+begin
+dir_rover:=dir_ptr;
+while dir_rover<>null do
+ begin
+ dir_tmp:=new_dir(dir_dir(dir_rover)); link(dir_tmp):=link(temp_head);
+ link(temp_head):=dir_tmp; dir_rover:=link(dir_rover);
+ end
+end
+
+@ @<DIR: Adjust the dir stack based on dir nodes in this line@>=
+begin flush_node_list(dir_ptr); dir_ptr:=null;
+q:=link(temp_head);
+while q<>cur_break(cur_p) do
+ begin if not is_char_node(q) then
+ if type(q)=whatsit_node then
+ if subtype(q)=dir_node then begin
+ if dir_dir(q)>=0 then begin
+ push_dir_node(q)
+ end
+ else if dir_ptr<>null then
+ if dir_dir(dir_ptr)=(dir_dir(q)+64) then begin
+ pop_dir_node;
+ end;
+ end;
+ q:=link(q);
+ end
+end
+
+@ @<DIR: Insert dir nodes at the end of the current line@>=
+if dir_ptr<>null then
+ begin
+ if link(r)=q then begin
+ dir_rover:=dir_ptr;
+ while dir_rover<>null do
+ begin
+ dir_tmp:=new_dir(dir_dir(dir_rover)-64);
+ link(dir_tmp):=q;
+ link(r):=dir_tmp;
+ r:=dir_tmp;
+ dir_rover:=link(dir_rover);
+ end;
+ end
+ else if r=final_par_glue then begin
+ s:=temp_head;
+ while link(s)<>r do
+ s:=link(s);
+ dir_rover:=dir_ptr;
+ while dir_rover<>null do
+ begin
+ dir_tmp:=new_dir(dir_dir(dir_rover)-64);
+ link(dir_tmp):=q;
+ link(s):=dir_tmp;
+ s:=dir_tmp;
+ dir_rover:=link(dir_rover);
+ end;
+ end
+ else begin
+ dir_rover:=dir_ptr;
+ s:=link(q);
+ while dir_rover<>null do
+ begin
+ dir_tmp:=new_dir(dir_dir(dir_rover)-64);
+ link(dir_tmp):=s;
+ link(q):=dir_tmp;
+ q:=dir_tmp;
+ dir_rover:=link(dir_rover);
+ end;
+ r:=q;
+ end
+ end
+
+@ @<DIR: Reset |dir_ptr|@>=
+begin
+ while dir_ptr<>null do
+ pop_dir_node
+end
+
+@ @<DIR: |unsave| math@>=
+begin
+unsave;
+decr(save_ptr);
+flush_node_list(text_dir_ptr);
+text_dir_ptr:=saved(0);
+end
+
+@ @<DIR: |new_save_level| math@>=
+begin
+saved(0):=text_dir_ptr;
+text_dir_ptr:=new_dir(math_direction);
+incr(save_ptr);
+new_save_level(c);
+eq_word_define(dir_base+body_direction_code,math_direction);
+eq_word_define(dir_base+par_direction_code,math_direction);
+eq_word_define(dir_base+text_direction_code,math_direction);
+eq_word_define(int_base+level_local_dir_code,cur_level);
+end
+
+@ @<DIR: Adjust |text_dir_ptr| for |scan_spec|@>=
+begin
+if spec_direction<>-1 then begin
+ saved(3):=text_dir_ptr;
+ text_dir_ptr:=new_dir(spec_direction);
+ end
+else saved(3):=null;
+end
+
+@ @<DIR: Adjust back |text_dir_ptr| for |scan_spec|@>=
+begin
+flush_node_list(text_dir_ptr);
+text_dir_ptr:=saved(4);
+end
+
+@ @<DIR: Add to |text_dir_ptr|@>=
+begin
+text_dir_tmp:=new_dir(text_direction);
+link(text_dir_tmp):=text_dir_ptr;
+text_dir_ptr:=text_dir_tmp;
+end
+
+@ @<DIR: Remove from |text_dir_ptr|@>=
+begin
+text_dir_tmp:=link(text_dir_ptr);
+free_node(text_dir_ptr,dir_node_size);
+text_dir_ptr:=text_dir_tmp;
+end
+
+@ @<DIR: Initialize |text_dir_ptr|@>=
+begin
+text_dir_ptr:=new_dir(0);
+end
+
+@ @<DIR: Initialize |dir_ptr| for |ship_out|@>=
+begin dir_ptr:=null; push_dir(dvi_direction);
+dir_dvi_ptr(dir_ptr):=dvi_ptr;
+end
+
+@ @<DIR: Initialize |dir_ptr| for |hpack|@>=
+begin dir_ptr:=null; push_dir(hpack_dir) end
+
+@ @<DIR: Initialize |dir_ptr| for |line_break|@>=
+begin dir_ptr:=null; push_dir(paragraph_dir); end
+
+@ @<Output a reflection instruction if the direction has changed@>=
+begin
+if dir_dir(p)>=0 then
+ begin synch_h; synch_v;
+ push_dir_node(p);
+ if dir_opposite(dir_secondary[dir_dir(dir_ptr)])(dir_secondary[dvi_direction])
+ then begin
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=2) then
+ dvi_out(down4)
+ else
+ dvi_out(right4);
+ dir_dvi_ptr(dir_ptr):=dvi_ptr;
+ dir_dvi_h(dir_ptr):=dvi_h;
+ dvi_four(0);
+ cur_h:=0; dvi_h:=0;
+ end
+ else begin
+ dir_dvi_ptr(dir_ptr):=dvi_ptr;
+ dir_dvi_h(dir_ptr):=dvi_h;
+ end;
+ dvi_direction:=dir_dir(dir_ptr);
+ end
+else begin
+ dvi_dir_h:=dir_dvi_h(dir_ptr);
+ dvi_dir_ptr:=dir_dvi_ptr(dir_ptr);
+ pop_dir_node;
+ synch_h; synch_v;
+ dvi_direction:=dir_dir(dir_ptr);
+ if dir_opposite(dir_secondary[dir_dir(p)+64])(dir_secondary[dvi_direction])
+ then begin
+ dvi_temp_ptr:=dvi_ptr;
+ dvi_ptr:=dvi_dir_ptr;
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=1) then
+ dvi_four(dvi_h)
+ else
+ dvi_four(-dvi_h);
+ dvi_ptr:=dvi_temp_ptr;
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=2) then
+ dvi_out(down4)
+ else
+ dvi_out(right4);
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=1) then
+ dvi_four(dvi_h)
+ else
+ dvi_four(-dvi_h);
+ end;
+ cur_h:=dvi_dir_h+dvi_h; dvi_h:=cur_h;
+ end
+end
+@z
diff --git a/Build/source/texk/web2c/alephdir/omega.ch0 b/Build/source/texk/web2c/alephdir/omega.ch0
new file mode 100644
index 00000000000..dcd72d28087
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omega.ch0
@@ -0,0 +1,45 @@
+%
+% Copyright (c) 2002-2003 the Omega Task Force
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one resolves inconsistencies between the etex changes for
+% web2c and Omega changes for web2c.
+% Public domain.
+
+@x
+@d banner=='This is e-Omega, Version 3.141592--1.15--2.1--RC1' {printed when \TeX\ starts}
+@y
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@z
+
+@x
+wterm(eTeX_banner);
+@y
+wterm(banner);
+@z
+
+@x
+begin wlog(eTeX_banner);
+@y
+begin wlog(banner);
+@z
+
+@x [50] m.1308 l.23794 - e-TeX basic
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@/@<Undump the \eTeX\ state@>@/
+@y
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@z
+
+@x
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+ store_fmt_file; return;@+tini@/
+@y
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ store_fmt_file; return;@+tini@/
+@z
diff --git a/Build/source/texk/web2c/alephdir/omega.ch1 b/Build/source/texk/web2c/alephdir/omega.ch1
new file mode 100644
index 00000000000..a38b0ad409e
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omega.ch1
@@ -0,0 +1,155 @@
+%
+% Copyright (c) 2002-2003 the Omega Task Force
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one resolves inconsistencies between the etex changes for
+% web2c and Omega changes for web2c.
+% Public domain.
+
+@x
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@d banner_k=='This is Omegak, Version 3.141592--1.15' {printed when \TeX\ starts}
+@y
+@d banner=='This is e-Omega, Version 3.141592--1.15--2.1--RC1' {printed when \TeX\ starts}
+@d banner_k=='This is e-Omegak, Version 3.141592--1.15--2.1--RC1' {printed when \TeX\ starts}
+@z
+
+@x [1.2] l.188 - Web2C: extensions imply we're not TeX.
+@d eTeX_banner==banner
+ {printed when \eTeX\ starts}
+@y
+@d eTeX_banner==banner
+ {printed when \eTeX\ starts}
+@d eTeX_banner_k==banner_k
+@z
+
+@x
+Routine is implemented in C, module is not needed.
+@y
+Routine is implemented in C; part of module is, however, needed for e-TeX.
+
+@<Report overflow of the input buffer, and abort@>=
+ begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+@z
+
+ @x
+ wterm(banner_k)
+ @y
+ wterm(eTeX_banner_k)
+ @z
+
+ @x
+ wterm(banner);
+ @y
+ wterm(eTeX_banner);
+ @z
+
+ @x
+ wlog(banner_k)
+ @y
+ wlog(eTeX_banner_k)
+ @z
+
+ @x
+ wlog(banner);
+ @y
+ wlog(eTeX_banner);
+ @z
+
+% @x l.15074
+% @<DIR: Initialize the text direction@>;
+% @y
+% @<DIR: Initialize the text direction@>;
+% if src_specials_p then begin
+% @z
+
+% @x
+% while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+% @y
+% end;
+% while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+% @z
+
+% @x
+% begin synch_h; synch_v;
+% @y
+% begin synch_h; synch_v;
+% if src_specials_p then begin
+% @z
+
+% @x l.15115
+% repeat f:=font(p); c:=character(p);
+% incr(chars_since_last_special);
+% @y
+% end;
+% repeat f:=font(p); c:=character(p);
+% if src_specials_p then
+% incr(chars_since_last_special);
+% @z
+
+@x
+@<Append character |cur_chr|...@>=
+if ((head=tail) and (mode>0)) then begin
+ if (insert_src_special_auto) then append_src_special;
+end;
+@y
+@<Append character |cur_chr|...@>=
+@z
+
+
+@x
+begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+if (insert_src_special_every_math) then insert_src_special;
+@y
+begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+@z
+
+@x
+ push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+ if (insert_src_special_every_vbox) then insert_src_special;
+@y
+ push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+@z
+
+@x
+@!init procedure store_fmt_file;
+label found1,found2,done1,done2;
+var @!k:integer; {all-purpose indices}
+@y
+@!init procedure store_fmt_file;
+label found1,found2,done1,done2;
+var j,@!k:integer; {all-purpose indices}
+@z
+
+@x [50] m.1308 l.23794 - e-TeX basic
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+@y
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+@/@<Undump the \eTeX\ state@>@/
+@z
+
+@x
+ line_stack:=xmalloc_array (integer, max_in_open);
+@y
+ xmalloc_array (line_stack, max_in_open);
+@z
+
+@x
+ begin @!init if ini_version then
+ begin for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ store_fmt_file; return;
+ end;@+tini@/
+@y
+ begin @!init if ini_version then
+ begin for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+ store_fmt_file; return;
+ end;@+tini@/
+@z
diff --git a/Build/source/texk/web2c/alephdir/omega.ch2 b/Build/source/texk/web2c/alephdir/omega.ch2
new file mode 100644
index 00000000000..5216941f80d
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omega.ch2
@@ -0,0 +1,83 @@
+%
+% Copyright (c) 2002-2003 the Omega Task Force
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one resolves inconsistencies between the etex changes for
+% web2c and Omega changes for web2c.
+% Public domain.
+%
+
+@x [4.51] - Change `eomega.pool' to `pdftex.pool' in error messages
+else bad_pool('! I can''t read omega.pool; bad path?')
+@y
+else bad_pool('! I can''t read eomega.pool; bad path?')
+@z
+
+@x [4.51] - Change `eomega.pool' to `omega.pool' in error messages
+begin if eof(pool_file) then bad_pool('! omega.pool has no check sum.');
+@y
+begin if eof(pool_file) then bad_pool('! eomega.pool has no check sum.');
+@z
+
+@x [4.51] - Change `eomega.pool' to `omega.pool' in error messages
+ bad_pool('! omega.pool line doesn''t begin with two digits.');
+@y
+ bad_pool('! eomega.pool line doesn''t begin with two digits.');
+@z
+
+@x [4.51] - Change `eomega.pool' to `omega.pool' in error messages
+ bad_pool('! omega.pool check sum doesn''t have nine digits.');
+@y
+ bad_pool('! eomega.pool check sum doesn''t have nine digits.');
+@z
+
+@x [4.51] - Change `eomega.pool' to `omega.pool' in error messages
+ bad_pool('! omega.pool doesn''t match; otangle me again (or fix the path).');
+@y
+ bad_pool('! eomega.pool doesn''t match; otangle me again (or fix the path).');
+@z
+
+%----------------------------------------
+@x
+print_err("Omega capacity exceeded, sorry [");
+@y
+print_err("e-Omega capacity exceeded, sorry [");
+@z
+%----------------------------------------
+
+@x
+@=#include "omegamem.h";@>
+@y
+@=#include "eomegamem.h";@>
+@z
+
+@x
+ print("Omega output, Version 3.141592--1.15, ");
+@y
+ print("e-Omega output, Version 3.141592--1.15--2.1--RC1, ");
+@z
+
+@x
+if ini_version then format_ident:=" (INIOMEGA)";
+@y
+if ini_version then format_ident:=" (INIEOMEGA)";
+@z
+
+@x
+ xmalloc_array (line_stack, max_in_open);
+ xmalloc_array (eof_seen, max_in_open);
+ xmalloc_array (grp_stack, max_in_open);
+ xmalloc_array (if_stack, max_in_open);
+@y
+ line_stack:=xmalloc_array (integer, max_in_open);
+ eof_seen:=xmalloc_array (boolean, max_in_open);
+ grp_stack:=xmalloc_array (save_pointer, max_in_open);
+ if_stack:=xmalloc_array (pointer, max_in_open);
+@z
+
+@x
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+@y
+@!init if (buffer[loc]="*")and(format_ident=" (INIEOMEGA)") then
+@z
+
diff --git a/Build/source/texk/web2c/alephdir/omfi.ch b/Build/source/texk/web2c/alephdir/omfi.ch
new file mode 100644
index 00000000000..3c61add97b7
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omfi.ch
@@ -0,0 +1,246 @@
+% omfi.ch: Primitives for extra level of infinity.
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [10] m.135 l.2878 - Omega fi order of infinity
+specifies the order of infinity to which glue setting applies (|normal|,
+|fil|, |fill|, or |filll|). The |subtype| field is not used.
+@y
+specifies the order of infinity to which glue setting applies (|normal|,
+|sfi|, |fil|, |fill|, or |filll|). The |subtype| field is not used.
+@z
+%---------------------------------------
+@x [10] m.150 l.3136 - Omega fi order of infinity
+orders of infinity (|normal|, |fil|, |fill|, or |filll|)
+@y
+orders of infinity (|normal|, |sfi|, |fil|, |fill|, or |filll|)
+@z
+%---------------------------------------
+@x [10] m.150 l.3145 - Omega fi order of infinity
+@d fil=1 {first-order infinity}
+@d fill=2 {second-order infinity}
+@d filll=3 {third-order infinity}
+@y
+@d sfi=1 {first-order infinity}
+@d fil=2 {second-order infinity}
+@d fill=3 {third-order infinity}
+@d filll=4 {fourth-order infinity}
+@z
+%---------------------------------------
+@x [10] m.150 l.3150 - Omega fi order of infinity
+@!glue_ord=normal..filll; {infinity to the 0, 1, 2, or 3 power}
+@y
+@!glue_ord=normal..filll; {infinity to the 0, 1, 2, 3, or 4 power}
+@z
+%---------------------------------------
+@x [11] m.162 l.3296 - Omega fi order of infinity
+@d fil_glue==zero_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
+@y
+@d sfi_glue==zero_glue+glue_spec_size {\.{0pt plus 1fi minus 0pt}}
+@d fil_glue==sfi_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
+@z
+%---------------------------------------
+@x [11] m.164 l.3296 - Omega fi order of infinity
+stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
+@y
+stretch(sfi_glue):=unity; stretch_order(sfi_glue):=sfi;@/
+stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
+@z
+%---------------------------------------
+@x [12] m.177 l.3591 - Omega fi order of infinity
+ begin print("fil");
+ while order>fil do
+@y
+ begin print("fi");
+ while order>sfi do
+@z
+%---------------------------------------
+@x [26] m.454 l.8924 - Omega fi order of infinity
+if scan_keyword("fil") then
+@.fil@>
+ begin cur_order:=fil;
+@y
+if scan_keyword("fi") then
+@.fil@>
+ begin cur_order:=sfi;
+@z
+%---------------------------------------
+@x [33] m.650 l.12877 - Omega fi order of infinity
+total_stretch[fil]:=0; total_shrink[fil]:=0;
+@y
+total_stretch[sfi]:=0; total_shrink[sfi]:=0;
+total_stretch[fil]:=0; total_shrink[fil]:=0;
+@z
+%---------------------------------------
+@x [33] m.659 l.12996 - Omega fi order of infinity
+else if total_stretch[fil]<>0 then o:=fil
+@y
+else if total_stretch[fil]<>0 then o:=fil
+else if total_stretch[sfi]<>0 then o:=sfi
+@z
+%---------------------------------------
+@x [33] m.665 l.13061 - Omega fi order of infinity
+else if total_shrink[fil]<>0 then o:=fil
+@y
+else if total_shrink[fil]<>0 then o:=fil
+else if total_shrink[sfi]<>0 then o:=sfi
+@z
+%---------------------------------------
+@x [38] m.822 l.16135 - Omega fi order of infinity
+contains six scaled numbers, since it must record the net change in glue
+stretchability with respect to all orders of infinity. The natural width
+difference appears in |mem[q+1].sc|; the stretch differences in units of
+pt, fil, fill, and filll appear in |mem[q+2..q+5].sc|; and the shrink difference
+appears in |mem[q+6].sc|. The |subtype| field of a delta node is not used.
+
+@d delta_node_size=7 {number of words in a delta node}
+@y
+contains seven scaled numbers, since it must record the net change in glue
+stretchability with respect to all orders of infinity. The natural width
+difference appears in |mem[q+1].sc|; the stretch differences in units of
+pt, sfi, fil, fill, and filll appear in |mem[q+2..q+6].sc|; and the shrink
+difference appears in |mem[q+7].sc|. The |subtype| field of a delta node
+is not used.
+
+@d delta_node_size=8 {number of words in a delta node}
+@z
+%---------------------------------------
+@x [38] m.823 l.16144 - Omega fi order of infinity
+@ As the algorithm runs, it maintains a set of six delta-like registers
+for the length of the line following the first active breakpoint to the
+current position in the given hlist. When it makes a pass through the
+active list, it also maintains a similar set of six registers for the
+@y
+@ As the algorithm runs, it maintains a set of seven delta-like registers
+for the length of the line following the first active breakpoint to the
+current position in the given hlist. When it makes a pass through the
+active list, it also maintains a similar set of seven registers for the
+@z
+%---------------------------------------
+@x [38] m.823 l.16154 - Omega fi order of infinity
+k:=1 to 6 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
+want to do this without the overhead of |for| loops. The |do_all_six|
+macro makes such six-tuples convenient.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6)
+
+@<Glo...@>=
+@!active_width:array[1..6] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..6] of scaled; {distance from current active node}
+@!background:array[1..6] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..6] of scaled; {length being computed after current break}
+@y
+k:=1 to 7 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
+want to do this without the overhead of |for| loops. The |do_all_six|
+macro makes such six-tuples convenient.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6);#(7)
+
+@<Glo...@>=
+@!active_width:array[1..7] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..7] of scaled; {distance from current active node}
+@!background:array[1..7] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..7] of scaled; {length being computed after current break}
+@z
+%---------------------------------------
+@x [38] m.827 l.16242 - Omega fi order of infinity
+background[2]:=0; background[3]:=0; background[4]:=0; background[5]:=0;@/
+@y
+background[2]:=0; background[3]:=0; background[4]:=0; background[5]:=0;@/
+background[6]:=0;@/
+@z
+%---------------------------------------
+@x [38] m.827 l.16260 - Omega fi order of infinity
+background[6]:=shrink(q)+shrink(r);
+@y
+background[7]:=shrink(q)+shrink(r);
+@z
+%---------------------------------------
+@x [38] m.838 l.16470 - Omega fi order of infinity
+break_width[6]:=break_width[6]-shrink(v);
+@y
+break_width[7]:=break_width[7]-shrink(v);
+@z
+%---------------------------------------
+@x [38] m.852 l.16713 - Omega fi order of infinity
+subarray |cur_active_width[2..5]|, in units of points, fil, fill, and filll.
+@y
+subarray |cur_active_width[2..6]|, in units of points, sfi, fil, fill and filll.
+@z
+%---------------------------------------
+@x [38] m.852 l.16722 - Omega fi order of infinity
+if (cur_active_width[3]<>0)or(cur_active_width[4]<>0)or@|
+ (cur_active_width[5]<>0) then
+@y
+if (cur_active_width[3]<>0)or(cur_active_width[4]<>0)or@|
+ (cur_active_width[5]<>0)or(cur_active_width[6]<>0) then
+@z
+%---------------------------------------
+@x [38] m.853 l.16738 - Omega fi order of infinity
+we can shrink the line from |r| to |cur_p| by at most |cur_active_width[6]|.
+
+@<Set the value of |b| to the badness for shrinking...@>=
+begin if -shortfall>cur_active_width[6] then b:=inf_bad+1
+else b:=badness(-shortfall,cur_active_width[6]);
+@y
+we can shrink the line from |r| to |cur_p| by at most |cur_active_width[7]|.
+
+@<Set the value of |b| to the badness for shrinking...@>=
+begin if -shortfall>cur_active_width[7] then b:=inf_bad+1
+else b:=badness(-shortfall,cur_active_width[7]);
+@z
+%---------------------------------------
+@x [39] m.868 l.17054 - Omega fi order of infinity
+active_width[6]:=active_width[6]+shrink(q)
+@y
+active_width[7]:=active_width[7]+shrink(q)
+@z
+%---------------------------------------
+@x [44] m.975 l.18932 - Omega fi order of infinity
+ if (active_height[3]<>0) or (active_height[4]<>0) or
+ (active_height[5]<>0) then b:=0
+ else b:=badness(h-cur_height,active_height[2])
+else if cur_height-h>active_height[6] then b:=awful_bad
+else b:=badness(cur_height-h,active_height[6])
+@y
+ if (active_height[3]<>0) or (active_height[4]<>0) or
+ (active_height[5]<>0) or (active_height[6]<>0) then b:=0
+ else b:=badness(h-cur_height,active_height[2])
+else if cur_height-h>active_height[7] then b:=awful_bad
+else b:=badness(cur_height-h,active_height[7])
+@z
+%---------------------------------------
+@x [44] m.976 l.18947 - Omega fi order of infinity
+ active_height[6]:=active_height[6]+shrink(q);
+@y
+ active_height[7]:=active_height[7]+shrink(q);
+@z
+%---------------------------------------
+@x [48] m.1201 l.22454 - Omega fi order of infinity
+ (total_shrink[fil]<>0)or(total_shrink[fill]<>0)or
+ (total_shrink[filll]<>0)) then
+@y
+ (total_shrink[sfi]<>0)or(total_shrink[fil]<>0)or
+ (total_shrink[fill]<>0)or(total_shrink[filll]<>0)) then
+@z
+
diff --git a/Build/source/texk/web2c/alephdir/omfilter.ch b/Build/source/texk/web2c/alephdir/omfilter.ch
new file mode 100644
index 00000000000..e57dcb0ae78
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omfilter.ch
@@ -0,0 +1,942 @@
+% omfilter.ch: Running OCP programs
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.412 - Omega Filtering
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@y
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@!active_mem_size=2000; {number of words of |active_info| for active ocps}
+@z
+%---------------------------------------
+@x [5] - Omega Translation
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("Omega capacity exceeded, sorry [");
+@.TeX capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+ ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+@y
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("Omega capacity exceeded, sorry [");
+@.TeX capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+ ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+
+procedure overflow_ocp_buf_size;
+begin
+overflow("ocp_buf_size",ocp_buf_size);
+end;
+
+procedure overflow_ocp_stack_size;
+begin
+overflow("ocp_stack_size",ocp_stack_size);
+end;
+@z
+%---------------------------------------
+@x [22] m.300 l.6425 - Omega Filtering
+@!in_state_record = record
+ @!state_field, @!index_field: quarterword;
+ @!start_field,@!loc_field, @!limit_field, @!name_field: halfword;
+ end;
+@y
+@!in_state_record = record
+ @!state_field, @!index_field: quarterword;
+ @!start_field,@!loc_field, @!limit_field, @!name_field,
+ @!ocp_lstack_field: halfword; {used for omega translation processes}
+ @!ocp_no_field: halfword; {used for omega translation processes}
+ end;
+@z
+%---------------------------------------
+@x [22] m.300 l.6444 - Omega Filtering
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d name==cur_input.name_field {name of the current file}
+@y
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d name==cur_input.name_field {name of the current file}
+@d current_ocp_lstack==cur_input.ocp_lstack_field {name of the current ocp}
+@d current_ocp_no==cur_input.ocp_no_field {name of the current ocp}
+@z
+%---------------------------------------
+@x [22] m.312 l.6766 - Omega Filtering
+ if state<>token_list then
+ begin @<Print location of current line@>;
+ @<Pseudoprint the line@>;
+@y
+ if current_ocp_lstack>0 then
+ begin print_nl("OCP stack "); print_scaled(current_ocp_lstack);
+ print(" entry "); print_int(current_ocp_no); print(":");
+ @<Pseudoprint the line@>;
+ end
+ else if state<>token_list then
+ begin @<Print location of current line@>;
+ @<Pseudoprint the line@>;
+@z
+%---------------------------------------
+@x [23] m.331 l.7069 - Omega Filtering
+state:=new_line; start:=1; index:=0; line:=0; name:=0;
+@y
+state:=new_line; start:=1; index:=0; line:=0; name:=0;
+current_ocp_lstack:=0; current_ocp_no:=0;
+@z
+%---------------------------------------
+@x [24] m.343 l.7248 - Omega Filtering
+else begin state:=new_line;@/
+ @<Move to next line of file,
+@y
+else begin
+ if current_ocp_lstack>0 then
+ begin
+ pop_input; goto restart;
+ end;
+ state:=new_line;
+ @<Move to next line of file,
+@z
+%---------------------------------------
+@x [30] m.582 l.11283 - Omega Filtering
+char_warning(f,c);
+new_character:=null;
+exit:end;
+@y
+char_warning(f,c);
+new_character:=null;
+exit:end;
+
+@
+@<Types...@>=
+@!active_index=0..active_mem_size;
+
+@
+@d active_ocp(#)==active_info[#].hh.b0
+@d active_counter(#)==active_info[#].hh.b1
+@d active_lstack_no(#)==active_info[#+1].sc
+
+@<Glob...@>=
+@!active_info:array[active_index] of memory_word;
+@!active_min_ptr:active_index; {first unused word of |active_info|}
+@!active_max_ptr:active_index; {last unused word of |active_info|}
+@!active_real:active_index;
+@!holding:array[active_index] of ocp_list_index;
+
+@
+@<Initialize table...@>=
+active_min_ptr:=0;
+active_real:=0;
+
+@
+@p
+function is_last_ocp(llstack_no:scaled; counter:integer):integer;
+begin
+active_min_ptr:=equiv(ocp_active_min_ptr_base);
+active_max_ptr:=equiv(ocp_active_max_ptr_base);
+active_real:=active_min_ptr;
+while (active_real < active_max_ptr) and
+ (active_lstack_no(active_real) < llstack_no) do begin
+ active_real:=active_real+2;
+ end;
+while (active_real < active_max_ptr) and
+ (active_lstack_no(active_real) = llstack_no) and
+ (active_counter(active_real) <= counter) do begin
+ active_real:=active_real+2;
+ end;
+is_last_ocp := (active_real=active_max_ptr);
+end;
+
+procedure print_active_ocps;
+var i:integer;
+begin
+print_nl("Active ocps: [");
+i:=active_min_ptr;
+while i<active_max_ptr do begin
+ print("(");
+ print_scaled(active_lstack_no(i));
+ print(",");
+ print_int(active_counter(i));
+ print(",");
+ print_esc(ocp_id_text(active_ocp(i)));
+ print(")");
+ if i<>(active_max_ptr-2) then print(",");
+ i:=i+2;
+ end;
+print("]");
+end;
+
+procedure add_ocp_stack(min_index:integer; min_value:scaled);
+var p:ocp_lstack_index;
+ llstack_no:scaled;
+ counter:integer;
+begin
+p:=ocp_list_lstack(holding[min_index]);
+llstack_no:=ocp_list_lstack_no(holding[min_index]);
+counter:=0;
+while not (is_null_ocp_lstack(p)) do begin
+ active_ocp(active_max_ptr):=ocp_lstack_ocp(p);
+ active_counter(active_max_ptr):=counter;
+ active_lstack_no(active_max_ptr):=llstack_no;
+ p:=ocp_lstack_lnext(p);
+ active_max_ptr:=active_max_ptr+2;
+ incr(counter); {no overflow problem}
+ end;
+end;
+
+procedure active_compile;
+var i:integer;
+ min_index:integer;
+ min_stack_ocp:scaled;
+ old_min:scaled;
+ max_active:integer;
+ stack_value:scaled;
+begin
+active_min_ptr:=active_max_ptr;
+min_stack_ocp:=ocp_maxint;
+max_active:=equiv(ocp_active_number_base)-1;
+for i:=max_active downto 0 do begin
+ holding[i]:=ocp_list_list[equiv(ocp_active_base+i)];
+ stack_value:=ocp_list_lstack_no(holding[i]);
+ if stack_value<min_stack_ocp then begin
+ min_index:=i;
+ min_stack_ocp:=stack_value;
+ end;
+ end;
+while min_stack_ocp<ocp_maxint do begin
+ add_ocp_stack(min_index, min_stack_ocp);
+ old_min:=min_stack_ocp;
+ min_stack_ocp:=ocp_maxint;
+ for i:=max_active downto 0 do begin
+ stack_value:=ocp_list_lstack_no(holding[i]);
+ while old_min=stack_value do begin
+ holding[i]:=ocp_list_lnext(holding[i]);
+ stack_value:=ocp_list_lstack_no(holding[i]);
+ end;
+ if stack_value<min_stack_ocp then begin
+ min_index:=i;
+ min_stack_ocp:=stack_value;
+ end;
+ end;
+ end;
+end;
+
+@z
+%---------------------------------------
+@x [46] m.1030 l.19984 - Omega Filtering
+main_loop:@<Append character |cur_chr| and the following characters (if~any)
+ to the current hlist in the current font; |goto reswitch| when
+ a non-character has been fetched@>;
+@y
+main_loop:
+if is_last_ocp(current_ocp_lstack,current_ocp_no) then
+ begin
+ @<Append character |cur_chr| and the following characters (if~any)
+ to the current hlist in the current font; |goto reswitch| when
+ a non-character has been fetched@>;
+ end
+else begin
+ @<Create a buffer with character |cur_chr| and the following
+ characters (if~any) and then apply the current active OCP filter
+ to this buffer@>;
+ end;
+@z
+%---------------------------------------
+@x [50] m.1302 l.23862 - Omega Filtering
+@<Dump the font information@>;
+@y
+@<Dump the font information@>;
+@<Dump the active ocp information@>;
+@z
+%---------------------------------------
+@x [50] m.1303 l.23711 - Omega Filtering
+@<Undump the font information@>;
+@y
+@<Undump the font information@>;
+@<Undump the active ocp information@>;
+@z
+%---------------------------------------
+@x [50] m.1323 l.24907 - Omega Filtering
+begin undump_font_table(k);@/
+end
+@y
+begin undump_font_table(k);@/
+end
+
+@ @<Dump the active ocp information@>=
+dump_int(active_min_ptr);
+dump_int(active_max_ptr);
+for k:=0 to active_max_ptr-1 do dump_wd(active_info[k]);
+print_ln; print_int(active_max_ptr); print(" words of active ocps");
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+for k:=0 to active_max_ptr-1 do undump_wd(active_info[k]);
+
+@z
+%---------------------------------------
+@x [54] m.1379 l.24883 - Omega Filtering
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+@y
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+
+@
+@<Types...@>=
+
+@ Here are all the instructions in our mini-assembler.
+@d otp_right_output=1
+@d otp_right_num=2
+@d otp_right_char=3
+@d otp_right_lchar=4
+@d otp_right_some=5
+
+@d otp_pback_output=6
+@d otp_pback_num=7
+@d otp_pback_char=8
+@d otp_pback_lchar=9
+@d otp_pback_some=10
+
+@d otp_add=11
+@d otp_sub=12
+@d otp_mult=13
+@d otp_div=14
+@d otp_mod=15
+@d otp_lookup=16
+@d otp_push_num=17
+@d otp_push_char=18
+@d otp_push_lchar=19
+
+@d otp_state_change=20
+@d otp_state_push=21
+@d otp_state_pop=22
+
+@d otp_left_start=23
+@d otp_left_return=24
+@d otp_left_backup=25
+
+@d otp_goto=26
+@d otp_goto_ne=27
+@d otp_goto_eq=28
+@d otp_goto_lt=29
+@d otp_goto_le=30
+@d otp_goto_gt=31
+@d otp_goto_ge=32
+@d otp_goto_no_advance=33
+@d otp_goto_beg=34
+@d otp_goto_end=35
+
+@d otp_stop=36
+
+@
+@<Glob...@>=
+@!otp_init_input_start:halfword;
+@!otp_init_input_last:halfword;
+@!otp_init_input_end:halfword;
+@!otp_i:halfword;
+@!otp_init_input_buf:array[0..20000] of quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:array[0..20000] of quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:array[0..20000] of quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:array[0..1000] of quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:array[0..1000] of halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:array[0..1000] of halfword;
+
+@!otp_input_char:halfword;
+@!otp_calculated_char:halfword;
+@!otp_no_input_chars:halfword;
+
+@!otp_instruction:halfword;
+@!otp_instr:halfword;
+@!otp_arg:halfword;
+@!otp_first_arg:halfword;
+@!otp_second_arg:halfword;
+
+@!otp_input_ocp:halfword;
+@!otp_counter:halfword;
+
+@!otp_finished:boolean;
+@!otp_ext_str:integer;
+@!otp_ext_str_arg:integer;
+@!otp_ext_i:integer;
+
+@
+@<Initialize table...@>=
+
+@
+@<Create a buffer with character |cur_chr| and the following
+ characters (if~any) and then apply the current active OCP filter
+ to this buffer@>=
+begin
+if (cur_cmd=char_given) or (cur_cmd=char_num) then
+ @<Skip OCP processing for explicit characters@>
+else begin
+@<Read in the buffer for treatment@>;
+@<Apply the OCP to the input buffer@>;
+@<Place the output buffer back on the stream@>;
+end;
+goto big_switch;
+end;
+
+@
+@<Skip OCP processing for explicit characters@>=
+begin
+ back_input;
+ current_ocp_lstack:=active_lstack_no(active_real);
+ current_ocp_no:=active_counter(active_real);
+end
+
+@
+@<Read in the buffer for treatment@>=
+begin
+otp_init_input_end:=0;
+while (cur_cmd=letter) or (cur_cmd=other_char) or
+ {| (cur_cmd=char_given) or |} (cur_cmd=spacer) do begin
+ incr(otp_init_input_end);
+ if otp_init_input_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_init_input_buf[otp_init_input_end]:=cur_chr;
+ get_x_token;
+ {| if (cur_cmd<>letter) and (cur_cmd<>other_char) |}
+ {| and (cur_cmd<>char_given) then begin |}
+ {| x_token; |}
+ if (cur_cmd=char_num) then begin
+ scan_char_num; cur_chr:=cur_val;
+ end;
+ {| end; |}
+ end;
+back_input;
+otp_input_end:=otp_init_input_end;
+for otp_i:=0 to otp_init_input_end do begin
+ otp_input_buf[otp_i]:=otp_init_input_buf[otp_i];
+ end;
+end
+
+@
+@<Apply the OCP to the input buffer@>=
+begin
+otp_input_ocp:=active_ocp(active_real);
+if otp_input_ocp=0 then begin
+ print_nl("Null ocp being used: all input lost");
+ otp_output_end:=0;
+ end
+else if ocp_external(otp_input_ocp)=0 then begin
+ otp_input_start:=0;
+ otp_input_last:=0;
+ otp_stack_used:=0;
+ otp_stack_last:=0;
+ otp_stack_new:=0;
+ otp_output_end:=0;
+ otp_pc:=0;
+ otp_finished:=false;
+ otp_calc_ptr:=0;
+ otp_calcs[otp_calc_ptr]:=0;
+ otp_state_ptr:=0;
+ otp_states[otp_state_ptr]:=0;
+ while not otp_finished do
+ @<Run the OTP program@>;
+ end
+else begin
+ k:=0;
+ if name_of_file then libc_free (name_of_file);
+ otp_ext_str:=ocp_external(otp_input_ocp);
+ otp_ext_str_arg:=ocp_external_arg(otp_input_ocp);
+ name_of_file := xmalloc (4 + length(otp_ext_str) + length(otp_ext_str_arg));
+ for otp_ext_i:=str_start(otp_ext_str) to
+ str_start(otp_ext_str)+length(otp_ext_str)-1 do
+ append_to_name(str_pool[otp_ext_i]);
+ append_to_name(" ");
+ for otp_ext_i:=str_start(otp_ext_str_arg) to
+ str_start(otp_ext_str_arg)+length(otp_ext_str_arg)-1 do
+ append_to_name(str_pool[otp_ext_i]);
+ name_of_file[length(otp_ext_str)+length(otp_ext_str_arg)+2]:=0;
+ run_external_ocp(name_of_file);
+ end
+end
+
+@
+@<Place the output buffer back on the stream@>=
+if otp_output_end>0 then
+begin
+{|if (first+otp_output_end)>=ocp_buf_size then|
+ |overflow_ocp_buf_size;|}
+if (first+otp_output_end)>=buf_size then
+ begin
+ overflow("(OTP invaded) buffer size", buf_size);
+ { FIXME do something about it!!! }
+ end;
+push_input; { FIXME has no pop_input!!! }
+current_ocp_lstack:=active_lstack_no(active_real);
+current_ocp_no:=active_counter(active_real);
+state:=mid_line;
+last:=first;
+start:=first;
+loc:=first;
+for otp_counter:=1 to otp_output_end do begin
+ buffer[last]:=otp_output_buf[otp_counter];
+ incr(last); {no overflow problem}
+ end;
+{|if last>=max_buf_stack then max_buf_stack:=last+1;|}
+limit:=last-1;
+{first:=last;}
+end
+
+@
+@d otp_cur_state==otp_states[otp_state_ptr]
+@d otp_set_instruction==begin
+if otp_pc>=ocp_state_no(otp_input_ocp)(otp_cur_state) then begin
+ print_err("bad OCP program -- PC not valid");
+ succumb;
+ end;
+otp_instruction:=ocp_state_entry(otp_input_ocp)(otp_cur_state)(otp_pc);
+otp_instr:=otp_instruction div @"1000000;
+otp_arg:=otp_instruction mod @"1000000;
+end
+
+@<Run the OTP program@>=
+begin
+otp_set_instruction;
+case otp_instr of
+ @<Run the |otp_right| instructions@>;
+ @<Run the |otp_pback| instructions@>;
+ @<Run the arithmetic instructions@>;
+ @<Run the |otp_state| instructions@>;
+ @<Run the |otp_left| instructions@>;
+ @<Run the |otp_goto| instructions@>;
+ @<Run the |otp_stop| instruction@>;
+ othercases begin
+ print_err("bad OCP program -- unknown instruction");
+ succumb;
+ end
+ endcases;
+end
+
+@
+
+@d otp_check_char(#)==
+if (1>#) or (#>otp_no_input_chars) then begin
+ print_err("right hand side of OCP expression is bad");
+ succumb;
+ end
+
+@d otp_get_char(#)==begin
+otp_check_char(#);
+if #>otp_stack_last then begin
+ otp_calculated_char:=otp_input_buf[otp_input_start+#-otp_stack_last];
+ end
+else begin
+ otp_calculated_char:=otp_stack_buf[#];
+ end;
+end
+
+@<Run the |otp_right| instructions@>=
+ otp_right_output: begin
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calcs[otp_calc_ptr];
+ decr(otp_calc_ptr);
+ incr(otp_pc);
+ end;
+ otp_right_num: begin
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_arg;
+ incr(otp_pc);
+ end;
+ otp_right_char: begin
+ otp_get_char(otp_arg);
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_right_lchar: begin
+ otp_get_char(otp_no_input_chars-otp_arg);
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_right_some: begin
+ otp_first_arg:=otp_arg+1;
+ incr(otp_pc);
+ otp_set_instruction;
+ otp_second_arg:=otp_no_input_chars-otp_arg;
+ for otp_counter:=otp_first_arg to otp_second_arg do begin
+ otp_get_char(otp_counter);
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calculated_char;
+ end;
+ incr(otp_pc);
+ end
+
+@
+@<Run the |otp_pback| instructions@>=
+ otp_pback_output: begin
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calcs[otp_calc_ptr];
+ decr(otp_calc_ptr);
+ incr(otp_pc);
+ end;
+ otp_pback_num: begin
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_arg;
+ incr(otp_pc);
+ end;
+ otp_pback_char: begin
+ otp_get_char(otp_arg);
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_pback_lchar: begin
+ otp_get_char(otp_no_input_chars-otp_arg);
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_pback_some: begin
+ otp_first_arg:=otp_arg+1;
+ incr(otp_pc);
+ otp_set_instruction;
+ otp_second_arg:=otp_no_input_chars-otp_arg;
+ for otp_counter:=otp_first_arg to otp_second_arg do begin
+ otp_get_char(otp_counter);
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+ end;
+ incr(otp_pc);
+ end
+
+@
+@<Run the arithmetic instructions@>=
+ otp_add: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] + otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_sub: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] - otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_mult: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] * otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_div: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] div otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_mod: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] mod otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_lookup: begin
+ if otp_calcs[otp_calc_ptr]>=
+ ocp_table_no(otp_input_ocp)(otp_calcs[otp_calc_ptr-1]) then begin
+ print_err("bad OCP program -- table index not valid");
+ succumb;
+ end;
+ otp_calcs[otp_calc_ptr-1]:=
+ ocp_table_entry(otp_input_ocp)(otp_calcs[otp_calc_ptr-1])
+ (otp_calcs[otp_calc_ptr]);
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_push_num: begin
+ incr(otp_calc_ptr);
+ if otp_calc_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_calcs[otp_calc_ptr]:=otp_arg;
+ incr(otp_pc);
+ end;
+ otp_push_char: begin
+ otp_get_char(otp_arg);
+ incr(otp_calc_ptr);
+ if otp_calc_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_calcs[otp_calc_ptr]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_push_lchar: begin
+ otp_get_char(otp_no_input_chars-otp_arg);
+ incr(otp_calc_ptr);
+ if otp_calc_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_calcs[otp_calc_ptr]:=otp_calculated_char;
+ incr(otp_pc);
+ end
+
+@
+@<Run the |otp_state| instructions@>=
+ otp_state_change: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ otp_states[otp_state_ptr]:=otp_arg;
+ otp_pc:=0;
+ end;
+ otp_state_push: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ incr(otp_state_ptr);
+ if otp_state_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_states[otp_state_ptr]:=otp_arg;
+ otp_pc:=0;
+ end;
+ otp_state_pop: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ if otp_state_ptr>0 then decr(otp_state_ptr);
+ otp_pc:=0;
+ end
+
+@
+@<Run the |otp_left| instructions@>=
+ otp_left_start: begin
+ otp_input_start:=otp_input_last;
+ otp_input_last:=otp_input_start;
+ otp_stack_used:=0;
+ if (otp_stack_last=0) and (otp_input_last>=otp_input_end) then
+ otp_finished:=true
+ else if (otp_stack_used < otp_stack_last) then begin
+ incr(otp_stack_used); {no overflow problem}
+ otp_input_char:=otp_stack_buf[otp_stack_used];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end
+ else begin
+ incr(otp_input_last); {no overflow problem}
+ otp_input_char:=otp_input_buf[otp_input_last];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end;
+ end;
+ otp_left_return: begin
+ otp_input_last:=otp_input_start;
+ otp_stack_used:=0;
+ if (otp_stack_used < otp_stack_last) then begin
+ incr(otp_stack_used); {no overflow problem}
+ otp_input_char:=otp_stack_buf[otp_stack_used];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end
+ else begin
+ incr(otp_input_last); {no overflow problem}
+ otp_input_char:=otp_input_buf[otp_input_last];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end;
+ end;
+ otp_left_backup: begin
+ if otp_input_start < otp_input_last then begin
+ decr(otp_input_last); otp_input_char:=otp_input_buf[otp_input_last];
+ end
+ else begin
+ decr(otp_stack_used); otp_input_char:=otp_stack_buf[otp_stack_used];
+ end;
+ decr(otp_no_input_chars);
+ incr(otp_pc);
+ end
+
+@
+@<Run the |otp_goto| instructions@>=
+ otp_goto: begin
+ otp_pc:=otp_arg;
+ end;
+ otp_goto_ne: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char <> otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_eq: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char = otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_lt: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char < otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_le: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char <= otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_gt: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char > otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_ge: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char >= otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_no_advance: begin
+ if (otp_stack_used < otp_stack_last) then begin
+ incr(otp_stack_used); {no overflow problem}
+ otp_input_char:=otp_stack_buf[otp_stack_used];
+ incr(otp_no_input_chars); {no overflow problem}
+ incr(otp_pc);
+ end
+ else if otp_input_last>=otp_input_end then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_input_last); {no overflow problem}
+ otp_input_char:=otp_input_buf[otp_input_last];
+ incr(otp_no_input_chars); {no overflow problem}
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_beg: begin
+ if otp_input_last=0 then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_end: begin
+ if otp_input_last>=otp_input_end then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end
+
+@
+@<Run the |otp_stop| instruction@>=
+ otp_stop: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ otp_pc:=0;
+ end
+
+@z
diff --git a/Build/source/texk/web2c/alephdir/omfont.ch b/Build/source/texk/web2c/alephdir/omfont.ch
new file mode 100644
index 00000000000..a176f346ccd
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omfont.ch
@@ -0,0 +1,2373 @@
+% omfont.ch: Reading and storing font metric information
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%%---------------------------------------
+@x [15] m.208 l.
+@d min_internal=end_cs_name+1 {the smallest code that can follow \.{\\the}}
+@y
+@d char_ghost=end_cs_name+1
+ {\.{\\ghostleft}, \.{\\ghostright} character for kerning}
+@d min_internal=char_ghost+1 {the smallest code that can follow \.{\\the}}
+@z
+%---------------------------------------
+@x [17] m.222 l.4530 - Omega
+ {begins table of 257 permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+257 {dummy location}
+@y
+ {begins table of |number_fonts| permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+number_fonts
+ {dummy location}
+@z
+%---------------------------------------
+@x [18] m.265 l.5648 - Omega
+primitive("insert",insert,0);@/
+@!@:insert_}{\.{\\insert} primitive@>
+@y
+primitive("insert",insert,0);@/
+@!@:insert_}{\.{\\insert} primitive@>
+primitive("leftghost",char_ghost,0);@/
+@!@:leftghost_}{\.{\\leftghost} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5648 - Omega
+primitive("setbox",set_box,0);@/
+@!@:set_box_}{\.{\\setbox} primitive@>
+@y
+primitive("rightghost",char_ghost,1);@/
+@!@:rightghost_}{\.{\\rightghost} primitive@>
+primitive("setbox",set_box,0);@/
+@!@:set_box_}{\.{\\setbox} primitive@>
+@z
+%---------------------------------------
+@x [18] m.266 l.5648 - Omega
+char_num: print_esc("char");
+@y
+char_num: print_esc("char");
+char_ghost: if cur_chr=0 then print_esc("leftghost")
+ else print_esc("rightghost");
+@z
+%---------------------------------------
+@x [26] m.425 l.8524 - font parameters
+begin find_font_dimen(false); font_info[fmem_ptr].sc:=0;
+scanned_result(font_info[cur_val].sc)(dimen_val);
+@y
+begin find_font_dimen(false);
+font_info(dimen_font)(font_file_size(dimen_font)).sc:=0;
+scanned_result(font_info(dimen_font)(cur_val).sc)(dimen_val);
+@z
+%---------------------------------------
+@x [26] m.426 l.8530 - font parameters
+if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+else scanned_result(skew_char[cur_val])(int_val);
+@y
+if m=0 then scanned_result(hyphen_char(cur_val))(int_val)
+else scanned_result(skew_char(cur_val))(int_val);
+@z
+%---------------------------------------
+@x [27] m.472 l.9258 - font parameters
+font_name_code: begin print(font_name[cur_val]);
+ if font_size[cur_val]<>font_dsize[cur_val] then
+ begin print(" at "); print_scaled(font_size[cur_val]);
+@y
+font_name_code: begin print(font_name(cur_val));
+ if font_size(cur_val)<>font_dsize(cur_val) then
+ begin print(" at "); print_scaled(font_size(cur_val));
+@z
+%---------------------------------------
+@x [30] m.539 l.10392 - Omega
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+@y
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+$\Omega$ is capable of reading not only \.{TFM} files, but also
+\.{OFM} files, which can describe fonts with up to 65536 characters
+and with huge lig/kern tables. These fonts will often be virtual
+fonts built up from real fonts with 256 characters, but $\Omega$
+is not aware of this.
+
+The documentation below describes \.{TFM} files, with slight additions
+to show where \.{OFM} files differ.
+
+@z
+%---------------------------------------
+@x [30] m.540 l.10417 - Omega
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+@y
+Note that a \.{TFM} font may contain as many as 256 characters
+(if |bc=0| and |ec=255|), and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+The first 52 bytes (13 words) of an \.{OFM} file contains thirteen
+32-bit integers that give the lengths of the various subsequent
+portions of the file. The first word is 0 (future versions of
+\.{OFM} files could have different values; what is important is that
+the first two bytes be 0 to differentiate \.{TFM} and \.{OFM} files).
+The next twelve integers are as above, all nonegative and less
+than~$2^{31}$. We must have |bc-1<=ec<=65535|, and
+$$\hbox{|lf=13+lh+2*(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that an \.{OFM} font may contain as many as 65536 characters
+(if |bc=0| and |ec=65535|), and as few as 0 characters (if |bc=ec+1|).
+
+@z
+%---------------------------------------
+@x [30] m.543 l.10492 - Omega
+per character. Each word in this part of the file contains six fields
+@y
+per character. Each word in this part of a \.{TFM} file contains six fields
+@z
+%---------------------------------------
+@x [30] m.543 l.10506 - Omega
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+@y
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+For \.{OFM} files, two words (eight bytes) are used.
+The arrangement is as follows.
+
+\yskip\hang first and second bytes: |@!width_index| (16 bits)\par
+\hang third byte: |@!height_index| (8 bits)\par
+\hang fourth byte: |@!depth_index| (8~bits)\par
+\hang fifth and sixth bytes:
+|@!italic_index| (14 bits) times 4, plus |@!tag| (2~bits)\par
+\hang seventh and eighth bytes: |@!remainder| (16 bits)\par
+\yskip\noindent
+Therefore the \.{OFM} format imposes a limit of 256 different heights,
+256 different depths, and 16384 different italic corrections.
+
+@z
+%---------------------------------------
+@x [30] m.545 l.10547 - Omega
+that explains what to do for special letter pairs. Each word in this array is a
+|@!lig_kern_command| of four bytes.
+@y
+that explains what to do for special letter pairs. Each word in this array,
+in a \.{TFM} file, is a |@!lig_kern_command| of four bytes.
+@z
+%---------------------------------------
+@x [30] m.545 l.10557 - Omega
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+@y
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In an \.{OFM} file, eight bytes are used, two bytes for each field.
+
+@z
+%---------------------------------------
+@x [30] m.545 l.10587 - Omega
+appear in a location |<=255|.
+@y
+appear in a location |<=255| in a \.{TFM} file, |<=65535| in an \.{OFM} file.
+@z
+%---------------------------------------
+@x [30] m.545 l.10599 - Omega
+@d skip_byte(#)==#.b0
+@d next_char(#)==#.b1
+@d op_byte(#)==#.b2
+@d rem_byte(#)==#.b3
+@y
+@d top_skip_byte(#)==(#.b0 div 256)
+@d skip_byte(#)==(#.b0 mod 256)
+@d next_char_end(#)==#.b1
+@d next_char(#)==font_offset(#)+next_char_end
+@d op_byte(#)==#.b2
+@d rem_byte(#)==#.b3
+@d rem_char_byte_end(#)==#.b3
+@d rem_char_byte(#)==font_offset(#)+rem_char_byte_end
+@d rem_top_byte(#)==(#.b3 div 256)
+@d rem_bot_byte(#)==(#.b3 mod 256)
+@z
+%---------------------------------------
+@x [30] m.546 l.10604 - Omega
+consists of four bytes called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this
+order). These bytes are the character codes of individual pieces used to
+@y
+consists of four bytes in a \.{TFM} file,
+called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this order).
+In an \.{OFM} file, each field takes two bytes, for eight in total.
+These bytes are the character codes of individual pieces used to
+@z
+%---------------------------------------
+@x [30] m.546 l.10618 - Omega
+@d ext_top(#)==#.b0 {|top| piece in a recipe}
+@d ext_mid(#)==#.b1 {|mid| piece in a recipe}
+@d ext_bot(#)==#.b2 {|bot| piece in a recipe}
+@d ext_rep(#)==#.b3 {|rep| piece in a recipe}
+@y
+@d ext_top_end(#)==#.b0 {|top| piece in a recipe}
+@d ext_top(#)==font_offset(#)+ext_top_end
+@d ext_mid_end(#)==#.b1 {|mid| piece in a recipe}
+@d ext_mid(#)==font_offset(#)+ext_mid_end
+@d ext_bot_end(#)==#.b2 {|bot| piece in a recipe}
+@d ext_bot(#)==font_offset(#)+ext_bot_end
+@d ext_rep_end(#)==#.b3 {|rep| piece in a recipe}
+@d ext_rep(#)==font_offset(#)+ext_rep_end
+@z
+%---------------------------------------
+@x [30] m.548 l.10674 - Omega
+@!font_index=0..font_mem_size; {index into |font_info|}
+@y
+@!font_index=integer; {index into |font_info|}
+@z
+%---------------------------------------
+@x [30] m.549 l.10678 - Omega
+@d non_char==qi(256) {a |halfword| code that can't match a real character}
+@y
+@d non_char==qi(too_big_char) {a code that can't match a real character}
+@z
+%---------------------------------------
+@x [30] m.549 l.10686 - Omega
+@!font_info:array[font_index] of memory_word;
+ {the big collection of font data}
+@!fmem_ptr:font_index; {first unused word of |font_info|}
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_check:array[internal_font_number] of four_quarters; {check sum}
+@!font_size:array[internal_font_number] of scaled; {``at'' size}
+@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
+@!font_params:array[internal_font_number] of font_index; {how many font
+ parameters are present}
+@!font_name:array[internal_font_number] of str_number; {name of the font}
+@!font_area:array[internal_font_number] of str_number; {area of the font}
+@!font_bc:array[internal_font_number] of eight_bits;
+ {beginning (smallest) character code}
+@!font_ec:array[internal_font_number] of eight_bits;
+ {ending (largest) character code}
+@!font_glue:array[internal_font_number] of pointer;
+ {glue specification for interword space, |null| if not allocated}
+@!font_used:array[internal_font_number] of boolean;
+ {has a character from this font actually appeared in the output?}
+@!hyphen_char:array[internal_font_number] of integer;
+ {current \.{\\hyphenchar} values}
+@!skew_char:array[internal_font_number] of integer;
+ {current \.{\\skewchar} values}
+@!bchar_label:array[internal_font_number] of font_index;
+ {start of |lig_kern| program for left boundary character,
+ |non_address| if there is none}
+@!font_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {right boundary character, |non_char| if there is none}
+@!font_false_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
+@y
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@z
+%---------------------------------------
+@x [30] m.550 l.10723 - Omega
+|font_info[char_base[f]+c].qqqq|; and if |w| is the |width_index|
+part of this word (the |b0| field), the width of the character is
+|font_info[width_base[f]+w].sc|. (These formulas assume that
+|min_quarterword| has already been added to |c| and to |w|, since \TeX\
+stores its quarterwords that way.)
+
+@<Glob...@>=
+@!char_base:array[internal_font_number] of integer;
+ {base addresses for |char_info|}
+@!width_base:array[internal_font_number] of integer;
+ {base addresses for widths}
+@!height_base:array[internal_font_number] of integer;
+ {base addresses for heights}
+@!depth_base:array[internal_font_number] of integer;
+ {base addresses for depths}
+@!italic_base:array[internal_font_number] of integer;
+ {base addresses for italic corrections}
+@!lig_kern_base:array[internal_font_number] of integer;
+ {base addresses for ligature/kerning programs}
+@!kern_base:array[internal_font_number] of integer;
+ {base addresses for kerns}
+@!exten_base:array[internal_font_number] of integer;
+ {base addresses for extensible recipes}
+@!param_base:array[internal_font_number] of integer;
+ {base addresses for font parameters}
+@y
+|font_info(f)(char_base(f)+c).qqqq|; and if |w| is the |width_index|
+part of this word (the |b0| field), the width of the character is
+|font_info(f)(width_base(f)+w).sc|. (These formulas assume that
+|min_quarterword| has already been added to |c| and to |w|, since \TeX\
+stores its quarterwords that way.)
+
+@d font_info_end(#)==#]
+@d font_info(#)==font_tables[#,font_info_end
+@d offset_file_size=0
+@d offset_check=1
+@d offset_offset=offset_check+4
+@d offset_size=offset_offset+1
+@d offset_dsize=offset_size+1
+@d offset_params=offset_dsize+1
+@d offset_name_sort=offset_params+1
+@d offset_name=offset_name_sort+1
+@d offset_area=offset_name+1
+@d offset_bc=offset_area+1
+@d offset_ec=offset_bc+1
+@d offset_glue=offset_ec+1
+@d offset_used=offset_glue+1
+@d offset_hyphen=offset_used+1
+@d offset_skew=offset_hyphen+1
+@d offset_bchar_label=offset_skew+1
+@d offset_bchar=offset_bchar_label+1
+@d offset_false_bchar=offset_bchar+1
+@d offset_ivalues_start=offset_false_bchar+1
+@d offset_fvalues_start=offset_ivalues_start+1
+@d offset_mvalues_start=offset_fvalues_start+1
+@d offset_rules_start=offset_mvalues_start+1
+@d offset_glues_start=offset_rules_start+1
+@d offset_penalties_start=offset_glues_start+1
+@d offset_ivalues_base=offset_penalties_start+1
+@d offset_fvalues_base=offset_ivalues_base+1
+@d offset_mvalues_base=offset_fvalues_base+1
+@d offset_rules_base=offset_mvalues_base+1
+@d offset_glues_base=offset_rules_base+1
+@d offset_penalties_base=offset_glues_base+1
+@d offset_char_base=offset_penalties_base+1
+@d offset_char_attr_base=offset_char_base+1
+@d offset_width_base=offset_char_attr_base+1
+@d offset_height_base=offset_width_base+1
+@d offset_depth_base=offset_height_base+1
+@d offset_italic_base=offset_depth_base+1
+@d offset_lig_kern_base=offset_italic_base+1
+@d offset_kern_base=offset_lig_kern_base+1
+@d offset_exten_base=offset_kern_base+1
+@d offset_param_base=offset_exten_base+1
+@d offset_charinfo_base=offset_param_base+1
+@d font_file_size(#)==font_info(#)(offset_file_size).int
+@d font_check_0(#)==font_info(#)(offset_check).int
+@d font_check_1(#)==font_info(#)(offset_check+1).int
+@d font_check_2(#)==font_info(#)(offset_check+2).int
+@d font_check_3(#)==font_info(#)(offset_check+3).int
+@d font_offset(#)==font_info(#)(offset_offset).int
+@d font_size(#)==font_info(#)(offset_size).int
+@d font_dsize(#)==font_info(#)(offset_dsize).int
+@d font_params(#)==font_info(#)(offset_params).int
+@d font_name_sort(#)==font_info(#)(offset_name_sort).int
+@d font_name(#)==font_info(#)(offset_name).int
+@d font_area(#)==font_info(#)(offset_area).int
+@d font_bc(#)==font_info(#)(offset_bc).int
+@d font_ec(#)==font_info(#)(offset_ec).int
+@d font_glue(#)==font_info(#)(offset_glue).int
+@d font_used(#)==font_info(#)(offset_used).int
+@d hyphen_char(#)==font_info(#)(offset_hyphen).int
+@d skew_char(#)==font_info(#)(offset_skew).int
+@d bchar_label(#)==font_info(#)(offset_bchar_label).int
+@d font_bchar(#)==font_info(#)(offset_bchar).int
+@d font_false_bchar(#)==font_info(#)(offset_false_bchar).int
+@d ivalues_start(#)==font_info(#)(offset_ivalues_start).int
+@d fvalues_start(#)==font_info(#)(offset_fvalues_start).int
+@d mvalues_start(#)==font_info(#)(offset_mvalues_start).int
+@d rules_start(#)==font_info(#)(offset_rules_start).int
+@d glues_start(#)==font_info(#)(offset_glues_start).int
+@d penalties_start(#)==font_info(#)(offset_penalties_start).int
+@d ivalues_base(#)==font_info(#)(offset_ivalues_base).int
+@d fvalues_base(#)==font_info(#)(offset_fvalues_base).int
+@d mvalues_base(#)==font_info(#)(offset_mvalues_base).int
+@d rules_base(#)==font_info(#)(offset_rules_base).int
+@d glues_base(#)==font_info(#)(offset_glues_base).int
+@d penalties_base(#)==font_info(#)(offset_penalties_base).int
+@d char_attr_base(#)==font_info(#)(offset_char_attr_base).int
+@d char_base(#)==font_info(#)(offset_char_base).int
+@d width_base(#)==font_info(#)(offset_width_base).int
+@d height_base(#)==font_info(#)(offset_height_base).int
+@d depth_base(#)==font_info(#)(offset_depth_base).int
+@d italic_base(#)==font_info(#)(offset_italic_base).int
+@d lig_kern_base(#)==font_info(#)(offset_lig_kern_base).int
+@d kern_base(#)==font_info(#)(offset_kern_base).int
+@d exten_base(#)==font_info(#)(offset_exten_base).int
+@d param_base(#)==font_info(#)(offset_param_base).int
+
+@<Glob...@>=
+@!dimen_font:integer;
+@z
+%---------------------------------------
+@x [30] m.551 l.10743 - Omega
+for k:=font_base to font_max do font_used[k]:=false;
+@y
+@z
+%---------------------------------------
+@x [30] m.552 l.10749 - Omega
+font_ptr:=null_font; fmem_ptr:=7;
+font_name[null_font]:="nullfont"; font_area[null_font]:="";
+hyphen_char[null_font]:="-"; skew_char[null_font]:=-1;
+bchar_label[null_font]:=non_address;
+font_bchar[null_font]:=non_char; font_false_bchar[null_font]:=non_char;
+font_bc[null_font]:=1; font_ec[null_font]:=0;
+font_size[null_font]:=0; font_dsize[null_font]:=0;
+char_base[null_font]:=0; width_base[null_font]:=0;
+height_base[null_font]:=0; depth_base[null_font]:=0;
+italic_base[null_font]:=0; lig_kern_base[null_font]:=0;
+kern_base[null_font]:=0; exten_base[null_font]:=0;
+font_glue[null_font]:=null; font_params[null_font]:=7;
+param_base[null_font]:=-1;
+for k:=0 to 6 do font_info[k].sc:=0;
+@y
+font_ptr:=null_font;
+allocate_font_table(null_font,offset_charinfo_base+108);
+font_file_size(null_font):=offset_charinfo_base+108;
+font_used(null_font):=false;
+font_name(null_font):="nullfont"; font_area(null_font):="";
+hyphen_char(null_font):="-"; skew_char(null_font):=-1;
+bchar_label(null_font):=non_address;
+font_bchar(null_font):=non_char; font_false_bchar(null_font):=non_char;
+font_bc(null_font):=1; font_ec(null_font):=0;
+font_size(null_font):=0; font_dsize(null_font):=0;
+char_base(null_font):=offset_charinfo_base;
+char_attr_base(null_font):=offset_charinfo_base;
+ivalues_start(null_font):=offset_charinfo_base;
+fvalues_start(null_font):=offset_charinfo_base;
+mvalues_start(null_font):=offset_charinfo_base;
+rules_start(null_font):=offset_charinfo_base;
+glues_start(null_font):=offset_charinfo_base;
+penalties_start(null_font):=offset_charinfo_base;
+ivalues_base(null_font):=offset_charinfo_base;
+fvalues_base(null_font):=offset_charinfo_base;
+mvalues_base(null_font):=offset_charinfo_base;
+rules_base(null_font):=offset_charinfo_base;
+glues_base(null_font):=offset_charinfo_base;
+penalties_base(null_font):=offset_charinfo_base;
+width_base(null_font):=offset_charinfo_base;
+height_base(null_font):=offset_charinfo_base;
+depth_base(null_font):=offset_charinfo_base;
+italic_base(null_font):=offset_charinfo_base;
+lig_kern_base(null_font):=offset_charinfo_base;
+kern_base(null_font):=offset_charinfo_base;
+exten_base(null_font):=offset_charinfo_base;
+font_glue(null_font):=null;
+font_params(null_font):=7;
+param_base(null_font):=offset_charinfo_base-1;
+font_offset(null_font):=0;
+for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
+@z
+%---------------------------------------
+@x [30] m.553 l.10767 - Omega
+text(frozen_null_font):="nullfont"; eqtb[frozen_null_font]:=eqtb[cur_val];
+@y
+settext(frozen_null_font,"nullfont");
+set_new_eqtb(frozen_null_font,new_eqtb(cur_val));
+@z
+%---------------------------------------
+@x [30] m.554 l.10771 - Omega
+$$\hbox{|font_info[width_base[f]+font_info[char_base[f]+c].qqqq.b0].sc|}$$
+@y
+$$\hbox{|font_info(f)(width_base(f)+font_info(f)(char_base(f)+c).qqqq.b0).sc|}$$
+@z
+%---------------------------------------
+@x [30] m.554 l.10785 - Omega
+|height_depth(q)| will be the 8-bit quantity
+$$b=|height_index|\times16+|depth_index|,$$ and if |b| is such a byte we
+@y
+|height_depth(q)| will be the 16-bit quantity
+$$b=|height_index|\times256+|depth_index|,$$ and if |b| is such a byte we
+@z
+%---------------------------------------
+@x [30] m.554 l.10798 - Omega
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_info[char_base[#]+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_info[width_base[#]+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 4].sc
+@d char_italic(#)==font_info[italic_base[#]+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 16].sc
+@d char_height(#)==font_info[height_base[#]+char_height_end
+@d char_depth_end(#)==(#) mod 16].sc
+@d char_depth(#)==font_info[depth_base[#]+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+@y
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_tables[#,char_base(#)-font_offset(#)+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_tables[#,width_base(#)+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 256].sc
+@d char_italic(#)==font_tables[#,italic_base(#)+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 256].sc
+@d char_height(#)==font_tables[#,height_base(#)+char_height_end
+@d char_depth_end(#)==(#) mod 256].sc
+@d char_depth(#)==font_tables[#,depth_base(#)+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+@z
+%---------------------------------------
+@x [30] m.557 l.10834 - Omega
+|i=font_info[lig_kern_start(f)(j)]| or |font_info[lig_kern_restart(f)(i)]|,
+depending on whether or not |skip_byte(i)<=stop_flag|.
+
+The constant |kern_base_offset| should be simplified, for \PASCAL\ compilers
+that do not do local optimization.
+@^system dependencies@>
+
+@d char_kern_end(#)==256*op_byte(#)+rem_byte(#)].sc
+@d char_kern(#)==font_info[kern_base[#]+char_kern_end
+@d kern_base_offset==256*(128+min_quarterword)
+@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program}
+@d lig_kern_restart_end(#)==256*op_byte(#)+rem_byte(#)+32768-kern_base_offset
+@d lig_kern_restart(#)==lig_kern_base[#]+lig_kern_restart_end
+@y
+|i=font_info(f)(lig_kern_start(f)(j))| or
+|font_info(f)(lig_kern_restart(f)(i))|,
+depending on whether or not |skip_byte(i)<=stop_flag|.
+
+The constant |kern_base_offset| should be simplified, for \PASCAL\ compilers
+that do not do local optimization.
+@^system dependencies@>
+
+@d char_kern_end(#)==256*op_byte(#)+rem_byte(#)].sc
+@d char_kern(#)==font_tables[#,kern_base(#)+char_kern_end
+@d kern_base_offset==256*(128+min_quarterword)
+@d lig_kern_start(#)==lig_kern_base(#)+rem_byte {beginning of lig/kern program}
+@d lig_kern_restart_end(#)==256*op_byte(#)+rem_byte(#)+32768-kern_base_offset
+@d lig_kern_restart(#)==lig_kern_base(#)+lig_kern_restart_end
+
+@d attr_zero_char_ivalue_end(#)==#].int].int
+@d attr_zero_char_ivalue(#)==
+ font_tables[#,font_tables[#,char_attr_base(#)+attr_zero_char_ivalue_end
+@d attr_zero_ivalue_end(#)==#].int
+@d attr_zero_ivalue(#)==font_tables[#,ivalues_base(#)+attr_zero_ivalue_end
+@d attr_zero_penalty_end(#)==#].int
+@d attr_zero_penalty(#)==font_tables[#,penalties_base(#)+attr_zero_penalty_end
+@d attr_zero_kern_end(#)==#].int
+@d attr_zero_kern(#)==font_tables[#,mvalues_base(#)+attr_zero_kern_end
+
+@z
+%---------------------------------------
+@x [30] m.558 l.10843 - Omega
+@d param_end(#)==param_base[#]].sc
+@d param(#)==font_info[#+param_end
+@d slant==param(slant_code) {slant to the right, per unit distance upward}
+@d space==param(space_code) {normal space between words}
+@d space_stretch==param(space_stretch_code) {stretch between words}
+@d space_shrink==param(space_shrink_code) {shrink between words}
+@d x_height==param(x_height_code) {one ex}
+@d quad==param(quad_code) {one em}
+@d extra_space==param(extra_space_code) {additional space at end of sentence}
+@y
+@d slant(#)==font_info(#)(param_base(#)+slant_code).sc
+ {slant to the right, per unit distance upward}
+@d space(#)==font_info(#)(param_base(#)+space_code).sc
+ {normal space between words}
+@d space_stretch(#)==font_info(#)(param_base(#)+space_stretch_code).sc
+ {stretch between words}
+@d space_shrink(#)==font_info(#)(param_base(#)+space_shrink_code).sc
+ {shrink between words}
+@d x_height(#)==font_info(#)(param_base(#)+x_height_code).sc
+ {one ex}
+@d quad(#)==font_info(#)(param_base(#)+quad_code).sc
+ {one em}
+@d extra_space(#)==font_info(#)(param_base(#)+extra_space_code).sc
+ {additional space at end of sentence}
+@z
+%---------------------------------------
+@x [30] m.560 l.10876 - Omega
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled):internal_font_number; {input a \.{TFM} file}
+@y
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled;offset:quarterword):internal_font_number; {input a \.{TFM} file}
+@z
+%---------------------------------------
+@x [30] m.560 l.10882 - Omega
+ {sizes of subfiles}
+@!f:internal_font_number; {the new font's number}
+@!g:internal_font_number; {the number to return}
+@!a,@!b,@!c,@!d:eight_bits; {byte variables}
+@y
+@!font_dir:halfword;
+ {sizes of subfiles}
+@!f:internal_font_number; {the new font's number}
+@!g:internal_font_number; {the number to return}
+@!a,@!b,@!c,@!d:integer; {byte variables}
+@!i,@!k_param,@!param,@!font_counter:integer; {counters}
+@!font_level,@!header_length:integer;
+@!nco,@!ncw,@!npc,@!nlw,@!neew:integer;
+@!nki,@!nwi,@!nkf,@!nwf,@!nkm,@!nwm:integer;
+@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp:integer;
+@!table_size:array [0..31] of integer;
+@!bytes_per_entry,@!extra_char_bytes:integer;
+@!repeat_no,@!table_counter:integer;
+@z
+%---------------------------------------
+@x [30] m.560 l.10888 - Omega
+@!bchar:0..256; {right boundary character, or 256}
+@y
+@!bchar:0..too_big_char; {right boundary character, or |too_big_char|}
+@!first_two:integer;
+@z
+%---------------------------------------
+@x [30] m.563 l.10943 - Omega
+if file_opened then print(" not loadable: Bad metric (TFM) file")
+else print(" not loadable: Metric (TFM) file not found");
+@y
+if file_opened then print(" not loadable: Bad metric (TFM/OFM) file")
+else print(" not loadable: Metric (TFM/OFM) file not found");
+@z
+%---------------------------------------
+@x [30] m.563 l.10943 - Omega
+if aire="" then pack_file_name(nom,TEX_font_area,".tfm")
+else pack_file_name(nom,aire,".tfm");
+if not b_open_in(tfm_file) then abort;
+@y
+if aire="" then pack_file_name(nom,TEX_font_area,".ofm")
+else pack_file_name(nom,aire,".ofm");
+if not b_open_in(tfm_file) then abort;
+@z
+%---------------------------------------
+@x [30] m.564 l.10962 - Omega
+@d store_four_quarters(#)==begin fget; a:=fbyte; qw.b0:=qi(a);
+ fget; b:=fbyte; qw.b1:=qi(b);
+ fget; c:=fbyte; qw.b2:=qi(c);
+ fget; d:=fbyte; qw.b3:=qi(d);
+ #:=qw;
+ end
+@y
+@d read_sixteen_unsigned(#)==begin #:=fbyte;
+ fget; #:=#*@'400+fbyte;
+ end
+@d read_thirtytwo(#)==begin #:=fbyte;
+ if #>127 then abort;
+ fget; #:=#*@'400+fbyte;
+ fget; #:=#*@'400+fbyte;
+ fget; #:=#*@'400+fbyte;
+ end
+@d store_four_bytes(#)==begin fget; a:=fbyte; qw.b0:=a;
+ fget; b:=fbyte; qw.b1:=b;
+ fget; c:=fbyte; qw.b2:=c;
+ fget; d:=fbyte; qw.b3:=d;
+ #:=qw;
+ end
+@d store_char_info(#)==begin if (font_level<>-1) then
+ begin fget; read_sixteen_unsigned(a); qw.b0:=a;
+ fget; read_sixteen_unsigned(b); qw.b1:=b;
+ fget; read_sixteen_unsigned(c); qw.b2:=c;
+ fget; read_sixteen_unsigned(d); qw.b3:=d;
+ #:=qw
+ end
+else
+ begin fget; a:=fbyte; qw.b0:=a;
+ fget; b:=fbyte; b:=((b div 16)*256)+(b mod 16); qw.b1:=b;
+ fget; c:=fbyte; c:=((c div 4)*256)+(c mod 4); qw.b2:=c;
+ fget; d:=fbyte; qw.b3:=d;
+ #:=qw
+ end
+end
+@d store_four_quarters(#)==begin if (font_level<>-1) then
+ begin fget; read_sixteen_unsigned(a); qw.b0:=a;
+ fget; read_sixteen_unsigned(b); qw.b1:=b;
+ fget; read_sixteen_unsigned(c); qw.b2:=c;
+ fget; read_sixteen_unsigned(d); qw.b3:=d;
+ #:=qw
+ end
+else
+ begin fget; a:=fbyte; qw.b0:=a;
+ fget; b:=fbyte; qw.b1:=b;
+ fget; c:=fbyte; qw.b2:=c;
+ fget; d:=fbyte; qw.b3:=d;
+ #:=qw
+ end
+end
+@z
+%---------------------------------------
+@x [30] m.565 l.10970 - Omega
+begin read_sixteen(lf);
+fget; read_sixteen(lh);
+fget; read_sixteen(bc);
+fget; read_sixteen(ec);
+if (bc>ec+1)or(ec>255) then abort;
+if bc>255 then {|bc=256| and |ec=255|}
+ begin bc:=1; ec:=0;
+ end;
+fget; read_sixteen(nw);
+fget; read_sixteen(nh);
+fget; read_sixteen(nd);
+fget; read_sixteen(ni);
+fget; read_sixteen(nl);
+fget; read_sixteen(nk);
+fget; read_sixteen(ne);
+fget; read_sixteen(np);
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort;
+end
+@y
+nco:=0; ncw:=0; npc:=0;
+nki:=0; nwi:=0; nkf:=0; nwf:=0; nkm:=0; nwm:=0;
+nkr:=0; nwr:=0; nkg:=0; nwg:=0; nkp:=0; nwp:=0;
+read_sixteen(first_two);
+if first_two<>0 then begin
+ font_level:=-1;
+ lf:=first_two;
+ fget; read_sixteen(lh);
+ fget; read_sixteen(bc);
+ fget; read_sixteen(ec);
+ if (bc>ec+1)or(ec>255) then abort;
+ if bc>255 then {|bc=256| and |ec=255|}
+ begin bc:=1; ec:=0;
+ end;
+ fget; read_sixteen(nw);
+ fget; read_sixteen(nh);
+ fget; read_sixteen(nd);
+ fget; read_sixteen(ni);
+ fget; read_sixteen(nl);
+ fget; read_sixteen(nk);
+ fget; read_sixteen(ne);
+ fget; read_sixteen(np);
+ header_length:=6;
+ ncw:=(ec-bc+1);
+ nlw:=nl;
+ neew:=ne;
+ end
+else begin
+ fget; read_sixteen(font_level);
+ if (font_level<>0) and (font_level<>1) then abort;
+ fget; read_thirtytwo(lf);
+ fget; read_thirtytwo(lh);
+ fget; read_thirtytwo(bc);
+ fget; read_thirtytwo(ec);
+ if (bc>ec+1)or(ec>biggest_char) then abort;
+ if bc>65535 then {|bc=65536| and |ec=65535|}
+ begin bc:=1; ec:=0;
+ end;
+ fget; read_thirtytwo(nw);
+ fget; read_thirtytwo(nh);
+ fget; read_thirtytwo(nd);
+ fget; read_thirtytwo(ni);
+ fget; read_thirtytwo(nl);
+ fget; read_thirtytwo(nk);
+ fget; read_thirtytwo(ne);
+ fget; read_thirtytwo(np);
+ fget; read_thirtytwo(font_dir);
+ nlw:=2*nl;
+ neew:=2*ne;
+ if font_level=0 then begin
+ header_length:=14;
+ ncw:=2*(ec-bc+1);
+ end
+ else begin
+ header_length:=29;
+ fget; read_thirtytwo(nco);
+ fget; read_thirtytwo(ncw);
+ fget; read_thirtytwo(npc);
+ fget; read_thirtytwo(nki); {Kinds of font ivalues}
+ fget; read_thirtytwo(nwi); {Words of font ivalues}
+ fget; read_thirtytwo(nkf); {Kinds of font fvalues}
+ fget; read_thirtytwo(nwf); {Words of font fvalues}
+ fget; read_thirtytwo(nkm); {Kinds of font mvalues}
+ fget; read_thirtytwo(nwm); {Words of font mvalues}
+ fget; read_thirtytwo(nkr); {Kinds of font rules}
+ fget; read_thirtytwo(nwr); {Words of font rules}
+ fget; read_thirtytwo(nkg); {Kinds of font glues}
+ fget; read_thirtytwo(nwg); {Words of font glues}
+ fget; read_thirtytwo(nkp); {Kinds of font penalties}
+ fget; read_thirtytwo(nwp); {Words of font penalties}
+ end
+ end;
+if lf<>(header_length+lh+ncw+nw+nh+nd+ni+nlw+nk+neew+np+
+ nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp) then abort;
+@z
+%---------------------------------------
+@x [30] m.566 l.10996 - Omega
+lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
+if np<7 then lf:=lf+7-np; {at least seven parameters will appear}
+if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then
+ @<Apologize for not loading the font, |goto done|@>;
+f:=font_ptr+1;
+char_base[f]:=fmem_ptr-bc;
+width_base[f]:=char_base[f]+ec+1;
+height_base[f]:=width_base[f]+nw;
+depth_base[f]:=height_base[f]+nh;
+italic_base[f]:=depth_base[f]+nd;
+lig_kern_base[f]:=italic_base[f]+ni;
+kern_base[f]:=lig_kern_base[f]+nl-kern_base_offset;
+exten_base[f]:=kern_base[f]+kern_base_offset+nk;
+param_base[f]:=exten_base[f]+ne
+@y
+case font_level of
+-1: lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
+ 0: lf:=lf-14-lh-(ec-bc+1)-nl-ne;
+ {some of the sections contain pairs of
+ words that become single |memory_word|s}
+ 1: lf:=lf-29-lh-ncw+(1+npc)*(ec-bc+1)-nl-ne;
+ {We explode the characters}
+end;
+if np<7 then lf:=lf+7-np; {at least seven parameters will appear}
+if (font_ptr=font_max) then
+ @<Apologize for not loading the font, |goto done|@>;
+f:=font_ptr+1;
+allocate_font_table(f,offset_charinfo_base+lf+100);
+ {leave room for 100 extra parameters -- potential bug}
+font_file_size(f):=offset_charinfo_base+lf+100;
+font_used(f):=false;
+font_offset(f):=offset;
+char_base(f):=offset_charinfo_base-bc;
+char_attr_base(f):=char_base(f)+ec+1;
+ivalues_start(f):=char_attr_base(f)+npc*(ec-bc+1);
+fvalues_start(f):=ivalues_start(f)+nki;
+mvalues_start(f):=fvalues_start(f)+nkf;
+rules_start(f):=mvalues_start(f)+nkm;
+glues_start(f):=rules_start(f)+nkr;
+penalties_start(f):=glues_start(f)+nkg;
+ivalues_base(f):=penalties_start(f)+nkp;
+fvalues_base(f):=ivalues_base(f)+nwi;
+mvalues_base(f):=fvalues_base(f)+nwf;
+rules_base(f):=mvalues_base(f)+nwm;
+glues_base(f):=rules_base(f)+nwr;
+penalties_base(f):=glues_base(f)+nwg;
+width_base(f):=penalties_base(f)+nwp;
+height_base(f):=width_base(f)+nw;
+depth_base(f):=height_base(f)+nh;
+italic_base(f):=depth_base(f)+nd;
+lig_kern_base(f):=italic_base(f)+ni;
+kern_base(f):=lig_kern_base(f)+nl-kern_base_offset;
+exten_base(f):=kern_base(f)+kern_base_offset+nk;
+param_base(f):=exten_base(f)+ne;
+@z
+%---------------------------------------
+@x [30] m.568 l.11026 - Omega
+store_four_quarters(font_check[f]);
+@y
+fget; font_check_0(f):=fbyte;
+fget; font_check_1(f):=fbyte;
+fget; font_check_2(f):=fbyte;
+fget; font_check_3(f):=fbyte;
+@z
+%---------------------------------------
+@x [30] m.568 l.11033 - Omega
+font_dsize[f]:=z;
+if s<>-1000 then
+ if s>=0 then z:=s
+ else z:=xn_over_d(z,-s,1000);
+font_size[f]:=z;
+@y
+font_dsize(f):=z;
+if s<>-1000 then
+ if s>=0 then z:=s
+ else z:=xn_over_d(z,-s,1000);
+font_size(f):=z;
+@z
+%---------------------------------------
+@x [30] m.569 l.11041 - Omega
+for k:=fmem_ptr to width_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if (a>=nw)or(b div @'20>=nh)or(b mod @'20>=nd)or
+ (c div 4>=ni) then abort;
+ case c mod 4 of
+ lig_tag: if d>=nl then abort;
+ ext_tag: if d>=ne then abort;
+ list_tag: @<Check for charlist cycle@>;
+ othercases do_nothing {|no_tag|}
+ endcases;
+ end
+@y
+if font_level=1 then begin
+ i:=0;
+ k:=ivalues_start(f);
+ font_counter:=ivalues_base(f);
+ while k<fvalues_start(f) do {IVALUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<mvalues_start(f) do {FVALUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<rules_start(f) do {MVALUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<glues_start(f) do {RULE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param*3;
+ table_size[i]:=3;
+ incr(i); incr(k);
+ end;
+ while k<penalties_start(f) do {GLUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param*4;
+ table_size[i]:=4;
+ incr(i); incr(k);
+ end;
+ while k<ivalues_base(f) do {PENALTY starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param*1;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<fvalues_base(f) do {IVALUE entries}
+ begin
+ read_thirtytwo(font_info(f)(k).int);
+ incr(k);
+ end;
+ while k<mvalues_base(f) do {FVALUE entries}
+ begin
+ read_thirtytwo(font_info(f)(k).sc);
+ incr(k);
+ end;
+ while k<rules_base(f) do {MVALUE entries}
+ begin
+ read_thirtytwo(font_info(f)(k).int);
+ incr(k);
+ end;
+ while k<glues_base(f) do {RULE entries}
+ begin
+ store_scaled(font_info(f)(k).sc);
+ store_scaled(font_info(f)(k+1).sc);
+ store_scaled(font_info(f)(k+2).sc);
+ k:=k+3;
+ end;
+ while k<penalties_base(f) do {GLUE entries}
+ begin
+ fget; read_sixteen(font_info(f)(k).hh.lhfield);
+ fget; read_sixteen(font_info(f)(k).hh.rh);
+ store_scaled(font_info(f)(k+1).sc);
+ store_scaled(font_info(f)(k+2).sc);
+ store_scaled(font_info(f)(k+3).sc);
+ k:=k+4;
+ end;
+ while k<offset_charinfo_base do {PENALTY entries}
+ begin
+ read_thirtytwo(font_info(f)(k).int);
+ incr(k);
+ end;
+ end;
+k:=char_base(f)+bc;
+k_param:=char_attr_base(f);
+bytes_per_entry:=(12 + 2*npc) div 4 * 4;
+extra_char_bytes:=bytes_per_entry - (10 + 2*npc);
+while k<char_attr_base(f) do begin
+ store_char_info(font_info(f)(k).qqqq);
+ if (a>=nw)or((b div @"100)>=nh)or((b mod @"100)>=nd)or
+ ((c div @"100)>=ni) then abort;
+ case c mod 4 of
+ lig_tag: if d>=nl then abort;
+ ext_tag: if d>=ne then abort;
+ list_tag: @<Check for charlist cycle@>;
+ othercases do_nothing {|no_tag|}
+ endcases;
+ incr(k);
+ if font_level=1 then begin
+ fget; read_sixteen_unsigned(repeat_no);
+ for i:=0 to npc-1 do begin
+ fget; read_sixteen(param);
+ font_info(f)(k_param).int :=
+ font_info(f)(ivalues_start(f)+i).int + param*table_size[i];
+ incr(k_param);
+ end;
+ for i:=1 to extra_char_bytes do fget;
+ for i:=1 to repeat_no do begin
+ font_info(f)(k):=font_info(f)(k-1);
+ incr(k);
+ for table_counter:=0 to npc-1 do begin
+ font_info(f)(k_param).int := font_info(f)(k_param-npc).int;
+ incr(k_param);
+ end;
+ end;
+ end;
+ end
+@z
+%---------------------------------------
+@x [30] m.570 l.11059 - Omega
+@d current_character_being_worked_on==k+bc-fmem_ptr
+@y
+@d current_character_being_worked_on==k-char_base(f)
+@z
+%---------------------------------------
+@x [30] m.570 l.11065 - Omega
+ begin qw:=char_info(f)(d);
+ {N.B.: not |qi(d)|, since |char_base[f]| hasn't been adjusted yet}
+@y
+ begin qw:=char_info(f)(d);
+ {N.B.: not |qi(d)|, since |char_base(f)| hasn't been adjusted yet}
+@z
+%---------------------------------------
+@x [30] m.571 l.11098 - Omega
+for k:=width_base[f] to lig_kern_base[f]-1 do
+ store_scaled(font_info[k].sc);
+if font_info[width_base[f]].sc<>0 then abort; {\\{width}[0] must be zero}
+if font_info[height_base[f]].sc<>0 then abort; {\\{height}[0] must be zero}
+if font_info[depth_base[f]].sc<>0 then abort; {\\{depth}[0] must be zero}
+if font_info[italic_base[f]].sc<>0 then abort; {\\{italic}[0] must be zero}
+@y
+for k:=width_base(f) to lig_kern_base(f)-1 do
+ store_scaled(font_info(f)(k).sc);
+if font_info(f)(width_base(f)).sc<>0 then abort; {\\{width}[0] must be zero}
+if font_info(f)(height_base(f)).sc<>0 then abort; {\\{height}[0] must be zero}
+if font_info(f)(depth_base(f)).sc<>0 then abort; {\\{depth}[0] must be zero}
+if font_info(f)(italic_base(f)).sc<>0 then abort; {\\{italic}[0] must be zero}
+@z
+%---------------------------------------
+@x [30] m.573 l.11114 - Omega
+@ @d check_existence(#)==@t@>@;@/
+ begin check_byte_range(#);
+ qw:=char_info(f)(#); {N.B.: not |qi(#)|}
+ if not char_exists(qw) then abort;
+ end
+
+@<Read ligature/kern program@>=
+bch_label:=@'77777; bchar:=256;
+if nl>0 then
+ begin for k:=lig_kern_base[f] to kern_base[f]+kern_base_offset-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if a>128 then
+ begin if 256*c+d>=nl then abort;
+ if a=255 then if k=lig_kern_base[f] then bchar:=b;
+ end
+ else begin if b<>bchar then check_existence(b);
+ if c<128 then check_existence(d) {check ligature}
+ else if 256*(c-128)+d>=nk then abort; {check kern}
+ if a<128 then if k-lig_kern_base[f]+a+1>=nl then abort;
+ end;
+ end;
+ if a=255 then bch_label:=256*c+d;
+ end;
+for k:=kern_base[f]+kern_base_offset to exten_base[f]-1 do
+ store_scaled(font_info[k].sc);
+@y
+@ @d check_existence(#)==@t@>@;@/
+ begin check_byte_range(#);
+ qw:=char_info(f)(#+font_offset(f)); {N.B.: not |qi(#)|}
+ if not char_exists(qw) then abort;
+ end
+
+@<Read ligature/kern program@>=
+bch_label:=nl {infinity}; bchar:=too_big_char;
+if nl>0 then
+ begin for k:=lig_kern_base(f) to kern_base(f)+kern_base_offset-1 do
+ begin store_four_quarters(font_info(f)(k).qqqq);
+ if a>128 then
+ begin if 256*c+d>=nl then abort;
+ if a=255 then if k=lig_kern_base(f) then bchar:=b;
+ end
+ else begin if b<>bchar then check_existence(b);
+ if c<128 then check_existence(d) {check ligature}
+ else if 256*(c-128)+d>=nk then abort; {check kern}
+ if a<128 then if k-lig_kern_base(f)+a+1>=nl then abort;
+ end;
+ end;
+ if a=255 then bch_label:=256*c+d;
+ end;
+for k:=kern_base(f)+kern_base_offset to exten_base(f)-1 do
+ store_scaled(font_info(f)(k).sc);
+@z
+%---------------------------------------
+@x [30] m.574 l.11141 - Omega
+for k:=exten_base[f] to param_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+@y
+for k:=exten_base(f) to param_base(f)-1 do
+ begin store_four_quarters(font_info(f)(k).qqqq);
+@z
+%---------------------------------------
+@x [30] m.575 l.11157 - Omega
+ fget; font_info[param_base[f]].sc:=
+ (sw*@'20)+(fbyte div@'20);
+ end
+ else store_scaled(font_info[param_base[f]+k-1].sc);
+if eof(tfm_file) then abort;
+for k:=np+1 to 7 do font_info[param_base[f]+k-1].sc:=0;
+@y
+ fget; font_info(f)(param_base(f)).sc:=
+ (sw*@'20)+(fbyte div@'20);
+ end
+ else store_scaled(font_info(f)(param_base(f)+k-1).sc);
+if eof(tfm_file) then abort;
+for k:=np+1 to 7 do font_info(f)(param_base(f)+k-1).sc:=0;
+@z
+%---------------------------------------
+@x [30] m.576 l.11169 - Omega
+@d adjust(#)==#[f]:=qo(#[f])
+ {correct for the excess |min_quarterword| that was added}
+
+@<Make final adjustments...@>=
+if np>=7 then font_params[f]:=np@+else font_params[f]:=7;
+hyphen_char[f]:=default_hyphen_char; skew_char[f]:=default_skew_char;
+if bch_label<nl then bchar_label[f]:=bch_label+lig_kern_base[f]
+else bchar_label[f]:=non_address;
+font_bchar[f]:=qi(bchar);
+font_false_bchar[f]:=qi(bchar);
+if bchar<=ec then if bchar>=bc then
+ begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+ if char_exists(qw) then font_false_bchar[f]:=non_char;
+ end;
+font_name[f]:=nom;
+font_area[f]:=aire;
+font_bc[f]:=bc; font_ec[f]:=ec; font_glue[f]:=null;
+adjust(char_base); adjust(width_base); adjust(lig_kern_base);
+adjust(kern_base); adjust(exten_base);
+decr(param_base[f]);
+fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; goto done
+@y
+@d adjust(#)==#(f):=qo(#(f))
+ {correct for the excess |min_quarterword| that was added}
+
+@<Make final adjustments...@>=
+if np>=7 then font_params(f):=np@+else font_params(f):=7;
+font_offset(f):=offset;
+hyphen_char(f):=default_hyphen_char+offset;
+skew_char(f):=default_skew_char+offset;
+bchar:=bchar+offset;
+if bch_label<nl then bchar_label(f):=bch_label+lig_kern_base(f)
+else bchar_label(f):=non_address;
+font_bchar(f):=qi(bchar);
+font_false_bchar(f):=qi(bchar);
+if bchar<=ec then if bchar>=bc then
+ begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+ if char_exists(qw) then font_false_bchar(f):=non_char;
+ end;
+font_name(f):=nom;
+font_area(f):=aire;
+font_bc(f):=bc; font_ec(f):=ec; font_glue(f):=null;
+font_bc(f):=bc+offset; font_ec(f):=ec+offset; font_glue(f):=null;
+adjust(char_base); adjust(width_base); adjust(lig_kern_base);
+adjust(kern_base); adjust(exten_base);
+decr(param_base(f));
+font_ptr:=f; g:=f; goto done
+@z
+%---------------------------------------
+@x [30] m.577 l.11202 - Omega
+ begin m:=cur_chr; scan_four_bit_int; f:=equiv(m+cur_val);
+@y
+ begin m:=cur_chr; scan_big_four_bit_int; f:=equiv(m+cur_val);
+@z
+%---------------------------------------
+@x [30] m.578 l.11223 - Omega
+if n<=0 then cur_val:=fmem_ptr
+else begin if writing and(n<=space_shrink_code)and@|
+ (n>=space_code)and(font_glue[f]<>null) then
+ begin delete_glue_ref(font_glue[f]);
+ font_glue[f]:=null;
+ end;
+ if n>font_params[f] then
+ if f<font_ptr then cur_val:=fmem_ptr
+ else @<Increase the number of parameters in the last font@>
+ else cur_val:=n+param_base[f];
+ end;
+@<Issue an error message if |cur_val=fmem_ptr|@>;
+end;
+@y
+dimen_font:=f;
+if n<=0 then cur_val:=font_file_size(f)
+else begin if writing and(n<=space_shrink_code)and@|
+ (n>=space_code)and(font_glue(f)<>null) then
+ begin delete_glue_ref(font_glue(f));
+ font_glue(f):=null;
+ end;
+ if n>font_params(f) then
+ if f<font_ptr then cur_val:=font_file_size(f)
+ else @<Increase the number of parameters in the last font@>
+ else cur_val:=n+param_base(f);
+ end;
+@<Issue an error message if |cur_val=font_file_size(f)|@>;
+end;
+@z
+%---------------------------------------
+@x [30] m.579 l.11240 - Omega
+@ @<Issue an error message if |cur_val=fmem_ptr|@>=
+if cur_val=fmem_ptr then
+ begin print_err("Font "); print_esc(font_id_text(f));
+ print(" has only "); print_int(font_params[f]);
+ print(" fontdimen parameters");
+@.Font x has only...@>
+ help2("To increase the number of font parameters, you must")@/
+ ("use \fontdimen immediately after the \font is loaded.");
+ error;
+ end
+@y
+@ @<Issue an error message if |cur_val=font_file_size(f)|@>=
+if cur_val=font_file_size(f) then
+ begin print_err("Font "); print_esc(font_id_text(f));
+ print(" has only "); print_int(font_params(f));
+ print(" fontdimen parameters");
+@.Font x has only...@>
+ help2("To increase the number of font parameters, you must")@/
+ ("use \fontdimen immediately after the \font is loaded.");
+ error;
+ end
+@z
+%---------------------------------------
+@x [30] m.580 l.11252 - font parameters
+@ @<Increase the number of parameters...@>=
+begin repeat if fmem_ptr=font_mem_size then
+ overflow("font memory",font_mem_size);
+@:TeX capacity exceeded font memory}{\quad font memory@>
+font_info[fmem_ptr].sc:=0; incr(fmem_ptr); incr(font_params[f]);
+until n=font_params[f];
+cur_val:=fmem_ptr-1; {this equals |param_base[f]+font_params[f]|}
+@y
+@ @<Increase the number of parameters...@>=
+begin if n+font_params(f)>font_file_size(f) then
+ begin print_nl("Out of font parameter space"); succumb; end;
+repeat
+font_info(f)(param_base(f)+font_params(f)).sc:=0; incr(font_params(f));
+until n=font_params(f);
+cur_val:=param_base(f)+font_params(f);
+@z
+%---------------------------------------
+@x [30] m.581 l.11268 - font parameters
+ slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
+@y
+ slow_print(font_name(f)); print_char("!"); end_diagnostic(false);
+@z
+%---------------------------------------
+@x [30] m.582 l.11276 - font parameters
+begin if font_bc[f]<=c then if font_ec[f]>=c then
+@y
+begin if font_bc(f)<=c then if font_ec(f)>=c then
+@z
+%---------------------------------------
+@x [32] m.592 l.11820 - Omega
+@!c,@!f:quarterword; {character and font in current |char_node|}
+@y
+@!c,@!f:quarterword; {character and font in current |char_node|}
+@!oval,@!ocmd:integer; {used by |out_cmd| for generating
+ |set|, |fnt| and |fnt_def| commands}
+@z
+%---------------------------------------
+@x [32] m.602 l.11939 - Omega
+@ Here's a procedure that outputs a font definition. Since \TeX82 uses at
+most 256 different fonts per job, |fnt_def1| is always used as the command code.
+@y
+@ Here's a procedure that outputs a font definition. $\Omega$ allows
+more than 256 different fonts per job, so the right font definition
+command must be selected.
+
+@d Incr_Decr(#) == #
+@d Incr(#) == #:=#+Incr_Decr {increase a variable}
+@d Decr(#) == #:=#-Incr_Decr {decrease a variable}
+
+@d dvi_debug_out(#)==begin
+dvi_out(#);
+end
+
+@d out_cmd ==
+begin
+if (oval<@"100)and(oval>=0) then begin
+ if (ocmd<>set1)or(oval>127) then
+ if (ocmd=fnt1)and(oval<64) then Incr(oval)(fnt_num_0) @+ else dvi_debug_out(ocmd);
+ end
+else
+ begin if (oval<@"10000)and(oval>=0) then dvi_debug_out(ocmd+1) @+ else @;
+ begin if (oval<@"1000000)and(oval>=0) then dvi_debug_out(ocmd+2) @+ else @;
+ begin dvi_debug_out(ocmd+3);
+ if oval>=0 then dvi_debug_out(oval div @"1000000)
+ else begin Incr(oval)(@"40000000); Incr(oval)(@"40000000);
+ dvi_debug_out((oval div @"1000000) + 128); oval:=oval mod @"1000000;
+ end;
+ dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
+ end;
+ dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
+ end;
+ dvi_debug_out(oval div @"100); oval:=oval mod @"100;
+ end;
+dvi_debug_out(oval)
+end
+
+@z
+%---------------------------------------
+@x [32] m.602 l.11944 - Omega
+begin dvi_out(fnt_def1);
+dvi_out(f-font_base-1);@/
+dvi_out(qo(font_check[f].b0));
+dvi_out(qo(font_check[f].b1));
+dvi_out(qo(font_check[f].b2));
+dvi_out(qo(font_check[f].b3));@/
+dvi_four(font_size[f]);
+dvi_four(font_dsize[f]);@/
+dvi_out(length(font_area[f]));
+dvi_out(length(font_name[f]));
+@y
+begin
+oval:=f-font_base-1; ocmd:= fnt_def1; out_cmd;@/
+dvi_out(qo(font_check_0(f)));
+dvi_out(qo(font_check_1(f)));
+dvi_out(qo(font_check_2(f)));
+dvi_out(qo(font_check_3(f)));@/
+dvi_four(font_size(f));
+dvi_four(font_dsize(f));@/
+dvi_out(length(font_area(f)));
+dvi_out(length(font_name(f)));
+@z
+%---------------------------------------
+@x [32] m.603 l.11958 - Omega
+for k:=str_start[font_area[f]] to str_start[font_area[f]+1]-1 do
+ dvi_out(so(str_pool[k]));
+for k:=str_start[font_name[f]] to str_start[font_name[f]+1]-1 do
+ dvi_out(so(str_pool[k]))
+@y
+for k:=str_start(font_area(f)) to str_start(font_area(f)+1)-1 do
+ dvi_out(so(str_pool[k]));
+for k:=str_start(font_name(f)) to str_start(font_name(f)+1)-1 do
+ dvi_out(so(str_pool[k]))
+@z
+%---------------------------------------
+@x [32] m.620 l.12334 - Omega
+ if c>=qi(128) then dvi_out(set1);
+ dvi_out(qo(c));@/
+@y
+ oval:=c-font_offset(f); ocmd:=set1; out_cmd;@/
+@z
+%---------------------------------------
+@x [32] m.621 l.12345 - Omega
+begin if not font_used[f] then
+ begin dvi_font_def(f); font_used[f]:=true;
+ end;
+if f<=64+font_base then dvi_out(f-font_base-1+fnt_num_0)
+else begin dvi_out(fnt1); dvi_out(f-font_base-1);
+ end;
+@y
+begin if not font_used(f) then
+ begin dvi_font_def(f); font_used(f):=true;
+ end;
+oval:=f-font_base-1; ocmd:=fnt1; out_cmd;@/
+@z
+%---------------------------------------
+@x [32] m.643 l.12757 - Omega
+ begin if font_used[font_ptr] then dvi_font_def(font_ptr);
+@y
+ begin if font_used(font_ptr) then dvi_font_def(font_ptr);
+@z
+%---------------------------------------
+@x [35] m.699 l.13742 - Omega
+@d text_size=0 {size code for the largest size in a family}
+@d script_size=16 {size code for the medium size in a family}
+@d script_script_size=32 {size code for the smallest size in a family}
+@y
+@z
+%---------------------------------------
+@x [35] m.700 l.13762 - Omega
+@d mathsy_end(#)==fam_fnt(2+#)]].sc
+@d mathsy(#)==font_info[#+param_base[mathsy_end
+@y
+@d mathsy_end(#)==sc
+@d mathsy(#)==font_info(fam_fnt(2+cur_size))(#+param_base(fam_fnt(2+cur_size))).mathsy_end
+@z
+%---------------------------------------
+@x [35] m.701 l.13789 - Omega
+@d mathex(#)==font_info[#+param_base[fam_fnt(3+cur_size)]].sc
+@y
+@d mathex(#)==font_info(fam_fnt(3+cur_size))(#+param_base(fam_fnt(3+cur_size))).sc
+@z
+%---------------------------------------
+@x [35] m.703 l.13813 - Omega
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
+begin if cur_style<script_style then cur_size:=text_size
+else cur_size:=16*((cur_style-text_style) div 2);
+cur_mu:=x_over_n(math_quad(cur_size),18);
+end
+@y
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
+begin if cur_style<script_style then cur_size:=text_size
+else cur_size:=script_size*((cur_style-text_style) div 2);
+cur_mu:=x_over_n(math_quad(cur_size),18);
+end
+@z
+%---------------------------------------
+@x [35] m.706 l.13855 - Omega
+function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer;
+label found,continue;
+var b:pointer; {the box that will be constructed}
+@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
+@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
+@!m,@!n: integer; {the number of extensible pieces}
+@!u: scaled; {height-plus-depth of a tentative character}
+@!w: scaled; {largest height-plus-depth so far}
+@!q: four_quarters; {character info}
+@!hd: eight_bits; {height-depth byte}
+@!r: four_quarters; {extensible pieces}
+@!z: small_number; {runs through font family members}
+@y
+function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer;
+label found,continue;
+var b:pointer; {the box that will be constructed}
+@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
+@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
+@!m,@!n: integer; {the number of extensible pieces}
+@!u: scaled; {height-plus-depth of a tentative character}
+@!w: scaled; {largest height-plus-depth so far}
+@!q: four_quarters; {character info}
+@!hd: eight_bits; {height-depth byte}
+@!r: four_quarters; {extensible pieces}
+@!z: integer; {runs through font family members}
+@z
+%---------------------------------------
+@x [35] m.706 l.13881 - Omega
+shift_amount(b):=half(height(b)-depth(b)) - axis_height(s);
+@y
+z:=cur_size; cur_size:=s;
+shift_amount(b):=half(height(b)-depth(b)) - axis_height(cur_size);
+cur_size:=z;
+@z
+%---------------------------------------
+@x [35] m.707 l.13889 - Omega
+@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
+if (z<>0)or(x<>min_quarterword) then
+ begin z:=z+s+16;
+ repeat z:=z-16; g:=fam_fnt(z);
+ if g<>null_font then
+ @<Look at the list of characters starting with |x| in
+ font |g|; set |f| and |c| whenever
+ a better character is found; |goto found| as soon as a
+ large enough variant is encountered@>;
+ until z<16;
+ end
+@y
+@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
+if (z<>0)or(x<>min_quarterword) then
+ begin z:=z+s+script_size;
+ repeat z:=z-script_size; g:=fam_fnt(z);
+ if g<>null_font then
+ @<Look at the list of characters starting with |x| in
+ font |g|; set |f| and |c| whenever
+ a better character is found; |goto found| as soon as a
+ large enough variant is encountered@>;
+ until z<script_size;
+ end
+@z
+%---------------------------------------
+@x [35] m.708 l.13903 - Omega
+if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
+@y
+if (qo(y)>=font_bc(g))and(qo(y)<=font_ec(g)) then
+@z
+%---------------------------------------
+@x [35] m.713 l.13974 - Omega
+r:=font_info[exten_base[f]+rem_byte(q)].qqqq;@/
+@<Compute the minimum suitable height, |w|, and the corresponding
+ number of extension steps, |n|; also set |width(b)|@>;
+c:=ext_bot(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+c:=ext_rep(r);
+for m:=1 to n do stack_into_box(b,f,c);
+c:=ext_mid(r);
+if c<>min_quarterword then
+ begin stack_into_box(b,f,c); c:=ext_rep(r);
+ for m:=1 to n do stack_into_box(b,f,c);
+ end;
+c:=ext_top(r);
+@y
+r:=font_info(f)(exten_base(f)+rem_byte(q)).qqqq;@/
+@<Compute the minimum suitable height, |w|, and the corresponding
+ number of extension steps, |n|; also set |width(b)|@>;
+c:=ext_bot(f)(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+c:=ext_rep(f)(r);
+for m:=1 to n do stack_into_box(b,f,c);
+c:=ext_mid(f)(r);
+if c<>min_quarterword then
+ begin stack_into_box(b,f,c); c:=ext_rep(f)(r);
+ for m:=1 to n do stack_into_box(b,f,c);
+ end;
+c:=ext_top(f)(r);
+@z
+%---------------------------------------
+@x [35] m.714 l.13997 - Omega
+c:=ext_rep(r); u:=height_plus_depth(f,c);
+w:=0; q:=char_info(f)(c); width(b):=char_width(f)(q)+char_italic(f)(q);@/
+c:=ext_bot(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_mid(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_top(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+n:=0;
+if u>0 then while w<v do
+ begin w:=w+u; incr(n);
+ if ext_mid(r)<>min_quarterword then w:=w+u;
+ end
+@y
+c:=ext_rep(f)(r); u:=height_plus_depth(f,c);
+w:=0; q:=char_info(f)(c); width(b):=char_width(f)(q)+char_italic(f)(q);@/
+c:=ext_bot(f)(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_mid(f)(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_top(f)(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+n:=0;
+if u>0 then while w<v do
+ begin w:=w+u; incr(n);
+ if (ext_mid(f)(r))<>min_quarterword then w:=w+u;
+ end
+@z
+%---------------------------------------
+@x [36] m.719 l.14107 - Omega
+@!cur_style:small_number; {style code at current place in the list}
+@!cur_size:small_number; {size code corresponding to |cur_style|}
+@y
+@!cur_style:integer; {style code at current place in the list}
+@!cur_size:integer; {size code corresponding to |cur_style|}
+@z
+%---------------------------------------
+@x [36] m.720 l.14122 - Omega
+function clean_box(@!p:pointer;@!s:small_number):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:small_number; {|cur_style| to be restored}
+@y
+function clean_box(@!p:pointer;@!s:integer):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:integer; {|cur_style| to be restored}
+@z
+%---------------------------------------
+@x [36] m.722 l.14172 - Omega
+else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
+@y
+else begin if (qo(cur_c)>=font_bc(cur_f))and(qo(cur_c)<=font_ec(cur_f)) then
+@z
+%---------------------------------------
+@x [36] m.726 l.14228 - Omega
+procedure mlist_to_hlist;
+label reswitch, check_dimensions, done_with_noad, done_with_node, delete_q,
+ done;
+var mlist:pointer; {beginning of the given list}
+@!penalties:boolean; {should penalty nodes be inserted?}
+@!style:small_number; {the given style}
+@!save_style:small_number; {holds |cur_style| during recursion}
+@!q:pointer; {runs through the mlist}
+@!r:pointer; {the most recent noad preceding |q|}
+@!r_type:small_number; {the |type| of noad |r|, or |op_noad| if |r=null|}
+@!t:small_number; {the effective |type| of noad |q| during the second pass}
+@!p,@!x,@!y,@!z: pointer; {temporary registers for list construction}
+@!pen:integer; {a penalty to be inserted}
+@!s:small_number; {the size of a noad to be deleted}
+@y
+procedure mlist_to_hlist;
+label reswitch, check_dimensions, done_with_noad, done_with_node, delete_q,
+ done;
+var mlist:pointer; {beginning of the given list}
+@!penalties:boolean; {should penalty nodes be inserted?}
+@!style:integer; {the given style}
+@!save_style:integer; {holds |cur_style| during recursion}
+@!q:pointer; {runs through the mlist}
+@!r:pointer; {the most recent noad preceding |q|}
+@!r_type:integer; {the |type| of noad |r|, or |op_noad| if |r=null|}
+@!t:integer; {the effective |type| of noad |q| during the second pass}
+@!p,@!x,@!y,@!z: pointer; {temporary registers for list construction}
+@!pen:integer; {a penalty to be inserted}
+@!s:integer; {the size of a noad to be deleted}
+@z
+%---------------------------------------
+@x [36] m.741 l.14495 - Omega
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin if qo(next_char(cur_i))=skew_char[cur_f] then
+ begin if op_byte(cur_i)>=kern_flag then
+ if skip_byte(cur_i)<=stop_flag then s:=char_kern(cur_f)(cur_i);
+ goto done1;
+ end;
+ if skip_byte(cur_i)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+ end;
+ end;
+ end;
+done1:
+@y
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_i:=font_info(cur_f)(a).qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info(cur_f)(a).qqqq;
+ end;
+ loop@+ begin if qo((next_char(cur_f)(cur_i)))=skew_char(cur_f) then
+ begin if op_byte(cur_i)>=kern_flag then
+ if skip_byte(cur_i)<=stop_flag then s:=char_kern(cur_f)(cur_i);
+ goto done1;
+ end;
+ if skip_byte(cur_i)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info(cur_f)(a).qqqq;
+ end;
+ end;
+ end;
+done1:
+@z
+%---------------------------------------
+@x [36] m.752 l.14722 - Omega
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach
+ the kern after~|q|; or if it is a ligature with |cur_c|, combine
+ noads |q| and~|p| appropriately; then |return| if the cursor has
+ moved past a noad, or |goto restart|@>;
+ if skip_byte(cur_i)>=stop_flag then return;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+@y
+ cur_i:=font_info(cur_f)(a).qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info(cur_f)(a).qqqq;
+ end;
+ loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach
+ the kern after~|q|; or if it is a ligature with |cur_c|, combine
+ noads |q| and~|p| appropriately; then |return| if the cursor has
+ moved past a noad, or |goto restart|@>;
+ if skip_byte(cur_i)>=stop_flag then return;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info(cur_f)(a).qqqq;
+@z
+%---------------------------------------
+@x [36] m.753 l.14751 - Omega
+if next_char(cur_i)=cur_c then if skip_byte(cur_i)<=stop_flag then
+@y
+if (next_char(cur_f)(cur_i))=cur_c then if skip_byte(cur_i)<=stop_flag then
+@z
+%---------------------------------------
+@x [36] m.756 l.14833 - Omega
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:small_number; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural);
+ if cur_style<script_style then t:=script_size@+else t:=script_script_size;
+ shift_up:=height(z)-sup_drop(t);
+ shift_down:=depth(z)+sub_drop(t);
+@y
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:integer; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural);
+ t:=cur_size;
+ if cur_style<script_style
+ then cur_size:=script_size@+else cur_size:=script_script_size;
+ shift_up:=height(z)-sup_drop(cur_size);
+ shift_down:=depth(z)+sub_drop(cur_size);
+ cur_size:=t;
+@z
+%---------------------------------------
+@x [36] m.762 l.14967 - Omega
+function make_left_right(@!q:pointer;@!style:small_number;
+ @!max_d,@!max_h:scaled):small_number;
+var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
+begin if style<script_style then cur_size:=text_size
+else cur_size:=16*((style-text_style) div 2);
+@y
+function make_left_right(@!q:pointer;@!style:integer;
+ @!max_d,@!max_h:scaled):integer;
+var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
+begin if style<script_style then cur_size:=text_size
+else cur_size:=script_size*((style-text_style) div 2);
+@z
+%---------------------------------------
+@x [40] m.896 l.17534 - Omega
+done2: hyf_char:=hyphen_char[hf];
+@y
+done2: hyf_char:=hyphen_char(hf);
+@z
+%---------------------------------------
+@x [40] m.897 l.17555 - Omega
+ hyf_bchar:=font_bchar[hf];
+@y
+ hyf_bchar:=font_bchar(hf);
+@z
+%---------------------------------------
+@x [40] m.898 l.17578 - Omega
+if odd(subtype(s)) then hyf_bchar:=font_bchar[hf]@+else hyf_bchar:=non_char;
+@y
+if odd(subtype(s)) then hyf_bchar:=font_bchar(hf)@+else hyf_bchar:=non_char;
+@z
+%---------------------------------------
+@x [41] m.909 l.17800 - Omega
+ begin k:=bchar_label[hf];
+ if k=non_address then goto done@+else q:=font_info[k].qqqq;
+ end
+else begin q:=char_info(hf)(cur_l);
+ if char_tag(q)<>lig_tag then goto done;
+ k:=lig_kern_start(hf)(q); q:=font_info[k].qqqq;
+ if skip_byte(q)>stop_flag then
+ begin k:=lig_kern_restart(hf)(q); q:=font_info[k].qqqq;
+@y
+ begin k:=bchar_label(hf);
+ if k=non_address then goto done@+else q:=font_info(hf)(k).qqqq;
+ end
+else begin q:=char_info(hf)(cur_l);
+ if char_tag(q)<>lig_tag then goto done;
+ k:=lig_kern_start(hf)(q); q:=font_info(hf)(k).qqqq;
+ if skip_byte(q)>stop_flag then
+ begin k:=lig_kern_restart(hf)(q); q:=font_info(hf)(k).qqqq;
+@z
+%---------------------------------------
+@x [41] m.909 l.17811 - Omega
+loop@+begin if next_char(q)=test_char then if skip_byte(q)<=stop_flag then
+@y
+loop@+begin if (next_char(hf)(q))=test_char then if skip_byte(q)<=stop_flag then
+@z
+%---------------------------------------
+@x [41] m.909 l.17829 - Omega
+ k:=k+qo(skip_byte(q))+1; q:=font_info[k].qqqq;
+@y
+ k:=k+qo(skip_byte(q))+1; q:=font_info(hf)(k).qqqq;
+@z
+%---------------------------------------
+@x [41] m.915 l.17963 - Omega
+ begin l:=reconstitute(l,i,font_bchar[hf],non_char)+1;
+@y
+ begin l:=reconstitute(l,i,font_bchar(hf),non_char)+1;
+@z
+%---------------------------------------
+@x [41] m.916 l.17980 - Omega
+if bchar_label[hf]<>non_address then {put left boundary at beginning of new line}
+@y
+if bchar_label(hf)<>non_address then {put left boundary at beginning of new line}
+@z
+%---------------------------------------
+@x [46] m.1030 l.19987 - Omega
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+@y
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+hmode+char_ghost: begin t:=cur_chr; get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then begin
+ if t=0 then new_left_ghost:=true
+ else new_right_ghost:=true;
+ end;
+ goto reswitch;
+ end;
+@z
+%---------------------------------------
+@x [46] m.1032 l.20030 - Omega
+ |font_bchar[cur_font]|,&otherwise;\cr}$$
+except when |character(lig_stack)=font_false_bchar[cur_font]|.
+@y
+ |font_bchar(cur_font)|,&otherwise;\cr}$$
+except when |character(lig_stack)=font_false_bchar(cur_font)|.
+@z
+%---------------------------------------
+@x [46] m.1032
+@!cancel_boundary:boolean; {should the left boundary be ignored?}
+@!ins_disc:boolean; {should we insert a discretionary node?}
+@y
+@!cancel_boundary:boolean; {should the left boundary be ignored?}
+@!left_ghost:boolean; {character left of cursor is a left ghost}
+@!right_ghost:boolean; {character left of cursor is a right ghost}
+@!new_left_ghost:boolean; {character right of cursor is a left ghost}
+@!new_right_ghost:boolean; {character right of cursor is a right ghost}
+@!ins_disc:boolean; {should we insert a discretionary node?}
+@!k_glue:integer;
+@!font_glue_spec:pointer;
+@z
+%---------------------------------------
+@x [46] m.1033
+ligature_present:=false; cancel_boundary:=false; lft_hit:=false; rt_hit:=false;
+@y
+ligature_present:=false; cancel_boundary:=false; lft_hit:=false; rt_hit:=false;
+left_ghost:=false; right_ghost:=false;
+new_left_ghost:=false; new_right_ghost:=false;
+@z
+%---------------------------------------
+@x [46] m.1034 l.20075 - Omega
+adjust_space_factor;@/
+main_f:=cur_font;
+bchar:=font_bchar[main_f]; false_bchar:=font_false_bchar[main_f];
+if mode>0 then if language<>clang then fix_language;
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+character(lig_stack):=cur_l;@/
+cur_q:=tail;
+if cancel_boundary then
+ begin cancel_boundary:=false; main_k:=non_address;
+ end
+else main_k:=bchar_label[main_f];
+if main_k=non_address then goto main_loop_move+2; {no left boundary processing}
+cur_r:=cur_l; cur_l:=non_char;
+goto main_lig_loop+1; {begin with cursor after left boundary}
+@y
+adjust_space_factor;@/
+main_f:=cur_font;
+bchar:=font_bchar(main_f); false_bchar:=font_false_bchar(main_f);
+if mode>0 then if language<>clang then fix_language;
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+character(lig_stack):=cur_l;@/
+cur_q:=tail;
+if cancel_boundary then
+ begin cancel_boundary:=false; main_k:=non_address;
+ left_ghost:=new_left_ghost; right_ghost:=new_right_ghost;
+ new_left_ghost:=false; new_right_ghost:=false;
+ end
+else main_k:=bchar_label(main_f);
+if main_k=non_address then goto main_loop_move+2; {no left boundary processing}
+cur_r:=cur_l; cur_l:=non_char;
+if not new_right_ghost then
+ goto main_lig_loop+1; {begin with cursor after left boundary}
+@z
+%---------------------------------------
+@x [46] m.1035 l.20122 - Omega
+ begin if character(tail)=qi(hyphen_char[main_f]) then if link(cur_q)>null then
+@y
+ begin if character(tail)=qi(hyphen_char(main_f)) then if link(cur_q)>null then
+@z
+%---------------------------------------
+@x [46] m.1036 l.20135 - Omega
+if lig_stack=null then goto reswitch;
+cur_q:=tail; cur_l:=character(lig_stack);
+main_loop_move+1:if not is_char_node(lig_stack) then goto main_loop_move_lig;
+main_loop_move+2:if(cur_chr<font_bc[main_f])or(cur_chr>font_ec[main_f]) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+main_i:=char_info(main_f)(cur_l);
+if not char_exists(main_i) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+tail_append(lig_stack) {|main_loop_lookahead| is next}
+@y
+if lig_stack=null then goto reswitch;
+cur_q:=tail; cur_l:=character(lig_stack);
+main_loop_move+1:if not is_char_node(lig_stack) then goto main_loop_move_lig;
+main_loop_move+2:
+left_ghost:=new_left_ghost; right_ghost:=new_right_ghost;
+new_left_ghost:=false; new_right_ghost:=false;
+if(cur_chr<font_bc(main_f))or(cur_chr>font_ec(main_f)) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+main_i:=char_info(main_f)(cur_l);
+if not char_exists(main_i) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+if not (left_ghost or right_ghost) then
+ tail_append(lig_stack) {|main_loop_lookahead| is next}
+@z
+%---------------------------------------
+@x [46] m.1038 l.20177 - Omega
+if cur_cmd=no_boundary then bchar:=non_char;
+@y
+if cur_cmd=char_ghost then begin t:=cur_chr; get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then begin
+ if t=0 then new_left_ghost:=true
+ else new_right_ghost:=true;
+ back_input;
+ goto main_loop_lookahead;
+ end;
+ end;
+if cur_cmd=no_boundary then bchar:=non_char;
+@z
+%---------------------------------------
+@x [46] m.1039 l.20193 - Omega
+@<If there's a ligature/kern command...@>=
+if char_tag(main_i)<>lig_tag then goto main_loop_wrapup;
+main_k:=lig_kern_start(main_f)(main_i); main_j:=font_info[main_k].qqqq;
+if skip_byte(main_j)<=stop_flag then goto main_lig_loop+2;
+main_k:=lig_kern_restart(main_f)(main_j);
+main_lig_loop+1:main_j:=font_info[main_k].qqqq;
+main_lig_loop+2:if next_char(main_j)=cur_r then
+ if skip_byte(main_j)<=stop_flag then
+ @<Do ligature or kern command, returning to |main_lig_loop|
+ or |main_loop_wrapup| or |main_loop_move|@>;
+if skip_byte(main_j)=qi(0) then incr(main_k)
+else begin if skip_byte(main_j)>=stop_flag then goto main_loop_wrapup;
+ main_k:=main_k+qo(skip_byte(main_j))+1;
+ end;
+goto main_lig_loop+1
+@y
+@<If there's a ligature/kern command...@>=
+if new_right_ghost or left_ghost then goto main_loop_wrapup;
+if char_tag(main_i)<>lig_tag then goto main_loop_wrapup;
+main_k:=lig_kern_start(main_f)(main_i);
+main_j:=font_info(main_f)(main_k).qqqq;
+if skip_byte(main_j)<=stop_flag then goto main_lig_loop+2;
+main_k:=lig_kern_restart(main_f)(main_j);
+main_lig_loop+1: main_j:=font_info(main_f)(main_k).qqqq;
+main_lig_loop+2:if top_skip_byte(main_j)=0 then begin
+ if next_char(main_f)(main_j)=cur_r then
+ if skip_byte(main_j)<=stop_flag then
+ @<Do ligature or kern command, returning to |main_lig_loop|
+ or |main_loop_wrapup| or |main_loop_move|@>;
+ end
+ else begin
+ if (font_bc(main_f)<=cur_r) then
+ if (font_ec(main_f)>=cur_r) then
+ if (char_exists(char_info(main_f)(cur_r))) then
+ if cur_r<>bchar then
+ if next_char(main_f)(main_j)=
+ attr_zero_char_ivalue(main_f)(cur_r) then
+ @<Do glue or penalty command@>;
+ end;
+if skip_byte(main_j)=qi(0) then incr(main_k)
+else begin if skip_byte(main_j)>=stop_flag then goto main_loop_wrapup;
+ main_k:=main_k+qo(skip_byte(main_j))+1;
+ end;
+goto main_lig_loop+1
+
+@ There are currently three commands. Command 17 will add a penalty
+node between the two characters. Command 18 will add a glue
+node between the two characters. Command 19 will add a penalty node,
+then a glue node between the two characters. Command 20
+will add a kern nore between the two characters.
+
+@<Do glue or penalty command@>=
+begin
+if new_left_ghost or right_ghost then goto main_loop_wrapup;
+case op_byte(main_j) of
+ qi(20): begin wrapup(rt_hit);
+ tail_append(new_kern(attr_zero_kern(main_f)(rem_byte(main_j))));
+ end;
+ qi(18): begin wrapup(rt_hit);
+ k_glue:=glues_base(main_f) + (rem_byte(main_j)*4);
+ font_glue_spec:=new_spec(zero_glue);
+ width(font_glue_spec):= font_info(main_f)(k_glue+1).sc;
+ stretch(font_glue_spec):=font_info(main_f)(k_glue+2).sc;
+ shrink(font_glue_spec):=font_info(main_f)(k_glue+3).sc;
+ tail_append(new_glue(font_glue_spec));
+ end;
+ qi(19): begin wrapup(rt_hit);
+ tail_append(new_penalty(attr_zero_penalty(main_f)(rem_top_byte(main_j))));
+ k_glue:=glues_base(main_f) + (rem_bot_byte(main_j)*4);
+ font_glue_spec:=new_spec(zero_glue);
+ width(font_glue_spec):= font_info(main_f)(k_glue+1).sc;
+ stretch(font_glue_spec):=font_info(main_f)(k_glue+2).sc;
+ shrink(font_glue_spec):=font_info(main_f)(k_glue+3).sc;
+ tail_append(new_glue(font_glue_spec));
+ end;
+ qi(17): begin wrapup(rt_hit);
+ tail_append(new_penalty(attr_zero_penalty(main_f)(rem_byte(main_j))));
+ end;
+ end;
+goto main_loop_move;
+end
+@z
+%---------------------------------------
+@x [46] m.1040 l.20219 - Omega
+begin if op_byte(main_j)>=kern_flag then
+ begin wrapup(rt_hit);
+ tail_append(new_kern(char_kern(main_f)(main_j))); goto main_loop_move;
+ end;
+if cur_l=non_char then lft_hit:=true
+else if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(main_j) of
+qi(1),qi(5):begin cur_l:=rem_byte(main_j); {\.{=:\?}, \.{=:\?>}}
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_byte(main_j); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack=null then {right boundary character is being consumed}
+ begin lig_stack:=new_lig_item(cur_r); bchar:=non_char;
+ end
+ else if is_char_node(lig_stack) then {|link(lig_stack)=null|}
+ begin main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ lig_ptr(lig_stack):=main_p;
+ end
+ else character(lig_stack):=cur_r;
+ end;
+qi(3):begin cur_r:=rem_byte(main_j); {\.{\?=:\?}}
+ main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ link(lig_stack):=main_p;
+ end;
+qi(7),qi(11):begin wrapup(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=tail; cur_l:=rem_byte(main_j);
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_byte(main_j); ligature_present:=true; {\.{=:}}
+ if lig_stack=null then goto main_loop_wrapup
+ else goto main_loop_move+1;
+ end
+endcases;
+if op_byte(main_j)>qi(4) then
+ if op_byte(main_j)<>qi(7) then goto main_loop_wrapup;
+if cur_l<non_char then goto main_lig_loop;
+main_k:=bchar_label[main_f]; goto main_lig_loop+1;
+end
+@y
+begin if op_byte(main_j)>=kern_flag then
+ begin wrapup(rt_hit);
+ tail_append(new_kern(char_kern(main_f)(main_j)));
+ if new_left_ghost or right_ghost then begin
+ subtype(tail):=explicit;
+ end;
+ goto main_loop_move;
+ end;
+if new_left_ghost or right_ghost then goto main_loop_wrapup;
+if cur_l=non_char then lft_hit:=true
+else if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(main_j) of
+qi(1),qi(5):begin cur_l:=rem_char_byte(main_f)(main_j); {\.{=:\?}, \.{=:\?>}}
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_char_byte(main_f)(main_j); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack=null then {right boundary character is being consumed}
+ begin lig_stack:=new_lig_item(cur_r); bchar:=non_char;
+ end
+ else if is_char_node(lig_stack) then {|link(lig_stack)=null|}
+ begin main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ lig_ptr(lig_stack):=main_p;
+ end
+ else character(lig_stack):=cur_r;
+ end;
+qi(3):begin cur_r:=rem_char_byte(main_f)(main_j); {\.{\?=:\?}}
+ main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ link(lig_stack):=main_p;
+ end;
+qi(7),qi(11):begin wrapup(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=tail; cur_l:=rem_char_byte(main_f)(main_j);
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_char_byte(main_f)(main_j);
+ ligature_present:=true; {\.{=:}}
+ if lig_stack=null then goto main_loop_wrapup
+ else goto main_loop_move+1;
+ end
+endcases;
+if op_byte(main_j)>qi(4) then
+ if op_byte(main_j)<>qi(7) then goto main_loop_wrapup;
+if cur_l<non_char then goto main_lig_loop;
+main_k:=bchar_label(main_f); goto main_lig_loop+1;
+end
+@z
+%---------------------------------------
+@x [46] m.1042 l.20285 - Omega
+begin main_p:=font_glue[cur_font];
+if main_p=null then
+ begin main_p:=new_spec(zero_glue); main_k:=param_base[cur_font]+space_code;
+ width(main_p):=font_info[main_k].sc; {that's |space(cur_font)|}
+ stretch(main_p):=font_info[main_k+1].sc; {and |space_stretch(cur_font)|}
+ shrink(main_p):=font_info[main_k+2].sc; {and |space_shrink(cur_font)|}
+ font_glue[cur_font]:=main_p;
+@y
+begin main_p:=font_glue(cur_font);
+if main_p=null then
+ begin main_p:=new_spec(zero_glue); main_k:=param_base(cur_font)+space_code;
+ width(main_p):=font_info(cur_font)(main_k).sc; {that's |space(cur_font)|}
+ stretch(main_p):=font_info(cur_font)(main_k+1).sc;
+ {and |space_stretch(cur_font)|}
+ shrink(main_p):=font_info(cur_font)(main_k+2).sc;
+ {and |space_shrink(cur_font)|}
+ font_glue(cur_font):=main_p;
+@z
+%---------------------------------------
+@x [47] m.1090
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+@y
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+vmode+char_ghost,
+@z
+%---------------------------------------
+@x [48] m.1117 l.21343 - Omega
+ begin c:=hyphen_char[cur_font];
+@y
+ begin c:=hyphen_char(cur_font);
+@z
+%---------------------------------------
+@x [49] m.1195 l.22361 - Omega
+if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@|
+ (font_params[fam_fnt(2+script_size)]<total_mathsy_params)or@|
+ (font_params[fam_fnt(2+script_script_size)]<total_mathsy_params) then
+ begin print_err("Math formula deleted: Insufficient symbol fonts");@/
+@.Math formula deleted...@>
+ help3("Sorry, but I can't typeset math unless \textfont 2")@/
+ ("and \scriptfont 2 and \scriptscriptfont 2 have all")@/
+ ("the \fontdimen values needed in math symbol fonts.");
+ error; flush_math; danger:=true;
+ end
+else if (font_params[fam_fnt(3+text_size)]<total_mathex_params)or@|
+ (font_params[fam_fnt(3+script_size)]<total_mathex_params)or@|
+ (font_params[fam_fnt(3+script_script_size)]<total_mathex_params) then
+@y
+if (font_params(fam_fnt(2+text_size))<total_mathsy_params)or@|
+ (font_params(fam_fnt(2+script_size))<total_mathsy_params)or@|
+ (font_params(fam_fnt(2+script_script_size))<total_mathsy_params) then
+ begin print_err("Math formula deleted: Insufficient symbol fonts");@/
+@.Math formula deleted...@>
+ help3("Sorry, but I can't typeset math unless \textfont 2")@/
+ ("and \scriptfont 2 and \scriptscriptfont 2 have all")@/
+ ("the \fontdimen values needed in math symbol fonts.");
+ error; flush_math; danger:=true;
+ end
+else if (font_params(fam_fnt(3+text_size))<total_mathex_params)or@|
+ (font_params(fam_fnt(3+script_size))<total_mathex_params)or@|
+ (font_params(fam_fnt(3+script_script_size))<total_mathex_params) then
+@z
+%---------------------------------------
+@x [49] m.1253 l.23250 - Omega
+assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen; font_info[k].sc:=cur_val;
+ end;
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
+@y
+assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen;
+ font_info(dimen_font)(k).sc:=cur_val;
+ end;
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char(f):=cur_val@+else skew_char(f):=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1257 l.23269 - Omega
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+@y
+@!offset:integer;
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+@z
+%---------------------------------------
+@x [49] m.1257 l.23290 - Omega
+@<Scan the font size specification@>;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s);
+common_ending: equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
+@y
+@<Scan the font size specification@>;
+name_in_progress:=true;
+if scan_keyword("offset") then begin
+ scan_int;
+ offset:=cur_val;
+ if (cur_val<0) then begin
+ print_err("Illegal offset has been changed to 0");
+ help1("The offset must be bigger than 0."); int_error(cur_val);
+ offset:=0;
+ end
+ end
+else offset:=0;
+name_in_progress:=false;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s,offset);
+common_ending: set_equiv(u,f);
+set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t);
+@z
+%---------------------------------------
+@x [49] m.1260 l.23333 - Omega
+for f:=font_base+1 to font_ptr do
+ if str_eq_str(font_name[f],cur_name)and str_eq_str(font_area[f],cur_area) then
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name[f];
+ end;
+ if s>0 then
+ begin if s=font_size[f] then goto common_ending;
+ end
+ else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
+ goto common_ending;
+ end
+@y
+for f:=font_base+1 to font_ptr do begin
+ if str_eq_str(font_name(f),cur_name) and
+ str_eq_str(font_area(f),cur_area) then
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name(f);
+ end;
+ if s>0 then
+ begin if s=font_size(f) then goto common_ending;
+ end
+ else if font_size(f)=xn_over_d(font_dsize(f),-s,1000) then
+ goto common_ending;
+ end
+ end
+@z
+%---------------------------------------
+@x [49] m.1261 l.23345 - Omega
+set_font:begin print("select font "); slow_print(font_name[chr_code]);
+ if font_size[chr_code]<>font_dsize[chr_code] then
+ begin print(" at "); print_scaled(font_size[chr_code]);
+@y
+set_font:begin print("select font "); slow_print(font_name(chr_code));
+ if font_size(chr_code)<>font_dsize(chr_code) then
+ begin print(" at "); print_scaled(font_size(chr_code));
+@z
+%---------------------------------------
+@x [50] m.1320 l.23983 - Omega
+@ @<Dump the font information@>=
+dump_int(fmem_ptr);
+for k:=0 to fmem_ptr-1 do dump_wd(font_info[k]);
+dump_int(font_ptr);
+for k:=null_font to font_ptr do
+ @<Dump the array info for internal font number |k|@>;
+print_ln; print_int(fmem_ptr-7); print(" words of font info for ");
+print_int(font_ptr-font_base); print(" preloaded font");
+if font_ptr<>font_base+1 then print_char("s")
+@y
+@ @<Dump the font information@>=
+dump_int(font_ptr);
+for k:=null_font to font_ptr do
+ @<Dump the array info for internal font number |k|@>;
+print_ln; print_int(font_ptr-font_base); print(" preloaded font");
+if font_ptr<>font_base+1 then print_char("s")
+@z
+%---------------------------------------
+@x [50] m.1321 l.23993 - Omega
+@ @<Undump the font information@>=
+undump_size(7)(font_mem_size)('font mem size')(fmem_ptr);
+for k:=0 to fmem_ptr-1 do undump_wd(font_info[k]);
+undump_size(font_base)(font_max)('font max')(font_ptr);
+for k:=null_font to font_ptr do
+ @<Undump the array info for internal font number |k|@>
+@y
+@ @<Undump the font information@>=
+undump_size(font_base)(font_max)('font max')(font_ptr);
+for k:=null_font to font_ptr do
+ @<Undump the array info for internal font number |k|@>
+@z
+%---------------------------------------
+@x [50] m.1322 l.24000 - Omega
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_qqqq(font_check[k]);
+dump_int(font_size[k]);
+dump_int(font_dsize[k]);
+dump_int(font_params[k]);@/
+dump_int(hyphen_char[k]);
+dump_int(skew_char[k]);@/
+dump_int(font_name[k]);
+dump_int(font_area[k]);@/
+dump_int(font_bc[k]);
+dump_int(font_ec[k]);@/
+dump_int(char_base[k]);
+dump_int(width_base[k]);
+dump_int(height_base[k]);@/
+dump_int(depth_base[k]);
+dump_int(italic_base[k]);
+dump_int(lig_kern_base[k]);@/
+dump_int(kern_base[k]);
+dump_int(exten_base[k]);
+dump_int(param_base[k]);@/
+dump_int(font_glue[k]);@/
+dump_int(bchar_label[k]);
+dump_int(font_bchar[k]);
+dump_int(font_false_bchar[k]);@/
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(font_name[k],font_area[k],"");
+if font_size[k]<>font_dsize[k] then
+ begin print(" at "); print_scaled(font_size[k]); print("pt");
+ end;
+end
+@y
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_font_table(k,param_base(k)+font_params(k)+1);
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(font_name(k),font_area(k),"");
+if font_size(k)<>font_dsize(k) then
+ begin print(" at "); print_scaled(font_size(k)); print("pt");
+ end;
+end
+@z
+%---------------------------------------
+@x [50] m.1323 l.24031 - Omega
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_qqqq(font_check[k]);@/
+undump_int(font_size[k]);
+undump_int(font_dsize[k]);
+undump(min_halfword)(max_halfword)(font_params[k]);@/
+undump_int(hyphen_char[k]);
+undump_int(skew_char[k]);@/
+undump(0)(str_ptr)(font_name[k]);
+undump(0)(str_ptr)(font_area[k]);@/
+undump(0)(255)(font_bc[k]);
+undump(0)(255)(font_ec[k]);@/
+undump_int(char_base[k]);
+undump_int(width_base[k]);
+undump_int(height_base[k]);@/
+undump_int(depth_base[k]);
+undump_int(italic_base[k]);
+undump_int(lig_kern_base[k]);@/
+undump_int(kern_base[k]);
+undump_int(exten_base[k]);
+undump_int(param_base[k]);@/
+undump(min_halfword)(lo_mem_max)(font_glue[k]);@/
+undump(0)(fmem_ptr-1)(bchar_label[k]);
+undump(min_quarterword)(non_char)(font_bchar[k]);
+undump(min_quarterword)(non_char)(font_false_bchar[k]);
+end
+@y
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_font_table(k);@/
+end
+@z
+%---------------------------------------
+@x [51] m.1334 l.24277 - Omega
+ wlog(' ',fmem_ptr:1,' words of font info for ',
+ font_ptr-font_base:1,' font');
+ if font_ptr<>font_base+1 then wlog('s');
+@y
+ wlog(font_ptr-font_base:1,' font');
+ if font_ptr<>font_base+1 then wlog('s');
+@z
+%---------------------------------------
+@x [52] m.1339 l.24429 - Omega
+4: print_word(eqtb[n]);
+5: print_word(font_info[n]);
+@y
+4: print_word(new_eqtb(n));
+5: ;
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/alephdir/omocp.ch b/Build/source/texk/web2c/alephdir/omocp.ch
new file mode 100644
index 00000000000..039903327fb
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omocp.ch
@@ -0,0 +1,1068 @@
+% omocp.ch: Reading an OCP file
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.412 - Omega OCP
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@y
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@!ocp_maxint=@"10000000;
+@z
+%---------------------------------------
+@x [1] m.12 l.436 - Omega OCP
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@d ocp_base=0 {smallest internal ocp number; must not be less
+ than |min_quarterword|}
+@d ocp_biggest=65535 {the real biggest ocp}
+@d number_ocps=ocp_biggest-ocp_base+1
+@d ocp_list_base=0 {smallest internal ocp list number; must not be less
+ than |min_quarterword|}
+@d ocp_list_biggest=65535 {the real biggest ocp list}
+@d number_ocp_lists=ocp_list_biggest-ocp_list_base+1
+@d max_active_ocp_lists=65536
+@z
+%---------------------------------------
+@x [15] m.209 l.4170 - Omega OCP
+@d max_command=set_interaction
+ {the largest command code seen at |big_switch|}
+@y
+@d set_ocp=set_interaction+1
+ {Place a translation process in the stream}
+@d def_ocp=set_ocp+1
+ {Define and load a translation process}
+@d set_ocp_list=def_ocp+1
+ {Place a list of OCPs in the stream}
+@d def_ocp_list=set_ocp_list+1
+ {Define a list of OCPs}
+@d clear_ocp_lists=def_ocp_list+1
+ {Remove all active OCP lists}
+@d push_ocp_list=clear_ocp_lists+1
+ {Add to the sequence of active OCP lists}
+@d pop_ocp_list=push_ocp_list+1
+ {Remove from the sequence of active OCP lists}
+@d ocp_list_op=pop_ocp_list+1
+ {Operations for building a list of OCPs}
+@d ocp_trace_level=ocp_list_op+1
+ {Tracing of active OCPs, either 0 or 1}
+@d max_command=ocp_trace_level
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.222 l.4523 - Omega OCP
+@d font_id_base=frozen_null_font-font_base
+ {begins table of |number_fonts| permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+number_fonts
+@y
+@d font_id_base=frozen_null_font-font_base
+ {begins table of |number_fonts| permanent font identifiers}
+@d frozen_null_ocp=frozen_null_font+number_fonts
+ {permanent `\.{\\nullocp}'}
+@d ocp_id_base=frozen_null_ocp-ocp_base
+ {begins table of |number_ocps| permanent ocp identifiers}
+@d frozen_null_ocp_list=frozen_null_ocp+number_ocps
+ {permanent `\.{\\nullocplist}'}
+@d ocp_list_id_base=frozen_null_ocp_list-ocp_list_base
+ {begins table of |number_ocp_lists| permanent ocp list identifiers}
+@d undefined_control_sequence=frozen_null_ocp_list+number_ocp_lists
+@z
+%---------------------------------------
+@x
+@d toks_base=local_base+10 {table of |number_regs| token list registers}
+@y
+@d ocp_trace_level_base=local_base+10
+@d ocp_active_number_base=ocp_trace_level_base+1
+@d ocp_active_min_ptr_base = ocp_active_number_base+1
+@d ocp_active_max_ptr_base = ocp_active_min_ptr_base+1
+@d ocp_active_base = ocp_active_max_ptr_base+1
+@d toks_base=ocp_active_base+max_active_ocp_lists
+ {table of |number_regs| token list registers}
+@z
+%---------------------------------------
+@x [17] m.232 l.4799 - Omega OCP
+@d null_font==font_base
+@y
+@d null_font==font_base
+@d null_ocp==ocp_base
+@d null_ocp_list==ocp_list_base
+@z
+%---------------------------------------
+@x [18] m.256 l.5479 - Omega OCP
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@y
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@d ocp_id_text(#) == newtext(ocp_id_base+#) {a frozen ocp identifier's name}
+@d ocp_list_id_text(#) == newtext(ocp_list_id_base+#)
+ {a frozen ocp list identifier's name}
+@z
+%---------------------------------------
+@x [26] m.409 l.8254 - Omega OCP
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@y
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@t\4\4@>@<Declare procedures that scan ocp-related stuff@>
+@z
+%---------------------------------------
+@x [29] m.514 l.9968 - Omega OCP
+|TEX_font_area|. These system area names will, of course, vary from place
+to place.
+@y
+|TEX_font_area|. $\Omega$'s compiled translation process files whose areas
+are not given explicitly are assumed to appear in a standard system area
+called |OMEGA_ocp_area|. These system area names will, of course, vary
+from place to place.
+@z
+%---------------------------------------
+@x [29] m.514 l.9974 - Omega OCP
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@d OMEGA_ocp_area=="OmegaOCPs:"
+@.OmegaOCPs@>
+@z
+%---------------------------------------
+@x [30] m.582 l.10379 - Omega OCP
+@* \[30] Font metric data.
+@y
+@* \[30] Font metric data and OCPs.
+@z
+%---------------------------------------
+@x [30] m.??? l.10928 - Omega OCP
+@ @<Read and check...@>=
+@y
+@ @<Read and check the font data...@>=
+@z
+%---------------------------------------
+@x [30] m.??? l.11010 - Omega OCP
+@ @<Apologize for not loading...@>=
+@y
+@ @<Apologize for not loading the font...@>=
+@z
+%---------------------------------------
+@x [30] m.582 l.11283 - Omega OCP
+char_warning(f,c);
+new_character:=null;
+exit:end;
+@y
+char_warning(f,c);
+new_character:=null;
+exit:end;
+
+@ Here we begin the \.{OCP} file handling.
+
+@<Glob...@>=
+@!ocp_file:byte_file;
+
+@ So that is what \.{OCP} files hold.
+
+When the user defines \.{\\ocp\\f}, say, \TeX\ assigns an internal number
+to the user's ocp~\.{\\f}. Adding this number to |ocp_id_base| gives the
+|eqtb| location of a ``frozen'' control sequence that will always select
+the ocp.
+
+@<Types...@>=
+@!internal_ocp_number=ocp_base..ocp_biggest;
+@!ocp_index=integer;
+
+@ Here now is the array of ocp arrays.
+
+@<Glob...@>=
+@!ocp_ptr:internal_ocp_number; {largest internal ocp number in use}
+
+@ Besides the arrays just enumerated, we have two directory arrays that
+make it easy to get at the individual entries in |ocp_info|.
+The beginning of the info for the |j|-th state in the |i|-th ocp is at
+location |ocp_info[ocp_state_base[i]+j]| and the |k|-th entry is in
+location |ocp_info[ocp_info[ocp_state_base[i]+j]+k]|.
+(These formulas assume that |min_quarterword| has already been
+added to |i|, |j| and |k|, since $\Omega$ stores its quarterwords that way.)
+
+@d ocp_info_end(#)==#]
+@d ocp_info(#)==ocp_tables[#,ocp_info_end
+@d offset_ocp_file_size=0
+@d offset_ocp_name=1
+@d offset_ocp_area=offset_ocp_name+1
+@d offset_ocp_external=offset_ocp_area+1
+@d offset_ocp_external_arg=offset_ocp_external+1
+@d offset_ocp_input=offset_ocp_external_arg+1
+@d offset_ocp_output=offset_ocp_input+1
+@d offset_ocp_no_tables=offset_ocp_output+1
+@d offset_ocp_no_states=offset_ocp_no_tables+1
+@d offset_ocp_table_base=offset_ocp_no_states+1
+@d offset_ocp_state_base=offset_ocp_table_base+1
+@d offset_ocp_info=offset_ocp_state_base+1
+@d ocp_file_size(#)==ocp_info(#)(offset_ocp_file_size)
+@d ocp_name(#)==ocp_info(#)(offset_ocp_name)
+@d ocp_area(#)==ocp_info(#)(offset_ocp_area)
+@d ocp_external(#)==ocp_info(#)(offset_ocp_external)
+@d ocp_external_arg(#)==ocp_info(#)(offset_ocp_external_arg)
+@d ocp_input(#)==ocp_info(#)(offset_ocp_input)
+@d ocp_output(#)==ocp_info(#)(offset_ocp_output)
+@d ocp_no_tables(#)==ocp_info(#)(offset_ocp_no_tables)
+@d ocp_no_states(#)==ocp_info(#)(offset_ocp_no_states)
+@d ocp_table_base(#)==ocp_info(#)(offset_ocp_table_base)
+@d ocp_state_base(#)==ocp_info(#)(offset_ocp_state_base)
+
+@ $\Omega$ always knows at least one ocp, namely the null ocp.
+It does nothing.
+
+@<Initialize table...@>=
+ocp_ptr:=null_ocp;
+allocate_ocp_table(null_ocp,17);
+ocp_file_size(null_ocp):=17;
+ocp_name(null_ocp):="nullocp"; ocp_area(null_ocp):="";
+ocp_external(null_ocp):=0; ocp_external_arg(null_ocp):=0;
+ocp_input(null_ocp):=1; ocp_output(null_ocp):=1;
+ocp_no_tables(null_ocp):=0;
+ocp_no_states(null_ocp):=1;
+ocp_table_base(f):=offset_ocp_info;
+ocp_state_base(f):=offset_ocp_info;
+ocp_info(null_ocp)(offset_ocp_info) := offset_ocp_info+2; {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+1) := offset_ocp_info+5; {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+2) := 23; {|OTP_LEFT_START|}
+ocp_info(null_ocp)(offset_ocp_info+3) := 3; {|OTP_RIGHT_CHAR|}
+ocp_info(null_ocp)(offset_ocp_info+4) := 36; {|OTP_STOP|}
+
+
+@ @<Put each...@>=
+primitive("nullocp", set_ocp, null_ocp);
+settext(frozen_null_ocp,"nullocp");
+set_new_eqtb(frozen_null_ocp,new_eqtb(cur_val));
+geq_define(ocp_active_number_base, data, 0);
+geq_define(ocp_active_min_ptr_base, data, 0);
+geq_define(ocp_active_max_ptr_base, data, 0);
+
+@ Of course we want to define macros that suppress the detail of how ocp
+information is actually packed, so that we don't have to write things like
+$$\hbox{|ocp_info[k+ocp_info[j+ocp_state_base[i]]]|}$$
+too often. The \.{WEB} definitions here make |ocp_state_entry(i)(j)(k)|
+(|ocp_table_entry(i)(j)(k)|) the |k|-th word in the |j|-th state (table)
+of the |i|-th ocp.
+@^inner loop@>
+
+@d ocp_state_end(#)==#]
+@d ocp_state_one(#)==#*2]+ocp_state_end
+@d ocp_state_entry(#)==ocp_tables[#,ocp_tables[#,ocp_state_base(#)+ocp_state_one
+
+@d ocp_state_no_end(#)==#*2+1]
+@d ocp_state_no(#)==ocp_tables[#,ocp_state_base(#)+ocp_state_no_end
+
+@d ocp_table_end(#)==#]
+@d ocp_table_one(#)==#*2]+ocp_table_end
+@d ocp_table_entry(#)==ocp_tables[#,ocp_tables[#,ocp_table_base(#)+ocp_table_one
+
+@d ocp_table_no_end(#)==#*2+1]
+@d ocp_table_no(#)==ocp_tables[#,ocp_table_base(#)+ocp_table_no_end
+
+@ $\Omega$ checks the information of a \.{OCP} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. The somewhat tedious subroutine that does this
+is called |read_ocp_info|. It has three parameters: the user ocp
+identifier~|u|, and the file name and area strings |nom| and |aire|.
+
+The subroutine opens and closes a global file variable called |ocp_file|.
+It returns the value of the internal ocp number that was just loaded.
+If an error is detected, an error message is issued and no ocp
+information is stored; |null_ocp| is returned in this case.
+
+@d bad_ocp=11 {label for |read_ocp_info|}
+@d ocp_abort(#)==begin print("OCP file error (");
+ print(#); print(")"); print_ln; goto bad_ocp end
+ {do this when the \.{OCP} data is wrong}
+
+@p function read_ocp_info(@!u:pointer;@!nom,@!aire,@!ext:str_number;
+ @!external_ocp:boolean)
+ :internal_ocp_number; {input a \.{OCP} file}
+label done,bad_ocp,not_found;
+var
+@!file_opened:boolean; {was |ocp_file| successfully opened?}
+@!f:internal_ocp_number; {the new ocp's number}
+@!g:internal_ocp_number; {the number to return}
+@!ocpword:integer;
+@!ocpmem_run_ptr:ocp_index;
+@!ocp_length,real_ocp_length:integer; {length of ocp file}
+@!previous_address:ocp_index;
+@!temp_ocp_input:integer;
+@!temp_ocp_output:integer;
+@!temp_ocp_no_tables:integer;
+@!temp_ocp_no_states:integer;
+@!i,new_offset,room_for_tables,room_for_states:integer;
+begin g:=null_ocp;@/
+@<Read and check the ocp data; |ocp_abort| if the \.{OCP} file is
+ malformed; if there's no room for this ocp, say so and |goto
+ done|; otherwise |incr(ocp_ptr)| and |goto done|@>;
+bad_ocp: @<Report that the ocp won't be loaded@>;
+done: if file_opened then b_close(ocp_file);
+ocp_name(f):=nom; ocp_area(f):=aire;
+read_ocp_info:=g;
+end;
+
+@ $\Omega$ does not give precise details about why it
+rejects a particular \.{OCP} file.
+
+@d start_ocp_error_message==print_err("Translation process ");
+ sprint_cs(u); print_char("="); print_file_name(nom,aire,"");
+
+@<Report that the ocp won't be loaded@>=
+start_ocp_error_message;
+@.Translation process x=xx not loadable...@>
+if file_opened then print(" not loadable: Bad ocp file")
+else print(" not loadable: ocp file not found");
+help2("I wasn't able to read the data for this ocp,")@/
+("so I will ignore the ocp specification.");
+error
+
+@ @<Read and check the ocp data...@>=
+if external_ocp then
+ @<Check |ocp_file| exists@>
+else begin
+ @<Open |ocp_file| for input@>;
+ @<Read the {\.{OCP}} file@>;
+ end;
+
+@ @<Check |ocp_file| exists@>=
+begin
+file_opened:=false;
+pack_file_name(nom,aire,ext);
+b_test_in;
+if name_length=0 then ocp_abort("opening file");
+f :=ocp_ptr+1;
+allocate_ocp_table(f,13);
+ocp_file_size(f):=13;
+for i:=1 to name_length do begin
+ append_char(name_of_file[i]);
+ end;
+ocp_external(f):=make_string;
+scan_string_argument;
+ocp_external_arg(f):=cur_val;
+ocp_name(f):=""; ocp_area(f):="";
+ocp_state_base(f):=0; ocp_table_base(f):=0;
+ocp_input(f):=1; ocp_output(f):=1;
+ocp_info(f)(offset_ocp_info):=0;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ @<Open |ocp_file| for input@>=
+file_opened:=false;
+pack_file_name(nom,aire,".ocp");
+if not b_open_in(ocp_file) then ocp_abort("opening file");
+file_opened:=true
+
+@ Note: A malformed \.{OCP} file might be shorter than it claims to be;
+thus |eof(ocp_file)| might be true when |read_ocp_info| refers to
+|ocp_file^| or when it says |get(ocp_file)|. If such circumstances
+cause system error messages, you will have to defeat them somehow,
+for example by defining |ocpget| to be `\ignorespaces|begin get(ocp_file);|
+|if eof(ocp_file) then ocp_abort; end|\unskip'.
+@^system dependencies@>
+
+@d add_to_ocp_info(#)==begin ocp_tables[f,ocpmem_run_ptr]:=#;
+ incr(ocpmem_run_ptr);
+ end
+@d ocpget==get(ocp_file)
+@d ocpbyte==ocp_file^
+@d ocp_read(#)==begin ocpword:=ocpbyte;
+ if ocpword>127 then ocp_abort("checking first octet");
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ #:=ocpword;
+ end
+@d ocp_read_all(#)==begin ocpget; ocp_read(#); end
+@d ocp_read_info==begin ocp_read_all(ocpword);
+ add_to_ocp_info(ocpword);
+ end
+
+@ @<Read the {\.{OCP}} file@>=
+begin
+f :=ocp_ptr+1;
+ocpmem_run_ptr:=offset_ocp_info;
+ocp_read(ocp_length);
+real_ocp_length:=ocp_length-7;
+ocp_read_all(temp_ocp_input);
+ocp_read_all(temp_ocp_output);
+ocp_read_all(temp_ocp_no_tables);
+ocp_read_all(room_for_tables);
+ocp_read_all(temp_ocp_no_states);
+ocp_read_all(room_for_states);
+if real_ocp_length <>
+ (temp_ocp_no_tables + room_for_tables +
+ temp_ocp_no_states + room_for_states) then
+ ocp_abort("checking size");
+real_ocp_length:=real_ocp_length+12+
+ temp_ocp_no_states+temp_ocp_no_tables;
+allocate_ocp_table(f,real_ocp_length);
+ocp_external(f):=0;
+ocp_external_arg(f):=0;
+ocp_file_size(f):=real_ocp_length;
+ocp_input(f):=temp_ocp_input;
+ocp_output(f):=temp_ocp_output;
+ocp_no_tables(f):=temp_ocp_no_tables;
+ocp_no_states(f):=temp_ocp_no_states;
+ocp_table_base(f):=ocpmem_run_ptr;
+if ocp_no_tables(f) <> 0 then begin
+ previous_address:=ocpmem_run_ptr+2*(ocp_no_tables(f));
+ for i:=1 to ocp_no_tables(f) do begin
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address:=previous_address+new_offset;
+ end
+ end;
+if room_for_tables <> 0 then begin
+ for i:=1 to room_for_tables do begin
+ ocp_read_info;
+ end
+ end;
+ocp_state_base(f):=ocpmem_run_ptr;
+if ocp_no_states(f) <> 0 then begin
+ previous_address:=ocpmem_run_ptr+2*(ocp_no_states(f));
+ for i:=1 to ocp_no_states(f) do begin
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address:=previous_address+new_offset;
+ end;
+ end;
+if room_for_states <> 0 then begin
+ for i:=1 to room_for_states do begin
+ ocp_read_info;
+ end
+ end;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ Before we forget about the format of these tables, let's deal with
+$\Omega$'s basic scanning routine related to ocp information.
+
+@<Declare procedures that scan ocp-related stuff@>=
+procedure scan_ocp_ident;
+var f:internal_ocp_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp then f:=cur_chr
+else begin print_err("Missing ocp identifier");
+@.Missing ocp identifier@>
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \ocp.");
+ back_error; f:=null_ocp;
+ end;
+cur_val:=f;
+end;
+
+
+@ Here we begin the \.{OCP} list handling.
+
+
+@<Types...@>=
+@!internal_ocp_list_number=ocp_list_base..ocp_list_biggest;
+@!ocp_list_index=integer; {index into |ocp_list_info|}
+@!ocp_lstack_index=integer; {index into |ocp_lstack_info|}
+
+@ Here now is the array of ocp arrays.
+@d ocp_list_lnext(#)==ocp_list_info[#].hh.b0
+@d ocp_list_lstack(#)==ocp_list_info[#].hh.b1
+@d ocp_list_lstack_no(#)==ocp_list_info[#+1].sc
+@d ocp_lstack_lnext(#)==ocp_lstack_info[#].hh.b0
+@d ocp_lstack_ocp(#)==ocp_lstack_info[#].hh.b1
+@d make_null_ocp_list==make_ocp_list_node(0,ocp_maxint,0)
+@d is_null_ocp_list(#)==ocp_list_lstack_no(#)=ocp_maxint
+@d make_null_ocp_lstack==0
+@d is_null_ocp_lstack(#)==#=0
+@d add_before_op=1
+@d add_after_op=2
+@d remove_before_op=3
+@d remove_after_op=4
+
+@<Glob...@>=
+@!ocp_list_info:array[ocp_list_index] of memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
+
+@
+@<Initialize table...@>=
+ocp_listmem_ptr:=2;
+ocp_list_lstack(0):=0;
+ocp_list_lstack_no(0):=ocp_maxint;
+ocp_list_lnext(0):=0;
+ocp_list_ptr:=null_ocp_list;
+ocp_list_list[null_ocp_list]:=0;
+ocp_lstackmem_ptr:=1;
+
+@ $\Omega$ always knows at least one ocp list, namely the null ocp list.
+
+@ @<Put each...@>=
+primitive("nullocplist", set_ocp_list, null_ocp_list);
+settext(frozen_null_ocp_list,"nullocplist");
+set_new_eqtb(frozen_null_ocp_list,new_eqtb(cur_val));
+
+@ @p function make_ocp_list_node(llstack:ocp_lstack_index;
+ llstack_no:scaled;
+ llnext:ocp_list_index):ocp_list_index;
+var p:ocp_list_index;
+begin
+p:=ocp_listmem_run_ptr;
+ocp_list_lstack(p):=llstack;
+ocp_list_lstack_no(p):=llstack_no;
+ocp_list_lnext(p):=llnext;
+ocp_listmem_run_ptr:=ocp_listmem_run_ptr+2;
+make_ocp_list_node:=p;
+end;
+
+function make_ocp_lstack_node(locp:internal_ocp_number;
+ llnext:ocp_lstack_index) : ocp_lstack_index;
+var p:ocp_lstack_index;
+begin
+p:=ocp_lstackmem_run_ptr;
+ocp_lstack_ocp(p):=locp;
+ocp_lstack_lnext(p):=llnext;
+incr(ocp_lstackmem_run_ptr);
+make_ocp_lstack_node:=p;
+end;
+
+function copy_ocp_lstack(llstack:ocp_lstack_index):ocp_lstack_index;
+var result:ocp_lstack_index;
+begin
+if is_null_ocp_lstack(llstack) then
+ result:=make_null_ocp_lstack
+else
+ result:=make_ocp_lstack_node(ocp_lstack_ocp(llstack),
+ copy_ocp_lstack(ocp_lstack_lnext(llstack)));
+copy_ocp_lstack:=result;
+end;
+
+function copy_ocp_list(list:ocp_list_index):ocp_list_index;
+var result:ocp_list_index;
+begin
+if is_null_ocp_list(list) then
+ result:=make_null_ocp_list
+else
+ result:=make_ocp_list_node(copy_ocp_lstack(ocp_list_lstack(list)),
+ ocp_list_lstack_no(list),
+ copy_ocp_list(ocp_list_lnext(list)));
+copy_ocp_list:=result;
+end;
+
+function ocp_ensure_lstack(list:ocp_list_index; llstack_no:scaled):
+ ocp_list_index;
+var p:ocp_list_index;
+ q:ocp_list_index;
+begin
+p:=list;
+if is_null_ocp_list(p) then begin
+ ocp_list_lstack_no(p) := llstack_no;
+ ocp_list_lnext(p) := make_null_ocp_list;
+ end
+else if ocp_list_lstack_no(p) > llstack_no then begin
+ ocp_list_lnext(p):=
+ make_ocp_list_node(ocp_list_lstack(p),
+ ocp_list_lstack_no(p),
+ ocp_list_lnext(p));
+ ocp_list_lstack(p):=0;
+ ocp_list_lstack_no(p):=llstack_no;
+ end
+else begin
+ q:=ocp_list_lnext(p);
+ while (not (is_null_ocp_list(q))) and
+ ocp_list_lstack_no(q) <= llstack_no do begin
+ p:=q; q:=ocp_list_lnext(q);
+ end;
+ if ocp_list_lstack_no(p) < llstack_no then begin
+ ocp_list_lnext(p) := make_ocp_list_node(0, llstack_no, q);
+ p := ocp_list_lnext(p);
+ end;
+ end;
+ocp_ensure_lstack := p;
+end;
+
+procedure ocp_apply_add(list_entry:ocp_list_index;
+ lbefore:boolean;
+ locp:internal_ocp_number);
+var p:ocp_lstack_index;
+ q:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if lbefore or (p=0) then begin
+ ocp_list_lstack(list_entry) := make_ocp_lstack_node(locp, p);
+ end
+else begin
+ q:=ocp_lstack_lnext(p);
+ while q<>0 do begin
+ p:=q; q:=ocp_lstack_lnext(q);
+ end;
+ ocp_lstack_lnext(p):=make_ocp_lstack_node(locp, null);
+ end;
+end;
+
+procedure ocp_apply_remove(list_entry:ocp_list_index;
+ lbefore:boolean);
+var p:ocp_lstack_index;
+ q:ocp_lstack_index;
+ r:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if p=0 then begin
+ print_err("warning: stack entry already empty"); print_ln
+ end
+else begin
+ q := ocp_lstack_lnext(p);
+ if lbefore or (q=0) then
+ ocp_list_lstack(list_entry) := q
+ else begin
+ r:=ocp_lstack_lnext(q);
+ while r <> 0 do begin
+ p:=q; q:=r; r:=ocp_lstack_lnext(r);
+ end;
+ ocp_lstack_lnext(p) := null;
+ end
+ end;
+end;
+
+procedure scan_scaled; {sets |cur_val| to a scaled value}
+label done, done1, done2, found, not_found, attach_fraction;
+var negative:boolean; {should the answer be negated?}
+@!f:integer; {numerator of a fraction whose denominator is $2^{16}$}
+@!k,@!kk:small_number; {number of digits in a decimal fraction}
+@!p,@!q:pointer; {top of decimal digit stack}
+begin f:=0; arith_error:=false; negative:=false;
+@<Get the next non-blank non-sign...@>;
+back_input;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if cur_tok<>point_token then scan_int
+else begin radix:=10; cur_val:=0;
+ end;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>;
+if cur_val<0 then {in this case |f=0|}
+ begin negative := not negative; negate(cur_val);
+ end;
+if cur_val>@'40000 then arith_error:=true
+else cur_val := cur_val*unity +f;
+if arith_error or(abs(cur_val)>=@'10000000000) then
+begin print_err("Stack number too large");
+end;
+if negative then negate(cur_val);
+end;
+
+procedure print_ocp_lstack(lstack_entry:ocp_lstack_index);
+var p:ocp_lstack_index;
+begin
+p:=lstack_entry;
+while (p<>0) do begin
+ print_esc(ocp_id_text(ocp_lstack_ocp(p)));
+ p:=ocp_lstack_lnext(p);
+ if (p<>0) then print(",");
+ end;
+end;
+
+procedure print_ocp_list(list_entry:ocp_list_index);
+var p:ocp_list_index;
+begin
+print("["); p:=list_entry;
+while not (is_null_ocp_list(p)) do begin
+ print("(");
+ print_scaled(ocp_list_lstack_no(p));
+ print(" : ");
+ print_ocp_lstack(ocp_list_lstack(p));
+ print(")");
+ p:=ocp_list_lnext(p);
+ if not (is_null_ocp_list(p)) then print(", ");
+ end;
+print("]");
+end;
+
+function scan_ocp_list: ocp_list_index;
+var llstack_no:scaled;
+ lop:quarterword;
+ lstack_entry:ocp_list_index;
+ other_list:ocp_list_index;
+ ocp_ident:internal_ocp_number;
+ result:ocp_list_index;
+begin
+get_r_token;
+if cur_cmd = set_ocp_list then
+ result := copy_ocp_list(ocp_list_list[cur_chr])
+else if cur_cmd <> ocp_list_op then begin
+ print_err("Bad ocp list specification");
+@.Bad ocp list specification@>
+ help1("I was looking for a ocp list specification.");
+ result := make_null_ocp_list;
+ end
+else begin
+ lop:=cur_chr;
+ scan_scaled; llstack_no:=cur_val;
+ if (llstack_no<=0) or (llstack_no>=ocp_maxint) then begin
+ print_err("Stack numbers must be between 0 and 4096 (exclusive)");
+ result := make_null_ocp_list;
+ end
+ else begin
+ if lop <= add_after_op then begin
+ scan_ocp_ident; ocp_ident:=cur_val;
+ end;
+ other_list:=scan_ocp_list;
+ lstack_entry:=ocp_ensure_lstack(other_list, llstack_no);
+ if lop <= add_after_op then
+ ocp_apply_add(lstack_entry, (lop=add_before_op), ocp_ident)
+ else
+ ocp_apply_remove(lstack_entry, (lop=remove_before_op));
+ result:=other_list;
+ end;
+ end;
+scan_ocp_list:=result;
+end;
+
+function read_ocp_list: internal_ocp_list_number;
+var f:internal_ocp_list_number;
+ g:internal_ocp_list_number;
+begin
+g:=null_ocp_list;
+f:=ocp_list_ptr+1;
+ocp_listmem_run_ptr:=ocp_listmem_ptr;
+ocp_lstackmem_run_ptr:=ocp_lstackmem_ptr;
+ocp_list_list[f]:=scan_ocp_list;
+ocp_list_ptr:=f;
+ocp_listmem_ptr:=ocp_listmem_run_ptr;
+ocp_lstackmem_ptr:=ocp_lstackmem_run_ptr;
+g:=f;
+read_ocp_list:=g;
+end;
+
+procedure scan_ocp_list_ident;
+var f:internal_ocp_list_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp_list then f:=cur_chr
+else begin print_err("Missing ocp list identifier");
+@.Missing ocp list identifier@>
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \ocplist.");
+ back_error; f:=null_ocp_list;
+ end;
+cur_val:=f;
+end;
+
+
+@z
+%---------------------------------------
+@x [49] m.1210 l.22629 - Omega OCP
+any_mode(set_interaction):prefixed_command;
+@y
+any_mode(set_interaction),
+any_mode(set_ocp),
+any_mode(def_ocp),
+any_mode(set_ocp_list),
+any_mode(def_ocp_list),
+any_mode(clear_ocp_lists),
+any_mode(push_ocp_list),
+any_mode(pop_ocp_list),
+any_mode(ocp_list_op),
+any_mode(ocp_trace_level) : prefixed_command;
+@z
+%---------------------------------------
+@x [50] m.1302 l.23682 - Omega OCP
+@<Dump the font information@>;
+@y
+@<Dump the font information@>;
+@<Dump the ocp information@>;
+@<Dump the ocp list information@>;
+@z
+%---------------------------------------
+@x [50] m.1303 l.23711 - Omega OCP
+@<Undump the font information@>;
+@y
+@<Undump the font information@>;
+@<Undump the ocp information@>;
+@<Undump the ocp list information@>;
+@z
+%---------------------------------------
+@x [50] m.1323 l.24907 - Omega OCP
+begin undump_font_table(k);@/
+end
+@y
+begin undump_font_table(k);@/
+end
+
+@ @<Dump the ocp information@>=
+dump_int(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+ @<Dump the array info for internal ocp number |k|@>;
+print_ln; print_int(ocp_ptr-ocp_base); print(" preloaded ocp");
+if ocp_ptr<>ocp_base+1 then print_char("s")
+
+@ @<Undump the ocp information@>=
+undump_size(ocp_base)(ocp_biggest)('ocp max')(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+ @<Undump the array info for internal ocp number |k|@>
+
+@ @<Dump the array info for internal ocp number |k|@>=
+begin dump_ocp_table(k);
+print_nl("\ocp"); print_esc(ocp_id_text(k)); print_char("=");
+print_file_name(ocp_name(k),ocp_area(k),"");
+end
+
+@ @<Undump the array info for internal ocp number |k|@>=
+begin undump_ocp_table(k);
+end
+
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
+dump_int(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ dump_int(ocp_list_list[k]);
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
+
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
+undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do
+ undump_int(ocp_list_list[k]);
+undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
+
+@z
+%---------------------------------------
+@x
+@* \[54] $\Omega$ changes.
+
+@y
+@* \[54] $\Omega$ changes.
+
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+
+@ @<Put each...@>=
+primitive("ocp", def_ocp, 0);
+primitive("externalocp", def_ocp, 1);
+primitive("ocplist", def_ocp_list, 0);
+primitive("pushocplist", push_ocp_list, 0);
+primitive("popocplist", pop_ocp_list, 0);
+primitive("clearocplists", clear_ocp_lists, 0);
+primitive("addbeforeocplist", ocp_list_op, add_before_op);
+primitive("addafterocplist", ocp_list_op, add_after_op);
+primitive("removebeforeocplist", ocp_list_op, remove_before_op);
+primitive("removeafterocplist", ocp_list_op, remove_after_op);
+primitive("ocptracelevel", ocp_trace_level, 0);
+set_equiv(ocp_trace_level_base,0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_ocp: begin
+ print("select ocp ");
+ slow_print(ocp_name(chr_code));
+ end;
+def_ocp: if cur_chr=0 then print_esc("ocp")
+ else print_esc("externalocp");
+set_ocp_list: print("select ocp list ");
+def_ocp_list: print_esc("ocplist");
+push_ocp_list: print_esc("pushocplist");
+pop_ocp_list: print_esc("popocplist");
+clear_ocp_lists: print_esc("clearocplists");
+ocp_list_op:
+ if chr_code=add_before_op then print_esc("addbeforeocplist")
+ else if chr_code=add_after_op then print_esc("addafterocplist")
+ else if chr_code=remove_before_op then print_esc("removebeforeocplist")
+ else {|chr_code|=|remove_after_op|} print_esc("removeafterocplist");
+ocp_trace_level: print_esc("ocptracelevel");
+
+@ @<Assignments@>=
+set_ocp: begin
+ print_err("To use ocps, use the "); print_esc("pushocplist");
+ print(" primitive");print_ln
+ end;
+def_ocp: new_ocp(a);
+set_ocp_list: begin
+ print_err("To use ocp lists, use the ");
+ print_esc("pushocplist"); print(" primitive");print_ln
+ end;
+def_ocp_list: new_ocp_list(a);
+push_ocp_list: do_push_ocp_list(a);
+pop_ocp_list: do_pop_ocp_list(a);
+clear_ocp_lists: do_clear_ocp_lists(a);
+ocp_list_op: begin
+ print_err("To build ocp lists, use the ");
+ print_esc("ocplist"); print(" primitive"); print_ln
+ end;
+ocp_trace_level: begin scan_optional_equals; scan_int;
+ if cur_val<>0 then cur_val:=1;
+ define(ocp_trace_level_base, data, cur_val);
+ end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp(@!a:small_number);
+label common_ending;
+var u:pointer; {user's ocp identifier}
+@!f:internal_ocp_number; {runs through existing ocps}
+@!t:str_number; {name for the frozen ocp identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+@!flushable_string:str_number; {string not yet referenced}
+@!external_ocp:boolean; {external binary file}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the ocp name}
+@.texput@>
+if cur_chr=1 then external_ocp:=true
+else external_ocp:=false;
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+else if u>=single_base then
+ if u=null_cs then t:="OCP"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("OCP"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_ocp,null_ocp); scan_optional_equals; scan_file_name;
+@<If this ocp has already been loaded, set |f| to the internal
+ ocp number and |goto common_ending|@>;
+f:=read_ocp_info(u,cur_name,cur_area,cur_ext,external_ocp);
+common_ending:
+set_equiv(u,f); set_new_eqtb(ocp_id_base+f,new_eqtb(u));
+settext(ocp_id_base+f,t);
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl(""); print_esc("ocp"); print_esc(t); print("="); print(cur_name);
+ end;
+end;
+
+@ When the user gives a new identifier to a ocp that was previously loaded,
+the new name becomes the ocp identifier of record. OCP names `\.{xyz}' and
+`\.{XYZ}' are considered to be different.
+
+@<If this ocp has already been loaded...@>=
+flushable_string:=str_ptr-1;
+for f:=ocp_base+1 to ocp_ptr do
+ if str_eq_str(ocp_name(f),cur_name)and str_eq_str(ocp_area(f),cur_area) then
+ begin
+ if cur_name=flushable_string then begin
+ flush_string; cur_name:=ocp_name(f);
+ end;
+ goto common_ending
+ end
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp_list(@!a:small_number);
+var u:pointer; {user's ocp list identifier}
+@!f:internal_ocp_list_number; {runs through existing ocp lists}
+@!t:str_number; {name for the frozen ocp list identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the ocp list name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+else if u>=single_base then
+ if u=null_cs then t:="OCPLIST"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("OCPLIST"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_ocp_list,null_ocp_list); scan_optional_equals;
+f:=read_ocp_list;
+ set_equiv(u,f); set_new_eqtb(ocp_list_id_base+f,new_eqtb(u));
+ settext(ocp_list_id_base+f,t);
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl(""); print_esc("ocplist"); print_esc(t); print("=");
+ print_ocp_list(ocp_list_list[f]);
+ end;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_push_ocp_list(@!a:small_number);
+var ocp_list_no:halfword;
+ old_number:halfword;
+ i:integer;
+begin
+scan_ocp_list_ident; ocp_list_no:=cur_val;
+old_number:=equiv(ocp_active_number_base);
+define(ocp_active_base+old_number, data, ocp_list_no);
+define(ocp_active_number_base, data, (old_number+1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl("New active ocp list: {");
+ for i:=old_number downto 0 do begin
+ print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+ print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+ if i<>0 then print(",");
+ end;
+ print("}");
+ end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_pop_ocp_list(@!a:small_number);
+var old_number:halfword;
+ i:integer;
+begin
+old_number:=equiv(ocp_active_number_base);
+if old_number=0 then begin
+ print_err("No active ocp lists to be popped");
+ end
+else
+ define(ocp_active_number_base, data, (old_number-1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl("New active ocp list: {");
+ for i:=(old_number-2) downto 0 do begin
+ print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+ print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+ if i<>0 then print(",");
+ end;
+ print("}");
+ end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_clear_ocp_lists(@!a:small_number);
+begin
+define(ocp_active_number_base, data, 0);
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/alephdir/ompar.ch b/Build/source/texk/web2c/alephdir/ompar.ch
new file mode 100644
index 00000000000..5e42cb64e26
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/ompar.ch
@@ -0,0 +1,798 @@
+% ompar.ch: Local paragraph information
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%-------------------------
+@x
+@p function copy_node_list(@!p:pointer):pointer; {makes a duplicate of the
+ node list that starts at |p| and returns a pointer to the new list}
+var h:pointer; {temporary head of copied list}
+@!q:pointer; {previous position in new list}
+@!r:pointer; {current node being fabricated for new list}
+@!words:0..5; {number of words remaining to be copied}
+@y
+@p function copy_node_list(@!p:pointer):pointer; {makes a duplicate of the
+ node list that starts at |p| and returns a pointer to the new list}
+var h:pointer; {temporary head of copied list}
+@!q:pointer; {previous position in new list}
+@!r:pointer; {current node being fabricated for new list}
+@!words:0..8; {number of words remaining to be copied}
+@z
+
+@x [15] m.208 l.4170
+@d min_internal=char_ghost+1 {the smallest code that can follow \.{\\the}}
+@y
+@d assign_local_box=char_ghost+1
+ {box for guillemets \.{\\localleftbox} or \.{\\localrightbox}}
+@d min_internal=assign_local_box+1 {the smallest code that can follow \.{\\the}}
+@z
+%-------------------------
+@x [16] m.212 l.4306
+ @!aux_field: memory_word;
+@y
+ @!aux_field: memory_word;
+ @!local_par_field: pointer;
+ @!local_par_bool_field: boolean;
+@z
+%-------------------------
+@x [16] m.213 l.4318
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@y
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@d local_par==cur_list.local_par_field
+ {pointer to whatsit for local stuff}
+@d local_par_bool==cur_list.local_par_bool_field
+ {has local stuff been changed in this group?}
+@z
+%-------------------------
+@x [16] m.215 l.4344
+prev_graf:=0; shown_mode:=0;
+@y
+prev_graf:=0; shown_mode:=0;
+local_par:=null; local_par_bool:=false;
+@z
+%-------------------------
+@x [16] m.216 l.4351
+@ When \TeX's work on one level is interrupted, the state is saved by
+calling |push_nest|. This routine changes |head| and |tail| so that
+a new (empty) list is begun; it does not change |mode| or |aux|.
+
+@p procedure push_nest; {enter a new semantic level, save the old}
+begin if nest_ptr>max_nest_stack then
+ begin max_nest_stack:=nest_ptr;
+ if nest_ptr=nest_size then overflow("semantic nest size",nest_size);
+@:TeX capacity exceeded semantic nest size}{\quad semantic nest size@>
+ end;
+nest[nest_ptr]:=cur_list; {stack the record}
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+@ @p @<LOCAL: Declare |make_local_par_node|@>;
+
+@ When \TeX's work on one level is interrupted, the state is saved by
+calling |push_nest|. This routine changes |head| and |tail| so that
+a new (empty) list is begun; it does not change |mode| or |aux|.
+
+@p procedure push_nest; {enter a new semantic level, save the old}
+begin if nest_ptr>max_nest_stack then
+ begin max_nest_stack:=nest_ptr;
+ if nest_ptr=nest_size then overflow("semantic nest size",nest_size);
+@:TeX capacity exceeded semantic nest size}{\quad semantic nest size@>
+ end;
+nest[nest_ptr]:=cur_list; {stack the record}
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+local_par:=make_local_par_node; local_par_bool:=false;
+@z
+%-------------------------
+@x [16] m.217 l.4366
+begin free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+@y
+begin
+if local_par<>null then begin
+ if local_par_bool then begin end {|tail_append(local_par)|}
+ else free_node(local_par,local_par_size);
+ end;
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+@z
+%-------------------------
+@x [17] m.230 l.4860
+@d box_base=toks_base+number_regs {table of |number_regs| box registers}
+@y
+@d local_left_box_base=toks_base+number_regs
+@d local_right_box_base=local_left_box_base+1
+@d box_base=local_right_box_base+1 {table of |number_regs| box registers}
+@z
+%-------------------------
+@x [17] m.230 l.4888
+@d box(#)==equiv(box_base+#)
+@y
+@d local_left_box==equiv(local_left_box_base)
+@d local_right_box==equiv(local_right_box_base)
+@d box(#)==equiv(box_base+#)
+@z
+%-------------------------
+@x [17] m.236 l.4954
+@d int_pars=55 {total number of integer parameters}
+@y
+@d local_inter_line_penalty_code=55 {local \.{\\interlinepenalty}}
+@d local_broken_penalty_code=56 {local \.{\\brokenpenalty}}
+@d no_local_whatsits_code=57 {counts local whatsits}
+@d int_pars=58 {total number of integer parameters}
+@z
+%-------------------------
+@x [17] m.236 l.5011
+@d new_line_char==int_par(new_line_char_code)
+@y
+@d new_line_char==int_par(new_line_char_code)
+@d local_inter_line_penalty==int_par(local_inter_line_penalty_code)
+@d local_broken_penalty==int_par(local_broken_penalty_code)
+@d no_local_whatsits==int_par(no_local_whatsits_code)
+@z
+%-------------------------
+@x [19] m.269 l.5860
+@d max_group_code=16
+@y
+@d local_box_group=17 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=17
+@z
+%-------------------------
+@x [38] m.814 l.15994
+@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
+@y
+@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
+@!internal_pen_inter:integer; {running \.{\\localinterlinepenalty}}
+@!internal_pen_broken:integer; {running \.{\\localbrokenpenalty}}
+@!internal_left_box:pointer; {running \.{\\localleftbox}}
+@!internal_left_box_width:integer; {running \.{\\localleftbox} width}
+@!init_internal_left_box:pointer; {running \.{\\localleftbox}}
+@!init_internal_left_box_width:integer; {running \.{\\localleftbox} width}
+@!internal_right_box:pointer; {running \.{\\localrightbox}}
+@!internal_right_box_width:integer; {running \.{\\localrightbox} width}
+@!temp_no_whatsits:integer; {used when closing group}
+
+@ @<Set init...@>=
+temp_no_whatsits:=0;
+@z
+%-------------------------
+@x [38] m.821 l.16110
+@ The passive node for a given breakpoint contains only four fields:
+
+\yskip\hang|link| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+\yskip\hang|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+\yskip\hang|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+\yskip\hang|serial| is equal to |n| if this passive node is the |n|th
+one created during the current pass. (This field is used only when
+printing out detailed statistics about the line-breaking calculations.)
+
+\yskip\noindent
+There is a global variable called |passive| that points to the most
+recently created passive node. Another global variable, |printed_node|,
+is used to help print out the paragraph when detailed information about
+the line-breaking computation is being displayed.
+
+@d passive_node_size=2 {number of words in passive nodes}
+@d cur_break==rlink {in passive node, points to position of this breakpoint}
+@d prev_break==llink {points to passive node that should precede this one}
+@d serial==info {serial number for symbolic identification}
+@y
+@ The passive node for a given breakpoint contains EIGHT fields:
+
+\yskip\hang|link| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+\yskip\hang|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+\yskip\hang|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+\yskip\hang|serial| is equal to |n| if this passive node is the |n|th
+one created during the current pass. (This field is used only when
+printing out detailed statistics about the line-breaking calculations.)
+
+\yskip\hang|passive_pen_inter| holds the current \.{\\localinterlinepenalty}
+
+\yskip\hang|passive_pen_broken| holds the current \.{\\localbrokenpenalty}
+
+\yskip\noindent
+There is a global variable called |passive| that points to the most
+recently created passive node. Another global variable, |printed_node|,
+is used to help print out the paragraph when detailed information about
+the line-breaking computation is being displayed.
+
+@d passive_node_size=10 {number of words in passive nodes}
+@d cur_break==rlink {in passive node, points to position of this breakpoint}
+@d prev_break==llink {points to passive node that should precede this one}
+@d serial==info {serial number for symbolic identification}
+@d passive_pen_inter(#)==mem[#+2].int
+@d passive_pen_broken(#)==mem[#+3].int
+@d passive_left_box(#)==mem[#+4].int
+@d passive_left_box_width(#)==mem[#+5].int
+@d passive_last_left_box(#)==mem[#+6].int
+@d passive_last_left_box_width(#)==mem[#+7].int
+@d passive_right_box(#)==mem[#+8].int
+@d passive_right_box_width(#)==mem[#+9].int
+@z
+%-------------------------
+@x [38] m.835 l.16407
+@<If a line number class...@>=
+begin l:=line_number(r);
+if l>old_l then
+ begin {now we are no longer in the inner loop}
+@y
+@<If a line number class...@>=
+begin l:=line_number(r);
+if l>old_l then
+ begin {now we are no longer in the inner loop}
+@z
+%-------------------------
+@x [38] m.844 l.16595
+@<Insert a new active node from |best_place[fit_class]| to |cur_p|@>=
+begin q:=get_node(passive_node_size);
+link(q):=passive; passive:=q; cur_break(q):=cur_p;
+@!stat incr(pass_number); serial(q):=pass_number;@+tats@;@/
+prev_break(q):=best_place[fit_class];@/
+@y
+@<Insert a new active node from |best_place[fit_class]| to |cur_p|@>=
+begin q:=get_node(passive_node_size);
+link(q):=passive; passive:=q; cur_break(q):=cur_p;
+@!stat incr(pass_number); serial(q):=pass_number;@+tats@;@/
+prev_break(q):=best_place[fit_class];@/
+{Here we keep track of the subparagraph penalties in the break nodes}
+passive_pen_inter(q):=internal_pen_inter;
+passive_pen_broken(q):=internal_pen_broken;
+passive_last_left_box(q):=internal_left_box;
+passive_last_left_box_width(q):=internal_left_box_width;
+if prev_break(q)<>null then begin
+ passive_left_box(q):=passive_last_left_box(prev_break(q));
+ passive_left_box_width(q):=passive_last_left_box_width(prev_break(q));
+ end
+else begin
+ passive_left_box(q):=init_internal_left_box;
+ passive_left_box_width(q):=init_internal_left_box_width;
+ end;
+passive_right_box(q):=internal_right_box;
+passive_right_box_width(q):=internal_right_box_width;
+@z
+%-------------------------
+@x [38] m.851 l.16706
+@<Consider the demerits for a line from |r| to |cur_p|...@>=
+begin artificial_demerits:=false;@/
+@^inner loop@>
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+@y
+@<Consider the demerits for a line from |r| to |cur_p|...@>=
+begin artificial_demerits:=false;@/
+@^inner loop@>
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+if break_node(r)=null then
+ shortfall:=shortfall-init_internal_left_box_width
+else shortfall:=shortfall-passive_last_left_box_width(break_node(r));
+shortfall:=shortfall-internal_right_box_width;
+@z
+%-------------------------
+@x [39] m.863 l.16932
+loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
+ if second_pass then @<Initialize for hyphenating a paragraph@>;
+ @<Create an active breakpoint representing the beginning of the paragraph@>;
+ cur_p:=link(temp_head); auto_breaking:=true;@/
+ prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
+@y
+loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
+ if second_pass then @<Initialize for hyphenating a paragraph@>;
+ @<Create an active breakpoint representing the beginning of the paragraph@>;
+ cur_p:=link(temp_head); auto_breaking:=true;@/
+ prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
+ @<LOCAL: Initialize with first |local_paragraph| node@>;
+@z
+%-------------------------
+@x [39] m.877 l.17206
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+@y
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+@z
+%-------------------------
+@x [39] m.879 l.17257
+ if non_discardable(q) then goto done1;
+ if type(q)=kern_node then if subtype(q)<>explicit then goto done1;
+@y
+ if @<LOCAL: local paragraph node@> then begin end
+ else begin
+ if non_discardable(q) then goto done1;
+ if type(q)=kern_node then if subtype(q)<>explicit then goto done1;
+ end;
+@z
+%-------------------------
+@x [39] m.881 l.17289
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+if q<>null then {|q| cannot be a |char_node|}
+ if type(q)=glue_node then
+ begin delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+@y
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+if q<>null then {|q| cannot be a |char_node|}
+ if type(q)=glue_node then begin
+ if passive_right_box(cur_p)<>null then begin
+ r:=temp_head;
+ while link(r)<>q do r:=link(r);
+ s:=copy_node_list(passive_right_box(cur_p));
+ link(r):=s;
+ link(s):=q;
+ end;
+ delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+if passive_right_box(cur_p)<>null then begin
+ r:=copy_node_list(passive_right_box(cur_p));
+ link(r):=link(q);
+ link(q):=r;
+ q:=r;
+ end;
+@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+@z
+%-------------------------
+@x [39] m.887 l.17352
+@<Put the \(l)\.{\\leftskip} glue at the left...@>=
+r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
+if left_skip<>zero_glue then
+ begin r:=new_param_glue(left_skip_code);
+ link(r):=q; q:=r;
+ end
+@y
+@<Put the \(l)\.{\\leftskip} glue at the left...@>=
+r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
+if passive_left_box(cur_p)<>null then begin
+ r:=copy_node_list(passive_left_box(cur_p));
+ s:=link(q);
+ link(r):=q;
+ q:=r;
+ if (cur_line=prev_graf+1) and (s<>null) then
+ if type(s)=hlist_node then
+ if list_ptr(s)=null then begin
+ q:=link(q);
+ link(r):=link(s);
+ link(s):=r;
+ end;
+ end;
+if left_skip<>zero_glue then
+ begin r:=new_param_glue(left_skip_code);
+ link(r):=q; q:=r;
+ end
+@z
+%-------------------------
+@x [39] m.890 l.17391
+@<Append a penalty node, if a nonzero penalty is appropriate@>=
+if cur_line+1<>best_line then
+ begin pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+ if disc_break then pen:=pen+broken_penalty;
+@y
+@<Append a penalty node, if a nonzero penalty is appropriate@>=
+if cur_line+1<>best_line then begin
+ if passive_pen_inter(cur_p)<>0 then
+ pen:=passive_pen_inter(cur_p)
+ else pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+ if disc_break then
+ if passive_pen_broken(cur_p)<>0 then
+ pen:=pen+passive_pen_broken(cur_p)
+ else pen:=pen+broken_penalty;
+@z
+%-------------------------
+@x [47] m.1063 l.20580
+non_math(left_brace): new_save_level(simple_group);
+any_mode(begin_group): new_save_level(semi_simple_group);
+any_mode(end_group): if cur_group=semi_simple_group then unsave
+ else off_save;
+@y
+non_math(left_brace): begin
+ new_save_level(simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ end;
+any_mode(begin_group): begin
+ new_save_level(semi_simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ end;
+any_mode(end_group):
+ if cur_group=semi_simple_group then begin
+ temp_no_whatsits:=no_local_whatsits;
+ unsave;
+ if temp_no_whatsits<>0 then
+ if abs(mode)=hmode then @<LOCAL: Add local paragraph node@>;
+ end
+ else off_save;
+@z
+%-------------------------
+@x [47] m.1068 l.20653
+procedure handle_right_brace;
+var p,@!q:pointer; {for short-term use}
+@!d:scaled; {holds |split_max_depth| in |insert_group|}
+@!f:integer; {holds |floating_penalty| in |insert_group|}
+begin case cur_group of
+simple_group: unsave;
+@y
+procedure handle_right_brace;
+var p,@!q:pointer; {for short-term use}
+@!d:scaled; {holds |split_max_depth| in |insert_group|}
+@!f:integer; {holds |floating_penalty| in |insert_group|}
+begin case cur_group of
+simple_group: begin
+ temp_no_whatsits:=no_local_whatsits;
+ unsave;
+ if temp_no_whatsits<>0 then
+ if abs(mode)=hmode then @<LOCAL: Add local paragraph node@>;
+ end;
+@z
+%-------------------------
+@x [47] m.1091 l.21055
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ end;
+@y
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ tail:=new_null_box; link(link(head)):=tail; width(tail):=par_indent;@+
+ end;
+@z
+%-------------------------
+@x [47] m.1096 l.21116
+procedure end_graf;
+begin if mode=hmode then
+ begin if head=tail then pop_nest {null paragraphs are ignored}
+@y
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+@z
+%-------------------------
+@x [47] m.1114 l.21322
+primitive("-",discretionary,1);
+@!@:Single-character primitives -}{\quad\.{\\-}@>
+primitive("discretionary",discretionary,0);
+@!@:discretionary_}{\.{\\discretionary} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+discretionary: if chr_code=1 then
+ print_esc("-")@+else print_esc("discretionary");
+
+@ @<Cases of |main_control| that build...@>=
+hmode+discretionary,mmode+discretionary: append_discretionary;
+@y
+primitive("-",discretionary,1);
+@!@:Single-character primitives -}{\quad\.{\\-}@>
+primitive("discretionary",discretionary,0);
+@!@:discretionary_}{\.{\\discretionary} primitive@>
+primitive("localleftbox",assign_local_box,0);
+@!@:assign_local_box}{\.{\\localleftbox} primitive@>
+primitive("localrightbox",assign_local_box,1);
+@!@:assign_local_box}{\.{\\localrightbox} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+discretionary: if chr_code=1 then
+ print_esc("-")@+else print_esc("discretionary");
+assign_local_box: if chr_code=0 then print_esc("localleftbox")
+ else print_esc("localrightbox");
+
+@ @<Cases of |main_control| that build...@>=
+hmode+discretionary,mmode+discretionary: append_discretionary;
+any_mode(assign_local_box): append_local_box(cur_chr);
+@z
+%-------------------------
+@x [47] m.1117 l.21338
+procedure append_discretionary;
+@y
+procedure append_local_box(kind:integer);
+begin
+incr(save_ptr); saved(-1):=kind; new_save_level(local_box_group);
+scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
+end;
+
+procedure append_discretionary;
+@z
+%-------------------------
+@x [47] m.1118 l.21355
+disc_group: build_discretionary;
+@y
+disc_group: build_discretionary;
+local_box_group: build_local_box;
+@z
+%-------------------------
+@x [47] m.1119 l.21358
+procedure build_discretionary;
+@y
+procedure build_local_box;
+var p:pointer;
+ kind:integer;
+begin
+unsave;
+kind:=saved(-1);
+decr(save_ptr);
+p:=link(head); pop_nest;
+p:=hpack(p,natural);
+if kind=0 then
+ eq_define(local_left_box_base,box_ref,p)
+else
+ eq_define(local_right_box_base,box_ref,p);
+if abs(mode)=hmode then
+ @<LOCAL: Add local paragraph node@>;
+eq_word_define(int_base+no_local_whatsits_code,no_local_whatsits+1);
+end;
+
+procedure build_discretionary;
+@z
+%-------------------------
+@x [47] m.1200 l.22453
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+unsave; prev_graf:=prev_graf+3;
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@y
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+unsave; prev_graf:=prev_graf+3;
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+@z
+%-------------------------
+@x [49] m.1228 l.22908
+assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
+ word_define(p,cur_val);
+@y
+assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
+ word_define(p,cur_val);
+{If we are defining subparagraph penalty levels while we are
+in hmode, then we put out a whatsit immediately, otherwise
+we leave it alone. This mechanism might not be sufficiently
+powerful, and some other algorithm, searching down the stack,
+might be necessary. Good first step.}
+ if (abs(mode)=hmode) and
+ ((p=(int_base+local_inter_line_penalty_code)) or
+ (p=(int_base+local_broken_penalty_code))) then begin
+ @<LOCAL: Add local paragraph node@>;
+ eq_word_define(int_base+no_local_whatsits_code,no_local_whatsits+1);
+ local_par_bool:=true;
+ end;
+@z
+%-------------------------
+@x [53] m.1344 l.24533
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@y
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@d local_par_node=6 {|subtype| in whatsits for local paragraph node}
+@z
+%-------------------------
+@x [53] m.1344 l.24546
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+@y
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+primitive("localinterlinepenalty",assign_int,local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,local_broken_penalty_code);@/
+@z
+%-------------------------
+@x [53] m.1356 l.24660
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+@y4
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+@<LOCAL: print out |local_paragraph| node@>;
+@z
+%-------------------------
+@x [53] m.1357 l.24685
+othercases confusion("ext2")
+@y
+local_par_node: begin r:=get_node(local_par_size);
+ words:=local_par_size;
+ end;
+othercases confusion("ext2")
+@z
+%-------------------------
+@x [53] m.1358 l.24696
+othercases confusion("ext3")
+@y
+local_par_node: free_node(p,local_par_size);
+othercases confusion("ext3")
+@z
+%-------------------------
+@x [53] m.1362 l.24711
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p)
+@y
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p) else @<LOCAL: Advance past a |local_paragraph| node@>
+@z
+%-------------------------
+@x [53] m.1373 l.24820
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+begin case subtype(p) of
+open_node,write_node,close_node:@<Do some work that has been queued up
+ for \.{\\write}@>;
+special_node:special_out(p);
+language_node:do_nothing;
+othercases confusion("ext4")
+@y
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+begin case subtype(p) of
+open_node,write_node,close_node:@<Do some work that has been queued up
+ for \.{\\write}@>;
+special_node:special_out(p);
+language_node:do_nothing;
+local_par_node:do_nothing;
+othercases confusion("ext4")
+@z
+%-------------------------
+@x [53] m.1378 l.24900
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+@y
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+
+@
+@d local_pen_inter(#)==mem[#+1].int {\.{\\localinterlinepenalty}}
+@d local_pen_broken(#)==mem[#+2].int {\.{\\localbrokenpenalty}}
+@d local_box_left(#)==mem[#+3].int {\.{\\localleftbox}}
+@d local_box_left_width(#)==mem[#+4].int
+@d local_box_right(#)==mem[#+5].int {\.{\\localleftbox}}
+@d local_box_right_width(#)==mem[#+6].int
+@d local_par_size==7
+
+@<LOCAL: Declare |make_local_par_node|@>=
+function make_local_par_node:pointer;
+{This function creates a |local_paragraph| node}
+var p:pointer;
+begin
+p:=get_node(local_par_size); type(p):=whatsit_node;
+subtype(p):=local_par_node; link(p):=null;
+local_pen_inter(p):=local_inter_line_penalty;
+local_pen_broken(p):=local_broken_penalty;
+if local_left_box=null then begin
+ local_box_left(p):=null;
+ local_box_left_width(p):=0;
+ end
+else begin
+ local_box_left(p):=copy_node_list(local_left_box);
+ local_box_left_width(p):=width(local_left_box);
+ end;
+if local_right_box=null then begin
+ local_box_right(p):=null;
+ local_box_right_width(p):=0;
+ end
+else begin
+ local_box_right(p):=copy_node_list(local_right_box);
+ local_box_right_width(p):=width(local_right_box);
+ end;
+make_local_par_node:=p;
+end
+
+@ @<LOCAL: Initialize with first |local_paragraph| node@>=
+if subtype(cur_p)=local_par_node then begin
+ internal_pen_inter:=local_pen_inter(cur_p);
+ internal_pen_broken:=local_pen_broken(cur_p);
+ init_internal_left_box:=local_box_left(cur_p);
+ init_internal_left_box_width:=local_box_left_width(cur_p);
+ internal_left_box:=init_internal_left_box;
+ internal_left_box_width:=init_internal_left_box_width;
+ internal_right_box:=local_box_right(cur_p);
+ internal_right_box_width:=local_box_right_width(cur_p);
+ end
+
+@ @<LOCAL: Advance past a |local_paragraph| node@>=
+if subtype(cur_p)=local_par_node then begin
+ internal_pen_inter:=local_pen_inter(cur_p);
+ internal_pen_broken:=local_pen_broken(cur_p);
+ internal_left_box:=local_box_left(cur_p);
+ internal_left_box_width:=local_box_left_width(cur_p);
+ internal_right_box:=local_box_right(cur_p);
+ internal_right_box_width:=local_box_right_width(cur_p);
+ end
+
+@ @<LOCAL: print out |local_paragraph| node@>=
+local_par_node: begin
+ print_esc("whatsit");
+ append_char(".");
+ print_ln; print_current_string;
+ print_esc("localinterlinepenalty"); print("=");
+ print_int(local_pen_inter(p));
+ print_ln; print_current_string;
+ print_esc("localbrokenpenalty"); print("=");
+ print_int(local_pen_broken(p));
+ print_ln; print_current_string;
+ print_esc("localleftbox");
+ if local_box_left(p)=null then print("=null")
+ else begin
+ append_char(".");
+ show_node_list(local_box_left(p));
+ decr(pool_ptr);
+ end;
+ print_ln; print_current_string;
+ print_esc("localrightbox");
+ if local_box_right(p)=null then print("=null")
+ else begin
+ append_char(".");
+ show_node_list(local_box_right(p));
+ decr(pool_ptr);
+ end;
+ decr(pool_ptr);
+ end
+
+@ @<LOCAL: Add local paragraph node@>=
+begin tail_append(make_local_par_node) end
+
+@ @<LOCAL: local paragraph node@>=
+((type(q)=whatsit_node) and (subtype(q)=local_par_node))
+
+@z
+%-------------------------
diff --git a/Build/source/texk/web2c/alephdir/omstr.ch b/Build/source/texk/web2c/alephdir/omstr.ch
new file mode 100644
index 00000000000..f23ca0c2933
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omstr.ch
@@ -0,0 +1,875 @@
+% omstr.ch: String manipulation
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [2] m.17 l.510 - Omega
+In order to make \TeX\ readily portable to a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+@y
+In order to make $\Omega$ readily portable to a wide variety of
+computers, all of its input text is converted to an internal 31-bit
+@z
+%---------------------------------------
+@x [2] m.18 l.537 - Omega
+@!ASCII_code=0..255; {eight-bit numbers}
+@y
+@!ASCII_code=0..biggest_char;
+@z
+%---------------------------------------
+@x [2] m.19 l.567 - Omega
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@y
+@d last_text_char=biggest_char
+ {ordinal number of the largest element of |text_char|}
+@z
+%---------------------------------------
+@x [2] m.20 l.577 - Omega
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+@y
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+@z
+%---------------------------------------
+@x [2] m.23 l.724 - Omega
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+@y
+for i:=0 to @'37 do xchr[i]:=chr(i);
+for i:=@'177 to @'377 do xchr[i]:=chr(i);
+init_eqtb_table;
+@z
+%---------------------------------------
+@x [2] m.24 l.734 - Omega
+for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
+for i:=@'200 to @'377 do xord[xchr[i]]:=i;
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+@y
+@z
+%---------------------------------------
+@x [3] m.25 l.772 - Omega
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+@!eight_bits=0..biggest_char; {unsigned two-byte quantity}
+@!real_eight_bits=0..255; {dvi output uses exactly 8 bits}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of real_eight_bits; {files that contain binary data}
+@z
+%---------------------------------------
+@x [3] m.31 l.947 - Omega
+ buffer[last]:=xord[f^]; get(f); incr(last);
+@y
+ buffer[last]:=f^; get(f); incr(last);
+@z
+%---------------------------------------
+@x [4] m.38 l.1099 - Omega
+String numbers 0 to 255 are reserved for strings that correspond to single
+ASCII characters. This is in accordance with the conventions of \.{WEB},
+@y
+String numbers 0 to |biggest_char| are reserved for strings that correspond to
+single ASCII characters. This is in accordance with the conventions of \.{WEB},
+@z
+%---------------------------------------
+@x [4] m.38 l.1109 - Omega
+ASCII character, so the first 256 strings are used to specify exactly what
+should be printed for each of the 256 possibilities.
+@y
+ASCII character, so the first |biggest_char+1| strings are used to specify
+exactly what should be printed for each of the |biggest_char+1| possibilities.
+@z
+%---------------------------------------
+@x [4] m.38-9 l.1122 - Omega
+@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
+@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..255; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
+@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
+@d str_start(#) == str_start_ar[#-too_big_char]
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..65535; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start_ar : array[str_number] of pool_pointer; {the starting pointers}
+@z
+%---------------------------------------
+@x [4] m.40 l.1145 - Omega
+@d length(#)==(str_start[#+1]-str_start[#]) {the number of characters
+ in string number \#}
+@y
+@p function length(s:str_number):integer;
+ {the number of characters in string number |s|}
+begin if (s>=@"10000) then length:=str_start(s+1)-str_start(s)
+else if (s>=@"20) and (s<@"7F) then length:=1
+else if (s<=@"7F) then length:=3
+else if (s<@"100) then length:=4
+else length:=8
+end;
+@z
+%---------------------------------------
+@x [4] m.41 l.1150 - Omega
+@d cur_length == (pool_ptr - str_start[str_ptr])
+@y
+@d cur_length == (pool_ptr - str_start(str_ptr))
+@z
+%---------------------------------------
+@x [4] m.43 l.1181 - Omega
+incr(str_ptr); str_start[str_ptr]:=pool_ptr;
+@y
+incr(str_ptr); str_start(str_ptr):=pool_ptr;
+@z
+%---------------------------------------
+@x [4] m.44 l.1187 - Omega
+@d flush_string==begin decr(str_ptr); pool_ptr:=str_start[str_ptr];
+@y
+@d flush_string==begin decr(str_ptr); pool_ptr:=str_start(str_ptr);
+@z
+%---------------------------------------
+@x [4] m.45 l.1201 - Omega
+begin j:=str_start[s];
+while j<str_start[s+1] do
+@y
+begin j:=str_start(s);
+while j<str_start(s+1) do
+@z
+%---------------------------------------
+@x [4] m.46 l.1222 - Omega
+@p function str_eq_str(@!s,@!t:str_number):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j,@!k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin result:=false;
+if length(s)<>length(t) then goto not_found;
+j:=str_start[s]; k:=str_start[t];
+while j<str_start[s+1] do
+ begin if str_pool[j]<>str_pool[k] then goto not_found;
+ incr(j); incr(k);
+ end;
+result:=true;
+not_found: str_eq_str:=result;
+end;
+@y
+@p function str_eq_str(@!s,@!t:str_number):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j,@!k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin result:=false;
+if length(s)<>length(t) then goto not_found;
+if (length(s)=1) then begin
+ if s<65536 then begin
+ if t<65536 then begin
+ if s<>t then goto not_found;
+ end
+ else begin
+ if s<>str_pool[str_start(t)] then goto not_found;
+ end;
+ end
+ else begin
+ if t<65536 then begin
+ if str_pool[str_start(s)]<>t then goto not_found;
+ end
+ else begin
+ if str_pool[str_start(s)]<>str_pool[str_start(t)] then
+ goto not_found;
+ end;
+ end;
+ end
+else begin
+ j:=str_start(s); k:=str_start(t);
+ while j<str_start(s+1) do
+ begin if str_pool[j]<>str_pool[k] then goto not_found;
+ incr(j); incr(k);
+ end;
+ end;
+result:=true;
+not_found: str_eq_str:=result;
+end;
+@z
+%---------------------------------------
+@x [4] m.47 l.1240 - Omega
+var k,@!l:0..255; {small indices or counters}
+@y
+var k,@!l:0..biggest_char; {small indices or counters}
+@z
+%---------------------------------------
+@x [4] m.47 l.1245 - Omega
+begin pool_ptr:=0; str_ptr:=0; str_start[0]:=0;
+@<Make the first 256 strings@>;
+@<Read the other strings from the \.{TEX.POOL} file and return |true|,
+@y
+begin pool_ptr:=0; str_ptr:=0; str_start_ar[0]:=0; str_start_ar[1]:=0;
+@<Make the first strings@>;
+@<Read the other strings from the \.{OMEGA.POOL} file and return |true|,
+@z
+%---------------------------------------
+% A hack is made for strings 256 through to 65535.
+% String 256 becomes "^^^^????". All the strings
+% from 256 to 65535 are made to point at this string,
+% which will never be printed: it's just a placeholder.
+
+@x [4] m.48 l.1255 - Omega
+@<Make the first 256...@>=
+for k:=0 to 255 do
+ begin if (@<Character |k| cannot be printed@>) then
+ begin append_char("^"); append_char("^");
+ if k<@'100 then append_char(k+@'100)
+ else if k<@'200 then append_char(k-@'100)
+ else begin app_lc_hex(k div 16); app_lc_hex(k mod 16);
+ end;
+ end
+ else append_char(k);
+ g:=make_string;
+ end
+@y
+@<Make the first ...@>=
+begin
+str_ptr:=too_big_char;
+end
+@z
+%---------------------------------------
+@x [4] m.49 l.1279 - Omega
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+@y
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+Unprintable characters of codes 256--|biggest_char| are, similarly, rendered
+\.{\^\^\^\^0100}--\.{\^\^\^\^ffff}.
+
+@z
+%---------------------------------------
+@x [4] m.49 l.1295 - Omega
+@<Character |k| cannot be printed@>=
+ (k<" ")or(k>"~")
+@y
+@z
+%---------------------------------------
+@x [4] m.50 l.1298 - Omega
+@ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{TEX.PAS} and also a string pool file called \.{TEX.POOL}. The \.{INITEX}
+@y
+@ When the \.{WEB} system program called \.{OTANGLE} processes the \.{OMEGA.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{OMEGA.PAS} and also a string pool file called \.{OMEGA.POOL}. The \.{INITEX}
+@z
+%---------------------------------------
+@x [4] m.51 l.1322 - Omega
+else bad_pool('! I can''t read TEX.POOL.')
+@.I can't read TEX.POOL@>
+@y
+else bad_pool('! I can''t read OMEGA.POOL.')
+@.I can't read OMEGA.POOL@>
+@z
+%---------------------------------------
+@x [4] m.52 l.1326 - Omega
+begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.');
+@.TEX.POOL has no check sum@>
+@y
+begin if eof(pool_file) then bad_pool('! OMEGA.POOL has no check sum.');
+@.OMEGA.POOL has no check sum@>
+@z
+%---------------------------------------
+@x [4] m.52 l.1332 - Omega
+else begin if (xord[m]<"0")or(xord[m]>"9")or@|
+ (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL line doesn''t begin with two digits.');
+@.TEX.POOL line doesn't...@>
+ l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(xord[m]);
+@y
+else begin if (m<"0")or(m>"9")or@|
+ (n<"0")or(n>"9") then
+ bad_pool('! OMEGA.POOL line doesn''t begin with two digits.');
+@.OMEGA.POOL line doesn't...@>
+ l:=m*10+n-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(m);
+@z
+%---------------------------------------
+@x [4] m.53 l.1347 - Omega
+end of this \.{TEX.POOL} file; any other value means that the wrong pool
+@y
+end of this \.{OMEGA.POOL} file; any other value means that the wrong pool
+@z
+%---------------------------------------
+@x [4] m.53 l.1354 - Omega
+loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL check sum doesn''t have nine digits.');
+@.TEX.POOL check sum...@>
+ a:=10*a+xord[n]-"0";
+@y
+loop@+ begin if (n<"0")or(n>"9") then
+ bad_pool('! OMEGA.POOL check sum doesn''t have nine digits.');
+@.OMEGA.POOL check sum...@>
+ a:=10*a+n-"0";
+@z
+%---------------------------------------
+@x [4] m.53 l.1360 - Omega
+done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.');
+@.TEX.POOL doesn't match@>
+@y
+done: if a<>@$ then bad_pool('! OMEGA.POOL doesn''t match; OTANGLE me again.');
+@.OMEGA.POOL doesn't match@>
+@z
+%---------------------------------------
+% When we print a string, we must make sure we do the appropriate
+% thing for strings 256 through to 65535. We must generate the
+% strings on the fly.
+
+@x [5] m.59 l.1496 - Omega
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<256 then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char; new_line_char:=-1;
+ {temporarily disable new-line character}
+ j:=str_start[s];
+ while j<str_start[s+1] do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+ new_line_char:=nl; return;
+ end;
+j:=str_start[s];
+while j<str_start[s+1] do
+@y
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@d print_lc_hex(#)==l:=#;
+ if l<10 then print_char(l+"0") else print_char(l-10+"a");
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+@!l:integer; {for printing 16-bit characters}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char;
+ @<Set newline character to -1@>;
+ if s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(s+@'100);
+ end
+ else if s<@"7F then
+ print_char(s)
+ else if s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(s-@'100);
+ end
+ else if s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end;
+ @<Set newline character to nl@>;
+ return;
+ end;
+j:=str_start(s);
+while j<str_start(s+1) do
+@z
+%---------------------------------------
+@x [5] m.60 l.1539 - Omega
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<256) then print(s)
+else begin j:=str_start[s];
+ while j<str_start[s+1] do
+@y
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<=biggest_char) then print(s)
+else begin j:=str_start(s);
+ while j<str_start(s+1) do
+@z
+%---------------------------------------
+@x [5] m.61 l.1556 - Omega
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+update_terminal;
+@y
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+wterm_ln('Copyright (c) 1994--2000 John Plaice and Yannis Haralambous');
+update_terminal;
+@z
+%---------------------------------------
+@x [5] m.63 l.1576 - Omega
+procedure print_esc(@!s:str_number); {prints escape character, then |s|}
+var c:integer; {the escape character code}
+begin @<Set variable |c| to the current escape character@>;
+if c>=0 then if c<256 then print(c);
+@y
+procedure print_esc(@!s:str_number); {prints escape character, then |s|}
+var c:integer; {the escape character code}
+begin @<Set variable |c| to the current escape character@>;
+if c>=0 then if c<=biggest_char then print(c);
+@z
+%---------------------------------------
+@x [5] m.69 l.1654 - Omega
+@p procedure print_roman_int(@!n:integer);
+label exit;
+var j,@!k: pool_pointer; {mysterious indices into |str_pool|}
+@!u,@!v: nonnegative_integer; {mysterious numbers}
+begin j:=str_start["m2d5c2l5x2v5i"]; v:=1000;
+@y
+@p procedure print_roman_int(@!n:integer);
+label exit;
+var j,@!k: pool_pointer; {mysterious indices into |str_pool|}
+@!u,@!v: nonnegative_integer; {mysterious numbers}
+begin j:=str_start("m2d5c2l5x2v5i"); v:=1000;
+@z
+%---------------------------------------
+@x [5] m.70 l.1674 - Omega
+@p procedure print_current_string; {prints a yet-unmade string}
+var j:pool_pointer; {points to current character code}
+begin j:=str_start[str_ptr];
+@y
+@p procedure print_current_string; {prints a yet-unmade string}
+var j:pool_pointer; {points to current character code}
+begin j:=str_start(str_ptr);
+@z
+%---------------------------------------
+@x [6] m.94 l.2052 - Omega
+print_err("TeX capacity exceeded, sorry [");
+@y
+print_err("Omega capacity exceeded, sorry [");
+@z
+%---------------------------------------
+@x [18] m.260 l.5532 - Omega
+while pool_ptr>str_start[str_ptr] do
+@y
+while pool_ptr>str_start(str_ptr) do
+@z
+%---------------------------------------
+@x [18] m.264 l.5610 - Omega
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+@y
+else begin k:=str_start(s); l:=str_start(s+1)-k;
+@z
+%---------------------------------------
+@x [24] m.341 l.7219 - Omega
+@!c,@!cc:ASCII_code; {constituents of a possible expanded code}
+@!d:2..3; {number of excess characters in an expanded code}
+@y
+@!c,@!cc,@!ccc,@!cccc:ASCII_code; {constituents of a possible expanded code}
+@!d:2..7; {number of excess characters in an expanded code}
+@z
+%---------------------------------------
+@x [24] m.352 l.7349 - Omega
+ else cur_chr:=16*cur_chr+cc-"a"+10
+@y
+ else cur_chr:=16*cur_chr+cc-"a"+10
+@d long_hex_to_cur_chr==
+ if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
+ if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
+ else cur_chr:=16*cur_chr+cc-"a"+10;
+ if ccc<="9" then cur_chr:=16*cur_chr+ccc-"0"
+ else cur_chr:=16*cur_chr+ccc-"a"+10;
+ if cccc<="9" then cur_chr:=16*cur_chr+cccc-"0"
+ else cur_chr:=16*cur_chr+cccc-"a"+10
+
+@z
+%---------------------------------------
+@x [24] m.352 l.7353 - Omega
+ begin c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
+@y
+ begin if (cur_chr=buffer[loc+1]) and (cur_chr=buffer[loc+2]) and
+ ((loc+6)<=limit) then
+ begin c:=buffer[loc+3]; cc:=buffer[loc+4];
+ ccc:=buffer[loc+5]; cccc:=buffer[loc+6];
+ if is_hex(c) and is_hex(cc) and is_hex(ccc) and is_hex(cccc) then
+ begin loc:=loc+7; long_hex_to_cur_chr; goto reswitch;
+ end;
+ end;
+ c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
+@z
+%---------------------------------------
+@x [24] m.355 l.7416 - Omega
+begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
+ begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
+ begin d:=2;
+ if is_hex(c) then @+if k+2<=limit then
+ begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
+ end;
+ if d>2 then
+ begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ end
+ else if c<@'100 then buffer[k-1]:=c+@'100
+ else buffer[k-1]:=c-@'100;
+ limit:=limit-d; first:=first-d;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end;
+ end;
+end
+
+@y
+begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
+ begin if (cur_chr=buffer[k+1]) and (cur_chr=buffer[k+2]) and
+ ((k+6)<=limit) then
+ begin c:=buffer[k+3]; cc:=buffer[k+4];
+ ccc:=buffer[k+5]; cccc:=buffer[k+6];
+ if is_hex(c) and is_hex(cc) and is_hex(ccc) and is_hex(cccc) then
+ begin d:=7; long_hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end
+ end
+ else begin
+ c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
+ begin
+ d:=2;
+ if is_hex(c) then @+if k+2<=limit then
+ begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
+ end;
+ if d>2 then
+ begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ end
+ else if c<@'100 then buffer[k-1]:=c+@'100
+ else buffer[k-1]:=c-@'100;
+ limit:=limit-d; first:=first-d;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end
+ end
+ end
+end
+@z
+%---------------------------------------
+@x [26] m.407 l.8216 - Omega
+begin p:=backup_head; link(p):=null; k:=str_start[s];
+while k<str_start[s+1] do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=so(str_pool[k]))or(cur_chr=so(str_pool[k])-"a"+"A")) then
+ begin store_new_token(cur_tok); incr(k);
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+@y
+begin p:=backup_head; link(p):=null;
+if s<too_big_char then begin
+ while true do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=s)or(cur_chr=s-"a"+"A")) then
+ begin store_new_token(cur_tok);
+ flush_list(link(backup_head)); scan_keyword:=true; return;
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+ end;
+k:=str_start(s);
+while k<str_start(s+1) do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=so(str_pool[k]))or(cur_chr=so(str_pool[k])-"a"+"A")) then
+ begin store_new_token(cur_tok); incr(k);
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+@z
+%---------------------------------------
+@x [29] m.517 l.10005 - Omega
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+if area_delimiter=0 then cur_area:=""
+else begin cur_area:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
+@y
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+if area_delimiter=0 then cur_area:=""
+else begin cur_area:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+@z
+%---------------------------------------
+@x [29] m.519 l.10039 - Omega
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[n] to str_start[n+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[e] to str_start[e+1]-1 do append_to_name(so(str_pool[j]));
+@y
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start(n) to str_start(n+1)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start(e) to str_start(e+1)-1 do append_to_name(so(str_pool[j]));
+@z
+%---------------------------------------
+@x [29] m.523 l.10095 - Omega
+for j:=1 to n do append_to_name(xord[TEX_format_default[j]]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=format_default_length-format_ext_length+1 to format_default_length do
+ append_to_name(xord[TEX_format_default[j]]);
+@y
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=format_default_length-format_ext_length+1 to format_default_length do
+ append_to_name(TEX_format_default[j]);
+@z
+%---------------------------------------
+@x [29] m.524 l.10155 - Omega
+else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+@y
+else begin for k:=1 to name_length do append_char(name_of_file[k]);
+@z
+%---------------------------------------
+@x [29] m.536 l.10324 - Omega
+begin wlog(banner);
+slow_print(format_ident); print(" ");
+print_int(day); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+for k:=3*month-2 to 3*month do wlog(months[k]);
+print_char(" "); print_int(year); print_char(" ");
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+end
+@y
+begin wlog(banner);
+slow_print(format_ident); print_nl("");
+print_int(day); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+for k:=3*month-2 to 3*month do wlog(months[k]);
+print_char(" "); print_int(year); print_char(" ");
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+print_nl("Copyright (c) 1994--2000 John Plaice and Yannis Haralambous");
+end
+@z
+%---------------------------------------
+@x [32] m.595 l.11860 - Omega
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@y
+@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
+@z
+%---------------------------------------
+@x [32] m.617 l.12262 - Omega
+ print(" TeX output "); print_int(year); print_char(".");
+@y
+ print("Omega output, Version 3.141592--1.15, ");
+ print_int(year); print_char(".");
+@z
+%---------------------------------------
+@x [32] m.617 l.12267 - Omega
+ for s:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[s]));
+ pool_ptr:=str_start[str_ptr]; {flush the current string}
+@y
+ for s:=str_start(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s]));
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+@z
+%---------------------------------------
+@x [36] m.765 l.15021 - Omega
+magic_offset:=str_start[math_spacing]-9*ord_noad
+@y
+magic_offset:=str_start(math_spacing)-9*ord_noad
+@z
+%---------------------------------------
+@x [42] m.931 l.18172 - Omega
+ begin j:=1; u:=str_start[k];
+@y
+ begin j:=1; u:=str_start(k);
+@z
+%---------------------------------------
+@x [42] m.940 l.18296 - Omega
+u:=str_start[k]; v:=str_start[s];
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start[k+1];
+@y
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+@z
+%---------------------------------------
+@x [49] m.1252 l.23232 - Omega
+ print_err("Patterns can be loaded only by INITEX");
+@y
+ print_err("Patterns can be loaded only by INIOMEGA");
+@z
+%---------------------------------------
+@x [50] m.1301 l.23682 - Omega
+format_ident:=" (INITEX)";
+@y
+format_ident:=" (INIOMEGA)";
+@z
+%---------------------------------------
+% We do not store any information for strings between 257 and 65535.
+
+@x [50] m.1309 l.23814 - Omega
+for k:=0 to str_ptr do dump_int(str_start[k]);
+@y
+for k:=too_big_char to str_ptr do dump_int(str_start(k));
+@z
+%---------------------------------------
+% We recreate the information for strings between 257 and 65535.
+
+@x [50] m.1310 l.23831 - Omega
+for k:=0 to str_ptr do undump(0)(pool_ptr)(str_start[k]);
+@y
+for k:=too_big_char to str_ptr do undump(0)(pool_ptr)(str_start(k));
+@z
+%---------------------------------------
+@x [51] m.1334 l.24266 - Omega
+ wlog_ln('Here is how much of TeX''s memory',' you used:');
+@y
+ wlog_ln('Here is how much of Omega''s memory',' you used:');
+@z
+%---------------------------------------
+@x [51] m.1335 l.24338 - Omega
+ print_nl("(\dump is performed only by INITEX)"); return;
+@:dump_}{\.{\\dump...only by INITEX}@>
+@y
+ print_nl("(\dump is performed only by INIOMEGA)"); return;
+@:dump_}{\.{\\dump...only by INIOMEGA}@>
+@z
+%---------------------------------------
+@x [53] m.1368 l.24747 - Omega
+for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
+pool_ptr:=str_start[str_ptr]; {erase the string}
+@y
+for k:=str_start(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k]));
+pool_ptr:=str_start(str_ptr); {erase the string}
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/alephdir/omtrans.ch b/Build/source/texk/web2c/alephdir/omtrans.ch
new file mode 100644
index 00000000000..fae0e52b7e6
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omtrans.ch
@@ -0,0 +1,782 @@
+% omtrans.ch: Characters sets for input and output
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [3] m.25 l.767 - Omega Translation
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+@y
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+
+@d no_mode=0
+@d onebyte_mode=1
+@d ebcdic_mode=2
+@d twobyte_mode=3
+@d twobyteLE_mode=4
+
+@d trans_input=0
+@d trans_output=1
+@d trans_default_input=2
+@d trans_default_output=3
+@d trans_no_input=4
+@d trans_no_output=5
+@d trans_no_default_input=6
+@d trans_no_default_output=7
+
+@d mode_input=0
+@d mode_output=1
+@d mode_default_input=2
+@d mode_default_output=3
+@d mode_no_input=4
+@d mode_no_output=5
+@d mode_no_default_input=6
+@d mode_no_default_output=7
+@z
+%---------------------------------------
+@x [3] m.30 l.890 - Omega Translation
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+@y
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+@!term_in_mode:halfword;
+@!term_in_translation:halfword;
+@z
+%---------------------------------------
+@x [3] m.37 l.1065 - Omega Translation
+ if not input_ln(term_in,true) then {this shouldn't happen}
+@y
+ if not new_input_ln(term_in,term_in_mode,term_in_translation,true)
+then {this shouldn't happen}
+@z
+%---------------------------------------
+@x [5] m.54 l. - Omega Translation
+@!log_file : alpha_file; {transcript of \TeX\ session}
+@y
+@!log_file : alpha_file; {transcript of \TeX\ session}
+@!term_out_mode:halfword;
+@!term_out_translation:halfword;
+@z
+%---------------------------------------
+@x [5] m.59 l. - Omega Translation
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+case selector of
+term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin wlog(xchr[s]); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin wterm(xchr[s]); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+othercases write(write_file[selector],xchr[s])
+endcases;@/
+incr(tally);
+exit:end;
+@y
+@d omega_write(#)==case term_out_mode of
+ no_mode: write(#,xchr[s]);
+ onebyte_mode,ebcdic_mode: write(#,xchr[s]);
+ twobyte_mode: begin write(#,xchr[s div @"100]);
+ write(#,xchr[s mod @"100]);
+ end;
+ twobyteLE_mode: begin write(#,xchr[s mod @"100]);
+ write(#,xchr[s div @"100]);
+ end;
+ end
+
+@d omega_file_write(#)==case write_file_mode[#] of
+ no_mode: write(write_file[#],xchr[s]);
+ onebyte_mode,ebcdic_mode: write(write_file[#],xchr[s]);
+ twobyte_mode: begin write(write_file[#],xchr[s div @"100]);
+ write(write_file[#],xchr[s mod @"100]);
+ end;
+ twobyteLE_mode: begin write(write_file[#],xchr[s mod @"100]);
+ write(write_file[#],xchr[s div @"100]);
+ end;
+ end
+
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+case selector of
+term_and_log: begin omega_write(term_out); omega_write(log_file);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin omega_write(log_file); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin omega_write(term_out); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+othercases omega_file_write(selector)
+endcases;@/
+incr(tally);
+exit:end;
+@z
+%---------------------------------------
+@x [5] m.59 l. - Omega Translation
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+@!l:integer; {for printing 16-bit characters}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char;
+ @<Set newline character to -1@>;
+ if s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(s+@'100);
+ end
+ else if s<@"7F then
+ print_char(s)
+ else if s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(s-@'100);
+ end
+ else if s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end;
+ @<Set newline character to nl@>;
+ return;
+ end;
+j:=str_start(s);
+while j<str_start(s+1) do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+exit:end;
+
+@ Control sequence names, file names, and strings constructed with
+\.{\\string} might contain |ASCII_code| values that can't
+be printed using |print_char|. Therefore we use |slow_print| for them:
+
+@<Basic print...@>=
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<=biggest_char) then print(s)
+else begin j:=str_start(s);
+ while j<str_start(s+1) do
+ begin print(so(str_pool[j])); incr(j);
+ end;
+ end;
+end;
+@y
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+@!l:integer; {for printing 16-bit characters}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char;
+ @<Set newline character to -1@>;
+ if s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(s+@'100);
+ end
+ else if s<@"7F then
+ print_char(s)
+ else if s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(s-@'100);
+ end
+ else if s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end;
+ @<Set newline character to nl@>;
+ return;
+ end;
+j:=str_start(s);
+while j<str_start(s+1) do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+exit:end;
+
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+ ((file_offset>0)and(selector>=log_only)) then print_ln;
+print(s);
+end;
+
+procedure overflow_ocp_buf_size; forward;
+procedure overflow_ocp_stack_size; forward;
+
+procedure omega_print(s:str_number);
+var new_s:str_number;
+ om_mode,om_translation:integer;
+ j:integer;
+begin
+om_mode:=no_mode;
+om_translation:=0;
+case selector of
+term_and_log,log_only,term_only: begin
+ om_mode:=term_out_mode;
+ if om_mode<>no_mode then om_translation:=term_out_translation;
+ end;
+no_print,pseudo,new_string: do_nothing;
+othercases begin
+ om_mode:=write_file_mode[selector];
+ if om_mode<>no_mode then om_translation:=write_file_translation[selector];
+ end
+endcases;
+
+if (om_mode=no_mode) or
+ ((om_mode=onebyte_mode) and (om_translation=0)) then
+ begin
+ j:=str_start(s);
+ while j<str_start(s+1) do begin
+ new_s:=so(str_pool[j]);
+ if new_s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(new_s+@'100);
+ end
+ else if new_s<@"7F then
+ print_char(new_s)
+ else if new_s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(new_s-@'100);
+ end
+ else if new_s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((new_s mod @"100) div @"10); print_lc_hex(new_s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(new_s div @"1000);
+ print_lc_hex((new_s mod @"1000) div @"100);
+ print_lc_hex((new_s mod @"100) div @"10);
+ print_lc_hex(new_s mod @"10);
+ end;
+ incr(j);
+ end;
+ end
+else begin
+ if om_translation=0 then begin
+ j:=str_start(s);
+ otp_counter:=1;
+ while j<str_start(s+1) do begin
+ otp_output_buf[otp_counter]:=so(str_pool[j]);
+ incr(otp_counter);
+ incr(j);
+ end;
+ otp_output_end:=otp_counter;
+ end
+ else begin
+ otp_input_start:=0;
+ otp_input_last:=0;
+ otp_stack_used:=0;
+ otp_stack_last:=0;
+ otp_stack_new:=0;
+ otp_output_end:=0;
+ otp_pc:=0;
+ otp_finished:=false;
+ otp_calc_ptr:=0;
+ otp_calcs[otp_calc_ptr]:=0;
+ otp_state_ptr:=0;
+ otp_states[otp_state_ptr]:=0;
+ otp_input_ocp:=om_translation;
+ j:=str_start(s);
+ otp_counter:=1;
+ while j<str_start(s+1) do begin
+ otp_input_buf[otp_counter]:=so(str_pool[j]);
+ incr(otp_counter);
+ incr(j);
+ end;
+ otp_input_end:=otp_counter;
+ while not otp_finished do
+ @<Run the OTP program@>;
+ end;
+ for otp_counter:=1 to (otp_output_end-1) do begin
+ new_s:=otp_output_buf[otp_counter];
+ if (om_mode<twobyte_mode) and (new_s>255) then
+ begin
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(new_s div @"1000);
+ print_lc_hex((new_s mod @"1000) div @"100);
+ print_lc_hex((new_s mod @"100) div @"10);
+ print_lc_hex(new_s mod @"10);
+ end
+ else
+ print_char(new_s);
+ end;
+ end;
+end;
+
+@ Control sequence names, file names, and strings constructed with
+\.{\\string} might contain |ASCII_code| values that can't
+be printed using |print_char|. Therefore we use |slow_print| for them:
+
+@<Basic print...@>=
+procedure slow_print(@!s:integer); {prints string |s|}
+begin if (s>=str_ptr) or (s<=biggest_char) then print(s)
+else omega_print(s);
+end;
+@z
+%---------------------------------------
+@x [5] - Omega Translation
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+ ((file_offset>0)and(selector>=log_only)) then print_ln;
+print(s);
+end;
+@y
+@z
+%---------------------------------------
+@x [5] m.71 l.1694 - Omega Translation
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@y
+if not new_input_ln(term_in,term_in_mode,term_in_translation,true)
+then fatal_error("End of file on the terminal!");
+@z
+%---------------------------------------
+@x [15] m.209 l.4170 - Omega Translation
+@d max_command=ocp_trace_level
+ {the largest command code seen at |big_switch|}
+@y
+@d char_trans=ocp_trace_level+1
+@d char_mode=char_trans+1
+@d max_command=char_mode
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.230 l.4722 - Omega Translation
+@d toks_base=ocp_active_base+max_active_ocp_lists
+ {table of |number_regs| token list registers}
+@y
+@d ocp_input_mode_base=ocp_active_base+max_active_ocp_lists
+@d ocp_input_onebyte_translation_base =ocp_input_mode_base+ 1
+@d ocp_input_ebcdic_translation_base =ocp_input_mode_base+ 2
+@d ocp_input_twobyte_translation_base =ocp_input_mode_base+ 3
+@d ocp_input_twobyteLE_translation_base =ocp_input_mode_base+ 4
+
+@d ocp_output_mode_base =ocp_input_mode_base+ 5
+@d ocp_output_onebyte_translation_base =ocp_input_mode_base+ 6
+@d ocp_output_ebcdic_translation_base =ocp_input_mode_base+ 7
+@d ocp_output_twobyte_translation_base =ocp_input_mode_base+ 8
+@d ocp_output_twobyteLE_translation_base =ocp_input_mode_base+ 9
+
+@d toks_base =ocp_input_mode_base+10
+@z
+%---------------------------------------
+@x [22] m.304 l.6535 - Omega Translation
+@!input_file : array[1..max_in_open] of alpha_file;
+@y
+@!input_file : array[1..max_in_open] of alpha_file;
+@!input_file_mode : array[1..max_in_open] of halfword;
+@!input_file_translation : array[1..max_in_open] of halfword;
+@z
+%---------------------------------------
+@x [23] m.331 l.7066 - Omega Translation
+param_ptr:=0; max_param_stack:=0;
+@y
+param_ptr:=0; max_param_stack:=0;
+geq_define(ocp_input_mode_base,data,1);
+term_in_mode:=equiv(ocp_input_mode_base);
+term_out_mode:=equiv(ocp_input_mode_base);
+if term_in_mode>0
+then term_in_translation:=
+ equiv(ocp_input_onebyte_translation_base+term_in_mode-1);
+if term_out_mode>0
+then term_out_translation:=
+ equiv(ocp_output_onebyte_translation_base+term_in_mode-1);
+@z
+%---------------------------------------
+@x [24] m.362 l.7066 - Omega Translation
+ begin if input_ln(cur_file,true) then {not end of file}
+@y
+ begin if new_input_ln(cur_file,input_file_mode[index],
+ input_file_translation[index],true) then {not end of file}
+@z
+%---------------------------------------
+@x [27] m.480 l.9411 - Omega Translation
+@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
+@y
+@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
+@!read_file_mode:array[0..15] of halfword;
+@!read_file_translation:array[0..15] of halfword;
+@z
+%---------------------------------------
+@x [27] m.485 l.9475 - Omega Translation
+@<Input the first line of |read_file[m]|@>=
+if input_ln(read_file[m],false) then read_open[m]:=normal
+else begin a_close(read_file[m]); read_open[m]:=closed;
+ end
+@y
+@<Input the first line of |read_file[m]|@>=
+begin read_file_mode[m]:=
+ get_file_mode(read_file[m], equiv(ocp_input_mode_base));
+if read_file_mode[m]>0
+then read_file_translation[m]:=
+ equiv(ocp_input_onebyte_translation_base+read_file_mode[m]-1);
+if new_input_ln(read_file[m],read_file_mode[m],
+ read_file_translation[m],false) then read_open[m]:=normal
+else begin a_close(read_file[m]); read_open[m]:=closed;
+ end
+end
+@z
+%---------------------------------------
+@x [27] m.486 l.9484 - Omega Translation
+begin if not input_ln(read_file[m],true) then
+ begin a_close(read_file[m]); read_open[m]:=closed;
+@y
+begin if not new_input_ln(read_file[m],
+read_file_mode[m],read_file_translation[m],true) then
+ begin a_close(read_file[m]); read_open[m]:=closed;
+@z
+%---------------------------------------
+@x [29] m.538 l.10371 - Omega Translation
+begin line:=1;
+if input_ln(cur_file,false) then do_nothing;
+@y
+begin line:=1;
+input_file_mode[index]:=
+ get_file_mode(cur_file, equiv(ocp_input_mode_base));
+if input_file_mode[index]>0
+then input_file_translation[index]:=
+ equiv(ocp_input_onebyte_translation_base+input_file_mode[index]-1);
+if new_input_ln(cur_file,input_file_mode[index],
+ input_file_translation[index],false) then do_nothing;
+@z
+%---------------------------------------
+@x [49] m.1210 l.22629 - Omega Translation
+any_mode(ocp_trace_level) : prefixed_command;
+@y
+any_mode(ocp_trace_level) : prefixed_command;
+any_mode(char_mode) : do_char_mode;
+any_mode(char_trans) : do_char_translation;
+@z
+%---------------------------------------
+@x [49] m.1343 l.24928 - Omega Translation
+@!write_file:array[0..15] of alpha_file;
+@y
+@!write_file:array[0..15] of alpha_file;
+@!write_file_mode:array[0..15] of halfword;
+@!write_file_translation:array[0..15] of halfword;
+@z
+%---------------------------------------
+@x
+@* \[54] $\Omega$ changes.
+
+@y
+@* \[54] $\Omega$ changes.
+
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Input Translation Processes.
+
+@ @<Put each...@>=
+primitive("InputTranslation", char_trans, trans_input);
+primitive("OutputTranslation", char_trans, trans_output);
+primitive("DefaultInputTranslation", char_trans, trans_default_input);
+primitive("DefaultOutputTranslation", char_trans, trans_default_output);
+primitive("noInputTranslation", char_trans, trans_no_input);
+primitive("noOutputTranslation", char_trans, trans_no_output);
+primitive("noDefaultInputTranslation", char_trans, trans_no_default_input);
+primitive("noDefaultOutputTranslation", char_trans, trans_no_default_output);
+primitive("InputMode", char_mode, mode_input);
+primitive("OutputMode", char_mode, mode_output);
+primitive("DefaultInputMode", char_mode, mode_default_input);
+primitive("DefaultOutputMode", char_mode, mode_default_output);
+primitive("noInputMode", char_mode, mode_no_input);
+primitive("noOutputMode", char_mode, mode_no_output);
+primitive("noDefaultInputMode", char_mode, mode_no_default_input);
+primitive("noDefaultOutputMode", char_mode, mode_no_default_output);
+
+geq_define(ocp_input_onebyte_translation_base, data, 0);
+geq_define(ocp_input_ebcdic_translation_base, data, 0);
+geq_define(ocp_input_twobyte_translation_base, data, 0);
+geq_define(ocp_input_twobyteLE_translation_base, data, 0);
+geq_define(ocp_input_mode_base, data, 0);
+
+geq_define(ocp_output_onebyte_translation_base, data, 0);
+geq_define(ocp_output_ebcdic_translation_base, data, 0);
+geq_define(ocp_output_twobyte_translation_base, data, 0);
+geq_define(ocp_output_twobyteLE_translation_base, data, 0);
+geq_define(ocp_output_mode_base, data, 0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+char_trans:
+ case chr_code of
+ trans_input: print_esc("InputTranslation");
+ trans_output: print_esc("OutputTranslation");
+ trans_default_input: print_esc("DefaultInputTranslation");
+ trans_default_output: print_esc("DefaultOutputTranslation");
+ trans_no_input: print_esc("noInputTranslation");
+ trans_no_output: print_esc("noOutputTranslation");
+ trans_no_default_input: print_esc("noDefaultInputTranslation");
+ trans_no_default_output: print_esc("noDefaultOutputTranslation");
+ end;
+char_mode:
+ case chr_code of
+ mode_input: print_esc("InputMode");
+ mode_output: print_esc("OutputMode");
+ mode_default_input: print_esc("DefaultInputMode");
+ mode_default_output: print_esc("DefaultOutputMode");
+ mode_no_input: print_esc("noInputMode");
+ mode_no_output: print_esc("noOutputMode");
+ mode_no_default_input: print_esc("noDefaultInputMode");
+ mode_no_default_output: print_esc("noDefaultOutputMode");
+ end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure scan_file_referrent;
+begin
+if scan_keyword("currentfile") then cur_val:=max_halfword
+else scan_int;
+end;
+
+procedure scan_mode;
+begin
+if scan_keyword("onebyte") then cur_val:=onebyte_mode
+else if scan_keyword("ebcdic") then cur_val:=ebcdic_mode
+else if scan_keyword("twobyte") then cur_val:=twobyte_mode
+else if scan_keyword("twobyteLE") then cur_val:=twobyteLE_mode
+else begin print_err("Invalid input mode"); cur_val:=0; end;
+end;
+
+procedure do_char_translation;
+var kind:halfword;
+ fileref:halfword;
+ moderef:halfword;
+ ocpref:halfword;
+begin
+fileref:=0;
+moderef:=0;
+ocpref:=0;
+kind:=cur_chr;
+if (kind mod 4) <= 1 then begin
+ scan_file_referrent;
+ fileref:=cur_val;
+ end
+else begin
+ scan_mode;
+ moderef:=cur_val;
+ end;
+if kind < 4 then begin
+ scan_ocp_ident;
+ ocpref:=cur_val;
+ end;
+case (kind mod 4) of
+ trans_input: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ read_file_translation[fileref]:=ocpref;
+ end
+ else if fileref<>max_halfword then begin
+ term_in_translation:=ocpref;
+ end
+ else begin
+ base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ while state = token_list do
+ begin
+ decr(base_ptr);
+ cur_input:=input_stack[base_ptr];
+ end;
+ if name>17 then input_file_translation[index]:=ocpref;
+ cur_input:=input_stack[input_ptr];
+ end;
+ end;
+ trans_output: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ write_file_translation[fileref]:=ocpref;
+ end
+ else begin
+ term_out_translation:=ocpref;
+ end;
+ end;
+ trans_default_input: begin
+ geq_define(ocp_input_mode_base+moderef,data,ocpref);
+ end;
+ trans_default_output: begin
+ geq_define(ocp_output_mode_base+moderef,data,ocpref);
+ end;
+ end;
+end;
+
+procedure do_char_mode;
+var kind:halfword;
+ fileref:halfword;
+ moderef:halfword;
+begin
+fileref:=0;
+moderef:=0;
+kind:=cur_chr;
+if (kind mod 4) <= 1 then begin
+ scan_file_referrent;
+ fileref:=cur_val;
+ end;
+if kind < 4 then begin
+ scan_mode;
+ moderef:=cur_val;
+ end;
+case (kind mod 4) of
+ trans_input: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ read_file_mode[fileref]:=moderef;
+ end
+ else if fileref<>max_halfword then begin
+ term_in_mode:=moderef;
+ end
+ else begin
+ base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ while state = token_list do
+ begin
+ decr(base_ptr);
+ cur_input:=input_stack[base_ptr];
+ end;
+ if name>17 then input_file_mode[index]:=moderef;
+ cur_input:=input_stack[input_ptr];
+ end;
+ end;
+ trans_output: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ write_file_mode[fileref]:=moderef;
+ end
+ else begin
+ term_out_mode:=moderef;
+ end;
+ end;
+ trans_default_input: begin
+ geq_define(ocp_input_mode_base,data,moderef);
+ end;
+ trans_default_output: begin
+ geq_define(ocp_output_mode_base,data,moderef);
+ end;
+ end;
+end;
+
+function p_new_input_ln(f:alpha_file;
+the_mode,translation:halfword;
+bypass_eoln:boolean):boolean;
+begin
+if (the_mode=no_mode) or ((the_mode=onebyte_mode) and (translation=0))
+then p_new_input_ln:=input_ln(f,bypass_eoln)
+else if not newinputline(f,the_mode,bypass_eoln)
+then p_new_input_ln:=false
+else if translation=0 then
+begin
+ if (first+otp_input_end)>=buf_size then overflow("buffer size", buf_size);
+ state:=new_line;
+ start:=first;
+ last:=start;
+ loc:=start;
+ for otp_counter:=1 to otp_input_end do
+ begin
+ buffer[last]:=otp_input_buf[otp_counter];
+ incr(last);
+ end;
+ while buffer[last-1]=' ' do decr(last);
+ limit:=last-1;
+ p_new_input_ln:=true
+end
+else
+begin
+ otp_input_start:=0;
+ otp_input_last:=0;
+ otp_stack_used:=0;
+ otp_stack_last:=0;
+ otp_stack_new:=0;
+ otp_output_end:=0;
+ otp_pc:=0;
+ otp_finished:=false;
+ otp_calc_ptr:=0;
+ otp_calcs[otp_calc_ptr]:=0;
+ otp_state_ptr:=0;
+ otp_states[otp_state_ptr]:=0;
+ otp_input_ocp:=translation;
+ while not otp_finished do
+ @<Run the OTP program@>;
+ if (first+otp_output_end)>=buf_size then overflow("buffer size", buf_size);
+ state:=new_line;
+ start:=first;
+ last:=start;
+ loc:=start;
+ for otp_counter:=1 to otp_output_end do
+ begin
+ buffer[last]:=otp_output_buf[otp_counter];
+ incr(last);
+ end;
+ while buffer[last-1]=' ' do decr(last);
+ limit:=last-1;
+ p_new_input_ln:=true
+end
+end;
+
+
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/alephdir/omxml.ch b/Build/source/texk/web2c/alephdir/omxml.ch
new file mode 100644
index 00000000000..4d47a3a55a0
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omxml.ch
@@ -0,0 +1,1975 @@
+% omxml.ch: Generate XML, MathML, HTML, etc.
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.392 - Omega
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@y
+@!font_sort_max=65535; {maximum internal font sort number}
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@z
+%---------------------------------------
+@x [1] m.12 l.437 - Omega
+@d number_fonts=font_biggest-font_base+2
+@y
+@d number_fonts=font_biggest-font_base+2
+@d font_sort_base=0
+@d font_sort_biggest=65535 {the biggest font sort}
+@d number_font_sorts=font_sort_biggest-font_sort_base+2
+@z
+%---------------------------------------
+@x [5] m.57 l.1446 - Omega
+othercases write_ln(write_file[selector])
+@y
+othercases if selector>max_selector then
+ write_ln(output_files[selector-max_selector])
+ else
+ write_ln(write_file[selector])
+@z
+%---------------------------------------
+@x [5] m.58 l.1465 - Omega
+othercases omega_file_write(selector)
+@y
+othercases if selector>max_selector then
+ write(output_files[selector-max_selector],xchr[s])
+ else
+ omega_file_write(selector)
+@z
+%---------------------------------------
+@x [10] m.160 l.3270 - Omega
+@ In fact, there are still more types coming. When we get to math formula
+processing we will see that a |style_node| has |type=14|; and a number
+of larger type codes will also be defined, for use in math mode only.
+@y
+@ In fact, there are still more types coming. When we get to math formula
+processing we will see that a |style_node| has |type=14|; and a number
+of larger type codes will also be defined, for use in math mode only.
+
+@d sgml_text_node=0
+@d sgml_math_node=1
+
+@d sgml_node=unset_node+1 {|type| for an SGML node}
+@d sgml_node_size=5
+@d sgml_tag(#)==mem[#+1].int
+@d sgml_attrs(#)==mem[#+2].int
+@d sgml_singleton(#)==info(#+3)
+@d sgml_info(#)==link(#+3)
+@d sgml_kind(#)==mem[#+4].int
+
+@d sgml_attr_node=unset_node+2 {|type| for an SGML attribute node}
+@d sgml_attr_node_size=4
+
+@d sgml_entity_node=unset_node+3 {|type| for an SGML entity node}
+@d sgml_entity_node_size=2
+@d sgml_entity_string(#)==mem[#+1].int
+
+@d biggest_ordinary_node=sgml_entity_node
+
+@p
+function new_sgml_node:pointer;
+var p:pointer;
+begin p:=get_node(sgml_node_size);
+type(p):=sgml_node;
+sgml_tag(p):=0;
+sgml_attrs(p):=0;
+sgml_info(p):=0;
+sgml_singleton(p):=0;
+sgml_kind(p):=0;
+new_sgml_node:=p;
+end;
+
+function new_sgml_attr_node:pointer;
+var p:pointer;
+begin p:=get_node(sgml_attr_node_size);
+type(p):=sgml_attr_node;
+sgml_tag(p):=0;
+sgml_attrs(p):=0;
+sgml_info(p):=0;
+sgml_singleton(p):=0;
+new_sgml_attr_node:=p;
+end;
+
+function new_sgml_entity_node:pointer;
+var p:pointer;
+begin p:=get_node(sgml_entity_node_size);
+type(p):=sgml_entity_node;
+sgml_entity_string(p):=0;
+new_sgml_entity_node:=p;
+end;
+@z
+%---------------------------------------
+@x [12] m.174 l.3520 - Omega
+@p procedure short_display(@!p:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+begin while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ print_ASCII(qo(character(p)));
+@y
+@p procedure short_display(@!p:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+ fsort:integer;
+begin while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ if not SGML_show_entities then
+ print_ASCII(qo(character(p)))
+ else begin
+ fsort:=font_name_sort(font(p));
+ if fsort<>0 then begin
+ if (font_sort_char_entity(fsort)(character(p))<>0) then
+ slow_print(font_sort_char_entity(fsort)(character(p)))
+ else
+ print_ASCII(qo(character(p)));
+ end
+ else
+ print_ASCII(qo(character(p)));
+ end;
+@z
+%---------------------------------------
+@x [12] m.176 l.3563 - Omega
+@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); print_ASCII(qo(character(p)));
+ end;
+end;
+@y
+@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+var fsort:integer;
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" ");
+ if not SGML_show_entities then
+ print_ASCII(qo(character(p)))
+ else begin
+ fsort:=font_name_sort(font(p));
+ if fsort<>0 then begin
+ if (font_sort_char_entity(fsort)(character(p))<>0) then
+ print(font_sort_char_entity(fsort)(character(p)))
+ else
+ print_ASCII(qo(character(p)));
+ end
+ else
+ print_ASCII(qo(character(p)));
+ end;
+ end;
+end;
+@z
+%---------------------------------------
+@x [13] m.202 l.3928 - Omega
+ adjust_node: flush_node_list(adjust_ptr(p));
+@y
+ adjust_node: flush_node_list(adjust_ptr(p));
+ sgml_node: begin
+ if sgml_tag(p)<>0 then flush_node_list(sgml_attrs(p));
+ free_node(p,sgml_node_size); goto done;
+ end;
+ sgml_attr_node: begin
+ free_node(p,sgml_attr_node_size); goto done;
+ end;
+ sgml_entity_node: begin
+ free_node(p,sgml_entity_node_size); goto done;
+ end;
+@z
+%---------------------------------------
+@x [15] m.209 l.4138 - Omega
+@d max_command=char_mode
+ {the largest command code seen at |big_switch|}
+@y
+@d set_show_sgml_entities=char_mode+1
+ {printing hex code or SGML-like entity during \.{\\showbox}}
+@d set_mml_mode=set_show_sgml_entities+1
+ {for entering or leaving MML mode ( \.{\\mmlmode}~)}
+@d mml_tag=set_mml_mode+1
+ {for various SGML tags}
+@d max_command=mml_tag
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+ @!pg_field,@!ml_field: integer;@+
+@y
+ @!pg_field,@!ml_field: integer;@+
+ @!sgml_field: integer;
+ @!sgml_attr_field: pointer;
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@y
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@d current_sgml_tag==cur_list.sgml_field {current SGML tag}
+@d current_sgml_attrs==cur_list.sgml_attr_field {current SGML tag}
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+prev_graf:=0; shown_mode:=0;
+@y
+prev_graf:=0; shown_mode:=0;
+current_sgml_tag:=0; current_sgml_attrs:=null;
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+current_sgml_tag:=0; current_sgml_attrs:=null;
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+@p procedure pop_nest; {leave a semantic level, re-enter the old}
+begin
+if local_par<>null then begin
+ if local_par_bool then begin end {tail_append(local_par)}
+ else free_node(local_par,local_par_size);
+ end;
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+end;
+@y
+@p procedure pop_nest; {leave a semantic level, re-enter the old}
+var attrs:pointer;
+ {p:pointer;}
+begin attrs:=null;
+if local_par<>null then begin
+ if local_par_bool then begin end {tail_append(local_par)}
+ else free_node(local_par,local_par_size);
+ end;
+{
+if current_sgml_attrs<>null then
+ if current_sgml_tag=null then
+ attrs:=current_sgml_attrs
+ else
+ free_avail(current_sgml_attrs);
+}
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+{
+if attrs<>null then begin
+ p:=attrs;
+ while link(p)<>null do
+ begin
+ p:=link(p);
+ end;
+ link(p):=current_sgml_attrs;
+ current_sgml_attrs:=attrs;
+ end;
+}
+end;
+@z
+%---------------------------------------
+@x [17] m.222 l.4525 - Omega
+@d frozen_null_ocp=frozen_null_font+number_fonts
+@y
+@d frozen_null_font_sort=frozen_null_font+number_font_sorts {permanent null sort}
+@d frozen_null_ocp=frozen_null_font_sort+number_font_sorts
+@z
+%---------------------------------------
+@x [17] m.232 l.4802 - Omega
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+@y
+@d null_font_sort==font_sort_base
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+@z
+%---------------------------------------
+@x [19] m.269 l.5859 - Omega
+@d math_left_group=16 {code for `\.{\\left...\\right}'}
+@d local_box_group=17 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=17
+@y
+@d math_left_group=16 {code for `\.{\\left...\\right}'}
+@d math_mml_group=17 {code for automatic `\.{\\left...\\right}'}
+@d text_mml_group=18 {code for `\.{\\text...}'}
+@d text_sgml_group=19 {code for SGML tags}
+@d font_entity_group=20
+@d empty_tag_group=21
+@d lone_tag_group=22
+@d local_box_group=23 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=23
+@z
+%---------------------------------------
+@x [29] m.532 l.10260 - Omega
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d ensure_dvi_open==if output_file_name=0 then
+ begin if job_name=0 then open_log_file;
+ pack_job_name(".dvi");
+ while not b_open_out(dvi_file) do
+ prompt_file_name("file name for output",".dvi");
+ output_file_name:=b_make_name_string(dvi_file);
+ end
+
+@<Glob...@>=
+@!dvi_file: byte_file; {the device-independent output goes here}
+@!output_file_name: str_number; {full name of the output file}
+@!log_name:str_number; {full name of the log file}
+@y
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d ensure_output_open_end(#)==while not b_open_out(#) do
+ prompt_file_name("file name for output",output_m_suffix);
+ output_m_name:=b_make_name_string(#);
+ end end
+
+@d ensure_output_open_middle(#)==output_m_name:=#; if #=0 then
+ begin if job_name=0 then open_log_file;
+ pack_job_name(output_m_suffix);
+ ensure_output_open_end
+
+@d ensure_output_open(#)==begin output_m_suffix:=#; ensure_output_open_middle
+
+@d ensure_dvi_open==begin
+ ensure_output_open(".dvi")(output_file_name)(dvi_file);
+ output_file_name:=output_m_name end
+
+@<Glob...@>=
+@!dvi_file: byte_file; {the device-independent output goes here}
+@!output_file_name: str_number; {full name of the dvi output file}
+@!output_m_suffix: str_number; {suffix for the current output file}
+@!output_m_name: str_number; {suffix for the current output file}
+@!output_file_names:array[1..10] of str_number;
+@!output_files:array[1..10] of byte_file;
+@!output_file_no:integer; {number of open output files}
+@!log_name:str_number; {full name of the log file}
+@z
+%---------------------------------------
+@x [29] m.533 l.10260 - Omega
+@ @<Initialize the output...@>=output_file_name:=0;
+@y
+@ @<Initialize the output...@>=output_file_name:=0;
+for output_file_no:=1 to 10 do output_file_names[output_file_no]:=0;
+output_file_no:=0;
+@z
+%---------------------------------------
+@x [30] m.549 l.10686 - Omega
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@y
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_sort_ptr:integer; {largest internal font sort number in use}
+@z
+%---------------------------------------
+@x [30] m.550 l.10723 - Omega
+@d param_base(#)==font_info(#)(offset_param_base).int
+@y
+@d param_base(#)==font_info(#)(offset_param_base).int
+
+@d font_sort_info_end(#)==#]
+@d font_sort_info(#)==font_sort_tables[#,font_sort_info_end
+@d font_sort_offset_file_size=0
+@d font_sort_offset_name=font_sort_offset_file_size+1
+@d font_sort_offset_bc=font_sort_offset_name+1
+@d font_sort_offset_ec=font_sort_offset_bc+1
+@d font_sort_offset_char_base=font_sort_offset_bc+1
+@d font_sort_file_size(#)==font_sort_info(#)(font_sort_offset_file_size).int
+@d font_sort_name(#)==font_sort_info(#)(font_sort_offset_name).int
+@d font_sort_bc(#)==font_sort_info(#)(font_sort_offset_bc).int
+@d font_sort_ec(#)==font_sort_info(#)(font_sort_offset_ec).int
+@d font_sort_char_base(#)==font_sort_info(#)(font_sort_offset_char_base).int
+@d font_sort_char_entity_end(#)==#*3].int
+@d font_sort_char_entity(#)==
+ font_sort_tables[#,font_sort_offset_char_base+font_sort_char_entity_end
+@d font_sort_char_tag_end(#)==#*3+1].int
+@d font_sort_char_tag(#)==
+ font_sort_tables[#,font_sort_offset_char_base+font_sort_char_tag_end
+@d font_sort_char_attr_end(#)==#*3+2].int
+@d font_sort_char_attr(#)==
+ font_sort_tables[#,font_sort_offset_char_base+font_sort_char_attr_end
+@z
+%---------------------------------------
+@x [30] m.550 l.10723 - Omega
+@!dimen_font:integer;
+@y
+@!dimen_font:integer;
+@!font_sorts:integer; {to run through font sorts}
+@!font_sort_c:integer; {character used to define font entities}
+@!font_sort_number:integer; {this particular font sort number}
+@z
+%---------------------------------------
+@x [30] m.552 l.10749 - Omega
+for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
+@y
+for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
+font_sort_ptr:=null_font_sort;
+allocate_font_sort_table(null_font_sort,font_sort_offset_char_base);
+font_sort_file_size(null_font_sort):=font_sort_offset_char_base;
+font_sort_name(null_font_sort):="nullfontsort";
+@z
+%---------------------------------------
+@x [32] m.638 l.12656 - Omega
+@<Ship box |p| out@>;
+@y
+if not MML_mode then begin @<Ship box |p| out@>; end;
+@z
+%---------------------------------------
+@x [34] m.682 l.13395 - Omega
+@d ord_noad=unset_node+3 {|type| of a noad classified Ord}
+@y
+@d ord_noad=biggest_ordinary_node+3 {|type| of a noad classified Ord}
+@z
+%---------------------------------------
+@x [34] m.688 l.13515 - Omega
+@d style_node=unset_node+1 {|type| of a style node}
+@y
+@d style_node=biggest_ordinary_node+1 {|type| of a style node}
+@z
+%---------------------------------------
+@x [34] m.688 l.13515 - Omega
+@d choice_node=unset_node+2 {|type| of a choice node}
+@y
+@d choice_node=biggest_ordinary_node+2 {|type| of a choice node}
+@z
+%---------------------------------------
+@x [46] m.1030
+hmode+spacer: if space_factor=1000 then goto append_normal_space
+ else app_space;
+hmode+ex_space,mmode+ex_space: goto append_normal_space;
+@y
+hmode+spacer:
+ if MML_mode then begin
+ make_sgml_entity(" ");
+ goto big_switch;
+ end
+ else if space_factor=1000 then goto append_normal_space
+ else app_space;
+hmode+ex_space,mmode+ex_space: goto append_normal_space;
+@z
+%---------------------------------------
+@x [47] m.1060 l.20533 - Omega
+procedure append_glue;
+var s:small_number; {modifier of skip command}
+begin s:=cur_chr;
+case s of
+fil_code: cur_val:=fil_glue;
+fill_code: cur_val:=fill_glue;
+ss_code: cur_val:=ss_glue;
+fil_neg_code: cur_val:=fil_neg_glue;
+skip_code: scan_glue(glue_val);
+mskip_code: scan_glue(mu_val);
+end; {now |cur_val| points to the glue specification}
+tail_append(new_glue(cur_val));
+if s>=skip_code then
+ begin decr(glue_ref_count(cur_val));
+ if s>skip_code then subtype(tail):=mu_glue;
+ end;
+end;
+@y
+procedure append_glue;
+var s:small_number; {modifier of skip command}
+begin s:=cur_chr;
+case s of
+fil_code: cur_val:=fil_glue;
+fill_code: cur_val:=fill_glue;
+ss_code: cur_val:=ss_glue;
+fil_neg_code: cur_val:=fil_neg_glue;
+skip_code: scan_glue(glue_val);
+mskip_code: scan_glue(mu_val);
+end; {now |cur_val| points to the glue specification}
+if (abs(mode)=mmode) and MML_mode then begin
+ end
+else begin
+ tail_append(new_glue(cur_val));
+ if s>=skip_code then
+ begin decr(glue_ref_count(cur_val));
+ if s>skip_code then subtype(tail):=mu_glue;
+ end;
+ end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1061 l.20339 - Omega
+procedure append_kern;
+var s:quarterword; {|subtype| of the kern node}
+begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
+tail_append(new_kern(cur_val)); subtype(tail):=s;
+end;
+@y
+procedure append_kern;
+var s:quarterword; {|subtype| of the kern node}
+begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
+if (abs(mode)=mmode) and MML_mode then begin
+ end
+else begin
+ tail_append(new_kern(cur_val)); subtype(tail):=s;
+ end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1073 l.20795 - Omega
+vmode+hmove,hmode+vmove,mmode+vmove: begin t:=cur_chr;
+ scan_normal_dimen;
+ if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
+ end;
+any_mode(leader_ship): scan_box(leader_flag-a_leaders+cur_chr);
+any_mode(make_box): begin_box(0);
+@y
+vmode+hmove,hmode+vmove,mmode+vmove: begin
+ if abs(mode)=mmode and MML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_cmd_chr(cur_cmd,cur_chr); print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end
+ else begin
+ t:=cur_chr; scan_normal_dimen;
+ if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
+ end;
+ end;
+any_mode(leader_ship): begin
+ if abs(mode)=mmode and MML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_cmd_chr(cur_cmd,cur_chr); print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end
+ else
+ scan_box(leader_flag-a_leaders+cur_chr);
+ end;
+any_mode(make_box): begin
+ if abs(mode)=mmode and MML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_cmd_chr(cur_cmd,cur_chr); print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end
+ else
+ begin_box(0);
+ end;
+@z
+%---------------------------------------
+@x [47] m. l.21055 - Omega
+procedure new_graf(@!indented:boolean);
+var p,q,dir_graf_tmp:pointer;
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+q:=tail;
+dir_rover:=text_dir_ptr;
+while dir_rover<>null do
+ begin
+ if (link(dir_rover)<>null) or (dir_dir(dir_rover)<>par_direction) then
+ begin
+ dir_graf_tmp:=new_dir(dir_dir(dir_rover));
+ link(dir_graf_tmp):=link(q); link(q):=dir_graf_tmp;
+ end;
+ dir_rover:=link(dir_rover);
+ end;
+q:=head;
+while link(q)<>null do q:=link(q);
+tail:=q;
+if every_par<>null then begin_token_list(every_par,every_par_text);
+if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
+end;
+@y
+procedure sgml_start_graf; forward;
+
+procedure new_graf(@!indented:boolean);
+var p,q,dir_graf_tmp:pointer;
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+{if MML_mode then begin
+ sgml_start_graf
+ end
+else} begin
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+q:=tail;
+dir_rover:=text_dir_ptr;
+while dir_rover<>null do
+ begin
+ if (link(dir_rover)<>null) or (dir_dir(dir_rover)<>par_direction) then
+ begin
+ dir_graf_tmp:=new_dir(dir_dir(dir_rover));
+ link(dir_graf_tmp):=link(q); link(q):=dir_graf_tmp;
+ end;
+ dir_rover:=link(dir_rover);
+ end;
+q:=head;
+while link(q)<>null do q:=link(q);
+tail:=q;
+if every_par<>null then begin_token_list(every_par,every_par_text);
+if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
+end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1100 l.21156 - Omega
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+ else line_break(widow_penalty);
+ if dir_save<>null then
+ begin flush_node_list(dir_save); dir_save:=null;
+ end;
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@y
+procedure sgml_end_graf; forward;
+
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+ {else if MML_mode then begin sgml_end_graf end}
+ else line_break(widow_penalty);
+ if dir_save<>null then
+ begin flush_node_list(dir_save); dir_save:=null;
+ end;
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1130 l.21562 - Omega
+vmode+halign,hmode+valign:init_align;
+mmode+halign: if privileged then
+ if cur_group=math_shift_group then init_align
+ else off_save;
+vmode+endv,hmode+endv: do_endv;
+@y
+vmode+halign,hmode+valign:init_align;
+mmode+halign: if MML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_esc("halign"); print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end
+ else begin
+ if privileged then
+ if cur_group=math_shift_group then init_align
+ else off_save;
+ end;
+vmode+endv,hmode+endv: do_endv;
+@z
+%---------------------------------------
+@x [48] m.1136 l.21605 - Omega
+@* \[48] Building math lists.
+The routines that \TeX\ uses to create mlists are similar to those we have
+just seen for the generation of hlists and vlists. But it is necessary to
+make ``noads'' as well as nodes, so the reader should review the
+discussion of math mode data structures before trying to make sense out of
+the following program.
+
+Here is a little routine that needs to be done whenever a subformula
+is about to be processed. The parameter is a code like |math_group|.
+
+@<Declare act...@>=
+procedure push_math(@!c:group_code);
+begin
+if math_direction<>text_direction then dir_math_save:=true;
+push_nest; mode:=-mmode; incompleat_noad:=null;
+@<DIR: |new_save_level| math@>;
+end;
+@y
+@* \[48] Building math lists.
+The routines that \TeX\ uses to create mlists are similar to those we have
+just seen for the generation of hlists and vlists. But it is necessary to
+make ``noads'' as well as nodes, so the reader should review the
+discussion of math mode data structures before trying to make sense out of
+the following program.
+
+Here is a little routine that needs to be done whenever a subformula
+is about to be processed. The parameter is a code like |math_group|.
+
+@<Glob...@>=
+@!MML_mode:boolean;
+@!SGML_show_entities:boolean;
+@!MML_level:integer;
+@!mml_file_no:integer; {the \.{MML} output file}
+@!mml_indent:integer;
+@!mml_depth_level:integer;
+@!mml_last_print_char:boolean;
+
+@ @<Set init...@>=
+MML_mode:=false;
+SGML_show_entities:=true;
+MML_level:=0;
+mml_indent:=0;
+mml_file_no:=0;
+mml_depth_level:=0;
+mml_last_print_char:=false;
+
+@
+
+@d sgml_out_pointer(#)==
+ case math_type(#(p)) of
+ math_char: begin
+ fetch(#(p));
+ fsort:=font_name_sort(cur_f);
+ if char_exists(cur_i) then begin
+ if (font_sort_char_tag(fsort)(cur_c)<>0) then begin
+ if not inside_mop then begin
+ for i:=1 to mml_indent do print(" ");
+ print("<"); print(font_sort_char_tag(fsort)(cur_c));
+ if (font_sort_char_attr(fsort)(cur_c)<>null) then begin
+ sgml_attrs_out(font_sort_char_attr(fsort)(cur_c));
+ end;
+ print("> ");
+ end;
+ if (font_sort_char_entity(fsort)(cur_c)<>0) then begin
+ print(font_sort_char_entity(fsort)(cur_c));
+ end;
+ if not inside_mop then begin
+ print(" </"); print(font_sort_char_tag(fsort)(cur_c));
+ print(">"); print(new_line_char);
+ back_at_bol:=true;
+ end;
+ end;
+ end;
+ end;
+ sub_mlist: begin
+ case type(p) of
+ op_noad,bin_noad,rel_noad,
+ open_noad,close_noad,punct_noad,inner_noad: begin
+ for i:=1 to mml_indent do print(" ");
+ print("<mo");
+ if (type(p)=op_noad) and (subtype(p)=limits) then begin
+ print(" limits=""true""");
+ end
+ else if (type(p)=op_noad) and (subtype(p)=no_limits) then begin
+ print(" limits=""false""");
+ end;
+ print("> ");
+ q:=p; cur_mlist:=info(#(p));
+ if link(cur_mlist)=null then
+ if type(cur_mlist)=sgml_node then
+ if str_eq_str(sgml_tag(cur_mlist),"mrow") then
+ cur_mlist:=sgml_info(cur_mlist);
+ sgml_out_mlist(false,false,true); p:=q;
+ print(" </mo>");
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ othercases begin
+ q:=p; cur_mlist:=info(#(p));
+ sgml_out_mlist(false,false,false); p:=q;
+ end
+ endcases;
+ end;
+ othercases begin
+ for i:=1 to mml_indent do print(" ");
+ print("<merror> Unrecognized math stuff </merror>");
+ print(new_line_char);
+ end
+ endcases;
+
+@<Declare act...@>=
+procedure push_math(@!c:group_code);
+begin
+if math_direction<>text_direction then dir_math_save:=true;
+push_nest; mode:=-mmode; incompleat_noad:=null;
+@<DIR: |new_save_level| math@>;
+end;
+
+function sgml_out_on_one_line(p:pointer):boolean;
+begin
+if (sgml_tag(p)="mi") or (sgml_tag(p)="mo") or (sgml_tag(p)="mn") then
+ sgml_out_on_one_line:=true
+else sgml_out_on_one_line:=false;
+end;
+
+procedure sgml_attrs_out(p:pointer);
+var q:pointer;
+begin
+q:=p;
+while q<>null do begin
+ print(" ");
+ print(sgml_tag(q)); print("=""");
+ print(sgml_attrs(q)); print("""");
+ q:=link(q);
+ end;
+end;
+
+procedure sgml_out_mlist(break_line,inside_text,inside_mop:boolean);
+var p,q:pointer;
+ old_selector:integer;
+ i,fsort:integer;
+ back_at_bol:boolean;
+ first_inside_text:boolean;
+begin
+old_selector:=selector;
+selector:=max_selector+mml_file_no;
+p:=cur_mlist;
+back_at_bol:=false;
+first_inside_text:=inside_text;
+while p<>null do begin
+ if is_char_node(p) then begin
+ fsort:=font_name_sort(font(p));
+ if (font_sort_char_entity(fsort)(character(p))<>0) then begin
+ if back_at_bol then
+ for i:=1 to mml_indent do print(" ");
+ print(font_sort_char_entity(fsort)(character(p)));
+ back_at_bol:=false;
+ mml_last_print_char:=true;
+ first_inside_text:=false;
+ end;
+ end
+ else begin
+ case type(p) of
+ hlist_node,vlist_node,rule_node,
+ ins_node,mark_node,adjust_node: do_nothing;
+ ligature_node: begin
+ fsort:=font_name_sort(font(lig_char(p)));
+ if (font_sort_char_entity(fsort)(character(lig_char(p)))<>0) then begin
+ if back_at_bol then
+ for i:=1 to mml_indent do print(" ");
+ print(font_sort_char_entity(fsort)(character(lig_char(p))));
+ back_at_bol:=false;
+ end;
+ mml_last_print_char:=false;
+ first_inside_text:=false;
+ end;
+ disc_node,whatsit_node,math_node,glue_node,
+ kern_node,penalty_node,unset_node: do_nothing;
+ sgml_node: begin
+ if sgml_tag(p)=0 then begin
+ print(sgml_attrs(p));
+ end
+ else if sgml_singleton(p)>=1 then begin
+ if not (first_inside_text) then begin
+ if inside_text then print(new_line_char);
+ for i:=1 to mml_indent do print(" ");
+ end;
+ print("<"); print(sgml_tag(p));
+ sgml_attrs_out(sgml_attrs(p));
+ if sgml_singleton(p)=1 then print("/");
+ print(">");
+ print(new_line_char);
+ back_at_bol:=true;
+ end
+ else begin
+ if not (first_inside_text) then begin
+ if inside_text and not(back_at_bol) then print(new_line_char);
+ for i:=1 to mml_indent do print(" ");
+ end;
+ print("<"); print(sgml_tag(p));
+ sgml_attrs_out(sgml_attrs(p)); print(">");
+ if sgml_out_on_one_line(p) then
+ print(" ")
+ else begin mml_indent:=mml_indent+1;
+ print(new_line_char);
+ end;
+ cur_mlist:=sgml_info(p);
+ if cur_mlist<>null then begin
+ if (sgml_kind(p)=sgml_text_node) or
+ (sgml_tag(p)="mtext") then begin
+ for i:=1 to mml_indent do print(" ");
+ sgml_out_mlist(false,true,false);
+ if mml_last_print_char then print(new_line_char);
+ end
+ else sgml_out_mlist(false,false,false);
+ end;
+ if sgml_out_on_one_line(p) then
+ print(" ")
+ else begin
+ mml_indent:=mml_indent-1;
+ for i:=1 to mml_indent do print(" ");
+ end;
+ print("</"); print(sgml_tag(p)); print(">");
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ mml_last_print_char:=false;
+ first_inside_text:=false;
+ end;
+ sgml_entity_node:
+ if not(first_inside_text and
+ (str_eq_str(sgml_entity_string(p)," "))) then begin
+ if back_at_bol then
+ for i:=1 to mml_indent do print(" ");
+ print(sgml_entity_string(p));
+ first_inside_text:=false;
+ mml_last_print_char:=true;
+ back_at_bol:=false;
+ if break_line then begin
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ end;
+ fraction_noad: begin
+ for i:=1 to mml_indent do print(" ");
+ print("<mfrac> Arguments </mfrac>"); print(new_line_char);
+ back_at_bol:=true;
+ mml_last_print_char:=false;
+ first_inside_text:=false;
+ end;
+ othercases begin
+ if (info(subscr(p))<>null) or
+ (info(supscr(p))<>null) then begin
+ if inside_text then print(new_line_char);
+ for i:=1 to mml_indent do print(" ");
+ print("<m");
+ if info(subscr(p))<>empty then print("sub");
+ if info(supscr(p))<>empty then print("sup");
+ print(">");
+ mml_indent:=mml_indent+1;
+ print(new_line_char);
+ end;
+ sgml_out_pointer(nucleus);
+ if (info(subscr(p))<>null) or
+ (info(supscr(p))<>null) then begin
+ if info(subscr(p))<>null then begin
+ sgml_out_pointer(subscr);
+ end;
+ if info(supscr(p))<>null then begin
+ sgml_out_pointer(supscr);
+ end;
+ mml_indent:=mml_indent-1;
+ for i:=1 to mml_indent do print(" ");
+ print("</m");
+ if info(subscr(p))<>null then print("sub");
+ if info(supscr(p))<>null then print("sup");
+ print(">");
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ mml_last_print_char:=false;
+ first_inside_text:=false;
+ end;
+ endcases;
+ end;
+ p:=link(p);
+ end;
+selector:=old_selector;
+end;
+
+procedure make_sgml_entity(s:str_number);
+begin
+link(tail):=new_sgml_entity_node;
+tail:=link(tail);
+sgml_entity_string(tail):=s;
+end;
+
+procedure scan_font_entity;
+var cv1,cv2,cv3,cv4:integer;
+begin
+scan_string_argument; cv1:=cur_val;
+scan_left_brace; scan_int; cv2:=cur_val; scan_right_brace;
+scan_string_argument; cv3:=cur_val;
+scan_string_argument; cv4:=cur_val;
+save_ptr:=save_ptr+4;
+saved(-1):=cv1; saved(-2):=cv2; saved(-3):=cv3; saved(-4):=cv4;
+new_save_level(font_entity_group); scan_left_brace; push_nest;
+end;
+
+procedure scan_empty_tag;
+begin
+scan_string_argument;
+link(tail):=new_sgml_node;
+tail:=link(tail);
+sgml_tag(tail):=cur_val;
+sgml_kind(tail):=sgml_math_node;
+sgml_singleton(tail):=1;
+incr(save_ptr); saved(-1):=tail;
+new_save_level(empty_tag_group); scan_left_brace; push_nest;
+end;
+
+procedure scan_lone_tag;
+begin
+scan_string_argument;
+link(tail):=new_sgml_node;
+tail:=link(tail);
+sgml_tag(tail):=cur_val;
+sgml_kind(tail):=sgml_math_node;
+sgml_singleton(tail):=2;
+incr(save_ptr); saved(-1):=tail;
+new_save_level(lone_tag_group); scan_left_brace; push_nest;
+end;
+
+procedure sgml_startmathtag(s:str_number);
+begin
+push_math(math_group); current_sgml_tag:=s;
+end;
+
+
+procedure sgml_starttexttag(s:str_number);
+begin
+push_nest; new_save_level(text_sgml_group);
+current_sgml_tag:=s;
+mode:=-hmode;
+end;
+
+
+procedure sgml_attribute(s,s1:str_number);
+var p:pointer;
+begin
+p:=new_sgml_attr_node;
+sgml_tag(p):=s;
+sgml_attrs(p):=s1;
+sgml_singleton(p):=0;
+link(p):=current_sgml_attrs;
+current_sgml_attrs:=p;
+end;
+
+procedure sgml_endtexttag(s:str_number);
+var q:pointer;
+begin
+if not str_eq_str(s,current_sgml_tag) then begin
+ print_err("Tags do not match: ");
+ print(current_sgml_tag); print(","); print(s);
+ print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end;
+q:=new_sgml_node;
+sgml_tag(q):=s;
+sgml_kind(q):=sgml_text_node;
+sgml_info(q):=link(head);
+sgml_attrs(q):=current_sgml_attrs;
+pop_nest;
+unsave;
+if mode=vmode then begin
+ ensure_mml_open;
+ cur_mlist:=q;
+ sgml_out_mlist(false,false,false);
+ end
+else begin
+ link(tail):=q;
+ tail:=q;
+ end;
+end;
+
+procedure sgml_write(s:str_number);
+var old_selector:integer;
+begin
+ensure_mml_open;
+old_selector:=selector;
+selector:=max_selector+mml_file_no;
+print(s);
+selector:=old_selector;
+end;
+
+procedure sgml_endmathtag(s:str_number);
+var q:pointer;
+begin
+if not str_eq_str(s,current_sgml_tag) then begin
+ print_err("Tags do not match: ");
+ print(current_sgml_tag); print(","); print(s);
+ print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end;
+q:=new_sgml_node;
+sgml_tag(q):=s;
+sgml_kind(q):=sgml_math_node;
+if s<>"mtext" then sgml_attrs(q):=current_sgml_attrs;
+sgml_info(q):=link(head);
+if current_sgml_attrs=null then
+ if (link(head)<>null) then
+ if (str_eq_str(s,"mtr") or str_eq_str(s,"mtd")) and
+ (link(link(head))=null) then begin
+ q:=sgml_info(q);
+ end;
+pop_nest;
+@<DIR: |unsave| math@>;
+link(tail):=q;
+tail:=q;
+end;
+
+procedure sgml_start_graf;
+begin
+sgml_starttexttag("par")
+end;
+
+procedure sgml_end_graf;
+begin
+sgml_endtexttag("par")
+end;
+
+@ Entering or leaving MML mode
+by using the routine called |primitive|, defined below. Let us enter them
+now, so that we don't have to list all those parameter names anywhere else.
+
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("showSGMLentities",set_show_sgml_entities,1);
+primitive("noshowSGMLentities",set_show_sgml_entities,0);
+primitive("MMLmode",set_mml_mode,1);
+@!@:MML_mode_}{\.{\\MMLmode} primitive@>
+primitive("noMMLmode",set_mml_mode,0);
+@!@:noMML_mode_}{\.{\\noMMLmode} primitive@>
+primitive("SGMLstartmathtag",mml_tag,0);
+primitive("SGMLendmathtag",mml_tag,1);
+primitive("SGMLstarttexttag",mml_tag,2);
+primitive("SGMLendtexttag",mml_tag,3);
+primitive("SGMLattribute",mml_tag,4);
+primitive("MMLstarttext",mml_tag,5);
+primitive("MMLendtext",mml_tag,6);
+
+primitive("SGMLampersand",other_char,"&");
+primitive("SGMLbackslash",other_char,"\");
+primitive("SGMLcarret",other_char,"^");
+primitive("SGMLdollar",other_char,"$");
+primitive("SGMLhash",other_char,"#");
+primitive("SGMLleftbrace",other_char,"{");
+primitive("SGMLpercent",other_char,"%");
+primitive("SGMLrightbrace",other_char,"}");
+primitive("SGMLunderscore",other_char,"_");
+
+primitive("SGMLentity",mml_tag,7);
+primitive("SGMLemptytag",mml_tag,8);
+primitive("SGMLlonetag",mml_tag,9);
+primitive("SGMLFontEntity",mml_tag,10);
+primitive("SGMLwrite",mml_tag,11);
+primitive("SGMLwriteln",mml_tag,12);
+
+@ @<Cases of |main_control| that build boxes and lists@>=
+mmode+set_mml_mode: report_illegal_case;
+non_math(set_mml_mode):
+ if cur_chr=0 then MML_mode:=false else MML_mode:=true;
+any_mode(set_show_sgml_entities):
+ if cur_chr=0 then SGML_show_entities:=false
+ else SGML_show_entities:=true;
+any_mode(mml_tag): begin
+ case cur_chr of
+ 0: begin scan_string_argument; sgml_startmathtag(cur_val); end;
+ 1: begin scan_string_argument; sgml_endmathtag(cur_val); end;
+ 2: begin scan_string_argument; sgml_starttexttag(cur_val); end;
+ 3: begin scan_string_argument; sgml_endtexttag(cur_val); end;
+ 4: begin scan_string_argument; cur_val1:=cur_val;
+ scan_string_argument; sgml_attribute(cur_val1,cur_val); end;
+ 5: begin
+ push_nest; new_save_level(text_mml_group);
+ current_sgml_tag:="mtext"; mode:=-hmode;
+ end;
+ 6: begin sgml_endtexttag("mtext"); end;
+ 7: begin scan_string_argument; make_sgml_entity(cur_val); end;
+ 8: begin scan_empty_tag; end;
+ 9: begin scan_lone_tag; end;
+ 10: begin scan_font_entity; end;
+ 11: begin scan_string_argument; sgml_write(cur_val); end;
+ 12: begin sgml_write(new_line_char); end;
+ end;
+ end;
+
+@ The following code opens \.{MML} output file if neccesary.
+@p procedure ensure_mml_open;
+begin
+ if mml_file_no=0 then begin
+ incr(output_file_no);
+ mml_file_no:=output_file_no;
+ ensure_output_open(".mml")
+ (output_file_names[mml_file_no])
+ (output_files[mml_file_no]);
+ output_file_names[mml_file_no]:=output_m_name;
+ end;
+end;
+
+@ @<Declare act...@>=
+
+@z
+%---------------------------------------
+@x [48] m.1137 l.21620 - Omega
+@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
+|math_shift| character) is scanned. We must check to see whether this
+`\.\$' is immediately followed by another, in case display math mode is
+called for.
+
+@<Cases of |main_control| that build...@>=
+hmode+math_shift:init_math;
+@y
+@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
+|math_shift| character) is scanned. We must check to see whether this
+`\.\$' is immediately followed by another, in case display math mode is
+called for.
+
+@<Cases of |main_control| that build...@>=
+hmode+math_shift: begin
+ if MML_mode then begin
+ ensure_mml_open;
+ incr(MML_level);
+ end;
+ init_math;
+ end;
+
+@z
+%---------------------------------------
+@x [48] m.1139 l.21648 - Omega
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+current_sgml_tag:="mrow";
+sgml_attribute("displaystyle","false");
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+%---------------------------------------
+@x [48] m.1145 l.21703 - Omega
+if every_display<>null then begin_token_list(every_display,every_display_text);
+@y
+current_sgml_tag:="mrow";
+sgml_attribute("displaystyle","true");
+if every_display<>null then begin_token_list(every_display,every_display_text);
+@z
+%---------------------------------------
+@x [48] m.1155 l.21878 - Omega
+ else type(p):=ord_noad+(c div @"1000000);
+ link(tail):=p; tail:=p;
+@y
+ else type(p):=ord_noad+(c div @"1000000);
+ if not MML_mode then
+ tail_append(p)
+ else if (c div @"1000000)=4 then begin
+ saved(0):=p;
+ incr(save_ptr);
+ push_math(math_mml_group);
+ end
+ else if (cur_group=math_mml_group) and
+ ((c div @"1000000)=5) then begin
+ {unsave;}
+ @<DIR: |unsave| math@>;
+ decr(save_ptr);
+ q:=saved(0);
+ r:=fin_mlist(null);
+ push_math(math_group);
+ tail_append(q); tail_append(r); tail_append(p);
+ {unsave;}
+ @<DIR: |unsave| math@>;
+ p:=fin_mlist(null);
+ tail_append(p);
+ end
+ else tail_append(p);
+@z
+%---------------------------------------
+@x [48] m.1176--1177 l.22109 - Omega
+procedure sub_sup;
+var t:small_number; {type of previous sub/superscript}
+@!p:pointer; {field to be filled by |scan_math|}
+begin t:=empty; p:=null;
+if tail<>head then if scripts_allowed(tail) then
+ begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+ t:=math_type(p);
+ end;
+if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
+scan_math(p);
+end;
+@y
+procedure sub_sup;
+var t:small_number; {type of previous sub/superscript}
+@!p,q,r:pointer; {field to be filled by |scan_math|}
+begin t:=empty; p:=null;
+if tail<>head then begin
+ if MML_mode then
+ if type(tail)=sgml_node then begin
+ q:=head;
+ while link(q)<>tail do q:=link(q);
+ r:=new_noad;
+ info(nucleus(r)):=tail;
+ math_type(nucleus(r)):=sub_mlist;
+ link(q):=r;
+ tail:=r;
+ end;
+ if scripts_allowed(tail) then
+ begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+ t:=math_type(p);
+ end;
+ end;
+if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
+scan_math(p);
+end;
+@z
+%---------------------------------------
+@x [48] m.1181 l.22199 - Omega
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+if incompleat_noad<>null then
+ @<Ignore the fraction operation and complain about this ambiguous case@>
+else begin incompleat_noad:=get_node(fraction_noad_size);
+ type(incompleat_noad):=fraction_noad;
+ subtype(incompleat_noad):=normal;
+ math_type(numerator(incompleat_noad)):=sub_mlist;
+ info(numerator(incompleat_noad)):=link(head);
+ mem[denominator(incompleat_noad)].hh:=empty_field;
+ mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
+ mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
+ link(head):=null; tail:=head;
+ @<Use code |c| to distinguish between generalized fractions@>;
+ end;
+end;
+@y
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+if incompleat_noad<>null then
+ @<Ignore the fraction operation and complain about this ambiguous case@>
+else begin incompleat_noad:=get_node(fraction_noad_size);
+ type(incompleat_noad):=fraction_noad;
+ subtype(incompleat_noad):=normal;
+ math_type(numerator(incompleat_noad)):=sub_mlist;
+ info(numerator(incompleat_noad)):=link(head);
+ mem[denominator(incompleat_noad)].hh:=empty_field;
+ if MML_mode then begin
+ mem[left_delimiter(incompleat_noad)].int:=0;
+ mem[right_delimiter(incompleat_noad)].int:=0;@/
+ end
+ else begin
+ mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
+ mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
+ end;
+ link(head):=null; tail:=head;
+ @<Use code |c| to distinguish between generalized fractions@>;
+ end;
+end;
+@z
+%---------------------------------------
+@x [48] m.1182 l.22199 - Omega
+ begin scan_delimiter(left_delimiter(incompleat_noad),false);
+ scan_delimiter(right_delimiter(incompleat_noad),false);
+@y
+ begin if MML_mode then begin
+ mem[left_delimiter(incompleat_noad)].int:=new_noad;
+ scan_math(nucleus(mem[left_delimiter(incompleat_noad)].int));
+ mem[right_delimiter(incompleat_noad)].int:=new_noad;
+ scan_math(nucleus(mem[right_delimiter(incompleat_noad)].int));
+ end
+ else begin
+ scan_delimiter(left_delimiter(incompleat_noad),0);
+ scan_delimiter(right_delimiter(incompleat_noad),0);
+ end;
+@z
+%---------------------------------------
+@x [48] m.1183 l.22212 - Omega
+ begin scan_delimiter(garbage,false); scan_delimiter(garbage,false);
+@y
+ begin if MML_mode then begin
+ scan_math(garbage); scan_math(garbage);
+ end
+ else begin
+ scan_delimiter(garbage,0); scan_delimiter(garbage,0);
+ end;
+@z
+%---------------------------------------
+@x [48] m.1184 l.22230 - Omega
+function fin_mlist(@!p:pointer):pointer;
+var q:pointer; {the mlist to return}
+begin if incompleat_noad<>null then @<Compleat the incompleat noad@>
+else begin link(tail):=p; q:=link(head);
+ end;
+pop_nest; fin_mlist:=q;
+end;
+@y
+function fin_mlist(@!p:pointer):pointer;
+var q,q1,q2:pointer; {the mlist to return}
+ tag:integer;
+begin if incompleat_noad<>null then @<Compleat the incompleat noad@>
+else begin link(tail):=p; q:=link(head);
+ end;
+if current_sgml_tag=0 then
+ tag:="mrow"
+else tag:=current_sgml_tag;
+pop_nest;
+if MML_mode then
+ if q<>null then
+ if link(q)<>null then begin
+ q1:=new_sgml_node;
+ sgml_tag(q1):=tag;
+ sgml_info(q1):=q;
+ sgml_kind(q1):=sgml_math_node;
+ fin_mlist:=q1
+ end
+ else fin_mlist:=q
+ else fin_mlist:=q
+else
+ fin_mlist:=q;
+end;
+@z
+%---------------------------------------
+@x [48] m.1185 l.22256 - Omega
+@ @<Compleat...@>=
+begin math_type(denominator(incompleat_noad)):=sub_mlist;
+info(denominator(incompleat_noad)):=link(head);
+if p=null then q:=incompleat_noad
+else begin q:=info(numerator(incompleat_noad));
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+ end;
+end
+@y
+@ @<Compleat...@>=
+begin math_type(denominator(incompleat_noad)):=sub_mlist;
+info(denominator(incompleat_noad)):=link(head);
+if p=null then
+ if not MML_mode then
+ q:=incompleat_noad
+ else begin
+ if link(info(numerator(incompleat_noad)))<>null then begin
+ q1:=new_sgml_node;
+ sgml_tag(q1):="mrow";
+ sgml_kind(q1):=sgml_math_node;
+ sgml_info(q1):=info(numerator(incompleat_noad));
+ end
+ else q1:=info(numerator(incompleat_noad));
+ if link(info(denominator(incompleat_noad)))<>null then begin
+ q2:=new_sgml_node;
+ sgml_tag(q2):="mrow";
+ sgml_kind(q2):=sgml_math_node;
+ sgml_info(q2):=info(denominator(incompleat_noad));
+ end
+ else q2:=info(denominator(incompleat_noad));
+ q:=new_sgml_node;
+ sgml_tag(q):="mfrac";
+ sgml_kind(q):=sgml_math_node;
+ sgml_info(q):=q1;
+ link(q1):=q2;
+ current_sgml_attrs:=null;
+ if thickness(incompleat_noad)<>default_code then
+ if thickness(incompleat_noad)=0 then
+ sgml_attribute("linethickness","0ex")
+ else if thickness(incompleat_noad)<default_rule_thickness then
+ sgml_attribute("linethickness","thin")
+ else if thickness(incompleat_noad)>default_rule_thickness then
+ sgml_attribute("linethickness","thick");
+ sgml_attrs(q):=current_sgml_attrs;
+ if (mem[left_delimiter(incompleat_noad)].int<>0) or
+ (mem[right_delimiter(incompleat_noad)].int<>0) then begin
+ q1:=q;
+ q:=new_sgml_node;
+ sgml_tag(q):="mrow";
+ sgml_kind(q):=sgml_math_node;
+ sgml_info(q):=mem[left_delimiter(incompleat_noad)].int;
+ link(mem[left_delimiter(incompleat_noad)].int):=q1;
+ link(q1):=mem[right_delimiter(incompleat_noad)].int;
+ end
+ end
+else begin q:=info(numerator(incompleat_noad));
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+ end;
+end
+@z
+%---------------------------------------
+@x [48] m.1186 l.22256 - Omega
+math_group: begin @<DIR: |unsave| math@>; decr(save_ptr);@/
+ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
+ if p<>null then if link(p)=null then
+ if type(p)=ord_noad then
+ begin if math_type(subscr(p))=empty then
+ if math_type(supscr(p))=empty then
+ begin mem[saved(0)].hh:=mem[nucleus(p)].hh;
+ free_node(p,noad_size);
+ end;
+ end
+ else if type(p)=accent_noad then if saved(0)=nucleus(tail) then
+ if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>;
+ end;
+@y
+text_mml_group: begin
+ unsave; decr(save_ptr);
+ p:=saved(0);
+ sgml_info(p):=link(head);
+ pop_nest;
+ tail_append(p);
+ end;
+text_sgml_group: begin
+ print_err("Expecting closing tag </");
+ print(current_sgml_tag); print(">.");
+ print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end;
+math_mml_group: begin
+ @<DIR: |unsave| math@>;
+ decr(save_ptr);
+ link(saved(0)):=link(head);
+ p:=saved(0);
+ pop_nest;
+ if type(p)=sgml_node then
+ if str_eq_str(sgml_tag(p),"mrow") then
+ if sgml_attrs(p)=null then begin
+ if link(sgml_info(p))=null then
+ p:=sgml_info(p);
+ end;
+ tail_append(p);
+ back_input;
+ end;
+math_group: begin @<DIR: |unsave| math@>; decr(save_ptr);@/
+ if MML_mode then
+ math_type(saved(0)):=sub_mlist
+ else
+ math_type(saved(0)):=sub_mlist;
+ p:=fin_mlist(null); info(saved(0)):=p;
+ if p<>null then if link(p)=null then
+ if type(p)=ord_noad then
+ begin if math_type(subscr(p))=empty then
+ if math_type(supscr(p))=empty then
+ begin mem[saved(0)].hh:=mem[nucleus(p)].hh;
+ free_node(p,noad_size);
+ end;
+ end
+ else if type(p)=accent_noad then if saved(0)=nucleus(tail) then
+ if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>;
+ end;
+font_entity_group: begin
+ unsave;
+ font_sort_number:=font_sort_ptr+1;
+ for font_sorts:=font_sort_base+1 to font_sort_ptr do
+ if str_eq_str(font_sort_name(font_sorts),saved(-1)) then begin
+ font_sort_number:=font_sorts;
+ break;
+ end;
+ font_sort_c:=saved(-2);
+ font_sort_char_entity(font_sort_number)(font_sort_c):=saved(-3);
+ font_sort_char_tag(font_sort_number)(font_sort_c):=saved(-4);
+ font_sort_char_attr(font_sort_number)(font_sort_c):=current_sgml_attrs;
+ current_sgml_attrs:=null;
+ save_ptr:=save_ptr-4; pop_nest;
+ end;
+empty_tag_group: begin
+ unsave; sgml_attrs(saved(-1)):=current_sgml_attrs;
+ decr(save_ptr); pop_nest;
+ end;
+lone_tag_group: begin
+ unsave; sgml_attrs(saved(-1)):=current_sgml_attrs;
+ decr(save_ptr); pop_nest;
+ end;
+@z
+%---------------------------------------
+@x [48] m.1191 l.22301 - Omega
+procedure math_left_right;
+var t:small_number; {|left_noad| or |right_noad|}
+@!p:pointer; {new noad}
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+ @<Try to recover from mismatched \.{\\right}@>
+else begin p:=new_noad; type(p):=t;
+ scan_delimiter(delimiter(p),false);
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+ tail_append(new_noad); type(tail):=inner_noad;
+ math_type(nucleus(tail)):=sub_mlist;
+ info(nucleus(tail)):=p;
+ end;
+ end;
+end;
+@y
+procedure math_left_right;
+var t:small_number; {|left_noad| or |right_noad|}
+@!p,q,r:pointer; {new noad}
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+ @<Try to recover from mismatched \.{\\right}@>
+else begin p:=new_noad;
+ if MML_mode then begin
+ scan_math(nucleus(p));
+ if t=left_noad then begin
+ saved(0):=p; incr(save_ptr);
+ push_math(math_left_group);
+ end
+ else begin
+ {unsave;}
+ @<DIR: |unsave| math@>;
+ decr(save_ptr);
+ q:=saved(0); r:=fin_mlist(null);
+ push_math(math_group);
+ tail_append(q); tail_append(r);
+ tail_append(p);
+ {unsave;}
+ @<DIR: |unsave| math@>;
+ p:=fin_mlist(null);
+ tail_append(p);
+ end
+ end
+ else begin
+ type(p):=t;
+ scan_delimiter(delimiter(p),false);
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+ tail_append(new_noad); type(tail):=inner_noad;
+ math_type(nucleus(tail)):=sub_mlist;
+ info(nucleus(tail)):=p;
+ end;
+ end;
+ end;
+end;
+@z
+%---------------------------------------
+@x [48] m.1192 l.22284 - Omega
+begin if cur_group=math_shift_group then
+ begin scan_delimiter(garbage,false);
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ error;
+ end
+else off_save;
+end
+@y
+begin if cur_group=math_shift_group then
+ begin if MML_mode then scan_math(garbage)
+ else scan_delimiter(garbage,0);
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ error;
+ end
+else off_save;
+end
+@z
+%---------------------------------------
+@x [48] m.1193 l.22327 - Omega
+mmode+math_shift: if cur_group=math_shift_group then after_math
+ else off_save;
+@y
+mmode+math_shift: if cur_group=math_mml_group then after_mml
+ else if cur_group=math_shift_group then after_math
+ else off_save;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22284 - Omega
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ @<DIR: |unsave| math@>;
+ decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+ danger:=false;
+ @<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+ m:=mode; p:=fin_mlist(null);
+ end
+else a:=null;
+if m<0 then @<Finish math in text@>
+else begin if a=null then @<Check that another \.\$ follows@>;
+ @<Finish displayed math@>;
+ end;
+end;
+@y
+procedure after_mml;
+var p:pointer;
+begin
+@<DIR: |unsave| math@>;
+decr(save_ptr);
+link(saved(0)):=link(head);
+p:=saved(0);
+pop_nest;
+tail_append(p);
+back_input;
+end;
+
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if MML_mode then decr(MML_level);
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ if MML_mode then begin
+ sgml_out_mlist(true,false,false)
+ end
+ else begin
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ end;
+ @<DIR: |unsave| math@>;
+ decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+ danger:=false;
+ @<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+ m:=mode; p:=fin_mlist(null);
+ end
+else a:=null;
+if m<0 then @<Finish math in text@>
+else begin if a=null then @<Check that another \.\$ follows@>;
+ @<Finish displayed math@>;
+ end;
+end;
+@z
+%---------------------------------------
+@x [49] m.1196 l.22388 - Omega
+@<Finish math in text@> =
+begin tail_append(new_math(math_surround,before));
+if dir_math_save then
+ @<Append a begin direction to the tail of the current list@>;
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+if dir_math_save then
+ @<Append an end direction to the tail of the current list@>;
+dir_math_save:=false;
+tail_append(new_math(math_surround,after));
+space_factor:=1000;
+@<DIR: |unsave| math@>;
+end
+@y
+@<Finish math in text@>=
+begin
+if not MML_mode then begin
+ tail_append(new_math(math_surround,before));
+ if dir_math_save then
+ @<Append a begin direction to the tail of the current list@>;
+ end;
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0);
+if MML_mode then begin
+{
+ if MML_level=0 then sgml_out_mlist(true,false,false)
+ else tail_append(cur_mlist);
+}
+ sgml_starttexttag("inlinemath");
+ sgml_starttexttag("math");
+ tail_append(cur_mlist);
+ sgml_endtexttag("math");
+ sgml_endtexttag("inlinemath");
+ end
+else begin
+ mlist_to_hlist;
+ link(tail):=link(temp_head);
+ while link(tail)<>null do tail:=link(tail);
+ if dir_math_save then
+ @<Append an end direction to the tail of the current list@>;
+ dir_math_save:=false;
+ tail_append(new_math(math_surround,after));
+ end;
+space_factor:=1000;
+@<DIR: |unsave| math@>;
+end
+@z
+%---------------------------------------
+@x [49] m.1197 l.22430 - Omega
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+mlist_to_hlist; p:=link(temp_head);@/
+adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b);
+t:=adjust_tail; adjust_tail:=null;@/
+w:=width(b); z:=display_width; s:=display_indent;
+if (a=null)or danger then
+ begin e:=0; q:=0;
+ end
+else begin e:=width(a); q:=e+math_quad(text_size);
+ end;
+if w+q>z then
+ @<Squeeze the equation as much as possible; if there is an equation
+ number that should go on a separate line by itself,
+ set~|e:=0|@>;
+@<Determine the displacement, |d|, of the left edge of the equation, with
+ respect to the line size |z|, assuming that |l=false|@>;
+@<Append the glue or equation number preceding the display@>;
+@<Append the display and perhaps also the equation number@>;
+@<Append the glue or equation number following the display@>;
+resume_after_display
+@y
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+if MML_mode then begin
+{
+ if MML_level=0 then sgml_out_mlist(true,false,false)
+ else tail_append(cur_mlist);
+}
+ sgml_starttexttag("displaymath");
+ sgml_starttexttag("math");
+ tail_append(cur_mlist);
+ sgml_endtexttag("math");
+ sgml_endtexttag("displaymath");
+ end
+else begin
+ mlist_to_hlist; p:=link(temp_head);@/
+ adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b);
+ t:=adjust_tail; adjust_tail:=null;@/
+ w:=width(b); z:=display_width; s:=display_indent;
+ if (a=null)or danger then
+ begin e:=0; q:=0;
+ end
+ else begin e:=width(a); q:=e+math_quad(text_size);
+ end;
+ if w+q>z then
+ @<Squeeze the equation as much as possible; if there is an equation
+ number that should go on a separate line by itself,
+ set~|e:=0|@>;
+ @<Determine the displacement, |d|, of the left edge of the equation, with
+ respect to the line size |z|, assuming that |l=false|@>;
+ @<Append the glue or equation number preceding the display@>;
+ @<Append the display and perhaps also the equation number@>;
+ @<Append the glue or equation number following the display@>;
+ end;
+resume_after_display
+@z
+%---------------------------------------
+@x [49] m.1257 l.23269 - Omega
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+@y
+@!flushable_string:str_number; {string not yet referenced}
+@!cur_font_sort_name:str_number; {the name without the digits at the end}
+@!new_length:integer; {length of font name, to become font sort name}
+@!last_character:integer; {last character in font name}
+@!i:integer; {to run through characters of name}
+@!this_is_a_new_font:boolean;
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+this_is_a_new_font:=false;
+@z
+%---------------------------------------
+@x [49] m.1257 l.23290 - Omega
+common_ending: set_equiv(u,f);
+set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t);
+@y
+this_is_a_new_font:=true;
+common_ending: set_equiv(u,f);
+set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t);
+if this_is_a_new_font then
+ begin
+ if cur_name>=@"10000 then begin
+ new_length:=length(cur_name);
+ last_character:=str_pool[str_start(cur_name)+new_length-1];
+ while (last_character>="0") and (last_character<="9") do begin
+ decr(new_length);
+ last_character:=str_pool[str_start(cur_name)+new_length-1];
+ end;
+ for i:=1 to new_length do begin
+ append_char(str_pool[str_start(cur_name)+i-1]);
+ end;
+ cur_font_sort_name:=make_string;
+ font_sort_number:=font_sort_ptr+1;
+ for font_sorts:=font_sort_base+1 to font_sort_ptr do
+ if str_eq_str(font_sort_name(font_sorts),cur_font_sort_name) then begin
+ font_sort_number:=font_sorts;
+ break;
+ end;
+ font_name_sort(f):=font_sort_number;
+ if font_sort_number=(font_sort_ptr+1) then begin
+ incr(font_sort_ptr);
+ allocate_font_sort_table
+ (font_sort_ptr,
+ font_sort_offset_char_base+3*(font_ec(f)-font_bc(f)+1));
+ font_sort_file_size(font_sort_ptr):=
+ font_sort_offset_char_base+3*(font_ec(f)-font_bc(f)+1);
+ font_sort_name(font_sort_ptr):=cur_font_sort_name;
+ font_sort_ec(font_sort_ptr):=font_ec(f);
+ font_sort_bc(font_sort_ptr):=font_bc(f);
+ cur_name:=cur_font_sort_name;
+ cur_ext:=".onm";
+ pack_cur_name;
+ begin_file_reading;
+ if a_open_in(cur_file,kpse_tex_format) then begin
+ name:=a_make_name_string(cur_file);
+ print_ln; print("("); print(name);
+ @<Read the first line of the new file@>;
+ end
+ else end_file_reading;
+ end;
+ end;
+ end;
+@z
+%---------------------------------------
+@x [50] m.1320 l.23983 - Omega
+@ @<Dump the font information@>=
+@y
+@ @<Dump the font information@>=
+dump_int(font_sort_ptr);
+for k:=null_font_sort to font_sort_ptr do
+ dump_font_sort_table(k,font_sort_file_size(k));
+@z
+%---------------------------------------
+@x [50] m.1321 l.23993 - Omega
+@ @<Undump the font information@>=
+@y
+@ @<Undump the font information@>=
+undump_size(font_base)(font_max)('font sort max')(font_sort_ptr);
+for k:=null_font_sort to font_sort_ptr do
+ undump_font_sort_table(k);
+@z
+%---------------------------------------
+@x [51] m.1333 l.24244 - Omega
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+@y
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal;
+if not MML_mode then begin @<Finish the \.{DVI} file@>; end;
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/bibtex.ch b/Build/source/texk/web2c/bibtex.ch
new file mode 100644
index 00000000000..4f760282c62
--- /dev/null
+++ b/Build/source/texk/web2c/bibtex.ch
@@ -0,0 +1,1291 @@
+% Change file for BibTeX in C, originally by Howard Trickey.
+%
+% 05/28/84 Initial implementation, version 0.41 of BibTeX
+% 07/01/84 Version 0.41a of BibTeX.
+% 12/17/84 Version 0.97c of BibTeX.
+% 02/12/85 Version 0.98c of BibTeX.
+% 02/25/85 Newer version 0.98c of BibTeX.
+% 03/25/85 Version 0.98f of BibTeX
+% 05/23/85 Version 0.98i of BibTeX
+% 02/11/88 Version 0.99b of BibTeX
+% 04/04/88 Version 0.99c; converted for use with web2c (ETM).
+% 11/30/89 Use FILENAMESIZE instead of 1024 (KB).
+% 03/09/90 `int' is a bad variable name for C.
+% (more recent changes in the ChangeLog)
+
+% [0] Let bibtex.tex work with latest webmac (which defines \ET, hence
+% making E active loses).
+@x
+\catcode`E=13 \uppercase{\def E{e}}
+\def\\#1{\hbox{\let E=\drop\it#1\/\kern.05em}} % italic type for identifiers
+@y
+\let\maybe = \iffalse % process only changed sections
+@z
+
+% [2] `term_in' and `term_out' are standard input and output. But
+% there is a complication: BibTeX passes `term_out' to some routines as
+% a var parameter. web2c turns a var parameter f into &f at the calling
+% side -- and stdout is sometimes implemented as `&_iob[1]' or some
+% such. An address of an address is invalid. Therefore, we define
+% variables `standardinput' and `standardoutput' in openinout.c.
+@x
+@d term_out == tty
+@d term_in == tty
+@y
+@d term_out == standard_output
+@d term_in == standard_input
+
+@<Globals in the outer block@>=
+standard_input, standard_output: text;
+@z
+
+@x [3] Add log_pr macros.
+@d trace_pr_newline == begin write_ln(log_file); end
+@y
+@d trace_pr_newline == begin write_ln(log_file); end
+@#
+@d log_pr(#) == trace_pr(#)
+@d log_pr_ln(#) == trace_pr_ln(#)
+@d log_pr_newline == trace_pr_newline
+@z
+
+@x [4] Turn debug..gubed et al. into #ifdef's.
+@d debug == @{ { remove the `|@{|' when debugging }
+@d gubed == @t@>@} { remove the `|@}|' when debugging }
+@f debug == begin
+@f gubed == end
+@#
+@d stat == @{ { remove the `|@{|' when keeping statistics }
+@d tats == @t@>@} { remove the `|@}|' when keeping statistics }
+@f stat == begin
+@f tats == end
+@#
+@d trace == @{ { remove the `|@{|' when in |trace| mode }
+@d ecart == @t@>@} { remove the `|@}|' when in |trace| mode }
+@f trace == begin
+@f ecart == end
+@y
+@d debug == ifdef('TEXMF_DEBUG')
+@d gubed == endif('TEXMF_DEBUG')
+@f debug == begin
+@f gubed == end
+@#
+@d stat == ifndef('NO_BIBTEX_STAT')
+@d tats == endifn('NO_BIBTEX_STAT')
+@f stat==begin
+@f tats==end
+@#
+@d trace == ifdef@&('TRACE')
+@d ecart == endif@&('TRACE')
+@f trace == begin
+@f ecart == end
+@z
+
+@x [10] Don't print the banner unless verbose, and initialize dynamic arrays.
+begin
+initialize;
+print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+begin
+standard_input := stdin;
+standard_output := stdout;
+@#
+max_ent_ints := MAX_ENT_INTS;
+max_ent_strs := MAX_ENT_STRS;
+pool_size := POOL_SIZE;
+buf_size := BUF_SIZE;
+max_bib_files := MAX_BIB_FILES;
+max_fields := MAX_FIELDS;
+wiz_fn_space := WIZ_FN_SPACE;
+@#
+{Add one to the sizes because that's what bibtex uses.}
+bib_file := XTALLOC (max_bib_files + 1, alpha_file);
+bib_list := XTALLOC (max_bib_files + 1, str_number);
+entry_ints := XTALLOC (max_ent_ints + 1, integer);
+entry_strs := XTALLOC ((max_ent_strs + 1) * (ent_str_size + 1), ASCII_code);
+wiz_functions := XTALLOC (wiz_fn_space + 1, hash_ptr2);
+field_info := XTALLOC (max_fields + 1, str_number);
+s_preamble := XTALLOC (max_bib_files + 1, str_number);
+str_pool := XTALLOC (pool_size + 1, ASCII_code);
+buffer := XTALLOC (buf_size + 1, ASCII_code);
+sv_buffer := XTALLOC (buf_size + 1, ASCII_code);
+ex_buf := XTALLOC (buf_size + 1, ASCII_code);
+out_buf := XTALLOC (buf_size + 1, ASCII_code);
+name_tok := XTALLOC (buf_size + 1, buf_pointer);
+name_sep_char := XTALLOC (buf_size + 1, ASCII_code);
+@#
+initialize;
+{This initializes the jmp9998 buffer, which can be used early}
+hack0;
+if verbose then begin
+ print (banner);
+ print_ln (version_string);
+end
+else begin
+ log_pr (banner);
+ log_pr_ln (version_string);
+end;
+@z
+
+% [10] Possibly exit with bad status. It doesn't seem worth it to move
+% the definitions of the |history| values to above this module; hence the 1.
+@x
+exit_program:
+end.
+@y
+exit_program:
+if (history > 1) then uexit (history);
+end.
+@z
+
+@x [13] Remove nonlocal goto.
+ goto exit_program;
+@y
+ uexit (1);
+@z
+
+@x [14] Increase some constants, and uppercase others for dynamic arrays.
+@<Constants in the outer block@>=
+@y
+@<Constants in the outer block@>=
+@!hash_prime = 30011; {a prime number about 85\% of |hash_size| and |>= 128|}
+@!hash_size = 35307; {must be |>= max_strings| and |>= hash_prime|}
+@!hash_base = empty + 1; {lowest numbered hash-table location}
+@!hash_max = hash_base + hash_size - 1; {highest numbered hash-table location}
+@!hash_maxp1 = hash_max + 1; {because we need a scalar constant later}
+@!max_hash_value = hash_prime + hash_prime - 2 + 127; {|h|'s maximum value}
+@!quote_next_fn = hash_base - 1; {special marker used in defining functions}
+@!end_of_def = hash_max + 1; {another such special marker}
+@!undefined = hash_max + 1; {a special marker used for |type_list|}
+@z
+
+@x [still 14]
+@!buf_size=1000; {maximum number of characters in an input line (or string)}
+@y
+@!BUF_SIZE=5000; {initial maximum number of characters in an input line
+ (or string)}
+@z
+
+@x [still 14]
+@!max_bib_files=20; {maximum number of \.{.bib} files allowed}
+@!pool_size=65000; {maximum number of characters in strings}
+@!max_strings=4000; {maximum number of strings, including pre-defined;
+ must be |<=hash_size|}
+@!max_cites=750; {maximum number of distinct cite keys; must be
+ |<=max_strings|}
+@!min_crossrefs=2; {minimum number of cross-refs required for automatic
+ |cite_list| inclusion}
+@!wiz_fn_space=3000; {maximum amount of |wiz_defined|-function space}
+@y [still 14]
+@!MAX_BIB_FILES=20; {initial number of \.{.bib} files allowed}
+@!POOL_SIZE=65000; {initial number of characters in strings}
+@!max_strings=35000; {maximum number of strings, including pre-defined;
+ must be |<=hash_size|}
+@!max_cites=5000; {maximum number of distinct cite keys; must be
+ |<=max_strings|}
+@!WIZ_FN_SPACE=3000; {initial amount of |wiz_defined|-function space}
+{|min_crossrefs| can be set at runtime now.}
+@z
+
+@x [still 14] handle long citation strings
+@!max_ent_ints=3000; {maximum number of |int_entry_var|s
+ (entries $\times$ |int_entry_var|s)}
+@!max_ent_strs=3000; {maximum number of |str_entry_var|s
+ (entries $\times$ |str_entry_var|s)}
+@!ent_str_size=100; {maximum size of a |str_entry_var|; must be |<=buf_size|}
+@!glob_str_size=1000; {maximum size of a |str_global_var|;
+ must be |<=buf_size|}
+@!max_fields=17250; {maximum number of fields (entries $\times$ fields,
+@y
+@!MAX_ENT_INTS=3000; {initial number of |int_entry_var|s
+ (entries $\times$ |int_entry_var|s)}
+@!MAX_ENT_STRS=3000; {initial number of |str_entry_var|s
+ (entries $\times$ |str_entry_var|s)}
+@!ent_str_size=250; {maximum size of a |str_entry_var|; must be |<=buf_size|}
+@!glob_str_size=5000; {maximum size of a |str_global_var|;
+ must be |<=buf_size|}
+@!MAX_FIELDS=5000; {initial number of fields (entries $\times$ fields,
+@z
+
+@x [15] Increase more constants in the web defines.
+@d hash_size=5000 {must be |>= max_strings| and |>= hash_prime|}
+@d hash_prime=4253 {a prime number about 85\% of |hash_size| and |>= 128|
+ and |< @t$2^{14}-2^6$@>|}
+@d file_name_size=40 {file names shouldn't be longer than this}
+@d max_glob_strs=10 {maximum number of |str_global_var| names}
+@y
+{|hash_size| and |hash_prime| are |const| constants now.}
+@d max_glob_strs=20 {maximum number of |str_global_var| names
+ \.{James.Ashton@@keating.anu.edu.au} says his
+ indxcite package needs at least 15 here.}
+@#
+@d file_name_size==maxint {file names have no arbitrary maximum length}
+@#
+{For dynamic allocation.}
+@d x_entry_strs_tail(#) == (#)]
+@d x_entry_strs(#) == entry_strs[(#) * (ent_str_size+1) + x_entry_strs_tail
+@z
+
+@x [16] Add new variables-that-used-to-be-constants for dynamic arrays.
+@<Globals in the outer block@>=
+@y
+@<Globals in the outer block@>=
+@!max_ent_ints: integer;
+@!max_ent_strs: integer;
+@!pool_size: integer;
+@!max_bib_files: integer;
+@!wiz_fn_space: integer;
+@!max_fields: integer;
+@z
+
+@x [17] Remove painfully small upper bound on hash_prime
+if (hash_prime >= (16384-64)) then bad:=10*bad+6;
+@y
+@z
+
+@x [22, 23, 27, 28] Allow any character as input. [22]
+@!ASCII_code=0..127; {seven-bit numbers}
+@y
+@!ASCII_code=0..255; {eight-bit numbers}
+@z
+
+@x [23]
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Local variables for initialization@>=
+i:0..last_text_char; {this is the first one declared}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Local variables for initialization@>=
+i:integer;
+@z
+
+@x [27]
+for i:=1 to @'37 do xchr[i]:=' ';
+xchr[tab]:=chr(tab);
+@y
+for i:=0 to @'37 do xchr[i]:=chr(i);
+for i:=@'177 to @'377 do xchr[i]:=chr(i);
+@z
+
+@x [28]
+for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
+for i:=1 to @'176 do xord[xchr[i]]:=i;
+@y
+for i:=first_text_char to last_text_char do xord[xchr[i]]:=i;
+@z
+
+@x [32] Put the [128..255] range into lex_class alpha.
+for i:=0 to @'177 do lex_class[i] := other_lex;
+@y
+for i:=0 to @'177 do lex_class[i] := other_lex;
+for i:=@'200 to @'377 do lex_class[i] := alpha;
+@z
+
+% [32] Make RET a `white_space' character, so we won't choke on DOS
+% files, which use CR/LF for line endings.
+@x
+lex_class[tab] := white_space;
+@y
+lex_class[tab] := white_space;
+lex_class[13] := white_space;
+@z
+
+@x [33] Allow the [128..255] range in legal_id_char.
+for i:=0 to @'177 do id_class[i] := legal_id_char;
+@y
+for i:=0 to @'377 do id_class[i] := legal_id_char;
+@z
+
+% [37] file_name_size no longer exists. See comments in tex.ch for why
+% we change the element type to text_char.
+@x
+@!name_of_file:packed array[1..file_name_size] of char;
+ {on some systems this is a \&{record} variable}
+@!name_length:0..file_name_size;
+ {this many characters are relevant in |name_of_file| (the rest are blank)}
+@!name_ptr:0..file_name_size+1; {index variable into |name_of_file|}
+@y
+@!name_of_file:^text_char;
+@!name_length:integer;
+ {this many characters are relevant in |name_of_file| }
+@!name_ptr:integer; {index variable into |name_of_file|}
+@z
+
+@x [38] File opening.
+The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `\ignorespaces|packed
+array[@t\<\\{any}>@>] of text_char|', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\TeX\ to undertake appropriate corrective action.
+
+\TeX's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@<Procedures and functions for file-system interacting@>=
+function erstat(var f:file):integer; extern; {in the runtime library}
+@#@t\2@>
+function a_open_in(var f:alpha_file):boolean; {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean; {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@y
+@ File opening will be done in C.
+@d no_file_path = -1
+@z
+
+@x [39] Do file closing in C.
+@<Procedures and functions for file-system interacting@>=
+procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+@y
+File closing will be done in C, too.
+@z
+
+@x [41] Dynamic buf_size.
+@!buffer:buf_type; {usually, lines of characters being read}
+@y
+@!buf_size:integer; {size of buffer}
+@!buffer:buf_type; {usually, lines of characters being read}
+@z
+
+@x [42] Dyanmic buf_size.
+@!buf_pointer = 0..buf_size; {an index into a |buf_type|}
+@!buf_type = array[buf_pointer] of ASCII_code; {for various buffers}
+@y
+@!buf_pointer = integer; {an index into a |buf_type|}
+@!buf_type = ^ASCII_code; {for various buffers}
+@z
+
+@x [46] Dynamic buf_size.
+procedure buffer_overflow;
+begin
+overflow('buffer size ',buf_size);
+end;
+@y
+procedure buffer_overflow;
+var cur_size:integer;
+begin
+cur_size := buf_size;
+BIB_XRETALLOC('buffer', buffer, ASCII_code, cur_size, cur_size + BUF_SIZE);
+cur_size := buf_size;
+BIB_XRETALLOC('sv_buffer', sv_buffer, ASCII_code, cur_size, cur_size+BUF_SIZE);
+cur_size := buf_size;
+BIB_XRETALLOC('ex_buf', ex_buf, ASCII_code, cur_size, cur_size+BUF_SIZE);
+cur_size := buf_size;
+BIB_XRETALLOC('out_buf', out_buf, ASCII_code, cur_size, cur_size+BUF_SIZE);
+cur_size := buf_size;
+BIB_XRETALLOC('name_tok', name_tok, buf_pointer, cur_size, cur_size+BUF_SIZE);
+cur_size := buf_size;
+BIB_XRETALLOC('name_sep_char', name_sep_char, ASCII_code, cur_size,
+ cur_size+BUF_SIZE);
+buf_size := cur_size;
+end;
+@z
+
+@x [47] web2c doesn't understand f^.
+ buffer[last]:=xord[f^];
+ get(f); incr(last);
+ end;
+ get(f);
+@y
+ buffer[last] := xord[getc (f)];
+ incr (last);
+ end;
+ vgetc (f); {skip the eol}
+@z
+
+@x [48] Dynamically allocate str_pool.
+@!str_pool : packed array[pool_pointer] of ASCII_code; {the characters}
+@y
+@!str_pool : ^ASCII_code; {the characters}
+@z
+
+@x [49] pool_size is a variable now, so can't be used as a constant.
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@y
+@!pool_pointer = integer; {for variables that point into |str_pool|}
+@z
+
+@x [50] Add log_pr_pool_str macro.
+@d trace_pr_pool_str(#) == begin
+ out_pool_str(log_file,#);
+ end
+@y
+@d trace_pr_pool_str(#) == begin
+ out_pool_str(log_file,#);
+ end
+@#
+@d log_pr_pool_str(#) == trace_pr_pool_str(#)
+@z
+
+@x [53] Reallocate str_pool.
+overflow('pool size ',pool_size);
+@y
+BIB_XRETALLOC ('str_pool', str_pool, ASCII_code, pool_size,
+ pool_size + POOL_SIZE);
+@z
+
+% [58] (start_name) reallocate name_of_file for the new name and
+% terminate with null.
+@x
+name_ptr := 1;
+@y
+name_ptr := 1;
+free (name_of_file);
+name_of_file := xmalloc_array (ASCII_code, length (file_name) + 1);
+@z
+
+@x
+name_length := length(file_name);
+@y
+name_length := length(file_name);
+name_of_file[name_length + 1] := 0;
+@z
+
+% [60] (add_extension) Don't pad name_of_file with blanks, terminate
+% with null. And junk the overflow check, since Web2c can't translate
+% the print statement properly and it can never happen, anyway.
+@x
+if (name_length + length(ext) > file_name_size) then
+ begin
+ print ('File=',name_of_file,', extension=');
+ print_pool_str (ext); print_ln (',');
+ file_nm_size_overflow;
+ end;
+@y
+@z
+@x
+name_ptr := name_length+1;
+while (name_ptr <= file_name_size) do {pad with blanks}
+ begin
+ name_of_file[name_ptr] := ' ';
+ incr(name_ptr);
+ end;
+@y
+name_of_file[name_length + 1] := 0;
+@z
+
+@x [61] (add_area) Delete this print of name_of_file as well.
+if (name_length + length(area) > file_name_size) then
+ begin
+ print ('File=');
+ print_pool_str (area); print (name_of_file,',');
+ file_nm_size_overflow;
+ end;
+@y
+@z
+
+@x [65] hash_base and hash_max are now Pascal consts, instead of web macros.
+@d hash_base = empty + 1 {lowest numbered hash-table location}
+@d hash_max = hash_base + hash_size - 1 {highest numbered hash-table location}
+@y
+@z
+@x
+@!hash_used : hash_base..hash_max+1; {allocation pointer for hash table}
+@y
+@!hash_used : hash_base..hash_maxp1; {allocation pointer for hash table}
+@z
+
+@x [68] This is const now.
+@d max_hash_value = hash_prime+hash_prime-2+127 {|h|'s maximum value}
+@y
+@z
+
+@x [77] C strings start at zero instead of one.
+for i:=1 to len do
+ buffer[i] := xord[pds[i]];
+@y
+for i:=1 to len do
+ buffer[i] := xord[pds[i-1]];
+@z
+
+@x [97] Can't do this tangle-time arithmetic with file_name_size.
+@!aux_name_length : 0..file_name_size+1; {\.{.aux} name sans extension}
+@y
+@!aux_name_length : integer;
+@z
+
+@x [100] Reading the aux file name and command-line processing.
+This procedure consists of a loop that reads and processes a (nonnull)
+\.{.aux} file name. It's this module and the next two that must be
+changed on those systems using command-line arguments. Note: The
+|term_out| and |term_in| files are system dependent.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure get_the_top_level_aux_file_name;
+label aux_found,@!aux_not_found;
+var @<Variables for possible command-line processing@>@/
+begin
+check_cmnd_line := false; {many systems will change this}
+loop
+ begin
+ if (check_cmnd_line) then
+ @<Process a possible command line@>
+ else
+ begin
+ write (term_out,'Please type input file name (no extension)--');
+ if (eoln(term_in)) then {so the first |read| works}
+ read_ln (term_in);
+ aux_name_length := 0;
+ while (not eoln(term_in)) do
+ begin
+ if (aux_name_length = file_name_size) then
+ begin
+ while (not eoln(term_in)) do {discard the rest of the line}
+ get(term_in);
+ sam_you_made_the_file_name_too_long;
+ end;
+ incr(aux_name_length);
+ name_of_file[aux_name_length] := term_in^;
+ get(term_in);
+ end;
+ end;
+ @<Handle this \.{.aux} name@>;
+aux_not_found:
+ check_cmnd_line := false;
+ end;
+aux_found: {now we're ready to read the \.{.aux} file}
+end;
+@y
+@<Procedures and functions for the reading and processing of input files@>=
+procedure get_the_top_level_aux_file_name;
+label aux_found,@!aux_not_found;
+begin
+ @<Process a possible command line@>
+ {Leave room for the \.., the extension, the junk byte at the
+ beginning, and the null byte at the end.}
+ name_of_file := xmalloc_array (ASCII_code, strlen (cmdline (optind)) + 5);
+ strcpy (stringcast(name_of_file + 1), cmdline (optind));
+ aux_name_length := strlen (stringcast(name_of_file + 1));
+ @<Handle this \.{.aux} name@>;
+aux_not_found: uexit (1);
+aux_found: {now we're ready to read the \.{.aux} file}
+end;
+@z
+
+% [101] Don't need this variable; we use argc to check if we have a
+% command line.
+@x
+@<Variables for possible command-line processing@>=
+@!check_cmnd_line : boolean; {|true| if we're to check the command line}
+@y
+@z
+
+@x [102] Get the aux file name from the command line.
+@<Process a possible command line@>=
+begin
+do_nothing; {the ``default system'' doesn't use the command line}
+end
+@y
+@<Process a possible command line@>=
+kpse_set_progname (argv[0]);
+parse_arguments;
+@z
+
+% [106] Don't use a path to find the aux file, and don't add the
+% extension if it's already there.
+@x
+add_extension (s_aux_extension); {this also sets |name_length|}
+aux_ptr := 0; {initialize the \.{.aux} file stack}
+if (not a_open_in(cur_aux_file)) then
+ sam_you_made_the_file_name_wrong;
+@y
+if (name_length < 4) or
+ (strcmp (stringcast(name_of_file + 1 + name_length - 4), '.aux') <> 0)
+then
+ add_extension (s_aux_extension) {this also sets |name_length|}
+else
+ aux_name_length := aux_name_length - 4; {set to length without \.{.aux}}
+aux_ptr := 0; {initialize the \.{.aux} file stack}
+if (not a_open_in(cur_aux_file,no_file_path)) then
+ sam_you_made_the_file_name_wrong;
+@z
+
+@x [108] Add log_pr_aux_name.
+procedure print_aux_name;
+begin
+print_pool_str (cur_aux_str);
+print_newline;
+end;
+@y
+procedure print_aux_name;
+begin
+print_pool_str (cur_aux_str);
+print_newline;
+end;
+@#
+procedure log_pr_aux_name;
+begin
+log_pr_pool_str (cur_aux_str);
+log_pr_newline;
+end;
+@z
+
+@x [110] Be silent unless verbose.
+print ('The top-level auxiliary file: ');
+print_aux_name;
+@y
+if verbose then begin
+ print ('The top-level auxiliary file: ');
+ print_aux_name;
+end
+else begin
+ log_pr ('The top-level auxiliary file: ');
+ log_pr_aux_name;
+end;
+@z
+
+@x [117] bib_list is dynamically allocated.
+@!bib_list : array[bib_number] of str_number; {the \.{.bib} file list}
+@y
+@!bib_list : ^str_number; {the \.{.bib} file list}
+@z
+@x [still 117] bib_file also.
+@!bib_file : array[bib_number] of alpha_file; {corresponding |file| variables}
+@y
+@!bib_file : ^alpha_file; {corresponding |file| variables}
+@z
+
+@x [118] max_bib_files is a variable now, so can't be used as a const.
+@!bib_number = 0..max_bib_files; {gives the |bib_list| range}
+@y
+@!bib_number = integer; {gives the |bib_list| range}
+@z
+
+@x [121] Add log_pr_bib_name.
+procedure print_bib_name;
+begin
+print_pool_str (cur_bib_str);
+print_pool_str (s_bib_extension);
+print_newline;
+end;
+@y
+procedure print_bib_name;
+begin
+print_pool_str (cur_bib_str);
+print_pool_str (s_bib_extension);
+print_newline;
+end;
+@#
+procedure log_pr_bib_name;
+begin
+log_pr_pool_str (cur_bib_str);
+log_pr_pool_str (s_bib_extension);
+log_pr_newline;
+end;
+@z
+
+@x [123] Reallocate when we run out of bib files.
+ overflow('number of database files ',max_bib_files);
+@y
+begin
+ BIB_XRETALLOC ('bib_list', bib_list, str_number, max_bib_files,
+ max_bib_files + MAX_BIB_FILES);
+ {Already increased |max_bib_files|, so don't need to do it again.}
+ BIB_XRETALLOC ('bib_file', bib_file, alpha_file, max_bib_files,
+ max_bib_files);
+ BIB_XRETALLOC ('s_preamble', s_preamble, str_number, max_bib_files,
+ max_bib_files);
+end;
+@z
+
+@x [still 123] Use BIBINPUTS to search for the .bib file.
+add_extension (s_bib_extension);
+if (not a_open_in(cur_bib_file)) then
+ begin
+ add_area (s_bib_area);
+ if (not a_open_in(cur_bib_file)) then
+ open_bibdata_aux_err ('I couldn''t open database file ');
+ end;
+@y
+if (not a_open_in(cur_bib_file, kpse_bib_format)) then
+ open_bibdata_aux_err ('I couldn''t open database file ');
+@z
+
+@x [127] Use BSTINPUTS/TEXINPUTS to search for .bst files.
+add_extension (s_bst_extension);
+if (not a_open_in(bst_file)) then
+ begin
+ add_area (s_bst_area);
+ if (not a_open_in(bst_file)) then
+ begin
+ print ('I couldn''t open style file ');
+ print_bst_name;@/
+ bst_str := 0; {mark as unused again}
+ aux_err_return;
+ end;
+ end;
+@y
+if (not a_open_in(bst_file, kpse_bst_format)) then
+ begin
+ print ('I couldn''t open style file ');
+ print_bst_name;@/
+ bst_str := 0; {mark as unused again}
+ aux_err_return;
+ end;
+@z
+
+@x [127] Be silent unless verbose.
+print ('The style file: ');
+print_bst_name;
+@y
+if verbose then begin
+ print ('The style file: ');
+ print_bst_name;
+end
+else begin
+ log_pr ('The style file: ');
+ log_pr_bst_name;
+end;
+@z
+
+@x [128] Add log_pr_bst_name.
+procedure print_bst_name;
+begin
+print_pool_str (bst_str);
+print_pool_str (s_bst_extension);
+print_newline;
+end;
+@y
+procedure print_bst_name;
+begin
+print_pool_str (bst_str);
+print_pool_str (s_bst_extension);
+print_newline;
+end;
+@#
+procedure log_pr_bst_name;
+begin
+log_pr_pool_str (bst_str);
+log_pr_pool_str (s_bst_extension);
+log_pr_newline;
+end;
+@z
+
+% [141] Don't pad with blanks.
+% Don't use a path to search for subsidiary aux files, either.
+@x
+while (name_ptr <= file_name_size) do {pad with blanks}
+ begin
+ name_of_file[name_ptr] := ' ';
+ incr(name_ptr);
+ end;
+if (not a_open_in(cur_aux_file)) then
+@y
+name_of_file[name_ptr] := 0;
+if (not a_open_in(cur_aux_file, no_file_path)) then
+@z
+
+% [151] This goto gets turned into a setjmp/longjmp by ./convert --
+% unfortunately, it is a nonlocal goto. ekrell@ulysses.att.com
+% implemented the conversion.
+@x
+buf_ptr2 := last; {to get the first input line}
+loop
+ begin
+ if (not eat_bst_white_space) then {the end of the \.{.bst} file}
+ goto bst_done;
+ get_bst_command_and_process;
+ end;
+bst_done: a_close (bst_file);
+@y
+buf_ptr2 := last; {to get the first input line}
+hack1;
+ begin
+ if (not eat_bst_white_space) then {the end of the \.{.bst} file}
+ hack2;
+ get_bst_command_and_process;
+ end;
+bst_done: a_close (bst_file);
+@z
+
+% max_ent_ints, max_ent_strs, max_fields are no longer const.
+@x [160] quote_next_fn and end_of_def are Pascal consts, instead of web macros.
+@d quote_next_fn = hash_base - 1 {special marker used in defining functions}
+@d end_of_def = hash_max + 1 {another such special marker}
+
+@<Types in the outer block@>=
+@!fn_class = 0..last_fn_class; {the \.{.bst} function classes}
+@!wiz_fn_loc = 0..wiz_fn_space; {|wiz_defined|-function storage locations}
+@!int_ent_loc = 0..max_ent_ints; {|int_entry_var| storage locations}
+@!str_ent_loc = 0..max_ent_strs; {|str_entry_var| storage locations}
+@!str_glob_loc = 0..max_glb_str_minus_1; {|str_global_var| storage locations}
+@!field_loc = 0..max_fields; {individual field storage locations}
+@y
+@<Types in the outer block@>=
+@!fn_class = 0..last_fn_class; {the \.{.bst} function classes}
+@!wiz_fn_loc = integer; {|wiz_defined|-function storage locations}
+@!int_ent_loc = integer; {|int_entry_var| storage locations}
+@!str_ent_loc = integer; {|str_entry_var| storage locations}
+@!str_glob_loc = 0..max_glb_str_minus_1; {|str_global_var| storage locations}
+@!field_loc = integer; {individual field storage locations}
+@z
+
+@x [161] Dynamically allocate wiz_functions.
+@!wiz_functions : packed array[wiz_fn_loc] of hash_ptr2;
+@y
+@!wiz_functions : ^hash_ptr2;
+@z
+
+% [still 161] Convert entry_ints and entry_strs to dynamically-allocated
+% one-dimensional arrays; too bad C and Pascal lag Fortran in supporting
+% run-time dimensioning of multidimensional arrays. Other changes that
+% follow this one will convert every reference to entry_strs[p][q] to
+% x_entry_strs(p)(q), the equivalent of entry_strs[p*(ent_str_size+1) +
+% q], but hidden inside a macro to mask the addressing computation.
+% Although WEB does not have multi-argument macros, webman.tex shows how
+% to get the equivalent effect.
+@x
+@!entry_ints : array[int_ent_loc] of integer;
+@!num_ent_ints : int_ent_loc; {the number of distinct |int_entry_var| names}
+@!str_ent_ptr : str_ent_loc; {general |str_entry_var| location}
+@!entry_strs : array[str_ent_loc] of
+ packed array[0..ent_str_size] of ASCII_code;
+@y
+@!entry_ints : ^integer; {dynamically-allocated array}
+@!num_ent_ints : int_ent_loc; {the number of distinct |int_entry_var| names}
+@!str_ent_ptr : str_ent_loc; {general |str_entry_var| location}
+@!entry_strs : ^ASCII_code; {dynamically-allocated array}
+@z
+
+@x [still 161] Dynamically allocate field_info.
+@!field_info : packed array[field_loc] of str_number;
+@y
+@!field_info : ^str_number;
+@z
+
+@x [198] A variable named `int' is no good in C.
+@<Procedures and functions for handling numbers, characters, and strings@>=
+@y
+@d int == the_int
+@<Procedures and functions for handling numbers, characters, and strings@>=
+@z
+
+@x [200] Reallocate if out of wizard space.
+if (single_ptr + wiz_def_ptr > wiz_fn_space) then
+ begin
+ print (single_ptr + wiz_def_ptr : 0,': ');
+ overflow('wizard-defined function space ',wiz_fn_space);
+ end;
+@y
+if (single_ptr + wiz_def_ptr > wiz_fn_space) then
+ begin
+ BIB_XRETALLOC ('wiz_functions', wiz_functions, hash_ptr2,
+ wiz_fn_space, wiz_fn_space + WIZ_FN_SPACE);
+ end;
+@z
+
+@x [219] undefined is now a Pascal const, instead of a web macro
+@d undefined = hash_max + 1 {a special marker used for |type_list|}
+@y
+@z
+
+@x [223] Be silent unless verbose.
+ print ('Database file #',bib_ptr+1:0,': ');
+ print_bib_name;@/
+@y
+ if verbose then begin
+ print ('Database file #',bib_ptr+1:0,': ');
+ print_bib_name;
+ end
+ else begin
+ log_pr ('Database file #',bib_ptr+1:0,': ');
+ log_pr_bib_name;
+ end;
+@z
+
+@x [226] Reallocate if out of fields.
+procedure check_field_overflow (@!total_fields : integer);
+begin
+if (total_fields > max_fields) then
+ begin
+ print_ln (total_fields:0,' fields:');
+ overflow('total number of fields ',max_fields);
+@y
+procedure check_field_overflow (@!total_fields : integer);
+var @!f_ptr: field_loc;
+ @!start_fields: field_loc;
+begin
+if (total_fields > max_fields) then
+ begin
+ start_fields := max_fields;
+ BIB_XRETALLOC ('field_info', field_info, str_number, max_fields,
+ total_fields + MAX_FIELDS);
+ {Initialize to |missing|.}
+ for f_ptr := start_fields to max_fields - 1 do begin
+ field_info[f_ptr] := missing;
+ end;
+@z
+
+@x [242] Reallocate when we run out of s_preamble's.
+ bib_err ('You''ve exceeded ',max_bib_files:0,' preamble commands');
+@y
+begin
+ BIB_XRETALLOC ('bib_list', bib_list, str_number, max_bib_files,
+ max_bib_files + MAX_BIB_FILES);
+ {Already increased |max_bib_files|, so don't need to do it again.}
+ BIB_XRETALLOC ('bib_file', bib_file, alpha_file, max_bib_files,
+ max_bib_files);
+ BIB_XRETALLOC ('s_preamble', s_preamble, str_number, max_bib_files,
+ max_bib_files);
+end;
+@z
+
+@x [263] Add check for fieldinfo[] overflow.
+field_ptr := entry_cite_ptr * num_fields + fn_info[field_name_loc];
+@y
+field_ptr := entry_cite_ptr * num_fields + fn_info[field_name_loc];
+if (field_ptr >= max_fields) then
+ confusion ('field_info index is out of range');
+@z
+
+@x [265] Fix bug in the add_database_cite procedure.
+check_field_overflow (num_fields*new_cite);
+@y
+check_field_overflow (num_fields*(new_cite+1));
+@z
+
+@x [277] Add check for fieldinfo[] overflow.
+@<Add cross-reference information@>=
+begin
+@y
+@<Add cross-reference information@>=
+begin
+if ((num_cites - 1) * num_fields + crossref_num >= max_fields) then
+ confusion ('field_info index is out of range');
+@z
+
+@x [279] Add check for fieldinfo[] overflow.
+@<Subtract cross-reference information@>=
+begin
+@y
+@<Subtract cross-reference information@>=
+begin
+if ((num_cites - 1) * num_fields + crossref_num >= max_fields) then
+ confusion ('field_info index is out of range');
+@z
+
+@x [285] Add check for fieldinfo[] overflow.
+@<Slide this cite key down to its permanent spot@>=
+begin
+@y
+@<Slide this cite key down to its permanent spot@>=
+begin
+if ((cite_xptr + 1) * num_fields > max_fields) then
+ confusion ('field_info index is out of range');
+@z
+
+@x [287] Reallocate on overflow.
+if (num_ent_ints*num_cites > max_ent_ints) then
+ begin
+ print (num_ent_ints*num_cites,': ');
+ overflow('total number of integer entry-variables ',max_ent_ints);
+ end;
+@y
+if (num_ent_ints*num_cites > max_ent_ints) then
+ BIB_XRETALLOC ('entry_ints', entry_ints, integer, max_ent_ints,
+ (num_ent_ints + 1) * (num_cites + 1));
+@z
+
+@x [288] Reallocate entry_strs.
+if (num_ent_strs*num_cites > max_ent_strs) then
+ begin
+ print (num_ent_strs*num_cites,': ');
+ overflow('total number of string entry-variables ',max_ent_strs);
+ end;
+@y
+{Have to include the maximum size of each string in the reallocation,
+ unfortunately, since we're faking a two-dimensional array. And then
+ decrease |max_ent_strs| again, because it's the number of strings, not
+ the number of characters (which is what we're allocating.)}
+if (num_ent_strs * num_cites > max_ent_strs) then begin
+ BIB_XRETALLOC ('entry_strs', entry_strs, ASCII_code, max_ent_strs,
+ (num_ent_strs + 1) * (num_cites + 1) * (ent_str_size + 1));
+ max_ent_strs := num_ent_strs * num_cites;
+ {The new values are initialized in the next few statements from
+ \.{bibtex.web}.}
+end;
+@z
+
+@x [288] Macroize entry_strs[][].
+ entry_strs[str_ent_ptr][0] := end_of_string;
+@y
+ x_entry_strs(str_ent_ptr)(0) := end_of_string;
+@z
+
+@x [301] Macroize entry_strs[][].
+ char1 := entry_strs[ptr1][char_ptr];
+ char2 := entry_strs[ptr2][char_ptr];
+@y
+ char1 := x_entry_strs(ptr1)(char_ptr);
+ char2 := x_entry_strs(ptr2)(char_ptr);
+@z
+
+% We shouldn't try to split a \% combo, as the result is an escaped % at
+% end-of-line, and a line beginning with a %, which leads to rest being
+% ignored. This is a special case of the general problem that we shouldn't
+% split macro invocations either -- however, the best way to avoid that is
+% not to split lines at all.
+@x [324] Check whether we're trying to break a \% combo.
+out_buf[end_ptr] := out_buf[max_print_line-1]; {save this character}
+out_buf[max_print_line-1] := comment; {so \TeX\ does the thing right}
+out_buf_length := max_print_line;
+break_ptr := out_buf_length - 1; {the `|-1|' allows for the restoration}
+output_bbl_line; {output what we can,}
+out_buf[max_print_line-1] := out_buf[end_ptr]; {restore this character}
+@y
+if out_buf[max_print_line-1] = comment then {assume \% combo here}
+ out_buf_length := max_print_line - 1
+else
+ out_buf_length := max_print_line;
+break_ptr := out_buf_length - 1; {the `|-1|' allows for the restoration}
+out_buf[end_ptr] := out_buf[break_ptr]; {save this character}
+out_buf[break_ptr] := comment; {so \TeX\ does the thing right}
+output_bbl_line; {output what we can,}
+out_buf[break_ptr] := out_buf[end_ptr]; {restore this character}
+@z
+
+@x [327] Add check for fieldinfo[] overflow.
+ field_ptr := cite_ptr*num_fields + fn_info[ex_fn_loc];
+@y
+ field_ptr := cite_ptr*num_fields + fn_info[ex_fn_loc];
+ if (field_ptr >= max_fields) then
+ confusion ('field_info index is out of range');
+@z
+
+@x [329] Macroize entry_strs[][]
+ while (entry_strs[str_ent_ptr][ex_buf_ptr] <> end_of_string) do
+ {copy characters into the buffer}
+ append_ex_buf_char (entry_strs[str_ent_ptr][ex_buf_ptr]);
+@y
+ while (x_entry_strs(str_ent_ptr)(ex_buf_ptr) <> end_of_string) do
+ {copy characters into the buffer}
+ append_ex_buf_char (x_entry_strs(str_ent_ptr)(ex_buf_ptr));
+@z
+
+@x [337] s_preamble is dynamically allocated.
+@!s_preamble : array[bib_number] of str_number;
+@y
+@!s_preamble : ^str_number;
+@z
+
+@x [344] Dynamic buf_size.
+@!name_tok : packed array[buf_pointer] of buf_pointer; {name-token ptr list}
+@!name_sep_char : packed array[buf_pointer] of ASCII_code; {token-ending chars}
+@y
+@!name_tok : ^buf_pointer; {name-token ptr list}
+@!name_sep_char : ^ASCII_code; {token-ending chars}
+@z
+
+@x [357] Macroize entry_strs[][].
+ while (sp_ptr < sp_xptr1) do
+ begin {copy characters into |entry_strs|}
+ entry_strs[str_ent_ptr][ent_chr_ptr] := str_pool[sp_ptr];
+ incr(ent_chr_ptr);
+ incr(sp_ptr);
+ end;
+ entry_strs[str_ent_ptr][ent_chr_ptr] := end_of_string;
+@y
+ while (sp_ptr < sp_xptr1) do
+ begin {copy characters into |entry_strs|}
+ x_entry_strs(str_ent_ptr)(ent_chr_ptr) := str_pool[sp_ptr];
+ incr(ent_chr_ptr);
+ incr(sp_ptr);
+ end;
+ x_entry_strs(str_ent_ptr)(ent_chr_ptr) := end_of_string;
+@z
+
+% [388] bibtex.web has mutually exclusive tests here; Oren said he
+% doesn't want to fix it until 1.0, since it's obviously of no practical
+% import (or someone would have found it before GCC 2 did). Changing
+% the second `and' to an `or' makes all but the last of multiple authors
+% be omitted in the bbl file, so I simply removed the statement.
+@x
+while ((ex_buf_xptr < ex_buf_ptr) and
+ (lex_class[ex_buf[ex_buf_ptr]] = white_space) and
+ (lex_class[ex_buf[ex_buf_ptr]] = sep_char)) do
+ incr(ex_buf_xptr); {this removes leading stuff}
+@y
+@z
+
+% [459] Eliminate unreferenced statement label, because `undefined' is
+% now a constant expression that is not evaluated at the Web level. If
+% this label were ever required, it could be replaced by the constant
+% 9997, which is not used as a statement label in BibTeX.
+@x
+ undefined : trace_pr ('unknown')
+@y
+ trace_pr ('unknown')
+@z
+
+@x [460] Macroize entry_strs[][].
+ while (entry_strs[str_ent_ptr][ent_chr_ptr] <> end_of_string) do
+ begin
+ trace_pr (xchr[entry_strs[str_ent_ptr][ent_chr_ptr]]);
+ incr(ent_chr_ptr);
+ end;
+@y
+ while (x_entry_strs(str_ent_ptr)(ent_chr_ptr) <> end_of_string) do
+ begin
+ trace_pr (xchr[x_entry_strs(str_ent_ptr)(ent_chr_ptr)]);
+ incr(ent_chr_ptr);
+ end;
+@z
+
+@x [462] Add check for fieldinfo[] overflow.
+ field_ptr := cite_ptr * num_fields;
+ field_end_ptr := field_ptr + num_fields;
+@y
+ field_ptr := cite_ptr * num_fields;
+ field_end_ptr := field_ptr + num_fields;
+ if (field_end_ptr > max_fields) then
+ confusion ('field_info index is out of range');
+@z
+
+@x [467] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \BibTeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 4; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('bibtex');
+
+ end else if argument_is ('min-crossrefs') then begin
+ min_crossrefs := atoi (optarg);
+
+ end else if argument_is ('help') then begin
+ usage_help (BIBTEX_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, 'Oren Patashnik', nil);
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one remaining argument.}
+ if (optind + 1 <> argc) then begin
+ write_ln (stderr, 'bibtex: Need exactly one file argument.');
+ usage ('bibtex');
+ end;
+end;
+
+@ Here is the first of the options we allow.
+@.-terse@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[0].name := 'terse';
+long_options[0].has_arg := 0;
+long_options[0].flag := address_of (verbose);
+long_options[0].val := 0;
+incr (current_option);
+
+@ The global variable |verbose| determines whether or not we print
+progress information.
+
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@ Start off |true|, to match the default behavior.
+
+@<Initialize the option...@> =
+verbose := true;
+
+@ Here is an option to change the minimum number of cross-refs required
+for automatic |cite_list| inclusion.
+@.-min-crossrefs@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'min-crossrefs';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@
+@<Glob...@> =
+@!min_crossrefs: integer;
+
+@ Set |min_crossrefs| to two by default, so we match the
+documentation (\.{btxdoc.tex}).
+
+@<Initialize the option...@> =
+min_crossrefs := 2;
+
+@ One of the standard options.
+@.-help@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/bibtex.rc b/Build/source/texk/web2c/bibtex.rc
new file mode 100644
index 00000000000..8df4eddee94
--- /dev/null
+++ b/Build/source/texk/web2c/bibtex.rc
@@ -0,0 +1,34 @@
+/* bibtex.rc: bibtex resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR "BibTeX 0.99c"
+
+#define VER_INTERNALNAME_STR "bibtex"
+#define VER_ORIGINALFILENAME_STR "bibtex.exe"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1985 by Oren Patashnik; all rights reserved."
+
+#define VER_FILEDESCRIPTION_STR "BibTeX"
+
+#include <texlive.version>
+
+/* bibtex.rc ends here */
diff --git a/Build/source/texk/web2c/bibtex.web b/Build/source/texk/web2c/bibtex.web
new file mode 100644
index 00000000000..e465a33c48d
--- /dev/null
+++ b/Build/source/texk/web2c/bibtex.web
@@ -0,0 +1,11652 @@
+% This program is copyright (C) 1985 by Oren Patashnik; all rights reserved.
+% Copying of this file is authorized only if (1) you are Oren Patashnik, or if
+% (2) you make absolutely no changes to your copy. (The WEB system provides
+% for alterations via an auxiliary file; the master file should stay intact.)
+% See Appendix H of the WEB manual for hints on how to install this program.
+
+% Version 0.98f was released in March 1985.
+% Version 0.98g was released in April; it removed some system dependencies
+% (introducing term_in and term_out in place of just tty, and removing
+% some nonlocal goto's) and it gave context for certain parsing errors.
+% Version 0.98h was released in April; it patched a bug in the output
+% line-breaking routine that can arise with some nonstandard style files.
+% Version 0.98i was released in May; its main change split up the main program
+% and some procedures to help certain compilers cope with size
+% limitations, among other things changing error and warning macros so
+% they'd produce (much) less inline code; it also redefined the class of
+% legal style-file identifiers---although this affects only the bizarre
+% ones, it makes BibTeX's error messages more coherent; and it had many
+% minor changes, including about a 15% speed-up on TOPS-20.
+% Version 0.99a was released in January 1988. Its main changes: allowed the
+% inclusion of entire .bib files (rather than just those entries
+% \cited or \nocited); made the sorting algorithm stable; eliminated
+% any case conversion for file names; allowed concatenation in database
+% fields and string definitions; handled hyphenated names properly;
+% handled accented characters properly; implemented new empty$,
+% preamble$, text.length$, text.prefix$, and warning$ built-in functions;
+% allowed a new cross-referencing feature; and made many minor fixes,
+% including about a 40% speed-up on TOPS-20.
+% Version 0.99b was released in February 1988. It changed text.length$ and
+% text.prefix$ to not count braces as text characters, and it changed
+% text.prefix$ to add any necessary matching right braces.
+% Version 0.99c was released in February 1988. It removed two begin-end pairs
+% that, for convention only, surrounded entire modules, but that elicited
+% label-related complaints from some compilers.
+
+% Please report any bugs to Oren Patashnik (PATASHNIK@@SCORE.STANFORD.EDU)
+
+% Although considerable effort has been expended to make the BibTeX program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software.
+
+% This program was written by Oren Patashnik, in consultation with Leslie
+% Lamport, to be used with Lamport's LaTeX document preparation system.
+% Some modules were taken from Knuth's TeX and TeXware with his permission.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\def\PASCAL{{\mc PASCAL}}
+\def\ph{{\mc PASCAL-H}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+% Note: WEAVE will typeset an upper-case `E' in a PASCAL identifier a
+% bit strangely so that the `TeX' in the name of this program is typeset
+% correctly; if this becomes a problem remove these three lines to get
+% normal upper-case `E's in PASCAL identifiers
+\def\drop{\kern-.1667em\lower.5ex\hbox{E}\kern-.125em} % middle of TeX
+\catcode`E=13 \uppercase{\def E{e}}
+\def\\#1{\hbox{\let E=\drop\it#1\/\kern.05em}} % italic type for identifiers
+
+\font\sc=cmcsc10
+
+\def\BibTeX{{\rm B\kern-.05em{\sc i\kern-.025em b}\kern-.08em
+ T\kern-.1667em\lower.7ex\hbox{E}\kern-.125emX}}
+
+\def\LaTeX{{\rm L\kern-.36em\raise.3ex\hbox{\sc a}\kern-.15em
+ T\kern-.1667em\lower.7ex\hbox{E}\kern-.125emX}}
+
+\def\title{\BibTeX\ }
+\def\today{\ifcase\month\or
+ January\or February\or March\or April\or May\or June\or
+ July\or August\or September\or October\or November\or December\fi
+ \space\number\day, \number\year}
+\def\topofcontents{\null\vfill
+ \def\titlepage{F}
+ \centerline{\:\titlefont The {\:\ttitlefont \BibTeX} preprocessor}
+ \vskip 15pt \centerline{(Version 0.99c---\today)} \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+
+
+@* Introduction.
+@^documentation@>
+@^space savings@>
+@^system dependencies@>
+@^wizard@>
+@!@:BibTeX}{\BibTeX@>
+@!@:BibTeX documentation}{\BibTeX\ documentation@>
+@:LaTeX}{\LaTeX@>
+\BibTeX\ is a preprocessor (with elements of postprocessing as
+explained below) for the \LaTeX\ document-preparation system. It
+handles most of the formatting decisions required to produce a
+reference list, outputting a \.{.bbl} file that a user can edit to add
+any finishing touches \BibTeX\ isn't designed to handle (in practice,
+such editing almost never is needed); with this file \LaTeX\ actually
+produces the reference list.
+
+Here's how \BibTeX\ works. It takes as input (a)~an \.{.aux} file
+produced by \LaTeX\ on an earlier run; (b)~a \.{.bst} file (the style
+file), which specifies the general reference-list style and specifies
+how to format individual entries, and which is written by a style
+designer (called a wizard throughout this program) in a
+special-purpose language described in the \BibTeX\ documentation---see
+the file {\.{btxdoc.tex}}; and (c)~\.{.bib} file(s) constituting a
+database of all reference-list entries the user might ever hope to
+use. \BibTeX\ chooses from the \.{.bib} file(s) only those entries
+specified by the \.{.aux} file (that is, those given by \LaTeX's
+\.{\\cite} or \.{\\nocite} commands), and creates as output a \.{.bbl}
+file containing these entries together with the formatting commands
+specified by the \.{.bst} file (\BibTeX\ also creates a \.{.blg} log
+file, which includes any error or warning messages, but this file
+isn't used by any program). \LaTeX\ will use the \.{.bbl} file,
+perhaps edited by the user, to produce the reference list.
+
+Many modules of \BibTeX\ were taken from Knuth's \TeX\ and \TeX ware,
+with his permission. All known system-dependent modules are marked in
+the index entry ``system dependencies''; Dave Fuchs helped exorcise
+unwanted ones. In addition, a few modules that can be changed to make
+\BibTeX\ smaller are marked in the index entry ``space savings''.
+
+Megathanks to Howard Trickey, for whose suggestions future users and
+style writers would be eternally grateful, if only they knew.
+
+The |banner| string defined here should be changed whenever \BibTeX\
+gets modified.
+
+@d banner=='This is BibTeX, Version 0.99c' {printed when the program starts}
+
+
+@
+@^system dependencies@>
+Terminal output goes to the file |term_out|, while terminal input
+comes from |term_in|. On our system, these (system-dependent) files
+are already opened at the beginning of the program, and have the same
+real name.
+
+@d term_out == tty
+@d term_in == tty
+
+
+@
+@^system dependencies@>
+This program uses the term |print| instead of |write| when writing on
+both the |log_file| and (system-dependent) |term_out| file, and it
+uses |trace_pr| when in |trace| mode, for which it writes on just the
+|log_file|. If you want to change where either set of macros writes
+to, you should also change the other macros in this program for that
+set; each such macro begins with |print_| or |trace_pr_|.
+
+@d print(#) == begin write(log_file,#); write(term_out,#); end
+@d print_ln(#) == begin write_ln(log_file,#); write_ln(term_out,#); end
+@d print_newline == print_a_newline
+ {making this a procedure saves a little space}
+@#
+@d trace_pr(#) == begin write(log_file,#); end
+@d trace_pr_ln(#) == begin write_ln(log_file,#); end
+@d trace_pr_newline == begin write_ln(log_file); end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_a_newline;
+begin
+write_ln(log_file);
+write_ln(term_out);
+end;
+
+
+@
+@^debugging@>
+@^statistics@>
+Some of the code below is intended to be used only when diagnosing the
+strange behavior that sometimes occurs when \BibTeX\ is being
+installed or when system wizards are fooling around with \BibTeX\
+without quite knowing what they are doing. Such code will not normally
+be compiled; it is delimited by the codewords
+`$|debug|\ldots|gubed|$', with apologies to people who wish to
+preserve the purity of English. Similarly, there is some conditional
+code delimited by `$|stat|\ldots|tats|$' that is intended only for use
+when statistics are to be kept about \BibTeX's memory/cpu usage,
+and there is conditional code delimited by `$|trace|\ldots|ecart|$'
+that is intended to be a trace facility for use mainly when debugging
+\.{.bst} files.
+
+@d debug == @{ { remove the `|@{|' when debugging }
+@d gubed == @t@>@} { remove the `|@}|' when debugging }
+@f debug == begin
+@f gubed == end
+@#
+@d stat == @{ { remove the `|@{|' when keeping statistics }
+@d tats == @t@>@} { remove the `|@}|' when keeping statistics }
+@f stat == begin
+@f tats == end
+@#
+@d trace == @{ { remove the `|@{|' when in |trace| mode }
+@d ecart == @t@>@} { remove the `|@}|' when in |trace| mode }
+@f trace == begin
+@f ecart == end
+
+
+@
+@^system dependencies@>
+We assume that |case| statements may include a
+default case that applies if no matching label is found,
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the \ph\
+compiler allows `|others|:' as a default label, and other \PASCAL s allow
+syntaxes like `\ignorespaces|else|\unskip' or `\\{otherwise}' or
+`\\{otherwise}:', etc. The definitions of |othercases| and |endcases|
+should be changed to agree with local conventions. Note that no semicolon
+appears before |endcases| in this program, so the definition of |endcases|
+should include a semicolon if the compiler wants one. (Of course, if no
+default mechanism is available, the |case| statements of \BibTeX\ will have
+to be laboriously extended by listing all remaining cases. People who are
+stuck with such \PASCAL s have in fact done this, successfully but not
+happily!)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+
+@
+Labels are given symbolic names by the following definitions, so that
+occasional |goto| statements will be meaningful. We insert the label
+`|exit|:' just before the `\ignorespaces|end|\unskip' of a procedure
+in which we have used the `|return|' statement defined below (and this
+is the only place `|exit|:' appears). This label is sometimes used
+for exiting loops that are set up with the |loop| construction defined
+below. Another generic label is `|loop_exit|:'; it appears
+immediately after a loop.
+
+Incidentally, this program never declares a label that isn't actually used,
+because some fussy \PASCAL\ compilers will complain about redundant labels.
+
+@d exit=10 {go here to leave a procedure}
+@d loop_exit=15 {go here to leave a loop within a procedure}
+@d loop1_exit=16 {the first generic label for a procedure with two}
+@d loop2_exit=17 {the second}
+
+
+@
+@^for loops@>
+And |while| we're discussing loops: This program makes into |while|
+loops many that would otherwise be |for| loops because of Standard
+\PASCAL\ limitations (it's a bit complicated---standard \PASCAL\
+doesn't allow a global variable as the index of a |for| loop inside a
+procedure; furthermore, many compilers have fairly severe limitations
+on the size of a block, including the main block of the program; so
+most of the code in this program occurs inside procedures, and since
+for other reasons this program must use primarily global variables, it
+doesn't use many |for| loops).
+
+
+@
+@^program conventions@>
+This program uses this convention: If there are several quantities in
+a boolean expression, they are ordered by expected frequency (except
+perhaps when an error message results) so that execution will be
+fastest; this is more an attempt to understand the program than to
+make it faster.
+
+
+@
+Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@f loop == xclause
+ {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@d empty=0 {symbolic name for a null constant}
+@d any_value=0 {this appeases \PASCAL's boolean-evaluation scheme}
+
+
+
+@* The main program.
+@^system dependencies@>
+@:LaTeX}{\LaTeX@>
+This program first reads the \.{.aux} file that \LaTeX\ produces,
+(\romannumeral1) determining which \.{.bib} file(s) and \.{.bst} file
+to read and (\romannumeral2) constructing a list of cite keys in order
+of occurrence. The \.{.aux} file may have other \.{.aux} files nested
+within. Second, it reads and executes the \.{.bst} file,
+(\romannumeral1) determining how and in which order to process the
+database entries in the \.{.bib} file(s) corresponding to those cite
+keys in the list (or in some cases, to all the entries in the \.{.bib}
+file(s)), (\romannumeral2) determining what text to be output for each
+entry and determining any additional text to be output, and
+(\romannumeral3) actually outputting this text to the \.{.bbl} file.
+In addition, the program sends error messages and other remarks to the
+|log_file| and terminal.
+
+@d close_up_shop=9998 {jump here after fatal errors}
+@d exit_program=9999 {jump here if we couldn't even get started}
+
+@p
+@t\4@>@<Compiler directives@>@/
+program BibTEX; {all files are opened dynamically}
+label close_up_shop,@!exit_program @<Labels in the outer block@>;
+const @<Constants in the outer block@>
+type @<Types in the outer block@>
+var @<Globals in the outer block@>@;
+@<Procedures and functions for about everything@>@;
+@<The procedure |initialize|@>
+@#
+begin
+initialize;
+print_ln(banner);@/
+@<Read the \.{.aux} file@>;
+@<Read and execute the \.{.bst} file@>;
+close_up_shop:
+@<Clean up and leave@>;
+exit_program:
+end.
+
+
+@
+@^overflow in arithmetic@>
+@^system dependencies@>
+If the first character of a \PASCAL\ comment is a dollar sign,
+\ph\ treats the comment as a list of ``compiler directives'' that will
+affect the translation of this program into machine language. The
+directives shown below specify full checking and inclusion of the \PASCAL\
+debugger when \BibTeX\ is being debugged,
+but they cause range checking and other
+redundant code to be eliminated when the production system is being generated.
+Arithmetic overflow will be detected in all cases.
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+
+@
+@^bottom up@>
+@^gymnastics@>
+@^mooning@>
+All procedures in this program (except for |initialize|) are grouped
+into one of the seven classes below, and these classes are dispersed
+throughout the program. However: Much of this program is written top
+down, yet \PASCAL\ wants its procedures bottom up. Since mooning is
+neither a technically nor a socially acceptable solution to the
+bottom-up problem, this section instead performs the topological
+gymnastics that \.{WEB} allows, ordering these classes to satisfy
+\PASCAL\ compilers. There are a few procedures still out of place
+after this ordering, though, and the other modules that complete the
+task have ``gymnastics'' as an index entry.
+
+@<Procedures and functions for about everything@>=
+@<Procedures and functions for all file I/O, error messages, and such@>@;
+@<Procedures and functions for file-system interacting@>@;
+@<Procedures and functions for handling numbers, characters, and strings@>@;
+@<Procedures and functions for input scanning@>@;
+@<Procedures and functions for name-string processing@>@;
+@<Procedures and functions for style-file function execution@>@;
+@<Procedures and functions for the reading and processing of input files@>
+
+
+@
+This procedure gets things started properly.
+
+@<The procedure |initialize|@>=
+procedure initialize;
+var @<Local variables for initialization@>
+begin
+@<Check the ``constant'' values for consistency@>;
+if (bad > 0) then
+ begin
+ write_ln (term_out,bad:0,' is a bad bad');
+ goto exit_program;
+ end;
+@<Set initial values of key variables@>;
+pre_def_certain_strings;@/
+get_the_top_level_aux_file_name;
+end;
+
+
+@
+@^space savings@>
+@^system dependencies@>
+These parameters can be changed at compile time to extend or reduce
+\BibTeX's capacity. They are set to accommodate about 750 cites when
+used with the standard styles, although |pool_size| is usually the
+first limitation to be a problem, often when there are 500 cites.
+
+@<Constants in the outer block@>=
+@!buf_size=1000; {maximum number of characters in an input line (or string)}
+@!min_print_line=3; {minimum \.{.bbl} line length: must be |>=3|}
+@!max_print_line=79; {the maximum: must be |>min_print_line| and |<buf_size|}
+@!aux_stack_size=20; {maximum number of simultaneous open \.{.aux} files}
+@!max_bib_files=20; {maximum number of \.{.bib} files allowed}
+@!pool_size=65000; {maximum number of characters in strings}
+@!max_strings=4000; {maximum number of strings, including pre-defined;
+ must be |<=hash_size|}
+@!max_cites=750; {maximum number of distinct cite keys; must be
+ |<=max_strings|}
+@!min_crossrefs=2; {minimum number of cross-refs required for automatic
+ |cite_list| inclusion}
+@!wiz_fn_space=3000; {maximum amount of |wiz_defined|-function space}
+@!single_fn_space=100; {maximum amount for a single |wiz_defined|-function}
+@!max_ent_ints=3000; {maximum number of |int_entry_var|s
+ (entries $\times$ |int_entry_var|s)}
+@!max_ent_strs=3000; {maximum number of |str_entry_var|s
+ (entries $\times$ |str_entry_var|s)}
+@!ent_str_size=100; {maximum size of a |str_entry_var|; must be |<=buf_size|}
+@!glob_str_size=1000; {maximum size of a |str_global_var|;
+ must be |<=buf_size|}
+@!max_fields=17250; {maximum number of fields (entries $\times$ fields,
+ about |23*max_cites| for consistency)}
+@!lit_stk_size=100; {maximum number of literal functions on the stack}
+
+
+@
+@^space savings@>
+@^system dependencies@>
+These parameters can also be changed at compile time, but they're
+needed to define some \.{WEB} numeric macros so they must be so
+defined themselves.
+
+@d hash_size=5000 {must be |>= max_strings| and |>= hash_prime|}
+@d hash_prime=4253 {a prime number about 85\% of |hash_size| and |>= 128|
+ and |< @t$2^{14}-2^6$@>|}
+@d file_name_size=40 {file names shouldn't be longer than this}
+@d max_glob_strs=10 {maximum number of |str_global_var| names}
+@d max_glb_str_minus_1 = max_glob_strs-1 {to avoid wasting a |str_global_var|}
+
+
+@
+In case somebody has inadvertently made bad settings of the ``constants,''
+\BibTeX\ checks them using a global variable called |bad|.
+
+This is the first of many sections of \BibTeX\ where global variables are
+defined.
+
+@<Globals in the outer block@>=
+@!bad:integer; {is some ``constant'' wrong?}
+
+
+@
+Each digit-value of |bad| has a specific meaning.
+
+@<Check the ``constant'' values for consistency@>=
+bad := 0;
+if (min_print_line < 3) then bad:=1;
+if (max_print_line <= min_print_line) then bad:=10*bad+2;
+if (max_print_line >= buf_size) then bad:=10*bad+3;
+if (hash_prime < 128) then bad:=10*bad+4;
+if (hash_prime > hash_size) then bad:=10*bad+5;
+if (hash_prime >= (16384-64)) then bad:=10*bad+6;
+if (max_strings > hash_size) then bad:=10*bad+7;
+if (max_cites > max_strings) then bad:=10*bad+8;
+if (ent_str_size > buf_size) then bad:=10*bad+9;
+if (glob_str_size > buf_size) then bad:=100*bad+11;
+ {well, almost each}
+
+
+@
+A global variable called |history| will contain one of four values at
+the end of every run: |spotless| means that no unusual messages were
+printed; |warning_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means
+that at least one error was found; |fatal_message| means that the
+program terminated abnormally. The value of |history| does not
+influence the behavior of the program; it is simply computed for the
+convenience of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d warning_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure mark_warning;
+begin
+if (history = warning_message) then
+ incr(err_count)
+ else if (history = spotless) then
+ begin
+ history := warning_message;
+ err_count := 1;
+ end;
+end;
+@#
+procedure mark_error;
+begin
+if (history < error_message) then
+ begin
+ history := error_message;
+ err_count := 1;
+ end
+ else {|history = error_message|}
+ incr(err_count);
+end;
+@#
+procedure mark_fatal;
+begin
+history := fatal_message;
+end;
+
+
+@
+For the two states |warning_message| and |error_message| we keep track
+of the number of messages given; but since |warning_message|s aren't
+so serious, we ignore them once we've seen an |error_message|. Hence
+we need just the single variable |err_count| to keep track.
+
+
+@<Globals in the outer block@>=
+@!history:spotless..fatal_message; {how bad was this run?}
+@!err_count:integer;
+
+
+@
+The |err_count| gets set or reset when |history| first changes to
+|warning_message| or |error_message|, so we don't need to initialize
+it.
+
+@<Set initial values of key variables@>=
+history := spotless;
+
+
+
+@* The character set.
+@^ASCII code@>
+(The following material is copied (almost) verbatim from \TeX.
+Thus, the same system-dependent changes should be made to both programs.)
+
+In order to make \TeX\ readily portable between a wide variety of
+computers, all of its input text is converted to an internal seven-bit
+code that is essentially standard ASCII, the ``American Standard Code for
+Information Interchange.'' This conversion is done immediately when each
+character is read in. Conversely, characters are converted from ASCII to
+the user's external representation just before they are output to a
+text file.
+
+Such an internal code is relevant to users of \TeX\ primarily because it
+governs the positions of characters in the fonts. For example, the
+character `\.A' has ASCII code $65=@'101$, and when \TeX\ typesets
+this letter it specifies character number 65 in the current font.
+If that font actually has `\.A' in a different position, \TeX\ doesn't
+know what the real position is; the program that does the actual printing from
+\TeX's device-independent files is responsible for converting from ASCII to
+a particular font encoding.
+
+\TeX's internal code is relevant also with respect to constants
+that begin with a reverse apostrophe.
+
+
+@
+Characters of text that have been converted to \TeX's internal form
+are said to be of type |ASCII_code|, which is a subrange of the integers.
+
+@<Types in the outer block@>=
+@!ASCII_code=0..127; {seven-bit numbers}
+
+
+@
+@^character set dependencies@>
+@^system dependencies@>
+The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower-case
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, especially in a program for typesetting;
+so the present specification of \TeX\ has been written under the assumption
+that the \PASCAL\ compiler and run-time system permit the use of text files
+with more than 64 distinguishable characters. More precisely, we assume that
+the character set contains at least the letters and symbols associated
+with ASCII codes @'40 through @'176; all of these characters are now
+available on most computer terminals.
+
+Since we are dealing with more characters than were present in the first
+\PASCAL\ compilers, we have to decide what to call the associated data
+type. Some \PASCAL s use the original name |char| for the
+characters in text files, even though there now are more than 64 such
+characters, while other \PASCAL s consider |char| to be a 64-element
+subrange of a larger data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters that are converted to and
+from |ASCII_code| when they are input and output. We shall also assume
+that |text_char| consists of the elements |chr(first_text_char)| through
+|chr(last_text_char)|, inclusive. The following definitions should be
+adjusted if necessary.
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Local variables for initialization@>=
+i:0..last_text_char; {this is the first one declared}
+
+
+@
+The \TeX\ processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals in the outer block@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+
+@
+@^character set dependencies@>
+@^system dependencies@>
+Since we are assuming that our \PASCAL\ system is able to read and write the
+visible characters of standard ASCII (although not necessarily using the
+ASCII codes to represent them), the following assignment statements initialize
+most of the |xchr| array properly, without needing any system-dependent
+changes. On the other hand, it is possible to implement \TeX\ with
+less complete character sets, and in such cases it will be necessary to
+change something here.
+
+@<Set initial values of key variables@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+xchr[0]:=' '; xchr[@'177]:=' ';
+ {ASCII codes 0 and |@'177| do not appear in text}
+
+
+@
+@^character set dependencies@>
+@^system dependencies@>
+Some of the ASCII codes without visible characters have been given symbolic
+names in this program because they are used with a special meaning. The
+|tab| character may be system dependent.
+
+@d null_code=@'0 {ASCII code that might disappear}
+@d tab=@'11 {ASCII code treated as |white_space|}
+@d space=@'40 {ASCII code treated as |white_space|}
+@d invalid_code=@'177 {ASCII code that should not appear}
+
+
+@
+@^character set dependencies@>
+@^system dependencies@>
+@:TeXbook}{\sl The \TeX book@>
+The ASCII code is ``standard'' only to a certain extent, since many
+computer installations have found it advantageous to have ready access
+to more than 94 printing characters. Appendix~C of {\sl The \TeX book\/}
+gives a complete specification of the intended correspondence between
+characters and \TeX's internal representation.
+
+If \TeX\ is being used
+on a garden-variety \PASCAL\ for which only standard ASCII
+codes will appear in the input and output files, it doesn't really matter
+what codes are specified in |xchr[1..@'37]|, but the safest policy is to
+blank everything out by using the code shown below.
+
+However, other settings of |xchr| will make \TeX\ more friendly on
+computers that have an extended character set, so that users can type things
+like `\.^^Z' instead of `\.{\\ne}'. At MIT, for example, it would be more
+appropriate to substitute the code
+$$\hbox{|for i:=1 to @'37 do xchr[i]:=chr(i);|}$$
+\TeX's character set is essentially the same as MIT's, even with respect to
+characters less than~@'40. People with extended character sets can
+assign codes arbitrarily, giving an |xchr| equivalent to whatever
+characters the users of \TeX\ are allowed to have in their input files.
+It is best to make the codes correspond to the intended interpretations as
+shown in Appendix~C whenever possible; but this is not necessary. For
+example, in countries with an alphabet of more than 26 letters, it is
+usually best to map the additional letters into codes less than~@'40.
+
+@<Set initial values of key variables@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+xchr[tab]:=chr(tab);
+
+
+@
+This system-independent code makes the |xord| array contain a suitable
+inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
+where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
+|j| or more; hence, standard ASCII code numbers will be used instead
+of codes below @'40 in case there is a coincidence.
+
+@<Set initial values of key variables@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
+for i:=1 to @'176 do xord[xchr[i]]:=i;
+
+
+@
+Also, various characters are given symbolic names; all the ones this
+program uses are collected here. We use the sharp sign as the
+|concat_char|, rather than something more natural (like an ampersand),
+for uniformity of database syntax (ampersand is a valid character in
+identifiers).
+
+@d double_quote = """" {delimits strings}
+@d number_sign = "#" {marks an |int_literal|}
+@d comment = "%" {ignore the rest of a \.{.bst} or \TeX\ line}
+@d single_quote = "'" {marks a quoted function}
+@d left_paren = "(" {optional database entry left delimiter}
+@d right_paren = ")" {corresponding right delimiter}
+@d comma = "," {separates various things}
+@d minus_sign = "-" {for a negative number}
+@d equals_sign = "=" {separates a field name from a field value}
+@d at_sign = "@@" {the beginning of a database entry}
+@d left_brace = "{" {left delimiter of many things}
+@d right_brace = "}" {corresponding right delimiter}
+@d period = "." {these are three}
+@d question_mark = "?" {string-ending characters}
+@d exclamation_mark = "!" {of interest in \.{add.period\$}}
+@d tie = "~" {the default space char, in \.{format.name\$}}
+@d hyphen = "-" {like |white_space|, in \.{format.name\$}}
+@d star = "*" {for including entire database}
+@d concat_char = "#" {for concatenating field tokens}
+@d colon = ":" {for lower-casing (usually title) strings}
+@d backslash = "\" {used to recognize accented characters}
+
+
+@
+These arrays give a lexical classification for the |ASCII_code|s;
+|lex_class| is used for general scanning and |id_class| is used for
+scanning identifiers.
+
+@<Globals in the outer block@>=
+@!lex_class: array [ASCII_code] of lex_type;
+@!id_class: array [ASCII_code] of id_type;
+
+
+@
+Every character has two types of the lexical classifications. The
+first type is general, and the second type tells whether the character
+is legal in identifiers.
+
+@d illegal = 0 {the unrecognized |ASCII_code|s}
+@d white_space = 1 {things like |space|s that you can't see}
+@d alpha = 2 {the upper- and lower-case letters}
+@d numeric = 3 {the ten digits}
+@d sep_char = 4 {things sometimes treated like |white_space|}
+@d other_lex = 5 {when none of the above applies}
+@d last_lex = 5 {the same number as on the line above}
+@#
+@d illegal_id_char = 0 {a few forbidden ones}
+@d legal_id_char = 1 {most printing characters}
+
+@<Types in the outer block@>=
+@!lex_type = 0..last_lex;@/
+@!id_type = 0..1;
+
+
+@
+@^character set dependencies@>
+@^system dependencies@>
+Now we initialize the system-dependent |lex_class| array. The |tab|
+character may be system dependent. Note that the order of these
+assignments is important here.
+
+@<Set initial values of key variables@>=
+for i:=0 to @'177 do lex_class[i] := other_lex;
+for i:=0 to @'37 do lex_class[i] := illegal;
+lex_class[invalid_code] := illegal;
+lex_class[tab] := white_space;
+lex_class[space] := white_space;
+lex_class[tie] := sep_char;
+lex_class[hyphen] := sep_char;
+for i:=@'60 to @'71 do lex_class[i] := numeric;
+for i:=@'101 to @'132 do lex_class[i] := alpha;
+for i:=@'141 to @'172 do lex_class[i] := alpha;
+
+
+@
+@^character set dependencies@>
+@^system dependencies@>
+And now the |id_class| array.
+
+@<Set initial values of key variables@>=
+for i:=0 to @'177 do id_class[i] := legal_id_char;
+for i:=0 to @'37 do id_class[i] := illegal_id_char;
+id_class[space] := illegal_id_char;
+id_class[tab] := illegal_id_char;
+id_class[double_quote] := illegal_id_char;
+id_class[number_sign] := illegal_id_char;
+id_class[comment] := illegal_id_char;
+id_class[single_quote] := illegal_id_char;
+id_class[left_paren] := illegal_id_char;
+id_class[right_paren] := illegal_id_char;
+id_class[comma] := illegal_id_char;
+id_class[equals_sign] := illegal_id_char;
+id_class[left_brace] := illegal_id_char;
+id_class[right_brace] := illegal_id_char;
+
+
+@
+The array |char_width| gives relative printing widths of each
+|ASCII_code|, and |string_width| will be used later to sum up
+|char_width|s in a string.
+
+@<Globals in the outer block@>=
+@!char_width : array [ASCII_code] of integer;
+@!string_width : integer;
+
+
+@
+@^character set dependencies@>
+@^system dependencies@>
+Now we initialize the system-dependent |char_width| array, for which
+|space| is the only |white_space| character given a nonzero printing
+width. The widths here are taken from Stanford's June~'87
+$cmr10$~font and represent hundredths of a point (rounded), but since
+they're used only for relative comparisons, the units have no meaning.
+
+@d ss_width = 500 {character |@'31|'s width in the $cmr10$ font}
+@d ae_width = 722 {character |@'32|'s width in the $cmr10$ font}
+@d oe_width = 778 {character |@'33|'s width in the $cmr10$ font}
+@d upper_ae_width = 903 {character |@'35|'s width in the $cmr10$ font}
+@d upper_oe_width = 1014 {character |@'36|'s width in the $cmr10$ font}
+
+@<Set initial values of key variables@>=
+for i:=0 to @'177 do char_width[i] := 0;
+@#
+char_width[@'40] := 278;
+char_width[@'41] := 278;
+char_width[@'42] := 500;
+char_width[@'43] := 833;
+char_width[@'44] := 500;
+char_width[@'45] := 833;
+char_width[@'46] := 778;
+char_width[@'47] := 278;
+char_width[@'50] := 389;
+char_width[@'51] := 389;
+char_width[@'52] := 500;
+char_width[@'53] := 778;
+char_width[@'54] := 278;
+char_width[@'55] := 333;
+char_width[@'56] := 278;
+char_width[@'57] := 500;
+char_width[@'60] := 500;
+char_width[@'61] := 500;
+char_width[@'62] := 500;
+char_width[@'63] := 500;
+char_width[@'64] := 500;
+char_width[@'65] := 500;
+char_width[@'66] := 500;
+char_width[@'67] := 500;
+char_width[@'70] := 500;
+char_width[@'71] := 500;
+char_width[@'72] := 278;
+char_width[@'73] := 278;
+char_width[@'74] := 278;
+char_width[@'75] := 778;
+char_width[@'76] := 472;
+char_width[@'77] := 472;
+char_width[@'100] := 778;
+char_width[@'101] := 750;
+char_width[@'102] := 708;
+char_width[@'103] := 722;
+char_width[@'104] := 764;
+char_width[@'105] := 681;
+char_width[@'106] := 653;
+char_width[@'107] := 785;
+char_width[@'110] := 750;
+char_width[@'111] := 361;
+char_width[@'112] := 514;
+char_width[@'113] := 778;
+char_width[@'114] := 625;
+char_width[@'115] := 917;
+char_width[@'116] := 750;
+char_width[@'117] := 778;
+char_width[@'120] := 681;
+char_width[@'121] := 778;
+char_width[@'122] := 736;
+char_width[@'123] := 556;
+char_width[@'124] := 722;
+char_width[@'125] := 750;
+char_width[@'126] := 750;
+char_width[@'127] :=1028;
+char_width[@'130] := 750;
+char_width[@'131] := 750;
+char_width[@'132] := 611;
+char_width[@'133] := 278;
+char_width[@'134] := 500;
+char_width[@'135] := 278;
+char_width[@'136] := 500;
+char_width[@'137] := 278;
+char_width[@'140] := 278;
+char_width[@'141] := 500;
+char_width[@'142] := 556;
+char_width[@'143] := 444;
+char_width[@'144] := 556;
+char_width[@'145] := 444;
+char_width[@'146] := 306;
+char_width[@'147] := 500;
+char_width[@'150] := 556;
+char_width[@'151] := 278;
+char_width[@'152] := 306;
+char_width[@'153] := 528;
+char_width[@'154] := 278;
+char_width[@'155] := 833;
+char_width[@'156] := 556;
+char_width[@'157] := 500;
+char_width[@'160] := 556;
+char_width[@'161] := 528;
+char_width[@'162] := 392;
+char_width[@'163] := 394;
+char_width[@'164] := 389;
+char_width[@'165] := 556;
+char_width[@'166] := 528;
+char_width[@'167] := 722;
+char_width[@'170] := 528;
+char_width[@'171] := 528;
+char_width[@'172] := 444;
+char_width[@'173] := 500;
+char_width[@'174] :=1000;
+char_width[@'175] := 500;
+char_width[@'176] := 500;
+
+
+
+@* Input and output.
+The basic operations we need to do are
+(1)~inputting and outputting of text characters to or from a file;
+(2)~instructing the operating system to initiate (``open'')
+or to terminate (``close'') input or output to or from a specified file; and
+(3)~testing whether the end of an input file has been reached.
+
+@<Types in the outer block@>=
+@!alpha_file=packed file of text_char; {files that contain textual data}
+
+
+@
+@^system dependencies@>
+Most of what we need to do with respect to input and output can be handled
+by the I/O facilities that are standard in \PASCAL, i.e., the routines
+called |get|, |put|, |eof|, and so on. But
+standard \PASCAL\ does not allow file variables to be associated with file
+names that are determined at run time, so it cannot be used to implement
+\BibTeX; some sort of extension to \PASCAL's ordinary |reset| and |rewrite|
+is crucial for our purposes. We shall assume that |name_of_file| is a variable
+of an appropriate type such that the \PASCAL\ run-time system being used to
+implement \BibTeX\ can open a file whose external name is specified by
+|name_of_file|. \BibTeX\ does no case conversion for file names.
+
+@<Globals in the outer block@>=
+@!name_of_file:packed array[1..file_name_size] of char;
+ {on some systems this is a \&{record} variable}
+@!name_length:0..file_name_size;
+ {this many characters are relevant in |name_of_file| (the rest are blank)}
+@!name_ptr:0..file_name_size+1; {index variable into |name_of_file|}
+
+
+@
+@^system dependencies@>
+@:PASCAL H}{\ph@>
+The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `\ignorespaces|packed
+array[@t\<\\{any}>@>] of text_char|', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\TeX\ to undertake appropriate corrective action.
+
+\TeX's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@<Procedures and functions for file-system interacting@>=
+function erstat(var f:file):integer; extern; {in the runtime library}
+@#@t\2@>
+function a_open_in(var f:alpha_file):boolean; {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean; {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+
+
+@
+@^system dependencies@>
+Files can be closed with the \ph\ routine `|close(f)|', which should
+be used when all input or output with respect to |f| has been
+completed. This makes |f| available to be opened again, if desired;
+and if |f| was used for output, the |close| operation makes the
+corresponding external file appear on the user's area, ready to be
+read.
+
+@<Procedures and functions for file-system interacting@>=
+procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+
+
+@
+Text output is easy to do with the ordinary \PASCAL\ |put| procedure,
+so we don't have to make any other special arrangements.
+The treatment of text input is more difficult, however, because
+of the necessary translation to |ASCII_code| values, and because
+\TeX's conventions should be efficient and they should
+blend nicely with the user's operating environment.
+
+
+@
+Input from text files is read one line at a time, using a routine
+called |input_ln|. This function is defined in terms of global
+variables called |buffer| and |last|. The |buffer| array contains
+|ASCII_code| values, and |last| is an index into this array marking
+the end of a line of text. (Occasionally, |buffer| is used for
+something else, in which case it is copied to a temporary array.)
+
+@<Globals in the outer block@>=
+@!buffer:buf_type; {usually, lines of characters being read}
+@!last:buf_pointer; {end of the line just input to |buffer|}
+
+
+@
+@^save space@>
+@^space savings@>
+@^system dependencies@>
+The type |buf_type| is used for |buffer|, for saved copies of it, or
+for scratch work. It's not |packed| because otherwise the program
+would run much slower on some systems (more than 25 percent slower,
+for example, on a TOPS-20 operating system). But on systems that are
+byte-addressable and that have a good compiler, packing |buf_type|
+would save lots of space without much loss of speed. Other modules
+that have packable arrays are also marked with a ``space savings''
+index entry.
+
+@<Types in the outer block@>=
+@!buf_pointer = 0..buf_size; {an index into a |buf_type|}
+@!buf_type = array[buf_pointer] of ASCII_code; {for various buffers}
+
+
+@
+@^kludge@>
+And while we're at it, we declare another buffer for general use.
+Because buffers are not packed and can get large, we use |sv_buffer|
+several purposes; this is a bit kludgy, but it helps make the stack
+space not overflow on some machines. It's used when reading the
+entire database file (in the \.{read} command) and when doing
+name-handling (through the alias |name_buf|) in the |built_in|
+functions \.{format.names\$} and \.{num.names\$}.
+
+@<Globals in the outer block@>=
+@!sv_buffer : buf_type;
+@!sv_ptr1 : buf_pointer;
+@!sv_ptr2 : buf_pointer;
+@!tmp_ptr,@!tmp_end_ptr : integer; {copy pointers only, usually for buffers}
+
+
+@
+@.BibTeX capacity exceeded@>
+When something in the program wants to be bigger or something out
+there wants to be smaller, it's time to call it a run. Here's the
+first of several macros that have associated procedures so that they
+produce less inline code.
+
+@d overflow(#)==begin {fatal error---close up shop}
+ print_overflow;
+ print_ln(#:0);
+ goto close_up_shop;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_overflow;
+begin
+print ('Sorry---you''ve exceeded BibTeX''s ');
+mark_fatal;
+end;
+
+
+@
+@.this can't happen@>
+When something happens that the program thinks is impossible,
+call the maintainer.
+
+@d confusion(#)==begin {fatal error---close up shop}
+ print (#);
+ print_confusion;
+ goto close_up_shop;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_confusion;
+begin
+print_ln ('---this can''t happen');
+print_ln ('*Please notify the BibTeX maintainer*');
+mark_fatal;
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad buffer size@>
+When a buffer overflows, it's time to complain (and then quit).
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure buffer_overflow;
+begin
+overflow('buffer size ',buf_size);
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad buffer size@>
+The |input_ln| function brings the next line of input from the
+specified file into available positions of the buffer array and
+returns the value |true|, unless the file has already been entirely
+read, in which case it returns |false| and sets |last:=0|. In
+general, the |ASCII_code| numbers that represent the next line of the
+file are input into |buffer[0]|, |buffer[1]|, \dots, |buffer[last-1]|;
+and the global variable |last| is set equal to the length of the line.
+Trailing |white_space| characters are removed from the line
+(|white_space| characters are explained in the character-set section%
+---most likely they're blanks); thus, either |last=0| (in which case
+the line was entirely blank) or |lex_class[buffer[last-1]]<>white_space|.
+An overflow error is given if the normal actions of |input_ln| would
+make |last>buf_size|.
+
+Standard \PASCAL\ says that a file should have |eoln| immediately
+before |eof|, but \BibTeX\ needs only a weaker restriction: If |eof|
+occurs in the middle of a line, the system function |eoln| should return
+a |true| result (even though |f^| will be undefined).
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+function input_ln(var f:alpha_file) : boolean;
+ {inputs the next line or returns |false|}
+label loop_exit;
+begin
+last:=0;
+if (eof(f)) then input_ln:=false
+else
+ begin
+ while (not eoln(f)) do
+ begin
+ if (last >= buf_size) then
+ buffer_overflow;
+ buffer[last]:=xord[f^];
+ get(f); incr(last);
+ end;
+ get(f);
+ while (last > 0) do {remove trailing |white_space|}
+ if (lex_class[buffer[last-1]] = white_space) then
+ decr(last)
+ else
+ goto loop_exit;
+loop_exit:
+ input_ln:=true;
+ end;
+end;
+
+
+
+@* String handling.
+\BibTeX\ uses variable-length strings of seven-bit characters.
+Since \PASCAL\ does not have a well-developed string mechanism,
+\BibTeX\ does all its string processing by home-grown
+(predominantly \TeX's) methods.
+Unlike \TeX, however, \BibTeX\ does not use a |pool_file| for
+string storage; it creates its few pre-defined strings at run-time.
+
+The necessary operations are handled with a simple data structure.
+The array |str_pool| contains all the (seven-bit) ASCII codes in all
+the strings \BibTeX\ must ever search for (generally identifiers
+names), and the array |str_start| contains indices of the starting
+points of each such string. Strings are referred to by integer
+numbers, so that string number |s| comprises the characters
+|str_pool[j]| for |str_start[s]<=j<str_start[s+1]|. Additional integer
+variables |pool_ptr| and |str_ptr| indicate the number of entries used
+so far in |str_pool| and |str_start|; locations |str_pool[pool_ptr]|
+and |str_start[str_ptr]| are ready for the next string to be
+allocated. Location |str_start[0]| is unused so that hashing will
+work correctly.
+
+Elements of the |str_pool| array must be ASCII codes that can actually be
+printed; i.e., they must have an |xchr| equivalent in the local
+character set.
+
+@<Globals in the outer block@>=
+@!str_pool : packed array[pool_pointer] of ASCII_code; {the characters}
+@!str_start : packed array[str_number] of pool_pointer; {the starting pointers}
+@!pool_ptr : pool_pointer; {first unused position in |str_pool|}
+@!str_ptr : str_number; {start of the current string being created}
+@!str_num : str_number; {general index variable into |str_start|}
+@!p_ptr1,@!p_ptr2 : pool_pointer; {several procedures use these locally}
+
+
+@
+Where |pool_pointer| and |str_number| are pointers into |str_pool| and
+|str_start|.
+
+@<Types in the outer block@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+
+
+@
+These macros send a string in |str_pool| to an output file.
+
+@d max_pop = 3 {---see the |built_in| functions section}
+@#
+@d print_pool_str(#) == print_a_pool_str(#)
+ {making this a procedure saves a little space}
+@#
+@d trace_pr_pool_str(#) == begin
+ out_pool_str(log_file,#);
+ end
+
+
+@
+@^kludge@>
+@^system dependencies@>
+@:this can't happen}{\quad Illegal string number@>
+And here are the associated procedures. Note: The |term_out| file is
+system dependent.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure out_pool_str (var f:alpha_file; @!s:str_number);
+var i:pool_pointer;
+begin {allowing |str_ptr <= s < str_ptr+max_pop| is a \.{.bst}-stack kludge}
+if ((s<0) or (s>=str_ptr+max_pop) or (s>=max_strings)) then
+ confusion ('Illegal string number:',s:0);
+for i := str_start[s] to str_start[s+1]-1 do
+ write(f,xchr[str_pool[i]]);
+end;
+@#
+procedure print_a_pool_str (@!s:str_number);
+begin
+out_pool_str(term_out,s);
+out_pool_str(log_file,s);
+end;
+
+
+@
+@.WEB@>
+Several of the elementary string operations are performed using \.{WEB}
+macros instead of using \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a string.
+
+@d length(#) == (str_start[#+1]-str_start[#])
+ {the number of characters in string number \#}
+
+
+@
+@:BibTeX capacity exceeded}{\quad pool size@>
+Strings are created by appending character codes to |str_pool|.
+The macro called |append_char|, defined here, does not check to see if the
+value of |pool_ptr| has gotten too high; this test is supposed to be
+made before |append_char| is used.
+
+To test if there is room to append |l| more characters to |str_pool|,
+we shall write |str_room(l)|, which aborts \BibTeX\ and gives an
+error message if there isn't enough room.
+
+@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
+begin str_pool[pool_ptr]:=#; incr(pool_ptr);
+end
+@#
+@d str_room(#) == {make sure that the pool hasn't overflowed}
+ begin
+ if (pool_ptr+# > pool_size) then
+ pool_overflow;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure pool_overflow;
+begin
+overflow('pool size ',pool_size);
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad number of strings@>
+Once a sequence of characters has been appended to |str_pool|, it
+officially becomes a string when the function |make_string| is called.
+It returns the string number of the string it just made.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+function make_string : str_number; {current string enters the pool}
+begin
+if (str_ptr=max_strings) then
+ overflow('number of strings ',max_strings);
+incr(str_ptr);
+str_start[str_ptr]:=pool_ptr;
+make_string := str_ptr - 1;
+end;
+
+
+@
+These macros destroy and recreate the string at the end of the pool.
+
+@d flush_string == begin
+ decr(str_ptr);
+ pool_ptr := str_start[str_ptr];
+ end
+@#
+@d unflush_string == begin
+ incr(str_ptr);
+ pool_ptr := str_start[str_ptr];
+ end
+
+
+@
+This subroutine compares string |s| with another string that appears
+in the buffer |buf| between positions |bf_ptr| and |bf_ptr+len-1|; the
+result is |true| if and only if the strings are equal.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+function str_eq_buf (@!s:str_number; var buf:buf_type;
+ @!bf_ptr,@!len:buf_pointer) : boolean;
+ {test equality of strings}
+label exit;
+var i : buf_pointer; {running}
+@!j : pool_pointer; {indices}
+begin
+if (length(s) <> len) then {strings of unequal length}
+ begin
+ str_eq_buf := false;
+ return;
+ end;
+i := bf_ptr;
+j := str_start[s];
+while (j < str_start[s+1]) do
+ begin
+ if (str_pool[j] <> buf[i]) then
+ begin
+ str_eq_buf := false;
+ return;
+ end;
+ incr(i);
+ incr(j);
+ end;
+str_eq_buf := true;
+exit:
+end;
+
+
+@
+This subroutine compares two |str_pool| strings and returns true
+|true| if and only if the strings are equal.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+function str_eq_str (@!s1,@!s2:str_number) : boolean;
+label exit;
+begin
+if (length(s1) <> length(s2)) then
+ begin
+ str_eq_str := false;
+ return;
+ end;
+p_ptr1 := str_start[s1];
+p_ptr2 := str_start[s2];
+while (p_ptr1 < str_start[s1+1]) do
+ begin
+ if (str_pool[p_ptr1] <> str_pool[p_ptr2]) then
+ begin
+ str_eq_str := false;
+ return;
+ end;
+ incr(p_ptr1);
+ incr(p_ptr2);
+ end;
+str_eq_str:=true;
+exit:
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad file name size@>
+This procedure copies file name |file_name| into the beginning of
+|name_of_file|, if it will fit. It also sets the global variable
+|name_length| to the appropriate value.
+
+@<Procedures and functions for file-system interacting@>=
+procedure start_name (@!file_name:str_number);
+var p_ptr: pool_pointer; {running index}
+begin
+if (length(file_name) > file_name_size) then
+ begin
+ print ('File=');
+ print_pool_str (file_name);
+ print_ln (',');
+ file_nm_size_overflow;
+ end;
+name_ptr := 1;
+p_ptr := str_start[file_name];
+while (p_ptr < str_start[file_name+1]) do
+ begin
+ name_of_file[name_ptr] := chr (str_pool[p_ptr]);
+ incr(name_ptr); incr(p_ptr);
+ end;
+name_length := length(file_name);
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad file name size@>
+Yet another complaint-before-quiting.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure file_nm_size_overflow;
+begin
+overflow('file name size ',file_name_size);
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad file name size@>
+This procedure copies file extension |ext| into the array
+|name_of_file| starting at position |name_length+1|. It also sets the
+global variable |name_length| to the appropriate value.
+
+@<Procedures and functions for file-system interacting@>=
+procedure add_extension(@!ext:str_number);
+var p_ptr: pool_pointer; {running index}
+begin
+if (name_length + length(ext) > file_name_size) then
+ begin
+ print ('File=',name_of_file,', extension=');
+ print_pool_str (ext); print_ln (',');
+ file_nm_size_overflow;
+ end;
+name_ptr := name_length + 1;
+p_ptr := str_start[ext];
+while (p_ptr < str_start[ext+1]) do
+ begin
+ name_of_file[name_ptr] := chr (str_pool[p_ptr]);
+ incr(name_ptr); incr(p_ptr);
+ end;
+name_length := name_length + length(ext);
+name_ptr := name_length+1;
+while (name_ptr <= file_name_size) do {pad with blanks}
+ begin
+ name_of_file[name_ptr] := ' ';
+ incr(name_ptr);
+ end;
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad file name size@>
+This procedure copies the default logical area name |area| into the
+array |name_of_file| starting at position 1, after shifting up the
+rest of the filename. It also sets the global variable |name_length|
+to the appropriate value.
+
+@<Procedures and functions for file-system interacting@>=
+procedure add_area(@!area:str_number);
+var p_ptr: pool_pointer; {running index}
+begin
+if (name_length + length(area) > file_name_size) then
+ begin
+ print ('File=');
+ print_pool_str (area); print (name_of_file,',');
+ file_nm_size_overflow;
+ end;
+name_ptr := name_length;
+while (name_ptr > 0) do {shift up name}
+ begin
+ name_of_file[name_ptr+length(area)] := name_of_file[name_ptr];
+ decr(name_ptr);
+ end;
+name_ptr := 1;
+p_ptr := str_start[area];
+while (p_ptr < str_start[area+1]) do
+ begin
+ name_of_file[name_ptr] := chr (str_pool[p_ptr]);
+ incr(name_ptr); incr(p_ptr);
+ end;
+name_length := name_length + length(area);
+end;
+
+
+@
+This system-independent procedure converts upper-case characters to
+lower case for the specified part of |buf|. It is system independent
+because it uses only the internal representation for characters.
+
+@d case_difference = "a" - "A"
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+procedure lower_case (var buf:buf_type; @!bf_ptr,@!len:buf_pointer);
+var i:buf_pointer;
+begin
+if (len > 0) then
+ for i := bf_ptr to bf_ptr+len-1 do
+ if ((buf[i]>="A") and (buf[i]<="Z")) then
+ buf[i] := buf[i] + case_difference;
+end;
+
+
+@
+This system-independent procedure is the same as the previous except
+that it converts lower- to upper-case letters.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+procedure upper_case (var buf:buf_type; @!bf_ptr,@!len:buf_pointer);
+var i:buf_pointer;
+begin
+if (len > 0) then
+ for i := bf_ptr to bf_ptr+len-1 do
+ if ((buf[i]>="a") and (buf[i]<="z")) then
+ buf[i] := buf[i] - case_difference;
+end;
+
+
+
+@* The hash table.
+All static strings that \BibTeX\ might have to search for, generally
+identifiers, are stored and retrieved by means of a fairly standard
+hash-table algorithm (but slightly altered here) called the method of
+``coalescing lists''
+(cf.\ Algorithm 6.4C in {\sl The Art of Computer Programming}).
+Once a string enters the table, it is never removed. The actual
+sequence of characters forming a string is stored in the |str_pool|
+array.
+
+The hash table consists of the four arrays |hash_next|, |hash_text|,
+|hash_ilk|, and |ilk_info|. The first array, |hash_next[p]|, points
+to the next identifier belonging to the same coalesced list as the
+identifier corresponding to~|p|. The second, |hash_text[p]|, points
+to the |str_start| entry for |p|'s string. If position~|p| of the hash
+table is empty, we have |hash_text[p]=0|; if position |p| is either
+empty or the end of a coalesced hash list, we have
+|hash_next[p]=empty|; an auxiliary pointer variable called |hash_used|
+is maintained in such a way that all locations |p>=hash_used| are
+nonempty. The third, |hash_ilk[p]|, tells how this string is used (as
+ordinary text, as a variable name, as an \.{.aux} file command, etc).
+The fourth, |ilk_info[p]|, contains information specific to the
+corresponding |hash_ilk|---for |integer_ilk|s: the integer's value;
+for |cite_ilk|s: a pointer into |cite_list|; for |lc_cite_ilk|s: a
+pointer to a |cite_ilk| string; for |command_ilk|s: a constant to be
+used in a |case| statement; for |bst_fn_ilk|s: function-specific
+information; for |macro_ilk|s: a pointer to its definition string; for
+|control_seq_ilk|s: a constant for use in a |case| statement; for all
+other |ilk|s it contains no information. This |ilk|-specific
+information is set in other parts of the program rather than here in
+the hashing routine.
+
+@d hash_base = empty + 1 {lowest numbered hash-table location}
+@d hash_max = hash_base + hash_size - 1 {highest numbered hash-table location}
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@#
+@d text_ilk = 0 {a string of ordinary text}
+@d integer_ilk = 1 {an integer (possibly with a |minus_sign|)}
+@d aux_command_ilk = 2 {an \.{.aux}-file command}
+@d aux_file_ilk = 3 {an \.{.aux} file name}
+@d bst_command_ilk = 4 {a \.{.bst}-file command}
+@d bst_file_ilk = 5 {a \.{.bst} file name}
+@d bib_file_ilk = 6 {a \.{.bib} file name}
+@d file_ext_ilk = 7 {one of \.{.aux}, \.{.bst}, \.{.bib}, \.{.bbl},
+ or \.{.blg}}
+@d file_area_ilk = 8 {one of \.{texinputs:} or \.{texbib:}}
+@d cite_ilk = 9 {a \.{\\citation} argument}
+@d lc_cite_ilk = 10 {a \.{\\citation} argument converted to lower case}
+@d bst_fn_ilk = 11 {a \.{.bst} function name}
+@d bib_command_ilk = 12 {a \.{.bib}-file command}
+@d macro_ilk = 13 {a \.{.bst} macro or a \.{.bib} string}
+@d control_seq_ilk = 14 {a control sequence specifying a foreign character}
+@d last_ilk = 14 {the same number as on the line above}
+
+@<Types in the outer block@>=
+@!hash_loc=hash_base..hash_max; {a location within the hash table}
+@!hash_pointer=empty..hash_max; {either |empty| or a |hash_loc|}
+@#
+@!str_ilk=0..last_ilk; {the legal string types}
+
+
+@
+@<Globals in the outer block@>=
+@!hash_next : packed array[hash_loc] of hash_pointer; {coalesced-list link}
+@!hash_text : packed array[hash_loc] of str_number; {pointer to a string}
+@!hash_ilk : packed array[hash_loc] of str_ilk; {the type of string}
+@!ilk_info : packed array[hash_loc] of integer; {|ilk|-specific info}
+@!hash_used : hash_base..hash_max+1; {allocation pointer for hash table}
+@!hash_found : boolean; {set to |true| if it's already in the hash table}
+@!dummy_loc : hash_loc; {receives |str_lookup| value whenever it's useless}
+
+
+@
+@<Local variables for initialization@>=
+@!k:hash_loc;
+
+
+@
+Now it's time to initialize the hash table; note that |str_start[0]|
+must be unused if |hash_text[k] := 0| is to have the desired effect.
+
+@<Set initial values of key variables@>=
+for k:=hash_base to hash_max do
+ begin
+ hash_next[k] := empty;
+ hash_text[k] := 0; {thus, no need to initialize |hash_ilk| or |ilk_info|}
+ end;
+hash_used := hash_max + 1; {nothing in table initially}
+
+
+@
+Here is the subroutine that searches the hash table for a
+(string,~|str_ilk|) pair, where the string is of length |l>=0| and
+appears in |buffer[j..(j+l-1)]|. If it finds the pair, it returns the
+corresponding hash-table location and sets the global variable
+|hash_found| to |true|. Otherwise it sets |hash_found| to |false|,
+and if the parameter |insert_it| is |true|, it inserts the pair into
+the hash table, inserts the string into |str_pool| if not previously
+encountered, and returns its location. Note that two different pairs
+can have the same string but different |str_ilk|s, in which case the
+second pair encountered, if |insert_it| were |true|, would be inserted
+into the hash table though its string wouldn't be inserted into
+|str_pool| because it would already be there.
+
+@d max_hash_value = hash_prime+hash_prime-2+127 {|h|'s maximum value}
+@d do_insert == true {insert string if not found in hash table}
+@d dont_insert == false {don't insert string}
+@#
+@d str_found = 40 {go here when you've found the string}
+@d str_not_found = 45 {go here when you haven't}
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+function str_lookup(var buf:buf_type; @!j,@!l:buf_pointer; @!ilk:str_ilk;
+ @!insert_it:boolean) : hash_loc; {search the hash table}
+label str_found,@!str_not_found;
+var h:0..max_hash_value; {hash code}
+@!p:hash_loc; {index into |hash_| arrays}
+@!k:buf_pointer; {index into |buf| array}
+@!old_string:boolean; {set to |true| if it's an already encountered string}
+@!str_num:str_number; {pointer to an already encountered string}
+begin
+@<Compute the hash code |h|@>;
+p:=h+hash_base; {start searching here; note that |0<=h<hash_prime|}
+hash_found := false;
+old_string := false;
+loop
+ begin
+ @<Process the string if we've already encountered it@>;
+ if (hash_next[p]=empty) then {location |p| may or may not be empty}
+ begin
+ if (not insert_it) then goto str_not_found;
+ @<Insert pair into hash table and make |p| point to it@>;
+ goto str_found;
+ end;
+ p:=hash_next[p]; {old and new locations |p| are not empty}
+ end;
+str_not_found: do_nothing; {don't insert pair; function value meaningless}
+str_found: str_lookup:=p;
+end;
+
+
+@
+@^for loops@>
+@.WEB@>
+The value of |hash_prime| should be roughly 85\% of |hash_size|, and
+it should be a prime number
+(it should also be less than $2^{14} + 2^{6} = 16320$ because of
+\.{WEB}'s simple-macro bound). The theory of hashing tells us to expect
+fewer than two table probes, on the average, when the search is
+successful.
+
+@<Compute the hash code |h|@>=
+begin
+h := 0; {note that this works for zero-length strings}
+k := j;
+while (k < j+l) do {not a |for| loop in case |j = l = 0|}
+ begin
+ h:=h+h+buf[k];
+ while (h >= hash_prime) do h:=h-hash_prime;
+ incr(k);
+ end;
+end
+
+
+@
+Here we handle the case in which we've already encountered this
+string; note that even if we have, we'll still have to insert the pair
+into the hash table if |str_ilk| doesn't match.
+
+@<Process the string if we've already encountered it@>=
+begin
+if (hash_text[p]>0) then {there's something here}
+ if (str_eq_buf(hash_text[p],buf,j,l)) then {it's the right string}
+ if (hash_ilk[p] = ilk) then {it's the right |str_ilk|}
+ begin
+ hash_found := true;
+ goto str_found;
+ end
+ else
+ begin {it's the wrong |str_ilk|}
+ old_string := true;
+ str_num := hash_text[p];
+ end;
+end
+
+
+@
+@^for loops@>
+@:BibTeX capacity exceeded}{\quad hash size@>
+This code inserts the pair in the appropriate unused location.
+
+@<Insert pair into hash table and make |p| point to it@>=
+begin
+if (hash_text[p]>0) then {location |p| isn't empty}
+ begin
+ repeat if (hash_is_full) then overflow('hash size ',hash_size);
+ decr(hash_used);
+ until (hash_text[hash_used]=0); {search for an empty location}
+ hash_next[p]:=hash_used;
+ p:=hash_used;
+ end; {now location |p| is empty}
+if (old_string) then {it's an already encountered string}
+ hash_text[p] := str_num
+ else
+ begin {it's a new string}
+ str_room(l); {make sure it'll fit in |str_pool|}
+ k := j;
+ while (k < j+l) do {not a |for| loop in case |j = l = 0|}
+ begin
+ append_char(buf[k]);
+ incr(k);
+ end;
+ hash_text[p] := make_string; {and make it official}
+ end;
+hash_ilk[p] := ilk;
+end
+
+
+@
+@^string pool@>
+Now that we've defined the hash-table workings we can initialize the
+string pool. Unlike \TeX, \BibTeX\ does not use a |pool_file| for
+string storage; instead it inserts its pre-defined strings into
+|str_pool|---this makes one file fewer for the \BibTeX\ implementor
+to deal with. This section initializes |str_pool|; the pre-defined
+strings will be inserted into it shortly; and other strings are
+inserted while processing the input files.
+
+@<Set initial values of key variables@>=
+pool_ptr:=0; str_ptr:=1; {hash table must have |str_start[0]| unused}
+str_start[str_ptr]:=pool_ptr;
+
+
+@
+The longest pre-defined string determines type definitions used to
+insert the pre-defined strings into |str_pool|.
+
+@d longest_pds=12 {the length of `\.{change.case\$}'}
+
+@<Types in the outer block@>=
+@!pds_loc = 1..longest_pds;
+@!pds_len = 0..longest_pds;
+@!pds_type = packed array [pds_loc] of char;
+
+
+@
+The variables in this program beginning with |s_| specify the
+locations in |str_pool| for certain often-used strings. Those here
+have to do with the file system; the next section will actually insert
+them into |str_pool|.
+
+@<Globals in the outer block@>=
+@!s_aux_extension : str_number; {\.{.aux}}
+@!s_log_extension : str_number; {\.{.blg}}
+@!s_bbl_extension : str_number; {\.{.bbl}}
+@!s_bst_extension : str_number; {\.{.bst}}
+@!s_bib_extension : str_number; {\.{.bib}}
+@!s_bst_area : str_number; {\.{texinputs:}}
+@!s_bib_area : str_number; {\.{texbib:}}
+
+
+@
+@^important note@>
+@^system dependencies@>
+It's time to insert some of the pre-defined strings into |str_pool|
+(and thus the hash table). These system-dependent strings should
+contain no upper-case letters, and they must all be exactly
+|longest_pds| characters long (even if fewer characters are actually
+stored). The |pre_define| routine appears shortly.
+
+Important notes: These pre-definitions must not have any glitches or
+the program may bomb because the |log_file| hasn't been opened yet,
+and |text_ilk|s should be pre-defined later, for
+\.{.bst}-function-execution purposes.
+
+@<Pre-define certain strings@>=
+pre_define('.aux ',4,file_ext_ilk);
+s_aux_extension := hash_text[pre_def_loc];
+pre_define('.bbl ',4,file_ext_ilk);
+s_bbl_extension := hash_text[pre_def_loc];
+pre_define('.blg ',4,file_ext_ilk);
+s_log_extension := hash_text[pre_def_loc];
+pre_define('.bst ',4,file_ext_ilk);
+s_bst_extension := hash_text[pre_def_loc];
+pre_define('.bib ',4,file_ext_ilk);
+s_bib_extension := hash_text[pre_def_loc];
+pre_define('texinputs: ',10,file_area_ilk);
+s_bst_area := hash_text[pre_def_loc];
+pre_define('texbib: ',7,file_area_ilk);
+s_bib_area := hash_text[pre_def_loc];
+
+
+@
+This global variable gives the hash-table location of pre-defined
+strings generated by calls to |str_lookup|.
+
+@<Globals in the outer block@>=
+@!pre_def_loc : hash_loc;
+
+
+@
+This procedure initializes a pre-defined string of length at most
+|longest_pds|.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+procedure pre_define (@!pds:pds_type; @!len:pds_len; @!ilk:str_ilk);
+var i : pds_len;
+begin
+for i:=1 to len do
+ buffer[i] := xord[pds[i]];
+pre_def_loc := str_lookup(buffer,1,len,ilk,do_insert);
+end;
+
+
+@
+These constants all begin with |n_| and are used for the |case|
+statement that determines which command to execute. The variable
+|command_num| is set to one of these and is used to do the branching,
+but it must have the full |integer| range because at times it can
+assume an arbitrary |ilk_info| value (though it will be one of the
+values here when we actually use it).
+
+@d n_aux_bibdata = 0 {\.{\\bibdata}}
+@d n_aux_bibstyle = 1 {\.{\\bibstyle}}
+@d n_aux_citation = 2 {\.{\\citation}}
+@d n_aux_input = 3 {\.{\\@@input}}
+@#
+@d n_bst_entry = 0 {\.{entry}}
+@d n_bst_execute = 1 {\.{execute}}
+@d n_bst_function = 2 {\.{function}}
+@d n_bst_integers = 3 {\.{integers}}
+@d n_bst_iterate = 4 {\.{iterate}}
+@d n_bst_macro = 5 {\.{macro}}
+@d n_bst_read = 6 {\.{read}}
+@d n_bst_reverse = 7 {\.{reverse}}
+@d n_bst_sort = 8 {\.{sort}}
+@d n_bst_strings = 9 {\.{strings}}
+@#
+@d n_bib_comment = 0 {\.{comment}}
+@d n_bib_preamble = 1 {\.{preamble}}
+@d n_bib_string = 2 {\.{string}}
+
+@<Globals in the outer block@>=
+@!command_num : integer;
+
+
+@
+@^important note@>
+Now we pre-define the command strings; they must all be exactly
+|longest_pds| characters long.
+
+Important note: These pre-definitions must not have any glitches or
+the program may bomb because the |log_file| hasn't been opened yet.
+
+@<Pre-define certain strings@>=
+pre_define('\citation ',9,aux_command_ilk);
+ilk_info[pre_def_loc] := n_aux_citation;
+pre_define('\bibdata ',8,aux_command_ilk);
+ilk_info[pre_def_loc] := n_aux_bibdata;
+pre_define('\bibstyle ',9,aux_command_ilk);
+ilk_info[pre_def_loc] := n_aux_bibstyle;
+pre_define('\@@input ',7,aux_command_ilk);
+ilk_info[pre_def_loc] := n_aux_input;
+@#
+pre_define('entry ',5,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_entry;
+pre_define('execute ',7,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_execute;
+pre_define('function ',8,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_function;
+pre_define('integers ',8,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_integers;
+pre_define('iterate ',7,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_iterate;
+pre_define('macro ',5,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_macro;
+pre_define('read ',4,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_read;
+pre_define('reverse ',7,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_reverse;
+pre_define('sort ',4,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_sort;
+pre_define('strings ',7,bst_command_ilk);
+ilk_info[pre_def_loc] := n_bst_strings;
+@#
+pre_define('comment ',7,bib_command_ilk);
+ilk_info[pre_def_loc] := n_bib_comment;
+pre_define('preamble ',8,bib_command_ilk);
+ilk_info[pre_def_loc] := n_bib_preamble;
+pre_define('string ',6,bib_command_ilk);
+ilk_info[pre_def_loc] := n_bib_string;
+
+
+
+@* Scanning an input line.
+This section describes the various |buffer| scanning routines. The
+two global variables |buf_ptr1| and |buf_ptr2| are used in scanning an
+input line. Between scans, |buf_ptr1| points to the first character
+of the current token and |buf_ptr2| points to that of the next. The
+global variable |last|, set by the function |input_ln|, marks the end
+of the current line; it equals 0 at the end of the current file. All
+the procedures and functions in this section will indicate an
+end-of-line when it's the end of the file.
+
+@d token_len == (buf_ptr2 - buf_ptr1) {of the current token}
+@d scan_char == buffer[buf_ptr2] {the current character}
+
+@<Globals in the outer block@>=
+@!buf_ptr1:buf_pointer; {points to the first position of the current token}
+@!buf_ptr2:buf_pointer; {used to find the end of the current token}
+
+
+@
+These macros send the current token, in |buffer[buf_ptr1]| to
+|buffer[buf_ptr2-1]|, to an output file.
+
+@d print_token == print_a_token {making this a procedure saves a little space}
+@#
+@d trace_pr_token == begin
+ out_token(log_file);
+ end
+
+
+@
+@^system dependencies@>
+And here are the associated procedures. Note: The |term_out| file is
+system dependent.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure out_token (var f:alpha_file);
+var i:buf_pointer;
+begin
+i := buf_ptr1;
+while (i < buf_ptr2) do
+ begin
+ write(f,xchr[buffer[i]]);
+ incr(i);
+ end;
+end;
+@#
+procedure print_a_token;
+begin
+out_token(term_out);
+out_token(log_file);
+end;
+
+
+@
+This function scans the |buffer| for the next token, starting at the
+global variable |buf_ptr2| and ending just before either the single
+specified stop-character or the end of the current line, whichever
+comes first, respectively returning |true| or |false|; afterward,
+|scan_char| is the first character following this token.
+
+@<Procedures and functions for input scanning@>=
+function scan1 (@!char1:ASCII_code) : boolean;
+begin
+buf_ptr1 := buf_ptr2;
+ {scan until end-of-line or the specified character}
+while ((scan_char <> char1) and (buf_ptr2 < last)) do
+ incr(buf_ptr2);
+if (buf_ptr2 < last) then
+ scan1 := true
+ else
+ scan1 := false;
+end;
+
+
+@
+This function is the same but stops at |white_space| characters as well.
+
+@<Procedures and functions for input scanning@>=
+function scan1_white (@!char1:ASCII_code) : boolean;
+begin
+buf_ptr1 := buf_ptr2;
+ {scan until end-of-line, the specified character, or |white_space|}
+while ((lex_class[scan_char] <> white_space) and (scan_char <> char1) and
+ (buf_ptr2 < last)) do
+ incr(buf_ptr2);
+if (buf_ptr2 < last) then
+ scan1_white := true
+ else
+ scan1_white := false;
+end;
+
+
+@
+This function is similar to |scan1|, but stops at either of two
+stop-characters as well as the end of the current line.
+
+@<Procedures and functions for input scanning@>=
+function scan2 (@!char1,@!char2:ASCII_code) : boolean;
+begin
+buf_ptr1 := buf_ptr2;
+ {scan until end-of-line or the specified characters}
+while ((scan_char <> char1) and (scan_char <> char2) and (buf_ptr2 < last)) do
+ incr(buf_ptr2);
+if (buf_ptr2 < last) then
+ scan2 := true
+ else
+ scan2 := false;
+end;
+
+
+@
+This function is the same but stops at |white_space| characters as well.
+
+@<Procedures and functions for input scanning@>=
+function scan2_white (@!char1,@!char2:ASCII_code) : boolean;
+begin
+buf_ptr1 := buf_ptr2;
+ {scan until end-of-line, the specified characters, or |white_space|}
+while ((scan_char <> char1) and (scan_char <> char2) and
+ (lex_class[scan_char] <> white_space) and (buf_ptr2 < last)) do
+ incr(buf_ptr2);
+if (buf_ptr2 < last) then
+ scan2_white := true
+ else
+ scan2_white := false;
+end;
+
+
+@
+This function is similar to |scan2|, but stops at either of three
+stop-characters as well as the end of the current line.
+
+@<Procedures and functions for input scanning@>=
+function scan3 (@!char1,@!char2,@!char3:ASCII_code) : boolean;
+begin
+buf_ptr1 := buf_ptr2;
+ {scan until end-of-line or the specified characters}
+while ((scan_char <> char1) and (scan_char <> char2) and
+ (scan_char <> char3) and (buf_ptr2 < last)) do
+ incr(buf_ptr2);
+if (buf_ptr2 < last) then
+ scan3 := true
+ else
+ scan3 := false;
+end;
+
+
+@
+This function scans for letters, stopping at the first nonletter; it
+returns |true| if there is at least one letter.
+
+@<Procedures and functions for input scanning@>=
+function scan_alpha : boolean;
+begin
+buf_ptr1 := buf_ptr2;
+ {scan until end-of-line or a nonletter}
+while ((lex_class[scan_char] = alpha) and (buf_ptr2 < last)) do
+ incr(buf_ptr2);
+if (token_len = 0) then
+ scan_alpha := false
+ else
+ scan_alpha := true;
+end;
+
+
+@
+These are the possible values for |scan_result|; they're set by the
+|scan_identifier| procedure and are described in the next section.
+
+@d id_null = 0
+@d specified_char_adjacent = 1
+@d other_char_adjacent = 2
+@d white_adjacent = 3
+
+@<Globals in the outer block@>=
+@!scan_result : id_null..white_adjacent;
+
+
+@
+This procedure scans for an identifier, stopping at the first
+|illegal_id_char|, or stopping at the first character if it's
+|numeric|. It sets the global variable |scan_result| to |id_null| if
+the identifier is null, else to |white_adjacent| if it ended at a
+|white_space| character or an end-of-line, else to
+|specified_char_adjacent| if it ended at one of |char1| or |char2| or
+|char3|, else to |other_char_adjacent| if it ended at a nonspecified,
+non|white_space| |illegal_id_char|. By convention, when some calling
+code really wants just one or two ``specified'' characters, it merely
+repeats one of the characters.
+
+@<Procedures and functions for input scanning@>=
+procedure scan_identifier (@!char1,@!char2,@!char3:ASCII_code);
+begin
+buf_ptr1 := buf_ptr2;
+if (lex_class[scan_char] <> numeric) then
+ {scan until end-of-line or an |illegal_id_char|}
+ while ((id_class[scan_char] = legal_id_char) and (buf_ptr2 < last)) do
+ incr(buf_ptr2);
+if (token_len = 0) then
+ scan_result := id_null
+else if ((lex_class[scan_char] = white_space) or (buf_ptr2 = last)) then
+ scan_result := white_adjacent
+else if ((scan_char = char1) or (scan_char = char2) or (scan_char = char3))
+ then
+ scan_result := specified_char_adjacent
+else
+ scan_result := other_char_adjacent;
+end;
+
+
+@
+The next two procedures scan for an integer, setting the global
+variable |token_value| to the corresponding integer.
+
+@d char_value == (scan_char - "0") {the value of the digit being scanned}
+
+@<Globals in the outer block@>=
+@!token_value : integer; {the numeric value of the current token}
+
+
+@
+This function scans for a nonnegative integer, stopping at the first
+nondigit; it sets the value of |token_value| accordingly. It returns
+|true| if the token was a legal nonnegative integer (i.e., consisted
+of one or more digits).
+
+@<Procedures and functions for input scanning@>=
+function scan_nonneg_integer : boolean;
+begin
+buf_ptr1 := buf_ptr2;
+token_value := 0;
+ {scan until end-of-line or a nondigit}
+while ((lex_class[scan_char] = numeric) and (buf_ptr2 < last)) do
+ begin
+ token_value := token_value*10 + char_value;
+ incr(buf_ptr2);
+ end;
+if (token_len = 0) then {there were no digits}
+ scan_nonneg_integer := false
+ else
+ scan_nonneg_integer := true;
+end;
+
+
+@
+This procedure scans for an integer, stopping at the first nondigit;
+it sets the value of |token_value| accordingly. It returns |true| if
+the token was a legal integer (i.e., consisted of an optional
+|minus_sign| followed by one or more digits).
+
+@d negative == (sign_length = 1) {if this integer is negative}
+
+@<Procedures and functions for input scanning@>=
+function scan_integer : boolean;
+var sign_length : 0..1; {1 if there's a |minus_sign|, 0 if not}
+begin
+buf_ptr1 := buf_ptr2;
+if (scan_char = minus_sign) then {it's a negative number}
+ begin
+ sign_length := 1;
+ incr(buf_ptr2); {skip over the |minus_sign|}
+ end
+ else
+ sign_length := 0;
+token_value := 0;
+ {scan until end-of-line or a nondigit}
+while ((lex_class[scan_char] = numeric) and (buf_ptr2 < last)) do
+ begin
+ token_value := token_value*10 + char_value;
+ incr(buf_ptr2);
+ end;
+if (negative) then
+ token_value := -token_value;
+if (token_len = sign_length) then {there were no digits}
+ scan_integer := false
+ else
+ scan_integer := true;
+end;
+
+
+@
+This function scans over |white_space| characters, stopping either at
+the first nonwhite character or the end of the line, respectively
+returning |true| or |false|.
+
+@<Procedures and functions for input scanning@>=
+function scan_white_space : boolean;
+begin
+ {scan until end-of-line or a nonwhite}
+while ((lex_class[scan_char] = white_space) and (buf_ptr2 < last)) do
+ incr(buf_ptr2);
+if (buf_ptr2 < last) then
+ scan_white_space := true
+ else
+ scan_white_space := false;
+end;
+
+
+@
+The |print_bad_input_line| procedure prints the current input line,
+splitting it at the character being scanned: It prints |buffer[0]|,
+|buffer[1]|, \dots, |buffer[buf_ptr2-1]| on one line and
+|buffer[buf_ptr2]|, \dots, |buffer[last-1]| on the next (and both
+lines start with a colon between two |space|s). Each |white_space|
+character is printed as a |space|.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_bad_input_line;
+var bf_ptr : buf_pointer;
+begin
+print (' : ');
+bf_ptr := 0;
+while (bf_ptr < buf_ptr2) do
+ begin
+ if (lex_class[buffer[bf_ptr]] = white_space) then
+ print (xchr[space])
+ else
+ print (xchr[buffer[bf_ptr]]);
+ incr(bf_ptr);
+ end;
+print_newline;
+print (' : ');
+bf_ptr := 0;
+while (bf_ptr < buf_ptr2) do
+ begin
+ print (xchr[space]);
+ incr(bf_ptr);
+ end;
+bf_ptr := buf_ptr2;
+while (bf_ptr < last) do
+ begin
+ if (lex_class[buffer[bf_ptr]] = white_space) then
+ print (xchr[space])
+ else
+ print (xchr[buffer[bf_ptr]]);
+ incr(bf_ptr);
+ end;
+print_newline;@/
+bf_ptr := 0;
+while ((bf_ptr < buf_ptr2) and (lex_class[buffer[bf_ptr]] = white_space)) do
+ incr(bf_ptr);
+if (bf_ptr = buf_ptr2) then
+ print_ln ('(Error may have been on previous line)');
+mark_error;
+end;
+
+
+@
+This little procedure exists because it's used by at least two other
+procedures and thus saves some space.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_skipping_whatever_remains;
+begin
+print ('I''m skipping whatever remains of this ');
+end;
+
+
+
+@* Getting the top-level auxiliary file name.
+@^system dependencies@>
+These modules read the name of the top-level \.{.aux} file. Some
+systems will try to find this on the command line; if it's not there
+it will come from the user's terminal. In either case, the name goes
+into the |char| array |name_of_file|, and the files relevant to this
+name are opened.
+
+@d aux_found=41 {go here when the \.{.aux} name is legit}
+@d aux_not_found=46 {go here when it's not}
+
+@<Globals in the outer block@>=
+@!aux_name_length : 0..file_name_size+1; {\.{.aux} name sans extension}
+
+
+@
+@^system dependencies@>
+@^user abuse@>
+I mean, this is truly disgraceful. A user has to type something in to
+the terminal just once during the entire run. And it's not some
+complicated string where you have to get every last punctuation mark
+just right, and it's not some fancy list where you get nervous because
+if you forget one item you have to type the whole thing again; it's
+just a simple, ordinary, file name. Now you'd think a five-year-old
+could do it; you'd think it's so simple a user should be able to do it
+in his sleep. But noooooooooo. He had to sit there droning on and on
+about who knows what until he exceeded the bounds of common sense, and
+he probably didn't even realize it. Just pitiful. What's this world
+coming to? We should probably just delete all his files and be done
+with him. Note: The |term_out| file is system dependent.
+
+@d sam_you_made_the_file_name_too_long == begin
+ sam_too_long_file_name_print;
+ goto aux_not_found;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure sam_too_long_file_name_print;
+begin
+write (term_out,'File name `');
+name_ptr := 1;
+while (name_ptr <= aux_name_length) do
+ begin
+ write (term_out,name_of_file[name_ptr]);
+ incr(name_ptr);
+ end;
+write_ln (term_out,''' is too long');
+end;
+
+
+@
+@^system dependencies@>
+@^user abuse@>
+We've abused the user enough for one section; suffice it to
+say here that most of what we said last module still applies.
+Note: The |term_out| file is system dependent.
+
+@d sam_you_made_the_file_name_wrong == begin
+ sam_wrong_file_name_print;
+ goto aux_not_found;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure sam_wrong_file_name_print;
+begin
+write (term_out,'I couldn''t open file name `');
+name_ptr := 1;
+while (name_ptr <= name_length) do
+ begin
+ write (term_out,name_of_file[name_ptr]);
+ incr(name_ptr);
+ end;
+write_ln (term_out,'''');
+end;
+
+
+@
+@^system dependencies@>
+This procedure consists of a loop that reads and processes a (nonnull)
+\.{.aux} file name. It's this module and the next two that must be
+changed on those systems using command-line arguments. Note: The
+|term_out| and |term_in| files are system dependent.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure get_the_top_level_aux_file_name;
+label aux_found,@!aux_not_found;
+var @<Variables for possible command-line processing@>@/
+begin
+check_cmnd_line := false; {many systems will change this}
+loop
+ begin
+ if (check_cmnd_line) then
+ @<Process a possible command line@>
+ else
+ begin
+ write (term_out,'Please type input file name (no extension)--');
+ if (eoln(term_in)) then {so the first |read| works}
+ read_ln (term_in);
+ aux_name_length := 0;
+ while (not eoln(term_in)) do
+ begin
+ if (aux_name_length = file_name_size) then
+ begin
+ while (not eoln(term_in)) do {discard the rest of the line}
+ get(term_in);
+ sam_you_made_the_file_name_too_long;
+ end;
+ incr(aux_name_length);
+ name_of_file[aux_name_length] := term_in^;
+ get(term_in);
+ end;
+ end;
+ @<Handle this \.{.aux} name@>;
+aux_not_found:
+ check_cmnd_line := false;
+ end;
+aux_found: {now we're ready to read the \.{.aux} file}
+end;
+
+
+@
+@^system dependencies@>
+The switch |check_cmnd_line| tells us whether we're to check for a
+possible command-line argument.
+
+@<Variables for possible command-line processing@>=
+@!check_cmnd_line : boolean; {|true| if we're to check the command line}
+
+
+@
+@^system dependencies@>
+Here's where we do the real command-line work. Those systems needing
+more than a single module to handle the task should add the extras to
+the ``System-dependent changes'' section.
+
+@<Process a possible command line@>=
+begin
+do_nothing; {the ``default system'' doesn't use the command line}
+end
+
+
+@
+Here we orchestrate this \.{.aux} name's handling: we add the various
+extensions, try to open the files with the resulting name, and
+store the name strings we'll need later.
+
+@<Handle this \.{.aux} name@>=
+begin
+if ((aux_name_length + length(s_aux_extension) > file_name_size) or@|
+ (aux_name_length + length(s_log_extension) > file_name_size) or@|
+ (aux_name_length + length(s_bbl_extension) > file_name_size)) then
+ sam_you_made_the_file_name_too_long;
+@<Add extensions and open files@>;
+@<Put this name into the hash table@>;
+goto aux_found;
+end
+
+
+@
+Here we set up definitions and declarations for files opened in this
+section. Each element in |aux_list| (except for
+|aux_list[aux_stack_size]|, which is always unused) is a pointer to
+the appropriate |str_pool| string representing the \.{.aux} file name.
+The array |aux_file| contains the corresponding \PASCAL\ |file|
+variables.
+
+@d cur_aux_str == aux_list[aux_ptr] {shorthand for the current \.{.aux} file}
+@d cur_aux_file == aux_file[aux_ptr] {shorthand for the current |aux_file|}
+@d cur_aux_line == aux_ln_stack[aux_ptr] {line number of current \.{.aux} file}
+
+@<Globals in the outer block@>=
+@!aux_file : array[aux_number] of alpha_file; {open \.{.aux} |file| variables}
+@!aux_list : array[aux_number] of str_number; {the open \.{.aux} file list}
+@!aux_ptr : aux_number; {points to the currently open \.{.aux} file}
+@!aux_ln_stack : array[aux_number] of integer; {open \.{.aux} line numbers}
+@#
+@!top_lev_str : str_number; {the top-level \.{.aux} file's name}
+@#
+@!log_file : alpha_file; {the |file| variable for the \.{.blg} file}
+@!bbl_file : alpha_file; {the |file| variable for the \.{.bbl} file}
+
+
+@
+Where |aux_number| is the obvious.
+
+@<Types in the outer block@>=
+@!aux_number = 0..aux_stack_size; {gives the |aux_list| range}
+
+
+@
+@^system dependencies@>
+We must make sure the (top-level) \.{.aux}, \.{.blg}, and \.{.bbl}
+files can be opened.
+
+@<Add extensions and open files@>=
+begin
+name_length := aux_name_length; {set to last used position}
+add_extension (s_aux_extension); {this also sets |name_length|}
+aux_ptr := 0; {initialize the \.{.aux} file stack}
+if (not a_open_in(cur_aux_file)) then
+ sam_you_made_the_file_name_wrong;
+@#
+name_length := aux_name_length;
+add_extension (s_log_extension); {this also sets |name_length|}
+if (not a_open_out(log_file)) then
+ sam_you_made_the_file_name_wrong;
+@#
+name_length := aux_name_length;
+add_extension (s_bbl_extension); {this also sets |name_length|}
+if (not a_open_out(bbl_file)) then
+ sam_you_made_the_file_name_wrong;
+end
+
+
+@
+@:this can't happen}{\quad Already encountered auxiliary file@>
+This code puts the \.{.aux} file name, both with and without the
+extension, into the hash table, and it initializes |aux_list|. Note
+that all previous top-level \.{.aux}-file stuff must have been
+successful.
+
+@<Put this name into the hash table@>=
+begin
+name_length := aux_name_length;
+add_extension (s_aux_extension); {this also sets |name_length|}
+name_ptr := 1;
+while (name_ptr <= name_length) do
+ begin
+ buffer[name_ptr] := xord[name_of_file[name_ptr]];
+ incr(name_ptr);
+ end;
+top_lev_str := hash_text[
+ str_lookup(buffer,1,aux_name_length,text_ilk,do_insert)];
+cur_aux_str := hash_text[
+ str_lookup(buffer,1,name_length,aux_file_ilk,do_insert)];
+ {note that this has initialized |aux_list|}
+if (hash_found) then
+ begin
+ trace
+ print_aux_name;
+ ecart@/
+ confusion ('Already encountered auxiliary file');
+ end;
+cur_aux_line := 0; {this finishes initializing the top-level \.{.aux} file}
+end
+
+
+@
+Print the name of the current \.{.aux} file, followed by a |newline|.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_aux_name;
+begin
+print_pool_str (cur_aux_str);
+print_newline;
+end;
+
+
+
+@* Reading the auxiliary file(s).
+@^auxiliary-file commands@>
+Now it's time to read the \.{.aux} file. The only commands we handle
+are \.{\\citation} (there can be arbitrarily many, each having
+arbitrarily many arguments), \.{\\bibdata} (there can be just one, but
+it can have arbitrarily many arguments), \.{\\bibstyle} (there can be
+just one, and it can have just one argument), and \.{\\@@input} (there
+can be arbitrarily many, each with one argument, and they can be
+nested to a depth of |aux_stack_size|). Each of these commands is
+assumed to be on just a single line. The rest of the \.{.aux} file is
+ignored.
+
+@d aux_done=31 {go here when finished with the \.{.aux} files}
+
+@<Labels in the outer block@>=
+,@!aux_done
+
+
+@
+We keep reading and processing input lines until none left. This is
+part of the main program; hence, because of the |aux_done| label,
+there's no conventional |begin|-|end| pair surrounding the entire
+module.
+
+@<Read the \.{.aux} file@>=
+print ('The top-level auxiliary file: ');
+print_aux_name;
+loop
+ begin {|pop_the_aux_stack| will exit the loop}
+ incr(cur_aux_line);
+ if (not input_ln(cur_aux_file)) then {end of current \.{.aux} file}
+ pop_the_aux_stack
+ else
+ get_aux_command_and_process;
+ end;
+ trace
+ trace_pr_ln ('Finished reading the auxiliary file(s)');
+ ecart@/
+aux_done:
+last_check_for_aux_errors;
+
+
+@
+When we find a bug, we print a message and flush the rest of the line.
+This macro must be called from within a procedure that has an |exit|
+label.
+
+@d aux_err_return == begin
+ aux_err_print;
+ return; {flush this input line}
+ end
+
+@d aux_err(#) == begin
+ print (#);
+ aux_err_return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure aux_err_print;
+begin
+print ('---line ',cur_aux_line:0,' of file ');
+print_aux_name;@/
+print_bad_input_line; {this call does the |mark_error|}
+print_skipping_whatever_remains;
+print_ln ('command')
+end;
+
+
+@
+@:this can't happen}{\quad Illegal auxiliary-file command@>
+Here are a bunch of macros whose print statements are used at least
+twice. Thus we save space by making the statements procedures. This
+macro complains when there's a repeated command that's to be used just
+once.
+
+@d aux_err_illegal_another(#) == begin
+ aux_err_illegal_another_print (#);
+ aux_err_return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure aux_err_illegal_another_print (@!cmd_num : integer);
+begin
+print ('Illegal, another \bib');
+case (cmd_num) of
+ n_aux_bibdata : print ('data');
+ n_aux_bibstyle : print ('style');
+ othercases
+ confusion ('Illegal auxiliary-file command')
+endcases;
+print (' command');
+end;
+
+
+@
+This one complains when a command is missing its |right_brace|.
+
+@d aux_err_no_right_brace == begin
+ aux_err_no_right_brace_print;
+ aux_err_return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure aux_err_no_right_brace_print;
+begin
+print ('No "',xchr[right_brace],'"');
+end;
+
+
+@
+This one complains when a command has stuff after its |right_brace|.
+
+@d aux_err_stuff_after_right_brace == begin
+ aux_err_stuff_after_right_brace_print;
+ aux_err_return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure aux_err_stuff_after_right_brace_print;
+begin
+print ('Stuff after "',xchr[right_brace],'"');
+end;
+
+
+@
+And this one complains when a command has |white_space| in its
+argument.
+
+@d aux_err_white_space_in_argument == begin
+ aux_err_white_space_in_argument_print;
+ aux_err_return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure aux_err_white_space_in_argument_print;
+begin
+print ('White space in argument');
+end;
+
+
+@
+@^auxiliary-file commands@>
+@:this can't happen}{\quad Unknown auxiliary-file command@>
+We're not at the end of an \.{.aux} file, so we see if the current
+line might be a command of interest. A command of interest will be a
+line without blanks, consisting of a command name, a |left_brace|, one
+or more arguments separated by commas, and a |right_brace|.
+
+@<Scan for and process an \.{.aux} command@>=
+procedure get_aux_command_and_process;
+label exit;
+begin
+buf_ptr2 := 0; {mark the beginning of the next token}
+if (not scan1(left_brace)) then {no |left_brace|---flush line}
+ return;
+command_num := ilk_info[
+ str_lookup(buffer,buf_ptr1,token_len,aux_command_ilk,dont_insert)];
+if (hash_found) then
+ case (command_num) of
+ n_aux_bibdata : aux_bib_data_command;
+ n_aux_bibstyle : aux_bib_style_command;
+ n_aux_citation : aux_citation_command;
+ n_aux_input : aux_input_command;
+ othercases
+ confusion ('Unknown auxiliary-file command')
+ endcases;
+exit:
+end;
+
+
+@
+Here we introduce some variables for processing a \.{\\bibdata}
+command. Each element in |bib_list| (except for
+|bib_list[max_bib_files]|, which is always unused) is a pointer to the
+appropriate |str_pool| string representing the \.{.bib} file name.
+The array |bib_file| contains the corresponding \PASCAL\ |file|
+variables.
+
+@d cur_bib_str == bib_list[bib_ptr] {shorthand for current \.{.bib} file}
+@d cur_bib_file == bib_file[bib_ptr] {shorthand for current |bib_file|}
+
+@<Globals in the outer block@>=
+@!bib_list : array[bib_number] of str_number; {the \.{.bib} file list}
+@!bib_ptr : bib_number; {pointer for the current \.{.bib} file}
+@!num_bib_files : bib_number; {the total number of \.{.bib} files}
+@!bib_seen : boolean; {|true| if we've already seen a \.{\\bibdata} command}
+@!bib_file : array[bib_number] of alpha_file; {corresponding |file| variables}
+
+
+@
+Where |bib_number| is the obvious.
+
+@<Types in the outer block@>=
+@!bib_number = 0..max_bib_files; {gives the |bib_list| range}
+
+
+@
+@<Set initial values of key variables@>=
+bib_ptr := 0; {this makes |bib_list| empty}
+bib_seen := false; {we haven't seen a \.{\\bibdata} command yet}
+
+
+@
+@:auxiliary-file commands}{\quad \.{\\bibdata}@>
+A \.{\\bibdata} command will have its arguments between braces and
+separated by commas. There must be exactly one such command in the
+\.{.aux} file(s). All upper-case letters are converted to lower case.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure aux_bib_data_command;
+label exit;
+begin
+if (bib_seen) then
+ aux_err_illegal_another (n_aux_bibdata);
+bib_seen := true; {now we've seen a \.{\\bibdata} command}
+while (scan_char <> right_brace) do
+ begin
+ incr(buf_ptr2); {skip over the previous stop-character}
+ if (not scan2_white(right_brace,comma)) then
+ aux_err_no_right_brace;
+ if (lex_class[scan_char] = white_space) then
+ aux_err_white_space_in_argument;
+ if ((last > buf_ptr2+1) and (scan_char = right_brace)) then
+ aux_err_stuff_after_right_brace;
+ @<Open a \.{.bib} file@>;
+ end;
+exit:
+end;
+
+
+@
+Here's a procedure we'll need shortly. It prints the name of the
+current \.{.bib} file, followed by a |newline|.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_bib_name;
+begin
+print_pool_str (cur_bib_str);
+print_pool_str (s_bib_extension);
+print_newline;
+end;
+
+
+@
+This macro is similar to |aux_err| but it complains specifically about
+opening a file for a \.{\\bibdata} command.
+
+@d open_bibdata_aux_err(#) == begin
+ print (#);
+ print_bib_name;
+ aux_err_return; {this does the |mark_error|}
+ end
+
+
+@
+@:BibTeX capacity exceeded}{\quad number of \.{.bib} files@>
+Now we add the just-found argument to |bib_list| if it hasn't already
+been encountered as a \.{\\bibdata} argument and if, after appending
+the |s_bib_extension| string, the resulting file name can be opened.
+
+@<Open a \.{.bib} file@>=
+begin
+if (bib_ptr = max_bib_files) then
+ overflow('number of database files ',max_bib_files);
+cur_bib_str := hash_text[
+ str_lookup(buffer,buf_ptr1,token_len,bib_file_ilk,do_insert)];
+if (hash_found) then {already encountered this as a \.{\\bibdata} argument}
+ open_bibdata_aux_err ('This database file appears more than once: ');
+start_name (cur_bib_str);
+add_extension (s_bib_extension);
+if (not a_open_in(cur_bib_file)) then
+ begin
+ add_area (s_bib_area);
+ if (not a_open_in(cur_bib_file)) then
+ open_bibdata_aux_err ('I couldn''t open database file ');
+ end;
+ trace
+ trace_pr_pool_str (cur_bib_str);
+ trace_pr_pool_str (s_bib_extension);
+ trace_pr_ln (' is a bibdata file');
+ ecart@/
+incr(bib_ptr);
+end
+
+
+@
+Here we introduce some variables for processing a \.{\\bibstyle}
+command.
+
+@<Globals in the outer block@>=
+@!bst_seen : boolean; {|true| if we've already seen a \.{\\bibstyle} command}
+@!bst_str : str_number; {the string number for the \.{.bst} file}
+@!bst_file : alpha_file; {the corresponding |file| variable}
+
+
+@
+And we initialize.
+
+@<Set initial values of key variables@>=
+bst_str := 0; {mark |bst_str| as unused}
+bst_seen := false; {we haven't seen a \.{\\bibstyle} command yet}
+
+
+@
+@:auxiliary-file commands}{\quad \.{\\bibstyle}@>
+A \.{\\bibstyle} command will have exactly one argument, and it will
+be between braces. There must be exactly one such command in the
+\.{.aux} file(s). All upper-case letters are converted to lower case.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure aux_bib_style_command;
+label exit;
+begin
+if (bst_seen) then
+ aux_err_illegal_another (n_aux_bibstyle);
+bst_seen := true; {now we've seen a \.{\\bibstyle} command}
+incr(buf_ptr2); {skip over the |left_brace|}
+if (not scan1_white(right_brace)) then
+ aux_err_no_right_brace;
+if (lex_class[scan_char] = white_space) then
+ aux_err_white_space_in_argument;
+if (last > buf_ptr2+1) then
+ aux_err_stuff_after_right_brace;
+@<Open the \.{.bst} file@>;
+exit:
+end;
+
+
+@
+@:this can't happen}{\quad Already encountered style file@>
+Now we open the file whose name is the just-found argument appended
+with the |s_bst_extension| string, if possible.
+
+@<Open the \.{.bst} file@>=
+begin
+bst_str := hash_text[
+ str_lookup(buffer,buf_ptr1,token_len,bst_file_ilk,do_insert)];
+if (hash_found) then
+ begin
+ trace
+ print_bst_name;
+ ecart@/
+ confusion ('Already encountered style file');
+ end;
+start_name (bst_str);
+add_extension (s_bst_extension);
+if (not a_open_in(bst_file)) then
+ begin
+ add_area (s_bst_area);
+ if (not a_open_in(bst_file)) then
+ begin
+ print ('I couldn''t open style file ');
+ print_bst_name;@/
+ bst_str := 0; {mark as unused again}
+ aux_err_return;
+ end;
+ end;
+print ('The style file: ');
+print_bst_name;
+end
+
+
+@
+Print the name of the \.{.bst} file, followed by a |newline|.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_bst_name;
+begin
+print_pool_str (bst_str);
+print_pool_str (s_bst_extension);
+print_newline;
+end;
+
+
+@
+Here we introduce some variables for processing a \.{\\citation}
+command. Each element in |cite_list| (except for
+|cite_list[max_cites]|, which is always unused) is a pointer to the
+appropriate |str_pool| string. The cite-key list is kept in order of
+occurrence with duplicates removed.
+
+@d cur_cite_str == cite_list[cite_ptr] {shorthand for the current cite key}
+
+@<Globals in the outer block@>=
+@!cite_list : packed array[cite_number] of str_number; {the cite-key list}
+@!cite_ptr : cite_number; {pointer for the current cite key}
+@!entry_cite_ptr : cite_number; {cite pointer for the current entry}
+@!num_cites : cite_number; {the total number of distinct cite keys}
+@!old_num_cites : cite_number; {set to a previous |num_cites| value}
+@!citation_seen : boolean; {|true| if we've seen a \.{\\citation} command}
+@!cite_loc : hash_loc; {the hash-table location of a cite key}
+@!lc_cite_loc : hash_loc; {and of its lower-case equivalent}
+@!lc_xcite_loc : hash_loc; {a second |lc_cite_loc| variable}
+@!cite_found : boolean; {|true| if we've already seen this cite key}
+@!all_entries : boolean; {|true| if we're to use the entire database}
+@!all_marker : cite_number; {we put the other entries in |cite_list| here}
+
+
+@
+Where |cite_number| is the obvious.
+
+@<Types in the outer block@>=
+@!cite_number = 0..max_cites; {gives the |cite_list| range}
+
+
+@
+@<Set initial values of key variables@>=
+cite_ptr := 0; {this makes |cite_list| empty}
+citation_seen := false; {we haven't seen a \.{\\citation} command yet}
+all_entries := false; {by default, use just the entries explicitly named}
+
+
+@
+@^case mismatch@>
+@^entire database inclusion@>
+@^whole database inclusion@>
+@:LaTeX}{\LaTeX@>
+@:auxiliary-file commands}{\quad \.{\\citation}@>
+A \.{\\citation} command will have its arguments between braces and
+separated by commas. Upper/lower cases are considered to be different
+for \.{\\citation} arguments, which is the same as the rest of \LaTeX\
+but different from the rest of \BibTeX. A cite key needn't exactly
+case-match its corresponding database key to work, although two cite
+keys that are case-mismatched will produce an error message.
+(A {\sl case mismatch\/} is a mismatch, but only because of a case
+difference.)
+
+A \.{\\citation} command having \.{*} as an argument indicates that
+the entire database will be included (almost as if a \.{\\nocite}
+command that listed every cite key in the database, in order, had been
+given at the corresponding spot in the \.{.tex} file).
+
+@d next_cite = 23 {read the next argument}
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure aux_citation_command;
+label next_cite,@!exit;
+begin
+citation_seen := true; {now we've seen a \.{\\citation} command}
+while (scan_char <> right_brace) do
+ begin
+ incr(buf_ptr2); {skip over the previous stop-character}
+ if (not scan2_white(right_brace,comma)) then
+ aux_err_no_right_brace;
+ if (lex_class[scan_char] = white_space) then
+ aux_err_white_space_in_argument;
+ if ((last > buf_ptr2+1) and (scan_char = right_brace)) then
+ aux_err_stuff_after_right_brace;
+ @<Check the cite key@>;
+next_cite:
+ end;
+exit:
+end;
+
+
+@
+@^kludge@>
+We must check if (the lower-case version of) this cite key has been
+previously encountered, and proceed accordingly. The alias kludge
+helps make the stack space not overflow on some machines.
+
+@d ex_buf1== ex_buf {an alias, used only in this module}
+
+@<Check the cite key@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr (' cite key encountered');
+ ecart@/
+@<Check for entire database inclusion (and thus skip this cite key)@>;
+tmp_ptr := buf_ptr1;
+while (tmp_ptr < buf_ptr2) do
+ begin
+ ex_buf1[tmp_ptr] := buffer[tmp_ptr];
+ incr(tmp_ptr);
+ end;
+lower_case (ex_buf1, buf_ptr1, token_len); {convert to `canonical' form}
+lc_cite_loc := str_lookup(ex_buf1,buf_ptr1,token_len,lc_cite_ilk,do_insert);
+if (hash_found) then {already encountered this as a \.{\\citation} argument}
+ @<Cite seen, don't add a cite key@>
+ else
+ @<Cite unseen, add a cite key@>;
+ {it's a new cite key---add it to |cite_list|}
+end
+
+
+@
+Here we check for a \.{\\citation} command having \.{*} as an
+argument, indicating that the entire database will be included.
+
+@<Check for entire database inclusion (and thus skip this cite key)@>=
+begin
+if (token_len = 1) then
+ if (buffer[buf_ptr1] = star) then
+ begin
+ trace
+ trace_pr_ln ('---entire database to be included');
+ ecart@/
+ if (all_entries) then
+ begin
+ print_ln ('Multiple inclusions of entire database');
+ aux_err_return;
+ end
+ else
+ begin
+ all_entries := true;
+ all_marker := cite_ptr;
+ goto next_cite;
+ end;
+ end;
+end
+
+
+@
+@^case mismatch errors@>
+We've previously encountered the lower-case version, so we check that
+the actual version exactly matches the actual version of the
+previously-encountered cite key(s).
+
+@<Cite seen, don't add a cite key@>=
+begin
+ trace
+ trace_pr_ln (' previously');
+ ecart@/
+dummy_loc := str_lookup(buffer,buf_ptr1,token_len,cite_ilk,dont_insert);
+if (not hash_found) then {case mismatch error}
+ begin
+ print ('Case mismatch error between cite keys ');
+ print_token;
+ print (' and ');
+ print_pool_str (cite_list[ilk_info[ilk_info[lc_cite_loc]]]);
+ print_newline;
+ aux_err_return;
+ end;
+end
+
+
+@
+@:this can't happen}{\quad Cite hash error@>
+Now we add the just-found argument to |cite_list| if there isn't
+anything funny happening.
+
+@<Cite unseen, add a cite key@>=
+begin
+ trace
+ trace_pr_newline;
+ ecart@/
+cite_loc := str_lookup(buffer,buf_ptr1,token_len,cite_ilk,do_insert);
+if (hash_found) then
+ hash_cite_confusion;
+check_cite_overflow (cite_ptr);
+cur_cite_str := hash_text[cite_loc];
+ilk_info[cite_loc] := cite_ptr;
+ilk_info[lc_cite_loc] := cite_loc;
+incr(cite_ptr);
+end
+
+
+@
+@:this can't happen}{\quad Cite hash error@>
+Here's a serious complaint (that is, a bug) concerning hash problems.
+This is the first of several similar bug-procedures that exist only
+because they save space.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure hash_cite_confusion;
+begin
+confusion ('Cite hash error');
+end;
+
+
+@
+@^fetish@>
+@:BibTeX capacity exceeded}{\quad number of cite keys@>
+Complain if somebody's got a cite fetish. This procedure is called
+when were about to add another cite key to |cite_list|. It assumes
+that |cite_loc| gives the potential cite key's hash table location.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure check_cite_overflow (@!last_cite : cite_number);
+begin
+if (last_cite = max_cites) then
+ begin
+ print_pool_str (hash_text[cite_loc]);
+ print_ln (' is the key:');
+ overflow('number of cite keys ',max_cites);
+ end;
+end;
+
+
+@
+@:auxiliary-file commands}{\quad \.{\\\AT!input}@>
+An \.{\\@@input} command will have exactly one argument, it will
+be between braces, and it must have the |s_aux_extension|.
+All upper-case letters are converted to lower case.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure aux_input_command;
+label exit;
+var aux_extension_ok : boolean; {to check for a correct file extension}
+begin
+incr(buf_ptr2); {skip over the |left_brace|}
+if (not scan1_white(right_brace)) then
+ aux_err_no_right_brace;
+if (lex_class[scan_char] = white_space) then
+ aux_err_white_space_in_argument;
+if (last > buf_ptr2+1) then
+ aux_err_stuff_after_right_brace;
+@<Push the \.{.aux} stack@>;
+exit:
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad number of \.{.aux} files@>
+We must check that this potential \.{.aux} file won't overflow the
+stack, that it has the correct extension, that we haven't encountered
+it before (to prevent, among other things, an infinite loop).
+
+@<Push the \.{.aux} stack@>=
+begin
+incr(aux_ptr);
+if (aux_ptr = aux_stack_size) then
+ begin
+ print_token; print (': ');
+ overflow('auxiliary file depth ',aux_stack_size);
+ end;
+aux_extension_ok := true;
+if (token_len < length(s_aux_extension)) then@/
+ aux_extension_ok := false {else |str_eq_buf| might bomb the program}
+else if (not str_eq_buf(s_aux_extension, buffer,
+ buf_ptr2-length(s_aux_extension), length(s_aux_extension))) then
+ aux_extension_ok := false;
+if (not aux_extension_ok) then
+ begin
+ print_token;
+ print (' has a wrong extension');
+ decr(aux_ptr);
+ aux_err_return;
+ end;
+cur_aux_str := hash_text[
+ str_lookup(buffer,buf_ptr1,token_len,aux_file_ilk,do_insert)];
+if (hash_found) then
+ begin
+ print ('Already encountered file ');
+ print_aux_name;
+ decr(aux_ptr);
+ aux_err_return;
+ end;
+@<Open this \.{.aux} file@>;
+end
+
+
+@
+We check that this \.{.aux} file can actually be opened, and then open it.
+
+@<Open this \.{.aux} file@>=
+begin
+start_name (cur_aux_str); {extension already there for \.{.aux} files}
+name_ptr := name_length+1;
+while (name_ptr <= file_name_size) do {pad with blanks}
+ begin
+ name_of_file[name_ptr] := ' ';
+ incr(name_ptr);
+ end;
+if (not a_open_in(cur_aux_file)) then
+ begin
+ print ('I couldn''t open auxiliary file ');
+ print_aux_name;
+ decr(aux_ptr);
+ aux_err_return;
+ end;
+print ('A level-',aux_ptr:0,' auxiliary file: ');
+print_aux_name;
+cur_aux_line := 0;
+end
+
+
+@
+Here we close the current-level \.{.aux} file and go back up a level,
+if possible, by decrementing |aux_ptr|.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure pop_the_aux_stack;
+begin
+a_close (cur_aux_file);
+if (aux_ptr=0) then
+ goto aux_done
+ else
+ decr(aux_ptr);
+end;
+
+
+@
+@^gymnastics@>
+That's it for processing \.{.aux} commands, except for finishing the
+procedural gymnastics.
+
+@<Procedures and functions for the reading and processing of input files@>=
+@<Scan for and process an \.{.aux} command@>
+
+
+@
+We must complain if anything's amiss.
+
+@d aux_end_err(#) == begin
+ aux_end1_err_print;
+ print (#);
+ aux_end2_err_print;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure aux_end1_err_print;
+begin
+print ('I found no ');
+end;
+@#
+procedure aux_end2_err_print;
+begin
+print ('---while reading file ');
+print_aux_name;
+mark_error;
+end;
+
+
+@
+Before proceeding, we see if we have any complaints.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure last_check_for_aux_errors;
+begin
+num_cites := cite_ptr; {record the number of distinct cite keys}
+num_bib_files := bib_ptr; {and the number of \.{.bib} files}
+if (not citation_seen) then
+ aux_end_err ('\citation commands')
+ else if ((num_cites = 0) and (not all_entries)) then
+ aux_end_err ('cite keys');
+if (not bib_seen) then
+ aux_end_err ('\bibdata command')
+ else if (num_bib_files = 0) then
+ aux_end_err ('database files');
+if (not bst_seen) then
+ aux_end_err ('\bibstyle command')
+ else if (bst_str = 0) then
+ aux_end_err ('style file');
+end;
+
+
+
+@* Reading the style file.
+This part of the program reads the \.{.bst} file, which consists of a
+sequence of commands. Each \.{.bst} command consists of a name (for
+which case differences are ignored) followed by zero or more
+arguments, each enclosed in braces.
+
+@d bst_done=32 {go here when finished with the \.{.bst} file}
+@d no_bst_file=9932 {go here when skipping the \.{.bst} file}
+
+@<Labels in the outer block@>=
+,@!bst_done,@!no_bst_file
+
+
+@
+The |bbl_line_num| gets initialized along with the |bst_line_num|, so
+it's declared here too.
+
+@<Globals in the outer block@>=
+@!bbl_line_num : integer; {line number of the \.{.bbl} (output) file}
+@!bst_line_num : integer; {line number of the \.{.bst} file}
+
+
+@
+This little procedure exists because it's used by at least two other
+procedures and thus saves some space.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_ln_num_print;
+begin
+print ('--line ',bst_line_num:0,' of file ');
+print_bst_name;
+end;
+
+
+@
+When there's a serious error parsing the \.{.bst} file, we flush the
+rest of the current command; a blank line is assumed to mark the end
+of a command (but for the purposes of error recovery only). Thus,
+error recovery will be better if style designers leave blank lines
+between \.{.bst} commands. This macro must be called from within a
+procedure that has an |exit| label.
+
+@d bst_err_print_and_look_for_blank_line_return ==
+ begin
+ bst_err_print_and_look_for_blank_line;
+ return;
+ end
+
+@d bst_err(#) == begin {serious error during \.{.bst} parsing}
+ print (#);
+ bst_err_print_and_look_for_blank_line_return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_err_print_and_look_for_blank_line;
+begin
+print ('-');
+bst_ln_num_print;
+print_bad_input_line; {this call does the |mark_error|}
+while (last <> 0) do {look for a blank input line}
+ if (not input_ln(bst_file)) then {or the end of the file}
+ goto bst_done
+ else
+ incr(bst_line_num);
+buf_ptr2 := last; {to input the next line}
+end;
+
+
+@
+When there's a harmless error parsing the \.{.bst} file (harmless
+syntactically, at least) we give just a |warning_message|.
+
+@d bst_warn(#) == begin {non-serious error during \.{.bst} parsing}
+ print (#);
+ bst_warn_print;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_warn_print;
+begin
+bst_ln_num_print;
+mark_warning;
+end;
+
+
+@
+Here's the outer loop for reading the \.{.bst} file---it keeps reading
+and processing \.{.bst} commands until none left. This is part of the
+main program; hence, because of the |bst_done| label, there's no
+conventional |begin|-|end| pair surrounding the entire module.
+
+@<Read and execute the \.{.bst} file@>=
+if (bst_str = 0) then {there's no \.{.bst} file to read}
+ goto no_bst_file; {this is a |goto| so that |bst_done| is not in a block}
+bst_line_num := 0; {initialize things}
+bbl_line_num := 1; {best spot to initialize the output line number}
+buf_ptr2 := last; {to get the first input line}
+loop
+ begin
+ if (not eat_bst_white_space) then {the end of the \.{.bst} file}
+ goto bst_done;
+ get_bst_command_and_process;
+ end;
+bst_done: a_close (bst_file);
+no_bst_file: a_close (bbl_file);
+
+
+@
+This \.{.bst}-specific scanning function skips over |white_space|
+characters (and comments) until hitting a nonwhite character or the
+end of the file, respectively returning |true| or |false|. It also
+updates |bst_line_num|, the line counter.
+
+@<Procedures and functions for input scanning@>=
+function eat_bst_white_space : boolean;
+label exit;
+begin
+loop
+ begin
+ if (scan_white_space) then {hit a nonwhite character on this line}
+ if (scan_char <> comment) then {it's not a comment character; return}
+ begin
+ eat_bst_white_space := true;
+ return;
+ end;
+ if (not input_ln(bst_file)) then {end-of-file; return |false|}
+ begin
+ eat_bst_white_space := false;
+ return;
+ end;
+ incr(bst_line_num);
+ buf_ptr2 := 0;
+ end;
+exit:
+end;
+
+
+@
+It's often illegal to end a \.{.bst} command in certain places, and
+this is where we come to check.
+
+@d eat_bst_white_and_eof_check(#) ==
+ begin
+ if (not eat_bst_white_space) then
+ begin
+ eat_bst_print;
+ bst_err (#);
+ end;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure eat_bst_print;
+begin
+print ('Illegal end of style file in command: ');
+end;
+
+
+@
+We must attend to a few details before getting to work on this
+\.{.bst} command.
+
+@<Scan for and process a \.{.bst} command@>=
+procedure get_bst_command_and_process;
+label exit;
+begin
+if (not scan_alpha) then
+ bst_err ('"',xchr[scan_char],'" can''t start a style-file command');
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+command_num := ilk_info[
+ str_lookup(buffer,buf_ptr1,token_len,bst_command_ilk,dont_insert)];
+if (not hash_found) then
+ begin
+ print_token;
+ bst_err (' is an illegal style-file command');
+ end;
+@<Process the appropriate \.{.bst} command@>;
+exit:
+end;
+
+
+@
+@^style-file commands@>
+@:this can't happen}{\quad Unknown style-file command@>
+Here we determine which \.{.bst} command we're about to process, and
+then go to it.
+
+@<Process the appropriate \.{.bst} command@>=
+case (command_num) of
+ n_bst_entry : bst_entry_command;
+ n_bst_execute : bst_execute_command;
+ n_bst_function : bst_function_command;
+ n_bst_integers : bst_integers_command;
+ n_bst_iterate : bst_iterate_command;
+ n_bst_macro : bst_macro_command;
+ n_bst_read : bst_read_command;
+ n_bst_reverse : bst_reverse_command;
+ n_bst_sort : bst_sort_command;
+ n_bst_strings : bst_strings_command;
+ othercases confusion ('Unknown style-file command')
+endcases
+
+
+@
+We need data structures for the function definitions, the entry
+variables, the global variables, and the actual entries corresponding
+to the cite-key list. First we define the classes of `function's
+used. Functions in all classes are of |bst_fn_ilk| except for
+|int_literal|s, which are of |integer_ilk|; and |str_literal|s, which
+are of |text_ilk|.
+
+@d built_in = 0 {the `primitive' functions}
+@d wiz_defined = 1 {defined in the \.{.bst} file}
+@d int_literal = 2 {integer `constants'}
+@d str_literal = 3 {string `constants'}
+@d field = 4 {things like `author' and `title'}
+@d int_entry_var = 5 {integer entry variable}
+@d str_entry_var = 6 {string entry variable}
+@d int_global_var = 7 {integer global variable}
+@d str_global_var = 8 {string global variable}
+@d last_fn_class = 8 {the same number as on the line above}
+
+
+@
+@:this can't happen}{\quad Unknown function class@>
+Here's another bug report.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure unknwn_function_class_confusion;
+begin
+confusion ('Unknown function class');
+end;
+
+
+@
+@:this can't happen}{\quad Unknown function class@>
+Occasionally we'll want to |print| the name of one of these function
+classes.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_fn_class (@!fn_loc : hash_loc);
+begin
+case (fn_type[fn_loc]) of
+ built_in : print ('built-in');
+ wiz_defined : print ('wizard-defined');
+ int_literal : print ('integer-literal');
+ str_literal : print ('string-literal');
+ field : print ('field');
+ int_entry_var : print ('integer-entry-variable');
+ str_entry_var : print ('string-entry-variable');
+ int_global_var : print ('integer-global-variable');
+ str_global_var : print ('string-global-variable');
+ othercases unknwn_function_class_confusion
+endcases;
+end;
+
+
+@
+@:this can't happen}{\quad Unknown function class@>
+This version is for printing when in |trace| mode.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+ trace
+ procedure trace_pr_fn_class (@!fn_loc : hash_loc);
+ begin
+ case (fn_type[fn_loc]) of
+ built_in : trace_pr ('built-in');
+ wiz_defined : trace_pr ('wizard-defined');
+ int_literal : trace_pr ('integer-literal');
+ str_literal : trace_pr ('string-literal');
+ field : trace_pr ('field');
+ int_entry_var : trace_pr ('integer-entry-variable');
+ str_entry_var : trace_pr ('string-entry-variable');
+ int_global_var : trace_pr ('integer-global-variable');
+ str_global_var : trace_pr ('string-global-variable');
+ othercases unknwn_function_class_confusion
+ endcases;
+ end;
+ ecart
+
+
+@
+Besides the function classes, we have types based on \BibTeX's
+capacity limitations and one based on what can go into the array
+|wiz_functions| explained below.
+
+@d quote_next_fn = hash_base - 1 {special marker used in defining functions}
+@d end_of_def = hash_max + 1 {another such special marker}
+
+@<Types in the outer block@>=
+@!fn_class = 0..last_fn_class; {the \.{.bst} function classes}
+@!wiz_fn_loc = 0..wiz_fn_space; {|wiz_defined|-function storage locations}
+@!int_ent_loc = 0..max_ent_ints; {|int_entry_var| storage locations}
+@!str_ent_loc = 0..max_ent_strs; {|str_entry_var| storage locations}
+@!str_glob_loc = 0..max_glb_str_minus_1; {|str_global_var| storage locations}
+@!field_loc = 0..max_fields; {individual field storage locations}
+@!hash_ptr2 = quote_next_fn..end_of_def; {a special marker or a |hash_loc|}
+
+
+@
+@^save space@>
+@^space savings@>
+@^system dependencies@>
+We store information about the \.{.bst} functions in arrays the same
+size as the hash-table arrays and in locations corresponding to their
+hash-table locations. The two arrays |fn_info| (an alias of
+|ilk_info| described earlier) and |fn_type| accomplish this: |fn_type|
+specifies one of the above classes, and |fn_info| gives information
+dependent on the class.
+
+Six other arrays give the contents of functions: The array
+|wiz_functions| holds definitions for |wiz_defined| functions---each
+such function consists of a sequence of pointers to hash-table
+locations of other functions (with the two special-marker exceptions
+above); the array |entry_ints| contains the current values of
+|int_entry_var|s; the array |entry_strs| contains the current values
+of |str_entry_var|s; an element of the array |global_strs| contains
+the current value of a |str_global_var| if the corresponding
+|glb_str_ptr| entry is empty, otherwise the nonempty entry is a
+pointer to the string; and the array |field_info|, for each field of
+each entry, contains either a pointer to the string or the special
+value |missing|.
+
+The array |global_strs| isn't packed (that is, it isn't |array| \dots\
+|of packed array| \dots$\,$) to increase speed on some systems;
+however, on systems that are byte-addressable and that have a good
+compiler, packing |global_strs| would save lots of space without much
+loss of speed.
+
+@d fn_info == ilk_info {an alias used with functions}
+@#
+@d missing = empty {a special pointer for missing fields}
+
+@<Globals in the outer block@>=
+@!fn_loc : hash_loc; {the hash-table location of a function}
+@!wiz_loc : hash_loc; {the hash-table location of a wizard function}
+@!literal_loc : hash_loc; {the hash-table location of a literal function}
+@!macro_name_loc : hash_loc; {the hash-table location of a macro name}
+@!macro_def_loc : hash_loc; {the hash-table location of a macro definition}
+@!fn_type : packed array[hash_loc] of fn_class;
+@!wiz_def_ptr : wiz_fn_loc; {storage location for the next wizard function}
+@!wiz_fn_ptr : wiz_fn_loc; {general |wiz_functions| location}
+@!wiz_functions : packed array[wiz_fn_loc] of hash_ptr2;
+@!int_ent_ptr : int_ent_loc; {general |int_entry_var| location}
+@!entry_ints : array[int_ent_loc] of integer;
+@!num_ent_ints : int_ent_loc; {the number of distinct |int_entry_var| names}
+@!str_ent_ptr : str_ent_loc; {general |str_entry_var| location}
+@!entry_strs : array[str_ent_loc] of
+ packed array[0..ent_str_size] of ASCII_code;
+@!num_ent_strs : str_ent_loc; {the number of distinct |str_entry_var| names}
+@!str_glb_ptr : 0..max_glob_strs; {general |str_global_var| location}
+@!glb_str_ptr : array[str_glob_loc] of str_number;
+@!global_strs : array[str_glob_loc] of array[0..glob_str_size] of ASCII_code;
+@!glb_str_end : array[str_glob_loc] of 0..glob_str_size; {end markers}
+@!num_glb_strs : 0..max_glob_strs; {number of distinct |str_global_var| names}
+@!field_ptr : field_loc; {general |field_info| location}
+@!field_parent_ptr,@!field_end_ptr : field_loc; {two more for doing cross-refs}
+@!cite_parent_ptr,@!cite_xptr : cite_number; {two others for doing cross-refs}
+@!field_info : packed array[field_loc] of str_number;
+@!num_fields : field_loc; {the number of distinct field names}
+@!num_pre_defined_fields : field_loc; {so far, just one: \.{crossref}}
+@!crossref_num : field_loc; {the number given to \.{crossref}}
+@!no_fields : boolean; {used for |tr_print|ing entry information}
+
+
+@
+Now we initialize storage for the |wiz_defined| functions and we
+initialize variables so that the first |str_entry_var|,
+|int_entry_var|, |str_global_var|, and |field| name will be assigned
+the number~0. Note: The variables |num_ent_strs| and |num_fields|
+will also be set when pre-defining strings.
+
+@<Set initial values of key variables@>=
+wiz_def_ptr := 0;
+num_ent_ints := 0;
+num_ent_strs := 0;
+num_fields := 0;
+str_glb_ptr := 0;
+while (str_glb_ptr < max_glob_strs) do {make |str_global_var|s empty}
+ begin
+ glb_str_ptr[str_glb_ptr] := 0;
+ glb_str_end[str_glb_ptr] := 0;
+ incr(str_glb_ptr);
+ end;
+num_glb_strs := 0;
+
+
+
+@* Style-file commands.
+@^style-file commands@>
+There are ten \.{.bst} commands: Five (\.{entry}, \.{function},
+\.{integers}, \.{macro}, and \.{strings}) declare and define
+functions, one (\.{read}) reads in the \.{.bib}-file entries, and four
+(\.{execute}, \.{iterate}, \.{reverse}, and \.{sort})
+manipulate the entries and produce output.
+
+The boolean variables |entry_seen| and |read_seen| indicate whether
+we've yet encountered an \.{entry} and a \.{read} command. There must
+be exactly one of each of these, and the \.{entry} command, as well as
+any \.{macro} command, must precede the \.{read} command.
+Furthermore, the \.{read} command must precede the four that
+manipulate the entries and produce output.
+
+@<Globals in the outer block@>=
+@!entry_seen : boolean; {|true| if we've already seen an \.{entry} command}
+@!read_seen : boolean; {|true| if we've already seen a \.{read} command}
+@!read_performed : boolean; {|true| if we started reading the database file(s)}
+@!reading_completed : boolean; {|true| if we made it all the way through}
+@!read_completed : boolean; {|true| if the database info didn't bomb \BibTeX}
+
+
+@
+And we initialize them.
+
+@<Set initial values of key variables@>=
+entry_seen := false;
+read_seen := false;
+read_performed := false;
+reading_completed := false;
+read_completed := false;
+
+
+@
+@:this can't happen}{\quad Identifier scanning error@>
+Here's another bug.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure id_scanning_confusion;
+begin
+confusion ('Identifier scanning error');
+end;
+
+
+@
+@:this can't happen}{\quad Identifier scanning error@>
+This macro is used to scan all \.{.bst} identifiers. The argument
+supplies the \.{.bst} command name. The associated procedure simply
+prints an error message.
+
+@d bst_identifier_scan(#) ==
+ begin
+ scan_identifier (right_brace,comment,comment);
+ if ((scan_result = white_adjacent) or
+ (scan_result = specified_char_adjacent)) then
+ do_nothing
+ else
+ begin
+ bst_id_print;
+ bst_err (#);
+ end;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_id_print;
+begin
+if (scan_result = id_null) then
+ print ('"',xchr[scan_char],'" begins identifier, command: ')
+else if (scan_result = other_char_adjacent) then
+ print ('"',xchr[scan_char],'" immediately follows identifier, command: ')
+else
+ id_scanning_confusion;
+end;
+
+
+@
+This macro just makes sure we're at a |left_brace|.
+
+@d bst_get_and_check_left_brace(#) ==
+ begin
+ if (scan_char <> left_brace) then
+ begin
+ bst_left_brace_print;
+ bst_err (#);
+ end;
+ incr(buf_ptr2); {skip over the |left_brace|}
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_left_brace_print;
+begin
+print ('"',xchr[left_brace],'" is missing in command: ');
+end;
+
+
+@
+And this one, a |right_brace|.
+
+@d bst_get_and_check_right_brace(#) ==
+ begin
+ if (scan_char <> right_brace) then
+ begin
+ bst_right_brace_print;
+ bst_err (#);
+ end;
+ incr(buf_ptr2); {skip over the |right_brace|}
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_right_brace_print;
+begin
+print ('"',xchr[right_brace],'" is missing in command: ');
+end;
+
+
+@
+This macro complains if we've already encountered a function to be
+inserted into the hash table.
+
+@d check_for_already_seen_function(#) ==
+ begin
+ if (hash_found) then {already encountered this as a \.{.bst} function}
+ begin
+ already_seen_function_print (#);
+ return;
+ end;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure already_seen_function_print (@!seen_fn_loc : hash_loc);
+label exit; {so the call to |bst_err| works}
+begin
+print_pool_str (hash_text[seen_fn_loc]);
+print (' is already a type "');
+print_fn_class (seen_fn_loc);
+print_ln ('" function name');
+bst_err_print_and_look_for_blank_line_return;
+exit:
+end;
+
+
+@
+@:style-file commands}{\quad \.{entry}@>
+An \.{entry} command has three arguments, each a (possibly empty) list
+of function names between braces (the names are separated by one or
+more |white_space| characters). All function names in this and other
+commands must be legal \.{.bst} identifiers. Upper/lower cases are
+considered to be the same for function names in these lists---all
+upper-case letters are converted to lower case. These arguments give
+lists of |field|s, |int_entry_var|s, and |str_entry_var|s.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_entry_command;
+label exit;
+begin
+if (entry_seen) then
+ bst_err ('Illegal, another entry command');
+entry_seen := true; {now we've seen an \.{entry} command}
+eat_bst_white_and_eof_check ('entry');
+@<Scan the list of |field|s@>;
+eat_bst_white_and_eof_check ('entry');
+if (num_fields = num_pre_defined_fields) then
+ bst_warn ('Warning--I didn''t find any fields');
+@<Scan the list of |int_entry_var|s@>;
+eat_bst_white_and_eof_check ('entry');
+@<Scan the list of |str_entry_var|s@>;
+exit:
+end;
+
+
+@
+This module reads a |left_brace|, the list of |field|s, and a
+|right_brace|. The |field|s are those like `author' and `title.'
+
+@<Scan the list of |field|s@>=
+begin
+bst_get_and_check_left_brace ('entry');
+eat_bst_white_and_eof_check ('entry');
+while (scan_char <> right_brace) do
+ begin
+ bst_identifier_scan ('entry');
+ @<Insert a |field| into the hash table@>;
+ eat_bst_white_and_eof_check ('entry');
+ end;
+incr(buf_ptr2); {skip over the |right_brace|}
+end
+
+
+@
+@^secret agent man@>
+Here we insert the just found field name into the hash table, record
+it as a |field|, and assign it a number to be used in indexing into
+the |field_info| array.
+
+@<Insert a |field| into the hash table@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a field');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+fn_loc := str_lookup(buffer,buf_ptr1,token_len,bst_fn_ilk,do_insert);
+check_for_already_seen_function (fn_loc);
+fn_type[fn_loc] := field;@/
+fn_info[fn_loc] := num_fields; {give this field a number (take away its name)}
+incr(num_fields);
+end
+
+
+@
+This module reads a |left_brace|, the list of |int_entry_var|s,
+and a |right_brace|.
+
+@<Scan the list of |int_entry_var|s@>=
+begin
+bst_get_and_check_left_brace ('entry');
+eat_bst_white_and_eof_check ('entry');
+while (scan_char <> right_brace) do
+ begin
+ bst_identifier_scan ('entry');
+ @<Insert an |int_entry_var| into the hash table@>;
+ eat_bst_white_and_eof_check ('entry');
+ end;
+incr(buf_ptr2); {skip over the |right_brace|}
+end
+
+
+@
+Here we insert the just found |int_entry_var| name into the hash table
+and record it as an |int_entry_var|. An |int_entry_var| is one that
+the style designer wants a separate copy of for each entry.
+
+@<Insert an |int_entry_var| into the hash table@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is an integer entry-variable');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+fn_loc := str_lookup(buffer,buf_ptr1,token_len,bst_fn_ilk,do_insert);
+check_for_already_seen_function (fn_loc);
+fn_type[fn_loc] := int_entry_var;@/
+fn_info[fn_loc] := num_ent_ints; {give this |int_entry_var| a number}
+incr(num_ent_ints);
+end
+
+
+@
+This module reads a |left_brace|, the list of |str_entry_var|s, and a
+|right_brace|. A |str_entry_var| is one that the style designer wants
+a separate copy of for each entry.
+
+@<Scan the list of |str_entry_var|s@>=
+begin
+bst_get_and_check_left_brace ('entry');
+eat_bst_white_and_eof_check ('entry');
+while (scan_char <> right_brace) do
+ begin
+ bst_identifier_scan ('entry');
+ @<Insert a |str_entry_var| into the hash table@>;
+ eat_bst_white_and_eof_check ('entry');
+ end;
+incr(buf_ptr2); {skip over the |right_brace|}
+end
+
+
+@
+Here we insert the just found |str_entry_var| name into the hash
+table, record it as a |str_entry_var|, and set its pointer into
+|entry_strs|.
+
+@<Insert a |str_entry_var| into the hash table@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a string entry-variable');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+fn_loc := str_lookup(buffer,buf_ptr1,token_len,bst_fn_ilk,do_insert);
+check_for_already_seen_function (fn_loc);
+fn_type[fn_loc] := str_entry_var;@/
+fn_info[fn_loc] := num_ent_strs; {give this |str_entry_var| a number}
+incr(num_ent_strs);
+end
+
+
+@
+A legal argument for an \.{execute}, \.{iterate}, or \.{reverse}
+command must exist and be |built_in| or |wiz_defined|.
+Here's where we check, returning |true| if the argument is illegal.
+
+@<Procedures and functions for the reading and processing of input files@>=
+function bad_argument_token : boolean;
+label exit;
+begin
+bad_argument_token := true; {now it's easy to exit if necessary}
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+fn_loc := str_lookup(buffer,buf_ptr1,token_len,bst_fn_ilk,dont_insert);
+if (not hash_found) then {unknown \.{.bst} function}
+ begin
+ print_token;
+ bst_err (' is an unknown function');
+ end
+else if ((fn_type[fn_loc] <> built_in) and
+ (fn_type[fn_loc] <> wiz_defined)) then
+ begin
+ print_token;
+ print (' has bad function type ');
+ print_fn_class (fn_loc);
+ bst_err_print_and_look_for_blank_line_return;
+ end;
+bad_argument_token := false;
+exit:
+end;
+
+
+@
+@:style-file commands}{\quad \.{execute}@>
+An \.{execute} command has one argument, a single |built_in| or
+|wiz_defined| function name between braces. Upper/lower cases are
+considered to be the same---all upper-case letters are converted to
+lower case. Also, we must make sure we've already seen a \.{read}
+command.
+
+This module reads a |left_brace|, a single function to be executed,
+and a |right_brace|.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_execute_command;
+label exit;
+begin
+if (not read_seen) then
+ bst_err ('Illegal, execute command before read command');
+eat_bst_white_and_eof_check ('execute');
+bst_get_and_check_left_brace ('execute');
+eat_bst_white_and_eof_check ('execute');
+bst_identifier_scan ('execute');
+@<Check the \.{execute}-command argument token@>;
+eat_bst_white_and_eof_check ('execute');
+bst_get_and_check_right_brace ('execute');
+@<Perform an \.{execute} command@>;
+exit:
+end;
+
+
+@
+Before executing the function, we must make sure it's a legal one. It
+must exist and be |built_in| or |wiz_defined|.
+
+@<Check the \.{execute}-command argument token@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a to be executed function');
+ ecart@/
+if (bad_argument_token) then
+ return;
+end
+
+
+@
+@:style-file commands}{\quad \.{function}@>
+A \.{function} command has two arguments; the first is a
+|wiz_defined| function name between braces. Upper/lower cases are
+considered to be the same---all upper-case letters are converted to
+lower case. The second argument defines this function. It consists
+of a sequence of functions, between braces, separated by |white_space|
+characters. Upper/lower cases are considered to be the same for
+function names but not for |str_literal|s.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_function_command;
+label exit;
+begin
+eat_bst_white_and_eof_check ('function');
+@<Scan the |wiz_defined| function name@>;
+eat_bst_white_and_eof_check ('function');
+bst_get_and_check_left_brace ('function');
+scan_fn_def(wiz_loc); {this scans the function definition}
+exit:
+end;
+
+
+@
+This module reads a |left_brace|, a |wiz_defined| function name, and
+a |right_brace|.
+
+@<Scan the |wiz_defined| function name@>=
+begin
+bst_get_and_check_left_brace ('function');
+eat_bst_white_and_eof_check ('function');
+bst_identifier_scan ('function');
+@<Check the |wiz_defined| function name@>;
+eat_bst_white_and_eof_check ('function');
+bst_get_and_check_right_brace ('function');
+end
+
+
+@
+The function name must exist and be a new one; we mark it as
+|wiz_defined|. Also, see if it's the default entry-type function.
+
+@<Check the |wiz_defined| function name@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a wizard-defined function');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+wiz_loc := str_lookup(buffer,buf_ptr1,token_len,bst_fn_ilk,do_insert);
+check_for_already_seen_function (wiz_loc);
+fn_type[wiz_loc] := wiz_defined;
+if (hash_text[wiz_loc] = s_default) then {we've found the default entry-type}
+ b_default := wiz_loc; {see the |built_in| functions for |b_default|}
+end
+
+
+@
+We're about to start scanning tokens in a function definition. When a
+function token is illegal, we skip until it ends; a |white_space|
+character, an end-of-line, a |right_brace|, or a |comment| marks the
+end of the current token.
+
+@d next_token=25 {a bad function token; go read the next one}
+@#
+@d skip_token(#) == begin {not-so-serious error during \.{.bst} parsing}
+ print (#);
+ skip_token_print; {also, skip to the current token's end}
+ goto next_token;
+ end
+
+@<Procedures and functions for input scanning@>=
+procedure skip_token_print;
+begin
+print ('-');
+bst_ln_num_print;
+mark_error;
+if (scan2_white(right_brace,comment)) then {ok if token ends line}
+ do_nothing;
+end;
+
+
+@
+@^commented-out code@>
+@^for a good time, try comment-out code@>
+This macro is similar to the last one but is specifically for
+recursion in a |wiz_defined| function, which is illegal; it helps save
+space.
+
+@d skip_recursive_token == begin
+ print_recursion_illegal;
+ goto next_token;
+ end
+
+@<Procedures and functions for input scanning@>=
+procedure print_recursion_illegal;
+begin
+ trace
+ trace_pr_newline;
+ ecart@/
+print_ln ('Curse you, wizard, before you recurse me:');
+print ('function ');
+print_token;
+print_ln (' is illegal in its own definition');
+ @{
+ print_recursion_illegal;
+ @}@/
+skip_token_print; {also, skip to the current token's end}
+end;
+
+
+@
+Here's another macro for saving some space when there's a problem with
+a token.
+
+@d skip_token_unknown_function == begin
+ skp_token_unknown_function_print;
+ goto next_token;
+ end
+
+@<Procedures and functions for input scanning@>=
+procedure skp_token_unknown_function_print;
+begin
+print_token;
+print (' is an unknown function');
+skip_token_print; {also, skip to the current token's end}
+end;
+
+
+@
+And another.
+
+@d skip_token_illegal_stuff_after_literal ==
+ begin
+ skip_illegal_stuff_after_token_print;
+ goto next_token;
+ end
+
+@<Procedures and functions for input scanning@>=
+procedure skip_illegal_stuff_after_token_print;
+begin
+print ('"',xchr[scan_char],'" can''t follow a literal');
+skip_token_print; {also, skip to the current token's end}
+end;
+
+
+@
+This recursive function reads and stores the list of functions
+(separated by |white_space| characters or ends-of-line) that define
+this new function, and reads a |right_brace|.
+
+@<Procedures and functions for input scanning@>=
+procedure scan_fn_def (@!fn_hash_loc : hash_loc);
+label next_token,@!exit;
+type @!fn_def_loc = 0..single_fn_space; {for a single |wiz_defined|-function}
+var singl_function : packed array[fn_def_loc] of hash_ptr2;
+ @!single_ptr : fn_def_loc; {next storage location for this definition}
+ @!copy_ptr : fn_def_loc; {dummy variable}
+ @!end_of_num : buf_pointer; {the end of an implicit function's name}
+ @!impl_fn_loc : hash_loc; {an implicit function's hash-table location}
+begin
+eat_bst_white_and_eof_check ('function');
+single_ptr := 0;
+while (scan_char <> right_brace) do
+ begin
+ @<Get the next function of the definition@>;
+next_token:
+ eat_bst_white_and_eof_check ('function');
+ end;
+@<Complete this function's definition@>;
+incr(buf_ptr2); {skip over the |right_brace|}
+exit:
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad single function space@>
+This macro inserts a hash-table location (or one of the two
+special markers |quote_next_fn| and |end_of_def|) into the
+|singl_function| array, which will later be copied into the
+|wiz_functions| array.
+
+@d insert_fn_loc(#) == begin
+ singl_function[single_ptr] := #;
+ if (single_ptr = single_fn_space) then
+ singl_fn_overflow;
+ incr(single_ptr);
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure singl_fn_overflow;
+begin
+overflow('single function space ',single_fn_space);
+end;
+
+
+@
+There are five possibilities for the first character of the token
+representing the next function of the definition: If it's a
+|number_sign|, the token is an |int_literal|; if it's a
+|double_quote|, the token is a |str_literal|; if it's a
+|single_quote|, the token is a quoted function; if it's a
+|left_brace|, the token isn't really a token, but rather the start of
+another function definition (which will result in a recursive call to
+|scan_fn_def|); if it's anything else, the token is the name of an
+already-defined function. Note: To prevent the wizard from using
+recursion, we have to check that neither a quoted function nor an
+already-defined-function is actually the currently-being-defined
+function (which is stored at |wiz_loc|).
+
+@<Get the next function of the definition@>=
+case (scan_char) of
+ number_sign : @<Scan an |int_literal|@>;
+ double_quote : @<Scan a |str_literal|@>;
+ single_quote : @<Scan a quoted function@>;
+ left_brace : @<Start a new function definition@>;
+ othercases @<Scan an already-defined function@>
+endcases
+
+
+@
+An |int_literal| is preceded by a |number_sign|, consists of an
+integer (i.e., an optional |minus_sign| followed by one or more
+|numeric| characters), and is followed either by a |white_space|
+character, an end-of-line, or a |right_brace|. The array |fn_info|
+contains the value of the integer for |int_literal|s.
+
+@<Scan an |int_literal|@>=
+begin
+incr(buf_ptr2); {skip over the |number_sign|}
+if (not scan_integer) then
+ skip_token ('Illegal integer in integer literal');
+ trace
+ trace_pr ('#');
+ trace_pr_token;
+ trace_pr_ln (' is an integer literal with value ',token_value:0);
+ ecart@/
+literal_loc := str_lookup(buffer,buf_ptr1,token_len,integer_ilk,do_insert);
+if (not hash_found) then
+ begin
+ fn_type[literal_loc] := int_literal; {set the |fn_class|}
+ fn_info[literal_loc] := token_value; {the value of this integer}
+ end;
+if ((lex_class[scan_char]<>white_space) and (buf_ptr2<last) and
+ (scan_char<>right_brace) and@| (scan_char<>comment)) then
+ skip_token_illegal_stuff_after_literal;
+insert_fn_loc (literal_loc); {add this function to |wiz_functions|}
+end
+
+
+@
+A |str_literal| is preceded by a |double_quote| and consists of all
+characters on this line up to the next |double_quote|. Also, there
+must be either a |white_space| character, an end-of-line, a
+|right_brace|, or a |comment| following (since functions in the
+definition must be separated by |white_space|). The array |fn_info|
+contains nothing for |str_literal|s.
+
+@<Scan a |str_literal|@>=
+begin
+incr(buf_ptr2); {skip over the |double_quote|}
+if (not scan1(double_quote)) then
+ skip_token ('No `',xchr[double_quote],''' to end string literal');
+ trace
+ trace_pr ('"');
+ trace_pr_token;
+ trace_pr ('"');
+ trace_pr_ln (' is a string literal');
+ ecart@/
+literal_loc := str_lookup(buffer,buf_ptr1,token_len,text_ilk,do_insert);@/
+fn_type[literal_loc] := str_literal; {set the |fn_class|}
+incr(buf_ptr2); {skip over the |double_quote|}
+if ((lex_class[scan_char]<>white_space) and (buf_ptr2<last) and
+ (scan_char<>right_brace) and@| (scan_char<>comment)) then
+ skip_token_illegal_stuff_after_literal;
+insert_fn_loc (literal_loc); {add this function to |wiz_functions|}
+end
+
+
+@
+A quoted function is preceded by a |single_quote| and consists of all
+characters up to the next |white_space| character, end-of-line,
+|right_brace|, or |comment|.
+
+@<Scan a quoted function@>=
+begin
+incr(buf_ptr2); {skip over the |single_quote|}
+if (scan2_white(right_brace,comment)) then {ok if token ends line}
+ do_nothing;
+ trace
+ trace_pr ('''');
+ trace_pr_token;
+ trace_pr (' is a quoted function ');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+fn_loc := str_lookup(buffer,buf_ptr1,token_len,bst_fn_ilk,dont_insert);
+if (not hash_found) then {unknown \.{.bst} function}
+ skip_token_unknown_function
+else
+ @<Check and insert the quoted function@>;
+end
+
+
+@
+Here we check that this quoted function is a legal one---the function
+name must already exist, but it mustn't be the currently-being-defined
+function (which is stored at |wiz_loc|).
+
+@<Check and insert the quoted function@>=
+begin
+if (fn_loc = wiz_loc) then
+ skip_recursive_token
+else
+ begin
+ trace
+ trace_pr ('of type ');
+ trace_pr_fn_class (fn_loc);
+ trace_pr_newline;
+ ecart@/
+ insert_fn_loc (quote_next_fn); {add special marker together with}
+ insert_fn_loc (fn_loc); {this function to |wiz_functions|}
+ end
+end
+
+
+@
+@^kludge@>
+@:this can't happen}{\quad Already encountered implicit function@>
+This module marks the implicit function as being quoted, generates a
+name, and stores it in the hash table. This name is strictly internal
+to this program, starts with a |single_quote| (since that will make
+this function name unique), and ends with the variable |impl_fn_num|
+converted to ASCII. The alias kludge helps make the stack space not
+overflow on some machines.
+
+@d ex_buf2 == ex_buf {an alias, used only in this module}
+
+@<Start a new function definition@>=
+begin
+ex_buf2[0] := single_quote;
+int_to_ASCII (impl_fn_num,ex_buf2,1,end_of_num);
+impl_fn_loc := str_lookup(ex_buf2,0,end_of_num,bst_fn_ilk,do_insert);
+if (hash_found) then
+ confusion ('Already encountered implicit function');
+ trace
+ trace_pr_pool_str (hash_text[impl_fn_loc]);
+ trace_pr_ln (' is an implicit function');
+ ecart@/
+incr(impl_fn_num);
+fn_type[impl_fn_loc] := wiz_defined;@/
+insert_fn_loc (quote_next_fn); {all implicit functions are quoted}
+insert_fn_loc (impl_fn_loc); {add it to |wiz_functions|}
+incr(buf_ptr2); {skip over the |left_brace|}
+scan_fn_def (impl_fn_loc); {this is the recursive call}
+end
+
+
+@
+The variable |impl_fn_num| counts the number of implicit functions
+seen in the \.{.bst} file.
+
+@<Globals in the outer block@>=
+@!impl_fn_num : integer; {the number of implicit functions seen so far}
+
+
+@
+Now we initialize it.
+
+@<Set initial values of key variables@>=
+impl_fn_num := 0;
+
+
+@
+@:BibTeX capacity exceeded}{\quad buffer size@>
+This module appends a character to |int_buf| after checking to make
+sure it will fit; for use in |int_to_ASCII|.
+
+@d append_int_char(#) == begin
+ if (int_ptr = buf_size) then
+ buffer_overflow;
+ int_buf[int_ptr]:=#;
+ incr(int_ptr);
+ end
+
+
+@
+This procedure takes the integer |int|, copies the appropriate
+|ASCII_code| string into |int_buf| starting at |int_begin|, and sets
+the |var| parameter |int_end| to the first unused |int_buf| location.
+The ASCII string will consist of decimal digits, the first of which
+will be not be a~0 if the integer is nonzero, with a prepended minus
+sign if the integer is negative.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+procedure int_to_ASCII (@!int:integer; var int_buf:buf_type;
+ @!int_begin:buf_pointer; var int_end:buf_pointer);
+var int_ptr,@!int_xptr : buf_pointer; {pointers into |int_buf|}
+ @!int_tmp_val : ASCII_code; {the temporary element in an exchange}
+begin
+int_ptr := int_begin;
+if (int < 0) then {add the |minus_sign| and use the absolute value}
+ begin
+ append_int_char (minus_sign);
+ int := -int;
+ end;
+int_xptr := int_ptr;
+repeat {copy digits into |int_buf|}
+ append_int_char ("0" + (int mod 10));
+ int := int div 10;
+ until (int = 0);
+int_end := int_ptr; {set the string length}
+decr(int_ptr);
+while (int_xptr < int_ptr) do {and reorder (flip) the digits}
+ begin
+ int_tmp_val := int_buf[int_xptr];
+ int_buf[int_xptr] := int_buf[int_ptr];
+ int_buf[int_ptr] := int_tmp_val;
+ decr(int_ptr);
+ incr(int_xptr);
+ end
+end;
+
+
+@
+An already-defined function consists of all characters up to the next
+|white_space| character, end-of-line, |right_brace|, or |comment|.
+This function name must already exist, but it mustn't be the
+currently-being-defined function (which is stored at |wiz_loc|).
+
+@<Scan an already-defined function@>=
+begin
+if (scan2_white(right_brace,comment)) then {ok if token ends line}
+ do_nothing;
+ trace
+ trace_pr_token;
+ trace_pr (' is a function ');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+fn_loc := str_lookup(buffer,buf_ptr1,token_len,bst_fn_ilk,dont_insert);
+if (not hash_found) then {unknown \.{.bst} function}
+ skip_token_unknown_function
+else if (fn_loc = wiz_loc) then
+ skip_recursive_token
+else
+ begin
+ trace
+ trace_pr ('of type ');
+ trace_pr_fn_class (fn_loc);
+ trace_pr_newline;
+ ecart@/
+ insert_fn_loc (fn_loc); {add this function to |wiz_functions|}
+ end;
+end
+
+
+@
+@:BibTeX capacity exceeded}{\quad wizard-defined function space@>
+Now we add the |end_of_def| special marker, make sure this function will
+fit into |wiz_functions|, and put it there.
+
+@<Complete this function's definition@>=
+begin
+insert_fn_loc (end_of_def); {add special marker ending the definition}
+if (single_ptr + wiz_def_ptr > wiz_fn_space) then
+ begin
+ print (single_ptr + wiz_def_ptr : 0,': ');
+ overflow('wizard-defined function space ',wiz_fn_space);
+ end;
+fn_info[fn_hash_loc] := wiz_def_ptr; {pointer into |wiz_functions|}
+copy_ptr := 0;
+while (copy_ptr < single_ptr) do {make this function official}
+ begin
+ wiz_functions[wiz_def_ptr] := singl_function[copy_ptr];
+ incr(copy_ptr);
+ incr(wiz_def_ptr);
+ end;
+end
+
+
+@
+@:style-file commands}{\quad \.{integers}@>
+An \.{integers} command has one argument, a list of function names
+between braces (the names are separated by one or more |white_space|
+characters). Upper/lower cases are considered to be the same for
+function names in these lists---all upper-case letters are converted to
+lower case. Each name in this list specifies an |int_global_var|.
+There may be several \.{integers} commands in the \.{.bst} file.
+
+This module reads a |left_brace|, a list of |int_global_var|s, and a
+|right_brace|.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_integers_command;
+label exit;
+begin
+eat_bst_white_and_eof_check ('integers');
+bst_get_and_check_left_brace ('integers');
+eat_bst_white_and_eof_check ('integers');
+while (scan_char <> right_brace) do
+ begin
+ bst_identifier_scan ('integers');
+ @<Insert an |int_global_var| into the hash table@>;
+ eat_bst_white_and_eof_check ('integers');
+ end;
+incr(buf_ptr2); {skip over the |right_brace|}
+exit:
+end;
+
+
+@
+Here we insert the just found |int_global_var| name into the hash
+table and record it as an |int_global_var|. Also, we initialize it by
+setting |fn_info[fn_loc]| to 0.
+
+@<Insert an |int_global_var| into the hash table@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is an integer global-variable');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+fn_loc := str_lookup(buffer,buf_ptr1,token_len,bst_fn_ilk,do_insert);
+check_for_already_seen_function (fn_loc);
+fn_type[fn_loc] := int_global_var;@/
+fn_info[fn_loc] := 0; {initialize}
+end
+
+
+@
+@:style-file commands}{\quad \.{iterate}@>
+An \.{iterate} command has one argument, a single |built_in| or
+|wiz_defined| function name between braces. Upper/lower cases are
+considered to be the same---all upper-case letters are converted to
+lower case. Also, we must make sure we've already seen a \.{read}
+command.
+
+This module reads a |left_brace|, a single function to be iterated,
+and a |right_brace|.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_iterate_command;
+label exit;
+begin
+if (not read_seen) then
+ bst_err ('Illegal, iterate command before read command');
+eat_bst_white_and_eof_check ('iterate');
+bst_get_and_check_left_brace ('iterate');
+eat_bst_white_and_eof_check ('iterate');
+bst_identifier_scan ('iterate');
+@<Check the \.{iterate}-command argument token@>;
+eat_bst_white_and_eof_check ('iterate');
+bst_get_and_check_right_brace ('iterate');
+@<Perform an \.{iterate} command@>;
+exit:
+end;
+
+
+@
+Before iterating the function, we must make sure it's a legal one. It
+must exist and be |built_in| or |wiz_defined|.
+
+@<Check the \.{iterate}-command argument token@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a to be iterated function');
+ ecart@/
+if (bad_argument_token) then
+ return;
+end
+
+
+@
+@:style-file commands}{\quad \.{macro}@>
+A \.{macro} command, like a \.{function} command, has two arguments;
+the first is a macro name between braces. The name must be a legal
+\.{.bst} identifier. Upper/lower cases are considered to be the
+same---all upper-case letters are converted to lower case. The second
+argument defines this macro. It consists of a
+|double_quote|-delimited string (which must be on a single line)
+between braces, with optional |white_space| characters between the
+braces and the |double_quote|s. This |double_quote|-delimited string
+is parsed exactly as a |str_literal| is for the \.{function} command.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_macro_command;
+label exit;
+begin
+if (read_seen) then
+ bst_err ('Illegal, macro command after read command');
+eat_bst_white_and_eof_check ('macro');
+@<Scan the macro name@>;
+eat_bst_white_and_eof_check ('macro');
+@<Scan the macro's definition@>;
+exit:
+end;
+
+
+@
+This module reads a |left_brace|, a macro name, and a |right_brace|.
+
+@<Scan the macro name@>=
+begin
+bst_get_and_check_left_brace ('macro');
+eat_bst_white_and_eof_check ('macro');
+bst_identifier_scan ('macro');
+@<Check the macro name@>;
+eat_bst_white_and_eof_check ('macro');
+bst_get_and_check_right_brace ('macro');
+end
+
+
+@
+The macro name must be a new one; we mark it as |macro_ilk|.
+
+@<Check the macro name@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a macro');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+macro_name_loc := str_lookup(buffer,buf_ptr1,token_len,macro_ilk,do_insert);
+if (hash_found) then
+ begin
+ print_token;
+ bst_err (' is already defined as a macro');
+ end;
+ilk_info[macro_name_loc]:=hash_text[macro_name_loc]; {default in case of error}
+end
+
+
+@
+This module reads a |left_brace|, the |double_quote|-delimited string
+that defines this macro, and a |right_brace|.
+
+@<Scan the macro's definition@>=
+begin
+bst_get_and_check_left_brace ('macro');
+eat_bst_white_and_eof_check ('macro');
+if (scan_char <> double_quote) then
+ bst_err ('A macro definition must be ',xchr[double_quote],'-delimited');
+@<Scan the macro definition-string@>;
+eat_bst_white_and_eof_check ('macro');
+bst_get_and_check_right_brace ('macro');
+end
+
+
+@
+A macro definition-string is preceded by a |double_quote| and consists
+of all characters on this line up to the next |double_quote|. The
+array |ilk_info| contains a pointer to this string for the macro name.
+
+@<Scan the macro definition-string@>=
+begin
+incr(buf_ptr2); {skip over the |double_quote|}
+if (not scan1(double_quote)) then
+ bst_err ('There''s no `',xchr[double_quote],''' to end macro definition');
+ trace
+ trace_pr ('"');
+ trace_pr_token;
+ trace_pr ('"');
+ trace_pr_ln (' is a macro string');
+ ecart@/
+macro_def_loc := str_lookup(buffer,buf_ptr1,token_len,text_ilk,do_insert);@/
+fn_type[macro_def_loc] := str_literal; {set the |fn_class|}
+ilk_info[macro_name_loc] := hash_text[macro_def_loc];
+incr(buf_ptr2); {skip over the |double_quote|}
+end
+
+
+@
+@^gymnastics@>
+We need to include stuff for \.{.bib} reading here because that's done
+by the \.{read} command.
+
+@<Procedures and functions for the reading and processing of input files@>=
+@<Scan for and process a \.{.bib} command or database entry@>
+
+
+@
+@:style-file commands}{\quad \.{read}@>
+The \.{read} command has no arguments so there's no more parsing to
+do. We must make sure we haven't seen a \.{read} command before and
+we've already seen an \.{entry} command.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_read_command;
+label exit;
+begin
+if (read_seen) then
+ bst_err ('Illegal, another read command');
+read_seen := true; {now we've seen a \.{read} command}
+if (not entry_seen) then
+ bst_err ('Illegal, read command before entry command');
+sv_ptr1 := buf_ptr2; {save the contents of the \.{.bst} input line}
+sv_ptr2 := last;
+tmp_ptr := sv_ptr1;
+while (tmp_ptr < sv_ptr2) do
+ begin
+ sv_buffer[tmp_ptr] := buffer[tmp_ptr];
+ incr(tmp_ptr);
+ end;
+@<Read the \.{.bib} file(s)@>;
+buf_ptr2 := sv_ptr1; {and restore}
+last := sv_ptr2;
+tmp_ptr := buf_ptr2;
+while (tmp_ptr < last) do
+ begin
+ buffer[tmp_ptr] := sv_buffer[tmp_ptr];
+ incr(tmp_ptr);
+ end;
+exit:
+end;
+
+
+@
+@:style-file commands}{\quad \.{reverse}@>
+A \.{reverse} command has one argument, a single |built_in| or
+|wiz_defined| function name between braces. Upper/lower cases are
+considered to be the same---all upper-case letters are converted to
+lower case. Also, we must make sure we've already seen a \.{read}
+command.
+
+This module reads a |left_brace|, a single function to be iterated in
+reverse, and a |right_brace|.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_reverse_command;
+label exit;
+begin
+if (not read_seen) then
+ bst_err ('Illegal, reverse command before read command');
+eat_bst_white_and_eof_check ('reverse');
+bst_get_and_check_left_brace ('reverse');
+eat_bst_white_and_eof_check ('reverse');
+bst_identifier_scan ('reverse');
+@<Check the \.{reverse}-command argument token@>;
+eat_bst_white_and_eof_check ('reverse');
+bst_get_and_check_right_brace ('reverse');
+@<Perform a \.{reverse} command@>;
+exit:
+end;
+
+
+@
+Before iterating the function in reverse, we must make sure it's a
+legal one. It must exist and be |built_in| or |wiz_defined|.
+
+@<Check the \.{reverse}-command argument token@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a to be iterated in reverse function');
+ ecart@/
+if (bad_argument_token) then
+ return;
+end
+
+
+@
+@:style-file commands}{\quad \.{sort}@>
+The \.{sort} command has no arguments so there's no more parsing to
+do, but we must make sure we've already seen a \.{read} command.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_sort_command;
+label exit;
+begin
+if (not read_seen) then
+ bst_err ('Illegal, sort command before read command');
+@<Perform a \.{sort} command@>;
+exit:
+end;
+
+
+@
+@:style-file commands}{\quad \.{strings}@>
+A \.{strings} command has one argument, a list of function names
+between braces (the names are separated by one or more |white_space|
+characters). Upper/lower cases are considered to be the same for
+function names in these lists---all upper-case letters are converted to
+lower case. Each name in this list specifies a |str_global_var|.
+There may be several \.{strings} commands in the \.{.bst} file.
+
+This module reads a |left_brace|, a list of |str_global_var|s,
+and a |right_brace|.
+
+@<Procedures and functions for the reading and processing of input files@>=
+procedure bst_strings_command;
+label exit;
+begin
+eat_bst_white_and_eof_check ('strings');
+bst_get_and_check_left_brace ('strings');
+eat_bst_white_and_eof_check ('strings');
+while (scan_char <> right_brace) do
+ begin
+ bst_identifier_scan ('strings');
+ @<Insert a |str_global_var| into the hash table@>;
+ eat_bst_white_and_eof_check ('strings');
+ end;
+incr(buf_ptr2); {skip over the |right_brace|}
+exit:
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad number of string global-variables@>
+Here we insert the just found |str_global_var| name into the hash
+table, record it as a |str_global_var|, set its pointer into
+|global_strs|, and initialize its value there to the null string.
+
+@d end_of_string = invalid_code {this illegal |ASCII_code| ends a string}
+
+@<Insert a |str_global_var| into the hash table@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a string global-variable');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+fn_loc := str_lookup(buffer,buf_ptr1,token_len,bst_fn_ilk,do_insert);
+check_for_already_seen_function (fn_loc);
+fn_type[fn_loc] := str_global_var;@/
+fn_info[fn_loc] := num_glb_strs; {pointer into |global_strs|}
+if (num_glb_strs = max_glob_strs) then
+ overflow('number of string global-variables ',max_glob_strs);
+incr(num_glb_strs);
+end
+
+
+@
+@^gymnastics@>
+That's it for processing \.{.bst} commands, except for finishing the
+procedural gymnastics. Note that this must topologically follow the
+stuff for \.{.bib} reading, because that's done by the \.{.bst}'s
+\.{read} command.
+
+@<Procedures and functions for the reading and processing of input files@>=
+@<Scan for and process a \.{.bst} command@>
+
+
+
+@* Reading the database file(s).
+This section reads the \.{.bib} file(s), each of which consists of a
+sequence of entries (perhaps with a few \.{.bib} commands thrown in,
+as explained later). Each entry consists of an |at_sign|, an entry
+type, and, between braces or parentheses and separated by |comma|s, a
+database key and a list of fields. Each field consists of a field
+name, an |equals_sign|, and nonempty list of field tokens separated by
+|concat_char|s. Each field token is either a nonnegative number, a
+macro name (like `jan'), or a brace-balanced string delimited by
+either |double_quote|s or braces. Finally, case differences are
+ignored for all but delimited strings and database keys, and
+|white_space| characters and ends-of-line may appear in all reasonable
+places (i.e., anywhere except within entry types, database keys, field
+names, and macro names); furthermore, comments may appear anywhere
+between entries (or before the first or after the last) as long as
+they contain no |at_sign|s.
+
+
+@
+These global variables are used while reading the \.{.bib} file(s).
+The elements of |type_list|, which indicate an entry's type (book,
+article, etc.), point either to a |hash_loc| or are one of two special
+markers: |empty|, from which |hash_base = empty + 1| was defined,
+means we haven't yet encountered the \.{.bib} entry corresponding to
+this cite key; and |undefined| means we've encountered it but it had
+an unknown entry type. Thus the array |type_list| is of type
+|hash_ptr2|, also defined earlier. An element of the boolean array
+|entry_exists| whose corresponding entry in |cite_list| gets
+overwritten (which happens only when |all_entries| is |true|)
+indicates whether we've encountered that entry of |cite_list| while
+reading the \.{.bib} file(s); this information is unused for entries
+that aren't (or more precisely, that have no chance of being)
+overwritten. When we're reading the database file, the array
+|cite_info| contains auxiliary information for |cite_list|. Later,
+|cite_info| will become |sorted_cites|, and this dual role imposes the
+(not-very-imposing) restriction |max_strings >= max_cites|.
+
+@d undefined = hash_max + 1 {a special marker used for |type_list|}
+
+@<Globals in the outer block@>=
+@!bib_line_num : integer; {line number of the \.{.bib} file}
+@!entry_type_loc : hash_loc; {the hash-table location of an entry type}
+@!type_list : packed array[cite_number] of hash_ptr2;
+@!type_exists : boolean; {|true| if this entry type is \.{.bst}-defined}
+@!entry_exists : packed array[cite_number] of boolean;
+@!store_entry : boolean; {|true| if we're to store info for this entry}
+@!field_name_loc : hash_loc; {the hash-table location of a field name}
+@!field_val_loc : hash_loc; {the hash-table location of a field value}
+@!store_field : boolean; {|true| if we're to store info for this field}
+@!store_token : boolean; {|true| if we're to store this macro token}
+@!right_outer_delim : ASCII_code; {either a |right_brace| or a |right_paren|}
+@!right_str_delim : ASCII_code; {either a |right_brace| or a |double_quote|}
+@!at_bib_command : boolean; {|true| for a command, false for an entry}
+@!cur_macro_loc : hash_loc; {|macro_loc| for a \.{string} being defined}
+@!cite_info : packed array[cite_number] of str_number; {extra |cite_list| info}
+@!cite_hash_found : boolean; {set to a previous |hash_found| value}
+@!preamble_ptr : bib_number; {pointer into the |s_preamble| array}
+@!num_preamble_strings : bib_number; {counts the |s_preamble| strings}
+
+
+@
+This little procedure exists because it's used by at least two other
+procedures and thus saves some space.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bib_ln_num_print;
+begin
+print ('--line ',bib_line_num:0,' of file ');
+print_bib_name;
+end;
+
+
+@
+When there's a serious error parsing a \.{.bib} file, we flush
+everything up to the beginning of the next entry.
+
+@d bib_err(#) == begin {serious error during \.{.bib} parsing}
+ print (#);
+ bib_err_print;
+ return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bib_err_print;
+begin
+print ('-');
+bib_ln_num_print;
+print_bad_input_line; {this call does the |mark_error|}
+print_skipping_whatever_remains;
+if (at_bib_command) then
+ print_ln ('command')
+ else
+ print_ln ('entry');
+end;
+
+
+@
+When there's a harmless error parsing a \.{.bib} file, we just give a
+warning message. This is always called after other stuff has been
+printed out.
+
+@d bib_warn(#) == begin {non-serious error during \.{.bst} parsing}
+ print (#);
+ bib_warn_print;
+ end
+@#
+@d bib_warn_newline(#) == begin {same as above but with a newline}
+ print_ln (#);
+ bib_warn_print;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bib_warn_print;
+begin
+bib_ln_num_print;
+mark_warning;
+end;
+
+
+@
+For all |num_bib_files| database files, we keep reading and processing
+\.{.bib} entries until none left.
+
+@<Read the \.{.bib} file(s)@>=
+begin
+@<Final initialization for \.{.bib} processing@>;
+read_performed := true;
+bib_ptr := 0;
+while (bib_ptr < num_bib_files) do
+ begin
+ print ('Database file #',bib_ptr+1:0,': ');
+ print_bib_name;@/
+ bib_line_num := 0; {initialize to get the first input line}
+ buf_ptr2 := last;
+ while (not eof(cur_bib_file)) do
+ get_bib_command_or_entry_and_process;
+ a_close (cur_bib_file);
+ incr(bib_ptr);
+ end;
+reading_completed := true;
+ trace
+ trace_pr_ln ('Finished reading the database file(s)');
+ ecart@/
+@<Final initialization for processing the entries@>;
+read_completed := true;
+end
+
+
+@
+We need to initialize the |field_info| array, and also various things
+associated with the |cite_list| array (but not |cite_list| itself).
+
+@<Final initialization for \.{.bib} processing@>=
+begin
+@<Initialize the |field_info|@>;
+@<Initialize things for the |cite_list|@>;
+end
+
+
+@
+This module initializes all fields of all entries to |missing|, the
+value to which all fields are initialized.
+
+@<Initialize the |field_info|@>=
+begin
+check_field_overflow (num_fields*num_cites);
+field_ptr := 0;
+while (field_ptr < max_fields) do
+ begin
+ field_info[field_ptr] := missing;
+ incr(field_ptr);
+ end;
+end
+
+
+@
+@^fetish@>
+@:BibTeX capacity exceeded}{\quad total number of fields@>
+Complain if somebody's got a field fetish.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure check_field_overflow (@!total_fields : integer);
+begin
+if (total_fields > max_fields) then
+ begin
+ print_ln (total_fields:0,' fields:');
+ overflow('total number of fields ',max_fields);
+ end;
+end;
+
+
+@
+We must initialize the |type_list| array so that we can detect
+duplicate (or missing) entries for cite keys on |cite_list|. Also,
+when we're to include the entire database, we use the array
+|entry_exists| to detect those missing entries whose |cite_list| info
+will (or to be more precise, might) be overwritten; and we use the
+array |cite_info| to save the part of |cite_list| that will (might) be
+overwritten. We also use |cite_info| for counting cross~references
+when it's appropriate---when an entry isn't otherwise to be included
+on |cite_list| (that is, the entry isn't \.{\\cite}d or
+\.{\\nocite}d). Such an entry is included on the final |cite_list| if
+it's cross~referenced at least |min_crossrefs| times.
+
+@<Initialize things for the |cite_list|@>=
+begin
+cite_ptr := 0;
+while (cite_ptr < max_cites) do
+ begin
+ type_list[cite_ptr] := empty;@/
+ cite_info[cite_ptr] := any_value; {to appeas \PASCAL's boolean evaluation}
+ incr(cite_ptr);
+ end;
+old_num_cites := num_cites;
+if (all_entries) then
+ begin
+ cite_ptr := all_marker;
+ while (cite_ptr < old_num_cites) do
+ begin
+ cite_info[cite_ptr] := cite_list[cite_ptr];
+ entry_exists[cite_ptr] := false;
+ incr(cite_ptr);
+ end;
+ cite_ptr := all_marker; {we insert the ``other'' entries here}
+ end
+ else
+ begin
+ cite_ptr := num_cites; {we insert the cross-referenced entries here}
+ all_marker := any_value; {to appease \PASCAL's boolean evaluation}
+ end;
+end
+
+
+@
+Before we actually start the code for reading a database file, we must
+define this \.{.bib}-specific scanning function. It skips over
+|white_space| characters until hitting a nonwhite character or the end
+of the file, respectively returning |true| or |false|. It also
+updates |bib_line_num|, the line counter.
+
+@<Procedures and functions for input scanning@>=
+function eat_bib_white_space : boolean;
+label exit;
+begin
+while (not scan_white_space) do {no characters left; read another line}
+ begin
+ if (not input_ln(cur_bib_file)) then {end-of-file; return |false|}
+ begin
+ eat_bib_white_space := false;
+ return;
+ end;
+ incr(bib_line_num);
+ buf_ptr2 := 0;
+ end;
+eat_bib_white_space := true;
+exit:
+end;
+
+
+@
+It's often illegal to end a \.{.bib} command in certain places, and
+this is where we come to check.
+
+@d eat_bib_white_and_eof_check ==
+ begin
+ if (not eat_bib_white_space) then
+ begin
+ eat_bib_print;
+ return;
+ end;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure eat_bib_print;
+label exit; {so the call to |bib_err| works}
+begin
+bib_err ('Illegal end of database file');
+exit:
+end;
+
+
+@
+And here are a bunch of error-message macros, each called more than
+once, that thus save space as implemented. This one is for when one
+of two possible characters is expected while scanning.
+
+@d bib_one_of_two_expected_err(#) ==
+ begin
+ bib_one_of_two_print (#);
+ return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bib_one_of_two_print (@!char1,@!char2:ASCII_code);
+label exit; {so the call to |bib_err| works}
+begin
+bib_err ('I was expecting a `',xchr[char1],''' or a `',xchr[char2],'''');
+exit:
+end;
+
+
+@
+This one's for an expected |equals_sign|.
+
+@d bib_equals_sign_expected_err ==
+ begin
+ bib_equals_sign_print;
+ return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bib_equals_sign_print;
+label exit; {so the call to |bib_err| works}
+begin
+bib_err ('I was expecting an "',xchr[equals_sign],'"');
+exit:
+end;
+
+
+@
+This complains about unbalanced braces.
+
+@d bib_unbalanced_braces_err ==
+ begin
+ bib_unbalanced_braces_print;
+ return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bib_unbalanced_braces_print;
+label exit; {so the call to |bib_err| works}
+begin
+bib_err ('Unbalanced braces');
+exit:
+end;
+
+
+@
+And this one about an overly exuberant field.
+
+@d bib_field_too_long_err ==
+ begin
+ bib_field_too_long_print;
+ return;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bib_field_too_long_print;
+label exit; {so the call to |bib_err| works}
+begin
+bib_err ('Your field is more than ',buf_size:0,' characters');
+exit:
+end;
+
+
+@
+This one is just a warning, not an error. It's for when something
+isn't (or might not be) quite right with a macro name.
+
+@d macro_name_warning(#) ==
+ begin
+ macro_warn_print;
+ bib_warn_newline (#);
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure macro_warn_print;
+begin
+print ('Warning--string name "');
+print_token;
+print ('" is ');
+end;
+
+
+@
+@:this can't happen}{\quad Identifier scanning error@>
+This macro is used to scan all \.{.bib} identifiers. The argument
+tells what was happening at the time. The associated procedure simply
+prints an error message.
+
+@d bib_identifier_scan_check(#) ==
+ begin
+ if ((scan_result = white_adjacent) or
+ (scan_result = specified_char_adjacent)) then
+ do_nothing
+ else
+ begin
+ bib_id_print;
+ bib_err (#);
+ end;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bib_id_print;
+begin
+if (scan_result = id_null) then
+ print ('You''re missing ')
+else if (scan_result = other_char_adjacent) then
+ print ('"',xchr[scan_char],'" immediately follows ')
+else
+ id_scanning_confusion;
+end;
+
+
+@
+This module either reads a database entry, whose three main components
+are an entry type, a database key, and a list of fields, or it reads a
+\.{.bib} command, whose structure is command dependent and explained
+later.
+
+@d cite_already_set = 22 {this gets around \PASCAL\ limitations}
+@d first_time_entry = 26 {for checking for repeated database entries}
+
+@<Scan for and process a \.{.bib} command or database entry@>=
+procedure get_bib_command_or_entry_and_process;
+label cite_already_set,@!first_time_entry,@!loop_exit,@!exit;
+begin
+at_bib_command := false;@/
+@<Skip to the next database entry or \.{.bib} command@>;
+@<Scan the entry type or scan and process the \.{.bib} command@>;
+eat_bib_white_and_eof_check;
+@<Scan the entry's database key@>;
+eat_bib_white_and_eof_check;
+@<Scan the entry's list of fields@>;
+exit:
+end;
+
+
+@
+This module skips over everything until hitting an |at_sign| or the
+end of the file. It also updates |bib_line_num|, the line counter.
+
+@<Skip to the next database entry or \.{.bib} command@>=
+while (not scan1(at_sign)) do {no |at_sign|; get next line}
+ begin
+ if (not input_ln(cur_bib_file)) then {end-of-file}
+ return;
+ incr(bib_line_num);
+ buf_ptr2 := 0;
+ end
+
+
+@
+@:this can't happen}{\quad An at-sign disappeared@>
+This module reads an |at_sign| and an entry type (like `book' or
+`article') or a \.{.bib} command. If it's an entry type, it must be
+defined in the \.{.bst} file if this entry is to be included in the
+reference list.
+
+@<Scan the entry type or scan and process the \.{.bib} command@>=
+begin
+if (scan_char <> at_sign) then
+ confusion ('An "',xchr[at_sign],'" disappeared');
+incr(buf_ptr2); {skip over the |at_sign|}
+eat_bib_white_and_eof_check;
+scan_identifier (left_brace,left_paren,left_paren);
+bib_identifier_scan_check ('an entry type');
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is an entry type or a database-file command');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+command_num := ilk_info[
+ str_lookup(buffer,buf_ptr1,token_len,bib_command_ilk,dont_insert)];
+if (hash_found) then
+ @<Process a \.{.bib} command@>
+else
+ begin {process an entry type}
+ entry_type_loc := str_lookup(
+ buffer,buf_ptr1,token_len,bst_fn_ilk,dont_insert);
+ if ((not hash_found) or (fn_type[entry_type_loc]<>wiz_defined)) then@/
+ type_exists := false {no such entry type defined in the \.{.bst} file}
+ else
+ type_exists := true;
+ end;
+end
+
+
+@
+@^database-file commands@>
+@:this can't happen}{\quad Unknown database-file command@>
+Here we determine which \.{.bib} command we're about to process, then
+go to it.
+
+@<Process a \.{.bib} command@>=
+begin
+at_bib_command := true;
+case (command_num) of
+ n_bib_comment : @<Process a \.{comment} command@>;
+ n_bib_preamble : @<Process a \.{preamble} command@>;
+ n_bib_string : @<Process a \.{string} command@>;
+ othercases bib_cmd_confusion
+endcases;
+end
+
+
+@
+@:this can't happen}{\quad Unknown database-file command@>
+Here's another bug.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bib_cmd_confusion;
+begin
+confusion ('Unknown database-file command');
+end;
+
+
+@
+@:database-file commands}{\quad \.{comment}@>
+The \.{comment} command is implemented for SCRIBE compatibility. It's
+not really needed because \BibTeX\ treats (flushes) everything not
+within an entry as a comment anyway.
+
+@<Process a \.{comment} command@>=
+begin
+return; {flush comments}
+end
+
+
+@
+@:database-file commands}{\quad \.{preamble}@>
+The \.{preamble} command lets a user have \TeX\ stuff inserted (by the
+standard styles, at least) directly into the \.{.bbl} file. It is
+intended primarily for allowing \TeX\ macro definitions used within
+the bibliography entries (for better sorting, for example). One
+\.{preamble} command per \.{.bib} file should suffice.
+
+A \.{preamble} command has either braces or parentheses as outer
+delimiters. Inside is the preamble string, which has the same syntax
+as a field value: a nonempty list of field tokens separated by
+|concat_char|s. There are three types of field tokens---nonnegative
+numbers, macro names, and delimited strings.
+
+This module does all the scanning (that's not subcontracted), but the
+\.{.bib}-specific scanning function
+|scan_and_store_the_field_value_and_eat_white| actually stores the
+value.
+
+@<Process a \.{preamble} command@>=
+begin
+if (preamble_ptr = max_bib_files) then
+ bib_err ('You''ve exceeded ',max_bib_files:0,' preamble commands');
+eat_bib_white_and_eof_check;
+if (scan_char = left_brace) then
+ right_outer_delim := right_brace
+else if (scan_char = left_paren) then
+ right_outer_delim := right_paren
+else
+ bib_one_of_two_expected_err (left_brace,left_paren);
+incr(buf_ptr2); {skip over the left-delimiter}
+eat_bib_white_and_eof_check;
+store_field := true;
+if (not scan_and_store_the_field_value_and_eat_white) then
+ return;
+if (scan_char <> right_outer_delim) then
+ bib_err ('Missing "',xchr[right_outer_delim],'" in preamble command');
+incr(buf_ptr2); {skip over the |right_outer_delim|}
+return;
+end
+
+
+@
+@:database-file commands}{\quad \.{string}@>
+The \.{string} command is implemented both for SCRIBE compatibility
+and for allowing a user: to override a \.{.bst}-file \.{macro}
+command, to define one that the \.{.bst} file doesn't, or to engage in
+good, wholesome, typing laziness.
+
+The \.{string} command does mostly the same thing as the
+\.{.bst}-file's \.{macro} command (but the syntax is different and the
+\.{string} command compresses |white_space|). In fact, later in this
+program, the term ``macro'' refers to either a \.{.bst} ``macro'' or a
+\.{.bib} ``string'' (when it's clear from the context that it's not
+a \.{WEB} macro).
+
+A \.{string} command has either braces or parentheses as outer
+delimiters. Inside is the string's name (it must be a legal
+identifier, and case differences are ignored---all upper-case letters
+are converted to lower case), then an |equals_sign|, and the string's
+definition, which has the same syntax as a field value: a nonempty
+list of field tokens separated by |concat_char|s. There are three
+types of field tokens---nonnegative numbers, macro names, and
+delimited strings.
+
+@<Process a \.{string} command@>=
+begin
+eat_bib_white_and_eof_check;
+@<Scan the string's name@>;
+eat_bib_white_and_eof_check;
+@<Scan the string's definition field@>;
+return;
+end
+
+
+@
+This module reads a left outer-delimiter and a string name.
+
+@<Scan the string's name@>=
+begin
+if (scan_char = left_brace) then
+ right_outer_delim := right_brace
+else if (scan_char = left_paren) then
+ right_outer_delim := right_paren
+else
+ bib_one_of_two_expected_err (left_brace,left_paren);
+incr(buf_ptr2); {skip over the left-delimiter}
+eat_bib_white_and_eof_check;
+scan_identifier (equals_sign,equals_sign,equals_sign);
+bib_identifier_scan_check ('a string name');
+@<Store the string's name@>;
+end
+
+
+@
+@^commented-out code@>
+This module marks this string as |macro_ilk|; the commented-out code
+will give a warning message when overwriting a previously defined
+macro.
+
+@<Store the string's name@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a database-defined macro');
+ ecart@/
+lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+cur_macro_loc := str_lookup(buffer,buf_ptr1,token_len,macro_ilk,do_insert);
+ilk_info[cur_macro_loc] := hash_text[cur_macro_loc]; {default in case of error}
+ @{
+ if (hash_found) then {already seen macro}
+ macro_name_warning ('having its definition overwritten');
+ @}@/
+end
+
+
+@
+This module skips over the |equals_sign|, reads and stores the list of
+field tokens that defines this macro (compressing |white_space|), and
+reads a |right_outer_delim|.
+
+@<Scan the string's definition field@>=
+begin
+if (scan_char <> equals_sign) then
+ bib_equals_sign_expected_err;
+incr(buf_ptr2); {skip over the |equals_sign|}
+eat_bib_white_and_eof_check;
+store_field := true;
+if (not scan_and_store_the_field_value_and_eat_white) then
+ return;
+if (scan_char <> right_outer_delim) then
+ bib_err ('Missing "',xchr[right_outer_delim],'" in string command');
+incr(buf_ptr2); {skip over the |right_outer_delim|}
+end
+
+
+@
+@^kludge@>
+The variables for the function
+|scan_and_store_the_field_value_and_eat_white| must be global since
+the functions it calls use them too. The alias kludge helps make the
+stack space not overflow on some machines.
+
+@d field_vl_str == ex_buf {aliases, used ``only'' for this function}
+@d field_end == ex_buf_ptr {the end marker for the field-value string}
+@d field_start == ex_buf_xptr {and the start marker}
+
+@<Globals in the outer block@>=
+@!bib_brace_level : integer; {brace nesting depth (excluding |str_delim|s)}
+
+
+@
+@^gymnastics@>
+Since the function |scan_and_store_the_field_value_and_eat_white|
+calls several other yet-to-be-described functions (one directly and
+two indirectly), we must perform some topological gymnastics.
+
+@<Procedures and functions for input scanning@>=
+@<The scanning function |compress_bib_white|@>@;
+@<The scanning function |scan_balanced_braces|@>@;
+@<The scanning function |scan_a_field_token_and_eat_white|@>
+
+
+@
+This function scans the list of field tokens that define the field
+value string. If |store_field| is |true| it accumulates (indirectly)
+in |field_vl_str| the concatenation of all the field tokens,
+compressing nonnull |white_space| to a single |space| and, if the
+field value is for a field (rather than a string definition), removing
+any leading or trailing |white_space|; when it's finished it puts the
+string into the hash table. It returns |false| if there was a serious
+syntax error.
+
+@<Procedures and functions for input scanning@>=
+function scan_and_store_the_field_value_and_eat_white : boolean;
+label exit;
+begin
+scan_and_store_the_field_value_and_eat_white := false;
+ {now it's easy to exit if necessary}
+field_end := 0;
+if (not scan_a_field_token_and_eat_white) then
+ return;
+while (scan_char = concat_char) do {scan remaining field tokens}
+ begin
+ incr(buf_ptr2); {skip over the |concat_char|}
+ eat_bib_white_and_eof_check;
+ if (not scan_a_field_token_and_eat_white) then
+ return;
+ end;
+if (store_field) then
+ @<Store the field value string@>;
+scan_and_store_the_field_value_and_eat_white := true;
+exit:
+end;
+
+
+@
+Each field token is either a nonnegative number, a macro name (like
+`jan'), or a brace-balanced string delimited by either |double_quote|s
+or braces. Thus there are four possibilities for the first character
+of the field token: If it's a |left_brace| or a |double_quote|, the
+token (with balanced braces, up to the matching |right_str_delim|) is
+a string; if it's |numeric|, the token is a number; if it's anything
+else, the token is a macro name (and should thus have been defined by
+either the \.{.bst}-file's \.{macro} command or the \.{.bib}-file's
+\.{string} command). This function returns |false| if there was a
+serious syntax error.
+
+@<The scanning function |scan_a_field_token_and_eat_white|@>=
+function scan_a_field_token_and_eat_white : boolean;
+label exit;
+begin
+scan_a_field_token_and_eat_white := false; {now it's easy to exit if necessary}
+case (scan_char) of
+ left_brace :
+ begin
+ right_str_delim := right_brace;
+ if (not scan_balanced_braces) then
+ return;
+ end;
+ double_quote :
+ begin
+ right_str_delim := double_quote;
+ if (not scan_balanced_braces) then
+ return;
+ end;
+ "0", "1", "2", "3", "4", "5", "6", "7", "8", "9" :
+ @<Scan a number@>;
+ othercases
+ @<Scan a macro name@>
+endcases;
+eat_bib_white_and_eof_check;
+scan_a_field_token_and_eat_white := true;
+exit:
+end;
+
+
+@
+Now we come to the stuff that actually accumulates the field value to
+be stored. This module copies a character into |field_vl_str| if it
+will fit; since it's so low level, it's implemented as a macro.
+
+@d copy_char(#) == begin
+ if (field_end = buf_size) then
+ bib_field_too_long_err
+ else
+ begin
+ field_vl_str[field_end] := #;
+ incr(field_end);
+ end;
+ end
+
+
+@
+The \.{.bib}-specific scanning function |compress_bib_white| skips
+over |white_space| characters within a string until hitting a nonwhite
+character; in fact, it does everything |eat_bib_white_space| does, but
+it also adds a |space| to |field_vl_str|. This function is never
+called if there are no |white_space| characters (or ends-of-line) to
+be scanned (though the associated macro might be). The function
+returns |false| if there is a serious syntax error.
+
+@d check_for_and_compress_bib_white_space ==
+ begin
+ if ((lex_class[scan_char]=white_space) or (buf_ptr2=last)) then
+ if (not compress_bib_white) then
+ return;
+ end
+
+@<The scanning function |compress_bib_white|@>=
+function compress_bib_white : boolean;
+label exit;
+begin
+compress_bib_white := false; {now it's easy to exit if necessary}
+copy_char (space);
+while (not scan_white_space) do {no characters left; read another line}
+ begin
+ if (not input_ln(cur_bib_file)) then {end-of-file; complain}
+ begin
+ eat_bib_print;
+ return;
+ end;
+ incr(bib_line_num);
+ buf_ptr2 := 0;
+ end;
+compress_bib_white := true;
+exit:
+end;
+
+
+@
+This \.{.bib}-specific function scans a string with balanced braces,
+stopping just past the matching |right_str_delim|. How much work it
+does depends on whether |store_field = true|. It returns |false| if
+there was a serious syntax error.
+
+@<The scanning function |scan_balanced_braces|@>=
+function scan_balanced_braces : boolean;
+label loop_exit,@!exit;
+begin
+scan_balanced_braces := false; {now it's easy to exit if necessary}
+incr(buf_ptr2); {skip over the left-delimiter}
+check_for_and_compress_bib_white_space;
+if (field_end > 1) then
+ if (field_vl_str[field_end-1] = space) then
+ if (field_vl_str[field_end-2] = space) then {remove wrongly added |space|}
+ decr(field_end);
+bib_brace_level := 0; {and we're at a non|white_space| character}
+if (store_field) then
+ @<Do a full brace-balanced scan@>
+ else
+ @<Do a quick brace-balanced scan@>;
+incr(buf_ptr2); {skip over the |right_str_delim|}
+scan_balanced_braces := true;
+exit:
+end;
+
+
+@
+This module scans over a brace-balanced string without keeping track
+of anything but the brace level. It starts with |bib_brace_level = 0|
+and at a non|white_space| character.
+
+@<Do a quick brace-balanced scan@>=
+begin
+while (scan_char <> right_str_delim) do {we're at |bib_brace_level = 0|}
+ if (scan_char = left_brace) then
+ begin
+ incr(bib_brace_level);
+ incr(buf_ptr2); {skip over the |left_brace|}
+ eat_bib_white_and_eof_check;
+ while (bib_brace_level > 0) do
+ @<Do a quick scan with |bib_brace_level > 0|@>;
+ end
+ else if (scan_char = right_brace) then
+ bib_unbalanced_braces_err
+ else
+ begin
+ incr(buf_ptr2); {skip over some other character}
+ if (not scan3 (right_str_delim, left_brace, right_brace)) then
+ eat_bib_white_and_eof_check;
+ end
+end
+
+
+@
+This module does the same as above but, because |bib_brace_level > 0|, it
+doesn't have to look for a |right_str_delim|.
+
+@<Do a quick scan with |bib_brace_level > 0|@>=
+begin {top part of the |while| loop---we're always at a nonwhite character}
+if (scan_char = right_brace) then
+ begin
+ decr(bib_brace_level);
+ incr(buf_ptr2); {skip over the |right_brace|}
+ eat_bib_white_and_eof_check;
+ end
+else if (scan_char = left_brace) then
+ begin
+ incr(bib_brace_level);
+ incr(buf_ptr2); {skip over the |left_brace|}
+ eat_bib_white_and_eof_check;
+ end
+else
+ begin
+ incr(buf_ptr2); {skip over some other character}
+ if (not scan2 (right_brace, left_brace)) then
+ eat_bib_white_and_eof_check;
+ end
+end
+
+
+@
+This module scans over a brace-balanced string, compressing multiple
+|white_space| characters into a single |space|. It starts with
+|bib_brace_level = 0| and starts at a non|white_space| character.
+
+@<Do a full brace-balanced scan@>=
+begin
+while (scan_char <> right_str_delim) do
+ case (scan_char) of
+ left_brace :
+ begin
+ incr(bib_brace_level);
+ copy_char (left_brace);@/
+ incr(buf_ptr2); {skip over the |left_brace|}
+ check_for_and_compress_bib_white_space;@/
+ @<Do a full scan with |bib_brace_level > 0|@>;
+ end;
+ right_brace :
+ bib_unbalanced_braces_err;
+ othercases
+ begin
+ copy_char (scan_char);
+ incr(buf_ptr2); {skip over some other character}
+ check_for_and_compress_bib_white_space;
+ end
+ endcases;
+end
+
+
+@
+This module is similar to the last but starts with |bib_brace_level > 0|
+(and, like the last, it starts at a non|white_space| character).
+
+@<Do a full scan with |bib_brace_level > 0|@>=
+begin
+loop
+ case (scan_char) of
+ right_brace :
+ begin
+ decr(bib_brace_level);
+ copy_char (right_brace);@/
+ incr(buf_ptr2); {skip over the |right_brace|}
+ check_for_and_compress_bib_white_space;
+ if (bib_brace_level = 0) then
+ goto loop_exit;
+ end;
+ left_brace :
+ begin
+ incr(bib_brace_level);
+ copy_char (left_brace);@/
+ incr(buf_ptr2); {skip over the |left_brace|}
+ check_for_and_compress_bib_white_space;
+ end;
+ othercases
+ begin
+ copy_char (scan_char);
+ incr(buf_ptr2); {skip over some other character}
+ check_for_and_compress_bib_white_space;
+ end
+ endcases;
+loop_exit:
+end
+
+
+@
+@:this can't happen}{\quad A digit disappeared@>
+This module scans a nonnegative number and copies it to |field_vl_str|
+if it's to store the field.
+
+@<Scan a number@>=
+begin
+if (not scan_nonneg_integer) then
+ confusion ('A digit disappeared');
+if (store_field) then
+ begin
+ tmp_ptr := buf_ptr1;
+ while (tmp_ptr < buf_ptr2) do
+ begin
+ copy_char (buffer[tmp_ptr]);
+ incr(tmp_ptr);
+ end;
+ end;
+end
+
+
+@
+This module scans a macro name and copies its string to |field_vl_str|
+if it's to store the field, complaining if the macro is recursive or
+undefined.
+
+@<Scan a macro name@>=
+begin
+scan_identifier (comma,right_outer_delim,concat_char);
+bib_identifier_scan_check ('a field part');
+if (store_field) then
+ begin
+ lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+ macro_name_loc := str_lookup(
+ buffer,buf_ptr1,token_len,macro_ilk,dont_insert);
+ store_token := true;
+ if (at_bib_command) then
+ if (command_num = n_bib_string) then
+ if (macro_name_loc = cur_macro_loc) then
+ begin
+ store_token := false;
+ macro_name_warning ('used in its own definition');
+ end;
+ if (not hash_found) then
+ begin
+ store_token := false;
+ macro_name_warning ('undefined');
+ end;
+ if (store_token) then
+ @<Copy the macro string to |field_vl_str|@>;
+ end;
+end
+
+
+@
+The macro definition may have |white_space| that needs compressing,
+because it may have been defined in the \.{.bst} file.
+
+@<Copy the macro string to |field_vl_str|@>=
+begin
+tmp_ptr := str_start[ilk_info[macro_name_loc]];
+tmp_end_ptr := str_start[ilk_info[macro_name_loc]+1];
+if (field_end = 0) then
+ if ((lex_class[str_pool[tmp_ptr]] = white_space) and (tmp_ptr < tmp_end_ptr))
+ then
+ begin {compress leading |white_space| of first nonnull token}
+ copy_char (space);
+ incr(tmp_ptr);
+ while ((lex_class[str_pool[tmp_ptr]] = white_space) and
+ (tmp_ptr < tmp_end_ptr)) do
+ incr(tmp_ptr);
+ end; {the next remaining character is non|white_space|}
+while (tmp_ptr < tmp_end_ptr) do
+ begin
+ if (lex_class[str_pool[tmp_ptr]] <> white_space) then
+ copy_char (str_pool[tmp_ptr])
+ else if (field_vl_str[field_end-1] <> space) then
+ copy_char (space);
+ incr(tmp_ptr);
+ end;
+end
+
+
+@
+@^ham and eggs@>
+Now it's time to store the field value in the hash table, and store an
+appropriate pointer to it (depending on whether it's for a database
+entry or command). But first, if necessary, we remove a trailing
+|space| and a leading |space| if these exist. (Hey, if we had some
+ham we could make ham-and-eggs if we had some eggs.)
+
+@<Store the field value string@>=
+begin
+if (not at_bib_command) then {chop trailing |space| for a field}
+ if (field_end > 0) then
+ if (field_vl_str[field_end-1] = space) then
+ decr(field_end);
+if ((not at_bib_command) and (field_vl_str[0] = space) and (field_end > 0))
+ then {chop leading |space| for a field}
+ field_start := 1
+ else
+ field_start := 0;
+field_val_loc := str_lookup(field_vl_str,field_start,field_end-field_start,
+ text_ilk,do_insert);
+fn_type[field_val_loc] := str_literal; {set the |fn_class|}
+ trace
+ trace_pr ('"');
+ trace_pr_pool_str (hash_text[field_val_loc]);
+ trace_pr_ln ('" is a field value');
+ ecart@/
+if (at_bib_command) then {for a \.{preamble} or \.{string} command}
+ @<Store the field value for a command@>
+ else {for a database entry}
+ @<Store the field value for a database entry@>;
+end
+
+
+@
+@:this can't happen}{\quad Unknown database-file command@>
+Here's where we store the goods when we're dealing with a command
+rather than an entry.
+
+@<Store the field value for a command@>=
+begin
+case (command_num) of
+ n_bib_preamble :
+ begin
+ s_preamble[preamble_ptr] := hash_text[field_val_loc];
+ incr(preamble_ptr);
+ end;
+ n_bib_string :
+ ilk_info[cur_macro_loc] := hash_text[field_val_loc];
+ othercases bib_cmd_confusion
+endcases;
+end
+
+
+@
+And here, an entry.
+
+@<Store the field value for a database entry@>=
+begin
+field_ptr := entry_cite_ptr * num_fields + fn_info[field_name_loc];
+if (field_info[field_ptr] <> missing) then
+ begin
+ print ('Warning--I''m ignoring ');
+ print_pool_str (cite_list[entry_cite_ptr]);
+ print ('''s extra "');
+ print_pool_str (hash_text[field_name_loc]);
+ bib_warn_newline ('" field');
+ end
+ else
+ begin {the field was empty, store its new value}
+ field_info[field_ptr] := hash_text[field_val_loc];
+ if ((fn_info[field_name_loc] = crossref_num) and (not all_entries)) then
+ @<Add or update a cross reference on |cite_list| if necessary@>;
+ end;
+end
+
+
+@
+@^kludge@>
+@:this can't happen}{\quad Cite hash error@>
+If the cross-referenced entry isn't already on |cite_list| we add it
+(at least temporarily); if it is already on |cite_list| we update the
+cross-reference count, if necessary. Note that |all_entries| is
+|false| here. The alias kludge helps make the stack space not
+overflow on some machines.
+
+@d extra_buf == out_buf {an alias, used only in this module}
+
+@<Add or update a cross reference on |cite_list| if necessary@>=
+begin
+tmp_ptr := field_start;
+while (tmp_ptr < field_end) do
+ begin
+ extra_buf[tmp_ptr] := field_vl_str[tmp_ptr];
+ incr(tmp_ptr);
+ end;
+lower_case (extra_buf, field_start, field_end-field_start);
+ {convert to `canonical' form}
+lc_cite_loc := str_lookup(extra_buf,field_start,field_end-field_start,
+ lc_cite_ilk,do_insert);
+if (hash_found) then
+ begin
+ cite_loc := ilk_info[lc_cite_loc]; {even if there's a case mismatch}
+ if (ilk_info[cite_loc] >= old_num_cites) then {a previous \.{crossref}}
+ incr(cite_info[ilk_info[cite_loc]]);
+ end
+ else
+ begin {it's a new \.{crossref}}
+ cite_loc := str_lookup(field_vl_str,field_start,field_end-field_start,
+ cite_ilk,do_insert);
+ if (hash_found) then
+ hash_cite_confusion;
+ add_database_cite (cite_ptr); {this increments |cite_ptr|}
+ cite_info[ilk_info[cite_loc]] := 1; {the first cross-ref for this cite key}
+ end;
+end
+
+
+@
+This procedure adds (or restores) to |cite_list| a cite key; it is
+called only when |all_entries| is |true| or when adding
+cross~references, and it assumes that |cite_loc| and |lc_cite_loc| are
+set. It also increments its argument.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+procedure add_database_cite (var new_cite : cite_number);
+begin
+check_cite_overflow (new_cite); {make sure this cite will fit}
+check_field_overflow (num_fields*new_cite);
+cite_list[new_cite] := hash_text[cite_loc];
+ilk_info[cite_loc] := new_cite;
+ilk_info[lc_cite_loc] := cite_loc;
+incr(new_cite);
+end;
+
+
+@
+And now, back to processing an entry (rather than a command). This
+module reads a left outer-delimiter and a database key.
+
+@<Scan the entry's database key@>=
+begin
+if (scan_char = left_brace) then
+ right_outer_delim := right_brace
+else if (scan_char = left_paren) then
+ right_outer_delim := right_paren
+else
+ bib_one_of_two_expected_err (left_brace,left_paren);
+incr(buf_ptr2); {skip over the left-delimiter}
+eat_bib_white_and_eof_check;
+if (right_outer_delim = right_paren) then {to allow it in a database key}
+ begin
+ if (scan1_white(comma)) then {ok if database key ends line}
+ do_nothing;
+ end
+ else
+ if (scan2_white(comma,right_brace)) then {|right_brace=right_outer_delim|}
+ do_nothing;
+@<Check for a database key of interest@>;
+end
+
+
+@
+@^kludge@>
+The lower-case version of this database key must correspond to one in
+|cite_list|, or else |all_entries| must be |true|, if this entry is to
+be included in the reference list. Accordingly, this module sets
+|store_entry|, which determines whether the relevant information for
+this entry is stored. The alias kludge helps make the stack space not
+overflow on some machines.
+
+@d ex_buf3 == ex_buf {an alias, used only in this module}
+
+@<Check for a database key of interest@>=
+begin
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a database key');
+ ecart@/
+tmp_ptr := buf_ptr1;
+while (tmp_ptr < buf_ptr2) do
+ begin
+ ex_buf3[tmp_ptr] := buffer[tmp_ptr];
+ incr(tmp_ptr);
+ end;
+lower_case (ex_buf3, buf_ptr1, token_len); {convert to `canonical' form}
+if (all_entries) then
+ lc_cite_loc := str_lookup(ex_buf3,buf_ptr1,token_len,lc_cite_ilk,do_insert)
+ else
+ lc_cite_loc := str_lookup(ex_buf3,buf_ptr1,token_len,lc_cite_ilk,
+ dont_insert);
+if (hash_found) then
+ begin
+ entry_cite_ptr := ilk_info[ilk_info[lc_cite_loc]];
+ @<Check for a duplicate or \.{crossref}-matching database key@>;
+ end;
+store_entry := true; {unless |(not hash_found) and (not all_entries)|}
+if (all_entries) then
+ @<Put this cite key in its place@>
+ else if (not hash_found) then
+ store_entry := false; {no such cite key exists on |cite_list|}
+if (store_entry) then
+ @<Make sure this entry is ok before proceeding@>;
+end
+
+
+@
+@:this can't happen}{\quad The cite list is messed up@>
+It's illegal to have two (or more) entries with the same database key
+(even if there are case differrences), and we skip the rest of the
+entry for such a repeat occurrence. Also, we make this entry's
+database key the official |cite_list| key if it's on |cite_list| only
+because of cross references.
+
+@<Check for a duplicate or \.{crossref}-matching database key@>=
+begin
+if ((not all_entries) or (entry_cite_ptr < all_marker)
+ or (entry_cite_ptr >= old_num_cites)) then
+ begin
+ if (type_list[entry_cite_ptr] = empty) then
+ begin
+ @<Make sure this entry's database key is on |cite_list|@>;
+ goto first_time_entry;
+ end;
+ end
+else if (not entry_exists[entry_cite_ptr]) then
+ begin
+ @<Find the lower-case equivalent of the |cite_info| key@>;
+ if (lc_xcite_loc = lc_cite_loc) then
+ goto first_time_entry;
+ end;@/
+ {oops---repeated entry---issue a reprimand}
+if (type_list[entry_cite_ptr] = empty) then
+ confusion ('The cite list is messed up');
+bib_err ('Repeated entry');
+first_time_entry: {note that when we leave normally, |hash_found| is |true|}
+end
+
+
+@
+An entry that's on |cite_list| only because of cross referencing must
+have its database key (rather than one of the \.{crossref} keys) as
+the official |cite_list| string. Here's where we assure that. The
+variable |hash_found| is |true| upon entrance to and exit from this
+module.
+
+@<Make sure this entry's database key is on |cite_list|@>=
+begin
+if ((not all_entries) and (entry_cite_ptr >= old_num_cites)) then
+ begin
+ cite_loc := str_lookup(buffer,buf_ptr1,token_len,cite_ilk,do_insert);
+ if (not hash_found) then
+ begin {it's not on |cite_list|---put it there}
+ ilk_info[lc_cite_loc] := cite_loc;
+ ilk_info[cite_loc] := entry_cite_ptr;
+ cite_list[entry_cite_ptr] := hash_text[cite_loc];@/
+ hash_found := true; {restore this value for later use}
+ end;
+ end;
+end
+
+
+@
+@^kludge@>
+@:this can't happen}{\quad A cite key disappeared@>
+This module, a simpler version of the
+|find_cite_locs_for_this_cite_key| function, exists primarily to
+compute |lc_xcite_loc|. When this code is executed we have
+|(all_entries) and (entry_cite_ptr >= all_marker) and (not
+entry_exists[entry_cite_ptr])|. The alias kludge helps make the stack
+space not overflow on some machines.
+
+@d ex_buf4 == ex_buf {aliases, used only}
+@d ex_buf4_ptr == ex_buf_ptr {in this module}
+
+@<Find the lower-case equivalent of the |cite_info| key@>=
+begin
+ex_buf4_ptr := 0;
+tmp_ptr := str_start[cite_info[entry_cite_ptr]];
+tmp_end_ptr := str_start[cite_info[entry_cite_ptr]+1];
+while (tmp_ptr < tmp_end_ptr) do
+ begin
+ ex_buf4[ex_buf4_ptr] := str_pool[tmp_ptr];
+ incr(ex_buf4_ptr);
+ incr(tmp_ptr);
+ end;
+lower_case (ex_buf4, 0, length(cite_info[entry_cite_ptr]));
+ {convert to `canonical' form}
+lc_xcite_loc := str_lookup(ex_buf4,0,length(cite_info[entry_cite_ptr]),
+ lc_cite_ilk,dont_insert);
+if (not hash_found) then
+ cite_key_disappeared_confusion;
+end
+
+
+@
+@:this can't happen}{\quad A cite key disappeared@>
+Here's another bug complaint.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure cite_key_disappeared_confusion;
+begin
+confusion ('A cite key disappeared');
+end;
+
+
+@
+@:this can't happen}{\quad Cite hash error@>
+This module, which gets executed only when |all_entries| is |true|,
+does one of three things, depending on whether or not, and where, the
+cite key appears on |cite_list|: If it's on |cite_list| before
+|all_marker|, there's nothing to be done; if it's after |all_marker|,
+it must be reinserted (at the current place) and we must note that its
+corresponding entry exists; and if it's not on |cite_list| at all, it
+must be inserted for the first time. The |goto| construct must stay
+as is, partly because some \PASCAL\ compilers might complain if
+``|and|'' were to connect the two boolean expressions (since
+|entry_cite_ptr| could be uninitialized when |hash_found| is |false|).
+
+@<Put this cite key in its place@>=
+begin
+if (hash_found) then
+ begin
+ if (entry_cite_ptr < all_marker) then
+ goto cite_already_set {that is, do nothing}
+ else
+ begin
+ entry_exists[entry_cite_ptr] := true;
+ cite_loc := ilk_info[lc_cite_loc];
+ end;
+ end
+ else
+ begin {this is a new key}
+ cite_loc := str_lookup(buffer,buf_ptr1,token_len,cite_ilk,do_insert);
+ if (hash_found) then
+ hash_cite_confusion;
+ end;@/
+entry_cite_ptr := cite_ptr;
+add_database_cite (cite_ptr); {this increments |cite_ptr|}
+cite_already_set:
+end
+
+
+@
+@^case mismatch errors@>
+@^commented-out code@>
+We must give a warning if this entry~type doesn't exist. Also, we
+point the appropriate entry of |type_list| to the entry type just read
+above.
+
+For SCRIBE compatibility, the code to give a warning for a case
+mismatch between a cite key and a database key has been commented out.
+In fact, SCRIBE is the reason that it doesn't produce an error message
+outright. (Note: Case mismatches between two cite keys produce
+full-blown errors.)
+
+@<Make sure this entry is ok before proceeding@>=
+begin
+ @{
+ dummy_loc := str_lookup(buffer,buf_ptr1,token_len,cite_ilk,dont_insert);
+ if (not hash_found) then {give a warning if there is a case difference}
+ begin
+ print ('Warning--case mismatch, database key "');
+ print_token;
+ print ('", cite key "');
+ print_pool_str (cite_list[entry_cite_ptr]);
+ bib_warn_newline ('"');
+ end;
+ @}@/
+if (type_exists) then
+ type_list[entry_cite_ptr] := entry_type_loc
+ else
+ begin
+ type_list[entry_cite_ptr] := undefined;
+ print ('Warning--entry type for "');
+ print_token;
+ bib_warn_newline ('" isn''t style-file defined');
+ end;
+end
+
+
+@
+This module reads a |comma| and a field as many times as it can, and
+then reads a |right_outer_delim|, ending the current entry.
+
+@<Scan the entry's list of fields@>=
+begin
+while (scan_char <> right_outer_delim) do
+ begin
+ if (scan_char <> comma) then
+ bib_one_of_two_expected_err (comma,right_outer_delim);
+ incr(buf_ptr2); {skip over the |comma|}
+ eat_bib_white_and_eof_check;
+ if (scan_char = right_outer_delim) then
+ goto loop_exit;
+ @<Get the next field name@>;
+ eat_bib_white_and_eof_check;
+ if (not scan_and_store_the_field_value_and_eat_white) then
+ return;
+ end;
+loop_exit:
+incr(buf_ptr2); {skip over the |right_outer_delim|}
+end
+
+
+@
+This module reads a field name; its contents won't be stored unless it
+was declared in the \.{.bst} file and |store_entry = true|.
+
+@<Get the next field name@>=
+begin
+scan_identifier (equals_sign,equals_sign,equals_sign);
+bib_identifier_scan_check ('a field name');
+ trace
+ trace_pr_token;
+ trace_pr_ln (' is a field name');
+ ecart@/
+store_field := false;
+if (store_entry) then
+ begin
+ lower_case (buffer, buf_ptr1, token_len); {ignore case differences}
+ field_name_loc := str_lookup(
+ buffer,buf_ptr1,token_len,bst_fn_ilk,dont_insert);
+ if (hash_found) then
+ if (fn_type[field_name_loc]=field) then@/
+ store_field := true; {field name was pre-defined or \.{.bst}-declared}
+ end;
+eat_bib_white_and_eof_check;
+if (scan_char <> equals_sign) then
+ bib_equals_sign_expected_err;
+incr(buf_ptr2); {skip over the |equals_sign|}
+end
+
+
+@
+This gets things ready for further \.{.bst} processing.
+
+@<Final initialization for processing the entries@>=
+begin
+num_cites := cite_ptr; {to include database and \.{crossref} cite keys, too}
+num_preamble_strings := preamble_ptr; {number of \.{preamble} commands seen}
+@<Add cross-reference information@>;
+@<Subtract cross-reference information@>;
+@<Remove missing entries or those cross referenced too few times@>;
+@<Initialize the |int_entry_var|s@>;
+@<Initialize the |str_entry_var|s@>;
+@<Initialize the |sorted_cites|@>;
+end
+
+
+@
+@^child entry@>
+@^cross references@>
+@^nested cross references@>
+@^parent entry@>
+Now we update any entry (here called a {\it child\/} entry) that
+cross~referenced another (here called a {\it parent\/} entry); this
+cross~referencing occurs when the child's \.{crossref} field (value)
+consists of the parent's database key. To do the update, we replace
+the child's |missing| fields by the corresponding fields of the
+parent. Also, we make sure the \.{crossref} field contains the
+case-correct version. Finally, although it is technically illegal to
+nest cross~references, and although we give a warning (a few modules
+hence) when someone tries, we do what we can to accommodate the
+attempt.
+
+@<Add cross-reference information@>=
+begin
+cite_ptr := 0;
+while (cite_ptr < num_cites) do
+ begin
+ field_ptr := cite_ptr * num_fields + crossref_num;
+ if (field_info[field_ptr] <> missing) then
+ if (find_cite_locs_for_this_cite_key (field_info[field_ptr])) then
+ begin
+ cite_loc := ilk_info[lc_cite_loc];
+ field_info[field_ptr] := hash_text[cite_loc];
+ cite_parent_ptr := ilk_info[cite_loc];
+ field_ptr := cite_ptr * num_fields + num_pre_defined_fields;
+ field_end_ptr := field_ptr - num_pre_defined_fields + num_fields;
+ field_parent_ptr := cite_parent_ptr * num_fields
+ + num_pre_defined_fields;
+ while (field_ptr < field_end_ptr) do
+ begin
+ if (field_info[field_ptr] = missing) then
+ field_info[field_ptr] := field_info[field_parent_ptr];
+ incr(field_ptr);
+ incr(field_parent_ptr);
+ end;
+ end;
+ incr(cite_ptr);
+ end;
+end
+
+
+@
+@^kludge@>
+@^raisin@>
+Occasionally we need to figure out the hash-table location of a given
+cite-key string and its lower-case equivalent. This function does
+that. To perform the task it needs to borrow a buffer, a need that
+gives rise to the alias kludge---it helps make the stack space not
+overflow on some machines (and while it's at it, it'll borrow a
+pointer, too). Finally, the function returns |true| if the cite key
+exists on |cite_list|, and its sets |cite_hash_found| according to
+whether or not it found the actual version (before |lower_case|ing) of
+the cite key; however, its {\sl raison d'\^$\mkern-8mu$etre\/}
+(literally, ``to eat a raisin'') is to compute |cite_loc| and
+|lc_cite_loc|.
+
+@d ex_buf5 == ex_buf {aliases, used only}
+@d ex_buf5_ptr == ex_buf_ptr {in this module}
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+function find_cite_locs_for_this_cite_key (@!cite_str : str_number) : boolean;
+begin
+ex_buf5_ptr := 0;
+tmp_ptr := str_start[cite_str];
+tmp_end_ptr := str_start[cite_str+1];
+while (tmp_ptr < tmp_end_ptr) do
+ begin
+ ex_buf5[ex_buf5_ptr] := str_pool[tmp_ptr];
+ incr(ex_buf5_ptr);
+ incr(tmp_ptr);
+ end;
+cite_loc := str_lookup(ex_buf5,0,length(cite_str),cite_ilk,dont_insert);
+cite_hash_found := hash_found;
+lower_case (ex_buf5, 0, length(cite_str)); {convert to `canonical' form}
+lc_cite_loc := str_lookup(ex_buf5,0,length(cite_str),lc_cite_ilk,dont_insert);
+if (hash_found) then
+ find_cite_locs_for_this_cite_key := true
+ else
+ find_cite_locs_for_this_cite_key := false;
+end;
+
+
+@
+@:this can't happen}{\quad Cite hash error@>
+Here we remove the \.{crossref} field value for each child whose
+parent was cross~referenced too few times. We also issue any
+necessary warnings arising from a bad cross~reference.
+
+@<Subtract cross-reference information@>=
+begin
+cite_ptr := 0;
+while (cite_ptr < num_cites) do
+ begin
+ field_ptr := cite_ptr * num_fields + crossref_num;
+ if (field_info[field_ptr] <> missing) then
+ if (not find_cite_locs_for_this_cite_key (field_info[field_ptr])) then
+ begin {the parent is not on |cite_list|}
+ if (cite_hash_found) then
+ hash_cite_confusion;
+ nonexistent_cross_reference_error;
+ field_info[field_ptr] := missing; {remove the \.{crossref} ptr}
+ end
+ else
+ begin {the parent exists on |cite_list|}
+ if (cite_loc <> ilk_info[lc_cite_loc]) then
+ hash_cite_confusion;
+ cite_parent_ptr := ilk_info[cite_loc];
+ if (type_list[cite_parent_ptr] = empty) then
+ begin
+ nonexistent_cross_reference_error;@/
+ field_info[field_ptr] := missing; {remove the \.{crossref} ptr}
+ end
+ else
+ begin {the parent exists in the database too}
+ field_parent_ptr := cite_parent_ptr * num_fields + crossref_num;
+ if (field_info[field_parent_ptr] <> missing) then
+ @<Complain about a nested cross reference@>;
+ if ((not all_entries) and (cite_parent_ptr >= old_num_cites) and
+ (cite_info[cite_parent_ptr] < min_crossrefs)) then@/
+ field_info[field_ptr] := missing; {remove the \.{crossref} ptr}
+ end;
+ end;
+ incr(cite_ptr);
+ end;
+end
+
+
+@
+This procedure exists to save space, since it's used twice---once for
+each of the two succeeding modules.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bad_cross_reference_print (@!s:str_number);
+begin
+print ('--entry "');
+print_pool_str (cur_cite_str);
+print_ln ('"');
+print ('refers to entry "');
+print_pool_str (s);
+end;
+
+
+@
+When an entry being cross referenced doesn't exist on |cite_list|, we
+complain.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure nonexistent_cross_reference_error;
+begin
+print ('A bad cross reference-');
+bad_cross_reference_print (field_info[field_ptr]);
+print_ln ('", which doesn''t exist');
+mark_error;
+end;
+
+
+@
+We also complain when an entry being cross referenced has a
+non|missing| \.{crossref} field itself, but this one is just a
+warning, not a full-blown error.
+
+@<Complain about a nested cross reference@>=
+begin
+print ('Warning--you''ve nested cross references');
+bad_cross_reference_print (cite_list[cite_parent_ptr]);
+print_ln ('", which also refers to something');
+mark_warning;
+end
+
+
+@
+We remove (and give a warning for) each cite key on the original
+|cite_list| without a corresponding database entry. And we remove any
+entry that was included on |cite_list| only because it was
+cross~referenced, yet was cross~referenced fewer than |min_crossrefs|
+times. Throughout this module, |cite_ptr| points to the next cite key
+to be checked and |cite_xptr| points to the next permanent spot on
+|cite_list|.
+
+@<Remove missing entries or those cross referenced too few times@>=
+begin
+cite_ptr := 0;
+while (cite_ptr < num_cites) do
+ begin
+ if (type_list[cite_ptr] = empty) then
+ print_missing_entry (cur_cite_str)
+ else if ((all_entries) or (cite_ptr < old_num_cites) or
+ (cite_info[cite_ptr] >= min_crossrefs)) then
+ begin
+ if (cite_ptr > cite_xptr) then
+ @<Slide this cite key down to its permanent spot@>;
+ incr(cite_xptr);
+ end;
+ incr(cite_ptr);
+ end;
+num_cites := cite_xptr;
+if (all_entries) then
+ @<Complain about missing entries whose cite keys got overwritten@>;
+end
+
+
+@
+When a cite key on the original |cite_list| (or added to |cite_list|
+because of cross~referencing) didn't appear in the database, complain.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_missing_entry (@!s:str_number);
+begin
+print ('Warning--I didn''t find a database entry for "');
+print_pool_str (s);
+print_ln ('"');
+mark_warning;
+end;
+
+
+@
+@:this can't happen}{\quad A cite key disappeared@>
+@:this can't happen}{\quad Cite hash error@>
+We have to move to its final resting place all the entry information
+associated with the exact location in |cite_list| of this cite key.
+
+@<Slide this cite key down to its permanent spot@>=
+begin
+cite_list[cite_xptr] := cite_list[cite_ptr];
+type_list[cite_xptr] := type_list[cite_ptr];
+if (not find_cite_locs_for_this_cite_key (cite_list[cite_ptr])) then
+ cite_key_disappeared_confusion;
+if ((not cite_hash_found) or (cite_loc <> ilk_info[lc_cite_loc])) then
+ hash_cite_confusion;
+ilk_info[cite_loc] := cite_xptr;@/
+field_ptr := cite_xptr * num_fields;
+field_end_ptr := field_ptr + num_fields;
+tmp_ptr := cite_ptr * num_fields;
+while (field_ptr < field_end_ptr) do
+ begin
+ field_info[field_ptr] := field_info[tmp_ptr];
+ incr(field_ptr);
+ incr(tmp_ptr);
+ end;
+end
+
+
+@
+We need this module only when we're including the whole database.
+It's for missing entries whose cite key originally resided in
+|cite_list| at a spot that another cite key (might have) claimed.
+
+@<Complain about missing entries whose cite keys got overwritten@>=
+begin
+cite_ptr := all_marker;
+while (cite_ptr < old_num_cites) do
+ begin
+ if (not entry_exists[cite_ptr]) then
+ print_missing_entry (cite_info[cite_ptr]);
+ incr(cite_ptr);
+ end;
+end
+
+
+@
+@:BibTeX capacity exceeded}{\quad total number of integer entry-variables@>
+This module initializes all |int_entry_var|s of all entries to 0, the
+value to which all integers are initialized.
+
+@<Initialize the |int_entry_var|s@>=
+begin
+if (num_ent_ints*num_cites > max_ent_ints) then
+ begin
+ print (num_ent_ints*num_cites,': ');
+ overflow('total number of integer entry-variables ',max_ent_ints);
+ end;
+int_ent_ptr := 0;
+while (int_ent_ptr < num_ent_ints*num_cites) do
+ begin
+ entry_ints[int_ent_ptr] := 0;
+ incr(int_ent_ptr);
+ end;
+end
+
+
+@
+@:BibTeX capacity exceeded}{\quad total number of string entry-variables@>
+This module initializes all |str_entry_var|s of all entries to the
+null string, the value to which all strings are initialized.
+
+@<Initialize the |str_entry_var|s@>=
+begin
+if (num_ent_strs*num_cites > max_ent_strs) then
+ begin
+ print (num_ent_strs*num_cites,': ');
+ overflow('total number of string entry-variables ',max_ent_strs);
+ end;
+str_ent_ptr := 0;
+while (str_ent_ptr < num_ent_strs*num_cites) do
+ begin
+ entry_strs[str_ent_ptr][0] := end_of_string;
+ incr(str_ent_ptr);
+ end;
+end
+
+
+@
+The array |sorted_cites| initially specifies that the entries are to
+be processed in order of cite-key occurrence. The \.{sort} command
+may change this to whatever it likes (which, we hope, is whatever the
+style-designer instructs it to like). We make |sorted_cites| an alias
+to save space; this works fine because we're done with |cite_info|.
+
+@d sorted_cites == cite_info {an alias used for the rest of the program}
+
+@<Initialize the |sorted_cites|@>=
+begin
+cite_ptr := 0;
+while (cite_ptr < num_cites) do
+ begin
+ sorted_cites[cite_ptr] := cite_ptr;
+ incr(cite_ptr);
+ end;
+end
+
+
+
+@* Executing the style file.
+This part of the program produces the output by executing the
+\.{.bst}-file commands \.{execute}, \.{iterate}, \.{reverse}, and
+\.{sort}. To do this it uses a stack (consisting of the two arrays
+|lit_stack| and |lit_stk_type|) for storing literals, a buffer
+|ex_buf| for manipulating strings, and an array |sorted_cites|
+for holding pointers to the sorted cite keys (|sorted_cites| is an
+alias of |cite_info|).
+
+@<Globals in the outer block@>=
+@!lit_stack : array[lit_stk_loc] of integer; {the literal function stack}
+@!lit_stk_type : array[lit_stk_loc] of stk_type; {their corresponding types}
+@!lit_stk_ptr : lit_stk_loc; {points just above the top of the stack}
+@!cmd_str_ptr : str_number; {stores value of |str_ptr| during execution}
+@!ent_chr_ptr : 0..ent_str_size; {points at a |str_entry_var| character}
+@!glob_chr_ptr : 0..glob_str_size; {points at a |str_global_var| character}
+@!ex_buf : buf_type; {a buffer for manipulating strings}
+@!ex_buf_ptr : buf_pointer; {general |ex_buf| location}
+@!ex_buf_length : buf_pointer; {the length of the current string in |ex_buf|}
+@!out_buf : buf_type; {the \.{.bbl} output buffer}
+@!out_buf_ptr : buf_pointer; {general |out_buf| location}
+@!out_buf_length : buf_pointer; {the length of the current string in |out_buf|}
+@!mess_with_entries : boolean; {|true| if functions can use entry info}
+@!sort_cite_ptr : cite_number; {a loop index for the sorted cite keys}
+@!sort_key_num : str_ent_loc; {index for the |str_entry_var| \.{sort.key\$}}
+@!brace_level : integer; {the brace nesting depth within a string}
+
+
+@
+Where |lit_stk_loc| is a stack location, and where |stk_type| gives
+one of the three types of literals (an integer, a string, or a
+function) or a special marker. If a |lit_stk_type| element is a
+|stk_int| then the corresponding |lit_stack| element is an integer; if
+a |stk_str|, then a pointer to a |str_pool| string; and if a |stk_fn|,
+then a pointer to the function's hash-table location. However, if the
+literal should have been a |stk_str| that was the value of a field
+that happened to be |missing|, then the special value
+|stk_field_missing| goes on the stack instead; its corresponding
+|lit_stack| element is a pointer to the field-name's string. Finally,
+|stk_empty| is the type of a literal popped from an empty stack.
+
+@d stk_int = 0 {an integer literal}
+@d stk_str = 1 {a string literal}
+@d stk_fn = 2 {a function literal}
+@d stk_field_missing = 3 {a special marker: a field value was missing}
+@d stk_empty = 4 {another: the stack was empty when this was popped}
+@d last_lit_type = 4 {the same number as on the line above}
+
+@<Types in the outer block@>=
+@!lit_stk_loc = 0..lit_stk_size; {the stack range}
+@!stk_type = 0..last_lit_type; {the literal types}
+
+
+@
+And the first output line requires this initialization.
+
+@<Set initial values of key variables@>=
+out_buf_length := 0;
+
+
+@
+When there's an error while executing \.{.bst} functions, what we do
+depends on whether the function is messing with the entries.
+Furthermore this error is serious enough to classify as an
+|error_message| instead of a |warning_message|. These messages (that
+is, from |bst_ex_warn|) are meant both for the user and for the style
+designer while debugging.
+
+@d bst_ex_warn(#) == begin {error while executing some function}
+ print (#);
+ bst_ex_warn_print;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_ex_warn_print;
+begin
+if (mess_with_entries) then
+ begin
+ print (' for entry ');
+ print_pool_str (cur_cite_str);
+ end;
+print_newline;
+print ('while executing-');
+bst_ln_num_print;
+mark_error;
+end;
+
+
+@
+When an error is so harmless, we print a |warning_message| instead of
+an |error_message|.
+
+@d bst_mild_ex_warn(#) == begin {error while executing some function}
+ print (#);
+ bst_mild_ex_warn_print;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_mild_ex_warn_print;
+begin
+if (mess_with_entries) then
+ begin
+ print (' for entry ');
+ print_pool_str (cur_cite_str);
+ end;
+print_newline;
+bst_warn ('while executing'); {This does the |mark_warning|}
+end;
+
+
+@
+It's illegal to mess with the entry information at certain times;
+here's a complaint for these times.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_cant_mess_with_entries_print;
+begin
+bst_ex_warn ('You can''t mess with entries here');
+end;
+
+
+@
+This module executes a single specified function once. It can't do
+anything with the entries.
+
+@<Perform an \.{execute} command@>=
+begin
+init_command_execution;
+mess_with_entries := false;
+execute_fn (fn_loc);
+check_command_execution;
+end
+
+
+@
+This module iterates a single specified function for all entries
+specified by |cite_list|.
+
+@<Perform an \.{iterate} command@>=
+begin
+init_command_execution;
+mess_with_entries := true;
+sort_cite_ptr := 0;
+while (sort_cite_ptr < num_cites) do
+ begin
+ cite_ptr := sorted_cites[sort_cite_ptr];
+ trace
+ trace_pr_pool_str (hash_text[fn_loc]);
+ trace_pr (' to be iterated on ');
+ trace_pr_pool_str (cur_cite_str);
+ trace_pr_newline;
+ ecart@/
+ execute_fn (fn_loc);
+ check_command_execution;
+ incr(sort_cite_ptr);
+ end;
+end
+
+
+@
+This module iterates a single specified function for all entries
+specified by |cite_list|, but does it in reverse order.
+
+@<Perform a \.{reverse} command@>=
+begin
+init_command_execution;
+mess_with_entries := true;
+if (num_cites > 0) then
+ begin
+ sort_cite_ptr := num_cites;
+ repeat
+ decr(sort_cite_ptr);
+ cite_ptr := sorted_cites[sort_cite_ptr];
+ trace
+ trace_pr_pool_str (hash_text[fn_loc]);
+ trace_pr (' to be iterated in reverse on ');
+ trace_pr_pool_str (cur_cite_str);
+ trace_pr_newline;
+ ecart@/
+ execute_fn (fn_loc);
+ check_command_execution;
+ until (sort_cite_ptr = 0);
+ end;
+end
+
+
+@
+This module sorts the entries based on \.{sort.key\$}; it is a stable
+sort.
+
+@<Perform a \.{sort} command@>=
+begin
+ trace
+ trace_pr_ln ('Sorting the entries');
+ ecart@/
+if (num_cites > 1) then
+ quick_sort (0, num_cites-1);
+ trace
+ trace_pr_ln ('Done sorting');
+ ecart@/
+end
+
+
+@
+These next two procedures (actually, one procedures and one function,
+but who's counting) are subroutines for |quick_sort|, which follows.
+The |swap| procedure exchanges the two elements its arguments point
+to.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+procedure swap (@!swap1,@!swap2 : cite_number);
+var innocent_bystander : cite_number; {the temporary element in an exchange}
+begin
+innocent_bystander := sorted_cites[swap2];
+sorted_cites[swap2] := sorted_cites[swap1];
+sorted_cites[swap1] := innocent_bystander;
+end;
+
+
+@
+@:this can't happen}{\quad Duplicate sort key@>
+The function |less_than| compares the two \.{sort.key\$}s indirectly
+pointed to by its arguments and returns |true| if the first argument's
+\.{sort.key\$} is lexicographically less than the second's (that is,
+alphabetically earlier). In case of ties the function compares the
+indices |arg1| and |arg2|, which are assumed to be different, and
+returns |true| if the first is smaller. This function uses
+|ASCII_code|s to compare, so it might give ``interesting'' results
+when handling nonletters.
+
+@d compare_return(#) == begin {the compare is finished}
+ less_than := #;
+ return;
+ end
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+function less_than (@!arg1,@!arg2 : cite_number) : boolean;
+label exit;
+var char_ptr : 0..ent_str_size; {character index into compared strings}
+ @!ptr1,@!ptr2 : str_ent_loc; {the two \.{sort.key\$} pointers}
+ @!char1,@!char2 : ASCII_code; {the two characters being compared}
+begin
+ptr1 := arg1*num_ent_strs + sort_key_num;
+ptr2 := arg2*num_ent_strs + sort_key_num;
+char_ptr := 0;
+loop
+ begin
+ char1 := entry_strs[ptr1][char_ptr];
+ char2 := entry_strs[ptr2][char_ptr];
+ if (char1 = end_of_string) then
+ if (char2 = end_of_string) then
+ if (arg1 < arg2) then
+ compare_return (true)
+ else if (arg1 > arg2) then
+ compare_return (false)
+ else {|arg1 = arg2|}
+ confusion ('Duplicate sort key')
+ else {|char2 <> end_of_string|}
+ compare_return (true)
+ else {|char1 <> end_of_string|}
+ if (char2 = end_of_string) then
+ compare_return (false)
+ else if (char1 < char2) then
+ compare_return (true)
+ else if (char1 > char2) then
+ compare_return (false);
+ incr(char_ptr);
+ end;
+exit:
+end;
+
+
+@
+The recursive procedure |quick_sort| sorts the entries indirectly
+pointed to by the |sorted_cites| elements between |left_end| and
+|right_end|, inclusive, based on the value of the |str_entry_var|
+\.{sort.key\$}. It's a fairly standard quicksort (for example, see
+Algorithm 5.2.2Q in {\sl The Art of Computer Programming}), but uses
+the median-of-three method to choose the partition element just in
+case the entries are already sorted (or nearly sorted---humans and
+ASCII might have different ideas on lexicographic ordering); it is a
+stable sort. This code generally prefers clarity to assembler-type
+execution-time efficiency since |cite_list|s will rarely be huge.
+
+The value |short_list|, which must be at least |2*end_offset + 2| for
+this code to work, tells us the list-length at which the list is small
+enough to warrant switching over to straight insertion sort from the
+recursive quicksort. The values here come from modest empirical tests
+aimed at minimizing, for large |cite_list|s (five hundred or so), the
+number of comparisons (between keys) plus the number of calls to
+|quick_sort|. The value |end_offset| must be positive; this helps
+avoid $n^2$ behavior observed when the list starts out nearly, but not
+completely, sorted (and fairly frequently large |cite_list|s come from
+entire databases, which fairly frequently are nearly sorted).
+
+@d short_list = 10 {use straight insertion sort at or below this length}
+@d end_offset = 4 {the index end-offsets for choosing a median-of-three}
+
+@<Check the ``constant'' values for consistency@>=
+if (short_list < 2*end_offset + 2) then bad:=100*bad+22;
+
+
+@
+Here's the actual procedure.
+
+@d next_insert = 24 {now insert the next element}
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+procedure quick_sort (@!left_end,@!right_end : cite_number);
+label next_insert;
+var left,@!right : cite_number; {two general |sorted_cites| pointers}
+ @!insert_ptr : cite_number; {the to-be-(straight)-inserted element}
+ @!middle : cite_number; {the |(left_end+right_end) div 2| element}
+ @!partition : cite_number; {the median-of-three partition element}
+begin
+ trace
+ trace_pr_ln ('Sorting ',left_end:0,' through ',right_end:0);
+ ecart@/
+if (right_end - left_end < short_list) then
+ @<Do a straight insertion sort@>
+ else
+ begin
+ @<Draw out the median-of-three partition element@>;
+ @<Do the partitioning and the recursive calls@>;
+ end;
+end;
+
+
+@
+This code sorts the entries between |left_end| and |right_end| when
+the difference is less than |short_list|. Each iteration of the outer
+loop inserts the element indicated by |insert_ptr| into its proper
+place among the (sorted) elements from |left_end| through
+|insert_ptr-1|.
+
+@<Do a straight insertion sort@>=
+begin
+for insert_ptr := left_end+1 to right_end do
+ begin
+ for right := insert_ptr downto left_end+1 do
+ begin
+ if (less_than (sorted_cites[right-1], sorted_cites[right])) then
+ goto next_insert;
+ swap (right-1, right);
+ end;
+next_insert:
+ end;
+end
+
+
+@
+Now we find the median of the three \.{sort.key\$}s to which the three
+elements |sorted_cites[left_end+end_offset]|,
+|sorted_cites[right_end]-end_offset|, and
+|sorted_cites[(left_end+right_end) div 2]| point (a nonzero
+|end_offset| avoids using as the leftmost of the three elements the
+one that was swapped there when the old partition element was swapped
+into its final spot; this turns out to avoid $n^2$ behavior when the
+list is nearly sorted to start with). This code determines which of
+the six possible permutations we're dealing with and moves the median
+element to |left_end|. The comments next to the |swap| actions give
+the known orderings of the corresponding elements of |sorted_cites|
+before the action.
+
+@<Draw out the median-of-three partition element@>=
+begin
+left := left_end + end_offset;
+middle := (left_end+right_end) div 2;
+right := right_end - end_offset;
+if (less_than (sorted_cites[left], sorted_cites[middle])) then
+ if (less_than (sorted_cites[middle], sorted_cites[right])) then
+ {|left < middle < right|}
+ swap(left_end,middle)
+ else if (less_than (sorted_cites[left], sorted_cites[right])) then
+ {|left < right < middle|}
+ swap(left_end,right)
+ else {|right < left < middle|}
+ swap(left_end,left)
+ else if (less_than (sorted_cites[right], sorted_cites[middle])) then
+ {|right < middle < left|}
+ swap(left_end,middle)
+ else if (less_than (sorted_cites[right], sorted_cites[left])) then
+ {|middle < right < left|}
+ swap(left_end,right)
+ else {|middle < left < right|}
+ swap(left_end,left);
+end
+
+
+@
+This module uses the median-of-three computed above to partition the
+elements into those less than and those greater than the median.
+Equal \.{sort.key\$}s are sorted by order of occurrence (in
+|cite_list|).
+
+@<Do the partitioning and the recursive calls@>=
+begin
+partition := sorted_cites[left_end];
+left := left_end + 1;
+right := right_end;
+repeat
+ while (less_than (sorted_cites[left], partition)) do
+ incr(left);
+ while (less_than (partition, sorted_cites[right])) do
+ decr(right);
+ {now |sorted_cites[right] < partition < sorted_cites[left]|}
+ if (left < right) then
+ begin
+ swap (left,right);
+ incr(left);
+ decr(right);
+ end;
+until (left = right+1); {pointers have crossed}
+swap (left_end,right);{restoring the partition element to its |right|ful place}
+quick_sort (left_end,right-1);
+quick_sort (left,right_end);
+end
+
+
+@
+@:BibTeX capacity exceeded}{\quad literal-stack size@>
+@:this can't happen}{\quad Unknown literal type@>
+Ok, that's it for sorting; now we'll play with the literal stack.
+This procedure pushes a literal onto the stack, checking for stack
+overflow.
+
+@<Procedures and functions for style-file function execution@>=
+procedure push_lit_stk (@!push_lt:integer; @!push_type:stk_type);
+ trace
+ var dum_ptr : lit_stk_loc; {used just as an index variable}
+ ecart@/
+begin
+lit_stack[lit_stk_ptr] := push_lt;
+lit_stk_type[lit_stk_ptr] := push_type;
+ trace
+ for dum_ptr := 0 to lit_stk_ptr do
+ trace_pr (' ');
+ trace_pr ('Pushing ');
+ case (lit_stk_type[lit_stk_ptr]) of
+ stk_int : trace_pr_ln (lit_stack[lit_stk_ptr]:0);
+ stk_str : begin
+ trace_pr ('"');
+ trace_pr_pool_str (lit_stack[lit_stk_ptr]);
+ trace_pr_ln ('"');
+ end;
+ stk_fn : begin
+ trace_pr ('`');
+ trace_pr_pool_str (hash_text[lit_stack[lit_stk_ptr]]);
+ trace_pr_ln ('''');
+ end;
+ stk_field_missing : begin
+ trace_pr ('missing field `');
+ trace_pr_pool_str (lit_stack[lit_stk_ptr]);
+ trace_pr_ln ('''');
+ end;
+ stk_empty : trace_pr_ln ('a bad literal--popped from an empty stack');
+ othercases unknwn_literal_confusion
+ endcases;
+ ecart@/
+if (lit_stk_ptr = lit_stk_size) then
+ overflow('literal-stack size ',lit_stk_size);
+incr(lit_stk_ptr);
+end;
+
+
+@
+@^push the literal stack@>
+This macro pushes the last thing, necessarily a string, that was
+popped. And this module, along with others that push the literal
+stack without explicitly calling |push_lit_stack|, have an index entry
+under ``push the literal stack''; these implicit pushes collectively
+speed up the program by about ten percent.
+
+@d repush_string == begin
+ if (lit_stack[lit_stk_ptr] >= cmd_str_ptr) then
+ unflush_string;
+ incr(lit_stk_ptr);
+ end
+
+
+@
+@:this can't happen}{\quad Nontop top of string stack@>
+This procedure pops the stack, checking for, and trying to recover
+from, stack underflow. (Actually, this procedure is really a
+function, since it returns the two values through its |var|
+parameters.) Also, if the literal being popped is a |stk_str| that's
+been created during the execution of the current \.{.bst} command, pop
+it from |str_pool| as well (it will be the string corresponding to
+|str_ptr-1|). Note that when this happens, the string is no longer
+`officially' available so that it must be used before anything else is
+added to |str_pool|.
+
+@<Procedures and functions for style-file function execution@>=
+procedure pop_lit_stk (var pop_lit:integer; var pop_type:stk_type);
+begin
+if (lit_stk_ptr = 0) then
+ begin
+ bst_ex_warn ('You can''t pop an empty literal stack');@/
+ pop_type := stk_empty; {this is an error recovery attempt}
+ end
+ else
+ begin
+ decr(lit_stk_ptr);
+ pop_lit := lit_stack[lit_stk_ptr];
+ pop_type := lit_stk_type[lit_stk_ptr];
+ if (pop_type = stk_str) then
+ if (pop_lit >= cmd_str_ptr) then
+ begin
+ if (pop_lit <> str_ptr-1) then
+ confusion ('Nontop top of string stack');
+ flush_string;
+ end;
+ end;
+end;
+
+
+@
+@:this can't happen}{\quad Illegal literal type@>
+@:this can't happen}{\quad Unknown literal type@>
+More bug complaints, this time about bad literals.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure illegl_literal_confusion;
+begin
+confusion ('Illegal literal type');
+end;
+@#
+procedure unknwn_literal_confusion;
+begin
+confusion ('Unknown literal type');
+end;
+
+
+@
+@:this can't happen}{\quad Illegal literal type@>
+@:this can't happen}{\quad Unknown literal type@>
+Occasionally we'll want to know what's on the literal stack. Here we
+print out a stack literal, giving its type. This procedure should
+never be called after popping an empty stack.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_stk_lit (@!stk_lt:integer; @!stk_tp:stk_type);
+begin
+case (stk_tp) of
+ stk_int : print (stk_lt:0,' is an integer literal');
+ stk_str : begin
+ print ('"');
+ print_pool_str (stk_lt);
+ print ('" is a string literal');
+ end;
+ stk_fn : begin
+ print ('`');
+ print_pool_str (hash_text[stk_lt]);
+ print (''' is a function literal');
+ end;
+ stk_field_missing : begin
+ print ('`');
+ print_pool_str (stk_lt);
+ print (''' is a missing field');
+ end;
+ stk_empty : illegl_literal_confusion;
+ othercases unknwn_literal_confusion
+endcases;
+end;
+
+
+@
+@:this can't happen}{\quad Illegal literal type@>
+@:this can't happen}{\quad Unknown literal type@>
+This procedure appropriately chastises the style designer; however, if
+the wrong literal came from popping an empty stack, the procedure
+|pop_lit_stack| will have already done the chastising (because this
+procedure is called only after popping the stack) so there's no need
+for more.
+
+@<Procedures and functions for style-file function execution@>=
+procedure print_wrong_stk_lit (@!stk_lt:integer; @!stk_tp1,@!stk_tp2:stk_type);
+begin
+if (stk_tp1 <> stk_empty) then
+ begin
+ print_stk_lit (stk_lt, stk_tp1);
+ case (stk_tp2) of
+ stk_int : print (', not an integer,');
+ stk_str : print (', not a string,');
+ stk_fn : print (', not a function,');
+ stk_field_missing,
+ stk_empty : illegl_literal_confusion;
+ othercases unknwn_literal_confusion
+ endcases;
+ bst_ex_warn_print;
+ end;
+end;
+
+
+@
+@:this can't happen}{\quad Illegal literal type@>
+@:this can't happen}{\quad Unknown literal type@>
+This is similar to |print_stk_lit|, but here we don't give the
+literal's type, and here we end with a new line. This procedure
+should never be called after popping an empty stack.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure print_lit (@!stk_lt:integer; @!stk_tp:stk_type);
+begin
+case (stk_tp) of
+ stk_int : print_ln (stk_lt:0);
+ stk_str : begin
+ print_pool_str (stk_lt);
+ print_newline;
+ end;
+ stk_fn : begin
+ print_pool_str (hash_text[stk_lt]);
+ print_newline;
+ end;
+ stk_field_missing : begin
+ print_pool_str (stk_lt);
+ print_newline;
+ end;
+ stk_empty : illegl_literal_confusion;
+ othercases unknwn_literal_confusion
+endcases;
+end;
+
+
+@
+This procedure pops and prints the top of the stack; when the stack is
+empty the procedure |pop_lit_stk| complains.
+
+@<Procedures and functions for style-file function execution@>=
+procedure pop_top_and_print;
+var stk_lt : integer;
+ @!stk_tp : stk_type;
+begin
+pop_lit_stk (stk_lt,stk_tp);
+if (stk_tp = stk_empty) then
+ print_ln ('Empty literal')
+ else
+ print_lit (stk_lt,stk_tp);
+end;
+
+
+@
+This procedure pops and prints the whole stack.
+
+@<Procedures and functions for style-file function execution@>=
+procedure pop_whole_stack;
+begin
+while (lit_stk_ptr > 0) do
+ pop_top_and_print;
+end;
+
+
+@
+At the beginning of a \.{.bst}-command execution we make the stack
+empty and record how much of |str_pool| has been used.
+
+@<Procedures and functions for style-file function execution@>=
+procedure init_command_execution;
+begin
+lit_stk_ptr := 0; {make the stack empty}
+cmd_str_ptr := str_ptr; {we'll check this when we finish command execution}
+end;
+
+
+@
+@:this can't happen}{\quad Nonempty empty string stack@>
+At the end of a \.{.bst} command-execution we check that the stack and
+|str_pool| are still in good shape.
+
+@<Procedures and functions for style-file function execution@>=
+procedure check_command_execution;
+begin
+if (lit_stk_ptr<>0) then
+ begin
+ print_ln ('ptr=',lit_stk_ptr:0,', stack=');
+ pop_whole_stack;
+ bst_ex_warn ('---the literal stack isn''t empty');
+ end;
+if (cmd_str_ptr<>str_ptr) then
+ begin
+ trace
+ print_ln ('Pointer is ',str_ptr:0,' but should be ',cmd_str_ptr:0);
+ ecart@/
+ confusion ('Nonempty empty string stack');
+ end;
+end;
+
+
+@
+This procedure adds to |str_pool| the string from |ex_buf[0]| through
+|ex_buf[ex_buf_length-1]| if it will fit. It assumes the global
+variable |ex_buf_length| gives the length of the current string in
+|ex_buf|. It then pushes this string onto the literal stack.
+
+@<Procedures and functions for style-file function execution@>=
+procedure add_pool_buf_and_push;
+begin
+str_room (ex_buf_length); {make sure this string will fit}
+ex_buf_ptr := 0;
+while (ex_buf_ptr < ex_buf_length) do
+ begin
+ append_char (ex_buf[ex_buf_ptr]);
+ incr(ex_buf_ptr);
+ end;
+push_lit_stk (make_string, stk_str); {and push it onto the stack}
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad buffer size@>
+These macros append a character to |ex_buf|. Which is called depends
+on whether the character is known to fit.
+
+@d append_ex_buf_char(#) == begin
+ ex_buf[ex_buf_ptr] := #;
+ incr(ex_buf_ptr);
+ end
+@#
+@d append_ex_buf_char_and_check(#) ==
+ begin
+ if (ex_buf_ptr = buf_size) then
+ buffer_overflow;
+ append_ex_buf_char(#);
+ end
+
+
+@
+@:BibTeX capacity exceeded}{\quad buffer size@>
+This procedure adds to the execution buffer the given string in
+|str_pool| if it will fit. It assumes the global variable
+|ex_buf_length| gives the length of the current string in |ex_buf|,
+and thus also gives the location of the next character.
+
+@<Procedures and functions for style-file function execution@>=
+procedure add_buf_pool (@!p_str : str_number);
+begin
+p_ptr1 := str_start[p_str];
+p_ptr2 := str_start[p_str+1];
+if (ex_buf_length+(p_ptr2-p_ptr1) > buf_size) then
+ buffer_overflow;
+ex_buf_ptr := ex_buf_length;
+while (p_ptr1 < p_ptr2) do
+ begin {copy characters into the buffer}
+ append_ex_buf_char (str_pool[p_ptr1]);
+ incr(p_ptr1);
+ end;
+ex_buf_length := ex_buf_ptr;
+end;
+
+
+@
+This procedure actually writes onto the \.{.bbl}~file a line of output
+(the characters from |out_buf[0]| to |out_buf[out_buf_length-1]|,
+after removing trailing |white_space| characters). It also updates
+|bbl_line_num|, the line counter. It writes a blank line if and only
+if |out_buf| is empty. The program uses this procedure in such a way
+that |out_buf| will be nonempty if there have been characters put in
+it since the most recent \.{newline\$}.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure output_bbl_line;
+label loop_exit,@!exit;
+begin
+if (out_buf_length <> 0) then {the buffer's not empty}
+ begin
+ while (out_buf_length > 0) do {remove trailing |white_space|}
+ if (lex_class[out_buf[out_buf_length-1]] = white_space) then
+ decr(out_buf_length)
+ else
+ goto loop_exit;
+loop_exit:
+ if (out_buf_length = 0) then {ignore a line of just |white_space|}
+ return;
+ out_buf_ptr := 0;
+ while (out_buf_ptr < out_buf_length) do
+ begin
+ write (bbl_file, xchr[out_buf[out_buf_ptr]]);
+ incr(out_buf_ptr);
+ end;
+ end;
+write_ln (bbl_file);
+incr(bbl_line_num); {update line number}
+out_buf_length := 0; {make the next line empty}
+exit:
+end;
+
+
+@
+@:BibTeX capacity exceeded}{\quad output buffer size@>
+This procedure adds to the output buffer the given string in
+|str_pool|. It assumes the global variable |out_buf_length| gives the
+length of the current string in |out_buf|, and thus also gives the
+location for the next character. If there are enough characters
+present in the output buffer, it writes one or more lines out to the
+\.{.bbl} file. It may break a line at any |white_space| character it
+likes, but if it does, it will add two |space|s to the next output
+line.
+
+@<Procedures and functions for style-file function execution@>=
+procedure add_out_pool (@!p_str : str_number);
+var break_ptr : buf_pointer; {the first character following the line break}
+@!end_ptr : buf_pointer; {temporary end-of-buffer pointer}
+begin
+p_ptr1 := str_start[p_str];
+p_ptr2 := str_start[p_str+1];
+if (out_buf_length+(p_ptr2-p_ptr1) > buf_size) then
+ overflow('output buffer size ',buf_size);
+out_buf_ptr := out_buf_length;
+while (p_ptr1 < p_ptr2) do
+ begin {copy characters into the buffer}
+ out_buf[out_buf_ptr] := str_pool[p_ptr1];
+ incr(p_ptr1);
+ incr(out_buf_ptr);
+ end;
+out_buf_length := out_buf_ptr;
+while (out_buf_length > max_print_line) do
+ @<Break that line@>;
+end;
+
+
+@
+Here we break the line by looking for a |white_space| character,
+backwards from |out_buf[max_print_line]| until
+|out_buf[min_print_line]|; we break at the |white_space| and indent
+the next line two |space|s. The next module handles things when
+there's no |white_space| character to break at.
+
+@<Break that line@>=
+begin
+end_ptr := out_buf_length;
+out_buf_ptr := max_print_line;
+while ((lex_class[out_buf[out_buf_ptr]] <> white_space) and
+ (out_buf_ptr >= min_print_line)) do
+ decr(out_buf_ptr);
+if (out_buf_ptr = min_print_line-1) then {no |white_space| character}
+ @<Break that unbreakable line@>
+else
+ begin {hit a |white_space| character}
+ out_buf_length := out_buf_ptr;
+ break_ptr := out_buf_length + 1;
+ output_bbl_line; {output what we can}
+ out_buf[0] := space;
+ out_buf[1] := space; {start the next line with two |space|s}
+ out_buf_ptr := 2;
+ tmp_ptr := break_ptr;
+ while (tmp_ptr < end_ptr) do {and slide the rest down}
+ begin
+ out_buf[out_buf_ptr] := out_buf[tmp_ptr];
+ incr(out_buf_ptr);
+ incr(tmp_ptr);
+ end;
+ out_buf_length := end_ptr - break_ptr + 2;
+ end;
+end
+
+
+@
+If there's no |white_space| character to break the line at, we break
+it at |out_buf[max_print_line-1]|, append a |comment| character, and
+don't indent the next line.
+
+@<Break that unbreakable line@>=
+begin
+out_buf[end_ptr] := out_buf[max_print_line-1]; {save this character}
+out_buf[max_print_line-1] := comment; {so \TeX\ does the thing right}
+out_buf_length := max_print_line;
+break_ptr := out_buf_length - 1; {the `|-1|' allows for the restoration}
+output_bbl_line; {output what we can,}
+out_buf[max_print_line-1] := out_buf[end_ptr]; {restore this character}
+out_buf_ptr := 0;
+tmp_ptr := break_ptr;
+while (tmp_ptr < end_ptr) do {and slide the rest down}
+ begin
+ out_buf[out_buf_ptr] := out_buf[tmp_ptr];
+ incr(out_buf_ptr);
+ incr(tmp_ptr);
+ end;
+out_buf_length := end_ptr - break_ptr;
+end
+
+
+@
+@^Tuesdays@>
+@^windows@>
+@:this can't happen}{\quad Unknown function class@>
+This procedure executes a single specified function; it is the single
+execution-primitive that does everything (except windows, and it takes
+Tuesdays off).
+
+@<|execute_fn| itself@>=
+procedure execute_fn (@!ex_fn_loc : hash_loc);
+@<Declarations for executing |built_in| functions@>
+@!wiz_ptr : wiz_fn_loc; {general |wiz_functions| location}
+begin
+ trace
+ trace_pr ('execute_fn `');
+ trace_pr_pool_str (hash_text[ex_fn_loc]);
+ trace_pr_ln ('''');
+ ecart@/
+case (fn_type[ex_fn_loc]) of
+ built_in : @<Execute a |built_in| function@>;
+ wiz_defined : @<Execute a |wiz_defined| function@>;
+ int_literal : push_lit_stk (fn_info[ex_fn_loc], stk_int);
+ str_literal : push_lit_stk (hash_text[ex_fn_loc], stk_str);
+ field : @<Execute a field@>;
+ int_entry_var : @<Execute an |int_entry_var|@>;
+ str_entry_var : @<Execute a |str_entry_var|@>;
+ int_global_var : push_lit_stk (fn_info[ex_fn_loc], stk_int);
+ str_global_var : @<Execute a |str_global_var|@>;
+ othercases unknwn_function_class_confusion
+endcases;
+end;
+
+
+@
+To execute a |wiz_defined| function, we just execute all those
+functions in its definition, except that the special marker
+|quote_next_fn| means we push the next function onto the stack.
+
+@<Execute a |wiz_defined| function@>=
+begin
+wiz_ptr := fn_info[ex_fn_loc];
+while (wiz_functions[wiz_ptr] <> end_of_def) do
+ begin
+ if (wiz_functions[wiz_ptr] <> quote_next_fn) then
+ execute_fn (wiz_functions[wiz_ptr])
+ else
+ begin
+ incr(wiz_ptr);
+ push_lit_stk (wiz_functions[wiz_ptr], stk_fn);
+ end;
+ incr(wiz_ptr);
+ end;
+end
+
+
+@
+This module pushes the string given by the field onto the literal
+stack unless it's |missing|, in which case it pushes a special value
+onto the stack.
+
+@<Execute a field@>=
+begin
+if (not mess_with_entries) then
+ bst_cant_mess_with_entries_print
+ else
+ begin
+ field_ptr := cite_ptr*num_fields + fn_info[ex_fn_loc];
+ if (field_info[field_ptr] = missing) then
+ push_lit_stk (hash_text[ex_fn_loc], stk_field_missing)
+ else
+ push_lit_stk (field_info[field_ptr], stk_str);
+ end
+end
+
+
+@
+This module pushes the integer given by an |int_entry_var| onto the
+literal stack.
+
+@<Execute an |int_entry_var|@>=
+begin
+if (not mess_with_entries) then
+ bst_cant_mess_with_entries_print
+ else
+ push_lit_stk (entry_ints[cite_ptr*num_ent_ints+fn_info[ex_fn_loc]],
+ stk_int);
+end
+
+
+@
+This module adds the string given by a |str_entry_var| to |str_pool|
+via the execution buffer and pushes it onto the literal stack.
+
+@<Execute a |str_entry_var|@>=
+begin
+if (not mess_with_entries) then
+ bst_cant_mess_with_entries_print
+ else
+ begin
+ str_ent_ptr := cite_ptr*num_ent_strs + fn_info[ex_fn_loc];@/
+ ex_buf_ptr := 0; {also serves as |ent_chr_ptr|}
+ while (entry_strs[str_ent_ptr][ex_buf_ptr] <> end_of_string) do
+ {copy characters into the buffer}
+ append_ex_buf_char (entry_strs[str_ent_ptr][ex_buf_ptr]);
+ ex_buf_length := ex_buf_ptr;
+ add_pool_buf_and_push; {push this string onto the stack}
+ end;
+end
+
+
+@
+This module pushes the string given by a |str_global_var| onto the
+literal stack, but it copies the string to |str_pool| (character by
+character) only if it has to---it {\it doesn't\/} have to if the
+string is static (that is, if the string isn't at the top, temporary
+part of the string pool).
+
+@<Execute a |str_global_var|@>=
+begin
+str_glb_ptr := fn_info[ex_fn_loc];
+if (glb_str_ptr[str_glb_ptr] > 0) then {we're dealing with a static string}
+ push_lit_stk (glb_str_ptr[str_glb_ptr],stk_str)
+ else
+ begin
+ str_room(glb_str_end[str_glb_ptr]);
+ glob_chr_ptr := 0;
+ while (glob_chr_ptr < glb_str_end[str_glb_ptr]) do {copy the string}
+ begin
+ append_char (global_strs[str_glb_ptr][glob_chr_ptr]);
+ incr(glob_chr_ptr);
+ end;
+ push_lit_stk (make_string, stk_str); {and push it onto the stack}
+ end;
+end
+
+
+
+@* The built-in functions.
+@^add a built-in function@>
+@^biblical procreation@>
+@^grade inflation@>
+This section gives the all the code for all the built-in functions
+(including pre-defined |field|s, |str_entry_var|s, and
+|int_global_var|s, which technically aren't classified as |built_in|).
+To modify or add one, we needn't go anywhere else (with one exception:
+The constant |max_pop|, which gives the maximum number of literals
+that any of these functions pops off the stack, is defined earlier
+because it's needed earlier; thus, if we need to update it, which will
+happen if some new |built_in| functions uses more than |max_pop|
+literals from the stack, we'll have to go outside this section).
+Adding a |built_in| function entails modifying (at least four of) the
+five modules marked by ``add a built-in function'' in the index, in
+addition to adding the code to execute the function.
+
+These variables all begin with |b_| and specify the hash-table
+locations of the |built_in| functions, except that |b_default| is
+pseudo-|built_in|---either it will point to the no-op \.{skip\$} or to
+the \.{.bst}-defined function \.{default.type}; it's used when an
+entry has a type that's not defined in the \.{.bst} file.
+
+@<Globals in the outer block@>=
+@!b_equals : hash_loc; {\.{=}}
+@!b_greater_than : hash_loc; {\.{>}}
+@!b_less_than : hash_loc; {\.{<}}
+@!b_plus : hash_loc; {\.{+} (this may be changed to an |a_minus|)}
+@!b_minus : hash_loc; {\.{-}}
+@!b_concatenate : hash_loc; {\.{*}}
+@!b_gets : hash_loc; {\.{:=} (formerly, |b_gat|)}
+@!b_add_period : hash_loc; {\.{add.period\$}}
+@!b_call_type : hash_loc; {\.{call.type\$}}
+@!b_change_case : hash_loc; {\.{change.case\$}}
+@!b_chr_to_int : hash_loc; {\.{chr.to.int\$}}
+@!b_cite : hash_loc; {\.{cite\$}}
+@!b_duplicate : hash_loc; {\.{duplicate\$}}
+@!b_empty : hash_loc; {\.{empty\$}}
+@!b_format_name : hash_loc; {\.{format.name\$}}
+@!b_if : hash_loc; {\.{if\$}}
+@!b_int_to_chr : hash_loc; {\.{int.to.chr\$}}
+@!b_int_to_str : hash_loc; {\.{int.to.str\$}}
+@!b_missing : hash_loc; {\.{missing\$}}
+@!b_newline : hash_loc; {\.{newline\$}}
+@!b_num_names : hash_loc; {\.{num.names\$}}
+@!b_pop : hash_loc; {\.{pop\$}}
+@!b_preamble : hash_loc; {\.{preamble\$}}
+@!b_purify : hash_loc; {\.{purify\$}}
+@!b_quote : hash_loc; {\.{quote\$}}
+@!b_skip : hash_loc; {\.{skip\$}}
+@!b_stack : hash_loc; {\.{stack\$}}
+@!b_substring : hash_loc; {\.{substring\$}}
+@!b_swap : hash_loc; {\.{swap\$}}
+@!b_text_length : hash_loc; {\.{text.length\$}}
+@!b_text_prefix : hash_loc; {\.{text.prefix\$}}
+@!b_top_stack : hash_loc; {\.{top\$}}
+@!b_type : hash_loc; {\.{type\$}}
+@!b_warning : hash_loc; {\.{warning\$}}
+@!b_while : hash_loc; {\.{while\$}}
+@!b_width : hash_loc; {\.{width\$}}
+@!b_write : hash_loc; {\.{write\$}}
+@!b_default : hash_loc; {either \.{skip\$} or \.{default.type}}
+@#
+ stat
+ @!blt_in_loc : array[blt_in_range] of hash_loc; {for execution counts}
+ @!execution_count : array[blt_in_range] of integer; {the same}
+ @!total_ex_count : integer; {the sum of all |execution_count|s}
+ @!blt_in_ptr : blt_in_range; {a pointer into |blt_in_loc|}
+ tats@/
+
+
+@
+Where |blt_in_range| gives the legal |built_in| function numbers.
+
+@<Types in the outer block@>=
+@!blt_in_range = 0..num_blt_in_fns;
+
+
+@
+@^add a built-in function@>
+These constants all begin with |n_| and are used for the |case|
+statement that determines which |built_in| function to execute.
+
+@d n_equals = 0 {\.{=}}
+@d n_greater_than = 1 {\.{>}}
+@d n_less_than = 2 {\.{<}}
+@d n_plus = 3 {\.{+}}
+@d n_minus = 4 {\.{-}}
+@d n_concatenate = 5 {\.{*}}
+@d n_gets = 6 {\.{:=}}
+@d n_add_period = 7 {\.{add.period\$}}
+@d n_call_type = 8 {\.{call.type\$}}
+@d n_change_case = 9 {\.{change.case\$}}
+@d n_chr_to_int = 10 {\.{chr.to.int\$}}
+@d n_cite = 11 {\.{cite\$} (this may start a riot)}
+@d n_duplicate = 12 {\.{duplicate\$}}
+@d n_empty = 13 {\.{empty\$}}
+@d n_format_name = 14 {\.{format.name\$}}
+@d n_if = 15 {\.{if\$}}
+@d n_int_to_chr = 16 {\.{int.to.chr\$}}
+@d n_int_to_str = 17 {\.{int.to.str\$}}
+@d n_missing = 18 {\.{missing\$}}
+@d n_newline = 19 {\.{newline\$}}
+@d n_num_names = 20 {\.{num.names\$}}
+@d n_pop = 21 {\.{pop\$}}
+@d n_preamble = 22 {\.{preamble\$}}
+@d n_purify = 23 {\.{purify\$}}
+@d n_quote = 24 {\.{quote\$}}
+@d n_skip = 25 {\.{skip\$}}
+@d n_stack = 26 {\.{stack\$}}
+@d n_substring = 27 {\.{substring\$}}
+@d n_swap = 28 {\.{swap\$}}
+@d n_text_length = 29 {\.{text.length\$}}
+@d n_text_prefix = 30 {\.{text.prefix\$}}
+@d n_top_stack = 31 {\.{top\$}}
+@d n_type = 32 {\.{type\$}}
+@d n_warning = 33 {\.{warning\$}}
+@d n_while = 34 {\.{while\$}}
+@d n_width = 35 {\.{width\$}}
+@d n_write = 36 {\.{write\$}}
+
+@<Constants in the outer block@>=
+@!num_blt_in_fns = 37; {one more than the previous number}
+
+
+@
+@^add a built-in function@>
+@^important note@>
+It's time for us to insert more pre-defined strings into |str_pool|
+(and thus the hash table) and to insert the |built_in| functions into
+the hash table. The strings corresponding to these functions should
+contain no upper-case letters, and they must all be exactly
+|longest_pds| characters long. The |build_in| routine (to appear
+shortly) does the work.
+
+Important note: These pre-definitions must not have any glitches or the
+program may bomb because the |log_file| hasn't been opened yet.
+
+@<Pre-define certain strings@>=
+build_in('= ',1,b_equals,n_equals);
+build_in('> ',1,b_greater_than,n_greater_than);
+build_in('< ',1,b_less_than,n_less_than);
+build_in('+ ',1,b_plus,n_plus);
+build_in('- ',1,b_minus,n_minus);
+build_in('* ',1,b_concatenate,n_concatenate);
+build_in(':= ',2,b_gets,n_gets);
+build_in('add.period$ ',11,b_add_period,n_add_period);
+build_in('call.type$ ',10,b_call_type,n_call_type);
+build_in('change.case$',12,b_change_case,n_change_case);
+build_in('chr.to.int$ ',11,b_chr_to_int,n_chr_to_int);
+build_in('cite$ ',5,b_cite,n_cite);
+build_in('duplicate$ ',10,b_duplicate,n_duplicate);
+build_in('empty$ ',6,b_empty,n_empty);
+build_in('format.name$',12,b_format_name,n_format_name);
+build_in('if$ ',3,b_if,n_if);
+build_in('int.to.chr$ ',11,b_int_to_chr,n_int_to_chr);
+build_in('int.to.str$ ',11,b_int_to_str,n_int_to_str);
+build_in('missing$ ',8,b_missing,n_missing);
+build_in('newline$ ',8,b_newline,n_newline);
+build_in('num.names$ ',10,b_num_names,n_num_names);
+build_in('pop$ ',4,b_pop,n_pop);
+build_in('preamble$ ',9,b_preamble,n_preamble);
+build_in('purify$ ',7,b_purify,n_purify);
+build_in('quote$ ',6,b_quote,n_quote);
+build_in('skip$ ',5,b_skip,n_skip);
+build_in('stack$ ',6,b_stack,n_stack);
+build_in('substring$ ',10,b_substring,n_substring);
+build_in('swap$ ',5,b_swap,n_swap);
+build_in('text.length$',12,b_text_length,n_text_length);
+build_in('text.prefix$',12,b_text_prefix,n_text_prefix);
+build_in('top$ ',4,b_top_stack,n_top_stack);
+build_in('type$ ',5,b_type,n_type);
+build_in('warning$ ',8,b_warning,n_warning);
+build_in('width$ ',6,b_width,n_width);
+build_in('while$ ',6,b_while,n_while);
+build_in('width$ ',6,b_width,n_width);
+build_in('write$ ',6,b_write,n_write);
+
+
+@
+This procedure inserts a |built_in| function into the hash table and
+initializes the corresponding pre-defined string (of length at most
+|longest_pds|). The array |fn_info| contains a number from 0 through
+the number of |built_in| functions minus 1 (i.e., |num_blt_in_fns - 1|
+if we're keeping statistics); this number is used by a |case|
+statement to execute this function and is used for keeping execution
+counts when keeping statistics.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+procedure build_in (@!pds:pds_type; @!len:pds_len; var fn_hash_loc:hash_loc;
+ @!blt_in_num:blt_in_range);
+begin
+pre_define (pds,len,bst_fn_ilk);@/
+fn_hash_loc := pre_def_loc; {the |pre_define| routine sets |pre_def_loc|}
+fn_type[fn_hash_loc] := built_in;
+fn_info[fn_hash_loc] := blt_in_num;
+ stat
+ blt_in_loc[blt_in_num] := fn_hash_loc;@/
+ execution_count[blt_in_num] := 0; {initialize the function-execution count}
+ tats@/
+end;
+
+
+@
+This is a procedure so that |initialize| is smaller.
+
+@<Procedures and functions for handling numbers, characters, and strings@>=
+procedure pre_def_certain_strings;
+begin
+@<Pre-define certain strings@>@;
+end;
+
+
+@
+These variables all begin with |s_| and specify the locations in
+|str_pool| of certain often-used strings that the \.{.bst} commands
+need. The |s_preamble| array is big enough to allow an average of one
+\.{preamble\$} command per \.{.bib} file.
+
+@<Globals in the outer block@>=
+@!s_null : str_number; {the null string}
+@!s_default : str_number; {\.{default.type}, for unknown entry types}
+@!s_t : str_number; {\.{t}, for |title_lowers| case conversion}
+@!s_l : str_number; {\.{l}, for |all_lowers| case conversion}
+@!s_u : str_number; {\.{u}, for |all_uppers| case conversion}
+@!s_preamble : array[bib_number] of str_number;
+ {for the \.{preamble\$} |built_in| function}
+
+
+@
+These constants all begin with |n_| and are used for the |case|
+statement that determines which, if any, control sequence we're
+dealing with; a control sequence of interest will be either one of the
+undotted characters `\.{\\i}' or `\.{\\j}' or one of the foreign
+characters in Table~3.2 of the \LaTeX\ manual.
+
+@d n_i = 0 {\.{i}, for the undotted character \.{\\i}}
+@d n_j = 1 {\.{j}, for the undotted character \.{\\j}}
+@d n_oe = 2 {\.{oe}, for the foreign character \.{\\oe}}
+@d n_oe_upper = 3 {\.{OE}, for the foreign character \.{\\OE}}
+@d n_ae = 4 {\.{ae}, for the foreign character \.{\\ae}}
+@d n_ae_upper = 5 {\.{AE}, for the foreign character \.{\\AE}}
+@d n_aa = 6 {\.{aa}, for the foreign character \.{\\aa}}
+@d n_aa_upper = 7 {\.{AA}, for the foreign character \.{\\AA}}
+@d n_o = 8 {\.{o}, for the foreign character \.{\\o}}
+@d n_o_upper = 9 {\.{O}, for the foreign character \.{\\O}}
+@d n_l = 10 {\.{l}, for the foreign character \.{\\l}}
+@d n_l_upper = 11 {\.{L}, for the foreign character \.{\\L}}
+@d n_ss = 12 {\.{ss}, for the foreign character \.{\\ss}}
+
+
+@
+@^important note@>
+@.default.type@>
+Here we pre-define a few strings used in executing the \.{.bst} file:
+the null string, which is sometimes pushed onto the stack; a string
+used for default entry types; and some control sequences used to spot
+foreign characters. We also initialize the |s_preamble| array to
+empty. These pre-defined strings must all be exactly |longest_pds|
+characters long.
+
+Important note: These pre-definitions must not have any glitches or
+the program may bomb because the |log_file| hasn't been opened yet,
+and |text_ilk|s should be pre-defined here, not earlier, for
+\.{.bst}-function-execution purposes.
+
+@<Pre-define certain strings@>=
+pre_define(' ',0,text_ilk); s_null := hash_text[pre_def_loc];
+fn_type[pre_def_loc] := str_literal;@/
+pre_define('default.type',12,text_ilk); s_default := hash_text[pre_def_loc];
+fn_type[pre_def_loc] := str_literal;@/
+b_default := b_skip; {this may be changed to the \.{default.type} function}
+preamble_ptr := 0; {initialize the |s_preamble| array}
+pre_define('i ',1,control_seq_ilk);
+ilk_info[pre_def_loc] := n_i;
+pre_define('j ',1,control_seq_ilk);
+ilk_info[pre_def_loc] := n_j;
+pre_define('oe ',2,control_seq_ilk);
+ilk_info[pre_def_loc] := n_oe;
+pre_define('OE ',2,control_seq_ilk);
+ilk_info[pre_def_loc] := n_oe_upper;
+pre_define('ae ',2,control_seq_ilk);
+ilk_info[pre_def_loc] := n_ae;
+pre_define('AE ',2,control_seq_ilk);
+ilk_info[pre_def_loc] := n_ae_upper;
+pre_define('aa ',2,control_seq_ilk);
+ilk_info[pre_def_loc] := n_aa;
+pre_define('AA ',2,control_seq_ilk);
+ilk_info[pre_def_loc] := n_aa_upper;
+pre_define('o ',1,control_seq_ilk);
+ilk_info[pre_def_loc] := n_o;
+pre_define('O ',1,control_seq_ilk);
+ilk_info[pre_def_loc] := n_o_upper;
+pre_define('l ',1,control_seq_ilk);
+ilk_info[pre_def_loc] := n_l;
+pre_define('L ',1,control_seq_ilk);
+ilk_info[pre_def_loc] := n_l_upper;
+pre_define('ss ',2,control_seq_ilk);
+ilk_info[pre_def_loc] := n_ss;
+
+
+@
+@^important note@>
+@.crossref@>
+@.entry.max\$@>
+@.global.max\$@>
+@.sort.key\$@>
+Now we pre-define any built-in |field|s, |str_entry_var|s, and
+|int_global_var|s; these strings must all be exactly |longest_pds|
+characters long. Note that although these are built-in functions, we
+classify them (in the |fn_type| array) otherwise.
+
+Important note: These pre-definitions must not have any glitches or
+the program may bomb because the |log_file| hasn't been opened yet.
+
+@<Pre-define certain strings@>=
+pre_define('crossref ',8,bst_fn_ilk);
+fn_type[pre_def_loc] := field;@/
+fn_info[pre_def_loc] := num_fields; {give this |field| a number}
+crossref_num := num_fields;
+incr(num_fields);@/
+num_pre_defined_fields := num_fields; {that's it for pre-defined |field|s}
+pre_define('sort.key$ ',9,bst_fn_ilk);
+fn_type[pre_def_loc] := str_entry_var;
+fn_info[pre_def_loc] := num_ent_strs; {give this |str_entry_var| a number}
+sort_key_num := num_ent_strs;
+incr(num_ent_strs);@/
+pre_define('entry.max$ ',10,bst_fn_ilk);
+fn_type[pre_def_loc] := int_global_var;
+fn_info[pre_def_loc] := ent_str_size; {initialize this |int_global_var|}
+pre_define('global.max$ ',11,bst_fn_ilk);
+fn_type[pre_def_loc] := int_global_var;
+fn_info[pre_def_loc] := glob_str_size; {initialize this |int_global_var|}
+
+
+@
+@^add a built-in function@>
+@:this can't happen}{\quad Unknown built-in function@>
+This module branches to the code for the appropriate |built_in|
+function. Only three---{\.{call.type\$}}, {\.{if\$}}, and
+{\.{while\$}}---do a recursive call.
+
+@<Execute a |built_in| function@>=
+begin
+ stat {update this function's execution count}
+ incr(execution_count[fn_info[ex_fn_loc]]);
+ tats@/
+case (fn_info[ex_fn_loc]) of
+ n_equals : x_equals;
+ n_greater_than : x_greater_than;
+ n_less_than : x_less_than;
+ n_plus : x_plus;
+ n_minus : x_minus;
+ n_concatenate : x_concatenate;
+ n_gets : x_gets;
+ n_add_period : x_add_period;
+ n_call_type : @<|execute_fn|({\.{call.type\$}})@>;
+ n_change_case : x_change_case;
+ n_chr_to_int : x_chr_to_int;
+ n_cite : x_cite;
+ n_duplicate : x_duplicate;
+ n_empty : x_empty;
+ n_format_name : x_format_name;
+ n_if : @<|execute_fn|({\.{if\$}})@>;
+ n_int_to_chr : x_int_to_chr;
+ n_int_to_str : x_int_to_str;
+ n_missing : x_missing;
+ n_newline : @<|execute_fn|({\.{newline\$}})@>;
+ n_num_names : x_num_names;
+ n_pop : @<|execute_fn|({\.{pop\$}})@>;
+ n_preamble : x_preamble;
+ n_purify : x_purify;
+ n_quote : x_quote;
+ n_skip : @<|execute_fn|({\.{skip\$}})@>;
+ n_stack : @<|execute_fn|({\.{stack\$}})@>;
+ n_substring : x_substring;
+ n_swap : x_swap;
+ n_text_length : x_text_length;
+ n_text_prefix : x_text_prefix;
+ n_top_stack : @<|execute_fn|({\.{top\$}})@>;
+ n_type : x_type;
+ n_warning : x_warning;
+ n_while : @<|execute_fn|({\.{while\$}})@>;
+ n_width : x_width;
+ n_write : x_write;
+ othercases confusion ('Unknown built-in function')
+endcases;
+end
+
+
+@
+@^add a built-in function@>
+@^gymnastics@>
+This extra level of module-pointing allows a uniformity of module
+names for the |built_in| functions, regardless of whether they do a
+recursive call to |execute_fn| or are trivial (a single statement).
+Those that do a recursive call are left as part of |execute_fn|,
+avoiding \PASCAL's forward procedure mechanism, and those that don't
+(except for the single-statement ones) are made into procedures so
+that |execute_fn| doesn't get too large.
+
+@<Procedures and functions for style-file function execution@>=
+@<|execute_fn|({\.{=}})@>@;
+@<|execute_fn|({\.{>}})@>@;
+@<|execute_fn|({\.{<}})@>@;
+@<|execute_fn|({\.{+}})@>@;
+@<|execute_fn|({\.{-}})@>@;
+@<|execute_fn|({\.{*}})@>@;
+@<|execute_fn|({\.{:=}})@>@;
+@<|execute_fn|({\.{add.period\$}})@>@;
+@<|execute_fn|({\.{change.case\$}})@>@;
+@<|execute_fn|({\.{chr.to.int\$}})@>@;
+@<|execute_fn|({\.{cite\$}})@>@;
+@<|execute_fn|({\.{duplicate\$}})@>@;
+@<|execute_fn|({\.{empty\$}})@>@;
+@<|execute_fn|({\.{format.name\$}})@>@;
+@<|execute_fn|({\.{int.to.chr\$}})@>@;
+@<|execute_fn|({\.{int.to.str\$}})@>@;
+@<|execute_fn|({\.{missing\$}})@>@;
+@<|execute_fn|({\.{num.names\$}})@>@;
+@<|execute_fn|({\.{preamble\$}})@>@;
+@<|execute_fn|({\.{purify\$}})@>@;
+@<|execute_fn|({\.{quote\$}})@>@;
+@<|execute_fn|({\.{substring\$}})@>@;
+@<|execute_fn|({\.{swap\$}})@>@;
+@<|execute_fn|({\.{text.length\$}})@>@;
+@<|execute_fn|({\.{text.prefix\$}})@>@;
+@<|execute_fn|({\.{type\$}})@>@;
+@<|execute_fn|({\.{warning\$}})@>@;
+@<|execute_fn|({\.{width\$}})@>@;
+@<|execute_fn|({\.{write\$}})@>@;
+@<|execute_fn| itself@>
+
+
+@
+Now it's time to declare some things for executing |built_in|
+functions only. These (and only these) variables are used
+recursively, so they can't be global.
+
+@d end_while = 51 {stop executing the \.{while\$} function}
+
+@<Declarations for executing |built_in| functions@>=
+label end_while;
+var r_pop_lt1,@!r_pop_lt2 : integer; {stack literals for \.{while\$}}
+@!r_pop_tp1,@!r_pop_tp2 : stk_type; {stack types for \.{while\$}}
+
+
+@
+These are nonrecursive variables that |execute_fn| uses. Declaring
+them here (instead of in the previous module) saves execution time and
+stack space on most machines.
+
+@d name_buf == sv_buffer {an alias, a buffer for manipulating names}
+
+@<Globals in the outer block@>=
+@!pop_lit1,@!pop_lit2,@!pop_lit3 : integer; {stack literals}
+@!pop_typ1,@!pop_typ2,@!pop_typ3 : stk_type; {stack types}
+@!sp_ptr : pool_pointer; {for manipulating |str_pool| strings}
+@!sp_xptr1,@!sp_xptr2 : pool_pointer; {more of the same}
+@!sp_end : pool_pointer; {marks the end of a |str_pool| string}
+@!sp_length,sp2_length : pool_pointer; {lengths of |str_pool| strings}
+@!sp_brace_level : integer; {for scanning |str_pool| strings}
+@!ex_buf_xptr,@!ex_buf_yptr : buf_pointer; {extra |ex_buf| locations}
+@!control_seq_loc : hash_loc; {hash-table loc of a control sequence}
+@!preceding_white : boolean; {used in scanning strings}
+@!and_found : boolean; {to stop the loop that looks for an ``and''}
+@!num_names : integer; {for counting names}
+@!name_bf_ptr : buf_pointer; {general |name_buf| location}
+@!name_bf_xptr,@!name_bf_yptr : buf_pointer; {and two more}
+@!nm_brace_level : integer; {for scanning |name_buf| strings}
+@!name_tok : packed array[buf_pointer] of buf_pointer; {name-token ptr list}
+@!name_sep_char : packed array[buf_pointer] of ASCII_code; {token-ending chars}
+@!num_tokens : buf_pointer; {this counts name tokens}
+@!token_starting : boolean; {used in scanning name tokens}
+@!alpha_found : boolean; {used in scanning the format string}
+@!double_letter,@!end_of_group,@!to_be_written : boolean; {the same}
+@!first_start : buf_pointer; {start-ptr into |name_tok| for the first name}
+@!first_end : buf_pointer; {end-ptr into |name_tok| for the first name}
+@!last_end : buf_pointer; {end-ptr into |name_tok| for the last name}
+@!von_start : buf_pointer; {start-ptr into |name_tok| for the von name}
+@!von_end : buf_pointer; {end-ptr into |name_tok| for the von name}
+@!jr_end : buf_pointer; {end-ptr into |name_tok| for the jr name}
+@!cur_token,@!last_token : buf_pointer; {|name_tok| ptrs for outputting tokens}
+@!use_default : boolean; {for the inter-token intra-name part string}
+@!num_commas : buf_pointer; {used to determine the name syntax}
+@!comma1,@!comma2 : buf_pointer; {ptrs into |name_tok|}
+@!num_text_chars : buf_pointer; {special characters count as one}
+
+
+@
+The |built_in| function {\.{=}} pops the top two (integer or string)
+literals, compares them, and pushes the integer 1 if they're equal, 0
+otherwise. If they're not either both string or both integer, it
+complains and pushes the integer 0.
+
+@<|execute_fn|({\.{=}})@>=
+procedure x_equals;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if (pop_typ1 <> pop_typ2) then
+ begin
+ if ((pop_typ1 <> stk_empty) and (pop_typ2 <> stk_empty)) then
+ begin
+ print_stk_lit (pop_lit1,pop_typ1);
+ print (', ');
+ print_stk_lit (pop_lit2,pop_typ2);
+ print_newline;
+ bst_ex_warn ('---they aren''t the same literal types');
+ end;
+ push_lit_stk (0, stk_int);
+ end
+else if ((pop_typ1 <> stk_int) and (pop_typ1 <> stk_str)) then
+ begin
+ if (pop_typ1 <> stk_empty) then
+ begin
+ print_stk_lit (pop_lit1,pop_typ1);
+ bst_ex_warn (', not an integer or a string,');
+ end;
+ push_lit_stk (0, stk_int);
+ end
+else if (pop_typ1 = stk_int) then
+ if (pop_lit2 = pop_lit1) then
+ push_lit_stk (1, stk_int)
+ else
+ push_lit_stk (0, stk_int)
+else
+ if (str_eq_str (pop_lit2,pop_lit1)) then
+ push_lit_stk (1, stk_int)
+ else
+ push_lit_stk (0, stk_int);
+end;
+
+
+@
+The |built_in| function {\.{>}} pops the top two (integer) literals,
+compares them, and pushes the integer 1 if the second is greater than
+the first, 0 otherwise. If either isn't an integer literal, it
+complains and pushes the integer 0.
+
+@<|execute_fn|({\.{>}})@>=
+procedure x_greater_than;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (0, stk_int);
+ end
+else if (pop_typ2 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_int);
+ push_lit_stk (0, stk_int);
+ end
+else
+ if (pop_lit2 > pop_lit1) then
+ push_lit_stk (1, stk_int)
+ else
+ push_lit_stk (0, stk_int);
+end;
+
+
+@
+The |built_in| function {\.{<}} pops the top two (integer) literals,
+compares them, and pushes the integer 1 if the second is less than the
+first, 0 otherwise. If either isn't an integer literal, it complains
+and pushes the integer 0.
+
+@<|execute_fn|({\.{<}})@>=
+procedure x_less_than;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (0, stk_int);
+ end
+else if (pop_typ2 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_int);
+ push_lit_stk (0, stk_int);
+ end
+else
+ if (pop_lit2 < pop_lit1) then
+ push_lit_stk (1, stk_int)
+ else
+ push_lit_stk (0, stk_int);
+end;
+
+
+@
+The |built_in| function {\.{+}} pops the top two (integer) literals
+and pushes their sum. If either isn't an integer literal, it
+complains and pushes the integer 0.
+
+@<|execute_fn|({\.{+}})@>=
+procedure x_plus;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (0, stk_int);
+ end
+else if (pop_typ2 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_int);
+ push_lit_stk (0, stk_int);
+ end
+else
+ push_lit_stk (pop_lit2+pop_lit1, stk_int);
+end;
+
+
+@
+The |built_in| function {\.{-}} pops the top two (integer) literals
+and pushes their difference (the first subtracted from the second).
+If either isn't an integer literal, it complains and pushes the
+integer 0.
+
+@<|execute_fn|({\.{-}})@>=
+procedure x_minus;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (0, stk_int);
+ end
+else if (pop_typ2 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_int);
+ push_lit_stk (0, stk_int);
+ end
+else
+ push_lit_stk (pop_lit2-pop_lit1, stk_int);
+end;
+
+
+@
+The |built_in| function {\.{*}} pops the top two (string) literals,
+concatenates them (in reverse order, that is, the order in which
+pushed), and pushes the resulting string back onto the stack. If
+either isn't a string literal, it complains and pushes the null
+string.
+
+@<|execute_fn|({\.{*}})@>=
+procedure x_concatenate;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if (pop_typ1 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else if (pop_typ2 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ @<Concatenate the two strings and push@>;
+end;
+
+
+@
+@^push the literal stack@>
+Often both strings will be at the top of the string pool, in which
+case we just move some pointers. Furthermore, it's worth doing some
+special stuff in case either string is null, since empirically this
+seems to happen about $20\%$ of the time. In any case, we don't need
+the execution buffer---we simple move the strings around in the string
+pool when necessary.
+
+@<Concatenate the two strings and push@>=
+begin
+if (pop_lit2 >= cmd_str_ptr) then
+ if (pop_lit1 >= cmd_str_ptr) then
+ begin
+ str_start[pop_lit1] := str_start[pop_lit1+1];
+ unflush_string;
+ incr(lit_stk_ptr);
+ end
+ else if (length(pop_lit2) = 0) then
+ push_lit_stk (pop_lit1, stk_str)
+ else {|pop_lit2| is nonnull, only |pop_lit1| is below |cmd_str_ptr|}
+ begin
+ pool_ptr := str_start[pop_lit2+1];
+ str_room (length(pop_lit1));
+ sp_ptr := str_start[pop_lit1];
+ sp_end := str_start[pop_lit1+1];
+ while (sp_ptr < sp_end) do
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+ push_lit_stk (make_string, stk_str); {and push it onto the stack}
+ end
+else
+ @<Concatenate them and push when |pop_lit2 < cmd_str_ptr|@>;
+end
+
+
+@
+@^push the literal stack@>
+We simply continue the previous module.
+
+@<Concatenate them and push when |pop_lit2 < cmd_str_ptr|@>=
+begin
+if (pop_lit1 >= cmd_str_ptr) then
+ if (length(pop_lit2) = 0) then
+ begin
+ unflush_string;
+ lit_stack[lit_stk_ptr] := pop_lit1;
+ incr(lit_stk_ptr);
+ end
+ else if (length(pop_lit1) = 0) then
+ incr(lit_stk_ptr)
+ else {both strings nonnull, only |pop_lit2| is below |cmd_str_ptr|}
+ begin
+ sp_length := length(pop_lit1);
+ sp2_length := length(pop_lit2);
+ str_room (sp_length + sp2_length);
+ sp_ptr := str_start[pop_lit1+1];
+ sp_end := str_start[pop_lit1];
+ sp_xptr1 := sp_ptr + sp2_length;
+ while (sp_ptr > sp_end) do {slide up |pop_lit1|}
+ begin
+ decr(sp_ptr);
+ decr(sp_xptr1);
+ str_pool[sp_xptr1] := str_pool[sp_ptr];
+ end;
+ sp_ptr := str_start[pop_lit2];
+ sp_end := str_start[pop_lit2+1];
+ while (sp_ptr < sp_end) do {slide up |pop_lit2|}
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+ pool_ptr := pool_ptr + sp_length;
+ push_lit_stk (make_string, stk_str); {and push it onto the stack}
+ end
+else
+ @<Concatenate them and push when |pop_lit1,pop_lit2 < cmd_str_ptr|@>;
+end
+
+
+@
+@^push the literal stack@>
+Again, we simply continue the previous module.
+
+@<Concatenate them and push when |pop_lit1,pop_lit2 < cmd_str_ptr|@>=
+begin
+if (length(pop_lit1) = 0) then
+ incr(lit_stk_ptr)
+else if (length(pop_lit2) = 0) then
+ push_lit_stk (pop_lit1, stk_str)
+else {both strings are nonnull, and both are below |cmd_str_ptr|}
+ begin
+ str_room (length(pop_lit1) + length(pop_lit2));
+ sp_ptr := str_start[pop_lit2];
+ sp_end := str_start[pop_lit2+1];
+ while (sp_ptr < sp_end) do {slide up |pop_lit2|}
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+ sp_ptr := str_start[pop_lit1];
+ sp_end := str_start[pop_lit1+1];
+ while (sp_ptr < sp_end) do {slide up |pop_lit1|}
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+ push_lit_stk (make_string, stk_str); {and push it onto the stack}
+ end;
+end
+
+
+@
+The |built_in| function {\.{:=}} pops the top two literals and assigns
+to the first (which must be an |int_entry_var|, a |str_entry_var|, an
+|int_global_var|, or a |str_global_var|) the value of the second;
+it complains if the value isn't of the appropriate type.
+
+@<|execute_fn|({\.{:=}})@>=
+procedure x_gets;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if (pop_typ1 <> stk_fn) then
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_fn)
+else if ((not mess_with_entries) and
+ ((fn_type[pop_lit1] = str_entry_var) or
+ (fn_type[pop_lit1] = int_entry_var))) then
+ bst_cant_mess_with_entries_print
+else
+ case (fn_type[pop_lit1]) of
+ int_entry_var : @<Assign to an |int_entry_var|@>;
+ str_entry_var : @<Assign to a |str_entry_var|@>;
+ int_global_var : @<Assign to an |int_global_var|@>;
+ str_global_var : @<Assign to a |str_global_var|@>;
+ othercases begin
+ print ('You can''t assign to type ');
+ print_fn_class (pop_lit1);
+ bst_ex_warn (', a nonvariable function class');
+ end
+ endcases;
+end;
+
+
+@
+This module checks that what we're about to assign is really an
+integer, and then assigns.
+
+@<Assign to an |int_entry_var|@>=
+if (pop_typ2 <> stk_int) then
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_int)
+ else
+ entry_ints[cite_ptr*num_ent_ints+fn_info[pop_lit1]] := pop_lit2
+
+
+@
+@.String size exceeded@>
+It's time for a complaint if either of the two (entry or global)
+string lengths is exceeded.
+
+@d bst_string_size_exceeded(#) == begin
+ bst_1print_string_size_exceeded;
+ print (#);
+ bst_2print_string_size_exceeded;
+ end
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure bst_1print_string_size_exceeded;
+begin
+print ('Warning--you''ve exceeded ');
+end;
+@#
+procedure bst_2print_string_size_exceeded;
+begin
+print ('-string-size,');
+bst_mild_ex_warn_print;
+print_ln ('*Please notify the bibstyle designer*');
+end;
+
+
+@
+@.entry string size exceeded@>
+@:String size exceeded}{\quad entry string size@>
+This module checks that what we're about to assign is really a
+string, and then assigns.
+
+@<Assign to a |str_entry_var|@>=
+begin
+if (pop_typ2 <> stk_str) then
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_str)
+ else
+ begin
+ str_ent_ptr := cite_ptr*num_ent_strs + fn_info[pop_lit1];
+ ent_chr_ptr := 0;
+ sp_ptr := str_start[pop_lit2];
+ sp_xptr1 := str_start[pop_lit2+1];
+ if (sp_xptr1-sp_ptr > ent_str_size) then
+ begin
+ bst_string_size_exceeded (ent_str_size:0,', the entry');
+ sp_xptr1 := sp_ptr + ent_str_size;
+ end;
+ while (sp_ptr < sp_xptr1) do
+ begin {copy characters into |entry_strs|}
+ entry_strs[str_ent_ptr][ent_chr_ptr] := str_pool[sp_ptr];
+ incr(ent_chr_ptr);
+ incr(sp_ptr);
+ end;
+ entry_strs[str_ent_ptr][ent_chr_ptr] := end_of_string;
+ end
+end
+
+
+@
+This module checks that what we're about to assign is really an
+integer, and then assigns.
+
+@<Assign to an |int_global_var|@>=
+if (pop_typ2 <> stk_int) then
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_int)
+ else
+ fn_info[pop_lit1] := pop_lit2
+
+
+@
+@.global string size exceeded@>
+@:String size exceeded}{\quad global string size@>
+This module checks that what we're about to assign is really a
+string, and then assigns.
+
+@<Assign to a |str_global_var|@>=
+begin
+if (pop_typ2 <> stk_str) then
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_str)
+ else
+ begin
+ str_glb_ptr := fn_info[pop_lit1];
+ if (pop_lit2 < cmd_str_ptr) then
+ glb_str_ptr[str_glb_ptr] := pop_lit2
+ else
+ begin
+ glb_str_ptr[str_glb_ptr] := 0;
+ glob_chr_ptr := 0;
+ sp_ptr := str_start[pop_lit2];
+ sp_end := str_start[pop_lit2+1];
+ if (sp_end - sp_ptr > glob_str_size) then
+ begin
+ bst_string_size_exceeded (glob_str_size:0,', the global');
+ sp_end := sp_ptr + glob_str_size;
+ end;
+ while (sp_ptr < sp_end) do
+ begin {copy characters into |global_strs|}
+ global_strs[str_glb_ptr][glob_chr_ptr] := str_pool[sp_ptr];
+ incr(glob_chr_ptr);
+ incr(sp_ptr);
+ end;
+ glb_str_end[str_glb_ptr] := glob_chr_ptr;
+ end;
+ end
+end
+
+
+@
+The |built_in| function {\.{add.period\$}} pops the top (string)
+literal, adds a |period| to a nonnull string if its last
+non|right_brace| character isn't a |period|, |question_mark|, or
+|exclamation_mark|, and pushes this resulting string back onto the
+stack. If the literal isn't a string, it complains and pushes the
+null string.
+
+@<|execute_fn|({\.{add.period\$}})@>=
+procedure x_add_period;
+label loop_exit;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else if (length(pop_lit1) = 0) then {don't add |period| to the null string}
+ push_lit_stk (s_null, stk_str)
+else
+ @<Add the |period|, if necessary, and push@>;
+end;
+
+
+@
+@^push the literal stack@>
+Here we scan backwards from the end of the string, skipping
+non|right_brace| characters, to see if we have to add the |period|.
+
+@<Add the |period|, if necessary, and push@>=
+begin
+sp_ptr := str_start[pop_lit1+1];
+sp_end := str_start[pop_lit1];
+while (sp_ptr > sp_end) do {find a non|right_brace|}
+ begin
+ decr(sp_ptr);
+ if (str_pool[sp_ptr] <> right_brace) then
+ goto loop_exit;
+ end;
+loop_exit:
+case (str_pool[sp_ptr]) of
+ period,
+ question_mark,
+ exclamation_mark :
+ repush_string;
+ othercases
+ @<Add the |period| (it's necessary) and push@>
+endcases;
+end
+
+
+@
+Ok guys, we really have to do it.
+
+@<Add the |period| (it's necessary) and push@>=
+begin
+if (pop_lit1 < cmd_str_ptr) then
+ begin
+ str_room (length(pop_lit1)+1);
+ sp_ptr := str_start[pop_lit1];
+ sp_end := str_start[pop_lit1+1];
+ while (sp_ptr < sp_end) do {slide |pop_lit1| atop the string pool}
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+ end
+else {the string is already there}
+ begin
+ pool_ptr := str_start[pop_lit1+1];
+ str_room (1);
+ end;
+append_char (period);
+push_lit_stk (make_string, stk_str);
+end
+
+
+@
+The |built_in| function {\.{call.type\$}} executes the function
+specified in |type_list| for this entry unless it's |undefined|, in
+which case it executes the default function \.{default.type} defined
+in the \.{.bst} file, or unless it's |empty|, in which case it does
+nothing.
+
+@<|execute_fn|({\.{call.type\$}})@>=
+begin
+if (not mess_with_entries) then
+ bst_cant_mess_with_entries_print
+ else
+ if (type_list[cite_ptr] = undefined) then
+ execute_fn (b_default)
+ else if (type_list[cite_ptr] = empty) then
+ do_nothing
+ else
+ execute_fn (type_list[cite_ptr]);
+end
+
+
+@
+The |built_in| function {\.{change.case\$}} pops the top two (string)
+literals; it changes the case of the second according to the
+specifications of the first, as follows. (Note: The word `letters' in
+the next sentence refers only to those at brace-level~0, the top-most
+brace level; no other characters are changed, except perhaps for
+special characters, described shortly.) If the first literal is the
+string~\.{t}, it converts to lower case all letters except the very
+first character in the string, which it leaves alone, and except the
+first character following any |colon| and then nonnull |white_space|,
+which it also leaves alone; if it's the string~\.{l}, it converts all
+letters to lower case; if it's the string~\.{u}, it converts all
+letters to upper case; and if it's anything else, it complains and
+does no conversion. It then pushes this resulting string. If either
+type is incorrect, it complains and pushes the null string; however,
+if both types are correct but the specification string (i.e., the
+first string) isn't one of the legal ones, it merely pushes the second
+back onto the stack, after complaining. (Another note: It ignores
+case differences in the specification string; for example, the strings
+\.{t} and \.{T} are equivalent for the purposes of this |built_in|
+function.)
+
+@d ok_pascal_i_give_up = 21
+
+@<|execute_fn|({\.{change.case\$}})@>=
+procedure x_change_case;
+label ok_pascal_i_give_up;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if (pop_typ1 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else if (pop_typ2 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ begin
+ @<Determine the case-conversion type@>;
+ ex_buf_length := 0;
+ add_buf_pool (pop_lit2);
+ @<Perform the case conversion@>;
+ add_pool_buf_and_push; {push this string onto the stack}
+ end;
+end;
+
+
+@
+First we define a few variables for case conversion. The constant
+definitions, to be used in |case| statements, are in order of probable
+frequency.
+
+@d title_lowers = 0 {representing the string \.{t}}
+@d all_lowers = 1 {representing the string \.{l}}
+@d all_uppers = 2 {representing the string \.{u}}
+@d bad_conversion = 3 {representing any illegal case-conversion string}
+
+@<Globals in the outer block@>=
+@!conversion_type : 0..bad_conversion; {the possible cases}
+@!prev_colon : boolean; {|true| if just past a |colon|}
+
+
+@
+Now we determine which of the three case-conversion types we're
+dealing with: \.{t},~\.{l}, or~\.{u}.
+
+@<Determine the case-conversion type@>=
+begin
+case (str_pool[str_start[pop_lit1]]) of
+ "t","T" : conversion_type := title_lowers;
+ "l","L" : conversion_type := all_lowers;
+ "u","U" : conversion_type := all_uppers;
+ othercases conversion_type := bad_conversion
+endcases;
+if ((length(pop_lit1) <> 1) or (conversion_type = bad_conversion)) then
+ begin
+ conversion_type := bad_conversion;
+ print_pool_str (pop_lit1);
+ bst_ex_warn (' is an illegal case-conversion string');
+ end;
+end
+
+
+@
+This procedure complains if the just-encountered |right_brace| would
+make |brace_level| negative.
+
+@<Procedures and functions for name-string processing@>=
+procedure decr_brace_level (@!pop_lit_var : str_number);
+begin
+if (brace_level = 0) then
+ braces_unbalanced_complaint (pop_lit_var)
+ else
+ decr(brace_level);
+end;
+
+
+@
+This complaint often arises because the style designer has to type
+lots of braces.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure braces_unbalanced_complaint (@!pop_lit_var : str_number);
+begin
+print ('Warning--"');
+print_pool_str (pop_lit_var);
+bst_mild_ex_warn ('" isn''t a brace-balanced string');
+end;
+
+
+@
+This one makes sure that |brace_level=0| (it's called at a point in a
+string where braces must be balanced).
+
+@<Procedures and functions for name-string processing@>=
+procedure check_brace_level (@!pop_lit_var : str_number);
+begin
+if (brace_level > 0) then
+ braces_unbalanced_complaint (pop_lit_var);
+end;
+
+
+@
+Here's where we actually go through the string and do the case
+conversion.
+
+@<Perform the case conversion@>=
+begin
+brace_level := 0; {this is the top level}
+ex_buf_ptr := 0; {we start with the string's first character}
+while (ex_buf_ptr < ex_buf_length) do
+ begin
+ if (ex_buf[ex_buf_ptr] = left_brace) then
+ begin
+ incr(brace_level);
+ if (brace_level <> 1) then
+ goto ok_pascal_i_give_up;
+ if (ex_buf_ptr + 4 > ex_buf_length) then
+ goto ok_pascal_i_give_up
+ else if (ex_buf[ex_buf_ptr+1] <> backslash) then
+ goto ok_pascal_i_give_up;
+ if (conversion_type = title_lowers) then
+ if (ex_buf_ptr = 0) then
+ goto ok_pascal_i_give_up
+ else if ((prev_colon) and
+ (lex_class[ex_buf[ex_buf_ptr-1]] = white_space)) then
+ goto ok_pascal_i_give_up;
+ @<Convert a special character@>;
+ok_pascal_i_give_up:
+ prev_colon := false;
+ end
+ else if (ex_buf[ex_buf_ptr] = right_brace) then
+ begin
+ decr_brace_level (pop_lit2);
+ prev_colon := false;
+ end
+ else
+ if (brace_level = 0) then
+ @<Convert a |brace_level = 0| character@>;
+ incr(ex_buf_ptr);
+ end;
+check_brace_level (pop_lit2);
+end
+
+
+@
+@^special character@>
+We're dealing with a special character (usually either an undotted
+`\i' or `\j', or an accent like one in Table~3.1 of the \LaTeX\
+manual, or a foreign character like one in Table~3.2) if the first
+character after the |left_brace| is a |backslash|; the special
+character ends with the matching |right_brace|. How we handle what's
+in between depends on the special character. In general, this code
+will do reasonably well if there is other stuff, too, between braces,
+but it doesn't try to do anything special with |colon|s.
+
+@<Convert a special character@>=
+begin
+incr(ex_buf_ptr); {skip over the |left_brace|}
+while ((ex_buf_ptr < ex_buf_length) and (brace_level > 0)) do
+ begin
+ incr(ex_buf_ptr); {skip over the |backslash|}
+ ex_buf_xptr := ex_buf_ptr;
+ while ((ex_buf_ptr < ex_buf_length) and
+ (lex_class[ex_buf[ex_buf_ptr]] = alpha)) do
+ incr(ex_buf_ptr); {this scans the control sequence}
+ control_seq_loc := str_lookup(ex_buf,ex_buf_xptr,ex_buf_ptr-ex_buf_xptr,
+ control_seq_ilk,dont_insert);
+ if (hash_found) then
+ @<Convert the accented or foreign character, if necessary@>;
+ ex_buf_xptr := ex_buf_ptr;
+ while ((ex_buf_ptr < ex_buf_length) and (brace_level > 0) and
+ (ex_buf[ex_buf_ptr] <> backslash)) do
+ begin {this scans to the next control sequence}
+ if (ex_buf[ex_buf_ptr] = right_brace) then
+ decr(brace_level)
+ else if (ex_buf[ex_buf_ptr] = left_brace) then
+ incr(brace_level);
+ incr(ex_buf_ptr);
+ end;
+ @<Convert a noncontrol sequence@>;
+ end;
+decr(ex_buf_ptr); {unskip the |right_brace|}
+end
+
+
+@
+@^control sequence@>
+@:this can't happen}{\quad Unknown type of case conversion@>
+A control sequence, for the purposes of this program, consists just of
+the consecutive alphabetic characters following the |backslash|; it
+might be empty (although ones in this section aren't).
+
+@<Convert the accented or foreign character, if necessary@>=
+begin
+case (conversion_type) of
+ title_lowers,
+ all_lowers :
+ case (ilk_info[control_seq_loc]) of
+ n_l_upper,
+ n_o_upper,
+ n_oe_upper,
+ n_ae_upper,
+ n_aa_upper :
+ lower_case (ex_buf, ex_buf_xptr, ex_buf_ptr-ex_buf_xptr);
+ othercases
+ do_nothing
+ endcases;
+ all_uppers :
+ case (ilk_info[control_seq_loc]) of
+ n_l,
+ n_o,
+ n_oe,
+ n_ae,
+ n_aa :
+ upper_case (ex_buf, ex_buf_xptr, ex_buf_ptr-ex_buf_xptr);
+ n_i,
+ n_j,
+ n_ss :
+ @<Convert, then remove the control sequence@>;
+ othercases
+ do_nothing
+ endcases;
+ bad_conversion :
+ do_nothing;
+ othercases
+ case_conversion_confusion
+endcases;
+end
+
+
+@
+@:this can't happen}{\quad Unknown type of case conversion@>
+Another bug complaint.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure case_conversion_confusion;
+begin
+confusion ('Unknown type of case conversion');
+end;
+
+
+@
+After converting the control sequence, we need to remove the preceding
+|backslash| and any following |white_space|.
+
+@<Convert, then remove the control sequence@>=
+begin
+upper_case (ex_buf, ex_buf_xptr, ex_buf_ptr-ex_buf_xptr);
+while (ex_buf_xptr < ex_buf_ptr) do
+ begin {remove preceding |backslash| and shift down}
+ ex_buf[ex_buf_xptr-1] := ex_buf[ex_buf_xptr];
+ incr(ex_buf_xptr);
+ end;
+decr(ex_buf_xptr);
+while ((ex_buf_ptr < ex_buf_length) and
+ (lex_class[ex_buf[ex_buf_ptr]] = white_space)) do
+ incr(ex_buf_ptr); {remove |white_space| trailing the control seq}
+tmp_ptr := ex_buf_ptr;
+while (tmp_ptr < ex_buf_length) do
+ begin {more shifting down}
+ ex_buf[tmp_ptr-(ex_buf_ptr-ex_buf_xptr)] := ex_buf[tmp_ptr];
+ incr(tmp_ptr)
+ end;
+ex_buf_length := tmp_ptr - (ex_buf_ptr - ex_buf_xptr);
+ex_buf_ptr := ex_buf_xptr;
+end
+
+
+@
+@:this can't happen}{\quad Unknown type of case conversion@>
+There are no control sequences in what we're about to convert,
+so a straight conversion suffices.
+
+@<Convert a noncontrol sequence@>=
+begin
+case (conversion_type) of
+ title_lowers,
+ all_lowers :
+ lower_case (ex_buf, ex_buf_xptr, ex_buf_ptr-ex_buf_xptr);
+ all_uppers :
+ upper_case (ex_buf, ex_buf_xptr, ex_buf_ptr-ex_buf_xptr);
+ bad_conversion :
+ do_nothing;
+ othercases
+ case_conversion_confusion
+endcases;
+end
+
+
+@
+@:this can't happen}{\quad Unknown type of case conversion@>
+This code does any needed conversion for an ordinary character; it
+won't touch nonletters.
+
+@<Convert a |brace_level = 0| character@>=
+begin
+case (conversion_type) of
+ title_lowers :
+ begin
+ if (ex_buf_ptr = 0) then
+ do_nothing
+ else if ((prev_colon) and
+ (lex_class[ex_buf[ex_buf_ptr-1]] = white_space)) then
+ do_nothing
+ else
+ lower_case (ex_buf, ex_buf_ptr, 1);
+ if (ex_buf[ex_buf_ptr] = colon) then
+ prev_colon := true
+ else if (lex_class[ex_buf[ex_buf_ptr]] <> white_space) then
+ prev_colon := false;
+ end;
+ all_lowers :
+ lower_case (ex_buf, ex_buf_ptr, 1);
+ all_uppers :
+ upper_case (ex_buf, ex_buf_ptr, 1);
+ bad_conversion :
+ do_nothing;
+ othercases
+ case_conversion_confusion
+endcases;
+end
+
+
+@
+The |built_in| function {\.{chr.to.int\$}} pops the top (string)
+literal, makes sure it's a single character, converts it to the
+corresponding |ASCII_code| integer, and pushes this integer. If the
+literal isn't an appropriate string, it complains and pushes the
+integer~0.
+
+@<|execute_fn|({\.{chr.to.int\$}})@>=
+procedure x_chr_to_int;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str);
+ push_lit_stk (0, stk_int);
+ end
+else if (length(pop_lit1) <> 1) then
+ begin
+ print ('"');
+ print_pool_str (pop_lit1);
+ bst_ex_warn ('" isn''t a single character');
+ push_lit_stk (0, stk_int);
+ end
+else
+ push_lit_stk (str_pool[str_start[pop_lit1]], stk_int);
+ {push the (|ASCII_code|) integer}
+end;
+
+
+@
+The |built_in| function {\.{cite\$}} pushes the appropriate string
+from |cite_list| onto the stack.
+
+@<|execute_fn|({\.{cite\$}})@>=
+procedure x_cite;
+begin
+if (not mess_with_entries) then
+ bst_cant_mess_with_entries_print
+ else
+ push_lit_stk (cur_cite_str, stk_str);
+end;
+
+
+@
+@^push the literal stack@>
+The |built_in| function {\.{duplicate\$}} pops the top literal from
+the stack and pushes two copies of it.
+
+@<|execute_fn|({\.{duplicate\$}})@>=
+procedure x_duplicate;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_str) then
+ begin
+ push_lit_stk (pop_lit1, pop_typ1);
+ push_lit_stk (pop_lit1, pop_typ1);
+ end
+ else
+ begin
+ repush_string;
+ if (pop_lit1 < cmd_str_ptr) then
+ push_lit_stk (pop_lit1, pop_typ1)
+ else
+ begin
+ str_room (length(pop_lit1));
+ sp_ptr := str_start[pop_lit1];
+ sp_end := str_start[pop_lit1+1];
+ while (sp_ptr < sp_end) do
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+ push_lit_stk (make_string, stk_str); {and push it onto the stack}
+ end;
+ end;
+end;
+
+
+@
+The |built_in| function {\.{empty\$}} pops the top literal and pushes
+the integer 1 if it's a missing field or a string having no
+non|white_space| characters, 0 otherwise. If the literal isn't a
+missing field or a string, it complains and pushes 0.
+
+@<|execute_fn|({\.{empty\$}})@>=
+procedure x_empty;
+label exit;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+case (pop_typ1) of
+ stk_str : @<Push 0 if the string has a non|white_space| char, else 1@>;
+ stk_field_missing : push_lit_stk (1, stk_int);
+ stk_empty : push_lit_stk (0, stk_int);
+ othercases
+ begin
+ print_stk_lit (pop_lit1,pop_typ1);
+ bst_ex_warn (', not a string or missing field,');
+ push_lit_stk (0, stk_int);
+ end
+endcases;
+exit:
+end;
+
+
+@
+When we arrive here we're dealing with a legitimate string. If it has
+no characters, or has nothing but |white_space| characters, we push~1,
+otherwise we push~0.
+
+@<Push 0 if the string has a non|white_space| char, else 1@>=
+begin
+sp_ptr := str_start[pop_lit1];
+sp_end := str_start[pop_lit1+1];
+while (sp_ptr < sp_end) do
+ begin
+ if (lex_class[str_pool[sp_ptr]] <> white_space) then
+ begin
+ push_lit_stk (0, stk_int);
+ return;
+ end;
+ incr(sp_ptr);
+ end;
+push_lit_stk (1, stk_int);
+end
+
+
+@
+The |built_in| function {\.{format.name\$}} pops the top three
+literals (they are a string, an integer, and a string literal, in that
+order). The last string literal represents a name list (each name
+corresponding to a person), the integer literal specifies which name
+to pick from this list, and the first string literal specifies how to
+format this name, as described in the \BibTeX\ documentation.
+Finally, this function pushes the formatted name. If any of the types
+is incorrect, it complains and pushes the null string.
+
+@d von_found = 52 {for when a von token is found}
+
+@<|execute_fn|({\.{format.name\$}})@>=
+procedure x_format_name;
+label loop1_exit,@!loop2_exit,@!von_found;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+pop_lit_stk (pop_lit3,pop_typ3);
+if (pop_typ1 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else if (pop_typ2 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_int);
+ push_lit_stk (s_null, stk_str);
+ end
+else if (pop_typ3 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit3,pop_typ3,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ begin
+ ex_buf_length := 0;
+ add_buf_pool (pop_lit3);
+ @<Isolate the desired name@>;
+ @<Copy name and count |comma|s to determine syntax@>;
+ @<Find the parts of the name@>;
+ ex_buf_length := 0;
+ add_buf_pool (pop_lit1);
+ figure_out_the_formatted_name;@/
+ add_pool_buf_and_push; {push the formatted string onto the stack}
+ end;
+end;
+
+
+@
+This module skips over undesired names in |pop_lit3| and it throws
+away the ``and'' from the end of the name if it exists. When it's
+done, |ex_buf_xptr| points to its first character and |ex_buf_ptr|
+points just past its last.
+
+@<Isolate the desired name@>=
+begin
+ex_buf_ptr := 0;
+num_names := 0;
+while ((num_names < pop_lit2) and (ex_buf_ptr < ex_buf_length)) do
+ begin
+ incr(num_names);
+ ex_buf_xptr := ex_buf_ptr;
+ name_scan_for_and (pop_lit3);
+ end;
+if (ex_buf_ptr < ex_buf_length) then {remove the ``and''}
+ ex_buf_ptr := ex_buf_ptr - 4;
+if (num_names < pop_lit2) then
+ begin
+ if (pop_lit2 = 1) then
+ print ('There is no name in "')
+ else
+ print ('There aren''t ',pop_lit2:0,' names in "');
+ print_pool_str (pop_lit3);
+ bst_ex_warn ('"');
+ end
+end
+
+
+@
+This module, starting at |ex_buf_ptr|, looks in |ex_buf| for an
+``and'' surrounded by nonnull |white_space|. It stops either at
+|ex_buf_length| or just past the ``and'', whichever comes first,
+setting |ex_buf_ptr| accordingly. Its parameter |pop_lit_var| is
+either |pop_lit3| or |pop_lit1|, depending on whether
+{\.{format.name\$}} or {\.{num.names\$}} calls it.
+
+@<Procedures and functions for name-string processing@>=
+procedure name_scan_for_and (@!pop_lit_var : str_number);
+begin
+brace_level := 0;
+preceding_white := false;
+and_found := false;
+while ((not and_found) and (ex_buf_ptr < ex_buf_length)) do
+ case (ex_buf[ex_buf_ptr]) of
+ "a", "A" :
+ begin
+ incr(ex_buf_ptr);
+ if (preceding_white) then
+ @<See if we have an ``and''@>; {if so, |and_found := true|}
+ preceding_white := false;
+ end;
+ left_brace :
+ begin
+ incr(brace_level);
+ incr(ex_buf_ptr);
+ @<Skip over |ex_buf| stuff at |brace_level > 0|@>;
+ preceding_white := false;
+ end;
+ right_brace :
+ begin
+ decr_brace_level (pop_lit_var); {this checks for an error}
+ incr(ex_buf_ptr);
+ preceding_white := false;
+ end;
+ othercases
+ if (lex_class[ex_buf[ex_buf_ptr]] = white_space) then
+ begin
+ incr(ex_buf_ptr);
+ preceding_white := true;
+ end
+ else
+ begin
+ incr(ex_buf_ptr);
+ preceding_white := false;
+ end
+ endcases;
+check_brace_level (pop_lit_var);
+end;
+
+
+@
+When we come here |ex_buf_ptr| is just past the |left_brace|, and when
+we leave it's either at |ex_buf_length| or just past the matching
+|right_brace|.
+
+@<Skip over |ex_buf| stuff at |brace_level > 0|@>=
+while ((brace_level > 0) and (ex_buf_ptr < ex_buf_length)) do
+ begin
+ if (ex_buf[ex_buf_ptr] = right_brace) then
+ decr(brace_level)
+ else if (ex_buf[ex_buf_ptr] = left_brace) then
+ incr(brace_level);
+ incr(ex_buf_ptr);
+ end
+
+
+@
+When we come here |ex_buf_ptr| is just past the ``a'' or ``A'', and when
+we leave it's either at the same place or, if we found an ``and'', at
+the following |white_space| character.
+
+@<See if we have an ``and''@>=
+begin
+if (ex_buf_ptr <= (ex_buf_length - 3)) then {enough characters are left}
+ if ((ex_buf[ex_buf_ptr] = "n") or (ex_buf[ex_buf_ptr] = "N")) then
+ if ((ex_buf[ex_buf_ptr+1] = "d") or (ex_buf[ex_buf_ptr+1] = "D")) then
+ if (lex_class[ex_buf[ex_buf_ptr+2]] = white_space) then
+ begin
+ ex_buf_ptr := ex_buf_ptr + 2;
+ and_found := true;
+ end;
+end
+
+
+@
+When we arrive here, the desired name is in |ex_buf[ex_buf_xptr]|
+through |ex_buf[ex_buf_ptr-1]|. This module does its thing for
+characters only at |brace_level = 0|; the rest get processed verbatim.
+It removes leading |white_space| (and |sep_char|s), and trailing
+|white_space| (and |sep_char|s) and |comma|s, complaining for each
+trailing |comma|. It then copies the name into |name_buf|, removing
+all |white_space|, |sep_char|s and |comma|s, counting |comma|s, and
+constructing a list of name tokens, which are sequences of characters
+separated (at |brace_level=0|) by |white_space|, |sep_char|s or
+|comma|s. Each name token but the first has an associated
+|name_sep_char|, the character that separates it from the preceding
+token. If there are too many (more than two) |comma|s, a complaint is
+in order.
+
+@<Copy name and count |comma|s to determine syntax@>=
+begin
+@<Remove leading and trailing junk, complaining if necessary@>;
+name_bf_ptr := 0;
+num_commas := 0;
+num_tokens := 0;@/
+token_starting := true; {to indicate that a name token is starting}
+while (ex_buf_xptr < ex_buf_ptr) do
+ case (ex_buf[ex_buf_xptr]) of
+ comma : @<Name-process a |comma|@>;
+ left_brace : @<Name-process a |left_brace|@>;
+ right_brace : @<Name-process a |right_brace|@>;
+ othercases
+ case (lex_class[ex_buf[ex_buf_xptr]]) of
+ white_space : @<Name-process a |white_space|@>;
+ sep_char : @<Name-process a |sep_char|@>;
+ othercases @<Name-process some other character@>
+ endcases
+ endcases;
+name_tok[num_tokens] := name_bf_ptr; {this is an end-marker}
+end
+
+
+@
+This module removes all leading |white_space| (and |sep_char|s), and
+trailing |white_space| (and |sep_char|s) and |comma|s. It complains
+for each trailing |comma|.
+
+@<Remove leading and trailing junk, complaining if necessary@>=
+begin
+while ((ex_buf_xptr < ex_buf_ptr) and
+ (lex_class[ex_buf[ex_buf_ptr]] = white_space) and
+ (lex_class[ex_buf[ex_buf_ptr]] = sep_char)) do
+ incr(ex_buf_xptr); {this removes leading stuff}
+while (ex_buf_ptr > ex_buf_xptr) do {now remove trailing stuff}
+ case (lex_class[ex_buf[ex_buf_ptr-1]]) of
+ white_space,
+ sep_char :
+ decr(ex_buf_ptr);
+ othercases
+ if (ex_buf[ex_buf_ptr-1] = comma) then
+ begin
+ print ('Name ',pop_lit2:0,' in "');
+ print_pool_str (pop_lit3);
+ print ('" has a comma at the end');
+ bst_ex_warn_print;
+ decr(ex_buf_ptr);
+ end
+ else
+ goto loop1_exit
+ endcases;
+loop1_exit:
+
+end
+
+@
+Here we mark the token number at which this comma has occurred.
+
+@<Name-process a |comma|@>=
+begin
+if (num_commas = 2) then
+ begin
+ print ('Too many commas in name ',pop_lit2:0,' of "');
+ print_pool_str (pop_lit3);
+ print ('"');
+ bst_ex_warn_print;
+ end
+ else
+ begin
+ incr(num_commas);
+ if (num_commas = 1) then
+ comma1 := num_tokens
+ else
+ comma2 := num_tokens; {|num_commas = 2|}
+ name_sep_char[num_tokens] := comma;
+ end;
+incr(ex_buf_xptr);
+token_starting := true;
+end
+
+
+@
+We copy the stuff up through the matching |right_brace| verbatim.
+
+@<Name-process a |left_brace|@>=
+begin
+incr(brace_level);
+if (token_starting) then
+ begin
+ name_tok[num_tokens] := name_bf_ptr;
+ incr(num_tokens);
+ end;
+name_buf[name_bf_ptr] := ex_buf[ex_buf_xptr];
+incr(name_bf_ptr);
+incr(ex_buf_xptr);
+while ((brace_level > 0) and (ex_buf_xptr < ex_buf_ptr)) do
+ begin
+ if (ex_buf[ex_buf_xptr] = right_brace) then
+ decr(brace_level)
+ else if (ex_buf[ex_buf_xptr] = left_brace) then
+ incr(brace_level);
+ name_buf[name_bf_ptr] := ex_buf[ex_buf_xptr];
+ incr(name_bf_ptr);
+ incr(ex_buf_xptr);
+ end;
+token_starting := false;
+end
+
+
+@
+We don't copy an extra |right_brace|; this code will almost never be
+executed.
+
+@<Name-process a |right_brace|@>=
+begin
+if (token_starting) then
+ begin
+ name_tok[num_tokens] := name_bf_ptr;
+ incr(num_tokens);
+ end;
+print ('Name ',pop_lit2:0,' of "');
+print_pool_str (pop_lit3);
+bst_ex_warn ('" isn''t brace balanced');
+incr(ex_buf_xptr);
+token_starting := false;
+end
+
+
+@
+A token will be starting soon in a buffer near you, one way$\ldots$
+
+@<Name-process a |white_space|@>=
+begin
+if (not token_starting) then
+ name_sep_char[num_tokens] := space;
+incr(ex_buf_xptr);
+token_starting := true;
+end
+
+
+@
+@^user abuse@>
+or another. If one of the valid |sep_char|s appears between tokens,
+we usually use it instead of a |space|. If the user has been silly
+enough to have multiple |sep_char|s, or to have both |white_space| and
+a |sep_char|, we use the first such character.
+
+@<Name-process a |sep_char|@>=
+begin
+if (not token_starting) then
+ name_sep_char[num_tokens] := ex_buf[ex_buf_xptr];
+incr(ex_buf_xptr);
+token_starting := true;
+end
+
+
+@
+For ordinary characters, we just copy the character.
+
+@<Name-process some other character@>=
+begin
+if (token_starting) then
+ begin
+ name_tok[num_tokens] := name_bf_ptr;
+ incr(num_tokens);
+ end;
+name_buf[name_bf_ptr] := ex_buf[ex_buf_xptr];
+incr(name_bf_ptr);
+incr(ex_buf_xptr);
+token_starting := false;
+end
+
+
+@
+@:this can't happen}{\quad Illegal number of comma,s@>
+Here we set all the pointers for the various parts of the name,
+depending on which of the three possible syntaxes this name uses.
+
+@<Find the parts of the name@>=
+begin
+if (num_commas = 0) then
+ begin
+ first_start := 0;
+ last_end := num_tokens;
+ jr_end := last_end;
+ @<Determine where the first name ends and von name starts and ends@>;
+ end
+else if (num_commas = 1) then
+ begin
+ von_start := 0;
+ last_end := comma1;
+ jr_end := last_end;
+ first_start := jr_end;
+ first_end := num_tokens;
+ von_name_ends_and_last_name_starts_stuff;
+ end
+else if (num_commas = 2) then
+ begin
+ von_start := 0;
+ last_end := comma1;
+ jr_end := comma2;
+ first_start := jr_end;
+ first_end := num_tokens;
+ von_name_ends_and_last_name_starts_stuff;
+ end
+else
+ confusion ('Illegal number of comma,s');
+end
+
+
+@
+When there are no brace-level-0 |comma|s in the name, the von name
+starts with the first nonlast token whose first brace-level-0 letter
+is in lower case (for the purposes of this determination, an accented
+or foreign character at brace-level-1 that's in lower case will do, as
+well). A module following this one determines where the von name ends
+and the last starts.
+
+@<Determine where the first name ends and von name starts and ends@>=
+begin
+von_start := 0;
+while (von_start < last_end-1) do
+ begin
+ name_bf_ptr := name_tok[von_start];
+ name_bf_xptr := name_tok[von_start+1];
+ if (von_token_found) then
+ begin
+ von_name_ends_and_last_name_starts_stuff;
+ goto von_found;
+ end;
+ incr(von_start);
+ end; {there's no von name, so}
+while (von_start > 0) do {backtrack if there are connected tokens}
+ begin
+ if ((lex_class[name_sep_char[von_start]] <> sep_char) or
+ (name_sep_char[von_start] = tie)) then
+ goto loop2_exit;
+ decr(von_start);
+ end;
+loop2_exit:
+von_end := von_start;
+von_found:
+first_end := von_start;
+end
+
+
+@
+@^special character@>
+It's a von token if there exists a first brace-level-0 letter (or
+brace-level-1 special character), and it's in lower case; in this case
+we return |true|. The token is in |name_buf|, starting at
+|name_bf_ptr| and ending just before |name_bf_xptr|.
+
+@d return_von_found == begin
+ von_token_found := true;
+ return;
+ end
+
+@<Procedures and functions for name-string processing@>=
+function von_token_found : boolean;
+label exit;
+begin
+nm_brace_level := 0;
+von_token_found := false; {now it's easy to exit if necessary}
+while (name_bf_ptr < name_bf_xptr) do
+ if ((name_buf[name_bf_ptr] >= "A") and
+ (name_buf[name_bf_ptr] <= "Z")) then
+ return
+ else if ((name_buf[name_bf_ptr] >= "a") and
+ (name_buf[name_bf_ptr] <= "z")) then
+ return_von_found
+ else if (name_buf[name_bf_ptr] = left_brace) then
+ begin
+ incr(nm_brace_level);
+ incr(name_bf_ptr);
+ if ((name_bf_ptr + 2 < name_bf_xptr) and
+ (name_buf[name_bf_ptr] = backslash)) then
+ @<Check the special character (and |return|)@>
+ else
+ @<Skip over |name_buf| stuff at |nm_brace_level > 0|@>;
+ end
+ else
+ incr(name_bf_ptr);
+exit:
+end;
+
+
+@
+@^special character@>
+When we come here |name_bf_ptr| is just past the |left_brace|,
+but we always leave by |return|ing.
+
+@<Check the special character (and |return|)@>=
+begin
+incr(name_bf_ptr); {skip over the |backslash|}
+name_bf_yptr := name_bf_ptr;
+while ((name_bf_ptr < name_bf_xptr) and
+ (lex_class[name_buf[name_bf_ptr]] = alpha)) do
+ incr(name_bf_ptr); {this scans the control sequence}
+control_seq_loc := str_lookup(name_buf,name_bf_yptr,name_bf_ptr-name_bf_yptr,
+ control_seq_ilk,dont_insert);
+if (hash_found) then
+ @<Handle this accented or foreign character (and |return|)@>;
+while ((name_bf_ptr < name_bf_xptr) and (nm_brace_level > 0)) do
+ begin
+ if ((name_buf[name_bf_ptr] >= "A") and
+ (name_buf[name_bf_ptr] <= "Z")) then
+ return
+ else if ((name_buf[name_bf_ptr] >= "a") and
+ (name_buf[name_bf_ptr] <= "z")) then
+ return_von_found
+ else if (name_buf[name_bf_ptr] = right_brace) then
+ decr(nm_brace_level)
+ else if (name_buf[name_bf_ptr] = left_brace) then
+ incr(nm_brace_level);
+ incr(name_bf_ptr);
+ end;
+return;
+end
+
+
+@
+@:this can't happen}{\quad Control-sequence hash error@>
+The accented or foreign character is either `\.{\\i}' or `\.{\\j}' or
+one of the eleven alphabetic foreign characters in Table~3.2 of the
+\LaTeX\ manual.
+
+@<Handle this accented or foreign character (and |return|)@>=
+begin
+case (ilk_info[control_seq_loc]) of
+ n_oe_upper,
+ n_ae_upper,
+ n_aa_upper,
+ n_o_upper,
+ n_l_upper :
+ return;
+ n_i,
+ n_j,
+ n_oe,
+ n_ae,
+ n_aa,
+ n_o,
+ n_l,
+ n_ss :
+ return_von_found;
+ othercases
+ confusion ('Control-sequence hash error')
+endcases;
+end
+
+
+@
+When we come here |name_bf_ptr| is just past the |left_brace|; when we
+leave it's either at |name_bf_xptr| or just past the matching
+|right_brace|.
+
+@<Skip over |name_buf| stuff at |nm_brace_level > 0|@>=
+while ((nm_brace_level > 0) and (name_bf_ptr < name_bf_xptr)) do
+ begin
+ if (name_buf[name_bf_ptr] = right_brace) then
+ decr(nm_brace_level)
+ else if (name_buf[name_bf_ptr] = left_brace) then
+ incr(nm_brace_level);
+ incr(name_bf_ptr);
+ end
+
+
+@
+@^Casey Stengel would be proud@>
+@^special character@>
+@^Tuesdays@>
+The last name starts just past the last token, before the first
+|comma| (if there is no |comma|, there is deemed to be one at the end
+of the string), for which there exists a first brace-level-0 letter
+(or brace-level-1 special character), and it's in lower case, unless
+this last token is also the last token before the |comma|, in which
+case the last name starts with this token (unless this last token is
+connected by a |sep_char| other than a |tie| to the previous token, in
+which case the last name starts with as many tokens earlier as are
+connected by non|tie|s to this last one (except on Tuesdays
+$\ldots\,$), although this module never sees such a case). Note that
+if there are any tokens in either the von or last names, then the last
+name has at least one, even if it starts with a lower-case letter.
+
+@<Procedures and functions for name-string processing@>=
+procedure von_name_ends_and_last_name_starts_stuff;
+label exit;
+begin {there may or may not be a von name}
+von_end := last_end - 1;
+while (von_end > von_start) do
+ begin
+ name_bf_ptr := name_tok[von_end-1];
+ name_bf_xptr := name_tok[von_end];
+ if (von_token_found) then
+ return;
+ decr(von_end);
+ end;
+exit:
+end;
+
+
+@
+This module uses the information in |pop_lit1| to format the name.
+Everything at |sp_brace_level = 0| is copied verbatim to the formatted
+string; the rest is described in the succeeding modules.
+
+@<Figure out the formatted name@>=
+begin
+ex_buf_ptr := 0;
+sp_brace_level := 0;
+sp_ptr := str_start[pop_lit1];
+sp_end := str_start[pop_lit1+1];
+while (sp_ptr < sp_end) do
+ if (str_pool[sp_ptr] = left_brace) then
+ begin
+ incr(sp_brace_level);
+ incr(sp_ptr);
+ @<Format this part of the name@>;
+ end
+ else if (str_pool[sp_ptr] = right_brace) then
+ begin
+ braces_unbalanced_complaint (pop_lit1);
+ incr(sp_ptr);
+ end
+ else
+ begin
+ append_ex_buf_char_and_check (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+if (sp_brace_level > 0) then
+ braces_unbalanced_complaint (pop_lit1);
+ex_buf_length := ex_buf_ptr;
+end
+
+
+@
+When we arrive here we're at |sp_brace_level = 1|, just past the
+|left_brace|. Letters at this |sp_brace_level| other than those
+denoting the parts of the name (i.e., the first letters of `first,'
+`last,' `von,' and `jr,' ignoring case) are illegal. We do two passes
+over this group; the first determines whether we're to output
+anything, and, if we are, the second actually outputs it.
+
+@<Format this part of the name@>=
+begin
+sp_xptr1 := sp_ptr;
+alpha_found := false;
+double_letter := false;
+end_of_group := false;
+to_be_written := true;
+while ((not end_of_group) and (sp_ptr < sp_end)) do
+ if (lex_class[str_pool[sp_ptr]] = alpha) then
+ begin
+ incr(sp_ptr);
+ @<Figure out what this letter means@>;
+ end
+ else if (str_pool[sp_ptr] = right_brace) then
+ begin
+ decr(sp_brace_level);
+ incr(sp_ptr);
+ end_of_group := true;
+ end
+ else if (str_pool[sp_ptr] = left_brace) then
+ begin
+ incr(sp_brace_level);
+ incr(sp_ptr);
+ skip_stuff_at_sp_brace_level_greater_than_one;
+ end
+ else
+ incr(sp_ptr);
+if ((end_of_group) and (to_be_written)) then {do the second pass}
+ @<Finally format this part of the name@>;
+end
+
+
+@
+When we come here |sp_ptr| is just past the |left_brace|, and when we
+leave it's either at |sp_end| or just past the matching |right_brace|.
+
+@<Procedures and functions for name-string processing@>=
+procedure skip_stuff_at_sp_brace_level_greater_than_one;
+begin
+while ((sp_brace_level > 1) and (sp_ptr < sp_end)) do
+ begin
+ if (str_pool[sp_ptr] = right_brace) then
+ decr(sp_brace_level)
+ else if (str_pool[sp_ptr] = left_brace) then
+ incr(sp_brace_level);
+ incr(sp_ptr);
+ end;
+end;
+
+
+@
+We won't output anything for this part of the name if this is a second
+occurrence of an |sp_brace_level = 1| letter, if it's an illegal
+letter, or if there are no tokens corresponding to this part. We also
+determine if we're we to output complete tokens (indicated by a double
+letter).
+
+@<Figure out what this letter means@>=
+begin
+if (alpha_found) then
+ begin
+ brace_lvl_one_letters_complaint;
+ to_be_written := false;
+ end
+ else
+ begin
+ case (str_pool[sp_ptr-1]) of
+ "f","F" : @<Figure out what tokens we'll output for the `first' name@>;
+ "v","V" : @<Figure out what tokens we'll output for the `von' name@>;
+ "l","L" : @<Figure out what tokens we'll output for the `last' name@>;
+ "j","J" : @<Figure out what tokens we'll output for the `jr' name@>;
+ othercases
+ begin
+ brace_lvl_one_letters_complaint;
+ to_be_written := false;
+ end
+ endcases;
+ if (double_letter) then
+ incr(sp_ptr);
+ end;
+alpha_found := true;
+end
+
+
+@
+At most one of the important letters, perhaps doubled, may appear at
+|sp_brace_level = 1|.
+
+@<Procedures and functions for name-string processing@>=
+procedure brace_lvl_one_letters_complaint;
+begin
+print ('The format string "');
+print_pool_str (pop_lit1);
+bst_ex_warn ('" has an illegal brace-level-1 letter');
+end;
+
+
+@
+Here we set pointers into |name_tok| and note whether we'll be dealing
+with a full first-name tokens (|double_letter = true|) or
+abbreviations (|double_letter = false|).
+
+@<Figure out what tokens we'll output for the `first' name@>=
+begin
+cur_token := first_start;
+last_token := first_end;
+if (cur_token = last_token) then
+ to_be_written := false;
+if ((str_pool[sp_ptr] = "f") or (str_pool[sp_ptr] = "F")) then
+ double_letter := true;
+end
+
+
+@
+The same as above but for von-name tokens.
+
+@<Figure out what tokens we'll output for the `von' name@>=
+begin
+cur_token := von_start;
+last_token := von_end;
+if (cur_token = last_token) then
+ to_be_written := false;
+if ((str_pool[sp_ptr] = "v") or (str_pool[sp_ptr] = "V")) then
+ double_letter := true;
+end
+
+
+@
+The same as above but for last-name tokens.
+
+@<Figure out what tokens we'll output for the `last' name@>=
+begin
+cur_token := von_end;
+last_token := last_end;
+if (cur_token = last_token) then
+ to_be_written := false;
+if ((str_pool[sp_ptr] = "l") or (str_pool[sp_ptr] = "L")) then
+ double_letter := true;
+end
+
+
+@
+The same as above but for jr-name tokens.
+
+@<Figure out what tokens we'll output for the `jr' name@>=
+begin
+cur_token := last_end;
+last_token := jr_end;
+if (cur_token = last_token) then
+ to_be_written := false;
+if ((str_pool[sp_ptr] = "j") or (str_pool[sp_ptr] = "J")) then
+ double_letter := true;
+end
+
+
+@
+This is the second pass over this part of the name; here we actually
+write stuff out to |ex_buf|.
+
+@<Finally format this part of the name@>=
+begin
+ex_buf_xptr := ex_buf_ptr;
+sp_ptr := sp_xptr1;
+sp_brace_level := 1;
+while (sp_brace_level > 0) do
+ if ((lex_class[str_pool[sp_ptr]] = alpha) and (sp_brace_level = 1)) then
+ begin
+ incr(sp_ptr);
+ @<Figure out how to output the name tokens, and do it@>;
+ end
+ else if (str_pool[sp_ptr] = right_brace) then
+ begin
+ decr(sp_brace_level);
+ incr(sp_ptr);
+ if (sp_brace_level > 0) then
+ append_ex_buf_char_and_check (right_brace);
+ end
+ else if (str_pool[sp_ptr] = left_brace) then
+ begin
+ incr(sp_brace_level);
+ incr(sp_ptr);
+ append_ex_buf_char_and_check (left_brace);
+ end
+ else
+ begin
+ append_ex_buf_char_and_check (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+if (ex_buf_ptr > 0) then
+ if (ex_buf[ex_buf_ptr-1] = tie) then
+ @<Handle a discretionary |tie|@>;
+end
+
+
+@
+When we come here, |sp_ptr| is just past the letter indicating the
+part of the name for which we're about to output tokens. When we
+leave, it's at the first character of the rest of the group.
+
+@<Figure out how to output the name tokens, and do it@>=
+begin
+if (double_letter) then
+ incr(sp_ptr);
+use_default := true;
+sp_xptr2 := sp_ptr;
+if (str_pool[sp_ptr] = left_brace) then {find the inter-token string}
+ begin
+ use_default := false;
+ incr(sp_brace_level);
+ incr(sp_ptr);
+ sp_xptr1 := sp_ptr;
+ skip_stuff_at_sp_brace_level_greater_than_one;
+ sp_xptr2 := sp_ptr - 1;
+ end;
+@<Finally output the name tokens@>;
+if (not use_default) then
+ sp_ptr := sp_xptr2 + 1;
+end
+
+
+@
+Here, for each token in this part, we output either a full or an
+abbreviated token and the inter-token string for all but the last
+token of this part.
+
+@<Finally output the name tokens@>=
+while (cur_token < last_token) do
+ begin
+ if (double_letter) then
+ @<Finally output a full token@>
+ else
+ @<Finally output an abbreviated token@>;
+ incr(cur_token);
+ if (cur_token < last_token) then
+ @<Finally output the inter-token string@>;
+ end
+
+
+@
+@:BibTeX capacity exceeded}{\quad buffer size@>
+Here we output all the characters in the token, verbatim.
+
+@<Finally output a full token@>=
+begin
+name_bf_ptr := name_tok[cur_token];
+name_bf_xptr := name_tok[cur_token+1];
+if (ex_buf_length+(name_bf_xptr-name_bf_ptr) > buf_size) then
+ buffer_overflow;
+while (name_bf_ptr < name_bf_xptr) do
+ begin
+ append_ex_buf_char (name_buf[name_bf_ptr]);
+ incr(name_bf_ptr);
+ end;
+end
+
+
+@
+@^special character@>
+Here we output the first alphabetic or special character of the token;
+brace level is irrelevant for an alphabetic (but not a special)
+character.
+
+@<Finally output an abbreviated token@>=
+begin
+name_bf_ptr := name_tok[cur_token];
+name_bf_xptr := name_tok[cur_token+1];
+while (name_bf_ptr < name_bf_xptr) do
+ begin
+ if (lex_class[name_buf[name_bf_ptr]] = alpha) then
+ begin
+ append_ex_buf_char_and_check (name_buf[name_bf_ptr]);
+ goto loop_exit;
+ end
+ else if ((name_buf[name_bf_ptr] = left_brace) and
+ (name_bf_ptr + 1 < name_bf_xptr)) then
+ if (name_buf[name_bf_ptr+1] = backslash) then
+ @<Finally output a special character and exit loop@>;
+ incr(name_bf_ptr);
+ end;
+loop_exit:
+end
+
+
+@
+@^special character@>
+@^user abuse@>
+@:BibTeX capacity exceeded}{\quad buffer size@>
+We output a special character here even if the user has been silly
+enough to make it nonalphabetic (and even if the user has been sillier
+still by not having a matching |right_brace|).
+
+@<Finally output a special character and exit loop@>=
+begin
+if (ex_buf_ptr + 2 > buf_size) then
+ buffer_overflow;
+append_ex_buf_char (left_brace);
+append_ex_buf_char (backslash);
+name_bf_ptr := name_bf_ptr + 2;
+nm_brace_level := 1;
+while ((name_bf_ptr < name_bf_xptr) and (nm_brace_level > 0)) do
+ begin
+ if (name_buf[name_bf_ptr] = right_brace) then
+ decr(nm_brace_level)
+ else if (name_buf[name_bf_ptr] = left_brace) then
+ incr(nm_brace_level);
+ append_ex_buf_char_and_check (name_buf[name_bf_ptr]);
+ incr(name_bf_ptr);
+ end;
+goto loop_exit;
+end
+
+
+@
+@:BibTeX capacity exceeded}{\quad buffer size@>
+Here we output either the \.{.bst} given string if it exists, or else
+the \.{.bib} |sep_char| if it exists, or else the default string. A
+|tie| is the default space character between the last two tokens of
+the name part, and between the first two tokens if the first token is
+short enough; otherwise, a |space| is the default.
+
+@d long_token = 3 {a token this length or longer is ``long''}
+
+@<Finally output the inter-token string@>=
+begin
+if (use_default) then
+ begin
+ if (not double_letter) then
+ append_ex_buf_char_and_check (period);
+ if (lex_class[name_sep_char[cur_token]] = sep_char) then
+ append_ex_buf_char_and_check (name_sep_char[cur_token])
+ else if ((cur_token = last_token-1) or
+ (not enough_text_chars (long_token))) then
+ append_ex_buf_char_and_check (tie)
+ else
+ append_ex_buf_char_and_check (space);
+ end
+ else
+ begin
+ if (ex_buf_length+(sp_xptr2-sp_xptr1) > buf_size) then
+ buffer_overflow;
+ sp_ptr := sp_xptr1;
+ while (sp_ptr < sp_xptr2) do
+ begin
+ append_ex_buf_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end
+ end;
+end
+
+
+@
+@^special character@>
+This function looks at the string in |ex_buf|, starting at
+|ex_buf_xptr| and ending just before |ex_buf_ptr|, and it returns
+|true| if there are |enough_chars|, where a special character (even if
+it's missing its matching |right_brace|) counts as a single charcter.
+This procedure is called only for strings that don't have too many
+|right_brace|s.
+
+@<Procedures and functions for name-string processing@>=
+function enough_text_chars (@!enough_chars : buf_pointer) : boolean;
+begin
+num_text_chars := 0;
+ex_buf_yptr := ex_buf_xptr;
+while ((ex_buf_yptr < ex_buf_ptr) and (num_text_chars < enough_chars)) do
+ begin
+ incr(ex_buf_yptr);
+ if (ex_buf[ex_buf_yptr-1] = left_brace) then
+ begin
+ incr(brace_level);
+ if ((brace_level = 1) and (ex_buf_yptr < ex_buf_ptr)) then
+ if (ex_buf[ex_buf_yptr] = backslash) then
+ begin
+ incr(ex_buf_yptr); {skip over the |backslash|}
+ while ((ex_buf_yptr < ex_buf_ptr) and (brace_level > 0)) do
+ begin
+ if (ex_buf[ex_buf_yptr] = right_brace) then
+ decr(brace_level)
+ else if (ex_buf[ex_buf_yptr] = left_brace) then
+ incr(brace_level);
+ incr(ex_buf_yptr);
+ end;
+ end;
+ end
+ else if (ex_buf[ex_buf_yptr-1] = right_brace) then
+ decr(brace_level);
+ incr(num_text_chars);
+ end;
+if (num_text_chars < enough_chars) then
+ enough_text_chars := false
+ else
+ enough_text_chars := true;
+end;
+
+
+@
+If the last character output for this name part is a |tie| but the
+previous character it isn't, we're dealing with a discretionary |tie|;
+thus we replace it by a |space| if there are enough characters in the
+rest of the name part.
+
+@d long_name = 3 {a name this length or longer is ``long''}
+
+@<Handle a discretionary |tie|@>=
+begin
+decr(ex_buf_ptr); {remove the previous |tie|}
+if (ex_buf[ex_buf_ptr-1] = tie) then {it's not a discretionary |tie|}
+ do_nothing
+else if (not enough_text_chars (long_name)) then {this is a short name part}
+ incr(ex_buf_ptr) {so restore the |tie|}
+else {replace it by a |space|}
+ append_ex_buf_char (space);
+end
+
+
+@
+This is a procedure so that |x_format_name| is smaller.
+
+@<Procedures and functions for name-string processing@>=
+procedure figure_out_the_formatted_name;
+label loop_exit;
+begin
+@<Figure out the formatted name@>;
+end;
+
+
+@
+The |built_in| function {\.{if\$}} pops the top three literals (they
+are two function literals and an integer literal, in that order); if
+the integer is greater than 0, it executes the second literal, else it
+executes the first. If any of the types is incorrect, it complains
+but does nothing else.
+
+@<|execute_fn|({\.{if\$}})@>=
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+pop_lit_stk (pop_lit3,pop_typ3);
+if (pop_typ1 <> stk_fn) then
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_fn)
+else if (pop_typ2 <> stk_fn) then
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_fn)
+else if (pop_typ3 <> stk_int) then
+ print_wrong_stk_lit (pop_lit3,pop_typ3,stk_int)
+else
+ if (pop_lit3 > 0) then
+ execute_fn (pop_lit2)
+ else
+ execute_fn (pop_lit1);
+end
+
+
+@
+The |built_in| function {\.{int.to.chr\$}} pops the top (integer)
+literal, interpreted as the |ASCII_code| of a single character,
+converts it to the corresponding single-character string, and pushes
+this string. If the literal isn't an appropriate integer, it
+complains and pushes the null string.
+
+@<|execute_fn|({\.{int.to.chr\$}})@>=
+procedure x_int_to_chr;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (s_null, stk_str);
+ end
+else if ((pop_lit1 < 0) or (pop_lit1 > 127)) then
+ begin
+ bst_ex_warn (pop_lit1:0,' isn''t valid ASCII');
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ begin
+ str_room(1);
+ append_char (pop_lit1);
+ push_lit_stk (make_string, stk_str);
+ end;
+end;
+
+
+@
+The |built_in| function {\.{int.to.str\$}} pops the top (integer)
+literal, converts it to its (unique) string equivalent, and pushes
+this string. If the literal isn't an integer, it complains and pushes
+the null string.
+
+@<|execute_fn|({\.{int.to.str\$}})@>=
+procedure x_int_to_str;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ begin
+ int_to_ASCII (pop_lit1, ex_buf, 0, ex_buf_length);@/
+ add_pool_buf_and_push; {push this string onto the stack}
+ end;
+end;
+
+
+@
+The |built_in| function {\.{missing\$}} pops the top literal and
+pushes the integer 1 if it's a missing field, 0 otherwise. If the
+literal isn't a missing field or a string, it complains and pushes 0.
+Unlike \.{empty\$}, this function should be called only when
+|mess_with_entries| is true.
+
+@<|execute_fn|({\.{missing\$}})@>=
+procedure x_missing;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (not mess_with_entries) then
+ bst_cant_mess_with_entries_print
+else if ((pop_typ1 <> stk_str) and (pop_typ1 <> stk_field_missing)) then
+ begin
+ if (pop_typ1 <> stk_empty) then
+ begin
+ print_stk_lit (pop_lit1,pop_typ1);
+ bst_ex_warn (', not a string or missing field,');
+ end;
+ push_lit_stk (0, stk_int);
+ end
+else
+ if (pop_typ1 = stk_field_missing) then
+ push_lit_stk (1, stk_int)
+ else
+ push_lit_stk (0, stk_int);
+end;
+
+
+@
+The |built_in| function {\.{newline\$}} writes whatever has
+accumulated in the output buffer |out_buf| onto the \.{.bbl} file.
+
+@<|execute_fn|({\.{newline\$}})@>=
+begin
+output_bbl_line;
+end
+
+
+@
+The |built_in| function {\.{num.names\$}} pops the top (string)
+literal; it pushes the number of names the string represents---one
+plus the number of occurrences of the substring ``and'' (ignoring case
+differences) surrounded by nonnull |white_space| at the top brace
+level. If the literal isn't a string, it complains and pushes the
+value 0.
+
+@<|execute_fn|({\.{num.names\$}})@>=
+procedure x_num_names;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str);
+ push_lit_stk (0, stk_int);
+ end
+else
+ begin
+ ex_buf_length := 0;
+ add_buf_pool (pop_lit1);
+ @<Determine the number of names@>;
+ push_lit_stk (num_names, stk_int);
+ end;
+end;
+
+
+@
+This module, while scanning the list of names, counts the occurrences
+of ``and'' (ignoring case differences) surrounded by nonnull
+|white_space|, and adds 1.
+
+@<Determine the number of names@>=
+begin
+ex_buf_ptr := 0;
+num_names := 0;
+while (ex_buf_ptr < ex_buf_length) do
+ begin
+ name_scan_for_and (pop_lit1);
+ incr(num_names);
+ end;
+end
+
+
+@
+The |built_in| function {\.{pop\$}} pops the top of the stack but
+doesn't print it.
+
+@<|execute_fn|({\.{pop\$}})@>=
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+end
+
+
+@
+The |built_in| function {\.{preamble\$}} pushes onto the stack the
+concatenation of all the \.{preamble} strings read from the database
+files.
+
+@<|execute_fn|({\.{preamble\$}})@>=
+procedure x_preamble;
+begin
+ex_buf_length := 0;
+preamble_ptr := 0;
+while (preamble_ptr < num_preamble_strings) do
+ begin
+ add_buf_pool (s_preamble[preamble_ptr]);
+ incr(preamble_ptr);
+ end;
+add_pool_buf_and_push; {push the concatenation string onto the stack}
+end;
+
+
+@
+@^special character@>
+The |built_in| function {\.{purify\$}} pops the top (string) literal,
+removes nonalphanumeric characters except for |white_space| and
+|sep_char| characters (these get converted to a |space|) and removes
+certain alphabetic characters contained in the control sequences
+associated with a special character, and pushes the resulting string.
+If the literal isn't a string, it complains and pushes the null
+string.
+
+@<|execute_fn|({\.{purify\$}})@>=
+procedure x_purify;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ begin
+ ex_buf_length := 0;
+ add_buf_pool (pop_lit1);
+ @<Perform the purification@>;
+ add_pool_buf_and_push; {push this string onto the stack}
+ end;
+end;
+
+
+@
+@^special character@>
+The resulting string has nonalphanumeric characters removed, and each
+|white_space| or |sep_char| character converted to a |space|. The next
+module handles special characters. This code doesn't complain if the
+string isn't brace balanced.
+
+@<Perform the purification@>=
+begin
+brace_level := 0; {this is the top level}
+ex_buf_xptr := 0; {this pointer is for the purified string}
+ex_buf_ptr := 0; {and this one is for the original string}
+while (ex_buf_ptr < ex_buf_length) do
+ begin
+ case (lex_class[ex_buf[ex_buf_ptr]]) of
+ white_space,
+ sep_char :
+ begin
+ ex_buf[ex_buf_xptr] := space;
+ incr(ex_buf_xptr);
+ end;
+ alpha,
+ numeric :
+ begin
+ ex_buf[ex_buf_xptr] := ex_buf[ex_buf_ptr];
+ incr(ex_buf_xptr);
+ end;
+ othercases
+ if (ex_buf[ex_buf_ptr] = left_brace) then
+ begin
+ incr(brace_level);
+ if ((brace_level = 1) and
+ (ex_buf_ptr + 1 < ex_buf_length)) then
+ if (ex_buf[ex_buf_ptr+1] = backslash) then
+ @<Purify a special character@>;
+ end
+ else if (ex_buf[ex_buf_ptr] = right_brace) then
+ if (brace_level > 0) then
+ decr(brace_level)
+ endcases;
+ incr(ex_buf_ptr);
+ end;
+ex_buf_length := ex_buf_xptr;
+end
+
+
+@
+@^special character@>
+Special characters (even without a matching |right_brace|) are
+purified by removing the control sequences (but restoring the correct
+thing for `\.{\\i}' and `\.{\\j}' as well as the eleven alphabetic
+foreign characters in Table~3.2 of the \LaTeX\ manual) and removing
+all nonalphanumeric characters (including |white_space| and
+|sep_char|s).
+
+@<Purify a special character@>=
+begin
+incr(ex_buf_ptr); {skip over the |left_brace|}
+while ((ex_buf_ptr < ex_buf_length) and (brace_level > 0)) do
+ begin
+ incr(ex_buf_ptr); {skip over the |backslash|}
+ ex_buf_yptr := ex_buf_ptr; {mark the beginning of the control sequence}
+ while ((ex_buf_ptr < ex_buf_length) and
+ (lex_class[ex_buf[ex_buf_ptr]] = alpha)) do@/
+ incr(ex_buf_ptr); {this scans the control sequence}
+ control_seq_loc := str_lookup(ex_buf,ex_buf_yptr,ex_buf_ptr-ex_buf_yptr,
+ control_seq_ilk,dont_insert);
+ if (hash_found) then
+ @<Purify this accented or foreign character@>;
+ while ((ex_buf_ptr < ex_buf_length) and (brace_level > 0) and
+ (ex_buf[ex_buf_ptr] <> backslash)) do
+ begin {this scans to the next control sequence}
+ case (lex_class[ex_buf[ex_buf_ptr]]) of
+ alpha,
+ numeric :
+ begin
+ ex_buf[ex_buf_xptr] := ex_buf[ex_buf_ptr];
+ incr(ex_buf_xptr);
+ end;
+ othercases
+ if (ex_buf[ex_buf_ptr] = right_brace) then
+ decr(brace_level)
+ else if (ex_buf[ex_buf_ptr] = left_brace) then
+ incr(brace_level)
+ endcases;
+ incr(ex_buf_ptr);
+ end;
+ end;
+decr(ex_buf_ptr); {unskip the |right_brace| (or last character)}
+end
+
+
+@
+We consider the purified character to be either the first alphabetic
+character of its control sequence, or perhaps both alphabetic
+characters.
+
+@<Purify this accented or foreign character@>=
+begin
+ex_buf[ex_buf_xptr] := ex_buf[ex_buf_yptr]; {the first alphabetic character}
+incr(ex_buf_xptr);
+case (ilk_info[control_seq_loc]) of
+ n_oe,
+ n_oe_upper,
+ n_ae,
+ n_ae_upper,
+ n_ss :
+ begin {and the second}
+ ex_buf[ex_buf_xptr] := ex_buf[ex_buf_yptr+1];
+ incr(ex_buf_xptr);
+ end;
+ othercases
+ do_nothing
+endcases;
+end
+
+
+@
+The |built_in| function {\.{quote\$}} pushes the string consisting of
+the |double_quote| character.
+
+@<|execute_fn|({\.{quote\$}})@>=
+procedure x_quote;
+begin
+str_room(1);
+append_char (double_quote);
+push_lit_stk (make_string, stk_str);
+end;
+
+
+@
+The |built_in| function {\.{skip\$}} is a no-op.
+
+@<|execute_fn|({\.{skip\$}})@>=
+begin
+do_nothing;
+end
+
+
+@
+The |built_in| function {\.{stack\$}} pops and prints the whole stack;
+it's meant to be used for style designers while debugging.
+
+@<|execute_fn|({\.{stack\$}})@>=
+begin
+pop_whole_stack;
+end
+
+
+@
+@^push the literal stack@>
+The |built_in| function {\.{substring\$}} pops the top three literals
+(they are the two integers literals |pop_lit1| and |pop_lit2| and a
+string literal, in that order). It pushes the substring of the (at
+most) |pop_lit1| consecutive characters starting at the |pop_lit2|th
+character (assuming 1-based indexing) if |pop_lit2| is positive, and
+ending at the |-pop_lit2|th character from the end if |pop_lit2| is
+negative (where the first character from the end is the last
+character). If any of the types is incorrect, it complain and pushes
+the null string.
+
+@<|execute_fn|({\.{substring\$}})@>=
+procedure x_substring;
+label exit;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+pop_lit_stk (pop_lit3,pop_typ3);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (s_null, stk_str);
+ end
+else if (pop_typ2 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_int);
+ push_lit_stk (s_null, stk_str);
+ end
+else if (pop_typ3 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit3,pop_typ3,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ begin
+ sp_length := length(pop_lit3);
+ if (pop_lit1 >= sp_length) then
+ if ((pop_lit2 = 1) or (pop_lit2 = -1)) then
+ begin
+ repush_string;
+ return;
+ end;
+ if ((pop_lit1 <= 0) or (pop_lit2 = 0) or (pop_lit2 > sp_length) or
+ (pop_lit2 < -sp_length)) then
+ begin
+ push_lit_stk (s_null, stk_str);
+ return;
+ end
+ else
+ @<Form the appropriate substring@>;
+ end;
+exit:
+end;
+
+
+@
+@^push the literal stack@>
+This module finds the substring as described in the last section,
+and slides it into place in the string pool, if necessary.
+
+@<Form the appropriate substring@>=
+begin
+if (pop_lit2 > 0) then
+ begin
+ if (pop_lit1 > sp_length - (pop_lit2-1)) then
+ pop_lit1 := sp_length - (pop_lit2-1);
+ sp_ptr := str_start[pop_lit3] + (pop_lit2-1);
+ sp_end := sp_ptr + pop_lit1;
+ if (pop_lit2 = 1) then
+ if (pop_lit3 >= cmd_str_ptr) then {no shifting---merely change pointers}
+ begin
+ str_start[pop_lit3+1] := sp_end;
+ unflush_string;
+ incr(lit_stk_ptr);
+ return;
+ end;
+ end
+else {|-ex_buf_length <= pop_lit2 < 0|}
+ begin
+ pop_lit2 := -pop_lit2;
+ if (pop_lit1 > sp_length - (pop_lit2-1)) then
+ pop_lit1 := sp_length - (pop_lit2-1);
+ sp_end := str_start[pop_lit3+1] - (pop_lit2-1);
+ sp_ptr := sp_end - pop_lit1;
+ end;
+while (sp_ptr < sp_end) do {shift the substring}
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+push_lit_stk (make_string, stk_str); {and push it onto the stack}
+end
+
+
+@
+The |built_in| function {\.{swap\$}} pops the top two literals from
+the stack and pushes them back swapped.
+
+@<|execute_fn|({\.{swap\$}})@>=
+procedure x_swap;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if ((pop_typ1 <> stk_str) or (pop_lit1 < cmd_str_ptr)) then
+ begin
+ push_lit_stk (pop_lit1, pop_typ1);
+ if ((pop_typ2 = stk_str) and (pop_lit2 >= cmd_str_ptr)) then
+ unflush_string;
+ push_lit_stk (pop_lit2, pop_typ2);
+ end
+else if ((pop_typ2 <> stk_str) or (pop_lit2 < cmd_str_ptr)) then
+ begin
+ unflush_string; {this is |pop_lit1|}
+ push_lit_stk (pop_lit1, stk_str);
+ push_lit_stk (pop_lit2, pop_typ2);
+ end
+else {bummer, both are recent strings}
+ @<Swap the two strings (they're at the end of |str_pool|)@>;
+end;
+
+
+@
+We have to swap both (a)~the strings at the end of the string pool,
+and (b)~their pointers on the literal stack.
+
+@<Swap the two strings (they're at the end of |str_pool|)@>=
+begin
+ex_buf_length := 0;
+add_buf_pool (pop_lit2); {save the second string}
+sp_ptr := str_start[pop_lit1];
+sp_end := str_start[pop_lit1+1];
+while (sp_ptr < sp_end) do {slide the first string down}
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+push_lit_stk (make_string, stk_str); {and push it onto the stack}
+add_pool_buf_and_push; {push second string onto the stack}
+end
+
+
+@
+@^special character@>
+The |built_in| function {\.{text.length\$}} pops the top (string)
+literal, and pushes the number of text characters it contains, where
+an accented character (more precisely, a ``special character''$\!$,
+defined earlier) counts as a single text character, even if it's
+missing its matching |right_brace|, and where braces don't count as
+text characters. If the literal isn't a string, it complains and
+pushes the null string.
+
+@<|execute_fn|({\.{text.length\$}})@>=
+procedure x_text_length;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ begin
+ num_text_chars := 0;
+ @<Count the text characters@>;
+ push_lit_stk (num_text_chars, stk_int); {and push it onto the stack}
+ end;
+end;
+
+
+@
+@^special character@>
+Here we determine the number of text characters in the string, where
+an entire special character counts as a single text character (even if
+it's missing its matching |right_brace|), and where braces don't count
+as text characters.
+
+@<Count the text characters@>=
+begin
+sp_ptr := str_start[pop_lit1];
+sp_end := str_start[pop_lit1+1];
+sp_brace_level := 0;
+while (sp_ptr < sp_end) do
+ begin
+ incr(sp_ptr);
+ if (str_pool[sp_ptr-1] = left_brace) then
+ begin
+ incr(sp_brace_level);
+ if ((sp_brace_level = 1) and (sp_ptr < sp_end)) then
+ if (str_pool[sp_ptr] = backslash) then
+ begin
+ incr(sp_ptr); {skip over the |backslash|}
+ while ((sp_ptr < sp_end) and (sp_brace_level > 0)) do
+ begin
+ if (str_pool[sp_ptr] = right_brace) then
+ decr(sp_brace_level)
+ else if (str_pool[sp_ptr] = left_brace) then
+ incr(sp_brace_level);
+ incr(sp_ptr);
+ end;
+ incr(num_text_chars);
+ end;
+ end
+ else if (str_pool[sp_ptr-1] = right_brace) then
+ begin
+ if (sp_brace_level > 0) then
+ decr(sp_brace_level);
+ end
+ else
+ incr(num_text_chars);
+ end;
+end
+
+
+@
+@^special character@>
+The |built_in| function {\.{text.prefix\$}} pops the top two literals
+(the integer literal |pop_lit1| and a string literal, in that order).
+It pushes the substring of the (at most) |pop_lit1| consecutive text
+characters starting from the beginning of the string. This function
+is similar to {\.{substring\$}}, but this one considers an accented
+character (or more precisely, a ``special character''$\!$, even if
+it's missing its matching |right_brace|) to be a single text character
+(rather than however many |ASCII_code| characters it actually
+comprises), and this function doesn't consider braces to be text
+characters; furthermore, this function appends any needed matching
+|right_brace|s. If any of the types is incorrect, it complains and
+pushes the null string.
+
+@<|execute_fn|({\.{text.prefix\$}})@>=
+procedure x_text_prefix;
+label exit;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+pop_lit_stk (pop_lit2,pop_typ2);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (s_null, stk_str);
+ end
+else if (pop_typ2 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit2,pop_typ2,stk_str);
+ push_lit_stk (s_null, stk_str);
+ end
+else if (pop_lit1 <= 0) then
+ begin
+ push_lit_stk (s_null, stk_str);
+ return;
+ end
+else
+ @<Form the appropriate prefix@>;
+exit:
+end;
+
+
+@
+@^push the literal stack@>
+This module finds the prefix as described in the last section, and
+appends any needed matching |right_brace|s.
+
+@<Form the appropriate prefix@>=
+begin
+sp_ptr := str_start[pop_lit2];
+sp_end := str_start[pop_lit2+1]; {this may change}
+@<Scan the appropriate number of characters@>;
+if (pop_lit2 >= cmd_str_ptr) then {no shifting---merely change pointers}
+ pool_ptr := sp_end
+else
+ while (sp_ptr < sp_end) do {shift the substring}
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
+while (sp_brace_level > 0) do {add matching |right_brace|s}
+ begin
+ append_char (right_brace);
+ decr(sp_brace_level);
+ end;
+push_lit_stk (make_string, stk_str); {and push it onto the stack}
+end
+
+
+@
+@^special character@>
+This section scans |pop_lit1| text characters, where an entire special
+character counts as a single text character (even if it's missing its
+matching |right_brace|), and where braces don't count as text
+characters.
+
+@<Scan the appropriate number of characters@>=
+begin
+num_text_chars := 0;
+sp_brace_level := 0;
+sp_xptr1 := sp_ptr;
+while ((sp_xptr1 < sp_end) and (num_text_chars < pop_lit1)) do
+ begin
+ incr(sp_xptr1);
+ if (str_pool[sp_xptr1-1] = left_brace) then
+ begin
+ incr(sp_brace_level);
+ if ((sp_brace_level = 1) and (sp_xptr1 < sp_end)) then
+ if (str_pool[sp_xptr1] = backslash) then
+ begin
+ incr(sp_xptr1); {skip over the |backslash|}
+ while ((sp_xptr1 < sp_end) and (sp_brace_level > 0)) do
+ begin
+ if (str_pool[sp_xptr1] = right_brace) then
+ decr(sp_brace_level)
+ else if (str_pool[sp_xptr1] = left_brace) then
+ incr(sp_brace_level);
+ incr(sp_xptr1);
+ end;
+ incr(num_text_chars);
+ end;
+ end
+ else if (str_pool[sp_xptr1-1] = right_brace) then
+ begin
+ if (sp_brace_level > 0) then
+ decr(sp_brace_level);
+ end
+ else
+ incr(num_text_chars);
+ end;
+sp_end := sp_xptr1;
+end
+
+
+@
+The |built_in| function {\.{top\$}} pops and prints the top of the
+stack.
+
+@<|execute_fn|({\.{top\$}})@>=
+begin
+pop_top_and_print;
+end
+
+
+@
+The |built_in| function {\.{type\$}} pushes the appropriate string
+from |type_list| onto the stack (unless either it's |undefined| or
+|empty|, in which case it pushes the null string).
+
+@<|execute_fn|({\.{type\$}})@>=
+procedure x_type;
+begin
+if (not mess_with_entries) then
+ bst_cant_mess_with_entries_print
+ else
+ if ((type_list[cite_ptr] = undefined) or
+ (type_list[cite_ptr] = empty)) then
+ push_lit_stk (s_null, stk_str)
+ else
+ push_lit_stk (hash_text[type_list[cite_ptr]], stk_str);
+end;
+
+
+@
+The |built_in| function {\.{warning\$}} pops the top (string) literal
+and prints it following a warning message. This is implemented as a
+special |built_in| function rather than using the {\.{top\$}} function
+so that it can |mark_warning|.
+
+@<|execute_fn|({\.{warning\$}})@>=
+procedure x_warning;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_str) then
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str)
+else
+ begin
+ print ('Warning--');
+ print_lit (pop_lit1,pop_typ1);
+ mark_warning;
+ end;
+end;
+
+
+@
+The |built_in| function {\.{while\$}} pops the top two (function)
+literals, and keeps executing the second as long as the (integer)
+value left on the stack by executing the first is greater than 0. If
+either type is incorrect, it complains but does nothing else.
+
+@<|execute_fn|({\.{while\$}})@>=
+begin
+pop_lit_stk (r_pop_lt1,r_pop_tp1);
+pop_lit_stk (r_pop_lt2,r_pop_tp2);
+if (r_pop_tp1 <> stk_fn) then
+ print_wrong_stk_lit (r_pop_lt1,r_pop_tp1,stk_fn)
+else if (r_pop_tp2 <> stk_fn) then
+ print_wrong_stk_lit (r_pop_lt2,r_pop_tp2,stk_fn)
+else
+ loop
+ begin
+ execute_fn (r_pop_lt2); {this is the \.{while\$} test}
+ pop_lit_stk (pop_lit1,pop_typ1);
+ if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ goto end_while;
+ end
+ else
+ if (pop_lit1 > 0) then
+ execute_fn (r_pop_lt1) {this is the \.{while\$} body}
+ else
+ goto end_while;
+ end;
+end_while: {justifies this |mean_while|}
+end
+
+
+@
+@^literal literal@>
+@^special character@>
+The |built_in| function {\.{width\$}} pops the top (string) literal
+and pushes the integer that represents its width in units specified by
+the |char_width| array. This function takes the literal literally;
+that is, it assumes each character in the string is to be printed as
+is, regardless of whether the character has a special meaning to \TeX,
+except that special characters (even without their |right_brace|s) are
+handled specially. If the literal isn't a string, it complains and
+pushes~0.
+
+@<|execute_fn|({\.{width\$}})@>=
+procedure x_width;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_str) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str);
+ push_lit_stk (0, stk_int);
+ end
+else
+ begin
+ ex_buf_length := 0;
+ add_buf_pool (pop_lit1);
+ string_width := 0;
+ @<Add up the |char_width|s in this string@>;
+ push_lit_stk (string_width, stk_int);
+ end
+end;
+
+
+@
+We use the natural width for all but special characters, and we
+complain if the string isn't brace-balanced.
+
+@<Add up the |char_width|s in this string@>=
+begin
+brace_level := 0; {we're at the top level}
+ex_buf_ptr := 0; {and the beginning of string}
+while (ex_buf_ptr < ex_buf_length) do
+ begin
+ if (ex_buf[ex_buf_ptr] = left_brace) then
+ begin
+ incr(brace_level);
+ if ((brace_level = 1) and (ex_buf_ptr + 1 < ex_buf_length)) then
+ if (ex_buf[ex_buf_ptr+1] = backslash) then
+ @<Determine the width of this special character@>
+ else
+ string_width := string_width + char_width[left_brace]
+ else
+ string_width := string_width + char_width[left_brace];
+ end
+ else if (ex_buf[ex_buf_ptr] = right_brace) then
+ begin
+ decr_brace_level (pop_lit1);
+ string_width := string_width + char_width[right_brace];
+ end
+ else
+ string_width := string_width + char_width[ex_buf[ex_buf_ptr]];
+ incr(ex_buf_ptr);
+ end;
+check_brace_level (pop_lit1);
+end
+
+
+@
+@^special character@>
+We use the natural widths of all characters except that some
+characters have no width: braces, control sequences (except for the
+usual 13 accented and foreign characters, whose widths are given in
+the next module), and |white_space| following control sequences (even
+a null control sequence).
+
+@<Determine the width of this special character@>=
+begin
+incr(ex_buf_ptr); {skip over the |left_brace|}
+while ((ex_buf_ptr < ex_buf_length) and (brace_level > 0)) do
+ begin
+ incr(ex_buf_ptr); {skip over the |backslash|}
+ ex_buf_xptr := ex_buf_ptr;
+ while ((ex_buf_ptr < ex_buf_length) and
+ (lex_class[ex_buf[ex_buf_ptr]] = alpha)) do@/
+ incr(ex_buf_ptr); {this scans the control sequence}
+ if ((ex_buf_ptr < ex_buf_length) and (ex_buf_ptr = ex_buf_xptr)) then
+ incr(ex_buf_ptr) {this skips a nonalpha control seq}
+ else
+ begin
+ control_seq_loc := str_lookup(ex_buf,ex_buf_xptr,
+ ex_buf_ptr-ex_buf_xptr,control_seq_ilk,dont_insert);
+ if (hash_found) then
+ @<Determine the width of this accented or foreign character@>;
+ end;
+ while ((ex_buf_ptr < ex_buf_length) and
+ (lex_class[ex_buf[ex_buf_ptr]] = white_space)) do
+ incr(ex_buf_ptr); {this skips following |white_space|}
+ while ((ex_buf_ptr < ex_buf_length) and (brace_level > 0) and
+ (ex_buf[ex_buf_ptr] <> backslash)) do
+ begin {this scans to the next control sequence}
+ if (ex_buf[ex_buf_ptr] = right_brace) then
+ decr(brace_level)
+ else if (ex_buf[ex_buf_ptr] = left_brace) then
+ incr(brace_level)
+ else
+ string_width := string_width + char_width[ex_buf[ex_buf_ptr]];
+ incr(ex_buf_ptr);
+ end;
+ end;
+decr(ex_buf_ptr); {unskip the |right_brace|}
+end
+
+
+@
+Five of the 13 possibilities resort to special information not present
+in the |char_width| array; the other eight simply use |char_width|'s
+information for the first letter of the control sequence.
+
+@<Determine the width of this accented or foreign character@>=
+begin
+case (ilk_info[control_seq_loc]) of
+ n_ss : string_width := string_width + ss_width;
+ n_ae : string_width := string_width + ae_width;
+ n_oe : string_width := string_width + oe_width;
+ n_ae_upper : string_width := string_width + upper_ae_width;
+ n_oe_upper : string_width := string_width + upper_oe_width;
+ othercases
+ string_width := string_width + char_width[ex_buf[ex_buf_xptr]]
+endcases;
+end
+
+
+@
+The |built_in| function {\.{write\$}} pops the top (string) literal
+and writes it onto the output buffer |out_buf| (which will result in
+stuff being written onto the \.{.bbl} file if the buffer fills up). If
+the literal isn't a string, it complains but does nothing else.
+
+@<|execute_fn|({\.{write\$}})@>=
+procedure x_write;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_str) then
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_str)
+else
+ add_out_pool (pop_lit1);
+end;
+
+
+
+@* Cleaning up.
+@^clich\'e-\`a-trois@>
+@^fat lady@>
+@^turn out lights@>
+@^Yogi@>
+This section does any last-minute printing and ends the program.
+
+@<Clean up and leave@>=
+begin
+if ((read_performed) and (not reading_completed)) then
+ begin
+ print ('Aborted at line ',bib_line_num:0,' of file ');
+ print_bib_name;
+ end;
+trace_and_stat_printing;
+@<Print the job |history|@>;
+a_close (log_file);
+{turn out the lights, the fat lady has sung; it's over, Yogi}
+end
+
+
+@
+Here we print |trace| and/or |stat| information, if desired.
+
+@<Procedures and functions for all file I/O, error messages, and such@>=
+procedure trace_and_stat_printing;
+begin
+@#
+ trace
+ @<Print all \.{.bib}- and \.{.bst}-file information@>;
+ @<Print all |cite_list| and entry information@>;
+ @<Print the |wiz_defined| functions@>;
+ @<Print the string pool@>;
+ ecart@/
+@#
+ stat
+ @<Print usage statistics@>;
+ tats@/
+@#
+end;
+
+
+@
+This prints information obtained from the \.{.aux} file about the
+other files.
+
+@<Print all \.{.bib}- and \.{.bst}-file information@>=
+begin
+if (num_bib_files = 1) then
+ trace_pr_ln ('The 1 database file is')
+ else
+ trace_pr_ln ('The ',num_bib_files:0,' database files are');
+if (num_bib_files = 0) then
+ trace_pr_ln (' undefined')
+ else
+ begin
+ bib_ptr := 0;
+ while (bib_ptr < num_bib_files) do
+ begin
+ trace_pr (' ');
+ trace_pr_pool_str (cur_bib_str);
+ trace_pr_pool_str (s_bib_extension);
+ trace_pr_newline;
+ incr(bib_ptr);
+ end;
+ end;
+trace_pr ('The style file is ');
+if (bst_str = 0) then
+ trace_pr_ln ('undefined')
+ else
+ begin
+ trace_pr_pool_str (bst_str);
+ trace_pr_pool_str (s_bst_extension);
+ trace_pr_newline;
+ end;
+end
+
+
+@
+In entry-sorted order, this prints an entry's |cite_list| string and,
+indirectly, its entry type and entry variables.
+
+@<Print all |cite_list| and entry information@>=
+begin
+if (all_entries) then
+ trace_pr ('all_marker=',all_marker:0,', ');
+if (read_performed) then
+ trace_pr_ln ('old_num_cites=',old_num_cites:0)
+ else
+ trace_pr_newline;
+trace_pr ('The ',num_cites:0);
+if (num_cites = 1) then
+ trace_pr_ln (' entry:')
+ else
+ trace_pr_ln (' entries:');
+if (num_cites = 0) then
+ trace_pr_ln (' undefined')
+ else
+ begin
+ sort_cite_ptr := 0;
+ while (sort_cite_ptr < num_cites) do
+ begin
+ if (not read_completed) then {we didn't finish the \.{read} command}
+ cite_ptr := sort_cite_ptr
+ else
+ cite_ptr := sorted_cites[sort_cite_ptr];
+ trace_pr_pool_str (cur_cite_str);
+ if (read_performed) then
+ @<Print entry information@>
+ else
+ trace_pr_newline;
+ incr(sort_cite_ptr);
+ end;
+ end;
+end
+
+
+@
+This prints information gathered while reading the \.{.bst} and
+\.{.bib} files.
+
+@<Print entry information@>=
+begin
+trace_pr (', entry-type ');
+if (type_list[cite_ptr] = undefined) then
+ undefined : trace_pr ('unknown')
+else if (type_list[cite_ptr] = empty) then
+ trace_pr ('--- no type found')
+else
+ trace_pr_pool_str (hash_text[type_list[cite_ptr]]);
+trace_pr_ln (', has entry strings');
+@<Print entry strings@>;
+trace_pr (' has entry integers');
+@<Print entry integers@>;
+trace_pr_ln (' and has fields');
+@<Print fields@>;
+end
+
+
+@
+This prints, for the current entry, the strings declared by the
+\.{entry} command.
+
+@<Print entry strings@>=
+begin
+if (num_ent_strs = 0) then
+ trace_pr_ln (' undefined')
+else if (not read_completed) then
+ trace_pr_ln (' uninitialized')
+else
+ begin
+ str_ent_ptr := cite_ptr * num_ent_strs;
+ while (str_ent_ptr < (cite_ptr+1)*num_ent_strs) do
+ begin
+ ent_chr_ptr := 0;
+ trace_pr (' "');
+ while (entry_strs[str_ent_ptr][ent_chr_ptr] <> end_of_string) do
+ begin
+ trace_pr (xchr[entry_strs[str_ent_ptr][ent_chr_ptr]]);
+ incr(ent_chr_ptr);
+ end;
+ trace_pr_ln ('"');
+ incr(str_ent_ptr);
+ end;
+ end;
+end
+
+
+@
+This prints, for the current entry, the integers declared by the
+\.{entry} command.
+
+@<Print entry integers@>=
+begin
+if (num_ent_ints = 0) then
+ trace_pr (' undefined')
+else if (not read_completed) then
+ trace_pr (' uninitialized')
+else
+ begin
+ int_ent_ptr := cite_ptr*num_ent_ints;
+ while (int_ent_ptr < (cite_ptr+1)*num_ent_ints) do
+ begin
+ trace_pr (' ',entry_ints[int_ent_ptr]:0);
+ incr(int_ent_ptr);
+ end;
+ end;
+trace_pr_newline;
+end
+
+
+@
+This prints the fields stored for the current entry.
+
+@<Print fields@>=
+begin
+if (not read_performed) then
+ trace_pr_ln (' uninitialized')
+ else
+ begin
+ field_ptr := cite_ptr * num_fields;
+ field_end_ptr := field_ptr + num_fields;
+ no_fields := true;
+ while (field_ptr < field_end_ptr) do
+ begin
+ if (field_info[field_ptr] <> missing) then
+ begin
+ trace_pr (' "');
+ trace_pr_pool_str (field_info[field_ptr]);
+ trace_pr_ln ('"');
+ no_fields := false;
+ end;
+ incr(field_ptr);
+ end;
+ if (no_fields) then
+ trace_pr_ln (' missing');
+ end;
+end
+
+
+@
+This gives all the |wiz_defined| functions that appeared in the
+\.{.bst} file.
+
+@<Print the |wiz_defined| functions@>=
+begin
+trace_pr_ln ('The wiz-defined functions are');
+if (wiz_def_ptr = 0) then
+ trace_pr_ln (' nonexistent')
+ else
+ begin
+ wiz_fn_ptr := 0;
+ while (wiz_fn_ptr < wiz_def_ptr) do
+ begin
+ if (wiz_functions[wiz_fn_ptr] = end_of_def) then
+ trace_pr_ln (wiz_fn_ptr:0,'--end-of-def--')
+ else if (wiz_functions[wiz_fn_ptr] = quote_next_fn) then
+ trace_pr (wiz_fn_ptr:0,' quote_next_function ')
+ else
+ begin
+ trace_pr (wiz_fn_ptr:0,' `');
+ trace_pr_pool_str (hash_text[wiz_functions[wiz_fn_ptr]]);
+ trace_pr_ln ('''');
+ end;
+ incr(wiz_fn_ptr);
+ end;
+ end;
+end
+
+
+@
+This includes all the `static' strings (that is, those that are also
+in the hash table), but none of the dynamic strings (that is, those
+put on the stack while executing \.{.bst} commands).
+
+@<Print the string pool@>=
+begin
+trace_pr_ln ('The string pool is');
+str_num := 1;
+while (str_num < str_ptr) do
+ begin
+ trace_pr (str_num:4, str_start[str_num]:6,' "');
+ trace_pr_pool_str (str_num);
+ trace_pr_ln ('"');
+ incr(str_num);
+ end;
+end
+
+
+@
+@^statistics@>
+These statistics can help determine how large some of the constants
+should be and can tell how useful certain |built_in| functions are.
+They are written to the same files as tracing information.
+
+@d stat_pr == trace_pr
+@d stat_pr_ln == trace_pr_ln
+@d stat_pr_pool_str == trace_pr_pool_str
+
+@<Print usage statistics@>=
+begin
+stat_pr ('You''ve used ',num_cites:0);
+if (num_cites = 1) then
+ stat_pr_ln (' entry,')
+ else
+ stat_pr_ln (' entries,');
+stat_pr_ln (' ',wiz_def_ptr:0,' wiz_defined-function locations,');
+stat_pr_ln (' ',str_ptr:0,' strings with ',str_start[str_ptr]:0,
+ ' characters,');
+blt_in_ptr := 0;
+total_ex_count := 0;
+while (blt_in_ptr < num_blt_in_fns) do
+ begin
+ total_ex_count := total_ex_count + execution_count[blt_in_ptr];
+ incr(blt_in_ptr);
+ end;
+stat_pr_ln ('and the built_in function-call counts, ', total_ex_count:0,
+ ' in all, are:');
+blt_in_ptr := 0;
+while (blt_in_ptr < num_blt_in_fns) do
+ begin
+ stat_pr_pool_str (hash_text[blt_in_loc[blt_in_ptr]]);
+ stat_pr_ln (' -- ',execution_count[blt_in_ptr]:0);
+ incr(blt_in_ptr);
+ end;
+end
+
+
+@
+@^bunk, history@>
+@^system dependencies@>
+@:this can't happen}{\quad History is bunk@>
+Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+
+@<Print the job |history|@>=
+case (history) of
+ spotless : do_nothing;
+ warning_message : begin
+ if (err_count = 1) then
+ print_ln ('(There was 1 warning)')
+ else
+ print_ln ('(There were ',err_count:0,' warnings)');
+ end;
+ error_message : begin
+ if (err_count = 1) then
+ print_ln ('(There was 1 error message)')
+ else
+ print_ln ('(There were ',err_count:0,
+ ' error messages)');
+ end;
+ fatal_message : print_ln ('(That was a fatal error)');
+ othercases begin
+ print ('History is bunk');
+ print_confusion;
+ end
+endcases
+
+
+
+@* System-dependent changes.
+@^system dependencies@>
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \BibTeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+
+
+
+@* Index.
+@.this can't happen@>
+Here is where you can find all uses of each identifier in the program,
+with underlined entries pointing to where the identifier was defined.
+If the identifier is only one letter long, however, you get to see only
+the underlined entries. All references are to section numbers instead of
+page numbers.
+
+This index also lists a few error messages and other aspects of the
+program that you might want to look up some day. For example, the
+entry for ``system dependencies'' lists all sections that should
+receive special attention from people who are installing \TeX\ in a
+new operating environment. A list of various things that can't happen
+appears under ``this can't happen''$\!$.
diff --git a/Build/source/texk/web2c/c-auto.in b/Build/source/texk/web2c/c-auto.in
new file mode 100644
index 00000000000..79f4540184d
--- /dev/null
+++ b/Build/source/texk/web2c/c-auto.in
@@ -0,0 +1,105 @@
+/* c-auto.in. Generated automatically from configure.in by autoheader 2.13. */
+/* acconfig.h -- used by autoheader when generating c-auto.in.
+
+ If you're thinking of editing acconfig.h to fix a configuration
+ problem, don't. Edit the c-auto.h file created by configure,
+ instead. Even better, fix configure to give the right answer. */
+
+/* Guard against double inclusion. */
+#ifndef WEB2C_C_AUTO_H
+#define WEB2C_C_AUTO_H
+
+/* web2c: the version string. */
+#define WEB2CVERSION "REPLACE-WITH-WEB2CVERSION"
+
+
+/* Define if type char is unsigned and you are not using gcc. */
+#ifndef __CHAR_UNSIGNED__
+#undef __CHAR_UNSIGNED__
+#endif
+
+/* Define as __inline if that's what the C compiler calls it. */
+#undef inline
+
+/* Define as the return type of signal handlers (int or void). */
+#undef RETSIGTYPE
+
+/* Define if your processor stores words with the most significant
+ byte first (like Motorola and SPARC, unlike Intel and VAX). */
+#undef WORDS_BIGENDIAN
+
+/* Define if the X Window System is missing or not being used. */
+#undef X_DISPLAY_MISSING
+
+/* Define if lex declares yytext as a char [] by default. */
+#undef YYTEXT_CHAR
+
+/* Define if lex declares yytext as a char * by default, not a char[]. */
+#undef YYTEXT_POINTER
+
+/* Define if lex declares yytext as a unsigned char [] by default. */
+#undef YYTEXT_UCHAR
+
+/* tex: Define to enable --ipc. */
+#undef IPC
+
+/* web2c: Define if gcc asm needs _ on external symbols. */
+#undef ASM_NEEDS_UNDERSCORE
+
+/* web2c: Define to enable HackyInputFileNameForCoreDump.tex. */
+#undef FUNNY_CORE_DUMP
+
+/* web2c: Define to disable architecture-independent dump files.
+ Faster on LittleEndian architectures. */
+#undef NO_DUMP_SHARE
+
+/* web2c: Default editor for interactive `e' option. */
+#define EDITOR "vi +%d %s"
+
+/* web2c: Window system support for Metafont. */
+#undef EPSFWIN
+#undef HP2627WIN
+#undef MFTALKWIN
+#undef NEXTWIN
+#undef REGISWIN
+#undef SUNWIN
+#undef TEKTRONIXWIN
+#undef UNITERMWIN
+#undef X11WIN
+
+/* The number of bytes in a long. */
+#undef SIZEOF_LONG
+
+/* Define if you have the ftime function. */
+#undef HAVE_FTIME
+
+/* Define if you have the gettimeofday function. */
+#undef HAVE_GETTIMEOFDAY
+
+/* Define if you have the mkstemp function. */
+#undef HAVE_MKSTEMP
+
+/* Define if you have the mktemp function. */
+#undef HAVE_MKTEMP
+
+/* Define if you have the strerror function. */
+#undef HAVE_STRERROR
+
+/* Define if you have the <sys/time.h> header file. */
+#undef HAVE_SYS_TIME_H
+
+/* Define if you have the <sys/timeb.h> header file. */
+#undef HAVE_SYS_TIMEB_H
+
+/* Define if you have the <zlib.h> header file. */
+#undef HAVE_ZLIB_H
+
+/* Define if you have the m library (-lm). */
+#undef HAVE_LIBM
+
+/* Define if you have the posix library (-lposix). */
+#undef HAVE_LIBPOSIX
+
+/* Define if you have the z library (-lz). */
+#undef HAVE_LIBZ
+#endif /* !WEB2C_C_AUTO_H */
diff --git a/Build/source/texk/web2c/config.h b/Build/source/texk/web2c/config.h
new file mode 100644
index 00000000000..2c5933fea90
--- /dev/null
+++ b/Build/source/texk/web2c/config.h
@@ -0,0 +1,117 @@
+/* config.h: All .c files include this first.
+
+Copyright (C) 1995, 96 Karl Berry.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef WEB2C_CONFIG_H
+#define WEB2C_CONFIG_H
+
+#if defined (TEX_DLL) && (defined (WIN32) || defined (__CYGWIN__))
+#ifdef MAKE_TEX_DLL
+#define TEXDLL __declspec (dllexport)
+#else /* ! MAKE_TEX_DLL */
+#define TEXDLL __declspec (dllimport)
+#endif
+#else /* ! (TEX_DLL && (WIN32 || __CYGWIN__)) */
+#define TEXDLL
+#endif
+
+/* The stuff from the path searching library. */
+#include <kpathsea/config.h>
+#include <web2c/c-auto.h>
+
+#include <kpathsea/c-vararg.h>
+
+/* How to open a binary file. */
+#include <kpathsea/c-fopen.h>
+
+/* The smallest signed type: use `signed char' if ANSI C, `short' if
+ char is unsigned, otherwise `char'. */
+#ifndef SCHAR_TYPE
+#if __STDC__
+#define SCHAR_TYPE signed char
+#else /* not __STDC */
+#ifdef __CHAR_UNSIGNED__
+#define SCHAR_TYPE short
+#else
+#define SCHAR_TYPE char
+#endif
+#endif /* not __STDC__ */
+#endif /* not SCHAR_TYPE */
+typedef SCHAR_TYPE schar;
+
+/* The type `integer' must be a signed integer capable of holding at
+ least the range of numbers (-2^31)..(2^31-1). If your compiler goes
+ to great lengths to make programs fail, you might have to change this
+ definition. If this changes, you may have to modify
+ web2c/fixwrites.c, since it generates code to do integer output using
+ "%ld", and casts all integral values to be printed to `long'.
+
+ If you define your own INTEGER_TYPE, you have to define your own
+ INTEGER_MAX and INTEGER_MIN, too. */
+#ifndef INTEGER_TYPE
+
+#if SIZEOF_LONG > 4 && !defined (NO_DUMP_SHARE)
+/* If we have 64-bit longs and want to share format files (with 32-bit
+ machines), use `int'. */
+#define INTEGER_IS_INT
+#endif
+
+#ifdef INTEGER_IS_INT
+#define INTEGER_TYPE int
+#define INTEGER_MAX INT_MAX
+#define INTEGER_MIN INT_MIN
+#else
+#define INTEGER_TYPE long
+#define INTEGER_MAX LONG_MAX
+#define INTEGER_MIN LONG_MIN
+#endif /* not INTEGER_IS_INT */
+
+#endif /* not INTEGER_TYPE */
+
+typedef INTEGER_TYPE integer;
+
+/* I don't want to write a configure test for remove when all Unix
+ machines have unlink. But, for the sake of non-Unix machines that
+ support ANSI C... */
+#if !defined (unix) && !defined (__unix__) && defined (__STDC__) && !defined (unlink)
+#define unlink remove
+#endif
+
+/* Window support on the Amiga is just for the Amiga. */
+#ifdef AMIGA
+#define AMIGAWIN
+#endif
+
+/* Window support for WIN32 machines. */
+#ifdef WIN32
+#define WIN32WIN
+#endif
+
+/* strtol.c */
+#ifndef HAVE_STRTOL
+extern long strtol P3H(const char *, char **, int);
+#endif
+
+/* From uexit.c. This is here because the lib/ and web2c/ routines
+ themselves can use it, but they don't need cpascal.h. */
+extern void uexit P1H(int status);
+
+/* usage.c */
+extern void usage P1H(const_string progname);
+extern void usagehelp P2H(const_string *message, const_string bug_email);
+
+#endif /* not CONFIG_H */
diff --git a/Build/source/texk/web2c/configure b/Build/source/texk/web2c/configure
new file mode 100755
index 00000000000..efaab7924de
--- /dev/null
+++ b/Build/source/texk/web2c/configure
@@ -0,0 +1,5117 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --without-etex don't compile and install e-TeX"
+ac_help="$ac_help
+ --without-omega don't compile and install Omega"
+ac_help="$ac_help
+ --without-aleph don't compile and install Aleph"
+ac_help="$ac_help
+ --without-pdftex don't compile and install pdfTeX"
+ac_help="$ac_help
+ --without-pdfetex don't compile and install pdfeTeX"
+ac_help="$ac_help
+ --with-cxx-runtime-hack link C++ runtime statically"
+ac_help="$ac_help
+ --with-editor=CMD invoke CMD from the e option [vi +%d %s]"
+ac_help="$ac_help
+ --enable-ipc enable TeX's --ipc option, i.e., pipe to a program"
+ac_help="$ac_help
+ --enable-auto-core cause TeX&MF to dump core given a certain filename"
+ac_help="$ac_help
+ --disable-dump-share make fmt/base/mem files architecture-dependent"
+ac_help="$ac_help
+ --enable-fmtutil use fmtutil for build dumps"
+ac_help="$ac_help
+ --with-mf-nowin build a separate non-windows-capable METAFONT"
+ac_help="$ac_help
+ --with-epsfwin include EPSF pseudo-window support"
+ac_help="$ac_help
+ --with-hp2627win include HP 2627 window support in Metafont"
+ac_help="$ac_help
+ --with-mftalkwin include mftalk (generic server) window support"
+ac_help="$ac_help
+ --with-nextwin include NeXT window support"
+ac_help="$ac_help
+ --with-regiswin include Regis window support"
+ac_help="$ac_help
+ --with-suntoolswin include old Suntools window support (this is not X)"
+ac_help="$ac_help
+ --with-tektronixwin include Tektronix window support"
+ac_help="$ac_help
+ --with-unitermwin include Uniterm window support"
+ac_help="$ac_help
+ --with-x-toolkit=KIT OBSOLETE: use --with-mf-x-toolkit and/or
+ --with-xdvi-x-toolkit instead."
+ac_help="$ac_help
+ --with-x11win same as --with-x"
+ac_help="$ac_help
+ --with-x11 same as --with-x"
+ac_help="$ac_help
+ --with-mf-x-toolkit Use X toolkit for mf."
+ac_help="$ac_help
+ --enable-maintainer-mode enable make rules and dependencies not useful
+ (and sometimes confusing) to the casual installer"
+ac_help="$ac_help
+ --without-mktexmf-default do not run mktexmf if MF source missing"
+ac_help="$ac_help
+ --without-mktexpk-default do not run mktexpk if PK font missing"
+ac_help="$ac_help
+ --without-mktextfm-default do not run mktextfm if TFM file missing"
+ac_help="$ac_help
+ --without-mkocp-default do not run mkocp if OCP file missing"
+ac_help="$ac_help
+ --without-mkofm-default do not run mkofm if OFM file missing"
+ac_help="$ac_help
+ --with-mktexfmt-default run mktexfmt if format file missing"
+ac_help="$ac_help
+ --with-mktextex-default run mktextex if TeX source missing"
+ac_help="$ac_help
+ --with-system-zlib use installed zlib library"
+ac_help="$ac_help
+ --with-zlib-libdir=DIR
+ Specify directory where the zlib.a resides."
+ac_help="$ac_help
+ --with-zlib-include=DIR
+ Specify the zlib header files location."
+ac_help="$ac_help
+ --with-system-pnglib use installed pnglib library"
+ac_help="$ac_help
+ --with-pnglib-libdir=DIR
+ Specify directory where the png library (libpng.a) resides."
+ac_help="$ac_help
+ --with-pnglib-include=DIR
+ Specify the pnglib header files location."
+ac_help="$ac_help
+ --with-x use the X Window System"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+ac_config_files=
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *=*)
+ ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_envvar| sed 's/[_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: invalid variable name: $ac_envvar" 1>&2; exit 1; }
+ fi
+ ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
+ eval "$ac_envvar='$ac_optarg'"
+ export $ac_envvar ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=web2c/main.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+WEB2CVERSION=7.5.5
+
+cat >> confdefs.h <<EOF
+#define WEB2CVERSION " (Web2C $WEB2CVERSION)"
+EOF
+
+
+
+
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:633: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:664: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:716: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:749: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 760 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:765: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:791: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:796: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:805: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:824: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ case $ac_dir in
+ /*|[A-z]:/*) ac_aux_dir=$ac_dir;;
+ *) ac_aux_dir=`pwd`/$ac_dir;;
+ esac
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ case $ac_dir in
+ /*|[A-z]:/*) ac_aux_dir=$ac_dir;;
+ *) ac_aux_dir=`pwd`/$ac_dir;;
+ esac
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:892: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ # Hack for MSDOS and descendants.
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test $ac_x $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+echo $ac_n "checking whether ln -s works""... $ac_c" 1>&6
+echo "configure:947: checking whether ln -s works" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_LN_S'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ rm -f conftestdata
+# MS-DOS is a special case, because it sort of pretends that ln -s
+# works for executables.
+if test -z "$COMSPEC" && ln -s X conftestdata 2>/dev/null
+then
+ rm -f conftestdata
+ ac_cv_prog_LN_S="ln -s"
+else
+ ac_cv_prog_LN_S=ln
+fi
+fi
+LN_S="$ac_cv_prog_LN_S"
+if test "$ac_cv_prog_LN_S" = "ln -s"; then
+ echo "$ac_t""yes" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:970: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+for ac_prog in 'bison -y' byacc
+do
+# Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1002: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_YACC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$YACC"; then
+ ac_cv_prog_YACC="$YACC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_prog_YACC="$ac_prog"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+YACC="$ac_cv_prog_YACC"
+if test -n "$YACC"; then
+ echo "$ac_t""$YACC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+test -n "$YACC" && break
+done
+test -n "$YACC" || YACC="yacc"
+
+# Extract the first word of "flex", so it can be a program name with args.
+set dummy flex; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1036: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_LEX'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$LEX"; then
+ ac_cv_prog_LEX="$LEX" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_prog_LEX="flex"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_LEX" && ac_cv_prog_LEX="lex"
+fi
+fi
+LEX="$ac_cv_prog_LEX"
+if test -n "$LEX"; then
+ echo "$ac_t""$LEX" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$LEXLIB"
+then
+ case "$LEX" in
+ flex*) ac_lib=fl ;;
+ *) ac_lib=l ;;
+ esac
+ echo $ac_n "checking for yywrap in -l$ac_lib""... $ac_c" 1>&6
+echo "configure:1071: checking for yywrap in -l$ac_lib" >&5
+ac_lib_var=`echo $ac_lib'_'yywrap | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-l$ac_lib $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1079 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char yywrap();
+
+int main() {
+yywrap()
+; return 0; }
+EOF
+if { (eval echo configure:1090: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ LEXLIB="-l$ac_lib"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+# Work around a problem with Flex Version 2.5.31 which needs -l flag.
+# Since all recent versions of flex support -l, don't check for the
+# specific version, but check that at least "--version" is supported.
+# We also want to catch LEX=/some/where/flex, so:
+case $LEX in
+ *flex) $LEX --version >/dev/null 2>&1 && LEX="$LEX -l" ;;
+esac
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1122: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1151: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1166 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1172: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1183 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1189: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1200 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1206: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+for ac_hdr in sys/time.h sys/timeb.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1234: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1239 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1244: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+for ac_func in strerror gettimeofday ftime mkstemp mktemp
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1273: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1278 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1301: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6
+echo "configure:1327: checking return type of signal handlers" >&5
+if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1332 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <signal.h>
+#ifdef signal
+#undef signal
+#endif
+#ifdef __cplusplus
+extern "C" void (*signal (int, void (*)(int)))(int);
+#else
+void (*signal ()) ();
+#endif
+
+int main() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:1349: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_type_signal=void
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_type_signal=int
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_type_signal" 1>&6
+cat >> confdefs.h <<EOF
+#define RETSIGTYPE $ac_cv_type_signal
+EOF
+
+
+
+# AC_DECL_YYTEXT is just used to set LEX_OUTPUT_ROOT.
+echo $ac_n "checking lex output file root""... $ac_c" 1>&6
+echo "configure:1370: checking lex output file root" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_lex_root'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # The minimal lex program is just a single line: %%. But some broken lexes
+# (Solaris, I think it was) want two %% lines, so accommodate them.
+echo '%%
+%%' | $LEX
+if test -f lex.yy.c; then
+ ac_cv_prog_lex_root=lex.yy
+elif test -f lexyy.c; then
+ ac_cv_prog_lex_root=lexyy
+else
+ { echo "configure: error: cannot find output from $LEX; giving up" 1>&2; exit 1; }
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_lex_root" 1>&6
+LEX_OUTPUT_ROOT=$ac_cv_prog_lex_root
+rm -f "${LEX_OUTPUT_ROOT}.c"
+
+echo $ac_n "checking whether yytext is a pointer""... $ac_c" 1>&6
+echo "configure:1392: checking whether yytext is a pointer" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_lex_yytext_pointer'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # POSIX says lex can declare yytext either as a pointer or an array; the
+# default is implementation-dependent. Figure out which it is, since
+# not all implementations provide the %pointer and %array declarations.
+ac_cv_prog_lex_yytext_pointer=no
+# Avoid need for the lex library; very commonly, -lfl won't be found by
+# default, and thus the link below would fail if we didn't supply yywrap,
+# which would fool configure into thinking that yytext was not
+# a char * when it really is.
+echo '%%
+%%' | $LEX
+echo "extern char *yytext;
+#ifndef yywrap
+int yywrap () { return 1; }
+#endif" >>$LEX_OUTPUT_ROOT.c
+ac_save_LIBS="$LIBS"
+LIBS="$LIBS $LEXLIB"
+cat > conftest.$ac_ext <<EOF
+#line 1413 "configure"
+#include "confdefs.h"
+`cat $LEX_OUTPUT_ROOT.c`
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:1420: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_cv_prog_lex_yytext_pointer=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+rm -f "${LEX_OUTPUT_ROOT}.c"
+
+fi
+
+echo "$ac_t""$ac_cv_prog_lex_yytext_pointer" 1>&6
+if test $ac_cv_prog_lex_yytext_pointer = yes; then
+ cat >> confdefs.h <<\EOF
+#define YYTEXT_POINTER 1
+EOF
+
+else
+echo $ac_n "checking whether yytext is an array of char""... $ac_c" 1>&6
+echo "configure:1441: checking whether yytext is an array of char" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_lex_yytext_char'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # POSIX says lex can declare yytext either as a pointer or an array; the
+# default is implementation-dependent. Figure out which it is, since
+# not all implementations provide the %pointer and %array declarations.
+ac_cv_prog_lex_yytext_char=no
+# Avoid need for the lex library; very commonly, -lfl won't be found by
+# default, and thus the link below would fail if we didn't supply yywrap,
+# which would fool configure into thinking that yytext was not
+# a char array when it really is.
+
+echo '%%
+%%' | $LEX
+echo "extern char yytext[];
+#ifndef yywrap
+int yywrap () { return 1; }
+#endif" >>$LEX_OUTPUT_ROOT.c
+
+ac_save_LIBS="$LIBS"
+LIBS="$LIBS $LEXLIB"
+cat > conftest.$ac_ext <<EOF
+#line 1464 "configure"
+#include "confdefs.h"
+`cat $LEX_OUTPUT_ROOT.c`
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:1471: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_cv_prog_lex_yytext_char=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+rm -f "${LEX_OUTPUT_ROOT}.c"
+
+fi
+
+echo "$ac_t""$ac_cv_prog_lex_yytext_char" 1>&6
+if test $ac_cv_prog_lex_yytext_char = yes; then
+cat >> confdefs.h <<\EOF
+#define YYTEXT_CHAR 1
+EOF
+
+else
+echo $ac_n "checking whether yytext is an array of unsigned char""... $ac_c" 1>&6
+echo "configure:1492: checking whether yytext is an array of unsigned char" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_lex_yytext_uchar'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # Some systems use an array of unsigned char for yytext. Figure out if that
+# happens to be the case.
+ac_cv_prog_lex_yytext_uchar=no
+# Avoid need for the lex library; very commonly, -lfl won't be found by
+# default, and thus the link below would fail if we didn't supply yywrap,
+# which would fool configure into thinking that yytext was not
+# a unsigned char array when it really is.
+
+echo '%%
+%%' | $LEX
+echo "extern unsigned char yytext[];
+#ifndef yywrap
+int yywrap () { return 1; }
+#endif" >>$LEX_OUTPUT_ROOT.c
+
+ac_save_LIBS="$LIBS"
+LIBS="$LIBS $LEXLIB"
+cat > conftest.$ac_ext <<EOF
+#line 1514 "configure"
+#include "confdefs.h"
+`cat $LEX_OUTPUT_ROOT.c`
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:1521: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_cv_prog_lex_yytext_uchar=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+rm -f "${LEX_OUTPUT_ROOT}.c"
+
+fi
+
+echo "$ac_t""$ac_cv_prog_lex_yytext_uchar" 1>&6
+if test $ac_cv_prog_lex_yytext_uchar = yes; then
+cat >> confdefs.h <<\EOF
+#define YYTEXT_UCHAR 1
+EOF
+
+fi
+fi
+fi
+
+echo $ac_n "checking whether gcc asm needs underscore""... $ac_c" 1>&6
+echo "configure:1545: checking whether gcc asm needs underscore" >&5
+if eval "test \"`echo '$''{'pb_cv_asm_underscore'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+# Older versions of GCC asm for i386 need an underscore prepended to
+# external symbols. Figure out if this is so.
+pb_cv_asm_underscore=yes
+cat > conftest.$ac_ext <<EOF
+#line 1554 "configure"
+#include "confdefs.h"
+
+extern char val ;
+extern void sub () ;
+#if defined (__i386__) && defined (__GNUC__)
+asm(" .align 4\n"
+".globl sub\n"
+"sub:\n"
+" movb \$1,val\n"
+" ret\n");
+#else
+void sub () { val = 1; }
+#endif /* assembler */
+char val ;
+
+int main() {
+sub
+; return 0; }
+EOF
+if { (eval echo configure:1574: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ pb_cv_asm_underscore=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$pb_cv_asm_underscore" 1>&6
+if test "x$pb_cv_asm_underscore" = xyes; then
+ cat >> confdefs.h <<\EOF
+#define ASM_NEEDS_UNDERSCORE 1
+EOF
+
+fi
+
+
+echo $ac_n "checking for inline""... $ac_c" 1>&6
+echo "configure:1594: checking for inline" >&5
+if eval "test \"`echo '$''{'ac_cv_c_inline'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_cv_c_inline=no
+for ac_kw in inline __inline__ __inline; do
+ cat > conftest.$ac_ext <<EOF
+#line 1601 "configure"
+#include "confdefs.h"
+
+int main() {
+} $ac_kw foo() {
+; return 0; }
+EOF
+if { (eval echo configure:1608: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_c_inline=$ac_kw; break
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+done
+
+fi
+
+echo "$ac_t""$ac_cv_c_inline" 1>&6
+case "$ac_cv_c_inline" in
+ inline | yes) ;;
+ no) cat >> confdefs.h <<\EOF
+#define inline
+EOF
+ ;;
+ *) cat >> confdefs.h <<EOF
+#define inline $ac_cv_c_inline
+EOF
+ ;;
+esac
+
+
+echo $ac_n "checking for loader (symbol LD)""... $ac_c" 1>&6
+echo "configure:1635: checking for loader (symbol LD)" >&5
+if eval "test \"`echo '$''{'cf_cv_subst_LD'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+test -z "$LD" && LD=ld
+cf_cv_subst_LD=$LD
+fi
+
+LD=${cf_cv_subst_LD}
+echo "$ac_t""$LD" 1>&6
+
+
+echo $ac_n "checking for archiver (symbol AR)""... $ac_c" 1>&6
+echo "configure:1649: checking for archiver (symbol AR)" >&5
+if eval "test \"`echo '$''{'cf_cv_subst_AR'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+test -z "$AR" && AR=ar
+cf_cv_subst_AR=$AR
+fi
+
+AR=${cf_cv_subst_AR}
+echo "$ac_t""$AR" 1>&6
+
+
+echo $ac_n "checking for archiver options (symbol ARFLAGS)""... $ac_c" 1>&6
+echo "configure:1663: checking for archiver options (symbol ARFLAGS)" >&5
+if eval "test \"`echo '$''{'cf_cv_subst_ARFLAGS'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+test -z "$ARFLAGS" && ARFLAGS=rc
+cf_cv_subst_ARFLAGS=$ARFLAGS
+fi
+
+ARFLAGS=${cf_cv_subst_ARFLAGS}
+echo "$ac_t""$ARFLAGS" 1>&6
+
+
+
+# Needed on A/UX 3.0. I don't want to pull in other -lposix's, though.
+# From: bernt@weinberg.pop.bio.aau.dk (Bernt Guldbrandtsen)
+if test `(uname) 2>/dev/null` = aux; then
+ echo $ac_n "checking for sigemptyset in -lposix""... $ac_c" 1>&6
+echo "configure:1681: checking for sigemptyset in -lposix" >&5
+ac_lib_var=`echo posix'_'sigemptyset | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lposix $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1689 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char sigemptyset();
+
+int main() {
+sigemptyset()
+; return 0; }
+EOF
+if { (eval echo configure:1700: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_lib=HAVE_LIB`echo posix | sed -e 's/[^a-zA-Z0-9_]/_/g' \
+ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_lib 1
+EOF
+
+ LIBS="-lposix $LIBS"
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+
+
+ZZ=
+if test "$cross_compiling" = yes &&
+ (test "x$CC" = "xdos-gcc" || test "x$CC" = "xi386-mingw32-gcc" || test "x$CC" = "xgnuwin32gcc") ; then
+ZZ=$CC
+unset CC
+cross_compiling=no
+fi
+
+echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6
+echo "configure:1740: checking whether char is unsigned" >&5
+if eval "test \"`echo '$''{'ac_cv_c_char_unsigned'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$GCC" = yes; then
+ # GCC predefines this symbol on systems where it applies.
+cat > conftest.$ac_ext <<EOF
+#line 1747 "configure"
+#include "confdefs.h"
+#ifdef __CHAR_UNSIGNED__
+ yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "yes" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_c_char_unsigned=yes
+else
+ rm -rf conftest*
+ ac_cv_c_char_unsigned=no
+fi
+rm -f conftest*
+
+else
+if test "$cross_compiling" = yes; then
+ { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1769 "configure"
+#include "confdefs.h"
+/* volatile prevents gcc2 from optimizing the test away on sparcs. */
+#if !defined(__STDC__) || __STDC__ != 1
+#define volatile
+#endif
+main() {
+ volatile char c = 255; exit(c < 0);
+}
+EOF
+if { (eval echo configure:1779: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_c_char_unsigned=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_c_char_unsigned=no
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_c_char_unsigned" 1>&6
+if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then
+ cat >> confdefs.h <<\EOF
+#define __CHAR_UNSIGNED__ 1
+EOF
+
+fi
+
+echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6
+echo "configure:1803: checking whether byte ordering is bigendian" >&5
+if eval "test \"`echo '$''{'ac_cv_c_bigendian'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_cv_c_bigendian=unknown
+# See if sys/param.h defines the BYTE_ORDER macro.
+cat > conftest.$ac_ext <<EOF
+#line 1810 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
+ bogus endian macros
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:1821: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ # It does; now see whether it defined to BIG_ENDIAN or not.
+cat > conftest.$ac_ext <<EOF
+#line 1825 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if BYTE_ORDER != BIG_ENDIAN
+ not big endian
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:1836: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_c_bigendian=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_c_bigendian=no
+fi
+rm -f conftest*
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+if test $ac_cv_c_bigendian = unknown; then
+if test "$cross_compiling" = yes; then
+ { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1856 "configure"
+#include "confdefs.h"
+main () {
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long l;
+ char c[sizeof (long)];
+ } u;
+ u.l = 1;
+ exit (u.c[sizeof (long) - 1] == 1);
+}
+EOF
+if { (eval echo configure:1869: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_c_bigendian=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_c_bigendian=yes
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_c_bigendian" 1>&6
+if test $ac_cv_c_bigendian = yes; then
+ cat >> confdefs.h <<\EOF
+#define WORDS_BIGENDIAN 1
+EOF
+
+fi
+
+echo $ac_n "checking size of long""... $ac_c" 1>&6
+echo "configure:1893: checking size of long" >&5
+if eval "test \"`echo '$''{'ac_cv_sizeof_long'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$cross_compiling" = yes; then
+ { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1901 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+main()
+{
+ FILE *f=fopen("conftestval", "w");
+ if (!f) exit(1);
+ fprintf(f, "%d\n", sizeof(long));
+ exit(0);
+}
+EOF
+if { (eval echo configure:1912: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_sizeof_long=`cat conftestval`
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_sizeof_long=0
+fi
+rm -fr conftest*
+fi
+
+fi
+echo "$ac_t""$ac_cv_sizeof_long" 1>&6
+cat >> confdefs.h <<EOF
+#define SIZEOF_LONG $ac_cv_sizeof_long
+EOF
+
+
+
+if test "x$ZZ" = "xdos-gcc" || test "x$ZZ" = "xi386-mingw32-gcc" || test "x$ZZ" = "xgnuwin32gcc" ; then
+CC=$ZZ
+cross_compiling=yes
+fi
+
+
+# --with and --enable options.
+test "x$with_x_toolkit" = xyes && with_x=yes
+test "x$with_x_toolkit" = xxt && with_x=yes
+test "x$with_x_toolkit" = xathena && with_x=yes
+test "x$with_x" = xno && with_x_toolkit=no
+
+: ${with_x=no} # tell PATH_XTRA no X by default, if not specified.
+
+
+
+# Check whether --with-etex or --without-etex was given.
+if test "${with_etex+set}" = set; then
+ withval="$with_etex"
+ :
+fi
+
+
+# Check whether --with-omega or --without-omega was given.
+if test "${with_omega+set}" = set; then
+ withval="$with_omega"
+ :
+fi
+
+
+# Check whether --with-aleph or --without-aleph was given.
+if test "${with_aleph+set}" = set; then
+ withval="$with_aleph"
+ :
+fi
+
+
+# Check whether --with-pdftex or --without-pdftex was given.
+if test "${with_pdftex+set}" = set; then
+ withval="$with_pdftex"
+ :
+fi
+
+
+# Check whether --with-pdfetex or --without-pdfetex was given.
+if test "${with_pdfetex+set}" = set; then
+ withval="$with_pdfetex"
+ :
+fi
+
+
+# Check whether --with-cxx-runtime-hack or --without-cxx-runtime-hack was given.
+if test "${with_cxx_runtime_hack+set}" = set; then
+ withval="$with_cxx_runtime_hack"
+ :
+fi
+
+
+# Check whether --with-editor or --without-editor was given.
+if test "${with_editor+set}" = set; then
+ withval="$with_editor"
+ cat >> confdefs.h <<EOF
+#define EDITOR "$with_editor"
+EOF
+
+
+fi
+
+
+# Check whether --enable-ipc or --disable-ipc was given.
+if test "${enable_ipc+set}" = set; then
+ enableval="$enable_ipc"
+ if test "x$enableval" = xyes; then
+ cat >> confdefs.h <<\EOF
+#define IPC 1
+EOF
+
+ # -lsocket is needed on Solaris, at least. Maybe -lnsl on SCO, too?
+ # See ac_path_xtra.
+ echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:2012: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2017 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2040: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test x$ac_cv_func_connect = xno; then
+ echo $ac_n "checking for connect in -lsocket""... $ac_c" 1>&6
+echo "configure:2061: checking for connect in -lsocket" >&5
+ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2069 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+connect()
+; return 0; }
+EOF
+if { (eval echo configure:2080: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ socketlibs="-lsocket $socketlibs"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+fi
+
+fi
+
+
+
+# Check whether --enable-auto-core or --disable-auto-core was given.
+if test "${enable_auto_core+set}" = set; then
+ enableval="$enable_auto_core"
+ cat >> confdefs.h <<\EOF
+#define FUNNY_CORE_DUMP 1
+EOF
+
+fi
+
+
+# Check whether --enable-dump-share or --disable-dump-share was given.
+if test "${enable_dump_share+set}" = set; then
+ enableval="$enable_dump_share"
+ if test "x$enableval" = xno; then
+ cat >> confdefs.h <<\EOF
+#define NO_DUMP_SHARE 1
+EOF
+
+fi
+
+fi
+
+
+# Check whether --enable-fmtutil or --disable-fmtutil was given.
+if test "${enable_fmtutil+set}" = set; then
+ enableval="$enable_fmtutil"
+ :
+fi
+
+
+# Check whether --with-mf-nowin or --without-mf-nowin was given.
+if test "${with_mf_nowin+set}" = set; then
+ withval="$with_mf_nowin"
+ :
+fi
+
+
+# Window system support for Metafont.
+# Check whether --with-epsfwin or --without-epsfwin was given.
+if test "${with_epsfwin+set}" = set; then
+ withval="$with_epsfwin"
+ if test "x$withval" = xyes; then
+ cat >> confdefs.h <<\EOF
+#define EPSFWIN 1
+EOF
+
+fi
+
+fi
+
+# Check whether --with-hp2627win or --without-hp2627win was given.
+if test "${with_hp2627win+set}" = set; then
+ withval="$with_hp2627win"
+ if test "x$withval" = xyes; then
+ cat >> confdefs.h <<\EOF
+#define HP2627WIN 1
+EOF
+
+fi
+
+fi
+
+# Check whether --with-mftalkwin or --without-mftalkwin was given.
+if test "${with_mftalkwin+set}" = set; then
+ withval="$with_mftalkwin"
+ if test "x$withval" = xyes; then
+ cat >> confdefs.h <<\EOF
+#define MFTALKWIN 1
+EOF
+
+fi
+
+fi
+
+# Check whether --with-nextwin or --without-nextwin was given.
+if test "${with_nextwin+set}" = set; then
+ withval="$with_nextwin"
+ if test "x$withval" = xyes; then
+ cat >> confdefs.h <<\EOF
+#define NEXTWIN 1
+EOF
+
+fi
+
+fi
+
+# Check whether --with-regiswin or --without-regiswin was given.
+if test "${with_regiswin+set}" = set; then
+ withval="$with_regiswin"
+ if test "x$withval" = xyes; then
+ cat >> confdefs.h <<\EOF
+#define REGISWIN 1
+EOF
+
+fi
+
+fi
+
+# Check whether --with-suntoolswin or --without-suntoolswin was given.
+if test "${with_suntoolswin+set}" = set; then
+ withval="$with_suntoolswin"
+ if test "x$withval" = xyes; then
+ wlibs="-lsuntool -lsunwindow -lpixrect $wlibs"
+ cat >> confdefs.h <<\EOF
+#define SUNWIN 1
+EOF
+
+fi
+
+fi
+
+# Check whether --with-tektronixwin or --without-tektronixwin was given.
+if test "${with_tektronixwin+set}" = set; then
+ withval="$with_tektronixwin"
+ if test "x$withval" = xyes; then
+ cat >> confdefs.h <<\EOF
+#define TEKTRONIXWIN 1
+EOF
+
+fi
+
+fi
+
+# Check whether --with-unitermwin or --without-unitermwin was given.
+if test "${with_unitermwin+set}" = set; then
+ withval="$with_unitermwin"
+ if test "x$withval" = xyes; then
+ cat >> confdefs.h <<\EOF
+#define UNITERMWIN 1
+EOF
+
+fi
+
+fi
+
+
+
+# Check whether --with-x-toolkit or --without-x-toolkit was given.
+if test "${with_x_toolkit+set}" = set; then
+ withval="$with_x_toolkit"
+
+ echo "configure: warning: the --with-x-toolkit option is obsolete; please use --with-mf-x-toolkit
+and/or --with-xdvi-x-toolkit instead. (Assuming default toolkit.)" 1>&2
+ with_xdvi_x_toolkit=yes
+ with_mf_x_toolkit=yes
+
+fi
+
+
+
+# Check whether --with-x11win or --without-x11win was given.
+if test "${with_x11win+set}" = set; then
+ withval="$with_x11win"
+ with_x="$withval"
+fi
+
+# Check whether --with-x11 or --without-x11 was given.
+if test "${with_x11+set}" = set; then
+ withval="$with_x11"
+ with_x="$withval"
+fi
+
+
+
+
+# Check whether --with-mf-x-toolkit or --without-mf-x-toolkit was given.
+if test "${with_mf_x_toolkit+set}" = set; then
+ withval="$with_mf_x_toolkit"
+ case "${withval}" in
+ y | ye | yes ) val=yes ;;
+ n | no ) val=no ;;
+ * )
+echo "configure: warning: unknown --with-mf-x-toolkit argument \`$withval'; using yes." 1>&2
+ val=yes;;
+ esac
+ with_mf_x_toolkit=$val
+
+fi
+
+
+
+echo $ac_n "checking whether to enable maintainer-specific portions of Makefiles""... $ac_c" 1>&6
+echo "configure:2289: checking whether to enable maintainer-specific portions of Makefiles" >&5
+ # Check whether --enable-maintainer-mode or --disable-maintainer-mode was given.
+if test "${enable_maintainer_mode+set}" = set; then
+ enableval="$enable_maintainer_mode"
+ USE_MAINTAINER_MODE=$enableval
+else
+ USE_MAINTAINER_MODE=no
+fi
+
+ echo "$ac_t""$USE_MAINTAINER_MODE" 1>&6
+ if test "x$USE_MAINTAINER_MODE" = xyes; then
+ MAINT=
+ else
+ MAINT='#M#'
+ fi
+
+
+
+echo $ac_n "checking for loader (symbol LD)""... $ac_c" 1>&6
+echo "configure:2308: checking for loader (symbol LD)" >&5
+if eval "test \"`echo '$''{'cf_cv_subst_LD'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+test -z "$LD" && LD=ld
+cf_cv_subst_LD=$LD
+fi
+
+LD=${cf_cv_subst_LD}
+echo "$ac_t""$LD" 1>&6
+
+
+echo $ac_n "checking for archiver (symbol AR)""... $ac_c" 1>&6
+echo "configure:2322: checking for archiver (symbol AR)" >&5
+if eval "test \"`echo '$''{'cf_cv_subst_AR'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+test -z "$AR" && AR=ar
+cf_cv_subst_AR=$AR
+fi
+
+AR=${cf_cv_subst_AR}
+echo "$ac_t""$AR" 1>&6
+
+
+echo $ac_n "checking for archiver options (symbol ARFLAGS)""... $ac_c" 1>&6
+echo "configure:2336: checking for archiver options (symbol ARFLAGS)" >&5
+if eval "test \"`echo '$''{'cf_cv_subst_ARFLAGS'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+test -z "$ARFLAGS" && ARFLAGS=rc
+cf_cv_subst_ARFLAGS=$ARFLAGS
+fi
+
+ARFLAGS=${cf_cv_subst_ARFLAGS}
+echo "$ac_t""$ARFLAGS" 1>&6
+
+
+
+# Check whether --with-mktexmf-default or --without-mktexmf-default was given.
+if test "${with_mktexmf_default+set}" = set; then
+ withval="$with_mktexmf_default"
+ :
+else
+ with_mktexmf_default=yes
+fi
+
+# Check whether --with-mktexpk-default or --without-mktexpk-default was given.
+if test "${with_mktexpk_default+set}" = set; then
+ withval="$with_mktexpk_default"
+ :
+else
+ with_mktexpk_default=yes
+fi
+
+# Check whether --with-mktextfm-default or --without-mktextfm-default was given.
+if test "${with_mktextfm_default+set}" = set; then
+ withval="$with_mktextfm_default"
+ :
+else
+ with_mktextfm_default=yes
+fi
+
+# Check whether --with-mkocp-default or --without-mkocp-default was given.
+if test "${with_mkocp_default+set}" = set; then
+ withval="$with_mkocp_default"
+ :
+else
+ with_mkocp_default=yes
+fi
+
+# Check whether --with-mkofm-default or --without-mkofm-default was given.
+if test "${with_mkofm_default+set}" = set; then
+ withval="$with_mkofm_default"
+ :
+else
+ with_mkofm_default=yes
+fi
+
+# Check whether --with-mktexfmt-default or --without-mktexfmt-default was given.
+if test "${with_mktexfmt_default+set}" = set; then
+ withval="$with_mktexfmt_default"
+ :
+fi
+
+# Check whether --with-mktextex-default or --without-mktextex-default was given.
+if test "${with_mktextex_default+set}" = set; then
+ withval="$with_mktextex_default"
+ with_mktextex_default=yes
+else
+ with_mktextex_default=no
+fi
+
+
+echo $ac_n "checking where the main texmf tree is located""... $ac_c" 1>&6
+echo "configure:2406: checking where the main texmf tree is located" >&5
+texmfmain=
+if test "x$datadir" != 'x${prefix}/share'; then
+ # First case, datadir is defined...
+ eval p=\"$datadir\"
+ # Unconditionally set the directory, but...
+ texmfmain=`echo "$p/texmf" | sed 's,//*,/,g'`
+ # ... do complain if it wasn't found.
+ if test -d "$texmfmain"; then
+ echo "$ac_t"""$texmfmain"" 1>&6
+ else
+ echo "$ac_t""not found" 1>&6
+ echo "configure: warning: No texmf tree found at $texmfmain.
+ *****************************************************************
+ * Error: The main texmf tree was not found. *
+ * If you do not have the files, you should be able to them from *
+ * the same place you got these sources from, or from one of the *
+ * CTAN hosts. *
+ *****************************************************************
+ Winging it." 1>&2
+ fi
+else
+ # Second case, datadir is default...
+ if test "x$prefix" = "xNONE"; then
+ p="$ac_default_prefix"
+ else
+ eval p=\"$prefix\"
+ fi
+ for e in share/texmf lib/texmf texmf; do
+ if test -d "$p/$e"; then
+ texmfmain='${prefix}'/"$e"
+ break
+ fi
+ done
+ if test -z "$texmfmain" && test "x$prefix" = "xNONE"; then
+ # Still no texmfmain found, no prefix set, perhaps kpsewhich is
+ # installed and can help us out.
+ texmfmain=`kpsewhich --expand-path='$TEXMFMAIN'` 2>/dev/null
+ fi
+ texmfmain=`echo "$texmfmain" | sed 's,//*,/,g'`
+ if test -n "$texmfmain"; then
+ echo "$ac_t"""$texmfmain"" 1>&6
+ else
+ eval texmfmain="$datadir/texmf"
+ echo "$ac_t""not found" 1>&6
+ echo "configure: warning: The main texmf tree was not found at $texmfmain.
+ *****************************************************************
+ * Error: The main texmf tree was not found. *
+ * Use the --datadir option to specify its parent directory. *
+ * If you do not have the files, you should be able to them from *
+ * the same place you got these sources from, or from one of the *
+ * CTAN hosts. *
+ *****************************************************************
+ Winging it by pretending $texmfmain is correct." 1>&2
+ fi
+fi
+
+
+# Check whether --with-system_zlib or --without-system_zlib was given.
+if test "${with_system_zlib+set}" = set; then
+ withval="$with_system_zlib"
+ :
+fi
+
+
+# Check whether --with-zlib_libdir or --without-zlib_libdir was given.
+if test "${with_zlib_libdir+set}" = set; then
+ withval="$with_zlib_libdir"
+ :
+fi
+
+
+# Check whether --with-zlib_include or --without-zlib_include was given.
+if test "${with_zlib_include+set}" = set; then
+ withval="$with_zlib_include"
+ :
+fi
+
+
+# Check whether --with-system-pnglib or --without-system-pnglib was given.
+if test "${with_system_pnglib+set}" = set; then
+ withval="$with_system_pnglib"
+ :
+fi
+
+
+# Check whether --with-pnglib_libdir or --without-pnglib_libdir was given.
+if test "${with_pnglib_libdir+set}" = set; then
+ withval="$with_pnglib_libdir"
+ :
+fi
+
+
+# Check whether --with-pnglib_include or --without-pnglib_include was given.
+if test "${with_pnglib_include+set}" = set; then
+ withval="$with_pnglib_include"
+ :
+fi
+
+
+if test "$needs_zlib" = no; then
+ ZLIBCPPFLAGS=
+ LDZLIB=
+ ZLIBDEP=
+else
+ EXTRA_ZLIB_INCLUDE=
+ EXTRA_ZLIB_LIBDIR=
+
+ if test "$with_system_zlib" = yes; then
+ if test "x$with_zlib_libdir" != x; then
+ EXTRA_ZLIB_LIBDIR="-L$with_zlib_libdir"
+ fi
+ if test "x$with_zlib_include" != x; then
+ EXTRA_ZLIB_INCLUDE="-I$with_zlib_include"
+ fi
+ fi
+
+ OLD_LDFLAGS=$LDFLAGS
+ OLD_CPP=$CPP
+ OLD_LIBS=$LIBS
+
+ LDFLAGS="$LDFLAGS $EXTRA_ZLIB_LIBDIR"
+ CPP="$CPP $EXTRA_ZLIB_INCLUDE"
+
+ if test "$with_system_zlib" = yes; then
+ echo $ac_n "checking for inflate in -lz""... $ac_c" 1>&6
+echo "configure:2532: checking for inflate in -lz" >&5
+ac_lib_var=`echo z'_'inflate | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lz $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2540 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char inflate();
+
+int main() {
+inflate()
+; return 0; }
+EOF
+if { (eval echo configure:2551: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_lib=HAVE_LIB`echo z | sed -e 's/[^a-zA-Z0-9_]/_/g' \
+ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_lib 1
+EOF
+
+ LIBS="-lz $LIBS"
+
+else
+ echo "$ac_t""no" 1>&6
+echo "configure: warning: Standard ZLIB library not found. Compiling my own." 1>&2
+ with_system_zlib=no
+fi
+
+ fi
+
+ if test "$with_system_zlib" = yes; then
+ for ac_hdr in zlib.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:2587: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2592 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2597: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+ if test "$ac_cv_header_zlib_h" != yes; then
+ echo "configure: warning: zlib.h not found. Using my own zlib sources." 1>&2
+ with_system_zlib=no
+ fi
+ fi
+
+ LDFLAGS=$OLD_LDFLAGS
+ CPP=$OLD_CPP
+ LIBS=$OLD_LIBS
+
+ if test "$with_system_zlib" != yes; then
+ ZLIBCPPFLAGS='-I$(ZLIBDIR) -I$(ZLIBSRCDIR)'
+ LDZLIB='$(ZLIBDIR)/libz.a'
+ ZLIBDEP='$(ZLIBDIR)/libz.a'
+ using_system_zlib=no
+ else
+ ZLIBCPPFLAGS="$EXTRA_ZLIB_INCLUDE"
+ LDZLIB="$EXTRA_ZLIB_LIBDIR -lz"
+ ZLIBDEP=
+ using_system_zlib=yes
+ fi
+fi
+
+
+
+
+
+if test "$needs_pnglib" = no; then
+ LIBPNGCPPFLAGS=
+ LDLIBPNG=
+ LIBPNGDEP=
+else
+ EXTRA_LIBPNG_INCLUDE=
+ EXTRA_LIBPNG_LIBDIR=
+
+ if test "$with_system_pnglib" = yes; then
+ if test "x$with_pnglib_libdir" != x; then
+ EXTRA_LIBPNG_LIBDIR="-L$with_pnglib_libdir"
+ fi
+ if test "x$with_pnglib_include" != x; then
+ EXTRA_LIBPNG_INCLUDE="-I$with_pnglib_include"
+ fi
+ fi
+
+ OLD_LDFLAGS=$LDFLAGS
+ OLD_CPP=$CPP
+ OLD_LIBS=$LIBS
+
+ LDFLAGS="$LDFLAGS $EXTRA_LIBPNG_LIBDIR"
+ CPP="$CPP $EXTRA_LIBPNG_INCLUDE"
+
+ if test "$with_system_pnglib" = yes; then
+ echo $ac_n "checking for png_set_read_fn in -lpng""... $ac_c" 1>&6
+echo "configure:2676: checking for png_set_read_fn in -lpng" >&5
+ac_lib_var=`echo png'_'png_set_read_fn | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lpng -lz -lm $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2684 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char png_set_read_fn();
+
+int main() {
+png_set_read_fn()
+; return 0; }
+EOF
+if { (eval echo configure:2695: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ pnglib=-lpng
+else
+ echo "$ac_t""no" 1>&6
+echo "configure: warning: Standard PNG library not found. Compiling my own." 1>&2
+ with_system_pnglib=no
+fi
+
+ fi
+
+ LDFLAGS=$OLD_LDFLAGS
+ CPP=$OLD_CPP
+ LIBS=$OLD_LIBS
+
+ if test "$with_system_pnglib" != yes; then
+ LIBPNGCPPFLAGS='-I$(LIBPNGDIR) -I$(LIBPNGSRCDIR)'
+ LDLIBPNG='$(LIBPNGDIR)/libpng.a'
+ LIBPNGDEP='$(LIBPNGDIR)/libpng.a'
+ using_system_pnglib=no
+ else
+ LIBPNGCPPFLAGS="$EXTRA_LIBPNG_INCLUDE"
+ LDLIBPNG="$EXTRA_LIBPNG_LIBDIR -lpng"
+ LIBPNGDEP=
+ using_system_pnglib=yes
+ fi
+fi
+
+
+
+
+
+if test "$needs_libxpdf" = no; then
+ LIBXPDFCPPFLAGS=
+ LDLIBXPDF=
+ LIBXPDFDEP=
+else
+ LIBXPDFCPPFLAGS='-I$(LIBXPDFDIR) -I$(LIBXPDFDIR)/xpdf -I$(LIBXPDFDIR)/goo -I$(LIBXPDFDIR)/fofi -I$(LIBXPDFSRCDIR) -I$(LIBXPDFSRCDIR)/xpdf -I$(LIBXPDFSRCDIR)/goo -I$(LIBXPDFSRCDIR)/fofi'
+ LDLIBXPDF='$(LIBXPDFDIR)/xpdf/libxpdf.a $(LIBXPDFDIR)/goo/libGoo.a $(LIBXPDFDIR)/fofi/libfofi.a'
+ LIBXPDFDEP='$(LIBXPDFDIR)/xpdf/libxpdf.a $(LIBXPDFDIR)/goo/libGoo.a $(LIBXPDFDIR)/fofi/libfofi.a'
+fi
+
+
+
+
+
+
+# Whether to build mf-nowin.
+: ${with_mf_nowin=no} # Default.
+if test "x$with_mf_nowin" = xyes; then
+ MFN=
+else
+ MFN='#! '
+fi
+
+
+# For Omega.
+if test -d $srcdir/omegadir; then
+ test "${with_omega+set}" = set || with_omega=yes
+else
+ if test "x$with_omega" = xyes; then
+ echo "configure: warning: The Omega sources are not available." 1>&2
+ fi
+ with_omega=no
+fi
+if test "x$with_omega" = xyes; then
+ OMEGA=
+ ac_config_files="$ac_config_files omegafonts/Makefile otps/Makefile"
+
+else
+ OMEGA='#! '
+fi
+
+
+# For Aleph
+if test -d $srcdir/alephdir && test -d $srcdir/omegadir; then
+ test "${with_aleph+set}" = set || with_aleph=yes
+else
+ if test "x$with_aleph" = xyes; then
+ echo "configure: warning: The Aleph sources are not available." 1>&2
+ fi
+ with_aleph=no
+fi
+if test "x$with_aleph" = xyes; then
+ ALEPH=
+else
+ ALEPH='#! '
+fi
+
+
+# For pdfTeX.
+if test -d $srcdir/pdftexdir; then
+ # Create build dir, if necessary.
+ test -d pdftexdir || mkdir pdftexdir
+ test "${with_pdftex+set}" = set || with_pdftex=yes
+else
+ if test "x$with_pdftex" = xyes; then
+ echo "configure: warning: The pdfTeX sources are not available." 1>&2
+ fi
+ with_pdftex=no
+fi
+
+# For pdfeTeX
+if test -d $srcdir/pdfetexdir && test -d $srcdir/pdftexdir \
+ && test -d $srcdir/etexdir; then
+ test "${with_pdfetex+set}" = set || with_pdfetex=yes
+else
+ if test "x$with_pdfetex" = xyes; then
+ echo "configure: warning: Not all sources of pdfeTeX are available." 1>&2
+ fi
+ with_pdfetex=no
+fi
+
+# Check whether C++ compiler works. Prevent exit if it doesn't.
+if test "x$with_pdftex" = xyes ||
+ test "x$with_pdfetex" = xyes
+then
+ # First test whether the compiler works in a subshell, and if so,
+ # do it again in the main shell so we see the result.
+(
+ for ac_prog in $CCC c++ g++ gcc CC cxx cc++ cl
+do
+# Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:2833: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CXX'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CXX"; then
+ ac_cv_prog_CXX="$CXX" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_prog_CXX="$ac_prog"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CXX="$ac_cv_prog_CXX"
+if test -n "$CXX"; then
+ echo "$ac_t""$CXX" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+test -n "$CXX" && break
+done
+test -n "$CXX" || CXX="gcc"
+
+
+echo $ac_n "checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:2866: checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) works" >&5
+
+ac_ext=C
+# CXXFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CXXCPP $CPPFLAGS'
+ac_compile='${CXX-g++} -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CXX-g++} -o conftest${ac_exeext} $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cxx_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 2877 "configure"
+#include "confdefs.h"
+
+int main(){return(0);}
+EOF
+if { (eval echo configure:2882: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cxx_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cxx_cross=no
+ else
+ ac_cv_prog_cxx_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cxx_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cxx_works" 1>&6
+if test $ac_cv_prog_cxx_works = no; then
+ { echo "configure: error: installation or configuration problem: C++ compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:2908: checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cxx_cross" 1>&6
+cross_compiling=$ac_cv_prog_cxx_cross
+
+echo $ac_n "checking whether we are using GNU C++""... $ac_c" 1>&6
+echo "configure:2913: checking whether we are using GNU C++" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gxx'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.C <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CXX-g++} -E conftest.C'; { (eval echo configure:2922: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gxx=yes
+else
+ ac_cv_prog_gxx=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gxx" 1>&6
+
+if test $ac_cv_prog_gxx = yes; then
+ GXX=yes
+else
+ GXX=
+fi
+
+ac_test_CXXFLAGS="${CXXFLAGS+set}"
+ac_save_CXXFLAGS="$CXXFLAGS"
+CXXFLAGS=
+echo $ac_n "checking whether ${CXX-g++} accepts -g""... $ac_c" 1>&6
+echo "configure:2941: checking whether ${CXX-g++} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cxx_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.cc
+if test -z "`${CXX-g++} -g -c conftest.cc 2>&1`"; then
+ ac_cv_prog_cxx_g=yes
+else
+ ac_cv_prog_cxx_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cxx_g" 1>&6
+if test "$ac_test_CXXFLAGS" = set; then
+ CXXFLAGS="$ac_save_CXXFLAGS"
+elif test $ac_cv_prog_cxx_g = yes; then
+ if test "$GXX" = yes; then
+ CXXFLAGS="-g -O2"
+ else
+ CXXFLAGS="-g"
+ fi
+else
+ if test "$GXX" = yes; then
+ CXXFLAGS="-O2"
+ else
+ CXXFLAGS=
+ fi
+fi
+
+) && {
+ for ac_prog in $CCC c++ g++ gcc CC cxx cc++ cl
+do
+# Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:2978: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CXX'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CXX"; then
+ ac_cv_prog_CXX="$CXX" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_prog_CXX="$ac_prog"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CXX="$ac_cv_prog_CXX"
+if test -n "$CXX"; then
+ echo "$ac_t""$CXX" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+test -n "$CXX" && break
+done
+test -n "$CXX" || CXX="gcc"
+
+
+echo $ac_n "checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:3011: checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) works" >&5
+
+ac_ext=C
+# CXXFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CXXCPP $CPPFLAGS'
+ac_compile='${CXX-g++} -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CXX-g++} -o conftest${ac_exeext} $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cxx_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 3022 "configure"
+#include "confdefs.h"
+
+int main(){return(0);}
+EOF
+if { (eval echo configure:3027: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cxx_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cxx_cross=no
+ else
+ ac_cv_prog_cxx_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cxx_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cxx_works" 1>&6
+if test $ac_cv_prog_cxx_works = no; then
+ { echo "configure: error: installation or configuration problem: C++ compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:3053: checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cxx_cross" 1>&6
+cross_compiling=$ac_cv_prog_cxx_cross
+
+echo $ac_n "checking whether we are using GNU C++""... $ac_c" 1>&6
+echo "configure:3058: checking whether we are using GNU C++" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gxx'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.C <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CXX-g++} -E conftest.C'; { (eval echo configure:3067: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gxx=yes
+else
+ ac_cv_prog_gxx=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gxx" 1>&6
+
+if test $ac_cv_prog_gxx = yes; then
+ GXX=yes
+else
+ GXX=
+fi
+
+ac_test_CXXFLAGS="${CXXFLAGS+set}"
+ac_save_CXXFLAGS="$CXXFLAGS"
+CXXFLAGS=
+echo $ac_n "checking whether ${CXX-g++} accepts -g""... $ac_c" 1>&6
+echo "configure:3086: checking whether ${CXX-g++} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cxx_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.cc
+if test -z "`${CXX-g++} -g -c conftest.cc 2>&1`"; then
+ ac_cv_prog_cxx_g=yes
+else
+ ac_cv_prog_cxx_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cxx_g" 1>&6
+if test "$ac_test_CXXFLAGS" = set; then
+ CXXFLAGS="$ac_save_CXXFLAGS"
+elif test $ac_cv_prog_cxx_g = yes; then
+ if test "$GXX" = yes; then
+ CXXFLAGS="-g -O2"
+ else
+ CXXFLAGS="-g"
+ fi
+else
+ if test "$GXX" = yes; then
+ CXXFLAGS="-O2"
+ else
+ CXXFLAGS=
+ fi
+fi
+
+} || {
+ test "x$with_pdftex" = xyes \
+ && echo "configure: warning: No C++ compiler: pdfTeX will not be compiled." 1>&2
+ test "x$with_pdfetex" = xyes \
+ && echo "configure: warning: No C++ compiler: pdfeTeX will not be compiled." 1>&2
+ with_pdftex=no
+ with_pdfetex=no
+ true
+}
+fi
+
+# Check if we can link the C++ runlime lib statically. Only check, if we are
+# going to build pdf[ex]tex. And, only try the magic hack, if C++ is
+# GNU C++ (i.e. if $ac_cv_prog_gxx=yes). The reason for using a static C++
+# runtime is that binaries are more portable. That's only important if you are
+# planning to distribute binaries, so all the neat stuff is disabled by default:
+flags_try1='-nodefaultlibs -Wl,-Bstatic -lstdc++ -Wl,-Bdynamic -lm -lgcc_eh -lgcc -lc -lgcc_eh -lgcc'
+flags_try2='-nodefaultlibs -Wl,-Bstatic -lstdc++ -Wl,-Bdynamic -lm -lgcc -lc -lgcc'
+CXXLDEXTRA=
+CXXHACKLINK='$(kpathsea_cxx_link)'
+CXXHACKLDLIBS='$(LOADLIBES)'
+if test "x$with_cxx_runtime_hack" = xyes &&
+ { test "x$with_pdftex" = xyes ||
+ test "x$with_pdfetex" = xyes; }
+then
+ echo $ac_n "checking for statically linking C++ runtime library""... $ac_c" 1>&6
+echo "configure:3143: checking for statically linking C++ runtime library" >&5
+
+ cpp_link_hack=false
+ old_flags=$flags
+ old_ac_ext=$ac_ext
+ old_ac_link=$ac_link
+ if test "$ac_cv_prog_gxx" = yes; then
+
+ ac_ext=C
+ cat > conftest.$ac_ext << EOF
+#include <iostream.h>
+int main()
+{
+ cout <<"worksok\n";
+}
+EOF
+
+ for flags in "$flags_try1" "$flags_try2"; do
+ ac_link='${CXX-g++} -o conftest${ac_exeext} $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS $flags 1>&5'
+ if { (eval echo configure: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ case `(./conftest; exit) 2>/dev/null` in
+ worksok)
+ cpp_link_hack=true; break;;
+ esac
+ else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ fi
+ done
+ fi
+
+ if $cpp_link_hack; then
+ CXXLDEXTRA=$flags
+ CXXHACKLINK='$(cxx_link_command)'
+ CXXHACKLDLIBS='$(proglib) $(kpathsea_dir)/.libs/libkpathsea.a $(LIBS) $(XLOADLIBES)'
+ echo "$ac_t""ok using $flags" 1>&6
+ else
+ echo "$ac_t""not supported" 1>&6
+ fi
+
+ flags=$old_flags
+ ac_ext=$old_ac_ext
+ ac_link=$old_ac_link
+fi
+
+
+
+
+if test "x$with_pdftex" = xyes; then
+ PTEX=
+else
+ PTEX='#! '
+fi
+
+
+if test "x$with_pdfetex" = xyes; then
+ PETEX=
+else
+ PETEX='#! '
+fi
+
+
+# For e-TeX, three choices: no, yes, and tex. In the latter case, we
+# have to comment out the normal TeX build (TEX), as well as enable the
+# e-TeX build (ETEX) and the replacement of TeX with e-TeX in compatibilty
+# mode(CTEX).
+if test -d $srcdir/etexdir; then
+ # Create build dir, if necessary.
+ test -d etexdir || mkdir etexdir
+ test "${with_etex+set}" = set || with_etex=yes
+else
+ if test "x$with_etex" = xyes; then
+ echo "configure: warning: The e-TeX sources are not available." 1>&2
+ fi
+ with_etex=no
+fi
+if test "x$with_etex" = xyes; then
+ ETEX=
+else
+ ETEX='#! '
+fi
+
+
+
+# --with-x* options: Distinguish no X at all, no toolkit, or toolkit.
+# If we find X, set shell vars x_includes and x_libraries to the
+# paths, otherwise set no_x=yes.
+# Uses ac_ vars as temps to allow command line to override cache and checks.
+# --without-x overrides everything else, but does not touch the cache.
+echo $ac_n "checking for X""... $ac_c" 1>&6
+echo "configure:3233: checking for X" >&5
+
+# Check whether --with-x or --without-x was given.
+if test "${with_x+set}" = set; then
+ withval="$with_x"
+ :
+fi
+
+# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
+if test "x$with_x" = xno; then
+ # The user explicitly disabled X.
+ have_x=disabled
+else
+ if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then
+ # Both variables are already set.
+ have_x=yes
+ else
+if eval "test \"`echo '$''{'ac_cv_have_x'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # One or both of the vars are not set, and there is no cached value.
+ac_x_includes=NO ac_x_libraries=NO
+rm -fr conftestdir
+if mkdir conftestdir; then
+ cd conftestdir
+ # Make sure to not put "make" in the Imakefile rules, since we grep it out.
+ cat > Imakefile <<'EOF'
+acfindx:
+ @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"'
+EOF
+ if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then
+ # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+ eval `${MAKE-make} acfindx 2>/dev/null | grep -v make`
+ # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
+ for ac_extension in a so sl; do
+ if test ! -f $ac_im_usrlibdir/libX11.$ac_extension &&
+ test -f $ac_im_libdir/libX11.$ac_extension; then
+ ac_im_usrlibdir=$ac_im_libdir; break
+ fi
+ done
+ # Screen out bogus values from the imake configuration. They are
+ # bogus both because they are the default anyway, and because
+ # using them would break gcc on systems where it needs fixed includes.
+ case "$ac_im_incroot" in
+ /usr/include) ;;
+ *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;;
+ esac
+ case "$ac_im_usrlibdir" in
+ /usr/lib | /lib) ;;
+ *) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;;
+ esac
+ fi
+ cd ..
+ rm -fr conftestdir
+fi
+
+if test "$ac_x_includes" = NO; then
+ # Guess where to find include files, by looking for this one X11 .h file.
+ test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h
+
+ # First, try using that file with no special directory specified.
+cat > conftest.$ac_ext <<EOF
+#line 3295 "configure"
+#include "confdefs.h"
+#include <$x_direct_test_include>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:3300: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ # We can compile using X headers with no special include directory.
+ac_x_includes=
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ # Look for the header file in a standard set of common directories.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+ for ac_dir in \
+ /usr/X11/include \
+ /usr/X11R6/include \
+ /usr/X11R5/include \
+ /usr/X11R4/include \
+ \
+ /usr/include/X11 \
+ /usr/include/X11R6 \
+ /usr/include/X11R5 \
+ /usr/include/X11R4 \
+ \
+ /usr/local/X11/include \
+ /usr/local/X11R6/include \
+ /usr/local/X11R5/include \
+ /usr/local/X11R4/include \
+ \
+ /usr/local/include/X11 \
+ /usr/local/include/X11R6 \
+ /usr/local/include/X11R5 \
+ /usr/local/include/X11R4 \
+ \
+ /usr/X386/include \
+ /usr/x386/include \
+ /usr/XFree86/include/X11 \
+ \
+ /usr/include \
+ /usr/local/include \
+ /usr/unsupported/include \
+ /usr/athena/include \
+ /usr/local/x11r5/include \
+ /usr/lpp/Xamples/include \
+ \
+ /usr/openwin/include \
+ /usr/openwin/share/include \
+ ; \
+ do
+ if test -r "$ac_dir/$x_direct_test_include"; then
+ ac_x_includes=$ac_dir
+ break
+ fi
+ done
+fi
+rm -f conftest*
+fi # $ac_x_includes = NO
+
+if test "$ac_x_libraries" = NO; then
+ # Check for the libraries.
+
+ test -z "$x_direct_test_library" && x_direct_test_library=Xt
+ test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc
+ test -z "$x_direct_test_arguments" && x_direct_test_arguments=1
+
+ # See if we find them without any special options.
+ # Don't add to $LIBS permanently.
+ ac_save_LIBS="$LIBS"
+ LIBS="-l$x_direct_test_library $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3370 "configure"
+#include "confdefs.h"
+#include <${x_direct_test_include}>
+int main() {
+${x_direct_test_function}(${x_direct_test_arguments})
+; return 0; }
+EOF
+if { (eval echo configure:3377: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# We can link X programs with no special library path.
+ac_x_libraries=
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# First see if replacing the include by lib works.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+for ac_dir in `echo "$ac_x_includes" | sed s/include/lib/` \
+ /usr/X11/lib \
+ /usr/X11R6/lib \
+ /usr/X11R5/lib \
+ /usr/X11R4/lib \
+ \
+ /usr/lib/X11 \
+ /usr/lib/X11R6 \
+ /usr/lib/X11R5 \
+ /usr/lib/X11R4 \
+ \
+ /usr/local/X11/lib \
+ /usr/local/X11R6/lib \
+ /usr/local/X11R5/lib \
+ /usr/local/X11R4/lib \
+ \
+ /usr/local/lib/X11 \
+ /usr/local/lib/X11R6 \
+ /usr/local/lib/X11R5 \
+ /usr/local/lib/X11R4 \
+ \
+ /usr/X386/lib \
+ /usr/x386/lib \
+ /usr/XFree86/lib/X11 \
+ \
+ /usr/lib \
+ /usr/local/lib \
+ /usr/unsupported/lib \
+ /usr/athena/lib \
+ /usr/local/x11r5/lib \
+ /usr/lpp/Xamples/lib \
+ /lib/usr/lib/X11 \
+ \
+ /usr/openwin/lib \
+ /usr/openwin/share/lib \
+ ; \
+do
+ for ac_extension in a so sl; do
+ if test -r $ac_dir/lib${x_direct_test_library}.$ac_extension; then
+ ac_x_libraries=$ac_dir
+ break 2
+ fi
+ done
+done
+fi
+rm -f conftest*
+fi # $ac_x_libraries = NO
+
+if test "$ac_x_includes" = NO || test "$ac_x_libraries" = NO; then
+ # Didn't find X anywhere. Cache the known absence of X.
+ ac_cv_have_x="have_x=no"
+else
+ # Record where we found X for the cache.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries"
+fi
+fi
+ fi
+ eval "$ac_cv_have_x"
+fi # $with_x != no
+
+if test "$have_x" != yes; then
+ echo "$ac_t""$have_x" 1>&6
+ no_x=yes
+else
+ # If each of the values was on the command line, it overrides each guess.
+ test "x$x_includes" = xNONE && x_includes=$ac_x_includes
+ test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
+ # Update the cache value to reflect the command line values.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$x_includes ac_x_libraries=$x_libraries"
+ echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6
+fi
+
+if test "$no_x" = yes; then
+ # Not all programs may use this symbol, but it does not hurt to define it.
+ cat >> confdefs.h <<\EOF
+#define X_DISPLAY_MISSING 1
+EOF
+
+ X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS=
+else
+ if test -n "$x_includes"; then
+ X_CFLAGS="$X_CFLAGS -I$x_includes"
+ fi
+
+ # It would also be nice to do this for all -L options, not just this one.
+ if test -n "$x_libraries"; then
+ X_LIBS="$X_LIBS -L$x_libraries"
+ # For Solaris; some versions of Sun CC require a space after -R and
+ # others require no space. Words are not sufficient . . . .
+ case "`(uname -sr) 2>/dev/null`" in
+ "SunOS 5"*)
+ echo $ac_n "checking whether -R must be followed by a space""... $ac_c" 1>&6
+echo "configure:3483: checking whether -R must be followed by a space" >&5
+ ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries"
+ cat > conftest.$ac_ext <<EOF
+#line 3486 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:3493: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_R_nospace=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_R_nospace=no
+fi
+rm -f conftest*
+ if test $ac_R_nospace = yes; then
+ echo "$ac_t""no" 1>&6
+ X_LIBS="$X_LIBS -R$x_libraries"
+ else
+ LIBS="$ac_xsave_LIBS -R $x_libraries"
+ cat > conftest.$ac_ext <<EOF
+#line 3509 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:3516: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_R_space=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_R_space=no
+fi
+rm -f conftest*
+ if test $ac_R_space = yes; then
+ echo "$ac_t""yes" 1>&6
+ X_LIBS="$X_LIBS -R $x_libraries"
+ else
+ echo "$ac_t""neither works" 1>&6
+ fi
+ fi
+ LIBS="$ac_xsave_LIBS"
+ ;;
+ OSF1*|IRIX*)
+ # OSF1 refers to Dec-Unix. -rpath is required in du 4.0 - at least
+ # -rpath is required in irix 5.x and 6.x - at least
+ # (Is -rpath really needed in IRIX? OJM)
+ X_LIBS="$X_LIBS -Wl,-rpath,$x_libraries"
+ ;;
+ esac
+ fi
+
+ # Check for system-dependent libraries X programs must link with.
+ # Do this before checking for the system-independent R6 libraries
+ # (-lICE), since we may need -lsocket or whatever for X linking.
+
+ if test "$ISC" = yes; then
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet"
+ else
+ # Martyn.Johnson@cl.cam.ac.uk says this is needed for Ultrix, if the X
+ # libraries were built with DECnet support. And karl@cs.umb.edu says
+ # the Alpha needs dnet_stub (dnet does not exist).
+ echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6
+echo "configure:3555: checking for dnet_ntoa in -ldnet" >&5
+ac_lib_var=`echo dnet'_'dnet_ntoa | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-ldnet $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3563 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dnet_ntoa();
+
+int main() {
+dnet_ntoa()
+; return 0; }
+EOF
+if { (eval echo configure:3574: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_lib_dnet_dnet_ntoa = no; then
+ echo $ac_n "checking for dnet_ntoa in -ldnet_stub""... $ac_c" 1>&6
+echo "configure:3596: checking for dnet_ntoa in -ldnet_stub" >&5
+ac_lib_var=`echo dnet_stub'_'dnet_ntoa | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-ldnet_stub $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3604 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dnet_ntoa();
+
+int main() {
+dnet_ntoa()
+; return 0; }
+EOF
+if { (eval echo configure:3615: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+
+ # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT,
+ # to get the SysV transport functions.
+ # chad@anasazi.com says the Pyramis MIS-ES running DC/OSx (SVR4)
+ # needs -lnsl.
+ # The nsl library prevents programs from opening the X display
+ # on Irix 5.2, according to dickey@clark.net.
+ echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:3644: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3649 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char gethostbyname(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3672: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_gethostbyname = no; then
+ echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6
+echo "configure:3693: checking for gethostbyname in -lnsl" >&5
+ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lnsl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3701 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+gethostbyname()
+; return 0; }
+EOF
+if { (eval echo configure:3712: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+
+ # lieder@skyler.mavd.honeywell.com says without -lsocket,
+ # socket/setsockopt and other routines are undefined under SCO ODT
+ # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary
+ # on later versions), says simon@lia.di.epfl.ch: it contains
+ # gethostby* variants that don't use the nameserver (or something).
+ # -lsocket must be given before -lnsl if both are needed.
+ # We assume that if connect needs -lnsl, so does gethostbyname.
+ echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:3742: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3747 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3770: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_connect = no; then
+ echo $ac_n "checking for connect in -lsocket""... $ac_c" 1>&6
+echo "configure:3791: checking for connect in -lsocket" >&5
+ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $X_EXTRA_LIBS $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3799 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+connect()
+; return 0; }
+EOF
+if { (eval echo configure:3810: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+
+ # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX.
+ echo $ac_n "checking for remove""... $ac_c" 1>&6
+echo "configure:3834: checking for remove" >&5
+if eval "test \"`echo '$''{'ac_cv_func_remove'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3839 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char remove(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char remove();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_remove) || defined (__stub___remove)
+choke me
+#else
+remove();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3862: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_remove=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_remove=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'remove`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_remove = no; then
+ echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6
+echo "configure:3883: checking for remove in -lposix" >&5
+ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lposix $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3891 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char remove();
+
+int main() {
+remove()
+; return 0; }
+EOF
+if { (eval echo configure:3902: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+
+ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay.
+ echo $ac_n "checking for shmat""... $ac_c" 1>&6
+echo "configure:3926: checking for shmat" >&5
+if eval "test \"`echo '$''{'ac_cv_func_shmat'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3931 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char shmat(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char shmat();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_shmat) || defined (__stub___shmat)
+choke me
+#else
+shmat();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3954: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_shmat=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_shmat=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'shmat`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_shmat = no; then
+ echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6
+echo "configure:3975: checking for shmat in -lipc" >&5
+ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lipc $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3983 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char shmat();
+
+int main() {
+shmat()
+; return 0; }
+EOF
+if { (eval echo configure:3994: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+ fi
+
+ # Check for libraries that X11R6 Xt/Xaw programs need.
+ ac_save_LDFLAGS="$LDFLAGS"
+ test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries"
+ # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to
+ # check for ICE first), but we must link in the order -lSM -lICE or
+ # we get undefined symbols. So assume we have SM if we have ICE.
+ # These have to be linked with before -lX11, unlike the other
+ # libraries we check for below, so use a different variable.
+ # --interran@uluru.Stanford.EDU, kb@cs.umb.edu.
+ echo $ac_n "checking for IceConnectionNumber in -lICE""... $ac_c" 1>&6
+echo "configure:4027: checking for IceConnectionNumber in -lICE" >&5
+ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lICE $X_EXTRA_LIBS $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4035 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char IceConnectionNumber();
+
+int main() {
+IceConnectionNumber()
+; return 0; }
+EOF
+if { (eval echo configure:4046: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ LDFLAGS="$ac_save_LDFLAGS"
+
+fi
+
+if test "x$with_x" = xyes; then
+ if test -n "$x_libraries"; then
+ XLFLAG="-L$x_libraries"
+ wlibs="-lX11 $wlibs $XLFLAG"
+ else
+ wlibs="-lX11 $wlibs"
+ fi
+ if test -z "$x_ext_lib"; then # allow envvar override
+ echo $ac_n "checking for XextCreateExtension in -lXext""... $ac_c" 1>&6
+echo "configure:4079: checking for XextCreateExtension in -lXext" >&5
+ac_lib_var=`echo Xext'_'XextCreateExtension | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lXext $wlibs $X_EXTRA_LIBS $XLFLAG $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4087 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char XextCreateExtension();
+
+int main() {
+XextCreateExtension()
+; return 0; }
+EOF
+if { (eval echo configure:4098: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ x_ext_lib=-lXext
+else
+ echo "$ac_t""no" 1>&6
+:
+fi
+
+ fi
+ if test "x$with_mf_x_toolkit" = xno; then
+ wfile=x11-Xlib.c
+ else
+ # Effectively demote --with-x-toolkit=athena to xt since
+ # the code does not distinguish.
+ x_tool_libs="-lXt $x_tool_libs"
+ wfile=x11-Xt.c
+ fi
+ test -d window || mkdir window
+ case "$srcdir" in
+ /*) wfile=$srcdir/window/$wfile;;
+ .) ;;
+ *) wfile=../$srcdir/window/$wfile;;
+ esac
+ (cd window && (rm -f x11.c; $LN_S $wfile x11.c))
+ cat >> confdefs.h <<\EOF
+#define X11WIN 1
+EOF
+
+fi
+
+
+
+
+if test "x$enable_fmtutil" = xyes; then
+ FMU='# '
+else
+ FMU=
+fi
+
+
+# Don't bother with pdflib unless pdf*TeX is requested.
+if test "$with_pdftex" = yes || \
+ test "$with_pdfetex" = yes
+then
+ ac_config_files="$ac_config_files pdftexdir/Makefile"
+
+fi
+
+# Don't bother with pdfelib unless pdfeTeX is requested.
+if test "$with_pdfetex" = yes; then
+ ac_config_files="$ac_config_files pdfetexdir/Makefile"
+
+fi
+
+test -d tests || mkdir tests
+
+# Is libm present. FIXME: do we need it at all?
+echo $ac_n "checking for main in -lm""... $ac_c" 1>&6
+echo "configure:4169: checking for main in -lm" >&5
+ac_lib_var=`echo m'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lm $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4177 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:4184: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_lib=HAVE_LIB`echo m | sed -e 's/[^a-zA-Z0-9_]/_/g' \
+ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_lib 1
+EOF
+
+ LIBS="-lm $LIBS"
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+# For cross-compilation. Put at the end so there is a fair chance
+# these are still visible when the configure script has finished.
+
+# The variables we need to build binaries that will run on the build
+# machine: BUILDCC, BUILDCFLAGS, BUILDCCLD.
+if test "$cross_compiling" = yes; then
+ if test -z "${BUILDCC}"; then
+ BUILDCC='cc'
+ fi
+ echo "$ac_t""setting \$BUILDCC to ${BUILDCC}" 1>&6
+else
+ if test -n "${BUILDCC}"; then
+ echo "configure: warning: \$BUILDCC set but not cross-compiling." 1>&2
+ fi
+ BUILDCC='$(CC)'
+fi
+
+
+if test "$cross_compiling" = yes; then
+ if test -z "${BUILDCFLAGS}"; then
+ BUILDCFLAGS='$(BUILDXCFLAGS)'
+ fi
+ echo "$ac_t""setting \$BUILDCFLAGS to ${BUILDCFLAGS}" 1>&6
+else
+ if test -n "${BUILDCFLAGS}"; then
+ echo "configure: warning: \$BUILDCFLAGS set but not cross-compiling." 1>&2
+ fi
+ BUILDCFLAGS='$(CFLAGS)'
+fi
+
+
+if test "$cross_compiling" = yes; then
+ if test -z "${BUILDCPPFLAGS}"; then
+ BUILDCPPFLAGS='$(BUILDXCPPFLAGS)'
+ fi
+ echo "$ac_t""setting \$BUILDCPPFLAGS to ${BUILDCPPFLAGS}" 1>&6
+else
+ if test -n "${BUILDCPPFLAGS}"; then
+ echo "configure: warning: \$BUILDCPPFLAGS set but not cross-compiling." 1>&2
+ fi
+ BUILDCPPFLAGS='$(CPPFLAGS)'
+fi
+
+
+if test "$cross_compiling" = yes; then
+ if test -z "${BUILDLDFLAGS}"; then
+ BUILDLDFLAGS='$(BUILDXLDFLAGS)'
+ fi
+ echo "$ac_t""setting \$BUILDLDFLAGS to ${BUILDLDFLAGS}" 1>&6
+else
+ if test -n "${BUILDLDFLAGS}"; then
+ echo "configure: warning: \$BUILDLDFLAGS set but not cross-compiling." 1>&2
+ fi
+ BUILDLDFLAGS='$(LDFLAGS)'
+fi
+
+
+if test "$cross_compiling" = yes; then
+ if test -z "${BUILDCCLD}"; then
+ BUILDCCLD='$(BUILDCC)'
+ fi
+ echo "$ac_t""setting \$BUILDCCLD to ${BUILDCCLD}" 1>&6
+else
+ if test -n "${BUILDCCLD}"; then
+ echo "configure: warning: \$BUILDCCLD set but not cross-compiling." 1>&2
+ fi
+ BUILDCCLD='$(CCLD)'
+fi
+
+
+
+# And supporting programs we need to have available on the build
+# machine.
+if test "$cross_compiling" = yes; then
+# Extract the first word of "tangle", so it can be a program name with args.
+set dummy tangle; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:4289: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_TANGLEBOOT'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$TANGLEBOOT" in
+ /*|[A-z]:/*)
+ ac_cv_path_TANGLEBOOT="$TANGLEBOOT" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_TANGLEBOOT="$TANGLEBOOT" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_path_TANGLEBOOT="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+TANGLEBOOT="$ac_cv_path_TANGLEBOOT"
+if test -n "$TANGLEBOOT"; then
+ echo "$ac_t""$TANGLEBOOT" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "${TANGLEBOOT}"; then
+ { echo "configure: error: tangle was not found but is required when cross-compiling.
+ Install tangle or set \$TANGLEBOOT to the full pathname." 1>&2; exit 1; }
+fi
+else
+ TANGLEBOOT=./tangleboot
+fi
+if test "$cross_compiling" = yes; then
+# Extract the first word of "tangle", so it can be a program name with args.
+set dummy tangle; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:4333: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_TANGLE'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$TANGLE" in
+ /*|[A-z]:/*)
+ ac_cv_path_TANGLE="$TANGLE" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_TANGLE="$TANGLE" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_path_TANGLE="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+TANGLE="$ac_cv_path_TANGLE"
+if test -n "$TANGLE"; then
+ echo "$ac_t""$TANGLE" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "${TANGLE}"; then
+ { echo "configure: error: tangle was not found but is required when cross-compiling.
+ Install tangle or set \$TANGLE to the full pathname." 1>&2; exit 1; }
+fi
+else
+ TANGLE=./tangle
+fi
+if test "$cross_compiling" = yes; then
+# Extract the first word of "ctangle", so it can be a program name with args.
+set dummy ctangle; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:4377: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_CTANGLEBOOT'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$CTANGLEBOOT" in
+ /*|[A-z]:/*)
+ ac_cv_path_CTANGLEBOOT="$CTANGLEBOOT" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_CTANGLEBOOT="$CTANGLEBOOT" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_path_CTANGLEBOOT="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+CTANGLEBOOT="$ac_cv_path_CTANGLEBOOT"
+if test -n "$CTANGLEBOOT"; then
+ echo "$ac_t""$CTANGLEBOOT" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "${CTANGLEBOOT}"; then
+ { echo "configure: error: ctangle was not found but is required when cross-compiling.
+ Install ctangle or set \$CTANGLEBOOT to the full pathname." 1>&2; exit 1; }
+fi
+else
+ CTANGLEBOOT=./ctangleboot
+fi
+if test "$cross_compiling" = yes; then
+# Extract the first word of "ctangle", so it can be a program name with args.
+set dummy ctangle; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:4421: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_CTANGLE'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$CTANGLE" in
+ /*|[A-z]:/*)
+ ac_cv_path_CTANGLE="$CTANGLE" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_CTANGLE="$CTANGLE" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_path_CTANGLE="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+CTANGLE="$ac_cv_path_CTANGLE"
+if test -n "$CTANGLE"; then
+ echo "$ac_t""$CTANGLE" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "${CTANGLE}"; then
+ { echo "configure: error: ctangle was not found but is required when cross-compiling.
+ Install ctangle or set \$CTANGLE to the full pathname." 1>&2; exit 1; }
+fi
+else
+ CTANGLE=./ctangle
+fi
+if test "$cross_compiling" = yes; then
+# Extract the first word of "tie", so it can be a program name with args.
+set dummy tie; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:4465: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_TIE'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$TIE" in
+ /*|[A-z]:/*)
+ ac_cv_path_TIE="$TIE" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_TIE="$TIE" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_path_TIE="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+TIE="$ac_cv_path_TIE"
+if test -n "$TIE"; then
+ echo "$ac_t""$TIE" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "${TIE}"; then
+ { echo "configure: error: tie was not found but is required when cross-compiling.
+ Install tie or set \$TIE to the full pathname." 1>&2; exit 1; }
+fi
+else
+ TIE=./tie
+fi
+if test "x$with_omega" = xyes || test "x$with_aleph" = xyes; then
+if test "$cross_compiling" = yes; then
+# Extract the first word of "otangle", so it can be a program name with args.
+set dummy otangle; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:4510: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_OTANGLE'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$OTANGLE" in
+ /*|[A-z]:/*)
+ ac_cv_path_OTANGLE="$OTANGLE" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_OTANGLE="$OTANGLE" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ if test -z "$COMSPEC"; then ac_x=-f; else ac_x=-x; fi
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test $ac_x $ac_dir/$ac_word; then
+ ac_cv_path_OTANGLE="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+OTANGLE="$ac_cv_path_OTANGLE"
+if test -n "$OTANGLE"; then
+ echo "$ac_t""$OTANGLE" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "${OTANGLE}"; then
+ { echo "configure: error: otangle was not found but is required when cross-compiling.
+ Install otangle or set \$OTANGLE to the full pathname." 1>&2; exit 1; }
+fi
+else
+ OTANGLE=./otangle
+fi
+fi
+
+ac_config_files="$ac_config_files Makefile doc/Makefile lib/Makefile man/Makefile mpware/Makefile
+ web2c/Makefile window/Makefile"
+
+ac_config_files="$ac_config_files fmtutil.cnf:fmtutil.in"
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+DEFS=-DHAVE_CONFIG_H
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+
+trap 'rm -fr `echo "$ac_config_files c-auto.h:c-auto.in" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@WEB2CVERSION@%$WEB2CVERSION%g
+s%@CC@%$CC%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@LN_S@%$LN_S%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@YACC@%$YACC%g
+s%@LEX@%$LEX%g
+s%@LEXLIB@%$LEXLIB%g
+s%@RANLIB@%$RANLIB%g
+s%@CPP@%$CPP%g
+s%@LEX_OUTPUT_ROOT@%$LEX_OUTPUT_ROOT%g
+s%@LD@%$LD%g
+s%@AR@%$AR%g
+s%@ARFLAGS@%$ARFLAGS%g
+s%@socketlibs@%$socketlibs%g
+s%@MAINT@%$MAINT%g
+s%@texmfmain@%$texmfmain%g
+s%@ZLIBCPPFLAGS@%$ZLIBCPPFLAGS%g
+s%@LDZLIB@%$LDZLIB%g
+s%@ZLIBDEP@%$ZLIBDEP%g
+s%@LIBPNGCPPFLAGS@%$LIBPNGCPPFLAGS%g
+s%@LDLIBPNG@%$LDLIBPNG%g
+s%@LIBPNGDEP@%$LIBPNGDEP%g
+s%@LIBXPDFCPPFLAGS@%$LIBXPDFCPPFLAGS%g
+s%@LDLIBXPDF@%$LDLIBXPDF%g
+s%@LIBXPDFDEP@%$LIBXPDFDEP%g
+s%@MFN@%$MFN%g
+s%@OMEGA@%$OMEGA%g
+s%@ALEPH@%$ALEPH%g
+s%@CXX@%$CXX%g
+s%@CXXLDEXTRA@%$CXXLDEXTRA%g
+s%@CXXHACKLINK@%$CXXHACKLINK%g
+s%@CXXHACKLDLIBS@%$CXXHACKLDLIBS%g
+s%@PTEX@%$PTEX%g
+s%@PETEX@%$PETEX%g
+s%@ETEX@%$ETEX%g
+s%@X_CFLAGS@%$X_CFLAGS%g
+s%@X_PRE_LIBS@%$X_PRE_LIBS%g
+s%@X_LIBS@%$X_LIBS%g
+s%@X_EXTRA_LIBS@%$X_EXTRA_LIBS%g
+s%@x_ext_lib@%$x_ext_lib%g
+s%@x_tool_libs@%$x_tool_libs%g
+s%@wlibs@%$wlibs%g
+s%@FMU@%$FMU%g
+s%@BUILDCC@%$BUILDCC%g
+s%@BUILDCFLAGS@%$BUILDCFLAGS%g
+s%@BUILDCPPFLAGS@%$BUILDCPPFLAGS%g
+s%@BUILDLDFLAGS@%$BUILDLDFLAGS%g
+s%@BUILDCCLD@%$BUILDCCLD%g
+s%@TANGLEBOOT@%$TANGLEBOOT%g
+s%@TANGLE@%$TANGLE%g
+s%@CTANGLEBOOT@%$CTANGLEBOOT%g
+s%@CTANGLE@%$CTANGLE%g
+s%@TIE@%$TIE%g
+s%@OTANGLE@%$OTANGLE%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"$ac_config_files"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*|[A-z]:/*) # Absolute path.
+ srcdir="$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ "") ;;
+ [/$]*|[A-z]:/*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ rm -f conftest.in
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%:% $ac_given_srcdir/%g" -e "s%^%$ac_given_srcdir/%"`
+ cat $ac_file_inputs > conftest.in
+ #
+ # Replace lines of the form ac_include foo with the contents of foo:
+ # first, from the ac_include lines construct a list of file names.
+ # From that list, we construct a second list of those files that exist.
+ # Then we construct lists of sed commands for including those files,
+ # and a sed command that removes the ac_include lines. We don't attempt
+ # to read non-existent files because some (buggy) versions of sed choke
+ # on this. Have to use sed because old (Ultrix, SunOS) awk does not support
+ # getline or system. (Anyway, configure scripts aren't supposed to use awk.)
+ # Can't use only one -e and commands {dr foo} because foo has to be last.
+ # Be careful, because the filename may contain /. Be careful with
+ # whitespace; we need to use echo.
+ #
+ file_substs=`sed -n '/^ac_include/s%ac_include[ ]*\(.*\)%\1%p' conftest.in`
+ # Create the sed command line ...
+ if test -n "$file_substs"; then
+ echo "configure: warning: ac_include is obsolete; instead use kpse_include" 1>&2
+ file_subst_cmd="sed -e 's/^ac_include/kpse_include/'"
+ else
+ file_subst_cmd='sed'
+ fi
+ kpse_substs=`sed -n '/^kpse_include/s%kpse_include[ ]*\(.*\)%\1%p' conftest.in`
+ for ac_inc in $file_substs $kpse_substs; do
+ if test -f "$ac_given_srcdir/$ac_inc"; then
+ ac_mung=`echo $ac_inc | sed 's,/,%,g'`
+ file_subst_cmd="$file_subst_cmd -e '/^kpse_include $ac_mung$/r $ac_given_srcdir/$ac_inc'"
+ fi
+ done
+ file_subst_cmd="$file_subst_cmd -e '/^kpse_include/d'"
+ # ... and fix the whitespace and escaped slashes.
+ file_subst_cmd=`echo "$file_subst_cmd" | sed -e 's,%,\\\/,g' \
+-e 's/kpse_include /kpse_include[ ]*/g'`
+ # I can't find any way to do variable substitution in the sed commands
+ # (so the user could have, e.g., $top_srcdir in their ac_include line).
+ (eval $file_subst_cmd conftest.in) \
+ | sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s* conftest.in
+
+# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where
+# NAME is the cpp macro being defined and VALUE is the value it is being given.
+#
+# ac_d sets the value in "#define NAME VALUE" lines.
+ac_dA='s%^\([ ]*\)#\([ ]*define[ ][ ]*\)'
+ac_dB='\([ ][ ]*\)[^ ].*$%\1#\2'
+ac_dC='\3'
+ac_dD='%g'
+# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE".
+ac_uA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
+ac_uB='\([ ]\)%\1#\2define\3'
+ac_uC=' '
+ac_uD='\4%g'
+# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
+ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
+ac_eB='$%\1#\2define\3'
+ac_eC=' '
+ac_eD='%g'
+
+if test "${CONFIG_HEADERS+set}" != set; then
+EOF
+cat >> $CONFIG_STATUS <<EOF
+ CONFIG_HEADERS=" c-auto.h:c-auto.in"
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+fi
+for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ echo creating $ac_file
+
+ rm -f conftest.frag conftest.in conftest.out
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%:% $ac_given_srcdir/%g" -e "s%^%$ac_given_srcdir/%"`
+ cat $ac_file_inputs > conftest.in
+
+EOF
+
+# Transform confdefs.h into a sed script conftest.vals that substitutes
+# the proper values into config.h.in to produce config.h. And first:
+# Protect against being on the right side of a sed subst in config.status.
+# Protect against being in an unquoted here document in config.status.
+rm -f conftest.vals
+cat > conftest.hdr <<\EOF
+s/[\\&%]/\\&/g
+s%[\\$`]%\\&%g
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp
+s%ac_d%ac_u%gp
+s%ac_u%ac_e%gp
+EOF
+sed -n -f conftest.hdr confdefs.h > conftest.vals
+rm -f conftest.hdr
+
+# This sed command replaces #undef with comments. This is necessary, for
+# example, in the case of _POSIX_SOURCE, which is predefined and required
+# on some systems where configure will not decide to define it.
+cat >> conftest.vals <<\EOF
+s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */%
+EOF
+
+# Break up conftest.vals because some shells have a limit on
+# the size of here documents, and old seds have small limits too.
+
+rm -f conftest.tail
+while :
+do
+ ac_lines=`grep -c . conftest.vals`
+ # grep -c gives empty output for an empty file on some AIX systems.
+ if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi
+ # Write a limited-size here document to conftest.frag.
+ echo ' cat > conftest.frag <<CEOF' >> $CONFIG_STATUS
+ sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS
+ echo 'CEOF
+ sed -f conftest.frag conftest.in > conftest.out
+ rm -f conftest.in
+ mv conftest.out conftest.in
+' >> $CONFIG_STATUS
+ sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail
+ rm -f conftest.vals
+ mv conftest.tail conftest.vals
+done
+rm -f conftest.vals
+
+cat >> $CONFIG_STATUS <<\EOF
+ rm -f conftest.frag conftest.h
+ echo "/* $ac_file. Generated automatically by configure. */" > conftest.h
+ cat conftest.in >> conftest.h
+ rm -f conftest.in
+ if cmp -s $ac_file conftest.h 2>/dev/null; then
+ echo "$ac_file is unchanged"
+ rm -f conftest.h
+ else
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ fi
+ rm -f $ac_file
+ mv conftest.h $ac_file
+ fi
+fi; done
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+
+
+
+
+
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+date >stamp-auto
+
+
+
+
+
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+if test "$no_recursion" != yes; then
+
+ # Remove --cache-file and --srcdir arguments so they do not pile up.
+ ac_sub_configure_args=
+ ac_prev=
+ for ac_arg in $ac_configure_args; do
+ if test -n "$ac_prev"; then
+ ac_prev=
+ continue
+ fi
+ case "$ac_arg" in
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ ;;
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ ;;
+ *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;;
+ esac
+ done
+
+ for ac_config_dir in : $subdirs; do
+
+ # Do not complain, so a configure script can configure whichever
+ # parts of a large source tree are present.
+ if test ! -d $srcdir/$ac_config_dir; then
+ continue
+ fi
+
+ echo configuring in $ac_config_dir
+
+ case "$srcdir" in
+ .) ;;
+ *)
+ if test -d ./$ac_config_dir || mkdir ./$ac_config_dir; then :;
+ else
+ { echo "configure: error: can not create `pwd`/$ac_config_dir" 1>&2; exit 1; }
+ fi
+ ;;
+ esac
+
+ ac_popdir=`pwd`
+ cd $ac_config_dir
+
+ # A "../" for each directory in /$ac_config_dir.
+ ac_dots=`echo $ac_config_dir|sed -e 's%^\./%%' -e 's%[^/]$%&/%' -e 's%[^/]*/%../%g'`
+
+ case "$srcdir" in
+ .) # No --srcdir option. We are building in place.
+ ac_sub_srcdir=$srcdir ;;
+ /*|[A-z]:/*) # Absolute path.
+ ac_sub_srcdir=$srcdir/$ac_config_dir ;;
+ *) # Relative path.
+ ac_sub_srcdir=$ac_dots$srcdir/$ac_config_dir ;;
+ esac
+
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f ./configure; then
+ ac_sub_configure=./configure
+ elif test -f $ac_sub_srcdir/configure; then
+ ac_sub_configure=$ac_sub_srcdir/configure
+ elif test -f $ac_sub_srcdir/configure.in; then
+ ac_sub_configure=$ac_configure
+ else
+ echo "configure: warning: no configuration information is in $ac_config_dir" 1>&2
+ ac_sub_configure=
+ fi
+
+ # The recursion is here.
+ if test -n "$ac_sub_configure"; then
+
+ # Make the cache file name correct relative to the subdirectory.
+ case "$cache_file" in
+ /*|[A-z]:/*) ac_sub_cache_file=$cache_file ;;
+ *) # Relative path.
+ ac_sub_cache_file="$ac_dots$cache_file" ;;
+ esac
+ case "$ac_given_INSTALL" in
+ "") ;;
+ [/$]*|[A-z]:/*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo "running ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir"
+ # The eval makes quoting arguments work.
+ if eval ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir
+ then :
+ else
+ { echo "configure: error: $ac_sub_configure failed for $ac_config_dir" 1>&2; exit 1; }
+ fi
+ fi
+
+ cd $ac_popdir
+ done
+fi
+
diff --git a/Build/source/texk/web2c/configure.in b/Build/source/texk/web2c/configure.in
new file mode 100644
index 00000000000..23c5206c88d
--- /dev/null
+++ b/Build/source/texk/web2c/configure.in
@@ -0,0 +1,368 @@
+dnl Process this file with Autoconf to produce a configure script for Web2c.
+dnl
+dnl Some things are no longer configurable:
+dnl - SMALL{TeX,MF,BibTeX}: too painful to maintain the separate patch
+dnl files, and, for TeX, texmfmem.h would have to be fixed to support
+dnl more than 256 fonts.
+dnl - NONASCII: necessary for the character translation feature.
+dnl - REGFIX: modern compilers mostly ignore register declarations, anyway.
+dnl The code for these things remains (where applicable), so you can
+dnl get these features if you are willing to hack the sources. If not,
+dnl it'll take a good argument to convince me to invest the time to make
+dnl them configurable.
+dnl
+dnl We don't use (for example) tex/tex.web because people who only want
+dnl to build part of the distribution may not have any given program.
+dnl Even main.c isn't guaranteed, but then nothing is, really ...
+AC_INIT(web2c/main.c)
+
+WEB2CVERSION=7.5.5
+AC_SUBST(WEB2CVERSION)
+AC_DEFINE_UNQUOTED(WEB2CVERSION," (Web2C $WEB2CVERSION)")
+
+dnl Write output here, instead of putting a zillion -D's on the command line.
+AC_CONFIG_HEADERS([c-auto.h:c-auto.in], [date >stamp-auto])
+
+AC_PROG_CC
+AC_PROG_INSTALL
+AC_PROG_LN_S
+AC_PROG_MAKE_SET
+
+AC_PROG_YACC
+AC_PROG_LEX
+# Work around a problem with Flex Version 2.5.31 which needs -l flag.
+# Since all recent versions of flex support -l, don't check for the
+# specific version, but check that at least "--version" is supported.
+# We also want to catch LEX=/some/where/flex, so:
+case $LEX in
+ *flex) $LEX --version >/dev/null 2>&1 && LEX="$LEX -l" ;;
+esac
+AC_PROG_RANLIB
+AC_CHECK_HEADERS(sys/time.h sys/timeb.h)
+AC_CHECK_FUNCS(strerror gettimeofday ftime mkstemp mktemp)
+
+AC_TYPE_SIGNAL
+
+# AC_DECL_YYTEXT is just used to set LEX_OUTPUT_ROOT.
+AC_DECL_YYTEXT
+pb_AC_ASM_UNDERSCORE
+
+dnl pdfTeX likes inline functions in C code.
+AC_C_INLINE
+
+dnl These are standard among *NIX systems, but not when cross-compiling
+AC_DEFUN([CF_SUBST],
+[AC_MSG_CHECKING(for $1 (symbol $2))
+AC_CACHE_VAL(cf_cv_subst_$2,[
+test -z "[$]$2" && $2=$3
+cf_cv_subst_$2=[$]$2])
+$2=${cf_cv_subst_$2}
+AC_MSG_RESULT([$]$2)
+AC_SUBST($2)
+])dnl
+CF_SUBST(loader,LD,ld)
+CF_SUBST(archiver,AR,ar)
+CF_SUBST(archiver options,ARFLAGS,rc)
+
+# Needed on A/UX 3.0. I don't want to pull in other -lposix's, though.
+# From: bernt@weinberg.pop.bio.aau.dk (Bernt Guldbrandtsen)
+if test `(uname) 2>/dev/null` = aux; then
+ AC_CHECK_LIB(posix, sigemptyset)
+fi
+
+dnl These tests prevent reliable cross-compilation. Sigh.
+dnl Some special hacks are used to make cross-compilation
+dnl succeed in one special case.
+
+AC_UNSET_CC
+AC_C_CHAR_UNSIGNED
+AC_C_BIGENDIAN
+AC_CHECK_SIZEOF(long)
+AC_RESET_CC
+
+# --with and --enable options.
+test "x$with_x_toolkit" = xyes && with_x=yes
+test "x$with_x_toolkit" = xxt && with_x=yes
+test "x$with_x_toolkit" = xathena && with_x=yes
+test "x$with_x" = xno && with_x_toolkit=no
+
+: ${with_x=no} # tell PATH_XTRA no X by default, if not specified.
+
+sinclude(withenable.ac)
+sinclude(../kpathsea/withenable.ac)
+sinclude(../../libs/zlib/withenable.ac)
+sinclude(../../libs/libpng/withenable.ac)
+sinclude(../../libs/zlib/zlib.ac)
+sinclude(../../libs/libpng/libpng.ac)
+sinclude(../../libs/xpdf/libxpdf.ac)
+
+# Whether to build mf-nowin.
+: ${with_mf_nowin=no} # Default.
+if test "x$with_mf_nowin" = xyes; then
+ MFN=
+else
+ MFN='#! '
+fi
+AC_SUBST(MFN)
+
+# For Omega.
+if test -d $srcdir/omegadir; then
+ test "${with_omega+set}" = set || with_omega=yes
+else
+ if test "x$with_omega" = xyes; then
+ AC_MSG_WARN(The Omega sources are not available.)
+ fi
+ with_omega=no
+fi
+if test "x$with_omega" = xyes; then
+ OMEGA=
+ KPSE_CONFIG_FILES([omegafonts/Makefile otps/Makefile])
+else
+ OMEGA='#! '
+fi
+AC_SUBST(OMEGA)
+
+# For Aleph
+if test -d $srcdir/alephdir && test -d $srcdir/omegadir; then
+ test "${with_aleph+set}" = set || with_aleph=yes
+else
+ if test "x$with_aleph" = xyes; then
+ AC_MSG_WARN(The Aleph sources are not available.)
+ fi
+ with_aleph=no
+fi
+if test "x$with_aleph" = xyes; then
+ ALEPH=
+else
+ ALEPH='#! '
+fi
+AC_SUBST(ALEPH)
+
+# For pdfTeX.
+if test -d $srcdir/pdftexdir; then
+ # Create build dir, if necessary.
+ test -d pdftexdir || mkdir pdftexdir
+ test "${with_pdftex+set}" = set || with_pdftex=yes
+else
+ if test "x$with_pdftex" = xyes; then
+ AC_MSG_WARN(The pdfTeX sources are not available.)
+ fi
+ with_pdftex=no
+fi
+
+# For pdfeTeX
+if test -d $srcdir/pdfetexdir && test -d $srcdir/pdftexdir \
+ && test -d $srcdir/etexdir; then
+ test "${with_pdfetex+set}" = set || with_pdfetex=yes
+else
+ if test "x$with_pdfetex" = xyes; then
+ AC_MSG_WARN(Not all sources of pdfeTeX are available.)
+ fi
+ with_pdfetex=no
+fi
+
+# Check whether C++ compiler works. Prevent exit if it doesn't.
+if test "x$with_pdftex" = xyes ||
+ test "x$with_pdfetex" = xyes
+then
+ # First test whether the compiler works in a subshell, and if so,
+ # do it again in the main shell so we see the result.
+(
+ AC_PROG_CXX
+) && {
+ AC_PROG_CXX
+} || {
+ test "x$with_pdftex" = xyes \
+ && AC_MSG_WARN(No C++ compiler: pdfTeX will not be compiled.)
+ test "x$with_pdfetex" = xyes \
+ && AC_MSG_WARN(No C++ compiler: pdfeTeX will not be compiled.)
+ with_pdftex=no
+ with_pdfetex=no
+ true
+}
+fi
+
+# Check if we can link the C++ runlime lib statically. Only check, if we are
+# going to build pdf[ex]tex. And, only try the magic hack, if C++ is
+# GNU C++ (i.e. if $ac_cv_prog_gxx=yes). The reason for using a static C++
+# runtime is that binaries are more portable. That's only important if you are
+# planning to distribute binaries, so all the neat stuff is disabled by default:
+flags_try1='-nodefaultlibs -Wl,-Bstatic -lstdc++ -Wl,-Bdynamic -lm -lgcc_eh -lgcc -lc -lgcc_eh -lgcc'
+flags_try2='-nodefaultlibs -Wl,-Bstatic -lstdc++ -Wl,-Bdynamic -lm -lgcc -lc -lgcc'
+CXXLDEXTRA=
+CXXHACKLINK='$(kpathsea_cxx_link)'
+CXXHACKLDLIBS='$(LOADLIBES)'
+if test "x$with_cxx_runtime_hack" = xyes &&
+ { test "x$with_pdftex" = xyes ||
+ test "x$with_pdfetex" = xyes; }
+then
+ AC_MSG_CHECKING(for statically linking C++ runtime library)
+
+ cpp_link_hack=false
+ old_flags=$flags
+ old_ac_ext=$ac_ext
+ old_ac_link=$ac_link
+ if test "$ac_cv_prog_gxx" = yes; then
+
+ ac_ext=C
+ cat > conftest.$ac_ext << EOF
+#include <iostream.h>
+int main()
+{
+ cout <<"worksok\n";
+}
+EOF
+
+ for flags in "$flags_try1" "$flags_try2"; do
+ ac_link='${CXX-g++} -o conftest${ac_exeext} $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS $flags 1>&5'
+ if { (eval echo configure: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ case `(./conftest; exit) 2>/dev/null` in
+ worksok)
+ cpp_link_hack=true; break;;
+ esac
+ else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ fi
+ done
+ fi
+
+ if $cpp_link_hack; then
+ CXXLDEXTRA=$flags
+ CXXHACKLINK='$(cxx_link_command)'
+ CXXHACKLDLIBS='$(proglib) $(kpathsea_dir)/.libs/libkpathsea.a $(LIBS) $(XLOADLIBES)'
+ AC_MSG_RESULT(ok using $flags)
+ else
+ AC_MSG_RESULT(not supported)
+ fi
+
+ flags=$old_flags
+ ac_ext=$old_ac_ext
+ ac_link=$old_ac_link
+fi
+AC_SUBST(CXXLDEXTRA)
+AC_SUBST(CXXHACKLINK)
+AC_SUBST(CXXHACKLDLIBS)
+
+if test "x$with_pdftex" = xyes; then
+ PTEX=
+else
+ PTEX='#! '
+fi
+AC_SUBST(PTEX)
+
+if test "x$with_pdfetex" = xyes; then
+ PETEX=
+else
+ PETEX='#! '
+fi
+AC_SUBST(PETEX)
+
+# For e-TeX, three choices: no, yes, and tex. In the latter case, we
+# have to comment out the normal TeX build (TEX), as well as enable the
+# e-TeX build (ETEX) and the replacement of TeX with e-TeX in compatibilty
+# mode(CTEX).
+if test -d $srcdir/etexdir; then
+ # Create build dir, if necessary.
+ test -d etexdir || mkdir etexdir
+ test "${with_etex+set}" = set || with_etex=yes
+else
+ if test "x$with_etex" = xyes; then
+ AC_MSG_WARN(The e-TeX sources are not available.)
+ fi
+ with_etex=no
+fi
+if test "x$with_etex" = xyes; then
+ ETEX=
+else
+ ETEX='#! '
+fi
+AC_SUBST(ETEX)
+
+
+# --with-x* options: Distinguish no X at all, no toolkit, or toolkit.
+AC_PATH_XTRA
+if test "x$with_x" = xyes; then
+ if test -n "$x_libraries"; then
+ XLFLAG="-L$x_libraries"
+ wlibs="-lX11 $wlibs $XLFLAG"
+ else
+ wlibs="-lX11 $wlibs"
+ fi
+ if test -z "$x_ext_lib"; then # allow envvar override
+ AC_CHECK_LIB(Xext, XextCreateExtension,
+ x_ext_lib=-lXext, :, $wlibs $X_EXTRA_LIBS $XLFLAG)
+ fi
+ if test "x$with_mf_x_toolkit" = xno; then
+ wfile=x11-Xlib.c
+ else
+ # Effectively demote --with-x-toolkit=athena to xt since
+ # the code does not distinguish.
+ x_tool_libs="-lXt $x_tool_libs"
+ wfile=x11-Xt.c
+ fi
+ test -d window || mkdir window
+ case "$srcdir" in
+ /*) wfile=$srcdir/window/$wfile;;
+ .) ;;
+ *) wfile=../$srcdir/window/$wfile;;
+ esac
+ (cd window && (rm -f x11.c; $LN_S $wfile x11.c))
+ AC_DEFINE(X11WIN)
+fi
+AC_SUBST(x_ext_lib)
+AC_SUBST(x_tool_libs)
+AC_SUBST(wlibs)
+
+if test "x$enable_fmtutil" = xyes; then
+ FMU='# '
+else
+ FMU=
+fi
+AC_SUBST(FMU)
+
+# Don't bother with pdflib unless pdf*TeX is requested.
+if test "$with_pdftex" = yes || \
+ test "$with_pdfetex" = yes
+then
+ KPSE_CONFIG_FILES([pdftexdir/Makefile])
+fi
+
+# Don't bother with pdfelib unless pdfeTeX is requested.
+if test "$with_pdfetex" = yes; then
+ AC_CONFIG_FILES([pdfetexdir/Makefile])
+fi
+
+dnl Create tests subdirectory.
+test -d tests || mkdir tests
+
+# Is libm present. FIXME: do we need it at all?
+AC_CHECK_LIB(m, main)
+
+# For cross-compilation. Put at the end so there is a fair chance
+# these are still visible when the configure script has finished.
+
+# The variables we need to build binaries that will run on the build
+# machine: BUILDCC, BUILDCFLAGS, BUILDCCLD.
+KPSE_CROSS_BUILD_VAR(CC, cc)
+KPSE_CROSS_BUILD_VAR(CFLAGS, $(BUILDXCFLAGS))
+KPSE_CROSS_BUILD_VAR(CPPFLAGS, $(BUILDXCPPFLAGS))
+KPSE_CROSS_BUILD_VAR(LDFLAGS, $(BUILDXLDFLAGS))
+KPSE_CROSS_BUILD_VAR(CCLD, $(BUILDCC))
+
+# And supporting programs we need to have available on the build
+# machine.
+KPSE_CROSS_PATH_PROG(TANGLEBOOT, tangle, ./tangleboot)
+KPSE_CROSS_PATH_PROG(TANGLE, tangle, ./tangle)
+KPSE_CROSS_PATH_PROG(CTANGLEBOOT, ctangle, ./ctangleboot)
+KPSE_CROSS_PATH_PROG(CTANGLE, ctangle, ./ctangle)
+KPSE_CROSS_PATH_PROG(TIE, tie, ./tie)
+if test "x$with_omega" = xyes || test "x$with_aleph" = xyes; then
+KPSE_CROSS_PATH_PROG(OTANGLE, otangle, ./otangle)
+fi
+
+dnl Generate `Makefile's, `config.status', and our header file.
+KPSE_CONFIG_FILES([Makefile doc/Makefile lib/Makefile man/Makefile mpware/Makefile
+ web2c/Makefile window/Makefile])
+AC_CONFIG_FILES([fmtutil.cnf:fmtutil.in])
+AC_OUTPUT
diff --git a/Build/source/texk/web2c/cpascal.h b/Build/source/texk/web2c/cpascal.h
new file mode 100644
index 00000000000..f9493690d3b
--- /dev/null
+++ b/Build/source/texk/web2c/cpascal.h
@@ -0,0 +1,277 @@
+/* cpascal.h: implement various bits of standard and other Pascal that
+ we use in the change files. Public domain.
+
+ This is the top-level include file for all the web2c-generated C
+ programs except TeX and Metafont themselves, which use texmf.h. It's
+ not included by the web2c programs, though. */
+
+#ifndef CPASCAL_H
+#define CPASCAL_H
+
+#ifdef WIN32
+#pragma warning( disable : 4018 4244 )
+#endif
+
+/* We must include this first, to resolve many C issues. */
+#include "config.h"
+
+/* We only use getopt in the applications, not in web2c itself. */
+#include <kpathsea/getopt.h>
+
+/* Almost everybody needs path searching. May as well always include
+ them and simplify the change files. */
+#include <kpathsea/progname.h>
+#include <kpathsea/proginit.h>
+#include <kpathsea/tex-file.h>
+
+/* Help messages. */
+#include "help.h"
+
+/* Allow translation files. */
+#define Xchr(x) xchr[x]
+
+/* Pieces of predefined Pascal web2c doesn't convert. */
+
+/* Absolute value. Without the casts to integer here, the Ultrix and
+ AIX compilers (at least) produce bad code (or maybe it's that I don't
+ understand all the casting rules in C) for tests on memory fields.
+ Specifically, a test in diag_round (in Metafont) on a quarterword
+ comes out differently without the cast, thus causing the trap test to
+ fail. (A path at line 86 is constructed slightly differently). */
+/* If the system had an abs #define already, get rid of it. */
+#undef abs
+#define abs(x) ((integer)(x) >= 0 ? (integer)(x) : (integer)-(x))
+
+#define chr(x) (x)
+#define ord(x) (x)
+#define odd(x) ((x) & 1)
+#define round(x) zround ((double) (x))
+#define trunc(x) ((integer) (x))
+#define floor(x) ((integer)floor((double)(x)))
+#define input stdin
+#define output stdout
+#define maxint INTEGER_MAX
+#define nil NULL
+
+#define floorunscaled(i) ((i)>>16)
+#define floorscaled(i) ((i)&(-65536))
+#define roundunscaled(i) (((i>>15)+1)>>1)
+#define roundfraction(i) (((i>>11)+1)>>1)
+#ifndef TeX
+/* In TeX, the half routine is always applied to positive integers.
+ In MF and MP, it isn't; therefore, we can't portably use the C shift
+ operator -- whether zeros or the sign bit will be shifted in on
+ negative left operands is implementation-defined.
+
+ It might be worth going through MF and using halfp where possible, as
+ in MP. */
+#define half(i) ( ((i)<0) ? (((i)+1)>>1) : ((i)>>1) )
+#endif
+#define halfp(i) ((i) >> 1)
+
+/* Standard Pascal file routines. These are used for both binary and
+ text files, but binary is more common. If you want it 100% right,
+ fix the change files to pass the fopen mode to reset in all cases and
+ send me the changes; it doesn't matter for Unix, so I'm not going to
+ spend any more time on it. */
+#define reset(f,n) f = xfopen (n, FOPEN_R_MODE)
+#define rewrite(f,n) f = xfopen (n, FOPEN_W_MODE)
+#define resetbin(f,n) f = xfopen (n, FOPEN_RBIN_MODE)
+#define rewritebin(f,n) f = xfopen (n, FOPEN_WBIN_MODE)
+
+#if defined(read)
+#undef read
+#endif
+#define read(f,b) ((b) = getc (f))
+
+/* We hope this will be efficient than the `x = x - 1' that decr would
+ otherwise be translated to. Likewise for incr. */
+#define decr(x) --(x)
+#define incr(x) ++(x)
+
+/* `real' is used for noncritical floating-point stuff. */
+typedef double real;
+
+/* C doesn't need to distinguish between text files and other files. */
+typedef FILE *text;
+
+/* Extra stuff used in various change files for various reasons. */
+
+/* Pascal has no address-of operator, and we need pointers to integers
+ to set up the option table. */
+#define addressof(x) (&(x))
+
+/* So dvicopy can use stdin/stdout. */
+#if defined (__DJGPP__) || defined (WIN32)
+#include <io.h>
+/* Don't set console device to binary. */
+#define makebinaryfile(arg) ((!isatty(fileno(arg)) && setmode(fileno(arg), O_BINARY)), arg)
+#else
+#define makebinaryfile(arg) (arg)
+#endif
+
+/* It's not worth fixing fixwrites to handle Pascal-style n:m write
+ specifiers for reals, so the change files call print_real instead. */
+#define printreal(r,n,m) fprintreal (stdout, r, n, m)
+
+/* Write the byte X to the file F. */
+#define putbyte(x,f) \
+ do { if (putc ((char) (x) & 255, f) == EOF) \
+ FATAL1 ("putbyte(%ld) failed", (long) x); } while (0)
+
+/* To work around casting problems. */
+#define intcast(x) ((integer) (x))
+#define stringcast(x) ((string) (x))
+
+/* For throwing away input from the file F. */
+#define vgetc(f) (void) getc (f)
+
+/* The fixwrites program outputs this, for diagnostics and such, that
+ aren't worth checking the return value on. */
+#define Fputs(f,s) (void) fputs (s, f)
+
+/* `aopenin' is used for all kinds of input text files, so it
+ needs to know what path to use. Used by BibTeX, MF, TeX. */
+#define aopenin(f,p) open_input (&(f), p, FOPEN_RBIN_MODE)
+#define aopenout(f) open_output (&(f), FOPEN_W_MODE)
+
+/* For faking arrays in tftopl. */
+typedef unsigned char *pointertobyte;
+#define casttobytepointer(e) ((pointertobyte) e)
+
+/* Write out elements START through END of BUF to the file F. For gftodvi. */
+#define writechunk(f, buf, start, end) \
+ (void) fwrite (&buf[start], sizeof (buf[start]), end - start + 1, f)
+
+/* PatGen 2 uses this. */
+#define input2ints(a,b) zinput2ints (&a, &b)
+
+/* We need this only if TeX is being debugged. */
+#define input3ints(a,b,c) zinput3ints (&a, &b, &c)
+
+/* Allocate an array of a given type. Add 1 to size to account for the
+ fact that Pascal arrays are used from [1..size], unlike C arrays which
+ use [0..size). */
+#define xmallocarray(type,size) ((type*)xmalloc((size+1)*sizeof(type)))
+/* Same for reallocating an array. */
+#define xreallocarray(ptr,type,size) ((type*)xrealloc(ptr,(size+1)*sizeof(type)))
+
+/* BibTeX needs this to dynamically reallocate arrays. Too bad we can't
+ rely on stringification, or we could avoid the ARRAY_NAME arg.
+ Actually allocate one more than requests, so we can index the last
+ entry, as Pascal wants to do. */
+#define BIBXRETALLOC(array_name, array_var, type, size_var, new_size) do { \
+ fprintf (logfile, "Reallocated %s (elt_size=%d) to %ld items from %ld.\n", \
+ array_name, (int) sizeof (type), new_size, size_var); \
+ XRETALLOC (array_var, new_size + 1, type); \
+ size_var = new_size; \
+} while (0)
+
+/* Need precisely int for getopt, etc. */
+#define cinttype int
+
+/* Need this because web2c doesn't translate `var1,var2:^char' correctly
+ -- var2 lacks the *. */
+#define cstring string
+
+/* Not all C libraries have fabs, so we'll roll our own. */
+#undef fabs
+#define fabs(x) ((x) >= 0.0 ? (x) : -(x))
+
+/* TeX et al. have a variable free, but we also need the C routine. */
+#define libcfree free
+
+/* Tangle removes underscores from names. Put them back for things that
+ are defined in C with _'s. */
+#define extendfilename extend_filename
+#define findsuffix find_suffix
+#define FOPENRBINMODE FOPEN_RBIN_MODE
+#define FOPENRMODE FOPEN_R_MODE
+#define getoptlongonly getopt_long_only
+#define hasarg has_arg
+#define ISDIRSEP IS_DIR_SEP
+#define kpsebibformat kpse_bib_format
+#define kpsebstformat kpse_bst_format
+#define kpsefindfile kpse_find_file
+#define kpsefindmf kpse_find_mf
+#define kpsefindmft kpse_find_mft
+#define kpsefindofm kpse_find_ofm
+#define kpsefindovf kpse_find_ovf
+#define kpsefindtex kpse_find_tex
+#define kpsefindtfm kpse_find_tfm
+#define kpsefindvf kpse_find_vf
+#define kpseinitprog kpse_init_prog
+#define kpsesetprogname kpse_set_progname
+#define kpsesetprogramname kpse_set_program_name
+#define kpseresetprogramname kpse_reset_program_name
+#define kpsegfformat kpse_gf_format
+#define kpselastformat kpse_last_format
+#define kpsemaketexdiscarderrors kpse_make_tex_discard_errors
+#define kpsemfformat kpse_mf_format
+#define kpsemftformat kpse_mft_format
+#define kpsempformat kpse_mp_format
+#define kpseocpformat kpse_ocp_format
+#define kpseofmformat kpse_ofm_format
+#define kpseoplformat kpse_opl_format
+#define kpseotpformat kpse_otp_format
+#define kpseovpformat kpse_ovp_format
+#define kpseovfformat kpse_ovf_format
+#define kpseopenfile kpse_open_file
+#define kpsepkformat kpse_pk_format
+#define kpsetfmformat kpse_tfm_format
+#define kpsevfformat kpse_vf_format
+#define kpsewebformat kpse_web_format
+#define kpsevarvalue kpse_var_value
+#define kpsesetprogramenabled kpse_set_program_enabled
+#define kpsesrccmdline kpse_src_cmdline
+#define makesuffix make_suffix
+#define recorderchangefilename recorder_change_filename
+#define recorderenabled recorder_enabled
+#define removesuffix remove_suffix
+
+/* We need a new type for the argument parsing, too. */
+typedef struct option getoptstruct;
+
+/* We never need the `link' system call, which may be declared in
+ <unistd.h>, but we do have variables named `link' in the webs. */
+#undef link
+#define link link_var
+
+/* Throw away VMS' library routine `getname', as WEB uses that name. */
+#ifdef VMS
+#undef getname
+#define getname vms_getname
+#endif
+
+/* Declarations for the routines we provide ourselves in lib/. */
+
+extern string basenamechangesuffix P3H(const_string,const_string,const_string);
+extern string chartostring P1H(char);
+extern boolean eof P1H(FILE *);
+extern boolean eoln P1H(FILE *);
+extern void readln P1H(FILE *);
+extern void fprintreal P4H(FILE *, double, int, int);
+extern integer inputint P1H(FILE *);
+extern void printversionandexit P3H(const_string, const_string, const_string);
+extern void zinput2ints P2H(integer *, integer *);
+extern void zinput3ints P3H(integer *, integer *, integer *);
+extern integer zround P1H(double);
+
+/* main.c */
+extern int argc;
+extern string *argv;
+extern string cmdline P1H(int);
+extern TEXDLL void mainbody P1H(void); /* generated by web2c */
+
+/* openclose.c */
+extern boolean open_input P3H(FILE **, int, const_string fopen_mode);
+extern boolean open_output P2H(FILE **, const_string fopen_mode);
+extern void aclose P1H(FILE *);
+extern void recorder_change_filename P1H(string);
+extern boolean recorder_enabled;
+extern string output_directory;
+
+/* version.c */
+extern string versionstring;
+
+#endif /* not CPASCAL_H */
diff --git a/Build/source/texk/web2c/ctangleboot.c b/Build/source/texk/web2c/ctangleboot.c
new file mode 100644
index 00000000000..edfb55a0d90
--- /dev/null
+++ b/Build/source/texk/web2c/ctangleboot.c
@@ -0,0 +1,1620 @@
+/*1:*/
+#line 64 "./cwebdir/ctangle.w"
+
+/*5:*/
+#line 35 "./cwebdir/common.h"
+
+#line 93 "./cwebdir/ctang-w2c.ch"
+#include <stdio.h>
+
+extern char*versionstring;
+#include <kpathsea/kpathsea.h>
+#line 37 "./cwebdir/common.h"
+
+/*:5*//*61:*/
+#line 888 "./cwebdir/ctangle.w"
+
+#line 890 "./cwebdir/ctangle.w"
+#include <stdlib.h>
+
+/*:61*/
+#line 65 "./cwebdir/ctangle.w"
+
+#define banner "This is CTANGLE, Version 3.64" \
+
+#define max_bytes 90000 \
+
+#define max_toks 270000
+#define max_names 4000 \
+
+#define max_texts 2500
+#define hash_size 353
+#define longest_name 10000
+#define stack_size 50
+#define buf_size 100 \
+
+#define ctangle 0
+#define cweave 1 \
+
+#define and_and 04
+#define lt_lt 020
+#define gt_gt 021
+#define plus_plus 013
+#define minus_minus 01
+#define minus_gt 031
+#define not_eq 032
+#define lt_eq 034
+#define gt_eq 035
+#define eq_eq 036
+#define or_or 037
+#define dot_dot_dot 016
+#define colon_colon 06
+#define period_ast 026
+#define minus_gt_ast 027 \
+
+#define xisalpha(c) (isalpha(c) &&((eight_bits) c<0200) )
+#define xisdigit(c) (isdigit(c) &&((eight_bits) c<0200) )
+#define xisspace(c) (isspace(c) &&((eight_bits) c<0200) )
+#define xislower(c) (islower(c) &&((eight_bits) c<0200) )
+#define xisupper(c) (isupper(c) &&((eight_bits) c<0200) )
+#define xisxdigit(c) (isxdigit(c) &&((eight_bits) c<0200) ) \
+
+#define length(c) (c+1) ->byte_start-(c) ->byte_start
+#define print_id(c) term_write((c) ->byte_start,length((c) ) )
+#define llink link
+#define rlink dummy.Rlink
+#define root name_dir->rlink \
+
+#define chunk_marker 0 \
+
+#define spotless 0
+#define harmless_message 1
+#define error_message 2
+#define fatal_message 3
+#define mark_harmless {if(history==spotless) history= harmless_message;}
+#define mark_error history= error_message
+#define confusion(s) fatal("! This can't happen: ",s) \
+
+#define max_file_name_length 1024
+#define cur_file file[include_depth]
+#define cur_file_name file_name[include_depth]
+#define web_file_name file_name[0]
+#define cur_line line[include_depth] \
+
+#define show_banner flags['b']
+#define show_progress flags['p']
+#define show_happiness flags['h'] \
+
+#define update_terminal fflush(stdout)
+#define new_line putchar('\n')
+#define putxchar putchar
+#define term_write(a,b) fflush(stdout) ,fwrite(a,sizeof(char) ,b,stdout)
+#define C_printf(c,a) fprintf(C_file,c,a)
+#define C_putc(c) putc(c,C_file) \
+
+#define equiv equiv_or_xref \
+
+#define section_flag max_texts \
+
+#define string 02
+#define join 0177
+#define output_defs_flag (2*024000-1) \
+
+#define cur_end cur_state.end_field
+#define cur_byte cur_state.byte_field
+#define cur_name cur_state.name_field
+#define cur_repl cur_state.repl_field
+#define cur_section cur_state.section_field \
+
+#define section_number 0201
+#define identifier 0202 \
+
+#define normal 0
+#define num_or_id 1
+#define post_slash 2
+#define unbreakable 3
+#define verbatim 4 \
+
+#define max_files 256
+#define translit_length 10 \
+
+#define ignore 0
+#define ord 0302
+#define control_text 0303
+#define translit_code 0304
+#define output_defs_code 0305
+#define format_code 0306
+#define definition 0307
+#define begin_C 0310
+#define section_name 0311
+#define new_section 0312 \
+
+#define constant 03 \
+
+#define isxalpha(c) ((c) =='_'||(c) =='$') \
+
+#define ishigh(c) ((unsigned char) (c) > 0177) \
+ \
+
+#define compress(c) if(loc++<=limit) return(c) \
+
+#define macro 0
+#define app_repl(c) {if(tok_ptr==tok_mem_end) overflow("token") ;*tok_ptr++= c;} \
+
+
+#line 66 "./cwebdir/ctangle.w"
+
+/*4:*/
+#line 29 "./cwebdir/common.h"
+
+#line 31 "./cwebdir/common.h"
+typedef char unsigned eight_bits;
+extern boolean program;
+extern int phase;
+
+/*:4*//*6:*/
+#line 57 "./cwebdir/common.h"
+
+char section_text[longest_name+1];
+char*section_text_end= section_text+longest_name;
+char*id_first;
+char*id_loc;
+
+/*:6*//*7:*/
+#line 72 "./cwebdir/common.h"
+
+extern char buffer[];
+extern char*buffer_end;
+extern char*loc;
+extern char*limit;
+
+/*:7*//*8:*/
+#line 87 "./cwebdir/common.h"
+
+typedef struct name_info{
+char*byte_start;
+struct name_info*link;
+union{
+struct name_info*Rlink;
+
+char Ilk;
+}dummy;
+char*equiv_or_xref;
+}name_info;
+typedef name_info*name_pointer;
+typedef name_pointer*hash_pointer;
+extern char byte_mem[];
+extern char*byte_mem_end;
+extern name_info name_dir[];
+extern name_pointer name_dir_end;
+extern name_pointer name_ptr;
+extern char*byte_ptr;
+extern name_pointer hash[];
+extern hash_pointer hash_end;
+extern hash_pointer h;
+#line 106 "./cwebdir/ctang-w2c.ch"
+
+extern name_pointer id_lookup P3H(char*,char*,char);
+
+extern name_pointer section_lookup P3H(char*,char*,char);
+extern void print_section_name P1H(name_pointer);
+extern void sprint_section_name P2H(char*,name_pointer);
+#line 112 "./cwebdir/common.h"
+
+/*:8*//*9:*/
+#line 122 "./cwebdir/common.h"
+
+#line 123 "./cwebdir/ctang-w2c.ch"
+extern int history;
+extern void err_print P1H(char*);
+extern int wrap_up P1H(void);
+extern void fatal P2H(char*,char*);
+extern void overflow P1H(char*);
+#line 128 "./cwebdir/common.h"
+
+/*:9*//*10:*/
+#line 137 "./cwebdir/common.h"
+
+#line 141 "./cwebdir/ctang-w2c.ch"
+extern int include_depth;
+#line 139 "./cwebdir/common.h"
+extern FILE*file[];
+extern FILE*change_file;
+extern char C_file_name[];
+extern char tex_file_name[];
+extern char idx_file_name[];
+extern char scn_file_name[];
+extern char file_name[][max_file_name_length];
+
+extern char change_file_name[];
+#line 148 "./cwebdir/ctang-w2c.ch"
+extern int line[];
+extern int change_line;
+#line 150 "./cwebdir/common.h"
+extern boolean input_has_ended;
+extern boolean changing;
+extern boolean web_file_open;
+#line 157 "./cwebdir/ctang-w2c.ch"
+extern void reset_input P1H(void);
+extern int get_line P1H(void);
+extern void check_complete P1H(void);
+#line 156 "./cwebdir/common.h"
+
+/*:10*//*11:*/
+#line 158 "./cwebdir/common.h"
+
+typedef unsigned short sixteen_bits;
+extern sixteen_bits section_count;
+extern boolean changed_section[];
+extern boolean change_pending;
+extern boolean print_where;
+
+/*:11*//*12:*/
+#line 170 "./cwebdir/common.h"
+
+extern int argc;
+extern char**argv;
+extern boolean flags[];
+
+/*:12*//*13:*/
+#line 182 "./cwebdir/common.h"
+
+extern FILE*C_file;
+extern FILE*tex_file;
+extern FILE*idx_file;
+extern FILE*scn_file;
+extern FILE*active_file;
+
+/*:13*//*14:*/
+#line 191 "./cwebdir/common.h"
+
+#line 167 "./cwebdir/ctang-w2c.ch"
+extern void common_init P1H(void);
+#line 128 "./cwebdir/ctangle.w"
+
+/*:14*/
+#line 67 "./cwebdir/ctangle.w"
+
+/*15:*/
+#line 152 "./cwebdir/ctangle.w"
+
+typedef struct{
+eight_bits*tok_start;
+sixteen_bits text_link;
+}text;
+typedef text*text_pointer;
+
+/*:15*//*26:*/
+#line 296 "./cwebdir/ctangle.w"
+
+typedef struct{
+eight_bits*end_field;
+eight_bits*byte_field;
+name_pointer name_field;
+text_pointer repl_field;
+sixteen_bits section_field;
+}output_state;
+typedef output_state*stack_pointer;
+
+/*:26*/
+#line 68 "./cwebdir/ctangle.w"
+
+/*16:*/
+#line 159 "./cwebdir/ctangle.w"
+
+text text_info[max_texts];
+text_pointer text_info_end= text_info+max_texts-1;
+text_pointer text_ptr;
+eight_bits tok_mem[max_toks];
+eight_bits*tok_mem_end= tok_mem+max_toks-1;
+eight_bits*tok_ptr;
+
+/*:16*//*22:*/
+#line 227 "./cwebdir/ctangle.w"
+
+text_pointer last_unnamed;
+
+/*:22*//*27:*/
+#line 312 "./cwebdir/ctangle.w"
+
+output_state cur_state;
+
+output_state stack[stack_size+1];
+stack_pointer stack_ptr;
+stack_pointer stack_end= stack+stack_size;
+
+/*:27*//*31:*/
+#line 384 "./cwebdir/ctangle.w"
+
+int cur_val;
+
+/*:31*//*35:*/
+#line 473 "./cwebdir/ctangle.w"
+
+eight_bits out_state;
+boolean protect;
+
+/*:35*//*37:*/
+#line 502 "./cwebdir/ctangle.w"
+
+name_pointer output_files[max_files];
+name_pointer*cur_out_file,*end_output_files,*an_output_file;
+char cur_section_name_char;
+char output_file_name[longest_name];
+
+/*:37*//*44:*/
+#line 599 "./cwebdir/ctangle.w"
+
+boolean output_defs_seen= 0;
+
+/*:44*//*50:*/
+#line 710 "./cwebdir/ctangle.w"
+
+char translit[128][translit_length];
+
+/*:50*//*55:*/
+#line 789 "./cwebdir/ctangle.w"
+
+eight_bits ccode[256];
+
+/*:55*//*58:*/
+#line 845 "./cwebdir/ctangle.w"
+
+boolean comment_continues= 0;
+
+/*:58*//*60:*/
+#line 884 "./cwebdir/ctangle.w"
+
+name_pointer cur_section_name;
+int no_where;
+
+/*:60*//*74:*/
+#line 1195 "./cwebdir/ctangle.w"
+
+text_pointer cur_text;
+eight_bits next_control;
+
+/*:74*//*81:*/
+#line 1350 "./cwebdir/ctangle.w"
+
+extern sixteen_bits section_count;
+
+/*:81*/
+#line 69 "./cwebdir/ctangle.w"
+
+/*40:*/
+#line 533 "./cwebdir/ctangle.w"
+
+#line 244 "./cwebdir/ctang-w2c.ch"
+void phase_two P1H(void);
+#line 535 "./cwebdir/ctangle.w"
+
+/*:40*//*45:*/
+#line 602 "./cwebdir/ctangle.w"
+
+#line 260 "./cwebdir/ctang-w2c.ch"
+void output_defs P1H(void);
+#line 604 "./cwebdir/ctangle.w"
+
+/*:45*//*47:*/
+#line 648 "./cwebdir/ctangle.w"
+
+#line 276 "./cwebdir/ctang-w2c.ch"
+static void out_char P1H(eight_bits);
+#line 650 "./cwebdir/ctangle.w"
+
+/*:47*//*89:*/
+#line 1457 "./cwebdir/ctangle.w"
+
+#line 342 "./cwebdir/ctang-w2c.ch"
+void phase_one P1H(void);
+#line 1459 "./cwebdir/ctangle.w"
+
+/*:89*//*91:*/
+#line 1475 "./cwebdir/ctangle.w"
+
+#line 358 "./cwebdir/ctang-w2c.ch"
+void skip_limbo P1H(void);
+#line 1477 "./cwebdir/ctangle.w"
+
+/*:91*/
+#line 70 "./cwebdir/ctangle.w"
+
+
+#line 83 "./cwebdir/ctangle.w"
+
+/*:1*//*2:*/
+#line 91 "./cwebdir/ctangle.w"
+
+#line 70 "./cwebdir/ctang-w2c.ch"
+int main P2C(int,ac,char**,av)
+#line 95 "./cwebdir/ctangle.w"
+{
+argc= ac;argv= av;
+program= ctangle;
+/*17:*/
+#line 167 "./cwebdir/ctangle.w"
+
+text_info->tok_start= tok_ptr= tok_mem;
+text_ptr= text_info+1;text_ptr->tok_start= tok_mem;
+
+
+/*:17*//*19:*/
+#line 177 "./cwebdir/ctangle.w"
+
+name_dir->equiv= (char*)text_info;
+
+/*:19*//*23:*/
+#line 230 "./cwebdir/ctangle.w"
+last_unnamed= text_info;text_info->text_link= 0;
+
+/*:23*//*38:*/
+#line 512 "./cwebdir/ctangle.w"
+
+cur_out_file= end_output_files= output_files+max_files;
+
+/*:38*//*51:*/
+#line 713 "./cwebdir/ctangle.w"
+
+{
+int i;
+for(i= 0;i<128;i++)sprintf(translit[i],"X%02X",(unsigned)(128+i));
+}
+
+/*:51*//*56:*/
+#line 792 "./cwebdir/ctangle.w"
+{
+int c;
+for(c= 0;c<256;c++)ccode[c]= ignore;
+ccode[' ']= ccode['\t']= ccode['\n']= ccode['\v']= ccode['\r']= ccode['\f']
+= ccode['*']= new_section;
+ccode['@']= '@';ccode['=']= string;
+ccode['d']= ccode['D']= definition;
+ccode['f']= ccode['F']= ccode['s']= ccode['S']= format_code;
+ccode['c']= ccode['C']= ccode['p']= ccode['P']= begin_C;
+ccode['^']= ccode[':']= ccode['.']= ccode['t']= ccode['T']=
+ccode['q']= ccode['Q']= control_text;
+ccode['h']= ccode['H']= output_defs_code;
+ccode['l']= ccode['L']= translit_code;
+ccode['&']= join;
+ccode['<']= ccode['(']= section_name;
+ccode['\'']= ord;
+}
+
+/*:56*//*70:*/
+#line 1116 "./cwebdir/ctangle.w"
+section_text[0]= ' ';
+
+/*:70*/
+#line 98 "./cwebdir/ctangle.w"
+;
+common_init();
+#line 76 "./cwebdir/ctang-w2c.ch"
+if(show_banner){
+printf("%s%s\n",banner,versionstring);
+}
+#line 101 "./cwebdir/ctangle.w"
+phase_one();
+phase_two();
+return wrap_up();
+}
+
+/*:2*//*20:*/
+#line 183 "./cwebdir/ctangle.w"
+
+#line 178 "./cwebdir/ctang-w2c.ch"
+int names_match P4C(name_pointer,p,char*,first,int,l,char,t)
+#line 188 "./cwebdir/ctangle.w"
+{
+if(length(p)!=l)return 0;
+return!strncmp(first,p->byte_start,l);
+}
+
+/*:20*//*21:*/
+#line 198 "./cwebdir/ctangle.w"
+
+void
+#line 187 "./cwebdir/ctang-w2c.ch"
+ init_node P1C(name_pointer,node)
+#line 202 "./cwebdir/ctangle.w"
+{
+node->equiv= (char*)text_info;
+}
+void
+#line 193 "./cwebdir/ctang-w2c.ch"
+ init_p P2C(name_pointer,p,char,t){}
+#line 207 "./cwebdir/ctangle.w"
+
+/*:21*//*25:*/
+#line 260 "./cwebdir/ctangle.w"
+
+void
+#line 202 "./cwebdir/ctang-w2c.ch"
+ store_two_bytes P1C(sixteen_bits,x)
+#line 264 "./cwebdir/ctangle.w"
+{
+if(tok_ptr+2> tok_mem_end)overflow("token");
+*tok_ptr++= x>>8;
+*tok_ptr++= x&0377;
+}
+
+/*:25*//*29:*/
+#line 336 "./cwebdir/ctangle.w"
+
+void
+#line 211 "./cwebdir/ctang-w2c.ch"
+ push_level P1C(name_pointer,p)
+#line 340 "./cwebdir/ctangle.w"
+{
+if(stack_ptr==stack_end)overflow("stack");
+*stack_ptr= cur_state;
+stack_ptr++;
+if(p!=NULL){
+cur_name= p;cur_repl= (text_pointer)p->equiv;
+cur_byte= cur_repl->tok_start;cur_end= (cur_repl+1)->tok_start;
+cur_section= 0;
+}
+}
+
+/*:29*//*30:*/
+#line 355 "./cwebdir/ctangle.w"
+
+void
+#line 220 "./cwebdir/ctang-w2c.ch"
+ pop_level P1C(int,flag)
+#line 359 "./cwebdir/ctangle.w"
+{
+if(flag&&cur_repl->text_link<section_flag){
+cur_repl= cur_repl->text_link+text_info;
+cur_byte= cur_repl->tok_start;cur_end= (cur_repl+1)->tok_start;
+return;
+}
+stack_ptr--;
+if(stack_ptr> stack)cur_state= *stack_ptr;
+}
+
+/*:30*//*32:*/
+#line 391 "./cwebdir/ctangle.w"
+
+void
+#line 228 "./cwebdir/ctang-w2c.ch"
+ get_output P1H(void)
+#line 394 "./cwebdir/ctangle.w"
+{
+sixteen_bits a;
+restart:if(stack_ptr==stack)return;
+if(cur_byte==cur_end){
+cur_val= -((int)cur_section);
+pop_level(1);
+if(cur_val==0)goto restart;
+out_char(section_number);return;
+}
+a= *cur_byte++;
+if(out_state==verbatim&&a!=string&&a!=constant&&a!='\n')
+C_putc(a);
+else if(a<0200)out_char(a);
+else{
+a= (a-0200)*0400+*cur_byte++;
+switch(a/024000){
+case 0:cur_val= a;out_char(identifier);break;
+case 1:if(a==output_defs_flag)output_defs();
+else/*33:*/
+#line 423 "./cwebdir/ctangle.w"
+
+{
+a-= 024000;
+if((a+name_dir)->equiv!=(char*)text_info)push_level(a+name_dir);
+else if(a!=0){
+printf("\n! Not present: <");
+print_section_name(a+name_dir);err_print(">");
+
+}
+goto restart;
+}
+
+/*:33*/
+#line 412 "./cwebdir/ctangle.w"
+;
+break;
+default:cur_val= a-050000;if(cur_val> 0)cur_section= cur_val;
+out_char(section_number);
+}
+}
+}
+
+/*:32*//*36:*/
+#line 481 "./cwebdir/ctangle.w"
+
+void
+#line 236 "./cwebdir/ctang-w2c.ch"
+ flush_buffer P1H(void)
+#line 484 "./cwebdir/ctangle.w"
+{
+C_putc('\n');
+if(cur_line%100==0&&show_progress){
+printf(".");
+if(cur_line%500==0)printf("%d",cur_line);
+update_terminal;
+}
+cur_line++;
+}
+
+/*:36*//*41:*/
+#line 536 "./cwebdir/ctangle.w"
+
+void
+#line 252 "./cwebdir/ctang-w2c.ch"
+ phase_two P1H(void){
+#line 539 "./cwebdir/ctangle.w"
+web_file_open= 0;
+cur_line= 1;
+/*28:*/
+#line 325 "./cwebdir/ctangle.w"
+
+stack_ptr= stack+1;cur_name= name_dir;cur_repl= text_info->text_link+text_info;
+cur_byte= cur_repl->tok_start;cur_end= (cur_repl+1)->tok_start;cur_section= 0;
+
+/*:28*/
+#line 541 "./cwebdir/ctangle.w"
+;
+/*43:*/
+#line 595 "./cwebdir/ctangle.w"
+
+if(!output_defs_seen)
+output_defs();
+
+/*:43*/
+#line 542 "./cwebdir/ctangle.w"
+;
+if(text_info->text_link==0&&cur_out_file==end_output_files){
+printf("\n! No program text was specified.");mark_harmless;
+
+}
+else{
+if(cur_out_file==end_output_files){
+if(show_progress)
+printf("\nWriting the output file (%s):",C_file_name);
+}
+else{
+if(show_progress){
+printf("\nWriting the output files:");
+
+printf(" (%s)",C_file_name);
+update_terminal;
+}
+if(text_info->text_link==0)goto writeloop;
+}
+while(stack_ptr> stack)get_output();
+flush_buffer();
+writeloop:/*42:*/
+#line 572 "./cwebdir/ctangle.w"
+
+for(an_output_file= end_output_files;an_output_file> cur_out_file;){
+an_output_file--;
+sprint_section_name(output_file_name,*an_output_file);
+fclose(C_file);
+C_file= fopen(output_file_name,"w");
+if(C_file==0)fatal("! Cannot open output file:",output_file_name);
+
+printf("\n(%s)",output_file_name);update_terminal;
+cur_line= 1;
+stack_ptr= stack+1;
+cur_name= (*an_output_file);
+cur_repl= (text_pointer)cur_name->equiv;
+cur_byte= cur_repl->tok_start;
+cur_end= (cur_repl+1)->tok_start;
+while(stack_ptr> stack)get_output();
+flush_buffer();
+}
+
+/*:42*/
+#line 563 "./cwebdir/ctangle.w"
+;
+if(show_happiness)printf("\nDone.");
+}
+}
+
+/*:41*//*46:*/
+#line 605 "./cwebdir/ctangle.w"
+
+void
+#line 268 "./cwebdir/ctang-w2c.ch"
+ output_defs P1H(void)
+#line 608 "./cwebdir/ctangle.w"
+{
+sixteen_bits a;
+push_level(NULL);
+for(cur_text= text_info+1;cur_text<text_ptr;cur_text++)
+if(cur_text->text_link==0){
+cur_byte= cur_text->tok_start;
+cur_end= (cur_text+1)->tok_start;
+C_printf("%s","#define ");
+out_state= normal;
+protect= 1;
+while(cur_byte<cur_end){
+a= *cur_byte++;
+if(cur_byte==cur_end&&a=='\n')break;
+if(out_state==verbatim&&a!=string&&a!=constant&&a!='\n')
+C_putc(a);
+
+else if(a<0200)out_char(a);
+else{
+a= (a-0200)*0400+*cur_byte++;
+if(a<024000){
+cur_val= a;out_char(identifier);
+}
+else if(a<050000){confusion("macro defs have strange char");}
+else{
+cur_val= a-050000;cur_section= cur_val;out_char(section_number);
+}
+
+}
+}
+protect= 0;
+flush_buffer();
+}
+pop_level(0);
+}
+
+/*:46*//*48:*/
+#line 651 "./cwebdir/ctangle.w"
+
+static void
+#line 285 "./cwebdir/ctang-w2c.ch"
+ out_char P1C(eight_bits,cur_char)
+#line 655 "./cwebdir/ctangle.w"
+{
+char*j,*k;
+restart:
+switch(cur_char){
+case'\n':if(protect&&out_state!=verbatim)C_putc(' ');
+if(protect||out_state==verbatim)C_putc('\\');
+flush_buffer();if(out_state!=verbatim)out_state= normal;break;
+/*52:*/
+#line 719 "./cwebdir/ctangle.w"
+
+case identifier:
+if(out_state==num_or_id)C_putc(' ');
+j= (cur_val+name_dir)->byte_start;
+k= (cur_val+name_dir+1)->byte_start;
+while(j<k){
+if((unsigned char)(*j)<0200)C_putc(*j);
+
+else C_printf("%s",translit[(unsigned char)(*j)-0200]);
+j++;
+}
+out_state= num_or_id;break;
+
+/*:52*/
+#line 662 "./cwebdir/ctangle.w"
+;
+/*53:*/
+#line 732 "./cwebdir/ctangle.w"
+
+case section_number:
+if(cur_val> 0)C_printf("/*%d:*/",cur_val);
+else if(cur_val<0)C_printf("/*:%d*/",-cur_val);
+else if(protect){
+cur_byte+= 4;
+cur_char= '\n';
+goto restart;
+}else{
+sixteen_bits a;
+a= 0400**cur_byte++;
+a+= *cur_byte++;
+C_printf("\n#line %d \"",a);
+
+cur_val= *cur_byte++;
+cur_val= 0400*(cur_val-0200)+*cur_byte++;
+for(j= (cur_val+name_dir)->byte_start,k= (cur_val+name_dir+1)->byte_start;
+j<k;j++){
+if(*j=='\\'||*j=='"')C_putc('\\');
+C_putc(*j);
+}
+C_printf("%s","\"\n");
+}
+break;
+
+/*:53*/
+#line 663 "./cwebdir/ctangle.w"
+;
+/*49:*/
+#line 681 "./cwebdir/ctangle.w"
+
+case plus_plus:C_putc('+');C_putc('+');out_state= normal;break;
+case minus_minus:C_putc('-');C_putc('-');out_state= normal;break;
+case minus_gt:C_putc('-');C_putc('>');out_state= normal;break;
+case gt_gt:C_putc('>');C_putc('>');out_state= normal;break;
+case eq_eq:C_putc('=');C_putc('=');out_state= normal;break;
+case lt_lt:C_putc('<');C_putc('<');out_state= normal;break;
+case gt_eq:C_putc('>');C_putc('=');out_state= normal;break;
+case lt_eq:C_putc('<');C_putc('=');out_state= normal;break;
+case not_eq:C_putc('!');C_putc('=');out_state= normal;break;
+case and_and:C_putc('&');C_putc('&');out_state= normal;break;
+case or_or:C_putc('|');C_putc('|');out_state= normal;break;
+case dot_dot_dot:C_putc('.');C_putc('.');C_putc('.');out_state= normal;
+break;
+case colon_colon:C_putc(':');C_putc(':');out_state= normal;break;
+case period_ast:C_putc('.');C_putc('*');out_state= normal;break;
+case minus_gt_ast:C_putc('-');C_putc('>');C_putc('*');out_state= normal;
+break;
+
+/*:49*/
+#line 664 "./cwebdir/ctangle.w"
+;
+case'=':case'>':C_putc(cur_char);C_putc(' ');
+out_state= normal;break;
+case join:out_state= unbreakable;break;
+case constant:if(out_state==verbatim){
+out_state= num_or_id;break;
+}
+if(out_state==num_or_id)C_putc(' ');out_state= verbatim;break;
+case string:if(out_state==verbatim)out_state= normal;
+else out_state= verbatim;break;
+case'/':C_putc('/');out_state= post_slash;break;
+case'*':if(out_state==post_slash)C_putc(' ');
+
+default:C_putc(cur_char);out_state= normal;break;
+}
+}
+
+/*:48*//*57:*/
+#line 813 "./cwebdir/ctangle.w"
+
+eight_bits
+#line 293 "./cwebdir/ctang-w2c.ch"
+ skip_ahead P1H(void)
+#line 816 "./cwebdir/ctangle.w"
+{
+eight_bits c;
+while(1){
+if(loc> limit&&(get_line()==0))return(new_section);
+*(limit+1)= '@';
+while(*loc!='@')loc++;
+if(loc<=limit){
+loc++;c= ccode[(eight_bits)*loc];loc++;
+if(c!=ignore||*(loc-1)=='>')return(c);
+}
+}
+}
+
+/*:57*//*59:*/
+#line 848 "./cwebdir/ctangle.w"
+
+#line 302 "./cwebdir/ctang-w2c.ch"
+int skip_comment P1C(boolean,is_long_comment)
+#line 851 "./cwebdir/ctangle.w"
+{
+char c;
+while(1){
+if(loc> limit){
+if(is_long_comment){
+if(get_line())return(comment_continues= 1);
+else{
+err_print("! Input ended in mid-comment");
+
+return(comment_continues= 0);
+}
+}
+else return(comment_continues= 0);
+}
+c= *(loc++);
+if(is_long_comment&&c=='*'&&*loc=='/'){
+loc++;return(comment_continues= 0);
+}
+if(c=='@'){
+if(ccode[(eight_bits)*loc]==new_section){
+err_print("! Section name ended in mid-comment");loc--;
+
+return(comment_continues= 0);
+}
+else loc++;
+}
+}
+}
+
+/*:59*//*62:*/
+#line 900 "./cwebdir/ctangle.w"
+
+eight_bits
+#line 317 "./cwebdir/ctang-w2c.ch"
+ get_next P1H(void)
+#line 903 "./cwebdir/ctangle.w"
+{
+static int preprocessing= 0;
+eight_bits c;
+while(1){
+if(loc> limit){
+if(preprocessing&&*(limit-1)!='\\')preprocessing= 0;
+if(get_line()==0)return(new_section);
+else if(print_where&&!no_where){
+print_where= 0;
+/*76:*/
+#line 1225 "./cwebdir/ctangle.w"
+
+store_two_bytes(0150000);
+if(changing)id_first= change_file_name;
+else id_first= cur_file_name;
+id_loc= id_first+strlen(id_first);
+if(changing)store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a= id_lookup(id_first,id_loc,0)-name_dir;app_repl((a/0400)+0200);
+app_repl(a%0400);}
+
+/*:76*/
+#line 912 "./cwebdir/ctangle.w"
+;
+}
+else return('\n');
+}
+c= *loc;
+if(comment_continues||(c=='/'&&(*(loc+1)=='*'||*(loc+1)=='/'))){
+skip_comment(comment_continues||*(loc+1)=='*');
+
+if(comment_continues)return('\n');
+else continue;
+}
+loc++;
+if(xisdigit(c)||c=='.')/*65:*/
+#line 978 "./cwebdir/ctangle.w"
+{
+id_first= loc-1;
+if(*id_first=='.'&&!xisdigit(*loc))goto mistake;
+if(*id_first=='0'){
+if(*loc=='x'||*loc=='X'){
+loc++;while(xisxdigit(*loc))loc++;goto found;
+}
+}
+while(xisdigit(*loc))loc++;
+if(*loc=='.'){
+loc++;
+while(xisdigit(*loc))loc++;
+}
+if(*loc=='e'||*loc=='E'){
+if(*++loc=='+'||*loc=='-')loc++;
+while(xisdigit(*loc))loc++;
+}
+found:while(*loc=='u'||*loc=='U'||*loc=='l'||*loc=='L'
+||*loc=='f'||*loc=='F')loc++;
+id_loc= loc;
+return(constant);
+}
+
+/*:65*/
+#line 924 "./cwebdir/ctangle.w"
+
+else if(c=='\''||c=='"'||(c=='L'&&(*loc=='\''||*loc=='"')))
+/*66:*/
+#line 1006 "./cwebdir/ctangle.w"
+{
+char delim= c;
+id_first= section_text+1;
+id_loc= section_text;*++id_loc= delim;
+if(delim=='L'){
+delim= *loc++;*++id_loc= delim;
+}
+while(1){
+if(loc>=limit){
+if(*(limit-1)!='\\'){
+err_print("! String didn't end");loc= limit;break;
+
+}
+if(get_line()==0){
+err_print("! Input ended in middle of string");loc= buffer;break;
+
+}
+else if(++id_loc<=section_text_end)*id_loc= '\n';
+
+}
+if((c= *loc++)==delim){
+if(++id_loc<=section_text_end)*id_loc= c;
+break;
+}
+if(c=='\\'){
+if(loc>=limit)continue;
+if(++id_loc<=section_text_end)*id_loc= '\\';
+c= *loc++;
+}
+if(++id_loc<=section_text_end)*id_loc= c;
+}
+if(id_loc>=section_text_end){
+printf("\n! String too long: ");
+
+term_write(section_text+1,25);
+err_print("...");
+}
+id_loc++;
+return(string);
+}
+
+/*:66*/
+#line 926 "./cwebdir/ctangle.w"
+
+else if(isalpha(c)||isxalpha(c)||ishigh(c))
+/*64:*/
+#line 972 "./cwebdir/ctangle.w"
+{
+id_first= --loc;
+while(isalpha(*++loc)||isdigit(*loc)||isxalpha(*loc)||ishigh(*loc));
+id_loc= loc;return(identifier);
+}
+
+/*:64*/
+#line 928 "./cwebdir/ctangle.w"
+
+else if(c=='@')/*67:*/
+#line 1050 "./cwebdir/ctangle.w"
+{
+c= ccode[(eight_bits)*loc++];
+switch(c){
+case ignore:continue;
+case translit_code:err_print("! Use @l in limbo only");continue;
+
+case control_text:while((c= skip_ahead())=='@');
+
+if(*(loc-1)!='>')
+err_print("! Double @ should be used in control text");
+
+continue;
+case section_name:
+cur_section_name_char= *(loc-1);
+/*69:*/
+#line 1098 "./cwebdir/ctangle.w"
+{
+char*k;
+/*71:*/
+#line 1118 "./cwebdir/ctangle.w"
+
+k= section_text;
+while(1){
+if(loc> limit&&get_line()==0){
+err_print("! Input ended in section name");
+
+loc= buffer+1;break;
+}
+c= *loc;
+/*72:*/
+#line 1142 "./cwebdir/ctangle.w"
+
+if(c=='@'){
+c= *(loc+1);
+if(c=='>'){
+loc+= 2;break;
+}
+if(ccode[(eight_bits)c]==new_section){
+err_print("! Section name didn't end");break;
+
+}
+if(ccode[(eight_bits)c]==section_name){
+err_print("! Nesting of section names not allowed");break;
+
+}
+*(++k)= '@';loc++;
+}
+
+/*:72*/
+#line 1127 "./cwebdir/ctangle.w"
+;
+loc++;if(k<section_text_end)k++;
+if(xisspace(c)){
+c= ' ';if(*(k-1)==' ')k--;
+}
+*k= c;
+}
+if(k>=section_text_end){
+printf("\n! Section name too long: ");
+
+term_write(section_text+1,25);
+printf("...");mark_harmless;
+}
+if(*k==' '&&k> section_text)k--;
+
+/*:71*/
+#line 1100 "./cwebdir/ctangle.w"
+;
+if(k-section_text> 3&&strncmp(k-2,"...",3)==0)
+cur_section_name= section_lookup(section_text+1,k-3,1);
+else cur_section_name= section_lookup(section_text+1,k,0);
+if(cur_section_name_char=='(')
+/*39:*/
+#line 516 "./cwebdir/ctangle.w"
+
+{
+for(an_output_file= cur_out_file;
+an_output_file<end_output_files;an_output_file++)
+if(*an_output_file==cur_section_name)break;
+if(an_output_file==end_output_files){
+if(cur_out_file> output_files)
+*--cur_out_file= cur_section_name;
+else{
+overflow("output files");
+}
+}
+}
+
+/*:39*/
+#line 1106 "./cwebdir/ctangle.w"
+;
+return(section_name);
+}
+
+/*:69*/
+#line 1064 "./cwebdir/ctangle.w"
+;
+case string:/*73:*/
+#line 1164 "./cwebdir/ctangle.w"
+{
+id_first= loc++;*(limit+1)= '@';*(limit+2)= '>';
+while(*loc!='@'||*(loc+1)!='>')loc++;
+if(loc>=limit)err_print("! Verbatim string didn't end");
+
+id_loc= loc;loc+= 2;
+return(string);
+}
+
+/*:73*/
+#line 1065 "./cwebdir/ctangle.w"
+;
+case ord:/*68:*/
+#line 1077 "./cwebdir/ctangle.w"
+
+id_first= loc;
+if(*loc=='\\'){
+if(*++loc=='\'')loc++;
+}
+while(*loc!='\''){
+if(*loc=='@'){
+if(*(loc+1)!='@')
+err_print("! Double @ should be used in ASCII constant");
+
+else loc++;
+}
+loc++;
+if(loc> limit){
+err_print("! String didn't end");loc= limit-1;break;
+
+}
+}
+loc++;
+return(ord);
+
+/*:68*/
+#line 1066 "./cwebdir/ctangle.w"
+;
+default:return(c);
+}
+}
+
+/*:67*/
+#line 929 "./cwebdir/ctangle.w"
+
+else if(xisspace(c)){
+if(!preprocessing||loc> limit)continue;
+
+else return(' ');
+}
+else if(c=='#'&&loc==buffer+1)preprocessing= 1;
+mistake:/*63:*/
+#line 950 "./cwebdir/ctangle.w"
+
+switch(c){
+case'+':if(*loc=='+')compress(plus_plus);break;
+case'-':if(*loc=='-'){compress(minus_minus);}
+else if(*loc=='>')if(*(loc+1)=='*'){loc++;compress(minus_gt_ast);}
+else compress(minus_gt);break;
+case'.':if(*loc=='*'){compress(period_ast);}
+else if(*loc=='.'&&*(loc+1)=='.'){
+loc++;compress(dot_dot_dot);
+}
+break;
+case':':if(*loc==':')compress(colon_colon);break;
+case'=':if(*loc=='=')compress(eq_eq);break;
+case'>':if(*loc=='='){compress(gt_eq);}
+else if(*loc=='>')compress(gt_gt);break;
+case'<':if(*loc=='='){compress(lt_eq);}
+else if(*loc=='<')compress(lt_lt);break;
+case'&':if(*loc=='&')compress(and_and);break;
+case'|':if(*loc=='|')compress(or_or);break;
+case'!':if(*loc=='=')compress(not_eq);break;
+}
+
+/*:63*/
+#line 936 "./cwebdir/ctangle.w"
+
+return(c);
+}
+}
+
+/*:62*//*75:*/
+#line 1199 "./cwebdir/ctangle.w"
+
+void
+#line 326 "./cwebdir/ctang-w2c.ch"
+ scan_repl P1C(eight_bits,t)
+#line 1203 "./cwebdir/ctangle.w"
+{
+sixteen_bits a;
+if(t==section_name){/*76:*/
+#line 1225 "./cwebdir/ctangle.w"
+
+store_two_bytes(0150000);
+if(changing)id_first= change_file_name;
+else id_first= cur_file_name;
+id_loc= id_first+strlen(id_first);
+if(changing)store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a= id_lookup(id_first,id_loc,0)-name_dir;app_repl((a/0400)+0200);
+app_repl(a%0400);}
+
+/*:76*/
+#line 1205 "./cwebdir/ctangle.w"
+;}
+while(1)switch(a= get_next()){
+/*77:*/
+#line 1235 "./cwebdir/ctangle.w"
+
+case identifier:a= id_lookup(id_first,id_loc,0)-name_dir;
+app_repl((a/0400)+0200);
+app_repl(a%0400);break;
+case section_name:if(t!=section_name)goto done;
+else{
+/*78:*/
+#line 1268 "./cwebdir/ctangle.w"
+{
+char*try_loc= loc;
+while(*try_loc==' '&&try_loc<limit)try_loc++;
+if(*try_loc=='+'&&try_loc<limit)try_loc++;
+while(*try_loc==' '&&try_loc<limit)try_loc++;
+if(*try_loc=='=')err_print("! Missing `@ ' before a named section");
+
+
+
+}
+
+/*:78*/
+#line 1241 "./cwebdir/ctangle.w"
+;
+a= cur_section_name-name_dir;
+app_repl((a/0400)+0250);
+app_repl(a%0400);
+/*76:*/
+#line 1225 "./cwebdir/ctangle.w"
+
+store_two_bytes(0150000);
+if(changing)id_first= change_file_name;
+else id_first= cur_file_name;
+id_loc= id_first+strlen(id_first);
+if(changing)store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a= id_lookup(id_first,id_loc,0)-name_dir;app_repl((a/0400)+0200);
+app_repl(a%0400);}
+
+/*:76*/
+#line 1245 "./cwebdir/ctangle.w"
+;break;
+}
+case output_defs_code:if(t!=section_name)err_print("! Misplaced @h");
+
+else{
+output_defs_seen= 1;
+a= output_defs_flag;
+app_repl((a/0400)+0200);
+app_repl(a%0400);
+/*76:*/
+#line 1225 "./cwebdir/ctangle.w"
+
+store_two_bytes(0150000);
+if(changing)id_first= change_file_name;
+else id_first= cur_file_name;
+id_loc= id_first+strlen(id_first);
+if(changing)store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a= id_lookup(id_first,id_loc,0)-name_dir;app_repl((a/0400)+0200);
+app_repl(a%0400);}
+
+/*:76*/
+#line 1254 "./cwebdir/ctangle.w"
+;
+}
+break;
+case constant:case string:
+/*79:*/
+#line 1279 "./cwebdir/ctangle.w"
+
+app_repl(a);
+while(id_first<id_loc){
+if(*id_first=='@'){
+if(*(id_first+1)=='@')id_first++;
+else err_print("! Double @ should be used in string");
+
+}
+app_repl(*id_first++);
+}
+app_repl(a);break;
+
+/*:79*/
+#line 1258 "./cwebdir/ctangle.w"
+;
+case ord:
+/*80:*/
+#line 1295 "./cwebdir/ctangle.w"
+{
+int c= (eight_bits)*id_first;
+if(c=='\\'){
+c= *++id_first;
+if(c>='0'&&c<='7'){
+c-= '0';
+if(*(id_first+1)>='0'&&*(id_first+1)<='7'){
+c= 8*c+*(++id_first)-'0';
+if(*(id_first+1)>='0'&&*(id_first+1)<='7'&&c<32)
+c= 8*c+*(++id_first)-'0';
+}
+}
+else switch(c){
+case't':c= '\t';break;
+case'n':c= '\n';break;
+case'b':c= '\b';break;
+case'f':c= '\f';break;
+case'v':c= '\v';break;
+case'r':c= '\r';break;
+case'a':c= '\7';break;
+case'?':c= '?';break;
+case'x':
+if(xisdigit(*(id_first+1)))c= *(++id_first)-'0';
+else if(xisxdigit(*(id_first+1))){
+++id_first;
+c= toupper(*id_first)-'A'+10;
+}
+if(xisdigit(*(id_first+1)))c= 16*c+*(++id_first)-'0';
+else if(xisxdigit(*(id_first+1))){
+++id_first;
+c= 16*c+toupper(*id_first)-'A'+10;
+}
+break;
+case'\\':c= '\\';break;
+case'\'':c= '\'';break;
+case'\"':c= '\"';break;
+default:err_print("! Unrecognized escape sequence");
+
+}
+}
+
+app_repl(constant);
+if(c>=100)app_repl('0'+c/100);
+if(c>=10)app_repl('0'+(c/10)%10);
+app_repl('0'+c%10);
+app_repl(constant);
+}
+break;
+
+/*:80*/
+#line 1260 "./cwebdir/ctangle.w"
+;
+case definition:case format_code:case begin_C:if(t!=section_name)goto done;
+else{
+err_print("! @d, @f and @c are ignored in C text");continue;
+
+}
+case new_section:goto done;
+
+/*:77*/
+#line 1210 "./cwebdir/ctangle.w"
+
+case')':app_repl(a);
+if(t==macro)app_repl(' ');
+break;
+default:app_repl(a);
+}
+done:next_control= (eight_bits)a;
+if(text_ptr> text_info_end)overflow("text");
+cur_text= text_ptr;(++text_ptr)->tok_start= tok_ptr;
+}
+
+/*:75*//*82:*/
+#line 1357 "./cwebdir/ctangle.w"
+
+void
+#line 334 "./cwebdir/ctang-w2c.ch"
+ scan_section P1H(void)
+#line 1360 "./cwebdir/ctangle.w"
+{
+name_pointer p;
+text_pointer q;
+sixteen_bits a;
+section_count++;no_where= 1;
+if(*(loc-1)=='*'&&show_progress){
+printf("*%d",section_count);update_terminal;
+}
+next_control= 0;
+while(1){
+/*83:*/
+#line 1396 "./cwebdir/ctangle.w"
+
+while(next_control<definition)
+
+if((next_control= skip_ahead())==section_name){
+loc-= 2;next_control= get_next();
+}
+
+/*:83*/
+#line 1371 "./cwebdir/ctangle.w"
+;
+if(next_control==definition){
+/*84:*/
+#line 1403 "./cwebdir/ctangle.w"
+{
+while((next_control= get_next())=='\n');
+if(next_control!=identifier){
+err_print("! Definition flushed, must start with identifier");
+
+continue;
+}
+app_repl(((a= id_lookup(id_first,id_loc,0)-name_dir)/0400)+0200);
+
+app_repl(a%0400);
+if(*loc!='('){
+app_repl(string);app_repl(' ');app_repl(string);
+}
+scan_repl(macro);
+cur_text->text_link= 0;
+}
+
+/*:84*/
+#line 1373 "./cwebdir/ctangle.w"
+
+continue;
+}
+if(next_control==begin_C){
+p= name_dir;break;
+}
+if(next_control==section_name){
+p= cur_section_name;
+/*85:*/
+#line 1428 "./cwebdir/ctangle.w"
+
+while((next_control= get_next())=='+');
+if(next_control!='='&&next_control!=eq_eq)
+continue;
+
+/*:85*/
+#line 1381 "./cwebdir/ctangle.w"
+;
+break;
+}
+return;
+}
+no_where= print_where= 0;
+/*86:*/
+#line 1433 "./cwebdir/ctangle.w"
+
+/*87:*/
+#line 1438 "./cwebdir/ctangle.w"
+
+store_two_bytes((sixteen_bits)(0150000+section_count));
+
+
+/*:87*/
+#line 1434 "./cwebdir/ctangle.w"
+;
+scan_repl(section_name);
+/*88:*/
+#line 1442 "./cwebdir/ctangle.w"
+
+if(p==name_dir||p==0){
+(last_unnamed)->text_link= cur_text-text_info;last_unnamed= cur_text;
+}
+else if(p->equiv==(char*)text_info)p->equiv= (char*)cur_text;
+
+else{
+q= (text_pointer)p->equiv;
+while(q->text_link<section_flag)
+q= q->text_link+text_info;
+q->text_link= cur_text-text_info;
+}
+cur_text->text_link= section_flag;
+
+
+/*:88*/
+#line 1436 "./cwebdir/ctangle.w"
+;
+
+/*:86*/
+#line 1387 "./cwebdir/ctangle.w"
+;
+}
+
+/*:82*//*90:*/
+#line 1460 "./cwebdir/ctangle.w"
+
+void
+#line 350 "./cwebdir/ctang-w2c.ch"
+ phase_one P1H(void){
+#line 1463 "./cwebdir/ctangle.w"
+phase= 1;
+section_count= 0;
+reset_input();
+skip_limbo();
+while(!input_has_ended)scan_section();
+check_complete();
+phase= 2;
+}
+
+/*:90*//*92:*/
+#line 1478 "./cwebdir/ctangle.w"
+
+void
+#line 366 "./cwebdir/ctang-w2c.ch"
+ skip_limbo P1H(void)
+#line 1481 "./cwebdir/ctangle.w"
+{
+char c;
+while(1){
+if(loc> limit&&get_line()==0)return;
+*(limit+1)= '@';
+while(*loc!='@')loc++;
+if(loc++<=limit){
+c= *loc++;
+if(ccode[(eight_bits)c]==new_section)break;
+switch(ccode[(eight_bits)c]){
+case translit_code:/*93:*/
+#line 1507 "./cwebdir/ctangle.w"
+
+while(xisspace(*loc)&&loc<limit)loc++;
+loc+= 3;
+if(loc> limit||!xisxdigit(*(loc-3))||!xisxdigit(*(loc-2))
+||(*(loc-3)>='0'&&*(loc-3)<='7')||!xisspace(*(loc-1)))
+err_print("! Improper hex number following @l");
+
+else{
+unsigned i;
+char*beg;
+sscanf(loc-3,"%x",&i);
+while(xisspace(*loc)&&loc<limit)loc++;
+beg= loc;
+while(loc<limit&&(xisalpha(*loc)||xisdigit(*loc)||*loc=='_'))loc++;
+if(loc-beg>=translit_length)
+err_print("! Replacement string in @l too long");
+
+else{
+strncpy(translit[i-0200],beg,loc-beg);
+translit[i-0200][loc-beg]= '\0';
+}
+}
+
+/*:93*/
+#line 1491 "./cwebdir/ctangle.w"
+;break;
+case format_code:case'@':break;
+case control_text:if(c=='q'||c=='Q'){
+while((c= skip_ahead())=='@');
+if(*(loc-1)!='>')
+err_print("! Double @ should be used in control text");
+
+break;
+}
+default:err_print("! Double @ should be used in limbo");
+
+}
+}
+}
+}
+
+/*:92*//*94:*/
+#line 1533 "./cwebdir/ctangle.w"
+
+void
+#line 374 "./cwebdir/ctang-w2c.ch"
+ print_stats P1H(void){
+#line 1536 "./cwebdir/ctangle.w"
+printf("\nMemory usage statistics:\n");
+printf("%ld names (out of %ld)\n",
+(long)(name_ptr-name_dir),(long)max_names);
+printf("%ld replacement texts (out of %ld)\n",
+(long)(text_ptr-text_info),(long)max_texts);
+printf("%ld bytes (out of %ld)\n",
+(long)(byte_ptr-byte_mem),(long)max_bytes);
+printf("%ld tokens (out of %ld)\n",
+(long)(tok_ptr-tok_mem),(long)max_toks);
+}
+
+/*:94*/
diff --git a/Build/source/texk/web2c/ctiedir/ChangeLog b/Build/source/texk/web2c/ctiedir/ChangeLog
new file mode 100644
index 00000000000..92650a4454c
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ChangeLog
@@ -0,0 +1,34 @@
+2005-02-05 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * ctie.1: Correct header from TIE to CTIE.
+
+2005-01-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * ctie.1 (ctie.1): Man page correction from Eric S. Raymond
+ <esr@thyrsus.com>.
+
+2003-04-20 Julian Gilbey <jdg@debian.org>
+
+ * Remove documented need for any change files - they're not
+ actually necessary (thanks to Hartmut Henkel
+ <hartmut_henkel@gmx.de> for this observation)
+
+ * Use kpathsea 3.4.5 modified functions, losing some backward
+ compatibility if the kpathsea library is used
+
+ * Match current Web2C/Kpathsea modifications to cweb, and modify
+ to more closely match cweb 3.64 behaviour
+
+ * Release as version 1.1
+
+2002-02-03 Julian Gilbey <jdg@debian.org>
+
+ * Make success message appear on a new line at end of run
+
+ * Improve formatted output for ctie-k.ch
+
+ * Release as version 1.0
+
+2002-01-13 Julian Gilbey <jdg@debian.org>
+
+ * Initial release (version 0.9)
diff --git a/Build/source/texk/web2c/ctiedir/Makefile b/Build/source/texk/web2c/ctiedir/Makefile
new file mode 100644
index 00000000000..8edc24225cf
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/Makefile
@@ -0,0 +1,51 @@
+#
+# Makefile for ctie distribution - 21 Dec 92
+#
+# This file makes CTIE and needs ctangle from cweb distribution.
+#
+
+CTANGLE=ctangle
+BINDIR=.
+CTIE=$(BINDIR)/ctie
+
+# directory for CWEB inputs in @i files
+CWEBINPUTS= /usr/local/lib/cweb
+
+CFLAGS=
+LDFLAGS=
+KPATHSEAFLAGS=-lkpathsea
+
+default: ctie
+
+
+# CTIE
+ctie.o: ctie.c
+ $(CC) $(LDFLAGS) $(CFLAGS) -DCWEBINPUTS=\"$(CWEBINPUTS)\" -c ctie.c
+
+ctie: ctie.o
+ $(CC) $(LDFLAGS) $(CFLAGS) -o $(CTIE) ctie.o
+
+ctie.c: ctie.w
+ $(CTANGLE) ctie
+
+ctie-k.o: ctie-k.c
+
+ctie-k: ctie-k.o
+ $(CC) $(LDFLAGS) $(CFLAGS) -o $(BINDIR)/ctie-k ctie-k.o $(KPATHSEAFLAGS)
+
+ctie-k.c: ctie.w ctie-k.ch
+ ctangle ctie.w ctie-k.ch ctie-k.c
+
+clean:
+ rm -f ctie.o ctie-k.o ctie.outc ctie.outm ctie.tex
+ rm -f ctie.log ctie.toc ctie.scn ctie.idx
+ rm -f ctiedoc.aux ctiedoc.log
+
+veryclean: clean
+ rm -f $(BINDIR)/ctie $(BINDIR)/ctie-k ctie.dvi ctiedoc.dvi
+
+ttest: $(CTIE)
+ $(CTIE) -c ctie.outc ctie.tie ctie.cf?
+ diff ctie.outc ctie.chf.gen
+ $(CTIE) -m ctie.outm ctie.tie ctie.cf?
+ diff ctie.outm ctie.master.gen
diff --git a/Build/source/texk/web2c/ctiedir/README b/Build/source/texk/web2c/ctiedir/README
new file mode 100644
index 00000000000..48aab880ee2
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/README
@@ -0,0 +1,75 @@
+This is the README file of the `CTIE' distribution, version 1.1
+---------------------------------------------------------------
+
+CTIE is based on the `TIE' program, a program which was first
+developed to allow WEB programmers to use more than one change file
+with their WEB programs.
+
+CWEB introduced a new command, @i, to handle "include files". The
+original TIE program was not designed to handle this situation, and so
+could not be used for all CWEB programs. CTIE behaves essentially
+identically to the original TIE, and identical results will be
+generated when TIE is applied to traditional WEB files with changes,
+as long as there are no errors. (Errors may lead to different output,
+but then the errors need correcting, anyway.)
+
+CTIE can be used to either create a new version of the (C)WEB file
+which incorporates the changes, or to merge multiple change files into
+a single change file. This program does not depend in an essential
+way on any special WEB dialect, nor on using WEB at all, as the only
+controls to be interpreted are the change requests in the change files
+(delimited by @x, @y and @z) and file include commands (indicated by @i).
+This makes `CTIE' also usable for any other language, or even
+data files. See the documentation ctiedoc.tex and the example file
+ctie.tie for more information.
+
+
+REQUIREMENTS:
+
+This version of `CTIE' is written in CWEB. To preprocess and compile
+the source you will need a working `ctangle'. A pretangled ctie.c is
+supplied if you do not have a working ctangle available.
+
+Please note, that the CWEB by Silvio Levy and Donald E. Knuth must
+probably be at least at version 2.8, to process and compile `ctie'
+without problems.
+
+Furthermore, a ctie-k.ch file is provided which links ctie against
+Karl Berry's kpathsea library. A tangled version of this file is
+provided as ctie-k.c. To use this, you will need to link against
+version 3.4.5 or higher of the kpathsea library. This version
+searches for files, both from the command line and included (@i) files
+using the CWEBINPUTS search path.
+
+
+DISTRIBUTION:
+
+This package has been uploaded to CTAN, and appears in the directory
+web/c_cpp/ctie/.
+
+
+LICENCE:
+
+This program is based on tie.w and common.w (part of CWEB). It is
+distributed with the following licence.
+
+Copyright (c) 2002,2003 by Julian Gilbey
+All rights reserved.
+
+This program is distributed WITHOUT ANY WARRANTY, express or implied.
+
+Permission is granted to make and distribute verbatim copies of this
+program provided that the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+program under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+
+BUGS/ENHANCEMENTS:
+
+If you detect bugs in the implementation of CTIE or have suggestions
+to enhance functionality or improve portability, please send a message
+to Julian Gilbey <jdg@debian.org>.
diff --git a/Build/source/texk/web2c/ctiedir/ctie-k.c b/Build/source/texk/web2c/ctiedir/ctie-k.c
new file mode 100644
index 00000000000..bfa74483d5d
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie-k.c
@@ -0,0 +1,1166 @@
+#define version_number "1.1"
+#define banner "This is CTIE, Version 1.1"
+#define copyright \
+"Copyright 2002,2003 Julian Gilbey. All rights reserved. There is no warranty.\n\
+Run with the --version option for other important information." \
+ \
+
+#define kpse_find_cweb(name) kpse_find_file(name,kpse_cweb_format,true) \
+
+#define buf_size 1024
+#define max_file_index 32 \
+
+#define xisupper(c) (isupper(c) &&((unsigned char) c<0200) ) \
+ \
+
+#define spotless 0
+#define troublesome 1
+#define fatal 2 \
+
+#define max_include_files 20 \
+
+#define max_file_name_length 1024 \
+
+#define too_long() {total_include_files--;free(new_inc) ; \
+err_print(i,"! Include file name too long") ;goto restart;} \
+
+#define fatal_error(i,s,t) { \
+fprintf(stderr,"\n%s",s) ; \
+err_print(i,t) ; \
+history= fatal; \
+exit(wrap_up() ) ; \
+} \
+ \
+
+#define none (-1) \
+
+/*2:*/
+#line 89 "./ctie.w"
+
+/*10:*/
+#line 172 "./ctie.w"
+
+#include <stdio.h>
+
+
+#line 126 "./ctie-k.ch"
+/*:10*//*39:*/
+#line 715 "./ctie.w"
+
+#include <errno.h>
+
+
+/*:39*//*72:*/
+#line 454 "./ctie-k.ch"
+
+#include <kpathsea/kpathsea.h>
+
+/*:72*/
+#line 90 "./ctie.w"
+
+/*12:*/
+#line 211 "./ctie.w"
+
+#define search 0
+#define test 1
+#define reading 2
+#define ignore 3
+typedef int in_file_modes;
+#define unknown 0
+#define master 1
+#define chf 2
+typedef int file_types;
+
+
+/*:12*//*13:*/
+#line 229 "./ctie.w"
+
+#define normal 0
+#define pre 1
+#define post 2
+typedef int out_md_type;
+
+
+/*:13*//*14:*/
+#line 239 "./ctie.w"
+
+typedef int file_index;
+
+
+/*:14*//*15:*/
+#line 246 "./ctie.w"
+
+typedef struct _indsc{
+char file_name[max_file_name_length];
+long line;
+FILE*the_file;
+struct _indsc*parent;
+}include_description;
+
+
+/*:15*//*16:*/
+#line 259 "./ctie.w"
+
+typedef struct _idsc{
+string file_name;
+char buffer[buf_size];
+in_file_modes mode;
+long line;
+file_types type_of_file;
+include_description*current_include;
+char*buffer_end;
+char*limit;
+char*loc;
+FILE*the_file;
+int dont_match;
+}input_description;
+
+
+/*:16*/
+#line 91 "./ctie.w"
+
+/*30:*/
+#line 584 "./ctie.w"
+
+#line 223 "./ctie-k.ch"
+void err_print P2H(file_index,char*);
+#line 586 "./ctie.w"
+
+/*:30*//*35:*/
+#line 673 "./ctie.w"
+
+#line 243 "./ctie-k.ch"
+int wrap_up P1H(void);
+#line 675 "./ctie.w"
+
+/*:35*//*37:*/
+#line 696 "./ctie.w"
+
+#line 249 "./ctie-k.ch"
+void pfatal_error P2H(char*,char*);
+#line 698 "./ctie.w"
+
+/*:37*//*69:*/
+#line 1232 "./ctie.w"
+
+#line 392 "./ctie-k.ch"
+void usage_help P1H(void);
+void print_version_and_exit P2H(string,string);
+#line 1235 "./ctie.w"
+
+
+/*:69*/
+#line 92 "./ctie.w"
+
+/*9:*/
+#line 162 "./ctie.w"
+
+int history= spotless;
+
+
+/*:9*//*17:*/
+#line 286 "./ctie.w"
+
+int total_include_files= 0;
+
+/*:17*//*18:*/
+#line 292 "./ctie.w"
+
+file_index actual_input,test_input,no_ch;
+file_types prod_chf= unknown;
+out_md_type out_mode;
+
+/*:18*//*20:*/
+#line 309 "./ctie.w"
+
+input_description*input_organisation[max_file_index+1];
+
+
+/*:20*//*24:*/
+#line 406 "./ctie.w"
+
+boolean input_has_ended= false;
+
+
+/*:24*//*41:*/
+#line 742 "./ctie.w"
+
+FILE*out_file;
+string out_name;
+
+
+#line 273 "./ctie-k.ch"
+/*:41*//*68:*/
+#line 1217 "./ctie.w"
+
+string CTIEHELP[]= {
+"Usage: ctie -[mc] outfile master changefile(s)",
+" Create a new master file or change file from the given",
+" master (C)WEB file and changefiles.",
+" All filenames are taken literally; no suffixes are added.",
+"",
+"-m create a new master file from original (C)WEB and change file(s)",
+"-c create a master change file for original (C)WEB file from changefile(s)",
+"--help display this help and exit",
+"--version display version information and exit",
+NULL
+};
+
+
+/*:68*//*73:*/
+#line 459 "./ctie-k.ch"
+
+string file_open_mode;
+#line 1278 "./ctie.w"
+
+
+/*:73*/
+#line 93 "./ctie.w"
+
+/*31:*/
+#line 589 "./ctie.w"
+
+#line 230 "./ctie-k.ch"
+void err_print P2C(file_index,i,char*,s)
+
+#line 592 "./ctie.w"
+{
+char*k,*l;
+fprintf(stderr,*s=='!'?"\n%s":"%s",s);
+if(i>=0)/*32:*/
+#line 611 "./ctie.w"
+
+{
+register input_description*inp_desc= input_organisation[i];
+register include_description*inc_desc= inp_desc->current_include;
+
+if(inc_desc!=NULL){
+fprintf(stderr,". (l. %ld of include file %s",inc_desc->line,
+inc_desc->file_name);
+fprintf(stderr," included from l. %ld of %s file %s)\n",
+inp_desc->line,
+inp_desc->type_of_file==master?"master":"change",
+inp_desc->file_name);
+}
+else
+fprintf(stderr,". (l. %ld of %s file %s)\n",inp_desc->line,
+inp_desc->type_of_file==master?"master":"change",
+inp_desc->file_name);
+l= (inp_desc->loc>=inp_desc->limit?inp_desc->limit:inp_desc->loc);
+if(l> inp_desc->buffer){
+for(k= inp_desc->buffer;k<l;k++)
+if(*k=='\t')putc(' ',stderr);
+else putc(*k,stderr);
+putc('\n',stderr);
+for(k= inp_desc->buffer;k<l;k++)
+putc(' ',stderr);
+}
+for(k= l;k<inp_desc->limit;k++)
+putc(*k,stderr);
+putc('\n',stderr);
+}
+
+
+/*:32*/
+#line 595 "./ctie.w"
+
+else putc('\n',stderr);
+fflush(stderr);
+history= troublesome;
+}
+
+/*:31*//*38:*/
+#line 699 "./ctie.w"
+
+#line 256 "./ctie-k.ch"
+void pfatal_error P2C(char*,s,char*,t)
+#line 702 "./ctie.w"
+{
+char*strerr= strerror(errno);
+
+fprintf(stderr,"\n%s%s",s,t);
+if(strerr)fprintf(stderr," (%s)\n",strerr);
+else fprintf(stderr,"\n");
+history= fatal;
+exit(wrap_up());
+}
+
+
+/*:38*/
+#line 94 "./ctie.w"
+
+/*21:*/
+#line 328 "./ctie.w"
+
+#line 143 "./ctie-k.ch"
+boolean get_line P2C(file_index,i,boolean,do_includes)
+#line 331 "./ctie.w"
+{
+register input_description*inp_desc= input_organisation[i];
+register FILE*fp;
+
+if(inp_desc->mode==ignore)return false;
+
+restart:
+if(inp_desc->current_include!=NULL){
+register include_description*inc_desc= inp_desc->current_include;
+
+fp= inc_desc->the_file;
+/*26:*/
+#line 426 "./ctie.w"
+
+{
+register int c;
+register char*k;
+
+if(feof(fp))
+/*27:*/
+#line 452 "./ctie.w"
+
+{
+include_description*temp= inc_desc->parent;
+
+fclose(fp);
+free(inc_desc);
+total_include_files--;
+inp_desc->current_include= temp;
+goto restart;
+}
+
+
+/*:27*/
+#line 432 "./ctie.w"
+
+
+inp_desc->limit= k= inp_desc->buffer;
+while(k<=inp_desc->buffer_end&&(c= getc(fp))!=EOF&&c!='\n')
+if((*(k++)= c)!=' ')inp_desc->limit= k;
+if(k> inp_desc->buffer_end)
+if((c= getc(fp))!=EOF&&c!='\n'){
+ungetc(c,fp);inp_desc->loc= inp_desc->buffer;
+err_print(i,"! Input line too long");
+
+}
+if(c==EOF&&inp_desc->limit==inp_desc->buffer)
+/*27:*/
+#line 452 "./ctie.w"
+
+{
+include_description*temp= inc_desc->parent;
+
+fclose(fp);
+free(inc_desc);
+total_include_files--;
+inp_desc->current_include= temp;
+goto restart;
+}
+
+
+/*:27*/
+#line 444 "./ctie.w"
+
+
+inc_desc->line++;
+}
+
+/*:26*/
+#line 342 "./ctie.w"
+
+}
+else{
+fp= inp_desc->the_file;
+/*22:*/
+#line 366 "./ctie.w"
+
+{
+register int c;
+register char*k;
+
+if(feof(fp))
+/*23:*/
+#line 394 "./ctie.w"
+
+{
+inp_desc->mode= ignore;
+inp_desc->limit= NULL;
+if(inp_desc->type_of_file==master)input_has_ended= true;
+fclose(fp);
+return false;
+}
+
+
+/*:23*/
+#line 372 "./ctie.w"
+
+
+inp_desc->limit= k= inp_desc->buffer;
+while(k<=inp_desc->buffer_end&&(c= getc(fp))!=EOF&&c!='\n')
+if((*(k++)= c)!=' ')inp_desc->limit= k;
+if(k> inp_desc->buffer_end)
+if((c= getc(fp))!=EOF&&c!='\n'){
+ungetc(c,fp);inp_desc->loc= inp_desc->buffer;
+err_print(i,"! Input line too long");
+
+}
+if(c==EOF&&inp_desc->limit==inp_desc->buffer)
+/*23:*/
+#line 394 "./ctie.w"
+
+{
+inp_desc->mode= ignore;
+inp_desc->limit= NULL;
+if(inp_desc->type_of_file==master)input_has_ended= true;
+fclose(fp);
+return false;
+}
+
+
+/*:23*/
+#line 384 "./ctie.w"
+
+
+/*25:*/
+#line 414 "./ctie.w"
+
+inp_desc->line++;
+if(inp_desc->type_of_file==master&&inp_desc->line%100==0){
+if(inp_desc->line%500==0)printf("%ld",inp_desc->line);
+else putchar('.');
+fflush(stdout);
+}
+
+
+/*:25*/
+#line 387 "./ctie.w"
+
+}
+
+
+/*:22*/
+#line 346 "./ctie.w"
+
+}
+
+if(do_includes)
+/*28:*/
+#line 467 "./ctie.w"
+
+{
+inp_desc->loc= inp_desc->buffer;
+*inp_desc->limit= ' ';
+if(*inp_desc->buffer=='@'&&
+(inp_desc->buffer[1]=='i'||inp_desc->buffer[1]=='I')){
+inp_desc->loc= inp_desc->buffer+2;
+*inp_desc->limit= '"';
+while(*inp_desc->loc==' '||*inp_desc->loc=='\t')
+inp_desc->loc++;
+if(inp_desc->loc>=inp_desc->limit){
+err_print(i,"! Include file name not given");
+
+goto restart;
+}
+if(total_include_files>=max_include_files){
+err_print(i,"! Too many nested includes");
+
+goto restart;
+}
+total_include_files++;
+/*29:*/
+#line 507 "./ctie.w"
+
+{
+include_description*new_inc;
+#line 166 "./ctie-k.ch"
+char*file_name_end;
+string fullname;
+char*k;
+#line 514 "./ctie.w"
+
+new_inc= (include_description*)malloc(sizeof(include_description));
+if(new_inc==NULL)
+fatal_error(i,"! No memory for new include descriptor","");
+new_inc->line= 0;
+k= new_inc->file_name;
+file_name_end= k+max_file_name_length-1;
+
+if(*inp_desc->loc=='"'){
+inp_desc->loc++;
+while(*inp_desc->loc!='"'&&k<=file_name_end)
+*k++= *inp_desc->loc++;
+if(inp_desc->loc==inp_desc->limit)
+k= file_name_end+1;
+}else
+while(*inp_desc->loc!=' '&&*inp_desc->loc!='\t'&&
+*inp_desc->loc!='"'&&k<=file_name_end)*k++= *inp_desc->loc++;
+if(k> file_name_end)too_long();
+
+*k= '\0';
+#line 174 "./ctie-k.ch"
+fullname= kpse_find_cweb(new_inc->file_name);
+if(fullname)
+new_inc->the_file= fopen(fullname,"r");
+if(fullname!=NULL&&new_inc->the_file!=NULL){
+free(fullname);
+#line 535 "./ctie.w"
+new_inc->parent= inp_desc->current_include;
+inp_desc->current_include= new_inc;
+goto restart;
+}
+#line 563 "./ctie.w"
+total_include_files--;
+free(new_inc);
+#line 212 "./ctie-k.ch"
+if(fullname){
+free(fullname);
+err_print(i,"! Cannot open include file");
+}else
+err_print(i,"! Cannot find include file");
+#line 566 "./ctie.w"
+
+goto restart;
+}
+
+
+
+/*:29*/
+#line 488 "./ctie.w"
+;
+}
+}
+
+
+/*:28*/
+#line 351 "./ctie.w"
+
+return true;
+}
+
+
+/*:21*//*34:*/
+#line 663 "./ctie.w"
+
+#line 237 "./ctie-k.ch"
+int wrap_up P1H(void)
+#line 665 "./ctie.w"
+{
+/*36:*/
+#line 682 "./ctie.w"
+
+switch(history){
+case spotless:
+printf("\n(No errors were found.)\n");break;
+case troublesome:
+printf("\n(Pardon me, but I think I spotted something wrong.)\n");break;
+case fatal:printf("(That was a fatal error, my friend.)\n");
+}
+
+
+/*:36*/
+#line 666 "./ctie.w"
+;
+if(history> spotless)return 1;
+else return 0;
+}
+
+/*:34*//*44:*/
+#line 791 "./ctie.w"
+
+#line 342 "./ctie-k.ch"
+boolean lines_dont_match P2C(file_index,i,file_index,j)
+#line 794 "./ctie.w"
+{
+register input_description*iptr= input_organisation[i],
+*jptr= input_organisation[j];
+
+if(iptr->limit-iptr->buffer!=jptr->limit-jptr->buffer)
+return true;
+return strncmp(iptr->buffer,jptr->buffer,iptr->limit-iptr->buffer);
+}
+
+
+/*:44*//*45:*/
+#line 808 "./ctie.w"
+
+#line 349 "./ctie-k.ch"
+void init_change_file P1C(file_index,i)
+#line 811 "./ctie.w"
+{
+register input_description*inp_desc= input_organisation[i];
+char ccode;
+
+inp_desc->limit= inp_desc->buffer;
+/*46:*/
+#line 827 "./ctie.w"
+
+while(1){
+if(!get_line(i,false))return;
+if(inp_desc->limit<inp_desc->buffer+2)continue;
+if(inp_desc->buffer[0]!='@')continue;
+ccode= inp_desc->buffer[1];
+if(xisupper(ccode))ccode= tolower(ccode);
+if(ccode=='x')break;
+if(ccode=='y'||ccode=='z'||ccode=='i'){
+inp_desc->loc= inp_desc->buffer+2;
+err_print(i,"! Missing @x in change file");
+
+}
+}
+
+/*:46*/
+#line 816 "./ctie.w"
+
+/*47:*/
+#line 844 "./ctie.w"
+
+do{
+if(!get_line(i,true)){
+err_print(i,"! Change file ended after @x");
+
+return;
+}
+}while(inp_desc->limit==inp_desc->buffer);
+
+
+/*:47*/
+#line 817 "./ctie.w"
+
+inp_desc->dont_match= 0;
+}
+
+
+/*:45*//*48:*/
+#line 857 "./ctie.w"
+
+#line 356 "./ctie-k.ch"
+void put_line P1C(file_index,j)
+#line 860 "./ctie.w"
+{
+char*ptr= input_organisation[j]->buffer;
+char*lmt= input_organisation[j]->limit;
+
+while(ptr<lmt)putc(*ptr++,out_file);
+putc('\n',out_file);
+}
+
+
+/*:48*//*49:*/
+#line 872 "./ctie.w"
+
+#line 363 "./ctie-k.ch"
+boolean e_of_ch_module P1C(file_index,i)
+#line 875 "./ctie.w"
+{
+register input_description*inp_desc= input_organisation[i];
+
+if(inp_desc->limit==NULL){
+err_print(i,"! Change file ended without @z");
+
+return true;
+}else if(inp_desc->limit>=inp_desc->buffer+2)
+if(inp_desc->buffer[0]=='@'&&
+(inp_desc->buffer[1]=='Z'||inp_desc->buffer[1]=='z'))
+return true;
+return false;
+}
+
+
+/*:49*//*50:*/
+#line 893 "./ctie.w"
+
+#line 370 "./ctie-k.ch"
+boolean e_of_ch_preamble P1C(file_index,i)
+#line 896 "./ctie.w"
+{
+register input_description*inp_desc= input_organisation[i];
+
+if(inp_desc->limit>=inp_desc->buffer+2&&inp_desc->buffer[0]=='@')
+if(inp_desc->buffer[1]=='Y'||inp_desc->buffer[1]=='y'){
+if(inp_desc->dont_match> 0){
+inp_desc->loc= inp_desc->buffer+2;
+fprintf(stderr,"\n! Hmm... %d ",inp_desc->dont_match);
+err_print(i,"of the preceding lines failed to match");
+}
+return true;
+}
+return false;
+}
+
+
+
+/*:50*//*61:*/
+#line 1105 "./ctie.w"
+
+#line 376 "./ctie-k.ch"
+void usage_error P1H(void)
+#line 1107 "./ctie.w"
+{
+/*62:*/
+#line 1118 "./ctie.w"
+
+#line 382 "./ctie-k.ch"
+{
+extern KPSEDLL string kpathsea_version_string;
+printf("%s (%s)\n",banner,kpathsea_version_string);
+}
+#line 1120 "./ctie.w"
+printf("%s\n",copyright);
+
+
+/*:62*/
+#line 1108 "./ctie.w"
+;
+fprintf(stderr,"Usage: ctie -[mc] outfile master changefile(s)\n");
+fprintf(stderr,"Type ctie --help for more information\n");
+exit(1);
+}
+
+
+/*:61*/
+#line 95 "./ctie.w"
+
+/*3:*/
+#line 101 "./ctie.w"
+
+#line 32 "./ctie-k.ch"
+int main P2C(int,argc,string*,argv)
+#line 104 "./ctie.w"
+{
+#line 38 "./ctie-k.ch"
+/*5:*/
+#line 84 "./ctie-k.ch"
+
+kpse_set_program_name(argv[0],"ctie");
+
+/*:5*/
+#line 38 "./ctie-k.ch"
+;
+/*19:*/
+#line 300 "./ctie.w"
+
+actual_input= 0;
+out_mode= normal;
+
+/*:19*/
+#line 39 "./ctie-k.ch"
+;
+#line 106 "./ctie.w"
+/*63:*/
+#line 1135 "./ctie.w"
+
+{
+if(argc> max_file_index+5-1)usage_error();
+no_ch= -1;
+while(--argc> 0){
+argv++;
+if(strcmp("-help",*argv)==0||strcmp("--help",*argv)==0)
+/*66:*/
+#line 1202 "./ctie.w"
+
+usage_help();
+
+
+
+/*:66*/
+#line 1142 "./ctie.w"
+;
+if(strcmp("-version",*argv)==0||strcmp("--version",*argv)==0)
+/*67:*/
+#line 1208 "./ctie.w"
+
+{
+print_version_and_exit("CTIE",version_number);
+
+}
+
+
+/*:67*/
+#line 1144 "./ctie.w"
+;
+if(**argv=='-')/*64:*/
+#line 1158 "./ctie.w"
+
+if(prod_chf!=unknown)usage_error();
+else
+switch(*(*argv+1)){
+case'c':case'C':prod_chf= chf;break;
+case'm':case'M':prod_chf= master;break;
+default:usage_error();
+}
+
+
+/*:64*/
+#line 1145 "./ctie.w"
+
+else/*65:*/
+#line 1172 "./ctie.w"
+
+{
+if(no_ch==(-1)){
+out_name= *argv;
+}else{
+register input_description*inp_desc;
+
+inp_desc= (input_description*)malloc(sizeof(input_description));
+if(inp_desc==NULL)
+fatal_error(-1,"! No memory for input descriptor","");
+
+inp_desc->mode= search;
+inp_desc->line= 0;
+inp_desc->type_of_file= chf;
+inp_desc->limit= inp_desc->buffer;
+inp_desc->buffer[0]= ' ';
+inp_desc->loc= inp_desc->buffer+1;
+inp_desc->buffer_end= inp_desc->buffer+buf_size-2;
+inp_desc->file_name= *argv;
+inp_desc->current_include= NULL;
+input_organisation[no_ch]= inp_desc;
+}
+no_ch++;
+}
+
+
+/*:65*/
+#line 1146 "./ctie.w"
+
+}
+if(no_ch<=0||prod_chf==unknown)usage_error();
+}
+
+
+/*:63*/
+#line 106 "./ctie.w"
+
+/*62:*/
+#line 1118 "./ctie.w"
+
+#line 382 "./ctie-k.ch"
+{
+extern KPSEDLL string kpathsea_version_string;
+printf("%s (%s)\n",banner,kpathsea_version_string);
+}
+#line 1120 "./ctie.w"
+printf("%s\n",copyright);
+
+
+/*:62*/
+#line 107 "./ctie.w"
+;
+/*42:*/
+#line 277 "./ctie-k.ch"
+
+{
+string fullname;
+
+fullname= kpse_find_cweb(input_organisation[0]->file_name);
+if(fullname)
+input_organisation[0]->the_file= fopen(fullname,"r");
+
+if(fullname==NULL||input_organisation[0]->the_file==NULL){
+if(fullname){
+pfatal_error("! Cannot open master file ",
+input_organisation[0]->file_name);
+}else{
+fatal_error(-1,"! Cannot find master file ",
+input_organisation[0]->file_name);
+}
+}
+else free(fullname);
+
+
+#line 759 "./ctie.w"
+printf("(%s)\n",input_organisation[0]->file_name);
+input_organisation[0]->type_of_file= master;
+get_line(0,true);
+}
+
+
+/*:42*/
+#line 108 "./ctie.w"
+
+/*43:*/
+#line 313 "./ctie-k.ch"
+
+{
+file_index i;
+string fullname;
+
+i= 1;
+while(i<no_ch){
+fullname= kpse_find_cweb(input_organisation[i]->file_name);
+if(fullname)
+input_organisation[i]->the_file= fopen(fullname,"r");
+
+if(fullname==NULL||input_organisation[i]->the_file==NULL){
+if(fullname){
+pfatal_error("! Cannot open change file ",
+input_organisation[i]->file_name);
+}else{
+fatal_error(-1,"! Cannot find change file ",
+input_organisation[i]->file_name);
+}
+}
+else free(fullname);
+
+
+#line 780 "./ctie.w"
+printf("(%s)\n",input_organisation[i]->file_name);
+init_change_file(i);
+i++;
+}
+}
+
+
+/*:43*/
+#line 109 "./ctie.w"
+
+/*40:*/
+#line 729 "./ctie.w"
+
+{
+out_file= fopen(out_name,"w");
+if(out_file==NULL){
+pfatal_error("! Cannot open/create output file","");
+
+}
+}
+
+
+/*:40*/
+#line 110 "./ctie.w"
+
+/*59:*/
+#line 1074 "./ctie.w"
+
+actual_input= 0;
+input_has_ended= false;
+while(input_has_ended==false||actual_input!=0)
+/*51:*/
+#line 917 "./ctie.w"
+
+{
+file_index test_file;
+
+/*52:*/
+#line 934 "./ctie.w"
+
+{
+register input_description*inp_desc;
+while(actual_input> 0&&e_of_ch_module(actual_input)){
+inp_desc= input_organisation[actual_input];
+if(inp_desc->type_of_file==master){
+
+fatal_error(-1,"! This can't happen: change file is master file","");
+
+}
+inp_desc->mode= search;
+init_change_file(actual_input);
+while((input_organisation[actual_input]->mode!=reading
+&&actual_input> 0))
+actual_input--;
+}
+}
+
+
+/*:52*/
+#line 921 "./ctie.w"
+
+if(input_has_ended&&actual_input==0)break;
+/*53:*/
+#line 960 "./ctie.w"
+
+test_input= none;
+test_file= actual_input;
+while(test_input==none&&test_file<no_ch-1){
+test_file++;
+switch(input_organisation[test_file]->mode){
+case search:
+if(lines_dont_match(actual_input,test_file)==false){
+input_organisation[test_file]->mode= test;
+test_input= test_file;
+}
+break;
+case test:
+if(lines_dont_match(actual_input,test_file)){
+
+input_organisation[test_file]->dont_match++;
+}
+test_input= test_file;
+break;
+case reading:
+break;
+case ignore:
+break;
+}
+}
+
+
+/*:53*/
+#line 923 "./ctie.w"
+
+/*54:*/
+#line 993 "./ctie.w"
+
+if(prod_chf==chf){
+while(1){
+/*55:*/
+#line 1007 "./ctie.w"
+
+if(out_mode==normal){
+if(test_input!=none){
+fprintf(out_file,"@x\n");
+out_mode= pre;
+}else break;
+}
+
+
+/*:55*/
+#line 996 "./ctie.w"
+
+/*56:*/
+#line 1021 "./ctie.w"
+
+if(out_mode==pre){
+if(test_input==none){
+fprintf(out_file,"@y\n");
+out_mode= post;
+}else{
+if(input_organisation[actual_input]->type_of_file==master)
+put_line(actual_input);
+break;
+}
+}
+
+
+/*:56*/
+#line 997 "./ctie.w"
+
+/*57:*/
+#line 1040 "./ctie.w"
+
+if(out_mode==post){
+if(input_organisation[actual_input]->type_of_file==chf){
+if(test_input==none)put_line(actual_input);
+break;
+}else{
+fprintf(out_file,"@z\n\n");
+out_mode= normal;
+}
+}
+
+
+/*:57*/
+#line 998 "./ctie.w"
+
+}
+}else
+if(test_input==none)put_line(actual_input);
+
+
+/*:54*/
+#line 924 "./ctie.w"
+
+/*58:*/
+#line 1055 "./ctie.w"
+
+get_line(actual_input,true);
+if(test_input!=none){
+get_line(test_input,true);
+if(e_of_ch_preamble(test_input)==true){
+get_line(test_input,true);
+input_organisation[test_input]->mode= reading;
+actual_input= test_input;
+test_input= none;
+}
+}
+
+
+/*:58*/
+#line 925 "./ctie.w"
+
+}
+
+
+/*:51*/
+#line 1078 "./ctie.w"
+
+if(out_mode==post)
+fprintf(out_file,"@z\n");
+
+
+/*:59*/
+#line 111 "./ctie.w"
+
+/*60:*/
+#line 1087 "./ctie.w"
+
+{
+file_index i;
+
+for(i= 1;i<no_ch;i++){
+if(input_organisation[i]->mode!=ignore){
+input_organisation[i]->loc= input_organisation[i]->buffer;
+err_print(i,"! Change file entry did not match");
+
+}
+}
+}
+
+
+/*:60*/
+#line 112 "./ctie.w"
+
+exit(wrap_up());
+}
+
+#line 57 "./ctie-k.ch"
+/*:3*/
+#line 96 "./ctie.w"
+
+
+/*:2*//*70:*/
+#line 1237 "./ctie.w"
+
+#line 399 "./ctie-k.ch"
+void usage_help P1H(void)
+#line 1239 "./ctie.w"
+{
+string*message= CTIEHELP;
+
+while(*message){
+fputs(*message,stdout);
+putchar('\n');
+++message;
+}
+putchar('\n');
+exit(0);
+}
+
+
+/*:70*//*71:*/
+#line 1252 "./ctie.w"
+
+#line 416 "./ctie-k.ch"
+void print_version_and_exit P2C(string,name,string,version)
+{
+extern KPSEDLL string kpathsea_version_string;
+printf("%s %s\n",name,version);
+puts(kpathsea_version_string);
+
+puts("Copyright (C) 2002,2003 Julian Gilbey.");
+puts("Kpathsea is copyright (C) 1999 Free Software Foundation, Inc.");
+
+puts("There is NO warranty. This is free software.");
+puts("Redistribution of this software is covered by the terms of");
+puts("both the CTIE copyright and the GNU General Public Licence.");
+puts("For more information about these matters, see the files");
+puts("named COPYING and the CTIE source.");
+puts("Primary authors of CTIE: Julian Gilbey.");
+puts("Kpathsea written by Karl Berry and others.\n");
+
+exit(0);
+}
+#line 1265 "./ctie.w"
+
+
+#line 450 "./ctie-k.ch"
+/*:71*/
diff --git a/Build/source/texk/web2c/ctiedir/ctie-k.ch b/Build/source/texk/web2c/ctiedir/ctie-k.ch
new file mode 100644
index 00000000000..88e8d840b59
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie-k.ch
@@ -0,0 +1,461 @@
+% Changes to adapt CTIE to web2c.
+% Copyright 2002,2003 Julian Gilbey
+% All rights reserved.
+%
+% This file is distributed WITHOUT ANY WARRANTY, express or implied.
+%
+% Permission is granted to make and distribute verbatim copies of this
+% file provided that the copyright notice and this permission notice
+% are preserved on all copies.
+%
+% Permission is granted to copy and distribute modified versions of this
+% file under the conditions for verbatim copying, provided that the
+% entire resulting derived work is distributed under the terms of a
+% permission notice identical to this one.
+%
+% This file is based heavily on tie.ch by Olaf Weber to adapt tie.w to
+% the web2c system and on comm-w2c.ch from the Web2C 7.4.5 distribution
+% by Wlodek Bzyl and Olaf Weber.
+
+@x l.19 Add macro definitions
+\def\title{The CTIE processor}
+@y
+\def\Kpathsea/{{\mc KPATHSEA\spacefactor1000}}
+
+\def\title{The CTIE processor}
+@z
+
+@x l.102
+main(argc, argv)
+ int argc; string *argv;
+@y
+int main @,P2C(int, argc, string *, argv)
+@z
+
+@x l.105 Set up kpathsea stuff
+ @<Initialise parameters@>;
+@y
+ @<Set up |PROGNAME| feature and initialize the search path mechanism@>;
+ @<Initialise parameters@>;
+@z
+
+These are defined by kpathsea; we replace this by the path-searching
+initialisation code taken almost verbatim from comm-w2c.ch.
+@x l.116
+@ We include the additional types |boolean| and |string|. \.{CTIE}
+replaces the complex \.{TIE} character set handling (based on that of
+the original \.{WEB} system) with the standard \.{CWEB} behaviour, and
+so uses the |char| type for input and output.
+
+@d false 0
+@d true 1
+
+@<Global types@>=
+typedef int boolean;
+typedef char* string;
+@y
+@ The \.{ctie} program from the original \.{CTIE} package uses the
+compile-time default directory or the value of the environment
+variable \.{CWEBINPUTS} as an alternative place to be searched for
+files, if they could not be found in the current directory.
+
+This version uses the \Kpathsea/ mechanism for searching files.
+The directories to be searched for come from three sources:
+
+ (a)~a user-set environment variable \.{CWEBINPUTS}
+ (overriden by \.{CWEBINPUTS\_ctie});\par
+ (b)~a line in \Kpathsea/ configuration file \.{texmf.cnf},\hfil\break
+ e.g. \.{CWEBINPUTS=.:$TEXMF/texmf/cweb//}
+ or \.{CWEBINPUTS.ctie=.:$TEXMF/texmf/cweb//};\hangindent=2\parindent\par
+ (c)~compile-time default directories \.{.:$TEXMF/texmf/cweb//}
+ (specified in \.{texmf.in}).
+
+@d kpse_find_cweb(name) kpse_find_file(name, kpse_cweb_format, true)
+
+@ The simple file searching is replaced by the `path searching'
+mechanism that the \Kpathsea/ library provides.
+
+We set |kpse_program_name| to |"ctie"|. This means if the variable
+|CWEBINPUTS.ctie| is present in \.{texmf.cnf} (or |CWEBINPUTS_ctie| in
+the environment) its value will be used as the search path for
+filenames. This allows different flawors of \.{CTIE} to have
+different search paths.
+
+@<Set up |PROGNAME| feature and initialize the search path mechanism@>=
+kpse_set_program_name(argv[0], "ctie");
+
+@ We include the additional types |boolean| and |string|. \.{CTIE}
+replaces the complex \.{TIE} character set handling (based on that of
+the original \.{WEB} system) with the standard \.{CWEB} behaviour, and
+so uses the |char| type for input and output.
+
+The |kpathsea| library (version 3.4.5) defines the |true|, |false|,
+|boolean| and |string| types in \.{kpathsea/types.h}, so we do not
+actually need to define them here.
+@z
+
+@x l.129 The kpathsea include files find the right header file for these.
+@ We predeclare some standard string-handling functions here instead of
+including their system header files, because the names of the header files
+are not as standard as the names of the functions. (There's confusion
+between \.{<string.h>} and \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+extern char *strerror();
+@y
+@ We don't need to predeclare any string handling functions here, as
+the \.{kpathsea} headers do the right thing.
+@z
+
+@x l.176 And this.
+@ And we need dynamic memory allocation.
+This should cause no trouble in any \CEE/ program.
+@^system dependencies@>
+
+@<Global \&{\#include}s@>=
+#ifdef __STDC__
+#include <stdlib.h>
+#else
+#include <malloc.h>
+#endif
+@y
+@ And we need dynamic memory allocation.
+This should cause no trouble in any \CEE/ program.
+The \.{kpathsea} include files handle the definition of |malloc()|,
+too.
+@^system dependencies@>
+@z
+
+@x l.284 way too short!
+@d max_file_name_length 60
+@y
+@d max_file_name_length 1024
+@z
+
+@x l.329
+boolean get_line(i, do_includes)
+ file_index i; boolean do_includes;
+@y
+boolean get_line @,P2C(file_index, i, boolean, do_includes)
+@z
+
+The next piece is simplified using the kpathsea kpse_find_file
+function.
+
+@x l.497
+If the environment variable \.{CWEBINPUTS} is set, or if the compiler flag
+of the same name was defined at compile time,
+\.{CWEB} will look for include files in the directory thus named, if
+it cannot find them in the current directory.
+(Colon-separated paths are not supported.)
+@y
+We use the \Kpathsea/ library (in particular, the \.{CWEBINPUTS}
+variable) to search for this file.
+@z
+
+@x l.510 Don't need the same variables any longer
+ char temp_file_name[max_file_name_length];
+ char *file_name_end;
+ char *k, *kk;
+ int l; /* length of file name */
+@y
+ char *file_name_end;
+ string fullname;
+ char *k;
+@z
+
+@x l.534 Replace with kpse_find_file
+ if ((new_inc->the_file=fopen(new_inc->file_name, "r"))!=NULL) {
+@y
+ fullname=kpse_find_cweb(new_inc->file_name);
+ if (fullname)
+ new_inc->the_file=fopen(fullname, "r");
+ if (fullname!=NULL && new_inc->the_file!=NULL) {
+ free(fullname);
+@z
+
+@x l.539 And this part is replaced by kpse_find_file
+ kk=getenv("CWEBINPUTS");
+ if (kk!=NULL) {
+ if ((l=strlen(kk))>max_file_name_length-2) too_long();
+ strcpy(temp_file_name, kk);
+ }
+ else {
+#ifdef CWEBINPUTS
+ if ((l=strlen(CWEBINPUTS))>max_file_name_length-2) too_long();
+ strcpy(temp_file_name, CWEBINPUTS);
+#else
+ l=0;
+#endif /* |CWEBINPUTS| */
+ }
+ if (l>0) {
+ if (k+l+2>=file_name_end) too_long();
+ for (; k>= new_inc->file_name; k--) *(k+l+1)=*k;
+ strcpy(new_inc->file_name, temp_file_name);
+ new_inc->file_name[l]='/'; /* \UNIX/ pathname separator */
+ if ((new_inc->the_file=fopen(new_inc->file_name, "r"))!=NULL) {
+ new_inc->parent=inp_desc->current_include; /* link it in */
+ inp_desc->current_include=new_inc;
+ goto restart; /* success */
+ }
+ }
+@y
+@z
+
+@x l.565 slightly more useful error message
+ err_print(i, "! Cannot open include file");
+@y
+ if (fullname) {
+ free(fullname);
+ err_print(i, "! Cannot open include file");
+ } else
+ err_print(i, "! Cannot find include file");
+@z
+
+
+@x l.585
+void err_print();
+@y
+void err_print @,P2H(file_index, char *);
+@z
+
+@x l.590
+void err_print(i, s) /* prints `\..' and location of error message */
+file_index i; char *s;
+@y
+void err_print @,P2C(file_index, i, char *, s)
+/* prints `\..' and location of error message */
+@z
+
+@x l.664
+int wrap_up()
+@y
+int wrap_up @,P1H(void)
+@z
+
+@x l.674
+int wrap_up();
+@y
+int wrap_up @,P1H(void);
+@z
+
+@x l.697
+void pfatal_error();
+@y
+void pfatal_error @,P2H(char *, char *);
+@z
+
+@x l.700
+void pfatal_error(s, t)
+char *s, *t;
+@y
+void pfatal_error @,P2C(char *, s, char *, t)
+@z
+
+@x l.747 Use the kpathsea library to do this
+@ For the master file we start by reading its first line into the
+buffer, if we could open it.
+
+@<Get the master file started@>=
+{
+ input_organisation[0]->the_file=
+ fopen(input_organisation[0]->file_name, "r");
+
+ if (input_organisation[0]->the_file==NULL)
+ pfatal_error("! Cannot open master file ",
+ input_organisation[0]->file_name);
+@.Cannot open master file@>
+@y
+@ For the master file we start by reading its first line into the
+buffer, if we could open it. We use the \.{kpathsea} library to find
+the file.
+
+@<Get the master file started@>=
+{
+ string fullname;
+
+ fullname = kpse_find_cweb(input_organisation[0]->file_name);
+ if (fullname)
+ input_organisation[0]->the_file = fopen(fullname, "r");
+
+ if (fullname==NULL || input_organisation[0]->the_file==NULL) {
+ if (fullname) {
+ pfatal_error("! Cannot open master file ",
+ input_organisation[0]->file_name);
+ } else {
+ fatal_error(-1, "! Cannot find master file ",
+ input_organisation[0]->file_name);
+ }
+ }
+ else free(fullname);
+@.Cannot open master file@>
+@.Cannot find master file@>
+@z
+
+@x l.768 And this
+@<Prepare the change files@>=
+{
+ file_index i;
+
+ i=1;
+ while (i<no_ch) {
+ input_organisation[i]->the_file=
+ fopen(input_organisation[i]->file_name, "r");
+ if (input_organisation[i]->the_file==NULL)
+ pfatal_error("! Cannot open change file ",
+ input_organisation[i]->file_name);
+@.Cannot open change file@>
+@y
+@<Prepare the change files@>=
+{
+ file_index i;
+ string fullname;
+
+ i=1;
+ while (i<no_ch) {
+ fullname = kpse_find_cweb(input_organisation[i]->file_name);
+ if (fullname)
+ input_organisation[i]->the_file = fopen(fullname, "r");
+
+ if (fullname==NULL || input_organisation[i]->the_file==NULL) {
+ if (fullname) {
+ pfatal_error("! Cannot open change file ",
+ input_organisation[i]->file_name);
+ } else {
+ fatal_error(-1, "! Cannot find change file ",
+ input_organisation[i]->file_name);
+ }
+ }
+ else free(fullname);
+@.Cannot open change file@>
+@.Cannot find change file@>
+@z
+
+@x l.792
+boolean lines_dont_match(i, j)
+ file_index i, j;
+@y
+boolean lines_dont_match @,P2C(file_index, i, file_index, j)
+@z
+
+@x l.809
+void init_change_file(i)
+ file_index i;
+@y
+void init_change_file @,P1C(file_index, i)
+@z
+
+@x l.858
+void put_line(j)
+ file_index j;
+@y
+void put_line @,P1C(file_index, j)
+@z
+
+@x l.873
+boolean e_of_ch_module(i)
+ file_index i;
+@y
+boolean e_of_ch_module @,P1C(file_index, i)
+@z
+
+@x l.894
+boolean e_of_ch_preamble(i)
+ file_index i;
+@y
+boolean e_of_ch_preamble @,P1C(file_index, i)
+@z
+
+@x l.1106
+void usage_error()
+@y
+void usage_error @,P1H(void)
+@z
+
+@x l.1119 Add Web2C version to banner string
+printf("%s\n", banner); /* print a ``banner line'' */
+@y
+{
+ extern KPSEDLL string kpathsea_version_string; /* from kpathsea/version.c */
+ printf("%s (%s)\n", banner, kpathsea_version_string); /* print a ``banner line'' */
+}
+@z
+
+@x l.1233
+void usage_help();
+void print_version_and_exit();
+@y
+void usage_help @,P1H(void);
+void print_version_and_exit @,P2H(string, string);
+@z
+
+@x l.1238
+void usage_help()
+@y
+void usage_help @,P1H(void)
+@z
+
+@x l.1253
+void print_version_and_exit(name, version)
+ string name, version;
+{
+ printf ("%s %s\n", name, version);
+
+ puts ("Copyright (C) 2002,2003 Julian Gilbey.");
+
+ puts ("There is NO warranty. This is free software. See the source");
+ puts ("code of CTIE for redistribution conditions.");
+
+ exit (0);
+}
+@y
+void print_version_and_exit @,P2C(string, name, string, version)
+{
+ extern KPSEDLL string kpathsea_version_string; /* from kpathsea/version.c */
+ printf ("%s %s\n", name, version);
+ puts (kpathsea_version_string);
+
+ puts ("Copyright (C) 2002,2003 Julian Gilbey.");
+ puts ("Kpathsea is copyright (C) 1999 Free Software Foundation, Inc.");
+
+ puts ("There is NO warranty. This is free software.");
+ puts ("Redistribution of this software is covered by the terms of");
+ puts ("both the CTIE copyright and the GNU General Public Licence.");
+ puts ("For more information about these matters, see the files");
+ puts ("named COPYING and the CTIE source.");
+ puts ("Primary authors of CTIE: Julian Gilbey.");
+ puts ("Kpathsea written by Karl Berry and others.\n");
+
+ exit (0);
+}
+@z
+
+@x l.1267
+@* System-dependent changes.
+This section should be replaced, if necessary, by
+changes to the program that are necessary to make \.{CTIE}
+work at a particular installation. It is usually best to
+design your change file so that all changes to previous
+modules preserve the module numbering; then everybody's
+version will be consistent with the printed program. More
+extensive changes, which introduce new modules, can be
+inserted here; then only the index itself will get a new
+module number.
+@^system dependencies@>
+@y
+@* System-dependent changes.
+We modify the program to use the \.{kpathsea} library.
+We need to include the headers first.
+
+@<Global \&{\#include}s@>=
+#include <kpathsea/kpathsea.h>
+
+@ A global variable for the file read mode.
+
+@<Global variables@>=
+string file_open_mode;
+@z
diff --git a/Build/source/texk/web2c/ctiedir/ctie.1 b/Build/source/texk/web2c/ctiedir/ctie.1
new file mode 100644
index 00000000000..8058d364e5a
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.1
@@ -0,0 +1,55 @@
+.TH CTIE 1 20/04/2003
+.SH NAME
+ctie \- merge or apply CWEB change files
+.SH SYNOPSIS
+.B ctie
+.B \-c|\-m
+.I outputfile masterfile changefile...
+
+.SH DESCRIPTION
+The
+.I CTIE
+program is used to process multiple change files used with the CWEB
+system for literate programming. The CWEB programs allow one to apply
+patches to a source file (the
+.IR masterfile )
+by means of a single change file.
+.I CTIE
+can be used to either merge up to 32 change files into a single one or
+to apply the changes to the
+.I masterfile
+in order to create a new master file. Output of either the new change
+file or the patched master file goes into
+.IR outputfile .
+Any include files (indicated using the CWEB
+.I @i
+command) are fully expanded during
+.I CTIE
+processing, which means that the change files are able to modify the
+contents of any included files. Also, if this program has been
+compiled using the
+.I kpathsea
+library, then files are searched for using the
+.I CWEBINPUTS
+environment variable, as described in the
+.I kpathsea
+documentation.
+.SH OPTIONS
+.TP
+.B \-c
+Create a single change file from the given
+.IR changefiles .
+.TP
+.B \-m
+Create a new master file by applying the given
+.IR changefiles .
+.SH "SEE ALSO"
+.BR cweb (1),
+.IR ctiedoc.tex ,
+.BR tie (1),
+.BR web (1).
+.SH "AUTHOR"
+Julian Gilbey, jdg@debian.org. The original TIE program was by Klaus
+Guntermann, TH Darmstadt, Institut f. Theoretische Informatik. The
+TIE man page was by Joachim Schnitter, TH Darmstadt, Phys. Chemie I,
+and was modified for CTIE by Julian Gilbey.
diff --git a/Build/source/texk/web2c/ctiedir/ctie.c b/Build/source/texk/web2c/ctiedir/ctie.c
new file mode 100644
index 00000000000..840c7800144
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.c
@@ -0,0 +1,1111 @@
+#define version_number "1.1"
+#define banner "This is CTIE, Version 1.1"
+#define copyright \
+"Copyright 2002,2003 Julian Gilbey. All rights reserved. There is no warranty.\n\
+Run with the --version option for other important information." \
+ \
+
+#define false 0
+#define true 1 \
+
+#define buf_size 1024
+#define max_file_index 32 \
+
+#define xisupper(c) (isupper(c) &&((unsigned char) c<0200) ) \
+ \
+
+#define spotless 0
+#define troublesome 1
+#define fatal 2 \
+
+#define max_include_files 20 \
+
+#define max_file_name_length 60 \
+
+#define too_long() {total_include_files--;free(new_inc) ; \
+err_print(i,"! Include file name too long") ;goto restart;} \
+
+#define fatal_error(i,s,t) { \
+fprintf(stderr,"\n%s",s) ; \
+err_print(i,t) ; \
+history= fatal; \
+exit(wrap_up() ) ; \
+} \
+ \
+
+#define none (-1) \
+
+/*2:*/
+#line 89 "./ctie.w"
+
+/*8:*/
+#line 172 "./ctie.w"
+
+#include <stdio.h>
+
+
+/*:8*//*9:*/
+#line 180 "./ctie.w"
+
+#ifdef __STDC__
+#include <stdlib.h>
+#else
+#include <malloc.h>
+#endif
+
+
+/*:9*//*37:*/
+#line 715 "./ctie.w"
+
+#include <errno.h>
+
+
+/*:37*/
+#line 90 "./ctie.w"
+
+/*4:*/
+#line 124 "./ctie.w"
+
+typedef int boolean;
+typedef char*string;
+
+
+/*:4*//*10:*/
+#line 211 "./ctie.w"
+
+#define search 0
+#define test 1
+#define reading 2
+#define ignore 3
+typedef int in_file_modes;
+#define unknown 0
+#define master 1
+#define chf 2
+typedef int file_types;
+
+
+/*:10*//*11:*/
+#line 229 "./ctie.w"
+
+#define normal 0
+#define pre 1
+#define post 2
+typedef int out_md_type;
+
+
+/*:11*//*12:*/
+#line 239 "./ctie.w"
+
+typedef int file_index;
+
+
+/*:12*//*13:*/
+#line 246 "./ctie.w"
+
+typedef struct _indsc{
+char file_name[max_file_name_length];
+long line;
+FILE*the_file;
+struct _indsc*parent;
+}include_description;
+
+
+/*:13*//*14:*/
+#line 259 "./ctie.w"
+
+typedef struct _idsc{
+string file_name;
+char buffer[buf_size];
+in_file_modes mode;
+long line;
+file_types type_of_file;
+include_description*current_include;
+char*buffer_end;
+char*limit;
+char*loc;
+FILE*the_file;
+int dont_match;
+}input_description;
+
+
+/*:14*/
+#line 91 "./ctie.w"
+
+/*5:*/
+#line 134 "./ctie.w"
+
+extern int strlen();
+extern char*strcpy();
+extern int strncmp();
+extern char*strncpy();
+extern char*strerror();
+
+
+/*:5*//*28:*/
+#line 584 "./ctie.w"
+
+void err_print();
+
+/*:28*//*33:*/
+#line 673 "./ctie.w"
+
+int wrap_up();
+
+/*:33*//*35:*/
+#line 696 "./ctie.w"
+
+void pfatal_error();
+
+/*:35*//*67:*/
+#line 1232 "./ctie.w"
+
+void usage_help();
+void print_version_and_exit();
+
+
+/*:67*/
+#line 92 "./ctie.w"
+
+/*7:*/
+#line 162 "./ctie.w"
+
+int history= spotless;
+
+
+/*:7*//*15:*/
+#line 286 "./ctie.w"
+
+int total_include_files= 0;
+
+/*:15*//*16:*/
+#line 292 "./ctie.w"
+
+file_index actual_input,test_input,no_ch;
+file_types prod_chf= unknown;
+out_md_type out_mode;
+
+/*:16*//*18:*/
+#line 309 "./ctie.w"
+
+input_description*input_organisation[max_file_index+1];
+
+
+/*:18*//*22:*/
+#line 406 "./ctie.w"
+
+boolean input_has_ended= false;
+
+
+/*:22*//*39:*/
+#line 742 "./ctie.w"
+
+FILE*out_file;
+string out_name;
+
+
+/*:39*//*66:*/
+#line 1217 "./ctie.w"
+
+string CTIEHELP[]= {
+"Usage: ctie -[mc] outfile master changefile(s)",
+" Create a new master file or change file from the given",
+" master (C)WEB file and changefiles.",
+" All filenames are taken literally; no suffixes are added.",
+"",
+"-m create a new master file from original (C)WEB and change file(s)",
+"-c create a master change file for original (C)WEB file from changefile(s)",
+"--help display this help and exit",
+"--version display version information and exit",
+NULL
+};
+
+
+/*:66*/
+#line 93 "./ctie.w"
+
+/*29:*/
+#line 589 "./ctie.w"
+
+void err_print(i,s)
+file_index i;char*s;
+{
+char*k,*l;
+fprintf(stderr,*s=='!'?"\n%s":"%s",s);
+if(i>=0)/*30:*/
+#line 611 "./ctie.w"
+
+{
+register input_description*inp_desc= input_organisation[i];
+register include_description*inc_desc= inp_desc->current_include;
+
+if(inc_desc!=NULL){
+fprintf(stderr,". (l. %ld of include file %s",inc_desc->line,
+inc_desc->file_name);
+fprintf(stderr," included from l. %ld of %s file %s)\n",
+inp_desc->line,
+inp_desc->type_of_file==master?"master":"change",
+inp_desc->file_name);
+}
+else
+fprintf(stderr,". (l. %ld of %s file %s)\n",inp_desc->line,
+inp_desc->type_of_file==master?"master":"change",
+inp_desc->file_name);
+l= (inp_desc->loc>=inp_desc->limit?inp_desc->limit:inp_desc->loc);
+if(l> inp_desc->buffer){
+for(k= inp_desc->buffer;k<l;k++)
+if(*k=='\t')putc(' ',stderr);
+else putc(*k,stderr);
+putc('\n',stderr);
+for(k= inp_desc->buffer;k<l;k++)
+putc(' ',stderr);
+}
+for(k= l;k<inp_desc->limit;k++)
+putc(*k,stderr);
+putc('\n',stderr);
+}
+
+
+/*:30*/
+#line 595 "./ctie.w"
+
+else putc('\n',stderr);
+fflush(stderr);
+history= troublesome;
+}
+
+/*:29*//*36:*/
+#line 699 "./ctie.w"
+
+void pfatal_error(s,t)
+char*s,*t;
+{
+char*strerr= strerror(errno);
+
+fprintf(stderr,"\n%s%s",s,t);
+if(strerr)fprintf(stderr," (%s)\n",strerr);
+else fprintf(stderr,"\n");
+history= fatal;
+exit(wrap_up());
+}
+
+
+/*:36*/
+#line 94 "./ctie.w"
+
+/*19:*/
+#line 328 "./ctie.w"
+
+boolean get_line(i,do_includes)
+file_index i;boolean do_includes;
+{
+register input_description*inp_desc= input_organisation[i];
+register FILE*fp;
+
+if(inp_desc->mode==ignore)return false;
+
+restart:
+if(inp_desc->current_include!=NULL){
+register include_description*inc_desc= inp_desc->current_include;
+
+fp= inc_desc->the_file;
+/*24:*/
+#line 426 "./ctie.w"
+
+{
+register int c;
+register char*k;
+
+if(feof(fp))
+/*25:*/
+#line 452 "./ctie.w"
+
+{
+include_description*temp= inc_desc->parent;
+
+fclose(fp);
+free(inc_desc);
+total_include_files--;
+inp_desc->current_include= temp;
+goto restart;
+}
+
+
+/*:25*/
+#line 432 "./ctie.w"
+
+
+inp_desc->limit= k= inp_desc->buffer;
+while(k<=inp_desc->buffer_end&&(c= getc(fp))!=EOF&&c!='\n')
+if((*(k++)= c)!=' ')inp_desc->limit= k;
+if(k> inp_desc->buffer_end)
+if((c= getc(fp))!=EOF&&c!='\n'){
+ungetc(c,fp);inp_desc->loc= inp_desc->buffer;
+err_print(i,"! Input line too long");
+
+}
+if(c==EOF&&inp_desc->limit==inp_desc->buffer)
+/*25:*/
+#line 452 "./ctie.w"
+
+{
+include_description*temp= inc_desc->parent;
+
+fclose(fp);
+free(inc_desc);
+total_include_files--;
+inp_desc->current_include= temp;
+goto restart;
+}
+
+
+/*:25*/
+#line 444 "./ctie.w"
+
+
+inc_desc->line++;
+}
+
+/*:24*/
+#line 342 "./ctie.w"
+
+}
+else{
+fp= inp_desc->the_file;
+/*20:*/
+#line 366 "./ctie.w"
+
+{
+register int c;
+register char*k;
+
+if(feof(fp))
+/*21:*/
+#line 394 "./ctie.w"
+
+{
+inp_desc->mode= ignore;
+inp_desc->limit= NULL;
+if(inp_desc->type_of_file==master)input_has_ended= true;
+fclose(fp);
+return false;
+}
+
+
+/*:21*/
+#line 372 "./ctie.w"
+
+
+inp_desc->limit= k= inp_desc->buffer;
+while(k<=inp_desc->buffer_end&&(c= getc(fp))!=EOF&&c!='\n')
+if((*(k++)= c)!=' ')inp_desc->limit= k;
+if(k> inp_desc->buffer_end)
+if((c= getc(fp))!=EOF&&c!='\n'){
+ungetc(c,fp);inp_desc->loc= inp_desc->buffer;
+err_print(i,"! Input line too long");
+
+}
+if(c==EOF&&inp_desc->limit==inp_desc->buffer)
+/*21:*/
+#line 394 "./ctie.w"
+
+{
+inp_desc->mode= ignore;
+inp_desc->limit= NULL;
+if(inp_desc->type_of_file==master)input_has_ended= true;
+fclose(fp);
+return false;
+}
+
+
+/*:21*/
+#line 384 "./ctie.w"
+
+
+/*23:*/
+#line 414 "./ctie.w"
+
+inp_desc->line++;
+if(inp_desc->type_of_file==master&&inp_desc->line%100==0){
+if(inp_desc->line%500==0)printf("%ld",inp_desc->line);
+else putchar('.');
+fflush(stdout);
+}
+
+
+/*:23*/
+#line 387 "./ctie.w"
+
+}
+
+
+/*:20*/
+#line 346 "./ctie.w"
+
+}
+
+if(do_includes)
+/*26:*/
+#line 467 "./ctie.w"
+
+{
+inp_desc->loc= inp_desc->buffer;
+*inp_desc->limit= ' ';
+if(*inp_desc->buffer=='@'&&
+(inp_desc->buffer[1]=='i'||inp_desc->buffer[1]=='I')){
+inp_desc->loc= inp_desc->buffer+2;
+*inp_desc->limit= '"';
+while(*inp_desc->loc==' '||*inp_desc->loc=='\t')
+inp_desc->loc++;
+if(inp_desc->loc>=inp_desc->limit){
+err_print(i,"! Include file name not given");
+
+goto restart;
+}
+if(total_include_files>=max_include_files){
+err_print(i,"! Too many nested includes");
+
+goto restart;
+}
+total_include_files++;
+/*27:*/
+#line 507 "./ctie.w"
+
+{
+include_description*new_inc;
+char temp_file_name[max_file_name_length];
+char*file_name_end;
+char*k,*kk;
+int l;
+
+new_inc= (include_description*)malloc(sizeof(include_description));
+if(new_inc==NULL)
+fatal_error(i,"! No memory for new include descriptor","");
+new_inc->line= 0;
+k= new_inc->file_name;
+file_name_end= k+max_file_name_length-1;
+
+if(*inp_desc->loc=='"'){
+inp_desc->loc++;
+while(*inp_desc->loc!='"'&&k<=file_name_end)
+*k++= *inp_desc->loc++;
+if(inp_desc->loc==inp_desc->limit)
+k= file_name_end+1;
+}else
+while(*inp_desc->loc!=' '&&*inp_desc->loc!='\t'&&
+*inp_desc->loc!='"'&&k<=file_name_end)*k++= *inp_desc->loc++;
+if(k> file_name_end)too_long();
+
+*k= '\0';
+if((new_inc->the_file= fopen(new_inc->file_name,"r"))!=NULL){
+new_inc->parent= inp_desc->current_include;
+inp_desc->current_include= new_inc;
+goto restart;
+}
+kk= getenv("CWEBINPUTS");
+if(kk!=NULL){
+if((l= strlen(kk))> max_file_name_length-2)too_long();
+strcpy(temp_file_name,kk);
+}
+else{
+#ifdef CWEBINPUTS
+if((l= strlen(CWEBINPUTS))> max_file_name_length-2)too_long();
+strcpy(temp_file_name,CWEBINPUTS);
+#else
+l= 0;
+#endif
+}
+if(l> 0){
+if(k+l+2>=file_name_end)too_long();
+for(;k>=new_inc->file_name;k--)*(k+l+1)= *k;
+strcpy(new_inc->file_name,temp_file_name);
+new_inc->file_name[l]= '/';
+if((new_inc->the_file= fopen(new_inc->file_name,"r"))!=NULL){
+new_inc->parent= inp_desc->current_include;
+inp_desc->current_include= new_inc;
+goto restart;
+}
+}
+total_include_files--;
+free(new_inc);
+err_print(i,"! Cannot open include file");
+
+goto restart;
+}
+
+
+
+/*:27*/
+#line 488 "./ctie.w"
+;
+}
+}
+
+
+/*:26*/
+#line 351 "./ctie.w"
+
+return true;
+}
+
+
+/*:19*//*32:*/
+#line 663 "./ctie.w"
+
+int wrap_up()
+{
+/*34:*/
+#line 682 "./ctie.w"
+
+switch(history){
+case spotless:
+printf("\n(No errors were found.)\n");break;
+case troublesome:
+printf("\n(Pardon me, but I think I spotted something wrong.)\n");break;
+case fatal:printf("(That was a fatal error, my friend.)\n");
+}
+
+
+/*:34*/
+#line 666 "./ctie.w"
+;
+if(history> spotless)return 1;
+else return 0;
+}
+
+/*:32*//*42:*/
+#line 791 "./ctie.w"
+
+boolean lines_dont_match(i,j)
+file_index i,j;
+{
+register input_description*iptr= input_organisation[i],
+*jptr= input_organisation[j];
+
+if(iptr->limit-iptr->buffer!=jptr->limit-jptr->buffer)
+return true;
+return strncmp(iptr->buffer,jptr->buffer,iptr->limit-iptr->buffer);
+}
+
+
+/*:42*//*43:*/
+#line 808 "./ctie.w"
+
+void init_change_file(i)
+file_index i;
+{
+register input_description*inp_desc= input_organisation[i];
+char ccode;
+
+inp_desc->limit= inp_desc->buffer;
+/*44:*/
+#line 827 "./ctie.w"
+
+while(1){
+if(!get_line(i,false))return;
+if(inp_desc->limit<inp_desc->buffer+2)continue;
+if(inp_desc->buffer[0]!='@')continue;
+ccode= inp_desc->buffer[1];
+if(xisupper(ccode))ccode= tolower(ccode);
+if(ccode=='x')break;
+if(ccode=='y'||ccode=='z'||ccode=='i'){
+inp_desc->loc= inp_desc->buffer+2;
+err_print(i,"! Missing @x in change file");
+
+}
+}
+
+/*:44*/
+#line 816 "./ctie.w"
+
+/*45:*/
+#line 844 "./ctie.w"
+
+do{
+if(!get_line(i,true)){
+err_print(i,"! Change file ended after @x");
+
+return;
+}
+}while(inp_desc->limit==inp_desc->buffer);
+
+
+/*:45*/
+#line 817 "./ctie.w"
+
+inp_desc->dont_match= 0;
+}
+
+
+/*:43*//*46:*/
+#line 857 "./ctie.w"
+
+void put_line(j)
+file_index j;
+{
+char*ptr= input_organisation[j]->buffer;
+char*lmt= input_organisation[j]->limit;
+
+while(ptr<lmt)putc(*ptr++,out_file);
+putc('\n',out_file);
+}
+
+
+/*:46*//*47:*/
+#line 872 "./ctie.w"
+
+boolean e_of_ch_module(i)
+file_index i;
+{
+register input_description*inp_desc= input_organisation[i];
+
+if(inp_desc->limit==NULL){
+err_print(i,"! Change file ended without @z");
+
+return true;
+}else if(inp_desc->limit>=inp_desc->buffer+2)
+if(inp_desc->buffer[0]=='@'&&
+(inp_desc->buffer[1]=='Z'||inp_desc->buffer[1]=='z'))
+return true;
+return false;
+}
+
+
+/*:47*//*48:*/
+#line 893 "./ctie.w"
+
+boolean e_of_ch_preamble(i)
+file_index i;
+{
+register input_description*inp_desc= input_organisation[i];
+
+if(inp_desc->limit>=inp_desc->buffer+2&&inp_desc->buffer[0]=='@')
+if(inp_desc->buffer[1]=='Y'||inp_desc->buffer[1]=='y'){
+if(inp_desc->dont_match> 0){
+inp_desc->loc= inp_desc->buffer+2;
+fprintf(stderr,"\n! Hmm... %d ",inp_desc->dont_match);
+err_print(i,"of the preceding lines failed to match");
+}
+return true;
+}
+return false;
+}
+
+
+
+/*:48*//*59:*/
+#line 1105 "./ctie.w"
+
+void usage_error()
+{
+/*60:*/
+#line 1118 "./ctie.w"
+
+printf("%s\n",banner);
+printf("%s\n",copyright);
+
+
+/*:60*/
+#line 1108 "./ctie.w"
+;
+fprintf(stderr,"Usage: ctie -[mc] outfile master changefile(s)\n");
+fprintf(stderr,"Type ctie --help for more information\n");
+exit(1);
+}
+
+
+/*:59*/
+#line 95 "./ctie.w"
+
+/*3:*/
+#line 101 "./ctie.w"
+
+main(argc,argv)
+int argc;string*argv;
+{
+/*17:*/
+#line 300 "./ctie.w"
+
+actual_input= 0;
+out_mode= normal;
+
+/*:17*/
+#line 105 "./ctie.w"
+;
+/*61:*/
+#line 1135 "./ctie.w"
+
+{
+if(argc> max_file_index+5-1)usage_error();
+no_ch= -1;
+while(--argc> 0){
+argv++;
+if(strcmp("-help",*argv)==0||strcmp("--help",*argv)==0)
+/*64:*/
+#line 1202 "./ctie.w"
+
+usage_help();
+
+
+
+/*:64*/
+#line 1142 "./ctie.w"
+;
+if(strcmp("-version",*argv)==0||strcmp("--version",*argv)==0)
+/*65:*/
+#line 1208 "./ctie.w"
+
+{
+print_version_and_exit("CTIE",version_number);
+
+}
+
+
+/*:65*/
+#line 1144 "./ctie.w"
+;
+if(**argv=='-')/*62:*/
+#line 1158 "./ctie.w"
+
+if(prod_chf!=unknown)usage_error();
+else
+switch(*(*argv+1)){
+case'c':case'C':prod_chf= chf;break;
+case'm':case'M':prod_chf= master;break;
+default:usage_error();
+}
+
+
+/*:62*/
+#line 1145 "./ctie.w"
+
+else/*63:*/
+#line 1172 "./ctie.w"
+
+{
+if(no_ch==(-1)){
+out_name= *argv;
+}else{
+register input_description*inp_desc;
+
+inp_desc= (input_description*)malloc(sizeof(input_description));
+if(inp_desc==NULL)
+fatal_error(-1,"! No memory for input descriptor","");
+
+inp_desc->mode= search;
+inp_desc->line= 0;
+inp_desc->type_of_file= chf;
+inp_desc->limit= inp_desc->buffer;
+inp_desc->buffer[0]= ' ';
+inp_desc->loc= inp_desc->buffer+1;
+inp_desc->buffer_end= inp_desc->buffer+buf_size-2;
+inp_desc->file_name= *argv;
+inp_desc->current_include= NULL;
+input_organisation[no_ch]= inp_desc;
+}
+no_ch++;
+}
+
+
+/*:63*/
+#line 1146 "./ctie.w"
+
+}
+if(no_ch<=0||prod_chf==unknown)usage_error();
+}
+
+
+/*:61*/
+#line 106 "./ctie.w"
+
+/*60:*/
+#line 1118 "./ctie.w"
+
+printf("%s\n",banner);
+printf("%s\n",copyright);
+
+
+/*:60*/
+#line 107 "./ctie.w"
+;
+/*40:*/
+#line 750 "./ctie.w"
+
+{
+input_organisation[0]->the_file=
+fopen(input_organisation[0]->file_name,"r");
+
+if(input_organisation[0]->the_file==NULL)
+pfatal_error("! Cannot open master file ",
+input_organisation[0]->file_name);
+
+printf("(%s)\n",input_organisation[0]->file_name);
+input_organisation[0]->type_of_file= master;
+get_line(0,true);
+}
+
+
+/*:40*/
+#line 108 "./ctie.w"
+
+/*41:*/
+#line 768 "./ctie.w"
+
+{
+file_index i;
+
+i= 1;
+while(i<no_ch){
+input_organisation[i]->the_file=
+fopen(input_organisation[i]->file_name,"r");
+if(input_organisation[i]->the_file==NULL)
+pfatal_error("! Cannot open change file ",
+input_organisation[i]->file_name);
+
+printf("(%s)\n",input_organisation[i]->file_name);
+init_change_file(i);
+i++;
+}
+}
+
+
+/*:41*/
+#line 109 "./ctie.w"
+
+/*38:*/
+#line 729 "./ctie.w"
+
+{
+out_file= fopen(out_name,"w");
+if(out_file==NULL){
+pfatal_error("! Cannot open/create output file","");
+
+}
+}
+
+
+/*:38*/
+#line 110 "./ctie.w"
+
+/*57:*/
+#line 1074 "./ctie.w"
+
+actual_input= 0;
+input_has_ended= false;
+while(input_has_ended==false||actual_input!=0)
+/*49:*/
+#line 917 "./ctie.w"
+
+{
+file_index test_file;
+
+/*50:*/
+#line 934 "./ctie.w"
+
+{
+register input_description*inp_desc;
+while(actual_input> 0&&e_of_ch_module(actual_input)){
+inp_desc= input_organisation[actual_input];
+if(inp_desc->type_of_file==master){
+
+fatal_error(-1,"! This can't happen: change file is master file","");
+
+}
+inp_desc->mode= search;
+init_change_file(actual_input);
+while((input_organisation[actual_input]->mode!=reading
+&&actual_input> 0))
+actual_input--;
+}
+}
+
+
+/*:50*/
+#line 921 "./ctie.w"
+
+if(input_has_ended&&actual_input==0)break;
+/*51:*/
+#line 960 "./ctie.w"
+
+test_input= none;
+test_file= actual_input;
+while(test_input==none&&test_file<no_ch-1){
+test_file++;
+switch(input_organisation[test_file]->mode){
+case search:
+if(lines_dont_match(actual_input,test_file)==false){
+input_organisation[test_file]->mode= test;
+test_input= test_file;
+}
+break;
+case test:
+if(lines_dont_match(actual_input,test_file)){
+
+input_organisation[test_file]->dont_match++;
+}
+test_input= test_file;
+break;
+case reading:
+break;
+case ignore:
+break;
+}
+}
+
+
+/*:51*/
+#line 923 "./ctie.w"
+
+/*52:*/
+#line 993 "./ctie.w"
+
+if(prod_chf==chf){
+while(1){
+/*53:*/
+#line 1007 "./ctie.w"
+
+if(out_mode==normal){
+if(test_input!=none){
+fprintf(out_file,"@x\n");
+out_mode= pre;
+}else break;
+}
+
+
+/*:53*/
+#line 996 "./ctie.w"
+
+/*54:*/
+#line 1021 "./ctie.w"
+
+if(out_mode==pre){
+if(test_input==none){
+fprintf(out_file,"@y\n");
+out_mode= post;
+}else{
+if(input_organisation[actual_input]->type_of_file==master)
+put_line(actual_input);
+break;
+}
+}
+
+
+/*:54*/
+#line 997 "./ctie.w"
+
+/*55:*/
+#line 1040 "./ctie.w"
+
+if(out_mode==post){
+if(input_organisation[actual_input]->type_of_file==chf){
+if(test_input==none)put_line(actual_input);
+break;
+}else{
+fprintf(out_file,"@z\n\n");
+out_mode= normal;
+}
+}
+
+
+/*:55*/
+#line 998 "./ctie.w"
+
+}
+}else
+if(test_input==none)put_line(actual_input);
+
+
+/*:52*/
+#line 924 "./ctie.w"
+
+/*56:*/
+#line 1055 "./ctie.w"
+
+get_line(actual_input,true);
+if(test_input!=none){
+get_line(test_input,true);
+if(e_of_ch_preamble(test_input)==true){
+get_line(test_input,true);
+input_organisation[test_input]->mode= reading;
+actual_input= test_input;
+test_input= none;
+}
+}
+
+
+/*:56*/
+#line 925 "./ctie.w"
+
+}
+
+
+/*:49*/
+#line 1078 "./ctie.w"
+
+if(out_mode==post)
+fprintf(out_file,"@z\n");
+
+
+/*:57*/
+#line 111 "./ctie.w"
+
+/*58:*/
+#line 1087 "./ctie.w"
+
+{
+file_index i;
+
+for(i= 1;i<no_ch;i++){
+if(input_organisation[i]->mode!=ignore){
+input_organisation[i]->loc= input_organisation[i]->buffer;
+err_print(i,"! Change file entry did not match");
+
+}
+}
+}
+
+
+/*:58*/
+#line 112 "./ctie.w"
+
+exit(wrap_up());
+}
+
+/*:3*/
+#line 96 "./ctie.w"
+
+
+/*:2*//*68:*/
+#line 1237 "./ctie.w"
+
+void usage_help()
+{
+string*message= CTIEHELP;
+
+while(*message){
+fputs(*message,stdout);
+putchar('\n');
+++message;
+}
+putchar('\n');
+exit(0);
+}
+
+
+/*:68*//*69:*/
+#line 1252 "./ctie.w"
+
+void print_version_and_exit(name,version)
+string name,version;
+{
+printf("%s %s\n",name,version);
+
+puts("Copyright (C) 2002,2003 Julian Gilbey.");
+
+puts("There is NO warranty. This is free software. See the source");
+puts("code of CTIE for redistribution conditions.");
+
+exit(0);
+}
+
+
+/*:69*/
diff --git a/Build/source/texk/web2c/ctiedir/ctie.cf1 b/Build/source/texk/web2c/ctiedir/ctie.cf1
new file mode 100644
index 00000000000..5b1165435c9
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.cf1
@@ -0,0 +1,14 @@
+@x
+line 2
+line 3
+@y
+changed line 2
+changed line 3
+inserted line
+@z
+
+@x
+line 7
+@y
+changed line 7
+@z
diff --git a/Build/source/texk/web2c/ctiedir/ctie.cf2 b/Build/source/texk/web2c/ctiedir/ctie.cf2
new file mode 100644
index 00000000000..d9a5fbaf673
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.cf2
@@ -0,0 +1,26 @@
+@x
+line 1
+changed line 2
+changed line 3
+inserted line
+line 4
+@y
+final line 2
+final line 3
+changed line 4
+@z
+
+@x
+include line 1
+@y
+changed include line 1
+inserted include line
+@z
+
+@x
+changed line 7
+line 8
+@y
+final line 7
+final line 8
+@z
diff --git a/Build/source/texk/web2c/ctiedir/ctie.cf3 b/Build/source/texk/web2c/ctiedir/ctie.cf3
new file mode 100644
index 00000000000..95c7ff63536
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.cf3
@@ -0,0 +1,13 @@
+@x
+changed line 4
+@y
+final line 4
+@z
+
+@x
+changed include line 1
+inserted include line
+@y
+final include line 1
+@i ctie.inc2
+@z
diff --git a/Build/source/texk/web2c/ctiedir/ctie.chf.gen b/Build/source/texk/web2c/ctiedir/ctie.chf.gen
new file mode 100644
index 00000000000..d07e9280c08
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.chf.gen
@@ -0,0 +1,26 @@
+@x
+line 1
+line 2
+line 3
+line 4
+@y
+final line 2
+final line 3
+final line 4
+@z
+
+@x
+include line 1
+@y
+final include line 1
+final inserted include line
+@z
+
+@x
+line 7
+line 8
+@y
+final line 7
+final line 8
+@z
+
diff --git a/Build/source/texk/web2c/ctiedir/ctie.inc b/Build/source/texk/web2c/ctiedir/ctie.inc
new file mode 100644
index 00000000000..435c17d8a18
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.inc
@@ -0,0 +1,4 @@
+include line 1
+include line 2
+@i ctie.inc1
+include line 3
diff --git a/Build/source/texk/web2c/ctiedir/ctie.inc1 b/Build/source/texk/web2c/ctiedir/ctie.inc1
new file mode 100644
index 00000000000..79b0114e1e8
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.inc1
@@ -0,0 +1 @@
+included include line
diff --git a/Build/source/texk/web2c/ctiedir/ctie.inc2 b/Build/source/texk/web2c/ctiedir/ctie.inc2
new file mode 100644
index 00000000000..bb83f8a6710
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.inc2
@@ -0,0 +1 @@
+final inserted include line
diff --git a/Build/source/texk/web2c/ctiedir/ctie.master.gen b/Build/source/texk/web2c/ctiedir/ctie.master.gen
new file mode 100644
index 00000000000..4c00f383145
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.master.gen
@@ -0,0 +1,19 @@
+final line 2
+final line 3
+final line 4
+line 5
+final include line 1
+final inserted include line
+include line 2
+included include line
+include line 3
+line 6
+final line 7
+final line 8
+line 9
+line 10
+The character set:
+abcdefghijklmnopqrstuvwxyz
+ABCDEFGHIJKLMNOPQRSTUVWXYZ
+=!"#$%&/()?'`^~|-+[]{}@\;:
+ 0123456789<>.,*_
diff --git a/Build/source/texk/web2c/ctiedir/ctie.tie b/Build/source/texk/web2c/ctiedir/ctie.tie
new file mode 100644
index 00000000000..649b26d5518
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.tie
@@ -0,0 +1,16 @@
+line 1
+line 2
+line 3
+line 4
+line 5
+@i "ctie.inc"
+line 6
+line 7
+line 8
+line 9
+line 10
+The character set:
+abcdefghijklmnopqrstuvwxyz
+ABCDEFGHIJKLMNOPQRSTUVWXYZ
+=!"#$%&/()?'`^~|-+[]{}@\;:
+ 0123456789<>.,*_
diff --git a/Build/source/texk/web2c/ctiedir/ctie.w b/Build/source/texk/web2c/ctiedir/ctie.w
new file mode 100644
index 00000000000..33abf6312c8
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctie.w
@@ -0,0 +1,1280 @@
+% This is ctie.w
+% Copyright (c) 2002,2003 by Julian Gilbey
+% All rights reserved.
+%
+% This program is distributed WITHOUT ANY WARRANTY, express or implied.
+%
+% Permission is granted to make and distribute verbatim copies of this
+% program provided that the copyright notice and this permission notice
+% are preserved on all copies.
+%
+% Permission is granted to copy and distribute modified versions of this
+% program under the conditions for verbatim copying, provided that the
+% entire resulting derived work is distributed under the terms of a
+% permission notice identical to this one.
+%
+% This program is based heavily on tie.w and common.w, part of the
+% CWEB source.
+
+\def\title{The CTIE processor}
+\def\botofcontents{%
+\vfill
+$\copyright$ 2002,2003 Julian Gilbey
+
+All rights reserved.
+
+This program is distributed WITHOUT ANY WARRANTY, express or implied.
+
+Permission is granted to make and distribute verbatim copies of this
+program provided that the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+program under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+}
+
+
+@* Introduction.
+Whenever a programmer wants to change a given \.{WEB} or \.{CWEB}
+program (referred to as a \.{WEB} program throughout this program)
+because of system dependencies, she or he will create a new change
+file. In addition there may be a second change file to modify system
+independent modules of the program. But the \.{WEB} file cannot be
+tangled and weaved with more than one change file simultaneously.
+The \.{TIE} program was designed to merge a \.{WEB} file
+and several change files producing a new \.{WEB} file, and since the
+input files are tied together, the program was called \.{TIE}.
+Furthermore, the program could be used to merge several change files
+giving a new single change file. This method seems to be more
+important because it doesn't modify the original source file.
+
+However, the introduction of \.{CWEB} has meant that \.{TIE} is not
+quite able to perform its task correctly any longer: \.{CWEB}
+introduced the idea of include files, which are input into \.{CWEB}
+files using the \.{@@i} command, and \.{TIE} is unable to handle such
+constructs if the change files modify lines included in those files.
+The present program, \.{CTIE}, is designed to overcome this lack.
+Like \.{TIE}, upon which it is based, it can either output a single
+master \.{WEB} file or a master change file. However, in both cases,
+any include commands will be totally expanded and the files included
+in the output rather than the \.{@@i} commands being left; this makes
+this code feasible, which it would not necessarily be otherwise.
+Other than this difference, \.{CTIE} should function identically to
+\.{TIE} on files which do not involve any \.{CWEB} include commands.
+
+The algorithm used is essentially the same as that of \.{TIE}, with
+modifications to check for and handle \.{@@i} commands. Thus, as with
+\.{TIE}, the method used only needs one buffer line for each input
+file. Thus the storage requirement of \.{CTIE} does not depend on the
+sizes of the input files but only on their number.
+
+The program is written in \CEE/ and has few system dependencies.
+
+The ``banner line'' defined here should be changed whenever
+\.{CTIE} is modified. We also keep the version number here separately
+for ease; it is used below.
+
+@d version_number "1.1"
+@d banner "This is CTIE, Version 1.1"
+@d copyright
+ "Copyright 2002,2003 Julian Gilbey. All rights reserved. There is no warranty.\n\
+Run with the --version option for other important information."
+
+
+@ The main outline of the program is now given.
+This can be used more or less for any \CEE/ program.
+
+@c
+@<Global \&{\#include}s@>@;
+@<Global types@>@;
+@<Predeclaration of functions@>@;
+@<Global variables@>@;
+@<Error handling functions@>@;
+@<Internal functions@>@;
+@<The main function@>@;
+
+@ And this is the structure of the |main| function: this is where
+\.{CTIE} starts, and where it ends.
+
+@<The main function@>=
+main(argc, argv)
+ int argc; string *argv;
+{
+ @<Initialise parameters@>;
+ @<Scan the parameters@>@;
+ @<Print the banners@>;
+ @<Get the master file started@>@;
+ @<Prepare the change files@>@;
+ @<Prepare the output file@>@;
+ @<Process the input@>@;
+ @<Check that all changes have been read@>@;
+ exit(wrap_up());
+}
+
+@ We include the additional types |boolean| and |string|. \.{CTIE}
+replaces the complex \.{TIE} character set handling (based on that of
+the original \.{WEB} system) with the standard \.{CWEB} behaviour, and
+so uses the |char| type for input and output.
+
+@d false 0
+@d true 1
+
+@<Global types@>=
+typedef int boolean;
+typedef char* string;
+
+
+@ We predeclare some standard string-handling functions here instead of
+including their system header files, because the names of the header files
+are not as standard as the names of the functions. (There's confusion
+between \.{<string.h>} and \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+extern char *strerror();
+
+
+@ The following parameters should be sufficient for most
+applications of \.{CTIE}.
+@^system dependencies@>
+
+@d buf_size 1024 /* maximum length of one input line */
+@d max_file_index 32
+/* we don't think that anyone needs more than 32 change files */
+@d xisupper(c) (isupper(c)&&((unsigned char)c<0200))
+
+
+@ We introduce a history variable that allows us to set a
+return code if the operating system can use it.
+First we introduce the coded values for the history.
+This variable must be initialized.
+(We do this even if the value given may be the default for
+variables, just to document the need for the initial value.)
+@d spotless 0
+@d troublesome 1
+@d fatal 2
+
+@<Global variables@>=
+int history=spotless;
+
+
+@* Input and output.
+Standard output for the user is done by writing on |stdout|. Error
+messages are written to |stderr|. Terminal input is not needed in
+this version of \.{CTIE}. |stdin|, |stdout| and |stderr| are
+predefined as we include the \.{stdio.h} definitions.
+
+@<Global \&{\#include}s@>=
+#include <stdio.h>
+
+
+@ And we need dynamic memory allocation.
+This should cause no trouble in any \CEE/ program.
+@^system dependencies@>
+
+@<Global \&{\#include}s@>=
+#ifdef __STDC__
+#include <stdlib.h>
+#else
+#include <malloc.h>
+#endif
+
+
+@* Data structures.
+The multiple primary input files (master file and change
+files) are treated the same way. To organize the
+simultaneous usage of several input files, we introduce the
+data type \&{in\_file\_modes}.
+
+The mode |search| indicates that \.{CTIE} searches for a
+match of the input line with any line of an input file in
+|reading| mode. |test| is used whenever a match is found
+and it has to be tested if the next input lines do match
+also. |reading| describes that the lines can be read without
+any check for matching other lines. |ignore| denotes
+that the file cannot be used. This may happen because an
+error has been detected or because the end of the file has
+been found.
+
+\leavevmode |file_types| is used to describe whether a file
+is a master file or a change file. The value |unknown| is added
+to this type to set an initial mode for the output file.
+This enables us to check whether any option was used to select
+the kind of output. (this would even be necessary if we
+would assume a default action for missing options.)
+
+@<Global types@>=
+#define search 0
+#define test 1
+#define reading 2
+#define ignore 3
+typedef int in_file_modes; /* should be |enum(search, test, reading, ignore)| */
+#define unknown 0
+#define master 1
+#define chf 2
+typedef int file_types; /* should be |enum(unknown, master, chf)| */
+
+
+@ A variable of type |out_md_type| will tell us in what state the output
+change file is during processing. |normal| will be the state, when we
+did not yet start a change, |pre| will be set when we write the lines
+to be changes and |post| will indicate that the replacement lines are
+written.
+
+@<Global types@>=
+#define normal 0
+#define pre 1
+#define post 2
+typedef int out_md_type; /* should be |enum(normal, pre, post)| */
+
+
+@ The next type will indicate variables used as an index into the file
+table.
+
+@<Global types@>=
+typedef int file_index; /* |-1..max_file_index+1| */
+
+
+@ This is the data structure in which we collect information about
+each include file.
+
+@<Global types@>=
+typedef struct _indsc {
+ char file_name[max_file_name_length];
+ long line;
+ FILE *the_file;
+ struct _indsc *parent;
+} include_description;
+
+
+@ The following data structure contains all of the information needed
+to use these input files.
+%`line' is a normal identifier throughout this program
+@f line dummy
+@<Global types@>=
+typedef struct _idsc{
+ string file_name;
+ char buffer[buf_size];
+ in_file_modes mode;
+ long line;
+ file_types type_of_file;
+ include_description *current_include;
+ char *buffer_end;
+ char *limit;
+ char *loc;
+ FILE *the_file;
+ int dont_match;
+ } input_description;
+
+
+@ Every one of the primary input files might include another file
+using the \.{@@i} include mechanism. In turn, each of these might
+include other files, and so on. We allow a limited number of these
+files to be opened simultaneously, and we store information about the
+currently open include files as a linked list attached to each primary
+file.
+
+@d max_include_files 20
+ /* maximum number of include files open simultaneously */
+@d max_file_name_length 60
+
+@<Global variables@>=
+int total_include_files = 0; /* count 'em */
+
+@ The following variables refer to the files in action, the number of
+change files, the mode of operation and the current output state.
+
+@<Global variables@>=
+file_index actual_input, test_input, no_ch;
+file_types prod_chf=unknown;
+out_md_type out_mode;
+
+@ And the |actual_input| and |out_mode| variables need to be
+initialised sensibly.
+
+@<Initialise parameters@>=
+actual_input=0;
+out_mode=normal;
+
+@ All primary input files (including the master file) are recorded
+in the following structure.
+The components are usually accessed through a local pointer variable,
+requiring only a one-time-computation of the index expression.
+
+@<Global variables@>=
+input_description *input_organisation[max_file_index+1];
+
+
+@* File I/O.
+The basic function |get_line| can be used to get a line from
+an input file. The line is stored in the |buffer| part of the
+descriptor. The components |limit| and |line| are updated. If the
+end of the file is reached |mode| is set to |ignore|. On some systems
+it might be useful to replace tab characters by a proper number of
+spaces since several editors used to create change files insert tab
+characters into a source file not under control of the user. So it
+might be a problem to create a matching change file.
+@^tab character expansion@>
+
+We define |get_line| to read a line from a file specified by the
+corresponding file descriptor. This function returns |true| if it is
+successful and |false| if the end of the file has been reached.
+
+@<Internal functions@>=
+boolean get_line(i, do_includes)
+ file_index i; boolean do_includes;
+{
+ register input_description *inp_desc=input_organisation[i];
+ register FILE *fp;
+
+ if (inp_desc->mode==ignore) return false;
+
+ restart:
+ if (inp_desc->current_include != NULL) {
+ register include_description *inc_desc=inp_desc->current_include;
+
+ fp=inc_desc->the_file;
+ @<Get include line into buffer or |goto restart| if end of file@>@;
+ }
+ else {
+ fp=inp_desc->the_file;
+ @<Get line into buffer, |return false| if end of file@>@;
+ }
+
+ if (do_includes)
+ @<Check for \.{@@i} in newly read line, |goto restart| if
+ include fails@>@;
+ return true;
+}
+
+
+@ Lines must fit into the buffer completely.
+We read all characters sequentially until an end of line is found
+(but do not forget to check for |EOF|!).
+Too long input lines will be truncated.
+This will result in a damaged output if they occur in the
+replacement part of a change file, or in an incomplerte check if the
+matching part is concerned.
+Tab character expansion might be done here.
+@^tab character expansion@>
+
+@<Get line into buffer,...@>=
+{
+ register int c; /* the actual character read */
+ register char *k; /* where the next character goes */
+
+ if (feof(fp))
+ @<Handle end of file and return@>@;
+
+ inp_desc->limit = k = inp_desc->buffer; /* beginning of buffer */
+ while (k<=inp_desc->buffer_end && (c=getc(fp)) != EOF && c!='\n')
+ if ((*(k++) = c) != ' ') inp_desc->limit = k;
+ if (k>inp_desc->buffer_end)
+ if ((c=getc(fp))!=EOF && c!='\n') {
+ ungetc(c, fp); inp_desc->loc=inp_desc->buffer;
+ err_print(i, "! Input line too long");
+@.Input line too long@>
+ }
+ if (c==EOF && inp_desc->limit==inp_desc->buffer)
+ @<Handle end of file...@>@;
+
+ @<Increment the line number and print a progess report at
+ certain times@>@;
+}
+
+
+@ End of file is special if this file is the master file.
+Then we set the global flag variable |input_has_ended|.
+
+@<Handle end of file ...@>=
+{
+ inp_desc->mode=ignore;
+ inp_desc->limit=NULL; /* mark end-of-file */
+ if (inp_desc->type_of_file==master) input_has_ended=true;
+ fclose(fp);
+ return false;
+}
+
+
+@ This variable must be declared for global access.
+
+@<Global variables@>=
+boolean input_has_ended=false;
+
+
+@ This section does what its name says. Every 100 lines
+in the master file we print a dot, every 500 lines the number
+of lines is shown.
+
+@<Increment the line number and print ...@>=
+inp_desc->line++;
+if (inp_desc->type_of_file==master && inp_desc->line % 100==0) {
+ if (inp_desc->line % 500 == 0) printf("%ld", inp_desc->line);
+ else putchar('.');
+ fflush(stdout);
+}
+
+
+@ The following is very similar to the above, but for the case where
+we are reading from an include file.
+
+@<Get include line into buffer or |goto restart| if end of file@>=
+{
+ register int c; /* the actual character read */
+ register char *k; /* where the next character goes */
+
+ if (feof(fp))
+ @<Handle end of include file and |goto restart|@>@;
+
+ inp_desc->limit = k = inp_desc->buffer; /* beginning of buffer */
+ while (k<=inp_desc->buffer_end && (c=getc(fp)) != EOF && c!='\n')
+ if ((*(k++) = c) != ' ') inp_desc->limit = k;
+ if (k>inp_desc->buffer_end)
+ if ((c=getc(fp))!=EOF && c!='\n') {
+ ungetc(c, fp); inp_desc->loc=inp_desc->buffer;
+ err_print(i, "! Input line too long");
+@.Input line too long@>
+ }
+ if (c==EOF && inp_desc->limit==inp_desc->buffer)
+ @<Handle end of include file...@>@;
+
+ inc_desc->line++;
+}
+
+@ We don't bail out if we find the end of an include file, we just
+return to the parent file.
+
+@<Handle end of include file and |goto restart|@>=
+{
+ include_description *temp=inc_desc->parent;
+
+ fclose(fp);
+ free(inc_desc);
+ total_include_files--;
+ inp_desc->current_include=temp;
+ goto restart;
+}
+
+
+@ Usually, we have to check the line we have just read to see whether
+it begins with \.{@@i} and therefore needs expanding.
+
+@<Check for \.{@@i} in newly read line...@>=
+{
+ inp_desc->loc=inp_desc->buffer;
+ *inp_desc->limit=' ';
+ if (*inp_desc->buffer=='@@' &&
+ (inp_desc->buffer[1]=='i' || inp_desc->buffer[1]=='I')) {
+ inp_desc->loc=inp_desc->buffer+2;
+ *inp_desc->limit='"'; /* this will terminate the search in all cases */
+ while (*inp_desc->loc==' '||*inp_desc->loc=='\t')
+ inp_desc->loc++;
+ if (inp_desc->loc>=inp_desc->limit) {
+ err_print(i, "! Include file name not given");
+@.Include file name ...@>
+ goto restart;
+ }
+ if (total_include_files>=max_include_files) {
+ err_print(i, "! Too many nested includes");
+@.Too many nested includes@>
+ goto restart;
+ }
+ total_include_files++; /* push input stack */
+ @<Try to open include file, abort push if unsuccessful, go to |restart|@>;
+ }
+}
+
+
+@ When an \.{@@i} line is found in the file, we must temporarily
+stop reading it and start reading from the named include file. The
+\.{@@i} line should give a complete file name with or without
+double quotes.
+If the environment variable \.{CWEBINPUTS} is set, or if the compiler flag
+of the same name was defined at compile time,
+\.{CWEB} will look for include files in the directory thus named, if
+it cannot find them in the current directory.
+(Colon-separated paths are not supported.)
+The remainder of the \.{@@i} line after the file name is ignored.
+
+@d too_long() {total_include_files--; free(new_inc);
+ err_print(i, "! Include file name too long"); goto restart;}
+
+@<Try to open...@>=
+{
+ include_description *new_inc;
+ char temp_file_name[max_file_name_length];
+ char *file_name_end;
+ char *k, *kk;
+ int l; /* length of file name */
+
+ new_inc=(include_description *) malloc(sizeof(include_description));
+ if (new_inc==NULL)
+ fatal_error(i, "! No memory for new include descriptor", "");
+ new_inc->line=0;
+ k=new_inc->file_name;
+ file_name_end=k+max_file_name_length-1;
+
+ if (*inp_desc->loc=='"') {
+ inp_desc->loc++;
+ while (*inp_desc->loc!='"' && k<=file_name_end)
+ *k++=*inp_desc->loc++;
+ if (inp_desc->loc==inp_desc->limit)
+ k=file_name_end+1; /* unmatched quote is `too long' */
+ } else
+ while (*inp_desc->loc!=' '&&*inp_desc->loc!='\t'&&
+ *inp_desc->loc!='"'&&k<=file_name_end) *k++=*inp_desc->loc++;
+ if (k>file_name_end) too_long();
+@.Include file name ...@>
+ *k='\0';
+ if ((new_inc->the_file=fopen(new_inc->file_name, "r"))!=NULL) {
+ new_inc->parent=inp_desc->current_include; /* link it in */
+ inp_desc->current_include=new_inc;
+ goto restart; /* success */
+ }
+ kk=getenv("CWEBINPUTS");
+ if (kk!=NULL) {
+ if ((l=strlen(kk))>max_file_name_length-2) too_long();
+ strcpy(temp_file_name, kk);
+ }
+ else {
+#ifdef CWEBINPUTS
+ if ((l=strlen(CWEBINPUTS))>max_file_name_length-2) too_long();
+ strcpy(temp_file_name, CWEBINPUTS);
+#else
+ l=0;
+#endif /* |CWEBINPUTS| */
+ }
+ if (l>0) {
+ if (k+l+2>=file_name_end) too_long();
+ for (; k>= new_inc->file_name; k--) *(k+l+1)=*k;
+ strcpy(new_inc->file_name, temp_file_name);
+ new_inc->file_name[l]='/'; /* \UNIX/ pathname separator */
+ if ((new_inc->the_file=fopen(new_inc->file_name, "r"))!=NULL) {
+ new_inc->parent=inp_desc->current_include; /* link it in */
+ inp_desc->current_include=new_inc;
+ goto restart; /* success */
+ }
+ }
+ total_include_files--;
+ free(new_inc);
+ err_print(i, "! Cannot open include file");
+@.Cannot open include file@>
+ goto restart;
+}
+
+
+
+@* Reporting errors to the user.
+There may be errors if a line in a given change
+file does not match a line in the master file or a
+replacement in a previous change file. Such errors are
+reported to the user by saying
+$$
+ \hbox{|err_print(file_no, "! Error message")|;}
+$$
+where |file_no| is the number of the file which is concerned by the
+error. Please note that no trailing dot is supplied in the error
+message because it is appended by |err_print|.
+
+@<Predecl...@>=
+void err_print();
+
+@ Here is the outline of the |err_print| function.
+
+@<Error handling...@>=
+void err_print(i, s) /* prints `\..' and location of error message */
+file_index i; char *s;
+{
+ char *k, *l; /* pointers into an appropriate |buffer| */
+ fprintf(stderr, *s=='!'? "\n%s" : "%s", s);
+ if(i>=0) @<Print error location based on input buffer@>@;
+ else putc('\n', stderr);
+ fflush(stderr);
+ history=troublesome;
+}
+
+@ The error locations can be indicated by using the variables
+|loc|, |line| and |file_name| within the appropriate file description
+structures, which tell respectively the first
+unlooked-at position in the |buffer|, the current line number and the
+current file. We can determine whether we are looking at an included
+file or not by examining the |current_include| variable.
+This routine should be modified on systems whose standard text editor
+has special line-numbering conventions.
+@^system dependencies@>
+
+@<Print error location based on input buffer@>=
+{
+ register input_description *inp_desc=input_organisation[i];
+ register include_description *inc_desc=inp_desc->current_include;
+
+ if (inc_desc!=NULL) {
+ fprintf(stderr, ". (l. %ld of include file %s", inc_desc->line,
+ inc_desc->file_name);
+ fprintf(stderr, " included from l. %ld of %s file %s)\n",
+ inp_desc->line,
+ inp_desc->type_of_file==master?"master":"change",
+ inp_desc->file_name);
+ }
+ else
+ fprintf(stderr, ". (l. %ld of %s file %s)\n", inp_desc->line,
+ inp_desc->type_of_file==master?"master":"change",
+ inp_desc->file_name);
+ l=(inp_desc->loc>=inp_desc->limit? inp_desc->limit: inp_desc->loc);
+ if (l>inp_desc->buffer) {
+ for (k=inp_desc->buffer; k<l; k++)
+ if (*k=='\t') putc(' ', stderr);
+ else putc(*k, stderr); /* print the characters already read */
+ putc('\n', stderr);
+ for (k=inp_desc->buffer; k<l; k++)
+ putc(' ', stderr); /* space out the next line */
+ }
+ for (k=l; k<inp_desc->limit; k++)
+ putc(*k, stderr); /* print the part not yet read */
+ putc('\n', stderr);
+}
+
+
+@ Non recoverable errors are handled by calling |fatal_error| that
+outputs a message and then calls `|wrap_up|' and exits. |err_print|
+will print the error message followed by an indication of where the
+error was spotted in the source files. |fatal_error| cannot state any
+files because the problem is usually to access these.
+
+@d fatal_error(i, s, t) {
+ fprintf(stderr, "\n%s", s);
+ err_print(i, t);
+ history=fatal;
+ exit(wrap_up());
+ }
+
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here, for instance, we pass the operating system
+a status of~0 if and only if only harmless messages were printed.
+@^system dependencies@>
+
+@<Internal func...@>=
+int wrap_up()
+{
+ @<Print the job |history|@>;
+ if (history > spotless) return 1;
+ else return 0;
+}
+
+@ Always good to prototype.
+
+@<Predecl...@>=
+int wrap_up();
+
+@ We report the history to the user, although this may not
+be ``\UNIX/'' style---but we are in good company: \.{WEB} and
+\TEX/ do the same. We put this on |stdout| rather than |stderr|, so
+that users can easily filter this away if they wish.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+switch (history) {
+ case spotless:
+ printf("\n(No errors were found.)\n"); break;
+ case troublesome:
+ printf("\n(Pardon me, but I think I spotted something wrong.)\n"); break;
+ case fatal: printf("(That was a fatal error, my friend.)\n");
+} /* there are no other cases */
+
+
+@ If there's a system error, we may be able to give the user more
+information with the |pfatal_error| function. This prints out system
+error information if it is available.
+
+@<Predecl...@>=
+void pfatal_error();
+
+@ @<Error handling...@>=
+void pfatal_error(s, t)
+char *s, *t;
+{
+ char *strerr=strerror(errno);
+
+ fprintf(stderr, "\n%s%s", s, t);
+ if (strerr) fprintf(stderr, " (%s)\n", strerr);
+ else fprintf(stderr, "\n");
+ history=fatal;
+ exit(wrap_up());
+}
+
+
+@ We need an include file for the above.
+
+@<Global \&{\#include}s@>=
+#include <errno.h>
+
+
+@* Handling multiple change files.
+In the standard version we take the name of the
+files from the command line.
+It is assumed that filenames can be used as given in the
+command line without changes.
+
+First there are some sections to open all files.
+If a file is not accessible, the run will be aborted.
+Otherwise the name of the open file will be displayed.
+
+@<Prepare the output file@>=
+{
+ out_file=fopen(out_name, "w");
+ if (out_file==NULL) {
+ pfatal_error("! Cannot open/create output file", "");
+@.Cannot open/create output file@>
+ }
+}
+
+
+@ The name of the file and the file desciptor are stored in
+global variables.
+
+@<Global variables@>=
+FILE *out_file;
+string out_name;
+
+
+@ For the master file we start by reading its first line into the
+buffer, if we could open it.
+
+@<Get the master file started@>=
+{
+ input_organisation[0]->the_file=
+ fopen(input_organisation[0]->file_name, "r");
+
+ if (input_organisation[0]->the_file==NULL)
+ pfatal_error("! Cannot open master file ",
+ input_organisation[0]->file_name);
+@.Cannot open master file@>
+ printf("(%s)\n", input_organisation[0]->file_name);
+ input_organisation[0]->type_of_file=master;
+ get_line(0, true);
+}
+
+
+@ For the change files we must skip any comment part and see whether
+there are any changes in it. This is done by |init_change_file|.
+
+@<Prepare the change files@>=
+{
+ file_index i;
+
+ i=1;
+ while (i<no_ch) {
+ input_organisation[i]->the_file=
+ fopen(input_organisation[i]->file_name, "r");
+ if (input_organisation[i]->the_file==NULL)
+ pfatal_error("! Cannot open change file ",
+ input_organisation[i]->file_name);
+@.Cannot open change file@>
+ printf("(%s)\n", input_organisation[i]->file_name);
+ init_change_file(i);
+ i++;
+ }
+}
+
+
+@*Input/output organisation.
+Here's a simple function that checks if two lines
+are different.
+
+@<Internal functions@>=
+boolean lines_dont_match(i, j)
+ file_index i, j;
+{
+ register input_description *iptr=input_organisation[i],
+ *jptr=input_organisation[j];
+
+ if (iptr->limit-iptr->buffer != jptr->limit-jptr->buffer)
+ return true;
+ return strncmp(iptr->buffer, jptr->buffer, iptr->limit-iptr->buffer);
+}
+
+
+@ Function |init_change_file(i)| is used to ignore all
+lines of the input file with index~|i| until the next change
+module is found.
+
+@<Internal functions@>=
+void init_change_file(i)
+ file_index i;
+{
+ register input_description *inp_desc=input_organisation[i];
+ char ccode;
+
+ inp_desc->limit=inp_desc->buffer;
+ @<Skip over comment lines; |return| if end of file@>@;
+ @<Skip to the next nonblank line; |return| if end of file@>@;
+ inp_desc->dont_match=0;
+}
+
+
+@ While looking for a line that begins with \.{@@x} in the change
+file, we allow lines that begin with \.{@@}, as long as they don't
+begin with \.{@@y}, \.{@@z} or \.{@@i} (which would probably mean that
+the change file is fouled up).
+
+@<Skip over comment lines...@>=
+while(1) {
+ if (!get_line(i, false)) return; /* end of file reached */
+ if (inp_desc->limit<inp_desc->buffer+2) continue;
+ if (inp_desc->buffer[0]!='@@') continue;
+ ccode=inp_desc->buffer[1];
+ if (xisupper(ccode)) ccode=tolower(ccode);
+ if (ccode=='x') break;
+ if (ccode=='y' || ccode=='z' || ccode=='i') {
+ inp_desc->loc=inp_desc->buffer+2;
+ err_print(i, "! Missing @@x in change file");
+@.Missing @@x...@>
+ }
+}
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+do {
+ if (!get_line(i, true)) {
+ err_print(i, "! Change file ended after @@x");
+@.Change file ended...@>
+ return;
+ }
+} while (inp_desc->limit==inp_desc->buffer);
+
+
+@ The |put_line| function is used to write a line from
+input buffer |j| to the output file.
+
+@<Internal functions@>=
+void put_line(j)
+ file_index j;
+{
+ char *ptr=input_organisation[j]->buffer;
+ char *lmt=input_organisation[j]->limit;
+
+ while(ptr<lmt) putc(*ptr++, out_file);
+ putc('\n', out_file);
+}
+
+
+@ The function |e_of_ch_module| returns true if the input
+line from file |i| starts with \.{@@z}.
+
+@<Internal functions@>=
+boolean e_of_ch_module(i)
+ file_index i;
+{
+ register input_description *inp_desc=input_organisation[i];
+
+ if (inp_desc->limit==NULL) {
+ err_print(i, "! Change file ended without @@z");
+@.Change file ended without @@z@>
+ return true;
+ } else if (inp_desc->limit>=inp_desc->buffer+2)
+ if (inp_desc->buffer[0]=='@@' &&
+ (inp_desc->buffer[1]=='Z' || inp_desc->buffer[1]=='z'))
+ return true;
+ return false;
+}
+
+
+@ The function |e_of_ch_preamble| returns |true| if the input
+line from file~|i| starts with \.{@@y}.
+
+@<Internal functions@>=
+boolean e_of_ch_preamble(i)
+ file_index i;
+{
+ register input_description *inp_desc=input_organisation[i];
+
+ if (inp_desc->limit>=inp_desc->buffer+2 && inp_desc->buffer[0]=='@@')
+ if (inp_desc->buffer[1]=='Y'||inp_desc->buffer[1]=='y') {
+ if (inp_desc->dont_match>0) {
+ inp_desc->loc=inp_desc->buffer+2;
+ fprintf(stderr, "\n! Hmm... %d ", inp_desc->dont_match);
+ err_print(i, "of the preceding lines failed to match");
+ }
+ return true;
+ }
+ return false;
+}
+
+
+
+@ To process the input file the next section reads a line of the
+current (actual) input file and updates the |input_organisation| for
+all files with index greater than |actual_input|.
+
+@<Process a line, |break| when end of source reached@>=
+{
+ file_index test_file;
+
+ @<Check the current files for any ends of changes@>@;
+ if (input_has_ended && actual_input==0) break; /* all done */
+ @<Scan all other files for changes to be done@>@;
+ @<Handle output@>@;
+ @<Step to next line@>@;
+}
+
+
+@ Any of the current change files may have reached the end of the
+current change. In such a case, intermediate lines must be skipped
+and the next start of change is to be found. This may make a change
+file become inactive if the end of the file is reached.
+
+@<Check the...@>=
+{
+ register input_description *inp_desc;
+ while (actual_input>0 && e_of_ch_module(actual_input)) {
+ inp_desc=input_organisation[actual_input];
+ if (inp_desc->type_of_file==master) {
+ /* emergency exit, everything mixed up!*/
+ fatal_error(-1, "! This can't happen: change file is master file", "");
+@.This can't happen...@>
+ }
+ inp_desc->mode=search;
+ init_change_file(actual_input);
+ while ((input_organisation[actual_input]->mode!=reading
+ && actual_input>0))
+ actual_input--;
+ }
+}
+
+
+@ Now we will set |test_input| to the first change file that is being
+tested against the current line. If no other file is testing, then
+|actual_input| refers to a line to write and |test_input| is set to
+|none|.
+
+@d none (-1)
+
+@<Scan all other files...@>=
+test_input=none;
+test_file=actual_input;
+while (test_input==none && test_file<no_ch-1){
+ test_file++;
+ switch (input_organisation[test_file]->mode) {
+ case search:
+ if (lines_dont_match(actual_input, test_file)==false) {
+ input_organisation[test_file]->mode=test;
+ test_input=test_file;
+ }
+ break;
+ case test:
+ if (lines_dont_match(actual_input, test_file)) {
+ /* error, sections do not match; just note at this point */
+ input_organisation[test_file]->dont_match++;
+ }
+ test_input=test_file;
+ break;
+ case reading: /* this can't happen */
+ break;
+ case ignore: /* nothing to do */
+ break;
+ }
+}
+
+
+@ For the output we must distinguish between whether we are creating a
+new change file or a new master file. Change file creation requires
+closer inspection because we may be before a change, in the pattern
+(match) part or in the replacement part. For master file creation, we
+simply have to write the line from the current (actual) input.
+
+@<Handle output@>=
+if (prod_chf==chf) {
+ while(1) {
+ @<Test for |normal|, |break| when done@>@;
+ @<Test for |pre|, |break| when done@>@;
+ @<Test for |post|, |break| when done@>@;
+ }
+} else
+ if (test_input==none) put_line(actual_input);
+
+
+@ Check whether we have to start a change file entry.
+Without a match nothing needs to be done.
+
+@<Test for |normal|...@>=
+if (out_mode==normal) {
+ if (test_input!=none) {
+ fprintf(out_file, "@@x\n");
+ out_mode=pre;
+ } else break;
+}
+
+
+@ Check whether we have to start the replacement text. This is the
+case when we are in |pre| mode but have no more matching lines.
+Otherwise the master file source line must be copied to the change
+file.
+
+@<Test for |pre|...@>=
+if (out_mode==pre) {
+ if (test_input==none) {
+ fprintf(out_file, "@@y\n");
+ out_mode=post;
+ } else {
+ if (input_organisation[actual_input]->type_of_file==master)
+ put_line(actual_input);
+ break;
+ }
+}
+
+
+@ Check whether an entry from a change file is complete. If the
+current input is from a change file which is not being tested against
+a later change file, then this change file line must be written. If
+the actual input has been reset to the master file, we can finish this
+change.
+
+@<Test for |post|...@>=
+if (out_mode==post) {
+ if (input_organisation[actual_input]->type_of_file==chf) {
+ if (test_input==none) put_line(actual_input);
+ break;
+ } else {
+ fprintf(out_file, "@@z\n\n");
+ out_mode=normal;
+ }
+}
+
+
+@ If we had a change, we must proceed in the actual file
+to be changed and in the change file in effect.
+
+@<Step to next line@>=
+get_line(actual_input, true);
+if (test_input!=none) {
+ get_line(test_input, true);
+ if (e_of_ch_preamble(test_input)==true) {
+ get_line(test_input, true); /* update current changing file */
+ input_organisation[test_input]->mode=reading;
+ actual_input=test_input;
+ test_input=none;
+ }
+}
+
+
+@ To create the new output file we have to scan the whole
+master file and all changes in effect when it ends.
+At the very end it is wise to check for all changes
+to have completed, in case the last line of the master file
+was to be changed.
+
+@<Process the input@>=
+actual_input=0;
+input_has_ended=false;
+while (input_has_ended==false||actual_input!=0)
+ @<Process a line...@>@;
+if (out_mode==post) /* last line has been changed */
+ fprintf(out_file, "@@z\n");
+
+
+@ At the end of the program, we will tell the user if the
+change file had a line that didn't match any relevant line
+in the master file or any of the change files.
+
+@<Check that all changes have been read@>=
+{
+ file_index i;
+
+ for (i=1;i<no_ch;i++) { /* all change files */
+ if (input_organisation[i]->mode!=ignore) {
+ input_organisation[i]->loc=input_organisation[i]->buffer;
+ err_print(i, "! Change file entry did not match");
+@.Change file entry ...@>
+ }
+ }
+}
+
+
+@ We want to tell the user about our command line options if they made
+a mistake. This is done by the |usage_error()| function. It contains
+merely the necessary print statements and exits afterwards.
+
+@<Intern...@>=
+void usage_error()
+{
+ @<Print the banners@>;
+ fprintf(stderr, "Usage: ctie -[mc] outfile master changefile(s)\n");
+ fprintf(stderr, "Type ctie --help for more information\n");
+ exit(1);
+}
+
+
+@ Printing our welcome banners; we only do this if we are not asked
+for version or help information.
+
+@<Print the banners@>=
+printf("%s\n", banner); /* print a ``banner line'' */
+printf("%s\n", copyright); /* include the copyright notice */
+
+
+@ We must scan through the list of parameters, given in |argv|. The
+number is in |argc|. We must pay attention to the flag parameter. We
+need at least 3~parameters (\.{-m} or \.{-c}, an output file and a
+master file) and can handle up to |max_file_index| change files. The
+names of the file parameters will be inserted into the structure of
+|input_organisation|. The first file is special. It indicates the
+output file. When we allow flags at any position, we must find out
+which name is for what purpose. The master file is already part of
+the |input_organisation| structure (index~0). As long as the number
+of files found (counted in |no_ch|) is |-1| we have not yet found the
+output file name.
+
+@<Scan the parameters@>=
+{
+ if (argc>max_file_index+5-1) usage_error();
+ no_ch = -1; /* fill this part of |input_organisation| */
+ while (--argc>0) {
+ argv++;
+ if (strcmp("-help", *argv)==0 || strcmp("--help", *argv)==0)
+ @<Display help message and exit@>;
+ if (strcmp("-version", *argv)==0 || strcmp("--version", *argv)==0)
+ @<Display version information and exit@>;
+ if (**argv=='-') @<Set a flag@>@;
+ else @<Get a file name@>@;
+ }
+ if (no_ch<=0|| prod_chf==unknown) usage_error();
+}
+
+
+@ The flag is about to determine the processing mode.
+We must make sure that this flag has not been set before.
+Further flags might be introduced to avoid/force overwriting of
+output files.
+Currently we just have to set the processing flag properly.
+
+@<Set a flag@>=
+if (prod_chf!=unknown) usage_error();
+else
+ switch (*(*argv+1)) {
+ case 'c': case 'C': prod_chf=chf; break;
+ case 'm': case 'M': prod_chf=master; break;
+ default: usage_error();
+ }
+
+
+@ We have to distinguish whether this is the very first file name
+(which is the case if |no_ch==(-1)|) or if the next element of
+|input_organisation| must be filled.
+
+@<Get a file name@>=
+{
+ if (no_ch==(-1)) {
+ out_name=*argv;
+ } else {
+ register input_description *inp_desc;
+
+ inp_desc=(input_description *) malloc(sizeof(input_description));
+ if (inp_desc==NULL)
+ fatal_error(-1, "! No memory for input descriptor", "");
+@.No memory for descriptor@>
+ inp_desc->mode=search;
+ inp_desc->line=0;
+ inp_desc->type_of_file=chf;
+ inp_desc->limit=inp_desc->buffer;
+ inp_desc->buffer[0]=' ';
+ inp_desc->loc=inp_desc->buffer+1;
+ inp_desc->buffer_end=inp_desc->buffer+buf_size-2;
+ inp_desc->file_name=*argv;
+ inp_desc->current_include=NULL;
+ input_organisation[no_ch]=inp_desc;
+ }
+ no_ch++;
+}
+
+
+@ Modules for dealing with help messages and version info. We follow
+the \.{kpathsea} standard code here, so that we can easily adapt this
+to work with \.{kpathsea}.
+
+@<Display help message and exit@>=
+usage_help();
+@.--help@>
+
+
+@
+@<Display version information and exit@>=
+{
+ print_version_and_exit("CTIE", version_number);
+@.--version@>
+}
+
+
+@ Here is the usage information for \.{--help}.
+
+@<Global variables@>=
+string CTIEHELP[] = {
+ "Usage: ctie -[mc] outfile master changefile(s)",
+ " Create a new master file or change file from the given",
+ " master (C)WEB file and changefiles.",
+ " All filenames are taken literally; no suffixes are added.",
+ "",
+ "-m create a new master file from original (C)WEB and change file(s)",
+ "-c create a master change file for original (C)WEB file from changefile(s)",
+ "--help display this help and exit",
+ "--version display version information and exit",
+ NULL
+};
+
+
+@ @<Predec...@>=
+void usage_help();
+void print_version_and_exit();
+
+
+@ @c
+void usage_help()
+{
+ string *message=CTIEHELP;
+
+ while (*message) {
+ fputs(*message, stdout);
+ putchar('\n');
+ ++message;
+ }
+ putchar('\n');
+ exit(0);
+}
+
+
+@ @c
+void print_version_and_exit(name, version)
+ string name, version;
+{
+ printf ("%s %s\n", name, version);
+
+ puts ("Copyright (C) 2002,2003 Julian Gilbey.");
+
+ puts ("There is NO warranty. This is free software. See the source");
+ puts ("code of CTIE for redistribution conditions.");
+
+ exit (0);
+}
+
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by
+changes to the program that are necessary to make \.{CTIE}
+work at a particular installation. It is usually best to
+design your change file so that all changes to previous
+modules preserve the module numbering; then everybody's
+version will be consistent with the printed program. More
+extensive changes, which introduce new modules, can be
+inserted here; then only the index itself will get a new
+module number.
+@^system dependencies@>
+
+
+@* Index.
diff --git a/Build/source/texk/web2c/ctiedir/ctiedoc.tex b/Build/source/texk/web2c/ctiedir/ctiedoc.tex
new file mode 100644
index 00000000000..972bfff44d4
--- /dev/null
+++ b/Build/source/texk/web2c/ctiedir/ctiedoc.tex
@@ -0,0 +1,242 @@
+% ctiedoc.tex Jan 2002, last updated Apr 2003
+%-----------------------------------------------
+
+% A minor rewrite of tiedoc.tex for the CTIE changes.
+
+
+\documentclass{article}
+
+\let\mc=\small
+\def\CEE/{{\mc C\spacefactor1000}}
+\let\.=\texttt
+
+\begin{document}
+
+\begin{center}
+\Large The \.{CTIE} Processor
+
+\bigskip
+\large
+Julian Gilbey\\
+\.{jdg@debian.org}
+
+\bigskip
+Based on the original \.{TIE} documentation by:\\
+Klaus Guntermann\\
+TH Darmstadt\\
+Fachbereich Informatik\\
+Institut f\"ur Theoretische Informatik
+
+\bigskip
+January 2002, updated April 2003
+
+\end{center}
+
+\bigskip
+
+\section{Introduction}
+
+When installing a program on a particular computer system, certain
+system dependent changes are often needed. The original \.{WEB}
+programs (\.{WEAVE} and \.{TANGLE}) handled this problem by using
+\textit{change files}, which work very much like a patch file and are
+read by \.{WEAVE} and \.{TANGLE} along with the main \.{WEB} file.
+This allows the original \.{WEB} file to remain intact and the
+particular system dependencies to be isolated.
+
+Sometimes it is good practice to develop a set of multiple change
+files for a given \.{WEB} file to distinguish between different
+changes such as program enhancements, bug fixes, system dependent
+changes and output device dependent modifications. Additionally this
+allows combinations of changes that can be used with a set of programs
+that share some common features, such as \.{WEAVE} and \.{TANGLE}
+themselves.
+
+Unfortunately, the processors \.{TANGLE} and \.{WEAVE} can handle only
+one change file. Rather than modifying these processors to handle
+multiple change files, it is easier to combine them in a preprocessing
+step. The \.{TIE} processor was written to perform this task. It is
+able to create either a new master file or a single change file that
+comprises the effect of all change files.
+
+The \.{CWEB} system was later developed in order to open up the
+\.{WEB} system of literate programming to \CEE/ programmers. It
+functions in an essentially identical way to the original Pascal
+\.{WEB} system, and the syntax of change files is the same. So it
+should be possible to use the \.{TIE} processor for \.{CWEB} source
+files. However, one significant enhancement was made to \.{CWEB}
+which makes this sometimes impossible. \.{CWEB} supports
+\textit{include files}, which are introduced by a line beginning
+`\.{@i} \textit{filename}', which includes the \.{CWEB} file
+specified, just like the \CEE/ preprocessor command \.{\#include}. As
+these include commands are effectively expanded before the change file
+is applied, both in the master file and the change file, it is clear
+that \.{TIE} needs to interpret \.{@i} commands in order to work for
+all \.{CWEB} files. Thus \.{CTIE} was born: it essentially combines
+the traditional behaviour of \.{TIE} with the ability to handle
+\.{CWEB} include files.
+
+
+\section{Application}
+
+The current version of \.{CTIE} accepts a master file and up to
+32~change files. In general it is important to use the change files
+in the correct sequence, as later change files may modify the results
+of applying earlier changes. Thus the order of the change files on
+the command line is taken to specify the order in which the change
+files should be applied. Conceptually, each change file is applied to
+the master file in turn to create a new master file, to which the next
+change file is applied; in practice, though, a more space-efficient
+algorithm is used which only requires storage space for one line per
+file, so the lengths of the individual files or changes are irrelevant
+for storage requirements.
+
+Note that \.{CTIE} will expand all \.{@i} include lines, including the
+specified files whether or not they are modified by any change files.
+So another application of \.{CTIE} is to simply expand all of these
+include files, producing an expanded master file. (Thanks to Hartmut
+Henkel \.{<hartmut\_henkel@gmx.de>} for this observation.)
+
+\.{CTIE} must be called with at least 3~parameters as follows:
+$$\texttt{ctie -[cm] outfile master changefile(s)}$$
+where the parameters are (in order):
+\begin{enumerate}
+
+\item Either the option \.{-c} or \.{-m}. This option determines
+ whether an amalgamated change file or a new master file is created.
+
+\item The name of the output file.
+
+\item The name of the master file.
+
+\item The name(s) of the change file(s), if any.
+
+\end{enumerate}
+
+Unlike the \.{CWEB} programs \.{CWEAVE} and \.{CTANGLE}, no attempt to
+add default suffixes such as \.{.w} or \.{.ch} is made; the filenames
+must be the full filenames. If \.{CTIE} has been compiled with
+\.{kpathsea} support, then the \.{kpathsea} library will be used to
+search for the files using the \.{CWEBINPUTS} variable, otherwise just
+the current directory and the directory specified by the
+\.{CWEBINPUTS} environment variable will be searched, in that order.
+
+Also, \.{CTIE} can be called with the single argument \.{--help} or
+\.{--version} to get basic help or version information.
+
+\clearpage
+
+
+\def\eof{$\langle$\textrm{\mc EOF}$\rangle$}
+\tabcolsep=1em
+\parindent=0pt
+
+\section{Example}
+
+To illustrate the actions \.{CTIE} performs you may inspect the
+following example that exercises some of the borderline cases.
+
+\begin{center}
+\ttfamily
+\begin{tabular}{llll}
+\multicolumn1{c}{\textbf{\textrm{ctie.tie}}}&
+ \multicolumn1{c}{\textbf{\textrm{ctie.cf1}}}&
+ \multicolumn1{c}{\textbf{\textrm{ctie.cf2}}}&
+ \multicolumn1{c}{\textbf{\textrm{ctie.cf3}}}\\[1pt]
+\hline
+line 1 &@x &@x &@x\\
+line 2 &line 2 &line 1 &changed line 4\\
+line 3 &line 3 &changed line 2 &@y\\
+line 4 &@y &changed line 3 &final line 4\\
+line 5 &changed line 2 &inserted line &@z\\
+@i ctie.inc &changed line 3 &line 4\\
+line 6 &inserted line &@y &@x\\
+line 7 &@z &final line 2 &changed inc line 1\\
+line 8 & &final line 3 &inserted inc line\\
+line 9 &@x &changed line 4 &@y\\
+line 10 &line 7 &@z &final inc line 1\\
+\eof &@y & &@i "ctie.inc2"\\
+ &changed line 7 &@x &@z\\
+ &@z &inc line 1 &\eof\\
+ &\eof &@y\\
+ & &changed inc line 1\\
+ & &inserted inc line\\
+ & &@z\\
+ & &\\
+ & &@x\\
+ & &changed line 7\\
+ & &line 8\\
+ & &@y\\
+ & &final line 7\\
+ & &final line 8\\
+ & &@z\\
+ & &\eof\\
+\end{tabular}
+\end{center}
+
+The included files are as follows:
+
+\begin{center}
+\ttfamily
+\begin{tabular}{lll}
+\multicolumn1{c}{\textbf{\textrm{ctie.inc}}}&
+ \multicolumn1{c}{\textbf{\textrm{ctie.inc1}}}&
+ \multicolumn1{c}{\textbf{\textrm{ctie.inc2}}}\\[1pt]
+\hline
+inc line 1 &included inc line &final inserted inc line\\
+inc line 2 &\eof &\eof\\
+@i ctie.inc1\\
+inc line 3\\
+\eof\\
+\end{tabular}
+\end{center}
+
+\clearpage
+
+Using these input files and running \.{CTIE} with the following
+commands to create a new master file and a new change file will result
+in the following output files.
+
+\begin{tabbing}
+ \quad For the master file:\qquad\=\texttt{ctie -m ctie.outm ctie.cf1
+ ctie.cf2 ctie.cf3}\\
+ \quad For the change file:\>\texttt{ctie -c ctie.outc ctie.cf1
+ ctie.cf2 ctie.cf3}
+\end{tabbing}
+
+\begin{center}
+\ttfamily
+\begin{tabular}{ll}
+\multicolumn1{c}{\textbf{\textrm{ctie.outm}}}&
+ \multicolumn1{c}{\textbf{\textrm{ctie.outc}}}\\[1pt]
+\hline
+final line 2 &@x\\
+final line 3 &line 1\\
+final line 4 &line 2\\
+line 5 &line 3\\
+final inc line 1 &line 4\\
+final inserted inc line &@y\\
+inc line 2 &final line 2\\
+included inc line &final line 3\\
+inc line 3 &final line 4\\
+line 6 &@z\\
+final line 7 &\\
+final line 8 &@x\\
+line 9 &inc line 1\\
+line 10 &@y\\
+ &final inc line 1\\
+ &final inserted inc line\\
+ &@z\\
+ &\\
+ &@x\\
+ &line 7\\
+ &line 8\\
+ &@y\\
+ &final line 7\\
+ &final line 8\\
+ &@z\\
+\end{tabular}
+\end{center}
+
+
+\end{document}
diff --git a/Build/source/texk/web2c/cwebboot.c b/Build/source/texk/web2c/cwebboot.c
new file mode 100644
index 00000000000..1514ba76f72
--- /dev/null
+++ b/Build/source/texk/web2c/cwebboot.c
@@ -0,0 +1,1345 @@
+/*1:*/
+#line 58 "./cwebdir/common.w"
+
+/*5:*/
+#line 102 "./cwebdir/common.w"
+
+#include <ctype.h>
+
+/*:5*//*8:*/
+#line 165 "./cwebdir/common.w"
+
+#include <stdio.h>
+
+/*:8*//*22:*/
+#line 471 "./cwebdir/common.w"
+
+#line 151 "./cwebdir/comm-w2c.ch"
+#include <stdlib.h>
+#define CWEB
+#include "cpascal.h"
+#include <kpathsea/kpathsea.h>
+#include "help.h"
+
+/*:22*/
+#line 59 "./cwebdir/common.w"
+
+#define ctangle 0
+#define cweave 1 \
+
+#define and_and 04
+#define lt_lt 020
+#define gt_gt 021
+#define plus_plus 013
+#define minus_minus 01
+#define minus_gt 031
+#define not_eq 032
+#define lt_eq 034
+#define gt_eq 035
+#define eq_eq 036
+#define or_or 037
+#define dot_dot_dot 016
+#define colon_colon 06
+#define period_ast 026
+#define minus_gt_ast 027 \
+
+#define buf_size 100
+#define longest_name 1000
+#define long_buf_size (buf_size+longest_name)
+#define xisspace(c) (isspace(c) &&((unsigned char) c<0200) )
+#define xisupper(c) (isupper(c) &&((unsigned char) c<0200) ) \
+
+#define max_include_depth 10 \
+
+#define max_file_name_length 1024
+#define cur_file file[include_depth]
+#define cur_file_name file_name[include_depth]
+#define cur_line line[include_depth]
+#define web_file file[0]
+#define web_file_name file_name[0] \
+
+#define lines_dont_match (change_limit-change_buffer!=limit-buffer|| \
+strncmp(buffer,change_buffer,limit-buffer) ) \
+
+#define if_section_start_make_pending(b) {*limit= '!'; \
+for(loc= buffer;xisspace(*loc) ;loc++) ; \
+*limit= ' '; \
+if(*loc=='@'&&(xisspace(*(loc+1) ) ||*(loc+1) =='*') ) change_pending= b; \
+} \
+
+#define max_sections 2000 \
+ \
+
+#define too_long() {include_depth--; \
+err_print("! Include file name too long") ;goto restart;} \
+
+#define kpse_find_cweb(name) kpse_find_file(name,kpse_cweb_format,true) \
+
+#define max_bytes 90000 \
+
+#define max_names 4000 \
+ \
+
+#define length(c) (c+1) ->byte_start-(c) ->byte_start
+#define print_id(c) term_write((c) ->byte_start,length((c) ) ) \
+
+#define hash_size 353 \
+
+#define llink link
+#define rlink dummy.Rlink
+#define root name_dir->rlink \
+ \
+
+#define first_chunk(p) ((p) ->byte_start+2)
+#define prefix_length(p) (int) ((unsigned char) *((p) ->byte_start) *256+ \
+(unsigned char) *((p) ->byte_start+1) )
+#define set_prefix_length(p,m) (*((p) ->byte_start) = (m) /256, \
+*((p) ->byte_start+1) = (m) %256) \
+
+#define less 0
+#define equal 1
+#define greater 2
+#define prefix 3
+#define extension 4 \
+
+#define bad_extension 5 \
+
+#define spotless 0
+#define harmless_message 1
+#define error_message 2
+#define fatal_message 3
+#define mark_harmless {if(history==spotless) history= harmless_message;}
+#define mark_error history= error_message \
+
+#define confusion(s) fatal("! This can't happen: ",s) \
+ \
+
+#define show_banner flags['b']
+#define show_progress flags['p']
+#define show_stats flags['s']
+#define show_happiness flags['h']
+#define show_kpathsea_debug flags['d'] \
+ \
+
+#define update_terminal fflush(stdout) \
+
+#define new_line putchar('\n')
+#define putxchar putchar
+#define term_write(a,b) fflush(stdout) ,fwrite(a,sizeof(char) ,b,stdout)
+#define C_printf(c,a) fprintf(C_file,c,a)
+#define C_putc(c) putc(c,C_file) \
+ \
+
+#define ctangle_banner "This is CTANGLE, Version 3.64"
+#define cweave_banner "This is CWEAVE, Version 3.64" \
+
+
+#line 60 "./cwebdir/common.w"
+
+/*2:*/
+#line 73 "./cwebdir/common.w"
+
+#line 75 "./cwebdir/common.w"
+boolean program;
+
+/*:2*//*7:*/
+#line 159 "./cwebdir/common.w"
+
+char buffer[long_buf_size];
+char*buffer_end= buffer+buf_size-2;
+char*limit= buffer;
+char*loc= buffer;
+
+/*:7*//*10:*/
+#line 214 "./cwebdir/common.w"
+
+int include_depth;
+FILE*file[max_include_depth];
+FILE*change_file;
+char file_name[max_include_depth][max_file_name_length];
+
+char change_file_name[max_file_name_length];
+#line 222 "./cwebdir/common.w"
+int line[max_include_depth];
+int change_line;
+int change_depth;
+boolean input_has_ended;
+boolean changing;
+boolean web_file_open= 0;
+
+/*:10*//*20:*/
+#line 418 "./cwebdir/common.w"
+
+typedef unsigned short sixteen_bits;
+sixteen_bits section_count;
+boolean changed_section[max_sections];
+boolean change_pending;
+
+boolean print_where= 0;
+
+/*:20*//*29:*/
+#line 594 "./cwebdir/common.w"
+
+typedef struct name_info{
+char*byte_start;
+/*33:*/
+#line 631 "./cwebdir/common.w"
+
+struct name_info*link;
+
+/*:33*//*42:*/
+#line 730 "./cwebdir/common.w"
+
+union{
+struct name_info*Rlink;
+
+char Ilk;
+}dummy;
+
+/*:42*//*57:*/
+#line 1062 "./cwebdir/common.w"
+
+char*equiv_or_xref;
+
+/*:57*/
+#line 597 "./cwebdir/common.w"
+
+}name_info;
+typedef name_info*name_pointer;
+char byte_mem[max_bytes];
+char*byte_mem_end= byte_mem+max_bytes-1;
+name_info name_dir[max_names];
+name_pointer name_dir_end= name_dir+max_names-1;
+
+/*:29*//*31:*/
+#line 617 "./cwebdir/common.w"
+
+name_pointer name_ptr;
+char*byte_ptr;
+
+/*:31*//*34:*/
+#line 644 "./cwebdir/common.w"
+
+typedef name_pointer*hash_pointer;
+name_pointer hash[hash_size];
+hash_pointer hash_end= hash+hash_size-1;
+hash_pointer h;
+
+/*:34*//*58:*/
+#line 1082 "./cwebdir/common.w"
+
+int history= spotless;
+
+/*:58*//*69:*/
+#line 1220 "./cwebdir/common.w"
+
+int argc;
+char**argv;
+char C_file_name[max_file_name_length];
+char tex_file_name[max_file_name_length];
+char idx_file_name[max_file_name_length];
+char scn_file_name[max_file_name_length];
+boolean flags[128];
+
+/*:69*//*79:*/
+#line 1370 "./cwebdir/common.w"
+
+FILE*C_file;
+FILE*tex_file;
+FILE*idx_file;
+FILE*scn_file;
+#line 576 "./cwebdir/comm-w2c.ch"
+FILE*active_file;
+char*found_filename;
+#line 1376 "./cwebdir/common.w"
+
+/*:79*/
+#line 61 "./cwebdir/common.w"
+
+/*3:*/
+#line 83 "./cwebdir/common.w"
+int phase;
+
+/*:3*//*11:*/
+#line 240 "./cwebdir/common.w"
+
+char change_buffer[buf_size];
+char*change_limit;
+
+/*:11*/
+#line 62 "./cwebdir/common.w"
+
+/*35:*/
+#line 650 "./cwebdir/common.w"
+
+#line 260 "./cwebdir/comm-w2c.ch"
+extern int names_match P4H(name_pointer,char*,int,char);
+#line 652 "./cwebdir/common.w"
+
+/*:35*//*40:*/
+#line 703 "./cwebdir/common.w"
+
+#line 280 "./cwebdir/comm-w2c.ch"
+extern void init_p P2C(name_pointer,p,char,t);
+#line 705 "./cwebdir/common.w"
+
+/*:40*//*48:*/
+#line 852 "./cwebdir/common.w"
+
+#line 327 "./cwebdir/comm-w2c.ch"
+extern void init_node P1C(name_pointer,node);
+#line 854 "./cwebdir/common.w"
+
+/*:48*//*55:*/
+#line 1017 "./cwebdir/common.w"
+
+#line 373 "./cwebdir/comm-w2c.ch"
+int section_name_cmp P3H(char**,int,name_pointer);
+#line 1019 "./cwebdir/common.w"
+
+/*:55*//*59:*/
+#line 1092 "./cwebdir/common.w"
+
+#line 392 "./cwebdir/comm-w2c.ch"
+void err_print P1H(char*);
+#line 1094 "./cwebdir/common.w"
+
+/*:59*//*62:*/
+#line 1140 "./cwebdir/common.w"
+
+#line 410 "./cwebdir/comm-w2c.ch"
+int wrap_up P1H(void);
+extern void print_stats P1H(void);
+#line 1143 "./cwebdir/common.w"
+
+/*:62*//*65:*/
+#line 1173 "./cwebdir/common.w"
+
+#line 427 "./cwebdir/comm-w2c.ch"
+void fatal P2H(char*,char*);
+void overflow(char*);
+#line 1175 "./cwebdir/common.w"
+
+/*:65*//*71:*/
+#line 1251 "./cwebdir/common.w"
+
+#line 495 "./cwebdir/comm-w2c.ch"
+void scan_args P1H(void);
+#line 1253 "./cwebdir/common.w"
+
+/*:71*/
+#line 63 "./cwebdir/common.w"
+
+
+/*:1*//*4:*/
+#line 89 "./cwebdir/common.w"
+
+void
+#line 51 "./cwebdir/comm-w2c.ch"
+ common_init P1H(void)
+#line 92 "./cwebdir/common.w"
+{
+#line 57 "./cwebdir/comm-w2c.ch"
+/*32:*/
+#line 621 "./cwebdir/common.w"
+
+name_dir->byte_start= byte_ptr= byte_mem;
+name_ptr= name_dir+1;
+name_ptr->byte_start= byte_mem;
+
+/*:32*//*36:*/
+#line 655 "./cwebdir/common.w"
+
+for(h= hash;h<=hash_end;*h++= NULL);
+
+/*:36*//*43:*/
+#line 737 "./cwebdir/common.w"
+
+root= NULL;
+
+/*:43*/
+#line 57 "./cwebdir/comm-w2c.ch"
+;
+/*24:*/
+#line 188 "./cwebdir/comm-w2c.ch"
+
+kpse_set_program_name(argv[0],"cweb");
+#line 473 "./cwebdir/common.w"
+
+/*:24*/
+#line 58 "./cwebdir/comm-w2c.ch"
+;
+#line 94 "./cwebdir/common.w"
+/*70:*/
+#line 1233 "./cwebdir/common.w"
+
+#line 487 "./cwebdir/comm-w2c.ch"
+show_banner= show_happiness= show_progress= 1;
+#line 1235 "./cwebdir/common.w"
+
+/*:70*/
+#line 94 "./cwebdir/common.w"
+;
+/*80:*/
+#line 1377 "./cwebdir/common.w"
+
+scan_args();
+if(program==ctangle){
+if((C_file= fopen(C_file_name,"w"))==NULL)
+fatal("! Cannot open output file ",C_file_name);
+
+}
+else{
+if((tex_file= fopen(tex_file_name,"w"))==NULL)
+fatal("! Cannot open output file ",tex_file_name);
+}
+
+/*:80*/
+#line 95 "./cwebdir/common.w"
+;
+}
+
+/*:4*//*9:*/
+#line 172 "./cwebdir/common.w"
+
+#line 67 "./cwebdir/comm-w2c.ch"
+int input_ln P1C(FILE*,fp)
+#line 175 "./cwebdir/common.w"
+{
+register int c= EOF;
+register char*k;
+if(feof(fp))return(0);
+limit= k= buffer;
+while(k<=buffer_end&&(c= getc(fp))!=EOF&&c!='\n')
+if((*(k++)= c)!=' ')limit= k;
+if(k> buffer_end)
+if((c= getc(fp))!=EOF&&c!='\n'){
+ungetc(c,fp);loc= buffer;err_print("! Input line too long");
+
+}
+if(c==EOF&&limit==buffer)return(0);
+
+return(1);
+}
+
+/*:9*//*12:*/
+#line 251 "./cwebdir/common.w"
+
+void
+#line 88 "./cwebdir/comm-w2c.ch"
+ prime_the_change_buffer P1H(void)
+#line 254 "./cwebdir/common.w"
+{
+change_limit= change_buffer;
+/*13:*/
+#line 265 "./cwebdir/common.w"
+
+while(1){
+change_line++;
+if(!input_ln(change_file))return;
+if(limit<buffer+2)continue;
+if(buffer[0]!='@')continue;
+if(xisupper(buffer[1]))buffer[1]= tolower(buffer[1]);
+if(buffer[1]=='x')break;
+if(buffer[1]=='y'||buffer[1]=='z'||buffer[1]=='i'){
+loc= buffer+2;
+err_print("! Missing @x in change file");
+
+}
+}
+
+/*:13*/
+#line 256 "./cwebdir/common.w"
+;
+/*14:*/
+#line 282 "./cwebdir/common.w"
+
+do{
+change_line++;
+if(!input_ln(change_file)){
+err_print("! Change file ended after @x");
+
+return;
+}
+}while(limit==buffer);
+
+/*:14*/
+#line 257 "./cwebdir/common.w"
+;
+/*15:*/
+#line 292 "./cwebdir/common.w"
+
+{
+change_limit= change_buffer+(limit-buffer);
+strncpy(change_buffer,buffer,limit-buffer+1);
+}
+
+/*:15*/
+#line 258 "./cwebdir/common.w"
+;
+}
+
+/*:12*//*16:*/
+#line 320 "./cwebdir/common.w"
+
+void
+#line 96 "./cwebdir/comm-w2c.ch"
+ check_change P1H(void)
+#line 323 "./cwebdir/common.w"
+{
+int n= 0;
+if(lines_dont_match)return;
+change_pending= 0;
+if(!changed_section[section_count]){
+if_section_start_make_pending(1);
+if(!change_pending)changed_section[section_count]= 1;
+}
+while(1){
+changing= 1;print_where= 1;change_line++;
+if(!input_ln(change_file)){
+err_print("! Change file ended before @y");
+
+change_limit= change_buffer;changing= 0;
+return;
+}
+if(limit> buffer+1&&buffer[0]=='@'){
+char xyz_code= xisupper(buffer[1])?tolower(buffer[1]):buffer[1];
+/*17:*/
+#line 358 "./cwebdir/common.w"
+
+if(xyz_code=='x'||xyz_code=='z'){
+loc= buffer+2;err_print("! Where is the matching @y?");
+
+}
+else if(xyz_code=='y'){
+if(n> 0){
+loc= buffer+2;
+printf("\n! Hmm... %d ",n);
+err_print("of the preceding lines failed to match");
+
+}
+change_depth= include_depth;
+return;
+}
+
+/*:17*/
+#line 342 "./cwebdir/common.w"
+;
+}
+/*15:*/
+#line 292 "./cwebdir/common.w"
+
+{
+change_limit= change_buffer+(limit-buffer);
+strncpy(change_buffer,buffer,limit-buffer+1);
+}
+
+/*:15*/
+#line 344 "./cwebdir/common.w"
+;
+changing= 0;cur_line++;
+while(!input_ln(cur_file)){
+if(include_depth==0){
+err_print("! CWEB file ended during a change");
+
+input_has_ended= 1;return;
+}
+include_depth--;cur_line++;
+}
+if(lines_dont_match)n++;
+}
+}
+
+/*:16*//*18:*/
+#line 378 "./cwebdir/common.w"
+
+void
+#line 104 "./cwebdir/comm-w2c.ch"
+ reset_input P1H(void)
+#line 381 "./cwebdir/common.w"
+{
+limit= buffer;loc= buffer+1;buffer[0]= ' ';
+/*19:*/
+#line 393 "./cwebdir/common.w"
+
+#line 116 "./cwebdir/comm-w2c.ch"
+if((found_filename= kpse_find_cweb(web_file_name))==NULL||
+(web_file= fopen(found_filename,"r"))==NULL){
+fatal("! Cannot open input file ",web_file_name);
+}else if(strlen(found_filename)<max_file_name_length){
+strcpy(web_file_name,found_filename);
+free(found_filename);
+}
+#line 399 "./cwebdir/common.w"
+
+
+web_file_open= 1;
+#line 129 "./cwebdir/comm-w2c.ch"
+if((found_filename= kpse_find_cweb(change_file_name))==NULL||
+(change_file= fopen(found_filename,"r"))==NULL){
+fatal("! Cannot open change file ",change_file_name);
+}else if(strlen(found_filename)<max_file_name_length){
+strcpy(change_file_name,found_filename);
+free(found_filename);
+}
+#line 404 "./cwebdir/common.w"
+
+/*:19*/
+#line 383 "./cwebdir/common.w"
+;
+include_depth= 0;cur_line= 0;change_line= 0;
+change_depth= include_depth;
+changing= 1;prime_the_change_buffer();changing= !changing;
+limit= buffer;loc= buffer+1;buffer[0]= ' ';input_has_ended= 0;
+}
+
+/*:18*//*21:*/
+#line 426 "./cwebdir/common.w"
+
+#line 143 "./cwebdir/comm-w2c.ch"
+int get_line P1H(void)
+#line 428 "./cwebdir/common.w"
+{
+restart:
+if(changing&&include_depth==change_depth)
+/*27:*/
+#line 537 "./cwebdir/common.w"
+{
+change_line++;
+if(!input_ln(change_file)){
+err_print("! Change file ended without @z");
+
+buffer[0]= '@';buffer[1]= 'z';limit= buffer+2;
+}
+if(limit> buffer){
+if(change_pending){
+if_section_start_make_pending(0);
+if(change_pending){
+changed_section[section_count]= 1;change_pending= 0;
+}
+}
+*limit= ' ';
+if(buffer[0]=='@'){
+if(xisupper(buffer[1]))buffer[1]= tolower(buffer[1]);
+if(buffer[1]=='x'||buffer[1]=='y'){
+loc= buffer+2;
+err_print("! Where is the matching @z?");
+
+}
+else if(buffer[1]=='z'){
+prime_the_change_buffer();changing= !changing;print_where= 1;
+}
+}
+}
+}
+
+/*:27*/
+#line 431 "./cwebdir/common.w"
+;
+if(!changing||include_depth> change_depth){
+/*26:*/
+#line 520 "./cwebdir/common.w"
+{
+cur_line++;
+while(!input_ln(cur_file)){
+print_where= 1;
+if(include_depth==0){input_has_ended= 1;break;}
+else{
+fclose(cur_file);include_depth--;
+if(changing&&include_depth==change_depth)break;
+cur_line++;
+}
+}
+if(!changing&&!input_has_ended)
+if(limit-buffer==change_limit-change_buffer)
+if(buffer[0]==change_buffer[0])
+if(change_limit> change_buffer)check_change();
+}
+
+/*:26*/
+#line 433 "./cwebdir/common.w"
+;
+if(changing&&include_depth==change_depth)goto restart;
+}
+if(input_has_ended)return 0;
+loc= buffer;*limit= ' ';
+if(buffer[0]=='@'&&(buffer[1]=='i'||buffer[1]=='I')){
+loc= buffer+2;*limit= '"';
+while(*loc==' '||*loc=='\t')loc++;
+if(loc>=limit){
+err_print("! Include file name not given");
+
+goto restart;
+}
+if(include_depth>=max_include_depth-1){
+err_print("! Too many nested includes");
+
+goto restart;
+}
+include_depth++;
+/*25:*/
+#line 474 "./cwebdir/common.w"
+{
+#line 201 "./cwebdir/comm-w2c.ch"
+char*cur_file_name_end= cur_file_name+max_file_name_length-1;
+char*k= cur_file_name;
+#line 479 "./cwebdir/common.w"
+
+if(*loc=='"'){
+loc++;
+while(*loc!='"'&&k<=cur_file_name_end)*k++= *loc++;
+if(loc==limit)k= cur_file_name_end+1;
+}else
+while(*loc!=' '&&*loc!='\t'&&*loc!='"'&&k<=cur_file_name_end)*k++= *loc++;
+if(k> cur_file_name_end)too_long();
+
+*k= '\0';
+#line 208 "./cwebdir/comm-w2c.ch"
+if((found_filename= kpse_find_cweb(cur_file_name))!=NULL&&
+(cur_file= fopen(found_filename,"r"))!=NULL){
+
+if(strlen(found_filename)<max_file_name_length){
+strcpy(cur_file_name,found_filename);
+free(found_filename);
+}
+#line 490 "./cwebdir/common.w"
+cur_line= 0;print_where= 1;
+goto restart;
+}
+#line 517 "./cwebdir/common.w"
+include_depth--;err_print("! Cannot open include file");goto restart;
+}
+
+/*:25*/
+#line 452 "./cwebdir/common.w"
+;
+}
+return 1;
+}
+
+/*:21*//*28:*/
+#line 569 "./cwebdir/common.w"
+
+void
+#line 252 "./cwebdir/comm-w2c.ch"
+ check_complete P1H(void){
+#line 572 "./cwebdir/common.w"
+if(change_limit!=change_buffer){
+strncpy(buffer,change_buffer,change_limit-change_buffer+1);
+limit= buffer+(int)(change_limit-change_buffer);
+changing= 1;change_depth= include_depth;loc= buffer;
+err_print("! Change file entry did not match");
+
+}
+}
+
+/*:28*//*37:*/
+#line 660 "./cwebdir/common.w"
+
+name_pointer
+#line 271 "./cwebdir/comm-w2c.ch"
+
+id_lookup P3C(char*,first,char*,last,char,t)
+#line 666 "./cwebdir/common.w"
+{
+char*i= first;
+int h;
+int l;
+name_pointer p;
+if(last==NULL)for(last= first;*last!='\0';last++);
+l= last-first;
+/*38:*/
+#line 683 "./cwebdir/common.w"
+
+h= (unsigned char)*i;
+while(++i<last)h= (h+h+(int)((unsigned char)*i))%hash_size;
+
+
+/*:38*/
+#line 673 "./cwebdir/common.w"
+;
+/*39:*/
+#line 691 "./cwebdir/common.w"
+
+p= hash[h];
+while(p&&!names_match(p,first,l,t))p= p->link;
+if(p==NULL){
+p= name_ptr;
+p->link= hash[h];hash[h]= p;
+}
+
+/*:39*/
+#line 674 "./cwebdir/common.w"
+;
+if(p==name_ptr)/*41:*/
+#line 706 "./cwebdir/common.w"
+{
+if(byte_ptr+l> byte_mem_end)overflow("byte memory");
+if(name_ptr>=name_dir_end)overflow("name");
+strncpy(byte_ptr,first,l);
+(++name_ptr)->byte_start= byte_ptr+= l;
+if(program==cweave)init_p(p,t);
+}
+
+/*:41*/
+#line 675 "./cwebdir/common.w"
+;
+return(p);
+}
+
+/*:37*//*44:*/
+#line 764 "./cwebdir/common.w"
+
+void
+#line 289 "./cwebdir/comm-w2c.ch"
+ print_section_name P1C(name_pointer,p)
+#line 768 "./cwebdir/common.w"
+{
+char*ss,*s= first_chunk(p);
+name_pointer q= p+1;
+while(p!=name_dir){
+ss= (p+1)->byte_start-1;
+if(*ss==' '&&ss>=s){
+term_write(s,ss-s);p= q->link;q= p;
+}else{
+term_write(s,ss+1-s);p= name_dir;q= NULL;
+}
+s= p->byte_start;
+}
+if(q)term_write("...",3);
+}
+
+/*:44*//*45:*/
+#line 783 "./cwebdir/common.w"
+
+void
+#line 299 "./cwebdir/comm-w2c.ch"
+ sprint_section_name P2C(char*,dest,name_pointer,p)
+#line 788 "./cwebdir/common.w"
+{
+char*ss,*s= first_chunk(p);
+name_pointer q= p+1;
+while(p!=name_dir){
+ss= (p+1)->byte_start-1;
+if(*ss==' '&&ss>=s){
+p= q->link;q= p;
+}else{
+ss++;p= name_dir;
+}
+strncpy(dest,s,ss-s),dest+= ss-s;
+s= p->byte_start;
+}
+*dest= '\0';
+}
+
+/*:45*//*46:*/
+#line 804 "./cwebdir/common.w"
+
+void
+#line 308 "./cwebdir/comm-w2c.ch"
+ print_prefix_name P1C(name_pointer,p)
+#line 808 "./cwebdir/common.w"
+{
+char*s= first_chunk(p);
+int l= prefix_length(p);
+term_write(s,l);
+if(s+l<(p+1)->byte_start)term_write("...",3);
+}
+
+/*:46*//*47:*/
+#line 825 "./cwebdir/common.w"
+
+#line 318 "./cwebdir/comm-w2c.ch"
+
+int web_strcmp P4C(char*,j,int,j_len,char*,k,int,k_len)
+#line 829 "./cwebdir/common.w"
+{
+char*j1= j+j_len,*k1= k+k_len;
+while(k<k1&&j<j1&&*j==*k)k++,j++;
+if(k==k1)if(j==j1)return equal;
+else return extension;
+else if(j==j1)return prefix;
+else if(*j<*k)return less;
+else return greater;
+}
+
+/*:47*//*49:*/
+#line 855 "./cwebdir/common.w"
+
+name_pointer
+#line 340 "./cwebdir/comm-w2c.ch"
+
+add_section_name P5C(name_pointer,par,int,c,char*,first,char*,last,
+int,ispref)
+#line 863 "./cwebdir/common.w"
+{
+name_pointer p= name_ptr;
+char*s= first_chunk(p);
+int name_len= last-first+ispref;
+if(s+name_len> byte_mem_end)overflow("byte memory");
+if(name_ptr+1>=name_dir_end)overflow("name");
+(++name_ptr)->byte_start= byte_ptr= s+name_len;
+if(ispref){
+*(byte_ptr-1)= ' ';
+name_len--;
+name_ptr->link= name_dir;
+(++name_ptr)->byte_start= byte_ptr;
+}
+set_prefix_length(p,name_len);
+strncpy(s,first,name_len);
+p->llink= NULL;
+p->rlink= NULL;
+init_node(p);
+return par==NULL?(root= p):c==less?(par->llink= p):(par->rlink= p);
+}
+
+/*:49*//*50:*/
+#line 884 "./cwebdir/common.w"
+
+void
+#line 354 "./cwebdir/comm-w2c.ch"
+ extend_section_name P4C(name_pointer,p,char*,first,char*,last,int,ispref)
+#line 891 "./cwebdir/common.w"
+{
+char*s;
+name_pointer q= p+1;
+int name_len= last-first+ispref;
+if(name_ptr>=name_dir_end)overflow("name");
+while(q->link!=name_dir)q= q->link;
+q->link= name_ptr;
+s= name_ptr->byte_start;
+name_ptr->link= name_dir;
+if(s+name_len> byte_mem_end)overflow("byte memory");
+(++name_ptr)->byte_start= byte_ptr= s+name_len;
+strncpy(s,first,name_len);
+if(ispref)*(byte_ptr-1)= ' ';
+}
+
+/*:50*//*51:*/
+#line 912 "./cwebdir/common.w"
+
+name_pointer
+#line 364 "./cwebdir/comm-w2c.ch"
+
+section_lookup P3C(char*,first,char*,last,int,ispref)
+#line 917 "./cwebdir/common.w"
+{
+int c= 0;
+name_pointer p= root;
+name_pointer q= NULL;
+name_pointer r= NULL;
+name_pointer par= NULL;
+
+int name_len= last-first+1;
+/*52:*/
+#line 936 "./cwebdir/common.w"
+
+while(p){
+c= web_strcmp(first,name_len,first_chunk(p),prefix_length(p));
+if(c==less||c==greater){
+if(r==NULL)
+par= p;
+p= (c==less?p->llink:p->rlink);
+}else{
+if(r!=NULL){
+printf("\n! Ambiguous prefix: matches <");
+
+print_prefix_name(p);
+printf(">\n and <");
+print_prefix_name(r);
+err_print(">");
+return name_dir;
+}
+r= p;
+p= p->llink;
+q= r->rlink;
+}
+if(p==NULL)
+p= q,q= NULL;
+}
+
+/*:52*/
+#line 926 "./cwebdir/common.w"
+;
+/*53:*/
+#line 961 "./cwebdir/common.w"
+
+if(r==NULL)
+return add_section_name(par,c,first,last+1,ispref);
+
+/*:53*/
+#line 927 "./cwebdir/common.w"
+;
+/*54:*/
+#line 969 "./cwebdir/common.w"
+
+switch(section_name_cmp(&first,name_len,r)){
+
+case prefix:
+if(!ispref){
+printf("\n! New name is a prefix of <");
+
+print_section_name(r);
+err_print(">");
+}
+else if(name_len<prefix_length(r))set_prefix_length(r,name_len);
+
+case equal:return r;
+case extension:if(!ispref||first<=last)
+extend_section_name(r,first,last+1,ispref);
+return r;
+case bad_extension:
+printf("\n! New name extends <");
+
+print_section_name(r);
+err_print(">");
+return r;
+default:
+printf("\n! Section name incompatible with <");
+
+print_prefix_name(r);
+printf(">,\n which abbreviates <");
+print_section_name(r);
+err_print(">");
+return r;
+}
+
+/*:54*/
+#line 928 "./cwebdir/common.w"
+;
+}
+
+/*:51*//*56:*/
+#line 1020 "./cwebdir/common.w"
+
+#line 384 "./cwebdir/comm-w2c.ch"
+int section_name_cmp P3C(char**,pfirst,int,len,name_pointer,r)
+#line 1025 "./cwebdir/common.w"
+{
+char*first= *pfirst;
+name_pointer q= r+1;
+char*ss,*s= first_chunk(r);
+int c;
+int ispref;
+while(1){
+ss= (r+1)->byte_start-1;
+if(*ss==' '&&ss>=r->byte_start)ispref= 1,q= q->link;
+else ispref= 0,ss++,q= name_dir;
+switch(c= web_strcmp(first,len,s,ss-s)){
+case equal:if(q==name_dir)
+if(ispref){
+*pfirst= first+(ss-s);
+return extension;
+}else return equal;
+else return(q->byte_start==(q+1)->byte_start)?equal:prefix;
+case extension:
+if(!ispref)return bad_extension;
+first+= ss-s;
+if(q!=name_dir){len-= ss-s;s= q->byte_start;r= q;continue;}
+*pfirst= first;return extension;
+default:return c;
+}
+}
+}
+
+/*:56*//*60:*/
+#line 1095 "./cwebdir/common.w"
+
+void
+#line 401 "./cwebdir/comm-w2c.ch"
+ err_print P1C(char*,s)
+#line 1099 "./cwebdir/common.w"
+{
+char*k,*l;
+printf(*s=='!'?"\n%s":"%s",s);
+if(web_file_open)/*61:*/
+#line 1115 "./cwebdir/common.w"
+
+{if(changing&&include_depth==change_depth)
+printf(". (l. %d of change file)\n",change_line);
+else if(include_depth==0)printf(". (l. %d)\n",cur_line);
+else printf(". (l. %d of include file %s)\n",cur_line,cur_file_name);
+l= (loc>=limit?limit:loc);
+if(l> buffer){
+for(k= buffer;k<l;k++)
+if(*k=='\t')putchar(' ');
+else putchar(*k);
+putchar('\n');
+for(k= buffer;k<l;k++)putchar(' ');
+}
+for(k= l;k<limit;k++)putchar(*k);
+if(*limit=='|')putchar('|');
+putchar(' ');
+}
+
+/*:61*/
+#line 1102 "./cwebdir/common.w"
+;
+update_terminal;mark_error;
+}
+
+/*:60*//*63:*/
+#line 1150 "./cwebdir/common.w"
+
+#line 419 "./cwebdir/comm-w2c.ch"
+int wrap_up P1H(void){
+#line 1152 "./cwebdir/common.w"
+putchar('\n');
+if(show_stats)
+print_stats();
+/*64:*/
+#line 1160 "./cwebdir/common.w"
+
+switch(history){
+case spotless:if(show_happiness)printf("(No errors were found.)\n");break;
+case harmless_message:
+printf("(Did you see the warning message above?)\n");break;
+case error_message:
+printf("(Pardon me, but I think I spotted something wrong.)\n");break;
+case fatal_message:printf("(That was a fatal error, my friend.)\n");
+}
+
+/*:64*/
+#line 1155 "./cwebdir/common.w"
+;
+if(history> harmless_message)return(1);
+else return(0);
+}
+
+/*:63*//*66:*/
+#line 1179 "./cwebdir/common.w"
+void
+#line 437 "./cwebdir/comm-w2c.ch"
+ fatal P2C(char*,s,char*,t)
+#line 1182 "./cwebdir/common.w"
+{
+if(*s)printf(s);
+err_print(t);
+history= fatal_message;exit(wrap_up());
+}
+
+/*:66*//*67:*/
+#line 1190 "./cwebdir/common.w"
+void
+#line 446 "./cwebdir/comm-w2c.ch"
+ overflow P1C(char*,t)
+#line 1193 "./cwebdir/common.w"
+{
+printf("\n! Sorry, %s capacity exceeded",t);fatal("","");
+}
+
+
+/*:67*//*72:*/
+#line 1254 "./cwebdir/common.w"
+
+void
+#line 504 "./cwebdir/comm-w2c.ch"
+ scan_args P1H(void)
+#line 1257 "./cwebdir/common.w"
+{
+char*dot_pos;
+char*name_pos;
+register char*s;
+boolean found_web= 0,found_change= 0,found_out= 0;
+
+boolean flag_change;
+
+while(--argc> 0){
+if((**(++argv)=='-'||**argv=='+')&&*(*argv+1))/*76:*/
+#line 528 "./cwebdir/comm-w2c.ch"
+
+{
+if(strcmp("-help",*argv)==0||strcmp("--help",*argv)==0)
+/*84:*/
+#line 605 "./cwebdir/comm-w2c.ch"
+
+usagehelp(program==ctangle?CTANGLEHELP:CWEAVEHELP,NULL);
+
+
+/*:84*/
+#line 531 "./cwebdir/comm-w2c.ch"
+;
+if(strcmp("-version",*argv)==0||strcmp("--version",*argv)==0)
+/*85:*/
+#line 614 "./cwebdir/comm-w2c.ch"
+
+printversionandexit((program==ctangle?ctangle_banner:cweave_banner),
+"Silvio Levy and Donald E. Knuth",NULL);
+
+
+/*:85*/
+#line 533 "./cwebdir/comm-w2c.ch"
+;
+#line 1346 "./cwebdir/common.w"
+if(**argv=='-')flag_change= 0;
+#line 539 "./cwebdir/comm-w2c.ch"
+else flag_change= 1;
+if(*(*argv+1)=='d')
+if(sscanf(*argv+2,"%u",&kpathsea_debug)!=1)/*77:*/
+#line 1352 "./cwebdir/common.w"
+
+{
+#line 562 "./cwebdir/comm-w2c.ch"
+if(program==ctangle){
+fprintf(stderr,"ctangle: Need one to three file arguments.\n");
+usage("ctangle");
+}else{
+fprintf(stderr,"cweave: Need one to three file arguments.\n");
+usage("cweave");
+}
+#line 1362 "./cwebdir/common.w"
+}
+
+/*:77*/
+#line 541 "./cwebdir/comm-w2c.ch"
+;
+#line 1348 "./cwebdir/common.w"
+for(dot_pos= *argv+1;*dot_pos> '\0';dot_pos++)
+#line 547 "./cwebdir/comm-w2c.ch"
+flags[(unsigned char)*dot_pos]= flag_change;
+#line 1350 "./cwebdir/common.w"
+}
+
+/*:76*/
+#line 1266 "./cwebdir/common.w"
+
+else{
+s= name_pos= *argv;dot_pos= NULL;
+while(*s){
+if(*s=='.')dot_pos= s++;
+else if(*s=='/')dot_pos= NULL,name_pos= ++s;
+else s++;
+}
+if(!found_web)/*73:*/
+#line 1292 "./cwebdir/common.w"
+
+{
+if(s-*argv> max_file_name_length-5)
+/*78:*/
+#line 1364 "./cwebdir/common.w"
+fatal("! Filename too long\n",*argv);
+
+
+/*:78*/
+#line 1295 "./cwebdir/common.w"
+;
+if(dot_pos==NULL)
+sprintf(web_file_name,"%s.w",*argv);
+else{
+strcpy(web_file_name,*argv);
+*dot_pos= 0;
+}
+#line 1303 "./cwebdir/common.w"
+sprintf(tex_file_name,"%s.tex",name_pos);
+sprintf(idx_file_name,"%s.idx",name_pos);
+sprintf(scn_file_name,"%s.scn",name_pos);
+sprintf(C_file_name,"%s.c",name_pos);
+found_web= 1;
+}
+
+/*:73*/
+#line 1275 "./cwebdir/common.w"
+
+else if(!found_change)/*74:*/
+#line 1310 "./cwebdir/common.w"
+
+{
+if(strcmp(*argv,"-")==0)found_change= -1;
+else{
+if(s-*argv> max_file_name_length-4)
+/*78:*/
+#line 1364 "./cwebdir/common.w"
+fatal("! Filename too long\n",*argv);
+
+
+/*:78*/
+#line 1315 "./cwebdir/common.w"
+;
+if(dot_pos==NULL)
+sprintf(change_file_name,"%s.ch",*argv);
+else strcpy(change_file_name,*argv);
+found_change= 1;
+}
+}
+
+/*:74*/
+#line 1276 "./cwebdir/common.w"
+
+else if(!found_out)/*75:*/
+#line 1323 "./cwebdir/common.w"
+
+{
+if(s-*argv> max_file_name_length-5)
+/*78:*/
+#line 1364 "./cwebdir/common.w"
+fatal("! Filename too long\n",*argv);
+
+
+/*:78*/
+#line 1326 "./cwebdir/common.w"
+;
+if(dot_pos==NULL){
+sprintf(tex_file_name,"%s.tex",*argv);
+sprintf(idx_file_name,"%s.idx",*argv);
+sprintf(scn_file_name,"%s.scn",*argv);
+sprintf(C_file_name,"%s.c",*argv);
+}else{
+strcpy(tex_file_name,*argv);
+strcpy(C_file_name,*argv);
+if(flags['x']){
+*dot_pos= 0;
+sprintf(idx_file_name,"%s.idx",*argv);
+sprintf(scn_file_name,"%s.scn",*argv);
+}
+}
+found_out= 1;
+}
+
+#line 528 "./cwebdir/comm-w2c.ch"
+/*:75*/
+#line 1277 "./cwebdir/common.w"
+
+else/*77:*/
+#line 1352 "./cwebdir/common.w"
+
+{
+#line 562 "./cwebdir/comm-w2c.ch"
+if(program==ctangle){
+fprintf(stderr,"ctangle: Need one to three file arguments.\n");
+usage("ctangle");
+}else{
+fprintf(stderr,"cweave: Need one to three file arguments.\n");
+usage("cweave");
+}
+#line 1362 "./cwebdir/common.w"
+}
+
+/*:77*/
+#line 1278 "./cwebdir/common.w"
+;
+}
+}
+if(!found_web)/*77:*/
+#line 1352 "./cwebdir/common.w"
+
+{
+#line 562 "./cwebdir/comm-w2c.ch"
+if(program==ctangle){
+fprintf(stderr,"ctangle: Need one to three file arguments.\n");
+usage("ctangle");
+}else{
+fprintf(stderr,"cweave: Need one to three file arguments.\n");
+usage("cweave");
+}
+#line 1362 "./cwebdir/common.w"
+}
+
+/*:77*/
+#line 1281 "./cwebdir/common.w"
+;
+#line 513 "./cwebdir/comm-w2c.ch"
+if(found_change<=0)strcpy(change_file_name,DEV_NULL);
+#line 1283 "./cwebdir/common.w"
+}
+
+/*:72*/
diff --git a/Build/source/texk/web2c/cwebdir/Makefile b/Build/source/texk/web2c/cwebdir/Makefile
new file mode 100644
index 00000000000..31194f46bb0
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/Makefile
@@ -0,0 +1,195 @@
+# This file is part of CWEB.
+# It is distributed WITHOUT ANY WARRANTY, express or implied.
+# Version 3.64 --- February 2002
+
+# Copyright (C) 1987,1990,1993,2000 Silvio Levy and Donald E. Knuth
+
+# Permission is granted to make and distribute verbatim copies of this
+# document provided that the copyright notice and this permission notice
+# are preserved on all copies.
+
+# Permission is granted to copy and distribute modified versions of this
+# document under the conditions for verbatim copying, provided that the
+# entire resulting derived work is given a different name and distributed
+# under the terms of a permission notice identical to this one.
+
+#
+# Read the README file, then edit this file to reflect local conditions
+#
+
+# directory for TeX inputs (cwebmac.tex goes here)
+MACROSDIR= /usr/local/texmf/tex/generic
+
+# directory for CWEB inputs in @i files
+CWEBINPUTS= /usr/local/lib/cweb
+
+# extension for manual pages ("l" distinguishes local from system stuff)
+MANEXT= l
+#MANEXT= 1
+
+# directory for manual pages (cweb.1 goes here)
+MANDIR= /usr/man/man$(MANEXT)
+
+# destination directory for executables; must end in /
+DESTDIR= /usr/local/bin/
+
+# directory for GNU EMACS Lisp code (cweb.el goes here)
+EMACSDIR= /usr/local/emacs/lisp
+
+# Set DESTPREF to null if you want to call the executables "tangle" and "weave"
+# (probably NOT a good idea; we recommend leaving DESTPREF=c)
+DESTPREF=c
+
+# Set CCHANGES to comm-foo.ch if you need changes to common.w
+CCHANGES=
+
+# Set TCHANGES to ctang-foo.ch if you need changes to ctangle.w
+TCHANGES=
+
+# Set WCHANGES to cweav-foo.ch if you need changes to cweave.w
+WCHANGES=
+
+# We keep debugging info around, for fun, but most users don't need it
+CFLAGS = -g
+#CFLAGS = -O
+LINKFLAGS = -g
+#LINKFLAGS = -s # for smaller (stripped) executables on many UNIX systems
+
+# What C compiler are you using?
+CC = cc
+
+# RM and CP are used below in case rm and cp are aliased
+RM= /bin/rm
+CP= /bin/cp
+
+# uncomment the second line if you use pdftex to bypass .dvi files
+PDFTEX = dvipdfm
+#PDFTEX = pdftex
+
+########## You shouldn't have to change anything after this point #######
+
+CWEAVE = ./cweave
+CTANGLE = ./ctangle
+SOURCES = cweave.w common.w ctangle.w
+ALL = common.w ctangle.w cweave.w prod.w \
+ Makefile common.c common.h ctangle.c \
+ cwebman.tex cwebmac.tex comm-vms.ch ctang-vms.ch \
+ cweav-vms.ch comm-man.ch ctang-man.ch cweav-man.ch \
+ comm-pc.ch ctang-pc.ch cweav-pc.ch comm-amiga.ch \
+ comm-bs.ch ctang-bs.ch cweav-bs.ch makefile.bs \
+ comm-ql.ch ctang-ql.ch cweav-ql.ch readme.ql \
+ comm-w32.ch ctang-w32.ch cweav-w32.ch \
+ comm-os2.ch comm-mac.ch cweb.1 cweb.el c++lib.w README
+
+.SUFFIXES: .dvi .tex .w .pdf
+
+.w.tex:
+ $(CWEAVE) $*
+
+.tex.dvi:
+ tex $<
+
+.w.dvi:
+ make $*.tex
+ make $*.dvi
+
+.w.c:
+ $(CTANGLE) $*
+
+.w.o:
+ make $*.c
+ make $*.o
+
+.w.pdf:
+ make $*.tex
+ case "$(PDFTEX)" in \
+ dvipdfm ) tex "\let\pdf+ \input $*"; dvipdfm $* ;; \
+ pdftex ) pdftex $* ;; \
+ esac
+
+all: ctangle cweave
+
+cautiously: ctangle
+ $(CP) common.c SAVEcommon.c
+ ./ctangle common $(CCHANGES)
+ diff common.c SAVEcommon.c
+ $(RM) SAVEcommon.c
+ $(CP) ctangle.c SAVEctangle.c
+ ./ctangle ctangle $(TCHANGES)
+ diff ctangle.c SAVEctangle.c
+ $(RM) SAVEctangle.c
+
+SAVEctangle.c:
+ $(CP) ctangle.c SAVEctangle.c
+
+SAVEcommon.c:
+ $(CP) common.c SAVEcommon.c
+
+common.c: common.w $(CCHANGES)
+ $(CTANGLE) common $(CCHANGES)
+
+common.o: common.c
+ $(CC) $(CFLAGS) -DCWEBINPUTS=\"$(CWEBINPUTS)\" -c common.c
+
+ctangle: ctangle.o common.o
+ $(CC) $(LINKFLAGS) -o ctangle ctangle.o common.o
+
+ctangle.c: ctangle.w $(TCHANGES)
+ $(CTANGLE) ctangle $(TCHANGES)
+
+cweave: cweave.o common.o
+ $(CC) $(LINKFLAGS) -o cweave cweave.o common.o
+
+cweave.c: cweave.w $(WCHANGES)
+ $(CTANGLE) cweave $(WCHANGES)
+
+doc: $(SOURCES:.w=.dvi)
+
+usermanual: cwebman.tex cwebmac.tex
+ tex cwebman
+
+fullmanual: usermanual $(SOURCES) comm-man.ch ctang-man.ch cweav-man.ch
+ make cweave
+ ./cweave common.w comm-man.ch
+ tex common.tex
+ ./cweave ctangle.w ctang-man.ch
+ tex ctangle.tex
+ ./cweave cweave.w cweav-man.ch
+ tex cweave.tex
+
+# be sure to leave ctangle.c and common.c for bootstrapping
+clean:
+ $(RM) -f -r *~ *.o common.tex cweave.tex cweave.c ctangle.tex \
+ *.log *.dvi *.toc *.idx *.scn *.pdf core cweave ctangle
+
+install: all
+ - mkdir $(DESTDIR)
+ $(CP) cweave $(DESTDIR)$(DESTPREF)weave
+ chmod 755 $(DESTDIR)$(DESTPREF)weave
+ $(CP) ctangle $(DESTDIR)$(DESTPREF)tangle
+ chmod 755 $(DESTDIR)$(DESTPREF)tangle
+ - mkdir $(MANDIR)
+ $(CP) cweb.1 $(MANDIR)/cweb.$(MANEXT)
+ chmod 644 $(MANDIR)/cweb.$(MANEXT)
+ - mkdir $(MACROSDIR)
+ $(CP) cwebmac.tex $(MACROSDIR)
+ chmod 644 $(MACROSDIR)/cwebmac.tex
+ - mkdir $(EMACSDIR)
+ $(CP) cweb.el $(EMACSDIR)
+ chmod 644 $(EMACSDIR)/cweb.el
+ - mkdir $(CWEBINPUTS)
+ $(CP) c++lib.w $(CWEBINPUTS)
+ chmod 644 $(CWEBINPUTS)/c++lib.w
+
+floppy: $(ALL) examples
+ bar cvhf /dev/rfd0 $(ALL) examples
+ bar tvf /dev/rfd0
+ eject
+
+tags: $(ALL)
+ etags -lnone $(ALL)
+
+tarfile: $(ALL) examples
+ tar cvhf /tmp/cweb.tar $(ALL) examples
+ gzip -9 /tmp/cweb.tar
+
diff --git a/Build/source/texk/web2c/cwebdir/README b/Build/source/texk/web2c/cwebdir/README
new file mode 100644
index 00000000000..1f4add6dd09
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/README
@@ -0,0 +1,98 @@
+% This file is part of CWEB.
+% The CWEB programs by Silvio Levy are based on programs by D. E. Knuth.
+% They are distributed WITHOUT ANY WARRANTY, express or implied.
+% This README file last updated May 2000 by Don Knuth
+
+% Copyright (C) 1987,1990,1993,2000 Silvio Levy and Donald E. Knuth
+
+% Permission is granted to make and distribute verbatim copies of this
+% document provided that the copyright notice and this permission notice
+% are preserved on all copies.
+
+% Permission is granted to copy and distribute modified versions of this
+% document under the conditions for verbatim copying, provided that the
+% entire resulting derived work is given a different name and distributed
+% under the terms of a permission notice identical to this one.
+
+% Please send comments, suggestions, etc. to levy@math.berkeley.edu.
+
+This directory contains the following files:
+
+Makefile
+README
+comm-amiga.ch
+comm-bs.ch
+comm-mac.ch
+comm-man.ch
+comm-pc.ch
+comm-ql.ch
+comm-vms.ch
+comm-w32.ch
+common.c
+common.h
+common.w
+ctang-bs.ch
+ctang-man.ch
+ctang-pc.ch
+ctang-ql.ch
+ctang-vms.ch
+ctang-w32.ch
+ctangle.c
+ctangle.w
+cweav-bs.ch
+cweav-man.ch
+cweav-pc.ch
+cweav-ql.ch
+cweav-vms.ch
+cweave-w32.ch
+cweave.w
+cweb.1
+cweb.el
+cwebmac.tex
+cwebman.tex
+examples/
+makefile.bs
+prod.w
+readme.ql
+c++lib.w
+
+The file cwebman.tex is the user manual.
+The examples directory contains additional examples of the use of CWEB.
+The files common.c and ctangle.c are used for bootstrapping.
+The file cweb.1 is a manual page.
+The file cweb.el is suggested for GNU-Emacs users.
+The file c++lib.w is for C++ users (say `@i c++lib.w' at beginning of program).
+The files *-man.ch are used if you want to make the full 239-page CWEB manual.
+The files *-bs.ch are used instead of *-pc.ch if you are doing BIG programs.
+You can use makefile.bs to make CWEB with *-bs.ch.
+The files *-ql.ch are for QDOS/SMSQ systems; see readme.ql for further info.
+The files *-w32.ch use __fastcall conventions on win32 systems.
+The file comm-mac.ch is for Macintosh conventions.
+The other files named *.ch are sample change files for local customization.
+
+IMPORTANT: Please touch *.c before proceeding.
+Then edit the opening lines of Makefile so that it has the proper
+directory information for your local system.
+
+To make ctangle and cweave say `make all'; this should produce roughly
+the following actions (possibly with harmless warning messages from cc):
+
+cc -g -w -c ctangle.c
+cc -g -w -DCWEBINPUTS=\"/usr/local/lib/cweb\" -c common.c
+cc -g -o ctangle ctangle.o common.o
+./ctangle cweave
+cc -g -w -c cweave.c
+cc -g -w -o cweave cweave.o common.o
+
+To get some reassurance that things are OK, you can say `make cautiously',
+which ensures that CTANGLE will reproduce itself. (Otherwise the source
+files common.w and ctangle.w won't actually have been used.)
+
+To install cweave and ctangle say `make install'. You probably need to
+be superuser to do this; but it's wise to `make all' first, BEFORE
+becoming superuser and saying `make install'.
+
+Note that change files for VMS, AMIGA, MAC, and PCs are provided. When you
+are first bootstrapping to a new system, you may need to edit common.c and
+ctangle.c by hand, but the vast majority of the change-file changes are
+minor refinements that are not necessary for a rudimentary ctangle.
diff --git a/Build/source/texk/web2c/cwebdir/c++lib.w b/Build/source/texk/web2c/cwebdir/c++lib.w
new file mode 100644
index 00000000000..15e59cc8851
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/c++lib.w
@@ -0,0 +1,85 @@
+@q This file defines standard C++ namespaces and classes @>
+@q Please send corrections to saroj-tamasa@@worldnet.att.net @>
+@s std int
+@s rel_ops int
+@s bitset int
+@s char_traits int
+@s deque int
+@s list int
+@s map int
+@s multimap int
+@s multiset int
+@s pair int
+@s set int
+@s stack int
+@s exception int
+@s logic_error int
+@s runtime_error int
+@s domain_error int
+@s invalid_argument int
+@s length_error int
+@s out_of_range int
+@s range_error int
+@s overflow_error int
+@s underflow_error int
+@s back_insert_iterator int
+@s front_insert_iterator int
+@s insert_iterator int
+@s reverse_iterator int
+@s istream_iterator int
+@s ostream_iterator int
+@s istreambuf_iterator int
+@s ostreambuf_iterator int
+@s iterator_traits int
+@s queue int
+@s vector int
+@s basic_string int
+@s string int
+@s auto_ptr int
+@s valarray int
+@s ios_base int
+@s basic_ios int
+@s basic_streambuf int
+@s basic_istream int
+@s basic_ostream int
+@s basic_iostream int
+@s basic_stringbuf int
+@s basic_istringstream int
+@s basic_ostringstream int
+@s basic_stringstream int
+@s basic_filebuf int
+@s basic_ifstream int
+@s basic_ofstream int
+@s basic_fstream int
+@s ctype int
+@s collate int
+@s collate_byname int
+@s streambuf int
+@s istream int
+@s ostream int
+@s iostream int
+@s stringbuf int
+@s istringstream int
+@s ostringstream int
+@s stringstream int
+@s filebuf int
+@s ifstream int
+@s ofstream int
+@s fstream int
+@s wstreambuf int
+@s wistream int
+@s wostream int
+@s wiostram int
+@s wstringbuf int
+@s wistringstream int
+@s wostringstream int
+@s wstringstream int
+@s wfilebuf int
+@s wifstream int
+@s wofstream int
+@s wfstream int
+@s streamoff int
+@s streamsize int
+@s fpos int
+@s streampos int
+@s wstreampos int
diff --git a/Build/source/texk/web2c/cwebdir/comm-amiga.ch b/Build/source/texk/web2c/cwebdir/comm-amiga.ch
new file mode 100644
index 00000000000..57e65d1ccda
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-amiga.ch
@@ -0,0 +1,17 @@
+This is the change file for CWEB's COMMON on the Amiga
+(Contributed by Tomas Rokicki, June 1993)
+
+With Lattice C 5.1, use compilation switches -b0 -r0, and ignore the
+compiler warnings. With SAS 6.0, use compilation switches Code=far Data=far.
+
+@x section 69
+An omitted change file argument means that |"/dev/null"| should be used,
+@y
+An omitted change file argument means that |"nil:"| should be used,
+@z
+
+@x section 70
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+@y
+ if (found_change<=0) strcpy(change_file_name,"nil:");
+@z
diff --git a/Build/source/texk/web2c/cwebdir/comm-bs.ch b/Build/source/texk/web2c/cwebdir/comm-bs.ch
new file mode 100644
index 00000000000..26f79b160d1
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-bs.ch
@@ -0,0 +1,229 @@
+Changes for code common to CTANGLE and CWEAVE, for MSDOS
+and Borland C++ 3.1 using the following options (and perhaps others):
+
+ -mc -w-pro -Ff=5000 -Z- -O-p
+
+The options -Z- and -O-p explicitly turn off optimizations that seem to be
+dangerous for the style of code in the CWEB sources. (See makefile.bs.)
+
+The main purpose of these changes is to support MSDOS with full-size arrays
+by using "huge" pointers.
+
+(This file contributed by Barry Schwartz, trashman@crud.mn.org, 28 Jun 94;
+ revised 24 Jul 94.)
+
+
+@x Section 23.
+ cur_file_name[l]='/'; /* \UNIX/ pathname separator */
+@y
+ cur_file_name[l]='/'; /* A valid {\mc MSDOS} pathname separator */
+@z
+
+
+@x Section 27.
+@d max_names 4000 /* number of identifiers, strings, section names;
+ must be less than 10240 */
+
+@<Definitions that...@>=
+typedef struct name_info {
+ char *byte_start; /* beginning of the name in |byte_mem| */
+ @<More elements of |name_info| structure@>@;
+} name_info; /* contains information about an identifier or section name */
+typedef name_info *name_pointer; /* pointer into array of |name_info|s */
+char byte_mem[max_bytes]; /* characters of names */
+char *byte_mem_end = byte_mem+max_bytes-1; /* end of |byte_mem| */
+name_info name_dir[max_names]; /* information about names */
+name_pointer name_dir_end = name_dir+max_names-1; /* end of |name_dir| */
+@y
+@d max_names 4000 /* number of identifiers, strings, section names;
+ must be less than 10240 */
+
+@f huge extern
+
+@<Definitions that...@>=
+typedef struct name_info {
+ char huge* byte_start; /* beginning of the name in |byte_mem| */
+ @<More elements of |name_info| structure@>@;
+} name_info; /* contains information about an identifier or section name */
+typedef name_info *name_pointer; /* pointer into array of |name_info|s */
+char huge byte_mem[max_bytes]; /* characters of names */
+char huge* byte_mem_end; /* end of |byte_mem| */
+name_info name_dir[max_names]; /* information about names */
+name_pointer name_dir_end = name_dir+max_names-1;
+@z
+
+
+@x Section 29.
+char *byte_ptr; /* first unused position in |byte_mem| */
+@y
+char huge* byte_ptr; /* first unused position in |byte_mem| */
+@z
+
+
+@x Section 30.
+@ @<Init...@>=
+name_dir->byte_start=byte_ptr=byte_mem; /* position zero in both arrays */
+name_ptr=name_dir+1; /* |name_dir[0]| will be used only for error recovery */
+name_ptr->byte_start=byte_mem; /* this makes name 0 of length zero */
+@y
+@ @<Init...@>=
+name_dir->byte_start=byte_ptr=byte_mem; /* position zero in both arrays */
+name_ptr=name_dir+1; /* |name_dir[0]| will be used only for error recovery */
+name_ptr->byte_start=byte_mem; /* this makes name 0 of length zero */
+byte_mem_end = byte_mem+max_bytes-1;
+@z
+
+
+@x Section 42.
+void
+print_section_name(p)
+name_pointer p;
+{
+ char *ss, *s = first_chunk(p);
+@y
+void
+print_section_name(p)
+name_pointer p;
+{
+ char huge* ss, huge* s = first_chunk(p);
+@z
+
+
+@x Section 43.
+void
+sprint_section_name(dest,p)
+ char*dest;
+ name_pointer p;
+{
+ char *ss, *s = first_chunk(p);
+@y
+void
+sprint_section_name(dest,p)
+ char*dest;
+ name_pointer p;
+{
+ char huge* ss, huge* s = first_chunk(p);
+@z
+
+
+@x Section 44.
+void
+print_prefix_name(p)
+name_pointer p;
+{
+ char *s = first_chunk(p);
+@y
+void
+print_prefix_name(p)
+name_pointer p;
+{
+ char huge* s = first_chunk(p);
+@z
+
+
+@x Section 47.
+name_pointer
+add_section_name(par,c,first,last,ispref) /* install a new node in the tree */
+name_pointer par; /* parent of new node */
+int c; /* right or left? */
+char *first; /* first character of section name */
+char *last; /* last character of section name, plus one */
+int ispref; /* are we adding a prefix or a full name? */
+{
+ name_pointer p=name_ptr; /* new node */
+ char *s=first_chunk(p);
+@y
+name_pointer
+add_section_name(par,c,first,last,ispref) /* install a new node in the tree */
+name_pointer par; /* parent of new node */
+int c; /* right or left? */
+char *first; /* first character of section name */
+char *last; /* last character of section name, plus one */
+int ispref; /* are we adding a prefix or a full name? */
+{
+ name_pointer p=name_ptr; /* new node */
+ char huge* s=first_chunk(p);
+@z
+
+
+@x Section 48.
+void
+extend_section_name(p,first,last,ispref)
+name_pointer p; /* name to be extended */
+char *first; /* beginning of extension text */
+char *last; /* one beyond end of extension text */
+int ispref; /* are we adding a prefix or a full name? */
+{
+ char *s;
+@y
+void
+extend_section_name(p,first,last,ispref)
+name_pointer p; /* name to be extended */
+char *first; /* beginning of extension text */
+char *last; /* one beyond end of extension text */
+int ispref; /* are we adding a prefix or a full name? */
+{
+ char huge* s;
+@z
+
+
+@x Section 54.
+int section_name_cmp(pfirst,len,r)
+char **pfirst; /* pointer to beginning of comparison string */
+int len; /* length of string */
+name_pointer r; /* section name being compared */
+{
+ char *first=*pfirst; /* beginning of comparison string */
+ name_pointer q=r+1; /* access to subsequent chunks */
+ char *ss, *s=first_chunk(r);
+@y
+int section_name_cmp(pfirst,len,r)
+char **pfirst; /* pointer to beginning of comparison string */
+int len; /* length of string */
+name_pointer r; /* section name being compared */
+{
+ char *first=*pfirst; /* beginning of comparison string */
+ name_pointer q=r+1; /* access to subsequent chunks */
+ char huge* ss, huge* s=first_chunk(r);
+@z
+
+
+@x Section 55.
+source files, respectively; here we just declare a common field
+|equiv_or_xref| as a pointer to a |char|.
+
+@<More elements of |name...@>=
+char *equiv_or_xref; /* info corresponding to names */
+@y
+source files, respectively. Here we just declare a common field
+|ptr_union| as a union of pointers to |char|, which happen to have
+different addressing attributes.
+
+@<More elements of |name...@>=
+union {
+ char *equiv_member;
+ char huge* xref_member;
+} ptr_union; /* info corresponding to names */
+@z
+
+
+@x Section 69.
+An omitted change file argument means that |"/dev/null"| should be used,
+@y
+An omitted change file argument means that |"NUL"| should be used,
+@z
+
+
+@x Section 70.
+ else if (*s=='/') dot_pos=NULL,name_pos=++s;
+@y
+ else if (*s == ':' || *s == '\\' || *s == '/')
+ dot_pos=NULL,name_pos=++s;
+@z
+
+
+@x Section 70.
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+@y
+ if (found_change<=0) strcpy(change_file_name,"NUL");
+@z
diff --git a/Build/source/texk/web2c/cwebdir/comm-mac.ch b/Build/source/texk/web2c/cwebdir/comm-mac.ch
new file mode 100644
index 00000000000..b9bd408655e
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-mac.ch
@@ -0,0 +1,150 @@
+This is the change file to CWEB's COMMON for porting to Macintoshes.
+No changes to CTANGLE or CWEAVE are needed.
+
+(Contributed 13 Oct 2000 by AndPio@aol.com; slightly edited by Don Knuth)
+
+@x in limbo, change the title page document to specify Mac version
+ \centerline{(Version 3.64)}
+@y
+ \centerline{(Version 3.64 for MacOS)}
+@z
+
+@x section 9: Make input_ln accept \n, \r, \n\r, or \r\n as line endings
+@ In the unlikely event that your standard I/O library does not
+support |feof|, |getc|, and |ungetc| you may have to change things here.
+@^system dependencies@>
+
+@c
+int input_ln(fp) /* copies a line into |buffer| or returns 0 */
+FILE *fp; /* what file to read from */
+{
+ register int c=EOF; /* character read; initialized so some compilers won't complain */
+ register char *k; /* where next character goes */
+ if (feof(fp)) return(0); /* we have hit end-of-file */
+ limit = k = buffer; /* beginning of buffer */
+ while (k<=buffer_end && (c=getc(fp)) != EOF && c!='\n')
+ if ((*(k++) = c) != ' ') limit = k;
+ if (k>buffer_end)
+ if ((c=getc(fp))!=EOF && c!='\n') {
+ ungetc(c,fp); loc=buffer; err_print("! Input line too long");
+@.Input line too long@>
+ }
+ if (c==EOF && limit==buffer) return(0); /* there was nothing after
+ the last newline */
+ return(1);
+}
+@y
+@ In the unlikely event that your standard I/O library does not
+support |feof|, |getc|, and |ungetc| you may have to change things here.
+
+This |input_ln| function accepts |"\n"|, |"\r"|, |"\n\r"| and |"\r\n"| as
+line endings, so that \.{CWEB} will works with ASCII files stored in
+\UNIX/, {\mc DOS} or {\mc MAC} format.
+@^system dependencies@>
+
+@c
+int input_ln(fp) /* copies a line into |buffer| or returns 0 */
+FILE *fp; /* what file to read from */
+{
+ register int c=EOF; /* character read; initialized so some compilers won't complain */
+ register char *k; /* where next character goes */
+ if (feof(fp)) return(0); /* we have hit end-of-file */
+ limit = k = buffer; /* beginning of buffer */
+ while (1) {
+ c = getc(fp);
+ if (c==EOF) return (limit!=buffer); /* 0, if there was nothing after
+ the last newline */
+ else if (c=='\n' || c=='\r') { /* we have hit end-of-line */
+ int d = getc(fp);
+ if (c+d!='\n'+'\r') /* no combination |"\n\r"| or |"\r\n"| */
+ ungetc(d,fp);
+ return (1);
+ }
+ else if (k>buffer_end) {
+ ungetc(c,fp); loc=buffer; err_print("! Input line too long");
+ return (1);
+@.Input line too long@>
+ }
+ else
+ if ((*(k++)=c) != ' ') limit = k;
+ }
+}
+@z
+
+@x section 12, simply return if no change file was specified
+ change_limit=change_buffer; /* this value is used if the change file ends */
+ @<Skip over comment lines in the change file; |return| if end of file@>;
+@y
+ change_limit=change_buffer; /* this value is used if the change file ends */
+ if (change_file_name[0] == '\0') /* no change file specified */
+ return; /* so we have reached the end of that file */
+ @<Skip over comment lines in the change file; |return| if end of file@>;
+@z
+
+@x section 19, don't try to open a change file if none was specified
+if ((change_file=fopen(change_file_name,"r"))==NULL)
+ fatal("! Cannot open change file ", change_file_name);
+@y
+if (change_file_name[0] == '\0') /* no change file specified */
+ change_file = NULL; /* reset at least the |change_file| */
+else if ((change_file=fopen(change_file_name,"r"))==NULL)
+ fatal("! Cannot open change file ", change_file_name);
+@z
+
+@x section 22, declare colon as Mac's path separator
+(Colon-separated paths are not supported.)
+The remainder of the \.{@@i} line after the file name is ignored.
+
+@y
+(Colon-separated path alternatives in the style of \UNIX/ or Kpathsea
+are not supported. On a Macintosh, colons are used to separate the names on
+different levels of a path.)
+The remainder of the \.{@@i} line after the file name is ignored.
+
+@d PATH_SEP ':' /* MacOS pathname separator */
+@^system dependencies@>
+@z
+
+@x section 23, use the path separator constant
+ cur_file_name[l]='/'; /* \UNIX/ pathname separator */
+@y
+ cur_file_name[l]=PATH_SEP; /* pathname separator */
+@z
+
+@x section 69, explain the convention for omitted change files
+An omitted change file argument means that |"/dev/null"| should be used,
+@y
+An omitted change file argument means that no change file should be used,
+@z
+
+@x section 70, use the Metrowerks |ccommand| to access command lines
+ while (--argc > 0) {
+@y
+ argc = ccommand (&argv); /* use Mac interface to command line */
+@^system dependencies@>
+ while (--argc > 0) {
+@z
+@x section 70, use the path separator constant
+ else if (*s=='/') dot_pos=NULL,name_pos=++s;
+@y
+ else if (*s==PATH_SEP) dot_pos=NULL,name_pos=++s;
+@z
+@x section 70, make change file name empty when it is unspecified
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+@y
+ if (found_change<=0) change_file_name[0]='\0'; /* empty string */
+@z
+
+@x section 82, insert an extra module before the index
+@** Index.
+@y by putting the new module here, we preserve all the previous section numbers
+@ We assume an interface to \CEE/ command-line emulation as supplied by
+the |ccommand| function of Metrowerks CodeWarrior, as defined in
+the header file \.{console.h}.
+
+@<Include files@>=
+#include <console.h>
+@^system dependencies@>
+
+@** Index.
+@z
diff --git a/Build/source/texk/web2c/cwebdir/comm-man.ch b/Build/source/texk/web2c/cwebdir/comm-man.ch
new file mode 100644
index 00000000000..c922c036312
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-man.ch
@@ -0,0 +1,22 @@
+Change file to help make Appendix D of the full CWEB manual
+@x
+\def\botofcontents{\vfill
+\noindent
+Copyright \copyright\ 1987, 1990, 1993, 2000 Silvio Levy and Donald E. Knuth
+\bigskip\noindent
+Permission is granted to make and distribute verbatim copies of this
+document provided that the copyright notice and this permission notice
+are preserved on all copies.
+
+\smallskip\noindent
+Permission is granted to copy and distribute modified versions of this
+document under the conditions for verbatim copying, provided that the
+entire resulting derived work is given a different name and distributed
+under the terms of a permission notice identical to this one.
+}
+@y
+\def\botofcontents{\vfill\titlefalse}
+\def\contentspagenumber{28}
+\def\title{APPENDIX D: COMMON}
+\let\K=\leftarrow
+@z
diff --git a/Build/source/texk/web2c/cwebdir/comm-os2.ch b/Build/source/texk/web2c/cwebdir/comm-os2.ch
new file mode 100644
index 00000000000..5e20a6706ce
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-os2.ch
@@ -0,0 +1,24 @@
+This is the change file for CWEB's COMMON under OS/2
+(Contributed by Jim Nutt, jnutt@PrimeNet.Com, May 1995)
+
+These changes tested with WATCOM C v10.0a.
+No changes to CTANGLE or CWEAVE are needed with OS/2.
+
+@x section 69
+An omitted change file argument means that |"/dev/null"| should be used,
+@y
+An omitted change file argument means that |"NUL"| should be used,
+@z
+
+@x section 70 (this change copied from comm-pc.ch)
+ else if (*s=='/') dot_pos=NULL,name_pos=++s;
+@y
+ else if (*s == ':' || *s == '\\' || *s == '/')
+ dot_pos=NULL,name_pos=++s;
+@z
+
+@x section 70
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+@y
+ if (found_change<=0) strcpy(change_file_name,"NUL");
+@z
diff --git a/Build/source/texk/web2c/cwebdir/comm-pc.ch b/Build/source/texk/web2c/cwebdir/comm-pc.ch
new file mode 100644
index 00000000000..e69bafb5244
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-pc.ch
@@ -0,0 +1,33 @@
+This is the change file for CWEB's COMMON under DOS
+(Contributed by Lee Wittenberg, March 1993)
+
+Changes necessary for compiling with Borland C/C++
+Use compilation switches -mc -w-pro -Ff=5000
+
+Note: The change to section 27 is not necessary if using a compiler
+that allows >64K arrays.
+
+@x section 27
+@d max_bytes 90000 /* the number of bytes in identifiers,
+@y
+@d max_bytes (unsigned)60000 /* the number of bytes in identifiers,
+@z
+
+@x section 69
+An omitted change file argument means that |"/dev/null"| should be used,
+@y
+An omitted change file argument means that |"NUL"| should be used,
+@z
+
+@x section 70 (this change copied from comm-bs.ch, July 94)
+ else if (*s=='/') dot_pos=NULL,name_pos=++s;
+@y
+ else if (*s == ':' || *s == '\\' || *s == '/')
+ dot_pos=NULL,name_pos=++s;
+@z
+
+@x section 70
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+@y
+ if (found_change<=0) strcpy(change_file_name,"NUL");
+@z
diff --git a/Build/source/texk/web2c/cwebdir/comm-ql.ch b/Build/source/texk/web2c/cwebdir/comm-ql.ch
new file mode 100644
index 00000000000..8859e215b2a
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-ql.ch
@@ -0,0 +1,332 @@
+This is the change file for CWEB's COMMON under QSOD/SMSQ
+(Contributed by Robert H. Klein, September 1994)
+
+This change file is intended for use with C68 v4.13 (or later).
+compile with
+ex <dev_>cc;'-v -h -c -=500000 -DCWEBINPUTS=flp2_ common_c'
+
+
+
+@x
+\def\v{\char'174} % vertical (|) in typewriter font
+
+\def\title{Common code for CTANGLE and CWEAVE (Version 3.64)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont Common code for {\ttitlefont CTANGLE} and
+ {\ttitlefont CWEAVE}}
+ \vskip 15pt
+ \centerline{(Version 3.64)}
+ \vfill}
+\def\botofcontents{\vfill
+\noindent
+@y
+\def\v{\char'174} % vertical (|) in typewriter font
+
+\def\title{Common code for CTANGLE and CWEAVE (QL Version 3.64)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont Common code for {\ttitlefont CTANGLE} and
+ {\ttitlefont CWEAVE}}
+ \vskip 15pt
+ \centerline{(Version 3.64)}
+ \vfill}
+\def\botofcontents{\vfill
+\noindent
+@z
+
+@x
+The line number of each open file is also kept for error reporting and
+for the benefit of \.{CTANGLE}.
+
+@f line x /* make |line| an unreserved word */
+@d max_include_depth 10 /* maximum number of source files open
+ simultaneously, not counting the change file */
+@d max_file_name_length 60
+@d cur_file file[include_depth] /* current file */
+@d cur_file_name file_name[include_depth] /* current file name */
+@d cur_line line[include_depth] /* number of current line in current file */
+@d web_file file[0] /* main source file */
+@d web_file_name file_name[0] /* main source file name */
+@y
+The line number of each open file is also kept for error reporting and
+for the benefit of \.{CTANGLE}.
+
+For use on QDOS/SMSQ systems the variable |max_file_name_length| is shortened
+to 42 characters, i.e. 5 characters for the device name, 36 characters
+for the file name plus one character as string terminator. (Note that
+(current) QDOS/SMSQ file systems have a limitation of 36 characters as
+maximum length for a file name.
+
+@f line x /* make |line| an unreserved word */
+@d max_include_depth 10 /* maximum number of source files open
+ simultaneously, not counting the change file */
+@d max_file_name_length 42
+@d cur_file file[include_depth] /* current file */
+@d cur_file_name file_name[include_depth] /* current file name */
+@d cur_line line[include_depth] /* number of current line in current file */
+@d web_file file[0] /* main source file */
+@d web_file_name file_name[0] /* main source file name */
+@z
+
+
+@x
+ cur_file_name[l]='/'; /* \UNIX/ pathname separator */
+@y
+ cur_file_name[l]='_'; /* QDOS/SMSQ pathname separator */
+@z
+
+
+@x
+@ We now must look at the command line arguments and set the file names
+accordingly. At least one file name must be present: the \.{CWEB}
+file. It may have an extension, or it may omit the extension to get |".w"| or
+|".web"| added. The \TEX/ output file name is formed by replacing the \.{CWEB}
+file name extension by |".tex"|, and the \CEE/ file name by replacing
+the extension by |".c"|, after removing the directory name (if any).
+
+If there is a second file name present among the arguments, it is the
+change file, again either with an extension or without one to get |".ch"|.
+An omitted change file argument means that |"/dev/null"| should be used,
+when no changes are desired.
+@^system dependencies@>
+
+If there's a third file name, it will be the output file.
+
+@<Pred...@>=
+void scan_args();
+
+@ @c
+void
+scan_args()
+{
+ char *dot_pos; /* position of |'.'| in the argument */
+ char *name_pos; /* file name beginning, sans directory */
+ register char *s; /* register for scanning strings */
+ boolean found_web=0,found_change=0,found_out=0;
+ /* have these names have been seen? */
+ boolean flag_change;
+
+ while (--argc > 0) {
+ if ((**(++argv)=='-'||**argv=='+')&&*(*argv+1)) @<Handle flag argument@>@;
+ else {
+ s=name_pos=*argv;@+dot_pos=NULL;
+ while (*s) {
+ if (*s=='.') dot_pos=s++;
+ else if (*s=='/') dot_pos=NULL,name_pos=++s;
+ else s++;
+ }
+ if (!found_web) @<Make
+ |web_file_name|, |tex_file_name| and |C_file_name|@>@;
+ else if (!found_change) @<Make |change_file_name| from |fname|@>@;
+ else if (!found_out) @<Override |tex_file_name| and |C_file_name|@>@;
+ else @<Print usage error message and quit@>;
+ }
+ }
+ if (!found_web) @<Print usage error message and quit@>;
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+}
+
+@ We use all of |*argv| for the |web_file_name| if there is a |'.'| in it,
+otherwise we add |".w"|. If this file can't be opened, we prepare an
+|alt_web_file_name| by adding |"web"| after the dot.
+The other file names come from adding other things
+after the dot. We must check that there is enough room in
+|web_file_name| and the other arrays for the argument.
+
+@<Make |web_file_name|...@>=
+{
+ if (s-*argv > max_file_name_length-5)
+ @<Complain about argument length@>;
+ if (dot_pos==NULL)
+ sprintf(web_file_name,"%s.w",*argv);
+ else {
+ strcpy(web_file_name,*argv);
+ *dot_pos=0; /* string now ends where the dot was */
+ }
+ sprintf(alt_web_file_name,"%s.web",*argv);
+ sprintf(tex_file_name,"%s.tex",name_pos); /* strip off directory name */
+ sprintf(idx_file_name,"%s.idx",name_pos);
+ sprintf(scn_file_name,"%s.scn",name_pos);
+ sprintf(C_file_name,"%s.c",name_pos);
+ found_web=1;
+}
+
+@ @<Make |change_file_name|...@>=
+{
+ if (strcmp(*argv,"-")==0) found_change=-1;
+ else {
+ if (s-*argv > max_file_name_length-4)
+ @<Complain about argument length@>;
+ if (dot_pos==NULL)
+ sprintf(change_file_name,"%s.ch",*argv);
+ else strcpy(change_file_name,*argv);
+ found_change=1;
+ }
+}
+
+@ @<Override...@>=
+{
+ if (s-*argv > max_file_name_length-5)
+ @<Complain about argument length@>;
+ if (dot_pos==NULL) {
+ sprintf(tex_file_name,"%s.tex",*argv);
+ sprintf(idx_file_name,"%s.idx",*argv);
+ sprintf(scn_file_name,"%s.scn",*argv);
+ sprintf(C_file_name,"%s.c",*argv);
+ } else {
+ strcpy(tex_file_name,*argv);
+ strcpy(C_file_name,*argv);
+ if (flags['x']) { /* indexes will be generated */
+ *dot_pos=0;
+ sprintf(idx_file_name,"%s.idx",*argv);
+ sprintf(scn_file_name,"%s.scn",*argv);
+ }
+ }
+ found_out=1;
+}
+@y
+@ We now must look at the command line arguments and set the file names
+accordingly. At least one file name must be present: the \.{CWEB}
+file. It may have an extension, or it may omit the extension to get |"_w"| or
+|"_web"| added. The \TEX/ output file name is formed by replacing the \.{CWEB}
+file name extension by |"_tex"|, and the \CEE/ file name by replacing
+the extension by |"_c"|, after removing the directory name (if any).
+
+If there is a second file name present among the arguments, it is the
+change file, again either with an extension or without one to get |"_ch"|.
+An omitted change file argument means that |"NUL"| should be used,
+when no changes are desired.
+@^system dependencies@>
+
+If there's a third file name, it will be the output file.
+
+Because |"_"| is a directory {\em and} extension separator, \.{CWEB} will
+always use the {\em full} name (i.e. with full path). Fortunately the
+routine has been written to search for the last ``dot'', so the altered
+version will search for the last |"_"| (including directory separators),
+so we have what we want.
+
+@<Pred...@>=
+void scan_args();
+
+@ @c
+void
+scan_args()
+{
+ char *dot_pos; /* position of |'_'| in the argument */
+ char *name_pos; /* file name beginning, sans directory */
+ register char *s; /* register for scanning strings */
+ boolean found_web=0,found_change=0,found_out=0;
+ /* have these names have been seen? */
+ boolean flag_change;
+
+ while (--argc > 0) {
+ if ((**(++argv)=='-'||**argv=='+')&&*(*argv+1)) @<Handle flag argument@>@;
+ else {
+ s=name_pos=*argv;@+dot_pos=NULL;
+ while (*s) {
+ if (*s=='_') dot_pos=s++;
+ else if (*s=='_') dot_pos=NULL,name_pos=++s;
+ else s++;
+ }
+ if (!found_web) @<Make
+ |web_file_name|, |tex_file_name| and |C_file_name|@>@;
+ else if (!found_change) @<Make |change_file_name| from |fname|@>@;
+ else if (!found_out) @<Override |tex_file_name| and |C_file_name|@>@;
+ else @<Print usage error message and quit@>;
+ }
+ }
+ if (!found_web) @<Print usage error message and quit@>;
+ if (found_change<=0) strcpy(change_file_name,"NUL");
+}
+
+@ We use all of |*argv| for the |web_file_name| if there is a |'_'| in it,
+otherwise we add |"_w"|. If this file can't be opened, we prepare an
+|alt_web_file_name| by adding |"web"| after the dot.
+The other file names come from adding other things
+after the dot. We must check that there is enough room in
+|web_file_name| and the other arrays for the argument.
+
+If you've read the section before carefully you'll have noticed, that
+QDOS/SMSQ file names contain almost a |"_"|, so this routine will not work,
+i.e. you'll {\em have} to add the |"_w"| always. Nevertheless I adapted
+the routine as if it would work.
+
+@<Make |web_file_name|...@>=
+{
+ if (s-*argv > max_file_name_length-5)
+ @<Complain about argument length@>;
+ if (dot_pos==NULL)
+ sprintf(web_file_name,"%s_w",*argv);
+ else {
+ strcpy(web_file_name,*argv);
+ *dot_pos=0; /* string now ends where the dot was */
+ }
+ sprintf(alt_web_file_name,"%s_web",*argv);
+ sprintf(tex_file_name,"%s_tex",name_pos); /* strip off directory name */
+ sprintf(idx_file_name,"%s_idx",name_pos);
+ sprintf(scn_file_name,"%s_scn",name_pos);
+ sprintf(C_file_name,"%s_c",name_pos);
+ found_web=1;
+}
+
+@ @<Make |change_file_name|...@>=
+{
+ if (strcmp(*argv,"-")==0) found_change=-1;
+ else {
+ if (s-*argv > max_file_name_length-4)
+ @<Complain about argument length@>;
+ if (dot_pos==NULL)
+ sprintf(change_file_name,"%s_ch",*argv);
+ else strcpy(change_file_name,*argv);
+ found_change=1;
+ }
+}
+
+@ @<Override...@>=
+{
+ if (s-*argv > max_file_name_length-5)
+ @<Complain about argument length@>;
+ if (dot_pos==NULL) {
+ sprintf(tex_file_name,"%s_tex",*argv);
+ sprintf(idx_file_name,"%s_idx",*argv);
+ sprintf(scn_file_name,"%s_scn",*argv);
+ sprintf(C_file_name,"%s_c",*argv);
+ } else {
+ strcpy(tex_file_name,*argv);
+ strcpy(C_file_name,*argv);
+ if (flags['x']) { /* indexes will be generated */
+ *dot_pos=0;
+ sprintf(idx_file_name,"%s_idx",*argv);
+ sprintf(scn_file_name,"%s_scn",*argv);
+ }
+ }
+ found_out=1;
+}
+@z
+
+
+@x
+@ @<Print usage error message and quit@>=
+{
+if (program==ctangle)
+ fatal(
+"! Usage: ctangle [options] webfile[.w] [{changefile[.ch]|-} [outfile[.c]]]\n"
+ ,"");
+@.Usage:@>
+else fatal(
+"! Usage: cweave [options] webfile[.w] [{changefile[.ch]|-} [outfile[.tex]]]\n"
+ ,"");
+}
+@y
+@ @<Print usage error message and quit@>=
+{
+if (program==ctangle)
+ fatal(
+"! Usage: ctangle [options] webfile[_w] [{changefile[_ch]|-} [outfile[_c]]]\n"
+ ,"");
+@.Usage:@>
+else fatal(
+"! Usage: cweave [options] webfile[_w] [{changefile[_ch]|-} [outfile[_tex]]]\n"
+ ,"");
+}
+@z
diff --git a/Build/source/texk/web2c/cwebdir/comm-vms.ch b/Build/source/texk/web2c/cwebdir/comm-vms.ch
new file mode 100644
index 00000000000..cd5fe524393
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-vms.ch
@@ -0,0 +1,81 @@
+This is the change file for CWEB's COMMON under VAX/VMS.
+
+created:
+ 1987 BL (Bjorn Larsen, University of Oslo)
+
+modified:
+ 01-FEB-1992 ST (Stephan Trebels <trebels@ams02.dnet.gwdg.de>)
+ > include ctype,stdio,ssdef from textlibrary SYS$SHARE:VAXCDEF.TLB
+ > change error return code to SS$_ABORT
+ (perhaps better than %NONAME-E-NOMSG, Message number 2 )
+
+(also modified by Don Knuth to match changes in the master file)
+(only the two changes by BL are necessary for initial bootstrapping
+ via hand-editing of common.c)
+
+@x section 5 (01-FEB-1992 ST)
+#include <ctype.h>
+@y
+#include ctype /* VMS searches Textlibraries faster */
+@z
+
+@x section 8 (01-FEB-1992 ST)
+#include <stdio.h>
+@y
+#include stdio /* VMS searches Textlibraries faster */
+@z
+
+@x section 61 (01-FEB-1992 ST)
+programs are started. Here, for instance, we pass the operating system
+a status of 0 if and only if only harmless messages were printed.
+@y
+programs are started. Here, for instance, we pass VAX/VMS
+a status of |SS$_NORMAL| if and only if only harmless
+messages have been printed.
+A suitable status to signal an error condition to VAX/VMS could be
+|SS$_ABORT|, telling the operating system to
+print |"%SYSTEM-F-ABORT, abort"|, if |history > harmless_message|.
+@z
+
+@x section 61 (1987 BL) (01-FEB-1992 ST) (11-JAN-1993 DEK)
+ if (history > harmless_message) return(1);
+ else return(0);
+@y
+/*
+ VAX/VMS and UNIX have different error status conventions.
+ VAX/VMS uses odd values (for example |SS$_NORMAL|) to indicate success,
+ even values indicate errors, resulting in messages displayed
+ on the screen. |SS$_ABORT| has been chosen, to indicate an
+ error and display something that's not complete nonsense.
+*/
+ if (history > harmless_message) exit(SS$_ABORT);
+ else exit(SS$_NORMAL);
+@z
+
+@x section 69 (01-FEB-1992 ST)
+An omitted change file argument means that |"/dev/null"| should be used,
+when no changes are desired.
+@y
+An omitted change file argument means that the
+null device |"NL:"| should be used, when no changes are desired.
+@z
+
+@x section 70 (1987 BL) (01-FEB-1992 ST) (05-APR-1992 DEK)
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+@y
+ if (found_change<=) strcpy(change_file_name,"NL:");
+ /* {\tt NL:} is the VAX/VMS notation for {\tt /dev/null} */
+@z
+
+@x section 82 (01-FEB-1992 ST)
+@** Index.
+@y
+@* VAX/VMS specific code.
+We have used |SS$_NORMAL| and |SS$_ABORT| as return codes,
+so we have to include the system message codes.
+
+@<Include files@>=
+#include ssdef /* we need VAX/VMS system messages */
+
+@** Index.
+@z
diff --git a/Build/source/texk/web2c/cwebdir/comm-w2c.ch b/Build/source/texk/web2c/cwebdir/comm-w2c.ch
new file mode 100644
index 00000000000..2a80aca53c6
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-w2c.ch
@@ -0,0 +1,620 @@
+% Kpathsea changes for CWEB by Wlodek Bzyl and Olaf Weber
+% Copyright 2002 Wlodek Bzyl and Olaf Weber
+% This file is in the Public Domain.
+
+@x l.20
+\def\title{Common code for CTANGLE and CWEAVE (Version 3.64)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont Common code for {\ttitlefont CTANGLE} and
+ {\ttitlefont CWEAVE}}
+ \vskip 15pt
+ \centerline{(Version 3.64)}
+ \vfill}
+@y
+\def\Kpathsea/{{\mc KPATHSEA\spacefactor1000}}
+\def\title{Common code for CTANGLE and CWEAVE (Version 3.64k)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont Common code for {\ttitlefont CTANGLE} and
+ {\ttitlefont CWEAVE}}
+ \vskip 15pt
+ \centerline{(Version 3.64k)}
+ \vfill}
+@z
+
+This change can not be applied when `tie' is used
+(TOC file can not be typeset).
+
+%@x l.42
+%\let\maybe=\iftrue
+%@y
+%\let\maybe=\iffalse % print only changed modules
+%@z
+
+
+Section 2.
+We use the definition from `kpathsea/types.h':
+
+ typedef enum { false = 0, true = 1 } boolean;
+
+Note that this definition also occurs in common.h.
+@x l.74
+typedef short boolean;
+@y
+@z
+
+
+Section 4.
+
+@x l.91
+common_init()
+@y
+common_init P1H(void)
+@z
+
+@x l.93
+ @<Initialize pointers@>;
+@y
+ @<Initialize pointers@>;
+ @<Set up |PROGNAME| feature and initialize the search path mechanism@>;
+@z
+
+Section 9.
+
+@x l.173
+int input_ln(fp) /* copies a line into |buffer| or returns 0 */
+FILE *fp; /* what file to read from */
+@y
+int input_ln P1C(FILE *, fp) /* copies a line into |buffer| or returns 0 */
+@z
+
+Section 10.
+
+@x l.207 - max_file_name_length is way too small.
+@d max_file_name_length 60
+@y
+@d max_file_name_length 1024
+@z
+
+@x l.221 - no alt_web_file_name needed.
+char alt_web_file_name[max_file_name_length]; /* alternate name to try */
+@y
+@z
+
+Section 12.
+
+@x l.254
+prime_the_change_buffer()
+@y
+prime_the_change_buffer P1H(void)
+@z
+
+Section 16.
+
+@x l.322
+check_change() /* switches to |change_file| if the buffers match */
+@y
+check_change P1H(void) /* switches to |change_file| if the buffers match */
+@z
+
+Section 18.
+
+@x l.380
+reset_input()
+@y
+reset_input P1H(void)
+@z
+
+Section 19.
+
+@x l.394
+if ((web_file=fopen(web_file_name,"r"))==NULL) {
+ strcpy(web_file_name,alt_web_file_name);
+ if ((web_file=fopen(web_file_name,"r"))==NULL)
+ fatal("! Cannot open input file ", web_file_name);
+}
+@y
+if ((found_filename=kpse_find_cweb(web_file_name))==NULL ||
+ (web_file=fopen(found_filename,"r"))==NULL) {
+ fatal("! Cannot open input file ", web_file_name);
+} else if (strlen(found_filename) < max_file_name_length) {
+ strcpy(web_file_name, found_filename);
+ free(found_filename);
+}
+@z
+
+@x l.402
+if ((change_file=fopen(change_file_name,"r"))==NULL)
+ fatal("! Cannot open change file ", change_file_name);
+@y
+if ((found_filename=kpse_find_cweb(change_file_name))==NULL ||
+ (change_file=fopen(found_filename,"r"))==NULL) {
+ fatal("! Cannot open change file ", change_file_name);
+} else if (strlen(found_filename) < max_file_name_length) {
+ strcpy(change_file_name, found_filename);
+ free(found_filename);
+}
+@z
+
+Section 21.
+
+@x l.427
+int get_line() /* inputs the next line */
+@y
+int get_line P1H(void) /* inputs the next line */
+@z
+
+Section 22.
+
+@x l.472
+#include <stdlib.h> /* declaration of |getenv| and |exit| */
+@y
+#include <stdlib.h> /* declaration of |getenv| and |exit| */
+#define CWEB
+#include "cpascal.h"
+#include <kpathsea/kpathsea.h> /* include every \Kpathsea/ header */
+#include "help.h"
+
+@ The \.{ctangle} and \.{cweave} programs from the original \.{CWEB}
+package use the compile-time default directory or the value of the
+environment variable \.{CWEBINPUTS} as an alternative place to be
+searched for files, if they could not be found in the current
+directory.
+
+This version uses the \Kpathsea/ mechanism for searching files.
+The directories to be searched for come from three sources:
+
+ (a)~a user-set environment variable \.{CWEBINPUTS}
+ (overriden by \.{CWEBINPUTS\_cweb});\par
+ (b)~a line in \Kpathsea/ configuration file \.{texmf.cnf},\hfil\break
+ e.g. \.{CWEBINPUTS=.:$TEXMF/texmf/cweb//}
+ or \.{CWEBINPUTS.cweb=.:$TEXMF/texmf/cweb//};\hangindent=2\parindent\par
+ (c)~compile-time default directories \.{.:$TEXMF/texmf/cweb//}
+ (specified in \.{texmf.in}).
+
+
+@d kpse_find_cweb(name) kpse_find_file(name,kpse_cweb_format,true)
+
+@ The simple file searching is replaced by `path searching' mechanism
+that \Kpathsea/ library provides.
+
+We set |kpse_program_name| to a |"cweb"|. This means if the
+variable |CWEBINPUTS.cweb| is present in \.{texmf.cnf} (or |CWEBINPUTS_cweb|
+in the environment) its value will be used as the search path for
+filenames. This allows different flawors of \.{CWEB} to have
+different search paths.
+
+FIXME: Not sure this is the best way to go about this.
+
+@<Set up |PROGNAME| feature and initialize the search path mechanism@>=
+kpse_set_program_name(argv[0], "cweb");
+@z
+
+
+Section 23.
+
+@x l.475
+ char temp_file_name[max_file_name_length];
+ char *cur_file_name_end=cur_file_name+max_file_name_length-1;
+ char *k=cur_file_name, *kk;
+ int l; /* length of file name */
+@y
+ char *cur_file_name_end=cur_file_name+max_file_name_length-1;
+ char *k=cur_file_name;
+@z
+
+@x l.489
+ if ((cur_file=fopen(cur_file_name,"r"))!=NULL) {
+@y
+ if ((found_filename=kpse_find_cweb(cur_file_name))!=NULL &&
+ (cur_file=fopen(found_filename,"r"))!=NULL) {
+ /* Copy name for #line directives. */
+ if (strlen(found_filename) < max_file_name_length) {
+ strcpy(cur_file_name, found_filename);
+ free(found_filename);
+ }
+@z
+
+Replaced by Kpathsea `kpse_find_file'
+
+@x l.493
+ kk=getenv("CWEBINPUTS");
+ if (kk!=NULL) {
+ if ((l=strlen(kk))>max_file_name_length-2) too_long();
+ strcpy(temp_file_name,kk);
+ }
+ else {
+#ifdef CWEBINPUTS
+ if ((l=strlen(CWEBINPUTS))>max_file_name_length-2) too_long();
+ strcpy(temp_file_name,CWEBINPUTS);
+#else
+ l=0;
+#endif /* |CWEBINPUTS| */
+ }
+ if (l>0) {
+ if (k+l+2>=cur_file_name_end) too_long();
+@.Include file name ...@>
+ for (; k>= cur_file_name; k--) *(k+l+1)=*k;
+ strcpy(cur_file_name,temp_file_name);
+ cur_file_name[l]='/'; /* \UNIX/ pathname separator */
+ if ((cur_file=fopen(cur_file_name,"r"))!=NULL) {
+ cur_line=0; print_where=1;
+ goto restart; /* success */
+ }
+ }
+@y
+@z
+
+Section 26.
+
+@x l.571
+check_complete(){
+@y
+check_complete P1H(void) {
+@z
+
+Section 33.
+
+@x l.651
+extern int names_match();
+@y
+extern int names_match P4H(name_pointer, char*, int, char);
+@z
+
+Section 35.
+
+@x l.661
+id_lookup(first,last,t) /* looks up a string in the identifier table */
+char *first; /* first character of string */
+char *last; /* last character of string plus one */
+char t; /* the |ilk|; used by \.{CWEAVE} only */
+@y
+/* looks up a string in the identifier table */
+id_lookup P3C(char*,first, char*,last, char,t)
+@z
+
+Section 38.
+
+@x l.704
+void init_p();
+@y
+extern void init_p P2C(name_pointer,p, char,t);
+@z
+
+Section 42.
+
+@x l.766
+print_section_name(p)
+name_pointer p;
+@y
+print_section_name P1C(name_pointer, p)
+@z
+
+Section 43.
+
+@x l.785
+sprint_section_name(dest,p)
+ char*dest;
+ name_pointer p;
+@y
+sprint_section_name P2C(char*,dest, name_pointer,p)
+@z
+
+Section 44.
+
+@x l.806
+print_prefix_name(p)
+name_pointer p;
+@y
+print_prefix_name P1C(name_pointer,p)
+@z
+
+Section 45.
+
+@x l.826
+int web_strcmp(j,j_len,k,k_len) /* fuller comparison than |strcmp| */
+ char *j, *k; /* beginning of first and second strings */
+ int j_len, k_len; /* length of strings */
+@y
+/* fuller comparison than |strcmp| */
+int web_strcmp P4C(char*,j, int,j_len, char*,k, int,k_len)
+@z
+
+Section 46.
+
+@x l.853
+extern void init_node();
+@y
+extern void init_node P1C(name_pointer,node);
+@z
+
+Section 47.
+
+@x l.857
+add_section_name(par,c,first,last,ispref) /* install a new node in the tree */
+name_pointer par; /* parent of new node */
+int c; /* right or left? */
+char *first; /* first character of section name */
+char *last; /* last character of section name, plus one */
+int ispref; /* are we adding a prefix or a full name? */
+@y
+/* install a new node in the tree */
+add_section_name P5C(name_pointer,par, int,c, char*,first, char*,last,
+ int,ispref)
+@z
+
+Section 48.
+
+@x l.886
+extend_section_name(p,first,last,ispref)
+name_pointer p; /* name to be extended */
+char *first; /* beginning of extension text */
+char *last; /* one beyond end of extension text */
+int ispref; /* are we adding a prefix or a full name? */
+@y
+extend_section_name P4C(name_pointer,p, char*,first, char*,last, int,ispref)
+@z
+
+Section 49.
+
+@x l.914
+section_lookup(first,last,ispref) /* find or install section name in tree */
+char *first, *last; /* first and last characters of new name */
+int ispref; /* is the new name a prefix or a full name? */
+@y
+/* find or install section name in tree */
+section_lookup P3C(char*,first, char*,last, int,ispref)
+@z
+
+Section 53.
+
+@x l.1018
+int section_name_cmp();
+@y
+int section_name_cmp P3H(char**, int, name_pointer);
+@z
+
+Section 54.
+
+@x l.1021
+int section_name_cmp(pfirst,len,r)
+char **pfirst; /* pointer to beginning of comparison string */
+int len; /* length of string */
+name_pointer r; /* section name being compared */
+@y
+int section_name_cmp P3C(char**,pfirst, int,len, name_pointer,r)
+@z
+
+Section 57.
+
+@x l.1093
+void err_print();
+@y
+void err_print P1H(char*);
+@z
+
+Section 58.
+
+@x l.1098
+err_print(s) /* prints `\..' and location of error message */
+char *s;
+@y
+err_print P1C(char*,s) /* prints `\..' and location of error message */
+@z
+
+Section 60.
+
+@x l.1141
+int wrap_up();
+extern void print_stats();
+@y
+int wrap_up P1H(void);
+extern void print_stats P1H(void);
+@z
+
+Section 61.
+
+@x l.1151
+int wrap_up() {
+@y
+int wrap_up P1H(void) {
+@z
+
+Section 63.
+
+@x l.1174
+void fatal(), overflow();
+@y
+void fatal P2H(char*,char*);
+void overflow(char*);
+@z
+
+Section 64.
+
+@x l.1180
+fatal(s,t)
+ char *s,*t;
+@y
+fatal P2C(char*,s, char*,t)
+@z
+
+Section 65.
+
+@x l.1191
+overflow(t)
+ char *t;
+@y
+overflow P1C(char*,t)
+@z
+
+Section 67.
+
+@x l.1212
+the names of those files. Most of the 128 flags are undefined but available
+for future extensions.
+@y
+the names of those files. Most of the 128 flags are undefined but available
+for future extensions.
+
+We use `kpathsea' library functions to find literate sources and
+NLS configuration files. When the files you expect are not
+being found, the thing to do is to enable `kpathsea' runtime
+debugging by assigning to |kpathsea_debug| variable a small number
+via `\.{-d}' option. The meaning of number is shown below. To set
+more than one debugging options sum the corresponding numbers.
+$$\halign{\hskip5em\tt\hfil#&&\qquad\tt#\cr
+ 1&report `\.{stat}' calls\cr
+ 2&report lookups in all hash tables\cr
+ 4&report file openings and closings\cr
+ 8&report path information\cr
+16&report directory list\cr
+32&report on each file search\cr
+64&report values of variables being looked up\cr}$$
+Debugging output is always written to |stderr|, and begins with the string
+`\.{kdebug:}'.
+@z
+
+@x l.1218
+@d show_happiness flags['h'] /* should lack of errors be announced? */
+@y
+@d show_happiness flags['h'] /* should lack of errors be announced? */
+@d show_kpathsea_debug flags['d']
+ /* should results of file searching be shown? */
+@z
+
+@x l.1234
+show_banner=show_happiness=show_progress=1;
+@y
+show_banner=show_happiness=show_progress=1;
+@z
+
+Section 69.
+
+@x l.1252
+void scan_args();
+@y
+void scan_args P1H(void);
+@z
+
+
+Section 70.
+
+@x l.1257
+scan_args()
+@y
+scan_args P1H(void)
+@z
+
+
+Section 71.
+
+@x l.1282 - use a define for /dev/null
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+@y
+ if (found_change<=0) strcpy(change_file_name,DEV_NULL);
+@z
+
+@x l.1302 - no alt_web_file_name
+ sprintf(alt_web_file_name,"%s.web",*argv);
+@y
+@z
+
+
+Section 74.
+
+@x l.1344
+@ @<Handle flag...@>=
+{
+@y
+@ @<Handle flag...@>=
+{
+ if (strcmp("-help",*argv)==0 || strcmp("--help",*argv)==0)
+ @<Display help message and exit@>;
+ if (strcmp("-version",*argv)==0 || strcmp("--version",*argv)==0)
+ @<Display version information and exit@>;
+@z
+
+@x l.1347
+ else flag_change=1;
+@y
+ else flag_change=1;
+ if (*(*argv+1)=='d')
+ if (sscanf(*argv+2,"%u",&kpathsea_debug)!=1) @<Print usage error...@>;
+@z
+
+@x l.1349
+ flags[*dot_pos]=flag_change;
+@y
+ flags[(unsigned char)*dot_pos]=flag_change;
+@z
+
+Section 75.
+
+@x l.1354
+if (program==ctangle)
+ fatal(
+"! Usage: ctangle [options] webfile[.w] [{changefile[.ch]|-} [outfile[.c]]]\n"
+ ,"");
+@.Usage:@>
+else fatal(
+"! Usage: cweave [options] webfile[.w] [{changefile[.ch]|-} [outfile[.tex]]]\n"
+ ,"");
+@y
+if (program==ctangle) {
+ fprintf(stderr, "ctangle: Need one to three file arguments.\n");
+ usage("ctangle");
+} else {
+ fprintf(stderr, "cweave: Need one to three file arguments.\n");
+ usage("cweave");
+}
+@z
+
+Section 77.
+
+@x l.1375
+FILE *active_file; /* currently active file for \.{CWEAVE} output */
+@y
+FILE *active_file; /* currently active file for \.{CWEAVE} output */
+char *found_filename; /* filename found by |kpse_find_file| */
+@z
+
+
+Section 81. (removed)
+
+@x l.1403
+@ We predeclare several standard system functions here instead of including
+their system header files, because the names of the header files are not as
+standard as the names of the functions. (For example, some \CEE/ environments
+have \.{<string.h>} where others have \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern int strcmp(); /* compare strings lexicographically */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+@y
+@z
+
+@x
+@** Index.
+@y
+@** System dependent changes.
+
+@ Modules for dealing with help messages and version info.
+
+@<Display help message and exit@>=
+usagehelp(program==ctangle ? CTANGLEHELP : CWEAVEHELP, NULL);
+@.--help@>
+
+@ Will have to change these if the version numbers change (ouch).
+
+@d ctangle_banner "This is CTANGLE, Version 3.64"
+@d cweave_banner "This is CWEAVE, Version 3.64"
+
+@<Display version information and exit@>=
+printversionandexit((program==ctangle ? ctangle_banner : cweave_banner),
+ "Silvio Levy and Donald E. Knuth", NULL);
+@.--version@>
+
+@** Index.
+@z
diff --git a/Build/source/texk/web2c/cwebdir/comm-w32.ch b/Build/source/texk/web2c/cwebdir/comm-w32.ch
new file mode 100644
index 00000000000..b300f496d2b
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/comm-w32.ch
@@ -0,0 +1,94 @@
+This is the change file for CWEB's COMMON under Win32
+(Contributed by Fabrice Popineau, February 2002 <Fabrice.Popineau@supelec.fr>)
+
+The Microsoft C compiler included in Visual Studio allows for different
+parameter passing conventions than the standard one. This is actually
+specified with the Intel IA32 architecture. There exist three
+calling conventions under the IA32 architecture as defined by Intel.
+
+One of them is the standard C calling convention: Parameters are passed on
+the stack, calling function is responsible to unstack arguments. Names are
+decorated with a prefixed underscore. It is called the __cdecl convention.
+
+Another calling convention is the __fastcall convention. The first two 32bits
+arguments are passed on the stack. The called function is responsible for
+stack maintenance. Names are decorated with an @ sign as prefix, and another
+@ sign followed by the size of the arguments as suffix.
+
+The third one is the __stdcall convention and is basically the Pascal calling
+convention.
+
+Using the __fastcall convention is usually faster on Intel architecture. Names
+are decorated because obviously a __cdecl function can't behave the same way
+as a __fastcall one of the same prototype. So the new full prototype includes
+the keyword __cdecl or __fastcall. A compiler option allows to compile all
+functions using one or the other calling convention. If you compile using
+__fastcall, then you are bound to explicitly declare a few functions as
+__cdecl : the ones that are passed to the C library (like function pointers
+for qsort() or signal()) or functions that replace functions from the C
+library, because the standard headers have a __cdecl prototype for these
+functions. Also, you cannot declare a library function without giving it the
+exact prototype used in the library headers files. So you'd better use the
+header files to be safe.
+
+Admittedly, this is not vital for cweb, except that I build the whole texlive
+set of programs using the __fastcall convention.
+
+@x
+@<Include files@>=
+#include <ctype.h>
+@y
+@<Include files@>=
+#include <ctype.h>
+#include <string.h>
+@z
+
+@x
+@ @<Predec...@>=
+extern int names_match();
+@y
+@ @<Predec...@>=
+extern int __cdecl names_match();
+@z
+
+@x
+@<Pred...@>=
+void init_p();
+@y
+@<Pred...@>=
+void __cdecl init_p();
+@z
+
+@x section 69
+An omitted change file argument means that |"/dev/null"| should be used,
+@y
+An omitted change file argument means that |"NUL"| should be used,
+@z
+
+@x section 70 (this change copied from comm-bs.ch, July 94)
+ else if (*s=='/') dot_pos=NULL,name_pos=++s;
+@y
+ else if (*s == ':' || *s == '\\' || *s == '/')
+ dot_pos=NULL,name_pos=++s;
+@z
+
+@x section 70
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+@y
+ if (found_change<=0) strcpy(change_file_name,"NUL");
+@z
+
+@x
+@ We predeclare several standard system functions here instead of including
+their system header files, because the names of the header files are not as
+standard as the names of the functions. (For example, some \CEE/ environments
+have \.{<string.h>} where others have \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern int strcmp(); /* compare strings lexicographically */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+@y
+@z
diff --git a/Build/source/texk/web2c/cwebdir/common.c b/Build/source/texk/web2c/cwebdir/common.c
new file mode 100644
index 00000000000..8fca7c63335
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/common.c
@@ -0,0 +1,1242 @@
+/*1:*/
+#line 58 "common.w"
+
+/*5:*/
+#line 102 "common.w"
+
+#include <ctype.h>
+
+/*:5*//*8:*/
+#line 165 "common.w"
+
+#include <stdio.h>
+
+/*:8*//*22:*/
+#line 471 "common.w"
+
+#include <stdlib.h>
+
+/*:22*/
+#line 59 "common.w"
+
+#define ctangle 0
+#define cweave 1 \
+
+#define and_and 04
+#define lt_lt 020
+#define gt_gt 021
+#define plus_plus 013
+#define minus_minus 01
+#define minus_gt 031
+#define not_eq 032
+#define lt_eq 034
+#define gt_eq 035
+#define eq_eq 036
+#define or_or 037
+#define dot_dot_dot 016
+#define colon_colon 06
+#define period_ast 026
+#define minus_gt_ast 027 \
+
+#define buf_size 100
+#define longest_name 1000
+#define long_buf_size (buf_size+longest_name)
+#define xisspace(c) (isspace(c) &&((unsigned char) c<0200) )
+#define xisupper(c) (isupper(c) &&((unsigned char) c<0200) ) \
+
+#define max_include_depth 10 \
+
+#define max_file_name_length 60
+#define cur_file file[include_depth]
+#define cur_file_name file_name[include_depth]
+#define cur_line line[include_depth]
+#define web_file file[0]
+#define web_file_name file_name[0] \
+
+#define lines_dont_match (change_limit-change_buffer!=limit-buffer|| \
+strncmp(buffer,change_buffer,limit-buffer) ) \
+
+#define if_section_start_make_pending(b) {*limit= '!'; \
+for(loc= buffer;xisspace(*loc) ;loc++) ; \
+*limit= ' '; \
+if(*loc=='@'&&(xisspace(*(loc+1) ) ||*(loc+1) =='*') ) change_pending= b; \
+} \
+
+#define max_sections 2000 \
+ \
+
+#define too_long() {include_depth--; \
+err_print("! Include file name too long") ;goto restart;} \
+
+#define max_bytes 90000 \
+
+#define max_names 4000 \
+ \
+
+#define length(c) (c+1) ->byte_start-(c) ->byte_start
+#define print_id(c) term_write((c) ->byte_start,length((c) ) ) \
+
+#define hash_size 353 \
+
+#define llink link
+#define rlink dummy.Rlink
+#define root name_dir->rlink \
+ \
+
+#define first_chunk(p) ((p) ->byte_start+2)
+#define prefix_length(p) (int) ((unsigned char) *((p) ->byte_start) *256+ \
+(unsigned char) *((p) ->byte_start+1) )
+#define set_prefix_length(p,m) (*((p) ->byte_start) = (m) /256, \
+*((p) ->byte_start+1) = (m) %256) \
+
+#define less 0
+#define equal 1
+#define greater 2
+#define prefix 3
+#define extension 4 \
+
+#define bad_extension 5 \
+
+#define spotless 0
+#define harmless_message 1
+#define error_message 2
+#define fatal_message 3
+#define mark_harmless {if(history==spotless) history= harmless_message;}
+#define mark_error history= error_message \
+
+#define confusion(s) fatal("! This can't happen: ",s) \
+ \
+
+#define show_banner flags['b']
+#define show_progress flags['p']
+#define show_stats flags['s']
+#define show_happiness flags['h'] \
+
+#define update_terminal fflush(stdout) \
+
+#define new_line putchar('\n')
+#define putxchar putchar
+#define term_write(a,b) fflush(stdout) ,fwrite(a,sizeof(char) ,b,stdout)
+#define C_printf(c,a) fprintf(C_file,c,a)
+#define C_putc(c) putc(c,C_file) \
+
+
+#line 60 "common.w"
+
+/*2:*/
+#line 73 "common.w"
+
+typedef short boolean;
+boolean program;
+
+/*:2*//*7:*/
+#line 159 "common.w"
+
+char buffer[long_buf_size];
+char*buffer_end= buffer+buf_size-2;
+char*limit= buffer;
+char*loc= buffer;
+
+/*:7*//*10:*/
+#line 214 "common.w"
+
+int include_depth;
+FILE*file[max_include_depth];
+FILE*change_file;
+char file_name[max_include_depth][max_file_name_length];
+
+char change_file_name[max_file_name_length];
+char alt_web_file_name[max_file_name_length];
+int line[max_include_depth];
+int change_line;
+int change_depth;
+boolean input_has_ended;
+boolean changing;
+boolean web_file_open= 0;
+
+/*:10*//*20:*/
+#line 418 "common.w"
+
+typedef unsigned short sixteen_bits;
+sixteen_bits section_count;
+boolean changed_section[max_sections];
+boolean change_pending;
+
+boolean print_where= 0;
+
+/*:20*//*27:*/
+#line 594 "common.w"
+
+typedef struct name_info{
+char*byte_start;
+/*31:*/
+#line 631 "common.w"
+
+struct name_info*link;
+
+/*:31*//*40:*/
+#line 730 "common.w"
+
+union{
+struct name_info*Rlink;
+
+char Ilk;
+}dummy;
+
+/*:40*//*55:*/
+#line 1062 "common.w"
+
+char*equiv_or_xref;
+
+/*:55*/
+#line 597 "common.w"
+
+}name_info;
+typedef name_info*name_pointer;
+char byte_mem[max_bytes];
+char*byte_mem_end= byte_mem+max_bytes-1;
+name_info name_dir[max_names];
+name_pointer name_dir_end= name_dir+max_names-1;
+
+/*:27*//*29:*/
+#line 617 "common.w"
+
+name_pointer name_ptr;
+char*byte_ptr;
+
+/*:29*//*32:*/
+#line 644 "common.w"
+
+typedef name_pointer*hash_pointer;
+name_pointer hash[hash_size];
+hash_pointer hash_end= hash+hash_size-1;
+hash_pointer h;
+
+/*:32*//*56:*/
+#line 1082 "common.w"
+
+int history= spotless;
+
+/*:56*//*67:*/
+#line 1220 "common.w"
+
+int argc;
+char**argv;
+char C_file_name[max_file_name_length];
+char tex_file_name[max_file_name_length];
+char idx_file_name[max_file_name_length];
+char scn_file_name[max_file_name_length];
+boolean flags[128];
+
+/*:67*//*77:*/
+#line 1370 "common.w"
+
+FILE*C_file;
+FILE*tex_file;
+FILE*idx_file;
+FILE*scn_file;
+FILE*active_file;
+
+/*:77*/
+#line 61 "common.w"
+
+/*3:*/
+#line 83 "common.w"
+int phase;
+
+/*:3*//*11:*/
+#line 240 "common.w"
+
+char change_buffer[buf_size];
+char*change_limit;
+
+/*:11*/
+#line 62 "common.w"
+
+/*33:*/
+#line 650 "common.w"
+
+extern int names_match();
+
+/*:33*//*38:*/
+#line 703 "common.w"
+
+void init_p();
+
+/*:38*//*46:*/
+#line 852 "common.w"
+
+extern void init_node();
+
+/*:46*//*53:*/
+#line 1017 "common.w"
+
+int section_name_cmp();
+
+/*:53*//*57:*/
+#line 1092 "common.w"
+
+void err_print();
+
+/*:57*//*60:*/
+#line 1140 "common.w"
+
+int wrap_up();
+extern void print_stats();
+
+/*:60*//*63:*/
+#line 1173 "common.w"
+
+void fatal(),overflow();
+
+/*:63*//*69:*/
+#line 1251 "common.w"
+
+void scan_args();
+
+/*:69*//*81:*/
+#line 1411 "common.w"
+
+extern int strlen();
+extern int strcmp();
+extern char*strcpy();
+extern int strncmp();
+extern char*strncpy();
+
+/*:81*/
+#line 63 "common.w"
+
+
+/*:1*//*4:*/
+#line 89 "common.w"
+
+void
+common_init()
+{
+/*30:*/
+#line 621 "common.w"
+
+name_dir->byte_start= byte_ptr= byte_mem;
+name_ptr= name_dir+1;
+name_ptr->byte_start= byte_mem;
+
+/*:30*//*34:*/
+#line 655 "common.w"
+
+for(h= hash;h<=hash_end;*h++= NULL);
+
+/*:34*//*41:*/
+#line 737 "common.w"
+
+root= NULL;
+
+/*:41*/
+#line 93 "common.w"
+;
+/*68:*/
+#line 1233 "common.w"
+
+show_banner= show_happiness= show_progress= 1;
+
+/*:68*/
+#line 94 "common.w"
+;
+/*78:*/
+#line 1377 "common.w"
+
+scan_args();
+if(program==ctangle){
+if((C_file= fopen(C_file_name,"w"))==NULL)
+fatal("! Cannot open output file ",C_file_name);
+
+}
+else{
+if((tex_file= fopen(tex_file_name,"w"))==NULL)
+fatal("! Cannot open output file ",tex_file_name);
+}
+
+/*:78*/
+#line 95 "common.w"
+;
+}
+
+/*:4*//*9:*/
+#line 172 "common.w"
+
+int input_ln(fp)
+FILE*fp;
+{
+register int c= EOF;
+register char*k;
+if(feof(fp))return(0);
+limit= k= buffer;
+while(k<=buffer_end&&(c= getc(fp))!=EOF&&c!='\n')
+if((*(k++)= c)!=' ')limit= k;
+if(k> buffer_end)
+if((c= getc(fp))!=EOF&&c!='\n'){
+ungetc(c,fp);loc= buffer;err_print("! Input line too long");
+
+}
+if(c==EOF&&limit==buffer)return(0);
+
+return(1);
+}
+
+/*:9*//*12:*/
+#line 251 "common.w"
+
+void
+prime_the_change_buffer()
+{
+change_limit= change_buffer;
+/*13:*/
+#line 265 "common.w"
+
+while(1){
+change_line++;
+if(!input_ln(change_file))return;
+if(limit<buffer+2)continue;
+if(buffer[0]!='@')continue;
+if(xisupper(buffer[1]))buffer[1]= tolower(buffer[1]);
+if(buffer[1]=='x')break;
+if(buffer[1]=='y'||buffer[1]=='z'||buffer[1]=='i'){
+loc= buffer+2;
+err_print("! Missing @x in change file");
+
+}
+}
+
+/*:13*/
+#line 256 "common.w"
+;
+/*14:*/
+#line 282 "common.w"
+
+do{
+change_line++;
+if(!input_ln(change_file)){
+err_print("! Change file ended after @x");
+
+return;
+}
+}while(limit==buffer);
+
+/*:14*/
+#line 257 "common.w"
+;
+/*15:*/
+#line 292 "common.w"
+
+{
+change_limit= change_buffer+(limit-buffer);
+strncpy(change_buffer,buffer,limit-buffer+1);
+}
+
+/*:15*/
+#line 258 "common.w"
+;
+}
+
+/*:12*//*16:*/
+#line 320 "common.w"
+
+void
+check_change()
+{
+int n= 0;
+if(lines_dont_match)return;
+change_pending= 0;
+if(!changed_section[section_count]){
+if_section_start_make_pending(1);
+if(!change_pending)changed_section[section_count]= 1;
+}
+while(1){
+changing= 1;print_where= 1;change_line++;
+if(!input_ln(change_file)){
+err_print("! Change file ended before @y");
+
+change_limit= change_buffer;changing= 0;
+return;
+}
+if(limit> buffer+1&&buffer[0]=='@'){
+char xyz_code= xisupper(buffer[1])?tolower(buffer[1]):buffer[1];
+/*17:*/
+#line 358 "common.w"
+
+if(xyz_code=='x'||xyz_code=='z'){
+loc= buffer+2;err_print("! Where is the matching @y?");
+
+}
+else if(xyz_code=='y'){
+if(n> 0){
+loc= buffer+2;
+printf("\n! Hmm... %d ",n);
+err_print("of the preceding lines failed to match");
+
+}
+change_depth= include_depth;
+return;
+}
+
+/*:17*/
+#line 342 "common.w"
+;
+}
+/*15:*/
+#line 292 "common.w"
+
+{
+change_limit= change_buffer+(limit-buffer);
+strncpy(change_buffer,buffer,limit-buffer+1);
+}
+
+/*:15*/
+#line 344 "common.w"
+;
+changing= 0;cur_line++;
+while(!input_ln(cur_file)){
+if(include_depth==0){
+err_print("! CWEB file ended during a change");
+
+input_has_ended= 1;return;
+}
+include_depth--;cur_line++;
+}
+if(lines_dont_match)n++;
+}
+}
+
+/*:16*//*18:*/
+#line 378 "common.w"
+
+void
+reset_input()
+{
+limit= buffer;loc= buffer+1;buffer[0]= ' ';
+/*19:*/
+#line 393 "common.w"
+
+if((web_file= fopen(web_file_name,"r"))==NULL){
+strcpy(web_file_name,alt_web_file_name);
+if((web_file= fopen(web_file_name,"r"))==NULL)
+fatal("! Cannot open input file ",web_file_name);
+}
+
+
+web_file_open= 1;
+if((change_file= fopen(change_file_name,"r"))==NULL)
+fatal("! Cannot open change file ",change_file_name);
+
+/*:19*/
+#line 383 "common.w"
+;
+include_depth= 0;cur_line= 0;change_line= 0;
+change_depth= include_depth;
+changing= 1;prime_the_change_buffer();changing= !changing;
+limit= buffer;loc= buffer+1;buffer[0]= ' ';input_has_ended= 0;
+}
+
+/*:18*//*21:*/
+#line 426 "common.w"
+
+int get_line()
+{
+restart:
+if(changing&&include_depth==change_depth)
+/*25:*/
+#line 537 "common.w"
+{
+change_line++;
+if(!input_ln(change_file)){
+err_print("! Change file ended without @z");
+
+buffer[0]= '@';buffer[1]= 'z';limit= buffer+2;
+}
+if(limit> buffer){
+if(change_pending){
+if_section_start_make_pending(0);
+if(change_pending){
+changed_section[section_count]= 1;change_pending= 0;
+}
+}
+*limit= ' ';
+if(buffer[0]=='@'){
+if(xisupper(buffer[1]))buffer[1]= tolower(buffer[1]);
+if(buffer[1]=='x'||buffer[1]=='y'){
+loc= buffer+2;
+err_print("! Where is the matching @z?");
+
+}
+else if(buffer[1]=='z'){
+prime_the_change_buffer();changing= !changing;print_where= 1;
+}
+}
+}
+}
+
+/*:25*/
+#line 431 "common.w"
+;
+if(!changing||include_depth> change_depth){
+/*24:*/
+#line 520 "common.w"
+{
+cur_line++;
+while(!input_ln(cur_file)){
+print_where= 1;
+if(include_depth==0){input_has_ended= 1;break;}
+else{
+fclose(cur_file);include_depth--;
+if(changing&&include_depth==change_depth)break;
+cur_line++;
+}
+}
+if(!changing&&!input_has_ended)
+if(limit-buffer==change_limit-change_buffer)
+if(buffer[0]==change_buffer[0])
+if(change_limit> change_buffer)check_change();
+}
+
+/*:24*/
+#line 433 "common.w"
+;
+if(changing&&include_depth==change_depth)goto restart;
+}
+if(input_has_ended)return 0;
+loc= buffer;*limit= ' ';
+if(buffer[0]=='@'&&(buffer[1]=='i'||buffer[1]=='I')){
+loc= buffer+2;*limit= '"';
+while(*loc==' '||*loc=='\t')loc++;
+if(loc>=limit){
+err_print("! Include file name not given");
+
+goto restart;
+}
+if(include_depth>=max_include_depth-1){
+err_print("! Too many nested includes");
+
+goto restart;
+}
+include_depth++;
+/*23:*/
+#line 474 "common.w"
+{
+char temp_file_name[max_file_name_length];
+char*cur_file_name_end= cur_file_name+max_file_name_length-1;
+char*k= cur_file_name,*kk;
+int l;
+
+if(*loc=='"'){
+loc++;
+while(*loc!='"'&&k<=cur_file_name_end)*k++= *loc++;
+if(loc==limit)k= cur_file_name_end+1;
+}else
+while(*loc!=' '&&*loc!='\t'&&*loc!='"'&&k<=cur_file_name_end)*k++= *loc++;
+if(k> cur_file_name_end)too_long();
+
+*k= '\0';
+if((cur_file= fopen(cur_file_name,"r"))!=NULL){
+cur_line= 0;print_where= 1;
+goto restart;
+}
+kk= getenv("CWEBINPUTS");
+if(kk!=NULL){
+if((l= strlen(kk))> max_file_name_length-2)too_long();
+strcpy(temp_file_name,kk);
+}
+else{
+#ifdef CWEBINPUTS
+if((l= strlen(CWEBINPUTS))> max_file_name_length-2)too_long();
+strcpy(temp_file_name,CWEBINPUTS);
+#else
+l= 0;
+#endif
+}
+if(l> 0){
+if(k+l+2>=cur_file_name_end)too_long();
+
+for(;k>=cur_file_name;k--)*(k+l+1)= *k;
+strcpy(cur_file_name,temp_file_name);
+cur_file_name[l]= '/';
+if((cur_file= fopen(cur_file_name,"r"))!=NULL){
+cur_line= 0;print_where= 1;
+goto restart;
+}
+}
+include_depth--;err_print("! Cannot open include file");goto restart;
+}
+
+/*:23*/
+#line 452 "common.w"
+;
+}
+return 1;
+}
+
+/*:21*//*26:*/
+#line 569 "common.w"
+
+void
+check_complete(){
+if(change_limit!=change_buffer){
+strncpy(buffer,change_buffer,change_limit-change_buffer+1);
+limit= buffer+(int)(change_limit-change_buffer);
+changing= 1;change_depth= include_depth;loc= buffer;
+err_print("! Change file entry did not match");
+
+}
+}
+
+/*:26*//*35:*/
+#line 660 "common.w"
+
+name_pointer
+id_lookup(first,last,t)
+char*first;
+char*last;
+char t;
+{
+char*i= first;
+int h;
+int l;
+name_pointer p;
+if(last==NULL)for(last= first;*last!='\0';last++);
+l= last-first;
+/*36:*/
+#line 683 "common.w"
+
+h= (unsigned char)*i;
+while(++i<last)h= (h+h+(int)((unsigned char)*i))%hash_size;
+
+
+/*:36*/
+#line 673 "common.w"
+;
+/*37:*/
+#line 691 "common.w"
+
+p= hash[h];
+while(p&&!names_match(p,first,l,t))p= p->link;
+if(p==NULL){
+p= name_ptr;
+p->link= hash[h];hash[h]= p;
+}
+
+/*:37*/
+#line 674 "common.w"
+;
+if(p==name_ptr)/*39:*/
+#line 706 "common.w"
+{
+if(byte_ptr+l> byte_mem_end)overflow("byte memory");
+if(name_ptr>=name_dir_end)overflow("name");
+strncpy(byte_ptr,first,l);
+(++name_ptr)->byte_start= byte_ptr+= l;
+if(program==cweave)init_p(p,t);
+}
+
+/*:39*/
+#line 675 "common.w"
+;
+return(p);
+}
+
+/*:35*//*42:*/
+#line 764 "common.w"
+
+void
+print_section_name(p)
+name_pointer p;
+{
+char*ss,*s= first_chunk(p);
+name_pointer q= p+1;
+while(p!=name_dir){
+ss= (p+1)->byte_start-1;
+if(*ss==' '&&ss>=s){
+term_write(s,ss-s);p= q->link;q= p;
+}else{
+term_write(s,ss+1-s);p= name_dir;q= NULL;
+}
+s= p->byte_start;
+}
+if(q)term_write("...",3);
+}
+
+/*:42*//*43:*/
+#line 783 "common.w"
+
+void
+sprint_section_name(dest,p)
+char*dest;
+name_pointer p;
+{
+char*ss,*s= first_chunk(p);
+name_pointer q= p+1;
+while(p!=name_dir){
+ss= (p+1)->byte_start-1;
+if(*ss==' '&&ss>=s){
+p= q->link;q= p;
+}else{
+ss++;p= name_dir;
+}
+strncpy(dest,s,ss-s),dest+= ss-s;
+s= p->byte_start;
+}
+*dest= '\0';
+}
+
+/*:43*//*44:*/
+#line 804 "common.w"
+
+void
+print_prefix_name(p)
+name_pointer p;
+{
+char*s= first_chunk(p);
+int l= prefix_length(p);
+term_write(s,l);
+if(s+l<(p+1)->byte_start)term_write("...",3);
+}
+
+/*:44*//*45:*/
+#line 825 "common.w"
+
+int web_strcmp(j,j_len,k,k_len)
+char*j,*k;
+int j_len,k_len;
+{
+char*j1= j+j_len,*k1= k+k_len;
+while(k<k1&&j<j1&&*j==*k)k++,j++;
+if(k==k1)if(j==j1)return equal;
+else return extension;
+else if(j==j1)return prefix;
+else if(*j<*k)return less;
+else return greater;
+}
+
+/*:45*//*47:*/
+#line 855 "common.w"
+
+name_pointer
+add_section_name(par,c,first,last,ispref)
+name_pointer par;
+int c;
+char*first;
+char*last;
+int ispref;
+{
+name_pointer p= name_ptr;
+char*s= first_chunk(p);
+int name_len= last-first+ispref;
+if(s+name_len> byte_mem_end)overflow("byte memory");
+if(name_ptr+1>=name_dir_end)overflow("name");
+(++name_ptr)->byte_start= byte_ptr= s+name_len;
+if(ispref){
+*(byte_ptr-1)= ' ';
+name_len--;
+name_ptr->link= name_dir;
+(++name_ptr)->byte_start= byte_ptr;
+}
+set_prefix_length(p,name_len);
+strncpy(s,first,name_len);
+p->llink= NULL;
+p->rlink= NULL;
+init_node(p);
+return par==NULL?(root= p):c==less?(par->llink= p):(par->rlink= p);
+}
+
+/*:47*//*48:*/
+#line 884 "common.w"
+
+void
+extend_section_name(p,first,last,ispref)
+name_pointer p;
+char*first;
+char*last;
+int ispref;
+{
+char*s;
+name_pointer q= p+1;
+int name_len= last-first+ispref;
+if(name_ptr>=name_dir_end)overflow("name");
+while(q->link!=name_dir)q= q->link;
+q->link= name_ptr;
+s= name_ptr->byte_start;
+name_ptr->link= name_dir;
+if(s+name_len> byte_mem_end)overflow("byte memory");
+(++name_ptr)->byte_start= byte_ptr= s+name_len;
+strncpy(s,first,name_len);
+if(ispref)*(byte_ptr-1)= ' ';
+}
+
+/*:48*//*49:*/
+#line 912 "common.w"
+
+name_pointer
+section_lookup(first,last,ispref)
+char*first,*last;
+int ispref;
+{
+int c= 0;
+name_pointer p= root;
+name_pointer q= NULL;
+name_pointer r= NULL;
+name_pointer par= NULL;
+
+int name_len= last-first+1;
+/*50:*/
+#line 936 "common.w"
+
+while(p){
+c= web_strcmp(first,name_len,first_chunk(p),prefix_length(p));
+if(c==less||c==greater){
+if(r==NULL)
+par= p;
+p= (c==less?p->llink:p->rlink);
+}else{
+if(r!=NULL){
+printf("\n! Ambiguous prefix: matches <");
+
+print_prefix_name(p);
+printf(">\n and <");
+print_prefix_name(r);
+err_print(">");
+return name_dir;
+}
+r= p;
+p= p->llink;
+q= r->rlink;
+}
+if(p==NULL)
+p= q,q= NULL;
+}
+
+/*:50*/
+#line 926 "common.w"
+;
+/*51:*/
+#line 961 "common.w"
+
+if(r==NULL)
+return add_section_name(par,c,first,last+1,ispref);
+
+/*:51*/
+#line 927 "common.w"
+;
+/*52:*/
+#line 969 "common.w"
+
+switch(section_name_cmp(&first,name_len,r)){
+
+case prefix:
+if(!ispref){
+printf("\n! New name is a prefix of <");
+
+print_section_name(r);
+err_print(">");
+}
+else if(name_len<prefix_length(r))set_prefix_length(r,name_len);
+
+case equal:return r;
+case extension:if(!ispref||first<=last)
+extend_section_name(r,first,last+1,ispref);
+return r;
+case bad_extension:
+printf("\n! New name extends <");
+
+print_section_name(r);
+err_print(">");
+return r;
+default:
+printf("\n! Section name incompatible with <");
+
+print_prefix_name(r);
+printf(">,\n which abbreviates <");
+print_section_name(r);
+err_print(">");
+return r;
+}
+
+/*:52*/
+#line 928 "common.w"
+;
+}
+
+/*:49*//*54:*/
+#line 1020 "common.w"
+
+int section_name_cmp(pfirst,len,r)
+char**pfirst;
+int len;
+name_pointer r;
+{
+char*first= *pfirst;
+name_pointer q= r+1;
+char*ss,*s= first_chunk(r);
+int c;
+int ispref;
+while(1){
+ss= (r+1)->byte_start-1;
+if(*ss==' '&&ss>=r->byte_start)ispref= 1,q= q->link;
+else ispref= 0,ss++,q= name_dir;
+switch(c= web_strcmp(first,len,s,ss-s)){
+case equal:if(q==name_dir)
+if(ispref){
+*pfirst= first+(ss-s);
+return extension;
+}else return equal;
+else return(q->byte_start==(q+1)->byte_start)?equal:prefix;
+case extension:
+if(!ispref)return bad_extension;
+first+= ss-s;
+if(q!=name_dir){len-= ss-s;s= q->byte_start;r= q;continue;}
+*pfirst= first;return extension;
+default:return c;
+}
+}
+}
+
+/*:54*//*58:*/
+#line 1095 "common.w"
+
+void
+err_print(s)
+char*s;
+{
+char*k,*l;
+printf(*s=='!'?"\n%s":"%s",s);
+if(web_file_open)/*59:*/
+#line 1115 "common.w"
+
+{if(changing&&include_depth==change_depth)
+printf(". (l. %d of change file)\n",change_line);
+else if(include_depth==0)printf(". (l. %d)\n",cur_line);
+else printf(". (l. %d of include file %s)\n",cur_line,cur_file_name);
+l= (loc>=limit?limit:loc);
+if(l> buffer){
+for(k= buffer;k<l;k++)
+if(*k=='\t')putchar(' ');
+else putchar(*k);
+putchar('\n');
+for(k= buffer;k<l;k++)putchar(' ');
+}
+for(k= l;k<limit;k++)putchar(*k);
+if(*limit=='|')putchar('|');
+putchar(' ');
+}
+
+/*:59*/
+#line 1102 "common.w"
+;
+update_terminal;mark_error;
+}
+
+/*:58*//*61:*/
+#line 1150 "common.w"
+
+int wrap_up(){
+putchar('\n');
+if(show_stats)
+print_stats();
+/*62:*/
+#line 1160 "common.w"
+
+switch(history){
+case spotless:if(show_happiness)printf("(No errors were found.)\n");break;
+case harmless_message:
+printf("(Did you see the warning message above?)\n");break;
+case error_message:
+printf("(Pardon me, but I think I spotted something wrong.)\n");break;
+case fatal_message:printf("(That was a fatal error, my friend.)\n");
+}
+
+/*:62*/
+#line 1155 "common.w"
+;
+if(history> harmless_message)return(1);
+else return(0);
+}
+
+/*:61*//*64:*/
+#line 1179 "common.w"
+void
+fatal(s,t)
+char*s,*t;
+{
+if(*s)printf(s);
+err_print(t);
+history= fatal_message;exit(wrap_up());
+}
+
+/*:64*//*65:*/
+#line 1190 "common.w"
+void
+overflow(t)
+char*t;
+{
+printf("\n! Sorry, %s capacity exceeded",t);fatal("","");
+}
+
+
+/*:65*//*70:*/
+#line 1254 "common.w"
+
+void
+scan_args()
+{
+char*dot_pos;
+char*name_pos;
+register char*s;
+boolean found_web= 0,found_change= 0,found_out= 0;
+
+boolean flag_change;
+
+while(--argc> 0){
+if((**(++argv)=='-'||**argv=='+')&&*(*argv+1))/*74:*/
+#line 1344 "common.w"
+
+{
+if(**argv=='-')flag_change= 0;
+else flag_change= 1;
+for(dot_pos= *argv+1;*dot_pos> '\0';dot_pos++)
+flags[*dot_pos]= flag_change;
+}
+
+/*:74*/
+#line 1266 "common.w"
+
+else{
+s= name_pos= *argv;dot_pos= NULL;
+while(*s){
+if(*s=='.')dot_pos= s++;
+else if(*s=='/')dot_pos= NULL,name_pos= ++s;
+else s++;
+}
+if(!found_web)/*71:*/
+#line 1292 "common.w"
+
+{
+if(s-*argv> max_file_name_length-5)
+/*76:*/
+#line 1364 "common.w"
+fatal("! Filename too long\n",*argv);
+
+
+/*:76*/
+#line 1295 "common.w"
+;
+if(dot_pos==NULL)
+sprintf(web_file_name,"%s.w",*argv);
+else{
+strcpy(web_file_name,*argv);
+*dot_pos= 0;
+}
+sprintf(alt_web_file_name,"%s.web",*argv);
+sprintf(tex_file_name,"%s.tex",name_pos);
+sprintf(idx_file_name,"%s.idx",name_pos);
+sprintf(scn_file_name,"%s.scn",name_pos);
+sprintf(C_file_name,"%s.c",name_pos);
+found_web= 1;
+}
+
+/*:71*/
+#line 1275 "common.w"
+
+else if(!found_change)/*72:*/
+#line 1310 "common.w"
+
+{
+if(strcmp(*argv,"-")==0)found_change= -1;
+else{
+if(s-*argv> max_file_name_length-4)
+/*76:*/
+#line 1364 "common.w"
+fatal("! Filename too long\n",*argv);
+
+
+/*:76*/
+#line 1315 "common.w"
+;
+if(dot_pos==NULL)
+sprintf(change_file_name,"%s.ch",*argv);
+else strcpy(change_file_name,*argv);
+found_change= 1;
+}
+}
+
+/*:72*/
+#line 1276 "common.w"
+
+else if(!found_out)/*73:*/
+#line 1323 "common.w"
+
+{
+if(s-*argv> max_file_name_length-5)
+/*76:*/
+#line 1364 "common.w"
+fatal("! Filename too long\n",*argv);
+
+
+/*:76*/
+#line 1326 "common.w"
+;
+if(dot_pos==NULL){
+sprintf(tex_file_name,"%s.tex",*argv);
+sprintf(idx_file_name,"%s.idx",*argv);
+sprintf(scn_file_name,"%s.scn",*argv);
+sprintf(C_file_name,"%s.c",*argv);
+}else{
+strcpy(tex_file_name,*argv);
+strcpy(C_file_name,*argv);
+if(flags['x']){
+*dot_pos= 0;
+sprintf(idx_file_name,"%s.idx",*argv);
+sprintf(scn_file_name,"%s.scn",*argv);
+}
+}
+found_out= 1;
+}
+
+/*:73*/
+#line 1277 "common.w"
+
+else/*75:*/
+#line 1352 "common.w"
+
+{
+if(program==ctangle)
+fatal(
+"! Usage: ctangle [options] webfile[.w] [{changefile[.ch]|-} [outfile[.c]]]\n"
+,"");
+
+else fatal(
+"! Usage: cweave [options] webfile[.w] [{changefile[.ch]|-} [outfile[.tex]]]\n"
+,"");
+}
+
+/*:75*/
+#line 1278 "common.w"
+;
+}
+}
+if(!found_web)/*75:*/
+#line 1352 "common.w"
+
+{
+if(program==ctangle)
+fatal(
+"! Usage: ctangle [options] webfile[.w] [{changefile[.ch]|-} [outfile[.c]]]\n"
+,"");
+
+else fatal(
+"! Usage: cweave [options] webfile[.w] [{changefile[.ch]|-} [outfile[.tex]]]\n"
+,"");
+}
+
+/*:75*/
+#line 1281 "common.w"
+;
+if(found_change<=0)strcpy(change_file_name,"/dev/null");
+}
+
+/*:70*/
diff --git a/Build/source/texk/web2c/cwebdir/common.h b/Build/source/texk/web2c/cwebdir/common.h
new file mode 100644
index 00000000000..a91b8e8d8ea
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/common.h
@@ -0,0 +1,192 @@
+% This file is part of CWEB.
+% This program by Silvio Levy and Donald E. Knuth
+% is based on a program by Knuth.
+% It is distributed WITHOUT ANY WARRANTY, express or implied.
+% Version 3.0 --- June 1993 (works also with later versions)
+
+% Copyright (C) 1987,1990,1993 Silvio Levy and Donald E. Knuth
+
+% Permission is granted to make and distribute verbatim copies of this
+% document provided that the copyright notice and this permission notice
+% are preserved on all copies.
+
+% Permission is granted to copy and distribute modified versions of this
+% document under the conditions for verbatim copying, provided that the
+% entire resulting derived work is distributed under the terms of a
+% permission notice identical to this one.
+
+% Please send comments, suggestions, etc. to levy@@math.berkeley.edu.
+
+% The next few sections contain stuff from the file |"common.w"| that has
+% to be included in both |"ctangle.w"| and |"cweave.w"|. It appears in this
+% file |"common.h"|, which needs to be updated when |"common.w"| changes.
+
+First comes general stuff:
+
+@d ctangle 0
+@d cweave 1
+
+@<Common code for \.{CWEAVE} and \.{CTANGLE}@>=
+typedef short boolean;
+typedef char unsigned eight_bits;
+extern boolean program; /* \.{CWEAVE} or \.{CTANGLE}? */
+extern int phase; /* which phase are we in? */
+
+@ @<Include files@>=
+#include <stdio.h>
+
+@ Code related to the character set:
+@^ASCII code dependencies@>
+
+@d and_and 04 /* `\.{\&\&}'\,; corresponds to MIT's {\tentex\char'4} */
+@d lt_lt 020 /* `\.{<<}'\,; corresponds to MIT's {\tentex\char'20} */
+@d gt_gt 021 /* `\.{>>}'\,; corresponds to MIT's {\tentex\char'21} */
+@d plus_plus 013 /* `\.{++}'\,; corresponds to MIT's {\tentex\char'13} */
+@d minus_minus 01 /* `\.{--}'\,; corresponds to MIT's {\tentex\char'1} */
+@d minus_gt 031 /* `\.{->}'\,; corresponds to MIT's {\tentex\char'31} */
+@d not_eq 032 /* `\.{!=}'\,; corresponds to MIT's {\tentex\char'32} */
+@d lt_eq 034 /* `\.{<=}'\,; corresponds to MIT's {\tentex\char'34} */
+@d gt_eq 035 /* `\.{>=}'\,; corresponds to MIT's {\tentex\char'35} */
+@d eq_eq 036 /* `\.{==}'\,; corresponds to MIT's {\tentex\char'36} */
+@d or_or 037 /* `\.{\v\v}'\,; corresponds to MIT's {\tentex\char'37} */
+@d dot_dot_dot 016 /* `\.{...}'\,; corresponds to MIT's {\tentex\char'16} */
+@d colon_colon 06 /* `\.{::}'\,; corresponds to MIT's {\tentex\char'6} */
+@d period_ast 026 /* `\.{.*}'\,; corresponds to MIT's {\tentex\char'26} */
+@d minus_gt_ast 027 /* `\.{->*}'\,; corresponds to MIT's {\tentex\char'27} */
+
+@<Common code...@>=
+char section_text[longest_name+1]; /* name being sought for */
+char *section_text_end = section_text+longest_name; /* end of |section_text| */
+char *id_first; /* where the current identifier begins in the buffer */
+char *id_loc; /* just after the current identifier in the buffer */
+
+@ Code related to input routines:
+
+@d xisalpha(c) (isalpha(c)&&((eight_bits)c<0200))
+@d xisdigit(c) (isdigit(c)&&((eight_bits)c<0200))
+@d xisspace(c) (isspace(c)&&((eight_bits)c<0200))
+@d xislower(c) (islower(c)&&((eight_bits)c<0200))
+@d xisupper(c) (isupper(c)&&((eight_bits)c<0200))
+@d xisxdigit(c) (isxdigit(c)&&((eight_bits)c<0200))
+
+@<Common code...@>=
+extern char buffer[]; /* where each line of input goes */
+extern char *buffer_end; /* end of |buffer| */
+extern char *loc; /* points to the next character to be read from the buffer*/
+extern char *limit; /* points to the last character in the buffer */
+
+@ Code related to identifier and section name storage:
+@d length(c) (c+1)->byte_start-(c)->byte_start /* the length of a name */
+@d print_id(c) term_write((c)->byte_start,length((c))) /* print identifier */
+@d llink link /* left link in binary search tree for section names */
+@d rlink dummy.Rlink /* right link in binary search tree for section names */
+@d root name_dir->rlink /* the root of the binary search tree
+ for section names */
+@d chunk_marker 0
+
+@<Common code...@>=
+typedef struct name_info {
+ char *byte_start; /* beginning of the name in |byte_mem| */
+ struct name_info *link;
+ union {
+ struct name_info *Rlink; /* right link in binary search tree for section
+ names */
+ char Ilk; /* used by identifiers in \.{CWEAVE} only */
+ } dummy;
+ char *equiv_or_xref; /* info corresponding to names */
+} name_info; /* contains information about an identifier or section name */
+typedef name_info *name_pointer; /* pointer into array of \&{name\_info}s */
+typedef name_pointer *hash_pointer;
+extern char byte_mem[]; /* characters of names */
+extern char *byte_mem_end; /* end of |byte_mem| */
+extern name_info name_dir[]; /* information about names */
+extern name_pointer name_dir_end; /* end of |name_dir| */
+extern name_pointer name_ptr; /* first unused position in |byte_start| */
+extern char *byte_ptr; /* first unused position in |byte_mem| */
+extern name_pointer hash[]; /* heads of hash lists */
+extern hash_pointer hash_end; /* end of |hash| */
+extern hash_pointer h; /* index into hash-head array */
+extern name_pointer id_lookup(); /* looks up a string in the identifier table */
+extern name_pointer section_lookup(); /* finds section name */
+extern void print_section_name(), sprint_section_name();
+
+@ Code related to error handling:
+@d spotless 0 /* |history| value for normal jobs */
+@d harmless_message 1 /* |history| value when non-serious info was printed */
+@d error_message 2 /* |history| value when an error was noted */
+@d fatal_message 3 /* |history| value when we had to stop prematurely */
+@d mark_harmless {if (history==spotless) history=harmless_message;}
+@d mark_error history=error_message
+@d confusion(s) fatal("! This can't happen: ",s)
+
+@<Common...@>=
+extern history; /* indicates how bad this run was */
+extern err_print(); /* print error message and context */
+extern wrap_up(); /* indicate |history| and exit */
+extern void fatal(); /* issue error message and die */
+extern void overflow(); /* succumb because a table has overflowed */
+
+@ Code related to file handling:
+@f line x /* make |line| an unreserved word */
+@d max_file_name_length 60
+@d cur_file file[include_depth] /* current file */
+@d cur_file_name file_name[include_depth] /* current file name */
+@d web_file_name file_name[0] /* main source file name */
+@d cur_line line[include_depth] /* number of current line in current file */
+
+@<Common code...@>=
+extern include_depth; /* current level of nesting */
+extern FILE *file[]; /* stack of non-change files */
+extern FILE *change_file; /* change file */
+extern char C_file_name[]; /* name of |C_file| */
+extern char tex_file_name[]; /* name of |tex_file| */
+extern char idx_file_name[]; /* name of |idx_file| */
+extern char scn_file_name[]; /* name of |scn_file| */
+extern char file_name[][max_file_name_length];
+ /* stack of non-change file names */
+extern char change_file_name[]; /* name of change file */
+extern line[]; /* number of current line in the stacked files */
+extern change_line; /* number of current line in change file */
+extern boolean input_has_ended; /* if there is no more input */
+extern boolean changing; /* if the current line is from |change_file| */
+extern boolean web_file_open; /* if the web file is being read */
+extern reset_input(); /* initialize to read the web file and change file */
+extern get_line(); /* inputs the next line */
+extern check_complete(); /* checks that all changes were picked up */
+
+@ Code related to section numbers:
+@<Common code...@>=
+typedef unsigned short sixteen_bits;
+extern sixteen_bits section_count; /* the current section number */
+extern boolean changed_section[]; /* is the section changed? */
+extern boolean change_pending; /* is a decision about change still unclear? */
+extern boolean print_where; /* tells \.{CTANGLE} to print line and file info */
+
+@ Code related to command line arguments:
+@d show_banner flags['b'] /* should the banner line be printed? */
+@d show_progress flags['p'] /* should progress reports be printed? */
+@d show_happiness flags['h'] /* should lack of errors be announced? */
+
+@<Common code...@>=
+extern int argc; /* copy of |ac| parameter to |main| */
+extern char **argv; /* copy of |av| parameter to |main| */
+extern boolean flags[]; /* an option for each 7-bit code */
+
+@ Code relating to output:
+@d update_terminal fflush(stdout) /* empty the terminal output buffer */
+@d new_line putchar('\n') @d putxchar putchar
+@d term_write(a,b) fflush(stdout),fwrite(a,sizeof(char),b,stdout)
+@d C_printf(c,a) fprintf(C_file,c,a)
+@d C_putc(c) putc(c,C_file)
+
+@<Common code...@>=
+extern FILE *C_file; /* where output of \.{CTANGLE} goes */
+extern FILE *tex_file; /* where output of \.{CWEAVE} goes */
+extern FILE *idx_file; /* where index from \.{CWEAVE} goes */
+extern FILE *scn_file; /* where list of sections from \.{CWEAVE} goes */
+extern FILE *active_file; /* currently active file for \.{CWEAVE} output */
+
+@ The procedure that gets everything rolling:
+
+@<Common code...@>=
+extern void common_init();
diff --git a/Build/source/texk/web2c/cwebdir/common.w b/Build/source/texk/web2c/cwebdir/common.w
new file mode 100644
index 00000000000..466456c306d
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/common.w
@@ -0,0 +1,1418 @@
+% This file is part of CWEB.
+% This program by Silvio Levy and Donald E. Knuth
+% is based on a program by Knuth.
+% It is distributed WITHOUT ANY WARRANTY, express or implied.
+% Version 3.64 --- January 2002
+
+% Copyright (C) 1987,1990,1993,2000 Silvio Levy and Donald E. Knuth
+
+% Permission is granted to make and distribute verbatim copies of this
+% document provided that the copyright notice and this permission notice
+% are preserved on all copies.
+
+% Permission is granted to copy and distribute modified versions of this
+% document under the conditions for verbatim copying, provided that the
+% entire resulting derived work is given a different name and distributed
+% under the terms of a permission notice identical to this one.
+
+\def\v{\char'174} % vertical (|) in typewriter font
+
+\def\title{Common code for CTANGLE and CWEAVE (Version 3.64)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont Common code for {\ttitlefont CTANGLE} and
+ {\ttitlefont CWEAVE}}
+ \vskip 15pt
+ \centerline{(Version 3.64)}
+ \vfill}
+\def\botofcontents{\vfill
+\noindent
+Copyright \copyright\ 1987, 1990, 1993, 2000 Silvio Levy and Donald E. Knuth
+\bigskip\noindent
+Permission is granted to make and distribute verbatim copies of this
+document provided that the copyright notice and this permission notice
+are preserved on all copies.
+
+\smallskip\noindent
+Permission is granted to copy and distribute modified versions of this
+document under the conditions for verbatim copying, provided that the
+entire resulting derived work is given a different name and distributed
+under the terms of a permission notice identical to this one.
+}
+
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iftrue
+@s not_eq normal @q unreserve a C++ keyword @>
+
+@** Introduction. This file contains code common
+to both \.{CTANGLE} and \.{CWEAVE}, which roughly concerns the following
+problems: character uniformity, input routines, error handling and
+parsing of command line. We have tried to concentrate in this file
+all the system dependencies, so as to maximize portability.
+
+In the texts below we will
+sometimes use \.{CWEB} to refer to either of the two component
+programs, if no confusion can arise.
+
+The file begins with a few basic definitions.
+
+@c
+@<Include files@>@/
+@h
+@<Definitions that should agree with \.{CTANGLE} and \.{CWEAVE}@>@/
+@<Other definitions@>@/
+@<Predeclaration of procedures@>@/
+
+@ In certain cases \.{CTANGLE} and \.{CWEAVE} should do almost, but not
+quite, the same thing. In these cases we've written common code for
+both, differentiating between the two by means of the global variable
+|program|.
+
+@d ctangle 0
+@d cweave 1
+
+@<Definitions...@>=
+typedef short boolean;
+boolean program; /* \.{CWEAVE} or \.{CTANGLE}? */
+
+@ \.{CWEAVE} operates in three phases: First it inputs the source
+file and stores cross-reference data, then it inputs the source once again and
+produces the \TEX/ output file, and finally it sorts and outputs the index.
+Similarly, \.{CTANGLE} operates in two phases.
+The global variable |phase| tells which phase we are in.
+
+@<Other...@>= int phase; /* which phase are we in? */
+
+@ There's an initialization procedure that gets both \.{CTANGLE} and
+\.{CWEAVE} off to a good start. We will fill in the details of this
+procedure later.
+
+@c
+void
+common_init()
+{
+ @<Initialize pointers@>;
+ @<Set the default options common to \.{CTANGLE} and \.{CWEAVE}@>;
+ @<Scan arguments and open output files@>;
+}
+
+@* The character set.
+\.{CWEB} uses the conventions of \CEE/ programs found in the standard
+\.{ctype.h} header file.
+
+@<Include files@>=
+#include <ctype.h>
+
+@ A few character pairs are encoded internally as single characters,
+using the definitions below. These definitions are consistent with
+an extension of ASCII code originally developed at MIT and explained in
+Appendix~C of {\sl The \TEX/book\/}; thus, users who have such a
+character set can type things like \.{\char'32} and \.{\char'4} instead
+of \.{!=} and \.{\&\&}. (However, their files will not be too portable
+until more people adopt the extended code.)
+
+If the character set is not ASCII, the definitions given here may conflict
+with existing characters; in such cases, other arbitrary codes should be
+substituted. The indexes to \.{CTANGLE} and \.{CWEAVE} mention every
+case where similar codes may have to be changed in order to
+avoid character conflicts. Look for the entry ``ASCII code dependencies''
+in those indexes.
+
+@^ASCII code dependencies@>
+@^system dependencies@>
+
+@d and_and 04 /* `\.{\&\&}'\,; corresponds to MIT's {\tentex\char'4} */
+@d lt_lt 020 /* `\.{<<}'\,; corresponds to MIT's {\tentex\char'20} */
+@d gt_gt 021 /* `\.{>>}'\,; corresponds to MIT's {\tentex\char'21} */
+@d plus_plus 013 /* `\.{++}'\,; corresponds to MIT's {\tentex\char'13} */
+@d minus_minus 01 /* `\.{--}'\,; corresponds to MIT's {\tentex\char'1} */
+@d minus_gt 031 /* `\.{->}'\,; corresponds to MIT's {\tentex\char'31} */
+@d not_eq 032 /* `\.{!=}'\,; corresponds to MIT's {\tentex\char'32} */
+@d lt_eq 034 /* `\.{<=}'\,; corresponds to MIT's {\tentex\char'34} */
+@d gt_eq 035 /* `\.{>=}'\,; corresponds to MIT's {\tentex\char'35} */
+@d eq_eq 036 /* `\.{==}'\,; corresponds to MIT's {\tentex\char'36} */
+@d or_or 037 /* `\.{\v\v}'\,; corresponds to MIT's {\tentex\char'37} */
+@d dot_dot_dot 016 /* `\.{...}'\,; corresponds to MIT's {\tentex\char'16} */
+@d colon_colon 06 /* `\.{::}'\,; corresponds to MIT's {\tentex\char'6} */
+@d period_ast 026 /* `\.{.*}'\,; corresponds to MIT's {\tentex\char'26} */
+@d minus_gt_ast 027 /* `\.{->*}'\,; corresponds to MIT's {\tentex\char'27} */
+
+@** Input routines. The lowest level of input to the \.{CWEB} programs
+is performed by |input_ln|, which must be told which file to read from.
+The return value of |input_ln| is 1 if the read is successful and 0 if
+not (generally this means the file has ended). The conventions
+of \TEX/ are followed; i.e., the characters of the next line of the file
+are copied into the |buffer| array,
+and the global variable |limit| is set to the first unoccupied position.
+Trailing blanks are ignored. The value of |limit| must be strictly less
+than |buf_size|, so that |buffer[buf_size-1]| is never filled.
+
+Since |buf_size| is strictly less than |long_buf_size|,
+some of \.{CWEB}'s routines use the fact that it is safe to refer to
+|*(limit+2)| without overstepping the bounds of the array.
+
+@d buf_size 100 /* for \.{CWEAVE} and \.{CTANGLE} */
+@d longest_name 1000
+@d long_buf_size (buf_size+longest_name) /* for \.{CWEAVE} */
+@d xisspace(c) (isspace(c)&&((unsigned char)c<0200))
+@d xisupper(c) (isupper(c)&&((unsigned char)c<0200))
+
+@<Definitions...@>=
+char buffer[long_buf_size]; /* where each line of input goes */
+char *buffer_end=buffer+buf_size-2; /* end of |buffer| */
+char *limit=buffer; /* points to the last character in the buffer */
+char *loc=buffer; /* points to the next character to be read from the buffer */
+
+@ @<Include files@>=
+#include <stdio.h>
+
+@ In the unlikely event that your standard I/O library does not
+support |feof|, |getc|, and |ungetc| you may have to change things here.
+@^system dependencies@>
+
+@c
+int input_ln(fp) /* copies a line into |buffer| or returns 0 */
+FILE *fp; /* what file to read from */
+{
+ register int c=EOF; /* character read; initialized so some compilers won't complain */
+ register char *k; /* where next character goes */
+ if (feof(fp)) return(0); /* we have hit end-of-file */
+ limit = k = buffer; /* beginning of buffer */
+ while (k<=buffer_end && (c=getc(fp)) != EOF && c!='\n')
+ if ((*(k++) = c) != ' ') limit = k;
+ if (k>buffer_end)
+ if ((c=getc(fp))!=EOF && c!='\n') {
+ ungetc(c,fp); loc=buffer; err_print("! Input line too long");
+@.Input line too long@>
+ }
+ if (c==EOF && limit==buffer) return(0); /* there was nothing after
+ the last newline */
+ return(1);
+}
+
+@ Now comes the problem of deciding which file to read from next.
+Recall that the actual text that \.{CWEB} should process comes from two
+streams: a |web_file|, which can contain possibly nested include
+commands \.{@@i}, and a |change_file|, which might also contain
+includes. The |web_file| together with the currently open include
+files form a stack |file|, whose names are stored in a parallel stack
+|file_name|. The boolean |changing| tells whether or not we're reading
+from the |change_file|.
+
+The line number of each open file is also kept for error reporting and
+for the benefit of \.{CTANGLE}.
+
+@f line x /* make |line| an unreserved word */
+@d max_include_depth 10 /* maximum number of source files open
+ simultaneously, not counting the change file */
+@d max_file_name_length 60
+@d cur_file file[include_depth] /* current file */
+@d cur_file_name file_name[include_depth] /* current file name */
+@d cur_line line[include_depth] /* number of current line in current file */
+@d web_file file[0] /* main source file */
+@d web_file_name file_name[0] /* main source file name */
+
+@<Definitions...@>=
+int include_depth; /* current level of nesting */
+FILE *file[max_include_depth]; /* stack of non-change files */
+FILE *change_file; /* change file */
+char file_name[max_include_depth][max_file_name_length];
+ /* stack of non-change file names */
+char change_file_name[max_file_name_length]; /* name of change file */
+char alt_web_file_name[max_file_name_length]; /* alternate name to try */
+int line[max_include_depth]; /* number of current line in the stacked files */
+int change_line; /* number of current line in change file */
+int change_depth; /* where \.{@@y} originated during a change */
+boolean input_has_ended; /* if there is no more input */
+boolean changing; /* if the current line is from |change_file| */
+boolean web_file_open=0; /* if the web file is being read */
+
+@ When |changing==0|, the next line of |change_file| is kept in
+|change_buffer|, for purposes of comparison with the next
+line of |cur_file|. After the change file has been completely input, we
+set |change_limit=change_buffer|,
+so that no further matches will be made.
+
+Here's a shorthand expression for inequality between the two lines:
+
+@d lines_dont_match (change_limit-change_buffer != limit-buffer ||
+ strncmp(buffer, change_buffer, limit-buffer))
+
+@<Other...@>=
+char change_buffer[buf_size]; /* next line of |change_file| */
+char *change_limit; /* points to the last character in |change_buffer| */
+
+@ Procedure |prime_the_change_buffer|
+sets |change_buffer| in preparation for the next matching operation.
+Since blank lines in the change file are not used for matching, we have
+|(change_limit==change_buffer && !changing)| if and only if
+the change file is exhausted. This procedure is called only when
+|changing| is 1; hence error messages will be reported correctly.
+
+@c
+void
+prime_the_change_buffer()
+{
+ change_limit=change_buffer; /* this value is used if the change file ends */
+ @<Skip over comment lines in the change file; |return| if end of file@>;
+ @<Skip to the next nonblank line; |return| if end of file@>;
+ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>;
+}
+
+@ While looking for a line that begins with \.{@@x} in the change file, we
+allow lines that begin with \.{@@}, as long as they don't begin with \.{@@y},
+\.{@@z}, or \.{@@i} (which would probably mean that the change file is fouled up).
+
+@<Skip over comment lines in the change file...@>=
+while(1) {
+ change_line++;
+ if (!input_ln(change_file)) return;
+ if (limit<buffer+2) continue;
+ if (buffer[0]!='@@') continue;
+ if (xisupper(buffer[1])) buffer[1]=tolower(buffer[1]);
+ if (buffer[1]=='x') break;
+ if (buffer[1]=='y' || buffer[1]=='z' || buffer[1]=='i') {
+ loc=buffer+2;
+ err_print("! Missing @@x in change file");
+@.Missing @@x...@>
+ }
+}
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+do {
+ change_line++;
+ if (!input_ln(change_file)) {
+ err_print("! Change file ended after @@x");
+@.Change file ended...@>
+ return;
+ }
+} while (limit==buffer);
+
+@ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>=
+{
+ change_limit=change_buffer+(limit-buffer);
+ strncpy(change_buffer,buffer,limit-buffer+1);
+}
+
+@ The following procedure is used to see if the next change entry should
+go into effect; it is called only when |changing| is 0.
+The idea is to test whether or not the current
+contents of |buffer| matches the current contents of |change_buffer|.
+If not, there's nothing more to do; but if so, a change is called for:
+All of the text down to the \.{@@y} is supposed to match. An error
+message is issued if any discrepancy is found. Then the procedure
+prepares to read the next line from |change_file|.
+
+When a match is found, the current section is marked as changed unless
+the first line after the \.{@@x} and after the \.{@@y} both start with
+either |'@@*'| or |'@@ '| (possibly preceded by whitespace).
+
+This procedure is called only when |buffer<limit|, i.e., when the
+current line is nonempty.
+
+@d if_section_start_make_pending(b) {@+*limit='!';
+ for (loc=buffer;xisspace(*loc);loc++) ;
+ *limit=' ';
+ if (*loc=='@@' && (xisspace(*(loc+1)) || *(loc+1)=='*')) change_pending=b;
+}
+
+@c
+void
+check_change() /* switches to |change_file| if the buffers match */
+{
+ int n=0; /* the number of discrepancies found */
+ if (lines_dont_match) return;
+ change_pending=0;
+ if (!changed_section[section_count]) {
+ if_section_start_make_pending(1);
+ if (!change_pending) changed_section[section_count]=1;
+ }
+ while (1) {
+ changing=1; print_where=1; change_line++;
+ if (!input_ln(change_file)) {
+ err_print("! Change file ended before @@y");
+@.Change file ended...@>
+ change_limit=change_buffer; changing=0;
+ return;
+ }
+ if (limit>buffer+1 && buffer[0]=='@@') {
+ char xyz_code=xisupper(buffer[1])? tolower(buffer[1]): buffer[1];
+ @<If the current line starts with \.{@@y},
+ report any discrepancies and |return|@>;
+ }
+ @<Move |buffer| and |limit|...@>;
+ changing=0; cur_line++;
+ while (!input_ln(cur_file)) { /* pop the stack or quit */
+ if (include_depth==0) {
+ err_print("! CWEB file ended during a change");
+@.CWEB file ended...@>
+ input_has_ended=1; return;
+ }
+ include_depth--; cur_line++;
+ }
+ if (lines_dont_match) n++;
+ }
+}
+
+@ @<If the current line starts with \.{@@y}...@>=
+if (xyz_code=='x' || xyz_code=='z') {
+ loc=buffer+2; err_print("! Where is the matching @@y?");
+@.Where is the match...@>
+ }
+else if (xyz_code=='y') {
+ if (n>0) {
+ loc=buffer+2;
+ printf("\n! Hmm... %d ",n);
+ err_print("of the preceding lines failed to match");
+@.Hmm... n of the preceding...@>
+ }
+ change_depth=include_depth;
+ return;
+}
+
+@ The |reset_input| procedure, which gets \.{CWEB} ready to read the
+user's \.{CWEB} input, is used at the beginning of phase one of \.{CTANGLE},
+phases one and two of \.{CWEAVE}.
+
+@c
+void
+reset_input()
+{
+ limit=buffer; loc=buffer+1; buffer[0]=' ';
+ @<Open input files@>;
+ include_depth=0; cur_line=0; change_line=0;
+ change_depth=include_depth;
+ changing=1; prime_the_change_buffer(); changing=!changing;
+ limit=buffer; loc=buffer+1; buffer[0]=' '; input_has_ended=0;
+}
+
+@ The following code opens the input files.
+@^system dependencies@>
+
+@<Open input files@>=
+if ((web_file=fopen(web_file_name,"r"))==NULL) {
+ strcpy(web_file_name,alt_web_file_name);
+ if ((web_file=fopen(web_file_name,"r"))==NULL)
+ fatal("! Cannot open input file ", web_file_name);
+}
+@.Cannot open input file@>
+@.Cannot open change file@>
+web_file_open=1;
+if ((change_file=fopen(change_file_name,"r"))==NULL)
+ fatal("! Cannot open change file ", change_file_name);
+
+@ The |get_line| procedure is called when |loc>limit|; it puts the next
+line of merged input into the buffer and updates the other variables
+appropriately. A space is placed at the right end of the line.
+This procedure returns |!input_has_ended| because we often want to
+check the value of that variable after calling the procedure.
+
+If we've just changed from the |cur_file| to the |change_file|, or if
+the |cur_file| has changed, we tell \.{CTANGLE} to print this
+information in the \CEE/ file by means of the |print_where| flag.
+
+@d max_sections 2000 /* number of identifiers, strings, section names;
+ must be less than 10240 */
+
+@<Defin...@>=
+typedef unsigned short sixteen_bits;
+sixteen_bits section_count; /* the current section number */
+boolean changed_section[max_sections]; /* is the section changed? */
+boolean change_pending; /* if the current change is not yet recorded in
+ |changed_section[section_count]| */
+boolean print_where=0; /* should \.{CTANGLE} print line and file info? */
+
+@ @c
+int get_line() /* inputs the next line */
+{
+ restart:
+ if (changing && include_depth==change_depth)
+ @<Read from |change_file| and maybe turn off |changing|@>;
+ if (! changing || include_depth>change_depth) {
+ @<Read from |cur_file| and maybe turn on |changing|@>;
+ if (changing && include_depth==change_depth) goto restart;
+ }
+ if (input_has_ended) return 0;
+ loc=buffer; *limit=' ';
+ if (buffer[0]=='@@' && (buffer[1]=='i' || buffer[1]=='I')) {
+ loc=buffer+2; *limit='"';
+ while (*loc==' '||*loc=='\t') loc++;
+ if (loc>=limit) {
+ err_print("! Include file name not given");
+@.Include file name ...@>
+ goto restart;
+ }
+ if (include_depth>=max_include_depth-1) {
+ err_print("! Too many nested includes");
+@.Too many nested includes@>
+ goto restart;
+ }
+ include_depth++; /* push input stack */
+ @<Try to open include file, abort push if unsuccessful, go to |restart|@>;
+ }
+ return 1;
+}
+
+@ When an \.{@@i} line is found in the |cur_file|, we must temporarily
+stop reading it and start reading from the named include file. The
+\.{@@i} line should give a complete file name with or without
+double quotes.
+If the environment variable \.{CWEBINPUTS} is set, or if the compiler flag
+of the same name was defined at compile time,
+\.{CWEB} will look for include files in the directory thus named, if
+it cannot find them in the current directory.
+(Colon-separated paths are not supported.)
+The remainder of the \.{@@i} line after the file name is ignored.
+
+@d too_long() {include_depth--;
+ err_print("! Include file name too long"); goto restart;}
+
+@<Include...@>=
+#include <stdlib.h> /* declaration of |getenv| and |exit| */
+
+@ @<Try to open...@>= {
+ char temp_file_name[max_file_name_length];
+ char *cur_file_name_end=cur_file_name+max_file_name_length-1;
+ char *k=cur_file_name, *kk;
+ int l; /* length of file name */
+
+ if (*loc=='"') {
+ loc++;
+ while (*loc!='"' && k<=cur_file_name_end) *k++=*loc++;
+ if (loc==limit) k=cur_file_name_end+1; /* unmatched quote is `too long' */
+ } else
+ while (*loc!=' '&&*loc!='\t'&&*loc!='"'&&k<=cur_file_name_end) *k++=*loc++;
+ if (k>cur_file_name_end) too_long();
+@.Include file name ...@>
+ *k='\0';
+ if ((cur_file=fopen(cur_file_name,"r"))!=NULL) {
+ cur_line=0; print_where=1;
+ goto restart; /* success */
+ }
+ kk=getenv("CWEBINPUTS");
+ if (kk!=NULL) {
+ if ((l=strlen(kk))>max_file_name_length-2) too_long();
+ strcpy(temp_file_name,kk);
+ }
+ else {
+#ifdef CWEBINPUTS
+ if ((l=strlen(CWEBINPUTS))>max_file_name_length-2) too_long();
+ strcpy(temp_file_name,CWEBINPUTS);
+#else
+ l=0;
+#endif /* |CWEBINPUTS| */
+ }
+ if (l>0) {
+ if (k+l+2>=cur_file_name_end) too_long();
+@.Include file name ...@>
+ for (; k>= cur_file_name; k--) *(k+l+1)=*k;
+ strcpy(cur_file_name,temp_file_name);
+ cur_file_name[l]='/'; /* \UNIX/ pathname separator */
+ if ((cur_file=fopen(cur_file_name,"r"))!=NULL) {
+ cur_line=0; print_where=1;
+ goto restart; /* success */
+ }
+ }
+ include_depth--; err_print("! Cannot open include file"); goto restart;
+}
+
+@ @<Read from |cur_file|...@>= {
+ cur_line++;
+ while (!input_ln(cur_file)) { /* pop the stack or quit */
+ print_where=1;
+ if (include_depth==0) {input_has_ended=1; break;}
+ else {
+ fclose(cur_file); include_depth--;
+ if (changing && include_depth==change_depth) break;
+ cur_line++;
+ }
+ }
+ if (!changing && !input_has_ended)
+ if (limit-buffer==change_limit-change_buffer)
+ if (buffer[0]==change_buffer[0])
+ if (change_limit>change_buffer) check_change();
+}
+
+@ @<Read from |change_file|...@>= {
+ change_line++;
+ if (!input_ln(change_file)) {
+ err_print("! Change file ended without @@z");
+@.Change file ended...@>
+ buffer[0]='@@'; buffer[1]='z'; limit=buffer+2;
+ }
+ if (limit>buffer) { /* check if the change has ended */
+ if (change_pending) {
+ if_section_start_make_pending(0);
+ if (change_pending) {
+ changed_section[section_count]=1; change_pending=0;
+ }
+ }
+ *limit=' ';
+ if (buffer[0]=='@@') {
+ if (xisupper(buffer[1])) buffer[1]=tolower(buffer[1]);
+ if (buffer[1]=='x' || buffer[1]=='y') {
+ loc=buffer+2;
+ err_print("! Where is the matching @@z?");
+@.Where is the match...@>
+ }
+ else if (buffer[1]=='z') {
+ prime_the_change_buffer(); changing=!changing; print_where=1;
+ }
+ }
+ }
+}
+
+@ At the end of the program, we will tell the user if the change file
+had a line that didn't match any relevant line in |web_file|.
+
+@c
+void
+check_complete(){
+ if (change_limit!=change_buffer) { /* |changing| is 0 */
+ strncpy(buffer,change_buffer,change_limit-change_buffer+1);
+ limit=buffer+(int)(change_limit-change_buffer);
+ changing=1; change_depth=include_depth; loc=buffer;
+ err_print("! Change file entry did not match");
+@.Change file entry did not match@>
+ }
+}
+
+@** Storage of names and strings.
+Both \.{CWEAVE} and \.{CTANGLE} store identifiers, section names and
+other strings in a large array of |char|s, called |byte_mem|.
+Information about the names is kept in the array |name_dir|, whose
+elements are structures of type |name_info|, containing a pointer into
+the |byte_mem| array (the address where the name begins) and other data.
+A |name_pointer| variable is a pointer into |name_dir|.
+
+@d max_bytes 90000 /* the number of bytes in identifiers,
+ index entries, and section names; must be less than $2^{24}$ */
+@d max_names 4000 /* number of identifiers, strings, section names;
+ must be less than 10240 */
+
+@<Definitions that...@>=
+typedef struct name_info {
+ char *byte_start; /* beginning of the name in |byte_mem| */
+ @<More elements of |name_info| structure@>@;
+} name_info; /* contains information about an identifier or section name */
+typedef name_info *name_pointer; /* pointer into array of |name_info|s */
+char byte_mem[max_bytes]; /* characters of names */
+char *byte_mem_end = byte_mem+max_bytes-1; /* end of |byte_mem| */
+name_info name_dir[max_names]; /* information about names */
+name_pointer name_dir_end = name_dir+max_names-1; /* end of |name_dir| */
+
+@ The actual sequence of characters in the name pointed to by a |name_pointer
+p| appears in positions |p->byte_start| to |(p+1)->byte_start-1|, inclusive.
+The |print_id| macro prints this text on the user's terminal.
+
+@d length(c) (c+1)->byte_start-(c)->byte_start /* the length of a name */
+@d print_id(c) term_write((c)->byte_start,length((c))) /* print identifier */
+
+@ The first unused position in |byte_mem| and |name_dir| is
+kept in |byte_ptr| and |name_ptr|, respectively. Thus we
+usually have |name_ptr->byte_start==byte_ptr|, and certainly
+we want to keep |name_ptr<=name_dir_end| and |byte_ptr<=byte_mem_end|.
+
+@<Defini...@>=
+name_pointer name_ptr; /* first unused position in |byte_start| */
+char *byte_ptr; /* first unused position in |byte_mem| */
+
+@ @<Init...@>=
+name_dir->byte_start=byte_ptr=byte_mem; /* position zero in both arrays */
+name_ptr=name_dir+1; /* |name_dir[0]| will be used only for error recovery */
+name_ptr->byte_start=byte_mem; /* this makes name 0 of length zero */
+
+@ The names of identifiers are found by computing a hash address |h| and
+then looking at strings of bytes signified by the |name_pointer|s
+|hash[h]|, |hash[h]->link|, |hash[h]->link->link|, \dots,
+until either finding the desired name or encountering the null pointer.
+
+@<More elements of |name...@>=
+struct name_info *link;
+
+@ The hash table itself
+consists of |hash_size| entries of type |name_pointer|, and is
+updated by the |id_lookup| procedure, which finds a given identifier
+and returns the appropriate |name_pointer|. The matching is done by the
+function |names_match|, which is slightly different in
+\.{CWEAVE} and \.{CTANGLE}. If there is no match for the identifier,
+it is inserted into the table.
+
+@d hash_size 353 /* should be prime */
+
+@<Defini...@>=
+typedef name_pointer *hash_pointer;
+name_pointer hash[hash_size]; /* heads of hash lists */
+hash_pointer hash_end = hash+hash_size-1; /* end of |hash| */
+hash_pointer h; /* index into hash-head array */
+
+@ @<Predec...@>=
+extern int names_match();
+
+@ Initially all the hash lists are empty.
+
+@<Init...@>=
+for (h=hash; h<=hash_end; *h++=NULL) ;
+
+@ Here is the main procedure for finding identifiers:
+
+@c
+name_pointer
+id_lookup(first,last,t) /* looks up a string in the identifier table */
+char *first; /* first character of string */
+char *last; /* last character of string plus one */
+char t; /* the |ilk|; used by \.{CWEAVE} only */
+{
+ char *i=first; /* position in |buffer| */
+ int h; /* hash code */
+ int l; /* length of the given identifier */
+ name_pointer p; /* where the identifier is being sought */
+ if (last==NULL) for (last=first; *last!='\0'; last++);
+ l=last-first; /* compute the length */
+ @<Compute the hash code |h|@>;
+ @<Compute the name location |p|@>;
+ if (p==name_ptr) @<Enter a new name into the table at position |p|@>;
+ return(p);
+}
+
+@ A simple hash code is used: If the sequence of
+character codes is $c_1c_2\ldots c_n$, its hash value will be
+$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the hash...@>=
+h=(unsigned char)*i;
+while (++i<last) h=(h+h+(int)((unsigned char)*i)) % hash_size;
+@^high-bit character handling@>
+
+@ If the identifier is new, it will be placed in position |p=name_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the name location...@>=
+p=hash[h];
+while (p && !names_match(p,first,l,t)) p=p->link;
+if (p==NULL) {
+ p=name_ptr; /* the current identifier is new */
+ p->link=hash[h]; hash[h]=p; /* insert |p| at beginning of hash list */
+}
+
+@ The information associated with a new identifier must be initialized
+in a slightly different way in \.{CWEAVE} than in \.{CTANGLE}; hence the
+|init_p| procedure.
+
+@<Pred...@>=
+void init_p();
+
+@ @<Enter a new name...@>= {
+ if (byte_ptr+l>byte_mem_end) overflow("byte memory");
+ if (name_ptr>=name_dir_end) overflow("name");
+ strncpy(byte_ptr,first,l);
+ (++name_ptr)->byte_start=byte_ptr+=l;
+ if (program==cweave) init_p(p,t);
+}
+
+@ The names of sections are stored in |byte_mem| together
+with the identifier names, but a hash table is not used for them because
+\.{CTANGLE} needs to be able to recognize a section name when given a prefix of
+that name. A conventional binary search tree is used to retrieve section names,
+with fields called |llink| and |rlink| (where |llink| takes the place
+of |link|). The root of this tree is stored in |name_dir->rlink|;
+this will be the only information in |name_dir[0]|.
+
+Since the space used by |rlink| has a different function for
+identifiers than for section names, we declare it as a |union|.
+
+@d llink link /* left link in binary search tree for section names */
+@d rlink dummy.Rlink /* right link in binary search tree for section names */
+@d root name_dir->rlink /* the root of the binary search tree
+ for section names */
+
+@<More elements of |name...@>=
+union {
+ struct name_info *Rlink; /* right link in binary search tree for section
+ names */
+ char Ilk; /* used by identifiers in \.{CWEAVE} only */
+} dummy;
+
+@ @<Init...@>=
+root=NULL; /* the binary search tree starts out with nothing in it */
+
+@ If |p| is a |name_pointer| variable, as we have seen,
+|p->byte_start| is the beginning of the area where the name
+corresponding to |p| is stored. However, if |p| refers to a section
+name, the name may need to be stored in chunks, because it may
+``grow'': a prefix of the section name may be encountered before
+the full name. Furthermore we need to know the length of the shortest
+prefix of the name that was ever encountered.
+
+We solve this problem by inserting two extra bytes at |p->byte_start|,
+representing the length of the shortest prefix, when |p| is a
+section name. Furthermore, the last byte of the name will be a blank
+space if |p| is a prefix. In the latter case, the name pointer
+|p+1| will allow us to access additional chunks of the name:
+The second chunk will begin at the name pointer |(p+1)->link|,
+and if it too is a prefix (ending with blank) its |link| will point
+to additional chunks in the same way. Null links are represented by
+|name_dir|.
+
+@d first_chunk(p) ((p)->byte_start+2)
+@d prefix_length(p) (int)((unsigned char)*((p)->byte_start)*256 +
+ (unsigned char)*((p)->byte_start+1))
+@d set_prefix_length(p,m) (*((p)->byte_start)=(m)/256,
+ *((p)->byte_start+1)=(m)%256)
+
+@c
+void
+print_section_name(p)
+name_pointer p;
+{
+ char *ss, *s = first_chunk(p);
+ name_pointer q = p+1;
+ while (p!=name_dir) {
+ ss = (p+1)->byte_start-1;
+ if (*ss==' ' && ss>=s) {
+ term_write(s,ss-s); p=q->link; q=p;
+ } else {
+ term_write(s,ss+1-s); p=name_dir; q=NULL;
+ }
+ s = p->byte_start;
+ }
+ if (q) term_write("...",3); /* complete name not yet known */
+}
+
+@ @c
+void
+sprint_section_name(dest,p)
+ char*dest;
+ name_pointer p;
+{
+ char *ss, *s = first_chunk(p);
+ name_pointer q = p+1;
+ while (p!=name_dir) {
+ ss = (p+1)->byte_start-1;
+ if (*ss==' ' && ss>=s) {
+ p=q->link; q=p;
+ } else {
+ ss++; p=name_dir;
+ }
+ strncpy(dest,s,ss-s), dest+=ss-s;
+ s = p->byte_start;
+ }
+ *dest='\0';
+}
+
+@ @c
+void
+print_prefix_name(p)
+name_pointer p;
+{
+ char *s = first_chunk(p);
+ int l = prefix_length(p);
+ term_write(s,l);
+ if (s+l<(p+1)->byte_start) term_write("...",3);
+}
+
+@ When we compare two section names, we'll need a function analogous to
+|strcmp|. But we do not assume the strings
+are null-terminated, and we keep an eye open for prefixes and extensions.
+
+@d less 0 /* the first name is lexicographically less than the second */
+@d equal 1 /* the first name is equal to the second */
+@d greater 2 /* the first name is lexicographically greater than the second */
+@d prefix 3 /* the first name is a proper prefix of the second */
+@d extension 4 /* the first name is a proper extension of the second */
+
+@c
+int web_strcmp(j,j_len,k,k_len) /* fuller comparison than |strcmp| */
+ char *j, *k; /* beginning of first and second strings */
+ int j_len, k_len; /* length of strings */
+{
+ char *j1=j+j_len, *k1=k+k_len;
+ while (k<k1 && j<j1 && *j==*k) k++, j++;
+ if (k==k1) if (j==j1) return equal;
+ else return extension;
+ else if (j==j1) return prefix;
+ else if (*j<*k) return less;
+ else return greater;
+}
+
+@ Adding a section name to the tree is straightforward if we know its
+parent and whether it's the |rlink| or |llink| of the parent. As a
+special case, when the name is the first section being added, we set the
+``parent'' to |NULL|. When a section name is created, it has only one
+chunk, which however may be just a prefix; the full name will
+hopefully be unveiled later. Obviously, |prefix_length| starts
+out as the length of the first chunk, though it may decrease later.
+
+The information associated with a new node must be initialized
+differently in \.{CWEAVE} and \.{CTANGLE}; hence the
+|init_node| procedure, which is defined differently in \.{cweave.w}
+and \.{ctangle.w}.
+
+@<Prede...@>=
+extern void init_node();
+
+@ @c
+name_pointer
+add_section_name(par,c,first,last,ispref) /* install a new node in the tree */
+name_pointer par; /* parent of new node */
+int c; /* right or left? */
+char *first; /* first character of section name */
+char *last; /* last character of section name, plus one */
+int ispref; /* are we adding a prefix or a full name? */
+{
+ name_pointer p=name_ptr; /* new node */
+ char *s=first_chunk(p);
+ int name_len=last-first+ispref; /* length of section name */
+ if (s+name_len>byte_mem_end) overflow("byte memory");
+ if (name_ptr+1>=name_dir_end) overflow("name");
+ (++name_ptr)->byte_start=byte_ptr=s+name_len;
+ if (ispref) {
+ *(byte_ptr-1)=' ';
+ name_len--;
+ name_ptr->link=name_dir;
+ (++name_ptr)->byte_start=byte_ptr;
+ }
+ set_prefix_length(p,name_len);
+ strncpy(s,first,name_len);
+ p->llink=NULL;
+ p->rlink=NULL;
+ init_node(p);
+ return par==NULL ? (root=p) : c==less ? (par->llink=p) : (par->rlink=p);
+}
+
+@ @c
+void
+extend_section_name(p,first,last,ispref)
+name_pointer p; /* name to be extended */
+char *first; /* beginning of extension text */
+char *last; /* one beyond end of extension text */
+int ispref; /* are we adding a prefix or a full name? */
+{
+ char *s;
+ name_pointer q=p+1;
+ int name_len=last-first+ispref;
+ if (name_ptr>=name_dir_end) overflow("name");
+ while (q->link!=name_dir) q=q->link;
+ q->link=name_ptr;
+ s=name_ptr->byte_start;
+ name_ptr->link=name_dir;
+ if (s+name_len>byte_mem_end) overflow("byte memory");
+ (++name_ptr)->byte_start=byte_ptr=s+name_len;
+ strncpy(s,first,name_len);
+ if (ispref) *(byte_ptr-1)=' ';
+}
+
+@ The |section_lookup| procedure is supposed to find a
+section name that matches a new name, installing the new name if
+it doesn't match an existing one. The new name is the string
+between |first| and |last|; a ``match'' means that the new name
+exactly equals or is a prefix or extension of a name in the tree.
+
+@c
+name_pointer
+section_lookup(first,last,ispref) /* find or install section name in tree */
+char *first, *last; /* first and last characters of new name */
+int ispref; /* is the new name a prefix or a full name? */
+{
+ int c=0; /* comparison between two names; initialized so some compilers won't complain */
+ name_pointer p=root; /* current node of the search tree */
+ name_pointer q=NULL; /* another place to look in the tree */
+ name_pointer r=NULL; /* where a match has been found */
+ name_pointer par=NULL; /* parent of |p|, if |r| is |NULL|;
+ otherwise parent of |r| */
+ int name_len=last-first+1;
+ @<Look for matches for new name among shortest prefixes, complaining
+ if more than one is found@>;
+ @<If no match found, add new name to tree@>;
+ @<If one match found, check for compatibility and return match@>;
+}
+
+@ A legal new name matches an existing section name if and only if it
+matches the shortest prefix of that section name. Therefore we can
+limit our search for matches to shortest prefixes, which eliminates
+the need for chunk-chasing at this stage.
+
+@<Look for matches for new name among...@>=
+while (p) { /* compare shortest prefix of |p| with new name */
+ c=web_strcmp(first,name_len,first_chunk(p),prefix_length(p));
+ if (c==less || c==greater) { /* new name does not match |p| */
+ if (r==NULL) /* no previous matches have been found */
+ par=p;
+ p=(c==less?p->llink:p->rlink);
+ } else { /* new name matches |p| */
+ if (r!=NULL) { /* and also |r|: illegal */
+ printf("\n! Ambiguous prefix: matches <");
+@.Ambiguous prefix ... @>
+ print_prefix_name(p);
+ printf(">\n and <");
+ print_prefix_name(r);
+ err_print(">");
+ return name_dir; /* the unsection */
+ }
+ r=p; /* remember match */
+ p=p->llink; /* try another */
+ q=r->rlink; /* we'll get back here if the new |p| doesn't match */
+ }
+ if (p==NULL)
+ p=q, q=NULL; /* |q| held the other branch of |r| */
+}
+
+@ @<If no match ...@>=
+ if (r==NULL) /* no matches were found */
+ return add_section_name(par,c,first,last+1,ispref);
+
+@ Although error messages are given in anomalous cases, we do return the
+unique best match when a discrepancy is found, because users often
+change a title in one place while forgetting to change it elsewhere.
+
+@<If one match found, check for compatibility and return match@>=
+switch(section_name_cmp(&first,name_len,r)) {
+ /* compare all of |r| with new name */
+ case prefix:
+ if (!ispref) {
+ printf("\n! New name is a prefix of <");
+@.New name is a prefix...@>
+ print_section_name(r);
+ err_print(">");
+ }
+ else if (name_len<prefix_length(r)) set_prefix_length(r,name_len);
+ /* fall through */
+ case equal: return r;
+ case extension: if (!ispref || first<=last)
+ extend_section_name(r,first,last+1,ispref);
+ return r;
+ case bad_extension:
+ printf("\n! New name extends <");
+@.New name extends...@>
+ print_section_name(r);
+ err_print(">");
+ return r;
+ default: /* no match: illegal */
+ printf("\n! Section name incompatible with <");
+@.Section name incompatible...@>
+ print_prefix_name(r);
+ printf(">,\n which abbreviates <");
+ print_section_name(r);
+ err_print(">");
+ return r;
+}
+
+@ The return codes of |section_name_cmp|, which compares a string with
+the full name of a section, are those of |web_strcmp| plus
+|bad_extension|, used when the string is an extension of a
+supposedly already complete section name. This function has a side
+effect when the comparison string is an extension: It advances the
+address of the first character of the string by an amount equal to
+the length of the known part of the section name.
+
+The name \.{@@<foo...@@>} should be an acceptable ``abbreviation''
+for \.{@@<foo@@>}. If such an abbreviation comes after the complete
+name, there's no trouble recognizing it. If it comes before the
+complete name, we simply append a null chunk. This logic requires
+us to regard \.{@@<foo...@@>} as an ``extension'' of itself.
+
+@d bad_extension 5
+
+@<Predec...@>=
+int section_name_cmp();
+
+@ @c
+int section_name_cmp(pfirst,len,r)
+char **pfirst; /* pointer to beginning of comparison string */
+int len; /* length of string */
+name_pointer r; /* section name being compared */
+{
+ char *first=*pfirst; /* beginning of comparison string */
+ name_pointer q=r+1; /* access to subsequent chunks */
+ char *ss, *s=first_chunk(r);
+ int c; /* comparison */
+ int ispref; /* is chunk |r| a prefix? */
+ while (1) {
+ ss=(r+1)->byte_start-1;
+ if (*ss==' ' && ss>=r->byte_start) ispref=1,q=q->link;
+ else ispref=0,ss++,q=name_dir;
+ switch(c=web_strcmp(first,len,s,ss-s)) {
+ case equal: if (q==name_dir)
+ if (ispref) {
+ *pfirst=first+(ss-s);
+ return extension; /* null extension */
+ } else return equal;
+ else return (q->byte_start==(q+1)->byte_start)? equal: prefix;
+ case extension:
+ if (!ispref) return bad_extension;
+ first += ss-s;
+ if (q!=name_dir) {len -= ss-s; s=q->byte_start; r=q; continue;}
+ *pfirst=first; return extension;
+ default: return c;
+ }
+ }
+}
+
+@ The last component of |name_info| is different for \.{CTANGLE} and
+\.{CWEAVE}. In \.{CTANGLE}, if |p| is a pointer to a section name,
+|p->equiv| is a pointer to its replacement text, an element of the
+array |text_info|. In \.{CWEAVE}, on the other hand, if
+|p| points to an identifier, |p->xref| is a pointer to its
+list of cross-references, an element of the array |xmem|. The make-up
+of |text_info| and |xmem| is discussed in the \.{CTANGLE} and \.{CWEAVE}
+source files, respectively; here we just declare a common field
+|equiv_or_xref| as a pointer to a |char|.
+
+@<More elements of |name...@>=
+char *equiv_or_xref; /* info corresponding to names */
+
+@** Reporting errors to the user.
+A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless 0 /* |history| value for normal jobs */
+@d harmless_message 1 /* |history| value when non-serious info was printed */
+@d error_message 2 /* |history| value when an error was noted */
+@d fatal_message 3 /* |history| value when we had to stop prematurely */
+@d mark_harmless {if (history==spotless) history=harmless_message;}
+@d mark_error history=error_message
+
+@<Definit...@>=
+int history=spotless; /* indicates how bad this run was */
+
+@ The command `|err_print("! Error message")|' will report a syntax error to
+the user, by printing the error message at the beginning of a new line and
+then giving an indication of where the error was spotted in the source file.
+Note that no period follows the error message, since the error routine
+will automatically supply a period. A newline is automatically supplied
+if the string begins with |"!"|.
+
+@<Predecl...@>=
+void err_print();
+
+@ @c
+void
+err_print(s) /* prints `\..' and location of error message */
+char *s;
+{
+ char *k,*l; /* pointers into |buffer| */
+ printf(*s=='!'? "\n%s" : "%s",s);
+ if(web_file_open) @<Print error location based on input buffer@>;
+ update_terminal; mark_error;
+}
+
+@ The error locations can be indicated by using the global variables
+|loc|, |cur_line|, |cur_file_name| and |changing|,
+which tell respectively the first
+unlooked-at position in |buffer|, the current line number, the current
+file, and whether the current line is from |change_file| or |cur_file|.
+This routine should be modified on systems whose standard text editor
+has special line-numbering conventions.
+@^system dependencies@>
+
+@<Print error location based on input buffer@>=
+{if (changing && include_depth==change_depth)
+ printf(". (l. %d of change file)\n", change_line);
+else if (include_depth==0) printf(". (l. %d)\n", cur_line);
+ else printf(". (l. %d of include file %s)\n", cur_line, cur_file_name);
+l= (loc>=limit? limit: loc);
+if (l>buffer) {
+ for (k=buffer; k<l; k++)
+ if (*k=='\t') putchar(' ');
+ else putchar(*k); /* print the characters already read */
+ putchar('\n');
+ for (k=buffer; k<l; k++) putchar(' '); /* space out the next line */
+}
+for (k=l; k<limit; k++) putchar(*k); /* print the part not yet read */
+if (*limit=='|') putchar('|'); /* end of \CEE/ text in section names */
+putchar(' '); /* to separate the message from future asterisks */
+}
+
+@ When no recovery from some error has been provided, we have to wrap
+up and quit as graciously as possible. This is done by calling the
+function |wrap_up| at the end of the code.
+
+\.{CTANGLE} and \.{CWEAVE} have their own notions about how to
+print the job statistics.
+
+@<Prede...@>=
+int wrap_up();
+extern void print_stats();
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here, for instance, we pass the operating system
+a status of 0 if and only if only harmless messages were printed.
+@^system dependencies@>
+
+@c
+int wrap_up() {
+ putchar('\n');
+ if (show_stats)
+ print_stats(); /* print statistics about memory usage */
+ @<Print the job |history|@>;
+ if (history > harmless_message) return(1);
+ else return(0);
+}
+
+@ @<Print the job |history|@>=
+switch (history) {
+case spotless: if (show_happiness) printf("(No errors were found.)\n"); break;
+case harmless_message:
+ printf("(Did you see the warning message above?)\n"); break;
+case error_message:
+ printf("(Pardon me, but I think I spotted something wrong.)\n"); break;
+case fatal_message: printf("(That was a fatal error, my friend.)\n");
+} /* there are no other cases */
+
+@ When there is no way to recover from an error, the |fatal| subroutine is
+invoked. This happens most often when |overflow| occurs.
+
+@<Predec...@>=
+void fatal(), overflow();
+
+@ The two parameters to |fatal| are strings that are essentially
+concatenated to print the final error message.
+
+@c void
+fatal(s,t)
+ char *s,*t;
+{
+ if (*s) printf(s);
+ err_print(t);
+ history=fatal_message; exit(wrap_up());
+}
+
+@ An overflow stop occurs if \.{CWEB}'s tables aren't large enough.
+
+@c void
+overflow(t)
+ char *t;
+{
+ printf("\n! Sorry, %s capacity exceeded",t); fatal("","");
+}
+@.Sorry, capacity exceeded@>
+
+@ Sometimes the program's behavior is far different from what it should be,
+and \.{CWEB} prints an error message that is really for the \.{CWEB}
+maintenance person, not the user. In such cases the program says
+|confusion("indication of where we are")|.
+
+@d confusion(s) fatal("! This can't happen: ",s)
+@.This can't happen@>
+
+@** Command line arguments.
+The user calls \.{CWEAVE} and \.{CTANGLE} with arguments on the command line.
+These are either file names or flags to be turned off (beginning with |"-"|)
+or flags to be turned on (beginning with |"+"|).
+The following globals are for communicating the user's desires to the rest
+of the program. The various file name variables contain strings with
+the names of those files. Most of the 128 flags are undefined but available
+for future extensions.
+
+@d show_banner flags['b'] /* should the banner line be printed? */
+@d show_progress flags['p'] /* should progress reports be printed? */
+@d show_stats flags['s'] /* should statistics be printed at end of run? */
+@d show_happiness flags['h'] /* should lack of errors be announced? */
+
+@<Defin...@>=
+int argc; /* copy of |ac| parameter to |main| */
+char **argv; /* copy of |av| parameter to |main| */
+char C_file_name[max_file_name_length]; /* name of |C_file| */
+char tex_file_name[max_file_name_length]; /* name of |tex_file| */
+char idx_file_name[max_file_name_length]; /* name of |idx_file| */
+char scn_file_name[max_file_name_length]; /* name of |scn_file| */
+boolean flags[128]; /* an option for each 7-bit code */
+
+@ The |flags| will be initially zero. Some of them are set to~1 before
+scanning the arguments; if additional flags are 1 by default they
+should be set before calling |common_init|.
+
+@<Set the default options common to \.{CTANGLE} and \.{CWEAVE}@>=
+show_banner=show_happiness=show_progress=1;
+
+@ We now must look at the command line arguments and set the file names
+accordingly. At least one file name must be present: the \.{CWEB}
+file. It may have an extension, or it may omit the extension to get |".w"| or
+|".web"| added. The \TEX/ output file name is formed by replacing the \.{CWEB}
+file name extension by |".tex"|, and the \CEE/ file name by replacing
+the extension by |".c"|, after removing the directory name (if any).
+
+If there is a second file name present among the arguments, it is the
+change file, again either with an extension or without one to get |".ch"|.
+An omitted change file argument means that |"/dev/null"| should be used,
+when no changes are desired.
+@^system dependencies@>
+
+If there's a third file name, it will be the output file.
+
+@<Pred...@>=
+void scan_args();
+
+@ @c
+void
+scan_args()
+{
+ char *dot_pos; /* position of |'.'| in the argument */
+ char *name_pos; /* file name beginning, sans directory */
+ register char *s; /* register for scanning strings */
+ boolean found_web=0,found_change=0,found_out=0;
+ /* have these names been seen? */
+ boolean flag_change;
+
+ while (--argc > 0) {
+ if ((**(++argv)=='-'||**argv=='+')&&*(*argv+1)) @<Handle flag argument@>@;
+ else {
+ s=name_pos=*argv;@+dot_pos=NULL;
+ while (*s) {
+ if (*s=='.') dot_pos=s++;
+ else if (*s=='/') dot_pos=NULL,name_pos=++s;
+ else s++;
+ }
+ if (!found_web) @<Make
+ |web_file_name|, |tex_file_name|, and |C_file_name|@>@;
+ else if (!found_change) @<Make |change_file_name| from |fname|@>@;
+ else if (!found_out) @<Override |tex_file_name| and |C_file_name|@>@;
+ else @<Print usage error message and quit@>;
+ }
+ }
+ if (!found_web) @<Print usage error message and quit@>;
+ if (found_change<=0) strcpy(change_file_name,"/dev/null");
+}
+
+@ We use all of |*argv| for the |web_file_name| if there is a |'.'| in it,
+otherwise we add |".w"|. If this file can't be opened, we prepare an
+|alt_web_file_name| by adding |"web"| after the dot.
+The other file names come from adding other things
+after the dot. We must check that there is enough room in
+|web_file_name| and the other arrays for the argument.
+
+@<Make |web_file_name|...@>=
+{
+ if (s-*argv > max_file_name_length-5)
+ @<Complain about argument length@>;
+ if (dot_pos==NULL)
+ sprintf(web_file_name,"%s.w",*argv);
+ else {
+ strcpy(web_file_name,*argv);
+ *dot_pos=0; /* string now ends where the dot was */
+ }
+ sprintf(alt_web_file_name,"%s.web",*argv);
+ sprintf(tex_file_name,"%s.tex",name_pos); /* strip off directory name */
+ sprintf(idx_file_name,"%s.idx",name_pos);
+ sprintf(scn_file_name,"%s.scn",name_pos);
+ sprintf(C_file_name,"%s.c",name_pos);
+ found_web=1;
+}
+
+@ @<Make |change_file_name|...@>=
+{
+ if (strcmp(*argv,"-")==0) found_change=-1;
+ else {
+ if (s-*argv > max_file_name_length-4)
+ @<Complain about argument length@>;
+ if (dot_pos==NULL)
+ sprintf(change_file_name,"%s.ch",*argv);
+ else strcpy(change_file_name,*argv);
+ found_change=1;
+ }
+}
+
+@ @<Override...@>=
+{
+ if (s-*argv > max_file_name_length-5)
+ @<Complain about argument length@>;
+ if (dot_pos==NULL) {
+ sprintf(tex_file_name,"%s.tex",*argv);
+ sprintf(idx_file_name,"%s.idx",*argv);
+ sprintf(scn_file_name,"%s.scn",*argv);
+ sprintf(C_file_name,"%s.c",*argv);
+ } else {
+ strcpy(tex_file_name,*argv);
+ strcpy(C_file_name,*argv);
+ if (flags['x']) { /* indexes will be generated */
+ *dot_pos=0;
+ sprintf(idx_file_name,"%s.idx",*argv);
+ sprintf(scn_file_name,"%s.scn",*argv);
+ }
+ }
+ found_out=1;
+}
+
+@ @<Handle flag...@>=
+{
+ if (**argv=='-') flag_change=0;
+ else flag_change=1;
+ for(dot_pos=*argv+1;*dot_pos>'\0';dot_pos++)
+ flags[*dot_pos]=flag_change;
+}
+
+@ @<Print usage error message and quit@>=
+{
+if (program==ctangle)
+ fatal(
+"! Usage: ctangle [options] webfile[.w] [{changefile[.ch]|-} [outfile[.c]]]\n"
+ ,"");
+@.Usage:@>
+else fatal(
+"! Usage: cweave [options] webfile[.w] [{changefile[.ch]|-} [outfile[.tex]]]\n"
+ ,"");
+}
+
+@ @<Complain about arg...@>= fatal("! Filename too long\n", *argv);
+@.Filename too long@>
+
+@** Output. Here is the code that opens the output file:
+@^system dependencies@>
+
+@<Defin...@>=
+FILE *C_file; /* where output of \.{CTANGLE} goes */
+FILE *tex_file; /* where output of \.{CWEAVE} goes */
+FILE *idx_file; /* where index from \.{CWEAVE} goes */
+FILE *scn_file; /* where list of sections from \.{CWEAVE} goes */
+FILE *active_file; /* currently active file for \.{CWEAVE} output */
+
+@ @<Scan arguments and open output files@>=
+scan_args();
+if (program==ctangle) {
+ if ((C_file=fopen(C_file_name,"w"))==NULL)
+ fatal("! Cannot open output file ", C_file_name);
+@.Cannot open output file@>
+}
+else {
+ if ((tex_file=fopen(tex_file_name,"w"))==NULL)
+ fatal("! Cannot open output file ", tex_file_name);
+}
+
+@ The |update_terminal| procedure is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+@^system dependencies@>
+
+@d update_terminal fflush(stdout) /* empty the terminal output buffer */
+
+@ Terminal output uses |putchar| and |putc| when we have to
+translate from \.{CWEB}'s code into the external character code,
+and |printf| when we just want to print strings.
+Several macros make other kinds of output convenient.
+@^system dependencies@>
+@d new_line putchar('\n') @d putxchar putchar
+@d term_write(a,b) fflush(stdout),fwrite(a,sizeof(char),b,stdout)
+@d C_printf(c,a) fprintf(C_file,c,a)
+@d C_putc(c) putc(c,C_file) /* isn't \CEE/ wonderfully consistent? */
+
+@ We predeclare several standard system functions here instead of including
+their system header files, because the names of the header files are not as
+standard as the names of the functions. (For example, some \CEE/ environments
+have \.{<string.h>} where others have \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern int strcmp(); /* compare strings lexicographically */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+
+@** Index.
diff --git a/Build/source/texk/web2c/cwebdir/ctang-bs.ch b/Build/source/texk/web2c/cwebdir/ctang-bs.ch
new file mode 100644
index 00000000000..634dc9acc83
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctang-bs.ch
@@ -0,0 +1,202 @@
+Changes for CTANGLE for MSDOS and Borland C++ 3.1 using the following
+options (and perhaps others):
+
+ -mc -w-pro -Ff=5000 -Z- -O-p
+
+The options -Z- and -O-p explicitly turn off optimizations that break
+the code. (See makefile.bs.)
+
+The main purpose of these changes is to support MSDOS with full-size arrays
+by using "huge" pointers.
+
+(This file contributed by Barry Schwartz, trashman@crud.mn.org, 28 Jun 94;
+ revised 24 Jul 94.)
+
+
+@x Section 1.
+The ``banner line'' defined here should be changed whenever \.{CTANGLE}
+is modified.
+
+@d banner "This is CTANGLE (Version 3.64)\n"
+@y
+The ``banner line'' defined here should be changed whenever \.{CTANGLE}
+is modified.
+
+@d banner "This is CTANGLE (Version 3.64pc/big)\n"
+@z
+
+
+@x Section 4.
+@ The following parameters were sufficient in the original \.{TANGLE} to
+handle \TEX/,
+so they should be sufficient for most applications of \.{CTANGLE}.
+If you change |max_bytes|, |max_names| or |hash_size| you should also
+change them in the file |"common.w"|.
+
+@d max_bytes 90000 /* the number of bytes in identifiers,
+ index entries, and section names; used in |"common.w"| */
+@d max_toks 270000 /* number of bytes in compressed \CEE/ code */
+@d max_names 4000 /* number of identifiers, strings, section names;
+ must be less than 10240; used in |"common.w"| */
+@d max_texts 2500 /* number of replacement texts, must be less than 10240 */
+@d hash_size 353 /* should be prime; used in |"common.w"| */
+@d longest_name 1000 /* section names shouldn't be longer than this */
+@d stack_size 50 /* number of simultaneous levels of macro expansion */
+@d buf_size 100 /* for \.{CWEAVE} and \.{CTANGLE} */
+@y
+@ The following parameters were sufficient in the original \.{TANGLE} to
+handle \TEX/,
+so they should be sufficient for most applications of \.{CTANGLE}.
+If you change |max_bytes|, |max_names| or |hash_size| you should also
+change them in the file |"common.w"|.
+
+(This is a modified version of \.{CTANGLE}, and in fact one of the parameters
+has been reduced in value. The parameter |max_toks|
+has been reduced from 270000 [which
+was sufficient to handle \TEX/] to
+170000, so that \.{CTANGLE}
+may be run on {\mc MSDOS}
+systems that are tight on memory. Consider, for
+instance, an 80286-based machine with several TSRs and drivers, trying
+to run \.{CTANGLE} from a makefile.)
+
+@d max_bytes 90000 /* the number of bytes in identifiers,
+ index entries, and section names; used in |"common.w"| */
+@d max_toks 170000 /* number of bytes in compressed \CEE/ code */
+@d max_names 4000 /* number of identifiers, strings, section names;
+ must be less than 10240; used in |"common.w"| */
+@d max_texts 2500 /* number of replacement texts, must be less than 10240 */
+@d hash_size 353 /* should be prime; used in |"common.w"| */
+@d longest_name 1000 /* section names shouldn't be longer than this */
+@d stack_size 50 /* number of simultaneous levels of macro expansion */
+@d buf_size 100 /* for \.{CWEAVE} and \.{CTANGLE} */
+@z
+
+
+@x Section 9.
+@d chunk_marker 0
+
+@<Common code...@>=
+typedef struct name_info {
+ char *byte_start; /* beginning of the name in |byte_mem| */
+ struct name_info *link;
+ union {
+ struct name_info *Rlink; /* right link in binary search tree for section
+ names */
+ char Ilk; /* used by identifiers in \.{CWEAVE} only */
+ } dummy;
+ char *equiv_or_xref; /* info corresponding to names */
+} name_info; /* contains information about an identifier or section name */
+typedef name_info *name_pointer; /* pointer into array of \&{name\_info}s */
+typedef name_pointer *hash_pointer;
+extern char byte_mem[]; /* characters of names */
+extern char *byte_mem_end; /* end of |byte_mem| */
+extern name_info name_dir[]; /* information about names */
+extern name_pointer name_dir_end; /* end of |name_dir| */
+extern name_pointer name_ptr; /* first unused position in |byte_start| */
+extern char *byte_ptr; /* first unused position in |byte_mem| */
+extern name_pointer hash[]; /* heads of hash lists */
+extern hash_pointer hash_end; /* end of |hash| */
+extern hash_pointer h; /* index into hash-head array */
+extern name_pointer id_lookup(); /* looks up a string in the identifier table */
+extern name_pointer section_lookup(); /* finds section name */
+extern void print_section_name(), sprint_section_name();
+@y
+@d chunk_marker 0
+
+@f huge extern
+
+@<Common code...@>=
+typedef struct name_info {
+ char huge* byte_start; /* beginning of the name in |byte_mem| */
+ struct name_info *link;
+ union {
+ struct name_info *Rlink; /* right link in binary search tree for section
+ names */
+ char Ilk; /* used by identifiers in \.{CWEAVE} only */
+ } dummy;
+ union {
+ char *equiv_member;
+ char huge* xref_member;
+ } ptr_union; /* info corresponding to names */
+} name_info; /* contains information about an identifier or section name */
+typedef name_info *name_pointer; /* pointer into array of \&{name\_info}s */
+typedef name_pointer *hash_pointer;
+extern char huge byte_mem[]; /* characters of names */
+extern char huge* byte_mem_end; /* end of |byte_mem| */
+extern name_info name_dir[]; /* information about names */
+extern name_pointer name_dir_end; /* end of |name_dir| */
+extern name_pointer name_ptr; /* first unused position in |byte_start| */
+extern char huge* byte_ptr; /* first unused position in |byte_mem| */
+extern name_pointer hash[]; /* heads of hash lists */
+extern hash_pointer hash_end; /* end of |hash| */
+extern hash_pointer h; /* index into hash-head array */
+extern name_pointer id_lookup(); /* looks up a string in the identifier table */
+extern name_pointer section_lookup(); /* finds section name */
+extern void print_section_name(), sprint_section_name();
+@z
+
+
+@x Section 16.
+ eight_bits *tok_start; /* pointer into |tok_mem| */
+ sixteen_bits text_link; /* relates replacement texts */
+} text;
+typedef text *text_pointer;
+@y
+ eight_bits huge* tok_start; /* pointer into |tok_mem| */
+ sixteen_bits text_link; /* relates replacement texts */
+} text;
+typedef text *text_pointer;
+@z
+
+
+@x Section 17.
+eight_bits tok_mem[max_toks];
+eight_bits *tok_mem_end=tok_mem+max_toks-1;
+eight_bits *tok_ptr; /* first unused position in |tok_mem| */
+@y
+eight_bits huge tok_mem[max_toks];
+eight_bits huge* tok_mem_end;
+eight_bits huge* tok_ptr; /* first unused position in |tok_mem| */
+@z
+
+
+@x Section 18.
+text_info->tok_start=tok_ptr=tok_mem;
+text_ptr=text_info+1; text_ptr->tok_start=tok_mem;
+ /* this makes replacement text 0 of length zero */
+@y
+tok_mem_end=tok_mem+max_toks-1;
+text_info->tok_start=tok_ptr=tok_mem;
+text_ptr=text_info+1; text_ptr->tok_start=tok_mem;
+ /* this makes replacement text 0 of length zero */
+@z
+
+
+@x Section 19.
+@d equiv equiv_or_xref /* info corresponding to names */
+@y
+@d equiv ptr_union.equiv_member /* info corresponding to names */
+@z
+
+
+@x Section 27.
+ eight_bits *end_field; /* ending location of replacement text */
+ eight_bits *byte_field; /* present location within replacement text */
+@y
+ eight_bits huge* end_field; /* ending location of replacement text */
+ eight_bits huge* byte_field; /* present location within replacement text */
+@z
+
+
+@x Section 49.
+out_char(cur_char)
+eight_bits cur_char;
+{
+ char *j, *k; /* pointer into |byte_mem| */
+@y
+out_char(cur_char)
+eight_bits cur_char;
+{
+ char huge* j, huge* k; /* pointer into |byte_mem| */
+@z
diff --git a/Build/source/texk/web2c/cwebdir/ctang-man.ch b/Build/source/texk/web2c/cwebdir/ctang-man.ch
new file mode 100644
index 00000000000..12e9d3248ef
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctang-man.ch
@@ -0,0 +1,22 @@
+Change file to help make Appendix E of the full CWEB manual
+@x
+\def\botofcontents{\vfill
+\noindent
+Copyright \copyright\ 1987, 1990, 1993, 2000 Silvio Levy and Donald E. Knuth
+\bigskip\noindent
+Permission is granted to make and distribute verbatim copies of this
+document provided that the copyright notice and this permission notice
+are preserved on all copies.
+
+\smallskip\noindent
+Permission is granted to copy and distribute modified versions of this
+document under the conditions for verbatim copying, provided that the
+entire resulting derived work is given a different name and distributed
+under the terms of a permission notice identical to this one.
+}
+@y
+\def\botofcontents{\vfill\titlefalse}
+\def\contentspagenumber{63}
+\def\title{APPENDIX E: CTANGLE}
+\let\K=\leftarrow
+@z
diff --git a/Build/source/texk/web2c/cwebdir/ctang-pc.ch b/Build/source/texk/web2c/cwebdir/ctang-pc.ch
new file mode 100644
index 00000000000..67f32fae0c2
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctang-pc.ch
@@ -0,0 +1,24 @@
+This is the change file for CWEB's CTANGLE under DOS
+(Contributed by Lee Wittenberg, March 1993)
+
+Changes necessary for compiling with Borland C/C++
+Use compilation switches -mc -w-pro -Ff=5000
+
+Note: The changes to section 4 are not necessary if using a compiler
+that allows >64K arrays. If you need lots of bytes and toks, try the
+alternate change files with -bs suffix instead of -pc.
+
+@x section 1
+@d banner "This is CTANGLE (Version 3.64)\n"
+@y
+@d banner "This is CTANGLE (Version 3.64pc)\n"
+@z
+@x section 4
+@d max_bytes 90000 /* the number of bytes in identifiers,
+ index entries, and section names; used in |"common.w"| */
+@d max_toks 270000 /* number of bytes in compressed \CEE/ code */
+@y (note that CWEAVE itself needs only about 42K toks)
+@d max_bytes (unsigned)60000 /* the number of bytes in identifiers,
+ index entries, and section names; used in |"common.w"| */
+@d max_toks (unsigned)60000 /* number of bytes in compressed \CEE/ code */
+@z
diff --git a/Build/source/texk/web2c/cwebdir/ctang-ql.ch b/Build/source/texk/web2c/cwebdir/ctang-ql.ch
new file mode 100644
index 00000000000..a0920243a97
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctang-ql.ch
@@ -0,0 +1,25 @@
+This is the change file for CWEB's CTANGLE under QDOS/SMSQ
+(Contributed by Robert H. Klein, September 1994)
+
+This change file is intended for use with C68 v4.13 (or later).
+compile with
+ex <dev_>cc;"-v -h -c -=500000 ctangle_c"
+
+
+@x
+\def\title{CTANGLE (Version 3.64)}
+@y
+\def\title{CTANGLE (QL Version 3.64)}
+@z
+
+@x section 1
+@d banner "This is CTANGLE (Version 3.64)\n"
+@y
+@d banner "This is CTANGLE (QL Version 3.64)\n"
+@z
+
+@x
+@i common.h
+@y
+@i common_h
+@z
diff --git a/Build/source/texk/web2c/cwebdir/ctang-vms.ch b/Build/source/texk/web2c/cwebdir/ctang-vms.ch
new file mode 100644
index 00000000000..7e538abc27f
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctang-vms.ch
@@ -0,0 +1,35 @@
+This is the change file for CWEB's CTANGLE for VAX/VMS.
+
+created:
+ 01-FEB-1992 ST (Stephan Trebels <trebels@ams02.dnet.gwdg.de>)
+ > include ctype,stdio from textlibrary SYS$SHARE:VAXCDEF.TLB
+ > change banner line to include (VAX/VMS)
+ ? will someone make a CLD interface? (should be easy)
+
+(also modified by Don Knuth to keep version numbers uptodate)
+(these changes not necessary for initial bootstrapping)
+
+@x section 1 (01-FEB-1992 ST)
+@d banner "This is CTANGLE (Version 3.64)\n"
+@y
+@d banner "This is CTANGLE (VAX/VMS Version 3.64)\n"
+@z
+
+@x section 6 (from common.h) (01-FEB-1992 ST)
+#include <stdio.h>
+@y
+#include stdio /* VMS searches Textlibraries faster */
+@z
+
+@x section 62 (01-FEB-1992 ST)
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+@y
+#include ctype /* definition of |isalpha|, |isdigit| and so on */
+ /* VMS searches text libraries faster */
+@z
+
+@x section 63 (01-FEB-1992 ST)
+@d isxalpha(c) ((c)=='_') /* non-alpha character allowed in identifier */
+@y
+@d isxalpha(c) ((c)=='_' || (c)=='$') /* non-alpha characters allowed in id */
+@z
diff --git a/Build/source/texk/web2c/cwebdir/ctang-w2c.ch b/Build/source/texk/web2c/cwebdir/ctang-w2c.ch
new file mode 100644
index 00000000000..0e71a5d5f73
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctang-w2c.ch
@@ -0,0 +1,375 @@
+% Kpathsea changes for CWEB by Wlodek Bzyl and Olaf Weber
+% Copyright 2002 Wlodek Bzyl and Olaf Weber
+% This file is in the Public Domain.
+
+@x l.27
+\def\title{CTANGLE (Version 3.64)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont The {\ttitlefont CTANGLE} processor}
+ \vskip 15pt
+ \centerline{(Version 3.64)}
+ \vfill}
+@y
+\def\title{CTANGLE (Version 3.64k)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont The {\ttitlefont CTANGLE} processor}
+ \vskip 15pt
+ \centerline{(Version 3.64k)}
+ \vfill}
+@z
+
+This change can not be applied when `tie' is used
+(TOC file can not be typeset).
+
+%@x l.48
+%\let\maybe=\iftrue
+%@y
+%\let\maybe=\iffalse % print only sections that change
+%@z
+
+
+Section 1.
+
+@x l.49
+The ``banner line'' defined here should be changed whenever \.{CTANGLE}
+is modified.
+
+@d banner "This is CTANGLE (Version 3.64)\n"
+@y
+The ``banner line'' defined here should be changed whenever \.{CTANGLE}
+is modified.
+
+@d banner "This is CTANGLE, Version 3.64"
+@z
+
+
+Section 2.
+
+@x l.72
+@ We predeclare several standard system functions here instead of including
+their system header files, because the names of the header files are not as
+standard as the names of the functions. (For example, some \CEE/ environments
+have \.{<string.h>} where others have \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern int strcmp(); /* compare strings lexicographically */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+@y
+@z
+
+Section 3.
+
+@x l.92
+int main (ac, av)
+int ac;
+char **av;
+@y
+int main P2C(int,ac, char**,av)
+@z
+
+@x l.100 - Add Web2C version to banner.
+ if (show_banner) printf(banner); /* print a ``banner line'' */
+@y
+ if (show_banner) {
+ printf("%s%s\n", banner, versionstring); /* print a ``banner line'' */
+ }
+@z
+
+Section 5.
+
+@x common.h l.30 - boolean comes from kpathsea.
+typedef short boolean;
+@y
+@z
+
+Section 6.
+
+@x l.36
+#include <stdio.h>
+@y
+#include <stdio.h>
+/* #include "cpascal.h" ??? */
+extern char *versionstring;
+#include <kpathsea/kpathsea.h>
+@z
+
+Section 9.
+
+@x common.h l.109
+extern name_pointer id_lookup(); /* looks up a string in the identifier table */
+extern name_pointer section_lookup(); /* finds section name */
+extern void print_section_name(), sprint_section_name();
+@y
+/* looks up a string in the identifier table */
+extern name_pointer id_lookup P3H(char*,char*,char);
+/* finds section name */
+extern name_pointer section_lookup P3H(char*,char*,char);
+extern void print_section_name P1H(name_pointer);
+extern void sprint_section_name P2H(char*,name_pointer);
+@z
+
+Section 10.
+
+@x common.h l.123 - explicit types.
+extern history; /* indicates how bad this run was */
+extern err_print(); /* print error message and context */
+extern wrap_up(); /* indicate |history| and exit */
+extern void fatal(); /* issue error message and die */
+extern void overflow(); /* succumb because a table has overflowed */
+@y
+extern int history; /* indicates how bad this run was */
+extern void err_print P1H(char*); /* print error message and context */
+extern int wrap_up P1H(void); /* indicate |history| and exit */
+extern void fatal P2H(char*,char*); /* issue error message and die */
+extern void overflow P1H(char*); /* succumb because a table has overflowed */
+@z
+
+Section 11.
+
+@x common.h l.131 - max_file_name_length is way too small.
+@d max_file_name_length 60
+@y
+@d max_file_name_length 1024
+@z
+
+@x common.h l.138 - explicit types.
+extern include_depth; /* current level of nesting */
+@y
+extern int include_depth; /* current level of nesting */
+@z
+
+@x common.h l.148 - explicit types.
+extern line[]; /* number of current line in the stacked files */
+extern change_line; /* number of current line in change file */
+@y
+extern int line[]; /* number of current line in the stacked files */
+extern int change_line; /* number of current line in change file */
+@z
+
+@x common.h l.153 - explicit types.
+extern reset_input(); /* initialize to read the web file and change file */
+extern get_line(); /* inputs the next line */
+extern check_complete(); /* checks that all changes were picked up */
+@y
+extern void reset_input P1H(void); /* initialize to read the web file and change file */
+extern int get_line P1H(void); /* inputs the next line */
+extern void check_complete P1H(void); /* checks that all changes were picked up */
+@z
+
+Section 15.
+
+@x common.h l.192
+extern void common_init();
+@y
+extern void common_init P1H(void);
+@z
+
+Section 21.
+
+@x l.184
+int names_match(p,first,l)
+name_pointer p; /* points to the proposed match */
+char *first; /* position of first character of string */
+int l; /* length of identifier */
+@y
+int names_match P4C(name_pointer,p, char*,first, int,l, char,t)
+@z
+
+Section 22.
+
+@x l.200
+init_node(node)
+name_pointer node;
+@y
+init_node P1C(name_pointer,node)
+@z
+
+@x l.207
+init_p() {}
+@y
+init_p P2C(name_pointer,p, char,t) {}
+@z
+
+Section 26.
+
+@x l.262
+store_two_bytes(x)
+sixteen_bits x;
+@y
+store_two_bytes P1C(sixteen_bits,x)
+@z
+
+Section 30.
+
+@x l.338
+push_level(p) /* suspends the current level */
+name_pointer p;
+@y
+push_level P1C(name_pointer,p) /* suspends the current level */
+@z
+
+Section 31.
+
+@x l.357
+pop_level(flag) /* do this when |cur_byte| reaches |cur_end| */
+int flag; /* |flag==0| means we are in |output_defs| */
+@y
+pop_level P1C(int,flag) /* do this when |cur_byte| reaches |cur_end| */
+@z
+
+Section 33.
+
+@x l.393
+get_output() /* sends next token to |out_char| */
+@y
+get_output P1H(void) /* sends next token to |out_char| */
+@z
+
+Section 37.
+
+@x l.483
+flush_buffer() /* writes one line to output file */
+@y
+flush_buffer P1H(void) /* writes one line to output file */
+@z
+
+Section 41.
+
+@x l.534
+void phase_two();
+@y
+void phase_two P1H(void);
+@z
+
+Section 42.
+
+@x l.538
+phase_two () {
+@y
+phase_two P1H(void) {
+@z
+
+Section 46.
+
+@x l.603
+void output_defs();
+@y
+void output_defs P1H(void);
+@z
+
+Section 47.
+
+@x l.607
+output_defs()
+@y
+output_defs P1H(void)
+@z
+
+Section 48.
+
+@x l.649
+static void out_char();
+@y
+static void out_char P1H(eight_bits);
+@z
+
+Section 49.
+
+@x l.653
+out_char(cur_char)
+eight_bits cur_char;
+@y
+out_char P1C(eight_bits,cur_char)
+@z
+
+Section 58.
+
+@x l.815
+skip_ahead() /* skip to next control code */
+@y
+skip_ahead P1H(void) /* skip to next control code */
+@z
+
+Section 60.
+
+@x l.849
+int skip_comment(is_long_comment) /* skips over comments */
+boolean is_long_comment;
+@y
+int skip_comment P1C(boolean,is_long_comment) /* skips over comments */
+@z
+
+Section 62
+
+@x l.889 - add declaration of versionstring.
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+@y
+@z
+
+Section 63.
+
+@x l.902
+get_next() /* produces the next input token */
+@y
+get_next P1H(void) /* produces the next input token */
+@z
+
+Section 76.
+
+@x l.1201
+scan_repl(t) /* creates a replacement text */
+eight_bits t;
+@y
+scan_repl P1C(eight_bits,t) /* creates a replacement text */
+@z
+
+Section 83.
+
+@x l.1359
+scan_section()
+@y
+scan_section P1H(void)
+@z
+
+Section 90.
+
+@x l.1458
+void phase_one();
+@y
+void phase_one P1H(void);
+@z
+
+Section 91.
+
+@x l.1462
+phase_one() {
+@y
+phase_one P1H(void) {
+@z
+
+Section 92.
+
+@x l.1476
+void skip_limbo();
+@y
+void skip_limbo P1H(void);
+@z
+
+Section 93.
+
+@x l.1480
+skip_limbo()
+@y
+skip_limbo P1H(void)
+@z
+
+Section 95.
+
+@x l.1535
+print_stats() {
+@y
+print_stats P1H(void) {
+@z
diff --git a/Build/source/texk/web2c/cwebdir/ctang-w32.ch b/Build/source/texk/web2c/cwebdir/ctang-w32.ch
new file mode 100644
index 00000000000..523985ce3da
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctang-w32.ch
@@ -0,0 +1,66 @@
+This is the change file for CWEB's CTANGLE under Win32
+(Contributed by Fabrice Popineau, February 2002)
+
+Changes necessary for compiling with Borland C/C++
+
+@x section 1
+@d banner "This is CTANGLE (Version 3.64)\n"
+@y
+@d banner "This is CTANGLE (Version 3.64win32)\n"
+@z
+
+@x
+@ We predeclare several standard system functions here instead of including
+their system header files, because the names of the header files are not as
+standard as the names of the functions. (For example, some \CEE/ environments
+have \.{<string.h>} where others have \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern int strcmp(); /* compare strings lexicographically */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+@y
+@z
+
+@x
+int names_match(p,first,l)
+name_pointer p; /* points to the proposed match */
+char *first; /* position of first character of string */
+@y
+int __cdecl names_match(p,first,l)
+name_pointer p; /* points to the proposed match */
+char *first; /* position of first character of string */
+@z
+
+@x
+void
+init_node(node)
+name_pointer node;
+{
+ node->equiv=(char *)text_info;
+}
+void
+init_p() {}
+@y
+void
+init_node(node)
+name_pointer node;
+{
+ node->equiv=(char *)text_info;
+}
+void __cdecl
+init_p() {}
+@z
+
+@x
+@ @<Include...@>=
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+#include <stdlib.h> /* definition of |exit| */
+@y
+@ @<Include...@>=
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+#include <stdlib.h> /* definition of |exit| */
+#include <string.h>
+@z
diff --git a/Build/source/texk/web2c/cwebdir/ctangle.c b/Build/source/texk/web2c/cwebdir/ctangle.c
new file mode 100644
index 00000000000..01fa7c407cd
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctangle.c
@@ -0,0 +1,1566 @@
+/*1:*/
+#line 64 "ctangle.w"
+
+/*6:*/
+#line 35 "common.h"
+
+#include <stdio.h>
+
+/*:6*//*62:*/
+#line 888 "ctangle.w"
+
+#include <ctype.h>
+#include <stdlib.h>
+
+/*:62*/
+#line 65 "ctangle.w"
+
+#define banner "This is CTANGLE (Version 3.64)\n" \
+
+#define max_bytes 90000 \
+
+#define max_toks 270000
+#define max_names 4000 \
+
+#define max_texts 2500
+#define hash_size 353
+#define longest_name 10000
+#define stack_size 50
+#define buf_size 100 \
+
+#define ctangle 0
+#define cweave 1 \
+
+#define and_and 04
+#define lt_lt 020
+#define gt_gt 021
+#define plus_plus 013
+#define minus_minus 01
+#define minus_gt 031
+#define not_eq 032
+#define lt_eq 034
+#define gt_eq 035
+#define eq_eq 036
+#define or_or 037
+#define dot_dot_dot 016
+#define colon_colon 06
+#define period_ast 026
+#define minus_gt_ast 027 \
+
+#define xisalpha(c) (isalpha(c) &&((eight_bits) c<0200) )
+#define xisdigit(c) (isdigit(c) &&((eight_bits) c<0200) )
+#define xisspace(c) (isspace(c) &&((eight_bits) c<0200) )
+#define xislower(c) (islower(c) &&((eight_bits) c<0200) )
+#define xisupper(c) (isupper(c) &&((eight_bits) c<0200) )
+#define xisxdigit(c) (isxdigit(c) &&((eight_bits) c<0200) ) \
+
+#define length(c) (c+1) ->byte_start-(c) ->byte_start
+#define print_id(c) term_write((c) ->byte_start,length((c) ) )
+#define llink link
+#define rlink dummy.Rlink
+#define root name_dir->rlink \
+
+#define chunk_marker 0 \
+
+#define spotless 0
+#define harmless_message 1
+#define error_message 2
+#define fatal_message 3
+#define mark_harmless {if(history==spotless) history= harmless_message;}
+#define mark_error history= error_message
+#define confusion(s) fatal("! This can't happen: ",s) \
+
+#define max_file_name_length 60
+#define cur_file file[include_depth]
+#define cur_file_name file_name[include_depth]
+#define web_file_name file_name[0]
+#define cur_line line[include_depth] \
+
+#define show_banner flags['b']
+#define show_progress flags['p']
+#define show_happiness flags['h'] \
+
+#define update_terminal fflush(stdout)
+#define new_line putchar('\n')
+#define putxchar putchar
+#define term_write(a,b) fflush(stdout) ,fwrite(a,sizeof(char) ,b,stdout)
+#define C_printf(c,a) fprintf(C_file,c,a)
+#define C_putc(c) putc(c,C_file) \
+
+#define equiv equiv_or_xref \
+
+#define section_flag max_texts \
+
+#define string 02
+#define join 0177
+#define output_defs_flag (2*024000-1) \
+
+#define cur_end cur_state.end_field
+#define cur_byte cur_state.byte_field
+#define cur_name cur_state.name_field
+#define cur_repl cur_state.repl_field
+#define cur_section cur_state.section_field \
+
+#define section_number 0201
+#define identifier 0202 \
+
+#define normal 0
+#define num_or_id 1
+#define post_slash 2
+#define unbreakable 3
+#define verbatim 4 \
+
+#define max_files 256
+#define translit_length 10 \
+
+#define ignore 0
+#define ord 0302
+#define control_text 0303
+#define translit_code 0304
+#define output_defs_code 0305
+#define format_code 0306
+#define definition 0307
+#define begin_C 0310
+#define section_name 0311
+#define new_section 0312 \
+
+#define constant 03 \
+
+#define isxalpha(c) ((c) =='_'||(c) =='$') \
+
+#define ishigh(c) ((unsigned char) (c) > 0177) \
+ \
+
+#define compress(c) if(loc++<=limit) return(c) \
+
+#define macro 0
+#define app_repl(c) {if(tok_ptr==tok_mem_end) overflow("token") ;*tok_ptr++= c;} \
+
+
+#line 66 "ctangle.w"
+
+/*5:*/
+#line 29 "common.h"
+
+typedef short boolean;
+typedef char unsigned eight_bits;
+extern boolean program;
+extern int phase;
+
+/*:5*//*7:*/
+#line 57 "common.h"
+
+char section_text[longest_name+1];
+char*section_text_end= section_text+longest_name;
+char*id_first;
+char*id_loc;
+
+/*:7*//*8:*/
+#line 72 "common.h"
+
+extern char buffer[];
+extern char*buffer_end;
+extern char*loc;
+extern char*limit;
+
+/*:8*//*9:*/
+#line 87 "common.h"
+
+typedef struct name_info{
+char*byte_start;
+struct name_info*link;
+union{
+struct name_info*Rlink;
+
+char Ilk;
+}dummy;
+char*equiv_or_xref;
+}name_info;
+typedef name_info*name_pointer;
+typedef name_pointer*hash_pointer;
+extern char byte_mem[];
+extern char*byte_mem_end;
+extern name_info name_dir[];
+extern name_pointer name_dir_end;
+extern name_pointer name_ptr;
+extern char*byte_ptr;
+extern name_pointer hash[];
+extern hash_pointer hash_end;
+extern hash_pointer h;
+extern name_pointer id_lookup();
+extern name_pointer section_lookup();
+extern void print_section_name(),sprint_section_name();
+
+/*:9*//*10:*/
+#line 122 "common.h"
+
+extern history;
+extern err_print();
+extern wrap_up();
+extern void fatal();
+extern void overflow();
+
+/*:10*//*11:*/
+#line 137 "common.h"
+
+extern include_depth;
+extern FILE*file[];
+extern FILE*change_file;
+extern char C_file_name[];
+extern char tex_file_name[];
+extern char idx_file_name[];
+extern char scn_file_name[];
+extern char file_name[][max_file_name_length];
+
+extern char change_file_name[];
+extern line[];
+extern change_line;
+extern boolean input_has_ended;
+extern boolean changing;
+extern boolean web_file_open;
+extern reset_input();
+extern get_line();
+extern check_complete();
+
+/*:11*//*12:*/
+#line 158 "common.h"
+
+typedef unsigned short sixteen_bits;
+extern sixteen_bits section_count;
+extern boolean changed_section[];
+extern boolean change_pending;
+extern boolean print_where;
+
+/*:12*//*13:*/
+#line 170 "common.h"
+
+extern int argc;
+extern char**argv;
+extern boolean flags[];
+
+/*:13*//*14:*/
+#line 182 "common.h"
+
+extern FILE*C_file;
+extern FILE*tex_file;
+extern FILE*idx_file;
+extern FILE*scn_file;
+extern FILE*active_file;
+
+/*:14*//*15:*/
+#line 191 "common.h"
+
+extern void common_init();
+#line 128 "ctangle.w"
+
+/*:15*/
+#line 67 "ctangle.w"
+
+/*16:*/
+#line 152 "ctangle.w"
+
+typedef struct{
+eight_bits*tok_start;
+sixteen_bits text_link;
+}text;
+typedef text*text_pointer;
+
+/*:16*//*27:*/
+#line 296 "ctangle.w"
+
+typedef struct{
+eight_bits*end_field;
+eight_bits*byte_field;
+name_pointer name_field;
+text_pointer repl_field;
+sixteen_bits section_field;
+}output_state;
+typedef output_state*stack_pointer;
+
+/*:27*/
+#line 68 "ctangle.w"
+
+/*17:*/
+#line 159 "ctangle.w"
+
+text text_info[max_texts];
+text_pointer text_info_end= text_info+max_texts-1;
+text_pointer text_ptr;
+eight_bits tok_mem[max_toks];
+eight_bits*tok_mem_end= tok_mem+max_toks-1;
+eight_bits*tok_ptr;
+
+/*:17*//*23:*/
+#line 227 "ctangle.w"
+
+text_pointer last_unnamed;
+
+/*:23*//*28:*/
+#line 312 "ctangle.w"
+
+output_state cur_state;
+
+output_state stack[stack_size+1];
+stack_pointer stack_ptr;
+stack_pointer stack_end= stack+stack_size;
+
+/*:28*//*32:*/
+#line 384 "ctangle.w"
+
+int cur_val;
+
+/*:32*//*36:*/
+#line 473 "ctangle.w"
+
+eight_bits out_state;
+boolean protect;
+
+/*:36*//*38:*/
+#line 502 "ctangle.w"
+
+name_pointer output_files[max_files];
+name_pointer*cur_out_file,*end_output_files,*an_output_file;
+char cur_section_name_char;
+char output_file_name[longest_name];
+
+/*:38*//*45:*/
+#line 599 "ctangle.w"
+
+boolean output_defs_seen= 0;
+
+/*:45*//*51:*/
+#line 710 "ctangle.w"
+
+char translit[128][translit_length];
+
+/*:51*//*56:*/
+#line 789 "ctangle.w"
+
+eight_bits ccode[256];
+
+/*:56*//*59:*/
+#line 845 "ctangle.w"
+
+boolean comment_continues= 0;
+
+/*:59*//*61:*/
+#line 884 "ctangle.w"
+
+name_pointer cur_section_name;
+int no_where;
+
+/*:61*//*75:*/
+#line 1195 "ctangle.w"
+
+text_pointer cur_text;
+eight_bits next_control;
+
+/*:75*//*82:*/
+#line 1350 "ctangle.w"
+
+extern sixteen_bits section_count;
+
+/*:82*/
+#line 69 "ctangle.w"
+
+/*2:*/
+#line 77 "ctangle.w"
+
+extern int strlen();
+extern int strcmp();
+extern char*strcpy();
+extern int strncmp();
+extern char*strncpy();
+
+/*:2*//*41:*/
+#line 533 "ctangle.w"
+
+void phase_two();
+
+/*:41*//*46:*/
+#line 602 "ctangle.w"
+
+void output_defs();
+
+/*:46*//*48:*/
+#line 648 "ctangle.w"
+
+static void out_char();
+
+/*:48*//*90:*/
+#line 1457 "ctangle.w"
+
+void phase_one();
+
+/*:90*//*92:*/
+#line 1475 "ctangle.w"
+
+void skip_limbo();
+
+/*:92*/
+#line 70 "ctangle.w"
+
+
+/*:1*//*3:*/
+#line 91 "ctangle.w"
+
+int main(ac,av)
+int ac;
+char**av;
+{
+argc= ac;argv= av;
+program= ctangle;
+/*18:*/
+#line 167 "ctangle.w"
+
+text_info->tok_start= tok_ptr= tok_mem;
+text_ptr= text_info+1;text_ptr->tok_start= tok_mem;
+
+
+/*:18*//*20:*/
+#line 177 "ctangle.w"
+
+name_dir->equiv= (char*)text_info;
+
+/*:20*//*24:*/
+#line 230 "ctangle.w"
+last_unnamed= text_info;text_info->text_link= 0;
+
+/*:24*//*39:*/
+#line 512 "ctangle.w"
+
+cur_out_file= end_output_files= output_files+max_files;
+
+/*:39*//*52:*/
+#line 713 "ctangle.w"
+
+{
+int i;
+for(i= 0;i<128;i++)sprintf(translit[i],"X%02X",(unsigned)(128+i));
+}
+
+/*:52*//*57:*/
+#line 792 "ctangle.w"
+{
+int c;
+for(c= 0;c<256;c++)ccode[c]= ignore;
+ccode[' ']= ccode['\t']= ccode['\n']= ccode['\v']= ccode['\r']= ccode['\f']
+= ccode['*']= new_section;
+ccode['@']= '@';ccode['=']= string;
+ccode['d']= ccode['D']= definition;
+ccode['f']= ccode['F']= ccode['s']= ccode['S']= format_code;
+ccode['c']= ccode['C']= ccode['p']= ccode['P']= begin_C;
+ccode['^']= ccode[':']= ccode['.']= ccode['t']= ccode['T']=
+ccode['q']= ccode['Q']= control_text;
+ccode['h']= ccode['H']= output_defs_code;
+ccode['l']= ccode['L']= translit_code;
+ccode['&']= join;
+ccode['<']= ccode['(']= section_name;
+ccode['\'']= ord;
+}
+
+/*:57*//*71:*/
+#line 1116 "ctangle.w"
+section_text[0]= ' ';
+
+/*:71*/
+#line 98 "ctangle.w"
+;
+common_init();
+if(show_banner)printf(banner);
+phase_one();
+phase_two();
+return wrap_up();
+}
+
+/*:3*//*21:*/
+#line 183 "ctangle.w"
+
+int names_match(p,first,l)
+name_pointer p;
+char*first;
+int l;
+{
+if(length(p)!=l)return 0;
+return!strncmp(first,p->byte_start,l);
+}
+
+/*:21*//*22:*/
+#line 198 "ctangle.w"
+
+void
+init_node(node)
+name_pointer node;
+{
+node->equiv= (char*)text_info;
+}
+void
+init_p(){}
+
+/*:22*//*26:*/
+#line 260 "ctangle.w"
+
+void
+store_two_bytes(x)
+sixteen_bits x;
+{
+if(tok_ptr+2> tok_mem_end)overflow("token");
+*tok_ptr++= x>>8;
+*tok_ptr++= x&0377;
+}
+
+/*:26*//*30:*/
+#line 336 "ctangle.w"
+
+void
+push_level(p)
+name_pointer p;
+{
+if(stack_ptr==stack_end)overflow("stack");
+*stack_ptr= cur_state;
+stack_ptr++;
+if(p!=NULL){
+cur_name= p;cur_repl= (text_pointer)p->equiv;
+cur_byte= cur_repl->tok_start;cur_end= (cur_repl+1)->tok_start;
+cur_section= 0;
+}
+}
+
+/*:30*//*31:*/
+#line 355 "ctangle.w"
+
+void
+pop_level(flag)
+int flag;
+{
+if(flag&&cur_repl->text_link<section_flag){
+cur_repl= cur_repl->text_link+text_info;
+cur_byte= cur_repl->tok_start;cur_end= (cur_repl+1)->tok_start;
+return;
+}
+stack_ptr--;
+if(stack_ptr> stack)cur_state= *stack_ptr;
+}
+
+/*:31*//*33:*/
+#line 391 "ctangle.w"
+
+void
+get_output()
+{
+sixteen_bits a;
+restart:if(stack_ptr==stack)return;
+if(cur_byte==cur_end){
+cur_val= -((int)cur_section);
+pop_level(1);
+if(cur_val==0)goto restart;
+out_char(section_number);return;
+}
+a= *cur_byte++;
+if(out_state==verbatim&&a!=string&&a!=constant&&a!='\n')
+C_putc(a);
+else if(a<0200)out_char(a);
+else{
+a= (a-0200)*0400+*cur_byte++;
+switch(a/024000){
+case 0:cur_val= a;out_char(identifier);break;
+case 1:if(a==output_defs_flag)output_defs();
+else/*34:*/
+#line 423 "ctangle.w"
+
+{
+a-= 024000;
+if((a+name_dir)->equiv!=(char*)text_info)push_level(a+name_dir);
+else if(a!=0){
+printf("\n! Not present: <");
+print_section_name(a+name_dir);err_print(">");
+
+}
+goto restart;
+}
+
+/*:34*/
+#line 412 "ctangle.w"
+;
+break;
+default:cur_val= a-050000;if(cur_val> 0)cur_section= cur_val;
+out_char(section_number);
+}
+}
+}
+
+/*:33*//*37:*/
+#line 481 "ctangle.w"
+
+void
+flush_buffer()
+{
+C_putc('\n');
+if(cur_line%100==0&&show_progress){
+printf(".");
+if(cur_line%500==0)printf("%d",cur_line);
+update_terminal;
+}
+cur_line++;
+}
+
+/*:37*//*42:*/
+#line 536 "ctangle.w"
+
+void
+phase_two(){
+web_file_open= 0;
+cur_line= 1;
+/*29:*/
+#line 325 "ctangle.w"
+
+stack_ptr= stack+1;cur_name= name_dir;cur_repl= text_info->text_link+text_info;
+cur_byte= cur_repl->tok_start;cur_end= (cur_repl+1)->tok_start;cur_section= 0;
+
+/*:29*/
+#line 541 "ctangle.w"
+;
+/*44:*/
+#line 595 "ctangle.w"
+
+if(!output_defs_seen)
+output_defs();
+
+/*:44*/
+#line 542 "ctangle.w"
+;
+if(text_info->text_link==0&&cur_out_file==end_output_files){
+printf("\n! No program text was specified.");mark_harmless;
+
+}
+else{
+if(cur_out_file==end_output_files){
+if(show_progress)
+printf("\nWriting the output file (%s):",C_file_name);
+}
+else{
+if(show_progress){
+printf("\nWriting the output files:");
+
+printf(" (%s)",C_file_name);
+update_terminal;
+}
+if(text_info->text_link==0)goto writeloop;
+}
+while(stack_ptr> stack)get_output();
+flush_buffer();
+writeloop:/*43:*/
+#line 572 "ctangle.w"
+
+for(an_output_file= end_output_files;an_output_file> cur_out_file;){
+an_output_file--;
+sprint_section_name(output_file_name,*an_output_file);
+fclose(C_file);
+C_file= fopen(output_file_name,"w");
+if(C_file==0)fatal("! Cannot open output file:",output_file_name);
+
+printf("\n(%s)",output_file_name);update_terminal;
+cur_line= 1;
+stack_ptr= stack+1;
+cur_name= (*an_output_file);
+cur_repl= (text_pointer)cur_name->equiv;
+cur_byte= cur_repl->tok_start;
+cur_end= (cur_repl+1)->tok_start;
+while(stack_ptr> stack)get_output();
+flush_buffer();
+}
+
+/*:43*/
+#line 563 "ctangle.w"
+;
+if(show_happiness)printf("\nDone.");
+}
+}
+
+/*:42*//*47:*/
+#line 605 "ctangle.w"
+
+void
+output_defs()
+{
+sixteen_bits a;
+push_level(NULL);
+for(cur_text= text_info+1;cur_text<text_ptr;cur_text++)
+if(cur_text->text_link==0){
+cur_byte= cur_text->tok_start;
+cur_end= (cur_text+1)->tok_start;
+C_printf("%s","#define ");
+out_state= normal;
+protect= 1;
+while(cur_byte<cur_end){
+a= *cur_byte++;
+if(cur_byte==cur_end&&a=='\n')break;
+if(out_state==verbatim&&a!=string&&a!=constant&&a!='\n')
+C_putc(a);
+
+else if(a<0200)out_char(a);
+else{
+a= (a-0200)*0400+*cur_byte++;
+if(a<024000){
+cur_val= a;out_char(identifier);
+}
+else if(a<050000){confusion("macro defs have strange char");}
+else{
+cur_val= a-050000;cur_section= cur_val;out_char(section_number);
+}
+
+}
+}
+protect= 0;
+flush_buffer();
+}
+pop_level(0);
+}
+
+/*:47*//*49:*/
+#line 651 "ctangle.w"
+
+static void
+out_char(cur_char)
+eight_bits cur_char;
+{
+char*j,*k;
+restart:
+switch(cur_char){
+case'\n':if(protect&&out_state!=verbatim)C_putc(' ');
+if(protect||out_state==verbatim)C_putc('\\');
+flush_buffer();if(out_state!=verbatim)out_state= normal;break;
+/*53:*/
+#line 719 "ctangle.w"
+
+case identifier:
+if(out_state==num_or_id)C_putc(' ');
+j= (cur_val+name_dir)->byte_start;
+k= (cur_val+name_dir+1)->byte_start;
+while(j<k){
+if((unsigned char)(*j)<0200)C_putc(*j);
+
+else C_printf("%s",translit[(unsigned char)(*j)-0200]);
+j++;
+}
+out_state= num_or_id;break;
+
+/*:53*/
+#line 662 "ctangle.w"
+;
+/*54:*/
+#line 732 "ctangle.w"
+
+case section_number:
+if(cur_val> 0)C_printf("/*%d:*/",cur_val);
+else if(cur_val<0)C_printf("/*:%d*/",-cur_val);
+else if(protect){
+cur_byte+= 4;
+cur_char= '\n';
+goto restart;
+}else{
+sixteen_bits a;
+a= 0400**cur_byte++;
+a+= *cur_byte++;
+C_printf("\n#line %d \"",a);
+
+cur_val= *cur_byte++;
+cur_val= 0400*(cur_val-0200)+*cur_byte++;
+for(j= (cur_val+name_dir)->byte_start,k= (cur_val+name_dir+1)->byte_start;
+j<k;j++){
+if(*j=='\\'||*j=='"')C_putc('\\');
+C_putc(*j);
+}
+C_printf("%s","\"\n");
+}
+break;
+
+/*:54*/
+#line 663 "ctangle.w"
+;
+/*50:*/
+#line 681 "ctangle.w"
+
+case plus_plus:C_putc('+');C_putc('+');out_state= normal;break;
+case minus_minus:C_putc('-');C_putc('-');out_state= normal;break;
+case minus_gt:C_putc('-');C_putc('>');out_state= normal;break;
+case gt_gt:C_putc('>');C_putc('>');out_state= normal;break;
+case eq_eq:C_putc('=');C_putc('=');out_state= normal;break;
+case lt_lt:C_putc('<');C_putc('<');out_state= normal;break;
+case gt_eq:C_putc('>');C_putc('=');out_state= normal;break;
+case lt_eq:C_putc('<');C_putc('=');out_state= normal;break;
+case not_eq:C_putc('!');C_putc('=');out_state= normal;break;
+case and_and:C_putc('&');C_putc('&');out_state= normal;break;
+case or_or:C_putc('|');C_putc('|');out_state= normal;break;
+case dot_dot_dot:C_putc('.');C_putc('.');C_putc('.');out_state= normal;
+break;
+case colon_colon:C_putc(':');C_putc(':');out_state= normal;break;
+case period_ast:C_putc('.');C_putc('*');out_state= normal;break;
+case minus_gt_ast:C_putc('-');C_putc('>');C_putc('*');out_state= normal;
+break;
+
+/*:50*/
+#line 664 "ctangle.w"
+;
+case'=':case'>':C_putc(cur_char);C_putc(' ');
+out_state= normal;break;
+case join:out_state= unbreakable;break;
+case constant:if(out_state==verbatim){
+out_state= num_or_id;break;
+}
+if(out_state==num_or_id)C_putc(' ');out_state= verbatim;break;
+case string:if(out_state==verbatim)out_state= normal;
+else out_state= verbatim;break;
+case'/':C_putc('/');out_state= post_slash;break;
+case'*':if(out_state==post_slash)C_putc(' ');
+
+default:C_putc(cur_char);out_state= normal;break;
+}
+}
+
+/*:49*//*58:*/
+#line 813 "ctangle.w"
+
+eight_bits
+skip_ahead()
+{
+eight_bits c;
+while(1){
+if(loc> limit&&(get_line()==0))return(new_section);
+*(limit+1)= '@';
+while(*loc!='@')loc++;
+if(loc<=limit){
+loc++;c= ccode[(eight_bits)*loc];loc++;
+if(c!=ignore||*(loc-1)=='>')return(c);
+}
+}
+}
+
+/*:58*//*60:*/
+#line 848 "ctangle.w"
+
+int skip_comment(is_long_comment)
+boolean is_long_comment;
+{
+char c;
+while(1){
+if(loc> limit){
+if(is_long_comment){
+if(get_line())return(comment_continues= 1);
+else{
+err_print("! Input ended in mid-comment");
+
+return(comment_continues= 0);
+}
+}
+else return(comment_continues= 0);
+}
+c= *(loc++);
+if(is_long_comment&&c=='*'&&*loc=='/'){
+loc++;return(comment_continues= 0);
+}
+if(c=='@'){
+if(ccode[(eight_bits)*loc]==new_section){
+err_print("! Section name ended in mid-comment");loc--;
+
+return(comment_continues= 0);
+}
+else loc++;
+}
+}
+}
+
+/*:60*//*63:*/
+#line 900 "ctangle.w"
+
+eight_bits
+get_next()
+{
+static int preprocessing= 0;
+eight_bits c;
+while(1){
+if(loc> limit){
+if(preprocessing&&*(limit-1)!='\\')preprocessing= 0;
+if(get_line()==0)return(new_section);
+else if(print_where&&!no_where){
+print_where= 0;
+/*77:*/
+#line 1225 "ctangle.w"
+
+store_two_bytes(0150000);
+if(changing)id_first= change_file_name;
+else id_first= cur_file_name;
+id_loc= id_first+strlen(id_first);
+if(changing)store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a= id_lookup(id_first,id_loc,0)-name_dir;app_repl((a/0400)+0200);
+app_repl(a%0400);}
+
+/*:77*/
+#line 912 "ctangle.w"
+;
+}
+else return('\n');
+}
+c= *loc;
+if(comment_continues||(c=='/'&&(*(loc+1)=='*'||*(loc+1)=='/'))){
+skip_comment(comment_continues||*(loc+1)=='*');
+
+if(comment_continues)return('\n');
+else continue;
+}
+loc++;
+if(xisdigit(c)||c=='.')/*66:*/
+#line 978 "ctangle.w"
+{
+id_first= loc-1;
+if(*id_first=='.'&&!xisdigit(*loc))goto mistake;
+if(*id_first=='0'){
+if(*loc=='x'||*loc=='X'){
+loc++;while(xisxdigit(*loc))loc++;goto found;
+}
+}
+while(xisdigit(*loc))loc++;
+if(*loc=='.'){
+loc++;
+while(xisdigit(*loc))loc++;
+}
+if(*loc=='e'||*loc=='E'){
+if(*++loc=='+'||*loc=='-')loc++;
+while(xisdigit(*loc))loc++;
+}
+found:while(*loc=='u'||*loc=='U'||*loc=='l'||*loc=='L'
+||*loc=='f'||*loc=='F')loc++;
+id_loc= loc;
+return(constant);
+}
+
+/*:66*/
+#line 924 "ctangle.w"
+
+else if(c=='\''||c=='"'||(c=='L'&&(*loc=='\''||*loc=='"')))
+/*67:*/
+#line 1006 "ctangle.w"
+{
+char delim= c;
+id_first= section_text+1;
+id_loc= section_text;*++id_loc= delim;
+if(delim=='L'){
+delim= *loc++;*++id_loc= delim;
+}
+while(1){
+if(loc>=limit){
+if(*(limit-1)!='\\'){
+err_print("! String didn't end");loc= limit;break;
+
+}
+if(get_line()==0){
+err_print("! Input ended in middle of string");loc= buffer;break;
+
+}
+else if(++id_loc<=section_text_end)*id_loc= '\n';
+
+}
+if((c= *loc++)==delim){
+if(++id_loc<=section_text_end)*id_loc= c;
+break;
+}
+if(c=='\\'){
+if(loc>=limit)continue;
+if(++id_loc<=section_text_end)*id_loc= '\\';
+c= *loc++;
+}
+if(++id_loc<=section_text_end)*id_loc= c;
+}
+if(id_loc>=section_text_end){
+printf("\n! String too long: ");
+
+term_write(section_text+1,25);
+err_print("...");
+}
+id_loc++;
+return(string);
+}
+
+/*:67*/
+#line 926 "ctangle.w"
+
+else if(isalpha(c)||isxalpha(c)||ishigh(c))
+/*65:*/
+#line 972 "ctangle.w"
+{
+id_first= --loc;
+while(isalpha(*++loc)||isdigit(*loc)||isxalpha(*loc)||ishigh(*loc));
+id_loc= loc;return(identifier);
+}
+
+/*:65*/
+#line 928 "ctangle.w"
+
+else if(c=='@')/*68:*/
+#line 1050 "ctangle.w"
+{
+c= ccode[(eight_bits)*loc++];
+switch(c){
+case ignore:continue;
+case translit_code:err_print("! Use @l in limbo only");continue;
+
+case control_text:while((c= skip_ahead())=='@');
+
+if(*(loc-1)!='>')
+err_print("! Double @ should be used in control text");
+
+continue;
+case section_name:
+cur_section_name_char= *(loc-1);
+/*70:*/
+#line 1098 "ctangle.w"
+{
+char*k;
+/*72:*/
+#line 1118 "ctangle.w"
+
+k= section_text;
+while(1){
+if(loc> limit&&get_line()==0){
+err_print("! Input ended in section name");
+
+loc= buffer+1;break;
+}
+c= *loc;
+/*73:*/
+#line 1142 "ctangle.w"
+
+if(c=='@'){
+c= *(loc+1);
+if(c=='>'){
+loc+= 2;break;
+}
+if(ccode[(eight_bits)c]==new_section){
+err_print("! Section name didn't end");break;
+
+}
+if(ccode[(eight_bits)c]==section_name){
+err_print("! Nesting of section names not allowed");break;
+
+}
+*(++k)= '@';loc++;
+}
+
+/*:73*/
+#line 1127 "ctangle.w"
+;
+loc++;if(k<section_text_end)k++;
+if(xisspace(c)){
+c= ' ';if(*(k-1)==' ')k--;
+}
+*k= c;
+}
+if(k>=section_text_end){
+printf("\n! Section name too long: ");
+
+term_write(section_text+1,25);
+printf("...");mark_harmless;
+}
+if(*k==' '&&k> section_text)k--;
+
+/*:72*/
+#line 1100 "ctangle.w"
+;
+if(k-section_text> 3&&strncmp(k-2,"...",3)==0)
+cur_section_name= section_lookup(section_text+1,k-3,1);
+else cur_section_name= section_lookup(section_text+1,k,0);
+if(cur_section_name_char=='(')
+/*40:*/
+#line 516 "ctangle.w"
+
+{
+for(an_output_file= cur_out_file;
+an_output_file<end_output_files;an_output_file++)
+if(*an_output_file==cur_section_name)break;
+if(an_output_file==end_output_files){
+if(cur_out_file> output_files)
+*--cur_out_file= cur_section_name;
+else{
+overflow("output files");
+}
+}
+}
+
+/*:40*/
+#line 1106 "ctangle.w"
+;
+return(section_name);
+}
+
+/*:70*/
+#line 1064 "ctangle.w"
+;
+case string:/*74:*/
+#line 1164 "ctangle.w"
+{
+id_first= loc++;*(limit+1)= '@';*(limit+2)= '>';
+while(*loc!='@'||*(loc+1)!='>')loc++;
+if(loc>=limit)err_print("! Verbatim string didn't end");
+
+id_loc= loc;loc+= 2;
+return(string);
+}
+
+/*:74*/
+#line 1065 "ctangle.w"
+;
+case ord:/*69:*/
+#line 1077 "ctangle.w"
+
+id_first= loc;
+if(*loc=='\\'){
+if(*++loc=='\'')loc++;
+}
+while(*loc!='\''){
+if(*loc=='@'){
+if(*(loc+1)!='@')
+err_print("! Double @ should be used in ASCII constant");
+
+else loc++;
+}
+loc++;
+if(loc> limit){
+err_print("! String didn't end");loc= limit-1;break;
+
+}
+}
+loc++;
+return(ord);
+
+/*:69*/
+#line 1066 "ctangle.w"
+;
+default:return(c);
+}
+}
+
+/*:68*/
+#line 929 "ctangle.w"
+
+else if(xisspace(c)){
+if(!preprocessing||loc> limit)continue;
+
+else return(' ');
+}
+else if(c=='#'&&loc==buffer+1)preprocessing= 1;
+mistake:/*64:*/
+#line 950 "ctangle.w"
+
+switch(c){
+case'+':if(*loc=='+')compress(plus_plus);break;
+case'-':if(*loc=='-'){compress(minus_minus);}
+else if(*loc=='>')if(*(loc+1)=='*'){loc++;compress(minus_gt_ast);}
+else compress(minus_gt);break;
+case'.':if(*loc=='*'){compress(period_ast);}
+else if(*loc=='.'&&*(loc+1)=='.'){
+loc++;compress(dot_dot_dot);
+}
+break;
+case':':if(*loc==':')compress(colon_colon);break;
+case'=':if(*loc=='=')compress(eq_eq);break;
+case'>':if(*loc=='='){compress(gt_eq);}
+else if(*loc=='>')compress(gt_gt);break;
+case'<':if(*loc=='='){compress(lt_eq);}
+else if(*loc=='<')compress(lt_lt);break;
+case'&':if(*loc=='&')compress(and_and);break;
+case'|':if(*loc=='|')compress(or_or);break;
+case'!':if(*loc=='=')compress(not_eq);break;
+}
+
+/*:64*/
+#line 936 "ctangle.w"
+
+return(c);
+}
+}
+
+/*:63*//*76:*/
+#line 1199 "ctangle.w"
+
+void
+scan_repl(t)
+eight_bits t;
+{
+sixteen_bits a;
+if(t==section_name){/*77:*/
+#line 1225 "ctangle.w"
+
+store_two_bytes(0150000);
+if(changing)id_first= change_file_name;
+else id_first= cur_file_name;
+id_loc= id_first+strlen(id_first);
+if(changing)store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a= id_lookup(id_first,id_loc,0)-name_dir;app_repl((a/0400)+0200);
+app_repl(a%0400);}
+
+/*:77*/
+#line 1205 "ctangle.w"
+;}
+while(1)switch(a= get_next()){
+/*78:*/
+#line 1235 "ctangle.w"
+
+case identifier:a= id_lookup(id_first,id_loc,0)-name_dir;
+app_repl((a/0400)+0200);
+app_repl(a%0400);break;
+case section_name:if(t!=section_name)goto done;
+else{
+/*79:*/
+#line 1268 "ctangle.w"
+{
+char*try_loc= loc;
+while(*try_loc==' '&&try_loc<limit)try_loc++;
+if(*try_loc=='+'&&try_loc<limit)try_loc++;
+while(*try_loc==' '&&try_loc<limit)try_loc++;
+if(*try_loc=='=')err_print("! Missing `@ ' before a named section");
+
+
+
+}
+
+/*:79*/
+#line 1241 "ctangle.w"
+;
+a= cur_section_name-name_dir;
+app_repl((a/0400)+0250);
+app_repl(a%0400);
+/*77:*/
+#line 1225 "ctangle.w"
+
+store_two_bytes(0150000);
+if(changing)id_first= change_file_name;
+else id_first= cur_file_name;
+id_loc= id_first+strlen(id_first);
+if(changing)store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a= id_lookup(id_first,id_loc,0)-name_dir;app_repl((a/0400)+0200);
+app_repl(a%0400);}
+
+/*:77*/
+#line 1245 "ctangle.w"
+;break;
+}
+case output_defs_code:if(t!=section_name)err_print("! Misplaced @h");
+
+else{
+output_defs_seen= 1;
+a= output_defs_flag;
+app_repl((a/0400)+0200);
+app_repl(a%0400);
+/*77:*/
+#line 1225 "ctangle.w"
+
+store_two_bytes(0150000);
+if(changing)id_first= change_file_name;
+else id_first= cur_file_name;
+id_loc= id_first+strlen(id_first);
+if(changing)store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a= id_lookup(id_first,id_loc,0)-name_dir;app_repl((a/0400)+0200);
+app_repl(a%0400);}
+
+/*:77*/
+#line 1254 "ctangle.w"
+;
+}
+break;
+case constant:case string:
+/*80:*/
+#line 1279 "ctangle.w"
+
+app_repl(a);
+while(id_first<id_loc){
+if(*id_first=='@'){
+if(*(id_first+1)=='@')id_first++;
+else err_print("! Double @ should be used in string");
+
+}
+app_repl(*id_first++);
+}
+app_repl(a);break;
+
+/*:80*/
+#line 1258 "ctangle.w"
+;
+case ord:
+/*81:*/
+#line 1295 "ctangle.w"
+{
+int c= (eight_bits)*id_first;
+if(c=='\\'){
+c= *++id_first;
+if(c>='0'&&c<='7'){
+c-= '0';
+if(*(id_first+1)>='0'&&*(id_first+1)<='7'){
+c= 8*c+*(++id_first)-'0';
+if(*(id_first+1)>='0'&&*(id_first+1)<='7'&&c<32)
+c= 8*c+*(++id_first)-'0';
+}
+}
+else switch(c){
+case't':c= '\t';break;
+case'n':c= '\n';break;
+case'b':c= '\b';break;
+case'f':c= '\f';break;
+case'v':c= '\v';break;
+case'r':c= '\r';break;
+case'a':c= '\7';break;
+case'?':c= '?';break;
+case'x':
+if(xisdigit(*(id_first+1)))c= *(++id_first)-'0';
+else if(xisxdigit(*(id_first+1))){
+++id_first;
+c= toupper(*id_first)-'A'+10;
+}
+if(xisdigit(*(id_first+1)))c= 16*c+*(++id_first)-'0';
+else if(xisxdigit(*(id_first+1))){
+++id_first;
+c= 16*c+toupper(*id_first)-'A'+10;
+}
+break;
+case'\\':c= '\\';break;
+case'\'':c= '\'';break;
+case'\"':c= '\"';break;
+default:err_print("! Unrecognized escape sequence");
+
+}
+}
+
+app_repl(constant);
+if(c>=100)app_repl('0'+c/100);
+if(c>=10)app_repl('0'+(c/10)%10);
+app_repl('0'+c%10);
+app_repl(constant);
+}
+break;
+
+/*:81*/
+#line 1260 "ctangle.w"
+;
+case definition:case format_code:case begin_C:if(t!=section_name)goto done;
+else{
+err_print("! @d, @f and @c are ignored in C text");continue;
+
+}
+case new_section:goto done;
+
+/*:78*/
+#line 1210 "ctangle.w"
+
+case')':app_repl(a);
+if(t==macro)app_repl(' ');
+break;
+default:app_repl(a);
+}
+done:next_control= (eight_bits)a;
+if(text_ptr> text_info_end)overflow("text");
+cur_text= text_ptr;(++text_ptr)->tok_start= tok_ptr;
+}
+
+/*:76*//*83:*/
+#line 1357 "ctangle.w"
+
+void
+scan_section()
+{
+name_pointer p;
+text_pointer q;
+sixteen_bits a;
+section_count++;no_where= 1;
+if(*(loc-1)=='*'&&show_progress){
+printf("*%d",section_count);update_terminal;
+}
+next_control= 0;
+while(1){
+/*84:*/
+#line 1396 "ctangle.w"
+
+while(next_control<definition)
+
+if((next_control= skip_ahead())==section_name){
+loc-= 2;next_control= get_next();
+}
+
+/*:84*/
+#line 1371 "ctangle.w"
+;
+if(next_control==definition){
+/*85:*/
+#line 1403 "ctangle.w"
+{
+while((next_control= get_next())=='\n');
+if(next_control!=identifier){
+err_print("! Definition flushed, must start with identifier");
+
+continue;
+}
+app_repl(((a= id_lookup(id_first,id_loc,0)-name_dir)/0400)+0200);
+
+app_repl(a%0400);
+if(*loc!='('){
+app_repl(string);app_repl(' ');app_repl(string);
+}
+scan_repl(macro);
+cur_text->text_link= 0;
+}
+
+/*:85*/
+#line 1373 "ctangle.w"
+
+continue;
+}
+if(next_control==begin_C){
+p= name_dir;break;
+}
+if(next_control==section_name){
+p= cur_section_name;
+/*86:*/
+#line 1428 "ctangle.w"
+
+while((next_control= get_next())=='+');
+if(next_control!='='&&next_control!=eq_eq)
+continue;
+
+/*:86*/
+#line 1381 "ctangle.w"
+;
+break;
+}
+return;
+}
+no_where= print_where= 0;
+/*87:*/
+#line 1433 "ctangle.w"
+
+/*88:*/
+#line 1438 "ctangle.w"
+
+store_two_bytes((sixteen_bits)(0150000+section_count));
+
+
+/*:88*/
+#line 1434 "ctangle.w"
+;
+scan_repl(section_name);
+/*89:*/
+#line 1442 "ctangle.w"
+
+if(p==name_dir||p==0){
+(last_unnamed)->text_link= cur_text-text_info;last_unnamed= cur_text;
+}
+else if(p->equiv==(char*)text_info)p->equiv= (char*)cur_text;
+
+else{
+q= (text_pointer)p->equiv;
+while(q->text_link<section_flag)
+q= q->text_link+text_info;
+q->text_link= cur_text-text_info;
+}
+cur_text->text_link= section_flag;
+
+
+/*:89*/
+#line 1436 "ctangle.w"
+;
+
+/*:87*/
+#line 1387 "ctangle.w"
+;
+}
+
+/*:83*//*91:*/
+#line 1460 "ctangle.w"
+
+void
+phase_one(){
+phase= 1;
+section_count= 0;
+reset_input();
+skip_limbo();
+while(!input_has_ended)scan_section();
+check_complete();
+phase= 2;
+}
+
+/*:91*//*93:*/
+#line 1478 "ctangle.w"
+
+void
+skip_limbo()
+{
+char c;
+while(1){
+if(loc> limit&&get_line()==0)return;
+*(limit+1)= '@';
+while(*loc!='@')loc++;
+if(loc++<=limit){
+c= *loc++;
+if(ccode[(eight_bits)c]==new_section)break;
+switch(ccode[(eight_bits)c]){
+case translit_code:/*94:*/
+#line 1507 "ctangle.w"
+
+while(xisspace(*loc)&&loc<limit)loc++;
+loc+= 3;
+if(loc> limit||!xisxdigit(*(loc-3))||!xisxdigit(*(loc-2))
+||(*(loc-3)>='0'&&*(loc-3)<='7')||!xisspace(*(loc-1)))
+err_print("! Improper hex number following @l");
+
+else{
+unsigned i;
+char*beg;
+sscanf(loc-3,"%x",&i);
+while(xisspace(*loc)&&loc<limit)loc++;
+beg= loc;
+while(loc<limit&&(xisalpha(*loc)||xisdigit(*loc)||*loc=='_'))loc++;
+if(loc-beg>=translit_length)
+err_print("! Replacement string in @l too long");
+
+else{
+strncpy(translit[i-0200],beg,loc-beg);
+translit[i-0200][loc-beg]= '\0';
+}
+}
+
+/*:94*/
+#line 1491 "ctangle.w"
+;break;
+case format_code:case'@':break;
+case control_text:if(c=='q'||c=='Q'){
+while((c= skip_ahead())=='@');
+if(*(loc-1)!='>')
+err_print("! Double @ should be used in control text");
+
+break;
+}
+default:err_print("! Double @ should be used in limbo");
+
+}
+}
+}
+}
+
+/*:93*//*95:*/
+#line 1533 "ctangle.w"
+
+void
+print_stats(){
+printf("\nMemory usage statistics:\n");
+printf("%ld names (out of %ld)\n",
+(long)(name_ptr-name_dir),(long)max_names);
+printf("%ld replacement texts (out of %ld)\n",
+(long)(text_ptr-text_info),(long)max_texts);
+printf("%ld bytes (out of %ld)\n",
+(long)(byte_ptr-byte_mem),(long)max_bytes);
+printf("%ld tokens (out of %ld)\n",
+(long)(tok_ptr-tok_mem),(long)max_toks);
+}
+
+/*:95*/
diff --git a/Build/source/texk/web2c/cwebdir/ctangle.rc b/Build/source/texk/web2c/cwebdir/ctangle.rc
new file mode 100644
index 00000000000..c2b73323b15
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctangle.rc
@@ -0,0 +1,34 @@
+/* ctangle.rc: ctangle resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " ctangle 3.63"
+
+#define VER_INTERNALNAME_STR "ctangle"
+#define VER_ORIGINALFILENAME_STR "ctangle.exe"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1987,1990,1993 Silvio Levy and Donald E. Knuth"
+
+#define VER_FILEDESCRIPTION_STR "CTangle"
+
+#include <texlive.version>
+
+/* afm2tfm.rc ends here */
diff --git a/Build/source/texk/web2c/cwebdir/ctangle.w b/Build/source/texk/web2c/cwebdir/ctangle.w
new file mode 100644
index 00000000000..6cdcfd5db06
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/ctangle.w
@@ -0,0 +1,1554 @@
+% This file is part of CWEB.
+% This program by Silvio Levy and Donald E. Knuth
+% is based on a program by Knuth.
+% It is distributed WITHOUT ANY WARRANTY, express or implied.
+% Version 3.64 --- February 2002
+% (same as Version 3.5 except for minor corrections)
+% (also quotes backslashes in file names of #line directives)
+
+% Copyright (C) 1987,1990,1993,2000 Silvio Levy and Donald E. Knuth
+
+% Permission is granted to make and distribute verbatim copies of this
+% document provided that the copyright notice and this permission notice
+% are preserved on all copies.
+
+% Permission is granted to copy and distribute modified versions of this
+% document under the conditions for verbatim copying, provided that the
+% entire resulting derived work is given a different name and distributed
+% under the terms of a permission notice identical to this one.
+
+% Here is TeX material that gets inserted after \input cwebmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\def\pb{$\.|\ldots\.|$} % C brackets (|...|)
+\def\v{\char'174} % vertical (|) in typewriter font
+\mathchardef\RA="3221 % right arrow
+\mathchardef\BA="3224 % double arrow
+
+\def\title{CTANGLE (Version 3.64)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont The {\ttitlefont CTANGLE} processor}
+ \vskip 15pt
+ \centerline{(Version 3.64)}
+ \vfill}
+\def\botofcontents{\vfill
+\noindent
+Copyright \copyright\ 1987, 1990, 1993, 2000 Silvio Levy and Donald E. Knuth
+\bigskip\noindent
+Permission is granted to make and distribute verbatim copies of this
+document provided that the copyright notice and this permission notice
+are preserved on all copies.
+
+\smallskip\noindent
+Permission is granted to copy and distribute modified versions of this
+document under the conditions for verbatim copying, provided that the
+entire resulting derived work is given a different name and distributed
+under the terms of a permission notice identical to this one.
+}
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iftrue
+@s not_eq normal @q unreserve a C++ keyword @>
+
+@** Introduction.
+This is the \.{CTANGLE} program by Silvio Levy and Donald E. Knuth,
+based on \.{TANGLE} by Knuth.
+We are thankful to
+Nelson Beebe, Hans-Hermann Bode (to whom the \CPLUSPLUS/ adaptation is due),
+Klaus Guntermann, Norman Ramsey, Tomas Rokicki, Joachim Schnitter,
+Joachim Schrod, Lee Wittenberg, and others who have contributed improvements.
+
+The ``banner line'' defined here should be changed whenever \.{CTANGLE}
+is modified.
+
+@d banner "This is CTANGLE (Version 3.64)\n"
+
+@c
+@<Include files@>@/
+@h
+@<Common code for \.{CWEAVE} and \.{CTANGLE}@>@/
+@<Typedef declarations@>@/
+@<Global variables@>@/
+@<Predeclaration of procedures@>@/
+
+@ We predeclare several standard system functions here instead of including
+their system header files, because the names of the header files are not as
+standard as the names of the functions. (For example, some \CEE/ environments
+have \.{<string.h>} where others have \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern int strcmp(); /* compare strings lexicographically */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+
+@ \.{CTANGLE} has a fairly straightforward outline. It operates in
+two phases: First it reads the source file, saving the \CEE/ code in
+compressed form; then it shuffles and outputs the code.
+
+Please read the documentation for \.{common}, the set of routines common
+to \.{CTANGLE} and \.{CWEAVE}, before proceeding further.
+
+@c
+int main (ac, av)
+int ac;
+char **av;
+{
+ argc=ac; argv=av;
+ program=ctangle;
+ @<Set initial values@>;
+ common_init();
+ if (show_banner) printf(banner); /* print a ``banner line'' */
+ phase_one(); /* read all the user's text and compress it into |tok_mem| */
+ phase_two(); /* output the contents of the compressed tables */
+ return wrap_up(); /* and exit gracefully */
+}
+
+@ The following parameters were sufficient in the original \.{TANGLE} to
+handle \TEX/,
+so they should be sufficient for most applications of \.{CTANGLE}.
+If you change |max_bytes|, |max_names|, or |hash_size| you should also
+change them in the file |"common.w"|.
+
+@d max_bytes 90000 /* the number of bytes in identifiers,
+ index entries, and section names; used in |"common.w"| */
+@d max_toks 270000 /* number of bytes in compressed \CEE/ code */
+@d max_names 4000 /* number of identifiers, strings, section names;
+ must be less than 10240; used in |"common.w"| */
+@d max_texts 2500 /* number of replacement texts, must be less than 10240 */
+@d hash_size 353 /* should be prime; used in |"common.w"| */
+@d longest_name 10000 /* section names shouldn't be longer than this */
+@d stack_size 50 /* number of simultaneous levels of macro expansion */
+@d buf_size 100 /* for \.{CWEAVE} and \.{CTANGLE} */
+
+@ The next few sections contain stuff from the file |"common.w"| that must
+be included in both |"ctangle.w"| and |"cweave.w"|. It appears in
+file |"common.h"|, which needs to be updated when |"common.w"| changes.
+
+@i common.h
+
+@* Data structures exclusive to {\tt CTANGLE}.
+We've already seen that the |byte_mem| array holds the names of identifiers,
+strings, and sections;
+the |tok_mem| array holds the replacement texts
+for sections. Allocation is sequential, since things are deleted only
+during Phase II, and only in a last-in-first-out manner.
+
+A \&{text} variable is a structure containing a pointer into
+|tok_mem|, which tells where the corresponding text starts, and an
+integer |text_link|, which, as we shall see later, is used to connect
+pieces of text that have the same name. All the \&{text}s are stored in
+the array |text_info|, and we use a |text_pointer| variable to refer
+to them.
+
+The first position of |tok_mem| that is unoccupied by
+replacement text is called |tok_ptr|, and the first unused location of
+|text_info| is called |text_ptr|. Thus we usually have the identity
+|text_ptr->tok_start==tok_ptr|.
+
+If your machine does not support |unsigned char| you should change
+the definition of \&{eight\_bits} to |unsigned short|.
+@^system dependencies@>
+
+@<Typed...@>=
+typedef struct {
+ eight_bits *tok_start; /* pointer into |tok_mem| */
+ sixteen_bits text_link; /* relates replacement texts */
+} text;
+typedef text *text_pointer;
+
+@ @<Glob...@>=
+text text_info[max_texts];
+text_pointer text_info_end=text_info+max_texts-1;
+text_pointer text_ptr; /* first unused position in |text_info| */
+eight_bits tok_mem[max_toks];
+eight_bits *tok_mem_end=tok_mem+max_toks-1;
+eight_bits *tok_ptr; /* first unused position in |tok_mem| */
+
+@ @<Set init...@>=
+text_info->tok_start=tok_ptr=tok_mem;
+text_ptr=text_info+1; text_ptr->tok_start=tok_mem;
+ /* this makes replacement text 0 of length zero */
+
+@ If |p| is a pointer to a section name, |p->equiv| is a pointer to its
+replacement text, an element of the array |text_info|.
+
+@d equiv equiv_or_xref /* info corresponding to names */
+
+@ @<Set init...@>=
+name_dir->equiv=(char *)text_info; /* the undefined section has no replacement text */
+
+@ Here's the procedure that decides whether a name of length |l|
+starting at position |first| equals the identifier pointed to by |p|:
+
+@c
+int names_match(p,first,l)
+name_pointer p; /* points to the proposed match */
+char *first; /* position of first character of string */
+int l; /* length of identifier */
+{
+ if (length(p)!=l) return 0;
+ return !strncmp(first,p->byte_start,l);
+}
+
+@ The common lookup routine refers to separate routines |init_node| and
+|init_p| when the data structure grows. Actually |init_p| is called only by
+\.{CWEAVE}, but we need to declare a dummy version so that
+the loader won't complain of its absence.
+
+@c
+void
+init_node(node)
+name_pointer node;
+{
+ node->equiv=(char *)text_info;
+}
+void
+init_p() {}
+
+@* Tokens.
+Replacement texts, which represent \CEE/ code in a compressed format,
+appear in |tok_mem| as mentioned above. The codes in
+these texts are called `tokens'; some tokens occupy two consecutive
+eight-bit byte positions, and the others take just one byte.
+
+If $p$ points to a replacement text, |p->tok_start| is the |tok_mem| position
+of the first eight-bit code of that text. If |p->text_link==0|,
+this is the replacement text for a macro, otherwise it is the replacement
+text for a section. In the latter case |p->text_link| is either equal to
+|section_flag|, which means that there is no further text for this section, or
+|p->text_link| points to a continuation of this replacement text; such
+links are created when several sections have \CEE/ texts with the same
+name, and they also tie together all the \CEE/ texts of unnamed sections.
+The replacement text pointer for the first unnamed section appears in
+|text_info->text_link|, and the most recent such pointer is |last_unnamed|.
+
+@d section_flag max_texts /* final |text_link| in section replacement texts */
+
+@<Glob...@>=
+text_pointer last_unnamed; /* most recent replacement text of unnamed section */
+
+@ @<Set init...@>= last_unnamed=text_info; text_info->text_link=0;
+
+@ If the first byte of a token is less than |0200|, the token occupies a
+single byte. Otherwise we make a sixteen-bit token by combining two consecutive
+bytes |a| and |b|. If |0200<=a<0250|, then |(a-0200)@t${}\times2^8$@>+b|
+points to an identifier; if |0250<=a<0320|, then
+|(a-0250)@t${}\times2^8$@>+b| points to a section name
+(or, if it has the special value |output_defs_flag|,
+to the area where the preprocessor definitions are stored); and if
+|0320<=a<0400|, then |(a-0320)@t${}\times2^8$@>+b| is the number of the section
+in which the current replacement text appears.
+
+Codes less than |0200| are 7-bit |char| codes that represent themselves.
+Some of the 7-bit codes will not be present, however, so we can
+use them for special purposes. The following symbolic names are used:
+
+\yskip \hang |join| denotes the concatenation of adjacent items with no
+space or line breaks allowed between them (the \.{@@\&} operation of \.{CWEB}).
+
+\hang |string| denotes the beginning or end of a string, verbatim
+construction or numerical constant.
+@^ASCII code dependencies@>
+
+@d string 02 /* takes the place of extended ASCII \.{\char2} */
+@d join 0177 /* takes the place of ASCII delete */
+@d output_defs_flag (2*024000-1)
+
+@ The following procedure is used to enter a two-byte value into
+|tok_mem| when a replacement text is being generated.
+
+@c
+void
+store_two_bytes(x)
+sixteen_bits x;
+{
+ if (tok_ptr+2>tok_mem_end) overflow("token");
+ *tok_ptr++=x>>8; /* store high byte */
+ *tok_ptr++=x&0377; /* store low byte */
+}
+
+@** Stacks for output. The output process uses a stack to keep track
+of what is going on at different ``levels'' as the sections are being
+written out. Entries on this stack have five parts:
+
+\yskip\hang |end_field| is the |tok_mem| location where the replacement
+text of a particular level will end;
+
+\hang |byte_field| is the |tok_mem| location from which the next token
+on a particular level will be read;
+
+\hang |name_field| points to the name corresponding to a particular level;
+
+\hang |repl_field| points to the replacement text currently being read
+at a particular level;
+
+\hang |section_field| is the section number, or zero if this is a macro.
+
+\yskip\noindent The current values of these five quantities are referred to
+quite frequently, so they are stored in a separate place instead of in
+the |stack| array. We call the current values |cur_end|, |cur_byte|,
+|cur_name|, |cur_repl|, and |cur_section|.
+
+The global variable |stack_ptr| tells how many levels of output are
+currently in progress. The end of all output occurs when the stack is
+empty, i.e., when |stack_ptr==stack|.
+
+@<Typed...@>=
+typedef struct {
+ eight_bits *end_field; /* ending location of replacement text */
+ eight_bits *byte_field; /* present location within replacement text */
+ name_pointer name_field; /* |byte_start| index for text being output */
+ text_pointer repl_field; /* |tok_start| index for text being output */
+ sixteen_bits section_field; /* section number or zero if not a section */
+} output_state;
+typedef output_state *stack_pointer;
+
+@ @d cur_end cur_state.end_field /* current ending location in |tok_mem| */
+@d cur_byte cur_state.byte_field /* location of next output byte in |tok_mem|*/
+@d cur_name cur_state.name_field /* pointer to current name being expanded */
+@d cur_repl cur_state.repl_field /* pointer to current replacement text */
+@d cur_section cur_state.section_field /* current section number being expanded */
+
+@<Global...@>=
+output_state cur_state; /* |cur_end|, |cur_byte|, |cur_name|, |cur_repl|,
+ and |cur_section| */
+output_state stack[stack_size+1]; /* info for non-current levels */
+stack_pointer stack_ptr; /* first unused location in the output state stack */
+stack_pointer stack_end=stack+stack_size; /* end of |stack| */
+
+@ To get the output process started, we will perform the following
+initialization steps. We may assume that |text_info->text_link| is nonzero,
+since it points to the \CEE/ text in the first unnamed section that generates
+code; if there are no such sections, there is nothing to output, and an
+error message will have been generated before we do any of the initialization.
+
+@<Initialize the output stacks@>=
+stack_ptr=stack+1; cur_name=name_dir; cur_repl=text_info->text_link+text_info;
+cur_byte=cur_repl->tok_start; cur_end=(cur_repl+1)->tok_start; cur_section=0;
+
+@ When the replacement text for name |p| is to be inserted into the output,
+the following subroutine is called to save the old level of output and get
+the new one going.
+
+We assume that the \CEE/ compiler can copy structures.
+@^system dependencies@>
+
+@c
+void
+push_level(p) /* suspends the current level */
+name_pointer p;
+{
+ if (stack_ptr==stack_end) overflow("stack");
+ *stack_ptr=cur_state;
+ stack_ptr++;
+ if (p!=NULL) { /* |p==NULL| means we are in |output_defs| */
+ cur_name=p; cur_repl=(text_pointer)p->equiv;
+ cur_byte=cur_repl->tok_start; cur_end=(cur_repl+1)->tok_start;
+ cur_section=0;
+ }
+}
+
+@ When we come to the end of a replacement text, the |pop_level| subroutine
+does the right thing: It either moves to the continuation of this replacement
+text or returns the state to the most recently stacked level.
+
+@c
+void
+pop_level(flag) /* do this when |cur_byte| reaches |cur_end| */
+int flag; /* |flag==0| means we are in |output_defs| */
+{
+ if (flag && cur_repl->text_link<section_flag) { /* link to a continuation */
+ cur_repl=cur_repl->text_link+text_info; /* stay on the same level */
+ cur_byte=cur_repl->tok_start; cur_end=(cur_repl+1)->tok_start;
+ return;
+ }
+ stack_ptr--; /* go down to the previous level */
+ if (stack_ptr>stack) cur_state=*stack_ptr;
+}
+
+@ The heart of the output procedure is the function |get_output|,
+which produces the next token of output and sends it on to the lower-level
+function |out_char|. The main purpose of |get_output| is to handle the
+necessary stacking and unstacking. It sends the value |section_number|
+if the next output begins or ends the replacement text of some section,
+in which case |cur_val| is that section's number (if beginning) or the
+negative of that value (if ending). (A section number of 0 indicates
+not the beginning or ending of a section, but a \&{\#line} command.)
+And it sends the value |identifier|
+if the next output is an identifier, in which case
+|cur_val| points to that identifier name.
+
+@d section_number 0201 /* code returned by |get_output| for section numbers */
+@d identifier 0202 /* code returned by |get_output| for identifiers */
+
+@<Global...@>=
+int cur_val; /* additional information corresponding to output token */
+
+@ If |get_output| finds that no more output remains, it returns with
+|stack_ptr==stack|.
+@^high-bit character handling@>
+
+@c
+void
+get_output() /* sends next token to |out_char| */
+{
+ sixteen_bits a; /* value of current byte */
+ restart: if (stack_ptr==stack) return;
+ if (cur_byte==cur_end) {
+ cur_val=-((int)cur_section); /* cast needed because of sign extension */
+ pop_level(1);
+ if (cur_val==0) goto restart;
+ out_char(section_number); return;
+ }
+ a=*cur_byte++;
+ if (out_state==verbatim && a!=string && a!=constant && a!='\n')
+ C_putc(a); /* a high-bit character can occur in a string */
+ else if (a<0200) out_char(a); /* one-byte token */
+ else {
+ a=(a-0200)*0400+*cur_byte++;
+ switch (a/024000) { /* |024000==(0250-0200)*0400| */
+ case 0: cur_val=a; out_char(identifier); break;
+ case 1: if (a==output_defs_flag) output_defs();
+ else @<Expand section |a-024000|, |goto restart|@>;
+ break;
+ default: cur_val=a-050000; if (cur_val>0) cur_section=cur_val;
+ out_char(section_number);
+ }
+ }
+}
+
+@ The user may have forgotten to give any \CEE/ text for a section name,
+or the \CEE/ text may have been associated with a different name by mistake.
+
+@<Expand section |a-...@>=
+{
+ a-=024000;
+ if ((a+name_dir)->equiv!=(char *)text_info) push_level(a+name_dir);
+ else if (a!=0) {
+ printf("\n! Not present: <");
+ print_section_name(a+name_dir); err_print(">");
+@.Not present: <section name>@>
+ }
+ goto restart;
+}
+
+@* Producing the output.
+The |get_output| routine above handles most of the complexity of output
+generation, but there are two further considerations that have a nontrivial
+effect on \.{CTANGLE}'s algorithms.
+
+@ First,
+we want to make sure that the output has spaces and line breaks in
+the right places (e.g., not in the middle of a string or a constant or an
+identifier, not at a `\.{@@\&}' position
+where quantities are being joined together, and certainly after an \.=
+because the \CEE/ compiler thinks \.{=-} is ambiguous).
+
+The output process can be in one of following states:
+
+\yskip\hang |num_or_id| means that the last item in the buffer is a number or
+identifier, hence a blank space or line break must be inserted if the next
+item is also a number or identifier.
+
+\yskip\hang |unbreakable| means that the last item in the buffer was followed
+by the \.{@@\&} operation that inhibits spaces between it and the next item.
+
+\yskip\hang |verbatim| means we're copying only character tokens, and
+that they are to be output exactly as stored. This is the case during
+strings, verbatim constructions and numerical constants.
+
+\yskip\hang |post_slash| means we've just output a slash.
+
+\yskip\hang |normal| means none of the above.
+
+\yskip\noindent Furthermore, if the variable |protect| is positive, newlines
+are preceded by a `\.\\'.
+
+@d normal 0 /* non-unusual state */
+@d num_or_id 1 /* state associated with numbers and identifiers */
+@d post_slash 2 /* state following a \./ */
+@d unbreakable 3 /* state associated with \.{@@\&} */
+@d verbatim 4 /* state in the middle of a string */
+
+@<Global...@>=
+eight_bits out_state; /* current status of partial output */
+boolean protect; /* should newline characters be quoted? */
+
+@ Here is a routine that is invoked when we want to output the current line.
+During the output process, |cur_line| equals the number of the next line
+to be output.
+
+@c
+void
+flush_buffer() /* writes one line to output file */
+{
+ C_putc('\n');
+ if (cur_line % 100 == 0 && show_progress) {
+ printf(".");
+ if (cur_line % 500 == 0) printf("%d",cur_line);
+ update_terminal; /* progress report */
+ }
+ cur_line++;
+}
+
+@ Second, we have modified the original \.{TANGLE} so that it will write output
+on multiple files.
+If a section name is introduced in at least one place by \.{@@(}
+instead of \.{@@<}, we treat it as the name of a file.
+All these special sections are saved on a stack, |output_files|.
+We write them out after we've done the unnamed section.
+
+@d max_files 256
+@<Glob...@>=
+name_pointer output_files[max_files];
+name_pointer *cur_out_file, *end_output_files, *an_output_file;
+char cur_section_name_char; /* is it |'<'| or |'('| */
+char output_file_name[longest_name]; /* name of the file */
+
+@ We make |end_output_files| point just beyond the end of
+|output_files|. The stack pointer
+|cur_out_file| starts out there. Every time we see a new file, we
+decrement |cur_out_file| and then write it in.
+@<Set initial...@>=
+cur_out_file=end_output_files=output_files+max_files;
+
+@ @<If it's not there, add |cur_section_name| to the output file stack, or
+complain we're out of room@>=
+{
+ for (an_output_file=cur_out_file;
+ an_output_file<end_output_files; an_output_file++)
+ if (*an_output_file==cur_section_name) break;
+ if (an_output_file==end_output_files) {
+ if (cur_out_file>output_files)
+ *--cur_out_file=cur_section_name;
+ else {
+ overflow("output files");
+ }
+ }
+}
+
+@* The big output switch. Here then is the routine that does the
+output.
+
+@<Predecl...@>=
+void phase_two();
+
+@ @c
+void
+phase_two () {
+ web_file_open=0;
+ cur_line=1;
+ @<Initialize the output stacks@>;
+ @<Output macro definitions if appropriate@>;
+ if (text_info->text_link==0 && cur_out_file==end_output_files) {
+ printf("\n! No program text was specified."); mark_harmless;
+@.No program text...@>
+ }
+ else {
+ if(cur_out_file==end_output_files) {
+ if(show_progress)
+ printf("\nWriting the output file (%s):",C_file_name);
+ }
+ else {
+ if (show_progress) {
+ printf("\nWriting the output files:");
+@.Writing the output...@>
+ printf(" (%s)",C_file_name);
+ update_terminal;
+ }
+ if (text_info->text_link==0) goto writeloop;
+ }
+ while (stack_ptr>stack) get_output();
+ flush_buffer();
+writeloop: @<Write all the named output files@>;
+ if(show_happiness) printf("\nDone.");
+ }
+}
+
+@ To write the named output files, we proceed as for the unnamed
+section.
+The only subtlety is that we have to open each one.
+
+@<Write all the named output files@>=
+for (an_output_file=end_output_files; an_output_file>cur_out_file;) {
+ an_output_file--;
+ sprint_section_name(output_file_name,*an_output_file);
+ fclose(C_file);
+ C_file=fopen(output_file_name,"w");
+ if (C_file ==0) fatal("! Cannot open output file:",output_file_name);
+@.Cannot open output file@>
+ printf("\n(%s)",output_file_name); update_terminal;
+ cur_line=1;
+ stack_ptr=stack+1;
+ cur_name= (*an_output_file);
+ cur_repl= (text_pointer)cur_name->equiv;
+ cur_byte=cur_repl->tok_start;
+ cur_end=(cur_repl+1)->tok_start;
+ while (stack_ptr > stack) get_output();
+ flush_buffer();
+}
+
+@ If a \.{@@h} was not encountered in the input,
+we go through the list of replacement texts and copy the ones
+that refer to macros, preceded by the \.{\#define} preprocessor command.
+
+@<Output macro definitions if appropriate@>=
+ if (!output_defs_seen)
+ output_defs();
+
+@ @<Glob...@>=
+boolean output_defs_seen=0;
+
+@ @<Predecl...@>=
+void output_defs();
+
+@ @c
+void
+output_defs()
+{
+ sixteen_bits a;
+ push_level(NULL);
+ for (cur_text=text_info+1; cur_text<text_ptr; cur_text++)
+ if (cur_text->text_link==0) { /* |cur_text| is the text for a macro */
+ cur_byte=cur_text->tok_start;
+ cur_end=(cur_text+1)->tok_start;
+ C_printf("%s","#define ");
+ out_state=normal;
+ protect=1; /* newlines should be preceded by |'\\'| */
+ while (cur_byte<cur_end) {
+ a=*cur_byte++;
+ if (cur_byte==cur_end && a=='\n') break; /* disregard a final newline */
+ if (out_state==verbatim && a!=string && a!=constant && a!='\n')
+ C_putc(a); /* a high-bit character can occur in a string */
+@^high-bit character handling@>
+ else if (a<0200) out_char(a); /* one-byte token */
+ else {
+ a=(a-0200)*0400+*cur_byte++;
+ if (a<024000) { /* |024000==(0250-0200)*0400| */
+ cur_val=a; out_char(identifier);
+ }
+ else if (a<050000) { confusion("macro defs have strange char");}
+ else {
+ cur_val=a-050000; cur_section=cur_val; out_char(section_number);
+ }
+ /* no other cases */
+ }
+ }
+ protect=0;
+ flush_buffer();
+ }
+ pop_level(0);
+}
+
+@ A many-way switch is used to send the output. Note that this function
+is not called if |out_state==verbatim|, except perhaps with arguments
+|'\n'| (protect the newline), |string| (end the string), or |constant|
+(end the constant).
+
+@<Predecl...@>=
+static void out_char();
+
+@ @c
+static void
+out_char(cur_char)
+eight_bits cur_char;
+{
+ char *j, *k; /* pointer into |byte_mem| */
+restart:
+ switch (cur_char) {
+ case '\n': if (protect && out_state!=verbatim) C_putc(' ');
+ if (protect || out_state==verbatim) C_putc('\\');
+ flush_buffer(); if (out_state!=verbatim) out_state=normal; break;
+ @/@t\4@>@<Case of an identifier@>;
+ @/@t\4@>@<Case of a section number@>;
+ @/@t\4@>@<Cases like \.{!=}@>;
+ case '=': case '>': C_putc(cur_char); C_putc(' ');
+ out_state=normal; break;
+ case join: out_state=unbreakable; break;
+ case constant: if (out_state==verbatim) {
+ out_state=num_or_id; break;
+ }
+ if(out_state==num_or_id) C_putc(' '); out_state=verbatim; break;
+ case string: if (out_state==verbatim) out_state=normal;
+ else out_state=verbatim; break;
+ case '/': C_putc('/'); out_state=post_slash; break;
+ case '*': if (out_state==post_slash) C_putc(' ');
+ /* fall through */
+ default: C_putc(cur_char); out_state=normal; break;
+ }
+}
+
+@ @<Cases like \.{!=}@>=
+case plus_plus: C_putc('+'); C_putc('+'); out_state=normal; break;
+case minus_minus: C_putc('-'); C_putc('-'); out_state=normal; break;
+case minus_gt: C_putc('-'); C_putc('>'); out_state=normal; break;
+case gt_gt: C_putc('>'); C_putc('>'); out_state=normal; break;
+case eq_eq: C_putc('='); C_putc('='); out_state=normal; break;
+case lt_lt: C_putc('<'); C_putc('<'); out_state=normal; break;
+case gt_eq: C_putc('>'); C_putc('='); out_state=normal; break;
+case lt_eq: C_putc('<'); C_putc('='); out_state=normal; break;
+case not_eq: C_putc('!'); C_putc('='); out_state=normal; break;
+case and_and: C_putc('&'); C_putc('&'); out_state=normal; break;
+case or_or: C_putc('|'); C_putc('|'); out_state=normal; break;
+case dot_dot_dot: C_putc('.'); C_putc('.'); C_putc('.'); out_state=normal;
+ break;
+case colon_colon: C_putc(':'); C_putc(':'); out_state=normal; break;
+case period_ast: C_putc('.'); C_putc('*'); out_state=normal; break;
+case minus_gt_ast: C_putc('-'); C_putc('>'); C_putc('*'); out_state=normal;
+ break;
+
+@ When an identifier is output to the \CEE/ file, characters in the
+range 128--255 must be changed into something else, so the \CEE/
+compiler won't complain. By default, \.{CTANGLE} converts the
+character with code $16 x+y$ to the three characters `\.X$xy$', but
+a different transliteration table can be specified. Thus a German
+might want {\it gr\"un\/} to appear as a still readable \.{gruen}.
+This makes debugging a lot less confusing.
+
+@d translit_length 10
+
+@<Glo...@>=
+char translit[128][translit_length];
+
+@ @<Set init...@>=
+{
+ int i;
+ for (i=0;i<128;i++) sprintf(translit[i],"X%02X",(unsigned)(128+i));
+}
+
+@ @<Case of an identifier@>=
+case identifier:
+ if (out_state==num_or_id) C_putc(' ');
+ j=(cur_val+name_dir)->byte_start;
+ k=(cur_val+name_dir+1)->byte_start;
+ while (j<k) {
+ if ((unsigned char)(*j)<0200) C_putc(*j);
+@^high-bit character handling@>
+ else C_printf("%s",translit[(unsigned char)(*j)-0200]);
+ j++;
+ }
+ out_state=num_or_id; break;
+
+@ @<Case of a sec...@>=
+case section_number:
+ if (cur_val>0) C_printf("/*%d:*/",cur_val);
+ else if(cur_val<0) C_printf("/*:%d*/",-cur_val);
+ else if (protect) {
+ cur_byte +=4; /* skip line number and file name */
+ cur_char = '\n';
+ goto restart;
+ } else {
+ sixteen_bits a;
+ a=0400* *cur_byte++;
+ a+=*cur_byte++; /* gets the line number */
+ C_printf("\n#line %d \"",a);
+@:line}{\.{\#line}@>
+ cur_val=*cur_byte++;
+ cur_val=0400*(cur_val-0200)+ *cur_byte++; /* points to the file name */
+ for (j=(cur_val+name_dir)->byte_start, k=(cur_val+name_dir+1)->byte_start;
+ j<k; j++) {
+ if (*j=='\\' || *j=='"') C_putc('\\');
+ C_putc(*j);
+ }
+ C_printf("%s","\"\n");
+ }
+ break;
+
+@** Introduction to the input phase.
+We have now seen that \.{CTANGLE} will be able to output the full
+\CEE/ program, if we can only get that program into the byte memory in
+the proper format. The input process is something like the output process
+in reverse, since we compress the text as we read it in and we expand it
+as we write it out.
+
+There are three main input routines. The most interesting is the one that gets
+the next token of a \CEE/ text; the other two are used to scan rapidly past
+\TEX/ text in the \.{CWEB} source code. One of the latter routines will jump to
+the next token that starts with `\.{@@}', and the other skips to the end
+of a \CEE/ comment.
+
+@ Control codes in \.{CWEB} begin with `\.{@@}', and the next character
+identifies the code. Some of these are of interest only to \.{CWEAVE},
+so \.{CTANGLE} ignores them; the others are converted by \.{CTANGLE} into
+internal code numbers by the |ccode| table below. The ordering
+of these internal code numbers has been chosen to simplify the program logic;
+larger numbers are given to the control codes that denote more significant
+milestones.
+
+@d ignore 0 /* control code of no interest to \.{CTANGLE} */
+@d ord 0302 /* control code for `\.{@@'}' */
+@d control_text 0303 /* control code for `\.{@@t}', `\.{@@\^}', etc. */
+@d translit_code 0304 /* control code for `\.{@@l}' */
+@d output_defs_code 0305 /* control code for `\.{@@h}' */
+@d format_code 0306 /* control code for `\.{@@f}' */
+@d definition 0307 /* control code for `\.{@@d}' */
+@d begin_C 0310 /* control code for `\.{@@c}' */
+@d section_name 0311 /* control code for `\.{@@<}' */
+@d new_section 0312 /* control code for `\.{@@\ }' and `\.{@@*}' */
+
+@<Global...@>=
+eight_bits ccode[256]; /* meaning of a char following \.{@@} */
+
+@ @<Set ini...@>= {
+ int c; /* must be |int| so the |for| loop will end */
+ for (c=0; c<256; c++) ccode[c]=ignore;
+ ccode[' ']=ccode['\t']=ccode['\n']=ccode['\v']=ccode['\r']=ccode['\f']
+ =ccode['*']=new_section;
+ ccode['@@']='@@'; ccode['=']=string;
+ ccode['d']=ccode['D']=definition;
+ ccode['f']=ccode['F']=ccode['s']=ccode['S']=format_code;
+ ccode['c']=ccode['C']=ccode['p']=ccode['P']=begin_C;
+ ccode['^']=ccode[':']=ccode['.']=ccode['t']=ccode['T']=
+ ccode['q']=ccode['Q']=control_text;
+ ccode['h']=ccode['H']=output_defs_code;
+ ccode['l']=ccode['L']=translit_code;
+ ccode['&']=join;
+ ccode['<']=ccode['(']=section_name;
+ ccode['\'']=ord;
+}
+
+@ The |skip_ahead| procedure reads through the input at fairly high speed
+until finding the next non-ignorable control code, which it returns.
+
+@c
+eight_bits
+skip_ahead() /* skip to next control code */
+{
+ eight_bits c; /* control code found */
+ while (1) {
+ if (loc>limit && (get_line()==0)) return(new_section);
+ *(limit+1)='@@';
+ while (*loc!='@@') loc++;
+ if (loc<=limit) {
+ loc++; c=ccode[(eight_bits)*loc]; loc++;
+ if (c!=ignore || *(loc-1)=='>') return(c);
+ }
+ }
+}
+
+@ The |skip_comment| procedure reads through the input at somewhat high
+speed in order to pass over comments, which \.{CTANGLE} does not transmit
+to the output. If the comment is introduced by \.{/*}, |skip_comment|
+proceeds until finding the end-comment token \.{*/} or a newline; in the
+latter case |skip_comment| will be called again by |get_next|, since the
+comment is not finished. This is done so that the each newline in the
+\CEE/ part of a section is copied to the output; otherwise the \&{\#line}
+commands inserted into the \CEE/ file by the output routines become useless.
+On the other hand, if the comment is introduced by \.{//} (i.e., if it
+is a \CPLUSPLUS/ ``short comment''), it always is simply delimited by the next
+newline. The boolean argument |is_long_comment| distinguishes between
+the two types of comments.
+
+If |skip_comment| comes to the end of the section, it prints an error message.
+No comment, long or short, is allowed to contain `\.{@@\ }' or `\.{@@*}'.
+
+@<Global...@>=
+boolean comment_continues=0; /* are we scanning a comment? */
+
+@ @c
+int skip_comment(is_long_comment) /* skips over comments */
+boolean is_long_comment;
+{
+ char c; /* current character */
+ while (1) {
+ if (loc>limit) {
+ if (is_long_comment) {
+ if(get_line()) return(comment_continues=1);
+ else{
+ err_print("! Input ended in mid-comment");
+@.Input ended in mid-comment@>
+ return(comment_continues=0);
+ }
+ }
+ else return(comment_continues=0);
+ }
+ c=*(loc++);
+ if (is_long_comment && c=='*' && *loc=='/') {
+ loc++; return(comment_continues=0);
+ }
+ if (c=='@@') {
+ if (ccode[(eight_bits)*loc]==new_section) {
+ err_print("! Section name ended in mid-comment"); loc--;
+@.Section name ended in mid-comment@>
+ return(comment_continues=0);
+ }
+ else loc++;
+ }
+ }
+}
+
+@* Inputting the next token.
+
+@d constant 03
+
+@<Global...@>=
+name_pointer cur_section_name; /* name of section just scanned */
+int no_where; /* suppress |print_where|? */
+
+@ @<Include...@>=
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+#include <stdlib.h> /* definition of |exit| */
+
+@ As one might expect, |get_next| consists mostly of a big switch
+that branches to the various special cases that can arise.
+
+@d isxalpha(c) ((c)=='_' || (c)=='$')
+ /* non-alpha characters allowed in identifier */
+@d ishigh(c) ((unsigned char)(c)>0177)
+@^high-bit character handling@>
+
+@c
+eight_bits
+get_next() /* produces the next input token */
+{
+ static int preprocessing=0;
+ eight_bits c; /* the current character */
+ while (1) {
+ if (loc>limit) {
+ if (preprocessing && *(limit-1)!='\\') preprocessing=0;
+ if (get_line()==0) return(new_section);
+ else if (print_where && !no_where) {
+ print_where=0;
+ @<Insert the line number into |tok_mem|@>;
+ }
+ else return ('\n');
+ }
+ c=*loc;
+ if (comment_continues || (c=='/' && (*(loc+1)=='*' || *(loc+1)=='/'))) {
+ skip_comment(comment_continues||*(loc+1)=='*');
+ /* scan to end of comment or newline */
+ if (comment_continues) return('\n');
+ else continue;
+ }
+ loc++;
+ if (xisdigit(c) || c=='.') @<Get a constant@>@;
+ else if (c=='\'' || c=='"' || (c=='L'&&(*loc=='\'' || *loc=='"')))
+ @<Get a string@>@;
+ else if (isalpha(c) || isxalpha(c) || ishigh(c))
+ @<Get an identifier@>@;
+ else if (c=='@@') @<Get control code and possible section name@>@;
+ else if (xisspace(c)) {
+ if (!preprocessing || loc>limit) continue;
+ /* we don't want a blank after a final backslash */
+ else return(' '); /* ignore spaces and tabs, unless preprocessing */
+ }
+ else if (c=='#' && loc==buffer+1) preprocessing=1;
+ mistake: @<Compress two-symbol operator@>@;
+ return(c);
+ }
+}
+
+@ The following code assigns values to the combinations \.{++},
+\.{--}, \.{->}, \.{>=}, \.{<=}, \.{==}, \.{<<}, \.{>>}, \.{!=}, \.{||} and
+\.{\&\&}, and to the \CPLUSPLUS/
+combinations \.{...}, \.{::}, \.{.*} and \.{->*}.
+The compound assignment operators (e.g., \.{+=}) are
+treated as separate tokens.
+
+@d compress(c) if (loc++<=limit) return(c)
+
+@<Compress tw...@>=
+switch(c) {
+ case '+': if (*loc=='+') compress(plus_plus); break;
+ case '-': if (*loc=='-') {compress(minus_minus);}
+ else if (*loc=='>') if (*(loc+1)=='*') {loc++; compress(minus_gt_ast);}
+ else compress(minus_gt); break;
+ case '.': if (*loc=='*') {compress(period_ast);}
+ else if (*loc=='.' && *(loc+1)=='.') {
+ loc++; compress(dot_dot_dot);
+ }
+ break;
+ case ':': if (*loc==':') compress(colon_colon); break;
+ case '=': if (*loc=='=') compress(eq_eq); break;
+ case '>': if (*loc=='=') {compress(gt_eq);}
+ else if (*loc=='>') compress(gt_gt); break;
+ case '<': if (*loc=='=') {compress(lt_eq);}
+ else if (*loc=='<') compress(lt_lt); break;
+ case '&': if (*loc=='&') compress(and_and); break;
+ case '|': if (*loc=='|') compress(or_or); break;
+ case '!': if (*loc=='=') compress(not_eq); break;
+}
+
+@ @<Get an identifier@>= {
+ id_first=--loc;
+ while (isalpha(*++loc) || isdigit(*loc) || isxalpha(*loc) || ishigh(*loc));
+ id_loc=loc; return(identifier);
+}
+
+@ @<Get a constant@>= {
+ id_first=loc-1;
+ if (*id_first=='.' && !xisdigit(*loc)) goto mistake; /* not a constant */
+ if (*id_first=='0') {
+ if (*loc=='x' || *loc=='X') { /* hex constant */
+ loc++; while (xisxdigit(*loc)) loc++; goto found;
+ }
+ }
+ while (xisdigit(*loc)) loc++;
+ if (*loc=='.') {
+ loc++;
+ while (xisdigit(*loc)) loc++;
+ }
+ if (*loc=='e' || *loc=='E') { /* float constant */
+ if (*++loc=='+' || *loc=='-') loc++;
+ while (xisdigit(*loc)) loc++;
+ }
+ found: while (*loc=='u' || *loc=='U' || *loc=='l' || *loc=='L'
+ || *loc=='f' || *loc=='F') loc++;
+ id_loc=loc;
+ return(constant);
+}
+
+@ \CEE/ strings and character constants, delimited by double and single
+quotes, respectively, can contain newlines or instances of their own
+delimiters if they are protected by a backslash. We follow this
+convention, but do not allow the string to be longer than |longest_name|.
+
+@<Get a string@>= {
+ char delim = c; /* what started the string */
+ id_first = section_text+1;
+ id_loc = section_text; *++id_loc=delim;
+ if (delim=='L') { /* wide character constant */
+ delim=*loc++; *++id_loc=delim;
+ }
+ while (1) {
+ if (loc>=limit) {
+ if(*(limit-1)!='\\') {
+ err_print("! String didn't end"); loc=limit; break;
+@.String didn't end@>
+ }
+ if(get_line()==0) {
+ err_print("! Input ended in middle of string"); loc=buffer; break;
+@.Input ended in middle of string@>
+ }
+ else if (++id_loc<=section_text_end) *id_loc='\n'; /* will print as
+ \.{"\\\\\\n"} */
+ }
+ if ((c=*loc++)==delim) {
+ if (++id_loc<=section_text_end) *id_loc=c;
+ break;
+ }
+ if (c=='\\') {
+ if (loc>=limit) continue;
+ if (++id_loc<=section_text_end) *id_loc = '\\';
+ c=*loc++;
+ }
+ if (++id_loc<=section_text_end) *id_loc=c;
+ }
+ if (id_loc>=section_text_end) {
+ printf("\n! String too long: ");
+@.String too long@>
+ term_write(section_text+1,25);
+ err_print("...");
+ }
+ id_loc++;
+ return(string);
+}
+
+@ After an \.{@@} sign has been scanned, the next character tells us
+whether there is more work to do.
+
+@<Get control code and possible section name@>= {
+ c=ccode[(eight_bits)*loc++];
+ switch(c) {
+ case ignore: continue;
+ case translit_code: err_print("! Use @@l in limbo only"); continue;
+@.Use @@l in limbo...@>
+ case control_text: while ((c=skip_ahead())=='@@');
+ /* only \.{@@@@} and \.{@@>} are expected */
+ if (*(loc-1)!='>')
+ err_print("! Double @@ should be used in control text");
+@.Double @@ should be used...@>
+ continue;
+ case section_name:
+ cur_section_name_char=*(loc-1);
+ @<Scan the section name and make |cur_section_name| point to it@>;
+ case string: @<Scan a verbatim string@>;
+ case ord: @<Scan an ASCII constant@>;
+ default: return(c);
+ }
+}
+
+@ After scanning a valid ASCII constant that follows
+\.{@@'}, this code plows ahead until it finds the next single quote.
+(Special care is taken if the quote is part of the constant.)
+Anything after a valid ASCII constant is ignored;
+thus, \.{@@'\\nopq'} gives the same result as \.{@@'\\n'}.
+
+@<Scan an ASCII constant@>=
+ id_first=loc;
+ if (*loc=='\\') {
+ if (*++loc=='\'') loc++;
+ }
+ while (*loc!='\'') {
+ if (*loc=='@@') {
+ if (*(loc+1)!='@@')
+ err_print("! Double @@ should be used in ASCII constant");
+@.Double @@ should be used...@>
+ else loc++;
+ }
+ loc++;
+ if (loc>limit) {
+ err_print("! String didn't end"); loc=limit-1; break;
+@.String didn't end@>
+ }
+ }
+ loc++;
+ return(ord);
+
+@ @<Scan the section name...@>= {
+ char *k; /* pointer into |section_text| */
+ @<Put section name into |section_text|@>;
+ if (k-section_text>3 && strncmp(k-2,"...",3)==0)
+ cur_section_name=section_lookup(section_text+1,k-3,1); /* 1 means is a prefix */
+ else cur_section_name=section_lookup(section_text+1,k,0);
+ if (cur_section_name_char=='(')
+ @<If it's not there, add |cur_section_name| to the output file stack, or
+ complain we're out of room@>;
+ return(section_name);
+}
+
+@ Section names are placed into the |section_text| array with consecutive spaces,
+tabs, and carriage-returns replaced by single spaces. There will be no
+spaces at the beginning or the end. (We set |section_text[0]=' '| to facilitate
+this, since the |section_lookup| routine uses |section_text[1]| as the first
+character of the name.)
+
+@<Set init...@>=section_text[0]=' ';
+
+@ @<Put section name...@>=
+k=section_text;
+while (1) {
+ if (loc>limit && get_line()==0) {
+ err_print("! Input ended in section name");
+@.Input ended in section name@>
+ loc=buffer+1; break;
+ }
+ c=*loc;
+ @<If end of name or erroneous nesting, |break|@>;
+ loc++; if (k<section_text_end) k++;
+ if (xisspace(c)) {
+ c=' '; if (*(k-1)==' ') k--;
+ }
+*k=c;
+}
+if (k>=section_text_end) {
+ printf("\n! Section name too long: ");
+@.Section name too long@>
+ term_write(section_text+1,25);
+ printf("..."); mark_harmless;
+}
+if (*k==' ' && k>section_text) k--;
+
+@ @<If end of name or erroneous nesting,...@>=
+if (c=='@@') {
+ c=*(loc+1);
+ if (c=='>') {
+ loc+=2; break;
+ }
+ if (ccode[(eight_bits)c]==new_section) {
+ err_print("! Section name didn't end"); break;
+@.Section name didn't end@>
+ }
+ if (ccode[(eight_bits)c]==section_name) {
+ err_print("! Nesting of section names not allowed"); break;
+@.Nesting of section names...@>
+ }
+ *(++k)='@@'; loc++; /* now |c==*loc| again */
+}
+
+@ At the present point in the program we
+have |*(loc-1)==string|; we set |id_first| to the beginning
+of the string itself, and |id_loc| to its ending-plus-one location in the
+buffer. We also set |loc| to the position just after the ending delimiter.
+
+@<Scan a verbatim string@>= {
+ id_first=loc++; *(limit+1)='@@'; *(limit+2)='>';
+ while (*loc!='@@' || *(loc+1)!='>') loc++;
+ if (loc>=limit) err_print("! Verbatim string didn't end");
+@.Verbatim string didn't end@>
+ id_loc=loc; loc+=2;
+ return(string);
+}
+
+@* Scanning a macro definition.
+The rules for generating the replacement texts corresponding to macros and
+\CEE/ texts of a section are almost identical; the only differences are that
+
+\yskip \item{a)}Section names are not allowed in macros;
+in fact, the appearance of a section name terminates such macros and denotes
+the name of the current section.
+
+\item{b)}The symbols \.{@@d} and \.{@@f} and \.{@@c} are not allowed after
+section names, while they terminate macro definitions.
+
+\item{c)}Spaces are inserted after right parentheses in macros, because the
+ANSI \CEE/ preprocessor sometimes requires it.
+
+\yskip Therefore there is a single procedure |scan_repl| whose parameter
+|t| specifies either |macro| or |section_name|. After |scan_repl| has
+acted, |cur_text| will point to the replacement text just generated, and
+|next_control| will contain the control code that terminated the activity.
+
+@d macro 0
+@d app_repl(c) {if (tok_ptr==tok_mem_end) overflow("token"); *tok_ptr++=c;}
+
+@<Global...@>=
+text_pointer cur_text; /* replacement text formed by |scan_repl| */
+eight_bits next_control;
+
+@ @c
+void
+scan_repl(t) /* creates a replacement text */
+eight_bits t;
+{
+ sixteen_bits a; /* the current token */
+ if (t==section_name) {@<Insert the line number into |tok_mem|@>;}
+ while (1) switch (a=get_next()) {
+ @<In cases that |a| is a non-|char| token (|identifier|,
+ |section_name|, etc.), either process it and change |a| to a byte
+ that should be stored, or |continue| if |a| should be ignored,
+ or |goto done| if |a| signals the end of this replacement text@>@;
+ case ')': app_repl(a);
+ if (t==macro) app_repl(' ');
+ break;
+ default: app_repl(a); /* store |a| in |tok_mem| */
+ }
+ done: next_control=(eight_bits) a;
+ if (text_ptr>text_info_end) overflow("text");
+ cur_text=text_ptr; (++text_ptr)->tok_start=tok_ptr;
+}
+
+@ Here is the code for the line number: first a |sixteen_bits| equal
+to |0150000|; then the numeric line number; then a pointer to the
+file name.
+
+@<Insert the line...@>=
+store_two_bytes(0150000);
+if (changing) id_first=change_file_name;
+else id_first=cur_file_name;
+id_loc=id_first+strlen(id_first);
+if (changing) store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a=id_lookup(id_first,id_loc,0)-name_dir; app_repl((a / 0400)+0200);
+ app_repl(a % 0400);}
+
+@ @<In cases that |a| is...@>=
+case identifier: a=id_lookup(id_first,id_loc,0)-name_dir;
+ app_repl((a / 0400)+0200);
+ app_repl(a % 0400); break;
+case section_name: if (t!=section_name) goto done;
+ else {
+ @<Was an `@@' missed here?@>;
+ a=cur_section_name-name_dir;
+ app_repl((a / 0400)+0250);
+ app_repl(a % 0400);
+ @<Insert the line number into |tok_mem|@>; break;
+ }
+case output_defs_code: if (t!=section_name) err_print("! Misplaced @@h");
+@.Misplaced @@h@>
+ else {
+ output_defs_seen=1;
+ a=output_defs_flag;
+ app_repl((a / 0400)+0200);
+ app_repl(a % 0400);
+ @<Insert the line number into |tok_mem|@>;
+ }
+ break;
+case constant: case string:
+ @<Copy a string or verbatim construction or numerical constant@>;
+case ord:
+ @<Copy an ASCII constant@>;
+case definition: case format_code: case begin_C: if (t!=section_name) goto done;
+ else {
+ err_print("! @@d, @@f and @@c are ignored in C text"); continue;
+@.@@d, @@f and @@c are ignored in C text@>
+ }
+case new_section: goto done;
+
+@ @<Was an `@@'...@>= {
+ char *try_loc=loc;
+ while (*try_loc==' ' && try_loc<limit) try_loc++;
+ if (*try_loc=='+' && try_loc<limit) try_loc++;
+ while (*try_loc==' ' && try_loc<limit) try_loc++;
+ if (*try_loc=='=') err_print ("! Missing `@@ ' before a named section");
+@.Missing `@@ '...@>
+ /* user who isn't defining a section should put newline after the name,
+ as explained in the manual */
+}
+
+@ @<Copy a string...@>=
+ app_repl(a); /* |string| or |constant| */
+ while (id_first < id_loc) { /* simplify \.{@@@@} pairs */
+ if (*id_first=='@@') {
+ if (*(id_first+1)=='@@') id_first++;
+ else err_print("! Double @@ should be used in string");
+@.Double @@ should be used...@>
+ }
+ app_repl(*id_first++);
+ }
+ app_repl(a); break;
+
+@ This section should be rewritten on machines that don't use ASCII
+code internally.
+@^ASCII code dependencies@>
+
+@<Copy an ASCII constant@>= {
+ int c=(eight_bits) *id_first;
+ if (c=='\\') {
+ c=*++id_first;
+ if (c>='0' && c<='7') {
+ c-='0';
+ if (*(id_first+1)>='0' && *(id_first+1)<='7') {
+ c=8*c+*(++id_first) - '0';
+ if (*(id_first+1)>='0' && *(id_first+1)<='7' && c<32)
+ c=8*c+*(++id_first)- '0';
+ }
+ }
+ else switch (c) {
+ case 't':c='\t';@+break;
+ case 'n':c='\n';@+break;
+ case 'b':c='\b';@+break;
+ case 'f':c='\f';@+break;
+ case 'v':c='\v';@+break;
+ case 'r':c='\r';@+break;
+ case 'a':c='\7';@+break;
+ case '?':c='?';@+break;
+ case 'x':
+ if (xisdigit(*(id_first+1))) c=*(++id_first)-'0';
+ else if (xisxdigit(*(id_first+1))) {
+ ++id_first;
+ c=toupper(*id_first)-'A'+10;
+ }
+ if (xisdigit(*(id_first+1))) c=16*c+*(++id_first)-'0';
+ else if (xisxdigit(*(id_first+1))) {
+ ++id_first;
+ c=16*c+toupper(*id_first)-'A'+10;
+ }
+ break;
+ case '\\':c='\\';@+break;
+ case '\'':c='\'';@+break;
+ case '\"':c='\"';@+break;
+ default: err_print("! Unrecognized escape sequence");
+@.Unrecognized escape sequence@>
+ }
+ }@/
+ /* at this point |c| should have been converted to its ASCII code number */
+ app_repl(constant);
+ if (c>=100) app_repl('0'+c/100);
+ if (c>=10) app_repl('0'+(c/10)%10);
+ app_repl('0'+c%10);
+ app_repl(constant);
+}
+break;
+
+@* Scanning a section.
+The |scan_section| procedure starts when `\.{@@\ }' or `\.{@@*}' has been
+sensed in the input, and it proceeds until the end of that section. It
+uses |section_count| to keep track of the current section number; with luck,
+\.{CWEAVE} and \.{CTANGLE} will both assign the same numbers to sections.
+
+@<Global...@>=
+extern sixteen_bits section_count; /* the current section number */
+
+@ The body of |scan_section| is a loop where we look for control codes
+that are significant to \.{CTANGLE}: those
+that delimit a definition, the \CEE/ part of a module, or a new module.
+
+@c
+void
+scan_section()
+{
+ name_pointer p; /* section name for the current section */
+ text_pointer q; /* text for the current section */
+ sixteen_bits a; /* token for left-hand side of definition */
+ section_count++; @+ no_where=1;
+ if (*(loc-1)=='*' && show_progress) { /* starred section */
+ printf("*%d",section_count); update_terminal;
+ }
+ next_control=0;
+ while (1) {
+ @<Skip ahead until |next_control| corresponds to \.{@@d}, \.{@@<},
+ \.{@@\ } or the like@>;
+ if (next_control == definition) { /* \.{@@d} */
+ @<Scan a definition@>@;
+ continue;
+ }
+ if (next_control == begin_C) { /* \.{@@c} or \.{@@p} */
+ p=name_dir; break;
+ }
+ if (next_control == section_name) { /* \.{@@<} or \.{@@(} */
+ p=cur_section_name;
+ @<If section is not being defined, |continue| @>;
+ break;
+ }
+ return; /* \.{@@\ } or \.{@@*} */
+ }
+ no_where=print_where=0;
+ @<Scan the \CEE/ part of the current section@>;
+}
+
+@ At the top of this loop, if |next_control==section_name|, the
+section name has already been scanned (see |@<Get control code
+and...@>|). Thus, if we encounter |next_control==section_name| in the
+skip-ahead process, we should likewise scan the section name, so later
+processing will be the same in both cases.
+
+@<Skip ahead until |next_control| ...@>=
+while (next_control<definition)
+ /* |definition| is the lowest of the ``significant'' codes */
+ if((next_control=skip_ahead())==section_name){
+ loc-=2; next_control=get_next();
+ }
+
+@ @<Scan a definition@>= {
+ while ((next_control=get_next())=='\n'); /*allow newline before definition */
+ if (next_control!=identifier) {
+ err_print("! Definition flushed, must start with identifier");
+@.Definition flushed...@>
+ continue;
+ }
+ app_repl(((a=id_lookup(id_first,id_loc,0)-name_dir) / 0400)+0200);
+ /* append the lhs */
+ app_repl(a % 0400);
+ if (*loc!='(') { /* identifier must be separated from replacement text */
+ app_repl(string); app_repl(' '); app_repl(string);
+ }
+ scan_repl(macro);
+ cur_text->text_link=0; /* |text_link==0| characterizes a macro */
+}
+
+@ If the section name is not followed by \.{=} or \.{+=}, no \CEE/
+code is forthcoming: the section is being cited, not being
+defined. This use is illegal after the definition part of the
+current section has started, except inside a comment, but
+\.{CTANGLE} does not enforce this rule; it simply ignores the offending
+section name and everything following it, up to the next significant
+control code.
+
+@<If section is not being defined, |continue| @>=
+while ((next_control=get_next())=='+'); /* allow optional \.{+=} */
+if (next_control!='=' && next_control!=eq_eq)
+ continue;
+
+@ @<Scan the \CEE/...@>=
+@<Insert the section number into |tok_mem|@>;
+scan_repl(section_name); /* now |cur_text| points to the replacement text */
+@<Update the data structure so that the replacement text is accessible@>;
+
+@ @<Insert the section number...@>=
+store_two_bytes((sixteen_bits)(0150000+section_count));
+ /* |0150000==0320*0400| */
+
+@ @<Update the data...@>=
+if (p==name_dir||p==0) { /* unnamed section, or bad section name */
+ (last_unnamed)->text_link=cur_text-text_info; last_unnamed=cur_text;
+}
+else if (p->equiv==(char *)text_info) p->equiv=(char *)cur_text;
+ /* first section of this name */
+else {
+ q=(text_pointer)p->equiv;
+ while (q->text_link<section_flag)
+ q=q->text_link+text_info; /* find end of list */
+ q->text_link=cur_text-text_info;
+}
+cur_text->text_link=section_flag;
+ /* mark this replacement text as a nonmacro */
+
+@ @<Predec...@>=
+void phase_one();
+
+@ @c
+void
+phase_one() {
+ phase=1;
+ section_count=0;
+ reset_input();
+ skip_limbo();
+ while (!input_has_ended) scan_section();
+ check_complete();
+ phase=2;
+}
+
+@ Only a small subset of the control codes is legal in limbo, so limbo
+processing is straightforward.
+
+@<Predecl...@>=
+void skip_limbo();
+
+@ @c
+void
+skip_limbo()
+{
+ char c;
+ while (1) {
+ if (loc>limit && get_line()==0) return;
+ *(limit+1)='@@';
+ while (*loc!='@@') loc++;
+ if (loc++<=limit) {
+ c=*loc++;
+ if (ccode[(eight_bits)c]==new_section) break;
+ switch (ccode[(eight_bits)c]) {
+ case translit_code: @<Read in transliteration of a character@>; break;
+ case format_code: case '@@': break;
+ case control_text: if (c=='q' || c=='Q') {
+ while ((c=skip_ahead())=='@@');
+ if (*(loc-1)!='>')
+ err_print("! Double @@ should be used in control text");
+@.Double @@ should be used...@>
+ break;
+ } /* otherwise fall through */
+ default: err_print("! Double @@ should be used in limbo");
+@.Double @@ should be used...@>
+ }
+ }
+ }
+}
+
+@ @<Read in transliteration of a character@>=
+ while(xisspace(*loc)&&loc<limit) loc++;
+ loc+=3;
+ if (loc>limit || !xisxdigit(*(loc-3)) || !xisxdigit(*(loc-2)) @|
+ || (*(loc-3)>='0' && *(loc-3)<='7') || !xisspace(*(loc-1)))
+ err_print("! Improper hex number following @@l");
+@.Improper hex number...@>
+ else {
+ unsigned i;
+ char *beg;
+ sscanf(loc-3,"%x",&i);
+ while(xisspace(*loc)&&loc<limit) loc++;
+ beg=loc;
+ while(loc<limit&&(xisalpha(*loc)||xisdigit(*loc)||*loc=='_')) loc++;
+ if (loc-beg>=translit_length)
+ err_print("! Replacement string in @@l too long");
+@.Replacement string in @@l...@>
+ else{
+ strncpy(translit[i-0200],beg,loc-beg);
+ translit[i-0200][loc-beg]='\0';
+ }
+ }
+
+@ Because on some systems the difference between two pointers is a |long|
+but not an |int|, we use \.{\%ld} to print these quantities.
+
+@c
+void
+print_stats() {
+ printf("\nMemory usage statistics:\n");
+ printf("%ld names (out of %ld)\n",
+ (long)(name_ptr-name_dir),(long)max_names);
+ printf("%ld replacement texts (out of %ld)\n",
+ (long)(text_ptr-text_info),(long)max_texts);
+ printf("%ld bytes (out of %ld)\n",
+ (long)(byte_ptr-byte_mem),(long)max_bytes);
+ printf("%ld tokens (out of %ld)\n",
+ (long)(tok_ptr-tok_mem),(long)max_toks);
+}
+
+@** Index.
+Here is a cross-reference table for \.{CTANGLE}.
+All sections in which an identifier is
+used are listed with that identifier, except that reserved words are
+indexed only when they appear in format definitions, and the appearances
+of identifiers in section names are not indexed. Underlined entries
+correspond to where the identifier was declared. Error messages and
+a few other things like ``ASCII code dependencies'' are indexed here too.
diff --git a/Build/source/texk/web2c/cwebdir/cweav-bs.ch b/Build/source/texk/web2c/cwebdir/cweav-bs.ch
new file mode 100644
index 00000000000..186d4cc777c
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweav-bs.ch
@@ -0,0 +1,302 @@
+Changes for CWEAVE for MSDOS and Borland C++ 3.1 using the following
+options (and perhaps others):
+
+ -mc -w-pro -Ff=5000 -Z- -O-p
+
+The options -Z- and -O-p explicitly turn off optimizations that break
+the code. (See makefile.bs.)
+
+The main purpose of these changes is to support MSDOS with full-size arrays
+by using "huge" pointers.
+
+This file contributed by Barry Schwartz, trashman@crud.mn.org, 28 Jun 94.
+(Includes workaround for compiler bug [pointers wrapping around at
+ segment boundaries], November 1993, contributed by Jorge Fernandez Arnaiz
+ -- arnaiz@redvax1.dgsca.unam.mx)
+(Last revised 5 Dec 94 with help of bob@microprograms.com.)
+
+
+@x Section 1.
+The ``banner line'' defined here should be changed whenever \.{CWEAVE}
+is modified.
+
+@d banner "This is CWEAVE (Version 3.64)\n"
+@y
+The ``banner line'' defined here should be changed whenever \.{CWEAVE}
+is modified.
+
+@d banner "This is CWEAVE (Version 3.64pc/big)\n"
+@z
+
+
+@x Section 9.
+@d chunk_marker 0
+
+@<Common code...@>=
+typedef struct name_info {
+ char *byte_start; /* beginning of the name in |byte_mem| */
+ struct name_info *link;
+ union {
+ struct name_info *Rlink; /* right link in binary search tree for section
+ names */
+ char Ilk; /* used by identifiers in \.{CWEAVE} only */
+ } dummy;
+ char *equiv_or_xref; /* info corresponding to names */
+} name_info; /* contains information about an identifier or section name */
+typedef name_info *name_pointer; /* pointer into array of \&{name\_info}s */
+typedef name_pointer *hash_pointer;
+extern char byte_mem[]; /* characters of names */
+extern char *byte_mem_end; /* end of |byte_mem| */
+extern name_info name_dir[]; /* information about names */
+extern name_pointer name_dir_end; /* end of |name_dir| */
+extern name_pointer name_ptr; /* first unused position in |byte_start| */
+extern char *byte_ptr; /* first unused position in |byte_mem| */
+extern name_pointer hash[]; /* heads of hash lists */
+extern hash_pointer hash_end; /* end of |hash| */
+extern hash_pointer h; /* index into hash-head array */
+extern name_pointer id_lookup(); /* looks up a string in the identifier table */
+extern name_pointer section_lookup(); /* finds section name */
+extern void print_section_name(), sprint_section_name();
+@y
+@d chunk_marker 0
+
+@f huge extern
+
+@<Common code...@>=
+typedef struct name_info {
+ char huge* byte_start; /* beginning of the name in |byte_mem| */
+ struct name_info *link;
+ union {
+ struct name_info *Rlink; /* right link in binary search tree for section
+ names */
+ char Ilk; /* used by identifiers in \.{CWEAVE} only */
+ } dummy;
+ union {
+ char *equiv_member;
+ char huge* xref_member;
+ } ptr_union; /* info corresponding to names */
+} name_info; /* contains information about an identifier or section name */
+typedef name_info *name_pointer; /* pointer into array of \&{name\_info}s */
+typedef name_pointer *hash_pointer;
+extern char huge byte_mem[]; /* characters of names */
+extern char huge* byte_mem_end; /* end of |byte_mem| */
+extern name_info name_dir[]; /* information about names */
+extern name_pointer name_dir_end; /* end of |name_dir| */
+extern name_pointer name_ptr; /* first unused position in |byte_start| */
+extern char huge* byte_ptr; /* first unused position in |byte_mem| */
+extern name_pointer hash[]; /* heads of hash lists */
+extern hash_pointer hash_end; /* end of |hash| */
+extern hash_pointer h; /* index into hash-head array */
+extern name_pointer id_lookup(); /* looks up a string in the identifier table */
+extern name_pointer section_lookup(); /* finds section name */
+extern void print_section_name(), sprint_section_name();
+@z
+
+
+@x Section 18.
+typedef struct xref_info {
+ sixteen_bits num; /* section number plus zero or |def_flag| */
+ struct xref_info *xlink; /* pointer to the previous cross-reference */
+} xref_info;
+typedef xref_info *xref_pointer;
+@y
+typedef struct xref_info {
+ sixteen_bits num; /* section number plus zero or |def_flag| */
+ struct xref_info huge* xlink; /* pointer to the previous cross-reference */
+} xref_info;
+typedef xref_info huge* xref_pointer;
+@z
+
+
+@x Section 19.
+xref_info xmem[max_refs]; /* contains cross-reference information */
+xref_pointer xmem_end = xmem+max_refs-1;
+@y
+xref_info huge xmem[max_refs]; /* contains cross-reference information */
+xref_pointer xmem_end;
+@z
+
+
+@x Section 20.
+@d xref equiv_or_xref
+@y
+@d xref ptr_union.xref_member
+@z
+
+
+@x Section 20.
+xref_ptr=xmem; name_dir->xref=(char*)xmem; xref_switch=0; section_xref_switch=0;
+xmem->num=0; /* sentinel value */
+@y
+xmem_end = xmem + max_refs - 1;
+xref_ptr=xmem; name_dir->xref=(char*)xmem; xref_switch=0; section_xref_switch=0;
+xmem->num=0; /* sentinel value */
+@z
+
+
+@x Section 21.
+ append_xref(m); xref_ptr->xlink=q; p->xref=(char*)xref_ptr;
+@y
+ append_xref(m); xref_ptr->xlink=q; p->xref=(char huge*)xref_ptr;
+@z
+
+
+@x Section 22.
+ if (r==xmem) p->xref=(char*)xref_ptr;
+@y
+ if (r==xmem) p->xref=(char huge*)xref_ptr;
+@z
+
+
+@x Section 23.
+ q=(xref_pointer)p->xref;
+ if (q->num==file_flag) return;
+ append_xref(file_flag);
+ xref_ptr->xlink = q;
+ p->xref = (char *)xref_ptr;
+@y
+ q=(xref_pointer)p->xref;
+ if (q->num==file_flag) return;
+ append_xref(file_flag);
+ xref_ptr->xlink = q;
+ p->xref = (char huge*)xref_ptr;
+@z
+
+@x Section 25. (to please Borland's C++, version 4.02)
+token tok_mem[max_toks]; /* tokens */
+token_pointer tok_mem_end = tok_mem+max_toks-1; /* end of |tok_mem| */
+token_pointer tok_start[max_texts]; /* directory into |tok_mem| */
+token_pointer tok_ptr; /* first unused position in |tok_mem| */
+text_pointer text_ptr; /* first unused position in |tok_start| */
+text_pointer tok_start_end = tok_start+max_texts-1; /* end of |tok_start| */
+token_pointer max_tok_ptr; /* largest value of |tok_ptr| */
+@y
+token tok_mem[max_toks]; /* tokens */
+token_pointer tok_mem_end; /* end of |tok_mem| */
+token_pointer tok_start[max_texts]; /* directory into |tok_mem| */
+token_pointer tok_ptr; /* first unused position in |tok_mem| */
+text_pointer text_ptr; /* first unused position in |tok_start| */
+text_pointer tok_start_end; /* end of |tok_start| */
+token_pointer max_tok_ptr; /* largest value of |tok_ptr| */
+@z
+
+@x Section 26. (goes with the previous change)
+tok_start[1]=tok_mem+1;
+max_tok_ptr=tok_mem+1; max_text_ptr=tok_start+1;
+@y
+tok_start[1]=tok_mem+1;
+tok_mem_end=tok_mem+max_toks-1;
+tok_start_end=tok_start+max_texts-1;
+max_tok_ptr=tok_mem+1; max_text_ptr=tok_start+1;
+@z
+
+
+@x Section 27.
+ p->ilk=t; p->xref=(char*)xmem;
+@y
+ p->ilk=t; p->xref=(char huge*)xmem;
+@z
+
+
+@x Section 27.
+ p->xref=(char*)xmem;
+@y
+ p->xref=(char huge*)xmem;
+@z
+
+
+@x Section 70.
+ if (unindexed(lhs)) { /* retain only underlined entries */
+ xref_pointer q,r=NULL;
+ for (q=(xref_pointer)lhs->xref;q>xmem;q=q->xlink)
+ if (q->num<def_flag)
+ if (r) r->xlink=q->xlink;
+ else lhs->xref=(char*)q->xlink;
+ else r=q;
+ }
+@y
+ if (unindexed(lhs)) { /* retain only underlined entries */
+ xref_pointer q,r=NULL;
+ for (q=(xref_pointer)lhs->xref;q>xmem;q=q->xlink)
+ if (q->num<def_flag)
+ if (r) r->xlink=q->xlink;
+ else lhs->xref=(char huge*)q->xlink;
+ else r=q;
+ }
+@z
+
+
+@x Section 87.
+ char *k, *k_end=(p+1)->byte_start; /* pointers into |byte_mem| */
+ out('{');
+ for (k=p->byte_start; k<k_end; k++) {
+@y
+ char huge* k, huge* k_end=(p+1)->byte_start; /* pointers into |byte_mem| */
+ out('{');
+ for (k=p->byte_start; k<k_end; k++) {
+@z
+
+
+@x Section 116.
+ append_xref(0); /* this number doesn't matter */
+ xref_ptr->xlink=(xref_pointer)p->xref; r=xref_ptr;
+ p->xref=(char*)xref_ptr;
+ while (r->xlink!=q) {r->num=r->xlink->num; r=r->xlink;}
+ r->num=m; /* everything from |q| on is left undisturbed */
+@y
+ append_xref(0); /* this number doesn't matter */
+ xref_ptr->xlink=(xref_pointer)p->xref; r=xref_ptr;
+ p->xref=(char huge*)xref_ptr;
+ while (r->xlink!=q) {r->num=r->xlink->num; r=r->xlink;}
+ r->num=m; /* everything from |q| on is left undisturbed */
+@z
+
+
+@x Section 163.
+@ @<Change |pp| to $\max...@>=
+@y
+@ @<Change |pp| to $\max...@>=
+#ifdef __MSDOS__
+if (d<0 && pp+d>pp) pp=scrap_base; /* segmented architecture caused wrap */
+else
+#endif
+@z
+
+
+@x Section 194.
+ char *p; /* index into |byte_mem| */
+@y
+ char huge *p; /* index into |byte_mem| */
+@z
+
+
+@x Section 229.
+ if (cur_name->xref!=(char*)xmem) {
+@y
+ if (cur_name->xref!=(char huge*)xmem) {
+@z
+
+
+@x Section 232.
+char *cur_byte; /* index into |byte_mem| */
+@y
+char huge* cur_byte; /* index into |byte_mem| */
+@z
+
+
+@x Section 241.
+switch (cur_name->ilk) {
+ case normal: if (is_tiny(cur_name)) out_str("\\|");
+ else {char *j;
+@y
+switch (cur_name->ilk) {
+ case normal: if (is_tiny(cur_name)) out_str("\\|");
+ else {char huge* j;
+@z
+
+
+@x Section 241.
+ case custom: case quoted: {char *j; out_str("$\\");
+@y
+ case custom: case quoted: {char huge* j; out_str("$\\");
+@z
diff --git a/Build/source/texk/web2c/cwebdir/cweav-man.ch b/Build/source/texk/web2c/cwebdir/cweav-man.ch
new file mode 100644
index 00000000000..6cfcc8fe2d2
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweav-man.ch
@@ -0,0 +1,22 @@
+Change file to help make Appendix F of the full CWEB manual
+@x
+\def\botofcontents{\vfill
+\noindent
+Copyright \copyright\ 1987, 1990, 1993, 2000 Silvio Levy and Donald E. Knuth
+\bigskip\noindent
+Permission is granted to make and distribute verbatim copies of this
+document provided that the copyright notice and this permission notice
+are preserved on all copies.
+
+\smallskip\noindent
+Permission is granted to copy and distribute modified versions of this
+document under the conditions for verbatim copying, provided that the
+entire resulting derived work is given a different name and distributed
+under the terms of a permission notice identical to this one.
+}
+@y
+\def\botofcontents{\vfill\titlefalse}
+\def\contentspagenumber{109}
+\def\title{APPENDIX F: CWEAVE}
+\let\K=\leftarrow
+@z
diff --git a/Build/source/texk/web2c/cwebdir/cweav-pc.ch b/Build/source/texk/web2c/cwebdir/cweav-pc.ch
new file mode 100644
index 00000000000..28cd94f5a3f
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweav-pc.ch
@@ -0,0 +1,39 @@
+This is the change file for CWEB's CWEAVE under DOS
+(Contributed by Lee Wittenberg, March 1993)
+(Also includes workaround for compiler bug, November 1993,
+ contributed by Jorge Fernandez Arnaiz -- arnaiz@redvax1.dgsca.unam.mx)
+
+Changes necessary for compiling with Borland C/C++
+Use compilation switches -mc -w-pro -Ff=5000
+
+Note: The changes to section 4 are not necessary if using a compiler
+that allows >64K arrays. (If you need lots more bytes, try the alternate
+change files that have -bs in their name instead of -pc.)
+
+@x section 1
+@d banner "This is CWEAVE (Version 3.64)\n"
+@y
+@d banner "This is CWEAVE (Version 3.64pc)\n"
+@z
+
+@x section 4
+@d max_bytes 90000 /* the number of bytes in identifiers,
+@y
+@d max_bytes (unsigned)60000 /* the number of bytes in identifiers,
+@z
+@x
+@d max_refs 20000 /* number of cross-references; must be less than 65536 */
+@y
+@d max_refs 10000 /* number of cross-references; must be less than 65536 */
+@z
+
+@x section 163
+@ @<Change |pp| to $\max...@>=
+@y
+@ @<Change |pp| to $\max...@>=
+#ifdef __MSDOS__
+if (d<0 && pp+d>pp) pp=scrap_base; /* segmented architecture caused wrap */
+else
+#endif
+@z
+
diff --git a/Build/source/texk/web2c/cwebdir/cweav-ql.ch b/Build/source/texk/web2c/cwebdir/cweav-ql.ch
new file mode 100644
index 00000000000..3e37ba23522
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweav-ql.ch
@@ -0,0 +1,32 @@
+This is the change file for CWEB's CWEAVE under QDOS/SMSQ
+(Contributed by Robert H. Klein, September 1994)
+
+This change file is intended for use with C68 v4.14 (or later).
+compile with
+ex <dev_>cc;"-v -h -c =500000 cweave_c"
+
+
+@x
+\def\title{CWEAVE (Version 3.64)}
+@y
+\def\title{CWEAVE (QL Version 3.64)}
+@z
+
+@x section 1
+@d banner "This is CWEAVE (Version 3.64)\n"
+@y
+@d banner "This is CWEAVE (QL Version 3.64)\n"
+@z
+
+@x
+@i common.h
+@y
+@i common_h
+@z
+
+
+@x
+@i prod.w
+@y
+@i prod_w
+@z
diff --git a/Build/source/texk/web2c/cwebdir/cweav-vms.ch b/Build/source/texk/web2c/cwebdir/cweav-vms.ch
new file mode 100644
index 00000000000..b6f46559cc5
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweav-vms.ch
@@ -0,0 +1,37 @@
+This is the change file for CWEB's CWEAVE for VAX/VMS.
+
+created:
+ 1991 JM (John Mulhollen, Science Applications International Corporation)
+
+modified:
+ 01-FEB-1992 ST (Stephan Trebels <trebels@ams02.dnet.gwdg.de>)
+ > include ctype,stdio from textlibrary SYS$SHARE:VAXCDEF.TLB
+ > change banner line to include (VAX/VMS)
+ > allow $ in identifiers (*necessary* for VAX/VMS)
+ ? will someone eventally make a CLD interface? (should be easy)
+
+(also modified by Don Knuth to keep version numbers uptodate)
+
+@x section 1 (01-FEB-1992 ST)
+@d banner "This is CWEAVE (Version 3.64)\n"
+@y
+@d banner "This is CWEAVE (VAX/VMS Version 3.64)\n"
+@z
+
+@x section 6 (from common.h) (01-FEB-1992 ST)
+#include <stdio.h>
+@y
+#include stdio /* VMS searches Textlibraries faster */
+@z
+
+@x section 38 (1991 JM) (01-FEB-1992 ST)
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+@y
+#include ctype /* VMS searches Textlibraries faster */
+@z
+
+@x section 39 (01-FEB-1992 ST)
+@d isxalpha(c) ((c)=='_') /* non-alpha character allowed in identifier */
+@y
+@d isxalpha(c) ((c)=='_' || (c)=='$') /* non-alpha characters allowed in id */
+@z
diff --git a/Build/source/texk/web2c/cwebdir/cweav-w2c.ch b/Build/source/texk/web2c/cwebdir/cweav-w2c.ch
new file mode 100644
index 00000000000..59552eedcda
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweav-w2c.ch
@@ -0,0 +1,768 @@
+% Kpathsea changes for CWEB by Wlodek Bzyl and Olaf Weber
+% Copyright 2002 Wlodek Bzyl and Olaf Weber
+% This file is in the Public Domain.
+
+
+@x l.32
+\def\title{CWEAVE (Version 3.64)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont The {\ttitlefont CWEAVE} processor}
+ \vskip 15pt
+ \centerline{(Version 3.64)}
+ \vfill}
+@y
+\def\Kpathsea/{{\mc KPATHSEA\spacefactor1000}}
+\def\SQUARE{\vrule width 2pt depth -1pt height 3pt}
+\def\sqitem{\item{\SQUARE}}
+
+\def\title{CWEAVE (Version 3.64k)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont The {\ttitlefont CWEAVE} processor}
+ \vskip 15pt
+ \centerline{(Version 3.64k)}
+ \vfill}
+@z
+
+This change can not be applied when `tie' is used
+(TOC file can not be typeset).
+
+%@x l.51
+%\let\maybe=\iftrue
+%@y
+%\let\maybe=\iffalse % print only changed modules
+%@z
+
+
+Section 1.
+
+@x l.65
+The ``banner line'' defined here should be changed whenever \.{CWEAVE}
+is modified.
+
+@d banner "This is CWEAVE (Version 3.64)\n"
+@y
+The ``banner line'' defined here should be changed whenever \.{CWEAVE}
+is modified.
+
+@d banner "This is CWEAVE, Version 3.64"
+@z
+
+
+Section 2.
+
+@x l.77
+@ We predeclare several standard system functions here instead of including
+their system header files, because the names of the header files are not as
+standard as the names of the functions. (For example, some \CEE/ environments
+have \.{<string.h>} where others have \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern int strcmp(); /* compare strings lexicographically */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+@y
+@z
+
+Section 3.
+
+@x l.98
+int main (ac, av)
+int ac; /* argument count */
+char **av; /* argument values */
+@y
+int main P2C(int,ac, char**,av)
+@z
+
+@x l.107 - Add Web2C version to banner.
+ if (show_banner) printf(banner); /* print a ``banner line'' */
+@y
+ if (show_banner) {
+ printf("%s%s\n", banner, versionstring); /* print a ``banner line'' */
+ }
+@z
+
+
+Section 5.
+
+@x common.h l.30 - boolean comes from kpathsea.
+typedef short boolean;
+@y
+@z
+
+Section 6.
+
+@x l.36
+#include <stdio.h>
+@y
+#include <stdio.h>
+/* #include "cpascal.h" ??? */
+extern char *versionstring;
+#include <kpathsea/kpathsea.h>
+@z
+
+Section 9.
+
+@x common.h l.109
+extern name_pointer id_lookup(); /* looks up a string in the identifier table */
+extern name_pointer section_lookup(); /* finds section name */
+extern void print_section_name(), sprint_section_name();
+@y
+/* looks up a string in the identifier table */
+extern name_pointer id_lookup P3H(char*,char*,char);
+/* finds section name */
+extern name_pointer section_lookup P3H(char*,char*,char);
+extern void print_section_name P1H(name_pointer);
+extern void sprint_section_name P2H(char*,name_pointer);
+@z
+
+Section 10.
+
+@x common.h l.123 - explicit types.
+extern history; /* indicates how bad this run was */
+extern err_print(); /* print error message and context */
+extern wrap_up(); /* indicate |history| and exit */
+extern void fatal(); /* issue error message and die */
+extern void overflow(); /* succumb because a table has overflowed */
+@y
+extern int history; /* indicates how bad this run was */
+extern void err_print P1H(char*); /* print error message and context */
+extern int wrap_up P1H(void); /* indicate |history| and exit */
+extern void fatal P2H(char*,char*); /* issue error message and die */
+extern void overflow P1H(char*); /* succumb because a table has overflowed */
+@z
+
+Section 11.
+
+@x common.h l.131 - max_file_name_length is way too small.
+@d max_file_name_length 60
+@y
+@d max_file_name_length 1024
+@z
+
+@x common.h l.138 - explicit types.
+extern include_depth; /* current level of nesting */
+@y
+extern int include_depth; /* current level of nesting */
+@z
+
+@x common.h l.148 - explicit types.
+extern line[]; /* number of current line in the stacked files */
+extern change_line; /* number of current line in change file */
+@y
+extern int line[]; /* number of current line in the stacked files */
+extern int change_line; /* number of current line in change file */
+@z
+
+@x common.h l.153 - explicit types.
+extern reset_input(); /* initialize to read the web file and change file */
+extern get_line(); /* inputs the next line */
+extern check_complete(); /* checks that all changes were picked up */
+@y
+extern void reset_input P1H(void); /* initialize to read the web file and change file */
+extern int get_line P1H(void); /* inputs the next line */
+extern void check_complete P1H(void); /* checks that all changes were picked up */
+@z
+
+Section 15.
+
+@x common.h l.192
+extern void common_init();
+@y
+extern void common_init P1H(void);
+@z
+
+Section 21.
+
+@x l.276
+new_xref(p)
+name_pointer p;
+@y
+new_xref P1C(name_pointer,p)
+@z
+
+Section 22.
+
+@x l.307
+new_section_xref(p)
+name_pointer p;
+@y
+new_section_xref P1C(name_pointer,p)
+@z
+
+Section 23.
+
+@x l.327
+set_file_flag(p)
+name_pointer p;
+@y
+set_file_flag P1C(name_pointer,p)
+@z
+
+Section 27.
+
+@x l.371
+int names_match(p,first,l,t)
+name_pointer p; /* points to the proposed match */
+char *first; /* position of first character of string */
+int l; /* length of identifier */
+eight_bits t; /* desired ilk */
+@y
+int names_match P4C(name_pointer,p, char*,first, int,l, char,t)
+@z
+
+@x l.383
+init_p(p,t)
+name_pointer p;
+eight_bits t;
+@y
+init_p P2C(name_pointer,p, char,t)
+@z
+
+@x l.391
+init_node(p)
+name_pointer p;
+@y
+init_node P1C(name_pointer,p)
+@z
+
+Section 34.
+
+@x l.600
+void skip_limbo();
+@y
+void skip_limbo P1H(void);
+@z
+
+Section 35.
+
+@x l.604
+skip_limbo() {
+@y
+skip_limbo P1H(void) {
+@z
+
+Section 36.
+
+@x l.626
+skip_TeX() /* skip past pure \TEX/ code */
+@y
+skip_TeX P1H(void) /* skip past pure \TEX/ code */
+@z
+
+Section 38.
+
+@x l.682 - Add declaration for versionstring.
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+@y
+@z
+
+Section 39.
+
+@x l.696
+eight_bits get_next();
+@y
+eight_bits get_next P1H(void);
+@z
+
+Section 40.
+
+@x l.700
+get_next() /* produces the next input token */
+@y
+get_next P1H(void) /* produces the next input token */
+@z
+
+Section 55.
+
+@x l.971
+void skip_restricted();
+@y
+void skip_restricted P1H(void);
+@z
+
+Section 56.
+
+@x l.975
+skip_restricted()
+@y
+skip_restricted P1H(void)
+@z
+
+Section 59.
+
+@x l.1024
+void phase_one();
+@y
+void phase_one P1H(void);
+@z
+
+Section 60.
+
+@x l.1028
+phase_one() {
+@y
+phase_one P1H(void) {
+@z
+
+Section 62.
+
+@x l.1076
+void C_xref();
+@y
+void C_xref P1H(eight_bits);
+@z
+
+Section 63.
+
+@x l.1080
+C_xref( spec_ctrl ) /* makes cross-references for \CEE/ identifiers */
+ eight_bits spec_ctrl;
+@y
+C_xref P1C(eight_bits,spec_ctrl) /* makes cross-references for \CEE/ identifiers */
+@z
+
+Section 64.
+
+@x l.1104
+void outer_xref();
+@y
+void outer_xref P1H(void);
+@z
+
+Section 65.
+
+@x l.1108
+outer_xref() /* extension of |C_xref| */
+@y
+outer_xref P1H(void) /* extension of |C_xref| */
+@z
+
+Section 74.
+
+@x l.1266
+void section_check();
+@y
+void section_check P1H(name_pointer);
+@z
+
+Section 75.
+
+@x l.1270
+section_check(p)
+name_pointer p; /* print anomalies in subtree |p| */
+@y
+section_check P1C(name_pointer,p) /* print anomalies in subtree |p| */
+@z
+
+Section 78.
+
+@x l.1323
+flush_buffer(b,per_cent,carryover)
+char *b; /* outputs from |out_buf+1| to |b|,where |b<=out_ptr| */
+boolean per_cent,carryover;
+@y
+flush_buffer P3C(char*,b, boolean,per_cent, boolean,carryover)
+@z
+
+Section 79.
+
+@x l.1352
+finish_line() /* do this at the end of a line */
+@y
+finish_line P1H(void) /* do this at the end of a line */
+@z
+
+Section 81.
+
+@x l.1384
+out_str(s) /* output characters from |s| to end of string */
+char *s;
+@y
+out_str P1C(char*,s) /* output characters from |s| to end of string */
+@z
+
+Section 83.
+
+@x l.1402
+void break_out();
+@y
+void break_out P1H(void);
+@z
+
+Section 84.
+
+@x l.1406
+break_out() /* finds a way to break the output line */
+@y
+break_out P1H(void) /* finds a way to break the output line */
+@z
+
+Section 86.
+
+@x l.1441
+out_section(n)
+sixteen_bits n;
+@y
+out_section P1C(sixteen_bits,n)
+@z
+
+Section 87.
+
+@x l.1455
+out_name(p,quote_xalpha)
+name_pointer p;
+boolean quote_xalpha;
+@y
+out_name P2C(name_pointer,p, boolean,quote_xalpha)
+@z
+
+Section 88.
+
+@x l.1485
+copy_limbo()
+@y
+copy_limbo P1H(void)
+@z
+
+Section 90.
+
+@x l.1520
+copy_TeX()
+@y
+copy_TeX P1H(void)
+@z
+
+Section 91.
+
+@x l.1449
+int copy_comment();
+@y
+int copy_comment P2H(boolean,int);
+@z
+
+Section 92.
+
+@x l.1551
+int copy_comment(is_long_comment,bal) /* copies \TEX/ code in comments */
+boolean is_long_comment; /* is this a traditional \CEE/ comment? */
+int bal; /* brace balance */
+@y
+int copy_comment P2C(boolean,is_long_comment, int,bal)
+@z
+
+Section 99.
+
+@x l.1784
+print_cat(c) /* symbolic printout of a category */
+eight_bits c;
+@y
+print_cat P1C(eight_bits,c)
+@z
+
+Section 106.
+
+@x l.2139
+print_text(p) /* prints a token list for debugging; not used in |main| */
+text_pointer p;
+@y
+print_text P1C(text_pointer,p)
+@z
+
+Section 109.
+
+@x l.2264
+app_str(s)
+char *s;
+@y
+app_str P1C(char*,s)
+@z
+
+@x l.2271
+big_app(a)
+token a;
+@y
+big_app P1C(token,a)
+@z
+
+@x l.2288
+big_app1(a)
+scrap_pointer a;
+@y
+big_app1 P1C(scrap_pointer,a)
+@z
+
+Section 111.
+
+@x l.2415
+find_first_ident(p)
+text_pointer p;
+@y
+find_first_ident P1C(text_pointer,p)
+@z
+
+Section 112.
+
+@x l.2447
+make_reserved(p) /* make the first identifier in |p->trans| like |int| */
+scrap_pointer p;
+@y
+make_reserved P1C(scrap_pointer,p)
+@z
+
+Section 113.
+
+@x l.2478
+make_underlined(p)
+/* underline the entry for the first identifier in |p->trans| */
+scrap_pointer p;
+@y
+make_underlined P1C(scrap_pointer,p)
+@z
+
+Section 114.
+
+@x l.2495
+void underline_xref();
+@y
+void underline_xref P1H(name_pointer);
+@z
+
+Section 115.
+
+@x l.2499
+underline_xref(p)
+name_pointer p;
+@y
+underline_xref P1C(name_pointer,p)
+@z
+
+Section 164.
+
+@x l.3004
+reduce(j,k,c,d,n)
+scrap_pointer j;
+eight_bits c;
+short k, d, n;
+@y
+reduce P5C(scrap_pointer,j, short,k, eight_bits,c, short,d, short,n)
+@z
+
+Section 165.
+
+@x l.3030
+squash(j,k,c,d,n)
+scrap_pointer j;
+eight_bits c;
+short k, d, n;
+@y
+squash P5C(scrap_pointer,j, short,k, eight_bits,c, short,d, short,n)
+@z
+
+Section 170.
+
+@x l.3126
+translate() /* converts a sequence of scraps */
+@y
+translate P1H(void) /* converts a sequence of scraps */
+@z
+
+Section 174.
+
+@x l.3191
+C_parse(spec_ctrl) /* creates scraps from \CEE/ tokens */
+ eight_bits spec_ctrl;
+@y
+C_parse P1C(eight_bits,spec_ctrl) /* creates scraps from \CEE/ tokens */
+@z
+
+Section 181.
+
+@x l.3421
+void app_cur_id();
+@y
+void app_cur_id P1H(boolean);
+@z
+
+Section 182.
+
+@x l.3425
+app_cur_id(scrapping)
+boolean scrapping; /* are we making this into a scrap? */
+@y
+app_cur_id P1C(boolean,scrapping)
+@z
+
+Section 183.
+
+@x l.3451
+C_translate()
+@y
+C_translate P1H(void)
+@z
+
+Section 184.
+
+@x l.3480
+outer_parse() /* makes scraps from \CEE/ tokens and comments */
+@y
+outer_parse P1H(void) /* makes scraps from \CEE/ tokens and comments */
+@z
+
+Section 189.
+
+@x l.3586
+push_level(p) /* suspends the current level */
+text_pointer p;
+@y
+push_level P1C(text_pointer,p) /* suspends the current level */
+@z
+
+Section 190.
+
+@x l.3606
+pop_level()
+@y
+pop_level P1H(void)
+@z
+
+Section 192.
+
+@x l.3628
+get_output() /* returns the next token of output */
+@y
+get_output P1H(void) /* returns the next token of output */
+@z
+
+Section 193.
+
+@x l.3665
+output_C() /* outputs the current token list */
+@y
+output_C P1H(void) /* outputs the current token list */
+@z
+
+Section 194.
+
+@x l.3687
+void make_output();
+@y
+void make_output P1H(void);
+@z
+
+Section 195.
+
+@x l.3691
+make_output() /* outputs the equivalents of tokens */
+@y
+make_output P1H(void) /* outputs the equivalents of tokens */
+@z
+
+Section 205.
+
+@x l.3951
+void phase_two();
+@y
+void phase_two P1H(void);
+@z
+
+Section 206.
+
+@x l.3955
+phase_two() {
+@y
+phase_two P1H(void) {
+@z
+
+Section 212.
+
+@x l.4074
+void finish_C();
+@y
+void finish_C P1H(boolean);
+@z
+
+Section 213.
+
+@x l.4078
+finish_C(visible) /* finishes a definition or a \CEE/ part */
+ boolean visible; /* nonzero if we should produce \TEX/ output */
+@y
+finish_C P1C(boolean,visible) /* finishes a definition or a \CEE/ part */
+@z
+
+Section 221.
+
+@x l.4245
+void footnote();
+@y
+void footnote P1H(sixteen_bits);
+@z
+
+Section 222.
+
+@x l.4249
+footnote(flag) /* outputs section cross-references */
+sixteen_bits flag;
+@y
+footnote P1C(sixteen_bits,flag) /* outputs section cross-references */
+@z
+
+Section 225.
+
+@x l.4294
+void phase_three();
+@y
+void phase_three P1H(void);
+@z
+
+Section 226.
+
+@x l.4298
+phase_three() {
+@y
+phase_three P1H(void) {
+@z
+
+Section 237.
+
+@x l.4474
+void unbucket();
+@y
+void unbucket P1H(eight_bits);
+@z
+
+Section 238.
+
+@x l.4478
+unbucket(d) /* empties buckets having depth |d| */
+eight_bits d;
+@y
+unbucket P1C(eight_bits,d) /* empties buckets having depth |d| */
+@z
+
+Section 246.
+
+@x l.4594
+void section_print();
+@y
+void section_print P1H(name_pointer);
+@z
+
+Section 247.
+
+@x l.4598
+section_print(p) /* print all section names in subtree |p| */
+name_pointer p;
+@y
+section_print P1C(name_pointer,p) /* print all section names in subtree |p| */
+@z
+
+Section 249.
+
+@x l.4620
+print_stats() {
+@y
+print_stats P1H(void) {
+@z
diff --git a/Build/source/texk/web2c/cwebdir/cweav-w32.ch b/Build/source/texk/web2c/cwebdir/cweav-w32.ch
new file mode 100644
index 00000000000..26825b0bfd1
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweav-w32.ch
@@ -0,0 +1,52 @@
+This is the change file for CWEB's CWEAVE under Win32
+(Contributed by Fabrice Popineau, February 2002)
+
+@x section 1
+@d banner "This is CWEAVE (Version 3.64)\n"
+@y
+@d banner "This is CWEAVE (Version 3.64win32)\n"
+@z
+
+@x
+@ We predeclare several standard system functions here instead of including
+their system header files, because the names of the header files are not as
+standard as the names of the functions. (For example, some \CEE/ environments
+have \.{<string.h>} where others have \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern int strcmp(); /* compare strings lexicographically */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+@y
+@z
+
+@x
+int names_match(p,first,l,t)
+name_pointer p; /* points to the proposed match */
+@y
+int __cdecl names_match(p,first,l,t)
+name_pointer p; /* points to the proposed match */
+@z
+
+@x
+void
+init_p(p,t)
+name_pointer p;
+@y
+void __cdecl
+init_p(p,t)
+name_pointer p;
+@z
+
+@x
+@ @<Include...@>=
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+#include <stdlib.h> /* definition of |exit| */
+@y
+@ @<Include...@>=
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+#include <stdlib.h> /* definition of |exit| */
+#include <string.h> /* definition of |strncmp| and |strncpy| */
+@z
diff --git a/Build/source/texk/web2c/cwebdir/cweave.rc b/Build/source/texk/web2c/cwebdir/cweave.rc
new file mode 100644
index 00000000000..ac85c26e02c
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweave.rc
@@ -0,0 +1,34 @@
+/* cweave.rc: cweave resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " cweave 3.63"
+
+#define VER_INTERNALNAME_STR "cweave"
+#define VER_ORIGINALFILENAME_STR "cweave.exe"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1987,1990,1993 Silvio Levy and Donald E. Knuth"
+
+#define VER_FILEDESCRIPTION_STR "CWeave"
+
+#include <texlive.version>
+
+/* cweave.rc ends here */
diff --git a/Build/source/texk/web2c/cwebdir/cweave.w b/Build/source/texk/web2c/cwebdir/cweave.w
new file mode 100644
index 00000000000..91b8785bfe9
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweave.w
@@ -0,0 +1,4651 @@
+% This file is part of CWEB.
+% This program by Silvio Levy and Donald E. Knuth
+% is based on a program by Knuth.
+% It is distributed WITHOUT ANY WARRANTY, express or implied.
+% Version 3.64 --- February 2002
+% (essentially the same as version 3.6, which added
+% recently introduced features of standard C++ to version 3.4)
+
+% Copyright (C) 1987,1990,1993,2000 Silvio Levy and Donald E. Knuth
+
+% Permission is granted to make and distribute verbatim copies of this
+% document provided that the copyright notice and this permission notice
+% are preserved on all copies.
+
+% Permission is granted to copy and distribute modified versions of this
+% document under the conditions for verbatim copying, provided that the
+% entire resulting derived work is given a different name and distributed
+% under the terms of a permission notice identical to this one.
+
+% Here is TeX material that gets inserted after \input cwebmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\def\pb{$\.|\ldots\.|$} % C brackets (|...|)
+\def\v{\char'174} % vertical (|) in typewriter font
+\def\dleft{[\![} \def\dright{]\!]} % double brackets
+\mathchardef\RA="3221 % right arrow
+\mathchardef\BA="3224 % double arrow
+\def\({} % ) kludge for alphabetizing certain section names
+\def\TeXxstring{\\{\TEX/\_string}}
+\def\skipxTeX{\\{skip\_\TEX/}}
+\def\copyxTeX{\\{copy\_\TEX/}}
+
+\def\title{CWEAVE (Version 3.64)}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont The {\ttitlefont CWEAVE} processor}
+ \vskip 15pt
+ \centerline{(Version 3.64)}
+ \vfill}
+\def\botofcontents{\vfill
+\noindent
+Copyright \copyright\ 1987, 1990, 1993, 2000 Silvio Levy and Donald E. Knuth
+\bigskip\noindent
+Permission is granted to make and distribute verbatim copies of this
+document provided that the copyright notice and this permission notice
+are preserved on all copies.
+
+\smallskip\noindent
+Permission is granted to copy and distribute modified versions of this
+document under the conditions for verbatim copying, provided that the
+entire resulting derived work is given a different name and distributed
+under the terms of a permission notice identical to this one.
+}
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iftrue
+@s not_eq normal @q unreserve a C++ keyword @>
+
+@** Introduction.
+This is the \.{CWEAVE} program by Silvio Levy and Donald E. Knuth,
+based on \.{WEAVE} by Knuth.
+We are thankful to Steve Avery,
+Nelson Beebe, Hans-Hermann Bode (to whom the original \CPLUSPLUS/ adaptation
+is due), Klaus Guntermann, Norman Ramsey, Tomas Rokicki, Joachim Schnitter,
+Joachim Schrod, Lee Wittenberg, Saroj Mahapatra, Cesar Augusto Rorato
+Crusius, and others who have contributed improvements.
+
+The ``banner line'' defined here should be changed whenever \.{CWEAVE}
+is modified.
+
+@d banner "This is CWEAVE (Version 3.64)\n"
+
+@c @<Include files@>@/
+@h
+@<Common code for \.{CWEAVE} and \.{CTANGLE}@>@/
+@<Typedef declarations@>@/
+@<Global variables@>@/
+@<Predeclaration of procedures@>
+
+@ We predeclare several standard system functions here instead of including
+their system header files, because the names of the header files are not as
+standard as the names of the functions. (For example, some \CEE/ environments
+have \.{<string.h>} where others have \.{<strings.h>}.)
+
+@<Predecl...@>=
+extern int strlen(); /* length of string */
+extern int strcmp(); /* compare strings lexicographically */
+extern char* strcpy(); /* copy one string to another */
+extern int strncmp(); /* compare up to $n$ string characters */
+extern char* strncpy(); /* copy up to $n$ string characters */
+
+@ \.{CWEAVE} has a fairly straightforward outline. It operates in
+three phases: First it inputs the source file and stores cross-reference
+data, then it inputs the source once again and produces the \TEX/ output
+file, finally it sorts and outputs the index.
+
+Please read the documentation for \.{common}, the set of routines common
+to \.{CTANGLE} and \.{CWEAVE}, before proceeding further.
+
+@c
+int main (ac, av)
+int ac; /* argument count */
+char **av; /* argument values */
+{
+ argc=ac; argv=av;
+ program=cweave;
+ make_xrefs=force_lines=make_pb=1; /* controlled by command-line options */
+ common_init();
+ @<Set initial values@>;
+ if (show_banner) printf(banner); /* print a ``banner line'' */
+ @<Store all the reserved words@>;
+ phase_one(); /* read all the user's text and store the cross-references */
+ phase_two(); /* read all the text again and translate it to \TEX/ form */
+ phase_three(); /* output the cross-reference index */
+ return wrap_up(); /* and exit gracefully */
+}
+
+@ The following parameters were sufficient in the original \.{WEAVE} to
+handle \TEX/, so they should be sufficient for most applications of \.{CWEAVE}.
+If you change |max_bytes|, |max_names|, |hash_size|, or |buf_size|
+you have to change them also in the file |"common.w"|.
+
+@d max_bytes 90000 /* the number of bytes in identifiers,
+ index entries, and section names */
+@d max_names 4000 /* number of identifiers, strings, section names;
+ must be less than 10240; used in |"common.w"| */
+@d max_sections 2000 /* greater than the total number of sections */
+@d hash_size 353 /* should be prime */
+@d buf_size 100 /* maximum length of input line, plus one */
+@d longest_name 10000 /* section names and strings shouldn't be longer than this */
+@d long_buf_size (buf_size+longest_name)
+@d line_length 80 /* lines of \TEX/ output have at most this many characters;
+ should be less than 256 */
+@d max_refs 20000 /* number of cross-references; must be less than 65536 */
+@d max_toks 20000 /* number of symbols in \CEE/ texts being parsed;
+ must be less than 65536 */
+@d max_texts 4000 /* number of phrases in \CEE/ texts being parsed;
+ must be less than 10240 */
+@d max_scraps 2000 /* number of tokens in \CEE/ texts being parsed */
+@d stack_size 400 /* number of simultaneous output levels */
+
+@ The next few sections contain stuff from the file |"common.w"| that must
+be included in both |"ctangle.w"| and |"cweave.w"|. It appears in
+file |"common.h"|, which needs to be updated when |"common.w"| changes.
+
+@i common.h
+
+@* Data structures exclusive to {\tt CWEAVE}.
+As explained in \.{common.w}, the field of a |name_info| structure
+that contains the |rlink| of a section name is used for a completely
+different purpose in the case of identifiers. It is then called the
+|ilk| of the identifier, and it is used to
+distinguish between various types of identifiers, as follows:
+
+\yskip\hang |normal| and |func_template| identifiers are part of the
+\CEE/ program that will appear in italic type (or in typewriter type
+if all uppercase).
+
+\yskip\hang |custom| identifiers are part of the \CEE/ program that
+will be typeset in special ways.
+
+\yskip\hang |roman| identifiers are index entries that appear after
+\.{@@\^} in the \.{CWEB} file.
+
+\yskip\hang |wildcard| identifiers are index entries that appear after
+\.{@@:} in the \.{CWEB} file.
+
+\yskip\hang |typewriter| identifiers are index entries that appear after
+\.{@@.} in the \.{CWEB} file.
+
+\yskip\hang |alfop|, \dots, |template_like|
+identifiers are \CEE/ or \CPLUSPLUS/ reserved words whose |ilk|
+explains how they are to be treated when \CEE/ code is being
+formatted.
+
+@d ilk dummy.Ilk
+@d normal 0 /* ordinary identifiers have |normal| ilk */
+@d roman 1 /* normal index entries have |roman| ilk */
+@d wildcard 2 /* user-formatted index entries have |wildcard| ilk */
+@d typewriter 3 /* `typewriter type' entries have |typewriter| ilk */
+@d abnormal(a) (a->ilk>typewriter) /* tells if a name is special */
+@d func_template 4 /* identifiers that can be followed by optional template */
+@d custom 5 /* identifiers with user-given control sequence */
+@d alfop 22 /* alphabetic operators like \&{and} or \&{not\_eq} */
+@d else_like 26 /* \&{else} */
+@d public_like 40 /* \&{public}, \&{private}, \&{protected} */
+@d operator_like 41 /* \&{operator} */
+@d new_like 42 /* \&{new} */
+@d catch_like 43 /* \&{catch} */
+@d for_like 45 /* \&{for}, \&{switch}, \&{while} */
+@d do_like 46 /* \&{do} */
+@d if_like 47 /* \&{if}, \&{ifdef}, \&{endif}, \&{pragma}, \dots */
+@d delete_like 48 /* \&{delete} */
+@d raw_ubin 49 /* `\.\&' or `\.*' when looking for \&{const} following */
+@d const_like 50 /* \&{const}, \&{volatile} */
+@d raw_int 51 /* \&{int}, \&{char}, \dots; also structure and class names */
+@d int_like 52 /* same, when not followed by left parenthesis or \DC\ */
+@d case_like 53 /* \&{case}, \&{return}, \&{goto}, \&{break}, \&{continue} */
+@d sizeof_like 54 /* \&{sizeof} */
+@d struct_like 55 /* \&{struct}, \&{union}, \&{enum}, \&{class} */
+@d typedef_like 56 /* \&{typedef} */
+@d define_like 57 /* \&{define} */
+@d template_like 58 /* \&{template} */
+
+@ We keep track of the current section number in |section_count|, which
+is the total number of sections that have started. Sections which have
+been altered by a change file entry have their |changed_section| flag
+turned on during the first phase.
+
+@<Global...@>=
+boolean change_exists; /* has any section changed? */
+
+@ The other large memory area in \.{CWEAVE} keeps the cross-reference data.
+All uses of the name |p| are recorded in a linked list beginning at
+|p->xref|, which points into the |xmem| array. The elements of |xmem|
+are structures consisting of an integer, |num|, and a pointer |xlink|
+to another element of |xmem|. If |x=p->xref| is a pointer into |xmem|,
+the value of |x->num| is either a section number where |p| is used,
+or |cite_flag| plus a section number where |p| is mentioned,
+or |def_flag| plus a section number where |p| is defined;
+and |x->xlink| points to the next such cross-reference for |p|,
+if any. This list of cross-references is in decreasing order by
+section number. The next unused slot in |xmem| is |xref_ptr|.
+The linked list ends at |&xmem[0]|.
+
+The global variable |xref_switch| is set either to |def_flag| or to zero,
+depending on whether the next cross-reference to an identifier is to be
+underlined or not in the index. This switch is set to |def_flag| when
+\.{@@!} or \.{@@d} is scanned, and it is cleared to zero when
+the next identifier or index entry cross-reference has been made.
+Similarly, the global variable |section_xref_switch| is either
+|def_flag| or |cite_flag| or zero, depending
+on whether a section name is being defined, cited or used in \CEE/ text.
+
+@<Type...@>=
+typedef struct xref_info {
+ sixteen_bits num; /* section number plus zero or |def_flag| */
+ struct xref_info *xlink; /* pointer to the previous cross-reference */
+} xref_info;
+typedef xref_info *xref_pointer;
+
+@ @<Global...@>=
+xref_info xmem[max_refs]; /* contains cross-reference information */
+xref_pointer xmem_end = xmem+max_refs-1;
+xref_pointer xref_ptr; /* the largest occupied position in |xmem| */
+sixteen_bits xref_switch,section_xref_switch; /* either zero or |def_flag| */
+
+@ A section that is used for multi-file output (with the \.{@@(} feature)
+has a special first cross-reference whose |num| field is |file_flag|.
+
+@d file_flag (3*cite_flag)
+@d def_flag (2*cite_flag)
+@d cite_flag 10240 /* must be strictly larger than |max_sections| */
+@d xref equiv_or_xref
+
+@<Set init...@>=
+xref_ptr=xmem; name_dir->xref=(char*)xmem; xref_switch=0; section_xref_switch=0;
+xmem->num=0; /* sentinel value */
+
+@ A new cross-reference for an identifier is formed by calling |new_xref|,
+which discards duplicate entries and ignores non-underlined references
+to one-letter identifiers or \CEE/'s reserved words.
+
+If the user has sent the |no_xref| flag (the \.{-x} option of the command line),
+it is unnecessary to keep track of cross-references for identifiers.
+If one were careful, one could probably make more changes around section
+100 to avoid a lot of identifier looking up.
+
+@d append_xref(c) if (xref_ptr==xmem_end) overflow("cross-reference");
+ else (++xref_ptr)->num=c;
+@d no_xref (flags['x']==0)
+@d make_xrefs flags['x'] /* should cross references be output? */
+@d is_tiny(p) ((p+1)->byte_start==(p)->byte_start+1)
+@d unindexed(a) (a<res_wd_end && a->ilk>=custom)
+ /* tells if uses of a name are to be indexed */
+
+@c
+void
+new_xref(p)
+name_pointer p;
+{
+ xref_pointer q; /* pointer to previous cross-reference */
+ sixteen_bits m, n; /* new and previous cross-reference value */
+ if (no_xref) return;
+ if ((unindexed(p) || is_tiny(p)) && xref_switch==0) return;
+ m=section_count+xref_switch; xref_switch=0; q=(xref_pointer)p->xref;
+ if (q != xmem) {
+ n=q->num;
+ if (n==m || n==m+def_flag) return;
+ else if (m==n+def_flag) {
+ q->num=m; return;
+ }
+ }
+ append_xref(m); xref_ptr->xlink=q; p->xref=(char*)xref_ptr;
+}
+
+@ The cross-reference lists for section names are slightly different.
+Suppose that a section name is defined in sections $m_1$, \dots,
+$m_k$, cited in sections $n_1$, \dots, $n_l$, and used in sections
+$p_1$, \dots, $p_j$. Then its list will contain $m_1+|def_flag|$,
+\dots, $m_k+|def_flag|$, $n_1+|cite_flag|$, \dots,
+$n_l+|cite_flag|$, $p_1$, \dots, $p_j$, in this order.
+
+Although this method of storage takes quadratic time with respect to
+the length of the list, under foreseeable uses of \.{CWEAVE} this inefficiency
+is insignificant.
+
+@c
+void
+new_section_xref(p)
+name_pointer p;
+{
+ xref_pointer q,r; /* pointers to previous cross-references */
+ q=(xref_pointer)p->xref; r=xmem;
+ if (q>xmem)
+ while (q->num>section_xref_switch) {r=q; q=q->xlink;}
+ if (r->num==section_count+section_xref_switch)
+ return; /* don't duplicate entries */
+ append_xref(section_count+section_xref_switch);
+ xref_ptr->xlink=q; section_xref_switch=0;
+ if (r==xmem) p->xref=(char*)xref_ptr;
+ else r->xlink=xref_ptr;
+}
+
+@ The cross-reference list for a section name may also begin with
+|file_flag|. Here's how that flag gets put~in.
+
+@c
+void
+set_file_flag(p)
+name_pointer p;
+{
+ xref_pointer q;
+ q=(xref_pointer)p->xref;
+ if (q->num==file_flag) return;
+ append_xref(file_flag);
+ xref_ptr->xlink = q;
+ p->xref = (char *)xref_ptr;
+}
+
+@ A third large area of memory is used for sixteen-bit `tokens', which appear
+in short lists similar to the strings of characters in |byte_mem|. Token lists
+are used to contain the result of \CEE/ code translated into \TEX/ form;
+further details about them will be explained later. A |text_pointer| variable
+is an index into |tok_start|.
+
+@<Typed...@>=
+typedef sixteen_bits token;
+typedef token *token_pointer;
+typedef token_pointer *text_pointer;
+
+@ The first position of |tok_mem|
+that is unoccupied by replacement text is called |tok_ptr|, and the first
+unused location of |tok_start| is called |text_ptr|.
+Thus, we usually have |*text_ptr==tok_ptr|.
+
+@<Global...@>=
+token tok_mem[max_toks]; /* tokens */
+token_pointer tok_mem_end = tok_mem+max_toks-1; /* end of |tok_mem| */
+token_pointer tok_start[max_texts]; /* directory into |tok_mem| */
+token_pointer tok_ptr; /* first unused position in |tok_mem| */
+text_pointer text_ptr; /* first unused position in |tok_start| */
+text_pointer tok_start_end = tok_start+max_texts-1; /* end of |tok_start| */
+token_pointer max_tok_ptr; /* largest value of |tok_ptr| */
+text_pointer max_text_ptr; /* largest value of |text_ptr| */
+
+@ @<Set init...@>=
+tok_ptr=tok_mem+1; text_ptr=tok_start+1; tok_start[0]=tok_mem+1;
+tok_start[1]=tok_mem+1;
+max_tok_ptr=tok_mem+1; max_text_ptr=tok_start+1;
+
+@ Here are the three procedures needed to complete |id_lookup|:
+@c
+int names_match(p,first,l,t)
+name_pointer p; /* points to the proposed match */
+char *first; /* position of first character of string */
+int l; /* length of identifier */
+eight_bits t; /* desired ilk */
+{
+ if (length(p)!=l) return 0;
+ if (p->ilk!=t && !(t==normal && abnormal(p))) return 0;
+ return !strncmp(first,p->byte_start,l);
+}
+
+void
+init_p(p,t)
+name_pointer p;
+eight_bits t;
+{
+ p->ilk=t; p->xref=(char*)xmem;
+}
+
+void
+init_node(p)
+name_pointer p;
+{
+ p->xref=(char*)xmem;
+}
+
+@ We have to get \CEE/'s
+reserved words into the hash table, and the simplest way to do this is
+to insert them every time \.{CWEAVE} is run. Fortunately there are relatively
+few reserved words. (Some of these are not strictly ``reserved,'' but
+are defined in header files of the ISO Standard \CEE/ Library.)
+@^reserved words@>
+
+@<Store all the reserved words@>=
+id_lookup("and",NULL,alfop);
+id_lookup("and_eq",NULL,alfop);
+id_lookup("asm",NULL,sizeof_like);
+id_lookup("auto",NULL,int_like);
+id_lookup("bitand",NULL,alfop);
+id_lookup("bitor",NULL,alfop);
+id_lookup("bool",NULL,raw_int);
+id_lookup("break",NULL,case_like);
+id_lookup("case",NULL,case_like);
+id_lookup("catch",NULL,catch_like);
+id_lookup("char",NULL,raw_int);
+id_lookup("class",NULL,struct_like);
+id_lookup("clock_t",NULL,raw_int);
+id_lookup("compl",NULL,alfop);
+id_lookup("const",NULL,const_like);
+id_lookup("const_cast",NULL,raw_int);
+id_lookup("continue",NULL,case_like);
+id_lookup("default",NULL,case_like);
+id_lookup("define",NULL,define_like);
+id_lookup("defined",NULL,sizeof_like);
+id_lookup("delete",NULL,delete_like);
+id_lookup("div_t",NULL,raw_int);
+id_lookup("do",NULL,do_like);
+id_lookup("double",NULL,raw_int);
+id_lookup("dynamic_cast",NULL,raw_int);
+id_lookup("elif",NULL,if_like);
+id_lookup("else",NULL,else_like);
+id_lookup("endif",NULL,if_like);
+id_lookup("enum",NULL,struct_like);
+id_lookup("error",NULL,if_like);
+id_lookup("explicit",NULL,int_like);
+id_lookup("export",NULL,int_like);
+id_lookup("extern",NULL,int_like);
+id_lookup("FILE",NULL,raw_int);
+id_lookup("float",NULL,raw_int);
+id_lookup("for",NULL,for_like);
+id_lookup("fpos_t",NULL,raw_int);
+id_lookup("friend",NULL,int_like);
+id_lookup("goto",NULL,case_like);
+id_lookup("if",NULL,if_like);
+id_lookup("ifdef",NULL,if_like);
+id_lookup("ifndef",NULL,if_like);
+id_lookup("include",NULL,if_like);
+id_lookup("inline",NULL,int_like);
+id_lookup("int",NULL,raw_int);
+id_lookup("jmp_buf",NULL,raw_int);
+id_lookup("ldiv_t",NULL,raw_int);
+id_lookup("line",NULL,if_like);
+id_lookup("long",NULL,raw_int);
+id_lookup("mutable",NULL,int_like);
+id_lookup("namespace",NULL,struct_like);
+id_lookup("new",NULL,new_like);
+id_lookup("not",NULL,alfop);
+id_lookup("not_eq",NULL,alfop);
+id_lookup("NULL",NULL,custom);
+id_lookup("offsetof",NULL,raw_int);
+id_lookup("operator",NULL,operator_like);
+id_lookup("or",NULL,alfop);
+id_lookup("or_eq",NULL,alfop);
+id_lookup("pragma",NULL,if_like);
+id_lookup("private",NULL,public_like);
+id_lookup("protected",NULL,public_like);
+id_lookup("ptrdiff_t",NULL,raw_int);
+id_lookup("public",NULL,public_like);
+id_lookup("register",NULL,int_like);
+id_lookup("reinterpret_cast",NULL,raw_int);
+id_lookup("return",NULL,case_like);
+id_lookup("short",NULL,raw_int);
+id_lookup("sig_atomic_t",NULL,raw_int);
+id_lookup("signed",NULL,raw_int);
+id_lookup("size_t",NULL,raw_int);
+id_lookup("sizeof",NULL,sizeof_like);
+id_lookup("static",NULL,int_like);
+id_lookup("static_cast",NULL,raw_int);
+id_lookup("struct",NULL,struct_like);
+id_lookup("switch",NULL,for_like);
+id_lookup("template",NULL,template_like);
+id_lookup("this",NULL,custom);
+id_lookup("throw",NULL,case_like);
+id_lookup("time_t",NULL,raw_int);
+id_lookup("try",NULL,else_like);
+id_lookup("typedef",NULL,typedef_like);
+id_lookup("typeid",NULL,raw_int);
+id_lookup("typename",NULL,struct_like);
+id_lookup("undef",NULL,if_like);
+id_lookup("union",NULL,struct_like);
+id_lookup("unsigned",NULL,raw_int);
+id_lookup("using",NULL,int_like);
+id_lookup("va_dcl",NULL,decl); /* Berkeley's variable-arg-list convention */
+id_lookup("va_list",NULL,raw_int); /* ditto */
+id_lookup("virtual",NULL,int_like);
+id_lookup("void",NULL,raw_int);
+id_lookup("volatile",NULL,const_like);
+id_lookup("wchar_t",NULL,raw_int);
+id_lookup("while",NULL,for_like);
+id_lookup("xor",NULL,alfop);
+id_lookup("xor_eq",NULL,alfop);
+res_wd_end=name_ptr;
+id_lookup("TeX",NULL,custom);
+id_lookup("make_pair",NULL,func_template);
+
+@* Lexical scanning.
+Let us now consider the subroutines that read the \.{CWEB} source file
+and break it into meaningful units. There are four such procedures:
+One simply skips to the next `\.{@@\ }' or `\.{@@*}' that begins a
+section; another passes over the \TEX/ text at the beginning of a
+section; the third passes over the \TEX/ text in a \CEE/ comment;
+and the last, which is the most interesting, gets the next token of
+a \CEE/ text. They all use the pointers |limit| and |loc| into
+the line of input currently being studied.
+
+@ Control codes in \.{CWEB}, which begin with `\.{@@}', are converted
+into a numeric code designed to simplify \.{CWEAVE}'s logic; for example,
+larger numbers are given to the control codes that denote more significant
+milestones, and the code of |new_section| should be the largest of
+all. Some of these numeric control codes take the place of |char|
+control codes that will not otherwise appear in the output of the
+scanning routines.
+@^ASCII code dependencies@>
+
+@d ignore 00 /* control code of no interest to \.{CWEAVE} */
+@d verbatim 02 /* takes the place of extended ASCII \.{\char2} */
+@d begin_short_comment 03 /* \CPLUSPLUS/ short comment */
+@d begin_comment '\t' /* tab marks will not appear */
+@d underline '\n' /* this code will be intercepted without confusion */
+@d noop 0177 /* takes the place of ASCII delete */
+@d xref_roman 0203 /* control code for `\.{@@\^}' */
+@d xref_wildcard 0204 /* control code for `\.{@@:}' */
+@d xref_typewriter 0205 /* control code for `\.{@@.}' */
+@d TeX_string 0206 /* control code for `\.{@@t}' */
+@f TeX_string TeX
+@d ord 0207 /* control code for `\.{@@'}' */
+@d join 0210 /* control code for `\.{@@\&}' */
+@d thin_space 0211 /* control code for `\.{@@,}' */
+@d math_break 0212 /* control code for `\.{@@\v}' */
+@d line_break 0213 /* control code for `\.{@@/}' */
+@d big_line_break 0214 /* control code for `\.{@@\#}' */
+@d no_line_break 0215 /* control code for `\.{@@+}' */
+@d pseudo_semi 0216 /* control code for `\.{@@;}' */
+@d macro_arg_open 0220 /* control code for `\.{@@[}' */
+@d macro_arg_close 0221 /* control code for `\.{@@]}' */
+@d trace 0222 /* control code for `\.{@@0}', `\.{@@1}' and `\.{@@2}' */
+@d translit_code 0223 /* control code for `\.{@@l}' */
+@d output_defs_code 0224 /* control code for `\.{@@h}' */
+@d format_code 0225 /* control code for `\.{@@f}' and `\.{@@s}' */
+@d definition 0226 /* control code for `\.{@@d}' */
+@d begin_C 0227 /* control code for `\.{@@c}' */
+@d section_name 0230 /* control code for `\.{@@<}' */
+@d new_section 0231 /* control code for `\.{@@\ }' and `\.{@@*}' */
+
+@ Control codes are converted to \.{CWEAVE}'s internal
+representation by means of the table |ccode|.
+
+@<Global...@>=
+eight_bits ccode[256]; /* meaning of a char following \.{@@} */
+
+@ @<Set ini...@>=
+{int c; for (c=0; c<256; c++) ccode[c]=0;}
+ccode[' ']=ccode['\t']=ccode['\n']=ccode['\v']=ccode['\r']=ccode['\f']
+ =ccode['*']=new_section;
+ccode['@@']='@@'; /* `quoted' at sign */
+ccode['=']=verbatim;
+ccode['d']=ccode['D']=definition;
+ccode['f']=ccode['F']=ccode['s']=ccode['S']=format_code;
+ccode['c']=ccode['C']=ccode['p']=ccode['P']=begin_C;
+ccode['t']=ccode['T']=TeX_string;
+ccode['l']=ccode['L']=translit_code;
+ccode['q']=ccode['Q']=noop;
+ccode['h']=ccode['H']=output_defs_code;
+ccode['&']=join; ccode['<']=ccode['(']=section_name;
+ccode['!']=underline; ccode['^']=xref_roman;
+ccode[':']=xref_wildcard; ccode['.']=xref_typewriter; ccode[',']=thin_space;
+ccode['|']=math_break; ccode['/']=line_break; ccode['#']=big_line_break;
+ccode['+']=no_line_break; ccode[';']=pseudo_semi;
+ccode['[']=macro_arg_open; ccode[']']=macro_arg_close;
+ccode['\'']=ord;
+@<Special control codes for debugging@>@;
+
+@ Users can write
+\.{@@2}, \.{@@1}, and \.{@@0} to turn tracing fully on, partly on,
+and off, respectively.
+
+@<Special control codes...@>=
+ccode['0']=ccode['1']=ccode['2']=trace;
+
+@ The |skip_limbo| routine is used on the first pass to skip through
+portions of the input that are not in any sections, i.e., that precede
+the first section. After this procedure has been called, the value of
+|input_has_ended| will tell whether or not a section has actually been found.
+
+There's a complication that we will postpone until later: If the \.{@@s}
+operation appears in limbo, we want to use it to adjust the default
+interpretation of identifiers.
+
+@<Predec...@>=
+void skip_limbo();
+
+@ @c
+void
+skip_limbo() {
+ while(1) {
+ if (loc>limit && get_line()==0) return;
+ *(limit+1)='@@';
+ while (*loc!='@@') loc++; /* look for '@@', then skip two chars */
+ if (loc++ <=limit) { int c=ccode[(eight_bits)*loc++];
+ if (c==new_section) return;
+ if (c==noop) skip_restricted();
+ else if (c==format_code) @<Process simple format in limbo@>;
+ }
+ }
+}
+
+@ The |skip_TeX| routine is used on the first pass to skip through
+the \TEX/ code at the beginning of a section. It returns the next
+control code or `\.{\v}' found in the input. A |new_section| is
+assumed to exist at the very end of the file.
+
+@f skip_TeX TeX
+
+@c
+unsigned
+skip_TeX() /* skip past pure \TEX/ code */
+{
+ while (1) {
+ if (loc>limit && get_line()==0) return(new_section);
+ *(limit+1)='@@';
+ while (*loc!='@@' && *loc!='|') loc++;
+ if (*loc++ =='|') return('|');
+ if (loc<=limit) return(ccode[(eight_bits)*(loc++)]);
+ }
+}
+
+@*1 Inputting the next token.
+As stated above, \.{CWEAVE}'s most interesting lexical scanning routine is the
+|get_next| function that inputs the next token of \CEE/ input. However,
+|get_next| is not especially complicated.
+
+The result of |get_next| is either a |char| code for some special character,
+or it is a special code representing a pair of characters (e.g., `\.{!=}'),
+or it is the numeric value computed by the |ccode|
+table, or it is one of the following special codes:
+
+\yskip\hang |identifier|: In this case the global variables |id_first| and
+|id_loc| will have been set to the beginning and ending-plus-one locations
+in the buffer, as required by the |id_lookup| routine.
+
+\yskip\hang |string|: The string will have been copied into the array
+|section_text|; |id_first| and |id_loc| are set as above (now they are
+pointers into |section_text|).
+
+\yskip\hang |constant|: The constant is copied into |section_text|, with
+slight modifications; |id_first| and |id_loc| are set.
+
+\yskip\noindent Furthermore, some of the control codes cause
+|get_next| to take additional actions:
+
+\yskip\hang |xref_roman|, |xref_wildcard|, |xref_typewriter|, |TeX_string|,
+|verbatim|: The values of |id_first| and |id_loc| will have been set to
+the beginning and ending-plus-one locations in the buffer.
+
+\yskip\hang |section_name|: In this case the global variable |cur_section| will
+point to the |byte_start| entry for the section name that has just been scanned.
+The value of |cur_section_char| will be |'('| if the section name was
+preceded by \.{@@(} instead of \.{@@<}.
+
+\yskip\noindent If |get_next| sees `\.{@@!}'
+it sets |xref_switch| to |def_flag| and goes on to the next token.
+
+@d constant 0200 /* \CEE/ constant */
+@d string 0201 /* \CEE/ string */
+@d identifier 0202 /* \CEE/ identifier or reserved word */
+
+@<Global...@>=
+name_pointer cur_section; /* name of section just scanned */
+char cur_section_char; /* the character just before that name */
+
+@ @<Include...@>=
+#include <ctype.h> /* definition of |isalpha|, |isdigit| and so on */
+#include <stdlib.h> /* definition of |exit| */
+
+@ As one might expect, |get_next| consists mostly of a big switch
+that branches to the various special cases that can arise.
+\CEE/ allows underscores to appear in identifiers, and some \CEE/
+compilers even allow the dollar sign.
+
+@d isxalpha(c) ((c)=='_' || (c)=='$')
+ /* non-alpha characters allowed in identifier */
+@d ishigh(c) ((eight_bits)(c)>0177)
+@^high-bit character handling@>
+
+@<Predecl...@>=
+eight_bits get_next();
+
+@ @c
+eight_bits
+get_next() /* produces the next input token */
+{@+eight_bits c; /* the current character */
+ while (1) {
+ @<Check if we're at the end of a preprocessor command@>;
+ if (loc>limit && get_line()==0) return(new_section);
+ c=*(loc++);
+ if (xisdigit(c) || c=='.') @<Get a constant@>@;
+ else if (c=='\'' || c=='"' || (c=='L'&&(*loc=='\'' || *loc=='"'))@|
+ || (c=='<' && sharp_include_line==1))
+ @<Get a string@>@;
+ else if (xisalpha(c) || isxalpha(c) || ishigh(c))
+ @<Get an identifier@>@;
+ else if (c=='@@') @<Get control code and possible section name@>@;
+ else if (xisspace(c)) continue; /* ignore spaces and tabs */
+ if (c=='#' && loc==buffer+1) @<Raise preprocessor flag@>;
+ mistake: @<Compress two-symbol operator@>@;
+ return(c);
+ }
+}
+
+@ Because preprocessor commands do not fit in with the rest of the syntax
+of \CEE/,
+we have to deal with them separately. One solution is to enclose such
+commands between special markers. Thus, when a \.\# is seen as the
+first character of a line, |get_next| returns a special code
+|left_preproc| and raises a flag |preprocessing|.
+
+We can use the same internal code number for |left_preproc| as we do
+for |ord|, since |get_next| changes |ord| into a string.
+
+@d left_preproc ord /* begins a preprocessor command */
+@d right_preproc 0217 /* ends a preprocessor command */
+
+@<Glob...@>=
+boolean preprocessing=0; /* are we scanning a preprocessor command? */
+
+@ @<Raise prep...@>= {
+ preprocessing=1;
+ @<Check if next token is |include|@>;
+ return (left_preproc);
+}
+
+@ An additional complication is the freakish use of \.< and \.> to delimit
+a file name in lines that start with \.{\#include}. We must treat this file
+name as a string.
+
+@<Glob...@>=
+boolean sharp_include_line=0; /* are we scanning a |#include| line? */
+
+@ @<Check if next token is |include|@>=
+while (loc<=buffer_end-7 && xisspace(*loc)) loc++;
+if (loc<=buffer_end-6 && strncmp(loc,"include",7)==0) sharp_include_line=1;
+
+@ When we get to the end of a preprocessor line,
+we lower the flag and send a code |right_preproc|, unless
+the last character was a \.\\.
+
+@<Check if we're at...@>=
+ while (loc==limit-1 && preprocessing && *loc=='\\')
+ if (get_line()==0) return(new_section); /* still in preprocessor mode */
+ if (loc>=limit && preprocessing) {
+ preprocessing=sharp_include_line=0;
+ return(right_preproc);
+ }
+
+@ The following code assigns values to the combinations \.{++},
+\.{--}, \.{->}, \.{>=}, \.{<=}, \.{==}, \.{<<}, \.{>>}, \.{!=}, \.{\v\v}, and
+\.{\&\&}, and to the \CPLUSPLUS/
+combinations \.{...}, \.{::}, \.{.*} and \.{->*}.
+The compound assignment operators (e.g., \.{+=}) are
+treated as separate tokens.
+
+@d compress(c) if (loc++<=limit) return(c)
+
+@<Compress tw...@>=
+switch(c) {
+ case '/': if (*loc=='*') {compress(begin_comment);}
+ else if (*loc=='/') compress(begin_short_comment); break;
+ case '+': if (*loc=='+') compress(plus_plus); break;
+ case '-': if (*loc=='-') {compress(minus_minus);}
+ else if (*loc=='>') if (*(loc+1)=='*') {loc++; compress(minus_gt_ast);}
+ else compress(minus_gt); break;
+ case '.': if (*loc=='*') {compress(period_ast);}
+ else if (*loc=='.' && *(loc+1)=='.') {
+ loc++; compress(dot_dot_dot);
+ }
+ break;
+ case ':': if (*loc==':') compress(colon_colon); break;
+ case '=': if (*loc=='=') compress(eq_eq); break;
+ case '>': if (*loc=='=') {compress(gt_eq);}
+ else if (*loc=='>') compress(gt_gt); break;
+ case '<': if (*loc=='=') {compress(lt_eq);}
+ else if (*loc=='<') compress(lt_lt); break;
+ case '&': if (*loc=='&') compress(and_and); break;
+ case '|': if (*loc=='|') compress(or_or); break;
+ case '!': if (*loc=='=') compress(not_eq); break;
+}
+
+@ @<Get an identifier@>= {
+ id_first=--loc;
+ while (isalpha(*++loc) || isdigit(*loc) || isxalpha(*loc) || ishigh(*loc));
+ id_loc=loc; return(identifier);
+}
+
+@ Different conventions are followed by \TEX/ and \CEE/ to express octal
+and hexadecimal numbers; it is reasonable to stick to each convention
+within its realm. Thus the \CEE/ part of a \.{CWEB} file has octals
+introduced by \.0 and hexadecimals by \.{0x}, but \.{CWEAVE} will print
+with \TEX/ macros that the user can redefine to fit the context.
+In order to simplify such macros, we replace some of the characters.
+
+Notice that in this section and the next, |id_first| and |id_loc|
+are pointers into the array |section_text|, not into |buffer|.
+
+@<Get a constant@>= {
+ id_first=id_loc=section_text+1;
+ if (*(loc-1)=='0') {
+ if (*loc=='x' || *loc=='X') {*id_loc++='^'; loc++;
+ while (xisxdigit(*loc)) *id_loc++=*loc++;} /* hex constant */
+ else if (xisdigit(*loc)) {*id_loc++='~';
+ while (xisdigit(*loc)) *id_loc++=*loc++;} /* octal constant */
+ else goto dec; /* decimal constant */
+ }
+ else { /* decimal constant */
+ if (*(loc-1)=='.' && !xisdigit(*loc)) goto mistake; /* not a constant */
+ dec: *id_loc++=*(loc-1);
+ while (xisdigit(*loc) || *loc=='.') *id_loc++=*loc++;
+ if (*loc=='e' || *loc=='E') { /* float constant */
+ *id_loc++='_'; loc++;
+ if (*loc=='+' || *loc=='-') *id_loc++=*loc++;
+ while (xisdigit(*loc)) *id_loc++=*loc++;
+ }
+ }
+ while (*loc=='u' || *loc=='U' || *loc=='l' || *loc=='L'
+ || *loc=='f' || *loc=='F') {
+ *id_loc++='$'; *id_loc++=toupper(*loc); loc++;
+ }
+ return(constant);
+}
+
+@ \CEE/ strings and character constants, delimited by double and single
+quotes, respectively, can contain newlines or instances of their own
+delimiters if they are protected by a backslash. We follow this
+convention, but do not allow the string to be longer than |longest_name|.
+
+@<Get a string@>= {
+ char delim = c; /* what started the string */
+ id_first = section_text+1;
+ id_loc = section_text;
+ if (delim=='\'' && *(loc-2)=='@@') {*++id_loc='@@'; *++id_loc='@@';}
+ *++id_loc=delim;
+ if (delim=='L') { /* wide character constant */
+ delim=*loc++; *++id_loc=delim;
+ }
+ if (delim=='<') delim='>'; /* for file names in |#include| lines */
+ while (1) {
+ if (loc>=limit) {
+ if(*(limit-1)!='\\') {
+ err_print("! String didn't end"); loc=limit; break;
+@.String didn't end@>
+ }
+ if(get_line()==0) {
+ err_print("! Input ended in middle of string"); loc=buffer; break;
+@.Input ended in middle of string@>
+ }
+ }
+ if ((c=*loc++)==delim) {
+ if (++id_loc<=section_text_end) *id_loc=c;
+ break;
+ }
+ if (c=='\\') if (loc>=limit) continue;
+ else if (++id_loc<=section_text_end) {
+ *id_loc = '\\'; c=*loc++;
+ }
+ if (++id_loc<=section_text_end) *id_loc=c;
+ }
+ if (id_loc>=section_text_end) {
+ printf("\n! String too long: ");
+@.String too long@>
+ term_write(section_text+1,25);
+ printf("..."); mark_error;
+ }
+ id_loc++;
+ return(string);
+}
+
+@ After an \.{@@} sign has been scanned, the next character tells us
+whether there is more work to do.
+
+@<Get control code and possible section name@>= {
+ c=*loc++;
+ switch(ccode[(eight_bits)c]) {
+ case translit_code: err_print("! Use @@l in limbo only"); continue;
+@.Use @@l in limbo...@>
+ case underline: xref_switch=def_flag; continue;
+ case trace: tracing=c-'0'; continue;
+ case xref_roman: case xref_wildcard: case xref_typewriter:
+ case noop: case TeX_string: c=ccode[c]; skip_restricted(); return(c);
+ case section_name:
+ @<Scan the section name and make |cur_section| point to it@>;
+ case verbatim: @<Scan a verbatim string@>;
+ case ord: @<Get a string@>;
+ default: return(ccode[(eight_bits)c]);
+ }
+}
+
+@ The occurrence of a section name sets |xref_switch| to zero,
+because the section name might (for example) follow \&{int}.
+
+@<Scan the section name...@>= {
+ char *k; /* pointer into |section_text| */
+ cur_section_char=*(loc-1);
+ @<Put section name into |section_text|@>;
+ if (k-section_text>3 && strncmp(k-2,"...",3)==0)
+ cur_section=section_lookup(section_text+1,k-3,1); /* 1 indicates a prefix */
+ else cur_section=section_lookup(section_text+1,k,0);
+ xref_switch=0; return(section_name);
+}
+
+@ Section names are placed into the |section_text| array with consecutive spaces,
+tabs, and carriage-returns replaced by single spaces. There will be no
+spaces at the beginning or the end. (We set |section_text[0]=' '| to facilitate
+this, since the |section_lookup| routine uses |section_text[1]| as the first
+character of the name.)
+
+@<Set init...@>=section_text[0]=' ';
+
+@ @<Put section name...@>=
+k=section_text;
+while (1) {
+ if (loc>limit && get_line()==0) {
+ err_print("! Input ended in section name");
+@.Input ended in section name@>
+ loc=buffer+1; break;
+ }
+ c=*loc;
+ @<If end of name or erroneous control code, |break|@>;
+ loc++; if (k<section_text_end) k++;
+ if (xisspace(c)) {
+ c=' '; if (*(k-1)==' ') k--;
+ }
+*k=c;
+}
+if (k>=section_text_end) {
+ printf("\n! Section name too long: ");
+@.Section name too long@>
+ term_write(section_text+1,25);
+ printf("..."); mark_harmless;
+}
+if (*k==' ' && k>section_text) k--;
+
+@ @<If end of name...@>=
+if (c=='@@') {
+ c=*(loc+1);
+ if (c=='>') {
+ loc+=2; break;
+ }
+ if (ccode[(eight_bits)c]==new_section) {
+ err_print("! Section name didn't end"); break;
+@.Section name didn't end@>
+ }
+ if (c!='@@') {
+ err_print("! Control codes are forbidden in section name"); break;
+@.Control codes are forbidden...@>
+ }
+ *(++k)='@@'; loc++; /* now |c==*loc| again */
+}
+
+@ This function skips over a restricted context at relatively high speed.
+
+@<Predecl...@>=
+void skip_restricted();
+
+@ @c
+void
+skip_restricted()
+{
+ id_first=loc; *(limit+1)='@@';
+false_alarm:
+ while (*loc!='@@') loc++;
+ id_loc=loc;
+ if (loc++>limit) {
+ err_print("! Control text didn't end"); loc=limit;
+@.Control text didn't end@>
+ }
+ else {
+ if (*loc=='@@'&&loc<=limit) {loc++; goto false_alarm;}
+ if (*loc++!='>')
+ err_print("! Control codes are forbidden in control text");
+@.Control codes are forbidden...@>
+ }
+}
+
+@ At the present point in the program we
+have |*(loc-1)==verbatim|; we set |id_first| to the beginning
+of the string itself, and |id_loc| to its ending-plus-one location in the
+buffer. We also set |loc| to the position just after the ending delimiter.
+
+@<Scan a verbatim string@>= {
+ id_first=loc++; *(limit+1)='@@'; *(limit+2)='>';
+ while (*loc!='@@' || *(loc+1)!='>') loc++;
+ if (loc>=limit) err_print("! Verbatim string didn't end");
+@.Verbatim string didn't end@>
+ id_loc=loc; loc+=2;
+ return (verbatim);
+}
+
+@** Phase one processing.
+We now have accumulated enough subroutines to make it possible to carry out
+\.{CWEAVE}'s first pass over the source file. If everything works right,
+both phase one and phase two of \.{CWEAVE} will assign the same numbers to
+sections, and these numbers will agree with what \.{CTANGLE} does.
+
+The global variable |next_control| often contains the most recent output of
+|get_next|; in interesting cases, this will be the control code that
+ended a section or part of a section.
+
+@<Global...@>=
+eight_bits next_control; /* control code waiting to be acting upon */
+
+@ The overall processing strategy in phase one has the following
+straightforward outline.
+
+@<Predecl...@>=
+void phase_one();
+
+@ @c
+void
+phase_one() {
+ phase=1; reset_input(); section_count=0;
+ skip_limbo(); change_exists=0;
+ while (!input_has_ended)
+ @<Store cross-reference data for the current section@>;
+ changed_section[section_count]=change_exists;
+ /* the index changes if anything does */
+ phase=2; /* prepare for second phase */
+ @<Print error messages about unused or undefined section names@>;
+}
+
+@ @<Store cross-reference data...@>=
+{
+ if (++section_count==max_sections) overflow("section number");
+ changed_section[section_count]=changing;
+ /* it will become 1 if any line changes */
+ if (*(loc-1)=='*' && show_progress) {
+ printf("*%d",section_count);
+ update_terminal; /* print a progress report */
+ }
+ @<Store cross-references in the \TEX/ part of a section@>;
+ @<Store cross-references in the definition part of a section@>;
+ @<Store cross-references in the \CEE/ part of a section@>;
+ if (changed_section[section_count]) change_exists=1;
+}
+
+@ The |C_xref| subroutine stores references to identifiers in
+\CEE/ text material beginning with the current value of |next_control|
+and continuing until |next_control| is `\.\{' or `\.{\v}', or until the next
+``milestone'' is passed (i.e., |next_control>=format_code|). If
+|next_control>=format_code| when |C_xref| is called, nothing will happen;
+but if |next_control=='|'| upon entry, the procedure assumes that this is
+the `\.{\v}' preceding \CEE/ text that is to be processed.
+
+The parameter |spec_ctrl| is used to change this behavior. In most cases
+|C_xref| is called with |spec_ctrl==ignore|, which triggers the default
+processing described above. If |spec_ctrl==section_name|, section names will
+be gobbled. This is used when \CEE/ text in the \TEX/ part or inside comments
+is parsed: It allows for section names to appear in \pb, but these
+strings will not be entered into the cross reference lists since they are not
+definitions of section names.
+
+The program uses the fact that our internal code numbers satisfy
+the relations |xref_roman==identifier+roman| and |xref_wildcard==identifier
++wildcard| and |xref_typewriter==identifier+typewriter|,
+as well as |normal==0|.
+
+@<Predecl...@>=
+void C_xref();
+
+@ @c
+void
+C_xref( spec_ctrl ) /* makes cross-references for \CEE/ identifiers */
+ eight_bits spec_ctrl;
+{
+ name_pointer p; /* a referenced name */
+ while (next_control<format_code || next_control==spec_ctrl) {
+ if (next_control>=identifier && next_control<=xref_typewriter) {
+ if (next_control>identifier) @<Replace |"@@@@"| by |"@@"| @>@;
+ p=id_lookup(id_first, id_loc,next_control-identifier); new_xref(p);
+ }
+ if (next_control==section_name) {
+ section_xref_switch=cite_flag;
+ new_section_xref(cur_section);
+ }
+ next_control=get_next();
+ if (next_control=='|' || next_control==begin_comment ||
+ next_control==begin_short_comment) return;
+ }
+}
+
+@ The |outer_xref| subroutine is like |C_xref| except that it begins
+with |next_control!='|'| and ends with |next_control>=format_code|. Thus, it
+handles \CEE/ text with embedded comments.
+
+@<Predecl...@>=
+void outer_xref();
+
+@ @c
+void
+outer_xref() /* extension of |C_xref| */
+{
+ int bal; /* brace level in comment */
+ while (next_control<format_code)
+ if (next_control!=begin_comment && next_control!=begin_short_comment)
+ C_xref(ignore);
+ else {
+ boolean is_long_comment=(next_control==begin_comment);
+ bal=copy_comment(is_long_comment,1); next_control='|';
+ while (bal>0) {
+ C_xref(section_name); /* do not reference section names in comments */
+ if (next_control=='|') bal=copy_comment(is_long_comment,bal);
+ else bal=0; /* an error message will occur in phase two */
+ }
+ }
+}
+
+@ In the \TEX/ part of a section, cross-reference entries are made only for
+the identifiers in \CEE/ texts enclosed in \pb, or for control texts
+enclosed in \.{@@\^}$\,\ldots\,$\.{@@>} or \.{@@.}$\,\ldots\,$\.{@@>}
+or \.{@@:}$\,\ldots\,$\.{@@>}.
+
+@<Store cross-references in the \T...@>=
+while (1) {
+ switch (next_control=skip_TeX()) {
+ case translit_code: err_print("! Use @@l in limbo only"); continue;
+@.Use @@l in limbo...@>
+ case underline: xref_switch=def_flag; continue;
+ case trace: tracing=*(loc-1)-'0'; continue;
+ case '|': C_xref(section_name); break;
+ case xref_roman: case xref_wildcard: case xref_typewriter:
+ case noop: case section_name:
+ loc-=2; next_control=get_next(); /* scan to \.{@@>} */
+ if (next_control>=xref_roman && next_control<=xref_typewriter) {
+ @<Replace |"@@@@"| by |"@@"| @>@;
+ new_xref(id_lookup(id_first, id_loc,next_control-identifier));
+ }
+ break;
+ }
+ if (next_control>=format_code) break;
+}
+
+@ @<Replace |"@@@@"| by |"@@"| @>=
+{
+ char *src=id_first,*dst=id_first;
+ while(src<id_loc){
+ if(*src=='@@') src++;
+ *dst++=*src++;
+ }
+ id_loc=dst;
+ while (dst<src) *dst++=' '; /* clean up in case of error message display */
+}
+
+@ During the definition and \CEE/ parts of a section, cross-references
+are made for all identifiers except reserved words. However, the right
+identifier in a format definition is not referenced, and the left
+identifier is referenced only if it has been explicitly
+underlined (preceded by \.{@@!}).
+The \TEX/ code in comments is, of course, ignored, except for
+\CEE/ portions enclosed in \pb; the text of a section name is skipped
+entirely, even if it contains \pb\ constructions.
+
+The variables |lhs| and |rhs| point to the respective identifiers involved
+in a format definition.
+
+@<Global...@>=
+name_pointer lhs, rhs; /* pointers to |byte_start| for format identifiers */
+name_pointer res_wd_end; /* pointer to the first nonreserved identifier */
+
+@ When we get to the following code we have |next_control>=format_code|.
+
+@<Store cross-references in the d...@>=
+while (next_control<=definition) { /* |format_code| or |definition| */
+ if (next_control==definition) {
+ xref_switch=def_flag; /* implied \.{@@!} */
+ next_control=get_next();
+ } else @<Process a format definition@>;
+ outer_xref();
+}
+
+@ Error messages for improper format definitions will be issued in phase
+two. Our job in phase one is to define the |ilk| of a properly formatted
+identifier, and to remove cross-references to identifiers that we now
+discover should be unindexed.
+
+@<Process a form...@>= {
+ next_control=get_next();
+ if (next_control==identifier) {
+ lhs=id_lookup(id_first, id_loc,normal); lhs->ilk=normal;
+ if (xref_switch) new_xref(lhs);
+ next_control=get_next();
+ if (next_control==identifier) {
+ rhs=id_lookup(id_first, id_loc,normal);
+ lhs->ilk=rhs->ilk;
+ if (unindexed(lhs)) { /* retain only underlined entries */
+ xref_pointer q,r=NULL;
+ for (q=(xref_pointer)lhs->xref;q>xmem;q=q->xlink)
+ if (q->num<def_flag)
+ if (r) r->xlink=q->xlink;
+ else lhs->xref=(char*)q->xlink;
+ else r=q;
+ }
+ next_control=get_next();
+ }
+ }
+}
+
+@ A much simpler processing of format definitions occurs when the
+definition is found in limbo.
+
+@<Process simple format in limbo@>=
+{
+ if (get_next()!=identifier)
+ err_print("! Missing left identifier of @@s");
+@.Missing left identifier...@>
+ else {
+ lhs=id_lookup(id_first,id_loc,normal);
+ if (get_next()!=identifier)
+ err_print("! Missing right identifier of @@s");
+@.Missing right identifier...@>
+ else {
+ rhs=id_lookup(id_first,id_loc,normal);
+ lhs->ilk=rhs->ilk;
+ }
+ }
+}
+
+@ Finally, when the \TEX/ and definition parts have been treated, we have
+|next_control>=begin_C|.
+
+@<Store cross-references in the \CEE/...@>=
+if (next_control<=section_name) { /* |begin_C| or |section_name| */
+ if (next_control==begin_C) section_xref_switch=0;
+ else {
+ section_xref_switch=def_flag;
+ if(cur_section_char=='(' && cur_section!=name_dir)
+ set_file_flag(cur_section);
+ }
+ do {
+ if (next_control==section_name && cur_section!=name_dir)
+ new_section_xref(cur_section);
+ next_control=get_next(); outer_xref();
+ } while ( next_control<=section_name);
+}
+
+@ After phase one has looked at everything, we want to check that each
+section name was both defined and used. The variable |cur_xref| will point
+to cross-references for the current section name of interest.
+
+@<Global...@>=
+xref_pointer cur_xref; /* temporary cross-reference pointer */
+boolean an_output; /* did |file_flag| precede |cur_xref|? */
+
+@ The following recursive procedure
+walks through the tree of section names and prints out anomalies.
+@^recursion@>
+
+@<Predecl...@>=
+void section_check();
+
+@ @c
+void
+section_check(p)
+name_pointer p; /* print anomalies in subtree |p| */
+{
+ if (p) {
+ section_check(p->llink);
+ cur_xref=(xref_pointer)p->xref;
+ if (cur_xref->num==file_flag) {an_output=1; cur_xref=cur_xref->xlink;}
+ else an_output=0;
+ if (cur_xref->num <def_flag) {
+ printf("\n! Never defined: <"); print_section_name(p); putchar('>'); mark_harmless;
+@.Never defined: <section name>@>
+ }
+ while (cur_xref->num >=cite_flag) cur_xref=cur_xref->xlink;
+ if (cur_xref==xmem && !an_output) {
+ printf("\n! Never used: <"); print_section_name(p); putchar('>'); mark_harmless;
+@.Never used: <section name>@>
+ }
+ section_check(p->rlink);
+ }
+}
+
+@ @<Print error messages about un...@>=section_check(root)
+
+@* Low-level output routines.
+The \TEX/ output is supposed to appear in lines at most |line_length|
+characters long, so we place it into an output buffer. During the output
+process, |out_line| will hold the current line number of the line about to
+be output.
+
+@<Global...@>=
+char out_buf[line_length+1]; /* assembled characters */
+char *out_ptr; /* just after last character in |out_buf| */
+char *out_buf_end = out_buf+line_length; /* end of |out_buf| */
+int out_line; /* number of next line to be output */
+
+@ The |flush_buffer| routine empties the buffer up to a given breakpoint,
+and moves any remaining characters to the beginning of the next line.
+If the |per_cent| parameter is 1 a |'%'| is appended to the line
+that is being output; in this case the breakpoint |b| should be strictly
+less than |out_buf_end|. If the |per_cent| parameter is |0|,
+trailing blanks are suppressed.
+The characters emptied from the buffer form a new line of output;
+if the |carryover| parameter is true, a |"%"| in that line will be
+carried over to the next line (so that \TEX/ will ignore the completion
+of commented-out text).
+
+@d c_line_write(c) fflush(active_file),fwrite(out_buf+1,sizeof(char),c,active_file)
+@d tex_putc(c) putc(c,active_file)
+@d tex_new_line putc('\n',active_file)
+@d tex_printf(c) fprintf(active_file,c)
+
+@c
+void
+flush_buffer(b,per_cent,carryover)
+char *b; /* outputs from |out_buf+1| to |b|,where |b<=out_ptr| */
+boolean per_cent,carryover;
+{
+ char *j; j=b; /* pointer into |out_buf| */
+ if (! per_cent) /* remove trailing blanks */
+ while (j>out_buf && *j==' ') j--;
+ c_line_write(j-out_buf);
+ if (per_cent) tex_putc('%');
+ tex_new_line; out_line++;
+ if (carryover)
+ while (j>out_buf)
+ if (*j--=='%' && (j==out_buf || *j!='\\')) {
+ *b--='%'; break;
+ }
+ if (b<out_ptr) strncpy(out_buf+1,b+1,out_ptr-b);
+ out_ptr-=b-out_buf;
+}
+
+@ When we are copying \TEX/ source material, we retain line breaks
+that occur in the input, except that an empty line is not
+output when the \TEX/ source line was nonempty. For example, a line
+of the \TEX/ file that contains only an index cross-reference entry
+will not be copied. The |finish_line| routine is called just before
+|get_line| inputs a new line, and just after a line break token has
+been emitted during the output of translated \CEE/ text.
+
+@c
+void
+finish_line() /* do this at the end of a line */
+{
+ char *k; /* pointer into |buffer| */
+ if (out_ptr>out_buf) flush_buffer(out_ptr,0,0);
+ else {
+ for (k=buffer; k<=limit; k++)
+ if (!(xisspace(*k))) return;
+ flush_buffer(out_buf,0,0);
+ }
+}
+
+@ In particular, the |finish_line| procedure is called near the very
+beginning of phase two. We initialize the output variables in a slightly
+tricky way so that the first line of the output file will be
+`\.{\\input cwebmac}'.
+
+@<Set init...@>=
+out_ptr=out_buf+1; out_line=1; active_file=tex_file;
+*out_ptr='c'; tex_printf("\\input cwebma");
+
+@ When we wish to append one character |c| to the output buffer, we write
+`|out(c)|'; this will cause the buffer to be emptied if it was already
+full. If we want to append more than one character at once, we say
+|out_str(s)|, where |s| is a string containing the characters.
+
+A line break will occur at a space or after a single-nonletter
+\TEX/ control sequence.
+
+@d out(c) {if (out_ptr>=out_buf_end) break_out(); *(++out_ptr)=c;}
+
+@c
+void
+out_str(s) /* output characters from |s| to end of string */
+char *s;
+{
+ while (*s) out(*s++);
+}
+
+@ The |break_out| routine is called just before the output buffer is about
+to overflow. To make this routine a little faster, we initialize position
+0 of the output buffer to `\.\\'; this character isn't really output.
+
+@<Set init...@>=
+out_buf[0]='\\';
+
+@ A long line is broken at a blank space or just before a backslash that isn't
+preceded by another backslash. In the latter case, a |'%'| is output at
+the break.
+
+@<Predecl...@>=
+void break_out();
+
+@ @c
+void
+break_out() /* finds a way to break the output line */
+{
+ char *k=out_ptr; /* pointer into |out_buf| */
+ while (1) {
+ if (k==out_buf) @<Print warning message, break the line, |return|@>;
+ if (*k==' ') {
+ flush_buffer(k,0,1); return;
+ }
+ if (*(k--)=='\\' && *k!='\\') { /* we've decreased |k| */
+ flush_buffer(k,1,1); return;
+ }
+ }
+}
+
+@ We get to this section only in the unusual case that the entire output line
+consists of a string of backslashes followed by a string of nonblank
+non-backslashes. In such cases it is almost always safe to break the
+line by putting a |'%'| just before the last character.
+
+@<Print warning message...@>=
+{
+ printf("\n! Line had to be broken (output l. %d):\n",out_line);
+@.Line had to be broken@>
+ term_write(out_buf+1, out_ptr-out_buf-1);
+ new_line; mark_harmless;
+ flush_buffer(out_ptr-1,1,1); return;
+}
+
+@ Here is a macro that outputs a section number in decimal notation.
+The number to be converted by |out_section| is known to be less than
+|def_flag|, so it cannot have more than five decimal digits. If
+the section is changed, we output `\.{\\*}' just after the number.
+
+@c
+void
+out_section(n)
+sixteen_bits n;
+{
+ char s[6];
+ sprintf(s,"%d",n); out_str(s);
+ if(changed_section[n]) out_str ("\\*");
+@.\\*@>
+}
+
+@ The |out_name| procedure is used to output an identifier or index
+entry, enclosing it in braces.
+
+@c
+void
+out_name(p,quote_xalpha)
+name_pointer p;
+boolean quote_xalpha;
+{
+ char *k, *k_end=(p+1)->byte_start; /* pointers into |byte_mem| */
+ out('{');
+ for (k=p->byte_start; k<k_end; k++) {
+ if (isxalpha(*k) && quote_xalpha) out('\\');
+@.\\\$@>
+@.\\\_@>
+ out(*k);
+ }
+ out('}');
+}
+
+@* Routines that copy \TEX/ material.
+During phase two, we use subroutines |copy_limbo|, |copy_TeX|, and
+|copy_comment| in place of the analogous |skip_limbo|, |skip_TeX|, and
+|skip_comment| that were used in phase one. (Well, |copy_comment|
+was actually written in such a way that it functions as |skip_comment|
+in phase one.)
+
+The |copy_limbo| routine, for example, takes \TEX/ material that is not
+part of any section and transcribes it almost verbatim to the output file.
+The use of `\.{@@}' signs is severely restricted in such material:
+`\.{@@@@}' pairs are replaced by singletons; `\.{@@l}' and `\.{@@q}' and
+`\.{@@s}' are interpreted.
+
+@c
+void
+copy_limbo()
+{
+ char c;
+ while (1) {
+ if (loc>limit && (finish_line(), get_line()==0)) return;
+ *(limit+1)='@@';
+ while (*loc!='@@') out(*(loc++));
+ if (loc++<=limit) {
+ c=*loc++;
+ if (ccode[(eight_bits)c]==new_section) break;
+ switch (ccode[(eight_bits)c]) {
+ case translit_code: out_str("\\ATL"); break;
+@.\\ATL@>
+ case '@@': out('@@'); break;
+ case noop: skip_restricted(); break;
+ case format_code: if (get_next()==identifier) get_next();
+ if (loc>=limit) get_line(); /* avoid blank lines in output */
+ break; /* the operands of \.{@@s} are ignored on this pass */
+ default: err_print("! Double @@ should be used in limbo");
+@.Double @@ should be used...@>
+ out('@@');
+ }
+ }
+ }
+}
+
+@ The |copy_TeX| routine processes the \TEX/ code at the beginning of a
+section; for example, the words you are now reading were copied in this
+way. It returns the next control code or `\.{\v}' found in the input.
+We don't copy spaces or tab marks into the beginning of a line. This
+makes the test for empty lines in |finish_line| work.
+
+@ @f copy_TeX TeX
+@c
+eight_bits
+copy_TeX()
+{
+ char c; /* current character being copied */
+ while (1) {
+ if (loc>limit && (finish_line(), get_line()==0)) return(new_section);
+ *(limit+1)='@@';
+ while ((c=*(loc++))!='|' && c!='@@') {
+ out(c);
+ if (out_ptr==out_buf+1 && (xisspace(c))) out_ptr--;
+ }
+ if (c=='|') return('|');
+ if (loc<=limit) return(ccode[(eight_bits)*(loc++)]);
+ }
+}
+
+@ The |copy_comment| function issues a warning if more braces are opened than
+closed, and in the case of a more serious error it supplies enough
+braces to keep \TEX/ from complaining about unbalanced braces.
+Instead of copying the \TEX/ material
+into the output buffer, this function copies it into the token memory
+(in phase two only).
+The abbreviation |app_tok(t)| is used to append token |t| to the current
+token list, and it also makes sure that it is possible to append at least
+one further token without overflow.
+
+@d app_tok(c) {if (tok_ptr+2>tok_mem_end) overflow("token"); *(tok_ptr++)=c;}
+
+@<Predec...@>=
+int copy_comment();
+
+@ @c
+int copy_comment(is_long_comment,bal) /* copies \TEX/ code in comments */
+boolean is_long_comment; /* is this a traditional \CEE/ comment? */
+int bal; /* brace balance */
+{
+ char c; /* current character being copied */
+ while (1) {
+ if (loc>limit) {
+ if (is_long_comment) {
+ if (get_line()==0) {
+ err_print("! Input ended in mid-comment");
+@.Input ended in mid-comment@>
+ loc=buffer+1; goto done;
+ }
+ }
+ else {
+ if (bal>1) err_print("! Missing } in comment");
+@.Missing \} in comment@>
+ goto done;
+ }
+ }
+ c=*(loc++);
+ if (c=='|') return(bal);
+ if (is_long_comment) @<Check for end of comment@>;
+ if (phase==2) {
+ if (ishigh(c)) app_tok(quoted_char);
+ app_tok(c);
+ }
+ @<Copy special things when |c=='@@', '\\'|@>;
+ if (c=='{') bal++;
+ else if (c=='}') {
+ if(bal>1) bal--;
+ else {err_print("! Extra } in comment");
+@.Extra \} in comment@>
+ if (phase==2) tok_ptr--;
+ }
+ }
+ }
+done:@<Clear |bal| and |return|@>;
+}
+
+@ @<Check for end of comment@>=
+if (c=='*' && *loc=='/') {
+ loc++;
+ if (bal>1) err_print("! Missing } in comment");
+@.Missing \} in comment@>
+ goto done;
+}
+
+@ @<Copy special things when |c=='@@'...@>=
+if (c=='@@') {
+ if (*(loc++)!='@@') {
+ err_print("! Illegal use of @@ in comment");
+@.Illegal use of @@...@>
+ loc-=2; if (phase==2) *(tok_ptr-1)=' '; goto done;
+ }
+}
+else if (c=='\\' && *loc!='@@')
+ if (phase==2) app_tok(*(loc++)) else loc++;
+
+@ We output
+enough right braces to keep \TEX/ happy.
+
+@<Clear |bal|...@>=
+if (phase==2) while (bal-- >0) app_tok('}');
+return(0);
+
+@** Parsing.
+The most intricate part of \.{CWEAVE} is its mechanism for converting
+\CEE/-like code into \TEX/ code, and we might as well plunge into this
+aspect of the program now. A ``bottom up'' approach is used to parse the
+\CEE/-like material, since \.{CWEAVE} must deal with fragmentary
+constructions whose overall ``part of speech'' is not known.
+
+At the lowest level, the input is represented as a sequence of entities
+that we shall call {\it scraps}, where each scrap of information consists
+of two parts, its {\it category} and its {\it translation}. The category
+is essentially a syntactic class, and the translation is a token list that
+represents \TEX/ code. Rules of syntax and semantics tell us how to
+combine adjacent scraps into larger ones, and if we are lucky an entire
+\CEE/ text that starts out as hundreds of small scraps will join
+together into one gigantic scrap whose translation is the desired \TEX/
+code. If we are unlucky, we will be left with several scraps that don't
+combine; their translations will simply be output, one by one.
+
+The combination rules are given as context-sensitive productions that are
+applied from left to right. Suppose that we are currently working on the
+sequence of scraps $s_1\,s_2\ldots s_n$. We try first to find the longest
+production that applies to an initial substring $s_1\,s_2\ldots\,$; but if
+no such productions exist, we try to find the longest production
+applicable to the next substring $s_2\,s_3\ldots\,$; and if that fails, we
+try to match $s_3\,s_4\ldots\,$, etc.
+
+A production applies if the category codes have a given pattern. For
+example, one of the productions (see rule~3) is
+$$\hbox{|exp| }\left\{\matrix{\hbox{|binop|}\cr\hbox{|ubinop|}}\right\}
+\hbox{ |exp| }\RA\hbox{ |exp|}$$
+and it means that three consecutive scraps whose respective categories are
+|exp|, |binop| (or |ubinop|),
+and |exp| are converted to one scrap whose category
+is |exp|. The translations of the original
+scraps are simply concatenated. The case of
+$$\hbox{|exp| |comma| |exp| $\RA$ |exp|} \hskip4emE_1C\,\\{opt}9\,E_2$$
+(rule 4) is only slightly more complicated:
+Here the resulting |exp| translation
+consists not only of the three original translations, but also of the
+tokens |opt| and 9 between the translations of the
+|comma| and the following |exp|.
+In the \TEX/ file, this will specify an optional line break after the
+comma, with penalty 90.
+
+At each opportunity the longest possible production is applied. For
+example, if the current sequence of scraps is |int_like| |cast|
+|lbrace|, rule 31 is applied; but if the sequence is |int_like| |cast|
+followed by anything other than |lbrace|, rule 32 takes effect.
+
+Translation rules such as `$E_1C\,\\{opt}9\,E_2$' above use subscripts
+to distinguish between translations of scraps whose categories have the
+same initial letter; these subscripts are assigned from left to right.
+
+@ Here is a list of the category codes that scraps can have.
+(A few others, like |int_like|, have already been defined; the
+|cat_name| array contains a complete list.)
+
+@d exp 1 /* denotes an expression, including perhaps a single identifier */
+@d unop 2 /* denotes a unary operator */
+@d binop 3 /* denotes a binary operator */
+@d ubinop 4
+ /* denotes an operator that can be unary or binary, depending on context */
+@d cast 5 /* denotes a cast */
+@d question 6 /* denotes a question mark and possibly the expressions flanking it */
+@d lbrace 7 /* denotes a left brace */
+@d rbrace 8 /* denotes a right brace */
+@d decl_head 9 /* denotes an incomplete declaration */
+@d comma 10 /* denotes a comma */
+@d lpar 11 /* denotes a left parenthesis or left bracket */
+@d rpar 12 /* denotes a right parenthesis or right bracket */
+@d prelangle 13 /* denotes `$<$' before we know what it is */
+@d prerangle 14 /* denotes `$>$' before we know what it is */
+@d langle 15 /* denotes `$<$' when it's used as angle bracket in a template */
+@d colcol 18 /* denotes `::' */
+@d base 19 /* denotes a colon that introduces a base specifier */
+@d decl 20 /* denotes a complete declaration */
+@d struct_head 21 /* denotes the beginning of a structure specifier */
+@d stmt 23 /* denotes a complete statement */
+@d function 24 /* denotes a complete function */
+@d fn_decl 25 /* denotes a function declarator */
+@d semi 27 /* denotes a semicolon */
+@d colon 28 /* denotes a colon */
+@d tag 29 /* denotes a statement label */
+@d if_head 30 /* denotes the beginning of a compound conditional */
+@d else_head 31 /* denotes a prefix for a compound statement */
+@d if_clause 32 /* pending \.{if} together with a condition */
+@d lproc 35 /* begins a preprocessor command */
+@d rproc 36 /* ends a preprocessor command */
+@d insert 37 /* a scrap that gets combined with its neighbor */
+@d section_scrap 38 /* section name */
+@d dead 39 /* scrap that won't combine */
+@d ftemplate 59 /* \\{make\_pair} */
+@d new_exp 60 /* \&{new} and a following type identifier */
+@d begin_arg 61 /* \.{@@[} */
+@d end_arg 62 /* \.{@@]} */
+
+@<Glo...@>=
+char cat_name[256][12];
+eight_bits cat_index;
+
+@ @<Set in...@>=
+ for (cat_index=0;cat_index<255;cat_index++)
+ strcpy(cat_name[cat_index],"UNKNOWN");
+@.UNKNOWN@>
+ strcpy(cat_name[exp],"exp");
+ strcpy(cat_name[unop],"unop");
+ strcpy(cat_name[binop],"binop");
+ strcpy(cat_name[ubinop],"ubinop");
+ strcpy(cat_name[cast],"cast");
+ strcpy(cat_name[question],"?");
+ strcpy(cat_name[lbrace],"{"@q}@>);
+ strcpy(cat_name[rbrace],@q{@>"}");
+ strcpy(cat_name[decl_head],"decl_head");
+ strcpy(cat_name[comma],",");
+ strcpy(cat_name[lpar],"(");
+ strcpy(cat_name[rpar],")");
+ strcpy(cat_name[prelangle],"<");
+ strcpy(cat_name[prerangle],">");
+ strcpy(cat_name[langle],"\\<");
+ strcpy(cat_name[colcol],"::");
+ strcpy(cat_name[base],"\\:");
+ strcpy(cat_name[decl],"decl");
+ strcpy(cat_name[struct_head],"struct_head");
+ strcpy(cat_name[alfop],"alfop");
+ strcpy(cat_name[stmt],"stmt");
+ strcpy(cat_name[function],"function");
+ strcpy(cat_name[fn_decl],"fn_decl");
+ strcpy(cat_name[else_like],"else_like");
+ strcpy(cat_name[semi],";");
+ strcpy(cat_name[colon],":");
+ strcpy(cat_name[tag],"tag");
+ strcpy(cat_name[if_head],"if_head");
+ strcpy(cat_name[else_head],"else_head");
+ strcpy(cat_name[if_clause],"if()");
+ strcpy(cat_name[lproc],"#{"@q}@>);
+ strcpy(cat_name[rproc],@q{@>"#}");
+ strcpy(cat_name[insert],"insert");
+ strcpy(cat_name[section_scrap],"section");
+ strcpy(cat_name[dead],"@@d");
+ strcpy(cat_name[public_like],"public");
+ strcpy(cat_name[operator_like],"operator");
+ strcpy(cat_name[new_like],"new");
+ strcpy(cat_name[catch_like],"catch");
+ strcpy(cat_name[for_like],"for");
+ strcpy(cat_name[do_like],"do");
+ strcpy(cat_name[if_like],"if");
+ strcpy(cat_name[delete_like],"delete");
+ strcpy(cat_name[raw_ubin],"ubinop?");
+ strcpy(cat_name[const_like],"const");
+ strcpy(cat_name[raw_int],"raw");
+ strcpy(cat_name[int_like],"int");
+ strcpy(cat_name[case_like],"case");
+ strcpy(cat_name[sizeof_like],"sizeof");
+ strcpy(cat_name[struct_like],"struct");
+ strcpy(cat_name[typedef_like],"typedef");
+ strcpy(cat_name[define_like],"define");
+ strcpy(cat_name[template_like],"template");
+ strcpy(cat_name[ftemplate],"ftemplate");
+ strcpy(cat_name[new_exp],"new_exp");
+ strcpy(cat_name[begin_arg],"@@["@q]@>);
+ strcpy(cat_name[end_arg],@q[@>"@@]");
+ strcpy(cat_name[0],"zero");
+
+@ This code allows \.{CWEAVE} to display its parsing steps.
+
+@c
+void
+print_cat(c) /* symbolic printout of a category */
+eight_bits c;
+{
+ printf(cat_name[c]);
+}
+
+@ The token lists for translated \TEX/ output contain some special control
+symbols as well as ordinary characters. These control symbols are
+interpreted by \.{CWEAVE} before they are written to the output file.
+
+\yskip\hang |break_space| denotes an optional line break or an en space;
+
+\yskip\hang |force| denotes a line break;
+
+\yskip\hang |big_force| denotes a line break with additional vertical space;
+
+\yskip\hang |preproc_line| denotes that the line will be printed flush left;
+
+\yskip\hang |opt| denotes an optional line break (with the continuation
+line indented two ems with respect to the normal starting position)---this
+code is followed by an integer |n|, and the break will occur with penalty
+$10n$;
+
+\yskip\hang |backup| denotes a backspace of one em;
+
+\yskip\hang |cancel| obliterates any |break_space|, |opt|, |force|, or
+|big_force| tokens that immediately precede or follow it and also cancels any
+|backup| tokens that follow it;
+
+\yskip\hang |indent| causes future lines to be indented one more em;
+
+\yskip\hang |outdent| causes future lines to be indented one less em.
+
+\yskip\noindent All of these tokens are removed from the \TEX/ output that
+comes from \CEE/ text between \pb\ signs; |break_space| and |force| and
+|big_force| become single spaces in this mode. The translation of other
+\CEE/ texts results in \TEX/ control sequences \.{\\1}, \.{\\2},
+\.{\\3}, \.{\\4}, \.{\\5}, \.{\\6}, \.{\\7}, \.{\\8}
+corresponding respectively to
+|indent|, |outdent|, |opt|, |backup|, |break_space|, |force|,
+|big_force| and |preproc_line|.
+However, a sequence of consecutive `\.\ ', |break_space|,
+|force|, and/or |big_force| tokens is first replaced by a single token
+(the maximum of the given ones).
+
+The token |math_rel| will be translated into
+\.{\\MRL\{}, and it will get a matching \.\} later.
+Other control sequences in the \TEX/ output will be
+`\.{\\\\\{}$\,\ldots\,$\.\}'
+surrounding identifiers, `\.{\\\&\{}$\,\ldots\,$\.\}' surrounding
+reserved words, `\.{\\.\{}$\,\ldots\,$\.\}' surrounding strings,
+`\.{\\C\{}$\,\ldots\,$\.\}$\,$|force|' surrounding comments, and
+`\.{\\X$n$:}$\,\ldots\,$\.{\\X}' surrounding section names, where
+|n| is the section number.
+
+@d math_rel 0206
+@d big_cancel 0210 /* like |cancel|, also overrides spaces */
+@d cancel 0211 /* overrides |backup|, |break_space|, |force|, |big_force| */
+@d indent 0212 /* one more tab (\.{\\1}) */
+@d outdent 0213 /* one less tab (\.{\\2}) */
+@d opt 0214 /* optional break in mid-statement (\.{\\3}) */
+@d backup 0215 /* stick out one unit to the left (\.{\\4}) */
+@d break_space 0216 /* optional break between statements (\.{\\5}) */
+@d force 0217 /* forced break between statements (\.{\\6}) */
+@d big_force 0220 /* forced break with additional space (\.{\\7}) */
+@d preproc_line 0221 /* begin line without indentation (\.{\\8}) */
+@^high-bit character handling@>
+@d quoted_char 0222
+ /* introduces a character token in the range |0200|--|0377| */
+@d end_translation 0223 /* special sentinel token at end of list */
+@d inserted 0224 /* sentinel to mark translations of inserts */
+@d qualifier 0225 /* introduces an explicit namespace qualifier */
+
+@ The raw input is converted into scraps according to the following table,
+which gives category codes followed by the translations.
+\def\stars {\.{**}}%
+The symbol `\stars' stands for `\.{\\\&\{{\rm identifier}\}}',
+i.e., the identifier itself treated as a reserved word.
+The right-hand column is the so-called |mathness|, which is explained
+further below.
+
+An identifier |c| of length 1 is translated as \.{\\\v c} instead of
+as \.{\\\\\{c\}}. An identifier \.{CAPS} in all caps is translated as
+\.{\\.\{CAPS\}} instead of as \.{\\\\\{CAPS\}}. An identifier that has
+become a reserved word via |typedef| is translated with \.{\\\&} replacing
+\.{\\\\} and |raw_int| replacing |exp|.
+
+A string of length greater than 20 is broken into pieces of size at most~20
+with discretionary breaks in between.
+
+\yskip\halign{\quad#\hfil&\quad#\hfil&\quad\hfil#\hfil\cr
+\.{!=}&|binop|: \.{\\I}&yes\cr
+\.{<=}&|binop|: \.{\\Z}&yes\cr
+\.{>=}&|binop|: \.{\\G}&yes\cr
+\.{==}&|binop|: \.{\\E}&yes\cr
+\.{\&\&}&|binop|: \.{\\W}&yes\cr
+\.{\v\v}&|binop|: \.{\\V}&yes\cr
+\.{++}&|unop|: \.{\\PP}&yes\cr
+\.{--}&|unop|: \.{\\MM}&yes\cr
+\.{->}&|binop|: \.{\\MG}&yes\cr
+\.{>>}&|binop|: \.{\\GG}&yes\cr
+\.{<<}&|binop|: \.{\\LL}&yes\cr
+\.{::}&|colcol|: \.{\\DC}&maybe\cr
+\.{.*}&|binop|: \.{\\PA}&yes\cr
+\.{->*}&|binop|: \.{\\MGA}&yes\cr
+\.{...}&|raw_int|: \.{\\,\\ldots\\,}&yes\cr
+\."string\."&|exp|: \.{\\.\{}string with special characters quoted\.\}&maybe\cr
+\.{@@=}string\.{@@>}&|exp|: \.{\\vb\{}string with special characters
+ quoted\.\}&maybe\cr
+\.{@@'7'}&|exp|: \.{\\.\{@@'7'\}}&maybe\cr
+\.{077} or \.{\\77}&|exp|: \.{\\T\{\\\~77\}}&maybe\cr
+\.{0x7f}&|exp|: \.{\\T\{\\\^7f\}}&maybe\cr
+\.{77}&|exp|: \.{\\T\{77\}}&maybe\cr
+\.{77L}&|exp|: \.{\\T\{77\\\$L\}}&maybe\cr
+\.{0.1E5}&|exp|: \.{\\T\{0.1\\\_5\}}&maybe\cr
+\.+&|ubinop|: \.+&yes\cr
+\.-&|ubinop|: \.-&yes\cr
+\.*&|raw_ubin|: \.*&yes\cr
+\./&|binop|: \./&yes\cr
+\.<&|prelangle|: \.{\\langle}&yes\cr
+\.=&|binop|: \.{\\K}&yes\cr
+\.>&|prerangle|: \.{\\rangle}&yes\cr
+\..&|binop|: \..&yes\cr
+\.{\v}&|binop|: \.{\\OR}&yes\cr
+\.\^&|binop|: \.{\\XOR}&yes\cr
+\.\%&|binop|: \.{\\MOD}&yes\cr
+\.?&|question|: \.{\\?}&yes\cr
+\.!&|unop|: \.{\\R}&yes\cr
+\.\~&|unop|: \.{\\CM}&yes\cr
+\.\&&|raw_ubin|: \.{\\AND}&yes\cr
+\.(&|lpar|: \.(&maybe\cr
+\.[&|lpar|: \.[&maybe\cr
+\.)&|rpar|: \.)&maybe\cr
+\.]&|rpar|: \.]&maybe\cr
+\.\{&|lbrace|: \.\{&yes\cr
+\.\}&|lbrace|: \.\}&yes\cr
+\.,&|comma|: \.,&yes\cr
+\.;&|semi|: \.;&maybe\cr
+\.:&|colon|: \.:&no\cr
+\.\# (within line)&|ubinop|: \.{\\\#}&yes\cr
+\.\# (at beginning)&|lproc|: |force| |preproc_line| \.{\\\#}&no\cr
+end of \.\# line&|rproc|: |force|&no\cr
+identifier&|exp|: \.{\\\\\{}identifier with underlines and
+ dollar signs quoted\.\}&maybe\cr
+\.{and}&|alfop|: \stars&yes\cr
+\.{and\_eq}&|alfop|: \stars&yes\cr
+\.{asm}&|sizeof_like|: \stars&maybe\cr
+\.{auto}&|int_like|: \stars&maybe\cr
+\.{bitand}&|alfop|: \stars&yes\cr
+\.{bitor}&|alfop|: \stars&yes\cr
+\.{bool}&|raw_int|: \stars&maybe\cr
+\.{break}&|case_like|: \stars&maybe\cr
+\.{case}&|case_like|: \stars&maybe\cr
+\.{catch}&|catch_like|: \stars&maybe\cr
+\.{char}&|raw_int|: \stars&maybe\cr
+\.{class}&|struct_like|: \stars&maybe\cr
+\.{clock\_t}&|raw_int|: \stars&maybe\cr
+\.{compl}&|alfop|: \stars&yes\cr
+\.{const}&|const_like|: \stars&maybe\cr
+\.{const\_cast}&|raw_int|: \stars&maybe\cr
+\.{continue}&|case_like|: \stars&maybe\cr
+\.{default}&|case_like|: \stars&maybe\cr
+\.{define}&|define_like|: \stars&maybe\cr
+\.{defined}&|sizeof_like|: \stars&maybe\cr
+\.{delete}&|delete_like|: \stars&maybe\cr
+\.{div\_t}&|raw_int|: \stars&maybe\cr
+\.{do}&|do_like|: \stars&maybe\cr
+\.{double}&|raw_int|: \stars&maybe\cr
+\.{dynamic\_cast}&|raw_int|: \stars&maybe\cr
+\.{elif}&|if_like|: \stars&maybe\cr
+\.{else}&|else_like|: \stars&maybe\cr
+\.{endif}&|if_like|: \stars&maybe\cr
+\.{enum}&|struct_like|: \stars&maybe\cr
+\.{error}&|if_like|: \stars&maybe\cr
+\.{explicit}&|int_like|: \stars&maybe\cr
+\.{export}&|int_like|: \stars&maybe\cr
+\.{extern}&|int_like|: \stars&maybe\cr
+\.{FILE}&|raw_int|: \stars&maybe\cr
+\.{float}&|raw_int|: \stars&maybe\cr
+\.{for}&|for_like|: \stars&maybe\cr
+\.{fpos\_t}&|raw_int|: \stars&maybe\cr
+\.{friend}&|int_like|: \stars&maybe\cr
+\.{goto}&|case_like|: \stars&maybe\cr
+\.{if}&|if_like|: \stars&maybe\cr
+\.{ifdef}&|if_like|: \stars&maybe\cr
+\.{ifndef}&|if_like|: \stars&maybe\cr
+\.{include}&|if_like|: \stars&maybe\cr
+\.{inline}&|int_like|: \stars&maybe\cr
+\.{int}&|raw_int|: \stars&maybe\cr
+\.{jmp\_buf}&|raw_int|: \stars&maybe\cr
+\.{ldiv\_t}&|raw_int|: \stars&maybe\cr
+\.{line}&|if_like|: \stars&maybe\cr
+\.{long}&|raw_int|: \stars&maybe\cr
+\.{make\_pair}&|ftemplate|: \.{\\\\\{make\\\_pair\}}&maybe\cr
+\.{mutable}&|int_like|: \stars&maybe\cr
+\.{namespace}&|struct_like|: \stars&maybe\cr
+\.{new}&|new_like|: \stars&maybe\cr
+\.{not}&|alfop|: \stars&yes\cr
+\.{not\_eq}&|alfop|: \stars&yes\cr
+\.{NULL}&|exp|: \.{\\NULL}&yes\cr
+\.{offsetof}&|raw_int|: \stars&maybe\cr
+\.{operator}&|operator_like|: \stars&maybe\cr
+\.{or}&|alfop|: \stars&yes\cr
+\.{or\_eq}&|alfop|: \stars&yes\cr
+\.{pragma}&|if_like|: \stars&maybe\cr
+\.{private}&|public_like|: \stars&maybe\cr
+\.{protected}&|public_like|: \stars&maybe\cr
+\.{ptrdiff\_t}&|raw_int|: \stars&maybe\cr
+\.{public}&|public_like|: \stars&maybe\cr
+\.{register}&|int_like|: \stars&maybe\cr
+\.{reinterpret\_cast}&|raw_int|: \stars&maybe\cr
+\.{return}&|case_like|: \stars&maybe\cr
+\.{short}&|raw_int|: \stars&maybe\cr
+\.{sig\_atomic\_t}&|raw_int|: \stars&maybe\cr
+\.{signed}&|raw_int|: \stars&maybe\cr
+\.{size\_t}&|raw_int|: \stars&maybe\cr
+\.{sizeof}&|sizeof_like|: \stars&maybe\cr
+\.{static}&|int_like|: \stars&maybe\cr
+\.{static\_cast}&|raw_int|: \stars&maybe\cr
+\.{struct}&|struct_like|: \stars&maybe\cr
+\.{switch}&|for_like|: \stars&maybe\cr
+\.{template}&|template_like|: \stars&maybe\cr
+\.{TeX}&|exp|: \.{\\TeX}&yes\cr
+\.{this}&|exp|: \.{\\this}&yes\cr
+\.{throw}&|case_like|: \stars&maybe\cr
+\.{time\_t}&|raw_int|: \stars&maybe\cr
+\.{try}&|else_like|: \stars&maybe\cr
+\.{typedef}&|typedef_like|: \stars&maybe\cr
+\.{typeid}&|raw_int|: \stars&maybe\cr
+\.{typename}&|struct_like|: \stars&maybe\cr
+\.{undef}&|if_like|: \stars&maybe\cr
+\.{union}&|struct_like|: \stars&maybe\cr
+\.{unsigned}&|raw_int|: \stars&maybe\cr
+\.{using}&|int_like|: \stars&maybe\cr
+\.{va\_dcl}&|decl|: \stars&maybe\cr
+\.{va\_list}&|raw_int|: \stars&maybe\cr
+\.{virtual}&|int_like|: \stars&maybe\cr
+\.{void}&|raw_int|: \stars&maybe\cr
+\.{volatile}&|const_like|: \stars&maybe\cr
+\.{wchar\_t}&|raw_int|: \stars&maybe\cr
+\.{while}&|for_like|: \stars&maybe\cr
+\.{xor}&|alfop|: \stars&yes\cr
+\.{xor\_eq}&|alfop|: \stars&yes\cr
+\.{@@,}&|insert|: \.{\\,}&maybe\cr
+\.{@@\v}&|insert|: |opt| \.0&maybe\cr
+\.{@@/}&|insert|: |force|&no\cr
+\.{@@\#}&|insert|: |big_force|&no\cr
+\.{@@+}&|insert|: |big_cancel| \.{\{\}} |break_space|
+ \.{\{\}} |big_cancel|&no\cr
+\.{@@;}&|semi|: &maybe\cr
+\.{@@[@q]@>}&|begin_arg|: &maybe\cr
+\.{@q[@>@@]}&|end_arg|: &maybe\cr
+\.{@@\&}&|insert|: \.{\\J}&maybe\cr
+\.{@@h}&|insert|: |force| \.{\\ATH} |force|&no\cr
+\.{@@<}\thinspace section name\thinspace\.{@@>}&|section_scrap|:
+ \.{\\X}$n$\.:translated section name\.{\\X}&maybe\cr
+\.{@@(@q)@>}\thinspace section name\thinspace\.{@@>}&|section_scrap|:
+ \.{\\X}$n$\.{:\\.\{}section name with special characters
+ quoted\.{\ \}\\X}&maybe\cr
+\.{/*}comment\.{*/}&|insert|: |cancel|
+ \.{\\C\{}translated comment\.\} |force|&no\cr
+\.{//}comment&|insert|: |cancel|
+ \.{\\SHC\{}translated comment\.\} |force|&no\cr
+}
+
+\smallskip
+The construction \.{@@t}\thinspace stuff\/\thinspace\.{@@>} contributes
+\.{\\hbox\{}\thinspace stuff\/\thinspace\.\} to the following scrap.
+
+@i prod.w
+
+@* Implementing the productions.
+More specifically, a scrap is a structure consisting of a category
+|cat| and a |text_pointer| |trans|, which points to the translation in
+|tok_start|. When \CEE/ text is to be processed with the grammar above,
+we form an array |scrap_info| containing the initial scraps.
+Our production rules have the nice property that the right-hand side is never
+longer than the left-hand side. Therefore it is convenient to use sequential
+allocation for the current sequence of scraps. Five pointers are used to
+manage the parsing:
+
+\yskip\hang |pp| is a pointer into |scrap_info|. We will try to match
+the category codes |pp->cat,@,@,(pp+1)->cat|$,\,\,\ldots\,$
+to the left-hand sides of productions.
+
+\yskip\hang |scrap_base|, |lo_ptr|, |hi_ptr|, and |scrap_ptr| are such that
+the current sequence of scraps appears in positions |scrap_base| through
+|lo_ptr| and |hi_ptr| through |scrap_ptr|, inclusive, in the |cat| and
+|trans| arrays. Scraps located between |scrap_base| and |lo_ptr| have
+been examined, while those in positions |>=hi_ptr| have not yet been
+looked at by the parsing process.
+
+\yskip\noindent Initially |scrap_ptr| is set to the position of the final
+scrap to be parsed, and it doesn't change its value. The parsing process
+makes sure that |lo_ptr>=pp+3|, since productions have as many as four terms,
+by moving scraps from |hi_ptr| to |lo_ptr|. If there are
+fewer than |pp+3| scraps left, the positions up to |pp+3| are filled with
+blanks that will not match in any productions. Parsing stops when
+|pp==lo_ptr+1| and |hi_ptr==scrap_ptr+1|.
+
+Since the |scrap| structure will later be used for other purposes, we
+declare its second element as a union.
+
+@<Type...@>=
+typedef struct {
+ eight_bits cat;
+ eight_bits mathness;
+ union {
+ text_pointer Trans;
+ @<Rest of |trans_plus| union@>@;
+ } trans_plus;
+} scrap;
+typedef scrap *scrap_pointer;
+
+@ @d trans trans_plus.Trans /* translation texts of scraps */
+
+@<Global...@>=
+scrap scrap_info[max_scraps]; /* memory array for scraps */
+scrap_pointer scrap_info_end=scrap_info+max_scraps -1; /* end of |scrap_info| */
+scrap_pointer pp; /* current position for reducing productions */
+scrap_pointer scrap_base; /* beginning of the current scrap sequence */
+scrap_pointer scrap_ptr; /* ending of the current scrap sequence */
+scrap_pointer lo_ptr; /* last scrap that has been examined */
+scrap_pointer hi_ptr; /* first scrap that has not been examined */
+scrap_pointer max_scr_ptr; /* largest value assumed by |scrap_ptr| */
+
+@ @<Set init...@>=
+scrap_base=scrap_info+1;
+max_scr_ptr=scrap_ptr=scrap_info;
+
+@ Token lists in |@!tok_mem| are composed of the following kinds of
+items for \TEX/ output.
+
+\yskip\item{$\bullet$}Character codes and special codes like |force| and
+|math_rel| represent themselves;
+
+\item{$\bullet$}|id_flag+p| represents \.{\\\\\{{\rm identifier $p$}\}};
+
+\item{$\bullet$}|res_flag+p| represents \.{\\\&\{{\rm identifier $p$}\}};
+
+\item{$\bullet$}|section_flag+p| represents section name |p|;
+
+\item{$\bullet$}|tok_flag+p| represents token list number |p|;
+
+\item{$\bullet$}|inner_tok_flag+p| represents token list number |p|, to be
+translated without line-break controls.
+
+@d id_flag 10240 /* signifies an identifier */
+@d res_flag 2*id_flag /* signifies a reserved word */
+@d section_flag 3*id_flag /* signifies a section name */
+@d tok_flag 4*id_flag /* signifies a token list */
+@d inner_tok_flag 5*id_flag /* signifies a token list in `\pb' */
+
+@c
+void
+print_text(p) /* prints a token list for debugging; not used in |main| */
+text_pointer p;
+{
+ token_pointer j; /* index into |tok_mem| */
+ sixteen_bits r; /* remainder of token after the flag has been stripped off */
+ if (p>=text_ptr) printf("BAD");
+ else for (j=*p; j<*(p+1); j++) {
+ r=*j%id_flag;
+ switch (*j/id_flag) {
+ case 1: printf("\\\\{"@q}@>); print_id((name_dir+r)); printf(@q{@>"}");
+ break; /* |id_flag| */
+ case 2: printf("\\&{"@q}@>); print_id((name_dir+r)); printf(@q{@>"}");
+ break; /* |res_flag| */
+ case 3: printf("<"); print_section_name((name_dir+r)); printf(">");
+ break; /* |section_flag| */
+ case 4: printf("[[%d]]",r); break; /* |tok_flag| */
+ case 5: printf("|[[%d]]|",r); break; /* |inner_tok_flag| */
+ default: @<Print token |r| in symbolic form@>;
+ }
+ }
+ fflush(stdout);
+}
+
+@ @<Print token |r|...@>=
+switch (r) {
+ case math_rel: printf("\\mathrel{"@q}@>); break;
+ case big_cancel: printf("[ccancel]"); break;
+ case cancel: printf("[cancel]"); break;
+ case indent: printf("[indent]"); break;
+ case outdent: printf("[outdent]"); break;
+ case backup: printf("[backup]"); break;
+ case opt: printf("[opt]"); break;
+ case break_space: printf("[break]"); break;
+ case force: printf("[force]"); break;
+ case big_force: printf("[fforce]"); break;
+ case preproc_line: printf("[preproc]"); break;
+ case quoted_char: j++; printf("[%o]",(unsigned)*j); break;
+ case end_translation: printf("[quit]"); break;
+ case inserted: printf("[inserted]"); break;
+ default: putxchar(r);
+}
+
+@ The production rules listed above are embedded directly into \.{CWEAVE},
+since it is easier to do this than to write an interpretive system
+that would handle production systems in general. Several macros are defined
+here so that the program for each production is fairly short.
+
+All of our productions conform to the general notion that some |k|
+consecutive scraps starting at some position |j| are to be replaced by a
+single scrap of some category |c| whose translation is composed from the
+translations of the disappearing scraps. After this production has been
+applied, the production pointer |pp| should change by an amount |d|. Such
+a production can be represented by the quadruple |(j,k,c,d)|. For example,
+the production `|exp@,comma@,exp| $\RA$ |exp|' would be represented by
+`|(pp,3,exp,-2)|'; in this case the pointer |pp| should decrease by 2
+after the production has been applied, because some productions with
+|exp| in their second or third positions might now match,
+but no productions have
+|exp| in the fourth position of their left-hand sides. Note that
+the value of |d| is determined by the whole collection of productions, not
+by an individual one.
+The determination of |d| has been
+done by hand in each case, based on the full set of productions but not on
+the grammar of \CEE/ or on the rules for constructing the initial
+scraps.
+
+We also attach a serial number to each production, so that additional
+information is available when debugging. For example, the program below
+contains the statement `|reduce(pp,3,exp,-2,4)|' when it implements
+the production just mentioned.
+
+Before calling |reduce|, the program should have appended the tokens of
+the new translation to the |tok_mem| array. We commonly want to append
+copies of several existing translations, and macros are defined to
+simplify these common cases. For example, \\{app2}|(pp)| will append the
+translations of two consecutive scraps, |pp->trans| and |(pp+1)->trans|, to
+the current token list. If the entire new translation is formed in this
+way, we write `|squash(j,k,c,d,n)|' instead of `|reduce(j,k,c,d,n)|'. For
+example, `|squash(pp,3,exp,-2,3)|' is an abbreviation for `\\{app3}|(pp);
+reduce(pp,3,exp,-2,3)|'.
+
+A couple more words of explanation:
+Both |big_app| and |app| append a token (while |big_app1| to |big_app4|
+append the specified number of scrap translations) to the current token list.
+The difference between |big_app| and |app| is simply that |big_app|
+checks whether there can be a conflict between math and non-math
+tokens, and intercalates a `\.{\$}' token if necessary. When in
+doubt what to use, use |big_app|.
+
+The |mathness| is an attribute of scraps that says whether they are
+to be printed in a math mode context or not. It is separate from the
+``part of speech'' (the |cat|) because to make each |cat| have
+a fixed |mathness| (as in the original \.{WEAVE}) would multiply the
+number of necessary production rules.
+
+The low two bits (i.e. |mathness % 4|) control the left boundary.
+(We need two bits because we allow cases |yes_math|, |no_math| and
+|maybe_math|, which can go either way.)
+The next two bits (i.e. |mathness / 4|) control the right boundary.
+If we combine two scraps and the right boundary of the first has
+a different mathness from the left boundary of the second, we
+insert a \.{\$} in between. Similarly, if at printing time some
+irreducible scrap has a |yes_math| boundary the scrap gets preceded
+or followed by a \.{\$}. The left boundary is |maybe_math| if and
+only if the right boundary is.
+
+The code below is an exact translation of the production rules into
+\CEE/, using such macros, and the reader should have no difficulty
+understanding the format by comparing the code with the symbolic
+productions as they were listed earlier.
+
+@d no_math 2 /* should be in horizontal mode */
+@d yes_math 1 /* should be in math mode */
+@d maybe_math 0 /* works in either horizontal or math mode */
+@d big_app2(a) big_app1(a);big_app1(a+1)
+@d big_app3(a) big_app2(a);big_app1(a+2)
+@d big_app4(a) big_app3(a);big_app1(a+3)
+@d app(a) *(tok_ptr++)=a
+@d app1(a) *(tok_ptr++)=tok_flag+(int)((a)->trans-tok_start)
+
+@<Global...@>=
+int cur_mathness, init_mathness;
+
+@ @c
+void
+app_str(s)
+char *s;
+{
+ while (*s) app_tok(*(s++));
+}
+
+void
+big_app(a)
+token a;
+{
+ if (a==' ' || (a>=big_cancel && a<=big_force)) /* non-math token */ {
+ if (cur_mathness==maybe_math) init_mathness=no_math;
+ else if (cur_mathness==yes_math) app_str("{}$");
+ cur_mathness=no_math;
+ }
+ else {
+ if (cur_mathness==maybe_math) init_mathness=yes_math;
+ else if (cur_mathness==no_math) app_str("${}");
+ cur_mathness=yes_math;
+ }
+ app(a);
+}
+
+void
+big_app1(a)
+scrap_pointer a;
+{
+ switch (a->mathness % 4) { /* left boundary */
+ case (no_math):
+ if (cur_mathness==maybe_math) init_mathness=no_math;
+ else if (cur_mathness==yes_math) app_str("{}$");
+ cur_mathness=a->mathness / 4; /* right boundary */
+ break;
+ case (yes_math):
+ if (cur_mathness==maybe_math) init_mathness=yes_math;
+ else if (cur_mathness==no_math) app_str("${}");
+ cur_mathness=a->mathness / 4; /* right boundary */
+ break;
+ case (maybe_math): /* no changes */ break;
+ }
+ app(tok_flag+(int)((a)->trans-tok_start));
+}
+
+@ Let us consider the big switch for productions now, before looking
+at its context. We want to design the program so that this switch
+works, so we might as well not keep ourselves in suspense about exactly what
+code needs to be provided with a proper environment.
+
+@d cat1 (pp+1)->cat
+@d cat2 (pp+2)->cat
+@d cat3 (pp+3)->cat
+@d lhs_not_simple (pp->cat!=public_like
+ && pp->cat!=semi
+ && pp->cat!=prelangle
+ && pp->cat!=prerangle
+ && pp->cat!=template_like
+ && pp->cat!=new_like
+ && pp->cat!=new_exp
+ && pp->cat!=ftemplate
+ && pp->cat!=raw_ubin
+ && pp->cat!=const_like
+ && pp->cat!=raw_int
+ && pp->cat!=operator_like)
+ /* not a production with left side length 1 */
+
+@<Match a production at |pp|, or increase |pp| if there is no match@>= {
+ if (cat1==end_arg && lhs_not_simple)
+ if (pp->cat==begin_arg) squash(pp,2,exp,-2,124);
+ else squash(pp,2,end_arg,-1,125);
+ else if (cat1==insert) squash(pp,2,pp->cat,-2,0);
+ else if (cat2==insert) squash(pp+1,2,(pp+1)->cat,-1,0);
+ else if (cat3==insert) squash(pp+2,2,(pp+2)->cat,0,0);
+ else
+ switch (pp->cat) {
+ case exp: @<Cases for |exp|@>; @+break;
+ case lpar: @<Cases for |lpar|@>; @+break;
+ case unop: @<Cases for |unop|@>; @+break;
+ case ubinop: @<Cases for |ubinop|@>; @+break;
+ case binop: @<Cases for |binop|@>; @+break;
+ case cast: @<Cases for |cast|@>; @+break;
+ case sizeof_like: @<Cases for |sizeof_like|@>; @+break;
+ case int_like: @<Cases for |int_like|@>; @+break;
+ case public_like: @<Cases for |public_like|@>; @+break;
+ case colcol: @<Cases for |colcol|@>; @+break;
+ case decl_head: @<Cases for |decl_head|@>; @+break;
+ case decl: @<Cases for |decl|@>; @+break;
+ case base: @<Cases for |base|@>; @+break;
+ case struct_like: @<Cases for |struct_like|@>; @+break;
+ case struct_head: @<Cases for |struct_head|@>; @+break;
+ case fn_decl: @<Cases for |fn_decl|@>; @+break;
+ case function: @<Cases for |function|@>; @+break;
+ case lbrace: @<Cases for |lbrace|@>; @+break;
+ case if_like: @<Cases for |if_like|@>; @+break;
+ case else_like: @<Cases for |else_like|@>; @+break;
+ case else_head: @<Cases for |else_head|@>; @+break;
+ case if_clause: @<Cases for |if_clause|@>; @+break;
+ case if_head: @<Cases for |if_head|@>; @+break;
+ case do_like: @<Cases for |do_like|@>; @+break;
+ case case_like: @<Cases for |case_like|@>; @+break;
+ case catch_like: @<Cases for |catch_like|@>; @+break;
+ case tag: @<Cases for |tag|@>; @+break;
+ case stmt: @<Cases for |stmt|@>; @+break;
+ case semi: @<Cases for |semi|@>; @+break;
+ case lproc: @<Cases for |lproc|@>; @+break;
+ case section_scrap: @<Cases for |section_scrap|@>; @+break;
+ case insert: @<Cases for |insert|@>; @+break;
+ case prelangle: @<Cases for |prelangle|@>; @+break;
+ case prerangle: @<Cases for |prerangle|@>; @+break;
+ case langle: @<Cases for |langle|@>; @+break;
+ case template_like: @<Cases for |template_like|@>; @+break;
+ case new_like: @<Cases for |new_like|@>; @+break;
+ case new_exp: @<Cases for |new_exp|@>; @+break;
+ case ftemplate: @<Cases for |ftemplate|@>; @+break;
+ case for_like: @<Cases for |for_like|@>; @+break;
+ case raw_ubin: @<Cases for |raw_ubin|@>; @+break;
+ case const_like: @<Cases for |const_like|@>; @+break;
+ case raw_int: @<Cases for |raw_int|@>; @+break;
+ case operator_like: @<Cases for |operator_like|@>; @+break;
+ case typedef_like: @<Cases for |typedef_like|@>; @+break;
+ case delete_like: @<Cases for |delete_like|@>; @+break;
+ case question: @<Cases for |question|@>; @+break;
+ }
+ pp++; /* if no match was found, we move to the right */
+}
+
+@ In \CEE/, new specifier names can be defined via |typedef|, and we want
+to make the parser recognize future occurrences of the identifier thus
+defined as specifiers. This is done by the procedure |make_reserved|,
+which changes the |ilk| of the relevant identifier.
+
+We first need a procedure to recursively seek the first
+identifier in a token list, because the identifier might
+be enclosed in parentheses, as when one defines a function
+returning a pointer.
+
+If the first identifier found is a keyword like `\&{case}', we
+return the special value |case_found|; this prevents underlining
+of identifiers in case labels.
+
+If the first identifier is the keyword `\&{operator}', we give up;
+users who want to index definitions of overloaded \CPLUSPLUS/ operators
+should say, for example, `\.{@@!@@\^\\\&\{operator\} \$+\{=\}\$@@>}' (or,
+more properly alphebetized,
+`\.{@@!@@:operator+=\}\{\\\&\{operator\} \$+\{=\}\$@@>}').
+
+@d no_ident_found (token_pointer)0 /* distinct from any identifier token */
+@d case_found (token_pointer)1 /* likewise */
+@d operator_found (token_pointer)2 /* likewise */
+
+@c
+token_pointer
+find_first_ident(p)
+text_pointer p;
+{
+ token_pointer q; /* token to be returned */
+ token_pointer j; /* token being looked at */
+ sixteen_bits r; /* remainder of token after the flag has been stripped off */
+ if (p>=text_ptr) confusion("find_first_ident");
+ for (j=*p; j<*(p+1); j++) {
+ r=*j%id_flag;
+ switch (*j/id_flag) {
+ case 2: /* |res_flag| */
+ if (name_dir[r].ilk==case_like) return case_found;
+ if (name_dir[r].ilk==operator_like) return operator_found;
+ if (name_dir[r].ilk!=raw_int) break;
+ case 1: return j;
+ case 4: case 5: /* |tok_flag| or |inner_tok_flag| */
+ if ((q=find_first_ident(tok_start+r))!=no_ident_found)
+ return q;
+ default: ; /* char, |section_flag|, fall thru: move on to next token */
+ if (*j==inserted) return no_ident_found; /* ignore inserts */
+ else if (*j==qualifier) j++; /* bypass namespace qualifier */
+ }
+ }
+ return no_ident_found;
+}
+
+@ The scraps currently being parsed must be inspected for any
+occurrence of the identifier that we're making reserved; hence
+the |for| loop below.
+
+@c
+void
+make_reserved(p) /* make the first identifier in |p->trans| like |int| */
+scrap_pointer p;
+{
+ sixteen_bits tok_value; /* the name of this identifier, plus its flag*/
+ token_pointer tok_loc; /* pointer to |tok_value| */
+ if ((tok_loc=find_first_ident(p->trans))<=operator_found)
+ return; /* this should not happen */
+ tok_value=*tok_loc;
+ for (;p<=scrap_ptr; p==lo_ptr? p=hi_ptr: p++) {
+ if (p->cat==exp) {
+ if (**(p->trans)==tok_value) {
+ p->cat=raw_int;
+ **(p->trans)=tok_value%id_flag+res_flag;
+ }
+ }
+ }
+ (name_dir+(sixteen_bits)(tok_value%id_flag))->ilk=raw_int;
+ *tok_loc=tok_value%id_flag+res_flag;
+}
+
+@ In the following situations we want to mark the occurrence of
+an identifier as a definition: when |make_reserved| is just about to be
+used; after a specifier, as in |char **argv|;
+before a colon, as in \\{found}:; and in the declaration of a function,
+as in \\{main}()$\{\ldots;\}$. This is accomplished by the invocation
+of |make_underlined| at appropriate times. Notice that, in the declaration
+of a function, we find out that the identifier is being defined only after
+it has been swallowed up by an |exp|.
+
+@c
+void
+make_underlined(p)
+/* underline the entry for the first identifier in |p->trans| */
+scrap_pointer p;
+{
+ token_pointer tok_loc; /* where the first identifier appears */
+ if ((tok_loc=find_first_ident(p->trans))<=operator_found)
+ return; /* this happens, for example, in |case found:| */
+ xref_switch=def_flag;
+ underline_xref(*tok_loc%id_flag+name_dir);
+}
+
+@ We cannot use |new_xref| to underline a cross-reference at this point
+because this would just make a new cross-reference at the end of the list.
+We actually have to search through the list for the existing
+cross-reference.
+
+@<Predecl...@>=
+void underline_xref();
+
+@ @c
+void
+underline_xref(p)
+name_pointer p;
+{
+ xref_pointer q=(xref_pointer)p->xref; /* pointer to cross-reference being examined */
+ xref_pointer r; /* temporary pointer for permuting cross-references */
+ sixteen_bits m; /* cross-reference value to be installed */
+ sixteen_bits n; /* cross-reference value being examined */
+ if (no_xref) return;
+ m=section_count+xref_switch;
+ while (q != xmem) {
+ n=q->num;
+ if (n==m) return;
+ else if (m==n+def_flag) {
+ q->num=m; return;
+ }
+ else if (n>=def_flag && n<m) break;
+ q=q->xlink;
+ }
+ @<Insert new cross-reference at |q|, not at beginning of list@>;
+}
+
+@ We get to this section only when the identifier is one letter long,
+so it didn't get a non-underlined entry during phase one. But it may
+have got some explicitly underlined entries in later sections, so in order
+to preserve the numerical order of the entries in the index, we have
+to insert the new cross-reference not at the beginning of the list
+(namely, at |p->xref|), but rather right before |q|.
+
+@<Insert new cross-reference at |q|...@>=
+ append_xref(0); /* this number doesn't matter */
+ xref_ptr->xlink=(xref_pointer)p->xref; r=xref_ptr;
+ p->xref=(char*)xref_ptr;
+ while (r->xlink!=q) {r->num=r->xlink->num; r=r->xlink;}
+ r->num=m; /* everything from |q| on is left undisturbed */
+
+@ Now comes the code that tries to match each production starting
+with a particular type of scrap. Whenever a match is discovered,
+the |squash| or |reduce| macro will cause the appropriate action
+to be performed, followed by |goto found|.
+
+@<Cases for |exp|@>=
+if (cat1==lbrace || cat1==int_like || cat1==decl) {
+ make_underlined(pp); big_app1(pp); big_app(indent); app(indent);
+ reduce(pp,1,fn_decl,0,1);
+}
+else if (cat1==unop) squash(pp,2,exp,-2,2);
+else if ((cat1==binop || cat1==ubinop) && cat2==exp)
+ squash(pp,3,exp,-2,3);
+else if (cat1==comma && cat2==exp) {
+ big_app2(pp);
+ app(opt); app('9'); big_app1(pp+2); reduce(pp,3,exp,-2,4);
+}
+else if (cat1==lpar && cat2==rpar && cat3==colon) squash(pp+3,1,base,0,5);
+else if (cat1==cast && cat2==colon) squash(pp+2,1,base,0,5);
+else if (cat1==semi) squash(pp,2,stmt,-1,6);
+else if (cat1==colon) {
+ make_underlined (pp); squash(pp,2,tag,-1,7);
+}
+else if (cat1==rbrace) squash(pp,1,stmt,-1,8);
+else if (cat1==lpar && cat2==rpar && (cat3==const_like || cat3==case_like)) {
+ big_app1(pp+2); big_app(' '); big_app1(pp+3); reduce(pp+2,2,rpar,0,9);
+}
+else if (cat1==cast && (cat2==const_like || cat2==case_like)) {
+ big_app1(pp+1); big_app(' '); big_app1(pp+2); reduce(pp+1,2,cast,0,9);
+}
+else if (cat1==exp || cat1==cast) squash(pp,2,exp,-2,10);
+
+@ @<Cases for |lpar|@>=
+if ((cat1==exp||cat1==ubinop) && cat2==rpar) squash(pp,3,exp,-2,11);
+else if (cat1==rpar) {
+ big_app1(pp); app('\\'); app(','); big_app1(pp+1);
+@.\\,@>
+ reduce(pp,2,exp,-2,12);
+}
+else if ((cat1==decl_head || cat1==int_like || cat1==cast) && cat2==rpar)
+ squash(pp,3,cast,-2,13);
+else if ((cat1==decl_head || cat1==int_like || cat1==exp) && cat2==comma) {
+ big_app3(pp); app(opt); app('9'); reduce(pp,3,lpar,-1,14);
+}
+else if (cat1==stmt || cat1==decl) {
+ big_app2(pp); big_app(' '); reduce(pp,2,lpar,-1,15);
+}
+
+@ @<Cases for |unop|@>=
+if (cat1==exp || cat1==int_like) squash(pp,2,exp,-2,16);
+
+@ @<Cases for |ubinop|@>=
+if (cat1==cast && cat2==rpar) {
+ big_app('{'); big_app1(pp); big_app('}'); big_app1(pp+1);
+ reduce(pp,2,cast,-2,17);
+}
+else if (cat1==exp || cat1==int_like) {
+ big_app('{'); big_app1(pp); big_app('}'); big_app1(pp+1);
+ reduce(pp,2,cat1,-2,18);
+}
+else if (cat1==binop) {
+ big_app(math_rel); big_app1(pp); big_app('{'); big_app1(pp+1); big_app('}');
+ big_app('}'); reduce(pp,2,binop,-1,19);
+}
+
+@ @<Cases for |binop|@>=
+if (cat1==binop) {
+ big_app(math_rel); big_app('{'); big_app1(pp); big_app('}');
+ big_app('{'); big_app1(pp+1); big_app('}');
+ big_app('}'); reduce(pp,2,binop,-1,20);
+}
+
+@ @<Cases for |cast|@>=
+if (cat1==lpar) squash(pp,2,lpar,-1,21);
+else if (cat1==exp) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,exp,-2,21);
+}
+else if (cat1==semi) squash(pp,1,exp,-2,22);
+
+@ @<Cases for |sizeof_like|@>=
+if (cat1==cast) squash(pp,2,exp,-2,23);
+else if (cat1==exp) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,exp,-2,24);
+}
+
+@ @<Cases for |int_like|@>=
+if (cat1==int_like|| cat1==struct_like) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,cat1,-2,25);
+}
+else if (cat1==exp && (cat2==raw_int||cat2==struct_like))
+ squash(pp,2,int_like,-2,26);
+else if (cat1==exp || cat1==ubinop || cat1==colon) {
+ big_app1(pp); big_app(' '); reduce(pp,1,decl_head,-1,27);
+}
+else if (cat1==semi || cat1==binop) squash(pp,1,decl_head,0,28);
+
+@ @<Cases for |public_like|@>=
+if (cat1==colon) squash(pp,2,tag,-1,29);
+else squash(pp,1,int_like,-2,30);
+
+@ @<Cases for |colcol|@>=
+if (cat1==exp||cat1==int_like) {
+ app(qualifier); squash(pp,2,cat1,-2,31);
+}@+else if (cat1==colcol) squash(pp,2,colcol,-1,32);
+
+@ @<Cases for |decl_head|@>=
+if (cat1==comma) {
+ big_app2(pp); big_app(' '); reduce(pp,2,decl_head,-1,33);
+}
+else if (cat1==ubinop) {
+ big_app1(pp); big_app('{'); big_app1(pp+1); big_app('}');
+ reduce(pp,2,decl_head,-1,34);
+}
+else if (cat1==exp && cat2!=lpar && cat2!=exp && cat2!=cast) {
+ make_underlined(pp+1); squash(pp,2,decl_head,-1,35);
+}
+else if ((cat1==binop||cat1==colon) && cat2==exp && (cat3==comma ||
+ cat3==semi || cat3==rpar))
+ squash(pp,3,decl_head,-1,36);
+else if (cat1==cast) squash(pp,2,decl_head,-1,37);
+else if (cat1==lbrace || cat1==int_like || cat1==decl) {
+ big_app1(pp); big_app(indent); app(indent); reduce(pp,1,fn_decl,0,38);
+}
+else if (cat1==semi) squash(pp,2,decl,-1,39);
+
+@ @<Cases for |decl|@>=
+if (cat1==decl) {
+ big_app1(pp); big_app(force); big_app1(pp+1);
+ reduce(pp,2,decl,-1,40);
+}
+else if (cat1==stmt || cat1==function) {
+ big_app1(pp); big_app(big_force);
+ big_app1(pp+1); reduce(pp,2,cat1,-1,41);
+}
+
+@ @<Cases for |base|@>=
+if (cat1==int_like || cat1==exp) {
+ if (cat2==comma) {
+ big_app1(pp); big_app(' '); big_app2(pp+1);
+ app(opt); app('9'); reduce(pp,3,base,0,42);
+ }
+ else if (cat2==lbrace) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); big_app(' '); big_app1(pp+2);
+ reduce(pp,3,lbrace,-2,43);
+ }
+}
+
+@ @<Cases for |struct_like|@>=
+if (cat1==lbrace) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,struct_head,0,44);
+}
+else if (cat1==exp||cat1==int_like) {
+ if (cat2==lbrace || cat2==semi) {
+ make_underlined(pp+1); make_reserved(pp+1);
+ big_app1(pp); big_app(' '); big_app1(pp+1);
+ if (cat2==semi) reduce(pp,2,decl_head,0,45);
+ else {
+ big_app(' '); big_app1(pp+2);reduce(pp,3,struct_head,0,46);
+ }
+ }
+ else if (cat2==colon) squash(pp+2,1,base,2,47);
+ else if (cat2!=base) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,int_like,-2,48);
+ }
+}
+
+@ @<Cases for |struct_head|@>=
+if ((cat1==decl || cat1==stmt || cat1==function) && cat2==rbrace) {
+ big_app1(pp); big_app(indent); big_app(force); big_app1(pp+1);
+ big_app(outdent); big_app(force); big_app1(pp+2);
+ reduce(pp,3,int_like,-2,49);
+}
+else if (cat1==rbrace) {
+ big_app1(pp); app_str("\\,"); big_app1(pp+1);
+@.\\,@>
+ reduce(pp,2,int_like,-2,50);
+}
+
+@ @<Cases for |fn_decl|@>=
+if (cat1==decl) {
+ big_app1(pp); big_app(force); big_app1(pp+1); reduce(pp,2,fn_decl,0,51);
+}
+else if (cat1==stmt) {
+ big_app1(pp); app(outdent); app(outdent); big_app(force);
+ big_app1(pp+1); reduce(pp,2,function,-1,52);
+}
+
+@ @<Cases for |function|@>=
+if (cat1==function || cat1==decl || cat1==stmt) {
+ big_app1(pp); big_app(big_force); big_app1(pp+1); reduce(pp,2,cat1,-1,53);
+}
+
+@ @<Cases for |lbrace|@>=
+if (cat1==rbrace) {
+ big_app1(pp); app('\\'); app(','); big_app1(pp+1);
+@.\\,@>
+ reduce(pp,2,stmt,-1,54);
+}
+else if ((cat1==stmt||cat1==decl||cat1==function) && cat2==rbrace) {
+ big_app(force); big_app1(pp); big_app(indent); big_app(force);
+ big_app1(pp+1); big_app(force); big_app(backup); big_app1(pp+2);
+ big_app(outdent); big_app(force); reduce(pp,3,stmt,-1,55);
+}
+else if (cat1==exp) {
+ if (cat2==rbrace) squash(pp,3,exp,-2,56);
+ else if (cat2==comma && cat3==rbrace) squash(pp,4,exp,-2,56);
+}
+
+@ @<Cases for |if_like|@>=
+if (cat1==exp) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,if_clause,0,57);
+}
+
+@ @<Cases for |else_like|@>=
+if (cat1==colon) squash(pp+1,1,base,1,58);
+else if (cat1==lbrace) squash(pp,1,else_head,0,59);
+else if (cat1==stmt) {
+ big_app(force); big_app1(pp); big_app(indent); big_app(break_space);
+ big_app1(pp+1); big_app(outdent); big_app(force);
+ reduce(pp,2,stmt,-1,60);
+}
+
+@ @<Cases for |else_head|@>=
+if (cat1==stmt || cat1==exp) {
+ big_app(force); big_app1(pp); big_app(break_space); app(noop);
+ big_app(cancel); big_app1(pp+1); big_app(force);
+ reduce(pp,2,stmt,-1,61);
+}
+
+@ @<Cases for |if_clause|@>=
+if (cat1==lbrace) squash(pp,1,if_head,0,62);
+else if (cat1==stmt) {
+ if (cat2==else_like) {
+ big_app(force); big_app1(pp); big_app(indent); big_app(break_space);
+ big_app1(pp+1); big_app(outdent); big_app(force); big_app1(pp+2);
+ if (cat3==if_like) {
+ big_app(' '); big_app1(pp+3); reduce(pp,4,if_like,0,63);
+ }@+else reduce(pp,3,else_like,0,64);
+ }
+ else squash(pp,1,else_like,0,65);
+}
+
+@ @<Cases for |if_head|@>=
+if (cat1==stmt || cat1==exp) {
+ if (cat2==else_like) {
+ big_app(force); big_app1(pp); big_app(break_space); app(noop);
+ big_app(cancel); big_app1(pp+1); big_app(force); big_app1(pp+2);
+ if (cat3==if_like) {
+ big_app(' '); big_app1(pp+3); reduce(pp,4,if_like,0,66);
+ }@+else reduce(pp,3,else_like,0,67);
+ }
+ else squash(pp,1,else_head,0,68);
+}
+
+@ @<Cases for |do_like|@>=
+if (cat1==stmt && cat2==else_like && cat3==semi) {
+ big_app1(pp); big_app(break_space); app(noop); big_app(cancel);
+ big_app1(pp+1); big_app(cancel); app(noop); big_app(break_space);
+ big_app2(pp+2); reduce(pp,4,stmt,-1,69);
+}
+
+@ @<Cases for |case_like|@>=
+if (cat1==semi) squash(pp,2,stmt,-1,70);
+else if (cat1==colon) squash(pp,2,tag,-1,71);
+else if (cat1==exp) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,exp,-2,72);
+}
+
+@ @<Cases for |catch_like|@>=
+if (cat1==cast || cat1==exp) {
+ big_app2(pp); big_app(indent); big_app(indent); reduce(pp,2,fn_decl,0,73);
+}
+
+@ @<Cases for |tag|@>=
+if (cat1==tag) {
+ big_app1(pp); big_app(break_space); big_app1(pp+1); reduce(pp,2,tag,-1,74);
+}
+else if (cat1==stmt||cat1==decl||cat1==function) {
+ big_app(force); big_app(backup); big_app1(pp); big_app(break_space);
+ big_app1(pp+1); reduce(pp,2,cat1,-1,75);
+}
+
+@ The user can decide at run-time whether short statements should be
+grouped together on the same line.
+
+@d force_lines flags['f'] /* should each statement be on its own line? */
+@<Cases for |stmt|@>=
+if (cat1==stmt||cat1==decl||cat1==function) {
+ big_app1(pp);
+ if (cat1==function) big_app(big_force);
+ else if (cat1==decl) big_app(big_force);
+ else if (force_lines) big_app(force);
+ else big_app(break_space);
+ big_app1(pp+1); reduce(pp,2,cat1,-1,76);
+}
+
+@ @<Cases for |semi|@>=
+big_app(' '); big_app1(pp); reduce(pp,1,stmt,-1,77);
+
+@ @<Cases for |lproc|@>=
+if (cat1==define_like) make_underlined(pp+2);
+if (cat1==else_like || cat1==if_like ||cat1==define_like)
+ squash(pp,2,lproc,0,78);
+else if (cat1==rproc) {
+ app(inserted); big_app2(pp); reduce(pp,2,insert,-1,79);
+} else if (cat1==exp || cat1==function) {
+ if (cat2==rproc) {
+ app(inserted); big_app1(pp); big_app(' '); big_app2(pp+1);
+ reduce(pp,3,insert,-1,80);
+ }
+ else if (cat2==exp && cat3==rproc && cat1==exp) {
+ app(inserted); big_app1(pp); big_app(' '); big_app1(pp+1); app_str(" \\5");
+@.\\5@>
+ big_app2(pp+2); reduce(pp,4,insert,-1,80);
+ }
+}
+
+@ @<Cases for |section_scrap|@>=
+if (cat1==semi) {
+ big_app2(pp); big_app(force); reduce(pp,2,stmt,-2,81);
+}
+else squash(pp,1,exp,-2,82);
+
+@ @<Cases for |insert|@>=
+if (cat1)
+ squash(pp,2,cat1,0,83);
+
+@ @<Cases for |prelangle|@>=
+init_mathness=cur_mathness=yes_math;
+app('<'); reduce(pp,1,binop,-2,84);
+
+@ @<Cases for |prerangle|@>=
+init_mathness=cur_mathness=yes_math;
+app('>'); reduce(pp,1,binop,-2,85);
+
+@ @<Cases for |langle|@>=
+if (cat1==prerangle) {
+ big_app1(pp); app('\\'); app(','); big_app1(pp+1);
+@.\\,@>
+ reduce(pp,2,cast,-1,86);
+}
+else if (cat1==decl_head || cat1==int_like || cat1==exp) {
+ if (cat2==prerangle) squash(pp,3,cast,-1,87);
+ else if (cat2==comma) {
+ big_app3(pp); app(opt); app('9'); reduce(pp,3,langle,0,88);
+ }
+}
+
+@ @<Cases for |template_like|@>=
+if (cat1==exp && cat2==prelangle) squash(pp+2,1,langle,2,89);
+else if (cat1==exp || cat1==raw_int) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,cat1,-2,90);
+}@+ else squash(pp,1,raw_int,0,91);
+
+@ @<Cases for |new_like|@>=
+if (cat1==lpar && cat2==exp && cat3==rpar) squash(pp,4,new_like,0,92);
+else if (cat1==cast) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,exp,-2,93);
+}
+else if (cat1!=lpar) squash(pp,1,new_exp,0,94);
+
+@ @<Cases for |new_exp|@>=
+if (cat1==int_like || cat1==const_like) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,new_exp,0,95);
+}
+else if (cat1==struct_like && (cat2==exp || cat2==int_like)) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); big_app(' ');
+ big_app1(pp+2); reduce(pp,3,new_exp,0,96);
+}
+else if (cat1==raw_ubin) {
+ big_app1(pp); big_app('{'); big_app1(pp+1); big_app('}');
+ reduce(pp,2,new_exp,0,97);
+}
+else if (cat1==lpar) squash(pp,1,exp,-2,98);
+else if (cat1==exp) {
+ big_app1(pp); big_app(' '); reduce(pp,1,exp,-2,98);
+}
+else if (cat1!=raw_int && cat1!=struct_like && cat1!=colcol)
+ squash(pp,1,exp,-2,99);
+
+@ @<Cases for |ftemplate|@>=
+if (cat1==prelangle) squash(pp+1,1,langle,1,100);
+else squash(pp,1,exp,-2,101);
+
+@ @<Cases for |for_like|@>=
+if (cat1==exp) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,else_like,-2,102);
+}
+
+@ @<Cases for |raw_ubin|@>=
+if (cat1==const_like) {
+ big_app2(pp); app_str("\\ "); reduce(pp,2,raw_ubin,0,103);
+@.\\\ @>
+} else squash(pp,1,ubinop,-2,104);
+
+@ @<Cases for |const_like|@>=
+squash(pp,1,int_like,-2,105);
+
+@ @<Cases for |raw_int|@>=
+if (cat1==prelangle) squash(pp+1,1,langle,1,106);
+else if (cat1==colcol) squash(pp,2,colcol,-1,107);
+else if (cat1==cast) squash(pp,2,raw_int,0,108);
+else if (cat1==lpar) squash(pp,1,exp,-2,109);
+else if (cat1!=langle) squash(pp,1,int_like,-3,110);
+
+@ @<Cases for |operator_like|@>=
+if (cat1==binop || cat1==unop || cat1==ubinop) {
+ if (cat2==binop) break;
+ big_app1(pp); big_app('{'); big_app1(pp+1); big_app('}');
+ reduce(pp,2,exp,-2,111);
+}
+else if (cat1==new_like || cat1==delete_like) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,exp,-2,112);
+}
+else if (cat1==comma) squash(pp,2,exp,-2,113);
+else if (cat1!=raw_ubin) squash(pp,1,new_exp,0,114);
+
+@ @<Cases for |typedef_like|@>=
+if ((cat1==int_like || cat1==cast) && (cat2==comma || cat2==semi))
+ squash(pp+1,1,exp,-1,115);
+else if (cat1==int_like) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,typedef_like,0,116);
+}
+else if (cat1==exp && cat2!=lpar && cat2!=exp && cat2!=cast) {
+ make_underlined(pp+1); make_reserved(pp+1);
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,typedef_like,0,117);
+}
+else if (cat1==comma) {
+ big_app2(pp); big_app(' '); reduce(pp,2,typedef_like,0,118);
+}
+else if (cat1==semi) squash(pp,2,decl,-1,119);
+else if (cat1==ubinop && (cat2==ubinop || cat2==cast)) {
+ big_app('{'); big_app1(pp+1); big_app('}'); big_app1(pp+2);
+ reduce(pp+1,2,cat2,0,120);
+}
+
+@ @<Cases for |delete_like|@>=
+if (cat1==lpar && cat2==rpar) {
+ big_app2(pp); app('\\'); app(','); big_app1(pp+2);
+@.\\,@>
+ reduce(pp,3,delete_like,0,121);
+}
+else if (cat1==exp) {
+ big_app1(pp); big_app(' '); big_app1(pp+1); reduce(pp,2,exp,-2,122);
+}
+
+@ @<Cases for |question|@>=
+if (cat1==exp && (cat2==colon || cat2==base)) {
+ (pp+2)->mathness=5*yes_math; /* this colon should be in math mode */
+ squash(pp,3,binop,-2,123);
+}
+
+@ Now here's the |reduce| procedure used in our code for productions.
+
+The `|freeze_text|' macro is used to give official status to a token list.
+Before saying |freeze_text|, items are appended to the current token list,
+and we know that the eventual number of this token list will be the current
+value of |text_ptr|. But no list of that number really exists as yet,
+because no ending point for the current list has been
+stored in the |tok_start| array. After saying |freeze_text|, the
+old current token list becomes legitimate, and its number is the current
+value of |text_ptr-1| since |text_ptr| has been increased. The new
+current token list is empty and ready to be appended to.
+Note that |freeze_text| does not check to see that |text_ptr| hasn't gotten
+too large, since it is assumed that this test was done beforehand.
+
+@d freeze_text *(++text_ptr)=tok_ptr
+
+@c
+void
+reduce(j,k,c,d,n)
+scrap_pointer j;
+eight_bits c;
+short k, d, n;
+{
+ scrap_pointer i, i1; /* pointers into scrap memory */
+ j->cat=c; j->trans=text_ptr;
+ j->mathness=4*cur_mathness+init_mathness;
+ freeze_text;
+ if (k>1) {
+ for (i=j+k, i1=j+1; i<=lo_ptr; i++, i1++) {
+ i1->cat=i->cat; i1->trans=i->trans;
+ i1->mathness=i->mathness;
+ }
+ lo_ptr=lo_ptr-k+1;
+ }
+ pp=(pp+d<scrap_base? scrap_base: pp+d);
+ @<Print a snapshot of the scrap list if debugging @>;
+ pp--; /* we next say |pp++| */
+}
+
+@ Here's the |squash| procedure, which
+takes advantage of the simplification that occurs when |k==1|.
+
+@c
+void
+squash(j,k,c,d,n)
+scrap_pointer j;
+eight_bits c;
+short k, d, n;
+{
+ scrap_pointer i; /* pointers into scrap memory */
+ if (k==1) {
+ j->cat=c; pp=(pp+d<scrap_base? scrap_base: pp+d);
+ @<Print a snapshot...@>;
+ pp--; /* we next say |pp++| */
+ return;
+ }
+ for (i=j; i<j+k; i++) big_app1(i);
+ reduce(j,k,c,d,n);
+}
+
+@ And here now is the code that applies productions as long as possible.
+Before applying the production mechanism, we must make sure
+it has good input (at least four scraps, the length of the lhs of the
+longest rules), and that there is enough room in the memory arrays
+to hold the appended tokens and texts. Here we use a very
+conservative test; it's more important to make sure the program
+will still work if we change the production rules (within reason)
+than to squeeze the last bit of space from the memory arrays.
+
+@d safe_tok_incr 20
+@d safe_text_incr 10
+@d safe_scrap_incr 10
+
+@<Reduce the scraps using the productions until no more rules apply@>=
+while (1) {
+ @<Make sure the entries |pp| through |pp+3| of |cat| are defined@>;
+ if (tok_ptr+safe_tok_incr>tok_mem_end) {
+ if (tok_ptr>max_tok_ptr) max_tok_ptr=tok_ptr;
+ overflow("token");
+ }
+ if (text_ptr+safe_text_incr>tok_start_end) {
+ if (text_ptr>max_text_ptr) max_text_ptr=text_ptr;
+ overflow("text");
+ }
+ if (pp>lo_ptr) break;
+ init_mathness=cur_mathness=maybe_math;
+ @<Match a production...@>;
+}
+
+@ If we get to the end of the scrap list, category codes equal to zero are
+stored, since zero does not match anything in a production.
+
+@<Make sure the entries...@>=
+if (lo_ptr<pp+3) {
+ while (hi_ptr<=scrap_ptr && lo_ptr!=pp+3) {
+ (++lo_ptr)->cat=hi_ptr->cat; lo_ptr->mathness=(hi_ptr)->mathness;
+ lo_ptr->trans=(hi_ptr++)->trans;
+ }
+ for (i=lo_ptr+1;i<=pp+3;i++) i->cat=0;
+}
+
+@ If \.{CWEAVE} is being run in debugging mode, the production numbers and
+current stack categories will be printed out when |tracing| is set to 2;
+a sequence of two or more irreducible scraps will be printed out when
+|tracing| is set to 1.
+
+@<Global...@>=
+int tracing; /* can be used to show parsing details */
+
+@ @<Print a snapsh...@>=
+{ scrap_pointer k; /* pointer into |scrap_info| */
+ if (tracing==2) {
+ printf("\n%d:",n);
+ for (k=scrap_base; k<=lo_ptr; k++) {
+ if (k==pp) putxchar('*'); else putxchar(' ');
+ if (k->mathness %4 == yes_math) putchar('+');
+ else if (k->mathness %4 == no_math) putchar('-');
+ print_cat(k->cat);
+ if (k->mathness /4 == yes_math) putchar('+');
+ else if (k->mathness /4 == no_math) putchar('-');
+ }
+ if (hi_ptr<=scrap_ptr) printf("..."); /* indicate that more is coming */
+ }
+}
+
+@ The |translate| function assumes that scraps have been stored in
+positions |scrap_base| through |scrap_ptr| of |cat| and |trans|. It
+applies productions as much as
+possible. The result is a token list containing the translation of
+the given sequence of scraps.
+
+After calling |translate|, we will have |text_ptr+3<=max_texts| and
+|tok_ptr+6<=max_toks|, so it will be possible to create up to three token
+lists with up to six tokens without checking for overflow. Before calling
+|translate|, we should have |text_ptr<max_texts| and |scrap_ptr<max_scraps|,
+since |translate| might add a new text and a new scrap before it checks
+for overflow.
+
+@c
+text_pointer
+translate() /* converts a sequence of scraps */
+{
+ scrap_pointer i, /* index into |cat| */
+ j; /* runs through final scraps */
+ pp=scrap_base; lo_ptr=pp-1; hi_ptr=pp;
+ @<If tracing, print an indication of where we are@>;
+ @<Reduce the scraps...@>;
+ @<Combine the irreducible scraps that remain@>;
+}
+
+@ If the initial sequence of scraps does not reduce to a single scrap,
+we concatenate the translations of all remaining scraps, separated by
+blank spaces, with dollar signs surrounding the translations of scraps
+where appropriate.
+
+@<Combine the irreducible...@>= {
+ @<If semi-tracing, show the irreducible scraps@>;
+ for (j=scrap_base; j<=lo_ptr; j++) {
+ if (j!=scrap_base) app(' ');
+ if (j->mathness % 4 == yes_math) app('$');
+ app1(j);
+ if (j->mathness / 4 == yes_math) app('$');
+ if (tok_ptr+6>tok_mem_end) overflow("token");
+ }
+ freeze_text; return(text_ptr-1);
+}
+
+@ @<If semi-tracing, show the irreducible scraps@>=
+if (lo_ptr>scrap_base && tracing==1) {
+ printf("\nIrreducible scrap sequence in section %d:",section_count);
+@.Irreducible scrap sequence...@>
+ mark_harmless;
+ for (j=scrap_base; j<=lo_ptr; j++) {
+ printf(" "); print_cat(j->cat);
+ }
+}
+
+@ @<If tracing,...@>=
+if (tracing==2) {
+ printf("\nTracing after l. %d:\n",cur_line); mark_harmless;
+@.Tracing after...@>
+ if (loc>buffer+50) {
+ printf("...");
+ term_write(loc-51,51);
+ }
+ else term_write(buffer,loc-buffer);
+}
+
+@* Initializing the scraps.
+If we are going to use the powerful production mechanism just developed, we
+must get the scraps set up in the first place, given a \CEE/ text. A table
+of the initial scraps corresponding to \CEE/ tokens appeared above in the
+section on parsing; our goal now is to implement that table. We shall do this
+by implementing a subroutine called |C_parse| that is analogous to the
+|C_xref| routine used during phase one.
+
+Like |C_xref|, the |C_parse| procedure starts with the current
+value of |next_control| and it uses the operation |next_control=get_next()|
+repeatedly to read \CEE/ text until encountering the next `\.{\v}' or
+`\.{/*}', or until |next_control>=format_code|. The scraps corresponding to
+what it reads are appended into the |cat| and |trans| arrays, and |scrap_ptr|
+is advanced.
+
+@c
+void
+C_parse(spec_ctrl) /* creates scraps from \CEE/ tokens */
+ eight_bits spec_ctrl;
+{
+ int count; /* characters remaining before string break */
+ while (next_control<format_code || next_control==spec_ctrl) {
+ @<Append the scrap appropriate to |next_control|@>;
+ next_control=get_next();
+ if (next_control=='|' || next_control==begin_comment ||
+ next_control==begin_short_comment) return;
+ }
+}
+
+@ The following macro is used to append a scrap whose tokens have just
+been appended:
+
+@d app_scrap(c,b) {
+ (++scrap_ptr)->cat=(c); scrap_ptr->trans=text_ptr;
+ scrap_ptr->mathness=5*(b); /* no no, yes yes, or maybe maybe */
+ freeze_text;
+}
+
+@ @<Append the scr...@>=
+@<Make sure that there is room for the new scraps, tokens, and texts@>;
+switch (next_control) {
+ case section_name:
+ app(section_flag+(int)(cur_section-name_dir));
+ app_scrap(section_scrap,maybe_math);
+ app_scrap(exp,yes_math);@+break;
+ case string: case constant: case verbatim: @<Append a string or constant@>;
+ @+break;
+ case identifier: app_cur_id(1);@+break;
+ case TeX_string: @<Append a \TEX/ string, without forming a scrap@>;@+break;
+ case '/': case '.':
+ app(next_control); app_scrap(binop,yes_math);@+break;
+ case '<': app_str("\\langle");@+app_scrap(prelangle,yes_math);@+break;
+@.\\langle@>
+ case '>': app_str("\\rangle");@+app_scrap(prerangle,yes_math);@+break;
+@.\\rangle@>
+ case '=': app_str("\\K"); app_scrap(binop,yes_math);@+break;
+@.\\K@>
+ case '|': app_str("\\OR"); app_scrap(binop,yes_math);@+break;
+@.\\OR@>
+ case '^': app_str("\\XOR"); app_scrap(binop,yes_math);@+break;
+@.\\XOR@>
+ case '%': app_str("\\MOD"); app_scrap(binop,yes_math);@+break;
+@.\\MOD@>
+ case '!': app_str("\\R"); app_scrap(unop,yes_math);@+break;
+@.\\R@>
+ case '~': app_str("\\CM"); app_scrap(unop,yes_math);@+break;
+@.\\CM@>
+ case '+': case '-': app(next_control); app_scrap(ubinop,yes_math);@+break;
+ case '*': app(next_control); app_scrap(raw_ubin,yes_math);@+break;
+ case '&': app_str("\\AND"); app_scrap(raw_ubin,yes_math);@+break;
+@.\\AND@>
+ case '?': app_str("\\?"); app_scrap(question,yes_math);@+break;
+@.\\?@>
+ case '#': app_str("\\#"); app_scrap(ubinop,yes_math);@+break;
+@.\\\#@>
+ case ignore: case xref_roman: case xref_wildcard:
+ case xref_typewriter: case noop:@+break;
+ case '(': case '[': app(next_control); app_scrap(lpar,maybe_math);@+break;
+ case ')': case ']': app(next_control); app_scrap(rpar,maybe_math);@+break;
+ case '{': app_str("\\{"@q}@>); app_scrap(lbrace,yes_math);@+break;
+@.\\\{@>@q}@>
+ case '}': app_str(@q{@>"\\}"); app_scrap(rbrace,yes_math);@+break;
+@q{@>@.\\\}@>
+ case ',': app(','); app_scrap(comma,yes_math);@+break;
+ case ';': app(';'); app_scrap(semi,maybe_math);@+break;
+ case ':': app(':'); app_scrap(colon,no_math);@+break;@/
+ @t\4@> @<Cases involving nonstandard characters@>@;
+ case thin_space: app_str("\\,"); app_scrap(insert,maybe_math);@+break;
+@.\\,@>
+ case math_break: app(opt); app_str("0");
+ app_scrap(insert,maybe_math);@+break;
+ case line_break: app(force); app_scrap(insert,no_math);@+break;
+ case left_preproc: app(force); app(preproc_line);
+ app_str("\\#"); app_scrap(lproc,no_math);@+break;
+@.\\\#@>
+ case right_preproc: app(force); app_scrap(rproc,no_math);@+break;
+ case big_line_break: app(big_force); app_scrap(insert,no_math);@+break;
+ case no_line_break: app(big_cancel); app(noop); app(break_space);
+ app(noop); app(big_cancel);
+ app_scrap(insert,no_math);@+break;
+ case pseudo_semi: app_scrap(semi,maybe_math);@+break;
+ case macro_arg_open: app_scrap(begin_arg,maybe_math);@+break;
+ case macro_arg_close: app_scrap(end_arg,maybe_math);@+break;
+ case join: app_str("\\J"); app_scrap(insert,no_math);@+break;
+@.\\J@>
+ case output_defs_code: app(force); app_str("\\ATH"); app(force);
+ app_scrap(insert,no_math);@+break;
+@.\\ATH@>
+ default: app(inserted); app(next_control);
+ app_scrap(insert,maybe_math);@+break;
+}
+
+@ @<Make sure that there is room for the new...@>=
+if (scrap_ptr+safe_scrap_incr>scrap_info_end ||
+ tok_ptr+safe_tok_incr>tok_mem_end @| ||
+ text_ptr+safe_text_incr>tok_start_end) {
+ if (scrap_ptr>max_scr_ptr) max_scr_ptr=scrap_ptr;
+ if (tok_ptr>max_tok_ptr) max_tok_ptr=tok_ptr;
+ if (text_ptr>max_text_ptr) max_text_ptr=text_ptr;
+ overflow("scrap/token/text");
+}
+
+@ Some nonstandard characters may have entered \.{CWEAVE} by means of
+standard ones. They are converted to \TEX/ control sequences so that it is
+possible to keep \.{CWEAVE} from outputting unusual |char| codes.
+
+@<Cases involving nonstandard...@>=
+case not_eq: app_str("\\I");@+app_scrap(binop,yes_math);@+break;
+@.\\I@>
+case lt_eq: app_str("\\Z");@+app_scrap(binop,yes_math);@+break;
+@.\\Z@>
+case gt_eq: app_str("\\G");@+app_scrap(binop,yes_math);@+break;
+@.\\G@>
+case eq_eq: app_str("\\E");@+app_scrap(binop,yes_math);@+break;
+@.\\E@>
+case and_and: app_str("\\W");@+app_scrap(binop,yes_math);@+break;
+@.\\W@>
+case or_or: app_str("\\V");@+app_scrap(binop,yes_math);@+break;
+@.\\V@>
+case plus_plus: app_str("\\PP");@+app_scrap(unop,yes_math);@+break;
+@.\\PP@>
+case minus_minus: app_str("\\MM");@+app_scrap(unop,yes_math);@+break;
+@.\\MM@>
+case minus_gt: app_str("\\MG");@+app_scrap(binop,yes_math);@+break;
+@.\\MG@>
+case gt_gt: app_str("\\GG");@+app_scrap(binop,yes_math);@+break;
+@.\\GG@>
+case lt_lt: app_str("\\LL");@+app_scrap(binop,yes_math);@+break;
+@.\\LL@>
+case dot_dot_dot: app_str("\\,\\ldots\\,");@+app_scrap(raw_int,yes_math);
+ @+break;
+@.\\,@>
+@.\\ldots@>
+case colon_colon: app_str("\\DC");@+app_scrap(colcol,maybe_math);@+break;
+@.\\DC@>
+case period_ast: app_str("\\PA");@+app_scrap(binop,yes_math);@+break;
+@.\\PA@>
+case minus_gt_ast: app_str("\\MGA");@+app_scrap(binop,yes_math);@+break;
+@.\\MGA@>
+
+@ The following code must use |app_tok| instead of |app| in order to
+protect against overflow. Note that |tok_ptr+1<=max_toks| after |app_tok|
+has been used, so another |app| is legitimate before testing again.
+
+Many of the special characters in a string must be prefixed by `\.\\' so that
+\TEX/ will print them properly.
+@^special string characters@>
+
+@<Append a string or...@>=
+count= -1;
+if (next_control==constant) app_str("\\T{"@q}@>);
+@.\\T@>
+else if (next_control==string) {
+ count=20; app_str("\\.{"@q}@>);
+}
+@.\\.@>
+else app_str("\\vb{"@q}@>);
+@.\\vb@>
+while (id_first<id_loc) {
+ if (count==0) { /* insert a discretionary break in a long string */
+ app_str(@q(@>@q{@>"}\\)\\.{"@q}@>); count=20;
+@q(@>@.\\)@>
+ }
+@^high-bit character handling@>
+ if((eight_bits)(*id_first)>0177) {
+ app_tok(quoted_char);
+ app_tok((eight_bits)(*id_first++));
+ }
+ else {
+ switch (*id_first) {
+ case ' ':case '\\':case '#':case '%':case '$':case '^':
+ case '{': case '}': case '~': case '&': case '_': app('\\'); break;
+@.\\\ @>
+@.\\\\@>
+@.\\\#@>
+@.\\\%@>
+@.\\\$@>
+@.\\\^@>
+@.\\\{@>@q}@>
+@q{@>@.\\\}@>
+@.\\\~@>
+@.\\\&@>
+@.\\\_@>
+ case '@@': if (*(id_first+1)=='@@') id_first++;
+ else err_print("! Double @@ should be used in strings");
+@.Double @@ should be used...@>
+ }
+ app_tok(*id_first++);
+ }
+ count--;
+}
+app(@q{@>'}');
+app_scrap(exp,maybe_math);
+
+@ We do not make the \TEX/ string into a scrap, because there is no
+telling what the user will be putting into it; instead we leave it
+open, to be picked up by the next scrap. If it comes at the end of a
+section, it will be made into a scrap when |finish_C| is called.
+
+There's a known bug here, in cases where an adjacent scrap is
+|prelangle| or |prerangle|. Then the \TEX/ string can disappear
+when the \.{\\langle} or \.{\\rangle} becomes \.{<} or \.{>}.
+For example, if the user writes \.{\v x<@@ty@@>\v}, the \TEX/ string
+\.{\\hbox\{y\}} eventually becomes part of an |insert| scrap, which is combined
+with a |prelangle| scrap and eventually lost. The best way to work around
+this bug is probably to enclose the \.{@@t...@@>} in \.{@@[...@@]} so that
+the \TEX/ string is treated as an expression.
+@^bug, known@>
+
+@<Append a \TEX/ string, without forming a scrap@>=
+app_str("\\hbox{"@q}@>);
+@^high-bit character handling@>
+while (id_first<id_loc)
+ if((eight_bits)(*id_first)>0177) {
+ app_tok(quoted_char);
+ app_tok((eight_bits)(*id_first++));
+ }
+ else {
+ if (*id_first=='@@') id_first++;
+ app_tok(*id_first++);
+ }
+app(@q{@>'}');
+
+@ The function |app_cur_id| appends the current identifier to the
+token list; it also builds a new scrap if |scrapping==1|.
+
+@<Predec...@>=
+void app_cur_id();
+
+@ @c
+void
+app_cur_id(scrapping)
+boolean scrapping; /* are we making this into a scrap? */
+{
+ name_pointer p=id_lookup(id_first,id_loc,normal);
+ if (p->ilk<=custom) { /* not a reserved word */
+ app(id_flag+(int)(p-name_dir));
+ if (scrapping) app_scrap(p->ilk==func_template? ftemplate: exp,
+ p->ilk==custom? yes_math: maybe_math);
+@.\\NULL@>
+ } else {
+ app(res_flag+(int)(p-name_dir));
+ if (scrapping) {
+ if (p->ilk==alfop) app_scrap(ubinop,yes_math)@;
+ else app_scrap(p->ilk,maybe_math);
+ }
+ }
+}
+
+@ When the `\.{\v}' that introduces \CEE/ text is sensed, a call on
+|C_translate| will return a pointer to the \TEX/ translation of
+that text. If scraps exist in |scrap_info|, they are
+unaffected by this translation process.
+
+@c
+text_pointer
+C_translate()
+{
+ text_pointer p; /* points to the translation */
+ scrap_pointer save_base; /* holds original value of |scrap_base| */
+ save_base=scrap_base; scrap_base=scrap_ptr+1;
+ C_parse(section_name); /* get the scraps together */
+ if (next_control!='|') err_print("! Missing '|' after C text");
+@.Missing '|'...@>
+ app_tok(cancel); app_scrap(insert,maybe_math);
+ /* place a |cancel| token as a final ``comment'' */
+ p=translate(); /* make the translation */
+ if (scrap_ptr>max_scr_ptr) max_scr_ptr=scrap_ptr;
+ scrap_ptr=scrap_base-1; scrap_base=save_base; /* scrap the scraps */
+ return(p);
+}
+
+@ The |outer_parse| routine is to |C_parse| as |outer_xref|
+is to |C_xref|: It constructs a sequence of scraps for \CEE/ text
+until |next_control>=format_code|. Thus, it takes care of embedded comments.
+
+The token list created from within `\pb' brackets is output as an argument
+to \.{\\PB}, if the user has invoked \.{CWEAVE} with the \.{+e} flag.
+Although \.{cwebmac} ignores \.{\\PB}, other macro packages
+might use it to localize the special meaning of the macros that mark up
+program text.
+
+@d make_pb flags['e']
+
+@c
+void
+outer_parse() /* makes scraps from \CEE/ tokens and comments */
+{
+ int bal; /* brace level in comment */
+ text_pointer p, q; /* partial comments */
+ while (next_control<format_code)
+ if (next_control!=begin_comment && next_control!=begin_short_comment)
+ C_parse(ignore);
+ else {
+ boolean is_long_comment=(next_control==begin_comment);
+ @<Make sure that there is room for the new...@>;
+ app(cancel); app(inserted);
+ if (is_long_comment) app_str("\\C{"@q}@>);
+@.\\C@>
+ else app_str("\\SHC{"@q}@>);
+@.\\SHC@>
+ bal=copy_comment(is_long_comment,1); next_control=ignore;
+ while (bal>0) {
+ p=text_ptr; freeze_text; q=C_translate();
+ /* at this point we have |tok_ptr+6<=max_toks| */
+ app(tok_flag+(int)(p-tok_start));
+ if (make_pb) app_str("\\PB{");
+@.\\PB@>
+ app(inner_tok_flag+(int)(q-tok_start));
+ if (make_pb) app_tok('}');
+ if (next_control=='|') {
+ bal=copy_comment(is_long_comment,bal);
+ next_control=ignore;
+ }
+ else bal=0; /* an error has been reported */
+ }
+ app(force); app_scrap(insert,no_math);
+ /* the full comment becomes a scrap */
+ }
+}
+
+@* Output of tokens.
+So far our programs have only built up multi-layered token lists in
+\.{CWEAVE}'s internal memory; we have to figure out how to get them into
+the desired final form. The job of converting token lists to characters in
+the \TEX/ output file is not difficult, although it is an implicitly
+recursive process. Four main considerations had to be kept in mind when
+this part of \.{CWEAVE} was designed. (a) There are two modes of output:
+|outer| mode, which translates tokens like |force| into line-breaking
+control sequences, and |inner| mode, which ignores them except that blank
+spaces take the place of line breaks. (b) The |cancel| instruction applies
+to adjacent token or tokens that are output, and this cuts across levels
+of recursion since `|cancel|' occurs at the beginning or end of a token
+list on one level. (c) The \TEX/ output file will be semi-readable if line
+breaks are inserted after the result of tokens like |break_space| and
+|force|. (d) The final line break should be suppressed, and there should
+be no |force| token output immediately after `\.{\\Y\\B}'.
+
+@ The output process uses a stack to keep track of what is going on at
+different ``levels'' as the token lists are being written out. Entries on
+this stack have three parts:
+
+\yskip\hang |end_field| is the |tok_mem| location where the token list of a
+particular level will end;
+
+\yskip\hang |tok_field| is the |tok_mem| location from which the next token
+on a particular level will be read;
+
+\yskip\hang |mode_field| is the current mode, either |inner| or |outer|.
+
+\yskip\noindent The current values of these quantities are referred to
+quite frequently, so they are stored in a separate place instead of in the
+|stack| array. We call the current values |cur_end|, |cur_tok|, and
+|cur_mode|.
+
+The global variable |stack_ptr| tells how many levels of output are
+currently in progress. The end of output occurs when an |end_translation|
+token is found, so the stack is never empty except when we first begin the
+output process.
+
+@d inner 0 /* value of |mode| for \CEE/ texts within \TEX/ texts */
+@d outer 1 /* value of |mode| for \CEE/ texts in sections */
+
+@<Typed...@>= typedef int mode;
+typedef struct {
+ token_pointer end_field; /* ending location of token list */
+ token_pointer tok_field; /* present location within token list */
+ boolean mode_field; /* interpretation of control tokens */
+} output_state;
+typedef output_state *stack_pointer;
+
+@ @d cur_end cur_state.end_field /* current ending location in |tok_mem| */
+@d cur_tok cur_state.tok_field /* location of next output token in |tok_mem| */
+@d cur_mode cur_state.mode_field /* current mode of interpretation */
+@d init_stack stack_ptr=stack;cur_mode=outer /* initialize the stack */
+
+@<Global...@>=
+output_state cur_state; /* |cur_end|, |cur_tok|, |cur_mode| */
+output_state stack[stack_size]; /* info for non-current levels */
+stack_pointer stack_ptr; /* first unused location in the output state stack */
+stack_pointer stack_end=stack+stack_size-1; /* end of |stack| */
+stack_pointer max_stack_ptr; /* largest value assumed by |stack_ptr| */
+
+@ @<Set init...@>=
+max_stack_ptr=stack;
+
+@ To insert token-list |p| into the output, the |push_level| subroutine
+is called; it saves the old level of output and gets a new one going.
+The value of |cur_mode| is not changed.
+
+@c
+void
+push_level(p) /* suspends the current level */
+text_pointer p;
+{
+ if (stack_ptr==stack_end) overflow("stack");
+ if (stack_ptr>stack) { /* save current state */
+ stack_ptr->end_field=cur_end;
+ stack_ptr->tok_field=cur_tok;
+ stack_ptr->mode_field=cur_mode;
+ }
+ stack_ptr++;
+ if (stack_ptr>max_stack_ptr) max_stack_ptr=stack_ptr;
+ cur_tok=*p; cur_end=*(p+1);
+}
+
+@ Conversely, the |pop_level| routine restores the conditions that were in
+force when the current level was begun. This subroutine will never be
+called when |stack_ptr==1|.
+
+@c
+void
+pop_level()
+{
+ cur_end=(--stack_ptr)->end_field;
+ cur_tok=stack_ptr->tok_field; cur_mode=stack_ptr->mode_field;
+}
+
+@ The |get_output| function returns the next byte of output that is not a
+reference to a token list. It returns the values |identifier| or |res_word|
+or |section_code| if the next token is to be an identifier (typeset in
+italics), a reserved word (typeset in boldface), or a section name (typeset
+by a complex routine that might generate additional levels of output).
+In these cases |cur_name| points to the identifier or section name in
+question.
+
+@<Global...@>=
+name_pointer cur_name;
+
+@ @d res_word 0201 /* returned by |get_output| for reserved words */
+@d section_code 0200 /* returned by |get_output| for section names */
+
+@c
+eight_bits
+get_output() /* returns the next token of output */
+{
+ sixteen_bits a; /* current item read from |tok_mem| */
+ restart: while (cur_tok==cur_end) pop_level();
+ a=*(cur_tok++);
+ if (a>=0400) {
+ cur_name=a % id_flag + name_dir;
+ switch (a / id_flag) {
+ case 2: return(res_word); /* |a==res_flag+cur_name| */
+ case 3: return(section_code); /* |a==section_flag+cur_name| */
+ case 4: push_level(a % id_flag + tok_start); goto restart;
+ /* |a==tok_flag+cur_name| */
+ case 5: push_level(a % id_flag + tok_start); cur_mode=inner; goto restart;
+ /* |a==inner_tok_flag+cur_name| */
+ default: return(identifier); /* |a==id_flag+cur_name| */
+ }
+ }
+ return(a);
+}
+
+@ The real work associated with token output is done by |make_output|.
+This procedure appends an |end_translation| token to the current token list,
+and then it repeatedly calls |get_output| and feeds characters to the output
+buffer until reaching the |end_translation| sentinel. It is possible for
+|make_output| to be called recursively, since a section name may include
+embedded \CEE/ text; however, the depth of recursion never exceeds one
+level, since section names cannot be inside of section names.
+
+A procedure called |output_C| does the scanning, translation, and
+output of \CEE/ text within `\pb' brackets, and this procedure uses
+|make_output| to output the current token list. Thus, the recursive call
+of |make_output| actually occurs when |make_output| calls |output_C|
+while outputting the name of a section.
+@^recursion@>
+
+@c
+void
+output_C() /* outputs the current token list */
+{
+ token_pointer save_tok_ptr;
+ text_pointer save_text_ptr;
+ sixteen_bits save_next_control; /* values to be restored */
+ text_pointer p; /* translation of the \CEE/ text */
+ save_tok_ptr=tok_ptr; save_text_ptr=text_ptr;
+ save_next_control=next_control; next_control=ignore; p=C_translate();
+ app(inner_tok_flag+(int)(p-tok_start));
+ if (make_pb) {
+ out_str("\\PB{"); make_output(); out('}');
+@.\\PB@>
+ }@+else make_output(); /* output the list */
+ if (text_ptr>max_text_ptr) max_text_ptr=text_ptr;
+ if (tok_ptr>max_tok_ptr) max_tok_ptr=tok_ptr;
+ text_ptr=save_text_ptr; tok_ptr=save_tok_ptr; /* forget the tokens */
+ next_control=save_next_control; /* restore |next_control| to original state */
+}
+
+@ Here is \.{CWEAVE}'s major output handler.
+
+@<Predecl...@>=
+void make_output();
+
+@ @c
+void
+make_output() /* outputs the equivalents of tokens */
+{
+ eight_bits a, /* current output byte */
+ b; /* next output byte */
+ int c; /* count of |indent| and |outdent| tokens */
+ char scratch[longest_name]; /* scratch area for section names */
+ char *k, *k_limit; /* indices into |scratch| */
+ char *j; /* index into |buffer| */
+ char *p; /* index into |byte_mem| */
+ char delim; /* first and last character of string being copied */
+ char *save_loc, *save_limit; /* |loc| and |limit| to be restored */
+ name_pointer cur_section_name; /* name of section being output */
+ boolean save_mode; /* value of |cur_mode| before a sequence of breaks */
+ app(end_translation); /* append a sentinel */
+ freeze_text; push_level(text_ptr-1);
+ while (1) {
+ a=get_output();
+ reswitch: switch(a) {
+ case end_translation: return;
+ case identifier: case res_word: @<Output an identifier@>; break;
+ case section_code: @<Output a section name@>; break;
+ case math_rel: out_str("\\MRL{"@q}@>);
+@.\\MRL@>
+ case noop: case inserted: break;
+ case cancel: case big_cancel: c=0; b=a;
+ while (1) {
+ a=get_output();
+ if (a==inserted) continue;
+ if ((a<indent && !(b==big_cancel&&a==' ')) || a>big_force) break;
+ if (a==indent) c++; else if (a==outdent) c--;
+ else if (a==opt) a=get_output();
+ }
+ @<Output saved |indent| or |outdent| tokens@>;
+ goto reswitch;
+ case indent: case outdent: case opt: case backup: case break_space:
+ case force: case big_force: case preproc_line: @<Output a control,
+ look ahead in case of line breaks, possibly |goto reswitch|@>; break;
+ case quoted_char: out(*(cur_tok++));
+ case qualifier: break;
+ default: out(a); /* otherwise |a| is an ordinary character */
+ }
+ }
+}
+
+@ An identifier of length one does not have to be enclosed in braces, and it
+looks slightly better if set in a math-italic font instead of a (slightly
+narrower) text-italic font. Thus we output `\.{\\\v}\.{a}' but
+`\.{\\\\\{aa\}}'.
+
+@<Output an identifier@>=
+out('\\');
+if (a==identifier) {
+ if (cur_name->ilk==custom && !doing_format) {
+ custom_out:
+ for (p=cur_name->byte_start;p<(cur_name+1)->byte_start;p++)
+ out(*p=='_'? 'x': *p=='$'? 'X': *p);
+ break;
+ } else if (is_tiny(cur_name)) out('|')@;
+@.\\|@>
+ else { delim='.';
+ for (p=cur_name->byte_start;p<(cur_name+1)->byte_start;p++)
+ if (xislower(*p)) { /* not entirely uppercase */
+ delim='\\'; break;
+ }
+ out(delim);
+ }
+@.\\\\@>
+@.\\.@>
+}@+else if (cur_name->ilk==alfop) {
+ out('X');
+ goto custom_out;
+}@+else out('&'); /* |a==res_word| */
+@.\\\&@>
+if (is_tiny(cur_name)) {
+ if (isxalpha((cur_name->byte_start)[0]))
+ out('\\');
+ out((cur_name->byte_start)[0]);
+}
+else out_name(cur_name,1);
+
+@ The current mode does not affect the behavior of \.{CWEAVE}'s output routine
+except when we are outputting control tokens.
+
+@<Output a control...@>=
+if (a<break_space || a==preproc_line) {
+ if (cur_mode==outer) {
+ out('\\'); out(a-cancel+'0');
+@.\\1@>
+@.\\2@>
+@.\\3@>
+@.\\4@>
+@.\\8@>
+ if (a==opt) {
+ b=get_output(); /* |opt| is followed by a digit */
+ if (b!='0' || force_lines==0) out(b)@;
+ else out_str("{-1}"); /* |force_lines| encourages more \.{@@\v} breaks */
+ }
+ } else if (a==opt) b=get_output(); /* ignore digit following |opt| */
+ }
+else @<Look ahead for strongest line break, |goto reswitch|@>
+
+@ If several of the tokens |break_space|, |force|, |big_force| occur in a
+row, possibly mixed with blank spaces (which are ignored),
+the largest one is used. A line break also occurs in the output file,
+except at the very end of the translation. The very first line break
+is suppressed (i.e., a line break that follows `\.{\\Y\\B}').
+
+@<Look ahead for st...@>= {
+ b=a; save_mode=cur_mode; c=0;
+ while (1) {
+ a=get_output();
+ if (a==inserted) continue;
+ if (a==cancel || a==big_cancel) {
+ @<Output saved |indent| or |outdent| tokens@>;
+ goto reswitch; /* |cancel| overrides everything */
+ }
+ if ((a!=' ' && a<indent) || a==backup || a>big_force) {
+ if (save_mode==outer) {
+ if (out_ptr>out_buf+3 && strncmp(out_ptr-3,"\\Y\\B",4)==0)
+ goto reswitch;
+ @<Output saved |indent| or |outdent| tokens@>;
+ out('\\'); out(b-cancel+'0');
+@.\\5@>
+@.\\6@>
+@.\\7@>
+ if (a!=end_translation) finish_line();
+ }
+ else if (a!=end_translation && cur_mode==inner) out(' ');
+ goto reswitch;
+ }
+ if (a==indent) c++;
+ else if (a==outdent) c--;
+ else if (a==opt) a=get_output();
+ else if (a>b) b=a; /* if |a==' '| we have |a<b| */
+ }
+}
+
+@ @<Output saved...@>=
+ for (;c>0;c--) out_str("\\1");
+@.\\1@>
+ for (;c<0;c++) out_str("\\2");
+@.\\2@>
+
+@ The remaining part of |make_output| is somewhat more complicated. When we
+output a section name, we may need to enter the parsing and translation
+routines, since the name may contain \CEE/ code embedded in
+\pb\ constructions. This \CEE/ code is placed at the end of the active
+input buffer and the translation process uses the end of the active
+|tok_mem| area.
+
+@<Output a section name@>= {
+ out_str("\\X");
+@.\\X@>
+ cur_xref=(xref_pointer)cur_name->xref;
+ if (cur_xref->num==file_flag) {an_output=1; cur_xref=cur_xref->xlink;}
+ else an_output=0;
+ if (cur_xref->num>=def_flag) {
+ out_section(cur_xref->num-def_flag);
+ if (phase==3) {
+ cur_xref=cur_xref->xlink;
+ while (cur_xref->num>=def_flag) {
+ out_str(", ");
+ out_section(cur_xref->num-def_flag);
+ cur_xref=cur_xref->xlink;
+ }
+ }
+ }
+ else out('0'); /* output the section number, or zero if it was undefined */
+ out(':');
+ if (an_output) out_str("\\.{"@q}@>);
+@.\\.@>
+ @<Output the text of the section name@>;
+ if (an_output) out_str(@q{@>" }");
+ out_str("\\X");
+}
+
+@ @<Output the text...@>=
+sprint_section_name(scratch,cur_name);
+k=scratch;
+k_limit=scratch+strlen(scratch);
+cur_section_name=cur_name;
+while (k<k_limit) {
+ b=*(k++);
+ if (b=='@@') @<Skip next character, give error if not `\.{@@}'@>;
+ if (an_output)
+ switch (b) {
+ case ' ':case '\\':case '#':case '%':case '$':case '^':
+ case '{': case '}': case '~': case '&': case '_':
+ out('\\'); /* falls through */
+@.\\\ @>
+@.\\\\@>
+@.\\\#@>
+@.\\\%@>
+@.\\\$@>
+@.\\\^@>
+@.\\\{@>@q}@>
+@q{@>@.\\\}@>
+@.\\\~@>
+@.\\\&@>
+@.\\\_@>
+ default: out(b);
+ }
+ else if (b!='|') out(b)
+ else {
+ @<Copy the \CEE/ text into the |buffer| array@>;
+ save_loc=loc; save_limit=limit; loc=limit+2; limit=j+1;
+ *limit='|'; output_C();
+ loc=save_loc; limit=save_limit;
+ }
+}
+
+@ @<Skip next char...@>=
+if (*k++!='@@') {
+ printf("\n! Illegal control code in section name: <");
+@.Illegal control code...@>
+ print_section_name(cur_section_name); printf("> "); mark_error;
+}
+
+@ The \CEE/ text enclosed in \pb\ should not contain `\.{\v}' characters,
+except within strings. We put a `\.{\v}' at the front of the buffer, so that an
+error message that displays the whole buffer will look a little bit sensible.
+The variable |delim| is zero outside of strings, otherwise it
+equals the delimiter that began the string being copied.
+
+@<Copy the \CEE/ text into...@>=
+j=limit+1; *j='|'; delim=0;
+while (1) {
+ if (k>=k_limit) {
+ printf("\n! C text in section name didn't end: <");
+@.C text...didn't end@>
+ print_section_name(cur_section_name); printf("> "); mark_error; break;
+ }
+ b=*(k++);
+ if (b=='@@' || (b=='\\' && delim!=0))
+ @<Copy a quoted character into the buffer@>
+ else {
+ if (b=='\'' || b=='"')
+ if (delim==0) delim=b;
+ else if (delim==b) delim=0;
+ if (b!='|' || delim!=0) {
+ if (j>buffer+long_buf_size-3) overflow("buffer");
+ *(++j)=b;
+ }
+ else break;
+ }
+}
+
+@ @<Copy a quoted char...@>= {
+ if (j>buffer+long_buf_size-4) overflow("buffer");
+ *(++j)=b; *(++j)=*(k++);
+}
+
+@** Phase two processing.
+We have assembled enough pieces of the puzzle in order to be ready to specify
+the processing in \.{CWEAVE}'s main pass over the source file. Phase two
+is analogous to phase one, except that more work is involved because we must
+actually output the \TEX/ material instead of merely looking at the
+\.{CWEB} specifications.
+
+@<Predecl...@>=
+void phase_two();
+
+@ @c
+void
+phase_two() {
+reset_input(); if (show_progress) printf("\nWriting the output file...");
+@.Writing the output file...@>
+section_count=0; format_visible=1; copy_limbo();
+finish_line(); flush_buffer(out_buf,0,0); /* insert a blank line, it looks nice */
+while (!input_has_ended) @<Translate the current section@>;
+}
+
+@ The output file will contain the control sequence \.{\\Y} between non-null
+sections of a section, e.g., between the \TEX/ and definition parts if both
+are nonempty. This puts a little white space between the parts when they are
+printed. However, we don't want \.{\\Y} to occur between two definitions
+within a single section. The variables |out_line| or |out_ptr| will
+change if a section is non-null, so the following macros `|save_position|'
+and `|emit_space_if_needed|' are able to handle the situation:
+
+@d save_position save_line=out_line; save_place=out_ptr
+@d emit_space_if_needed if (save_line!=out_line || save_place!=out_ptr)
+ out_str("\\Y");
+ space_checked=1
+@.\\Y@>
+
+@<Global...@>=
+int save_line; /* former value of |out_line| */
+char *save_place; /* former value of |out_ptr| */
+int sec_depth; /* the integer, if any, following \.{@@*} */
+boolean space_checked; /* have we done |emit_space_if_needed|? */
+boolean format_visible; /* should the next format declaration be output? */
+boolean doing_format=0; /* are we outputting a format declaration? */
+boolean group_found=0; /* has a starred section occurred? */
+
+@ @<Translate the current section@>= {
+ section_count++;
+ @<Output the code for the beginning of a new section@>;
+ save_position;
+ @<Translate the \TEX/ part of the current section@>;
+ @<Translate the definition part of the current section@>;
+ @<Translate the \CEE/ part of the current section@>;
+ @<Show cross-references to this section@>;
+ @<Output the code for the end of a section@>;
+}
+
+@ Sections beginning with the \.{CWEB} control sequence `\.{@@\ }' start in the
+output with the \TEX/ control sequence `\.{\\M}', followed by the section
+number. Similarly, `\.{@@*}' sections lead to the control sequence `\.{\\N}'.
+In this case there's an additional parameter, representing one plus the
+specified depth, immediately after the \.{\\N}.
+If the section has changed, we put \.{\\*} just after the section number.
+
+@<Output the code for the beginning...@>=
+if (*(loc-1)!='*') out_str("\\M");
+@.\\M@>
+else {
+ while (*loc == ' ') loc++;
+ if (*loc=='*') { /* ``top'' level */
+ sec_depth = -1;
+ loc++;
+ }
+ else {
+ for (sec_depth=0; xisdigit(*loc);loc++)
+ sec_depth = sec_depth*10 + (*loc) -'0';
+ }
+ while (*loc == ' ') loc++; /* remove spaces before group title */
+ group_found=1;
+ out_str("\\N");
+@.\\N@>
+ {@+ char s[32];@+sprintf(s,"{%d}",sec_depth+1);@+out_str(s);@+}
+ if (show_progress)
+ printf("*%d",section_count); update_terminal; /* print a progress report */
+}
+out_str("{");out_section(section_count); out_str("}");
+
+@ In the \TEX/ part of a section, we simply copy the source text, except that
+index entries are not copied and \CEE/ text within \pb\ is translated.
+
+@<Translate the \T...@>= do {
+ next_control=copy_TeX();
+ switch (next_control) {
+ case '|': init_stack; output_C(); break;
+ case '@@': out('@@'); break;
+ case TeX_string: case noop:
+ case xref_roman: case xref_wildcard: case xref_typewriter:
+ case section_name: loc-=2; next_control=get_next(); /* skip to \.{@@>} */
+ if (next_control==TeX_string)
+ err_print("! TeX string should be in C text only"); break;
+@.TeX string should be...@>
+ case thin_space: case math_break: case ord:
+ case line_break: case big_line_break: case no_line_break: case join:
+ case pseudo_semi: case macro_arg_open: case macro_arg_close:
+ case output_defs_code:
+ err_print("! You can't do that in TeX text"); break;
+@.You can't do that...@>
+ }
+} while (next_control<format_code);
+
+@ When we get to the following code we have |next_control>=format_code|, and
+the token memory is in its initial empty state.
+
+@<Translate the d...@>=
+space_checked=0;
+while (next_control<=definition) { /* |format_code| or |definition| */
+ init_stack;
+ if (next_control==definition) @<Start a macro definition@>@;
+ else @<Start a format definition@>;
+ outer_parse(); finish_C(format_visible); format_visible=1;
+ doing_format=0;
+}
+
+@ The |finish_C| procedure outputs the translation of the current
+scraps, preceded by the control sequence `\.{\\B}' and followed by the
+control sequence `\.{\\par}'. It also restores the token and scrap
+memories to their initial empty state.
+
+A |force| token is appended to the current scraps before translation
+takes place, so that the translation will normally end with \.{\\6} or
+\.{\\7} (the \TEX/ macros for |force| and |big_force|). This \.{\\6} or
+\.{\\7} is replaced by the concluding \.{\\par} or by \.{\\Y\\par}.
+
+@<Predecl...@>=
+void finish_C();
+
+@ @c
+void
+finish_C(visible) /* finishes a definition or a \CEE/ part */
+ boolean visible; /* nonzero if we should produce \TEX/ output */
+{
+ text_pointer p; /* translation of the scraps */
+ if (visible) {
+ out_str("\\B"); app_tok(force); app_scrap(insert,no_math);
+ p=translate();
+@.\\B@>
+ app(tok_flag+(int)(p-tok_start)); make_output(); /* output the list */
+ if (out_ptr>out_buf+1)
+ if (*(out_ptr-1)=='\\')
+@.\\6@>
+@.\\7@>
+@.\\Y@>
+ if (*out_ptr=='6') out_ptr-=2;
+ else if (*out_ptr=='7') *out_ptr='Y';
+ out_str("\\par"); finish_line();
+ }
+ if (text_ptr>max_text_ptr) max_text_ptr=text_ptr;
+ if (tok_ptr>max_tok_ptr) max_tok_ptr=tok_ptr;
+ if (scrap_ptr>max_scr_ptr) max_scr_ptr=scrap_ptr;
+ tok_ptr=tok_mem+1; text_ptr=tok_start+1; scrap_ptr=scrap_info;
+ /* forget the tokens and the scraps */
+}
+
+@ Keeping in line with the conventions of the \CEE/ preprocessor (and
+otherwise contrary to the rules of \.{CWEB}) we distinguish here
+between the case that `\.(' immediately follows an identifier and the
+case that the two are separated by a space. In the latter case, and
+if the identifier is not followed by `\.(' at all, the replacement
+text starts immediately after the identifier. In the former case,
+it starts after we scan the matching `\.)'.
+
+@<Start a macro...@>= {
+ if (save_line!=out_line || save_place!=out_ptr || space_checked) app(backup);
+ if(!space_checked){emit_space_if_needed;save_position;}
+ app_str("\\D"); /* this will produce `\&{define }' */
+@.\\D@>
+ if ((next_control=get_next())!=identifier)
+ err_print("! Improper macro definition");
+@.Improper macro definition@>
+ else {
+ app('$'); app_cur_id(0);
+ if (*loc=='(')
+ reswitch: switch (next_control=get_next()) {
+ case '(': case ',': app(next_control); goto reswitch;
+ case identifier: app_cur_id(0); goto reswitch;
+ case ')': app(next_control); next_control=get_next(); break;
+ default: err_print("! Improper macro definition"); break;
+ }
+ else next_control=get_next();
+ app_str("$ "); app(break_space);
+ app_scrap(dead,no_math); /* scrap won't take part in the parsing */
+ }
+}
+
+@ @<Start a format...@>= {
+ doing_format=1;
+ if(*(loc-1)=='s' || *(loc-1)=='S') format_visible=0;
+ if(!space_checked){emit_space_if_needed;save_position;}
+ app_str("\\F"); /* this will produce `\&{format }' */
+@.\\F@>
+ next_control=get_next();
+ if (next_control==identifier) {
+ app(id_flag+(int)(id_lookup(id_first, id_loc,normal)-name_dir));
+ app(' ');
+ app(break_space); /* this is syntactically separate from what follows */
+ next_control=get_next();
+ if (next_control==identifier) {
+ app(id_flag+(int)(id_lookup(id_first, id_loc,normal)-name_dir));
+ app_scrap(exp,maybe_math); app_scrap(semi,maybe_math);
+ next_control=get_next();
+ }
+ }
+ if (scrap_ptr!=scrap_info+2) err_print("! Improper format definition");
+@.Improper format definition@>
+}
+
+@ Finally, when the \TEX/ and definition parts have been treated, we have
+|next_control>=begin_C|. We will make the global variable |this_section|
+point to the current section name, if it has a name.
+
+@<Global...@>=
+name_pointer this_section; /* the current section name, or zero */
+
+@ @<Translate the \CEE/...@>=
+this_section=name_dir;
+if (next_control<=section_name) {
+ emit_space_if_needed; init_stack;
+ if (next_control==begin_C) next_control=get_next();
+ else {
+ this_section=cur_section;
+ @<Check that '=' or '==' follows this section name, and
+ emit the scraps to start the section definition@>;
+ }
+ while (next_control<=section_name) {
+ outer_parse();
+ @<Emit the scrap for a section name if present@>;
+ }
+ finish_C(1);
+}
+
+@ The title of the section and an $\E$ or $\mathrel+\E$ are made
+into a scrap that should not take part in the parsing.
+
+@<Check that '='...@>=
+do next_control=get_next();
+ while (next_control=='+'); /* allow optional `\.{+=}' */
+if (next_control!='=' && next_control!=eq_eq)
+ err_print("! You need an = sign after the section name");
+@.You need an = sign...@>
+ else next_control=get_next();
+if (out_ptr>out_buf+1 && *out_ptr=='Y' && *(out_ptr-1)=='\\') app(backup);
+ /* the section name will be flush left */
+@.\\Y@>
+app(section_flag+(int)(this_section-name_dir));
+cur_xref=(xref_pointer)this_section->xref;
+if(cur_xref->num==file_flag) cur_xref=cur_xref->xlink;
+app_str("${}");
+if (cur_xref->num!=section_count+def_flag) {
+ app_str("\\mathrel+"); /*section name is multiply defined*/
+ this_section=name_dir; /*so we won't give cross-reference info here*/
+}
+app_str("\\E"); /* output an equivalence sign */
+@.\\E@>
+app_str("{}$");
+app(force); app_scrap(dead,no_math);
+ /* this forces a line break unless `\.{@@+}' follows */
+
+@ @<Emit the scrap...@>=
+if (next_control<section_name) {
+ err_print("! You can't do that in C text");
+@.You can't do that...@>
+ next_control=get_next();
+}
+else if (next_control==section_name) {
+ app(section_flag+(int)(cur_section-name_dir));
+ app_scrap(section_scrap,maybe_math);
+ next_control=get_next();
+}
+
+@ Cross references relating to a named section are given
+after the section ends.
+
+@<Show cross...@>=
+if (this_section>name_dir) {
+ cur_xref=(xref_pointer)this_section->xref;
+ if (cur_xref->num==file_flag){an_output=1;cur_xref=cur_xref->xlink;}
+ else an_output=0;
+ if (cur_xref->num>def_flag)
+ cur_xref=cur_xref->xlink; /* bypass current section number */
+ footnote(def_flag); footnote(cite_flag); footnote(0);
+}
+
+@ The |footnote| procedure gives cross-reference information about
+multiply defined section names (if the |flag| parameter is
+|def_flag|), or about references to a section name
+(if |flag==cite_flag|), or to its uses (if |flag==0|). It assumes that
+|cur_xref| points to the first cross-reference entry of interest, and it
+leaves |cur_xref| pointing to the first element not printed. Typical outputs:
+`\.{\\A101.}'; `\.{\\Us 370\\ET1009.}';
+`\.{\\As 8, 27\\*\\ETs64.}'.
+
+Note that the output of \.{CWEAVE} is not English-specific; users may
+supply new definitions for the macros \.{\\A}, \.{\\As}, etc.
+
+@<Predecl...@>=
+void footnote();
+
+@ @c
+void
+footnote(flag) /* outputs section cross-references */
+sixteen_bits flag;
+{
+ xref_pointer q; /* cross-reference pointer variable */
+ if (cur_xref->num<=flag) return;
+ finish_line(); out('\\');
+@.\\A@>
+@.\\Q@>
+@.\\U@>
+ out(flag==0? 'U': flag==cite_flag? 'Q': 'A');
+ @<Output all the section numbers on the reference list |cur_xref|@>;
+ out('.');
+}
+
+@ The following code distinguishes three cases, according as the number
+of cross-references is one, two, or more than two. Variable |q| points
+to the first cross-reference, and the last link is a zero.
+
+@<Output all the section numbers...@>=
+q=cur_xref; if (q->xlink->num>flag) out('s'); /* plural */
+while (1) {
+ out_section(cur_xref->num-flag);
+ cur_xref=cur_xref->xlink; /* point to the next cross-reference to output */
+ if (cur_xref->num<=flag) break;
+ if (cur_xref->xlink->num>flag) out_str(", "); /* not the last */
+ else {out_str("\\ET"); /* the last */
+@.\\ET@>
+ if (cur_xref != q->xlink) out('s'); /* the last of more than two */
+ }
+}
+
+@ @<Output the code for the end of a section@>=
+out_str("\\fi"); finish_line();
+@.\\fi@>
+flush_buffer(out_buf,0,0); /* insert a blank line, it looks nice */
+
+@** Phase three processing.
+We are nearly finished! \.{CWEAVE}'s only remaining task is to write out the
+index, after sorting the identifiers and index entries.
+
+If the user has set the |no_xref| flag (the \.{-x} option on the command line),
+just finish off the page, omitting the index, section name list, and table of
+contents.
+
+@<Predecl...@>=
+void phase_three();
+
+@ @c
+void
+phase_three() {
+if (no_xref) {
+ finish_line();
+ out_str("\\end");
+@.\\end@>
+ finish_line();
+}
+else {
+ phase=3; if (show_progress) printf("\nWriting the index...");
+@.Writing the index...@>
+ finish_line();
+ if ((idx_file=fopen(idx_file_name,"w"))==NULL)
+ fatal("! Cannot open index file ",idx_file_name);
+@.Cannot open index file@>
+ if (change_exists) {
+ @<Tell about changed sections@>; finish_line(); finish_line();
+ }
+ out_str("\\inx"); finish_line();
+@.\\inx@>
+ active_file=idx_file; /* change active file to the index file */
+ @<Do the first pass of sorting@>;
+ @<Sort and output the index@>;
+ finish_line(); fclose(active_file); /* finished with |idx_file| */
+ active_file=tex_file; /* switch back to |tex_file| for a tic */
+ out_str("\\fin"); finish_line();
+@.\\fin@>
+ if ((scn_file=fopen(scn_file_name,"w"))==NULL)
+ fatal("! Cannot open section file ",scn_file_name);
+@.Cannot open section file@>
+ active_file=scn_file; /* change active file to section listing file */
+ @<Output all the section names@>;
+ finish_line(); fclose(active_file); /* finished with |scn_file| */
+ active_file=tex_file;
+ if (group_found) out_str("\\con");@+else out_str("\\end");
+@.\\con@>
+@.\\end@>
+ finish_line();
+ fclose(active_file);
+}
+if (show_happiness) printf("\nDone.");
+check_complete(); /* was all of the change file used? */
+}
+
+@ Just before the index comes a list of all the changed sections, including
+the index section itself.
+
+@<Global...@>=
+sixteen_bits k_section; /* runs through the sections */
+
+@ @<Tell about changed sections@>= {
+ /* remember that the index is already marked as changed */
+ k_section=0;
+ while (!changed_section[++k_section]);
+ out_str("\\ch ");
+@.\\ch@>
+ out_section(k_section);
+ while (k_section<section_count) {
+ while (!changed_section[++k_section]);
+ out_str(", "); out_section(k_section);
+ }
+ out('.');
+}
+
+@ A left-to-right radix sorting method is used, since this makes it easy to
+adjust the collating sequence and since the running time will be at worst
+proportional to the total length of all entries in the index. We put the
+identifiers into 102 different lists based on their first characters.
+(Uppercase letters are put into the same list as the corresponding lowercase
+letters, since we want to have `$t<\\{TeX}<\&{to}$'.) The
+list for character |c| begins at location |bucket[c]| and continues through
+the |blink| array.
+
+@<Global...@>=
+name_pointer bucket[256];
+name_pointer next_name; /* successor of |cur_name| when sorting */
+name_pointer blink[max_names]; /* links in the buckets */
+
+@ To begin the sorting, we go through all the hash lists and put each entry
+having a nonempty cross-reference list into the proper bucket.
+
+@<Do the first pass...@>= {
+int c;
+for (c=0; c<=255; c++) bucket[c]=NULL;
+for (h=hash; h<=hash_end; h++) {
+ next_name=*h;
+ while (next_name) {
+ cur_name=next_name; next_name=cur_name->link;
+ if (cur_name->xref!=(char*)xmem) {
+ c=(eight_bits)((cur_name->byte_start)[0]);
+ if (xisupper(c)) c=tolower(c);
+ blink[cur_name-name_dir]=bucket[c]; bucket[c]=cur_name;
+ }
+ }
+}
+}
+
+@ During the sorting phase we shall use the |cat| and |trans| arrays from
+\.{CWEAVE}'s parsing algorithm and rename them |depth| and |head|. They now
+represent a stack of identifier lists for all the index entries that have
+not yet been output. The variable |sort_ptr| tells how many such lists are
+present; the lists are output in reverse order (first |sort_ptr|, then
+|sort_ptr-1|, etc.). The |j|th list starts at |head[j]|, and if the first
+|k| characters of all entries on this list are known to be equal we have
+|depth[j]==k|.
+
+@ @<Rest of |trans_plus| union@>=
+name_pointer Head;
+
+@ @d depth cat /* reclaims memory that is no longer needed for parsing */
+@d head trans_plus.Head /* ditto */
+@f sort_pointer int
+@d sort_pointer scrap_pointer /* ditto */
+@d sort_ptr scrap_ptr /* ditto */
+@d max_sorts max_scraps /* ditto */
+
+@<Global...@>=
+eight_bits cur_depth; /* depth of current buckets */
+char *cur_byte; /* index into |byte_mem| */
+sixteen_bits cur_val; /* current cross-reference number */
+sort_pointer max_sort_ptr; /* largest value of |sort_ptr| */
+
+@ @<Set init...@>=
+max_sort_ptr=scrap_info;
+
+@ The desired alphabetic order is specified by the |collate| array; namely,
+$|collate|[0]<|collate|[1]<\cdots<|collate|[100]$.
+
+@<Global...@>=
+eight_bits collate[102+128]; /* collation order */
+@^high-bit character handling@>
+
+@ We use the order $\hbox{null}<\.\ <\hbox{other characters}<{}$\.\_${}<
+\.A=\.a<\cdots<\.Z=\.z<\.0<\cdots<\.9.$ Warning: The collation mapping
+needs to be changed if ASCII code is not being used.
+@^ASCII code dependencies@>
+@^high-bit character handling@>
+
+We initialize |collate| by copying a few characters at a time, because
+some \CEE/ compilers choke on long strings.
+
+@<Set init...@>=
+collate[0]=0;
+strcpy(collate+1," \1\2\3\4\5\6\7\10\11\12\13\14\15\16\17");
+/* 16 characters + 1 = 17 */
+strcpy(collate+17,"\20\21\22\23\24\25\26\27\30\31\32\33\34\35\36\37");
+/* 16 characters + 17 = 33 */
+strcpy(collate+33,"!\42#$%&'()*+,-./:;<=>?@@[\\]^`{|}~_");
+/* 32 characters + 33 = 65 */
+strcpy(collate+65,"abcdefghijklmnopqrstuvwxyz0123456789");
+/* (26 + 10) characters + 65 = 101 */
+strcpy(collate+101,"\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217");
+/* 16 characters + 101 = 117 */
+strcpy(collate+117,"\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237");
+/* 16 characters + 117 = 133 */
+strcpy(collate+133,"\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257");
+/* 16 characters + 133 = 149 */
+strcpy(collate+149,"\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277");
+/* 16 characters + 149 = 165 */
+strcpy(collate+165,"\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317");
+/* 16 characters + 165 = 181 */
+strcpy(collate+181,"\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337");
+/* 16 characters + 181 = 197 */
+strcpy(collate+197,"\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357");
+/* 16 characters + 197 = 213 */
+strcpy(collate+213,"\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377");
+/* 16 characters + 213 = 229 */
+
+@ Procedure |unbucket| goes through the buckets and adds nonempty lists
+to the stack, using the collating sequence specified in the |collate| array.
+The parameter to |unbucket| tells the current depth in the buckets.
+Any two sequences that agree in their first 255 character positions are
+regarded as identical.
+
+@d infinity 255 /* $\infty$ (approximately) */
+
+@<Predecl...@>=
+void unbucket();
+
+@ @c
+void
+unbucket(d) /* empties buckets having depth |d| */
+eight_bits d;
+{
+ int c; /* index into |bucket|; cannot be a simple |char| because of sign
+ comparison below*/
+ for (c=100+128; c>= 0; c--) if (bucket[collate[c]]) {
+@^high-bit character handling@>
+ if (sort_ptr>=scrap_info_end) overflow("sorting");
+ sort_ptr++;
+ if (sort_ptr>max_sort_ptr) max_sort_ptr=sort_ptr;
+ if (c==0) sort_ptr->depth=infinity;
+ else sort_ptr->depth=d;
+ sort_ptr->head=bucket[collate[c]]; bucket[collate[c]]=NULL;
+ }
+}
+
+@ @<Sort and output...@>=
+sort_ptr=scrap_info; unbucket(1);
+while (sort_ptr>scrap_info) {
+ cur_depth=sort_ptr->depth;
+ if (blink[sort_ptr->head-name_dir]==0 || cur_depth==infinity)
+ @<Output index entries for the list at |sort_ptr|@>@;
+ else @<Split the list at |sort_ptr| into further lists@>;
+}
+
+@ @<Split the list...@>= {
+ eight_bits c;
+ next_name=sort_ptr->head;
+ do {
+ cur_name=next_name; next_name=blink[cur_name-name_dir];
+ cur_byte=cur_name->byte_start+cur_depth;
+ if (cur_byte==(cur_name+1)->byte_start) c=0; /* hit end of the name */
+ else {
+ c=(eight_bits) *cur_byte;
+ if (xisupper(c)) c=tolower(c);
+ }
+ blink[cur_name-name_dir]=bucket[c]; bucket[c]=cur_name;
+ } while (next_name);
+ --sort_ptr; unbucket(cur_depth+1);
+}
+
+@ @<Output index...@>= {
+ cur_name=sort_ptr->head;
+ do {
+ out_str("\\I");
+@.\\I@>
+ @<Output the name at |cur_name|@>;
+ @<Output the cross-references at |cur_name|@>;
+ cur_name=blink[cur_name-name_dir];
+ } while (cur_name);
+ --sort_ptr;
+}
+
+@ @<Output the name...@>=
+switch (cur_name->ilk) {
+ case normal: case func_template: if (is_tiny(cur_name)) out_str("\\|");
+ else {char *j;
+ for (j=cur_name->byte_start;j<(cur_name+1)->byte_start;j++)
+ if (xislower(*j)) goto lowcase;
+ out_str("\\."); break;
+lowcase: out_str("\\\\");
+ }
+ break;
+@.\\|@>
+@.\\.@>
+@.\\\\@>
+ case wildcard: out_str("\\9");@+ goto not_an_identifier;
+@.\\9@>
+ case typewriter: out_str("\\.");
+@.\\.@>
+ case roman: not_an_identifier: out_name(cur_name,0); goto name_done;
+ case custom: {char *j; out_str("$\\");
+ for (j=cur_name->byte_start;j<(cur_name+1)->byte_start;j++)
+ out(*j=='_'? 'x': *j=='$'? 'X': *j);
+ out('$');
+ goto name_done;
+ }
+ default: out_str("\\&");
+@.\\\&@>
+}
+out_name(cur_name,1);
+name_done:@;
+
+@ Section numbers that are to be underlined are enclosed in
+`\.{\\[}$\,\ldots\,$\.]'.
+
+@<Output the cross-references...@>=
+@<Invert the cross-reference list at |cur_name|, making |cur_xref| the head@>;
+do {
+ out_str(", "); cur_val=cur_xref->num;
+ if (cur_val<def_flag) out_section(cur_val);
+ else {out_str("\\["); out_section(cur_val-def_flag); out(']');}
+@.\\[@>
+ cur_xref=cur_xref->xlink;
+} while (cur_xref!=xmem);
+out('.'); finish_line();
+
+@ List inversion is best thought of as popping elements off one stack and
+pushing them onto another. In this case |cur_xref| will be the head of
+the stack that we push things onto.
+@<Global...@>=
+xref_pointer next_xref, this_xref;
+ /* pointer variables for rearranging a list */
+
+@ @<Invert the cross-reference list at |cur_name|, making |cur_xref| the head@>=
+this_xref=(xref_pointer)cur_name->xref; cur_xref=xmem;
+do {
+ next_xref=this_xref->xlink; this_xref->xlink=cur_xref;
+ cur_xref=this_xref; this_xref=next_xref;
+} while (this_xref!=xmem);
+
+@ The following recursive procedure walks through the tree of section names and
+prints them.
+@^recursion@>
+
+@<Predecl...@>=
+void section_print();
+
+@ @c
+void
+section_print(p) /* print all section names in subtree |p| */
+name_pointer p;
+{
+ if (p) {
+ section_print(p->llink); out_str("\\I");
+@.\\I@>
+ tok_ptr=tok_mem+1; text_ptr=tok_start+1; scrap_ptr=scrap_info; init_stack;
+ app(p-name_dir+section_flag); make_output();
+ footnote(cite_flag);
+ footnote(0); /* |cur_xref| was set by |make_output| */
+ finish_line();@/
+ section_print(p->rlink);
+ }
+}
+
+@ @<Output all the section names@>=section_print(root)
+
+@ Because on some systems the difference between two pointers is a |long|
+rather than an |int|, we use \.{\%ld} to print these quantities.
+
+@c
+void
+print_stats() {
+ printf("\nMemory usage statistics:\n");
+@.Memory usage statistics:@>
+ printf("%ld names (out of %ld)\n",
+ (long)(name_ptr-name_dir),(long)max_names);
+ printf("%ld cross-references (out of %ld)\n",
+ (long)(xref_ptr-xmem),(long)max_refs);
+ printf("%ld bytes (out of %ld)\n",
+ (long)(byte_ptr-byte_mem),(long)max_bytes);
+ printf("Parsing:\n");
+ printf("%ld scraps (out of %ld)\n",
+ (long)(max_scr_ptr-scrap_info),(long)max_scraps);
+ printf("%ld texts (out of %ld)\n",
+ (long)(max_text_ptr-tok_start),(long)max_texts);
+ printf("%ld tokens (out of %ld)\n",
+ (long)(max_tok_ptr-tok_mem),(long)max_toks);
+ printf("%ld levels (out of %ld)\n",
+ (long)(max_stack_ptr-stack),(long)stack_size);
+ printf("Sorting:\n");
+ printf("%ld levels (out of %ld)\n",
+ (long)(max_sort_ptr-scrap_info),(long)max_scraps);
+}
+
+@** Index.
+If you have read and understood the code for Phase III above, you know what
+is in this index and how it got here. All sections in which an identifier is
+used are listed with that identifier, except that reserved words are
+indexed only when they appear in format definitions, and the appearances
+of identifiers in section names are not indexed. Underlined entries
+correspond to where the identifier was declared. Error messages, control
+sequences put into the output, and a few
+other things like ``recursion'' are indexed here too.
diff --git a/Build/source/texk/web2c/cwebdir/cweb.1 b/Build/source/texk/web2c/cwebdir/cweb.1
new file mode 100644
index 00000000000..ad41c427ead
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweb.1
@@ -0,0 +1,138 @@
+.TH CWEB 1L 2002-Apr-13
+.
+.SH NAME
+ctangle, cweave \- translate CWEB to C and/or TeX
+.
+.SH SYNOPSIS
+.na
+.B ctangle
+[
+.B \-bhp
+] [
+.B +s
+] webfile[.w] [changefile[.ch]] [outputfile[.c]]
+.br
+.B cweave
+[
+.B \-befhpx
+] [
+.B +s
+] webfile[.w] [changefile[.ch]] [outputfile[.tex]]
+.ad
+.
+.SH DESCRIPTION
+The
+.I ctangle
+program converts a CWEB
+source document into a C\ program that may be compiled in the usual way.
+The output file includes #line specifications so that debugging can be
+done in terms of the CWEB source file.
+.PP
+The
+.I cweave
+program converts the same CWEB file into a TeX file that may be
+formatted and printed in the usual way.
+It takes appropriate care of typographic details like page
+layout and the use of indentation, italics, boldface, etc., and it supplies
+extensive cross-index information that it gathers automatically.
+.PP
+CWEB allows you to prepare a single
+document containing all the information that is needed both to produce
+a compilable C\ program and to produce a well-formatted document
+describing the program in as much detail as the writer may desire.
+The user of CWEB ought to be familiar with TeX as well as\ C.
+.PP
+The command line should have one, two, or three names on it.
+The first is taken as the CWEB file (and .w is added if there is no
+extension).
+If that file cannot be opened, the extension .web is tried instead.
+(But .w is recommended, since .web usually implies Pascal.)
+If there is a second name, it is a change file (and .ch is added if there is
+no extension).
+The change file overrides parts of the WEB file,
+as described in the documentation.
+If there is a third name, it overrides
+the default name of the output file, which is ordinarily the same as
+the name of the input file (but on the current directory) with the
+extension .c or .tex.
+.PP
+Options in the command line may be either turned off with\ \-
+(if they are on by default) or turned on with\ + (if they are off by
+default).
+In fact, the options are processed from left to right,
+so a sequence like -f\ +f corresponds to +f (which is the default).
+.PP
+The
+.B \-b
+option suppresses the banner line that normally appears on your terminal
+when ctangle or cweave begins.
+The
+.B \-h
+option suppresses the happy message that normally appears if the processing
+was successful.
+The
+.B \-p
+option suppresses progress reports (starred module numbers) as the processing
+takes place.
+If you say -bhp, you get nothing but error messages.
+.PP
+The
+.B +s
+option prints statistics about memory usage at the end of a run
+(assuming that the programs have been compiled with the -DSTAT switch).
+.PP
+There are three other options applicable to
+.I cweave
+only:
+.B \-f
+means do not force a newline after every statement in the formatted output.
+.B \-e
+inhibits the enclosure of C\ material formatted by
+.I cweave
+in brackets
+\ePB{...}.
+Such brackets are normally inserted so that special hooks
+can be used by
+.I cweb-latex
+and similar programs.
+.B \-x
+means omit the index and table of contents.
+.
+.SH FILES
+.TP
+/usr/local/lib/tex/inputs/cwebmac.tex
+TeX macros used by cweave output.
+.TP
+/usr/local/src/cweb/cwebman.tex
+The user manual.
+.TP
+/usr/local/src/cweb/examples/wc.w
+An introductory example.
+.TP
+/usr/local/src/cweb/examples/wmerge.w
+Patch program based on CWEB-style change files.
+.TP
+/usr/local/lib/cweb
+Directory for cweb "include" files.
+.
+.SH "SEE ALSO"
+.TP
+.I Literate Programming
+by D. E. Knuth
+.TP
+.I Weaving a Program
+by Wayne Sewell
+.TP
+.I The CWEB System of Structured Documentation
+by Donald E. Knuth and Silvio Levy (hardcopy version of cwebman.tex
+and the source code listings)
+.TP
+tex(1), cc(1)
+.
+.SH AUTHORS
+Don Knuth wrote WEB for TeX and Pascal.
+Silvio Levy designed and developed CWEB
+by adapting the WEB conventions to\ C and by recoding everything in CWEB.
+Knuth began using CWEB and made further refinements.
+Many other helpers are acknowledged in the CWEB manual.
+
diff --git a/Build/source/texk/web2c/cwebdir/cweb.el b/Build/source/texk/web2c/cwebdir/cweb.el
new file mode 100644
index 00000000000..b7cfb2ee535
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cweb.el
@@ -0,0 +1,215 @@
+;; This file contains extensions to GNU-Emacs, to wit:
+; (1) some WEB-oriented functions that are also of general use
+; (2) changes to the GNU-distributed TeX mode
+; (3) definitions of simple WEB and CWEB modes
+
+; To use: Put this in your EMACS-lisp library and say (load-library "cweb")
+; in your .emacs init file.
+
+; Contributed by Don Knuth, July 1990
+
+;; OK, here's part (1): some WEB-oriented functions whose main purpose is
+; to maintain a stack of module names that are "pending" as you are writing
+; a program. When you first think of a module that needs to be written later,
+; put it into the pending list (by typing CTL-Z instead of @> after the
+; name). Later you can say CTL-\ to retrieve a pending name (and if
+; you want to cycle through the pending names, ESC-y after CTL-\ will
+; do it, just as ESC-y works after a yank).
+; After you've said CTL-\, the current region is the name just removed from
+; the pending list. If you change your mind, you can put it back again by
+; saying ESC-\. If you had put it into the pending list by mistake, you
+; can get rid of it by using the normal CTL-W operation (kill-region).
+; The following code binds the new commands to CTL-Z, CTL-\, and ESC-\
+; in all modes. You may prefer other bindings, of course.
+; CTL-Z is normally "suspend emacs", but it is best not used when emacs
+; has its own window as it usually does nowadays; if you need the
+; old CTL-Z, you might rather bind it to CTL-X CTL-Z.
+; CTL-\ is normally undefined.
+; ESC-\ is normally "delete space", but ESC-space DEL does that easily too.
+
+(defvar pending-list nil
+ "List of strings (usually WEB module names) still pending.")
+
+(defun into-pending-list (beg end)
+ "Copy region into pending-list."
+ (interactive "r")
+ (indicate-region)
+ (setq pending-list (cons (buffer-substring beg end) pending-list)))
+
+(defun new-module-name-pending ()
+ "Insert @> to complete a module name, then put it into pending-list."
+ (interactive)
+ (insert "@>")
+ (push-mark)
+ (if (search-backward "@<" nil t)
+ (progn
+ (exchange-point-and-mark)
+ (into-pending-list (point) (mark))
+ )
+ (message "There's no @< to begin the module name!")))
+(global-set-key "\C-z" 'new-module-name-pending)
+
+(defun pop-pending-list (arg)
+ "Remove first element of pending-list and insert it as current region.
+With argument, put point at left; otherwise point will follow the insertion.
+Say \\[new-yank-pop] to replace this by another element of the list.
+Say \\[into-pending-list] to put it back in the list."
+ (interactive "*P")
+ (if (consp pending-list)
+ (progn
+ (push-mark (point))
+ (insert (car pending-list))
+ (setq pending-list (cdr pending-list))
+ (if arg
+ (exchange-point-and-mark)))
+ (message "Nothing is pending.")
+ (setq this-command nil)))
+(global-set-key "\C-\\" 'pop-pending-list)
+(global-set-key "\M-\\" 'into-pending-list)
+
+(defun new-yank-pop (arg)
+ "If previous command was \\[pop-pending-list], pop a different string;
+otherwise do an ordinary Meta-y."
+ (interactive "*p")
+ (if (eq last-command 'pop-pending-list)
+ (let (xch)
+ (setq xch (< (point) (mark)))
+ (setq pending-list (append pending-list
+ (list (buffer-substring (point) (mark)))))
+ (delete-region (point) (mark))
+ (setq this-command 'pop-pending-list)
+ (pop-pending-list xch))
+ (yank-pop arg)))
+(global-set-key "\M-y" 'new-yank-pop)
+
+(defun indicate-region ()
+ "Bounce cursor to mark and back again"
+ (let ((point-save (point)))
+ (unwind-protect
+ (progn (goto-char (mark))
+ (sit-for 0 300)) ;; wait 300 milliseconds
+ (goto-char point-save))))
+
+; I prefer to change the standard copy-region command to the following,
+; which gives me visual feedback about what I've copied to the kill ring:
+(defun indicate-and-copy-region (beg end)
+ "Indicate current region, then copy it to the kill ring."
+ (interactive "r")(indicate-region)(copy-region-as-kill beg end))
+(global-set-key "\M-w" 'indicate-and-copy-region)
+
+; Here's another convenient command, bound to the usually unused ESC-".
+(defun ditto (arg)
+ "Copy ARG characters from the line above."
+ (interactive "*p")
+ (let (ch)
+ (while (> arg 0)
+ (setq temporary-goal-column (current-column))
+ (save-excursion
+ (previous-line 1)
+ (setq ch (following-char)))
+ (insert ch)
+ (setq arg (1- arg)))))
+(global-set-key "\M-\"" 'ditto)
+
+;; OK, here's part (2): Changes to TeX mode.
+; The WEB modes below are very much like TeX mode, but some improvements were
+; desirable in TeX mode:
+; I made newline act as it does in indented-text mode, since this
+; works nicely for both TeX and WEB (Pascal or C code).
+; I made RET check for unmatched delimiters if it ends a paragraph.
+; Otherwise TeX mode remains as it was before.
+
+(setq TeX-mode-map (make-sparse-keymap))
+(define-key TeX-mode-map "\C-c\C-k" 'TeX-kill-job)
+(define-key TeX-mode-map "\C-c\C-l" 'TeX-recenter-output-buffer)
+(define-key TeX-mode-map "\C-c\C-q" 'TeX-show-print-queue)
+(define-key TeX-mode-map "\C-c\C-p" 'TeX-print)
+(define-key TeX-mode-map "\"" 'TeX-insert-quote)
+(define-key TeX-mode-map "\e}" 'up-list)
+(define-key TeX-mode-map "\e{" 'TeX-insert-braces)
+(define-key TeX-mode-map "\C-c\C-r" 'TeX-region)
+(define-key TeX-mode-map "\C-c\C-b" 'TeX-buffer)
+(define-key TeX-mode-map "\C-c\C-f" 'TeX-close-LaTeX-block)
+(define-key TeX-mode-map "\r" 'TeX-newline)
+(define-key TeX-mode-map "\t" 'indent-relative)
+(setq TeX-mode-hook '(lambda ()
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'indent-relative-maybe)))
+
+(defun TeX-newline (arg)
+"If previous character is newline and no ARG, check for unbalanced braces
+and/or dollar signs in previous paragraph. If ARG is \\[universal-argument],
+do a single newline; otherwise do ordinary newline."
+ (interactive "*P")
+ (if (and (eq (preceding-char) ?\n) (not arg))
+ (TeX-check-paragraph)
+ (if (listp arg)
+ (newline)
+ (newline arg))))
+
+(defun TeX-check-paragraph ()
+"Insert a newline following a newline, breaking a paragraph for TeX.
+Check for mismatched delimiters in paragraph being terminated."
+ (interactive)
+ (if (TeX-validate-paragraph
+ (save-excursion
+ (search-backward "\n\n" nil 'move)
+ (point))
+ (point))
+ (insert ?\n)
+ (insert ?\n)
+ (error "Mismatched delimiters in that paragraph?")))
+
+;; and now, part (3): WEB and CWEB modes.
+; These are like plain TeX mode except that the automatic conversion of
+; " to `` or '' is disabled. (Personally I never liked that feature anyway,
+; since it's easy to get used to typing `` and ''. In WEB modes, the
+; feature soon becomes intolerable, unless you never use string constants!)
+; Another thing distinguishing WEB mode from TeX is ESC-p and ESC-n, to
+; move to previous or next module. These keys are usually unbound, except
+; when processing email.
+
+(defun forward-module (arg)
+"Advance past next WEB module beginning; with ARG, repeat ARG times."
+ (interactive "p")
+ (move-to-module arg))
+(defun backward-module (arg)
+"Advance to previous WEB module beginning; with ARG, repeat ARG times."
+ (interactive "p")
+ (move-to-module (- arg)))
+(defun move-to-module (arg)
+ (while (> arg 0)
+ (re-search-forward "@ \\|@\\*\\|@\n")
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (re-search-backward "@ \\|@\\*\\|@\n")
+ (setq arg (1+ arg))))
+
+(defun web-mode ()
+ "Major mode like TeX mode plus \\[forward-module] and \\[backward-module]
+for relative module movement. The automatic \" feature is disabled."
+ (interactive)
+ (plain-tex-mode)
+ (local-set-key "\M-n" 'forward-module)
+ (local-set-key "\M-p" 'backward-module)
+ (local-set-key "\"" 'self-insert-command)
+ (setq mode-name "WEB")
+ (setq major-mode 'web-mode)
+ (run-hooks 'web-mode-hook))
+(setq auto-mode-alist (cons '("\\.web$" . web-mode) auto-mode-alist))
+
+(defun cweb-mode ()
+ "Major mode like TeX mode plus \\[forward-module] and \\[backward-module]
+for relative module movement. The automatic \" feature is disabled."
+ (interactive)
+ (plain-tex-mode)
+ (local-set-key "\M-n" 'forward-module)
+ (local-set-key "\M-p" 'backward-module)
+ (local-set-key "\"" 'self-insert-command)
+ (setq comment-start nil)
+ (modify-syntax-entry ?% "@")
+ (setq mode-name "CWEB")
+ (setq major-mode 'cweb-mode)
+ (run-hooks 'cweb-mode-hook))
+(setq auto-mode-alist (cons '("\\.w$" . cweb-mode) auto-mode-alist))
+(setq auto-mode-alist (cons '("\\.ch$" . cweb-mode) auto-mode-alist))
diff --git a/Build/source/texk/web2c/cwebdir/cwebmac.tex b/Build/source/texk/web2c/cwebdir/cwebmac.tex
new file mode 100644
index 00000000000..8eca77d71cd
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cwebmac.tex
@@ -0,0 +1,539 @@
+% standard macros for CWEB listings (in addition to plain.tex)
+% Version 3.64 --- February 2002
+\ifx\documentstyle\undefined\else\endinput\fi % LaTeX will use other macros
+\xdef\fmtversion{\fmtversion+CWEB3.64}
+\chardef\cwebversion=3 \chardef\cwebrevision=64
+\newif\ifpdf
+\ifx\pdf+\pdftrue\fi
+% Uncomment the following line if you want PDF goodies to be the default
+%\ifx\pdf-\else\pdftrue\fi
+\def\pdflinkcolor{0 0 1} % the RGB values for hyperlink color
+\newif\ifpdftex
+\ifx\pdfoutput\undefined \pdftexfalse \else\ifnum\pdfoutput=0 \pdftexfalse
+\else \pdftextrue \pdfoutput=1 \input pdfcolor \let\setcolor\pdfsetcolor \fi\fi
+\newif\ifacro \ifpdf\acrotrue\fi \ifpdftex\acrotrue\fi
+
+\let\:=\. % preserve a way to get the dot accent
+ % (all other accents will still work as usual)
+
+\parskip 0pt % no stretch between paragraphs
+\parindent 1em % for paragraphs and for the first line of C text
+
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps
+\def\CEE/{{\mc C\spacefactor1000}}
+\def\UNIX/{{\mc U\kern-.05emNIX\spacefactor1000}}
+\def\TEX/{\TeX}
+\def\CPLUSPLUS/{{\mc C\PP\spacefactor1000}}
+\def\Cee{\CEE/} % for backward compatibility
+\def\9#1{}
+ % with this definition of \9 you can say @:sort key}{TeX code@>
+ % to alphabetize an index entry by the sort key but format with the TeX code
+\font\eightrm=cmr8
+\let\sc=\eightrm % for smallish caps (NOT a caps-and-small-caps font)
+\let\mainfont=\tenrm
+\let\cmntfont\tenrm
+%\font\tenss=cmss10 \let\cmntfont\tenss % alternative comment font
+\font\titlefont=cmr7 scaled\magstep4 % title on the contents page
+\font\ttitlefont=cmtt10 scaled\magstep2 % typewriter type in title
+\font\tentex=cmtex10 % TeX extended character set (used in strings)
+\fontdimen7\tentex=0pt % no double space after sentences
+
+\def\\#1{\leavevmode\hbox{\it#1\/\kern.05em}} % italic type for identifiers
+\def\|#1{\leavevmode\hbox{$#1$}} % one-letter identifiers look better this way
+\def\&#1{\leavevmode\hbox{\bf
+ \def\_{\kern.04em\vbox{\hrule width.3em height .6pt}\kern.08em}%
+ #1\/\kern.05em}} % boldface type for reserved words
+\def\.#1{\leavevmode\hbox{\tentex % typewriter type for strings
+ \let\\=\BS % backslash in a string
+ \let\{=\LB % left brace in a string
+ \let\}=\RB % right brace in a string
+ \let\~=\TL % tilde in a string
+ \let\ =\SP % space in a string
+ \let\_=\UL % underline in a string
+ \let\&=\AM % ampersand in a string
+ \let\^=\CF % circumflex in a string
+ #1\kern.05em}}
+\def\){{\tentex\kern-.05em}\discretionary{\hbox{\tentex\BS}}{}{}}
+\def\AT{@} % at sign for control text (not needed in versions >= 2.9)
+\def\ATL{\par\noindent\bgroup\catcode`\_=12 \postATL} % print @l in limbo
+\def\postATL#1 #2 {\bf letter \\{\uppercase{\char"#1}}
+ tangles as \tentex "#2"\egroup\par}
+\def\noATL#1 #2 {}
+\def\noatl{\let\ATL=\noATL} % suppress output from @l
+\def\ATH{{\acrofalse\X\kern-.5em:Preprocessor definitions\X}}
+\let\PB=\relax % hook for program brackets |...| in TeX part or section name
+
+\chardef\AM=`\& % ampersand character in a string
+\chardef\BS=`\\ % backslash in a string
+\chardef\LB=`\{ % left brace in a string
+\chardef\RB=`\} % right brace in a string
+\def\SP{{\tt\char`\ }} % (visible) space in a string
+\chardef\TL=`\~ % tilde in a string
+\chardef\UL=`\_ % underline character in a string
+\chardef\CF=`\^ % circumflex character in a string
+
+\newbox\PPbox % symbol for ++
+\setbox\PPbox=\hbox{\kern.5pt\raise1pt\hbox{\sevenrm+\kern-1pt+}\kern.5pt}
+\def\PP{\copy\PPbox}
+\newbox\MMbox \setbox\MMbox=\hbox{\kern.5pt\raise1pt\hbox{\sevensy\char0
+ \kern-1pt\char0}\kern.5pt}
+\def\MM{\copy\MMbox}
+\newbox\MGbox % symbol for ->
+\setbox\MGbox=\hbox{\kern-2pt\lower3pt\hbox{\teni\char'176}\kern1pt}
+\def\MG{\copy\MGbox}
+\def\MRL#1{\mathrel{\let\K==#1}}
+%\def\MRL#1{\KK#1}\def\KK#1#2{\buildrel\;#1\over{#2}}
+\let\GG=\gg
+\let\LL=\ll
+\let\NULL=\Lambda
+\mathchardef\AND="2026 % bitwise and; also \& (unary operator)
+\let\OR=\mid % bitwise or
+\let\XOR=\oplus % bitwise exclusive or
+\def\CM{{\sim}} % bitwise complement
+\newbox\MODbox \setbox\MODbox=\hbox{\eightrm\%}
+\def\MOD{\mathbin{\copy\MODbox}}
+\def\DC{\kern.1em{::}\kern.1em} % symbol for ::
+\def\PA{\mathbin{.*}} % symbol for .*
+\def\MGA{\mathbin{\MG*}} % symbol for ->*
+\def\this{\&{this}}
+
+\newbox\bak \setbox\bak=\hbox to -1em{} % backspace one em
+\newbox\bakk\setbox\bakk=\hbox to -2em{} % backspace two ems
+
+\newcount\ind % current indentation in ems
+\def\1{\global\advance\ind by1\hangindent\ind em} % indent one more notch
+\def\2{\global\advance\ind by-1} % indent one less notch
+\def\3#1{\hfil\penalty#10\hfilneg} % optional break within a statement
+\def\4{\copy\bak} % backspace one notch
+\def\5{\hfil\penalty-1\hfilneg\kern2.5em\copy\bakk\ignorespaces}% optional break
+\def\6{\ifmmode\else\par % forced break
+ \hangindent\ind em\noindent\kern\ind em\copy\bakk\ignorespaces\fi}
+\def\7{\Y\6} % forced break and a little extra space
+\def\8{\hskip-\ind em\hskip 2em} % no indentation
+
+\newcount\gdepth % depth of current major group, plus one
+\newcount\secpagedepth
+\secpagedepth=3 % page breaks will occur for depths -1, 0, and 1
+\newtoks\gtitle % title of current major group
+\newskip\intersecskip \intersecskip=12pt minus 3pt % space between sections
+\let\yskip=\smallskip
+\def\?{\mathrel?}
+\def\note#1#2.{\Y\noindent{\hangindent2em%
+ \baselineskip10pt\eightrm#1~\ifacro{\pdfnote#2.}\else#2\fi.\par}}
+
+\newtoks\toksA \newtoks\toksB \newtoks\toksC \newtoks\toksD
+\newtoks\toksE \newtoks\toksF \newtoks\usersanitizer
+\newcount\countA \countA=0 \newcount\countB \countB=0
+\newcount\countC \countC=0
+\newif\iftokprocessed \newif\ifTnum \newif\ifinstr
+{\def\\{\global\let\spacechar= }\\ }
+
+\ifacro % The following are pdf macros
+\def\thewidth{\the\wd0 \space}
+\def\theheight{\the\ht\strutbox\space}
+\def\thedepth{\the\dp\strutbox\space}
+\ifpdftex
+ \ifx\pdfannotlink\undefined\let\pdfannotlink\pdfstartlink\fi% for pdfTeX 0.14
+ \def\pdflink#1#2{\hbox{\pdfannotlink height\ht\strutbox depth\dp\strutbox
+ attr{/Border [0 0 0]} goto num #1 \BlueGreen #1\Black\pdfendlink}}
+\else\def\pdflink#1#2{\setbox0=\hbox{\special{pdf: bc [ \pdflinkcolor ]}{#1}%
+ \special{pdf: ec}}\special{pdf: ann width \thewidth height \theheight
+ depth \thedepth << /Type /Annot /Subtype /Link
+ /Border [0 0 0] /A << /S /GoTo /D (#2) >> >>}\box0\relax}\fi
+\def\pdfnote#1.{\setbox0=\hbox{\toksA={#1.}\toksB={}\maketoks}\the\toksA}
+\def\firstsecno#1.{\setbox0=\hbox{\toksA={#1.}\toksB={}%
+ \def\makenote{\addtokens\toksB{\the\toksC}\def\makenote{\toksD={}
+ \toksC={}\let\space\empty}\makenote}\maketoks}}
+\def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks}
+\def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}%
+ \ifcat\noexpand\first0\countB=`#1\else\countB=0\fi\toksA={#2}}
+\def\maketoks{\expandafter\poptoks\the\toksA|ENDTOKS|%
+ \ifnum\countB>`9 \countB=0 \fi
+ \ifnum\countB<`0
+ \ifnum0=\countC\else\makenote\fi
+ \ifx\first.\let\next=\maketoksdone\else
+ \let\next=\maketoks
+ \addtokens\toksB{\the\toksD}
+ \ifx\first,\addtokens\toksB{\space}\fi
+ \fi
+ \else \addtokens\toksC{\the\toksD}\global\countC=1\let\next=\maketoks
+ \fi
+ \next
+}
+\def\makenote{\addtokens\toksB
+ {\noexpand\pdflink{\the\toksC}{\romannumeral\the\toksC}}\toksC={}\global\countC=0}
+\def\maketoksdone{\edef\st{\global\noexpand\toksA={\the\toksB}}\st}
+\def\pdfURL#1#2{\ifpdftex\pdfannotlink height\ht\strutbox depth\dp\strutbox
+ attr {/Border [0 0 0]} user { /Type /Action /Subtype /Link /A
+ << /S /URI /URI (#2) >>}\BlueGreen #1\Black \pdfendlink
+ \else \ifpdf{\setbox0=\hbox{\special{pdf: bc [ \pdflinkcolor ]}{#1}%
+ \special{pdf: ec}}\special{pdf: ann width \thewidth\space height \theheight
+ \space depth \thedepth\space << /Border [0 0 0]
+ /Type /Action /Subtype /Link /A << /S /URI /URI (#2) >> >>}\box0\relax}%
+ \else #1 ({\tt#2})\fi\fi}
+{\catcode`\~=12 \gdef\TILDE/{~}} % ~ in a URL
+{\catcode`\_=12 \gdef\UNDER/{_}} % _ in a URL
+\def\sanitizecommand#1#2{\addtokens\usersanitizer
+ {\noexpand\dosanitizecommand\noexpand#1{#2}}}
+\def\dosanitizecommand#1#2{\ifx\nxt#1\addF{#2}\fi}
+
+\catcode`\[=1 \catcode`\]=2 \catcode`\{=12 \catcode`\}=12
+ \def\lbchar[{] \def\rbchar[}]
+\catcode`\[=12 \catcode`\]=12 \catcode`\{=1 \catcode`\}=2
+\catcode`\~=12 \def\tildechar{~} \catcode`\~=13
+\catcode`\|=0 |catcode`|\=12 |def|bschar{\} |catcode`|\=0 \catcode`\|=12
+\def\makeoutlinetoks{\Tnumfalse\afterassignment\makeolproctok\let\nxt= }
+\def\makeolnexttok{\afterassignment\makeolproctok\let\nxt= }
+\def\makeolgobbletok{\afterassignment\makeolnexttok\let\nxt= }
+\def\addF#1{\addtokens\toksF{#1}\tokprocessedtrue}
+% now comes a routine to "sanitize" section names, for pdf outlines
+\def\makeolproctok{\tokprocessedfalse
+ \let\next\makeolnexttok % default
+ \ifx\nxt\outlinedone\let\next\outlinedone
+ \else\ifx{\nxt \else\ifx}\nxt \Tnumfalse \instrfalse % skip braces
+ \else\ifx$\nxt % or a $ sign
+ \else\ifx^\nxt \addF^\else\ifx_\nxt \addF_% sanitize ^ and _
+ \else\ifx\nxt\spacechar \addF\space
+ \else\if\noexpand\nxt\relax % we have a control sequence; is it one we know?
+ \ifx\nxt~\addF\space
+ \else\ifx\nxt\onespace\addF\space
+ \else\the\usersanitizer
+ \iftokprocessed\else\makeolproctokctli
+ \iftokprocessed\else\makeolproctokctlii
+ \iftokprocessed\else\makeolproctokctliii % if not recognised, skip it
+ \fi\fi\fi\fi\fi
+ \else % we don't have a control sequence, it's an ordinary char
+ \ifx/\nxt \addF{\string\/}% quote chars special to PDF with backslash
+ \else\ifx(\nxt \addF{\string\(}\else\ifx)\nxt \addF{\string\)}%
+ \else\ifx[\nxt \addF{\string\[}\else\ifx]\nxt \addF{\string\]}%
+ \else\expandafter\makeolproctokchar\meaning\nxt
+ \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
+ \next
+}
+\def\makeolproctokchar#1 #2 #3{\addF{#3}}
+\def\makeolproctokctli{%
+ \ifx\nxt\CEE\addF{C}\let\next\makeolgobbletok % \CEE/
+ \else\ifx\nxt\UNIX\addF{UNIX}\let\next\makeolgobbletok % \UNIX/
+ \else\ifx\nxt\TEX\addF{TeX}\let\next\makeolgobbletok % \TEX/
+ \else\ifx\nxt\TeX\addF{TeX}\else\ifx\nxt\LaTeX\addF{LaTeX}%
+ \else\ifx\nxt\CPLUSPLUS\addF{C++}\let\next\makeolgobbletok % \CPLUSPLUS/
+ \else\ifx\nxt\Cee\addF{C}%
+ \else\ifx\nxt\PB \let\next\makeolgobbletok \tokprocessedtrue % \PB{...}
+ \else\ifx\nxt\.\tokprocessedtrue\instrtrue % \.{...}
+ % skip \|
+ \else\ifx\nxt\\\ifinstr\addF{\bschar\bschar}\else\tokprocessedtrue\fi
+ \else\ifx\nxt\&\ifinstr\addF&\else\tokprocessedtrue\fi
+ \else\ifx\nxt\~\ifTnum\addF{0}\else\addF\tildechar\fi % 077->\T{\~77}
+ \else\ifx\nxt\_\ifTnum\addF{E}\else\addF_\fi % 0.1E5->\T{0.1\_5}
+ \else\ifx\nxt\^\ifTnum\addF{0x}\else\addF^\fi % 0x77 -> \T{\^77}
+ \else\ifx\nxt\$\ifTnum\tokprocessedtrue\else\addF$\fi % \T{77\$L}
+ \else\ifx\nxt\{\addF\lbchar \else\ifx\nxt\}\addF\rbchar
+ \else\ifx\nxt\ \addF\space \else\ifx\nxt\#\addF{\string\#}%
+ \else\ifx\nxt\PP\addF{++}\else\ifx\nxt\MM\addF{--}%
+ \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
+}
+\def\makeolproctokctlii{%
+ \ifx\nxt\MG\addF{->}\else\ifx\nxt\GG\addF{>>}%
+ \else\ifx\nxt\LL\addF{<<}\else\ifx\nxt\NULL\addF{NULL}%
+ \else\ifx\nxt\AND\addF&\else\ifx\nxt\OR\addF|%
+ \else\ifx\nxt\XOR\addF^\else\ifx\nxt\CM\addF\tildechar
+ \else\ifx\nxt\MOD\addF{\string\%}\else\ifx\nxt\DC\addF{::}%
+ \else\ifx\nxt\PA\addF{.*}\else\ifx\nxt\MGA\addF{->*}%
+ \else\ifx\nxt\this\addF{this}\else\ifx\nxt\?\addF?%
+ \else\ifx\nxt\E\addF{==}\else\ifx\nxt\G\addF{>=}%
+ \else\ifx\nxt\I\addF{!=}\else\ifx\nxt\K\addF{=}%
+ \else\ifx\nxt\l\addF{l}\else\ifx\nxt\L\addF{L}%
+ \else\ifx\nxt\o\addF{o}\else\ifx\nxt\O\addF{O}%
+ \else\ifx\nxt\R\addF!%
+ \else\ifx\nxt\T \Tnumtrue \let\next\makeolgobbletok
+ \tokprocessedtrue % \T{number}
+ \else\ifx\nxt\AM\addF&\else\ifx\nxt\%\addF{\string\%}%
+ \fi\fi\fi\fi\fi \fi\fi\fi\fi\fi
+ \fi\fi\fi\fi\fi \fi\fi\fi\fi\fi
+ \fi\fi\fi\fi\fi\fi
+}
+\def\makeolproctokctliii{%
+ \ifx\nxt\V\addF{||}\else\ifx\nxt\W\addF{&&}\else\ifx\nxt\Z\addF{<=}%
+ \else\ifx\nxt\*\addF*\else\ifx\nxt\Xand\addF{\space and\space}%
+ \else\ifx\nxt\Xandxeq\addF{\space and_eq\space}%
+ \else\ifx\nxt\Xbitand\addF{\space bitand\space}%
+ \else\ifx\nxt\Xbitor\addF{\space bitor\space}%
+ \else\ifx\nxt\Xcompl\addF{\space compl\space}%
+ \else\ifx\nxt\Xnot\addF{\space not\space}%
+ \else\ifx\nxt\Xnotxeq\addF{\space not_eq\space}%
+ \else\ifx\nxt\Xor\addF{\space or\space}%
+ \else\ifx\nxt\Xorxeq\addF{\space or_eq\space}%
+ \else\ifx\nxt\Xxor\addF{\space xor\space}%
+ \else\ifx\nxt\Xxorxeq\addF{\space xor_eq\space}%
+ \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
+ \fi\fi\fi\fi\fi
+}
+\def\outlinedone{\edef\outlinest{\global\noexpand\toksE={\the\toksF}}%
+ \outlinest\let\outlinedone=\relax}
+\fi % End of pdf macros
+
+\def\lapstar{\rlap{*}}
+\def\stsec{\rightskip=0pt % get out of C mode (cf. \B)
+ \sfcode`;=1500 \pretolerance 200 \hyphenpenalty 50 \exhyphenpenalty 50
+ \noindent{\let\*=\lapstar\bf\secstar.\quad}%
+ \ifpdftex\smash{\raise\baselineskip\hbox to0pt{%
+ \let\*=\empty\pdfdest num \secstar fith}}
+ \else\ifpdf\smash{\raise\baselineskip\hbox to0pt{%
+ \let\*=\empty\special{%
+ pdf: dest (\romannumeral\secstar) [ @thispage /FitH @ypos ]}}}\fi\fi}
+\let\startsection=\stsec
+\def\defin#1{\global\advance\ind by 2 \1\&{#1 } } % begin `define' or `format'
+\def\A{\note{See also section}} % xref for doubly defined section name
+\def\As{\note{See also sections}} % xref for multiply defined section name
+\def\B{\rightskip=0pt plus 100pt minus 10pt % go into C mode
+ \sfcode`;=3000
+ \pretolerance 10000
+ \hyphenpenalty 1000 % so strings can be broken (discretionary \ is inserted)
+ \exhyphenpenalty 10000
+ \global\ind=2 \1\ \unskip}
+\def\C#1{\5\5\quad$/\ast\,${\cmntfont #1}$\,\ast/$}
+\let\SHC\C % "// short comments" treated like "/* ordinary comments */"
+%\def\C#1{\5\5\quad$\triangleright\,${\cmntfont#1}$\,\triangleleft$}
+%\def\SHC#1{\5\5\quad$\diamond\,${\cmntfont#1}}
+\def\D{\defin{\#define}} % macro definition
+\let\E=\equiv % equivalence sign
+\def\ET{ and~} % conjunction between two section numbers
+\def\ETs{, and~} % conjunction between the last two of several section numbers
+\def\F{\defin{format}} % format definition
+\let\G=\ge % greater than or equal sign
+% \H is long Hungarian umlaut accent
+\let\I=\ne % unequal sign
+\def\J{\.{@\&}} % TANGLE's join operation
+\let\K== % assignment operator
+%\let\K=\leftarrow % "honest" alternative to standard assignment operator
+% \L is Polish letter suppressed-L
+\outer\def\M#1{\MN{#1}\ifon\vfil\penalty-100\vfilneg % beginning of section
+ \vskip\intersecskip\startsection\ignorespaces}
+\outer\def\N#1#2#3.{% beginning of starred section
+ \ifacro{\toksF={}\makeoutlinetoks#3\outlinedone\outlinedone}\fi
+ \gdepth=#1\gtitle={#3}\MN{#2}%
+ \ifon\ifnum#1<\secpagedepth \vfil\eject % force page break if depth is small
+ \else\vfil\penalty-100\vfilneg\vskip\intersecskip\fi\fi
+ \message{*\secno} % progress report
+ \def\stripprefix##1>{}\def\gtitletoks{#3}%
+ \edef\gtitletoks{\expandafter\stripprefix\meaning\gtitletoks}%
+ \edef\next{\write\cont{\ZZ{\gtitletoks}{#1}{\secno}% write to contents file
+ {\noexpand\the\pageno}{\the\toksE}}}\next % \ZZ{title}{depth}{sec}{page}{ss}
+ \ifpdftex\expandafter\xdef\csname curr#1\endcsname{\secno}
+ \ifnum#1>0\countB=#1 \advance\countB by-1
+ \advancenumber{chunk\the\countB.\expnumber{curr\the\countB}}\fi\fi
+ \ifpdf\special{pdf: outline #1 << /Title (\the\toksE) /Dest
+ [ @thispage /FitH @ypos ] >>}\fi
+ \ifon\startsection{\bf#3.\quad}\ignorespaces}
+\def\MN#1{\par % common code for \M, \N
+ {\xdef\secstar{#1}\let\*=\empty\xdef\secno{#1}}% remove \* from section name
+ \ifx\secno\secstar \onmaybe \else\ontrue \fi
+ \mark{{{\tensy x}\secno}{\the\gdepth}{\the\gtitle}}}
+% each \mark is {section reference or null}{depth plus 1}{group title}
+% \O is Scandinavian letter O-with-slash
+% \P is paragraph sign
+\def\Q{\note{This code is cited in section}} % xref for mention of a section
+\def\Qs{\note{This code is cited in sections}} % xref for mentions of a section
+\let\R=\lnot % logical not
+% \S is section sign
+\def\T#1{\leavevmode % octal, hex or decimal constant
+ \hbox{$\def\?{\kern.2em}%
+ \def\$##1{\egroup_{\,\rm##1}\bgroup}% suffix to constant
+ \def\_{\cdot 10^{\aftergroup}}% power of ten (via dirty trick)
+ \let\~=\oct \let\^=\hex {#1}$}}
+\def\U{\note{This code is used in section}} % xref for use of a section
+\def\Us{\note{This code is used in sections}} % xref for uses of a section
+\let\V=\lor % logical or
+\let\W=\land % logical and
+\def\X#1:#2\X{\ifmmode\gdef\XX{\null$\null}\else\gdef\XX{}\fi %$% section name
+ \XX$\langle\,${\let\I=\ne#2\eightrm\kern.5em
+ \ifacro{\pdfnote#1.}\else#1\fi}$\,\rangle$\XX}
+\def\Y{\par\yskip}
+\let\Z=\le
+\let\ZZ=\let % now you can \write the control sequence \ZZ
+\let\*=*
+
+\def\Xand{\W} \def\Xandxeq{\MRL{{\AND}{\K}}} \def\Xbitand{\AND}
+\def\Xbitor{\OR} \def\Xcompl{\CM} \def\Xnot{\R} \def\Xnotxeq{\I} \def\Xor{\V}
+\def\Xorxeq{\MRL{{\OR}{\K}}} \def\Xxor{\XOR} \def\Xxorxeq{\MRL{{\XOR}{\K}}}
+
+%\def\oct{\hbox{\rm\char'23\kern-.2em\it\aftergroup\?\aftergroup}} % WEB style
+%\def\hex{\hbox{\rm\char"7D\tt\aftergroup}} % WEB style
+\def\oct{\hbox{$^\circ$\kern-.1em\it\aftergroup\?\aftergroup}}% CWEB style
+\def\hex{\hbox{$^{\scriptscriptstyle\#}$\tt\aftergroup}} % CWEB style
+\def\vb#1{\leavevmode\hbox{\kern2pt\vrule\vtop{\vbox{\hrule
+ \hbox{\strut\kern2pt\.{#1}\kern2pt}}
+ \hrule}\vrule\kern2pt}} % verbatim string
+
+\def\onmaybe{\let\ifon=\maybe} \let\maybe=\iftrue
+\newif\ifon \newif\iftitle \newif\ifpagesaved
+
+\newif\ifheader
+\def\lheader{\headertrue\mainfont\the\pageno\eightrm\qquad\grouptitle
+ \hfill\title\qquad\mainfont\topsecno} % top line on left-hand pages
+\def\rheader{\headertrue\mainfont\topsecno\eightrm\qquad\title\hfill
+ \grouptitle\qquad\mainfont\the\pageno} % top line on right-hand pages
+\def\grouptitle{\let\i=I\let\j=J\uppercase\expandafter{\expandafter
+ \takethree\topmark}}
+\def\topsecno{\expandafter\takeone\topmark}
+\def\takeone#1#2#3{#1}
+\def\taketwo#1#2#3{#2}
+\def\takethree#1#2#3{#3}
+\def\nullsec{\eightrm\kern-2em} % the \kern-2em cancels \qquad in headers
+
+\let\page=\pagebody \raggedbottom
+% \def\page{\box255 }\normalbottom % faster, but loses plain TeX footnotes
+\def\normaloutput#1#2#3{\ifodd\pageno\hoffset=\pageshift\fi
+ \shipout\vbox{
+ \vbox to\fullpageheight{
+ \iftitle\global\titlefalse
+ \else\hbox to\pagewidth{\vbox to10pt{}\ifodd\pageno #3\else#2\fi}\fi
+ \vfill#1}} % parameter #1 is the page itself
+ \global\advance\pageno by1}
+
+\gtitle={\.{CWEB} output} % this running head is reset by starred sections
+\mark{\noexpand\nullsec0{\the\gtitle}}
+\def\title{\expandafter\uppercase\expandafter{\jobname}}
+\def\topofcontents{\centerline{\titlefont\title}\vskip.7in
+ \vfill} % this material will start the table of contents page
+\def\startpdf{\ifpdftex\pdfcatalog{/PageMode /UseOutlines}\else
+ \ifpdf{\special{pdf: docview << /PageMode /UseOutlines >>}}\fi\fi}
+\def\botofcontents{\vfill
+ \centerline{\covernote}} % this material will end the table of contents page
+\def\covernote{}
+\def\contentspagenumber{0} % default page number for table of contents
+\newdimen\pagewidth \pagewidth=6.5in % the width of each page
+\newdimen\pageheight \pageheight=8.7in % the height of each page
+\newdimen\fullpageheight \fullpageheight=9in % page height including headlines
+\newdimen\pageshift \pageshift=0in % shift righthand pages wrt lefthand ones
+\def\magnify#1{\mag=#1\pagewidth=6.5truein\pageheight=8.7truein
+ \fullpageheight=9truein\setpage}
+\def\setpage{\hsize\pagewidth\vsize\pageheight} % use after changing page size
+\def\contentsfile{\jobname.toc} % file that gets table of contents info
+\def\readcontents{\input \contentsfile}
+\def\readindex{\input \jobname.idx}
+\def\readsections{\input \jobname.scn}
+
+\newwrite\cont
+\output{\setbox0=\page % the first page is garbage
+ \openout\cont=\contentsfile
+ \write\cont{\catcode `\noexpand\@=11\relax} % \makeatletter
+ \global\output{\normaloutput\page\lheader\rheader}}
+\setpage
+\vbox to \vsize{} % the first \topmark won't be null
+
+\def\ch{\note{The following sections were changed by the change file:}
+ \let\*=\relax}
+\newbox\sbox % saved box preceding the index
+\newbox\lbox % lefthand column in the index
+\def\inx{\par\vskip6pt plus 1fil % we are beginning the index
+ \def\page{\box255 } \normalbottom
+ \write\cont{} % ensure that the contents file isn't empty
+ \write\cont{\catcode `\noexpand\@=12\relax} % \makeatother
+ \closeout\cont % the contents information has been fully gathered
+ \output{\ifpagesaved\normaloutput{\box\sbox}\lheader\rheader\fi
+ \global\setbox\sbox=\page \global\pagesavedtrue}
+ \pagesavedfalse \eject % eject the page-so-far and predecessors
+ \setbox\sbox\vbox{\unvbox\sbox} % take it out of its box
+ \vsize=\pageheight \advance\vsize by -\ht\sbox % the remaining height
+ \hsize=.5\pagewidth \advance\hsize by -10pt
+ % column width for the index (20pt between cols)
+ \parfillskip 0pt plus .6\hsize % try to avoid almost empty lines
+ \def\lr{L} % this tells whether the left or right column is next
+ \output{\if L\lr\global\setbox\lbox=\page \gdef\lr{R}
+ \else\normaloutput{\vbox to\pageheight{\box\sbox\vss
+ \hbox to\pagewidth{\box\lbox\hfil\page}}}\lheader\rheader
+ \global\vsize\pageheight\gdef\lr{L}\global\pagesavedfalse\fi}
+ \message{Index:}
+ \parskip 0pt plus .5pt
+ \outer\def\I##1, ##2.{\par\hangindent2em\noindent##1:\kern1em
+ \ifacro\pdfnote##2.\else##2\fi.} % index entry
+ \def\[##1]{$\underline{##1}$} % underlined index item
+ \rm \rightskip0pt plus 2.5em \tolerance 10000 \let\*=\lapstar
+ \hyphenpenalty 10000 \parindent0pt
+ \readindex}
+\def\fin{\par\vfill\eject % this is done when we are ending the index
+ \ifpagesaved\null\vfill\eject\fi % output a null index column
+ \if L\lr\else\null\vfill\eject\fi % finish the current page
+ \parfillskip 0pt plus 1fil
+ \def\grouptitle{NAMES OF THE SECTIONS}
+ \let\topsecno=\nullsec
+ \message{Section names:}
+ \output={\normaloutput\page\lheader\rheader}
+ \setpage
+ \def\note##1##2.{\quad{\eightrm##1~\ifacro{\pdfnote##2.}\else{##2}\fi.}}
+ \def\Q{\note{Cited in section}} % crossref for mention of a section
+ \def\Qs{\note{Cited in sections}} % crossref for mentions of a section
+ \def\U{\note{Used in section}} % crossref for use of a section
+ \def\Us{\note{Used in sections}} % crossref for uses of a section
+ \def\I{\par\hangindent 2em}\let\*=*
+ \ifacro \def\outsecname{Names of the sections} \let\Xpdf\X
+ \ifpdftex \makebookmarks \pdfdest name {NOS} fitb
+ \pdfoutline goto name {NOS} count -\secno {\outsecname}
+ \def\X##1:##2\X{\Xpdf##1:##2\X \firstsecno##1.%
+ {\toksF={}\makeoutlinetoks##2\outlinedone\outlinedone}%
+ \pdfoutline goto num \the\toksA \expandafter{\the\toksE}}
+ \else\ifpdf
+ \special{pdf: outline -1 << /Title (\outsecname)
+ /Dest [ @thispage /FitH @ypos ] >>}
+ \def\X##1:##2\X{\Xpdf##1:##2\X \firstsecno##1.%
+ {\toksF={}\makeoutlinetoks##2\outlinedone\outlinedone}%
+ \special{pdf: outline 0 << /Title (\the\toksE)
+ /A << /S /GoTo /D (\romannumeral\the\toksA) >> >>}}
+ \fi\fi\fi
+ \readsections}
+\def\makebookmarks{\let\ZZ=\writebookmarkline \readcontents\relax}
+\def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0%
+ \else \csname#1\endcsname \fi} % Petr Olsak's macros from texinfo.tex
+\def\advancenumber#1{\countA=\expnumber{#1}\relax \advance\countA by1
+ \expandafter\xdef\csname#1\endcsname{\the\countA}}
+\def\writebookmarkline#1#2#3#4#5{{%
+ \let\(=\let \let\)=\let \let\[=\let \let\]=\let \let\/=\let
+ \pdfoutline goto num #3 count -\expnumber{chunk#2.#3} {#5}}}
+\def\con{\par\vfill\eject % finish the section names
+% \ifodd\pageno\else\titletrue\null\vfill\eject\fi % for duplex printers
+ \rightskip 0pt \hyphenpenalty 50 \tolerance 200
+ \setpage \output={\normaloutput\page\lheader\rheader}
+ \titletrue % prepare to output the table of contents
+ \pageno=\contentspagenumber
+ \def\grouptitle{TABLE OF CONTENTS}
+ \message{Table of contents:}
+ \topofcontents \startpdf
+ \line{\hfil Section\hbox to3em{\hss Page}}
+ \let\ZZ=\contentsline
+ \readcontents\relax % read the contents info
+ \botofcontents \end} % print the contents page(s) and terminate
+\def\contentsline#1#2#3#4#5{\ifnum#2=0 \smallbreak\fi
+ \line{\consetup{#2}#1
+ \rm\leaders\hbox to .5em{.\hfil}\hfil
+ \ \ifacro\pdflink{#3}{\romannumeral#3}\else#3\fi\hbox to3em{\hss#4}}}
+\def\consetup#1{\ifcase#1 \bf % depth -1 (@**)
+ \or % depth 0 (@*)
+ \or \hskip2em % depth 1 (@*1)
+ \or \hskip4em \or \hskip6em \or \hskip8em \or \hskip10em % depth 2,3,4,5
+ \else \hskip12em \fi} % depth 6 or more
+\def\noinx{\let\inx=\end} % no indexes or table of contents
+\def\nosecs{\let\FIN=\fin \def\fin{\let\parfillskip=\end \FIN}}
+ % no index of section names or table of contents
+\def\nocon{\let\con=\end} % no table of contents
+\def\today{\ifcase\month\or
+ January\or February\or March\or April\or May\or June\or
+ July\or August\or September\or October\or November\or December\fi
+ \space\number\day, \number\year}
+\newcount\twodigits
+\def\hours{\twodigits=\time \divide\twodigits by 60 \printtwodigits
+ \multiply\twodigits by-60 \advance\twodigits by\time :\printtwodigits}
+\def\gobbleone1{}
+\def\printtwodigits{\advance\twodigits100
+ \expandafter\gobbleone\number\twodigits
+ \advance\twodigits-100 }
+\def\TeX{{\ifmmode\it\fi
+ \leavevmode\hbox{T\kern-.1667em\lower.424ex\hbox{E}\hskip-.125em X}}}
+\def\,{\relax\ifmmode\mskip\thinmuskip\else\thinspace\fi}
+\def\datethis{\def\startsection{\leftline{\sc\today\ at \hours}\bigskip
+ \let\startsection=\stsec\stsec}}
+ % say `\datethis' in limbo, to get your listing timestamped before section 1
+\def\datecontentspage{%
+ \def\topofcontents{\leftline{\sc\today\ at \hours}\bigskip
+ \centerline{\titlefont\title}\vfill}} % timestamps the contents page
diff --git a/Build/source/texk/web2c/cwebdir/cwebman.tex b/Build/source/texk/web2c/cwebdir/cwebman.tex
new file mode 100644
index 00000000000..49f43531d8c
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/cwebman.tex
@@ -0,0 +1,1761 @@
+% This file generates the user manual; TeX it, don't read it!
+
+\def\tangref{3} % where the main explanation of CTANGLing is given
+\input cwebmac
+\acrofalse\pdffalse\pdftexfalse
+\def\page{\box255 } \normalbottom
+\parskip 0pt plus 1pt
+\def\RA{\char'31 } % right arrow
+\def\hang{\hangindent 4em\ignorespaces}
+\font\eightrm=cmr8
+\font\ninerm=cmr9
+\font\ninett=cmtt9
+\font\eighttt=cmtt8
+\font\twelvett=cmtt12
+\font\quoterm=cmssq8
+\font\quoteit=cmssqi8
+\font\authorfont=cmr12
+\font\sectionfont=cmbx12
+
+\def\pb{\.{|...|}}
+\def\v{\.{\char'174}} % vertical (|) in typewriter font
+\def\lpile{\def\cr{\hfill\endline}\matrix} % I only use \lpile by itself
+\abovedisplayskip=.5\abovedisplayskip
+\belowdisplayskip=.5\belowdisplayskip
+\abovedisplayshortskip=.5\abovedisplayshortskip
+\belowdisplayshortskip=.5\belowdisplayshortskip
+\advance\baselineskip by -.5pt
+\advance\pageheight by \baselineskip % the manual just got a bit longer
+\advance\fullpageheight by \baselineskip
+\setpage
+
+\outer\def\section #1.{\penalty-500\bigskip
+ \centerline{\sectionfont\def\.##1{{\twelvett##1}} #1}\nobreak\vskip 6pt
+ \everypar{\hskip-\parindent\everypar{}}}
+
+\def\lheader{\mainfont\the\pageno\hfill\sc\runninghead\hfill}
+\def\rheader{\hfill\sc\runninghead\hfill\mainfont\the\pageno}
+\def\runninghead{{\tentt CWEB} USER MANUAL (VERSION 3.64)}
+
+% This verbatim mode assumes that ! marks are !! in the text being copied.
+\def\verbatim{\begingroup
+ \def\do##1{\catcode`##1=12 } \dospecials
+ \parskip 0pt \parindent 0pt \let\!=!
+ \catcode`\ =13 \catcode`\^^M=13
+ \tt \catcode`\!=0 \verbatimdefs \verbatimgobble}
+{\catcode`\^^M=13{\catcode`\ =13\gdef\verbatimdefs{\def^^M{\ \par}\let =\ }} %
+ \gdef\verbatimgobble#1^^M{}}
+
+\null\vfill
+\centerline{\titlefont The {\ttitlefont CWEB} System of
+ Structured Documentation}
+\vskip 18pt\centerline{(Version 3.64 --- February 2002)}
+\vskip 24pt
+\centerline{\authorfont Donald E. Knuth and Silvio Levy}
+\vfill
+
+\noindent
+\TeX\ is a trademark of the American Mathematical Society.
+
+\noindent
+Acrobat Reader is a trademark of Adobe Systems Incorporated.
+
+\bigskip\noindent
+The printed form of this manual is copyright \copyright\ 1994
+ by Addison-Wesley Publishing Company, Inc. All rights reserved.
+\smallskip\noindent
+The electronic form is copyright \copyright\ 1987, 1990, 1993, 2000
+ by Silvio Levy and Donald E. Knuth.
+
+\bigskip\noindent
+Permission is granted to make and distribute verbatim copies of the
+electronic form of this document provided that the electronic copyright
+notice and this permission notice are preserved on all copies.
+
+\smallskip\noindent
+Permission is granted to copy and distribute modified versions of the
+electronic form of this document under the conditions for verbatim copying,
+provided that the entire resulting derived work is distributed under the terms
+of a permission notice identical to this one.
+
+\smallskip\noindent
+Individuals may make copies of the documentation from the electronic files
+for their own personal use.
+
+\smallskip\noindent
+Internet page \.{http://www-cs-faculty.stanford.edu/\char`\~knuth/cweb.html}
+contains current info about \.{CWEB} and related topics.
+
+\pageno=0 \titletrue\eject
+
+\titletrue
+\centerline{\titlefont The {\ttitlefont CWEB} System of
+ Structured Documentation}
+
+\vskip 15pt plus 3pt minus 3pt
+\centerline{\authorfont Donald E. Knuth and Silvio Levy}
+
+\vskip 24pt plus 3pt minus 3pt
+\noindent
+This document describes a version of Don Knuth's \.{WEB} system,
+adapted to \CEE/ by Silvio Levy. Since its creation in 1987, \.{CWEB}
+has been revised and enhanced in various ways, by both Knuth and Levy.
+We now believe that its evolution is near an end; however, bug
+reports, suggestions and comments are still welcome, and
+should be sent to Levy (\.{levy@math.berkeley.edu}).
+
+Readers who are familiar with Knuth's memo ``The \.{WEB} System of Structured
+Documentation'' will be able
+to skim this material rapidly, because \.{CWEB} and \.{WEB} share
+the same philosophy and (essentially) the same syntax. In some respects
+\.{CWEB} is a simplification
+of \.{WEB}: for example, \.{CWEB} does not need \.{WEB}'s features
+for macro definition and string handling, because \CEE/ and its
+preprocessor already take care of macros and strings. Similarly, the \.{WEB}
+conventions of denoting octal and hexadecimal constants by \.{@'77}
+and \.{@"3f} are replaced by \CEE/'s conventions \.{077} and
+\.{0x3f}. All other features of \.{WEB} have been
+retained, and new features have been added.
+
+We thank all who contributed suggestions and criticism to
+the development of \.{CWEB}. We are especially grateful to Steve
+Avery, Nelson Beebe, Hans-Hermann Bode, Klaus Guntermann, Norman Ramsey,
+Joachim Schnitter, and Saroj Mahapatra,
+who contributed code, and to Cameron Smith, who
+made many suggestions improving the manual. Ramsey has made
+literate programming accessible to users of yet other languages by means of
+his \.{SPIDER} system [see {\sl Communications of the ACM\/ \bf32} (1989),
+1051--1055]. The book {\sl Literate Programming\/} by Knuth (1992) contains
+a comprehensive bibliography of related early work.
+Bode, Schnitter, and Mahapatra adapted \.{CWEB} so that it works
+for \CPLUSPLUS/ as well; therefore in the text below you can read \CPLUSPLUS/
+for \CEE/ if you so desire.
+
+\section Introduction.
+The philosophy behind \.{CWEB} is
+that programmers who want to provide the best
+possible documentation for their programs need two things
+simultaneously: a language like \TEX/ for formatting, and a language like
+\CEE/ for programming. Neither type of language can provide the
+best documentation by itself. But when both are appropriately combined, we
+obtain a system that is much more useful than either language separately.
+
+The structure of a software program may be thought of as a ``web'' that is
+made up of many interconnected pieces. To document such a program, we want
+to explain each individual part of the web and how it relates to its
+neighbors. The typographic tools provided by \TEX/ give us an opportunity
+to explain the local structure of each part by making that structure
+visible, and the programming tools provided by \CEE/ make it possible
+for us to specify the algorithms formally and unambiguously. By combining
+the two, we can develop a style of programming that maximizes our ability
+to perceive the structure of a complex piece of software, and at the same
+time the documented programs can be mechanically translated into a working
+software system that matches the documentation.
+
+The \.{CWEB} system consists of two programs named \.{CWEAVE} and \.{CTANGLE}.
+When writing a \.{CWEB} program the user keeps the
+\CEE/ code and the documentation in the same file, called the \.{CWEB}
+file and generally named \.{something.w}. The command
+`\.{cweave} \.{something}' creates an output file \.{something.tex}, which
+can then be fed to \TEX/, yielding a ``pretty printed'' version of
+\.{something.w} that correctly handles
+typographic details like page layout and the use of indentation,
+italics, boldface, and mathematical symbols. The typeset output also
+includes extensive cross-index
+information that is gathered automatically. Similarly, if you run the
+command `\.{ctangle} \.{something}' you will get a \CEE/ file \.{something.c},
+which can then be compiled to yield executable code.
+
+Besides providing a documentation tool, \.{CWEB} enhances the \CEE/
+language by providing the
+ability to permute pieces of the program text, so that a large system can
+be understood entirely in terms of small sections and their local
+interrelationships. The \.{CTANGLE} program is so named because it takes a
+given web and moves the sections from their web structure into the order
+required by \CEE/; the advantage of programming in \.{CWEB} is that the
+algorithms can be expressed in ``untangled'' form, with each section
+explained separately. The \.{CWEAVE} program is so named because it takes
+a given web and intertwines the \TEX/ and \CEE/ portions contained in
+each section, then it knits the whole fabric into a structured document.
+(Get it? Wow.) Perhaps there is some deep connection here with the fact
+that the German word for ``weave'' is ``{\it webe\/}'', and the
+corresponding Latin imperative is ``{\it texe\/}''!
+
+A user of \.{CWEB} should be fairly familiar with the \CEE/
+programming language. A minimal amount of acquaintance with \TEX/ is also
+desirable, but in fact it can be acquired as one uses \.{CWEB}, since
+straight text can be typeset in \TEX/ with virtually no knowledge of
+that language. To someone familiar with both \CEE/ and \TEX/ the amount of
+effort necessary to learn the commands of \.{CWEB} is small.
+
+\section Overview.
+Two kinds of material go into \.{CWEB} files: \TEX/ text and \CEE/ text.
+A programmer writing in \.{CWEB} should be thinking both of the
+documentation and of the \CEE/ program being created;
+i.e., the programmer should be instinctively aware of the different
+actions that \.{CWEAVE} and \.{CTANGLE} will perform on the \.{CWEB} file.
+\TEX/ text is essentially copied without change by \.{CWEAVE}, and it is
+entirely deleted by \.{CTANGLE}; the \TEX/ text is ``pure
+documentation.'' \CEE/ text, on the other hand, is formatted by
+\.{CWEAVE} and it is shuffled around by \.{CTANGLE}, according to rules that
+will become clear later. For now the important point to keep in mind is
+that there are two kinds of text. Writing \.{CWEB} programs is something
+like writing \TEX/ documents, but with an additional ``\CEE/ mode''
+that is added to \TEX/'s horizontal mode, vertical mode, and math mode.
+
+A \.{CWEB} file is built up from units called {\sl sections\/} that are more
+or less self-contained. Each section has three parts:
+
+\yskip\item{$\bullet$} A \TEX/ part, containing explanatory material about what
+is going on in the section.
+
+\item{$\bullet$} A middle part, containing macro definitions that serve as
+abbreviations for \CEE/ constructions that would be less comprehensible
+if written out in full each time. They are turned by \.{CTANGLE} into
+preprocessor macro definitions.
+
+\item{$\bullet$} A \CEE/ part, containing a piece of the program that
+\.{CTANGLE} will produce. This \CEE/ code should ideally be about a
+dozen lines long, so that it is easily comprehensible as a unit and so
+that its structure is readily perceived.
+
+\yskip\noindent The three parts of each section must appear in this order;
+i.e., the \TEX/ commentary must come first, then the middle part, and
+finally the \CEE/ code. Any of the parts may be empty.
+
+A section begins with either of the symbols `\.{@\ }' or `\.{@*}', where
+`\.{\ }' denotes a blank space. A section ends
+at the beginning of the next section (i.e., at the next
+`\.{@\ }' or `\.{@*}'), or at the end of the file, whichever comes first.
+The \.{CWEB} file may also contain material that is not part of any section
+at all, namely the text (if any) that occurs before the first section.
+Such text is said to be ``in limbo''; it is ignored by \.{CTANGLE}
+and copied essentially verbatim by \.{CWEAVE}, so its function is to
+provide any additional formatting instructions that may be desired in the
+\TEX/ output. Indeed, it is customary to begin a \.{CWEB} file with
+\TEX/ code in limbo that loads special fonts, defines special macros,
+changes the page sizes, and/or produces a title page.
+
+Sections are numbered consecutively, starting with 1. These numbers appear
+at the beginning of each section of the \TEX/ documentation output by
+\.{CWEAVE}, and they appear
+as bracketed comments at the beginning and end of the code generated by that
+section in the \CEE/ program output by \.{CTANGLE}.
+
+\section Section Names.
+Fortunately, you never mention these numbers yourself when you are writing
+in \.{CWEB}. You just say `\.{@\ }' or `\.{@*}' at the beginning of each
+new section, and the numbers are supplied automatically by \.{CWEAVE} and
+\.{CTANGLE}. As far as you are concerned, a section has a
+{\sl name\/} instead of a number; its name is specified by writing
+`\.{@<}' followed by \TEX/ text followed by `\.{@>}'. When \.{CWEAVE}
+outputs a section name, it replaces the `\.{@<}' and `\.{@>}' by
+angle brackets and inserts the section number in small type. Thus, when you
+read the output of \.{CWEAVE} it is easy to locate any section that is
+referred to in another section.
+
+For expository purposes, a section name should be a good description of the
+contents of that section; i.e., it should stand for the abstraction
+represented by the section. Then the section can be ``plugged into'' one or
+more other sections in such a way
+that unimportant details of its inner workings
+are suppressed. A section name therefore ought to be long enough to convey
+the necessary meaning.
+
+Unfortunately, it is laborious to type
+such long names over and over again, and it is also difficult to specify a
+long name twice in exactly the same way so that \.{CWEAVE} and \.{CTANGLE}
+will be able to match the names to the sections. To ameliorate this situation,
+\.{CWEAVE} and \.{CTANGLE} let you abbreviate a section name, so long as
+the full name appears somewhere in the \.{CWEB} file; you can type simply
+`\.{@<$\alpha$...@>}', where $\alpha$ is any string that is a prefix of
+exactly one section name appearing in the file. For example, `\.{@<Clear
+the arrays@>}' can be abbreviated to `\.{@<Clear...@>}' if no other section
+name begins with the five letters `\.{Clear}'. Elsewhere
+you might use the abbreviation `\.{@<Clear t...@>}', and so on.
+
+Section names must otherwise match character for character, except
+that consecutive characters of white space (spaces, tab marks, newlines, and/or
+form feeds) are treated as equivalent to a single space, and such spaces are
+deleted at the beginning and end of the name. Thus, `\.{@< Clear { }the
+arrays @>}' will also match the name in the previous example.
+Spaces following the ellipsis in abbreviations are ignored as well, but
+not those before, so that `\.{@<Clear t ...@>}' would not match
+`\.{@<Clear the arrays@>}'.
+
+\section What \.{CTANGLE} Does.
+We have said that a section begins with `\.{@\ }' or `\.{@*}', but we
+didn't say how it gets divided up into a \TEX/ part, a middle part,
+and a \CEE/ part. The middle part begins with the first appearance of
+`\.{@d}' or `\.{@f}' in the section, and the \CEE/ part begins with
+the first appearance of `\.{@c}' or `\.{@<section name@>=}'. In the
+latter case you are saying, in effect, that the section name stands
+for the \CEE/ text that follows. Alternatively, if the \CEE/ part
+begins with `\.{@c}' instead of a section name, the current section is
+said to be {\sl unnamed}.
+
+The construct `\.{@<section name@>}' can appear
+any number of times in the \CEE/ part of a section:
+Subsequent appearances indicate that a named section is being
+``used'' rather than ``defined.'' In other words, the
+\CEE/ code for the named section, presumably defined elsewhere, should be
+spliced in at this point in the \CEE/ program. Indeed,
+the main idea of \.{CTANGLE} is to make a \CEE/ program out of
+individual sections, named and unnamed. The exact way in which this is done
+is this: First all the macro definitions
+indicated by `\.{@d}' are turned into \CEE/ preprocessor macro definitions
+and copied at the beginning.
+Then the \CEE/ parts of unnamed sections are copied down,
+in order; this constitutes the first-order
+approximation to the text of the program. (There should be at least
+one unnamed section, otherwise there will be no program.) Then all section
+names that appear in the first-order approximation are replaced by the \CEE/
+parts of the corresponding sections, and this substitution process
+continues until no section names remain. All comments are removed, because
+the \CEE/ program is intended only for the eyes of the \CEE/ compiler.
+
+If the same name has been given to more than one section, the \CEE/ text
+for that name is obtained by putting together all of the \CEE/ parts in
+the corresponding sections. This feature is useful, for example, in a
+section named `Global variables', since one can then
+declare global variables in whatever sections those variables are
+introduced. When several sections have the same name, \.{CWEAVE} assigns the
+first section number as the number corresponding to that name, and it
+inserts a note at the bottom of that section telling the reader to `See
+also sections so-and-so'; this footnote gives the numbers of all the other
+sections having the same name as the present one. The \CEE/ text
+corresponding to a section is usually formatted by \.{CWEAVE} so that the
+output has an equivalence sign in place of the equals sign in the \.{CWEB}
+file; i.e., the output says `$\langle\,$section
+name$\,\rangle\equiv\null$\CEE/ text'. However, in the case of the second
+and subsequent appearances of a section with the same name, this `$\equiv$'
+sign is replaced by `$\mathrel+\equiv$', as an indication that the
+following \CEE/ text is being appended to the \CEE/ text of another section.
+
+As \.{CTANGLE} enters and leaves sections, it inserts preprocessor
+\.{\#line} commands into the \CEE/ output file. This means that
+when the compiler gives you error messages, or when you debug your program,
+the messages refer to line numbers in the \.{CWEB} file, and not in the
+\CEE/ file. In most cases you can therefore
+forget about the \CEE/ file altogether.
+
+\section What \.{CWEAVE} Does.
+The general idea of \.{CWEAVE} is to make a \.{.tex} file from the \.{CWEB}
+file in the following way: The first line of the \.{.tex} file
+tells \TEX/ to input a file with macros that
+define \.{CWEB}'s documentation conventions. The next lines of the file
+will be copied from whatever \TEX/ text is in limbo before the first
+section. Then comes the output for each section in turn, possibly
+interspersed with end-of-page marks. Finally, \.{CWEAVE} will generate a
+cross-reference index that lists each section number in which each \CEE/
+identifier appears, and it will also generate an alphabetized list
+of the section names, as well as a table of contents that
+shows the page and section numbers for each ``starred'' section.
+
+What is a ``starred'' section, you ask? A section that begins with `\.{@*}'
+instead of `\.{@\ }' is slightly special in that it denotes a new major
+group of sections. The `\.{@*}' should be followed by the title of this
+group, followed by a period. Such sections will always start on a new page
+in the \TEX/ output, and the group title will appear as a running headline
+on all subsequent pages until the next starred section. The title will also
+appear in the table of contents, and in boldface type at the beginning of
+its section. Caution: Do not use \TEX/ control sequences in such titles,
+unless you know that the \.{cwebmac} macros will do the right thing with
+them. The reason is that these titles are converted to uppercase when
+they appear as running heads, and they are converted to boldface when they
+appear at the beginning of their sections, and they are also written out to
+a table-of-contents file used for temporary storage while \TEX/ is
+working; whatever control sequences you use must be meaningful in all
+three of these modes.
+
+The \TEX/ output produced by \.{CWEAVE} for each section consists of
+the following: First comes the section number (e.g., `\.{\\M123.}'
+at the beginning of section 123, except that `\.{\\N}' appears in place of
+`\.{\\M}' at the beginning of a starred section). Then comes the
+\TEX/ part of the section, copied almost verbatim except as noted
+below. Then comes the middle part and the \CEE/ part, formatted
+so that there will be a little extra space between them if both are
+nonempty. The middle and \CEE/ parts are obtained by inserting
+a bunch of funny-looking \TEX/ macros into the \CEE/ program; these
+macros handle typographic details about fonts and proper math spacing,
+as well as line breaks and indentation.
+
+\section C Code in \TEX/ Text and Vice Versa.
+When you are typing \TEX/ text, you will probably want to make frequent
+reference to variables and other quantities in your \CEE/ code, and you
+will want those variables to have the same typographic treatment
+when they appear in your text as when they appear in your
+program. Therefore the \.{CWEB} language allows you to get the effect of
+\CEE/ editing within \TEX/ text, if you place `\.|' marks before and
+after the \CEE/ material. For example, suppose you want to say something
+like this:
+$$\hbox{ If \\{pa} is declared as `\&{int} ${}{*}\\{pa}$',
+the assignment $\\{pa}\K{\AND}\|a[\T{0}]$ makes \\{pa}
+point to the zeroth element of \|a.}$$
+The \TEX/ text would look like this in your \.{CWEB} file:
+$$\lpile{\.{If |pa| is declared as `|int *pa|', the}\cr
+\.{assignment |pa=\&a[0]| makes |pa| point
+to the zeroth element of |a|.}\cr}$$
+And \.{CWEAVE} translates this into something you are glad you didn't have
+to type:
+$$\lpile{\.{If \\\\\{pa\} is declared as
+ `\\\&\{int\} \$\{\}\{*\}\\\\\{pa\}\$',}\cr
+\.{the assignment \$\\\\\{pa\}\\K\{\\AND\}\\|a[\\T\{0\}]\$}\cr
+\.{makes \\\\\{pa\} point to the zeroth element of \\|a.}\cr}$$
+Incidentally, the cross-reference index that \.{CWEAVE} would make, in
+the presence of a comment like this, would include
+the current section number as one of the index entries for \\{pa},
+even though \\{pa} might not appear in the \CEE/ part of
+this section. Thus, the index covers references to identifiers in
+the explanatory comments as well as in the program itself; you will
+soon learn to appreciate this feature. However, the identifiers
+\&{int} and \|a\ would not be indexed,
+because \.{CWEAVE} does not make index entries for reserved words or
+single-letter identifiers. Such identifiers are felt to be so ubiquitous
+that it would be pointless to mention every place where they occur.
+
+Although a section begins with \TEX/ text and ends with \CEE/ text, we
+have noted that the dividing line isn't sharp, since \CEE/ text can be
+included in \TEX/ text if it is enclosed in `\pb'. Conversely, \TEX/ text
+appears frequently within \CEE/ text, because everything in
+comments (i.e., between \.{/*} and \.{*/}, or following \.{//})
+is treated as \TEX/ text.
+Likewise, the text of a section name consists of \TEX/ text, but
+the construct \.{@<section name@>} as a whole is expected to be found
+in \CEE/ text; thus, one typically goes back and forth
+between the \CEE/ and \TEX/ environments in a natural way, as in these
+examples:
+$$
+\displaylines{
+\hbox{\.{if} \.{(x==0)} \.{@<Empty} \.{the} \.{|buffer|} \.{array@>}} \cr
+\hbox{\.{...} \.{using} \.{the} \.{algorithm}
+\.{in} \.{|@<Empty} \.{the} \.{|buffer|} \.{array@>|.}} }
+$$
+The first of these excerpts
+would be found in the \CEE/ part of a section, into which the code
+from the section
+named ``Empty the \\{buffer} array'' is being spliced. The second excerpt
+would be found in the \TEX/ part of the section, and the named section
+is being ``cited'', rather than defined or used.
+(Note the `\pb' surrounding the section name in this case.)
+
+\section Macros.
+The control code \.{@d} followed by
+$$\\{identifier}\.{ }\hbox{\CEE/ text}\qquad\hbox{or by}\qquad
+\\{identifier}\.(\\{par}_1,\ldots,\\{par}_n\.{) }\hbox{\CEE/ text}$$
+(where there is no blank between the
+\\{identifier} and the parentheses in the second case) is
+transformed by \.{CTANGLE} into a preprocessor command, starting with
+\.{\#define}, which is printed at the top of the \CEE/ output file
+as explained earlier.
+
+A `\.{@d}' macro definition can go on for several lines, and the
+newlines don't have to be protected by backslashes, since \.{CTANGLE}
+itself inserts the backslashes. If
+for any reason you need a \.{\#define} command at a specific spot in
+your \CEE/ file, you can treat it as \CEE/ code, instead of as a
+\.{CWEB} macro; but then you do have to protect newlines yourself.
+
+\section Strings and constants.
+If you want a string to appear in the \CEE/ file, delimited by pairs of
+\.' or \." marks as usual, you can type it exactly so in the \.{CWEB} file,
+except that the character `\.@' should be typed `\.{@@}' (it becomes a
+control code, the only one that can appear in strings; see below).
+Strings should end on the same line as they begin, unless there's a
+backslash at the end of lines within them.
+
+\TEX/ and \CEE/ have different ways to refer to octal and hex constants,
+because \TEX/ is oriented to technical writing while \CEE/ is oriented to
+computer processing. In \TEX/ you
+make a constant octal or hexadecimal by prepending \.' or \.",
+respectively, to it; in \CEE/ the constant should be preceded by \.0
+or \.{0x}. In \.{CWEB} it seems reasonable to let each convention hold
+in its respective realm; so in \CEE/ text you get $40_8$ by typing
+`\.{040}', which \.{CTANGLE} faithfully copies into the \CEE/ file (for
+the compiler's benefit) and which \.{CWEAVE} prints as $\T{\~40}$.
+Similarly, \.{CWEAVE} prints the hexadecimal \CEE/ constant `\.{0x20}'
+as \T{\^20}. The use of italic font for octal digits and typewriter font
+for hexadecimal digits makes the meaning of such constants clearer in
+a document. For consistency, then, you
+should type `\.{|040|}' or `\.{|0x20|}'
+in the \TEX/ part of the section.
+
+\section Control codes.
+A \.{CWEB} {\sl control code\/}
+is a two-character combination of which the first is `\.@'.
+We've already seen the meaning of several control codes; it's time to
+list them more methodically.
+
+In the following list,
+the letters in brackets after a control code indicate in what contexts that
+code is allowed. $L$ indicates that the code is allowed in limbo; $T$
+(for \TEX/), $M$ (for middle), and $C$ (for \CEE/) mean that the code is
+allowed in each of the three parts of a section, at top level---that
+is, outside such constructs as `\pb' and section names. An arrow $\to$
+means that the control code terminates the present part of the \.{CWEB}
+file, and inaugurates the part indicated by the letter following the
+arrow. Thus $[LTMC\to T]$ next to \.{@\ } indicates that this control
+code can occur in limbo, or in any of the three parts of a section, and
+that it starts the (possibly empty) \TEX/ part of the following section.
+
+Two other abbreviations can occur in these brackets: The letter $r$ stands for
+{\it restricted context}, that is, material inside \CEE/ comments, section
+names, \CEE/ strings and control texts (defined below); the letter
+$c$ stands for {\it inner \CEE/ context}, that is, \CEE/ material
+inside `\pb' (including `\pb's inside comments, but not those
+occurring in other restricted contexts). An asterisk $*$ following
+the brackets means
+that the context from this control code to the matching \.{@>} is
+restricted.
+
+Control codes involving letters are case-insensitive; thus \.{@d} and
+\.{@D} are equivalent. Only the lowercase versions are mentioned
+specifically below.
+
+\gdef\@#1[#2] {\penalty-50\yskip\hangindent 2em\noindent\.{@#1\unskip
+ \spacefactor1000{ }}$[#2]$\quad}
+\def\more{\hangindent 2em \hangafter0}
+\def\subsec{\penalty-300\medskip\noindent}
+
+\@@ [LTMCrc] A double \.@ denotes the single character `\.@'. This is
+the only control code that is legal everywhere.
+Note that you must use this convention if you are giving an internet
+email address in a \.{CWEB} file (e.g., \.{levy@@math.berkeley.edu}).
+
+\subsec
+Here are the codes that introduce the \TEX/ part of a section.
+
+\@\ [LTMC\to T] This denotes the beginning of a new (unstarred)
+section. A tab mark or form feed or
+end-of-line character is equivalent to a space when it follows an \.@
+sign (and in most other cases).
+
+\@* [LTMC\to T] This denotes the beginning of a new starred
+section, i.e., a section that begins a new major group. The title of the new
+group should appear after the \.{@*}, followed by a period. As explained
+above, \TEX/ control sequences should be avoided in such titles unless
+they are quite simple. When \.{CWEAVE} and \.{CTANGLE} read a \.{@*}, they
+print an asterisk on the terminal
+followed by the current section number, so that the user
+can see some indication of progress. The very first section should be starred.
+
+\more You can specify the ``depth'' of a starred section by typing \.* or a
+decimal number after the \.{@*}; this indicates the relative ranking
+of the current group of sections in the program hierarchy. Top-level
+portions of the program, introduced by \.{@**}, get their names typeset
+in boldface type in the table of contents; they are said to have
+depth~$-1$. Otherwise the depth is a nonnegative number, which governs
+the amount of indentation on the contents page. Such indentation helps
+clarify the structure of a long program. The depth is assumed to be 0
+if it is not specified explicitly; when your program is short, you
+might as well leave all depths zero. A starred section always begins
+a new page in the output, unless the depth is greater than~1.
+
+\subsec
+The middle part of each section consists of any number of
+macro definitions (beginning with \.{@d}) and format definitions (beginning
+with \.{@f} or \.{@s}), intermixed in any order.
+
+\@d [TM\to M] Macro definitions begin with \.{@d}, followed by
+an identifier and optional parameters and \CEE/ text as explained earlier.
+
+\@f [TM\to M] Format definitions begin with \.{@f}; they cause
+\.{CWEAVE} to treat identifiers in a special way when they appear in
+\CEE/ text. The general form of a format definition is `\.{@f} \|l
+\|r', followed by an optional comment enclosed between
+\.{/*} and \.{*/}, where \|l and \|r
+are identifiers; \.{CWEAVE} will subsequently treat identifier \|l as it
+currently treats \|r. This feature allows a \.{CWEB} programmer to invent
+new reserved words and/or to unreserve some of \CEE/'s reserved
+identifiers. For example, the common words `error' and `line'
+have been given a special meaning in the \CEE/ preprocessor,
+so \.{CWEAVE} is set up to format them specially; if you want a variable
+named \\{error} or \\{line}, you should say
+$$\.{@f error normal}\qquad\qquad\.{@f line normal}$$
+somewhere in your program.
+
+\more If \|r is the special identifier `\\{TeX}', identifier \|l
+will be formatted as a \TEX/ control sequence; for example,
+`\.{@f foo TeX}' in the \.{CWEB} file will cause identifier \\{foo} to
+be output as \.{\\foo} by \.{CWEAVE}. The programmer should define
+\.{\\foo} to have whatever custom format is desired, assuming \TEX/
+math mode. (Each underline
+character is converted to \.{x} when making the \TEX/ control sequence,
+and each dollar sign is converted to~\.X;
+thus \\{foo\_bar} becomes \.{\\fooxbar}. Other characters, including digits,
+are left untranslated, so \TEX/ will consider them as macro parameters,
+not as part of the control sequence itself. For example,
+$$\.{\\def\\x\#1\{x\_\{\#1\}\} @f x1 TeX @f x2 TeX}$$
+will format \.{x1} and \.{x2} not as \\{x1} and \\{x2} but as $x_1$ and $x_2$.)
+
+\more If \|r is the special identifier `\\{make\_pair}', identifier \|l will
+be treated as a \CPLUSPLUS/ function template. For example, after
+\.{@f}~\.{convert}~\.{make\_pair} one can say `\.{convert<int>(2.5)}' without
+having \.< and \.> misunderstood as less-than and greater-than signs.
+
+\more \.{CWEAVE} knows that identifiers being
+defined with a \&{typedef} should become reserved words; thus you
+don't need format definitions very often.
+
+\@s [TM\to M;\;L] Same as \.{@f}, but \.{CWEAVE} does not show the format
+definition in the output, and the optional \CEE/ comment is not
+allowed. This is used mostly in \.{@i} files.
+
+\subsec
+Next come the codes that govern the \CEE/ part of a section.
+
+\@{c @p} [TM\to C] The \CEE/ part of an unnamed section begins with \.{@c}
+(or with \.{@p} for ``program''; both control codes do the same thing).
+This causes \.{CTANGLE} to append the following \CEE/ code
+to the first-order program text, as explained on page~\tangref.
+Note that \.{CWEAVE} does not print a `\.{@c}' in the \TEX/
+output, so if you are creating a \.{CWEB} file based on a \TEX/-printed
+\.{CWEB} documentation you have to remember to insert \.{@c} in the
+appropriate places of the unnamed sections.
+
+\@< [TM\to C;\; C;\; c] $*$ This control code introduces a
+section name (or unambiguous prefix, as discussed above), which
+consists of \TEX/ text and extends to the matching \.{@>}.
+The whole construct \.{@<...@>} is conceptually a \CEE/ element.
+The behavior is different depending on the context:
+
+\more A \.{@<} appearing in contexts $T$ and $M$ attaches the
+following section name to the current section, and inaugurates the
+\CEE/ part of the section. The closing \.{@>} should be followed by
+\.{=} or \.{+=}.
+
+\more
+In context $C$, \.{@<} indicates that the named
+section is being used---its \CEE/ definition is spliced in by
+\.{CTANGLE}, as explained on page~\tangref.
+As an error-detection measure,
+\.{CTANGLE} and \.{CWEAVE} complain if such a section name is followed
+by \.=, because most likely this is meant as the definition of a new
+section, and so should be preceded by \.{@\ }. If you really want to
+say $\langle\,$foo$\,\rangle=\\{bar}$, where $\langle\,$foo$\,\rangle$
+is being used and not defined, put a newline before the \.=.
+
+\more
+Finally, in inner \CEE/ context (that is, within `\pb' in the \TEX/ part
+of a section or in a comment), \.{@<...@>}
+means that the named section is being
+cited. Such an occurrence is ignored by \.{CTANGLE}. Note that
+even here we think of the section name as being a \CEE/ element, hence the \pb.
+
+\@( [TM\to C;\;C;\;c] $*$ A section name can begin with \.{@(}.
+Everything works just as for \.{@<}, except that the \CEE/ code
+of the section named \.{@(foo@>} is written by \.{CTANGLE}
+to file \.{foo}. In this way you can get multiple-file output from
+a single \.{CWEB} file. (The \.{@d} definitions are not output
+to such files, only to the master \.{.c} file.) One use of this feature
+is to produce header files for other program modules that will be loaded
+with the present one. Another use is to produce a test routine that
+goes with your program. By keeping the sources for a program and its
+header and test routine together, you are more likely to keep
+all three consistent with each other. Notice that the output of a named
+section can be incorporated in several different output files, because
+you can mention \.{@<foo@>} in both \.{@(bar1@>} and \.{@(bar2@>}.
+
+\@h [Cc] Causes \.{CTANGLE}
+to insert at the current spot the \.{\#define} statements
+from the middle parts of all sections,
+and {\it not\/} to write them at the beginning of the \CEE/ file.
+Useful when you want the macro definitions to come after the include files,
+say. (Ignored by \.{CTANGLE} inside `\pb'.)
+
+\subsec
+The next several control codes introduce ``control
+texts,'' which end with the next `\.{@>}'. The closing `\.{@>}' must be on
+the same line of the \.{CWEB} file as the line where the control text began.
+The context from each of these control codes to the matching \.{@>} is
+restricted.
+
+\@\^ [TMCc] $*$ The control text that follows, up to the next
+`\.{@>}', will be entered into the index together with the identifiers of
+the \CEE/ program; this text will appear in roman type. For example, to
+put the phrase ``system dependencies'' into the index that is output by
+\.{CWEAVE}, type
+`\.{@\^system dependencies@>}' in each section
+that you want to index as system dependent.
+
+\@. [TMCc] $*$ The control text that follows will be entered into the index
+in \.{typewriter} \.{type}.
+
+\@: [TMCc] $*$ The control text that follows will be entered into the index
+in a format controlled by the \TEX/ macro `\.{\\9}', which you
+should define as desired.
+
+\@t [MCc] $*$ The control text that follows will
+be put into a \TEX/ \.{\\hbox} and formatted along with the neighboring
+\CEE/ program. This text is ignored by \.{CTANGLE}, but it can be used
+for various purposes within \.{CWEAVE}. For example, you can make comments
+that mix \CEE/ and classical mathematics, as in `$\\{size}<2^{15}$', by
+typing `\.{|size < 2@t\$\^\{15\}\$@>|}'.
+
+\@= [MCc] $*$ The control text that follows will
+be passed verbatim to the \CEE/ program.
+
+\@q [LTMCc] $*$ The control text that follows will
+be totally ignored---it's a comment for readers of the \.{CWEB} file only.
+A file intended to be included in
+limbo, with \.{@i}, can identify itself with \.{@q} comments.
+Another use is to balance unbalanced parentheses in C strings,
+so that your text editor's parenthesis matcher doesn't go into a tailspin.
+
+\@! [TMCc] $*$
+The section number in an index entry will be underlined if `\.{@!}'
+immediately precedes the identifier or control text being indexed. This
+convention is used to distinguish the sections where an identifier is
+defined, or where it is explained in some special way, from the sections
+where it is used. A~reserved word or an identifier of length one will not
+be indexed except for underlined entries. An `\.{@!}' is implicitly inserted
+by \.{CWEAVE} when an identifier is being defined or declared in \CEE/
+code; for example, the definition
+$$\hbox{\&{int} \\{array}[\\{max\_dim}], \\{count}${}=\\{old\_count};$}$$
+makes the names \\{array} and \\{count} get an underlined entry in the
+index. Statement labels, function definitions like
+\\{main}(\&{int}~\\{argc},\,\&{char}~$*$\\{argv}[\,]),
+and \&{typedef} definitions also
+imply underlining. An old-style
+function definition (without prototyping) doesn't define its arguments;
+the arguments will, however, be considered to be defined
+(i.e., their index entries will be underlined) if their types are
+declared before the body of the function in the usual way
+(e.g., `\&{int}~\\{argc}; \&{char}~${*}\\{argv}[\,]$; $\{\,\ldots\,\}$').
+Thus \.{@!} is not needed very often, except in unusual constructions
+or in cases like
+$$\.{enum boolean \{@!false, @!true\};}$$
+here \.{@!} gives the best results because individual constants enumerated
+by \.{enum} are not automatically underlined in the index at their
+point of definition.
+
+\subsec
+We now turn to control codes that affect only the operation of
+\.{CTANGLE}.
+
+\@' [MCc] This control code is dangerous because it has quite different
+meanings in \.{CWEB} and the original \.{WEB}. In \.{CWEB} it produces the
+decimal constant corresponding to the ASCII code for a string of length~1
+(e.g., \.{@'a'} is \.{CTANGLE}d into \.{97} and \.{@'\\t'} into
+\.9). You might want to use this if you need to work in ASCII on a
+non-ASCII machine; but in most cases the \CEE/ conventions of
+\.{<ctype.h>} are adequate for character-set-independent programming.
+
+\@\& [MCc] The \.{@\&} operation causes whatever is on its left to be
+adjacent to whatever is on its right, in the \CEE/ output. No spaces or
+line breaks will separate these two items.
+
+\@l [L] \.{CWEB} programmers have the option of using any 8-bit character
+code from the often-forbidden range 128--255 within \TEX/ text; such
+characters are also permitted in strings and even in identifiers of the
+\CEE/ program.
+Under various extensions of the basic
+ASCII standard, the higher 8-bit codes correspond
+to accented letters, letters from non-Latin alphabets,
+and so on. When such characters occur in identifiers, \.{CTANGLE} must replace
+them by standard ASCII alphanumeric characters or
+\.{\_}, in order to generate legal \CEE/ code. It does this by means
+of a transliteration table, which by default associates the string
+\.{Xab} to the character with ASCII code \T{\^}$ab$ (where $a$ and $b$ are
+hexadecimal digits, and $a\ge8$). By placing the
+construction \.{@l\ ab\ newstring} in limbo, you are telling
+\.{CTANGLE} to replace this character by \.{newstring} instead.
+For example, the ISO Latin-1 code for the letter `\"u' is \T{\^FC}
+(or \.{'\char`\\374'}),
+and \.{CTANGLE} will normally change this code to the
+three-character sequence \.{XFC} if it
+appears in an identifier. If you say \.{@l} \.{fc} \.{ue}, the code will
+be transliterated into \.{ue} instead.
+
+\more
+\.{CWEAVE} passes 8-bit characters straight through to \TEX/ without
+transliteration; therefore \TEX/ must be prepared to receive them.
+If you are formatting all your nonstandard identifiers as ``custom''
+control sequences, you should
+make \TEX/ treat all their characters as letters. Otherwise you should either
+make your 8-bit codes ``active'' in \TEX/, or load fonts that
+contain the special characters you need in the correct positions.
+(The font selected by \TEX/ control sequence \.{\\it} is used for
+identifiers.)
+Look for special macro packages designed for \.{CWEB} users in your language;
+or, if you are brave, write one yourself.
+
+\subsec
+The next eight control codes (namely `\.{@,}', `\.{@/}', `\.{@|}', `\.{@\#}',
+`\.{@+}', `\.{@;}', `\.{@[}', and `\.{@]}') have no effect on the \CEE/
+program output by \.{CTANGLE}; they merely help to improve the readability
+of the \TEX/-formatted \CEE/ that is output by \.{CWEAVE}, in unusual
+circumstances. \.{CWEAVE}'s built-in formatting method is fairly good
+when dealing with syntactically correct \CEE/ text, but
+it is incapable of handling all possible cases, because it must deal with
+fragments of text involving macros and section names; these fragments do
+not necessarily obey \CEE/'s syntax. Although \.{CWEB} allows you to
+override the automatic formatting, your best strategy is not to worry
+about such things until you have seen what \.{CWEAVE} produces automatically,
+since you will probably need to make only a few corrections when you are
+touching up your documentation.
+
+\@, [MCc] This control code inserts a thin space in \.{CWEAVE}'s output.
+Sometimes you need this extra space if you are using
+macros in an unusual way, e.g., if two identifiers are adjacent.
+
+\@/ [MC] This control code causes a line break to occur within a \CEE/
+program formatted by \.{CWEAVE}. Line breaks
+are chosen automatically by \TEX/ according to a scheme that works 99\%\
+of the time, but sometimes you will prefer to force a line break so that
+the program is segmented according to logical rather than visual
+criteria. If a comment follows, say `\.{@/@,}' to break the line
+before the comment.
+
+\@| [MC] This control code specifies an optional line break in the midst of
+an expression. For example, if you have
+a long expression on the right-hand side of an assignment
+statement, you can use `\.{@|}' to specify breakpoints more logical than
+the ones that \TEX/ might choose on visual grounds.
+
+\@\# [MC] This control code forces a line break, like \.{@/} does,
+and it also causes a little extra white space to appear between the lines at
+this break. You might use it, for example,
+between groups of macro definitions that are logically separate but within
+the same section. \.{CWEB} automatically inserts this extra space
+between functions, between external declarations and functions, and
+between declarations and statements within a function.
+
+\@+ [MC] This control code cancels a line break that might otherwise be
+inserted by \.{CWEAVE}, e.g., before the word `\&{else}', if you want to
+put a short if--else construction on a single line.
+If you say `\.{\{@+}' at the beginning of a compound statement
+that is the body of a function, the first declaration or
+statement of the function will appear on the same line as the
+left brace, and it will be indented by the same amount as the
+second declaration or statement on the next line.
+
+\@; [MC] This control code is treated like a semicolon, for formatting
+purposes, except that it is invisible. You can use it, for example, after
+a section name or macro when the \CEE/ text represented by that section or macro
+is a compound statement or ends
+with a semicolon. Consider constructions like
+$$\lpile{\.{if (condition) macro @;}\cr
+\.{else break;}\cr}$$
+where \\{macro} is defined to be a compound statement (enclosed in braces).
+This is a well-known infelicity of \CEE/ syntax.
+
+\@{[} [MC] See \.{@]}.
+
+\@] [MC] Place \.{@[...@]} brackets around program text that \.{CWEAVE} is
+supposed to format as an expression, if it doesn't already do so. (This
+occasionally applies to unusual macro arguments.) Also
+insert `\.{@[@]}' between a simple type name and a left parenthesis
+when declaring a pointer to a function, as in
+$$\.{int @[@] (*f)();}$$
+otherwise \.{CWEAVE} will confuse the first part of that declaration with
+the \CPLUSPLUS/ expression `\&{int}($*f$)'. Another example, for people
+who want to use low-level \.{\#define} commands in the midst of \CEE/ code
+and the definition begins with a cast:
+$$\.{\#define foo @[(int)(bar)@]}$$
+
+\subsec
+The remaining control codes govern the input that \.{CWEB} sees.
+
+\@{x @y @z}[\\{change\_file}]
+\.{CWEAVE} and \.{CTANGLE} are designed to work with two input files,
+called \\{web\_file} and \\{change\_file}, where \\{change\_file} contains
+data that overrides selected portions of \\{web\_file}. The resulting merged
+text is actually what has been called the \.{CWEB} file elsewhere in this
+report.
+
+\more Here's how it works: The change file consists of zero or more ``changes,''
+where a change has the form `\.{@x}$\langle$old lines$\rangle$\.{@y}$\langle$%
+new lines$\rangle$\.{@z}'. The special control codes \.{@x}, \.{@y}, \.{@z},
+which are allowed only in change files, must appear at the beginning of a line;
+the remainder of such a line is ignored.
+The $\langle$old lines$\rangle$ represent material that exactly matches
+consecutive lines of the \\{web\_file}; the $\langle$new lines$\rangle$
+represent zero or more lines that are supposed to replace the old. Whenever
+the first ``old line'' of a change is found to match a line in the
+\\{web\_file}, all the other lines in that change must match too.
+
+\more Between changes, before the first change, and after the last change,
+the change file can have any number of lines that do not begin with
+`\.{@x}', `\.{@y}', or~`\.{@z}'. Such lines are bypassed and not used for
+matching purposes.
+
+\more This dual-input feature is useful when working with a master \.{CWEB}
+file that has been received from elsewhere (e.g., \.{tangle.w} or
+\.{weave.w} or \.{tex.web}), when changes are desirable to customize the
+program for your local computer system. You will be able to debug your
+system-dependent changes without clobbering the master web file; and once
+your changes are working, you will be able to incorporate them readily
+into new releases of the master web file that you might receive from time
+to time.
+
+\@i [\\{web\_file}]
+Furthermore the \\{web\_file} itself can be a combination of
+several files. When either \.{CWEAVE} or \.{CTANGLE} is reading a file and
+encounters the control code \.{@i} at the beginning of a line, it
+interrupts normal reading and starts looking at the file named after the
+\.{@i}, much as the \CEE/ preprocessor does when it encounters an \.{\#include}
+line. After the included file has been entirely read, the program
+goes back to the next line
+of the original file. The file name following \.{@i} can be
+surrounded by \." characters, but such delimiters are
+optional. Include files can nest.
+
+\more
+Change files can have lines starting with \.{@i}. In this way
+you can replace one included file with another. Conceptually, the
+replacement mechanism described above does its work first, and
+its output is then checked for \.{@i} lines. If \.{@i} \.{foo}
+occurs between \.{@y} and \.{@z} in a change file, individual lines
+of file \.{foo} and files it includes are not changeable; but changes
+can be made to lines from files that were included by unchanged input.
+
+\more On UNIX systems (and others that support environment variables),
+if the environment variable \.{CWEBINPUTS} is set, or if the compiler flag
+of the same name was defined at compile time,
+\.{CWEB} will look for include files in the directory thus named, if
+it cannot find them in the current directory.
+
+\section Additional features and caveats.
+
+1. In certain installations of \.{CWEB} that
+{\def\\#1#2{`{\tentex\char'#1#2}'}%
+have an extended character set, the characters
+\\13, \\01, \\31, \\32, \\34, \\35,
+\\36, \\37, \\04, \\20, and \\21}
+can be typed as abbreviations for `\.{++}', `\.{--}', `\.{->}',
+`\.{!=}', `\.{<=}', `\.{>=}', `\.{==}', `\.{\v\v}', `\.{\&\&}',
+`\.{<<}', and `\.{>>}',
+respectively.
+
+2. If you have an extended character set, you can use it with only minimal
+restrictions, as discussed under the rules for \.{@l} above. But you should
+stick to standard ASCII characters if you want to write programs that will
+be useful to all the poor souls out there who don't have extended
+character sets.
+
+3. The \TEX/ file output by \.{CWEAVE} is broken into lines having at most
+80 characters each. When
+\TEX/ text is being copied, the existing line breaks are copied as well.
+If you aren't doing anything too tricky, \.{CWEAVE} will recognize when
+a \TEX/ comment is being split across two or more lines, and it will
+append `\.\%' to the beginning of such continued comments.
+
+4. \CEE/ text is translated by a ``bottom up'' procedure that
+identifies each token as a ``part of speech'' and combines parts of speech
+into larger and larger phrases as much as possible according to a special
+grammar that is explained in the documentation of \.{CWEAVE}. It is easy to
+learn the translation scheme for simple constructions like single
+identifiers and short expressions, just by looking at a few examples of
+what \.{CWEAVE} does, but the general mechanism is somewhat complex because
+it must handle much more than \CEE/ itself. Furthermore the output
+contains embedded codes that cause \TEX/ to indent and break lines as
+necessary, depending on the fonts used and the desired page width. For
+best results it is wise to avoid enclosing long \CEE/ texts in \pb, since the
+indentation and line breaking codes are omitted when the \pb\ text is
+translated from \CEE/ to \TEX/. Stick to simple expressions or
+statements. If a \CEE/ preprocessor command is enclosed in \pb,
+the \.\# that introduces it must be at the beginning of a line,
+or \.{CWEAVE} won't print it correctly.
+
+5. Comments are not permitted in \pb\ text. After a `\.|'
+signals the change from \TEX/ text to \CEE/ text, the next `\.|' that is
+not part of a string or control text or section name ends the \CEE/ text.
+
+6. A comment must have properly nested occurrences of left and right
+braces, otherwise \.{CWEAVE} will complain. But it
+does try to balance the braces, so that \TEX/ won't foul up too much.
+
+7. When you're debugging a program and decide to omit some of your
+\CEE/ code, do NOT simply ``comment it out.'' Such comments are not
+in the spirit of \.{CWEB} documentation; they will appear to readers
+as if they were explanations of the uncommented-out instructions.
+Furthermore, comments of a program must be valid \TEX/ text; hence
+\.{CWEAVE} will get confused if you enclose \CEE/ statements in
+\.{/*...*/} instead of in \.{/*|...|*/}. If you must comment out
+\CEE/ code, you can surround it with preprocessor commands
+like \.{\#if 0==1} and \.{\#endif}.
+
+8. The \.{@f} feature allows you to define one identifier to act like
+another, and these format definitions are carried out sequentially.
+In general, a given identifier has only one printed format
+throughout the entire document, and this format is used even before
+the \.{@f} that defines it. The reason is that \.{CWEAVE} operates in two
+passes; it processes \.{@f}'s and cross-references on the first pass and
+it does the output on the second. (However, identifiers that
+implicitly get a boldface format, thanks to a \.{typedef} declaration,
+don't obey this rule; they are printed differently before and after
+the relevant \.{typedef}. This is unfortunate, but hard to fix. You can
+get around the restriction by saying, say, `\.{@s} \.{foo} \.{int}',
+before or after the \.{typedef}.)
+
+9. Sometimes it is desirable to insert spacing into formatted \CEE/ code that
+is more general than the thin space provided by `\.{@,}'. The \.{@t} feature
+can be used for this purpose; e.g., `\.{@t\\hskip 1in@>}' will
+leave one inch of blank space. Furthermore, `\.{@t\\4@>}' can be
+used to backspace by one unit of indentation, since the control sequence
+\.{\\4} is defined in \.{cwebmac} to be such a backspace. (This
+control sequence is used, for example, at the beginning of lines that
+contain labeled statements, so that the label will stick out a little at
+the left.) You can also use `\.{@t\}\\3\{-5@>}' to force a break
+in the middle of an expression.
+
+10. Each identifier in \.{CWEB} has a single formatting convention. Therefore
+you shouldn't use the same identifier to denote, say, both a type name and
+part of a \.{struct}, even though \CEE/ does allow this.
+
+\section Running the programs.
+The \UNIX/ command line for \.{CTANGLE} is
+$$\.{ctangle [options] web\_file[.w] [\{change\_file[.ch]|-\} [out\_file]]}$$
+and the same conventions apply to \.{CWEAVE}. If `\.-' or no change file is
+specified, the change file is null. The extensions \.{.w} and \.{.ch}
+are appended only if the given file names contain no dot. If the
+web file defined in this way cannot be found, the extension \.{.web}
+will be tried. For example, `\.{cweave} \.{cob}' will try to read
+\.{cob.w}; failing that, it will try \.{cob.web} before giving up.
+If no output file name is specified, the name of the \CEE/ file output by
+\.{CTANGLE} is obtained by appending the extension \.{.c};
+the name of the \TEX/ file output by \.{CWEAVE} gets the extension \.{.tex}.
+Index files output by \.{CWEAVE} replace \.{.tex} by \.{.idx} and \.{.scn}.
+
+Programmers who like terseness might choose to set up their
+ operating shell so that `\.{wv}' expands to
+`\.{cweave -bhp}'; this will suppress most terminal output from \.{CWEAVE}
+except for error messages.
+
+Options are introduced either by a \.- sign, to turn an option off,
+or by a \.+ sign to turn one on. For example, `\.{-fb}' turns off
+options \.f and \.b; `\.{+s}' turns on option \.s. Options can be
+specified before the file names, after the file names, or both. The following
+options are currently implemented:
+
+\yskip
+\def\option#1 {\textindent{\.#1}\hangindent2\parindent}
+
+\option b Print a banner line at the beginning of execution. (On
+by default.)
+
+\option e Enclose \CEE/ material formatted by \.{CWEAVE} in
+brackets \.{\\PB\{...\}}, so that special hooks can be used.
+(Off by default; has no effect on \.{CTANGLE}.)
+
+\option f Force line breaks after each \CEE/ statement formatted
+by \.{CWEAVE}. (On by default; \.{-f} saves paper but looks less \CEE/-like
+to some people.) (Has no effect on \.{CTANGLE}.)
+
+\option h Print a happy message at the conclusion of a successful
+run. (On by default.)
+
+\option p Give progress reports as the program runs. (On by default.)
+
+\option s Show statistics about memory usage after the program
+runs to completion. (Off by default.)
+If you
+have large \.{CWEB} files or sections, you may need to see
+how close you come to exceeding the capacity of \.{CTANGLE} and/or \.{CWEAVE}.
+
+\option x Include indexes and a table of contents in the \TEX/ file
+output by \.{CWEAVE}. (On by default.) (Has no effect on \.{CTANGLE}.)
+
+\section Further details about formatting.
+You may not like the way \.{CWEAVE} handles certain
+situations. If you're desperate, you can customize \.{CWEAVE}
+by changing its grammar. This means changing the source code,
+a task that you might find amusing. A table of grammar rules
+appears in the \.{CWEAVE} source listing, and you can make a separate
+copy of that table by copying the file \.{prod.w} found in the \.{CWEB}
+sources and saying `\.{cweave}~\.{-x}~\.{prod}', followed by
+`\.{tex}~\.{prod}'.
+
+You can see exactly
+how \.{CWEAVE} is parsing your \CEE/ code by preceding
+it with the line `\.{@ @c @2}'. (The control code `\.{@2}'
+turns on a ``peeping'' mode, and `\.{@0}' turns it off.)
+For example, if you run \.{CWEAVE} on the file
+\medskip
+\begingroup
+\verbatim
+@ @c @2
+main (argc,argv)
+char **argv;
+{ for (;argc>0;argc--) printf("%s\n",argv[argc-1]); }
+!endgroup
+\endgroup
+\medskip\noindent
+you get the following gibberish on your screen:
+\medskip
+\begingroup
+\verbatim
+[...]
+4:*exp ( +exp+ )...
+11:*exp +exp+ int...
+5:*+exp+ int +unorbinop+...
+[...]
+60: +fn_decl+*+{+ -stmt- +}-
+55:*+fn_decl+ -stmt-
+52:*+function-
+[...]
+!endgroup
+\endgroup
+\medskip
+The first line says that grammar rule 4 has just been applied, and \.{CWEAVE}
+currently has in its memory a sequence of chunks of \TEX/ code (called
+``scraps'') that are respectively
+of type \\{exp} (for expression), open-parenthesis,
+\\{exp} again, close-parenthesis, and further scraps that haven't yet
+been considered by the parser. (The \.+ and \.- signs stipulate that
+\TEX/ should be in or out of math mode at the scrap boundaries. The \.* shows
+the parser's current position.)
+Then rule 11 is applied, and
+the sequence $(\,exp\,)$ becomes an \\{exp} and so on. In the
+end the whole \CEE/ text has become one big scrap of type \\{function}.
+
+Sometimes things don't work as smoothly, and you get a bunch of
+lines lumped together. This means that \.{CWEAVE} could not
+digest something in your \CEE/ code. For instance, suppose
+`\.{@<Argument definitions@>}' had appeared instead of
+`\.{char **argv;}' in the program above. Then \.{CWEAVE} would have
+been somewhat mystified, since it thinks that section names
+are just \\{exp}s. Thus it would tell \TEX/ to format
+`\X2:Argument declarations\X' on the same line as
+`$\\{main}(\\{argc},\39\\{argv}{}$)'.
+In this case you should help \.{CWEAVE} by putting `\.{@/}' after
+`\.{main(argc,argv)}'.
+
+\.{CWEAVE} automatically inserts a bit of extra space between declarations
+and the first apparent statement of a block. One way to defeat this
+spacing locally is
+$$\vbox{\halign{#\hfil\cr
+\.{int x;@+@t\}\\6\{@>}\cr
+\.{@<Other locals@>@;@\#}\cr}}$$
+the `\.{@\#}' will put extra space after `$\langle\,$Other locals$\,\rangle$'.
+
+\section Hypertext and hyperdocumentation.
+
+Many people have of course noticed analogies between \.{CWEB} and the
+World Wide Web. The \.{CWEB} macros are in fact set up so that the output of
+\.{CWEAVE} can be converted easily into Portable Document Format,
+with clickable hyperlinks that can be read with Adobe's Acrobat Reader,
+using a widely available open-source program called \.{dvipdfm} developed
+by Mark~A. Wicks. After using \.{CWEAVE} to convert \.{cob.w} into
+\.{cob.tex}, you can prepare and view a hypertext version of the program
+by giving the commands
+$$\vbox{\halign{\.{#}\hfil\cr
+tex "\\let\\pdf+ \\input cob"\cr
+dvipdfm cob\cr
+acroread cob.pdf\cr}}$$
+instead of invoking \TeX\ in the normal way. (Thanks to Hans Hagen,
+C\'esar Augusto Rorato Crusius, and Julian Gilbey
+for the macros that make this work.)
+Alternatively, thanks to H\`an Th\^e\kern-.3em\raise.3ex\hbox{\'{}} Th\`anh
+and Andreas Scherer, you can generate \.{cob.pdf} in one step by simply
+saying `\.{pdftex}~\.{cob}'.
+
+A more elaborate system called \.{CTWILL}, which extends the usual cross
+references of \.{CWEAVE} by preparing links from the uses of identifiers
+to their definitions, is also available---provided that you are willing
+to work a bit harder in cases where an identifier is multiply defined.
+\.{CTWILL} is intended primarily for hardcopy output, but its principles
+could be used for hypertext as well.
+See Chapter 11 of {\sl Digital Typography\/} by D.~E. Knuth (1999), and
+the program sources at \.{ftp://labrea.stanford.edu/pub/ctwill}.
+
+\section Appendices.
+
+As an example of a real program written in \.{CWEB}, Appendix~A
+contains an excerpt from the \.{CWEB} program itself. The reader who
+examines the listings in this appendix carefully will get a good
+feeling for the basic ideas of \.{CWEB}.
+
+Appendix B is the file that sets \TEX/ up to accept
+the output of \.{CWEAVE}, and Appendix~C discusses how to use some of those
+macros to vary the output formats.
+
+A ``long'' version of this manual, which can be produced from the \.{CWEB}
+sources via the \UNIX/ command \.{make} \.{fullmanual}, also contains
+appendices D, E, and~F, which exhibit the complete source code for
+\.{CTANGLE} and \.{CWEAVE}.
+
+\vfil\eject\titletrue
+
+\def\runninghead{APPENDIX A --- {\tentt CWEB} FILE FORMAT}
+\section Appendix A: Excerpts from a \.{CWEB} Program.
+
+This appendix consists
+of four listings. The first shows the \.{CWEB} input that
+generated sections 12--15 of the file \.{common.w}, which contains
+routines common to \.{CWEAVE} and \.{CTANGLE}.
+Note that some of the lines are indented to show the program structure;
+the indentation is ignored by \.{CWEAVE} and \.{CTANGLE}, but users find
+that \.{CWEB} files are quite readable if they have some such indentation.
+
+The second and third listings
+show corresponding parts
+of the \CEE/ code output by \.{CTANGLE} and of
+the corresponding \TEX/ code output by \.{CWEAVE}, when run on \.{common.w}.
+The fourth listing shows how that output looks when printed out.
+
+\vskip 6pt
+\begingroup \def\tt{\eighttt} \baselineskip9pt
+\verbatim
+@ Procedure |prime_the_change_buffer|
+sets |change_buffer| in preparation for the next matching operation.
+Since blank lines in the change file are not used for matching, we have
+|(change_limit==change_buffer && !!changing)| if and only if
+the change file is exhausted. This procedure is called only when
+|changing| is 1; hence error messages will be reported correctly.
+
+@c
+void
+prime_the_change_buffer()
+{
+ change_limit=change_buffer; /* this value is used if the change file ends */
+ @<Skip over comment lines in the change file; |return| if end of file@>;
+ @<Skip to the next nonblank line; |return| if end of file@>;
+ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>;
+}
+
+@ While looking for a line that begins with \.{@@x} in the change file, we
+allow lines that begin with \.{@@}, as long as they don't begin with \.{@@y},
+\.{@@z}, or \.{@@i} (which would probably mean that the change file is fouled up).
+
+@<Skip over comment lines in the change file...@>=
+while(1) {
+ change_line++;
+ if (!!input_ln(change_file)) return;
+ if (limit<buffer+2) continue;
+ if (buffer[0]!!='@@') continue;
+ if (xisupper(buffer[1])) buffer[1]=tolower(buffer[1]);
+ if (buffer[1]=='x') break;
+ if (buffer[1]=='y' || buffer[1]=='z' || buffer[1]=='i') {
+ loc=buffer+2;
+ err_print("!! Missing @@x in change file");
+@.Missing @@x...@>
+ }
+}
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+do {
+ change_line++;
+ if (!!input_ln(change_file)) {
+ err_print("!! Change file ended after @@x");
+@.Change file ended...@>
+ return;
+ }
+} while (limit==buffer);
+
+@ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>=
+{
+ change_limit=change_buffer-buffer+limit;
+ strncpy(change_buffer,buffer,limit-buffer+1);
+}
+
+!endgroup
+\endgroup
+\vfill\eject
+
+\def\runninghead{APPENDIX A --- TRANSLATION BY {\tentt CTANGLE}}
+
+Here's the portion of the \CEE/ code generated by \.{CTANGLE} that corresponds
+to the source on the preceding page. Notice that sections~13, 14 and~15
+have been tangled into section~12.
+
+\vskip6pt
+\begingroup \def\tt{\eighttt} \baselineskip9pt
+\verbatim
+/*:9*//*12:*/
+#line 247 "common.w"
+
+void
+prime_the_change_buffer()
+{
+change_limit= change_buffer;
+/*13:*/
+#line 261 "common.w"
+
+while(1){
+change_line++;
+if(!!input_ln(change_file))return;
+if(limit<buffer+2)continue;
+if(buffer[0]!!='@')continue;
+if(xisupper(buffer[1]))buffer[1]= tolower(buffer[1]);
+if(buffer[1]=='x')break;
+if(buffer[1]=='y'||buffer[1]=='z'||buffer[1]=='i'){
+loc= buffer+2;
+err_print("!! Missing @x in change file");
+
+}
+}
+
+/*:13*/
+#line 252 "common.w"
+;
+/*14:*/
+#line 278 "common.w"
+
+do{
+change_line++;
+if(!!input_ln(change_file)){
+err_print("!! Change file ended after @x");
+
+return;
+}
+}while(limit==buffer);
+
+/*:14*/
+#line 253 "common.w"
+;
+/*15:*/
+#line 288 "common.w"
+
+{
+change_limit= change_buffer-buffer+limit;
+strncpy(change_buffer,buffer,limit-buffer+1);
+}
+
+/*:15*/
+#line 254 "common.w"
+;
+}
+
+/*:12*//*16:*/
+!endgroup
+\endgroup
+\vfill\eject
+
+\def\runninghead{APPENDIX A --- TRANSLATION BY {\tentt CWEAVE}}
+
+Here is the corresponding excerpt from \.{common.tex}.
+
+\vskip6pt
+\begingroup \def\tt{\eighttt} \baselineskip9pt
+\verbatim
+\M{12}Procedure \PB{\\{prime\_the\_change\_buffer}}
+sets \PB{\\{change\_buffer}} in preparation for the next matching operation.
+Since blank lines in the change file are not used for matching, we have
+\PB{$(\\{change\_limit}\E\\{change\_buffer}\W\R\\{changing})$} if and only if
+the change file is exhausted. This procedure is called only when
+\PB{\\{changing}} is 1; hence error messages will be reported correctly.
+!vskip-.5!baselineskip
+\Y\B\&{void} \\{prime\_the\_change\_buffer}(\,)\1\1\2\2\6
+${}\{{}$\1\6
+${}\\{change\_limit}\K\\{change\_buffer}{}$;\C{ this value is used if the
+change file ends }\6
+\X13:Skip over comment lines in the change file; \PB{\&{return}} if end of file%
+\X;\6
+\X14:Skip to the next nonblank line; \PB{\&{return}} if end of file\X;\6
+\X15:Move \PB{\\{buffer}} and \PB{\\{limit}} to \PB{\\{change\_buffer}} and %
+\PB{\\{change\_limit}}\X;\6
+\4${}\}{}$\2\par
+\fi
+!vskip-.5!baselineskip
+\M{13}While looking for a line that begins with \.{@x} in the change file, we
+allow lines that begin with \.{@}, as long as they don't begin with \.{@y},
+\.{@z}, or \.{@i} (which would probably mean that the change file is fouled
+up).
+!vskip-.5!baselineskip
+\Y\B\4\X13:Skip over comment lines in the change file; \PB{\&{return}} if end
+of file\X${}\E{}$\6
+\&{while} (\T{1})\5
+${}\{{}$\1\6
+${}\\{change\_line}\PP;{}$\6
+\&{if} ${}(\R\\{input\_ln}(\\{change\_file})){}$\1\5
+\&{return};\2\6
+\&{if} ${}(\\{limit}<\\{buffer}+\T{2}){}$\1\5
+\&{continue};\2\6
+\&{if} ${}(\\{buffer}[\T{0}]\I\.{'@'}){}$\1\5
+\&{continue};\2\6
+\&{if} (\\{xisupper}(\\{buffer}[\T{1}]))\1\5
+${}\\{buffer}[\T{1}]\K\\{tolower}(\\{buffer}[\T{1}]);{}$\2\6
+\&{if} ${}(\\{buffer}[\T{1}]\E\.{'x'}){}$\1\5
+\&{break};\2\6
+\&{if} ${}(\\{buffer}[\T{1}]\E\.{'y'}\V\\{buffer}[\T{1}]\E\.{'z'}\V\\{buffer}[%
+\T{1}]\E\.{'i'}){}$\5
+${}\{{}$\1\6
+${}\\{loc}\K\\{buffer}+\T{2};{}$\6
+\\{err\_print}(\.{"!!\ Missing\ @x\ in\ cha}\)\.{nge\ file"});\6
+\4${}\}{}$\2\6
+\4${}\}{}$\2\par
+\U12.\fi
+!vskip-.5!baselineskip
+\M{14}Here we are looking at lines following the \.{@x}.
+!vskip-.5!baselineskip
+\Y\B\4\X14:Skip to the next nonblank line; \PB{\&{return}} if end of file\X${}%
+\E{}$\6
+\&{do}\5
+${}\{{}$\1\6
+${}\\{change\_line}\PP;{}$\6
+\&{if} ${}(\R\\{input\_ln}(\\{change\_file})){}$\5
+${}\{{}$\1\6
+\\{err\_print}(\.{"!!\ Change\ file\ ended}\)\.{\ after\ @x"});\6
+\&{return};\6
+\4${}\}{}$\2\6
+\4${}\}{}$\2\5
+\&{while} ${}(\\{limit}\E\\{buffer}){}$;\par
+\U12.\fi
+!vskip-.5!baselineskip
+\M{15}\B\X15:Move \PB{\\{buffer}} and \PB{\\{limit}} to \PB{\\{change\_buffer}}
+and \PB{\\{change\_limit}}\X${}\E{}$\6
+${}\{{}$\1\6
+${}\\{change\_limit}\K\\{change\_buffer}-\\{buffer}+\\{limit};{}$\6
+${}\\{strncpy}(\\{change\_buffer},\39\\{buffer},\39\\{limit}-\\{buffer}+%
+\T{1});{}$\6
+\4${}\}{}$\2\par
+\Us12\ET16.\fi
+!endgroup
+\endgroup
+\vfil\eject
+
+\def\runninghead{APPENDIX A --- FINAL DOCUMENT}
+
+And here's what the same excerpt looks like when typeset.
+
+\M{12}Procedure \PB{\\{prime\_the\_change\_buffer}}
+sets \PB{\\{change\_buffer}} in preparation for the next matching operation.
+Since blank lines in the change file are not used for matching, we have
+\PB{$(\\{change\_limit}\E\\{change\_buffer}\W\R\\{changing})$} if and only if
+the change file is exhausted. This procedure is called only when
+\PB{\\{changing}} is 1; hence error messages will be reported correctly.
+
+\Y\B\&{void} \\{prime\_the\_change\_buffer}(\,)\1\1\2\2\6
+${}\{{}$\1\6
+${}\\{change\_limit}\K\\{change\_buffer}{}$;\C{ this value is used if the
+change file ends }\6
+\X13:Skip over comment lines in the change file; \PB{\&{return}} if end of file%
+\X;\6
+\X14:Skip to the next nonblank line; \PB{\&{return}} if end of file\X;\6
+\X15:Move \PB{\\{buffer}} and \PB{\\{limit}} to \PB{\\{change\_buffer}} and %
+\PB{\\{change\_limit}}\X;\6
+\4${}\}{}$\2\par
+\fi
+
+\M{13}While looking for a line that begins with \.{@x} in the change file, we
+allow lines that begin with \.{@}, as long as they don't begin with \.{@y},
+\.{@z}, or \.{@i} (which would probably mean that the change file is fouled up).
+
+\Y\B\4\X13:Skip over comment lines in the change file; \PB{\&{return}} if end
+of file\X${}\E{}$\6
+\&{while} (\T{1})\5
+${}\{{}$\1\6
+${}\\{change\_line}\PP;{}$\6
+\&{if} ${}(\R\\{input\_ln}(\\{change\_file})){}$\1\5
+\&{return};\2\6
+\&{if} ${}(\\{limit}<\\{buffer}+\T{2}){}$\1\5
+\&{continue};\2\6
+\&{if} ${}(\\{buffer}[\T{0}]\I\.{'@'}){}$\1\5
+\&{continue};\2\6
+\&{if} (\\{xisupper}(\\{buffer}[\T{1}]))\1\5
+${}\\{buffer}[\T{1}]\K\\{tolower}(\\{buffer}[\T{1}]);{}$\2\6
+\&{if} ${}(\\{buffer}[\T{1}]\E\.{'x'}){}$\1\5
+\&{break};\2\6
+\&{if} ${}(\\{buffer}[\T{1}]\E\.{'y'}\V\\{buffer}[\T{1}]\E\.{'z'}\V\\{buffer}[%
+\T{1}]\E\.{'i'}){}$\5
+${}\{{}$\1\6
+${}\\{loc}\K\\{buffer}+\T{2};{}$\6
+\\{err\_print}(\.{"!\ Missing\ @x\ in\ cha}\)\.{nge\ file"});\6
+\4${}\}{}$\2\6
+\4${}\}{}$\2\par
+\U12.\fi
+
+\M{14}Here we are looking at lines following the \.{@x}.
+
+\Y\B\4\X14:Skip to the next nonblank line; \PB{\&{return}} if end of file\X${}%
+\E{}$\6
+\&{do}\5
+${}\{{}$\1\6
+${}\\{change\_line}\PP;{}$\6
+\&{if} ${}(\R\\{input\_ln}(\\{change\_file})){}$\5
+${}\{{}$\1\6
+\\{err\_print}(\.{"!\ Change\ file\ ended}\)\.{\ after\ @x"});\6
+\&{return};\6
+\4${}\}{}$\2\6
+\4${}\}{}$\2\5
+\&{while} ${}(\\{limit}\E\\{buffer}){}$;\par
+\U12.\fi
+
+\M{15}\B\X15:Move \PB{\\{buffer}} and \PB{\\{limit}} to \PB{\\{change\_buffer}}
+and \PB{\\{change\_limit}}\X${}\E{}$\6
+${}\{{}$\1\6
+${}\\{change\_limit}\K\\{change\_buffer}-\\{buffer}+\\{limit};{}$\6
+${}\\{strncpy}(\\{change\_buffer},\39\\{buffer},\39\\{limit}-\\{buffer}+%
+\T{1});{}$\6
+\4${}\}{}$\2\par
+\Us12\ET16.\fi
+
+\vfil\eject\titletrue
+\rightskip=0pt % get out of C mode (cf. \B)
+\sfcode`;=1500 \pretolerance 200 \hyphenpenalty 50 \exhyphenpenalty 50
+
+\def\runninghead{APPENDIX B --- MACROS FOR FORMATTING}
+\section Appendix B: The \.{cwebmac.tex} file.
+This is the file that extends ``plain \TEX/'' format in order to support the
+features needed by the output of \.{CWEAVE}.
+
+\vskip6pt
+\begingroup \def\tt{\eighttt} \baselineskip9pt
+\def\printmacs{\begingroup
+ \def\do##1{\catcode`##1=12 } \dospecials
+ \parskip 0pt \parindent 0pt
+ \catcode`\ =13 \catcode`\^^M=13
+ \tt \verbatimdefs \input cwebmac \endgroup}
+\printmacs
+\endgroup
+\vfill\eject
+
+\def\runninghead{APPENDIX C --- NOTES ON FORMATTING}
+\section Appendix C: How to use \.{CWEB} macros.
+The macros in \.{cwebmac} make it possible to produce a variety of formats
+without editing the output of \.{CWEAVE}, and the purpose of this appendix
+is to explain some of the possibilities.
+
+\def\point#1.{\yskip\indent#1.\quad\ignorespaces}
+
+\point 1. Four fonts have been declared in addition to the standard fonts of
+\.{PLAIN} format: You can say `\.{\{\\mc UNIX\}}' to get {\mc UNIX} in
+medium-size caps; you can say `\.{\{\\sc STUFF\}}' to get {\sc STUFF}
+in small caps; and you can select the largish fonts \.{\\titlefont}
+and \.{\\ttitlefont} in the title of your document, where \.{\\ttitlefont}
+is a typewriter style of type. There are macros \.{\\UNIX/} and \.{\\CEE/}
+to refer to \UNIX/ and \CEE/ with medium-size caps.
+
+\point 2. When you mention an identifier in \TEX/ text, you normally call
+it `\.{|identifier|}'. But you can also say `\.{\\\\\{identifier\}}'. The
+output will look the same in both cases, but the second alternative
+doesn't put \\{identifier} into the index, since
+it bypasses \.{CWEAVE}'s translation from \CEE/ mode. In the second
+case you must put a backslash before each underline character
+in the identifier.
+
+\point 3. To get typewriter-like type, as when referring to `\.{CWEB}', you
+can use the `\.{\\.}' macro (e.g., `\.{\\.\{CWEB\}}'). In the argument to
+this macro you should insert an additional backslash before the symbols
+listed as `special string characters' in the index to \.{CWEAVE}, i.e.,
+before backslashes and dollar signs and the like.
+A `\.{\\\ }' here will result in the visible space symbol; to get an
+invisible space following a control sequence you can say `\.{\{\ \}}'.
+If the string is long, you can break it up into substrings that
+are separated by `\.{\\)}'\,; the latter gives a discretionary backslash
+if \TEX/ has to break a line here.
+
+\point 4. The three control sequences \.{\\pagewidth}, \.{\\pageheight},
+and \.{\\fullpageheight} can be redefined in the limbo section at the
+beginning of your \.{CWEB} file, to change the dimensions of each page.
+The default settings
+$$\lpile{\.{\\pagewidth=6.5in}\cr
+ \.{\\pageheight=8.7in}\cr
+ \.{\\fullpageheight=9in}\cr}$$
+were used to prepare this manual; \.{\\fullpageheight} is
+\.{\\pageheight} plus room for the additional heading and page numbers at
+the top of each page. If you change any of these quantities, you should
+call the macro \.{\\setpage} immediately after making the change.
+
+\point 5. The \.{\\pageshift} macro defines an amount by which right-hand
+pages (i.e., odd-numbered pages) are shifted right with respect to
+left-hand (even-numbered) ones. By adjusting this amount you may be
+able to get two-sided output in which the page numbers line up on
+opposite sides of each sheet.
+
+\point 6. The \.{\\title} macro will appear at the top of each page
+in small caps; it is the job name unless redefined.
+
+\point 7. The first page usually is assigned page
+number 1. To start on page 16, with contents
+on page 15, say this: `\.{\\def\\contentspagenumber\{15\}}
+\.{\\pageno=\\contentspagenumber} \.{\\advance\\pageno by 1}'.
+
+\point 8. The macro \.{\\iftitle} will suppress the header line if it is
+defined by `\.{\\titletrue}'. The normal value is \.{\\titlefalse}
+except for the table of contents; thus, the contents
+page is usually unnumbered.
+
+Two macros are provided to give flexibility to the table of
+contents: \.{\\topofcontents} is invoked just before the contents
+info is read, and \.{\\botofcontents} is invoked just after.
+Here's a typical definition:
+$$\lpile{\.{\\def\\topofcontents\{\\null\\vfill}\cr
+ \.{ { }\\titlefalse \% include headline on the contents page}\cr
+ \.{ { }\\def\\rheader\{\\mainfont The \{\\tt CWEAVE\}{ }processor\\hfil\}}\cr
+ \.{ { }\\centerline\{\\titlefont The \{\\ttitlefont CWEAVE\}{ }processor\}}\cr
+ \.{ { }\\vskip 15pt \\centerline\{(Version 3.64)\}{ }\\vfill\}}\cr}$$
+Redefining \.{\\rheader}, which is the headline for right-hand pages,
+suffices in this case to put the desired information at the top of the
+contents page.
+
+\point 9. Data for the table of contents is written to a file that
+is read after the indexes have been \TEX/ed; there's one line of data
+for every starred section. The file \.{common.toc} might look like this:
+$$\lpile{\.{\\ZZ \{Introduction\}\{0\}\{1\}\{28\}\{\}}\cr
+ \.{\\ZZ \{The character set\}\{2\}\{5\}\{29\}\{\}}\cr}$$
+and so on. The \.{\\topofcontents} macro could
+redefine \.{\\ZZ} so that the information appears in any desired format.
+(See also point~19 below.)
+
+\point 10. Sometimes it is necessary or desirable to divide the output of
+\.{CWEAVE} into subfiles that can be processed separately. For example,
+the listing of \TEX/ runs to more than 500 pages, and that is enough to
+exceed the capacity of many printing devices and/or their software.
+When an extremely large job isn't cut into smaller pieces, the entire
+process might be spoiled by a single error of some sort, making it
+necessary to start everything over.
+
+Here's a safe way to break a woven file into three parts:
+Say the pieces are $\alpha$,
+$\beta$, and $\gamma$, where each piece begins with a starred section.
+All macros should be defined in the opening limbo section of $\alpha$,
+and copies of this \TEX/ code should be placed at the
+beginning of $\beta$ and of $\gamma$. In order to process the parts
+separately, we need to take care of two things: The starting page
+numbers of $\beta$ and $\gamma$ need to be set up properly, and
+the table of contents data from all three runs needs to be
+accumulated.
+
+The \.{cwebmac} macros include two control sequences \.{\\contentsfile} and
+\.{\\readcontents} that facilitate the necessary processing. We include
+`\.{\\def\\contentsfile\{cont1\}}' in the limbo section of $\alpha$, and
+we include `\.{\\def\\contentsfile\{cont2\}}' in the limbo section of
+$\beta$; this causes \TEX/ to write the contents data for $\alpha$ and $\beta$
+into \.{cont1.tex} and \.{cont2.tex}. Now in $\gamma$ we say
+$$\.{\\def\\readcontents\{\\input cont1 \\input cont2
+ \\input \\contentsfile\}}\,;$$
+this brings in the data from all three pieces, in the proper order.
+
+However, we still need to solve the page-numbering problem. One way to
+do it is to include the following in the limbo material for $\beta$:
+$$\lpile{\.{\\message\{Please type the last page number of part 1: \}}\cr
+ \.{\\read -1 to \\temp \\pageno=\\temp \\advance\\pageno by 1}\cr}$$
+Then you simply provide the necessary data when \TEX/ requests
+it; a similar construction is used at the beginning of $\gamma$.
+
+This method can, of course, be used to divide a woven file into
+any number of pieces.
+
+\point 11. Sometimes it is nice to include things in the index that are
+typeset in a special way. For example, we might want to have an
+index entry for `\TeX'. \.{CWEAVE} provides two simple ways to
+typeset an index entry (unless the entry is an identifier or a reserved word):
+`\.{@\^}' gives roman type, and `\.{@.}' gives typewriter type.
+But if we try to typeset `\TeX' in roman type by saying, e.g.,
+`\.{@\^\\TeX@>}', the backslash character gets in the way,
+and this entry wouldn't appear in the index with the T's.
+
+The solution is to use the `\.{@:}' feature, declaring a macro that
+simply removes a sort key as follows:
+$$\.{\\def\\9\#1\{\}}$$
+Now you can say, e.g., `\.{@:TeX\}\{\\TeX@>}' in your \.{CWEB} file; \.{CWEAVE}
+puts it into the index alphabetically, based on the sort key, and
+produces the macro call `\.{\\9\{TeX\}\{\\TeX\}}' which will ensure that
+the sort key isn't printed.
+
+A similar idea can be used to insert hidden material into section
+names so that they are alphabetized in whatever way you might wish.
+Some people call these tricks ``special refinements''; others call
+them ``kludges.''
+
+\point 12. The control sequence \.{\\secno} is set to the number of the
+section being typeset.
+
+\point 13. If you want to list only the sections that have changed,
+together with the index, put the command `\.{\\let\\maybe=\\iffalse}' in
+the limbo section before the first section of your \.{CWEB} file. It's
+customary to make this the first change in your change file.
+
+This feature has a \TeX nical limitation, however: You cannot use it
+together with control sequences like \.{\\proclaim} or \.{\\+} or
+\.{\\newcount} that plain \TeX\ has declared to be `\.{\\outer}',
+because \TeX\ refuses to skip silently over such control sequences.
+One way to work around this limitation is to say
+$$\.{\\fi \\let\\proclaim\\relax \\def\\proclaim\{...\} \\ifon}$$
+where \.{\\proclaim} is redefined to be the same as usual but without
+an \.{\\outer} qualification. (The \.{\\fi} here stops the conditional
+skipping, and the \.{\\ifon} turns it back on again.) Similarly,
+$$\.{\\fi \\newcount\\n \\ifon}$$
+is a safe way to use \.{\\newcount}. Plain \TeX\ already provides a
+non-outer macro \.{\\tabalign} that does the work of \.{\\+}; you can say
+$$\postdisplaypenalty=10000
+\.{\\fi \\let\\+\\tabalign \\ifon}$$
+if you prefer the shorter notation \.{\\+}.
+
+\point 14. To get output in languages other than English, redefine the
+macros \.{\\A}, \.{\\As}, \.{\\ET}, \.{\\ETs}, \.{\\Q}, \.{\\Qs}, \.{\\U},
+\.{\\Us}, \.{\\ch}, \.{\\fin}, \.{\\con}, \.{\\today}, \.{\\datethis}, and
+\.{\\datecontentspage}. \.{CWEAVE} itself need not be changed.
+
+\point 15. Some output can be selectively suppressed with the macros
+\.{\\noatl}, \.{\\noinx}, \.{\\nosecs}, \.{\\nocon}.
+
+\point 16. All accents and special text symbols of plain \TEX/ format
+will work in \.{CWEB} documents just as they are described in
+Chapter~9 of {\sl The \TEX/book}, with one exception.
+The dot accent (normally \.{\\.}) must be typed \.{\\:} instead.
+
+\point 17. Several commented-out lines in \.{cwebmac.tex} are suggestions
+that users may wish to adopt. For example, one such line inserts a blank page
+if you have a duplex printer. Appendices D, E, and F of the complete
+version of this manual are printed using a commented-out option that
+substitutes `$\gets$' for `$=$' in the program listings. Looking at those
+appendices might help you decide which format you like better.
+
+\point 18. Andreas Scherer has contributed a macro called \.{\\pdfURL}
+with which one can say things like the following, anywhere in the \TeX\ parts
+or the \CEE/ comments of a \.{CWEB} file:
+$$\vbox{\halign{\.{#}\hfil\cr
+You can send email to
+ \\pdfURL\{the author\}\{mailto:andreas.scherer@@pobox.com\}\cr
+or visit \\pdfURL\{his home page\}\{http://www.pobox.com/%
+ \\TILDE/scherer\}.\cr}}$$
+In a {\mc PDF} document, the first argument will appear in blue as
+clickable text; the Acrobat reader, if correctly configured, will then
+redirect those links to the user's browser and open either the
+email client or the HTML viewer. In a hardcopy document, both arguments
+will be printed ({\tt the second in parentheses and typewriter type}).
+Certain special characters in an Internet address need to be handled
+in a somewhat awkward way, so that \.{CWEAVE} and/or \TeX\
+will not confuse them with formatting controls: Use \.{@@} for \.@
+and \.{\\TILDE/} for \.\~ and \.{\\UNDER/} for \.\_.
+
+\point 19. {\mc PDF} documents contain bookmarks that list all the major group
+titles in the table of contents, some of which will be subsidiary to
+others if the depth feature of \.{@*} has been used.
+Such bookmark entries are also known as ``outlines.''
+Moreover, the final group title, `Names of the sections',
+can be opened up to list every section name; Acrobat users can therefore
+navigate easily to any desired section.
+
+The macros of \.{cwebmac.tex} are careful to ``sanitize'' all the names
+that appear as bookmarks, by removing special characters and
+formatting codes that are inappropriate for the limited typographic
+capabilities of {\mc PDF} outlines. For example, one section of \.{CWEAVE}
+is named `Cases for \\{case\_like}', which is represented by the \TeX\ code
+`\.{Cases} \.{for} \.{\\PB\{\\\\\{case\\\_like\}\}}' in \.{cweave.tex}; its
+sanitized name is simply `\.{Cases} \.{for} \.{case\_like}'.
+(When \.{.pdf} files are produced, the fifth parameter of every \.{\\ZZ} in
+the \.{.toc} file is set to the sanitized form of the first parameter;
+see point~9 above and point~20 below.)
+
+In general, sanitization removes \TeX\ control sequences and braces,
+except for control sequences defined by \.{CWEB} itself. Such a translation
+works most of the time, but you can override the defaults and obtain any
+translation that you want by using \TeX nical tricks. For example, after
+$$\.{\\sanitizecommand\\foo\{bar\}}$$
+the control sequence \.{\\foo} will sanitize to `\.{bar}'. And after
+$$\.{\\def\\kluj\#1\\\\\{foo\}}$$
+the \TeX\ code `\.{\\kluj bar\\\\}' will print as `foo' but sanitize
+to `\.{bar}', because the control sequences \.{\\kluj} and
+\.{\\\\} are removed by sanitization.
+
+\point 20. Furthermore, group titles can be converted to an arbitrary
+sanitized text while also changing their form in running headlines, by
+using \.{\\ifheader}. Consider, for example, a \.{CWEB} source file that
+begins with the two lines
+$$\lpile{\.{\\def\\klujj\#1\\\\\{\\ifheader FOO\\else foo\\fi\}}\cr
+\.{@*Chinese \\klujj bar\\.}\cr}$$
+This coding introduces a major group entitled `{\bf Chinese foo}', with
+running headline `{\eightrm CHINESE FOO}' and table-of-contents entry
+`Chinese foo'. The corresponding bookmark is, however, `\.{Chinese} \.{bar}'.
+And the corresponding \.{.toc} file entry is
+`\.{\\ZZ \{Chinese \\klujj bar\\\\\}\{1\}\{1\}\{1\}\{Chinese bar\}}'.
+
+\vfill\end
+
diff --git a/Build/source/texk/web2c/cwebdir/depend.mak b/Build/source/texk/web2c/cwebdir/depend.mak
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/depend.mak
diff --git a/Build/source/texk/web2c/cwebdir/makefile.bs b/Build/source/texk/web2c/cwebdir/makefile.bs
new file mode 100644
index 00000000000..5e970128049
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/makefile.bs
@@ -0,0 +1,60 @@
+# Makefile for CTANGLE and CWEAVE, pc/big versions, using
+# Borland C++ 3.1 and Borland Make.
+#
+# (This file contributed by Barry Schwartz, trashman@crud.mn.org,
+# 24 Jul 94.)
+
+
+
+CC = bcc
+
+# Redundant Load Suppression (-Z) is turned off, because it seems to
+# break the code. Likewise for Copy Propagation (-Op). (These
+# optimizations don't seem to cause any problems in common.w, but
+# better safe than sorry--compile everything with them turned off.)
+OPT = -O2-p -Z-
+
+# Compile with symbols. That way you'll be able to use the debugger if
+# you run into trouble. You can always use tdstrip later, to remove the
+# symbols.
+DEBUG = -v
+
+LCFLAGS = -mc -Ff=5000 -d -w-pro $(DEBUG)
+CFLAGS = $(LCFLAGS) $(OPT)
+COMPILE = $(CC) $(CFLAGS)
+
+LINK = $(CC) $(LCFLAGS) -e
+
+
+
+# Where to find an "old" version of ctangle, for bootstrapping. The first
+# time you make ctangle, you may have to edit the distributed ctangle.c
+# and/or common.c by hand to reduce the size of one or more arrays.
+# This will give you a functional ctangle.exe, which you can use to bootstrap
+# the "real" ctangle.exe.
+CTANGLE = ctangle
+
+
+
+
+all default: ctangle.exe cweave.exe
+
+
+ctangle.exe: ctangle.obj common.obj
+ $(LINK)$* $**
+
+cweave.exe: cweave.obj common.obj
+ $(LINK)$* $**
+
+
+common.obj: common.w comm-bs.ch
+ $(CTANGLE) common.w comm-bs.ch
+ $(COMPILE) -c common.c
+
+ctangle.obj: ctangle.w common.h ctang-bs.ch
+ $(CTANGLE) ctangle.w ctang-bs.ch
+ $(COMPILE) -c ctangle.c
+
+cweave.obj: cweave.w common.h cweav-bs.ch
+ $(CTANGLE) cweave.w cweav-bs.ch
+ $(COMPILE) -c cweave.c
diff --git a/Build/source/texk/web2c/cwebdir/prod.w b/Build/source/texk/web2c/cwebdir/prod.w
new file mode 100644
index 00000000000..5f76a193794
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/prod.w
@@ -0,0 +1,307 @@
+% This file is part of CWEB.
+% This program by Silvio Levy and Donald E. Knuth
+% is based on a program by Knuth.
+% It is distributed WITHOUT ANY WARRANTY, express or implied.
+% Version 3.6 --- May 2000
+%
+@ Here is a table of all the productions. Each production that
+combines two or more consecutive scraps implicitly inserts a {\tt \$}
+where necessary, that is, between scraps whose abutting boundaries
+have different |mathness|. In this way we never get double {\tt\$\$}.
+
+% The following kludge is needed because \newcount, \newdimen, and \+
+% are "\outer" control sequences that cannot be used in skipped text!
+\fi \newcount\prodno \newdimen\midcol \let\+\relax \ifon
+
+\def\v{\char'174}
+\mathchardef\RA="3221 % right arrow
+\mathchardef\BA="3224 % double arrow
+
+A translation is provided when the resulting scrap is not merely a
+juxtaposition of the scraps it comes from. An asterisk$^*$ next to a scrap
+means that its first identifier gets an underlined entry in the index,
+via the function |make_underlined|. Two asterisks$^{**}$ means that both
+|make_underlined| and |make_reserved| are called; that is, the
+identifier's ilk becomes |raw_int|. A dagger \dag\ before the
+production number refers to the notes at the end of this section,
+which deal with various exceptional cases.
+
+We use \\{in}, \\{out}, \\{back} and
+\\{bsp} as shorthands for |indent|, |outdent|, |backup| and
+|break_space|, respectively.
+
+\begingroup \lineskip=4pt
+\def\alt #1 #2
+{$\displaystyle\Bigl\{\!\matrix{\strut\hbox{#1}\cr
+ \strut\hbox{#2}\cr}\!\Bigr\}$ }
+\def\altt #1 #2 #3
+{$\displaystyle\Biggl\{\!\matrix{\strut\hbox{#1}\cr\hbox{#2}\cr
+ \strut\hbox{#3}\cr}\!\Biggr\}$ }
+\def\malt #1 #2
+{$\displaystyle\matrix{\strut\hbox{#1}\hfill\cr\strut\hbox{#2}\hfill\cr}$}
+\def\maltt #1 #2 #3
+{$\displaystyle\matrix{\strut\hbox{#1}\hfill\cr\hbox{#2}\hfill\cr
+ \strut\hbox{#3}\hfill\cr}$}
+\yskip
+\prodno=0 \midcol=2.5in
+\def\theprodno{\number\prodno \global\advance\prodno by1\enspace}
+\def\dagit{\dag\theprodno}
+\def\+#1&#2&#3&#4\cr{\def\next{#1}%
+ \line{\hbox to 2em{\hss
+ \ifx\next\empty\theprodno\else\next\fi}\strut
+ \ignorespaces#2\hfil\hbox to\midcol{$\RA$
+ \ignorespaces#3\hfil}\quad \hbox to1.45in{\ignorespaces#4\hfil}}}
+\+\relax & LHS & RHS \hfill Translation & Example\cr
+\yskip
+\+& \altt\\{any} {\\{any} \\{any}} {\\{any} \\{any} \\{any}}
+|insert| & \altt\\{any} {\\{any} \\{any}} {\\{any} \\{any} \\{any}}
+& stmt; \ /$\ast\,$comment$\,*$/\cr
+\+& |exp| \altt|lbrace| |int_like| |decl|
+ & |fn_decl| \altt|lbrace| |int_like| |decl|
+ \hfill $F=E^*\,|in|\,|in|$ & \malt {\\{main}()$\{$}
+ {\\{main}$(\\{ac},\\{av})$ \&{int} \\{ac};} \cr
+\+& |exp| |unop| & |exp| & |x++|\cr
+\+& |exp| \alt |binop| |ubinop| |exp| & |exp| & \malt {|x/y|} {|x+y|} \cr
+\+& |exp| |comma| |exp| & |exp| \hfill $EC\,|opt|9\,E$& |f(x,y)|\cr
+\+& |exp| \alt {|lpar| |rpar|} |cast| |colon| &
+ |exp| \alt {|lpar| |rpar|} |cast| |base| &
+ \malt \&C|()|: {\&C|int i)|:} \cr
+\+& |exp| |semi| & |stmt| & |x=0;|\cr
+\+& |exp| |colon| & |tag| \hfill $E^*C$ & |found:|\cr
+\+& |exp| |rbrace| & |stmt| |rbrace| & end of \&{enum} list\cr
+\+& |exp| \alt {|lpar| |rpar|} |cast| \alt|const_like| |case_like| &
+ |exp| \alt {|lpar| |rpar|} |cast| \hfill
+ \alt $R=R\.\ C$ $C_1=C_1\.\ C_2$ &
+ \malt {|f() const|} {|f(int) throw|} \cr
+\+& |exp| \alt |exp| |cast| & |exp| & |time()|\cr
+\+& |lpar| \alt |exp| |ubinop| |rpar| & |exp| & \malt{|(x)|} {|(*)|} \cr
+\+& |lpar| |rpar| & |exp| \hfill $L\.{\\,}R$ & functions, declarations\cr
+\+& |lpar| \altt |decl_head| |int_like| |cast| |rpar| & |cast| & |(char*)|\cr
+\+& |lpar| \altt |decl_head| |int_like| |exp| |comma| & |lpar| \hfill
+ $L$\,\altt $D$ $I$ $E$ $C$\,|opt|9 & |(int,|\cr
+\+& |lpar| \alt |stmt| |decl| & |lpar| \hfill \alt {$LS\.\ $} {$LD\.\ $} &
+ \malt {|(k=5;|} {|(int k=5;|} \cr
+\+& |unop| \alt |exp| |int_like| & |exp| &
+ \malt |!x| |~|\&C \cr
+\+& |ubinop| |cast| |rpar| & |cast| |rpar| \hfill
+ $C=\.\{U\.\}C$ & |*|\&{CPtr}) \cr
+\+& |ubinop| \alt|exp| |int_like| & \alt|exp| |int_like| \hfill
+ \.\{$U$\.\}\alt$E$ $I$ & \malt |*x| |*|\&{CPtr} \cr
+\+& |ubinop| |binop| & |binop| \hfill $|math_rel|\,U\.\{B\.\}\.\}$ & |*=|\cr
+\+& |binop| |binop| & |binop| \hfill
+ $|math_rel|\,\.\{B_1\.\}\.\{B_2\.\}\.\}$ & |>>=|\cr
+\+& |cast| \alt |lpar| |exp| & \alt |lpar| |exp| \hfill
+ \alt $CL$ $C\.\ E$ & \malt |(double)(x+2)| |(double)x| \cr
+\+& |cast| |semi| & |exp| |semi| & |(int);|\cr
+\+& |sizeof_like| |cast| & |exp| & |sizeof (double)|\cr
+\+& |sizeof_like| |exp| & |exp| \hfill $S\.\ E$ & |sizeof x|\cr
+\+& |int_like| \alt|int_like| |struct_like| &
+ \alt|int_like| |struct_like| \hfill $I\.\ $\alt $I$ $S$
+ \unskip& |extern char|\cr
+\+& |int_like| |exp| \alt|raw_int| |struct_like| &
+ |int_like| \alt|raw_int| |struct_like| & |extern "Ada" int|\cr
+\+& |int_like| \altt|exp| |ubinop| |colon| &
+ |decl_head| \altt|exp| |ubinop| |colon| \hfill
+ $D=I$\.\ & \maltt|int x| |int*x| |unsigned:| \cr
+\+& |int_like| \alt |semi| |binop| & |decl_head| \alt |semi| |binop| &
+ \malt |int x;| {\&{int} $f(\&{int}=4)$} \cr
+\+& |public_like| |colon| & |tag| & \&{private}:\cr
+\+& |public_like| & |int_like| & \&{private}\cr
+\+& |colcol| \alt|exp| |int_like| & \alt|exp| |int_like| \hfill
+ |qualifier| $C$ \alt$E$ $I$ & \&C\DC$x$\cr
+\+& |colcol| |colcol| & |colcol| & \&C\DC\&B\DC\cr
+\+& |decl_head| |comma| & |decl_head| \hfill $DC\.\ $ & |int x,|\cr
+\+& |decl_head| |ubinop| & |decl_head| \hfill $D\.\{U\.\}$ & |int *|\cr
+\+\dagit& |decl_head| |exp| & |decl_head| \hfill $DE^*$ & |int x|\cr
+\+& |decl_head| \alt|binop| |colon| |exp| \altt|comma| |semi| |rpar| &
+ |decl_head| \altt|comma| |semi| |rpar| \hfill
+ $D=D$\alt $B$ $C$ \unskip$E$ & \malt {\&{int} $f(\&{int}\ x=2)$} |int b:1| \cr
+\+& |decl_head| |cast| & |decl_head| & |int f(int)|\cr
+\+& |decl_head| \altt|int_like| |lbrace| |decl| & |fn_decl|
+ \altt|int_like| |lbrace| |decl| \hfill $F=D\,|in|\,|in|$
+ & |long time () {|\cr
+\+& |decl_head| |semi| & |decl| & |int n;|\cr
+\+& |decl| |decl| & |decl| \hfill $D_1\,|force|\,D_2$ & |int n;double x;|\cr
+\+& |decl| \alt|stmt| |function| & \alt|stmt| |function|
+ \hfill $D\,|big_force|\,$\alt $S$ $F$ \unskip& \&{extern} $n$;
+ \\{main} ()|{}|\cr
+\+& |base| \alt |int_like| |exp| |comma| & |base| \hfill
+ $B$\.\ \alt $I$ $E$ \unskip$C$\,|opt|9
+ & \malt {: \&{public} \&A,} {: $i(5)$,} \cr
+\+& |base| \alt |int_like| |exp| |lbrace| & |lbrace| \hfill
+ $B$\.\ \alt $I$ $E$ \unskip\.\ $L$ & \&D : \&{public} \&A $\{$\cr
+\+& |struct_like| |lbrace| & |struct_head| \hfill $S\.\ L$ & |struct {|\cr
+\+& |struct_like| \alt|exp| |int_like| |semi| & |decl_head| |semi|
+ \hfill $S\.\ $\alt $E^{**}$ $I^{**}$ & \&{struct} \&{forward};\cr
+\+& |struct_like| \alt|exp| |int_like| |lbrace| & |struct_head| \hfill
+ $S\.\ $\alt $E^{**}$ $I^{**}$ \unskip $\.\ L$ &
+ \&{struct} \&{name\_info} $\{$\cr
+\+& |struct_like| \alt|exp| |int_like| |colon| &
+ |struct_like| \alt|exp| |int_like| |base| & |class| \&C :\cr
+\+\dagit& |struct_like| \alt|exp| |int_like| & |int_like|
+ \hfill $S\.\ $\alt$E$ $I$ & \&{struct} \&{name\_info} $z$;\cr
+\+& |struct_head| \altt|decl| |stmt| |function| |rbrace| & |int_like|\hfill
+ $S\,\\{in}\,|force|$\altt$D$ $S$ $F$ $\\{out}\,|force|\,R$ &
+ |struct {| declaration |}|\cr
+\+& |struct_head| |rbrace| & |int_like|\hfill $S\.{\\,}R$ & |class C{}|\cr
+\+& |fn_decl| |decl| & |fn_decl| \hfill $F\,|force|\,D$
+ & $f(z)$ \&{double} $z$; \cr
+\+& |fn_decl| |stmt| & |function| \hfill $F\,|out|\,|out|\,|force|\,S$
+ & \\{main}() {\dots}\cr
+\+& |function| \altt|stmt| |decl| |function| & \altt |stmt| |decl| |function|
+ \hfill $F\,|big_force|\,$\altt $S$ $D$ $F$ & outer block\cr
+\+& |lbrace| |rbrace| & |stmt| \hfill $L\.{\\,}R$ & empty statement\cr
+\advance\midcol35pt
+\+& |lbrace| \altt|stmt| |decl| |function| |rbrace| & |stmt| \hfill
+ $|force|\,L\,\\{in}\,|force|\,S\,
+ |force|\,\\{back}\,R\,\\{out}\,|force|$ & compound statement\cr
+\advance\midcol-20pt
+\+& |lbrace| |exp| [|comma|] |rbrace| & |exp| & initializer\cr
+\+& |if_like| |exp| & |if_clause| \hfill $I\.{\ }E$ & |if (z)|\cr
+\+& |else_like| |colon| & |else_like| |base| & \&{try} :\cr
+\+& |else_like| |lbrace| & |else_head| |lbrace| & \&{else} $\{$\cr
+\+& |else_like| |stmt| & |stmt| \hfill
+ $|force|\,E\,\\{in}\,\\{bsp}\,S\,\\{out}\,|force|$ & |else x=0;|\cr
+\+& |else_head| \alt|stmt| |exp| & |stmt| \hfill
+ $|force|\,E\,\\{bsp}\,|noop|\,|cancel|\,S\,\\{bsp}$ & |else{x=0;}|\cr
+\+& |if_clause| |lbrace| & |if_head| |lbrace| & |if (x) {|\cr
+\+& |if_clause| |stmt| |else_like| |if_like| & |if_like| \hfill
+ $|force|\,I\,\\{in}\,\\{bsp}\,S\,\\{out}\,|force|\,E\,\.\ I$ &
+ |if (x) y; else if|\cr
+\+& |if_clause| |stmt| |else_like| & |else_like| \hfill
+ $|force|\,I\,\\{in}\,\\{bsp}\,S\,\\{out}\,|force|\,E$ &
+ |if (x) y; else|\cr
+\+& |if_clause| |stmt| & |else_like| |stmt| & |if (x)|\cr
+\+& |if_head| \alt|stmt| |exp| |else_like| |if_like| & |if_like| \hfill
+ $|force|\,I\,\\{bsp}\,|noop|\,|cancel|\,S\,|force|\,E\,\.\ I$ &
+ |if (x){y;}else if|\cr
+\+& |if_head| \alt|stmt| |exp| |else_like| & |else_like| \hfill
+ $|force|\,I\,\\{bsp}\,|noop|\,|cancel|\,S\,|force|\,E$ &
+ |if (x){y;}else|\cr
+\+& |if_head| \alt|stmt| |exp| & |else_head| \alt|stmt| |exp| & |if (x){y;}|\cr
+\advance\midcol20pt
+\+& |do_like| |stmt| |else_like| |semi| & |stmt| \hfill
+ $D\,\\{bsp}\,|noop|\,|cancel|\,S\,|cancel|\,|noop|\,\\{bsp}\,ES$%
+ & |do f(x); while (g(x));|\cr
+\advance\midcol-20pt
+\+& |case_like| |semi| & |stmt| & |return;|\cr
+\+& |case_like| |colon| & |tag| & |default:|\cr
+\+& |case_like| |exp| & |exp| \hfill $C\.\ E$ & |return 0|\cr
+\+& |catch_like| \alt|cast| |exp| & |fn_decl| \hfill
+ $C$\alt $C$ $E$ \\{in}\,\\{in} & |catch (...)|\cr
+\+& |tag| |tag| & |tag| \hfill $T_1\,\\{bsp}\,T_2$ & |case 0: case 1:|\cr
+\+& |tag| \altt|stmt| |decl| |function| & \altt|stmt| |decl| |function|
+ \hfill $|force|\,\\{back}\,T\,\\{bsp}\,S$ & |case 0: z=0;|\cr
+\+\dagit& |stmt| \altt|stmt| |decl| |function| &
+ \altt|stmt| |decl| |function|
+ \hfill $S\,$\altt$|force|\,S$ $|big_force|\,D$ $|big_force|\,F$ &
+ |x=1;y=2;|\cr
+\+& |semi| & |stmt| \hfill \.\ $S$& empty statement\cr
+\+\dagit& |lproc| \altt |if_like| |else_like| |define_like| & |lproc| &
+ \maltt {{\bf \#include}} {\bf\#else} {\bf\#define} \cr
+\+& |lproc| |rproc| & |insert| & {\bf\#endif} \cr
+\+& |lproc| \alt {|exp| [|exp|]} |function| |rproc| & |insert| \hfill
+ $I$\.\ \alt {$E{[\.{\ \\5}E]}$} {$F$} &
+ \malt{{\bf\#define} $a$\enspace 1} {{\bf\#define} $a$\enspace$\{\,b;\,\}$} \cr
+\+& |section_scrap| |semi| & |stmt|\hfill $MS$ |force|
+ &$\langle\,$section name$\,\rangle$;\cr
+\+& |section_scrap| & |exp| &$\langle\,$section name$\,\rangle$\cr
+\+& |insert| |any| & |any| & \.{\v\#include\v}\cr
+\+& |prelangle| & |binop| \hfill \.< & $<$ not in template\cr
+\+& |prerangle| & |binop| \hfill \.> & $>$ not in template\cr
+\+& |langle| |prerangle| & |cast| \hfill $L\.{\\,}P$ & $\langle\,\rangle$\cr
+\+& |langle| \altt|decl_head| |int_like| |exp| |prerangle| & |cast| &
+ $\langle\&{class}\,\&C\rangle$\cr
+\+& |langle| \altt|decl_head| |int_like| |exp| |comma| & |langle| \hfill
+ $L$\,\altt $D$ $I$ $E$ $C$\,|opt|9 & $\langle\&{class}\,\&C,$\cr
+\+& |template_like| |exp| |prelangle| & |template_like| |exp| |langle| &
+ \&{template} $a\langle100\rangle$\cr
+\+& |template_like| \alt|exp| |raw_int| & \alt|exp| |raw_int| \hfill
+ $T$\.\ \alt$E$ $R$ & \&C\DC\&{template} |a()|\cr
+\+& |template_like| & |raw_int| & \&{template}$\langle\&{class}\,\&T\rangle$\cr
+\+& |new_like| |lpar| |exp| |rpar| & |new_like| & \&{new}(\\{nothrow})\cr
+\+& |new_like| |cast| & |exp| \hfill $N\.\ C$ & |new(int*)|\cr
+\+\dagit& |new_like| & |new_exp| & \&{new} \&C|()|\cr
+\+& |new_exp| \alt|int_like| |const_like| & |new_exp| \hfill
+ $N$\.\ \alt $I$ $C$ & |new const int|\cr
+\+& |new_exp| |struct_like| \alt |exp| |int_like| & |new_exp| \hfill
+ $N\.\ S$\.\ \alt $E$ $I$ & \&{new} \&{struct} \&S\cr
+\+& |new_exp| |raw_ubin| & |new_exp| \hfill $N\.\{R\.\}$ & |new int*[2]|\cr
+\+& |new_exp| \alt |lpar| |exp| & |exp| \alt |lpar| |exp| \hfill
+ $E=N$\,\alt {} {\.\ } & \malt |operator[](int)| {|new int(2)|} \cr
+\+\dagit& |new_exp| & |exp| & |new int;|\cr
+\+& |ftemplate| |prelangle| & |ftemplate| |langle| & |make_pair<int,int>|\cr
+\+& |ftemplate| & |exp| & |make_pair(1,2)|\cr
+\+& |for_like| |exp| & |else_like| \hfill $F\.\ E$ & |while (1)|\cr
+\+& |raw_ubin| |const_like| & |raw_ubin| \hfill $RC$\.{\\\ }
+ & $*$\&{const} |x|\cr
+\+& |raw_ubin| & |ubinop| & $*$ |x|\cr
+\+& |const_like| & |int_like| & \&{const} |x|\cr
+\+& |raw_int| |prelangle| & |raw_int| |langle| & \&C$\langle$\cr
+\+& |raw_int| |colcol| & |colcol| & \&C\DC\cr
+\+& |raw_int| |cast| & |raw_int| & \&C$\langle\&{class}\ \&T\rangle$\cr
+\+& |raw_int| |lpar| & |exp| |lpar| & \&{complex}$(x,y)$\cr
+\+\dagit& |raw_int| & |int_like| & \&{complex} |z|\cr
+\+\dagit& |operator_like| \altt|binop| |unop| |ubinop| & |exp|
+ \hfill $O$\.\{\altt $B$ $U$ $U$ \unskip\.\} & |operator+|\cr
+\+& |operator_like| \alt|new_like| |delete_like| & |exp| \hfill
+ $O$\.\ \alt $N$ $S$ & |operator delete|\cr
+\+& |operator_like| |comma| & |exp| & \&{operator},\cr
+\+\dagit& |operator_like| & |new_exp| & |operator char*|\cr
+\advance\midcol-8pt
+\+& |typedef_like| \alt|int_like| |cast| \alt|comma| |semi| &
+ |typedef_like| |exp| \alt|comma| |semi| & \&{typedef} \&{int} \&I,\cr
+\advance\midcol+8pt
+\+& |typedef_like| |int_like| & |typedef_like| \hfill $T\.\ I$ &
+ \&{typedef} \&{char}\cr
+\+\dagit& |typedef_like| |exp| & |typedef_like| \hfill $T\.\ E^{**}$ &
+ \&{typedef} \&I \.{@@[@@]} (|*|\&P)\cr
+\+& |typedef_like| |comma| & |typedef_like| \hfill $TC\.\ $ &
+ \&{typedef} \&{int} \&x,\cr
+\+& |typedef_like| |semi| & |decl| & \&{typedef} \&{int} $\&x,\&y$;\cr
+\+& |typedef_like| |ubinop| \alt |cast| |ubinop| &
+ |typedef_like| \alt |cast| |ubinop| \hfill
+ \alt $C=\.\{U\.\}C$ $U_2=\.\{U_1\.\}U_2$ \unskip &
+ \&{typedef} |*|{}|*|(\&{CPtr})\cr
+\+& |delete_like| |lpar| |rpar| & |delete_like|\hfill $DL\.{\\,}R$ &
+ \&{delete}|[]| \cr
+\+& |delete_like| |exp| & |exp| \hfill $D\.\ E$ & |delete p| \cr
+\+\dagit& |question| |exp| \alt |colon| |base| & |binop| &
+ \malt |?x:| |?f():| \cr
+\+& |begin_arg| |end_arg| & |exp| & \.{@@[}\&{char}$*$\.{@@]}\cr
+\+& |any_other| |end_arg| & |end_arg| & \&{char}$*$\.{@@]}\cr
+\yskip
+\yskip
+\yskip
+\parindent=0pt
+\dag{\bf Notes}
+\yskip
+Rule 35: The |exp| must not be immediately followed by |lpar|, |exp|,
+ or~|cast|.
+
+Rule 48: The |exp| or |int_like| must not be immediately followed by |base|.
+
+Rule 76: The |force| in the |stmt| line becomes \\{bsp} if \.{CWEAVE} has
+been invoked with the \.{-f} option.
+
+Rule 78: The |define_like| case calls |make_underlined| on the following scrap.
+
+Rule 94: The |new_like| must not be immediately followed by |lpar|.
+
+Rule 99: The |new_exp| must not be immediately followed by |raw_int|,
+|struct_like|, or |colcol|.
+
+Rule 110: The |raw_int| must not be immediately followed by |langle|.
+
+Rule 111: The operator after |operator_like|
+must not be immediately followed by a |binop|.
+
+Rule 114: The |operator_like| must not be immediately followed by
+|raw_ubin|.
+
+Rule 117: The |exp| must not be immediately followed by |lpar|, |exp|,
+or |cast|.
+
+Rule 123: The mathness of the |colon| or |base| changes to `yes'.
+
+\endgroup
diff --git a/Build/source/texk/web2c/cwebdir/readme.ql b/Build/source/texk/web2c/cwebdir/readme.ql
new file mode 100644
index 00000000000..907d4c3192b
--- /dev/null
+++ b/Build/source/texk/web2c/cwebdir/readme.ql
@@ -0,0 +1,84 @@
+This is the readme file for CWEB for QDOS/SMSQ systems
+
+(These instructions are for systems with Toolkit II,
+ please report any problems to me, the address is at the
+ end of the file)
+
+If you want to compile CWEB for your QL system, you must first
+convert the ASCII code to the QL's character set. Therefore you
+can use the little BASIC program appended at the end of the file.
+
+For a first version you have to alter the supplied ctangle_c file.
+Set your DATA_USE to the directory you have the CWEB sources in, and
+the PROG_USE to C68's directory.
+compile it with:
+ex cc;'common_c ctangle_c -bufp500K -octangle'
+
+then ctangle the source files with:
+ex datad$&'ctangle';'common_w comm-ql_ch'
+ex datad$&'ctangle';'ctangle_w ctang-ql_ch'
+ex datad$&'ctangle';'cweave_w cweav-ql_ch'
+
+Compile the following way (C68v4.14 +):
+
+ex cc;'-c common_c'
+ex cc;'-c ctangle_c'
+ex cc;'-c cweave_c'
+ex ld;'-bufp500K common_o ctangle_o -octangle'
+ex ld;'-bufp500K common_o cweave_o -ocweave'
+
+After that copy the ctangle and cweave executables into your
+programs directory (if you want them there).
+
+The DATA default may be used as usual. E.g. if you have
+a file win2_data_test_w and the DATA default set to
+win2_data_ you may call ctangle with
+ ex ctangle;'test'
+assuming that ctangle is in your PROG default.
+
+Please report any problems with the QL version to:
+Robert Klein
+Bluecherstrasse 24
+D-56349 Kaub
+Germany
+
+
+**************** ASCII Conversion program ***************
+With this program you can convert DOS and Unix 7-Bit ASCII
+files to the QL's character set. You'll need Toolkit II.
+The program will take all the files in the source directory
+and put them converted into the destination&source directory,
+e.g. you have as drive1$='win2_', drive2$='win3_',
+path1$='cweb_' and path2$='ql_'. Then the routine will take
+all files in win2_cweb_ (wthout subdirectories!) convert them
+and write them to 'win3_ql_cweb_'. It's only a lousy hack,
+but it'll do it's job.
+
+1000 DEFine PROCedure dos2ql (drive1$,path1$,drive2$,path2$)
+1002 LOCal zx$,zx%,ishl,ashl
+1005 DELETE drive2$&path2$&'dirlist'
+1010 OPEN_NEW#5,drive2$&path2$&'dirlist'
+1020 DIR#5,drive1$&path1$
+1030 CLOSE#5
+1040 OPEN_IN#5,drive2$&path2$&'dirlist'
+1050 INPUT#5,zx$:INPUT#5,zx$:REMark devicename and sectors
+1060 REPeat ashl
+1070 IF EOF(#5)THEN EXIT ashl
+1080 INPUT#5,zx$
+1085 IF '->' INSTR zx$ THEN NEXT ashl
+1090 OPEN_IN#3,drive1$&zx$
+1100 OPEN_NEW#4,drive2$&path2$&zx$
+1110 REPeat ishl
+1120 IF EOF(#3)THEN EXIT ishl
+1130 BGET#3,zx%
+1140 SELect ON zx%
+1150 = 13:REMark do nothing (DOS LineFeed)
+1155 = 26:REMark do nothing (DOS EOF sign)
+1160 = 96: BPUT#4,159:REMark Unix/DOS beginning quote sign
+1170 = REMAINDER : BPUT#4,zx%
+1180 END SELect
+1190 END REPeat ishl
+1195 CLOSE#3:CLOSE#4
+1200 END REPeat ashl
+1205 CLOSE#5
+1210 END DEFine dos2ql
diff --git a/Build/source/texk/web2c/depend.mak b/Build/source/texk/web2c/depend.mak
new file mode 100644
index 00000000000..6bb610be06c
--- /dev/null
+++ b/Build/source/texk/web2c/depend.mak
@@ -0,0 +1,1244 @@
+$(objdir)/odvitype.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ odvitype.h
+
+$(objdir)/pooltype.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ pooltype.h
+
+$(objdir)/cwebboot.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/kpathsea.h \
+ $(kpathseadir)/absolute.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/c-dir.h \
+ $(kpathseadir)/c-namemx.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/c-stat.h \
+ $(kpathseadir)/cnf.h \
+ $(kpathseadir)/concatn.h \
+ $(kpathseadir)/db.h \
+ $(kpathseadir)/str-list.h \
+ $(kpathseadir)/default.h \
+ $(kpathseadir)/expand.h \
+ $(kpathseadir)/fn.h \
+ $(kpathseadir)/fontmap.h \
+ $(kpathseadir)/hash.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/magstep.h \
+ $(kpathseadir)/paths.h \
+ $(kpathseadir)/pathsearch.h \
+ $(kpathseadir)/str-llist.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/remote.h \
+ $(kpathseadir)/tex-glyph.h \
+ $(kpathseadir)/tex-hush.h \
+ $(kpathseadir)/tex-make.h \
+ $(kpathseadir)/tilde.h \
+ $(kpathseadir)/truncate.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/xopendir.h \
+ $(kpathseadir)/xstat.h
+
+$(objdir)/eomegafirst.obj: \
+ omegad.h \
+ texmfmp.h \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-make.h \
+ texmfmem.h \
+ omegamem.h \
+ omegacoerce.h
+
+$(objdir)/dvitype.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ dvitype.h
+
+$(objdir)/tie.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h
+
+$(objdir)/gftype.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ gftype.h
+
+$(objdir)/tangle.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ tangle.h
+
+$(objdir)/tex.obj: \
+ texmfmp.h \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-make.h \
+ texmfmem.h \
+ texcoerce.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/absolute.h \
+ texmfmp-help.h
+
+$(objdir)/dvicopy.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ dvicopy.h
+
+$(objdir)/patgen.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ patgen.h
+
+$(objdir)/otangle.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ otangle.h
+
+$(objdir)/eomegabis.obj: \
+ omegad.h \
+ texmfmp.h \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-make.h \
+ texmfmem.h \
+ omegamem.h \
+ omegacoerce.h
+
+$(objdir)/cweave.obj: \
+ $(kpathseadir)/kpathsea.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/absolute.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/c-dir.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/c-namemx.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/c-stat.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/cnf.h \
+ $(kpathseadir)/concatn.h \
+ $(kpathseadir)/db.h \
+ $(kpathseadir)/str-list.h \
+ $(kpathseadir)/default.h \
+ $(kpathseadir)/expand.h \
+ $(kpathseadir)/fn.h \
+ $(kpathseadir)/fontmap.h \
+ $(kpathseadir)/hash.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/magstep.h \
+ $(kpathseadir)/paths.h \
+ $(kpathseadir)/pathsearch.h \
+ $(kpathseadir)/str-llist.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/remote.h \
+ $(kpathseadir)/tex-file.h \
+ $(kpathseadir)/tex-glyph.h \
+ $(kpathseadir)/tex-hush.h \
+ $(kpathseadir)/tex-make.h \
+ $(kpathseadir)/tilde.h \
+ $(kpathseadir)/truncate.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/xopendir.h \
+ $(kpathseadir)/xstat.h
+
+$(objdir)/ctangleboot.obj: \
+ $(kpathseadir)/kpathsea.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/absolute.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/c-dir.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/c-namemx.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/c-stat.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/cnf.h \
+ $(kpathseadir)/concatn.h \
+ $(kpathseadir)/db.h \
+ $(kpathseadir)/str-list.h \
+ $(kpathseadir)/default.h \
+ $(kpathseadir)/expand.h \
+ $(kpathseadir)/fn.h \
+ $(kpathseadir)/fontmap.h \
+ $(kpathseadir)/hash.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/magstep.h \
+ $(kpathseadir)/paths.h \
+ $(kpathseadir)/pathsearch.h \
+ $(kpathseadir)/str-llist.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/remote.h \
+ $(kpathseadir)/tex-file.h \
+ $(kpathseadir)/tex-glyph.h \
+ $(kpathseadir)/tex-hush.h \
+ $(kpathseadir)/tex-make.h \
+ $(kpathseadir)/tilde.h \
+ $(kpathseadir)/truncate.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/xopendir.h \
+ $(kpathseadir)/xstat.h
+
+$(objdir)/odvicopy.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ odvicopy.h
+
+$(objdir)/dvitomp.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ dvitomp.h
+
+$(objdir)/cweb.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/kpathsea.h \
+ $(kpathseadir)/absolute.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/c-dir.h \
+ $(kpathseadir)/c-namemx.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/c-stat.h \
+ $(kpathseadir)/cnf.h \
+ $(kpathseadir)/concatn.h \
+ $(kpathseadir)/db.h \
+ $(kpathseadir)/str-list.h \
+ $(kpathseadir)/default.h \
+ $(kpathseadir)/expand.h \
+ $(kpathseadir)/fn.h \
+ $(kpathseadir)/fontmap.h \
+ $(kpathseadir)/hash.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/magstep.h \
+ $(kpathseadir)/paths.h \
+ $(kpathseadir)/pathsearch.h \
+ $(kpathseadir)/str-llist.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/remote.h \
+ $(kpathseadir)/tex-glyph.h \
+ $(kpathseadir)/tex-hush.h \
+ $(kpathseadir)/tex-make.h \
+ $(kpathseadir)/tilde.h \
+ $(kpathseadir)/truncate.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/xopendir.h \
+ $(kpathseadir)/xstat.h
+
+$(objdir)/bibtex.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ bibtex.h
+
+$(objdir)/ctangle.obj: \
+ $(kpathseadir)/kpathsea.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/absolute.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/c-dir.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/c-namemx.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/c-stat.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/cnf.h \
+ $(kpathseadir)/concatn.h \
+ $(kpathseadir)/db.h \
+ $(kpathseadir)/str-list.h \
+ $(kpathseadir)/default.h \
+ $(kpathseadir)/expand.h \
+ $(kpathseadir)/fn.h \
+ $(kpathseadir)/fontmap.h \
+ $(kpathseadir)/hash.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/magstep.h \
+ $(kpathseadir)/paths.h \
+ $(kpathseadir)/pathsearch.h \
+ $(kpathseadir)/str-llist.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/remote.h \
+ $(kpathseadir)/tex-file.h \
+ $(kpathseadir)/tex-glyph.h \
+ $(kpathseadir)/tex-hush.h \
+ $(kpathseadir)/tex-make.h \
+ $(kpathseadir)/tilde.h \
+ $(kpathseadir)/truncate.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/xopendir.h \
+ $(kpathseadir)/xstat.h
+
+$(objdir)/gftopk.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ gftopk.h
+
+$(objdir)/vptovf.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ vptovf.h
+
+$(objdir)/eomega.obj: \
+ texmfmp.h \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-make.h \
+ texmfmem.h \
+ eomegamem.h \
+ eomegacoerce.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/absolute.h \
+ texmfmp-help.h
+
+$(objdir)/tftopl.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ tftopl.h
+
+$(objdir)/omegabis.obj: \
+ omegad.h \
+ texmfmp.h \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-make.h \
+ texmfmem.h \
+ omegamem.h \
+ omegacoerce.h
+
+$(objdir)/weave.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ weave.h
+
+$(objdir)/mft.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ mft.h
+
+$(objdir)/pltotf.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ pltotf.h
+
+$(objdir)/vftovp.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ vftovp.h
+
+$(objdir)/etex.obj: \
+ texmfmp.h \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-make.h \
+ texmfmem.h \
+ etexcoerce.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/absolute.h \
+ texmfmp-help.h
+
+$(objdir)/pdftex.obj: \
+ texmfmp.h \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-make.h \
+ texmfmem.h \
+ pdftexcoerce.h \
+ pdftexdir/pdftex.h \
+ ./pdftexdir/ptexlib.h \
+ ./pdftexdir/ptexmac.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/absolute.h \
+ texmfmp-help.h
+
+$(objdir)/pktype.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ pktype.h
+
+$(objdir)/gftodvi.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ gftodmem.h \
+ gftodvi.h
+
+$(objdir)/tangleboot.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ tangleboot.h
+
+$(objdir)/pktogf.obj: \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ pktogf.h
+
+$(objdir)/omega.obj: \
+ texmfmp.h \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-make.h \
+ texmfmem.h \
+ omegamem.h \
+ omegacoerce.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/absolute.h \
+ texmfmp-help.h
+
+$(objdir)/omegafirst.obj: \
+ omegad.h \
+ texmfmp.h \
+ cpascal.h \
+ config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ help.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-make.h \
+ texmfmem.h \
+ omegamem.h \
+ omegacoerce.h
+
diff --git a/Build/source/texk/web2c/depend.mk b/Build/source/texk/web2c/depend.mk
new file mode 100644
index 00000000000..b09e7126ff1
--- /dev/null
+++ b/Build/source/texk/web2c/depend.mk
@@ -0,0 +1,1007 @@
+aleph0.o: aleph0.c alephd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h alephmem.h alephcoerce.h
+aleph1.o: aleph1.c alephd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h alephmem.h alephcoerce.h
+aleph2.o: aleph2.c alephd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h alephmem.h alephcoerce.h
+aleph3.o: aleph3.c alephd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h alephmem.h alephcoerce.h
+alephbis.o: alephbis.c \
+ alephd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h alephmem.h alephcoerce.h
+aleph.o: aleph.c alephd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h alephmem.h alephcoerce.h
+alephextra.o: alephextra.c alephd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h alephmem.h alephcoerce.h \
+ $(kpathsea_srcdir)/line.h $(kpathsea_srcdir)/readable.h $(kpathsea_srcdir)/variable.h \
+ $(kpathsea_srcdir)/absolute.h \
+ texmfmp-help.h alephdir/alephextra.h
+alephini.o: alephini.c alephd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h alephmem.h alephcoerce.h
+bibtex.o: bibtex.c \
+ cpascal.h \
+ config.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h bibtex.h
+ctangleboot.o: ctangleboot.c \
+ $(kpathsea_srcdir)/kpathsea.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ $(kpathsea_srcdir)/absolute.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/c-dir.h \
+ $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/c-namemx.h $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-pathmx.h \
+ $(kpathsea_srcdir)/c-stat.h \
+ $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/cnf.h $(kpathsea_srcdir)/concatn.h \
+ $(kpathsea_srcdir)/db.h $(kpathsea_srcdir)/str-list.h $(kpathsea_srcdir)/default.h \
+ $(kpathsea_srcdir)/expand.h $(kpathsea_srcdir)/fn.h $(kpathsea_srcdir)/fontmap.h \
+ $(kpathsea_srcdir)/hash.h $(kpathsea_srcdir)/getopt.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/magstep.h $(kpathsea_dir)/paths.h $(kpathsea_srcdir)/pathsearch.h \
+ $(kpathsea_srcdir)/str-llist.h $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/readable.h \
+ $(kpathsea_srcdir)/tex-file.h $(kpathsea_srcdir)/tex-glyph.h $(kpathsea_srcdir)/tex-hush.h \
+ $(kpathsea_srcdir)/tex-make.h $(kpathsea_srcdir)/tilde.h $(kpathsea_srcdir)/truncate.h \
+ $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/xopendir.h $(kpathsea_srcdir)/xstat.h
+ctangle.o: ctangle.c \
+ $(kpathsea_srcdir)/kpathsea.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ $(kpathsea_srcdir)/absolute.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/c-dir.h \
+ $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/c-namemx.h $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-pathmx.h \
+ $(kpathsea_srcdir)/c-stat.h \
+ $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/cnf.h $(kpathsea_srcdir)/concatn.h \
+ $(kpathsea_srcdir)/db.h $(kpathsea_srcdir)/str-list.h $(kpathsea_srcdir)/default.h \
+ $(kpathsea_srcdir)/expand.h $(kpathsea_srcdir)/fn.h $(kpathsea_srcdir)/fontmap.h \
+ $(kpathsea_srcdir)/hash.h $(kpathsea_srcdir)/getopt.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/magstep.h $(kpathsea_dir)/paths.h $(kpathsea_srcdir)/pathsearch.h \
+ $(kpathsea_srcdir)/str-llist.h $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/readable.h \
+ $(kpathsea_srcdir)/tex-file.h $(kpathsea_srcdir)/tex-glyph.h $(kpathsea_srcdir)/tex-hush.h \
+ $(kpathsea_srcdir)/tex-make.h $(kpathsea_srcdir)/tilde.h $(kpathsea_srcdir)/truncate.h \
+ $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/xopendir.h $(kpathsea_srcdir)/xstat.h
+ctie.o: ctie.c \
+ $(kpathsea_srcdir)/kpathsea.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ $(kpathsea_srcdir)/absolute.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/c-dir.h \
+ $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/c-namemx.h $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-pathmx.h \
+ $(kpathsea_srcdir)/c-stat.h \
+ $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/cnf.h $(kpathsea_srcdir)/concatn.h \
+ $(kpathsea_srcdir)/db.h $(kpathsea_srcdir)/str-list.h $(kpathsea_srcdir)/default.h \
+ $(kpathsea_srcdir)/expand.h $(kpathsea_srcdir)/fn.h $(kpathsea_srcdir)/fontmap.h \
+ $(kpathsea_srcdir)/hash.h $(kpathsea_srcdir)/getopt.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/magstep.h $(kpathsea_dir)/paths.h $(kpathsea_srcdir)/pathsearch.h \
+ $(kpathsea_srcdir)/str-llist.h $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/readable.h \
+ $(kpathsea_srcdir)/tex-file.h $(kpathsea_srcdir)/tex-glyph.h $(kpathsea_srcdir)/tex-hush.h \
+ $(kpathsea_srcdir)/tex-make.h $(kpathsea_srcdir)/tilde.h $(kpathsea_srcdir)/truncate.h \
+ $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/xopendir.h $(kpathsea_srcdir)/xstat.h
+cweave.o: cweave.c \
+ $(kpathsea_srcdir)/kpathsea.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ $(kpathsea_srcdir)/absolute.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/c-dir.h \
+ $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/c-namemx.h $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-pathmx.h \
+ $(kpathsea_srcdir)/c-stat.h \
+ $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/cnf.h $(kpathsea_srcdir)/concatn.h \
+ $(kpathsea_srcdir)/db.h $(kpathsea_srcdir)/str-list.h $(kpathsea_srcdir)/default.h \
+ $(kpathsea_srcdir)/expand.h $(kpathsea_srcdir)/fn.h $(kpathsea_srcdir)/fontmap.h \
+ $(kpathsea_srcdir)/hash.h $(kpathsea_srcdir)/getopt.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/magstep.h $(kpathsea_dir)/paths.h $(kpathsea_srcdir)/pathsearch.h \
+ $(kpathsea_srcdir)/str-llist.h $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/readable.h \
+ $(kpathsea_srcdir)/tex-file.h $(kpathsea_srcdir)/tex-glyph.h $(kpathsea_srcdir)/tex-hush.h \
+ $(kpathsea_srcdir)/tex-make.h $(kpathsea_srcdir)/tilde.h $(kpathsea_srcdir)/truncate.h \
+ $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/xopendir.h $(kpathsea_srcdir)/xstat.h
+cwebboot.o: cwebboot.c \
+ cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h \
+ $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/kpathsea.h $(kpathsea_srcdir)/absolute.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/c-dir.h \
+ $(kpathsea_srcdir)/c-namemx.h $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-pathmx.h \
+ $(kpathsea_srcdir)/c-stat.h \
+ $(kpathsea_srcdir)/cnf.h $(kpathsea_srcdir)/concatn.h $(kpathsea_srcdir)/db.h \
+ $(kpathsea_srcdir)/str-list.h $(kpathsea_srcdir)/default.h $(kpathsea_srcdir)/expand.h \
+ $(kpathsea_srcdir)/fn.h $(kpathsea_srcdir)/fontmap.h $(kpathsea_srcdir)/hash.h \
+ $(kpathsea_srcdir)/line.h $(kpathsea_srcdir)/magstep.h $(kpathsea_dir)/paths.h \
+ $(kpathsea_srcdir)/pathsearch.h $(kpathsea_srcdir)/str-llist.h $(kpathsea_srcdir)/readable.h \
+ $(kpathsea_srcdir)/tex-glyph.h $(kpathsea_srcdir)/tex-hush.h $(kpathsea_srcdir)/tex-make.h \
+ $(kpathsea_srcdir)/tilde.h $(kpathsea_srcdir)/truncate.h $(kpathsea_srcdir)/variable.h \
+ $(kpathsea_srcdir)/xopendir.h $(kpathsea_srcdir)/xstat.h
+cweb.o: cweb.c \
+ cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h \
+ $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/kpathsea.h $(kpathsea_srcdir)/absolute.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/c-dir.h \
+ $(kpathsea_srcdir)/c-namemx.h $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-pathmx.h \
+ $(kpathsea_srcdir)/c-stat.h \
+ $(kpathsea_srcdir)/cnf.h $(kpathsea_srcdir)/concatn.h $(kpathsea_srcdir)/db.h \
+ $(kpathsea_srcdir)/str-list.h $(kpathsea_srcdir)/default.h $(kpathsea_srcdir)/expand.h \
+ $(kpathsea_srcdir)/fn.h $(kpathsea_srcdir)/fontmap.h $(kpathsea_srcdir)/hash.h \
+ $(kpathsea_srcdir)/line.h $(kpathsea_srcdir)/magstep.h $(kpathsea_dir)/paths.h \
+ $(kpathsea_srcdir)/pathsearch.h $(kpathsea_srcdir)/str-llist.h $(kpathsea_srcdir)/readable.h \
+ $(kpathsea_srcdir)/tex-glyph.h $(kpathsea_srcdir)/tex-hush.h $(kpathsea_srcdir)/tex-make.h \
+ $(kpathsea_srcdir)/tilde.h $(kpathsea_srcdir)/truncate.h $(kpathsea_srcdir)/variable.h \
+ $(kpathsea_srcdir)/xopendir.h $(kpathsea_srcdir)/xstat.h
+dvicopy.o: dvicopy.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h dvicopy.h
+dvitomp.o: dvitomp.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h dvitomp.h
+dvitype.o: dvitype.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h dvitype.h
+gftodvi.o: gftodvi.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h gftodmem.h \
+ gftodvi.h
+gftopk.o: gftopk.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h gftopk.h
+gftype.o: gftype.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h gftype.h
+macnames.o: macnames.c
+mf0.o: mf0.c mfd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mfcoerce.h
+mf1.o: mf1.c mfd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mfcoerce.h
+mf2.o: mf2.c mfd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mfcoerce.h
+mfextra.o: mfextra.c mfd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mfcoerce.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/readable.h $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/absolute.h \
+ texmfmp-help.h lib/mfmpi386.asm
+mfini.o: mfini.c mfd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mfcoerce.h
+mfnowin.o: mfnowin.c mfd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mfcoerce.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/readable.h $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/absolute.h \
+ texmfmp-help.h lib/mfmpi386.asm
+mft.o: mft.c cpascal.h config.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h mft.h
+mp0.o: mp0.c mpd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mpcoerce.h
+mp1.o: mp1.c mpd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mpcoerce.h
+mp2.o: mp2.c mpd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mpcoerce.h
+mpextra.o: mpextra.c mpd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mpcoerce.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/readable.h $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/absolute.h \
+ texmfmp-help.h $(kpathsea_srcdir)/concatn.h lib/mfmpi386.asm
+mpini.o: mpini.c mpd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h mpcoerce.h
+odvicopy.o: odvicopy.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h odvicopy.h
+odvitype.o: odvitype.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h odvitype.h
+omega0.o: omega0.c omegad.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h omegamem.h omegacoerce.h
+omega1.o: omega1.c omegad.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h omegamem.h omegacoerce.h
+omega2.o: omega2.c omegad.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h omegamem.h omegacoerce.h
+omega3.o: omega3.c omegad.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h omegamem.h omegacoerce.h
+omegabis.o: omegabis.c \
+ omegad.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h $(kpathsea_srcdir)/c-minmax.h \
+ $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h omegamem.h omegacoerce.h
+omega.o: omega.c omegad.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h omegamem.h omegacoerce.h
+omegaextra.o: omegaextra.c omegad.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h omegamem.h omegacoerce.h \
+ $(kpathsea_srcdir)/line.h $(kpathsea_srcdir)/readable.h $(kpathsea_srcdir)/variable.h \
+ $(kpathsea_srcdir)/absolute.h \
+ texmfmp-help.h omegadir/omegaextra.h
+omegaini.o: omegaini.c omegad.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h omegamem.h omegacoerce.h
+otangle.o: otangle.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h otangle.h
+patgen.o: patgen.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h patgen.h
+pdfetex0.o: pdfetex0.c pdfetexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdfetexcoerce.h pdfetexdir/pdfetex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pdfetex1.o: pdfetex1.c pdfetexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdfetexcoerce.h pdfetexdir/pdfetex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pdfetex2.o: pdfetex2.c pdfetexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdfetexcoerce.h pdfetexdir/pdfetex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pdfetex3.o: pdfetex3.c pdfetexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdfetexcoerce.h pdfetexdir/pdfetex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pdfetexextra.o: pdfetexextra.c pdfetexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdfetexcoerce.h pdfetexdir/pdfetex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/readable.h $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/absolute.h \
+ texmfmp-help.h pdfetexdir/pdfetexextra.h
+pdfetexini.o: pdfetexini.c pdfetexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdfetexcoerce.h pdfetexdir/pdfetex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pdftex0.o: pdftex0.c pdftexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdftexcoerce.h pdftexdir/pdftex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pdftex1.o: pdftex1.c pdftexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdftexcoerce.h pdftexdir/pdftex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pdftex2.o: pdftex2.c pdftexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdftexcoerce.h pdftexdir/pdftex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pdftex3.o: pdftex3.c pdftexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdftexcoerce.h pdftexdir/pdftex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pdftexini.o: pdftexini.c pdftexd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h pdftexcoerce.h pdftexdir/pdftex.h \
+ pdftexdir/ptexlib.h pdftexdir/ptexmac.h
+pktogf.o: pktogf.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h pktogf.h
+pktype.o: pktype.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h pktype.h
+pltotf.o: pltotf.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h pltotf.h
+pooltype.o: pooltype.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h pooltype.h
+tangleboot.o: tangleboot.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h tangleboot.h
+tangle.o: tangle.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h tangle.h
+tex0.o: tex0.c texd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h texcoerce.h
+tex1.o: tex1.c texd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h texcoerce.h
+tex2.o: tex2.c texd.h texmfmp.h cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h texcoerce.h
+texextra.o: texextra.c texd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h texcoerce.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/readable.h $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/absolute.h \
+ texmfmp-help.h
+texini.o: texini.c texd.h texmfmp.h cpascal.h config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h texmfmem.h texcoerce.h
+tftopl.o: tftopl.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h tftopl.h
+tie.o: tie.c cpascal.h config.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h
+ttf2afm.o: ttf2afm.c $(kpathsea_srcdir)/kpathsea.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ $(kpathsea_srcdir)/absolute.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/c-dir.h \
+ $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/c-namemx.h $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-pathmx.h \
+ $(kpathsea_srcdir)/c-stat.h \
+ $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/cnf.h $(kpathsea_srcdir)/concatn.h \
+ $(kpathsea_srcdir)/db.h $(kpathsea_srcdir)/str-list.h $(kpathsea_srcdir)/default.h \
+ $(kpathsea_srcdir)/expand.h $(kpathsea_srcdir)/fn.h $(kpathsea_srcdir)/fontmap.h \
+ $(kpathsea_srcdir)/hash.h $(kpathsea_srcdir)/getopt.h $(kpathsea_srcdir)/line.h \
+ $(kpathsea_srcdir)/magstep.h $(kpathsea_dir)/paths.h $(kpathsea_srcdir)/pathsearch.h \
+ $(kpathsea_srcdir)/str-llist.h $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/readable.h \
+ $(kpathsea_srcdir)/tex-file.h $(kpathsea_srcdir)/tex-glyph.h $(kpathsea_srcdir)/tex-hush.h \
+ $(kpathsea_srcdir)/tex-make.h $(kpathsea_srcdir)/tilde.h $(kpathsea_srcdir)/truncate.h \
+ $(kpathsea_srcdir)/variable.h $(kpathsea_srcdir)/xopendir.h $(kpathsea_srcdir)/xstat.h \
+ pdftexdir/ptexmac.h pdftexdir/writettf.h \
+ macnames.c
+vftovp.o: vftovp.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h vftovp.h
+vptovf.o: vptovf.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h vptovf.h
+weave.o: weave.c cpascal.h config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h help.h weave.h
diff --git a/Build/source/texk/web2c/doc/Makefile.in b/Build/source/texk/web2c/doc/Makefile.in
new file mode 100644
index 00000000000..3230ec6cf2b
--- /dev/null
+++ b/Build/source/texk/web2c/doc/Makefile.in
@@ -0,0 +1,63 @@
+# Makefile for Web2c documentation.
+
+kpse_include ../make/paths.mk
+kpse_include ../make/common.mk
+kpse_include kpathsea.mk
+kpse_include ../make/texi.mk
+
+info: web2c.info
+dvi: web2c.dvi
+
+web2c.info: install.texi ref.txi
+all: web2c.info web2c.dvi
+
+@MAINT@INSTALL: install.texi
+@MAINT@ $(MAKEINFO) $(one_info) $(MAKEINFO_FLAGS) $< -o $@
+@MAINT@ $(SHELL) $(top_srcdir)/../add-info-toc $@
+@MAINT@doc: info INSTALL
+@MAINT@
+@MAINT@ref.txi: ref.bbl
+@MAINT@ sed -e 's/~/ /g' \
+@MAINT@ -e 's/\\[-`'\''"c^]//g' \
+@MAINT@ -e 's/\\emdash */---/g' \
+@MAINT@ -e 's/metapost/MetaPost/g' \
+@MAINT@ -e 's/\\MF/Metafont/g' \
+@MAINT@ -e 's/\\METAFONT/METAFONT/g' \
+@MAINT@ -e 's/\\TUB/TUGboat/g' \
+@MAINT@ -e 's/\\LaTeX/La@TeX/g' \
+@MAINT@ -e 's/\\AMSTEX/AMS@TeX/g' \
+@MAINT@ -e 's/\\AmSTeX/AMS@TeX/g' \
+@MAINT@ -e 's/\\TeX/@TeX/g' \
+@MAINT@ -e 's/\\noopsort{[^}]*}//g' \
+@MAINT@ -e 's/[{}\]//g' \
+@MAINT@ -e 's/@\[/{/g' \
+@MAINT@ -e 's/@\]/}/g' \
+@MAINT@ -e 's/@TeX/@TeX{}/g' \
+@MAINT@ $< >$@
+@MAINT@
+@MAINT@ref.bbl: ref.aux texinfo.bst
+@MAINT@ -bibtex ref
+@MAINT@
+@MAINT@ref.aux: ref.tex
+@MAINT@ rm -f ref.bbl
+@MAINT@ tex '\nonstopmode \input ref'
+
+Makefile: Makefile.in ../config.status
+ cd .. && $(SHELL) config.status
+
+install: install-exec install-data
+install-exec:
+install-data: web2c.info
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(infodir)
+ test -r ./web2c.info || cd $(srcdir) && for i in web2c.i*; do \
+ $(INSTALL_DATA) $$i $(infodir)/$$i; done
+ $(POST_INSTALL)
+ if $(SHELL) -c 'install-info --version' >/dev/null 2>&1; then \
+ install-info --info-dir=$(infodir) $(infodir)/web2c.info; \
+ else true; fi
+
+check: all
+
+#html: texi2html -expandinfo -number -menu -split_chapter
+
+kpse_include ../make/clean.mk
diff --git a/Build/source/texk/web2c/doc/README b/Build/source/texk/web2c/doc/README
new file mode 100644
index 00000000000..782585c019f
--- /dev/null
+++ b/Build/source/texk/web2c/doc/README
@@ -0,0 +1,7 @@
+This directory contains the Texinfo manual for Web2c, which includes
+nodes for all the TeX system programs in the distribution.
+
+The man pages are no longer supported, and are no longer in the distribution.
+I do not wish to take the time to maintain the same documentation in two
+source formats. If you want to volunteer to keep the man pages in sync
+with the Texinfo manual, let me know.
diff --git a/Build/source/texk/web2c/doc/install.texi b/Build/source/texk/web2c/doc/install.texi
new file mode 100644
index 00000000000..c570b0b0a46
--- /dev/null
+++ b/Build/source/texk/web2c/doc/install.texi
@@ -0,0 +1,347 @@
+@ifclear version
+@defcodeindex cm
+@defcodeindex fl
+@defcodeindex op
+@end ifclear
+
+@node Installation
+@chapter Installation
+
+@cindex configuration
+@cindex compilation
+@cindex installation
+
+@ifset version
+(A copy of this chapter is in the distribution file @file{web2c/INSTALL}.)
+@end ifset
+
+Installing Web2c is mostly the same as installing any other
+Kpathsea-using program. Therefore, for the basic steps involved,
+see @ref{Installation,,, kpathsea, Kpathsea}. (A copy is in the file
+@file{kpathsea/INSTALL}.)
+
+One peculiarity to Web2c is that the source distribution comes in two
+files: @file{web.tar.gz} and @file{web2c.tar.gz}. You must retrieve and
+unpack them both. (We have two because the former archive contains the
+very large and seldom-changing original WEB source files.)
+@xref{unixtex.ftp,,, kpathsea, Kpathsea}.
+
+@pindex mpost@r{, reason for name change}
+Another peculiarity is the MetaPost program. Although it has been
+installed previously as @code{mp}, as of Web2c 7.0 the installed name is
+now @code{mpost}, to avoid conflict with the @code{mp} program that does
+prettyprinting. This approach was recommended by the MetaPost author,
+John Hobby. If you as the @TeX{} administrator wish to make it
+available under its shorter name as well, you will have to set up a link
+or some such yourself. And of course individual users can do the same.
+
+For solutions to common installation problems and information on how to
+report a bug, see the file @file{kpathsea/BUGS} (@pxref{Bugs,,,
+kpathsea, Kpathsea}). See also the Web2c home page,
+@url{http://www.tug.org/web2c}.
+
+Points worth repeating:
+
+@itemize @bullet
+@item
+@cindex directory structure
+@cindex basic fonts and macros
+@cindex fonts, basic
+@cindex macros, basic
+Before starting the standard compilation and installation you must
+install the basic fonts, macros, and other library files.
+@xref{Installation,,,kpathsea, Kpathsea}.
+
+@item
+If you do not wish to use the standard file locations, see @ref{Changing
+search paths,,, kpathsea, Kpathsea}.
+
+@item
+Some Web2c features are enabled or disabled at @code{configure} time,
+as described in the first section below.
+
+@end itemize
+
+@menu
+* configure options:: Especially --with and --enable.
+* Compile-time options:: Unusual -D's.
+* Additional targets:: Breaking down the task.
+* Triptrap:: Running the torture tests.
+* Runtime options:: Array sizes and the like.
+@end menu
+
+
+@node configure options
+@section @code{configure} options
+
+@cindex configuration, compile-time
+@cindex compile-time options
+@pindex configure --with/--enable @r{options}
+This section gives pointers to descriptions of the @samp{--with} and
+@samp{--enable} @code{configure} arguments that Web2c accepts. Some are
+specific to Web2c, others are generic to all Kpathsea-using programs.
+
+For a list of all the options @code{configure} accepts, run
+@samp{configure --help}. The generic options are listed first, and the
+package-specific options come last.
+
+For a description of the generic options (which mainly allow you to
+specify installation directories) and basic @code{configure} usage,
+see @ref{Invoking configure,, Running @code{configure} scripts, autoconf,
+Autoconf}, a copy is in the file @file{kpathsea/CONFIGURE}.
+
+@table @samp
+@item --disable-dump-share
+Do not make fmt/base/mem files sharable across different endian
+architectures. @xref{Hardware and memory dumps}.
+
+@item --without-maketexmf-default
+@itemx --without-maketexpk-default
+@itemx --without-maketextfm-default
+@itemx --with-maketextex-default
+Enable or disable the dynamic generation programs. @xref{mktex
+configuration,,, kpathsea, Kpathsea}. The defaults are the inverse of
+the options, i.e., everything is enabled except @code{mktextex}.
+
+@item --enable-shared
+Build Kpathsea as a shared library. @xref{Shared library,,, kpathsea,
+Kpathsea}.
+
+@item --with-editor=@var{cmd}
+Change the default editor invoked by the @samp{e} interactive command.
+@xref{Editor invocation}.
+
+@item --with-epsfwin
+@itemx --with-hp2627win
+@itemx --with-mftalkwin
+@itemx --with-nextwin
+@itemx --with-regiswin
+@itemx --with-suntoolswin
+@itemx --with-tektronixwin
+@itemx --with-unitermwin
+@itemx --with-x
+@itemx --with-x-toolkit=KIT
+@itemx --with-x11win
+@itemx --with-x11
+Define Metafont graphics support; by default, no graphics support is
+enabled. @xref{Online Metafont graphics}.
+
+@item --x-includes=@var{dir}
+@itemx --x-libraries=@var{dir}
+Define the locations of the X11 include files and libraries; by default,
+@code{configure} does its best to guess). @xref{Optional Features,,,
+autoconf, Autoconf}. A copy is in @file{kpathsea/CONFIGURE}.
+@end table
+
+
+@node Compile-time options
+@section Compile-time options
+
+@cindex compile-time options
+@cindex @samp{#define} options
+@opindex -D @r{compiler options}
+In addition to the @code{configure} options listed in the previous
+section, there are a few things that can be affected at compile-time
+with C definitions, rather than with @code{configure}. Using any of
+these is unusual.
+
+To specify extra compiler flags (@samp{-D@var{name}} in this case), the
+simplest thing to do is:
+@example
+make XCFLAGS="@var{ccoptions}"
+@end example
+@noindent You can also set the @code{CFLAGS} environment variable before
+running @code{configure}. @xref{configure environment,,, kpathsea, Kpathsea}.
+
+Anyway, here are the possibilities:
+
+@table @samp
+@item -DFIXPT
+@itemx -DNO_MF_ASM
+@vindex FIXPT
+@cindex fixed-point arithmetic
+@cindex floating-point arithmetic
+@cindex assembly language routines
+@cindex fraction routines
+Use the original WEB fixed-point routines for Metafont and MetaPost
+arithmetic calculations regarding fractions. By default,
+assembly-language routines are used on x86 hardware with GNU C (unless
+@samp{NO_MF_ASM} is defined), and floating-point routines are used
+otherwise.
+
+@item -DIPC_DEBUG
+@vindex IPC_DEBUG
+Report on various interprocess communication activities. @xref{IPC and
+TeX,, IPC and @TeX{}}.
+@end table
+
+
+@node Additional targets
+@section Additional targets
+
+@cindex additional Make targets
+@cindex targets, additional Make
+@cindex Make targets, additional
+
+Web2c has several Make targets besides the standard ones. You can invoke
+these either in the top level directory of the source distribution (the
+one containing @file{kpathsea/} and @file{web2c/}), or in the
+@file{web2c/} directory.
+
+@table @samp
+@item c-sources
+@cmindex c-sources @r{Makefile target}
+@cindex non-Unix system, compiling on
+Make only the C files, translated from the Web sources, presumably
+because you want to take them to a non-Unix machine.
+
+@item formats
+@itemx install-formats
+@cmindex formats @r{Make target}
+@cmindex install-formats @r{Make target}
+Make or install all the memory dumps (@pxref{Memory dumps}). By
+default, the standard plain formats plus @file{latex.fmt} are made. You
+can add other formats by redefining the @code{fmts}, @code{bases}, and
+@code{mems} variables. See the top of @file{web2c/Makefile} for the
+possibilities.
+
+@item fmts
+@itemx install-fmts
+@cmindex fmts @r{Make target}
+@cmindex install-fmts @r{Make target}
+Make or install the @TeX{} @file{.fmt} files. @xref{Initial TeX}.
+
+@item bases
+@itemx install-bases
+@cmindex bases @r{Make target}
+@cmindex install-bases @r{Make target}
+
+Make or install the Metafont @file{.base} files. @xref{Initial Metafont}.
+
+@item mems
+@itemx install-mems
+@cmindex mems @r{Make target}
+@cmindex install-mems @r{Make target}
+Make or install the MetaPost @file{.mem} files. @xref{Initial MetaPost}.
+
+@item triptrap
+@itemx trip
+@itemx trap
+@itemx mptrap
+@cmindex triptrap @r{Make target}
+@findex trip @r{Make target}
+@findex trap @r{Make target}
+@findex mptrap @r{Make target}
+To run the torture tests for @TeX{}, Metafont, and MetaPost
+(respectively). See the next section.
+
+@end table
+
+
+@node Triptrap
+@section Trip, trap, and mptrap: Torture tests
+
+@cindex Gruff, Billy Goat
+@cindex trip test
+@cindex trap test
+@cindex mptrap test
+@cindex torture tests
+
+@flindex tripman.tex
+@flindex trapman.tex
+@flindex mptrap.readme
+To validate your @TeX{}, Metafont, and MetaPost executables, run
+@samp{make triptrap}. This runs the trip, trap, and mptrap ``torture
+tests''. See the files @file{triptrap/tripman.tex},
+@file{triptrap/trapman.tex}, and @file{triptrap/mptrap.readme} for
+detailed information and background on the tests.
+
+The differences between your executables' behavior and the standard
+values will show up on your terminal. The usual differences (these are
+all acceptable) are:
+
+@itemize @bullet
+@item string usage and table sizes;
+@item glue set ratios;
+@item @samp{down4}, @samp{right4}, and @samp{y4} commands in DVItype output;
+@item dates and times.
+@end itemize
+
+@noindent Any other differences are trouble. The most common culprit in
+the past has been compiler bugs, especially when optimizing.
+@xref{TeX or Metafont failing,, @TeX{} or Metafont failing, kpathsea,
+Kpathsea}.
+
+The files @file{trip.diffs}, @file{mftrap.diffs}, and
+@file{mptrap.diffs} in the @file{triptrap} directory show the standard
+diffs against the original output. If you diff your diffs against these
+files, you should come up clean. For example
+@example
+make trip >&mytrip.diffs
+diff triptrap/trip.diffs mytrip.diffs
+@end example
+
+To run the tests separately, use the targets @code{trip}, @code{trap},
+and @code{mptrap}.
+
+To run simple tests for all the programs as well as the torture tests,
+run @samp{make check}. You can compare the output to the distributed
+file @file{tests/check.log} if you like.
+
+
+@node Runtime options
+@section Runtime options
+
+@cindex runtime options
+
+@cindex configuration file values
+@cindex array sizes
+Besides the configure- and compile-time options described in the
+previous sections, you can control a number of parameters (in
+particular, array sizes) in the @file{texmf.cnf} runtime file read by
+Kpathsea (@pxref{Config files,,, kpathsea, Kpathsea}).
+
+Rather than exhaustively listing them here, please see the last section
+of the distributed @file{kpathsea/texmf.cnf}. Some of the more
+interesting values:
+
+@vtable @samp
+@item main_memory
+Total words of memory available, for @TeX{}, Metafont, and MetaPost.
+Must remake the format file after changing.
+
+@item extra_mem_bot
+@cindex boxes, memory for
+@cindex glue, memory for
+@cindex breakpoints, memory for
+@cindex PiC@TeX{}, increasing memory for
+Extra space for ``large'' @TeX{} data structures: boxes, glue,
+breakpoints, et al. If you use PiC@TeX{}, you may well want to set this.
+
+@item font_mem_size
+@cindex TFM files, memory for
+Words of font info available for @TeX{}; this is approximately the total
+size of all TFM files read.
+
+@item hash_extra
+@cindex control sequence names, space for
+@cindex hash table, increasing size of
+Additional space for the hash table of control sequence names.
+Approximately 10,000 control sequences can be stored in the main hash
+table; if you have a large book with numerous cross-references,
+this might not be enough, and thus you will want to set @code{hash_extra}.
+
+@end vtable
+
+@cindex array limit, fixed
+@cindex swap space, as array limit
+@cindex reallocation of arrays
+@cindex dynamic array allocation
+Of course, ideally all arrays would be dynamically expanded as
+necessary, so the only limiting factor would be the amount of swap space
+available. Unfortunately, implementing this is extremely difficult, as
+the fixed size of arrays is assumed in many places throughout the source
+code. These runtime limits are a practical compromise between the
+compile-time limits in previous versions, and truly dynamic arrays. (On
+the other hand, the Web2c Bib@TeX{} implementation does do dynamic
+reallocation of some arrays.)
diff --git a/Build/source/texk/web2c/doc/ref.tex b/Build/source/texk/web2c/doc/ref.tex
new file mode 100644
index 00000000000..5526b6e8cdb
--- /dev/null
+++ b/Build/source/texk/web2c/doc/ref.tex
@@ -0,0 +1,29 @@
+\input btxmac
+
+\nocite{Billawala:TB8-1-29}
+\nocite{Goosens:LC94}
+\nocite{Harbison:1991:CRM}
+\nocite{Hobby:1992:ATT-162}
+\nocite{Hobby:1993:ATT-1993}
+\nocite{Hobby:TB10-4-505}
+\nocite{Knuth:1989:ET}
+\nocite{Knuth:CSS93}
+\nocite{Knuth:LP92}
+\nocite{Knuth:STAN-CS-84-1027}
+\nocite{Knuth:STAN-CS-86-1095}
+\nocite{Knuth:TB11-1-13-23}
+\nocite{Knuth:ct-a}
+\nocite{Knuth:ct-b}
+\nocite{Knuth:ct-c}
+\nocite{Knuth:ct-d}
+\nocite{Knuth:ct-e}
+\nocite{Lamport:1994:LDP}
+\nocite{Liang:STAN-CS-83-977}
+\nocite{MacKay:1991:LPQ}
+\nocite{Spivak:JTG90}
+\nocite{Spivak:LS89}
+
+\bibliographystyle{texinfo}
+\bibliography{ep,ref,texbook1,texbook3,tugboat,unix}
+
+\bye
diff --git a/Build/source/texk/web2c/doc/ref.txi b/Build/source/texk/web2c/doc/ref.txi
new file mode 100644
index 00000000000..17a09d89390
--- /dev/null
+++ b/Build/source/texk/web2c/doc/ref.txi
@@ -0,0 +1,130 @@
+@c begin{thebibliography}{Knu86d}
+
+@item [Bil87]
+Neenie Billawala.
+Write-white printing engines and tuning fonts with Metafont.
+@cite{TUGboat}, 8(1):29--32, April 1987.
+
+@item [GMS94]
+Michel Goossens, Frank Mittelbach, and Alexander Samarin.
+@cite{The La@TeX{} Companion}.
+Addison-Wesley, Reading, MA, USA, 1994.
+
+@item [Hob89]
+John D. Hobby.
+A Metafont-like system with PS output.
+@cite{TUGboat}, 10(4):505--512, December 1989.
+
+@item [Hob92]
+John D. Hobby.
+A User's Manual for MetaPost.
+Technical Report CSTR-162, AT&T Bell Laboratories, 1992.
+
+@item [Hob93]
+John D. Hobby.
+Drawing Graphs with MetaPost.
+Technical Report CSTR-164, AT&T Bell Laboratories, 1993.
+
+@item [HS91]
+Samuel P. Harbison and Guy L. Steele Jr.
+@cite{C---A Reference Manual}.
+Prentice-Hall, Upper Saddle River, NJ 07458, USA, third edition, 1991.
+An authoritative reference to the C programming language, and a good
+ companion to Kernighan and Ritchie.
+
+@item [KL93]
+Donald E. Knuth and Silvio Levy.
+@cite{The CWEB System of Structured Documentation, Version 3.0}.
+Addison-Wesley, Reading, MA, USA, 1993.
+
+@item [Knu84]
+Donald E. Knuth.
+A torture test for @TeX{}.
+Report No. STAN-CS-84-1027, Stanford University, Department of Computer
+ Science, 1984.
+
+@item [Knu86a]
+Donald E. Knuth.
+A Torture Test for METAFONT.
+Report No. STAN-CS-86-1095, Stanford University, Department of Computer
+ Science, 1986.
+
+@item [Knu86b]
+Donald E. Knuth.
+@cite{The @TeX{}book}, volume A of @cite{Computers and Typesetting}.
+Addison-Wesley, Reading, MA, USA, 1986.
+
+@item [Knu86c]
+Donald E. Knuth.
+@cite{@TeX{}: The Program}, volume B of @cite{Computers and Typesetting}.
+Addison-Wesley, Reading, MA, USA, 1986.
+
+@item [Knu86d]
+Donald E. Knuth.
+@cite{The METAFONTbook}, volume C of @cite{Computers and Typesetting}.
+Addison-Wesley, Reading, MA, USA, 1986.
+
+@item [Knu86e]
+Donald E. Knuth.
+@cite{METAFONT: The Program}, volume D of @cite{Computers and
+ Typesetting}.
+Addison-Wesley, Reading, MA, USA, 1986.
+
+@item [Knu86f]
+Donald E. Knuth.
+@cite{Computer Modern Typefaces}, volume E of @cite{Computers and
+ Typesetting}.
+Addison-Wesley, Reading, MA, USA, 1986.
+
+@item [Knu89]
+Donald E. Knuth.
+The errors of @TeX{}.
+@cite{Software---Practice and Experience}, 19(7):607--681, July
+ 1989.
+This is an updated version of iteKnuth:1988:ET.
+
+@item [Knu90]
+Donald Knuth.
+Virtual Fonts: More Fun for Grand Wizards.
+@cite{TUGboat}, 11(1):13--23, April 1990.
+
+@item [Knu92]
+Donald E. Knuth.
+@cite{Literate Programming}.
+CSLI Lecture Notes Number 27. Stanford University Center for the Study of
+ Language and Information, Stanford, CA, USA, 1992.
+
+@item [Lam94]
+Leslie Lamport.
+@cite{La@TeX{}: A Document Preparation System: User's Guide and Reference
+ Manual}.
+Addison-Wesley, Reading, MA, USA, second edition, 1994.
+Reprinted with corrections in 1996.
+
+@item [Lia83]
+Franklin Mark Liang.
+Word hy-phen-a-tion by com-pu-ter.
+Technical Report STAN-CS-83-977, Stanford University, August 1983.
+
+@item [Mac91]
+Pierre A. MacKay.
+Looking at the pixels: Quality control for 300 dpi laser printer fonts,
+ especially Metafonts.
+In Robert A. Morris and Jacques Andre, editors, @cite{Raster Imaging and
+ Digital Typography II---Papers from the second RIDT meeting, held in
+ Boston, Oct. 14--16, 1991}, pages 205--215, New York, 1991. Cambridge
+ University Press.
+
+@item [Spi89]
+Michael D. Spivak.
+@cite{LAMS@TeX{}, The Synthesis}.
+The @TeX{}plorators Corporation, 3701 W. Alabama, Suite 450-273, Houston, TX
+ 77027, USA, 1989.
+
+@item [Spi90]
+Michael D. Spivak.
+@cite{The Joy of @TeX{}---A Gourmet Guide to Typesetting with the
+ AMS@TeX{} macro package}.
+American Mathematical Society, Providence, RI, USA, 2nd revised edition, 1990.
+
+@c end{thebibliography}
diff --git a/Build/source/texk/web2c/doc/texinfo.bst b/Build/source/texk/web2c/doc/texinfo.bst
new file mode 100644
index 00000000000..8a54827e0c9
--- /dev/null
+++ b/Build/source/texk/web2c/doc/texinfo.bst
@@ -0,0 +1,1256 @@
+% texinfo.bst from the
+% BibTeX standard bibliography style `alpha'
+% $Id: texinfo.bst,v 1.1.1.1 1997/09/16 10:56:03 olaf Exp $
+ % version 0.99a for BibTeX versions 0.99a or later, LaTeX version 2.09.
+ % Copyright (C) 1985, all rights reserved.
+ % Copying of this file is authorized only if either
+ % (1) you make absolutely no changes to your copy, including name, or
+ % (2) if you do make changes, you name it something other than
+ % btxbst.doc, plain.bst, unsrt.bst, alpha.bst, and abbrv.bst.
+ % This restriction helps ensure that all standard styles are identical.
+ % The file btxbst.doc has the documentation for this style.
+
+ENTRY
+ { address
+ author
+ booktitle
+ chapter
+ edition
+ editor
+ howpublished
+ institution
+ journal
+ key
+ month
+ note
+ number
+ organization
+ pages
+ publisher
+ school
+ series
+ title
+ type
+ volume
+ year
+ }
+ {}
+ { label extra.label sort.label }
+
+INTEGERS { output.state before.all mid.sentence after.sentence after.block }
+
+FUNCTION {init.state.consts}
+{ #0 'before.all :=
+ #1 'mid.sentence :=
+ #2 'after.sentence :=
+ #3 'after.block :=
+}
+
+STRINGS { s t }
+
+FUNCTION {output.nonnull}
+{ 's :=
+ output.state mid.sentence =
+ { ", " * write$ }
+ { output.state after.block =
+ { add.period$ write$
+ newline$
+ }
+ { output.state before.all =
+ 'write$
+ { add.period$ " " * write$ }
+ if$
+ }
+ if$
+ mid.sentence 'output.state :=
+ }
+ if$
+ s
+}
+
+FUNCTION {output}
+{ duplicate$ empty$
+ 'pop$
+ 'output.nonnull
+ if$
+}
+
+FUNCTION {output.check}
+{ 't :=
+ duplicate$ empty$
+ { pop$ "empty " t * " in " * cite$ * warning$ }
+ 'output.nonnull
+ if$
+}
+
+FUNCTION {output.bibitem}
+{ newline$
+ "@item [" write$
+ label write$
+ "]" write$
+ newline$
+ ""
+ before.all 'output.state :=
+}
+
+FUNCTION {fin.entry}
+{ add.period$
+ write$
+ newline$
+}
+
+FUNCTION {new.block}
+{ output.state before.all =
+ 'skip$
+ { after.block 'output.state := }
+ if$
+}
+
+FUNCTION {new.sentence}
+{ output.state after.block =
+ 'skip$
+ { output.state before.all =
+ 'skip$
+ { after.sentence 'output.state := }
+ if$
+ }
+ if$
+}
+
+FUNCTION {not}
+{ { #0 }
+ { #1 }
+ if$
+}
+
+FUNCTION {and}
+{ 'skip$
+ { pop$ #0 }
+ if$
+}
+
+FUNCTION {or}
+{ { pop$ #1 }
+ 'skip$
+ if$
+}
+
+FUNCTION {new.block.checka}
+{ empty$
+ 'skip$
+ 'new.block
+ if$
+}
+
+FUNCTION {new.block.checkb}
+{ empty$
+ swap$ empty$
+ and
+ 'skip$
+ 'new.block
+ if$
+}
+
+FUNCTION {new.sentence.checka}
+{ empty$
+ 'skip$
+ 'new.sentence
+ if$
+}
+
+FUNCTION {new.sentence.checkb}
+{ empty$
+ swap$ empty$
+ and
+ 'skip$
+ 'new.sentence
+ if$
+}
+
+FUNCTION {field.or.null}
+{ duplicate$ empty$
+ { pop$ "" }
+ 'skip$
+ if$
+}
+
+FUNCTION {emphasize}
+{ duplicate$ empty$
+ { pop$ "" }
+ { "@cite@[" swap$ * "@]" * }
+ if$
+}
+
+INTEGERS { nameptr namesleft numnames }
+
+FUNCTION {format.names}
+{ 's :=
+ #1 'nameptr :=
+ s num.names$ 'numnames :=
+ numnames 'namesleft :=
+ { namesleft #0 > }
+ { s nameptr "{ff~}{vv~}{ll}{, jj}" format.name$ 't :=
+ nameptr #1 >
+ { namesleft #1 >
+ { ", " * t * }
+ { numnames #2 >
+ { "," * }
+ 'skip$
+ if$
+ t "others" =
+ { " et~al." * }
+ { " and " * t * }
+ if$
+ }
+ if$
+ }
+ 't
+ if$
+ nameptr #1 + 'nameptr :=
+ namesleft #1 - 'namesleft :=
+ }
+ while$
+}
+
+FUNCTION {format.authors}
+{ author empty$
+ { "" }
+ { author format.names }
+ if$
+}
+
+FUNCTION {format.editors}
+{ editor empty$
+ { "" }
+ { editor format.names
+ editor num.names$ #1 >
+ { ", editors" * }
+ { ", editor" * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.title}
+{ title empty$
+ { "" }
+ { title "t" change.case$ }
+ if$
+}
+
+FUNCTION {n.dashify}
+{ 't :=
+ ""
+ { t empty$ not }
+ { t #1 #1 substring$ "-" =
+ { t #1 #2 substring$ "--" = not
+ { "--" *
+ t #2 global.max$ substring$ 't :=
+ }
+ { { t #1 #1 substring$ "-" = }
+ { "-" *
+ t #2 global.max$ substring$ 't :=
+ }
+ while$
+ }
+ if$
+ }
+ { t #1 #1 substring$ *
+ t #2 global.max$ substring$ 't :=
+ }
+ if$
+ }
+ while$
+}
+
+FUNCTION {format.date}
+{ year empty$
+ { month empty$
+ { "" }
+ { "there's a month but no year in " cite$ * warning$
+ month
+ }
+ if$
+ }
+ { month empty$
+ 'year
+ { month " " * year * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.btitle}
+{ title emphasize
+}
+
+FUNCTION {tie.or.space.connect}
+{ duplicate$ text.length$ #3 <
+ { "~" }
+ { " " }
+ if$
+ swap$ * *
+}
+
+FUNCTION {either.or.check}
+{ empty$
+ 'pop$
+ { "can't use both " swap$ * " fields in " * cite$ * warning$ }
+ if$
+}
+
+FUNCTION {format.bvolume}
+{ volume empty$
+ { "" }
+ { "volume" volume tie.or.space.connect
+ series empty$
+ 'skip$
+ { " of " * series emphasize * }
+ if$
+ "volume and number" number either.or.check
+ }
+ if$
+}
+
+FUNCTION {format.number.series}
+{ volume empty$
+ { number empty$
+ { series field.or.null }
+ { output.state mid.sentence =
+ { "number" }
+ { "Number" }
+ if$
+ number tie.or.space.connect
+ series empty$
+ { "there's a number but no series in " cite$ * warning$ }
+ { " in " * series * }
+ if$
+ }
+ if$
+ }
+ { "" }
+ if$
+}
+
+FUNCTION {format.edition}
+{ edition empty$
+ { "" }
+ { output.state mid.sentence =
+ { edition "l" change.case$ " edition" * }
+ { edition "t" change.case$ " edition" * }
+ if$
+ }
+ if$
+}
+
+INTEGERS { multiresult }
+
+FUNCTION {multi.page.check}
+{ 't :=
+ #0 'multiresult :=
+ { multiresult not
+ t empty$ not
+ and
+ }
+ { t #1 #1 substring$
+ duplicate$ "-" =
+ swap$ duplicate$ "," =
+ swap$ "+" =
+ or or
+ { #1 'multiresult := }
+ { t #2 global.max$ substring$ 't := }
+ if$
+ }
+ while$
+ multiresult
+}
+
+FUNCTION {format.pages}
+{ pages empty$
+ { "" }
+ { pages multi.page.check
+ { "pages" pages n.dashify tie.or.space.connect }
+ { "page" pages tie.or.space.connect }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.vol.num.pages}
+{ volume field.or.null
+ number empty$
+ 'skip$
+ { "(" number * ")" * *
+ volume empty$
+ { "there's a number but no volume in " cite$ * warning$ }
+ 'skip$
+ if$
+ }
+ if$
+ pages empty$
+ 'skip$
+ { duplicate$ empty$
+ { pop$ format.pages }
+ { ":" * pages n.dashify * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.chapter.pages}
+{ chapter empty$
+ 'format.pages
+ { type empty$
+ { "chapter" }
+ { type "l" change.case$ }
+ if$
+ chapter tie.or.space.connect
+ pages empty$
+ 'skip$
+ { ", " * format.pages * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.in.ed.booktitle}
+{ booktitle empty$
+ { "" }
+ { editor empty$
+ { "In " booktitle emphasize * }
+ { "In " format.editors * ", " * booktitle emphasize * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {empty.misc.check}
+{ author empty$ title empty$ howpublished empty$
+ month empty$ year empty$ note empty$
+ and and and and and
+ key empty$ not and
+ { "all relevant fields are empty in " cite$ * warning$ }
+ 'skip$
+ if$
+}
+
+FUNCTION {format.thesis.type}
+{ type empty$
+ 'skip$
+ { pop$
+ type "t" change.case$
+ }
+ if$
+}
+
+FUNCTION {format.tr.number}
+{ type empty$
+ { "Technical Report" }
+ 'type
+ if$
+ number empty$
+ { "t" change.case$ }
+ { number tie.or.space.connect }
+ if$
+}
+
+FUNCTION {format.article.crossref}
+{ key empty$
+ { journal empty$
+ { "need key or journal for " cite$ * " to crossref " * crossref *
+ warning$
+ ""
+ }
+ { "In @cite@[" journal * "@]" * }
+ if$
+ }
+ { "In " key * }
+ if$
+ " @bibcite{" * crossref * "}" *
+}
+
+FUNCTION {format.crossref.editor}
+{ editor #1 "{vv~}{ll}" format.name$
+ editor num.names$ duplicate$
+ #2 >
+ { pop$ " et~al." * }
+ { #2 <
+ 'skip$
+ { editor #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" =
+ { " et~al." * }
+ { " and " * editor #2 "{vv~}{ll}" format.name$ * }
+ if$
+ }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.book.crossref}
+{ volume empty$
+ { "empty volume in " cite$ * "'s crossref of " * crossref * warning$
+ "In "
+ }
+ { "Volume" volume tie.or.space.connect
+ " of " *
+ }
+ if$
+ editor empty$
+ editor field.or.null author field.or.null =
+ or
+ { key empty$
+ { series empty$
+ { "need editor, key, or series for " cite$ * " to crossref " *
+ crossref * warning$
+ "" *
+ }
+ { "@cite@[" * series * "@]" * }
+ if$
+ }
+ { key * }
+ if$
+ }
+ { format.crossref.editor * }
+ if$
+ " @bibcite{" * crossref * "}" *
+}
+
+FUNCTION {format.incoll.inproc.crossref}
+{ editor empty$
+ editor field.or.null author field.or.null =
+ or
+ { key empty$
+ { booktitle empty$
+ { "need editor, key, or booktitle for " cite$ * " to crossref " *
+ crossref * warning$
+ ""
+ }
+ { "In @cite@[" booktitle * "@]" * }
+ if$
+ }
+ { "In " key * }
+ if$
+ }
+ { "In " format.crossref.editor * }
+ if$
+ " @bibcite{" * crossref * "}" *
+}
+
+FUNCTION {article}
+{ output.bibitem
+ format.authors "author" output.check
+ new.block
+ format.title "title" output.check
+ new.block
+ crossref missing$
+ { journal emphasize "journal" output.check
+ format.vol.num.pages output
+ format.date "year" output.check
+ }
+ { format.article.crossref output.nonnull
+ format.pages output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {book}
+{ output.bibitem
+ author empty$
+ { format.editors "author and editor" output.check }
+ { format.authors output.nonnull
+ crossref missing$
+ { "author and editor" editor either.or.check }
+ 'skip$
+ if$
+ }
+ if$
+ new.block
+ format.btitle "title" output.check
+ crossref missing$
+ { format.bvolume output
+ new.block
+ format.number.series output
+ new.sentence
+ publisher "publisher" output.check
+ address output
+ }
+ { new.block
+ format.book.crossref output.nonnull
+ }
+ if$
+ format.edition output
+ format.date "year" output.check
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {booklet}
+{ output.bibitem
+ format.authors output
+ new.block
+ format.title "title" output.check
+ howpublished address new.block.checkb
+ howpublished output
+ address output
+ format.date output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {inbook}
+{ output.bibitem
+ author empty$
+ { format.editors "author and editor" output.check }
+ { format.authors output.nonnull
+ crossref missing$
+ { "author and editor" editor either.or.check }
+ 'skip$
+ if$
+ }
+ if$
+ new.block
+ format.btitle "title" output.check
+ crossref missing$
+ { format.bvolume output
+ format.chapter.pages "chapter and pages" output.check
+ new.block
+ format.number.series output
+ new.sentence
+ publisher "publisher" output.check
+ address output
+ }
+ { format.chapter.pages "chapter and pages" output.check
+ new.block
+ format.book.crossref output.nonnull
+ }
+ if$
+ format.edition output
+ format.date "year" output.check
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {incollection}
+{ output.bibitem
+ format.authors "author" output.check
+ new.block
+ format.title "title" output.check
+ new.block
+ crossref missing$
+ { format.in.ed.booktitle "booktitle" output.check
+ format.bvolume output
+ format.number.series output
+ format.chapter.pages output
+ new.sentence
+ publisher "publisher" output.check
+ address output
+ format.edition output
+ format.date "year" output.check
+ }
+ { format.incoll.inproc.crossref output.nonnull
+ format.chapter.pages output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {inproceedings}
+{ output.bibitem
+ format.authors "author" output.check
+ new.block
+ format.title "title" output.check
+ new.block
+ crossref missing$
+ { format.in.ed.booktitle "booktitle" output.check
+ format.bvolume output
+ format.number.series output
+ format.pages output
+ address empty$
+ { organization publisher new.sentence.checkb
+ organization output
+ publisher output
+ format.date "year" output.check
+ }
+ { address output.nonnull
+ format.date "year" output.check
+ new.sentence
+ organization output
+ publisher output
+ }
+ if$
+ }
+ { format.incoll.inproc.crossref output.nonnull
+ format.pages output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {conference} { inproceedings }
+
+FUNCTION {manual}
+{ output.bibitem
+ author empty$
+ { organization empty$
+ 'skip$
+ { organization output.nonnull
+ address output
+ }
+ if$
+ }
+ { format.authors output.nonnull }
+ if$
+ new.block
+ format.btitle "title" output.check
+ author empty$
+ { organization empty$
+ { address new.block.checka
+ address output
+ }
+ 'skip$
+ if$
+ }
+ { organization address new.block.checkb
+ organization output
+ address output
+ }
+ if$
+ format.edition output
+ format.date output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {mastersthesis}
+{ output.bibitem
+ format.authors "author" output.check
+ new.block
+ format.title "title" output.check
+ new.block
+ "Master's thesis" format.thesis.type output.nonnull
+ school "school" output.check
+ address output
+ format.date "year" output.check
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {misc}
+{ output.bibitem
+ format.authors output
+ title howpublished new.block.checkb
+ format.title output
+ howpublished new.block.checka
+ howpublished output
+ format.date output
+ new.block
+ note output
+ fin.entry
+ empty.misc.check
+}
+
+FUNCTION {phdthesis}
+{ output.bibitem
+ format.authors "author" output.check
+ new.block
+ format.btitle "title" output.check
+ new.block
+ "PhD thesis" format.thesis.type output.nonnull
+ school "school" output.check
+ address output
+ format.date "year" output.check
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {proceedings}
+{ output.bibitem
+ editor empty$
+ { organization output }
+ { format.editors output.nonnull }
+ if$
+ new.block
+ format.btitle "title" output.check
+ format.bvolume output
+ format.number.series output
+ address empty$
+ { editor empty$
+ { publisher new.sentence.checka }
+ { organization publisher new.sentence.checkb
+ organization output
+ }
+ if$
+ publisher output
+ format.date "year" output.check
+ }
+ { address output.nonnull
+ format.date "year" output.check
+ new.sentence
+ editor empty$
+ 'skip$
+ { organization output }
+ if$
+ publisher output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {techreport}
+{ output.bibitem
+ format.authors "author" output.check
+ new.block
+ format.title "title" output.check
+ new.block
+ format.tr.number output.nonnull
+ institution "institution" output.check
+ address output
+ format.date "year" output.check
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {unpublished}
+{ output.bibitem
+ format.authors "author" output.check
+ new.block
+ format.title "title" output.check
+ new.block
+ note "note" output.check
+ format.date output
+ fin.entry
+}
+
+FUNCTION {default.type} { misc }
+
+MACRO {jan} {"January"}
+
+MACRO {feb} {"February"}
+
+MACRO {mar} {"March"}
+
+MACRO {apr} {"April"}
+
+MACRO {may} {"May"}
+
+MACRO {jun} {"June"}
+
+MACRO {jul} {"July"}
+
+MACRO {aug} {"August"}
+
+MACRO {sep} {"September"}
+
+MACRO {oct} {"October"}
+
+MACRO {nov} {"November"}
+
+MACRO {dec} {"December"}
+
+MACRO {acmcs} {"ACM Computing Surveys"}
+
+MACRO {acta} {"Acta Informatica"}
+
+MACRO {cacm} {"Communications of the ACM"}
+
+MACRO {ibmjrd} {"IBM Journal of Research and Development"}
+
+MACRO {ibmsj} {"IBM Systems Journal"}
+
+MACRO {ieeese} {"IEEE Transactions on Software Engineering"}
+
+MACRO {ieeetc} {"IEEE Transactions on Computers"}
+
+MACRO {ieeetcad}
+ {"IEEE Transactions on Computer-Aided Design of Integrated Circuits"}
+
+MACRO {ipl} {"Information Processing Letters"}
+
+MACRO {jacm} {"Journal of the ACM"}
+
+MACRO {jcss} {"Journal of Computer and System Sciences"}
+
+MACRO {scp} {"Science of Computer Programming"}
+
+MACRO {sicomp} {"SIAM Journal on Computing"}
+
+MACRO {tocs} {"ACM Transactions on Computer Systems"}
+
+MACRO {tods} {"ACM Transactions on Database Systems"}
+
+MACRO {tog} {"ACM Transactions on Graphics"}
+
+MACRO {toms} {"ACM Transactions on Mathematical Software"}
+
+MACRO {toois} {"ACM Transactions on Office Information Systems"}
+
+MACRO {toplas} {"ACM Transactions on Programming Languages and Systems"}
+
+MACRO {tcs} {"Theoretical Computer Science"}
+
+READ
+
+FUNCTION {sortify}
+{ purify$
+ "l" change.case$
+}
+
+INTEGERS { len }
+
+FUNCTION {chop.word}
+{ 's :=
+ 'len :=
+ s #1 len substring$ =
+ { s len #1 + global.max$ substring$ }
+ 's
+ if$
+}
+
+INTEGERS { et.al.char.used }
+
+FUNCTION {initialize.et.al.char.used}
+{ #0 'et.al.char.used :=
+}
+
+EXECUTE {initialize.et.al.char.used}
+
+FUNCTION {format.lab.names}
+{ 's :=
+ s num.names$ 'numnames :=
+ numnames #1 >
+ { numnames #4 >
+ { #3 'namesleft := }
+ { numnames 'namesleft := }
+ if$
+ #1 'nameptr :=
+ ""
+ { namesleft #0 > }
+ { nameptr numnames =
+ { s nameptr "{ff }{vv }{ll}{ jj}" format.name$ "others" =
+ { "{\etalchar{+}}" *
+ #1 'et.al.char.used :=
+ }
+ { s nameptr "{v{}}{l{}}" format.name$ * }
+ if$
+ }
+ { s nameptr "{v{}}{l{}}" format.name$ * }
+ if$
+ nameptr #1 + 'nameptr :=
+ namesleft #1 - 'namesleft :=
+ }
+ while$
+ numnames #4 >
+ { "{\etalchar{+}}" *
+ #1 'et.al.char.used :=
+ }
+ 'skip$
+ if$
+ }
+ { s #1 "{v{}}{l{}}" format.name$
+ duplicate$ text.length$ #2 <
+ { pop$ s #1 "{ll}" format.name$ #3 text.prefix$ }
+ 'skip$
+ if$
+ }
+ if$
+}
+
+FUNCTION {author.key.label}
+{ author empty$
+ { key empty$
+ { cite$ #1 #3 substring$ }
+ { key #3 text.prefix$ }
+ if$
+ }
+ { author format.lab.names }
+ if$
+}
+
+FUNCTION {author.editor.key.label}
+{ author empty$
+ { editor empty$
+ { key empty$
+ { cite$ #1 #3 substring$ }
+ { key #3 text.prefix$ }
+ if$
+ }
+ { editor format.lab.names }
+ if$
+ }
+ { author format.lab.names }
+ if$
+}
+
+FUNCTION {author.key.organization.label}
+{ author empty$
+ { key empty$
+ { organization empty$
+ { cite$ #1 #3 substring$ }
+ { "The " #4 organization chop.word #3 text.prefix$ }
+ if$
+ }
+ { key #3 text.prefix$ }
+ if$
+ }
+ { author format.lab.names }
+ if$
+}
+
+FUNCTION {editor.key.organization.label}
+{ editor empty$
+ { key empty$
+ { organization empty$
+ { cite$ #1 #3 substring$ }
+ { "The " #4 organization chop.word #3 text.prefix$ }
+ if$
+ }
+ { key #3 text.prefix$ }
+ if$
+ }
+ { editor format.lab.names }
+ if$
+}
+
+FUNCTION {calc.label}
+{ type$ "book" =
+ type$ "inbook" =
+ or
+ 'author.editor.key.label
+ { type$ "proceedings" =
+ 'editor.key.organization.label
+ { type$ "manual" =
+ 'author.key.organization.label
+ 'author.key.label
+ if$
+ }
+ if$
+ }
+ if$
+ duplicate$
+ year field.or.null purify$ #-1 #2 substring$
+ *
+ 'label :=
+ year field.or.null purify$ #-1 #4 substring$
+ *
+ sortify 'sort.label :=
+}
+
+FUNCTION {sort.format.names}
+{ 's :=
+ #1 'nameptr :=
+ ""
+ s num.names$ 'numnames :=
+ numnames 'namesleft :=
+ { namesleft #0 > }
+ { nameptr #1 >
+ { " " * }
+ 'skip$
+ if$
+ s nameptr "{vv{ } }{ll{ }}{ ff{ }}{ jj{ }}" format.name$ 't :=
+ nameptr numnames = t "others" = and
+ { "et al" * }
+ { t sortify * }
+ if$
+ nameptr #1 + 'nameptr :=
+ namesleft #1 - 'namesleft :=
+ }
+ while$
+}
+
+FUNCTION {sort.format.title}
+{ 't :=
+ "A " #2
+ "An " #3
+ "The " #4 t chop.word
+ chop.word
+ chop.word
+ sortify
+ #1 global.max$ substring$
+}
+
+FUNCTION {author.sort}
+{ author empty$
+ { key empty$
+ { "to sort, need author or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { author sort.format.names }
+ if$
+}
+
+FUNCTION {author.editor.sort}
+{ author empty$
+ { editor empty$
+ { key empty$
+ { "to sort, need author, editor, or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { editor sort.format.names }
+ if$
+ }
+ { author sort.format.names }
+ if$
+}
+
+FUNCTION {author.organization.sort}
+{ author empty$
+ { organization empty$
+ { key empty$
+ { "to sort, need author, organization, or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { "The " #4 organization chop.word sortify }
+ if$
+ }
+ { author sort.format.names }
+ if$
+}
+
+FUNCTION {editor.organization.sort}
+{ editor empty$
+ { organization empty$
+ { key empty$
+ { "to sort, need editor, organization, or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { "The " #4 organization chop.word sortify }
+ if$
+ }
+ { editor sort.format.names }
+ if$
+}
+
+FUNCTION {presort}
+{ calc.label
+ sort.label
+ " "
+ *
+ type$ "book" =
+ type$ "inbook" =
+ or
+ 'author.editor.sort
+ { type$ "proceedings" =
+ 'editor.organization.sort
+ { type$ "manual" =
+ 'author.organization.sort
+ 'author.sort
+ if$
+ }
+ if$
+ }
+ if$
+ *
+ " "
+ *
+ year field.or.null sortify
+ *
+ " "
+ *
+ title field.or.null
+ sort.format.title
+ *
+ #1 entry.max$ substring$
+ 'sort.key$ :=
+}
+
+ITERATE {presort}
+
+SORT
+
+STRINGS { longest.label last.sort.label next.extra }
+
+INTEGERS { longest.label.width last.extra.num }
+
+FUNCTION {initialize.longest.label}
+{ "" 'longest.label :=
+ #0 int.to.chr$ 'last.sort.label :=
+ "" 'next.extra :=
+ #0 'longest.label.width :=
+ #0 'last.extra.num :=
+}
+
+FUNCTION {forward.pass}
+{ last.sort.label sort.label =
+ { last.extra.num #1 + 'last.extra.num :=
+ last.extra.num int.to.chr$ 'extra.label :=
+ }
+ { "a" chr.to.int$ 'last.extra.num :=
+ "" 'extra.label :=
+ sort.label 'last.sort.label :=
+ }
+ if$
+}
+
+FUNCTION {reverse.pass}
+{ next.extra "b" =
+ { "a" 'extra.label := }
+ 'skip$
+ if$
+ label extra.label * 'label :=
+ label width$ longest.label.width >
+ { label 'longest.label :=
+ label width$ 'longest.label.width :=
+ }
+ 'skip$
+ if$
+ extra.label 'next.extra :=
+}
+
+EXECUTE {initialize.longest.label}
+
+ITERATE {forward.pass}
+
+REVERSE {reverse.pass}
+
+FUNCTION {begin.bib}
+{ et.al.char.used
+ { "\newcommand{\etalchar}[1]{$^{#1}$}" write$ newline$ }
+ 'skip$
+ if$
+% preamble$ empty$
+% 'skip$
+% { preamble$ write$ newline$ }
+% if$
+ "@c \begin@[thebibliography@]@[" longest.label * "@]" * write$ newline$
+}
+
+EXECUTE {begin.bib}
+
+EXECUTE {init.state.consts}
+
+ITERATE {call.type$}
+
+FUNCTION {end.bib}
+{ newline$
+ "@c \end@[thebibliography@]" write$ newline$
+}
+
+EXECUTE {end.bib}
diff --git a/Build/source/texk/web2c/doc/web2c.cps b/Build/source/texk/web2c/doc/web2c.cps
new file mode 100644
index 00000000000..d4097dd5a7a
--- /dev/null
+++ b/Build/source/texk/web2c/doc/web2c.cps
@@ -0,0 +1,846 @@
+\initial {#}
+\entry {\samp {#define} options}{3}
+\initial {$}
+\entry {\code {$ \r {expansion in filenames}}}{13}
+\initial {%}
+\entry {\code {%& \r {magic number}}}{11}
+\initial {-}
+\entry {\code {- \r {starting a filename}}}{7}
+\entry {\code {- \r {starts option names}}}{7}
+\entry {\code {-- \r {starts option names}}}{7}
+\entry {\code {--disable-dump-share configure \r {option}}}{11}
+\entry {\code {--enable-ipc configure \r {option}}}{15}
+\entry {\code {--help \r {common option}}}{7}
+\entry {\code {--quiet (newer)}}{35}
+\entry {\code {--verbose (newer)}}{35}
+\entry {\code {--verbose \r {common option}}}{7}
+\entry {\code {--version \r {common option}}}{7}
+\entry {\code {--with-editor=\var {cmd}}}{12}
+\entry {\code {--with-epsfwin}}{26}
+\entry {\code {--with-hp2627win}}{26}
+\entry {\code {--with-mftalkwin}}{26}
+\entry {\code {--with-next}}{26}
+\entry {\code {--with-regiswin}}{26}
+\entry {\code {--with-suntoolswin}}{26}
+\entry {\code {--with-tektronixwin}}{26}
+\entry {\code {--with-unitermwin}}{26}
+\entry {\code {--with-x}}{26}
+\entry {\code {--with-x-toolkit=\var {kit}}}{26}
+\entry {\code {--with-x11}}{26}
+\entry {\code {--with-x11win}}{26}
+\entry {\code {-8bit}}{9}
+\entry {\code {-base=\var {base}}}{11}
+\entry {\code {-base=\var {dumpname}}}{8}
+\entry {\code {-change=\var {chfile}}}{28}
+\entry {\code {-charcode-format=\var {type}}}{51, 53}
+\entry {\code {-D \r {compiler options}}}{3}
+\entry {\code {-dpi=\var {real}}}{43}
+\entry {\code {-enc}}{15}
+\entry {\code {-file-line-error}}{7}
+\entry {\code {-file-line-error-style}}{7}
+\entry {\code {-fmt=\var {dumpname}}}{8}
+\entry {\code {-fmt=\var {fmt}}}{11}
+\entry {\code {-geometry\r {, supported with Xt}}}{26}
+\entry {\code {-halt-on-error}}{8}
+\entry {\code {-images}}{49}
+\entry {\code {-ini}}{8, 10}
+\entry {\code {-interaction=\var {string}}}{8}
+\entry {\code {-ipc}}{15}
+\entry {\code {-ipc-start}}{15}
+\entry {\code {-jobname=\var {string}}}{8}
+\entry {\code {-kpathsea-debug=\var {number}}}{8}
+\entry {\code {-length=\var {number}}}{39}
+\entry {\code {-loose}}{40}
+\entry {\code {-lowercase}}{39}
+\entry {\code {-magnification=\var {integer}}}{42, 43}
+\entry {\code {-max-pages=\var {n}}}{42, 43}
+\entry {\code {-mem=\var {dumpname}}}{8}
+\entry {\code {-mem=\var {mem}}}{11}
+\entry {\code {-min-crossrefs=\var {n}}}{37}
+\entry {\code {-mixedcase}}{39}
+\entry {\code {-mktex=\var {filetype}}}{15, 24}
+\entry {\code {-mltex}}{16}
+\entry {\code {-mnemonics}}{49}
+\entry {\code {-no-file-line-error}}{7}
+\entry {\code {-no-mktex=\var {filetype}}}{15, 24}
+\entry {\code {-no-parse-first-line}}{8}
+\entry {\code {-no-shell-escape}}{16}
+\entry {\code {-oem}}{9}
+\entry {\code {-output-comment=\var {string}}}{16}
+\entry {\code {-output-directory}}{8, 9}
+\entry {\code {-output-level=\var {n}}}{43}
+\entry {\code {-overflow-label-offset=\var {points}}}{27}
+\entry {\code {-page-start=\var {page-spec}}}{42, 43}
+\entry {\code {-parse-first-line}}{8}
+\entry {\code {-progname=\var {string}}}{8, 11}
+\entry {\code {-recorder}}{9}
+\entry {\code {-shell-escape}}{16}
+\entry {\code {-show-opcodes}}{43}
+\entry {\code {-strict}}{40}
+\entry {\code {-style=\var {mftfile}}}{28}
+\entry {\code {-T}}{32}
+\entry {\code {-terse}}{37}
+\entry {\code {-tex}}{35}
+\entry {\code {-tex=\var {texprogram}}}{32}
+\entry {\code {-translate-file=\var {tcxfile}}}{9}
+\entry {\code {-troff}}{32, 33, 35}
+\entry {\code {-underline}}{40}
+\entry {\code {-uppercase}}{39}
+\entry {\code {-x}}{40}
+\initial {.}
+\entry {\code {.\r {, used for output}}}{9}
+\entry {\code {.2602gf}}{23}
+\entry {\code {.aux \r {cross-reference files}}}{37}
+\entry {\code {.base}}{24}
+\entry {\code {.bbl \r {bibliography files}}}{37}
+\entry {\code {.bib \r {bibliography databases}}}{37}
+\entry {\code {.blg \r {Bib\TeX {} log file}}}{37}
+\entry {\code {.fmt}}{17}
+\entry {\code {.mem}}{32}
+\entry {\code {.mf}}{23}
+\entry {\code {.mp}}{30}
+\entry {\code {.\var {nnn} \r {PostScript figures}}}{30}
+\entry {\code {.\var {nnn}gf \r {generic fonts}}}{23}
+\entry {\code {.tcx \r {character translation files}}}{9, 19}
+\entry {\code {.tex}}{14}
+\entry {\code {.tfm \r {output}}}{23, 30}
+\entry {\code {.Xdefaults}}{26}
+\entry {\code {.Xresources}}{26}
+\initial {^}
+\entry {\code {^^ \r {notation, avoiding}}}{20}
+\initial {{\tt \indexbackslash }}
+\entry {\code {{\tt \backslashcurfont }bibliography}}{37}
+\entry {\code {{\tt \backslashcurfont }bibliographystyle}}{37}
+\entry {\code {{\tt \backslashcurfont }charsubdef \r {and ML\TeX {}}}}{18}
+\entry {\code {{\tt \backslashcurfont }count\var {n}}}{42, 43}
+\entry {\code {{\tt \backslashcurfont }font \r {and dynamic generation}}}{14}
+\entry {\code {{\tt \backslashcurfont }fontdimen}}{52}
+\entry {\code {{\tt \backslashcurfont }immediate{\tt \backslashcurfont }write18}}{16}
+\entry {\code {{\tt \backslashcurfont }input \r {filenames}}}{12}
+\entry {\code {{\tt \backslashcurfont }mag}}{42, 43}
+\entry {\code {{\tt \backslashcurfont }openout \r {and security}}}{14}
+\entry {\code {{\tt \backslashcurfont }string}}{13}
+\entry {\code {{\tt \backslashcurfont }tracingcharsubdef \r {and ML\TeX {}}}}{19}
+\entry {\code {{\tt \backslashcurfont }tracinglostchars \r {and ML\TeX {}}}}{19}
+\entry {\code {{\tt \backslashcurfont }write18 \r {shell escape extension}}}{16}
+\initial {~}
+\entry {\code {~ \r {expansion in filenames}}}{13}
+\initial {2}
+\entry {\code {2602gf}}{23}
+\initial {8}
+\entry {8 bit clean}{9}
+\entry {\code {8 bit clean output, specifying}}{9}
+\entry {8-bit characters}{19}
+\initial {A}
+\entry {\code {abbrv.bst}}{38}
+\entry {accented character}{19}
+\entry {accents, hyphenating words with}{18}
+\entry {acknowledgements}{1}
+\entry {\code {acm.bst}}{38}
+\entry {Ada, WEB for}{39}
+\entry {additional Make targets}{4}
+\entry {AFM to TFM conversion}{54}
+\entry {\code {afm2tfm}}{54}
+\entry {\code {afmtopl}}{54}
+\entry {aliases for fonts}{9}
+\entry {\code {alpha.bst}}{38}
+\entry {American Mathematical Society, typesetting system}{18}
+\entry {AMS\TeX {}}{18}
+\entry {\code {apalike.bst}}{38}
+\entry {Arabic typesetting}{22}
+\entry {architecture dependencies}{11}
+\entry {array limit, fixed}{5}
+\entry {array sizes}{5}
+\entry {assembly language routines}{4}
+\entry {\code {autotrace}}{54}
+\entry {Awk, WEB for}{39}
+\initial {B}
+\entry {base file, determining}{11}
+\entry {base files}{24}
+\entry {base files, need mode definitions}{25}
+\entry {base files, plain only}{25}
+\entry {base files, sharing}{11}
+\entry {\code {bases \r {Make target}}}{4}
+\entry {basic Bib\TeX {} style files}{38}
+\entry {basic fonts and macros}{2}
+\entry {batch languages}{14}
+\entry {BDF and GF conversion}{54}
+\entry {\code {beginfig}}{30}
+\entry {\code {BeginPath \r {ditroff command}}}{34}
+\entry {Berry, Karl}{1}
+\entry {\code {BIBINPUTS\r {, search path for bib files}}}{37}
+\entry {bibliographies, creating}{37}
+\entry {bibliography}{56}
+\entry {bibliography items, cross-referenced}{37}
+\entry {\code {bibtex}}{37}
+\entry {Bib\TeX {}}{37}
+\entry {Bib\TeX {} collection}{37}
+\entry {Bib\TeX {} style files}{38}
+\entry {BigEndian machines}{11}
+\entry {binaries, linking}{8}
+\entry {blank lines, in TCX files}{20}
+\entry {Bourne shell commands in \TeX {}}{16}
+\entry {boxes, memory for}{5}
+\entry {breakpoints, memory for}{5}
+\entry {Breitenlohner, Peter}{1}
+\entry {\code {BSTINPUTS\r {, search path for bst files}}}{37}
+\entry {\code {btex \r {and label extraction}}}{35}
+\entry {\code {btex \r {for MetaPost labels}}}{30}
+\entry {\code {btxdoc.bib}}{37}
+\entry {\code {btxdoc.tex}}{37}
+\entry {\code {btxhak.tex}}{37}
+\entry {byte position}{48, 50}
+\entry {byte swapping}{11}
+\initial {C}
+\entry {\code {c-sources \r {Makefile target}}}{4}
+\entry {captions, extracting from MetaPost input}{35}
+\entry {captions, for MetaPost}{32}
+\entry {change files, and MFT}{28}
+\entry {change files, and Tangle}{39}
+\entry {change files, and Weave}{40}
+\entry {changing error messages style}{7}
+\entry {character codes, in GFtype output}{50}
+\entry {character codes, in PKtype output}{48}
+\entry {character codes, in TCX files}{20}
+\entry {character proofs of fonts}{27}
+\entry {\code {CHARACTER \r {property}}}{52}
+\entry {character translation files}{19}
+\entry {\code {CHARDP \r {property}}}{52}
+\entry {\code {CHARHT \r {property}}}{52}
+\entry {\code {CHARIC \r {property}}}{52}
+\entry {\code {CHARWD \r {property}}}{52}
+\entry {\code {chtopx}}{54}
+\entry {class name for Metafont}{26}
+\entry {\code {cm.base}}{25}
+\entry {\code {cmbase.mf}}{25}
+\entry {\code {cmbase.mft}}{28}
+\entry {\code {cmmf.base \r {not recommended}}}{25}
+\entry {comments, in TCX files}{20}
+\entry {comments, MFT control}{28}
+\entry {common options}{7}
+\entry {commonalities}{7}
+\entry {comparing file modification times}{35}
+\entry {compilation}{2}
+\entry {compile-time options}{2, 3}
+\entry {Computer Modern fonts, and Troff}{31}
+\entry {Computer Modern macros}{25}
+\entry {\cite {Computer Modern Typefaces}, production of}{28}
+\entry {configuration}{2}
+\entry {configuration file reading}{9}
+\entry {configuration file values}{5}
+\entry {configuration, compile-time}{2}
+\entry {\code {configure --with/--enable \r {options}}}{2}
+\entry {\code {CONTENTS.tex}}{40}
+\entry {control sequence names, space for}{5}
+\entry {conventions for options,}{7}
+\entry {conversion, DVI to plain text}{42}
+\entry {conversion, GF to PK}{47}
+\entry {conversion, GF to plain text}{49}
+\entry {conversion, PK to GF}{47}
+\entry {conversion, PK to plain text}{47}
+\entry {conversion, property list to TFM}{53}
+\entry {conversion, property list to VF}{54}
+\entry {conversion, TFM to property list}{51}
+\entry {conversion, VF to VPL}{53}
+\entry {copyright notices}{55}
+\entry {Cork encoding and ISO input}{20}
+\entry {creating memory dumps}{10}
+\entry {cross-referenced bibliography items}{37}
+\entry {cross-references, omitting}{40}
+\entry {current directory, used for output}{9}
+\entry {Curtis, Pavel}{1}
+\entry {Cweb}{39}
+\entry {CWEB}{39}
+\initial {D}
+\entry {\code {D \var {c} \r {ditroff graphics}}}{34}
+\entry {date and time, in memory dumps}{11}
+\entry {debugging DVI utilities}{43}
+\entry {debugging flags, specifying}{8}
+\entry {decimal character codes, in TCX files}{20}
+\entry {dependencies, hardware}{11}
+\entry {design-size units}{52}
+\entry {device definitions, for Metafont}{25}
+\entry {device-independent width}{48, 50}
+\entry {directory structure}{2}
+\entry {\code {DISPLAY}}{26}
+\entry {ditroff output, converting to MPX}{34}
+\entry {\code {DMP}}{33, 34}
+\entry {DMP, invoked by MakeMPX}{33}
+\entry {\code {dmp.c}}{35}
+\entry {dot files, written by \TeX {} programs}{14}
+\entry {downloading of fonts for MetaPost labels}{31}
+\entry {\code {dpost}}{34}
+\entry {\code {DrawingServant}}{26}
+\entry {\code {DrawPath \r {ditroff command}}}{34}
+\entry {dump file}{8}
+\entry {dumping memory}{10}
+\entry {DVI comment, specifying}{16}
+\entry {DVI files, converting to MPX}{33}
+\entry {DVI files, creating multiple}{22}
+\entry {DVI files, explained}{46}
+\entry {DVI format definition}{42}
+\entry {DVI opcodes, showing}{43}
+\entry {DVI utilities}{42}
+\entry {\code {dvicopy}}{42}
+\entry {\code {dvitomp}}{33}
+\entry {\code {DVITOMP}}{33}
+\entry {DVItoMP, invoked by MakeMPX}{33}
+\entry {\code {dvitype \r {DVI validation}}}{42}
+\entry {dvitype output example}{43}
+\entry {\code {dvitype.web}}{42}
+\entry {dx \r {horizontal escapement}}{48, 50}
+\entry {dy \r {vertical escapement}}{50}
+\entry {dynamic array allocation}{5}
+\entry {dynamic Metafont mode definitions with \code {smode}}{25}
+\entry {dynamic packing variable}{48}
+\initial {E}
+\entry {\code {e \r {response at error prompt}}}{12}
+\entry {e-circumflex}{19}
+\entry {e-\TeX {}}{21}
+\entry {\code {e.mft}}{28}
+\entry {EC fonts}{14, 23}
+\entry {editing of bitmap fonts}{54}
+\entry {editor invoked at error}{12}
+\entry {eight-bit characters in filenames}{13}
+\entry {endian dependencies}{11}
+\entry {\code {eoc \r {GF command}}}{50}
+\entry {Eplain}{18}
+\entry {\code {epsf}}{26}
+\entry {errors, editor invoked at}{12}
+\entry {escapement, horizontal}{48, 50}
+\entry {escapement, vertical}{50}
+\entry {\code {etex \r {and label extraction}}}{35}
+\entry {\code {etex \r {for MetaPost labels}}}{30}
+\entry {executables, shared initial and virgin}{10}
+\entry {expanded plain format}{18}
+\entry {extensions to \TeX {}}{21}
+\entry {\code {extra_mem_bot}}{5}
+\initial {F}
+\entry {\code {FACE \r {property}}}{52}
+\entry {\code {FAMILY \r {property}}}{52}
+\entry {Ferguson, Michael}{18}
+\entry {file formats for fonts}{46}
+\entry {file mtimes, comparing}{35}
+\entry {file recorder}{9}
+\entry {File-handling \TeX {}}{22}
+\entry {filename conventions, in input files}{12}
+\entry {filenames starting with \samp {-}}{7}
+\entry {first line of the main input file}{9}
+\entry {fixed-point arithmetic}{4}
+\entry {\code {FIXPT}}{4}
+\entry {flag byte}{48}
+\entry {floating-point arithmetic}{4}
+\entry {floating-point values}{11}
+\entry {fmt file, determining}{11}
+\entry {fmt files}{17}
+\entry {fmt files, sharing}{11}
+\entry {\code {fmts \r {Make target}}}{4}
+\entry {font aliases}{9}
+\entry {font character code, translating}{20}
+\entry {font design}{23}
+\entry {font downloading for MetaPost labels}{31}
+\entry {font file formats}{46}
+\entry {font proofs}{27}
+\entry {font utilities}{46}
+\entry {font utilities, non-Web2c}{54}
+\entry {\code {font_mem_size}}{5}
+\entry {\code {fontforge}}{54}
+\entry {\code {fontinst\r {, for creating virtual fonts}}}{54}
+\entry {fonts, basic}{2}
+\entry {\code {fontutils}}{54}
+\entry {format files}{17}
+\entry {formats for \TeX {}}{17}
+\entry {\code {formats \r {Make target}}}{4}
+\entry {fraction routines}{4}
+\entry {Free Software Foundation documentation system}{18}
+\entry {freedom of Web2c}{1}
+\entry {\code {ftp.math.utah.edu}}{37}
+\initial {G}
+\entry {generating source specials}{16}
+\entry {geometric designs}{23}
+\entry {geometric font scaling}{46}
+\entry {geometry for Metafont}{26}
+\entry {\code {getopt_long_only}}{7}
+\entry {GF files, explained}{46}
+\entry {GF files, output by Metafont}{23}
+\entry {GF format definition}{46}
+\entry {GF output}{23}
+\entry {GF, converting PK to}{47}
+\entry {GF, converting to PK}{47}
+\entry {\code {gftodvi}}{27}
+\entry {\code {gftopk}}{47}
+\entry {\code {gftopxl}}{54}
+\entry {\code {gftype \r {GF validation}}}{49}
+\entry {\code {gftype.web}}{46}
+\entry {glue ratio representations}{11}
+\entry {glue, memory for}{5}
+\entry {glyph substitutions}{18}
+\entry {gray font}{27}
+\entry {Gruff, Billy Goat}{4}
+\entry {\code {gsftopk}}{54}
+\initial {H}
+\entry {Harbison, Samuel P.}{12}
+\entry {hardware and memory dumps}{11}
+\entry {hash table, increasing size of}{5}
+\entry {\code {hash_extra}}{5}
+\entry {\code {headerbyte \r {information}}}{52}
+\entry {height, in pixels}{48}
+\entry {help, online}{7}
+\entry {Henry, Patrick}{1}
+\entry {Herberts, Mathias}{26}
+\entry {hex character codes, in TCX files}{20}
+\entry {history}{1}
+\entry {Hobby, John}{1, 35}
+\entry {horizontal escapement}{48, 50}
+\entry {\code {hp2627}}{26}
+\entry {human languages, supported in \TeX {}}{18}
+\entry {human-readable text, converting DVI to}{42}
+\entry {human-readable text, converting GF to}{49}
+\entry {human-readable text, converting PK to}{47}
+\entry {human-readable text, converting TFM to}{51}
+\entry {human-readable text, converting VF to}{53}
+\entry {hyphenation and languages}{18}
+\entry {hyphenation patterns, creating}{21}
+\initial {I}
+\entry {ice cream}{1}
+\entry {identifier case}{39}
+\entry {identifier collisions}{40}
+\entry {identifier length}{39}
+\entry {identifiers with underlines}{40}
+\entry {\code {ieeetr.bst}}{38}
+\entry {\code {il1-t1.tcx}}{20}
+\entry {\code {il2-t1.tcx}}{20}
+\entry {Info format}{18}
+\entry {initial form, enabling}{8}
+\entry {initial Metafont}{24}
+\entry {initial MetaPost}{32}
+\entry {initial programs}{10}
+\entry {initial \TeX {}}{17}
+\entry {initializations, lengthy}{10}
+\entry {input filenames}{12}
+\entry {\code {install-bases \r {Make target}}}{4}
+\entry {\code {install-fmts \r {Make target}}}{4}
+\entry {\code {install-formats \r {Make target}}}{4}
+\entry {\code {install-mems \r {Make target}}}{4}
+\entry {installation}{2}
+\entry {interaction between TCX files and \samp {-8bit}.}{21}
+\entry {interaction mode}{8}
+\entry {international characters}{19}
+\entry {introduction}{1}
+\entry {IPC}{21}
+\entry {\code {IPC_DEBUG}}{4, 21}
+\initial {J}
+\entry {job name}{8}
+\initial {K}
+\entry {kerning table, in TFM files}{52}
+\entry {keyboard character code, translating}{20}
+\entry {Knuth, Donald E.}{1, 28}
+\entry {\code {KPATHSEA_DEBUG}}{8}
+\entry {\code {KRN \r {property}}}{52}
+\initial {L}
+\entry {label font}{27}
+\entry {\code {LABEL \r {property}}}{52}
+\entry {labels, extracting from MetaPost input}{35}
+\entry {labels, for MetaPost}{32}
+\entry {language support in \TeX {}}{18}
+\entry {languages, hyphenation rules for}{21}
+\entry {\LaTeX {}}{17}
+\entry {Latin Modern}{54}
+\entry {left side bearing}{48, 50}
+\entry {legalisms}{55}
+\entry {licensing terms}{1}
+\entry {\code {LIG \r {property}}}{52}
+\entry {ligature table, in TFM files}{52}
+\entry {\code {LIGTABLE \r {property}}}{52}
+\entry {linking binaries}{8}
+\entry {links to binaries}{11}
+\entry {literate programming}{39}
+\entry {\code {litprog@shsu.edu}}{39}
+\entry {LittleEndian machines}{11}
+\entry {log file, Bib\TeX {}}{37}
+\initial {M}
+\entry {machine dependencies}{11}
+\entry {machine-readable, converting property lists to}{53, 54}
+\entry {MacKay, Pierre}{47}
+\entry {macro packages, major \TeX {}}{17}
+\entry {macros, basic}{2}
+\entry {macros, predefining in memory dumps}{10}
+\entry {magnification}{42, 43}
+\entry {\code {main_memory}}{5}
+\entry {Make targets, additional}{4}
+\entry {\code {makempx}}{32}
+\entry {\code {MAKEMPX_BINDIR}}{33}
+\entry {Martin, Rick}{1}
+\entry {Mathematical Reviews}{18}
+\entry {mathematical typesetting}{14}
+\entry {mem file, determining}{11}
+\entry {mem files}{32}
+\entry {mem files, plain only}{32}
+\entry {mem files, sharing}{11}
+\entry {memory dump to use, determining}{11}
+\entry {memory dumps}{10}
+\entry {memory dumps and hardware}{11}
+\entry {memory dumps, contain date and time}{11}
+\entry {memory dumps, creating}{10}
+\entry {\code {mems \r {Make target}}}{4}
+\entry {meta characters in filenames}{13}
+\entry {Metafont}{23}
+\entry {Metafont geometry}{26}
+\entry {Metafont graphics}{26}
+\entry {Metafont input files}{23}
+\entry {Metafont invocation}{23}
+\entry {Metafont meets PostScript}{30}
+\entry {Metafont online support, new devices}{26}
+\entry {Metafont source, prettyprinting}{27}
+\entry {Metafont, compatibility in MetaPost}{32}
+\entry {Metafont, initial}{24}
+\entry {Metafont, MetaPost, and \TeX {}}{10}
+\entry {MetaFun, enhanced MetaPost}{32}
+\entry {\code {metafun.mp}}{32}
+\entry {MetaPost}{30}
+\entry {MetaPost and plain Metafont compatibility}{32}
+\entry {MetaPost input files}{30}
+\entry {MetaPost input, extracting labels from}{35}
+\entry {MetaPost invocation}{30}
+\entry {MetaPost labels}{32}
+\entry {MetaPost source, prettyprinting}{28}
+\entry {MetaPost, initial}{32}
+\entry {MetaPost, \TeX {}, and Metafont}{10}
+\entry {\code {metatype1}}{54}
+\entry {\code {mf}}{23}
+\entry {\code {mf.base}}{24}
+\entry {\code {MFEDIT}}{12}
+\entry {\code {mfplain.mem}}{32}
+\entry {\code {mfput}}{23}
+\entry {\code {mft}}{27}
+\entry {\code {mftalk}}{26}
+\entry {\code {MFTERM}}{26}
+\entry {\code {mftmac.tex}}{27}
+\entry {\code {mktexmf\r {, disabling}}}{23}
+\entry {\code {mktextfM\r {, disabling}}}{14}
+\entry {\code {mltex}}{18}
+\entry {ML\TeX {}, enabling}{16}
+\entry {mode needed to run Metafont}{23}
+\entry {\code {mode_def}}{25}
+\entry {\code {mode_setup}}{25}
+\entry {modes file needed for Metafont}{25}
+\entry {\code {modes.mf \r {recommended modes file}}}{25}
+\entry {Morgan, Tim}{1}
+\entry {Morris, Bob}{1}
+\entry {\code {MPEDIT}}{12}
+\entry {\code {mpgraph.ps}}{30}
+\entry {\code {mpman.ps}}{30}
+\entry {\code {mpost}}{30}
+\entry {\code {mpost\r {, reason for name change}}}{2}
+\entry {\code {mpost.mem}}{32}
+\entry {\code {mpout}}{30}
+\entry {\code {mproof.tex}}{31}
+\entry {\code {MPSUPPORT}}{34}
+\entry {\code {MPto}}{35}
+\entry {MPto, invoked by MakeMPX}{32}
+\entry {\code {MPTOTEX}}{33}
+\entry {\code {MPTOTR}}{33}
+\entry {\code {mptrap \r {Make target}}}{4}
+\entry {mptrap test}{4}
+\entry {\code {mptrap.readme}}{4}
+\entry {mpx file, defined}{33}
+\entry {MPX files, converting from DVI files}{33}
+\entry {MPX files, creating from ditroff output}{34}
+\entry {\code {mpxerr}}{33}
+\entry {\code {mpxerr.dvi}}{33}
+\entry {\code {mpxerr.log}}{33}
+\entry {\code {mpxerr.t}}{33}
+\entry {\code {mpxerr.tex}}{33}
+\entry {mtimes of files, comparing}{35}
+\entry {Multi-lingual \TeX {}}{18}
+\entry {multiple DVI files, creating}{22}
+\initial {N}
+\entry {N tilde}{19}
+\entry {new graphics support for Metafont}{26}
+\entry {\code {NEWER}}{33}
+\entry {\code {newer \r {file comparison}}}{35}
+\entry {\code {newrow \r {GF command}}}{50}
+\entry {\code {next}}{26}
+\entry {\code {NO_X11WIN}}{26}
+\entry {non-Unix system, compiling on}{4}
+\entry {NUL, not allowed in filenames}{13}
+\initial {O}
+\entry {octal character codes, in TCX files}{20}
+\entry {offset for overflow labels}{27}
+\entry {older-than, file comparisons}{35}
+\entry {Omega}{21}
+\entry {online Metafont graphics}{26}
+\entry {opcodes, showing DVI}{43}
+\entry {optical font scaling}{46}
+\entry {option conventions}{7}
+\entry {origin}{48}
+\entry {output directory, specifying}{8, 9}
+\entry {output file location}{9}
+\entry {output files, written by \TeX {} programs}{14}
+\entry {\code {output_comment \r {for DVI files}}}{16}
+\entry {overflow label offset}{27}
+\initial {P}
+\entry {packet length}{48}
+\entry {page, starting}{42, 43}
+\entry {parsing the first line}{8}
+\entry {Pascal, creating from WEB}{39}
+\entry {\code {patgen}}{21}
+\entry {path searching}{9}
+\entry {path searching debugging}{8}
+\entry {PDF}{22}
+\entry {pdf\TeX {}}{22}
+\entry {permissions, legal}{55}
+\entry {PFA and PFB conversion}{54}
+\entry {\code {pfaedit}}{54}
+\entry {PiC\TeX {}, increasing memory for}{5}
+\entry {picture expressions}{33}
+\entry {pixel height}{48}
+\entry {pixel width}{48}
+\entry {PK bitmaps from PostScript}{54}
+\entry {PK files, explained}{46}
+\entry {PK files, not output by Metafont}{23}
+\entry {PK format definition}{46}
+\entry {PK, converting GF to}{47}
+\entry {PK, converting to GF}{47}
+\entry {\code {pktogf}}{47}
+\entry {\code {pktype \r {PK validation}}}{47}
+\entry {\code {pktype.web}}{46}
+\entry {PL files, explained}{46}
+\entry {plain Metafont, compatibility in MetaPost}{32}
+\entry {plain text, converting DVI to}{42}
+\entry {plain text, converting GF to}{49}
+\entry {plain text, converting PK to}{47}
+\entry {plain text, converting TFM to}{51}
+\entry {plain text, converting VF to}{53}
+\entry {\code {plain.base}}{24}
+\entry {\code {plain.bst}}{38}
+\entry {\code {plain.fmt}}{17}
+\entry {\code {plain.mem}}{32}
+\entry {\code {plain.mft}}{28}
+\entry {\code {pltotf}}{53}
+\entry {pool file, writing}{39}
+\entry {Poole, Simon}{26}
+\entry {\code {pooltype}}{40}
+\entry {portable filenames}{13}
+\entry {PostScript fonts, and Troff}{31}
+\entry {PostScript meets Metafont}{30}
+\entry {PostScript output}{30}
+\entry {PostScript to PK bitmaps}{54}
+\entry {PostScript Type 1 font conversion}{54}
+\entry {PostScript, and font scaling}{46}
+\entry {\code {potrace}}{54}
+\entry {Pragma ADE}{32}
+\entry {predefined macros and memory dumps}{10}
+\entry {prettyprinting Metafont source}{27}
+\entry {prettyprinting WEB programs}{40}
+\entry {primitives, new}{21}
+\entry {printable characters, specifying}{20}
+\entry {printer characteristics, for Metafont}{25}
+\entry {production use}{10}
+\entry {program name, determines memory dump}{11}
+\entry {program names, special}{8, 16}
+\entry {\code {prologues}}{32}
+\entry {\code {prologues \r {and Troff in MetaPost}}}{33}
+\entry {\code {prologues\r {, and EPSF output}}}{31}
+\entry {\code {proof \r {mode}}}{23}
+\entry {proof sheets, of fonts}{27}
+\entry {property list format}{51}
+\entry {property list, converting TFM to}{51}
+\entry {property list, converting VF to virtual}{53}
+\entry {\code {ps2pk}}{54}
+\entry {\code {psfonts.map\r {, read by MetaPost}}}{31}
+\entry {PXL files, explained}{46}
+\entry {\code {pxtoch}}{54}
+\initial {R}
+\entry {Raichle, Bernd}{18}
+\entry {reading, additional}{1}
+\entry {readonly directory, running \TeX {} in}{9}
+\entry {reallocation of arrays}{5}
+\entry {redefined character substitutions}{19}
+\entry {reference pixel}{48}
+\entry {references}{56}
+\entry {\code {regis}}{26}
+\entry {Regis graphics support}{26}
+\entry {regression testing}{16}
+\entry {repeated rows}{49}
+\entry {representation of strings}{41}
+\entry {right side bearing}{48, 50}
+\entry {right-to-left typesetting}{22}
+\entry {Rokicki, Tomas}{1}
+\entry {run length encoded bitmaps}{49, 50}
+\entry {runtime options}{5}
+\initial {S}
+\entry {scaled pixels}{48, 50}
+\entry {scaling of fonts}{46}
+\entry {scanned images of fonts}{54}
+\entry {security, and \code {{\tt \backslashcurfont }openout}}{14}
+\entry {security, and output files}{14}
+\entry {security, and shell escapes}{16}
+\entry {\code {SetColor \r {ditroff command}}}{34}
+\entry {shapes}{23}
+\entry {sharing memory dumps}{11}
+\entry {shell commands in \TeX {}}{16}
+\entry {\code {shell_escape \r {enabling in \TeX {}}}}{16}
+\entry {\code {siam.bst}}{38}
+\entry {side bearings}{48, 50}
+\entry {slant font}{27}
+\entry {slides, producing}{18}
+\entry {Sli\TeX {}}{18}
+\entry {small Metafont memory and modes}{25}
+\entry {\code {smode \r {and dynamic Metafont mode definition}}}{25}
+\entry {sockets}{21}
+\entry {space-terminated filenames}{12}
+\entry {Spiderweb}{39}
+\entry {Stallman, Richard}{1}
+\entry {starting page}{42, 43}
+\entry {Steele Jr., Guy L.}{12}
+\entry {stopping at the first error}{8}
+\entry {strategy, overall}{1}
+\entry {string numbers, displaying}{40}
+\entry {string pool, writing}{39}
+\entry {string representation}{41}
+\entry {style design, for Bib\TeX {}}{37}
+\entry {style files}{28}
+\entry {substitutions of font glyphs}{18}
+\entry {\code {sun}}{26}
+\entry {\code {sun-gfx.c}}{26}
+\entry {Suntools}{26}
+\entry {SunView}{26}
+\entry {swap space, as array limit}{5}
+\entry {swapping bytes}{11}
+\entry {syntax of TCX files}{20}
+\entry {\code {system \r {C library function}}}{16}
+\initial {T}
+\entry {T1 encoding and ISO input}{20}
+\entry {Tachikawa, Elizabeth}{47}
+\entry {\code {tangle}}{39}
+\entry {targets, additional Make}{4}
+\entry {\code {TCX \r {character translation files}}}{19}
+\entry {\code {tek}}{26}
+\entry {Tektronix}{26}
+\entry {Tektronix 4014}{26}
+\entry {\code {TERM}}{26}
+\entry {terminator for filenames}{12}
+\entry {terse output}{37}
+\entry {\code {tex}}{14}
+\entry {\code {TEX}}{33}
+\entry {\code {TeX--XeT}}{22}
+\entry {\code {tex.fmt}}{17}
+\entry {\TeX {}, bibliographies for}{37}
+\entry {\TeX {}, creating from Metafont}{27}
+\entry {\TeX {}, creating from WEB}{40}
+\entry {\TeX {}, description of}{14}
+\entry {\TeX {}, extensions to}{21}
+\entry {\TeX {}, format packages for}{17}
+\entry {\TeX {}, initial}{17}
+\entry {\TeX {}, input files found}{14}
+\entry {\TeX {}, invocation}{14}
+\entry {\TeX {}, Metafont, and MetaPost}{10}
+\entry {\TeX {}, Web2c implementation of}{1}
+\entry {\code {TEXBIB\r {, search path for bib files}}}{37}
+\entry {\code {TEXEDIT}}{12}
+\entry {\code {texfonts.map}}{9}
+\entry {Texinfo}{18}
+\entry {\code {texmf.cnf}}{9}
+\entry {\code {texmfmp.c}}{26}
+\entry {\code {texmfmp.c \r {and \code {openoutnameok}}}}{14}
+\entry {\code {TEXMFOUTPUT\r {, used if \samp {.} unwritable}}}{9}
+\entry {\code {texput}}{14}
+\entry {text, extracting from MetaPost input}{35}
+\entry {TFM files, converting property lists to}{53}
+\entry {TFM files, explained}{46}
+\entry {TFM files, memory for}{5}
+\entry {TFM files, output by Metafont}{23}
+\entry {TFM files, output by MetaPost}{30}
+\entry {TFM width of characters}{48, 50}
+\entry {\code {tftopl}}{51}
+\entry {three programs}{10}
+\entry {time and date, in memory dumps}{11}
+\entry {title font}{27}
+\entry {toolkits, X}{26}
+\entry {torture tests}{4}
+\entry {translation file for \TeX {}, specifying}{9}
+\entry {translation from WEB to C}{1}
+\entry {\code {trap \r {Make target}}}{4}
+\entry {trap test}{4}
+\entry {\code {trapman.tex}}{4}
+\entry {\code {trchars.adj}}{34}
+\entry {Trickey, Howard}{1}
+\entry {\code {trip \r {Make target}}}{4}
+\entry {trip test}{4}
+\entry {\code {tripman.tex}}{4}
+\entry {\code {triptrap \r {Make target}}}{4}
+\entry {\code {TROFF}}{33}
+\entry {Troff, and MetaPost}{31}
+\entry {Troff, WEB for}{39}
+\entry {Trojan horses and \TeX {} programs}{14}
+\entry {TUGboat bibliography}{37}
+\entry {Type 1 conversion}{54}
+\entry {type design, personal}{25}
+\entry {type programs, DVI}{42}
+\entry {type programs, GF}{49}
+\entry {type programs, PK}{47}
+\entry {type programs, pool}{40}
+\entry {typeface families}{23}
+\entry {typeface specimen sheets}{54}
+\entry {typesetting}{14}
+\initial {U}
+\entry {Unicode}{21}
+\entry {Unicode input}{15}
+\entry {\code {uniterm}}{26}
+\entry {\code {unsrt.bst}}{38}
+\entry {using local codepage to display messages}{9}
+\entry {UTF-8 input}{15}
+\initial {V}
+\entry {validation, of DVI files}{42}
+\entry {validation, of GF files}{49}
+\entry {validation, of PK files}{47}
+\entry {validation, of TFM files}{51}
+\entry {validation, of VF files}{53}
+\entry {\code {verbatimtex \r {MetaPost command}}}{35}
+\entry {verbose Bib\TeX {} output, suppressing}{37}
+\entry {verbosity, enabling}{7}
+\entry {version number, finding}{7}
+\entry {vertical escapement}{50}
+\entry {VF files, converting property lists to}{54}
+\entry {\code {vftovp}}{53}
+\entry {virgin programs}{10}
+\entry {virtual font creation}{54}
+\entry {virtual fonts, expanding}{42}
+\entry {\code {virtual-fonts.knuth}}{46}
+\entry {\code {virtualfonts.txt}}{46}
+\entry {\code {vptovf}}{54}
+\initial {W}
+\entry {\code {weave}}{40}
+\entry {WEB}{39}
+\entry {WEB pool files, displaying}{40}
+\entry {WEB programs, compiling}{39}
+\entry {WEB programs, typesetting}{40}
+\entry {\code {WEB2C\r {, search path for TCX files}}}{20}
+\entry {Weber, Olaf}{1}
+\entry {\code {webmac.tex}}{40}
+\entry {\code {webman.tex}}{39}
+\entry {whitespace, in TCX files}{20}
+\entry {whitespace-terminated filenames}{12}
+\entry {width, device-independent}{48, 50}
+\entry {width, in pixels}{48}
+\entry {word processor, not}{14}
+\entry {writing memory dumps}{10}
+\initial {X}
+\entry {X bitmap fonts}{54}
+\entry {X class name for Metafont}{26}
+\entry {x offset}{48}
+\entry {X resources}{26}
+\entry {X toolkits and Metafont}{26}
+\entry {\code {x X \r {ditroff device control}}}{34}
+\entry {\code {xampl.bib}}{37}
+\entry {\code {xbfe\r {, bitmap font editor}}}{54}
+\entry {\code {xfed\r {, bitmap font editor}}}{54}
+\entry {\code {xfedor\r {, bitmap font editor}}}{54}
+\entry {\code {Xlib}}{26}
+\entry {Xlib support}{26}
+\entry {\code {Xt}}{26}
+\entry {Xt support}{26}
+\entry {\code {xterm}}{26}
+\initial {Y}
+\entry {y offset}{48}
diff --git a/Build/source/texk/web2c/doc/web2c.info b/Build/source/texk/web2c/doc/web2c.info
new file mode 100644
index 00000000000..2742d1abb9d
--- /dev/null
+++ b/Build/source/texk/web2c/doc/web2c.info
@@ -0,0 +1,4739 @@
+This is web2c.info, produced by makeinfo version 4.8 from web2c.texi.
+
+INFO-DIR-SECTION TeX
+START-INFO-DIR-ENTRY
+* Web2c: (web2c). TeX, Metafont, and companion programs.
+* bibtex: (web2c)bibtex invocation. Maintaining bibliographies.
+* dmp: (web2c)dmp invocation. Troff->MPX (MetaPost pictures).
+* dvicopy: (web2c)dvicopy invocation. Virtual font expansion
+* dvitomp: (web2c)dvitomp invocation. DVI to MPX (MetaPost pictures).
+* dvitype: (web2c)dvitype invocation. DVI to human-readable text.
+* gftodvi: (web2c)gftodvi invocation. Generic font proofsheets.
+* gftopk: (web2c)gftopk invocation. Generic to packed fonts.
+* gftype: (web2c)gftype invocation. GF to human-readable text.
+* makempx: (web2c)makempx invocation. MetaPost label typesetting.
+* mf: (web2c)mf invocation. Creating typeface families.
+* mft: (web2c)mft invocation. Prettyprinting Metafont source.
+* mltex: (web2c)MLTeX. Multi-lingual TeX.
+* mpost: (web2c)mpost invocation. Creating technical diagrams.
+* mpto: (web2c)mpto invocation. MetaPost label extraction.
+* newer: (web2c)newer invocation. Compare modification times.
+* patgen: (web2c)patgen invocation. Creating hyphenation patterns.
+* pktogf: (web2c)pktogf invocation. Packed to generic fonts.
+* pktype: (web2c)pktype invocation. PK to human-readable text.
+* pltotf: (web2c)pltotf invocation. Property list to TFM.
+* pooltype: (web2c)pooltype invocation. Display WEB pool files.
+* tangle: (web2c)tangle invocation. WEB to Pascal.
+* tex: (web2c)tex invocation. Typesetting.
+* tftopl: (web2c)tftopl invocation. TFM -> property list.
+* vftovp: (web2c)vftovp invocation. Virtual font -> virtual pl.
+* vptovf: (web2c)vptovf invocation. Virtual pl -> virtual font.
+* weave: (web2c)weave invocation. WEB to TeX.
+END-INFO-DIR-ENTRY
+
+ This file documents the installation and use of the programs in
+Web2c, an implementation of Donald Knuth's TeX system.
+
+ Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+Karl Berry & Olaf Weber.
+
+ Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+ Permission is granted to copy and distribute modified versions of
+this manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+ Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation
+
+
+File: web2c.info, Node: Top, Next: Introduction, Up: (dir)
+
+Web2c
+*****
+
+This document describes how to install and use the programs in the Web2c
+implementation of the TeX system, especially for Unix systems. It
+corresponds to Web2c version 7.5.5, released in June 2005.
+
+* Menu:
+
+* Introduction:: A brief introduction.
+* Installation:: How to compile and install Web2c.
+* Commonalities:: Option syntax, standard options, memory dumps.
+* TeX:: Typesetting.
+* Metafont:: Typeface design.
+* MetaPost:: Technical illustrations.
+* BibTeX:: Reusable bibliographies.
+* WEB:: Literate programming.
+* DVI utilities:: DVI expansion.
+* Font utilities:: Font format conversion.
+* Legalisms:: Blah blah blah.
+* References:: Books and such.
+* Index:: General index.
+
+
+File: web2c.info, Node: Introduction, Next: Installation, Prev: Top, Up: Top
+
+1 Introduction
+**************
+
+This manual corresponds to version 7.5.5 of Web2c, released in
+June 2005.
+
+ "Web2c" is the name of a TeX implementation, originally for Unix,
+but now also running under DOS, Amiga, and other operating systems. By
+"TeX implementation", we mean all of the standard programs developed by
+the Stanford TeX project directed by Donald E. Knuth: Metafont,
+DVItype, GFtoDVI, BibTeX, Tangle, etc., as well as TeX itself. Other
+programs are also included: DVIcopy, written by Peter Breitenlohner,
+MetaPost and its utilities (derived from Metafont), by John Hobby, etc.
+
+ General strategy: Web2c works, as its name implies, by translating
+the WEB source in which TeX is written into C source code. Its output is
+not self-contained, however; it makes extensive use of many macros and
+functions in a library (the `web2c/lib' directory in the sources).
+Therefore, it will not work without change on an arbitrary WEB program.
+
+ Availability: All of Web2c is freely available--"free" both in the
+sense of no cost (free ice cream) and of having the source code to
+modify and/or redistribute (free speech). *Note unixtex.ftp:
+(kpathsea)unixtex.ftp, for the practical details of how to obtain Web2c.
+
+ Different parts of the Web2c distribution have different licensing
+terms, however, reflecting the different circumstances of their
+creation; consult each source file for exact details. The main
+practical implication for redistributors of Web2c is that the
+executables are covered by the GNU General Public License, and
+therefore anyone who gets a binary distribution must also get the
+sources, as explained by the terms of the GPL (*note Copying:
+(kpathsea)Copying.). The GPL covers the Web2c executables, including
+`tex', because the Free Software Foundation sponsored the initial
+development of the Kpathsea library that Web2c uses. The basic source
+files from Stanford, however, have their own copyright terms or are in
+the public domain, and are not covered by the GPL.
+
+ History: Tomas Rokicki originated the TeX-to-C system in 1987,
+working from the first change files for TeX under Unix, which were done
+primarily by Howard Trickey and Pavel Curtis. Tim Morgan then took over
+development and maintenance for a number of years; the name changed to
+Web-to-C somewhere in there. In 1990, Karl Berry became the
+maintainer. He made many changes to the original sources, and started
+using the shorter name Web2c. In 1997, Olaf Weber took over. Dozens of
+other people have contributed; their names are listed in the
+`ChangeLog' files.
+
+ Other acknowledgements: The University of Massachusetts at Boston
+(particularly Rick Martin and Bob Morris) has provided computers and ftp
+access to me for many years. Richard Stallman at the Free Software
+Foundation employed me while I wrote the original path searching library
+(for the GNU font utilities). (rms also gave us Emacs, GDB, and GCC,
+without which I cannot imagine developing Web2c.) And, of course, TeX
+would not exist in the first place without Donald E. Knuth.
+
+ Further reading: *Note References::.
+
+
+File: web2c.info, Node: Installation, Next: Commonalities, Prev: Introduction, Up: Top
+
+2 Installation
+**************
+
+(A copy of this chapter is in the distribution file `web2c/INSTALL'.)
+
+Installing Web2c is mostly the same as installing any other
+Kpathsea-using program. Therefore, for the basic steps involved, see
+*Note Installation: (kpathsea)Installation. (A copy is in the file
+`kpathsea/INSTALL'.)
+
+ One peculiarity to Web2c is that the source distribution comes in two
+files: `web.tar.gz' and `web2c.tar.gz'. You must retrieve and unpack
+them both. (We have two because the former archive contains the very
+large and seldom-changing original WEB source files.) *Note
+unixtex.ftp: (kpathsea)unixtex.ftp.
+
+ Another peculiarity is the MetaPost program. Although it has been
+installed previously as `mp', as of Web2c 7.0 the installed name is now
+`mpost', to avoid conflict with the `mp' program that does
+prettyprinting. This approach was recommended by the MetaPost author,
+John Hobby. If you as the TeX administrator wish to make it available
+under its shorter name as well, you will have to set up a link or some
+such yourself. And of course individual users can do the same.
+
+ For solutions to common installation problems and information on how
+to report a bug, see the file `kpathsea/BUGS' (*note Bugs:
+(kpathsea)Bugs.). See also the Web2c home page,
+`http://www.tug.org/web2c'.
+
+ Points worth repeating:
+
+ * Before starting the standard compilation and installation you must
+ install the basic fonts, macros, and other library files. *Note
+ Installation: (kpathsea)Installation.
+
+ * If you do not wish to use the standard file locations, see *Note
+ Changing search paths: (kpathsea)Changing search paths.
+
+ * Some Web2c features are enabled or disabled at `configure' time,
+ as described in the first section below.
+
+
+* Menu:
+
+* configure options:: Especially --with and --enable.
+* Compile-time options:: Unusual -D's.
+* Additional targets:: Breaking down the task.
+* Triptrap:: Running the torture tests.
+* Runtime options:: Array sizes and the like.
+
+
+File: web2c.info, Node: configure options, Next: Compile-time options, Up: Installation
+
+2.1 `configure' options
+=======================
+
+This section gives pointers to descriptions of the `--with' and
+`--enable' `configure' arguments that Web2c accepts. Some are specific
+to Web2c, others are generic to all Kpathsea-using programs.
+
+ For a list of all the options `configure' accepts, run `configure
+--help'. The generic options are listed first, and the
+package-specific options come last.
+
+ For a description of the generic options (which mainly allow you to
+specify installation directories) and basic `configure' usage, see
+*Note Running `configure' scripts: (autoconf)Invoking configure, a copy
+is in the file `kpathsea/CONFIGURE'.
+
+`--disable-dump-share'
+ Do not make fmt/base/mem files sharable across different endian
+ architectures. *Note Hardware and memory dumps::.
+
+`--without-maketexmf-default'
+`--without-maketexpk-default'
+`--without-maketextfm-default'
+`--with-maketextex-default'
+ Enable or disable the dynamic generation programs. *Note mktex
+ configuration: (kpathsea)mktex configuration. The defaults are
+ the inverse of the options, i.e., everything is enabled except
+ `mktextex'.
+
+`--enable-shared'
+ Build Kpathsea as a shared library. *Note Shared library:
+ (kpathsea)Shared library.
+
+`--with-editor=CMD'
+ Change the default editor invoked by the `e' interactive command.
+ *Note Editor invocation::.
+
+`--with-epsfwin'
+`--with-hp2627win'
+`--with-mftalkwin'
+`--with-nextwin'
+`--with-regiswin'
+`--with-suntoolswin'
+`--with-tektronixwin'
+`--with-unitermwin'
+`--with-x'
+`--with-x-toolkit=KIT'
+`--with-x11win'
+`--with-x11'
+ Define Metafont graphics support; by default, no graphics support
+ is enabled. *Note Online Metafont graphics::.
+
+`--x-includes=DIR'
+`--x-libraries=DIR'
+ Define the locations of the X11 include files and libraries; by
+ default, `configure' does its best to guess). *Note Optional
+ Features: (autoconf)Optional Features. A copy is in
+ `kpathsea/CONFIGURE'.
+
+
+File: web2c.info, Node: Compile-time options, Next: Additional targets, Prev: configure options, Up: Installation
+
+2.2 Compile-time options
+========================
+
+In addition to the `configure' options listed in the previous section,
+there are a few things that can be affected at compile-time with C
+definitions, rather than with `configure'. Using any of these is
+unusual.
+
+ To specify extra compiler flags (`-DNAME' in this case), the
+simplest thing to do is:
+ make XCFLAGS="CCOPTIONS"
+ You can also set the `CFLAGS' environment variable before running
+`configure'. *Note configure environment: (kpathsea)configure
+environment.
+
+ Anyway, here are the possibilities:
+
+`-DFIXPT'
+`-DNO_MF_ASM'
+ Use the original WEB fixed-point routines for Metafont and MetaPost
+ arithmetic calculations regarding fractions. By default,
+ assembly-language routines are used on x86 hardware with GNU C
+ (unless `NO_MF_ASM' is defined), and floating-point routines are
+ used otherwise.
+
+`-DIPC_DEBUG'
+ Report on various interprocess communication activities. *Note
+ IPC and TeX: IPC and TeX.
+
+
+File: web2c.info, Node: Additional targets, Next: Triptrap, Prev: Compile-time options, Up: Installation
+
+2.3 Additional targets
+======================
+
+Web2c has several Make targets besides the standard ones. You can
+invoke these either in the top level directory of the source
+distribution (the one containing `kpathsea/' and `web2c/'), or in the
+`web2c/' directory.
+
+`c-sources'
+ Make only the C files, translated from the Web sources, presumably
+ because you want to take them to a non-Unix machine.
+
+`formats'
+`install-formats'
+ Make or install all the memory dumps (*note Memory dumps::). By
+ default, the standard plain formats plus `latex.fmt' are made. You
+ can add other formats by redefining the `fmts', `bases', and
+ `mems' variables. See the top of `web2c/Makefile' for the
+ possibilities.
+
+`fmts'
+`install-fmts'
+ Make or install the TeX `.fmt' files. *Note Initial TeX::.
+
+`bases'
+`install-bases'
+ Make or install the Metafont `.base' files. *Note Initial
+ Metafont::.
+
+`mems'
+`install-mems'
+ Make or install the MetaPost `.mem' files. *Note Initial
+ MetaPost::.
+
+`triptrap'
+`trip'
+`trap'
+`mptrap'
+ To run the torture tests for TeX, Metafont, and MetaPost
+ (respectively). See the next section.
+
+
+
+File: web2c.info, Node: Triptrap, Next: Runtime options, Prev: Additional targets, Up: Installation
+
+2.4 Trip, trap, and mptrap: Torture tests
+=========================================
+
+To validate your TeX, Metafont, and MetaPost executables, run `make
+triptrap'. This runs the trip, trap, and mptrap "torture tests". See
+the files `triptrap/tripman.tex', `triptrap/trapman.tex', and
+`triptrap/mptrap.readme' for detailed information and background on the
+tests.
+
+ The differences between your executables' behavior and the standard
+values will show up on your terminal. The usual differences (these are
+all acceptable) are:
+
+ * string usage and table sizes;
+
+ * glue set ratios;
+
+ * `down4', `right4', and `y4' commands in DVItype output;
+
+ * dates and times.
+
+Any other differences are trouble. The most common culprit in the past
+has been compiler bugs, especially when optimizing. *Note TeX or
+Metafont failing: (kpathsea)TeX or Metafont failing.
+
+ The files `trip.diffs', `mftrap.diffs', and `mptrap.diffs' in the
+`triptrap' directory show the standard diffs against the original
+output. If you diff your diffs against these files, you should come up
+clean. For example
+ make trip >&mytrip.diffs
+ diff triptrap/trip.diffs mytrip.diffs
+
+ To run the tests separately, use the targets `trip', `trap', and
+`mptrap'.
+
+ To run simple tests for all the programs as well as the torture
+tests, run `make check'. You can compare the output to the distributed
+file `tests/check.log' if you like.
+
+
+File: web2c.info, Node: Runtime options, Prev: Triptrap, Up: Installation
+
+2.5 Runtime options
+===================
+
+Besides the configure- and compile-time options described in the
+previous sections, you can control a number of parameters (in
+particular, array sizes) in the `texmf.cnf' runtime file read by
+Kpathsea (*note Config files: (kpathsea)Config files.).
+
+ Rather than exhaustively listing them here, please see the last
+section of the distributed `kpathsea/texmf.cnf'. Some of the more
+interesting values:
+
+`main_memory'
+ Total words of memory available, for TeX, Metafont, and MetaPost.
+ Must remake the format file after changing.
+
+`extra_mem_bot'
+ Extra space for "large" TeX data structures: boxes, glue,
+ breakpoints, et al. If you use PiCTeX, you may well want to set
+ this.
+
+`font_mem_size'
+ Words of font info available for TeX; this is approximately the
+ total size of all TFM files read.
+
+`hash_extra'
+ Additional space for the hash table of control sequence names.
+ Approximately 10,000 control sequences can be stored in the main
+ hash table; if you have a large book with numerous
+ cross-references, this might not be enough, and thus you will want
+ to set `hash_extra'.
+
+
+ Of course, ideally all arrays would be dynamically expanded as
+necessary, so the only limiting factor would be the amount of swap space
+available. Unfortunately, implementing this is extremely difficult, as
+the fixed size of arrays is assumed in many places throughout the source
+code. These runtime limits are a practical compromise between the
+compile-time limits in previous versions, and truly dynamic arrays. (On
+the other hand, the Web2c BibTeX implementation does do dynamic
+reallocation of some arrays.)
+
+
+File: web2c.info, Node: Commonalities, Next: TeX, Prev: Installation, Up: Top
+
+3 Commonalities
+***************
+
+Many aspects of the TeX system are the same among more than one
+program, so we describe all those pieces together, here.
+
+* Menu:
+
+* Option conventions:: -- or -, = or ` ' for values.
+* Common options:: --help --version --verbose, and TeX/MF/MP options.
+* Path searching:: Features of the common path searching library.
+* Output file location:: TEXMFOUTPUT allows output in places other than `.'.
+* Three programs:: TeX, Metafont, and MetaPost have a lot in common.
+
+
+File: web2c.info, Node: Option conventions, Next: Common options, Up: Commonalities
+
+3.1 Option conventions
+======================
+
+To provide a clean and consistent behavior, we chose to have all these
+programs use the GNU function `getopt_long_only' to parse command
+lines. However, we do use in a restricted mode, where all the options
+have to come before the rest of the arguments.
+
+ As a result, you can:
+ * use `-' or `--' to start an option name;
+
+ * use any unambiguous abbreviation for an option name;
+
+ * separate option names and values with either `=' or one or more
+ spaces;
+
+ * use filenames that would otherwise look like options by putting
+ them after an option `--'.
+
+ By convention, non-option arguments, if specified, generally define
+the name of an input file, as documented for each program.
+
+ If a particular option with a value is given more than once, it is
+the last value that counts.
+
+ For example, the following command line specifies the options `foo',
+`bar', and `verbose'; gives the value `baz' to the `abc' option, and
+the value `xyz' to the `quux' option; and specifies the filename
+`-myfile-'.
+
+ -foo --bar -verb -abc=baz -quux karl --quux xyz -- -myfile-
+
+
+File: web2c.info, Node: Common options, Next: Path searching, Prev: Option conventions, Up: Commonalities
+
+3.2 Common options
+==================
+
+All of these programs accept the standard GNU `--help' and `--version'
+options, and several programs accept `--verbose'. Rather than writing
+identical descriptions for every program, they are described here.
+
+`--help'
+ Print a usage message listing basic usage and all available
+ options to standard output, then exit successfully.
+
+`--verbose'
+ Print progress reports to standard output.
+
+`--version'
+ Print the version number to standard output, then exit
+ successfully.
+
+ TeX, Metafont, and MetaPost have a number of additional options in
+common:
+
+`-file-line-error'
+`-no-file-line-error'
+ Change (or do not change) the way error messages are printed. The
+ alternate style looks like error messages from many compilers and
+ is easier to parse for some editors that invoke TeX. This option
+ used to be called `-file-line-error-style'.
+
+`-fmt=DUMPNAME'
+`-base=DUMPNAME'
+`-mem=DUMPNAME'
+ Use DUMPNAME instead of the program name or a `%&' line to
+ determine the name of the memory dump file read (`fmt' for TeX,
+ `base' for Metafont, `mem' for MetaPost). *Note Memory dumps::.
+ Also sets the program name to DUMPNAME if no `-progname' option
+ was given.
+
+`-halt-on-error'
+ Stop processing and exit when an error occurs, as opposed to the
+ normal process of trying to recover and continue.
+
+`-ini'
+ Enable the "initial" form of the program (*note Initial and
+ virgin::). This is implicitly set if the program name is `initex'
+ resp. `inimf' resp. `inimpost', although these variants are no
+ longer typically installed.
+
+`-interaction=STRING'
+ Set the interaction mode from the command line. The STRING must
+ be one of `batchmode', `nonstopmode', `scrollmode', or
+ `errorstopmode'.
+
+`-jobname=STRING'
+ Set the job name to STRING, instead of deriving it from the name
+ of the input file.
+
+`-kpathsea-debug=NUMBER'
+ Set path searching debugging flags according to the bits of NUMBER
+ (*note Debugging: (kpathsea)Debugging.). You can also specify
+ this in `KPATHSEA_DEBUG' environment variable (for all Web2c
+ programs). (The command line value overrides.) The most useful
+ value is `-1', to get all available output.
+
+`-output-directory=DIRNAME'
+ Specify the directory DIRNAME to which output files are written.
+ Also look for input files in DIRNAME first, before looking along
+ the normal search path. This is useful when you are in some
+ read-only distribution directory, perhaps on a CD-ROM, and want to
+ TeX some documentation, for example. Note that for input files
+ the "search" in DIRNAME does not use the full generality of the
+ search mechanism. This means that some files are not found there
+ even though you might expect them to be.
+
+`-parse-first-line'
+`-no-parse-first-line'
+ Check or disable checking whether the first line of the main input
+ file starts with `%&', and parse it if it does. This line can be
+ used specify the format and/or a TCX file.
+
+`-progname=STRING'
+ Set program (and memory dump) name to STRING. This may affect the
+ search paths and other values used (*note Config files:
+ (kpathsea)Config files.). Using this option is equivalent to
+ making a link named STRING to the binary and then invoking the
+ binary under that name. *Note Memory dumps::.
+
+`-recorder'
+ Enable the filename recorder. This makes the program save a list
+ of the opened files into a file with (by default) extension
+ `.fls'. For Omega, this option is always on, and the file has
+ extension `.ofl'.
+
+`-translate-file=TCXFILE'
+ Use TCXFILE to define which characters are printable and
+ translations between the internal and external character sets.
+ Moreover, TCXFILE can be explicitly declared in the first line of
+ the main input file `%& -translate-file=TCXFILE'. This is the
+ recommended method for portability reasons. *Note TCX files::.
+
+`-8bit'
+ This option specifies that by default all characters should be
+ considered printable. If `-translate-file' was given as well,
+ then the TCX file may mark characters as non-printable.
+
+`-oem'
+ This option is specific to Windows. When specified, TeX engines
+ will use the OEM code page rather than the ANSI one to display
+ their messages.
+
+
+
+File: web2c.info, Node: Path searching, Next: Output file location, Prev: Common options, Up: Commonalities
+
+3.3 Path searching
+==================
+
+All of the Web2c programs, including TeX, which do path searching use
+the Kpathsea routines to do so. The precise names of the environment
+and configuration file variables which get searched for particular file
+formatted are therefore documented in the Kpathsea manual (*note
+Supported file formats: (kpathsea)Supported file formats.). Reading
+`texmf.cnf' (*note Config files: (kpathsea)Config files.), invoking
+`mktex...' scripts (*note mktex scripts: (kpathsea)mktex scripts.), and
+so on are all handled by Kpathsea.
+
+ The programs which read fonts make use of another Kpathsea feature:
+`texfonts.map', which allows arbitrary aliases for the actual names of
+font files; for example, `Times-Roman' for `ptmr8r.tfm'. The
+distributed (and installed by default) `texfonts.map' includes aliases
+for many widely available PostScript fonts by their PostScript names.
+
+
+File: web2c.info, Node: Output file location, Next: Three programs, Prev: Path searching, Up: Commonalities
+
+3.4 Output file location
+========================
+
+All the programs generally follow the usual convention for output files.
+Namely, they are placed in the directory current when the program is
+run, regardless of any input file location; or, in a few cases, output
+is to standard output.
+
+ For example, if you run `tex /tmp/foo', for example, the output will
+be in `./foo.dvi' and `./foo.log', not `/tmp/foo.dvi' and
+`/tmp/foo.log'.
+
+ You can use the `-output-directory' option to cause all output files
+that would normally be written in the current directory to be written
+in the specified directory instead. *Note Common options::.
+
+ If the current directory is not writable, and `-output-directory' is
+not specified, the main programs (TeX, Metafont, MetaPost, and BibTeX)
+make an exception: if the config file value `TEXMFOUTPUT' is set (it is
+not by default), output files are written to the directory specified.
+
+
+File: web2c.info, Node: Three programs, Prev: Output file location, Up: Commonalities
+
+3.5 Three programs: Metafont, MetaPost, and TeX
+===============================================
+
+TeX, Metafont, and MetaPost have a number of features in common.
+Besides the ones here, the common command-line options are described in
+the previous section. The configuration file options that let you
+control some array sizes and other features are described in *Note
+Runtime options::.
+
+* Menu:
+
+* Initial and virgin:: Making memory dumps vs. production runs.
+* Memory dumps:: .fmt/.base/.mem files for fast startup.
+* Editor invocation:: The `e' response at errors.
+* \input filenames:: ~ and $ expansion in TeX/MF/MP.
+
+
+File: web2c.info, Node: Initial and virgin, Next: Memory dumps, Up: Three programs
+
+3.5.1 Initial and virgin
+------------------------
+
+The TeX, Metafont, and MetaPost programs each have two main variants,
+called "initial" and "virgin". As of Web2c 7, one executable suffices
+for both variants, and in fact, the `ini...' executables are no longer
+created.
+
+ The initial form is enabled if:
+ 1. the `-ini' option was specified; or
+
+ 2. the program name is `initex' resp. `inimf' resp. `inimpost'
+ (these variants are no longer typically installed); or
+
+ 3. the first line of the main input file is `%&ini';
+ otherwise, the virgin form is used.
+
+ The "virgin" form is the one generally invoked for production use.
+The first thing it does is read a memory dump (*note Determining the
+memory dump to use::), and then proceeds on with the main job.
+
+ The "initial" form is generally used only to create memory dumps
+(see the next section). It starts up more slowly than the virgin form,
+because it must do lengthy initializations that are encapsulated in the
+memory dump file.
+
+
+File: web2c.info, Node: Memory dumps, Next: Editor invocation, Prev: Initial and virgin, Up: Three programs
+
+3.5.2 Memory dumps
+------------------
+
+In typical use, TeX, Metafont, and MetaPost require a large number of
+macros to be predefined; therefore, they support "memory dump" files,
+which can be read much more efficiently than ordinary source code.
+
+* Menu:
+
+* Creating memory dumps::
+* Determining the memory dump to use::
+* Hardware and memory dumps::
+
+
+File: web2c.info, Node: Creating memory dumps, Next: Determining the memory dump to use, Up: Memory dumps
+
+3.5.2.1 Creating memory dumps
+.............................
+
+The programs all create memory dumps in slightly idiosyncratic (thought
+substantially similar) way, so we describe the details in separate
+sections (references below). The basic idea is to run the initial
+version of the program (*note Initial and virgin::), read the source
+file to define the macros, and then execute the `\dump' primitive.
+
+ Also, each program uses a different filename extension for its memory
+dumps, since although they are completely analogous they are not
+interchangeable (TeX cannot read a Metafont memory dump, for example).
+
+ Here is a list of filename extensions with references to examples of
+creating memory dumps:
+
+TeX
+ (`.fmt') *Note Initial TeX: Initial TeX.
+
+Metafont
+ (`.base') *Note Initial Metafont::.
+
+MetaPost
+ (`.mem') *Note Initial MetaPost::.
+
+ When making memory dumps, the programs read environment variables and
+configuration files for path searching and other values as usual. If
+you are making a new installation and have environment variables
+pointing to an old one, for example, you will probably run into
+difficulties.
+
+
+File: web2c.info, Node: Determining the memory dump to use, Next: Hardware and memory dumps, Prev: Creating memory dumps, Up: Memory dumps
+
+3.5.2.2 Determining the memory dump to use
+..........................................
+
+The virgin form (*note Initial and virgin::) of each program always
+reads a memory dump before processing normal source input. All three
+programs determine the memory dump to use in the same way:
+
+ 1. If the first non-option command-line argument begins with `&', the
+ program uses the remainder of that argument as the memory dump
+ name. For example, running `tex \&super' reads `super.fmt'. (The
+ backslash protects the `&' against interpretation by the shell.)
+
+ 2. If the `-fmt' resp. `-base' resp. `-mem' option is specified, its
+ value is used.
+
+ 3. If the `-progname' option is specified, its value is used.
+
+ 4. If the first line of the main input file (which must be specified
+ on the command line, not in response to `**') is `%&DUMP', and
+ DUMP is an existing memory dump of the appropriate type, DUMP is
+ used.
+
+ The first line of the main input file can also specify which
+ character translation file is to be used:
+ `%&-translate-file=TCXFILE' (*note TCX files::).
+
+ These two roles can be combined: `%&DUMP -translate-file=TCXFILE'.
+ If this is done, the name of the dump must be given first.
+
+ 5. Otherwise, the program uses the program invocation name, most
+ commonly `tex' resp. `mf' resp. `mpost'. For example, if `latex'
+ is a link to `tex', and the user runs `latex foo', `latex.fmt'
+ will be used.
+
+
+
+File: web2c.info, Node: Hardware and memory dumps, Prev: Determining the memory dump to use, Up: Memory dumps
+
+3.5.2.3 Hardware and memory dumps
+.................................
+
+By default, memory dump files are generally sharable between
+architectures of different types; specifically, on machines of different
+endianness (*note Byte order: (libc)Byte order.). (This is a feature
+of the Web2c implementation, and is not true of all TeX
+implementations.) If you specify `--disable-dump-share' to
+`configure', however, memory dumps will be endian-dependent.
+
+ The reason to do this is speed. To achieve endian-independence, the
+reading of memory dumps on LittleEndian architectures, such as PC's and
+DEC architectures, is somewhat slowed (all the multibyte values have to
+be swapped). Usually, this is not noticeable, and the advantage of
+being able to share memory dumps across all platforms at a site far
+outweighs the speed loss. But if you're installing Web2c for use on
+LittleEndian machines only, perhaps on a PC being used only by you, you
+may wish to get maximum speed.
+
+ TeXnically, even without `--disable-dump-share', sharing of `.fmt'
+files cannot be guaranteed to work. Floating-point values are always
+written in native format, and hence will generally not be readable
+across platforms. Fortunately, TeX uses floating point only to
+represent glue ratios, and all common formats (plain, LaTeX, AMSTeX,
+...) do not do any glue setting at `.fmt'-creation time. Metafont and
+MetaPost do not use floating point in any dumped value at all.
+
+ Incidentally, different memory dump files will never compare equal
+byte-for-byte, because the program always dumps the current date and
+time. So don't be alarmed by just a few bytes difference.
+
+ If you don't know what endianness your machine is, and you're
+curious, here is a little C program to tell you. (The `configure' script
+contains a similar program.) This is from the book `C: A Reference
+Manual', by Samuel P. Harbison and Guy L. Steele Jr. (*note
+References::).
+
+ main ()
+ {
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long l;
+ char c[sizeof (long)];
+ } u;
+ u.l = 1;
+ if (u.c[0] == 1)
+ printf ("LittleEndian\n");
+ else if (u.c[sizeof (long) - 1] == 1)
+ printf ("BigEndian\n");
+ else
+ printf ("unknownEndian");
+
+ exit (u.c[sizeof (long) - 1] == 1);
+ }
+
+
+File: web2c.info, Node: Editor invocation, Next: \input filenames, Prev: Memory dumps, Up: Three programs
+
+3.5.3 Editor invocation
+-----------------------
+
+TeX, Metafont, and MetaPost all (by default) stop and ask for user
+intervention at an error. If the user responds with `e' or `E', the
+program invokes an editor.
+
+ Specifying `--with-editor=CMD' to `configure' sets the default
+editor command string to CMD. The environment variables/configuration
+values `TEXEDIT', `MFEDIT', and `MPEDIT' (respectively) override this.
+If `--with-editor' is not specified, the default is `vi +%d %s'.
+
+ In this string, `%d' is replaced by the line number of the error,
+and `%s' is replaced by the name of the current input file.
+
+
+File: web2c.info, Node: \input filenames, Prev: Editor invocation, Up: Three programs
+
+3.5.4 `\input' filenames
+------------------------
+
+TeX, Metafont, and MetaPost source programs can all read other source
+files with the `\input' (TeX) and `input' (MF and MP) primitives:
+ \input NAME % in TeX
+
+ The file NAME can always be terminated with whitespace; for Metafont
+and MetaPost, the statement terminator `;' also works. (LaTeX and
+other macro packages provide other interfaces to `\input' that allow
+different notation; here we are concerned only with the primitive
+operation.)
+
+ As of Web2c version 7.5.3, double-quote characters can be used to
+include spaces or other special cases. In typical use, the `"'
+characters surround the entire filename:
+ \input "filename with spaces"
+
+ Technically, the quote characters can be used inside the name, and
+can enclose any characters, as in:
+ \input filename" "with" "spaces
+
+ One more point. In LaTeX, the quotes are needed inside the braces,
+thus
+ \input{a b} % fails
+ \input{"a b"} % ok
+
+ This quoting mechanism comes into play _after_ TeX has tokenized and
+expanded the input. So, multiple spaces and tabs may be seen as a
+single space, active characters such as `~' are expanded first, and so
+on. (See below.)
+
+ On the other hand, various C library routines and Unix itself use
+the null byte (character code zero, ASCII NUL) to terminate strings. So
+filenames in Web2c cannot contain nulls, even though TeX itself does
+not treat NUL specially. In addition, some older Unix variants do not
+allow eight-bit characters (codes 128-255) in filenames.
+
+ For maximal portability of your document across systems, use only the
+characters `a'-`z', `0'-`9', and `.', and restrict your filenames to at
+most eight characters (not including the extension), and at most a
+three-character extension. Do not use anything but simple filenames,
+since directory separators vary among systems; instead, add the
+necessary directories to the appropriate search path.
+
+ Finally, the present Web2c implementation does `~' and `$' expansion
+on NAME, unlike Knuth's original implementation and older versions of
+Web2c. Thus:
+ \input ~jsmith/$foo.bar
+ will dereference the environment variable or Kpathsea config file
+value `foo' and read that file extended with `.bar' in user `jsmith''s
+home directory. You can also use braces, as in `${foo}bar', if you
+want to follow the variable name with a letter, numeral, or `_'.
+
+ (So another way to get a program to read a filename containing
+whitespace is to define an environment variable and dereference it.)
+
+ In all the common TeX formats (plain TeX, LaTeX, AMSTeX), the
+characters `~' and `$' have special category codes, so to actually use
+these in a document you have to change their catcodes or use `\string'.
+(The result is unportable anyway, see the suggestions above.) The
+place where they are most likely to be useful is when typing
+interactively.
+
+
+File: web2c.info, Node: TeX, Next: Metafont, Prev: Commonalities, Up: Top
+
+4 TeX: Typesetting
+******************
+
+TeX is a typesetting system: it was especially designed to handle
+complex mathematics, as well as most ordinary text typesetting.
+
+ TeX is a batch language, like C or Pascal, and not an interactive
+"word processor": you compile a TeX input file into a corresponding
+device-independent (DVI) file (and then translate the DVI file to the
+commands for a particular output device). This approach has both
+considerable disadvantages and considerable advantages. For a complete
+description of the TeX language, see `The TeXbook' (*note
+References::). Many other books on TeX, introductory and otherwise,
+are available.
+
+* Menu:
+
+* tex invocation:: Invoking TeX.
+* Initial TeX:: Making format files.
+* Formats:: Major TeX macro packages.
+* Languages and hyphenation:: TeX supports many human languages.
+* IPC and TeX:: DVI output to a socket.
+* TeX extensions:: Changes to the TeX language.
+
+
+File: web2c.info, Node: tex invocation, Next: Initial TeX, Up: TeX
+
+4.1 `tex' invocation
+====================
+
+TeX (usually invoked as `tex') formats the given text and commands, and
+outputs a corresponding device-independent representation of the
+typeset document. This section merely describes the options available
+in the Web2c implementation. For a complete description of the TeX
+typesetting language, see `The TeXbook' (*note References::).
+
+ TeX, Metafont, and MetaPost process the command line (described
+here) and determine their memory dump (fmt) file in the same way (*note
+Memory dumps::). Synopses:
+
+ tex [OPTION]... [TEXNAME[.tex]] [TEX-COMMANDS]
+ tex [OPTION]... \FIRST-LINE
+ tex [OPTION]... &FMT ARGS
+
+ TeX searches the usual places for the main input file TEXNAME (*note
+Supported file formats: (kpathsea)Supported file formats.), extending
+TEXNAME with `.tex' if necessary. To see all the relevant paths, set
+the environment variable `KPATHSEA_DEBUG' to `-1' before running the
+program.
+
+ After TEXNAME is read, TeX processes any remaining TEX-COMMANDS on
+the command line as regular TeX input. Also, if the first non-option
+argument begins with a TeX escape character (usually `\'), TeX
+processes all non-option command-line arguments as a line of regular
+TeX input.
+
+ If no arguments or options are specified, TeX prompts for an input
+file name with `**'.
+
+ TeX writes the main DVI output to the file `BASETEXNAME.dvi', where
+BASETEXNAME is the basename of TEXNAME, or `texput' if no input file
+was specified. A DVI file is a device-independent binary
+representation of your TeX document. The idea is that after running
+TeX, you translate the DVI file using a separate program to the
+commands for a particular output device, such as a PostScript printer
+(*note Introduction: (dvips)Top.) or an X Window System display (see
+xdvi(1)).
+
+ TeX also reads TFM files for any fonts you load in your document with
+the `\font' primitive. By default, it runs an external program named
+`mktextfm' to create any nonexistent TFM files. You can disable this
+at configure-time or runtime (*note mktex configuration:
+(kpathsea)mktex configuration.). This is enabled mostly for the sake
+of the EC fonts, which can be generated at any size.
+
+ TeX can write output files, via the `\openout' primitive; this opens
+a security hole vulnerable to Trojan horse attack: an unwitting user
+could run a TeX program that overwrites, say, `~/.rhosts'. (MetaPost
+has a `write' primitive with similar implications). To alleviate this,
+there is a configuration variable `openout_any', which selects one of
+three levels of security. When it is set to `a' (for "any"), no
+restrictions are imposed. When it is set to `r' (for "restricted"),
+filenames beginning with `.' are disallowed (except `.tex' because
+LaTeX needs it). When it is set to `p' (for "paranoid") additional
+restrictions are imposed: an absolute filename must refer to a file in
+(a subdirectory) of `TEXMFOUTPUT', and any attempt to go up a directory
+level is forbidden (that is, paths may not contain a `..' component).
+The paranoid setting is the default. (For backwards compatibility, `y'
+and `1' are synonyms of `a', while `n' and `0' are synonyms for `r'.)
+
+ In any case, all `\openout' filenames are recorded in the log file,
+except those opened on the first line of input, which is processed when
+the log file has not yet been opened. (If you as a TeX administrator
+wish to implement more stringent rules on `\openout', modifying the
+function `openoutnameok' in `web2c/lib/texmfmp.c' is intended to
+suffice.)
+
+ The program accepts the following options, as well as the standard
+`-help' and `-version' (*note Common options::):
+`-enc'
+`-[no]-file-line-error'
+`-fmt=FMTNAME'
+`-halt-on-error'
+`-ini'
+`-interaction=STRING'
+`-ipc'
+`-ipc-start'
+`-jobname=STRING'
+`-kpathsea-debug=NUMBER'
+`-[no]parse-first-line'
+`-output-directory'
+`-progname=STRING'
+`-recorder'
+`-translate-file=TCXFILE'
+`-8bit'
+ These options are common to TeX, Metafont, and MetaPost. *Note
+ Common options::.
+
+`-enc'
+ Enable encTeX extensions, such as `\mubyte'. This can be used to
+ support Unicode UTF-8 input encoding. See
+ `http://www.olsak.net/enctex.html'.
+
+`-ipc'
+`-ipc-start'
+ With either option, TeX writes its DVI output to a socket as well
+ as to the usual `.dvi' file. With `-ipc-start', TeX also opens a
+ server program at the other end to read the output. *Note IPC and
+ TeX: IPC and TeX.
+
+ These options are available only if the `--enable-ipc' option was
+ specified to `configure' during installation of Web2c.
+
+`-mktex=FILETYPE'
+`-no-mktex=FILETYPE'
+ Turn on or off the `mktex' script associated with FILETYPE. The
+ only values that make sense for FILETYPE are `tex' and `tfm'.
+
+`-mltex'
+ If we are `INITEX' (*note Initial and virgin::), enable MLTeX
+ extensions such as `\charsubdef'. Implicitly set if the program
+ name is `mltex'. *Note MLTeX: MLTeX.
+
+`-output-comment=STRING'
+ Use STRING as the DVI file comment. Ordinarily, this comment
+ records the date and time of the TeX run, but if you are doing
+ regression testing, you may not want the DVI file to have this
+ spurious difference. This is also taken from the environment
+ variable and config file value `output_comment'.
+
+`-shell-escape'
+`-no-shell-escape'
+ Enable (or disable) the `\write18{SHELL-COMMAND}' feature. This
+ is also enabled if the environment variable or config file value
+ `shell_escape' is set to `t' (but the `-no-shell-escape' command
+ line option overrides this). (For backwards compatibility, `y'
+ and `1' are accepted as synonyms of `t'). It is disabled by
+ default to avoid security problems. When enabled, the
+ SHELL-COMMAND string (which first undergoes the usual TeX
+ expansions, just as in `\special') is passed to the command shell
+ (via the C library function `system'). The output of
+ SHELL-COMMAND is not diverted anywhere, so it will not appear in
+ the log file. The system call either happens at `\output' time or
+ right away, according to the absence or presence of the
+ `\immediate' prefix, as usual for `\write'. (If you as a TeX
+ administrator wish to implement more stringent rules on what can
+ be executed, you will need to modify `tex.ch'.)
+
+`-src-specials'
+`-src-specials=STRING'
+ This option makes TeX output specific source information using
+ `\special' commands in the DVI file. These `\special' track the
+ current file name and line number.
+
+ Using the first form of this option, the `\special' commands are
+ inserted automatically.
+
+ In the second form of the option, STRING is a comma separated list
+ of the following values: `cr', `display', `hbox', `math', `par',
+ `parend', `vbox'. You can use this list to specify where you want
+ TeX to output such commands. For example, `-src-specials=cr,math'
+ will output source information every line and every math formula.
+
+ These commands can be used with the appropriate DVI viewer and
+ text editor to switch from the current position in the editor to
+ the same position in the viewer and back from the viewer to the
+ editor.
+
+ This option works by inserting `\special' commands into the token
+ stream, and thus in principle these additional tokens can be
+ recovered or seen by the tricky-enough macros. If you run across
+ a case, let us know, because this counts as a bug. However, such
+ bugs are very hard to fix, requiring significant changes to TeX,
+ so please don't count on it.
+
+ Redefining `\special' will not affect the functioning of this
+ option. The commands inserted into the token stream are
+ hard-coded to always use the `\special' primitive.
+
+ TeX does not pass the trip test when this option is enabled.
+
+
+
+File: web2c.info, Node: Initial TeX, Next: Formats, Prev: tex invocation, Up: TeX
+
+4.2 Initial TeX
+===============
+
+The "initial" form of TeX is invoked by `tex -ini'. It does lengthy
+initializations avoided by the "virgin" (`vir') form, so as to be
+capable of dumping `.fmt' files (*note Memory dumps::). For a detailed
+comparison of virgin and initial forms, *note Initial and virgin::. In
+past releases, a separate program `initex' was installed to invoke the
+initial form, but this is no longer the case.
+
+ For a list of options and other information, *note tex invocation::.
+
+ Unlike Metafont and MetaPost, many format files are commonly used
+with TeX. The standard one implementing the features described in the
+`TeXbook' is `plain.fmt', also known as `tex.fmt' (again, *note Memory
+dumps::). It is created by default during installation, but you can
+also do so by hand if necessary (e.g., if an update to `plain.tex' is
+issued):
+ tex -ini '\input plain \dump'
+ (The quotes prevent interpretation of the backslashes from the
+shell.) Then install the resulting `plain.fmt' in `$(fmtdir)'
+(`/usr/local/share/texmf/web2c' by default), and link `tex.fmt' to it.
+
+ The necessary invocation for generating a format file differs for
+each format, so instructions that come with the format should explain.
+The top-level `web2c' Makefile has targets for making most common
+formats: plain latex amstex texinfo eplain. *Note Formats::, for more
+details on TeX formats.
+
+
+File: web2c.info, Node: Formats, Next: Languages and hyphenation, Prev: Initial TeX, Up: TeX
+
+4.3 Formats
+===========
+
+TeX "formats" are large collections of macros, often dumped into a
+`.fmt' file (*note Memory dumps::) by `tex -ini' (*note Initial TeX::).
+A number of formats are in reasonably widespread use, and the Web2c
+Makefile has targets to make the versions current at the time of
+release. You can change which formats are automatically built by
+setting the `fmts' Make variable; by default, only the `plain' and
+`latex' formats are made.
+
+ You can get the latest versions of most of these formats from the
+CTAN archives in subdirectories of `CTAN:/macros' (for CTAN info, *note
+unixtex.ftp: (kpathsea)unixtex.ftp.). The archive
+`ftp://ftp.tug.org/tex/lib.tar.gz' (also available from CTAN) contains
+most of these formats (although perhaps not the absolute latest
+version), among other things.
+
+latex
+ The most widely used format. The current release is named `LaTeX
+ 2e'; new versions are released approximately every six months, with
+ patches issued as needed. The old release was called `LaTeX 2.09',
+ and is no longer maintained or supported. LaTeX attempts to
+ provide generic markup instructions, such as "emphasize", instead
+ of specific typesetting instructions, such as "use the 10pt
+ Computer Modern italic font". The LaTeX home page:
+ `http://www.latex-project.org'.
+
+context
+ ConTeXt is an independent macro package which has a basic document
+ structuring approach similar to LaTeX. It also supports creating
+ interactive PDF files and has integrated MetaPost support, among
+ many other interesting features. The ConTeXt home page:
+ `http://www.pragma-ade.com'.
+
+amstex
+ The official typesetting system of the American Mathematical
+ Society. Like LaTeX, it encourages generic markup commands. The
+ AMS also provides many LaTeX package for authors who prefer LaTeX.
+ Taken together, they are used to produce nearly all AMS
+ publications, e.g., `Mathematical Reviews'. The AMSTeX home page:
+ `http://www.ams.org/tex'.
+
+texinfo
+ The documentation system developed and maintained by the Free
+ Software Foundation for their software manuals. It can be
+ automatically converted into plain text, a machine-readable
+ on-line format called `info', HTML, etc. The Texinfo home page:
+ `http://www.gnu.org/software/texinfo'.
+
+eplain
+ The "expanded plain" format provides various common features (e.g.,
+ symbolic cross-referencing, tables of contents, indexing, citations
+ using BibTeX), for those authors who prefer to handle their own
+ high-level formatting. The Eplain home page:
+ `http://www.tug.org/eplain'.
+
+slitex
+ An obsolete LaTeX 2.09 format for making slides. It is replaced by
+ the `slides' document class, along with the `beamer', `texpower',
+ and other packages.
+
+
+
+File: web2c.info, Node: Languages and hyphenation, Next: IPC and TeX, Prev: Formats, Up: TeX
+
+4.4 Languages and hyphenation
+=============================
+
+TeX supports most natural languages. See also *Note TeX extensions:
+TeX extensions.
+
+* Menu:
+
+* MLTeX:: Multi-lingual TeX.
+* patgen invocation:: Creating hyphenation patterns.
+* TCX files:: Support for different character sets & fonts.
+
+
+File: web2c.info, Node: MLTeX, Next: patgen invocation, Up: Languages and hyphenation
+
+4.4.1 MLTeX: Multi-lingual TeX
+------------------------------
+
+Multi-lingual TeX (`mltex') is an extension of TeX originally written
+by Michael Ferguson and now updated and maintained by Bernd Raichle.
+It allows the use of non-existing glyphs in a font by declaring glyph
+substitutions. These are restricted to substitutions of an accented
+character glyph, which need not be defined in the current font, by its
+appropriate `\accent' construction using a base and accent character
+glyph, which do have to exist in the current font. This substitution
+is automatically done behind the scenes, if necessary, and thus MLTeX
+additionally supports hyphenation of words containing an accented
+character glyph for fonts missing this glyph (e.g., Computer Modern).
+Standard TeX suppresses hyphenation in this case.
+
+ MLTeX works at `.fmt'-creation time: the basic idea is to specify
+the `-mltex' option to TeX when you `\dump' a format. Then, when you
+subsequently invoke TeX and read that `.fmt' file, the MLTeX features
+described below will be enabled.
+
+ Generally, you use special macro files to create an MLTeX `.fmt'
+file.
+
+ The sections below describe the two new primitives that MLTeX
+defines. Aside from these, MLTeX is completely compatible with
+standard TeX.
+
+* Menu:
+
+* \charsubdef:: Character substitution definitions.
+* \tracingcharsubdef:: Tracing substitutions.
+
+
+File: web2c.info, Node: \charsubdef, Next: \tracingcharsubdef, Up: MLTeX
+
+4.4.1.1 `\charsubdef': Character substitutions
+..............................................
+
+The most important primitive MLTeX adds is `\charsubdef', used in a way
+reminiscent of `\chardef':
+ \charsubdef COMPOSITE [=] ACCENT BASE
+
+ Each of COMPOSITE, ACCENT, and BASE are font glyph numbers,
+expressed in the usual TeX syntax: `\e symbolically, '145 for octal,
+"65 for hex, 101 for decimal.
+
+ MLTeX's `\charsubdef' declares how to construct an accented
+character glyph (not necessarily existing in the current font) using two
+character glyphs (that do exist). Thus it defines whether a character
+glyph code, either typed as a single character or using the `\char'
+primitive, will be mapped to a font glyph or to an `\accent' glyph
+construction.
+
+ For example, if you assume glyph code 138 (decimal) for an
+e-circumflex and you are using the Computer Modern fonts, which have
+the circumflex accent in position 18 and lowercase `e' in the usual
+ASCII position 101 decimal, you would use `\charsubdef' as follows:
+
+ \charsubdef 138 = 18 101
+
+ For the plain TeX format to make use of this substitution, you have
+to redefine the circumflex accent macro `\^' in such a way that if its
+argument is character `e' the expansion `\char138 ' is used instead of
+`\accent18 e'. Similar `\charsubdef' declaration and macro
+redefinitions have to be done for all other accented characters.
+
+ To disable a previous `\charsubdef C', redefine C as a pair of
+zeros. For example:
+ \charsubdef '321 = 0 0 % disable N tilde
+ (Octal '321 is the ISO Latin-1 value for the Spanish N tilde.)
+
+ `\charsubdef' commands should only be given once. Although in
+principle you can use `\charsubdef' at any time, the result is
+unspecified. If `\charsubdef' declarations are changed, usually either
+incorrect character dimensions will be used or MLTeX will output
+missing character warnings. (The substitution of a `\charsubdef' is
+used by TeX when appending the character node to the current horizontal
+list, to compute the width of a horizontal box when the box gets
+packed, and when building the `\accent' construction at
+`\shipout'-time. In summary, the substitution is accessed often, so
+changing it is not desirable, nor generally useful.)
+
+
+File: web2c.info, Node: \tracingcharsubdef, Prev: \charsubdef, Up: MLTeX
+
+4.4.1.2 `\tracingcharsubdef': Substitution diagnostics
+......................................................
+
+To help diagnose problems with `\charsubdef', MLTeX provides a new
+primitive parameter, `\tracingcharsubdef'. If positive, every use of
+`\charsubdef' will be reported. This can help track down when a
+character is redefined.
+
+ In addition, if the TeX parameter `\tracinglostchars' is 100 or
+more, the character substitutions actually performed at `\shipout'-time
+will be recorded.
+
+
+File: web2c.info, Node: TCX files, Prev: patgen invocation, Up: Languages and hyphenation
+
+4.4.2 TCX files: Character translations
+---------------------------------------
+
+TCX (TeX character translation) files help TeX support direct input of
+8-bit international characters if fonts containing those characters are
+being used. Specifically, they map an input (keyboard) character code
+to the internal TeX character code (a superset of ASCII).
+
+ Of the various proposals for handling more than one input encoding,
+TCX files were chosen because they follow Knuth's original ideas for
+the use of the `xchr' and `xord' tables. He ventured that these would
+be changed in the WEB source in order to adjust the actual version to a
+given environment. It turns out, however, that recompiling the WEB
+sources is not as simple a task as Knuth may have imagined; therefore,
+TCX files, providing the possibility of changing of the conversion
+tables on on-the-fly, have been implemented instead.
+
+ This approach limits the portability of TeX documents, as some
+implementations do not support it (or use a different method for
+input-internal reencoding). It may also be problematic to determine
+the encoding to use for a TeX document of unknown provenance; in the
+worst case, failure to do so correctly may result in subtle errors in
+the typeset output. But we feel the benefits outweigh these
+disadvantages.
+
+ This is entirely independent of the MLTeX extension (*note MLTeX::):
+whereas a TCX file defines how an input keyboard character is mapped to
+TeX's internal code, MLTeX defines substitutions for a non-existing
+character glyph in a font with a `\accent' construction made out of two
+separate character glyphs. TCX files involve no new primitives; it is
+not possible to specify that an input (keyboard) character maps to more
+than one character.
+
+ Information on specifying TCX files:
+
+ * The best way to specify a TCX file is to list it explicitly in the
+ first line of the main document:
+ %& -translate-file=TCXFILE
+
+ * You can also specify a TCX file to be used on a particular TeX run
+ with the command-line option `-translate-file=TCXFILE'.
+
+ * TCX files are searched for along the `WEB2C' path.
+
+ * Initial TeX (*note Initial TeX: Initial TeX.) ignores TCX files.
+
+ The Web2c distribution comes with a number of TCX files. Two
+important ones are `il1-t1.tcx' and `il2-t1.tcx', which support ISO
+Latin 1 and ISO Latin 2, respectively, with Cork-encoded fonts (a.k.a.
+the LaTeX T1 encoding). TCX files for Czech, Polish, and Slovak are
+also provided.
+
+ One other notable TCX file is `empty.tcx', which is, well, empty.
+Its purpose is to reset Web2C's behavior to the default (only visible
+ASCII being printable, as described below) when a format was dumped
+with another TCX being active--which is in fact the case for everything
+but plain TeX in the TeX Live and other distributions. Thus:
+
+ latex somefile8.tex
+ => terminal etc. output with 8-bit chars
+ latex --translate-file=empty.tcx somefile8.tex
+ => terminal etc. output with ^^ notation
+
+ Syntax of TCX files:
+ 1. Line-oriented. Blank lines are ignored.
+
+ 2. Whitespace is ignored except as a separator.
+
+ 3. Comments start with `%' and continue to the end of the line.
+
+ 4. Otherwise, a line consists of one or two character codes,
+ optionally followed by 0 or 1. The last number indicates whether
+ DEST is considered printable.
+ SRC [DEST [PRNT]]
+
+ 5. Each character code may be specified in octal with a leading `0',
+ hexadecimal with a leading `0x', or decimal otherwise. Values must
+ be between 0 and 255, inclusive (decimal).
+
+ 6. If the DEST code is not specified, it is taken to be the same as
+ SRC.
+
+ 7. If the same SRC code is specified more than once, it is the last
+ definition that counts.
+
+ Finally, here's what happens: when TeX sees an input character with
+code SRC, it 1) changes SRC to DEST; and 2) makes the DEST code
+"printable", i.e., printed as-is in diagnostics and the log file rather
+than in `^^' notation.
+
+ By default, no characters are translated, and character codes
+between 32 and 126 inclusive (decimal) are printable.
+
+ Specifying translations for the printable ASCII characters (codes
+32-127) will yield unpredictable results. Additionally you shouldn't
+make the following characters printable: `^^I' (TAB), `^^J' (line
+feed), `^^M' (carriage return), and `^^?' (delete), since TeX uses them
+in various ways.
+
+ Thus, the idea is to specify the input (keyboard) character code for
+SRC, and the output (font) character code for DEST.
+
+ By default, only the printable ASCII characters are considered
+printable by TeX. If you specify the `-8bit' option, all characters are
+considered printable by default. If you specify both the `-8bit'
+option and a TCX file, then the TCX can set specific characters to be
+non-printable.
+
+ Both the specified TCX encoding and whether characters are printable
+are saved in the dump files (like `tex.fmt'). So by giving these
+options in combination with `-ini', you control the defaults seen by
+anyone who uses the resulting dump file.
+
+ When loading a dump, if the `-8bit' option was given, then all
+characters become printable by default.
+
+ When loading a dump, if a TCX file was specified, then the TCX data
+from the dump is ignored and the data from the file used instead.
+
+
+File: web2c.info, Node: patgen invocation, Next: TCX files, Prev: MLTeX, Up: Languages and hyphenation
+
+4.4.3 Patgen: Creating hyphenation patterns
+-------------------------------------------
+
+Patgen creates hyphenation patterns from dictionary files for use with
+TeX. Synopsis:
+
+ patgen DICTIONARY PATTERNS OUTPUT TRANSLATE
+
+ Each argument is a filename. No path searching is done. The output is
+written to the file OUTPUT.
+
+ In addition, Patgen prompts interactively for other values.
+
+ For more information, see `Word hy-phen-a-tion by com-puter' by
+Frank Liang (*note References::), and also the `patgen.web' source file.
+
+ The only options are `-help' and `-version' (*note Common options::).
+
+
+File: web2c.info, Node: IPC and TeX, Next: TeX extensions, Prev: Languages and hyphenation, Up: TeX
+
+4.5 IPC and TeX
+===============
+
+(Sorry, but I'm not going to write this unless someone actually uses
+this feature. Let me know.)
+
+ This functionality is available only if the `--enable-ipc' option
+was specified to `configure' during installation of Web2c (*note
+Installation::).
+
+ If you define `IPC_DEBUG' before compilation (e.g., with `make
+XCFLAGS=-DIPC_DEBUG'), TeX will print messages to standard error about
+its socket operations. This may be helpful if you are, well, debugging.
+
+
+File: web2c.info, Node: TeX extensions, Prev: IPC and TeX, Up: TeX
+
+4.6 TeX extensions
+==================
+
+The base TeX program has been extended in many ways. Here's a partial
+list. Please send information on extensions not listed here to the
+address in *Note Reporting bugs: (kpathsea)Reporting bugs.
+
+e-TeX
+ Adds many new primitives, including right-to-left typesetting.
+ Available from `http://www.vms.rhbnc.ac.uk/e-TeX/' and
+ `CTAN:/systems/e-tex'.
+
+Omega
+ Adds Unicode support, right-to-left typesetting, and more.
+ Available from `http://www.ens.fr/omega' and `CTAN:/systems/omega'.
+
+pdfTeX
+ A variant of TeX that produces PDF instead of DVI files. It also
+ includes primitives for hypertext and micro-typography. Available
+ from `CTAN:/systems/pdftex'.
+
+`TeX--XeT'
+ Adds primitives and DVI opcodes for right-to-left typesetting (as
+ used in Arabic, for example). An old version for TeX 3.1415 is
+ available from `CTAN:/systems/knuth/tex--xet'. A newer version is
+ included in e-TeX.
+
+File-handling TeX
+ Adds primitives for creating multiple DVI files in a single run;
+ and appending to output files as well as overwriting. Web2c
+ implementation available in the distribution file
+ `web2c/contrib/file-handling-tex'.
+
+
+File: web2c.info, Node: Metafont, Next: MetaPost, Prev: TeX, Up: Top
+
+5 Metafont: Creating typeface families
+**************************************
+
+Metafont is a system for producing shapes; it was designed for producing
+complete typeface families, but it can also produce geometric designs,
+dingbats, etc. And it has considerable mathematical and
+equation-solving capabilities which can be useful entirely on their own.
+
+ Metafont is a batch language, like C or Pascal: you compile a
+Metafont program into a corresponding font, rather than interactively
+drawing lines or curves. This approach has both considerable
+disadvantages (people unfamiliar with conventional programming
+languages will be unlikely to find it usable) and considerable
+advantages (you can make your design intentions specific and
+parameterizable). For a complete description of the Metafont language,
+see `The METAFONTbook' (*note References::).
+
+* Menu:
+
+* mf invocation:: Invoking Metafont.
+* Initial Metafont:: Making bases.
+* Modes:: Device definitions for Metafont.
+* Online Metafont graphics:: Seeing MF output online.
+* gftodvi invocation:: Making proofsheets for fonts.
+* mft invocation:: Prettyprinting Metafont sources.
+
+
+File: web2c.info, Node: mf invocation, Next: Initial Metafont, Up: Metafont
+
+5.1 `mf' invocation
+===================
+
+Metafont (usually invoked as `mf') reads character definitions
+specified in the Metafont programming language, and outputs the
+corresponding font. This section merely describes the options available
+in the Web2c implementation. For a complete description of the Metafont
+language, see `The Metafontbook' (*note References::).
+
+ Metafont processes its command line and determines its memory dump
+(base) file in a way exactly analogous to MetaPost and TeX (*note tex
+invocation::, and *note Memory dumps::). Synopses:
+
+ mf [OPTION]... [MFNAME[.mf]] [MF-COMMANDS]
+ mf [OPTION]... \FIRST-LINE
+ mf [OPTION]... &BASE ARGS
+
+ Most commonly, a Metafont invocation looks like this:
+ mf '\mode:=MODE; mag:=MAGNIFICATION; input MFNAME'
+ (The single quotes avoid unwanted interpretation by the shell.)
+
+ Metafont searches the usual places for the main input file MFNAME
+(*note Supported file formats: (kpathsea)Supported file formats.),
+extending MFNAME with `.mf' if necessary. To see all the relevant
+paths, set the environment variable `KPATHSEA_DEBUG' to `-1' before
+running the program. By default, Metafont runs an external program
+named `mktexmf' to create any nonexistent Metafont source files you
+input. You can disable this at configure-time or runtime (*note mktex
+configuration: (kpathsea)mktex configuration.). This is mostly for the
+sake of the EC fonts, which can be generated at any size.
+
+ Metafont writes the main GF output to the file `BASEMFNAME.NNNgf',
+where NNN is the font resolution in pixels per inch, and BASEMFNAME is
+the basename of MFNAME, or `mfput' if no input file was specified. A
+GF file contains bitmaps of the actual character shapes. Usually GF
+files are converted immediately to PK files with GFtoPK (*note gftopk
+invocation::), since PK files contain equivalent information, but are
+more compact. (Metafont output in GF format rather than PK for only
+historical reasons.)
+
+ Metafont also usually writes a metric file in TFM format to
+`BASEMFNAME.tfm'. A TFM file contains character dimensions, kerns, and
+ligatures, and spacing parameters. TeX reads only this .tfm file, not
+the GF file.
+
+ The MODE in the example command above is a name referring to a
+device definition (*note Modes::); for example, `localfont' or
+`ljfour'. These device definitions must generally be precompiled into
+the base file. If you leave this out, the default is `proof' mode, as
+stated in `The Metafontbook', in which Metafont outputs at a resolution
+of 2602dpi; this is usually not what you want. The remedy is simply to
+assign a different mode--`localfont', for example.
+
+ The MAGNIFICATION assignment in the example command above is a
+magnification factor; for example, if the device is 600dpi and you
+specify `mag:=2', Metafont will produce output at 1200dpi. Very often,
+the MAGNIFICATION is an expression such as `magstep(.5)', corresponding
+to a TeX "magstep", which are factors of 1.2 * sqrt(2).
+
+ After running Metafont, you can use the font in a TeX document as
+usual. For example:
+ \font\myfont = newfont
+ \myfont Now I am typesetting in my new font (minimum hamburgers).
+
+ The program accepts the following options, as well as the standard
+`-help' and `-version' (*note Common options::):
+`-[no]-file-line-error'
+`-fmt=FMTNAME'
+`-halt-on-error'
+`-ini'
+`-interaction=STRING'
+`-jobname=STRING'
+`-kpathsea-debug=NUMBER'
+`-[no]parse-first-line'
+`-output-directory'
+`-progname=STRING'
+`-recorder'
+`-translate-file=TCXFILE'
+`-8bit'
+ These options are common to TeX, Metafont, and MetaPost. *Note
+ Common options::.
+
+`-mktex=FILETYPE'
+`-no-mktex=FILETYPE'
+ Turn on or off the `mktex' script associated with FILETYPE. The
+ only value that makes sense for FILETYPE is `mf'.
+
+
+File: web2c.info, Node: Initial Metafont, Next: Modes, Prev: mf invocation, Up: Metafont
+
+5.2 Initial Metafont
+====================
+
+`inimf' is the "initial" form of Metafont, which does lengthy
+initializations avoided by the "virgin" (`vir') form, so as to be
+capable of dumping `.base' files (*note Memory dumps::). For a
+detailed comparison of virgin and initial forms, see *Note Initial and
+virgin::. In past releases, a separate program `inimf' was installed
+to invoke the initial form, but this is no longer the case.
+
+ For a list of options and other information, see *Note mf
+invocation::.
+
+ The only memory dump file commonly used with Metafont is the default
+`plain.base', also known as `mf.base' (again, *note Memory dumps::).
+It is created by default during installation, but you can also do so by
+hand if necessary (e.g., if a Metafont update is issued):
+ mf -ini '\input plain; input modes; dump'
+ (The quotes prevent interpretation of the backslashes from the
+shell.) Then install the resulting `plain.base' in `$(basedir)'
+(`/usr/local/share/texmf/web2c' by default), and link `mf.base' to it.
+
+ For an explanation of the additional `modes.mf' file, see *Note
+Modes::. This file has no counterpart in TeX or MetaPost.
+
+ In the past, it was sometimes useful to create a base file
+`cmmf.base' (a.k.a. `cm.base'), with the Computer Modern macros also
+included in the base file. Nowadays, however, the additional time
+required to read `cmbase.mf' is exceedingly small, usually not enough
+to be worth the administrative hassle of updating the `cmmf.base' file
+when you install a new version of `modes.mf'. People actually working
+on a typeface may still find it worthwhile to create their own base
+file, of course.
+
+
+File: web2c.info, Node: Modes, Next: Online Metafont graphics, Prev: Initial Metafont, Up: Metafont
+
+5.3 Modes: Device definitions for Metafont
+==========================================
+
+Running Metafont and creating Metafont base files requires information
+that TeX and MetaPost do not: "mode" definitions which specify device
+characteristics, so Metafont can properly rasterize the shapes.
+
+ When making a base file, a file containing modes for
+locally-available devices should be input after `plain.mf'. One
+commonly used file is `ftp://ftp.tug.org/tex/modes.mf'; it includes all
+known definitions.
+
+ If, however, for some reason you have decreased the memory available
+in your Metafont, you may need to copy `modes.mf' and remove the
+definitions irrelevant to you (probably most of them) instead of using
+it directly. (Or, if you're a Metafont hacker, maybe you can suggest a
+way to redefine `mode_def' and/or `mode_setup'; right now, the amount
+of memory used is approximately four times the total length of the
+`mode_def' names, and that's a lot.)
+
+ If you have a device not included in `modes.mf', please see comments
+in that file for how to create the new definition, and please send the
+definition to <tex-fonts@mail.tug.org> to get it included in the next
+release of `modes.mf'.
+
+ Usually, when you run Metafont you must supply the name of a mode
+that was dumped in the base file. But you can also define the mode
+characteristics dynamically, by invoking Metafont with an assignment to
+`smode' instead of `mode', like this:
+ mf '\smode:="newmode.mf"; mag:=MAGNIFICATION; input MFNAME'
+ This is most useful when you are working on the definition of a new
+mode.
+
+ The MAGNIFICATION and MFNAME arguments are explained in *Note mf
+invocation::. In the file `newmode.mf', you should have the following
+(with no `mode_def' or `enddef'), if you are using `modes.mf'
+conventions:
+ mode_param (pixels_per_inch, DPI);
+ mode_param (blacker, B);
+ mode_param (fillin, F);
+ mode_param (o_correction, O);
+ mode_common_setup_;
+ (Of course, you should use real numbers for DPI, B, F, and O.)
+
+ For more information on the use of `smode', or if you are not using
+`modes.mf', see page 269 of `The Metafontbook'.
+
+
+File: web2c.info, Node: Online Metafont graphics, Next: gftodvi invocation, Prev: Modes, Up: Metafont
+
+5.4 Online Metafont graphics
+============================
+
+The Web2c implementation of Metafont can do online graphics with a
+number of devices. (See the Metafont manual for more information about
+how to draw on your screen.) By default, no graphics support is
+enabled.
+
+ Metafont examines the `MFTERM' environment variable or config file
+value at runtime, or the `TERM' environment variable if `MFTERM' is not
+set, to determine the device support to use. Naturally, only the
+devices for which support has been compiled in can be selected.
+
+ Here is a table of the possibilities, showing the `MFTERM' value and
+the corresponding `configure' option(s) in parentheses.
+
+`epsf'
+ (`--with-epsfwin') Pseudo-window server for Encapsulated
+ PostScript (see `web2c/window/epsf.c'). This device produces an
+ EPS file containing the graphics which would be displayed online on
+ other devices. The name of the EPS file defaults to metafont.eps
+ but can be changed by setting the MFEPSF environment variable to
+ the new filename. Contributed by Mathias Herberts.
+
+`hp2627'
+ (`--with-hp2627win') HP2627a color graphics terminals.
+
+`mftalk'
+ (`--with-mftalkwin') Generic window server (see
+ `web2c/window/mftalk.c').
+
+`next'
+ (`--with-next') NeXT window system. This requires a separate
+ program, called `DrawingServant', available separately. See the
+ `web2c/window/next.c'.
+
+`regis'
+ (`--with-regiswin') Regis terminals.
+
+`sun'
+ (`--with-suntoolswin') The old Suntools (not any flavor of X)
+ window system. (You can get the even older SunWindows `gfx' system
+ by using `sun-gfx.c'.)
+
+`tek'
+ (`--with-tektronixwin') Tektronix terminals.
+
+`uniterm'
+ (`--with-unitermwin') Uniterm, Simon Poole's emulator of a smart
+ Tektronix 4014 terminal. This may work with regular Tektronix
+ terminals as well; it's faster than the driver `--with-tek'
+ selects.
+
+`xterm'
+ (`--with-x11win', `--with-x', `--with-x11') The X window system
+ (version 11).
+
+ There are two variants of the X11 support, one that works with the
+ Xt toolkit, and another that works directly with Xlib. The Xt
+ support is more efficient and has more functionality, so it is the
+ default. If you must use the Xlib support, use `configure --with-x
+ --with-x-toolkit=no'.
+
+ You cannot specify any of the usual X options (e.g., `-geometry')
+ on the Metafont command line, but you can specify X resources in
+ your `~/.Xdefaults' or `~/.Xresources' file. The class name is
+ `Metafont'. If you're using the Xt support, all the usual X toolkit
+ resources are supported. If you're using the Xlib support, only
+ the `geometry' resource is supported.
+
+ You specify the X display to which Metafont connects in the
+ `DISPLAY' environment variable, as usual.
+
+
+ Writing support for a new device is straightforward. Aside from
+defining the basic drawing routines that Metafont uses (see `mf.web'),
+you only have to add another entry to the tables on the last page of
+`web2c/lib/texmfmp.c'. Or you can write an independent program and use
+MFtalk (see `web2c/window/mftalk.c').
+
+
+File: web2c.info, Node: gftodvi invocation, Next: mft invocation, Prev: Online Metafont graphics, Up: Metafont
+
+5.5 GFtoDVI: Character proofs of fonts
+======================================
+
+GFtoDVI makes "proof sheets" from a GF bitmap file as output by, for
+example, Metafont (*note Metafont::). This is an indispensable aid for
+font designers or Metafont hackers. Synopsis:
+
+ gftodvi [OPTION]... GFNAME[gf]
+
+ The font GFNAME is searched for in the usual places (*note Glyph
+lookup: (kpathsea)Glyph lookup.). To see all the relevant paths, set
+the environment variable `KPATHSEA_DEBUG' to `-1' before running the
+program.
+
+ The suffix `gf' is supplied if not already present. This suffix is
+not an extension; no `.' precedes it: for instance `cmr10.600gf'.
+
+ The output filename is the basename of GFNAME extended with `.dvi',
+e.g., `gftodvi /wherever/foo.600gf' creates `./foo.dvi'.
+
+ The characters from GFNAME appear one per page in the DVI output,
+with labels, titles, and annotations, as specified in Appendix H
+(Hardcopy Proofs) of `The Metafontbook'.
+
+ GFtoDVI uses several fonts besides GFNAME itself:
+
+ * "gray font" (default `gray'): for the pixels that actually make up
+ the character. Simply using black is not right, since then labels,
+ key points, and other information could not be shown.
+
+ * "title font" (default `cmr8'): for the header information at the
+ top of each output page.
+
+ * "label font" (default `cmtt10'): for the labels on key points of
+ the figure.
+
+ * "slant font" (no default): for diagonal lines, which are otherwise
+ simulated using horizontal and vertical rules.
+
+
+ To change the default fonts, you must use `special' commands in your
+Metafont source file.
+
+ The program accepts the following option, as well as the standard
+`-verbose', `-help', and `-version' (*note Common options::):
+`-overflow-label-offset=POINTS'
+ Typeset the so-called overflow labels, if any, POINTS TeX points
+ from the right edge of the character bounding box. The default is
+ a little over two inches (ten million scaled points, to be
+ precise). Overflow equations are used to locate coordinates when
+ their actual position is too crowded with other information.
+
+
+File: web2c.info, Node: mft invocation, Prev: gftodvi invocation, Up: Metafont
+
+5.6 MFT: Prettyprinting Metafont source
+=======================================
+
+MFT translates a Metafont program into a TeX document suitable for
+typesetting, with the aid of TeX macros defined in the file
+`mftmac.tex'. Synopsis:
+
+ mft [OPTION]... MFNAME[.mf]
+
+ MFT searches the usual places for MFNAME (*note Supported file
+formats: (kpathsea)Supported file formats.). To see all the relevant
+paths, set the environment variable `KPATHSEA_DEBUG' to `-1' before
+running the program. The output goes to the basename of MFNAME extended
+with `.tex', e.g., `mft /wherever/foo.mf' creates `./foo.tex'.
+
+ Line breaks in the input are carried over into the output; moreover,
+blank spaces at the beginning of a line are converted to quads of
+indentation in the output. Thus, you have full control over the
+indentation and line breaks. Each line of input is translated
+independently of the others.
+
+ Further control is allowed via Metafont comments:
+ * Metafont comments following a single `%' should be valid TeX
+ input. But Metafont material can be included within vertical bars
+ in a comment; this will be translated by MFT as if it were regular
+ Metafont code. For example, a comment like `% |x2r| is the tip of
+ the bowl' will be translated into the TeX `% $x_{2r}$ is the ...',
+ i.e., the `x2r' is treated as an identifier.
+
+ * `%%' indicates that the remainder of an input line should be copied
+ verbatim to the output. This is typically used to introduce
+ additional TeX material at the beginning or an MFT job, e.g. code
+ to modify the standard layout or the formatting macros defined in
+ `mftmac.tex', or to add a line saying `%%\bye' at the end of the
+ job. (MFT doesn't add this automatically in order to allow
+ processing several files produces by MFT in the same TeX job.)
+
+ * `%%% TOKEN1 OTHER-TOKENS' introduces a change in MFT's formatting
+ rules; all the OTHER-TOKENS will henceforth be translated
+ according to the current conventions for TOKEN1. The tokens must
+ be symbolic (i.e., not numeric or string tokens). For example, the
+ input line
+ %%% addto fill draw filldraw
+ says to format the `fill', `draw', and `filldraw' operations of
+ plain Metafont just like the primitive token `addto', i.e., in
+ boldface type. Without such reformatting commands, MFT would
+ treat `fill' like an ordinary tag or variable name. In fact, you
+ need a `%%%' command even to get parentheses to act like
+ delimiters.
+
+ * `%%%%' introduces an MFT comment, i.e., MFT ignores the remainder
+ of such a line.
+
+ * Five or more `%' signs should not be used.
+
+ (The above description was edited from `mft.web', written by
+D.E. Knuth.)
+
+ The program accepts the following options, as well as the standard
+`-help' and `-version' (*note Common options::):
+`-change=CHFILE[.ch]'
+ Apply the change file CHFILE as with Tangle and Weave (*note
+ WEB::).
+
+`-style=MFTFILE[.mft]'
+ Read MFTFILE before anything else; a MFT style file typically
+ contains only MFT directives as described above. The default
+ style file is named `plain.mft', which defines this properly for
+ programs using plain Metafont. The MFT files is searched along the
+ `MFTINPUTS' path; see *Note Supported file formats:
+ (kpathsea)Supported file formats.
+
+ Other examples of MFT style files are `cmbase.mft', which defines
+ formatting rules for the macros defined in `cm.base', and `e.mft',
+ which was used in the production of Knuth's Volume E, `Computer
+ Modern Typefaces'.
+
+ Using an appropriate MFT style file, it is also possible to
+ configure MFT for typesetting MetaPost sources. However, MFT does
+ not search the usual places for MetaPost input files.
+
+ If you use eight-bit characters in the input file, they are passed
+on verbatim to the TeX output file; it is up to you to configure TeX to
+print these properly.
+
+
+File: web2c.info, Node: MetaPost, Next: BibTeX, Prev: Metafont, Up: Top
+
+6 MetaPost: Creating technical illustrations
+********************************************
+
+MetaPost is a picture-drawing language similar to Metafont (*note
+Metafont::), but instead of outputting bitmaps in a "font", it outputs
+PostScript commands. It's primarily intended for creating technical
+illustrations.
+
+ MetaPost also provides for arbitrary integration of text and
+graphics in a natural way, using any typesetter (TeX and Troff are both
+supported) and a number of other subsidiary programs, described below.
+
+* Menu:
+
+* mpost invocation:: Invoking MetaPost.
+* Initial MetaPost:: Making mems.
+* makempx invocation:: Create MPX files for labels.
+* dvitomp invocation:: DVI-to-MPX translation.
+* dmp invocation:: Ditroff-to-MPX translation.
+* mpto invocation:: Extracting labels from MetaPost programs.
+* newer invocation:: Is one file newer than another?
+
+
+File: web2c.info, Node: mpost invocation, Next: Initial MetaPost, Up: MetaPost
+
+6.1 `mpost' invocation
+======================
+
+MetaPost (installed as `mpost') reads a series of pictures specified in
+the MetaPost programming language, and outputs corresponding PostScript
+code. This section merely describes the options available in the Web2c
+implementation. For a complete description of the MetaPost language,
+see AT&T technical report CSTR-162, generally available in
+`TEXMF/doc/metapost/', where TEXMF is the root of TeX directory
+structure. See also:
+ * `http://cm.bell-labs.com/who/hobby/MetaPost.html' (the
+ MetaPost author's home page);
+
+ * `http://tug.org/metapost.html' (papers, packages, and
+ related information).
+
+ Also, a standard MetaPost package for drawing graphs is documented in
+AT&T technical report CSTR-164, available as the file `mpgraph.ps',
+generally stored alongside `mpman.ps'.
+
+ MetaPost processes its command line and determines its memory dump
+(mem) file in a way exactly analogous to Metafont and TeX (*note `tex'
+invocation: tex invocation, and *note Memory dumps::). Synopses:
+
+ mpost [OPTION]... [MPNAME[.mp]] [MP-COMMANDS]
+ mpost [OPTION]... \FIRST-LINE
+ mpost [OPTION]... &MEM ARGS
+
+ MetaPost searches the usual places for the main input file MPNAME
+(*note Supported file formats: (kpathsea)Supported file formats.),
+extending MPNAME with `.mp' if necessary. To see all the relevant
+paths, set the environment variable `KPATHSEA_DEBUG' to `-1' before
+running the program.
+
+ MetaPost writes its PostScript output to a series of files
+`BASEMPNAME.NNN' (or perhaps `BASEMPNAME.ps', very occasionally
+`BASEMPNAME.tfm'), where NNN are the figure numbers specified in the
+input, typically to the `beginfig' macro, and BASEMPNAME is the
+basename of MPNAME, or `mpout' if no input file was specified.
+MetaPost uses the `.ps' extension when the figure number is out of
+range, e.g., if you say `beginfig(-1)'.
+
+ You can use the output files as figures in a TeX document just as
+with any other PostScript figures. For example, with this TeX command:
+ \special{psfile="FILENAME"}
+ or by using `epsf.tex' (*note EPSF macros: (dvips)EPSF macros.).
+
+ The MetaPost construct
+ btex ... TEX-INPUT ... etex
+ calls MakeMPX to generate a MPX file containing a MetaPost picture
+expression corresponding to TEX-INPUT (*note makempx invocation::).
+
+ The construct
+ verbatimtex ... TEX-INPUT ... etex
+ simply passes the TEX-INPUT through to MakeMPX and thus to TeX. For
+example, if you are using LaTeX, your MetaPost input file must start
+with a `verbatimtex' block that gives the necessary `\documentclass'
+(or `\documentstyle') `\begin{document}' command. You will also need
+to set the enviroment variable `TEX' to `latex' (*note makempx
+invocation::).
+
+ TEX-INPUT need not be specifically TeX input; it could also be
+Troff. In that case, you will need the `-m pictures' Troff macro
+package (unfortunately absent from many Troff implementations), or an
+equivalent such as the `-m pspic' macros from GNU groff described in
+grops(1).
+
+ Other typesetters can be supported with no change to MetaPost itself;
+only MakeMPX needs to be updated.
+
+ Naturally, you must use fonts that are supported by the typesetter;
+specifically, you'll probably want to use standard PostScript fonts with
+Troff. And only the TeX system understands Computer Modern or other
+Metafont fonts; you can also use PostScript fonts with TeX, of course.
+
+ MetaPost-generated PostScript figures which do use Computer Modern
+fonts for labels cannot be directly previewed or printed. Instead, you
+must include them in a TeX document and run the resulting DVI file
+through Dvips to arrange for the downloading of the required fonts
+(*note Fonts in figures: (dvips)Fonts in figures.). To help with this,
+the MetaPost distribution provides a small TeX file `mproof.tex' which
+is typically called as:
+ tex mproof MP-OUTPUT-FILES... ; dvips mproof -o
+ The resulting file `mproof.ps' can then be printed or previewed.
+
+ To generate EPSF files, set the internal MetaPost variable
+`prologues' positive. To make the output files self-contained, use
+only standard PostScript fonts. MetaPost reads the same `psfonts.map'
+file as Dvips, to determine PostScript fonts that need to be downloaded
+(*note psfonts.map: (dvips)psfonts.map.).
+
+ MetaPost can write output files, via the `write' primitive; this
+opens a security hole. *Note tex invocation::.
+
+ The program accepts the following options, as well as the standard
+`-help' and `-version' (*note Common options::):
+`-[no]-file-line-error'
+`-fmt=FMTNAME'
+`-halt-on-error'
+`-ini'
+`-interaction=STRING'
+`-jobname=STRING'
+`-kpathsea-debug=NUMBER'
+`-[no]parse-first-line'
+`-output-directory'
+`-progname=STRING'
+`-recorder'
+`-translate-file=TCXFILE'
+`-8bit'
+ These options are common to TeX, Metafont, and MetaPost. *Note
+ Common options::.
+
+`-T'
+`-troff'
+ Set the `prologues' internal variable to `1', and use `makempx
+ -troff' to generate MPX files.
+
+`-tex=TEXPROGRAM'
+ When this option is given, the program TEXPROGRAM is used to
+ typeset the labels.
+
+
+
+File: web2c.info, Node: Initial MetaPost, Next: makempx invocation, Prev: mpost invocation, Up: MetaPost
+
+6.2 Initial MetaPost
+====================
+
+`inimpost' is the "initial" form of MetaPost, which does lengthy
+initializations avoided by the "virgin" (`vir') form, so as to be
+capable of dumping `.mem' files (*note Memory dumps::). For a detailed
+comparison of virgin and initial forms, see *Note Initial and virgin::.
+In past releases, a separate program `inimpost' was installed for the
+initial form, but this is no longer the case.
+
+ For a list of options and other information, see *Note mpost
+invocation::.
+
+ The principal memory dump file used with MetaPost is the default,
+`plain.mem', also known as `mpost.mem' (again, *note Memory dumps::).
+It is created by default during installation, but you can also do so by
+hand if necessary (e.g., if a `plain.mp' update is issued):
+ mpost -ini '\input plain dump'
+ (The quotes prevent interpretation of the backslashes from the
+shell.) Then install the resulting `plain.mem' in `$(memdir)'
+(`/usr/local/share/texmf/web2c' by default), and link `mpost.mem' to it.
+
+ MetaPost also provides a mem file with all the features of plain
+Metafont, called `mfplain.mem'. You can create that in the same way;
+just replace `plain' in the above command with `mfplain'.
+`mfplain.mem' file lets you directly process Metafont source files with
+MetaPost, producing character proofs (one file for each character)
+similar to those produced with Metafont in proof mode and GFtoDVI
+(*note gftodvi invocation::).
+
+ Another MetaPost mem file, named MetaFun, provides many advanced
+features. It was developed and maintained by Pragma ADE. The home
+page for MetaFun, and other MetaPost-related things from Pragma:
+`http://www.pragma-ade.com/metapost.htm'.
+
+
+File: web2c.info, Node: makempx invocation, Next: dvitomp invocation, Prev: Initial MetaPost, Up: MetaPost
+
+6.3 MakeMPX: Support MetaPost labels
+====================================
+
+In MetaPost, labels can be typeset using any document processor; the
+Web2c implementation supports TeX and Troff. MakeMPX translates the
+labels from the typesetting language back into low-level MetaPost
+commands in a so-called "mpx file", so text can be manipulated like
+other graphic objects. It is invoked automatically by MetaPost.
+Synopsis:
+
+ makempx [-troff] MPFILE MPXFILE
+
+The input comes from MPFILE (no path searching is done), and the output
+goes to MPXFILE. However, if the file MPXFILE already exists, and is
+newer than MPFILE, then nothing is done (presumably the file is
+up-to-date).
+
+ Otherwise:
+ 1. MPto is run to extract the label text from the MetaPost source
+ file MPFILE (*note mpto invocation::).
+
+ 2. The typesetting program itself is run, either TeX or Troff (see
+ below). If TeX, and the file named by the `MPTEXPRE' environment
+ variable exists (`mptexpre.tex' by default), that file is
+ prepended to the input from the MetaPost file.
+
+ 3. The typesetter output (a DVI file in the case of TeX, Ditroff
+ output for Troff) is translated back to MetaPost, by DVItoMP
+ (*note dvitomp invocation::) or DMP (*note dmp invocation::)
+ respectively.
+
+ If any of the above steps fail, for example if there was a
+typesetting mistake in the original MPFILE, output may be left in files
+named `mpxerr.{log,tex,dvi}' (TeX) or `mpxerr{,.t}' (Troff), so you can
+diagnose the problem.
+
+ The `-troff' option to MPto selects the Troff commands, rather than
+TeX. MetaPost supplies this automatically if the `-T' or `-troff'
+option was specified to MetaPost.
+
+ The MPX file created by MakeMPX is a sequence of MetaPost picture
+expressions, one for every label in the original MetaPost input file.
+
+ The names of the commands run by MakeMPX, and the directory added to
+the shell search `PATH' for the commands' location, are overridden by
+environment variables. Here is a list:
+
+`MAKEMPX_BINDIR'
+ The directory added to the `PATH'. Default is the `$(bindir)'
+ Make directory, which in turn is set from the configure-time
+ `--bindir', `--exec-prefix' and `--prefix' options; if nothing
+ else is specified, the default is file `/usr/local'.
+
+`NEWER'
+ The command run to determine if MPXFILE is out of date with respect
+ to MPFILE; default is `newer'.
+
+`MPTOTEX'
+ The command run to extract MetaPost labels in TeX format; default
+ is `mpto -tex'.
+
+`MPTOTR'
+ Likewise, for Troff; default is `mpto -troff'.
+
+`DVITOMP'
+ The command run to convert TeX output back to MetaPost; default is
+ `dvitomp'.
+
+`DMP'
+ Likewise, for Troff; default is `dmp'.
+
+`TEX'
+ The command run to typeset the labels in TeX; default is `tex'.
+ If you use LaTeX, set this to `latex', and supply an appropriate
+ `verbatimtex' header in the MP source (*note mpost invocation::).
+
+`TROFF'
+ Likewise, for Troff; default is `'eqn -d\$\$ | troff -Tpost''. You
+ may need to replace `-Tpost' by `-TTERM', where TERM is the
+ PostScript device name for your Troff implementation, e.g., `ps'
+ or `psc'; see troff(1).
+
+ If you change this, you will also need to set the `TRFONTS'
+ environment variable or configuration value to point to the
+ appropriate font directory, traditionally `/usr/lib/font/devTERM'.
+
+
+
+File: web2c.info, Node: dvitomp invocation, Next: dmp invocation, Prev: makempx invocation, Up: MetaPost
+
+6.4 DVItoMP: DVI to MPX conversion
+==================================
+
+DVItoMP converts DVI files into low-level MetaPost commands in a
+so-called MPX file. This program is generally invoked only by MakeMPX
+(*note makempx invocation::). Synopsis:
+
+ dvitomp DVIFILE[.dvi] [MPXFILE[.mpx]]
+
+If MPXFILE is not specified, the output goes to the basename of DVIFILE
+extended with `.mpx', e.g., `dvitomp /wherever/foo.dvi' creates
+`./foo.mpx'.
+
+ The only options are `-help' and `-version' (*note Common options::).
+
+
+File: web2c.info, Node: dmp invocation, Next: mpto invocation, Prev: dvitomp invocation, Up: MetaPost
+
+6.5 DMP: Ditroff to MPX conversion
+==================================
+
+DMP converts device-independent Troff (ditroff) output files into
+low-level MetaPost commands in a so-called MPX file. This program is
+generally invoked by MakeMPX (*note makempx invocation::). Synopsis:
+
+ dmp [DITROFF-FILE [MPXFILE]]
+
+If DITROFF-FILE is not specified, input comes from standard input; and
+if MPXFILE is not specified, output goes to standard output.
+
+ DMP was written to process the output of a Troff pipeline fed the
+output of `mpto -troff' (*note mpto invocation::). DMP understands all
+the `DC' graphics functions that `dpost' does, but it ignores `x X'
+device control functions such as `x X SetColor:...', `x X BeginPath:',
+and `x X DrawPath:...'.
+
+ The available font names are defined in the support file
+`trfonts.map', which DMP looks for along the `MPSUPPORT' path.
+
+ Another support file `trchars.adj', also looked for along the
+`MPSUPPORT' path, contains a character adjustment table which should
+reflect the shift amounts found in the standard PostScript prologue for
+Troff and dpost found in the `TRFONTS' directory. Such an adjustment
+table is unnecessary for some Troff implementations, in which case
+`trchars.adj' should be replaced by an empty file--but it must still
+exist.
+
+ DMP was written for one particular Troff implementation, and it
+unfortunately has many built-in assumptions about the output and fonts
+file formats used by Troff, which may not be satisfied in other
+environments. In particular, GNU groff uses some extensions in its file
+formats described in groff_font(5) and groff_out(5) which make its
+output completely unusable for DMP. On the other hand, the Troff
+version found in Sun Solaris 2.x, and perhaps other systems derived from
+System V R4, works fine with the default settings.
+
+ If you run into trouble and want to adapt DMP to other systems, you
+might have to try the following (this is primarily for hackers):
+
+ * If DMP complains about a missing font table (e.g., `Cannot find
+ TR'), your Troff may not support the device `post'.
+
+ Check troff(1) for the devices supported by your Troff and set the
+ `TROFF' environment variable appropriately (see above). Also,
+ locate the appropriate font directory and set the `TRFONTS'
+ variable as needed.
+
+ * If DMP complains about a missing font description file (e.g., `Font
+ TR was not in map file'), your version of Troff may be using
+ internal font names different from those in the distributed
+ `trfonts.map'; e.g., TR and TI instead of R and I for Times-Roman
+ and Times-Italic.
+
+ In this case, you may have to adapt `trfonts.map' and perhaps also
+ `trchars.adj' in the MetaPost support directory
+ (`texmf/metapost/support' by default).
+
+ * If DMP still complains that it cannot parse the font description
+ files or the Troff output (e.g., `TR has a bad line in its
+ description file', you are probably out of luck and have to hack
+ the DMP program (in `web2c/mpware/dmp.c').
+
+ Such problems may be caused by subtle differences in the file
+ formats, such as use of tabs vs. spaces as field separators or
+ decimal vs. octal vs. hex format for font metric data.
+
+ A reasonably good description of the expected Troff file formats
+ can be found in AT&T technical report CSTR-54 (`Troff User's
+ Manual', Revised 1992). Documentation on the subtle differences
+ in other Troff implementation is harder to find except for GNU
+ groff, where it's all documented in the above-mentioned
+ groff_font(5) and groff_out(5).
+
+ Any contributions to improve the portability of DMP or to make it
+ work with GNU groff are welcome, of course.
+
+
+ (Some of the above description was edited from the `dmp.c' source
+file, written by John Hobby.)
+
+ The only options are `--help' and `--version' (*note Common
+options::).
+
+
+File: web2c.info, Node: mpto invocation, Next: newer invocation, Prev: dmp invocation, Up: MetaPost
+
+6.6 MPto: Extract labels from MetaPost input
+============================================
+
+MPto extracts the labels from a MetaPost input file; this is the
+contents of any `btex...etex' and `verbatimtex...etex' sections. This
+program is generally invoked by MakeMPX (*note makempx invocation::).
+Synopsis:
+
+ mpto [OPTION]... MPFILE
+
+The input comes from MPFILE; no path searching is done. The output
+goes to standard output. Leading and trailing spaces and tabs are
+removed, and various predefined typesetter commands are included at the
+beginning of and end of the file and of each section.
+
+ The program accepts the following options, as well as the standard
+`-help' and `-version' (*note Common options::):
+`-troff'
+ Surround the MetaPost sections with Troff commands.
+
+`-tex'
+ Surround the MetaPost sections with TeX commands. This is the
+ default.
+
+
+File: web2c.info, Node: newer invocation, Prev: mpto invocation, Up: MetaPost
+
+6.7 Newer: Compare file modification times
+==========================================
+
+Newer compares file modification times. Synopsis:
+
+ newer SRC1 [ SRC2 ... SRCN ] TARGET
+
+Newer exits successfully if the files SRC1 ... SRCN exist and at least
+one of them is not older than DEPENDENT, i.e., the modification time
+(mtime) of at least one of the source files is greater than or the same
+as that of DEPENDENT. Newer also exits successfully if the file
+DEPENDENT doesn't exist. *Note Attribute Meanings: (libc)Attribute
+Meanings.
+
+ The program accepts the following option, as well as the standard
+`--help' and `--version' (*note Common options::):
+`--quiet'
+ Return result only, do not print any output.
+
+`--verbose'
+ List missing source files to STDERR. This is the default.
+
+ This is used by MakeMPX (*note makempx invocation::).
+
+
+File: web2c.info, Node: BibTeX, Next: WEB, Prev: MetaPost, Up: Top
+
+7 BibTeX: Bibliographies
+************************
+
+BibTeX automates much of the job of typesetting bibliographies, and
+makes bibliography entries reusable in many different contexts.
+
+* Menu:
+
+* bibtex invocation::
+* Basic BibTeX style files:: The standard and semi-standard styles.
+
+
+File: web2c.info, Node: bibtex invocation, Next: Basic BibTeX style files, Up: BibTeX
+
+7.1 BibTeX invocation
+=====================
+
+BibTeX creates a printable bibliography (`.bbl') file from references
+in a `.aux' file, generally written by TeX or LaTeX. The `.bbl' file
+is then incorporated on a subsequent run. The basic bibliographic
+information comes from `.bib' files, and a BibTeX style (`.bst') file
+controls the precise contents of the `.bbl' file. Synopsis:
+
+ bibtex [OPTION]... AUXFILE[.aux]
+
+The output goes to the basename of AUXFILE extended with `.bbl'; for
+example, `bibtex /wherever/foo.aux' creates `./foo.bbl'. BibTeX also
+writes a log file to the basename of AUXFILE extended with `.blg'.
+
+ The names of the `.bib' and `.bst' files are specified in the `.aux'
+file as well, via the `\bibliography' and `\bibliographystyle' (La)TeX
+macros. BibTeX searches for `.bib' files using the `BIBINPUTS' and
+`TEXBIB' paths, and for `.bst' files using `BSTINPUTS' (*note Supported
+file formats: (kpathsea)Supported file formats.). It does no path
+searching for `.aux' files.
+
+ The program accepts the following options, as well as the standard
+`-help' and `-version' (*note Common options::):
+`-terse'
+ Suppress the program banner and progress reports normally output.
+
+`-min-crossrefs=N'
+ If at least N (2 by default) bibliography entries refer to another
+ entry E via their `crossref' field, include E in the .bbl file,
+ even if it was not explicitly referenced in the .aux file. For
+ example, E might be a conference proceedings as a whole, with the
+ cross-referencing entries being individual articles published in
+ the proceedings. In some circumstances, you may want to avoid
+ these automatic inclusions altogether; to do this, make N a
+ sufficiently large number.
+
+ See also:
+`btxdoc.tex'
+ Basic LaTeXable documentation for general BibTeX users.
+
+`btxhak.tex'
+ LaTeXable documentation for style designers.
+
+`btxdoc.bib'
+ BibTeX database file for the two above documents.
+
+`xampl.bib'
+ Example database file with all the standard entry types.
+
+``ftp://ftp.math.utah.edu/pub/tex/bib/''
+ A very large `.bib' and `.bst' collection, including references
+ for all the standard TeX books and a complete bibliography for
+ TUGboat.
+
+
+File: web2c.info, Node: Basic BibTeX style files, Prev: bibtex invocation, Up: BibTeX
+
+7.2 Basic BibTeX style files
+============================
+
+Here are descriptions of the four standard and four semi-standard basic
+BibTeX styles. `CTAN:/biblio/bibtex' contains these and many more (for
+CTAN info, *note unixtex.ftp: (kpathsea)unixtex.ftp.).
+
+`plain'
+ Sorts entries alphabetically, with numeric labels. Generally
+ formatted according to van Leunen's `A Handbook for Scholars'.
+ The other style files listed here are based on `plain'.
+
+`abbrv'
+ First names, month names, and journal names are abbreviated.
+
+`acm'
+ Names are printed in small caps.
+
+`alpha'
+ Alphanumeric labels, e.g., `Knu66'.
+
+`apalike'
+ No labels at all; instead, the year appears in parentheses after
+ the author. Use this in conjunction with `apalike.tex' (plain
+ TeX) or `apalike.sty' (LaTeX), which also changes the citations in
+ the text to be `(AUTHOR, YEAR)'.
+
+`ieeetr'
+ Numeric labels, entries in citation order, IEEE abbreviations,
+ article titles in quotes.
+
+`siam'
+ Numeric labels, alphabetic order, `Math. Reviews' abbreviations,
+ names in small caps.
+
+`unsrt'
+ Lists entries in citation order, i.e., unsorted.
+
+`btxbst.doc'
+ The template file and documentation for the standard styles.
+
+
+
+File: web2c.info, Node: WEB, Next: DVI utilities, Prev: BibTeX, Up: Top
+
+8 WEB: Literate programming
+***************************
+
+"WEB" languages allow you to write a single source file that can
+produce both a compilable program and a well-formatted document
+describing the program in as much detail as you wish to prepare.
+Writing in this kind of dual-purpose language is called "literate
+programming". (The Usenet newsgroup `comp.programming.literate' and
+the mailing list <litprog@shsu.edu> are devoted to this subject; they
+are gatewayed to each other.)
+
+ WEB-like languages have been implemented with many pairs of base
+languages: Cweb provides C and Troff (*note References::); CWEB provides
+C and TeX (`CTAN:/web/c_cpp/cweb'); Spiderweb provides C, C++, Awk,
+Ada, many others, and TeX (`CTAN:/web/spiderweb'); and, of course, the
+original WEB provides Pascal and TeX, the implementation languages for
+the original TeX, Metafont, MetaPost, and related programs to come from
+the TeX project at Stanford.
+
+ The original WEB language is documented in the file `webman.tex',
+which is included in the `ftp://ftp.tug.org/tex/lib.tar.gz' archive
+(and available in many other places, of course).
+
+* Menu:
+
+* tangle invocation::
+* weave invocation::
+* pooltype invocation::
+
+
+File: web2c.info, Node: tangle invocation, Next: weave invocation, Up: WEB
+
+8.1 Tangle: Translate WEB to Pascal
+===================================
+
+Tangle creates a compilable Pascal program from a WEB source file
+(*note WEB::). Synopsis:
+
+ tangle [OPTION]... WEBFILE[.web] [CHANGEFILE[.ch]]
+
+The Pascal output is written to the basename of WEBFILE extended with
+`.p'; for example, `tangle /wherever/foo.web' creates `./foo.p'.
+Tangle applies CHANGEFILE to WEBFILE before writing the output; by
+default, there is no change file.
+
+ If the program makes use of the WEB string facility, Tangle writes
+the string pool to the basename of WEBFILE extended with `.pool'.
+
+ The Pascal output is packed into lines of 72 characters or less, with
+the only concession to readability being the termination of lines at
+semicolons when this can be done conveniently.
+
+ The program accepts the following options, as well as the standard
+`--help' and `--version' (*note Common options::):
+
+`-length=NUMBER'
+ The number of characters that are considered significant in an
+ identifier. Whether underline characters are counted depends on
+ the `-underline' option. The default value is 32, the original
+ tangle used 7, but this proved too restrictive for use by Web2c.
+
+`-lowercase'
+`-mixedcase'
+`-uppercase'
+ These options specify the case of identifiers in the output of
+ tangle. If `-uppercase' (`-lowercase') is specified, tangle will
+ convert all identfiers to uppercase (lowercase). The default is
+ `-mixedcase', which specifies that the case will not be changed.
+
+`-underline'
+ When this option is given, tangle does not strip underline
+ characters from identifiers.
+
+`-loose'
+`-strict'
+ These options specify how strict tangle must be when checking
+ identifiers for equality. The default is `-loose', which means
+ that tangle will follow the rules set by the case-smashing and
+ underline options above. If `-strict' is set, then identifiers
+ will always be stripped of underlines and converted to uppercase
+ before checking whether they collide.
+
+
+
+File: web2c.info, Node: weave invocation, Next: pooltype invocation, Prev: tangle invocation, Up: WEB
+
+8.2 Weave: Translate WEB to TeX
+===============================
+
+Weave creates a TeX document from a WEB source file (*note WEB::),
+assuming various macros defined in `webmac.tex'. It takes care of
+typographic details such as page layout, indentation, and italicizing
+identifiers. It also automatically gathers and outputs extensive
+cross-reference information. Synopsis:
+
+ weave [OPTION]... WEBFILE[.web] [CHANGEFILE[.ch]]
+
+The output is to the basename of WEBFILE extended with `.tex'; for
+example, `weave /wherever/foo.web' creates `./foo.tex'. Weave applies
+CHANGEFILE to WEBFILE before writing the output; by default, there is
+no change file.
+
+ The program accepts the following option, as well as the standard
+`-verbose', `-help' and `-version' (*note Common options::):
+`-x'
+ Omit the cross-reference information: the index, the list of WEB
+ module names, and the table of contents (an empty `CONTENTS.tex'
+ file will still be written when the Weave output file is processed
+ by TeX using the default `webmac.tex', though).
+
+ Conventionally, WEB programmers should define the TeX `\title' macro
+at the beginning of the source file. Also, to get output of only
+changed modules, one can say `\let\maybe=\iffalse' (usually as the
+first change in the change file).
+
+
+File: web2c.info, Node: pooltype invocation, Prev: weave invocation, Up: WEB
+
+8.3 Pooltype: Display WEB pool files
+====================================
+
+Pooltype shows the so-called "string number" of each string in a WEB
+pool file (*note WEB::), as output by Tangle (*note tangle
+invocation::), including the first 256 strings corresponding to the
+possible input characters. Pooltype primarily serves as an example of
+WEB conventions to implementors of the TeX system. Synopsis:
+
+ pooltype [OPTION]... POOLFILE[.pool]
+
+No path searching is done for POOLFILE. Output is to standard output.
+
+ The only options are `--help' and `--version' (*note Common
+options::).
+
+ As an example of the output, here is the (edited) output for
+`tex.pool':
+ 0: "^^@"
+ 1: "^^A"
+ ...
+ 255: "^^ff"
+ 256: "pool size"
+ ...
+ 1314: "Using character substitution: "
+ (23617 characters in all.)
+
+ In Metafont and MetaPost, the first 256 characters are actually
+represented as single bytes (i.e., themselves), not in the `^^'
+notation. Consider Pooltype as showing the results after conversion for
+output.
+
+
+File: web2c.info, Node: DVI utilities, Next: Font utilities, Prev: WEB, Up: Top
+
+9 DVI utilities
+***************
+
+TeX outputs a file in "DVI" (DeVice Independent) format as a compact
+representation of the original document. DVI files can be translated
+to meet the requirements of a real physical device, such as PostScript
+printers (*note Introduction: (dvips)Top.), PCL printers (see
+dvilj(1)), and X displays (see xdvi(1)). In fact, DVI translators are
+available for virtually all common devices: see `CTAN:/dviware' (for
+CTAN info, *note unixtex.ftp: (kpathsea)unixtex.ftp.).
+
+ For the precise definition of the DVI file format, see (for example)
+the source file `web2c/dvitype.web'.
+
+ The DVI-processing programs in the Web2c distribution are not device
+drivers; they perform generic utility functions.
+
+* Menu:
+
+* dvicopy invocation:: Expand virtual fonts.
+* dvitype invocation:: DVI to human-readable text.
+
+
+File: web2c.info, Node: dvicopy invocation, Next: dvitype invocation, Up: DVI utilities
+
+9.1 DVIcopy: Canonicalize virtual font references
+=================================================
+
+DVIcopy reads a DVI file, expands any references to virtual fonts
+(*note Virtual fonts: (dvips)Virtual fonts.) to base fonts, and writes
+the resulting DVI file. Thus you can use virtual fonts even if your DVI
+processor does not support them, by passing the documents through
+DVIcopy first. Synopsis:
+
+ dvicopy [OPTION]... [INDVI[.dvi] [OUTDVI[.dvi]]]
+
+ DVIcopy reads standard input if INDVI is not specified, and writes
+standard output if OUTDVI is not specified.
+
+ The program accepts the following options, as well as the standard
+`-help' and `-version' (*note Common options::):
+`-magnification=INTEGER'
+ Override existing magnification in INDVI with INTEGER; 1000
+ specifies no magnification. This is equivalent to setting TeX's
+ `\mag' parameter.
+
+`-max-pages=N'
+ Process N pages; default is one million.
+
+`-page-start=PAGE-SPEC'
+ Start at the first page matching PAGE-SPEC, which is one or more
+ (signed) integers separated by periods, corresponding to TeX's
+ `\count0...9' parameters at `\shipout' time; `*' matches anything.
+ Examples: `3', `1.*.-4'.
+
+
+File: web2c.info, Node: dvitype invocation, Prev: dvicopy invocation, Up: DVI utilities
+
+9.2 DVItype: Plain text transliteration of DVI files
+====================================================
+
+DVItype translates a DeVice Independent (DVI) file (as output by TeX,
+for example) to a plain text file that humans can read. It also serves
+as a DVI-validating program, i.e., if DVItype can read a file, it's
+correct. Synopsis:
+
+ dvitype [OPTION]... DVIFILE[.dvi]
+
+DVItype does not read any bitmap files, but it does read TFM files for
+fonts referenced in DVIFILE. The usual places are searched (*note
+Supported file formats: (kpathsea)Supported file formats.). To see all
+the relevant paths, set the environment variable `KPATHSEA_DEBUG' to
+`-1' before running the program.
+
+ Output goes to standard output.
+
+ The program accepts the following options, as well as the standard
+`-help' and `-version' (*note Common options::):
+`-dpi=REAL'
+ Do pixel movement calculations at REAL pixels per inch; default
+ 300.0.
+
+`-magnification=INTEGER'
+ Override existing magnification in INDVI with INTEGER; 1000
+ specifies no magnification. This is equivalent to setting TeX's
+ `\mag' parameter.
+
+`-max-pages=N'
+ Process N pages; default is one million.
+
+`-output-level=N'
+ Verbosity level of output, from 0 to 4 (default 4):
+ * 0: Global document information only.
+
+ * 1: Most DVI commands included, and typeset characters
+ summarized.
+
+ * 2: Character and movement commands explicitly included.
+
+ * 3: DVI stack and current position calculations included.
+
+ * 4: Same information as level 3, but DVItype does random
+ positioning in the file, reading the DVI postamble first.
+
+`-page-start=PAGE-SPEC'
+ Start at the first page matching PAGE-SPEC, which is one or more
+ (signed) integers separated by periods, corresponding to TeX's
+ `\count0...9' parameters at `\shipout' time; `*' matches anything.
+ Examples: `1', `5.*.-9'.
+
+`-show-opcodes'
+ Show numeric opcode values (in decimal) for DVI commands, in braces
+ after the command name. This can help in debugging DVI utilities.
+ We use decimal because in the DVI format documentation (in
+ `dvitype.web', among others) the opcodes are shown in decimal.
+
+* Menu:
+
+* dvitype output example::
+
+
+File: web2c.info, Node: dvitype output example, Up: dvitype invocation
+
+9.2.1 DVItype output example
+----------------------------
+
+As an example of the output from DVItype (see section above), here is
+its (abridged) translation of the `story.dvi' resulting from running
+the example in `The TeXbook', with `-output-level=4' and
+`-show-opcodes' on.
+
+ ...
+ Options selected:
+ Starting page = *
+ Maximum number of pages = 1000000
+ Output level = 4 (the works)
+ Resolution = 300.00000000 pixels per inch
+ numerator/denominator=25400000/473628672
+ magnification=1000; 0.00006334 pixels per DVI unit
+ ' TeX output 1992.05.17:0844'
+ Postamble starts at byte 564.
+ maxv=43725786, maxh=30785863, maxstackdepth=3, totalpages=1
+ Font 33: cmsl10---loaded at size 655360 DVI units
+ Font 23: cmbx10---loaded at size 655360 DVI units
+ Font 0: cmr10---loaded at size 655360 DVI units
+
+ 42: beginning of page 1
+ 87: push {141}
+ level 0:(h=0,v=0,w=0,x=0,y=0,z=0,hh=0,vv=0)
+ 88: down3 -917504 {159} v:=0-917504=-917504, vv:=-58
+ 92: pop {142}
+ ...
+ 104: putrule {137} height 26214, width 30785863 (2x1950 pixels)
+ 113: down3 5185936 {159} v:=655360+5185936=5841296, vv:=370
+ 117: push {141}
+ level 1:(h=0,v=5841296,w=0,x=0,y=0,z=0,hh=0,vv=370)
+ 118: right4 12265425 {146} h:=0+12265425=12265425, hh:=777
+ [ ]
+ 123: fntdef1 23 {243}: cmbx10
+ 145: fntnum23 {194} current font is cmbx10
+ 146: setchar65 h:=12265425+569796=12835221, hh:=813
+ 147: w3 251220 {150} h:=12835221+251220=13086441, hh:=829
+ 151: setchar83 h:=13086441+418700=13505141, hh:=856
+ ...
+ 164: setchar82 h:=17448202+565245=18013447, hh:=1142
+ 165: x0 -62805 {152} h:=18013447-62805=17950642, hh:=1138
+ 166: setchar89 h:=17950642+569796=18520438, hh:=1174
+ [A SHORT STORY]
+ 167: pop {142}
+ level 1:(h=0,v=5841296,w=0,x=0,y=0,z=0,hh=0,vv=370)
+ ...
+ 550: pop {142}
+ level 0:(h=0,v=42152922,w=0,x=0,y=0,z=0,hh=0,vv=2670)
+ 551: down3 1572864 {159} v:=42152922+1572864=43725786, vv:=2770
+ 555: push {141}
+ level 0:(h=0,v=43725786,w=0,x=0,y=0,z=0,hh=0,vv=2770)
+ 556: right4 15229091 {146} h:=0+15229091=15229091, hh:=965
+ 561: setchar49 h:=15229091+327681=15556772, hh:=986
+ [ 1]
+ 562: pop {142}
+ level 0:(h=0,v=43725786,w=0,x=0,y=0,z=0,hh=0,vv=2770)
+ 563: eop {140}
+
+ Explanation:
+
+ * The DVItype options are recorded at the beginning, followed by
+ global information about the document, including fonts used.
+
+ * Each DVI command is preceded by its byte position in the file
+ (`42:', `87:', ...), and (because of the `-show-opcodes') followed
+ by its decimal opcode value in braces (`{141}', `{142}', ...).
+
+ * The `level' lines record information about the DVI stack; `h' and
+ `v' define the current position in DVI units, while `hh' and `vv'
+ are the same in pixels.
+
+ * Text sequences are summarized in brackets, as in `[A SHORT STORY]'
+ and the `[ 1]'.
+
+
+File: web2c.info, Node: Font utilities, Next: Legalisms, Prev: DVI utilities, Up: Top
+
+10 Font utilities
+*****************
+
+The Web2c programs described here convert between various TeX-related
+font formats; the first section below briefly describes the formats.
+GFtoPK is the only one that is routinely used, as Metafont outputs GF
+format, but it's most efficient for device drivers to use PK.
+
+ The precise definitions of the PK, GF, TFM, PL, VF, and VPL formats
+mentioned below are in the source files that read them; `pktype.web',
+`gftype.web', `tftopl.web', etc.
+
+* Menu:
+
+* Font file formats:: Explanations of GF, PK, TFM, VF, ...
+* gftopk invocation:: GF -> PK (compact)
+* pktogf invocation:: PK -> GF (expand).
+* pktype invocation:: PK -> human-readable text.
+* gftype invocation:: GF -> human-readable text.
+* tftopl invocation:: TFM -> PL (for editing TFM).
+* pltotf invocation:: PL -> TFM (make editing results usable).
+* vftovp invocation:: VF -> VPL (tftopl for virtual fonts).
+* vptovf invocation:: VPL -> VF (pltotf for virtual fonts).
+* Font utilities available elsewhere:: Type 1, BDF, editors, etc.
+
+
+File: web2c.info, Node: Font file formats, Next: gftopk invocation, Up: Font utilities
+
+10.1 Font file formats
+======================
+
+(For another perspective on this, *note Font concepts: (dvips)Font
+concepts.).
+
+ Font files come in several varieties, with suffixes like:
+ .tfm .*pk .*gf .*pxl (obsolete) .pl .mf .vf .vpl
+ Each represents a file format.
+
+ A TFM (TeX font metric) file is a compact binary file that contains
+information about each character in a font, about combinations of
+characters within that font, and about the font as a whole. The font
+metric information contained in TFM files is device-independent units is
+used by TeX to do typesetting. Unlike the bitmap (raster) fonts
+described below, TFM font files contain no information about the shapes
+of characters. They describe rectangular areas and combinations
+thereof, but not what will eventually be printed in those areas.
+
+ Since TeX does scaling calculations, one TFM file serves for all
+magnifications of a given typeface. On the other hand, the best printed
+results are obtained when magnified (or reduced fonts) are not produced
+geometrically (as done by PostScript, for example) but rather optically,
+with each size a separate design (as done with Computer Modern and the
+EC fonts, for example); then a separate TFM file is needed for each
+size.
+
+ At any rate, TeX produces a DVI (DeVice Independent) file from your
+source document. In order to print DVI files on real devices, you need
+font files defining digitized character shapes and other data. Then
+previewers and printer-driver programs can translate your DVI files into
+something usable by your monitor or printer. Bitmap fonts come with
+suffixes such as `.600pk' or `.600gf' or `.3000pxl', where the `600' is
+the horizontal dots-per-inch resolution at which the font was produced,
+and the `pk' or `gf' or `pxl' indicates the font format. Outline fonts
+in PostScript Type 1 format have suffixes such as `.pfa' or `.pfb'.
+
+ Fonts in pk (packed) format are in the tightly packed raster format
+that is pretty much the standard today. They take up less space than
+fonts in the gf (generic font) format that Metafont generates, and far
+less space than fonts in pxl format. Fonts in pxl format take up gross
+amounts of disk space and permit only 128 characters. They are
+obsolete.
+
+ Font files with the `.pl' (property list) suffix are the plain text
+(human-readable) analog of the binary `.tfm' files. The TFtoPL and
+PLtoTF programs convert between the two formats (*note tftopl
+invocation:: and *Note pltotf invocation::).
+
+ Font files with the `.mf' suffix are in Metafont source format.
+These are the files used by Metafont to generate rastered fonts for
+specific typefaces at specific magnifications for the specific
+resolution and type of mapping used by your device.
+
+ The suffix `.vf' identifies "virtual font" files, for which `.vpl'
+is the human-readable analog. See *Note vftovp invocation::, and *Note
+vptovf invocation::. For further discussion of virtual fonts, see
+`CTAN:/doc/virtual-fonts.knuth', `CTAN:/help/virtualfonts.txt', and
+*Note Virtual fonts: (dvips)Virtual fonts.
+
+ (This section is based on documentation in the original Unix TeX
+distribution by Pierre MacKay and Elizabeth Tachikawa.)
+
+
+File: web2c.info, Node: gftopk invocation, Next: pktogf invocation, Prev: Font file formats, Up: Font utilities
+
+10.2 GFtoPK: Generic to packed font conversion
+==============================================
+
+GFtoPK converts a generic font (GF) file output by, for example,
+Metafont (*note mf invocation::) to a packed font (PK) file. PK files
+are considerably smaller than the corresponding gf files, so they are
+generally the bitmap font format of choice. Some DVI-processing
+programs, notably Dvips, only support PK files and not GF files.
+Synopsis:
+
+ gftopk [OPTION]... GFNAME.DPI[gf] [PKFILE]
+
+The font GFNAME is searched for in the usual places (*note Glyph
+lookup: (kpathsea)Glyph lookup.). To see all the relevant paths, set
+the environment variable `KPATHSEA_DEBUG' to `-1' before running the
+program.
+
+ The suffix `gf' is supplied if not already present. This suffix is
+not an extension; no `.' precedes it: for instance, `cmr10.600gf'.
+
+ If PKFILE is not specified, the output is written to the basename of
+`GFNAME.DPIpk', e.g., `gftopk /wherever/cmr10.600gf' creates
+`./cmr10.600pk'.
+
+ The only options are `--verbose', `--help', and `--version' (*note
+Common options::).
+
+
+File: web2c.info, Node: pktogf invocation, Next: pktype invocation, Prev: gftopk invocation, Up: Font utilities
+
+10.3 PKtoGF: Packed to generic font conversion
+==============================================
+
+PKtoGF converts a packed font (PK) file to a generic font (GF) file.
+Since PK format is much more compact than GF format, the most likely
+reason to do this is to run GFtype (*note gftype invocation::) on the
+result, so you can see the bitmap images. Also, a few old utility
+programs do not support PK format. Synopsis:
+
+ pktogf [OPTION]... PKNAME.DPI[pk] [GFFILE]
+
+The font PKNAME is searched for in the usual places (*note Glyph
+lookup: (kpathsea)Glyph lookup.). To see all the relevant paths, set
+the environment variable `KPATHSEA_DEBUG' to `-1' before running the
+program.
+
+ The suffix `pk' is supplied if not already present. This suffix is
+not an extension; no `.' precedes it: for instance, `cmr10.600pk'.
+
+ If GFFILE is not specified, the output is written to the basename of
+`PKNAME.DPIgf', e.g., `pktogf /wherever/cmr10.600pk' creates
+`./cmr10.600gf'.
+
+ The only options are `--verbose', `--help', and `--version' (*note
+Common options::).
+
+
+File: web2c.info, Node: pktype invocation, Next: gftype invocation, Prev: pktogf invocation, Up: Font utilities
+
+10.4 PKtype: Plain text transliteration of packed fonts
+=======================================================
+
+PKtype translates a packed font (PK) bitmap file (as output by GFtoPK,
+for example) to a plain text file that humans can read. It also serves
+as a PK-validating program, i.e., if PKtype can read a file, it's
+correct. Synopsis:
+
+ pktype PKNAME.DPI[pk]
+
+ The font PKNAME is searched for in the usual places (*note Glyph
+lookup: (kpathsea)Glyph lookup.). To see all the relevant paths, set
+the environment variable `KPATHSEA_DEBUG' to `-1' before running the
+program.
+
+ The suffix `pk' is supplied if not already present. This suffix is
+not an extension; no `.' precedes it: for instance, `cmr10.600pk'.
+
+ The translation is written to standard output.
+
+ The only options are `-help' and `-version' (*note Common options::).
+
+ As an example of the output, here is the (abridged) translation of
+the letter `K' in `cmr10', as rendered at 600dpi with the mode `ljfour'
+from `modes.mf' (available from `ftp://ftp.tug.org/tex/modes.mf').
+
+ 955: Flag byte = 184 Character = 75 Packet length = 174
+ Dynamic packing variable = 11
+ TFM width = 815562 dx = 4259840
+ Height = 57 Width = 57 X-offset = -3 Y-offset = 56
+ [2]23(16)17(8)9(25)11(13)7(27)7(16)7(28)4(18)7(28)2(20)7(27)...
+ ...
+ (14)9(24)12(5)[2]23(13)21
+
+Explanation:
+
+`955'
+ The byte position in the file where this character starts.
+
+`Flag byte'
+`Dynamic packing variable'
+ Related to the packing for this character; see the source code.
+
+`Character'
+ The character code, in decimal.
+
+`Packet length'
+ The total length of this character definition, in bytes.
+
+`TFM width'
+ The device-independent (TFM) width of this character. It is 2^24
+ times the ratio of the true width to the font's design size.
+
+`dx'
+ The device-dependent width, in "scaled pixels", i.e., units of
+ horizontal pixels times 2^16.
+
+`Height'
+`Width'
+ The bitmap height and width, in pixels.
+
+`X-offset'
+`Y-offset'
+ Horizontal and vertical offset from the upper left pixel to the
+ reference (origin) pixel for this character, in pixels (right and
+ down are positive). The "reference pixel" is the pixel that
+ occupies the unit square in Metafont; the Metafont reference point
+ is the lower left hand corner of this pixel. Put another way, the
+ x-offset is the negative of the left side bearing; the right side
+ bearing is the horizontal escapement minus the bitmap width plus
+ the x-offset.
+
+`[2]23(16)...'
+ Finally, run lengths of black pixels alternate with parenthesized
+ run lengths of white pixels, and brackets indicate a repeated row.
+
+
+File: web2c.info, Node: gftype invocation, Next: tftopl invocation, Prev: pktype invocation, Up: Font utilities
+
+10.5 GFtype: Plain text transliteration of generic fonts
+========================================================
+
+GFtype translates a generic font (GF) bitmap file (as output by
+Metafont, for example) to a plain text file that humans can read. It
+also serves as a GF-validating program, i.e., if GFtype can read a file,
+it's correct. Synopsis:
+
+ gftype [OPTION]... GFNAME.DPI[gf]
+
+ The font GFNAME is searched for in the usual places (*note Glyph
+lookup: (kpathsea)Glyph lookup.). To see all the relevant paths, set
+the environment variable `KPATHSEA_DEBUG' to `-1' before running the
+program.
+
+ The suffix `gf' is supplied if not already present. This suffix is
+not an extension; no `.' precedes it: for instance, `cmr10.600gf'.
+
+ The translation is written to standard output.
+
+ The program accepts the following options, as well as the standard
+`-help' and `-version' (*note Common options::):
+`-images'
+ Show the characters' bitmaps using asterisks and spaces.
+
+`-mnemonics'
+ Translate all commands in the GF file.
+
+ As an example of the output, here is the (abrdiged) translation of
+the letter `K' in `cmr10', as rendered at 600dpi with the mode `ljfour'
+from `modes.mf' (available from `ftp://ftp.tug.org/tex/modes.mf'), with
+both `-mnemonics' and `-images' enabled.
+
+ GFtype outputs the information about a character in two places: a
+main definition and a one-line summary at the end. We show both. Here
+is the main definition:
+
+ 2033: beginning of char 75: 3<=m<=60 0<=n<=56
+ (initially n=56) paint (0)24(12)20
+ 2043: newrow 0 (n=55) paint 24(12)20
+ 2047: newrow 0 (n=54) paint 24(12)20
+ 2051: newrow 0 (n=53) paint 24(12)20
+ 2055: newrow 7 (n=52) paint 10(21)13
+ 2059: newrow 8 (n=51) paint 8(23)9
+ ...
+ 2249: newrow 8 (n=5) paint 8(23)11
+ 2253: newrow 7 (n=4) paint 10(22)12
+ 2257: newrow 0 (n=3) paint 24(11)22
+ 2261: newrow 0 (n=2) paint 24(11)22
+ 2265: newrow 0 (n=1) paint 24(11)22
+ 2269: newrow 0 (n=0) paint 24(11)22
+ 2273: eoc
+ .<--This pixel's lower left corner is at (3,57) in METAFONT coordinates
+ ************************ ********************
+ ************************ ********************
+ ************************ ********************
+ ************************ ********************
+ ********** *************
+ ******** *********
+ ...
+ ******** ***********
+ ********** ************
+ ************************ **********************
+ ************************ **********************
+ ************************ **********************
+ ************************ **********************
+ .<--This pixel's upper left corner is at (3,0) in METAFONT coordinates
+
+Explanation:
+
+`2033'
+`2043'
+`...'
+ The byte position in the file where each GF command starts.
+
+`beginning of char 75'
+ The character code, in decimal.
+
+`3<=m<=60 0<=n<=56'
+ The character's bitmap lies between 3 and 60 (inclusive)
+ horizontally, and between 0 and 56 (inclusive) vertically. (m is a
+ column position and n is a row position.) Thus, 3 is the left side
+ bearing. The right side bearing is the horizontal escapement
+ (given below) minus the maximum m.
+
+`(initially n=56) paint (0)24(12)20'
+ The first row of pixels: 0 white pixels, 24 black pixels, 12 white
+ pixels, etc.
+
+`newrow 0 (n=55) paint 24(12)20'
+ The second row of pixels, with zero leading white pixels on the
+ row.
+
+`eoc'
+ The end of the main character definition.
+
+
+ Here is the GF postamble information that GFtype outputs at the end:
+
+ Character 75: dx 4259840 (65), width 815562 (64.57289), loc 2033
+
+ Explanation:
+
+`dx'
+ The device-dependent width, in "scaled pixels", i.e., units of
+ horizontal pixels times 2^16. The `(65)' is simply the same number
+ rounded. If the vertical escapement is nonzero, it would appear
+ here as a `dy' value.
+
+`width'
+ The device-independent (TFM) width of this character. It is 2^24
+ times the ratio of the true width to the font's design size. The
+ `64.57289' is the same number converted to pixels.
+
+`loc'
+ The byte position in the file where this character starts.
+
+
+
+File: web2c.info, Node: tftopl invocation, Next: pltotf invocation, Prev: gftype invocation, Up: Font utilities
+
+10.6 TFtoPL: TeX font metric to property list conversion
+========================================================
+
+TFtoPL translates a TeX font metric (TFM, *note Metric files:
+(dvips)Metric files.) file (as output by Metafont, for example) to
+"property list format" (a list of parenthesized items describing the
+font) that humans can edit or read. This program is mostly used by
+people debugging TeX implementations, writing font utilities, etc.
+Synopsis:
+
+ tftopl [OPTION]... TFMNAME[.tfm] [PLFILE[.pl]]
+
+ The font TFMNAME (extended with `.tfm' if necessary) is searched for
+in the usual places (*note Supported file formats: (kpathsea)Supported
+file formats.). To see all the relevant paths, set the environment
+variable `KPATHSEA_DEBUG' to `-1' before running the program.
+
+ If PLFILE (which is extended with `.pl' if necessary) is not
+specified, the property list file is written to standard output. The
+property list file can be converted back to TFM format by the companion
+program TFtoPL (see the next section).
+
+ The program accepts the following option, as well as the standard
+`-verbose', `-help' and `-version' (*note Common options::):
+`-charcode-format=TYPE'
+ Output character codes in the PL file according to TYPE: either
+ `octal' or `ascii'. Default is `ascii' for letters and digits,
+ octal for all other characters. Exception: if the font's coding
+ scheme starts with `TeX math sy' or `TeX math ex', all character
+ codes are output in octal.
+
+ In `ascii' format, character codes that correspond to graphic
+ characters, except for left and right parentheses, are output as a
+ `C' followed by the single character: `C K', for example. In
+ octal format, character codes are output as the letter `O' followed
+ by octal digits, as in `O 113' for `K'.
+
+ `octal' format is useful for symbol and other non-alphabetic fonts,
+ where using ASCII characters for the character codes is merely
+ confusing.
+
+ As an example of the output, here is the (abridged) property list
+translation of `cmr10.tfm':
+
+ (FAMILY CMR)
+ (FACE O 352)
+ (CODINGSCHEME TEX TEXT)
+ (DESIGNSIZE R 10.0)
+ (COMMENT DESIGNSIZE IS IN POINTS)
+ (COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+ (CHECKSUM O 11374260171)
+ (FONTDIMEN
+ (SLANT R 0.0)
+ (SPACE R 0.333334)
+ (STRETCH R 0.166667)
+ (SHRINK R 0.111112)
+ (XHEIGHT R 0.430555)
+ (QUAD R 1.000003)
+ (EXTRASPACE R 0.111112)
+ )
+ (LIGTABLE
+ ...
+ (LABEL C f)
+ (LIG C i O 14)
+ (LIG C f O 13)
+ (LIG C l O 15)
+ (KRN O 47 R 0.077779)
+ (KRN O 77 R 0.077779)
+ (KRN O 41 R 0.077779)
+ (KRN O 51 R 0.077779)
+ (KRN O 135 R 0.077779)
+ (STOP)
+ ...
+ )
+ ...
+ (CHARACTER C f
+ (CHARWD R 0.305557)
+ (CHARHT R 0.694445)
+ (CHARIC R 0.077779)
+ (COMMENT
+ (LIG C i O 14)
+ (LIG C f O 13)
+ (LIG C l O 15)
+ (KRN O 47 R 0.077779)
+ (KRN O 77 R 0.077779)
+ ...
+ )
+ )
+ ...
+
+ As you can see, the general format is a list of parenthesized
+"properties", nested where necessary.
+
+ * The first few items (`FAMILY', `FACE', and so on) are the
+ so-called "headerbyte" information from Metafont, giving general
+ information about the font.
+
+ * The `FONTDIMEN' property defines the TeX `\fontdimen' values.
+
+ * The `LIGTABLE' property defines the ligature and kerning table.
+ `LIG' properties define ligatures: in the example above, an `f'
+ (in the `LABEL') followed by an `i' is a ligature, i.e., a
+ typesetting program like TeX replaces those two consecutive
+ characters by the character at position octal '014 in the current
+ font--presumably the `fi' ligature. `KRN' properties define
+ kerns: if an `f' is followed by character octal '047 (an
+ apostrophe), TeX inserts a small amount of space between them:
+ 0.077779 times the design size the font was loaded at (about
+ three-quarters of a printer's point by default in this case, or
+ .001 inches).
+
+ * The `CHARACTER' property defines the dimensions of a character: its
+ width, height, depth, and italic correction, also in design-size
+ units, as explained in the previous item. For our example `f',
+ the depth is zero, so that property is omitted. TFtoPL also
+ inserts any kerns and ligatures for this character as a comment.
+
+
+
+File: web2c.info, Node: pltotf invocation, Next: vftovp invocation, Prev: tftopl invocation, Up: Font utilities
+
+10.7 PLtoTF: Property list to TeX font metric conversion
+========================================================
+
+PLtoTF translates a property list file (as output by TFtoPL, for
+example) to TeX font metric (TFM, *note Metric files: (dvips)Metric
+files.) format. It's much easier for both programs and humans to
+create the (plain text) property list files and let PLtoTF take care of
+creating the binary TFM equivalent than to output TFM files directly.
+Synopsis:
+
+ pltotf [OPTION]... PLFILE[.pl] [TFMFILE[.tfm]]
+
+ If TFMFILE (extended with `.tfm' if necessary) is not specified, the
+TFM file is written to the basename of `PLFILE.tfm', e.g., `pltotf
+/wherever/cmr10.pl' creates `./cmr10.tfm'. (Since TFM files are
+binary, writing to standard output by default is undesirable.)
+
+ The only options are `-verbose', `-help', and `-version' (*note
+Common options::).
+
+ For an example of property list format, see the previous section.
+
+
+File: web2c.info, Node: vftovp invocation, Next: vptovf invocation, Prev: pltotf invocation, Up: Font utilities
+
+10.8 VFtoVP: Virtual font to virtual property lists
+===================================================
+
+VFtoVP translates a virtual font metric (VF, *note Virtual fonts:
+(dvips)Virtual fonts.) file and its accompanying TeX font metric (TFM,
+*note Metric files: (dvips)Metric files.) file (as output by VPtoVF, for
+example) to "virtual property list format" (a list of parenthesized
+items describing the virtual font) that humans can edit or read. This
+program is mostly used by people debugging virtual font utilities.
+Synopsis:
+
+ vftovp [OPTION]... VFNAME[.vf] [TFMNAME[.tfm] [VPLFILE[.vpl]]]
+
+ The fonts VFNAME and TFMNAME (extended with `.vf' and `.tfm' if
+necessary) are searched for in the usual places (*note Supported file
+formats: (kpathsea)Supported file formats.). To see all the relevant
+paths, set the environment variable `KPATHSEA_DEBUG' to `-1' before
+running the program. If TFMNAME is not specified, VFNAME (without a
+trailing `.vf') is used.
+
+ If VPLFILE (extended with `.vpl' if necessary) is not specified, the
+property list file is written to standard output. The property list
+file can be converted back to VF and TFM format by the companion
+program VFtoVP (see the next section).
+
+ The program accepts the following option, as well as the standard
+`-verbose', `-help' and `-version' (*note Common options::):
+`-charcode-format=TYPE'
+ Output character codes in the PL file according to TYPE: either
+ `octal' or `ascii'. Default is `ascii' for letters and digits,
+ octal for all other characters. Exception: if the font's coding
+ scheme starts with `TeX math sy' or `TeX math ex', all character
+ codes are output in octal.
+
+ In `ascii' format, character codes that correspond to graphic
+ characters, except for left and right parentheses, are output as a
+ `C' followed by the single character: `C K', for example. In
+ octal format, character codes are output as the letter `O' followed
+ by octal digits, as in `O 113' for `K'.
+
+ `octal' format is useful for symbol and other non-alphabetic fonts,
+ where using ASCII characters for the character codes is merely
+ confusing.
+
+
+File: web2c.info, Node: vptovf invocation, Next: Font utilities available elsewhere, Prev: vftovp invocation, Up: Font utilities
+
+10.9 VPtoVF: Virtual property lists to virtual font
+===================================================
+
+VPtoVF translates a virtual property list file (as output by VFtoVP, for
+example) to virtual font (VF, *note Virtual fonts: (dvips)Virtual
+fonts.) and TeX font metric (TFM, *note Metric files: (dvips)Metric
+files.) files. It's much easier for both programs and humans to create
+the (plain text) property list files and let VPtoVF take care of
+creating the binary VF and TFM equivalents than to output them
+directly. Synopsis:
+
+ vptovf [OPTION]... VPLFILE[.vpl] [VFFILE[.vf] [TFMFILE[.tfm]]]
+
+ If VFFILE (extended with `.vf' if necessary) is not specified, the
+VF output is written to the basename of `VPLFILE.vf'; similarly for
+TFMFILE. For example, `vptovf /wherever/ptmr.vpl' creates `./ptmr.vf'
+and `./ptmr.tfm'.
+
+ The only options are `-verbose', `-help', and `-version' (*note
+Common options::).
+
+
+File: web2c.info, Node: Font utilities available elsewhere, Prev: vptovf invocation, Up: Font utilities
+
+10.10 Font utilities available elsewhere
+========================================
+
+The Web2c complement of font utilities merely implements a few basic
+conversions. Many other more sophisticated font utilities exist; most
+are in `CTAN:/fonts/utilities' (for CTAN info, *note unixtex.ftp:
+(kpathsea)unixtex.ftp.). Here are some of the most commonly-requested
+items:
+
+ * AFM (Adobe font metric) to TFM conversion: *note Invoking afm2tfm:
+ (dvips)Invoking afm2tfm, and `CTAN:/fonts/utilities/afmtopl'.
+
+ * BDF (the X bitmap format) conversion:
+ `ftp://ftp.tug.org/tex/bdf.tar.gz'.
+
+ * Creating fonts using MetaPost: MetaType1.
+ `ftp://bop.eps.gda.pl/pub/metatype1'. This is used to create the
+ excellent Latin Modern font family (`CTAN:/fonts/lm'), which
+ extends Computer Modern to a vast repertoire of scripts.
+
+ * Editing of bitmap fonts: Xbfe from the GNU font utilities mentioned
+ below; the X BDF-editing programs available from
+ `ftp://ftp.x.org/R5contrib/xfed.tar.Z' and
+ `ftp://ftp.x.org/R5contrib/xfedor.tar.Z'; and finally, if your
+ fonts have only 128 characters, you can use the old `gftopxl',
+ `pxtoch', and `chtopx' programs from `ftp://ftp.tug.org/tex/web'.
+
+ * Editing of outline fonts: FontForge, `fontforge.sourceforge.net'.
+ This is a very elaborate program with support for many outline
+ formats (Type 1, OpenType, TrueType, ...), and many advanced font
+ editing features.
+
+ * PK bitmaps from PostScript outline fonts: gsftopk from the `xdvi'
+ distribution. Alternatively, `ps2pk', from
+ `CTAN:/fonts/utilities/ps2pk'.
+
+ * PostScript Type 1 font format conversion (i.e., between PFA and PFB
+ formats): `ftp://ftp.tug.org/tex/t1utils.tar.gz'.
+
+ * Scanned image conversion: the (aging) GNU font utilities convert
+ type specimen images to Metafont, PostScript, etc.:
+ `http://www.gnu.org/software/fontutils/'.
+
+ * Tracing bitmaps to fitted outlines: Autotrace
+ (`http://autotrace.sourceforge.net'), Potrace
+ (`http://potrace.sourceforge.net'). For Metafont fonts, either of
+ the two programs `mftrace'
+ (`http://www.xs4all.nl/~hanwen/mftrace') or `textrace'
+ (`http://textrace.sourceforge.net') make the job easier.
+
+ * Virtual font creation: `CTAN:/fonts/utilities/fontinst'.
+
+
+File: web2c.info, Node: Legalisms, Next: References, Prev: Font utilities, Up: Top
+
+Appendix A Legalisms
+********************
+
+In general, each file has its own copyright notice stating the copying
+permissions for that file. Following is a summary.
+
+ The Web2c system itself and most of the original WEB source files are
+public domain.
+
+ `tex.web', the MLTeX code, `mf.web', and `bibtex.web', are
+copyrighted by their authors. They may be copied verbatim, but may be
+modified only through a `.ch' file.
+
+ MetaPost-related files, including `mp.web' itself, are copyrighted
+under X-like terms; the precise notice is included below.
+
+ Finally, the Kpathsea library is covered by the GNU Lesser General
+Public License (*note Introduction: (kpathsea)Introduction.).
+Therefore, the _binaries_ resulting from a standard Web2c compilation
+are also covered by the LGPL; so if you (re)distribute the binaries,
+you must also (offer to) distribute the complete source that went into
+those binaries. See the file `LGPL' for complete details on the LGPL.
+
+ The following notice must be included by the terms of the MetaPost
+copyright.
+
+ Permission to use, copy, modify, and distribute this software and
+ its documentation for any purpose and without fee is hereby
+ granted, provided that the above copyright notice appear in all
+ copies and that both that the copyright notice and this permission
+ notice and warranty disclaimer appear in supporting documentation,
+ and that the names of AT&T Bell Laboratories or any of its
+ entities not be used in advertising or publicity pertaining to
+ distribution of the software without specific, written prior
+ permission.
+
+ AT&T disclaims all warranties with regard to this software,
+ including all implied warranties of merchantability and fitness.
+ In no event shall AT&T be liable for any special, indirect or
+ consequential damages or any damages whatsoever resulting from
+ loss of use, data or profits, whether in an action of contract,
+ negligence or other tortious action, arising out of or in
+ connection with the use or performance of this software.
+
+
+File: web2c.info, Node: References, Next: Index, Prev: Legalisms, Up: Top
+
+Appendix B References
+*********************
+
+ 1. Kpathsea: *Note Introduction: (kpathsea)Top.
+
+ 2. Dvips and Afm2tfm: *Note Introduction: (dvips)Top.
+
+ 3. The TeX Users Group: `http://www.tug.org'. For an introduction to
+ the TeX system, see `http://tug.org/begin.html'.
+
+ 4. TUGboat: `http://tug.org/TUGboat'.
+
+ 5. TeX and computer typesetting in general:
+ `ftp://ftp.math.utah.edu/pub/tex/bib/texbook1.bib'.
+
+ 6. For a bibliography of formal articles and technical reports on the
+ TeX project, see the books `TeX: The Program' or `Metafont: The
+ Program' cited below.
+
+ 7. [Bil87] Neenie Billawala. Write-white printing engines and tuning
+ fonts with Metafont. `TUGboat', 8(1):29-32, April 1987.
+
+ 8. [GMS94] Michel Goossens, Frank Mittelbach, and Alexander Samarin.
+ `The LaTeX Companion'. Addison-Wesley, Reading, MA, USA, 1994.
+
+ 9. [Hob89] John D. Hobby. A Metafont-like system with PS output.
+ `TUGboat', 10(4):505-512, December 1989.
+
+ 10. [Hob92] John D. Hobby. A User's Manual for MetaPost. Technical
+ Report CSTR-162, AT&T Bell Laboratories, 1992.
+
+ 11. [Hob93] John D. Hobby. Drawing Graphs with MetaPost. Technical
+ Report CSTR-164, AT&T Bell Laboratories, 1993.
+
+ 12. [HS91] Samuel P. Harbison and Guy L. Steele Jr. `C--A Reference
+ Manual'. Prentice-Hall, Upper Saddle River, NJ 07458, USA, third
+ edition, 1991. An authoritative reference to the C programming
+ language, and a good companion to Kernighan and Ritchie.
+
+ 13. [KL93] Donald E. Knuth and Silvio Levy. `The CWEB System of
+ Structured Documentation, Version 3.0'. Addison-Wesley, Reading,
+ MA, USA, 1993.
+
+ 14. [Knu84] Donald E. Knuth. A torture test for TeX. Report No.
+ STAN-CS-84-1027, Stanford University, Department of Computer
+ Science, 1984.
+
+ 15. [Knu86a] Donald E. Knuth. A Torture Test for METAFONT. Report
+ No. STAN-CS-86-1095, Stanford University, Department of Computer
+ Science, 1986.
+
+ 16. [Knu86b] Donald E. Knuth. `The TeXbook', volume A of `Computers
+ and Typesetting'. Addison-Wesley, Reading, MA, USA, 1986.
+
+ 17. [Knu86c] Donald E. Knuth. `TeX: The Program', volume B of
+ `Computers and Typesetting'. Addison-Wesley, Reading, MA, USA,
+ 1986.
+
+ 18. [Knu86d] Donald E. Knuth. `The METAFONTbook', volume C of
+ `Computers and Typesetting'. Addison-Wesley, Reading, MA, USA,
+ 1986.
+
+ 19. [Knu86e] Donald E. Knuth. `METAFONT: The Program', volume D of
+ `Computers and Typesetting'. Addison-Wesley, Reading, MA, USA,
+ 1986.
+
+ 20. [Knu86f] Donald E. Knuth. `Computer Modern Typefaces', volume E
+ of `Computers and Typesetting'. Addison-Wesley, Reading, MA,
+ USA, 1986.
+
+ 21. [Knu89] Donald E. Knuth. The errors of TeX. `Software--Practice
+ and Experience', 19(7):607-681, July 1989. This is an updated
+ version of iteKnuth:1988:ET.
+
+ 22. [Knu90] Donald Knuth. Virtual Fonts: More Fun for Grand Wizards.
+ `TUGboat', 11(1):13-23, April 1990.
+
+ 23. [Knu92] Donald E. Knuth. `Literate Programming'. CSLI Lecture
+ Notes Number 27. Stanford University Center for the Study of
+ Language and Information, Stanford, CA, USA, 1992.
+
+ 24. [Lam94] Leslie Lamport. `LaTeX: A Document Preparation System:
+ User's Guide and Reference Manual'. Addison-Wesley, Reading,
+ MA, USA, second edition, 1994. Reprinted with corrections in 1996.
+
+ 25. [Lia83] Franklin Mark Liang. Word hy-phen-a-tion by com-pu-ter.
+ Technical Report STAN-CS-83-977, Stanford University, August 1983.
+
+ 26. [Mac91] Pierre A. MacKay. Looking at the pixels: Quality control
+ for 300 dpi laser printer fonts, especially Metafonts. In
+ Robert A. Morris and Jacques Andre, editors, `Raster Imaging and
+ Digital Typography II--Papers from the second RIDT meeting, held in
+ Boston, Oct. 14-16, 1991', pages 205-215, New York, 1991.
+ Cambridge University Press.
+
+ 27. [Spi89] Michael D. Spivak. `LAMSTeX, The Synthesis'. The
+ TeXplorators Corporation, 3701 W. Alabama, Suite 450-273, Houston,
+ TX 77027, USA, 1989.
+
+ 28. [Spi90] Michael D. Spivak. `The Joy of TeX--A Gourmet Guide to
+ Typesetting with the AMSTeX macro package'. American
+ Mathematical Society, Providence, RI, USA, 2nd revised edition,
+ 1990.
+
+
+
+File: web2c.info, Node: Index, Prev: References, Up: Top
+
+Index
+*****
+
+
+* Menu:
+
+* #define options: Compile-time options.
+ (line 6)
+* $ expansion in filenames: \input filenames. (line 48)
+* %& magic number: Determining the memory dump to use.
+ (line 20)
+* - starting a filename: Option conventions. (line 19)
+* - starts option names: Option conventions. (line 11)
+* -- starts option names: Option conventions. (line 11)
+* --disable-dump-share configure option: Hardware and memory dumps.
+ (line 6)
+* --enable-ipc configure option: tex invocation. (line 101)
+* --help common option: Common options. (line 11)
+* --quiet (newer): newer invocation. (line 20)
+* --verbose (newer): newer invocation. (line 23)
+* --verbose common option: Common options. (line 15)
+* --version common option: Common options. (line 18)
+* --with-editor=CMD: Editor invocation. (line 10)
+* --with-epsfwin: Online Metafont graphics.
+ (line 20)
+* --with-hp2627win: Online Metafont graphics.
+ (line 28)
+* --with-mftalkwin: Online Metafont graphics.
+ (line 31)
+* --with-next: Online Metafont graphics.
+ (line 35)
+* --with-regiswin: Online Metafont graphics.
+ (line 40)
+* --with-suntoolswin: Online Metafont graphics.
+ (line 43)
+* --with-tektronixwin: Online Metafont graphics.
+ (line 48)
+* --with-unitermwin: Online Metafont graphics.
+ (line 51)
+* --with-x: Online Metafont graphics.
+ (line 57)
+* --with-x-toolkit=KIT: Online Metafont graphics.
+ (line 60)
+* --with-x11: Online Metafont graphics.
+ (line 57)
+* --with-x11win: Online Metafont graphics.
+ (line 57)
+* -8bit: Common options. (line 103)
+* -base=BASE: Determining the memory dump to use.
+ (line 15)
+* -base=DUMPNAME: Common options. (line 34)
+* -change=CHFILE: mft invocation. (line 64)
+* -charcode-format=TYPE <1>: vftovp invocation. (line 31)
+* -charcode-format=TYPE: tftopl invocation. (line 28)
+* -D compiler options: Compile-time options.
+ (line 6)
+* -dpi=REAL: dvitype invocation. (line 24)
+* -enc: tex invocation. (line 95)
+* -file-line-error: Common options. (line 25)
+* -file-line-error-style: Common options. (line 26)
+* -fmt=DUMPNAME: Common options. (line 34)
+* -fmt=FMT: Determining the memory dump to use.
+ (line 15)
+* -geometry, supported with Xt: Online Metafont graphics.
+ (line 66)
+* -halt-on-error: Common options. (line 41)
+* -images: gftype invocation. (line 26)
+* -ini <1>: Initial and virgin. (line 12)
+* -ini: Common options. (line 45)
+* -interaction=STRING: Common options. (line 51)
+* -ipc: tex invocation. (line 101)
+* -ipc-start: tex invocation. (line 101)
+* -jobname=STRING: Common options. (line 56)
+* -kpathsea-debug=NUMBER: Common options. (line 60)
+* -length=NUMBER: tangle invocation. (line 27)
+* -loose: tangle invocation. (line 46)
+* -lowercase: tangle invocation. (line 35)
+* -magnification=INTEGER <1>: dvitype invocation. (line 28)
+* -magnification=INTEGER: dvicopy invocation. (line 20)
+* -max-pages=N <1>: dvitype invocation. (line 33)
+* -max-pages=N: dvicopy invocation. (line 25)
+* -mem=DUMPNAME: Common options. (line 34)
+* -mem=MEM: Determining the memory dump to use.
+ (line 15)
+* -min-crossrefs=N: bibtex invocation. (line 31)
+* -mixedcase: tangle invocation. (line 35)
+* -mktex=FILETYPE <1>: mf invocation. (line 87)
+* -mktex=FILETYPE: tex invocation. (line 111)
+* -mltex: tex invocation. (line 115)
+* -mnemonics: gftype invocation. (line 29)
+* -no-file-line-error: Common options. (line 26)
+* -no-mktex=FILETYPE <1>: mf invocation. (line 87)
+* -no-mktex=FILETYPE: tex invocation. (line 111)
+* -no-parse-first-line: Common options. (line 78)
+* -no-shell-escape: tex invocation. (line 128)
+* -oem: Common options. (line 108)
+* -output-comment=STRING: tex invocation. (line 120)
+* -output-directory <1>: Output file location.
+ (line 15)
+* -output-directory: Common options. (line 67)
+* -output-level=N: dvitype invocation. (line 36)
+* -overflow-label-offset=POINTS: gftodvi invocation. (line 49)
+* -page-start=PAGE-SPEC <1>: dvitype invocation. (line 50)
+* -page-start=PAGE-SPEC: dvicopy invocation. (line 28)
+* -parse-first-line: Common options. (line 77)
+* -progname=STRING <1>: Determining the memory dump to use.
+ (line 18)
+* -progname=STRING: Common options. (line 83)
+* -recorder: Common options. (line 90)
+* -shell-escape: tex invocation. (line 127)
+* -show-opcodes: dvitype invocation. (line 56)
+* -strict: tangle invocation. (line 46)
+* -style=MFTFILE: mft invocation. (line 68)
+* -T: mpost invocation. (line 117)
+* -terse: bibtex invocation. (line 28)
+* -tex: mpto invocation. (line 24)
+* -tex=TEXPROGRAM: mpost invocation. (line 121)
+* -translate-file=TCXFILE: Common options. (line 96)
+* -troff <1>: mpto invocation. (line 21)
+* -troff <2>: makempx invocation. (line 39)
+* -troff: mpost invocation. (line 117)
+* -underline: tangle invocation. (line 41)
+* -uppercase: tangle invocation. (line 35)
+* -x: weave invocation. (line 22)
+* ., used for output: Output file location.
+ (line 6)
+* .2602gf: mf invocation. (line 48)
+* .aux cross-reference files: bibtex invocation. (line 6)
+* .base: Initial Metafont. (line 6)
+* .bbl bibliography files: bibtex invocation. (line 6)
+* .bib bibliography databases: bibtex invocation. (line 6)
+* .blg BibTeX log file: bibtex invocation. (line 14)
+* .fmt: Initial TeX. (line 6)
+* .mem: Initial MetaPost. (line 6)
+* .mf: mf invocation. (line 24)
+* .mp: mpost invocation. (line 31)
+* .NNN PostScript figures: mpost invocation. (line 37)
+* .NNNgf generic fonts: mf invocation. (line 34)
+* .tcx character translation files <1>: TCX files. (line 6)
+* .tcx character translation files: Common options. (line 96)
+* .tex: tex invocation. (line 20)
+* .tfm output <1>: mpost invocation. (line 37)
+* .tfm output: mf invocation. (line 43)
+* .Xdefaults: Online Metafont graphics.
+ (line 66)
+* .Xresources: Online Metafont graphics.
+ (line 66)
+* 2602gf: mf invocation. (line 48)
+* 8 bit clean: Common options. (line 103)
+* 8 bit clean output, specifying: Common options. (line 103)
+* 8-bit characters: TCX files. (line 6)
+* \bibliography: bibtex invocation. (line 18)
+* \bibliographystyle: bibtex invocation. (line 18)
+* \charsubdef and MLTeX: \charsubdef. (line 6)
+* \countN <1>: dvitype invocation. (line 50)
+* \countN: dvicopy invocation. (line 28)
+* \font and dynamic generation: tex invocation. (line 44)
+* \fontdimen: tftopl invocation. (line 100)
+* \immediate\write18: tex invocation. (line 128)
+* \input filenames: \input filenames. (line 6)
+* \mag <1>: dvitype invocation. (line 28)
+* \mag: dvicopy invocation. (line 20)
+* \openout and security: tex invocation. (line 51)
+* \string: \input filenames. (line 60)
+* \tracingcharsubdef and MLTeX: \tracingcharsubdef. (line 6)
+* \tracinglostchars and MLTeX: \tracingcharsubdef. (line 11)
+* \write18 shell escape extension: tex invocation. (line 128)
+* ^^ notation, avoiding: TCX files. (line 88)
+* `Computer Modern Typefaces', production of: mft invocation. (line 75)
+* abbrv.bst: Basic BibTeX style files.
+ (line 16)
+* accented character: TCX files. (line 6)
+* accents, hyphenating words with: MLTeX. (line 6)
+* acknowledgements: Introduction. (line 51)
+* acm.bst: Basic BibTeX style files.
+ (line 19)
+* Ada, WEB for: WEB. (line 14)
+* additional Make targets: Additional targets. (line 6)
+* AFM to TFM conversion: Font utilities available elsewhere.
+ (line 12)
+* afm2tfm: Font utilities available elsewhere.
+ (line 12)
+* afmtopl: Font utilities available elsewhere.
+ (line 12)
+* aliases for fonts: Path searching. (line 15)
+* alpha.bst: Basic BibTeX style files.
+ (line 22)
+* American Mathematical Society, typesetting system: Formats. (line 39)
+* AMSTeX: Formats. (line 39)
+* apalike.bst: Basic BibTeX style files.
+ (line 25)
+* Arabic typesetting: TeX extensions. (line 25)
+* architecture dependencies: Hardware and memory dumps.
+ (line 6)
+* array limit, fixed: Runtime options. (line 36)
+* array sizes: Runtime options. (line 6)
+* assembly language routines: Compile-time options.
+ (line 22)
+* autotrace: Font utilities available elsewhere.
+ (line 46)
+* Awk, WEB for: WEB. (line 14)
+* base file, determining: Determining the memory dump to use.
+ (line 6)
+* base files: Initial Metafont. (line 6)
+* base files, need mode definitions: Modes. (line 6)
+* base files, plain only: Initial Metafont. (line 28)
+* base files, sharing: Hardware and memory dumps.
+ (line 6)
+* bases Make target: Additional targets. (line 29)
+* basic BibTeX style files: Basic BibTeX style files.
+ (line 6)
+* basic fonts and macros: Installation. (line 34)
+* batch languages: TeX. (line 9)
+* BDF and GF conversion: Font utilities available elsewhere.
+ (line 15)
+* beginfig: mpost invocation. (line 37)
+* BeginPath ditroff command: dmp invocation. (line 15)
+* Berry, Karl: Introduction. (line 41)
+* BIBINPUTS, search path for bib files: bibtex invocation. (line 18)
+* bibliographies, creating: BibTeX. (line 6)
+* bibliography: References. (line 6)
+* bibliography items, cross-referenced: bibtex invocation. (line 31)
+* bibtex: bibtex invocation. (line 6)
+* BibTeX: BibTeX. (line 6)
+* BibTeX collection: bibtex invocation. (line 54)
+* BibTeX style files: Basic BibTeX style files.
+ (line 6)
+* BigEndian machines: Hardware and memory dumps.
+ (line 6)
+* binaries, linking: Common options. (line 83)
+* blank lines, in TCX files: TCX files. (line 67)
+* Bourne shell commands in TeX: tex invocation. (line 128)
+* boxes, memory for: Runtime options. (line 20)
+* breakpoints, memory for: Runtime options. (line 20)
+* Breitenlohner, Peter: Introduction. (line 9)
+* BSTINPUTS, search path for bst files: bibtex invocation. (line 18)
+* btex and label extraction: mpto invocation. (line 6)
+* btex for MetaPost labels: mpost invocation. (line 50)
+* btxdoc.bib: bibtex invocation. (line 48)
+* btxdoc.tex: bibtex invocation. (line 42)
+* btxhak.tex: bibtex invocation. (line 45)
+* byte position <1>: gftype invocation. (line 76)
+* byte position: pktype invocation. (line 40)
+* byte swapping: Hardware and memory dumps.
+ (line 13)
+* c-sources Makefile target: Additional targets. (line 12)
+* captions, extracting from MetaPost input: mpto invocation. (line 6)
+* captions, for MetaPost: makempx invocation. (line 6)
+* change files, and MFT: mft invocation. (line 64)
+* change files, and Tangle: tangle invocation. (line 11)
+* change files, and Weave: weave invocation. (line 14)
+* changing error messages style: Common options. (line 26)
+* character codes, in GFtype output: gftype invocation. (line 79)
+* character codes, in PKtype output: pktype invocation. (line 47)
+* character codes, in TCX files: TCX files. (line 78)
+* character proofs of fonts: gftodvi invocation. (line 6)
+* CHARACTER property: tftopl invocation. (line 114)
+* character translation files: TCX files. (line 6)
+* CHARDP property: tftopl invocation. (line 114)
+* CHARHT property: tftopl invocation. (line 114)
+* CHARIC property: tftopl invocation. (line 114)
+* CHARWD property: tftopl invocation. (line 114)
+* chtopx: Font utilities available elsewhere.
+ (line 23)
+* class name for Metafont: Online Metafont graphics.
+ (line 66)
+* cm.base: Initial Metafont. (line 28)
+* cmbase.mf: Initial Metafont. (line 28)
+* cmbase.mft: mft invocation. (line 75)
+* cmmf.base not recommended: Initial Metafont. (line 28)
+* comments, in TCX files: TCX files. (line 71)
+* comments, MFT control: mft invocation. (line 24)
+* common options: Common options. (line 6)
+* commonalities: Commonalities. (line 6)
+* comparing file modification times: newer invocation. (line 6)
+* compilation: Installation. (line 6)
+* compile-time options <1>: Compile-time options.
+ (line 6)
+* compile-time options: configure options. (line 6)
+* Computer Modern fonts, and Troff: mpost invocation. (line 73)
+* Computer Modern macros: Initial Metafont. (line 28)
+* configuration: Installation. (line 6)
+* configuration file reading: Path searching. (line 6)
+* configuration file values: Runtime options. (line 6)
+* configuration, compile-time: configure options. (line 6)
+* configure --with/--enable options: configure options. (line 6)
+* CONTENTS.tex: weave invocation. (line 22)
+* control sequence names, space for: Runtime options. (line 29)
+* conventions for options,: Option conventions. (line 6)
+* conversion, DVI to plain text: dvitype invocation. (line 6)
+* conversion, GF to PK: gftopk invocation. (line 6)
+* conversion, GF to plain text: gftype invocation. (line 6)
+* conversion, PK to GF: pktogf invocation. (line 6)
+* conversion, PK to plain text: pktype invocation. (line 6)
+* conversion, property list to TFM: pltotf invocation. (line 6)
+* conversion, property list to VF: vptovf invocation. (line 6)
+* conversion, TFM to property list: tftopl invocation. (line 6)
+* conversion, VF to VPL: vftovp invocation. (line 6)
+* copyright notices: Legalisms. (line 6)
+* Cork encoding and ISO input: TCX files. (line 49)
+* creating memory dumps: Creating memory dumps.
+ (line 6)
+* cross-referenced bibliography items: bibtex invocation. (line 31)
+* cross-references, omitting: weave invocation. (line 22)
+* current directory, used for output: Output file location.
+ (line 6)
+* Curtis, Pavel: Introduction. (line 41)
+* CWEB: WEB. (line 14)
+* Cweb: WEB. (line 14)
+* D C ditroff graphics: dmp invocation. (line 15)
+* date and time, in memory dumps: Hardware and memory dumps.
+ (line 30)
+* debugging DVI utilities: dvitype invocation. (line 56)
+* debugging flags, specifying: Common options. (line 60)
+* decimal character codes, in TCX files: TCX files. (line 78)
+* dependencies, hardware: Hardware and memory dumps.
+ (line 6)
+* design-size units: tftopl invocation. (line 102)
+* device definitions, for Metafont: Modes. (line 6)
+* device-independent width <1>: gftype invocation. (line 113)
+* device-independent width: pktype invocation. (line 53)
+* directory structure: Installation. (line 34)
+* DISPLAY: Online Metafont graphics.
+ (line 73)
+* ditroff output, converting to MPX: dmp invocation. (line 6)
+* DMP <1>: dmp invocation. (line 6)
+* DMP: makempx invocation. (line 71)
+* DMP, invoked by MakeMPX: makempx invocation. (line 29)
+* dmp.c: dmp invocation. (line 82)
+* dot files, written by TeX programs: tex invocation. (line 51)
+* downloading of fonts for MetaPost labels: mpost invocation. (line 78)
+* dpost: dmp invocation. (line 15)
+* DrawingServant: Online Metafont graphics.
+ (line 35)
+* DrawPath ditroff command: dmp invocation. (line 15)
+* dump file: Common options. (line 34)
+* dumping memory: Memory dumps. (line 6)
+* DVI comment, specifying: tex invocation. (line 120)
+* DVI files, converting to MPX: dvitomp invocation. (line 6)
+* DVI files, creating multiple: TeX extensions. (line 31)
+* DVI files, explained: Font file formats. (line 30)
+* DVI format definition: DVI utilities. (line 14)
+* DVI opcodes, showing: dvitype invocation. (line 56)
+* DVI utilities: DVI utilities. (line 6)
+* dvicopy: dvicopy invocation. (line 6)
+* dvitomp: dvitomp invocation. (line 6)
+* DVITOMP: makempx invocation. (line 67)
+* DVItoMP, invoked by MakeMPX: makempx invocation. (line 29)
+* dvitype DVI validation: dvitype invocation. (line 6)
+* dvitype output example: dvitype output example.
+ (line 6)
+* dvitype.web: DVI utilities. (line 14)
+* dx horizontal escapement <1>: gftype invocation. (line 107)
+* dx horizontal escapement: pktype invocation. (line 57)
+* dy vertical escapement: gftype invocation. (line 107)
+* dynamic array allocation: Runtime options. (line 36)
+* dynamic Metafont mode definitions with smode: Modes. (line 28)
+* dynamic packing variable: pktype invocation. (line 44)
+* e response at error prompt: Editor invocation. (line 6)
+* e-circumflex: \charsubdef. (line 21)
+* e-TeX: TeX extensions. (line 11)
+* e.mft: mft invocation. (line 75)
+* EC fonts <1>: mf invocation. (line 24)
+* EC fonts: tex invocation. (line 44)
+* editing of bitmap fonts: Font utilities available elsewhere.
+ (line 23)
+* editor invoked at error: Editor invocation. (line 6)
+* eight-bit characters in filenames: \input filenames. (line 35)
+* empty.tcx: TCX files. (line 49)
+* endian dependencies: Hardware and memory dumps.
+ (line 6)
+* eoc GF command: gftype invocation. (line 97)
+* Eplain: Formats. (line 54)
+* epsf: Online Metafont graphics.
+ (line 19)
+* errors, editor invoked at: Editor invocation. (line 6)
+* escapement, horizontal <1>: gftype invocation. (line 107)
+* escapement, horizontal: pktype invocation. (line 57)
+* escapement, vertical: gftype invocation. (line 107)
+* etex and label extraction: mpto invocation. (line 6)
+* etex for MetaPost labels: mpost invocation. (line 50)
+* executables, shared initial and virgin: Initial and virgin. (line 6)
+* expanded plain format: Formats. (line 54)
+* extensions to TeX: TeX extensions. (line 6)
+* extra_mem_bot: Runtime options. (line 19)
+* FACE property: tftopl invocation. (line 96)
+* FAMILY property: tftopl invocation. (line 96)
+* Ferguson, Michael: MLTeX. (line 6)
+* file formats for fonts: Font file formats. (line 6)
+* file mtimes, comparing: newer invocation. (line 6)
+* file recorder: Common options. (line 90)
+* File-handling TeX: TeX extensions. (line 31)
+* filename conventions, in input files: \input filenames. (line 6)
+* filenames starting with -: Option conventions. (line 19)
+* first line of the main input file: Common options. (line 96)
+* fixed-point arithmetic: Compile-time options.
+ (line 22)
+* FIXPT: Compile-time options.
+ (line 22)
+* flag byte: pktype invocation. (line 44)
+* floating-point arithmetic: Compile-time options.
+ (line 22)
+* floating-point values: Hardware and memory dumps.
+ (line 22)
+* fmt file, determining: Determining the memory dump to use.
+ (line 6)
+* fmt files: Initial TeX. (line 6)
+* fmt files, sharing: Hardware and memory dumps.
+ (line 6)
+* fmts Make target: Additional targets. (line 25)
+* font aliases: Path searching. (line 15)
+* font character code, translating: TCX files. (line 102)
+* font design: Metafont. (line 6)
+* font downloading for MetaPost labels: mpost invocation. (line 78)
+* font file formats: Font file formats. (line 6)
+* font proofs: gftodvi invocation. (line 6)
+* font utilities: Font utilities. (line 6)
+* font utilities, non-Web2c: Font utilities available elsewhere.
+ (line 6)
+* font_mem_size: Runtime options. (line 24)
+* fontforge: Font utilities available elsewhere.
+ (line 30)
+* fontinst, for creating virtual fonts: Font utilities available elsewhere.
+ (line 53)
+* fonts, basic: Installation. (line 34)
+* fontutils: Font utilities available elsewhere.
+ (line 42)
+* format files: Initial TeX. (line 15)
+* formats for TeX: Formats. (line 6)
+* formats Make target: Additional targets. (line 17)
+* fraction routines: Compile-time options.
+ (line 22)
+* Free Software Foundation documentation system: Formats. (line 47)
+* freedom of Web2c: Introduction. (line 23)
+* ftp.math.utah.edu: bibtex invocation. (line 54)
+* generating source specials: tex invocation. (line 146)
+* geometric designs: Metafont. (line 6)
+* geometric font scaling: Font file formats. (line 22)
+* geometry for Metafont: Online Metafont graphics.
+ (line 66)
+* getopt_long_only: Option conventions. (line 6)
+* GF files, explained: Font file formats. (line 40)
+* GF files, output by Metafont: mf invocation. (line 34)
+* GF format definition: Font utilities. (line 11)
+* GF output: mf invocation. (line 34)
+* GF, converting PK to: pktogf invocation. (line 6)
+* GF, converting to PK: gftopk invocation. (line 6)
+* gftodvi: gftodvi invocation. (line 6)
+* gftopk: gftopk invocation. (line 6)
+* gftopxl: Font utilities available elsewhere.
+ (line 23)
+* gftype GF validation: gftype invocation. (line 6)
+* gftype.web: Font utilities. (line 11)
+* glue ratio representations: Hardware and memory dumps.
+ (line 22)
+* glue, memory for: Runtime options. (line 20)
+* glyph substitutions: MLTeX. (line 6)
+* gray font: gftodvi invocation. (line 29)
+* Gruff, Billy Goat: Triptrap. (line 6)
+* gsftopk: Font utilities available elsewhere.
+ (line 35)
+* Harbison, Samuel P.: Hardware and memory dumps.
+ (line 34)
+* hardware and memory dumps: Hardware and memory dumps.
+ (line 6)
+* hash table, increasing size of: Runtime options. (line 29)
+* hash_extra: Runtime options. (line 28)
+* headerbyte information: tftopl invocation. (line 96)
+* height, in pixels: pktype invocation. (line 62)
+* help, online: Common options. (line 11)
+* Henry, Patrick: Introduction. (line 23)
+* Herberts, Mathias: Online Metafont graphics.
+ (line 20)
+* hex character codes, in TCX files: TCX files. (line 78)
+* history: Introduction. (line 41)
+* Hobby, John <1>: dmp invocation. (line 82)
+* Hobby, John: Introduction. (line 9)
+* horizontal escapement <1>: gftype invocation. (line 107)
+* horizontal escapement: pktype invocation. (line 57)
+* hp2627: Online Metafont graphics.
+ (line 27)
+* human languages, supported in TeX: Languages and hyphenation.
+ (line 6)
+* human-readable text, converting DVI to: dvitype invocation. (line 6)
+* human-readable text, converting GF to: gftype invocation. (line 6)
+* human-readable text, converting PK to: pktype invocation. (line 6)
+* human-readable text, converting TFM to: tftopl invocation. (line 6)
+* human-readable text, converting VF to: vftovp invocation. (line 6)
+* hyphenation and languages: Languages and hyphenation.
+ (line 6)
+* hyphenation patterns, creating: patgen invocation. (line 6)
+* ice cream: Introduction. (line 23)
+* identifier case: tangle invocation. (line 35)
+* identifier collisions: tangle invocation. (line 46)
+* identifier length: tangle invocation. (line 27)
+* identifiers with underlines: tangle invocation. (line 41)
+* ieeetr.bst: Basic BibTeX style files.
+ (line 31)
+* il1-t1.tcx: TCX files. (line 49)
+* il2-t1.tcx: TCX files. (line 49)
+* Info format: Formats. (line 47)
+* initial form, enabling: Common options. (line 45)
+* initial Metafont: Initial Metafont. (line 6)
+* initial MetaPost: Initial MetaPost. (line 6)
+* initial programs: Initial and virgin. (line 24)
+* initial TeX: Initial TeX. (line 6)
+* initializations, lengthy: Initial and virgin. (line 24)
+* input filenames: \input filenames. (line 6)
+* install-bases Make target: Additional targets. (line 29)
+* install-fmts Make target: Additional targets. (line 25)
+* install-formats Make target: Additional targets. (line 17)
+* install-mems Make target: Additional targets. (line 34)
+* installation: Installation. (line 6)
+* interaction between TCX files and -8bit.: TCX files. (line 105)
+* interaction mode: Common options. (line 51)
+* international characters: TCX files. (line 6)
+* introduction: Introduction. (line 6)
+* IPC: IPC and TeX. (line 6)
+* IPC_DEBUG <1>: IPC and TeX. (line 13)
+* IPC_DEBUG: Compile-time options.
+ (line 29)
+* job name: Common options. (line 56)
+* kerning table, in TFM files: tftopl invocation. (line 102)
+* keyboard character code, translating: TCX files. (line 102)
+* Knuth, Donald E. <1>: mft invocation. (line 58)
+* Knuth, Donald E.: Introduction. (line 9)
+* KPATHSEA_DEBUG: Common options. (line 60)
+* KRN property: tftopl invocation. (line 102)
+* label font: gftodvi invocation. (line 36)
+* LABEL property: tftopl invocation. (line 102)
+* labels, extracting from MetaPost input: mpto invocation. (line 6)
+* labels, for MetaPost: makempx invocation. (line 6)
+* language support in TeX: Languages and hyphenation.
+ (line 6)
+* languages, hyphenation rules for: patgen invocation. (line 6)
+* LaTeX: Formats. (line 22)
+* Latin Modern: Font utilities available elsewhere.
+ (line 18)
+* left side bearing <1>: gftype invocation. (line 82)
+* left side bearing: pktype invocation. (line 66)
+* legalisms: Legalisms. (line 6)
+* licensing terms: Introduction. (line 23)
+* LIG property: tftopl invocation. (line 102)
+* ligature table, in TFM files: tftopl invocation. (line 102)
+* LIGTABLE property: tftopl invocation. (line 102)
+* linking binaries: Common options. (line 83)
+* links to binaries: Determining the memory dump to use.
+ (line 32)
+* literate programming: WEB. (line 6)
+* litprog@shsu.edu: WEB. (line 6)
+* LittleEndian machines: Hardware and memory dumps.
+ (line 6)
+* log file, BibTeX: bibtex invocation. (line 14)
+* machine dependencies: Hardware and memory dumps.
+ (line 6)
+* machine-readable, converting property lists to <1>: vptovf invocation.
+ (line 6)
+* machine-readable, converting property lists to: pltotf invocation.
+ (line 6)
+* MacKay, Pierre: Font file formats. (line 63)
+* macro packages, major TeX: Formats. (line 6)
+* macros, basic: Installation. (line 34)
+* macros, predefining in memory dumps: Memory dumps. (line 6)
+* magnification <1>: dvitype invocation. (line 28)
+* magnification: dvicopy invocation. (line 20)
+* main_memory: Runtime options. (line 15)
+* Make targets, additional: Additional targets. (line 6)
+* makempx: makempx invocation. (line 6)
+* MAKEMPX_BINDIR: makempx invocation. (line 50)
+* Martin, Rick: Introduction. (line 51)
+* Mathematical Reviews: Formats. (line 39)
+* mathematical typesetting: TeX. (line 6)
+* mem file, determining: Determining the memory dump to use.
+ (line 6)
+* mem files: Initial MetaPost. (line 6)
+* mem files, plain only: Initial MetaPost. (line 16)
+* mem files, sharing: Hardware and memory dumps.
+ (line 6)
+* memory dump to use, determining: Determining the memory dump to use.
+ (line 6)
+* memory dumps: Memory dumps. (line 6)
+* memory dumps and hardware: Hardware and memory dumps.
+ (line 6)
+* memory dumps, contain date and time: Hardware and memory dumps.
+ (line 30)
+* memory dumps, creating: Creating memory dumps.
+ (line 6)
+* mems Make target: Additional targets. (line 34)
+* meta characters in filenames: \input filenames. (line 35)
+* Metafont: Metafont. (line 6)
+* Metafont geometry: Online Metafont graphics.
+ (line 66)
+* Metafont graphics: Online Metafont graphics.
+ (line 6)
+* Metafont input files: mf invocation. (line 24)
+* Metafont invocation: mf invocation. (line 6)
+* Metafont meets PostScript: MetaPost. (line 6)
+* Metafont online support, new devices: Online Metafont graphics.
+ (line 77)
+* Metafont source, prettyprinting: mft invocation. (line 6)
+* Metafont, compatibility in MetaPost: Initial MetaPost. (line 25)
+* Metafont, initial: Initial Metafont. (line 6)
+* Metafont, MetaPost, and TeX: Three programs. (line 6)
+* MetaFun, enhanced MetaPost: Initial MetaPost. (line 33)
+* metafun.mp: Initial MetaPost. (line 33)
+* MetaPost: MetaPost. (line 6)
+* MetaPost and plain Metafont compatibility: Initial MetaPost.
+ (line 25)
+* MetaPost input files: mpost invocation. (line 31)
+* MetaPost input, extracting labels from: mpto invocation. (line 6)
+* MetaPost invocation: mpost invocation. (line 6)
+* MetaPost labels: makempx invocation. (line 6)
+* MetaPost source, prettyprinting: mft invocation. (line 80)
+* MetaPost, initial: Initial MetaPost. (line 6)
+* MetaPost, TeX, and Metafont: Three programs. (line 6)
+* metatype1: Font utilities available elsewhere.
+ (line 18)
+* mf: mf invocation. (line 6)
+* mf.base: Initial Metafont. (line 16)
+* MFEDIT: Editor invocation. (line 10)
+* mfplain.mem: Initial MetaPost. (line 25)
+* mfput: mf invocation. (line 34)
+* mft: mft invocation. (line 6)
+* mftalk: Online Metafont graphics.
+ (line 30)
+* MFTERM: Online Metafont graphics.
+ (line 11)
+* mftmac.tex: mft invocation. (line 6)
+* mktexmf, disabling: mf invocation. (line 24)
+* mktextfM, disabling: tex invocation. (line 44)
+* mltex: MLTeX. (line 6)
+* MLTeX, enabling: tex invocation. (line 115)
+* mode needed to run Metafont: mf invocation. (line 48)
+* mode_def: Modes. (line 15)
+* mode_setup: Modes. (line 15)
+* modes file needed for Metafont: Modes. (line 6)
+* modes.mf recommended modes file: Modes. (line 10)
+* Morgan, Tim: Introduction. (line 41)
+* Morris, Bob: Introduction. (line 51)
+* MPEDIT: Editor invocation. (line 10)
+* mpgraph.ps: mpost invocation. (line 19)
+* mpman.ps: mpost invocation. (line 6)
+* mpost: mpost invocation. (line 6)
+* mpost, reason for name change: Installation. (line 19)
+* mpost.mem: Initial MetaPost. (line 16)
+* mpout: mpost invocation. (line 37)
+* mproof.tex: mpost invocation. (line 78)
+* MPSUPPORT: dmp invocation. (line 21)
+* MPto: mpto invocation. (line 6)
+* MPto, invoked by MakeMPX: makempx invocation. (line 21)
+* MPTOTEX: makempx invocation. (line 60)
+* MPTOTR: makempx invocation. (line 64)
+* mptrap Make target: Additional targets. (line 41)
+* mptrap test: Triptrap. (line 6)
+* mptrap.readme: Triptrap. (line 6)
+* mpx file, defined: makempx invocation. (line 43)
+* MPX files, converting from DVI files: dvitomp invocation. (line 6)
+* MPX files, creating from ditroff output: dmp invocation. (line 6)
+* mpxerr: makempx invocation. (line 34)
+* mpxerr.dvi: makempx invocation. (line 34)
+* mpxerr.log: makempx invocation. (line 34)
+* mpxerr.t: makempx invocation. (line 34)
+* mpxerr.tex: makempx invocation. (line 34)
+* mtimes of files, comparing: newer invocation. (line 6)
+* Multi-lingual TeX: MLTeX. (line 6)
+* multiple DVI files, creating: TeX extensions. (line 31)
+* N tilde: \charsubdef. (line 37)
+* new graphics support for Metafont: Online Metafont graphics.
+ (line 77)
+* NEWER: makempx invocation. (line 56)
+* newer file comparison: newer invocation. (line 6)
+* newrow GF command: gftype invocation. (line 93)
+* next: Online Metafont graphics.
+ (line 34)
+* NO_X11WIN: Online Metafont graphics.
+ (line 56)
+* non-Unix system, compiling on: Additional targets. (line 12)
+* NUL, not allowed in filenames: \input filenames. (line 35)
+* octal character codes, in TCX files: TCX files. (line 78)
+* offset for overflow labels: gftodvi invocation. (line 49)
+* older-than, file comparisons: newer invocation. (line 6)
+* Omega: TeX extensions. (line 16)
+* online Metafont graphics: Online Metafont graphics.
+ (line 6)
+* opcodes, showing DVI: dvitype invocation. (line 56)
+* optical font scaling: Font file formats. (line 22)
+* option conventions: Option conventions. (line 6)
+* origin: pktype invocation. (line 66)
+* output directory, specifying <1>: Output file location.
+ (line 15)
+* output directory, specifying: Common options. (line 67)
+* output file location: Output file location.
+ (line 6)
+* output files, written by TeX programs: tex invocation. (line 51)
+* output_comment for DVI files: tex invocation. (line 120)
+* overflow label offset: gftodvi invocation. (line 49)
+* packet length: pktype invocation. (line 50)
+* page, starting <1>: dvitype invocation. (line 50)
+* page, starting: dvicopy invocation. (line 28)
+* parsing the first line: Common options. (line 78)
+* Pascal, creating from WEB: tangle invocation. (line 6)
+* patgen: patgen invocation. (line 6)
+* path searching: Path searching. (line 6)
+* path searching debugging: Common options. (line 60)
+* PDF: TeX extensions. (line 20)
+* pdfTeX: TeX extensions. (line 20)
+* permissions, legal: Legalisms. (line 6)
+* PFA and PFB conversion: Font utilities available elsewhere.
+ (line 39)
+* pfaedit: Font utilities available elsewhere.
+ (line 30)
+* PiCTeX, increasing memory for: Runtime options. (line 20)
+* picture expressions: makempx invocation. (line 43)
+* pixel height: pktype invocation. (line 62)
+* pixel width: pktype invocation. (line 62)
+* PK bitmaps from PostScript: Font utilities available elsewhere.
+ (line 35)
+* PK files, explained: Font file formats. (line 40)
+* PK files, not output by Metafont: mf invocation. (line 34)
+* PK format definition: Font utilities. (line 11)
+* PK, converting GF to: gftopk invocation. (line 6)
+* PK, converting to GF: pktogf invocation. (line 6)
+* pktogf: pktogf invocation. (line 6)
+* pktype PK validation: pktype invocation. (line 6)
+* pktype.web: Font utilities. (line 11)
+* PL files, explained: Font file formats. (line 47)
+* plain Metafont, compatibility in MetaPost: Initial MetaPost.
+ (line 25)
+* plain text, converting DVI to: dvitype invocation. (line 6)
+* plain text, converting GF to: gftype invocation. (line 6)
+* plain text, converting PK to: pktype invocation. (line 6)
+* plain text, converting TFM to: tftopl invocation. (line 6)
+* plain text, converting VF to: vftovp invocation. (line 6)
+* plain.base: Initial Metafont. (line 16)
+* plain.bst: Basic BibTeX style files.
+ (line 11)
+* plain.fmt: Initial TeX. (line 15)
+* plain.mem: Initial MetaPost. (line 16)
+* plain.mft: mft invocation. (line 68)
+* pltotf: pltotf invocation. (line 6)
+* pool file, writing: tangle invocation. (line 16)
+* Poole, Simon: Online Metafont graphics.
+ (line 50)
+* pooltype: pooltype invocation. (line 6)
+* portable filenames: \input filenames. (line 41)
+* PostScript fonts, and Troff: mpost invocation. (line 73)
+* PostScript meets Metafont: MetaPost. (line 6)
+* PostScript output: mpost invocation. (line 37)
+* PostScript to PK bitmaps: Font utilities available elsewhere.
+ (line 35)
+* PostScript Type 1 font conversion: Font utilities available elsewhere.
+ (line 39)
+* PostScript, and font scaling: Font file formats. (line 22)
+* potrace: Font utilities available elsewhere.
+ (line 46)
+* Pragma ADE: Initial MetaPost. (line 33)
+* predefined macros and memory dumps: Memory dumps. (line 6)
+* prettyprinting Metafont source: mft invocation. (line 6)
+* prettyprinting WEB programs: weave invocation. (line 6)
+* primitives, new: TeX extensions. (line 11)
+* printable characters, specifying: TCX files. (line 88)
+* printer characteristics, for Metafont: Modes. (line 6)
+* production use: Initial and virgin. (line 20)
+* program name, determines memory dump: Determining the memory dump to use.
+ (line 32)
+* program names, special <1>: tex invocation. (line 115)
+* program names, special: Common options. (line 45)
+* prologues: mpost invocation. (line 117)
+* prologues and Troff in MetaPost: makempx invocation. (line 39)
+* prologues, and EPSF output: mpost invocation. (line 88)
+* proof mode: mf invocation. (line 48)
+* proof sheets, of fonts: gftodvi invocation. (line 6)
+* property list format: tftopl invocation. (line 44)
+* property list, converting TFM to: tftopl invocation. (line 6)
+* property list, converting VF to virtual: vftovp invocation. (line 6)
+* ps2pk: Font utilities available elsewhere.
+ (line 35)
+* psfonts.map, read by MetaPost: mpost invocation. (line 88)
+* PXL files, explained: Font file formats. (line 40)
+* pxtoch: Font utilities available elsewhere.
+ (line 23)
+* Raichle, Bernd: MLTeX. (line 6)
+* reading, additional: Introduction. (line 59)
+* readonly directory, running TeX in: Output file location.
+ (line 15)
+* reallocation of arrays: Runtime options. (line 36)
+* redefined character substitutions: \tracingcharsubdef. (line 6)
+* reference pixel: pktype invocation. (line 66)
+* references: References. (line 6)
+* regis: Online Metafont graphics.
+ (line 39)
+* Regis graphics support: Online Metafont graphics.
+ (line 40)
+* regression testing: tex invocation. (line 120)
+* repeated rows: pktype invocation. (line 76)
+* representation of strings: pooltype invocation. (line 30)
+* right side bearing <1>: gftype invocation. (line 82)
+* right side bearing: pktype invocation. (line 66)
+* right-to-left typesetting: TeX extensions. (line 25)
+* Rokicki, Tomas: Introduction. (line 41)
+* run length encoded bitmaps <1>: gftype invocation. (line 89)
+* run length encoded bitmaps: pktype invocation. (line 76)
+* runtime options: Runtime options. (line 6)
+* scaled pixels <1>: gftype invocation. (line 107)
+* scaled pixels: pktype invocation. (line 57)
+* scaling of fonts: Font file formats. (line 22)
+* scanned images of fonts: Font utilities available elsewhere.
+ (line 42)
+* security, and \openout: tex invocation. (line 51)
+* security, and output files: tex invocation. (line 51)
+* security, and shell escapes: tex invocation. (line 128)
+* SetColor ditroff command: dmp invocation. (line 15)
+* shapes: Metafont. (line 6)
+* sharing memory dumps: Hardware and memory dumps.
+ (line 6)
+* shell commands in TeX: tex invocation. (line 128)
+* shell_escape enabling in TeX: tex invocation. (line 128)
+* siam.bst: Basic BibTeX style files.
+ (line 35)
+* side bearings <1>: gftype invocation. (line 82)
+* side bearings: pktype invocation. (line 66)
+* slant font: gftodvi invocation. (line 39)
+* slides, producing: Formats. (line 61)
+* SliTeX: Formats. (line 61)
+* small Metafont memory and modes: Modes. (line 15)
+* smode and dynamic Metafont mode definition: Modes. (line 28)
+* sockets: IPC and TeX. (line 6)
+* space-terminated filenames: \input filenames. (line 10)
+* Spiderweb: WEB. (line 14)
+* Stallman, Richard: Introduction. (line 51)
+* starting page <1>: dvitype invocation. (line 50)
+* starting page: dvicopy invocation. (line 28)
+* Steele Jr., Guy L.: Hardware and memory dumps.
+ (line 34)
+* stopping at the first error: Common options. (line 41)
+* strategy, overall: Introduction. (line 17)
+* string numbers, displaying: pooltype invocation. (line 6)
+* string pool, writing: tangle invocation. (line 16)
+* string representation: pooltype invocation. (line 30)
+* style design, for BibTeX: bibtex invocation. (line 45)
+* style files: mft invocation. (line 68)
+* substitutions of font glyphs: MLTeX. (line 6)
+* sun: Online Metafont graphics.
+ (line 42)
+* sun-gfx.c: Online Metafont graphics.
+ (line 43)
+* Suntools: Online Metafont graphics.
+ (line 43)
+* SunView: Online Metafont graphics.
+ (line 43)
+* swap space, as array limit: Runtime options. (line 36)
+* swapping bytes: Hardware and memory dumps.
+ (line 13)
+* syntax of TCX files: TCX files. (line 66)
+* system C library function: tex invocation. (line 128)
+* T1 encoding and ISO input: TCX files. (line 49)
+* Tachikawa, Elizabeth: Font file formats. (line 63)
+* tangle: tangle invocation. (line 6)
+* targets, additional Make: Additional targets. (line 6)
+* TCX character translation files: TCX files. (line 6)
+* tek: Online Metafont graphics.
+ (line 47)
+* Tektronix: Online Metafont graphics.
+ (line 48)
+* Tektronix 4014: Online Metafont graphics.
+ (line 51)
+* TERM: Online Metafont graphics.
+ (line 11)
+* terminator for filenames: \input filenames. (line 10)
+* terse output: bibtex invocation. (line 28)
+* TEX: makempx invocation. (line 74)
+* tex: tex invocation. (line 6)
+* TeX, bibliographies for: bibtex invocation. (line 54)
+* TeX, creating from Metafont: mft invocation. (line 6)
+* TeX, creating from WEB: weave invocation. (line 6)
+* TeX, description of: TeX. (line 6)
+* TeX, extensions to: TeX extensions. (line 6)
+* TeX, format packages for: Formats. (line 6)
+* TeX, initial: Initial TeX. (line 6)
+* TeX, input files found: tex invocation. (line 20)
+* TeX, invocation: tex invocation. (line 6)
+* TeX, Metafont, and MetaPost: Three programs. (line 6)
+* TeX, Web2c implementation of: Introduction. (line 9)
+* TeX--XeT: TeX extensions. (line 25)
+* tex.fmt: Initial TeX. (line 15)
+* TEXBIB, search path for bib files: bibtex invocation. (line 18)
+* TEXEDIT: Editor invocation. (line 10)
+* texfonts.map: Path searching. (line 15)
+* Texinfo: Formats. (line 47)
+* texmf.cnf: Path searching. (line 6)
+* texmfmp.c: Online Metafont graphics.
+ (line 77)
+* texmfmp.c and openoutnameok: tex invocation. (line 51)
+* TEXMFOUTPUT, used if . unwritable: Output file location.
+ (line 19)
+* texput: tex invocation. (line 35)
+* text, extracting from MetaPost input: mpto invocation. (line 6)
+* TFM files, converting property lists to: pltotf invocation. (line 6)
+* TFM files, explained: Font file formats. (line 13)
+* TFM files, memory for: Runtime options. (line 25)
+* TFM files, output by Metafont: mf invocation. (line 43)
+* TFM files, output by MetaPost: mpost invocation. (line 37)
+* TFM width of characters <1>: gftype invocation. (line 113)
+* TFM width of characters: pktype invocation. (line 53)
+* tftopl: tftopl invocation. (line 6)
+* three programs: Three programs. (line 6)
+* time and date, in memory dumps: Hardware and memory dumps.
+ (line 30)
+* title font: gftodvi invocation. (line 33)
+* toolkits, X: Online Metafont graphics.
+ (line 60)
+* torture tests: Triptrap. (line 6)
+* translation file for TeX, specifying: Common options. (line 96)
+* translation from WEB to C: Introduction. (line 17)
+* trap Make target: Additional targets. (line 41)
+* trap test: Triptrap. (line 6)
+* trapman.tex: Triptrap. (line 6)
+* trchars.adj: dmp invocation. (line 24)
+* Trickey, Howard: Introduction. (line 41)
+* trip Make target: Additional targets. (line 41)
+* trip test: Triptrap. (line 6)
+* tripman.tex: Triptrap. (line 6)
+* triptrap Make target: Additional targets. (line 41)
+* TROFF: makempx invocation. (line 79)
+* Troff, and MetaPost: mpost invocation. (line 73)
+* Troff, WEB for: WEB. (line 14)
+* Trojan horses and TeX programs: tex invocation. (line 51)
+* TUGboat bibliography: bibtex invocation. (line 54)
+* Type 1 conversion: Font utilities available elsewhere.
+ (line 39)
+* type design, personal: Initial Metafont. (line 33)
+* type programs, DVI: dvitype invocation. (line 6)
+* type programs, GF: gftype invocation. (line 6)
+* type programs, PK: pktype invocation. (line 6)
+* type programs, pool: pooltype invocation. (line 6)
+* typeface families: Metafont. (line 6)
+* typeface specimen sheets: Font utilities available elsewhere.
+ (line 42)
+* typesetting: TeX. (line 6)
+* Unicode: TeX extensions. (line 16)
+* Unicode input: tex invocation. (line 95)
+* uniterm: Online Metafont graphics.
+ (line 50)
+* unsrt.bst: Basic BibTeX style files.
+ (line 39)
+* using local codepage to display messages: Common options. (line 108)
+* UTF-8 input: tex invocation. (line 95)
+* validation, of DVI files: dvitype invocation. (line 6)
+* validation, of GF files: gftype invocation. (line 6)
+* validation, of PK files: pktype invocation. (line 6)
+* validation, of TFM files: tftopl invocation. (line 6)
+* validation, of VF files: vftovp invocation. (line 6)
+* verbatimtex MetaPost command: mpto invocation. (line 6)
+* verbose BibTeX output, suppressing: bibtex invocation. (line 28)
+* verbosity, enabling: Common options. (line 15)
+* version number, finding: Common options. (line 18)
+* vertical escapement: gftype invocation. (line 107)
+* VF files, converting property lists to: vptovf invocation. (line 6)
+* vftovp: vftovp invocation. (line 6)
+* virgin programs: Initial and virgin. (line 20)
+* virtual font creation: Font utilities available elsewhere.
+ (line 53)
+* virtual fonts, expanding: dvicopy invocation. (line 6)
+* virtual-fonts.knuth: Font file formats. (line 57)
+* virtualfonts.txt: Font file formats. (line 57)
+* vptovf: vptovf invocation. (line 6)
+* weave: weave invocation. (line 6)
+* WEB: WEB. (line 6)
+* WEB pool files, displaying: pooltype invocation. (line 6)
+* WEB programs, compiling: tangle invocation. (line 6)
+* WEB programs, typesetting: weave invocation. (line 6)
+* WEB2C, search path for TCX files: TCX files. (line 36)
+* Weber, Olaf: Introduction. (line 41)
+* webmac.tex: weave invocation. (line 22)
+* webman.tex: WEB. (line 14)
+* whitespace, in TCX files: TCX files. (line 69)
+* whitespace-terminated filenames: \input filenames. (line 10)
+* width, device-independent <1>: gftype invocation. (line 113)
+* width, device-independent: pktype invocation. (line 53)
+* width, in pixels: pktype invocation. (line 62)
+* word processor, not: TeX. (line 9)
+* writing memory dumps: Creating memory dumps.
+ (line 6)
+* X bitmap fonts: Font utilities available elsewhere.
+ (line 15)
+* X class name for Metafont: Online Metafont graphics.
+ (line 66)
+* x offset: pktype invocation. (line 66)
+* X resources: Online Metafont graphics.
+ (line 66)
+* X toolkits and Metafont: Online Metafont graphics.
+ (line 60)
+* x X ditroff device control: dmp invocation. (line 15)
+* xampl.bib: bibtex invocation. (line 51)
+* xbfe, bitmap font editor: Font utilities available elsewhere.
+ (line 23)
+* xfed, bitmap font editor: Font utilities available elsewhere.
+ (line 23)
+* xfedor, bitmap font editor: Font utilities available elsewhere.
+ (line 23)
+* Xlib: Online Metafont graphics.
+ (line 56)
+* Xlib support: Online Metafont graphics.
+ (line 60)
+* Xt: Online Metafont graphics.
+ (line 56)
+* Xt support: Online Metafont graphics.
+ (line 60)
+* xterm: Online Metafont graphics.
+ (line 56)
+* y offset: pktype invocation. (line 66)
+* ~ expansion in filenames: \input filenames. (line 48)
+
+
+
+Tag Table:
+Node: Top2967
+Node: Introduction3962
+Node: Installation7139
+Node: configure options9303
+Node: Compile-time options11385
+Node: Additional targets12511
+Node: Triptrap13792
+Node: Runtime options15321
+Node: Commonalities17093
+Node: Option conventions17698
+Node: Common options18922
+Node: Path searching23434
+Node: Output file location24456
+Node: Three programs25496
+Node: Initial and virgin26255
+Node: Memory dumps27355
+Node: Creating memory dumps27822
+Node: Determining the memory dump to use29083
+Node: Hardware and memory dumps30707
+Node: Editor invocation33176
+Node: \input filenames33906
+Node: TeX36899
+Node: tex invocation37989
+Node: Initial TeX45921
+Node: Formats47410
+Node: Languages and hyphenation50349
+Node: MLTeX50777
+Node: \charsubdef52272
+Node: \tracingcharsubdef54598
+Node: TCX files55173
+Node: patgen invocation60597
+Node: IPC and TeX61314
+Node: TeX extensions61915
+Node: Metafont63216
+Node: mf invocation64504
+Node: Initial Metafont68387
+Node: Modes70140
+Node: Online Metafont graphics72395
+Node: gftodvi invocation75668
+Node: mft invocation77927
+Node: MetaPost81982
+Node: mpost invocation83003
+Node: Initial MetaPost88188
+Node: makempx invocation90000
+Node: dvitomp invocation93500
+Node: dmp invocation94129
+Node: mpto invocation98150
+Node: newer invocation99132
+Node: BibTeX100069
+Node: bibtex invocation100430
+Node: Basic BibTeX style files102755
+Node: WEB104097
+Node: tangle invocation105380
+Node: weave invocation107503
+Node: pooltype invocation108911
+Node: DVI utilities110041
+Node: dvicopy invocation110985
+Node: dvitype invocation112283
+Node: dvitype output example114638
+Node: Font utilities117689
+Node: Font file formats118869
+Node: gftopk invocation122168
+Node: pktogf invocation123372
+Node: pktype invocation124551
+Node: gftype invocation127386
+Node: tftopl invocation131902
+Node: pltotf invocation136536
+Node: vftovp invocation137601
+Node: vptovf invocation139885
+Node: Font utilities available elsewhere140939
+Node: Legalisms143359
+Node: References145530
+Node: Index149915
+
+End Tag Table
diff --git a/Build/source/texk/web2c/doc/web2c.texi b/Build/source/texk/web2c/doc/web2c.texi
new file mode 100644
index 00000000000..55b33d929c0
--- /dev/null
+++ b/Build/source/texk/web2c/doc/web2c.texi
@@ -0,0 +1,4409 @@
+\input texinfo
+@setfilename web2c.info
+@settitle Web2c: A @TeX{} implementation
+
+@tex
+\expandafter\ifx\csname url\endcsname\relax
+ \errhelp{You must update texinfo.tex to at least version 3.8.
+The latest version is available from ftp://ftp.tug.org/tex/texinfo.tex.}
+ \errmessage{Your texinfo.tex is too old}
+ \csname bye\expandafter\endcsname
+\fi
+@end tex
+
+@set version 7.5.5
+@set month-year June 2005
+
+@c Define new indices for commands in auxiliary files, filenames, and options.
+@defcodeindex cm
+@defcodeindex fl
+@defcodeindex op
+
+@c Put everything in one index (arbitrarily chosen to be the concept index).
+@syncodeindex cm cp
+@syncodeindex fl cp
+@syncodeindex fn cp
+@syncodeindex ky cp
+@syncodeindex op cp
+@syncodeindex pg cp
+@syncodeindex vr cp
+
+@dircategory TeX
+@direntry
+* Web2c: (web2c). TeX, Metafont, and companion programs.
+* bibtex: (web2c)bibtex invocation. Maintaining bibliographies.
+* dmp: (web2c)dmp invocation. Troff->MPX (MetaPost pictures).
+* dvicopy: (web2c)dvicopy invocation. Virtual font expansion
+* dvitomp: (web2c)dvitomp invocation. DVI to MPX (MetaPost pictures).
+* dvitype: (web2c)dvitype invocation. DVI to human-readable text.
+* gftodvi: (web2c)gftodvi invocation. Generic font proofsheets.
+* gftopk: (web2c)gftopk invocation. Generic to packed fonts.
+* gftype: (web2c)gftype invocation. GF to human-readable text.
+* makempx: (web2c)makempx invocation. MetaPost label typesetting.
+* mf: (web2c)mf invocation. Creating typeface families.
+* mft: (web2c)mft invocation. Prettyprinting Metafont source.
+* mltex: (web2c)MLTeX. Multi-lingual TeX.
+* mpost: (web2c)mpost invocation. Creating technical diagrams.
+* mpto: (web2c)mpto invocation. MetaPost label extraction.
+* newer: (web2c)newer invocation. Compare modification times.
+* patgen: (web2c)patgen invocation. Creating hyphenation patterns.
+* pktogf: (web2c)pktogf invocation. Packed to generic fonts.
+* pktype: (web2c)pktype invocation. PK to human-readable text.
+* pltotf: (web2c)pltotf invocation. Property list to TFM.
+* pooltype: (web2c)pooltype invocation. Display WEB pool files.
+* tangle: (web2c)tangle invocation. WEB to Pascal.
+* tex: (web2c)tex invocation. Typesetting.
+* tftopl: (web2c)tftopl invocation. TFM -> property list.
+* vftovp: (web2c)vftovp invocation. Virtual font -> virtual pl.
+* vptovf: (web2c)vptovf invocation. Virtual pl -> virtual font.
+* weave: (web2c)weave invocation. WEB to TeX.
+@end direntry
+
+@copying
+This file documents the installation and use of the programs in Web2c,
+an implementation of Donald Knuth's TeX system.
+
+Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+2004 Karl Berry & Olaf Weber.
+
+Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries a copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+@end ignore
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation
+@end copying
+
+
+@titlepage
+
+@title Web2c
+@subtitle for version @value{version}
+@subtitle @value{month-year}
+@author Karl Berry (@email{karl@@tug.org})
+@author Olaf Weber (@email{infovore@@xs4all.nl})
+
+@page
+@vskip 0pt plus 1filll
+@insertcopying
+@end titlepage
+
+@contents
+
+@ifnottex
+@node Top
+@top Web2c
+
+This document describes how to install and use the programs in the Web2c
+implementation of the @TeX{} system, especially for Unix systems. It
+corresponds to Web2c version @value{version}, released in
+@value{month-year}.
+
+@menu
+* Introduction:: A brief introduction.
+* Installation:: How to compile and install Web2c.
+* Commonalities:: Option syntax, standard options, memory dumps.
+* TeX:: Typesetting.
+* Metafont:: Typeface design.
+* MetaPost:: Technical illustrations.
+* BibTeX:: Reusable bibliographies.
+* WEB:: Literate programming.
+* DVI utilities:: DVI expansion.
+* Font utilities:: Font format conversion.
+* Legalisms:: Blah blah blah.
+* References:: Books and such.
+* Index:: General index.
+@end menu
+@end ifnottex
+
+
+@node Introduction
+@chapter Introduction
+
+@cindex introduction
+
+This manual corresponds to version @value{version} of Web2c, released in
+@value{month-year}.
+
+@cindex Knuth, Donald E.
+@cindex @TeX{}, Web2c implementation of
+@cindex Hobby, John
+@cindex Breitenlohner, Peter
+@dfn{Web2c} is the name of a @TeX{} implementation, originally for Unix,
+but now also running under DOS, Amiga, and other operating systems. By
+@dfn{@TeX{} implementation}, we mean all of the standard programs
+developed by the Stanford @TeX{} project directed by Donald E. Knuth:
+Metafont, DVItype, GFtoDVI, Bib@TeX{}, Tangle, etc., as well as @TeX{}
+itself. Other programs are also included: DVIcopy, written by Peter
+Breitenlohner, MetaPost and its utilities (derived from Metafont), by
+John Hobby, etc.
+
+@cindex translation from WEB to C
+@cindex strategy, overall
+General strategy: Web2c works, as its name implies, by translating the
+WEB source in which @TeX{} is written into C source code. Its output is
+not self-contained, however; it makes extensive use of many macros and
+functions in a library (the @file{web2c/lib} directory in the sources).
+Therefore, it will not work without change on an arbitrary WEB program.
+
+@cindex licensing terms
+@cindex freedom of Web2c
+@cindex ice cream
+@cindex Henry, Patrick
+Availability: All of Web2c is freely available---``free'' both in the
+sense of no cost (free ice cream) and of having the source code to
+modify and/or redistribute (free speech). @xref{unixtex.ftp,,,
+kpathsea, Kpathsea}, for the practical details of how to obtain Web2c.
+
+Different parts of the Web2c distribution have different licensing
+terms, however, reflecting the different circumstances of their
+creation; consult each source file for exact details. The main
+practical implication for redistributors of Web2c is that the executables
+are covered by the GNU General Public License, and therefore anyone
+who gets a binary distribution must also get the sources, as explained
+by the terms of the GPL (@pxref{Copying, , , kpathsea, Kpathsea}). The
+GPL covers the Web2c executables, including @code{tex}, because the Free
+Software Foundation sponsored the initial development of the Kpathsea
+library that Web2c uses. The basic source files from Stanford, however,
+have their own copyright terms or are in the public domain, and are not
+covered by the GPL.
+
+@cindex history
+@cindex Rokicki, Tomas
+@cindex Trickey, Howard
+@cindex Curtis, Pavel
+@cindex Morgan, Tim
+@cindex Berry, Karl
+@cindex Weber, Olaf
+History: Tomas Rokicki originated the @TeX{}-to-C system in 1987,
+working from the first change files for @TeX{} under Unix, which were
+done primarily by Howard Trickey and Pavel Curtis. Tim Morgan then took
+over development and maintenance for a number of years; the name changed
+to Web-to-C somewhere in there. In 1990, Karl Berry became the
+maintainer. He made many changes to the original sources, and started
+using the shorter name Web2c. In 1997, Olaf Weber took over. Dozens of
+other people have contributed; their names are listed in the
+@file{ChangeLog} files.
+
+@cindex acknowledgements
+@cindex Martin, Rick
+@cindex Morris, Bob
+@cindex Stallman, Richard
+Other acknowledgements: The University of Massachusetts at Boston
+(particularly Rick Martin and Bob Morris) has provided computers and ftp
+access to me for many years. Richard Stallman at the Free Software
+Foundation employed me while I wrote the original path searching library
+(for the GNU font utilities). (rms also gave us Emacs, GDB, and GCC,
+without which I cannot imagine developing Web2c.) And, of course,
+@TeX{} would not exist in the first place without Donald E. Knuth.
+
+@cindex reading, additional
+Further reading: @xref{References}.
+
+
+@include install.texi
+
+
+@node Commonalities
+@chapter Commonalities
+
+@cindex commonalities
+
+Many aspects of the @TeX{} system are the same among more than one
+program, so we describe all those pieces together, here.
+
+@menu
+* Option conventions:: -- or -, = or ` ' for values.
+* Common options:: --help --version --verbose, and TeX/MF/MP options.
+* Path searching:: Features of the common path searching library.
+* Output file location:: TEXMFOUTPUT allows output in places other than `.'.
+* Three programs:: TeX, Metafont, and MetaPost have a lot in common.
+@end menu
+
+
+@node Option conventions
+@section Option conventions
+
+@cindex option conventions
+@cindex conventions for options,
+
+@findex getopt_long_only
+To provide a clean and consistent behavior, we chose to have all these
+programs use the GNU function @code{getopt_long_only} to parse command
+lines. However, we do use in a restricted mode, where all the options
+have to come before the rest of the arguments.
+
+@opindex - @r{starts option names}
+@opindex -- @r{starts option names}
+As a result, you can:
+@itemize @bullet
+@item
+use @samp{-} or @samp{--} to start an option name;
+
+@item
+use any unambiguous abbreviation for an option name;
+
+@item
+separate option names and values with either @samp{=} or one or more
+spaces;
+
+@item
+@flindex - @r{starting a filename}
+@cindex filenames starting with @samp{-}
+use filenames that would otherwise look like options by putting them
+after an option @samp{--}.
+@end itemize
+
+By convention, non-option arguments, if specified, generally define the
+name of an input file, as documented for each program.
+
+If a particular option with a value is given more than once, it is the
+last value that counts.
+
+For example, the following command line specifies the options
+@samp{foo}, @samp{bar}, and @samp{verbose}; gives the value @samp{baz}
+to the @samp{abc} option, and the value @samp{xyz} to the @samp{quux}
+option; and specifies the filename @file{-myfile-}.
+
+@example
+-foo --bar -verb -abc=baz -quux karl --quux xyz -- -myfile-
+@end example
+
+
+@node Common options
+@section Common options
+
+@cindex common options
+All of these programs accept the standard GNU @samp{--help} and
+@samp{--version} options, and several programs accept
+@samp{--verbose}. Rather than writing identical descriptions for
+every program, they are described here.
+
+@table @samp
+@item --help
+@opindex --help @r{common option}
+@cindex help, online
+Print a usage message listing basic usage and all available options to
+standard output, then exit successfully.
+
+@item --verbose
+@opindex --verbose @r{common option}
+@cindex verbosity, enabling
+Print progress reports to standard output.
+
+@item --version
+@opindex --version @r{common option}
+@cindex version number, finding
+Print the version number to standard output, then exit successfully.
+@end table
+
+@TeX{}, Metafont, and MetaPost have a number of additional options in
+common:
+
+@table @samp
+@item -file-line-error
+@opindex -file-line-error
+@itemx -no-file-line-error
+@opindex -no-file-line-error
+@opindex -file-line-error-style
+@cindex changing error messages style
+Change (or do not change) the way error messages are printed. The
+alternate style looks like error messages from many compilers and is
+easier to parse for some editors that invoke @TeX{}. This option used
+to be called @samp{-file-line-error-style}.
+
+@item -fmt=@var{dumpname}
+@itemx -base=@var{dumpname}
+@itemx -mem=@var{dumpname}
+@opindex -fmt=@var{dumpname}
+@opindex -base=@var{dumpname}
+@opindex -mem=@var{dumpname}
+@cindex dump file
+Use @var{dumpname} instead of the program name or a @samp{%&} line to
+determine the name of the memory dump file read (@samp{fmt} for @TeX{},
+@samp{base} for Metafont, @samp{mem} for MetaPost). @xref{Memory
+dumps}. Also sets the program name to @var{dumpname} if no
+@samp{-progname} option was given.
+
+@item -halt-on-error
+@opindex -halt-on-error
+@cindex stopping at the first error
+Stop processing and exit when an error occurs, as opposed to the normal
+process of trying to recover and continue.
+
+@item -ini
+@opindex -ini
+@cindex program names, special
+@cindex initial form, enabling
+Enable the ``initial'' form of the program (@pxref{Initial and
+virgin}). This is implicitly set if the program name is @code{initex}
+resp.@: @code{inimf} resp.@: @code{inimpost}, although these variants
+are no longer typically installed.
+
+@item -interaction=@var{string}
+@opindex -interaction=@var{string}
+@cindex interaction mode
+Set the interaction mode from the command line. The @var{string} must
+be one of @samp{batchmode}, @samp{nonstopmode}, @samp{scrollmode}, or
+@samp{errorstopmode}.
+
+@item -jobname=@var{string}
+@opindex -jobname=@var{string}
+@cindex job name
+Set the job name to @var{string}, instead of deriving it from the name
+of the input file.
+
+@item -kpathsea-debug=@var{number}
+@opindex -kpathsea-debug=@var{number}
+@vindex KPATHSEA_DEBUG
+@cindex debugging flags, specifying
+@cindex path searching debugging
+Set path searching debugging flags according to the bits of @var{number}
+(@pxref{Debugging,,,kpathsea,Kpathsea}). You can also specify this in
+@code{KPATHSEA_DEBUG} environment variable (for all Web2c programs).
+(The command line value overrides.) The most useful value is @samp{-1},
+to get all available output.
+
+@item -output-directory=@var{dirname}
+@opindex -output-directory
+@cindex output directory, specifying
+Specify the directory @var{dirname} to which output files are written.
+Also look for input files in @var{dirname} first, before looking along
+the normal search path. This is useful when you are in some read-only
+distribution directory, perhaps on a CD-ROM, and want to @TeX{} some
+documentation, for example.
+@c FIXME: caveat to -output-directory
+Note that for input files the ``search'' in @var{dirname} does
+not use the full generality of the search mechanism. This means that
+some files are not found there even though you might expect them to be.
+
+@item -parse-first-line
+@opindex -parse-first-line
+@itemx -no-parse-first-line
+@opindex -no-parse-first-line
+@cindex parsing the first line
+Check or disable checking whether the first line of the main input
+file starts with @samp{%&}, and parse it if it does. This line can be
+used specify the format and/or a TCX file.
+
+@item -progname=@var{string}
+@opindex -progname=@var{string}
+@cindex binaries, linking
+@cindex linking binaries
+@cindex program names, special
+Set program (and memory dump) name to @var{string}. This may affect the
+search paths and other values used (@pxref{Config files,,, kpathsea,
+Kpathsea}). Using this option is equivalent to making a link named
+@var{string} to the binary and then invoking the binary under that
+name. @xref{Memory dumps}.
+
+@item -recorder
+@opindex -recorder
+@cindex file recorder
+Enable the filename recorder. This makes the program save a list of the
+opened files into a file with (by default) extension @samp{.fls}. For
+Omega, this option is always on, and the file has extension @samp{.ofl}.
+
+@item -translate-file=@var{tcxfile}
+@opindex -translate-file=@var{tcxfile}
+@cindex translation file for @TeX{}, specifying
+@flindex .tcx @r{character translation files}
+@cindex first line of the main input file
+Use @var{tcxfile} to define which characters are printable and translations
+between the internal and external character sets. Moreover,
+@var{tcxfile} can be explicitly declared in the first line of the main
+input file @samp{%& -translate-file=@var{tcxfile}}.
+This is the recommended method for portability reasons.
+@xref{TCX files}.
+
+@item -8bit
+@opindex -8bit
+@cindex 8 bit clean
+@flindex 8 bit clean output, specifying
+This option specifies that by default all characters should be
+considered printable. If @samp{-translate-file} was given as well, then the
+TCX file may mark characters as non-printable.
+
+@item -oem
+@opindex -oem
+@cindex using local codepage to display messages
+This option is specific to Windows. When specified, @TeX{} engines will use the
+OEM code page rather than the ANSI one to display their messages.
+
+@end table
+
+
+@node Path searching
+@section Path searching
+
+@cindex path searching
+
+@flindex texmf.cnf
+@cindex configuration file reading
+All of the Web2c programs, including @TeX{}, which do path searching use
+the Kpathsea routines to do so. The precise names of the environment
+and configuration file variables which get searched for particular file
+formatted are therefore documented in the Kpathsea manual
+(@pxref{Supported file formats,,, kpathsea, Kpathsea}). Reading
+@file{texmf.cnf} (@pxref{Config files,,, kpathsea, Kpathsea}), invoking
+@code{mktex@dots{}} scripts (@pxref{mktex scripts,,, kpathsea,
+Kpathsea}), and so on are all handled by Kpathsea.
+
+@cindex font aliases
+@cindex aliases for fonts
+@flindex texfonts.map
+The programs which read fonts make use of another Kpathsea feature:
+@file{texfonts.map}, which allows arbitrary aliases for the actual names
+of font files; for example, @samp{Times-Roman} for @samp{ptmr8r.tfm}.
+The distributed (and installed by default) @file{texfonts.map} includes
+aliases for many widely available PostScript fonts by their PostScript
+names.
+
+
+@node Output file location
+@section Output file location
+
+@cindex output file location
+@cindex current directory, used for output
+@flindex .@r{, used for output}
+All the programs generally follow the usual convention for output files.
+Namely, they are placed in the directory current when the program is
+run, regardless of any input file location; or, in a few cases, output
+is to standard output.
+
+For example, if you run @samp{tex /tmp/foo}, for example, the output
+will be in @file{./foo.dvi} and @file{./foo.log}, not
+@file{/tmp/foo.dvi} and @file{/tmp/foo.log}.
+
+@opindex -output-directory
+@cindex output directory, specifying
+@cindex readonly directory, running @TeX{} in
+You can use the @samp{-output-directory} option to cause all output
+files that would normally be written in the current directory to be
+written in the specified directory instead. @xref{Common options}.
+
+@vindex TEXMFOUTPUT@r{, used if @samp{.} unwritable}
+@cindex readonly directory, running @TeX{} in
+If the current directory is not writable, and @samp{-output-directory}
+is not specified, the main programs (@TeX{}, Metafont, MetaPost, and
+Bib@TeX{}) make an exception: if the config file value
+@code{TEXMFOUTPUT} is set (it is not by default), output files are
+written to the directory specified.
+
+
+@node Three programs
+@section Three programs: Metafont, MetaPost, and @TeX{}
+
+@cindex three programs
+@cindex @TeX{}, Metafont, and MetaPost
+@cindex Metafont, MetaPost, and @TeX{}
+@cindex MetaPost, @TeX{}, and Metafont
+
+@TeX{}, Metafont, and MetaPost have a number of features in common.
+Besides the ones here, the common command-line options are described in
+the previous section. The configuration file options that let you
+control some array sizes and other features are described in
+@ref{Runtime options}.
+
+@menu
+* Initial and virgin:: Making memory dumps vs. production runs.
+* Memory dumps:: .fmt/.base/.mem files for fast startup.
+* Editor invocation:: The `e' response at errors.
+* \input filenames:: ~ and $ expansion in TeX/MF/MP.
+@end menu
+
+
+@node Initial and virgin
+@subsection Initial and virgin
+
+@cindex executables, shared initial and virgin
+The @TeX{}, Metafont, and MetaPost programs each have two main
+variants, called @dfn{initial} and @dfn{virgin}. As of Web2c 7, one
+executable suffices for both variants, and in fact, the @code{ini...}
+executables are no longer created.
+
+The initial form is enabled if:
+@enumerate
+@item
+@opindex -ini
+the @samp{-ini} option was specified; or
+@item
+the program name is @file{initex} resp.@: @file{inimf} resp.@:
+@file{inimpost} (these variants are no longer typically installed); or
+@item
+the first line of the main input file is @samp{%&ini};
+@end enumerate
+@noindent
+otherwise, the virgin form is used.
+
+@cindex virgin programs
+@cindex production use
+The @dfn{virgin} form is the one generally invoked for production use.
+The first thing it does is read a memory dump (@pxref{Determining the
+memory dump to use}), and then proceeds on with the main job.
+
+@cindex initial programs
+@cindex initializations, lengthy
+The @dfn{initial} form is generally used only to create memory dumps
+(see the next section). It starts up more slowly than the virgin form,
+because it must do lengthy initializations that are encapsulated in the
+memory dump file.
+
+
+@node Memory dumps
+@subsection Memory dumps
+
+@cindex memory dumps
+
+@cindex dumping memory
+@cindex macros, predefining in memory dumps
+@cindex predefined macros and memory dumps
+In typical use, @TeX{}, Metafont, and MetaPost require a large number of
+macros to be predefined; therefore, they support @dfn{memory dump}
+files, which can be read much more efficiently than ordinary source
+code.
+
+@menu
+* Creating memory dumps::
+* Determining the memory dump to use::
+* Hardware and memory dumps::
+@end menu
+
+
+@node Creating memory dumps
+@subsubsection Creating memory dumps
+
+@cindex memory dumps, creating
+@cindex creating memory dumps
+@cindex writing memory dumps
+
+The programs all create memory dumps in slightly idiosyncratic (thought
+substantially similar) way, so we describe the details in separate
+sections (references below). The basic idea is to run the initial
+version of the program (@pxref{Initial and virgin}), read the source
+file to define the macros, and then execute the @code{\dump} primitive.
+
+Also, each program uses a different filename extension for its memory
+dumps, since although they are completely analogous they are not
+interchangeable (@TeX{} cannot read a Metafont memory dump, for
+example).
+
+Here is a list of filename extensions with references to examples of
+creating memory dumps:
+
+@table @asis
+@item @TeX{}
+(@samp{.fmt}) @xref{Initial TeX,,Initial @TeX{}}.
+
+@item Metafont
+(@samp{.base}) @xref{Initial Metafont}.
+
+@item MetaPost
+(@samp{.mem}) @xref{Initial MetaPost}.
+@end table
+
+When making memory dumps, the programs read environment variables and
+configuration files for path searching and other values as usual. If
+you are making a new installation and have environment variables
+pointing to an old one, for example, you will probably run into
+difficulties.
+
+
+@node Determining the memory dump to use
+@subsubsection Determining the memory dump to use
+
+@cindex memory dump to use, determining
+@cindex fmt file, determining
+@cindex base file, determining
+@cindex mem file, determining
+
+The virgin form (@pxref{Initial and virgin}) of each program always
+reads a memory dump before processing normal source input. All three
+programs determine the memory dump to use in the same way:
+
+@enumerate
+@item
+If the first non-option command-line argument begins with @samp{&}, the
+program uses the remainder of that argument as the memory dump name.
+For example, running @samp{tex \&super} reads @file{super.fmt}. (The
+backslash protects the @samp{&} against interpretation by the shell.)
+
+@item
+@opindex -fmt=@var{fmt}
+@opindex -base=@var{base}
+@opindex -mem=@var{mem}
+If the @samp{-fmt} resp.@: @samp{-base} resp.@: @samp{-mem} option is
+specified, its value is used.
+
+@item
+@opindex -progname=@var{string}
+If the @samp{-progname} option is specified, its value is used.
+
+@item
+@kindex %& @r{magic number}
+If the first line of the main input file (which must be specified on the
+command line, not in response to @samp{**}) is @code{%&@var{dump}}, and
+@var{dump} is an existing memory dump of the appropriate type,
+@var{dump} is used.
+
+The first line of the main input file can also specify which character
+translation file is to be used: @code{%&-translate-file=@var{tcxfile}}
+(@pxref{TCX files}).
+
+These two roles can be combined: @code{%&@var{dump}
+-translate-file=@var{tcxfile}}. If this is done, the name of the dump
+must be given first.
+
+@item
+@cindex program name, determines memory dump
+@cindex links to binaries
+Otherwise, the program uses the program invocation name, most commonly
+@file{tex} resp.@: @file{mf} resp.@: @file{mpost}. For example, if
+@file{latex} is a link to @file{tex}, and the user runs @samp{latex
+foo}, @file{latex.fmt} will be used.
+
+@end enumerate
+
+
+@node Hardware and memory dumps
+@subsubsection Hardware and memory dumps
+
+@cindex hardware and memory dumps
+@cindex memory dumps and hardware
+@cindex sharing memory dumps
+@cindex fmt files, sharing
+@cindex base files, sharing
+@cindex mem files, sharing
+
+@cindex LittleEndian machines
+@cindex BigEndian machines
+@cindex endian dependencies
+@cindex machine dependencies
+@cindex architecture dependencies
+@cindex dependencies, hardware
+@opindex --disable-dump-share configure @r{option}
+By default, memory dump files are generally sharable between
+architectures of different types; specifically, on machines of different
+endianness (@pxref{Byte order,,,libc,GNU C Library}). (This is a
+feature of the Web2c implementation, and is not true of all @TeX{}
+implementations.) If you specify @samp{--disable-dump-share} to
+@code{configure}, however, memory dumps will be endian-dependent.
+
+@cindex byte swapping
+@cindex swapping bytes
+The reason to do this is speed. To achieve endian-independence, the
+reading of memory dumps on LittleEndian architectures, such as PC's and
+DEC architectures, is somewhat slowed (all the multibyte values have to
+be swapped). Usually, this is not noticeable, and the advantage of
+being able to share memory dumps across all platforms at a site far
+outweighs the speed loss. But if you're installing Web2c for use on
+LittleEndian machines only, perhaps on a PC being used only by you, you
+may wish to get maximum speed.
+
+@cindex floating-point values
+@cindex glue ratio representations
+@TeX{}nically, even without @samp{--disable-dump-share}, sharing of
+@file{.fmt} files cannot be guaranteed to work. Floating-point values
+are always written in native format, and hence will generally not be
+readable across platforms. Fortunately, @TeX{} uses floating point only
+to represent glue ratios, and all common formats (plain, @LaTeX{},
+AMS@TeX{}, @dots{}) do not do any glue setting at @file{.fmt}-creation
+time. Metafont and MetaPost do not use floating point in any dumped
+value at all.
+
+@cindex date and time, in memory dumps
+@cindex time and date, in memory dumps
+@cindex memory dumps, contain date and time
+Incidentally, different memory dump files will never compare equal
+byte-for-byte, because the program always dumps the current date and
+time. So don't be alarmed by just a few bytes difference.
+
+@cindex Harbison, Samuel P.
+@cindex Steele Jr., Guy L.
+If you don't know what endianness your machine is, and you're curious,
+here is a little C program to tell you. (The @code{configure} script
+contains a similar program.) This is from the book @cite{C: A Reference
+Manual}, by Samuel P. Harbison and Guy L. Steele
+Jr@:. (@pxref{References}).
+
+@example
+main ()
+@{
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ @{
+ long l;
+ char c[sizeof (long)];
+ @} u;
+ u.l = 1;
+ if (u.c[0] == 1)
+ printf ("LittleEndian\n");
+ else if (u.c[sizeof (long) - 1] == 1)
+ printf ("BigEndian\n");
+ else
+ printf ("unknownEndian");
+
+ exit (u.c[sizeof (long) - 1] == 1);
+@}
+@end example
+
+
+@node Editor invocation
+@subsection Editor invocation
+
+@cindex editor invoked at error
+@cindex errors, editor invoked at
+@opindex e @r{response at error prompt}
+
+@TeX{}, Metafont, and MetaPost all (by default) stop and ask for user
+intervention at an error. If the user responds with @kbd{e} or @kbd{E},
+the program invokes an editor.
+
+@vindex TEXEDIT
+@vindex MFEDIT
+@vindex MPEDIT
+@opindex --with-editor=@var{cmd}
+Specifying @samp{--with-editor=@var{cmd}} to @code{configure} sets the
+default editor command string to @var{cmd}. The environment
+variables/configuration values @code{TEXEDIT}, @code{MFEDIT}, and
+@code{MPEDIT} (respectively) override this. If @samp{--with-editor} is
+not specified, the default is @code{vi +%d %s}.
+
+In this string, @samp{%d} is replaced by the line number of the error,
+and @samp{%s} is replaced by the name of the current input file.
+
+
+@node \input filenames
+@subsection @code{\input} filenames
+
+@cindex input filenames
+@cindex filename conventions, in input files
+@findex \input @r{filenames}
+
+@TeX{}, Metafont, and MetaPost source programs can all read other source
+files with the @code{\input} (@TeX{}) and @code{input} (MF and MP)
+primitives:
+@example
+\input @var{name} % in TeX
+@end example
+
+@cindex space-terminated filenames
+@cindex whitespace-terminated filenames
+@cindex terminator for filenames
+The file @var{name} can always be terminated with whitespace; for
+Metafont and MetaPost, the statement terminator @samp{;} also works.
+(@LaTeX{} and other macro packages provide other interfaces to
+@code{\input} that allow different notation; here we are concerned only
+with the primitive operation.)
+
+As of Web2c version 7.5.3, double-quote characters can be used to
+include spaces or other special cases. In typical use, the @samp{"}
+characters surround the entire filename:
+@example
+\input "filename with spaces"
+@end example
+
+Technically, the quote characters can be used inside the name, and
+can enclose any characters, as in:
+@example
+\input filename" "with" "spaces
+@end example
+
+One more point. In @LaTeX{}, the quotes are needed inside the braces, thus
+@example
+\input@{a b@} % fails
+\input@{"a b"@} % ok
+@end example
+
+This quoting mechanism comes into play @emph{after} @TeX{} has
+tokenized and expanded the input. So, multiple spaces and tabs may be
+seen as a single space, active characters such as @samp{~} are
+expanded first, and so on. (See below.)
+
+@cindex NUL, not allowed in filenames
+@cindex eight-bit characters in filenames
+@cindex meta characters in filenames
+On the other hand, various C library routines and Unix itself use the null
+byte (character code zero, ASCII NUL) to terminate strings. So
+filenames in Web2c cannot contain nulls, even though @TeX{} itself does
+not treat NUL specially.
+In addition, some older Unix variants do not allow eight-bit characters
+(codes 128--255) in filenames.
+
+@cindex portable filenames
+For maximal portability of your document across systems, use only the
+characters @samp{a}--@samp{z}, @samp{0}--@samp{9}, and @samp{.}, and
+restrict your filenames to at most eight characters (not including the
+extension), and at most a three-character extension. Do not use
+anything but simple filenames, since directory separators vary among
+systems; instead, add the necessary directories to the appropriate
+search path.
+
+@kindex ~ @r{expansion in filenames}
+@kindex $ @r{expansion in filenames}
+Finally, the present Web2c implementation does @samp{~} and @samp{$}
+expansion on @var{name}, unlike Knuth's original implementation and
+older versions of Web2c. Thus:
+@example
+\input ~jsmith/$foo.bar
+@end example
+will dereference the environment variable or Kpathsea config file value
+@samp{foo} and read that file extended with @samp{.bar} in user
+@samp{jsmith}'s home directory. You can also use braces, as in
+@samp{$@{foo@}bar}, if you want to follow the variable name with a letter,
+numeral, or @samp{_}.
+
+(So another way to get a program to read a filename containing
+whitespace is to define an environment variable and dereference it.)
+
+@findex \string
+In all the common @TeX{} formats (plain @TeX{}, @LaTeX{}, AMS@TeX{}),
+the characters @samp{~} and @samp{$} have special category codes, so to
+actually use these in a document you have to change their catcodes or
+use @code{\string}. (The result is unportable anyway, see the
+suggestions above.) The place where they are most likely to be useful
+is when typing interactively.
+
+
+@node TeX
+@chapter @TeX{}: Typesetting
+
+@cindex @TeX{}, description of
+@cindex typesetting
+@cindex mathematical typesetting
+
+@TeX{} is a typesetting system: it was especially designed to handle
+complex mathematics, as well as most ordinary text typesetting.
+
+@cindex batch languages
+@cindex word processor, not
+@TeX{} is a batch language, like C or Pascal, and not an interactive
+``word processor'': you compile a @TeX{} input file into a corresponding
+device-independent (DVI) file (and then translate the DVI file to the
+commands for a particular output device). This approach has both
+considerable disadvantages and considerable advantages. For a complete
+description of the @TeX{} language, see @cite{The @TeX{}book}
+(@pxref{References}). Many other books on @TeX{}, introductory and
+otherwise, are available.
+
+@menu
+* tex invocation:: Invoking TeX.
+* Initial TeX:: Making format files.
+* Formats:: Major TeX macro packages.
+* Languages and hyphenation:: TeX supports many human languages.
+* IPC and TeX:: DVI output to a socket.
+* TeX extensions:: Changes to the TeX language.
+@end menu
+
+
+@node tex invocation
+@section @code{tex} invocation
+
+@pindex tex
+@cindex @TeX{}, invocation
+
+@TeX{} (usually invoked as @code{tex}) formats the given text and
+commands, and outputs a corresponding device-independent representation
+of the typeset document. This section merely describes the options
+available in the Web2c implementation. For a complete description of
+the @TeX{} typesetting language, see @cite{The @TeX{}book}
+(@pxref{References}).
+
+@TeX{}, Metafont, and MetaPost process the command line (described
+here) and determine their memory dump (fmt) file in the same way
+(@pxref{Memory dumps}). Synopses:
+
+@example
+tex [@var{option}]@dots{} [@var{texname}[.tex]] [@var{tex-commands}]
+tex [@var{option}]@dots{} \@var{first-line}
+tex [@var{option}]@dots{} &@var{fmt} @var{args}
+@end example
+
+@flindex .tex
+@cindex @TeX{}, input files found
+@TeX{} searches the usual places for the main input file @var{texname}
+(@pxref{Supported file formats,,, kpathsea, Kpathsea}), extending
+@var{texname} with @file{.tex} if necessary. To see all the
+relevant paths, set the environment variable @code{KPATHSEA_DEBUG} to
+@samp{-1} before running the program.
+
+After @var{texname} is read, @TeX{} processes any remaining
+@var{tex-commands} on the command line as regular @TeX{} input. Also,
+if the first non-option argument begins with a @TeX{} escape character
+(usually @code{\}), @TeX{} processes all non-option command-line
+arguments as a line of regular @TeX{} input.
+
+If no arguments or options are specified, @TeX{} prompts for an
+input file name with @samp{**}.
+
+@flindex texput
+@TeX{} writes the main DVI output to the file
+@file{@var{basetexname}.dvi}, where @var{basetexname} is the basename of
+@var{texname}, or @samp{texput} if no input file was specified. A DVI
+file is a device-independent binary representation of your @TeX{}
+document. The idea is that after running @TeX{}, you translate the DVI
+file using a separate program to the commands for a particular output
+device, such as a PostScript printer
+(@pxref{Top,,Introduction,dvips,Dvips}) or an X Window System display
+(see xdvi(1)).
+
+@cindex EC fonts
+@pindex mktextfM@r{, disabling}
+@findex \font @r{and dynamic generation}
+@TeX{} also reads TFM files for any fonts you load in your document with
+the @code{\font} primitive. By default, it runs an external program
+named @file{mktextfm} to create any nonexistent TFM files. You can
+disable this at configure-time or runtime (@pxref{mktex
+configuration,,, kpathsea, Kpathsea}). This is enabled mostly for the
+sake of the EC fonts, which can be generated at any size.
+
+@findex \openout @r{and security}
+@cindex security, and @code{\openout}
+@cindex output files, written by @TeX{} programs
+@cindex Trojan horses and @TeX{} programs
+@cindex dot files, written by @TeX{} programs
+@cindex security, and output files
+@flindex texmfmp.c @r{and @code{openoutnameok}}
+@TeX{} can write output files, via the @code{\openout} primitive; this
+opens a security hole vulnerable to Trojan horse attack: an unwitting
+user could run a @TeX{} program that overwrites, say, @file{~/.rhosts}.
+(MetaPost has a @code{write} primitive with similar implications). To
+alleviate this, there is a configuration variable @code{openout_any},
+which selects one of three levels of security. When it is set to
+@samp{a} (for ``any''), no restrictions are imposed. When it is set to
+@samp{r} (for ``restricted''), filenames beginning with @samp{.} are
+disallowed (except @file{.tex} because @LaTeX{} needs it). When it is set
+to @samp{p} (for ``paranoid'') additional restrictions are imposed: an
+absolute filename must refer to a file in (a subdirectory) of
+@code{TEXMFOUTPUT}, and any attempt to go up a directory level is
+forbidden (that is, paths may not contain a @samp{..} component). The
+paranoid setting is the default. (For backwards compatibility, @samp{y}
+and @samp{1} are synonyms of @samp{a}, while @samp{n} and @samp{0} are
+synonyms for @samp{r}.)
+
+In any case, all @code{\openout} filenames are recorded in the log file,
+except those opened on the first line of input, which is processed when
+the log file has not yet been opened. (If you as a @TeX{} administrator
+wish to implement more stringent rules on @code{\openout}, modifying the
+function @code{openoutnameok} in @file{web2c/lib/texmfmp.c} is intended
+to suffice.)
+
+The program accepts the following options, as well as the standard
+@samp{-help} and @samp{-version} (@pxref{Common options}):
+@table @samp
+@item -enc
+@itemx -[no]-file-line-error
+@itemx -fmt=@var{fmtname}
+@itemx -halt-on-error
+@itemx -ini
+@itemx -interaction=@var{string}
+@itemx -ipc
+@itemx -ipc-start
+@itemx -jobname=@var{string}
+@itemx -kpathsea-debug=@var{number}
+@itemx -[no]parse-first-line
+@itemx -output-directory
+@itemx -progname=@var{string}
+@itemx -recorder
+@itemx -translate-file=@var{tcxfile}
+@itemx -8bit
+These options are common to @TeX{}, Metafont, and MetaPost.
+@xref{Common options}.
+
+@item -enc
+@opindex -enc
+@cindex Unicode input
+@cindex UTF-8 input
+Enable enc@TeX{} extensions, such as @code{\mubyte}. This can be used
+to support Unicode UTF-8 input encoding. See
+@url{http://www.olsak.net/enctex.html}.
+
+@item -ipc
+@itemx -ipc-start
+@opindex -ipc
+@opindex -ipc-start
+@opindex --enable-ipc configure @r{option}
+With either option, @TeX{} writes its DVI output to a socket as well as
+to the usual @file{.dvi} file. With @samp{-ipc-start}, @TeX{} also
+opens a server program at the other end to read the output. @xref{IPC
+and TeX,,IPC and @TeX{}}.
+
+These options are available only if the @samp{--enable-ipc} option was
+specified to @code{configure} during installation of Web2c.
+
+@item -mktex=@var{filetype}
+@itemx -no-mktex=@var{filetype}
+@opindex -mktex=@var{filetype}
+@opindex -no-mktex=@var{filetype}
+Turn on or off the @samp{mktex} script associated with @var{filetype}.
+The only values that make sense for @var{filetype} are @samp{tex} and
+@samp{tfm}.
+
+@item -mltex
+@opindex -mltex
+@cindex ML@TeX{}, enabling
+@cindex program names, special
+If we are @code{INITEX} (@pxref{Initial and virgin}), enable ML@TeX{}
+extensions such as @code{\charsubdef}. Implicitly set if the program
+name is @code{mltex}. @xref{MLTeX,,ML@TeX{}}.
+
+@item -output-comment=@var{string}
+@opindex -output-comment=@var{string}
+@vindex output_comment @r{for DVI files}
+@cindex DVI comment, specifying
+@cindex regression testing
+Use @var{string} as the DVI file comment. Ordinarily, this comment
+records the date and time of the @TeX{} run, but if you are doing
+regression testing, you may not want the DVI file to have this spurious
+difference. This is also taken from the environment variable and
+config file value @samp{output_comment}.
+
+@item -shell-escape
+@opindex -shell-escape
+@itemx -no-shell-escape
+@opindex -no-shell-escape
+@cindex shell commands in @TeX{}
+@cindex Bourne shell commands in @TeX{}
+@vindex shell_escape @r{enabling in @TeX{}}
+@findex \immediate\write18
+@findex \write18 @r{shell escape extension}
+@findex system @r{C library function}
+@cindex security, and shell escapes
+Enable (or disable) the @samp{\write18@{@var{shell-command}@}}
+feature. This is also enabled if the environment variable or config
+file value @samp{shell_escape} is set to @samp{t} (but the
+@samp{-no-shell-escape} command line option overrides this). (For
+backwards compatibility, @samp{y} and @samp{1} are accepted as
+synonyms of @samp{t}). It is disabled by default to avoid security
+problems. When enabled, the @var{shell-command} string (which first
+undergoes the usual @TeX{} expansions, just as in @samp{\special}) is
+passed to the command shell (via the C library function
+@samp{system}). The output of @var{shell-command} is not diverted
+anywhere, so it will not appear in the log file. The system call
+either happens at @samp{\output} time or right away, according to the
+absence or presence of the @samp{\immediate} prefix, as usual for
+@code{\write}. (If you as a @TeX{} administrator wish to implement
+more stringent rules on what can be executed, you will need to modify
+@file{tex.ch}.)
+
+@item -src-specials
+@itemx -src-specials=@var{string}
+@cindex generating source specials
+This option makes @TeX{} output specific source information using
+@samp{\special} commands in the DVI file. These @samp{\special} track
+the current file name and line number.
+
+Using the first form of this option, the @samp{\special} commands are
+inserted automatically.
+
+In the second form of the option, @var{string} is
+a comma separated list of the following values: @samp{cr},
+@samp{display}, @samp{hbox}, @samp{math}, @samp{par}, @samp{parend},
+@samp{vbox}. You can use this list to specify where you want @TeX{} to
+output such commands. For example, @samp{-src-specials=cr,math} will
+output source information every line and every math formula.
+
+These commands can be used with the appropriate DVI viewer and text
+editor to switch from the current position in the editor to the same
+position in the viewer and back from the viewer
+to the editor.
+
+This option works by inserting @samp{\special} commands into the token
+stream, and thus in principle these additional tokens can be recovered
+or seen by the tricky-enough macros. If you run across a case, let us
+know, because this counts as a bug. However, such bugs are very hard
+to fix, requiring significant changes to @TeX{}, so please don't count
+on it.
+
+Redefining @samp{\special} will not affect the functioning of this
+option. The commands inserted into the token stream are
+hard-coded to always use the @samp{\special} primitive.
+
+@TeX{} does not pass the trip test when this option is enabled.
+
+@end table
+
+
+@node Initial TeX
+@section Initial @TeX{}
+
+@cindex initial @TeX{}
+@cindex @TeX{}, initial
+
+@flindex .fmt
+@cindex fmt files
+The @dfn{initial} form of @TeX{} is invoked by @samp{tex -ini}. It
+does lengthy initializations avoided by the ``virgin'' (@code{vir})
+form, so as to be capable of dumping @samp{.fmt} files (@pxref{Memory
+dumps}). For a detailed comparison of virgin and initial forms,
+@pxref{Initial and virgin}. In past releases, a separate program
+@command{initex} was installed to invoke the initial form, but this is
+no longer the case.
+
+For a list of options and other information, @pxref{tex invocation}.
+
+@flindex plain.fmt
+@flindex tex.fmt
+@cindex format files
+Unlike Metafont and MetaPost, many format files are commonly used with
+@TeX{}. The standard one implementing the features described in the
+@cite{@TeX{}book} is @samp{plain.fmt}, also known as @samp{tex.fmt}
+(again, @pxref{Memory dumps}). It is created by default during
+installation, but you can also do so by hand if necessary (e.g., if an
+update to @file{plain.tex} is issued):
+@example
+tex -ini '\input plain \dump'
+@end example
+@noindent
+(The quotes prevent interpretation of the backslashes from the shell.)
+Then install the resulting @file{plain.fmt} in @samp{$(fmtdir)}
+(@file{/usr/local/share/texmf/web2c} by default), and link
+@file{tex.fmt} to it.
+
+The necessary invocation for generating a format file differs for each
+format, so instructions that come with the format should explain. The
+top-level @file{web2c} Makefile has targets for making most common
+formats: @t{plain latex amstex texinfo eplain}. @xref{Formats}, for
+more details on @TeX{} formats.
+
+
+@node Formats
+@section Formats
+
+@cindex formats for @TeX{}
+@cindex @TeX{}, format packages for
+@cindex macro packages, major @TeX{}
+
+@TeX{} @dfn{formats} are large collections of macros, often dumped
+into a @file{.fmt} file (@pxref{Memory dumps}) by @code{tex -ini}
+(@pxref{Initial TeX}). A number of formats are in reasonably
+widespread use, and the Web2c Makefile has targets to make the versions
+current at the time of release. You can change which formats are
+automatically built by setting the @code{fmts} Make variable; by default,
+only the @samp{plain} and @samp{latex} formats are made.
+
+You can get the latest versions of most of these formats from the CTAN
+archives in subdirectories of @file{@var{CTAN:}/macros} (for CTAN info,
+@pxref{unixtex.ftp,,, kpathsea, Kpathsea}). The archive
+@url{ftp://ftp.tug.org/tex/lib.tar.gz} (also available from CTAN)
+contains most of these formats (although perhaps not the absolute latest
+version), among other things.
+
+@table @t
+@item latex
+@cindex @LaTeX{}
+The most widely used format. The current release is named `@LaTeX{}
+2e'; new versions are released approximately every six months, with
+patches issued as needed. The old release was called `@LaTeX{} 2.09',
+and is no longer maintained or supported. @LaTeX{} attempts to provide
+generic markup instructions, such as ``emphasize'', instead of specific
+typesetting instructions, such as ``use the 10@dmn{pt} Computer Modern
+italic font''. The @LaTeX{} home page: @url{http://www.latex-project.org}.
+
+@item context
+Con@TeX{}t is an independent macro package which has a basic document
+structuring approach similar to @LaTeX{}. It also supports creating
+interactive PDF files and has integrated MetaPost support, among many
+other interesting features. The Con@TeX{}t home page:
+@url{http://www.pragma-ade.com}.
+
+@item amstex
+@cindex AMS@TeX{}
+@cindex American Mathematical Society, typesetting system
+@cindex Mathematical Reviews
+The official typesetting system of the American Mathematical Society.
+Like @LaTeX{}, it encourages generic markup commands. The AMS also
+provides many @LaTeX{} package for authors who prefer @LaTeX{}. Taken
+together, they are used to produce nearly all AMS publications, e.g.,
+@cite{Mathematical Reviews}. The AMS@TeX{} home page:
+@url{http://www.ams.org/tex}.
+
+@item texinfo
+@cindex Texinfo
+@cindex Info format
+@cindex Free Software Foundation documentation system
+The documentation system developed and maintained by the Free Software
+Foundation for their software manuals. It can be automatically
+converted into plain text, a machine-readable on-line format called
+`info', HTML, etc. The Texinfo home page:
+@url{http://www.gnu.org/software/texinfo}.
+
+@item eplain
+@cindex Eplain
+@cindex expanded plain format
+The ``expanded plain'' format provides various common features (e.g.,
+symbolic cross-referencing, tables of contents, indexing, citations
+using Bib@TeX{}), for those authors who prefer to handle their own
+high-level formatting. The Eplain home page:
+@url{http://www.tug.org/eplain}.
+
+@item slitex
+@cindex Sli@TeX{}
+@cindex slides, producing
+An obsolete @LaTeX{} 2.09 format for making slides. It is replaced by
+the @samp{slides} document class, along with the @samp{beamer},
+@samp{texpower}, and other packages.
+
+@end table
+
+
+@node Languages and hyphenation
+@section Languages and hyphenation
+
+@cindex language support in @TeX{}
+@cindex human languages, supported in @TeX{}
+@cindex hyphenation and languages
+
+@TeX{} supports most natural languages. See also @ref{TeX extensions,,
+@TeX{} extensions}.
+
+@menu
+* MLTeX:: Multi-lingual TeX.
+* patgen invocation:: Creating hyphenation patterns.
+* TCX files:: Support for different character sets & fonts.
+@end menu
+
+
+@node MLTeX
+@subsection ML@TeX{}: Multi-lingual @TeX{}
+
+@pindex mltex
+@cindex Multi-lingual @TeX{}
+
+@cindex Ferguson, Michael
+@cindex Raichle, Bernd
+@cindex accents, hyphenating words with
+@cindex glyph substitutions
+@cindex substitutions of font glyphs
+Multi-lingual @TeX{} (@code{mltex}) is an extension of @TeX{} originally
+written by Michael Ferguson and now updated and maintained by Bernd
+Raichle. It allows the use of non-existing glyphs in a font by
+declaring glyph substitutions. These are restricted to substitutions of
+an accented character glyph, which need not be defined in the current
+font, by its appropriate @code{\accent} construction using a base and
+accent character glyph, which do have to exist in the current font.
+This substitution is automatically done behind the scenes, if necessary,
+and thus ML@TeX{} additionally supports hyphenation of words containing
+an accented character glyph for fonts missing this glyph (e.g., Computer
+Modern). Standard @TeX{} suppresses hyphenation in this case.
+
+ML@TeX{} works at @file{.fmt}-creation time: the basic idea is to
+specify the @samp{-mltex} option to @TeX{} when you @code{\dump} a
+format. Then, when you subsequently invoke @TeX{} and read that
+@code{.fmt} file, the ML@TeX{} features described below will be enabled.
+
+Generally, you use special macro files to create an ML@TeX{} @code{.fmt}
+file.
+
+The sections below describe the two new primitives that ML@TeX{} defines.
+Aside from these, ML@TeX{} is completely compatible with standard @TeX{}.
+
+@menu
+* \charsubdef:: Character substitution definitions.
+* \tracingcharsubdef:: Tracing substitutions.
+@end menu
+
+
+@node \charsubdef
+@subsubsection @code{\charsubdef}: Character substitutions
+
+@findex \charsubdef @r{and ML@TeX{}}
+
+The most important primitive ML@TeX{} adds is @code{\charsubdef}, used
+in a way reminiscent of @code{\chardef}:
+@example
+\charsubdef @var{composite} [=] @var{accent} @var{base}
+@end example
+
+Each of @var{composite}, @var{accent}, and @var{base} are font glyph
+numbers, expressed in the usual @TeX{} syntax: @t{`\e} symbolically,
+@t{'145} for octal, @t{"65} for hex, @t{101} for decimal.
+
+ML@TeX{}'s @code{\charsubdef} declares how to construct an accented
+character glyph (not necessarily existing in the current font) using two
+character glyphs (that do exist). Thus it defines whether a character
+glyph code, either typed as a single character or using the @code{\char}
+primitive, will be mapped to a font glyph or to an @code{\accent} glyph
+construction.
+
+For example, if you assume glyph code 138
+@cindex e-circumflex
+(decimal) for an e-circumflex
+@tex
+(\^e)
+@end tex
+and you are using the Computer Modern fonts, which have the circumflex
+accent in position 18 and lowercase `e' in the usual ASCII position 101
+decimal, you would use @code{\charsubdef} as follows:
+
+@example
+\charsubdef 138 = 18 101
+@end example
+
+For the plain @TeX{} format to make use of this substitution, you have
+to redefine the circumflex accent macro @code{\^} in such a way that if
+its argument is character `e' the expansion @code{\char138 } is used
+instead of @code{\accent18 e}. Similar @code{\charsubdef} declaration
+and macro redefinitions have to be done for all other accented
+characters.
+
+To disable a previous @code{\charsubdef @var{c}}, redefine @var{c}
+as a pair of zeros. For example:
+@example
+\charsubdef '321 = 0 0 % disable N tilde
+@end example
+@cindex N tilde
+@noindent
+(Octal @t{'321} is the ISO Latin-1 value for the Spanish N tilde.)
+
+@code{\charsubdef} commands should only be given once. Although in
+principle you can use @code{\charsubdef} at any time, the result is
+unspecified. If @code{\charsubdef} declarations are changed, usually
+either incorrect character dimensions will be used or ML@TeX{} will
+output missing character warnings. (The substitution of a
+@code{\charsubdef} is used by @TeX{} when appending the character node
+to the current horizontal list, to compute the width of a horizontal box
+when the box gets packed, and when building the @code{\accent}
+construction at @code{\shipout}-time. In summary, the substitution is
+accessed often, so changing it is not desirable, nor generally useful.)
+
+
+@node \tracingcharsubdef
+@subsubsection @code{\tracingcharsubdef}: Substitution diagnostics
+
+@findex \tracingcharsubdef @r{and ML@TeX{}}
+@cindex redefined character substitutions
+To help diagnose problems with @samp{\charsubdef}, ML@TeX{} provides a
+new primitive parameter, @code{\tracingcharsubdef}. If positive, every
+use of @code{\charsubdef} will be reported. This can help track down
+when a character is redefined.
+
+@findex \tracinglostchars @r{and ML@TeX{}}
+In addition, if the @TeX{} parameter @code{\tracinglostchars} is 100 or
+more, the character substitutions actually performed at
+@code{\shipout}-time will be recorded.
+
+
+@node TCX files
+@subsection TCX files: Character translations
+
+@flindex TCX @r{character translation files}
+@flindex .tcx @r{character translation files}
+@cindex character translation files
+
+@cindex international characters
+@cindex 8-bit characters
+@cindex accented character
+TCX (@TeX{} character translation) files help @TeX{} support direct
+input of 8-bit international characters if fonts containing those
+characters are being used. Specifically, they map an input (keyboard)
+character code to the internal @TeX{} character code (a superset of
+ASCII).
+
+Of the various proposals for handling more than one input encoding,
+TCX files were chosen because they follow Knuth's original ideas for
+the use of the @samp{xchr} and @samp{xord} tables. He ventured that
+these would be changed in the WEB source in order to adjust the actual
+version to a given environment. It turns out, however, that
+recompiling the WEB sources is not as simple a task as Knuth may have
+imagined; therefore, TCX files, providing the possibility of changing
+of the conversion tables on on-the-fly, have been implemented instead.
+
+This approach limits the portability of @TeX{} documents, as some
+implementations do not support it (or use a different method for
+input-internal reencoding). It may also be problematic to determine
+the encoding to use for a @TeX{} document of unknown provenance; in
+the worst case, failure to do so correctly may result in subtle errors
+in the typeset output. But we feel the benefits outweigh these
+disadvantages.
+
+This is entirely independent of the ML@TeX{} extension (@pxref{MLTeX}):
+whereas a TCX file defines how an input keyboard character is mapped to
+@TeX{}'s internal code, ML@TeX{} defines substitutions for a
+non-existing character glyph in a font with a @code{\accent}
+construction made out of two separate character glyphs. TCX files
+involve no new primitives; it is not possible to specify
+that an input (keyboard) character maps to more than one character.
+
+@vindex WEB2C@r{, search path for TCX files}
+Information on specifying TCX files:
+
+@itemize @bullet
+@item
+The best way to specify a TCX file is to list it explicitly in the
+first line of the main document:
+@example
+%& -translate-file=@var{tcxfile}
+@end example
+
+@item
+You can also specify a TCX file to be used on a particular @TeX{} run
+with the command-line option @samp{-translate-file=@var{tcxfile}}.
+
+@item
+TCX files are searched for along the @code{WEB2C} path.
+
+@item
+Initial @TeX{} (@pxref{Initial TeX,,Initial @TeX{}}) ignores TCX files.
+@end itemize
+
+@flindex il1-t1.tcx
+@flindex il2-t1.tcx
+@flindex empty.tcx
+@cindex Cork encoding and ISO input
+@cindex T1 encoding and ISO input
+The Web2c distribution comes with a number of TCX files. Two
+important ones are @file{il1-t1.tcx} and @file{il2-t1.tcx}, which
+support ISO Latin 1 and ISO Latin 2, respectively, with Cork-encoded
+fonts (a.k.a.@ the @LaTeX{} T1 encoding). TCX files for Czech,
+Polish, and Slovak are also provided.
+
+One other notable TCX file is @file{empty.tcx}, which is, well,
+empty. Its purpose is to reset Web2C's behavior to the default (only
+visible ASCII being printable, as described below) when a format was
+dumped with another TCX being active---which is in fact the case for
+everything but plain @TeX{} in the TeX Live and other distributions.
+Thus:
+
+@example
+latex somefile8.tex
+@result{} terminal etc. output with 8-bit chars
+latex --translate-file=empty.tcx somefile8.tex
+@result{} terminal etc. output with ^^ notation
+@end example
+
+@cindex syntax of TCX files
+Syntax of TCX files:
+@enumerate
+@item
+@cindex blank lines, in TCX files
+Line-oriented. Blank lines are ignored.
+
+@item
+@cindex whitespace, in TCX files
+Whitespace is ignored except as a separator.
+
+@item
+@cindex comments, in TCX files
+Comments start with @samp{%} and continue to the end of the line.
+
+@item
+Otherwise, a line consists of one or two character codes, optionally
+followed by 0 or 1. The last number indicates whether @var{dest} is
+considered printable.
+@example
+@var{src} [@var{dest} [@var{prnt}]]
+@end example
+
+@item
+@cindex character codes, in TCX files
+@cindex octal character codes, in TCX files
+@cindex hex character codes, in TCX files
+@cindex decimal character codes, in TCX files
+Each character code may be specified in octal with a leading @samp{0},
+hexadecimal with a leading @samp{0x}, or decimal otherwise. Values must
+be between 0 and 255, inclusive (decimal).
+
+@item
+If the @var{dest} code is not specified, it is taken to be the same as
+@var{src}.
+
+@item
+If the same @var{src} code is specified more than once, it is the last
+definition that counts.
+@end enumerate
+
+@cindex printable characters, specifying
+@kindex ^^ @r{notation, avoiding}
+Finally, here's what happens: when @TeX{} sees an input character with
+code @var{src}, it 1) changes @var{src} to @var{dest}; and 2) makes the
+@var{dest} code ``printable'', i.e., printed as-is in diagnostics and the
+log file rather than in @samp{^^} notation.
+
+By default, no characters are translated, and character codes between 32
+and 126 inclusive (decimal) are printable.
+
+Specifying translations for the printable ASCII characters (codes
+32--127) will yield unpredictable results. Additionally you shouldn't
+make the following characters printable: @code{^^I} (TAB), @code{^^J}
+(line feed), @code{^^M} (carriage return), and @code{^^?} (delete),
+since @TeX{} uses them in various ways.
+
+@cindex font character code, translating
+@cindex keyboard character code, translating
+Thus, the idea is to specify the input (keyboard) character code for
+@var{src}, and the output (font) character code for @var{dest}.
+
+@cindex interaction between TCX files and @samp{-8bit}.
+By default, only the printable ASCII characters are considered printable
+by @TeX{}. If you specify the @samp{-8bit} option, all characters are
+considered printable by default. If you specify both the @samp{-8bit}
+option and a TCX file, then the TCX can set specific characters to be
+non-printable.
+
+Both the specified TCX encoding and whether characters are printable
+are saved in the dump files (like @file{tex.fmt}). So by giving these
+options in combination with @samp{-ini}, you control the defaults seen
+by anyone who uses the resulting dump file.
+
+When loading a dump, if the @samp{-8bit} option was given, then all
+characters become printable by default.
+
+When loading a dump, if a TCX file was specified, then the TCX data from
+the dump is ignored and the data from the file used instead.
+
+
+@node patgen invocation
+@subsection Patgen: Creating hyphenation patterns
+
+@pindex patgen
+@cindex hyphenation patterns, creating
+@cindex languages, hyphenation rules for
+
+Patgen creates hyphenation patterns from dictionary files for use with
+@TeX{}. Synopsis:
+
+@example
+patgen @var{dictionary} @var{patterns} @var{output} @var{translate}
+@end example
+
+Each argument is a filename. No path searching is done. The output is
+written to the file @var{output}.
+
+@c @table @var
+@c @item dictionary
+@c @cindex dictionary file
+@c @findex \lefthyphemmin
+@c @findex \righthyphenmin
+@c The first line contains the values of @code{}\lefthyphenmin} and
+@c @code{\righthyphenmin} in columns 1--2 and 3--4. Columns 5, 6, and 7 may
+@c optionally contain replacements for the default characters @samp{.},
+@c @samp{-}, and @samp{*} respectively used in the word lists.
+@c
+@c Subsequent lines are either comments (if they start with two identical
+@c characters, e.g., @samp{%%}), or contain the external representation of
+@c the lower case version of a letter, followed by an arbitrary number of
+@c upper case versions, preceded and separated by a delimiter and followed
+@c by two consecutive delimiters. The delimiter may be any character not
+@c occurring in either version.
+
+In addition, Patgen prompts interactively for other values.
+
+For more information, see @cite{Word hy-phen-a-tion by com-puter} by
+Frank Liang (@pxref{References}), and also the @file{patgen.web} source file.
+
+The only options are @samp{-help} and @samp{-version} (@pxref{Common
+options}).
+
+
+@node IPC and TeX
+@section IPC and @TeX{}
+
+@cindex IPC
+@cindex sockets
+(Sorry, but I'm not going to write this unless someone actually uses
+this feature. Let me know.)
+
+This functionality is available only if the @samp{--enable-ipc} option
+was specified to @code{configure} during installation of Web2c
+(@pxref{Installation}).
+
+@vindex IPC_DEBUG
+If you define @code{IPC_DEBUG} before compilation (e.g., with @samp{make
+XCFLAGS=-DIPC_DEBUG}), @TeX{} will print messages to standard error
+about its socket operations. This may be helpful if you are, well,
+debugging.
+
+
+@node TeX extensions
+@section @TeX{} extensions
+
+@cindex extensions to @TeX{}
+@cindex @TeX{}, extensions to
+
+The base @TeX{} program has been extended in many ways. Here's a
+partial list. Please send information on extensions not listed here to
+the address in @ref{Reporting bugs,,, kpathsea, Kpathsea}.
+
+@table @asis
+@item e-@TeX{}
+@cindex e-@TeX{}
+@cindex primitives, new
+Adds many new primitives, including right-to-left typesetting.
+Available from @url{http://www.vms.rhbnc.ac.uk/e-TeX/} and
+@file{@var{CTAN:}/systems/e-tex}.
+
+@item Omega
+@cindex Omega
+@cindex Unicode
+Adds Unicode support, right-to-left typesetting, and more. Available
+from @url{http://www.ens.fr/omega} and @file{@var{CTAN:}/systems/omega}.
+
+@item pdf@TeX{}
+@cindex pdf@TeX{}
+@cindex PDF
+A variant of @TeX{} that produces PDF instead of DVI files. It also
+includes primitives for hypertext and micro-typography. Available from
+@file{@var{CTAN:}/systems/pdftex}.
+
+@item @samp{TeX--XeT}
+@pindex TeX--XeT
+@cindex Arabic typesetting
+@cindex right-to-left typesetting
+Adds primitives and DVI opcodes for right-to-left typesetting (as used
+in Arabic, for example). An old version for @TeX{} 3.1415 is available
+from @file{@var{CTAN:}/systems/knuth/tex--xet}. A newer version is
+included in e-@TeX{}.
+
+@item File-handling @TeX{}
+@cindex File-handling @TeX{}
+@cindex DVI files, creating multiple
+@cindex multiple DVI files, creating
+Adds primitives for creating multiple DVI files in a single run; and
+appending to output files as well as overwriting. Web2c implementation
+available in the distribution file
+@file{web2c/contrib/file-handling-tex}.
+@end table
+
+
+@node Metafont
+@chapter Metafont: Creating typeface families
+
+@cindex Metafont
+@cindex typeface families
+@cindex geometric designs
+@cindex shapes
+@cindex font design
+
+Metafont is a system for producing shapes; it was designed for producing
+complete typeface families, but it can also produce geometric designs,
+dingbats, etc. And it has considerable mathematical and
+equation-solving capabilities which can be useful entirely on their own.
+
+Metafont is a batch language, like C or Pascal: you compile a Metafont
+program into a corresponding font, rather than interactively drawing
+lines or curves. This approach has both considerable disadvantages
+(people unfamiliar with conventional programming languages will be
+unlikely to find it usable) and considerable advantages (you can make
+your design intentions specific and parameterizable). For a complete
+description of the Metafont language, see @cite{The METAFONTbook}
+(@pxref{References}).
+
+@menu
+* mf invocation:: Invoking Metafont.
+* Initial Metafont:: Making bases.
+* Modes:: Device definitions for Metafont.
+* Online Metafont graphics:: Seeing MF output online.
+* gftodvi invocation:: Making proofsheets for fonts.
+* mft invocation:: Prettyprinting Metafont sources.
+@end menu
+
+
+@node mf invocation
+@section @code{mf} invocation
+
+@pindex mf
+@cindex Metafont invocation
+
+Metafont (usually invoked as @code{mf}) reads character definitions
+specified in the Metafont programming language, and outputs the
+corresponding font. This section merely describes the options available
+in the Web2c implementation. For a complete description of the Metafont
+language, see @cite{The Metafontbook} (@pxref{References}).
+
+Metafont processes its command line and determines its memory dump
+(base) file in a way exactly analogous to MetaPost and @TeX{}
+(@pxref{tex invocation}, and @pxref{Memory dumps}). Synopses:
+
+@example
+mf [@var{option}]@dots{} [@var{mfname}[.mf]] [@var{mf-commands}]
+mf [@var{option}]@dots{} \@var{first-line}
+mf [@var{option}]@dots{} &@var{base} @var{args}
+@end example
+
+Most commonly, a Metafont invocation looks like this:
+@example
+mf '\mode:=@var{mode}; mag:=@var{magnification}; input @var{mfname}'
+@end example
+@noindent
+(The single quotes avoid unwanted interpretation by the shell.)
+
+@flindex .mf
+@cindex Metafont input files
+@cindex EC fonts
+@pindex mktexmf@r{, disabling}
+Metafont searches the usual places for the main input file @var{mfname}
+(@pxref{Supported file formats,,, kpathsea, Kpathsea}), extending
+@var{mfname} with @file{.mf} if necessary. To see all the relevant
+paths, set the environment variable @code{KPATHSEA_DEBUG} to @samp{-1}
+before running the program. By default, Metafont runs an external
+program named @file{mktexmf} to create any nonexistent Metafont source
+files you input. You can disable this at configure-time or runtime
+(@pxref{mktex configuration,,, kpathsea, Kpathsea}). This is mostly
+for the sake of the EC fonts, which can be generated at any size.
+
+@flindex .@var{nnn}gf @r{generic fonts}
+@flindex mfput
+@cindex GF output
+@cindex GF files, output by Metafont
+@cindex PK files, not output by Metafont
+Metafont writes the main GF output to the file
+@file{@var{basemfname}.@var{nnn}gf}, where @var{nnn} is the font
+resolution in pixels per inch, and @var{basemfname} is the basename of
+@var{mfname}, or @samp{mfput} if no input file was specified. A GF file
+contains bitmaps of the actual character shapes. Usually GF files are
+converted immediately to PK files with GFtoPK (@pxref{gftopk
+invocation}), since PK files contain equivalent information, but are
+more compact. (Metafont output in GF format rather than PK for only
+historical reasons.)
+
+@flindex .tfm @r{output}
+@cindex TFM files, output by Metafont
+Metafont also usually writes a metric file in TFM format to
+@file{@var{basemfname}.tfm}. A TFM file contains character dimensions,
+kerns, and ligatures, and spacing parameters. @TeX{} reads only this
+@t{.tfm} file, not the GF file.
+
+@cindex mode needed to run Metafont
+@findex proof @r{mode}
+@flindex 2602gf
+@flindex .2602gf
+The @var{mode} in the example command above is a name referring to a
+device definition (@pxref{Modes}); for example, @code{localfont} or
+@code{ljfour}. These device definitions must generally be precompiled
+into the base file. If you leave this out, the default is @code{proof}
+mode, as stated in @cite{The Metafontbook}, in which Metafont outputs at
+a resolution of 2602@dmn{dpi}; this is usually not what you want. The
+remedy is simply to assign a different mode---@code{localfont}, for
+example.
+
+The @var{magnification} assignment in the example command above is a
+magnification factor; for example, if the device is 600@dmn{dpi} and you
+specify @code{mag:=2}, Metafont will produce output at 1200@dmn{dpi}.
+Very often, the @var{magnification} is an expression such as
+@code{magstep(.5)}, corresponding to a @TeX{} ``magstep'', which are
+factors of
+@tex
+1.2$\sqrt{2}$.
+@end tex
+@ifinfo
+1.2 * sqrt(2).
+@end ifinfo
+
+After running Metafont, you can use the font in a @TeX{} document as
+usual. For example:
+@example
+\font\myfont = newfont
+\myfont Now I am typesetting in my new font (minimum hamburgers).
+@end example
+
+The program accepts the following options, as well as the standard
+@samp{-help} and @samp{-version} (@pxref{Common options}):
+@table @samp
+@item -[no]-file-line-error
+@itemx -fmt=@var{fmtname}
+@itemx -halt-on-error
+@itemx -ini
+@itemx -interaction=@var{string}
+@itemx -jobname=@var{string}
+@itemx -kpathsea-debug=@var{number}
+@itemx -[no]parse-first-line
+@itemx -output-directory
+@itemx -progname=@var{string}
+@itemx -recorder
+@itemx -translate-file=@var{tcxfile}
+@itemx -8bit
+These options are common to @TeX{}, Metafont, and MetaPost.
+@xref{Common options}.
+
+@item -mktex=@var{filetype}
+@itemx -no-mktex=@var{filetype}
+@opindex -mktex=@var{filetype}
+@opindex -no-mktex=@var{filetype}
+Turn on or off the @samp{mktex} script associated with @var{filetype}.
+The only value that makes sense for @var{filetype} is @samp{mf}.
+@end table
+
+
+@node Initial Metafont
+@section Initial Metafont
+
+@cindex initial Metafont
+@cindex Metafont, initial
+
+@flindex .base
+@cindex base files
+@code{inimf} is the ``initial'' form of Metafont, which does lengthy
+initializations avoided by the ``virgin'' (@code{vir}) form, so as to
+be capable of dumping @samp{.base} files (@pxref{Memory dumps}). For
+a detailed comparison of virgin and initial forms, see @ref{Initial
+and virgin}. In past releases, a separate program @command{inimf} was
+installed to invoke the initial form, but this is no longer the case.
+
+For a list of options and other information, see @ref{mf invocation}.
+
+@flindex plain.base
+@flindex mf.base
+The only memory dump file commonly used with Metafont is the default
+@samp{plain.base}, also known as @samp{mf.base} (again, @pxref{Memory
+dumps}). It is created by default during installation, but you can also
+do so by hand if necessary (e.g., if a Metafont update is issued):
+@example
+mf -ini '\input plain; input modes; dump'
+@end example
+@noindent
+(The quotes prevent interpretation of the backslashes from the shell.)
+Then install the resulting @file{plain.base} in @samp{$(basedir)}
+(@file{/usr/local/share/texmf/web2c} by default), and link
+@file{mf.base} to it.
+
+For an explanation of the additional @file{modes.mf} file,
+see @ref{Modes}. This file has no counterpart in @TeX{} or MetaPost.
+
+@flindex cmmf.base @r{not recommended}
+@flindex cm.base
+@flindex cmbase.mf
+@cindex Computer Modern macros
+@cindex base files, plain only
+In the past, it was sometimes useful to create a base file
+@file{cmmf.base} (a.k.a.@: @file{cm.base}), with the Computer Modern
+macros also included in the base file. Nowadays, however, the
+additional time required to read @file{cmbase.mf} is exceedingly small,
+usually not enough to be worth the administrative hassle of updating the
+@file{cmmf.base} file when you install a new version of @file{modes.mf}.
+@cindex type design, personal
+People actually working on a typeface may still find it worthwhile to
+create their own base file, of course.
+
+
+@node Modes
+@section Modes: Device definitions for Metafont
+
+@cindex modes file needed for Metafont
+@cindex base files, need mode definitions
+@cindex device definitions, for Metafont
+@cindex printer characteristics, for Metafont
+Running Metafont and creating Metafont base files requires information
+that @TeX{} and MetaPost do not: @dfn{mode} definitions which specify
+device characteristics, so Metafont can properly rasterize the shapes.
+
+@flindex modes.mf @r{recommended modes file}
+When making a base file, a file containing modes for locally-available
+devices should be input after @file{plain.mf}. One commonly used file
+is @url{ftp://ftp.tug.org/tex/modes.mf}; it includes all known
+definitions.
+
+@cindex small Metafont memory and modes
+@findex mode_def
+@findex mode_setup
+If, however, for some reason you have decreased the memory available in
+your Metafont, you may need to copy @file{modes.mf} and remove the
+definitions irrelevant to you (probably most of them) instead of using
+it directly. (Or, if you're a Metafont hacker, maybe you can suggest a
+way to redefine @code{mode_def} and/or @code{mode_setup}; right now, the
+amount of memory used is approximately four times the total length of
+the @code{mode_def} names, and that's a lot.)
+
+If you have a device not included in @file{modes.mf}, please see
+comments in that file for how to create the new definition, and please
+send the definition to @email{tex-fonts@@mail.tug.org} to get it included
+in the next release of @file{modes.mf}.
+
+@findex smode @r{and dynamic Metafont mode definition}
+@cindex dynamic Metafont mode definitions with @code{smode}
+Usually, when you run Metafont you must supply the name of a mode that
+was dumped in the base file. But you can also define the mode
+characteristics dynamically, by invoking Metafont with an assignment to
+@code{smode} instead of @code{mode}, like this:
+@example
+mf '\smode:="newmode.mf"; mag:=@var{magnification}; input @var{mfname}'
+@end example
+@noindent
+This is most useful when you are working on the definition of a new
+mode.
+
+The @var{magnification} and @var{mfname} arguments are explained in
+@ref{mf invocation}. In the file @file{newmode.mf}, you should have the
+following (with no @code{mode_def} or @code{enddef}), if you are using
+@file{modes.mf} conventions:
+@example
+mode_param (pixels_per_inch, @var{dpi});
+mode_param (blacker, @var{b});
+mode_param (fillin, @var{f});
+mode_param (o_correction, @var{o});
+mode_common_setup_;
+@end example
+@noindent
+(Of course, you should use real numbers for @var{dpi}, @var{b}, @var{f},
+and @var{o}.)
+
+For more information on the use of @code{smode}, or if you are not using
+@file{modes.mf}, see page 269 of @cite{The Metafontbook}.
+
+
+@node Online Metafont graphics
+@section Online Metafont graphics
+
+@cindex online Metafont graphics
+@cindex Metafont graphics
+
+The Web2c implementation of Metafont can do online graphics with a
+number of devices. (See the Metafont manual for more information about
+how to draw on your screen.) By default, no graphics support is
+enabled.
+
+@vindex MFTERM
+@vindex TERM
+Metafont examines the @code{MFTERM} environment variable or config file
+value at runtime, or the @code{TERM} environment variable if
+@code{MFTERM} is not set, to determine the device support to use.
+Naturally, only the devices for which support has been compiled in can
+be selected.
+
+Here is a table of the possibilities, showing the @code{MFTERM} value
+and the corresponding @code{configure} option(s) in parentheses.
+
+@vtable @code
+@item epsf
+@cindex Herberts, Mathias
+@opindex --with-epsfwin
+(@samp{--with-epsfwin}) Pseudo-window server for Encapsulated
+PostScript (see @file{web2c/window/epsf.c}). This device produces an
+EPS file containing the graphics which would be displayed online on
+other devices. The name of the EPS file defaults to metafont.eps but
+can be changed by setting the MFEPSF environment variable to the new
+filename. Contributed by Mathias Herberts.
+
+@item hp2627
+@opindex --with-hp2627win
+(@samp{--with-hp2627win}) HP2627a color graphics terminals.
+
+@item mftalk
+@opindex --with-mftalkwin
+(@samp{--with-mftalkwin}) Generic window server (see
+@file{web2c/window/mftalk.c}).
+
+@item next
+@pindex DrawingServant
+@opindex --with-next
+(@samp{--with-next}) NeXT window system. This requires a separate
+program, called @code{DrawingServant}, available separately. See the
+@file{web2c/window/next.c}.
+
+@item regis
+@opindex --with-regiswin
+@cindex Regis graphics support
+(@samp{--with-regiswin}) Regis terminals.
+
+@item sun
+@cindex SunView
+@cindex Suntools
+@opindex --with-suntoolswin
+@flindex sun-gfx.c
+(@samp{--with-suntoolswin}) The old Suntools (not any flavor of X)
+window system. (You can get the even older SunWindows @code{gfx} system
+by using @file{sun-gfx.c}.)
+
+@item tek
+@cindex Tektronix
+@opindex --with-tektronixwin
+(@samp{--with-tektronixwin}) Tektronix terminals.
+
+@cindex Poole, Simon
+@item uniterm
+@cindex Tektronix 4014
+@opindex --with-unitermwin
+(@samp{--with-unitermwin}) Uniterm, Simon Poole's emulator of a smart
+Tektronix 4014 terminal. This may work with regular Tektronix terminals
+as well; it's faster than the driver @samp{--with-tek} selects.
+
+@vindex NO_X11WIN
+@pindex Xt
+@pindex Xlib
+@item xterm
+@opindex --with-x11win
+@opindex --with-x
+@opindex --with-x11
+(@samp{--with-x11win}, @samp{--with-x}, @samp{--with-x11}) The X window
+system (version 11).
+
+@opindex --with-x-toolkit=@var{kit}
+@cindex toolkits, X
+@cindex X toolkits and Metafont
+@cindex Xt support
+@cindex Xlib support
+There are two variants of the X11 support, one that works with the Xt
+toolkit, and another that works directly with Xlib. The Xt support is
+more efficient and has more functionality, so it is the default. If you
+must use the Xlib support, use @samp{configure --with-x
+--with-x-toolkit=no}.
+
+@cindex X resources
+@cindex X class name for Metafont
+@cindex class name for Metafont
+@cindex geometry for Metafont
+@cindex Metafont geometry
+@flindex .Xdefaults
+@flindex .Xresources
+@opindex -geometry@r{, supported with Xt}
+You cannot specify any of the usual X options (e.g., @samp{-geometry})
+on the Metafont command line, but you can specify X resources in your
+@file{~/.Xdefaults} or @file{~/.Xresources} file. The class name is
+@code{Metafont}. If you're using the Xt support, all the usual X toolkit
+resources are supported. If you're using the Xlib support, only the
+@code{geometry} resource is supported.
+
+@vindex DISPLAY
+You specify the X display to which Metafont connects in the
+@code{DISPLAY} environment variable, as usual.
+
+@end vtable
+
+@cindex Metafont online support, new devices
+@cindex new graphics support for Metafont
+@flindex texmfmp.c
+Writing support for a new device is straightforward. Aside from defining
+the basic drawing routines that Metafont uses (see @file{mf.web}), you
+only have to add another entry to the tables on the last page of
+@file{web2c/lib/texmfmp.c}. Or you can write an independent program and
+use MFtalk (see @file{web2c/window/mftalk.c}).
+
+
+@node gftodvi invocation
+@section GFtoDVI: Character proofs of fonts
+
+@pindex gftodvi
+@cindex character proofs of fonts
+@cindex font proofs
+@cindex proof sheets, of fonts
+
+GFtoDVI makes @dfn{proof sheets} from a GF bitmap file as output by, for
+example, Metafont (@pxref{Metafont}). This is an indispensable aid for
+font designers or Metafont hackers. Synopsis:
+
+@example
+gftodvi [@var{option}]@dots{} @var{gfname}[gf]
+@end example
+
+The font @var{gfname} is searched for in the usual places (@pxref{Glyph
+lookup,,, kpathsea, Kpathsea}). To see all the relevant paths, set the
+environment variable @code{KPATHSEA_DEBUG} to @samp{-1} before running
+the program.
+
+The suffix @samp{gf} is supplied if not already present. This suffix is
+not an extension; no @samp{.} precedes it: for instance @file{cmr10.600gf}.
+
+The output filename is the basename of @var{gfname} extended with
+@file{.dvi}, e.g., @samp{gftodvi /wherever/foo.600gf} creates
+@file{./foo.dvi}.
+
+The characters from @var{gfname} appear one per page in the DVI output,
+with labels, titles, and annotations, as specified in Appendix H
+(Hardcopy Proofs) of @cite{The Metafontbook}.
+
+GFtoDVI uses several fonts besides @var{gfname} itself:
+
+@itemize @bullet
+@item
+@cindex gray font
+@dfn{gray font} (default @file{gray}): for the pixels that actually make
+up the character. Simply using black is not right, since then labels,
+key points, and other information could not be shown.
+
+@item
+@cindex title font
+@dfn{title font} (default @file{cmr8}): for the header information at
+the top of each output page.
+
+@item
+@cindex label font
+@dfn{label font} (default @file{cmtt10}): for the labels on key points
+of the figure.
+
+@item
+@cindex slant font
+@dfn{slant font} (no default): for diagonal lines, which are otherwise
+simulated using horizontal and vertical rules.
+
+@end itemize
+
+To change the default fonts, you must use @code{special} commands in
+your Metafont source file.
+
+The program accepts the following option, as well as the standard
+@samp{-verbose}, @samp{-help}, and @samp{-version} (@pxref{Common
+options}):
+@table @samp
+@item -overflow-label-offset=@var{points}
+@opindex -overflow-label-offset=@var{points}
+@cindex overflow label offset
+@cindex offset for overflow labels
+Typeset the so-called overflow labels, if any, @var{points} @TeX{}
+points from the right edge of the character bounding box. The default
+is a little over two inches (ten million scaled points, to be precise).
+Overflow equations are used to locate coordinates when their actual
+position is too crowded with other information.
+@end table
+
+
+@node mft invocation
+@section MFT: Prettyprinting Metafont source
+
+@pindex mft
+@cindex Metafont source, prettyprinting
+@cindex prettyprinting Metafont source
+@cindex @TeX{}, creating from Metafont
+
+@flindex mftmac.tex
+MFT translates a Metafont program into a @TeX{} document suitable for
+typesetting, with the aid of @TeX{} macros defined in the file
+@file{mftmac.tex}. Synopsis:
+
+@example
+mft [@var{option}]@dots{} @var{mfname}[.mf]
+@end example
+
+MFT searches the usual places for @var{mfname} (@pxref{Supported file
+formats,,, kpathsea, Kpathsea}). To see all the relevant paths, set the
+environment variable @code{KPATHSEA_DEBUG} to @samp{-1} before running
+the program. The output goes to the basename of @var{mfname} extended
+with @file{.tex}, e.g., @samp{mft /wherever/foo.mf} creates
+@file{./foo.tex}.
+
+Line breaks in the input are carried over into the output; moreover,
+blank spaces at the beginning of a line are converted to quads of
+indentation in the output. Thus, you have full control over the
+indentation and line breaks. Each line of input is translated
+independently of the others.
+
+Further control is allowed via Metafont comments:
+@cindex comments, MFT control
+@itemize @bullet
+@item
+Metafont comments following a single @samp{%} should be valid @TeX{}
+input. But Metafont material can be included within vertical bars in a
+comment; this will be translated by MFT as if it were regular Metafont
+code. For example, a comment like @samp{% |x2r| is the tip of the bowl}
+will be translated into the @TeX{} @samp{% $x_@{2r@}$ is the @dots{}},
+i.e., the @samp{x2r} is treated as an identifier.
+
+@item
+@samp{%%} indicates that the remainder of an input line should be copied
+verbatim to the output. This is typically used to introduce additional
+@TeX{} material at the beginning or an MFT job, e.g. code to modify the
+standard layout or the formatting macros defined in @file{mftmac.tex},
+or to add a line saying @samp{%%\bye} at the end of the job. (MFT
+doesn't add this automatically in order to allow processing several
+files produces by MFT in the same @TeX{} job.)
+
+@item
+@samp{%%% @var{token1} @var{other-tokens}}
+introduces a change in MFT's formatting rules; all the @var{other-tokens}
+will henceforth be translated according to the current conventions for
+@var{token1}. The tokens must be symbolic (i.e., not
+numeric or string tokens). For example, the input line
+@example
+%%% addto fill draw filldraw
+@end example
+@noindent
+says to format the @samp{fill}, @samp{draw}, and @samp{filldraw}
+operations of plain Metafont just like the primitive token @samp{addto},
+i.e., in boldface type. Without such reformatting commands, MFT would
+treat @samp{fill} like an ordinary tag or variable name. In fact, you
+need a @samp{%%%} command even to get parentheses to act like
+delimiters.
+
+@item
+@samp{%%%%} introduces an MFT comment, i.e., MFT ignores the remainder
+of such a line.
+
+@item
+Five or more @samp{%} signs should not be used.
+@end itemize
+
+@cindex Knuth, Donald E.
+(The above description was edited from @file{mft.web}, written by
+@w{D.E. Knuth}.)
+
+The program accepts the following options, as well as the standard
+@samp{-help} and @samp{-version} (@pxref{Common options}):
+@table @samp
+@item -change=@var{chfile}[.ch]
+@opindex -change=@var{chfile}
+@cindex change files, and MFT
+Apply the change file @var{chfile} as with Tangle and Weave
+(@pxref{WEB}).
+
+@item -style=@var{mftfile}[.mft]
+@opindex -style=@var{mftfile}
+@cindex style files
+@flindex plain.mft
+Read @var{mftfile} before anything else; a MFT style file typically
+contains only MFT directives as described above. The default style file
+is named @file{plain.mft}, which defines this properly for programs
+using plain Metafont. The MFT files is searched along the
+@code{MFTINPUTS} path; see @ref{Supported file formats,,, kpathsea, Kpathsea}.
+
+@flindex cmbase.mft
+@flindex e.mft
+@cindex @cite{Computer Modern Typefaces}, production of
+Other examples of MFT style files are @file{cmbase.mft}, which defines
+formatting rules for the macros defined in @file{cm.base}, and
+@file{e.mft}, which was used in the production of Knuth's Volume@w{ }E,
+@cite{Computer Modern Typefaces}.
+
+@cindex MetaPost source, prettyprinting
+Using an appropriate MFT style file, it is also possible to configure
+MFT for typesetting MetaPost sources. However, MFT does not search
+the usual places for MetaPost input files.
+@end table
+
+If you use eight-bit characters in the input file, they are
+passed on verbatim to the @TeX{} output file; it is up to you to
+configure @TeX{} to print these properly.
+
+
+@node MetaPost
+@chapter MetaPost: Creating technical illustrations
+
+@cindex MetaPost
+@cindex PostScript meets Metafont
+@cindex Metafont meets PostScript
+MetaPost is a picture-drawing language similar to Metafont
+(@pxref{Metafont}), but instead of outputting bitmaps in a ``font'', it
+outputs PostScript commands. It's primarily intended for creating
+technical illustrations.
+
+MetaPost also provides for arbitrary integration of text and graphics in
+a natural way, using any typesetter (@TeX{} and Troff are both
+supported) and a number of other subsidiary programs, described below.
+
+@menu
+* mpost invocation:: Invoking MetaPost.
+* Initial MetaPost:: Making mems.
+* makempx invocation:: Create MPX files for labels.
+* dvitomp invocation:: DVI-to-MPX translation.
+* dmp invocation:: Ditroff-to-MPX translation.
+* mpto invocation:: Extracting labels from MetaPost programs.
+* newer invocation:: Is one file newer than another?
+@end menu
+
+
+@node mpost invocation
+@section @code{mpost} invocation
+
+@pindex mpost
+@cindex MetaPost invocation
+
+@flindex mpman.ps
+MetaPost (installed as @code{mpost}) reads a series of pictures
+specified in the MetaPost programming language, and outputs
+corresponding PostScript code. This section merely describes the
+options available in the Web2c implementation. For a complete
+description of the MetaPost language, see AT&T technical report
+CSTR-162, generally available in @file{@var{texmf}/doc/metapost/},
+where @var{texmf} is the root of @TeX{} directory structure. See
+also:
+@itemize @bullet
+@item @url{http://cm.bell-labs.com/who/hobby/MetaPost.html} (the
+ MetaPost author's home page);
+@item @url{http://tug.org/metapost.html} (papers, packages, and
+ related information).
+@end itemize
+
+@flindex mpgraph.ps
+Also, a standard MetaPost package for drawing graphs is documented in
+AT&T technical report CSTR-164, available as the file @file{mpgraph.ps},
+generally stored alongside @file{mpman.ps}.
+
+MetaPost processes its command line and determines its memory dump (mem)
+file in a way exactly analogous to Metafont and @TeX{} (@pxref{tex
+invocation,,@code{tex} invocation}, and @pxref{Memory dumps}).
+Synopses:
+
+@example
+mpost [@var{option}]@dots{} [@var{mpname}[.mp]] [@var{mp-commands}]
+mpost [@var{option}]@dots{} \@var{first-line}
+mpost [@var{option}]@dots{} &@var{mem} @var{args}
+@end example
+
+@flindex .mp
+@cindex MetaPost input files
+MetaPost searches the usual places for the main input file @var{mpname}
+(@pxref{Supported file formats,,, kpathsea, Kpathsea}), extending
+@var{mpname} with @file{.mp} if necessary. To see all the relevant
+paths, set the environment variable @code{KPATHSEA_DEBUG} to @samp{-1}
+before running the program.
+
+@findex beginfig
+@flindex .@var{nnn} @r{PostScript figures}
+@flindex .tfm @r{output}
+@flindex mpout
+@cindex TFM files, output by MetaPost
+@cindex PostScript output
+MetaPost writes its PostScript output to a series of files
+@file{@var{basempname}.@var{nnn}} (or perhaps
+@file{@var{basempname}.ps}, very occasionally
+@file{@var{basempname}.tfm}), where @var{nnn} are the figure numbers
+specified in the input, typically to the @code{beginfig} macro, and
+@var{basempname} is the basename of @var{mpname}, or @samp{mpout} if no
+input file was specified. MetaPost uses the @samp{.ps} extension when
+the figure number is out of range, e.g., if you say @code{beginfig(-1)}.
+
+You can use the output files as figures in a @TeX{} document just as
+with any other PostScript figures. For example, with this @TeX{} command:
+@example
+\special@{psfile="@var{filename}"@}
+@end example
+@noindent
+or by using @file{epsf.tex} (@pxref{EPSF macros,,, dvips, Dvips}).
+
+@findex btex @r{for MetaPost labels}
+@findex etex @r{for MetaPost labels}
+The MetaPost construct
+@example
+btex @dots{} @var{tex-input} @dots{} etex
+@end example
+@noindent
+calls MakeMPX to generate a MPX file containing a MetaPost picture
+expression corresponding to @var{tex-input} (@pxref{makempx
+invocation}).
+
+The construct
+@example
+verbatimtex @dots{} @var{tex-input} @dots{} etex
+@end example
+@noindent
+simply passes the @var{tex-input} through to MakeMPX and thus to
+@TeX{}. For example, if you are using @LaTeX{}, your MetaPost input file
+must start with a @code{verbatimtex} block that gives the necessary
+@code{\documentclass} (or @code{\documentstyle})
+@code{\begin@{document@}} command. You will also need to set the
+enviroment variable @code{TEX} to @samp{latex} (@pxref{makempx
+invocation}).
+
+@var{tex-input} need not be specifically @TeX{} input; it could also be
+Troff. In that case, you will need the @samp{-m pictures} Troff macro
+package (unfortunately absent from many Troff implementations), or an
+equivalent such as the @samp{-m pspic} macros from GNU groff described
+in grops(1).
+
+Other typesetters can be supported with no change to MetaPost itself;
+only MakeMPX needs to be updated.
+
+@cindex PostScript fonts, and Troff
+@cindex Troff, and MetaPost
+@cindex Computer Modern fonts, and Troff
+Naturally, you must use fonts that are supported by the typesetter;
+specifically, you'll probably want to use standard PostScript fonts with
+Troff. And only the @TeX{} system understands Computer Modern or other
+Metafont fonts; you can also use PostScript fonts with @TeX{}, of course.
+
+@flindex mproof.tex
+@cindex downloading of fonts for MetaPost labels
+@cindex font downloading for MetaPost labels
+MetaPost-generated PostScript figures which do use Computer Modern fonts
+for labels cannot be directly previewed or printed. Instead, you must
+include them in a @TeX{} document and run the resulting DVI file through
+Dvips to arrange for the downloading of the required fonts (@pxref{Fonts
+in figures,,, dvips, Dvips}). To help with this, the MetaPost
+distribution provides a small @TeX{} file @file{mproof.tex} which is
+typically called as:
+@example
+tex mproof @var{mp-output-files}... ; dvips mproof -o
+@end example
+@noindent
+The resulting file @file{mproof.ps} can then be printed or previewed.
+
+@vindex prologues@r{, and EPSF output}
+@flindex psfonts.map@r{, read by MetaPost}
+To generate EPSF files, set the internal MetaPost variable
+@code{prologues} positive. To make the output files self-contained, use
+only standard PostScript fonts. MetaPost reads the same
+@file{psfonts.map} file as Dvips, to determine PostScript fonts that
+need to be downloaded (@pxref{psfonts.map,,, dvips, Dvips}).
+
+MetaPost can write output files, via the @code{write} primitive; this
+opens a security hole. @xref{tex invocation}.
+
+The program accepts the following options, as well as the standard
+@samp{-help} and @samp{-version} (@pxref{Common options}):
+@table @samp
+@item -[no]-file-line-error
+@itemx -fmt=@var{fmtname}
+@itemx -halt-on-error
+@itemx -ini
+@itemx -interaction=@var{string}
+@itemx -jobname=@var{string}
+@itemx -kpathsea-debug=@var{number}
+@itemx -[no]parse-first-line
+@itemx -output-directory
+@itemx -progname=@var{string}
+@itemx -recorder
+@itemx -translate-file=@var{tcxfile}
+@itemx -8bit
+These options are common to @TeX{}, Metafont, and MetaPost.
+@xref{Common options}.
+
+@item -T
+@itemx -troff
+@opindex -T
+@opindex -troff
+@vindex prologues
+Set the @code{prologues} internal variable to @code{1}, and use
+@code{makempx -troff} to generate MPX files.
+
+@item -tex=@var{texprogram}
+@opindex -tex=@var{texprogram}
+When this option is given, the program @var{texprogram} is used to
+typeset the labels.
+
+@end table
+
+
+@node Initial MetaPost
+@section Initial MetaPost
+
+@cindex initial MetaPost
+@cindex MetaPost, initial
+
+@flindex .mem
+@cindex mem files
+@code{inimpost} is the ``initial'' form of MetaPost, which does
+lengthy initializations avoided by the ``virgin'' (@code{vir}) form,
+so as to be capable of dumping @file{.mem} files (@pxref{Memory
+dumps}). For a detailed comparison of virgin and initial forms, see
+@ref{Initial and virgin}. In past releases, a separate program
+@command{inimpost} was installed for the initial form, but this is no
+longer the case.
+
+For a list of options and other information, see @ref{mpost invocation}.
+
+@flindex plain.mem
+@flindex mpost.mem
+@cindex mem files, plain only
+The principal memory dump file used with MetaPost is the default,
+@file{plain.mem}, also known as @file{mpost.mem} (again, @pxref{Memory
+dumps}). It is created by default during installation, but you can
+also do so by hand if necessary (e.g., if a @file{plain.mp} update is
+issued):
+@example
+mpost -ini '\input plain dump'
+@end example
+@noindent
+(The quotes prevent interpretation of the backslashes from the shell.)
+Then install the resulting @file{plain.mem} in @samp{$(memdir)}
+(@file{/usr/local/share/texmf/web2c} by default), and link
+@file{mpost.mem} to it.
+
+@cindex Metafont, compatibility in MetaPost
+@cindex plain Metafont, compatibility in MetaPost
+@cindex MetaPost and plain Metafont compatibility
+@flindex mfplain.mem
+MetaPost also provides a mem file with all the features of plain
+Metafont, called @file{mfplain.mem}. You can create that in the same
+way; just replace @samp{plain} in the above command with @samp{mfplain}.
+@file{mfplain.mem} file lets you directly process Metafont source files
+with MetaPost, producing character proofs (one file for each character)
+similar to those produced with Metafont in proof mode and GFtoDVI
+(@pxref{gftodvi invocation}).
+
+@flindex metafun.mp
+@cindex MetaFun, enhanced MetaPost
+@cindex Pragma ADE
+Another MetaPost mem file, named MetaFun, provides many advanced
+features. It was developed and maintained by Pragma ADE. The home
+page for MetaFun, and other MetaPost-related things from Pragma:
+@url{http://www.pragma-ade.com/metapost.htm}.
+
+
+@node makempx invocation
+@section MakeMPX: Support MetaPost labels
+
+@pindex makempx
+@cindex MetaPost labels
+@cindex captions, for MetaPost
+@cindex labels, for MetaPost
+
+In MetaPost, labels can be typeset using any document processor; the
+Web2c implementation supports @TeX{} and Troff. MakeMPX translates the
+labels from the typesetting language back into low-level MetaPost
+commands in a so-called @dfn{mpx file}, so text can be manipulated like
+other graphic objects. It is invoked automatically by MetaPost.
+Synopsis:
+
+@example
+makempx [-troff] @var{mpfile} @var{mpxfile}
+@end example
+
+@noindent
+The input comes from @var{mpfile} (no path searching is done), and the
+output goes to @var{mpxfile}. However, if the file @var{mpxfile}
+already exists, and is newer than @var{mpfile}, then nothing is done
+(presumably the file is up-to-date).
+
+Otherwise:
+@enumerate
+@item
+@cindex MPto, invoked by MakeMPX
+MPto is run to extract the label text from the
+MetaPost source file @var{mpfile} (@pxref{mpto invocation}).
+
+@item
+The typesetting program itself is run, either @TeX{} or Troff (see
+below). If @TeX{}, and the file named by the @code{MPTEXPRE}
+environment variable exists (@file{mptexpre.tex} by default), that file
+is prepended to the input from the MetaPost file.
+
+@item
+@cindex DVItoMP, invoked by MakeMPX
+@cindex DMP, invoked by MakeMPX
+The typesetter output (a DVI file in the case of @TeX{}, Ditroff output
+for Troff) is translated back to MetaPost, by DVItoMP (@pxref{dvitomp
+invocation}) or DMP (@pxref{dmp invocation}) respectively.
+@end enumerate
+
+@flindex mpxerr.log
+@flindex mpxerr.dvi
+@flindex mpxerr.tex
+@flindex mpxerr.t
+@flindex mpxerr
+If any of the above steps fail, for example if there was a typesetting
+mistake in the original @var{mpfile}, output may be left in files named
+@file{mpxerr.@{log,tex,dvi@}} (@TeX{}) or @file{mpxerr@{,.t@}} (Troff),
+so you can diagnose the problem.
+
+@opindex -troff
+@vindex prologues @r{and Troff in MetaPost}
+The @samp{-troff} option to MPto selects the Troff commands, rather than
+@TeX{}. MetaPost supplies this automatically if the @samp{-T} or
+@samp{-troff} option was specified to MetaPost.
+
+@cindex picture expressions
+@cindex mpx file, defined
+The MPX file created by MakeMPX is a sequence of MetaPost picture
+expressions, one for every label in the original MetaPost input file.
+
+The names of the commands run by MakeMPX, and the directory
+added to the shell search @code{PATH} for the commands' location, are
+overridden by environment variables. Here is a list:
+
+@vtable @code
+@item MAKEMPX_BINDIR
+The directory added to the @code{PATH}. Default is the @samp{$(bindir)}
+Make directory, which in turn is set from the configure-time
+@samp{--bindir}, @samp{--exec-prefix} and @samp{--prefix} options; if
+nothing else is specified, the default is file @samp{/usr/local}.
+
+@item NEWER
+The command run to determine if @var{mpxfile} is out of date with respect
+to @var{mpfile}; default is @samp{newer}.
+
+@item MPTOTEX
+The command run to extract MetaPost labels in @TeX{} format; default is
+@samp{mpto -tex}.
+
+@item MPTOTR
+Likewise, for Troff; default is @samp{mpto -troff}.
+
+@item DVITOMP
+The command run to convert @TeX{} output back to MetaPost; default is
+@samp{dvitomp}.
+
+@item DMP
+Likewise, for Troff; default is @samp{dmp}.
+
+@item TEX
+The command run to typeset the labels in @TeX{}; default is @samp{tex}.
+If you use @LaTeX{}, set this to @code{latex}, and supply an appropriate
+@code{verbatimtex} header in the MP source (@pxref{mpost invocation}).
+
+@item TROFF
+Likewise, for Troff; default is @samp{'eqn -d\$\$ | troff -Tpost'}. You
+may need to replace @samp{-Tpost} by @samp{-T@var{term}}, where
+@var{term} is the PostScript device name for your Troff implementation,
+e.g., @samp{ps} or @samp{psc}; see troff(1).
+
+If you change this, you will also need to set the @code{TRFONTS}
+environment variable or configuration value to point to the appropriate
+font directory, traditionally @file{/usr/lib/font/dev@var{term}}.
+
+@end vtable
+
+
+@node dvitomp invocation
+@section DVItoMP: DVI to MPX conversion
+
+@pindex dvitomp
+@cindex DVI files, converting to MPX
+@cindex MPX files, converting from DVI files
+
+DVItoMP converts DVI files into low-level MetaPost commands in a
+so-called MPX file. This program is generally invoked only by MakeMPX
+(@pxref{makempx invocation}). Synopsis:
+
+@example
+dvitomp @var{dvifile}[.dvi] [@var{mpxfile}[.mpx]]
+@end example
+
+@noindent
+If @var{mpxfile} is not specified, the output goes to the basename of
+@var{dvifile} extended with @file{.mpx}, e.g., @samp{dvitomp
+/wherever/foo.dvi} creates @file{./foo.mpx}.
+
+The only options are @samp{-help} and @samp{-version} (@pxref{Common
+options}).
+
+
+@node dmp invocation
+@section DMP: Ditroff to MPX conversion
+
+@pindex DMP
+@cindex ditroff output, converting to MPX
+@cindex MPX files, creating from ditroff output
+
+DMP converts device-independent Troff (ditroff) output files into
+low-level MetaPost commands in a so-called MPX file. This program is
+generally invoked by MakeMPX (@pxref{makempx invocation}). Synopsis:
+
+@example
+dmp [@var{ditroff-file} [@var{mpxfile}]]
+@end example
+
+@noindent
+If @var{ditroff-file} is not specified, input comes from standard input;
+and if @var{mpxfile} is not specified, output goes to standard output.
+
+@pindex dpost
+@findex D @var{c} @r{ditroff graphics}
+@findex x X @r{ditroff device control}
+@findex SetColor @r{ditroff command}
+@findex BeginPath @r{ditroff command}
+@findex DrawPath @r{ditroff command}
+DMP was written to process the output of a Troff pipeline fed the output
+of @code{mpto -troff} (@pxref{mpto invocation}). DMP understands all
+the @samp{D@var{c}} graphics functions that @code{dpost} does, but it
+ignores @samp{x X} device control functions such as @samp{x X
+SetColor:@dots{}}, @samp{x X BeginPath:}, and @samp{x X
+DrawPath:@dots{}}.
+
+@vindex MPSUPPORT
+The available font names are defined in the support file
+@file{trfonts.map}, which DMP looks for along the @code{MPSUPPORT} path.
+
+@flindex trchars.adj
+Another support file @file{trchars.adj}, also looked for along the
+@code{MPSUPPORT} path, contains a character adjustment table which
+should reflect the shift amounts found in the standard PostScript
+prologue for Troff and dpost found in the @code{TRFONTS} directory.
+Such an adjustment table is unnecessary for some Troff implementations,
+in which case @file{trchars.adj} should be replaced by an empty
+file---but it must still exist.
+
+
+DMP was written for one particular Troff implementation, and it
+unfortunately has many built-in assumptions about the output and fonts
+file formats used by Troff, which may not be satisfied in other
+environments. In particular, GNU groff uses some extensions in its file
+formats described in groff_font(5) and groff_out(5) which make its
+output completely unusable for DMP. On the other hand, the Troff
+version found in Sun Solaris 2.x, and perhaps other systems derived from
+System V R4, works fine with the default settings.
+
+If you run into trouble and want to adapt DMP to other systems,
+you might have to try the following (this is primarily for hackers):
+
+@itemize @bullet
+@item
+If DMP complains about a missing font table (e.g., @samp{Cannot find
+TR}), your Troff may not support the device @samp{post}.
+
+Check troff(1) for the devices supported by your Troff and set the
+@code{TROFF} environment variable appropriately (see above). Also,
+locate the appropriate font directory and set the @code{TRFONTS}
+variable as needed.
+
+@item
+If DMP complains about a missing font description file (e.g., @samp{Font
+TR was not in map file}), your version of Troff may be using internal
+font names different from those in the distributed @file{trfonts.map};
+e.g., TR and TI instead of R and I for Times-Roman and Times-Italic.
+
+@flindex trchars.adj
+In this case, you may have to adapt @file{trfonts.map} and perhaps also
+@file{trchars.adj} in the MetaPost support directory
+(@file{texmf/metapost/support} by default).
+
+@item
+If DMP still complains that it cannot parse the font description files
+or the Troff output (e.g., @samp{TR has a bad line in its description
+file}, you are probably out of luck and have to hack the DMP program (in
+@file{web2c/mpware/dmp.c}).
+
+Such problems may be caused by subtle differences in the file
+formats, such as use of tabs vs.@: spaces as field separators
+or decimal vs.@: octal vs.@: hex format for font metric data.
+
+A reasonably good description of the expected Troff file formats can be
+found in AT&T technical report CSTR-54 (@cite{Troff User's Manual},
+Revised 1992). Documentation on the subtle differences in other Troff
+implementation is harder to find except for GNU groff, where it's all
+documented in the above-mentioned groff_font(5) and groff_out(5).
+
+Any contributions to improve the portability of DMP or to make it work
+with GNU groff are welcome, of course.
+
+@end itemize
+
+@flindex dmp.c
+@cindex Hobby, John
+(Some of the above description was edited from the @file{dmp.c} source
+file, written by John Hobby.)
+
+The only options are @samp{--help} and @samp{--version} (@pxref{Common
+options}).
+
+
+@node mpto invocation
+@section MPto: Extract labels from MetaPost input
+
+@pindex MPto
+@cindex labels, extracting from MetaPost input
+@cindex captions, extracting from MetaPost input
+@cindex text, extracting from MetaPost input
+@cindex MetaPost input, extracting labels from
+
+@findex btex @r{and label extraction}
+@findex etex @r{and label extraction}
+@findex verbatimtex @r{MetaPost command}
+MPto extracts the labels from a MetaPost input file; this is the
+contents of any @code{btex@dots{}etex} and @code{verbatimtex@dots{}etex}
+sections. This program is generally invoked by MakeMPX (@pxref{makempx
+invocation}). Synopsis:
+
+@example
+mpto [@var{option}]@dots{} @var{mpfile}
+@end example
+
+@noindent
+The input comes from @var{mpfile}; no path searching is done. The
+output goes to standard output. Leading and trailing spaces and tabs
+are removed, and various predefined typesetter commands are included at
+the beginning of and end of the file and of each section.
+
+The program accepts the following options, as well as the standard
+@samp{-help} and @samp{-version} (@pxref{Common options}):
+@table @samp
+@item -troff
+@opindex -troff
+Surround the MetaPost sections with Troff commands.
+
+@item -tex
+@opindex -tex
+Surround the MetaPost sections with @TeX{} commands. This is the default.
+@end table
+
+
+@node newer invocation
+@section Newer: Compare file modification times
+
+@pindex newer @r{file comparison}
+@cindex comparing file modification times
+@cindex file mtimes, comparing
+@cindex mtimes of files, comparing
+@cindex older-than, file comparisons
+
+Newer compares file modification times. Synopsis:
+
+@example
+newer @var{src1} [ @var{src2} ... @var{srcN} ] @var{target}
+@end example
+
+@noindent
+Newer exits successfully if the files @var{src1} ... @var{srcN} exist
+and at least one of them is not older than @var{dependent}, i.e., the
+modification time (mtime) of at least one of the source files
+is greater than or the same as that of @var{dependent}. Newer also
+exits successfully if the file @var{dependent} doesn't exist.
+@xref{Attribute Meanings,,, libc, GNU C Library}.
+
+The program accepts the following option, as well as the standard
+@samp{--help} and @samp{--version} (@pxref{Common options}):
+@table @samp
+@item --quiet
+@opindex --quiet (newer)
+Return result only, do not print any output.
+@item --verbose
+@opindex --verbose (newer)
+List missing source files to STDERR. This is the default.
+@end table
+
+This is used by MakeMPX (@pxref{makempx invocation}).
+
+
+@node BibTeX
+@chapter Bib@TeX{}: Bibliographies
+
+@cindex bibliographies, creating
+@cindex Bib@TeX{}
+
+Bib@TeX{} automates much of the job of typesetting bibliographies, and
+makes bibliography entries reusable in many different contexts.
+
+@menu
+* bibtex invocation::
+* Basic BibTeX style files:: The standard and semi-standard styles.
+@end menu
+
+
+@node bibtex invocation
+@section Bib@TeX{} invocation
+
+@pindex bibtex
+
+@flindex .bbl @r{bibliography files}
+@flindex .aux @r{cross-reference files}
+@flindex .bib @r{bibliography databases}
+Bib@TeX{} creates a printable bibliography (@file{.bbl}) file from
+references in a @file{.aux} file, generally written by @TeX{} or
+@LaTeX{}. The @file{.bbl} file is then incorporated on a subsequent
+run. The basic bibliographic information comes from @file{.bib} files,
+and a Bib@TeX{} style (@file{.bst}) file controls the precise contents
+of the @file{.bbl} file. Synopsis:
+
+@example
+bibtex [@var{option}]@dots{} @var{auxfile}[.aux]
+@end example
+
+@flindex .blg @r{Bib@TeX{} log file}
+@cindex log file, Bib@TeX{}
+@noindent
+The output goes to the basename of @var{auxfile} extended with
+@file{.bbl}; for example, @samp{bibtex /wherever/foo.aux} creates
+@file{./foo.bbl}. Bib@TeX{} also writes a log file to the basename of
+@var{auxfile} extended with @samp{.blg}.
+
+@findex \bibliography
+@findex \bibliographystyle
+@vindex TEXBIB@r{, search path for bib files}
+@vindex BIBINPUTS@r{, search path for bib files}
+@vindex BSTINPUTS@r{, search path for bst files}
+The names of the @file{.bib} and @file{.bst} files are specified in the
+@file{.aux} file as well, via the @file{\bibliography} and
+@file{\bibliographystyle} (La)@TeX{} macros. Bib@TeX{} searches for
+@file{.bib} files using the @code{BIBINPUTS} and @code{TEXBIB} paths,
+and for @file{.bst} files using @code{BSTINPUTS} (@pxref{Supported file
+formats,,,kpathsea,Kpathsea}). It does no path searching for
+@file{.aux} files.
+
+The program accepts the following options, as well as the standard
+@samp{-help} and @samp{-version} (@pxref{Common options}):
+@table @samp
+@item -terse
+@opindex -terse
+@cindex terse output
+@cindex verbose Bib@TeX{} output, suppressing
+Suppress the program banner and progress reports normally output.
+
+@item -min-crossrefs=@var{n}
+@opindex -min-crossrefs=@var{n}
+@cindex cross-referenced bibliography items
+@cindex bibliography items, cross-referenced
+If at least @var{n} (2 by default) bibliography entries refer to another
+entry @var{e} via their @code{crossref} field, include @var{e} in the
+@t{.bbl} file, even if it was not explicitly referenced in the @t{.aux}
+file. For example, @var{e} might be a conference proceedings as a whole,
+with the cross-referencing entries being individual articles published
+in the proceedings. In some circumstances, you may want to avoid these
+automatic inclusions altogether; to do this, make @var{n} a sufficiently
+large number.
+@end table
+
+See also:
+@table @file
+@item btxdoc.tex
+@flindex btxdoc.tex
+Basic @LaTeX{}able documentation for general Bib@TeX{} users.
+
+@item btxhak.tex
+@flindex btxhak.tex
+@cindex style design, for Bib@TeX{}
+@LaTeX{}able documentation for style designers.
+
+@item btxdoc.bib
+@flindex btxdoc.bib
+Bib@TeX{} database file for the two above documents.
+
+@item xampl.bib
+@flindex xampl.bib
+Example database file with all the standard entry types.
+
+@item @url{ftp://ftp.math.utah.edu/pub/tex/bib/}
+@flindex ftp.math.utah.edu
+@cindex Bib@TeX{} collection
+@cindex TUGboat bibliography
+@cindex @TeX{}, bibliographies for
+A very large @file{.bib} and @file{.bst} collection, including
+references for all the standard @TeX{} books and a complete bibliography
+for TUGboat.
+@end table
+
+
+@node Basic BibTeX style files
+@section Basic Bib@TeX{} style files
+
+@cindex basic Bib@TeX{} style files
+@cindex Bib@TeX{} style files
+
+Here are descriptions of the four standard and four semi-standard basic
+Bib@TeX{} styles. @file{@var{CTAN:}/biblio/bibtex} contains these and
+many more (for CTAN info, @pxref{unixtex.ftp,,, kpathsea, Kpathsea}).
+
+@table @code
+@item plain
+@flindex plain.bst
+Sorts entries alphabetically, with numeric labels. Generally formatted
+according to van Leunen's @cite{A Handbook for Scholars}. The other
+style files listed here are based on @code{plain}.
+
+@item abbrv
+@flindex abbrv.bst
+First names, month names, and journal names are abbreviated.
+
+@item acm
+@flindex acm.bst
+Names are printed in small caps.
+
+@item alpha
+@flindex alpha.bst
+Alphanumeric labels, e.g., @samp{Knu66}.
+
+@item apalike
+@flindex apalike.bst
+No labels at all; instead, the year appears in parentheses after the author.
+Use this in conjunction with @file{apalike.tex} (plain @TeX{}) or
+@file{apalike.sty} (@LaTeX{}), which also changes the citations in the
+text to be @samp{(@var{author}, @var{year})}.
+
+@item ieeetr
+@flindex ieeetr.bst
+Numeric labels, entries in citation order, @sc{ieee} abbreviations,
+article titles in quotes.
+
+@item siam
+@flindex siam.bst
+Numeric labels, alphabetic order, @cite{Math.@: Reviews}
+abbreviations, names in small caps.
+
+@item unsrt
+@flindex unsrt.bst
+Lists entries in citation order, i.e., unsorted.
+
+@item btxbst.doc
+The template file and documentation for the standard styles.
+
+@end table
+
+
+@node WEB
+@chapter WEB: Literate programming
+
+@cindex WEB
+@cindex literate programming
+
+@flindex litprog@@shsu.edu
+@dfn{WEB} languages allow you to write a single source file that can
+produce both a compilable program and a well-formatted document
+describing the program in as much detail as you wish to prepare.
+Writing in this kind of dual-purpose language is called @dfn{literate
+programming}. (The Usenet newsgroup @file{comp.programming.literate}
+and the mailing list @email{litprog@@shsu.edu} are devoted to this
+subject; they are gatewayed to each other.)
+
+@flindex webman.tex
+@cindex Spiderweb
+@cindex Cweb
+@cindex CWEB
+@cindex Awk, WEB for
+@cindex Ada, WEB for
+@cindex Troff, WEB for
+WEB-like languages have been implemented with many pairs of base
+languages: Cweb provides C and Troff (@pxref{References}); CWEB provides
+C and @TeX{} (@file{@var{CTAN:}/web/c_cpp/cweb}); Spiderweb provides C,
+C++, Awk, Ada, many others, and @TeX{}
+(@file{@var{CTAN:}/web/spiderweb}); and, of course, the original WEB
+provides Pascal and @TeX{}, the implementation languages for the
+original @TeX{}, Metafont, MetaPost, and related programs to come from
+the @TeX{} project at Stanford.
+
+The original WEB language is documented in the file @file{webman.tex},
+which is included in the @url{ftp://ftp.tug.org/tex/lib.tar.gz} archive
+(and available in many other places, of course).
+
+@menu
+* tangle invocation::
+* weave invocation::
+* pooltype invocation::
+@end menu
+
+
+@node tangle invocation
+@section Tangle: Translate WEB to Pascal
+
+@pindex tangle
+@cindex Pascal, creating from WEB
+@cindex WEB programs, compiling
+
+Tangle creates a compilable Pascal program from a WEB source file
+(@pxref{WEB}). Synopsis:
+
+@example
+tangle [@var{option}]@dots{} @var{webfile}[.web] [@var{changefile}[.ch]]
+@end example
+
+@cindex change files, and Tangle
+@noindent
+The Pascal output is written to the basename of @var{webfile} extended
+with @samp{.p}; for example, @samp{tangle /wherever/foo.web} creates
+@file{./foo.p}. Tangle applies @var{changefile} to @var{webfile} before
+writing the output; by default, there is no change file.
+
+@cindex pool file, writing
+@cindex string pool, writing
+If the program makes use of the WEB string facility, Tangle writes the
+string pool to the basename of @var{webfile} extended with @samp{.pool}.
+
+The Pascal output is packed into lines of 72 characters or less, with
+the only concession to readability being the termination of lines at
+semicolons when this can be done conveniently.
+
+The program accepts the following options, as well as the standard
+@samp{--help} and @samp{--version} (@pxref{Common options}):
+
+@table @samp
+@item -length=@var{number}
+@opindex -length=@var{number}
+@cindex identifier length
+The number of characters that are considered significant in an
+identifier. Whether underline characters are counted depends on the
+@samp{-underline} option. The default value is 32, the original tangle
+used 7, but this proved too restrictive for use by Web2c.
+
+@item -lowercase
+@itemx -mixedcase
+@itemx -uppercase
+@opindex -lowercase
+@opindex -mixedcase
+@opindex -uppercase
+@cindex identifier case
+These options specify the case of identifiers in the output of tangle.
+If @samp{-uppercase} (@samp{-lowercase}) is specified, tangle will
+convert all identfiers to uppercase (lowercase). The default is
+@samp{-mixedcase}, which specifies that the case will not be changed.
+
+@item -underline
+@opindex -underline
+@cindex identifiers with underlines
+When this option is given, tangle does not strip underline characters
+from identifiers.
+
+@item -loose
+@itemx -strict
+@opindex -loose
+@opindex -strict
+@cindex identifier collisions
+These options specify how strict tangle must be when checking
+identifiers for equality. The default is @samp{-loose}, which means
+that tangle will follow the rules set by the case-smashing and underline
+options above. If @samp{-strict} is set, then identifiers will always
+be stripped of underlines and converted to uppercase before checking
+whether they collide.
+
+@end table
+
+@node weave invocation
+@section Weave: Translate WEB to @TeX{}
+
+@pindex weave
+@cindex @TeX{}, creating from WEB
+@cindex WEB programs, typesetting
+@cindex prettyprinting WEB programs
+
+Weave creates a @TeX{} document from a WEB source file (@pxref{WEB}),
+assuming various macros defined in @file{webmac.tex}. It takes care of
+typographic details such as page layout, indentation, and italicizing
+identifiers. It also automatically gathers and outputs extensive
+cross-reference information. Synopsis:
+
+@example
+weave [@var{option}]@dots{} @var{webfile}[.web] [@var{changefile}[.ch]]
+@end example
+
+@cindex change files, and Weave
+@noindent
+The output is to the basename of @var{webfile} extended with
+@samp{.tex}; for example, @samp{weave /wherever/foo.web} creates
+@file{./foo.tex}. Weave applies @var{changefile} to @var{webfile}
+before writing the output; by default, there is no change file.
+
+The program accepts the following option, as well as the standard
+@samp{-verbose}, @samp{-help} and @samp{-version} (@pxref{Common
+options}):
+@table @samp
+@item -x
+@opindex -x
+@cindex cross-references, omitting
+@flindex CONTENTS.tex
+@flindex webmac.tex
+Omit the cross-reference information: the index, the list of WEB module
+names, and the table of contents (an empty @file{CONTENTS.tex} file will
+still be written when the Weave output file is processed by @TeX{} using
+the default @file{webmac.tex}, though).
+@end table
+
+Conventionally, WEB programmers should define the @TeX{} @code{\title}
+macro at the beginning of the source file. Also, to get output of only
+changed modules, one can say @code{\let\maybe=\iffalse} (usually as the
+first change in the change file).
+
+
+@node pooltype invocation
+@section Pooltype: Display WEB pool files
+
+@pindex pooltype
+@cindex type programs, pool
+@cindex string numbers, displaying
+@cindex WEB pool files, displaying
+
+Pooltype shows the so-called @dfn{string number} of each string in a WEB
+pool file (@pxref{WEB}), as output by Tangle (@pxref{tangle
+invocation}), including the first 256 strings corresponding to the
+possible input characters. Pooltype primarily serves as an example of
+WEB conventions to implementors of the @TeX{} system. Synopsis:
+
+@example
+pooltype [@var{option}]@dots{} @var{poolfile}[.pool]
+@end example
+
+@noindent
+No path searching is done for @var{poolfile}. Output is to standard
+output.
+
+The only options are @samp{--help} and @samp{--version} (@pxref{Common
+options}).
+
+As an example of the output, here is the (edited) output for @file{tex.pool}:
+@example
+0: "^^@@"
+1: "^^A"
+@dots{}
+255: "^^ff"
+256: "pool size"
+@dots{}
+1314: "Using character substitution: "
+(23617 characters in all.)
+@end example
+
+@cindex representation of strings
+@cindex string representation
+In Metafont and MetaPost, the first 256 characters are actually
+represented as single bytes (i.e., themselves), not in the @samp{^^}
+notation. Consider Pooltype as showing the results after conversion for
+output.
+
+
+@node DVI utilities
+@chapter DVI utilities
+
+@cindex DVI utilities
+
+@TeX{} outputs a file in @dfn{DVI} (DeVice Independent) format as a
+compact representation of the original document. DVI files can be
+translated to meet the requirements of a real physical device, such as
+PostScript printers (@pxref{Top,, Introduction, dvips, Dvips}), PCL
+printers (see dvilj(1)), and X displays (see xdvi(1)). In fact, DVI
+translators are available for virtually all common devices: see
+@file{@var{CTAN:}/dviware} (for CTAN info, @pxref{unixtex.ftp,,,
+kpathsea, Kpathsea}).
+
+@flindex dvitype.web
+@cindex DVI format definition
+For the precise definition of the DVI file format, see (for example) the
+source file @file{web2c/dvitype.web}.
+
+The DVI-processing programs in the Web2c distribution are not device
+drivers; they perform generic utility functions.
+
+@menu
+* dvicopy invocation:: Expand virtual fonts.
+* dvitype invocation:: DVI to human-readable text.
+@end menu
+
+@node dvicopy invocation
+@section DVIcopy: Canonicalize virtual font references
+
+@pindex dvicopy
+@cindex virtual fonts, expanding
+
+DVIcopy reads a DVI file, expands any references to virtual fonts
+(@pxref{Virtual fonts,,, dvips, Dvips}) to base fonts, and writes the
+resulting DVI file. Thus you can use virtual fonts even if your DVI
+processor does not support them, by passing the documents through
+DVIcopy first. Synopsis:
+
+@example
+dvicopy [@var{option}]@dots{} [@var{indvi}[.dvi] [@var{outdvi}[.dvi]]]
+@end example
+
+DVIcopy reads standard input if @var{indvi} is not specified, and writes
+standard output if @var{outdvi} is not specified.
+
+The program accepts the following options, as well as the standard
+@samp{-help} and @samp{-version} (@pxref{Common options}):
+@table @samp
+@item -magnification=@var{integer}
+@opindex -magnification=@var{integer}
+@cindex magnification
+@findex \mag
+Override existing magnification in @var{indvi} with @var{integer}; 1000
+specifies no magnification. This is equivalent to setting @TeX{}'s
+@code{\mag} parameter.
+
+@item -max-pages=@var{n}
+@opindex -max-pages=@var{n}
+Process @var{n} pages; default is one million.
+
+@item -page-start=@var{page-spec}
+@opindex -page-start=@var{page-spec}
+@cindex starting page
+@cindex page, starting
+@findex \count@var{n}
+Start at the first page matching @var{page-spec}, which is one or more
+(signed) integers separated by periods, corresponding to @TeX{}'s
+@code{\count0@dots{}9} parameters at @code{\shipout} time; @samp{*}
+matches anything. Examples: @samp{3}, @samp{1.*.-4}.
+@end table
+
+
+@node dvitype invocation
+@section DVItype: Plain text transliteration of DVI files
+
+@pindex dvitype @r{DVI validation}
+@cindex conversion, DVI to plain text
+@cindex plain text, converting DVI to
+@cindex human-readable text, converting DVI to
+@cindex type programs, DVI
+@cindex validation, of DVI files
+
+DVItype translates a DeVice Independent (DVI) file (as output by @TeX{},
+for example) to a plain text file that humans can read. It also serves
+as a DVI-validating program, i.e., if DVItype can read a file, it's
+correct. Synopsis:
+
+@example
+dvitype [@var{option}]@dots{} @var{dvifile}[.dvi]
+@end example
+
+@noindent
+DVItype does not read any bitmap files, but it does read TFM files for
+fonts referenced in @var{dvifile}. The usual places are searched
+(@pxref{Supported file formats,,, kpathsea, Kpathsea}). To see all the
+relevant paths, set the environment variable @code{KPATHSEA_DEBUG} to
+@samp{-1} before running the program.
+
+Output goes to standard output.
+
+The program accepts the following options, as well as the standard
+@samp{-help} and @samp{-version} (@pxref{Common options}):
+@table @samp
+@item -dpi=@var{real}
+@opindex -dpi=@var{real}
+Do pixel movement calculations at @var{real} pixels per inch; default
+300.0.
+
+@item -magnification=@var{integer}
+@opindex -magnification=@var{integer}
+@cindex magnification
+@findex \mag
+Override existing magnification in @var{indvi} with @var{integer}; 1000
+specifies no magnification. This is equivalent to setting @TeX{}'s
+@code{\mag} parameter.
+
+@item -max-pages=@var{n}
+@opindex -max-pages=@var{n}
+Process @var{n} pages; default is one million.
+
+@item -output-level=@var{n}
+@opindex -output-level=@var{n}
+Verbosity level of output, from 0 to 4 (default 4):
+@itemize @bullet
+@item 0: Global document information only.
+@item 1: Most DVI commands included, and typeset characters summarized.
+@item 2: Character and movement commands explicitly included.
+@item 3: DVI stack and current position calculations included.
+@item 4: Same information as level 3, but DVItype does random positioning
+in the file, reading the DVI postamble first.
+@end itemize
+
+@item -page-start=@var{page-spec}
+@opindex -page-start=@var{page-spec}
+@cindex starting page
+@cindex page, starting
+@findex \count@var{n}
+Start at the first page matching @var{page-spec}, which is one or more
+(signed) integers separated by periods, corresponding to @TeX{}'s
+@code{\count0@dots{}9} parameters at @code{\shipout} time; @samp{*}
+matches anything. Examples: @samp{1}, @samp{5.*.-9}.
+
+@item -show-opcodes
+@opindex -show-opcodes
+@cindex opcodes, showing DVI
+@cindex DVI opcodes, showing
+@cindex debugging DVI utilities
+Show numeric opcode values (in decimal) for DVI commands, in braces
+after the command name. This can help in debugging DVI utilities. We
+use decimal because in the DVI format documentation (in
+@file{dvitype.web}, among others) the opcodes are shown in decimal.
+@end table
+
+@menu
+* dvitype output example::
+@end menu
+
+
+@node dvitype output example
+@subsection DVItype output example
+
+@cindex dvitype output example
+As an example of the output from DVItype (see section above), here is
+its (abridged) translation of the @file{story.dvi} resulting from
+running the example in @cite{The @TeX{}book}, with
+@samp{-output-level=4} and @samp{-show-opcodes} on.
+
+@example
+@dots{}
+Options selected:
+ Starting page = *
+ Maximum number of pages = 1000000
+ Output level = 4 (the works)
+ Resolution = 300.00000000 pixels per inch
+numerator/denominator=25400000/473628672
+magnification=1000; 0.00006334 pixels per DVI unit
+' TeX output 1992.05.17:0844'
+Postamble starts at byte 564.
+maxv=43725786, maxh=30785863, maxstackdepth=3, totalpages=1
+Font 33: cmsl10---loaded at size 655360 DVI units
+Font 23: cmbx10---loaded at size 655360 DVI units
+Font 0: cmr10---loaded at size 655360 DVI units
+
+42: beginning of page 1
+87: push @{141@}
+level 0:(h=0,v=0,w=0,x=0,y=0,z=0,hh=0,vv=0)
+88: down3 -917504 @{159@} v:=0-917504=-917504, vv:=-58
+92: pop @{142@}
+@dots{}
+104: putrule @{137@} height 26214, width 30785863 (2x1950 pixels)
+113: down3 5185936 @{159@} v:=655360+5185936=5841296, vv:=370
+117: push @{141@}
+level 1:(h=0,v=5841296,w=0,x=0,y=0,z=0,hh=0,vv=370)
+118: right4 12265425 @{146@} h:=0+12265425=12265425, hh:=777
+[ ]
+123: fntdef1 23 @{243@}: cmbx10
+145: fntnum23 @{194@} current font is cmbx10
+146: setchar65 h:=12265425+569796=12835221, hh:=813
+147: w3 251220 @{150@} h:=12835221+251220=13086441, hh:=829
+151: setchar83 h:=13086441+418700=13505141, hh:=856
+@dots{}
+164: setchar82 h:=17448202+565245=18013447, hh:=1142
+165: x0 -62805 @{152@} h:=18013447-62805=17950642, hh:=1138
+166: setchar89 h:=17950642+569796=18520438, hh:=1174
+[A SHORT STORY]
+167: pop @{142@}
+level 1:(h=0,v=5841296,w=0,x=0,y=0,z=0,hh=0,vv=370)
+@dots{}
+550: pop @{142@}
+level 0:(h=0,v=42152922,w=0,x=0,y=0,z=0,hh=0,vv=2670)
+551: down3 1572864 @{159@} v:=42152922+1572864=43725786, vv:=2770
+555: push @{141@}
+level 0:(h=0,v=43725786,w=0,x=0,y=0,z=0,hh=0,vv=2770)
+556: right4 15229091 @{146@} h:=0+15229091=15229091, hh:=965
+561: setchar49 h:=15229091+327681=15556772, hh:=986
+[ 1]
+562: pop @{142@}
+level 0:(h=0,v=43725786,w=0,x=0,y=0,z=0,hh=0,vv=2770)
+563: eop @{140@}
+@end example
+
+Explanation:
+
+@itemize @bullet
+@item
+The DVItype options are recorded at the beginning, followed by
+global information about the document, including fonts used.
+
+@item
+Each DVI command is preceded by its byte position in the file
+(@samp{42:}, @samp{87:}, @dots{}), and (because of the
+@samp{-show-opcodes}) followed by its decimal opcode value in braces
+(@samp{@{141@}}, @samp{@{142@}}, @dots{}).
+
+@item
+The @samp{level} lines record information about the DVI stack; @samp{h}
+and @samp{v} define the current position in DVI units, while @samp{hh}
+and @samp{vv} are the same in pixels.
+
+@item
+Text sequences are summarized in brackets, as in @samp{[A SHORT
+STORY]} and the @samp{[ 1]}.
+@end itemize
+
+
+@node Font utilities
+@chapter Font utilities
+
+@cindex font utilities
+
+The Web2c programs described here convert between various @TeX{}-related
+font formats; the first section below briefly describes the
+formats. GFtoPK is the only one that is routinely used, as Metafont
+outputs GF format, but it's most efficient for device drivers to use PK.
+
+@flindex pktype.web
+@flindex gftype.web
+@cindex PK format definition
+@cindex GF format definition
+The precise definitions of the PK, GF, TFM, PL, VF, and VPL formats
+mentioned below are in the source files that read them;
+@file{pktype.web}, @file{gftype.web}, @file{tftopl.web}, etc.
+
+@menu
+* Font file formats:: Explanations of GF, PK, TFM, VF, ...
+* gftopk invocation:: GF -> PK (compact)
+* pktogf invocation:: PK -> GF (expand).
+* pktype invocation:: PK -> human-readable text.
+* gftype invocation:: GF -> human-readable text.
+* tftopl invocation:: TFM -> PL (for editing TFM).
+* pltotf invocation:: PL -> TFM (make editing results usable).
+* vftovp invocation:: VF -> VPL (tftopl for virtual fonts).
+* vptovf invocation:: VPL -> VF (pltotf for virtual fonts).
+* Font utilities available elsewhere:: Type 1, BDF, editors, etc.
+@end menu
+
+
+@node Font file formats
+@section Font file formats
+
+@cindex font file formats
+@cindex file formats for fonts
+
+(For another perspective on this, @pxref{Font concepts,,, dvips,
+Dvips}).
+
+Font files come in several varieties, with suffixes like:
+@example
+.tfm .*pk .*gf .*pxl@r{ (obsolete)} .pl .mf .vf .vpl
+@end example
+@noindent
+Each represents a file format.
+
+@cindex TFM files, explained
+A TFM (@TeX{} font metric) file is a compact binary file that contains
+information about each character in a font, about combinations of
+characters within that font, and about the font as a whole. The font
+metric information contained in TFM files is device-independent units is
+used by @TeX{} to do typesetting. Unlike the bitmap (raster) fonts
+described below, TFM font files contain no information about the shapes
+of characters. They describe rectangular areas and combinations
+thereof, but not what will eventually be printed in those areas.
+
+@cindex scaling of fonts
+@cindex optical font scaling
+@cindex geometric font scaling
+@cindex PostScript, and font scaling
+Since @TeX{} does scaling calculations, one TFM file serves for all
+magnifications of a given typeface. On the other hand, the best printed
+results are obtained when magnified (or reduced fonts) are not produced
+geometrically (as done by PostScript, for example) but rather optically,
+with each size a separate design (as done with Computer Modern and the
+EC fonts, for example); then a separate TFM file is needed for each
+size.
+
+@cindex DVI files, explained
+At any rate, @TeX{} produces a DVI (DeVice Independent) file from your
+source document. In order to print DVI files on real devices, you need
+font files defining digitized character shapes and other data. Then
+previewers and printer-driver programs can translate your DVI files into
+something usable by your monitor or printer. Bitmap fonts come with
+suffixes such as @samp{.600pk} or @samp{.600gf} or @samp{.3000pxl}, where
+the @samp{600} is the horizontal dots-per-inch resolution at which the
+font was produced, and the @samp{pk} or @samp{gf} or @samp{pxl}
+indicates the font format. Outline fonts in PostScript Type 1 format
+have suffixes such as @samp{.pfa} or @samp{.pfb}.
+
+@cindex PXL files, explained
+@cindex PK files, explained
+@cindex GF files, explained
+Fonts in pk (packed) format are in the tightly packed raster format that
+is pretty much the standard today. They take up less space than fonts
+in the gf (generic font) format that Metafont generates, and far less
+space than fonts in pxl format. Fonts in pxl format take up gross
+amounts of disk space and permit only 128 characters. They are
+obsolete.
+
+@cindex PL files, explained
+Font files with the @samp{.pl} (property list) suffix are the plain text
+(human-readable) analog of the binary @samp{.tfm} files.
+The TFtoPL and PLtoTF programs convert between the two formats
+(@pxref{tftopl invocation} and @ref{pltotf invocation}).
+
+Font files with the @samp{.mf} suffix are in Metafont source format.
+These are the files used by Metafont to generate rastered fonts for
+specific typefaces at specific magnifications for the specific
+resolution and type of mapping used by your device.
+
+@flindex virtual-fonts.knuth
+@flindex virtualfonts.txt
+The suffix @samp{.vf} identifies ``virtual font'' files, for which
+@samp{.vpl} is the human-readable analog. See @xref{vftovp invocation},
+and @ref{vptovf invocation}. For further discussion of virtual fonts,
+see @file{@var{CTAN:}/doc/virtual-fonts.knuth},
+@file{@var{CTAN:}/help/virtualfonts.txt}, and @ref{Virtual fonts,,,
+dvips, Dvips}.
+
+@cindex MacKay, Pierre
+@cindex Tachikawa, Elizabeth
+(This section is based on documentation in the original Unix @TeX{}
+distribution by Pierre MacKay and Elizabeth Tachikawa.)
+
+
+@node gftopk invocation
+@section GFtoPK: Generic to packed font conversion
+
+@pindex gftopk
+@cindex conversion, GF to PK
+@cindex PK, converting GF to
+@cindex GF, converting to PK
+
+GFtoPK converts a generic font (GF) file output by, for example,
+Metafont (@pxref{mf invocation}) to a packed font (PK) file. PK files
+are considerably smaller than the corresponding gf files, so they are
+generally the bitmap font format of choice. Some DVI-processing
+programs, notably Dvips, only support PK files and not GF files.
+Synopsis:
+
+@example
+gftopk [@var{option}]@dots{} @var{gfname}.@var{dpi}[gf] [@var{pkfile}]
+@end example
+
+@noindent
+The font @var{gfname} is searched for in the usual places (@pxref{Glyph
+lookup,,, kpathsea, Kpathsea}). To see all the relevant paths, set the
+environment variable @code{KPATHSEA_DEBUG} to @samp{-1} before running
+the program.
+
+The suffix @samp{gf} is supplied if not already present. This suffix is
+not an extension; no @samp{.} precedes it: for instance,
+@file{cmr10.600gf}.
+
+If @var{pkfile} is not specified, the output is written to the basename
+of @samp{@var{gfname}.@var{dpi}pk}, e.g., @samp{gftopk
+/wherever/cmr10.600gf} creates @file{./cmr10.600pk}.
+
+The only options are @samp{--verbose}, @samp{--help}, and
+@samp{--version} (@pxref{Common options}).
+
+
+@node pktogf invocation
+@section PKtoGF: Packed to generic font conversion
+
+@pindex pktogf
+@cindex conversion, PK to GF
+@cindex GF, converting PK to
+@cindex PK, converting to GF
+
+PKtoGF converts a packed font (PK) file to a generic font (GF) file.
+Since PK format is much more compact than GF format, the most likely
+reason to do this is to run GFtype (@pxref{gftype invocation}) on the
+result, so you can see the bitmap images. Also, a few old utility
+programs do not support PK format. Synopsis:
+
+@example
+pktogf [@var{option}]@dots{} @var{pkname}.@var{dpi}[pk] [@var{gffile}]
+@end example
+
+@noindent
+The font @var{pkname} is searched for in the usual places (@pxref{Glyph
+lookup,,, kpathsea, Kpathsea}). To see all the relevant paths, set the
+environment variable @code{KPATHSEA_DEBUG} to @samp{-1} before running
+the program.
+
+The suffix @samp{pk} is supplied if not already present. This suffix is
+not an extension; no @samp{.} precedes it: for instance,
+@file{cmr10.600pk}.
+
+If @var{gffile} is not specified, the output is written to the basename
+of @samp{@var{pkname}.@var{dpi}gf}, e.g., @samp{pktogf
+/wherever/cmr10.600pk} creates @file{./cmr10.600gf}.
+
+The only options are @samp{--verbose}, @samp{--help}, and
+@samp{--version} (@pxref{Common options}).
+
+
+@node pktype invocation
+@section PKtype: Plain text transliteration of packed fonts
+
+@pindex pktype @r{PK validation}
+@cindex conversion, PK to plain text
+@cindex plain text, converting PK to
+@cindex human-readable text, converting PK to
+@cindex type programs, PK
+@cindex validation, of PK files
+
+PKtype translates a packed font (PK) bitmap file (as output by GFtoPK,
+for example) to a plain text file that humans can read. It also serves
+as a PK-validating program, i.e., if PKtype can read a file, it's
+correct. Synopsis:
+
+@example
+pktype @var{pkname}.@var{dpi}[pk]
+@end example
+
+The font @var{pkname} is searched for in the usual places (@pxref{Glyph
+lookup,,, kpathsea, Kpathsea}). To see all the relevant paths, set the
+environment variable @code{KPATHSEA_DEBUG} to @samp{-1} before running
+the program.
+
+The suffix @samp{pk} is supplied if not already present. This suffix is
+not an extension; no @samp{.} precedes it: for instance, @file{cmr10.600pk}.
+
+The translation is written to standard output.
+
+The only options are @samp{-help} and @samp{-version}
+(@pxref{Common options}).
+
+As an example of the output, here is the (abridged) translation of the
+letter `K' in @samp{cmr10}, as rendered at 600@dmn{dpi} with the mode
+@samp{ljfour} from @url{modes.mf} (available from
+@file{ftp://ftp.tug.org/tex/modes.mf}).
+
+@smallexample
+955: Flag byte = 184 Character = 75 Packet length = 174
+ Dynamic packing variable = 11
+ TFM width = 815562 dx = 4259840
+ Height = 57 Width = 57 X-offset = -3 Y-offset = 56
+ [2]23(16)17(8)9(25)11(13)7(27)7(16)7(28)4(18)7(28)2(20)7(27)@dots{}
+ @dots{}
+ (14)9(24)12(5)[2]23(13)21
+@end smallexample
+
+@noindent
+Explanation:
+
+@table @samp
+@item 955
+@cindex byte position
+The byte position in the file where this character starts.
+
+@item Flag byte
+@itemx Dynamic packing variable
+@cindex flag byte
+@cindex dynamic packing variable
+Related to the packing for this character; see the source code.
+
+@item Character
+@cindex character codes, in PKtype output
+The character code, in decimal.
+
+@item Packet length
+@cindex packet length
+The total length of this character definition, in bytes.
+
+@item TFM width
+@cindex TFM width of characters
+@cindex device-independent width
+@cindex width, device-independent
+The device-independent (TFM) width of this character. It is 2^24
+times the ratio of the true width to the font's design size.
+
+@item dx
+@cindex horizontal escapement
+@cindex escapement, horizontal
+@cindex scaled pixels
+@cindex dx @r{horizontal escapement}
+The device-dependent width, in @dfn{scaled pixels}, i.e., units of
+horizontal pixels times 2^16.
+
+@item Height
+@itemx Width
+@cindex height, in pixels
+@cindex pixel height
+@cindex pixel width
+@cindex width, in pixels
+The bitmap height and width, in pixels.
+
+@item X-offset
+@itemx Y-offset
+@cindex x offset
+@cindex y offset
+@cindex origin
+@cindex reference pixel
+@cindex side bearings
+@cindex left side bearing
+@cindex right side bearing
+Horizontal and vertical offset from the upper left pixel to the
+reference (origin) pixel for this character, in pixels (right and down
+are positive). The @dfn{reference pixel} is the pixel that occupies the
+unit square in Metafont; the Metafont reference point is the lower left
+hand corner of this pixel. Put another way, the x-offset is the negative
+of the left side bearing; the right side bearing is the horizontal
+escapement minus the bitmap width plus the x-offset.
+
+@item [2]23(16)@dots{}
+@cindex run length encoded bitmaps
+@cindex repeated rows
+Finally, run lengths of black pixels alternate with parenthesized run
+lengths of white pixels, and brackets indicate a repeated row.
+@end table
+
+
+@node gftype invocation
+@section GFtype: Plain text transliteration of generic fonts
+
+@pindex gftype @r{GF validation}
+@cindex conversion, GF to plain text
+@cindex plain text, converting GF to
+@cindex human-readable text, converting GF to
+@cindex type programs, GF
+@cindex validation, of GF files
+
+GFtype translates a generic font (GF) bitmap file (as output by
+Metafont, for example) to a plain text file that humans can read. It
+also serves as a GF-validating program, i.e., if GFtype can read a file,
+it's correct. Synopsis:
+
+@example
+gftype [@var{option}]@dots{} @var{gfname}.@var{dpi}[gf]
+@end example
+
+The font @var{gfname} is searched for in the usual places (@pxref{Glyph
+lookup,,, kpathsea, Kpathsea}). To see all the relevant paths, set the
+environment variable @code{KPATHSEA_DEBUG} to @samp{-1} before running
+the program.
+
+The suffix @samp{gf} is supplied if not already present. This suffix is
+not an extension; no @samp{.} precedes it: for instance, @file{cmr10.600gf}.
+
+The translation is written to standard output.
+
+The program accepts the following options, as well as the standard
+@samp{-help} and @samp{-version} (@pxref{Common options}):
+@table @samp
+@item -images
+@opindex -images
+Show the characters' bitmaps using asterisks and spaces.
+
+@item -mnemonics
+@opindex -mnemonics
+Translate all commands in the GF file.
+@end table
+
+As an example of the output, here is the (abrdiged) translation of the
+letter `K' in @samp{cmr10}, as rendered at 600@dmn{dpi} with the mode
+@samp{ljfour} from @file{modes.mf} (available from
+@url{ftp://ftp.tug.org/tex/modes.mf}), with both @samp{-mnemonics} and
+@samp{-images} enabled.
+
+GFtype outputs the information about a character in two places: a main
+definition and a one-line summary at the end. We show both. Here is the
+main definition:
+
+@example
+2033: beginning of char 75: 3<=m<=60 0<=n<=56
+(initially n=56) paint (0)24(12)20
+2043: newrow 0 (n=55) paint 24(12)20
+2047: newrow 0 (n=54) paint 24(12)20
+2051: newrow 0 (n=53) paint 24(12)20
+2055: newrow 7 (n=52) paint 10(21)13
+2059: newrow 8 (n=51) paint 8(23)9
+@dots{}
+2249: newrow 8 (n=5) paint 8(23)11
+2253: newrow 7 (n=4) paint 10(22)12
+2257: newrow 0 (n=3) paint 24(11)22
+2261: newrow 0 (n=2) paint 24(11)22
+2265: newrow 0 (n=1) paint 24(11)22
+2269: newrow 0 (n=0) paint 24(11)22
+2273: eoc
+@group
+.<--This pixel's lower left corner is at (3,57) in METAFONT coordinates
+************************ ********************
+************************ ********************
+************************ ********************
+************************ ********************
+ ********** *************
+ ******** *********
+@dots{}
+ ******** ***********
+ ********** ************
+************************ **********************
+************************ **********************
+************************ **********************
+************************ **********************
+.<--This pixel's upper left corner is at (3,0) in METAFONT coordinates
+@end group
+@end example
+
+@noindent
+Explanation:
+
+@table @samp
+@item 2033
+@itemx 2043
+@itemx @dots{}
+@cindex byte position
+The byte position in the file where each GF command starts.
+
+@item beginning of char 75
+@cindex character codes, in GFtype output
+The character code, in decimal.
+
+@item 3<=m<=60 0<=n<=56
+@cindex left side bearing
+@cindex right side bearing
+@cindex side bearings
+The character's bitmap lies between 3 and 60 (inclusive) horizontally,
+and between 0 and 56 (inclusive) vertically. (@math{m} is a column
+position and @math{n} is a row position.) Thus, 3 is the left side
+bearing. The right side bearing is the horizontal escapement (given
+below) minus the maximum @math{m}.
+
+@item (initially n=56) paint (0)24(12)20
+@cindex run length encoded bitmaps
+The first row of pixels: 0 white pixels, 24 black pixels, 12 white
+pixels, etc.
+
+@item newrow 0 (n=55) paint 24(12)20
+@findex newrow @r{GF command}
+The second row of pixels, with zero leading white pixels on the row.
+
+@item eoc
+@findex eoc @r{GF command}
+The end of the main character definition.
+
+@end table
+
+Here is the GF postamble information that GFtype outputs at the end:
+
+@example
+Character 75: dx 4259840 (65), width 815562 (64.57289), loc 2033
+@end example
+
+Explanation:
+
+@table @samp
+@item dx
+@cindex horizontal escapement
+@cindex escapement, horizontal
+@cindex vertical escapement
+@cindex escapement, vertical
+@cindex scaled pixels
+@cindex dx @r{horizontal escapement}
+@cindex dy @r{vertical escapement}
+The device-dependent width, in @dfn{scaled pixels}, i.e., units of
+horizontal pixels times 2^16. The @samp{(65)} is simply the same number
+rounded. If the vertical escapement is nonzero, it would appear here as
+a @samp{dy} value.
+
+@item width
+@cindex TFM width of characters
+@cindex device-independent width
+@cindex width, device-independent
+The device-independent (TFM) width of this character. It is 2^24
+times the ratio of the true width to the font's design size. The
+@samp{64.57289} is the same number converted to pixels.
+
+@item loc
+The byte position in the file where this character starts.
+
+@end table
+
+
+@node tftopl invocation
+@section TFtoPL: @TeX{} font metric to property list conversion
+
+@pindex tftopl
+@cindex conversion, TFM to property list
+@cindex validation, of TFM files
+@cindex property list, converting TFM to
+@cindex human-readable text, converting TFM to
+@cindex plain text, converting TFM to
+
+TFtoPL translates a @TeX{} font metric (TFM, @pxref{Metric
+files,,,dvips,Dvips}) file (as output by Metafont, for example) to
+@dfn{property list format} (a list of parenthesized items describing the
+font) that humans can edit or read. This program is mostly used by
+people debugging @TeX{} implementations, writing font utilities, etc.
+Synopsis:
+
+@example
+tftopl [@var{option}]@dots{} @var{tfmname}[.tfm] [@var{plfile}[.pl]]
+@end example
+
+The font @var{tfmname} (extended with @samp{.tfm} if necessary) is
+searched for in the usual places (@pxref{Supported file formats,,,
+kpathsea, Kpathsea}). To see all the relevant paths, set the
+environment variable @code{KPATHSEA_DEBUG} to @samp{-1} before running
+the program.
+
+If @var{plfile} (which is extended with @samp{.pl} if necessary) is not
+specified, the property list file is written to standard output. The
+property list file can be converted back to TFM format by the companion
+program TFtoPL (see the next section).
+
+The program accepts the following option, as well as the standard
+@samp{-verbose}, @samp{-help} and @samp{-version} (@pxref{Common
+options}):
+@table @samp
+@item -charcode-format=@var{type}
+@opindex -charcode-format=@var{type}
+Output character codes in the PL file according to @var{type}: either
+@samp{octal} or @samp{ascii}. Default is @samp{ascii} for letters and
+digits, octal for all other characters. Exception: if the font's coding
+scheme starts with @samp{TeX math sy} or @samp{TeX math ex}, all
+character codes are output in octal.
+
+In @samp{ascii} format, character codes that correspond to graphic
+characters, except for left and right parentheses, are output as a
+@samp{C} followed by the single character: @samp{C K}, for example. In
+octal format, character codes are output as the letter @samp{O} followed
+by octal digits, as in @samp{O 113} for @samp{K}.
+
+@samp{octal} format is useful for symbol and other non-alphabetic fonts,
+where using ASCII characters for the character codes is merely
+confusing.
+@end table
+
+@cindex property list format
+As an example of the output, here is the (abridged) property list
+translation of @file{cmr10.tfm}:
+
+@example
+(FAMILY CMR)
+(FACE O 352)
+(CODINGSCHEME TEX TEXT)
+(DESIGNSIZE R 10.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM O 11374260171)
+(FONTDIMEN
+ (SLANT R 0.0)
+ (SPACE R 0.333334)
+ (STRETCH R 0.166667)
+ (SHRINK R 0.111112)
+ (XHEIGHT R 0.430555)
+ (QUAD R 1.000003)
+ (EXTRASPACE R 0.111112)
+ )
+(LIGTABLE
+ @dots{}
+ (LABEL C f)
+ (LIG C i O 14)
+ (LIG C f O 13)
+ (LIG C l O 15)
+ (KRN O 47 R 0.077779)
+ (KRN O 77 R 0.077779)
+ (KRN O 41 R 0.077779)
+ (KRN O 51 R 0.077779)
+ (KRN O 135 R 0.077779)
+ (STOP)
+ @dots{}
+ )
+@dots{}
+(CHARACTER C f
+ (CHARWD R 0.305557)
+ (CHARHT R 0.694445)
+ (CHARIC R 0.077779)
+ (COMMENT
+ (LIG C i O 14)
+ (LIG C f O 13)
+ (LIG C l O 15)
+ (KRN O 47 R 0.077779)
+ (KRN O 77 R 0.077779)
+ @dots{}
+ )
+ )
+@dots{}
+@end example
+
+As you can see, the general format is a list of parenthesized
+@dfn{properties}, nested where necessary.
+
+@itemize @bullet
+@item
+@findex FAMILY @r{property}
+@findex FACE @r{property}
+@findex headerbyte @r{information}
+The first few items (@code{FAMILY}, @code{FACE}, and so on) are
+the so-called @dfn{headerbyte} information from Metafont, giving general
+information about the font.
+
+@item
+@findex FAMILY @r{property}
+@findex \fontdimen
+The @code{FONTDIMEN} property defines the @TeX{} @code{\fontdimen}
+values.
+
+@item
+@findex LIGTABLE @r{property}
+@findex LABEL @r{property}
+@findex LIG @r{property}
+@findex KRN @r{property}
+@cindex ligature table, in TFM files
+@cindex kerning table, in TFM files
+@cindex design-size units
+The @code{LIGTABLE} property defines the ligature and kerning table.
+@code{LIG} properties define ligatures: in the example above, an
+@samp{f} (in the @samp{LABEL}) followed by an @samp{i} is a ligature,
+i.e., a typesetting program like @TeX{} replaces those two consecutive
+characters by the character at position octal '014 in the current
+font---presumably the `fi' ligature. @code{KRN} properties define
+kerns: if an @samp{f} is followed by character octal '047 (an
+apostrophe), @TeX{} inserts a small amount of space between them:
+0.077779 times the design size the font was loaded at (about
+three-quarters of a printer's point by default in this case, or .001
+inches).
+
+@item
+@findex CHARACTER @r{property}
+@findex CHARWD @r{property}
+@findex CHARHT @r{property}
+@findex CHARDP @r{property}
+@findex CHARIC @r{property}
+The @code{CHARACTER} property defines the dimensions of a character: its
+width, height, depth, and italic correction, also in design-size units,
+as explained in the previous item. For our example `f', the depth is
+zero, so that property is omitted. TFtoPL also inserts any kerns and
+ligatures for this character as a comment.
+
+@end itemize
+
+
+@node pltotf invocation
+@section PLtoTF: Property list to @TeX{} font metric conversion
+
+@pindex pltotf
+@cindex conversion, property list to TFM
+@cindex TFM files, converting property lists to
+@cindex machine-readable, converting property lists to
+
+PLtoTF translates a property list file (as output by TFtoPL, for
+example) to @TeX{} font metric (TFM, @pxref{Metric files,,,dvips,Dvips})
+format. It's much easier for both programs and humans to create the
+(plain text) property list files and let PLtoTF take care of creating
+the binary TFM equivalent than to output TFM files directly. Synopsis:
+
+@example
+pltotf [@var{option}]@dots{} @var{plfile}[.pl] [@var{tfmfile}[.tfm]]
+@end example
+
+If @var{tfmfile} (extended with @samp{.tfm} if necessary) is
+not specified, the TFM file is written to the basename of
+@samp{@var{plfile}.tfm}, e.g., @samp{pltotf /wherever/cmr10.pl} creates
+@file{./cmr10.tfm}. (Since TFM files are binary, writing to standard
+output by default is undesirable.)
+
+The only options are @samp{-verbose}, @samp{-help}, and
+@samp{-version} (@pxref{Common options}).
+
+For an example of property list format, see the previous section.
+
+
+@node vftovp invocation
+@section VFtoVP: Virtual font to virtual property lists
+
+@pindex vftovp
+@cindex conversion, VF to VPL
+@cindex validation, of VF files
+@cindex property list, converting VF to virtual
+@cindex human-readable text, converting VF to
+@cindex plain text, converting VF to
+
+VFtoVP translates a virtual font metric (VF, @pxref{Virtual
+fonts,,,dvips,Dvips}) file and its accompanying @TeX{} font metric (TFM,
+@pxref{Metric files,,,dvips,Dvips}) file (as output by VPtoVF, for
+example) to @dfn{virtual property list format} (a list of parenthesized
+items describing the virtual font) that humans can edit or read. This
+program is mostly used by people debugging virtual font utilities.
+Synopsis:
+
+@example
+vftovp [@var{option}]@dots{} @var{vfname}[.vf] [@var{tfmname}[.tfm] @c
+[@var{vplfile}[.vpl]]]
+@end example
+
+The fonts @var{vfname} and @var{tfmname} (extended with @samp{.vf} and
+@samp{.tfm} if necessary) are searched for in the usual places
+(@pxref{Supported file formats,,, kpathsea, Kpathsea}). To see all the
+relevant paths, set the environment variable @code{KPATHSEA_DEBUG} to
+@samp{-1} before running the program. If @var{tfmname} is not
+specified, @var{vfname} (without a trailing @samp{.vf}) is used.
+
+If @var{vplfile} (extended with @samp{.vpl} if necessary) is
+not specified, the property list file is written to standard output.
+The property list file can be converted back to VF and TFM format by the
+companion program VFtoVP (see the next section).
+
+The program accepts the following option, as well as the standard
+@samp{-verbose}, @samp{-help} and @samp{-version} (@pxref{Common
+options}):
+@table @samp
+@item -charcode-format=@var{type}
+@opindex -charcode-format=@var{type}
+Output character codes in the PL file according to @var{type}: either
+@samp{octal} or @samp{ascii}. Default is @samp{ascii} for letters and
+digits, octal for all other characters. Exception: if the font's coding
+scheme starts with @samp{TeX math sy} or @samp{TeX math ex}, all
+character codes are output in octal.
+
+In @samp{ascii} format, character codes that correspond to graphic
+characters, except for left and right parentheses, are output as a
+@samp{C} followed by the single character: @samp{C K}, for example. In
+octal format, character codes are output as the letter @samp{O} followed
+by octal digits, as in @samp{O 113} for @samp{K}.
+
+@samp{octal} format is useful for symbol and other non-alphabetic fonts,
+where using ASCII characters for the character codes is merely
+confusing.
+@end table
+
+
+@node vptovf invocation
+@section VPtoVF: Virtual property lists to virtual font
+
+@pindex vptovf
+@cindex conversion, property list to VF
+@cindex VF files, converting property lists to
+@cindex machine-readable, converting property lists to
+
+VPtoVF translates a virtual property list file (as output by VFtoVP, for
+example) to virtual font (VF, @pxref{Virtual fonts,,,dvips,Dvips}) and
+@TeX{} font metric (TFM, @pxref{Metric files,,,dvips,Dvips}) files.
+It's much easier for both programs and humans to create the (plain text)
+property list files and let VPtoVF take care of creating the binary VF
+and TFM equivalents than to output them directly. Synopsis:
+
+@example
+vptovf [@var{option}]@dots{} @var{vplfile}[.vpl] [@var{vffile}[.vf] @c
+[@var{tfmfile}[.tfm]]]
+@end example
+
+If @var{vffile} (extended with @samp{.vf} if necessary) is not
+specified, the VF output is written to the basename of
+@samp{@var{vplfile}.vf}; similarly for @var{tfmfile}. For example,
+@samp{vptovf /wherever/ptmr.vpl} creates @file{./ptmr.vf} and
+@file{./ptmr.tfm}.
+
+The only options are @samp{-verbose}, @samp{-help}, and @samp{-version}
+(@pxref{Common options}).
+
+
+@node Font utilities available elsewhere
+@section Font utilities available elsewhere
+
+@cindex font utilities, non-Web2c
+
+The Web2c complement of font utilities merely implements a few basic
+conversions. Many other more sophisticated font utilities exist; most
+are in @file{@var{CTAN:}/fonts/utilities} (for CTAN info,
+@pxref{unixtex.ftp,,, kpathsea, Kpathsea}). Here are some of the most
+commonly-requested items:
+
+@itemize @bullet
+@item
+@cindex AFM to TFM conversion
+@pindex afm2tfm
+@pindex afmtopl
+AFM (Adobe font metric) to TFM conversion: @pxref{Invoking afm2tfm,,,
+dvips, Dvips}, and @file{@var{CTAN:}/fonts/utilities/afmtopl}.
+
+@item
+@cindex X bitmap fonts
+@cindex BDF and GF conversion
+BDF (the X bitmap format) conversion:
+@url{ftp://ftp.tug.org/tex/bdf.tar.gz}.
+
+@item
+@pindex metatype1
+@cindex Latin Modern
+Creating fonts using MetaPost: MetaType1.
+@url{ftp://bop.eps.gda.pl/pub/metatype1}. This is used to create
+the excellent Latin Modern font family (@file{@var{CTAN:}/fonts/lm}),
+which extends Computer Modern to a vast repertoire of scripts.
+
+@item
+@cindex editing of bitmap fonts
+@pindex xbfe@r{, bitmap font editor}
+@pindex xfed@r{, bitmap font editor}
+@pindex xfedor@r{, bitmap font editor}
+@pindex gftopxl
+@pindex chtopx
+@pindex pxtoch
+Editing of bitmap fonts: Xbfe from the GNU font utilities mentioned
+below; the X BDF-editing programs available from
+@url{ftp://ftp.x.org/R5contrib/xfed.tar.Z} and
+@url{ftp://ftp.x.org/R5contrib/xfedor.tar.Z}; and finally, if your
+fonts have only 128 characters, you can use the old @code{gftopxl},
+@code{pxtoch}, and @code{chtopx} programs from
+@url{ftp://ftp.tug.org/tex/web}.
+
+@item
+@pindex fontforge
+@pindex pfaedit
+Editing of outline fonts: FontForge, @url{fontforge.sourceforge.net}.
+This is a very elaborate program with support for many outline formats
+(Type@tie{}1, OpenType, TrueType, @dots{}), and many advanced font
+editing features.
+
+@item
+@cindex PK bitmaps from PostScript
+@cindex PostScript to PK bitmaps
+@pindex gsftopk
+@pindex ps2pk
+PK bitmaps from PostScript outline fonts: gsftopk from the @samp{xdvi}
+distribution. Alternatively, @code{ps2pk}, from
+@file{@var{CTAN:}/fonts/utilities/ps2pk}.
+
+@item
+@cindex Type 1 conversion
+@cindex PFA and PFB conversion
+@cindex PostScript Type 1 font conversion
+PostScript Type 1 font format conversion (i.e., between PFA and PFB
+formats): @url{ftp://ftp.tug.org/tex/t1utils.tar.gz}.
+
+@item
+@cindex scanned images of fonts
+@cindex typeface specimen sheets
+@pindex fontutils
+Scanned image conversion: the (aging) GNU font utilities convert type
+specimen images to Metafont, PostScript, etc.:
+@url{http://www.gnu.org/software/fontutils/}.
+
+@item
+@pindex autotrace
+@pindex potrace
+Tracing bitmaps to fitted outlines: Autotrace
+(@url{http://autotrace.sourceforge.net}), Potrace
+(@url{http://potrace.sourceforge.net}). For Metafont fonts, either of
+the two programs @code{mftrace}
+(@url{http://www.xs4all.nl/~hanwen/mftrace}) or @code{textrace}
+(@url{http://textrace.sourceforge.net}) make the job easier.
+
+@item
+@cindex virtual font creation
+@pindex fontinst@r{, for creating virtual fonts}
+Virtual font creation: @file{@var{CTAN:}/fonts/utilities/fontinst}.
+@end itemize
+
+
+@node Legalisms
+@appendix Legalisms
+
+@cindex legalisms
+@cindex copyright notices
+@cindex permissions, legal
+
+In general, each file has its own copyright notice stating the copying
+permissions for that file. Following is a summary.
+
+The Web2c system itself and most of the original WEB source files are
+public domain.
+
+@file{tex.web}, the ML@TeX{} code, @file{mf.web}, and @file{bibtex.web},
+are copyrighted by their authors. They may be copied verbatim, but may
+be modified only through a @file{.ch} file.
+
+MetaPost-related files, including @file{mp.web} itself, are copyrighted
+under X-like terms; the precise notice is included below.
+
+Finally, the Kpathsea library is covered by the GNU Lesser General
+Public License (@pxref{Introduction,,, kpathsea, Kpathsea}). Therefore,
+the @emph{binaries} resulting from a standard Web2c compilation are also
+covered by the LGPL; so if you (re)distribute the binaries, you must
+also (offer to) distribute the complete source that went into those
+binaries. See the file @file{LGPL} for complete details on the LGPL.
+
+The following notice must be included by the terms of the MetaPost
+copyright.
+
+@quotation
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that the copyright notice and this permission notice and warranty
+disclaimer appear in supporting documentation, and that the names of
+AT&T Bell Laboratories or any of its entities not be used in advertising
+or publicity pertaining to distribution of the software without
+specific, written prior permission.
+
+AT&T disclaims all warranties with regard to this software, including
+all implied warranties of merchantability and fitness. In no event
+shall AT&T be liable for any special, indirect or consequential damages
+or any damages whatsoever resulting from loss of use, data or profits,
+whether in an action of contract, negligence or other tortious action,
+arising out of or in connection with the use or performance of this
+software.
+@end quotation
+
+
+@node References
+@appendix References
+
+@cindex references
+@cindex bibliography
+
+@enumerate
+@item
+Kpathsea: @xref{Top, Introduction,, kpathsea, Kpathsea}.
+
+@item
+Dvips and Afm2tfm: @xref{Top, Introduction,, dvips, Dvips}.
+
+@item
+The @TeX{} Users Group: @url{http://www.tug.org}. For an introduction
+to the @TeX{} system, see @url{http://tug.org/begin.html}.
+
+@item
+TUGboat: @url{http://tug.org/TUGboat}.
+
+@item
+@TeX{} and computer typesetting in general:@*
+@url{ftp://ftp.math.utah.edu/pub/tex/bib/texbook1.bib}.
+
+@item
+For a bibliography of formal articles and technical reports on the
+@TeX{} project, see the books @cite{@TeX{}: The Program} or
+@cite{Metafont: The Program} cited below.
+
+@include ref.txi
+
+@end enumerate
+
+
+@node Index
+@unnumbered Index
+
+@printindex cp
+
+@bye
diff --git a/Build/source/texk/web2c/doc/win32.mak b/Build/source/texk/web2c/doc/win32.mak
new file mode 100644
index 00000000000..5b6f968285c
--- /dev/null
+++ b/Build/source/texk/web2c/doc/win32.mak
@@ -0,0 +1,42 @@
+################################################################################
+#
+# Makefile : Web2C / doc
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <03/02/19 16:24:17 popineau>
+#
+################################################################################
+root_srcdir = ..\..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+!include <msvc/common.mak>
+
+infofiles = web2c.info
+pdfdocfiles = web2c.pdf
+manfiles =
+htmldocfiles = web2c.html
+
+docsubdir = web2c
+
+all: doc
+
+info: doc
+
+!include <msvc/config.mak>
+!include <msvc/install.mak>
+
+install:: install-info install-doc
+
+web2c.info: install.texi ref.txi
+
+!include <msvc/clean.mak>
+
+#
+# Local Variables:
+# mode: makefile
+# End:
+
diff --git a/Build/source/texk/web2c/dvicopy.ch b/Build/source/texk/web2c/dvicopy.ch
new file mode 100644
index 00000000000..4d6a7d39143
--- /dev/null
+++ b/Build/source/texk/web2c/dvicopy.ch
@@ -0,0 +1,651 @@
+% dvicopy.ch for C compilation with web2c.
+% The original version of this file was created by Monika Jayme and
+% Klaus Guntermann at TH Darmstadt (THD), FR Germany.
+% Some parts are borrowed from the changes to dvitype, vftovp and vptovf.
+%
+% July 90 THD First versions for dvicopy 0.91 and 0.92
+% Aug 09 90 THD Updated to dvicopy 1.0 and released
+% Mar 20 91 THD Updated to dvicopy 1.2
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+@z
+
+@x [3] Set up kpathsea.
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+ print (banner); print_ln (version_string);
+@z
+
+@x [5] Big enough arrays to convert the dvilj sample font document.
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts}
+@!max_chars=10000; {maximum number of different characters among all fonts}
+@!max_widths=3000; {maximum number of different characters widths}
+@!max_packets=5000; {maximum number of different characters packets;
+ must be less than 65536}
+@!max_bytes=30000; {maximum number of bytes for characters packets}
+@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!name_length=50; {a file name shouldn't be longer than this}
+@y
+@<Constants...@>=
+@!max_fonts=400; {maximum number of distinct fonts}
+@!max_chars=750000; {maximum number of different characters among all fonts}
+@!max_widths=16000; {maximum number of different characters widths}
+@!max_packets=65530; {maximum number of different characters packets;
+ must be less than 65536}
+@!max_bytes=250000; {maximum number of bytes for characters packets}
+@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!terminal_line_length=256; {maximum number of characters input in a single
+ line of input from the terminal}
+@z
+
+% [7] Rename the integer types, as they collide with names used by C99.
+% Rather than change the code all over the place, we use macros to do
+% the renaming. This could also be done at C preprocessor level.
+@x
+@d int_32 == integer {signed 32~bit integers}
+@y
+@d int_32 == integer {signed 32~bit integers}
+@d int_31 == int_31_t
+@d int_24u == int_24u_t
+@d int_24 == int_24_t
+@d int_23 == int_23_t
+@d int_16u == int_16u_t
+@d int_16 == int_16_t
+@d int_15 == int_15_t
+@d int_8u == int_8u_t
+@d int_8 == int_8_t
+@d int_7 == int_7_t
+@z
+
+% [14] Redirect output, so it can go to either stdout or stderr,
+% depending on where the output dvi file is going.
+@x
+@d print(#)==write(output,#)
+@d print_ln(#)==write_ln(output,#)
+@d new_line==write_ln(output) {start new line}
+@y
+@d print(#)==write(term_out,#)
+@d print_ln(#)==write_ln(term_out,#)
+@d new_line==write_ln(term_out) {start new line}
+@z
+
+@x [14] Permissive input.
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+@y
+@!ASCII_code=0..255; {a subrange of the integers}
+@z
+
+% [15] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@z
+
+@x [23] Remove non-local goto
+@d abort(#)==begin print_ln(' ',#,'.'); jump_out;
+ end
+
+@<Error handling...@>=
+@<Basic printing procedures@>@;
+procedure close_files_and_terminate; forward;
+@#
+procedure jump_out;
+begin mark_fatal; close_files_and_terminate;
+goto final_end;
+end;
+@y
+@d abort(#)==begin write_ln(stderr, ' ',#,'.'); jump_out;
+ end
+
+@<Error handling...@>=
+@<Basic printing procedures@>@;
+procedure close_files_and_terminate; forward;
+@#
+procedure jump_out;
+begin mark_fatal; close_files_and_terminate;
+uexit(1);
+end;
+@z
+
+@x [51] Fix casting problem in C.
+@d comp_spair(#) == if a<128 then #:=a*256+b @+ else #:=(a-256)*256+b
+@d comp_upair(#) == #:=a*256+b
+@y
+@d comp_spair(#) == if a<128 then #:=a*intcast(256)+b
+ @+ else #:=(a-intcast(256))*intcast(256)+b
+@d comp_upair(#) == #:=a*intcast(256)+b
+@z
+
+@x [52]
+if a<128 then #:=(a*256+b)*256+c @+ else #:=((a-256)*256+b)*256+c
+@d comp_utrio(#) == #:=(a*256+b)*256+c
+@y
+if a<128 then #:=(a*intcast(256)+b)*intcast(256)+c @+
+else #:=((a-intcast(256))*intcast(256)+b)*intcast(256)+c
+@d comp_utrio(#) == #:=(a*intcast(256)+b)*intcast(256)+c
+@z
+
+@x [53]
+if a<128 then #:=((a*256+b)*256+c)*256+d
+else #:=(((a-256)*256+b)*256+c)*256+d
+@y
+if a<128 then #:=((a*intcast(256)+b)*intcast(256)+c)*intcast(256)+d
+else #:=(((a-intcast(256))*intcast(256)+b)*intcast(256)+c)*intcast(256)+d
+@z
+
+@x [62] cur_name is no longer a fixed-size array.
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+@!cur_name:^char;
+@z
+
+@x [63] Ignore arguments to make_font_name.
+@ For \.{TFM} and \.{VF} files we just append the apropriate extension
+to the file name packet; in addition a system dependent area part
+(usually different for \.{TFM} and \.{VF} files) is prepended if
+the file name packet contains no area part.
+@^system dependencies@>
+
+@d append_to_name(#)==
+ if l_cur_name<name_length then
+ begin incr(l_cur_name); cur_name[l_cur_name]:=#;
+ end
+ else overflow(str_name_length,name_length)
+@d make_font_name_end(#)==
+ append_to_name(#[l]); make_name
+@d make_font_name(#)==
+ l_cur_name:=0; for l:=1 to # do make_font_name_end
+@y
+@ Since files are actually searched through path definitions,
+the area definitions are ignored here.
+To reduce the required changes we simply ignore the parameters given
+to |make_font_name|.
+@^system dependencies@>
+
+@d append_to_name(#)== begin
+ cur_name[l_cur_name]:=#;
+ incr(l_cur_name);
+ end
+@d make_font_name_end(#)==
+ make_name
+@d make_font_name(#)==
+ l_cur_name:=0; make_font_name_end
+@z
+
+% [67] No conversion of filenames in lower case, and initialize and
+% terminate for C strings.
+@x
+cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
+@y
+cur_name := xmalloc_array (char, pckt_length (n) + pckt_length (e));
+cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
+@z
+
+@x
+ if (b>="a")and(b<="z") then Decr(b)("a"-"A"); {convert to upper case}
+@y
+@z
+
+@x
+cur_loc:=pckt_start[e]; cur_limit:=pckt_start[e+1];
+while cur_loc<cur_limit do
+ begin pckt_extract(b); append_res_to_name(xchr[b]);
+ end;
+while l_cur_name<name_length do
+ begin incr(l_cur_name); cur_name[l_cur_name]:=' ';
+ end;
+@y Skip copying in the extension, kpathsea knows what to do.
+ cur_name[l_cur_name] := 0;
+@z
+
+@x [93] Set default directory name
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{TFM} directory, which is a system-dependent place where
+the \.{TFM} files for standard fonts are kept.
+The string variable |TFM_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d TFM_default_area_name=='TeXfonts:' {change this to the correct name}
+@d TFM_default_area_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!TFM_default_area:packed array[1..TFM_default_area_name_length] of char;
+@y
+@ If no font directory has been specified, we search paths.
+@z
+
+@x [94] Remove initialization of now-defunct array
+@ @<Set init...@>=
+TFM_default_area:=TFM_default_area_name;
+@y
+@ (No initialization to be done. Keep this module to preserve numbering.)
+@z
+
+@x [96] Open TFM file
+@<TFM: Open |tfm_file|@>=
+make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
+reset(tfm_file,cur_name);
+if eof(tfm_file) then
+@y
+|TFM_default_area_name_length| and |TFM_default_area| will not
+be used by |make_font_name|.
+
+@<TFM: Open |tfm_file|@>=
+make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
+
+full_name := kpse_find_tfm (cur_name);
+if full_name then begin
+ resetbin (tfm_file, full_name);
+ free (cur_name);
+ free (full_name);
+end else
+@z
+
+@x [103] Fix casting problem in C.
+@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*256+tfm_b1
+@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
+if tfm_b2>127 then bad_font
+else #:=tfm_b2*256+tfm_b3
+@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
+if tfm_b0<128 then #:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+else #:=(((tfm_b0-256)*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
+(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3)
+@y
+@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*intcast(256)+tfm_b1
+@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
+if tfm_b2>127 then bad_font
+else #:=tfm_b2*intcast(256)+tfm_b3
+@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
+if tfm_b0<128
+then #:=((tfm_b0*intcast(256)+tfm_b1)*intcast(256)+tfm_b2)*intcast(256)+tfm_b3
+else #:=(((tfm_b0-intcast(256))*intcast(256)+tfm_b1)
+ *intcast(256)+tfm_b2)*intcast(256)+tfm_b3
+@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
+(((tfm_b0*intcast(256)+tfm_b1)*intcast(256)+tfm_b2)*intcast(256)+tfm_b3)
+@z
+
+@x [109] Declare full_name.
+@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
+@y
+@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
+@!full_name: ^char;
+@z
+
+@x [111] Fix up opening the binary files
+@ To prepare |dvi_file| for input, we |reset| it.
+
+@<Open input file(s)@>=
+reset(dvi_file); {prepares to read packed bytes from |dvi_file|}
+dvi_loc:=0;
+@y
+@ To prepare |dvi_file| for input, we |reset| it.
+
+@<Open input file(s)@>=
+dvi_loc:=0;
+@z
+
+@x [113] Make dvi_length() and dvi_move() work.
+@p function dvi_length:int_32;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure dvi_move(@!n:int_32);
+begin set_pos(dvi_file,n); dvi_loc:=n;
+end;
+@y
+@p function dvi_length:int_32;
+begin xfseek(dvi_file, 0, 2, 'dvicopy');
+dvi_loc:=xftell(dvi_file, 'dvicopy');
+dvi_length:=dvi_loc;
+end;
+@#
+procedure dvi_move(n:int_32);
+begin xfseek(dvi_file, n, 0, 'dvicopy');
+dvi_loc:=n;
+end;
+@z
+
+@x [137/138] Set default directory name
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{VF} directory, which is a system-dependent place where
+the \.{VF} files for standard fonts are kept.
+The string variable |VF_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d VF_default_area_name=='TeXvfonts:' {change this to the correct name}
+@d VF_default_area_name_length=10 {change this to the correct length}
+
+@<Glob...@>=
+@!VF_default_area:packed array[1..VF_default_area_name_length] of char;
+
+@ @<Set init...@>=
+VF_default_area:=VF_default_area_name;
+@y
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{VF} directory, which is a system-dependent place where
+the \.{VF} files for standard fonts are kept.
+
+Actually, under UNIX the standard area is defined in an external
+file \.{site.h}. And the users have a path searched for fonts,
+by setting the \.{VFFONTS} environment variable.
+
+@ (No initialization to be done. Keep this module to preserve numbering.)
+@z
+
+@x [139] Open VF file
+@<VF: Open |vf_file| or |goto not_found|@>=
+make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
+reset(vf_file,cur_name);
+if eof(vf_file) then
+@^system dependencies@>
+@y
+Do path searching. But the \.{VF} file may not exist.
+
+@<VF: Open |vf_file| or |goto not_found|@>=
+make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
+full_name := kpse_find_vf (cur_name);
+if full_name then begin
+ resetbin (vf_file, full_name);
+ free (cur_name);
+ free (full_name);
+end else
+@z
+
+@x [163] copy elements of array piece by piece
+@ @<VF: Start a new level@>=
+append_one(push);
+vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+@y
+@ \.{web2c} does not like array assignments. So we need to do them
+through a macro replacement.
+
+@d do_vf_move(#) == vf_move[vf_ptr]# := vf_move[vf_ptr-1]#
+@d vf_move_assign == begin do_vf_move([0][0]); do_vf_move([0][1]);
+ do_vf_move([1][0]); do_vf_move([1][1])
+ end
+
+@<VF: Start a new level@>=
+append_one(push);
+vf_move_assign;
+@z
+
+@x [170] and again...
+ vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+@y
+ vf_move_assign;
+@z
+
+@x [175] break is fflush.
+@d update_terminal == break(output) {empty the terminal output buffer}
+@y
+@d update_terminal == fflush(stdout) {empty the terminal output buffer}
+@z
+
+@x [175]
+procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin if n_opt=0 then
+ begin print('Enter option: '); update_terminal; reset(input);
+ if eoln(input) then read_ln(input);
+ k:=0; pckt_room(terminal_line_length);
+ while (k<terminal_line_length)and not eoln(input) do
+ begin append_byte(xord[input^]); incr(k); get(input);
+ end;
+ end
+else if k_opt<n_opt then
+ begin incr(k_opt);
+ {Copy command line option number |k_opt| into |byte_mem| array!}
+ end;
+end;
+@y
+procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin print('Enter option: '); update_terminal;
+{|if eoln(input) then read_ln(input);|}
+k:=0; pckt_room(terminal_line_length);
+while (k<terminal_line_length)and not eoln(input) do
+ begin append_byte(xord[getc(input)]); incr(k);
+ end;
+end;
+@z
+
+@x [231] No dialog, remove unused final label.
+dialog; {get options}
+@y
+@z
+@x
+final_end:end.
+@y
+end.
+@z
+
+@x [236] Do this later, to avoid creating empty files.
+@<Open output file(s)@>=
+rewrite(out_file); {prepares to write packed bytes to |out_file|}
+@y
+@<Open output file(s)@>=
+@z
+
+@x [238] Use external routine to output bytes.
+@d out_byte(#) == write(out_file,#) {write next \.{DVI} byte}
+@y
+@d out_byte(#) == put_byte(#,out_file) {write next \.{DVI} byte}
+@z
+
+@x [250] String declaration.
+@!comment:packed array[1..comm_length] of char; {preamble comment prefix}
+@y
+@!comment:^char; {preamble comment prefix}
+@z
+
+@x [251] Output the string from 0 to len-1, not 1 to len.
+for k:=1 to comm_length do append_byte(xord[comment[k]]);
+@y
+for k:=0 to comm_length - 1 do append_byte(xord[comment[k]]);
+@z
+
+@x [] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVIcopy} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+This macro tests if its argument is the current option, as represented
+by the index variable |option_index|.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 5; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+ @!k, @!m: c_int_type;
+ @!end_num: ^char;
+begin
+ @<Define the option table@>;
+ @<Initialize options@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('dvicopy');
+
+ end else if argument_is ('help') then begin
+ usage_help (DVICOPY_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, 'Peter Breitenlohner', nil);
+
+ end else if argument_is ('magnification') then begin
+ out_mag := atou (optarg);
+
+ end else if argument_is ('max-pages') then begin
+ max_pages := atou (optarg);
+ incr (cur_select);
+
+ end else if argument_is ('page-start') then begin
+ @<Determine the desired |start_count| values from |optarg|@>;
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We can have zero, one, or two remaining arguments.}
+ if optind = argc then begin
+ dvi_file := make_binary_file (stdin);
+ out_file := make_binary_file (stdout);
+ term_out := stderr;
+
+ end else if optind + 1 = argc then begin
+ resetbin (dvi_file, extend_filename (cmdline (optind), 'dvi'));
+ out_file := make_binary_file (stdout);
+ term_out := stderr;
+
+ end else if optind + 2 = argc then begin
+ resetbin (dvi_file, extend_filename (cmdline (optind), 'dvi'));
+ rewritebin (out_file, extend_filename (cmdline (optind + 1), 'dvi'));
+ term_out := stdout;
+
+ end else begin
+ write_ln (stderr, 'dvicopy: Need at most two file arguments.');
+ usage ('dvicopy');
+ end;
+end;
+
+@ Here is the first of the options we allow.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[0].name := 'help';
+long_options[0].has_arg := 0;
+long_options[0].flag := 0;
+long_options[0].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Magnification to apply.
+@.-magnification@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'magnification';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ How many pages to do.
+@.-max-pages@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'max-pages';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ What page to start at.
+@.-page-start@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'page-start';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Parsing the starting page specification is a bit complicated.
+(This is the same as in \.{DVItype}.)
+
+@<Determine the desired |start_count|...@> =
+k := 0; {which \.{\\count} register we're on}
+m := 0; {position in |optarg|}
+while optarg[m] do begin
+ if optarg[m] = "*" then begin
+ start_there[k] := false;
+ incr (m);
+
+ end else if optarg[m] = "." then begin
+ incr (k);
+ if k >= 10 then begin
+ write_ln (stderr, 'dvicopy: More than ten count registers specified.');
+ uexit (1);
+ end;
+ incr (m);
+
+ end else begin
+ start_count[k] := strtol (optarg + m, address_of (end_num), 10);
+ if end_num = optarg + m then begin
+ write_ln (stderr, 'dvicopy: -page-start values must be numeric or *.');
+ uexit (1);
+ end;
+ start_there[k] := true;
+ m := m + end_num - (optarg + m);
+ end;
+end;
+start_vals := k;
+selected := false;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ @<Glob...@> =
+@!term_out:text;
+@z
diff --git a/Build/source/texk/web2c/dvicopy.rc b/Build/source/texk/web2c/dvicopy.rc
new file mode 100644
index 00000000000..d0902434e4f
--- /dev/null
+++ b/Build/source/texk/web2c/dvicopy.rc
@@ -0,0 +1,34 @@
+/* dvicopy.rc: dvicopy resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " dvicopy 1.5"
+
+#define VER_INTERNALNAME_STR "dvicopy"
+#define VER_ORIGINALFILENAME_STR "dvicopy.exe"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1990,95 Peter Breitenlohner (peb@mppmu.mpg.de)"
+
+#define VER_FILEDESCRIPTION_STR "DVI Flattener"
+
+#include <texlive.version>
+
+/* dvicopy.rc ends here */
diff --git a/Build/source/texk/web2c/dvicopy.web b/Build/source/texk/web2c/dvicopy.web
new file mode 100644
index 00000000000..70cabca04b0
--- /dev/null
+++ b/Build/source/texk/web2c/dvicopy.web
@@ -0,0 +1,4480 @@
+% Copyright (C) 1990,95 Peter Breitenlohner (peb@@mppmu.mpg.de)
+%
+% This program is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 1, or (at your option)
+% any later version.
+%
+% You should have received a copy of the GNU General Public License
+% along with this program; if not, write to the Free Software
+% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+%
+% Version 0.9 was finished May 21, 1990.
+% Version 1.0 pixel rounding for real devices (August 6, 1990).
+% Version 1.1 major rearrangements for DVIprint (October 7, 1990).
+% Version 1.2 fixed some bugs, page selection (February 13, 1991).
+% Version 1.3 several more changes, command line options,
+% don't load fonts that are never used (August 25, 1992).
+% Version 1.4 fixed a typo (March 28, 1995).
+% Version 1.5 avoided cur_name_length identifier conflict (October 15, 1995).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=manfnt % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\mathchardef\RA="3221 % right arrow
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{DVI\lowercase{copy}} % don't change this line!
+\def\contentspagenumber{1}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont DVIcopy} processor}
+ \vskip 5pt
+ \centerline{Copyright (C) 1990,95 Peter Breitenlohner}
+ \centerline{Distributed under terms of GNU General Public License}
+ \vskip 15pt
+ \centerline{(Version 1.5, October 1995)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ This program was developed at the Max-Planck-Institut f\"ur Physik
+ (Werner-Heisenberg-Institut), Munich, Germany.
+ `\TeX' is a trademark of the American Mathematical Society.
+ `{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley
+ Publishing Company.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{DVIcopy} utility program copies (selected pages of) binary
+device-independent (``\.{DVI}'') files that are produced by document
+compilers such as \TeX, and replaces all references to characters from
+virtual fonts by the typesetting instructions specified for them in
+binary virtual-font (``\.{VF}'') files.
+This program has two chief purposes: (1)~It can be used as preprocessor
+for existing \.{DVI}-related software in cases where this software is
+unable to handle virtual fonts or (given suitable \.{VF} files) where
+this software cannot handle fonts with more than 128~characters;
+and (2)~it serves as an example of a program that reads \.{DVI} and
+\.{VF} files correctly, for system programmers who are developing
+\.{DVI}-related software.
+
+Goal number (1) is important since quite a few existing programs have
+to be adapted to the extened capabilities of Version~3 of \TeX\ which
+will require some time. Moreover some existing programs are `as is' and
+the source code is, unfortunately, not available.
+Goal number (2) needs perhaps a bit more explanation. Programs for
+typesetting need to be especially careful about how they do arithmetic; if
+rounding errors accumulate, margins won't be straight, vertical rules
+won't line up, and so on (see the documentaion of \.{DVItype} for more
+details). This program is written as if it were a \.{DVI}-driver for a
+hypothetical typesetting device |out_file|, the output file receiving
+the copy of the input |dvi_file|. In addition all code related to
+|out_file| is concentrated in two chapters at the end of this program
+and quite independent of the rest of the code concerned with the
+decoding of \.{DVI} and \.{VF} files and with font substitutions. Thus
+it should be relatively easy to replace the device dependent code of
+this program by the corresponding code required for a real typesetting
+device. Having this in mind \.{DVItype}'s pixel rounding algorithms are
+included as conditional code not used by \.{DVIcopy}.
+
+The |banner| and |preamble_comment| strings defined here should be
+changed whenever \.{DVIcopy} gets modified.
+
+@d banner=='This is DVIcopy, Version 1.5' {printed when the program starts}
+@d title=='DVIcopy' {the name of this program, used in some messages}
+@d copyright=='Copyright (C) 1990,95 Peter Breitenlohner'
+@#
+@d preamble_comment=='DVIcopy 1.5 output from '
+@d comm_length=24 {length of |preamble_comment|}
+@d from_length=6 {length of its |' from '| part}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{DVIcopy} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+All places where nonstandard constructions are used have been listed in
+the index under ``system dependencies.''
+@!@^system dependencies@>
+
+One of the extensions to standard \PASCAL\ that we shall deal with is the
+ability to move to a random place in a binary file; another is to
+determine the length of a binary file. Such extensions are not necessary
+for reading \.{DVI} files; since \.{DVIcopy} is (a model for) a
+production program it should, however, be made as efficient as possible
+for a particular system. If \.{DVIcopy} is being used with
+\PASCAL s for which random file positioning is not efficiently available,
+the following definition should be changed from |true| to |false|; in such
+cases, \.{DVIcopy} will not include the optional feature that reads the
+postamble first.
+
+@d random_reading==true {should we skip around in the file?}
+
+@ The program begins with a fairly normal header, made up of pieces that
+@^system dependencies@>
+will mostly be filled in later. The \.{DVI} input comes from file
+|dvi_file|, the \.{DVI} output goes to file |out_file|, and messages
+go to \PASCAL's standard |output| file.
+The \.{TFM} and \.{VF} files are defined later since their external
+names are determined dynamically.
+
+If it is necessary to abort the job because of a fatal error, the program
+calls the `|jump_out|' procedure, which goes to the label |final_end|.
+
+@d final_end = 9999 {go here to wrap it up}
+
+@p @t\4@>@<Compiler directives@>@/
+program DVI_copy(@!dvi_file,@!out_file,@!output);
+label final_end;
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ print_ln(copyright);
+ print_ln('Distributed under terms of GNU General Public License');@/
+ @<Set initial values@>@/
+ end;
+
+@ The definition of |max_font_type| should be adapted to the number of
+font types used by the program; the first three values have a fixed
+meaning: |defined_font=0| indicates that a font has been defined,
+|loaded_font=1| indicates that the \.{TFM} file has been loaded but the
+font has not yet been used, and |vf_font_type=2| indicates a virtual
+font. Font type values |>=real_font=3| indicate real fonts and
+different font types are used to distinguish various kinds of font files
+(\.{GF} or \.{PK} or \.{PXL}). \.{DVIcopy} uses |out_font_type=3| for
+fonts that appear in the output \.{DVI} file.
+@!@^font types@>
+
+@d defined_font=0 {this font has been defined}
+@d loaded_font=1 {this font has been defined and loaded}
+@d vf_font_type=2 {this font is a virtual font}
+@d real_font=3 {smallest font type for real fonts}
+@#
+@d out_font_type=3 {this font appears in the output file}
+@d max_font_type=3
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{DVIcopy}'s capacity.
+
+@d max_select=10 {maximum number of page selection ranges}
+
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts}
+@!max_chars=10000; {maximum number of different characters among all fonts}
+@!max_widths=3000; {maximum number of different characters widths}
+@!max_packets=5000; {maximum number of different characters packets;
+ must be less than 65536}
+@!max_bytes=30000; {maximum number of bytes for characters packets}
+@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!name_length=50; {a file name shouldn't be longer than this}
+
+@ As mentioned above, \.{DVIcopy} has two chief purposes: (1)~It produces
+a copy of the input \.{DVI} file with all references to characters from
+virtual fonts replaced by their expansion as specified in the character
+packets of \.{VF} files; and (2)~it serves as an example of a program
+that reads \.{DVI} and \.{VF} files correctly, for system programmers
+who are developing \.{DVI}-related software.
+
+In fact, a very large section of code (starting with the second chapter
+`Introduction (continued)' and ending with the fifteenth chapter
+`The main program') is used in identical form in \.{DVIcopy} and in
+\.{DVIprint}, a prototype \.{DVI}-driver. This has been made possible
+mostly by using several \.{WEB} coding tricks, such as not to make the
+resulting \PASCAL\ program inefficient in any way.
+
+Parts of the program that are needed in \.{DVIprint} but not in
+\.{DVIcopy} are delimited by the codewords `$|device|\ldots|ecived|$';
+these are mostly the pixel rounding algorithms used to convert the
+\.{DVI} units of a \.{DVI} file to the raster units of a real output
+device and have been copied more or less verbatim from \.{DVItype}.
+
+@d device==@{ {change this to `$\\{device}\equiv\null$' when output
+ for a real device is produced}
+@d ecived==@t@>@} {change this to `$\\{ecived}\equiv\null$' when output
+ for a real device is produced}
+@f device==begin
+@f ecived==end
+
+@* Introduction (continued).
+On some systems it is necessary to use various integer subrange types
+in order to make \.{\title} efficient; this is true in particular for
+frequently used variables such as loop indices. Consider an integer
+variable |x| with values in the range |0..255|: on most small systems
+|x| should be a one or two byte integer whereas on most large systems
+|x| should be a four byte integer.
+Clearly the author of a program knows best which range of values is
+required for each variable; thus \.{\title} never uses \PASCAL's |integer|
+type. All integer variables are declared as one of the integer subrange
+types defined below as \.{WEB} macros or \PASCAL\ types; these definitions
+can be used without system-dependent changes, provided the signed 32~bit
+integers are a subset of the standard type |integer|, and the compiler
+automatically uses the optimal representation for integer subranges
+(both conditions need not be satisfied for a particular system).
+@^system dependencies@>
+
+The complementary problem of storing large arrays of integer type
+variables as compactly as possible is addressed differently; here
+\.{\title} uses a \PASCAL\ |type|~declaration for each kind of array
+element.
+
+Note that the primary purpose of these definitions is optimizations, not
+range checking. All places where optimization for a particular system is
+highly desirable have been listed in the index under ``optimization.''
+@!@^optimization@>
+
+@d int_32 == integer {signed 32~bit integers}
+
+@<Types...@>=
+@!int_31 = 0..@"7FFFFFFF; {unsigned 31~bit integer}
+@!int_24u = 0..@"FFFFFF; {unsigned 24~bit integer}
+@!int_24 = -@"800000..@"7FFFFF; {signed 24~bit integer}
+@!int_23 = 0..@"7FFFFF; {unsigned 23~bit integer}
+@!int_16u = 0..@"FFFF; {unsigned 16~bit integer}
+@!int_16 = -@"8000..@"7FFF; {signed 16~bit integer}
+@!int_15 = 0..@"7FFF; {unsigned 15~bit integer}
+@!int_8u = 0..@"FF; {unsigned 8~bit integer}
+@!int_8 = -@"80..@"7F; {signed 8~bit integer}
+@!int_7 = 0..@"7F; {unsigned 7~bit integer}
+
+@ Some of this code is optional for use when debugging only;
+such material is enclosed between the delimiters |debug| and $|gubed|$.
+Other parts, delimited by |stat| and $|tats|$, are optionally included
+if statistics about \.{\title}'s memory usage are desired.
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$'
+ when gathering usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
+ when gathering usage statistics}
+@f stat==begin
+@f tats==end
+
+@ The \PASCAL\ compiler used to develop this program has ``compiler
+directives'' that can appear in comments whose first character is a dollar sign.
+In production versions of \.{\title} these directives tell the compiler that
+@^system dependencies@>
+it is safe to avoid range checks and to leave out the extra code it inserts
+for the \PASCAL\ debugger's benefit, although interrupts will occur if
+there is arithmetic overflow.
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ Labels are given symbolic names by the following definitions. We insert
+the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
+procedure in which we have used the `|return|' statement defined below;
+the label `|restart|' is occasionally used at the very beginning of a
+procedure; and the label `|reswitch|' is occasionally used just prior to
+a \&{case} statement in which some cases change the conditions and we wish to
+branch to the newly applicable case.
+Loops that are set up with the \&{loop} construction defined below are
+commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
+and they are sometimes repeated by going to `|continue|'.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=31 {go here when you've found it}
+@d not_found=32 {go here when you've found something else}
+
+@ The term |print| is used instead of |write| when this program writes on
+|output|, so that all such output could easily be redirected if desired;
+the term |d_print| is used for conditional output if we are debugging.
+
+@d print(#)==write(output,#)
+@d print_ln(#)==write_ln(output,#)
+@d new_line==write_ln(output) {start new line}
+@d print_nl(#)== {print information starting on a new line}
+ begin new_line; print(#);
+ end
+@#
+@d d_print(#)==@!debug print(#) @; @+ gubed
+@d d_print_ln(#)==@! debug print_ln(#) @; @+ gubed
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@#
+@d Incr_Decr_end(#)==#
+@d Incr(#)==#:=#+Incr_Decr_end {we use |Incr(a)(b)| to increase \dots}
+@d Decr(#)==#:=#-Incr_Decr_end {\dots\ and |Decr(a)(b)| to decrease
+ variable |a| by |b|; this can be optimized for some compilers}
+@#
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@f loop == xclause
+
+@ We assume that |case| statements may include a default case that applies
+if no matching label is found. Thus, we shall use constructions like
+@^system dependencies@>
+$$\vbox{\halign{#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the compiler
+used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
+and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
+`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
+and |endcases| should be changed to agree with local conventions. (Of
+course, if no default mechanism is available, the |case| statements of
+this program must be extended by listing all remaining cases.
+Donald~E. Knuth, the author of the \.{WEB} system program \.{TANGLE},
+@^Knuth, Donald Ervin@>
+would have taken the trouble to modify \.{TANGLE} so that such extensions
+were done automatically, if he had not wanted to encourage \PASCAL\
+compiler writers to make this important change in \PASCAL, where it belongs.)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{\title} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used, and because \.{DVI} and \.{VF} files use ASCII code for
+file names and certain other strings.
+
+The next few sections of \.{\title} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{\title} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+If such codes appear in the \.{DVI} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{\title}.
+So we shall assume that the \PASCAL\ system being used for \.{\title}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ @<Local variables for init...@>=
+@!i:int_16; {loop index for initializations}
+
+@ The \.{\title} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Reporting errors to the user.
+The \.{\title} processor does not verify that every single bit read from
+one of its binary input files is meaningful and consistent; there are
+other programs, e.g., \.{DVItype}, \.{TFtoPL}, and \.{VFtoPL}, specially
+designed for that purpose.
+
+On the other hand, \.{\title} is designed to avoid unpredictable results
+due to undetected arithmetic overflow, or due to violation of integer
+subranges or array bounds under {\it all\/} circumstances. Thus a fair
+amount of checking is done when reading and analyzing the input data,
+even in cases where such checking reduces the efficiency of the program
+to some extent.
+
+@ A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d harmless_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+@#
+@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
+@d mark_error==history:=error_message
+@d mark_fatal==history:=fatal_message
+
+@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
+
+@ @<Set init...@>=history:=spotless;
+
+@ If an input (\.{DVI}, \.{TFM}, \.{VF}, or other) file is badly malformed,
+the whole process must be aborted; \.{\title} will give up, after issuing
+an error message about what caused the error. These messages will, however,
+in most cases just indicate which input file caused the error. One of the
+programs \.{DVItype}, \.{TFtoPL} or \.{VFtoVP} should then be used to
+diagnose the error in full detail.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+transfers control to the label |final_end| at the end of the program,
+contains the only non-local |@!goto| statement in \.{\title}.
+@^system dependencies@>
+Some \PASCAL\ compilers do not implement non-local |goto| statements. In
+such cases the |goto final_end| in |jump_out| should simply be replaced
+by a call on some system procedure that quietly terminates the program.
+@^system dependencies@>
+
+@d abort(#)==begin print_ln(' ',#,'.'); jump_out;
+ end
+
+@<Error handling...@>=
+@<Basic printing procedures@>@;
+procedure close_files_and_terminate; forward;
+@#
+procedure jump_out;
+begin mark_fatal; close_files_and_terminate;
+goto final_end;
+end;
+
+@ Sometimes the program's behavior is far different from what it should
+be, and \.{\title} prints an error message that is really for the
+\.{\title} maintenance person, not the user. In such cases the program
+says |confusion(|indication of where we are|)|.
+
+@<Error handling...@>=
+procedure confusion(@!p:pckt_pointer);
+begin print(' !This can''t happen ('); print_packet(p); print_ln(').');
+@.This can't happen@>
+jump_out;
+end;
+
+@ An overflow stop occurs if \.{\title}'s tables aren't large enough.
+
+@<Error handling...@>=
+procedure overflow(@!p:pckt_pointer;@!n:int_16u);
+begin print(' !Sorry, ',title,' capacity exceeded ['); print_packet(p);
+@.Sorry, {\title} capacity exceeded@>
+print_ln('=',n:1,'].');
+jump_out;
+end;
+
+@* Binary data and binary files.
+A detailed description of the \.{DVI} file format can be found in the
+documentation of \TeX, \.{DVItype}, or \.{GFtoDVI}; here we just define
+symbolic names for some of the \.{DVI} command bytes.
+
+@d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@#
+@d dvi_id=2 {identifies \.{DVI} files}
+@d dvi_pad=223 {pad bytes at end of \.{DVI} file}
+
+@ A \.{DVI}, \.{VF}, or \.{TFM} file is a sequence of 8-bit bytes.
+The bytes appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo. One, two, three, or four consecutive bytes are often
+interpreted as (signed or unsigned) integers.
+We might as well define the corresponding data types.
+@!@^system dependencies@>
+
+@<Types...@>=
+@!signed_byte=-@"80..@"7F; {signed one-byte quantity}
+@!eight_bits=0..@"FF; {unsigned one-byte quantity}
+@!signed_pair=-@"8000..@"7FFF; {signed two-byte quantity}
+@!sixteen_bits=0..@"FFFF; {unsigned two-byte quantity}
+@!signed_trio=-@"800000..@"7FFFFF; {signed three-byte quantity}
+@!twentyfour_bits=0..@"FFFFFF; {unsigned three-byte quantity}
+@!signed_quad=int_32; {signed four-byte quantity}
+
+@ Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{\title} is written in standard \PASCAL.
+@^system dependencies@>
+
+One common way to solve the problem is to consider files of |integer|
+numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
+a sequence of four bytes $(a,b,c,d)$ using the following code, which
+avoids the controversial integer division of negative numbers:
+$$\vbox{\halign{#\hfil\cr
+|if x>=0 then a:=x div @'100000000|\cr
+|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
+\quad|end|\cr
+|x:=x mod @'100000000;|\cr
+|b:=x div @'200000; x:=x mod @'200000;|\cr
+|c:=x div @'400; d:=x mod @'400;|\cr}}$$
+The four bytes are then kept in a buffer and output one by one. (On 36-bit
+computers, an additional division by 16 is necessary at the beginning.
+Another way to separate an integer into four bytes is to use/abuse
+\PASCAL's variant records, storing an integer and retrieving bytes that are
+packed in the same place; {\sl caveat implementor!\/}) It is also desirable
+in some cases to read a hundred or so integers at a time, maintaining a
+larger buffer.
+
+@ We shall stick to simple \PASCAL\ in the standard version of this program,
+for reasons of clarity, even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ For some operating systems it may be convenient or even necessary to
+close the input files.
+
+@d close_in(#)==do_nothing {close an input file}
+
+@ Character packets extracted from \.{VF} files will be stored in a large
+array |byte_mem|. Other packets of bytes, e.g., character packets
+extracted from a \.{GF} or \.{PK} or \.{PXL} file could be stored in the
+same way. A `|pckt_pointer|' variable, which signifies a packet,
+is an index into another array |pckt_start|. The actual sequence of bytes
+in the packet pointed to by |p| appears in positions |pckt_start[p]| to
+|pckt_start[p+1]-1|, inclusive, in |byte_mem|.
+
+Packets will also be used to store sequences of |ASCII_code|s; in this
+respect the |byte_mem| array is very similar to \TeX's string pool and
+part of the following code has, in fact, been copied more or less
+verbatim from \TeX.
+
+In other respects the packets resemble the identifiers used by
+\.{TANGLE} and \.{WEAVE} (also stored in an array called |byte_mem|)
+since there is, in general, at most one packet with a given contents;
+thus part of the code below has been adapted from the corresponding code
+in these programs.
+
+Some \PASCAL\ compilers won't pack integers into a single byte unless the
+integers lie in the range |-128..127|. To accommodate such systems we
+access the array |byte_mem| only via macros that can easily be redefined.
+@^system dependencies@>
+
+@d bi(#) == # {convert from |eight_bits| to |packed_byte|}
+@d bo(#) == # {convert from |packed_byte| to |eight_bits|}
+
+@<Types...@>=
+@!packed_byte = eight_bits; {elements of |byte_mem| array}
+@!byte_pointer = 0..max_bytes; {an index into |byte_mem|}
+@!pckt_pointer = 0..max_packets; {an index into |pckt_start|}
+
+@ The global variable |byte_ptr| points to the first unused location in
+|byte_mem| and |pckt_ptr| points to the first unused location in
+|pckt_start|.
+
+@<Globals...@>=
+@!byte_mem: packed array [byte_pointer] of packed_byte; {bytes of packets}
+@!pckt_start: array [pckt_pointer] of byte_pointer;
+ {directory into |byte_mem|}
+@!byte_ptr: byte_pointer;
+@!pckt_ptr: pckt_pointer;
+
+@ Several of the elementary operations with packets are performed using
+\.{WEB} macros instead of \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a packet.
+@.WEB@>
+
+@d pckt_length(#)==(pckt_start[#+1]-pckt_start[#]) {the number of bytes
+ in packet number \#}
+
+@ Packets are created by appending bytes to |byte_mem|.
+The |append_byte| macro, defined here, does not check to see if the
+value of |byte_ptr| has gotten too high; this test is supposed to be
+made before |append_byte| is used. There is also a |flush_byte|
+macro, which erases the last byte appended.
+
+To test if there is room to append |l| more bytes to |byte_mem|,
+we shall write |pckt_room(l)|, which aborts \.{\title} and gives an
+apologetic error message if there isn't enough room.
+
+@d append_byte(#) == {put byte \# at the end of |byte_mem|}
+begin byte_mem[byte_ptr]:=bi(#); incr(byte_ptr);
+end
+@d flush_byte == decr(byte_ptr) {forget the last byte in |byte_mem|}
+@d pckt_room(#) == {make sure that |byte_mem| hasn't overflowed}
+ if max_bytes-byte_ptr<# then overflow(str_bytes,max_bytes)
+@#
+@d append_one(#) ==
+begin pckt_room(1); append_byte(#);
+end
+
+@ The length of the current packet is called |cur_pckt_length|:
+
+@d cur_pckt_length == (byte_ptr - pckt_start[pckt_ptr])
+
+@ Once a sequence of bytes has been appended to |byte_mem|, it
+officially becomes a packet when the |make_packet| function is called.
+This function returns as its value the identification number of either
+an existing packet with the same contents or, if no such packet exists,
+of the new packet. Thus two packets have the same contents if and only
+if they have the same identification number. In order to locate the
+packet with a given contents, or to find out that no such packet exists,
+we need a hash table. The hash table is kept by the method of simple
+chaining, where the heads of the individual lists appear in the |p_hash|
+array. If |h| is a hash code, the hash table list starts at |p_hash[h]|
+and proceeds through |p_link| pointers.
+
+@d hash_size=353 {should be prime, must be |>256|}
+
+@<Types...@>=
+@!hash_code=0..hash_size;
+
+@ @<Glob...@>=
+@!p_link:array[pckt_pointer] of pckt_pointer; {hash table}
+@!p_hash:array[hash_code] of pckt_pointer;
+
+@ Initially |byte_mem| and all the hash lists are empty; |empty_packet|
+is the empty packet.
+
+@d empty_packet=0 {the empty packet}
+@d invalid_packet==max_packets {used when there is no packet}
+
+@<Set init...@>=
+pckt_ptr:=1; byte_ptr:=1;
+pckt_start[0]:=1; pckt_start[1]:=1;
+for h:=0 to hash_size-1 do p_hash[h]:=0;
+
+@ @<Local variables for init...@>=
+@!h:hash_code; {index into hash-head arrays}
+
+@ Here now is the |make_packet| function used to create packets (and
+strings).
+
+@p function make_packet:pckt_pointer;
+label found;
+var i,@!k:byte_pointer; {indices into |byte_mem|}
+@!h:hash_code; {hash code}
+@!s,@!l:byte_pointer; {start and length of the given packet}
+@!p:pckt_pointer; {where the packet is being sought}
+begin s:=pckt_start[pckt_ptr]; l:=byte_ptr-s; {compute start and length}
+if l=0 then p:=empty_packet
+else begin @<Compute the packet hash code |h|@>;
+ @<Compute the packet location |p|@>;
+ if pckt_ptr=max_packets then overflow(str_packets,max_packets);
+ incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr;
+ end;
+found:make_packet:=p;
+end;
+
+@ A simple hash code is used: If the sequence of bytes is
+$b_1b_2\ldots b_n$, its hash value will be
+$$(2^{n-1}b_1+2^{n-2}b_2+\cdots+b_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the packet hash...@>=
+h:=bo(byte_mem[s]); i:=s+1;
+while i<byte_ptr do
+ begin h:=(h+h+bo(byte_mem[i])) mod hash_size; incr(i);
+ end
+
+@ If the packet is new, it will be placed in position |p=pckt_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the packet location...@>=
+p:=p_hash[h];
+while p<>0 do
+ begin if pckt_length(p)=l then
+ @<Compare packet |p| with current packet, |goto found| if equal@>;
+ p:=p_link[p];
+ end;
+p:=pckt_ptr; {the current packet is new}
+p_link[p]:=p_hash[h]; p_hash[h]:=p {insert |p| at beginning of hash list}
+
+@ @<Compare packet |p|...@>=
+begin i:=s; k:=pckt_start[p];
+while (i<byte_ptr)and(byte_mem[i]=byte_mem[k]) do
+ begin incr(i); incr(k);
+ end;
+if i=byte_ptr then {all bytes agree}
+ begin byte_ptr:=pckt_start[pckt_ptr]; goto found;
+ end;
+end
+
+@ Some packets are initialized with predefined strings of |ASCII_code|s;
+a few macros permit us to do the initialization with a compact program.
+Since this initialization is done when |byte_mem| is still empty, and
+since |byte_mem| is supposed to be large enough for all the predefined
+strings, |pckt_room| is used only if we are debugging.
+
+@d pid0(#)==#:=make_packet
+@d pid1(#)==byte_mem[byte_ptr-1]:=bi(#); pid0
+@d pid2(#)==byte_mem[byte_ptr-2]:=bi(#); pid1
+@d pid3(#)==byte_mem[byte_ptr-3]:=bi(#); pid2
+@d pid4(#)==byte_mem[byte_ptr-4]:=bi(#); pid3
+@d pid5(#)==byte_mem[byte_ptr-5]:=bi(#); pid4
+@d pid6(#)==byte_mem[byte_ptr-6]:=bi(#); pid5
+@d pid7(#)==byte_mem[byte_ptr-7]:=bi(#); pid6
+@d pid8(#)==byte_mem[byte_ptr-8]:=bi(#); pid7
+@d pid9(#)==byte_mem[byte_ptr-9]:=bi(#); pid8
+@d pid10(#)==byte_mem[byte_ptr-10]:=bi(#); pid9
+@#
+@d pid_init(#)==
+ @!debug pckt_room(#); @+ gubed @;
+ Incr(byte_ptr)(#)
+@#
+@d id1==pid_init(1); pid1
+@d id2==pid_init(2); pid2
+@d id3==pid_init(3); pid3
+@d id4==pid_init(4); pid4
+@d id5==pid_init(5); pid5
+@d id6==pid_init(6); pid6
+@d id7==pid_init(7); pid7
+@d id8==pid_init(8); pid8
+@d id9==pid_init(9); pid9
+@d id10==pid_init(10); pid10
+
+@ Here we initialize some strings used as argument of the |overflow| and
+|confusion| procedures.
+
+@<Initialize predefined strings@>=
+id5("f")("o")("n")("t")("s")(str_fonts);
+id5("c")("h")("a")("r")("s")(str_chars);
+id6("w")("i")("d")("t")("h")("s")(str_widths);
+id7("p")("a")("c")("k")("e")("t")("s")(str_packets);
+id5("b")("y")("t")("e")("s")(str_bytes);
+id9("r")("e")("c")("u")("r")("s")("i")("o")("n")(str_recursion);
+id5("s")("t")("a")("c")("k")(str_stack);
+id10("n")("a")("m")("e")("l")("e")("n")("g")("t")("h")(str_name_length);
+
+@ @<Glob...@>=
+@!str_fonts,@!str_chars,@!str_widths,@!str_packets,@!str_bytes,
+@!str_recursion,@!str_stack,@!str_name_length:pckt_pointer;
+
+@ Some packets, e.g., the preamble comments of \.{DVI} and \.{VF} files,
+are needed only temporarily. In such cases |new_packet| is used to
+create a packet (which might duplicate an existing packet) and
+|flush_packet| is used to discard it; the calls to |new_packet| and
+|flush_packet| must occur in balanced pairs, without any intervening
+calls to |make_packet|.
+
+@p function new_packet: pckt_pointer;
+begin if pckt_ptr=max_packets then overflow(str_packets,max_packets);
+new_packet:=pckt_ptr; incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr;
+end;
+@#
+procedure flush_packet;
+begin decr(pckt_ptr); byte_ptr:=pckt_start[pckt_ptr];
+end;
+
+@ The |print_packet| procedure prints the contents of a packet; such a
+packets should, of course, consists of a sequence of |ASCII_code|s.
+
+@<Basic printing...@>=
+procedure print_packet(p:pckt_pointer);
+var k:byte_pointer;
+begin for k:=pckt_start[p] to pckt_start[p+1]-1 do
+ print(xchr[bo(byte_mem[k])]);
+end;
+
+@ When we interpret a packet we will use two (global or local) variables:
+|cur_loc| will point to the byte to be used next, and |cur_limit| will
+point to the start of the next packet. The macro |pckt_extract| will be
+used to extract one byte; it should, however, never be used with
+|cur_loc>=cur_limit|.
+
+@d pckt_extract(#) ==
+@!debug if cur_loc>=cur_limit then confusion(str_packets) @+ else @/
+gubed @;
+ begin #:=bo(byte_mem[cur_loc]); incr(cur_loc); @+ end
+
+@<Globals...@>=
+@!cur_pckt: pckt_pointer; {the current packet}
+@!cur_loc: byte_pointer; {current location in a packet}
+@!cur_limit: byte_pointer; {start of next packet}
+
+@ We will need routines to extract one, two, three, or four bytes from
+|byte_mem|, from the \.{DVI} file, or from a \.{VF} file and assemble
+them into (signed or unsigned) integers and these routines should be
+optimized for efficiency. Here we define \.{WEB} macros to be used for
+the body of these routines; thus the changes for system dependent
+optimization have to be applied only once.
+@^system dependencies@>
+@^optimization@>
+
+In addition we demonstrates how these macros can be used to define
+functions that extract one, two, three, or four bytes from a character
+packet and assemble them into signed or unsigned integers (assuming that
+|cur_loc| and |cur_limit| are initialized suitably).
+
+@d begin_byte(#) ==
+var a:eight_bits;
+begin #(a)
+@d comp_sbyte(#) == if a<128 then #:=a @+ else #:=a-256
+@d comp_ubyte(#) == #:=a
+@f begin_byte == begin
+
+@p function pckt_sbyte:int_8; {returns the next byte, signed}
+@!begin_byte(pckt_extract); comp_sbyte(pckt_sbyte);
+end;
+@#
+function pckt_ubyte:int_8u; {returns the next byte, unsigned}
+@!begin_byte(pckt_extract); comp_ubyte(pckt_ubyte);
+end;
+
+@ @d begin_pair(#) ==
+var a,@!b:eight_bits;
+begin #(a); #(b)
+@d comp_spair(#) == if a<128 then #:=a*256+b @+ else #:=(a-256)*256+b
+@d comp_upair(#) == #:=a*256+b
+@f begin_pair == begin
+
+@p function pckt_spair:int_16; {returns the next two bytes, signed}
+@!begin_pair(pckt_extract); comp_spair(pckt_spair);
+end;
+@#
+function pckt_upair:int_16u; {returns the next two bytes, unsigned}
+@!begin_pair(pckt_extract); comp_upair(pckt_upair);
+end;
+
+@ @d begin_trio(#) ==
+var a,@!b,@!c:eight_bits;
+begin #(a); #(b); #(c)
+@d comp_strio(#) ==
+if a<128 then #:=(a*256+b)*256+c @+ else #:=((a-256)*256+b)*256+c
+@d comp_utrio(#) == #:=(a*256+b)*256+c
+@f begin_trio == begin
+
+@p function pckt_strio:int_24; {returns the next three bytes, signed}
+@!begin_trio(pckt_extract); comp_strio(pckt_strio);
+end;
+@#
+function pckt_utrio:int_24u; {returns the next three bytes, unsigned}
+@!begin_trio(pckt_extract); comp_utrio(pckt_utrio);
+end;
+
+@ @d begin_quad(#) ==
+var a,@!b,@!c,@!d:eight_bits;
+begin #(a); #(b); #(c); #(d)
+@d comp_squad(#) ==
+if a<128 then #:=((a*256+b)*256+c)*256+d
+else #:=(((a-256)*256+b)*256+c)*256+d
+@f begin_quad == begin
+
+@p function pckt_squad:int_32; {returns the next four bytes, signed}
+@!begin_quad(pckt_extract); comp_squad(pckt_squad);
+end;
+
+@ A similar set of routines is needed for the inverse task of
+decomposing a \.{DVI} command into a sequence of bytes to be appended
+to |byte_mem| or, in the case of \.{DVIcopy}, to be written to the
+output file. Again we define \.{WEB} macros to be used for the body
+of these routines; thus the changes for system dependent optimization
+have to be applied only once.
+@^system dependencies@>
+@^optimization@>
+
+First, the |pckt_one| outputs one byte, negative values are represented
+in two's complement notation.
+
+@d begin_one == begin
+@d comp_one(#) ==
+if x<0 then Incr(x)(256);
+#(x)
+@f begin_one == begin
+
+@p @!device
+procedure pckt_one(@!x:int_32); {output one byte}
+@!begin_one; pckt_room(1); comp_one(append_byte);
+end;
+ecived
+
+@ The |pckt_two| outputs two bytes, negative values are represented in
+two's complement notation.
+
+@d begin_two == begin
+@d comp_two(#) ==
+if x<0 then Incr(x)(@"10000);
+#(x div @"100); #(x mod @"100)
+@f begin_two == begin
+
+@p @!device
+procedure pckt_two(@!x:int_32); {output two byte}
+@!begin_two; pckt_room(2); comp_two(append_byte);
+end;
+ecived
+
+@ The |pckt_four| procedure outputs four bytes in two's complement
+notation, without risking arithmetic overflow.
+
+@d begin_four == begin
+@d comp_four(#) ==
+if x>=0 then #(x div @"1000000)
+else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
+ #((x div @"1000000) + 128);
+ end;
+x:=x mod @"1000000; #(x div @"10000);
+x:=x mod @"10000; #(x div @"100);
+#(x mod @"100)
+@f begin_four == begin
+
+@p procedure pckt_four(@!x:int_32); {output four bytes}
+@!begin_four; pckt_room(4); comp_four(append_byte);
+end;
+
+@ Next, the |pckt_char| procedure outputs a |set_char| or \\{set} command
+or, if |upd=false|, a |put| command.
+
+@d begin_char ==
+var o:eight_bits; {|set1| or |put1|}
+begin
+@d comp_char(#) ==
+if (not upd)or(res>127)or(ext<>0) then
+ begin o:=dvi_char_cmd[upd]; {|set1| or |put1|}
+ if ext<0 then Incr(ext)(@"1000000);
+ if ext=0 then #(o) @+ else @;
+ begin if ext<@"100 then #(o+1) @+ else @;
+ begin if ext<@"10000 then #(o+2) @+ else @;
+ begin #(o+3); #(ext div @"10000); ext:=ext mod @"10000;
+ end;
+ #(ext div @"100); ext:=ext mod @"100;
+ end;
+ #(ext);
+ end;
+ end;
+#(res)
+@f begin_char == begin
+
+@p procedure pckt_char(@!upd:boolean;@!ext:int_32;@!res:eight_bits);
+ {output \\{set} or |put|}
+@!begin_char; pckt_room(5); comp_char(append_byte);
+end;
+
+@ Then, the |pckt_unsigned| procedure outputs a |fnt| or |xxx|
+command with its first parameter (normally unsigned); a |fnt| command
+is converted into |fnt_num| whenever this is possible.
+
+@d begin_unsigned == begin
+@d comp_unsigned(#) ==
+if (x<@"100)and(x>=0) then
+ if (o=fnt1)and(x<64) then Incr(x)(fnt_num_0) @+ else #(o)
+else
+ begin if (x<@"10000)and(x>=0) then #(o+1) @+ else @;
+ begin if (x<@"1000000)and(x>=0) then #(o+2) @+ else @;
+ begin #(o+3);
+ if x>=0 then #(x div @"1000000)
+ else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
+ #((x div @"1000000) + 128);
+ end;
+ x:=x mod @"1000000;
+ end;
+ #(x div @"10000); x:=x mod @"10000;
+ end;
+ #(x div @"100); x:=x mod @"100;
+ end;
+#(x)
+@f begin_unsigned == begin
+
+@p procedure pckt_unsigned(@!o:eight_bits;@!x:int_32);
+ {output |fnt_num|, |fnt|, or |xxx|}
+@!begin_unsigned; pckt_room(5); comp_unsigned(append_byte);
+end;
+
+@ Finally, the |pckt_signed| procedure outputs a movement (|right|, |w|,
+|x|, |down|, |y|, or |z|) command with its (signed) parameter.
+
+@d begin_signed ==
+var xx:int_31; {`absolute value' of |x|}
+begin
+@d comp_signed(#) ==
+if x>=0 then xx:=x @+ else xx:=-(x+1);
+if xx<@"80 then
+ begin #(o); @+ if x<0 then Incr(x)(@"100); @+ end
+else begin if xx<@"8000 then
+ begin #(o+1); @+ if x<0 then Incr(x)(@"10000); @+ end
+ else begin if xx<@"800000 then
+ begin #(o+2); @+ if x<0 then Incr(x)(@"1000000); @+ end
+ else begin #(o+3);
+ if x>=0 then #(x div @"1000000)
+ else begin x:=@"7FFFFFFF-xx; #((x div @"1000000) + 128); @+ end;
+ x:=x mod @"1000000;
+ end;
+ #(x div @"10000); x:=x mod @"10000;
+ end;
+ #(x div @"100); x:=x mod @"100;
+ end;
+#(x)
+@f begin_signed == begin
+
+@p procedure pckt_signed(@!o:eight_bits;@!x:int_32);
+ {output |right|, |w|, |x|, |down|, |y|, or |z|}
+@!begin_signed; pckt_room(5); comp_signed(append_byte);
+end;
+
+@ The |hex_packet| procedure prints the contents of a packet in
+hexadecimal form.
+
+@<Basic printing...@>=
+@!debug procedure hex_packet(@!p:pckt_pointer); {prints a packet in hex}
+var j,@!k,@!l:byte_pointer; {indices into |byte_mem|}
+@!d:int_8u;
+begin j:=pckt_start[p]-1; k:=pckt_start[p+1]-1;
+print_ln(' packet=',p:1,' start=',j+1:1,' length=',k-j:1);
+for l:=j+1 to k do
+ begin d:=(bo(byte_mem[l])) div 16;
+ if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]);
+ d:=(bo(byte_mem[l])) mod 16;
+ if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]);
+ if (l=k)or(((l-j) mod 16)=0) then new_line
+ else if ((l-j) mod 4)=0 then print(' ')
+ else print(' ');
+ end;
+end;
+gubed
+
+@* File names.
+The structure of file names is different for different systems; therefore
+this part of the program will, in most cases, require system dependent
+modifications. Here we assume that a file name consists of three parts:
+an area or directory specifying where the file can be found, a name
+proper and an extension; \.{\title} assumes that these three parts appear
+in order stated above but this need not be true in all cases.
+
+The font names extracted from \.{DVI} and \.{VF} files consist of an area
+part and a name proper; these are stored as packets consisting of the
+length of the area part followed by the area and the name proper.
+When we print an external font name we simple print the area and the name
+contained in the `file name packet' without delimiter between them.
+This may need to be modified for some systems.
+@^system dependencies@>
+
+@<Basic printing...@>=
+procedure print_font(@!f:font_number);
+var p:pckt_pointer; {the font name packet}
+@!k:byte_pointer; {index into |byte_mem|}
+@!m:int_31; {font magnification}
+begin print(' = '); p:=font_name(f);
+for k:=pckt_start[p]+1 to pckt_start[p+1]-1 do
+ print(xchr[bo(byte_mem[k])]);
+m:=round((font_scaled(f)/font_design(f))*out_mag);
+if m<>1000 then print(' scaled ',m:1);
+end;
+
+@ Before a font file can be opened for input we must build a string
+with its external name.
+
+@<Glob...@>=
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!l_cur_name:int_15; {this many characters are actually relevant in
+ |cur_name|}
+
+@ For \.{TFM} and \.{VF} files we just append the apropriate extension
+to the file name packet; in addition a system dependent area part
+(usually different for \.{TFM} and \.{VF} files) is prepended if
+the file name packet contains no area part.
+@^system dependencies@>
+
+@d append_to_name(#)==
+ if l_cur_name<name_length then
+ begin incr(l_cur_name); cur_name[l_cur_name]:=#;
+ end
+ else overflow(str_name_length,name_length)
+@d make_font_name_end(#)==
+ append_to_name(#[l]); make_name
+@d make_font_name(#)==
+ l_cur_name:=0; for l:=1 to # do make_font_name_end
+
+@ For files with character raster data (e.g., \.{GF} or \.{PK} files) the
+the extension and\slash or area part will in most cases depend on the
+resolution of the output device (corrected for font magnification).
+If the special character |res_char| occurs in the extension and\slash or
+default area, a character string representing the device resolution will
+be substituted.
+@^system dependencies@>
+
+@d res_char=='?' {character to be replaced by font resolution}
+@d res_ASCII="?" {|xord[res_char]|}
+@#
+@d append_res_to_name(#)==
+ begin c:=#;
+ @!device if c=res_char then
+ for ll:=n_res_digits downto 1 do append_to_name(res_digits[ll])
+ else ecived@;@/
+ append_to_name(c);
+ end
+@d make_font_res_end(#)==
+ append_res_to_name(#[l]); make_name
+@d make_font_res(#)==
+ make_res; l_cur_name:=0; for l:=1 to # do make_font_res_end
+
+@ @<Glob...@>=
+@!device
+@!f_res:int_16u; {font resolution}
+@!res_digits:array [1..5] of char;
+@!n_res_digits:int_7; {number of significant characters in |res_digits|}
+ecived
+
+@ The |make_res| procedure creates a sequence of characters representing
+to the font resolution |f_res|.
+
+@p @!device procedure make_res;
+var r:int_16u;
+begin n_res_digits:=0; r:=f_res;
+repeat incr(n_res_digits);
+ res_digits[n_res_digits]:=xchr["0"+(r mod 10)]; r:=r div 10;
+until r=0;
+end;
+ecived
+
+@ The |make_name| procedure used to build the external file name. The
+global variable |l_cur_name| contains the length of a default area
+which has been copied to |cur_name| before |make_name| is called.
+@^system dependencies@>
+
+@p procedure make_name(@!e:pckt_pointer);
+var b:eight_bits; {a byte extracted from |byte_mem|}
+@!n:pckt_pointer; {file name packet}
+@!cur_loc,@!cur_limit:byte_pointer; {indices into |byte_mem|}
+@!device
+@!ll:int_15; {loop index}
+ecived@;@/
+@!c:char; {a character to be appended to |cur_name|}
+begin n:=font_name(cur_fnt);
+cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
+pckt_extract(b); {length of area part}
+if b>0 then l_cur_name:=0;
+while cur_loc<cur_limit do
+ begin pckt_extract(b);
+ if (b>="a")and(b<="z") then Decr(b)("a"-"A"); {convert to upper case}
+ append_to_name(xchr[b]);
+ end;
+cur_loc:=pckt_start[e]; cur_limit:=pckt_start[e+1];
+while cur_loc<cur_limit do
+ begin pckt_extract(b); append_res_to_name(xchr[b]);
+ end;
+while l_cur_name<name_length do
+ begin incr(l_cur_name); cur_name[l_cur_name]:=' ';
+ end;
+end;
+
+@* Font data.
+\.{DVI} file format does not include information about character widths, since
+that would tend to make the files a lot longer. But a program that reads
+a \.{DVI} file is supposed to know the widths of the characters that appear
+in \\{set\_char} commands. Therefore \.{\title} looks at the font metric
+(\.{TFM}) files for the fonts that are involved.
+@.TFM {\rm files}@>
+
+The character-width data appears also in other files (e.g., in \.{VF} files
+or in \.{GF} and \.{PK} files that specify bit patterns for digitized
+characters); thus, it is usually possible for \.{DVI} reading programs
+to get by with accessing only one file per font. For \.{VF} reading
+programs there is, however, a problem: (1)~when reading the character
+packets from a \.{VF} file the \.{TFM} width for its local fonts should
+be known in order to analyze and optimize the packets (e.g., determine
+if a packet must indeed be enclosed with |push| and |pop| as implied by
+the \.{VF} format); and (2)~ in order to avoid infinite recursion such
+programs must not try to read a \.{VF} file for a font before a
+character from that font is actually used. Thus \.{\title} reads the
+\.{TFM} file whenever a new font is encountered and delays the decision
+whether this is a virtual font or not.
+
+@ First of all we need to know for each font~|f| such things as its
+external name, design and scaled size, and the approximate size of
+inter-word spaces. In addition we need to know the range |bc..ec| of
+valid characters for this font, and for each character~|c| in~|f| we
+need to know if this character exists and if so what is the width of~|c|.
+Depending on the font type of~|f| we may want to know a few other things
+about character~|c| in~|f| such as the character packet from a \.{VF}
+file or the raster data from a \.{PK} file.
+@^font types@>
+
+In \.{\title} we want to be able to handle the full range
+|@t$-2^{31}$@><=c<@t$2^{31}$@>| of character codes; each character code
+is decomposed into a character residue |0<=res<256| and character
+extension |@t$-2^{23}$@><=ext<@t$2^{23}$@>| such that |c=256*ext+res|.
+At present \.{VFtoVP}, \.{VPtoVF}, and the standard version of \TeX\ use
+only characters in the range |0<=c<256| (i.e., |ext=0|), there are,
+however, extensions of \TeX\ which use characters with |ext<>0|.
+In any case characters with |ext<>0| will be used rather infrequently
+and we want to handle this possibility without too much overhead.
+
+Some of the data for each character~|c| depend only on its residue:
+first of all its width and escapement; others, such as \.{VF} packets or
+raster data will also depend on its extension. The later will be stored
+as packets in |byte_mem|, and the packets for characters with the same
+residue but different extension will be chained.
+
+Thus we have to maintain several variables for each character
+residue~|bc<=res<=ec| from each font~|f|; we store each type of variable
+in a large array such that the array index |font_chars(f)+res| points to
+the value for characters with residue |res| from font~|f|.
+
+@ Quite often a particular width value is shared by several characters in
+a font or even by characters from different fonts; the later will
+probably occur in particular for virtual fonts and the local fonts used
+by them. Thus the array |widths| is used to store all different \.{TFM}
+width values of all legal characters in all fonts; a variable of type
+|width_pointer| is an index into |widths| or is zero if a characters does
+not exist.
+
+In order to locate a given width value we use again a hash
+table with simple chaining; this time the heads of the individual lists
+appear in the |w_hash| array and the lists proceed through |w_link|
+pointers.
+
+@<Types...@>=
+@!width_pointer=0..max_widths; {an index into |widths|}
+
+@ @<Glob...@>=
+@!widths:array[width_pointer] of int_32; {the different width values}
+@!w_link:array[width_pointer] of width_pointer; {hash table}
+@!w_hash:array[hash_code] of width_pointer;
+@!n_widths:width_pointer; {first unoccupied position in |widths|}
+
+@ Initially the |widths| array and all the hash lists are empty, except
+for one entry: the width value zero; in addition we set |widths[0]:=0|.
+
+@d invalid_width=0 {width pointer for invalid characters}
+@d zero_width=1 {a width pointer to the value zero}
+
+@<Set init...@>=
+w_hash[0]:=1; w_link[1]:=0; widths[0]:=0; widths[1]:=0; n_widths:=2;
+for h:=1 to hash_size-1 do w_hash[h]:=0;
+
+@ The |make_width| function returns an index into |widths| and, if
+necessary, adds a new width value; thus two characters will have the
+same |width_pointer| if and only if their widths agree.
+
+@p function make_width(@!w:int_32):width_pointer;
+label found;
+var h:hash_code; {hash code}
+@!p:width_pointer; {where the identifier is being sought}
+@!x:int_16; {intermediate value}
+begin widths[n_widths]:=w;
+@<Compute the width hash code |h|@>;
+@<Compute the width location |p|, |goto| found unless the value is new@>;
+if n_widths=max_widths then overflow(str_widths,max_widths);
+incr(n_widths);
+found:make_width:=p;
+end;
+
+@ A simple hash code is used: If the width value consists of the four
+bytes $b_0b_1b_2b_3$, its hash value will be
+$$(8*b_0+4*b_1+2*b_2+b_3)\,\bmod\,|hash_size|.$$
+
+@<Compute the width hash...@>=
+if w>=0 then x:=w div @"1000000
+else begin w:=w+@"40000000; w:=w+@"40000000; x:=(w div @"1000000)+@"80;
+ end;
+w:=w mod @"1000000; x:=x+x+(w div @"10000);
+w:=w mod @"10000; x:=x+x+(w div @"100);
+h:=(x+x+(w mod @"100)) mod hash_size
+
+@ If the width is new, it has been placed into position |p=n_widths|,
+otherwise |p| will point to its existing location.
+
+@<Compute the width location...@>=
+p:=w_hash[h];
+while p<>0 do
+ begin if widths[p]=widths[n_widths] then goto found;
+ p:=w_link[p];
+ end;
+p:=n_widths; {the current width is new}
+w_link[p]:=w_hash[h]; w_hash[h]:=p {insert |p| at beginning of hash list}
+
+@ The |char_widths| array is used to store the |width_pointer|s for all
+different characters among all fonts. The |char_packets| array is used
+to store the |pckt_pointer|s for all different characters among all
+fonts; they can point to character packets from \.{VF} files or, e.g.,
+raster packets from \.{PK} files.
+
+@<Types...@>=
+@!char_offset=-255..max_chars; {|char_pointer| offset for a font}
+@!char_pointer=0..max_chars; {index into |char_widths| or similar arrays}
+
+@ @<Glob...@>=
+@!char_widths:array[char_pointer] of width_pointer; {width pointers}
+@!char_packets:array[char_pointer] of pckt_pointer; {packet pointers}
+@!n_chars:char_pointer; {first unused position in |char_widths|}
+
+@ @<Set init...@>=
+n_chars:=0;
+
+@ The current number of known fonts is |nf|; each known font has an
+internal number |f|, where |0<=f<nf|. For the moment we need for each
+known font: |font_check|, |font_scaled|, |font_design|, |font_name|,
+|font_bc|, |font_ec|, |font_chars|, and |font_type|. Here |font_scaled|
+and |font_design| are measured in \.{DVI} units and |font_chars| is of
+type |char_offset|: the width pointer for character~|c| of the font is
+stored in |char_widths[char_offset+c]| (for |font_bc<=c<=font_ec|).
+Lateron we will need additional information depending on the font type:
+\.{VF} or real (\.{GF}, \.{PK}, or \.{PXL}).
+
+@<Types...@>=
+@!f_type=defined_font..max_font_type; {type of a font}
+@!font_number=0..max_fonts;
+
+@ @<Glob...@>=
+@!nf:font_number;
+
+@ These data are stored in several arrays and we use \.{WEB} macros
+to access the various fields. Thus it would be simple to store the
+data in an array of record structures and adapt the \.{WEB} macros
+accordingly.
+
+We will say, e.g., |font_name(f)| for the name field of font~|f|, and
+|font_width(f)(c)| for the width pointer of character~|c| in font~|f|
+and |font_packet(f)(c)| for its character packet (this character
+exists provided |font_bc(f)<=c<=font_ec(f)| and
+|font_width(f)(c)<>invalid_width|). The actual width of character~|c| in
+font~|f| is stored in |widths[font_width(f)(c)]|.
+
+@d font_check(#)==fnt_check[#] {checksum}
+@d font_scaled(#)==fnt_scaled[#] {scaled or `at' size}
+@d font_design(#)==fnt_design[#] {design size}
+@d font_name(#)==fnt_name[#] {area plus name packet}
+@d font_bc(#)==fnt_bc[#] {first character}
+@d font_ec(#)==fnt_ec[#] {last character}
+@d font_chars(#)==fnt_chars[#] {character info offset}
+@d font_type(#)==fnt_type[#] {type of this font}
+@d font_font(#)==fnt_font[#] {use depends on |font_type|}
+@#
+@d font_width_end(#)==#]
+@d font_width(#)==char_widths[font_chars(#)+font_width_end
+@d font_packet(#)==char_packets[font_chars(#)+font_width_end
+
+@<Glob...@>=
+@!fnt_check:array [font_number] of int_32; {checksum}
+@!fnt_scaled:array [font_number] of int_31; {scaled size}
+@!fnt_design:array [font_number] of int_31; {design size}
+@!device @<Declare device dependent font data arrays@>@; @+ ecived @; @/
+@!fnt_name:array [font_number] of pckt_pointer; {pointer to area plus
+ name packet}
+@!fnt_bc:array [font_number] of eight_bits; {first character}
+@!fnt_ec:array [font_number] of eight_bits; {last character}
+@!fnt_chars:array [font_number] of char_offset; {character info offset}
+@!fnt_type:array [font_number] of f_type; {type of font}
+@!fnt_font:array [font_number] of font_number; {use depends on |font_type|}
+
+@ @d invalid_font==max_fonts {used when there is no valid font}
+
+@<Set init...@>=
+@!device @<Initialize device dependent font data@>@; @+ ecived @;@/
+nf:=0;
+
+@ A \.{VF}, or \.{GF}, or \.{PK} file may contain information for
+several characters with the same residue but with different extension;
+all except the first of the corresponding packets in |byte_mem| will
+contain a pointer to the previous one and |font_packet(f)(res)|
+identifies the last such packet.
+
+A character packet in |byte_mem| starts with a flag byte
+$$\hbox{|flag=@"40*ext_flag+@"20*chain_flag+type_flag|}$$
+with |0<=ext_flag<=3|, |0<=chain_flag<=1|, |0<=type_flag<=@"1F|,
+followed by |ext_flag| bytes with the character extension for this
+packet and, if |chain_flag=1|, by a two byte packet pointer to the
+previous packet for the same font and character residue. The actual
+character packet follows after these header bytes and the
+interpretation of the |type_flag| depends on whether this is a \.{VF}
+packet or a packet for raster data.
+
+The empty packet is interpreted as a special case of a packet with
+|flag=0|.
+
+@d ext_flag=@"40
+@d chain_flag=@"20
+
+@<Types...@>=
+@!type_flag=0..chain_flag-1; {the range of values for the |type_flag|}
+
+@ The global variable |cur_fnt| is the internal font number of the
+currently selected font, or equals |invalid_font| if no font has
+been selected; |cur_res| and |cur_ext| are the residue and extension
+part of the current character code. The type of a character packet
+located by the |find_packet| function defined below is |cur_type|.
+While building a character packet for a character, |pckt_ext| and
+|pckt_res| are the extension and residue of this character; |pckt_dup|
+indicates whether a packet for this extension exists already.
+
+@<Glob...@>=
+@!cur_fnt:font_number; {the currently selected font}
+@!cur_ext:int_24; {the current character extension}
+@!cur_res:int_8u; {the current character residue}
+@!cur_type:type_flag; {type of the current character packet}
+@!pckt_ext:int_24; {character extension for the current character packet}
+@!pckt_res:int_8u; {character residue for the current character packet}
+@!pckt_dup:boolean; {is there a previous packet for the same extension?}
+@!pckt_prev:pckt_pointer; {a previous packet for the same extension}
+@!pckt_m_msg,@!pckt_s_msg,@!pckt_d_msg:int_7; {counts for various character
+ packet error messages}
+
+@ @<Set init...@>=
+cur_fnt:=invalid_font; pckt_m_msg:=0; pckt_s_msg:=0; pckt_d_msg:=0;
+
+@ The |find_packet| functions is used to locate the character packet for
+the character with residue~|cur_res| and extension~|cur_ext| from
+font~|cur_fnt| and returns |false| if no packet exists for any extension;
+otherwise the result is |true| and the global variables |cur_packet|,
+|cur_type|, |cur_loc|, and |cur_limit| are initialized. In case none of
+the character packets has the correct extension, the last one in the
+chain (the one defined first) is used instead and |cur_ext| is changed
+accordingly.
+
+@p function find_packet:boolean;
+label found,exit;
+var p,@!q:pckt_pointer; {current and next packet}
+@!f:eight_bits; {a flag byte}
+@!e:int_24; {extension for a packet}
+begin @<Locate a character packet and |goto found| if found@>;
+if font_packet(cur_fnt)(cur_res)=invalid_packet then
+ begin if pckt_m_msg<10 then {stop telling after first 10 times}
+ begin print_ln('---missing character packet for character ',cur_res:1,
+@.missing character packet...@>
+ ' font ',cur_fnt:1);
+ incr(pckt_m_msg); mark_error;
+ if pckt_m_msg=10 then print_ln('---further messages suppressed.');
+ end;
+ find_packet:=false; return;
+ end;
+if pckt_s_msg<10 then {stop telling after first 10 times}
+ begin print_ln('---substituted character packet with extension ',
+@.substituted character packet...@>
+ e:1,' instead of ',cur_ext:1,' for character ',cur_res:1,
+ ' font ',cur_fnt:1);
+ incr(pckt_s_msg); mark_error;
+ if pckt_s_msg=10 then print_ln('---further messages suppressed.');
+ end;
+cur_ext:=e;
+found: cur_pckt:=p; cur_type:=f; find_packet:=true;
+exit: end;
+
+@ @<Locate a character packet and |goto found| if found@>=
+q:=font_packet(cur_fnt)(cur_res);
+while q<>invalid_packet do
+ begin p:=q; q:=invalid_packet;
+ cur_loc:=pckt_start[p]; cur_limit:=pckt_start[p+1];
+ if p=empty_packet then
+ begin e:=0; f:=0;
+ end
+ else begin pckt_extract(f);
+ case (f div ext_flag) of
+ 0: e:=0;
+ 1: e:=pckt_ubyte;
+ 2: e:=pckt_upair;
+ 3: e:=pckt_strio;
+ end; {there are no other cases}
+ if (f mod ext_flag)>=chain_flag then q:=pckt_upair;
+ f:=f mod chain_flag;
+ end;
+ if e=cur_ext then goto found;
+ end
+
+@ The |start_packet| procedure is used to create the header bytes of a
+character packet for the character with residue~|cur_res| and
+extension~|cur_ext| from font~|cur_fnt|; if a previous such a packet
+exists, we try to build an exact duplicate, i.e., use the chain field of
+that previous packet.
+
+@p procedure start_packet(@!t:type_flag);
+label found,not_found;
+var p,@!q:pckt_pointer; {current and next packet}
+@!f:int_8u; {a flag byte}
+@!e:int_32; {extension for a packet}
+@!cur_loc: byte_pointer; {current location in a packet}
+@!cur_limit: byte_pointer; {start of next packet}
+begin @<Locate a character packet and |goto found| if found@>;
+q:=font_packet(cur_fnt)(cur_res); pckt_dup:=false; goto not_found;
+found: pckt_dup:=true; pckt_prev:=p;
+not_found: pckt_ext:=cur_ext; pckt_res:=cur_res; pckt_room(6);
+@!debug if byte_ptr<>pckt_start[pckt_ptr] then confusion(str_packets);
+gubed @;@/
+if q=invalid_packet then f:=t @+ else f:=t+chain_flag;
+e:=cur_ext;
+if e<0 then Incr(e)(@"1000000);
+if e=0 then append_byte(f) @+ else @;
+ begin if e<@"100 then append_byte(f+ext_flag) @+ else @;
+ begin if e<@"10000 then append_byte(f+ext_flag+ext_flag) @+ else @;
+ begin append_byte(f+ext_flag+ext_flag+ext_flag);
+ append_byte(e div @"10000); e:=e mod @"10000;
+ end;
+ append_byte(e div @"100); e:=e mod @"100;
+ end;
+ append_byte(e);
+ end;
+if q<>invalid_packet then
+ begin append_byte(q div @"100); append_byte(q mod @"100);
+ end;
+end;
+
+@ The |build_packet| procedure is used to finish a character packet.
+If a previous packet for the same character extension exists, the new
+one is discarded; if the two packets are identical, as it occasionally
+occurs for raster files, this is done without an error message.
+
+@p procedure build_packet;
+var k,@!l:byte_pointer; {indices into |byte_mem|}
+begin if pckt_dup then
+ begin k:=pckt_start[pckt_prev+1]; l:=pckt_start[pckt_ptr];
+ if (byte_ptr-l)<>(k-pckt_start[pckt_prev]) then pckt_dup:=false;
+ while pckt_dup and(byte_ptr>l) do
+ begin flush_byte; decr(k);
+ if byte_mem[byte_ptr]<>byte_mem[k] then pckt_dup:=false;
+ end;
+ if (not pckt_dup)and(pckt_d_msg<10) then {stop telling after first 10 times}
+ begin print('---duplicate packet for character ',pckt_res:1);
+@.duplicate packet for character...@>
+ if pckt_ext<>0 then print('.',pckt_ext:1);
+ print_ln(' font ',cur_fnt:1);
+ incr(pckt_d_msg); mark_error;
+ if pckt_d_msg=10 then print_ln('---further messages suppressed.');
+ end;
+ byte_ptr:=l;
+ end
+else font_packet(cur_fnt)(pckt_res):=make_packet;
+end;
+
+@* Defining fonts.
+A detailed description of the \.{TFM} file format can be found in the
+documentation of \TeX, \MF, or \.{TFtoPL}. In order to read \.{TFM}
+files the program uses the binary file variable |tfm_file|.
+
+@<Glob...@>=
+@!tfm_file:byte_file; {a \.{TFM} file}
+@!tfm_ext:pckt_pointer; {extension for \.{TFM} files}
+
+@ @<Initialize predefined strings@>=
+id4(".")("T")("F")("M")(tfm_ext); {file name extension for \.{TFM} files}
+
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{TFM} directory, which is a system-dependent place where
+the \.{TFM} files for standard fonts are kept.
+The string variable |TFM_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d TFM_default_area_name=='TeXfonts:' {change this to the correct name}
+@d TFM_default_area_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!TFM_default_area:packed array[1..TFM_default_area_name_length] of char;
+
+@ @<Set init...@>=
+TFM_default_area:=TFM_default_area_name;
+
+@ If a \.{TFM} file is badly malformed, we say |bad_font|; for a \.{TFM}
+file the |bad_tfm| procedure is used to give an error message which
+refers the user to \.{TFtoPL} and \.{PLtoTF}, and terminates \.{\title}.
+
+@<Error handling...@>=
+procedure bad_tfm;
+begin print('Bad TFM file'); print_font(cur_fnt); print_ln('!');
+@.Bad TFM file@>
+abort('Use TFtoPL/PLtoTF to diagnose and correct the problem');
+@.Use TFtoPL/PLtoTF@>
+end;
+@#
+procedure bad_font;
+begin new_line;
+case font_type(cur_fnt) of
+ defined_font: confusion(str_fonts);
+ loaded_font: bad_tfm;
+ @<Cases for |bad_font|@>@;@/
+ end; {there are no other cases}
+end;
+
+@ To prepare |tfm_file| for input we |reset| it.
+
+@<TFM: Open |tfm_file|@>=
+make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
+reset(tfm_file,cur_name);
+if eof(tfm_file) then
+@^system dependencies@>
+ abort('---not loaded, TFM file can''t be opened!')
+@.TFM file can\'t be opened@>
+
+@ It turns out to be convenient to read four bytes at a time, when we
+are inputting from \.{TFM} files. The input goes into global variables
+|tfm_b0|, |tfm_b1|, |tfm_b2|, and |tfm_b3|, with |tfm_b0| getting the
+first byte and |tfm_b3| the fourth.
+
+@<Glob...@>=
+@!tfm_b0,@!tfm_b1,@!tfm_b2,@!tfm_b3: eight_bits; {four bytes input at once}
+
+@ Reading a \.{TFM} file should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes from |tfm_file| is read into a buffer and will then be extracted
+from that buffer. In order to simplify such system dependent changes
+we use the \.{WEB} macro |tfm_byte| to extract the next \.{TFM} byte;
+this macro and |eof(tfm_file)| are used only in the |read_tfm_word|
+procedure which sets |tfm_b0| through |tfm_b3| to the next four bytes
+in the current \.{TFM} file. Here we give simple minded definitions in
+terms of standard \PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d tfm_byte(#)==read(tfm_file,#) {read next \.{TFM} byte}
+
+@p procedure read_tfm_word;
+begin tfm_byte(tfm_b0); tfm_byte(tfm_b1);
+tfm_byte(tfm_b2); tfm_byte(tfm_b3);
+if eof(tfm_file) then bad_font;
+end;
+
+@ Here are three procedures used to check the consistency of font files:
+First, the |check_check_sum| procedure compares two check sum values: a
+warning is given if they differ and are both non-zero; if the second
+value is not zero it may replace the first one.
+Next, the |check_design_size| procedure compares two design size
+values: a warning is given if they differ by more than a small amount.
+Finally, the |check_width| function compares the character width value
+for character |cur_res| read from a \.{VF} or raster file for font
+|cur_fnt| with the value previously read from the \.{TFM} file and
+returns the width pointer for that value; a warning is given if the two
+values differ.
+
+@p procedure check_check_sum(@!c:int_32;@!u:boolean);
+ {compare |font_check(cur_fnt)| with |c|}
+begin if (c<>font_check(cur_fnt))and(c<>0) then
+ begin
+ if font_check(cur_fnt)<>0 then
+ begin new_line; print_ln('---beware: check sums do not agree! (',
+@.beware: check sums do not agree@>
+@.check sums do not agree@>
+ c:1,' vs. ',font_check(cur_fnt):1,')');
+ mark_harmless;
+ end;
+ if u then font_check(cur_fnt):=c;
+ end;
+end;
+@#
+procedure check_design_size(@!d:int_32);
+ {compare |font_design(cur_fnt)| with |d|}
+begin if abs(d-font_design(cur_fnt))>2 then
+ begin new_line; print_ln('---beware: design sizes do not agree! (',
+@.beware: design sizes do not agree@>
+@.design sizes do not agree@>
+ d:1,' vs. ',font_design(cur_fnt):1,')');
+ mark_error;
+ end;
+end;
+@#
+function check_width(w:int_32):width_pointer;
+ {compare |widths[font_width(cur_fnt)(cur_res)]| with |w|}
+var wp:width_pointer; {pointer to \.{TFM} width value}
+begin if (cur_res>=font_bc(cur_fnt))and(cur_res<=font_ec(cur_fnt)) then
+ wp:=font_width(cur_fnt)(cur_res)
+else wp:=invalid_width;
+if wp=invalid_width then
+ begin print_nl('Bad char ',cur_res:1);
+@.Bad char c@>
+ if cur_ext<>0 then print('.',cur_ext:1);
+ print(' font ',cur_fnt:1); print_font(cur_fnt);
+ abort(' (compare TFM file)');
+ end;
+if w<>widths[wp] then
+ begin new_line; print_ln('---beware: char widths do not agree! (',
+@.beware: char widths do not agree@>
+@.char widths do not agree@>
+ w:1,' vs. ',widths[wp]:1,')');
+ mark_error;
+ end;
+check_width:=wp;
+end;
+
+@ The |load_font| procedure reads the \.{TFM} file for a font and puts
+the data extracted into position |cur_fnt| of the font data arrays.
+
+@p procedure load_font; {reads a \.{TFM} file}
+var l:int_16; {loop index}
+@!p:char_pointer; {index into |char_widths|}
+@!q:width_pointer; {index into |widths|}
+@!bc,@!ec:int_15; {first and last character in this font}
+@!lh:int_15; {length of header in four byte words}
+@!nw:int_15; {number of words in width table}
+@!w:int_32; {a four byte integer}
+@<Variables for scaling computation@>@;
+begin print('TFM: font ',cur_fnt:1); print_font(cur_fnt);
+font_type(cur_fnt):=loaded_font;
+@<TFM: Open |tfm_file|@>;
+@<TFM: Read past the header data@>;
+@<TFM: Store character-width indices@>;
+@<TFM: Read and convert the width values@>;
+@<TFM: Convert character-width indices to character-width pointers@>;
+close_in(tfm_file);
+@!device @<Initialize device dependent data for a font@>@; @+ ecived @; @/
+d_print(' loaded at ',font_scaled(cur_fnt):1,' DVI units');
+print_ln('.');
+end;
+
+@ @<Glob...@>=
+@!tfm_conv:real; {\.{DVI} units per absolute \.{TFM} unit}
+
+@ We will use the following \.{WEB} macros to construct integers from
+two or four of the four bytes read by |read_tfm_word|.
+@^system dependencies@>
+
+@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*256+tfm_b1
+@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
+if tfm_b2>127 then bad_font
+else #:=tfm_b2*256+tfm_b3
+@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
+if tfm_b0<128 then #:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+else #:=(((tfm_b0-256)*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
+(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3)
+
+@<TFM: Read past the header data@>=
+read_tfm_word; tfm_b23(lh);
+read_tfm_word; tfm_b01(bc); tfm_b23(ec);
+if ec<bc then
+ begin bc:=1; ec:=0;
+ end
+else if ec>255 then bad_font;
+read_tfm_word; tfm_b01(nw);
+if (nw=0)or(nw>256) then bad_font;
+for l:=-2 to lh do
+ begin read_tfm_word;
+ if l=1 then
+ begin tfm_squad(w); check_check_sum(w,true);
+ end
+ else if l=2 then
+ begin if tfm_b0>127 then bad_font;
+ check_design_size(round(tfm_conv*tfm_uquad));
+ end;
+ end
+
+@ The width indices for the characters are stored in positions |n_chars|
+through |n_chars-bc+ec| of the |char_widths| array; if characters on
+either end of the range |bc..ec| do not exist, they are ignored and the
+range is adjusted accordingly.
+
+@<TFM: Store character-width indices@>=
+read_tfm_word;
+while (tfm_b0=0)and(bc<=ec) do
+ begin incr(bc); read_tfm_word;
+ end;
+font_bc(cur_fnt):=bc; font_chars(cur_fnt):=n_chars-bc;
+if ec>=max_chars-font_chars(cur_fnt) then overflow(str_chars,max_chars);
+for l:=bc to ec do
+ begin char_widths[n_chars]:=tfm_b0; incr(n_chars); read_tfm_word;
+ end;
+while (char_widths[n_chars-1]=0)and(ec>=bc) do
+ begin decr(n_chars); decr(ec);
+ end;
+font_ec(cur_fnt):=ec
+
+@ The most important part of |load_font| is the width computation, which
+involves multiplying the relative widths in the \.{TFM} file by the
+scaling factor in the \.{DVI} file. A similar computation is used for
+dimensions read from \.{VF} files. This fixed-point multiplication must
+be done with precisely the same accuracy by all \.{DVI}-reading programs,
+in order to validate the assumptions made by \.{DVI}-writing programs
+like \TeX82.
+
+Let us therefore summarize what needs to be done. Each width in a \.{TFM}
+file appears as a four-byte quantity called a |fix_word|. A |fix_word|
+whose respective bytes are $(a,b,c,d)$ represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+(No other choices of $a$ are allowed, since the magnitude of a \.{TFM}
+dimension must be less than 16.) We want to multiply this quantity by the
+integer~|z|, which is known to be less than $2^{27}$.
+If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$,
+$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or
+16, to obtain a multiplier less than $2^{23}$, and we can compensate for
+this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let
+$\beta=2^{4-e}$; we shall compute
+$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$,
+or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
+This calculation must be done exactly, for the reasons stated above; the
+following program does the job in a system-independent way, assuming
+that arithmetic is exact on numbers less than $2^{31}$ in magnitude. We
+use \.{WEB} macros for various versions of this computation.
+@^system dependencies@>
+@^optimization@>
+
+@d tfm_fix3u== {convert |tfm_b1..tfm_b3| to an unsigned scaled dimension}
+(((((tfm_b3*z)div@'400)+(tfm_b2*z))div@'400)+(tfm_b1*z))div beta
+@#
+@d tfm_fix4(#)== {convert |tfm_b0..tfm_b3| to a scaled dimension}
+ #:=tfm_fix3u;
+ if tfm_b0>0 then if tfm_b0=255 then Decr(#)(alpha) else bad_font
+@d tfm_fix3(#)== {convert |tfm_b1..tfm_b3| to a scaled dimension}
+ #:=tfm_fix3u; @+ if tfm_b1>127 then Decr(#)(alpha)
+@d tfm_fix2== {convert |tfm_b2..tfm_b3| to a scaled dimension}
+ if tfm_b2>127 then tfm_b1:=255 else tfm_b1:=0;
+ tfm_fix3
+@d tfm_fix1== {convert |tfm_b3| to a scaled dimension}
+ if tfm_b3>127 then tfm_b1:=255 else tfm_b1:=0;
+ tfm_b2:=tfm_b1; tfm_fix3
+
+@<Variables for scaling computation@>=
+@!z:int_32; {multiplier}
+@!alpha:int_32; {correction for negative values}
+@!beta:int_15; {divisor}
+
+@ @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>=
+alpha:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; alpha:=alpha+alpha;
+ end;
+beta:=256 div alpha; alpha:=alpha*z
+
+@ The first width value, which indicates that a character does not exist
+and which must vanish, is converted to |invalid_width|; the other width
+values are scaled by |font_scaled(cur_fnt)| and converted to width
+pointers by |make_width|. The resulting width pointers are stored
+temporarily in the |char_widths| array, following the with indices.
+
+@<TFM: Read and convert the width values@>=
+if nw-1>max_chars-n_chars then overflow(str_chars,max_chars);
+if (tfm_b0<>0)or(tfm_b1<>0)or(tfm_b2<>0)or(tfm_b3<>0) then bad_font
+ else char_widths[n_chars]:=invalid_width;
+z:=font_scaled(cur_fnt);
+@<Replace |z|...@>;
+for p:=n_chars+1 to n_chars+nw-1 do
+ begin read_tfm_word; tfm_fix4(w);
+ char_widths[p]:=make_width(w);
+ end
+
+@ We simply translate the width indices into width pointers. In addition
+we initialize the character packets with the invalid packet.
+
+@<TFM: Convert character-width indices to character-width pointers@>=
+for p:=font_chars(cur_fnt)+bc to n_chars-1 do
+ begin q:=char_widths[n_chars+char_widths[p]]; char_widths[p]:=q;
+ char_packets[p]:=invalid_packet;
+ end
+
+@ When processing a font definition we put the data extracted from the
+\.{DVI} or \.{VF} file into position |nf| of the font data arrays and
+call |define_font| to obtain the internal font number for this font.
+The parameter |load| is true if the \.{TFM} file should be loaded.
+
+@p function define_font(@!load:boolean):font_number;
+var save_fnt:font_number; {used to save |cur_fnt|}
+begin save_fnt:=cur_fnt; {save}
+cur_fnt:=0;
+while (font_name(cur_fnt)<>font_name(nf))or@|
+ (font_scaled(cur_fnt)<>font_scaled(nf)) do incr(cur_fnt);
+d_print(' => ',cur_fnt:1); print_font(cur_fnt);
+if cur_fnt<nf then
+ begin check_check_sum(font_check(nf),true);
+ check_design_size(font_design(nf));
+ @!debug if font_type(cur_fnt)=defined_font then print(' defined')
+ else print(' loaded');
+ print(' previously');
+ gubed@;
+ end
+else begin if nf=max_fonts then overflow(str_fonts,max_fonts);
+ incr(nf); font_font(cur_fnt):=invalid_font;
+ font_type(cur_fnt):=defined_font;
+ d_print(' defined');
+ end;
+print_ln('.');
+if load and(font_type(cur_fnt)=defined_font) then load_font;
+define_font:=cur_fnt;
+cur_fnt:=save_fnt; {restore}
+end;
+
+@* Low-level DVI input routines.
+The program uses the binary file variable |dvi_file| for its main input
+file; |dvi_loc| is the number of the byte about to be read next from
+|dvi_file|.
+
+@<Glob...@>=
+@!dvi_file:byte_file; {the stuff we are \.{\title}ing}
+@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
+
+@ If the \.{DVI} file is badly malformed, we say |bad_dvi|; this
+procedure gives an error message which refers the user to \.{DVItype},
+and terminates \.{\title}.
+
+@<Error handling...@>=
+procedure bad_dvi;
+begin new_line; print_ln('Bad DVI file: loc=',dvi_loc:1,'!');
+@.Bad DVI file@>
+print(' Use DVItype with output level');
+@.Use DVItype@>
+if random_reading then print('=4') @+ else print('<4');
+abort('to diagnose the problem');
+end;
+
+@ To prepare |dvi_file| for input, we |reset| it.
+
+@<Open input file(s)@>=
+reset(dvi_file); {prepares to read packed bytes from |dvi_file|}
+dvi_loc:=0;
+
+@ Reading the \.{DVI} file should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes from |dvi_file| is read into a buffer and will then be extracted
+from that buffer. In order to simplify such system dependent changes
+we use a pair of \.{WEB} macros: |dvi_byte| extracts the next \.{DVI}
+byte and |dvi_eof| is |true| if we have reached the end of the \.{DVI}
+file. Here we give simple minded definitions for these macros in terms
+of standard \PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d dvi_eof == eof(dvi_file) {has the \.{DVI} file been exhausted?}
+@d dvi_byte(#) ==
+ if dvi_eof then bad_dvi
+ else read(dvi_file,#) {obtain next \.{DVI} byte}
+
+@ Next we come to the routines that are used only if |random_reading| is
+|true|. The driver program below needs two such routines: |dvi_length| should
+compute the total number of bytes in |dvi_file|, possibly also
+causing |eof(dvi_file)| to be true; and |dvi_move(n)| should position
+|dvi_file| so that the next |dvi_byte| will read byte |n|, starting with
+|n=0| for the first byte in the file.
+@^system dependencies@>
+
+Such routines are, of course, highly system dependent. They are implemented
+here in terms of two assumed system routines called |set_pos| and |cur_pos|.
+The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
+negative or larger than the total number of items in |f|; in the latter
+case, |set_pos(f,n)| moves to the end of file |f|.
+The call |cur_pos(f)| gives the total number of items in |f|, if
+|eof(f)| is true; we use |cur_pos| only in such a situation.
+
+@p function dvi_length:int_32;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure dvi_move(@!n:int_32);
+begin set_pos(dvi_file,n); dvi_loc:=n;
+end;
+
+@ We need seven simple functions to read the next byte or bytes
+from |dvi_file|.
+
+@p function dvi_sbyte:int_8; {returns the next byte, signed}
+@!begin_byte(dvi_byte); incr(dvi_loc); comp_sbyte(dvi_sbyte);
+end;
+@#
+function dvi_ubyte:int_8u; {returns the next byte, unsigned}
+@!begin_byte(dvi_byte); incr(dvi_loc); comp_ubyte(dvi_ubyte);
+end;
+@#
+function dvi_spair:int_16; {returns the next two bytes, signed}
+@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_spair(dvi_spair);
+end;
+@#
+function dvi_upair:int_16u; {returns the next two bytes, unsigned}
+@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_upair(dvi_upair);
+end;
+@#
+function dvi_strio:int_24; {returns the next three bytes, signed}
+@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_strio(dvi_strio);
+end;
+@#
+function dvi_utrio:int_24u; {returns the next three bytes, unsigned}
+@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_utrio(dvi_utrio);
+end;
+@#
+function dvi_squad:int_32; {returns the next four bytes, signed}
+@!begin_quad(dvi_byte); Incr(dvi_loc)(4); comp_squad(dvi_squad);
+end;
+
+@ Three other functions are used in cases where a four byte integer
+(which is always signed) must have a non-negative value, a positive
+value, or is a pointer which must be either positive or |=-1|.
+
+@p function dvi_uquad:int_31; {result must be non-negative}
+var x:int_32;
+begin x:=dvi_squad; if x<0 then bad_dvi
+else dvi_uquad:=x;
+end;
+@#
+function dvi_pquad:int_31; {result must be positive}
+var x:int_32;
+begin x:=dvi_squad; if x<=0 then bad_dvi
+else dvi_pquad:=x;
+end;
+@#
+function dvi_pointer:int_32; {result must be positive or |=-1|}
+var x:int_32;
+begin x:=dvi_squad; if (x<=0)and(x<>-1) then bad_dvi
+else dvi_pointer:=x;
+end;
+
+@ Given the structure of the \.{DVI} commands it is fairly obvious
+that their interpretation consists of two steps: First zero to four
+bytes are read in order to obtain the value of the first parameter
+(e.g., zero bytes for |set_char_0|, four bytes for |set4|); then,
+depending on the command class, a specific action is performed (e.g.,
+typeset a character but don't move the reference point for |put1..put4|).
+
+The \.{DVItype} program uses large case statements for both steps;
+unfortunately some \PASCAL\ compilers fail to implement large case
+statements efficiently -- in particular those as the one used in the
+|first_par| function of \.{DVItype}. Here we use a pair of look up tables:
+|dvi_par| determines how to obtain the value of the first parameter, and
+|dvi_cl| determines the command class.
+
+A slight complication arises from the fact that we want to decompose the
+character code of each character to be typset into a residue
+|0<=char_res<256| and extension: |char_code=char_res+256*char_ext|;
+the \.{TFM} widths as well as the pixel widths for a given resolution
+are the same for all characters in a font with the same residue.
+
+@d two_cases(#)==#,#+1
+@d three_cases(#)==#,#+1,#+2
+@d five_cases(#)==#,#+1,#+2,#+3,#+4
+
+@ First we define the values used as array elements of |dvi_par|; we
+distinguish between pure numbers and dimensions because dimensions read
+from a \.{VF} file must be scaled.
+
+@d char_par=0 {character for \\{set} and |put|}
+@d no_par=1 {no parameter}
+@d dim1_par=2 {one-byte signed dimension}
+@d num1_par=3 {one-byte unsigned number}
+@d dim2_par=4 {two-byte signed dimension}
+@d num2_par=5 {two-byte unsigned number}
+@d dim3_par=6 {three-byte signed dimension}
+@d num3_par=7 {three-byte unsigned number}
+@d dim4_par=8 {four-byte signed dimension}
+@d num4_par=9 {four-byte signed number}
+@d numu_par=10 {four-byte non-negative number}
+@d rule_par=11 {dimensions for |set_rule| and |put_rule|}
+@d fnt_par=12 {font for |fnt_num| commands}
+@d max_par=12 {largest possible value}
+
+@<Types...@>=
+@!cmd_par=char_par..max_par;
+
+@ Here we declare the array |dvi_par|.
+
+@<Globals...@>=
+@!dvi_par:packed array [eight_bits] of cmd_par;
+
+@ And here we initialize it.
+
+@<Set init...@>=
+for i:=0 to put1+3 do dvi_par[i]:=char_par;@/
+for i:=nop to 255 do dvi_par[i]:=no_par;@/
+dvi_par[set_rule]:=rule_par; dvi_par[put_rule]:=rule_par;@/
+dvi_par[right1]:=dim1_par; dvi_par[right1+1]:=dim2_par;
+dvi_par[right1+2]:=dim3_par; dvi_par[right1+3]:=dim4_par;@/
+for i:=fnt_num_0 to fnt_num_0+63 do dvi_par[i]:=fnt_par;@/
+dvi_par[fnt1]:=num1_par; dvi_par[fnt1+1]:=num2_par;
+dvi_par[fnt1+2]:=num3_par; dvi_par[fnt1+3]:=num4_par;@/
+dvi_par[xxx1]:=num1_par; dvi_par[xxx1+1]:=num2_par;
+dvi_par[xxx1+2]:=num3_par; dvi_par[xxx1+3]:=numu_par;@/
+for i:=0 to 3 do
+ begin dvi_par[i+w1]:=dvi_par[i+right1];
+ dvi_par[i+x1]:=dvi_par[i+right1];
+ dvi_par[i+down1]:=dvi_par[i+right1];
+ dvi_par[i+y1]:=dvi_par[i+right1];
+ dvi_par[i+z1]:=dvi_par[i+right1];
+ dvi_par[i+fnt_def1]:=dvi_par[i+fnt1];
+ end;
+
+@ Next we define the values used as array elements of |dvi_cl|;
+several \.{DVI} commands (e.g., |nop|, |bop|, |eop|, |pre|, |post|) will
+always be treated separately and are therfore assigned to the invalid
+class here.
+
+@d char_cl=0
+@d rule_cl=char_cl+1
+@d xxx_cl=char_cl+2
+@d push_cl=3
+@d pop_cl=4
+@d w0_cl=5
+@d x0_cl=w0_cl+1
+@d right_cl=w0_cl+2
+@d w_cl=w0_cl+3
+@d x_cl=w0_cl+4
+@d y0_cl=10
+@d z0_cl=y0_cl+1
+@d down_cl=y0_cl+2
+@d y_cl=y0_cl+3
+@d z_cl=y0_cl+4
+@d fnt_cl=15
+@d fnt_def_cl=16
+@d invalid_cl=17
+@d max_cl=invalid_cl {largest possible value}
+
+@<Types...@>=
+@!cmd_cl=char_cl..max_cl;
+
+@ Here we declare the array |dvi_cl|.
+
+@<Globals...@>=
+@!dvi_cl:packed array [eight_bits] of cmd_cl;
+
+@ And here we initialize it.
+
+@<Set init...@>=
+for i:=set_char_0 to put1+3 do dvi_cl[i]:=char_cl;
+dvi_cl[set_rule]:=rule_cl; dvi_cl[put_rule]:=rule_cl;@/
+dvi_cl[nop]:=invalid_cl;
+dvi_cl[bop]:=invalid_cl; dvi_cl[eop]:=invalid_cl;@/
+dvi_cl[push]:=push_cl; dvi_cl[pop]:=pop_cl;@/
+dvi_cl[w0]:=w0_cl; dvi_cl[x0]:=x0_cl;@/
+dvi_cl[y0]:=y0_cl; dvi_cl[z0]:=z0_cl;@/
+for i:=0 to 3 do
+ begin dvi_cl[i+right1]:=right_cl;
+ dvi_cl[i+w1]:=w_cl;
+ dvi_cl[i+x1]:=x_cl;@/
+ dvi_cl[i+down1]:=down_cl;
+ dvi_cl[i+y1]:=y_cl;
+ dvi_cl[i+z1]:=z_cl;@/
+ dvi_cl[i+xxx1]:=xxx_cl;
+ dvi_cl[i+fnt_def1]:=fnt_def_cl;
+ end;
+for i:=fnt_num_0 to fnt1+3 do dvi_cl[i]:=fnt_cl;
+for i:=pre to 255 do dvi_cl[i]:=invalid_cl;
+
+@ A few small arrays are used to generate \.{DVI} commands.
+
+@<Glob...@>=
+@!dvi_char_cmd:array[boolean] of eight_bits; {|put1| and |set1|}
+@!dvi_rule_cmd:array[boolean] of eight_bits; {|put_rule| and |set_rule|}
+@!dvi_right_cmd:array[right_cl..x_cl] of eight_bits; {|right1|, |w1|, and |x1|}
+@!dvi_down_cmd:array[down_cl..z_cl] of eight_bits; {|down1|, |y1|, and |z1|}
+
+@ @<Set init...@>=
+dvi_char_cmd[false]:=put1;
+dvi_char_cmd[true]:=set1;@/
+dvi_rule_cmd[false]:=put_rule;
+dvi_rule_cmd[true]:=set_rule;@/
+dvi_right_cmd[right_cl]:=right1;
+dvi_right_cmd[w_cl]:=w1;
+dvi_right_cmd[x_cl]:=x1;@/
+dvi_down_cmd[down_cl]:=down1;
+dvi_down_cmd[y_cl]:=y1;
+dvi_down_cmd[z_cl]:=z1;
+
+@ The global variables |cur_cmd|, |cur_parm| and |cur_class| are used
+for the current \.{DVI} command, its first parameter (if any), and its
+command class respectively.
+
+@<Glob...@>=
+@!cur_cmd:eight_bits; {current \.{DVI} command byte}
+@!cur_parm:int_32; {its first parameter (if any)}
+@!cur_class:cmd_cl; {its class}
+
+@ When typesetting a character or rule, the boolean variable |cur_upd|
+is |true| for \\{set} commands, |false| for |put| commands.
+
+@<Glob...@>=
+@!cur_cp:char_pointer; {|char_widths| index for the current character}
+@!cur_wp:width_pointer; {width pointer of the current character}
+@!cur_upd:boolean; {is this a \\{set} or |set_rule| command ?}
+@!cur_v_dimen:int_32; {a vertical dimension}
+@!cur_h_dimen:int_32; {a horizontal dimension}
+
+@ @<Set init...@>=
+cur_cp:=0; cur_wp:=invalid_width; {so they can be saved and restored!}
+
+@ The |dvi_first_par| procedure first reads \.{DVI} command bytes into
+|cur_cmd| until |cur_cmd<>nop|; then |cur_parm| is set to the value of
+the first parameter (if any) and |cur_class| to the command class.
+
+@d set_cur_char(#)== {set up |cur_res|, |cur_ext|, and |cur_upd|}
+begin cur_ext:=0;
+if cur_cmd<set1 then
+ begin cur_res:=cur_cmd; cur_upd:=true
+ end
+else begin cur_res:=#; cur_upd:=(cur_cmd<put1);
+ Decr(cur_cmd)(dvi_char_cmd[cur_upd]);
+ while cur_cmd>0 do
+ begin if cur_cmd=3 then if cur_res>127 then cur_ext:=-1;
+ cur_ext:=cur_ext*256+cur_res; cur_res:=#; decr(cur_cmd);
+ end;
+ end;
+end
+
+@p procedure dvi_first_par;
+begin repeat cur_cmd:=dvi_ubyte;
+until cur_cmd<>nop; {skip over |nop|s}
+case dvi_par[cur_cmd] of
+char_par: set_cur_char(dvi_ubyte);
+no_par: do_nothing;
+dim1_par: cur_parm:=dvi_sbyte;
+num1_par: cur_parm:=dvi_ubyte;
+dim2_par: cur_parm:=dvi_spair;
+num2_par: cur_parm:=dvi_upair;
+dim3_par: cur_parm:=dvi_strio;
+num3_par: cur_parm:=dvi_utrio;
+two_cases(dim4_par): cur_parm:=dvi_squad; {|dim4_par| and |num4_par|}
+numu_par: cur_parm:=dvi_uquad;
+rule_par:
+ begin cur_v_dimen:=dvi_squad; cur_h_dimen:=dvi_squad;
+ cur_upd:=(cur_cmd=set_rule);
+ end;
+fnt_par:cur_parm:=cur_cmd-fnt_num_0;
+end; {there are no other cases}
+cur_class:=dvi_cl[cur_cmd];
+end;
+
+@ The global variable |dvi_nf| is used for the number of different
+\.{DVI} fonts defined so far; their external font numbers (as extracted
+from the \.{DVI} file) are stored in the array |dvi_e_fnts|, the
+corresponding internal font numbers used internally by \.{\title} are
+stored in the array |dvi_i_fnts|.
+
+@<Glob...@>=
+@!dvi_e_fnts:array[font_number] of int_32; {external font numbers}
+@!dvi_i_fnts:array[font_number] of font_number; {corresponding
+ internal font numbers}
+@!dvi_nf:font_number; {number of \.{DVI} fonts defined so far}
+
+@ @<Set ini...@>=
+dvi_nf:=0;
+
+@ The |dvi_font| procedure sets |cur_fnt| to the internal font number
+corresponding to the external font number |cur_parm| (or aborts the
+program if such a font was never defined).
+
+@p procedure dvi_font; {computes |cur_fnt| corresponding to |cur_parm|}
+var f:font_number; {where the font is sought}
+begin @<DVI: Locate font |cur_parm|@>;
+if f=dvi_nf then bad_dvi;
+cur_fnt:=dvi_i_fnts[f];
+if font_type(cur_fnt)=defined_font then load_font;
+end;
+
+@ @<DVI: Locate font |cur_parm|@>=
+f:=0; dvi_e_fnts[dvi_nf]:=cur_parm;
+while cur_parm<>dvi_e_fnts[f] do incr(f)
+
+@ Finally the |dvi_do_font| procedure is called when one of the command
+|fnt_def1..fnt_def4| and its first parameter have been read from the
+\.{DVI} file; the argument indicates whether this should be the second
+definition of the font (|true|) or not (|false|).
+
+@p procedure dvi_do_font(@!second:boolean);
+var f:font_number; {where the font is sought}
+@!k:int_15; {general purpose variable}
+begin print('DVI: font ',cur_parm:1);
+@<DVI: Locate font |cur_parm|@>;
+if (f=dvi_nf)=second then bad_dvi;
+font_check(nf):=dvi_squad;
+font_scaled(nf):=dvi_pquad;
+font_design(nf):=dvi_pquad;
+k:=dvi_ubyte; pckt_room(1); append_byte(k);
+Incr(k)(dvi_ubyte); pckt_room(k);
+while k>0 do begin append_byte(dvi_ubyte); decr(k);
+ end;
+font_name(nf):=make_packet; {the font area plus name}
+dvi_i_fnts[dvi_nf]:=define_font(false);
+if not second then
+ begin if dvi_nf=max_fonts then overflow(str_fonts,max_fonts);
+ incr(dvi_nf);
+ end
+else if dvi_i_fnts[f]<>dvi_i_fnts[dvi_nf] then bad_dvi;
+end;
+
+@* Low-level VF input routines.
+A detailed description of the \.{VF} file format can be found in the
+documentation of \.{VFtoVP}; here we just define symbolic names for
+some of the \.{VF} command bytes.
+
+@d long_char=242 {\.{VF} command for general character packet}
+@#
+@d vf_id=202 {identifies \.{VF} files}
+
+@ The program uses the binary file variable |vf_file| for input from
+\.{VF} files; |vf_loc| is the number of the byte about to be read next
+from |vf_file|.
+
+@<Glob...@>=
+@!vf_file:byte_file; {a \.{VF} file}
+@!vf_loc:int_32; {where we are about to look, in |vf_file|}
+@!vf_limit:int_32; {value of |vf_loc| at end of a character packet}
+@!vf_ext:pckt_pointer; {extension for \.{VF} files}
+@!vf_cur_fnt:font_number; {current font number in a \.{VF} file}
+
+@ @<Initialize predefined strings@>=
+id3(".")("V")("F")(vf_ext); {file name extension for \.{VF} files}
+
+@ If a \.{VF} file is badly malformed, we say |bad_font|; this procedure
+gives an error message which refers the user to \.{VFtoVP} and \.{VPtoVF},
+and terminates \.{\title}.
+
+@<Cases for |bad_font|@>=
+vf_font_type: begin print('Bad VF file'); print_font(cur_fnt);
+@.Bad VF file@>
+ print_ln(' loc=',vf_loc:1);
+ abort('Use VFtoVP/VPtoVF to diagnose and correct the problem');
+@.Use VFtoVP/VPtoVF@>
+ end;
+
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{VF} directory, which is a system-dependent place where
+the \.{VF} files for standard fonts are kept.
+The string variable |VF_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d VF_default_area_name=='TeXvfonts:' {change this to the correct name}
+@d VF_default_area_name_length=10 {change this to the correct length}
+
+@<Glob...@>=
+@!VF_default_area:packed array[1..VF_default_area_name_length] of char;
+
+@ @<Set init...@>=
+VF_default_area:=VF_default_area_name;
+
+@ To prepare |vf_file| for input we |reset| it.
+
+@<VF: Open |vf_file| or |goto not_found|@>=
+make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
+reset(vf_file,cur_name);
+if eof(vf_file) then
+@^system dependencies@>
+ goto not_found;
+vf_loc:=0
+
+@ Reading a \.{VF} file should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes from |vf_file| is read into a buffer and will then be extracted
+from that buffer. In order to simplify such system dependent changes
+we use a pair of \.{WEB} macros: |vf_byte| extracts the next \.{VF}
+byte and |vf_eof| is |true| if we have reached the end of the \.{VF}
+file. Here we give simple minded definitions for these macros in terms
+of standard \PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d vf_eof == eof(vf_file) {has the \.{VF} file been exhausted?}
+@d vf_byte(#) ==
+ if vf_eof then bad_font
+ else read(vf_file,#) {obtain next \.{VF} byte}
+
+@ We need several simple functions to read the next byte or bytes
+from |vf_file|.
+
+@p function vf_ubyte:int_8u; {returns the next byte, unsigned}
+@!begin_byte(vf_byte); incr(vf_loc); comp_ubyte(vf_ubyte);
+end;
+@#
+function vf_upair:int_16u; {returns the next two bytes, unsigned}
+@!begin_pair(vf_byte); Incr(vf_loc)(2); comp_upair(vf_upair);
+end;
+@#
+function vf_strio:int_24; {returns the next three bytes, signed}
+@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_strio(vf_strio);
+end;
+@#
+function vf_utrio:int_24u; {returns the next three bytes, unsigned}
+@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_utrio(vf_utrio);
+end;
+@#
+function vf_squad:int_32; {returns the next four bytes, signed}
+@!begin_quad(vf_byte); Incr(vf_loc)(4); comp_squad(vf_squad);
+end;
+
+@ All dimensions in a \.{VF} file, except the design sizes of a virtual
+font and its local fonts, are |fix_word|s that must be scaled in exactly
+the same way as the character widths from a \.{TFM} file; we can use the
+same code, but this time |z|, |alpha|, and |beta| are global variables.
+
+@<Glob...@>=
+@<Variables for scaling computation@>@;
+
+@ We need five functions to read the next byte or bytes and convert a
+|fix_word| to a scaled dimension.
+
+@p function vf_fix1:int_32; {returns the next byte as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b3); incr(vf_loc);
+tfm_fix1(x); vf_fix1:=x;
+end;
+@#
+function vf_fix2:int_32; {returns the next two bytes as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b2); vf_byte(tfm_b3); Incr(vf_loc)(2);
+tfm_fix2(x); vf_fix2:=x;
+end;
+@#
+function vf_fix3:int_32; {returns the next three bytes as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(3);@/
+tfm_fix3(x); vf_fix3:=x;
+end;
+@#
+function vf_fix3u:int_32; {returns the next three bytes as scaled value}
+begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(3);@/
+vf_fix3u:=tfm_fix3u;
+end;
+@#
+function vf_fix4:int_32; {returns the next four bytes as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(4);@/
+tfm_fix4(x); vf_fix4:=x;
+end;
+
+@ Three other functions are used in cases where the result must have a
+non-negative value or a positive value.
+
+@p function vf_uquad:int_31; {result must be non-negative}
+var x:int_32;
+begin x:=vf_squad; if x<0 then bad_font @+ else vf_uquad:=x;
+end;
+@#
+function vf_pquad:int_31; {result must be positive}
+var x:int_32;
+begin x:=vf_squad; if x<=0 then bad_font @+ else vf_pquad:=x;
+end;
+@#
+function vf_fixp:int_31; {result must be positive}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(4);@/
+if tfm_b0>0 then bad_font;
+vf_fixp:=tfm_fix3u;
+end;
+
+@ The |vf_first_par| procedure first reads a \.{VF} command byte into
+|cur_cmd|; then |cur_parm| is set to the value of the first parameter
+(if any) and |cur_class| to the command class.
+
+@d set_cur_wp_end(#)== if cur_wp=invalid_width then #
+@d set_cur_wp(#)== {set |cur_wp| to the char's width pointer}
+cur_wp:=invalid_width;
+if #<>invalid_font then
+ if (cur_res>=font_bc(#))and(cur_res<=font_ec(#)) then
+ begin cur_cp:=font_chars(#)+cur_res; cur_wp:=char_widths[cur_cp];
+ end;
+set_cur_wp_end
+
+@p procedure vf_first_par;
+begin cur_cmd:=vf_ubyte;
+case dvi_par[cur_cmd] of
+char_par:
+ begin set_cur_char(vf_ubyte); set_cur_wp(vf_cur_fnt)(bad_font);
+ end;
+no_par: do_nothing;
+dim1_par: cur_parm:=vf_fix1;
+num1_par: cur_parm:=vf_ubyte;
+dim2_par: cur_parm:=vf_fix2;
+num2_par: cur_parm:=vf_upair;
+dim3_par: cur_parm:=vf_fix3;
+num3_par: cur_parm:=vf_utrio;
+dim4_par: cur_parm:=vf_fix4;
+num4_par: cur_parm:=vf_squad;
+numu_par: cur_parm:=vf_uquad;
+rule_par:
+ begin cur_v_dimen:=vf_fix4; cur_h_dimen:=vf_fix4;
+ cur_upd:=(cur_cmd=set_rule);
+ end;
+fnt_par:cur_parm:=cur_cmd-fnt_num_0;
+end; {there are no other cases}
+cur_class:=dvi_cl[cur_cmd];
+end;
+
+@ For a virtual font we set |font_type(f):=vf_font_type|; in this case
+|font_font(f)| is the default font for character packets from virtual
+font~|f|.
+@^font types@>
+
+The global variable |vf_nf| is used for the number of different local
+fonts defined in a \.{VF} file so far; their external font numbers (as
+extracted from the \.{VF} file) are stored in the array |vf_e_fnts|, the
+corresponding internal font numbers used internally by \.{\title} are
+stored in the array |vf_i_fnts|.
+
+@<Glob...@>=
+@!vf_e_fnts:array[font_number] of int_32; {external font numbers}
+@!vf_i_fnts:array[font_number] of font_number; {corresponding
+ internal font numbers}
+@!vf_nf:font_number; {number of local fonts defined so far}
+@!lcl_nf:font_number; {largest |vf_nf| value for any \.{VF} file}
+
+@ @<Set init...@>=
+lcl_nf:=0;
+
+@ The |vf_font| procedure sets |vf_cur_fnt| to the internal font number
+corresponding to the external font number |cur_parm| (or aborts the
+program if such a font was never defined).
+
+@p procedure vf_font; {computes |vf_cur_fnt| corresponding to |cur_parm|}
+var f:font_number; {where the font is sought}
+begin @<VF: Locate font |cur_parm|@>;
+if f=vf_nf then bad_font;
+vf_cur_fnt:=vf_i_fnts[f];
+end;
+
+@ @<VF: Locate font |cur_parm|@>=
+f:=0; vf_e_fnts[vf_nf]:=cur_parm;
+while cur_parm<>vf_e_fnts[f] do incr(f)
+
+@ Finally the |vf_do_font| procedure is called when one of the command
+|fnt_def1..fnt_def4| and its first parameter have been read from the
+\.{VF} file.
+
+@p procedure vf_do_font;
+var f:font_number; {where the font is sought}
+@!k:int_15; {general purpose variable}
+begin print('VF: font ',cur_parm:1);@/
+@<VF: Locate font |cur_parm|@>;
+if f<>vf_nf then bad_font;
+font_check(nf):=vf_squad;
+font_scaled(nf):=vf_fixp;
+font_design(nf):=round(tfm_conv*vf_pquad);
+k:=vf_ubyte; pckt_room(1); append_byte(k);
+Incr(k)(vf_ubyte); pckt_room(k);
+while k>0 do begin append_byte(vf_ubyte); decr(k);
+ end;
+font_name(nf):=make_packet; {the font area plus name}
+vf_i_fnts[vf_nf]:=define_font(true);
+if vf_nf=lcl_nf then
+ if lcl_nf=max_fonts then overflow(str_fonts,max_fonts)
+ else incr(lcl_nf);
+incr(vf_nf);
+end;
+
+@* Reading VF files.
+The |do_vf| function attempts to read the \.{VF} file for a font and
+returns |false| if the \.{VF} file could not be found; otherwise the
+font type is changed to |vf_font_type|.
+
+@p function do_vf:boolean; {read a \.{VF} file}
+label reswitch,done,not_found,exit;
+var temp_int:int_32; {integer for temporary variables}
+@!temp_byte:int_8u; {byte for temporary variables}
+@!k:byte_pointer; {index into |byte_mem|}
+@!l:int_15; {general purpose variable}
+@!save_ext:int_24; {used to save |cur_ext|}
+@!save_res:int_8u; {used to save |cur_res|}
+@!save_cp:width_pointer; {used to save |cur_cp|}
+@!save_wp:width_pointer; {used to save |cur_wp|}
+@!save_upd:boolean; {used to save |cur_upd|}
+@!vf_wp:width_pointer; {width pointer for the current character packet}
+@!vf_fnt:font_number; {current font in the current character packet}
+@!move_zero:boolean; {|true| if rule 1 is used}
+@!last_pop:boolean; {|true| if final |pop| has been manufactured}
+begin @<VF: Open |vf_file| or |goto not_found|@>;
+save_ext:=cur_ext; save_res:=cur_res; save_cp:=cur_cp; save_wp:=cur_wp;
+save_upd:=cur_upd; {save}
+font_type(cur_fnt):=vf_font_type;@/
+@<VF: Process the preamble@>;@/
+@<VF: Process the font definitions@>;@/
+while cur_cmd<=long_char do @<VF: Build a character packet@>;
+if cur_cmd<>post then bad_font;
+@!debug print('VF file for font ',cur_fnt:1); print_font(cur_fnt);
+print_ln(' loaded.');
+gubed @;@/
+close_in(vf_file);
+cur_ext:=save_ext; cur_res:=save_res; cur_cp:=save_cp; cur_wp:=save_wp;
+cur_upd:=save_upd; {restore}
+do_vf:=true; return;
+not_found:do_vf:=false;
+exit:end;
+
+@ @<VF: Process the preamble@>=
+if vf_ubyte<>pre then bad_font;
+if vf_ubyte<>vf_id then bad_font;
+temp_byte:=vf_ubyte; pckt_room(temp_byte);
+for l:=1 to temp_byte do append_byte(vf_ubyte);
+print('VF file: '''); print_packet(new_packet); print(''',');
+flush_packet;@/
+check_check_sum(vf_squad,false);
+check_design_size(round(tfm_conv*vf_pquad));@/
+z:=font_scaled(cur_fnt);
+@<Replace |z|...@>;@/
+print_nl(' for font ',cur_fnt:1); print_font(cur_fnt); print_ln('.')
+
+@ @<VF: Process the font definitions@>=
+vf_i_fnts[0]:=invalid_font; vf_nf:=0;@/
+cur_cmd:=vf_ubyte;
+while (cur_cmd>=fnt_def1)and(cur_cmd<=fnt_def1+3) do
+ begin case cur_cmd-fnt_def1 of
+ 0: cur_parm:=vf_ubyte;
+ 1: cur_parm:=vf_upair;
+ 2: cur_parm:=vf_utrio;
+ 3: cur_parm:=vf_squad;
+ end; {there are no other cases}
+ vf_do_font;
+ cur_cmd:=vf_ubyte;
+ end;
+font_font(cur_fnt):=vf_i_fnts[0]
+
+@ The \.{VF} format specifies that the interpretation of each packet
+begins with |w=x=y=z=0|; any |w0|, |x0|, |y0|, or |z0| command using
+these initial values will be ignored.
+
+@<Types...@>=
+@!vf_state=array[0..1,0..1] of boolean; {state of |w|, |x|, |y|, and |z|}
+
+@ As implied by the \.{VF} format the \.{DVI} commands read from the
+\.{VF} file are enclosed by |push| and |pop|; as we read \.{DVI}
+commands and append them to |byte_mem|, we perform a set of
+transformations in order to simplify the resulting packet: Let |zero| be
+any of the commands |put|, |put_rule|, |fnt_num|, |fnt|, or |xxx| which
+all leave the current position on the page unchanged, let |move| be any
+of the horizontal or vertical movement commands |right1..z4|, and let
+|any| be any sequence of commands containing |push| and |pop| in
+properly nested pairs; whenever possible we apply one of the following
+transformation rules: $$\def\n#1:{\hbox to 3cm{\hfil#1:}}
+\leqalignno{
+\hbox{|push| |zero|}&\RA\hbox{|zero| |push|}&\n1:\cr
+\hbox{|move| |pop|}&\RA\hbox{|pop|}&\n2:\cr
+\hbox{|push| |pop|}&\RA{}&\n3:\cr
+\hbox{|push| |set_char| |pop|}&\RA\hbox{|put|}&\n4a:\cr
+\hbox{|push| \\{set} |pop|}&\RA\hbox{|put|}&\n4b:\cr
+\hbox{|push| |set_rule| |pop|}&\RA\hbox{|put_rule|}&\n4c:\cr
+\hbox{|push| |push| |any| |pop|}&\RA\hbox{|push| |any| |pop| |push|}&\n5:\cr
+\hbox{|push| |any| |pop| |pop|}&\RA\hbox{|any| |pop|}&\n6:\cr
+}$$
+
+@ In order to perform these transformations we need a stack which is
+indexed by |vf_ptr|, the number of |push| commands without corresponding
+|pop| in the packet we are building; the |vf_push_loc| array contains
+the locations in |byte_mem| following such |push| commands.
+In view of rule~5 consecutive |push| commands are never stored, the
+|vf_push_num| array is used to count them.
+The |vf_last| array indicates the type of the last non-discardable item:
+a character, a rule, or a group enclosed by |push| and |pop|;
+the |vf_last_end| array points to the ending locations and, if
+|vf_last<>vf_other|, the |vf_last_loc| array points to the starting
+locations of these items.
+
+@d vf_set=0 {|vf_set=char_cl|, last item is a |set_char| or \\{set}}
+@d vf_rule=1 {|vf_rule=rule_cl|, last item is a |set_rule|}
+@d vf_group=2 {last item is a group enclosed by |push| and |pop|}
+@d vf_put=3 {last item is a |put|}
+@d vf_other=4 {last item (if any) is none of the above}
+
+@<Types...@>=
+@!vf_type=vf_set..vf_other;
+
+@ @<Glob...@>=
+@!vf_move: array[stack_pointer] of vf_state; {state of |w|, |x|, |y|, and |z|}
+@!vf_push_loc: array[stack_pointer] of byte_pointer; {end of a |push|}
+@!vf_last_loc: array[stack_pointer] of byte_pointer; {start of an item}
+@!vf_last_end: array[stack_pointer] of byte_pointer; {end of an item}
+@!vf_push_num: array[stack_pointer] of eight_bits; {|push| count}
+@!vf_last: array[stack_pointer] of vf_type; {type of last item}
+@!vf_ptr:stack_pointer; {current number of unfinished groups}
+@!stack_used:stack_pointer; {largest |vf_ptr| or |stack_ptr| value}
+
+@ We use two small arrays to determine the item type of a character or a
+rule.
+
+@<Glob...@>=
+@!vf_char_type:array[boolean] of vf_type;
+@!vf_rule_type:array[boolean] of vf_type;
+
+@ @<Set init...@>=
+vf_move[0][0][0]:=false; vf_move[0][0][1]:=false;
+vf_move[0][1][0]:=false; vf_move[0][1][1]:=false;@/
+stack_used:=0;@/
+vf_char_type[false]:=vf_put; vf_char_type[true]:=vf_set;@/
+vf_rule_type[false]:=vf_other; vf_rule_type[true]:=vf_rule;
+
+@ Here we read the first bytes of a character packet from the \.{VF}
+file and initialize the packet being built in |byte_mem|; the start of
+the whole packet is stored in |vf_push_loc[0]|. When the character
+packet is finished, a type is be assigned to it: |vf_simple| if the
+packet ends with a character of the correct width, or |vf_complex|
+otherwise. Moreover, if such a packet for a character with
+extension zero consists of just one character with extension zero and
+the same residue, and if there is no previous packet, the whole packet
+is replaced by the empty packet.
+
+@d vf_simple=0 {the packet ends with a character of the correct width}
+@d vf_complex=vf_simple+1 {otherwise}
+
+@<VF: Build a character packet@>=
+begin if cur_cmd<long_char then
+ begin vf_limit:=cur_cmd;
+ cur_ext:=0; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix3u);
+ end
+else begin vf_limit:=vf_uquad;
+ cur_ext:=vf_strio; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix4);
+ end;
+Incr(vf_limit)(vf_loc);
+vf_push_loc[0]:=byte_ptr; vf_last_end[0]:=byte_ptr;
+vf_last[0]:=vf_other; vf_ptr:=0;@/
+start_packet(vf_complex);
+@<VF: Append \.{DVI} commands to the character packet@>;@/
+k:=pckt_start[pckt_ptr];
+if vf_last[0]=vf_put then if cur_wp=vf_wp then
+ begin decr(byte_mem[k]); {change |vf_complex| into |vf_simple|}
+ if (byte_mem[k]=bi(0))and@|(vf_push_loc[0]=vf_last_loc[0])and@|
+ (cur_ext=0)and@|(cur_res=pckt_res) then byte_ptr:=k;
+ end;
+build_packet;
+cur_cmd:=vf_ubyte;
+end
+
+@ For every \.{DVI} command read from the \.{VF} file some action is
+performed; in addition the initial |push| and the final |pop| are
+manufactured here.
+
+@<VF: Append \.{DVI} commands to the character packet@>=
+vf_cur_fnt:=font_font(cur_fnt); vf_fnt:=vf_cur_fnt;@/
+last_pop:=false; cur_class:=push_cl; {initial |push|}
+loop begin
+reswitch:case cur_class of
+ three_cases(char_cl): @<VF: Do a |char|, |rule|, or |xxx|@>;
+ push_cl: @<VF: Do a |push|@>;
+ pop_cl: @<VF: Do a |pop|@>;
+ two_cases(w0_cl):
+ if vf_move[vf_ptr][0][cur_class-w0_cl] then append_one(cur_cmd);
+ three_cases(right_cl):
+ begin pckt_signed(dvi_right_cmd[cur_class],cur_parm);
+ if cur_class>=w_cl then vf_move[vf_ptr][0][cur_class-w_cl]:=true;
+ end;
+ two_cases(y0_cl):
+ if vf_move[vf_ptr][1][cur_class-y0_cl] then append_one(cur_cmd);
+ three_cases(down_cl):
+ begin pckt_signed(dvi_down_cmd[cur_class],cur_parm);
+ if cur_class>=y_cl then vf_move[vf_ptr][1][cur_class-y_cl]:=true;
+ end;
+ fnt_cl: vf_font;
+ fnt_def_cl: bad_font;
+ invalid_cl: if cur_cmd<>nop then bad_font;
+ end; {there are no other cases}
+ if vf_loc<vf_limit then vf_first_par
+ else if last_pop then goto done
+ else begin cur_class:=pop_cl; last_pop:=true; {final |pop|}
+ end;
+ end;
+done:if (vf_ptr<>0)or(vf_loc<>vf_limit) then bad_font
+
+@ For a |push| we either increase |vf_push_num| or start a new level and
+append a |push|.
+
+@d incr_stack(#)==
+if #=stack_used then
+ if stack_used=stack_size then overflow(str_stack,stack_size)
+ else incr(stack_used);
+incr(#)
+
+@<VF: Do a |push|@>=
+if (vf_ptr>0)and(vf_push_loc[vf_ptr]=byte_ptr) then
+ begin if vf_push_num[vf_ptr]=255 then overflow(str_stack,255);
+ incr(vf_push_num[vf_ptr]);
+ end
+else begin incr_stack(vf_ptr);
+ @<VF: Start a new level@>;
+ vf_push_num[vf_ptr]:=0;
+ end
+
+@ @<VF: Start a new level@>=
+append_one(push);
+vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+vf_push_loc[vf_ptr]:=byte_ptr;
+vf_last_end[vf_ptr]:=byte_ptr;
+vf_last[vf_ptr]:=vf_other
+
+@ When a character, a rule, or an |xxx| is appended, transformation
+rule~1 might be applicable.
+
+@<VF: Do a |char|, |rule|, or |xxx|@>=
+begin if (vf_ptr=0)or(byte_ptr>vf_push_loc[vf_ptr]) then move_zero:=false
+else case cur_class of
+char_cl: move_zero:=(not cur_upd)or(vf_cur_fnt<>vf_fnt);
+rule_cl: move_zero:=not cur_upd;
+xxx_cl: move_zero:=true;
+end; {there are no other cases}
+if move_zero then
+ begin decr(byte_ptr); decr(vf_ptr);
+ end;
+case cur_class of
+char_cl: @<VF: Do a |fnt|, a |char|, or both@>;
+rule_cl: @<VF: Do a |rule|@>;
+xxx_cl: @<VF: Do an |xxx|@>;
+end; {there are no other cases}
+vf_last_end[vf_ptr]:=byte_ptr;
+if move_zero then
+ begin incr(vf_ptr); append_one(push); vf_push_loc[vf_ptr]:=byte_ptr;
+ vf_last_end[vf_ptr]:=byte_ptr;
+ if cur_class=char_cl then if cur_upd then goto reswitch;
+ end;
+end
+
+@ A special situation arises if transformation rule~1 is applied to a
+|fnt_num| of |fnt| command, but not to the |set_char| or \\{set} command
+following it; in this case |cur_upd| and |move_zero| are both |true| and
+the |set_char| or \\{set} command will be appended later.
+
+@<VF: Do a |fnt|, a |char|, or both@>=
+begin if vf_cur_fnt<>vf_fnt then
+ begin vf_last[vf_ptr]:=vf_other;
+ pckt_unsigned(fnt1,vf_cur_fnt); vf_fnt:=vf_cur_fnt;
+ end;
+if (not move_zero)or(not cur_upd) then
+ begin vf_last[vf_ptr]:=vf_char_type[cur_upd];
+ vf_last_loc[vf_ptr]:=byte_ptr;
+ pckt_char(cur_upd,cur_ext,cur_res);
+ end;
+end
+
+@ @<VF: Do a |rule|@>=
+begin vf_last[vf_ptr]:=vf_rule_type[cur_upd];
+vf_last_loc[vf_ptr]:=byte_ptr;
+append_one(dvi_rule_cmd[cur_upd]);
+pckt_four(cur_v_dimen); pckt_four(cur_h_dimen);
+end
+
+@ @<VF: Do an |xxx|@>=
+begin vf_last[vf_ptr]:=vf_other;
+pckt_unsigned(xxx1,cur_parm); pckt_room(cur_parm);
+while cur_parm>0 do
+ begin append_byte(vf_ubyte); decr(cur_parm);
+ end;
+end
+
+@ Transformation rules 2--6 are triggered by a |pop|, either read from
+the \.{VF} file or manufactured at the end of the packet.
+
+@<VF: Do a |pop|@>=
+begin if vf_ptr<1 then bad_font;
+byte_ptr:=vf_last_end[vf_ptr]; {this is rule 2}
+if vf_last[vf_ptr]<=vf_rule then
+ if vf_last_loc[vf_ptr]=vf_push_loc[vf_ptr] then
+ @<VF: Prepare for rule 4@>;
+if byte_ptr=vf_push_loc[vf_ptr] then @<VF: Apply rule 3 or 4@>
+else begin if vf_last[vf_ptr]=vf_group then @<VF: Apply rule 6@>;
+ append_one(pop); decr(vf_ptr); vf_last[vf_ptr]:=vf_group;
+ vf_last_loc[vf_ptr]:=vf_push_loc[vf_ptr+1]-1;
+ vf_last_end[vf_ptr]:=byte_ptr;
+ if vf_push_num[vf_ptr+1]>0 then @<VF: Apply rule 5@>;
+ end;
+end
+
+@ In order to implement transformation rule~4, we cancel the |set_char|,
+\\{set}, or |set_rule|, append a |pop|, and insert a |put| or |put_rule|
+with the old parameters.
+
+@<VF: Prepare for rule 4@>=
+begin cur_class:=vf_last[vf_ptr]; cur_upd:=false;
+byte_ptr:=vf_push_loc[vf_ptr];
+end
+
+@ @<VF: Apply rule 3 or 4@>=
+begin if vf_push_num[vf_ptr]>0 then
+ begin decr(vf_push_num[vf_ptr]);
+ vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+ end
+else begin decr(byte_ptr); decr(vf_ptr);
+ end;
+if cur_class<>pop_cl then goto reswitch; {this is rule 4}
+end
+
+@ @<VF: Apply rule 6@>=
+begin Decr(byte_ptr)(2);
+for k:=vf_last_loc[vf_ptr]+1 to byte_ptr do byte_mem[k-1]:=byte_mem[k];
+vf_last[vf_ptr]:=vf_other; vf_last_end[vf_ptr]:=byte_ptr;
+end
+
+@ @<VF: Apply rule 5@>=
+begin incr(vf_ptr);
+@<VF: Start a new level@>;
+decr(vf_push_num[vf_ptr]);
+end
+
+@ The \.{VF} format specifies that after a character packet invoked by a
+|set_char| or \\{set} command, ``|h|~is increased by the \.{TFM} width
+(properly scaled)---just as if a simple character had been typeset'';
+for |vf_simple| packets this is achieved by changing the final |put|
+command into |set_char| or \\{set}, but for |vf_complex| packets an
+explicit movement must be done. This poses a problem for programs,
+such as \.{DVIcopy}, which write a new \.{DVI} file with all references
+to characters from virtual fonts replaced by their character packets:
+The \.{DVItype} program specifies that the horizontal movements after a
+|set_char| or \\{set} command, after a |set_rule| command, and after one
+of the commands |right1..x4|, are all treated differently when \.{DVI}
+units are converted to pixels.
+
+Thus we introduce a slight extension of \.{DVItype}'s pixel rounding
+algorithm and hope that this extension will become part of the standard
+\.{DVItype} program in the near future: If a \.{DVI} file contains a
+|set_rule| command for a rule with the negative height |width_dimen|,
+then this rule shall be treated in exactly the same way as a ficticious
+character whose width is the width of that rule; as value of |width_dimen|
+we choose $-2^{31}$, the smallest signed 32-bit integer.
+
+@<Glob...@>=
+@!width_dimen:int_32; {vertical dimension of special rules}
+
+@ When initializing |width_dimen| we are careful to avoid arithmetic
+overflow.
+
+@<Set init...@>=
+width_dimen:=-@"40000000; Decr(width_dimen)(@"40000000);
+
+@* Terminal communication.
+When \.{\title} begins, it engages the user in a brief dialog so that
+various options may be specified. This part of \.{\title} requires
+nonstandard \PASCAL\ constructions to handle the online interaction; so
+it may be preferable in some cases to omit the dialog and simply to
+stick to the default options. On other hand, the system-dependent
+routines that are needed are not complicated, so it will not be terribly
+difficult to introduce them; furthermore they are similar to those in
+\.{DVItype}.
+
+It may be desirable to (optionally) specify all the options in the
+command line and skip the dialog with the user, provided the operating
+system permits this. Here we just define the system-indepent part of the
+code required for this possibility. Since a complete option (a keyword
+possibly followed by one or several parameters) may have embedded blanks
+it might be necessary to replace these blanks by some other separator,
+e.g., by a '/'. Using, e.g., \.{UNIX} style options one might then say
+$$\.{\title\space-mag/2000 -sel/17.3/5 -sel/47 ...}$$
+to override the magnification factor that is stated in the \.{DVI} file,
+and to select five pages starting with the page numbered~17.3 as well as
+all remaining pages starting with the one numbered~47; alternatively one
+might simply say
+$$\.{\title\space- ...}$$
+to skip the dialog and use the default options.
+
+The system-dependent initialization code should set the |n_opt| variable
+to the number of options found in the command line. If |n_opt=0| the
+|input_ln| procedure defined below will promt the user for options. If
+|n_opt>0| the |k_opt| variable will be incremented and another piece of
+system-dependent code is invoked instead of the dialog; that code should
+place the value of command line option number |k_opt| as temporary
+string into the |byte-mem| array. This process will be repeated until
+|k_opt=n_opt|, indicating that all command line options have been
+processed.
+@^system dependencies@>
+
+@d opt_separator="/" {acts as blank when scanning (command line) options}
+
+@<Set init...@>=
+n_opt:=0; {change this to indicate the presence of command line options}
+k_opt:=0; {just in case}
+
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that
+line into the |byte_mem| array as a temporary string. \PASCAL's
+standard |input| file is used for terminal input, as |output| is used
+for terminal output.
+
+Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall invoke a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+@^system dependencies@>
+
+@d update_terminal == break(output) {empty the terminal output buffer}
+@#
+@d scan_blank(#)== {tests for `blank' when scanning (command line) options}
+ ((byte_mem[#]=bi(" "))or(byte_mem[#]=bi(opt_separator)))
+@d scan_skip== {skip `blanks'}
+ while scan_blank(scan_ptr)and(scan_ptr<byte_ptr) do incr(scan_ptr)
+@d scan_init== {initialize |scan_ptr|}
+ byte_mem[byte_ptr]:=bi(" "); scan_ptr:=pckt_start[pckt_ptr-1]; scan_skip
+
+@<Action procedures for |dialog|@>=
+procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin if n_opt=0 then
+ begin print('Enter option: '); update_terminal; reset(input);
+ if eoln(input) then read_ln(input);
+ k:=0; pckt_room(terminal_line_length);
+ while (k<terminal_line_length)and not eoln(input) do
+ begin append_byte(xord[input^]); incr(k); get(input);
+ end;
+ end
+else if k_opt<n_opt then
+ begin incr(k_opt);
+ {Copy command line option number |k_opt| into |byte_mem| array!}
+ end;
+end;
+
+@ The global variable |scan_ptr| is used while scanning the temporary
+packet; it points to the next byte in |byte_mem| to be examined.
+
+@<Glob...@>=
+@!n_opt:int_16; {number of options found in command line}
+@!k_opt:int_16; {number of command line options processed}
+@!scan_ptr:byte_pointer; {pointer to next byte to be examined}
+@!sep_char:text_char; {|' '| or |xchr[opt_separator]|}
+
+@ The |scan_keyword| function is used to test for keywords in a character
+string stored as temporary packet in |byte_mem|; the result is |true|
+(and |scan_ptr| is updated) if the characters starting at position
+|scan_ptr| are an abbreviation of a given keyword followed by at least
+one blank.
+
+@<Action procedures for |dialog|@>=
+function scan_keyword(@!p:pckt_pointer;@!l:int_7):boolean;
+var i,@!j,@!k:byte_pointer; {indices into |byte_mem|}
+begin i:=pckt_start[p]; j:=pckt_start[p+1]; k:=scan_ptr;
+while (i<j)and((byte_mem[k]=byte_mem[i])or(byte_mem[k]=byte_mem[i]-"a"+"A")) do
+ begin incr(i); incr(k);
+ end;
+if scan_blank(k)and(i-pckt_start[p]>=l) then
+ begin scan_ptr:=k; scan_skip; scan_keyword:=true;
+ end
+else scan_keyword:=false;
+end;
+
+@ Here is a routine that scans a (possibly signed) integer and computes
+the decimal value. If no decimal integer starts at |scan_ptr|, the
+value~0 is returned. The integer should be less than $2^{31}$ in
+absolute value.
+
+@<Action procedures for |dialog|@>=
+function scan_int:int_32;
+var x:int_32; {accumulates the value}
+@!negative:boolean; {should the value be negated?}
+begin if byte_mem[scan_ptr]="-" then
+ begin negative:=true; incr(scan_ptr);
+ end
+else negative:=false;
+x:=0;
+while (byte_mem[scan_ptr]>="0")and(byte_mem[scan_ptr]<="9") do
+ begin x:=10*x+byte_mem[scan_ptr]-"0"; incr(scan_ptr);
+ end;
+scan_skip;
+if negative then scan_int:=-x @+ else scan_int:=x;
+end;
+
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{\title} begins.
+@^system dependencies@>
+
+@p @<Action procedures for |dialog|@>@;
+procedure dialog;
+label exit;
+var p:pckt_pointer; {packet being created}
+begin @<Initialize options@>@;
+loop begin input_ln; p:=new_packet; scan_init;
+ if scan_ptr=byte_ptr then
+ begin flush_packet; return;
+ end@;@/
+ @<Cases for options@>@;@/
+ else begin if n_opt=0 then sep_char:=' '
+ else sep_char:=xchr[opt_separator];
+ print_options;
+ if n_opt>0 then
+ begin print('Bad command line option: ');
+ print_packet(p); abort('---run terminated');
+ end;
+ end;
+ flush_packet;
+ end;
+exit:end;
+
+@ The |print_options| procedure might be used in a `Usage message'
+displaying the command line syntax.
+
+@<Basic printing...@>=
+procedure print_options;
+begin print_ln('Valid options are:');
+@<Print valid options@>@;
+end;
+
+@* Subroutines for typesetting commands.
+This is the central part of the whole \.{\title} program:
+When a typesetting command from the \.{DVI} file or from a \.{VF} packet
+has been decoded, one of the typesetting routines defined below is
+invoked to execute the command; apart from the necessary book keeping,
+these routines invoke device dependent code defined later.
+
+@p @<Declare typesetting procedures@>
+
+@ These typesetting routines communicate with the rest of the program
+through global variables.
+
+@<Glob...@>=
+@!type_setting:boolean; {|true| while typesetting a page}
+
+@ @<Set init...@>=
+type_setting:=false;
+
+@ The user may select up to |max_select| ranges of consecutive pages to
+be processed. Each starting page specification is recorded in two global
+arrays called |start_count| and |start_there|. For example, `\.{1.*.-5}'
+is represented by |start_there[0]=true|, |start_count[0]=1|,
+|start_there[1]=false|, |start_there[2]=true|, |start_count[2]=-5|. We
+also set |start_vals=2|, to indicate that count 2 was the last one
+mentioned. The other values of |start_count| and |start_there| are not
+important, in this example. The number of pages is recorded in
+|max_pages|; a non positive value indicates that there is no limit.
+
+@d start_count==select_count[cur_select] {count values to select
+ starting page}
+@d start_there==select_there[cur_select] {is the |start_count| value
+ relevant?}
+@d start_vals==select_vals[cur_select] {the last count considered
+ significant}
+@d max_pages==select_max[cur_select] {at most this many |bop..eop| pages
+ will be printed}
+
+@<Glob...@>=
+@!select_count:array[0..max_select-1,0..9] of int_32;
+@!select_there:array[0..max_select-1,0..9] of boolean;
+@!select_vals:array[0..max_select-1] of 0..9;
+@!select_max:array[0..max_select-1] of int_32;
+@!out_mag:int_32; {output maginfication}
+@!count:array[0..9] of int_32; {the count values on the current page}
+@!num_select:0..max_select; {number of page selection ranges specified}
+@!cur_select:0..max_select; {current page selection range}
+@!selected:boolean; {has starting page been found?}
+@!all_done:boolean; {have all selected pages been processed?}
+@!str_mag,@!str_select:pckt_pointer;
+
+@ Here is a simple subroutine that tests if the current page might be the
+starting page.
+
+@p function start_match:boolean; {does |count| match the starting spec?}
+var k:0..9; {loop index}
+@!match:boolean; {does everything match so far?}
+begin match:=true;
+for k:=0 to start_vals do
+ if start_there[k]and(start_count[k]<>count[k]) then match:=false;
+start_match:=match;
+end;
+
+@ @<Initialize options@>=
+out_mag:=0; cur_select:=0; max_pages:=0; selected:=true;
+
+@ @<Print valid options@>=
+print_ln(' mag',sep_char,'<new_mag>');
+print_ln(' select',sep_char,'<start_count>',sep_char,
+ '[<max_pages>] (up to ',max_select:1,' ranges)');
+
+@ @<Action procedures for |dialog|@>=
+procedure scan_count; {scan a |start_count| value}
+begin if byte_mem[scan_ptr]=bi("*") then
+ begin start_there[start_vals]:=false; incr(scan_ptr); scan_skip;
+ end
+else begin start_there[start_vals]:=true;
+ start_count[start_vals]:=scan_int;
+ if cur_select=0 then selected:=false; {don't start at first page}
+ end;
+end;
+
+@ @<Cases for options@>=
+else if scan_keyword(str_mag,3) then out_mag:=scan_int
+else if scan_keyword(str_select,3) then
+ if cur_select=max_select then print_ln('Too many page selections')
+ else begin start_vals:=0; scan_count;
+ while (start_vals<9)and(byte_mem[scan_ptr]=bi(".")) do
+ begin incr(start_vals); incr(scan_ptr); scan_count;
+ end;
+ max_pages:=scan_int; incr(cur_select);
+ end
+
+@ @<Initialize predefined strings@>=
+id3("m")("a")("g")(str_mag);
+id6("s")("e")("l")("e")("c")("t")(str_select);
+
+@ A stack is used to keep track of the current horizonal and vertical
+position, |h| and |v|, and the four registers |w|, |x|, |y|, and |z|;
+the register pairs |(w,x)| and |(y,z)| are maintained as arrays.
+
+@<Types...@>=
+@!device @<Declare device dependend types@>@; @+ ecived @; @/
+@!stack_pointer=0..stack_size;@/
+@!stack_index=1..stack_size;@/
+@!pair_32=array[0..1] of int_32; {a pair of |int_32| variables}
+@!stack_record=record@;@/
+ @!h_field:int_32; {horizontal position |h|}
+ @!v_field:int_32; {vertical position |v|}
+ @!w_x_field:pair_32; {|w| and |x| register for horizontal movements}
+ @!y_z_field:pair_32; {|y| and |z| register for vertical movements}
+ @!device @<Device dependent stack record fields@>@; @+ ecived @; @/
+ end;
+
+@ The current values are kept in |cur_stack|; they are pushed onto and
+popped from |stack|. We use \.{WEB} macros to access the current values.
+
+@d cur_h==cur_stack.h_field {the current |@!h| value}
+@d cur_v==cur_stack.v_field {the current |@!v| value}
+@d cur_w_x==cur_stack.w_x_field {the current |@!w| and |@!x| value}
+@d cur_y_z==cur_stack.y_z_field {the current |@!y| and |@!z| value}
+
+@<Glob...@>=
+@!stack:array[stack_index] of stack_record; {the pushed values}
+@!cur_stack:stack_record; {the current values}
+@!zero_stack:stack_record; {initial values}
+@!stack_ptr:stack_pointer; {last used position in |stack|}
+
+@ @<Set init...@>=
+zero_stack.h_field:=0; zero_stack.v_field:=0;
+for i:=0 to 1 do
+ begin zero_stack.w_x_field[i]:=0; zero_stack.y_z_field[i]:=0;
+ end;
+@!device @<Initialize device dependent stack record fields@>@; @+ ecived @; @/
+
+@ When typesetting for a real device we must convert the current
+position from \.{DVI} units to pixels, i.e., |cur_h| and |cur_v| into
+|cur_hh| and |cur_vv|. This might be a good place to collect everything
+related to the conversion from \.{DVI} units to pixels and in particular
+all the pixel rounding algorithms.
+
+@d font_space(#)==fnt_space[#] {boundary between ``small'' and ``large''
+ spaces}
+
+@<Declare device dependent font data arrays@>=
+@!fnt_space:array [font_number] of int_32; {boundary between ``small''
+ and ``large'' spaces}
+
+@ @<Initialize device dependent font data@>=
+font_space(invalid_font):=0;
+
+@ @<Initialize device dependent data for a font@>=
+font_space(cur_fnt):=font_scaled(cur_fnt) div 6;
+ {this is a 3-unit ``thin space''}
+
+@ The |char_pixels| array is used to store the horizontal character
+escapements: for \.{PK} or \.{GF} files we use the values given there,
+otherwise we must convert the character widths to (horizontal) pixels.
+The horizontal escapement of character~|c| in font~|f| is given by
+|font_pixel(f)(c)|.
+
+@d font_pixel(#)==char_pixels[font_chars(#)+font_width_end
+@#
+@d max_pix_value==@"7FFF {largest allowed pixel value; this range may not
+ suffice for high resolution output devices}
+
+@<Declare device dependend types@>=
+@!pix_value=-max_pix_value..max_pix_value; {a pixel coordinate or displacement}
+
+@ @<Glob...@>=
+@!device
+@!char_pixels:array[char_pointer] of pix_value; {character escapements}
+@!h_pixels:pix_value; {a horizontal dimension in pixels}
+@!v_pixels:pix_value; {a vertical dimension in pixels}
+@!temp_pix:pix_value; {temporary value for pixel rounding}
+ecived
+
+@ @d cur_hh==cur_stack.hh_field {the current |@!hh| value}
+@d cur_vv==cur_stack.vv_field {the current |@!vv| value}
+
+@<Device dependent stack record fields@>=
+@!hh_field:pix_value; {horizontal pixel position |hh|}
+@!vv_field:pix_value; {vertical pixel position |vv|}
+
+@ @<Initialize device dependent stack record fields@>=
+zero_stack.hh_field:=0; zero_stack.vv_field:=0;
+
+@ For small movements we round the increment in position, for large
+movements we round the incremented position. The same applies to rule
+dimensions with the only difference that they will always be rounded
+towards larger values. For characters we increment the horizontal
+position by the escapement values obtained, e.g., from a \.{PK} file or
+by the \.{TFM} width converted to pixels.
+
+@d h_pixel_round(#)==round(h_conv*(#))
+@d v_pixel_round(#)==round(v_conv*(#))
+@^system dependencies@>
+@#
+@d large_h_space(#)==(#>=font_space(cur_fnt))or(#<=-4*font_space(cur_fnt))
+ {is this a ``large'' horizontal distance?}
+@d large_v_space(#)==(abs(#)>=5*font_space(cur_fnt))
+ {is this a ``large'' vertical distance?}
+@#
+@d h_rule_pixels== {converts the rule width |cur_h_dimen| to pixels}
+@!device if large_h_space(cur_h_dimen) then
+ begin h_pixels:=h_pixel_round(cur_h+cur_h_dimen)-cur_hh;
+ if h_pixels<=0 then if cur_h_dimen>0 then h_pixels:=1;
+ end
+else begin h_pixels:=trunc(h_conv*cur_h_dimen);
+ if h_pixels<h_conv*cur_h_dimen then incr(h_pixels);
+ end;
+ecived
+@#
+@d v_rule_pixels== {converts the rule height |cur_v_dimen| to pixels}
+@!device if large_v_space(cur_v_dimen) then
+ begin v_pixels:=cur_vv-v_pixel_round(cur_v-cur_v_dimen);
+ if v_pixels<=0 then v_pixels:=1; {used only for |cur_v_dimen>0|}
+ end
+else begin v_pixels:=trunc(v_conv*cur_v_dimen);
+ if v_pixels<v_conv*cur_v_dimen then incr(v_pixels);
+ end;
+ecived
+
+@ A sequence of consecutive rules, or consecutive characters in a
+fixed-width font whose width is not an integer number of pixels, can
+cause |hh| to drift far away from a correctly rounded value. \.{\title}
+ensures that the amount of drift will never exceed |max_h_drift| pixels;
+similarly |vv| shall never drift away from the correctly rounded value
+by more than |max_v_drift| pixels.
+
+@d h_upd_end(#)== {check for proper horizontal pixel rounding}
+begin Incr(cur_hh)(#); temp_pix:=h_pixel_round(cur_h);
+if abs(temp_pix-cur_hh)>max_h_drift then
+ if temp_pix>cur_hh then cur_hh:=temp_pix-max_h_drift
+ else cur_hh:=temp_pix+max_h_drift;
+end @+ ecived
+@d h_upd_char(#)==Incr(cur_h)(#)@;
+ @!device; h_upd_end
+@d h_upd_move(#)==Incr(cur_h)(#)@;
+ @!device; if large_h_space(#) then cur_hh:=h_pixel_round(cur_h)
+ else h_upd_end
+@#
+@d v_upd_end(#)== {check for proper vertical pixel rounding}
+begin Incr(cur_vv)(#); temp_pix:=v_pixel_round(cur_v);
+if abs(temp_pix-cur_vv)>max_v_drift then
+ if temp_pix>cur_vv then cur_vv:=temp_pix-max_v_drift
+ else cur_vv:=temp_pix+max_v_drift;
+end @+ ecived
+@d v_upd_move(#)==Incr(cur_v)(#)@;
+ @!device; if large_v_space(#) then cur_vv:=v_pixel_round(cur_v)
+ else v_upd_end
+
+@ The routines defined below use sections named `Declare local variables
+(if any) for \dots' or `Declare additional local variables for \dots';
+the former may declare variables (including the keyword \&{var}), whereas
+the later must at least contain the keyword \&{var}. In general, both may
+start with the declaration of labels, constants, and\slash or types.
+
+Let us start with the simple cases:
+The |do_pre| procedure is called when the preamble has been read from
+the \.{DVI} file; the preamble comment has just been converted into a
+temporary packet with the |new_packet| procedure.
+
+@p procedure do_pre;@/
+@<OUT: Declare local variables (if any) for |do_pre|@>@;
+begin all_done:=false; num_select:=cur_select; cur_select:=0;
+if num_select=0 then max_pages:=0;
+@!device
+h_conv:=(dvi_num/254000.0)*(h_resolution/dvi_den)*(out_mag/1000.0);
+v_conv:=(dvi_num/254000.0)*(v_resolution/dvi_den)*(out_mag/1000.0);
+ecived @; @/
+@<OUT: Process the |pre|@>@;@/
+end;
+
+@ The |do_bop| procedure is called when a |bop| has been read. This
+routine determines whether a page shall be processed or skipped and sets
+the variable |type_setting| accordingly.
+
+@p procedure do_bop;@/
+@<OUT: Declare additional local variables |do_bop|@>@;
+@!i,@!j:0..9; {indices into |count|}
+begin @<Determine whether this page should be processed or skipped@>;
+print('DVI: ');
+if type_setting then print('process') @+ else print('skipp');
+print('ing page ',count[0]:1); j:=9;
+while (j>0)and(count[j]=0) do decr(j);
+for i:=1 to j do print('.',count[i]:1);
+d_print(' at ',dvi_loc-45:1);
+print_ln('.');
+if type_setting then
+ begin stack_ptr:=0; cur_stack:=zero_stack; cur_fnt:=invalid_font;@/
+ @<OUT: Process a |bop|@>@;@/
+ end;
+end;
+
+@ Note that the device dependent code `OUT: Process a |bop|' may choose
+to set |type_setting| to false even if |selected| is true.
+
+@<Determine whether this page...@>=
+if not selected then selected:=start_match;
+type_setting:=selected
+
+@ The |do_eop| procedure is called in order to process an |eop|; the
+stack should be empty.
+
+@p procedure do_eop;@/
+@<OUT: Declare local variables (if any) for |do_eop|@>@;
+begin if stack_ptr<>0 then bad_dvi;
+@<OUT: Process an |eop|@>@;
+if max_pages>0 then
+ begin decr(max_pages);
+ if max_pages=0 then
+ begin selected:=false; incr(cur_select);
+ if cur_select=num_select then all_done:=true;
+ end;
+ end;
+type_setting:=false;
+end;
+
+@ The procedures |do_push| and |do_pop| are called in order to process
+|push| and |pop| commands; |do_push| must check for stack overflow,
+|do_pop| should never be called when the stack is empty.
+
+@p procedure do_push; {push onto stack}
+@<OUT: Declare local variables (if any) for |do_push|@>@;
+begin incr_stack(stack_ptr); stack[stack_ptr]:=cur_stack;@/
+@<OUT: Process a |push|@>@;
+end;
+@#
+procedure do_pop; {pop from stack}
+@<OUT: Declare local variables (if any) for |do_pop|@>@;
+begin if stack_ptr=0 then bad_dvi;
+cur_stack:=stack[stack_ptr]; decr(stack_ptr);
+@<OUT: Process a |pop|@>@;@/
+end;
+
+@ The |do_xxx| procedure is called in order to process a special command.
+The bytes of the special string have been put into |byte_mem| as the
+current string. They are converted to a temporary packet and discarded
+again.
+
+@p procedure do_xxx;@/
+@<OUT: Declare additional local variables for |do_xxx|@>@;
+@!p:pckt_pointer; {temporary packet}
+begin p:=new_packet;@/
+@<OUT: Process an |xxx|@>@;@/
+flush_packet;
+end;
+
+@ Next are the movement commands:
+The |do_right| procedure is called in order to process the horizontal
+movement commands |right|, |w|, and |x|.
+
+
+@p procedure do_right;@/
+@<OUT: Declare local variables (if any) for |do_right|@>@;
+begin if cur_class>=w_cl then cur_w_x[cur_class-w_cl]:=cur_parm
+else if cur_class<right_cl then cur_parm:=cur_w_x[cur_class-w0_cl];
+@<OUT: Process a |right| or |w| or |x|@>@;@/
+h_upd_move(cur_parm)(h_pixel_round(cur_parm));
+@<OUT: Move right@>@;
+end;
+
+@ The |do_down| procedure is called in order to process the vertical
+movement commands |down|, |y|, and |z|.
+
+@p procedure do_down;@/
+@<OUT: Declare local variables (if any) for |do_down|@>@;
+begin if cur_class>=y_cl then cur_y_z[cur_class-y_cl]:=cur_parm
+else if cur_class<down_cl then cur_parm:=cur_y_z[cur_class-y0_cl];
+@<OUT: Process a |down| or |y| or |z|@>@;@/
+v_upd_move(cur_parm)(v_pixel_round(cur_parm));
+@<OUT: Move down@>@;
+end;
+
+@ The |do_width| procedure, or actually the |do_a_width| macro, is
+called in order to increase the current horizontal position |cur_h| by
+|cur_h_dimen| in exactly the same way as if a character of width
+|cur_h_dimen| had been typeset.
+
+@d do_a_width(#)==
+ begin @!device h_pixels:=#; @+ ecived @; @+ do_width;
+ end
+
+@p procedure do_width;@/
+@<OUT: Declare local variables (if any) for |do_width|@>@;
+begin @<OUT: Typeset a |width|@>@;@/
+h_upd_char(cur_h_dimen)(h_pixels);
+@<OUT: Move right@>@;
+end;
+
+@ Finally we have the commands for the typesetting of rules and characters;
+the global variable |cur_upd| is |true| if the horizontal position shall
+be updated (\\{set} commands).
+
+The |do_rule| procedure is called in order to typeset a rule.
+
+@p procedure do_rule;@/
+@<OUT: Declare additional local variables |do_rule|@>@;
+@!visible:boolean;
+begin h_rule_pixels@;
+if (cur_h_dimen>0)and(cur_v_dimen>0) then
+ begin visible:=true; v_rule_pixels@;
+ @<OUT: Typeset a visible |rule|@>@;
+ end
+else begin visible:=false;
+ @<OUT: Typeset an invisible |rule|@>@;
+ end;
+if cur_upd then
+ begin h_upd_move(cur_h_dimen)(h_pixels);
+ @<OUT: Move right@>@;
+ end;
+end;
+
+@ Last not least the |do_char| procedure is called in order to typeset
+character~|cur_res| with extension~|cur_ext| from the real font~|cur_fnt|.
+
+@p procedure do_char;@/
+@<OUT: Declare local variables (if any) for |do_char|@>@;
+begin @<OUT: Typeset a |char|@>@;
+if cur_upd then
+ begin h_upd_char(widths[cur_wp])(char_pixels[cur_cp]);
+ @<OUT: Move right@>@;
+ end;
+end;
+
+@ If the program terminates abnormally, the following code may be
+invoked in the middle of a page.
+
+@<Finish output file(s)@>=
+begin if type_setting then @<OUT: Finish incomplete page@>;
+@<OUT: Finish output file(s)@>@;
+end
+
+@ When the first character of font~|cur_fnt| is about to be typeset, the
+|do_font| procedure is called in order to decide whether this is a
+virtual font or a real font.
+
+One step in this decision is the attempt to find and read the \.{VF}
+file for this font; other attempts to locate a font file may be
+performed before and after that, depending on the nature of the output
+device and on the structure of the file system at a particular
+installation. For a real device we convert the character widths to
+(horizontal) pixels.
+
+In any case |do_font| must change |font_type(cur_fnt)| to a value
+|>defined_font|; as a last resort one might use the \.{TFM} width data
+and draw boxes or leave blank spaces in the output.
+
+@p procedure do_font;@/
+label done;@/
+@<OUT: Declare additional local variables for |do_font|@>@;
+@!p:char_pointer; {index into |char_widths| and |char_pixels|}
+begin @!debug if font_type(cur_fnt)=defined_font then confusion(str_fonts);
+gubed@;
+@!device for p:=font_chars(cur_fnt)+font_bc(cur_fnt)
+ to font_chars(cur_fnt)+font_ec(cur_fnt) do
+ char_pixels[p]:=h_pixel_round(widths[char_widths[p]]);
+ecived@;
+@<OUT: Look for a font file before trying to read the \.{VF} file;
+ if found |goto done|@>@;@/
+if do_vf then goto done; {try to read the \.{VF} file}
+@<OUT: Look for a font file after trying to read the \.{VF} file@>@;@/
+done:
+@!debug if font_type(cur_fnt)<=loaded_font then confusion(str_fonts);
+gubed@;
+end;
+
+@ Before a character of font~|cur_fnt| is typeset the following piece of
+code ensures that the font is ready to be used.
+
+@<Prepare to use font |cur_fnt|@>=
+@<OUT: Prepare to use font |cur_fnt|@>@;
+if font_type(cur_fnt)<=loaded_font then do_font {|cur_fnt| was not yet used}
+
+@* Interpreting VF packets.
+The |pckt_first_par| procedure first reads a \.{DVI} command byte from
+the packet into |cur_cmd|; then |cur_parm| is set to the value of the
+first parameter (if any) and |cur_class| to the command class.
+
+@p procedure pckt_first_par;
+begin cur_cmd:=pckt_ubyte;
+case dvi_par[cur_cmd] of
+char_par: set_cur_char(pckt_ubyte);
+no_par: do_nothing;
+dim1_par: cur_parm:=pckt_sbyte;
+num1_par: cur_parm:=pckt_ubyte;
+dim2_par: cur_parm:=pckt_spair;
+num2_par: cur_parm:=pckt_upair;
+dim3_par: cur_parm:=pckt_strio;
+num3_par: cur_parm:=pckt_utrio;
+three_cases(dim4_par): cur_parm:=pckt_squad; {|dim4|, |num4|, or |numu|}
+rule_par:
+ begin cur_v_dimen:=pckt_squad; cur_h_dimen:=pckt_squad;
+ cur_upd:=(cur_cmd=set_rule);
+ end;
+fnt_par:cur_parm:=cur_cmd-fnt_num_0;
+end; {there are no other cases}
+cur_class:=dvi_cl[cur_cmd];
+end;
+
+@ The |do_vf_packet| procedure is called in order to interpret the
+character packet for a virtual character. Such a packet may contain the
+instruction to typeset a character from the same or an other virtual
+font; in such cases |do_vf_packet| calls itself recursively. The
+recursion level, i.e., the number of times this has happened, is kept
+in the global variable |n_recur| and should not exceed |max_recursion|.
+@^recursion@>
+
+@<Types...@>=
+@!recur_pointer=0..max_recursion;
+
+@ The \.{\title} processor should detect an infinite recursion caused by
+bad \.{VF} files; thus a new recursion level is entered even in cases
+where this could be avoided without difficulty.
+
+If the recursion level exceeds the allowed maximum, we want to give
+a traceback how this has happened; thus some of the global variables
+used in different invocations of |do_vf_packet| are saved in a stack,
+others are saved as local variables of |do_vf_packet|.
+
+@<Glob...@>=
+@!recur_fnt:array[recur_pointer] of font_number; {this packet's font}
+@!recur_ext:array[recur_pointer] of int_24; {this packet's extension}
+@!recur_res:array[recur_pointer] of eight_bits; {this packet's residue}
+@!recur_pckt:array[recur_pointer] of pckt_pointer; {the packet}
+@!recur_loc:array[recur_pointer] of byte_pointer; {next byte of packet}
+@!n_recur:recur_pointer; {current recursion level}
+@!recur_used:recur_pointer; {highest recursion level used so far}
+
+@ @<Set init...@>=
+n_recur:=0; recur_used:=0;
+
+@ Here now is the |do_vf_packet| procedure.
+
+@p procedure do_vf_packet;
+label continue,found,done;
+var k:recur_pointer; {loop index}
+@!f:int_8u; {packet type flag}
+@!save_upd:boolean; {used to save |cur_upd|}
+@!save_cp:width_pointer; {used to save |cur_cp|}
+@!save_wp:width_pointer; {used to save |cur_wp|}
+@!save_limit:byte_pointer; {used to save |cur_limit|}
+begin @<VF: Save values on entry to |do_vf_packet|@>;@/
+@<VF: Interpret the \.{DVI} commands in the packet@>@;@/
+if save_upd then
+ begin cur_h_dimen:=widths[save_wp]; do_a_width(char_pixels[save_cp]);
+ end;
+@<VF: Restore values on exit from |do_vf_packet|@>;@/
+end;
+
+@ On entry to |do_vf_packet| several values must be saved.
+
+@<VF: Save values on entry to |do_vf_packet|@>=
+save_upd:=cur_upd; save_cp:=cur_cp; save_wp:=cur_wp;@/
+recur_fnt[n_recur]:=cur_fnt;
+recur_ext[n_recur]:=cur_ext;
+recur_res[n_recur]:=cur_res
+
+@ Some of these values must be restored on exit from |do_vf_packet|.
+
+@<VF: Restore values on exit from |do_vf_packet|@>=
+cur_fnt:=recur_fnt[n_recur]
+
+@ If |cur_pckt| is the empty packet, we manufacture a |put| command;
+otherwise we read and interpret \.{DVI} commands from the packet.
+
+@<VF: Interpret the \.{DVI} commands in the packet@>=
+if find_packet then f:=cur_type @+ else goto done;
+recur_pckt[n_recur]:=cur_pckt;
+save_limit:=cur_limit;
+cur_fnt:=font_font(cur_fnt);
+if cur_pckt=empty_packet then
+ begin cur_class:=char_cl; goto found;
+ end;
+if cur_loc>=cur_limit then goto done;
+continue: pckt_first_par;
+found: case cur_class of
+char_cl: @<VF: Typeset a |char|@>;
+rule_cl: do_rule;
+xxx_cl:
+ begin pckt_room(cur_parm);
+ while cur_parm>0 do
+ begin append_byte(pckt_ubyte); decr(cur_parm);
+ end;
+ do_xxx;
+ end;
+push_cl: do_push;
+pop_cl: do_pop;
+five_cases(w0_cl): do_right; {|right|, |w|, or |x|}
+five_cases(y0_cl): do_down; {|down|, |y|, or |z|}
+fnt_cl: cur_fnt:=cur_parm;
+othercases confusion(str_packets); {font definition or invalid}
+endcases;
+if cur_loc<cur_limit then goto continue;
+done:
+
+@ The final |put| of a simple packet may be changed into |set_char| or
+\\{set}.
+
+@<VF: Typeset a |char|@>=
+begin @<Prepare to use font |cur_fnt|@>;
+cur_cp:=font_chars(cur_fnt)+cur_res; cur_wp:=char_widths[cur_cp];
+if (cur_loc=cur_limit)and(f=vf_simple) and save_upd then
+ begin save_upd:=false; cur_upd:=true;
+ end;
+if font_type(cur_fnt)=vf_font_type then
+ @<VF: Enter a new recursion level@>
+else do_char;
+end
+
+@ Before entering a new recursion level we must test for overflow; in
+addition a few variables must be saved and restored.
+A |set_char| or \\{set} followed by |pop| is changed into |put|.
+
+@<VF: Enter a new recursion level@>=
+begin recur_loc[n_recur]:=cur_loc; {save}
+if cur_loc<cur_limit then
+ if byte_mem[cur_loc]=bi(pop) then cur_upd:=false;
+if n_recur=recur_used then
+ if recur_used=max_recursion then
+ @<VF: Display the recursion traceback and terminate@>
+ else incr(recur_used);@/
+incr(n_recur); do_vf_packet; decr(n_recur); {recurse}
+cur_loc:=recur_loc[n_recur]; cur_limit:=save_limit; {restore}
+end
+
+@ @<VF: Display the recursion traceback and terminate@>=
+begin print_ln(' !Infinite VF recursion?');
+@.Infinite VF recursion?@>
+for k:=max_recursion downto 0 do
+ begin print('level=',k:1,' font');
+ d_print('=',recur_fnt[k]:1);
+ print_font(recur_fnt[k]);
+ print(' char=',recur_res[k]:1);
+ if recur_ext[k]<>0 then print('.',recur_ext[k]:1);
+ new_line;
+ @!debug hex_packet(recur_pckt[k]); print_ln('loc=',recur_loc[k]:1);
+ gubed@;
+ end;
+overflow(str_recursion,max_recursion);
+end
+
+@* Interpreting the DVI file.
+The |do_dvi| procedure reads the entire \.{DVI} file and initiates
+whatever actions may be necessary.
+
+@p procedure do_dvi;
+label done,exit;
+var temp_byte:int_8u; {byte for temporary variables}
+@!temp_int:int_32; {integer for temporary variables}
+@!dvi_start:int_32; {starting location}
+@!dvi_bop_post:int_32; {location of |bop| or |post|}
+@!dvi_back:int_32; {a back pointer}
+@!k:int_15; {general purpose variable}
+begin @<DVI: Process the preamble@>;
+if random_reading then @<DVI: Process the postamble@>;
+repeat dvi_first_par;
+ while cur_class=fnt_def_cl do
+ begin dvi_do_font(random_reading); dvi_first_par;
+ end;
+ if cur_cmd=bop then @<DVI: Process one page@>;
+until cur_cmd<>eop;
+if cur_cmd<>post then bad_dvi;
+exit:end;
+
+@ @<DVI: Process the preamble@>=
+if dvi_ubyte<>pre then bad_dvi;
+if dvi_ubyte<>dvi_id then bad_dvi;
+dvi_num:=dvi_pquad; dvi_den:=dvi_pquad; dvi_mag:=dvi_pquad;
+tfm_conv:=(25400000.0/dvi_num)*(dvi_den/473628672)/16.0;
+temp_byte:=dvi_ubyte; pckt_room(temp_byte);
+for k:=1 to temp_byte do append_byte(dvi_ubyte);
+print('DVI file: '''); print_packet(new_packet); print_ln(''',');
+print(' num=',dvi_num:1,', den=',dvi_den:1,', mag=',dvi_mag:1);
+if out_mag<=0 then out_mag:=dvi_mag @+ else print(' => ',out_mag:1);
+print_ln('.');
+do_pre; flush_packet
+
+@ @<Glob...@>=
+@!dvi_num:int_31; {numerator}
+@!dvi_den:int_31; {denominator}
+@!dvi_mag:int_31; {magnification}
+
+@ @<DVI: Process the postamble@>=
+begin dvi_start:=dvi_loc; {remember start of first page}
+@<DVI: Find the postamble@>;
+d_print_ln('DVI: postamble at ',dvi_bop_post:1);
+dvi_back:=dvi_pointer;
+if dvi_num<>dvi_pquad then bad_dvi;
+if dvi_den<>dvi_pquad then bad_dvi;
+if dvi_mag<>dvi_pquad then bad_dvi;
+temp_int:=dvi_squad; temp_int:=dvi_squad;
+if stack_size<dvi_upair then overflow(str_stack,stack_size);
+temp_int:=dvi_upair;
+dvi_first_par;
+while cur_class=fnt_def_cl do
+ begin dvi_do_font(false); dvi_first_par;
+ end;
+if cur_cmd<>post_post then bad_dvi;
+if not selected then @<DVI: Find the starting page@>;
+dvi_move(dvi_start); {go to first or starting page}
+end
+
+@ @<DVI: Find the postamble@>=
+temp_int:=dvi_length-5;
+repeat if temp_int<49 then bad_dvi;
+dvi_move(temp_int); temp_byte:=dvi_ubyte; decr(temp_int);
+until temp_byte<>dvi_pad;
+if temp_byte<>dvi_id then bad_dvi;
+dvi_move(temp_int-4); if dvi_ubyte<>post_post then bad_dvi;
+dvi_bop_post:=dvi_pointer;
+if (dvi_bop_post<15)or(dvi_bop_post>dvi_loc-34) then bad_dvi;
+dvi_move(dvi_bop_post); if dvi_ubyte<>post then bad_dvi
+
+@ @<DVI: Find the starting page@>=
+begin dvi_start:=dvi_bop_post; {just in case}
+while dvi_back<>-1 do
+ begin if (dvi_back<15)or(dvi_back>dvi_bop_post-46) then bad_dvi;
+ dvi_bop_post:=dvi_back; dvi_move(dvi_back);
+ if dvi_ubyte<>bop then bad_dvi;
+ for k:=0 to 9 do count[k]:=dvi_squad;
+ if start_match then dvi_start:=dvi_bop_post;
+ dvi_back:=dvi_pointer;
+ end;
+end
+
+@ When a |bop| has been read, the \.{DVI} commands for one page are
+interpreted until an |eop| is found.
+
+@<DVI: Process one page@>=
+begin for k:=0 to 9 do count[k]:=dvi_squad;
+temp_int:=dvi_pointer; do_bop;
+dvi_first_par;
+if type_setting then @<DVI: Process a page; then |goto done|@>
+else @<DVI: Skip a page; then |goto done|@>;
+done:if cur_cmd<>eop then bad_dvi;
+if selected then
+ begin do_eop;
+ if all_done then return;
+ end;
+end
+
+@ All \.{DVI} commands are processed, as long as |cur_class<>invalid_cl|;
+then we should have found an |eop|.
+
+@<DVI: Process a page; then |goto done|@>=
+loop begin
+ case cur_class of
+ char_cl: @<DVI: Typeset a |char|@>;
+ rule_cl:
+ if cur_upd and(cur_v_dimen=width_dimen) then
+ do_a_width(h_pixel_round(cur_h_dimen))
+ else do_rule;
+ xxx_cl:
+ begin pckt_room(cur_parm);
+ while cur_parm>0 do
+ begin append_byte(dvi_ubyte); decr(cur_parm);
+ end;
+ do_xxx;
+ end;
+ push_cl: do_push;
+ pop_cl: do_pop;
+ five_cases(w0_cl): do_right; {|right|, |w|, or |x|}
+ five_cases(y0_cl): do_down; {|down|, |y|, or |z|}
+ fnt_cl: dvi_font;
+ fnt_def_cl: dvi_do_font(random_reading);
+ invalid_cl: goto done;
+ end; {there are no other cases}
+dvi_first_par; {get the next command}
+end
+
+@ While skipping a page all commands other than font definitions are
+ignored.
+
+@<DVI: Skip a page; then |goto done|@>=
+loop begin
+ case cur_class of
+ xxx_cl: while cur_parm>0 do
+ begin temp_byte:=dvi_ubyte; decr(cur_parm);
+ end;
+ fnt_def_cl: dvi_do_font(random_reading);
+ invalid_cl: goto done;
+ othercases do_nothing;
+ endcases;
+dvi_first_par; {get the next command}
+end
+
+@ @<DVI: Typeset a |char|@>=
+begin @<Prepare to use font |cur_fnt|@>;
+set_cur_wp(cur_fnt)(bad_dvi);
+if font_type(cur_fnt)=vf_font_type then do_vf_packet @+ else do_char;
+end
+
+@* The main program.
+The code for real devices is still rather incomplete.
+Moreover several branches of the program have not been tested because
+they are never used with \.{DVI} files made by \TeX\ and \.{VF} files
+made by \.{VPtoVF}.
+
+@ At the end of the program the output file(s) have to be finished and
+on some systems it may be necessary to close input and\slash or output
+files.
+@^system dependencies@>
+
+@p procedure close_files_and_terminate;
+var k:@!int_15; {general purpose index}
+begin close_in(dvi_file);
+if history<fatal_message then @<Finish output file(s)@>;
+stat @<Print memory usage statistics@>;@+tats@;@/
+@<Close output file(s)@>@;
+@<Print the job |history|@>;
+end;
+
+@ Now we are ready to put it all together.
+Here is where \.{\title} starts, and where it ends.
+@^system dependencies@>
+
+@p begin initialize; {get all variables initialized}
+@<Initialize predefined strings@>@;
+dialog; {get options}
+@<Open input file(s)@>@;
+@<Open output file(s)@>@;
+do_dvi; {process the entire \.{DVI} file}
+close_files_and_terminate;
+final_end:end.
+
+@ @<Print memory usage statistics@>=
+print_ln('Memory usage statistics:');
+print(dvi_nf:1,' dvi, ',lcl_nf:1,' local, ');
+@<Print more font usage statistics@>@;@/
+print_ln('and ',nf:1,' internal fonts of ',max_fonts:1);
+print_ln(n_widths:1,' widths of ',max_widths:1,' for ',
+ n_chars:1,' characters of ',max_chars:1);
+print_ln(pckt_ptr:1,' byte packets of ',max_packets:1,' with ',
+ byte_ptr:1,' bytes of ',max_bytes:1);
+@<Print more memory usage statistics@>@;@/
+print_ln(stack_used:1,' of ',stack_size:1,' stack and ',
+ recur_used:1,' of ',max_recursion:1,' recursion levels.')
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_ln('(No errors were found.)');
+harmless_message: print_ln('(Did you see the warning message above?)');
+error_message: print_ln('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_ln('(That was a fatal error, my friend.)');
+end {there are no other cases}
+
+@* Low-level output routines.
+The program uses the binary file variable |out_file| for its main output
+file; |out_loc| is the number of the byte about to be written next on
+|out_file|.
+
+@<Glob...@>=
+@!out_file:byte_file; {the \.{DVI} file we are writing}
+@!out_loc:int_32; {where we are about to write, in |out_file|}
+@!out_back:int_32; {a back pointer}
+@!out_max_v:int_31; {maximum |v| value so far}
+@!out_max_h:int_31; {maximum |h| value so far}
+@!out_stack:int_16u; {maximum stack depth}
+@!out_pages:int_16u; {total number of pages}
+
+@ @<Set ini...@>=
+out_loc:=0; out_back:=-1;
+out_max_v:=0; out_max_h:=0;
+out_stack:=0; out_pages:=0;
+
+@ To prepare |out_file| for output, we |rewrite| it.
+
+@<Open output file(s)@>=
+rewrite(out_file); {prepares to write packed bytes to |out_file|}
+
+@ For some operating systems it may be necessary to close |out_file|.
+
+@<Close output file(s)@>=
+
+@ Writing the |out_file| should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes will be accumulated in a buffer and is then written from that
+buffer to |out_file|. In order to simplify such system dependent changes
+we use the \.{WEB} macro |out_byte| to write the next \.{DVI} byte. Here
+we give a simple minded definition for this macro in terms of standard
+\PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d out_byte(#) == write(out_file,#) {write next \.{DVI} byte}
+
+@ The \.{WEB} macro |out_one| is used to write one byte and to update
+|out_loc|.
+
+@d out_one(#) == begin out_byte(#); incr(out_loc); @+ end
+
+@ First the |out_packet| procedure copies a packet to |out_file|.
+
+@<Declare typesetting procedures@>=
+procedure out_packet(@!p:pckt_pointer);
+var k:byte_pointer; {index into |byte_mem|}
+begin Incr(out_loc)(pckt_length(p));
+for k:=pckt_start[p] to pckt_start[p+1]-1 do out_byte(bo(byte_mem[k]));
+end;
+
+@ Next are the procedures used to write integer numbers or even complete
+\.{DVI} commands to |out_file|; they all keep |out_loc| up to date.
+
+The |out_four| procedure outputs four bytes in two's complement notation,
+without risking arithmetic overflow.
+
+@<Declare typesetting procedures@>=
+procedure out_four(@!x:int_32); {output four bytes}
+@!begin_four; comp_four(out_byte); Incr(out_loc)(4);
+end;
+
+@ The |out_char| procedure outputs a |set_char| or \\{set} command or, if
+|upd=false|, a |put| command.
+
+@<Declare typesetting procedures@>=
+procedure out_char(@!upd:boolean;@!ext:int_32;@!res:eight_bits);
+ {output \\{set} or |put|}
+@!begin_char; comp_char(out_one);
+end;
+
+@ The |out_unsigned| procedure outputs a |fnt|, |xxx|, or |fnt_def|
+command with its first parameter (normally unsigned); a |fnt| command
+is converted into |fnt_num| whenever this is possible.
+
+@<Declare typesetting procedures@>=
+procedure out_unsigned(@!o:eight_bits;@!x:int_32);
+ {output |fnt_num|, |fnt|, |xxx|, or |fnt_def|}
+@!begin_unsigned; comp_unsigned(out_one);
+end;
+
+@ The |out_signed| procedure outputs a movement (|right|, |w|,
+|x|, |down|, |y|, or |z|) command with its (signed) parameter.
+
+@<Declare typesetting procedures@>=
+procedure out_signed(@!o:eight_bits;@!x:int_32);
+ {output |right|, |w|, |x|, |down|, |y|, or |z|}
+@!begin_signed; comp_signed(out_one);
+end;
+
+@ For an output font we set |font_type(f):=out_font_type|; in this case
+|font_font(f)| is the font number used for font~|f| in |out_file|.
+@^font types@>
+
+The global variable |out_nf| is the number of fonts already used in
+|out_file| and the array |out_fnts| contains their internal font numbers;
+the current font in |out_file| is called |out_fnt|.
+
+@<Glob...@>=
+@!out_fnts:array[font_number] of font_number; {internal font numbers}
+@!out_nf:font_number; {number of fonts used in |out_file|}
+@!out_fnt:font_number; {internal font number of current output font}
+
+@ @<Set init...@>=
+out_nf:=0;
+
+@ @<Print more font usage statistics@>=
+print(out_nf:1,' out, ');
+
+@ The |out_fnt_def| procedure outputs a complete font definition
+command.
+
+@<Declare typesetting procedures@>=
+procedure out_fnt_def(@!f:font_number);
+var p:pckt_pointer; {the font name packet}
+@!k,@!l:byte_pointer; {indices into |byte_mem|}
+@!a:eight_bits; {length of area part}
+begin out_unsigned(fnt_def1,font_font(f)); out_four(font_check(f));
+out_four(font_scaled(f)); out_four(font_design(f));@/
+p:=font_name(f); k:=pckt_start[p]; l:=pckt_start[p+1]-1;
+a:=bo(byte_mem[k]);@/
+Incr(out_loc)(l-k+2); out_byte(a); out_byte(l-k-a);
+while k<l do
+ begin incr(k); out_byte(bo(byte_mem[k]));
+ end;
+end;
+
+@* Writing the output file.
+Here we define the device dependent parts of the typesetting routines
+described earlier in this program.
+
+First we define a few quantities required by the device dependent code
+for a real output device in order to demonstrate how they might be
+defined and in order to be able to compile \.{DVIcopy} with the device
+dependent code included.
+
+@d h_resolution==300 {horizontal resolution in pixels per inch (dpi)}
+@d v_resolution==300 {vertical resolution in pixels per inch (dpi)}
+
+@d max_h_drift==2 {we insist that |abs(hh-h_pixel_round(h))<=max_h_drift|}
+@d max_v_drift==2 {we insist that |abs(vv-v_pixel_round(v))<=max_v_drift|}
+
+@<Glob...@>=
+@!device
+@!h_conv:real; {converts \.{DVI} units to horizontal pixels}
+@!v_conv:real; {converts \.{DVI} units to vertical pixels}
+ecived
+
+@ These are the local variables (if any) needed for |do_pre|.
+
+@<OUT: Declare local variables (if any) for |do_pre|@>=
+var k:int_15; {general purpose variable}
+@!p,@!q,@!r:byte_pointer; {indices into |byte_mem|}
+@!comment:packed array[1..comm_length] of char; {preamble comment prefix}
+
+@ And here is the device dependent code for |do_pre|; the \.{DVI} preamble
+comment written to |out_file| is similar to the one produced by \.{GFtoPK},
+but we want to apply our preamble comment prefix only once.
+
+@<OUT: Process the |pre|@>=
+out_one(pre); out_one(dvi_id);
+out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/
+p:=pckt_start[pckt_ptr-1]; q:=byte_ptr; {location of old \.{DVI} comment}
+comment:=preamble_comment; pckt_room(comm_length);
+for k:=1 to comm_length do append_byte(xord[comment[k]]);
+while byte_mem[p]=bi(" ") do incr(p); {remove leading blanks}
+if p=q then Decr(byte_ptr)(from_length)
+else begin k:=0;
+ while (k<comm_length)and(byte_mem[p+k]=byte_mem[q+k]) do incr(k);
+ if k=comm_length then Incr(p)(comm_length);
+ end;
+k:=byte_ptr-p; {total length}
+if k>255 then
+ begin k:=255; q:=p+255-comm_length; {at most 255 bytes}
+ end;
+out_one(k); out_packet(new_packet); flush_packet;
+for r:=p to q-1 do out_one(bo(byte_mem[r]));
+
+@ These are the additional local variables (if any) needed for |do_bop|;
+the variables |@!i| and |@!j| are already declared.
+
+@<OUT: Declare additional local variables |do_bop|@>=
+var
+
+@ And here is the device dependent code for |do_bop|.
+
+@<OUT: Process a |bop|@>=
+out_one(bop); incr(out_pages);
+for i:=0 to 9 do out_four(count[i]);
+out_four(out_back); out_back:=out_loc-45;
+out_fnt:=invalid_font;
+
+@ These are the local variables (if any) needed for |do_eop|.
+
+@<OUT: Declare local variables (if any) for |do_eop|@>=
+
+@ And here is the device dependent code for |do_eop|.
+
+@<OUT: Process an |eop|@>=
+out_one(eop);
+
+@ These are the local variables (if any) needed for |do_push|.
+
+@<OUT: Declare local variables (if any) for |do_push|@>=
+
+@ And here is the device dependent code for |do_push|.
+
+@<OUT: Process a |push|@>=
+if stack_ptr>out_stack then out_stack:=stack_ptr;
+out_one(push);
+
+@ These are the local variables (if any) needed for |do_pop|.
+
+@<OUT: Declare local variables (if any) for |do_pop|@>=
+
+@ And here is the device dependent code for |do_pop|.
+
+@<OUT: Process a |pop|@>=
+out_one(pop);
+
+@ These are the additional local variables (if any) needed for |do_xxx|;
+the variable |@!p|, the pointer to the packet containing the special
+string, is already declared.
+
+@<OUT: Declare additional local variables for |do_xxx|@>=
+var
+
+@ And here is the device dependent code for |do_xxx|.
+
+@<OUT: Process an |xxx|@>=
+out_unsigned(xxx1,pckt_length(p)); out_packet(p);
+
+@ These are the local variables (if any) needed for |do_right|.
+
+@<OUT: Declare local variables (if any) for |do_right|@>=
+
+@ And here is the device dependent code for |do_right|.
+
+@<OUT: Process a |right| or |w| or |x|@>=
+if cur_class<right_cl then out_one(cur_cmd) {|w0| or |x0|}
+else out_signed(dvi_right_cmd[cur_class],cur_parm); {|right|, |w|, or |x|}
+
+@ Here we update the |out_max_h| value.
+
+@<OUT: Move right@>=
+if abs(cur_h)>out_max_h then out_max_h:=abs(cur_h);
+
+@ These are the local variables (if any) needed for |do_down|.
+
+@<OUT: Declare local variables (if any) for |do_down|@>=
+
+@ And here is the device dependent code for |do_down|.
+
+@<OUT: Process a |down| or |y| or |z|@>=
+if cur_class<down_cl then out_one(cur_cmd) {|y0| or |z0|}
+else out_signed(dvi_down_cmd[cur_class],cur_parm); {|down|, |y|, or |z|}
+
+@ Here we update the |out_max_v| value.
+
+@<OUT: Move down@>=
+if abs(cur_v)>out_max_v then out_max_v:=abs(cur_v);
+
+@ These are the local variables (if any) needed for |do_width|.
+
+@<OUT: Declare local variables (if any) for |do_width|@>=
+
+@ And here is the device dependent code for |do_width|.
+
+@<OUT: Typeset a |width|@>=
+out_one(set_rule);
+out_four(width_dimen); out_four(cur_h_dimen);
+
+@ These are the additional local variables (if any) needed for |do_rule|;
+the variable |@!visible| is already declared.
+
+@<OUT: Declare additional local variables |do_rule|@>=
+var
+
+@ And here is the device dependent code for |do_rule|.
+
+@<OUT: Typeset a visible |rule|@>=
+out_one(dvi_rule_cmd[cur_upd]);
+out_four(cur_v_dimen); out_four(cur_h_dimen);
+
+@ @<OUT: Typeset an invisible |rule|@>=
+@<OUT: Typeset a visible |rule|@>
+
+@ These are the additional local variables (if any) needed for |do_font|;
+the variable |@!p| is already declared.
+
+@<OUT: Declare additional local variables for |do_font|@>=
+var
+
+@ And here is the device dependent code for |do_font|; if the \.{VF} file
+for a font could not be found, we simply assume this must be a real font.
+
+@<OUT: Look for a font file before trying to read the \.{VF} file;
+ if found |goto done|@>=
+
+@ @<OUT: Look for a font file after trying to read the \.{VF} file@>=
+if(out_nf>=max_fonts) then overflow(str_fonts,max_fonts);
+print('OUT: font ',cur_fnt:1); d_print(' => ',out_nf:1);
+print_font(cur_fnt);
+d_print(' at ',font_scaled(cur_fnt):1,' DVI units'); print_ln('.');
+font_type(cur_fnt):=out_font_type; font_font(cur_fnt):=out_nf;
+out_fnts[out_nf]:=cur_fnt; incr(out_nf);
+out_fnt_def(cur_fnt);
+
+@ And here is some device dependent code used before each character.
+
+@<OUT: Prepare to use font |cur_fnt|@>=
+
+@ These are the local variables (if any) needed for |do_char|.
+
+@<OUT: Declare local variables (if any) for |do_char|@>=
+
+@ And here is the device dependent code for |do_char|.
+
+@<OUT: Typeset a |char|@>=
+@!debug if font_type(cur_fnt)<>out_font_type then confusion(str_fonts);
+gubed @;
+if cur_fnt<>out_fnt then
+ begin out_unsigned(fnt1,font_font(cur_fnt)); out_fnt:=cur_fnt;
+ end;
+out_char(cur_upd,cur_ext,cur_res);
+
+@ If the program terminates in the middle of a page, we write as many
+|pop|s as necessary and one |eop|.
+
+@<OUT: Finish incomplete page@>=
+begin while stack_ptr>0 do
+ begin out_one(pop); decr(stack_ptr);
+ end;
+ out_one(eop);
+end
+
+@ If the output file has been started, we write the postamble; in
+addition we print the number of bytes and pages written to |out_file|.
+
+@<OUT: Finish output file(s)@>=
+if out_loc>0 then
+ begin @<OUT: Write the postamble@>;
+ k:=7-((out_loc-1) mod 4); {the number of |dvi_pad| bytes}
+ while k>0 do
+ begin out_one(dvi_pad); decr(k);
+ end;
+ print('OUT file: ',out_loc:1,' bytes, ',out_pages:1,' page');
+ if out_pages<>1 then print('s');
+ end
+else print('OUT file: no output');
+print_ln(' written.');
+if out_pages=0 then mark_harmless;
+
+@ Here we simply write the values accumulated during the \.{DVI} output.
+
+@<OUT: Write the postamble@>=
+out_one(post); out_four(out_back); out_back:=out_loc-5;@/
+out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/
+out_four(out_max_v); out_four(out_max_h);@/
+out_one(out_stack div @"100); out_one(out_stack mod @"100);@/
+out_one(out_pages div @"100); out_one(out_pages mod @"100);@/
+k:=out_nf;
+while k>0 do
+ begin decr(k); out_fnt_def(out_fnts[k]);
+ end;
+out_one(post_post); out_four(out_back);@/
+out_one(dvi_id)
+
+@ Here we could print more memory usage statistics; this possibility is,
+however, not used for \.{DVIcopy}.
+
+@<Print more memory usage statistics@>=
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVIcopy} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/dvitomp.ch b/Build/source/texk/web2c/dvitomp.ch
new file mode 100644
index 00000000000..aff411c0edd
--- /dev/null
+++ b/Build/source/texk/web2c/dvitomp.ch
@@ -0,0 +1,860 @@
+% dvitomp.ch for C compilation with web2c.
+%
+% Copyright 1990 - 1995 by AT&T Bell Laboratories.
+%
+% Permission to use, copy, modify, and distribute this software
+% and its documentation for any purpose and without fee is hereby
+% granted, provided that the above copyright notice appear in all
+% copies and that both that the copyright notice and this
+% permission notice and warranty disclaimer appear in supporting
+% documentation, and that the names of AT&T Bell Laboratories or
+% any of its entities not be used in advertising or publicity
+% pertaining to distribution of the software without specific,
+% written prior permission.
+%
+% Change file for the DVItype processor, for use with WEB to C
+% This file was created by John Hobby. It is loosely based on the
+% change file for the WEB to C version of dvitype (due to Howard
+% Trickey and Pavel Curtis).
+%
+% 3/11/90 (JDH) Original version.
+% 4/30/90 (JDH) Update to handle virtual fonts
+% 4/16/93 (JDH) Make output go to standard output and require mpx file
+% to be a command line argument.
+%
+% 1/18/95 (UV) Update based on dvitype.ch for web2c-6.1
+% 4/13/95 (UV) Cosmetic changes for release of web2c-mp
+% 10/08/95 (UV) Bug fix: need to replace abs() with floating-point arg
+% by fabs() because of different definition in cpascal.h
+% as reported by Dane Dwyer <dwyer@geisel.csl.uiuc.edu>.
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{DVI$\,$\lowercase{to}MP changes for C}
+@z
+
+@x [1] Duplicate banner line for use in |print_version_and_exit|.
+@d banner=='% Written by DVItoMP, Version 0.64'
+ {the first line of the output file}
+@y
+@d banner=='% Written by DVItoMP, Version 0.64/color'
+ {the first line of the output file}
+@d term_banner=='This is DVItoMP, Version 0.64/color'
+ {the same in the usual format, as it would be shown on a terminal}
+@z
+
+@x [3] Set up kpathsea.
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin @<Set initial values@>@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin
+ kpse_set_progname (argv[0]); {initialize for the filename searches}
+ parse_arguments;
+ @<Set initial values@>@/
+@z
+
+@x [5] Increase parameter(s).
+@!virtual_space=10000;
+@y
+@!virtual_space=100000;
+@z
+
+@x [7] Remove non-local goto.
+@d abort(#)==begin err_print_ln('DVItoMP abort: ',#);
+ history:=fatal_error; jump_out;
+ end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+@d warn(#)==begin err_print_ln('DVItoMP warning: ',#);
+ history:=warning_given;
+ end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+@y
+@d jump_out==uexit(history)
+@d abort(#)==begin err_print_ln('DVItoMP abort: ',#);
+ history:=fatal_error; jump_out;
+ end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+@d warn(#)==begin err_print_ln('DVItoMP warning: ',#);
+ history:=warning_given;
+ end
+@z
+
+@x [11] Permissive input.
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+@y
+@!ASCII_code=0..255; {a subrange of the integers}
+@z
+
+% [12] The text_char type is used as an array index into `xord'. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@z
+
+@x [14] Fix up opening the files.
+@p procedure open_mpx_file; {prepares to write text on |mpx_file|}
+begin rewrite(mpx_file);
+end;
+@y
+@p procedure open_mpx_file; {prepares to write text on |mpx_file|}
+begin
+ cur_name := extend_filename (mpx_name, 'mpx');
+ rewrite (mpx_file, cur_name);
+end;
+@z
+
+@x [19] More file opening.
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+if eof(dvi_file) then abort('DVI file not found');
+end;
+@#
+function open_tfm_file:boolean; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_name);
+open_tfm_file:=(not eof(tfm_file));
+end;
+@#
+function open_vf_file:boolean; {prepares to read packed bytes in |vf_file|}
+begin reset(vf_file,cur_name);
+open_vf_file:=(not eof(vf_file));
+end;
+@y
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin
+ cur_name := extend_filename (dvi_name, 'dvi');
+ resetbin(dvi_file, cur_name);
+end;
+@#
+function open_tfm_file:boolean; {prepares to read packed bytes in |tfm_file|}
+begin
+ tfm_file := kpse_open_file (cur_name, kpse_tfm_format);
+ free (cur_name); {We |xmalloc|'d this before we got called.}
+ open_tfm_file := true; {If we get here, we succeeded.}
+end;
+@#
+function open_vf_file:boolean; {prepares to read packed bytes in |tfm_file|}
+var @!full_name:^char;
+begin
+ {It's ok if the \.{VF} file doesn't exist.}
+ full_name := kpse_find_vf (cur_name);
+ if full_name then begin
+ resetbin (vf_file, full_name);
+ free (cur_name);
+ free (full_name);
+ open_vf_file := true;
+ end else
+ open_vf_file := false;
+end;
+@z
+
+@x [24] No arbitrary limit on filename length.
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+@!cur_name:^char; {external name}
+@z
+
+@x [26] Make get_n_bytes routines work with 16-bit math.
+get_two_bytes:=a*256+b;
+@y
+get_two_bytes:=a*intcast(256)+b;
+@z
+@x
+get_three_bytes:=(a*256+b)*256+c;
+@y
+get_three_bytes:=(a*intcast(256)+b)*256+c;
+@z
+@x
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+@y
+if a<128 then signed_trio:=(a*intcast(256)+b)*256+c
+else signed_trio:=((a-intcast(256))*256+b)*256+c;
+@z
+@x
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+@y
+if a<128 then signed_quad:=((a*intcast(256)+b)*256+c)*256+d
+else signed_quad:=(((a-256)*intcast(256)+b)*256+c)*256+d;
+@z
+
+@x [32] l.672 Bugfix: local_only is indexed by internal font numbers.
+@!local_only:array [0..max_fonts] of boolean; {|font_num| meaningless?}
+@y
+@!local_only:array [0..max_fnums] of boolean; {|font_num| meaningless?}
+@z
+
+@x [41] Fix abs() with floating-point arg.
+ begin if abs(font_scaled_size[f]-font_scaled_size[ff])
+@y
+ begin if fabs(font_scaled_size[f]-font_scaled_size[ff])
+@z
+
+@x [43] Fix abs() with floating-point arg.
+if abs(font_design_size[f]-font_design_size[ff]) > font_tolerance then
+@y
+if fabs(font_design_size[f]-font_design_size[ff]) > font_tolerance then
+@z
+
+@x [43] Checksum warning: set history to cksum_trouble, not warning_given.
+ font_warn('Checksum mismatch for ')(ff)
+@.Checksum mismatch@>
+@y
+ begin err_print('DVItoMP warning: Checksum mismatch for ');
+@.Checksum mismatch@>
+ err_print_font(ff);
+ if history=spotless then history:=cksum_trouble;
+ end
+@z
+
+@x [46] Make 16-bit TFM calculations work.
+read_tfm_word; lh:=b2*256+b3;
+read_tfm_word; font_bc[f]:=b0*256+b1; font_ec[f]:=b2*256+b3;
+@y
+read_tfm_word; lh:=b2*intcast(256)+b3;
+read_tfm_word; font_bc[f]:=b0*intcast(256)+b1; font_ec[f]:=b2*intcast(256)+b3;
+@z
+@x
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3;
+@y
+ if b0<128 then tfm_check_sum:=((b0*intcast(256)+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*intcast(256)+b1)*256+b2)*256+b3;
+@z
+
+% For the code to work, Hobby notes that we need |round|(|x| - 0.5)
+% to be equal to $\lfloor x\rfloor$. For Pascal's |round| function
+% this is emphatically not true.
+@x [49] We need floor, not round.
+round(dvi_scale*font_scaled_size[f]*char_width(f)(c)-0.5)
+@y
+floor(dvi_scale*font_scaled_size[f]*char_width(f)(c))
+@z
+
+@x [50] We need floor, not round.
+round(dvi_scale*font_scaled_size[cur_font]*char_width(cur_font)(p)-0.5)
+@y
+floor(dvi_scale*font_scaled_size[cur_font]*char_width(cur_font)(p))
+@z
+
+@x [57] Off-by-one error in virtual font handling.
+info_ptr:=info_base[f]+font_ec[f]
+@y
+info_ptr:=info_base[f]+font_ec[f]+1
+@z
+
+% [61] Don't set default_directory_name.
+@x
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+@y
+There is no single |default_directory| with C.
+@z
+
+@x [62] Remove initialization of default_directory.
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+@y
+@ (No initialization needs to be done. Keep this module to preserve
+numbering.)
+@z
+
+@x [63] Dynamically allocate cur_name, don't add .vf.
+for k:=1 to name_length do cur_name[k]:=' ';
+if area_length[f]=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ l:=default_directory_name_length;
+ end
+else l:=0;
+for k:=font_name[f] to font_name[f+1]-1 do
+ begin incr(l);
+ if l+3>name_length then
+ abort('DVItoMP capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItoMP capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[l]:=xchr[names[k]-@'40]
+ else cur_name[l]:=xchr[names[k]];
+ end;
+cur_name[l+1]:='.'; cur_name[l+2]:='V'; cur_name[l+3]:='F'
+@y
+{This amounts to a string copy. }
+cur_name := xmalloc_array (char, font_name[f+1] - font_name[f]);
+for k:=font_name[f] to font_name[f+1]-1 do begin
+ cur_name[k - font_name[f]] := xchr[names[k]];
+end;
+cur_name[font_name[f+1] - font_name[f]] := 0;
+@z
+
+@x [64] Since we didn't add .vf, don't need to change it to .tfm.
+l:=area_length[f];
+if l=0 then l:=default_directory_name_length;
+l:=l+font_name[f+1]-font_name[f];
+if l+4>name_length then
+ abort('DVItoMP capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItoMP capacity exceeded...@>
+cur_name[l+2]:='T'; cur_name[l+3]:='F'; cur_name[l+4]:='M'
+@y
+do_nothing
+@z
+
+@x [75] Handle colored text. (COLOR)
+print_ln('vardef _s(expr _t,_f,_m,_x,_y)=');
+print_ln(' addto _p also _t infont _f scaled _m shifted (_x,_y); enddef;');
+@y
+print_ln('vardef _s(expr _t,_f,_m,_x,_y)(text _c)=');
+print_ln(' addto _p also _t infont _f scaled _m shifted (_x,_y) _c; enddef;');
+@z
+
+@x [78] Fix printing of real numbers, and add color (COLOR).
+ if (abs(x)>=4096.0)or(abs(y)>=4096.0)or(m>=4096.0)or(m<0) then
+ begin warn('text scaled ',m:1:1,@|
+ ' at (',x:1:1,',',y:1:1,') is out of range');
+ end_char_string(60);
+ end
+ else end_char_string(40);
+ print_ln(',_n',str_f:1,',',m:1:5,',',x:1:4,',',y:1:4,');');
+@y
+ if (fabs(x)>=4096.0)or(fabs(y)>=4096.0)or(m>=4096.0)or(m<0) then
+ begin warn('text is out of range');
+ end_char_string(60);
+ end
+ else end_char_string(40);
+ print(',_n',str_f:1,',');
+ fprint_real(mpx_file, m,1,5); print(',');
+ fprint_real(mpx_file, x,1,4); print(',');
+ fprint_real(mpx_file, y,1,4); print(',');@/
+ @<Print a \.{withcolor} specifier if appropriate@>@/
+ print_ln(');');
+@z
+
+@x [79] Fix _r definition (COLOR).
+ print_ln('vardef _r(expr _a,_w) =');
+ print_ln(' addto _p doublepath _a withpen pencircle scaled _w enddef;');
+@y
+ print_ln('vardef _r(expr _a,_w)(text _t) =');
+ print_ln(' addto _p doublepath _a withpen pencircle scaled _w _t enddef;');
+@z
+
+@x [79] Another fix for printing of real numbers, plus colors (COLOR).
+ if (abs(xx1)>=4096.0)or(abs(yy1)>=4096.0)or@|
+ (abs(xx2)>=4096.0)or(abs(yy2)>=4096.0)or(ww>=4096.0) then
+ warn('hrule or vrule near (',xx1:1:1,',',yy1:1:1,') is out of range');
+ print_ln('_r((',xx1:1:4,',',yy1:1:4,')..(',xx2:1:4,',',yy2:1:4,
+ '), ',ww:1:4,');');
+@y
+ if (fabs(xx1)>=4096.0)or(fabs(yy1)>=4096.0)or@|
+ (fabs(xx2)>=4096.0)or(fabs(yy2)>=4096.0)or(ww>=4096.0) then
+ warn('hrule or vrule is out of range');
+ print('_r((');
+ fprint_real(mpx_file, xx1,1,4); print(',');
+ fprint_real(mpx_file, yy1,1,4); print(')..(');
+ fprint_real(mpx_file, xx2,1,4); print(',');
+ fprint_real(mpx_file, yy2,1,4); print('), ');
+ fprint_real(mpx_file, ww,1,4); print(',');
+ @<Print a \.{withcolor} specifier if appropriate@>@/
+ print_ln(');');
+@z
+
+@x [80] Yet another fix for printing of real numbers.
+print_ln('setbounds _p to (0,',dd:1:4,')--(',w:1:4,',',dd:1:4,')--');
+print_ln(' (',w:1:4,',',h:1:4,')--(0,',h:1:4,')--cycle;')
+@y
+print('setbounds _p to (0,');
+fprint_real(mpx_file, dd,1,4); print(')--(');
+fprint_real(mpx_file, w,1,4); print(',');
+fprint_real(mpx_file, dd,1,4); print_ln(')--');@/
+print(' (');
+fprint_real(mpx_file, w,1,4); print(',');
+fprint_real(mpx_file, h,1,4); print(')--(0,');
+fprint_real(mpx_file, h,1,4); print_ln(')--cycle;')
+@z
+
+@x [88] push and pop commands (COLOR).
+@p procedure do_push;
+@y
+@p @<Declare procedures to handle color commands@>
+procedure do_push;
+@z
+
+@x [94] Additional cases for DVI commands (COLOR).
+four_cases(xxx1): for k:=1 to p do
+ down_the_drain:=get_byte;
+@y
+four_cases(xxx1): do_xxx(p);
+@z
+
+@x [98] Main program.
+print_ln(banner);
+@y
+print (banner);
+print_ln (version_string);
+@z
+@x Exit with appropriate status.
+final_end:end.
+@y
+if history<=cksum_trouble then uexit(0)
+else uexit(history);
+end.
+@z
+
+@x [103] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVItoMP} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 2; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('dvitomp');
+
+ end else if argument_is ('help') then begin
+ usage_help (DVITOMP_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (term_banner, 'AT&T Bell Laboraties', 'John Hobby');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one or two remaining arguments.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ write_ln (stderr, 'dvitomp: Need one or two file arguments.');
+ usage ('dvitomp');
+ end;
+
+ dvi_name := cmdline (optind);
+
+ if optind + 2 <= argc then begin
+ mpx_name := cmdline (optind + 1); {The user specified the other name.}
+ end else begin
+ {User did not specify the other name; default it from the first.}
+ mpx_name := basename_change_suffix (dvi_name, '.dvi', '.mpx');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!dvi_name, @!mpx_name:c_string;
+
+
+
+@* Color support.
+These changes support \.{dvips}-style ``\.{color push NAME}'' and
+``\.{color pop}'' specials. We store a list of named colors, sorted by
+name, and decorate the relevant drawing commands with ``\.{withcolor
+(r,g,b)}'' specifiers while a color is defined.
+
+@ A constant bounding the size of the named-color array.
+
+@<Constants...@> =
+@!max_named_colors=100; {maximum number of distinct named colors}
+
+@ Then we declare a record for color types.
+
+@<Types...@> =
+@!named_color_record=record@;@/
+ @!name:c_string; {color name}
+ @!value:c_string; {text to pass to MetaPost}
+ end;
+
+@ Declare the named-color array itself.
+
+@<Globals...@> =
+@!named_colors: array[1..max_named_colors] of named_color_record;
+ {stores information about named colors, in sorted order by name}
+@!num_named_colors:integer; {number of elements of |named_colors| that are valid}
+
+@ This function, used only during initialization, defines a named color.
+
+@<Define |parse_arguments|@> =
+procedure def_named_color(n,v: c_string);
+ begin
+ if num_named_colors = max_named_colors then
+ abort('too many named color definitions')
+ else if (num_named_colors > 0)
+ and (strcmp(n, named_colors[num_named_colors].name) <= 0)
+ then
+ abort('named colors added out of alphabetical order');
+ incr(num_named_colors);
+ named_colors[num_named_colors].name := n;
+ named_colors[num_named_colors].value := v
+ end;
+
+@ During the initialization phase, we define values for all the named
+colors defined in \.{colordvi.tex}. CMYK-to-RGB conversion by GhostScript.
+
+@<Set initial values@> =
+num_named_colors := 0;
+def_named_color('Apricot', '(1.0, 0.680006, 0.480006)');
+def_named_color('Aquamarine', '(0.180006, 1.0, 0.7)');
+def_named_color('Bittersweet', '(0.760012, 0.0100122, 0.0)');
+def_named_color('Black', '(0.0, 0.0, 0.0)');
+def_named_color('Blue', '(0.0, 0.0, 1.0)');
+def_named_color('BlueGreen', '(0.15, 1.0, 0.669994)');
+def_named_color('BlueViolet', '(0.1, 0.05, 0.960012)');
+def_named_color('BrickRed', '(0.719994, 0.0, 0.0)');
+def_named_color('Brown', '(0.4, 0.0, 0.0)');
+def_named_color('BurntOrange', '(1.0, 0.489988, 0.0)');
+def_named_color('CadetBlue', '(0.380006, 0.430006, 0.769994)');
+def_named_color('CarnationPink', '(1.0, 0.369994, 1.0)');
+def_named_color('Cerulean', '(0.0600122, 0.889988, 1.0)');
+def_named_color('CornflowerBlue', '(0.35, 0.869994, 1.0)');
+def_named_color('Cyan', '(0.0, 1.0, 1.0)');
+def_named_color('Dandelion', '(1.0, 0.710012, 0.160012)');
+def_named_color('DarkOrchid', '(0.6, 0.2, 0.8)');
+def_named_color('Emerald', '(0.0, 1.0, 0.5)');
+def_named_color('ForestGreen', '(0.0, 0.880006, 0.0)');
+def_named_color('Fuchsia', '(0.45, 0.00998169, 0.919994)');
+def_named_color('Goldenrod', '(1.0, 0.9, 0.160012)');
+def_named_color('Gray', '(0.5, 0.5, 0.5)');
+def_named_color('Green', '(0.0, 1.0, 0.0)');
+def_named_color('GreenYellow', '(0.85, 1.0, 0.310012)');
+def_named_color('JungleGreen', '(0.0100122, 1.0, 0.480006)');
+def_named_color('Lavender', '(1.0, 0.519994, 1.0)');
+def_named_color('LimeGreen', '(0.5, 1.0, 0.0)');
+def_named_color('Magenta', '(1.0, 0.0, 1.0)');
+def_named_color('Mahogany', '(0.65, 0.0, 0.0)');
+def_named_color('Maroon', '(0.680006, 0.0, 0.0)');
+def_named_color('Melon', '(1.0, 0.539988, 0.5)');
+def_named_color('MidnightBlue', '(0.0, 0.439988, 0.569994)');
+def_named_color('Mulberry', '(0.640018, 0.0800061, 0.980006)');
+def_named_color('NavyBlue', '(0.0600122, 0.460012, 1.0)');
+def_named_color('OliveGreen', '(0.0, 0.6, 0.0)');
+def_named_color('Orange', '(1.0, 0.389988, 0.130006)');
+def_named_color('OrangeRed', '(1.0, 0.0, 0.5)');
+def_named_color('Orchid', '(0.680006, 0.360012, 1.0)');
+def_named_color('Peach', '(1.0, 0.5, 0.3)');
+def_named_color('Periwinkle', '(0.430006, 0.45, 1.0)');
+def_named_color('PineGreen', '(0.0, 0.75, 0.160012)');
+def_named_color('Plum', '(0.5, 0.0, 1.0)');
+def_named_color('ProcessBlue', '(0.0399878, 1.0, 1.0)');
+def_named_color('Purple', '(0.55, 0.139988, 1.0)');
+def_named_color('RawSienna', '(0.55, 0.0, 0.0)');
+def_named_color('Red', '(1.0, 0.0, 0.0)');
+def_named_color('RedOrange', '(1.0, 0.230006, 0.130006)');
+def_named_color('RedViolet', '(0.590018, 0.0, 0.660012)');
+def_named_color('Rhodamine', '(1.0, 0.180006, 1.0)');
+def_named_color('RoyalBlue', '(0.0, 0.5, 1.0)');
+def_named_color('RoyalPurple', '(0.25, 0.1, 1.0)');
+def_named_color('RubineRed', '(1.0, 0.0, 0.869994)');
+def_named_color('Salmon', '(1.0, 0.469994, 0.619994)');
+def_named_color('SeaGreen', '(0.310012, 1.0, 0.5)');
+def_named_color('Sepia', '(0.3, 0.0, 0.0)');
+def_named_color('SkyBlue', '(0.380006, 1.0, 0.880006)');
+def_named_color('SpringGreen', '(0.739988, 1.0, 0.239988)');
+def_named_color('Tan', '(0.860012, 0.580006, 0.439988)');
+def_named_color('TealBlue', '(0.119994, 0.980006, 0.640018)');
+def_named_color('Thistle', '(0.880006, 0.410012, 1.0)');
+def_named_color('Turquoise', '(0.15, 1.0, 0.8)');
+def_named_color('Violet', '(0.210012, 0.119994, 1.0)');
+def_named_color('VioletRed', '(1.0, 0.189988, 1.0)');
+def_named_color('White', '(1.0, 1.0, 1.0)');
+def_named_color('WildStrawberry', '(1.0, 0.0399878, 0.610012)');
+def_named_color('Yellow', '(1.0, 1.0, 0.0)');
+def_named_color('YellowGreen', '(0.560012, 1.0, 0.260012)');
+def_named_color('YellowOrange', '(1.0, 0.580006, 0.0)');
+
+@ Color commands get a separate warning procedure. |warn| sets |history :=
+warning_given|, which causes a nonzero exit status; but color errors are
+trivial and should leave the exit status zero.
+
+@d color_warn(#)==begin err_print_ln('DVItoMP warning: ',#); if history < warning_given then history := cksum_trouble; end
+
+@ The |do_xxx| procedure handles DVI specials (defined with the
+|xxx1...xxx4| commands).
+
+@<Declare procedures to handle color commands@> =
+procedure do_xxx(p: integer);
+label 9999; {exit procedure}
+const bufsiz = 256; {FIXME: Fixed size buffer.}
+var buf: packed array[0..bufsiz] of eight_bits;
+ l, r, m, k, len: integer;
+ found: boolean;
+begin
+ len := 0;
+ while (p > 0) and (len < bufsiz) do begin
+ buf[len] := get_byte;
+ decr(p); incr(len);
+ end;
+ @<Check whether |buf| contains a color command; if not, |goto 9999|@>
+ if p > 0 then begin
+ color_warn('long "color" special ignored'); goto 9999; end;
+ if @<|buf| contains a color pop command@> then begin
+ @<Handle a color pop command@>
+ end else if @<|buf| contains a color push command@> then begin
+ @<Handle a color push command@>
+ end else begin
+ color_warn('unknown "color" special ignored'); goto 9999; end;
+9999: for k := 1 to p do down_the_drain := get_byte;
+end;
+
+@
+
+@<Check whether |buf| contains a color command; if not, |goto 9999|@> =
+if (len <= 5)
+ or (buf[0] <> "c")
+ or (buf[1] <> "o")
+ or (buf[2] <> "l")
+ or (buf[3] <> "o")
+ or (buf[4] <> "r")
+ or (buf[5] <> " ")
+ then goto 9999;
+
+@
+
+@<|buf| contains a color push command@> =
+(len >= 11) and (buf[6] = "p") and (buf[7] = "u") and (buf[8] = "s") and (buf[9] = "h") and (buf[10] = " ")
+
+@
+
+@<|buf| contains a color pop command@> =
+(len = 9) and (buf[6] = "p") and (buf[7] = "o") and (buf[8] = "p")
+
+@ The \.{color push} and \.{pop} commands imply a color stack, so we need a
+global variable to hold that stack.
+
+@<Constants...@> =
+max_color_stack_depth=10; {maximum depth of saved color stack}
+
+@ Here's the actual stack variables.
+
+@<Globals...@> =
+color_stack_depth: integer; {current depth of saved color stack}
+color_stack: array[1..max_color_stack_depth] of c_string; {saved color stack}
+
+@ Initialize the stack to empty.
+
+@<Set initial values@> =
+color_stack_depth := 0;
+
+@ \.{color pop} just pops the stack.
+
+@<Handle a color pop command@> =
+finish_last_char;
+if color_stack_depth > 0 then begin
+ free(color_stack[color_stack_depth]);
+ decr(color_stack_depth)
+end
+else begin
+ color_warn('color stack underflow')
+end;
+
+@ \.{color push} pushes a color onto the stack.
+
+@<Handle a color push command@> =
+finish_last_char;
+if color_stack_depth >= max_color_stack_depth then
+ abort('color stack overflow');
+incr(color_stack_depth);
+{ I don't know how to do string operations in Pascal. }
+{ Skip over extra spaces after 'color push'. }
+l := 11;
+while (l < len - 1) and (buf[l] = " ") do incr(l);
+if @<|buf[l]| contains an rgb command@> then begin
+ @<Handle a color push rgb command@>
+end else if @<|buf[l]| contains a cmyk command@> then begin
+ @<Handle a color push cmyk command@>
+end else if @<|buf[l]| contains a gray command@> then begin
+ @<Handle a color push gray command@>
+end else begin
+ @<Handle a named color push command@>
+end;
+
+@
+
+@<|buf[l]| contains an rgb command@> =
+(l + 4 < len)
+and (buf[l] = "r")
+and (buf[l+1] = "g")
+and (buf[l+2] = "b")
+and (buf[l+3] = " ")
+
+@
+
+@<Handle a color push rgb command@> =
+l := l + 4;
+while (l < len) and (buf[l] = " ") do incr(l);
+{ Remove spaces at end of buf }
+while (len > l) and (buf[len - 1] = " ") do decr(len);
+color_stack[color_stack_depth]:=xmalloc_array(char,len-l+3);
+k := 0;
+@<Copy |buf[l]| to |color_stack[color_stack_depth][k]| in tuple form@>
+
+@
+
+@<|buf[l]| contains a gray command@> =
+(l + 5 < len)
+and (buf[l] = "g")
+and (buf[l+1] = "r")
+and (buf[l+2] = "a")
+and (buf[l+3] = "y")
+and (buf[l+4] = " ")
+
+@
+
+@<Handle a color push gray command@> =
+l := l + 5;
+while (l < len) and (buf[l] = " ") do incr(l);
+{ Remove spaces at end of buf }
+while (len > l) and (buf[len - 1] = " ") do decr(len);
+color_stack[color_stack_depth]:=xmalloc_array(char,len-l+9);
+strcpy(color_stack[color_stack_depth],'white*');
+k := 6;
+@<Copy |buf[l]| to |color_stack[color_stack_depth][k]| in tuple form@>
+
+@
+
+@<|buf[l]| contains a cmyk command@> =
+(l + 5 < len)
+and (buf[l] = "c")
+and (buf[l+1] = "m")
+and (buf[l+2] = "y")
+and (buf[l+3] = "k")
+and (buf[l+4] = " ")
+
+@
+
+@<Handle a color push cmyk command@> =
+l := l + 5;
+while (l < len) and (buf[l] = " ") do incr(l);
+{ Remove spaces at end of buf }
+while (len > l) and (buf[len - 1] = " ") do decr(len);
+color_stack[color_stack_depth]:=xmalloc_array(char,len-l+7);
+strcpy(color_stack[color_stack_depth],'cmyk');
+k := 4;
+@<Copy |buf[l]| to |color_stack[color_stack_depth][k]| in tuple form@>
+
+@
+
+@<Copy |buf[l]| to |color_stack[color_stack_depth][k]| in tuple form@> =
+color_stack[color_stack_depth][k] := "(";
+incr(k);
+while l < len do
+ if buf[l] = " " then begin
+ color_stack[color_stack_depth][k] := ",";
+ while (l < len) and (buf[l] = " ") do incr(l);
+ incr(k);
+ end else begin
+ color_stack[color_stack_depth][k] := buf[l];
+ incr(l);
+ incr(k);
+ end;
+color_stack[color_stack_depth][k] := ")";
+color_stack[color_stack_depth][k+1] := chr(0)
+
+@ Binary-search the |named_colors| array, then push the found color onto
+the stack.
+
+@<Handle a named color push command@> =
+for k := l to len - 1 do begin
+ buf[k - l] := xchr[buf[k]];
+end;
+buf[len - l] := 0;
+len := len - l;
+l := 1; r := num_named_colors;
+found := false;
+while (l <= r) and not found do begin
+ m := (l + r) / 2;
+ k := strcmp(buf, named_colors[m].name);
+ if k = 0 then begin
+ color_stack[color_stack_depth]:=xstrdup(named_colors[m].value);
+ found := true;
+ end else if k < 0 then
+ r := m - 1
+ else
+ l := m + 1;
+end;
+if not found then begin
+ color_warn('non-hardcoded color "',stringcast(buf),'" in "color push" command');
+ color_stack[color_stack_depth]:=xstrdup(buf);
+end;
+
+@ Last but not least, this code snippet prints a \.{withcolor} specifier
+for the top of the color stack, if the stack is nonempty.
+
+@<Print a \.{withcolor} specifier if appropriate@> =
+if color_stack_depth > 0 then begin
+ print(' withcolor ');
+ fputs(color_stack[color_stack_depth], mpx_file);
+end;
+
+@z
diff --git a/Build/source/texk/web2c/dvitomp.mk b/Build/source/texk/web2c/dvitomp.mk
new file mode 100644
index 00000000000..9a7efd5f0a1
--- /dev/null
+++ b/Build/source/texk/web2c/dvitomp.mk
@@ -0,0 +1,27 @@
+# Makefile fragment for DVItoMP.
+# $Id: dvitomp.mk,v 1.1 2005/06/21 16:03:15 olaf Exp $
+#
+# Public domain.
+#
+# This facilitates a separate development track for DVItoMP.
+
+Makefile: dvitomp.mk
+
+dvitomp: dvitomp.o
+ $(kpathsea_link) dvitomp.o $(LOADLIBES)
+dvitomp.c dvitomp.h: $(web2c_common) $(web2c_programs) dvitomp.p
+ $(web2c) dvitomp
+dvitomp.p: tangle dvitomp.web dvitomp.ch
+ $(tangle) dvitomp dvitomp
+check: dvitomp-check
+dvitomp-check: dvitomp
+ TEXMFCNF=../kpathsea \
+ ./dvitomp $(srcdir)/tests/story.dvi tests/xstory.mpx
+ TFMFONTS=$(srcdir)/tests VFFONTS=$(srcdir)/tests: \
+ ./dvitomp $(srcdir)/tests/ptmr
+ mv ptmr.mpx tests/xptmr.mpx
+clean:: dvitomp-clean
+dvitomp-clean:
+ $(LIBTOOL) --mode=clean rm -f dvitomp
+ rm -f dvitomp.o dvitomp.c dvitomp.h dvitomp.p
+ rm -f tests/xstory.mpx tests/xptmr.mpx
diff --git a/Build/source/texk/web2c/dvitomp.rc b/Build/source/texk/web2c/dvitomp.rc
new file mode 100644
index 00000000000..436ab7e46ac
--- /dev/null
+++ b/Build/source/texk/web2c/dvitomp.rc
@@ -0,0 +1,35 @@
+/* dvitomp.rc: dvitomp resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " dvitomp 0.64"
+
+#define VER_INTERNALNAME_STR "dvitomp"
+#define VER_ORIGINALFILENAME_STR "dvitomp.exe"
+
+#define VER_LEGALCOPYRIGHT_STR " Copyright 1990 - 1995 by AT&T Bell Laboratories"
+#define VER_COMPANYNAME_STR "AT&T Bell Laboratories"
+
+#define VER_FILEDESCRIPTION_STR "DVI-to-MetaPost Converter"
+
+#include <texlive.version>
+
+/* dvitomp.rc ends here */
diff --git a/Build/source/texk/web2c/dvitomp.web b/Build/source/texk/web2c/dvitomp.web
new file mode 100644
index 00000000000..c850ceb7f8f
--- /dev/null
+++ b/Build/source/texk/web2c/dvitomp.web
@@ -0,0 +1,1688 @@
+% Copyright 1990 - 1995 by AT&T Bell Laboratories.
+
+% Permission to use, copy, modify, and distribute this software
+% and its documentation for any purpose and without fee is hereby
+% granted, provided that the above copyright notice appear in all
+% copies and that both that the copyright notice and this
+% permission notice and warranty disclaimer appear in supporting
+% documentation, and that the names of AT&T Bell Laboratories or
+% any of its entities not be used in advertising or publicity
+% pertaining to distribution of the software without specific,
+% written prior permission.
+
+% AT&T disclaims all warranties with regard to this software,
+% including all implied warranties of merchantability and fitness.
+% In no event shall AT&T be liable for any special, indirect or
+% consequential damages or any damages whatsoever resulting from
+% loss of use, data or profits, whether in an action of contract,
+% negligence or other tortious action, arising out of or in
+% connection with the use or performance of this software.
+
+
+% Version 0 was prepared (March 1990).
+% Version 0.1 implemented virtual fonts. (May 1990)
+% Version 0.30 outputs setbounds statments, ignores rules 1sp wide (May 1991)
+% Version 0.60 outputs rules as penstrokes with butt ends
+% Version 0.62 makes the output more robust when used in a macro definition
+% Version 0.63 new version number only (Unix change file has // path searching)
+% Version 0.632 outputs a setbounds path even if no 1sp vrule appears (Jan 1997)
+% Version 0.64 avoids outputting wrong fonts, improves error handling (Jan 1998)
+
+% Although considerable effort has been expended to make the DVItoMP program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software.
+
+% This program is loosely based on DVItype Version 3.0
+% It converts a DVI file into a sequence of MetaPost picture expressions.
+
+% TeX is a trademark of the American Mathematical Society.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\font\sc=cmcsc10
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\MP{MetaPost}
+\def\LaTeX{{\rm L\kern-.36em\raise.3ex\hbox{\sc a}\kern-.15em
+ T\kern-.1667em\lower.7ex\hbox{E}\kern-.125emX}}
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{DVI$\,$\lowercase{to}MP}
+\def\contentspagenumber{1}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont DVItoMP} processor}
+ \vskip 15pt
+ \centerline{(Version 0.64, January 1998)}
+ \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{DVItoMP} program reads binary device-independent (``\.{DVI}'')
+files that are produced by document compilers such as \TeX, and converts them
+into a symbolic form understood by \MP. It is loosely based on the \.{DVItype}
+utility program that produces a more faithful symbolic form of a \.{DVI} file.
+
+The output file is a sequence of \MP\ picture expressions, one for every page
+in the \.{DVI} file. It makes no difference to \.{DVItoMP} where the \.{DVI}
+file comes from, but it is intended to process the result of running \TeX\
+or \LaTeX\ on the output of \.{MPtoTEX}. Such a \.{DVI} file will contain
+one page for every \.{btex}$\ldots$\.{etex} block in the original input.
+Processing in with \.{DVItoMP} creates a corresponding sequence of \MP\ picture
+expressions for use as an auxiliary input file. Since \MP\ expects such files
+to have the extension \.{.MPX}, the output of \.{DVItoMP} is sometimes called
+an ``\.{MPX}'' file.
+
+The |banner| string defined here should be changed whenever \.{DVItoMP}
+gets modified.
+
+@d banner=='% Written by DVItoMP, Version 0.64'
+ {the first line of the output file}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{DVItoMP} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+All places where nonstandard constructions are used have been listed in
+the index under ``system dependencies.''
+@!@^system dependencies@>
+
+Many \.{DVI}-reading programs need the ability to move to a random place
+in a binary file. \.{DVItoMP} does not need to do this, but it does use
+a default |case| as in \.{TANGLE}, \.{WEAVE}, etc.
+
+@ The binary input comes from |dvi_file|, and the symbolic output goes to
+|mpx_file|. \PASCAL's standard |output| file is used only to print an error
+message if the \.{DVI} file is bad. The term |print| is used instead of
+|write| when this program writes on |mpx_file| just in case this helps
+some installations deal with system dependencies.
+@^system dependencies@>
+
+@d print(#)==write(mpx_file,#)
+@d print_ln(#)==write_ln(mpx_file,#)
+@d err_print(#)==write(#)
+@d err_print_ln(#)==write_ln(#)
+
+@p program DVI_to_MP(@!dvi_file,@!mpx_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'. Another label, |done|, is used when stopping normally.
+
+@d final_end=9999 {label for the end of it all}
+@d done=30 {go here when finished with a subtask}
+
+@<Labels...@>=final_end,done;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{DVItoMP}'s capacity.
+
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
+@!max_fnums=300; {maximum number of fonts plus fonts local to virtual fonts}
+@!max_widths=10000; {maximum number of different characters among all fonts}
+@!virtual_space=10000;
+ {maximum total bytes of typesetting commands for virtual fonts}
+@!line_length=79; {maximum output line length (must be at least 60)}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!name_size=1000; {total length of all font file names}
+@!name_length=50; {a file name shouldn't be longer than this}
+
+@ There is one more parameter that is a little harder to change because
+it is of type |real|.
+
+@d font_tolerance==0.00001
+ {font sizes should match to within this multiple of $2^{20}$ \.{DVI} units}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ A global variable |history| keeps track of what type of errors have
+occurred with the hope that that \MP\ can be warned of any problems.
+
+@d spotless=0 {|history| value when no problems have been found}
+@d cksum_trouble=1 {|history| value there have been font checksum mismatches}
+@d warning_given=2 {|history| value after a recoverable error}
+@d fatal_error=3 {|history| value if processing had to be aborted}
+
+@<Glob...@>=
+history:spotless..fatal_error;
+
+@ @<Set init...@>=
+history:=spotless;
+
+@ If the \.{DVI} file is badly malformed, the whole process must be aborted;
+\.{DVItoMP} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{DVItoMP}.
+@^system dependencies@>
+
+@d abort(#)==begin err_print_ln('DVItoMP abort: ',#);
+ history:=fatal_error; jump_out;
+ end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+@d warn(#)==begin err_print_ln('DVItoMP warning: ',#);
+ history:=warning_given;
+ end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{DVItoMP} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used, and because \.{DVI} files use ASCII code for file names.
+
+The next few sections of \.{DVItoMP} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{DVItoMP} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+If such codes appear in the font names,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{DVItoMP}.
+So we shall assume that the \PASCAL\ system being used for \.{DVItoMP}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{DVItoMP} processor converts from ASCII code to
+the user's external character set by means of an array |xchr|
+that is analogous to \PASCAL's |chr| function.
+
+@<Globals...@>=
+@!mpx_file:text_file; {destination for printed output}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ To prepare the |mpx_file| for output, we |rewrite| it.
+@^system dependencies@>
+
+@p procedure open_mpx_file; {prepares to write text on |mpx_file|}
+begin rewrite(mpx_file);
+end;
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@* Device-independent file format.
+The format of \.{DVI} files is described in many places including
+\.{dvitype.web} and Volume~B of D.~E. Knuth's {\sl Computers and Typesetting}.
+This program refers to the following command codes.
+
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+@#
+@d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@* Input from binary files.
+We have seen that a \.{DVI} file is a sequence of 8-bit bytes. The bytes
+appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{DVItoMP} is written in standard \PASCAL.
+@^system dependencies@>
+
+One common way to solve the problem is to consider files of |integer|
+numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
+a sequence of four bytes $(a,b,c,d)$ using the following code, which
+avoids the controversial integer division of negative numbers:
+$$\vbox{\halign{#\hfil\cr
+|if x>=0 then a:=x div @'100000000|\cr
+|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
+\quad|end|\cr
+|x:=x mod @'100000000;|\cr
+|b:=x div @'200000; x:=x mod @'200000;|\cr
+|c:=x div @'400; d:=x mod @'400;|\cr}}$$
+The four bytes are then kept in a buffer and output one by one. (On 36-bit
+computers, an additional division by 16 is necessary at the beginning.
+Another way to separate an integer into four bytes is to use/abuse
+\PASCAL's variant records, storing an integer and retrieving bytes that are
+packed in the same place; {\sl caveat implementor!\/}) It is also desirable
+in some cases to read a hundred or so integers at a time, maintaining a
+larger buffer.
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with two binary file variables: |dvi_file| is the main
+input file that we are translating into symbolic form, and |tfm_file| is
+the current font metric file from which character-width information is
+being read. It is convenient to have a throw-away variable for function
+results when reading parts of the files that are being skipped.
+
+@<Glob...@>=
+@!dvi_file:byte_file; {the input file}
+@!tfm_file:byte_file; {a font metric file}
+@!vf_file:byte_file; {a virtual font file}
+@!down_the_drain:integer; {a ``write-only'' variable}
+
+@ To prepare these files for input, we |reset| them. An extension of
+\PASCAL\ is needed in the case of |tfm_file|, since we want to associate
+it with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after |reset(f,s)|
+has acted, these routines assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+if eof(dvi_file) then abort('DVI file not found');
+end;
+@#
+function open_tfm_file:boolean; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_name);
+open_tfm_file:=(not eof(tfm_file));
+end;
+@#
+function open_vf_file:boolean; {prepares to read packed bytes in |vf_file|}
+begin reset(vf_file,cur_name);
+open_vf_file:=(not eof(vf_file));
+end;
+
+@ If you looked carefully at the preceding code, you probably asked,
+``What is |cur_name|?'' Good question. It's a global
+variable: |cur_name| is a string variable that will be set to the
+current font metric file name before |open_tfm_file| is called.
+
+@<Glob...@>=
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+
+@ It turns out to be convenient to read four bytes at a time, when we are
+inputting from \.{TFM} files. The input goes into global variables
+|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3|
+the fourth.
+
+@<Glob...@>=
+@!b0,@!b1,@!b2,@!b3: eight_bits; {four bytes input at once}
+
+@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
+four bytes in the current \.{TFM} file.
+@^system dependencies@>
+
+@p procedure read_tfm_word;
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+end;
+
+@ Input can come from from three different sources depending on the settings
+of global variables. When |vf_reading| is true, we read from the \.{VF} file.
+Otherwise, input can either come directly from |dvi_file| or from a buffer
+|cmd_buf|. The latter case applies whenever |buf_ptr<virtual_space|.
+
+@<Glob...@>=
+@!vf_reading:boolean; {should input come from |vf_file|?}
+@!cmd_buf:packed array [0..virtual_space] of quarter_word;
+ {commands for virtual characters}
+@!buf_ptr:0..virtual_space; {|cmd_buf| index for the next byte}
+
+@ @<Set init...@>=
+vf_reading:=false; buf_ptr:=virtual_space;
+
+@ It is probably not critical that |cmd_buf| be packed as efficiently as possible,
+but we define a new type just in case it is necessary to for |cmd_buf| entries
+to be in the range |-128..127|.
+@^system dependencies@>
+
+@d qi(#)==# {convert from |eight_bits| to |quarter_word|}
+@d qo(#)==# {convert from |quarter_word| to |eight_bits|}
+
+@<Types...@>=
+quarter_word=0..255; {a one byte quantity as stored in |cmd_buf|}
+
+@ We shall use a set of simple functions to read the next byte or bytes from the
+current input source. There are seven possibilities, each of which is treated
+as a separate function in order to minimize the overhead for subroutine calls.
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin @<Read one byte into |b|@>;
+get_byte:=b;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin @<Read one byte into |b|@>;
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin @<Read two bytes into |a| and |b|@>;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin @<Read two bytes into |a| and |b|@>;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin @<Read three bytes into |a|, |b|, and~|c|@>;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin @<Read three bytes into |a|, |b|, and~|c|@>;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin @<Read four bytes into |a|, |b|, |c|, and~|d|@>;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@ @<Read one byte into |b|@>=
+if vf_reading then read(vf_file,b)
+else if buf_ptr=virtual_space then read(dvi_file,b)
+else begin b:=qo(cmd_buf[buf_ptr]);
+ incr(buf_ptr);
+ end
+
+@ @<Read two bytes into |a| and |b|@>=
+if vf_reading then
+ begin read(vf_file,a); read(vf_file,b);
+ end
+else if buf_ptr=virtual_space then
+ begin read(dvi_file,a); read(dvi_file,b);
+ end
+else if buf_ptr+2>n_cmds then
+ abort('Error detected while interpreting a virtual font')
+@.Error detected while...@>
+else begin a:=qo(cmd_buf[buf_ptr]);
+ b:=qo(cmd_buf[buf_ptr+1]);
+ buf_ptr:=buf_ptr+2;
+ end
+
+@ @<Read three bytes into |a|, |b|, and~|c|@>=
+if vf_reading then
+ begin read(vf_file,a); read(vf_file,b); read(vf_file,c);
+ end
+else if buf_ptr=virtual_space then
+ begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+ end
+else if buf_ptr+3>n_cmds then
+ abort('Error detected while interpreting a virtual font')
+@.Error detected while...@>
+else begin a:=qo(cmd_buf[buf_ptr]);
+ b:=qo(cmd_buf[buf_ptr+1]);
+ c:=qo(cmd_buf[buf_ptr+2]);
+ buf_ptr:=buf_ptr+3;
+ end
+
+@ @<Read four bytes into |a|, |b|, |c|, and~|d|@>=
+if vf_reading then
+ begin read(vf_file,a); read(vf_file,b); read(vf_file,c); read(vf_file,d);
+ end
+else if buf_ptr=virtual_space then
+ begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
+ end
+else if buf_ptr+4>n_cmds then
+ abort('Error detected while interpreting a virtual font')
+@.Error detected while...@>
+else begin a:=qo(cmd_buf[buf_ptr]);
+ b:=qo(cmd_buf[buf_ptr+1]);
+ c:=qo(cmd_buf[buf_ptr+2]);
+ d:=qo(cmd_buf[buf_ptr+3]);
+ buf_ptr:=buf_ptr+4;
+ end
+
+@* Data structures for fonts.
+\.{DVI} file format does not include information about character widths, since
+that would tend to make the files a lot longer. But a program that reads
+a \.{DVI} file is supposed to know the widths of the characters that appear
+in \\{set\_char} commands. Therefore \.{DVItoMP} looks at the font metric
+(\.{TFM}) files for the fonts that are involved.
+@.TFM {\rm files}@>
+
+@ For purposes of this program, the only thing we need to know about a
+given character |c| in a non-virtual font |f| is the width. For the font as
+a whole, all we need is the symbolic name to use in the \.{MPX} file.
+
+This information appears implicitly in the following data
+structures. The current number of fonts defined is |nf|. Each such font has
+an internal number |f|, where |0<=f<nf|. There is also an external number
+that identifies the font in the \.{DVI} file. The correspondence is
+maintained in arrays |font_num| and |internal_num| so that |font_num[i]|
+is the external number for |f=internal_num[i]|.
+The external name of this font is the string that
+occupies positions |font_name[f]| through |font_name[f+1]-1| of the array
+|names|. The latter array consists of |ASCII_code| characters, and
+|font_name[nf]| is its first unoccupied position. The
+legal characters run from |font_bc[f]| to |font_ec[f]|, inclusive.
+The \.{TFM} file can specify that some of these are invalid, but this doesn't
+concern \.{DVItoMP} because it does not do extensive error checking.
+The width of character~|c| in font~|f| is given by
+|char_width(f)(c)=width[info_base[f]+c]|, and |info_ptr| is the
+first unused position of the |width| array.
+
+If font~|f| is a virtual font, there is a list of \.{DVI} commands for each
+character. These occupy consecutive positions in the |cmd_buf| array with
+the commands for character~|c| starting at
+|start_cmd(f)(c)=cmd_ptr[info_base[f]+c]| and ending just before
+|start_cmd(f)(c+1)|. Font numbers used when interpreting these \.{DVI}
+commands occupy positions |fbase[f]| through |ftop[f]-1| in the |font_num|
+table and the |internal_num| array gives the corresponding internal font
+numbers. If such an internal font number~|i| does not correspond to
+some font occuring in the \.{DVI} file, then |font_num[i]| has not been
+assigned a meaningful value; this is indicated by |local_only[i]=true|.
+
+If font~|f| is not virtual, then |fbase[f]=0| and |ftop[f]=0|. The |start_cmd|
+values are ignored in this case.
+
+@d char_width_end(#)==#]
+@d char_width(#)==width[info_base[#]+char_width_end
+@d start_cmd(#)==cmd_ptr[info_base[#]+start_cmd_end
+@d start_cmd_end(#)==#]
+
+@<Glob...@>=
+@!font_num:array [0..max_fnums] of integer; {external font numbers}
+@!internal_num:array [0..max_fnums] of integer; {internal font numbers}
+@!local_only:array [0..max_fonts] of boolean; {|font_num| meaningless?}
+@!font_name:array [0..max_fonts] of 0..name_size; {starting positions
+ of external font names}
+@!names:array [0..name_size] of ASCII_code; {characters of names}
+@!area_length:array [0..max_fonts] of integer;
+ {length of area part of font name}
+@!font_scaled_size:array [0..max_fonts] of real; {scale factors over $2^{20}$}
+@!font_design_size:array [0..max_fonts] of real; {design sizes over $2^{20}$}
+@!font_check_sum:array [0..max_fonts] of integer;
+ {check sum from the |font_def|}
+@!font_bc:array [0..max_fonts] of integer; {beginning characters in fonts}
+@!font_ec:array [0..max_fonts] of integer; {ending characters in fonts}
+@!info_base:array [0..max_fonts] of integer;
+ {index into |width| and |cmd_ptr| tables}
+@!width:array [0..max_widths] of integer;
+ {character widths, in units $2^{-20}$ of design size}
+@!fbase:array [0..max_fonts] of integer; {index into |font_num| for local fonts}
+@!ftop:array [0..max_fonts] of integer;
+ {|font_num| index where local fonts stop}
+@!cmd_ptr:array [0..max_widths] of integer; {starting positions in |cmd_buf|}
+@!nf:0..max_fonts; {the number of known fonts}
+@!vf_ptr:max_fonts..max_fnums;
+ {next |font_num| entry for virtual font font tables}
+@!info_ptr:0..max_widths; {allocation pointer for |width| and |cmd_ptr| tables}
+@!n_cmds:0..virtual_space; {number of occupied cells in |cmd_buf|}
+@!cur_fbase,@!cur_ftop:0..max_fnums;
+ {currently applicable part of the |font_num| table}
+
+@ @<Set init...@>=
+nf:=0; info_ptr:=0; font_name[0]:=0;
+vf_ptr:=max_fnums;
+cur_fbase:=0; cur_ftop:=0;
+
+@ Printing the name of a given font is easy except that a procedure |print_char|
+is needed to actually send an |ASCII_code| to the \.{MPX} file.
+
+@p @<Declare subroutines for printing strings@>@;
+procedure print_font(@!f:integer); {|f| is an internal font number}
+var k:0..name_size; {index into |names|}
+begin if (f<0)or(f>=nf) then bad_dvi('Undefined font')
+else begin for k:=font_name[f] to font_name[f+1]-1 do
+ print_char(names[k]);
+ end;
+end;
+
+@ Sometimes a font name is needed as part of an error message.
+
+@d font_warn(#)==begin err_print('DVItoMP warning: ',#); font_warn_end
+@d font_warn_end(#)==err_print_font(#);
+ history:=warning_given;
+ end
+@d font_abort(#)==begin err_print('DVItoMP abort: ',#); font_abort_end
+@d font_abort_end(#)==err_print_font(#);
+ history:=fatal_error; jump_out;
+ end
+
+@p procedure err_print_font(@!f:integer); {|f| is an internal font number}
+var k:0..name_size; {index into |names|}
+begin for k:=font_name[f] to font_name[f+1]-1 do
+ err_print(xchr[names[k]]);
+ err_print_ln(' ');
+end;
+
+@ When we encounter a font definition, we save the name, checksum, and size
+information, but we don't actaully read the \.{TFM} or \.{VF} file until we
+are about to use the font. If a matching font is not already defined, we then
+allocate a new internal font number.
+
+The following subroutine does the necessary things when a \\{fnt\_def} command
+is encountered in the \.{DVI} file or in a \.{VF} file. It assumes that the
+first argument has already been parsed and is given by the parameter~|e|.
+
+@p @<Declare a function called |match_font|@>@;
+procedure define_font(@!e:integer); {|e| is an external font number}
+var @!i:integer; {index into |font_num| and |internal_num|}
+@!n:integer; {length of the font name and area}
+@!k:integer; {general purpose loop counter}
+@!x:integer; {a temporary value for scaled size computation}
+begin if nf=max_fonts then abort('DVItoMP capacity exceeded (max fonts=',
+ max_fonts:1,')!');
+@.DVItoMP capacity exceeded...@>
+@<Allocate an index |i| into the |font_num| and |internal_num| tables@>;
+@<Read the font parameters into position for font |nf|@>;
+internal_num[i]:=match_font(nf,true);
+if internal_num[i]=nf then
+ begin info_base[nf]:=max_widths; {indicate that the info isn't loaded yet}
+ local_only[nf]:=vf_reading; incr(nf);
+ end;
+end;
+
+@ @<Allocate an index |i| into the |font_num| and |internal_num| tables@>=
+if vf_ptr=nf then abort('DVItoMP capacity exceeded (max font numbers=',
+ max_fnums:1,')');
+@.DVItoMP capacity exceeded...@>
+if vf_reading then
+ begin font_num[nf]:=0; i:=vf_ptr; decr(vf_ptr);
+ end
+else i:=nf;
+font_num[i]:=e
+
+@ @<Read the font parameters into position for font |nf|@>=
+font_check_sum[nf]:=signed_quad;
+@<Read |font_scaled_size[nf]| and |font_design_size[nf]|@>;
+n:=get_byte; area_length[nf]:=n;
+n:=n+get_byte;
+if font_name[nf]+n>name_size then
+ abort('DVItoMP capacity exceeded (name size=',name_size:1,')!');
+@.DVItoMP capacity exceeded...@>
+font_name[nf+1]:=font_name[nf]+n;
+for k:=font_name[nf] to font_name[nf+1]-1 do names[k]:=get_byte
+
+@ The scaled size and design size are stored in \.{DVI} units divided by $2^20$.
+The units for scaled size are a little different if we are reading a virtual
+font, but this will be corrected when the scaled size is used. The scaled size
+also needs to be truncated to at most 23 significant bits in order to make
+the character width calculation match what \TeX\ does.
+
+@<Read |font_scaled_size[nf]| and |font_design_size[nf]|@>=
+x:=signed_quad;
+k:=1;
+while x>@'40000000 do
+ begin x:=x div 2; k:=k+k;
+ end;
+font_scaled_size[nf]:=x*k/1048576.0;
+if vf_reading then
+ font_design_size[nf]:=signed_quad*dvi_per_fix/1048576.0
+else font_design_size[nf]:=signed_quad/1048576.0;
+
+@ @<Glob...@>=
+@!dvi_per_fix:real; {converts points scaled $2^{20}$ to \.{DVI} units}
+
+@ The |match_font| function tries to find a match for the font with internal
+number~|ff|, returning |nf| or the number of the matching font. If
+|exact=true|, the name and scaled size should match. Otherwise the scaled
+size need not match but the font found must be already loaded, not just
+defined.
+
+@<Declare a function called |match_font|@>=
+function match_font(ff:integer; exact:boolean):integer;
+label done, 99;
+var @!f:0..max_fonts; {font number being tested}
+@!ss,@!ll:0..name_size; {starting point and length of name of font |ff|}
+@!k,@!s:0..name_size; {registers for comparing font names}
+begin ss:=font_name[ff]; ll:=font_name[ff+1]-ss;
+f:=0;
+while f<nf do
+ begin if f<>ff then
+ begin @<Compare the names of fonts |f| and |ff|; |goto 99| if they differ@>;
+ if exact then
+ begin if abs(font_scaled_size[f]-font_scaled_size[ff])
+ <= font_tolerance then
+ begin if not vf_reading then
+ if local_only[f] then
+ begin font_num[f]:=font_num[ff]; local_only[f]:=false;
+ end
+ else if font_num[f]<>font_num[ff] then goto 99;
+ goto done;
+ end;
+ end
+ else if info_base[f]<>max_widths then goto done;
+ end;
+ 99:incr(f);
+ end;
+done:if f<nf then
+ @<Make sure fonts |f| and |ff| have matching design sizes and checksums@>;
+match_font:=f;
+end;
+
+@ @<Compare the names of fonts |f| and |ff|; |goto 99| if they differ@>=
+if (area_length[f]<area_length[ff]) or (ll<>font_name[f+1]-font_name[f]) then
+ goto 99;
+s:=font_name[f];
+k:=ll;
+while k>0 do
+ begin decr(k);
+ if names[s+k]<>names[ss+k] then goto 99;
+ end
+
+@ @<Make sure fonts |f| and |ff| have matching design sizes and checksums@>=
+if abs(font_design_size[f]-font_design_size[ff]) > font_tolerance then
+ font_warn('Inconsistent design sizes given for ')(ff)
+@.Inconsistent design sizes@>
+else if font_check_sum[f]<>font_check_sum[ff] then
+ font_warn('Checksum mismatch for ')(ff)
+@.Checksum mismatch@>
+
+@* Reading ordinary fonts.
+An auxiliary array |in_width| is used to hold the widths as they are
+input. The global variable |tfm_check_sum| is set to the check sum that
+appears in the current \.{TFM} file.
+
+@<Glob...@>=
+@!in_width:array[0..255] of integer; {\.{TFM} width data in \.{DVI} units}
+@!tfm_check_sum:integer; {check sum found in |tfm_file|}
+
+@ Here is a procedure that absorbs the necessary information from a
+\.{TFM} file, assuming that the file has just been successfully reset
+so that we are ready to read its first byte. (A complete description of
+\.{TFM} file format appears in the documentation of \.{TFtoPL} and will
+not be repeated here.) The procedure does not check the \.{TFM} file
+for validity, nor does it give explicit information about what is
+wrong with a \.{TFM} file that proves to be invalid. The procedure simply
+aborts the program if it detects anything amiss in the \.{TFM} data.
+
+@p procedure in_TFM(@!f:integer);
+ {input \.{TFM} data for font |f| or abort}
+label 9997, {go here when the format is bad}
+ 9999; {go here to exit}
+var k:integer; {index for loops}
+@!lh:integer; {length of the header data, in four-byte words}
+@!nw:integer; {number of words in the width table}
+@!wp:0..max_widths; {new value of |info_ptr| after successful input}
+begin @<Read past the header data; |goto 9997| if there is a problem@>;
+@<Store character-width indices at the end of the |width| table@>;
+@<Read the width values into the |in_width| table@>;
+@<Move the widths from |in_width| to |width|@>;
+fbase[f]:=0; ftop[f]:=0;
+info_ptr:=wp; goto 9999;
+9997: font_abort('Bad TFM file for ')(f);
+@.Bad TFM file@>
+9999: end;
+
+@ @<Read past the header...@>=
+read_tfm_word; lh:=b2*256+b3;
+read_tfm_word; font_bc[f]:=b0*256+b1; font_ec[f]:=b2*256+b3;
+if font_ec[f]<font_bc[f] then font_bc[f]:=font_ec[f]+1;
+if info_ptr+font_ec[f]-font_bc[f]+1>max_widths then
+ abort('DVItoMP capacity exceeded (width table size=',max_widths:1,')!');
+@.DVItoMP capacity exceeded...@>
+wp:=info_ptr+font_ec[f]-font_bc[f]+1;
+read_tfm_word; nw:=b0*256+b1;
+if (nw=0)or(nw>256) then goto 9997;
+for k:=1 to 3+lh do
+ begin if eof(tfm_file) then goto 9997;
+ read_tfm_word;
+ if k=4 then
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3;
+ end;
+
+@ @<Store character-width indices...@>=
+if wp>0 then for k:=info_ptr to wp-1 do
+ begin read_tfm_word;
+ if b0>nw then goto 9997;
+ width[k]:=b0;
+ end;
+
+@ No fancy width calculation is needed here because \.{DVItoMP} stores
+widths in their raw form as multiples of the design size scaled by $2^{20}$.
+The |font_scaled_size| entries have been computed so that the final width
+compution can be done in floating point if enough precision is available.
+
+@<Read the width values into the |in_width| table@>=
+for k:=0 to nw-1 do
+ begin read_tfm_word;
+ if b0>127 then b0:=b0-256;
+ in_width[k]:=((b0*@'400+b1)*@'400+b2)*@'400+b3;
+ end
+
+@ The width compution uses a scale factor |dvi_scale| that will be introduced
+later. It is equal to one when not typesetting a character from a virtual
+font. In that case, the following expressions do the width computation that is
+so important in \.{DVItype}. It is less important here because it is impractical
+to guarantee precise character positioning in \MP\ output. Nevertheless, the
+width compution will be precise if reals have at least 46-bit mantissas and
+|round(x-.5)| is equivalent to $\lfloor x\rfloor$. It may be a good idea to
+modify this computation if these conditions are not met.
+@^system dependencies@>
+
+@<Width of character |c| in font |f|@>=
+round(dvi_scale*font_scaled_size[f]*char_width(f)(c)-0.5)
+
+@ @<Width of character |p| in font |cur_font|@>=
+round(dvi_scale*font_scaled_size[cur_font]*char_width(cur_font)(p)-0.5)
+
+@ @<Move the widths from |in_width| to |width|@>=
+if in_width[0]<>0 then goto 9997; {the first width should be zero}
+info_base[f]:=info_ptr-font_bc[f];
+if wp>0 then for k:=info_ptr to wp-1 do
+ width[k]:=in_width[width[k]]
+
+
+@* Reading virtual fonts.
+The |in_VF| procedure absorbs the necessary information from a \.{VF} file that
+has just been reset so that we are ready to read the first byte. (A complete
+description of \.{VF} file format appears in the documention of \.{VFtoVP}).
+Like |in_TFM|, this procedure simply aborts the program if it detects anything
+wrong with the \.{VF} file.
+
+@p @<Declare a function called |first_par|@>@;
+procedure in_VF(f:integer);
+ {read \.{VF} data for font |f| or abort}
+label 9997, {go here to abort}
+ 9999; {go here to exit}
+var @!p:integer; {a byte from the \.{VF} file}
+@!was_vf_reading:boolean; {old value of |vf_reading|}
+@!c:integer; {the current character code}
+@!limit:integer; {space limitations force character codes to be less than this}
+@!w:integer; {a \.{TFM} width being read}
+begin was_vf_reading:=vf_reading; vf_reading:=true;
+@<Start reading the preamble from a \.{VF} file@>;@/
+@<Initialize the data structures for the virtual font@>;@/
+p:=get_byte;
+while p>=fnt_def1 do
+ begin if p>fnt_def1+3 then goto 9997;
+ define_font(first_par(p));
+ p:=get_byte;
+ end;
+while p<=242 do
+ begin if eof(vf_file) then goto 9997;
+ @<Read the packet length, character code, and \.{TFM} width@>;
+ @<Store the character packet in |cmd_buf|@>;
+ p:=get_byte;
+ end;
+if p=post then
+ begin @<Finish setting up the data structures for the new virtual font@>;
+ goto 9999;
+ end;
+9997:font_abort('Bad VF file for ')(f);
+9999: vf_reading:=was_vf_reading;
+end;
+
+@ @<Start reading the preamble from a \.{VF} file@>=
+p:=get_byte;
+if p<>pre then goto 9997;
+p:=get_byte; {fetch the identification byte}
+if p<>202 then goto 9997;
+p:=get_byte; {fetch the length of the introductory comment}
+while p>0 do
+ begin decr(p); down_the_drain:=get_byte;
+ end;
+tfm_check_sum:=signed_quad;
+down_the_drain:=signed_quad; {skip over the design size}
+
+@ @<Initialize the data structures for the virtual font@>=
+ftop[f]:=vf_ptr;
+if vf_ptr=nf then abort('DVItoMP capacity exceeded (max font numbers=',
+ max_fnums:1,')');
+@.DVItoMP capacity exceeded...@>
+decr(vf_ptr);
+info_base[f]:=info_ptr;
+limit:=max_widths-info_base[f];@/
+font_bc[f]:=limit; font_ec[f]:=0
+
+@ @<Read the packet length, character code, and \.{TFM} width@>=
+if p=242 then
+ begin p:=signed_quad; c:=signed_quad; w:=signed_quad;
+ if c<0 then goto 9997;
+ end
+else begin c:=get_byte; w:=get_three_bytes;
+ end;
+if c>=limit then
+ abort('DVItoMP capacity exceeded (max widths=', max_widths:1,')!');
+@.DVItoMP capacity exceeded...@>
+if c<font_bc[f] then font_bc[f]:=c;
+if c>font_ec[f] then font_ec[f]:=c;
+char_width(f)(c):=w
+
+@ @<Store the character packet in |cmd_buf|@>=
+if n_cmds+p>=virtual_space then
+ abort('DVItoMP capacity exceeded (virtual font space=',virtual_space:1,')!');
+@.DVItoMP capacity exceeded...@>
+start_cmd(f)(c):=n_cmds;
+while p>0 do
+ begin cmd_buf[n_cmds]:=qi(get_byte);
+ incr(n_cmds); decr(p);
+ end;
+cmd_buf[n_cmds]:=qi(eop); {add the end-of-packet marker}
+incr(n_cmds)
+
+@ There are unused |width| and |cmd_ptr| entries if |font_bc[f]>0| but it isn't
+worthwhile to slide everything down just to save a little space.
+
+@<Finish setting up the data structures for the new virtual font@>=
+fbase[f]:=vf_ptr+1;
+info_ptr:=info_base[f]+font_ec[f]
+
+
+@* Loading fonts.
+The character width information for a font is loaded when the font is selected
+for the first time. This information might already be loaded if the font has
+already been used at a different scale factor. Otherwise, we look for a \.{VF}
+file, or failing that, a \.{TFM} file. All this is done by the |select_font|
+function that takes an external font number~|e| and returns the corresponding
+internal font number with the width information loaded.
+
+@p function select_font(@!e:integer):integer;
+var @!f:0..max_fonts; {the internal font number}
+@!ff:0..max_fonts; {internal font number for an existing version}
+@!k,@!l:integer; {general purpose loop counters}
+begin @<Set |f| to the internal font number that corresponds to |e|,
+ or |abort| if there is none@>;
+if info_base[f]=max_widths then
+ begin ff:=match_font(f,false);
+ if ff<nf then @<Make font |f| refer to the width information from font |ff|@>
+ else begin @<Move the \.{VF} file name into the |cur_name| string@>;
+ if open_vf_file then in_VF(f)
+ else begin @<Change \.{.VF} to \.{.TFM} in the |cur_name| string@>;
+ if not open_tfm_file then font_abort('No TFM file found for ')(f);
+ @.no TFM file found@>
+ in_TFM(f);
+ end;
+ @<Make sure the checksum in the font file matches the one given in the
+ |font_def| for font |f|@>;
+ end;
+ @<Do any other initialization required for the new font |f|@>;
+ end;
+select_font:=f;
+end;
+
+@ @<Set |f| to the internal font number that corresponds to |e|,...@>=
+if cur_ftop<=nf then cur_ftop:=nf;
+font_num[cur_ftop]:=e;
+k:=cur_fbase;
+while (font_num[k]<>e)or local_only[k] do incr(k);
+if k=cur_ftop then abort('Undefined font selected');
+f:=internal_num[k]
+
+@ @<Make font |f| refer to the width information from font |ff|@>=
+begin font_bc[f]:=font_bc[ff];
+font_ec[f]:=font_ec[ff];
+info_base[f]:=info_base[ff];
+fbase[f]:=fbase[ff];
+ftop[f]:=ftop[ff];
+end
+
+@ If |area_length[f]=0|, i.e., if no font directory has been specified,
+\.{DVItoMP} is supposed to use the default font directory, which is a
+system-dependent place where the standard fonts are kept.
+The string variable |default_directory| contains the name of this area.
+@^system dependencies@>
+
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{VF} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.VF}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@^system dependencies@>
+
+@<Move the \.{VF} file name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if area_length[f]=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ l:=default_directory_name_length;
+ end
+else l:=0;
+for k:=font_name[f] to font_name[f+1]-1 do
+ begin incr(l);
+ if l+3>name_length then
+ abort('DVItoMP capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItoMP capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[l]:=xchr[names[k]-@'40]
+ else cur_name[l]:=xchr[names[k]];
+ end;
+cur_name[l+1]:='.'; cur_name[l+2]:='V'; cur_name[l+3]:='F'
+
+@ It is fairly simple to change a \.{VF} file name to a \.{TFM} file name.
+@^system dependencies@>
+
+@<Change \.{.VF} to \.{.TFM} in the |cur_name| string@>=
+l:=area_length[f];
+if l=0 then l:=default_directory_name_length;
+l:=l+font_name[f+1]-font_name[f];
+if l+4>name_length then
+ abort('DVItoMP capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItoMP capacity exceeded...@>
+cur_name[l+2]:='T'; cur_name[l+3]:='F'; cur_name[l+4]:='M'
+
+@ @<Make sure the checksum in the font file matches the one given in the...@>=
+begin if (font_check_sum[f]<>0)and(tfm_check_sum<>0)and@|
+ (font_check_sum[f]<>tfm_check_sum) then
+ begin err_print('DVItoMP warning: Checksum mismatch for ');
+@.Checksum mismatch@>
+ err_print_font(f);
+ if history=spotless then history:=cksum_trouble;
+ end;
+end
+
+@* Low level output routines.
+One of the basic output operations is to write a \MP\ string expression for
+a sequence of characters to be typeset. The main difficulties are that such
+strings can contain arbitrary eight-bit bytes and there is no fixed limit on
+the length of the string that needs to be produced. In extreme cases this
+can lead to expressions such as
+$$\vcenter{
+ \hbox{\.{char7\&char15\&char31\&"?FWayzz"}}
+ \hbox{\.{\&"zzaF"\&char15\&char3\&char31}}
+ \hbox{\.{\&"Nxzzzzzzzwvtsqo"}}}
+$$
+
+@ A global variable |state| keeps track of the output process.
+When |state=normal| we have begun a quoted string and the next character
+should be a printable character or a closing quote. When |state=special|
+the last thing printed was a ``\.{char}'' construction or a closing quote
+and an ampersand should come next. The starting condition |state=initial|
+is a lot like |state=special|, except no ampersand is required.
+
+@d special=0 {the |state| after printing a ``\.{char}'' expression}
+@d normal=1 {the |state| value in a quoted string}
+@d initial=2 {initial |state|}
+
+@<Glob...@>=
+state:special..initial; {controls the process of printing a string}
+print_col:0..line_length;
+ {there are at most this many characters on the current line}
+
+@ To print a string on the \.{MPX} file, initialize |print_col|, ensure that
+|state=initial|, and pass the characters one-at-a-time to |print_char|.
+
+@<Declare subroutines for printing strings@>=
+procedure print_char(@!c:eight_bits);
+var @!printable:boolean; {is it safe to print |xchr[c]|?}
+@!l:integer; {number of characters to print |c| or the \.{char} expression}
+begin printable:=(c>=" ")and(c<="~")and(c<>"""");
+if printable then l:=1
+else if c<10 then l:=5
+else if c<100 then l:=6
+else l:=7;
+if print_col+l>line_length-2 then
+ begin if state=normal then
+ begin print('"'); state:=special;
+ end;
+ print_ln(' ');
+ print_col:=0;
+ end;
+@<Print |c| and update |state| and |print_col|@>;
+end;
+
+@ @<Print |c| and update |state| and |print_col|@>=
+if state=normal then
+ if printable then print(xchr[c])
+ else begin print('"&char',c:1);
+ print_col:=print_col+2;
+ end
+else begin if state=special then
+ begin print('&'); incr(print_col);
+ end;
+ if printable then
+ begin print('"',xchr[c]); incr(print_col);
+ end
+ else print('char',c:1);
+ end;
+print_col:=print_col+l;
+if printable then state:=normal @+else state:=special
+
+@ The |end_char_string| procedure gets the string ended properly and ensures
+that there is room for |l| more characters on the output line.
+
+@<Declare subroutines for printing strings@>=
+procedure end_char_string(@!l:integer);
+begin while state>special do
+ begin print('"');
+ incr(print_col);
+ decr(state);
+ end;
+if print_col+l>line_length then
+ begin print_ln(' '); print_col:=0;
+ end;
+state:=initial; {get ready to print the next string}
+end;
+
+@ Since |end_char_string| resets |state:=initial|, all we have to do is set
+|state:=initial| once at the beginning.
+
+@<Set init...@>=
+state:=initial;
+
+@ Characters and rules are positioned according to global variables |h| and~|v|
+as will be explained later. We also need scale factors that convert quantities
+to the right units when they are printed in the \.{MPX} file.
+
+Even though all variable names in the \MP\ output are made local via \.{save}
+commands, it is still desirable to preceed them with underscores. This makes
+the output more likely to work when used in a macro definition, since the
+generated variables names must not collide with formal parameters in such
+cases.
+
+@<Glob...@>=
+@!h,@!v:integer; {the current position in \.{DVI} units}
+@!conv:real; {converts \.{DVI} units to \MP\ points}
+@!mag:real; {magnification factor times 1000}
+
+@ @p @<Declare a procedure called |finish_last_char|@>@;
+procedure do_set_char(@!f,@!c:integer);
+begin if (c<font_bc[f])or(c>font_ec[f]) then
+ abort('attempt to typeset invalid character ',c:1);
+@.attempt to typeset...@>
+if (h<>str_h2)or(v<>str_v)or(f<>str_f)or(dvi_scale<>str_scale) then
+ begin if str_f>=0 then finish_last_char
+ else if not fonts_used then
+ @<Prepare to output the first character on a page@>;
+ if not font_used[f] then
+ @<Prepare to use font |f| for the first time on a page@>;
+ print('_s('); print_col:=3;@/
+ str_scale:=dvi_scale; str_f:=f; str_v:=v; str_h1:=h;
+ end;
+print_char(c);
+str_h2:=h+@<Width of character |c| in font |f|@>;
+end;
+
+@ @<Glob...@>=
+@!font_used:array[0..max_fonts] of boolean;
+ {has this font been used on this page?}
+@!fonts_used:boolean; {has any font been used on this page?}
+@!rules_used:boolean; {has any rules been set on this page?}
+@!str_h1,str_v:integer; {starting position for current output string}
+@!str_h2:integer; {where the current output string ends}
+@!str_f:integer; {internal font number for the current output string}
+@!str_scale:real; {value of |dvi_scale| for the current output string}
+
+@ The |font_used| array is not initialized until it is actually time to output
+a character.
+
+@<Prepare to output the first character on a page@>=
+begin k:=0;
+while (k<nf) do
+ begin font_used[k]:=false; incr(k);
+ end;
+fonts_used:=true;
+print_ln('string _n[];');
+print_ln('vardef _s(expr _t,_f,_m,_x,_y)=');
+print_ln(' addto _p also _t infont _f scaled _m shifted (_x,_y); enddef;');
+end
+
+@ @<Do any other initialization required for the new font |f|@>=
+font_used[f]:=false;
+
+@ @<Prepare to use font |f| for the first time on a page@>=
+begin font_used[f]:=true;
+print('_n',f:1,'=');
+print_col:=6;
+print_font(f);
+end_char_string(1);
+print_ln(';');
+end
+
+@ We maintain the invariant that |str_f=-1| when there is no output string
+under construction.
+
+@<Declare a procedure called |finish_last_char|@>=
+procedure finish_last_char;
+var @!m,@!x,@!y:real;
+ {font scale factor and \MP\ coordinates of reference point}
+begin if str_f>=0 then
+ begin m:=str_scale*font_scaled_size[str_f]*mag/font_design_size[str_f];@/
+ x:=conv*str_h1; y:=conv*(-str_v);
+ if (abs(x)>=4096.0)or(abs(y)>=4096.0)or(m>=4096.0)or(m<0) then
+ begin warn('text scaled ',m:1:1,@|
+ ' at (',x:1:1,',',y:1:1,') is out of range');
+ end_char_string(60);
+ end
+ else end_char_string(40);
+ print_ln(',_n',str_f:1,',',m:1:5,',',x:1:4,',',y:1:4,');');
+ str_f:=-1;
+ end;
+end;
+
+@ Setting rules is fairly simple.
+
+@p procedure do_set_rule(@!ht,@!wd:integer);
+var @!xx1,@!yy1,@!xx2,@!yy2,@!ww:real;
+ {\MP\ coordinates of lower-left and upper-right corners}
+begin if wd=1 then @<Handle a special rule that determines the box size@>
+else if (ht>0)or(wd>0) then
+ begin if str_f>=0 then finish_last_char;
+ if not rules_used then
+ begin rules_used:=true;@/
+ print_ln('interim linecap:=0;');@/
+ print_ln('vardef _r(expr _a,_w) =');
+ print_ln(' addto _p doublepath _a withpen pencircle scaled _w enddef;');
+ end;
+ @<Make |(xx1,yy1)| and |(xx2,yy2)| then ends of the desired penstroke
+ and |ww| the desired stroke width@>;
+ if (abs(xx1)>=4096.0)or(abs(yy1)>=4096.0)or@|
+ (abs(xx2)>=4096.0)or(abs(yy2)>=4096.0)or(ww>=4096.0) then
+ warn('hrule or vrule near (',xx1:1:1,',',yy1:1:1,') is out of range');
+ print_ln('_r((',xx1:1:4,',',yy1:1:4,')..(',xx2:1:4,',',yy2:1:4,
+ '), ',ww:1:4,');');
+ end;
+end;
+
+@ @<Make |(xx1,yy1)| and |(xx2,yy2)| then ends of the desired penstroke...@>=
+xx1:=conv*h;
+yy1:=conv*(-v);
+if wd>ht then
+ begin xx2:=xx1+conv*wd;
+ ww:=conv*ht;@/
+ yy1:=yy1+0.5*ww;
+ yy2:=yy1;
+ end
+else begin yy2:=yy1+conv*ht;
+ ww:=conv*wd;@/
+ xx1:=xx1+0.5*ww;
+ xx2:=xx1;
+ end
+
+@ Rules of width one dvi unit are not typeset since \.{MPtoTeX} adds an
+extraneous rule of this width in order to allow \.{DVItoMP} to deduce the
+dimensions of the boxes it ships out. The box width is the left edge of the
+last such rule; the height and depth are at the top and bottom of the rule.
+There should be only one special rule per picture but there could be more if
+the user tries to typeset his own one-dvi-unit rules. In this case the
+dimension-determining rule is the last one in the picture.
+
+@<Handle a special rule that determines the box size@>=
+begin pic_wd:=h; pic_dp:=v; pic_ht:=ht-v;
+end
+
+@ @<Glob...@>=
+pic_dp, pic_ht, pic_wd: integer; {picture dimensions from special rule}
+
+@ The following initialization and clean-up is required. We do a little more
+initialization than is absolutely necessary since some compilers might complain
+if the variables are uninitialized when |do_set_char| tests them.
+
+@p procedure start_picture;
+begin fonts_used:=false;
+rules_used:=false;
+str_f:=-1;@/
+str_v:=0; str_h2:=0; str_scale:=1.0; {values don't matter}
+print_ln('begingroup save _p,_r,_s,_n; picture _p; _p=nullpicture;');
+end;
+@#
+procedure stop_picture;
+var @!w,@!h,@!dd:real; {width, height, negative depth in PostScript points}
+begin if str_f>=0 then finish_last_char;
+@<Print a \&{setbounds} command based on picture dimensions@>;
+print_ln('_p endgroup');
+end;
+
+@ @<Print a \&{setbounds} command based on picture dimensions@>=
+dd:=-pic_dp*conv;
+w:=conv*pic_wd; h:=conv*pic_ht;@/
+print_ln('setbounds _p to (0,',dd:1:4,')--(',w:1:4,',',dd:1:4,')--');
+print_ln(' (',w:1:4,',',h:1:4,')--(0,',h:1:4,')--cycle;')
+
+@* Translation to symbolic form.
+The main work of \.{DVItoMP} is accomplished by the |do_dvi_commands|
+procedure, which produces the output for an entire page, assuming that the
+|bop| command for that page has already been processed. This procedure is
+essentially an interpretive routine that reads and acts on the \.{DVI}
+commands. It is also capable of executing the typesetting commands for
+a character in a virtual font.
+
+@ The definition of \.{DVI} files refers to six registers,
+$(h,v,w,x,y,z)$, which hold integer values in \.{DVI} units.
+These units come directly from the input file except they need to be
+rescaled when typesetting characters from a virtual font.
+The stack of $(h,v,w,x,y,z)$ values is represented by six arrays
+called |hstack|, \dots, |zstack|.
+
+@<Glob...@>=
+@!w,@!x,@!y,@!z:integer;
+ {current state values (|h| and |v| have already been declared)}
+@!hstack,@!vstack,@!wstack,@!xstack,@!ystack,@!zstack:
+ array [0..stack_size] of integer; {pushed down values in \.{DVI} units}
+@!stk_siz:integer; {the current stack size}
+@!dvi_scale:real; {converts units of current input source to \.{DVI} units}
+
+@ @<Do initialization required before starting a new page@>=
+dvi_scale:=1.0;
+stk_siz:=0;
+h:=0; v:=0
+
+@ Next, we need procedures to handle |push| and |pop| commands.
+
+@p procedure do_push;
+begin if stk_siz=stack_size then
+ abort('DVItoMP capacity exceeded (stack size=',stack_size:1,')');
+@.DVItoMP capacity exceeded...@>
+hstack[stk_siz]:=h; vstack[stk_siz]:=v; wstack[stk_siz]:=w;
+xstack[stk_siz]:=x; ystack[stk_siz]:=y; zstack[stk_siz]:=z;
+incr(stk_siz);
+end;
+@#
+procedure do_pop;
+begin if stk_siz=0 then bad_dvi('attempt to pop empty stack')
+else begin decr(stk_siz);
+ h:=hstack[stk_siz]; v:=vstack[stk_siz]; w:=wstack[stk_siz];
+ x:=xstack[stk_siz]; y:=ystack[stk_siz]; z:=zstack[stk_siz];
+ end;
+end;
+
+@ We need to define the |set_virtual_char| procedure now because it is
+mutually recursive with |do_dvi_commands|. This is really a supervisory
+@^recursion@>
+procedure that calls |do_set_char| or adjusts the input source to read
+typesetting commands for a character in a virtual font.
+
+@p procedure do_dvi_commands;forward;@t\2@>
+procedure set_virtual_char(@!f,@!c:integer);
+var @!old_scale:real; {original value of |dvi_scale|}
+@!old_buf_ptr:0..virtual_space; {original value of the input pointer |buf_ptr|}
+@!old_fbase,@!old_ftop:0..max_fnums;
+ {originally applicable part of the |font_num| table}
+begin if fbase[f]=0 then do_set_char(f,c)
+else begin old_fbase:=cur_fbase; old_ftop:=cur_ftop;
+ cur_fbase:=fbase[f]; cur_ftop:=ftop[f];@/
+ old_scale:=dvi_scale;
+ dvi_scale:=dvi_scale*font_scaled_size[f];
+ old_buf_ptr:=buf_ptr;
+ buf_ptr:=start_cmd(f)(c);@/
+ do_push;
+ do_dvi_commands;
+ do_pop;@/
+ buf_ptr:=old_buf_ptr;
+ dvi_scale:=old_scale;
+ cur_fbase:=old_fbase; cur_ftop:=old_ftop;
+ end;
+end;
+
+@ Before we get into the details of |do_dvi_commands|, it is convenient to
+consider a simpler routine that computes the first parameter of each
+opcode.
+
+@d four_cases(#)==#,#+1,#+2,#+3
+@d eight_cases(#)==four_cases(#),four_cases(#+4)
+@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
+@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
+@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
+
+@<Declare a function called |first_par|@>=
+function first_par(o:eight_bits):integer;
+begin case o of
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64):
+ first_par:=o-set_char_0;
+set1,put1,fnt1,xxx1,fnt_def1: first_par:=get_byte;
+set1+1,put1+1,fnt1+1,xxx1+1,fnt_def1+1: first_par:=get_two_bytes;
+set1+2,put1+2,fnt1+2,xxx1+2,fnt_def1+2: first_par:=get_three_bytes;
+right1,w1,x1,down1,y1,z1: first_par:=signed_byte;
+right1+1,w1+1,x1+1,down1+1,y1+1,z1+1: first_par:=signed_pair;
+right1+2,w1+2,x1+2,down1+2,y1+2,z1+2: first_par:=signed_trio;
+set1+3,set_rule,put1+3,put_rule,right1+3,w1+3,x1+3,down1+3,y1+3,z1+3,
+ fnt1+3,xxx1+3,fnt_def1+3: first_par:=signed_quad;
+nop,bop,eop,push,pop,pre,post,post_post,undefined_commands: first_par:=0;
+w0: first_par:=w;
+x0: first_par:=x;
+y0: first_par:=y;
+z0: first_par:=z;
+sixty_four_cases(fnt_num_0): first_par:=o-fnt_num_0;
+end;
+end;
+
+@ Here is the |do_dvi_commands| procedure.
+
+@p procedure do_dvi_commands;
+label 9999;
+var o:eight_bits; {operation code of the current command}
+@!p,@!q:integer; {parameters of the current command}
+@!cur_font:integer; {current internal font number}
+begin if (cur_fbase<cur_ftop) and (buf_ptr<virtual_space) then
+ cur_font:=select_font(font_num[cur_ftop-1]) {select first local font}
+else cur_font:=max_fnums+1; {current font is undefined}
+w:=0; x:=0; y:=0; z:=0; {initialize the state variables}
+while true do @<Translate the next command in the \.{DVI} file;
+ |goto 9999| if it was |eop|@>;
+9999: do_nothing;
+end;
+
+@ The multiway switch in |first_par|, above, was organized by the length
+of each command; the one in |do_dvi_commands| is organized by the semantics.
+
+@ @<Translate the next command...@>=
+begin o:=get_byte; p:=first_par(o);
+if eof(dvi_file) then bad_dvi('the DVI file ended prematurely');
+@.the DVI file ended prematurely@>
+if o<set1+4 then {|set_char_0| through |set_char_127|, |set1| through |set4|}
+ begin if cur_font>max_fnums then
+ if vf_reading then
+ abort('no font selected for character ',p:1,' in virtual font')
+ else bad_dvi('no font selected for character ',p:1);
+@.no font selected@>
+ set_virtual_char(cur_font,p);
+ h:=h+@<Width of character |p| in font |cur_font|@>;
+ end
+else case o of
+ four_cases(put1): set_virtual_char(cur_font,p);
+ set_rule: begin q:=trunc(signed_quad*dvi_scale);
+ do_set_rule(trunc(p*dvi_scale),q);
+ h:=h+q;
+ end;
+ put_rule: do_set_rule(trunc(p*dvi_scale),trunc(signed_quad*dvi_scale));
+ @t\4@>@<Additional cases for translating \.{DVI} command |o| with
+ first paramter |p|@>@;
+ undefined_commands:bad_dvi('undefined command ',o:1);
+@.undefined command@>
+ end; {all cases have been enumerated}
+end
+
+@ @<Additional cases for translating \.{DVI} command |o|...@>=
+four_cases(xxx1): for k:=1 to p do
+ down_the_drain:=get_byte;
+pre,post,post_post: bad_dvi('preamble or postamble within a page!');
+@.preamble or postamble within a page@>
+
+@ @<Additional cases for translating \.{DVI} command |o|...@>=
+nop: do_nothing;
+bop: bad_dvi('bop occurred before eop');
+@.bop occurred before eop@>
+eop: goto 9999;
+push: do_push;
+pop: do_pop;
+
+@ @<Additional cases for translating \.{DVI} command |o|...@>=
+four_cases(right1):h:=h+trunc(p*dvi_scale);
+w0,four_cases(w1):begin w:=trunc(p*dvi_scale); h:=h+w;
+ end;
+x0,four_cases(x1):begin x:=trunc(p*dvi_scale); h:=h+x;
+ end;
+four_cases(down1):v:=v+trunc(p*dvi_scale);
+y0,four_cases(y1):begin y:=trunc(p*dvi_scale); v:=v+y;
+ end;
+z0,four_cases(z1):begin z:=trunc(p*dvi_scale); v:=v+z;
+ end;
+
+@ @<Additional cases for translating \.{DVI} command |o|...@>=
+sixty_four_cases(fnt_num_0),four_cases(fnt1):
+ cur_font:=select_font(p);
+four_cases(fnt_def1): define_font(p);
+
+@* The main program.
+Now we are ready to put it all together. This is where \.{DVItoMP} starts,
+and where it ends.
+
+@p begin initialize; {get all variables initialized}
+@<Process the preamble@>;
+open_mpx_file;
+print_ln(banner);
+begin while true do
+ begin @<Advance to the next |bop| command@>;
+ for k:=0 to 10 do down_the_drain:=signed_quad;
+ @<Do initialization required before starting a new page@>;
+ start_picture;
+ do_dvi_commands;
+ if stk_siz<>0 then bad_dvi('stack not empty at end of page');
+@.stack not empty...@>
+ stop_picture;
+ print_ln('mpxbreak');
+ end;
+done:end;
+final_end:end.
+
+@ The main program needs a few global variables in order to do its work.
+
+@<Glob...@>=
+@!k,@!p:integer; {general purpose registers}
+@!numerator,@!denominator:integer; {stated conversion ratio}
+
+@ @<Process the preamble@>=
+open_dvi_file;
+p:=get_byte; {fetch the first byte}
+if p<>pre then bad_dvi('First byte isn''t start of preamble!');
+@.First byte isn't...@>
+p:=get_byte; {fetch the identification byte}
+if p<>id_byte then
+ warn('identification in byte 1 should be ',id_byte:1,'!');
+@.identification...should be n@>
+@<Compute the conversion factor@>;
+p:=get_byte; {fetch the length of the introductory comment}
+while p>0 do
+ begin decr(p); down_the_drain:=get_byte;
+ end
+
+@ The conversion factor |conv| is figured as follows: There are exactly
+|n/d| decimicrons per \.{DVI} unit, and 254000 decimicrons per inch,
+and |resolution| pixels per inch. Then we have to adjust this
+by the stated amount of magnification. No such adjustment is needed for
+|dvi_per_fix| since it is used to convert design sizes.
+
+@<Compute the conversion factor@>=
+numerator:=signed_quad; denominator:=signed_quad;
+if (numerator<=0)or(denominator<=0) then
+ bad_dvi('bad scale ratio in preamble');
+@.bad scale ratio@>
+mag:=signed_quad/1000.0;
+if mag<=0.0 then bad_dvi('magnification isn''t positive');
+@.magnification isn't positive@>
+conv:=(numerator/254000.0)*(72.0/denominator)*mag;
+dvi_per_fix:=(254000.0/numerator)*(denominator/72.27)/1048576.0;
+
+@ @<Advance to the next |bop| command@>=
+repeat k:=get_byte;
+if (k>=fnt_def1)and(k<fnt_def1+4) then
+ begin p:=first_par(k); define_font(p); k:=nop;
+ end;
+until k<>nop;
+if k=post then goto done;
+if k<>bop then bad_dvi('missing bop');
+@.missing bop@>
+
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVItoMP} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/dvitype.ch b/Build/source/texk/web2c/dvitype.ch
new file mode 100644
index 00000000000..7e05f1c7c95
--- /dev/null
+++ b/Build/source/texk/web2c/dvitype.ch
@@ -0,0 +1,695 @@
+% dvitype.ch for C compilation with web2c.
+%
+% 04/04/83 (PC) Merged with Pavel's change file and made to work with the
+% version 1.0 of DVItype released with version 0.95 of TeX in
+% February, 1983.
+% 04/18/83 (PC) Added changes to module 47 so that it would work the same
+% when input was a file (or pipe) as with a terminal.
+% 06/29/83 (HWT) Brought up to version 1.1 as released with version 0.99 of
+% TeX, with new change file format
+% 07/28/83 (HWT) Brought up to version 2 as released with version 0.999.
+% Only the banner changes.
+% 11/21/83 (HWT) Brought up to version 2.2 as released with version 1.0.
+% 02/19/84 (HWT) Made it use the TEXFONTS environment variable.
+% 03/23/84 (HWT) Brought up to version 2.3.
+% 07/11/84 (HWT) Brought up to version 2.6 as released with version 1.1.
+% 11/07/84 (ETM) Brought up to version 2.7 as released with version 1.2.
+% 03/09/88 (ETM) Brought up to version 2.9
+% 03/16/88 (ETM) Converted for use with WEB to C.
+% 11/30/89 (KB) To version 3.
+% 01/16/90 (SR) To version 3.2.
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{DVI$\,$\lowercase{type} changes for C}
+@z
+
+% [3] Specify the output file to simplify web2c, and don't print the
+% banner until later.
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@y
+@d print(#)==write(stdout, #)
+@d print_ln(#)==write_ln(stdout, #)
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+ print (banner);
+ print_ln (version_string);
+@z
+
+@x [5] Allow more fonts, more widths, no arbitrary filename length.
+@!max_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
+@!max_widths=10000; {maximum number of different characters among all fonts}
+@y
+@!max_fonts=500; {maximum number of distinct fonts per \.{DVI} file}
+@!max_widths=25000; {maximum number of different characters among all fonts}
+@z
+@x
+@!name_size=1000; {total length of all font file names}
+@!name_length=50; {a file name shouldn't be longer than this}
+@y
+@!name_size=10000; {total length of all font file names}
+@z
+
+@x [7] Remove non-local goto.
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+@y
+@d jump_out==uexit(1)
+@d abort(#)==begin write_ln(stderr,#); jump_out; end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+@z
+
+@x [8] Permissive input.
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+@y
+@!ASCII_code=0..255; {a subrange of the integers}
+@z
+
+% [9] The text_char type is used as an array index into `xord'. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@z
+
+@x [23] Fix up opening the files.
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_name);
+end;
+@y
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin
+ cur_name := extend_filename (cmdline (optind), 'dvi');
+ resetbin (dvi_file, cur_name);
+ cur_loc := 0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+var full_name: ^char;
+begin
+ full_name := kpse_find_tfm (cur_name);
+ if full_name then begin
+ tfm_file := fopen (full_name, FOPEN_RBIN_MODE);
+ end else begin
+ tfm_file := nil;
+ end;
+end;
+@z
+
+@x [24] No arbitrary limit on filename length.
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+@!cur_name:^char; {external name}
+@z
+
+@x [27] Make get_n_bytes routines work with 16-bit math.
+get_two_bytes:=a*256+b;
+@y
+get_two_bytes:=a*intcast(256)+b;
+@z
+@x
+get_three_bytes:=(a*256+b)*256+c;
+@y
+get_three_bytes:=(a*intcast(256)+b)*256+c;
+@z
+@x
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+@y
+if a<128 then signed_trio:=(a*intcast(256)+b)*256+c
+else signed_trio:=((a-intcast(256))*256+b)*256+c;
+@z
+@x
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+@y
+if a<128 then signed_quad:=((a*intcast(256)+b)*256+c)*256+d
+else signed_quad:=(((a-256)*intcast(256)+b)*256+c)*256+d;
+@z
+
+@x [28] dvi_length and move_to_byte.
+@p function dvi_length:integer;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin set_pos(dvi_file,n); cur_loc:=n;
+end;
+@y
+@p function dvi_length:integer;
+begin
+ xfseek (dvi_file, 0, 2, 'dvitype');
+ cur_loc := xftell(dvi_file, 'dvitype');
+ dvi_length := cur_loc;
+end;
+@#
+procedure move_to_byte(n:integer);
+begin
+ xfseek (dvi_file, n, 0, 'dvitype');
+ cur_loc:=n;
+end;
+@z
+
+@x [35] Make 16-bit TFM calculations work.
+read_tfm_word; lh:=b2*256+b3;
+read_tfm_word; font_bc[nf]:=b0*256+b1; font_ec[nf]:=b2*256+b3;
+@y
+read_tfm_word; lh:=b2*intcast(256)+b3;
+read_tfm_word; font_bc[nf]:=b0*intcast(256)+b1; font_ec[nf]:=b2*intcast(256)+b3;
+@z
+@x
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3
+@y
+ if b0<128 then tfm_check_sum:=((b0*intcast(256)+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*intcast(256)+b1)*256+b2)*256+b3
+@z
+
+@x [43] Initialize optional variables sooner.
+@ @<Set init...@>=
+out_mode:=the_works; max_pages:=1000000; start_vals:=0; start_there[0]:=false;
+@y
+@ Initializations are done sooner now.
+@z
+
+@x [45] No dialog.
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+@ No dialog.
+@z
+
+@x [47] No input_ln.
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+@y
+@z
+
+@x [48] No dialog.
+@ The global variable |buf_ptr| is used while scanning each line of input;
+it points to the first unread character in |buffer|.
+
+@<Glob...@>=
+@!buf_ptr:0..terminal_line_length; {the number of characters read}
+@y
+@ No dialog.
+@z
+
+@x [49] No dialog.
+@ Here is a routine that scans a (possibly signed) integer and computes
+the decimal value. If no decimal integer starts at |buf_ptr|, the
+value 0 is returned. The integer should be less than $2^{31}$ in
+absolute value.
+
+@p function get_integer:integer;
+var x:integer; {accumulates the value}
+@!negative:boolean; {should the value be negated?}
+begin if buffer[buf_ptr]="-" then
+ begin negative:=true; incr(buf_ptr);
+ end
+else negative:=false;
+x:=0;
+while (buffer[buf_ptr]>="0")and(buffer[buf_ptr]<="9") do
+ begin x:=10*x+buffer[buf_ptr]-"0"; incr(buf_ptr);
+ end;
+if negative then get_integer:=-x @+ else get_integer:=x;
+end;
+
+@y
+@ No dialog.
+@z
+
+@x [50-55] No dialog.
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{DVItype} begins.
+@^system dependencies@>
+
+@p procedure dialog;
+label 1,2,3,4,5;
+var k:integer; {loop variable}
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);
+@<Determine the desired |out_mode|@>;
+@<Determine the desired |start_count| values@>;
+@<Determine the desired |max_pages|@>;
+@<Determine the desired |resolution|@>;
+@<Determine the desired |new_mag|@>;
+@<Print all the selected options@>;
+end;
+
+@ @<Determine the desired |out_mode|@>=
+1: write(term_out,'Output level (default=4, ? for help): ');
+out_mode:=the_works; input_ln;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="4") then out_mode:=buffer[0]-"0"
+ else begin write(term_out,'Type 4 for complete listing,');
+ write(term_out,' 0 for errors and fonts only,');
+ write_ln(term_out,' 1 or 2 or 3 for something in between.');
+ goto 1;
+ end
+
+@ @<Determine the desired |start...@>=
+2: write(term_out,'Starting page (default=*): ');
+start_vals:=0; start_there[0]:=false;
+input_ln; buf_ptr:=0; k:=0;
+if buffer[0]<>" " then
+ repeat if buffer[buf_ptr]="*" then
+ begin start_there[k]:=false; incr(buf_ptr);
+ end
+ else begin start_there[k]:=true; start_count[k]:=get_integer;
+ end;
+ if (k<9)and(buffer[buf_ptr]=".") then
+ begin incr(k); incr(buf_ptr);
+ end
+ else if buffer[buf_ptr]=" " then start_vals:=k
+ else begin write(term_out,'Type, e.g., 1.*.-5 to specify the ');
+ write_ln(term_out,'first page with \count0=1, \count2=-5.');
+ goto 2;
+ end;
+ until start_vals=k
+
+@ @<Determine the desired |max_pages|@>=
+3: write(term_out,'Maximum number of pages (default=1000000): ');
+max_pages:=1000000; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin max_pages:=get_integer;
+ if max_pages<=0 then
+ begin write_ln(term_out,'Please type a positive number.');
+ goto 3;
+ end;
+ end
+
+@ @<Determine the desired |resolution|@>=
+4: write(term_out,'Assumed device resolution');
+write(term_out,' in pixels per inch (default=300/1): ');
+resolution:=300.0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin k:=get_integer;
+ if (k>0)and(buffer[buf_ptr]="/")and
+ (buffer[buf_ptr+1]>"0")and(buffer[buf_ptr+1]<="9") then
+ begin incr(buf_ptr); resolution:=k/get_integer;
+ end
+ else begin write(term_out,'Type a ratio of positive integers;');
+ write_ln(term_out,' (1 pixel per mm would be 254/10).');
+ goto 4;
+ end;
+ end
+
+@ @<Determine the desired |new_mag|@>=
+5: write(term_out,'New magnification (default=0 to keep the old one): ');
+new_mag:=0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="9") then new_mag:=get_integer
+ else begin write(term_out,'Type a positive integer to override ');
+ write_ln(term_out,'the magnification in the DVI file.');
+ goto 5;
+ end
+@y
+@ No dialog (50).
+@ No dialog (51).
+@ No dialog (52).
+@ No dialog (53).
+@ No dialog (54).
+@ No dialog (55).
+@z
+
+@x [56] Fix printing of floating point number.
+print_ln(' Resolution = ',resolution:12:8,' pixels per inch');
+if new_mag>0 then print_ln(' New magnification factor = ',new_mag/1000:8:3)
+@y
+print (' Resolution = ');
+print_real (resolution, 12, 8);
+print_ln (' pixels per inch');
+if new_mag > 0
+then begin
+ print (' New magnification factor = ');
+ print_real (new_mag / 1000.0, 8, 3);
+ print_ln('')
+end
+@z
+
+@x [59] We use r for something else.
+@!r:0..name_length; {index into |cur_name|}
+@y
+@!r:0..name_size; {current filename length}
+@z
+
+@x [62] <Load the new font...> close the file when we're done
+if out_mode=errors_only then print_ln(' ');
+@y
+if out_mode=errors_only then print_ln(' ');
+if tfm_file then
+ xfclose (tfm_file, cur_name); {should be the |kpse_find_tfm| result}
+free (cur_name); {We |xmalloc|'d this before we got called.}
+@z
+
+@x [64] Don't set default_directory_name.
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+@y
+Under Unix, users have a path searched for fonts, there's no single
+default directory.
+@z
+
+@x [65] Remove initialization of default_directory.
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+@y
+@ (No initialization needs to be done. Keep this module to preserve
+numbering.)
+@z
+
+@x [66] Don't append `.tfm' here, and keep lowercase.
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@^system dependencies@>
+
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if p=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_name[nf] to font_name[nf+1]-1 do
+ begin incr(r);
+ if r+4>name_length then
+ abort('DVItype capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItype capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+@y
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. We do not impose a maximum limit
+here. It's too bad there is a limit on the total length of all
+filenames, but it doesn't seem worth reprogramming all that.
+@^system dependencies@>
+
+@d name_start == font_name[nf]
+@d name_end == font_name[nf+1]
+
+@<Move font name into the |cur_name| string@>=
+r := name_end - name_start;
+cur_name := xmalloc_array (char, r);
+{|strncpy| might be faster, but it's probably a good idea to keep the
+ |xchr| translation.}
+for k := name_start to name_end do begin
+ cur_name[k - name_start] := xchr[names[k]];
+end;
+cur_name[r] := 0; {Append null byte for C.}
+@z
+
+@x [80] (major,minor) optionally show opcode
+@d show(#)==begin flush_text; showing:=true; print(a:1,': ',#);
+ end
+@d major(#)==if out_mode>errors_only then show(#)
+@d minor(#)==if out_mode>terse then
+ begin showing:=true; print(a:1,': ',#);
+@y
+@d show(#)==begin flush_text; showing:=true; print(a:1,': ',#);
+ if show_opcodes and (o >= 128) then print (' {', o:1, '}');
+ end
+@d major(#)==if out_mode>errors_only then show(#)
+@d minor(#)==if out_mode>terse then
+ begin showing:=true; print(a:1,': ',#);
+ if show_opcodes and (o >= 128) then print (' {', o:1, '}');
+@z
+
+@x [106] (main) No dialog; remove unused label.
+dialog; {set up all the options}
+@y
+@<Print all the selected options@>;
+@z
+
+@x
+final_end:end.
+@y
+end.
+@z
+
+@x [109] Fix another floating point print.
+print_ln('magnification=',mag:1,'; ',conv:16:8,' pixels per DVI unit')
+@y
+print ('magnification=', mag:1, '; ');
+print_real (conv, 16, 8);
+print_ln (' pixels per DVI unit')
+@z
+
+@x [111] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVItype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 8; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+ @!end_num:^char; {for \.{page-start}}
+begin
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('dvitype');
+
+ end else if argument_is ('help') then begin
+ usage_help (DVITYPE_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.E. Knuth');
+
+ end else if argument_is ('output-level') then begin
+ out_mode := optarg[0] - '0';
+ if (out_mode < 0) or (out_mode > 4) or (optarg[1] <> 0) then begin
+ write_ln (stderr, 'Value for --output-level must be >= 0 and <= 4.');
+ uexit (1);
+ end;
+
+ end else if argument_is ('page-start') then begin
+ @<Determine the desired |start_count| values from |optarg|@>;
+
+ end else if argument_is ('max-pages') then begin
+ max_pages := atou (optarg);
+
+ end else if argument_is ('dpi') then begin
+ resolution := atof (optarg);
+
+ end else if argument_is ('magnification') then begin
+ new_mag := atou (optarg);
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 1 <> argc) then begin
+ write_ln (stderr, 'dvitype: Need exactly one file argument.');
+ usage ('dvitype');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ How verbose to be.
+@.-output-level@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'output-level';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+out_mode := the_works; {default}
+
+@ What page to start at.
+@.-page-start@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'page-start';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Parsing the starting page specification is a bit complicated.
+
+@<Determine the desired |start_count|...@> =
+k := 0; {which \.{\\count} register we're on}
+m := 0; {position in |optarg|}
+while optarg[m] do begin
+ if optarg[m] = "*" then begin
+ start_there[k] := false;
+ incr (m);
+
+ end else if optarg[m] = "." then begin
+ incr (k);
+ if k >= 10 then begin
+ write_ln (stderr, 'dvitype: More than ten count registers specified.');
+ uexit (1);
+ end;
+ incr (m);
+
+ end else begin
+ start_count[k] := strtol (optarg + m, address_of (end_num), 10);
+ if end_num = optarg + m then begin
+ write_ln (stderr, 'dvitype: -page-start values must be numeric or *.');
+ uexit (1);
+ end;
+ start_there[k] := true;
+ m := m + end_num - (optarg + m);
+ end;
+end;
+start_vals := k;
+
+@ How many pages to do.
+@.-max-pages@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'max-pages';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+max_pages := 1000000; {default}
+
+@ Resolution, in pixels per inch.
+@.-dpi@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'dpi';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+resolution := 300.0; {default}
+
+@ Magnification to apply.
+@.-magnification@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'magnification';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+new_mag := 0; {default is to keep the old one}
+
+@ Whether to show numeric opcodes.
+@.-show-opcodes@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'show-opcodes';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (show_opcodes);
+long_options[current_option].val := 1;
+incr (current_option);
+new_mag := 0; {default is to keep the old one}
+
+@ @<Glob...@> =
+@!show_opcodes: c_int_type;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/dvitype.rc b/Build/source/texk/web2c/dvitype.rc
new file mode 100644
index 00000000000..81ae833f46d
--- /dev/null
+++ b/Build/source/texk/web2c/dvitype.rc
@@ -0,0 +1,32 @@
+/* dvitype.rc: dvitype resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " dvitype 3.6"
+
+#define VER_INTERNALNAME_STR "dvitype"
+#define VER_ORIGINALFILENAME_STR "dvitype.exe"
+
+#define VER_FILEDESCRIPTION_STR "Converts DVI files into symbolic form"
+
+#include <texlive.version>
+
+/* dvitype.rc ends here */
diff --git a/Build/source/texk/web2c/dvitype.web b/Build/source/texk/web2c/dvitype.web
new file mode 100644
index 00000000000..a0c5dba2c77
--- /dev/null
+++ b/Build/source/texk/web2c/dvitype.web
@@ -0,0 +1,2506 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was completed in September, 1982.
+% Slight changes were made in October, 1982, for version 0.7 of TeX.
+% Version 1.1 corrected minor bugs (May, 1983).
+% Version 2 was released with version 0.999 of TeX (July, 1983).
+% Version 2.1 corrected a bug when no fonts are present (September, 1983).
+% Version 2.2 corrected bugs in max_*_so_far and put1 (October, 1983).
+% Version 2.3 corrected spacing of accents (March, 1984).
+% Version 2.4 fixed rounding, changed oriental font conventions (April, 1984).
+% Version 2.5 improved the case of zero pages (May, 1984).
+% Version 2.6 introduced max_drift (June, 1984).
+% Version 2.7 had minor editorial changes (August, 1984).
+% Version 2.8 made default resolution 300/1 (April, 1985).
+% Version 2.9 changed negative scaling as in TeX version 2.7 (November, 1987).
+% Version 3 introduced an intermediate level of verbosity (October,1989).
+% Version 3.1 gave magnification info in final font list (November, 1989).
+% Version 3.2 doublechecked design size of each font (January, 1990).
+% Version 3.3 had more robust for loops in print_font, define_font (May, 1990).
+% Version 3.4 more robustness in presence of bad fonts (September, 1990).
+% Version 3.5 checked skipped material more strictly (March, 1995).
+% Version 3.6 gives a better help message (December, 1995).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{DVI$\,$\lowercase{type}}
+\def\contentspagenumber{401}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont DVItype} processor}
+ \vskip 15pt
+ \centerline{(Version 3.6, December 1995)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{DVItype} utility program reads binary device-independent (``\.{DVI}'')
+files that are produced by document compilers such as \TeX, and converts them
+into symbolic form. This program has two chief purposes: (1)~It can be used to
+determine whether a \.{DVI} file is valid or invalid, when diagnosing
+compiler errors; and (2)~it serves as an example of a program that reads
+\.{DVI} files correctly, for system programmers who are developing
+\.{DVI}-related software.
+
+Goal number (2) needs perhaps a bit more explanation. Programs for
+typesetting need to be especially careful about how they do arithmetic; if
+rounding errors accumulate, margins won't be straight, vertical rules
+won't line up, and so on. But if rounding is done everywhere, even in the
+midst of words, there will be uneven spacing between the letters, and that
+looks bad. Human eyes notice differences of a thousandth of an inch in the
+positioning of lines that are close together; on low resolution devices,
+where rounding produces effects four times as great as this, the problem
+is especially critical. Experience has shown that unusual care is needed
+even on high-resolution equipment; for example, a mistake in the sixth
+significant hexadecimal place of a constant once led to a difficult-to-find
+bug in some software for the Alphatype CRS, which has a resolution of 5333
+pixels per inch (make that 5333.33333333 pixels per inch). The document
+compilers that generate \.{DVI} files make certain assumptions about the
+arithmetic that will be used by \.{DVI}-reading software, and if these
+assumptions are violated the results will be of inferior quality.
+Therefore the present program is intended as a guide to proper procedure
+in the critical places where a bit of subtlety is involved.
+
+The first \.{DVItype} program was designed by David Fuchs in 1979, and it
+@^Fuchs, David Raymond@>
+went through several versions on different computers as the format of
+\.{DVI} files was evolving to its present form. Peter Breitenlohner
+helped with the latest revisions.
+@^Breitenlohner, Peter@>
+
+The |banner| string defined here should be changed whenever \.{DVItype}
+gets modified.
+
+@d banner=='This is DVItype, Version 3.6' {printed when the program starts}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{DVItype} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+All places where nonstandard constructions are used have been listed in
+the index under ``system dependencies.''
+@!@^system dependencies@>
+
+One of the extensions to standard \PASCAL\ that we shall deal with is the
+ability to move to a random place in a binary file; another is to
+determine the length of a binary file. Such extensions are not necessary
+for reading \.{DVI} files, and they are not important for efficiency
+reasons either---an infrequently used program like \.{DVItype} does not
+have to be efficient. But they are included there because of \.{DVItype}'s
+r\^^Dole as a model of a \.{DVI} reading routine, since other \.{DVI}
+processors ought to be highly efficient. If \.{DVItype} is being used with
+\PASCAL s for which random file positioning is not efficiently available,
+the following definition should be changed from |true| to |false|; in such
+cases, \.{DVItype} will not include the optional feature that reads the
+postamble first.
+
+Another extension is to use a default |case| as in \.{TANGLE}, \.{WEAVE},
+etc.
+
+@d random_reading==true {should we skip around in the file?}
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The binary input comes from |dvi_file|, and the symbolic output is written
+on \PASCAL's standard |output| file. The term |print| is used instead of
+|write| when this program writes on |output|, so that all such output
+could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program DVI_type(@!dvi_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'. Another label, |done|, is used when stopping normally.
+
+@d final_end=9999 {label for the end of it all}
+@d done=30 {go here when finished with a subtask}
+
+@<Labels...@>=final_end,done;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{DVItype}'s capacity.
+
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
+@!max_widths=10000; {maximum number of different characters among all fonts}
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!name_size=1000; {total length of all font file names}
+@!name_length=50; {a file name shouldn't be longer than this}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ If the \.{DVI} file is badly malformed, the whole process must be aborted;
+\.{DVItype} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{DVItype}.
+@^system dependencies@>
+
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{DVItype} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used, and because \.{DVI} files use ASCII code for file names
+and certain other strings.
+
+The next few sections of \.{DVItype} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{DVItype} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+If such codes appear in the \.{DVI} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{DVItype}.
+So we shall assume that the \PASCAL\ system being used for \.{DVItype}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{DVItype} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Device-independent file format.
+Before we get into the details of \.{DVItype}, we need to know exactly
+what \.{DVI} files are. The form of such files was designed by David R.
+@^Fuchs, David Raymond@>
+Fuchs in 1979. Almost any reasonable typesetting device can be driven by
+a program that takes \.{DVI} files as input, and dozens of such
+\.{DVI}-to-whatever programs have been written. Thus, it is possible to
+print the output of document compilers like \TeX\ on many different kinds
+of equipment.
+
+A \.{DVI} file is a stream of 8-bit bytes, which may be regarded as a
+series of commands in a machine-like language. The first byte of each command
+is the operation code, and this code is followed by zero or more bytes
+that provide parameters to the command. The parameters themselves may consist
+of several consecutive bytes; for example, the `|set_rule|' command has two
+parameters, each of which is four bytes long. Parameters are usually
+regarded as nonnegative integers; but four-byte-long parameters,
+and shorter parameters that denote distances, can be
+either positive or negative. Such parameters are given in two's complement
+notation. For example, a two-byte-long distance parameter has a value between
+$-2^{15}$ and $2^{15}-1$.
+@.DVI {\rm files}@>
+
+A \.{DVI} file consists of a ``preamble,'' followed by a sequence of one
+or more ``pages,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that define the dimensions used in the
+file; this must come first. Each ``page'' consists of a |bop| command,
+followed by any number of other commands that tell where characters are to
+be placed on a physical page, followed by an |eop| command. The pages
+appear in the order that they were generated, not in any particular
+numerical order. If we ignore |nop| commands and \\{fnt\_def} commands
+(which are allowed between any two commands in the file), each |eop|
+command is immediately followed by a |bop| command, or by a |post|
+command; in the latter case, there are no more pages in the file, and the
+remaining bytes form the postamble. Further details about the postamble
+will be explained later.
+
+Some parameters in \.{DVI} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first byte is number~0, then comes number~1, and so on. For example,
+one of the parameters of a |bop| command points to the previous |bop|;
+this makes it feasible to read the pages in backwards order, in case the
+results are being directed to a device that stacks its output face up.
+Suppose the preamble of a \.{DVI} file occupies bytes 0 to 99. Now if the
+first page occupies bytes 100 to 999, say, and if the second
+page occupies bytes 1000 to 1999, then the |bop| that starts in byte 1000
+points to 100 and the |bop| that starts in byte 2000 points to 1000. (The
+very first |bop|, i.e., the one that starts in byte 100, has a pointer of $-1$.)
+
+@ The \.{DVI} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+implicit instead of explicit. When a \.{DVI}-reading program reads the
+commands for a page, it keeps track of several quantities: (a)~The current
+font |f| is an integer; this value is changed only
+by \\{fnt} and \\{fnt\_num} commands. (b)~The current position on the page
+is given by two numbers called the horizontal and vertical coordinates,
+|h| and |v|. Both coordinates are zero at the upper left corner of the page;
+moving to the right corresponds to increasing the horizontal coordinate, and
+moving down corresponds to increasing the vertical coordinate. Thus, the
+coordinates are essentially Cartesian, except that vertical directions are
+flipped; the Cartesian version of |(h,v)| would be |(h,-v)|. (c)~The
+current spacing amounts are given by four numbers |w|, |x|, |y|, and |z|,
+where |w| and~|x| are used for horizontal spacing and where |y| and~|z|
+are used for vertical spacing. (d)~There is a stack containing
+|(h,v,w,x,y,z)| values; the \.{DVI} commands |push| and |pop| are used to
+change the current level of operation. Note that the current font~|f| is
+not pushed and popped; the stack contains only information about
+positioning.
+
+The values of |h|, |v|, |w|, |x|, |y|, and |z| are signed integers having up
+to 32 bits, including the sign. Since they represent physical distances,
+there is a small unit of measurement such that increasing |h| by~1 means
+moving a certain tiny distance to the right. The actual unit of
+measurement is variable, as explained below.
+
+@ Here is a list of all the commands that may appear in a \.{DVI} file. Each
+command is specified by its symbolic name (e.g., |bop|), its opcode byte
+(e.g., 139), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|p[4]|' means that parameter |p| is four bytes long.
+
+\yskip\hang|set_char_0| 0. Typeset character number~0 from font~|f|
+such that the reference point of the character is at |(h,v)|. Then
+increase |h| by the width of that character. Note that a character may
+have zero or negative width, so one cannot be sure that |h| will advance
+after this command; but |h| usually does increase.
+
+\yskip\hang|set_char_1| through |set_char_127| (opcodes 1 to 127).
+Do the operations of |set_char_0|; but use the character whose number
+matches the opcode, instead of character~0.
+
+\yskip\hang|set1| 128 |c[1]|. Same as |set_char_0|, except that character
+number~|c| is typeset. \TeX82 uses this command for characters in the
+range |128<=c<256|.
+
+\yskip\hang|set2| 129 |c[2]|. Same as |set1|, except that |c|~is two
+bytes long, so it is in the range |0<=c<65536|. \TeX82 never uses this
+command, which is intended for processors that deal with oriental languages;
+but \.{DVItype} will allow character codes greater than 255, assuming that
+they all have the same width as the character whose code is $c \bmod 256$.
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+\yskip\hang|set3| 130 |c[3]|. Same as |set1|, except that |c|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|set4| 131 |c[4]|. Same as |set1|, except that |c|~is four
+bytes long, possibly even negative. Imagine that.
+
+\yskip\hang|set_rule| 132 |a[4]| |b[4]|. Typeset a solid black rectangle
+of height |a| and width |b|, with its bottom left corner at |(h,v)|. Then
+set |h:=h+b|. If either |a<=0| or |b<=0|, nothing should be typeset. Note
+that if |b<0|, the value of |h| will decrease even though nothing else happens.
+Programs that typeset from \.{DVI} files should be careful to make the rules
+line up carefully with digitized characters, as explained in connection with
+the |rule_pixels| subroutine below.
+
+\yskip\hang|put1| 133 |c[1]|. Typeset character number~|c| from font~|f|
+such that the reference point of the character is at |(h,v)|. (The `put'
+commands are exactly like the `set' commands, except that they simply put out a
+character or a rule without moving the reference point afterwards.)
+
+\yskip\hang|put2| 134 |c[2]|. Same as |set2|, except that |h| is not changed.
+
+\yskip\hang|put3| 135 |c[3]|. Same as |set3|, except that |h| is not changed.
+
+\yskip\hang|put4| 136 |c[4]|. Same as |set4|, except that |h| is not changed.
+
+\yskip\hang|put_rule| 137 |a[4]| |b[4]|. Same as |set_rule|, except that
+|h| is not changed.
+
+\yskip\hang|nop| 138. No operation, do nothing. Any number of |nop|'s
+may occur between \.{DVI} commands, but a |nop| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|bop| 139 $c_0[4]$ $c_1[4]$ $\ldots$ $c_9[4]$ $p[4]$. Beginning
+of a page: Set |(h,v,w,x,y,z):=(0,0,0,0,0,0)| and set the stack empty. Set
+the current font |f| to an undefined value. The ten $c_i$ parameters can
+be used to identify pages, if a user wants to print only part of a \.{DVI}
+file; \TeX82 gives them the values of \.{\\count0} $\ldots$ \.{\\count9}
+at the time \.{\\shipout} was invoked for this page. The parameter |p|
+points to the previous |bop| command in the file, where the first |bop|
+has $p=-1$.
+
+\yskip\hang|eop| 140. End of page: Print what you have read since the
+previous |bop|. At this point the stack should be empty. (The \.{DVI}-reading
+programs that drive most output devices will have kept a buffer of the
+material that appears on the page that has just ended. This material is
+largely, but not entirely, in order by |v| coordinate and (for fixed |v|) by
+|h|~coordinate; so it usually needs to be sorted into some order that is
+appropriate for the device in question. \.{DVItype} does not do such sorting.)
+
+\yskip\hang|push| 141. Push the current values of |(h,v,w,x,y,z)| onto the
+top of the stack; do not change any of these values. Note that |f| is
+not pushed.
+
+\yskip\hang|pop| 142. Pop the top six values off of the stack and assign
+them to |(h,v,w,x,y,z)|. The number of pops should never exceed the number
+of pushes, since it would be highly embarrassing if the stack were empty
+at the time of a |pop| command.
+
+\yskip\hang|right1| 143 |b[1]|. Set |h:=h+b|, i.e., move right |b| units.
+The parameter is a signed number in two's complement notation, |-128<=b<128|;
+if |b<0|, the reference point actually moves left.
+
+\yskip\hang|right2| 144 |b[2]|. Same as |right1|, except that |b| is a
+two-byte quantity in the range |-32768<=b<32768|.
+
+\yskip\hang|right3| 145 |b[3]|. Same as |right1|, except that |b| is a
+three-byte quantity in the range |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|right4| 146 |b[4]|. Same as |right1|, except that |b| is a
+four-byte quantity in the range |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|w0| 147. Set |h:=h+w|; i.e., move right |w| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|w| gets particular values.
+
+\yskip\hang|w1| 148 |b[1]|. Set |w:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |w|~spacing and moves right by |b|.
+
+\yskip\hang|w2| 149 |b[2]|. Same as |w1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|w3| 150 |b[3]|. Same as |w1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|w4| 151 |b[4]|. Same as |w1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|x0| 152. Set |h:=h+x|; i.e., move right |x| units. The `|x|'
+commands are like the `|w|' commands except that they involve |x| instead
+of |w|.
+
+\yskip\hang|x1| 153 |b[1]|. Set |x:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |x|~spacing and moves right by |b|.
+
+\yskip\hang|x2| 154 |b[2]|. Same as |x1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|x3| 155 |b[3]|. Same as |x1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|x4| 156 |b[4]|. Same as |x1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|down1| 157 |a[1]|. Set |v:=v+a|, i.e., move down |a| units.
+The parameter is a signed number in two's complement notation, |-128<=a<128|;
+if |a<0|, the reference point actually moves up.
+
+\yskip\hang|down2| 158 |a[2]|. Same as |down1|, except that |a| is a
+two-byte quantity in the range |-32768<=a<32768|.
+
+\yskip\hang|down3| 159 |a[3]|. Same as |down1|, except that |a| is a
+three-byte quantity in the range |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|down4| 160 |a[4]|. Same as |down1|, except that |a| is a
+four-byte quantity in the range |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|y0| 161. Set |v:=v+y|; i.e., move down |y| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|y| gets particular values.
+
+\yskip\hang|y1| 162 |a[1]|. Set |y:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |y|~spacing and moves down by |a|.
+
+\yskip\hang|y2| 163 |a[2]|. Same as |y1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|y3| 164 |a[3]|. Same as |y1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|y4| 165 |a[4]|. Same as |y1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|z0| 166. Set |v:=v+z|; i.e., move down |z| units. The `|z|' commands
+are like the `|y|' commands except that they involve |z| instead of |y|.
+
+\yskip\hang|z1| 167 |a[1]|. Set |z:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |z|~spacing and moves down by |a|.
+
+\yskip\hang|z2| 168 |a[2]|. Same as |z1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|z3| 169 |a[3]|. Same as |z1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|z4| 170 |a[4]|. Same as |z1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|fnt_num_0| 171. Set |f:=0|. Font 0 must previously have been
+defined by a \\{fnt\_def} instruction, as explained below.
+
+\yskip\hang|fnt_num_1| through |fnt_num_63| (opcodes 172 to 234). Set
+|f:=1|, \dots, |f:=63|, respectively.
+
+\yskip\hang|fnt1| 235 |k[1]|. Set |f:=k|. \TeX82 uses this command for font
+numbers in the range |64<=k<256|.
+
+\yskip\hang|fnt2| 236 |k[2]|. Same as |fnt1|, except that |k|~is two
+bytes long, so it is in the range |0<=k<65536|. \TeX82 never generates this
+command, but large font numbers may prove useful for specifications of
+color or texture, or they may be used for special fonts that have fixed
+numbers in some external coding scheme.
+
+\yskip\hang|fnt3| 237 |k[3]|. Same as |fnt1|, except that |k|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|fnt4| 238 |k[4]|. Same as |fnt1|, except that |k|~is four
+bytes long; this is for the really big font numbers (and for the negative ones).
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |nop| unless special \.{DVI}-reading
+programs are being used. \TeX82 generates |xxx1| when a short enough
+\.{\\special} appears, setting |k| to the number of bytes being sent. It
+is recommended that |x| be a string having the form of a keyword followed
+by possible parameters relevant to that keyword.
+
+\yskip\hang|xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be ridiculously
+large. \TeX82 uses |xxx4| when |xxx1| would be incorrect.
+
+\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<256|; font definitions will be explained shortly.
+
+\yskip\hang|fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<65536|.
+
+\yskip\hang|fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
+
+\yskip\hang|pre| 247 |i[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameters |i|, |num|, |den|, |mag|, |k|, and |x| are explained below.
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@ @d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The preamble contains basic information about the file as a whole. As
+stated above, there are six parameters:
+$$\hbox{|@!i[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
+The |i| byte identifies \.{DVI} format; currently this byte is always set
+to~2. (The value |i=3| is currently used for an extended format that
+allows a mixture of right-to-left and left-to-right typesetting.
+Some day we will set |i=4|, when \.{DVI} format makes another
+incompatible change---perhaps in the year 2048.)
+
+The next two parameters, |num| and |den|, are positive integers that define
+the units of measurement; they are the numerator and denominator of a
+fraction by which all dimensions in the \.{DVI} file could be multiplied
+in order to get lengths in units of $10^{-7}$ meters. (For example, there are
+exactly 7227 \TeX\ points in 254 centimeters, and \TeX82 works with scaled
+points where there are $2^{16}$ sp in a point, so \TeX82 sets |num=25400000|
+and $|den|=7227\cdot2^{16}=473628672$.)
+@^sp@>
+
+The |mag| parameter is what \TeX82 calls \.{\\mag}, i.e., 1000 times the
+desired magnification. The actual fraction by which dimensions are
+multiplied is therefore $mn/1000d$. Note that if a \TeX\ source document
+does not call for any `\.{true}' dimensions, and if you change it only by
+specifying a different \.{\\mag} setting, the \.{DVI} file that \TeX\
+creates will be completely unchanged except for the value of |mag| in the
+preamble and postamble. (Fancy \.{DVI}-reading programs allow users to
+override the |mag|~setting when a \.{DVI} file is being printed.)
+
+Finally, |k| and |x| allow the \.{DVI} writer to include a comment, which is not
+interpreted further. The length of comment |x| is |k|, where |0<=k<256|.
+
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+
+@ Font definitions for a given font number |k| contain further parameters
+$$\hbox{|c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.}$$
+The four-byte value |c| is the check sum that \TeX\ (or whatever program
+generated the \.{DVI} file) found in the \.{TFM} file for this font;
+|c| should match the check sum of the font found by programs that read
+this \.{DVI} file.
+@^check sum@>
+
+Parameter |s| contains a fixed-point scale factor that is applied to the
+character widths in font |k|; font dimensions in \.{TFM} files and other
+font files are relative to this quantity, which is always positive and
+less than $2^{27}$. It is given in the same units as the other dimensions
+of the \.{DVI} file. Parameter |d| is similar to |s|; it is the ``design
+size,'' and (like~|s|) it is given in \.{DVI} units. Thus, font |k| is to be
+used at $|mag|\cdot s/1000d$ times its normal size.
+
+The remaining part of a font definition gives the external name of the font,
+which is an ASCII string of length |a+l|. The number |a| is the length
+of the ``area'' or directory, and |l| is the length of the font name itself;
+the standard local system font area is supposed to be used when |a=0|.
+The |n| field contains the area in its first |a| bytes.
+
+Font definitions must appear before the first use of a particular font number.
+Once font |k| is defined, it must not be defined again; however, we
+shall see below that font definitions appear in the postamble as well as
+in the pages, so in this sense each font number is defined exactly twice,
+if at all. Like |nop| commands, font definitions can
+appear before the first |bop|, or between an |eop| and a |bop|.
+
+@ The last page in a \.{DVI} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \TeX\ has
+accumulated about the file, making it possible to print subsets of the data
+with reasonable efficiency. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |num[4]| |den[4]| |mag[4]| |l[4]| |u[4]| |s[2]| |t[2]|\cr
+ $\langle\,$font definitions$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the final |bop| in the file. The next three
+parameters, |num|, |den|, and |mag|, are duplicates of the quantities that
+appeared in the preamble.
+
+Parameters |l| and |u| give respectively the height-plus-depth of the tallest
+page and the width of the widest page, in the same units as other dimensions
+of the file. These numbers might be used by a \.{DVI}-reading program to
+position individual ``pages'' on large sheets of film or paper; however,
+the standard convention for output on normal size paper is to position each
+page so that the upper left-hand corner is exactly one inch from the left
+and the top. Experience has shown that it is unwise to design \.{DVI}-to-printer
+software that attempts cleverly to center the output; a fixed position of
+the upper left corner is easiest for users to understand and to work with.
+Therefore |l| and~|u| are often ignored.
+
+Parameter |s| is the maximum stack depth (i.e., the largest excess of
+|push| commands over |pop| commands) needed to process this file. Then
+comes |t|, the total number of pages (|bop| commands) present.
+
+The postamble continues with font definitions, which are any number of
+\\{fnt\_def} commands as described above, possibly interspersed with |nop|
+commands. Each font number that is used in the \.{DVI} file must be defined
+exactly twice: Once before it is first selected by a \\{fnt} command, and once
+in the postamble.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the font definitions, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~2, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \TeX\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{DVI} file makes it feasible for
+\.{DVI}-reading programs to find the postamble first, on most computers,
+even though \TeX\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{DVI} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{DVI} reader discovers all the information needed for typesetting the
+pages. Note that it is also possible to skip through the \.{DVI} file at
+reasonably high speed to locate a particular page, if that proves
+desirable. This saves a lot of time, since \.{DVI} files used in production
+jobs tend to be large.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{DVI}
+format has been designed to work most efficiently with modern operating systems.
+As noted above, \.{DVItype} will limit itself to the restrictions of standard
+\PASCAL\ if |random_reading| is defined to be |false|.
+
+@* Input from binary files.
+We have seen that a \.{DVI} file is a sequence of 8-bit bytes. The bytes
+appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{DVItype} is written in standard \PASCAL.
+@^system dependencies@>
+
+One common way to solve the problem is to consider files of |integer|
+numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
+a sequence of four bytes $(a,b,c,d)$ using the following code, which
+avoids the controversial integer division of negative numbers:
+$$\vbox{\halign{#\hfil\cr
+|if x>=0 then a:=x div @'100000000|\cr
+|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
+\quad|end|\cr
+|x:=x mod @'100000000;|\cr
+|b:=x div @'200000; x:=x mod @'200000;|\cr
+|c:=x div @'400; d:=x mod @'400;|\cr}}$$
+The four bytes are then kept in a buffer and output one by one. (On 36-bit
+computers, an additional division by 16 is necessary at the beginning.
+Another way to separate an integer into four bytes is to use/abuse
+\PASCAL's variant records, storing an integer and retrieving bytes that are
+packed in the same place; {\sl caveat implementor!\/}) It is also desirable
+in some cases to read a hundred or so integers at a time, maintaining a
+larger buffer.
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with two binary file variables: |dvi_file| is the main
+input file that we are translating into symbolic form, and |tfm_file| is
+the current font metric file from which character-width information is
+being read.
+
+@<Glob...@>=
+@!dvi_file:byte_file; {the stuff we are \.{DVI}typing}
+@!tfm_file:byte_file; {a font metric file}
+
+@ To prepare these files for input, we |reset| them. An extension of
+\PASCAL\ is needed in the case of |tfm_file|, since we want to associate
+it with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_name);
+end;
+
+@ If you looked carefully at the preceding code, you probably asked,
+``What are |cur_loc| and |cur_name|?'' Good question. They're global
+variables: |cur_loc| is the number of the byte about to be read next from
+|dvi_file|, and |cur_name| is a string variable that will be set to the
+current font metric file name before |open_tfm_file| is called.
+
+@<Glob...@>=
+@!cur_loc:integer; {where we are about to look, in |dvi_file|}
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+
+@ It turns out to be convenient to read four bytes at a time, when we are
+inputting from \.{TFM} files. The input goes into global variables
+|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3|
+the fourth.
+
+@<Glob...@>=
+@!b0,@!b1,@!b2,@!b3: eight_bits; {four bytes input at once}
+
+@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
+four bytes in the current \.{TFM} file.
+@^system dependencies@>
+
+@p procedure read_tfm_word;
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+end;
+
+@ We shall use another set of simple functions to read the next byte or
+bytes from |dvi_file|. There are seven possibilities, each of which is
+treated as a separate function in order to minimize the overhead for
+subroutine calls.
+@^system dependencies@>
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(dvi_file) then get_byte:=0
+else begin read(dvi_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(dvi_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@ Finally we come to the routines that are used only if |random_reading| is
+|true|. The driver program below needs two such routines: |dvi_length| should
+compute the total number of bytes in |dvi_file|, possibly also
+causing |eof(dvi_file)| to be true; and |move_to_byte(n)|
+should position |dvi_file| so that the next |get_byte| will read byte |n|,
+starting with |n=0| for the first byte in the file.
+@^system dependencies@>
+
+Such routines are, of course, highly system dependent. They are implemented
+here in terms of two assumed system routines called |set_pos| and |cur_pos|.
+The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
+negative or larger than the total number of items in |f|; in the latter
+case, |set_pos(f,n)| moves to the end of file |f|.
+The call |cur_pos(f)| gives the total number of items in |f|, if
+|eof(f)| is true; we use |cur_pos| only in such a situation.
+
+@p function dvi_length:integer;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin set_pos(dvi_file,n); cur_loc:=n;
+end;
+
+@* Reading the font information.
+\.{DVI} file format does not include information about character widths, since
+that would tend to make the files a lot longer. But a program that reads
+a \.{DVI} file is supposed to know the widths of the characters that appear
+in \\{set\_char} commands. Therefore \.{DVItype} looks at the font metric
+(\.{TFM}) files for the fonts that are involved.
+@.TFM {\rm files}@>
+
+The character-width data appears also in other files (e.g., in \.{GF} files
+that specify bit patterns for digitized characters);
+thus, it is usually possible for \.{DVI} reading programs to get by with
+accessing only one file per font. \.{DVItype} has a comparatively easy
+task in this regard, since it needs only a few words of information from
+each font; other \.{DVI}-to-printer programs may have to go to some pains to
+deal with complications that arise when a large number of large font files
+all need to be accessed simultaneously.
+
+@ For purposes of this program, we need to know only two things about a
+given character |c| in a given font |f|: (1)~Is |c| a legal character
+in~|f|? (2)~If so, what is the width of |c|? We also need to know the
+symbolic name of each font, so it can be printed out, and we need to know
+the approximate size of inter-word spaces in each font.
+
+The answers to these questions appear implicitly in the following data
+structures. The current number of known fonts is |nf|. Each known font has
+an internal number |f|, where |0<=f<nf|; the external number of this font,
+i.e., its font identification number in the \.{DVI} file, is
+|font_num[f]|, and the external name of this font is the string that
+occupies positions |font_name[f]| through |font_name[f+1]-1| of the array
+|names|. The latter array consists of |ASCII_code| characters, and
+|font_name[nf]| is its first unoccupied position. A horizontal motion
+in the range |-4*font_space[f]<h<font_space[f]|
+will be treated as a `kern' that is not
+indicated in the printouts that \.{DVItype} produces between brackets. The
+legal characters run from |font_bc[f]| to |font_ec[f]|, inclusive; more
+precisely, a given character |c| is valid in font |f| if and only if
+|font_bc[f]<=c<=font_ec[f]| and |char_width(f)(c)<>invalid_width|.
+Finally, |char_width(f)(c)=width[width_base[f]+c]|, and |width_ptr| is the
+first unused position of the |width| array.
+
+@d char_width_end(#)==#]
+@d char_width(#)==width[width_base[#]+char_width_end
+@d invalid_width==@'17777777777
+@d invalid_font==max_fonts
+
+@<Glob...@>=
+@!font_num:array [0..max_fonts] of integer; {external font numbers}
+@!font_name:array [0..max_fonts] of 1..name_size; {starting positions
+ of external font names}
+@!names:array [1..name_size] of ASCII_code; {characters of names}
+@!font_check_sum:array [0..max_fonts] of integer; {check sums}
+@!font_scaled_size:array [0..max_fonts] of integer; {scale factors}
+@!font_design_size:array [0..max_fonts] of integer; {design sizes}
+@!font_space:array [0..max_fonts] of integer; {boundary between ``small''
+ and ``large'' spaces}
+@!font_bc:array [0..max_fonts] of integer; {beginning characters in fonts}
+@!font_ec:array [0..max_fonts] of integer; {ending characters in fonts}
+@!width_base:array [0..max_fonts] of integer; {index into |width| table}
+@!width:array [0..max_widths] of integer; {character widths, in \.{DVI} units}
+@!nf:0..max_fonts; {the number of known fonts}
+@!width_ptr:0..max_widths; {the number of known character widths}
+
+@ @<Set init...@>=
+nf:=0; width_ptr:=0; font_name[0]:=1;@/
+font_space[invalid_font]:=0; {for |out_space| and |out_vmove|}
+font_bc[invalid_font]:=1; font_ec[invalid_font]:=0;
+
+@ It is, of course, a simple matter to print the name of a given font.
+
+@p procedure print_font(@!f:integer); {|f| is an internal font number}
+var k:0..name_size; {index into |names|}
+begin if f=invalid_font then print('UNDEFINED!')
+@.UNDEFINED@>
+else begin for k:=font_name[f] to font_name[f+1]-1 do
+ print(xchr[names[k]]);
+ end;
+end;
+
+@ An auxiliary array |in_width| is used to hold the widths as they are
+input. The global variables |tfm_check_sum| and |tfm_design_size| are
+set to the check sum and design size that
+appear in the current \.{TFM} file.
+
+@<Glob...@>=
+@!in_width:array[0..255] of integer; {\.{TFM} width data in \.{DVI} units}
+@!tfm_check_sum:integer; {check sum found in |tfm_file|}
+@!tfm_design_size:integer; {design size found in |tfm_file|, in \.{DVI} units}
+@!tfm_conv:real; {\.{DVI} units per absolute \.{TFM} unit}
+
+@ Here is a procedure that absorbs the necessary information from a
+\.{TFM} file, assuming that the file has just been successfully reset
+so that we are ready to read its first byte. (A complete description of
+\.{TFM} file format appears in the documentation of \.{TFtoPL} and will
+not be repeated here.) The procedure does not check the \.{TFM} file
+for validity, nor does it give explicit information about what is
+wrong with a \.{TFM} file that proves to be invalid; \.{DVI}-reading
+programs need not do this, since \.{TFM} files are almost always valid,
+and since the \.{TFtoPL} utility program has been specifically designed
+to diagnose \.{TFM} errors. The procedure simply returns |false| if it
+detects anything amiss in the \.{TFM} data.
+
+There is a parameter, |z|, which represents the scaling factor being
+used to compute the font dimensions; it must be in the range $0<z<2^{27}$.
+
+@p function in_TFM(@!z:integer):boolean; {input \.{TFM} data or return |false|}
+label 9997, {go here when the format is bad}
+ 9998, {go here when the information cannot be loaded}
+ 9999; {go here to exit}
+var k:integer; {index for loops}
+@!lh:integer; {length of the header data, in four-byte words}
+@!nw:integer; {number of words in the width table}
+@!wp:0..max_widths; {new value of |width_ptr| after successful input}
+@!alpha,@!beta:integer; {quantities used in the scaling computation}
+begin @<Read past the header data; |goto 9997| if there is a problem@>;
+@<Store character-width indices at the end of the |width| table@>;
+@<Read and convert the width values, setting up the |in_width| table@>;
+@<Move the widths from |in_width| to |width|, and append |pixel_width| values@>;
+width_ptr:=wp; in_TFM:=true; goto 9999;
+9997: print_ln('---not loaded, TFM file is bad');
+@.TFM file is bad@>
+9998: in_TFM:=false;
+9999: end;
+
+@ @<Read past the header...@>=
+read_tfm_word; lh:=b2*256+b3;
+read_tfm_word; font_bc[nf]:=b0*256+b1; font_ec[nf]:=b2*256+b3;
+if font_ec[nf]<font_bc[nf] then font_bc[nf]:=font_ec[nf]+1;
+if width_ptr+font_ec[nf]-font_bc[nf]+1>max_widths then
+ begin print_ln('---not loaded, DVItype needs larger width table');
+@.DVItype needs larger...@>
+ goto 9998;
+ end;
+wp:=width_ptr+font_ec[nf]-font_bc[nf]+1;
+read_tfm_word; nw:=b0*256+b1;
+if (nw=0)or(nw>256) then goto 9997;
+for k:=1 to 3+lh do
+ begin if eof(tfm_file) then goto 9997;
+ read_tfm_word;
+ if k=4 then
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3
+ else if k=5 then
+ if b0<128 then
+ tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3))
+ else goto 9997;
+ end;
+
+@ @<Store character-width indices...@>=
+if wp>0 then for k:=width_ptr to wp-1 do
+ begin read_tfm_word;
+ if b0>nw then goto 9997;
+ width[k]:=b0;
+ end;
+
+@ The most important part of |in_TFM| is the width computation, which
+involves multiplying the relative widths in the \.{TFM} file by the
+scaling factor in the \.{DVI} file. This fixed-point multiplication
+must be done with precisely the same accuracy by all \.{DVI}-reading programs,
+in order to validate the assumptions made by \.{DVI}-writing programs
+like \TeX82.
+
+Let us therefore summarize what needs to be done. Each width in a \.{TFM}
+file appears as a four-byte quantity called a |fix_word|. A |fix_word|
+whose respective bytes are $(a,b,c,d)$ represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+(No other choices of $a$ are allowed, since the magnitude of a \.{TFM}
+dimension must be less than 16.) We want to multiply this quantity by the
+integer~|z|, which is known to be less than $2^{27}$.
+If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$,
+$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or
+16, to obtain a multiplier less than $2^{23}$, and we can compensate for
+this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let
+$\beta=2^{4-e}$; we shall compute
+$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$,
+or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
+This calculation must be
+done exactly, for the reasons stated above; the following program does the
+job in a system-independent way, assuming that arithmetic is exact on
+numbers less than $2^{31}$ in magnitude.
+
+@<Read and convert the width values...@>=
+@<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>;
+for k:=0 to nw-1 do
+ begin read_tfm_word;
+ in_width[k]:=(((((b3*z)div@'400)+(b2*z))div@'400)+(b1*z))div beta;
+ if b0>0 then if b0<255 then goto 9997
+ else in_width[k]:=in_width[k]-alpha;
+ end
+
+@ @<Replace |z|...@>=
+begin alpha:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; alpha:=alpha+alpha;
+ end;
+beta:=256 div alpha; alpha:=alpha*z;
+end
+
+@ A \.{DVI}-reading program usually works with font files instead of
+\.{TFM} files, so \.{DVItype} is atypical in that respect. Font files
+should, however, contain exactly the same character width data that is
+found in the corresponding \.{TFM}s; check sums are used to help
+ensure this. In addition, font files usually also contain the widths of
+characters in pixels, since the device-independent character widths of
+\.{TFM} files are generally not perfect multiples of pixels.
+
+The |pixel_width| array contains this information; when |width[k]| is the
+device-independent width of some character in \.{DVI} units, |pixel_width[k]|
+is the corresponding width of that character in an actual font.
+The macro |char_pixel_width| is set up to be analogous to |char_width|.
+
+@d char_pixel_width(#)==pixel_width[width_base[#]+char_width_end
+
+@<Glob...@>=
+@!pixel_width:array[0..max_widths] of integer; {actual character widths,
+ in pixels}
+@!conv:real; {converts \.{DVI} units to pixels}
+@!true_conv:real; {converts unmagnified \.{DVI} units to pixels}
+@!numerator,@!denominator:integer; {stated conversion ratio}
+@!mag:integer; {magnification factor times 1000}
+
+@ The following code computes pixel widths by simply rounding the \.{TFM}
+widths to the nearest integer number of pixels, based on the conversion factor
+|conv| that converts \.{DVI} units to pixels. However, such a simple
+formula will not be valid for all fonts, and it will often give results that
+are off by $\pm1$ when a low-resolution font has been carefully
+hand-fitted. For example, a font designer often wants to make the letter `m'
+a pixel wider or narrower in order to make the font appear more consistent.
+\.{DVI}-to-printer programs should therefore input the correct pixel width
+information from font files whenever there is a chance that it may differ.
+A warning message may also be desirable in the case that at least one character
+is found whose pixel width differs from |conv*width| by more than a full pixel.
+@^system dependencies@>
+
+@d pixel_round(#)==round(conv*(#))
+
+@<Move the widths from |in_width| to |width|, and append |pixel_width| values@>=
+if in_width[0]<>0 then goto 9997; {the first width should be zero}
+width_base[nf]:=width_ptr-font_bc[nf];
+if wp>0 then for k:=width_ptr to wp-1 do
+ if width[k]=0 then
+ begin width[k]:=invalid_width; pixel_width[k]:=0;
+ end
+ else begin width[k]:=in_width[width[k]];
+ pixel_width[k]:=pixel_round(width[k]);
+ end
+
+@* Optional modes of output.
+\.{DVItype} will print different quantities of information based on some
+options that the user must specify: The |out_mode| level is set to one of
+five values (|errors_only|, |terse|, |mnemonics_only|,
+|verbose|, |the_works|), giving
+different degrees of output; and the typeout can be confined to a
+restricted subset of the pages by specifying the desired starting page and
+the maximum number of pages. Furthermore there is an option to specify the
+resolution of an assumed discrete output device, so that pixel-oriented
+calculations will be shown; and there is an option to override the
+magnification factor that is stated in the \.{DVI} file.
+
+The starting page is specified by giving a sequence of 1 to 10 numbers or
+asterisks separated by dots. For example, the specification `\.{1.*.-5}'
+can be used to refer to a page output by \TeX\ when $\.{\\count0}=1$
+and $\.{\\count2}=-5$. (Recall that |bop| commands in a \.{DVI} file
+are followed by ten `count' values.) An asterisk matches any number,
+so the `\.*' in `\.{1.*.-5}' means that \.{\\count1} is ignored when
+specifying the first page. If several pages match the given specification,
+\.{DVItype} will begin with the earliest such page in the file. The
+default specification `\.*' (which matches all pages) therefore denotes
+the page at the beginning of the file.
+
+When \.{DVItype} begins, it engages the user in a brief dialog so that the
+options will be specified. This part of \.{DVItype} requires nonstandard
+\PASCAL\ constructions to handle the online interaction; so it may be
+preferable in some cases to omit the dialog and simply to stick to the
+default options (|out_mode=the_works|, starting page `\.*',
+|max_pages=1000000|, |resolution=300.0|, |new_mag=0|). On other hand, the
+system-dependent routines that are needed are not complicated, so it will
+not be terribly difficult to introduce them.
+@^system dependencies@>
+
+@d errors_only=0 {value of |out_mode| when minimal printing occurs}
+@d terse=1 {value of |out_mode| for abbreviated output}
+@d mnemonics_only=2 {value of |out_mode| for medium-quantity output}
+@d verbose=3 {value of |out_mode| for detailed tracing}
+@d the_works=4 {|verbose|, plus check of postamble if |random_reading|}
+
+@<Glob...@>=
+@!out_mode:errors_only..the_works; {controls the amount of output}
+@!max_pages:integer; {at most this many |bop..eop| pages will be printed}
+@!resolution:real; {pixels per inch}
+@!new_mag:integer; {if positive, overrides the postamble's magnification}
+
+@ The starting page specification is recorded in two global arrays called
+|start_count| and |start_there|. For example, `\.{1.*.-5}' is represented
+by |start_there[0]=true|, |start_count[0]=1|, |start_there[1]=false|,
+|start_there[2]=true|, |start_count[2]=-5|.
+We also set |start_vals=2|, to indicate that count 2 was the last one
+mentioned. The other values of |start_count| and |start_there| are not
+important, in this example.
+
+@<Glob...@>=
+@!start_count:array[0..9] of integer; {count values to select starting page}
+@!start_there:array[0..9] of boolean; {is the |start_count| value relevant?}
+@!start_vals:0..9; {the last count considered significant}
+@!count:array[0..9] of integer; {the count values on the current page}
+
+@ @<Set init...@>=
+out_mode:=the_works; max_pages:=1000000; start_vals:=0; start_there[0]:=false;
+
+@ Here is a simple subroutine that tests if the current page might be the
+starting page.
+
+@p function start_match:boolean; {does |count| match the starting spec?}
+var k:0..9; {loop index}
+@!match:boolean; {does everything match so far?}
+begin match:=true;
+for k:=0 to start_vals do
+ if start_there[k]and(start_count[k]<>count[k]) then match:=false;
+start_match:=match;
+end;
+
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+
+@ Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall invoke a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ During the dialog, \.{DVItype} will treat the first blank space in a
+line as the end of that line. Therefore |input_ln| makes sure that there
+is always at least one blank space in |buffer|.
+@^system dependencies@>
+
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+
+@ The global variable |buf_ptr| is used while scanning each line of input;
+it points to the first unread character in |buffer|.
+
+@<Glob...@>=
+@!buf_ptr:0..terminal_line_length; {the number of characters read}
+
+@ Here is a routine that scans a (possibly signed) integer and computes
+the decimal value. If no decimal integer starts at |buf_ptr|, the
+value 0 is returned. The integer should be less than $2^{31}$ in
+absolute value.
+
+@p function get_integer:integer;
+var x:integer; {accumulates the value}
+@!negative:boolean; {should the value be negated?}
+begin if buffer[buf_ptr]="-" then
+ begin negative:=true; incr(buf_ptr);
+ end
+else negative:=false;
+x:=0;
+while (buffer[buf_ptr]>="0")and(buffer[buf_ptr]<="9") do
+ begin x:=10*x+buffer[buf_ptr]-"0"; incr(buf_ptr);
+ end;
+if negative then get_integer:=-x @+ else get_integer:=x;
+end;
+
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{DVItype} begins.
+@^system dependencies@>
+
+@p procedure dialog;
+label 1,2,3,4,5;
+var k:integer; {loop variable}
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);
+@<Determine the desired |out_mode|@>;
+@<Determine the desired |start_count| values@>;
+@<Determine the desired |max_pages|@>;
+@<Determine the desired |resolution|@>;
+@<Determine the desired |new_mag|@>;
+@<Print all the selected options@>;
+end;
+
+@ @<Determine the desired |out_mode|@>=
+1: write(term_out,'Output level (default=4, ? for help): ');
+out_mode:=the_works; input_ln;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="4") then out_mode:=buffer[0]-"0"
+ else begin write(term_out,'Type 4 for complete listing,');
+ write(term_out,' 0 for errors and fonts only,');
+ write_ln(term_out,' 1 or 2 or 3 for something in between.');
+ goto 1;
+ end
+
+@ @<Determine the desired |start...@>=
+2: write(term_out,'Starting page (default=*): ');
+start_vals:=0; start_there[0]:=false;
+input_ln; buf_ptr:=0; k:=0;
+if buffer[0]<>" " then
+ repeat if buffer[buf_ptr]="*" then
+ begin start_there[k]:=false; incr(buf_ptr);
+ end
+ else begin start_there[k]:=true; start_count[k]:=get_integer;
+ end;
+ if (k<9)and(buffer[buf_ptr]=".") then
+ begin incr(k); incr(buf_ptr);
+ end
+ else if buffer[buf_ptr]=" " then start_vals:=k
+ else begin write(term_out,'Type, e.g., 1.*.-5 to specify the ');
+ write_ln(term_out,'first page with \count0=1, \count2=-5.');
+ goto 2;
+ end;
+ until start_vals=k
+
+@ @<Determine the desired |max_pages|@>=
+3: write(term_out,'Maximum number of pages (default=1000000): ');
+max_pages:=1000000; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin max_pages:=get_integer;
+ if max_pages<=0 then
+ begin write_ln(term_out,'Please type a positive number.');
+ goto 3;
+ end;
+ end
+
+@ @<Determine the desired |resolution|@>=
+4: write(term_out,'Assumed device resolution');
+write(term_out,' in pixels per inch (default=300/1): ');
+resolution:=300.0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin k:=get_integer;
+ if (k>0)and(buffer[buf_ptr]="/")and
+ (buffer[buf_ptr+1]>"0")and(buffer[buf_ptr+1]<="9") then
+ begin incr(buf_ptr); resolution:=k/get_integer;
+ end
+ else begin write(term_out,'Type a ratio of positive integers;');
+ write_ln(term_out,' (1 pixel per mm would be 254/10).');
+ goto 4;
+ end;
+ end
+
+@ @<Determine the desired |new_mag|@>=
+5: write(term_out,'New magnification (default=0 to keep the old one): ');
+new_mag:=0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="9") then new_mag:=get_integer
+ else begin write(term_out,'Type a positive integer to override ');
+ write_ln(term_out,'the magnification in the DVI file.');
+ goto 5;
+ end
+
+@ After the dialog is over, we print the options so that the user
+can see what \.{DVItype} thought was specified.
+
+@<Print all the selected options@>=
+print_ln('Options selected:');
+@.Options selected@>
+print(' Starting page = ');
+for k:=0 to start_vals do
+ begin if start_there[k] then print(start_count[k]:1)
+ else print('*');
+ if k<start_vals then print('.')
+ else print_ln(' ');
+ end;
+print_ln(' Maximum number of pages = ',max_pages:1);
+print(' Output level = ',out_mode:1);
+case out_mode of
+errors_only: print_ln(' (showing bops, fonts, and error messages only)');
+terse: print_ln(' (terse)');
+mnemonics_only: print_ln(' (mnemonics)');
+verbose: print_ln(' (verbose)');
+the_works: if random_reading then print_ln(' (the works)')
+ else begin out_mode:=verbose;
+ print_ln(' (the works: same as level 3 in this DVItype)');
+ end;
+end;@/
+print_ln(' Resolution = ',resolution:12:8,' pixels per inch');
+if new_mag>0 then print_ln(' New magnification factor = ',new_mag/1000:8:3)
+
+@* Defining fonts.
+When |out_mode=the_works|, \.{DVItype} reads the postamble first and loads
+all of the fonts defined there; then it processes the pages. In this
+case, a \\{fnt\_def} command should match a previous definition if and only
+if the \\{fnt\_def} being processed is not in the postamble. But if
+|out_mode<the_works|, \.{DVItype} reads the pages first and the postamble
+last, so the conventions are reversed: a \\{fnt\_def} should match a previous
+\\{fnt\_def} if and only if the current one is a part of the postamble.
+
+A global variable |in_postamble| is provided to tell whether we are
+processing the postamble or not.
+
+@<Glob...@>=
+@!in_postamble:boolean; {are we reading the postamble?}
+
+@ @<Set init...@>=
+in_postamble:=false;
+
+@ The following subroutine does the necessary things when a \\{fnt\_def}
+command is being processed.
+
+@p procedure define_font(@!e:integer); {|e| is an external font number}
+var f:0..max_fonts;
+@!p:integer; {length of the area/directory spec}
+@!n:integer; {length of the font name proper}
+@!c,@!q,@!d,@!m:integer; {check sum, scaled size, design size, magnification}
+@!r:0..name_length; {index into |cur_name|}
+@!j,@!k:0..name_size; {indices into |names|}
+@!mismatch:boolean; {do names disagree?}
+begin if nf=max_fonts then abort('DVItype capacity exceeded (max fonts=',
+ max_fonts:1,')!');
+@.DVItype capacity exceeded...@>
+font_num[nf]:=e; f:=0;
+while font_num[f]<>e do incr(f);
+@<Read the font parameters into position for font |nf|, and
+ print the font name@>;
+if ((out_mode=the_works)and in_postamble)or@|
+ ((out_mode<the_works)and not in_postamble) then
+ begin if f<nf then print_ln('---this font was already defined!');
+@.this font was already defined@>
+ end
+else begin if f=nf then print_ln('---this font wasn''t loaded before!');
+@.this font wasn't loaded before@>
+ end;
+if f=nf then @<Load the new font, unless there are problems@>
+else @<Check that the current font definition matches the old one@>;
+end;
+
+@ @<Check that the current...@>=
+begin if font_check_sum[f]<>c then
+ print_ln('---check sum doesn''t match previous definition!');
+@.check sum doesn't match@>
+if font_scaled_size[f]<>q then
+ print_ln('---scaled size doesn''t match previous definition!');
+@.scaled size doesn't match@>
+if font_design_size[f]<>d then
+ print_ln('---design size doesn''t match previous definition!');
+@.design size doesn't match@>
+j:=font_name[f]; k:=font_name[nf];
+if font_name[f+1]-j<>font_name[nf+1]-k then mismatch:=true
+else begin mismatch:=false;
+ while j<font_name[f+1] do
+ begin if names[j]<>names[k] then mismatch:=true;
+ incr(j); incr(k);
+ end;
+ end;
+if mismatch then print_ln('---font name doesn''t match previous definition!');
+@.font name doesn't match@>
+end
+
+@ @<Read the font parameters into position for font |nf|...@>=
+c:=signed_quad; font_check_sum[nf]:=c;@/
+q:=signed_quad; font_scaled_size[nf]:=q;@/
+d:=signed_quad; font_design_size[nf]:=d;@/
+if (q<=0) or (d<=0) then m:=1000
+else m:=round((1000.0*conv*q)/(true_conv*d));
+p:=get_byte; n:=get_byte;
+if font_name[nf]+n+p>name_size then
+ abort('DVItype capacity exceeded (name size=',name_size:1,')!');
+@.DVItype capacity exceeded...@>
+font_name[nf+1]:=font_name[nf]+n+p;
+if showing then print(': ')
+ {when |showing| is true, the font number has already been printed}
+else print('Font ',e:1,': ');
+if n+p=0 then print('null font name!')
+@.null font name@>
+else for k:=font_name[nf] to font_name[nf+1]-1 do names[k]:=get_byte;
+print_font(nf);
+if not showing then if m<>1000 then print(' scaled ',m:1)
+@.scaled@>
+
+@ @<Load the new font, unless there are problems@>=
+begin @<Move font name into the |cur_name| string@>;
+open_tfm_file;
+if eof(tfm_file) then
+ print('---not loaded, TFM file can''t be opened!')
+@.TFM file can\'t be opened@>
+else begin if (q<=0)or(q>=@'1000000000) then
+ print('---not loaded, bad scale (',q:1,')!')
+@.bad scale@>
+ else if (d<=0)or(d>=@'1000000000) then
+ print('---not loaded, bad design size (',d:1,')!')
+@.bad design size@>
+ else if in_TFM(q) then @<Finish loading the new font info@>;
+ end;
+if out_mode=errors_only then print_ln(' ');
+end
+
+@ @<Finish loading...@>=
+begin font_space[nf]:=q div 6; {this is a 3-unit ``thin space''}
+if (c<>0)and(tfm_check_sum<>0)and(c<>tfm_check_sum) then
+ begin print_ln('---beware: check sums do not agree!');
+@.beware: check sums do not agree@>
+@.check sums do not agree@>
+ print_ln(' (',c:1,' vs. ',tfm_check_sum:1,')');
+ print(' ');
+ end;
+if abs(tfm_design_size-d)>2 then
+ begin print_ln('---beware: design sizes do not agree!');
+@.beware: design sizes do not agree@>
+@.design sizes do not agree@>
+ print_ln(' (',d:1,' vs. ',tfm_design_size:1,')');
+ print(' ');
+ end;
+print('---loaded at size ',q:1,' DVI units');
+d:=round((100.0*conv*q)/(true_conv*d));
+if d<>100 then
+ begin print_ln(' '); print(' (this font is magnified ',d:1,'%)');
+ end;
+@.this font is magnified@>
+incr(nf); {now the new font is officially present}
+end
+
+@ If |p=0|, i.e., if no font directory has been specified, \.{DVItype}
+is supposed to use the default font directory, which is a
+system-dependent place where the standard fonts are kept.
+The string variable |default_directory| contains the name of this area.
+@^system dependencies@>
+
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@^system dependencies@>
+
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if p=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_name[nf] to font_name[nf+1]-1 do
+ begin incr(r);
+ if r+4>name_length then
+ abort('DVItype capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItype capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+
+@* Low level output routines.
+Simple text in the \.{DVI} file is saved in a buffer until |line_length-2|
+characters have accumulated, or until some non-simple \.{DVI} operation
+occurs. Then the accumulated text is printed on a line, surrounded by
+brackets. The global variable |text_ptr| keeps track of the number of
+characters currently in the buffer.
+
+@<Glob...@>=
+@!text_ptr:0..line_length; {the number of characters in |text_buf|}
+@!text_buf:array[1..line_length] of ASCII_code; {saved characters}
+
+@ @<Set init...@>=
+text_ptr:=0;
+
+@ The |flush_text| procedure will empty the buffer if there is something in it.
+
+@p procedure flush_text;
+var k:0..line_length; {index into |text_buf|}
+begin if text_ptr>0 then
+ begin if out_mode>errors_only then
+ begin print('[');
+ for k:=1 to text_ptr do print(xchr[text_buf[k]]);
+ print_ln(']');
+ end;
+ text_ptr:=0;
+ end;
+end;
+
+@ And the |out_text| procedure puts something in it.
+
+@p procedure out_text(c:ASCII_code);
+begin if text_ptr=line_length-2 then flush_text;
+incr(text_ptr); text_buf[text_ptr]:=c;
+end;
+
+@* Translation to symbolic form.
+The main work of \.{DVItype} is accomplished by the |do_page| procedure,
+which produces the output for an entire page, assuming that the |bop|
+command for that page has already been processed. This procedure is
+essentially an interpretive routine that reads and acts on the \.{DVI}
+commands.
+
+@ The definition of \.{DVI} files refers to six registers,
+$(h,v,w,x,y,z)$, which hold integer values in \.{DVI} units. In practice,
+we also need registers |hh| and |vv|, the pixel analogs of $h$ and $v$,
+since it is not always true that |hh=pixel_round(h)| or
+|vv=pixel_round(v)|.
+
+The stack of $(h,v,w,x,y,z)$ values is represented by eight arrays
+called |hstack|, \dots, |zstack|, |hhstack|, and |vvstack|.
+
+@<Glob...@>=
+@!h,@!v,@!w,@!x,@!y,@!z,@!hh,@!vv:integer; {current state values}
+@!hstack,@!vstack,@!wstack,@!xstack,@!ystack,@!zstack:
+ array [0..stack_size] of integer; {pushed down values in \.{DVI} units}
+@!hhstack,@!vvstack:
+ array [0..stack_size] of integer; {pushed down values in pixels}
+
+@ Three characteristics of the pages (their |max_v|, |max_h|, and
+|max_s|) are specified in the postamble, and a warning message
+is printed if these limits are exceeded. Actually |max_v| is set to
+the maximum height plus depth of a page, and |max_h| to the maximum width,
+for purposes of page layout. Since characters can legally be set outside
+of the page boundaries, it is not an error when |max_v| or |max_h| is
+exceeded. But |max_s| should not be exceeded.
+
+The postamble also specifies the total number of pages; \.{DVItype}
+checks to see if this total is accurate.
+
+@<Glob...@>=
+@!max_v:integer; {the value of |abs(v)| should probably not exceed this}
+@!max_h:integer; {the value of |abs(h)| should probably not exceed this}
+@!max_s:integer; {the stack depth should not exceed this}
+@!max_v_so_far,@!max_h_so_far,@!max_s_so_far:integer; {the record high levels}
+@!total_pages:integer; {the stated total number of pages}
+@!page_count:integer; {the total number of pages seen so far}
+
+@ @<Set init...@>=
+max_v:=@'17777777777-99; max_h:=@'17777777777-99; max_s:=stack_size+1;@/
+max_v_so_far:=0; max_h_so_far:=0; max_s_so_far:=0; page_count:=0;
+
+@ Before we get into the details of |do_page|, it is convenient to
+consider a simpler routine that computes the first parameter of each
+opcode.
+
+@d four_cases(#)==#,#+1,#+2,#+3
+@d eight_cases(#)==four_cases(#),four_cases(#+4)
+@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
+@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
+@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
+
+@p function first_par(o:eight_bits):integer;
+begin case o of
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64):
+ first_par:=o-set_char_0;
+set1,put1,fnt1,xxx1,fnt_def1: first_par:=get_byte;
+set1+1,put1+1,fnt1+1,xxx1+1,fnt_def1+1: first_par:=get_two_bytes;
+set1+2,put1+2,fnt1+2,xxx1+2,fnt_def1+2: first_par:=get_three_bytes;
+right1,w1,x1,down1,y1,z1: first_par:=signed_byte;
+right1+1,w1+1,x1+1,down1+1,y1+1,z1+1: first_par:=signed_pair;
+right1+2,w1+2,x1+2,down1+2,y1+2,z1+2: first_par:=signed_trio;
+set1+3,set_rule,put1+3,put_rule,right1+3,w1+3,x1+3,down1+3,y1+3,z1+3,
+ fnt1+3,xxx1+3,fnt_def1+3: first_par:=signed_quad;
+nop,bop,eop,push,pop,pre,post,post_post,undefined_commands: first_par:=0;
+w0: first_par:=w;
+x0: first_par:=x;
+y0: first_par:=y;
+z0: first_par:=z;
+sixty_four_cases(fnt_num_0): first_par:=o-fnt_num_0;
+end;
+end;
+
+@ Here is another subroutine that we need: It computes the number of
+pixels in the height or width of a rule. Characters and rules will line up
+properly if the sizes are computed precisely as specified here. (Since
+|conv| is computed with some floating-point roundoff error, in a
+machine-dependent way, format designers who are tailoring something for a
+particular resolution should not plan their measurements to come out to an
+exact integer number of pixels; they should compute things so that the
+rule dimensions are a little less than an integer number of pixels, e.g.,
+4.99 instead of 5.00.)
+
+@p function rule_pixels(x:integer):integer;
+ {computes $\lceil|conv|\cdot x\rceil$}
+var n:integer;
+begin n:=trunc(conv*x);
+if n<conv*x then rule_pixels:=n+1 @+ else rule_pixels:=n;
+end;
+
+@ Strictly speaking, the |do_page| procedure is really a function with
+side effects, not a `\&{procedure}'\thinspace; it returns the value |false|
+if \.{DVItype} should be aborted because of some unusual happening. The
+subroutine is organized as a typical interpreter, with a multiway branch
+on the command code followed by |goto| statements leading to routines that
+finish up the activities common to different commands. We will use the
+following labels:
+
+@d fin_set=41 {label for commands that set or put a character}
+@d fin_rule=42 {label for commands that set or put a rule}
+@d move_right=43 {label for commands that change |h|}
+@d move_down=44 {label for commands that change |v|}
+@d show_state=45 {label for commands that change |s|}
+@d change_font=46 {label for commands that change |cur_font|}
+
+@ Some \PASCAL\ compilers severely restrict the length of procedure bodies,
+so we shall split |do_page| into two parts, one of which is
+called |special_cases|. The different parts communicate with each other
+via the global variables mentioned above, together with the following ones:
+
+@<Glob...@>=
+@!s:integer; {current stack size}
+@!ss:integer; {stack size to print}
+@!cur_font:integer; {current internal font number}
+@!showing:boolean; {is the current command being translated in full?}
+
+@ Here is the overall setup.
+
+@p @t\4@>@<Declare the function called |special_cases|@>@;
+function do_page:boolean;
+label fin_set,fin_rule,move_right,show_state,done,9998,9999;
+var o:eight_bits; {operation code of the current command}
+@!p,@!q:integer; {parameters of the current command}
+@!a:integer; {byte number of the current command}
+@!hhh:integer; {|h|, rounded to the nearest pixel}
+begin cur_font:=invalid_font; {set current font undefined}
+s:=0; h:=0; v:=0; w:=0; x:=0; y:=0; z:=0; hh:=0; vv:=0;
+ {initialize the state variables}
+while true do @<Translate the next command in the \.{DVI} file;
+ |goto 9999| with |do_page=true| if it was |eop|;
+ |goto 9998| if premature termination is needed@>;
+9998: print_ln('!'); do_page:=false;
+9999: end;
+
+@ Commands are broken down into ``major'' and ``minor'' categories:
+A major command is always shown in full, while a minor one is
+put into the buffer in abbreviated form. Minor commands, which
+account for the bulk of most \.{DVI} files, involve horizontal spacing
+and the typesetting of characters in a line; these are shown in full
+only if |out_mode>=verbose|.
+
+@d show(#)==begin flush_text; showing:=true; print(a:1,': ',#);
+ end
+@d major(#)==if out_mode>errors_only then show(#)
+@d minor(#)==if out_mode>terse then
+ begin showing:=true; print(a:1,': ',#);
+ end
+@d error(#)==if not showing then show(#) else print(' ',#)
+
+@<Translate the next command...@>=
+begin a:=cur_loc; showing:=false;
+o:=get_byte; p:=first_par(o);
+if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+@<Start translation of command |o| and |goto| the appropriate label to
+ finish the job@>;
+fin_set: @<Finish a command that either sets or puts a character, then
+ |goto move_right| or |done|@>;
+fin_rule: @<Finish a command that either sets or puts a rule, then
+ |goto move_right| or |done|@>;
+move_right: @<Finish a command that sets |h:=h+q|, then |goto done|@>;
+show_state: @<Show the values of |ss|, |h|, |v|, |w|, |x|, |y|, |z|,
+ |hh|, and |vv|; then |goto done|@>;
+done: if showing then print_ln(' ');
+end
+
+@ The multiway switch in |first_par|, above, was organized by the length
+of each command; the one in |do_page| is organized by the semantics.
+
+@<Start translation...@>=
+if o<set_char_0+128 then @<Translate a |set_char| command@>
+else case o of
+ four_cases(set1): begin major('set',o-set1+1:1,' ',p:1); goto fin_set;
+ end;
+ four_cases(put1): begin major('put',o-put1+1:1,' ',p:1); goto fin_set;
+ end;
+ set_rule: begin major('setrule'); goto fin_rule;
+ end;
+ put_rule: begin major('putrule'); goto fin_rule;
+ end;
+ @t\4@>@<Cases for commands |nop|, |bop|, \dots, |pop|@>@;
+ @t\4@>@<Cases for horizontal motion@>@;
+ othercases if special_cases(o,p,a) then goto done@+else goto 9998
+ endcases
+
+@ @<Declare the function called |special_cases|@>=
+function special_cases(@!o:eight_bits;@!p,@!a:integer):boolean;
+label change_font,move_down,done,9998;
+var q:integer; {parameter of the current command}
+@!k:integer; {loop index}
+@!bad_char:boolean; {has a non-ASCII character code appeared in this \\{xxx}?}
+@!pure:boolean; {is the command error-free?}
+@!vvv:integer; {|v|, rounded to the nearest pixel}
+begin pure:=true;
+case o of
+@t\4@>@<Cases for vertical motion@>@;
+@t\4@>@<Cases for fonts@>@;
+four_cases(xxx1): @<Translate an |xxx| command and |goto done|@>;
+pre: begin error('preamble command within a page!'); goto 9998;
+ end;
+@.preamble command within a page@>
+post,post_post: begin error('postamble command within a page!'); goto 9998;
+@.postamble command within a page@>
+ end;
+othercases begin error('undefined command ',o:1,'!');
+ goto done;
+@.undefined command@>
+ end
+endcases;
+move_down: @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+change_font: @<Finish a command that changes the current font,
+ then |goto done|@>;
+9998: pure:=false;
+done: special_cases:=pure;
+end;
+
+@ @<Cases for commands |nop|, |bop|, \dots, |pop|@>=
+nop: begin minor('nop'); goto done;
+ end;
+bop: begin error('bop occurred before eop!'); goto 9998;
+@.bop occurred before eop@>
+ end;
+eop: begin major('eop');
+ if s<>0 then error('stack not empty at end of page (level ',
+ s:1,')!');
+@.stack not empty...@>
+ do_page:=true; print_ln(' '); goto 9999;
+ end;
+push: begin major('push');
+ if s=max_s_so_far then
+ begin max_s_so_far:=s+1;
+ if s=max_s then error('deeper than claimed in postamble!');
+@.deeper than claimed...@>
+@.push deeper than claimed...@>
+ if s=stack_size then
+ begin error('DVItype capacity exceeded (stack size=',
+ stack_size:1,')'); goto 9998;
+ end;
+ end;
+ hstack[s]:=h; vstack[s]:=v; wstack[s]:=w;
+ xstack[s]:=x; ystack[s]:=y; zstack[s]:=z;
+ hhstack[s]:=hh; vvstack[s]:=vv; incr(s); ss:=s-1; goto show_state;
+ end;
+pop: begin major('pop');
+ if s=0 then error('(illegal at level zero)!')
+ else begin decr(s); hh:=hhstack[s]; vv:=vvstack[s];
+ h:=hstack[s]; v:=vstack[s]; w:=wstack[s];
+ x:=xstack[s]; y:=ystack[s]; z:=zstack[s];
+ end;
+ ss:=s; goto show_state;
+ end;
+
+@ Rounding to the nearest pixel is best done in the manner shown here, so as
+to be inoffensive to the eye: When the horizontal motion is small, like a
+kern, |hh| changes by rounding the kern; but when the motion is large, |hh|
+changes by rounding the true position |h| so that accumulated rounding errors
+disappear. We allow a larger space in the negative direction than in
+the positive one, because \TeX\ makes comparatively
+large backspaces when it positions accents.
+
+@d out_space(#)==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then
+ begin out_text(" "); hh:=pixel_round(h+p);
+ end
+ else hh:=hh+pixel_round(p);
+ minor(#,' ',p:1); q:=p; goto move_right
+
+@<Cases for horizontal motion@>=
+four_cases(right1):begin out_space('right',o-right1+1:1);
+ end;
+w0,four_cases(w1):begin w:=p; out_space('w',o-w0:1);
+ end;
+x0,four_cases(x1):begin x:=p; out_space('x',o-x0:1);
+ end;
+
+@ Vertical motion is done similarly, but with the threshold between
+``small'' and ``large'' increased by a factor of five. The idea is to make
+fractions like ``$1\over2$'' round consistently, but to absorb accumulated
+rounding errors in the baseline-skip moves.
+
+@d out_vmove(#)==if abs(p)>=5*font_space[cur_font] then vv:=pixel_round(v+p)
+ else vv:=vv+pixel_round(p);
+ major(#,' ',p:1); goto move_down
+
+@<Cases for vertical motion@>=
+four_cases(down1):begin out_vmove('down',o-down1+1:1);
+ end;
+y0,four_cases(y1):begin y:=p; out_vmove('y',o-y0:1);
+ end;
+z0,four_cases(z1):begin z:=p; out_vmove('z',o-z0:1);
+ end;
+
+@ @<Cases for fonts@>=
+sixty_four_cases(fnt_num_0): begin major('fntnum',p:1);
+ goto change_font;
+ end;
+four_cases(fnt1): begin major('fnt',o-fnt1+1:1,' ',p:1);
+ goto change_font;
+ end;
+four_cases(fnt_def1): begin major('fntdef',o-fnt_def1+1:1,' ',p:1);
+ define_font(p); goto done;
+ end;
+
+@ @<Translate an |xxx| command and |goto done|@>=
+begin major('xxx '''); bad_char:=false;
+if p<0 then error('string of negative length!');
+@.string of negative length@>
+for k:=1 to p do
+ begin q:=get_byte;
+ if (q<" ")or(q>"~") then bad_char:=true;
+ if showing then print(xchr[q]);
+ end;
+if showing then print('''');
+if bad_char then error('non-ASCII character in xxx command!');
+@.non-ASCII character...@>
+goto done;
+end
+
+@ @<Translate a |set_char|...@>=
+begin if (o>" ")and(o<="~") then
+ begin out_text(p); minor('setchar',p:1);
+ end
+else major('setchar',p:1);
+goto fin_set;
+end
+
+@ @<Finish a command that either sets or puts a character...@>=
+if p<0 then p:=255-((-1-p) mod 256)
+else if p>=256 then p:=p mod 256; {width computation for oriental fonts}
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+if (p<font_bc[cur_font])or(p>font_ec[cur_font]) then q:=invalid_width
+else q:=char_width(cur_font)(p);
+if q=invalid_width then
+ begin error('character ',p:1,' invalid in font ');
+@.character $c$ invalid...@>
+ print_font(cur_font);
+ if cur_font<>invalid_font then
+ print('!'); {the invalid font has `\.!' in its name}
+ end;
+if o>=put1 then goto done;
+if q=invalid_width then q:=0
+else hh:=hh+char_pixel_width(cur_font)(p);
+goto move_right
+
+@ @<Finish a command that either sets or puts a rule...@>=
+q:=signed_quad;
+if showing then
+ begin print(' height ',p:1,', width ',q:1);
+ if out_mode>mnemonics_only then
+ if (p<=0)or(q<=0) then print(' (invisible)')
+ else print(' (',rule_pixels(p):1,'x',rule_pixels(q):1,' pixels)');
+ end;
+if o=put_rule then goto done;
+if showing then if out_mode>mnemonics_only then print_ln(' ');
+hh:=hh+rule_pixels(q); goto move_right
+
+@ A sequence of consecutive rules, or consecutive characters in a fixed-width
+font whose width is not an integer number of pixels, can cause |hh| to drift
+far away from a correctly rounded value. \.{DVItype} ensures that the
+amount of drift will never exceed |max_drift| pixels.
+
+Since \.{DVItype} is intended to diagnose strange errors, it checks
+carefully to make sure that |h| and |v| do not get out of range.
+Normal \.{DVI}-reading programs need not do this.
+
+@d infinity==@'17777777777 {$\infty$ (approximately)}
+@d max_drift=2 {we insist that abs|(hh-pixel_round(h))<=max_drift|}
+
+@<Finish a command that sets |h:=h+q|, then |goto done|@>=
+if (h>0)and(q>0) then if h>infinity-q then
+ begin error('arithmetic overflow! parameter changed from ',
+@.arithmetic overflow...@>
+ q:1,' to ',infinity-h:1);
+ q:=infinity-h;
+ end;
+if (h<0)and(q<0) then if -h>q+infinity then
+ begin error('arithmetic overflow! parameter changed from ',
+ q:1, ' to ',(-h)-infinity:1);
+ q:=(-h)-infinity;
+ end;
+hhh:=pixel_round(h+q);
+if abs(hhh-hh)>max_drift then
+ if hhh>hh then hh:=hhh-max_drift
+ else hh:=hhh+max_drift;
+if showing then if out_mode>mnemonics_only then
+ begin print(' h:=',h:1);
+ if q>=0 then print('+');
+ print(q:1,'=',h+q:1,', hh:=',hh:1);
+ end;
+h:=h+q;
+if abs(h)>max_h_so_far then
+ begin if abs(h)>max_h+99 then
+ begin error('warning: |h|>',max_h:1,'!');
+@.warning: |h|...@>
+ max_h:=abs(h);
+ end;
+ max_h_so_far:=abs(h);
+ end;
+goto done
+
+@ @<Finish a command that sets |v:=v+p|, then |goto done|@>=
+if (v>0)and(p>0) then if v>infinity-p then
+ begin error('arithmetic overflow! parameter changed from ',
+@.arithmetic overflow...@>
+ p:1,' to ',infinity-v:1);
+ p:=infinity-v;
+ end;
+if (v<0)and(p<0) then if -v>p+infinity then
+ begin error('arithmetic overflow! parameter changed from ',
+ p:1, ' to ',(-v)-infinity:1);
+ p:=(-v)-infinity;
+ end;
+vvv:=pixel_round(v+p);
+if abs(vvv-vv)>max_drift then
+ if vvv>vv then vv:=vvv-max_drift
+ else vv:=vvv+max_drift;
+if showing then if out_mode>mnemonics_only then
+ begin print(' v:=',v:1);
+ if p>=0 then print('+');
+ print(p:1,'=',v+p:1,', vv:=',vv:1);
+ end;
+v:=v+p;
+if abs(v)>max_v_so_far then
+ begin if abs(v)>max_v+99 then
+ begin error('warning: |v|>',max_v:1,'!');
+@.warning: |v|...@>
+ max_v:=abs(v);
+ end;
+ max_v_so_far:=abs(v);
+ end;
+goto done
+
+@ @<Show the values of |ss|, |h|, |v|, |w|, |x|, |y|, |z|...@>=
+if showing then if out_mode>mnemonics_only then
+ begin print_ln(' ');
+ print('level ',ss:1,':(h=',h:1,',v=',v:1,
+ ',w=',w:1,',x=',x:1,',y=',y:1,',z=',z:1,
+ ',hh=',hh:1,',vv=',vv:1,')');
+ end;
+goto done
+
+@ @<Finish a command that changes the current font...@>=
+font_num[nf]:=p; cur_font:=0;
+while font_num[cur_font]<>p do incr(cur_font);
+if cur_font=nf then
+ begin cur_font:=invalid_font;
+ error('invalid font selection: font ',p:1,' was never defined!');
+ end;
+if showing then if out_mode>mnemonics_only then
+ begin print(' current font is '); print_font(cur_font);
+ end;
+goto done
+
+@* Skipping pages.
+A routine that's much simpler than |do_page| is used to pass over
+pages that are not being translated. The |skip_pages| subroutine
+is assumed to begin just after the preamble has been read, or just
+after a |bop| has been processed. It continues until either finding a
+|bop| that matches the desired starting page specifications, or until
+running into the postamble.
+
+@p @t\4@>@<Declare the procedure called |scan_bop|@>@;
+procedure skip_pages(@!bop_seen:boolean);
+label 9999; {end of this subroutine}
+var p:integer; {a parameter}
+@!k:0..255; {command code}
+@!down_the_drain:integer; {garbage}
+begin showing:=false;
+while true do
+ begin if not bop_seen then
+ begin scan_bop;
+ if in_postamble then goto 9999;
+ if not started then if start_match then
+ begin started:=true; goto 9999;
+ end;
+ end;
+ @<Skip until finding |eop|@>;
+ bop_seen:=false;
+ end;
+9999:end;
+
+@ @<Skip until finding |eop|@>=
+repeat if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+ k:=get_byte;
+ p:=first_par(k);
+ case k of
+ set_rule,put_rule: down_the_drain:=signed_quad;
+ four_cases(fnt_def1): begin define_font(p);
+ print_ln(' ');
+ end;
+ four_cases(xxx1): while p>0 do
+ begin down_the_drain:=get_byte; decr(p);
+ end;
+ bop,pre,post,post_post,undefined_commands:
+ bad_dvi('illegal command at byte ',cur_loc-1:1);
+@.illegal command at byte n@>
+ othercases do_nothing
+ endcases;
+until k=eop;
+
+@ Global variables called |old_backpointer| and |new_backpointer|
+are used to check whether the back pointers are properly set up.
+Another one tells whether we have already found the starting page.
+
+@<Glob...@>=
+@!old_backpointer:integer; {the previous |bop| command location}
+@!new_backpointer:integer; {the current |bop| command location}
+@!started:boolean; {has the starting page been found?}
+
+@ @<Set init...@>=
+old_backpointer:=-1; started:=false;
+
+@ The |scan_bop| procedure reads \.{DVI} commands following the preamble
+or following |eop|, until finding either |bop| or the postamble.
+
+@<Declare the procedure called |scan_bop|@>=
+procedure scan_bop;
+var k:0..255; {command code}
+begin repeat if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+ k:=get_byte;
+ if (k>=fnt_def1)and(k<fnt_def1+4) then
+ begin define_font(first_par(k)); k:=nop;
+ end;
+until k<>nop;
+if k=post then in_postamble:=true
+else begin if k<>bop then bad_dvi('byte ',cur_loc-1:1,' is not bop');
+@.byte n is not bop@>
+ new_backpointer:=cur_loc-1; incr(page_count);
+ for k:=0 to 9 do count[k]:=signed_quad;
+ if signed_quad<>old_backpointer
+ then print_ln('backpointer in byte ',cur_loc-4:1,
+ ' should be ',old_backpointer:1,'!');
+@.backpointer...should be p@>
+ old_backpointer:=new_backpointer;
+ end;
+end;
+
+@* Using the backpointers.
+The routines in this section of the program are brought into play only
+if |random_reading| is |true| (and only if |out_mode=the_works|).
+First comes a routine that illustrates how to find the postamble quickly.
+
+@<Find the postamble, working back from the end@>=
+n:=dvi_length;
+if n<53 then bad_dvi('only ',n:1,' bytes long');
+@.only n bytes long@>
+m:=n-4;
+repeat if m=0 then bad_dvi('all 223s');
+@.all 223s@>
+move_to_byte(m); k:=get_byte; decr(m);
+until k<>223;
+if k<>id_byte then bad_dvi('ID byte is ',k:1);
+@.ID byte is wrong@>
+move_to_byte(m-3); q:=signed_quad;
+if (q<0)or(q>m-33) then bad_dvi('post pointer ',q:1,' at byte ',m-3:1);
+@.post pointer is wrong@>
+move_to_byte(q); k:=get_byte;
+if k<>post then bad_dvi('byte ',q:1,' is not post');
+@.byte n is not post@>
+post_loc:=q; first_backpointer:=signed_quad
+
+@ Note that the last steps of the above code save the locations of the
+the |post| byte and the final |bop|. We had better declare these global
+variables, together with two more that we will need shortly.
+
+@<Glob...@>=
+@!post_loc:integer; {byte location where the postamble begins}
+@!first_backpointer:integer; {the pointer following |post|}
+@!start_loc:integer; {byte location of the first page to process}
+@!after_pre:integer; {byte location immediately following the preamble}
+
+@ The next little routine shows how the backpointers can be followed
+to move through a \.{DVI} file in reverse order. Ordinarily a \.{DVI}-reading
+program would do this only if it wants to print the pages backwards or
+if it wants to find a specified starting page that is not necessarily the
+first page in the file; otherwise it would of course be simpler and faster
+just to read the whole file from the beginning.
+
+@<Count the pages and move to the starting page@>=
+q:=post_loc; p:=first_backpointer; start_loc:=-1;
+if p<0 then in_postamble:=true
+else begin repeat
+ {now |q| points to a |post| or |bop| command; |p>=0| is prev pointer}
+ if p>q-46 then
+ bad_dvi('page link ',p:1,' after byte ',q:1);
+@.page link wrong...@>
+ q:=p; move_to_byte(q); k:=get_byte;
+ if k=bop then incr(page_count)
+ else bad_dvi('byte ',q:1,' is not bop');
+@.byte n is not bop@>
+ for k:=0 to 9 do count[k]:=signed_quad;
+ p:=signed_quad;
+ if start_match then
+ begin start_loc:=q; old_backpointer:=p;
+ end;
+ until p<0;
+ if start_loc<0 then abort('starting page number could not be found!');
+@.starting page number...@>
+ if old_backpointer<0 then start_loc:=after_pre; {we want to check everything}
+ move_to_byte(start_loc);
+ end;
+if page_count<>total_pages then
+ print_ln('there are really ',page_count:1,' pages, not ',total_pages:1,'!')
+@.there are really n pages@>
+
+@* Reading the postamble.
+Now imagine that we are reading the \.{DVI} file and positioned just
+four bytes after the |post| command. That, in fact, is the situation,
+when the following part of \.{DVItype} is called upon to read, translate,
+and check the rest of the postamble.
+
+@p procedure read_postamble;
+var k:integer; {loop index}
+@!p,@!q,@!m:integer; {general purpose registers}
+begin showing:=false; post_loc:=cur_loc-5;
+print_ln('Postamble starts at byte ',post_loc:1,'.');
+@.Postamble starts at byte n@>
+if signed_quad<>numerator then
+ print_ln('numerator doesn''t match the preamble!');
+@.numerator doesn't match@>
+if signed_quad<>denominator then
+ print_ln('denominator doesn''t match the preamble!');
+@.denominator doesn't match@>
+if signed_quad<>mag then if new_mag=0 then
+ print_ln('magnification doesn''t match the preamble!');
+@.magnification doesn't match@>
+max_v:=signed_quad; max_h:=signed_quad;@/
+print('maxv=',max_v:1,', maxh=',max_h:1);@/
+max_s:=get_two_bytes; total_pages:=get_two_bytes;@/
+print_ln(', maxstackdepth=',max_s:1,', totalpages=',total_pages:1);
+if out_mode<the_works then
+ @<Compare the \\{lust} parameters with the accumulated facts@>;
+@<Process the font definitions of the postamble@>;
+@<Make sure that the end of the file is well-formed@>;
+end;
+
+@ No warning is given when |max_h_so_far| exceeds |max_h| by less than~100,
+since 100 units is invisibly small; it's approximately the wavelength of
+visible light, in the case of \TeX\ output. Rounding errors can be expected
+to make |h| and |v| slightly more than |max_h| and |max_v|, every once in
+a~while; hence small discrepancies are not cause for alarm.
+
+@<Compare the \\{lust}...@>=
+begin if max_v+99<max_v_so_far then
+ print_ln('warning: observed maxv was ',max_v_so_far:1);
+@.warning: observed maxv...@>
+@.observed maxv was x@>
+if max_h+99<max_h_so_far then
+ print_ln('warning: observed maxh was ',max_h_so_far:1);
+@.warning: observed maxh...@>
+@.observed maxh was x@>
+if max_s<max_s_so_far then
+ print_ln('warning: observed maxstackdepth was ',max_s_so_far:1);
+@.warning: observed maxstack...@>
+@.observed maxstackdepth was x@>
+if page_count<>total_pages then
+ print_ln('there are really ',page_count:1,' pages, not ',total_pages:1,'!');
+end
+@.there are really n pages@>
+
+@ When we get to the present code, the |post_post| command has
+just been read.
+
+@<Make sure that the end of the file is well-formed@>=
+q:=signed_quad;
+if q<>post_loc then
+ print_ln('bad postamble pointer in byte ',cur_loc-4:1,'!');
+@.bad postamble pointer@>
+m:=get_byte;
+if m<>id_byte then print_ln('identification in byte ',cur_loc-1:1,
+@.identification...should be n@>
+ ' should be ',id_byte:1,'!');
+k:=cur_loc; m:=223;
+while (m=223)and not eof(dvi_file) do m:=get_byte;
+if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1,
+@.signature...should be...@>
+ ' should be 223')
+else if cur_loc<k+4 then
+ print_ln('not enough signature bytes at end of file (',
+@.not enough signature bytes...@>
+ cur_loc-k:1,')');
+
+@ @<Process the font definitions...@>=
+repeat k:=get_byte;
+if (k>=fnt_def1)and(k<fnt_def1+4) then
+ begin p:=first_par(k); define_font(p); print_ln(' '); k:=nop;
+ end;
+until k<>nop;
+if k<>post_post then
+ print_ln('byte ',cur_loc-1:1,' is not postpost!')
+@.byte n is not postpost@>
+
+@* The main program.
+Now we are ready to put it all together. This is where \.{DVItype} starts,
+and where it ends.
+
+@p begin initialize; {get all variables initialized}
+dialog; {set up all the options}
+@<Process the preamble@>;
+if out_mode=the_works then {|random_reading=true|}
+ begin @<Find the postamble, working back from the end@>;
+ in_postamble:=true; read_postamble; in_postamble:=false;
+ @<Count the pages and move to the starting page@>;
+ end;
+skip_pages(false);
+if not in_postamble then @<Translate up to |max_pages| pages@>;
+if out_mode<the_works then
+ begin if not in_postamble then skip_pages(true);
+ if signed_quad<>old_backpointer then
+ print_ln('backpointer in byte ',cur_loc-4:1,
+ ' should be ',old_backpointer:1,'!');
+@.backpointer...should be p@>
+ read_postamble;
+ end;
+final_end:end.
+
+@ The main program needs a few global variables in order to do its work.
+
+@<Glob...@>=
+@!k,@!m,@!n,@!p,@!q:integer; {general purpose registers}
+
+@ A \.{DVI}-reading program that reads the postamble first need not look at the
+preamble; but \.{DVItype} looks at the preamble in order to do error
+checking, and to display the introductory comment.
+
+@<Process the preamble@>=
+open_dvi_file;
+p:=get_byte; {fetch the first byte}
+if p<>pre then bad_dvi('First byte isn''t start of preamble!');
+@.First byte isn't...@>
+p:=get_byte; {fetch the identification byte}
+if p<>id_byte then
+ print_ln('identification in byte 1 should be ',id_byte:1,'!');
+@.identification...should be n@>
+@<Compute the conversion factors@>;
+p:=get_byte; {fetch the length of the introductory comment}
+print('''');
+while p>0 do
+ begin decr(p); print(xchr[get_byte]);
+ end;
+print_ln('''');
+after_pre:=cur_loc
+
+@ The conversion factor |conv| is figured as follows: There are exactly
+|n/d| decimicrons per \.{DVI} unit, and 254000 decimicrons per inch,
+and |resolution| pixels per inch. Then we have to adjust this
+by the stated amount of magnification.
+
+@<Compute the conversion factors@>=
+numerator:=signed_quad; denominator:=signed_quad;
+if numerator<=0 then bad_dvi('numerator is ',numerator:1);
+@.numerator is wrong@>
+if denominator<=0 then bad_dvi('denominator is ',denominator:1);
+@.denominator is wrong@>
+print_ln('numerator/denominator=',numerator:1,'/',denominator:1);
+tfm_conv:=(25400000.0/numerator)*(denominator/473628672)/16.0;
+conv:=(numerator/254000.0)*(resolution/denominator);
+mag:=signed_quad;
+if new_mag>0 then mag:=new_mag
+else if mag<=0 then bad_dvi('magnification is ',mag:1);
+@.magnification is wrong@>
+true_conv:=conv; conv:=true_conv*(mag/1000.0);
+print_ln('magnification=',mag:1,'; ',conv:16:8,' pixels per DVI unit')
+
+@ The code shown here uses a convention that has proved to be useful:
+If the starting page was specified as, e.g., `\.{1.*.-5}', then
+all page numbers in the file are displayed by showing the values of
+counts 0, 1, and~2, separated by dots. Such numbers can, for example,
+be displayed on the console of a printer when it is working on that
+page.
+
+@<Translate up to...@>=
+begin while max_pages>0 do
+ begin decr(max_pages);
+ print_ln(' '); print(cur_loc-45:1,': beginning of page ');
+ for k:=0 to start_vals do
+ begin print(count[k]:1);
+ if k<start_vals then print('.')
+ else print_ln(' ');
+ end;
+ if not do_page then bad_dvi('page ended unexpectedly');
+@.page ended unexpectedly@>
+ scan_bop;
+ if in_postamble then goto done;
+ end;
+done:end
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVItype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/eomega.rc b/Build/source/texk/web2c/eomega.rc
new file mode 100644
index 00000000000..fadc5e61c0e
--- /dev/null
+++ b/Build/source/texk/web2c/eomega.rc
@@ -0,0 +1,36 @@
+/* eomega.rc: eomega resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " Omega 3.14159--1.15--2.1--RC1"
+
+#define VER_INTERNALNAME_STR TEXLIVE_LIBRARYPREFIX_STR "eomega"
+#define VER_ORIGINALFILENAME_STR TEXLIVE_LIBRARYPREFIX_STR "eomega.dll"
+
+#define VER_FILEDESCRIPTION_STR "e-Omega DLL"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (c) 2002-2003 the e-Omega task force"
+#define VER_LEGALTRADEMARKS_STR "TeX is a trademark of the American \
+Mathematical Society."
+
+#include <texlive.version>
+
+/* eomega.rc ends here */
diff --git a/Build/source/texk/web2c/eomegadir/eo16bit-rc1.ch b/Build/source/texk/web2c/eomegadir/eo16bit-rc1.ch
new file mode 100644
index 00000000000..ee5e907d349
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eo16bit-rc1.ch
@@ -0,0 +1,696 @@
+% This is an \eOmega change file; it brings \eTeX register numbers
+% from 32767 ($2^{15}-1$) to 65535 ($2^{16}-1), to bring it on line
+% with \Omega
+% Noticeably, since Omega has 16-bit quarterwords, it is possible
+% to do so without changing much.
+% Notice that we do this for marks register: everything else is
+% brought to level with Omega in eomem.ch
+%----------------------------------------
+@x Section 53a onwards l.4600
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+@y
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=65535;
+max_reg_help_line:="A register number must be between 0 and 65535.";
+@z
+%----------------------------------------
+@x l.4607
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+@y
+@ There is one doubly linked tree, to handle the sparse array of the up
+to 65535 additional mark classes.
+The root of the tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains eight bits (two
+hexadecimal digits) of the mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (which is always |mark_val|). The |sa_used| field in the
+index nodes counts how many of the 16 pointers are non-null.
+@z
+%----------------------------------------
+@x l.4630
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@y
+The |sa_index| field in the nodes for array elements contains the eight
+bits plus 256 times the type. The type field is actually ignored,
+since we only use this hoop-jumpings for marks registers (the code
+will probably get a rewrite to get in line with the rest of the
+(e-)Omega stuf, anyway, so \dots)
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==7 {the additional box registers}
+@d mark_val=8 {the additional mark classes}
+@z
+%----------------------------------------
+@x
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+@y
+@ The root of the tree for the additional mark classes is kept
+in |sa_mark|.
+
+@<Glob...@>=
+@!sa_mark:pointer; {pointer to sparse array of marks}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+@z
+%----------------------------------------
+@x l.4681
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then set_equiv(box_base+cur_val,#)@+else set_sa_box(#)
+@#
+
+{ FIXME: needs debugging (sparse arrays) }
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@y
+@ Given a type |t| (which is always |mark_val|) and a sixteen-bit number |n|,
+the |find_sa_element| procedure returns (in |cur_ptr|) a pointer to the node
+for the corresponding array element, or |null| when no such element exists.
+The third parameter |w| is set |true| if the element must exist, e.g., because
+it is about to be modified. The procedure has two main branches: one follows
+the existing tree structure, the other (only used when |w| is |true|) creates
+the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+{FIXME: needs debugging}
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin
+begin if t<>mark_val then begin
+ cur_ptr:=null;
+ return;
+end; end;
+cur_ptr:=sa_mark;
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_mark:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ FIXME OBSOLETE The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number.
+
+@ Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 256) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+{FIXME: will be removed}
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+{FIXME: will be removed}
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<number_regs then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end;
+{
+|else begin if t<=dimen_val then| {a count or dimen register}
+| begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;|
+| sa_num(cur_ptr):=n;|
+| end|
+| else begin cur_ptr:=get_node(pointer_node_size);|
+| if t<=mu_val then| {a skip or muskip register}
+| begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);|
+| end|
+| else sa_ptr(cur_ptr):=null; |{a box or token list register}
+| end;|
+| sa_ref(cur_ptr):=null;| {all registers have a reference count}
+| end;|
+}
+sa_index(cur_ptr):=256*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ set_equiv(box_base+cur_val,#)
+@#
+
+{FIXME: will be removed}
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if false then {was |if sa_index(q)<dimen_val_limit then|}
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if false then {was |sa_index(q)<mu_val_limit then|}
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin
+ sa_mark:=null {was |sa_root[i]:=null|}; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if false {was |sa_index(q)<dimen_val_limit|} then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+{
+|if p=null then print_char("?")| {this can't happen}
+|else begin t:=sa_type(p);|
+| if t<box_val then print_cmd_chr(register,p)|
+| else if t=box_val then|
+| begin print_esc("box"); print_sa_num(p);|
+| end|
+| else if t=tok_val then print_cmd_chr(toks_register,p)|
+| else print_char("?");| {this can't happen either}
+| print_char("=");|
+| if t=int_val then print_int(sa_int(p))|
+| else if t=dimen_val then|
+| begin print_scaled(sa_dim(p)); print("pt");|
+| end|
+| else begin p:=sa_ptr(p);|
+| if t=glue_val then print_spec(p,"pt")|
+| else if t=mu_val then print_spec(p,"mu")|
+| else if t=box_val then|
+| if p=null then print("void")|
+| else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);|
+| end|
+| else if t=tok_val then|
+| begin if p<>null then show_token_list(link(p),null,32);|
+| end|
+| else print_char("?");| {this can't happen either}
+| end;|
+| end;|
+}
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@z
+%----------------------------------------
+% TODO: l.5029+: will the simply be removed?
+% (i.e.: cases which cannot happen (anymore)?)
+%----------------------------------------
+@x
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+@y
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if false {was |i<dimen_val_limit|} then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=i {was |i:=tok_val_limit|};
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if false {was |sa_index(p)<mu_val_limit|} then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if false {was |sa_index(p)<box_val_limit|} then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+@z
+%----------------------------------------
+@x
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@y
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin {|if sa_index(p)>=dimen_val_limit then|} sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if false {was |sa_index(p)<dimen_val_limit|} then
+ if false {was |sa_index(sa_chain)<dimen_val_limit|} then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if false {was |sa_index(p)<dimen_val_limit|} then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@z
diff --git a/Build/source/texk/web2c/eomegadir/eo16bit-rc2.ch b/Build/source/texk/web2c/eomegadir/eo16bit-rc2.ch
new file mode 100644
index 00000000000..e888efa80f4
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eo16bit-rc2.ch
@@ -0,0 +1,795 @@
+% This is an \eOmega change file; it brings \eTeX register numbers
+% from 32767 ($2^{15}-1$) to 65535 ($2^{16}-1), to bring it on line
+% with \Omega
+% Noticeably, since Omega has 16-bit quarterwords, it is possible
+% to do so without changing much.
+% Notice that we do this for marks register: everything else is
+% brought to level with Omega in eomem.ch
+%----------------------------------------
+@x Section 53a onwards l.4600
+@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
+dimen, skip, muskip, box, and token registers. As in \TeX\ the first
+256 registers of each kind are realized as arrays in the table of
+equivalents; the additional registers are realized as tree structures
+built from variable-size nodes with individual registers existing only
+when needed. Default values are used for nonexistent registers: zero
+for count and dimen values, |zero_glue| for glue (skip and muskip)
+values, void for boxes, and |null| for token lists (and current marks
+discussed below).
+
+Similarly there are 32768 mark classes; the command \.{\\marks}|n|
+creates a mark node for a given mark class |0<=n<=32767| (where
+\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
+the |fire_up| routine) and the |vsplit| routine maintain the current
+values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
+|split_bot_mark| for each mark class. They are accessed as
+\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
+\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
+are realized as |cur_mark| array. The additional current marks are
+again realized as tree structure with individual mark classes existing
+only when needed.
+
+@<Generate all \eTeX...@>=
+primitive("marks",mark,marks_code);
+@!@:marks_}{\.{\\marks} primitive@>
+primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
+@!@:top_marks_}{\.{\\topmarks} primitive@>
+primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
+@!@:first_marks_}{\.{\\firstmarks} primitive@>
+primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
+@!@:bot_marks_}{\.{\\botmarks} primitive@>
+primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
+@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
+primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
+@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
+
+@ The |scan_register_num| procedure scans a register number that must
+not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?scan_register_num; forward;@t\2@>
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>max_reg_num) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2(max_reg_help_line)("I changed this one to zero.");
+ int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Initialize variables for \eTeX\ comp...@>=
+max_reg_num:=255;
+max_reg_help_line:="A register number must be between 0 and 255.";
+
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+@y
+@ \eOmega\ (in extended mode) supports 65536 (i.e., $2^{16}$) count,
+dimen, skip, muskip, box, and token registers. They are
+implemented as in \TeX.
+
+There are 32768 mark classes; the command \.{\\marks}|n|
+creates a mark node for a given mark class |0<=n<=32767| (where
+\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
+the |fire_up| routine) and the |vsplit| routine maintain the current
+values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
+|split_bot_mark| for each mark class. They are accessed as
+\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
+\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
+are realized as |cur_mark| array. The additional current marks are
+again realized as tree structure with individual mark classes existing
+only when needed.
+
+@<Generate all \eTeX...@>=
+primitive("marks",mark,marks_code);
+@!@:marks_}{\.{\\marks} primitive@>
+primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
+@!@:top_marks_}{\.{\\topmarks} primitive@>
+primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
+@!@:first_marks_}{\.{\\firstmarks} primitive@>
+primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
+@!@:bot_marks_}{\.{\\botmarks} primitive@>
+primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
+@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
+primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
+@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
+
+@ The |scan_register_num| procedure scans a (token) register number.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?scan_register_num; forward;@t\2@>
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>max_reg_num) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2(max_reg_help_line)("I changed this one to zero.");
+ int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Initialize variables for \eTeX\ comp...@>=
+max_reg_num:=255;
+max_reg_help_line:="A register number must be between 0 and 255.";
+
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32727.";
+@z
+%----------------------------------------
+@x l.4607
+@ @<Glob...@>=
+@!max_reg_num: halfword; {largest allowed register number}
+@!max_reg_help_line: str_number; {first line of help message}
+
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+@y
+@ @<Glob...@>=
+@!max_reg_num: halfword; {largest allowed register number}
+@!max_reg_help_line: str_number; {first line of help message}
+
+@ There is one doubly linked tree, to handle the sparse array of the up
+to 32727 additional mark classes.
+The root of the tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains eight bits (two
+hexadecimal digits) of the mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (which is always |mark_val|). The |sa_used| field in the
+index nodes counts how many of the 16 pointers are non-null.
+@z
+%----------------------------------------
+@x l.4630
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@y
+The |sa_index| field in the nodes for array elements contains the eight
+bits plus 256 times the type. The type field is actually ignored,
+since we only use this hoop-jumpings for marks registers (the code
+will probably get a rewrite to get in line with the rest of the
+(e-)Omega stuf, anyway, so \dots)
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d mark_val=7 {the additional mark classes}
+@z
+%----------------------------------------
+@x
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+@y
+@ The root of the tree for the additional mark classes is kept
+in |sa_mark|.
+
+@<Glob...@>=
+@!sa_mark:pointer; {pointer to sparse array of marks}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+@z
+%----------------------------------------
+@x l.4681
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then set_equiv(box_base+cur_val,#)@+else set_sa_box(#)
+@#
+
+{ FIXME: needs debugging (sparse arrays) }
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@y
+@ Given a type |t| (which is always |mark_val|) and a sixteen-bit number |n|,
+the |find_sa_element| procedure returns (in |cur_ptr|) a pointer to the node
+for the corresponding array element, or |null| when no such element exists.
+The third parameter |w| is set |true| if the element must exist, e.g., because
+it is about to be modified. The procedure has two main branches: one follows
+the existing tree structure, the other (only used when |w| is |true|) creates
+the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+{FIXME: needs debugging}
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin
+begin if t<>mark_val then begin
+ cur_ptr:=null;
+ return;
+end; end;
+cur_ptr:=sa_mark;
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_mark:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 256) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end;
+sa_index(cur_ptr):=256*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_ptr(q)<>null then return;
+s:=pointer_node_size;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin
+ sa_mark:=null {was |sa_root[i]:=null|}; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@z
+%----------------------------------------
+% TODO: l.5029+: will the simply be removed?
+% (i.e.: cases which cannot happen (anymore)?)
+%----------------------------------------
+@x l.5078
+@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
+etc., as well as for references to sparse array elements defined by
+`\.{\\countdef}', etc.
+
+@<Cases of |register| for |print_cmd_chr|@>=
+begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
+ cmd:=sa_type(chr_code)
+else begin cmd:=chr_code-mem_bot; chr_code:=null;
+ end;
+if cmd=int_val then print_esc("count")
+else if cmd=dimen_val then print_esc("dimen")
+else if cmd=glue_val then print_esc("skip")
+else print_esc("muskip");
+if chr_code<>null then print_sa_num(chr_code);
+end
+
+@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
+well as for references to sparse array elements defined by
+`\.{\\toksdef}'.
+
+@<Cases of |toks_register| for |print_cmd_chr|@>=
+begin print_esc("toks");
+if chr_code<>mem_bot then print_sa_num(chr_code);
+end
+
+@ When a shorthand definition for an element of one of the sparse arrays
+is destroyed, we must reduce the reference count.
+
+@<Cases for |eq_destroy|@>=
+toks_register,register:
+ if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
+ delete_sa_ref(equiv_field(w));
+
+@ The task to maintain (change, save, and restore) register values is
+essentially the same when the register is realized as sparse array
+element or entry in |eqtb|. The global variable |sa_chain| is the head
+of a linked list of entries saved at the topmost level |sa_level|; the
+lists for lowel levels are kept in special save stack entries.
+
+@<Glob...@>=
+@!sa_chain: pointer; {chain of saved sparse array entries}
+@!sa_level: quarterword; {group level for |sa_chain|}
+
+@ @<Set init...@>=
+sa_chain:=null; sa_level:=level_zero;
+
+@ The individual saved items are kept in pointer or word nodes similar
+to those used for the array elements: a word node with value zero is,
+however, saved as pointer node with the otherwise impossible |sa_index|
+value |tok_val_limit|.
+
+@d sa_loc==sa_ref {location of saved item}
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+
+@ The procedure |sa_def| assigns a new value to sparse array elements,
+and saves the former value if appropriate. This procedure is used only
+for skip, muskip, box, and token list registers. The counterpart of
+|sa_def| for count and dimen registers is called |sa_w_def|.
+
+@d sa_define(#)==if e then
+ if global then gsa_def(#)@+else sa_def(#)
+ else define
+@#
+@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
+ begin find_sa_element(box_val,cur_val,true);
+ if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
+ end
+@#
+@d sa_word_define(#)==if e then
+ if global then gsa_w_def(#)@+else sa_w_def(#)
+ else word_define(#)
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_def(@!p:pointer;@!e:halfword);
+ {new data for sparse array elements}
+begin add_sa_ref(p);
+if sa_ptr(p)=e then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ sa_destroy(p);
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
+ sa_lev(p):=cur_level; sa_ptr(p):=e;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+@#
+procedure sa_w_def(@!p:pointer;@!w:integer);
+begin add_sa_ref(p);
+if sa_int(p)=w then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)<>cur_level then sa_save(p);
+ sa_lev(p):=cur_level; sa_int(p):=w;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+
+@ The |sa_def| and |sa_w_def| routines take care of local definitions.
+@^global definitions@>
+Global definitions are done in almost the same way, but there is no need
+to save old values, and the new value is associated with |level_one|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+@#
+procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_lev(p):=level_one; sa_int(p):=w;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+
+@ The |sa_restore| procedure restores the sparse array entries pointed
+at by |sa_chain|
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@y
+@z
diff --git a/Build/source/texk/web2c/eomegadir/eobase.ch b/Build/source/texk/web2c/eomegadir/eobase.ch
new file mode 100644
index 00000000000..5cffb470b60
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eobase.ch
@@ -0,0 +1,5542 @@
+% vim: ft=change
+% TODO: sparse arrays
+% This is the first of the set of
+% WEB change file containing code for various features extending Omega;
+% these files define the e-Omega program, and are designed to be applied
+% to omega.web (Version 3.14159--1.15) compiled without XML support.
+% This change-file is heavily based on etex.ch,
+% defining version 2.1 of e-TeX.
+
+% ATTENTION: The software is currently in pre-alpha stage.
+
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+% e-TeX and NTS are trademarks of the NTS group.
+
+% All line numbers refer to TEX.WEB 3.14159 as of March 21, 1995.
+% TODO: double line number reference, having them for both TEX.WEB
+% and (X)OMEGA.WEB
+
+@x limbo l.1 - this is e-Omega
+% (C) 1994--2000 by John Plaice and Yannis Haralambous.
+@y
+% (C) 2002 by Giuseppe Bilotta and the e-Omega task force;
+% all rights are reserved.
+%
+% e-Omega is directly derived from e-TeX, an extension of
+% Donald E. Knuth's TeX developed by Peter Breitenlohner and
+% the NTS team, and Omega, another extension of TeX, developed by
+% John Plaice and Yannis Haralambous.
+
+% e-Omega is designed in the form of a set of WEB changefiles
+% to be applied to Omega (version 3.14159--1.15)
+% compiled without XML support. The changefiles are heavily based
+% on the e-TeX 2.1 changefiles.
+
+% Omega is copyright (C) 1994--2000 by John Plaice and Yannis Haralambous.
+@z
+%---------------------------------------
+@x limbo l.1 - this is e-TeX
+%
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+% Copying of this file is authorized only if (1) you are D. E. Knuth, or if
+% (2) you make absolutely no changes to your copy. (The WEB system provides
+% for alterations via an auxiliary file; the master file should stay intact.)
+% See Appendix H of the WEB manual for hints on how to install this program.
+% And see Appendix A of the TRIP manual for details about how to validate it.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+@y
+
+% e-TeX is copyright (C) 1994,98 by the NTS team; all rights are reserved.
+
+% e-TeX and NTS are trademarks of the NTS group.
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+
+% e-TeX is directly derived from Donald E. Knuth's TeX;
+% the change history which follows and the reward offered for finders of
+% bugs refer specifically to TeX; they should not be taken as referring
+% to e-TeX, although the change history is relevant in that it
+% demonstrates the evolutionary path followed. This program is not TeX;
+% that name is reserved strictly for the program which is the creation
+% and sole responsibility of Professor Knuth.
+@z
+%---------------------------------------
+@x limbo l.50 - e-TeX history
+% Although considerable effort has been expended to make the TeX program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the author hopes that users enjoy it.
+@y
+% A preliminary version of TeX--XeT was released in April 1992.
+% TeX--XeT version 1.0 was released in June 1992,
+% version 1.1 prevented arith overflow in glue computation (Oct 1992).
+% A preliminary e-TeX version 0.95 was operational in March 1994.
+% Version 1.0beta was released in May 1995.
+% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995).
+% Version 1.02beta allowed 256 mark classes (March 1996).
+% Version 1.1 changed \group{type,level} -> \currentgroup{type,level},
+% first public release (October 1996).
+% Version 2.0 development was started in March 1997;
+% fixed a ligature-\beginR bug in January 1998;
+% was released in March 1998.
+% Version 2.1 fixed a marks bug (when min_halfword<>0) (January 1999).
+
+% e-Omega includes all the e-TeX extensions, except for TeX--XeT and
+% some optimizations.
+
+% Release Candidate 0 was released in Janurary 2003.
+
+% Although considerable effort has been expended to make the e-Omega program
+% correct and reliable, no warranty is implied; the authors disclaim any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the authors hope that users enjoy it.
+@z
+%---------------------------------------
+@x limbo l.61 - e-TeX logo, TeXXeT
+\let\mc=\ninerm % medium caps for names like SAIL
+@y
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\eTeX{$\varepsilon$-\TeX}
+\def\eOmega{$\varepsilon$-$\Omega$}
+% \font\revrm=xbmc10 % for right-to-left text
+% % to generate xbmc10 (i.e., reflected cmbx10) use a file
+% % xbmc10.mf containing:
+% %+++++++++++++++++++++++++++++++++++++++++++++++++
+% % if unknown cmbase: input cmbase fi
+% % extra_endchar := extra_endchar &
+% % "currentpicture:=currentpicture " &
+% % "reflectedabout((.5[l,r],0),(.5[l,r],1));";
+% % input cmbx10
+% %+++++++++++++++++++++++++++++++++++++++++++++++++
+% \ifx\beginL\undefined % this is TeX
+ \def\XeT{X\kern-.125em\lower.5ex\hbox{E}\kern-.1667emT}
+ \def\TeXeT{\TeX-\hbox{\revrm \XeT}} % for TeX-XeT
+ \def\TeXXeT{\TeX-\hbox{\revrm -\XeT}} % for TeX--XeT
+% \else
+% \ifx\eTeXversion\undefined % this is \TeXeT
+% \def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT
+% \def\TeXXeT{\TeX-{\revrm\beginR\TeX-\endR}} % for TeX--XeT
+% \else % this is \eTeX
+% \def\TeXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX\endR}} % for TeX-XeT
+% \def\TeXXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX-\endR}} % for TeX--XeT
+% \fi
+% \fi
+@z
+%---------------------------------------
+@x limbo l.64 - bug fix (print only changed modules)
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+@y
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\def\grp{\.{\char'173...\char'175}}
+@z
+%---------------------------------------
+@x limbo l.80 - e-TeX basic
+\def\title{$\Omega$ (OMEGA)}
+@y
+\def\title{\eOmega\ (E-OMEGA)}
+% system dependent redefinitions of \title should come later
+% and should use:
+% \toks0=\expandafter{\title}
+% \edef\title{...\the\toks0...}
+\let\maybe=\iffalse % print only changed modules
+\let\maybe=\iftrue % print everything
+@z
+%---------------------------------------
+@x [1] m.1 l.91 - this is e-TeX
+This is $\Omega$, a document compiler intended to simplify high-quality
+@y
+This is \eOmega, an extension of $\Omega$. $\Omega$ is a document compiler
+intended to simplify high-quality
+@z
+%---------------------------------------
+@x [1] m.2 l.179 - e-TeX basic
+If this program is changed, the resulting system should not be called
+@y
+This program contains code from both the $\Omega$ (developed by
+John Plaice and Yannis Haralambous) and \eTeX\
+(developed by Peter Breitenlohner and the NTS team) extensions
+to \TeX, therefore this program is called `\eOmega' and not
+@z
+%---------------------------------------
+@x [1] m.2 l.185 - e-TeX basic
+November 1984].
+@y
+November 1984].
+
+A similar test suite called the ``\.{e-BUMP} test'' is (or will be made)
+available for helping to determine whether a particular implementation deserves
+to be known as `\eOmega'.
+@z
+%---------------------------------------
+@x [1] m.2 l.187 - e-TeX basic
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@y
+@d banner=='This is e-Omega, Version 3.141592--1.15--2.1' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.141592--1.15--2.1' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@#
+@d eTeX_banner=='This is e-Omega, Version ',eTeX_version_string
+ {printed when \eTeX\ starts}
+@#
+@d OMEGA==EOMEGA {change program name into |EOMEGA|}
+@#
+@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|}
+@z
+%---------------------------------------
+@x [1] m.15 l.493 - e-TeX basic
+@d not_found=45 {go here when you've found nothing}
+@y
+@d not_found=45 {go here when you've found nothing}
+@d not_found1=46 {like |not_found|, when there's more than one}
+@d not_found2=47 {like |not_found|, when there's more than two}
+@d not_found3=48 {like |not_found|, when there's more than three}
+@d not_found4=49 {like |not_found|, when there's more than four}
+@z
+%---------------------------------------
+@x [5] m.61 l.1556 - e-TeX basic
+wterm(banner);
+@y
+wterm(eTeX_banner);
+@z
+%---------------------------------------
+@x [10] m.141 l.2965 - e-TeX marks
+This field occupies a full word instead of a halfword, because
+there's nothing to put in the other halfword; it is easier in \PASCAL\ to
+use the full word than to risk leaving garbage in the unused half.
+@y
+In addition there is a |mark_class| field that contains the mark class.
+@z
+%---------------------------------------
+@x [10] m.141 l.2971 - e-TeX marks
+@d mark_ptr(#)==mem[#+1].int {head of the token list for a mark}
+@y
+@d mark_ptr(#)==link(#+1) {head of the token list for a mark}
+@d mark_class(#)==info(#+1) {the mark class}
+@z
+%---------------------------------------
+@x [10] m.142 l.2980 - e-TeX marks
+@d adjust_ptr==mark_ptr {vertical list to be moved out of horizontal list}
+@y
+@d adjust_ptr(#)==mem[#+1].int
+ {vertical list to be moved out of horizontal list}
+@z
+%---------------------------------------
+% @x [10] m.147 l.3069 - e-TeX TeXXeT
+% the amount of surrounding space inserted by \.{\\mathsurround}.
+% @y
+% the amount of surrounding space inserted by \.{\\mathsurround}.
+%
+% In addition a |math_node| with |subtype>after| and |width=0| will be
+% (ab)used to record a regular |math_node| reinserted after being
+% discarded at a line break or one of the text direction primitives (
+% \.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} ).
+% @z
+%---------------------------------------
+% @x [10] m.147 l.3073 - e-TeX TeXXeT
+% @d after=1 {|subtype| for math node that winds up a formula}
+% @y
+% @d after=1 {|subtype| for math node that winds up a formula}
+% @#
+% @d M_code=2
+% @d begin_M_code=M_code+before {|subtype| for \.{\\beginM} node}
+% @d end_M_code=M_code+after {|subtype| for \.{\\endM} node}
+% @d L_code=4
+% @d begin_L_code=L_code+begin_M_code {|subtype| for \.{\\beginL} node}
+% @d end_L_code=L_code+end_M_code {|subtype| for \.{\\endL} node}
+% @d R_code=L_code+L_code
+% @d begin_R_code=R_code+begin_M_code {|subtype| for \.{\\beginR} node}
+% @d end_R_code=R_code+end_M_code {|subtype| for \.{\\endR} node}
+% @#
+% @d end_LR(#)==odd(subtype(#))
+% @d end_LR_type(#)==(L_code*(subtype(#) div L_code)+end_M_code)
+% @d begin_LR_type(#)==(#-after+before)
+% @z
+%---------------------------------------
+% @x [12] m.175 l.3546 - e-TeX TeXXeT
+% math_node: print_char("$");
+% @y
+% math_node: if subtype(p)>=L_code then print("[]")
+% else print_char("$");
+% @z
+%---------------------------------------
+% @x [12] m.184 l.3713 - e-TeX TeXXeT
+% begin print(", shifted "); print_scaled(shift_amount(p));
+% end;
+% @y
+% begin print(", shifted "); print_scaled(shift_amount(p));
+% end;
+% if eTeX_ex then @<Display if this box is never to be reversed@>;
+% @z
+%---------------------------------------
+% @x [12] m.192 l.3811 - e-TeX TeXXeT
+% begin print_esc("math");
+% @y
+% if subtype(p)>after then
+% begin if end_LR(p) then print_esc("end")
+% else print_esc("begin");
+% if subtype(p)>R_code then print_char("R")
+% else if subtype(p)>L_code then print_char("L")
+% else print_char("M");
+% end else
+% begin print_esc("math");
+% @z
+%---------------------------------------
+@x [12] m.196 l.3844 - e-TeX marks
+begin print_esc("mark"); print_mark(mark_ptr(p));
+@y
+begin print_esc("mark");
+if mark_class(p)<>0 then
+ begin print_char("s"); print_int(mark_class(p));
+ end;
+print_mark(mark_ptr(p));
+@z
+%---------------------------------------
+@x [15] m.208 l.4081 - e-TeX saved_items
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+@y
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+ {( or \.{\\pagediscards}, \.{\\splitdiscards} )}
+@z
+%---------------------------------------
+% @x [15] m.208 l.4091 - e-TeX TeXXeT
+% @d valign=33 {vertical table alignment ( \.{\\valign} )}
+% @y
+% @d valign=33 {vertical table alignment ( \.{\\valign} )}
+% {or text direction directives ( \.{\\beginL}, etc.~)}
+% @z
+%---------------------------------------
+@x [15] m.208 l.4107 - e-TeX middle
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+@y
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+ {( or \.{\\middle} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4151 - e-TeX basic
+ \.{\\insertpenalties} )}
+@y
+ \.{\\insertpenalties} )}
+ {( or \.{\\interactionmode} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4153 - e-TeX penalties
+@d set_shape=set_box_dimen+1
+ {specify fancy paragraph shape ( \.{\\parshape} )}
+@y
+@d set_shape=set_box_dimen+1
+ {specify fancy paragraph shape ( \.{\\parshape} )}
+ {(or \.{\\interlinepenalties}, etc.~)}
+@z
+%---------------------------------------
+@x [15] m.209 l.4163 - e-TeX protected
+@d prefix=divide+1
+ {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@y
+@d prefix=divide+1
+ {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+ {( or \.{\\protected} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4166 - e-TeX read_line
+@d read_to_cs=shorthand_def+1
+ {read into a control sequence ( \.{\\read} )}
+@y
+@d read_to_cs=shorthand_def+1
+ {read into a control sequence ( \.{\\read} )}
+ {( or \.{\\readline} )}
+@z
+%---------------------------------------
+@x [15] m.210 l.4181 - e-TeX scan_tokens
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+@y
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+ {( or \.{\\scantokens} )}
+@z
+%---------------------------------------
+@x [15] m.210 l.4186 - e-TeX unexpanded
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+@y
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+ {( or \.{\\unexpanded}, \.{\\detokenize} )}
+@z
+%---------------------------------------
+@x [16] m.212 l.4289 - e-TeX basic
+user's output routine.
+@y
+user's output routine.
+
+A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX.
+In vertical modes it is known as |LR_save| and holds the LR stack when a
+paragraph is interrupted by a displayed formula. In display math mode
+it is known as |LR_box| and holds a pointer to a prototype box for the
+display. In math mode it is known as |delim_ptr| and points to the most
+recent |left_noad| or |middle_noad| of a |math_left_group|.
+
+In \eOmega it is only used in this last sense.
+@z
+%---------------------------------------
+@x [16] m.212 l.4304 - e-TeX basic
+ @!head_field,@!tail_field: pointer;
+@y
+ @!head_field,@!tail_field: pointer;
+ @!eTeX_aux_field: pointer;
+@z
+%---------------------------------------
+@x [16] m.213 l.4311 - e-TeX basic
+@d tail==cur_list.tail_field {final node on current list}
+@y
+@d tail==cur_list.tail_field {final node on current list}
+@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX}
+@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group}
+@z
+%---------------------------------------
+@x [16] m.215 l.4342 - e-TeX basic
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+@y
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+eTeX_aux:=null;
+@z
+%---------------------------------------
+@x [16] m.216 l.4358 push_nest - e-TeX basic
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+eTeX_aux:=null;
+@z
+%---------------------------------------
+@x [17] m.230 l.4712 - e-TeX basic, penalties
+@d output_routine_loc=local_base+1 {points to token list for \.{\\output}}
+@d every_par_loc=local_base+2 {points to token list for \.{\\everypar}}
+@d every_math_loc=local_base+3 {points to token list for \.{\\everymath}}
+@d every_display_loc=local_base+4 {points to token list for \.{\\everydisplay}}
+@d every_hbox_loc=local_base+5 {points to token list for \.{\\everyhbox}}
+@d every_vbox_loc=local_base+6 {points to token list for \.{\\everyvbox}}
+@d every_job_loc=local_base+7 {points to token list for \.{\\everyjob}}
+@d every_cr_loc=local_base+8 {points to token list for \.{\\everycr}}
+@d err_help_loc=local_base+9 {points to token list for \.{\\errhelp}}
+@d ocp_trace_level_base=local_base+10
+@y
+@d inter_line_penalties_loc=local_base+1 {additional penalties between lines}
+@d club_penalties_loc=local_base+2 {penalties for creating club lines}
+@d widow_penalties_loc=local_base+3 {penalties for creating widow lines}
+@d display_widow_penalties_loc=local_base+4 {ditto, just before a display}
+@d token_base=local_base+5 {table of token list parameters}
+@d output_routine_loc=token_base {points to token list for \.{\\output}}
+@d every_par_loc=token_base+1 {points to token list for \.{\\everypar}}
+@d every_math_loc=token_base+2 {points to token list for \.{\\everymath}}
+@d every_display_loc=token_base+3 {points to token list for \.{\\everydisplay}}
+@d every_hbox_loc=token_base+4 {points to token list for \.{\\everyhbox}}
+@d every_vbox_loc=token_base+5 {points to token list for \.{\\everyvbox}}
+@d every_job_loc=token_base+6 {points to token list for \.{\\everyjob}}
+@d every_cr_loc=token_base+7 {points to token list for \.{\\everycr}}
+@d every_eof_loc=token_base+8 {points to token list for \.{\\everyeof}}
+@d err_help_loc=token_base+9 {points to token list for \.{\\errhelp}}
+@d ocp_trace_level_base=token_base+10
+@z
+%---------------------------------------
+@x [17] m.231 l.4787 - e-TeX basic
+ othercases print_esc("errhelp")
+@y
+ @/@<Cases of |assign_toks| for |print_cmd_chr|@>@/
+ othercases print_esc("errhelp")
+@z
+%---------------------------------------
+% FIXME moved to init_eqtb_entry --see later
+% @x [17] m.232 l.4805 - e-TeX penalties
+% eq_level(par_shape_loc):=level_one;@/
+% @y
+% eq_level(par_shape_loc):=level_one;@/
+% for k:=par_shape_loc+1 to token_base-1 do
+% eqtb[k]:=eqtb[par_shape_loc];
+% @z
+%---------------------------------------
+@x [17] m.233 l.4833 - e-TeX penalties
+if n=par_shape_loc then
+ begin print_esc("parshape"); print_char("=");
+ if par_shape_ptr=null then print_char("0")
+ else print_int(info(par_shape_ptr));
+@y
+if n<token_base then
+ begin print_cmd_chr(set_shape,n); print_char("=");
+ if equiv(n)=null then print_char("0")
+ else if n>par_shape_loc then
+ begin print_int(penalty(equiv(n))); print_char(" ");
+ print_int(penalty(equiv(n)+1));
+ if penalty(equiv(n))>1 then print_esc("ETC.");
+ end
+ else print_int(info(par_shape_ptr));
+@z
+%---------------------------------------
+% FIXME: in this section and in the next
+% we should remove pre_display_direction[_code]
+% stuff, both here and down below
+@x [17] m.236 l.4955 - e-TeX basic
+@d dir_base=int_base+int_pars
+@y
+@d tracing_assigns_code=int_pars {show assignments}
+@d tracing_groups_code=int_pars+1 {show save/restore groups}
+@d tracing_ifs_code=int_pars+2 {show conditionals}
+@d tracing_scan_tokens_code=int_pars+3 {show pseudo file open and close}
+@d tracing_nesting_code=int_pars+4
+ {show incomplete groups and ifs within files}
+@d pre_display_direction_code=int_pars+5 {text direction preceding a display}
+@d last_line_fit_code=int_pars+6 {adjustment for last line of paragraph}
+@d saving_vdiscards_code=int_pars+7 {save items discarded from vlists}
+@d saving_hyph_codes_code=int_pars+8 {save hyphenation codes for languages}
+@d eTeX_state_code=int_pars+9 {\eTeX\ state variables}
+@d dir_base=int_base+eTeX_state_code+eTeX_states
+@z
+%---------------------------------------
+@x [17] m.236 l.5016 - e-TeX basic
+@d error_context_lines==int_par(error_context_lines_code)
+@y
+@d error_context_lines==int_par(error_context_lines_code)
+@d tracing_assigns==int_par(tracing_assigns_code)
+@d tracing_groups==int_par(tracing_groups_code)
+@d tracing_ifs==int_par(tracing_ifs_code)
+@d tracing_scan_tokens==int_par(tracing_scan_tokens_code)
+@d tracing_nesting==int_par(tracing_nesting_code)
+@d pre_display_direction==int_par(pre_display_direction_code)
+@d last_line_fit==int_par(last_line_fit_code)
+@d saving_vdiscards==int_par(saving_vdiscards_code)
+@d saving_hyph_codes==int_par(saving_hyph_codes_code)
+@z
+%---------------------------------------
+@x [17] m.237 l.5081 print_param - e-TeX basic
+othercases print("[unknown integer parameter!]")
+@y
+@/@<Cases for |print_param|@>@/
+othercases print("[unknown integer parameter!]")
+@z
+%---------------------------------------
+% FIXED(?): moved to init_eqtb_entry in
+% omega.web at l.5813
+@x [17] m.232 l.4805 - e-TeX penalties
+ { Region 4 }
+ else if (p>=par_shape_loc) and
+ (p<=toks_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+@y
+ { Region 4 }
+ else if (p>=par_shape_loc) and
+ (p< token_base) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=shape_ref;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=token_base) and
+ (p<=toks_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+@z
+%---------------------------------------
+@x [18] m.264 l.5612 primitive - e-TeX basic
+@!j:small_number; {index into |buffer|}
+@y
+@!j:0..buf_size; {index into |buffer|}
+@z
+%---------------------------------------
+@x [18] m.264 l.5616 primitive - e-TeX basic
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+@y
+ {we will move |s| into the (possibly non-empty) |buffer|}
+ if first+l>buf_size+1 then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
+@z
+%---------------------------------------
+@x [18] m.265 l.5691 - e-TeX penalties
+primitive("parshape",set_shape,0);@/
+@y
+primitive("parshape",set_shape,par_shape_loc);@/
+@z
+%---------------------------------------
+@x [18] m.265 l.5708 - e-TeX sparse arrays
+primitive("toks",toks_register,0);@/
+@y
+primitive("toks",toks_register,mem_bot);@/
+@z
+%---------------------------------------
+@x [18] m.266 l.5741 - e-TeX cond
+expand_after: print_esc("expandafter");
+@y
+expand_after: if chr_code=0 then print_esc("expandafter")
+ @<Cases of |expandafter| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5747 - e-TeX marks
+mark: print_esc("mark");
+@y
+mark: begin print_esc("mark");
+ if chr_code>0 then print_char("s");
+ end;
+@z
+%---------------------------------------
+@x [18] m.266 l.5758 - e-TeX read_line
+read_to_cs: print_esc("read");
+@y
+read_to_cs: if chr_code=0 then print_esc("read")
+ @<Cases of |read| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5762 - e-TeX penalties
+set_shape: print_esc("parshape");
+@y
+set_shape: case chr_code of
+ par_shape_loc: print_esc("parshape");
+ @<Cases of |set_shape| for |print_cmd_chr|@>@;@/
+ end; {there are no other cases}
+@z
+%---------------------------------------
+@x [18] m.266 l.5763 - e-TeX unexpanded
+the: print_esc("the");
+@y
+the: if chr_code=0 then print_esc("the")
+ @<Cases of |the| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5764 - e-TeX sparse arrays
+toks_register: print_esc("toks");
+@y
+toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+% @x [18] m.266 l.5766 - e-TeX TeXXeT
+% valign: print_esc("valign");
+% @y
+% valign: if chr_code=0 then print_esc("valign")@/
+% @<Cases of |valign| for |print_cmd_chr|@>;
+% @z
+%---------------------------------------
+@x [19] m.268 l.5800 - e-TeX sparse arrays
+interpreted in one of four ways:
+@y
+interpreted in one of five ways:
+@z
+%---------------------------------------
+@x [19] m.268 l.5820 - e-TeX tracing
+the entries for that group.
+@y
+the entries for that group.
+Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
+source line number at which the current level of grouping was entered.
+
+\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a
+chain of sparse array entries to be restored at the end of the current
+group. Furthermore |save_index(p)| and |save_level(p)| should replace
+the values of |sa_chain| and |sa_level| respectively.
+@z
+%---------------------------------------
+% FIXME restore_sa safe? (sparse arrays)
+@x [19] m.268 l.5830 - e-TeX basic
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@y
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@d restore_sa=4 {|save_type| when sparse array entries should be restored}
+
+@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
+@z
+%---------------------------------------
+@x [19] m.273 l.5888 - e-TeX tracing
+@ The following macro is used to test if there is room for up to six more
+@y
+@ The following macro is used to test if there is room for up to seven more
+@z
+%---------------------------------------
+@x [19] m.273 l.5894 check_full_save_stack - e-TeX tracing
+ if max_save_stack>save_size-6 then overflow("save size",save_size);
+@y
+ if max_save_stack>save_size-7 then overflow("save size",save_size);
+@z
+%---------------------------------------
+@x [19] m.274 l.5916 new_save_level - e-TeX tracing
+begin check_full_save_stack;
+@y
+begin check_full_save_stack;
+if eTeX_ex then
+ begin saved(0):=line; incr(save_ptr);
+ end;
+@z
+%---------------------------------------
+@x [19] m.274 l.5923 new_save_level - e-TeX tracing
+cur_boundary:=save_ptr; incr(cur_level); incr(save_ptr); cur_group:=c;
+@y
+cur_boundary:=save_ptr; cur_group:=c;
+@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/
+incr(cur_level); incr(save_ptr);
+@z
+%---------------------------------------
+@x [19] m.275 l.5941 eq_destroy - e-TeX sparse arrays
+othercases do_nothing
+@y
+@/@<Cases for |eq_destroy|@>@/
+othercases do_nothing
+@z
+%---------------------------------------
+@x [19] m.277 l.5963 - e-TeX tracing
+the call, since |eq_save| makes the necessary test.
+@y
+the call, since |eq_save| makes the necessary test.
+
+@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#);
+ tats
+@z
+%---------------------------------------
+@x [19] m.277 l.5967 eq_define - e-TeX tracing
+begin if eq_level(p)=cur_level then eq_destroy(new_eqtb(p))
+@y
+label exit;
+begin if eTeX_ex and(eq_type(p)=t)and(equiv(p)=e) then
+ begin assign_trace(p,"reassigning")@;@/
+ eq_destroy(new_eqtb(p)); return;
+ end;
+assign_trace(p,"changing")@;@/
+if eq_level(p)=cur_level then eq_destroy(new_eqtb(p))
+@z
+%---------------------------------------
+@x [19] m.277 l.5970 eq_define - e-TeX tracing
+end;
+@y
+assign_trace(p,"into")@;@/
+exit:end;
+@z
+%---------------------------------------
+@x [19] m.278 l.5977 eq_word_define - e-TeX tracing
+begin if xeq_level(p)<>cur_level then
+@y
+label exit;
+begin if eTeX_ex and(eqtb[p].int=w) then
+ begin assign_trace(p,"reassigning")@;@/
+ return;
+ end;
+assign_trace(p,"changing")@;@/
+if xeq_level(p)<>cur_level then
+@z
+%---------------------------------------
+@x [19] m.278 l.5981 eq_word_define - e-TeX tracing
+end;
+@y
+assign_trace(p,"into")@;@/
+exit:end;
+@z
+%---------------------------------------
+@x [19] m.279 l.5990 geq_define - e-TeX tracing
+begin eq_destroy(new_eqtb(p));
+set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e);
+@y
+begin assign_trace(p,"globally changing")@;@/
+begin eq_destroy(new_eqtb(p));
+set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e);
+end;
+assign_trace(p,"into")@;@/
+@z
+%---------------------------------------
+@x [19] m.279 l.5995 geq_word_define - e-TeX tracing
+begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one);
+@y
+begin assign_trace(p,"globally changing")@;@/
+begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one);
+end;
+assign_trace(p,"into")@;@/
+@z
+%---------------------------------------
+@x [19] m.281 l.6012 - e-TeX tracing
+@p@t\4@>@<Declare the procedure called |restore_trace|@>@;@/
+@y
+@p
+@z
+%---------------------------------------
+@x [19] m.281 l.6019 unsave - e-TeX optimized \aftergroup
+begin if cur_level>level_one then
+@y
+@!a:boolean; {have we already processed an \.{\\aftergroup} ?}
+begin a:=false;
+if cur_level>level_one then
+@z
+%---------------------------------------
+% FIXME restore_sa usage
+@x [19] m.282 l.6033 - e-TeX sparse arrays
+ else begin if save_type(save_ptr)=restore_old_value then
+@y
+ else if save_type(save_ptr)=restore_sa then
+ begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr);
+ end
+ else begin if save_type(save_ptr)=restore_old_value then
+@z
+%---------------------------------------
+@x [19] m.282 l.6041 - e-TeX tracing
+done: cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr)
+@y
+done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/
+if grp_stack[in_open]=cur_boundary then group_warning;
+ {groups possibly not properly nested with files}
+cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr);
+if eTeX_ex then decr(save_ptr)
+@z
+%---------------------------------------
+@x [19] m.284 l.6067 - e-TeX tracing
+@ @<Declare the procedure called |restore_trace|@>=
+@y
+@ @<Declare \eTeX\ procedures for tr...@>=
+@z
+%---------------------------------------
+@x [20] m.289 l.6155 - e-TeX protected
+@d end_match_token=@"E0000 {$2^16\cdot|end_match|$}
+@y
+@d end_match_token=@"E0000 {$2^16\cdot|end_match|$}
+@d protected_token=@"E0001 {$2^16\cdot|end_match|+1$}
+@z
+%---------------------------------------
+@x [20] m.294 l.6280 - e-TeX protected
+end_match: print("->");
+@y
+end_match: if c=0 then print("->");
+@z
+%---------------------------------------
+@x [20] m.296 l.6301 print_meaning - e-TeX marks
+else if cur_cmd=top_bot_mark then
+@y
+else if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then
+@z
+%---------------------------------------
+@x [21] m.298 l.6375 print_cmd_chr - e-TeX protected
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@y
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+var n:integer; {temp variable}
+@z
+%---------------------------------------
+@x [21] m.299 l.6394 show_cur_cmd_chr - e-TeX tracing
+@p procedure show_cur_cmd_chr;
+@y
+@p procedure show_cur_cmd_chr;
+var n:integer; {level of \.{\\if...\\fi} nesting}
+@!l:integer; {line where \.{\\if} started}
+@!p:pointer;
+@z
+%---------------------------------------
+@x [21] m.299 l.6399 show_cur_cmd_chr - e-TeX tracing
+print_cmd_chr(cur_cmd,cur_chr); print_char("}");
+@y
+print_cmd_chr(cur_cmd,cur_chr);
+if tracing_ifs>0 then
+ if cur_cmd>=if_test then if cur_cmd<=fi_or_else then
+ begin print(": ");
+ if cur_cmd=fi_or_else then
+ begin print_cmd_chr(if_test,cur_if); print_char(" ");
+ n:=0; l:=if_line;
+ end
+ else begin n:=1; l:=line;
+ end;
+ p:=cond_ptr;
+ while p<>null do
+ begin incr(n); p:=link(p);
+ end;
+ print("(level "); print_int(n); print_char(")"); print_if_line(l);
+ end;
+print_char("}");
+@z
+%---------------------------------------
+% FIXME: What about \write18 compatibility?
+@x [22] m.303 l.6475 show_context - e-TeX scan_tokens
+the terminal, under control of the procedure |read_toks|.)
+@y
+the terminal, under control of the procedure |read_toks|.)
+Finally |18<=name<=19| indicates that we are reading a pseudo file
+created by the \.{\\scantokens} command.
+@z
+%---------------------------------------
+@x [22] m.307 l.6692 - e-TeX basic
+@d mark_text=14 {|token_type| code for \.{\\topmark}, etc.}
+@d write_text=15 {|token_type| code for \.{\\write}}
+@y
+@d every_eof_text=14 {|token_type| code for \.{\\everyeof}}
+@d mark_text=15 {|token_type| code for \.{\\topmark}, etc.}
+@d write_text=16 {|token_type| code for \.{\\write}}
+@z
+%---------------------------------------
+@x [22] m.311 l.6749 show_context - e-TeX scan_tokens
+ if (name>17) or (base_ptr=0) then bottom_line:=true;
+@y
+ if (name>19) or (base_ptr=0) then bottom_line:=true;
+@z
+%---------------------------------------
+@x [22] m.313 l.6794 - e-TeX scan_tokens
+else begin print_nl("l."); print_int(line);
+@y
+else if index<>in_open then {input from a pseudo file}
+ begin print_nl("l."); print_int(line_stack[index+1]);
+ end
+else begin print_nl("l."); print_int(line);
+@z
+%---------------------------------------
+@x [22] m.314 l.6814 - e-TeX basic
+every_cr_text: print_nl("<everycr> ");
+@y
+every_cr_text: print_nl("<everycr> ");
+every_eof_text: print_nl("<everyeof> ");
+@z
+%---------------------------------------
+@x [23] m.326 l.7009 - e-TeX optimized \aftergroup
+begin t:=cur_tok; cur_tok:=p; back_input; cur_tok:=t;
+@y
+begin t:=cur_tok; cur_tok:=p;
+if a then
+ begin p:=get_avail; info(p):=cur_tok; link(p):=loc; loc:=p; start:=p;
+ if cur_tok<right_brace_limit then
+ if cur_tok<left_brace_limit then decr(align_state)
+ else incr(align_state);
+ end
+else begin back_input; a:=eTeX_ex;
+ end;
+cur_tok:=t;
+@z
+%---------------------------------------
+@x [23] m.328 l.7037 begin_file_reading - e-TeX every_eof, tracing_nesting
+incr(in_open); push_input; index:=in_open;
+@y
+incr(in_open); push_input; index:=in_open;
+eof_seen[index]:=false;
+grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr;
+@z
+%---------------------------------------
+% FIXME: What about \write18 compatibility?
+@x [23] m.329 l.7047 end_file_reading - e-TeX scan_tokens
+if name>17 then a_close(cur_file); {forget it}
+@y
+if (name=18)or(name=19) then pseudo_close else
+if name>17 then a_close(cur_file); {forget it}
+@z
+%---------------------------------------
+@x [23] m.331 l.7066 - e-TeX tracing_nesting
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+@y
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+grp_stack[0]:=0; if_stack[0]:=null;
+@z
+%---------------------------------------
+@x [24] m.362 l.7538 - e-TeX scan_tokens, every_eof
+if not force_eof then
+@y
+if not force_eof then
+ if name<=19 then
+ begin if pseudo_input then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+ end
+ else
+@z
+%---------------------------------------
+@x [24] m.362 l.7541 - e-TeX every_eof
+ else force_eof:=true;
+@y
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+@z
+%---------------------------------------
+@x [24] m.362 l.7544 - e-TeX scan_tokens
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+@y
+ begin if tracing_nesting>0 then
+ if (grp_stack[in_open]<>cur_boundary)or@|
+ (if_stack[in_open]<>cond_ptr) then file_warning;
+ {give warning for some unfinished groups and/or conditionals}
+ if name>=19 then
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ end;
+@z
+%---------------------------------------
+@x [25] m.366 l.7630 - e-TeX basic
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+@y
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/
+@z
+%---------------------------------------
+@x [25] m.366 l.7637 expand - e-TeX cond
+procedure expand;
+@y
+procedure expand;
+label reswitch;
+@z
+%---------------------------------------
+@x [25] m.366 l.7648 expand - e-TeX cond
+if cur_cmd<call then @<Expand a nonmacro@>
+@y
+reswitch:
+if cur_cmd<call then @<Expand a nonmacro@>
+@z
+%---------------------------------------
+@x [25] m.367 l.7659 - e-TeX cond
+expand_after:@<Expand the token after the next token@>;
+@y
+expand_after:if cur_chr=0 then @<Expand the token after the next token@>
+ else @<Negate a boolean conditional and |goto reswitch|@>;
+@z
+%---------------------------------------
+@x [25] m.377 l.7779 - e-TeX scan_tokens
+input: if chr_code=0 then print_esc("input")@+else print_esc("endinput");
+@y
+input: if chr_code=0 then print_esc("input")
+ @/@<Cases of |input| for |print_cmd_chr|@>@/
+ else print_esc("endinput");
+@z
+%---------------------------------------
+@x [25] m.378 l.7782 - e-TeX scan_tokens
+if cur_chr>0 then force_eof:=true
+@y
+if cur_chr=1 then force_eof:=true
+@/@<Cases for |input|@>@/
+@z
+%---------------------------------------
+@x [25] m.382 l.7838 - e-TeX marks
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@y
+@d marks_code==5 {add this for \.{\\topmarks} etc.}
+@#
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@z
+%---------------------------------------
+@x [25] m.385 l.7870 - e-TeX marks
+top_bot_mark: case chr_code of
+@y
+top_bot_mark: begin case (chr_code mod marks_code) of
+@z
+%---------------------------------------
+@x [25] m.385 l.7876 - e-TeX marks
+ endcases;
+@y
+ endcases;
+ if chr_code>=marks_code then print_char("s");
+ end;
+@z
+%---------------------------------------
+@x [25] m.386 l.7882 - e-TeX marks
+begin if cur_mark[cur_chr]<>null then
+ begin_token_list(cur_mark[cur_chr],mark_text);
+@y
+begin t:=cur_chr mod marks_code;
+if cur_chr>=marks_code then scan_register_num@+else cur_val:=0;
+if cur_val=0 then cur_ptr:=cur_mark[t]
+else @<Compute the mark pointer for mark type |t| and class |cur_val|@>;
+if cur_ptr<>null then begin_token_list(cur_ptr,mark_text);
+@z
+%---------------------------------------
+@x [25] m.389 l.7945 macro_call - e-TeX protected
+if info(r)<>end_match_token then
+@y
+if info(r)=protected_token then r:=link(r);
+if info(r)<>end_match_token then
+@z
+%---------------------------------------
+@x [26] m.409 l.8255 - e-TeX basic
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@y
+@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@;
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@z
+%---------------------------------------
+@x [26] m.411 l.8299 - e-TeX sparse arrays
+|glue_val|, or |mu_val|.
+@y
+|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes
+cannot have these values)
+@z
+%---------------------------------------
+@x [26] m.411 l.8302 - e-TeX sparse arrays
+primitive("count",register,int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mu_val);
+@y
+primitive("count",register,mem_bot+int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,mem_bot+dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,mem_bot+glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mem_bot+mu_val);
+@z
+%---------------------------------------
+@x [26] m.412 l.8312 - e-TeX sparse arrays
+register: if chr_code=int_val then print_esc("count")
+ else if chr_code=dimen_val then print_esc("dimen")
+ else if chr_code=glue_val then print_esc("skip")
+ else print_esc("muskip");
+@y
+register: @<Cases of |register| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [26] m.413 l.8328 scan_something_internal - e-TeX basic
+var m:halfword; {|chr_code| part of the operand token}
+@y
+label exit;
+var m:halfword; {|chr_code| part of the operand token}
+@!q:halfword; {general purpose index}
+@!i:four_quarters; {character info}
+@z
+%---------------------------------------
+@x [26] m.413 l.8354 scan_something_internal - e-TeX basic
+end;
+@y
+exit:end;
+@z
+%---------------------------------------
+@x [26] m.415 l.8375 - e-TeX sparse arrays
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+@y
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else cur_val:=equiv(m);
+ cur_val_level:=tok_val;
+@z
+%---------------------------------------
+@x [26] m.416 l.8390 - e-TeX basic
+|glue_val|, |input_line_no_code|, or |badness_code|.
+
+@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@y
+|glue_val|, |last_node_type_code|, |input_line_no_code|, |badness_code|,
+|eTeX_version_code|, or one of the other codes for \eTeX\ extensions.
+
+@d last_node_type_code=glue_val+1 {code for \.{\\lastnodetype}}
+@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+3 {code for \.{\\badness}}
+@d eTeX_int=glue_val+4 {first of \eTeX\ codes for integers}
+@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions}
+@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue}
+@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue}
+@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions}
+@z
+%---------------------------------------
+@x [26] m.417 l.8425 - e-TeX interaction_mode
+@+else print_esc("insertpenalties");
+@y
+@/@<Cases of |set_page_int| for |print_cmd_chr|@>@/
+@+else print_esc("insertpenalties");
+@z
+%---------------------------------------
+@x [26] m.417 l.8434 - e-TeX basic
+ othercases print_esc("badness")
+@y
+ @/@<Cases of |last_item| for |print_cmd_chr|@>@/
+ othercases print_esc("badness")
+@z
+%---------------------------------------
+@x [26] m.419 l.8457 - e-TeX interaction_mode
+begin if m=0 then cur_val:=dead_cycles@+else cur_val:=insert_penalties;
+@y
+begin if m=0 then cur_val:=dead_cycles
+@/@<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>@/
+else cur_val:=insert_penalties;
+@z
+%---------------------------------------
+@x [26] m.420 l.8462 - e-TeX sparse arrays
+begin
+ scan_eight_bit_int;
+ if box(cur_val)=null then cur_val:=0 @+else
+ cur_val:=mem[box(cur_val)+m].sc;
+@y
+begin
+ scan_register_num;
+ fetch_box(q);
+ if q=null then cur_val:=0 @+else
+ cur_val:=mem[q+m].sc;
+@z
+%---------------------------------------
+@x [26] m.423 l.8487 - e-TeX penalties
+begin if par_shape_ptr=null then cur_val:=0
+@y
+begin if m>par_shape_loc then @<Fetch a penalties array element@>
+else if par_shape_ptr=null then cur_val:=0
+@z
+%---------------------------------------
+% @x [26] m.424 l.8493 - e-TeX TeXXeT
+% implemented. The reference count for \.{\\lastskip} will be updated later.
+% @y
+% implemented. The reference count for \.{\\lastskip} will be updated later.
+% A final \.{\\endM} node is temporarily removed.
+% @z
+%---------------------------------------
+@x [26] m.424 l.8499 - e-TeX basic
+if cur_chr>glue_val then
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+@y
+if m>last_node_type_code then
+ if m>=eTeX_glue then @<Process an expression and |return|@>@;
+ else if m>=eTeX_dim then
+ begin case m of
+ @/@<Cases for fetching a dimension value@>@/
+ end; {there are no other cases}
+ cur_val_level:=dimen_val;
+ end
+ else begin case m of
+ input_line_no_code: cur_val:=line;
+ badness_code: cur_val:=last_badness;
+ @/@<Cases for fetching an integer value@>@/
+ end; {there are no other cases}
+@z
+%---------------------------------------
+@x [26] m.424 l.8505 - e-TeX last_node_type
+ cur_val_level:=cur_chr;
+@y
+ if cur_chr=last_node_type_code then
+ begin cur_val:=int_val;
+ if (tail=head)or(mode=0) then cur_val:=-1;
+ end
+ else cur_val_level:=cur_chr;
+@z
+%---------------------------------------
+% @x [26] m.424 l.8507 - e-TeX TeXXeT
+% case cur_chr of
+% @y
+% begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+% remove_end_M;
+% case cur_chr of
+% @z
+%---------------------------------------
+@x [26] m.424 l.8513 - e-TeX last_node_type
+ end;
+@y
+ end;
+ last_node_type_code:
+ if (type(tail)<>math_node)or(subtype(tail)<>end_M_code) then
+ if type(tail)<=unset_node then cur_val:=type(tail)+1
+ else cur_val:=unset_node+2;
+@z
+%---------------------------------------
+% @x [26] m.424 l.8514 - e-TeX TeXXeT
+% end {there are no other cases}
+% @y
+% end; {there are no other cases}
+% if LR_temp<>null then insert_end_M;
+% end
+% @z
+%---------------------------------------
+@x [26] m.424 l.8519 - e-TeX last_node_type
+ glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+@y
+ glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+ last_node_type_code: cur_val:=last_node_type;
+@z
+%---------------------------------------
+% FIXME might need work
+@x [26] m.427 l.8535 - e-TeX sparse arrays
+begin scan_eight_bit_int;
+case m of
+@y
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+@z
+%---------------------------------------
+@x [26] m.427 l.8542 - e-TeX sparse arrays
+cur_val_level:=m;
+@y
+ end;
+@z
+%---------------------------------------
+@x [26] m.461 l.9070 - e-TeX expr
+exit:end;
+@y
+exit:end;
+@#
+@<Declare procedures needed for expressions@>@;
+@z
+%---------------------------------------
+@x [27] m.464 l.9129 - e-TeX basic
+@p function str_toks(@!b:pool_pointer):pointer;
+@y
+@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
+function str_toks(@!b:pool_pointer):pointer;
+@z
+%---------------------------------------
+@x [27] m.465 l.9154 the_toks - e-TeX unexpanded
+@p function the_toks:pointer;
+@y
+@p function the_toks:pointer;
+label exit;
+@z
+%---------------------------------------
+@x [27] m.465 l.9158 the_toks - e-TeX unexpanded
+begin get_x_token; scan_something_internal(tok_val,false);
+@y
+@!c:small_number; {value of |cur_chr|}
+begin @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>;@/
+get_x_token; scan_something_internal(tok_val,false);
+@z
+%---------------------------------------
+@x [27] m.465 l.9172 the_toks - e-TeX unexpanded
+end;
+@y
+exit:end;
+@z
+%---------------------------------------
+@x [27] m.469 l.9223 - e-TeX basic
+ othercases print_esc("jobname")
+@y
+ @/@<Cases of |convert| for |print_cmd_chr|@>@/
+ othercases print_esc("jobname")
+@z
+%---------------------------------------
+@x [27] m.470 l.9232 conv_toks - e-TeX basic
+@!c:number_code..job_name_code; {desired type of conversion}
+@y
+@!c:small_number; {desired type of conversion}
+@z
+%---------------------------------------
+@x [27] m.471 l.9249 - e-TeX basic
+end {there are no other cases}
+@y
+@/@<Cases of `Scan the argument for command |c|'@>@/
+end {there are no other cases}
+@z
+%---------------------------------------
+@x [27] m.472 l.9265 - e-TeX basic
+end {there are no other cases}
+@y
+@/@<Cases of `Print the result of command |c|'@>@/
+end {there are no other cases}
+@z
+%---------------------------------------
+@x [27] m.478 l.9374 - e-TeX protected
+ if cur_cmd<=max_command then goto done2;
+@y
+ if cur_cmd>=call then
+ if info(link(cur_chr))=protected_token then
+ begin cur_cmd:=relax; cur_chr:=no_expand_flag;
+ end;
+ if cur_cmd<=max_command then goto done2;
+@z
+%---------------------------------------
+@x [27] m.482 l.9422 read_toks - e-TeX read_line
+@p procedure read_toks(@!n:integer;@!r:pointer);
+@y
+@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword);
+@z
+%---------------------------------------
+@x [27] m.483 l.9448 - e-TeX read_line
+loop@+ begin get_token;
+@y
+@<Handle \.{\\readline} and |goto done|@>;@/
+loop@+ begin get_token;
+@z
+%---------------------------------------
+@x [28] m.487 l.9500 - e-TeX cond
+@d if_char_code=0 { `\.{\\if}' }
+@y
+@d unless_code=32 {amount added for `\.{\\unless}' prefix}
+@#
+@d if_char_code=0 { `\.{\\if}' }
+@z
+%---------------------------------------
+@x [28] m.488 l.9555 - e-TeX cond
+if_test: case chr_code of
+@y
+if_test: begin if chr_code>=unless_code then print_esc("unless");
+case chr_code mod unless_code of
+@z
+%---------------------------------------
+@x [28] m.488 l.9572 - e-TeX cond
+ othercases print_esc("if")
+ endcases;
+@y
+ @/@<Cases of |if_test| for |print_cmd_chr|@>@/
+ othercases print_esc("if")
+ endcases;
+end;
+@z
+%---------------------------------------
+@x [28] m.494 l.9646 pass_text - e-TeX tracing
+done: scanner_status:=save_scanner_status;
+@y
+done: scanner_status:=save_scanner_status;
+if tracing_ifs>0 then show_cur_cmd_chr;
+@z
+%---------------------------------------
+@x [28] m.496 l.9662 - e-TeX tracing_nesting
+begin p:=cond_ptr; if_line:=if_line_field(p);
+@y
+begin if if_stack[in_open]=cond_ptr then if_warning;
+ {conditionals possibly not properly nested with files}
+p:=cond_ptr; if_line:=if_line_field(p);
+@z
+%---------------------------------------
+@x [28] m.498 l.9699 conditional - e-TeX cond
+begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+@y
+@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?}
+begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
+is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+if is_unless then b:=not b;
+@z
+%---------------------------------------
+@x [28] m.501 l.9742 - e-TeX cond
+if_false_code: b:=false;
+@y
+if_false_code: b:=false;
+@/@<Cases for |conditional|@>@/
+@z
+%---------------------------------------
+@x [28] m.505 l.9781 - e-TeX sparse arrays
+begin scan_eight_bit_int; p:=box(cur_val);
+@y
+begin scan_register_num; fetch_box(p);
+@z
+%---------------------------------------
+@x [28] m.510 l.9871 - e-TeX cond
+if cur_chr>if_limit then
+@y
+begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+if cur_chr>if_limit then
+@z
+%---------------------------------------
+@x [28] m.510 l.9882 - e-TeX cond
+ end
+@y
+ end;
+end
+@z
+%---------------------------------------
+@x [29] m.536 l.10324 - e-TeX basic
+begin wlog(banner);
+@y
+begin wlog(eTeX_banner);
+@z
+%---------------------------------------
+@x [29] m.536 l.10331 - e-TeX basic
+end
+@y
+if eTeX_ex then
+ begin; wlog_cr; wlog('entering extended mode');
+ end;
+end
+@z
+%---------------------------------------
+@x [30] m.581 l.11263 char_warning - e-TeX tracing
+begin if tracing_lost_chars>0 then
+@y
+var old_setting: integer; {saved value of |tracing_online|}
+begin if tracing_lost_chars>0 then
+ begin old_setting:=tracing_online;
+ if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+@z
+%---------------------------------------
+@x [30] m.581 l.11270 char_warning - e-TeX tracing
+end;
+@y
+ tracing_online:=old_setting;
+ end;
+end;
+@z
+%---------------------------------------
+% @x [32] m.616 l.12238 - e-TeX TeXXeT
+% this is essentially the depth of |push| commands in the \.{DVI} output.
+% @y
+% this is essentially the depth of |push| commands in the \.{DVI} output.
+%
+% For mixed direction text (\TeXXeT) the current text direction is called
+% |cur_dir|. As the box being shipped out will never be used again and
+% soon be recycled, we can simply reverse any R-text (i.e., right-to-left)
+% segments of hlist nodes as well as complete hlist nodes embedded in such
+% segments. Moreover this can be done iteratively rather than recursively.
+% There are, however, two complications related to leaders that require
+% some additional bookkeeping: (1)~One and the same hlist node might be
+% used more than once (but never inside both L- and R-text); and
+% (2)~leader boxes inside hlists must be aligned with respect to the left
+% edge of the original hlist.
+%
+% A math node is changed into a kern node whenever the text direction
+% remains the same, it is replaced by an |edge_node| if the text direction
+% changes; the subtype of an an |hlist_node| inside R-text is changed to
+% |reversed| once its hlist has been reversed.
+% @!@^data structure assumptions@>
+% @z
+%---------------------------------------
+% @x [32] m.616 l.12240 - e-TeX TeXXeT
+% @d synch_h==if cur_h<>dvi_h then
+% @y
+% @d reversed=min_quarterword+1 {subtype for an |hlist_node| whose hlist
+% has been reversed}
+% @d dlist=min_quarterword+2 {subtype for an |hlist_node| from display math mode}
+% @d left_to_right=0
+% @d right_to_left=1
+% @d reflected==1-cur_dir {the opposite of |cur_dir|}
+% @#
+% @d synch_h==if cur_h<>dvi_h then
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12300 hlist_out - e-TeX add_glue
+% @!g_order: glue_ord; {applicable order of infinity for glue}
+% @y
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12308 hlist_out - e-TeX TeXXeT
+% @!edge:scaled; {left edge of sub-box, or right edge of leader space}
+% @y
+% @!edge:scaled; {right edge of sub-box or leader space}
+% @!prev_p:pointer; {one step behind |p|}
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12309 hlist_out - e-TeX add_glue
+% @!glue_temp:real; {glue value before rounding}
+% begin this_box:=temp_ptr; g_order:=glue_order(this_box);
+% @y
+% begin this_box:=temp_ptr;
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12315 hlist_out - e-TeX TeXXeT
+% save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+% @y
+% save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v;
+% prev_p:=this_box+list_offset;
+% if eTeX_ex then
+% begin @<Initialize the LR stack@>;
+% if subtype(this_box)=dlist then
+% if cur_dir=right_to_left then
+% begin cur_dir:=left_to_right; cur_h:=cur_h-width(this_box);
+% end
+% else subtype(this_box):=min_quarterword;
+% if (cur_dir=right_to_left)and(subtype(this_box)<>reversed) then
+% @<Reverse the complete hlist and set the subtype to |reversed|@>;
+% end;
+% left_edge:=cur_h;
+% @z
+%---------------------------------------
+% @x [32] m.619 l.12318 hlist_out - e-TeX TeXXeT
+% prune_movements(save_loc);
+% @y
+% if eTeX_ex then
+% begin @<Check for LR anomalies at the end of |hlist_out|@>;
+% if subtype(this_box)=dlist then cur_dir:=right_to_left;
+% end;
+% prune_movements(save_loc);
+% @z
+%---------------------------------------
+% @x [32] m.620 l.12337 - e-TeX TeXXeT
+% p:=link(p);
+% @y
+% prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|}
+% p:=link(p);
+% @z
+%---------------------------------------
+% @x [32] m.622 l.12362 - e-TeX TeXXeT
+% kern_node,math_node:cur_h:=cur_h+width(p);
+% @y
+% kern_node:cur_h:=cur_h+width(p);
+% math_node:begin if eTeX_ex then
+% @<Adjust \(t)the LR stack for the |hlist_out| routine; if necessary
+% reverse an hlist segment and |goto reswitch|@>;
+% cur_h:=cur_h+width(p);
+% end;
+% @z
+%---------------------------------------
+% @x [32] m.622 l.12364 - e-TeX TeXXeT
+% othercases do_nothing
+% @y
+% @/@<Cases of |hlist_out| that arise in mixed direction text only@>@;
+% othercases do_nothing
+% @z
+%---------------------------------------
+% @x [32] m.622 l.12369 - e-TeX TeXXeT
+% next_p:p:=link(p);
+% @y
+% next_p:prev_p:=p; p:=link(p);
+% @z
+%---------------------------------------
+% @x [32] m.623 l.12376 - e-TeX TeXXeT
+% temp_ptr:=p; edge:=cur_h;
+% @y
+% temp_ptr:=p; edge:=cur_h+width(p);
+% if cur_dir=right_to_left then cur_h:=edge;
+% @z
+%---------------------------------------
+% @x [32] m.623 l.12379 - e-TeX TeXXeT
+% cur_h:=edge+width(p); cur_v:=base_line;
+% @y
+% cur_h:=edge; cur_v:=base_line;
+% @z
+%---------------------------------------
+% @x [32] m.625 l.12401 - e-TeX add_glue
+% begin if g_sign=stretching then
+% begin if stretch_order(g)=g_order then
+% begin vet_glue(float(glue_set(this_box))*stretch(g));
+% @^real multiplication@>
+% rule_wd:=rule_wd+round(glue_temp);
+% end;
+% end
+% else if shrink_order(g)=g_order then
+% begin vet_glue(float(glue_set(this_box))*shrink(g));
+% rule_wd:=rule_wd-round(glue_temp);
+% end;
+% end;
+% @y
+% add_glue(rule_wd);
+% @z
+%---------------------------------------
+% @x [32] m.626 l.12428 - e-TeX TeXXeT
+% edge:=cur_h+rule_wd; lx:=0;
+% @y
+% if cur_dir=right_to_left then cur_h:=cur_h-10;
+% edge:=cur_h+rule_wd; lx:=0;
+% @z
+%---------------------------------------
+% @x [32] m.626 l.12434 - e-TeX TeXXeT
+% cur_h:=edge-10; goto next_p;
+% @y
+% if cur_dir=right_to_left then cur_h:=edge
+% else cur_h:=edge-10;
+% goto next_p;
+% @z
+%---------------------------------------
+% @x [32] m.628 l.12473 - e-TeX TeXXeT
+% synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+% @y
+% synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+% if cur_dir=right_to_left then cur_h:=cur_h+leader_wd;
+% @z
+%---------------------------------------
+% @x [32] m.629 l.12489 vlist_out - e-TeX add_glue
+% @!g_order: glue_ord; {applicable order of infinity for glue}
+% @y
+% @z
+%---------------------------------------
+% @x [32] m.629 l.12498 vlist_out - e-TeX add_glue
+% @!glue_temp:real; {glue value before rounding}
+% begin this_box:=temp_ptr; g_order:=glue_order(this_box);
+% @y
+% begin this_box:=temp_ptr;
+% @z
+%---------------------------------------
+% @x [32] m.632 l.12544 - e-TeX TeXXeT
+% cur_h:=left_edge+shift_amount(p); {shift the box right}
+% @y
+% if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p)
+% else cur_h:=left_edge+shift_amount(p); {shift the box right}
+% @z
+%---------------------------------------
+% @x [32] m.633 l.12556 - e-TeX TeXXeT
+% begin synch_h; synch_v;
+% dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+% @y
+% begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
+% synch_h; synch_v;
+% dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+% cur_h:=left_edge;
+% @z
+%---------------------------------------
+% @x [32] m.634 l.12564 - e-TeX add_glue
+% begin if g_sign=stretching then
+% begin if stretch_order(g)=g_order then
+% begin vet_glue(float(glue_set(this_box))*stretch(g));
+% @^real multiplication@>
+% rule_ht:=rule_ht+round(glue_temp);
+% end;
+% end
+% else if shrink_order(g)=g_order then
+% begin vet_glue(float(glue_set(this_box))*shrink(g));
+% rule_ht:=rule_ht-round(glue_temp);
+% end;
+% end;
+% @y
+% add_glue(rule_ht);
+% @z
+%---------------------------------------
+% @x [32] m.637 l.12619 - e-TeX TeXXeT
+% begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/
+% @y
+% begin if cur_dir=right_to_left then
+% cur_h:=left_edge-shift_amount(leader_box)
+% else cur_h:=left_edge+shift_amount(leader_box);
+% synch_h; save_h:=dvi_h;@/
+% @z
+%---------------------------------------
+% @x [32] m.638 l.12656 ship_out - e-TeX TeXXeT
+% @<Ship box |p| out@>;
+% @y
+% @<Ship box |p| out@>;
+% if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>;
+% @z
+%---------------------------------------
+% @x [33] m.649 l.12876 hpack - e-TeX TeXXeT
+% h:=0; @<Clear dimensions to zero@>;
+% @y
+% h:=0; @<Clear dimensions to zero@>;
+% if TeXXeT_en then @<Initialize the LR stack@>;
+% @z
+%---------------------------------------
+% @x [33] m.649 l.12886 hpack - e-TeX TeXXeT
+% exit: hpack:=r;
+% @y
+% exit: if TeXXeT_en then @<Check for LR anomalies at the end of |hpack|@>;
+% hpack:=r;
+% @z
+%---------------------------------------
+% @x [33] m.651 l.12910 - e-TeX TeXXeT
+% kern_node,math_node: x:=x+width(p);
+% @y
+% kern_node: x:=x+width(p);
+% math_node: begin x:=x+width(p);
+% if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>;
+% end;
+% @z
+%---------------------------------------
+@x [34] m.687 l.13480 - e-TeX middle
+\TeX's \.{\\left} and \.{\\right}. The |nucleus| of such noads is
+@y
+\TeX's \.{\\left} and \.{\\right} as well as \eTeX's \.{\\middle}.
+The |nucleus| of such noads is
+@z
+%---------------------------------------
+@x [34] m.687 l.13497 - e-TeX middle
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@y
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@d middle_noad==1 {|subtype| of right noad representing \.{\\middle}}
+@z
+%---------------------------------------
+@x [34] m.696 l.13670 - e-TeX middle
+right_noad: begin print_esc("right"); print_delimiter(nucleus(p));
+ end;
+end;
+if subtype(p)<>normal then
+ if subtype(p)=limits then print_esc("limits")
+ else print_esc("nolimits");
+if type(p)<left_noad then print_subsidiary_data(nucleus(p),".");
+@y
+right_noad: begin if subtype(p)=normal then print_esc("right")
+ else print_esc("middle");
+ print_delimiter(nucleus(p));
+ end;
+end;
+if type(p)<left_noad then
+ begin if subtype(p)<>normal then
+ if subtype(p)=limits then print_esc("limits")
+ else print_esc("nolimits");
+ print_subsidiary_data(nucleus(p),".");
+ end;
+@z
+%---------------------------------------
+@x [36] m.727 l.14268 - e-TeX middle
+done_with_noad: r:=q; r_type:=type(r);
+@y
+done_with_noad: r:=q; r_type:=type(r);
+if r_type=right_noad then
+ begin r_type:=left_noad; cur_style:=style; @<Set up the values...@>;
+ end;
+@z
+%---------------------------------------
+@x [36] m.760 l.14929 - e-TeX middle
+ r_type:=t;
+@y
+ if type(q)=right_noad then t:=open_noad;
+ r_type:=t;
+@z
+%---------------------------------------
+@x [36] m.762 l.14970 make_left_right - e-TeX middle
+begin if style<script_style then cur_size:=text_size
+else cur_size:=script_size*((style-text_style) div 2);
+@y
+begin cur_style:=style; @<Set up the values...@>;
+@z
+%---------------------------------------
+@x [37] m.785 l.15461 align_peek - e-TeX protected
+begin restart: align_state:=1000000; @<Get the next non-blank non-call token@>;
+@y
+begin restart: align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+@z
+%---------------------------------------
+@x [37] m.791 l.15572 fin_col - e-TeX protected
+align_state:=1000000; @<Get the next non-blank non-call token@>;
+@y
+align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+@z
+%---------------------------------------
+% @x [37] m.807 l.15834 - e-TeX TeXXeT
+% begin type(q):=hlist_node; width(q):=width(p);
+% @y
+% begin type(q):=hlist_node; width(q):=width(p);
+% if nest[nest_ptr-1].mode_field=mmode then subtype(q):=dlist; {for |ship_out|}
+% @z
+%---------------------------------------
+% @x [37] m.808 l.15852 - e-TeX TeXXeT
+% n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+% @y
+% n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+% subtype(r):=min_quarterword; {for |ship_out|}
+% @z
+%---------------------------------------
+@x [38] m.814 l.15975 - e-TeX penalties
+There is one explicit parameter: |final_widow_penalty| is the amount of
+additional penalty to be inserted before the final line of the paragraph.
+@y
+There is one explicit parameter: |d| is true for partial paragraphs
+preceding display math mode; in this case the amount of additional
+penalty inserted before the final line is |display_widow_penalty|
+instead of |widow_penalty|.
+@z
+%---------------------------------------
+@x [38] m.815 l.16002 line_break - e-TeX penalties
+procedure line_break(@!final_widow_penalty:integer);
+@y
+procedure line_break(@!d:boolean);
+@z
+%---------------------------------------
+@x [38] m.815 l.16012 - e-TeX basic
+end;
+@y
+end;
+@#
+@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@>
+@z
+%---------------------------------------
+@x [38] m.816 l.16032 - e-TeX last_line_fit
+final_par_glue:=new_param_glue(par_fill_skip_code);
+link(tail):=final_par_glue;
+@y
+final_par_glue:=new_param_glue(par_fill_skip_code);
+link(tail):=final_par_glue;
+last_line_fill:=link(tail);
+@z
+%---------------------------------------
+@x [38] m.819 l.16097 - e-TeX last_line_fit
+@d active_node_size=3 {number of words in active nodes}
+@y
+@d active_node_size_normal=3 {number of words in normal active nodes}
+@z
+%---------------------------------------
+% FIXME might need fixes; TeX has 6 backgrounds
+% Omega has 7. Why the difference?
+@x [38] m.827 l.16260 - e-TeX last_line_fit
+background[7]:=shrink(q)+shrink(r);
+@y
+background[7]:=shrink(q)+shrink(r);
+@<Check for special treatment of last line of paragraph@>;
+@z
+%---------------------------------------
+@x [38] m.829 l.16311 try_break - e-TeX last_line_fit
+label exit,done,done1,continue,deactivate;
+@y
+label exit,done,done1,continue,deactivate,found,not_found;
+@z
+%---------------------------------------
+@x [38] m.845 l.16603 - e-TeX last_line_fit
+total_demerits(q):=minimal_demerits[fit_class];
+@y
+total_demerits(q):=minimal_demerits[fit_class];
+if do_last_line_fit then
+ @<Store \(a)additional data in the new active node@>;
+@z
+%---------------------------------------
+@x [38] m.846 l.16616 - e-TeX last_line_fit
+print(" t="); print_int(total_demerits(q));
+@y
+print(" t="); print_int(total_demerits(q));
+if do_last_line_fit then @<Print additional data in the new active node@>;
+@z
+%---------------------------------------
+@x [38] m.851 l.16715 - e-TeX last_line_fit
+if (b>inf_bad)or(pi=eject_penalty) then
+@y
+if do_last_line_fit then @<Adjust \(t)the additional data for last line@>;
+found:
+if (b>inf_bad)or(pi=eject_penalty) then
+@z
+%---------------------------------------
+@x [38] m.852 l.16739 - e-TeX last_line_fit
+ begin b:=0; fit_class:=decent_fit; {infinite stretch}
+@y
+ begin if do_last_line_fit then
+ begin if cur_p=null then {the last line of a paragraph}
+ @<Perform computations for last line and |goto found|@>;
+ shortfall:=0;
+ end;
+ b:=0; fit_class:=decent_fit; {infinite stretch}
+@z
+%---------------------------------------
+@x [38] m.855 l.16796 - e-TeX last_line_fit
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+@y
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+ if do_last_line_fit then
+ @<Store \(a)additional data for this feasible break@>;
+@z
+%---------------------------------------
+@x [39] m.863 l.16969 - e-TeX last_line_fit
+ end;@+tats@/
+@y
+ end;@+tats@/
+if do_last_line_fit then @<Adjust \(t)the final line of the paragraph@>;
+@z
+%---------------------------------------
+@x [39] m.864 l.16980 - e-TeX last_line_fit
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+@y
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+if do_last_line_fit then
+ @<Initialize additional fields of the first active node@>;
+@z
+%---------------------------------------
+% @x [39] m.866 l.17030 - e-TeX TeXXeT
+% math_node: begin auto_breaking:=(subtype(cur_p)=after); kern_break;
+% @y
+% math_node: begin if subtype(cur_p)<L_code then auto_breaking:=end_LR(cur_p);
+% kern_break;
+% @z
+%---------------------------------------
+@x [39] m.876 l.17192 - e-TeX penalties
+post_line_break(final_widow_penalty)
+@y
+post_line_break(d)
+@z
+%---------------------------------------
+@x [39] m.877 l.17206 post_line_break - e-TeX penalties
+procedure post_line_break(@!final_widow_penalty:integer);
+@y
+procedure post_line_break(@!d:boolean);
+@z
+%---------------------------------------
+% @x [39] m.877 l.17216 post_line_break - e-TeX TeXXeT
+% begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+% @y
+% @!LR_ptr:pointer; {stack of LR codes}
+% begin LR_ptr:=LR_save;
+% @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+% @z
+%---------------------------------------
+% @x [39] m.877 l.17229 post_line_break - e-TeX TeXXeT
+% prev_graf:=best_line-1;
+% @y
+% prev_graf:=best_line-1;
+% LR_save:=LR_ptr;
+% @z
+%---------------------------------------
+% @x [39] m.879 l.17259 - e-TeX TeXXeT
+% r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
+% @y
+% r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
+% if type(q)=math_node then if TeXXeT_en then
+% @<Adjust \(t)the LR stack for the |post_line_break| routine@>;
+% @z
+%---------------------------------------
+% @x [39] m.880 l.17276 - e-TeX TeXXeT
+% @<Modify the end of the line to reflect the nature of the break and to include
+% \.{\\rightskip}; also set the proper value of |disc_break|@>;
+% @y
+% if TeXXeT_en then
+% @<Insert LR nodes at the beginning of the current line and adjust
+% the LR stack based on LR nodes in this line@>;
+% @<Modify the end of the line to reflect the nature of the break and to include
+% \.{\\rightskip}; also set the proper value of |disc_break|@>;
+% if TeXXeT_en then @<Insert LR nodes at the end of the current line@>;
+% @z
+%---------------------------------------
+% @x [39] m.881 l.17299 - e-TeX TeXXeT
+% else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+% @y
+% else if type(q)=kern_node then width(q):=0
+% else if type(q)=math_node then
+% begin width(q):=0;
+% if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>;
+% end;
+% @z
+%---------------------------------------
+% FIXME possible conflict
+@x [39] m.890 l.17395 - e-TeX penalties
+ if passive_pen_inter(cur_p)<>0 then
+ pen:=passive_pen_inter(cur_p)
+ else pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+@y
+ q:=inter_line_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=penalty(q+r);
+ end
+ else begin
+ if passive_pen_inter(cur_p)<>0 then
+ pen:=passive_pen_inter(cur_p)
+ else pen:=inter_line_penalty;
+ end;
+ q:=club_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line-prev_graf;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if d then q:=display_widow_penalties_ptr
+ else q:=widow_penalties_ptr;
+ if q<>null then
+ begin r:=best_line-cur_line-1;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line+2=best_line then
+ if d then pen:=pen+display_widow_penalty
+ else pen:=pen+widow_penalty;
+@z
+%---------------------------------------
+@x [40] m.891 l.17460 - e-TeX hyph_codes
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+@y
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+set_hyph_index;
+@z
+%---------------------------------------
+@x [40] m.896 l.17529 - e-TeX hyph_codes
+ if lc_code(c)<>0 then
+ if (lc_code(c)=c)or(uc_hyph>0) then goto done2
+@y
+ set_lc_code(c);
+ if hc[0]<>0 then
+ if (hc[0]=c)or(uc_hyph>0) then goto done2
+@z
+%---------------------------------------
+@x [40] m.897 l.17546 - e-TeX hyph_codes
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+ if hn=63 then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=lc_code(c); hyf_bchar:=non_char;
+@y
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+ if hn=63 then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char;
+@z
+%---------------------------------------
+@x [40] m.898 l.17572 - e-TeX hyph_codes
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+ if j=63 then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=lc_code(c);@/
+@y
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+ if j=63 then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=hc[0];@/
+@z
+%---------------------------------------
+@x [42] m.934 l.18211 new_hyph_exceptions - e-TeX hyph_codes
+label reswitch, exit, found, not_found;
+@y
+label reswitch, exit, found, not_found, not_found1;
+@z
+%---------------------------------------
+@x [42] m.934 l.18221 new_hyph_exceptions - e-TeX hyph_codes
+set_cur_lang;
+@y
+set_cur_lang;
+@!init if trie_not_ready then
+ begin hyph_index:=0; goto not_found1;
+ end;
+tini@/
+set_hyph_index;
+not_found1:
+@z
+%---------------------------------------
+@x [42] m.937 l.18253 - e-TeX hyph_codes
+else begin if lc_code(cur_chr)=0 then
+@y
+else begin set_lc_code(cur_chr);
+ if hc[0]=0 then
+@z
+%---------------------------------------
+@x [42] m.937 l.18261 - e-TeX hyph_codes
+ begin incr(n); hc[n]:=lc_code(cur_chr);
+@y
+ begin incr(n); hc[n]:=hc[0];
+@z
+%---------------------------------------
+@x [43] m.952 l.18549 - e-TeX hyph_codes
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+@y
+hyph_root:=compress_trie(hyph_root);
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+@z
+%---------------------------------------
+@x [43] m.958 l.18637 - e-TeX hyph_codes
+if trie_root=0 then {no patterns were given}
+@y
+if trie_max=0 then {no patterns were given}
+@z
+%---------------------------------------
+@x [43] m.958 l.18641 - e-TeX hyph_codes
+else begin trie_fix(trie_root); {this fixes the non-holes in |trie|}
+@y
+else begin if hyph_root>0 then trie_fix(hyph_root);
+ if trie_root>0 then trie_fix(trie_root); {this fixes the non-holes in |trie|}
+@z
+%---------------------------------------
+@x [43] m.960 l.18684 new_patterns - e-TeX hyph_codes
+ brace@>;
+@y
+ brace@>;
+ if saving_hyph_codes>0 then
+ @<Store hyphenation codes for current language@>;
+@z
+%---------------------------------------
+@x [43] m.966 l.18791 init_trie - e-TeX hyph_codes
+@<Move the data into |trie|@>;
+@y
+if hyph_root<>0 then @<Pack all stored |hyph_codes|@>;
+@<Move the data into |trie|@>;
+@z
+%---------------------------------------
+@x [44] m.968 l.18807 - e-TeX saved_items
+whenever this is possible without backspacing.
+@y
+whenever this is possible without backspacing.
+
+When the second argument |s| is |false| the deleted nodes are destroyed,
+otherwise they are collected in a list starting at |split_disc|.
+@z
+%---------------------------------------
+@x [44] m.968 l.18814 prune_page_top - e-TeX saved_items
+@p function prune_page_top(@!p:pointer):pointer; {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q:pointer; {temporary variable for list manipulation}
+@y
+@p function prune_page_top(@!p:pointer;@!s:boolean):pointer;
+ {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q,@!r:pointer; {temporary variables for list manipulation}
+@z
+%---------------------------------------
+@x [44] m.968 l.18825 prune_page_top - e-TeX saved_items
+ link(prev_p):=p; flush_node_list(q);
+@y
+ link(prev_p):=p;
+ if s then
+ begin if split_disc=null then split_disc:=q@+else link(r):=q;
+ r:=q;
+ end
+ else flush_node_list(q);
+@z
+%---------------------------------------
+@x [44] m.977 l.18992 vsplit - e-TeX marks, sparse arrays
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+@y
+@p @t\4@>@<Declare the function called |do_marks|@>@;
+function vsplit(@!n:halfword; @!h:scaled):pointer;
+@z
+%---------------------------------------
+% FIXME incompatible?
+@x [44] m.977 l.18998 vsplit - e-TeX sparse arrays
+begin v:=box(n); vdir:=box_dir(v);
+@y
+begin cur_val:=n; fetch_box(v); vdir:=box_dir(v);
+@z
+%---------------------------------------
+% FIXME: how to detach this from sparse arrays?
+@x [44] m.977 l.18999 vsplit - e-TeX marks, saved_items
+if split_first_mark<>null then
+@y
+flush_node_list(split_disc); split_disc:=null;
+if sa_mark<>null then
+ if do_marks(vsplit_init,0,sa_mark) then sa_mark:=null;
+if split_first_mark<>null then
+@z
+%---------------------------------------
+@x [44] m.977 l.19007 vsplit - e-TeX saved_items
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+@y
+q:=prune_page_top(q,saving_vdiscards>0);
+p:=list_ptr(v); free_node(v,box_node_size);
+@z
+%---------------------------------------
+% FIXME might be incompatible?
+@x [44] m.977 l.19008 vsplit - e-TeX sparse arrays
+if q=null then set_equiv(box_base+n,null)
+ {the |eq_level| of the box stays the same}
+else set_equiv(box_base+n,vpack(q,natural));
+@y
+if q<>null then q:=vpack(q,natural);
+change_box(q); {the |eq_level| of the box stays the same}
+@z
+%---------------------------------------
+@x [44] m.979 l.19033 - e-TeX marks
+ if split_first_mark=null then
+@y
+ if mark_class(p)<>0 then @<Update the current marks for |vsplit|@>
+ else if split_first_mark=null then
+@z
+%---------------------------------------
+@x [45] m.982 l.19167 - e-TeX last_node_type
+The variables |last_penalty| and |last_kern| are similar. And
+@y
+The variables |last_penalty|, |last_kern|, and |last_node_type|
+are similar. And
+@z
+%---------------------------------------
+@x [45] m.982 l.19180 - e-TeX last_node_type
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@y
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@!last_node_type:integer; {used to implement \.{\\lastnodetype}}
+@z
+%---------------------------------------
+@x [45] m.991 l.19317 - e-TeX last_node_type
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+@y
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+last_node_type:=-1;
+@z
+%---------------------------------------
+@x [45] m.996 l.19384 - e-TeX last_node_type
+last_penalty:=0; last_kern:=0;
+@y
+last_penalty:=0; last_kern:=0;
+last_node_type:=type(p)+1;
+@z
+%---------------------------------------
+@x [45] m.999 l.19421 - e-TeX saved_items
+link(contrib_head):=link(p); link(p):=null; flush_node_list(p)
+@y
+link(contrib_head):=link(p); link(p):=null;
+if saving_vdiscards>0 then
+ begin if page_disc=null then page_disc:=p@+else link(tail_page_disc):=p;
+ tail_page_disc:=p;
+ end
+else flush_node_list(p)
+@z
+%---------------------------------------
+% FIXME: sparse arrays?
+@x [45] m.1012 l.19661 fire_up - e-TeX marks
+if bot_mark<>null then
+@y
+if sa_mark<>null then
+ if do_marks(fire_up_init,0,sa_mark) then sa_mark:=null;
+if bot_mark<>null then
+@z
+%---------------------------------------
+@x [45] m.1012 l.19669 fire_up - e-TeX marks
+if (top_mark<>null)and(first_mark=null) then
+@y
+if sa_mark<>null then
+ if do_marks(fire_up_done,0,sa_mark) then sa_mark:=null;
+if (top_mark<>null)and(first_mark=null) then
+@z
+%---------------------------------------
+@x [45] m.1014 l.19706 - e-TeX marks
+ else if type(p)=mark_node then @<Update the values of
+@y
+ else if type(p)=mark_node then
+ if mark_class(p)<>0 then @<Update the current marks for |fire_up|@>
+ else @<Update the values of
+@z
+%---------------------------------------
+@x [45] m.1021 l.19818 - e-TeX saved_items
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+@y
+ ins_ptr(p):=prune_page_top(broken_ptr(r),false);
+@z
+%---------------------------------------
+@x [45] m.1023 l.19854 - e-TeX saved_items
+ship_out(box(255)); set_equiv(box_base+255,null);
+@y
+flush_node_list(page_disc); page_disc:=null;
+ship_out(box(255)); set_equiv(box_base+255,null);
+@z
+%---------------------------------------
+@x [45] m.1026 l.19896 - e-TeX saved_items
+pop_nest; build_page;
+@y
+flush_node_list(page_disc); page_disc:=null;
+pop_nest; build_page;
+@z
+%---------------------------------------
+@x [47] m.1070 l.20697 normal_paragraph - e-TeX penalties
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+@y
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+if inter_line_penalties_ptr<>null then
+ eq_define(inter_line_penalties_loc,shape_ref,null);
+@z
+%---------------------------------------
+% FIXME incompatible?
+% @x [47] m.1071 l.20718 - e-TeX sparse arrays
+% |box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}';
+% codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}'
+% through `\.{\\global\\setbox255}';
+% code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513|
+% through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}',
+% @y
+% |global_box_flag-1| represent `\.{\\setbox0}' through `\.{\\setbox32767}';
+% codes |global_box_flag| through |ship_out_flag-1| represent
+% `\.{\\global\\setbox0}' through `\.{\\global\\setbox32767}';
+% code |ship_out_flag| represents `\.{\\shipout}'; and codes |leader_flag|
+% through |leader_flag+2| represent `\.{\\leaders}', `\.{\\cleaders}',
+% @z
+%---------------------------------------
+@x [47] m.1071 l.20732 - e-TeX sparse arrays
+@d ship_out_flag==box_flag+(number_regs+number_regs)
+ {context code for `\.{\\shipout}'}
+@y
+@d global_box_flag==box_flag+(number_regs+number_regs) {context code for `\.{\\global\\setbox0}'}
+@d ship_out_flag==global_box_flag+1 {context code for `\.{\\shipout}'}
+@z
+%---------------------------------------
+@x [47] m.1075 l.20815 box_end - e-TeX sparse arrays
+var p:pointer; {|ord_noad| for new box in math mode}
+@y
+var p:pointer; {|ord_noad| for new box in math mode}
+@!a:small_number; {global prefix}
+@z
+%---------------------------------------
+% FIXME: might not work this way
+@x [47] m.1077 l.20853 - e-TeX sparse arrays
+if box_context<box_flag+number_regs then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box)
+@y
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+@z
+%---------------------------------------
+@x [47] m.1079 l.20885 begin_box - e-TeX sparse arrays
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+@y
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+@z
+%---------------------------------------
+% @x [47] m.1080 l.20901 - e-TeX TeXXeT
+% since |head| is a one-word node.
+% @y
+% since |head| is a one-word node.
+% A final \.{\\endM} node is temporarily removed.
+% @z
+%---------------------------------------
+% @x [47] m.1080 l.20914 - e-TeX TeXXeT
+% if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+% @<Remove the last box, unless it's part of a discretionary@>;
+% @y
+% begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+% remove_end_M;
+% if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+% @<Remove the last box, unless it's part of a discretionary@>;
+% if LR_temp<>null then insert_end_M;
+% end;
+% @z
+%---------------------------------------
+@x [47] m.1082 l.20935 - e-TeX sparse arrays
+begin scan_eight_bit_int; n:=cur_val;
+@y
+begin scan_register_num; n:=cur_val;
+@z
+%---------------------------------------
+% @x [47] m.1096 l.21119 - e-TeX penalties, TeXXeT
+% else line_break(widow_penalty);
+% @y
+% else line_break(false);
+% if LR_save<>null then
+% begin flush_list(LR_save); LR_save:=null;
+% end;
+% @z
+%---------------------------------------
+@x [47] m.1101 l.21175 make_mark - e-TeX marks
+begin p:=scan_toks(false,true); p:=get_node(small_node_size);
+@y
+@!c:halfword; {the mark class}
+begin if cur_chr=0 then c:=0
+else begin scan_register_num; c:=cur_val;
+ end;
+p:=scan_toks(false,true); p:=get_node(small_node_size);
+mark_class(p):=c;
+@z
+%---------------------------------------
+% @x [47] m.1105 l.21203 - e-TeX TeXXeT
+% will be deleted, if present.
+% @y
+% will be deleted, if present.
+% A final \.{\\endM} node is temporarily removed.
+% @z
+%---------------------------------------
+% @x [47] m.1105 l.21213 delete_last - e-TeX TeXXeT
+% else begin if not is_char_node(tail) then if type(tail)=cur_chr then
+% @y
+% else begin if not is_char_node(tail) then
+% begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+% remove_end_M;
+% if type(tail)=cur_chr then
+% @z
+%---------------------------------------
+% @x [47] m.1105 l.21224 delete_last - e-TeX TeXXeT
+% end;
+% @y
+% if LR_temp<>null then insert_end_M;
+% end;
+% end;
+% @z
+%---------------------------------------
+@x [47] m.1108 l.21262 - e-TeX saved_items
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+@y
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+ @<Cases of |un_vbox| for |print_cmd_chr|@>@/
+@z
+%---------------------------------------
+@x [47] m.1110 l.21272 unpackage - e-TeX saved_items
+label exit;
+@y
+label done, exit;
+@z
+%---------------------------------------
+@x [47] m.1110 l.21275 unpackage - e-TeX saved_items, sparse arrays
+begin c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+@y
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+@z
+%---------------------------------------
+% FIXME: might be incompatible
+@x [47] m.1110 l.21287 unpackage - e-TeX sparse arrays
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@y
+else begin link(tail):=list_ptr(p);
+change_box(null);
+@z
+%---------------------------------------
+@x [47] m.1110 l.21290 unpackage - e-TeX saved_items
+while link(tail)<>null do tail:=link(tail);
+@y
+done:
+while link(tail)<>null do tail:=link(tail);
+@z
+%---------------------------------------
+% @x [47] m.1130 l.21562 - e-TeX TeXXeT
+% vmode+halign,hmode+valign:init_align;
+% @y
+% vmode+halign:init_align;
+% hmode+valign:@<Cases of |main_control| for |hmode+valign|@>@; init_align;
+% @z
+%---------------------------------------
+% @x [48] m.1138 l.21629 init_math - e-TeX TeXXeT
+% procedure init_math;
+% label reswitch,found,not_found,done;
+% var w:scaled; {new or partial |pre_display_size|}
+% @y
+% @t\4@>@<Declare subprocedures for |init_math|@>@;
+% procedure init_math;
+% label reswitch,found,not_found,done;
+% var w:scaled; {new or partial |pre_display_size|}
+% @!j:pointer; {prototype box for display}
+% @!x:integer; {new |pre_display_direction|}
+% @z
+%---------------------------------------
+% @x [48] m.1145 l.21687 - e-TeX TeXXeT, penalties
+% begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+% begin pop_nest; w:=-max_dimen;
+% end
+% else begin line_break(display_widow_penalty);@/
+% @y
+% begin j:=null; w:=-max_dimen;
+% if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+% @<Prepare for display after an empty paragraph@>
+% else begin line_break(true);@/
+% @z
+%---------------------------------------
+% @x [48] m.1145 l.21700 - e-TeX TeXXeT
+% eq_word_define(dimen_base+pre_display_size_code,w);
+% @y
+% eq_word_define(dimen_base+pre_display_size_code,w);
+% LR_box:=j;
+% if eTeX_ex then eq_word_define(int_base+pre_display_direction_code,x);
+% @z
+%---------------------------------------
+% @x [48] m.1146 l.21708 - e-TeX TeXXeT
+% v:=shift_amount(just_box)+2*quad(cur_font); w:=-max_dimen;
+% p:=list_ptr(just_box);
+% @y
+% @<Prepare for display after a non-empty paragraph@>;
+% @z
+%---------------------------------------
+% @x [48] m.1146 l.21723 - e-TeX TeXXeT
+% done:
+% @y
+% done:
+% @<Finish the natural width computation@>
+% @z
+%---------------------------------------
+% @x [48] m.1147 l.21734 - e-TeX TeXXeT
+% kern_node,math_node: d:=width(p);
+% @y
+% kern_node: d:=width(p);
+% @t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@;
+% @z
+%---------------------------------------
+@x [48] m.1185 l.22243 - e-TeX middle
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+@y
+ if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(delim_ptr);
+ link(delim_ptr):=incompleat_noad; link(incompleat_noad):=p;
+@z
+%---------------------------------------
+@x [48] m.1189 l.22288 - e-TeX middle
+else print_esc("right");
+@y
+@/@<Cases of |left_right| for |print_cmd_chr|@>@/
+else print_esc("right");
+@z
+%---------------------------------------
+@x [48] m.1191 l.22297 math_left_right - e-TeX middle
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+@y
+@!q:pointer; {resulting mlist}
+begin t:=cur_chr;
+if (t<>left_noad)and(cur_group<>math_left_group) then
+@z
+%---------------------------------------
+% FIXME: might be incompatible?
+@x [48] m.1191 l.22302 math_left_right - e-TeX middle
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+@y
+ if t=middle_noad then
+ begin type(p):=right_noad; subtype(p):=middle_noad;
+ end;
+ if t=left_noad then q:=p
+ else begin q:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+ end;
+ if t<>right_noad then
+ begin push_math(math_left_group); link(head):=q; tail:=p;
+ delim_ptr:=p;
+ end
+ else begin
+@z
+%---------------------------------------
+@x [48] m.1191 l.22308 math_left_right - e-TeX middle
+ info(nucleus(tail)):=p;
+@y
+ info(nucleus(tail)):=q;
+@z
+%---------------------------------------
+@x [48] m.1192 l.22316 - e-TeX middle
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+@y
+ print_err("Extra ");
+ if t=middle_noad then
+ begin print_esc("middle");
+@.Extra \\middle.@>
+ help1("I'm ignoring a \middle that had no matching \left.");
+ end
+ else begin print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ end;
+@z
+%---------------------------------------
+% @x [48] m.1194 l.22331 after_math - e-TeX TeXXeT
+% procedure after_math;
+% @y
+% @t\4@>@<Declare subprocedures for |after_math|@>@;
+% procedure after_math;
+% @z
+%---------------------------------------
+% @x [48] m.1194 l.22338 after_math - e-TeX TeXXeT
+% begin danger:=false;
+% @y
+% begin danger:=false;
+% @<Retrieve the prototype box@>;
+% @z
+%---------------------------------------
+% @x [48] m.1194 l.22345 after_math - e-TeX TeXXeT
+% mlist_to_hlist; a:=hpack(link(temp_head),natural);
+% @y
+% mlist_to_hlist; a:=hpack(link(temp_head),natural);
+% subtype(a):=dlist;
+% @z
+%---------------------------------------
+% @x [48] m.1194 l.22348 after_math - e-TeX TeXXeT
+% danger:=false;
+% @y
+% danger:=false;
+% @<Retrieve the prototype box@>;
+% @z
+%---------------------------------------
+% @x [48] m.1199 l.22435 - e-TeX TeXXeT
+% w:=width(b); z:=display_width; s:=display_indent;
+% @y
+% w:=width(b); z:=display_width; s:=display_indent;
+% if pre_display_direction<0 then s:=-s-z;
+% @z
+%---------------------------------------
+% @x [48] m.1199 l.22450 - e-TeX TeXXeT
+% resume_after_display
+% @y
+% @<Flush the prototype box@>;
+% resume_after_display
+% @z
+%---------------------------------------
+% @x [48] m.1202 l.22492 - e-TeX TeXXeT
+% d:=half(z-w);
+% @y
+% subtype(b):=dlist;
+% d:=half(z-w);
+% @z
+%---------------------------------------
+% @x [48] m.1203 l.22513 - e-TeX TeXXeT
+% begin shift_amount(a):=s; append_to_vlist(a);
+% @y
+% begin app_display(j,a,0);
+% @z
+%---------------------------------------
+% @x [48] m.1204 l.22528 - e-TeX TeXXeT
+% shift_amount(b):=s+d; append_to_vlist(b)
+% @y
+% app_display(j,b,d)
+% @z
+%---------------------------------------
+% @x [48] m.1205 l.22533 - e-TeX TeXXeT
+% shift_amount(a):=s+z-width(a);
+% append_to_vlist(a);
+% @y
+% app_display(j,a,z-width(a));
+% @z
+%---------------------------------------
+% @x [48] m.1206 l.22552 - e-TeX TeXXeT
+% pop_nest;
+% @y
+% flush_node_list(LR_box);
+% pop_nest;
+% @z
+%---------------------------------------
+@x [49] m.1208 l.22577 - e-TeX protected
+control sequence can be defined to be `\.{\\long}' or `\.{\\outer}', and
+it might or might not be expanded. The prefixes `\.{\\global}', `\.{\\long}',
+@y
+control sequence can be defined to be `\.{\\long}', `\.{\\protected}',
+or `\.{\\outer}', and it might or might not be expanded. The prefixes
+`\.{\\global}', `\.{\\long}', `\.{\\protected}',
+@z
+%---------------------------------------
+@x [49] m.1209 l.22603 - e-TeX protected
+ else print_esc("global");
+@y
+ @/@<Cases of |prefix| for |print_cmd_chr|@>@/
+ else print_esc("global");
+@z
+%---------------------------------------
+@x [49] m.1211 l.22665 prefixed_command - e-TeX tracing
+ @<Discard erroneous prefixes and |return|@>;
+@y
+ @<Discard erroneous prefixes and |return|@>;
+ if tracing_commands>2 then if eTeX_ex then show_cur_cmd_chr;
+@z
+%---------------------------------------
+@x [49] m.1213 l.22686 - e-TeX protected
+if (cur_cmd<>def)and(a mod 4<>0) then
+@y
+if a>=8 then
+ begin j:=protected_token; a:=a-8;
+ end
+else j:=0;
+if (cur_cmd<>def)and((a mod 4<>0)or(j<>0)) then
+@z
+%---------------------------------------
+@x [49] m.1218 l.22749 - e-TeX protected
+ q:=scan_toks(true,e); define(p,call+(a mod 4),def_ref);
+@y
+ q:=scan_toks(true,e);
+ if j<>0 then
+ begin q:=get_avail; info(q):=j; link(q):=link(def_ref);
+ link(def_ref):=q;
+ end;
+ define(p,call+(a mod 4),def_ref);
+@z
+%---------------------------------------
+@x [49] m.1224 l.22840 - e-TeX sparse arrays
+ othercases begin scan_eight_bit_int;
+@y
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+@z
+%---------------------------------------
+@x [49] m.1225 l.22853 - e-TeX read_line
+read_to_cs: begin scan_int; n:=cur_val;
+@y
+read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1225 l.22861 - e-TeX read_line
+ p:=cur_cs; read_toks(n,p); define(p,call,cur_val);
+@y
+ p:=cur_cs; read_toks(n,p,j); define(p,call,cur_val);
+@z
+%---------------------------------------
+@x [49] m.1226 l.22870 - e-TeX sparse arrays
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@y
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true;
+ p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@z
+%---------------------------------------
+@x [49] m.1226 l.22880 - e-TeX sparse arrays
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+@y
+ begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+@z
+%---------------------------------------
+@x [49] m.1226 l.22888 - e-TeX sparse arrays
+ define(p,call,def_ref);
+@y
+ sa_define(p,def_ref)(p,call,def_ref);
+@z
+%---------------------------------------
+@x [49] m.1227 l.22893 - e-TeX sparse arrays
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+@y
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_ptr)
+ else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+@z
+%---------------------------------------
+@x [49] m.1236 l.23009 do_register_command - e-TeX sparse arrays
+begin q:=cur_cmd;
+@y
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@z
+%---------------------------------------
+@x [49] m.1236 l.23024 do_register_command - e-TeX sparse arrays
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+@y
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
+@z
+%---------------------------------------
+@x [49] m.1237 l.23046 - e-TeX sparse arrays
+p:=cur_chr; scan_eight_bit_int;
+@y
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+@z
+%---------------------------------------
+@x [49] m.1237 l.23053 - e-TeX sparse arrays
+end;
+found:
+@y
+ end;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=new_eqtb_int(l);
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+@z
+%---------------------------------------
+@x [49] m.1238 l.23059 - e-TeX sparse arrays
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@y
+ if q=advance then cur_val:=cur_val+w;
+@z
+%---------------------------------------
+@x [49] m.1239 l.23066 - e-TeX sparse arrays
+begin q:=new_spec(cur_val); r:=equiv(l);
+@y
+begin q:=new_spec(cur_val); r:=s;
+@z
+%---------------------------------------
+@x [49] m.1240 l.23086 - e-TeX sparse arrays
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+@y
+ if p=int_val then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin r:=new_spec(s);
+@z
+%---------------------------------------
+@x [49] m.1241 l.23108 - e-TeX sparse arrays
+set_box: begin scan_eight_bit_int;
+ if global then n:=number_regs+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+@y
+set_box: begin scan_register_num;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@z
+%---------------------------------------
+@x [49] m.1246 l.23179 alter_integer - e-TeX interaction_mode
+var c:0..1; {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+@y
+var c:small_number;
+ {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+@/@<Cases for |alter_integer|@>@/
+@z
+%---------------------------------------
+@x [49] m.1247 l.23188 alter_box_dimen - e-TeX sparse arrays
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+@y
+@!b:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1248 l.23197 - e-TeX penalties
+set_shape: begin scan_optional_equals; scan_int; n:=cur_val;
+ if n<=0 then p:=null
+@y
+set_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val;
+ if n<=0 then p:=null
+ else if q>par_shape_loc then
+ begin n:=(cur_val div 2)+1; p:=get_node(2*n+1); info(p):=n;
+ n:=cur_val; mem[p+1].int:=n; {number of penalties}
+ for j:=p+2 to p+n+1 do
+ begin scan_int; mem[j].int:=cur_val; {penalty values}
+ end;
+ if not odd(n) then mem[p+n+2].int:=0; {unused}
+ end
+@z
+%---------------------------------------
+@x [49] m.1248 l.23207 - e-TeX penalties
+ define(par_shape_loc,shape_ref,p);
+@y
+ define(q,shape_ref,p);
+@z
+%---------------------------------------
+@x [49] m.1292 l.23581 - e-TeX show_groups
+ show_lists:print_esc("showlists");
+@y
+ show_lists:print_esc("showlists");
+ @<Cases of |xray| for |print_cmd_chr|@>@;@/
+@z
+%---------------------------------------
+@x [49] m.1293 l.23588 show_whatever - e-TeX show_ifs
+var p:pointer; {tail of a token list to show}
+@y
+var p:pointer; {tail of a token list to show}
+@!t:small_number; {type of conditional being shown}
+@!m:normal..or_code; {upper bound on |fi_or_else| codes}
+@!l:integer; {line where that conditional began}
+@!n:integer; {level of \.{\\if...\\fi} nesting}
+@z
+%---------------------------------------
+@x [49] m.1293 l.23594 show_whatever - e-TeX show_groups
+othercases @<Show the current value of some parameter or register,
+@y
+@<Cases for |show_whatever|@>@;@/
+othercases @<Show the current value of some parameter or register,
+@z
+%---------------------------------------
+@x [49] m.1295 l.23629 - e-TeX protected
+call: print("macro");
+long_call: print_esc("long macro");
+outer_call: print_esc("outer macro");
+long_outer_call: begin print_esc("long"); print_esc("outer macro");
+@y
+call,long_call,outer_call,long_outer_call: begin n:=cmd-call;
+ if info(link(chr_code))=protected_token then n:=n+4;
+ if odd(n div 4) then print_esc("protected");
+ if odd(n) then print_esc("long");
+ if odd(n div 2) then print_esc("outer");
+ if n>0 then print_char(" ");
+ print("macro");
+@z
+%---------------------------------------
+@x [49] m.1296 l.23637 - e-TeX sparse arrays
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+@y
+begin scan_register_num; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+@z
+%---------------------------------------
+@x [50] m.1307 l.23779 - e-TeX basic
+dump_int(@$);@/
+@y
+dump_int(@$);@/
+@<Dump the \eTeX\ state@>@/
+@z
+%---------------------------------------
+@x [50] m.1308 l.23794 - e-TeX basic
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@y
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@/@<Undump the \eTeX\ state@>@/
+@z
+%---------------------------------------
+@x [50] m.1311 l.23848 - e-TeX sparse arrays
+dump_int(lo_mem_max); dump_int(rover);
+@y
+dump_int(lo_mem_max); dump_int(rover);
+if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+@z
+%---------------------------------------
+@x [50] m.1312 l.23871 - e-TeX sparse arrays
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+@y
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+if eTeX_ex then for k:=int_val to tok_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24065 - e-TeX hyph_codes
+dump_int(trie_max);
+@y
+dump_int(trie_max);
+dump_int(hyph_start);
+@z
+%---------------------------------------
+@x [50] m.1325 l.24093 - e-TeX hyph_codes
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+@y
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+undump(0)(j)(hyph_start);
+@z
+%---------------------------------------
+@x [51] m.1335 l.24313 final_cleanup - tracing
+ print_int(cur_level-level_one); print_char(")");
+@y
+ print_int(cur_level-level_one); print_char(")");
+ if eTeX_ex then show_save_groups;
+@z
+%---------------------------------------
+@x [51] m.1335 l.24336 final_cleanup - e-TeX marks, saved_items
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+@y
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+@z
+%---------------------------------------
+@x [51] m.1336 l.24345 ] m.1336 l.24340 init_prim - e-TeX basic
+begin no_new_control_sequence:=false;
+@y
+begin no_new_control_sequence:=false;
+first:=0;
+@z
+%---------------------------------------
+@x [51] m.1337 l.24360 - e-TeX basic
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+@<Enable \eTeX, if requested@>@;@/
+if (format_ident=0)or(buffer[loc]="&") then
+@z
+%---------------------------------------
+@x [51] m.1337 l.24368 - e-TeX basic
+ end;
+@y
+ end;
+if eTeX_ex then wterm_ln('entering extended mode');
+@z
+%---------------------------------------
+@x [53] m.1363 l.24715 - e-TeX hyph_codes
+adv_past(s)
+@y
+if subtype(s)=language_node then
+ begin cur_lang:=what_lang(s); l_hyf:=what_lhm(s); r_hyf:=what_rhm(s);
+ set_hyph_index;
+ end
+@z
+%---------------------------------------
+@x [54] m.1379 l.24903 - e-TeX additions
+@* \[54] System-dependent changes.
+@y
+@* \[53a] The extended features of \eTeX.
+The program has two modes of operation: (1)~In \TeX\ compatibility mode
+it fully deserves the name \TeX\ and there are neither extended features
+nor additional primitive commands. There are, however, a few
+modifications that would be legitimate in any implementation of \TeX\
+such as, e.g., preventing inadequate results of the glue to \.{DVI}
+unit conversion during |ship_out|. (2)~In extended mode there are
+additional primitive commands and the extended features of \eTeX\ are
+available.
+
+The distinction between these two modes of operation initially takes
+place when a `virgin' \.{eINITEX} starts without reading a format file.
+Later on the values of all \eTeX\ state variables are inherited when
+\.{eVIRTEX} (or \.{eINITEX}) reads a format file.
+
+The code below is designed to work for cases where `$|init|\ldots|tini|$'
+is a run-time switch.
+
+@<Enable \eTeX, if requested@>=
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+ begin no_new_control_sequence:=false;
+ @<Generate all \eTeX\ primitives@>@;
+ incr(loc); eTeX_mode:=1; {enter extended mode}
+ @<Initialize variables for \eTeX\ extended mode@>@;
+ end;
+tini@;@/
+if not no_new_control_sequence then {just entered extended mode ?}
+ no_new_control_sequence:=true@+else
+
+@ The \eTeX\ features available in extended mode are grouped into two
+categories: (1)~Some of them are permanently enabled and have no
+semantic effect as long as none of the additional primitives are
+executed. (2)~The remaining \eTeX\ features are optional and can be
+individually enabled and disabled. For each optional feature there is
+an \eTeX\ state variable named \.{\\...state}; the feature is enabled,
+resp.\ disabled by assigning a positive, resp.\ non-positive value to
+that integer.
+
+@d eTeX_state_base=int_base+eTeX_state_code
+@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable}
+@#
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+@d eTeX_revision_code=6 {command code for \.{\\eTeXrevision}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+eTeX_version_code: print_esc("eTeXversion");
+
+@ @<Cases for fetching an integer value@>=
+eTeX_version_code: cur_val:=eTeX_version;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+eTeX_revision_code: print_esc("eTeXrevision");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+eTeX_revision_code: do_nothing;
+
+@ @<Cases of `Print the result of command |c|'@>=
+eTeX_revision_code: print(eTeX_revision);
+
+@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?}
+
+@<Glob...@>=
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+
+@ @<Initialize table entries...@>=
+eTeX_mode:=0; {initially we are in compatibility mode}
+@<Initialize variables for \eTeX\ compatibility mode@>@;
+
+@ @<Dump the \eTeX\ state@>=
+dump_int(eTeX_mode);
+for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+
+@ @<Undump the \eTeX\ state@>=
+undump(0)(1)(eTeX_mode);
+if eTeX_ex then
+ begin @<Initialize variables for \eTeX\ extended mode@>@;
+ end
+else begin @<Initialize variables for \eTeX\ compatibility mode@>@;
+ end;
+
+@ The |eTeX_enabled| function simply returns its first argument as
+result. This argument is |true| if an optional \eTeX\ feature is
+currently enabled; otherwise, if the argument is |false|, the function
+gives an error message.
+
+@<Declare \eTeX\ procedures for use...@>=
+function eTeX_enabled(@!b:boolean;@!j:quarterword;@!k:halfword):boolean;
+begin if not b then
+ begin print_err("Improper "); print_cmd_chr(j,k);
+ help1("Sorry, this optional e-TeX feature has been disabled."); error;
+ end;
+eTeX_enabled:=b;
+end;
+
+@ First we implement the additional \eTeX\ parameters in the table of
+equivalents.
+
+@<Generate all \eTeX...@>=
+primitive("everyeof",assign_toks,every_eof_loc);
+@!@:every_eof_}{\.{\\everyeof} primitive@>
+primitive("tracingassigns",assign_int,int_base+tracing_assigns_code);@/
+@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@>
+primitive("tracinggroups",assign_int,int_base+tracing_groups_code);@/
+@!@:tracing_groups_}{\.{\\tracinggroups} primitive@>
+primitive("tracingifs",assign_int,int_base+tracing_ifs_code);@/
+@!@:tracing_ifs_}{\.{\\tracingifs} primitive@>
+primitive("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code);@/
+@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@>
+primitive("tracingnesting",assign_int,int_base+tracing_nesting_code);@/
+@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@>
+{ FIXME: the next two should be commented }
+primitive("predisplaydirection",
+ assign_int,int_base+pre_display_direction_code);@/
+@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@>
+primitive("lastlinefit",assign_int,int_base+last_line_fit_code);@/
+@!@:last_line_fit_}{\.{\\lastlinefit} primitive@>
+primitive("savingvdiscards",assign_int,int_base+saving_vdiscards_code);@/
+@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@>
+primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/
+@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@>
+
+@ @d every_eof==equiv(every_eof_loc)
+
+@<Cases of |assign_toks| for |print_cmd_chr|@>=
+every_eof_loc: print_esc("everyeof");
+
+@ @<Cases for |print_param|@>=
+tracing_assigns_code:print_esc("tracingassigns");
+tracing_groups_code:print_esc("tracinggroups");
+tracing_ifs_code:print_esc("tracingifs");
+tracing_scan_tokens_code:print_esc("tracingscantokens");
+tracing_nesting_code:print_esc("tracingnesting");
+{ FIXME: the next one should be commented }
+pre_display_direction_code:print_esc("predisplaydirection");
+last_line_fit_code:print_esc("lastlinefit");
+saving_vdiscards_code:print_esc("savingvdiscards");
+saving_hyph_codes_code:print_esc("savinghyphcodes");
+
+@ In order to handle \.{\\everyeof} we need an array |eof_seen| of
+boolean variables.
+
+@<Glob...@>=
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+
+@ The |print_group| procedure prints the current level of grouping and
+the name corresponding to |cur_group|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure print_group(@!e:boolean);
+label exit;
+begin case cur_group of
+ bottom_level: begin print("bottom level"); return;
+ end;
+ simple_group,semi_simple_group:
+ begin if cur_group=semi_simple_group then print("semi ");
+ print("simple");
+ end;
+ hbox_group,adjusted_hbox_group:
+ begin if cur_group=adjusted_hbox_group then print("adjusted ");
+ print("hbox");
+ end;
+ vbox_group: print("vbox");
+ vtop_group: print("vtop");
+ align_group,no_align_group:
+ begin if cur_group=no_align_group then print("no ");
+ print("align");
+ end;
+ output_group: print("output");
+ disc_group: print("disc");
+ insert_group: print("insert");
+ vcenter_group: print("vcenter");
+ math_group,math_choice_group,math_shift_group,math_left_group:
+ begin print("math");
+ if cur_group=math_choice_group then print(" choice")
+ else if cur_group=math_shift_group then print(" shift")
+ else if cur_group=math_left_group then print(" left");
+ end;
+ end; {there are no other cases}
+print(" group (level "); print_int(qo(cur_level)); print_char(")");
+if saved(-1)<>0 then
+ begin if e then print(" entered at line ") else print(" at line ");
+ print_int(saved(-1));
+ end;
+exit:end;
+
+@ The |group_trace| procedure is called when a new level of grouping
+begins (|e=false|) or ends (|e=true|) with |saved(-1)| containing the
+line number.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure group_trace(@!e:boolean);
+begin begin_diagnostic; print_char("{");
+if e then print("leaving ") else print("entering ");
+print_group(e); print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ The \.{\\currentgrouplevel} and \.{\\currentgrouptype} commands return
+the current level of grouping and the type of the current group
+respectively.
+
+@d current_group_level_code=eTeX_int+1 {code for \.{\\currentgrouplevel}}
+@d current_group_type_code=eTeX_int+2 {code for \.{\\currentgrouptype}}
+
+@<Generate all \eTeX...@>=
+primitive("currentgrouplevel",last_item,current_group_level_code);
+@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@>
+primitive("currentgrouptype",last_item,current_group_type_code);
+@!@:current_group_type_}{\.{\\currentgrouptype} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_group_level_code: print_esc("currentgrouplevel");
+current_group_type_code: print_esc("currentgrouptype");
+
+@ @<Cases for fetching an integer value@>=
+current_group_level_code: cur_val:=cur_level-level_one;
+current_group_type_code: cur_val:=cur_group;
+
+@ The \.{\\currentiflevel}, \.{\\currentiftype}, and
+\.{\\currentifbranch} commands return the current level of conditionals
+and the type and branch of the current conditional.
+
+@d current_if_level_code=eTeX_int+3 {code for \.{\\currentiflevel}}
+@d current_if_type_code=eTeX_int+4 {code for \.{\\currentiftype}}
+@d current_if_branch_code=eTeX_int+5 {code for \.{\\currentifbranch}}
+
+@<Generate all \eTeX...@>=
+primitive("currentiflevel",last_item,current_if_level_code);
+@!@:current_if_level_}{\.{\\currentiflevel} primitive@>
+primitive("currentiftype",last_item,current_if_type_code);
+@!@:current_if_type_}{\.{\\currentiftype} primitive@>
+primitive("currentifbranch",last_item,current_if_branch_code);
+@!@:current_if_branch_}{\.{\\currentifbranch} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_if_level_code: print_esc("currentiflevel");
+current_if_type_code: print_esc("currentiftype");
+current_if_branch_code: print_esc("currentifbranch");
+
+@ @<Cases for fetching an integer value@>=
+current_if_level_code: begin q:=cond_ptr; cur_val:=0;
+ while q<>null do
+ begin incr(cur_val); q:=link(q);
+ end;
+ end;
+current_if_type_code: if cond_ptr=null then cur_val:=0
+ else if cur_if<unless_code then cur_val:=cur_if+1
+ else cur_val:=-(cur_if-unless_code+1);
+current_if_branch_code:
+ if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1
+ else if if_limit=fi_code then cur_val:=-1
+ else cur_val:=0;
+
+@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and
+\.{\\fontcharic} commands return information about a character in a
+font.
+
+@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}}
+@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}}
+@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}}
+@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}}
+
+@<Generate all \eTeX...@>=
+primitive("fontcharwd",last_item,font_char_wd_code);
+@!@:font_char_wd_}{\.{\\fontcharwd} primitive@>
+primitive("fontcharht",last_item,font_char_ht_code);
+@!@:font_char_ht_}{\.{\\fontcharht} primitive@>
+primitive("fontchardp",last_item,font_char_dp_code);
+@!@:font_char_dp_}{\.{\\fontchardp} primitive@>
+primitive("fontcharic",last_item,font_char_ic_code);
+@!@:font_char_ic_}{\.{\\fontcharic} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+font_char_wd_code: print_esc("fontcharwd");
+font_char_ht_code: print_esc("fontcharht");
+font_char_dp_code: print_esc("fontchardp");
+font_char_ic_code: print_esc("fontcharic");
+
+@ @<Cases for fetching a dimension value@>=
+font_char_wd_code,
+font_char_ht_code,
+font_char_dp_code,
+font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
+ if (font_bc(q)<=cur_val)and(font_ec(q)>=cur_val) then
+ begin i:=char_info(q)(qi(cur_val));
+ case m of
+ font_char_wd_code: cur_val:=char_width(q)(i);
+ font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
+ font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
+ font_char_ic_code: cur_val:=char_italic(q)(i);
+ end; {there are no other cases}
+ end
+ else cur_val:=0;
+ end;
+
+@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength}
+commands return the indent and length parameters of the current
+\.{\\parshape} specification.
+
+@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}}
+@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}}
+@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}}
+
+@<Generate all \eTeX...@>=
+primitive("parshapelength",last_item,par_shape_length_code);
+@!@:par_shape_length_}{\.{\\parshapelength} primitive@>
+primitive("parshapeindent",last_item,par_shape_indent_code);
+@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@>
+primitive("parshapedimen",last_item,par_shape_dimen_code);
+@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+par_shape_length_code: print_esc("parshapelength");
+par_shape_indent_code: print_esc("parshapeindent");
+par_shape_dimen_code: print_esc("parshapedimen");
+
+@ @<Cases for fetching a dimension value@>=
+par_shape_length_code,
+par_shape_indent_code,
+par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int;
+ if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0
+ else begin if q=2 then
+ begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2;
+ end;
+ if cur_val>info(par_shape_ptr) then cur_val:=info(par_shape_ptr);
+ cur_val:=mem[par_shape_ptr+2*cur_val-q].sc;
+ end;
+ cur_val_level:=dimen_val;
+ end;
+
+@ The \.{\\showgroups} command displays all currently active grouping
+levels.
+
+@d show_groups=4 { \.{\\showgroups} }
+
+@<Generate all \eTeX...@>=
+primitive("showgroups",xray,show_groups);
+@!@:show_groups_}{\.{\\showgroups} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_groups:print_esc("showgroups");
+
+@ @<Cases for |show_whatever|@>=
+show_groups: begin begin_diagnostic; show_save_groups;
+ end;
+
+@ @<Types...@>=
+@!save_pointer=0..save_size; {index into |save_stack|}
+
+@ The modifications of \TeX\ required for the display produced by the
+|show_save_groups| procedure were first discussed by Donald~E. Knuth in
+{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990.
+@^Knuth, Donald Ervin@>
+
+In order to understand a group type we also have to know its mode.
+Since unrestricted horizontal modes are not associated with grouping,
+they are skipped when traversing the semantic nest.
+
+@<Declare \eTeX\ procedures for use...@>=
+procedure show_save_groups;
+label found1,found2,found,done;
+var p:0..nest_size; {index into |nest|}
+@!m:-mmode..mmode; {mode}
+@!v:save_pointer; {saved value of |save_ptr|}
+@!l:quarterword; {saved value of |cur_level|}
+@!c:group_code; {saved value of |cur_group|}
+@!a:-1..1; {to keep track of alignments}
+@!i:integer;
+@!j:quarterword;
+@!s:str_number;
+begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array}
+v:=save_ptr; l:=cur_level; c:=cur_group;
+save_ptr:=cur_boundary; decr(cur_level);@/
+a:=1;
+print_nl(""); print_ln;
+loop@+begin print_nl("### "); print_group(true);
+ if cur_group=bottom_level then goto done;
+ repeat m:=nest[p].mode_field;
+ if p>0 then decr(p) else m:=vmode;
+ until m<>hmode;
+ print(" (");
+ case cur_group of
+ simple_group: begin incr(p); goto found2;
+ end;
+ hbox_group,adjusted_hbox_group: s:="hbox";
+ vbox_group: s:="vbox";
+ vtop_group: s:="vtop";
+ align_group: if a=0 then
+ begin if m=-vmode then s:="halign" else s:="valign";
+ a:=1; goto found1;
+ end
+ else begin if a=1 then print("align entry") else print_esc("cr");
+ if p>=a then p:=p-a;
+ a:=0; goto found;
+ end;
+ no_align_group:
+ begin incr(p); a:=-1; print_esc("noalign"); goto found2;
+ end;
+ output_group:
+ begin print_esc("output"); goto found;
+ end;
+ math_group: goto found2;
+ disc_group,math_choice_group:
+ begin if cur_group=disc_group then print_esc("discretionary")
+ else print_esc("mathchoice");
+ for i:=1 to 3 do if i<=saved(-2) then print("{}");
+ goto found2;
+ end;
+ insert_group:
+ begin if saved(-2)=255 then print_esc("vadjust")
+ else begin print_esc("insert"); print_int(saved(-2));
+ end;
+ goto found2;
+ end;
+ vcenter_group: begin s:="vcenter"; goto found1;
+ end;
+ semi_simple_group: begin incr(p); print_esc("begingroup"); goto found;
+ end;
+ math_shift_group:
+ begin if m=mmode then print_char("$")
+ else if nest[p].mode_field=mmode then
+ begin print_cmd_chr(eq_no,saved(-2)); goto found;
+ end;
+ print_char("$"); goto found;
+ end;
+ math_left_group:
+ begin if type(nest[p+1].eTeX_aux_field)=left_noad then print_esc("left")
+ else print_esc("middle");
+ goto found;
+ end;
+ end; {there are no other cases}
+ @<Show the box context@>;
+ found1: print_esc(s); @<Show the box packaging info@>;
+ found2: print_char("{");
+ found: print_char(")"); decr(cur_level);
+ cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+ end;
+done: save_ptr:=v; cur_level:=l; cur_group:=c;
+end;
+
+@ @<Show the box packaging info@>=
+if saved(-2)<>0 then
+ begin print_char(" ");
+ if saved(-3)=exactly then print("to") else print("spread");
+ print_scaled(saved(-2)); print("pt");
+ end
+
+@ @<Show the box context@>=
+i:=saved(-4);
+if i<>0 then
+ if i<box_flag then
+ begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
+ if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
+ print_scaled(abs(i)); print("pt");
+ end
+ else if i<ship_out_flag then
+ begin if i>=global_box_flag then
+ begin print_esc("global"); i:=i-(global_box_flag-box_flag);
+ end;
+ print_esc("setbox"); print_int(i-box_flag); print_char("=");
+ end
+ else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
+
+@ The |scan_general_text| procedure is much like |scan_toks(false,false)|,
+but will be invoked via |expand|, i.e., recursively.
+@^recursion@>
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_general_text; forward;@t\2@>
+
+@ The token list (balanced text) created by |scan_general_text| begins
+at |link(temp_head)| and ends at |cur_val|. (If |cur_val=temp_head|,
+the list is empty.)
+
+@<Declare \eTeX\ procedures for tok...@>=
+procedure scan_general_text;
+label found;
+var s:normal..absorbing; {to save |scanner_status|}
+@!w:pointer; {to save |warning_index|}
+@!d:pointer; {to save |def_ref|}
+@!p:pointer; {tail of the token list being built}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!unbalance:halfword; {number of unmatched left braces}
+begin s:=scanner_status; w:=warning_index; d:=def_ref;
+scanner_status:=absorbing; warning_index:=cur_cs;
+def_ref:=get_avail; token_ref_count(def_ref):=null; p:=def_ref;
+scan_left_brace; {remove the compulsory left brace}
+unbalance:=1;
+loop@+ begin get_token;
+ if cur_tok<right_brace_limit then
+ if cur_cmd<right_brace then incr(unbalance)
+ else begin decr(unbalance);
+ if unbalance=0 then goto found;
+ end;
+ store_new_token(cur_tok);
+ end;
+found: q:=link(def_ref); free_avail(def_ref); {discard reference count}
+if q=null then cur_val:=temp_head @+ else cur_val:=p;
+link(temp_head):=q;
+scanner_status:=s; warning_index:=w; def_ref:=d;
+end;
+
+@ The \.{\\showtokens} command displays a token list.
+
+@d show_tokens=5 { \.{\\showtokens} , must be odd! }
+
+@<Generate all \eTeX...@>=
+primitive("showtokens",xray,show_tokens);
+@!@:show_tokens_}{\.{\\showtokens} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_tokens:print_esc("showtokens");
+
+@ The \.{\\unexpanded} primitive prevents expansion of tokens much as
+the result from \.{\\the} applied to a token variable. The
+\.{\\detokenize} primitive converts a token list into a list of
+character tokens much as if the token list were written to a file. We
+use the fact that the command modifiers for \.{\\unexpanded} and
+\.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe}
+are even.
+
+@<Generate all \eTeX...@>=
+primitive("unexpanded",the,1);@/
+@!@:unexpanded_}{\.{\\unexpanded} primitive@>
+primitive("detokenize",the,show_tokens);@/
+@!@:detokenize_}{\.{\\detokenize} primitive@>
+
+@ @<Cases of |the| for |print_cmd_chr|@>=
+else if chr_code=1 then print_esc("unexpanded")
+else print_esc("detokenize")
+
+@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>=
+if odd(cur_chr) then
+ begin c:=cur_chr; scan_general_text;
+ if c=1 then the_toks:=cur_val
+ else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
+ p:=get_avail; link(p):=link(temp_head);
+ token_show(p); flush_list(p);
+ selector:=old_setting; the_toks:=str_toks(b);
+ end;
+ return;
+ end
+
+@ The \.{\\showifs} command displays all currently active conditionals.
+
+@d show_ifs=6 { \.{\\showifs} }
+
+@<Generate all \eTeX...@>=
+primitive("showifs",xray,show_ifs);
+@!@:show_ifs_}{\.{\\showifs} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_ifs:print_esc("showifs");
+
+@
+@d print_if_line(#)==if #<>0 then
+ begin print(" entered on line "); print_int(#);
+ end
+
+@<Cases for |show_whatever|@>=
+show_ifs: begin begin_diagnostic; print_nl(""); print_ln;
+ if cond_ptr=null then
+ begin print_nl("### "); print("no active conditionals");
+ end
+ else begin p:=cond_ptr; n:=0;
+ repeat incr(n); p:=link(p);@+until p=null;
+ p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit;
+ repeat print_nl("### level "); print_int(n); print(": ");
+ print_cmd_chr(if_test,t);
+ if m=fi_code then print_esc("else");
+ print_if_line(l);
+ decr(n); t:=subtype(p); l:=if_line_field(p); m:=type(p); p:=link(p);
+ until p=null;
+ end;
+ end;
+
+@ The \.{\\interactionmode} primitive allows to query and set the
+interaction mode.
+
+@<Generate all \eTeX...@>=
+primitive("interactionmode",set_page_int,2);
+@!@:interaction_mode_}{\.{\\interactionmode} primitive@>
+
+@ @<Cases of |set_page_int| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("interactionmode")
+
+@ @<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>=
+else if m=2 then cur_val:=interaction
+
+@ @<Declare \eTeX\ procedures for use...@>=
+procedure@?new_interaction; forward;@t\2@>
+
+@ @<Cases for |alter_integer|@>=
+else if c=2 then
+ begin if (cur_val<batch_mode)or(cur_val>error_stop_mode) then
+ begin print_err("Bad interaction mode");
+@.Bad interaction mode@>
+ help2("Modes are 0=batch, 1=nonstop, 2=scroll, and")@/
+ ("3=errorstop. Proceed, and I'll ignore this case.");
+ int_error(cur_val);
+ end
+ else begin cur_chr:=cur_val; new_interaction;
+ end;
+ end
+
+@ The |middle| feature of \eTeX\ allows one ore several \.{\\middle}
+delimiters to appear between \.{\\left} and \.{\\right}.
+
+@<Generate all \eTeX...@>=
+primitive("middle",left_right,middle_noad);
+@!@:middle_}{\.{\\middle} primitive@>
+
+@ @<Cases of |left_right| for |print_cmd_chr|@>=
+else if chr_code=middle_noad then print_esc("middle")
+
+@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens}
+primitive.
+
+@<Generate all \eTeX...@>=
+primitive("scantokens",input,2);
+@!@:scan_tokens_}{\.{\\scantokens} primitive@>
+
+@ @<Cases of |input| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("scantokens")
+
+@ @<Cases for |input|@>=
+else if cur_chr=2 then pseudo_start
+
+@ The global variable |pseudo_files| is used to maintain a stack of
+pseudo files. The |info| field of each pseudo file points to a linked
+list of variable size nodes representing lines not yet processed: the
+|info| field of the first word contains the size of this node, all the
+following words contain ASCII codes.
+
+@<Glob...@>=
+@!pseudo_files:pointer; {stack of pseudo files}
+
+@ @<Set init...@>=
+pseudo_files:=null;
+
+@ The |pseudo_start| procedure initiates reading from a pseudo file.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?pseudo_start; forward;@t\2@>
+
+@ @<Declare \eTeX\ procedures for tok...@>=
+procedure pseudo_start;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!s:str_number; {string to be converted into a pseudo file}
+@!l,@!m:pool_pointer; {indices into |str_pool|}
+@!p,@!q,@!r:pointer; {for list construction}
+@!w: four_quarters; {four ASCII codes}
+@!nl,@!sz:integer;
+begin scan_general_text;
+old_setting:=selector; selector:=new_string;
+token_show(temp_head); selector:=old_setting;
+flush_list(link(temp_head));
+str_room(1); s:=make_string;
+@<Convert string |s| into a new pseudo file@>;
+flush_string;
+@<Initiate input from new pseudo file@>;
+end;
+
+@ @<Convert string |s| into a new pseudo file@>=
+str_pool[pool_ptr]:=si(" "); l:=str_start(s);
+nl:=si(new_line_char);
+p:=get_avail; q:=p;
+while l<pool_ptr do
+ begin m:=l;
+ while (l<pool_ptr)and(str_pool[l]<>nl) do incr(l);
+ sz:=(l-m+7)div 4;
+ if sz=1 then sz:=2;
+ r:=get_node(sz); link(q):=r; q:=r; info(q):=hi(sz);
+ while sz>2 do
+ begin decr(sz); incr(r);
+ w.b0:=qi(so(str_pool[m])); w.b1:=qi(so(str_pool[m+1]));
+ w.b2:=qi(so(str_pool[m+2])); w.b3:=qi(so(str_pool[m+3]));
+ mem[r].qqqq:=w; m:=m+4;
+ end;
+ w.b0:=qi(" "); w.b1:=qi(" "); w.b2:=qi(" "); w.b3:=qi(" ");
+ if l>m then
+ begin w.b0:=qi(so(str_pool[m]));
+ if l>m+1 then
+ begin w.b1:=qi(so(str_pool[m+1]));
+ if l>m+2 then
+ begin w.b2:=qi(so(str_pool[m+2]));
+ if l>m+3 then w.b3:=qi(so(str_pool[m+3]));
+ end;
+ end;
+ end;
+ mem[r+1].qqqq:=w;
+ if str_pool[l]=nl then incr(l);
+ end;
+info(p):=link(p); link(p):=pseudo_files; pseudo_files:=p
+
+@ @<Initiate input from new pseudo file@>=
+begin_file_reading; {set up |cur_file| and new level of input}
+line:=0; limit:=start; loc:=limit+1; {force line read}
+if tracing_scan_tokens>0 then
+ begin if term_offset>max_print_line-3 then print_ln
+ else if (term_offset>0)or(file_offset>0) then print_char(" ");
+ name:=19; print("( "); incr(open_parens); update_terminal;
+ end
+else name:=18
+
+@ Here we read a line from the current pseudo file into |buffer|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+function pseudo_input: boolean; {inputs the next line or returns |false|}
+var p:pointer; {current line from pseudo file}
+@!sz:integer; {size of node |p|}
+@!w:four_quarters; {four ASCII codes}
+@!r:pointer; {loop index}
+begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+p:=info(pseudo_files);
+if p=null then pseudo_input:=false
+else begin info(pseudo_files):=link(p); sz:=ho(info(p));
+ if 4*sz-3>=buf_size-last then
+ @<Report overflow of the input buffer, and abort@>;
+ last:=first;
+ for r:=p+1 to p+sz-1 do
+ begin w:=mem[r].qqqq;
+ buffer[last]:=w.b0; buffer[last+1]:=w.b1;
+ buffer[last+2]:=w.b2; buffer[last+3]:=w.b3;
+ last:=last+4;
+ end;
+ if last>=max_buf_stack then max_buf_stack:=last+1;
+ while (last>first)and(buffer[last-1]=" ") do decr(last);
+ free_node(p,sz);
+ pseudo_input:=true;
+ end;
+end;
+
+@ When we are done with a pseudo file we `close' it.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure pseudo_close; {close the top level pseudo file}
+var p,@!q: pointer;
+begin p:=link(pseudo_files); q:=info(pseudo_files);
+free_avail(pseudo_files); pseudo_files:=p;
+while q<>null do
+ begin p:=q; q:=link(p); free_node(p,ho(info(p)));
+ end;
+end;
+
+@ @<Dump the \eTeX\ state@>=
+while pseudo_files<>null do pseudo_close; {flush pseudo files}
+
+@ @<Generate all \eTeX...@>=
+primitive("readline",read_to_cs,1);@/
+@!@:read_line_}{\.{\\readline} primitive@>
+
+@ @<Cases of |read| for |print_cmd_chr|@>=
+else print_esc("readline")
+
+@ @<Handle \.{\\readline} and |goto done|@>=
+if j=1 then
+ begin while loc<=limit do {current line not yet finished}
+ begin cur_chr:=buffer[loc]; incr(loc);
+ if cur_chr=" " then cur_tok:=space_token
+ @+else cur_tok:=cur_chr+other_token;
+ store_new_token(cur_tok);
+ end;
+ goto done;
+ end
+
+@ Here we define the additional conditionals of \eTeX\ as well as the
+\.{\\unless} prefix.
+
+@d if_def_code=17 { `\.{\\ifdefined}' }
+@d if_cs_code=18 { `\.{\\ifcsname}' }
+@d if_font_char_code=19 { `\.{\\iffontchar}' }
+
+@<Generate all \eTeX...@>=
+primitive("unless",expand_after,1);@/
+@!@:unless_}{\.{\\unless} primitive@>
+primitive("ifdefined",if_test,if_def_code);
+@!@:if_defined_}{\.{\\ifdefined} primitive@>
+primitive("ifcsname",if_test,if_cs_code);
+@!@:if_cs_name_}{\.{\\ifcsname} primitive@>
+primitive("iffontchar",if_test,if_font_char_code);
+@!@:if_font_char_}{\.{\\iffontchar} primitive@>
+
+@ @<Cases of |expandafter| for |print_cmd_chr|@>=
+else print_esc("unless")
+
+@ @<Cases of |if_test| for |print_cmd_chr|@>=
+if_def_code:print_esc("ifdefined");
+if_cs_code:print_esc("ifcsname");
+if_font_char_code:print_esc("iffontchar");
+
+@ The result of a boolean condition is reversed when the conditional is
+preceded by \.{\\unless}.
+
+@<Negate a boolean conditional and |goto reswitch|@>=
+begin get_token;
+if (cur_cmd=if_test)and(cur_chr<>if_case_code) then
+ begin cur_chr:=cur_chr+unless_code; goto reswitch;
+ end;
+print_err("You can't use `"); print_esc("unless"); print("' before `");
+@.You can't use \\unless...@>
+print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+help1("Continue, and I'll forget that it ever happened.");
+back_error;
+end
+
+@ The conditional \.{\\ifdefined} tests if a control sequence is
+defined.
+
+We need to reset |scanner_status|, since \.{\\outer} control sequences
+are allowed, but we might be scanning a macro definition or preamble.
+
+@<Cases for |conditional|@>=
+if_def_code:begin save_scanner_status:=scanner_status;
+ scanner_status:=normal;
+ get_next; b:=(cur_cmd<>undefined_cs);
+ scanner_status:=save_scanner_status;
+ end;
+
+@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter}
+\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new
+control sequence will be entered into the hash table (once all tokens
+preceding the mandatory \.{\\endcsname} have been expanded).
+
+@<Cases for |conditional|@>=
+if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
+ repeat get_x_token;
+ if cur_cs=0 then store_new_token(cur_tok);
+ until cur_cs<>0;
+ if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
+ @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
+ flush_list(n);
+ b:=(eq_type(cur_cs)<>undefined_cs);
+ end;
+
+@ @<Look up the characters of list |n| in the hash table...@>=
+m:=first; p:=link(n);
+while p<>null do
+ begin if m>=max_buf_stack then
+ begin max_buf_stack:=m+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[m]:=info(p) mod @'400; incr(m); p:=link(p);
+ end;
+if m>first+1 then
+ cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|}
+else if m=first then cur_cs:=null_cs {the list is empty}
+else cur_cs:=single_base+buffer[first] {the list has length one}
+
+@ The conditional \.{\\iffontchar} tests the existence of a character in
+a font.
+
+@<Cases for |conditional|@>=
+if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
+ if (font_bc(n)<=cur_val)and(font_ec(n)>=cur_val) then
+ b:=char_exists(char_info(n)(qi(cur_val)))
+ else b:=false;
+ end;
+
+@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
+command for macro definitions. Such macros are protected against
+expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
+or during \.{\\write}.
+
+@<Generate all \eTeX...@>=
+primitive("protected",prefix,8);
+@!@:protected_}{\.{\\protected} primitive@>
+
+@ @<Cases of |prefix| for |print_cmd_chr|@>=
+else if chr_code=8 then print_esc("protected")
+
+@ The |get_x_or_protected| procedure is like |get_x_token| except that
+protected macros are not expanded.
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
+ and expands non-protected macros}
+label exit;
+begin loop@+begin get_token;
+ if cur_cmd<=max_command then return;
+ if (cur_cmd>=call)and(cur_cmd<end_template) then
+ if info(link(cur_chr))=protected_token then return;
+ expand;
+ end;
+exit:end;
+
+@ A group entered (or a conditional started) in one file may end in a
+different file. Such slight anomalies, although perfectly legitimate,
+may cause errors that are difficult to locate. In order to be able to
+give a warning message when such anomalies occur, \eTeX\ uses the
+|grp_stack| and |if_stack| arrays to record the initial |cur_boundary|
+and |cond_ptr| values for each input file.
+
+@<Glob...@>=
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+
+@ When a group ends that was apparently entered in a different input
+file, the |group_warning| procedure is invoked in order to update the
+|grp_stack|. If moreover \.{\\tracingnesting} is positive we want to
+give a warning message. The situation is, however, somewhat complicated
+by two facts: (1)~There may be |grp_stack| elements without a
+corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g.,
+error insertions from the terminal); and (2)~the relevant information is
+recorded in the |name_field| of the |input_stack| only loosely
+synchronized with the |in_open| variable indexing |grp_stack|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure group_warning;
+var i:0..max_in_open; {index into |grp_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ {store current state}
+i:=in_open; w:=false;
+while (grp_stack[i]=cur_boundary)and(i>0) do
+ begin @<Set variable |w| to indicate if this case should be reported@>;
+ grp_stack[i]:=save_index(save_ptr); decr(i);
+ end;
+if w then
+ begin print_nl("Warning: end of "); print_group(true);
+@.Warning: end of...@>
+ print(" of a different file"); print_ln;
+ if tracing_nesting>1 then show_context;
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+
+@ This code scans the input stack in order to determine the type of the
+current input file.
+
+@<Set variable |w| to...@>=
+if tracing_nesting>0 then
+ begin while (input_stack[base_ptr].state_field=token_list)or@|
+ (input_stack[base_ptr].index_field>i) do decr(base_ptr);
+ if input_stack[base_ptr].name_field>17 then w:=true;
+ end
+
+@ When a conditional ends that was apparently started in a different
+input file, the |if_warning| procedure is invoked in order to update the
+|if_stack|. If moreover \.{\\tracingnesting} is positive we want to
+give a warning message (with the same complications as above).
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure if_warning;
+var i:0..max_in_open; {index into |if_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ {store current state}
+i:=in_open; w:=false;
+while if_stack[i]=cond_ptr do
+ begin @<Set variable |w| to...@>;
+ if_stack[i]:=link(cond_ptr); decr(i);
+ end;
+if w then
+ begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if);
+@.Warning: end of...@>
+ print_if_line(if_line); print(" of a different file"); print_ln;
+ if tracing_nesting>1 then show_context;
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+
+@ Conversely, the |file_warning| procedure is invoked when a file ends
+and some groups entered or conditionals started while reading from that
+file are still incomplete.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure file_warning;
+var p:pointer; {saved value of |save_ptr| or |cond_ptr|}
+@!l:quarterword; {saved value of |cur_level| or |if_limit|}
+@!c:quarterword; {saved value of |cur_group| or |cur_if|}
+@!i:integer; {saved value of |if_line|}
+begin p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary;
+while grp_stack[in_open]<>save_ptr do
+ begin decr(cur_level);
+ print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+ print_group(true); print(" is incomplete");@/
+ cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+ end;
+save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values}
+p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line;
+while if_stack[in_open]<>cond_ptr do
+ begin print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+ print_cmd_chr(if_test,cur_if);
+ if if_limit=fi_code then print_esc("else");
+ print_if_line(if_line); print(" is incomplete");@/
+ if_line:=if_line_field(cond_ptr); cur_if:=subtype(cond_ptr);
+ if_limit:=type(cond_ptr); cond_ptr:=link(cond_ptr);
+ end;
+cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values}
+print_ln;
+if tracing_nesting>1 then show_context;
+if history=spotless then history:=warning_issued;
+end;
+
+@ Here are the additional \eTeX\ primitives for expressions.
+
+@<Generate all \eTeX...@>=
+primitive("numexpr",last_item,eTeX_expr-int_val+int_val);
+@!@:num_expr_}{\.{\\numexpr} primitive@>
+primitive("dimexpr",last_item,eTeX_expr-int_val+dimen_val);
+@!@:dim_expr_}{\.{\\dimexpr} primitive@>
+primitive("glueexpr",last_item,eTeX_expr-int_val+glue_val);
+@!@:glue_expr_}{\.{\\glueexpr} primitive@>
+primitive("muexpr",last_item,eTeX_expr-int_val+mu_val);
+@!@:mu_expr_}{\.{\\muexpr} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+eTeX_expr-int_val+int_val: print_esc("numexpr");
+eTeX_expr-int_val+dimen_val: print_esc("dimexpr");
+eTeX_expr-int_val+glue_val: print_esc("glueexpr");
+eTeX_expr-int_val+mu_val: print_esc("muexpr");
+
+@ This code for reducing |cur_val_level| and\slash or negating the
+result is similar to the one for all the other cases of
+|scan_something_internal|, with the difference that |scan_expr| has
+already increased the reference count of a glue specification.
+
+@<Process an expression and |return|@>=
+begin if m<eTeX_mu then
+ begin case m of
+ @/@<Cases for fetching a glue value@>@/
+ end; {there are no other cases}
+ cur_val_level:=glue_val;
+ end
+else if m<eTeX_expr then
+ begin case m of
+ @/@<Cases for fetching a mu value@>@/
+ end; {there are no other cases}
+ cur_val_level:=mu_val;
+ end
+else begin cur_val_level:=m-eTeX_expr+int_val; scan_expr;
+ end;
+while cur_val_level>level do
+ begin if cur_val_level=glue_val then
+ begin m:=cur_val; cur_val:=width(m); delete_glue_ref(m);
+ end
+ else if cur_val_level=mu_val then mu_error;
+ decr(cur_val_level);
+ end;
+if negative then
+ if cur_val_level>=glue_val then
+ begin m:=cur_val; cur_val:=new_spec(m); delete_glue_ref(m);
+ @<Negate all three glue components of |cur_val|@>;
+ end
+ else negate(cur_val);
+return;
+end
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_expr; forward;@t\2@>
+
+@ The |scan_expr| procedure scans and evaluates an expression.
+
+@<Declare procedures needed for expressions@>=
+@t\4@>@<Declare subprocedures for |scan_expr|@>
+procedure scan_expr; {scans and evaluates an expression}
+label restart, continue, found;
+var a,@!b:boolean; {saved values of |arith_error|}
+@!l:small_number; {type of expression}
+@!r:small_number; {state of expression so far}
+@!s:small_number; {state of term so far}
+@!o:small_number; {next operation or type of next factor}
+@!e:integer; {expression so far}
+@!t:integer; {term so far}
+@!f:integer; {current factor}
+@!n:integer; {numerator of combined multiplication and division}
+@!p:pointer; {top of expression stack}
+@!q:pointer; {for stack manipulations}
+begin l:=cur_val_level; a:=arith_error; b:=false; p:=null;
+@<Scan and evaluate an expression |e| of type |l|@>;
+if b then
+ begin print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+ help2("I can't evaluate this expression,")@/
+ ("since the result is out of range.");
+ error;
+ if l>=glue_val then
+ begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e);
+ end
+ else e:=0;
+ end;
+arith_error:=a; cur_val:=e; cur_val_level:=l;
+end;
+
+@ Evaluating an expression is a recursive process: When the left
+parenthesis of a subexpression is scanned we descend to the next level
+of recursion; the previous level is resumed with the matching right
+parenthesis.
+
+@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen}
+@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen}
+@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen}
+@d expr_mult=3 {$\langle\it term\rangle$ \.* seen}
+@d expr_div=4 {$\langle\it term\rangle$ \./ seen}
+@d expr_scale=5 {$\langle\it term\rangle$ \.*
+ $\langle\it factor\rangle$ \./ seen}
+
+@<Scan and eval...@>=
+restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0;
+continue: if s=expr_none then o:=l@+else o:=int_val;
+@<Scan a factor |f| of type |o| or start a subexpression@>;
+found: @<Scan the next operator and set |o|@>;
+arith_error:=b;
+@<Make sure that |f| is in the proper range@>;
+case s of @<Cases for evaluation of the current term@>@;
+end; {there are no other cases}
+if o>expr_sub then s:=o@+else @<Evaluate the current expression@>;
+b:=arith_error;
+if o<>expr_none then goto continue;
+if p<>null then @<Pop the expression stack and |goto found|@>
+
+@ @<Scan the next op...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"+" then o:=expr_add
+else if cur_tok=other_token+"-" then o:=expr_sub
+else if cur_tok=other_token+"*" then o:=expr_mult
+else if cur_tok=other_token+"/" then o:=expr_div
+else begin o:=expr_none;
+ if p=null then
+ begin if cur_cmd<>relax then back_input;
+ end
+ else if cur_tok<>other_token+")" then
+ begin print_err("Missing ) inserted for expression");
+@.Missing ) inserted@>
+ help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't.");
+ back_error;
+ end;
+ end
+
+@ @<Scan a factor...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"(" then
+ @<Push the expression stack and |goto restart|@>;
+back_input;
+if o=int_val then scan_int
+else if o=dimen_val then scan_normal_dimen
+else if o=glue_val then scan_normal_glue
+else scan_mu_glue;
+f:=cur_val
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_normal_glue; forward;@t\2@>@/
+procedure@?scan_mu_glue; forward;@t\2@>
+
+@ Here we declare to trivial procedures in order to avoid mutually
+recursive procedures with parameters.
+
+@<Declare procedures needed for expressions@>=
+procedure scan_normal_glue;
+begin scan_glue(glue_val);
+end;
+@#
+procedure scan_mu_glue;
+begin scan_glue(mu_val);
+end;
+
+@ Parenthesized subexpressions can be inside expressions, and this
+nesting has a stack. Seven local variables represent the top of the
+expression stack: |p| points to pushed-down entries, if any; |l|
+specifies the type of expression currently beeing evaluated; |e| is the
+expression so far and |r| is the state of its evaluation; |t| is the
+term so far and |s| is the state of its evaluation; finally |n| is the
+numerator for a combined multiplication and division, if any.
+
+@d expr_node_size=4 {number of words in stack entry for subexpressions}
+@d expr_e_field(#)==mem[#+1].int {saved expression so far}
+@d expr_t_field(#)==mem[#+2].int {saved term so far}
+@d expr_n_field(#)==mem[#+3].int {saved numerator}
+
+@<Push the expression...@>=
+begin q:=get_node(expr_node_size); link(q):=p; type(q):=l;
+subtype(q):=4*s+r;
+expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n;
+p:=q; l:=o; goto restart;
+end
+
+@ @<Pop the expression...@>=
+begin f:=e; q:=p;
+e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q);
+s:=subtype(q) div 4; r:=subtype(q) mod 4;
+l:=type(q); p:=link(q); free_node(q,expr_node_size);
+goto found;
+end
+
+@ We want to make sure that each term and (intermediate) result is in
+the proper range. Integer values must not exceed |infinity|
+($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen|
+($2^{30}-1$). We avoid the absolute value of an integer, because this
+might fail for the value $-2^{31}$ using 32-bit arithmetic.
+
+@d num_error(#)== {clear a number or dimension and set |arith_error|}
+ begin arith_error:=true; #:=0;
+ end
+@d glue_error(#)== {clear a glue spec and set |arith_error|}
+ begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue);
+ end
+
+@<Make sure that |f|...@>=
+if (l=int_val)or(s>expr_sub) then
+ begin if (f>infinity)or(f<-infinity) then num_error(f);
+ end
+else if l=dimen_val then
+ begin if abs(f)>max_dimen then num_error(f);
+ end
+else begin if (abs(width(f))>max_dimen)or@|
+ (abs(stretch(f))>max_dimen)or@|
+ (abs(shrink(f))>max_dimen) then glue_error(f);
+ end
+
+@ Applying the factor |f| to the partial term |t| (with the operator
+|s|) is delayed until the next operator |o| has been scanned. Here we
+handle the first factor of a partial term. A glue spec has to be copied
+unless the next operator is a right parenthesis; this allows us later on
+to simply modify the glue components.
+
+@d normalize_glue(#)==
+ if stretch(#)=0 then stretch_order(#):=normal;
+ if shrink(#)=0 then shrink_order(#):=normal
+
+@<Cases for evaluation of the current term@>=
+expr_none: if (l>=glue_val)and(o<>expr_none) then
+ begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t);
+ end
+ else t:=f;
+
+@ When a term |t| has been completed it is copied to, added to, or
+subtracted from the expression |e|.
+
+@d expr_add_sub(#)==add_or_sub(#,r=expr_sub)
+@d expr_a(#)==expr_add_sub(#,max_dimen)
+
+@<Evaluate the current expression@>=
+begin s:=expr_none;
+if r=expr_none then e:=t
+else if l=int_val then e:=expr_add_sub(e,t,infinity)
+else if l=dimen_val then e:=expr_a(e,t)
+else @<Compute the sum or difference of two glue specs@>;
+r:=o;
+end
+
+@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum
+(for |negative=false|) or difference (for |negative=true|) of |x| and
+|y|, provided the absolute value of the result does not exceed
+|max_answer|.
+
+@<Declare subprocedures for |scan_expr|@>=
+function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer;
+var a:integer; {the answer}
+begin if negative then negate(y);
+if x>=0 then
+ if y<=max_answer-x then a:=x+y@+else num_error(a)
+else if y>=-max_answer-x then a:=x+y@+else num_error(a);
+add_or_sub:=a;
+end;
+
+@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and
+|shrink_order(e)>normal| implies |shrink(e)<>0|.
+
+@<Compute the sum or diff...@>=
+begin width(e):=expr_a(width(e),width(t));
+if stretch_order(e)=stretch_order(t) then
+ stretch(e):=expr_a(stretch(e),stretch(t))
+else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then
+ begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t);
+ end;
+if shrink_order(e)=shrink_order(t) then
+ shrink(e):=expr_a(shrink(e),shrink(t))
+else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then
+ begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t);
+ end;
+delete_glue_ref(t); normalize_glue(e);
+end
+
+@ If a multiplication is followed by a division, the two operations are
+combined into a `scaling' operation. Otherwise the term |t| is
+multiplied by the factor |f|.
+
+@d expr_m(#)==#:=nx_plus_y(#,f,0)
+
+@<Cases for evaluation of the current term@>=
+expr_mult: if o=expr_div then
+ begin n:=f; o:=expr_scale;
+ end
+ else if l=int_val then t:=mult_integers(t,f)
+ else if l=dimen_val then expr_m(t)
+ else begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t));
+ end;
+
+@ Here we divide the term |t| by the factor |f|.
+
+@d expr_d(#)==#:=quotient(#,f)
+
+@<Cases for evaluation of the current term@>=
+expr_div: if l<glue_val then expr_d(t)
+ else begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t));
+ end;
+
+@ The function |quotient(n,d)| computes the rounded quotient
+$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive.
+
+@<Declare subprocedures for |scan_expr|@>=
+function quotient(@!n,@!d:integer):integer;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+begin if d=0 then num_error(a)
+else begin if d>0 then negative:=false
+ else begin negate(d); negative:=true;
+ end;
+ if n<0 then
+ begin negate(n); negative:=not negative;
+ end;
+ a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!}
+ if d+n>=0 then incr(a);
+ if negative then negate(a);
+ end;
+quotient:=a;
+end;
+
+@ Here the term |t| is multiplied by the quotient $n/f$.
+
+@d expr_s(#)==#:=fract(#,n,f,max_dimen)
+
+@<Cases for evaluation of the current term@>=
+expr_scale: if l=int_val then t:=fract(t,n,f,infinity)
+ else if l=dimen_val then expr_s(t)
+ else begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t));
+ end;
+
+@ Finally, the function |fract(x,n,d,max_answer)| computes the integer
+$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive
+and the result does not exceed |max_answer|. We can't use floating
+point arithmetic since the routine must produce identical results in all
+cases; and it would be too dangerous to multiply by~|n| and then divide
+by~|d|, in separate operations, since overflow might well occur. Hence
+this subroutine simulates double precision arithmetic, somewhat
+analogous to \MF's |make_fraction| and |take_fraction| routines.
+
+@d too_big=88 {go here when the result is too big}
+
+@<Declare subprocedures for |scan_expr|@>=
+function fract(@!x,@!n,@!d,@!max_answer:integer):integer;
+label found, found1, too_big, done;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+@!f:integer; {a proper fraction}
+@!h:integer; {smallest integer such that |2*h>=d|}
+@!r:integer; {intermediate remainder}
+@!t:integer; {temp variable}
+begin if d=0 then goto too_big;
+a:=0;
+if d>0 then negative:=false
+else begin negate(d); negative:=true;
+ end;
+if x<0 then
+ begin negate(x); negative:=not negative;
+ end
+else if x=0 then goto done;
+if n<0 then
+ begin negate(n); negative:=not negative;
+ end;
+t:=n div d;
+if t>max_answer div x then goto too_big;
+a:=t*x; n:=n-t*d;
+if n=0 then goto found;
+t:=x div d;
+if t>(max_answer-a) div n then goto too_big;
+a:=a+t*n; x:=x-t*d;
+if x=0 then goto found;
+if x<n then
+ begin t:=x; x:=n; n:=t;
+ end; {now |0<n<=x<d|}
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@;
+if f>(max_answer-a) then goto too_big;
+a:=a+f;
+found: if negative then negate(a);
+goto done;
+too_big: num_error(a);
+done: fract:=a;
+end;
+
+@ The loop here preserves the following invariant relations
+between |f|, |x|, |n|, and~|r|:
+(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$;
+(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$
+and $n$.
+
+Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|,
+because the latter could overflow.
+
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>=
+f:=0; r:=(d div 2)-d; h:=-r;
+loop@+begin if odd(n) then
+ begin r:=r+x;
+ if r>=0 then
+ begin r:=r-d; incr(f);
+ end;
+ end;
+ n:=n div 2;
+ if n=0 then goto found1;
+ if x<h then x:=x+x
+ else begin t:=x-d; x:=t+x; f:=f+n;
+ if x<n then
+ begin if x=0 then goto found1;
+ t:=x; x:=n; n:=t;
+ end;
+ end;
+ end;
+found1:
+
+@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and
+\.{\\glueshrinkorder} commands return the stretch and shrink components
+and their orders of ``infinity'' of a glue specification.
+
+@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}}
+@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}}
+@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}}
+@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}}
+
+@<Generate all \eTeX...@>=
+primitive("gluestretchorder",last_item,glue_stretch_order_code);
+@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@>
+primitive("glueshrinkorder",last_item,glue_shrink_order_code);
+@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@>
+primitive("gluestretch",last_item,glue_stretch_code);
+@!@:glue_stretch_}{\.{\\gluestretch} primitive@>
+primitive("glueshrink",last_item,glue_shrink_code);
+@!@:glue_shrink_}{\.{\\glueshrink} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+glue_stretch_order_code: print_esc("gluestretchorder");
+glue_shrink_order_code: print_esc("glueshrinkorder");
+glue_stretch_code: print_esc("gluestretch");
+glue_shrink_code: print_esc("glueshrink");
+
+@ @<Cases for fetching an integer value@>=
+glue_stretch_order_code, glue_shrink_order_code:
+ begin scan_normal_glue; q:=cur_val;
+ if m=glue_stretch_order_code then cur_val:=stretch_order(q)
+ else cur_val:=shrink_order(q);
+ delete_glue_ref(q);
+ end;
+
+@ @<Cases for fetching a dimension value@>=
+glue_stretch_code, glue_shrink_code:
+ begin scan_normal_glue; q:=cur_val;
+ if m=glue_stretch_code then cur_val:=stretch(q)
+ else cur_val:=shrink(q);
+ delete_glue_ref(q);
+ end;
+
+@ The \.{\\mutoglue} and \.{\\gluetomu} commands convert ``math'' glue
+into normal glue and vice versa; they allow to manipulate math glue with
+\.{\\gluestretch} etc.
+
+@d mu_to_glue_code=eTeX_glue {code for \.{\\mutoglue}}
+@d glue_to_mu_code=eTeX_mu {code for \.{\\gluetomu}}
+
+@<Generate all \eTeX...@>=
+primitive("mutoglue",last_item,mu_to_glue_code);
+@!@:mu_to_glue_}{\.{\\mutoglue} primitive@>
+primitive("gluetomu",last_item,glue_to_mu_code);
+@!@:glue_to_mu_}{\.{\\gluetomu} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+mu_to_glue_code: print_esc("mutoglue");
+glue_to_mu_code: print_esc("gluetomu");
+
+@ @<Cases for fetching a glue value@>=
+mu_to_glue_code: scan_mu_glue;
+
+@ @<Cases for fetching a mu value@>=
+glue_to_mu_code: scan_normal_glue;
+
+{ FIXME: next chapter is about sparse arrays; how does it cope with Omega? }
+
+@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
+dimen, skip, muskip, box, and token registers. As in \TeX\ the first
+256 registers of each kind are realized as arrays in the table of
+equivalents; the additional registers are realized as tree structures
+built from variable-size nodes with individual registers existing only
+when needed. Default values are used for nonexistent registers: zero
+for count and dimen values, |zero_glue| for glue (skip and muskip)
+values, void for boxes, and |null| for token lists (and current marks
+discussed below).
+
+Similarly there are 32768 mark classes; the command \.{\\marks}|n|
+creates a mark node for a given mark class |0<=n<=32767| (where
+\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
+the |fire_up| routine) and the |vsplit| routine maintain the current
+values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
+|split_bot_mark| for each mark class. They are accessed as
+\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
+\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
+are realized as |cur_mark| array. The additional current marks are
+again realized as tree structure with individual mark classes existing
+only when needed.
+
+@<Generate all \eTeX...@>=
+primitive("marks",mark,marks_code);
+@!@:marks_}{\.{\\marks} primitive@>
+primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
+@!@:top_marks_}{\.{\\topmarks} primitive@>
+primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
+@!@:first_marks_}{\.{\\firstmarks} primitive@>
+primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
+@!@:bot_marks_}{\.{\\botmarks} primitive@>
+primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
+@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
+primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
+@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
+
+@ The |scan_register_num| procedure scans a register number that must
+not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?scan_register_num; forward;@t\2@>
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>max_reg_num) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2(max_reg_help_line)("I changed this one to zero.");
+ int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Initialize variables for \eTeX\ comp...@>=
+max_reg_num:=255;
+max_reg_help_line:="A register number must be between 0 and 255.";
+
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+
+@ @<Glob...@>=
+@!max_reg_num: halfword; {largest allowed register number}
+@!max_reg_help_line: str_number; {first line of help message}
+
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@#
+@d index_node_size=9 {size of an index node}
+@d sa_index==type {a four-bit address or a type or both}
+@d sa_used==subtype {count of non-null pointers}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure new_index(@!i:quarterword; @!q:pointer);
+var k:small_number; {loop index}
+begin cur_ptr:=get_node(index_node_size); sa_index(cur_ptr):=i;
+sa_used(cur_ptr):=0; link(cur_ptr):=q;
+for k:=1 to index_node_size-1 do {clear all 16 pointers}
+ mem[cur_ptr+k]:=sa_null;
+end;
+
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then set_equiv(box_base+cur_val,#)@+else set_sa_box(#)
+@#
+
+{ FIXME: needs debugging (sparse arrays) }
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ Here we compute the pointer to the current mark of type |t| and mark
+class |cur_val|.
+
+@<Compute the mark pointer...@>=
+begin find_sa_element(mark_val,cur_val,false);
+if cur_ptr<>null then
+ if odd(t) then cur_ptr:=link(cur_ptr+(t div 2)+1)
+ else cur_ptr:=info(cur_ptr+(t div 2)+1);
+end
+
+@ The current marks for all mark classes are maintained by the |vsplit|
+and |fire_up| routines and are finally destroyed (for \.{INITEX} only)
+@.INITEX@>
+by the |final_cleanup| routine. Apart from updating the current marks
+when mark nodes are encountered, these routines perform certain actions
+on all existing mark classes. The recursive |do_marks| procedure walks
+through the whole tree or a subtree of existing mark class nodes and
+preforms certain actions indicted by its first parameter |a|, the action
+code. The second parameter |l| indicates the level of recursion (at
+most four); the third parameter points to a nonempty tree or subtree.
+The result is |true| if the complete tree or subtree has been deleted.
+
+@d vsplit_init==0 {action code for |vsplit| initialization}
+@d fire_up_init==1 {action code for |fire_up| initialization}
+@d fire_up_done==2 {action code for |fire_up| completion}
+@d destroy_marks==3 {action code for |final_cleanup|}
+@#
+@d sa_top_mark(#)==info(#+1) {\.{\\topmarks}|n|}
+@d sa_first_mark(#)==link(#+1) {\.{\\firstmarks}|n|}
+@d sa_bot_mark(#)==info(#+2) {\.{\\botmarks}|n|}
+@d sa_split_first_mark(#)==link(#+2) {\.{\\splitfirstmarks}|n|}
+@d sa_split_bot_mark(#)==info(#+3) {\.{\\splitbotmarks}|n|}
+
+@<Declare the function called |do_marks|@>=
+function do_marks(@!a,@!l:small_number;@!q:pointer):boolean;
+var i:small_number; {a four bit index}
+begin if l<4 then {|q| is an index node}
+ begin for i:=0 to 15 do
+ begin get_sa_ptr;
+ if cur_ptr<>null then if do_marks(a,l+1,cur_ptr) then delete_sa_ptr;
+ end;
+ if sa_used(q)=0 then
+ begin free_node(q,index_node_size); q:=null;
+ end;
+ end
+else {|q| is the node for a mark class}
+ begin case a of
+ @<Cases for |do_marks|@>@;
+ end; {there are no other cases}
+ if sa_bot_mark(q)=null then if sa_split_bot_mark(q)=null then
+ begin free_node(q,mark_class_node_size); q:=null;
+ end;
+ end;
+do_marks:=(q=null);
+end;
+
+@ At the start of the |vsplit| routine the existing |split_fist_mark|
+and |split_bot_mark| are discarded.
+
+@<Cases for |do_marks|@>=
+vsplit_init: if sa_split_first_mark(q)<>null then
+ begin delete_token_ref(sa_split_first_mark(q)); sa_split_first_mark(q):=null;
+ delete_token_ref(sa_split_bot_mark(q)); sa_split_bot_mark(q):=null;
+ end;
+
+@ We use again the fact that |split_first_mark=null| if and only if
+|split_bot_mark=null|.
+
+@<Update the current marks for |vsplit|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_split_first_mark(cur_ptr)=null then
+ begin sa_split_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end
+else delete_token_ref(sa_split_bot_mark(cur_ptr));
+sa_split_bot_mark(cur_ptr):=mark_ptr(p);
+add_token_ref(mark_ptr(p));
+end
+
+@ At the start of the |fire_up| routine the old |top_mark| and
+|first_mark| are discarded, whereas the old |bot_mark| becomes the new
+|top_mark|. An empty new |top_mark| token list is, however, discarded
+as well in order that mark class nodes can eventually be released. We
+use again the fact that |bot_mark<>null| implies |first_mark<>null|; it
+also knows that |bot_mark=null| implies |top_mark=first_mark=null|.
+
+@<Cases for |do_marks|@>=
+fire_up_init: if sa_bot_mark(q)<>null then
+ begin if sa_top_mark(q)<>null then delete_token_ref(sa_top_mark(q));
+ delete_token_ref(sa_first_mark(q)); sa_first_mark(q):=null;
+ if link(sa_bot_mark(q))=null then {an empty token list}
+ begin delete_token_ref(sa_bot_mark(q)); sa_bot_mark(q):=null;
+ end
+ else add_token_ref(sa_bot_mark(q));
+ sa_top_mark(q):=sa_bot_mark(q);
+ end;
+
+@ @<Cases for |do_marks|@>=
+fire_up_done: if (sa_top_mark(q)<>null)and(sa_first_mark(q)=null) then
+ begin sa_first_mark(q):=sa_top_mark(q); add_token_ref(sa_top_mark(q));
+ end;
+
+@ @<Update the current marks for |fire_up|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_first_mark(cur_ptr)=null then
+ begin sa_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end;
+if sa_bot_mark(cur_ptr)<>null then delete_token_ref(sa_bot_mark(cur_ptr));
+sa_bot_mark(cur_ptr):=mark_ptr(p); add_token_ref(mark_ptr(p));
+end
+
+@ Here we use the fact that the five current mark pointers in a mark
+class node occupy the same locations as the first five pointers of
+an index node. For systems using a run-time switch to distinguish
+between \.{VIRTEX} and \.{INITEX}, the codewords `$|init|\ldots|tini|$'
+surrounding the following piece of code should be removed.
+@.INITEX@>
+@^system dependencies@>
+
+@<Cases for |do_marks|@>=
+@!init destroy_marks: for i:=top_mark_code to split_bot_mark_code do
+ begin get_sa_ptr;
+ if cur_ptr<>null then
+ begin delete_token_ref(cur_ptr); put_sa_ptr(null);
+ end;
+ end;
+tini
+
+@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
+etc., as well as for references to sparse array elements defined by
+`\.{\\countdef}', etc.
+
+@<Cases of |register| for |print_cmd_chr|@>=
+begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
+ cmd:=sa_type(chr_code)
+else begin cmd:=chr_code-mem_bot; chr_code:=null;
+ end;
+if cmd=int_val then print_esc("count")
+else if cmd=dimen_val then print_esc("dimen")
+else if cmd=glue_val then print_esc("skip")
+else print_esc("muskip");
+if chr_code<>null then print_sa_num(chr_code);
+end
+
+@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
+well as for references to sparse array elements defined by
+`\.{\\toksdef}'.
+
+@<Cases of |toks_register| for |print_cmd_chr|@>=
+begin print_esc("toks");
+if chr_code<>mem_bot then print_sa_num(chr_code);
+end
+
+@ When a shorthand definition for an element of one of the sparse arrays
+is destroyed, we must reduce the reference count.
+
+@<Cases for |eq_destroy|@>=
+toks_register,register:
+ if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
+ delete_sa_ref(equiv_field(w));
+
+@ The task to maintain (change, save, and restore) register values is
+essentially the same when the register is realized as sparse array
+element or entry in |eqtb|. The global variable |sa_chain| is the head
+of a linked list of entries saved at the topmost level |sa_level|; the
+lists for lowel levels are kept in special save stack entries.
+
+@<Glob...@>=
+@!sa_chain: pointer; {chain of saved sparse array entries}
+@!sa_level: quarterword; {group level for |sa_chain|}
+
+@ @<Set init...@>=
+sa_chain:=null; sa_level:=level_zero;
+
+@ The individual saved items are kept in pointer or word nodes similar
+to those used for the array elements: a word node with value zero is,
+however, saved as pointer node with the otherwise impossible |sa_index|
+value |tok_val_limit|.
+
+@d sa_loc==sa_ref {location of saved item}
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+
+@ The procedure |sa_def| assigns a new value to sparse array elements,
+and saves the former value if appropriate. This procedure is used only
+for skip, muskip, box, and token list registers. The counterpart of
+|sa_def| for count and dimen registers is called |sa_w_def|.
+
+@d sa_define(#)==if e then
+ if global then gsa_def(#)@+else sa_def(#)
+ else define
+@#
+@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
+ begin find_sa_element(box_val,cur_val,true);
+ if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
+ end
+@#
+@d sa_word_define(#)==if e then
+ if global then gsa_w_def(#)@+else sa_w_def(#)
+ else word_define(#)
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_def(@!p:pointer;@!e:halfword);
+ {new data for sparse array elements}
+begin add_sa_ref(p);
+if sa_ptr(p)=e then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ sa_destroy(p);
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
+ sa_lev(p):=cur_level; sa_ptr(p):=e;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+@#
+procedure sa_w_def(@!p:pointer;@!w:integer);
+begin add_sa_ref(p);
+if sa_int(p)=w then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)<>cur_level then sa_save(p);
+ sa_lev(p):=cur_level; sa_int(p):=w;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+
+@ The |sa_def| and |sa_w_def| routines take care of local definitions.
+@^global definitions@>
+Global definitions are done in almost the same way, but there is no need
+to save old values, and the new value is associated with |level_one|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+@#
+procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_lev(p):=level_one; sa_int(p):=w;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+
+@ The |sa_restore| procedure restores the sparse array entries pointed
+at by |sa_chain|
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+
+{FIXME: |last_line_fit| might be incompatible with Omega}
+
+@ When the value of |last_line_fit| is positive, the last line of a
+(partial) paragraph is treated in a special way and we need additional
+fields in the active nodes.
+
+@d active_node_size_extended=5 {number of words in extended active nodes}
+@d active_short(#)==mem[#+3].sc {|shortfall| of this line}
+@d active_glue(#)==mem[#+4].sc {corresponding glue stretch or shrink}
+
+@<Glob...@>=
+@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph}
+@!do_last_line_fit:boolean; {special algorithm for last line of paragraph?}
+@!active_node_size:small_number; {number of words in active nodes}
+@!fill_width:array[0..2] of scaled; {infinite stretch components of
+ |par_fill_skip|}
+@!best_pl_short:array[very_loose_fit..tight_fit] of scaled; {|shortfall|
+ corresponding to |minimal_demerits|}
+@!best_pl_glue:array[very_loose_fit..tight_fit] of scaled; {corresponding
+ glue stretch or shrink}
+
+@ The new algorithm for the last line requires that the stretchability
+|par_fill_skip| is infinite and the stretchability of |left_skip| plus
+|right_skip| is finite.
+
+@<Check for special...@>=
+do_last_line_fit:=false; active_node_size:=active_node_size_normal;
+ {just in case}
+if last_line_fit>0 then
+ begin q:=glue_ptr(last_line_fill);
+ if (stretch(q)>0)and(stretch_order(q)>normal) then
+ if (background[3]=0)and(background[4]=0)and(background[5]=0) then
+ begin do_last_line_fit:=true;
+ active_node_size:=active_node_size_extended;
+ fill_width[0]:=0; fill_width[1]:=0; fill_width[2]:=0;
+ fill_width[stretch_order(q)-1]:=stretch(q);
+ end;
+ end
+
+@ @<Other local variables for |try_break|@>=
+@!g:scaled; {glue stretch or shrink of test line, adjustment for last line}
+
+@ Here we initialize the additional fields of the first active node
+representing the beginning of the paragraph.
+
+@<Initialize additional fields of the first active node@>=
+begin active_short(q):=0; active_glue(q):=0;
+end
+
+@ Here we compute the adjustment |g| and badness |b| for a line from |r|
+to the end of the paragraph. When any of the criteria for adjustment is
+violated we fall through to the normal algorithm.
+
+The last line must be too short, and have infinite stretch entirely due
+to |par_fill_skip|.
+
+@<Perform computations for last line and |goto found|@>=
+begin if (active_short(r)=0)or(active_glue(r)<=0) then goto not_found;
+ {previous line was neither stretched nor shrunk, or was infinitely bad}
+if (cur_active_width[3]<>fill_width[0])or@|
+ (cur_active_width[4]<>fill_width[1])or@|
+ (cur_active_width[5]<>fill_width[2]) then goto not_found;
+ {infinite stretch of this line not entirely due to |par_fill_skip|}
+if active_short(r)>0 then g:=cur_active_width[2]
+else g:=cur_active_width[6];
+if g<=0 then goto not_found; {no finite stretch resp.\ no shrink}
+arith_error:=false; g:=fract(g,active_short(r),active_glue(r),max_dimen);
+if last_line_fit<1000 then g:=fract(g,last_line_fit,1000,max_dimen);
+if arith_error then
+ if active_short(r)>0 then g:=max_dimen@+else g:=-max_dimen;
+if g>0 then
+ @<Set the value of |b| to the badness of the last line for stretching,
+ compute the corresponding |fit_class, and |goto found||@>
+else if g<0 then
+ @<Set the value of |b| to the badness of the last line for shrinking,
+ compute the corresponding |fit_class, and |goto found||@>;
+not_found:end
+
+@ These badness computations are rather similar to those of the standard
+algorithm, with the adjustment amount |g| replacing the |shortfall|.
+
+@<Set the value of |b| to the badness of the last line for str...@>=
+begin if g>shortfall then g:=shortfall;
+if g>7230584 then if cur_active_width[2]<1663497 then
+ begin b:=inf_bad; fit_class:=very_loose_fit; goto found;
+ end;
+b:=badness(g,cur_active_width[2]);
+if b>12 then
+ if b>99 then fit_class:=very_loose_fit
+ else fit_class:=loose_fit
+else fit_class:=decent_fit;
+goto found;
+end
+
+@ @<Set the value of |b| to the badness of the last line for shr...@>=
+begin if -g>cur_active_width[6] then g:=-cur_active_width[6];
+b:=badness(-g,cur_active_width[6]);
+if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
+goto found;
+end
+
+@ Vanishing values of |shortfall| and |g| indicate that the last line is
+not adjusted.
+
+@<Adjust \(t)the additional data for last line@>=
+begin if cur_p=null then shortfall:=0;
+if shortfall>0 then g:=cur_active_width[2]
+else if shortfall<0 then g:=cur_active_width[6]
+else g:=0;
+end
+
+@ For each feasible break we record the shortfall and glue stretch or
+shrink (or adjustment).
+
+@<Store \(a)additional data for this feasible break@>=
+begin best_pl_short[fit_class]:=shortfall; best_pl_glue[fit_class]:=g;
+end
+
+@ Here we save these data in the active node representing a potential
+line break.
+
+@<Store \(a)additional data in the new active node@>=
+begin active_short(q):=best_pl_short[fit_class];
+active_glue(q):=best_pl_glue[fit_class];
+end
+
+@ @<Print additional data in the new active node@>=
+begin print(" s="); print_scaled(active_short(q));
+if cur_p=null then print(" a=")@+else print(" g=");
+print_scaled(active_glue(q));
+end
+
+@ Here we either reset |do_last_line_fit| or adjust the |par_fill_skip|
+glue.
+
+@<Adjust \(t)the final line of the paragraph@>=
+if active_short(best_bet)=0 then do_last_line_fit:=false
+else begin q:=new_spec(glue_ptr(last_line_fill));
+ delete_glue_ref(glue_ptr(last_line_fill));
+ width(q):=width(q)+active_short(best_bet)-active_glue(best_bet);
+ stretch(q):=0; glue_ptr(last_line_fill):=q;
+ end
+
+@ When reading \.{\\patterns} while \.{\\savinghyphcodes} is positive
+the current |lc_code| values are stored together with the hyphenation
+patterns for the current language. They will later be used instead of
+the |lc_code| values for hyphenation purposes.
+
+The |lc_code| values are stored in the linked trie analogous to patterns
+$p_1$ of length~1, with |hyph_root=trie_r[0]| replacing |trie_root| and
+|lc_code(p_1)| replacing the |trie_op| code. This allows to compress
+and pack them together with the patterns with minimal changes to the
+existing code.
+
+@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|}
+
+@<Initialize table entries...@>=
+hyph_root:=0; hyph_start:=0;
+
+@ @<Store hyphenation codes for current language@>=
+begin c:=cur_lang; first_child:=false; p:=0;
+repeat q:=p; p:=trie_r[q];
+until (p=0)or(c<=so(trie_c[p]));
+if (p=0)or(c<so(trie_c[p])) then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>;
+q:=p; {now node |q| represents |cur_lang|}
+@<Store all current |lc_code| values@>;
+end
+
+@ We store all nonzero |lc_code| values, overwriting any previously
+stored values (and possibly wasting a few trie nodes that were used
+previously and are not needed now). We always store at least one
+|lc_code| value such that |hyph_index| (defined below) will not be zero.
+
+@<Store all current |lc_code| values@>=
+p:=trie_l[q]; first_child:=true;
+for c:=0 to 255 do
+ if (lc_code(c)>0)or((c=255)and first_child) then
+ begin if p=0 then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>
+ else trie_c[p]:=si(c);
+ trie_o[p]:=qi(lc_code(c));
+ q:=p; p:=trie_r[q]; first_child:=false;
+ end;
+if first_child then trie_l[q]:=0@+else trie_r[q]:=0
+
+@ We must avoid to ``take'' location~1, in order to distinguish between
+|lc_code| values and patterns.
+
+@<Pack all stored |hyph_codes|@>=
+begin if trie_root=0 then for p:=0 to 255 do trie_min[p]:=p+2;
+first_fit(hyph_root); trie_pack(hyph_root);
+hyph_start:=trie_ref[hyph_root];
+end
+
+@ The global variable |hyph_index| will point to the hyphenation codes
+for the current language.
+
+@d set_hyph_index== {set |hyph_index| for current language}
+ if trie_char(hyph_start+cur_lang)<>qi(cur_lang)
+ then hyph_index:=0 {no hyphenation codes for |cur_lang|}
+ else hyph_index:=trie_link(hyph_start+cur_lang)
+@#
+@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
+ if hyph_index=0 then hc[0]:=lc_code(#)
+ else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0
+ else hc[0]:=qo(trie_op(hyph_index+#))
+
+@<Glob...@>=
+@!hyph_start:trie_pointer; {root of the packed trie for |hyph_codes|}
+@!hyph_index:trie_pointer; {pointer to hyphenation codes for |cur_lang|}
+
+@ When |saving_vdiscards| is positive then the glue, kern, and penalty
+nodes removed by the page builder or by \.{\\vsplit} from the top of a
+vertical list are saved in special lists instead of being discarded.
+
+@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder}
+@d page_disc==disc_ptr[last_box_code] {first item removed by page builder}
+@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}}
+
+@<Glob...@>=
+@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers}
+
+@ @<Set init...@>=
+page_disc:=null; split_disc:=null;
+
+@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
+command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
+distinguished by their |chr_code| values |last_box_code| and
+|vsplit_code|. These |chr_code| values are larger than |box_code| and
+|copy_code|.
+
+@<Generate all \eTeX...@>=
+primitive("pagediscards",un_vbox,last_box_code);@/
+@!@:page_discards_}{\.{\\pagediscards} primitive@>
+primitive("splitdiscards",un_vbox,vsplit_code);@/
+@!@:split_discards_}{\.{\\splitdiscards} primitive@>
+
+@ @<Cases of |un_vbox| for |print_cmd_chr|@>=
+else if chr_code=last_box_code then print_esc("pagediscards")
+else if chr_code=vsplit_code then print_esc("splitdiscards")
+
+@ @<Handle saved items and |goto done|@>=
+begin link(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null;
+goto done;
+end
+
+@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
+and \.{\\displaywidowpenalties} commands allow to define arrays of
+penalty values to be used instead of the corresponding single values.
+
+@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc)
+@d club_penalties_ptr==equiv(club_penalties_loc)
+@d widow_penalties_ptr==equiv(widow_penalties_loc)
+@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc)
+
+@<Generate all \eTeX...@>=
+primitive("interlinepenalties",set_shape,inter_line_penalties_loc);@/
+@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@>
+primitive("clubpenalties",set_shape,club_penalties_loc);@/
+@!@:club_penalties_}{\.{\\clubpenalties} primitive@>
+primitive("widowpenalties",set_shape,widow_penalties_loc);@/
+@!@:widow_penalties_}{\.{\\widowpenalties} primitive@>
+primitive("displaywidowpenalties",set_shape,display_widow_penalties_loc);@/
+@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@>
+
+@ @<Cases of |set_shape| for |print_cmd_chr|@>=
+inter_line_penalties_loc: print_esc("interlinepenalties");
+club_penalties_loc: print_esc("clubpenalties");
+widow_penalties_loc: print_esc("widowpenalties");
+display_widow_penalties_loc: print_esc("displaywidowpenalties");
+
+@ @<Fetch a penalties array element@>=
+begin scan_int;
+if (equiv(m)=null)or(cur_val<0) then cur_val:=0
+else begin if cur_val>penalty(equiv(m)) then cur_val:=penalty(equiv(m));
+ cur_val:=penalty(equiv(m)+cur_val);
+ end;
+end
+
+@* \[54] System-dependent changes.
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/eomegadir/eocprt.ch b/Build/source/texk/web2c/eomegadir/eocprt.ch
new file mode 100644
index 00000000000..3637cc2ed62
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eocprt.ch
@@ -0,0 +1,10 @@
+@x
+wterm_ln('Copyright (c) 1994--2000 John Plaice and Yannis Haralambous');
+@y
+wterm_ln('Copyright (c) 2002 the e-Omega task force');
+@z
+@x
+print_nl("Copyright (c) 1994--2000 John Plaice and Yannis Haralambous");
+@y
+print_nl("Copyright (c) 2002 the e-Omega task force");
+@z
diff --git a/Build/source/texk/web2c/eomegadir/eoeqtb.ch b/Build/source/texk/web2c/eomegadir/eoeqtb.ch
new file mode 100644
index 00000000000..f2ce7917a57
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eoeqtb.ch
@@ -0,0 +1,23 @@
+% This changefile gets rid of all the remaining eqtb references
+% and fixes other similar issues
+% (hopefully ...)
+%----------------------------------------
+@x
+begin if eTeX_ex and(eqtb[p].int=w) then
+@y
+begin if eTeX_ex and(new_eqtb_int(p)=w) then
+@z
+%----------------------------------------
+% eomega.web line 29099
+@x
+@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable}
+@y
+@d eTeX_state(#)==new_eqtb_int(eTeX_state_base+#) {an \eTeX\ state variable}
+@z
+%----------------------------------------
+@x
+@d eTeX_revision_code=6 {command code for \.{\\eTeXrevision}}
+@y
+@d eTeX_revision_code=job_name_code+1 {command code for \.{\\eTeXrevision}}
+@z
+
diff --git a/Build/source/texk/web2c/eomegadir/eoext.ch b/Build/source/texk/web2c/eomegadir/eoext.ch
new file mode 100644
index 00000000000..08dcccefa47
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eoext.ch
@@ -0,0 +1,114 @@
+% vim ft=ch
+% Dealing with extended formats
+% and changing the last Omega references to e-Omega
+@x
+@<Read the other strings from the \.{OMEGA.POOL} file and return |true|,
+@y
+@<Read the other strings from the \.{EOMEGA.POOL} file and return |true|,
+@z
+%----------------------------------------
+@x
+else bad_pool('! I can''t read OMEGA.POOL.')
+@.I can't read OMEGA.POOL@>
+
+@ @<Read one string...@>=
+begin if eof(pool_file) then bad_pool('! OMEGA.POOL has no check sum.');
+@.OMEGA.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+if m='*' then @<Check the pool check sum@>
+else begin if (m<"0")or(m>"9")or@|
+ (n<"0")or(n>"9") then
+ bad_pool('! OMEGA.POOL line doesn''t begin with two digits.');
+@.OMEGA.POOL line doesn't...@>
+@y
+else bad_pool('! I can''t read EOMEGA.POOL.')
+@.I can't read EOMEGA.POOL@>
+
+@ @<Read one string...@>=
+begin if eof(pool_file) then bad_pool('! EOMEGA.POOL has no check sum.');
+@.EOMEGA.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+if m='*' then @<Check the pool check sum@>
+else begin if (m<"0")or(m>"9")or@|
+ (n<"0")or(n>"9") then
+ bad_pool('! EOMEGA.POOL line doesn''t begin with two digits.');
+@.EOMEGA.POOL line doesn't...@>
+@z
+%----------------------------------------
+@x
+ bad_pool('! OMEGA.POOL check sum doesn''t have nine digits.');
+@.OMEGA.POOL check sum...@>
+ a:=10*a+n-"0";
+ if k=9 then goto done;
+ incr(k); read(pool_file,n);
+ end;
+done: if a<>@$ then bad_pool('! OMEGA.POOL doesn''t match; OTANGLE me again.');
+@.OMEGA.POOL doesn't match@>
+@y
+ bad_pool('! EOMEGA.POOL check sum doesn''t have nine digits.');
+@.EOMEGA.POOL check sum...@>
+ a:=10*a+n-"0";
+ if k=9 then goto done;
+ incr(k); read(pool_file,n);
+ end;
+done: if a<>@$ then bad_pool('! EOMEGA.POOL doesn''t match; OTANGLE me again.');
+@.EOMEGA.POOL doesn't match@>
+@z
+%----------------------------------------
+@x
+print_err("Omega capacity exceeded, sorry [");
+@y
+print_err("e-Omega capacity exceeded, sorry [");
+@z
+%----------------------------------------
+@x
+ print("Omega output, Version 3.141592--1.15, ");
+@y
+ print("e-Omega output, Version 3.141592--1.15--2.1, ");
+@z
+%----------------------------------------
+@x
+ print_err("Patterns can be loaded only by INIOMEGA");
+@y
+ print_err("Patterns can be loaded only by INIEOMEGA");
+@z
+%----------------------------------------
+@x
+format_ident:=" (INIOMEGA)";
+@y
+format_ident:=" (INIEOMEGA)";
+@z
+%----------------------------------------
+@x
+ print_nl("(\dump is performed only by INIOMEGA)"); return;
+@:dump_}{\.{\\dump...only by INIOMEGA}@>
+@y
+ print_nl("(\dump is performed only by INIEOMEGA)"); return;
+@:dump_}{\.{\\dump...only by INIEOMEGA}@>
+@z
+%----------------------------------------
+@x
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+@y
+@!init if (buffer[loc]="*")and(format_ident=" (INIEOMEGA)") then
+@z
+%%% The following lines would let e-Omega start in enhanced mode
+% %----------------------------------------
+% @x
+% incr(loc); eTeX_mode:=1; {enter extended mode}
+% @y
+% if (buffer[loc]="*") then incr(loc);
+% eTeX_mode:=1; {enter extended mode}
+% @z
+% %----------------------------------------
+% @x
+% eTeX_mode:=0; {initially we are in compatibility mode}
+% @y
+% eTeX_mode:=1; {initially we are in extended mode}
+% @z
+% %----------------------------------------
+% @x
+% for j:=0 to eTeX_states-1 do set_new_eqtb_int(eTeX_state_base+j,0); {disable all enhancements}
+% @y
+% for j:=0 to eTeX_states-1 do set_new_eqtb_int(eTeX_state_base+j,1); {enable all enhancements}
+% @z
diff --git a/Build/source/texk/web2c/eomegadir/eofix.ch b/Build/source/texk/web2c/eomegadir/eofix.ch
new file mode 100644
index 00000000000..693f1a8bcea
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eofix.ch
@@ -0,0 +1,54 @@
+%----------------------------------------
+% Fix some compilation quirks
+% l. 4780
+@x
+ if local_par_bool then begin end {tail_append(local_par)}
+@y
+ if local_par_bool then begin end {|tail_append(local_par)|}
+@z
+% l. 8515
+@x
+ if (type(tail)<>math_node)or(subtype(tail)<>end_M_code) then
+@y
+ if (type(tail)<>math_node) then
+@z
+% l.28263
+@x
+pack_direction:=-1;
+{
+set_new_eqtb_sc(dimen_base+page_height_code,55380984); {29.7cm}
+set_new_eqtb_sc(dimen_base+page_width_code,39158276); {21cm}
+}
+set_new_eqtb_sc(dimen_base+page_height_code,15961652); {for talk}
+set_new_eqtb_sc(dimen_base+page_width_code,23718717); {for talk}
+@y
+pack_direction:=-1;
+
+set_new_eqtb_sc(dimen_base+page_height_code,55380984); {29.7cm}
+set_new_eqtb_sc(dimen_base+page_width_code,39158276); {21cm}
+{
+| set_new_eqtb_sc(dimen_base+page_height_code,15961652); | {for talk}
+| set_new_eqtb_sc(dimen_base+page_width_code,23718717); | {for talk}
+}
+@z
+% l. 28336
+@x
+primitive("pagewidth",assign_dimen,dimen_base+page_width_code);@/
+{
+primitive("pagerightoffset",assign_dimen,dimen_base+page_right_offset_code);@/
+primitive("pagebottomoffset",assign_dimen,dimen_base+page_bottom_offset_code);@/
+}
+@y
+primitive("pagewidth",assign_dimen,dimen_base+page_width_code);@/
+{
+|primitive("pagerightoffset",assign_dimen,dimen_base+page_right_offset_code);|
+|primitive("pagebottomoffset",assign_dimen,dimen_base+page_bottom_offset_code);|
+}
+@z
+@x
+
+@d decr(#)==#:=#-1
+
+@y
+
+@z
diff --git a/Build/source/texk/web2c/eomegadir/eofix2.ch b/Build/source/texk/web2c/eomegadir/eofix2.ch
new file mode 100644
index 00000000000..72de2a419cc
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eofix2.ch
@@ -0,0 +1,150 @@
+% vim:ft=change
+% This changefile fixes some minor bugs in (e-)Omega
+
+@x l.4290 -- max words = 8 (required by local_par_node)
+@p function copy_node_list(@!p:pointer):pointer; {makes a duplicate of the
+ node list that starts at |p| and returns a pointer to the new list}
+var h:pointer; {temporary head of copied list}
+@!q:pointer; {previous position in new list}
+@!r:pointer; {current node being fabricated for new list}
+@!words:0..5; {number of words remaining to be copied}
+@y
+@p function copy_node_list(@!p:pointer):pointer; {makes a duplicate of the
+ node list that starts at |p| and returns a pointer to the new list}
+var h:pointer; {temporary head of copied list}
+@!q:pointer; {previous position in new list}
+@!r:pointer; {current node being fabricated for new list}
+@!words:0..8; {number of words remaining to be copied}
+@z
+% ----------------------------------------
+@x remove l.18956 -- 18994 and reference to new_hsize
+function get_natural_width(first_ptr:pointer):scaled;
+label reswitch, common_ending, exit;
+var
+@!p:pointer;
+@!x:scaled; {height, depth, and natural width}
+@!g:pointer; {points to a glue specification}
+@!f:internal_font_number; {the font in a |char_node|}
+@!i:four_quarters; {font information about a |char_node|}
+begin
+x:=0;
+p:=first_ptr;
+while p<>null do begin
+ while is_char_node(p) do begin
+ f:=font(p); i:=char_info(f)(character(p));
+ x:=x+char_width(f)(i);
+ p:=link(p);
+ end;
+ if p<>null then
+ begin case type(p) of
+ hlist_node,vlist_node,rule_node,unset_node:
+ x:=x+width(p);
+ ins_node,mark_node,adjust_node: do_nothing;
+ whatsit_node: do_nothing;
+ glue_node: begin
+ g:=glue_ptr(p); x:=x+width(g);
+ end;
+ kern_node,math_node: x:=x+width(p);
+ ligature_node: begin
+ f:=font(p); i:=char_info(f)(character(lig_char(p)));
+ x:=x+char_width(f)(i);
+ end;
+ othercases do_nothing
+ endcases;
+ p:=link(p);
+ end;
+ end;
+get_natural_width:=x;
+end;
+
+procedure line_break(@!d:boolean);
+label done,done1,done2,done3,done4,done5,continue;
+var new_hsize: scaled;
+@<Local variables for line breaking@>@;
+@y
+procedure line_break(@!d:boolean);
+label done,done1,done2,done3,done4,done5,continue;
+var @<Local variables for line breaking@>@;
+@z
+% ----------------------------------------
+@x remove remaining refs to new_hsize (l.19726 etc)
+@ We compute the values of |easy_line| and the other local variables relating
+to line length when the |line_break| procedure is initializing itself.
+
+@<Get ready to start...@>=
+new_hsize := get_natural_width(link(temp_head)) div 7;
+if new_hsize>hsize then new_hsize:=hsize;
+if new_hsize<(hsize div 4) then new_hsize:=(hsize div 4);
+new_hsize := hsize;
+if par_shape_ptr=null then
+ if hang_indent=0 then
+ begin last_special_line:=0; second_width:=new_hsize;
+ second_indent:=0;
+ end
+ else @<Set line length parameters in preparation for hanging indentation@>
+else begin last_special_line:=info(par_shape_ptr)-1;
+ second_width:=mem[par_shape_ptr+2*(last_special_line+1)].sc;
+ second_indent:=mem[par_shape_ptr+2*last_special_line+1].sc;
+ end;
+if looseness=0 then easy_line:=last_special_line
+else easy_line:=max_halfword
+
+@ @<Set line length parameters in preparation for hanging indentation@>=
+begin last_special_line:=abs(hang_after);
+if hang_after<0 then
+ begin first_width:=new_hsize-abs(hang_indent);
+ if hang_indent>=0 then first_indent:=hang_indent
+ else first_indent:=0;
+ second_width:=new_hsize; second_indent:=0;
+ end
+else begin first_width:=new_hsize; first_indent:=0;
+ second_width:=hsize-abs(hang_indent);
+ if hang_indent>=0 then second_indent:=hang_indent
+ else second_indent:=0;
+ end;
+end
+@y
+@ We compute the values of |easy_line| and the other local variables relating
+to line length when the |line_break| procedure is initializing itself.
+
+@<Get ready to start...@>=
+if par_shape_ptr=null then
+ if hang_indent=0 then
+ begin last_special_line:=0; second_width:=hsize;
+ second_indent:=0;
+ end
+ else @<Set line length parameters in preparation for hanging indentation@>
+else begin last_special_line:=info(par_shape_ptr)-1;
+ second_width:=mem[par_shape_ptr+2*(last_special_line+1)].sc;
+ second_indent:=mem[par_shape_ptr+2*last_special_line+1].sc;
+ end;
+if looseness=0 then easy_line:=last_special_line
+else easy_line:=max_halfword
+
+@ @<Set line length parameters in preparation for hanging indentation@>=
+begin last_special_line:=abs(hang_after);
+if hang_after<0 then
+ begin first_width:=hsize-abs(hang_indent);
+ if hang_indent>=0 then first_indent:=hang_indent
+ else first_indent:=0;
+ second_width:=hsize; second_indent:=0;
+ end
+else begin first_width:=hsize; first_indent:=0;
+ second_width:=hsize-abs(hang_indent);
+ if hang_indent>=0 then second_indent:=hang_indent
+ else second_indent:=0;
+ end;
+end
+@z
+% ----------------------------------------
+@x l.28441 -- Correct wrong node size
+dir_node: begin r:=get_node(dir_node_size);
+ words:=small_node_size;
+ end;
+@y
+dir_node: begin r:=get_node(dir_node_size);
+ words:=dir_node_size;
+ end;
+@z
+% ----------------------------------------
+
diff --git a/Build/source/texk/web2c/eomegadir/eofmt.ch b/Build/source/texk/web2c/eomegadir/eofmt.ch
new file mode 100644
index 00000000000..5e05742388e
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eofmt.ch
@@ -0,0 +1,35 @@
+% XOMEGA.WEB l.428
+@x
+@!pool_name='TeXformats:OMEGA.POOL ';
+@y
+@!pool_name='TeXformats:EOMEGA.POOL ';
+@z
+% XOMEGA.WEB l.10746
+@x
+is `\.{.fmt}' on the format files written by \.{INITEX} to initialize \TeX.
+@y
+is `\.{.eofmt}' on the format files written by \.{INITEX} to initialize \TeX.
+@z
+%---------------------------------------
+% XOMEGA.WEB l.10909
+@x
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@y
+@d format_default_length=22 {length of the |TEX_format_default| string}
+@z
+%---------------------------------------
+% XOMEGA.WEB l.10911
+@x
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+@y
+@d format_ext_length=6 {length of its `\.{.xfmt}' part}
+@d format_extension=".eofmt" {the extension, as a \.{WEB} constant}
+@z
+%---------------------------------------
+% XOMEGA.WEB l.10918
+@x
+TEX_format_default:='TeXformats:plain.fmt';
+@y
+TEX_format_default:='TeXformats:plain.eofmt';
+@z
diff --git a/Build/source/texk/web2c/eomegadir/eomega.defines b/Build/source/texk/web2c/eomegadir/eomega.defines
new file mode 100644
index 00000000000..e8cf7f8fdc2
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eomega.defines
@@ -0,0 +1,74 @@
+{ omega.defines: Web declarations of Omega
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+}
+
+@define function newinputln ();
+@define function getfilemode ();
+@define function newinputline ();
+@define function neweqtb ();
+@define function neweqtbint ();
+@define function neweqtbsc ();
+@define function newequiv ();
+@define function newequiv1 ();
+@define function neweqlevel ();
+@define function neweqtype ();
+
+@define function newhashnext ();
+@define function newhashtext ();
+@define function newxeqlevel ();
+
+@define procedure odateandtime ();
+@define procedure allocatefonttable ();
+@define procedure dumpfonttable ();
+@define procedure undumpfonttable ();
+@define procedure allocatefontsorttable ();
+@define procedure dumpfontsorttable ();
+@define procedure undumpfontsorttable ();
+@define procedure allocateocptable ();
+@define procedure dumpocptable ();
+@define procedure undumpocptable ();
+@define procedure initeqtbtable;
+@define procedure dumpeqtbtable;
+@define procedure undumpeqtbtable;
+@define procedure setneweqtb ();
+@define procedure setneweqtbint ();
+@define procedure setneweqtbsc ();
+@define procedure setequiv ();
+@define procedure setequiv1 ();
+@define procedure seteqtype ();
+@define procedure seteqlevel ();
+@define procedure btestin ;
+@define procedure runexternalocp ();
+@define procedure changeomegafilename ();
+
+@define procedure sethashnext ();
+@define procedure sethashtext ();
+@define procedure setintzero ();
+@define procedure setintone ();
+
+@define var fonttables;
+@define var fontsorttables;
+@define var ocptables;
+
+@define var ocptemp;
+
+{ end of omega.defines }
diff --git a/Build/source/texk/web2c/eomegadir/eomega.ech b/Build/source/texk/web2c/eomegadir/eomega.ech
new file mode 100644
index 00000000000..33f6c4577ce
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eomega.ech
@@ -0,0 +1,69 @@
+% This is `tex.ech' in text format as of Jan 14, 1998,
+% for web2c-7.0 and e-TeX Version 2.0;eNov23 as of Nov 25, 1997,
+% made by B. Raichle and P. Breitenlohner.
+% Copyright (C) 1994,97 by the NTS team; all rights are reserved.
+
+%
+@x [...] l.10746
+is `\.{.fmt}' on the format files written by \.{INITEX} to initialize \TeX.
+@y
+is `\.{.eoft}' on the format files written by \.{INITEX} to initialize \TeX.
+@z
+
+%
+@x [...] l.10911
+@d format_ext_length=4 {length of its `\.{.oft}' part}
+@d format_extension=".oft" {the extension, as a \.{WEB} constant}
+@y
+@d format_ext_length=5 {length of its `\.{.eoft}' part}
+@d format_extension=".eoft" {the extension, as a \.{WEB} constant}
+@z
+
+@x [51.1332] l.24203 (ca.) texarray
+ xmalloc_array (line_stack, max_in_open);
+@y
+ xmalloc_array (line_stack, max_in_open);
+ xmalloc_array (eof_seen, max_in_open);
+ xmalloc_array (grp_stack, max_in_open);
+ xmalloc_array (if_stack, max_in_open);
+@z
+
+@x [51.1337] l.24371 (ca.) texarray
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+ hyph_root:=0; hyph_start:=0;
+@z
+
+@x [53a.???] l.??? texarray
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+@y
+@!eof_seen : ^boolean; {has eof been seen?}
+@z
+
+@x [53a.???] l.??? texarray
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+@y
+@!grp_stack : ^save_pointer; {initial |cur_boundary|}
+@!if_stack : ^pointer; {initial |cond_ptr|}
+@z
+
+@x [53a.???] l.??? texarray
+hyph_root:=0; hyph_start:=0;
+@y
+@z
+
+% @x [54/web2c.???] l.??? needed earlier
+% replacement, but always existing character |font_bc[f]|.
+% @^inner loop@>
+%
+% @<Declare additional functions for ML\TeX@>=
+% function effective_char(@!err_p:boolean;
+% @y
+% replacement, but always existing character |font_bc[f]|.
+% @^inner loop@>
+%
+% @<Declare \eTeX\ procedures for sc...@>=
+% function effective_char(@!err_p:boolean;
+% @z
diff --git a/Build/source/texk/web2c/eomegadir/eomega.mak b/Build/source/texk/web2c/eomegadir/eomega.mak
new file mode 100644
index 00000000000..923eca7bce0
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eomega.mak
@@ -0,0 +1,193 @@
+################################################################################
+#
+# Makefile : Omega, web2c win32.mak makefile fragment to build Omega
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/03/20 16:43:02 popineau>
+#
+################################################################################
+
+# e-Omega itself.
+
+# We build eomega
+eomega = $(objdir)\eomega.exe
+!ifdef TEX_DLL
+eomega = $(eomega) $(objdir)\$(library_prefix)eomega.dll
+!endif
+
+# The C sources.
+eomega_c = eomega.c
+eomega_o = $(objdir)\eomega.obj $(objdir)\eomegafirst.obj $(objdir)\eomegabis.obj
+
+# Generation of the web and ch files.
+
+omegadir = .\omegadir-1.15
+eomegadir = .\eomegadir
+
+#
+# e-Omega is build without the xml support
+# so we can't reuse omega.web and omega.ch
+# we need to build stripped down versions
+#
+eomega_files = \
+# $(omegadir)\omnode.ch \
+ $(omegadir)\om16bit.ch \
+ $(omegadir)\omstr.ch \
+ $(omegadir)\omfont.ch \
+ $(omegadir)\omchar.ch \
+ $(omegadir)\omfi.ch \
+ $(omegadir)\ompar.ch \
+ $(omegadir)\omocp.ch \
+ $(omegadir)\omfilter.ch \
+ $(omegadir)\omtrans.ch \
+ $(omegadir)\omdir.ch \
+# $(omegadir)\omxml.ch # We don't want this one, really, do we?
+ $(eomegadir)\eocprt.ch \
+ $(eomegadir)\eobase.ch \
+ $(eomegadir)\eomem-rc1.ch \
+ $(eomegadir)\eo16bit-rc1.ch \
+ $(eomegadir)\eofix.ch \
+ $(eomegadir)\eofix2.ch \
+ $(eomegadir)\eoeqtb.ch \
+ $(eomegadir)\eonewdir-rc1.ch \
+ $(eomegadir)\eover-rc1.ch
+
+eomega_changefiles = \
+ $(eomegadir)\omega.ch0 \
+# $(omegadir)\comnode.ch \
+ $(omegadir)\com16bit.ch \
+ $(omegadir)\comstr.ch \
+ $(omegadir)\comfont.ch \
+ $(omegadir)\comchar.ch \
+ $(omegadir)\comfi.ch \
+ $(omegadir)\compar.ch \
+ $(omegadir)\comocp.ch \
+ $(omegadir)\comfilter.ch \
+ $(omegadir)\comtrans.ch \
+ $(omegadir)\comdir.ch \
+# $(omegadir)\comxml.ch \
+ $(omegadir)\comsrcspec.ch \
+ $(omegadir)\comw32.ch \
+ $(eomegadir)\omega.ch1 \
+ $(eomegadir)\eomega.ech \
+ $(eomegadir)\omega.ch2
+
+# Linking
+!ifdef TEX_DLL
+$(ojbdir)\$(library_prefix)eomega.exp: $(objdir)\$(library_prefix)eomega.lib
+
+$(objdir)\$(library_prefix)eomega.lib: $(eomega_o)
+ $(archive) /DEF $(eomega_o)
+
+$(objdir)\$(library_prefix)eomega.dll: $(eomega_o) $(objdir)\$(library_prefix)eomega.exp $(objdir)\eomega.res $(omegalibsdep) $(kpathsealib) $(proglib)
+ $(link_dll) $(**) $(conlibs)
+
+$(objdir)\eomega.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)eomega.lib $(proglib)
+ $(link) $(**) $(socketslib) $(conlibs)
+!else
+$(objdir)\eomega.exe: $(eomega_o) $(objdir)\win32main.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(socketlibs) $(conlibs)
+!endif
+
+# The C files
+$(eomega_c) eomegacoerce.h eomegad.h: eomega.p $(web2c_texmf)
+ $(web2c) eomega
+# Additional C files, just copy them.
+eomegafirst.c: omegadir\omega.c
+ -$(del) $@
+ $(copy) $(srcdir)\omegadir\omega.c $@
+eomegabis.c: omegadir\omegabis.c
+ -$(del) $@
+ $(copy) $(srcdir)\omegadir\omegabis.c $@
+eomegamem.h: omegadir\omegamem.h
+ -$(del) $@
+ $(copy) $(srcdir)\omegadir\omegamem.h $@
+
+# The Pascal file
+eomega.p eomega.pool: $(objdir)\otangle.exe eomega.web eomega.ch
+ $(objdir)\otangle eomega.web eomega.ch
+
+# Generation of the web and ch files.
+eomega.web: $(objdir)\tie.exe tex.web $(eomega_files)
+ $(objdir)\tie.exe -m $@ tex.web $(eomega_files)
+
+eomega.ch: $(objdir)\tie.exe eomega.web $(eomega_changefiles)
+ $(objdir)\tie.exe -c $@ eomega.web $(eomega_changefiles)
+
+# Check: right now all we do is build the format.
+check: eomega-check
+eomega-check: eomega eomega.eoft
+# Cleaning up from building omega
+clean:: eomega-clean
+eomega-clean:
+ -@echo $(verbose) & ( \
+ for %%i in ($(eomega_c) eomegaextra.c eomegacoerce.h eomegad.h \
+ eomegafirst.c eomegabis.c eomegamem.h \
+ eomega.p eomega.pool eomega.web eomega.ch) do $(del) %%i $(redir_stderr) \
+ )
+#
+# Dumps.
+# all_eofmts = eomega.eoft $(eofmts)
+#
+# dumps: eofmts
+# eofmts: $(all_eofmts)
+#
+# eomega.eoft: $(eomega)
+# $(dumpenv) $(make) progname=eomega files="omega.tex" prereq-check
+# $(dumpenv) .\$(objdir)\eomega --ini --progname=eomega --jobname=eomega "\\input omega.tex \\dump" < nul
+#
+# elambda.eoft: $(eomega)
+# $(dumpenv) $(make) progname=elambda files="lambda.tex" prereq-check
+# $(dumpenv) .\$(objdir)\eomega --ini --progname=elambda --progname=elambda --jobname=elambda "\\input lambda.tex" < nul
+
+
+#
+# Installation.
+install-eomega: install-eomega-exec install-eomega-data
+install-eomega-exec: install-eomega-links
+# install-eomega-data: install-eomega-dumps
+install-eomega-dumps: install-eomega-fmts
+
+# The actual binary executables and pool files.
+install-programs: install-eomega-programs
+install-eomega-programs: $(eomega) $(bindir)
+ -@echo $(verbose) & ( \
+ for %%p in ($(eomega)) do copy %%p $(bindir) $(redir_stdout) \
+ )
+
+install-links: install-eomega-links
+install-eomega-links: install-eomega-programs
+# -@echo $(verbose) & ( \
+# pushd $(bindir) & \
+# $(del) inieomega.exe vireomega.exe & \
+# $(lnexe) .\eomega.exe .\inieomega.exe & \
+# $(lnexe) .\eomega.exe .\vireomega.exe & \
+# popd \
+# ) $(redir_stdout)
+ -@echo $(verbose) & ( \
+ if not "$(eofmts)"=="" \
+ for %%i in ($(eofmts)) do \
+ pushd $(bindir) & \
+ $(del) .\%%~ni.exe & \
+ $(lnexe) .\eomega.exe $(bindir)\%%~ni.exe & \
+ popd \
+ ) $(redir_stdout)
+
+install-fmts: install-eomega-fmts
+install-eomega-fmts: eofmts $(fmtdir)
+ -@echo $(verbose) & ( \
+ if not "$(eofmts)"=="" \
+ for %%f in ($(eofmts)) do $(copy) %%f $(fmtdir)\%%f $(redir_stdout) \
+ ) $(redir_stdout)
+
+# Auxiliary files.
+install-data:: install-eomega-data
+install-eomega-data: $(texpooldir)
+ @$(copy) eomega.pool $(texpooldir)\eomega.pool $(redir_stdout)
+
+# end of eomega.mak
+#
+# Local variables:
+# page-delimiter: "^# \f"
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/eomegadir/eomega.mk b/Build/source/texk/web2c/eomegadir/eomega.mk
new file mode 100644
index 00000000000..47a0c7a4f26
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eomega.mk
@@ -0,0 +1,174 @@
+# Makefile fragment for Omega and web2c. --infovore@xs4all.nl. Public domain.
+# This fragment contains the parts of the makefile that are most likely to
+# differ between releases of Omega.
+
+eomegadir = eomegadir
+omegadir = omegadir-1.15
+
+Makefile: $(eomegadir)/eomega.mk
+
+# e-Omega itself.
+
+# We build eomega
+eomega =@EOMEGA@ eomega
+
+# The C sources.
+eomega_c = eomegaini.c eomega0.c eomega1.c eomega2.c eomega3.c
+eomega_o = eomegaini.o eomega0.o eomega1.o eomega2.o \
+ eomegaextra.o eomega.o eomegabis.o \
+ eomega3.o
+
+# Linking
+eomega: $(eomega_o)
+ $(kpathsea_link) $(eomega_o) $(socketlibs) $(LOADLIBES)
+
+# The C files
+$(eomega_c) eomegacoerce.h eomegad.h: eomega.p $(web2c_texmf)
+ $(web2c) eomega
+eomegaextra.c: lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/eomega/ $(srcdir)/lib/texmfmp.c >$@
+# Additional C files, just copy them.
+eomega.c: $(omegadir)/omega.c
+ -rm -f $@
+ cp $(srcdir)/$(omegadir)/omega.c $@
+eomegabis.c: $(omegadir)/omegabis.c
+ -rm -f $@
+ cp $(srcdir)/$(omegadir)/omegabis.c $@
+eomegamem.h: $(omegadir)/omegamem.h
+ -rm -f $@
+ cp $(srcdir)/$(omegadir)/omegamem.h $@
+
+# The Pascal file
+eomega.p eomega.pool: otangle eomega.web eomega.ch
+ ./otangle eomega.web eomega.ch
+
+# Generation of the web and ch files.
+eomega.web: tie tex.web $(eomegadir)/eomega.mk
+eomega.web: $(omegadir)/om16bit.ch
+eomega.web: $(omegadir)/omstr.ch
+eomega.web: $(omegadir)/omfont.ch
+eomega.web: $(omegadir)/omchar.ch
+eomega.web: $(omegadir)/omfi.ch
+eomega.web: $(omegadir)/ompar.ch
+eomega.web: $(omegadir)/omocp.ch
+eomega.web: $(omegadir)/omfilter.ch
+eomega.web: $(omegadir)/omtrans.ch
+eomega.web: $(omegadir)/omdir.ch
+eomega.web: $(eomegadir)/eocprt.ch
+eomega.web: $(eomegadir)/eobase.ch
+eomega.web: $(eomegadir)/eomem-rc1.ch
+eomega.web: $(eomegadir)/eo16bit-rc1.ch
+eomega.web: $(eomegadir)/eofix.ch
+eomega.web: $(eomegadir)/eofix2.ch
+eomega.web: $(eomegadir)/eoeqtb.ch
+eomega.web: $(eomegadir)/eonewdir-rc1.ch
+eomega.web: $(eomegadir)/eover-rc1.ch
+ ./tie -m eomega.web $(srcdir)/tex.web \
+ $(srcdir)/$(omegadir)/om16bit.ch \
+ $(srcdir)/$(omegadir)/omstr.ch \
+ $(srcdir)/$(omegadir)/omfont.ch \
+ $(srcdir)/$(omegadir)/omchar.ch \
+ $(srcdir)/$(omegadir)/omfi.ch \
+ $(srcdir)/$(omegadir)/ompar.ch \
+ $(srcdir)/$(omegadir)/omocp.ch \
+ $(srcdir)/$(omegadir)/omfilter.ch \
+ $(srcdir)/$(omegadir)/omtrans.ch \
+ $(srcdir)/$(omegadir)/omdir.ch \
+ $(srcdir)/$(eomegadir)/eocprt.ch \
+ $(srcdir)/$(eomegadir)/eobase.ch \
+ $(srcdir)/$(eomegadir)/eomem-rc1.ch \
+ $(srcdir)/$(eomegadir)/eo16bit-rc1.ch \
+ $(srcdir)/$(eomegadir)/eofix.ch \
+ $(srcdir)/$(eomegadir)/eofix2.ch \
+ $(srcdir)/$(eomegadir)/eoeqtb.ch \
+ $(srcdir)/$(eomegadir)/eonewdir-rc1.ch \
+ $(srcdir)/$(eomegadir)/eover-rc1.ch
+eomega.ch: tie eomega.web $(eomegadir)/eomega.mk
+eomega.ch: $(eomegadir)/omega.ch0
+eomega.ch: $(omegadir)/com16bit.ch
+eomega.ch: $(omegadir)/comstr.ch
+eomega.ch: $(omegadir)/comfont.ch
+eomega.ch: $(omegadir)/comchar.ch
+eomega.ch: $(omegadir)/comfi.ch
+eomega.ch: $(omegadir)/compar.ch
+eomega.ch: $(omegadir)/comocp.ch
+eomega.ch: $(omegadir)/comfilter.ch
+eomega.ch: $(omegadir)/comtrans.ch
+eomega.ch: $(omegadir)/comdir.ch
+eomega.ch: $(omegadir)/comsrcspec.ch
+eomega.ch: $(eomegadir)/omega.ch1
+eomega.ch: $(eomegadir)/eomega.ech
+eomega.ch: $(eomegadir)/omega.ch2
+ ./tie -c eomega.ch eomega.web \
+ $(srcdir)/$(eomegadir)/omega.ch0 \
+ $(srcdir)/$(omegadir)/com16bit.ch \
+ $(srcdir)/$(omegadir)/comstr.ch \
+ $(srcdir)/$(omegadir)/comfont.ch \
+ $(srcdir)/$(omegadir)/comchar.ch \
+ $(srcdir)/$(omegadir)/comfi.ch \
+ $(srcdir)/$(omegadir)/compar.ch \
+ $(srcdir)/$(omegadir)/comocp.ch \
+ $(srcdir)/$(omegadir)/comfilter.ch \
+ $(srcdir)/$(omegadir)/comtrans.ch \
+ $(srcdir)/$(omegadir)/comdir.ch \
+ $(srcdir)/$(omegadir)/comsrcspec.ch \
+ $(srcdir)/$(eomegadir)/omega.ch1 \
+ $(srcdir)/$(eomegadir)/eomega.ech \
+ $(srcdir)/$(eomegadir)/omega.ch2
+# Check: right now all we do is build the format.
+check: eomega-check
+eomega-check: eomega eomega.eoft
+# Cleaning up from building omega
+clean:: eomega-clean
+eomega-clean:
+ $(LIBTOOL) --mode=clean $(RM) eomega
+ rm -f $(eomega_c) eomegaextra.c eomegacoerce.h eomegad.h
+ rm -f eomega.c eomegabis.c eomegamem.h
+ rm -f eomega.p eomega.pool eomega.web eomega.ch
+
+
+# Dumps.
+all_eofmts =@FMU@ eomega.eoft $(eofmts)
+
+dumps: eofmts
+eofmts: $(all_eofmts)
+
+eomega.eoft: eomega
+ $(dumpenv) $(MAKE) progname=eomega files="omega.tex" prereq-check
+ $(dumpenv) ./eomega --ini --progname=eomega --jobname=eomega \\input omega.tex \\dump </dev/null
+
+elambda.eoft: eomega
+ $(dumpenv) $(MAKE) progname=elambda files="lambda.tex" prereq-check
+ $(dumpenv) ./eomega --ini --progname=elambda --progname=elambda --jobname=elambda \\input lambda.tex </dev/null
+
+
+
+# Installation.
+install-eomega: install-eomega-exec install-eomega-data
+install-eomega-exec: install-eomega-links
+install-eomega-data:: install-eomega-dumps
+install-eomega-dumps: install-eomega-fmts
+
+# The actual binary executables and pool files.
+install-programs: install-eomega-programs
+install-eomega-programs: $(eomega) $(bindir)
+ for p in eomega; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+
+install-links: install-eomega-links
+install-eomega-links: install-eomega-programs
+ @FMU@cd $(bindir) && (rm -f inieomega vireomega; \
+ @FMU@ $(LN) eomega inieomega; $(LN) eomega vireomega)
+ eofmts="$(eofmts)";
+ for f in $$eofmts; do base=`basename $$f .eoft`; \
+ (cd $(bindir) && (rm -f $$base; $(LN) eomega $$base)); done
+
+install-fmts: install-eomega-fmts
+install-eomega-fmts: eofmts $(fmtdir)
+ eofmts="$(all_eofmts)";
+ for f in $$eofmts; do $(INSTALL_DATA) $$f $(fmtdir)/$$f; done
+
+# Auxiliary files.
+install-data install-eomega-data:: $(texpooldir)
+@EOMEGA@ $(INSTALL_DATA) eomega.pool $(texpooldir)/eomega.pool
+
+# end of omega.mk
diff --git a/Build/source/texk/web2c/eomegadir/eomegaextra.h b/Build/source/texk/web2c/eomegadir/eomegaextra.h
new file mode 100644
index 00000000000..342283ae759
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eomegaextra.h
@@ -0,0 +1,37 @@
+/* eomegaextra.h: banner etc. for Omega.
+
+ This is included by Omega, from ../omegaextra.c
+ (generated from ../lib/texmfmp.c).
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define BANNER "This is e-Omega, Version 3.141592--1.15--2.1--RC1"
+#define COPYRIGHT_HOLDER "the e-Omega task force"
+#define AUTHOR NULL
+#define PROGRAM_HELP EOMEGAHELP
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "eoft"
+#define DUMP_EXT ".eoft"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "inieomega"
+#define VIR_PROGRAM "vireomega"
diff --git a/Build/source/texk/web2c/eomegadir/eomem-rc1.ch b/Build/source/texk/web2c/eomegadir/eomem-rc1.ch
new file mode 100644
index 00000000000..6bba75066b1
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eomem-rc1.ch
@@ -0,0 +1,321 @@
+% vim ft=ch
+% This file is part of the e-Omega project
+% Purpouse of this file: adapting e-TeX to Omega memory management
+% Most registers are reverted to the Omega model. The only exception
+% is markings.
+%---------------------------------------
+ @x eobase.ch l.672
+begin if eTeX_ex and(eqtb[p].int=w) then
+ @y
+begin if eTeX_ex and(new_eqtb_int(p)=w) then
+ @z
+%---------------------------------------
+@x eobase.ch l.1071
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else cur_val:=equiv(m);
+ cur_val_level:=tok_val;
+@y
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+@z
+%----------------------------------------
+@x l.1220
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+@y
+begin scan_eight_bit_int;
+case m of
+@z
+%---------------------------------------
+@x
+ end;
+@y
+cur_val_level:=m;
+@z
+%----------------------------------------
+@x l.1420
+ if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+@y
+ if eTeX_ex and(tracing_lost_chars>1) then set_new_eqtb_int(int_base+tracing_online_code,1);
+@z
+%----------------------------------------
+@x
+ tracing_online:=old_setting;
+@y
+ set_new_eqtb_int(int_base+tracing_online_code,old_setting);
+@z
+%----------------------------------------
+@x eobase.ch l.2309
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+@y
+if box_context<box_flag+number_regs then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box)
+@z
+%---------------------------------------
+@x eobase.ch l.2328
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+@y
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+@z
+%---------------------------------------
+@x eobase.ch l.2359
+begin scan_register_num; n:=cur_val;
+@y
+begin scan_eight_bit_int; n:=cur_val;
+@z
+%---------------------------------------
+@x eobase.ch l.2422
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+@y
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2431
+else begin link(tail):=list_ptr(p);
+change_box(null);
+@y
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@z
+%----------------------------------------
+@x eobase.ch l.2698
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+@y
+ othercases begin scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2726
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true;
+ p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@y
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@z
+%---------------------------------------
+@x eobase.ch l.2746
+ begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+@y
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+@z
+%---------------------------------------
+@x eobase.ch l.2754
+ sa_define(p,def_ref)(p,call,def_ref);
+@y
+ define(p,call,def_ref);
+@z
+%---------------------------------------
+@x eobase.ch l.2770
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_ptr)
+ else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+@y
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+@z
+%---------------------------------------
+@x eobase.ch l.2792
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@y
+begin q:=cur_cmd;
+@z
+%----------------------------------------
+@x eobase.ch l.2802
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
+@y
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2809
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+@y
+p:=cur_chr; scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2823
+ end;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=new_eqtb_int(l);
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+@y
+end;
+found:
+@z
+%---------------------------------------
+@x eobase.ch l.2832
+ if q=advance then cur_val:=cur_val+w;
+@y
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2838
+begin q:=new_spec(cur_val); r:=s;
+@y
+begin q:=new_spec(cur_val); r:=equiv(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2847
+ if p=int_val then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin r:=new_spec(s);
+@y
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+@z
+%---------------------------------------
+@x eobase.ch l.2859
+set_box: begin scan_register_num;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@y
+set_box: begin scan_eight_bit_int;
+ if global then n:=number_regs+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+@z
+%---------------------------------------
+@x eobase.ch l.2883
+@!b:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+@y
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1296 l.23637 - e-TeX sparse arrays
+begin scan_register_num; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+@y
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+@z
+%----------------------------------------
+@x eobase.ch l.2979
+if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+@y
+@z
+%----------------------------------------
+@x eobase.ch l.2986
+if eTeX_ex then for k:=int_val to tok_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+@y
+@z
+@x l. 3132
+for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+@y
+for j:=0 to eTeX_states-1 do set_new_eqtb_int(eTeX_state_base+j,0); {disable all enhancements}
+@z
diff --git a/Build/source/texk/web2c/eomegadir/eomem-rc2.ch b/Build/source/texk/web2c/eomegadir/eomem-rc2.ch
new file mode 100644
index 00000000000..c531d831006
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eomem-rc2.ch
@@ -0,0 +1,498 @@
+% vim ft=ch
+% This file is part of the e-Omega project
+% Purpouse of this file: adapting e-TeX to Omega memory management
+% Most registers are reverted to the Omega model. The only exception
+% is markings.
+%---------------------------------------
+@x l.571
+primitive("toks",toks_register,mem_bot);@/
+@y
+primitive("toks",toks_register,0);@/
+@z
+%---------------------------------------
+@x l.615
+toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>;
+@y
+toks_register: print_esc("toks");
+@z
+%---------------------------------------
+@x l.628
+interpreted in one of five ways:
+@y
+interpreted in one of four ways:
+@z
+%---------------------------------------
+@x l.634
+the entries for that group.
+Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
+source line number at which the current level of grouping was entered.
+
+\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a
+chain of sparse array entries to be restored at the end of the current
+group. Furthermore |save_index(p)| and |save_level(p)| should replace
+the values of |sa_chain| and |sa_level| respectively.
+@y
+the entries for that group.
+Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
+source line number at which the current level of grouping was entered.
+@z
+%---------------------------------------
+@x l.647
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@d restore_sa=4 {|save_type| when sparse array entries should be restored}
+
+@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
+@y
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+
+@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
+@z
+%---------------------------------------
+ @x eobase.ch l.672
+begin if eTeX_ex and(eqtb[p].int=w) then
+ @y
+begin if eTeX_ex and(new_eqtb_int(p)=w) then
+ @z
+%---------------------------------------
+@x l.686
+@/@<Cases for |eq_destroy|@>@/
+othercases do_nothing
+@y
+othercases do_nothing
+@z
+%---------------------------------------
+@x l.774
+ else if save_type(save_ptr)=restore_sa then
+ begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr);
+ end
+ else begin if save_type(save_ptr)=restore_old_value then
+@y
+ else begin if save_type(save_ptr)=restore_old_value then
+@z
+%---------------------------------------
+@x l.1065
+|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes
+cannot have these values)
+@y
+|glue_val|, or |mu_val|.
+@z
+%---------------------------------------
+@x l.1072
+primitive("count",register,mem_bot+int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,mem_bot+dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,mem_bot+glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mem_bot+mu_val);
+@y
+primitive("count",register,int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mu_val);
+@z
+%---------------------------------------
+@x l.1090
+register: @<Cases of |register| for |print_cmd_chr|@>;
+@y
+register: if chr_code=int_val then print_esc("count")
+ else if chr_code=dimen_val then print_esc("dimen")
+ else if chr_code=glue_val then print_esc("skip")
+ else print_esc("muskip");
+@z
+%---------------------------------------
+@x eobase.ch l.1114
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else cur_val:=equiv(m);
+ cur_val_level:=tok_val;
+@y
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+@z
+%---------------------------------------
+@x l.1173
+begin
+ scan_register_num;
+ fetch_box(q);
+ if q=null then cur_val:=0 @+else
+ cur_val:=mem[q+m].sc;
+@y
+begin
+ scan_eight_bit_int;
+ if box(cur_val)=null then cur_val:=0 @+else
+ cur_val:=mem[box(cur_val)+m].sc;
+@z
+%----------------------------------------
+@x l.1263
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+@y
+begin scan_eight_bit_int;
+case m of
+@z
+%---------------------------------------
+@x
+ end;
+@y
+cur_val_level:=m;
+@z
+%---------------------------------------
+@x l.1437
+begin scan_register_num; fetch_box(p);
+@y
+begin scan_eight_bit_int; p:=box(cur_val);
+@z
+%----------------------------------------
+@x l.1479
+ if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+@y
+ if eTeX_ex and(tracing_lost_chars>1) then set_new_eqtb_int(int_base+tracing_online_code,1);
+@z
+%----------------------------------------
+@x
+ tracing_online:=old_setting;
+@y
+ set_new_eqtb_int(int_base+tracing_online_code,old_setting);
+@z
+%---------------------------------------
+@x l.2188
+begin cur_val:=n; fetch_box(v); vdir:=box_dir(v);
+@y
+begin v:=box(n); vdir:=box_dir(v);
+@z
+%---------------------------------------
+@x l.2212
+if q<>null then q:=vpack(q,natural);
+change_box(q); {the |eq_level| of the box stays the same}
+@y
+if q=null then set_equiv(box_base+n,null)
+ {the |eq_level| of the box stays the same}
+else set_equiv(box_base+n,vpack(q,natural));
+@z
+%---------------------------------------
+@x l.2336
+@d global_box_flag==box_flag+(number_regs+number_regs) {context code for `\.{\\global\\setbox0}'}
+@d ship_out_flag==global_box_flag+1 {context code for `\.{\\shipout}'}
+@y
+@d ship_out_flag==box_flag+(number_regs+number_regs)
+ {context code for `\.{\\shipout}'}
+@z
+%---------------------------------------
+@x l.2344
+var p:pointer; {|ord_noad| for new box in math mode}
+@!a:small_number; {global prefix}
+@y
+var p:pointer; {|ord_noad| for new box in math mode}
+@z
+%----------------------------------------
+@x l.2351
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+@y
+if box_context<box_flag+number_regs then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box)
+@z
+%---------------------------------------
+@x l. 2367
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+@y
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+@z
+%---------------------------------------
+@x eobase.ch l.2359
+begin scan_register_num; n:=cur_val;
+@y
+begin scan_eight_bit_int; n:=cur_val;
+@z
+%---------------------------------------
+@x eobase.ch l.2467
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+@y
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2431
+else begin link(tail):=list_ptr(p);
+change_box(null);
+@y
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@z
+%----------------------------------------
+@x eobase.ch l.2743
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+@y
+ othercases begin scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2769
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true;
+ p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@y
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@z
+%---------------------------------------
+@x eobase.ch l.2789
+ begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+@y
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+@z
+%---------------------------------------
+@x eobase.ch l.2799
+ sa_define(p,def_ref)(p,call,def_ref);
+@y
+ define(p,call,def_ref);
+@z
+%---------------------------------------
+@x eobase.ch l.2805
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_ptr)
+ else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+@y
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+@z
+%---------------------------------------
+@x eobase.ch l.2792
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@y
+begin q:=cur_cmd;
+@z
+%----------------------------------------
+@x eobase.ch l.2802
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
+@y
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+@z
+%---------------------------------------
+@x eobase.ch l.2809
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+@y
+p:=cur_chr; scan_eight_bit_int;
+@z
+%---------------------------------------
+@x eobase.ch l.2823
+ end;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=new_eqtb_int(l);
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+@y
+end;
+found:
+@z
+%---------------------------------------
+@x eobase.ch l.2832
+ if q=advance then cur_val:=cur_val+w;
+@y
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2838
+begin q:=new_spec(cur_val); r:=s;
+@y
+begin q:=new_spec(cur_val); r:=equiv(l);
+@z
+%---------------------------------------
+@x eobase.ch l.2847
+ if p=int_val then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin r:=new_spec(s);
+@y
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+@z
+%---------------------------------------
+@x eobase.ch l.2859
+set_box: begin scan_register_num;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@y
+set_box: begin scan_eight_bit_int;
+ if global then n:=number_regs+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+@z
+%---------------------------------------
+@x eobase.ch l.2925
+@!b:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+@y
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+@z
+%---------------------------------------
+@x l.2998
+begin scan_register_num; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+@y
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+@z
+%----------------------------------------
+@x eobase.ch l.3023
+if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+@y
+@z
+%----------------------------------------
+@x eobase.ch l.3030
+if eTeX_ex then for k:=int_val to tok_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+@y
+@z
+@x l. 3181
+for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+@y
+for j:=0 to eTeX_states-1 do set_new_eqtb_int(eTeX_state_base+j,0); {disable all enhancements}
+@z
+%----------------------------------------
+@x l.3558
+@ @<Show the box context@>=
+i:=saved(-4);
+if i<>0 then
+ if i<box_flag then
+ begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
+ if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
+ print_scaled(abs(i)); print("pt");
+ end
+ else if i<ship_out_flag then
+ begin if i>=global_box_flag then
+ begin print_esc("global"); i:=i-(global_box_flag-box_flag);
+ end;
+ print_esc("setbox"); print_int(i-box_flag); print_char("=");
+ end
+ else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
+@y
+@ @<Show the box context@>=
+i:=saved(-4);
+if i<>0 then
+ if i<box_flag then
+ begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
+ if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
+ print_scaled(abs(i)); print("pt");
+ end
+ else if i<ship_out_flag then
+ begin if i>=box_flag+number_regs then
+ begin print_esc("global"); i:=i-number_regs;
+ end;
+ print_esc("setbox"); print_int(i-box_flag); print_char("=");
+ end
+ else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
+@z
diff --git a/Build/source/texk/web2c/eomegadir/eonewdir-rc1.ch b/Build/source/texk/web2c/eomegadir/eonewdir-rc1.ch
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eonewdir-rc1.ch
diff --git a/Build/source/texk/web2c/eomegadir/eonewdir-rc2.ch b/Build/source/texk/web2c/eomegadir/eonewdir-rc2.ch
new file mode 100644
index 00000000000..9cdab96ab09
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eonewdir-rc2.ch
@@ -0,0 +1,52 @@
+% Backport some 1.23 dir primitives to 1.15
+% namely, \boxdir
+% NOT \nextfakemath, which requires too many changes
+
+@x
+@d assign_dir=register+1 {(\.{\\pagedir}, \.{\\textdir})}
+@d max_internal=assign_dir
+ {the largest code that can follow \.{\\the}}
+@y
+@d assign_next_fake_math=register+1 {(\.{\\nextfakemath})} {unused}
+@d assign_box_dir=register+2 {(\.{\\boxdir})}
+@d assign_dir=register+3 {(\.{\\pagedir}, \.{\\textdir})}
+@d max_internal=assign_dir
+ {the largest code that can follow \.{\\the}}
+@z
+
+@x
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_dir: scanned_result(new_eqtb_int(m))(dir_val);
+@y
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_box_dir: begin
+ scan_eight_bit_int;
+ m:=cur_val;
+ if box(m)<>null then cur_val:=box_dir(box(m))
+ else cur_val:=0;
+ cur_val_level:=dir_val;
+ end;
+assign_dir: scanned_result(new_eqtb_int(m))(dir_val);
+@z
+
+@x [47] m.1071
+primitive("xleaders",leader_ship,x_leaders);
+@!@:x_leaders_}{\.{\\xleaders} primitive@>
+@y
+primitive("xleaders",leader_ship,x_leaders);
+@!@:x_leaders_}{\.{\\xleaders} primitive@>
+primitive("boxdir",assign_box_dir,0);
+@!@:box_dir}{\.{\\boxdir} primitive@>
+@z
+
+@x [47] m.1073
+any_mode(make_box): begin_box(0);
+@y
+any_mode(make_box): begin_box(0);
+any_mode(assign_box_dir): begin scan_eight_bit_int;
+ cur_box:=box(cur_val);
+ scan_optional_equals; scan_dir;
+ if cur_box<>null then box_dir(cur_box):=cur_val;
+ end;
+@z
+
diff --git a/Build/source/texk/web2c/eomegadir/eover-rc1.ch b/Build/source/texk/web2c/eomegadir/eover-rc1.ch
new file mode 100644
index 00000000000..2c7eb4f5f8c
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eover-rc1.ch
@@ -0,0 +1,21 @@
+@x
+@d banner=='This is e-Omega, Version 3.141592--1.15--2.1' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.141592--1.15--2.1' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@#
+@d eTeX_banner=='This is e-Omega, Version ',eTeX_version_string
+ {printed when \eTeX\ starts}
+@y
+@d banner=='This is e-Omega, Version 3.141592--1.15--2.1--RC1' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.141592--1.15--2.1--RC1' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@d eOmega_version=0 { \.{\\eOmegaversion} } {TODO: make accessible}
+@d eOmega_revision==".2--RC1" { \.{\\eOmegarevision} } {TODO: make accessible}
+@#
+@d eTeX_banner==banner
+ {printed when \eTeX\ starts}
+@z
diff --git a/Build/source/texk/web2c/eomegadir/eover-rc2.ch b/Build/source/texk/web2c/eomegadir/eover-rc2.ch
new file mode 100644
index 00000000000..669adca570f
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/eover-rc2.ch
@@ -0,0 +1,173 @@
+% e-Omega version-specific stuff;
+% * we define the banner and everything to be
+% e-Omega specific (with e-Omega version numbering
+% added to the sequence --yes, I know it sucks)
+% * we add both \eTeX-like and \OMEGA-like
+% commands to display the version
+@x
+@d banner=='This is e-Omega, Version 3.141592--1.15--2.1' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.141592--1.15--2.1' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@#
+@d eTeX_banner=='This is e-Omega, Version ',eTeX_version_string
+ {printed when \eTeX\ starts}
+@y
+@d banner=='This is e-Omega, Version 3.141592--1.15--2.1--RC2--pre' {printed when \TeX\ starts}
+@#
+@d eTeX_version_string=='3.141592--1.15--2.1--RC2--pre' {current \eTeX\ version}
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".1" { \.{\\eTeXrevision} }
+@d Omega_version_string=="1.15" { \.{\\OmegaVersion} }
+@d eOmega_version_string=="0.3--RC2" { \.{\\eOmegaVersion} }
+@d eOmega_version=0 { \.{\\eOmegaversion} }
+@d eOmega_revision==".3--RC2" { \.{\\eOmegarevision} }
+@#
+@d eTeX_banner==banner
+ {printed when \eTeX\ starts}
+@z
+
+% === e-Omega history ===
+%----------------------------------------
+% Version: 0.1 (RC0)
+% Internal name: the successfull merge
+% Achievement: main executable that would run
+% Release date: 20030131
+%----------------------------------------
+% Version: 0.2 (RC1)
+% Internal name: the successfull trip (NOT)
+% Achievement: fixed the major 'trip' bug
+% making e-Omega usable for
+% Release date: 20030511
+%----------------------------------------
+% Version: 0.3 (RC2)
+% Internal name: <yet unnamed>
+% Achievement: <planned: fix the minor 'trip' bug>
+% <implemented: add \boxdir>
+% <implemented: add versioning info>
+% <implemented: add version-retrieving commands>
+% Release date: <yet to be released>
+%----------------------------------------
+
+@x
+@d eTeX_int=glue_val+4 {first of \eTeX\ codes for integers}
+@y
+@d eOmega_int=glue_val+4 {first of \eOmega\ codes for integers}
+@d eOmega_int_num=1 {number of \eOmega\ integers}
+@d eTeX_int=eOmega_int+eOmega_int_num {first of \eTeX\ codes for integers}
+@z
+
+@x
+@d omega_code=5 {command code for \.{\\OmegaVersion}}
+@d job_name_code=6 {command code for \.{\\jobname}}
+@y
+@d omega_code=5 {command code for \.{\\OmegaVersion}}
+@d eomega_code=6 {command code for \.{\\eOmegaVersion}}
+@d job_name_code=7 {command code for \.{\\jobname}}
+@z
+
+@x
+primitive("OmegaVersion",convert,omega_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+@y
+primitive("OmegaVersion",convert,omega_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+primitive("eOmegaVersion",convert,eomega_code);@/
+@!@:eomega_version_}{\.{\\eOmegaVersion} primitive@>
+@z
+
+@x
+ omega_code: print_esc("OmegaVersion");
+ @/@<Cases of |convert| for |print_cmd_chr|@>@/
+@y
+ omega_code: print_esc("OmegaVersion");
+ @/@<Cases of |convert| for |print_cmd_chr|@>@/
+ eomega_code: print_esc("eOmegaVersion");
+ @/@<Cases of |convert| for |print_cmd_chr|@>@/
+@z
+
+@x
+omega_code:;
+job_name_code: if job_name=0 then open_log_file;
+@y
+omega_code: do_nothing;
+eomega_code: do_nothing;
+job_name_code: if job_name=0 then open_log_file;
+@z
+
+@x
+omega_code: print("1.15");
+job_name_code: print(job_name);
+@y
+omega_code: print(Omega_version_string);
+eomega_code: print(eOmega_version_string);
+job_name_code: print(job_name);
+@z
+
+@x
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+@d eTeX_revision_code=job_name_code+1 {command code for \.{\\eTeXrevision}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+eTeX_version_code: print_esc("eTeXversion");
+
+@ @<Cases for fetching an integer value@>=
+eTeX_version_code: cur_val:=eTeX_version;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+eTeX_revision_code: print_esc("eTeXrevision");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+eTeX_revision_code: do_nothing;
+
+@ @<Cases of `Print the result of command |c|'@>=
+eTeX_revision_code: print(eTeX_revision);
+@y
+@d eOmega_version_code=eOmega_int {code for \.{\\eOmegaversion}}
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+@d eOmega_revision_code=job_name_code+1 {command code for \.{\\eOmegarevision}}
+@d eTeX_revision_code=job_name_code+2 {command code for \.{\\eTeXrevision}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("eOmegaversion",last_item,eOmega_version_code);
+@!@:eTeX_version_}{\.{\\eOmegaversion} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("eOmegarevision",convert,eOmega_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eOmegarevision} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+eOmega_version_code: print_esc("eOmegaversion");
+eTeX_version_code: print_esc("eTeXversion");
+
+@ @<Cases for fetching an integer value@>=
+eOmega_version_code: cur_val:=eOmega_version;
+eTeX_version_code: cur_val:=eTeX_version;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+eOmega_revision_code: print_esc("eOmegarevision");
+eTeX_revision_code: print_esc("eTeXrevision");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+eOmega_revision_code: do_nothing;
+eTeX_revision_code: do_nothing;
+
+@ @<Cases of `Print the result of command |c|'@>=
+eOmega_revision_code: print(eOmega_revision);
+eTeX_revision_code: print(eTeX_revision);
+@z
diff --git a/Build/source/texk/web2c/eomegadir/omega.ch0 b/Build/source/texk/web2c/eomegadir/omega.ch0
new file mode 100644
index 00000000000..dcd72d28087
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/omega.ch0
@@ -0,0 +1,45 @@
+%
+% Copyright (c) 2002-2003 the Omega Task Force
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one resolves inconsistencies between the etex changes for
+% web2c and Omega changes for web2c.
+% Public domain.
+
+@x
+@d banner=='This is e-Omega, Version 3.141592--1.15--2.1--RC1' {printed when \TeX\ starts}
+@y
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@z
+
+@x
+wterm(eTeX_banner);
+@y
+wterm(banner);
+@z
+
+@x
+begin wlog(eTeX_banner);
+@y
+begin wlog(banner);
+@z
+
+@x [50] m.1308 l.23794 - e-TeX basic
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@/@<Undump the \eTeX\ state@>@/
+@y
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@z
+
+@x
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+ store_fmt_file; return;@+tini@/
+@y
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ store_fmt_file; return;@+tini@/
+@z
diff --git a/Build/source/texk/web2c/eomegadir/omega.ch1 b/Build/source/texk/web2c/eomegadir/omega.ch1
new file mode 100644
index 00000000000..a38b0ad409e
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/omega.ch1
@@ -0,0 +1,155 @@
+%
+% Copyright (c) 2002-2003 the Omega Task Force
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one resolves inconsistencies between the etex changes for
+% web2c and Omega changes for web2c.
+% Public domain.
+
+@x
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@d banner_k=='This is Omegak, Version 3.141592--1.15' {printed when \TeX\ starts}
+@y
+@d banner=='This is e-Omega, Version 3.141592--1.15--2.1--RC1' {printed when \TeX\ starts}
+@d banner_k=='This is e-Omegak, Version 3.141592--1.15--2.1--RC1' {printed when \TeX\ starts}
+@z
+
+@x [1.2] l.188 - Web2C: extensions imply we're not TeX.
+@d eTeX_banner==banner
+ {printed when \eTeX\ starts}
+@y
+@d eTeX_banner==banner
+ {printed when \eTeX\ starts}
+@d eTeX_banner_k==banner_k
+@z
+
+@x
+Routine is implemented in C, module is not needed.
+@y
+Routine is implemented in C; part of module is, however, needed for e-TeX.
+
+@<Report overflow of the input buffer, and abort@>=
+ begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+@z
+
+ @x
+ wterm(banner_k)
+ @y
+ wterm(eTeX_banner_k)
+ @z
+
+ @x
+ wterm(banner);
+ @y
+ wterm(eTeX_banner);
+ @z
+
+ @x
+ wlog(banner_k)
+ @y
+ wlog(eTeX_banner_k)
+ @z
+
+ @x
+ wlog(banner);
+ @y
+ wlog(eTeX_banner);
+ @z
+
+% @x l.15074
+% @<DIR: Initialize the text direction@>;
+% @y
+% @<DIR: Initialize the text direction@>;
+% if src_specials_p then begin
+% @z
+
+% @x
+% while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+% @y
+% end;
+% while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+% @z
+
+% @x
+% begin synch_h; synch_v;
+% @y
+% begin synch_h; synch_v;
+% if src_specials_p then begin
+% @z
+
+% @x l.15115
+% repeat f:=font(p); c:=character(p);
+% incr(chars_since_last_special);
+% @y
+% end;
+% repeat f:=font(p); c:=character(p);
+% if src_specials_p then
+% incr(chars_since_last_special);
+% @z
+
+@x
+@<Append character |cur_chr|...@>=
+if ((head=tail) and (mode>0)) then begin
+ if (insert_src_special_auto) then append_src_special;
+end;
+@y
+@<Append character |cur_chr|...@>=
+@z
+
+
+@x
+begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+if (insert_src_special_every_math) then insert_src_special;
+@y
+begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+@z
+
+@x
+ push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+ if (insert_src_special_every_vbox) then insert_src_special;
+@y
+ push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+@z
+
+@x
+@!init procedure store_fmt_file;
+label found1,found2,done1,done2;
+var @!k:integer; {all-purpose indices}
+@y
+@!init procedure store_fmt_file;
+label found1,found2,done1,done2;
+var j,@!k:integer; {all-purpose indices}
+@z
+
+@x [50] m.1308 l.23794 - e-TeX basic
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+@y
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+@/@<Undump the \eTeX\ state@>@/
+@z
+
+@x
+ line_stack:=xmalloc_array (integer, max_in_open);
+@y
+ xmalloc_array (line_stack, max_in_open);
+@z
+
+@x
+ begin @!init if ini_version then
+ begin for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ store_fmt_file; return;
+ end;@+tini@/
+@y
+ begin @!init if ini_version then
+ begin for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+ store_fmt_file; return;
+ end;@+tini@/
+@z
diff --git a/Build/source/texk/web2c/eomegadir/omega.ch2 b/Build/source/texk/web2c/eomegadir/omega.ch2
new file mode 100644
index 00000000000..5216941f80d
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/omega.ch2
@@ -0,0 +1,83 @@
+%
+% Copyright (c) 2002-2003 the Omega Task Force
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one resolves inconsistencies between the etex changes for
+% web2c and Omega changes for web2c.
+% Public domain.
+%
+
+@x [4.51] - Change `eomega.pool' to `pdftex.pool' in error messages
+else bad_pool('! I can''t read omega.pool; bad path?')
+@y
+else bad_pool('! I can''t read eomega.pool; bad path?')
+@z
+
+@x [4.51] - Change `eomega.pool' to `omega.pool' in error messages
+begin if eof(pool_file) then bad_pool('! omega.pool has no check sum.');
+@y
+begin if eof(pool_file) then bad_pool('! eomega.pool has no check sum.');
+@z
+
+@x [4.51] - Change `eomega.pool' to `omega.pool' in error messages
+ bad_pool('! omega.pool line doesn''t begin with two digits.');
+@y
+ bad_pool('! eomega.pool line doesn''t begin with two digits.');
+@z
+
+@x [4.51] - Change `eomega.pool' to `omega.pool' in error messages
+ bad_pool('! omega.pool check sum doesn''t have nine digits.');
+@y
+ bad_pool('! eomega.pool check sum doesn''t have nine digits.');
+@z
+
+@x [4.51] - Change `eomega.pool' to `omega.pool' in error messages
+ bad_pool('! omega.pool doesn''t match; otangle me again (or fix the path).');
+@y
+ bad_pool('! eomega.pool doesn''t match; otangle me again (or fix the path).');
+@z
+
+%----------------------------------------
+@x
+print_err("Omega capacity exceeded, sorry [");
+@y
+print_err("e-Omega capacity exceeded, sorry [");
+@z
+%----------------------------------------
+
+@x
+@=#include "omegamem.h";@>
+@y
+@=#include "eomegamem.h";@>
+@z
+
+@x
+ print("Omega output, Version 3.141592--1.15, ");
+@y
+ print("e-Omega output, Version 3.141592--1.15--2.1--RC1, ");
+@z
+
+@x
+if ini_version then format_ident:=" (INIOMEGA)";
+@y
+if ini_version then format_ident:=" (INIEOMEGA)";
+@z
+
+@x
+ xmalloc_array (line_stack, max_in_open);
+ xmalloc_array (eof_seen, max_in_open);
+ xmalloc_array (grp_stack, max_in_open);
+ xmalloc_array (if_stack, max_in_open);
+@y
+ line_stack:=xmalloc_array (integer, max_in_open);
+ eof_seen:=xmalloc_array (boolean, max_in_open);
+ grp_stack:=xmalloc_array (save_pointer, max_in_open);
+ if_stack:=xmalloc_array (pointer, max_in_open);
+@z
+
+@x
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+@y
+@!init if (buffer[loc]="*")and(format_ident=" (INIEOMEGA)") then
+@z
+
diff --git a/Build/source/texk/web2c/eomegadir/primitives.tex b/Build/source/texk/web2c/eomegadir/primitives.tex
new file mode 100644
index 00000000000..a3c8d868cd3
--- /dev/null
+++ b/Build/source/texk/web2c/eomegadir/primitives.tex
@@ -0,0 +1,12 @@
+\box0=\hboxt dir TRT {}
+
+\showthe\boxdir0
+
+\boxdir0 TLT
+
+\showthe\boxdir0
+
+\eOmegaVersion
+\eOmegaversion
+\eOmegarevision
+
diff --git a/Build/source/texk/web2c/etex.rc b/Build/source/texk/web2c/etex.rc
new file mode 100644
index 00000000000..828e056cc04
--- /dev/null
+++ b/Build/source/texk/web2c/etex.rc
@@ -0,0 +1,46 @@
+/* etex.rc: etex resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " e-TeX 3.14159-2.1"
+
+#define VER_INTERNALNAME_STR TEXLIVE_LIBRARYPREFIX_STR "etex"
+#define VER_ORIGINALFILENAME_STR TEXLIVE_LIBRARYPREFIX_STR "etex.dll"
+
+#define VER_FILEDESCRIPTION_STR "e-TeX DLL"
+
+#define VER_LEGALCOPYRIGHT_STR \
+"e-TeX is copyright (C) 1994-1999 by the NTS team; all rights are reserved.\
+ Copying of this file is authorized only if (1) you are a member of the\
+ NTS team, or if (2) you make absolutely no changes to your copy.\
+ (Programs such as PATCHWEB, TIE, or WEBMERGE allow the application of\
+ several change files to tex.web; the master files tex.web and etex.ch\
+ should stay intact.)"
+
+#define VER_LEGALTRADEMARKS_STR \
+"e-TeX and NTS are trademarks of the NTS group.\
+ TeX is a trademark of the American Mathematical Society."
+
+#define VER_FILETYPE VFT_DLL
+
+#include <texlive.version>
+
+/* etex.rc ends here */
diff --git a/Build/source/texk/web2c/etexdir/ChangeLog b/Build/source/texk/web2c/etexdir/ChangeLog
new file mode 100644
index 00000000000..eb53fb8052c
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/ChangeLog
@@ -0,0 +1,271 @@
+2005-08-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ech: Implement -etex switch.
+
+2004-12-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk (etexextra.c): Depends on etexdir/etexextra.h.
+
+ * etex.mk (etex-check): Add TEXMFCNF=../kpathsea to the mltex
+ test, so the right files are found when the installation is not
+ yet done. From Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+2004-10-12 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch: Fixed a bug in the revised glue rounding code
+ (detected by Tigran Aivazian <tigran@aivazian.fsnet.co.uk>).
+ Version 2.2, dated October 12, 2004.
+
+2004-09-15 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch: Fixed a typo in TeX text, found by Giuseppe
+ Bilotta <bilotta78@hotpop.com>.
+
+2004-09-06 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch: Incorporated register recycling bug fix from Bernd
+ Raichle <bernd@dante.de>.
+ Final Version 2.2 (hopefully).
+
+ * etrip/etrip.{fot,log,tex,typ}, etrip/etripin.log:
+ Updated for current version.
+
+ * etex.mk: Modified rule for etex.version.
+
+2004-08-26 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.mk (etrip): Use etex with "--progname=einitex --ini" or
+ "--progname=etex".
+
+2004-08-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.fix: Include fix for register recycling bug from Bernd
+ Raichle <bernd@dante.de>.
+
+2004-08-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etrip/etripman.tex: Updated to Version 2.2
+
+2004-08-21 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch: Version 2.2.
+
+2004-08-20 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etexextra.in: Peter holds copyright now.
+
+2004-08-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.version: Is from now on a generated file.
+
+ * etexextra.in: renamed from etexextra.h. The current e-TeX
+ version is substituted from etex.version. Variant of code
+ supplied by Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+ * etex.mk: Added rules to extract current e-TeX version from
+ etex.ch and insert into etex.version and etexextra.h. Variant of
+ code supplied by Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+2004-08-17 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk, etex.fix: Resurrected etex.fix, there is again a need
+ to include late-breaking changes.
+
+2004-07-29 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch: Somewhat rearrange mixed direction typesetting code
+ in order to reduce interference between eTeX and pdfTeX change
+ files.
+
+2004-07-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch: Reorganize additional command codes for convert
+ and last_item in order to reduce interference between eTeX and
+ pdfTeX change files.
+
+2004-07-23 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch, tex.ch[01], tex.ech: Reorganize handling of banner
+ string in order to reduce interference between eTeX, pdfTeX,
+ and web2c change files.
+
+2004-07-22 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch: Reorganize handling of additional token types.
+ This also fixed a bug in error context for additional token list
+ parameters, introduced by their reorganization.
+
+2004-07-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etrip/etripin.log: Update from Preter Breitenlohner.
+
+ * etrip/etrip.tex: Update from Peter Breitenlohner.
+
+ * etrip/etrip.fot: Update from Peter Breitenlohner.
+
+2004-07-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch, tex.ch[01]: Reorganize handling of additional token
+ list and integer parameters and e-TeX's additional penalties in
+ order to reduce interference between eTeX, pdfTeX, and web2c
+ change files.
+
+ * etex.ch: Add a note that this file not only defines etex.web
+ in terms of changes to be applies to tex.web, but in addition
+ is used to define pdfetex.web.
+
+ * tex.ech: Add a note that this file is used to construct the
+ web2c change files for both e-TeX and pdfeTeX.
+
+2004-07-17 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.ch: Towards etex-2.2: Adapt to TeX 3.141592; this is still
+ somewhat preliminary; do_glue still needs to be adapted to the new
+ glue rounding algorithm of TeX 3.141592.
+ Incorporate bug fixes from etex.fix.
+
+ * etex.ch0, etrip/etrip.{fot,tex}, etrip/etripin.log: Adapted
+ to TeX 3.141592.
+
+ * tex.ch1, tex.ech: Change the xmalloc_array calls to the `new'
+ interface (from 2001-11-10).
+
+ * etex.ch0, etex.ch1, etex.fix, tex.ch2: Removed.
+
+ * etex.mk: Rewrite build rules for etex.{web,ch}, add
+ etexdir/etex.mk and remove etex.{ch0,ch1,fix}, tex.ch2.
+
+ * etex.version: add newline.
+
+ * etrip/etrip.log, etrip.diffs: changed due to bug fix.
+
+2004-07-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.fix: Add fix for typo on line 2737 of etex.ch. From Peter
+ Breitenlohner.
+
+ * etexextra.h: Add BUG_ADDRESS.
+
+2004-07-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk: Move the creation of the format-related links to
+ format-related install rules; this seems to be a better place for
+ them, as the links are pointless without the corresponding
+ formats. Make the install-*-pool rules depend on the pool file in
+ question.
+
+2004-07-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk: Set up the make rules so that if etex isn't built (by
+ default) we do not forward from the general to the etex-specific
+ rules. But the etex-specific rules can be used.
+
+ * etex.mk: Use $(TANGLE), $(TIE) instead ./tangle, ./tie to
+ support cross-compiling.
+
+2004-05-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk (install-etex-programs): Typo resulted in no etex binary
+ being installed.
+
+2004-05-08 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk (install-etex-programs): This rule didn't have a command
+ attached, so etex didn't get installed.
+ (install-etex-links): Dont install einitex, evirtex links.
+
+ * etex.mk: Formats are now parked in a subdirectory of
+ $(web2cdir).
+
+ * etex.mk: Change the .efmt extension to .fmt. One consequence is
+ that we don't want to build tex.fmt, where we could safely build
+ tex.efmt.
+
+ * etexextra.h: .efmt -> .fmt.
+
+ * tex.ech: .efmt -> .fmt.
+
+2004-01-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.fix: The assignment to cur_val instead of cur_val_level
+ would result in \lastnodetype getting confused about what type of
+ value it was supposed to be. Reported by Hartmut Henkel
+ <hartmut_henkel@gmx.de>, fix found by Fabrice Popineau
+ <Fabrice.Popineau@supelec.fr>.
+
+2003-02-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk: Installation of formats is no longer done via
+ install-data in this file, but just from the install-data ->
+ install-dumps -> install-fmts in the main Makefile. That way we
+ can prevent automatic installation with a single change in that
+ Makefile.
+ (etex.p): Depend on tangle.
+ (triptrap): Depend on etrip.
+ (install-etex-data): Double-colon rule.
+ (install-data): Combine with install-etex-data.
+
+2003-02-17 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.ch1: Reduce to banner changes.
+
+ * etex.ch0: Slightly extend the reverted bits here, so they can be
+ cleared out of etex.ch1 and are now all in one file.
+
+2003-02-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.ch1: Correct the banners, and revert a final few bits of
+ TeX that use a variable that doesn't exist in e-TeX.
+
+ * etex.ch0: TeX 3.141592 and e-TeX 2.1 require reconciliation.
+ Revert some of TeX's code to 3.14159 to get e-TeX 2.1 to tangle.
+
+ * etexextra.h: Update banner for 3.141592-2.1.
+
+ * etex.mk (etex.web): Add etex.ch0 and etex.ch1 to build rules.
+
+2003-02-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk: From klibtool to libtool. Based on patches from Albert
+ Chin-A-Young <china@thewrittenword.com>.
+
+ * etex.mk: Changes to make e-TeX, in extended mode, the engine
+ under LaTeX2e.
+
+2003-02-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk: Reorganized to match the new Makefile.in.
+
+2003-01-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.mk (etestenv): Add LC_ALL=C to the etrip environment.
+
+2002-10-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch1: Settle on a text for the not-TeX banner.
+
+2002-06-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.ch0, tex.ch1: Changes to account for the banner changing
+ when certain options are specified that make the program
+ not-strictly TeX.
+
+ * tex.ch2: Commented-out changes deleted. These changes became
+ active in tex.ch1.
+
+Mon Feb 01 18:35:30 1999 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * Version 2.1 for Web2c Version 7.2
+
+Thu Feb 19 18:03:12 1998 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * Version 2.0 for Web2c Version 7.2
+
+Sat Aug 23 14:14:12 1997 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * Integrated e-TeX Version 1.1 into Web2c Version 7.0
+ (by Karl Berry, as of Feb 7 1997.
+
+ All e-TeX (and e-TRIP) source files as well as a Makefile fragment
+ are in a separate directory: web2c/etexdir. This will certainly make
+ it easier to switch to e-TeX Version 2.
diff --git a/Build/source/texk/web2c/etexdir/INSTALL b/Build/source/texk/web2c/etexdir/INSTALL
new file mode 100644
index 00000000000..71579017187
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/INSTALL
@@ -0,0 +1,98 @@
+Contents:
+
+Installation
+ Additional `configure' options
+ Additional targets
+ Trip, etrip, trap, and mptrap: Torture tests
+
+
+Installation
+************
+
+ Installing e-TeX requires that you have already installed the Web2c
+source tree (either `web-7.2.tar.gz' and `web2c-7.2.tar.gz' with
+`web2c-7.2' as top-level directory, or `texk-7.2.tar.gz' with `texk-7.2').
+See web2c/INSTALL for details.
+
+Unpack the distribution file `web2c-7.2-etex-2.0.tar.gz' in the parent of
+the top-level directory. If necessary move the directory
+`<top_level>/web2c/etexdir' containing all e-TeX files into your source
+tree. Then (re-)configure the whole source tree.
+
+You will also need some e-TeX specific files in the TDS tree. Change to
+to the TDS root (`<texmf>') and unpack the distribution file
+`etexlib-2.0.tar.gz'. If you have already installed an earlier version,
+first remove the directory `<texmf>/etex' containing all the old files.
+
+Additional `configure' options
+==============================
+
+ This section describes only the e-TeX specific `configure' options,
+for the general Web2c `configure' options see `../INSTALL'.
+
+`--without-etex'
+`--with-etex=no'
+ Do not automatically generate and install e-TeX and e-TeX formats
+ (as part of `make' resp. `make install').
+
+`--with-etex=yes'
+`--with-etex=etex'
+ Automatically generate and install e-TeX and e-TeX formats (in
+ extended mode) in addition to TeX and TeX formats. This is the default.
+
+`--with-etex=tex'
+ Automatically generate e-TeX and e-TeX formats (in compatibility as
+ well as extended mode) and install them, using e-TeX instead of TeX.
+ Do not install TeX and TeX formats.
+
+Additional targets
+==================
+
+ e-TeX adds some new Web2c Make targets and the e-TeX specific `configure'
+options described above influence the behaviour of some other targets.
+
+`formats'
+`install-formats'
+ Make or install all the memory dumps (*note Memory dumps::.). By
+ default, the standard plain formats plus `latex.fmt' or `latex.efmt'
+ plus possibly `elatex.efmt' are made. The `latex.efmt' is in e-TeX
+ compatibility mode, to be used when e-TeX is installed instead of TeX;
+ the `elatex.efmt' is in extended mode. You can add other formats by
+ redefining the `fmts', `cfmts', `efmts', `bases', and `mems' variables.
+ See the top of `web2c/Makefile' for the possibilities.
+
+`triptrap'
+`trip'
+`etrip'
+`trap'
+`mptrap'
+ To run the torture tests for TeX, e-TeX, Metafont, and MetaPost
+ (respectively). See the next section.
+
+Trip, etrip, trap, and mptrap: Torture tests
+============================================
+
+ To validate your TeX and/or e-TeX, Metafont, and MetaPost executables,
+run `make triptrap'. This runs the trip and/or etrip, trap, and mptrap
+"torture tests". See the files `triptrap/tripman.tex',
+`etexdir/etrip/etripman.tex', `triptrap/trapman.tex', and
+`triptrap/mptrap.readme' for detailed information and background on the
+tests.
+
+ The differences between your executables' behavior and the standard
+values will show up on your terminal. See the file `./INSTALL' for the
+acceptable differences.
+
+ The files `trip.diffs', `mftrap.diffs', and `mptrap.diffs' in the
+`triptrap' directory and `etexdir/etrip/etrip.diffs' show the standard diffs
+against the original output. If you diff your diffs against these files,
+you should come up clean. For example
+ make etrip >&myetrip.diffs
+ diff etexdir/etrip/etrip.diffs myetrip.diffs
+
+ To run the tests separately, use the targets `trip', `etrip', `trap', and
+`mptrap'. Warning: with the `configure' option `--without-etex' the target
+`etrip' will cause Make to first generate the e-TeX executable; similarly
+with the `configure' option `--with-etex=tex' the target `trip' will cause
+Make to first generate the TeX executable.
+
diff --git a/Build/source/texk/web2c/etexdir/README b/Build/source/texk/web2c/etexdir/README
new file mode 100644
index 00000000000..87864b2aa1c
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/README
@@ -0,0 +1,16 @@
+This directory contains the Web2c implementation of e-TeX (Version 2.0).
+
+See `NEWS' for major changes by release, `ChangeLog` for all changes.
+See `INSTALL' for installation instructions.
+See `../../kpathsea/BUGS' for details on reporting bugs.
+
+e-TeX is copyright (C) 1994,97 by the NTS team; all rights are reserved.
+
+You can get the original e-TeX from http://www.rhbnc.ac.uk/e-TeX/ or
+from ftp://www.rhbnc.ac.uk/e-TeX/ (these URLs map to the identical fileset).
+Current information on e-TeX is also available at the same location.
+
+The original Web2c files can be obtained from
+ftp://ftpth.mppmu.mpg.de/e-TeX/latest
+
+Peter Breitenlohner <peb@mppmu.mpg.de>
diff --git a/Build/source/texk/web2c/etexdir/etex.ch b/Build/source/texk/web2c/etexdir/etex.ch
new file mode 100644
index 00000000000..74c19e79057
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etex.ch
@@ -0,0 +1,6181 @@
+% This is etex.ch in text format, as of October 12, 2004.
+% WEB change file containing code for various features extending TeX;
+% to be applied to tex.web (Version 3.141592) in order to define the
+% e-TeX program.
+
+% Note: This file defines etex.web in terms of changes to be applied to
+% tex.web; in terms of a program such as TIE (or equivalent), directories
+% may vary:
+%
+% tex.web )
+% + ) => tie -m ... => etex.web
+% etexdir/etex.ch )
+%
+% In addition, this file is used to define pdfetex.web, a combination
+% of e-TeX and pdfTeX as follows:
+%
+% tex.web )
+% + )
+% etexdir/etex.ch )
+% + )
+% pdfetexdir/pdfetex.ch1 ) => tie -m ... => pdfetex.web
+% + )
+% pdftexdir/pdftex.ch )
+% + )
+% pdfetexdir/pdfetex.ch2 )
+%
+% where the two (small) files pdfetexdir/pdfetex.ch[12] take care of
+% interferences between e-Tex changes (etexdir/etex.ch) and pdfTeX changes
+% (pdftexdir/pdftex.ch). Consequently, changes in these files have to be
+% coordinated.
+
+% e-TeX is copyright (C) 1999-2004 by P. Breitenlohner (1994,98 by the NTS
+% team); all rights are reserved. Copying of this file is authorized only if
+% (1) you are P. Breitenlohner, or if (2) you make absolutely no changes to
+% your copy. (Programs such as TIE allow the application of several change
+% files to tex.web; the master files tex.web and etex.ch should stay intact.)
+
+% See etex_gen.tex for hints on how to install this program.
+% And see etripman.tex for details about how to validate it.
+
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+% e-TeX and NTS are trademarks of the NTS group.
+
+% All line numbers refer to tex.web 3.141592 as of December 21, 2002.
+
+@x limbo l.1 - this is e-TeX
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+% Copying of this file is authorized only if (1) you are D. E. Knuth, or if
+% (2) you make absolutely no changes to your copy. (The WEB system provides
+% for alterations via an auxiliary file; the master file should stay intact.)
+% See Appendix H of the WEB manual for hints on how to install this program.
+% And see Appendix A of the TRIP manual for details about how to validate it.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+@y
+% e-TeX is copyright (C) 1994,98 by the NTS team; all rights are reserved.
+% Copying of this file is authorized only if (1) you are a member of the
+% NTS team, or if (2) you make absolutely no changes to your copy.
+% (Programs such as PATCHWEB, TIE, or WEBMERGE allow the application of
+% several change files to tex.web; the master files tex.web and etex.ch
+% should stay intact.)
+
+% See etex_gen.tex for hints on how to install this program.
+% And see etripman.tex for details about how to validate it.
+
+% e-TeX and NTS are trademarks of the NTS group.
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+
+% This program is directly derived from Donald E. Knuth's TeX;
+% the change history which follows and the reward offered for finders of
+% bugs refer specifically to TeX; they should not be taken as referring
+% to e-TeX, although the change history is relevant in that it
+% demonstrates the evolutionary path followed. This program is not TeX;
+% that name is reserved strictly for the program which is the creation
+% and sole responsibility of Professor Knuth.
+@z
+%---------------------------------------
+@x limbo l.50 - e-TeX history
+% Although considerable effort has been expended to make the TeX program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the author hopes that users enjoy it.
+@y
+% A preliminary version of TeX--XeT was released in April 1992.
+% TeX--XeT version 1.0 was released in June 1992,
+% version 1.1 prevented arith overflow in glue computation (Oct 1992).
+% A preliminary e-TeX version 0.95 was operational in March 1994.
+% Version 1.0beta was released in May 1995.
+% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995).
+% Version 1.02beta allowed 256 mark classes (March 1996).
+% Version 1.1 changed \group{type,level} -> \currentgroup{type,level},
+% first public release (October 1996).
+% Version 2.0 development was started in March 1997;
+% fixed a ligature-\beginR bug in January 1998;
+% was released in March 1998.
+% Version 2.1 fixed a \marks bug (when min_halfword<>0) (January 1999).
+% Version 2.2 development was started in Feb 2003; released in Oct 2004.
+% fixed a bug in sparse array handling (0=>null), Jun 2002;
+% fixed a bug in \lastnodetype (cur_val=>cur_val_level)
+% reported by Hartmut Henkel <hartmut_henkel@@gmx.de>,
+% fix by Fabrice Popineau <Fabrice.Popineau@@supelec.fr>,
+% Jan 2004;
+% another bug in sparse array handling (cur_ptr=>cur_chr)
+% reported by Taco Hoekwater <taco@@elvenkind.com>, Jul 2004;
+% fixed a sparse array reference count bug (\let,\futurelet),
+% fix by Bernd Raichle <berd@@dante.de>, Aug 2004;
+% reorganized handling of banner, additional token list and
+% integer parameters, and similar in order to reduce the
+% interference between eTeX, pdfTeX, and web2c change files.
+% adapted to tex.web 3.141592, revised glue rounding for mixed
+% direction typesetting;
+% fixed a bug in the revised glue rounding code, detected by
+% Tigran Aivazian <tigran@@aivazian.fsnet.co.uk>, Oct 2004.
+
+% Although considerable effort has been expended to make the e-TeX program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the author hopes that users enjoy it.
+@z
+%---------------------------------------
+@x limbo l.62 - e-TeX logo, TeXXeT
+\let\mc=\ninerm % medium caps for names like SAIL
+@y
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\eTeX{$\varepsilon$-\TeX}
+\font\revrm=xbmc10 % for right-to-left text
+% to generate xbmc10 (i.e., reflected cmbx10) use a file
+% xbmc10.mf containing:
+%+++++++++++++++++++++++++++++++++++++++++++++++++
+% if unknown cmbase: input cmbase fi
+% extra_endchar := extra_endchar &
+% "currentpicture:=currentpicture " &
+% "reflectedabout((.5[l,r],0),(.5[l,r],1));";
+% input cmbx10
+%+++++++++++++++++++++++++++++++++++++++++++++++++
+\ifx\beginL\undefined % this is TeX
+ \def\XeT{X\kern-.125em\lower.5ex\hbox{E}\kern-.1667emT}
+ \def\TeXeT{\TeX-\hbox{\revrm \XeT}} % for TeX-XeT
+ \def\TeXXeT{\TeX-\hbox{\revrm -\XeT}} % for TeX--XeT
+\else
+ \ifx\eTeXversion\undefined % this is \TeXeT
+ \def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT
+ \def\TeXXeT{\TeX-{\revrm\beginR\TeX-\endR}} % for TeX--XeT
+ \else % this is \eTeX
+ \def\TeXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX\endR}} % for TeX-XeT
+ \def\TeXXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX-\endR}} % for TeX--XeT
+ \fi
+\fi
+@z
+%---------------------------------------
+@x limbo l.65 - bug fix (print only changed modules)
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+@y
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\def\grp{\.{\char'173...\char'175}}
+@z
+%---------------------------------------
+@x limbo l.81 - e-TeX basic
+\def\title{\TeX82}
+@y
+\def\title{\eTeX}
+% system dependent redefinitions of \title should come later
+% and should use:
+% \toks0=\expandafter{\title}
+% \edef\title{...\the\toks0...}
+\let\maybe=\iffalse % print only changed modules
+@z
+%---------------------------------------
+@x [1] m.1 l.92 - this is e-TeX
+This is \TeX, a document compiler intended to produce typesetting of high
+@y
+This is \eTeX, a program derived from and extending the capabilities of
+\TeX, a document compiler intended to produce typesetting of high
+@z
+%---------------------------------------
+@x [1] m.2 l.180 - e-TeX basic
+If this program is changed, the resulting system should not be called
+@y
+This program contains code for various features extending \TeX,
+therefore this program is called `\eTeX' and not
+@z
+%---------------------------------------
+@x [1] m.2 l.186 - e-TeX basic
+November 1984].
+@y
+November 1984].
+
+A similar test suite called the ``\.{e-TRIP} test'' is available for
+helping to determine whether a particular implementation deserves to be
+known as `\eTeX'.
+@z
+%---------------------------------------
+@x [1] m.2 l.188 - e-TeX basic
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@y
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".2" { \.{\\eTeXrevision} }
+@d eTeX_version_string=='-2.2' {current \eTeX\ version}
+@#
+@d eTeX_banner=='This is e-TeX, Version 3.141592',eTeX_version_string
+ {printed when \eTeX\ starts}
+@#
+@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@#
+@d banner==eTeX_banner
+@#
+@d TEX==ETEX {change program name into |ETEX|}
+@#
+@d TeXXeT_code=0 {the \TeXXeT\ feature is optional}
+@#
+@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|}
+@z
+%---------------------------------------
+@x [1] m.3 l.207 - e-TeX basic
+scalar types; there are no `\&{var}' parameters, except in the case of files;
+@y
+scalar types; there are no `\&{var}' parameters, except in the case of files
+--- \eTeX, however, does use `\&{var}' parameters for the |reverse| function;
+@z
+%---------------------------------------
+@x [1] m.15 l.499 - e-TeX basic
+@d not_found=45 {go here when you've found nothing}
+@y
+@d not_found=45 {go here when you've found nothing}
+@d not_found1=46 {like |not_found|, when there's more than one}
+@d not_found2=47 {like |not_found|, when there's more than two}
+@d not_found3=48 {like |not_found|, when there's more than three}
+@d not_found4=49 {like |not_found|, when there's more than four}
+@z
+%---------------------------------------
+@x [10] m.141 l.2971 - e-TeX marks
+This field occupies a full word instead of a halfword, because
+there's nothing to put in the other halfword; it is easier in \PASCAL\ to
+use the full word than to risk leaving garbage in the unused half.
+@y
+In addition there is a |mark_class| field that contains the mark class.
+@z
+%---------------------------------------
+@x [10] m.141 l.2977 - e-TeX marks
+@d mark_ptr(#)==mem[#+1].int {head of the token list for a mark}
+@y
+@d mark_ptr(#)==link(#+1) {head of the token list for a mark}
+@d mark_class(#)==info(#+1) {the mark class}
+@z
+%---------------------------------------
+@x [10] m.142 l.2986 - e-TeX marks
+@d adjust_ptr==mark_ptr {vertical list to be moved out of horizontal list}
+@y
+@d adjust_ptr(#)==mem[#+1].int
+ {vertical list to be moved out of horizontal list}
+@z
+%---------------------------------------
+@x [10] m.147 l.3075 - e-TeX TeXXeT
+the amount of surrounding space inserted by \.{\\mathsurround}.
+@y
+the amount of surrounding space inserted by \.{\\mathsurround}.
+
+In addition a |math_node| with |subtype>after| and |width=0| will be
+(ab)used to record a regular |math_node| reinserted after being
+discarded at a line break or one of the text direction primitives (
+\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} ).
+@z
+%---------------------------------------
+@x [10] m.147 l.3079 - e-TeX TeXXeT
+@d after=1 {|subtype| for math node that winds up a formula}
+@y
+@d after=1 {|subtype| for math node that winds up a formula}
+@#
+@d M_code=2
+@d begin_M_code=M_code+before {|subtype| for \.{\\beginM} node}
+@d end_M_code=M_code+after {|subtype| for \.{\\endM} node}
+@d L_code=4
+@d begin_L_code=L_code+begin_M_code {|subtype| for \.{\\beginL} node}
+@d end_L_code=L_code+end_M_code {|subtype| for \.{\\endL} node}
+@d R_code=L_code+L_code
+@d begin_R_code=R_code+begin_M_code {|subtype| for \.{\\beginR} node}
+@d end_R_code=R_code+end_M_code {|subtype| for \.{\\endR} node}
+@#
+@d end_LR(#)==odd(subtype(#))
+@d end_LR_type(#)==(L_code*(subtype(#) div L_code)+end_M_code)
+@d begin_LR_type(#)==(#-after+before)
+@z
+%---------------------------------------
+@x [12] m.175 l.3552 - e-TeX TeXXeT
+math_node: print_char("$");
+@y
+math_node: if subtype(p)>=L_code then print("[]")
+ else print_char("$");
+@z
+%---------------------------------------
+@x [12] m.184 l.3719 - e-TeX TeXXeT
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+@y
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+ if eTeX_ex then @<Display if this box is never to be reversed@>;
+@z
+%---------------------------------------
+@x [12] m.192 l.3817 - e-TeX TeXXeT
+begin print_esc("math");
+@y
+if subtype(p)>after then
+ begin if end_LR(p) then print_esc("end")
+ else print_esc("begin");
+ if subtype(p)>R_code then print_char("R")
+ else if subtype(p)>L_code then print_char("L")
+ else print_char("M");
+ end else
+begin print_esc("math");
+@z
+%---------------------------------------
+@x [12] m.196 l.3850 - e-TeX marks
+begin print_esc("mark"); print_mark(mark_ptr(p));
+@y
+begin print_esc("mark");
+if mark_class(p)<>0 then
+ begin print_char("s"); print_int(mark_class(p));
+ end;
+print_mark(mark_ptr(p));
+@z
+%---------------------------------------
+@x [15] m.208 l.4087 - e-TeX saved_items
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+@y
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+ {( or \.{\\pagediscards}, \.{\\splitdiscards} )}
+@z
+%---------------------------------------
+@x [15] m.208 l.4097 - e-TeX TeXXeT
+@d valign=33 {vertical table alignment ( \.{\\valign} )}
+@y
+@d valign=33 {vertical table alignment ( \.{\\valign} )}
+ {or text direction directives ( \.{\\beginL}, etc.~)}
+@z
+%---------------------------------------
+@x [15] m.208 l.4113 - e-TeX middle
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+@y
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+ {( or \.{\\middle} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4157 - e-TeX basic
+ \.{\\insertpenalties} )}
+@y
+ \.{\\insertpenalties} )}
+ {( or \.{\\interactionmode} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4159 - e-TeX penalties
+@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
+@y
+@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
+ {(or \.{\\interlinepenalties}, etc.~)}
+@z
+%---------------------------------------
+@x [15] m.209 l.4169 - e-TeX protected
+@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@y
+@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+ {( or \.{\\protected} )}
+@z
+%---------------------------------------
+@x [15] m.209 l.4172 - e-TeX read_line
+@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
+@y
+@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
+ {( or \.{\\readline} )}
+@z
+%---------------------------------------
+@x [15] m.210 l.4187 - e-TeX scan_tokens
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+@y
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+ {( or \.{\\scantokens} )}
+@z
+%---------------------------------------
+@x [15] m.210 l.4192 - e-TeX unexpanded
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+@y
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+ {( or \.{\\unexpanded}, \.{\\detokenize} )}
+@z
+%---------------------------------------
+@x [16] m.212 l.4295 - e-TeX basic
+user's output routine.
+@y
+user's output routine.
+
+A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX.
+In vertical modes it is known as |LR_save| and holds the LR stack when a
+paragraph is interrupted by a displayed formula. In display math mode
+it is known as |LR_box| and holds a pointer to a prototype box for the
+display. In math mode it is known as |delim_ptr| and points to the most
+recent |left_noad| or |middle_noad| of a |math_left_group|.
+@z
+%---------------------------------------
+@x [16] m.212 l.4310 - e-TeX basic
+ @!head_field,@!tail_field: pointer;
+@y
+ @!head_field,@!tail_field: pointer;
+ @!eTeX_aux_field: pointer;
+@z
+%---------------------------------------
+@x [16] m.213 l.4317 - e-TeX basic
+@d tail==cur_list.tail_field {final node on current list}
+@y
+@d tail==cur_list.tail_field {final node on current list}
+@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX}
+@d LR_save==eTeX_aux {LR stack when a paragraph is interrupted}
+@d LR_box==eTeX_aux {prototype box for display}
+@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group}
+@z
+%---------------------------------------
+@x [16] m.215 l.4348 - e-TeX basic
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+@y
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+eTeX_aux:=null;
+@z
+%---------------------------------------
+@x [16] m.216 l.4364 push_nest - e-TeX basic
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+eTeX_aux:=null;
+@z
+%---------------------------------------
+@x [17] m.230 l.4727 - e-TeX basic, every_eof
+@d toks_base=local_base+10 {table of 256 token list registers}
+@y
+@d tex_toks=local_base+10 {end of \TeX's token list parameters}
+@#
+@d etex_toks_base=tex_toks {base for \eTeX's token list parameters}
+@d every_eof_loc=etex_toks_base {points to token list for \.{\\everyeof}}
+@d etex_toks=etex_toks_base+1 {end of \eTeX's token list parameters}
+@#
+@d toks_base=etex_toks {table of 256 token list registers}
+@z
+%---------------------------------------
+@x [17] m.230 l.4728 - e-TeX basic, penalties
+@d box_base=toks_base+256 {table of 256 box registers}
+@y
+@#
+@d etex_pen_base=toks_base+256 {start of table of \eTeX's penalties}
+@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines}
+@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines}
+@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines}
+@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display}
+@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties}
+@#
+@d box_base=etex_pens {table of 256 box registers}
+@z
+%---------------------------------------
+@x [17] m.231 l.4793 - e-TeX basic
+ othercases print_esc("errhelp")
+@y
+ @/@<Cases of |assign_toks| for |print_cmd_chr|@>@/
+ othercases print_esc("errhelp")
+@z
+%---------------------------------------
+@x [17] m.232 l.4811 - e-TeX penalties
+eq_level(par_shape_loc):=level_one;@/
+@y
+eq_level(par_shape_loc):=level_one;@/
+for k:=etex_pen_base to etex_pens-1 do
+ eqtb[k]:=eqtb[par_shape_loc];
+@z
+%---------------------------------------
+@x [17] m.233 l.4839 - e-TeX penalties
+if n=par_shape_loc then
+ begin print_esc("parshape"); print_char("=");
+ if par_shape_ptr=null then print_char("0")
+@y
+if (n=par_shape_loc) or ((n>=etex_pen_base) and (n<etex_pens)) then
+ begin print_cmd_chr(set_shape,n); print_char("=");
+ if equiv(n)=null then print_char("0")
+ else if n>par_shape_loc then
+ begin print_int(penalty(equiv(n))); print_char(" ");
+ print_int(penalty(equiv(n)+1));
+ if penalty(equiv(n))>1 then print_esc("ETC.");
+ end
+@z
+%---------------------------------------
+@x [17] m.236 l.4960 - e-TeX basic
+@d int_pars=55 {total number of integer parameters}
+@y
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@#
+@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters}
+@d tracing_assigns_code=etex_int_base {show assignments}
+@d tracing_groups_code=etex_int_base+1 {show save/restore groups}
+@d tracing_ifs_code=etex_int_base+2 {show conditionals}
+@d tracing_scan_tokens_code=etex_int_base+3 {show pseudo file open and close}
+@d tracing_nesting_code=etex_int_base+4 {show incomplete groups and ifs within files}
+@d pre_display_direction_code=etex_int_base+5 {text direction preceding a display}
+@d last_line_fit_code=etex_int_base+6 {adjustment for last line of paragraph}
+@d saving_vdiscards_code=etex_int_base+7 {save items discarded from vlists}
+@d saving_hyph_codes_code=etex_int_base+8 {save hyphenation codes for languages}
+@d eTeX_state_code=etex_int_base+9 {\eTeX\ state variables}
+@d etex_int_pars=eTeX_state_code+eTeX_states {total number of \eTeX's integer parameters}
+@#
+@d int_pars=etex_int_pars {total number of integer parameters}
+@z
+%---------------------------------------
+@x [17] m.236 l.5022 - e-TeX basic
+@d error_context_lines==int_par(error_context_lines_code)
+@y
+@d error_context_lines==int_par(error_context_lines_code)
+@#
+@d tracing_assigns==int_par(tracing_assigns_code)
+@d tracing_groups==int_par(tracing_groups_code)
+@d tracing_ifs==int_par(tracing_ifs_code)
+@d tracing_scan_tokens==int_par(tracing_scan_tokens_code)
+@d tracing_nesting==int_par(tracing_nesting_code)
+@d pre_display_direction==int_par(pre_display_direction_code)
+@d last_line_fit==int_par(last_line_fit_code)
+@d saving_vdiscards==int_par(saving_vdiscards_code)
+@d saving_hyph_codes==int_par(saving_hyph_codes_code)
+@z
+%---------------------------------------
+@x [17] m.237 l.5087 print_param - e-TeX basic
+othercases print("[unknown integer parameter!]")
+@y
+@/@<Cases for |print_param|@>@/
+othercases print("[unknown integer parameter!]")
+@z
+%---------------------------------------
+@x [18] m.264 l.5618 primitive - e-TeX basic
+@!j:small_number; {index into |buffer|}
+@y
+@!j:0..buf_size; {index into |buffer|}
+@z
+%---------------------------------------
+@x [18] m.264 l.5622 primitive - e-TeX basic
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+@y
+ {we will move |s| into the (possibly non-empty) |buffer|}
+ if first+l>buf_size+1 then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
+@z
+%---------------------------------------
+@x [18] m.265 l.5697 - e-TeX penalties
+primitive("parshape",set_shape,0);@/
+@y
+primitive("parshape",set_shape,par_shape_loc);@/
+@z
+%---------------------------------------
+@x [18] m.265 l.5714 - e-TeX sparse arrays
+primitive("toks",toks_register,0);@/
+@y
+primitive("toks",toks_register,mem_bot);@/
+@z
+%---------------------------------------
+@x [18] m.266 l.5747 - e-TeX cond
+expand_after: print_esc("expandafter");
+@y
+expand_after: if chr_code=0 then print_esc("expandafter")
+ @<Cases of |expandafter| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5753 - e-TeX marks
+mark: print_esc("mark");
+@y
+mark: begin print_esc("mark");
+ if chr_code>0 then print_char("s");
+ end;
+@z
+%---------------------------------------
+@x [18] m.266 l.5764 - e-TeX read_line
+read_to_cs: print_esc("read");
+@y
+read_to_cs: if chr_code=0 then print_esc("read")
+ @<Cases of |read| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5768 - e-TeX penalties
+set_shape: print_esc("parshape");
+@y
+set_shape: case chr_code of
+ par_shape_loc: print_esc("parshape");
+ @<Cases of |set_shape| for |print_cmd_chr|@>@;@/
+ end; {there are no other cases}
+@z
+%---------------------------------------
+@x [18] m.266 l.5769 - e-TeX unexpanded
+the: print_esc("the");
+@y
+the: if chr_code=0 then print_esc("the")
+ @<Cases of |the| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5770 - e-TeX sparse arrays
+toks_register: print_esc("toks");
+@y
+toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [18] m.266 l.5772 - e-TeX TeXXeT
+valign: print_esc("valign");
+@y
+valign: if chr_code=0 then print_esc("valign")@/
+ @<Cases of |valign| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [19] m.268 l.5806 - e-TeX sparse arrays
+interpreted in one of four ways:
+@y
+interpreted in one of five ways:
+@z
+%---------------------------------------
+@x [19] m.268 l.5826 - e-TeX tracing
+the entries for that group.
+@y
+the entries for that group.
+Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
+source line number at which the current level of grouping was entered.
+
+\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a
+chain of sparse array entries to be restored at the end of the current
+group. Furthermore |save_index(p)| and |save_level(p)| should replace
+the values of |sa_chain| and |sa_level| respectively.
+@z
+%---------------------------------------
+@x [19] m.268 l.5836 - e-TeX basic
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@y
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+@d restore_sa=4 {|save_type| when sparse array entries should be restored}
+
+@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
+@z
+%---------------------------------------
+@x [19] m.273 l.5894 - e-TeX tracing
+@ The following macro is used to test if there is room for up to six more
+@y
+@ The following macro is used to test if there is room for up to seven more
+@z
+%---------------------------------------
+@x [19] m.273 l.5900 check_full_save_stack - e-TeX tracing
+ if max_save_stack>save_size-6 then overflow("save size",save_size);
+@y
+ if max_save_stack>save_size-7 then overflow("save size",save_size);
+@z
+%---------------------------------------
+@x [19] m.274 l.5922 new_save_level - e-TeX tracing
+begin check_full_save_stack;
+@y
+begin check_full_save_stack;
+if eTeX_ex then
+ begin saved(0):=line; incr(save_ptr);
+ end;
+@z
+%---------------------------------------
+@x [19] m.274 l.5929 new_save_level - e-TeX tracing
+cur_boundary:=save_ptr; incr(cur_level); incr(save_ptr); cur_group:=c;
+@y
+cur_boundary:=save_ptr; cur_group:=c;
+@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/
+incr(cur_level); incr(save_ptr);
+@z
+%---------------------------------------
+@x [19] m.275 l.5947 eq_destroy - e-TeX sparse arrays
+othercases do_nothing
+@y
+@/@<Cases for |eq_destroy|@>@/
+othercases do_nothing
+@z
+%---------------------------------------
+@x [19] m.277 l.5969 - e-TeX tracing
+the call, since |eq_save| makes the necessary test.
+@y
+the call, since |eq_save| makes the necessary test.
+
+@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#);
+ tats
+@z
+%---------------------------------------
+@x [19] m.277 l.5973 eq_define - e-TeX tracing
+begin if eq_level(p)=cur_level then eq_destroy(eqtb[p])
+@y
+label exit;
+begin if eTeX_ex and(eq_type(p)=t)and(equiv(p)=e) then
+ begin assign_trace(p,"reassigning")@;@/
+ eq_destroy(eqtb[p]); return;
+ end;
+assign_trace(p,"changing")@;@/
+if eq_level(p)=cur_level then eq_destroy(eqtb[p])
+@z
+%---------------------------------------
+@x [19] m.277 l.5976 eq_define - e-TeX tracing
+end;
+@y
+assign_trace(p,"into")@;@/
+exit:end;
+@z
+%---------------------------------------
+@x [19] m.278 l.5983 eq_word_define - e-TeX tracing
+begin if xeq_level[p]<>cur_level then
+@y
+label exit;
+begin if eTeX_ex and(eqtb[p].int=w) then
+ begin assign_trace(p,"reassigning")@;@/
+ return;
+ end;
+assign_trace(p,"changing")@;@/
+if xeq_level[p]<>cur_level then
+@z
+%---------------------------------------
+@x [19] m.278 l.5987 eq_word_define - e-TeX tracing
+end;
+@y
+assign_trace(p,"into")@;@/
+exit:end;
+@z
+%---------------------------------------
+@x [19] m.279 l.5996 geq_define - e-TeX tracing
+begin eq_destroy(eqtb[p]);
+eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
+@y
+begin assign_trace(p,"globally changing")@;@/
+begin eq_destroy(eqtb[p]);
+eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
+end;
+assign_trace(p,"into")@;@/
+@z
+%---------------------------------------
+@x [19] m.279 l.6001 geq_word_define - e-TeX tracing
+begin eqtb[p].int:=w; xeq_level[p]:=level_one;
+@y
+begin assign_trace(p,"globally changing")@;@/
+begin eqtb[p].int:=w; xeq_level[p]:=level_one;
+end;
+assign_trace(p,"into")@;@/
+@z
+%---------------------------------------
+@x [19] m.281 l.6018 - e-TeX tracing
+@p@t\4@>@<Declare the procedure called |restore_trace|@>@;@/
+@y
+@p
+@z
+%---------------------------------------
+@x [19] m.281 l.6025 unsave - e-TeX optimized \aftergroup
+begin if cur_level>level_one then
+@y
+@!a:boolean; {have we already processed an \.{\\aftergroup} ?}
+begin a:=false;
+if cur_level>level_one then
+@z
+%---------------------------------------
+@x [19] m.282 l.6039 - e-TeX sparse arrays
+ else begin if save_type(save_ptr)=restore_old_value then
+@y
+ else if save_type(save_ptr)=restore_sa then
+ begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr);
+ end
+ else begin if save_type(save_ptr)=restore_old_value then
+@z
+%---------------------------------------
+@x [19] m.282 l.6047 - e-TeX tracing
+done: cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr)
+@y
+done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/
+if grp_stack[in_open]=cur_boundary then group_warning;
+ {groups possibly not properly nested with files}
+cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr);
+if eTeX_ex then decr(save_ptr)
+@z
+%---------------------------------------
+@x [19] m.284 l.6073 - e-TeX tracing
+@ @<Declare the procedure called |restore_trace|@>=
+@y
+@ @<Declare \eTeX\ procedures for tr...@>=
+@z
+%---------------------------------------
+@x [20] m.289 l.6161 - e-TeX protected
+@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
+@y
+@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
+@d protected_token=@'7001 {$2^8\cdot|end_match|+1$}
+@z
+%---------------------------------------
+@x [20] m.294 l.6286 - e-TeX protected
+end_match: print("->");
+@y
+end_match: if c=0 then print("->");
+@z
+%---------------------------------------
+@x [20] m.296 l.6307 print_meaning - e-TeX marks
+else if cur_cmd=top_bot_mark then
+@y
+else if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then
+@z
+%---------------------------------------
+@x [21] m.298 l.6381 print_cmd_chr - e-TeX protected
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@y
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+var n:integer; {temp variable}
+@z
+%---------------------------------------
+@x [21] m.299 l.6400 show_cur_cmd_chr - e-TeX tracing
+@p procedure show_cur_cmd_chr;
+@y
+@p procedure show_cur_cmd_chr;
+var n:integer; {level of \.{\\if...\\fi} nesting}
+@!l:integer; {line where \.{\\if} started}
+@!p:pointer;
+@z
+%---------------------------------------
+@x [21] m.299 l.6405 show_cur_cmd_chr - e-TeX tracing
+print_cmd_chr(cur_cmd,cur_chr); print_char("}");
+@y
+print_cmd_chr(cur_cmd,cur_chr);
+if tracing_ifs>0 then
+ if cur_cmd>=if_test then if cur_cmd<=fi_or_else then
+ begin print(": ");
+ if cur_cmd=fi_or_else then
+ begin print_cmd_chr(if_test,cur_if); print_char(" ");
+ n:=0; l:=if_line;
+ end
+ else begin n:=1; l:=line;
+ end;
+ p:=cond_ptr;
+ while p<>null do
+ begin incr(n); p:=link(p);
+ end;
+ print("(level "); print_int(n); print_char(")"); print_if_line(l);
+ end;
+print_char("}");
+@z
+%---------------------------------------
+@x [22] m.303 l.6481 show_context - e-TeX scan_tokens
+the terminal, under control of the procedure |read_toks|.)
+@y
+the terminal, under control of the procedure |read_toks|.)
+Finally |18<=name<=19| indicates that we are reading a pseudo file
+created by the \.{\\scantokens} command.
+@z
+%---------------------------------------
+@x [22] m.307 l.6678 - e-TeX basic, every_eof
+only if |token_type>=macro|.
+@^reference counts@>
+@y
+only if |token_type>=macro|.
+@^reference counts@>
+
+Since \eTeX's additional token list parameters precede |toks_base|, the
+corresponding token types must precede |write_text|.
+@z
+%---------------------------------------
+@x [22] m.307 l.6699 - e-TeX basic
+@d write_text=15 {|token_type| code for \.{\\write}}
+@y
+@#
+@d eTeX_text_offset=output_routine_loc-output_text
+@d every_eof_text=every_eof_loc-eTeX_text_offset
+ {|token_type| code for \.{\\everyeof}}
+@#
+@d write_text=toks_base-eTeX_text_offset {|token_type| code for \.{\\write}}
+@z
+%---------------------------------------
+@x [22] m.311 l.6755 show_context - e-TeX scan_tokens
+ if (name>17) or (base_ptr=0) then bottom_line:=true;
+@y
+ if (name>19) or (base_ptr=0) then bottom_line:=true;
+@z
+%---------------------------------------
+@x [22] m.313 l.6800 - e-TeX scan_tokens
+else begin print_nl("l."); print_int(line);
+@y
+else if index<>in_open then {input from a pseudo file}
+ begin print_nl("l."); print_int(line_stack[index+1]);
+ end
+else begin print_nl("l."); print_int(line);
+@z
+%---------------------------------------
+@x [22] m.314 l.6822 - e-TeX basic
+write_text: print_nl("<write> ");
+@y
+every_eof_text: print_nl("<everyeof> ");
+write_text: print_nl("<write> ");
+@z
+%---------------------------------------
+@x [23] m.326 l.7015 - e-TeX optimized \aftergroup
+begin t:=cur_tok; cur_tok:=p; back_input; cur_tok:=t;
+@y
+begin t:=cur_tok; cur_tok:=p;
+if a then
+ begin p:=get_avail; info(p):=cur_tok; link(p):=loc; loc:=p; start:=p;
+ if cur_tok<right_brace_limit then
+ if cur_tok<left_brace_limit then decr(align_state)
+ else incr(align_state);
+ end
+else begin back_input; a:=eTeX_ex;
+ end;
+cur_tok:=t;
+@z
+%---------------------------------------
+@x [23] m.328 l.7043 begin_file_reading - e-TeX every_eof, tracing_nesting
+incr(in_open); push_input; index:=in_open;
+@y
+incr(in_open); push_input; index:=in_open;
+eof_seen[index]:=false;
+grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr;
+@z
+%---------------------------------------
+@x [23] m.329 l.7053 end_file_reading - e-TeX scan_tokens
+if name>17 then a_close(cur_file); {forget it}
+@y
+if (name=18)or(name=19) then pseudo_close else
+if name>17 then a_close(cur_file); {forget it}
+@z
+%---------------------------------------
+@x [23] m.331 l.7072 - e-TeX tracing_nesting
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+@y
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+grp_stack[0]:=0; if_stack[0]:=null;
+@z
+%---------------------------------------
+@x [24] m.362 l.7544 - e-TeX scan_tokens, every_eof
+if not force_eof then
+@y
+if not force_eof then
+ if name<=19 then
+ begin if pseudo_input then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+ end
+ else
+@z
+%---------------------------------------
+@x [24] m.362 l.7547 - e-TeX every_eof
+ else force_eof:=true;
+@y
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+@z
+%---------------------------------------
+@x [24] m.362 l.7550 - e-TeX scan_tokens
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+@y
+ begin if tracing_nesting>0 then
+ if (grp_stack[in_open]<>cur_boundary)or@|
+ (if_stack[in_open]<>cond_ptr) then file_warning;
+ {give warning for some unfinished groups and/or conditionals}
+ if name>=19 then
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ end;
+@z
+%---------------------------------------
+@x [25] m.366 l.7636 - e-TeX basic
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+@y
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/
+@z
+%---------------------------------------
+@x [25] m.366 l.7643 expand - e-TeX cond
+procedure expand;
+@y
+procedure expand;
+label reswitch;
+@z
+%---------------------------------------
+@x [25] m.366 l.7654 expand - e-TeX cond
+if cur_cmd<call then @<Expand a nonmacro@>
+@y
+reswitch:
+if cur_cmd<call then @<Expand a nonmacro@>
+@z
+%---------------------------------------
+@x [25] m.367 l.7665 - e-TeX cond
+expand_after:@<Expand the token after the next token@>;
+@y
+expand_after:if cur_chr=0 then @<Expand the token after the next token@>
+ else @<Negate a boolean conditional and |goto reswitch|@>;
+@z
+%---------------------------------------
+@x [25] m.377 l.7785 - e-TeX scan_tokens
+input: if chr_code=0 then print_esc("input")@+else print_esc("endinput");
+@y
+input: if chr_code=0 then print_esc("input")
+ @/@<Cases of |input| for |print_cmd_chr|@>@/
+ else print_esc("endinput");
+@z
+%---------------------------------------
+@x [25] m.378 l.7788 - e-TeX scan_tokens
+if cur_chr>0 then force_eof:=true
+@y
+if cur_chr=1 then force_eof:=true
+@/@<Cases for |input|@>@/
+@z
+%---------------------------------------
+@x [25] m.382 l.7844 - e-TeX marks
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@y
+@d marks_code==5 {add this for \.{\\topmarks} etc.}
+@#
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@z
+%---------------------------------------
+@x [25] m.385 l.7876 - e-TeX marks
+top_bot_mark: case chr_code of
+@y
+top_bot_mark: begin case (chr_code mod marks_code) of
+@z
+%---------------------------------------
+@x [25] m.385 l.7882 - e-TeX marks
+ endcases;
+@y
+ endcases;
+ if chr_code>=marks_code then print_char("s");
+ end;
+@z
+%---------------------------------------
+@x [25] m.386 l.7888 - e-TeX marks
+begin if cur_mark[cur_chr]<>null then
+ begin_token_list(cur_mark[cur_chr],mark_text);
+@y
+begin t:=cur_chr mod marks_code;
+if cur_chr>=marks_code then scan_register_num@+else cur_val:=0;
+if cur_val=0 then cur_ptr:=cur_mark[t]
+else @<Compute the mark pointer for mark type |t| and class |cur_val|@>;
+if cur_ptr<>null then begin_token_list(cur_ptr,mark_text);
+@z
+%---------------------------------------
+@x [25] m.389 l.7951 macro_call - e-TeX protected
+if info(r)<>end_match_token then
+@y
+if info(r)=protected_token then r:=link(r);
+if info(r)<>end_match_token then
+@z
+%---------------------------------------
+@x [26] m.409 l.8262 - e-TeX basic
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@y
+@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@;
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@z
+%---------------------------------------
+@x [26] m.411 l.8306 - e-TeX sparse arrays
+|glue_val|, or |mu_val|.
+@y
+|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes
+cannot have these values)
+@z
+%---------------------------------------
+@x [26] m.411 l.8309 - e-TeX sparse arrays
+primitive("count",register,int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mu_val);
+@y
+primitive("count",register,mem_bot+int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,mem_bot+dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,mem_bot+glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mem_bot+mu_val);
+@z
+%---------------------------------------
+@x [26] m.412 l.8319 - e-TeX sparse arrays
+register: if chr_code=int_val then print_esc("count")
+ else if chr_code=dimen_val then print_esc("dimen")
+ else if chr_code=glue_val then print_esc("skip")
+ else print_esc("muskip");
+@y
+register: @<Cases of |register| for |print_cmd_chr|@>;
+@z
+%---------------------------------------
+@x [26] m.413 l.8335 scan_something_internal - e-TeX basic
+var m:halfword; {|chr_code| part of the operand token}
+@y
+label exit;
+var m:halfword; {|chr_code| part of the operand token}
+@!q:halfword; {general purpose index}
+@!i:four_quarters; {character info}
+@z
+%---------------------------------------
+@x [26] m.413 l.8361 scan_something_internal - e-TeX basic
+end;
+@y
+exit:end;
+@z
+%---------------------------------------
+@x [26] m.415 l.8382 - e-TeX sparse arrays
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+@y
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else cur_val:=equiv(m);
+ cur_val_level:=tok_val;
+@z
+%---------------------------------------
+@x [26] m.416 l.8397 - e-TeX basic
+|glue_val|, |input_line_no_code|, or |badness_code|.
+@y
+|glue_val|, |input_line_no_code|, or |badness_code|.
+\eTeX\ inserts |last_node_type_code| after |glue_val| and adds
+the codes for its extensions: |eTeX_version_code|, \dots\ .
+@z
+%---------------------------------------
+@x [26] m.416 l.8399 - e-TeX basic
+@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@y
+@d last_node_type_code=glue_val+1 {code for \.{\\lastnodetype}}
+@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}}
+@d badness_code=input_line_no_code+1 {code for \.{\\badness}}
+@#
+@d eTeX_int=badness_code+1 {first of \eTeX\ codes for integers}
+@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions}
+@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue}
+@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue}
+@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions}
+@z
+%---------------------------------------
+@x [26] m.417 l.8432 - e-TeX interaction_mode
+@+else print_esc("insertpenalties");
+@y
+@/@<Cases of |set_page_int| for |print_cmd_chr|@>@/
+@+else print_esc("insertpenalties");
+@z
+%---------------------------------------
+@x [26] m.417 l.8441 - e-TeX basic
+ othercases print_esc("badness")
+@y
+ @/@<Cases of |last_item| for |print_cmd_chr|@>@/
+ othercases print_esc("badness")
+@z
+%---------------------------------------
+@x [26] m.419 l.8464 - e-TeX interaction_mode
+begin if m=0 then cur_val:=dead_cycles@+else cur_val:=insert_penalties;
+@y
+begin if m=0 then cur_val:=dead_cycles
+@/@<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>@/
+else cur_val:=insert_penalties;
+@z
+%---------------------------------------
+@x [26] m.420 l.8469 - e-TeX sparse arrays
+begin scan_eight_bit_int;
+if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc;
+@y
+begin scan_register_num; fetch_box(q);
+if q=null then cur_val:=0 @+else cur_val:=mem[q+m].sc;
+@z
+%---------------------------------------
+@x [26] m.423 l.8494 - e-TeX penalties
+begin if par_shape_ptr=null then cur_val:=0
+@y
+begin if m>par_shape_loc then @<Fetch a penalties array element@>
+else if par_shape_ptr=null then cur_val:=0
+@z
+%---------------------------------------
+@x [26] m.424 l.8500 - e-TeX TeXXeT
+implemented. The reference count for \.{\\lastskip} will be updated later.
+@y
+implemented. The reference count for \.{\\lastskip} will be updated later.
+A final \.{\\endM} node is temporarily removed.
+@z
+%---------------------------------------
+@x [26] m.424 l.8506 - e-TeX basic
+if cur_chr>glue_val then
+@y
+if m>=input_line_no_code then
+@z
+%---------------------------------------
+@x [26] m.424 l.8507 - e-TeX basic
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+@y
+ if m>=eTeX_glue then @<Process an expression and |return|@>@;
+ else if m>=eTeX_dim then
+ begin case m of
+ @/@<Cases for fetching a dimension value@>@/
+ end; {there are no other cases}
+ cur_val_level:=dimen_val;
+ end
+ else begin case m of
+ input_line_no_code: cur_val:=line;
+ badness_code: cur_val:=last_badness;
+ @/@<Cases for fetching an integer value@>@/
+ end; {there are no other cases}
+@z
+%---------------------------------------
+@x [26] m.424 l.8512 - e-TeX last_node_type
+ cur_val_level:=cur_chr;
+@y
+ if cur_chr=last_node_type_code then
+ begin cur_val_level:=int_val;
+ if (tail=head)or(mode=0) then cur_val:=-1;
+ end
+ else cur_val_level:=cur_chr;
+@z
+%---------------------------------------
+@x [26] m.424 l.8514 - e-TeX TeXXeT
+ case cur_chr of
+@y
+ begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+ remove_end_M;
+ case cur_chr of
+@z
+%---------------------------------------
+@x [26] m.424 l.8520 - e-TeX last_node_type
+ end;
+@y
+ end;
+ last_node_type_code:
+ if (type(tail)<>math_node)or(subtype(tail)<>end_M_code) then
+ if type(tail)<=unset_node then cur_val:=type(tail)+1
+ else cur_val:=unset_node+2;
+@z
+%---------------------------------------
+@x [26] m.424 l.8521 - e-TeX TeXXeT
+ end {there are no other cases}
+@y
+ end; {there are no other cases}
+ if LR_temp<>null then insert_end_M;
+ end
+@z
+%---------------------------------------
+@x [26] m.424 l.8526 - e-TeX last_node_type
+ glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+@y
+ glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+ last_node_type_code: cur_val:=last_node_type;
+@z
+%---------------------------------------
+@x [26] m.427 l.8542 - e-TeX sparse arrays
+begin scan_eight_bit_int;
+case m of
+@y
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+@z
+%---------------------------------------
+@x [26] m.427 l.8549 - e-TeX sparse arrays
+cur_val_level:=m;
+@y
+ end;
+@z
+%---------------------------------------
+@x [26] m.461 l.9077 - e-TeX expr
+exit:end;
+@y
+exit:end;
+@#
+@<Declare procedures needed for expressions@>@;
+@z
+%---------------------------------------
+@x [27] m.464 l.9136 - e-TeX basic
+@p function str_toks(@!b:pool_pointer):pointer;
+@y
+@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
+function str_toks(@!b:pool_pointer):pointer;
+@z
+%---------------------------------------
+@x [27] m.465 l.9161 the_toks - e-TeX unexpanded
+@p function the_toks:pointer;
+@y
+@p function the_toks:pointer;
+label exit;
+@z
+%---------------------------------------
+@x [27] m.465 l.9165 the_toks - e-TeX unexpanded
+begin get_x_token; scan_something_internal(tok_val,false);
+@y
+@!c:small_number; {value of |cur_chr|}
+begin @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>;@/
+get_x_token; scan_something_internal(tok_val,false);
+@z
+%---------------------------------------
+@x [27] m.465 l.9179 the_toks - e-TeX unexpanded
+end;
+@y
+exit:end;
+@z
+%---------------------------------------
+@x [27] m.468 l.9202 - e-TeX basic
+@d number_code=0 {command code for \.{\\number}}
+@y
+\eTeX\ adds \.{\\eTeXrevision} such that |job_name_code| remains last.
+
+@d number_code=0 {command code for \.{\\number}}
+@z
+%---------------------------------------
+@x [27] m.468 l.9207 - e-TeX basic
+@d job_name_code=5 {command code for \.{\\jobname}}
+@y
+@d etex_convert_base=5 {base for \eTeX's command codes}
+@d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}}
+@d etex_convert_codes=etex_convert_base+1 {end of \eTeX's command codes}
+@d job_name_code=etex_convert_codes {command code for \.{\\jobname}}
+@z
+%---------------------------------------
+@x [27] m.469 l.9230 - e-TeX basic
+ othercases print_esc("jobname")
+@y
+ eTeX_revision_code: print_esc("eTeXrevision");
+ othercases print_esc("jobname")
+@z
+%---------------------------------------
+@x [27] m.471 l.9255 - e-TeX basic
+job_name_code: if job_name=0 then open_log_file;
+@y
+eTeX_revision_code: do_nothing;
+job_name_code: if job_name=0 then open_log_file;
+@z
+%---------------------------------------
+@x [27] m.472 l.9271 - e-TeX basic
+job_name_code: print(job_name);
+@y
+eTeX_revision_code: print(eTeX_revision);
+job_name_code: print(job_name);
+@z
+%---------------------------------------
+@x [27] m.478 l.9381 - e-TeX protected
+ if cur_cmd<=max_command then goto done2;
+@y
+ if cur_cmd>=call then
+ if info(link(cur_chr))=protected_token then
+ begin cur_cmd:=relax; cur_chr:=no_expand_flag;
+ end;
+ if cur_cmd<=max_command then goto done2;
+@z
+%---------------------------------------
+@x [27] m.482 l.9429 read_toks - e-TeX read_line
+@p procedure read_toks(@!n:integer;@!r:pointer);
+@y
+@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword);
+@z
+%---------------------------------------
+@x [27] m.483 l.9455 - e-TeX read_line
+loop@+ begin get_token;
+@y
+@<Handle \.{\\readline} and |goto done|@>;@/
+loop@+ begin get_token;
+@z
+%---------------------------------------
+@x [28] m.487 l.9507 - e-TeX cond
+@d if_char_code=0 { `\.{\\if}' }
+@y
+@d unless_code=32 {amount added for `\.{\\unless}' prefix}
+@#
+@d if_char_code=0 { `\.{\\if}' }
+@z
+%---------------------------------------
+@x [28] m.488 l.9562 - e-TeX cond
+if_test: case chr_code of
+@y
+if_test: begin if chr_code>=unless_code then print_esc("unless");
+case chr_code mod unless_code of
+@z
+%---------------------------------------
+@x [28] m.488 l.9579 - e-TeX cond
+ othercases print_esc("if")
+ endcases;
+@y
+ @/@<Cases of |if_test| for |print_cmd_chr|@>@/
+ othercases print_esc("if")
+ endcases;
+end;
+@z
+%---------------------------------------
+@x [28] m.494 l.9653 pass_text - e-TeX tracing
+done: scanner_status:=save_scanner_status;
+@y
+done: scanner_status:=save_scanner_status;
+if tracing_ifs>0 then show_cur_cmd_chr;
+@z
+%---------------------------------------
+@x [28] m.496 l.9669 - e-TeX tracing_nesting
+begin p:=cond_ptr; if_line:=if_line_field(p);
+@y
+begin if if_stack[in_open]=cond_ptr then if_warning;
+ {conditionals possibly not properly nested with files}
+p:=cond_ptr; if_line:=if_line_field(p);
+@z
+%---------------------------------------
+@x [28] m.498 l.9706 conditional - e-TeX cond
+begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+@y
+@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?}
+begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
+is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+if is_unless then b:=not b;
+@z
+%---------------------------------------
+@x [28] m.501 l.9749 - e-TeX cond
+if_false_code: b:=false;
+@y
+if_false_code: b:=false;
+@/@<Cases for |conditional|@>@/
+@z
+%---------------------------------------
+@x [28] m.505 l.9788 - e-TeX sparse arrays
+begin scan_eight_bit_int; p:=box(cur_val);
+@y
+begin scan_register_num; fetch_box(p);
+@z
+%---------------------------------------
+@x [28] m.510 l.9878 - e-TeX cond
+if cur_chr>if_limit then
+@y
+begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+if cur_chr>if_limit then
+@z
+%---------------------------------------
+@x [28] m.510 l.9889 - e-TeX cond
+ end
+@y
+ end;
+end
+@z
+%---------------------------------------
+@x [29] m.536 l.10343 - e-TeX basic
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+@y
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+if eTeX_ex then
+ begin; wlog_cr; wlog('entering extended mode');
+ end;
+@z
+%---------------------------------------
+@x [30] m.581 l.11276 char_warning - e-TeX tracing
+begin if tracing_lost_chars>0 then
+@y
+var old_setting: integer; {saved value of |tracing_online|}
+begin if tracing_lost_chars>0 then
+ begin old_setting:=tracing_online;
+ if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+@z
+%---------------------------------------
+@x [30] m.581 l.11283 char_warning - e-TeX tracing
+end;
+@y
+ tracing_online:=old_setting;
+ end;
+end;
+@z
+%---------------------------------------
+@x [32] m.616 l.12251 - e-TeX TeXXeT
+this is essentially the depth of |push| commands in the \.{DVI} output.
+@y
+this is essentially the depth of |push| commands in the \.{DVI} output.
+
+For mixed direction text (\TeXXeT) the current text direction is called
+|cur_dir|. As the box being shipped out will never be used again and
+soon be recycled, we can simply reverse any R-text (i.e., right-to-left)
+segments of hlist nodes as well as complete hlist nodes embedded in such
+segments. Moreover this can be done iteratively rather than recursively.
+There are, however, two complications related to leaders that require
+some additional bookkeeping: (1)~One and the same hlist node might be
+used more than once (but never inside both L- and R-text); and
+(2)~leader boxes inside hlists must be aligned with respect to the left
+edge of the original hlist.
+
+A math node is changed into a kern node whenever the text direction
+remains the same, it is replaced by an |edge_node| if the text direction
+changes; the subtype of an an |hlist_node| inside R-text is changed to
+|reversed| once its hlist has been reversed.
+@!@^data structure assumptions@>
+@z
+%---------------------------------------
+@x [32] m.616 l.12253 - e-TeX TeXXeT
+@d synch_h==if cur_h<>dvi_h then
+@y
+@d reversed=min_quarterword+1 {subtype for an |hlist_node| whose hlist
+ has been reversed}
+@d dlist=min_quarterword+2 {subtype for an |hlist_node| from display math mode}
+@d left_to_right=0
+@d right_to_left=1
+@d reflected==1-cur_dir {the opposite of |cur_dir|}
+@#
+@d synch_h==if cur_h<>dvi_h then
+@z
+%---------------------------------------
+@x [32] m.619 l.12321 hlist_out - e-TeX TeXXeT
+@!edge:scaled; {left edge of sub-box, or right edge of leader space}
+@y
+@!edge:scaled; {right edge of sub-box or leader space}
+@!prev_p:pointer; {one step behind |p|}
+@z
+%---------------------------------------
+@x [32] m.619 l.12331 hlist_out - e-TeX TeXXeT
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+@y
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v;
+prev_p:=this_box+list_offset;
+@<Initialize |hlist_out| for mixed direction typesetting@>;
+left_edge:=cur_h;
+@z
+%---------------------------------------
+@x [32] m.619 l.12334 hlist_out - e-TeX TeXXeT
+prune_movements(save_loc);
+@y
+@<Finish |hlist_out| for mixed direction typesetting@>;
+prune_movements(save_loc);
+@z
+%---------------------------------------
+@x [32] m.620 l.12353 - e-TeX TeXXeT
+ p:=link(p);
+@y
+ prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|}
+ p:=link(p);
+@z
+%---------------------------------------
+@x [32] m.622 l.12378 - e-TeX TeXXeT
+kern_node,math_node:cur_h:=cur_h+width(p);
+@y
+kern_node:cur_h:=cur_h+width(p);
+math_node: @<Handle a math node in |hlist_out|@>;
+@z
+%---------------------------------------
+@x [32] m.622 l.12380 - e-TeX TeXXeT
+othercases do_nothing
+@y
+@/@<Cases of |hlist_out| that arise in mixed direction text only@>@;
+othercases do_nothing
+@z
+%---------------------------------------
+@x [32] m.622 l.12385 - e-TeX TeXXeT
+next_p:p:=link(p);
+@y
+next_p:prev_p:=p; p:=link(p);
+@z
+%---------------------------------------
+@x [32] m.623 l.12392 - e-TeX TeXXeT
+ temp_ptr:=p; edge:=cur_h;
+@y
+ temp_ptr:=p; edge:=cur_h+width(p);
+ if cur_dir=right_to_left then cur_h:=edge;
+@z
+%---------------------------------------
+@x [32] m.623 l.12395 - e-TeX TeXXeT
+ cur_h:=edge+width(p); cur_v:=base_line;
+@y
+ cur_h:=edge; cur_v:=base_line;
+@z
+%---------------------------------------
+@x [32] m.625 l.12413 - e-TeX TeXXeT
+ glue_temp:=-billion
+
+@<Move right or output leaders@>=
+begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
+@y
+ glue_temp:=-billion
+@#
+@d round_glue==g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
+@z
+%---------------------------------------
+@x [32] m.625 l.12432 - e-TeX TeXXeT
+rule_wd:=rule_wd+cur_g;
+@y
+rule_wd:=rule_wd+cur_g
+
+@<Move right or output leaders@>=
+begin round_glue;
+if eTeX_ex then @<Handle a glue node for mixed direction typesetting@>;
+@z
+%---------------------------------------
+@x [32] m.626 l.12448 - e-TeX TeXXeT
+ edge:=cur_h+rule_wd; lx:=0;
+@y
+ if cur_dir=right_to_left then cur_h:=cur_h-10;
+ edge:=cur_h+rule_wd; lx:=0;
+@z
+%---------------------------------------
+@x [32] m.626 l.12454 - e-TeX TeXXeT
+ cur_h:=edge-10; goto next_p;
+@y
+ if cur_dir=right_to_left then cur_h:=edge
+ else cur_h:=edge-10;
+ goto next_p;
+@z
+%---------------------------------------
+@x [32] m.628 l.12493 - e-TeX TeXXeT
+synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+@y
+synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+if cur_dir=right_to_left then cur_h:=cur_h+leader_wd;
+@z
+%---------------------------------------
+@x [32] m.632 l.12567 - e-TeX TeXXeT
+ cur_h:=left_edge+shift_amount(p); {shift the box right}
+@y
+ if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p)
+ else cur_h:=left_edge+shift_amount(p); {shift the box right}
+@z
+%---------------------------------------
+@x [32] m.633 l.12579 - e-TeX TeXXeT
+ begin synch_h; synch_v;
+ dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+@y
+ begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
+ synch_h; synch_v;
+ dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+ cur_h:=left_edge;
+@z
+%---------------------------------------
+@x [32] m.637 l.12645 - e-TeX TeXXeT
+begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/
+@y
+begin if cur_dir=right_to_left then
+ cur_h:=left_edge-shift_amount(leader_box)
+ else cur_h:=left_edge+shift_amount(leader_box);
+synch_h; save_h:=dvi_h;@/
+@z
+%---------------------------------------
+@x [32] m.638 l.12682 ship_out - e-TeX TeXXeT
+@<Ship box |p| out@>;
+@y
+@<Ship box |p| out@>;
+if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>;
+@z
+%---------------------------------------
+@x [33] m.649 l.12902 hpack - e-TeX TeXXeT
+h:=0; @<Clear dimensions to zero@>;
+@y
+h:=0; @<Clear dimensions to zero@>;
+if TeXXeT_en then @<Initialize the LR stack@>;
+@z
+%---------------------------------------
+@x [33] m.649 l.12912 hpack - e-TeX TeXXeT
+exit: hpack:=r;
+@y
+exit: if TeXXeT_en then @<Check for LR anomalies at the end of |hpack|@>;
+hpack:=r;
+@z
+%---------------------------------------
+@x [33] m.651 l.12936 - e-TeX TeXXeT
+ kern_node,math_node: x:=x+width(p);
+@y
+ kern_node: x:=x+width(p);
+ math_node: begin x:=x+width(p);
+ if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>;
+ end;
+@z
+%---------------------------------------
+@x [34] m.687 l.13507 - e-TeX middle
+\TeX's \.{\\left} and \.{\\right}. The |nucleus| of such noads is
+@y
+\TeX's \.{\\left} and \.{\\right} as well as \eTeX's \.{\\middle}.
+The |nucleus| of such noads is
+@z
+%---------------------------------------
+@x [34] m.687 l.13524 - e-TeX middle
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@y
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@d middle_noad==1 {|subtype| of right noad representing \.{\\middle}}
+@z
+%---------------------------------------
+@x [34] m.696 l.13697 - e-TeX middle
+right_noad: begin print_esc("right"); print_delimiter(nucleus(p));
+ end;
+end;
+if subtype(p)<>normal then
+ if subtype(p)=limits then print_esc("limits")
+ else print_esc("nolimits");
+if type(p)<left_noad then print_subsidiary_data(nucleus(p),".");
+@y
+right_noad: begin if subtype(p)=normal then print_esc("right")
+ else print_esc("middle");
+ print_delimiter(nucleus(p));
+ end;
+end;
+if type(p)<left_noad then
+ begin if subtype(p)<>normal then
+ if subtype(p)=limits then print_esc("limits")
+ else print_esc("nolimits");
+ print_subsidiary_data(nucleus(p),".");
+ end;
+@z
+%---------------------------------------
+@x [36] m.727 l.14295 - e-TeX middle
+done_with_noad: r:=q; r_type:=type(r);
+@y
+done_with_noad: r:=q; r_type:=type(r);
+if r_type=right_noad then
+ begin r_type:=left_noad; cur_style:=style; @<Set up the values...@>;
+ end;
+@z
+%---------------------------------------
+@x [36] m.760 l.14956 - e-TeX middle
+ r_type:=t;
+@y
+ if type(q)=right_noad then t:=open_noad;
+ r_type:=t;
+@z
+%---------------------------------------
+@x [36] m.762 l.14997 make_left_right - e-TeX middle
+begin if style<script_style then cur_size:=text_size
+else cur_size:=16*((style-text_style) div 2);
+@y
+begin cur_style:=style; @<Set up the values...@>;
+@z
+%---------------------------------------
+@x [37] m.785 l.15488 align_peek - e-TeX protected
+begin restart: align_state:=1000000; @<Get the next non-blank non-call token@>;
+@y
+begin restart: align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+@z
+%---------------------------------------
+@x [37] m.791 l.15599 fin_col - e-TeX protected
+align_state:=1000000; @<Get the next non-blank non-call token@>;
+@y
+align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+@z
+%---------------------------------------
+@x [37] m.807 l.15861 - e-TeX TeXXeT
+ begin type(q):=hlist_node; width(q):=width(p);
+@y
+ begin type(q):=hlist_node; width(q):=width(p);
+ if nest[nest_ptr-1].mode_field=mmode then subtype(q):=dlist; {for |ship_out|}
+@z
+%---------------------------------------
+@x [37] m.808 l.15879 - e-TeX TeXXeT
+n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+@y
+n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+subtype(r):=min_quarterword; {for |ship_out|}
+@z
+%---------------------------------------
+@x [38] m.814 l.16002 - e-TeX penalties
+There is one explicit parameter: |final_widow_penalty| is the amount of
+additional penalty to be inserted before the final line of the paragraph.
+@y
+There is one explicit parameter: |d| is true for partial paragraphs
+preceding display math mode; in this case the amount of additional
+penalty inserted before the final line is |display_widow_penalty|
+instead of |widow_penalty|.
+@z
+%---------------------------------------
+@x [38] m.815 l.16029 line_break - e-TeX penalties
+procedure line_break(@!final_widow_penalty:integer);
+@y
+procedure line_break(@!d:boolean);
+@z
+%---------------------------------------
+@x [38] m.815 l.16039 - e-TeX basic
+end;
+@y
+end;
+@#
+@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@>
+@z
+%---------------------------------------
+@x [38] m.816 l.16059 - e-TeX last_line_fit
+link(tail):=new_param_glue(par_fill_skip_code);
+@y
+link(tail):=new_param_glue(par_fill_skip_code);
+last_line_fill:=link(tail);
+@z
+%---------------------------------------
+@x [38] m.819 l.16124 - e-TeX last_line_fit
+@d active_node_size=3 {number of words in active nodes}
+@y
+@d active_node_size_normal=3 {number of words in normal active nodes}
+@z
+%---------------------------------------
+@x [38] m.827 l.16287 - e-TeX last_line_fit
+background[6]:=shrink(q)+shrink(r);
+@y
+background[6]:=shrink(q)+shrink(r);
+@<Check for special treatment of last line of paragraph@>;
+@z
+%---------------------------------------
+@x [38] m.829 l.16338 try_break - e-TeX last_line_fit
+label exit,done,done1,continue,deactivate;
+@y
+label exit,done,done1,continue,deactivate,found,not_found;
+@z
+%---------------------------------------
+@x [38] m.845 l.16630 - e-TeX last_line_fit
+total_demerits(q):=minimal_demerits[fit_class];
+@y
+total_demerits(q):=minimal_demerits[fit_class];
+if do_last_line_fit then
+ @<Store \(a)additional data in the new active node@>;
+@z
+%---------------------------------------
+@x [38] m.846 l.16643 - e-TeX last_line_fit
+print(" t="); print_int(total_demerits(q));
+@y
+print(" t="); print_int(total_demerits(q));
+if do_last_line_fit then @<Print additional data in the new active node@>;
+@z
+%---------------------------------------
+@x [38] m.851 l.16742 - e-TeX last_line_fit
+if (b>inf_bad)or(pi=eject_penalty) then
+@y
+if do_last_line_fit then @<Adjust \(t)the additional data for last line@>;
+found:
+if (b>inf_bad)or(pi=eject_penalty) then
+@z
+%---------------------------------------
+@x [38] m.852 l.16766 - e-TeX last_line_fit
+ begin b:=0; fit_class:=decent_fit; {infinite stretch}
+@y
+ begin if do_last_line_fit then
+ begin if cur_p=null then {the last line of a paragraph}
+ @<Perform computations for last line and |goto found|@>;
+ shortfall:=0;
+ end;
+ b:=0; fit_class:=decent_fit; {infinite stretch}
+@z
+%---------------------------------------
+@x [38] m.855 l.16823 - e-TeX last_line_fit
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+@y
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+ if do_last_line_fit then
+ @<Store \(a)additional data for this feasible break@>;
+@z
+%---------------------------------------
+@x [39] m.863 l.16996 - e-TeX last_line_fit
+ end;@+tats@/
+@y
+ end;@+tats@/
+if do_last_line_fit then @<Adjust \(t)the final line of the paragraph@>;
+@z
+%---------------------------------------
+@x [39] m.864 l.17007 - e-TeX last_line_fit
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+@y
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+if do_last_line_fit then
+ @<Initialize additional fields of the first active node@>;
+@z
+%---------------------------------------
+@x [39] m.866 l.17057 - e-TeX TeXXeT
+math_node: begin auto_breaking:=(subtype(cur_p)=after); kern_break;
+@y
+math_node: begin if subtype(cur_p)<L_code then auto_breaking:=end_LR(cur_p);
+ kern_break;
+@z
+%---------------------------------------
+@x [39] m.876 l.17219 - e-TeX penalties
+post_line_break(final_widow_penalty)
+@y
+post_line_break(d)
+@z
+%---------------------------------------
+@x [39] m.877 l.17233 post_line_break - e-TeX penalties
+procedure post_line_break(@!final_widow_penalty:integer);
+@y
+procedure post_line_break(@!d:boolean);
+@z
+%---------------------------------------
+@x [39] m.877 l.17243 post_line_break - e-TeX TeXXeT
+begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+@y
+@!LR_ptr:pointer; {stack of LR codes}
+begin LR_ptr:=LR_save;
+@<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+@z
+%---------------------------------------
+@x [39] m.877 l.17256 post_line_break - e-TeX TeXXeT
+prev_graf:=best_line-1;
+@y
+prev_graf:=best_line-1;
+LR_save:=LR_ptr;
+@z
+%---------------------------------------
+@x [39] m.879 l.17286 - e-TeX TeXXeT
+ r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
+@y
+ r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
+ if type(q)=math_node then if TeXXeT_en then
+ @<Adjust \(t)the LR stack for the |post_line_break| routine@>;
+@z
+%---------------------------------------
+@x [39] m.880 l.17303 - e-TeX TeXXeT
+@<Modify the end of the line to reflect the nature of the break and to include
+ \.{\\rightskip}; also set the proper value of |disc_break|@>;
+@y
+if TeXXeT_en then
+ @<Insert LR nodes at the beginning of the current line and adjust
+ the LR stack based on LR nodes in this line@>;
+@<Modify the end of the line to reflect the nature of the break and to include
+ \.{\\rightskip}; also set the proper value of |disc_break|@>;
+if TeXXeT_en then @<Insert LR nodes at the end of the current line@>;
+@z
+%---------------------------------------
+@x [39] m.881 l.17326 - e-TeX TeXXeT
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+@y
+ else if type(q)=kern_node then width(q):=0
+ else if type(q)=math_node then
+ begin width(q):=0;
+ if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>;
+ end;
+@z
+%---------------------------------------
+@x [39] m.890 l.17420 - e-TeX penalties
+ begin pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+@y
+ begin q:=inter_line_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=penalty(q+r);
+ end
+ else pen:=inter_line_penalty;
+ q:=club_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line-prev_graf;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if d then q:=display_widow_penalties_ptr
+ else q:=widow_penalties_ptr;
+ if q<>null then
+ begin r:=best_line-cur_line-1;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line+2=best_line then
+ if d then pen:=pen+display_widow_penalty
+ else pen:=pen+widow_penalty;
+@z
+%---------------------------------------
+@x [40] m.891 l.17487 - e-TeX hyph_codes
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+@y
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+set_hyph_index;
+@z
+%---------------------------------------
+@x [40] m.896 l.17556 - e-TeX hyph_codes
+ if lc_code(c)<>0 then
+ if (lc_code(c)=c)or(uc_hyph>0) then goto done2
+@y
+ set_lc_code(c);
+ if hc[0]<>0 then
+ if (hc[0]=c)or(uc_hyph>0) then goto done2
+@z
+%---------------------------------------
+@x [40] m.897 l.17573 - e-TeX hyph_codes
+ if lc_code(c)=0 then goto done3;
+ if hn=63 then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=lc_code(c); hyf_bchar:=non_char;
+@y
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if hn=63 then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char;
+@z
+%---------------------------------------
+@x [40] m.898 l.17599 - e-TeX hyph_codes
+ if lc_code(c)=0 then goto done3;
+ if j=63 then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=lc_code(c);@/
+@y
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if j=63 then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=hc[0];@/
+@z
+%---------------------------------------
+@x [42] m.934 l.18238 new_hyph_exceptions - e-TeX hyph_codes
+label reswitch, exit, found, not_found;
+@y
+label reswitch, exit, found, not_found, not_found1;
+@z
+%---------------------------------------
+@x [42] m.934 l.18248 new_hyph_exceptions - e-TeX hyph_codes
+set_cur_lang;
+@y
+set_cur_lang;
+@!init if trie_not_ready then
+ begin hyph_index:=0; goto not_found1;
+ end;
+tini@/
+set_hyph_index;
+not_found1:
+@z
+%---------------------------------------
+@x [42] m.937 l.18280 - e-TeX hyph_codes
+else begin if lc_code(cur_chr)=0 then
+@y
+else begin set_lc_code(cur_chr);
+ if hc[0]=0 then
+@z
+%---------------------------------------
+@x [42] m.937 l.18288 - e-TeX hyph_codes
+ begin incr(n); hc[n]:=lc_code(cur_chr);
+@y
+ begin incr(n); hc[n]:=hc[0];
+@z
+%---------------------------------------
+@x [43] m.952 l.18576 - e-TeX hyph_codes
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+@y
+hyph_root:=compress_trie(hyph_root);
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+@z
+%---------------------------------------
+@x [43] m.958 l.18664 - e-TeX hyph_codes
+if trie_root=0 then {no patterns were given}
+@y
+if trie_max=0 then {no patterns were given}
+@z
+%---------------------------------------
+@x [43] m.958 l.18668 - e-TeX hyph_codes
+else begin trie_fix(trie_root); {this fixes the non-holes in |trie|}
+@y
+else begin if hyph_root>0 then trie_fix(hyph_root);
+ if trie_root>0 then trie_fix(trie_root); {this fixes the non-holes in |trie|}
+@z
+%---------------------------------------
+@x [43] m.960 l.18711 new_patterns - e-TeX hyph_codes
+ brace@>;
+@y
+ brace@>;
+ if saving_hyph_codes>0 then
+ @<Store hyphenation codes for current language@>;
+@z
+%---------------------------------------
+@x [43] m.966 l.18818 init_trie - e-TeX hyph_codes
+@<Move the data into |trie|@>;
+@y
+if hyph_root<>0 then @<Pack all stored |hyph_codes|@>;
+@<Move the data into |trie|@>;
+@z
+%---------------------------------------
+@x [44] m.968 l.18834 - e-TeX saved_items
+whenever this is possible without backspacing.
+@y
+whenever this is possible without backspacing.
+
+When the second argument |s| is |false| the deleted nodes are destroyed,
+otherwise they are collected in a list starting at |split_disc|.
+@z
+%---------------------------------------
+@x [44] m.968 l.18841 prune_page_top - e-TeX saved_items
+@p function prune_page_top(@!p:pointer):pointer; {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q:pointer; {temporary variable for list manipulation}
+@y
+@p function prune_page_top(@!p:pointer;@!s:boolean):pointer;
+ {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q,@!r:pointer; {temporary variables for list manipulation}
+@z
+%---------------------------------------
+@x [44] m.968 l.18852 prune_page_top - e-TeX saved_items
+ link(prev_p):=p; flush_node_list(q);
+@y
+ link(prev_p):=p;
+ if s then
+ begin if split_disc=null then split_disc:=q@+else link(r):=q;
+ r:=q;
+ end
+ else flush_node_list(q);
+@z
+%---------------------------------------
+@x [44] m.977 l.19019 vsplit - e-TeX marks, sparse arrays
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+@y
+@p @t\4@>@<Declare the function called |do_marks|@>@;
+function vsplit(@!n:halfword; @!h:scaled):pointer;
+@z
+%---------------------------------------
+@x [44] m.977 l.19025 vsplit - e-TeX sparse arrays
+begin v:=box(n);
+@y
+begin cur_val:=n; fetch_box(v);
+@z
+%---------------------------------------
+@x [44] m.977 l.19026 vsplit - e-TeX marks, saved_items
+if split_first_mark<>null then
+@y
+flush_node_list(split_disc); split_disc:=null;
+if sa_mark<>null then
+ if do_marks(vsplit_init,0,sa_mark) then sa_mark:=null;
+if split_first_mark<>null then
+@z
+%---------------------------------------
+@x [44] m.977 l.19034 vsplit - e-TeX saved_items
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+@y
+q:=prune_page_top(q,saving_vdiscards>0);
+p:=list_ptr(v); free_node(v,box_node_size);
+@z
+%---------------------------------------
+@x [44] m.977 l.19035 vsplit - e-TeX sparse arrays
+if q=null then box(n):=null {the |eq_level| of the box stays the same}
+else box(n):=vpack(q,natural);
+@y
+if q<>null then q:=vpack(q,natural);
+change_box(q); {the |eq_level| of the box stays the same}
+@z
+%---------------------------------------
+@x [44] m.979 l.19060 - e-TeX marks
+ if split_first_mark=null then
+@y
+ if mark_class(p)<>0 then @<Update the current marks for |vsplit|@>
+ else if split_first_mark=null then
+@z
+%---------------------------------------
+@x [45] m.982 l.19194 - e-TeX last_node_type
+The variables |last_penalty| and |last_kern| are similar. And
+@y
+The variables |last_penalty|, |last_kern|, and |last_node_type|
+are similar. And
+@z
+%---------------------------------------
+@x [45] m.982 l.19207 - e-TeX last_node_type
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@y
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@!last_node_type:integer; {used to implement \.{\\lastnodetype}}
+@z
+%---------------------------------------
+@x [45] m.991 l.19344 - e-TeX last_node_type
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+@y
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+last_node_type:=-1;
+@z
+%---------------------------------------
+@x [45] m.996 l.19411 - e-TeX last_node_type
+last_penalty:=0; last_kern:=0;
+@y
+last_penalty:=0; last_kern:=0;
+last_node_type:=type(p)+1;
+@z
+%---------------------------------------
+@x [45] m.999 l.19448 - e-TeX saved_items
+link(contrib_head):=link(p); link(p):=null; flush_node_list(p)
+@y
+link(contrib_head):=link(p); link(p):=null;
+if saving_vdiscards>0 then
+ begin if page_disc=null then page_disc:=p@+else link(tail_page_disc):=p;
+ tail_page_disc:=p;
+ end
+else flush_node_list(p)
+@z
+%---------------------------------------
+@x [45] m.1012 l.19688 fire_up - e-TeX marks
+if bot_mark<>null then
+@y
+if sa_mark<>null then
+ if do_marks(fire_up_init,0,sa_mark) then sa_mark:=null;
+if bot_mark<>null then
+@z
+%---------------------------------------
+@x [45] m.1012 l.19696 fire_up - e-TeX marks
+if (top_mark<>null)and(first_mark=null) then
+@y
+if sa_mark<>null then
+ if do_marks(fire_up_done,0,sa_mark) then sa_mark:=null;
+if (top_mark<>null)and(first_mark=null) then
+@z
+%---------------------------------------
+@x [45] m.1014 l.19733 - e-TeX marks
+ else if type(p)=mark_node then @<Update the values of
+@y
+ else if type(p)=mark_node then
+ if mark_class(p)<>0 then @<Update the current marks for |fire_up|@>
+ else @<Update the values of
+@z
+%---------------------------------------
+@x [45] m.1021 l.19845 - e-TeX saved_items
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+@y
+ ins_ptr(p):=prune_page_top(broken_ptr(r),false);
+@z
+%---------------------------------------
+@x [45] m.1023 l.19881 - e-TeX saved_items
+ship_out(box(255)); box(255):=null;
+@y
+flush_node_list(page_disc); page_disc:=null;
+ship_out(box(255)); box(255):=null;
+@z
+%---------------------------------------
+@x [45] m.1026 l.19923 - e-TeX saved_items
+pop_nest; build_page;
+@y
+flush_node_list(page_disc); page_disc:=null;
+pop_nest; build_page;
+@z
+%---------------------------------------
+@x [47] m.1070 l.20727 normal_paragraph - e-TeX penalties
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+@y
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+if inter_line_penalties_ptr<>null then
+ eq_define(inter_line_penalties_loc,shape_ref,null);
+@z
+%---------------------------------------
+@x [47] m.1071 l.20748 - e-TeX sparse arrays
+|box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}';
+codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox255}';
+code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513|
+through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}',
+@y
+|global_box_flag-1| represent `\.{\\setbox0}' through `\.{\\setbox32767}';
+codes |global_box_flag| through |ship_out_flag-1| represent
+`\.{\\global\\setbox0}' through `\.{\\global\\setbox32767}';
+code |ship_out_flag| represents `\.{\\shipout}'; and codes |leader_flag|
+through |leader_flag+2| represent `\.{\\leaders}', `\.{\\cleaders}',
+@z
+%---------------------------------------
+@x [47] m.1071 l.20762 - e-TeX sparse arrays
+@d ship_out_flag==box_flag+512 {context code for `\.{\\shipout}'}
+@d leader_flag==box_flag+513 {context code for `\.{\\leaders}'}
+@y
+@d global_box_flag==@'10000100000 {context code for `\.{\\global\\setbox0}'}
+@d ship_out_flag==@'10000200000 {context code for `\.{\\shipout}'}
+@d leader_flag==@'10000200001 {context code for `\.{\\leaders}'}
+@z
+%---------------------------------------
+@x [47] m.1075 l.20845 box_end - e-TeX sparse arrays
+var p:pointer; {|ord_noad| for new box in math mode}
+@y
+var p:pointer; {|ord_noad| for new box in math mode}
+@!a:small_number; {global prefix}
+@z
+%---------------------------------------
+@x [47] m.1077 l.20883 - e-TeX sparse arrays
+if box_context<box_flag+256 then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-256+box_context,box_ref,cur_box)
+@y
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+@z
+%---------------------------------------
+@x [47] m.1079 l.20915 begin_box - e-TeX sparse arrays
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ box(cur_val):=null; {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+@y
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ change_box(null); {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+@z
+%---------------------------------------
+@x [47] m.1080 l.20931 - e-TeX TeXXeT
+since |head| is a one-word node.
+@y
+since |head| is a one-word node.
+A final \.{\\endM} node is temporarily removed.
+@z
+%---------------------------------------
+@x [47] m.1080 l.20944 - e-TeX TeXXeT
+ if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+ @<Remove the last box, unless it's part of a discretionary@>;
+@y
+ begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+ remove_end_M;
+ if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+ @<Remove the last box, unless it's part of a discretionary@>;
+ if LR_temp<>null then insert_end_M;
+ end;
+@z
+%---------------------------------------
+@x [47] m.1082 l.20965 - e-TeX sparse arrays
+begin scan_eight_bit_int; n:=cur_val;
+@y
+begin scan_register_num; n:=cur_val;
+@z
+%---------------------------------------
+@x [47] m.1096 l.21149 - e-TeX penalties, TeXXeT
+ else line_break(widow_penalty);
+@y
+ else line_break(false);
+ if LR_save<>null then
+ begin flush_list(LR_save); LR_save:=null;
+ end;
+@z
+%---------------------------------------
+@x [47] m.1101 l.21205 make_mark - e-TeX marks
+begin p:=scan_toks(false,true); p:=get_node(small_node_size);
+@y
+@!c:halfword; {the mark class}
+begin if cur_chr=0 then c:=0
+else begin scan_register_num; c:=cur_val;
+ end;
+p:=scan_toks(false,true); p:=get_node(small_node_size);
+mark_class(p):=c;
+@z
+%---------------------------------------
+@x [47] m.1105 l.21233 - e-TeX TeXXeT
+will be deleted, if present.
+@y
+will be deleted, if present.
+A final \.{\\endM} node is temporarily removed.
+@z
+%---------------------------------------
+@x [47] m.1105 l.21243 delete_last - e-TeX TeXXeT
+else begin if not is_char_node(tail) then if type(tail)=cur_chr then
+@y
+else begin if not is_char_node(tail) then
+ begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
+ remove_end_M;
+ if type(tail)=cur_chr then
+@z
+%---------------------------------------
+@x [47] m.1105 l.21254 delete_last - e-TeX TeXXeT
+ end;
+@y
+ if LR_temp<>null then insert_end_M;
+ end;
+ end;
+@z
+%---------------------------------------
+@x [47] m.1108 l.21292 - e-TeX saved_items
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+@y
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+ @<Cases of |un_vbox| for |print_cmd_chr|@>@/
+@z
+%---------------------------------------
+@x [47] m.1110 l.21302 unpackage - e-TeX saved_items
+label exit;
+@y
+label done, exit;
+@z
+%---------------------------------------
+@x [47] m.1110 l.21305 unpackage - e-TeX saved_items, sparse arrays
+begin c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+@y
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+@z
+%---------------------------------------
+@x [47] m.1110 l.21317 unpackage - e-TeX sparse arrays
+else begin link(tail):=list_ptr(p); box(cur_val):=null;
+@y
+else begin link(tail):=list_ptr(p); change_box(null);
+@z
+%---------------------------------------
+@x [47] m.1110 l.21320 unpackage - e-TeX saved_items
+while link(tail)<>null do tail:=link(tail);
+@y
+done:
+while link(tail)<>null do tail:=link(tail);
+@z
+%---------------------------------------
+@x [47] m.1130 l.21592 - e-TeX TeXXeT
+vmode+halign,hmode+valign:init_align;
+@y
+vmode+halign:init_align;
+hmode+valign:@<Cases of |main_control| for |hmode+valign|@>@; init_align;
+@z
+%---------------------------------------
+@x [48] m.1138 l.21671 init_math - e-TeX TeXXeT
+procedure init_math;
+label reswitch,found,not_found,done;
+var w:scaled; {new or partial |pre_display_size|}
+@y
+@t\4@>@<Declare subprocedures for |init_math|@>@;
+procedure init_math;
+label reswitch,found,not_found,done;
+var w:scaled; {new or partial |pre_display_size|}
+@!j:pointer; {prototype box for display}
+@!x:integer; {new |pre_display_direction|}
+@z
+%---------------------------------------
+@x [48] m.1145 l.21729 - e-TeX TeXXeT, penalties
+begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+ begin pop_nest; w:=-max_dimen;
+ end
+else begin line_break(display_widow_penalty);@/
+@y
+begin j:=null; w:=-max_dimen;
+if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+ @<Prepare for display after an empty paragraph@>
+else begin line_break(true);@/
+@z
+%---------------------------------------
+@x [48] m.1145 l.21742 - e-TeX TeXXeT
+eq_word_define(dimen_base+pre_display_size_code,w);
+@y
+eq_word_define(dimen_base+pre_display_size_code,w);
+LR_box:=j;
+if eTeX_ex then eq_word_define(int_base+pre_display_direction_code,x);
+@z
+%---------------------------------------
+@x [48] m.1146 l.21750 - e-TeX TeXXeT
+v:=shift_amount(just_box)+2*quad(cur_font); w:=-max_dimen;
+p:=list_ptr(just_box);
+@y
+@<Prepare for display after a non-empty paragraph@>;
+@z
+%---------------------------------------
+@x [48] m.1146 l.21765 - e-TeX TeXXeT
+done:
+@y
+done:
+@<Finish the natural width computation@>
+@z
+%---------------------------------------
+@x [48] m.1147 l.21776 - e-TeX TeXXeT
+kern_node,math_node: d:=width(p);
+@y
+kern_node: d:=width(p);
+@t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@;
+@z
+%---------------------------------------
+@x [48] m.1185 l.22285 - e-TeX middle
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+@y
+ if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(delim_ptr);
+ link(delim_ptr):=incompleat_noad; link(incompleat_noad):=p;
+@z
+%---------------------------------------
+@x [48] m.1189 l.22300 - e-TeX middle
+else print_esc("right");
+@y
+@/@<Cases of |left_right| for |print_cmd_chr|@>@/
+else print_esc("right");
+@z
+%---------------------------------------
+@x [48] m.1191 l.22339 math_left_right - e-TeX middle
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+@y
+@!q:pointer; {resulting mlist}
+begin t:=cur_chr;
+if (t<>left_noad)and(cur_group<>math_left_group) then
+@z
+%---------------------------------------
+@x [48] m.1191 l.22344 math_left_right - e-TeX middle
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
+@y
+ if t=middle_noad then
+ begin type(p):=right_noad; subtype(p):=middle_noad;
+ end;
+ if t=left_noad then q:=p
+ else begin q:=fin_mlist(p); unsave; {end of |math_left_group|}
+ end;
+ if t<>right_noad then
+ begin push_math(math_left_group); link(head):=q; tail:=p;
+ delim_ptr:=p;
+ end
+ else begin
+@z
+%---------------------------------------
+@x [48] m.1191 l.22350 math_left_right - e-TeX middle
+ info(nucleus(tail)):=p;
+@y
+ info(nucleus(tail)):=q;
+@z
+%---------------------------------------
+@x [48] m.1192 l.22358 - e-TeX middle
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+@y
+ print_err("Extra ");
+ if t=middle_noad then
+ begin print_esc("middle");
+@.Extra \\middle.@>
+ help1("I'm ignoring a \middle that had no matching \left.");
+ end
+ else begin print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ end;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22373 after_math - e-TeX TeXXeT
+procedure after_math;
+@y
+@t\4@>@<Declare subprocedures for |after_math|@>@;
+procedure after_math;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22380 after_math - e-TeX TeXXeT
+begin danger:=false;
+@y
+begin danger:=false;
+@<Retrieve the prototype box@>;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22387 after_math - e-TeX TeXXeT
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+@y
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ subtype(a):=dlist;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22390 after_math - e-TeX TeXXeT
+ danger:=false;
+@y
+ danger:=false;
+ @<Retrieve the prototype box@>;
+@z
+%---------------------------------------
+@x [48] m.1199 l.22477 - e-TeX TeXXeT
+w:=width(b); z:=display_width; s:=display_indent;
+@y
+w:=width(b); z:=display_width; s:=display_indent;
+if pre_display_direction<0 then s:=-s-z;
+@z
+%---------------------------------------
+@x [48] m.1199 l.22492 - e-TeX TeXXeT
+resume_after_display
+@y
+@<Flush the prototype box@>;
+resume_after_display
+@z
+%---------------------------------------
+@x [48] m.1202 l.22534 - e-TeX TeXXeT
+d:=half(z-w);
+@y
+subtype(b):=dlist;
+d:=half(z-w);
+@z
+%---------------------------------------
+@x [48] m.1203 l.22555 - e-TeX TeXXeT
+ begin shift_amount(a):=s; append_to_vlist(a);
+@y
+ begin app_display(j,a,0);
+@z
+%---------------------------------------
+@x [48] m.1204 l.22570 - e-TeX TeXXeT
+shift_amount(b):=s+d; append_to_vlist(b)
+@y
+app_display(j,b,d)
+@z
+%---------------------------------------
+@x [48] m.1205 l.22575 - e-TeX TeXXeT
+ shift_amount(a):=s+z-width(a);
+ append_to_vlist(a);
+@y
+ app_display(j,a,z-width(a));
+@z
+%---------------------------------------
+@x [48] m.1206 l.22594 - e-TeX TeXXeT
+pop_nest;
+@y
+flush_node_list(LR_box);
+pop_nest;
+@z
+%---------------------------------------
+@x [49] m.1208 l.22619 - e-TeX protected
+control sequence can be defined to be `\.{\\long}' or `\.{\\outer}', and
+it might or might not be expanded. The prefixes `\.{\\global}', `\.{\\long}',
+@y
+control sequence can be defined to be `\.{\\long}', `\.{\\protected}',
+or `\.{\\outer}', and it might or might not be expanded. The prefixes
+`\.{\\global}', `\.{\\long}', `\.{\\protected}',
+@z
+%---------------------------------------
+@x [49] m.1209 l.22645 - e-TeX protected
+ else print_esc("global");
+@y
+ @/@<Cases of |prefix| for |print_cmd_chr|@>@/
+ else print_esc("global");
+@z
+%---------------------------------------
+@x [49] m.1211 l.22707 prefixed_command - e-TeX tracing
+ @<Discard erroneous prefixes and |return|@>;
+@y
+ @<Discard erroneous prefixes and |return|@>;
+ if tracing_commands>2 then if eTeX_ex then show_cur_cmd_chr;
+@z
+%---------------------------------------
+@x [49] m.1213 l.22728 - e-TeX protected
+if (cur_cmd<>def)and(a mod 4<>0) then
+@y
+if a>=8 then
+ begin j:=protected_token; a:=a-8;
+ end
+else j:=0;
+if (cur_cmd<>def)and((a mod 4<>0)or(j<>0)) then
+@z
+%---------------------------------------
+@x [49] m.1218 l.22791 - e-TeX protected
+ q:=scan_toks(true,e); define(p,call+(a mod 4),def_ref);
+@y
+ q:=scan_toks(true,e);
+ if j<>0 then
+ begin q:=get_avail; info(q):=j; link(q):=link(def_ref);
+ link(def_ref):=q;
+ end;
+ define(p,call+(a mod 4),def_ref);
+@z
+%---------------------------------------
+@x [49] m.1221 l.22819 - e-TeX sparse arrays
+ if cur_cmd>=call then add_token_ref(cur_chr);
+@y
+ if cur_cmd>=call then add_token_ref(cur_chr)
+ else if (cur_cmd=register)or(cur_cmd=toks_register) then
+ if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ add_sa_ref(cur_chr);
+@z
+%---------------------------------------
+@x [49] m.1224 l.22882 - e-TeX sparse arrays
+ othercases begin scan_eight_bit_int;
+@y
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+@z
+%---------------------------------------
+@x [49] m.1225 l.22895 - e-TeX read_line
+read_to_cs: begin scan_int; n:=cur_val;
+@y
+read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1225 l.22903 - e-TeX read_line
+ p:=cur_cs; read_toks(n,p); define(p,call,cur_val);
+@y
+ p:=cur_cs; read_toks(n,p,j); define(p,call,cur_val);
+@z
+%---------------------------------------
+@x [49] m.1226 l.22912 - e-TeX sparse arrays
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@y
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true;
+ p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+@z
+%---------------------------------------
+@x [49] m.1226 l.22922 - e-TeX sparse arrays
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+@y
+ begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+@z
+%---------------------------------------
+@x [49] m.1226 l.22930 - e-TeX sparse arrays
+ define(p,call,def_ref);
+@y
+ sa_define(p,def_ref)(p,call,def_ref);
+@z
+%---------------------------------------
+@x [49] m.1227 l.22935 - e-TeX sparse arrays
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+@y
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_chr)
+ else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+@z
+%---------------------------------------
+@x [49] m.1236 l.23051 do_register_command - e-TeX sparse arrays
+begin q:=cur_cmd;
+@y
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@z
+%---------------------------------------
+@x [49] m.1236 l.23066 do_register_command - e-TeX sparse arrays
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+@y
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
+@z
+%---------------------------------------
+@x [49] m.1237 l.23088 - e-TeX sparse arrays
+p:=cur_chr; scan_eight_bit_int;
+@y
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+@z
+%---------------------------------------
+@x [49] m.1237 l.23095 - e-TeX sparse arrays
+end;
+found:
+@y
+ end;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=eqtb[l].int
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+@z
+%---------------------------------------
+@x [49] m.1238 l.23101 - e-TeX sparse arrays
+ if q=advance then cur_val:=cur_val+eqtb[l].int;
+@y
+ if q=advance then cur_val:=cur_val+w;
+@z
+%---------------------------------------
+@x [49] m.1239 l.23108 - e-TeX sparse arrays
+begin q:=new_spec(cur_val); r:=equiv(l);
+@y
+begin q:=new_spec(cur_val); r:=s;
+@z
+%---------------------------------------
+@x [49] m.1240 l.23128 - e-TeX sparse arrays
+ if p=int_val then cur_val:=mult_integers(eqtb[l].int,cur_val)
+ else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0)
+ else cur_val:=x_over_n(eqtb[l].int,cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+@y
+ if p=int_val then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin r:=new_spec(s);
+@z
+%---------------------------------------
+@x [49] m.1241 l.23150 - e-TeX sparse arrays
+set_box: begin scan_eight_bit_int;
+ if global then n:=256+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+@y
+set_box: begin scan_register_num;
+ if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(n)
+@z
+%---------------------------------------
+@x [49] m.1246 l.23221 alter_integer - e-TeX interaction_mode
+var c:0..1; {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+@y
+var c:small_number;
+ {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+@/@<Cases for |alter_integer|@>@/
+@z
+%---------------------------------------
+@x [49] m.1247 l.23230 alter_box_dimen - e-TeX sparse arrays
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+@y
+@!b:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1248 l.23239 - e-TeX penalties
+set_shape: begin scan_optional_equals; scan_int; n:=cur_val;
+ if n<=0 then p:=null
+@y
+set_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val;
+ if n<=0 then p:=null
+ else if q>par_shape_loc then
+ begin n:=(cur_val div 2)+1; p:=get_node(2*n+1); info(p):=n;
+ n:=cur_val; mem[p+1].int:=n; {number of penalties}
+ for j:=p+2 to p+n+1 do
+ begin scan_int; mem[j].int:=cur_val; {penalty values}
+ end;
+ if not odd(n) then mem[p+n+2].int:=0; {unused}
+ end
+@z
+%---------------------------------------
+@x [49] m.1248 l.23249 - e-TeX penalties
+ define(par_shape_loc,shape_ref,p);
+@y
+ define(q,shape_ref,p);
+@z
+%---------------------------------------
+@x [49] m.1292 l.23623 - e-TeX show_groups
+ show_lists:print_esc("showlists");
+@y
+ show_lists:print_esc("showlists");
+ @<Cases of |xray| for |print_cmd_chr|@>@;@/
+@z
+%---------------------------------------
+@x [49] m.1293 l.23630 show_whatever - e-TeX show_ifs
+var p:pointer; {tail of a token list to show}
+@y
+var p:pointer; {tail of a token list to show}
+@!t:small_number; {type of conditional being shown}
+@!m:normal..or_code; {upper bound on |fi_or_else| codes}
+@!l:integer; {line where that conditional began}
+@!n:integer; {level of \.{\\if...\\fi} nesting}
+@z
+%---------------------------------------
+@x [49] m.1293 l.23636 show_whatever - e-TeX show_groups
+othercases @<Show the current value of some parameter or register,
+@y
+@<Cases for |show_whatever|@>@;@/
+othercases @<Show the current value of some parameter or register,
+@z
+%---------------------------------------
+@x [49] m.1295 l.23671 - e-TeX protected
+call: print("macro");
+long_call: print_esc("long macro");
+outer_call: print_esc("outer macro");
+long_outer_call: begin print_esc("long"); print_esc("outer macro");
+@y
+call,long_call,outer_call,long_outer_call: begin n:=cmd-call;
+ if info(link(chr_code))=protected_token then n:=n+4;
+ if odd(n div 4) then print_esc("protected");
+ if odd(n) then print_esc("long");
+ if odd(n div 2) then print_esc("outer");
+ if n>0 then print_char(" ");
+ print("macro");
+@z
+%---------------------------------------
+@x [49] m.1296 l.23679 - e-TeX sparse arrays
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+@y
+begin scan_register_num; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+@z
+%---------------------------------------
+@x [50] m.1307 l.23821 - e-TeX basic
+dump_int(@$);@/
+@y
+dump_int(@$);@/
+@<Dump the \eTeX\ state@>@/
+@z
+%---------------------------------------
+@x [50] m.1308 l.23836 - e-TeX basic
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@y
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@/@<Undump the \eTeX\ state@>@/
+@z
+%---------------------------------------
+@x [50] m.1311 l.23890 - e-TeX sparse arrays
+dump_int(lo_mem_max); dump_int(rover);
+@y
+dump_int(lo_mem_max); dump_int(rover);
+if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+@z
+%---------------------------------------
+@x [50] m.1312 l.23913 - e-TeX sparse arrays
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+@y
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+if eTeX_ex then for k:=int_val to tok_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24107 - e-TeX hyph_codes
+dump_int(trie_max);
+@y
+dump_int(trie_max);
+dump_int(hyph_start);
+@z
+%---------------------------------------
+@x [50] m.1325 l.24135 - e-TeX hyph_codes
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+@y
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+undump(0)(j)(hyph_start);
+@z
+%---------------------------------------
+@x [51] m.1335 l.24355 final_cleanup - tracing
+ print_int(cur_level-level_one); print_char(")");
+@y
+ print_int(cur_level-level_one); print_char(")");
+ if eTeX_ex then show_save_groups;
+@z
+%---------------------------------------
+@x [51] m.1335 l.24378 final_cleanup - e-TeX marks, saved_items
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+@y
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+@z
+%---------------------------------------
+@x [51] m.1336 l.24387 init_prim - e-TeX basic
+begin no_new_control_sequence:=false;
+@y
+begin no_new_control_sequence:=false;
+first:=0;
+@z
+%---------------------------------------
+@x [51] m.1337 l.24402 - e-TeX basic
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+@<Enable \eTeX, if requested@>@;@/
+if (format_ident=0)or(buffer[loc]="&") then
+@z
+%---------------------------------------
+@x [51] m.1337 l.24410 - e-TeX basic
+ end;
+@y
+ end;
+if eTeX_ex then wterm_ln('entering extended mode');
+@z
+%---------------------------------------
+@x [53] m.1363 l.24757 - e-TeX hyph_codes
+adv_past(s)
+@y
+if subtype(s)=language_node then
+ begin cur_lang:=what_lang(s); l_hyf:=what_lhm(s); r_hyf:=what_rhm(s);
+ set_hyph_index;
+ end
+@z
+%---------------------------------------
+@x [54] m.1379 l.24945 - e-TeX additions
+@* \[54] System-dependent changes.
+@y
+@* \[53a] The extended features of \eTeX.
+The program has two modes of operation: (1)~In \TeX\ compatibility mode
+it fully deserves the name \TeX\ and there are neither extended features
+nor additional primitive commands. There are, however, a few
+modifications that would be legitimate in any implementation of \TeX\
+such as, e.g., preventing inadequate results of the glue to \.{DVI}
+unit conversion during |ship_out|. (2)~In extended mode there are
+additional primitive commands and the extended features of \eTeX\ are
+available.
+
+The distinction between these two modes of operation initially takes
+place when a `virgin' \.{eINITEX} starts without reading a format file.
+Later on the values of all \eTeX\ state variables are inherited when
+\.{eVIRTEX} (or \.{eINITEX}) reads a format file.
+
+The code below is designed to work for cases where `$|init|\ldots|tini|$'
+is a run-time switch.
+
+@<Enable \eTeX, if requested@>=
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+ begin no_new_control_sequence:=false;
+ @<Generate all \eTeX\ primitives@>@;
+ incr(loc); eTeX_mode:=1; {enter extended mode}
+ @<Initialize variables for \eTeX\ extended mode@>@;
+ end;
+tini@;@/
+if not no_new_control_sequence then {just entered extended mode ?}
+ no_new_control_sequence:=true@+else
+
+@ The \eTeX\ features available in extended mode are grouped into two
+categories: (1)~Some of them are permanently enabled and have no
+semantic effect as long as none of the additional primitives are
+executed. (2)~The remaining \eTeX\ features are optional and can be
+individually enabled and disabled. For each optional feature there is
+an \eTeX\ state variable named \.{\\...state}; the feature is enabled,
+resp.\ disabled by assigning a positive, resp.\ non-positive value to
+that integer.
+
+@d eTeX_state_base=int_base+eTeX_state_code
+@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable}
+@#
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+eTeX_version_code: print_esc("eTeXversion");
+
+@ @<Cases for fetching an integer value@>=
+eTeX_version_code: cur_val:=eTeX_version;
+
+@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?}
+
+@<Glob...@>=
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+
+@ @<Initialize table entries...@>=
+eTeX_mode:=0; {initially we are in compatibility mode}
+@<Initialize variables for \eTeX\ compatibility mode@>@;
+
+@ @<Dump the \eTeX\ state@>=
+dump_int(eTeX_mode);
+for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+
+@ @<Undump the \eTeX\ state@>=
+undump(0)(1)(eTeX_mode);
+if eTeX_ex then
+ begin @<Initialize variables for \eTeX\ extended mode@>@;
+ end
+else begin @<Initialize variables for \eTeX\ compatibility mode@>@;
+ end;
+
+@ The |eTeX_enabled| function simply returns its first argument as
+result. This argument is |true| if an optional \eTeX\ feature is
+currently enabled; otherwise, if the argument is |false|, the function
+gives an error message.
+
+@<Declare \eTeX\ procedures for use...@>=
+function eTeX_enabled(@!b:boolean;@!j:quarterword;@!k:halfword):boolean;
+begin if not b then
+ begin print_err("Improper "); print_cmd_chr(j,k);
+ help1("Sorry, this optional e-TeX feature has been disabled."); error;
+ end;
+eTeX_enabled:=b;
+end;
+
+@ First we implement the additional \eTeX\ parameters in the table of
+equivalents.
+
+@<Generate all \eTeX...@>=
+primitive("everyeof",assign_toks,every_eof_loc);
+@!@:every_eof_}{\.{\\everyeof} primitive@>
+primitive("tracingassigns",assign_int,int_base+tracing_assigns_code);@/
+@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@>
+primitive("tracinggroups",assign_int,int_base+tracing_groups_code);@/
+@!@:tracing_groups_}{\.{\\tracinggroups} primitive@>
+primitive("tracingifs",assign_int,int_base+tracing_ifs_code);@/
+@!@:tracing_ifs_}{\.{\\tracingifs} primitive@>
+primitive("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code);@/
+@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@>
+primitive("tracingnesting",assign_int,int_base+tracing_nesting_code);@/
+@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@>
+primitive("predisplaydirection",
+ assign_int,int_base+pre_display_direction_code);@/
+@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@>
+primitive("lastlinefit",assign_int,int_base+last_line_fit_code);@/
+@!@:last_line_fit_}{\.{\\lastlinefit} primitive@>
+primitive("savingvdiscards",assign_int,int_base+saving_vdiscards_code);@/
+@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@>
+primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/
+@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@>
+
+@ @d every_eof==equiv(every_eof_loc)
+
+@<Cases of |assign_toks| for |print_cmd_chr|@>=
+every_eof_loc: print_esc("everyeof");
+
+@ @<Cases for |print_param|@>=
+tracing_assigns_code:print_esc("tracingassigns");
+tracing_groups_code:print_esc("tracinggroups");
+tracing_ifs_code:print_esc("tracingifs");
+tracing_scan_tokens_code:print_esc("tracingscantokens");
+tracing_nesting_code:print_esc("tracingnesting");
+pre_display_direction_code:print_esc("predisplaydirection");
+last_line_fit_code:print_esc("lastlinefit");
+saving_vdiscards_code:print_esc("savingvdiscards");
+saving_hyph_codes_code:print_esc("savinghyphcodes");
+
+@ In order to handle \.{\\everyeof} we need an array |eof_seen| of
+boolean variables.
+
+@<Glob...@>=
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+
+@ The |print_group| procedure prints the current level of grouping and
+the name corresponding to |cur_group|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure print_group(@!e:boolean);
+label exit;
+begin case cur_group of
+ bottom_level: begin print("bottom level"); return;
+ end;
+ simple_group,semi_simple_group:
+ begin if cur_group=semi_simple_group then print("semi ");
+ print("simple");
+ end;
+ hbox_group,adjusted_hbox_group:
+ begin if cur_group=adjusted_hbox_group then print("adjusted ");
+ print("hbox");
+ end;
+ vbox_group: print("vbox");
+ vtop_group: print("vtop");
+ align_group,no_align_group:
+ begin if cur_group=no_align_group then print("no ");
+ print("align");
+ end;
+ output_group: print("output");
+ disc_group: print("disc");
+ insert_group: print("insert");
+ vcenter_group: print("vcenter");
+ math_group,math_choice_group,math_shift_group,math_left_group:
+ begin print("math");
+ if cur_group=math_choice_group then print(" choice")
+ else if cur_group=math_shift_group then print(" shift")
+ else if cur_group=math_left_group then print(" left");
+ end;
+ end; {there are no other cases}
+print(" group (level "); print_int(qo(cur_level)); print_char(")");
+if saved(-1)<>0 then
+ begin if e then print(" entered at line ") else print(" at line ");
+ print_int(saved(-1));
+ end;
+exit:end;
+
+@ The |group_trace| procedure is called when a new level of grouping
+begins (|e=false|) or ends (|e=true|) with |saved(-1)| containing the
+line number.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure group_trace(@!e:boolean);
+begin begin_diagnostic; print_char("{");
+if e then print("leaving ") else print("entering ");
+print_group(e); print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ The \.{\\currentgrouplevel} and \.{\\currentgrouptype} commands return
+the current level of grouping and the type of the current group
+respectively.
+
+@d current_group_level_code=eTeX_int+1 {code for \.{\\currentgrouplevel}}
+@d current_group_type_code=eTeX_int+2 {code for \.{\\currentgrouptype}}
+
+@<Generate all \eTeX...@>=
+primitive("currentgrouplevel",last_item,current_group_level_code);
+@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@>
+primitive("currentgrouptype",last_item,current_group_type_code);
+@!@:current_group_type_}{\.{\\currentgrouptype} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_group_level_code: print_esc("currentgrouplevel");
+current_group_type_code: print_esc("currentgrouptype");
+
+@ @<Cases for fetching an integer value@>=
+current_group_level_code: cur_val:=cur_level-level_one;
+current_group_type_code: cur_val:=cur_group;
+
+@ The \.{\\currentiflevel}, \.{\\currentiftype}, and
+\.{\\currentifbranch} commands return the current level of conditionals
+and the type and branch of the current conditional.
+
+@d current_if_level_code=eTeX_int+3 {code for \.{\\currentiflevel}}
+@d current_if_type_code=eTeX_int+4 {code for \.{\\currentiftype}}
+@d current_if_branch_code=eTeX_int+5 {code for \.{\\currentifbranch}}
+
+@<Generate all \eTeX...@>=
+primitive("currentiflevel",last_item,current_if_level_code);
+@!@:current_if_level_}{\.{\\currentiflevel} primitive@>
+primitive("currentiftype",last_item,current_if_type_code);
+@!@:current_if_type_}{\.{\\currentiftype} primitive@>
+primitive("currentifbranch",last_item,current_if_branch_code);
+@!@:current_if_branch_}{\.{\\currentifbranch} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_if_level_code: print_esc("currentiflevel");
+current_if_type_code: print_esc("currentiftype");
+current_if_branch_code: print_esc("currentifbranch");
+
+@ @<Cases for fetching an integer value@>=
+current_if_level_code: begin q:=cond_ptr; cur_val:=0;
+ while q<>null do
+ begin incr(cur_val); q:=link(q);
+ end;
+ end;
+current_if_type_code: if cond_ptr=null then cur_val:=0
+ else if cur_if<unless_code then cur_val:=cur_if+1
+ else cur_val:=-(cur_if-unless_code+1);
+current_if_branch_code:
+ if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1
+ else if if_limit=fi_code then cur_val:=-1
+ else cur_val:=0;
+
+@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and
+\.{\\fontcharic} commands return information about a character in a
+font.
+
+@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}}
+@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}}
+@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}}
+@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}}
+
+@<Generate all \eTeX...@>=
+primitive("fontcharwd",last_item,font_char_wd_code);
+@!@:font_char_wd_}{\.{\\fontcharwd} primitive@>
+primitive("fontcharht",last_item,font_char_ht_code);
+@!@:font_char_ht_}{\.{\\fontcharht} primitive@>
+primitive("fontchardp",last_item,font_char_dp_code);
+@!@:font_char_dp_}{\.{\\fontchardp} primitive@>
+primitive("fontcharic",last_item,font_char_ic_code);
+@!@:font_char_ic_}{\.{\\fontcharic} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+font_char_wd_code: print_esc("fontcharwd");
+font_char_ht_code: print_esc("fontcharht");
+font_char_dp_code: print_esc("fontchardp");
+font_char_ic_code: print_esc("fontcharic");
+
+@ @<Cases for fetching a dimension value@>=
+font_char_wd_code,
+font_char_ht_code,
+font_char_dp_code,
+font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
+ if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
+ begin i:=char_info(q)(qi(cur_val));
+ case m of
+ font_char_wd_code: cur_val:=char_width(q)(i);
+ font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
+ font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
+ font_char_ic_code: cur_val:=char_italic(q)(i);
+ end; {there are no other cases}
+ end
+ else cur_val:=0;
+ end;
+
+@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength}
+commands return the indent and length parameters of the current
+\.{\\parshape} specification.
+
+@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}}
+@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}}
+@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}}
+
+@<Generate all \eTeX...@>=
+primitive("parshapelength",last_item,par_shape_length_code);
+@!@:par_shape_length_}{\.{\\parshapelength} primitive@>
+primitive("parshapeindent",last_item,par_shape_indent_code);
+@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@>
+primitive("parshapedimen",last_item,par_shape_dimen_code);
+@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+par_shape_length_code: print_esc("parshapelength");
+par_shape_indent_code: print_esc("parshapeindent");
+par_shape_dimen_code: print_esc("parshapedimen");
+
+@ @<Cases for fetching a dimension value@>=
+par_shape_length_code,
+par_shape_indent_code,
+par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int;
+ if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0
+ else begin if q=2 then
+ begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2;
+ end;
+ if cur_val>info(par_shape_ptr) then cur_val:=info(par_shape_ptr);
+ cur_val:=mem[par_shape_ptr+2*cur_val-q].sc;
+ end;
+ cur_val_level:=dimen_val;
+ end;
+
+@ The \.{\\showgroups} command displays all currently active grouping
+levels.
+
+@d show_groups=4 { \.{\\showgroups} }
+
+@<Generate all \eTeX...@>=
+primitive("showgroups",xray,show_groups);
+@!@:show_groups_}{\.{\\showgroups} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_groups:print_esc("showgroups");
+
+@ @<Cases for |show_whatever|@>=
+show_groups: begin begin_diagnostic; show_save_groups;
+ end;
+
+@ @<Types...@>=
+@!save_pointer=0..save_size; {index into |save_stack|}
+
+@ The modifications of \TeX\ required for the display produced by the
+|show_save_groups| procedure were first discussed by Donald~E. Knuth in
+{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990.
+@^Knuth, Donald Ervin@>
+
+In order to understand a group type we also have to know its mode.
+Since unrestricted horizontal modes are not associated with grouping,
+they are skipped when traversing the semantic nest.
+
+@<Declare \eTeX\ procedures for use...@>=
+procedure show_save_groups;
+label found1,found2,found,done;
+var p:0..nest_size; {index into |nest|}
+@!m:-mmode..mmode; {mode}
+@!v:save_pointer; {saved value of |save_ptr|}
+@!l:quarterword; {saved value of |cur_level|}
+@!c:group_code; {saved value of |cur_group|}
+@!a:-1..1; {to keep track of alignments}
+@!i:integer;
+@!j:quarterword;
+@!s:str_number;
+begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array}
+v:=save_ptr; l:=cur_level; c:=cur_group;
+save_ptr:=cur_boundary; decr(cur_level);@/
+a:=1;
+print_nl(""); print_ln;
+loop@+begin print_nl("### "); print_group(true);
+ if cur_group=bottom_level then goto done;
+ repeat m:=nest[p].mode_field;
+ if p>0 then decr(p) else m:=vmode;
+ until m<>hmode;
+ print(" (");
+ case cur_group of
+ simple_group: begin incr(p); goto found2;
+ end;
+ hbox_group,adjusted_hbox_group: s:="hbox";
+ vbox_group: s:="vbox";
+ vtop_group: s:="vtop";
+ align_group: if a=0 then
+ begin if m=-vmode then s:="halign" else s:="valign";
+ a:=1; goto found1;
+ end
+ else begin if a=1 then print("align entry") else print_esc("cr");
+ if p>=a then p:=p-a;
+ a:=0; goto found;
+ end;
+ no_align_group:
+ begin incr(p); a:=-1; print_esc("noalign"); goto found2;
+ end;
+ output_group:
+ begin print_esc("output"); goto found;
+ end;
+ math_group: goto found2;
+ disc_group,math_choice_group:
+ begin if cur_group=disc_group then print_esc("discretionary")
+ else print_esc("mathchoice");
+ for i:=1 to 3 do if i<=saved(-2) then print("{}");
+ goto found2;
+ end;
+ insert_group:
+ begin if saved(-2)=255 then print_esc("vadjust")
+ else begin print_esc("insert"); print_int(saved(-2));
+ end;
+ goto found2;
+ end;
+ vcenter_group: begin s:="vcenter"; goto found1;
+ end;
+ semi_simple_group: begin incr(p); print_esc("begingroup"); goto found;
+ end;
+ math_shift_group:
+ begin if m=mmode then print_char("$")
+ else if nest[p].mode_field=mmode then
+ begin print_cmd_chr(eq_no,saved(-2)); goto found;
+ end;
+ print_char("$"); goto found;
+ end;
+ math_left_group:
+ begin if type(nest[p+1].eTeX_aux_field)=left_noad then print_esc("left")
+ else print_esc("middle");
+ goto found;
+ end;
+ end; {there are no other cases}
+ @<Show the box context@>;
+ found1: print_esc(s); @<Show the box packaging info@>;
+ found2: print_char("{");
+ found: print_char(")"); decr(cur_level);
+ cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+ end;
+done: save_ptr:=v; cur_level:=l; cur_group:=c;
+end;
+
+@ @<Show the box packaging info@>=
+if saved(-2)<>0 then
+ begin print_char(" ");
+ if saved(-3)=exactly then print("to") else print("spread");
+ print_scaled(saved(-2)); print("pt");
+ end
+
+@ @<Show the box context@>=
+i:=saved(-4);
+if i<>0 then
+ if i<box_flag then
+ begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
+ if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
+ print_scaled(abs(i)); print("pt");
+ end
+ else if i<ship_out_flag then
+ begin if i>=global_box_flag then
+ begin print_esc("global"); i:=i-(global_box_flag-box_flag);
+ end;
+ print_esc("setbox"); print_int(i-box_flag); print_char("=");
+ end
+ else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
+
+@ The |scan_general_text| procedure is much like |scan_toks(false,false)|,
+but will be invoked via |expand|, i.e., recursively.
+@^recursion@>
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_general_text; forward;@t\2@>
+
+@ The token list (balanced text) created by |scan_general_text| begins
+at |link(temp_head)| and ends at |cur_val|. (If |cur_val=temp_head|,
+the list is empty.)
+
+@<Declare \eTeX\ procedures for tok...@>=
+procedure scan_general_text;
+label found;
+var s:normal..absorbing; {to save |scanner_status|}
+@!w:pointer; {to save |warning_index|}
+@!d:pointer; {to save |def_ref|}
+@!p:pointer; {tail of the token list being built}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!unbalance:halfword; {number of unmatched left braces}
+begin s:=scanner_status; w:=warning_index; d:=def_ref;
+scanner_status:=absorbing; warning_index:=cur_cs;
+def_ref:=get_avail; token_ref_count(def_ref):=null; p:=def_ref;
+scan_left_brace; {remove the compulsory left brace}
+unbalance:=1;
+loop@+ begin get_token;
+ if cur_tok<right_brace_limit then
+ if cur_cmd<right_brace then incr(unbalance)
+ else begin decr(unbalance);
+ if unbalance=0 then goto found;
+ end;
+ store_new_token(cur_tok);
+ end;
+found: q:=link(def_ref); free_avail(def_ref); {discard reference count}
+if q=null then cur_val:=temp_head @+ else cur_val:=p;
+link(temp_head):=q;
+scanner_status:=s; warning_index:=w; def_ref:=d;
+end;
+
+@ The \.{\\showtokens} command displays a token list.
+
+@d show_tokens=5 { \.{\\showtokens} , must be odd! }
+
+@<Generate all \eTeX...@>=
+primitive("showtokens",xray,show_tokens);
+@!@:show_tokens_}{\.{\\showtokens} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_tokens:print_esc("showtokens");
+
+@ The \.{\\unexpanded} primitive prevents expansion of tokens much as
+the result from \.{\\the} applied to a token variable. The
+\.{\\detokenize} primitive converts a token list into a list of
+character tokens much as if the token list were written to a file. We
+use the fact that the command modifiers for \.{\\unexpanded} and
+\.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe}
+are even.
+
+@<Generate all \eTeX...@>=
+primitive("unexpanded",the,1);@/
+@!@:unexpanded_}{\.{\\unexpanded} primitive@>
+primitive("detokenize",the,show_tokens);@/
+@!@:detokenize_}{\.{\\detokenize} primitive@>
+
+@ @<Cases of |the| for |print_cmd_chr|@>=
+else if chr_code=1 then print_esc("unexpanded")
+else print_esc("detokenize")
+
+@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>=
+if odd(cur_chr) then
+ begin c:=cur_chr; scan_general_text;
+ if c=1 then the_toks:=cur_val
+ else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
+ p:=get_avail; link(p):=link(temp_head);
+ token_show(p); flush_list(p);
+ selector:=old_setting; the_toks:=str_toks(b);
+ end;
+ return;
+ end
+
+@ The \.{\\showifs} command displays all currently active conditionals.
+
+@d show_ifs=6 { \.{\\showifs} }
+
+@<Generate all \eTeX...@>=
+primitive("showifs",xray,show_ifs);
+@!@:show_ifs_}{\.{\\showifs} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_ifs:print_esc("showifs");
+
+@
+@d print_if_line(#)==if #<>0 then
+ begin print(" entered on line "); print_int(#);
+ end
+
+@<Cases for |show_whatever|@>=
+show_ifs: begin begin_diagnostic; print_nl(""); print_ln;
+ if cond_ptr=null then
+ begin print_nl("### "); print("no active conditionals");
+ end
+ else begin p:=cond_ptr; n:=0;
+ repeat incr(n); p:=link(p);@+until p=null;
+ p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit;
+ repeat print_nl("### level "); print_int(n); print(": ");
+ print_cmd_chr(if_test,t);
+ if m=fi_code then print_esc("else");
+ print_if_line(l);
+ decr(n); t:=subtype(p); l:=if_line_field(p); m:=type(p); p:=link(p);
+ until p=null;
+ end;
+ end;
+
+@ The \.{\\interactionmode} primitive allows to query and set the
+interaction mode.
+
+@<Generate all \eTeX...@>=
+primitive("interactionmode",set_page_int,2);
+@!@:interaction_mode_}{\.{\\interactionmode} primitive@>
+
+@ @<Cases of |set_page_int| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("interactionmode")
+
+@ @<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>=
+else if m=2 then cur_val:=interaction
+
+@ @<Declare \eTeX\ procedures for use...@>=
+procedure@?new_interaction; forward;@t\2@>
+
+@ @<Cases for |alter_integer|@>=
+else if c=2 then
+ begin if (cur_val<batch_mode)or(cur_val>error_stop_mode) then
+ begin print_err("Bad interaction mode");
+@.Bad interaction mode@>
+ help2("Modes are 0=batch, 1=nonstop, 2=scroll, and")@/
+ ("3=errorstop. Proceed, and I'll ignore this case.");
+ int_error(cur_val);
+ end
+ else begin cur_chr:=cur_val; new_interaction;
+ end;
+ end
+
+@ The |middle| feature of \eTeX\ allows one ore several \.{\\middle}
+delimiters to appear between \.{\\left} and \.{\\right}.
+
+@<Generate all \eTeX...@>=
+primitive("middle",left_right,middle_noad);
+@!@:middle_}{\.{\\middle} primitive@>
+
+@ @<Cases of |left_right| for |print_cmd_chr|@>=
+else if chr_code=middle_noad then print_esc("middle")
+
+@ In constructions such as
+$$\vbox{\halign{\.{#}\hfil\cr
+{}\\hbox to \\hsize\{\cr
+\hskip 25pt \\hskip 0pt plus 0.0001fil\cr
+\hskip 25pt ...\cr
+\hskip 25pt \\hfil\\penalty-200\\hfilneg\cr
+\hskip 25pt ...\}\cr}}$$
+the stretch components of \.{\\hfil} and \.{\\hfilneg} compensate; they may,
+however, get modified in order to prevent arithmetic overflow during
+|hlist_out| when each of them is multiplied by a large |glue_set| value.
+
+Since this ``glue rounding'' depends on state variables |cur_g| and
+|cur_glue| and \TeXXeT\ is supposed to emulate the behaviour of \TeXeT\
+(plus a suitable postprocessor) as close as possible the glue rounding
+cannot be postponed until (segments of) an hlist has been reversed.
+
+The code below is invoked after the effective width, |rule_wd|, of a glue
+node has been computed. The glue node is either converted into a kern node
+or, for leaders, the glue specification is replaced by an equivalent rigid
+one; the subtype of the glue node remains unchanged.
+
+@<Handle a glue node for mixed...@>=
+if (((g_sign=stretching) and (stretch_order(g)=g_order)) or
+ ((g_sign=shrinking) and (shrink_order(g)=g_order))) then
+ begin fast_delete_glue_ref(g);
+ if subtype(p)<a_leaders then
+ begin type(p):=kern_node; width(p):=rule_wd;
+ end
+ else begin g:=get_node(glue_spec_size);@/
+ stretch_order(g):=filll+1; shrink_order(g):=filll+1; {will never match}
+ width(g):=rule_wd; stretch(g):=0; shrink(g):=0; glue_ptr(p):=g;
+ end;
+ end
+
+@ The optional |TeXXeT| feature of \eTeX\ contains the code for mixed
+left-to-right and right-to-left typesetting. This code is inspired by
+but different from \TeXeT\ as presented by Donald~E. Knuth and Pierre
+MacKay in {\sl TUGboat\/} {\bf 8}, 14--25, 1987.
+@^Knuth, Donald Ervin@>
+@^MacKay, Pierre@>
+
+In order to avoid confusion with \TeXeT\ the present implementation of
+mixed direction typesetting is called \TeXXeT. It differs from \TeXeT\
+in several important aspects: (1)~Right-to-left text is reversed
+explicitely by the |ship_out| routine and is written to a normal \.{DVI}
+file without any |begin_reflect| or |end_reflect| commands; (2)~a
+|math_node| is (ab)used instead of a |whatsit_node| to record the
+\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} text direction
+primitives in order to keep the influence on the line breaking algorithm
+for pure left-to-right text as small as possible; (3)~right-to-left text
+interrupted by a displayed equation is automatically resumed after that
+equation; and (4)~the |valign| command code with a non-zero command
+modifier is (ab)used for the text direction primitives.
+
+Nevertheless there is a subtle difference between \TeX\ and \TeXXeT\
+that may influence the line breaking algorithm for pure left-to-right
+text. When a paragraph containing math mode material is broken into
+lines \TeX\ may generate lines where math mode material is not enclosed
+by properly nested \.{\\mathon} and \.{\\mathoff} nodes. Unboxing such
+lines as part of a new paragraph may have the effect that hyphenation is
+attempted for `words' originating from math mode or that hyphenation is
+inhibited for words originating from horizontal mode.
+
+In \TeXXeT\ additional \.{\\beginM}, resp.\ \.{\\endM} math nodes are
+supplied at the start, resp.\ end of lines such that math mode material
+inside a horizontal list always starts with either \.{\\mathon} or
+\.{\\beginM} and ends with \.{\\mathoff} or \.{\\endM}. These
+additional nodes are transparent to operations such as \.{\\unskip},
+\.{\\lastpenalty}, or \.{\\lastbox} but they do have the effect that
+hyphenation is never attempted for `words' originating from math mode
+and is never inhibited for words originating from horizontal mode.
+
+@d TeXXeT_state==eTeX_state(TeXXeT_code)
+@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?}
+
+@<Cases for |print_param|@>=
+eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate");
+
+@ @<Generate all \eTeX...@>=
+primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code);
+@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@>
+primitive("beginL",valign,begin_L_code);
+@!@:beginL_}{\.{\\beginL} primitive@>
+primitive("endL",valign,end_L_code);
+@!@:endL_}{\.{\\endL} primitive@>
+primitive("beginR",valign,begin_R_code);
+@!@:beginR_}{\.{\\beginR} primitive@>
+primitive("endR",valign,end_R_code);
+@!@:endR_}{\.{\\endR} primitive@>
+
+@ @<Cases of |valign| for |print_cmd_chr|@>=
+else case chr_code of
+ begin_L_code: print_esc("beginL");
+ end_L_code: print_esc("endL");
+ begin_R_code: print_esc("beginR");
+ othercases print_esc("endR")
+ endcases
+
+@ @<Cases of |main_control| for |hmode+valign|@>=
+if cur_chr>0 then
+ begin if eTeX_enabled(TeXXeT_en,cur_cmd,cur_chr) then
+@.Improper \\beginL@>
+@.Improper \\endL@>
+@.Improper \\beginR@>
+@.Improper \\endR@>
+ tail_append(new_math(0,cur_chr));
+ end
+else
+
+@ An hbox with subtype dlist will never be reversed, even when embedded
+in right-to-left text.
+
+@<Display if this box is never to be reversed@>=
+if (type(p)=hlist_node)and(subtype(p)=dlist) then print(", display")
+
+@ A number of routines are based on a stack of one-word nodes whose
+|info| fields contain |end_M_code|, |end_L_code|, or |end_R_code|. The
+top of the stack is pointed to by |LR_ptr|.
+
+When the stack manipulation macros of this section are used below,
+variable |LR_ptr| might be the global variable declared here for |hpack|
+and |ship_out|, or might be local to |post_line_break|.
+
+@d put_LR(#)==begin temp_ptr:=get_avail; info(temp_ptr):=#;
+ link(temp_ptr):=LR_ptr; LR_ptr:=temp_ptr;
+ end
+@#
+@d push_LR(#)==put_LR(end_LR_type(#))
+@#
+@d pop_LR==begin temp_ptr:=LR_ptr; LR_ptr:=link(temp_ptr);
+ free_avail(temp_ptr);
+ end
+
+@<Glob...@>=
+@!LR_temp:pointer; {holds a temporarily removed \.{\\endM} node}
+@!LR_ptr:pointer; {stack of LR codes for |hpack|, |ship_out|, and |init_math|}
+@!LR_problems:integer; {counts missing begins and ends}
+@!cur_dir:small_number; {current text direction}
+
+@ @<Set init...@>=
+LR_temp:=null; LR_ptr:=null; LR_problems:=0; cur_dir:=left_to_right;
+
+@ @<Insert LR nodes at the beg...@>=
+begin q:=link(temp_head);
+if LR_ptr<>null then
+ begin temp_ptr:=LR_ptr; r:=q;
+ repeat s:=new_math(0,begin_LR_type(info(temp_ptr))); link(s):=r; r:=s;
+ temp_ptr:=link(temp_ptr);
+ until temp_ptr=null;
+ link(temp_head):=r;
+ end;
+while q<>cur_break(cur_p) do
+ begin if not is_char_node(q) then
+ if type(q)=math_node then @<Adjust \(t)the LR stack for the |p...@>;
+ q:=link(q);
+ end;
+end
+
+@ @<Adjust \(t)the LR stack for the |p...@>=
+if end_LR(q) then
+ begin if LR_ptr<>null then if info(LR_ptr)=end_LR_type(q) then pop_LR;
+ end
+else push_LR(q)
+
+@ We use the fact that |q| now points to the node with \.{\\rightskip} glue.
+
+@<Insert LR nodes at the end...@>=
+if LR_ptr<>null then
+ begin s:=temp_head; r:=link(s);
+ while r<>q do
+ begin s:=r; r:=link(s);
+ end;
+ r:=LR_ptr;
+ while r<>null do
+ begin temp_ptr:=new_math(0,info(r));
+ link(s):=temp_ptr; s:=temp_ptr; r:=link(r);
+ end;
+ link(s):=q;
+ end
+
+@ Special \.{\\beginM} and \.{\\endM} nodes are inserted in cases where
+math nodes are discarded during line breaking or end up in different
+lines. When the current lists ends with an \.{\\endM} node that node is
+temporarily removed and later reinserted when the last node is to be
+inspected or removed. A final \.{\\endM} preceded by a |char_node| will
+not be removed.
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure remove_end_M;
+var @!p:pointer; {runs through the current list}
+begin p:=head;
+while link(p)<>tail do p:=link(p);
+if not is_char_node(p) then
+ begin LR_temp:=tail; link(p):=null; tail:=p;
+ end;
+end;
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure insert_end_M;
+label done;
+var @!p:pointer; {runs through the current list}
+begin if not is_char_node(tail) then
+ if (type(tail)=math_node)and(subtype(tail)=begin_M_code) then
+ begin free_node(LR_temp,small_node_size); p:=head;
+ while link(p)<>tail do p:=link(p);
+ free_node(tail,small_node_size); link(p):=null; tail:=p; goto done;
+ end;
+link(tail):=LR_temp; tail:=LR_temp;
+done: LR_temp:=null;
+end;
+
+@ @<Initialize the LR stack@>=
+put_LR(before) {this will never match}
+
+@ @<Adjust \(t)the LR stack for the |hp...@>=
+if end_LR(p) then
+ if info(LR_ptr)=end_LR_type(p) then pop_LR
+ else begin incr(LR_problems); type(p):=kern_node; subtype(p):=explicit;
+ end
+else push_LR(p)
+
+@ @<Check for LR anomalies at the end of |hp...@>=
+begin if info(LR_ptr)<>before then
+ begin while link(q)<>null do q:=link(q);
+ repeat temp_ptr:=q; q:=new_math(0,info(LR_ptr)); link(temp_ptr):=q;
+ LR_problems:=LR_problems+10000; pop_LR;
+ until info(LR_ptr)=before;
+ end;
+if LR_problems>0 then
+ begin @<Report LR problems@>; goto common_ending;
+ end;
+pop_LR;
+if LR_ptr<>null then confusion("LR1");
+@:this can't happen LR1}{\quad LR1@>
+end
+
+@ @<Report LR problems@>=
+begin print_ln; print_nl("\endL or \endR problem (");@/
+print_int(LR_problems div 10000); print(" missing, ");@/
+print_int(LR_problems mod 10000); print(" extra");@/
+LR_problems:=0;
+end
+
+@ @<Initialize |hlist_out| for mixed...@>=
+if eTeX_ex then
+ begin @<Initialize the LR stack@>;
+ if subtype(this_box)=dlist then
+ if cur_dir=right_to_left then
+ begin cur_dir:=left_to_right; cur_h:=cur_h-width(this_box);
+ end
+ else subtype(this_box):=min_quarterword;
+ if (cur_dir=right_to_left)and(subtype(this_box)<>reversed) then
+ @<Reverse the complete hlist and set the subtype to |reversed|@>;
+ end
+
+@ @<Finish |hlist_out| for mixed...@>=
+if eTeX_ex then
+ begin @<Check for LR anomalies at the end of |hlist_out|@>;
+ if subtype(this_box)=dlist then cur_dir:=right_to_left;
+ end
+
+@ @<Handle a math node in |hlist_out|@>=
+begin if eTeX_ex then
+ @<Adjust \(t)the LR stack for the |hlist_out| routine; if necessary
+ reverse an hlist segment and |goto reswitch|@>;
+ cur_h:=cur_h+width(p);
+ end
+
+@ Breaking a paragraph into lines while \TeXXeT\ is disabled may result
+in lines whith unpaired math nodes. Such hlists are silently accepted
+in the absence of text direction directives.
+
+@d LR_dir(#)==(subtype(#) div R_code) {text direction of a `math node'}
+
+@<Adjust \(t)the LR stack for the |hl...@>=
+begin if end_LR(p) then
+ if info(LR_ptr)=end_LR_type(p) then pop_LR
+ else begin if subtype(p)>L_code then incr(LR_problems);
+ end
+else begin push_LR(p);
+ if LR_dir(p)<>cur_dir then
+ @<Reverse an hlist segment and |goto reswitch|@>;
+ end;
+type(p):=kern_node;
+end
+
+@ @<Check for LR anomalies at the end of |hl...@>=
+begin while info(LR_ptr)<>before do
+ begin if info(LR_ptr)>L_code then LR_problems:=LR_problems+10000;
+ pop_LR;
+ end;
+pop_LR;
+end
+
+@ @d edge_node=style_node {a |style_node| does not occur in hlists}
+@d edge_node_size=style_node_size {number of words in an edge node}
+@d edge_dist(#)==depth(#) {new |left_edge| position relative to |cur_h|
+ (after |width| has been taken into account)}
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+function new_edge(@!s:small_number;@!w:scaled):pointer;
+ {create an edge node}
+var p:pointer; {the new node}
+begin p:=get_node(edge_node_size); type(p):=edge_node; subtype(p):=s;
+width(p):=w; edge_dist(p):=0; {the |edge_dist| field will be set later}
+new_edge:=p;
+end;
+
+@ @<Cases of |hlist_out| that arise...@>=
+edge_node: begin cur_h:=cur_h+width(p);
+ left_edge:=cur_h+edge_dist(p); cur_dir:=subtype(p);
+ end;
+
+@ We detach the hlist, start a new one consisting of just one kern node,
+append the reversed list, and set the width of the kern node.
+
+@<Reverse the complete hlist...@>=
+begin save_h:=cur_h; temp_ptr:=p; p:=new_kern(0); link(prev_p):=p;
+cur_h:=0; link(p):=reverse(this_box,null,cur_g,cur_glue); width(p):=-cur_h;
+cur_h:=save_h; subtype(this_box):=reversed;
+end
+
+@ We detach the remainder of the hlist, replace the math node by
+an edge node, and append the reversed hlist segment to it; the tail of
+the reversed segment is another edge node and the remainder of the
+original list is attached to it.
+
+@<Reverse an hlist segment...@>=
+begin save_h:=cur_h; temp_ptr:=link(p); rule_wd:=width(p);
+free_node(p,small_node_size);
+cur_dir:=reflected; p:=new_edge(cur_dir,rule_wd); link(prev_p):=p;
+cur_h:=cur_h-left_edge+rule_wd;
+link(p):=reverse(this_box,new_edge(reflected,0),cur_g,cur_glue);
+edge_dist(p):=cur_h; cur_dir:=reflected; cur_h:=save_h;
+goto reswitch;
+end
+
+@ The |reverse| function defined here is responsible to reverse the
+nodes of an hlist (segment). The first parameter |this_box| is the enclosing
+hlist node, the second parameter |t| is to become the tail of the reversed
+list, and the global variable |temp_ptr| is the head of the list to be
+reversed. Finally |cur_g| and |cur_glue| are the current glue rounding state
+variables, to be updated by this function. We remove nodes from the original
+list and add them to the head of the new one.
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+function reverse(@!this_box,@!t:pointer; var cur_g:scaled;
+ var cur_glue:real):pointer;
+label reswitch,next_p,done;
+var l:pointer; {the new list}
+@!p:pointer; {the current node}
+@!q:pointer; {the next node}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!glue_temp:real; {glue value before rounding}
+@!m,@!n:halfword; {count of unmatched math nodes}
+begin g_order:=glue_order(this_box); g_sign:=glue_sign(this_box);
+l:=t; p:=temp_ptr; m:=min_halfword; n:=min_halfword;
+loop@+ begin while p<>null do
+ @<Move node |p| to the new list and go to the next node;
+ or |goto done| if the end of the reflected segment has been reached@>;
+ if (t=null)and(m=min_halfword)and(n=min_halfword) then goto done;
+ p:=new_math(0,info(LR_ptr)); LR_problems:=LR_problems+10000;
+ {manufacture one missing math node}
+ end;
+done:reverse:=l;
+end;
+
+@ @<Move node |p| to the new list...@>=
+reswitch: if is_char_node(p) then
+ repeat f:=font(p); c:=character(p);
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+ q:=link(p); link(p):=l; l:=p; p:=q;
+ until not is_char_node(p)
+else @<Move the non-|char_node| |p| to the new list@>
+
+@ @<Move the non-|char_node| |p| to the new list@>=
+begin q:=link(p);
+case type(p) of
+hlist_node,vlist_node,rule_node,kern_node: rule_wd:=width(p);
+@t\4@>@<Cases of |reverse| that need special treatment@>@;
+edge_node: confusion("LR2");
+@:this can't happen LR2}{\quad LR2@>
+othercases goto next_p
+endcases;@/
+cur_h:=cur_h+rule_wd;
+next_p: link(p):=l;
+if type(p)=kern_node then if (rule_wd=0)or(l=null) then
+ begin free_node(p,small_node_size); p:=l;
+ end;
+l:=p; p:=q;
+end
+
+@ Here we compute the effective width of a glue node as in |hlist_out|.
+
+@<Cases of |reverse|...@>=
+glue_node: begin round_glue;
+ @<Handle a glue node for mixed...@>;
+ end;
+
+@ A ligature node is replaced by a char node.
+
+@<Cases of |reverse|...@>=
+ligature_node: begin flush_node_list(lig_ptr(p));
+ temp_ptr:=p; p:=get_avail; mem[p]:=mem[lig_char(temp_ptr)]; link(p):=q;
+ free_node(temp_ptr,small_node_size); goto reswitch;
+ end;
+
+@ Math nodes in an inner reflected segment are modified, those at the
+outer level are changed into kern nodes.
+
+@<Cases of |reverse|...@>=
+math_node: begin rule_wd:=width(p);
+if end_LR(p) then
+ if info(LR_ptr)<>end_LR_type(p) then
+ begin type(p):=kern_node; incr(LR_problems);
+ end
+ else begin pop_LR;
+ if n>min_halfword then
+ begin decr(n); decr(subtype(p)); {change |after| into |before|}
+ end
+ else begin type(p):=kern_node;
+ if m>min_halfword then decr(m)
+ else @<Finish the reversed hlist segment and |goto done|@>;
+ end;
+ end
+else begin push_LR(p);
+ if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
+ begin incr(n); incr(subtype(p)); {change |before| into |after|}
+ end
+ else begin type(p):=kern_node; incr(m);
+ end;
+ end;
+end;
+
+@ Finally we have found the end of the hlist segment to be reversed; the
+final math node is released and the remaining list attached to the
+edge node terminating the reversed segment.
+
+@<Finish the reversed...@>=
+begin free_node(p,small_node_size);
+link(t):=q; width(t):=rule_wd; edge_dist(t):=-cur_h-rule_wd; goto done;
+end
+
+@ @<Check for LR anomalies at the end of |s...@>=
+begin if LR_problems>0 then
+ begin @<Report LR problems@>; print_char(")"); print_ln;
+ end;
+if (LR_ptr<>null)or(cur_dir<>left_to_right) then confusion("LR3");
+@:this can't happen LR3}{\quad LR3@>
+end
+
+@ Some special actions are required for displayed equation in paragraphs
+with mixed direction texts. First of all we have to set the text
+direction preceding the display.
+
+@<Set the value of |x| to the text direction before the display@>=
+if LR_save=null then x:=0
+else if info(LR_save)>=R_code then x:=-1@+else x:=1
+
+@ @<Prepare for display after an empty...@>=
+begin pop_nest; @<Set the value of |x|...@>;
+end
+
+@ When calculating the natural width, |w|, of the final line preceding
+the display, we may have to copy all or part of its hlist. We copy,
+however, only those parts of the original list that are relevant for the
+computation of |pre_display_size|.
+@^data structure assumptions@>
+
+@<Declare subprocedures for |init_math|@>=
+procedure just_copy(@!p,@!h,@!t:pointer);
+label found,not_found;
+var @!r:pointer; {current node being fabricated for new list}
+@!words:0..5; {number of words remaining to be copied}
+begin while p<>null do
+ begin words:=1; {this setting occurs in more branches than any other}
+ if is_char_node(p) then r:=get_avail
+ else case type(p) of
+ hlist_node,vlist_node: begin r:=get_node(box_node_size);
+ mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
+ words:=5; list_ptr(r):=null; {this affects |mem[r+5]|}
+ end;
+ rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size;
+ end;
+ ligature_node: begin r:=get_avail; {only |font| and |character| are needed}
+ mem[r]:=mem[lig_char(p)]; goto found;
+ end;
+ kern_node,math_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+ glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p));
+ glue_ptr(r):=glue_ptr(p); leader_ptr(r):=null;
+ end;
+ whatsit_node:@<Make a partial copy of the whatsit...@>;
+ othercases goto not_found
+ endcases;
+ while words>0 do
+ begin decr(words); mem[r+words]:=mem[p+words];
+ end;
+ found: link(h):=r; h:=r;
+ not_found: p:=link(p);
+ end;
+link(h):=t;
+end;
+
+@ When the final line ends with R-text, the value |w| refers to the line
+reflected with respect to the left edge of the enclosing vertical list.
+
+@<Prepare for display after a non-empty...@>=
+if eTeX_ex then @<Let |j| be the prototype box for the display@>;
+v:=shift_amount(just_box);
+@<Set the value of |x|...@>;
+if x>=0 then
+ begin p:=list_ptr(just_box); link(temp_head):=null;
+ end
+else begin v:=-v-width(just_box);
+ p:=new_math(0,begin_L_code); link(temp_head):=p;
+ just_copy(list_ptr(just_box),p,new_math(0,end_L_code));
+ cur_dir:=right_to_left;
+ end;
+v:=v+2*quad(cur_font);
+if TeXXeT_en then @<Initialize the LR stack@>
+
+@ @<Finish the natural width computation@>=
+if TeXXeT_en then
+ begin while LR_ptr<>null do pop_LR;
+ if LR_problems<>0 then
+ begin w:=max_dimen; LR_problems:=0;
+ end;
+ end;
+cur_dir:=left_to_right; flush_node_list(link(temp_head))
+
+@ In the presence of text direction directives we assume that any LR
+problems have been fixed by the |hpack| routine. If the final line
+contains, however, text direction directives while \TeXXeT\ is disabled,
+then we set |w:=max_dimen|.
+
+@<Cases of `Let |d| be the natural...@>=
+math_node: begin d:=width(p);
+ if TeXXeT_en then @<Adjust \(t)the LR stack for the |init_math| routine@>
+ else if subtype(p)>=L_code then
+ begin w:=max_dimen; goto done;
+ end;
+ end;
+edge_node: begin d:=width(p); cur_dir:=subtype(p);
+ end;
+
+@ @<Adjust \(t)the LR stack for the |i...@>=
+if end_LR(p) then
+ begin if info(LR_ptr)=end_LR_type(p) then pop_LR
+ else if subtype(p)>L_code then
+ begin w:=max_dimen; goto done;
+ end
+ end
+else begin push_LR(p);
+ if LR_dir(p)<>cur_dir then
+ begin just_reverse(p); p:=temp_head;
+ end;
+ end
+
+@ @<Declare subprocedures for |init_math|@>=
+procedure just_reverse(@!p:pointer);
+label found,done;
+var l:pointer; {the new list}
+@!t:pointer; {tail of reversed segment}
+@!q:pointer; {the next node}
+@!m,@!n:halfword; {count of unmatched math nodes}
+begin m:=min_halfword; n:=min_halfword;
+if link(temp_head)=null then
+ begin just_copy(link(p),temp_head,null); q:=link(temp_head);
+ end
+else begin q:=link(p); link(p):=null; flush_node_list(link(temp_head));
+ end;
+t:=new_edge(cur_dir,0); l:=t; cur_dir:=reflected;
+while q<>null do
+ if is_char_node(q) then
+ repeat p:=q; q:=link(p); link(p):=l; l:=p;
+ until not is_char_node(q)
+ else begin p:=q; q:=link(p);
+ if type(p)=math_node then
+ @<Adjust \(t)the LR stack for the |just_reverse| routine@>;
+ link(p):=l; l:=p;
+ end;
+goto done;
+found:width(t):=width(p); link(t):=q; free_node(p,small_node_size);
+done:link(temp_head):=l;
+end;
+
+@ @<Adjust \(t)the LR stack for the |j...@>=
+if end_LR(p) then
+ if info(LR_ptr)<>end_LR_type(p) then
+ begin type(p):=kern_node; incr(LR_problems);
+ end
+ else begin pop_LR;
+ if n>min_halfword then
+ begin decr(n); decr(subtype(p)); {change |after| into |before|}
+ end
+ else begin if m>min_halfword then decr(m)@+else goto found;
+ type(p):=kern_node;
+ end;
+ end
+else begin push_LR(p);
+ if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
+ begin incr(n); incr(subtype(p)); {change |before| into |after|}
+ end
+ else begin type(p):=kern_node; incr(m);
+ end;
+ end
+
+@ The prototype box is an hlist node with the width, glue set, and shift
+amount of |just_box|, i.e., the last line preceding the display. Its
+hlist reflects the current \.{\\leftskip} and \.{\\rightskip}.
+
+@<Let |j| be the prototype box for the display@>=
+begin if right_skip=zero_glue then j:=new_kern(0)
+else j:=new_param_glue(right_skip_code);
+if left_skip=zero_glue then p:=new_kern(0)
+else p:=new_param_glue(left_skip_code);
+link(p):=j; j:=new_null_box; width(j):=width(just_box);
+shift_amount(j):=shift_amount(just_box); list_ptr(j):=p;
+glue_order(j):=glue_order(just_box); glue_sign(j):=glue_sign(just_box);
+glue_set(j):=glue_set(just_box);
+end
+
+@ At the end of a displayed equation we retrieve the prototype box.
+
+@<Local variables for finishing...@>=
+@!j:pointer; {prototype box}
+
+@ @<Retrieve the prototype box@>=
+if mode=mmode then j:=LR_box
+
+@ @<Flush the prototype box@>=
+flush_node_list(j)
+
+@ The |app_display| procedure used to append the displayed equation
+and\slash or equation number to the current vertical list has three
+parameters: the prototype box, the hbox to be appended, and the
+displacement of the hbox in the display line.
+
+@<Declare subprocedures for |after_math|@>=
+procedure app_display(@!j,@!b:pointer;@!d:scaled);
+var z:scaled; {width of the line}
+@!s:scaled; {move the line right this much}
+@!e:scaled; {distance from right edge of box to end of line}
+@!x:integer; {|pre_display_direction|}
+@!p,@!q,@!r,@!t,@!u:pointer; {for list manipulation}
+begin s:=display_indent; x:=pre_display_direction;
+if x=0 then shift_amount(b):=s+d
+else begin z:=display_width; p:=b;
+ @<Set up the hlist for the display line@>;
+ @<Package the display line@>;
+ end;
+append_to_vlist(b);
+end;
+
+@ Here we construct the hlist for the display, starting with node |p|
+and ending with node |q|. We also set |d| and |e| to the amount of
+kerning to be added before and after the hlist (adjusted for the
+prototype box).
+
+@<Set up the hlist for the display line@>=
+if x>0 then e:=z-d-width(p)
+else begin e:=d; d:=z-e-width(p);
+ end;
+if j<>null then
+ begin b:=copy_node_list(j); height(b):=height(p); depth(b):=depth(p);
+ s:=s-shift_amount(b); d:=d+s; e:=e+width(b)-z-s;
+ end;
+if subtype(p)=dlist then q:=p {display or equation number}
+else begin {display and equation number}
+ r:=list_ptr(p); free_node(p,box_node_size);
+ if r=null then confusion("LR4");
+ if x>0 then
+ begin p:=r;
+ repeat q:=r; r:=link(r); {find tail of list}
+ until r=null;
+ end
+ else begin p:=null; q:=r;
+ repeat t:=link(r); link(r):=p; p:=r; r:=t; {reverse list}
+ until r=null;
+ end;
+ end
+
+@ In the presence of a prototype box we use its shift amount and width
+to adjust the values of kerning and add these values to the glue nodes
+inserted to cancel the \.{\\leftskip} and \.{\\rightskip}. If there is
+no prototype box (because the display is preceded by an empty
+paragraph), or if the skip parameters are zero, we just add kerns.
+
+The |cancel_glue| macro creates and links a glue node that is, together
+with another glue node, equivalent to a given amount of kerning. We can
+use |j| as temporary pointer, since all we need is |j<>null|.
+
+@d cancel_glue(#)==j:=new_skip_param(#); cancel_glue_cont
+@d cancel_glue_cont(#)==link(#):=j; cancel_glue_cont_cont
+@d cancel_glue_cont_cont(#)==link(j):=#; cancel_glue_end
+@d cancel_glue_end(#)==j:=glue_ptr(#); cancel_glue_end_end
+@d cancel_glue_end_end(#)==
+stretch_order(temp_ptr):=stretch_order(j);
+shrink_order(temp_ptr):=shrink_order(j); width(temp_ptr):=#-width(j);
+stretch(temp_ptr):=-stretch(j); shrink(temp_ptr):=-shrink(j)
+
+@<Package the display line@>=
+if j=null then
+ begin r:=new_kern(0); t:=new_kern(0); {the widths will be set later}
+ end
+else begin r:=list_ptr(b); t:=link(r);
+ end;
+u:=new_math(0,end_M_code);
+if type(t)=glue_node then {|t| is \.{\\rightskip} glue}
+ begin cancel_glue(right_skip_code)(q)(u)(t)(e); link(u):=t;
+ end
+else begin width(t):=e; link(t):=u; link(q):=t;
+ end;
+u:=new_math(0,begin_M_code);
+if type(r)=glue_node then {|r| is \.{\\leftskip} glue}
+ begin cancel_glue(left_skip_code)(u)(p)(r)(d); link(r):=u;
+ end
+else begin width(r):=d; link(r):=p; link(u):=r;
+ if j=null then
+ begin b:=hpack(u,natural); shift_amount(b):=s;
+ end
+ else list_ptr(b):=u;
+ end
+
+@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens}
+primitive.
+
+@<Generate all \eTeX...@>=
+primitive("scantokens",input,2);
+@!@:scan_tokens_}{\.{\\scantokens} primitive@>
+
+@ @<Cases of |input| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("scantokens")
+
+@ @<Cases for |input|@>=
+else if cur_chr=2 then pseudo_start
+
+@ The global variable |pseudo_files| is used to maintain a stack of
+pseudo files. The |info| field of each pseudo file points to a linked
+list of variable size nodes representing lines not yet processed: the
+|info| field of the first word contains the size of this node, all the
+following words contain ASCII codes.
+
+@<Glob...@>=
+@!pseudo_files:pointer; {stack of pseudo files}
+
+@ @<Set init...@>=
+pseudo_files:=null;
+
+@ The |pseudo_start| procedure initiates reading from a pseudo file.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?pseudo_start; forward;@t\2@>
+
+@ @<Declare \eTeX\ procedures for tok...@>=
+procedure pseudo_start;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!s:str_number; {string to be converted into a pseudo file}
+@!l,@!m:pool_pointer; {indices into |str_pool|}
+@!p,@!q,@!r:pointer; {for list construction}
+@!w: four_quarters; {four ASCII codes}
+@!nl,@!sz:integer;
+begin scan_general_text;
+old_setting:=selector; selector:=new_string;
+token_show(temp_head); selector:=old_setting;
+flush_list(link(temp_head));
+str_room(1); s:=make_string;
+@<Convert string |s| into a new pseudo file@>;
+flush_string;
+@<Initiate input from new pseudo file@>;
+end;
+
+@ @<Convert string |s| into a new pseudo file@>=
+str_pool[pool_ptr]:=si(" "); l:=str_start[s];
+nl:=si(new_line_char);
+p:=get_avail; q:=p;
+while l<pool_ptr do
+ begin m:=l;
+ while (l<pool_ptr)and(str_pool[l]<>nl) do incr(l);
+ sz:=(l-m+7)div 4;
+ if sz=1 then sz:=2;
+ r:=get_node(sz); link(q):=r; q:=r; info(q):=hi(sz);
+ while sz>2 do
+ begin decr(sz); incr(r);
+ w.b0:=qi(so(str_pool[m])); w.b1:=qi(so(str_pool[m+1]));
+ w.b2:=qi(so(str_pool[m+2])); w.b3:=qi(so(str_pool[m+3]));
+ mem[r].qqqq:=w; m:=m+4;
+ end;
+ w.b0:=qi(" "); w.b1:=qi(" "); w.b2:=qi(" "); w.b3:=qi(" ");
+ if l>m then
+ begin w.b0:=qi(so(str_pool[m]));
+ if l>m+1 then
+ begin w.b1:=qi(so(str_pool[m+1]));
+ if l>m+2 then
+ begin w.b2:=qi(so(str_pool[m+2]));
+ if l>m+3 then w.b3:=qi(so(str_pool[m+3]));
+ end;
+ end;
+ end;
+ mem[r+1].qqqq:=w;
+ if str_pool[l]=nl then incr(l);
+ end;
+info(p):=link(p); link(p):=pseudo_files; pseudo_files:=p
+
+@ @<Initiate input from new pseudo file@>=
+begin_file_reading; {set up |cur_file| and new level of input}
+line:=0; limit:=start; loc:=limit+1; {force line read}
+if tracing_scan_tokens>0 then
+ begin if term_offset>max_print_line-3 then print_ln
+ else if (term_offset>0)or(file_offset>0) then print_char(" ");
+ name:=19; print("( "); incr(open_parens); update_terminal;
+ end
+else name:=18
+
+@ Here we read a line from the current pseudo file into |buffer|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+function pseudo_input: boolean; {inputs the next line or returns |false|}
+var p:pointer; {current line from pseudo file}
+@!sz:integer; {size of node |p|}
+@!w:four_quarters; {four ASCII codes}
+@!r:pointer; {loop index}
+begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+p:=info(pseudo_files);
+if p=null then pseudo_input:=false
+else begin info(pseudo_files):=link(p); sz:=ho(info(p));
+ if 4*sz-3>=buf_size-last then
+ @<Report overflow of the input buffer, and abort@>;
+ last:=first;
+ for r:=p+1 to p+sz-1 do
+ begin w:=mem[r].qqqq;
+ buffer[last]:=w.b0; buffer[last+1]:=w.b1;
+ buffer[last+2]:=w.b2; buffer[last+3]:=w.b3;
+ last:=last+4;
+ end;
+ if last>=max_buf_stack then max_buf_stack:=last+1;
+ while (last>first)and(buffer[last-1]=" ") do decr(last);
+ free_node(p,sz);
+ pseudo_input:=true;
+ end;
+end;
+
+@ When we are done with a pseudo file we `close' it.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure pseudo_close; {close the top level pseudo file}
+var p,@!q: pointer;
+begin p:=link(pseudo_files); q:=info(pseudo_files);
+free_avail(pseudo_files); pseudo_files:=p;
+while q<>null do
+ begin p:=q; q:=link(p); free_node(p,ho(info(p)));
+ end;
+end;
+
+@ @<Dump the \eTeX\ state@>=
+while pseudo_files<>null do pseudo_close; {flush pseudo files}
+
+@ @<Generate all \eTeX...@>=
+primitive("readline",read_to_cs,1);@/
+@!@:read_line_}{\.{\\readline} primitive@>
+
+@ @<Cases of |read| for |print_cmd_chr|@>=
+else print_esc("readline")
+
+@ @<Handle \.{\\readline} and |goto done|@>=
+if j=1 then
+ begin while loc<=limit do {current line not yet finished}
+ begin cur_chr:=buffer[loc]; incr(loc);
+ if cur_chr=" " then cur_tok:=space_token
+ @+else cur_tok:=cur_chr+other_token;
+ store_new_token(cur_tok);
+ end;
+ goto done;
+ end
+
+@ Here we define the additional conditionals of \eTeX\ as well as the
+\.{\\unless} prefix.
+
+@d if_def_code=17 { `\.{\\ifdefined}' }
+@d if_cs_code=18 { `\.{\\ifcsname}' }
+@d if_font_char_code=19 { `\.{\\iffontchar}' }
+
+@<Generate all \eTeX...@>=
+primitive("unless",expand_after,1);@/
+@!@:unless_}{\.{\\unless} primitive@>
+primitive("ifdefined",if_test,if_def_code);
+@!@:if_defined_}{\.{\\ifdefined} primitive@>
+primitive("ifcsname",if_test,if_cs_code);
+@!@:if_cs_name_}{\.{\\ifcsname} primitive@>
+primitive("iffontchar",if_test,if_font_char_code);
+@!@:if_font_char_}{\.{\\iffontchar} primitive@>
+
+@ @<Cases of |expandafter| for |print_cmd_chr|@>=
+else print_esc("unless")
+
+@ @<Cases of |if_test| for |print_cmd_chr|@>=
+if_def_code:print_esc("ifdefined");
+if_cs_code:print_esc("ifcsname");
+if_font_char_code:print_esc("iffontchar");
+
+@ The result of a boolean condition is reversed when the conditional is
+preceded by \.{\\unless}.
+
+@<Negate a boolean conditional and |goto reswitch|@>=
+begin get_token;
+if (cur_cmd=if_test)and(cur_chr<>if_case_code) then
+ begin cur_chr:=cur_chr+unless_code; goto reswitch;
+ end;
+print_err("You can't use `"); print_esc("unless"); print("' before `");
+@.You can't use \\unless...@>
+print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+help1("Continue, and I'll forget that it ever happened.");
+back_error;
+end
+
+@ The conditional \.{\\ifdefined} tests if a control sequence is
+defined.
+
+We need to reset |scanner_status|, since \.{\\outer} control sequences
+are allowed, but we might be scanning a macro definition or preamble.
+
+@<Cases for |conditional|@>=
+if_def_code:begin save_scanner_status:=scanner_status;
+ scanner_status:=normal;
+ get_next; b:=(cur_cmd<>undefined_cs);
+ scanner_status:=save_scanner_status;
+ end;
+
+@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter}
+\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new
+control sequence will be entered into the hash table (once all tokens
+preceding the mandatory \.{\\endcsname} have been expanded).
+
+@<Cases for |conditional|@>=
+if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
+ repeat get_x_token;
+ if cur_cs=0 then store_new_token(cur_tok);
+ until cur_cs<>0;
+ if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
+ @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
+ flush_list(n);
+ b:=(eq_type(cur_cs)<>undefined_cs);
+ end;
+
+@ @<Look up the characters of list |n| in the hash table...@>=
+m:=first; p:=link(n);
+while p<>null do
+ begin if m>=max_buf_stack then
+ begin max_buf_stack:=m+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[m]:=info(p) mod @'400; incr(m); p:=link(p);
+ end;
+if m>first+1 then
+ cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|}
+else if m=first then cur_cs:=null_cs {the list is empty}
+else cur_cs:=single_base+buffer[first] {the list has length one}
+
+@ The conditional \.{\\iffontchar} tests the existence of a character in
+a font.
+
+@<Cases for |conditional|@>=
+if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
+ if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
+ b:=char_exists(char_info(n)(qi(cur_val)))
+ else b:=false;
+ end;
+
+@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
+command for macro definitions. Such macros are protected against
+expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
+or during \.{\\write}.
+
+@<Generate all \eTeX...@>=
+primitive("protected",prefix,8);
+@!@:protected_}{\.{\\protected} primitive@>
+
+@ @<Cases of |prefix| for |print_cmd_chr|@>=
+else if chr_code=8 then print_esc("protected")
+
+@ The |get_x_or_protected| procedure is like |get_x_token| except that
+protected macros are not expanded.
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
+ and expands non-protected macros}
+label exit;
+begin loop@+begin get_token;
+ if cur_cmd<=max_command then return;
+ if (cur_cmd>=call)and(cur_cmd<end_template) then
+ if info(link(cur_chr))=protected_token then return;
+ expand;
+ end;
+exit:end;
+
+@ A group entered (or a conditional started) in one file may end in a
+different file. Such slight anomalies, although perfectly legitimate,
+may cause errors that are difficult to locate. In order to be able to
+give a warning message when such anomalies occur, \eTeX\ uses the
+|grp_stack| and |if_stack| arrays to record the initial |cur_boundary|
+and |cond_ptr| values for each input file.
+
+@<Glob...@>=
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+
+@ When a group ends that was apparently entered in a different input
+file, the |group_warning| procedure is invoked in order to update the
+|grp_stack|. If moreover \.{\\tracingnesting} is positive we want to
+give a warning message. The situation is, however, somewhat complicated
+by two facts: (1)~There may be |grp_stack| elements without a
+corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g.,
+error insertions from the terminal); and (2)~the relevant information is
+recorded in the |name_field| of the |input_stack| only loosely
+synchronized with the |in_open| variable indexing |grp_stack|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure group_warning;
+var i:0..max_in_open; {index into |grp_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ {store current state}
+i:=in_open; w:=false;
+while (grp_stack[i]=cur_boundary)and(i>0) do
+ begin @<Set variable |w| to indicate if this case should be reported@>;
+ grp_stack[i]:=save_index(save_ptr); decr(i);
+ end;
+if w then
+ begin print_nl("Warning: end of "); print_group(true);
+@.Warning: end of...@>
+ print(" of a different file"); print_ln;
+ if tracing_nesting>1 then show_context;
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+
+@ This code scans the input stack in order to determine the type of the
+current input file.
+
+@<Set variable |w| to...@>=
+if tracing_nesting>0 then
+ begin while (input_stack[base_ptr].state_field=token_list)or@|
+ (input_stack[base_ptr].index_field>i) do decr(base_ptr);
+ if input_stack[base_ptr].name_field>17 then w:=true;
+ end
+
+@ When a conditional ends that was apparently started in a different
+input file, the |if_warning| procedure is invoked in order to update the
+|if_stack|. If moreover \.{\\tracingnesting} is positive we want to
+give a warning message (with the same complications as above).
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure if_warning;
+var i:0..max_in_open; {index into |if_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ {store current state}
+i:=in_open; w:=false;
+while if_stack[i]=cond_ptr do
+ begin @<Set variable |w| to...@>;
+ if_stack[i]:=link(cond_ptr); decr(i);
+ end;
+if w then
+ begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if);
+@.Warning: end of...@>
+ print_if_line(if_line); print(" of a different file"); print_ln;
+ if tracing_nesting>1 then show_context;
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+
+@ Conversely, the |file_warning| procedure is invoked when a file ends
+and some groups entered or conditionals started while reading from that
+file are still incomplete.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure file_warning;
+var p:pointer; {saved value of |save_ptr| or |cond_ptr|}
+@!l:quarterword; {saved value of |cur_level| or |if_limit|}
+@!c:quarterword; {saved value of |cur_group| or |cur_if|}
+@!i:integer; {saved value of |if_line|}
+begin p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary;
+while grp_stack[in_open]<>save_ptr do
+ begin decr(cur_level);
+ print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+ print_group(true); print(" is incomplete");@/
+ cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+ end;
+save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values}
+p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line;
+while if_stack[in_open]<>cond_ptr do
+ begin print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+ print_cmd_chr(if_test,cur_if);
+ if if_limit=fi_code then print_esc("else");
+ print_if_line(if_line); print(" is incomplete");@/
+ if_line:=if_line_field(cond_ptr); cur_if:=subtype(cond_ptr);
+ if_limit:=type(cond_ptr); cond_ptr:=link(cond_ptr);
+ end;
+cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values}
+print_ln;
+if tracing_nesting>1 then show_context;
+if history=spotless then history:=warning_issued;
+end;
+
+@ Here are the additional \eTeX\ primitives for expressions.
+
+@<Generate all \eTeX...@>=
+primitive("numexpr",last_item,eTeX_expr-int_val+int_val);
+@!@:num_expr_}{\.{\\numexpr} primitive@>
+primitive("dimexpr",last_item,eTeX_expr-int_val+dimen_val);
+@!@:dim_expr_}{\.{\\dimexpr} primitive@>
+primitive("glueexpr",last_item,eTeX_expr-int_val+glue_val);
+@!@:glue_expr_}{\.{\\glueexpr} primitive@>
+primitive("muexpr",last_item,eTeX_expr-int_val+mu_val);
+@!@:mu_expr_}{\.{\\muexpr} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+eTeX_expr-int_val+int_val: print_esc("numexpr");
+eTeX_expr-int_val+dimen_val: print_esc("dimexpr");
+eTeX_expr-int_val+glue_val: print_esc("glueexpr");
+eTeX_expr-int_val+mu_val: print_esc("muexpr");
+
+@ This code for reducing |cur_val_level| and\slash or negating the
+result is similar to the one for all the other cases of
+|scan_something_internal|, with the difference that |scan_expr| has
+already increased the reference count of a glue specification.
+
+@<Process an expression and |return|@>=
+begin if m<eTeX_mu then
+ begin case m of
+ @/@<Cases for fetching a glue value@>@/
+ end; {there are no other cases}
+ cur_val_level:=glue_val;
+ end
+else if m<eTeX_expr then
+ begin case m of
+ @/@<Cases for fetching a mu value@>@/
+ end; {there are no other cases}
+ cur_val_level:=mu_val;
+ end
+else begin cur_val_level:=m-eTeX_expr+int_val; scan_expr;
+ end;
+while cur_val_level>level do
+ begin if cur_val_level=glue_val then
+ begin m:=cur_val; cur_val:=width(m); delete_glue_ref(m);
+ end
+ else if cur_val_level=mu_val then mu_error;
+ decr(cur_val_level);
+ end;
+if negative then
+ if cur_val_level>=glue_val then
+ begin m:=cur_val; cur_val:=new_spec(m); delete_glue_ref(m);
+ @<Negate all three glue components of |cur_val|@>;
+ end
+ else negate(cur_val);
+return;
+end
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_expr; forward;@t\2@>
+
+@ The |scan_expr| procedure scans and evaluates an expression.
+
+@<Declare procedures needed for expressions@>=
+@t\4@>@<Declare subprocedures for |scan_expr|@>
+procedure scan_expr; {scans and evaluates an expression}
+label restart, continue, found;
+var a,@!b:boolean; {saved values of |arith_error|}
+@!l:small_number; {type of expression}
+@!r:small_number; {state of expression so far}
+@!s:small_number; {state of term so far}
+@!o:small_number; {next operation or type of next factor}
+@!e:integer; {expression so far}
+@!t:integer; {term so far}
+@!f:integer; {current factor}
+@!n:integer; {numerator of combined multiplication and division}
+@!p:pointer; {top of expression stack}
+@!q:pointer; {for stack manipulations}
+begin l:=cur_val_level; a:=arith_error; b:=false; p:=null;
+@<Scan and evaluate an expression |e| of type |l|@>;
+if b then
+ begin print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+ help2("I can't evaluate this expression,")@/
+ ("since the result is out of range.");
+ error;
+ if l>=glue_val then
+ begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e);
+ end
+ else e:=0;
+ end;
+arith_error:=a; cur_val:=e; cur_val_level:=l;
+end;
+
+@ Evaluating an expression is a recursive process: When the left
+parenthesis of a subexpression is scanned we descend to the next level
+of recursion; the previous level is resumed with the matching right
+parenthesis.
+
+@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen}
+@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen}
+@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen}
+@d expr_mult=3 {$\langle\it term\rangle$ \.* seen}
+@d expr_div=4 {$\langle\it term\rangle$ \./ seen}
+@d expr_scale=5 {$\langle\it term\rangle$ \.*
+ $\langle\it factor\rangle$ \./ seen}
+
+@<Scan and eval...@>=
+restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0;
+continue: if s=expr_none then o:=l@+else o:=int_val;
+@<Scan a factor |f| of type |o| or start a subexpression@>;
+found: @<Scan the next operator and set |o|@>;
+arith_error:=b;
+@<Make sure that |f| is in the proper range@>;
+case s of @<Cases for evaluation of the current term@>@;
+end; {there are no other cases}
+if o>expr_sub then s:=o@+else @<Evaluate the current expression@>;
+b:=arith_error;
+if o<>expr_none then goto continue;
+if p<>null then @<Pop the expression stack and |goto found|@>
+
+@ @<Scan the next op...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"+" then o:=expr_add
+else if cur_tok=other_token+"-" then o:=expr_sub
+else if cur_tok=other_token+"*" then o:=expr_mult
+else if cur_tok=other_token+"/" then o:=expr_div
+else begin o:=expr_none;
+ if p=null then
+ begin if cur_cmd<>relax then back_input;
+ end
+ else if cur_tok<>other_token+")" then
+ begin print_err("Missing ) inserted for expression");
+@.Missing ) inserted@>
+ help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't.");
+ back_error;
+ end;
+ end
+
+@ @<Scan a factor...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"(" then
+ @<Push the expression stack and |goto restart|@>;
+back_input;
+if o=int_val then scan_int
+else if o=dimen_val then scan_normal_dimen
+else if o=glue_val then scan_normal_glue
+else scan_mu_glue;
+f:=cur_val
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_normal_glue; forward;@t\2@>@/
+procedure@?scan_mu_glue; forward;@t\2@>
+
+@ Here we declare to trivial procedures in order to avoid mutually
+recursive procedures with parameters.
+
+@<Declare procedures needed for expressions@>=
+procedure scan_normal_glue;
+begin scan_glue(glue_val);
+end;
+@#
+procedure scan_mu_glue;
+begin scan_glue(mu_val);
+end;
+
+@ Parenthesized subexpressions can be inside expressions, and this
+nesting has a stack. Seven local variables represent the top of the
+expression stack: |p| points to pushed-down entries, if any; |l|
+specifies the type of expression currently beeing evaluated; |e| is the
+expression so far and |r| is the state of its evaluation; |t| is the
+term so far and |s| is the state of its evaluation; finally |n| is the
+numerator for a combined multiplication and division, if any.
+
+@d expr_node_size=4 {number of words in stack entry for subexpressions}
+@d expr_e_field(#)==mem[#+1].int {saved expression so far}
+@d expr_t_field(#)==mem[#+2].int {saved term so far}
+@d expr_n_field(#)==mem[#+3].int {saved numerator}
+
+@<Push the expression...@>=
+begin q:=get_node(expr_node_size); link(q):=p; type(q):=l;
+subtype(q):=4*s+r;
+expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n;
+p:=q; l:=o; goto restart;
+end
+
+@ @<Pop the expression...@>=
+begin f:=e; q:=p;
+e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q);
+s:=subtype(q) div 4; r:=subtype(q) mod 4;
+l:=type(q); p:=link(q); free_node(q,expr_node_size);
+goto found;
+end
+
+@ We want to make sure that each term and (intermediate) result is in
+the proper range. Integer values must not exceed |infinity|
+($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen|
+($2^{30}-1$). We avoid the absolute value of an integer, because this
+might fail for the value $-2^{31}$ using 32-bit arithmetic.
+
+@d num_error(#)== {clear a number or dimension and set |arith_error|}
+ begin arith_error:=true; #:=0;
+ end
+@d glue_error(#)== {clear a glue spec and set |arith_error|}
+ begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue);
+ end
+
+@<Make sure that |f|...@>=
+if (l=int_val)or(s>expr_sub) then
+ begin if (f>infinity)or(f<-infinity) then num_error(f);
+ end
+else if l=dimen_val then
+ begin if abs(f)>max_dimen then num_error(f);
+ end
+else begin if (abs(width(f))>max_dimen)or@|
+ (abs(stretch(f))>max_dimen)or@|
+ (abs(shrink(f))>max_dimen) then glue_error(f);
+ end
+
+@ Applying the factor |f| to the partial term |t| (with the operator
+|s|) is delayed until the next operator |o| has been scanned. Here we
+handle the first factor of a partial term. A glue spec has to be copied
+unless the next operator is a right parenthesis; this allows us later on
+to simply modify the glue components.
+
+@d normalize_glue(#)==
+ if stretch(#)=0 then stretch_order(#):=normal;
+ if shrink(#)=0 then shrink_order(#):=normal
+
+@<Cases for evaluation of the current term@>=
+expr_none: if (l>=glue_val)and(o<>expr_none) then
+ begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t);
+ end
+ else t:=f;
+
+@ When a term |t| has been completed it is copied to, added to, or
+subtracted from the expression |e|.
+
+@d expr_add_sub(#)==add_or_sub(#,r=expr_sub)
+@d expr_a(#)==expr_add_sub(#,max_dimen)
+
+@<Evaluate the current expression@>=
+begin s:=expr_none;
+if r=expr_none then e:=t
+else if l=int_val then e:=expr_add_sub(e,t,infinity)
+else if l=dimen_val then e:=expr_a(e,t)
+else @<Compute the sum or difference of two glue specs@>;
+r:=o;
+end
+
+@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum
+(for |negative=false|) or difference (for |negative=true|) of |x| and
+|y|, provided the absolute value of the result does not exceed
+|max_answer|.
+
+@<Declare subprocedures for |scan_expr|@>=
+function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer;
+var a:integer; {the answer}
+begin if negative then negate(y);
+if x>=0 then
+ if y<=max_answer-x then a:=x+y@+else num_error(a)
+else if y>=-max_answer-x then a:=x+y@+else num_error(a);
+add_or_sub:=a;
+end;
+
+@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and
+|shrink_order(e)>normal| implies |shrink(e)<>0|.
+
+@<Compute the sum or diff...@>=
+begin width(e):=expr_a(width(e),width(t));
+if stretch_order(e)=stretch_order(t) then
+ stretch(e):=expr_a(stretch(e),stretch(t))
+else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then
+ begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t);
+ end;
+if shrink_order(e)=shrink_order(t) then
+ shrink(e):=expr_a(shrink(e),shrink(t))
+else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then
+ begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t);
+ end;
+delete_glue_ref(t); normalize_glue(e);
+end
+
+@ If a multiplication is followed by a division, the two operations are
+combined into a `scaling' operation. Otherwise the term |t| is
+multiplied by the factor |f|.
+
+@d expr_m(#)==#:=nx_plus_y(#,f,0)
+
+@<Cases for evaluation of the current term@>=
+expr_mult: if o=expr_div then
+ begin n:=f; o:=expr_scale;
+ end
+ else if l=int_val then t:=mult_integers(t,f)
+ else if l=dimen_val then expr_m(t)
+ else begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t));
+ end;
+
+@ Here we divide the term |t| by the factor |f|.
+
+@d expr_d(#)==#:=quotient(#,f)
+
+@<Cases for evaluation of the current term@>=
+expr_div: if l<glue_val then expr_d(t)
+ else begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t));
+ end;
+
+@ The function |quotient(n,d)| computes the rounded quotient
+$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive.
+
+@<Declare subprocedures for |scan_expr|@>=
+function quotient(@!n,@!d:integer):integer;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+begin if d=0 then num_error(a)
+else begin if d>0 then negative:=false
+ else begin negate(d); negative:=true;
+ end;
+ if n<0 then
+ begin negate(n); negative:=not negative;
+ end;
+ a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!}
+ if d+n>=0 then incr(a);
+ if negative then negate(a);
+ end;
+quotient:=a;
+end;
+
+@ Here the term |t| is multiplied by the quotient $n/f$.
+
+@d expr_s(#)==#:=fract(#,n,f,max_dimen)
+
+@<Cases for evaluation of the current term@>=
+expr_scale: if l=int_val then t:=fract(t,n,f,infinity)
+ else if l=dimen_val then expr_s(t)
+ else begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t));
+ end;
+
+@ Finally, the function |fract(x,n,d,max_answer)| computes the integer
+$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive
+and the result does not exceed |max_answer|. We can't use floating
+point arithmetic since the routine must produce identical results in all
+cases; and it would be too dangerous to multiply by~|n| and then divide
+by~|d|, in separate operations, since overflow might well occur. Hence
+this subroutine simulates double precision arithmetic, somewhat
+analogous to \MF's |make_fraction| and |take_fraction| routines.
+
+@d too_big=88 {go here when the result is too big}
+
+@<Declare subprocedures for |scan_expr|@>=
+function fract(@!x,@!n,@!d,@!max_answer:integer):integer;
+label found, found1, too_big, done;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+@!f:integer; {a proper fraction}
+@!h:integer; {smallest integer such that |2*h>=d|}
+@!r:integer; {intermediate remainder}
+@!t:integer; {temp variable}
+begin if d=0 then goto too_big;
+a:=0;
+if d>0 then negative:=false
+else begin negate(d); negative:=true;
+ end;
+if x<0 then
+ begin negate(x); negative:=not negative;
+ end
+else if x=0 then goto done;
+if n<0 then
+ begin negate(n); negative:=not negative;
+ end;
+t:=n div d;
+if t>max_answer div x then goto too_big;
+a:=t*x; n:=n-t*d;
+if n=0 then goto found;
+t:=x div d;
+if t>(max_answer-a) div n then goto too_big;
+a:=a+t*n; x:=x-t*d;
+if x=0 then goto found;
+if x<n then
+ begin t:=x; x:=n; n:=t;
+ end; {now |0<n<=x<d|}
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@;
+if f>(max_answer-a) then goto too_big;
+a:=a+f;
+found: if negative then negate(a);
+goto done;
+too_big: num_error(a);
+done: fract:=a;
+end;
+
+@ The loop here preserves the following invariant relations
+between |f|, |x|, |n|, and~|r|:
+(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$;
+(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$
+and $n$.
+
+Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|,
+because the latter could overflow.
+
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>=
+f:=0; r:=(d div 2)-d; h:=-r;
+loop@+begin if odd(n) then
+ begin r:=r+x;
+ if r>=0 then
+ begin r:=r-d; incr(f);
+ end;
+ end;
+ n:=n div 2;
+ if n=0 then goto found1;
+ if x<h then x:=x+x
+ else begin t:=x-d; x:=t+x; f:=f+n;
+ if x<n then
+ begin if x=0 then goto found1;
+ t:=x; x:=n; n:=t;
+ end;
+ end;
+ end;
+found1:
+
+@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and
+\.{\\glueshrinkorder} commands return the stretch and shrink components
+and their orders of ``infinity'' of a glue specification.
+
+@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}}
+@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}}
+@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}}
+@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}}
+
+@<Generate all \eTeX...@>=
+primitive("gluestretchorder",last_item,glue_stretch_order_code);
+@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@>
+primitive("glueshrinkorder",last_item,glue_shrink_order_code);
+@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@>
+primitive("gluestretch",last_item,glue_stretch_code);
+@!@:glue_stretch_}{\.{\\gluestretch} primitive@>
+primitive("glueshrink",last_item,glue_shrink_code);
+@!@:glue_shrink_}{\.{\\glueshrink} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+glue_stretch_order_code: print_esc("gluestretchorder");
+glue_shrink_order_code: print_esc("glueshrinkorder");
+glue_stretch_code: print_esc("gluestretch");
+glue_shrink_code: print_esc("glueshrink");
+
+@ @<Cases for fetching an integer value@>=
+glue_stretch_order_code, glue_shrink_order_code:
+ begin scan_normal_glue; q:=cur_val;
+ if m=glue_stretch_order_code then cur_val:=stretch_order(q)
+ else cur_val:=shrink_order(q);
+ delete_glue_ref(q);
+ end;
+
+@ @<Cases for fetching a dimension value@>=
+glue_stretch_code, glue_shrink_code:
+ begin scan_normal_glue; q:=cur_val;
+ if m=glue_stretch_code then cur_val:=stretch(q)
+ else cur_val:=shrink(q);
+ delete_glue_ref(q);
+ end;
+
+@ The \.{\\mutoglue} and \.{\\gluetomu} commands convert ``math'' glue
+into normal glue and vice versa; they allow to manipulate math glue with
+\.{\\gluestretch} etc.
+
+@d mu_to_glue_code=eTeX_glue {code for \.{\\mutoglue}}
+@d glue_to_mu_code=eTeX_mu {code for \.{\\gluetomu}}
+
+@<Generate all \eTeX...@>=
+primitive("mutoglue",last_item,mu_to_glue_code);
+@!@:mu_to_glue_}{\.{\\mutoglue} primitive@>
+primitive("gluetomu",last_item,glue_to_mu_code);
+@!@:glue_to_mu_}{\.{\\gluetomu} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+mu_to_glue_code: print_esc("mutoglue");
+glue_to_mu_code: print_esc("gluetomu");
+
+@ @<Cases for fetching a glue value@>=
+mu_to_glue_code: scan_mu_glue;
+
+@ @<Cases for fetching a mu value@>=
+glue_to_mu_code: scan_normal_glue;
+
+@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
+dimen, skip, muskip, box, and token registers. As in \TeX\ the first
+256 registers of each kind are realized as arrays in the table of
+equivalents; the additional registers are realized as tree structures
+built from variable-size nodes with individual registers existing only
+when needed. Default values are used for nonexistent registers: zero
+for count and dimen values, |zero_glue| for glue (skip and muskip)
+values, void for boxes, and |null| for token lists (and current marks
+discussed below).
+
+Similarly there are 32768 mark classes; the command \.{\\marks}|n|
+creates a mark node for a given mark class |0<=n<=32767| (where
+\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
+the |fire_up| routine) and the |vsplit| routine maintain the current
+values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
+|split_bot_mark| for each mark class. They are accessed as
+\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
+\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
+are realized as |cur_mark| array. The additional current marks are
+again realized as tree structure with individual mark classes existing
+only when needed.
+
+@<Generate all \eTeX...@>=
+primitive("marks",mark,marks_code);
+@!@:marks_}{\.{\\marks} primitive@>
+primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
+@!@:top_marks_}{\.{\\topmarks} primitive@>
+primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
+@!@:first_marks_}{\.{\\firstmarks} primitive@>
+primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
+@!@:bot_marks_}{\.{\\botmarks} primitive@>
+primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
+@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
+primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
+@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
+
+@ The |scan_register_num| procedure scans a register number that must
+not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?scan_register_num; forward;@t\2@>
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>max_reg_num) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2(max_reg_help_line)("I changed this one to zero.");
+ int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Initialize variables for \eTeX\ comp...@>=
+max_reg_num:=255;
+max_reg_help_line:="A register number must be between 0 and 255.";
+
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+
+@ @<Glob...@>=
+@!max_reg_num: halfword; {largest allowed register number}
+@!max_reg_help_line: str_number; {first line of help message}
+
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_val|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@#
+@d index_node_size=9 {size of an index node}
+@d sa_index==type {a four-bit address or a type or both}
+@d sa_used==subtype {count of non-null pointers}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure new_index(@!i:quarterword; @!q:pointer);
+var k:small_number; {loop index}
+begin cur_ptr:=get_node(index_node_size); sa_index(cur_ptr):=i;
+sa_used(cur_ptr):=0; link(cur_ptr):=q;
+for k:=1 to index_node_size-1 do {clear all 16 pointers}
+ mem[cur_ptr+k]:=sa_null;
+end;
+
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then box(cur_val):=#@+else set_sa_box(#)
+@#
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>null then
+ begin sa_ptr(cur_ptr):=#; add_sa_ref(cur_ptr); delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ Here we compute the pointer to the current mark of type |t| and mark
+class |cur_val|.
+
+@<Compute the mark pointer...@>=
+begin find_sa_element(mark_val,cur_val,false);
+if cur_ptr<>null then
+ if odd(t) then cur_ptr:=link(cur_ptr+(t div 2)+1)
+ else cur_ptr:=info(cur_ptr+(t div 2)+1);
+end
+
+@ The current marks for all mark classes are maintained by the |vsplit|
+and |fire_up| routines and are finally destroyed (for \.{INITEX} only)
+@.INITEX@>
+by the |final_cleanup| routine. Apart from updating the current marks
+when mark nodes are encountered, these routines perform certain actions
+on all existing mark classes. The recursive |do_marks| procedure walks
+through the whole tree or a subtree of existing mark class nodes and
+preforms certain actions indicted by its first parameter |a|, the action
+code. The second parameter |l| indicates the level of recursion (at
+most four); the third parameter points to a nonempty tree or subtree.
+The result is |true| if the complete tree or subtree has been deleted.
+
+@d vsplit_init==0 {action code for |vsplit| initialization}
+@d fire_up_init==1 {action code for |fire_up| initialization}
+@d fire_up_done==2 {action code for |fire_up| completion}
+@d destroy_marks==3 {action code for |final_cleanup|}
+@#
+@d sa_top_mark(#)==info(#+1) {\.{\\topmarks}|n|}
+@d sa_first_mark(#)==link(#+1) {\.{\\firstmarks}|n|}
+@d sa_bot_mark(#)==info(#+2) {\.{\\botmarks}|n|}
+@d sa_split_first_mark(#)==link(#+2) {\.{\\splitfirstmarks}|n|}
+@d sa_split_bot_mark(#)==info(#+3) {\.{\\splitbotmarks}|n|}
+
+@<Declare the function called |do_marks|@>=
+function do_marks(@!a,@!l:small_number;@!q:pointer):boolean;
+var i:small_number; {a four bit index}
+begin if l<4 then {|q| is an index node}
+ begin for i:=0 to 15 do
+ begin get_sa_ptr;
+ if cur_ptr<>null then if do_marks(a,l+1,cur_ptr) then delete_sa_ptr;
+ end;
+ if sa_used(q)=0 then
+ begin free_node(q,index_node_size); q:=null;
+ end;
+ end
+else {|q| is the node for a mark class}
+ begin case a of
+ @<Cases for |do_marks|@>@;
+ end; {there are no other cases}
+ if sa_bot_mark(q)=null then if sa_split_bot_mark(q)=null then
+ begin free_node(q,mark_class_node_size); q:=null;
+ end;
+ end;
+do_marks:=(q=null);
+end;
+
+@ At the start of the |vsplit| routine the existing |split_fist_mark|
+and |split_bot_mark| are discarded.
+
+@<Cases for |do_marks|@>=
+vsplit_init: if sa_split_first_mark(q)<>null then
+ begin delete_token_ref(sa_split_first_mark(q)); sa_split_first_mark(q):=null;
+ delete_token_ref(sa_split_bot_mark(q)); sa_split_bot_mark(q):=null;
+ end;
+
+@ We use again the fact that |split_first_mark=null| if and only if
+|split_bot_mark=null|.
+
+@<Update the current marks for |vsplit|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_split_first_mark(cur_ptr)=null then
+ begin sa_split_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end
+else delete_token_ref(sa_split_bot_mark(cur_ptr));
+sa_split_bot_mark(cur_ptr):=mark_ptr(p);
+add_token_ref(mark_ptr(p));
+end
+
+@ At the start of the |fire_up| routine the old |top_mark| and
+|first_mark| are discarded, whereas the old |bot_mark| becomes the new
+|top_mark|. An empty new |top_mark| token list is, however, discarded
+as well in order that mark class nodes can eventually be released. We
+use again the fact that |bot_mark<>null| implies |first_mark<>null|; it
+also knows that |bot_mark=null| implies |top_mark=first_mark=null|.
+
+@<Cases for |do_marks|@>=
+fire_up_init: if sa_bot_mark(q)<>null then
+ begin if sa_top_mark(q)<>null then delete_token_ref(sa_top_mark(q));
+ delete_token_ref(sa_first_mark(q)); sa_first_mark(q):=null;
+ if link(sa_bot_mark(q))=null then {an empty token list}
+ begin delete_token_ref(sa_bot_mark(q)); sa_bot_mark(q):=null;
+ end
+ else add_token_ref(sa_bot_mark(q));
+ sa_top_mark(q):=sa_bot_mark(q);
+ end;
+
+@ @<Cases for |do_marks|@>=
+fire_up_done: if (sa_top_mark(q)<>null)and(sa_first_mark(q)=null) then
+ begin sa_first_mark(q):=sa_top_mark(q); add_token_ref(sa_top_mark(q));
+ end;
+
+@ @<Update the current marks for |fire_up|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_first_mark(cur_ptr)=null then
+ begin sa_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end;
+if sa_bot_mark(cur_ptr)<>null then delete_token_ref(sa_bot_mark(cur_ptr));
+sa_bot_mark(cur_ptr):=mark_ptr(p); add_token_ref(mark_ptr(p));
+end
+
+@ Here we use the fact that the five current mark pointers in a mark
+class node occupy the same locations as the the first five pointers of
+an index node. For systems using a run-time switch to distinguish
+between \.{VIRTEX} and \.{INITEX}, the codewords `$|init|\ldots|tini|$'
+surrounding the following piece of code should be removed.
+@.INITEX@>
+@^system dependencies@>
+
+@<Cases for |do_marks|@>=
+@!init destroy_marks: for i:=top_mark_code to split_bot_mark_code do
+ begin get_sa_ptr;
+ if cur_ptr<>null then
+ begin delete_token_ref(cur_ptr); put_sa_ptr(null);
+ end;
+ end;
+tini
+
+@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
+etc., as well as for references to sparse array elements defined by
+`\.{\\countdef}', etc.
+
+@<Cases of |register| for |print_cmd_chr|@>=
+begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
+ cmd:=sa_type(chr_code)
+else begin cmd:=chr_code-mem_bot; chr_code:=null;
+ end;
+if cmd=int_val then print_esc("count")
+else if cmd=dimen_val then print_esc("dimen")
+else if cmd=glue_val then print_esc("skip")
+else print_esc("muskip");
+if chr_code<>null then print_sa_num(chr_code);
+end
+
+@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
+well as for references to sparse array elements defined by
+`\.{\\toksdef}'.
+
+@<Cases of |toks_register| for |print_cmd_chr|@>=
+begin print_esc("toks");
+if chr_code<>mem_bot then print_sa_num(chr_code);
+end
+
+@ When a shorthand definition for an element of one of the sparse arrays
+is destroyed, we must reduce the reference count.
+
+@<Cases for |eq_destroy|@>=
+toks_register,register:
+ if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
+ delete_sa_ref(equiv_field(w));
+
+@ The task to maintain (change, save, and restore) register values is
+essentially the same when the register is realized as sparse array
+element or entry in |eqtb|. The global variable |sa_chain| is the head
+of a linked list of entries saved at the topmost level |sa_level|; the
+lists for lowel levels are kept in special save stack entries.
+
+@<Glob...@>=
+@!sa_chain: pointer; {chain of saved sparse array entries}
+@!sa_level: quarterword; {group level for |sa_chain|}
+
+@ @<Set init...@>=
+sa_chain:=null; sa_level:=level_zero;
+
+@ The individual saved items are kept in pointer or word nodes similar
+to those used for the array elements: a word node with value zero is,
+however, saved as pointer node with the otherwise impossible |sa_index|
+value |tok_val_limit|.
+
+@d sa_loc==sa_ref {location of saved item}
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+
+@ The procedure |sa_def| assigns a new value to sparse array elements,
+and saves the former value if appropriate. This procedure is used only
+for skip, muskip, box, and token list registers. The counterpart of
+|sa_def| for count and dimen registers is called |sa_w_def|.
+
+@d sa_define(#)==if e then
+ if global then gsa_def(#)@+else sa_def(#)
+ else define
+@#
+@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
+ begin find_sa_element(box_val,cur_val,true);
+ if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
+ end
+@#
+@d sa_word_define(#)==if e then
+ if global then gsa_w_def(#)@+else sa_w_def(#)
+ else word_define(#)
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_def(@!p:pointer;@!e:halfword);
+ {new data for sparse array elements}
+begin add_sa_ref(p);
+if sa_ptr(p)=e then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ sa_destroy(p);
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
+ sa_lev(p):=cur_level; sa_ptr(p):=e;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+@#
+procedure sa_w_def(@!p:pointer;@!w:integer);
+begin add_sa_ref(p);
+if sa_int(p)=w then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)<>cur_level then sa_save(p);
+ sa_lev(p):=cur_level; sa_int(p):=w;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+
+@ The |sa_def| and |sa_w_def| routines take care of local definitions.
+@^global definitions@>
+Global definitions are done in almost the same way, but there is no need
+to save old values, and the new value is associated with |level_one|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+@#
+procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_lev(p):=level_one; sa_int(p):=w;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+
+@ The |sa_restore| procedure restores the sparse array entries pointed
+at by |sa_chain|
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+
+@ When the value of |last_line_fit| is positive, the last line of a
+(partial) paragraph is treated in a special way and we need additional
+fields in the active nodes.
+
+@d active_node_size_extended=5 {number of words in extended active nodes}
+@d active_short(#)==mem[#+3].sc {|shortfall| of this line}
+@d active_glue(#)==mem[#+4].sc {corresponding glue stretch or shrink}
+
+@<Glob...@>=
+@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph}
+@!do_last_line_fit:boolean; {special algorithm for last line of paragraph?}
+@!active_node_size:small_number; {number of words in active nodes}
+@!fill_width:array[0..2] of scaled; {infinite stretch components of
+ |par_fill_skip|}
+@!best_pl_short:array[very_loose_fit..tight_fit] of scaled; {|shortfall|
+ corresponding to |minimal_demerits|}
+@!best_pl_glue:array[very_loose_fit..tight_fit] of scaled; {corresponding
+ glue stretch or shrink}
+
+@ The new algorithm for the last line requires that the stretchability
+|par_fill_skip| is infinite and the stretchability of |left_skip| plus
+|right_skip| is finite.
+
+@<Check for special...@>=
+do_last_line_fit:=false; active_node_size:=active_node_size_normal;
+ {just in case}
+if last_line_fit>0 then
+ begin q:=glue_ptr(last_line_fill);
+ if (stretch(q)>0)and(stretch_order(q)>normal) then
+ if (background[3]=0)and(background[4]=0)and(background[5]=0) then
+ begin do_last_line_fit:=true;
+ active_node_size:=active_node_size_extended;
+ fill_width[0]:=0; fill_width[1]:=0; fill_width[2]:=0;
+ fill_width[stretch_order(q)-1]:=stretch(q);
+ end;
+ end
+
+@ @<Other local variables for |try_break|@>=
+@!g:scaled; {glue stretch or shrink of test line, adjustment for last line}
+
+@ Here we initialize the additional fields of the first active node
+representing the beginning of the paragraph.
+
+@<Initialize additional fields of the first active node@>=
+begin active_short(q):=0; active_glue(q):=0;
+end
+
+@ Here we compute the adjustment |g| and badness |b| for a line from |r|
+to the end of the paragraph. When any of the criteria for adjustment is
+violated we fall through to the normal algorithm.
+
+The last line must be too short, and have infinite stretch entirely due
+to |par_fill_skip|.
+
+@<Perform computations for last line and |goto found|@>=
+begin if (active_short(r)=0)or(active_glue(r)<=0) then goto not_found;
+ {previous line was neither stretched nor shrunk, or was infinitely bad}
+if (cur_active_width[3]<>fill_width[0])or@|
+ (cur_active_width[4]<>fill_width[1])or@|
+ (cur_active_width[5]<>fill_width[2]) then goto not_found;
+ {infinite stretch of this line not entirely due to |par_fill_skip|}
+if active_short(r)>0 then g:=cur_active_width[2]
+else g:=cur_active_width[6];
+if g<=0 then goto not_found; {no finite stretch resp.\ no shrink}
+arith_error:=false; g:=fract(g,active_short(r),active_glue(r),max_dimen);
+if last_line_fit<1000 then g:=fract(g,last_line_fit,1000,max_dimen);
+if arith_error then
+ if active_short(r)>0 then g:=max_dimen@+else g:=-max_dimen;
+if g>0 then
+ @<Set the value of |b| to the badness of the last line for stretching,
+ compute the corresponding |fit_class, and |goto found||@>
+else if g<0 then
+ @<Set the value of |b| to the badness of the last line for shrinking,
+ compute the corresponding |fit_class, and |goto found||@>;
+not_found:end
+
+@ These badness computations are rather similar to those of the standard
+algorithm, with the adjustment amount |g| replacing the |shortfall|.
+
+@<Set the value of |b| to the badness of the last line for str...@>=
+begin if g>shortfall then g:=shortfall;
+if g>7230584 then if cur_active_width[2]<1663497 then
+ begin b:=inf_bad; fit_class:=very_loose_fit; goto found;
+ end;
+b:=badness(g,cur_active_width[2]);
+if b>12 then
+ if b>99 then fit_class:=very_loose_fit
+ else fit_class:=loose_fit
+else fit_class:=decent_fit;
+goto found;
+end
+
+@ @<Set the value of |b| to the badness of the last line for shr...@>=
+begin if -g>cur_active_width[6] then g:=-cur_active_width[6];
+b:=badness(-g,cur_active_width[6]);
+if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
+goto found;
+end
+
+@ Vanishing values of |shortfall| and |g| indicate that the last line is
+not adjusted.
+
+@<Adjust \(t)the additional data for last line@>=
+begin if cur_p=null then shortfall:=0;
+if shortfall>0 then g:=cur_active_width[2]
+else if shortfall<0 then g:=cur_active_width[6]
+else g:=0;
+end
+
+@ For each feasible break we record the shortfall and glue stretch or
+shrink (or adjustment).
+
+@<Store \(a)additional data for this feasible break@>=
+begin best_pl_short[fit_class]:=shortfall; best_pl_glue[fit_class]:=g;
+end
+
+@ Here we save these data in the active node representing a potential
+line break.
+
+@<Store \(a)additional data in the new active node@>=
+begin active_short(q):=best_pl_short[fit_class];
+active_glue(q):=best_pl_glue[fit_class];
+end
+
+@ @<Print additional data in the new active node@>=
+begin print(" s="); print_scaled(active_short(q));
+if cur_p=null then print(" a=")@+else print(" g=");
+print_scaled(active_glue(q));
+end
+
+@ Here we either reset |do_last_line_fit| or adjust the |par_fill_skip|
+glue.
+
+@<Adjust \(t)the final line of the paragraph@>=
+if active_short(best_bet)=0 then do_last_line_fit:=false
+else begin q:=new_spec(glue_ptr(last_line_fill));
+ delete_glue_ref(glue_ptr(last_line_fill));
+ width(q):=width(q)+active_short(best_bet)-active_glue(best_bet);
+ stretch(q):=0; glue_ptr(last_line_fill):=q;
+ end
+
+@ When reading \.{\\patterns} while \.{\\savinghyphcodes} is positive
+the current |lc_code| values are stored together with the hyphenation
+patterns for the current language. They will later be used instead of
+the |lc_code| values for hyphenation purposes.
+
+The |lc_code| values are stored in the linked trie analogous to patterns
+$p_1$ of length~1, with |hyph_root=trie_r[0]| replacing |trie_root| and
+|lc_code(p_1)| replacing the |trie_op| code. This allows to compress
+and pack them together with the patterns with minimal changes to the
+existing code.
+
+@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|}
+
+@<Initialize table entries...@>=
+hyph_root:=0; hyph_start:=0;
+
+@ @<Store hyphenation codes for current language@>=
+begin c:=cur_lang; first_child:=false; p:=0;
+repeat q:=p; p:=trie_r[q];
+until (p=0)or(c<=so(trie_c[p]));
+if (p=0)or(c<so(trie_c[p])) then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>;
+q:=p; {now node |q| represents |cur_lang|}
+@<Store all current |lc_code| values@>;
+end
+
+@ We store all nonzero |lc_code| values, overwriting any previously
+stored values (and possibly wasting a few trie nodes that were used
+previously and are not needed now). We always store at least one
+|lc_code| value such that |hyph_index| (defined below) will not be zero.
+
+@<Store all current |lc_code| values@>=
+p:=trie_l[q]; first_child:=true;
+for c:=0 to 255 do
+ if (lc_code(c)>0)or((c=255)and first_child) then
+ begin if p=0 then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>
+ else trie_c[p]:=si(c);
+ trie_o[p]:=qi(lc_code(c));
+ q:=p; p:=trie_r[q]; first_child:=false;
+ end;
+if first_child then trie_l[q]:=0@+else trie_r[q]:=0
+
+@ We must avoid to ``take'' location~1, in order to distinguish between
+|lc_code| values and patterns.
+
+@<Pack all stored |hyph_codes|@>=
+begin if trie_root=0 then for p:=0 to 255 do trie_min[p]:=p+2;
+first_fit(hyph_root); trie_pack(hyph_root);
+hyph_start:=trie_ref[hyph_root];
+end
+
+@ The global variable |hyph_index| will point to the hyphenation codes
+for the current language.
+
+@d set_hyph_index== {set |hyph_index| for current language}
+ if trie_char(hyph_start+cur_lang)<>qi(cur_lang)
+ then hyph_index:=0 {no hyphenation codes for |cur_lang|}
+ else hyph_index:=trie_link(hyph_start+cur_lang)
+@#
+@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
+ if hyph_index=0 then hc[0]:=lc_code(#)
+ else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0
+ else hc[0]:=qo(trie_op(hyph_index+#))
+
+@<Glob...@>=
+@!hyph_start:trie_pointer; {root of the packed trie for |hyph_codes|}
+@!hyph_index:trie_pointer; {pointer to hyphenation codes for |cur_lang|}
+
+@ When |saving_vdiscards| is positive then the glue, kern, and penalty
+nodes removed by the page builder or by \.{\\vsplit} from the top of a
+vertical list are saved in special lists instead of being discarded.
+
+@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder}
+@d page_disc==disc_ptr[last_box_code] {first item removed by page builder}
+@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}}
+
+@<Glob...@>=
+@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers}
+
+@ @<Set init...@>=
+page_disc:=null; split_disc:=null;
+
+@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
+command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
+distinguished by their |chr_code| values |last_box_code| and
+|vsplit_code|. These |chr_code| values are larger than |box_code| and
+|copy_code|.
+
+@<Generate all \eTeX...@>=
+primitive("pagediscards",un_vbox,last_box_code);@/
+@!@:page_discards_}{\.{\\pagediscards} primitive@>
+primitive("splitdiscards",un_vbox,vsplit_code);@/
+@!@:split_discards_}{\.{\\splitdiscards} primitive@>
+
+@ @<Cases of |un_vbox| for |print_cmd_chr|@>=
+else if chr_code=last_box_code then print_esc("pagediscards")
+else if chr_code=vsplit_code then print_esc("splitdiscards")
+
+@ @<Handle saved items and |goto done|@>=
+begin link(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null;
+goto done;
+end
+
+@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
+and \.{\\displaywidowpenalties} commands allow to define arrays of
+penalty values to be used instead of the corresponding single values.
+
+@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc)
+@d club_penalties_ptr==equiv(club_penalties_loc)
+@d widow_penalties_ptr==equiv(widow_penalties_loc)
+@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc)
+
+@<Generate all \eTeX...@>=
+primitive("interlinepenalties",set_shape,inter_line_penalties_loc);@/
+@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@>
+primitive("clubpenalties",set_shape,club_penalties_loc);@/
+@!@:club_penalties_}{\.{\\clubpenalties} primitive@>
+primitive("widowpenalties",set_shape,widow_penalties_loc);@/
+@!@:widow_penalties_}{\.{\\widowpenalties} primitive@>
+primitive("displaywidowpenalties",set_shape,display_widow_penalties_loc);@/
+@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@>
+
+@ @<Cases of |set_shape| for |print_cmd_chr|@>=
+inter_line_penalties_loc: print_esc("interlinepenalties");
+club_penalties_loc: print_esc("clubpenalties");
+widow_penalties_loc: print_esc("widowpenalties");
+display_widow_penalties_loc: print_esc("displaywidowpenalties");
+
+@ @<Fetch a penalties array element@>=
+begin scan_int;
+if (equiv(m)=null)or(cur_val<0) then cur_val:=0
+else begin if cur_val>penalty(equiv(m)) then cur_val:=penalty(equiv(m));
+ cur_val:=penalty(equiv(m)+cur_val);
+ end;
+end
+
+@* \[54] System-dependent changes.
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/etexdir/etex.fix b/Build/source/texk/web2c/etexdir/etex.fix
new file mode 100644
index 00000000000..0dff442eb83
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etex.fix
@@ -0,0 +1,2 @@
+% Late-breaking fixes for e-TeX.
+% Public domain.
diff --git a/Build/source/texk/web2c/etexdir/etex.mak b/Build/source/texk/web2c/etexdir/etex.mak
new file mode 100644
index 00000000000..4f3cea32f41
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etex.mak
@@ -0,0 +1,242 @@
+################################################################################
+#
+# Makefile : eTeX, web2c win32.mak makefile fragment to build e-TeX
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/03/20 16:41:06 popineau>
+#
+################################################################################
+
+etexver =
+
+# We build etex.
+etex = $(objdir)\etex.exe
+!ifdef TEX_DLL
+etex = $(etex) $(objdir)\$(library_prefix)etex.dll
+!endif
+
+# The C sources.
+etex_c = etex.c
+etex_o = $(objdir)\etex.obj
+
+!ifdef TEX_DLL
+$(objdir)\$(library_prefix)etex.exp: $(objdir)\$(library_prefix)etex.lib
+
+$(objdir)\$(library_prefix)etex.lib: $(etex_o)
+ $(archive) /DEF $(etex_o)
+
+$(objdir)\$(library_prefix)etex.dll: $(etex_o) $(objdir)\$(library_prefix)etex.exp $(objdir)\etex.res $(kpathsealib) $(proglib)
+ $(link_dll) $(**) $(socketlibs) $(conlibs)
+
+$(objdir)\etex.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)etex.lib $(proglib)
+ $(link) $(**) $(conlibs)
+!else
+$(objdir)\etex.exe: $(etex_o) $(objdir)\win32main.obj $(objdir)\etex.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+!endif
+
+# C file dependencies
+$(etex_c) etexcoerce.h etexd.h: etex.p $(web2c_texmf)
+ $(web2c) etex
+
+# Tangling
+etex.p etex.pool: etex.web etex.ch
+ .\$(objdir)\tangle etex.web etex.ch
+
+# Generation of the web and ch file.
+etex.web: $(objdir)\tie.exe tex.web etexdir/etex.ch0 etexdir/etex.ch etexdir/etex.fix etexdir/etex.ch1
+ .\$(objdir)\tie -m etex.web \
+ tex.web \
+ etexdir/etex.ch0 \
+ etexdir/etex.ch \
+ etexdir/etex.fix \
+ etexdir/etex.ch1
+
+etex.ch: $(objdir)\tie.exe etex.web etexdir/tex.ch0 tex.ch tex-supp-w32.ch etexdir/tex.ch1 etexdir/tex.ech etexdir/tex.ch2
+ .\$(objdir)\tie -c etex.ch etex.web \
+ etexdir/tex.ch0 \
+ tex.ch \
+ tex-supp-w32.ch \
+ etexdir/tex.ch1 \
+ etexdir/tex.ech \
+ etexdir/tex.ch2
+
+# Tests...
+check: etex-check
+etex-check: etrip etex.efmt
+# Test truncation (but don't bother showing the warning msg).
+ .\$(objdir)\etex --progname=etex --output-comment="$(outcom)" \
+ $(srcdir)/tests/hello \
+ && .\$(objdir)\dvitype hello.dvi | grep olaf@infovore.xs4all.nl >nul
+# \openout should show up in \write's.
+ .\$(objdir)\etex --progname=etex $(srcdir)/tests/openout && grep xfoo openout.log
+# one.two.tex -> one.two.log
+ .\$(objdir)\etex --progname=etex $(srcdir)/tests/one.two && dir /w one.two.log
+# uno.dos -> uno.log
+ .\$(objdir)\etex --progname=etex $(srcdir)/tests/uno.dos && dir /w uno.log
+ .\$(objdir)\etex --progname=etex $(srcdir)/tests/just.texi && dir /w just.log
+ -.\$(objdir)\etex --progname=etex $(srcdir)/tests/batch.tex
+ .\$(objdir)\etex --progname=etex --shell $(srcdir)/tests/write18 | grep echo
+# tcx files are a bad idea.
+# .\$(objdir)\etex --translate-file=$(srcdir)/share/isol1-t1.tcx \
+# $(srcdir)/tests/eight && ./dvitype eight.dvi >eigh.typ
+ .\$(objdir)\etex --mltex --progname=einitex $(srcdir)/tests/mltextst
+ -.\$(objdir)\etex --progname=etex <nul
+# -PATH=$(kpathsea_dir):$$PATH .\$(objdir)\etex '\nonstopmode\font\foo=nonesuch\end'
+ set PATH=$(kpathsea_dir);$(kpathsea_srcdir);$(PATH)
+ set WEB2C=$(kpathsea_srcdir)
+ set TMPDIR=..
+ -.\$(objdir)\etex --progname=etex "\nonstopmode\font\foo=nonesuch\end"
+
+
+# Cleaning up.
+clean:: etex-clean
+etex-clean: etrip-clean
+# $(LIBTOOL) --mode=clean $(RM) etex
+ -@echo $(verbose) & ( \
+ for %%i in ($(etex_o) $(etex_c) etexextra.c etexcoerce.h etexd.h \
+ etex.p etex.pool etex.web etex.ch \
+ etex.efmt etex.log \
+ hello.dvi hello.log xfoo.out openout.log one.two.log uno.log \
+ just.log batch.log write18.log mltextst.log texput.log \
+ missfont.log) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(deldir) tfm $(redir_stderr)
+
+#etrip
+etestdir = $(srcdir)\etexdir\etrip
+
+etrip: $(objdir)\pltotf.exe $(objdir)\tftopl.exe $(objdir)\etex.exe $(objdir)\dvitype.exe etrip-clean
+ @echo ">>> See $(etestdir)\etrip.diffs for example of acceptable diffs."
+ @echo "*** TRIP test for e-TeX in compatibility mode ***."
+ .\$(objdir)\pltotf $(testdir)\trip.pl trip.tfm
+ .\$(objdir)\tftopl .\trip.tfm trip.pl
+ -$(diff) $(testdir)\trip.pl trip.pl
+ -$(del) \f trip.tex & $(copy) $(testdir)\trip.tex . # get same filename in log
+# FIXME: this works only written on 2 lines !!!
+ set TEXMFCNFOLD=$(TEXMFCNF)
+ set TEXMFCNF=$(etestdir)
+ -.\$(objdir)\etex --progname=einitex <$(testdir)\trip1.in >ctripin.fot
+ $(copy) trip.log ctripin.log & $(del) trip.log
+ -$(diff) $(testdir)\tripin.log ctripin.log
+ -.\$(objdir)\etex <$(testdir)\trip2.in >ctrip.fot
+ $(copy) trip.log ctrip.log & $(del) trip.log
+ -$(diff) $(testdir)\trip.fot ctrip.fot
+ -$(diff) $(diffflags) $(testdir)\trip.log ctrip.log
+ .\$(objdir)\dvitype $(dvitype_args) trip.dvi >ctrip.typ
+ -$(diff) $(diffflags) $(testdir)\trip.typ ctrip.typ
+ @echo "*** TRIP test for e-TeX in extended mode ***."
+ -.\$(objdir)\etex -progname=einitex <$(etestdir)\etrip1.in >xtripin.fot
+ $(copy) trip.log xtripin.log & $(del) trip.log
+ -$(diff) ctripin.log xtripin.log
+ -.\$(objdir)\etex <$(etestdir)\trip2.in >xtrip.fot
+ $(copy) trip.log xtrip.log & $(del) trip.log
+ -$(diff) ctrip.fot xtrip.fot
+ -$(diff) $(diffflags) ctrip.log xtrip.log
+ .\$(objdir)\dvitype $(dvitype_args) trip.dvi >xtrip.typ
+ -$(diff) $(diffflags) ctrip.typ xtrip.typ
+ @echo "*** e-TeX specific part of e-TRIP test ***."
+ .\$(objdir)\pltotf $(etestdir)\etrip.pl etrip.tfm
+ .\$(objdir)\tftopl .\etrip.tfm etrip.pl
+ -$(diff) $(etestdir)\etrip.pl etrip.pl
+# get same filename in log
+ -$(del) \f etrip.tex & $(copy) $(etestdir:/=\)\etrip.tex .
+ -.\$(objdir)\etex --progname=einitex <$(etestdir)\etrip2.in >etripin.fot
+ $(copy) etrip.log etripin.log & $(del) etrip.log
+ -$(diff) $(etestdir)\etripin.log etripin.log
+ -.\$(objdir)\etex <$(etestdir)\etrip3.in >etrip.fot
+ -$(diff) $(etestdir)\etrip.fot etrip.fot
+ -$(diff) $(diffflags) $(etestdir)\etrip.log etrip.log
+ set TEXMFCNF=$(TEXMFCNFOLD)
+
+# Cleaning up for the etrip.
+etrip-clean:
+ -@echo $(verbose) & ( \
+ for %%i in (trip.tfm trip.pl trip.tex trip.efmt ctripin.fot ctripin.log \
+ ctrip.fot ctrip.log trip.dvi ctrip.typ \
+ xtripin.fot xtripin.log \
+ xtrip.fot xtrip.log xtrip.typ \
+ etrip.tfm etrip.pl etrip.tex etrip.efmt etripin.fot etripin.log \
+ etrip.fot etrip.log etrip.dvi etrip.out etrip.typ \
+ tripos.tex 8terminal.tex) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(deldir) tfm $(redir_stderr)
+
+# Distfiles ...
+# triptrapdiffs: etexdir\etrip\etrip.diffs
+# etexdir\etrip\etrip.diffs: etex
+# $(make) etrip | tail +1 >etexdir\etrip\etrip.diffs
+
+# Dumps
+# all_efmts = etex.efmt $(efmts)
+#
+# dumps: efmts
+# efmts: $(all_efmts)
+#
+# etex.efmt: $(etex)
+# $(dumpenv) $(make) progname=etex files="etex.src plain.tex cmr10.tfm" prereq-check
+# $(dumpenv) .\$(objdir)\etex --progname=etex --jobname=etex --ini "*\input etex.src \dump" < nul
+#
+# elatex.efmt: $(etex)
+# $(dumpenv) $(make) progname=elatex files="latex.ltx" prereq-check
+# $(dumpenv) .\$(objdir)\etex --progname=elatex --jobname=elatex --ini "*\input latex.ltx" < nul
+#
+# latex.efmt: $(etex)
+# $(dumpenv) $(make) progname=latex files="latex.ltx" prereq-check
+# $(dumpenv) .\$(objdir)\etex --progname=latex --jobname=latex --ini "*\input latex.ltx" < nul
+#
+# tex.efmt: $(etex)
+# $(dumpenv) $(make) progname=tex files="plain.tex cmr10.tfm" prereq-check
+# $(dumpenv) .\$(objdir)\etex --progname=tex --jobname=tex --ini "\input plain \dump" < nul
+#
+# olatex.efmt: $(etex)
+# $(dumpenv) $(make) progname=olatex files="latex.ltx" prereq-check
+# $(dumpenv) .\$(objdir)\etex --progname=olatex --progname=olatex --ini "\input latex.ltx" < nul
+
+# Install
+install-etex: install-etex-exec install-etex-data
+install-etex-exec: install-etex-links
+# install-etex-data: install-etex-dumps
+install-etex-dumps: install-etex-fmts
+
+install-programs: install-etex-programs
+install-etex-programs: $(etex) $(bindir)
+ -@echo $(verbose) & ( \
+ for %%p in ($(etex)) do $(copy) %%p $(bindir) \
+ ) $(redir_stdout)
+
+# install-links: install-etex-links
+install-etex-links: install-etex-programs
+# -@echo $(verbose) & ( \
+# pushd $(bindir) & \
+# $(del) .\einitex.exe .\evirtex.exe & \
+# $(lnexe) .\etex.exe $(bindir)\einitex.exe & \
+# $(lnexe) .\etex.exe $(bindir)\evirtex.exe & \
+# popd \
+# ) $(redir_stdout)
+ -@echo $(verbose) & ( \
+ if NOT "$(efmts)"=="" \
+ for %%i in ($(efmts)) do \
+ pushd $(bindir) & \
+ $(del) .\%%~ni.exe & \
+ $(lnexe) .\etex.exe $(bindir)\%%~ni.exe & \
+ popd \
+ ) $(redir_stdout)
+
+# install-fmts: install-etex-fmts
+install-etex-fmts: efmts $(fmtdir)
+ -@echo $(verbose) & ( \
+ for %%f in ($(all_efmts)) \
+ do $(copy) %%f $(fmtdir)\%%f \
+ ) $(redir_stdout)
+
+install-data:: install-etex-data
+install-etex-data: $(texpooldir)
+ @$(copy) etex.pool $(texpooldir)\etex.pool $(redir_stdout)
+
+# End of etex.mk.
+#
+# Local variables:
+# page-delimiter: " "
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/etexdir/etex.mk b/Build/source/texk/web2c/etexdir/etex.mk
new file mode 100644
index 00000000000..592094f7ff8
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etex.mk
@@ -0,0 +1,213 @@
+# Makefile fragment for e-TeX and web2c. --infovore@xs4all.nl. Public domain.
+# This fragment contains the parts of the makefile that are most likely to
+# differ between releases of e-TeX.
+
+Makefile: etexdir/etex.mk
+
+# We build etex.
+etex = @ETEX@ etex
+
+# Extract etex version
+etexdir/etex.version: etexdir/etex.ch
+ grep '^@d eTeX_version_string==' $(srcdir)/etexdir/etex.ch \
+ | sed "s/^.*'-//;s/'.*$$//" >etexdir/etex.version
+
+# The C sources.
+etex_c = etexini.c etex0.c etex1.c etex2.c
+etex_o = etexini.o etex0.o etex1.o etex2.o etexextra.o
+
+# Making etex.
+etex: $(etex_o)
+ $(kpathsea_link) $(etex_o) $(socketlibs) $(LOADLIBES)
+
+# C file dependencies
+$(etex_c) etexcoerce.h etexd.h: etex.p $(web2c_texmf)
+ $(web2c) etex
+etexextra.c: etexdir/etexextra.h lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/etex/ $(srcdir)/lib/texmfmp.c >$@
+etexdir/etexextra.h: etexdir/etexextra.in etexdir/etex.version
+ test -d etexdir || mkdir etexdir
+ sed s/ETEX-VERSION/`cat etexdir/etex.version`/ \
+ $(srcdir)/etexdir/etexextra.in >$@
+
+# Tangling
+etex.p etex.pool: tangle etex.web etex.ch
+ $(TANGLE) etex.web etex.ch
+
+# Generation of the web and ch file.
+# Sources for etex.web:
+etex_web_srcs = $(srcdir)/tex.web \
+ $(srcdir)/etexdir/etex.ch \
+ $(srcdir)/etexdir/etex.fix
+# Sources for etex.ch:
+etex_ch_srcs = etex.web \
+ $(srcdir)/etexdir/tex.ch0 \
+ $(srcdir)/tex.ch \
+ $(srcdir)/etexdir/tex.ch1 \
+ $(srcdir)/etexdir/tex.ech
+# Rules:
+etex.web: tie etexdir/etex.mk $(etex_web_srcs)
+ $(TIE) -m etex.web $(etex_web_srcs)
+etex.ch: $(etex_ch_srcs)
+ $(TIE) -c etex.ch $(etex_ch_srcs)
+
+# Tests...
+check: @ETEX@ etex-check
+etex-check: etrip etex.fmt
+# Test truncation (but don't bother showing the warning msg).
+ ./etex --progname=etex --output-comment="`cat $(srcdir)/PROJECTS`" \
+ $(srcdir)/tests/hello 2>/dev/null \
+ && ./dvitype hello.dvi | grep olaf@infovore.xs4all.nl >/dev/null
+# \openout should show up in \write's.
+ ./etex --progname=etex $(srcdir)/tests/openout && grep xfoo openout.log
+# one.two.tex -> one.two.log
+ ./etex --progname=etex $(srcdir)/tests/one.two && ls -l one.two.log
+# uno.dos -> uno.log
+ ./etex --progname=etex $(srcdir)/tests/uno.dos && ls -l uno.log
+ ./etex --progname=etex $(srcdir)/tests/just.texi && ls -l just.log
+ -./etex --progname=etex $(srcdir)/tests/batch.tex
+ ./etex --progname=etex --shell $(srcdir)/tests/write18 | grep echo
+# tcx files are a bad idea.
+# ./etex --translate-file=$(srcdir)/share/isol1-t1.tcx \
+# $(srcdir)/tests/eight && ./dvitype eight.dvi >eigh.typ
+ TEXMFCNF=../kpathsea \
+ ./etex --mltex --progname=einitex $(srcdir)/tests/mltextst
+ -./etex --progname=etex </dev/null
+ -PATH=`pwd`:$(kpathsea_dir):$(kpathsea_srcdir):$$PATH \
+ WEB2C=$(kpathsea_srcdir) TMPDIR=.. \
+ ./etex --progname=etex '\nonstopmode\font\foo=nonesuch\end'
+
+# Cleaning up.
+clean:: etex-clean
+etex-clean: etrip-clean
+ $(LIBTOOL) --mode=clean $(RM) etex
+ rm -f $(etex_o) $(etex_c) etexextra.c etexcoerce.h etexd.h
+ rm -f etexdir/etexextra.h etexdir/etex.version
+ rm -f etex.p etex.pool etex.web etex.ch
+ rm -f etex.fmt etex.log
+ rm -f hello.dvi hello.log xfoo.out openout.log one.two.log uno.log
+ rm -f just.log batch.log write18.log mltextst.log texput.log
+ rm -f missfont.log
+ rm -rf tfm
+
+# etrip
+etestdir = $(srcdir)/etexdir/etrip
+etestenv = TEXMFCNF=$(etestdir)
+
+triptrap: @ETEX@ etrip
+etrip: pltotf tftopl etex dvitype etrip-clean
+ @echo ">>> See $(etestdir)/etrip.diffs for example of acceptable diffs." >&2
+ @echo "*** TRIP test for e-TeX in compatibility mode ***."
+ ./pltotf $(testdir)/trip.pl trip.tfm
+ ./tftopl ./trip.tfm trip.pl
+ -diff $(testdir)/trip.pl trip.pl
+ $(LN) $(testdir)/trip.tex . # get same filename in log
+ -$(SHELL) -c '$(etestenv) ./etex --progname=einitex --ini <$(testdir)/trip1.in >ctripin.fot'
+ mv trip.log ctripin.log
+ -diff $(testdir)/tripin.log ctripin.log
+ -$(SHELL) -c '$(etestenv) ./etex --progname=etex <$(testdir)/trip2.in >ctrip.fot'
+ mv trip.log ctrip.log
+ -diff $(testdir)/trip.fot ctrip.fot
+ -$(DIFF) $(DIFFFLAGS) $(testdir)/trip.log ctrip.log
+ $(SHELL) -c '$(etestenv) ./dvitype $(dvitype_args) trip.dvi >ctrip.typ'
+ -$(DIFF) $(DIFFFLAGS) $(testdir)/trip.typ ctrip.typ
+ @echo "*** TRIP test for e-TeX in extended mode ***."
+ -$(SHELL) -c '$(etestenv) ./etex --progname=einitex --ini <$(etestdir)/etrip1.in >xtripin.fot'
+ mv trip.log xtripin.log
+ -diff ctripin.log xtripin.log
+ -$(SHELL) -c '$(etestenv) ./etex --progname=etex <$(etestdir)/trip2.in >xtrip.fot'
+ mv trip.log xtrip.log
+ -diff ctrip.fot xtrip.fot
+ -$(DIFF) $(DIFFFLAGS) ctrip.log xtrip.log
+ $(SHELL) -c '$(etestenv) ./dvitype $(dvitype_args) trip.dvi >xtrip.typ'
+ -$(DIFF) $(DIFFFLAGS) ctrip.typ xtrip.typ
+ @echo "*** e-TeX specific part of e-TRIP test ***."
+ ./pltotf $(etestdir)/etrip.pl etrip.tfm
+ ./tftopl ./etrip.tfm etrip.pl
+ -diff $(etestdir)/etrip.pl etrip.pl
+ $(LN) $(etestdir)/etrip.tex . # get same filename in log
+ -$(SHELL) -c '$(etestenv) ./etex --progname=einitex --ini <$(etestdir)/etrip2.in >etripin.fot'
+ mv etrip.log etripin.log
+ -diff $(etestdir)/etripin.log etripin.log
+ -$(SHELL) -c '$(etestenv) ./etex --progname=etex <$(etestdir)/etrip3.in >etrip.fot'
+ -diff $(etestdir)/etrip.fot etrip.fot
+ -$(DIFF) $(DIFFFLAGS) $(etestdir)/etrip.log etrip.log
+ diff $(etestdir)/etrip.out etrip.out
+ $(SHELL) -c '$(etestenv) ./dvitype $(dvitype_args) etrip.dvi >etrip.typ'
+ -$(DIFF) $(DIFFFLAGS) $(etestdir)/etrip.typ etrip.typ
+
+# Cleaning up for the etrip.
+etrip-clean:
+ rm -f trip.tfm trip.pl trip.tex trip.fmt ctripin.fot ctripin.log
+ rm -f ctrip.fot ctrip.log trip.dvi ctrip.typ
+ rm -f xtripin.fot xtripin.log
+ rm -f xtrip.fot xtrip.log xtrip.typ
+ rm -f etrip.tfm etrip.pl etrip.tex etrip.fmt etripin.fot etripin.log
+ rm -f etrip.fot etrip.log etrip.dvi etrip.out etrip.typ
+ rm -f tripos.tex 8terminal.tex
+ rm -rf tfm
+
+# Distfiles ...
+@MAINT@triptrapdiffs: etexdir/etrip/etrip.diffs
+@MAINT@etexdir/etrip/etrip.diffs: etex
+@MAINT@ $(MAKE) etrip | tail +1 >etexdir/etrip/etrip.diffs
+
+
+# Dumps
+all_efmts = etex.fmt $(efmts)
+
+dumps: @ETEX@ efmts
+efmts: $(all_efmts)
+
+efmtdir = $(web2cdir)/etex
+$(efmtdir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(efmtdir)
+
+etex.fmt: etex
+ $(dumpenv) $(MAKE) progname=etex files="etex.src plain.tex cmr10.tfm" prereq-check
+ $(dumpenv) ./etex --progname=etex --jobname=etex --ini \*\\input etex.src \\dump </dev/null
+
+elatex.fmt: etex
+ $(dumpenv) $(MAKE) progname=elatex files="latex.ltx" prereq-check
+ $(dumpenv) ./etex --progname=elatex --jobname=elatex --ini \*\\input latex.ltx </dev/null
+
+latex.fmt: etex
+ $(dumpenv) $(MAKE) progname=latex files="latex.ltx" prereq-check
+ $(dumpenv) ./etex --progname=latex --jobname=latex --ini \*\\input latex.ltx </dev/null
+
+#ctex.fmt: etex
+# $(dumpenv) $(MAKE) progname=ctex files="plain.tex cmr10.tfm" prereq-check
+# $(dumpenv) ./etex --progname=ctex --jobname=ctex --ini \\input plain \\dump </dev/null
+
+#olatex.fmt: etex
+# $(dumpenv) $(MAKE) progname=olatex files="latex.ltx" prereq-check
+# $(dumpenv) ./etex --progname=olatex --progname=olatex --ini \\input latex.ltx </dev/null
+
+# Install
+install-etex: install-etex-exec install-etex-data
+install-etex-exec: install-etex-programs install-etex-links
+install-etex-data: install-etex-pool @FMU@ install-etex-dumps
+install-etex-dumps: install-etex-fmts
+
+install-programs: @ETEX@ install-etex-programs
+install-etex-programs: etex $(bindir)
+ for p in etex; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+
+install-links: @ETEX@ install-etex-links
+install-etex-links: install-etex-programs
+ #cd $(bindir) && (rm -f einitex evirtex; \
+ # $(LN) etex einitex; $(LN) etex evirtex)
+
+install-fmts: @ETEX@ install-etex-fmts
+install-etex-fmts: efmts $(efmtdir)
+ efmts="$(all_efmts)"; \
+ for f in $$efmts; do $(INSTALL_DATA) $$f $(efmtdir)/$$f; done
+ efmts="$(efmts)"; \
+ for f in $$efmts; do base=`basename $$f .fmt`; \
+ (cd $(bindir) && (rm -f $$base; $(LN) etex $$base)); done
+
+install-data:: @ETEX@ install-etex-data
+install-etex-pool: etex.pool $(texpooldir)
+ $(INSTALL_DATA) etex.pool $(texpooldir)/etex.pool
+
+# end of etex.mk
diff --git a/Build/source/texk/web2c/etexdir/etex_gen.tex b/Build/source/texk/web2c/etexdir/etex_gen.tex
new file mode 100644
index 00000000000..c9dd037c4e2
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etex_gen.tex
@@ -0,0 +1,286 @@
+% etex_gen.tex --- How to generate e-TeX --- last modified 06 Mar 1998
+
+\font\eighttt= cmtt8
+\font\eightrm= cmr8
+\font\rtitlefont= cmr7 scaled\magstep5
+\font\ititlefont= cmmi7 scaled\magstep5
+\def\titlefont{\rtitlefont \textfont1=\ititlefont}
+\def\eTeX{$\varepsilon$-\TeX}
+\def\NTS{NTS}
+\let\mc=\eightrm
+\rm
+\let\mainfont=\tenrm
+
+\def\.#1{\hbox{\tt#1}}
+\def\\#1{\hbox{\it#1\/\hskip.05em}} % italic type for identifiers
+
+\parskip 2pt plus 1pt
+\baselineskip 12pt plus .25pt
+
+\output{\shipout\box255\global\advance\pageno by 1} % for the title page only
+\null
+\vfill
+\centerline{\titlefont How to generate \eTeX}
+\vskip 6pt
+\centerline{({\sl Version 2, March 1998\/})}
+\vskip 18pt
+\centerline{by The \NTS\ Team}
+\vskip 6pt
+\centerline{Peter Breitenlohner, Max-Planck-Institut f\"ur Physik, M\"unchen}
+\vskip 6pt
+\centerline{Philip Taylor, RHBNC, University of London}
+\vfill
+\centerline{\vbox{\hsize 4in
+\noindent Given an implementation of \TeX82 for a particular system, this
+report describes how to generate a corresponding implementation of
+\eTeX.}}
+\vskip 24pt
+{\baselineskip 9pt
+\eightrm\noindent
+The preparation of this report was supported in part by DANTE,
+Deutschsprachige Anwendervereinigung \TeX\ e.V.\hfil\break
+`\TeX' is a trademark of the American Mathematical Society.
+
+}\pageno=0\eject
+
+\output{\shipout\vbox{ % for subsequent pages
+ \baselineskip0pt\lineskip0pt
+ \hbox to\hsize{\strut
+ \ifodd\pageno \hfil\eightrm\firstmark\hfil
+ \mainfont\the\pageno
+ \else\mainfont\the\pageno\hfil
+ \eightrm\firstmark\hfil\fi}
+ \vskip 10pt
+ \box255}
+ \global\advance\pageno by 1}
+\let\runninghead=\mark
+\outer\def\section#1.{\noindent{\bf#1.}\quad
+ \runninghead{\uppercase{#1} }\ignorespaces}
+
+\section Introduction.
+Let us first review the process of generating an implementation of
+\TeX82 for a particular system from the source files as, e.g., described
+in the \.{WEB} manual [1]. The system-independent source file
+\.{tex.web} must remain unmodified. All changes to \.{tex.web}
+necessary for a particular operating system and\slash or compiler are to
+be collected in a system-dependent change file, typically named
+\.{tex.ch}. Both files \.{tex.web} and \.{tex.ch} are effectively
+merged when input by the \.{WEB} system programs \.{WEAVE} and
+\.{TANGLE}. When \.{WEAVE} processes this merged input, a file
+\.{tex.tex} is produced. Further processing by \TeX\ yields a `pretty
+printed' version of the input together with an index.
+
+When \.{TANGLE} processes the merged input, a string pool file
+\.{tex.pool} and a Pascal file \.{tex.pas} (or similar) are produced.
+The Pascal file can then be further processed by a suitable compiler
+and\slash or language converter such as \.{web2c}, and eventually yields
+an executable program.
+
+There are actually three versions of the program: First there is
+\.{INITEX} with its capability to initialize all of \TeX's tables and to
+write them in compact form to a format file. Next there is the
+production version \.{VIRTEX} requiring a format file as input. Finally
+there is \.{TRIPTEX}, a version of \.{INITEX} with special values for
+some of \TeX's parameters, for the \.{TRIP} test [2] that should be used
+to validate a \TeX\ implementation. Depending on the capabilities of
+the compiler, these three versions of the program are generated from
+three slightly different change files or they are generated from one
+change file with different compiler options. They might even be one and
+the same executable program used with different run time options.
+
+\vskip 24pt plus 24pt
+\section Generating \eTeX.
+The process of generating \eTeX\ is essentially the same as that of
+generating \TeX\ as described above. Conceptually there is a
+system-independent source file \.{etex.web} and a system-dependent change
+file \.{etex.sys}. Processing these two files by \.{TANGLE} yields a
+string pool file \.{etex.pool} as well as a Pascal file \.{etex.pas},
+whilst processing by \.{WEAVE} produces a \TeX\ source file, \.{etex.tex}.
+
+It may, however, be necessary to increase some of the constants defined
+in \.{TANGLE} and \.{WEAVE}. The following values should suffice in
+most cases:
+$$
+\vcenter{\halign{$#$\hfil\qquad&#\hfil\cr
+\\{max\_bytes}\times\\{ww}=100~000&\.{TANGLE} and \.{WEAVE}\cr
+\\{max\_texts}=2~500&\.{TANGLE} and \.{WEAVE}\cr
+\\{max\_toks}\times\\{zz}=180~000&\.{TANGLE}\cr
+\\{max\_names}=5~000&\.{TANGLE}\cr
+\\{max\_scraps}=3~000&\.{WEAVE}\cr
+\\{stack\_size}=300&\.{WEAVE}\cr
+}}
+$$
+
+The source file \.{etex.web} for \eTeX\ does not, however, exist as a
+physical file. It is the hypothetical file obtained by applying the
+changes in the actual source file \.{etex.ch} to \.{tex.web}. Thus
+\.{etex.web} inherits the bulk of code from \.{tex.web}, whilst the
+system-independent source file \.{etex.ch} for \eTeX\ defines the
+differences between \.{etex.web} and \.{tex.web}. In order to generate
+an implementation of \eTeX\ two change files have to be applied to
+\.{tex.web}, one after the other (the actual file names may differ):
+$$
+\vcenter{\halign{#\hfil&\qquad\.{#}\hfil&\qquad#\hfil\cr
+0.&tex.web&system-independent \.{WEB} source for \TeX\cr
+1.&etex.ch&system-independent changes for \eTeX\cr
+2.&etex.sys&system-dependent changes for \eTeX\cr
+}}
+$$
+
+The process of merging several change files into \.{tex.web} should
+certainly not be performed by hand. There are programs such as \.{TIE}
+and \.{PATCHWEB} that perform this process automatically. If no such
+program is available, a \TeX\ program \.{WEBMERGE} can be used.
+\.{WEBMERGE} reads \.{tex.web} and up to nine change files and produces
+a merged change file that can then be processed, together with
+\.{tex.web}, by \.{TANGLE} and \.{WEAVE}. [On systems such as VMS, use
+of \.{WEBMERGE} can leave a large number of temporary files
+lying around; this can be avoided by setting a version limit (e.g.~1) on any
+existing versions of those files, or by setting a version limit on the
+directory in which they will be created. On other systems, it will probably
+leave one large temporary file.]
+
+Every implementor of \eTeX\ is responsible for creating and maintaining
+a suitable \.{etex.sys} in the same way as every implementor of \TeX\
+is responsible for creating and maintaining \.{tex.ch}. Since the bulk
+of code in \.{etex.web} is identical to that in \.{tex.web} the bulk of
+the system-dependent changes in \.{etex.sys} for a particular system
+will be identical to those in \.{tex.ch} for the same system. In the
+following we try to give some hints where \.{etex.sys} for a particular
+system might deviate from the corresponding \.{tex.ch}.
+
+First, it might be necessary to increase the size of \TeX's string pool
+in order to accommodate \eTeX's additional strings (message texts as
+well as multi-letter control sequences). If this turns out to be
+necessary for \eTeX\ it would certainly not be harmful to do it for
+\TeX\ as well. \TeX\ and \eTeX\ use three constants related to the
+string pool: \\{max\_strings} the maximal number of strings,
+\\{pool\_size} the maximal number of string characters, and
+\\{string\_vacancies} the minimal number of available string characters
+in addition to those occupied by strings from the pool file. It is,
+therefore, sufficient to increase \\{pool\_size} (or reduce
+\\{string\_vacancies}) by the number of \eTeX's additional string
+characters and to increase \\{max\_strings} by the number of \eTeX's
+additional strings. The latter will, however, be unnecessary for most
+implementations as \\{max\_strings} is usually increased substantially
+beyond its standard value in order to accommodate large \TeX\ macro
+packages.
+
+For Version~2 of \eTeX, there are about 100 additional strings with
+about 1500 additional string characters. The precise numbers can be
+obtained by running \.{POOLTYPE} on \TeX's and \eTeX's pool files
+(\.{POOLTYPE} reports the total number of strings and string characters
+in a pool file).
+
+Next, \.{etex.sys} may contain a system-dependent modification of the
+\\{eTeX\_banner} string. The modified \\{eTeX\_banner} string must
+contain `\.{e-TeX}' as well as the \eTeX\ version number. Note,
+however, that the \\{banner} string modified by \.{tex.ch} will not be
+referenced by \eTeX\ unless the implementor intentionally changes that
+aspect of \eTeX's functionality: therefore \.{etex.sys} can modify the
+\\{banner} string in the same way as does \.{tex.ch}.
+
+Then, \.{etex.sys} might deviate from \.{tex.ch} in order to use a
+different pool file name and\slash or format file extension (see below).
+
+Finally, \.{etex.sys} will necessarily deviate whenever \.{etex.ch}
+and \.{tex.ch} try to change the same piece of \.{WEB} code or when the
+system-independent \eTeX\ changes from \.{etex.ch} and the
+system-dependent \TeX\ changes from \.{tex.ch} interfere in some other way.
+In case of any such interference implementors must first of all determine
+how to combine the respective changes from \.{etex.ch} and \.{tex.ch}
+in order to obtain \eTeX's functionality for a particular system.
+Obviously, this process cannot be automated since it requires human
+insight.
+
+The \NTS\ team has tried to formulate \.{etex.ch} such that
+interferences with system-dependent change files \.{tex.ch} are
+unlikely. Suggestions by implementors how any remaining such
+interferences could be avoided by a reformulation of \.{etex.ch} will
+be taken into serious consideration. Such interferences can be further
+reduced by reformulating the system-dependent change file \.{tex.ch} for
+\TeX, e.g.\ by reducing the range of change entries from entire modules
+to the pieces of code that are actually changed.
+
+Implementors might prefer to maintain the system-dependent change file
+\.{etex.sys} not as a physical file but as a hypothetical file defined
+through its deviation from \.{tex.ch}. If there are no interferences of
+the kind mentioned above, then the effect of applying the changes from
+the hypothetical \.{etex.sys} to the hypothetical \.{etex.web} can be
+achieved by applying 3 change files, one after the other, to \.{tex.web}
+(using some tool such as \.{TIE}, \.{PATCHWEB}, or \.{WEBMERGE}):
+$$
+\vcenter{\halign{#\hfil&\qquad\.{#}\hfil&\qquad#\hfil\cr
+0.&tex.web&system-independent \.{WEB} source for \TeX\cr
+1.&etex.ch&system-independent changes for \eTeX\cr
+2.&tex.ch&system-dependent changes for \TeX\cr
+3.&tex.ech&additional system-dependent changes for \eTeX\cr
+}}
+$$
+The third change file \.{tex.ech} will be rather short and contains just
+the differences between \.{etex.sys} and \.{tex.ch}. It is recommended
+that implementors try to remove all interferences between \.{etex.ch}
+and \.{tex.ch} and use this method to generate \eTeX.
+
+As with \TeX\ there are three versions of \eTeX: \.{e-INITEX},
+\.{e-VIRTEX}, and \.{e-TRIPTEX}. Depending on the implementation they
+will again be generated from the three slightly different versions of
+\.{tex.ch} or with different compiler options or they may be one and the
+same program used with different run time options.
+
+\vskip 24pt plus 24pt
+\section \eTeX\ modes.
+In order to ensure maximal compatibility with \TeX, \eTeX\ can run in
+either compatibility mode or extended mode. The possibility of this
+choice is, of course, an extended feature of \eTeX. Once \eTeX\ has
+chosen compatibility mode it is, however, a legitimate implementation of
+\TeX\ (assuming the \TeX\ implementation itself is legitimate). The
+only differences between \eTeX\ in compatibility mode and \TeX\ are
+those allowed by D.~E.~Knuth [2] between different implementations of
+\TeX.
+
+An \.{e-TRIP} test suite [3] defines the criteria by which a program can
+qualify to use the name `\eTeX'. Part of the \.{e-TRIP} test consists
+of the standard \.{TRIP} test for \.{e-TRIPTEX} in compatibility and
+extended mode.
+
+\eTeX\ can therefore be used instead of \TeX\ without the necessity to
+maintain both programs. For the case that both programs should
+nevertheless co-exist on a system, it might be a good idea to name the
+pool file for \eTeX\ \.{etex.pool} instead of \.{tex.pool} and to use
+an extension other than \.{.fmt}, e.g., \.{.efmt} for \eTeX\ format
+files. (Format files for \TeX\ and \eTeX\ are incompatible). All this
+will require additional changes in the file \.{tex.ech}.
+
+When \.{INITEX} or \.{VIRTEX} start, they inspect the first non-blank
+character from the command line or in response to the \.{**} prompt.
+This may be an \.{\&} immediately followed by the name of a format file
+to be loaded. Otherwise \.{VIRTEX} loads a default format, whereas
+\.{INITEX} starts without loading a format.
+
+When \.{e-INITEX} or \.{e-VIRTEX} start, they inspect the first
+non-blank character from the command line or in response to the \.{**}
+prompt. This may again be an \.{\&} immediately followed by the name of
+a format file to be loaded; otherwise \.{e-VIRTEX} loads a default
+format. For \.{e-INITEX} the first non-blank character may be an \.{*}
+immediately followed by what would normally be the input for \.{INITEX}
+(without intervening blanks). \.{e-INITEX} enters extended mode in
+response to the \.{*}, or compatibility mode otherwise. This mode is
+recorded in format files produced by \.{e-INITEX} and entered again when
+such a format is loaded (by either \.{e-INITEX} or \.{e-VIRTEX}).
+
+\vskip 24pt plus 24pt
+\section References.
+\item {[1]}
+{\sl The \.{WEB} system of structured documentation\/},
+by Donald E.~Knuth,\hfil\break Stanford Computer Science Report~980.
+
+\item {[2]}
+{\sl A torture test for \TeX\/},
+by Donald E.~Knuth, Stanford Computer Science Report~1027.
+
+\item {[3]}
+{\sl A torture test for \eTeX\/},
+by The \NTS\ Team (Peter Breitenlohner and Bernd Raichle).
+
+\end
diff --git a/Build/source/texk/web2c/etexdir/etexextra.in b/Build/source/texk/web2c/etexdir/etexextra.in
new file mode 100644
index 00000000000..a500087bdaf
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etexextra.in
@@ -0,0 +1,34 @@
+/* etexextra.in: banner etc. for e-TeX.
+
+ This is included by e-TeX, from ../etexextra.c
+ (generated from ../lib/texmfmp.c).
+
+Copyright (C) 1995, 96 Karl Berry.
+Copyright (C) 2004 Olaf Weber.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#define BANNER "This is e-TeX, Version 3.141592-ETEX-VERSION"
+#define COPYRIGHT_HOLDER "Peter Breitenlohner"
+#define AUTHOR NULL
+#define PROGRAM_HELP ETEXHELP
+#define BUG_ADDRESS "tex-k@mail.tug.org"
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "einitex"
+#define VIR_PROGRAM "evirtex"
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip.diffs b/Build/source/texk/web2c/etexdir/etrip/etrip.diffs
new file mode 100644
index 00000000000..3f0d96075b4
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip.diffs
@@ -0,0 +1,356 @@
+make[1]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c'
+cd ../kpathsea && make -w CC='gcc' CFLAGS='-g '
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/kpathsea'
+make[2]: Nothing to be done for `default'.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/kpathsea'
+cd lib && make -w CC='gcc' CFLAGS='-g ' LDFLAGS=''
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+make[2]: Nothing to be done for `default'.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' fixwrites
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `fixwrites' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' splitup
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `splitup' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' web2c
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `web2c' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+rm -f trip.tfm trip.pl trip.tex trip.fmt ctripin.fot ctripin.log
+rm -f ctrip.fot ctrip.log trip.dvi ctrip.typ
+rm -f xtripin.fot xtripin.log
+rm -f xtrip.fot xtrip.log xtrip.typ
+rm -f etrip.tfm etrip.pl etrip.tex etrip.fmt etripin.fot etripin.log
+rm -f etrip.fot etrip.log etrip.dvi etrip.out etrip.typ
+rm -f tripos.tex 8terminal.tex
+rm -rf tfm
+*** TRIP test for e-TeX in compatibility mode ***.
+./pltotf ./triptrap/trip.pl trip.tfm
+./tftopl ./trip.tfm trip.pl
+diff ./triptrap/trip.pl trip.pl
+ln -s ./triptrap/trip.tex . # get same filename in log
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=einitex --ini <./triptrap/trip1.in >ctripin.fot'
+mv trip.log ctripin.log
+diff ./triptrap/tripin.log ctripin.log
+1c1
+< This is TeX, Version 3.141592 (INITEX) 20 DEC 2002 20:24
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5) (INITEX) 3 AUG 2005 10:50
+3c3
+< (trip.tex
+---
+> (./trip.tex
+450,451c450,451
+< (preloaded format=trip 2002.12.20)
+< 1320 strings of total length 23539
+---
+> (format=trip 2005.8.3)
+> 1479 strings of total length 25862
+461c461
+< Hyphenation trie of length 273 has 9 ops out of 500
+---
+> Hyphenation trie of length 273 has 9 ops out of 35111
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=etex <./triptrap/trip2.in >ctrip.fot'
+mv trip.log ctrip.log
+diff ./triptrap/trip.fot ctrip.fot
+1,3c1,2
+< This is TeX, Version 3.141592 (INITEX)
+< ** &trip trip
+< (trip.tex ##
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5)
+> **(./trip.tex ##
+diff ./triptrap/trip.log ctrip.log
+1c1
+< This is TeX, Version 3.141592 (preloaded format=trip 2002.12.20) 20 DEC 2002 21:28
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5) (format=trip 2005.8.3) 3 AUG 2005 10:50
+3c3
+< (trip.tex ##
+---
+> (./trip.tex ##
+58a59,62
+> \openout0 = `8terminal.tex'.
+>
+> \openout10 = `tripos.tex'.
+>
+1405c1409
+< \vbox(16383.99998+0.0)x1000.0, glue set 16342.0fil
+---
+> \vbox(16383.99998+0.0)x1000.0, glue set 16341.99998fil
+1954c1958
+< (tripos.tex
+---
+> (./tripos.tex
+2018c2022
+< \vbox(16383.99998+1.0)x100.0, glue set 16239.0fil
+---
+> \vbox(16383.99998+1.0)x100.0, glue set 16238.99998fil
+2533c2537
+< \vbox(16383.99998+0.0)x20.0, glue set 16331.0fil
+---
+> \vbox(16383.99998+0.0)x20.0, glue set 16330.99998fil
+3326c3330
+< \vbox(10000.0+2.0)x28.0, glue set 9737.58789fil
+---
+> \vbox(10000.0+2.0)x28.0, glue set 9737.58742fil
+3864c3868
+< \vbox(16383.99998+2.0)x100.0, glue set 16318.0fil
+---
+> \vbox(16383.99998+2.0)x100.0, glue set 16317.99997fil
+4034c4038
+< \vbox(16383.99998+0.0)x8236.0, glue set 16344.0fil
+---
+> \vbox(16383.99998+0.0)x8236.0, glue set 16343.99998fil
+4420c4424
+< \vbox(16383.99998+0.0)x100.0, glue set 16332.0fil
+---
+> \vbox(16383.99998+0.0)x100.0, glue set 16331.99998fil
+4742c4746
+< \vbox(16383.99998+0.0)x205.12613, glue set 16344.0fil
+---
+> \vbox(16383.99998+0.0)x205.12613, glue set 16343.99998fil
+6370c6374
+< (tripos.tex
+---
+> (./tripos.tex
+7287,7288c7291,7292
+< 47 strings out of 1674
+< 251 string characters out of 8353
+---
+> 44 strings out of 1821
+> 261 string characters out of 8138
+7290c7294
+< 372 multiletter control sequences out of 2100
+---
+> 372 multiletter control sequences out of 10000+0
+7292,7293c7296,7297
+< 2 hyphenation exceptions out of 307
+< 5i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+---
+> 1 hyphenation exception out of 659
+> 7i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./dvitype -output-level=2 -dpi=72.27 -page-start='*.*.*.*.*.*.*.*.*.*' trip.dvi >ctrip.typ'
+diff ./triptrap/trip.typ ctrip.typ
+1c1
+< This is DVItype, Version 3.6
+---
+> This is DVItype, Version 3.6 (Web2C 7.5.5)
+9c9
+< ' TeX output 2002.12.20:2128'
+---
+> ' TeX output 2005.08.03:1050'
+419c419
+< 1121: down4 639342208
+---
+> 1121: down4 639342177
+1087,1088c1087,1088
+< 2535: y4 203921760
+< 2540: y0 203921760
+---
+> 2535: y4 203921756
+> 2540: y0 203921756
+1215d1214
+<
+*** TRIP test for e-TeX in extended mode ***.
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=einitex --ini <./etexdir/etrip/etrip1.in >xtripin.fot'
+mv trip.log xtripin.log
+diff ctripin.log xtripin.log
+2c2,3
+< **\input trip
+---
+> entering extended mode
+> ***\input trip
+36,41d36
+< ! Bad register code (256).
+< l.29 ...{1} \toksdef\tokens=256
+< \show\errorstopmode
+< A register number must be between 0 and 255.
+< I changed this one to zero.
+<
+452,453c447,448
+< 471 memory locations dumped; current usage is 96&278
+< 341 multiletter control sequences
+---
+> 509 memory locations dumped; current usage is 134&278
+> 407 multiletter control sequences
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=etex <./etexdir/etrip/trip2.in >xtrip.fot'
+mv trip.log xtrip.log
+diff ctrip.fot xtrip.fot
+2c2,3
+< **(./trip.tex ##
+---
+> **entering extended mode
+> ## (./trip.tex
+76a78,80
+>
+> ### semi simple group (level 1) entered at line 429 (begingroup)
+> ### bottom level
+diff ctrip.log xtrip.log
+2,3c2,4
+< ** &trip trip
+< (./trip.tex ##
+---
+> entering extended mode
+> **&trip \toksdef\tokens=0 \input trip
+> (./trip.tex
+1773d1773
+< {restoring \fam=-1}
+1783d1782
+< {restoring \displayindent=0.0pt}
+1837d1835
+< {restoring \fam=-1}
+2139c2137
+< .\hbox(0.0+0.0)x0.0, shifted 50.0
+---
+> .\hbox(0.0+0.0)x0.0, shifted 50.0, display
+2142c2140
+< .\hbox(0.0+0.0)x0.0, shifted 100.0
+---
+> .\hbox(0.0+0.0)x0.0, shifted 100.0, display
+2574c2572
+< .\hbox(0.0+0.0)x15.0, glue set 0.1875, shifted 5.0
+---
+> .\hbox(0.0+0.0)x15.0, glue set 0.1875, shifted 5.0, display
+2839d2836
+< {restoring current font=\ip}
+3227d3223
+< {restoring \fam=-1}
+3376c3372
+< .\hbox(68.26251+98.15005)x19.0, glue set - 1.0, shifted 9.0
+---
+> .\hbox(68.26251+98.15005)x19.0, glue set - 1.0, shifted 9.0, display
+3561c3557
+< .\hbox(20.5+50.80002)x8.27895, shifted 19.72105
+---
+> .\hbox(20.5+50.80002)x8.27895, shifted 19.72105, display
+3770d3765
+< {restoring \fam=-1}
+3843d3837
+< {restoring \fam=-1}
+3899c3893
+< ..\hbox(12.0+4.0)x8.1778
+---
+> ..\hbox(12.0+4.0)x8.1778, display
+3921c3915
+< ..\hbox(0.0+13.00002)x-0.1778, glue set - 57.67767fil
+---
+> ..\hbox(0.0+13.00002)x-0.1778, glue set - 57.67767fil, display
+3929c3923
+< ....\hbox(7.0+1.0)x5.0, shifted 47.5
+---
+> ....\hbox(7.0+1.0)x5.0, shifted 47.5, display
+4015d4008
+< {restoring \fam=-1}
+4051c4044
+< .\hbox(0.0+0.0)x1009.0, shifted 7227.0
+---
+> .\hbox(0.0+0.0)x1009.0, shifted 7227.0, display
+4055c4048
+< .\hbox(0.0+0.0)x-7127.0, shifted 7227.0
+---
+> .\hbox(0.0+0.0)x-7127.0, shifted 7227.0, display
+7286a7280,7282
+>
+> ### semi simple group (level 1) entered at line 429 (begingroup)
+> ### bottom level
+7294c7290
+< 372 multiletter control sequences out of 10000+0
+---
+> 438 multiletter control sequences out of 10000+0
+7297c7293
+< 7i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+---
+> 7i,7n,9p,136b,40s stack positions out of 200i,40n,60p,500b,600s
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./dvitype -output-level=2 -dpi=72.27 -page-start='*.*.*.*.*.*.*.*.*.*' trip.dvi >xtrip.typ'
+diff ctrip.typ xtrip.typ
+*** e-TeX specific part of e-TRIP test ***.
+./pltotf ./etexdir/etrip/etrip.pl etrip.tfm
+./tftopl ./etrip.tfm etrip.pl
+diff ./etexdir/etrip/etrip.pl etrip.pl
+ln -s ./etexdir/etrip/etrip.tex . # get same filename in log
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=einitex --ini <./etexdir/etrip/etrip2.in >etripin.fot'
+mv etrip.log etripin.log
+diff ./etexdir/etrip/etripin.log etripin.log
+1c1
+< This is e-TeX, Version 3.141592-2.2 (INITEX) 6 SEP 2004 23:13
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5) (INITEX) 3 AUG 2005 10:50
+4c4,5
+< (etrip.tex This is the e-Trip test [2004-09-06] for e-TeX v3.141592-2.2.
+---
+> (./etrip.tex
+> This is the e-Trip test [2004-09-06] for e-TeX v3.141592-2.2.
+25,26c26,27
+< (preloaded format=etrip 2004.9.6)
+< 1435 strings of total length 24590
+---
+> (format=etrip 2005.8.3)
+> 1480 strings of total length 25893
+35c36
+< Hyphenation trie of length 434 has 12 ops out of 500
+---
+> Hyphenation trie of length 434 has 12 ops out of 35111
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=etex <./etexdir/etrip/etrip3.in >etrip.fot'
+diff ./etexdir/etrip/etrip.fot etrip.fot
+1,4c1,3
+< This is e-TeX, Version 3.141592-2.2 (INITEX)
+< **&etrip etrip
+< entering extended mode
+< (etrip.tex e-IniTeX: e-Trip format loaded.
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5)
+> **entering extended mode
+> (./etrip.tex e-IniTeX: e-Trip format loaded.
+46a46,47
+> \openout1 = `etrip.out'.
+>
+diff ./etexdir/etrip/etrip.log etrip.log
+1c1
+< This is e-TeX, Version 3.141592-2.2 (preloaded format=etrip 2004.9.6) 6 SEP 2004 23:13
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5) (format=etrip 2005.8.3) 3 AUG 2005 10:50
+4c4
+< (etrip.tex e-IniTeX: e-Trip format loaded.
+---
+> (./etrip.tex e-IniTeX: e-Trip format loaded.
+670a671,672
+> \openout1 = `etrip.out'.
+>
+672c674
+< (etrip.out) (
+---
+> (./etrip.out) (
+764c766
+< % end of outer \scantokens) (etrip.out
+---
+> % end of outer \scantokens) (./etrip.out
+4273,4274c4275,4276
+< 22 strings out of 1665
+< 132 string characters out of 8410
+---
+> 18 strings out of 1820
+> 140 string characters out of 8107
+4276c4278
+< 408 multiletter control sequences out of 2100
+---
+> 408 multiletter control sequences out of 10000+0
+4278c4280
+< 10 hyphenation exceptions out of 307
+---
+> 9 hyphenation exceptions out of 659
+diff ./etexdir/etrip/etrip.out etrip.out
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./dvitype -output-level=2 -dpi=72.27 -page-start='*.*.*.*.*.*.*.*.*.*' etrip.dvi >etrip.typ'
+diff ./etexdir/etrip/etrip.typ etrip.typ
+1c1
+< This is DVItype, Version 3.6
+---
+> This is DVItype, Version 3.6 (Web2C 7.5.5)
+9c9
+< ' TeX output 2004.09.06:2313'
+---
+> ' TeX output 2005.08.03:1050'
+make[1]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c'
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip.fot b/Build/source/texk/web2c/etexdir/etrip/etrip.fot
new file mode 100644
index 00000000000..eb255a09cc3
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip.fot
@@ -0,0 +1,46 @@
+This is e-TeX, Version 3.141592-2.2 (INITEX)
+**&etrip etrip
+entering extended mode
+(etrip.tex e-IniTeX: e-Trip format loaded.
+This is the e-Trip test [2004-09-06] for e-TeX v3.141592-2.2.
+(You are using e-TeX version/revision 2.2)
+Missing character: There is no c in font nullfont!
+
+
+current interactionmode (l.230): nonstop
+
+current interactionmode (l.231): scroll
+
+current interactionmode (l.232): errorstop
+
+! Bad interaction mode (-1).
+l.237 \interactionmode=-1
+ \1 1 % nonstop
+current interactionmode (l.237): nonstop
+! Bad interaction mode (4).
+l.238 \interactionmode=4
+ \1 1 % nonstop
+current interactionmode (l.238): nonstop
+
+current interactionmode (l.239): scroll
+
+current interactionmode (l.239): scroll
+
+current interactionmode (l.239): nonstop
+
+current interactionmode (l.239): nonstop
+
+current interactionmode (l.239): errorstop
+
+current interactionmode (l.239): errorstop
+
+current interactionmode (l.240): errorstop
+
+1 (l.243)
+1 (l.245)
+current interactionmode (l.247): errorstop
+
+current interactionmode (l.247): scroll
+
+current interactionmode (l.247): nonstop
+
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip.log b/Build/source/texk/web2c/etexdir/etrip/etrip.log
new file mode 100644
index 00000000000..fca746ee6c6
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip.log
@@ -0,0 +1,4281 @@
+This is e-TeX, Version 3.141592-2.2 (preloaded format=etrip 2004.9.6) 6 SEP 2004 23:13
+entering extended mode
+**&etrip etrip
+(etrip.tex e-IniTeX: e-Trip format loaded.
+This is the e-Trip test [2004-09-06] for e-TeX v3.141592-2.2.
+(You are using e-TeX version/revision 2.2)
+Missing character: There is no b in font nullfont!
+
+Missing character: There is no c in font nullfont!
+
+Checking input/output of new csnames:
+e-TeX Version 2 has 66 new csnames:
+> \3=macro:
+-> \eTeXversion \eTeXrevision
+ \showgroups \showtokens
+ \tracingassigns \tracinggroups
+ \tracingifs \tracingscantokens
+ \currentgrouplevel \currentgrouptype
+ \middle \lastnodetype
+ \TeXXeTstate \beginL
+ \endL \beginR
+ \endR \predisplaydirection
+ \marks \topmarks
+ \firstmarks \botmarks
+ \splitfirstmarks \splittopmarks
+ \protected \unexpanded
+ \detokenize \scantokens
+ \readline \unless
+ \ifdefined \ifcsname
+ \everyeof \interactionmode
+ \currentiflevel \currentiftype
+ \currentifbranch \showifs
+ \fontcharwd \fontcharht
+ \fontchardp \fontcharic
+ \iffontchar \tracingnesting
+ \parshapelength \parshapeindent
+ \parshapedimen \numexpr
+ \dimexpr \glueexpr
+ \muexpr \mutoglue
+ \gluetomu \gluestretchorder
+ \glueshrinkorder \gluestretch
+ \glueshrink \savingvdiscards
+ \pagediscards \splitdiscards
+ \lastlinefit \savinghyphcodes
+ \interlinepenalties \clubpenalties
+ \widowpenalties \displaywidowpenalties
+.
+l.181 \show\3
+ \endgroup
+
+Checking creation and printing for new node types:
+
+Overfull \hbox (38.99965pt too wide) in paragraph at lines 195--197
+[]\trip a[]b[]p$q [] t$u[][]
+
+\hbox(17.0+3.00002)x0.0
+.\hbox(0.0+0.0)x0.0
+.\trip a
+.\beginL
+.\trip b
+.\beginR
+.\trip p
+.\mathon
+.\trip q
+.\glue(\thinmuskip) 4.99988 plus 0.99997
+.\hbox(17.0+3.00002)x23.9999
+..\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+...\bigtrip a
+..\trip r
+..\glue(\thinmuskip) 4.99988 plus 0.99997
+..\hbox(16.0+4.00002)x6.0, shifted -1.0
+...\bigtrip B
+..\trip s
+..\vbox(7.0+11.0)x7.0, shifted -9.0
+...\hbox(7.0+1.0)x3.0
+....\trip A
+...\hbox(8.0+2.0)x3.0
+....\trip B
+.\glue(\thinmuskip) 4.99988 plus 0.99997
+.\trip t
+.\mathoff
+.\trip r (ligature u|)
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\endR
+.\endL
+.\glue(\rightskip) 0.0
+
+
+Overfull \hbox (11.0pt too wide) detected at line 197
+\trip aMb
+
+\hbox(8.0+2.0)x0.0
+.\trip a
+.\trip M
+.\trip b
+
+
+Overfull \hbox (24.6pt too wide) in paragraph at lines 197--201
+[][]\trip p[]q$st$u[]
+
+\hbox(0.0+0.0)x0.0
+.\beginL
+.\beginR
+.\trip p
+.\endR
+.\trip q (ligature |)
+.\trip q
+.\mathon, surrounded 12.3
+.\trip s
+.\trip t
+.\mathoff, surrounded 12.3
+.\trip r (ligature u|)
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\endL
+.\glue(\rightskip) 0.0
+
+
+Overfull \hbox (6.0pt too wide) detected at line 201
+\trip rMs
+
+\hbox(0.0+0.0)x0.0
+.\trip r
+.\trip M
+.\trip s
+
+
+Overfull \hbox (3.0pt too wide) in paragraph at lines 201--205
+[]\trip tp[]u
+
+\hbox(0.0+0.0)x0.0
+.\beginL
+.\trip t
+.\kern3.0
+.\trip q (ligature )
+.\trip p
+.\endL
+.\trip r (ligature u|)
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+
+
+Overfull \hbox (6.0pt too wide) detected at line 205
+\trip rMs
+
+\hbox(0.0+0.0)x0.0
+.\trip r
+.\trip M
+.\trip s
+
+! Bad register code (-1).
+<to be read again>
+ {
+l.208 \marks-1{
+ -1}\marks32768{32768}% Bad register (-1) ....
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (32768).
+<to be read again>
+ {
+l.208 ...marks-1{-1}\marks32768{
+ 32768}% Bad register (-1) ......
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Improper \beginL.
+l.210 \beginL
+ \beginR\endL\endR % Improper \(begin/end)(L/R)
+Sorry, this optional e-TeX feature has been disabled.
+
+! Improper \beginR.
+l.210 \beginL\beginR
+ \endL\endR % Improper \(begin/end)(L/R)
+Sorry, this optional e-TeX feature has been disabled.
+
+! Improper \endL.
+l.210 \beginL\beginR\endL
+ \endR % Improper \(begin/end)(L/R)
+Sorry, this optional e-TeX feature has been disabled.
+
+! Improper \endR.
+l.210 ...beginL\beginR\endL\endR
+ % Improper \(begin/end)(L/R)
+Sorry, this optional e-TeX feature has been disabled.
+
+
+Overfull \hbox (3.0pt too wide) in paragraph at lines 205--211
+\trip tp
+
+\hbox(0.0+0.0)x0.0
+.\trip t
+.\kern3.0
+.\trip q (ligature )
+.\trip p
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+
+> \box0=
+\vbox(30.00002+0.0)x0.0
+.\hbox(17.0+3.00002)x0.0
+..\hbox(0.0+0.0)x0.0
+..\trip a
+..\beginL
+..\trip b
+..\beginR
+..\trip p
+..\mathon
+..\trip q
+..\glue(\thinmuskip) 4.99988 plus 0.99997
+..\hbox(17.0+3.00002)x23.9999
+...\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+....\bigtrip a
+...\trip r
+...\glue(\thinmuskip) 4.99988 plus 0.99997
+...\hbox(16.0+4.00002)x6.0, shifted -1.0
+....\bigtrip B
+...\trip s
+...\vbox(7.0+11.0)x7.0, shifted -9.0
+....\hbox(7.0+1.0)x3.0
+.....\trip A
+....\hbox(8.0+2.0)x3.0
+.....\trip B
+..\glue(\thinmuskip) 4.99988 plus 0.99997
+..\trip t
+..\mathoff
+..\trip r (ligature u|)
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\endR
+..\endL
+..\glue(\rightskip) 0.0
+.\penalty 0
+.\glue(\abovedisplayskip) 0.0
+.\glue(\lineskip) 0.0
+.\hbox(8.0+2.0)x0.0
+..\beginM
+..\kern0.0
+..\hbox(8.0+2.0)x0.0, display
+...\trip a
+...\trip M
+...\trip b
+..\kern0.0
+..\endM
+.\penalty 0
+.\glue(\belowdisplayskip) 0.0
+.\glue(\lineskip) 0.0
+.\hbox(0.0+0.0)x0.0
+..\beginL
+..\beginR
+..\trip p
+..\endR
+..\trip q (ligature |)
+..\trip q
+..\mathon, surrounded 12.3
+..\trip s
+..\trip t
+..\mathoff, surrounded 12.3
+..\trip r (ligature u|)
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\endL
+..\glue(\rightskip) 0.0
+.\penalty 0
+.\glue(\abovedisplayskip) 0.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x0.0
+..\beginM
+..\kern0.0
+..\hbox(0.0+0.0)x0.0, display
+...\trip r
+...\trip M
+...\trip s
+..\kern0.0
+..\endM
+.\penalty 0
+.\glue(\belowdisplayskip) 0.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x0.0
+..\beginL
+..\trip t
+..\kern3.0
+..\trip q (ligature )
+..\trip p
+..\endL
+..\trip r (ligature u|)
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\penalty 0
+.\glue(\abovedisplayskip) 0.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x0.0, display
+..\trip r
+..\trip M
+..\trip s
+.\penalty 0
+.\glue(\belowdisplayskip) 0.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x0.0
+..\trip t
+..\kern3.0
+..\trip q (ligature )
+..\trip p
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\mark{0old}
+.\mark{0}
+.\marks1{1}
+.\marks15{15}
+.\marks32767{32767}
+.\mark{-1}
+.\mark{32768}
+
+! OK.
+l.211 }\showbox0
+
+
+Checking \interactionmode:
+
+
+current interactionmode (l.229): batch
+
+current interactionmode (l.230): nonstop
+
+current interactionmode (l.231): scroll
+
+current interactionmode (l.232): errorstop
+
+! Bad interaction mode (-1).
+l.237 \interactionmode=-1
+ \1 1 % nonstop
+Modes are 0=batch, 1=nonstop, 2=scroll, and
+3=errorstop. Proceed, and I'll ignore this case.
+
+current interactionmode (l.237): nonstop
+! Bad interaction mode (4).
+l.238 \interactionmode=4
+ \1 1 % nonstop
+Modes are 0=batch, 1=nonstop, 2=scroll, and
+3=errorstop. Proceed, and I'll ignore this case.
+
+current interactionmode (l.238): nonstop
+
+current interactionmode (l.239): scroll
+
+current interactionmode (l.239): scroll
+
+current interactionmode (l.239): nonstop
+
+current interactionmode (l.239): nonstop
+
+current interactionmode (l.239): errorstop
+
+current interactionmode (l.239): errorstop
+
+current interactionmode (l.239): batch
+
+current interactionmode (l.239): batch
+current interactionmode (l.240): batch
+
+current interactionmode (l.240): errorstop
+
+1 (l.243)
+0 (l.244)
+1 (l.245)
+current interactionmode (l.247): batch
+
+current interactionmode (l.247): errorstop
+
+current interactionmode (l.247): scroll
+
+current interactionmode (l.247): nonstop
+
+current interactionmode (l.248): batch
+Checking \tracingifs:
+{vertical mode: \iftrue: (level 1) entered on line 257}
+{\iffalse: (level 2) entered on line 257}
+{\else: \iffalse (level 2) entered on line 257}
+{\fi: \iffalse (level 2) entered on line 257}
+{\else: \iftrue (level 1) entered on line 257}
+{\fi: \iftrue (level 1) entered on line 257}
+{\unless\iftrue: (level 1) entered on line 258}
+{\else: \unless\iftrue (level 1) entered on line 258}
+{\unless\iffalse: (level 2) entered on line 258}
+{\else: \unless\iffalse (level 2) entered on line 258}
+{\fi: \unless\iffalse (level 2) entered on line 258}
+{\fi: \unless\iftrue (level 1) entered on line 258}
+{\ifdefined: (level 1) entered on line 260}
+{true}
+{\unless}
+{\unless\ifdefined: (level 2) entered on line 260}
+{true}
+{\ifcase: (level 3) entered on line 260}
+{case 2}
+{\or: \ifcase (level 3) entered on line 260}
+{\or: \ifcase (level 3) entered on line 260}
+{\ifcsname: (level 4) entered on line 261}
+{true}
+{\ifcsname: (level 5) entered on line 261}
+{false}
+{\else: \ifcsname (level 5) entered on line 261}
+{\ifx: (level 6) entered on line 262}
+{false}
+{\else: \ifx (level 6) entered on line 262}
+{\ifx: (level 7) entered on line 262}
+{false}
+{\fi: \ifx (level 7) entered on line 262}
+{\fi: \ifx (level 6) entered on line 262}
+{\fi: \ifcsname (level 5) entered on line 261}
+{\fi: \ifcsname (level 4) entered on line 261}
+{\or: \ifcase (level 3) entered on line 260}
+{\fi: \ifcase (level 3) entered on line 260}
+{\fi: \unless\ifdefined (level 2) entered on line 260}
+{\fi: \ifdefined (level 1) entered on line 260}
+{\endgroup}
+Checking \tracingassigns:
+{into \tracingassigns=1}
+{globally changing \count17=0}
+{into \count17=7}
+{reassigning \count17=7}
+{globally changing \9=undefined}
+{into \9=macro:->\relax }
+{globally changing \8=undefined}
+{into \8=macro:->\relax }
+{reassigning \8=macro:->\relax }
+{globally changing \count17=7}
+{into \count17=0}
+{reassigning \count17=0}
+{globally changing \9=macro:->\relax }
+{into \9=undefined}
+{globally changing \8=macro:->\relax }
+{into \8=undefined}
+{reassigning \8=undefined}
+{restoring \tracingassigns=0}
+Checking \currentgrouptype, \currentgrouplevel, and \lastnodetype:
+current group level (l.282): outer level
+current group type (l.284): bottom level
+current group type (l.311): semi simple group
+{entering vbox group (level 2) at line 313}
+current group type (l.313): vbox group
+{entering adjusted hbox group (level 3) at line 314}
+current group type (l.314): adjusted hbox group
+{entering simple group (level 4) at line 315}
+current group type (l.315): simple group
+{leaving simple group (level 4) entered at line 315}
+last node type (l.316): empty
+{entering hbox group (level 4) at line 317}
+current group type (l.317): hbox group
+{entering disc group (level 5) at line 318}
+current group type (l.318): disc group
+{leaving disc group (level 5) entered at line 318}
+{entering disc group (level 5) at line 318}
+current group type (l.318): disc group
+{leaving disc group (level 5) entered at line 318}
+{entering disc group (level 5) at line 318}
+current group type (l.318): disc group
+{leaving disc group (level 5) entered at line 318}
+last node type (l.320): disc node
+last node type (l.321): char node
+last node type (l.322): ligature node
+{entering insert group (level 5) at line 323}
+current group type (l.323): insert group
+{leaving insert group (level 5) entered at line 323}
+last node type (l.324): ins node
+{entering insert group (level 5) at line 325}
+current group type (l.325): insert group
+{leaving insert group (level 5) entered at line 325}
+last node type (l.326): adjust node
+last node type (l.327): mark node
+last node type (l.328): rule node
+last node type (l.329): glue node
+last node type (l.330): kern node
+last node type (l.331): penalty node
+{entering vtop group (level 5) at line 332}
+current group type (l.332): vtop group
+{leaving vtop group (level 5) entered at line 332}
+last node type (l.333): vlist node
+last node type (l.334): whatsit node
+{entering math shift group (level 5) at line 335}
+current group type (l.335): math shift group
+{entering math group (level 6) at line 336}
+current group type (l.336): math group
+{leaving math group (level 6) entered at line 336}
+{leaving math shift group (level 5) entered at line 335}
+last node type (l.338): math node
+last node type (l.339): math node
+last node type (l.340): math node
+{entering align group (level 5) at line 341}
+{entering align group (level 6) at line 341}
+current group type (l.341): align group
+{leaving align group (level 6) entered at line 341}
+{entering align group (level 6) at line 342}
+{entering no align group (level 7) at line 342}
+current group type (l.342): no align group
+last node type (l.343): unset node
+{leaving no align group (level 7) entered at line 342}
+{leaving align group (level 6) entered at line 342}
+{leaving align group (level 5) entered at line 341}
+{leaving hbox group (level 4) entered at line 317}
+{leaving adjusted hbox group (level 3) entered at line 314}
+last node type (l.347): hlist node
+{entering math shift group (level 3) at line 348}
+current group type (l.348): math shift group
+last node type (l.349): empty
+{entering math choice group (level 4) at line 350}
+current group type (l.350): math choice group
+{leaving math choice group (level 4) entered at line 350}
+{entering math choice group (level 4) at line 350}
+current group type (l.350): math choice group
+{leaving math choice group (level 4) entered at line 350}
+{entering math choice group (level 4) at line 350}
+current group type (l.350): math choice group
+{leaving math choice group (level 4) entered at line 350}
+{entering math choice group (level 4) at line 350}
+current group type (l.350): math choice group
+{entering vcenter group (level 5) at line 351}
+current group type (l.351): vcenter group
+{leaving vcenter group (level 5) entered at line 351}
+last node type (l.352): math mode node
+{leaving math choice group (level 4) entered at line 350}
+last node type (l.353): math mode node
+{entering math left group (level 4) at line 354}
+current group type (l.354): math left group
+{leaving math left group (level 4) entered at line 354}
+{entering math left group (level 4) at line 355}
+current group type (l.355): math left group
+{leaving math left group (level 4) entered at line 355}
+{entering math left group (level 4) at line 356}
+current group type (l.356): math left group
+{leaving math left group (level 4) entered at line 356}
+{leaving math shift group (level 3) entered at line 348}
+{leaving vbox group (level 2) entered at line 313}
+{entering adjusted hbox group (level 2) at line 394}
+{leaving adjusted hbox group (level 2) entered at line 394}
+{entering output group (level 2) at line 394}
+current group type (l.394): output group
+{entering vbox group (level 3) at line 394}
+{entering adjusted hbox group (level 4) at line 394}
+{entering hbox group (level 5) at line 394}
+{entering simple group (level 6) at line 394}
+{entering align group (level 7) at line 394}
+{entering align group (level 8) at line 394}
+{entering no align group (level 9) at line 394}
+{entering math shift group (level 10) at line 394}
+{entering vtop group (level 11) at line 394}
+{entering math shift group (level 12) at line 394}
+{entering math group (level 13) at line 394}
+{entering math left group (level 14) at line 394}
+{leaving math left group (level 14) entered at line 394}
+{entering math left group (level 14) at line 394}
+{entering math choice group (level 15) at line 394}
+{leaving math choice group (level 15) entered at line 394}
+{entering math choice group (level 15) at line 394}
+{leaving math choice group (level 15) entered at line 394}
+{entering math choice group (level 15) at line 394}
+{entering vcenter group (level 16) at line 394}
+{entering insert group (level 17) at line 394}
+{entering disc group (level 18) at line 394}
+{leaving disc group (level 18) entered at line 394}
+{entering disc group (level 18) at line 394}
+
+### disc group (level 18) entered at line 394 (\discretionary{}{)
+### insert group (level 17) entered at line 394 (\vadjust{)
+### vcenter group (level 16) entered at line 394 (\vcenter to7.0pt{)
+### math choice group (level 15) entered at line 394 (\mathchoice{}{}{)
+### math left group (level 14) entered at line 394 (\middle)
+### math group (level 13) entered at line 394 ({)
+### math shift group (level 12) entered at line 394 ($$)
+### vtop group (level 11) entered at line 394 (\vtop{)
+### math shift group (level 10) entered at line 394 ($)
+### no align group (level 9) entered at line 394 (\noalign{)
+### align group (level 8) entered at line 394 (\cr)
+### align group (level 7) entered at line 394 (\valign{)
+### simple group (level 6) entered at line 394 ({)
+### hbox group (level 5) entered at line 394 (\raise5.0pt\hbox{)
+### adjusted hbox group (level 4) entered at line 394 (\hbox spread5.0pt
+{)
+### vbox group (level 3) entered at line 394 (\setbox0=\vbox{)
+### output group (level 2) entered at line 394 (\output)
+### semi simple group (level 1) entered at line 285 (\begingroup)
+### bottom level
+
+! OK.
+<output> ...nary {}{\showgroups
+ }{} } } }{} \right . } $$ } $...
+l.394 ...ox{}\vfil\penalty-10000
+
+
+{leaving disc group (level 18) entered at line 394}
+{entering disc group (level 18) at line 394}
+{leaving disc group (level 18) entered at line 394}
+{leaving insert group (level 17) entered at line 394}
+{leaving vcenter group (level 16) entered at line 394}
+{leaving math choice group (level 15) entered at line 394}
+{entering math choice group (level 15) at line 394}
+{leaving math choice group (level 15) entered at line 394}
+{leaving math left group (level 14) entered at line 394}
+{leaving math group (level 13) entered at line 394}
+{leaving math shift group (level 12) entered at line 394}
+{leaving vtop group (level 11) entered at line 394}
+{leaving math shift group (level 10) entered at line 394}
+{leaving no align group (level 9) entered at line 394}
+{leaving align group (level 8) entered at line 394}
+{leaving align group (level 7) entered at line 394}
+{leaving simple group (level 6) entered at line 394}
+{leaving hbox group (level 5) entered at line 394}
+{leaving adjusted hbox group (level 4) entered at line 394}
+{leaving vbox group (level 3) entered at line 394}
+{leaving output group (level 2) entered at line 394}
+Checking expansion of \protected macros:
+> \2=\protected macro:
+->.
+l.402 ...otected\def\2{} \show\2
+
+
+> \3=\protected macro:
+->.
+l.403 \let\3=\2 \show\3
+
+
+> \1=\protected macro:
+->\2.
+l.404 ...cted\def\1{\2}} \show\1
+
+
+
+\1->\2
+\1\2
+\typeout ->\immediate \write 15
+
+\1->\2
+\1\2
+
+\1->\2
+> \box0=
+\vbox(0.0+0.0)x0.0
+.\special{\1\2}
+
+! OK.
+l.408 ...ndafter\1\1}} \showbox0
+
+
+
+\1->\2
+> \5=macro:
+->\1\2.
+l.409 ...xpandafter\1\1} \show\5
+
+
+
+\1->\2
+
+\1->\3
+
+\3->
+
+\2->
+Checking \scantokens, \tracingscantokens, \readline, and \everyeof:
+
+Completed box being shipped out [1]
+\vbox(0.0+0.0)x0.0
+.\openout1=etrip.out
+.\write1{\unexpanded \expandafter {\1}}
+.\closeout1
+
+Memory usage before: 50&182; after: 36&176; still untouched: 680
+(etrip.out) (
+Warning: end of semi simple group (level 3) entered at line 431 of a dif
+ferent file
+Warning: end of \iftrue entered on line 431 of a different file
+Warning: end of file when simple group (level 3) entered at line 3 is in
+complete
+Warning: end of file when \iffalse\else entered on line 4 is incomplete
+) (
+Warning: end of semi simple group (level 3) entered at line 433 of a dif
+ferent file
+l.1 \endgroup
+
+l.433 ...ntokens\expandafter{\1}
+ \egroup \fi
+Warning: end of \unless\iffalse entered on line 433 of a different file
+l.2 \fi
+
+l.433 ...ntokens\expandafter{\1}
+ \egroup \fi
+Warning: end of file when simple group (level 3) entered at line 3 is in
+complete
+Warning: end of file when \iffalse\else entered on line 4 is incomplete
+l.5 \iffalse \else
+
+l.433 ...ntokens\expandafter{\1}
+ \egroup \fi) (
+Warning: end of hbox group (level 4) entered at line 1 of a different fi
+le
+l.1 \egroup
+
+l.6 }
+
+l.444 }
+ % end of outer \scantokens
+Warning: end of \ifcase entered on line 2 of a different file
+l.2 \else \fi
+
+l.6 }
+
+l.444 }
+ % end of outer \scantokens
+Warning: end of hbox group (level 3) entered at line 435 of a different
+file
+
+\1->\egroup
+ \fi
+l.4 \1
+
+l.6 }
+
+l.444 }
+ % end of outer \scantokens
+Warning: end of \unless\iftrue entered on line 436 of a different file
+
+\1->\egroup \fi
+
+l.4 \1
+
+l.6 }
+
+l.444 }
+ % end of outer \scantokens
+Warning: end of file when math shift group (level 4) entered at line 7 i
+s incomplete
+Warning: end of file when vtop group (level 3) entered at line 5 is inco
+mplete
+Warning: end of file when \iffalse entered on line 9 is incomplete
+Warning: end of file when \ifinner\else entered on line 8 is incomplete
+Warning: end of file when \ifnum entered on line 6 is incomplete
+l.10 \csname iffalse\endcsname
+
+l.6 }
+
+l.444 }
+ % end of outer \scantokens
+! Incomplete \iffalse; all text was ignored after line 9.
+<inserted text>
+ \fi
+l.6 }
+
+l.444 }
+ % end of outer \scantokens
+The file ended while I was skipping conditional text.
+This kind of error happens when you say `\if...' and forget
+the matching `\fi'. I've inserted a `\fi'; this might work.
+
+Warning: end of file when vtop group (level 3) entered at line 5 is inco
+mplete
+Warning: end of file when \ifnum entered on line 6 is incomplete
+l.9 \fi
+
+l.444 }
+ % end of outer \scantokens) (etrip.out
+! Undefined control sequence.
+\endgroup ->\9\9
+
+l.1 \endgroup
+
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+) (
+! Undefined control sequence.
+\endgroup ->\9\9
+
+l.1 \endgroup
+
+l.451 ...ntokens\expandafter{\1}
+ \egroup \fi
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+) ( )
+Runaway definition?
+->\begingroup
+! File ended while scanning definition of \1.
+<inserted text>
+ }
+l.453 ...scantokens{\begingroup}
+ % <== error
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+( ) ( level=2 ( level=3 ( level=4
+! Undefined control sequence.
+<everyeof> ...uplevel \2\else \9
+ \fi
+l.2
+
+\2...=\the \currentgrouplevel }}
+ \endgroup
+<everyeof> ...rrentgrouplevel \2
+ \else \9\fi
+l.2
+
+\2...=\the \currentgrouplevel }}
+ \endgroup
+<everyeof> ...rrentgrouplevel \2
+ \else \9\fi
+l.2
+
+\2...=\the \currentgrouplevel }}
+ \endgroup
+l.461 ...evel\2\else\9\fi}}}\1\2
+
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+)))
+{\tracingrestores}
+{\tracingassigns}
+{into \tracingassigns=1}
+{\setbox}
+{restricted horizontal mode: \unless}
+{\unless\ifeof}
+{true}
+{\readline}
+{changing \2=macro:->\begingroup \scantokens {\message \ETC.}
+{into \2=macro:->\endgroup^^M}
+{\endlinechar}
+{changing \endlinechar=13}
+{into \endlinechar=-1}
+{the character \}
+Missing character: There is no \ in font etrip!
+{the character e}
+Missing character: There is no e in font etrip!
+{the character n}
+Missing character: There is no n in font etrip!
+{the character d}
+Missing character: There is no d in font etrip!
+{the character g}
+Missing character: There is no g in font etrip!
+{the character r}
+Missing character: There is no o in font etrip!
+{the character u}
+Missing character: There is no ^^M in font etrip!
+{\expandafter}
+{\fi}
+{\unless}
+{\unless\ifeof}
+{true}
+{\readline}
+{changing \2=macro:->\endgroup^^M}
+{into \2=macro:->\fi}
+{\endlinechar}
+{reassigning \endlinechar=-1}
+{the character \}
+Missing character: There is no \ in font etrip!
+{the character f}
+Missing character: There is no f in font etrip!
+{the character i}
+Missing character: There is no i in font etrip!
+{\expandafter}
+{\fi}
+{\unless}
+{\unless\ifeof}
+{true}
+{\readline}
+{changing \2=macro:->\fi}
+{into \2=macro:->\bgroup}
+{\endlinechar}
+{reassigning \endlinechar=-1}
+{the character \}
+Missing character: There is no \ in font etrip!
+{the character b}
+Missing character: There is no g in font etrip!
+{the character r}
+Missing character: There is no o in font etrip!
+{the character u}
+{\expandafter}
+{\fi}
+{\unless}
+{\unless\ifeof}
+{true}
+{\readline}
+{changing \2=macro:->\bgroup}
+{into \2=macro:->\iffalse \else}
+{\endlinechar}
+{reassigning \endlinechar=-1}
+{the character \}
+Missing character: There is no \ in font etrip!
+{the character i}
+Missing character: There is no i in font etrip!
+{the character f}
+Missing character: There is no f in font etrip!
+{the character f}
+Missing character: There is no f in font etrip!
+{the character a}
+Missing character: There is no l in font etrip!
+{the character s}
+Missing character: There is no e in font etrip!
+{blank space }
+{the character \}
+Missing character: There is no \ in font etrip!
+{the character e}
+Missing character: There is no e in font etrip!
+{the character l}
+Missing character: There is no l in font etrip!
+{the character s}
+Missing character: There is no e in font etrip!
+{\expandafter}
+{\fi}
+{\unless}
+{\unless\ifeof}
+{true}
+{\readline}
+{changing \2=macro:->\iffalse \else}
+{into \2=macro:->}
+{\endlinechar}
+{reassigning \endlinechar=-1}
+{\expandafter}
+{\fi}
+{\unless}
+{\unless\ifeof}
+{false}
+{\showlists}
+
+### restricted horizontal mode entered at line 468
+\trip r
+\trip r (ligature up)
+\trip b
+\trip r
+\trip r (ligature up)
+\trip a
+\trip s
+\glue 4.0 plus 2.0 minus 1.0
+\trip s
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+l.468 ...ox25=\hbox{\1\showlists
+ }^^M
+
+{end-group character }}
+{restoring \endlinechar=13}
+{restoring \2=macro:->\begingroup \scantokens {\message \ETC.}
+{changing \box25=void}
+{into \box25=
+\hbox(8.0+2.0)x9.0 []}
+{vertical mode: blank space }
+{end-group character }}
+{restoring \box25=void}
+{restoring \tracingassigns=0}
+Checking \marks etc., \showtokens, and \detokenize:
+
+Current marks:
+ \splitfirstmarks 0=.
+ \splitbotmarks 0=.
+ \splitfirstmarks 1=.
+ \splitbotmarks 1=.
+ \splitfirstmarks 3=.
+ \splitbotmarks 3=.
+> \box0=
+\vbox(188.0+0.0)x10.0
+.\mark{0-1}
+.\marks1{1-1}
+.\glue 1.0
+.\vbox(9.0+0.0)x0.0
+.\mark{0-2}
+.\marks3{}
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x0.0
+.\glue 5.0
+.\glue 0.0 plus 1.0fil
+.\penalty 0
+.\glue 40.0
+.\mark{0-3}
+.\glue 1.0
+.\glue(\lineskip) 0.0
+.\vbox(19.0+0.0)x0.0
+.\marks3{3-3}
+.\glue 3.0 plus 1.0fil
+.\penalty 0
+.\glue 40.0
+.\glue(\lineskip) 0.0
+.\vbox(30.0+0.0)x0.0
+.\glue 0.0 plus 1.0fil
+.\penalty 0
+.\glue 40.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x10.0
+
+! OK.
+l.491 \1 \showbox0
+ \let\5=\3 \def\3#1{\showtokens\expandaft...
+
+> 0-1.
+<recently read> }
+
+...
+l.493 \1
+ \showbox1 \showbox0 \let\3=\5
+
+> 0-2.
+<recently read> }
+
+...
+l.493 \1
+ \showbox1 \showbox0 \let\3=\5
+
+> 1-1.
+<recently read> }
+
+...
+l.493 \1
+ \showbox1 \showbox0 \let\3=\5
+
+> 1-1.
+<recently read> }
+
+...
+l.493 \1
+ \showbox1 \showbox0 \let\3=\5
+
+> .
+<recently read> }
+
+...
+l.493 \1
+ \showbox1 \showbox0 \let\3=\5
+
+> .
+<recently read> }
+
+...
+l.493 \1
+ \showbox1 \showbox0 \let\3=\5
+
+
+Current marks:
+ \splitfirstmarks 0=0-1.
+ \splitbotmarks 0=0-2.
+ \splitfirstmarks 1=1-1.
+ \splitbotmarks 1=1-1.
+ \splitfirstmarks 3=.
+ \splitbotmarks 3=.
+> \box1=
+\vbox(17.0+0.0)x0.0, glue set 2.0fil
+.\mark{0-1}
+.\marks1{1-1}
+.\glue 1.0
+.\vbox(9.0+0.0)x0.0
+.\mark{0-2}
+.\marks3{}
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x0.0
+.\glue 5.0
+.\glue 0.0 plus 1.0fil
+
+! OK.
+l.493 \1 \showbox1
+ \showbox0 \let\3=\5
+
+> \box0=
+\vbox(132.0+0.0)x10.0
+.\mark{0-3}
+.\glue(\splittopskip) 0.0
+.\vbox(19.0+0.0)x0.0
+.\marks3{3-3}
+.\glue 3.0 plus 1.0fil
+.\penalty 0
+.\glue 40.0
+.\glue(\lineskip) 0.0
+.\vbox(30.0+0.0)x0.0
+.\glue 0.0 plus 1.0fil
+.\penalty 0
+.\glue 40.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x10.0
+
+! OK.
+l.493 \1 \showbox1 \showbox0
+ \let\3=\5
+
+
+Current marks:
+ \splitfirstmarks 0=0-3.
+ \splitbotmarks 0=0-3.
+ \splitfirstmarks 1=.
+ \splitbotmarks 1=.
+ \splitfirstmarks 3=3-3.
+ \splitbotmarks 3=3-3.
+> \box1=
+\vbox(27.0+0.0)x0.0, glue set 5.0fil
+.\mark{0-3}
+.\glue(\splittopskip) 0.0
+.\vbox(19.0+0.0)x0.0
+.\marks3{3-3}
+.\glue 3.0 plus 1.0fil
+
+! OK.
+l.495 \1 \showbox1
+ \showbox0
+
+> \box0=
+\vbox(70.0+0.0)x10.0
+.\glue(\splittopskip) 0.0
+.\vbox(30.0+0.0)x0.0
+.\glue 0.0 plus 1.0fil
+.\penalty 0
+.\glue 40.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x10.0
+
+! OK.
+l.495 \1 \showbox1 \showbox0
+
+
+
+Current marks:
+ \splitfirstmarks 0=.
+ \splitbotmarks 0=.
+ \splitfirstmarks 1=.
+ \splitbotmarks 1=.
+ \splitfirstmarks 3=.
+ \splitbotmarks 3=.
+> \box1=
+\vbox(37.0+0.0)x0.0, glue set 7.0fil
+.\glue(\splittopskip) 0.0
+.\vbox(30.0+0.0)x0.0
+.\glue 0.0 plus 1.0fil
+
+! OK.
+l.497 \1 \showbox1
+ \showbox0
+
+> \box0=
+\vbox(0.0+0.0)x10.0
+.\glue(\splittopskip) 0.0
+.\hbox(0.0+0.0)x10.0
+
+! OK.
+l.497 \1 \showbox1 \showbox0
+
+
+
+Current marks:
+ \topmarks 0=.
+ \firstmarks 0=.
+ \botmarks 0=.
+ \topmarks 1=.
+ \firstmarks 1=.
+ \botmarks 1=.
+ \topmarks 3=.
+ \firstmarks 3=.
+ \botmarks 3=.
+
+Current marks:
+ \topmarks 0=.
+ \firstmarks 0=0-1.
+ \botmarks 0=0-2.
+ \topmarks 1=.
+ \firstmarks 1=1-1.
+ \botmarks 1=1-1.
+ \topmarks 3=.
+ \firstmarks 3=.
+ \botmarks 3=.
+> \box255=
+\vbox(35.0+0.0)x0.0, glue set 21.0fil
+.\mark{0-1}
+.\marks1{1-1}
+.\glue(\topskip) 0.0
+.\vbox(9.0+0.0)x0.0
+.\mark{0-2}
+.\marks3{}
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x0.0
+.\glue 5.0
+.\glue 0.0 plus 1.0fil
+
+! OK.
+<output> {\1 \showbox 255
+ \setbox 0=\box 255}
+l.500 ...s3{}\vfil\penalty-10000
+
+
+
+Current marks:
+ \topmarks 0=0-2.
+ \firstmarks 0=0-3.
+ \botmarks 0=0-3.
+ \topmarks 1=1-1.
+ \firstmarks 1=1-1.
+ \botmarks 1=1-1.
+ \topmarks 3=.
+ \firstmarks 3=3-3.
+ \botmarks 3=3-3.
+> \box255=
+\vbox(35.0+0.0)x0.0, glue set 13.0fil
+.\mark{0-3}
+.\glue(\topskip) 0.0
+.\vbox(19.0+0.0)x0.0
+.\marks3{3-3}
+.\glue 3.0 plus 1.0fil
+
+! OK.
+<output> {\1 \showbox 255
+ \setbox 0=\box 255}
+l.500 ...s3{}\vfil\penalty-10000
+
+
+
+Current marks:
+ \topmarks 0=0-3.
+ \firstmarks 0=0-3.
+ \botmarks 0=0-3.
+ \topmarks 1=1-1.
+ \firstmarks 1=1-1.
+ \botmarks 1=1-1.
+ \topmarks 3=3-3.
+ \firstmarks 3=3-3.
+ \botmarks 3=3-3.
+> \box255=
+\vbox(35.0+0.0)x0.0, glue set 5.0fil
+.\glue(\topskip) 0.0
+.\vbox(30.0+0.0)x0.0
+.\glue 0.0 plus 1.0fil
+
+! OK.
+<output> {\1 \showbox 255
+ \setbox 0=\box 255}
+l.500 ...s3{}\vfil\penalty-10000
+
+
+
+Current marks:
+ \topmarks 0=0-3.
+ \firstmarks 0=.
+ \botmarks 0=.
+ \topmarks 1=1-1.
+ \firstmarks 1=.
+ \botmarks 1=.
+ \topmarks 3=3-3.
+ \firstmarks 3=.
+ \botmarks 3=.
+> \box255=
+\vbox(35.0+0.0)x10.0, glue set 35.0fil
+.\glue(\topskip) 0.0
+.\hbox(0.0+0.0)x10.0
+.\mark{}
+.\marks1{}
+.\marks3{}
+.\glue 0.0 plus 1.0fil
+
+! OK.
+<output> {\1 \showbox 255
+ \setbox 0=\box 255}
+l.500 ...s3{}\vfil\penalty-10000
+
+
+
+Current marks:
+ \topmarks 0=.
+ \firstmarks 0=.
+ \botmarks 0=.
+ \topmarks 1=.
+ \firstmarks 1=.
+ \botmarks 1=.
+ \topmarks 3=.
+ \firstmarks 3=.
+ \botmarks 3=.
+> \box255=
+\vbox(35.0+0.0)x0.0, glue set 35.0fil
+.\glue(\topskip) 0.0
+.\hbox(0.0+0.0)x0.0
+.\mark{}
+.\marks1{}
+.\marks3{}
+.\glue 0.0 plus 1.0fil
+
+! OK.
+<output> {\1 \showbox 255
+ \setbox 0=\box 255}
+l.501 ...s3{}\vfil\penalty-10000
+
+
+
+Current marks:
+ \topmarks 0=.
+ \firstmarks 0=.
+ \botmarks 0=.
+ \topmarks 1=.
+ \firstmarks 1=.
+ \botmarks 1=.
+ \topmarks 3=.
+ \firstmarks 3=.
+ \botmarks 3=.
+> \box255=
+\vbox(35.0+0.0)x0.0, glue set 35.0fil
+.\glue(\topskip) 0.0
+.\hbox(0.0+0.0)x0.0
+.\glue 0.0 plus 1.0fil
+
+! OK.
+<output> {\1 \showbox 255
+ \setbox 0=\box 255}
+l.502 ...x{}\vfil\penalty-10000
+ % reclaim sparse array memory!
+
+Checking \middle:
+! Missing $ inserted.
+<inserted text>
+ $
+...
+l.511 \setbox0=\vbox{\middle
+ \par \right \par} % <== 8 errors
+I've inserted a begin-math/end-math symbol since I think
+you left one out. Proceed, with fingers crossed.
+
+! Missing delimiter (. inserted).
+<to be read again>
+ \par
+l.511 ...box0=\vbox{\middle \par
+ \right \par} % <== 8 errors
+I was expecting to see something like `(' or `\{' or
+`\}' here. If you typed, e.g., `{' instead of `\{', you
+should probably delete the `{' by typing `1' now, so that
+braces don't get unbalanced. Otherwise just proceed.
+Acceptable delimiters are characters whose \delcode is
+nonnegative, or you can use `\delimiter <delimiter code>'.
+
+! Extra \middle.
+<to be read again>
+ \par
+l.511 ...box0=\vbox{\middle \par
+ \right \par} % <== 8 errors
+I'm ignoring a \middle that had no matching \left.
+
+! Missing $ inserted.
+<inserted text>
+ $
+...
+l.511 ...box0=\vbox{\middle \par
+ \right \par} % <== 8 errors
+I've inserted a begin-math/end-math symbol since I think
+you left one out. Proceed, with fingers crossed.
+
+! Missing $ inserted.
+<inserted text>
+ $
+...
+l.511 ...box{\middle \par \right
+ \par} % <== 8 errors
+I've inserted a begin-math/end-math symbol since I think
+you left one out. Proceed, with fingers crossed.
+
+! Missing delimiter (. inserted).
+<to be read again>
+ \par
+l.511 ...middle \par \right \par
+ } % <== 8 errors
+I was expecting to see something like `(' or `\{' or
+`\}' here. If you typed, e.g., `{' instead of `\{', you
+should probably delete the `{' by typing `1' now, so that
+braces don't get unbalanced. Otherwise just proceed.
+Acceptable delimiters are characters whose \delcode is
+nonnegative, or you can use `\delimiter <delimiter code>'.
+
+! Extra \right.
+<to be read again>
+ \par
+l.511 ...middle \par \right \par
+ } % <== 8 errors
+I'm ignoring a \right that had no matching \left.
+
+! Missing $ inserted.
+<inserted text>
+ $
+...
+l.511 ...middle \par \right \par
+ } % <== 8 errors
+I've inserted a begin-math/end-math symbol since I think
+you left one out. Proceed, with fingers crossed.
+
+
+### math mode entered at line 522
+\mathord
+.\fam1 r
+this will be denominator of:
+\fraction, thickness = default
+\\left"161361
+\\mathord
+\.\fam1 p
+\\middle"142342
+\\mathord
+\.\fam1 q
+\\middle"142342
+\\mathord
+\.\fam1 q
+### math mode entered at line 519
+\left"161361
+\mathord
+.\fam1 p
+\middle"142342
+\mathord
+.\fam1 q
+\middle"142342
+\mathord
+.\fam1 q
+### math mode entered at line 515
+\mathord
+.\fam1 r
+this will be denominator of:
+\fraction, thickness = default
+\\left"161361
+\\mathord
+\.\fam1 q
+### math mode entered at line 514
+\left"161361
+\mathord
+.\fam1 p
+### math mode entered at line 513
+### restricted horizontal mode entered at line 512
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+l.523 ... \over r\showlists
+
+
+
+### math mode entered at line 519
+\left"161361
+\mathord
+.\fam1 p
+\middle"142342
+\mathord
+.\fam1 q
+\middle"142342
+\mathord
+.\fam1 q
+\mathinner
+.\left"161361
+.\mathord
+..\fam1 p
+.\middle"142342
+.\mathord
+..\fam1 q
+.\middle"142342
+.\fraction, thickness = default
+.\\mathord
+.\.\fam1 q
+./\mathord
+./.\fam1 r
+.\right"162362
+### math mode entered at line 515
+\mathord
+.\fam1 r
+this will be denominator of:
+\fraction, thickness = default
+\\left"161361
+\\mathord
+\.\fam1 q
+### math mode entered at line 514
+\left"161361
+\mathord
+.\fam1 p
+### math mode entered at line 513
+### restricted horizontal mode entered at line 512
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+l.524 ... \right]\showlists
+
+
+
+### math mode entered at line 515
+\mathord
+.\fam1 r
+\mathinner
+.\left"161361
+.\mathord
+..\fam1 p
+.\middle"142342
+.\mathord
+..\fam1 q
+.\middle"142342
+.\mathord
+..\fam1 q
+.\mathinner
+..\left"161361
+..\mathord
+...\fam1 p
+..\middle"142342
+..\mathord
+...\fam1 q
+..\middle"142342
+..\fraction, thickness = default
+..\\mathord
+..\.\fam1 q
+../\mathord
+../.\fam1 r
+..\right"162362
+.\right"162362
+this will be denominator of:
+\fraction, thickness = default
+\\left"161361
+\\mathord
+\.\fam1 q
+### math mode entered at line 514
+\left"161361
+\mathord
+.\fam1 p
+### math mode entered at line 513
+### restricted horizontal mode entered at line 512
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+l.525 ... \right]\showlists
+
+
+
+### math mode entered at line 514
+\left"161361
+\mathord
+.\fam1 p
+\mathinner
+.\left"161361
+.\fraction, thickness = default
+.\\mathord
+.\.\fam1 q
+./\mathord
+./.\fam1 r
+./\mathinner
+./.\left"161361
+./.\mathord
+./..\fam1 p
+./.\middle"142342
+./.\mathord
+./..\fam1 q
+./.\middle"142342
+./.\mathord
+./..\fam1 q
+./.\mathinner
+./..\left"161361
+./..\mathord
+./...\fam1 p
+./..\middle"142342
+./..\mathord
+./...\fam1 q
+./..\middle"142342
+./..\fraction, thickness = default
+./..\\mathord
+./..\.\fam1 q
+./../\mathord
+./../.\fam1 r
+./..\right"162362
+./.\right"162362
+.\right"162362
+### math mode entered at line 513
+### restricted horizontal mode entered at line 512
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+l.526 \right]\showlists
+
+
+
+### math mode entered at line 513
+\mathinner
+.\left"161361
+.\mathord
+..\fam1 p
+.\mathinner
+..\left"161361
+..\fraction, thickness = default
+..\\mathord
+..\.\fam1 q
+../\mathord
+../.\fam1 r
+../\mathinner
+../.\left"161361
+../.\mathord
+../..\fam1 p
+../.\middle"142342
+../.\mathord
+../..\fam1 q
+../.\middle"142342
+../.\mathord
+../..\fam1 q
+../.\mathinner
+../..\left"161361
+../..\mathord
+../...\fam1 p
+../..\middle"142342
+../..\mathord
+../...\fam1 q
+../..\middle"142342
+../..\fraction, thickness = default
+../..\\mathord
+../..\.\fam1 q
+../../\mathord
+../../.\fam1 r
+../..\right"162362
+../.\right"162362
+..\right"162362
+.\right"162362
+### restricted horizontal mode entered at line 512
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+l.527 \right]\showlists
+
+
+
+### restricted horizontal mode entered at line 512
+\mathon
+\hbox(30.99977+16.99977)x80.99994
+.\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+..\bigtrip a
+.\trip p
+.\glue(\thinmuskip) 4.99988 plus 0.99997
+.\hbox(30.99977+16.99977)x63.00005
+..\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+...\bigtrip a
+..\hbox(8.5+16.49994)x50.00003
+...\hbox(0.0+0.0)x0.0, shifted -7.0
+...\vbox(8.5+16.49994)x50.00003
+....\hbox(0.0+0.0)x50.00003, glue set 25.00002fil
+.....\glue 0.0 plus 1.0fil minus 1.0fil
+.....\trip q
+.....\glue 0.0 plus 1.0fil minus 1.0fil
+....\kern1.0
+....\rule(1.0+0.0)x*
+....\kern1.0
+....\hbox(17.99997+3.99997)x50.00003
+.....\trip r
+.....\hbox(17.99997+3.99997)x50.00003
+......\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+.......\bigtrip a
+......\trip p
+......\hbox(16.0+4.00002)x6.0, shifted -1.0
+.......\bigtrip B
+......\trip q
+......\hbox(16.0+4.00002)x6.0, shifted -1.0
+.......\bigtrip B
+......\trip q
+......\hbox(17.0+3.00002)x25.00002
+.......\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+........\bigtrip a
+.......\trip p
+.......\hbox(16.0+4.00002)x6.0, shifted -1.0
+........\bigtrip B
+.......\trip q
+.......\hbox(16.0+4.00002)x6.0, shifted -1.0
+........\bigtrip B
+.......\hbox(8.5+2.0)x0.0
+........\hbox(0.0+0.0)x0.0, shifted -7.0
+........\vbox(8.5+2.0)x0.0
+.........\hbox(0.0+0.0)x0.0
+..........\trip q
+.........\kern1.0
+.........\rule(1.0+0.0)x*
+.........\kern8.5
+.........\hbox(0.0+0.0)x0.0
+..........\trip r
+........\hbox(0.0+0.0)x0.0, shifted -7.0
+.......\vbox(7.0+11.0)x7.0, shifted -9.0
+........\hbox(7.0+1.0)x3.0
+.........\trip A
+........\hbox(8.0+2.0)x3.0
+.........\trip B
+......\vbox(-1.00002+22.99995)x7.0, shifted -18.99998
+.......\hbox(-1.00002+2.0)x7.0
+........\trip ^^@
+.......\hbox(-1.00002+2.0)x7.0
+........\trip ^^@
+.......\hbox(7.0+1.0)x3.0
+........\trip A
+.......\hbox(-1.00002+2.0)x7.0
+........\trip ^^@
+.......\hbox(-1.00002+2.0)x7.0
+........\trip ^^@
+.......\hbox(8.0+2.0)x3.0
+........\trip B
+...\hbox(0.0+0.0)x0.0, shifted -7.0
+..\vbox(-1.00002+48.99956)x7.0, shifted -31.99979
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(7.0+1.0)x3.0
+....\trip A
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(-1.00002+2.0)x7.0
+....\trip ^^@
+...\hbox(8.0+2.0)x3.0
+....\trip B
+.\vbox(-1.00002+48.99956)x7.0, shifted -31.99979
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(7.0+1.0)x3.0
+...\trip A
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(8.0+2.0)x3.0
+...\trip B
+\mathoff
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+l.528 $\showlists
+
+
+
+### restricted horizontal mode entered at line 530
+\mathon
+\hbox(17.0+3.00002)x19.00002
+.\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+..\bigtrip a
+.\hbox(16.0+4.00002)x6.0, shifted -1.0
+..\bigtrip B
+.\trip p
+.\hbox(0.0+0.0)x0.0, shifted -16.5
+.\vbox(-1.00002+20.99998)x7.0, shifted -18.0
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(7.0+1.0)x3.0
+...\trip A
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(8.0+2.0)x3.0
+...\trip B
+\mathoff
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+l.532 ...box{}\right]$\showlists
+ }
+
+
+### restricted horizontal mode entered at line 533
+\mathon
+\hbox(17.99997+3.99997)x19.00002
+.\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+..\bigtrip a
+.\hbox(0.0+0.0)x0.0, shifted 3.0
+.\hbox(16.0+4.00002)x6.0, shifted -1.0
+..\bigtrip B
+.\trip s
+.\vbox(-1.00002+22.99995)x7.0, shifted -18.99998
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(7.0+1.0)x3.0
+...\trip A
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(-1.00002+2.0)x7.0
+...\trip ^^@
+..\hbox(8.0+2.0)x3.0
+...\trip B
+\mathoff
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+l.535 \right]$\showlists
+ }
+
+Checking TeX--XeT enhancements:
+
+\endL or \endR problem (0 missing, 1 extra) in paragraph at lines 548--5
+48
+[][][][][][]
+
+\hbox(0.0+0.0)x10.0, glue set 3.5fil
+.\hbox(0.0+0.0)x0.5
+.\beginL
+.\beginR
+.\kern 3.0
+.\penalty 0
+.\hbox(0.0+0.0)x0.0
+.\kern 3.0
+.\kern 0.0
+.\endR
+.\endL
+.\penalty 10000
+.\glue(\parfillskip) 0.0 plus 1.0fil
+.\glue(\rightskip) 0.0
+
+
+\endL or \endR problem (0 missing, 2 extra) in paragraph at lines 549--5
+49
+[]
+
+\hbox(0.0+0.0)x10.0, glue set 5.5fil
+.\hbox(0.0+0.0)x0.5
+.\kern 0.0
+.\kern 4.0
+.\kern 0.0
+.\penalty 10000
+.\glue(\parfillskip) 0.0 plus 1.0fil
+.\glue(\rightskip) 0.0
+
+> \box0=
+\vbox(0.0+0.0)x10.0
+.\hbox(0.0+0.0)x10.0, glue set 8.5fil
+..\hbox(0.0+0.0)x0.5
+..\beginL
+..\kern 1.0
+..\penalty 10000
+..\glue(\parfillskip) 0.0 plus 1.0fil
+..\endL
+..\glue(\rightskip) 0.0
+.\glue(\parskip) 0.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x10.0, glue set 7.5fil
+..\hbox(0.0+0.0)x0.5
+..\beginR
+..\kern 2.0
+..\penalty 10000
+..\glue(\parfillskip) 0.0 plus 1.0fil
+..\endR
+..\glue(\rightskip) 0.0
+.\glue(\parskip) 0.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x10.0, glue set 3.5fil
+..\hbox(0.0+0.0)x0.5
+..\beginL
+..\beginR
+..\kern 3.0
+..\penalty 0
+..\hbox(0.0+0.0)x0.0
+..\kern 3.0
+..\kern 0.0
+..\endR
+..\endL
+..\penalty 10000
+..\glue(\parfillskip) 0.0 plus 1.0fil
+..\glue(\rightskip) 0.0
+.\glue(\parskip) 0.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x10.0, glue set 5.5fil
+..\hbox(0.0+0.0)x0.5
+..\kern 0.0
+..\kern 4.0
+..\kern 0.0
+..\penalty 10000
+..\glue(\parfillskip) 0.0 plus 1.0fil
+..\glue(\rightskip) 0.0
+
+! OK.
+l.550 \showbox0
+
+
+Checking optimized \aftergroup:
+! Undefined control sequence.
+<to be read again> \x
+ }{\relax
+l.562 ...roup{\aftergroup\relax}
+ }
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+Checking \showifs, \currentiftype, \currentiflevel, and \currentifbranch
+:
+\currentifbranch OK
+current if level (l.581): 0
+current if level (l.582): 1
+current if level (l.583): 2
+current if type (l.601): \if!NONE
+current if branch (l.601): no branch
+current if type (l.602): \if
+current if branch (l.602): true branch
+current if type (l.602): \unless\if
+current if branch (l.602): false branch
+current if type (l.603): \if
+current if branch (l.603): false branch
+current if type (l.603): \unless\if
+current if branch (l.603): true branch
+current if type (l.604): \ifcat
+current if branch (l.604): true branch
+current if type (l.604): \unless\ifcat
+current if branch (l.604): false branch
+current if type (l.605): \ifcat
+current if branch (l.605): false branch
+current if type (l.605): \unless\ifcat
+current if branch (l.605): true branch
+current if type (l.606): \ifnum
+current if branch (l.606): true branch
+current if type (l.606): \unless\ifnum
+current if branch (l.606): true branch
+current if type (l.607): \ifdim
+current if branch (l.607): false branch
+current if type (l.607): \unless\ifdim
+current if branch (l.607): true branch
+current if type (l.608): \ifodd
+current if branch (l.608): true branch
+current if type (l.608): \unless\ifodd
+current if branch (l.608): false branch
+current if type (l.610): \ifvmode
+current if branch (l.610): true branch
+current if type (l.610): \unless\ifvmode
+current if branch (l.610): false branch
+current if type (l.613): \ifhmode
+current if branch (l.613): true branch
+current if type (l.613): \unless\ifhmode
+current if branch (l.613): false branch
+current if type (l.615): \ifmmode
+current if branch (l.615): true branch
+current if type (l.615): \unless\ifmmode
+current if branch (l.615): false branch
+current if type (l.617): \ifinner
+current if branch (l.617): true branch
+current if type (l.619): \unless\ifinner
+current if branch (l.619): true branch
+current if type (l.620): \ifvoid
+current if branch (l.620): true branch
+current if type (l.620): \unless\ifvoid
+current if branch (l.620): true branch
+current if type (l.621): \ifhbox
+current if branch (l.621): true branch
+current if type (l.621): \unless\ifhbox
+current if branch (l.621): true branch
+current if type (l.622): \ifvbox
+current if branch (l.622): true branch
+current if type (l.622): \unless\ifvbox
+current if branch (l.622): true branch
+current if type (l.623): \ifx
+current if branch (l.623): false branch
+current if type (l.623): \unless\ifx
+current if branch (l.623): true branch
+current if type (l.624): \ifeof
+current if branch (l.624): true branch
+current if type (l.624): \unless\ifeof
+current if branch (l.624): false branch
+current if type (l.625): \iftrue
+current if branch (l.625): true branch
+current if type (l.625): \unless\iftrue
+current if branch (l.625): false branch
+current if type (l.626): \iffalse
+current if branch (l.626): false branch
+current if type (l.626): \unless\iffalse
+current if branch (l.626): true branch
+current if type (l.627): \ifcase
+current if branch (l.627): true branch
+current if type (l.627): \ifcase
+current if branch (l.627): false branch
+current if type (l.628): \ifdefined
+current if branch (l.628): true branch
+current if type (l.628): \unless\ifdefined
+current if branch (l.628): true branch
+current if type (l.629): \ifcsname
+current if branch (l.629): true branch
+current if type (l.630): \unless\ifcsname
+current if branch (l.630): true branch
+current if type (l.631): \iffontchar
+current if branch (l.631): true branch
+current if type (l.631): \unless\iffontchar
+current if branch (l.631): true branch
+{math mode: \ifcsname: (level 41) entered on line 647}
+{\unless\ifcsname: (level 42) entered on line 647}
+{\iffontchar: (level 43) entered on line 648}
+{\unless\iffontchar: (level 44) entered on line 648}
+
+### level 44: \unless\iffontchar entered on line 648
+### level 43: \iffontchar entered on line 648
+### level 42: \unless\ifcsname entered on line 647
+### level 41: \ifcsname entered on line 647
+### level 40: \unless\ifdefined entered on line 645
+### level 39: \ifdefined entered on line 645
+### level 38: \ifcase\else entered on line 644
+### level 37: \ifcase entered on line 644
+### level 36: \unless\iffalse entered on line 643
+### level 35: \iffalse\else entered on line 643
+### level 34: \unless\iftrue\else entered on line 643
+### level 33: \iftrue entered on line 643
+### level 32: \unless\ifx entered on line 642
+### level 31: \ifx\else entered on line 642
+### level 30: \unless\ifeof\else entered on line 641
+### level 29: \ifeof entered on line 641
+### level 28: \unless\ifvbox entered on line 641
+### level 27: \ifvbox entered on line 641
+### level 26: \unless\ifhbox entered on line 640
+### level 25: \ifhbox entered on line 640
+### level 24: \unless\ifvoid entered on line 640
+### level 23: \ifvoid entered on line 640
+### level 22: \unless\ifinner\else entered on line 639
+### level 21: \ifinner entered on line 639
+### level 20: \unless\ifmmode\else entered on line 639
+### level 19: \ifmmode entered on line 639
+### level 18: \unless\ifhmode\else entered on line 638
+### level 17: \ifhmode entered on line 638
+### level 16: \unless\ifvmode\else entered on line 637
+### level 15: \ifvmode entered on line 637
+### level 14: \unless\ifodd\else entered on line 636
+### level 13: \ifodd entered on line 636
+### level 12: \unless\ifdim entered on line 635
+### level 11: \ifdim\else entered on line 635
+### level 10: \unless\ifnum entered on line 635
+### level 9: \ifnum entered on line 635
+### level 8: \unless\ifcat entered on line 634
+### level 7: \ifcat\else entered on line 634
+### level 6: \unless\ifcat\else entered on line 634
+### level 5: \ifcat entered on line 634
+### level 4: \unless\if entered on line 633
+### level 3: \if\else entered on line 633
+### level 2: \unless\if\else entered on line 633
+### level 1: \if entered on line 633
+
+! OK.
+l.649 \showifs
+ % <== show 44 nested ifs
+
+{\fi: \unless\iffontchar (level 44) entered on line 648}
+{\fi: \iffontchar (level 43) entered on line 648}
+{\fi: \unless\ifcsname (level 42) entered on line 647}
+{\fi: \ifcsname (level 41) entered on line 647}
+Checking \iffontchar, \fontcharwd, etc.:
+! Missing font identifier.
+<to be read again>
+ \relax
+...
+l.672 \iffontchar \else
+ \fi % <== missing font identifie...
+I was looking for a control sequence whose
+current meaning has been defined by \font.
+
+! Missing number, treated as zero.
+<to be read again>
+ \relax
+...
+l.672 \iffontchar \else
+ \fi % <== missing font identifie...
+A number should have been here; I inserted `0'.
+(If you can't figure out why I needed to see a number,
+look up `weird error' in the index to The TeXbook.)
+
+! Bad character code (-1).
+l.673 ...ffontchar\textfont2 -1
+ \else \fi % <== bad charac...
+A character number must be between 0 and 255.
+I changed this one to zero.
+
+! Bad character code (256).
+l.674 \iffontchar\font 256
+ \else \fi % <== bad character...
+A character number must be between 0 and 255.
+I changed this one to zero.
+
+! You can't use `\fontcharwd' in vertical mode.
+l.675 \fontcharwd
+ \fontcharht \fontchardp \fontcharic % ...
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\fontcharht' in vertical mode.
+l.675 \fontcharwd \fontcharht
+ \fontchardp \fontcharic % ...
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\fontchardp' in vertical mode.
+l.675 ...\fontcharht \fontchardp
+ \fontcharic % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\fontcharic' in vertical mode.
+l.675 ...\fontchardp \fontcharic
+ % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+Font \font character A: wd=2.0pt ht=7.0pt dp=1.0pt ic=1.0pt
+Font \textfont1 character B: wd=3.0pt ht=8.0pt dp=2.0pt
+Font \scriptfont2 character B: wd=1.5pt ht=4.0pt dp=1.0pt
+Font \scriptscriptfont3 character B: wd=6.0pt ht=16.0pt dp=4.00002pt
+Font \trip character 7:
+Font \trip character D does not exist
+Font \nullfont character D does not exist
+Font \font has 23 characters.
+Font \trip has 23 characters.
+Font \nullfont has 0 characters.
+Checking \parshapelength, \parshapeindent, and \parshapedimen:
+! You can't use `\parshapelength' in vertical mode.
+l.699 \parshapelength
+ \parshapeindent \parshapedimen % <...
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\parshapeindent' in vertical mode.
+l.699 ...elength \parshapeindent
+ \parshapedimen % <== can'...
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\parshapedimen' in vertical mode.
+l.699 ...peindent \parshapedimen
+ % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+Parshape test 1 OK
+Parshape test 2 OK
+Parshape test 3 OK
+Parshape test 4 OK
+Checking \numexpr, \dimexpr, \glueexpr, and \muexpr:
+! You can't use `\numexpr' in vertical mode.
+l.763 \numexpr
+ \dimexpr \glueexpr \muexpr % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\dimexpr' in vertical mode.
+l.763 \numexpr \dimexpr
+ \glueexpr \muexpr % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\glueexpr' in vertical mode.
+l.763 ...expr \dimexpr \glueexpr
+ \muexpr % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\muexpr' in vertical mode.
+l.763 ...mexpr \glueexpr \muexpr
+ % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! Missing ) inserted for expression.
+<to be read again>
+ \9
+l.765 ...unt43=\numexpr ( ( 2 \9
+ \dimen43=\dimexpr ...
+I was expecting to see `+', `-', `*', `/', or `)'. Didn't.
+
+! Missing ) inserted for expression.
+<to be read again>
+ \9
+l.765 ...unt43=\numexpr ( ( 2 \9
+ \dimen43=\dimexpr ...
+I was expecting to see `+', `-', `*', `/', or `)'. Didn't.
+
+! Missing ) inserted for expression.
+<to be read again>
+ \9
+l.765 ...men43=\dimexpr ( 3pt \9
+
+I was expecting to see `+', `-', `*', `/', or `)'. Didn't.
+
+\numexpr \count 43=2
+\dimexpr \dimen 43=3.0pt
+\glueexpr \skip 43=4.0pt plus 3.0fil
+\muexpr \muskip 43=5.0mu minus 1.0mu
+{into \tracingassigns=5}
+{changing \count44=0}
+{into \count44=2147483647}
+{changing \dimen44=0.0pt}
+{into \dimen44=16383.99998pt}
+{changing \count44=2147483647}
+{into \count44=-2147483647}
+{changing \dimen44=16383.99998pt}
+{into \dimen44=-16383.99998pt}
+{changing \count44=-2147483647}
+{into \count44=2147450880}
+{changing \dimen44=-16383.99998pt}
+{into \dimen44=16383.5pt}
+{changing \skip44=0.0pt}
+{into \skip44=16383.99998pt}
+{changing \skip44=16383.99998pt}
+{into \skip44=16384.0pt}
+! Dimension too large.
+l.778 \dimen45=\skip44
+ \dimen45=\dimexpr...
+I can't work with sizes bigger than about 19 feet.
+Continue and I'll use the largest value I can.
+
+{changing \dimen45=0.0pt}
+{into \dimen45=16383.99998pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.778 ...5=\dimexpr1sp*\skip44\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{changing \dimen45=16383.99998pt}
+{into \dimen45=0.0pt}
+{changing \dimen44=16383.5pt}
+{into \dimen44=-16383.99998pt}
+{changing \dimen44=-16383.99998pt}
+{into \dimen44=-16384.0pt}
+! Dimension too large.
+l.780 \dimen45=\skip44
+ \dimen45=\dimexpr...
+I can't work with sizes bigger than about 19 feet.
+Continue and I'll use the largest value I can.
+
+{changing \dimen45=0.0pt}
+{into \dimen45=16383.99998pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.780 ...5=\dimexpr1sp*\skip44\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{changing \dimen45=16383.99998pt}
+{into \dimen45=0.0pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.781 ...4=\numexpr"7FFFFFFE+2\9
+ \dimen44=\dimexpr"3FFFFFF...
+I can't evaluate this expression,
+since the result is out of range.
+
+{changing \count44=2147450880}
+{into \count44=0}
+! Arithmetic overflow.
+<recently read> \9
+
+l.781 ...imexpr"3FFFFFFEsp+2sp\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{changing \dimen44=-16384.0pt}
+{into \dimen44=0.0pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.782 ...=\numexpr-"7FFFFFFE-2\9
+ \dimen44=\dimexpr-"3FFFFFF...
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \count44=0}
+! Arithmetic overflow.
+<recently read> \9
+
+l.782 ...mexpr-"3FFFFFFEsp-2sp\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \dimen44=0.0pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.783 ...=\numexpr"10000*"8000\9
+ \dimen44=\dimexpr"8000sp*"...
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \count44=0}
+! Arithmetic overflow.
+<recently read> \9
+
+l.783 ...\dimexpr"8000sp*"8000\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \dimen44=0.0pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.784 ...\numexpr"10000*-"8000\9
+ \dimen44=\dimexpr"8000sp*-"...
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \count44=0}
+! Arithmetic overflow.
+<recently read> \9
+
+l.784 ...dimexpr"8000sp*-"8000\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \dimen44=0.0pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.785 ...\numexpr-"10000*"8000\9
+ \dimen44=\dimexpr-"8000sp*"...
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \count44=0}
+! Arithmetic overflow.
+<recently read> \9
+
+l.785 ...dimexpr-"8000sp*"8000\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \dimen44=0.0pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.786 ...numexpr-"10000*-"8000\9
+ \dimen44=\dimexpr-"8000sp*-"...
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \count44=0}
+! Arithmetic overflow.
+<recently read> \9
+
+l.786 ...imexpr-"8000sp*-"8000\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \dimen44=0.0pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.787 \count44=\numexpr0/0\9
+ \dimen44=\dimexpr...
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \count44=0}
+! Arithmetic overflow.
+<recently read> \9
+
+l.787 ...dimen44=\dimexpr0pt/0\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \dimen44=0.0pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.788 \count44=\numexpr1/0\9
+ \dimen44=\dimexpr...
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \count44=0}
+! Arithmetic overflow.
+<recently read> \9
+
+l.788 ...dimen44=\dimexpr1pt/0\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \dimen44=0.0pt}
+! Arithmetic overflow.
+<recently read> \9
+
+l.789 ...\count44=\numexpr-1/0\9
+ \dimen44=\dimexpr-...
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \count44=0}
+! Arithmetic overflow.
+<recently read> \9
+
+l.789 ...imen44=\dimexpr-1pt/0\9
+
+I can't evaluate this expression,
+since the result is out of range.
+
+{reassigning \dimen44=0.0pt}
+{into \tracingassigns=5}
+{changing \skip93=0.0pt}
+{into \skip93=3.0pt minus 1.0fil}
+{changing \skip93=3.0pt minus 1.0fil}
+{into \skip93=3.0pt minus 1.0fil}
+{changing \skip93=3.0pt minus 1.0fil}
+{into \skip93=3.0pt minus 1.0fil}
+{reassigning \skip93=3.0pt minus 1.0fil}
+{changing \skip93=3.0pt minus 1.0fil}
+{into \skip93=3.0pt plus 1.0fil}
+{changing \skip93=3.0pt plus 1.0fil}
+{into \skip93=3.0pt plus 1.0fil}
+{reassigning \skip93=3.0pt plus 1.0fil}
+{changing \skip93=3.0pt plus 1.0fil}
+{into \skip93=2.0pt plus -1.0fil minus 1.0fil}
+{changing \skip93=2.0pt plus -1.0fil minus 1.0fil}
+{into \skip93=2.0pt plus -1.0fil minus 1.0fil}
+{reassigning \skip93=2.0pt plus -1.0fil minus 1.0fil}
+{changing \skip93=2.0pt plus -1.0fil minus 1.0fil}
+{into \skip93=0.0pt plus 1.0fil minus 1.0fil}
+{changing \skip93=0.0pt plus 1.0fil minus 1.0fil}
+{into \skip93=1.0pt plus 2.0fil minus 1.0fil}
+{changing \skip93=1.0pt plus 2.0fil minus 1.0fil}
+{into \skip93=5.0pt minus 1.0fil}
+Expr quotient rounding 1 OK
+Expr quotient rounding 2 OK
+Expr quotient rounding 3 OK
+Expr quotient rounding 4 OK
+! Incompatible glue units.
+<recently read> \9
+
+...
+l.829 \15{32}{5}{6}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+<to be read again>
+ p
+...
+l.829 \15{32}{5}{6}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+<recently read> \relax
+
+...
+l.829 \15{32}{5}{6}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+Expr quotient rounding 5 OK
+! Incompatible glue units.
+<recently read> \9
+
+...
+l.830 \16{33}{5}{7}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+<to be read again>
+ p
+...
+l.830 \16{33}{5}{7}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+<recently read> \relax
+
+...
+l.830 \16{33}{5}{7}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+Expr quotient rounding 6 OK
+! Incompatible glue units.
+<recently read> \9
+
+...
+l.831 \17{25}{4}{6}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+<to be read again>
+ p
+...
+l.831 \17{25}{4}{6}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+<recently read> \relax
+
+...
+l.831 \17{25}{4}{6}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+Expr quotient rounding 7 OK
+! Incompatible glue units.
+<recently read> \9
+
+...
+l.832 \18{26}{4}{7}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+<to be read again>
+ p
+...
+l.832 \18{26}{4}{7}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+<recently read> \relax
+
+...
+l.832 \18{26}{4}{7}
+ % <== three mu_error's (! Incompatibl...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+Expr quotient rounding 8 OK
+Expr fraction rounding 1 OK
+Expr fraction rounding 2 OK
+! Arithmetic overflow.
+<to be read again>
+ =
+\1...\fi \ifdim \dimexpr 1sp*#6=
+ \dimexpr (#3sp)*(#4)/(#5)\els...
+l.860 ...1 "7FFFFFFF 2 "40000000
+
+I can't evaluate this expression,
+since the result is out of range.
+
+! Arithmetic overflow.
+<inserted text> \relax
+
+<to be read again>
+ \else
+\1...expr (#3sp)*(#4)/(#5)\else
+ \2#2 \fi
+l.860 ...1 "7FFFFFFF 2 "40000000
+
+I can't evaluate this expression,
+since the result is out of range.
+
+Expr fraction rounding 3 OK
+[1]
+Memory usage before: 51&320; after: 44&320; still untouched: 680
+[1]
+Memory usage before: 51&320; after: 44&320; still untouched: 680
+Checking \mutoglue and \gluetomu:
+! You can't use `\mutoglue' in vertical mode.
+l.903 \mutoglue
+ \gluetomu % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\gluetomu' in vertical mode.
+l.903 \mutoglue \gluetomu
+ % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! Incompatible glue units.
+l.905 ...kip2=\gluetomu\muskip1
+ % <== two mu_error's (! Inco...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+l.905 ...kip2=\gluetomu\muskip1
+ % <== two mu_error's (! Inco...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+l.906 ...uskip2=\mutoglue\skip1
+ % <== two mu_error's (! Inco...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+! Incompatible glue units.
+l.906 ...uskip2=\mutoglue\skip1
+ % <== two mu_error's (! Inco...
+I'm going to assume that 1mu=1pt when they're mixed.
+
+{into \tracingassigns=1}
+{changing \skip1=9.0pt}
+{into \skip1=1.0pt plus -2.0pt minus -3.0fil}
+{changing \muskip1=9.0mu}
+{into \muskip1=1.0mu plus -2.0mu minus -3.0fil}
+{changing \skip2=9.0pt}
+{into \skip2=-4.0pt plus 5.0fill minus 6.0filll}
+{changing \muskip2=9.0mu}
+{into \muskip2=-4.0mu plus 5.0fill minus 6.0filll}
+{changing \skip3=0.0pt}
+{into \skip3=-1.0pt plus 2.0pt minus 3.0fil}
+{changing \muskip3=0.0mu}
+{into \muskip3=-1.0mu plus 2.0mu minus 3.0fil}
+{changing \skip4=0.0pt}
+{into \skip4=4.0pt plus -5.0fill minus -6.0filll}
+{changing \muskip4=0.0mu}
+{into \muskip4=4.0mu plus -5.0fill minus -6.0filll}
+Checking (mu)glue identity:
+{changing \1=undefined}
+{into \1=\relax}
+{changing \1=\relax}
+{into \1=\skip32767}
+{changing \skip32767=0.0pt}
+{into \skip32767=7.0pt}
+{changing \2=undefined}
+{into \2=\relax}
+{changing \2=\relax}
+{into \2=\muskip32766}
+{changing \muskip32766=0.0mu}
+{into \muskip32766=7.0mu}
+{changing \tracingassigns=1}
+{into \tracingassigns=458752}
+{reassigning \skip32767=7.0pt}
+{reassigning \muskip32766=7.0mu}
+{changing \tracingassigns=458752}
+Checking \gluestretchorder, \glueshrinkorder, \gluestretch, and \glueshr
+ink:
+! You can't use `\gluestretchorder' in vertical mode.
+l.930 \gluestretchorder
+ \gluestretch % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\gluestretch' in vertical mode.
+l.930 ...retchorder \gluestretch
+ % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\glueshrinkorder' in vertical mode.
+l.931 \glueshrinkorder
+ \glueshrink % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! You can't use `\glueshrink' in vertical mode.
+l.931 ...shrinkorder \glueshrink
+ % <== can't use
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+Checking sparse arrays:
+! Bad register code (-1).
+<to be read again>
+ \countdef
+...
+l.968 \2\countdef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (32768).
+<to be read again>
+ \countdef
+...
+l.968 \2\countdef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+\count32767=0.
+! Bad register code (-1).
+<to be read again>
+ \dimendef
+...
+l.969 \2\dimendef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (32768).
+<to be read again>
+ \dimendef
+...
+l.969 \2\dimendef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+\dimen32767=0.0pt.
+! Bad register code (-1).
+<to be read again>
+ \skipdef
+...
+l.970 \2\skipdef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (32768).
+<to be read again>
+ \skipdef
+...
+l.970 \2\skipdef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+\skip32767=0.0pt.
+! Bad register code (-1).
+<to be read again>
+ \muskipdef
+...
+l.971 \2\muskipdef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (32768).
+<to be read again>
+ \muskipdef
+...
+l.971 \2\muskipdef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+\muskip32767=0.0mu.
+! Bad register code (-1).
+<to be read again>
+ \toksdef
+...
+l.972 \2\toksdef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (32768).
+<to be read again>
+ \toksdef
+...
+l.972 \2\toksdef
+ % Bad register code (-1) ...and (32768).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+\toks32767=.
+> \9=\dimen256.
+l.979 ...8 \let\8=\relax \show\9
+
+
+{restoring \9=undefined}
+{restoring \8=undefined}
+{restoring \skip22=0.0pt}
+{restoring \dimen21=0.0pt}
+{restoring \muskip2200=0.0mu}
+{restoring \dimen2100=0.0pt}
+{restoring \count2000=0}
+{restoring \count20=0}
+testing count registers ...
+{into \tracingassigns=1}
+{reassigning \count2000=0}
+{restoring \tracingassigns=0}
+\count2000=0,
+ \count2001=5,
+ \count2002=7,
+ \count2002=7.
+\count2000=5,
+ \count2002=12,
+ \count2002=12.
+\count2000=50,
+ \count2002=120,
+ \count2002=120.
+\count2000=10,
+ \count2002=24,
+ \count2002=24.
+{into \tracingassigns=1}
+{globally changing \count2002=24}
+{into \count2002=5}
+{changing \count2002=5}
+{into \count2002=7}
+{globally changing \count2002=7}
+{into \count2002=0}
+{restoring \tracingassigns=0}
+{restoring \1=undefined}
+{retaining \count2002=0}
+{restoring \count2000=0}
+{retaining \count2002=0}
+{restoring \count2001=0}
+testing dimen registers ...
+{into \tracingassigns=1}
+{reassigning \dimen2000=0.0pt}
+{restoring \tracingassigns=0}
+\dimen2000=0.0pt,
+ \dimen2001=2.5pt,
+ \dimen2002=3.5pt,
+ \dimen2002=3.5pt.
+\dimen2000=2.5pt,
+ \dimen2002=6.0pt,
+ \dimen2002=6.0pt.
+\dimen2000=25.0pt,
+ \dimen2002=60.0pt,
+ \dimen2002=60.0pt.
+\dimen2000=5.0pt,
+ \dimen2002=12.0pt,
+ \dimen2002=12.0pt.
+{into \tracingassigns=1}
+{globally changing \dimen2002=12.0pt}
+{into \dimen2002=2.5pt}
+{changing \dimen2002=2.5pt}
+{into \dimen2002=3.5pt}
+{globally changing \dimen2002=3.5pt}
+{into \dimen2002=0.0pt}
+{restoring \tracingassigns=0}
+{restoring \1=undefined}
+{retaining \dimen2002=0.0pt}
+{restoring \dimen2000=0.0pt}
+{retaining \dimen2002=0.0pt}
+{restoring \dimen2001=0.0pt}
+testing skip registers ...
+{into \tracingassigns=1}
+{reassigning \skip2000=0.0pt}
+{restoring \tracingassigns=0}
+\skip2000=0.0pt,
+ \skip2001=2.5pt plus 1.0fil,
+ \skip2002=3.5pt minus 1.0fill,
+ \skip2002=3.5pt minus 1.0fill.
+\skip2000=2.5pt plus 1.0fil,
+ \skip2002=6.0pt plus 1.0fil minus 1.0fill,
+ \skip2002=6.0pt plus 1.0fil minus 1.0fill.
+\skip2000=25.0pt plus 10.0fil,
+ \skip2002=60.0pt plus 10.0fil minus 10.0fill,
+ \skip2002=60.0pt plus 10.0fil minus 10.0fill.
+\skip2000=5.0pt plus 2.0fil,
+ \skip2002=12.0pt plus 2.0fil minus 2.0fill,
+ \skip2002=12.0pt plus 2.0fil minus 2.0fill.
+{into \tracingassigns=1}
+{globally changing \skip2002=12.0pt plus 2.0fil minus 2.0fill}
+{into \skip2002=2.5pt plus 1.0fil}
+{changing \skip2002=2.5pt plus 1.0fil}
+{into \skip2002=3.5pt minus 1.0fill}
+{globally changing \skip2002=3.5pt minus 1.0fill}
+{into \skip2002=0.0pt}
+{restoring \tracingassigns=0}
+{restoring \1=undefined}
+{retaining \skip2002=0.0pt}
+{restoring \skip2000=0.0pt}
+{retaining \skip2002=0.0pt}
+{restoring \skip2001=0.0pt}
+testing muskip registers ...
+{into \tracingassigns=1}
+{reassigning \muskip2000=0.0mu}
+{restoring \tracingassigns=0}
+\muskip2000=0.0mu,
+ \muskip2001=2.5mu plus 1.0fil,
+ \muskip2002=3.5mu minus 1.0fill,
+ \muskip2002=3.5mu minus 1.0fill.
+\muskip2000=2.5mu plus 1.0fil,
+ \muskip2002=6.0mu plus 1.0fil minus 1.0fill,
+ \muskip2002=6.0mu plus 1.0fil minus 1.0fill.
+\muskip2000=25.0mu plus 10.0fil,
+ \muskip2002=60.0mu plus 10.0fil minus 10.0fill,
+ \muskip2002=60.0mu plus 10.0fil minus 10.0fill.
+\muskip2000=5.0mu plus 2.0fil,
+ \muskip2002=12.0mu plus 2.0fil minus 2.0fill,
+ \muskip2002=12.0mu plus 2.0fil minus 2.0fill.
+{into \tracingassigns=1}
+{globally changing \muskip2002=12.0mu plus 2.0fil minus 2.0fill}
+{into \muskip2002=2.5mu plus 1.0fil}
+{changing \muskip2002=2.5mu plus 1.0fil}
+{into \muskip2002=3.5mu minus 1.0fill}
+{globally changing \muskip2002=3.5mu minus 1.0fill}
+{into \muskip2002=0.0mu}
+{restoring \tracingassigns=0}
+{restoring \1=undefined}
+{retaining \muskip2002=0.0mu}
+{restoring \muskip2000=0.0mu}
+{retaining \muskip2002=0.0mu}
+{restoring \muskip2001=0.0mu}
+testing toks registers ...
+{into \tracingassigns=1}
+{reassigning \toks2000=}
+{restoring \tracingassigns=0}
+\toks2000=,
+ \toks2001=a b c,
+ \toks2002=d e f,
+ \toks2002=d e f.
+{into \tracingassigns=1}
+{reassigning \toks20=}
+{changing \toks21=}
+{into \toks21=a b c}
+{changing \toks2100=}
+{into \toks2100=d e f}
+{changing \toks2002=d e f}
+{into \toks2002=}
+{changing \toks2002=}
+{into \toks2002=a b c}
+{reassigning \toks2200=}
+{changing \toks2200=}
+{into \toks2200=a b c}
+{changing \toks2002=a b c}
+{into \toks2002=}
+{changing \toks2002=}
+{into \toks2002=a b c}
+{changing \toks2200=a b c}
+{into \toks2200=}
+{changing \toks2200=}
+{into \toks2200=a b c}
+{changing \toks30=}
+{into \toks30=a b c}
+{changing \toks30=a b c}
+{into \toks30=}
+{changing \toks30=}
+{into \toks30=a b c}
+{changing \toks3000=}
+{into \toks3000=a b c}
+{changing \toks3000=a b c}
+{into \toks3000=}
+{changing \toks3000=}
+{into \toks3000=a b c}
+{restoring \toks30=}
+{restoring \toks3000=}
+{restoring \toks2200=}
+{restoring \toks2002=d e f}
+{restoring \toks2100=}
+{restoring \toks21=}
+{restoring \tracingassigns=0}
+{into \tracingassigns=1}
+{globally changing \toks2002=d e f}
+{into \toks2002=a b c}
+{changing \toks2002=a b c}
+{into \toks2002=d e f}
+{globally changing \toks2002=d e f}
+{into \toks2002=}
+{restoring \tracingassigns=0}
+{restoring \1=undefined}
+{retaining \toks2002=}
+{retaining \toks2002=}
+{restoring \toks2001=}
+testing box registers ...
+! Bad mathchar (-1).
+<to be read again>
+ \mathchardef
+...
+l.1022 \2\mathchardef
+ % Bad mathchar (-1) ...and (32768).
+A mathchar number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad mathchar (32768).
+<to be read again>
+ \mathchardef
+...
+l.1022 \2\mathchardef
+ % Bad mathchar (-1) ...and (32768).
+A mathchar number must be between 0 and 32767.
+I changed this one to zero.
+
+\mathchar"7FFF=32767.
+! Bad register code (-1).
+<to be read again>
+ =
+l.1023 \setbox-1=
+ \copy32768 % Bad register code (-1) ...and...
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (32768).
+l.1023 \setbox-1=\copy32768
+ % Bad register code (-1) ...and...
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (32768).
+<to be read again>
+ =
+l.1024 \global\setbox32768=
+ \copy-1 % Bad register code (327...
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (-1).
+l.1024 ...l\setbox32768=\copy-1
+ % Bad register code (32768) ....
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (32768).
+<to be read again>
+ =
+l.1025 \wd32768=
+ \ht-1 % Bad register code (32768) ...and (-1).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (-1).
+l.1025 \wd32768=\ht-1
+ % Bad register code (32768) ...and (-1).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+! Bad register code (-1).
+l.1026 \showbox-1
+ % Bad register code (-1).
+A register number must be between 0 and 32767.
+I changed this one to zero.
+
+> \box0=void
+
+! OK.
+l.1026 \showbox-1
+ % Bad register code (-1).
+
+
+### vtop group (level 4) entered at line 1039 (\setbox32103=\vtop to7.0p
+t{)
+### vbox group (level 3) entered at line 1038 (\global\setbox32102=\vbox
+ to5.0pt{)
+### hbox group (level 2) entered at line 1037 (\setbox32101=\hbox to3.0p
+t{)
+### semi simple group (level 1) entered at line 1019 (\begingroup)
+### bottom level
+
+! OK.
+l.1040 \showgroups
+
+
+{restoring \box32103=void}
+> \box32100=void
+
+! OK.
+l.1044 \showbox32100
+
+
+> \box32101=
+\hbox(0.0+0.0)x3.0
+
+! OK.
+l.1045 \showbox32101
+
+
+\box32101=\hbox,wd=3.0pt.
+\box32102=\vbox,ht=5.0pt.
+\box32103=void.
+\box32101=\hbox,wd=3.0pt.
+\box32103=\hbox,wd=3.0pt.
+\box32102=void.
+\box32104=\vbox,ht=5.0pt.
+\box32101=\hbox,ht=2.0pt,wd=3.0pt.
+\box32102=void.
+\box32103=\hbox,dp=6.0pt,wd=3.0pt.
+\box32104=\vbox,ht=5.0pt,wd=8.0pt.
+\box32105=\hbox,ht=1.0pt,wd=5.0pt.
+\box32105=\hbox,ht=1.0pt,wd=5.0pt.
+\box32105=void.
+\box32105=void.
+\box32106=\hbox,ht=1.0pt,wd=10.0pt.
+\box32105=\vbox,ht=5.0pt,wd=1.0pt.
+\box32105=\vbox,ht=5.0pt,wd=1.0pt.
+\box32105=void.
+\box32105=void.
+\box32106=\vbox,ht=10.0pt,wd=1.0pt.
+\box32105=\vbox,ht=30.0pt.
+\box32106=\vbox,ht=10.0pt.
+\box32105=\vbox,ht=20.0pt.
+{restoring \box32106=void}
+{restoring \box32105=void}
+{restoring \box32104=void}
+{restoring \box32103=void}
+{restoring \box32101=void}
+Checking \lastlinefit:
+@firstpass
+[] []
+@ via @@0 b=371 p=0 d=137641
+@@1: line 1.0 t=137641 -> @@0
+[]
+@ via @@0 b=12 p=0 d=144
+@@2: line 1.2 t=144 -> @@0
+[]
+@ via @@1 b=371 p=0 d=137641
+@@3: line 2.0 t=275282 -> @@1
+[]
+@\par via @@1 b=12 p=-10000 d=144
+@\par via @@2 b=0 p=-10000 d=0
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=144 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x96.0
+.\hbox(0.0+0.0)x96.0, glue set - 0.5 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x96.0, glue set 31.0fill []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1079 \lastlinefit=-1 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x96.0, glue set 31.0fill
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 0.0 plus 1.0fill
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1079 \lastlinefit=-1 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=371 p=0 d=137641
+@@1: line 1.0 t=137641 s=31.0 g=20.0 -> @@0
+[]
+@ via @@0 b=12 p=0 d=144
+@@2: line 1.2 t=144 s=-4.0 g=8.0 -> @@0
+[]
+@ via @@1 b=371 p=0 d=137641
+@@3: line 2.0 t=275282 s=31.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=12 p=-10000 d=144
+@\par via @@2 b=2 p=-10000 d=4
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=148 s=31.0 a=-1.0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x96.0
+.\hbox(0.0+0.0)x96.0, glue set - 0.5 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x96.0, glue set - 0.25 []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1080 \lastlinefit=500 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x96.0, glue set - 0.25
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 32.0
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1080 \lastlinefit=500 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=371 p=0 d=137641
+@@1: line 1.0 t=137641 s=31.0 g=20.0 -> @@0
+[]
+@ via @@0 b=12 p=0 d=144
+@@2: line 1.2 t=144 s=-4.0 g=8.0 -> @@0
+[]
+@ via @@1 b=371 p=0 d=137641
+@@3: line 2.0 t=275282 s=31.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=12 p=-10000 d=144
+@\par via @@2 b=12 p=-10000 d=144
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=288 s=31.0 a=-2.0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x96.0
+.\hbox(0.0+0.0)x96.0, glue set - 0.5 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x96.0, glue set - 0.5 []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1081 \lastlinefit=1001 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x96.0, glue set - 0.5
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 33.0
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1081 \lastlinefit=1001 \1
+
+
+@firstpass
+[]
+@ via @@0 b=0 p=0 d=0
+@@1: line 1.2 t=0 -> @@0
+[]
+@ via @@0 b=0 p=0 d=0
+@ via @@1 b=0 p=0 d=0
+@@2: line 2.2 t=0 -> @@1
+[]
+@ via @@0 b=2 p=0 d=4
+@ via @@1 b=0 p=0 d=0
+@ via @@2 b=0 p=0 d=0
+@@3: line 3.2 t=0 -> @@2
+[]
+@ via @@1 b=2 p=0 d=4
+@ via @@2 b=0 p=0 d=0
+@ via @@3 b=0 p=0 d=0
+@@4: line 4.2 t=0 -> @@3
+[]
+@\par via @@2 b=2 p=-10000 d=4
+@\par via @@3 b=0 p=-10000 d=0
+@\par via @@4 b=0 p=-10000 d=0
+@@5: line 5.2- t=0 -> @@4
+
+> \box0=
+\vbox(0.0+0.0)x98.0
+.\hbox(0.0+0.0)x98.0, glue set 68.0fill []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x98.0, glue set 68.0fill []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x98.0, glue set 68.0fill []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x98.0, glue set 68.0fill []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x98.0, glue set 34.0fill []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1085 ... \lastlinefit=1000 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x98.0, glue set 34.0fill
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 0.0 plus 1.0fill
+.\glue(\rightskip) 0.0 plus 1.0fill
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1085 ... \lastlinefit=1000 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=449 p=0 d=201601
+@@1: line 1.0 t=201601 s=33.0 g=20.0 -> @@0
+[]
+@ via @@0 b=2 p=0 d=4
+@@2: line 1.2 t=4 s=-2.0 g=8.0 -> @@0
+[]
+@ via @@1 b=449 p=0 d=201601
+@@3: line 2.0 t=403202 s=33.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=2 p=-10000 d=4
+@\par via @@2 b=0 p=-10000 d=0
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=4 s=33.0 a=-0.5 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x98.0
+.\hbox(0.0+0.0)x98.0, glue set - 0.25 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x98.0, glue set - 0.125 []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1087 \lastlinefit=500 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x98.0, glue set - 0.125
+.\glue(\leftskip) 0.0 plus -1.0fill
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 33.5
+.\glue(\rightskip) 0.0 plus 1.0fill
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1087 \lastlinefit=500 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=449 p=0 d=201601
+@@1: line 1.0 t=201601 s=33.0 g=20.0 -> @@0
+[]
+@ via @@0 b=2 p=0 d=4
+@@2: line 1.2 t=4 s=-2.0 g=8.0 -> @@0
+[]
+@ via @@1 b=449 p=0 d=201601
+@@3: line 2.0 t=403202 s=33.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=2 p=-10000 d=4
+@\par via @@2 b=2 p=-10000 d=4
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=8 s=33.0 a=-1.0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x98.0
+.\hbox(0.0+0.0)x98.0, glue set - 0.25 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x98.0, glue set - 0.25 []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1089 \lastlinefit=1000 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x98.0, glue set - 0.25
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 34.0
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1089 \lastlinefit=1000 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=533 p=0 d=284089
+@@1: line 1.0 t=284089 -> @@0
+[]
+@ via @@0 b=0 p=0 d=0
+@@2: line 1.2 t=0 -> @@0
+[]
+@ via @@1 b=533 p=0 d=284089
+@@3: line 2.0 t=568178 -> @@1
+[]
+@\par via @@1 b=0 p=-10000 d=0
+@\par via @@2 b=0 p=-10000 d=0
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x100.0
+.\hbox(0.0+0.0)x100.0 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x100.0, glue set 35.0fill []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1091 \lastlinefit=0 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x100.0, glue set 35.0fill
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 0.0 plus 1.0fill
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1091 \lastlinefit=0 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=533 p=0 d=284089
+@@1: line 1.0 t=284089 s=35.0 g=20.0 -> @@0
+[]
+@ via @@0 b=0 p=0 d=0
+@@2: line 1.2 t=0 s=0.0 g=0.0 -> @@0
+[]
+@ via @@1 b=533 p=0 d=284089
+@@3: line 2.0 t=568178 s=35.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=0 p=-10000 d=0
+@\par via @@2 b=0 p=-10000 d=0
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=0 s=0.0 a=0.0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x100.0
+.\hbox(0.0+0.0)x100.0 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x100.0, glue set 35.0fill []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1092 \lastlinefit=500 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x100.0, glue set 35.0fill
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 0.0 plus 1.0fill
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1092 \lastlinefit=500 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=533 p=0 d=284089
+@@1: line 1.0 t=284089 s=35.0 g=20.0 -> @@0
+[]
+@ via @@0 b=0 p=0 d=0
+@@2: line 1.2 t=0 s=0.0 g=0.0 -> @@0
+[]
+@ via @@1 b=533 p=0 d=284089
+@@3: line 2.0 t=568178 s=35.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=0 p=-10000 d=0
+@\par via @@2 b=0 p=-10000 d=0
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=0 s=0.0 a=0.0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x100.0
+.\hbox(0.0+0.0)x100.0 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x100.0, glue set 35.0fill []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1093 \lastlinefit=1000 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x100.0, glue set 35.0fill
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 0.0 plus 1.0fill
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1093 \lastlinefit=1000 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=1137 p=0 d=1292769
+@@1: line 1.0 t=1292769 s=45.0 g=20.0 -> @@0
+[]
+@ via @@0 b=2 p=0 d=4
+@@2: line 1.2 t=4 s=10.0 g=40.0 -> @@0
+[]
+@ via @@1 b=1137 p=0 d=1292769
+@@3: line 2.0 t=2585538 s=45.0 g=20.0 -> @@1
+ []
+@\par via @@1 b=0 p=-10000 d=0
+@\par via @@2 b=0 p=-10000 d=0
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=4 s=0.0 a=0.0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x110.0
+.\hbox(0.0+0.0)x110.0, glue set 0.25 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x110.0, glue set 45.0fill []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1097 ... \lastlinefit=1000 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x110.0, glue set 45.0fill
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\glue 0.0 plus 1.0fil
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 0.0 plus 1.0fill
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1097 ... \lastlinefit=1000 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=1137 p=0 d=1292769
+@@1: line 1.0 t=1292769 s=45.0 g=20.0 -> @@0
+[]
+@ via @@0 b=2 p=0 d=4
+@@2: line 1.2 t=4 s=10.0 g=40.0 -> @@0
+[]
+@ via @@1 b=1137 p=0 d=1292769
+@@3: line 2.0 t=2585538 s=45.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=2 p=-10000 d=4
+@\par via @@2 b=0 p=-10000 d=0
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=4 s=45.0 a=2.5 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x110.0
+.\hbox(0.0+0.0)x110.0, glue set 0.25 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x110.0, glue set 0.125 []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1099 \lastlinefit=500 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x110.0, glue set 0.125
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 42.5
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1099 \lastlinefit=500 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=1137 p=0 d=1292769
+@@1: line 1.0 t=1292769 s=45.0 g=20.0 -> @@0
+[]
+@ via @@0 b=2 p=0 d=4
+@@2: line 1.2 t=4 s=10.0 g=40.0 -> @@0
+[]
+@ via @@1 b=1137 p=0 d=1292769
+@@3: line 2.0 t=2585538 s=45.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=2 p=-10000 d=4
+@\par via @@2 b=2 p=-10000 d=4
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=8 s=45.0 a=5.0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x110.0
+.\hbox(0.0+0.0)x110.0, glue set 0.25 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x110.0, glue set 0.25 []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1100 \lastlinefit=1000 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x110.0, glue set 0.25
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 40.0
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1100 \lastlinefit=1000 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=2073 p=0 d=4297329
+@@1: line 1.0 t=4297329 -> @@0
+[]
+@ via @@0 b=12 p=0 d=144
+@@2: line 1.2 t=144 -> @@0
+[]
+@ via @@1 b=2073 p=0 d=4297329
+@@3: line 2.0 t=8594658 -> @@1
+[]
+@\par via @@1 b=0 p=-10000 d=0
+@\par via @@2 b=0 p=-10000 d=0
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=144 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x120.0
+.\hbox(0.0+0.0)x120.0, glue set 0.5 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x120.0, glue set 55.0fill []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1102 \lastlinefit=0 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x120.0, glue set 55.0fill
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 0.0 plus 1.0fill
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1102 \lastlinefit=0 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=2073 p=0 d=4297329
+@@1: line 1.0 t=4297329 s=55.0 g=20.0 -> @@0
+[]
+@ via @@0 b=12 p=0 d=144
+@@2: line 1.2 t=144 s=20.0 g=40.0 -> @@0
+[]
+@ via @@1 b=2073 p=0 d=4297329
+@@3: line 2.0 t=8594658 s=55.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=12 p=-10000 d=144
+@\par via @@2 b=2 p=-10000 d=4
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=148 s=55.0 a=5.0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x120.0
+.\hbox(0.0+0.0)x120.0, glue set 0.5 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x120.0, glue set 0.25 []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1103 \lastlinefit=500 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x120.0, glue set 0.25
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 50.0
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1103 \lastlinefit=500 \1
+
+
+@firstpass
+[] []
+@ via @@0 b=2073 p=0 d=4297329
+@@1: line 1.0 t=4297329 s=55.0 g=20.0 -> @@0
+[]
+@ via @@0 b=12 p=0 d=144
+@@2: line 1.2 t=144 s=20.0 g=40.0 -> @@0
+[]
+@ via @@1 b=2073 p=0 d=4297329
+@@3: line 2.0 t=8594658 s=55.0 g=20.0 -> @@1
+[]
+@\par via @@1 b=12 p=-10000 d=144
+@\par via @@2 b=12 p=-10000 d=144
+@\par via @@3 b=0 p=-10000 d=0
+@@4: line 2.2- t=288 s=55.0 a=10.0 -> @@2
+
+> \box0=
+\vbox(0.0+0.0)x120.0
+.\hbox(0.0+0.0)x120.0, glue set 0.5 []
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x120.0, glue set 0.5 []
+
+! OK.
+\1...nt \2\2\2\2\3\2}\showbox 0
+ \setbox 0=\vbox {\unvbox 0 \s...
+l.1104 \lastlinefit=1000 \1
+
+
+> \box0=
+\hbox(0.0+0.0)x120.0, glue set 0.5
+.\hbox(0.0+0.0)x30.0
+.\glue 5.0 plus 20.0 minus 4.0
+.\hbox(0.0+0.0)x30.0
+.\penalty 10000
+.\glue(\parfillskip) 45.0
+.\glue(\rightskip) 0.0
+
+! OK.
+\1...tbox 0=\lastbox \showbox 0
+ }
+l.1104 \lastlinefit=1000 \1
+
+
+Checking expansion of V 2 \protected macros:
+\1 (l.1113)
+\1 (l.1113)
+relax (l.1115)
+relax (l.1115)
+Checking hyphenation and \savinghyphcodes:
+
+Underfull \hbox (badness 10000) in paragraph at lines 1132--1132
+ []\trip pp1Aqq []pp1Aqq []pp1A1qq []pp1Aqq []ppAqq
+
+\hbox(7.0+1.0)x16383.99998, glue set 1635.4 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1132--1132
+ []\trip up1Aqq []up1Aqq []up1A1qq []up1Aqq []upAqq
+
+\hbox(7.0+1.0)x16383.99998, glue set 1635.4 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1132--1132
+ []\trip ppB1qq []ppB1qq []ppB1qq []pp1B1qq []ppBqq
+
+\hbox(8.0+2.0)x16383.99998, glue set 1634.9 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1132--1132
+ []\trip upB1qq []upB1qq []upB1qq []up1B1qq []upBqq
+
+\hbox(8.0+2.0)x16383.99998, glue set 1634.9 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1134--1134
+ []\trip pp1A1qq []pp1Aqq []pp1A1qq []pp1Aqq []ppAqq
+
+\hbox(7.0+1.0)x16383.99998, glue set 1635.4 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1134--1134
+ []\trip up1A1qq []up1Aqq []up1A1qq []up1Aqq []upAqq
+
+\hbox(7.0+1.0)x16383.99998, glue set 1635.4 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1134--1134
+ []\trip ppB1qq []ppB1qq []ppB1qq []pp1B1qq []ppBqq
+
+\hbox(8.0+2.0)x16383.99998, glue set 1634.9 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1134--1134
+ []\trip upB1qq []upB1qq []upB1qq []up1B1qq []upBqq
+
+\hbox(8.0+2.0)x16383.99998, glue set 1634.9 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1136--1136
+ []\trip pp1Aqq []pp1Aqq []pp1A1qq []pp1Aqq []ppAqq
+
+\hbox(7.0+1.0)x16383.99998, glue set 1635.4 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1136--1136
+ []\trip up1Aqq []up1Aqq []up1A1qq []up1Aqq []upAqq
+
+\hbox(7.0+1.0)x16383.99998, glue set 1635.4 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1136--1136
+ []\trip pp1B1qq []ppB1qq []ppB1qq []pp1B1qq []ppBqq
+
+\hbox(8.0+2.0)x16383.99998, glue set 1634.9 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1136--1136
+ []\trip up1B1qq []upB1qq []upB1qq []up1B1qq []upBqq
+
+\hbox(8.0+2.0)x16383.99998, glue set 1634.9 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1138--1138
+ []\trip qq1app []qq1app []qqapp []qq1app []qqapp
+
+\hbox(7.0+1.0)x16383.99998, glue set 1635.4 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1138--1138
+ []\trip qqb1pp []qqb1pp []qqb1pp []qqb1pp []qqbpp
+
+\hbox(8.0+2.0)x16383.99998, glue set 1634.9 []
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 1138--1138
+ []\trip qqrpp []qqrpp []qq1r1pp []qq1r1pp []qqrpp
+
+\hbox(0.0+0.0)x16383.99998, glue set 1634.9 []
+
+Checking \savingvdiscards, \pagediscards, and \splitdiscards:
+! Missing $ inserted.
+<inserted text>
+ $
+...
+l.1146 ...oindent$\splitdiscards
+ \noindent$\pagediscards}
+I've inserted a begin-math/end-math symbol since I think
+you left one out. Proceed, with fingers crossed.
+
+! Missing $ inserted.
+<inserted text>
+ $
+...
+l.1146 ...noindent$\pagediscards
+ }
+I've inserted a begin-math/end-math symbol since I think
+you left one out. Proceed, with fingers crossed.
+
+> \box27=
+\vbox(0.0+0.0)x0.0
+.\hbox(0.0+0.0)x0.0
+..\mathon
+..\mathoff
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\glue(\parskip) 0.0
+.\glue(\baselineskip) 0.0
+.\hbox(0.0+0.0)x0.0
+..\mathon
+..\mathoff
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+
+! OK.
+l.1147 \showbox27
+
+
+> \box0=
+\vbox(40.0+0.0)x0.0
+.\vbox(20.0+0.0)x0.0
+..\vbox(20.0+0.0)x0.0
+..\openout0=abc
+..\penalty 0
+..\write1{write 1}
+.\vbox(20.0+0.0)x0.0
+..\write2{write 2}
+..\closeout3
+..\glue(\splittopskip) 0.0
+..\vbox(20.0+0.0)x0.0
+..\glue 0.0 plus 1.0fil
+
+! OK.
+\1...cards \box 28 } \showbox 0
+ }
+l.1175 \1 -1 20
+ \1 0 30 \1 1 20 \1 2 30
+
+> \box0=
+\vbox(50.0+0.0)x0.0
+.\vbox(30.0+0.0)x0.0
+..\vbox(20.0+0.0)x0.0
+..\openout0=abc
+..\penalty 0
+..\write1{write 1}
+..\glue 10.0 plus 1.0 minus 1.0
+..\write2{write 2}
+.\vbox(20.0+0.0)x0.0
+..\closeout3
+..\glue(\splittopskip) 0.0
+..\vbox(20.0+0.0)x0.0
+..\glue 0.0 plus 1.0fil
+
+! OK.
+\1...cards \box 28 } \showbox 0
+ }
+l.1175 \1 -1 20 \1 0 30
+ \1 1 20 \1 2 30
+
+> \box0=
+\vbox(60.0+0.0)x0.0
+.\vbox(20.0+0.0)x0.0
+..\vbox(20.0+0.0)x0.0
+..\openout0=abc
+..\penalty 0
+..\write1{write 1}
+.\glue 10.0 plus 1.0 minus 1.0
+.\penalty 0
+.\kern 10.0
+.\vbox(20.0+0.0)x0.0
+..\write2{write 2}
+..\closeout3
+..\glue(\splittopskip) 0.0
+..\vbox(20.0+0.0)x0.0
+..\glue 0.0 plus 1.0fil
+
+! OK.
+\1...cards \box 28 } \showbox 0
+ }
+l.1175 ... \1 0 30 \1 1 20
+ \1 2 30
+
+> \box0=
+\vbox(60.0+0.0)x0.0
+.\vbox(30.0+0.0)x0.0
+..\vbox(20.0+0.0)x0.0
+..\openout0=abc
+..\penalty 0
+..\write1{write 1}
+..\glue 10.0 plus 1.0 minus 1.0
+..\write2{write 2}
+.\penalty 0
+.\kern 10.0
+.\vbox(20.0+0.0)x0.0
+..\closeout3
+..\glue(\splittopskip) 0.0
+..\vbox(20.0+0.0)x0.0
+..\glue 0.0 plus 1.0fil
+
+! OK.
+\1...cards \box 28 } \showbox 0
+ }
+l.1175 ... \1 1 20 \1 2 30
+
+
+
+### internal vertical mode entered at line 1184
+prevdepth ignored
+### vertical mode entered at line 0
+### recent contributions:
+\glue 0.0 plus 1.0fil
+\kern 20.0
+prevdepth 0.0
+
+! OK.
+\1...{ \pagediscards \showlists
+ }}
+l.1184 ...0 \vfil \kern 20 pt \1
+ \penalty -1 \1
+
+
+### internal vertical mode entered at line 1184
+prevdepth ignored
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+\1...{ \pagediscards \showlists
+ }}
+l.1184 ...0 pt \1 \penalty -1 \1
+
+
+
+### internal vertical mode entered at line 1185
+prevdepth ignored
+### vertical mode entered at line 0
+### recent contributions:
+\glue 0.0 plus 1.0fill
+\kern 2.0
+prevdepth 0.0
+
+! OK.
+\1...{ \pagediscards \showlists
+ }}
+l.1185 ...1 \vfill \kern 2 pt \1
+ \penalty 10 \1
+
+
+### internal vertical mode entered at line 1185
+\glue 0.0 plus 1.0fill
+\kern 2.0
+\penalty 10
+prevdepth ignored
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+\1...{ \pagediscards \showlists
+ }}
+l.1185 ...2 pt \1 \penalty 10 \1
+
+
+> \box0=
+\vbox(12.0+0.0)x0.0
+.\kern 5.0
+.\penalty 0
+.\kern 7.0
+.\glue(\baselineskip) 0.0
+
+! OK.
+<output> ...scards } \showbox 0
+ \showbox 255 \setbox 0 = \box...
+l.1190 ...box {} \penalty -10000
+
+
+> \box255=
+\vbox(0.0+0.0)x0.0
+.\write1{}
+.\write2{}
+.\write3{}
+.\glue(\topskip) 0.0
+.\hbox(0.0+0.0)x0.0
+
+! OK.
+<output> ...wbox 0 \showbox 255
+ \setbox 0 = \box 255 \global ...
+l.1190 ...box {} \penalty -10000
+
+
+
+### internal vertical mode entered at line 1191
+\penalty 10000
+prevdepth ignored
+### vertical mode entered at line 0
+prevdepth 0.0
+
+! OK.
+\1...{ \pagediscards \showlists
+ }}
+l.1191 \1
+
+
+Checking \interlinepenalties, \clubpenalties, \widowpenalties, and \disp
+laywidowpenalties:
+{into \tracingassigns=1}
+{changing \tracingrestores=0}
+{into \tracingrestores=1}
+\interlinepenalties=0
+\clubpenalties=0
+\widowpenalties=0
+\displaywidowpenalties=0
+\interlinepenalties-1=0
+\interlinepenalties0=0
+\interlinepenalties5=0
+\interlinepenalties\interlinepenalties0=0
+\clubpenalties-1=0
+\clubpenalties0=0
+\clubpenalties5=0
+\clubpenalties\clubpenalties0=0
+\widowpenalties-1=0
+\widowpenalties0=0
+\widowpenalties5=0
+\widowpenalties\widowpenalties0=0
+\displaywidowpenalties-1=0
+\displaywidowpenalties0=0
+\displaywidowpenalties5=0
+\displaywidowpenalties\displaywidowpenalties0=0
+{changing \interlinepenalties=0}
+{into \interlinepenalties=3 101\ETC.}
+{changing \clubpenalties=0}
+{into \clubpenalties=1 1}
+{changing \clubpenalties=1 1}
+{into \clubpenalties=4 201\ETC.}
+{changing \widowpenalties=0}
+{into \widowpenalties=5 301\ETC.}
+{changing \displaywidowpenalties=0}
+{into \displaywidowpenalties=6 401\ETC.}
+\interlinepenalties=3 101 102 103
+\clubpenalties=4 201 202 203 204
+\widowpenalties=5 301 302 303 304 305
+\displaywidowpenalties=6 401 402 403 404 405 406
+\interlinepenalties-1=0
+\interlinepenalties0=3
+\interlinepenalties5=103
+\interlinepenalties\interlinepenalties0=103
+\clubpenalties-1=0
+\clubpenalties0=4
+\clubpenalties5=204
+\clubpenalties\clubpenalties0=204
+\widowpenalties-1=0
+\widowpenalties0=5
+\widowpenalties5=305
+\widowpenalties\widowpenalties0=305
+\displaywidowpenalties-1=0
+\displaywidowpenalties0=6
+\displaywidowpenalties5=405
+\displaywidowpenalties\displaywidowpenalties0=406
+{changing \interlinepenalties=3 101\ETC.}
+{into \interlinepenalties=0}
+{restoring \interlinepenalties=3 101\ETC.}
+{changing \box0=void}
+{into \box0=
+\vbox(0.0+0.0)x0.0}
+{restoring \box0=void}
+{restoring \displaywidowpenalties=0}
+{restoring \widowpenalties=0}
+{restoring \clubpenalties=0}
+{restoring \interlinepenalties=0}
+ )
+Here is how much of TeX's memory you used:
+ 22 strings out of 1665
+ 132 string characters out of 8410
+ 2661 words of memory out of 3000
+ 408 multiletter control sequences out of 2100
+ 2286 words of font info for 3 fonts, out of 20000 for 75
+ 10 hyphenation exceptions out of 307
+ 10i,15n,8p,137b,78s stack positions out of 200i,40n,60p,500b,600s
+
+Output written on etrip.dvi (3 pages, 220 bytes).
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip.out b/Build/source/texk/web2c/etexdir/etrip/etrip.out
new file mode 100644
index 00000000000..38cd5282c5a
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip.out
@@ -0,0 +1,4 @@
+\endgroup
+\fi
+\bgroup
+\iffalse \else
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip.pl b/Build/source/texk/web2c/etexdir/etrip/etrip.pl
new file mode 100644
index 00000000000..6a38a92316b
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip.pl
@@ -0,0 +1,833 @@
+(FAMILY UNSPECIFIED)
+(FACE F MRR)
+(CODINGSCHEME TEX TEST: NOT A REAL FONT)
+(DESIGNSIZE R 10.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM O 32107654321)
+(FONTDIMEN
+ (SLANT R -2.0)
+ (SPACE R 0.400001)
+ (STRETCH R 0.200001)
+ (SHRINK R 0.1)
+ (XHEIGHT R 0.45)
+ (QUAD R 1.0)
+ (EXTRASPACE R 0.200001)
+ (PARAMETER D 8 R 0.05)
+ (PARAMETER D 9 R 0.1)
+ (PARAMETER D 10 R 0.200001)
+ (PARAMETER D 11 R 0.3)
+ (PARAMETER D 12 R 0.400001)
+ (PARAMETER D 13 R 0.5)
+ )
+(BOUNDARYCHAR C Z)
+(LIGTABLE
+ (LABEL C t)
+ (KRN O 0 R -1.0)
+ (KRN O 0 R -0.01)
+ (KRN O 0 R -0.02)
+ (KRN O 0 R -0.03)
+ (KRN O 0 R -0.04)
+ (KRN O 0 R -0.05)
+ (KRN O 0 R -0.06)
+ (KRN O 0 R -0.07)
+ (KRN O 0 R -0.08)
+ (KRN O 0 R -0.09)
+ (KRN O 0 R -0.1)
+ (KRN O 0 R -0.11)
+ (KRN O 0 R -0.12)
+ (KRN O 0 R -0.13)
+ (KRN O 0 R -0.14)
+ (KRN O 0 R -0.15)
+ (KRN O 0 R -0.16)
+ (KRN O 0 R -0.17)
+ (KRN O 0 R -0.18)
+ (KRN O 0 R -0.19)
+ (KRN O 0 R -0.2)
+ (KRN O 0 R -0.21)
+ (KRN O 0 R -0.22)
+ (KRN O 0 R -0.23)
+ (KRN O 0 R -0.24)
+ (KRN O 0 R -0.25)
+ (KRN O 0 R -0.26)
+ (KRN O 0 R -0.27)
+ (KRN O 0 R -0.28)
+ (KRN O 0 R -0.29)
+ (KRN O 0 R -0.3)
+ (KRN O 0 R -0.31)
+ (KRN O 0 R -0.32)
+ (KRN O 0 R -0.33)
+ (KRN O 0 R -0.34)
+ (KRN O 0 R -0.35)
+ (KRN O 0 R -0.36)
+ (KRN O 0 R -0.37)
+ (KRN O 0 R -0.38)
+ (KRN O 0 R -0.39)
+ (KRN O 0 R -0.4)
+ (KRN O 0 R -0.41)
+ (KRN O 0 R -0.42)
+ (KRN O 0 R -0.43)
+ (KRN O 0 R -0.44)
+ (KRN O 0 R -0.45)
+ (KRN O 0 R -0.46)
+ (KRN O 0 R -0.47)
+ (KRN O 0 R -0.48)
+ (KRN O 0 R -0.49)
+ (KRN O 0 R -0.5)
+ (KRN O 0 R -0.51)
+ (KRN O 0 R -0.52)
+ (KRN O 0 R -0.53)
+ (KRN O 0 R -0.54)
+ (KRN O 0 R -0.55)
+ (KRN O 0 R -0.56)
+ (KRN O 0 R -0.57)
+ (KRN O 0 R -0.58)
+ (KRN O 0 R -0.59)
+ (KRN O 0 R -0.6)
+ (KRN O 0 R -0.61)
+ (KRN O 0 R -0.62)
+ (KRN O 0 R -0.63)
+ (KRN O 0 R -0.64)
+ (KRN O 0 R -0.65)
+ (KRN O 0 R -0.66)
+ (KRN O 0 R -0.67)
+ (KRN O 0 R -0.68)
+ (KRN O 0 R -0.69)
+ (KRN O 0 R -0.7)
+ (KRN O 0 R -0.71)
+ (KRN O 0 R -0.72)
+ (KRN O 0 R -0.73)
+ (KRN O 0 R -0.74)
+ (KRN O 0 R -0.75)
+ (KRN O 0 R -0.76)
+ (KRN O 0 R -0.77)
+ (KRN O 0 R -0.78)
+ (KRN O 0 R -0.79)
+ (KRN O 0 R -0.8)
+ (KRN O 0 R -0.81)
+ (KRN O 0 R -0.82)
+ (KRN O 0 R -0.83)
+ (KRN O 0 R -0.84)
+ (KRN O 0 R -0.85)
+ (KRN O 0 R -0.86)
+ (KRN O 0 R -0.87)
+ (KRN O 0 R -0.88)
+ (KRN O 0 R -0.89)
+ (KRN O 0 R -0.9)
+ (KRN O 0 R -0.91)
+ (KRN O 0 R -0.92)
+ (KRN O 0 R -0.93)
+ (KRN O 0 R -0.94)
+ (KRN O 0 R -0.95)
+ (KRN O 0 R -0.96)
+ (KRN O 0 R -0.97)
+ (KRN O 0 R -0.98)
+ (KRN O 0 R -0.99)
+ (KRN O 0 R -1.0)
+ (KRN O 0 R -1.01)
+ (KRN O 0 R -1.02)
+ (KRN O 0 R -1.03)
+ (KRN O 0 R -1.04)
+ (KRN O 0 R -1.05)
+ (KRN O 0 R -1.06)
+ (KRN O 0 R -1.07)
+ (KRN O 0 R -1.08)
+ (KRN O 0 R -1.09)
+ (KRN O 0 R -1.1)
+ (KRN O 0 R -1.11)
+ (KRN O 0 R -1.12)
+ (KRN O 0 R -1.13)
+ (KRN O 0 R -1.14)
+ (KRN O 0 R -1.15)
+ (KRN O 0 R -1.16)
+ (KRN O 0 R -1.17)
+ (KRN O 0 R -1.18)
+ (KRN O 0 R -1.19)
+ (KRN O 0 R -1.2)
+ (KRN O 0 R -1.21)
+ (KRN O 0 R -1.22)
+ (KRN O 0 R -1.23)
+ (KRN O 0 R -1.24)
+ (KRN O 0 R -1.25)
+ (KRN O 0 R -1.26)
+ (KRN O 0 R -1.27)
+ (KRN O 0 R -1.28)
+ (KRN O 0 R -1.29)
+ (KRN O 0 R -1.3)
+ (KRN O 0 R -1.31)
+ (KRN O 0 R -1.32)
+ (KRN O 0 R -1.33)
+ (KRN O 0 R -1.34)
+ (KRN O 0 R -1.35)
+ (KRN O 0 R -1.36)
+ (KRN O 0 R -1.37)
+ (KRN O 0 R -1.38)
+ (KRN O 0 R -1.39)
+ (KRN O 0 R -1.4)
+ (KRN O 0 R -1.41)
+ (KRN O 0 R -1.42)
+ (KRN O 0 R -1.43)
+ (KRN O 0 R -1.44)
+ (KRN O 0 R -1.45)
+ (KRN O 0 R -1.46)
+ (KRN O 0 R -1.47)
+ (KRN O 0 R -1.48)
+ (KRN O 0 R -1.49)
+ (KRN O 0 R -1.5)
+ (KRN O 0 R -1.51)
+ (KRN O 0 R -1.52)
+ (KRN O 0 R -1.53)
+ (KRN O 0 R -1.54)
+ (KRN O 0 R -1.55)
+ (KRN O 0 R -1.56)
+ (KRN O 0 R -1.57)
+ (KRN O 0 R -1.58)
+ (KRN O 0 R -1.59)
+ (KRN O 0 R -1.6)
+ (KRN O 0 R -1.61)
+ (KRN O 0 R -1.62)
+ (KRN O 0 R -1.63)
+ (KRN O 0 R -1.64)
+ (KRN O 0 R -1.65)
+ (KRN O 0 R -1.66)
+ (KRN O 0 R -1.67)
+ (KRN O 0 R -1.68)
+ (KRN O 0 R -1.69)
+ (KRN O 0 R -1.7)
+ (KRN O 0 R -1.71)
+ (KRN O 0 R -1.72)
+ (KRN O 0 R -1.73)
+ (KRN O 0 R -1.74)
+ (KRN O 0 R -1.75)
+ (KRN O 0 R -1.76)
+ (KRN O 0 R -1.77)
+ (KRN O 0 R -1.78)
+ (KRN O 0 R -1.79)
+ (KRN O 0 R -1.8)
+ (KRN O 0 R -1.81)
+ (KRN O 0 R -1.82)
+ (KRN O 0 R -1.83)
+ (KRN O 0 R -1.84)
+ (KRN O 0 R -1.85)
+ (KRN O 0 R -1.86)
+ (KRN O 0 R -1.87)
+ (KRN O 0 R -1.88)
+ (KRN O 0 R -1.89)
+ (KRN O 0 R -1.9)
+ (KRN O 0 R -1.91)
+ (KRN O 0 R -1.92)
+ (KRN O 0 R -1.93)
+ (KRN O 0 R -1.94)
+ (KRN O 0 R -1.95)
+ (KRN O 0 R -1.96)
+ (KRN O 0 R -1.97)
+ (KRN O 0 R -1.98)
+ (KRN O 0 R -1.99)
+ (KRN O 0 R -2.0)
+ (KRN O 0 R -2.01)
+ (KRN O 0 R -2.02)
+ (KRN O 0 R -2.03)
+ (KRN O 0 R -2.04)
+ (KRN O 0 R -2.05)
+ (KRN O 0 R -2.06)
+ (KRN O 0 R -2.07)
+ (KRN O 0 R -2.08)
+ (KRN O 0 R -2.09)
+ (KRN O 0 R -2.1)
+ (KRN O 0 R -2.11)
+ (KRN O 0 R -2.12)
+ (KRN O 0 R -2.13)
+ (KRN O 0 R -2.14)
+ (KRN O 0 R -2.15)
+ (KRN O 0 R -2.16)
+ (KRN O 0 R -2.17)
+ (KRN O 0 R -2.18)
+ (KRN O 0 R -2.19)
+ (KRN O 0 R -2.2)
+ (KRN O 0 R -2.21)
+ (KRN O 0 R -2.22)
+ (KRN O 0 R -2.23)
+ (KRN O 0 R -2.24)
+ (KRN O 0 R -2.25)
+ (KRN O 0 R -2.26)
+ (KRN O 0 R -2.27)
+ (KRN O 0 R -2.28)
+ (KRN O 0 R -2.29)
+ (KRN O 0 R -2.3)
+ (SKIP D 3)
+ (LABEL O 55)
+ (LIG O 0 O 55)
+ (/LIG> C q C p)
+ (LABEL O 57)
+ (KRN C A R 0.1)
+ (STOP)
+ (KRN O 0 R -2.31)
+ (KRN O 0 R -2.32)
+ (KRN O 0 R -2.33)
+ (KRN O 0 R -2.34)
+ (KRN O 0 R -2.35)
+ (KRN O 0 R -2.36)
+ (KRN O 0 R -2.37)
+ (KRN O 0 R -2.38)
+ (KRN O 0 R -2.39)
+ (KRN O 0 R -2.4)
+ (KRN O 0 R -2.41)
+ (KRN O 0 R -2.42)
+ (KRN O 0 R -2.43)
+ (KRN O 0 R -2.44)
+ (KRN O 0 R -2.45)
+ (KRN O 0 R -2.46)
+ (KRN O 0 R -2.47)
+ (KRN O 0 R -2.48)
+ (KRN O 0 R -2.49)
+ (KRN O 0 R -2.5)
+ (KRN O 0 R -2.51)
+ (KRN O 0 R -2.52)
+ (KRN O 0 R -2.53)
+ (KRN O 0 R -2.54)
+ (KRN O 0 R -2.55)
+ (KRN O 0 R -2.56)
+ (KRN O 0 R -2.57)
+ (/LIG/>> C r C s)
+ (SKIP D 9)
+ (LABEL C p)
+ (/LIG/ C q C r)
+ (/LIG/> C r C t)
+ (LIG C t C t)
+ (STOP)
+ (LABEL C q)
+ (/LIG/ C u C p)
+ (/LIG/ C s C r)
+ (KRN C t R 0.1)
+ (/LIG> C r C t)
+ (SKIP D 2)
+ (LABEL C r)
+ (LIG/ C u C q)
+ (/LIG C q C u)
+ (STOP)
+ (/LIG/ C p C s)
+ (KRN C s R 0.3)
+ (STOP)
+ (LABEL C s)
+ (LIG/> C p C q)
+ (KRN C r R 0.1)
+ (STOP)
+ (LABEL C u)
+ (/LIG C Z C p)
+ (LIG C p C r)
+ (STOP)
+ (LABEL BOUNDARYCHAR)
+ (LIG/ C q C q)
+ (/LIG C 1 C 5)
+ (KRN O 55 R -0.1)
+ (STOP)
+ (LABEL C 1)
+ (/LIG/ C 1 C 2)
+ (/LIG/ C 2 C 3)
+ (/LIG> O 55 C 1)
+ (SKIP D 1)
+ (LABEL C 2)
+ (/LIG/ C 1 C 3)
+ (/LIG/ C 3 C 4)
+ (SKIP D 2)
+ (LABEL C 3)
+ (/LIG/ C 1 C 4)
+ (/LIG/ C 2 C 4)
+ (/LIG/ C 4 C 5)
+ (SKIP D 3)
+ (LABEL C 4)
+ (/LIG/ C 1 C 5)
+ (/LIG/ C 2 C 5)
+ (/LIG/ C 3 C 5)
+ (/LIG/ C 5 C 6)
+ (SKIP D 4)
+ (LABEL C 5)
+ (/LIG/ C 1 C 6)
+ (/LIG/ C 2 C 6)
+ (/LIG/ C 3 C 6)
+ (/LIG/ C 4 C 6)
+ (/LIG/ C 6 C 7)
+ (SKIP D 5)
+ (LABEL C 6)
+ (/LIG/ C 1 C 7)
+ (/LIG/ C 2 C 7)
+ (/LIG/ C 3 C 7)
+ (/LIG/ C 4 C 7)
+ (/LIG/ C 5 C 7)
+ (/LIG/>> C Z C 7)
+ (STOP)
+ (LABEL C 7)
+ (KRN C Z R 0.1)
+ (LABEL C A)
+ (LIG C A C A)
+ (KRN C B R 0.200001)
+ (KRN O 55 R 0.3)
+ (KRN C 1 R -0.200001)
+ (STOP)
+ (LABEL C B)
+ (LIG C B C A)
+ (LIG O 55 C C)
+ (KRN C C R 0.400001)
+ (STOP)
+ (LABEL C C)
+ (LIG C A O 202)
+ (LIG O 57 C B)
+ (STOP)
+ )
+(CHARACTER O 0
+ (CHARWD R 0.700001)
+ (CHARHT R -0.1)
+ (CHARDP R 0.200001)
+ )
+(CHARACTER O 55
+ (CHARWD R -0.5)
+ (COMMENT
+ (LIG O 0 O 55)
+ (/LIG> C q C p)
+ (KRN C A R 0.1)
+ )
+ )
+(CHARACTER O 57
+ (CHARWD R 0.1)
+ (COMMENT
+ (KRN C A R 0.1)
+ )
+ )
+(CHARACTER C 1
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 2)
+ (/LIG/ C 2 C 3)
+ (/LIG> O 55 C 1)
+ (/LIG/ C 3 C 4)
+ (/LIG/ C 4 C 5)
+ (/LIG/ C 5 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 2
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 3)
+ (/LIG/ C 3 C 4)
+ (/LIG/ C 4 C 5)
+ (/LIG/ C 5 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 3
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 4)
+ (/LIG/ C 2 C 4)
+ (/LIG/ C 4 C 5)
+ (/LIG/ C 5 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 4
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 5)
+ (/LIG/ C 2 C 5)
+ (/LIG/ C 3 C 5)
+ (/LIG/ C 5 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 5
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 6)
+ (/LIG/ C 2 C 6)
+ (/LIG/ C 3 C 6)
+ (/LIG/ C 4 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 6
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 7)
+ (/LIG/ C 2 C 7)
+ (/LIG/ C 3 C 7)
+ (/LIG/ C 4 C 7)
+ (/LIG/ C 5 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 7
+ (CHARWD R 0.0)
+ (COMMENT
+ (KRN C Z R 0.1)
+ (LIG C A C A)
+ (KRN C B R 0.200001)
+ (KRN O 55 R 0.3)
+ (KRN C 1 R -0.200001)
+ )
+ )
+(CHARACTER C A
+ (CHARWD R 0.200001)
+ (CHARHT R 0.700001)
+ (CHARDP R 0.1)
+ (CHARIC R 0.1)
+ (COMMENT
+ (LIG C A C A)
+ (KRN C B R 0.200001)
+ (KRN O 55 R 0.3)
+ (KRN C 1 R -0.200001)
+ )
+ )
+(CHARACTER C B
+ (CHARWD R 0.3)
+ (CHARHT R 0.8)
+ (CHARDP R 0.200001)
+ (COMMENT
+ (LIG C B C A)
+ (LIG O 55 C C)
+ (KRN C C R 0.400001)
+ )
+ )
+(CHARACTER C C
+ (CHARWD R 0.400001)
+ (COMMENT
+ (LIG C A O 202)
+ (LIG O 57 C B)
+ )
+ )
+(CHARACTER C M
+ (CHARWD R 0.6)
+ (CHARIC R 0.200001)
+ (VARCHAR
+ (MID C A)
+ (BOT C B)
+ (REP O 0)
+ )
+ )
+(CHARACTER C a
+ (CHARWD R 0.200001)
+ (CHARHT R 0.700001)
+ (CHARDP R 0.1)
+ (CHARIC R 0.1)
+ (NEXTLARGER O 202)
+ )
+(CHARACTER C b
+ (CHARWD R 0.3)
+ (CHARHT R 0.8)
+ (CHARDP R 0.200001)
+ (NEXTLARGER C M)
+ )
+(CHARACTER C p
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C q C r)
+ (/LIG/> C r C t)
+ (LIG C t C t)
+ )
+ )
+(CHARACTER C q
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C u C p)
+ (/LIG/ C s C r)
+ (KRN C t R 0.1)
+ (/LIG> C r C t)
+ (/LIG/ C p C s)
+ (KRN C s R 0.3)
+ )
+ )
+(CHARACTER C r
+ (CHARWD R 0.0)
+ (COMMENT
+ (LIG/ C u C q)
+ (/LIG C q C u)
+ )
+ )
+(CHARACTER C s
+ (CHARWD R 0.0)
+ (COMMENT
+ (LIG/> C p C q)
+ (KRN C r R 0.1)
+ )
+ )
+(CHARACTER C t
+ (CHARWD R 0.0)
+ (COMMENT
+ (KRN O 0 R -1.0)
+ (KRN O 0 R -0.01)
+ (KRN O 0 R -0.02)
+ (KRN O 0 R -0.03)
+ (KRN O 0 R -0.04)
+ (KRN O 0 R -0.05)
+ (KRN O 0 R -0.06)
+ (KRN O 0 R -0.07)
+ (KRN O 0 R -0.08)
+ (KRN O 0 R -0.09)
+ (KRN O 0 R -0.1)
+ (KRN O 0 R -0.11)
+ (KRN O 0 R -0.12)
+ (KRN O 0 R -0.13)
+ (KRN O 0 R -0.14)
+ (KRN O 0 R -0.15)
+ (KRN O 0 R -0.16)
+ (KRN O 0 R -0.17)
+ (KRN O 0 R -0.18)
+ (KRN O 0 R -0.19)
+ (KRN O 0 R -0.2)
+ (KRN O 0 R -0.21)
+ (KRN O 0 R -0.22)
+ (KRN O 0 R -0.23)
+ (KRN O 0 R -0.24)
+ (KRN O 0 R -0.25)
+ (KRN O 0 R -0.26)
+ (KRN O 0 R -0.27)
+ (KRN O 0 R -0.28)
+ (KRN O 0 R -0.29)
+ (KRN O 0 R -0.3)
+ (KRN O 0 R -0.31)
+ (KRN O 0 R -0.32)
+ (KRN O 0 R -0.33)
+ (KRN O 0 R -0.34)
+ (KRN O 0 R -0.35)
+ (KRN O 0 R -0.36)
+ (KRN O 0 R -0.37)
+ (KRN O 0 R -0.38)
+ (KRN O 0 R -0.39)
+ (KRN O 0 R -0.4)
+ (KRN O 0 R -0.41)
+ (KRN O 0 R -0.42)
+ (KRN O 0 R -0.43)
+ (KRN O 0 R -0.44)
+ (KRN O 0 R -0.45)
+ (KRN O 0 R -0.46)
+ (KRN O 0 R -0.47)
+ (KRN O 0 R -0.48)
+ (KRN O 0 R -0.49)
+ (KRN O 0 R -0.5)
+ (KRN O 0 R -0.51)
+ (KRN O 0 R -0.52)
+ (KRN O 0 R -0.53)
+ (KRN O 0 R -0.54)
+ (KRN O 0 R -0.55)
+ (KRN O 0 R -0.56)
+ (KRN O 0 R -0.57)
+ (KRN O 0 R -0.58)
+ (KRN O 0 R -0.59)
+ (KRN O 0 R -0.6)
+ (KRN O 0 R -0.61)
+ (KRN O 0 R -0.62)
+ (KRN O 0 R -0.63)
+ (KRN O 0 R -0.64)
+ (KRN O 0 R -0.65)
+ (KRN O 0 R -0.66)
+ (KRN O 0 R -0.67)
+ (KRN O 0 R -0.68)
+ (KRN O 0 R -0.69)
+ (KRN O 0 R -0.7)
+ (KRN O 0 R -0.71)
+ (KRN O 0 R -0.72)
+ (KRN O 0 R -0.73)
+ (KRN O 0 R -0.74)
+ (KRN O 0 R -0.75)
+ (KRN O 0 R -0.76)
+ (KRN O 0 R -0.77)
+ (KRN O 0 R -0.78)
+ (KRN O 0 R -0.79)
+ (KRN O 0 R -0.8)
+ (KRN O 0 R -0.81)
+ (KRN O 0 R -0.82)
+ (KRN O 0 R -0.83)
+ (KRN O 0 R -0.84)
+ (KRN O 0 R -0.85)
+ (KRN O 0 R -0.86)
+ (KRN O 0 R -0.87)
+ (KRN O 0 R -0.88)
+ (KRN O 0 R -0.89)
+ (KRN O 0 R -0.9)
+ (KRN O 0 R -0.91)
+ (KRN O 0 R -0.92)
+ (KRN O 0 R -0.93)
+ (KRN O 0 R -0.94)
+ (KRN O 0 R -0.95)
+ (KRN O 0 R -0.96)
+ (KRN O 0 R -0.97)
+ (KRN O 0 R -0.98)
+ (KRN O 0 R -0.99)
+ (KRN O 0 R -1.0)
+ (KRN O 0 R -1.01)
+ (KRN O 0 R -1.02)
+ (KRN O 0 R -1.03)
+ (KRN O 0 R -1.04)
+ (KRN O 0 R -1.05)
+ (KRN O 0 R -1.06)
+ (KRN O 0 R -1.07)
+ (KRN O 0 R -1.08)
+ (KRN O 0 R -1.09)
+ (KRN O 0 R -1.1)
+ (KRN O 0 R -1.11)
+ (KRN O 0 R -1.12)
+ (KRN O 0 R -1.13)
+ (KRN O 0 R -1.14)
+ (KRN O 0 R -1.15)
+ (KRN O 0 R -1.16)
+ (KRN O 0 R -1.17)
+ (KRN O 0 R -1.18)
+ (KRN O 0 R -1.19)
+ (KRN O 0 R -1.2)
+ (KRN O 0 R -1.21)
+ (KRN O 0 R -1.22)
+ (KRN O 0 R -1.23)
+ (KRN O 0 R -1.24)
+ (KRN O 0 R -1.25)
+ (KRN O 0 R -1.26)
+ (KRN O 0 R -1.27)
+ (KRN O 0 R -1.28)
+ (KRN O 0 R -1.29)
+ (KRN O 0 R -1.3)
+ (KRN O 0 R -1.31)
+ (KRN O 0 R -1.32)
+ (KRN O 0 R -1.33)
+ (KRN O 0 R -1.34)
+ (KRN O 0 R -1.35)
+ (KRN O 0 R -1.36)
+ (KRN O 0 R -1.37)
+ (KRN O 0 R -1.38)
+ (KRN O 0 R -1.39)
+ (KRN O 0 R -1.4)
+ (KRN O 0 R -1.41)
+ (KRN O 0 R -1.42)
+ (KRN O 0 R -1.43)
+ (KRN O 0 R -1.44)
+ (KRN O 0 R -1.45)
+ (KRN O 0 R -1.46)
+ (KRN O 0 R -1.47)
+ (KRN O 0 R -1.48)
+ (KRN O 0 R -1.49)
+ (KRN O 0 R -1.5)
+ (KRN O 0 R -1.51)
+ (KRN O 0 R -1.52)
+ (KRN O 0 R -1.53)
+ (KRN O 0 R -1.54)
+ (KRN O 0 R -1.55)
+ (KRN O 0 R -1.56)
+ (KRN O 0 R -1.57)
+ (KRN O 0 R -1.58)
+ (KRN O 0 R -1.59)
+ (KRN O 0 R -1.6)
+ (KRN O 0 R -1.61)
+ (KRN O 0 R -1.62)
+ (KRN O 0 R -1.63)
+ (KRN O 0 R -1.64)
+ (KRN O 0 R -1.65)
+ (KRN O 0 R -1.66)
+ (KRN O 0 R -1.67)
+ (KRN O 0 R -1.68)
+ (KRN O 0 R -1.69)
+ (KRN O 0 R -1.7)
+ (KRN O 0 R -1.71)
+ (KRN O 0 R -1.72)
+ (KRN O 0 R -1.73)
+ (KRN O 0 R -1.74)
+ (KRN O 0 R -1.75)
+ (KRN O 0 R -1.76)
+ (KRN O 0 R -1.77)
+ (KRN O 0 R -1.78)
+ (KRN O 0 R -1.79)
+ (KRN O 0 R -1.8)
+ (KRN O 0 R -1.81)
+ (KRN O 0 R -1.82)
+ (KRN O 0 R -1.83)
+ (KRN O 0 R -1.84)
+ (KRN O 0 R -1.85)
+ (KRN O 0 R -1.86)
+ (KRN O 0 R -1.87)
+ (KRN O 0 R -1.88)
+ (KRN O 0 R -1.89)
+ (KRN O 0 R -1.9)
+ (KRN O 0 R -1.91)
+ (KRN O 0 R -1.92)
+ (KRN O 0 R -1.93)
+ (KRN O 0 R -1.94)
+ (KRN O 0 R -1.95)
+ (KRN O 0 R -1.96)
+ (KRN O 0 R -1.97)
+ (KRN O 0 R -1.98)
+ (KRN O 0 R -1.99)
+ (KRN O 0 R -2.0)
+ (KRN O 0 R -2.01)
+ (KRN O 0 R -2.02)
+ (KRN O 0 R -2.03)
+ (KRN O 0 R -2.04)
+ (KRN O 0 R -2.05)
+ (KRN O 0 R -2.06)
+ (KRN O 0 R -2.07)
+ (KRN O 0 R -2.08)
+ (KRN O 0 R -2.09)
+ (KRN O 0 R -2.1)
+ (KRN O 0 R -2.11)
+ (KRN O 0 R -2.12)
+ (KRN O 0 R -2.13)
+ (KRN O 0 R -2.14)
+ (KRN O 0 R -2.15)
+ (KRN O 0 R -2.16)
+ (KRN O 0 R -2.17)
+ (KRN O 0 R -2.18)
+ (KRN O 0 R -2.19)
+ (KRN O 0 R -2.2)
+ (KRN O 0 R -2.21)
+ (KRN O 0 R -2.22)
+ (KRN O 0 R -2.23)
+ (KRN O 0 R -2.24)
+ (KRN O 0 R -2.25)
+ (KRN O 0 R -2.26)
+ (KRN O 0 R -2.27)
+ (KRN O 0 R -2.28)
+ (KRN O 0 R -2.29)
+ (KRN O 0 R -2.3)
+ (KRN O 0 R -2.31)
+ (KRN O 0 R -2.32)
+ (KRN O 0 R -2.33)
+ (KRN O 0 R -2.34)
+ (KRN O 0 R -2.35)
+ (KRN O 0 R -2.36)
+ (KRN O 0 R -2.37)
+ (KRN O 0 R -2.38)
+ (KRN O 0 R -2.39)
+ (KRN O 0 R -2.4)
+ (KRN O 0 R -2.41)
+ (KRN O 0 R -2.42)
+ (KRN O 0 R -2.43)
+ (KRN O 0 R -2.44)
+ (KRN O 0 R -2.45)
+ (KRN O 0 R -2.46)
+ (KRN O 0 R -2.47)
+ (KRN O 0 R -2.48)
+ (KRN O 0 R -2.49)
+ (KRN O 0 R -2.5)
+ (KRN O 0 R -2.51)
+ (KRN O 0 R -2.52)
+ (KRN O 0 R -2.53)
+ (KRN O 0 R -2.54)
+ (KRN O 0 R -2.55)
+ (KRN O 0 R -2.56)
+ (KRN O 0 R -2.57)
+ (/LIG/>> C r C s)
+ (/LIG/ C p C s)
+ (KRN C s R 0.3)
+ )
+ )
+(CHARACTER C u
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG C Z C p)
+ (LIG C p C r)
+ )
+ )
+(CHARACTER O 202
+ (CHARWD R 0.400001)
+ )
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip.tex b/Build/source/texk/web2c/etexdir/etrip/etrip.tex
new file mode 100644
index 00000000000..ab3468d5cd8
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip.tex
@@ -0,0 +1,1249 @@
+%%; This is `etrip.tex' for e-TeX v3.141592-2.2 as of August 21, 2004.
+%%;
+%%; This is a diabolical test file for e-TeX, an extension of TeX82.
+%%; It is not as diabolical as `trip.tex', Knuth's torture test for TeX.
+%%;
+%%; ==>> Do not use this TeX code and its macros as an example <<==
+%%; ==>> how you can make use of the new e-TeX features! It is <<==
+%%; ==>> meant to test these extensions and often uses slightly <<==
+%%; ==>> wrong e-TeX input to produce errors and warnings. <<==
+%%;
+\catcode`\{=1\catcode`\}=2\catcode`\#=6 \let\bgroup={ \let\egroup=}
+\def\etripdate {2004-09-06}
+\def\texversion {3.141592}
+\def\etripversion{2.2}
+%
+\message{This is the e-Trip test [\etripdate] for
+ e-TeX v\texversion-\etripversion.}
+%
+% --- Make sure that e-Trip is run in e-TeX extended mode
+\def\stop#1{\message{Emergency stop: #1!}}
+\expandafter\ifx\csname eTeXversion\endcsname\relax
+ \stop{You aren't using e-TeX in extended mode}
+ \message{(Do not forget to give an asterisk `*' as the first non-blank}
+ \message{character to make e-IniTeX enter extended mode.)}
+ \expandafter\end
+\fi
+%
+% --- Check for e-TeX version
+\def\1.#1#2\relax{\bgroup
+ \edef\1{\egroup
+ \def\noexpand\2{\number\eTeXversion\eTeXrevision}%
+ \def\noexpand\1{\number\eTeXversion.#1}}\1}
+\expandafter\1\eTeXrevision\relax
+\message{(You are using e-TeX version/revision \2)}
+\ifx\1\etripversion \else \stop{I have expected e-TeX
+ v\texversion-\etripversion...}\expandafter\end\fi
+\let\1=\5 \let\2=\5
+%
+% --- a special branch for e-IniTeX
+\ifx\einitex\undefined \def\einitex{}
+ %
+ \message{e-IniTeX: Assigning category codes,}
+ \catcode`\$=3\catcode`\&=4
+ \catcode`\^=7\catcode`\^^I=10\catcode`\_=8
+ \message{tracing switches,}
+ \tracingstats=4\tracinglostchars=2
+ \message{other codes,}
+ \endlinechar=`\^^M \newlinechar=`\^^J
+ %
+ \message{definitions for e-VirTeX e-Trip test run,}
+ \def\error{\immediate\write15{Bug in your e-TeX implementation!}%
+ \immediate\write15 }
+ \def\typeout{\immediate\write15 }
+ \def\empty{} \def\space{ }
+ %
+ \message{constants and registers,}
+ \chardef\zero=0\chardef\one=1\chardef\two=2
+ \countdef\ctmp=255 \countdef\cndx=254
+ %
+ \message{fonts,}
+ \fontdimen12\nullfont=13pt
+ \font\trip=etrip \hyphenchar\trip=`1 \trip
+ \textfont0=\trip \textfont1=\trip
+ \font\smalltrip=etrip scaled 500\relax % our symbols font
+ \fontdimen22\smalltrip=7pt
+ \textfont2=\smalltrip \scriptfont2=\smalltrip
+ \scriptscriptfont2=\smalltrip
+ \font\bigtrip=etrip at 20pt\relax % our extension font
+ \textfont3=\bigtrip \scriptfont3=\bigtrip
+ \scriptscriptfont3=\bigtrip
+ %
+ \message{some math characters,}
+ \delcode`\[="161361 % small (family 1, character "61 (a)), large (3,"61)
+ \delcode`\|="142342 % small (family 1, character "42 (B)), large (3,"42)
+ \delcode`\]="162362 % small (family 1, character "62 (b)), large (3,"62)
+ %
+ \message{some math parameters,}
+ \thinmuskip=18mu plus 3.6mu
+ \medmuskip=27mu plus 9mu minus 18mu
+ \thickmuskip=36mu minus 7.2mu
+ %
+ \message{hyphenation,}
+ \lefthyphenmin=2\righthyphenmin=2
+ \begingroup
+ \def\x{\patterns{%
+ .pp1aqq. .up1aqq. .ppb1qq. .upb1qq. .pp1r1qq. .up1r1qq.}}
+ \language=0 \x \savinghyphcodes=1
+ \language=1 \lccode`A=`a \lccode`B=`b \x
+ \language=2 \lccode`A=`r \lccode`B=`b \x
+ \language=3 \lccode`A=`a \lccode`B=`r \x
+ {\def\1{\lccode\count20=0 \ifnum\count20<255 \advance\count20 1
+ \expandafter\1\fi}\count20=0 \1
+ \language=4 \patterns{}}
+ {\lccode`B=`b \hyphenation{qqB-pp}}
+ \count20=\interactionmode \nonstopmode
+ {\setbox0\vbox{\parfillskip=0pt
+ \hbadness=0 \showboxdepth=0
+ \hsize=16383.99999pt \pretolerance=-1 \tolerance=-1
+ \trip\ ppaqq upaqq ppbqq upbqq pprqq uprqq qqbpp}}
+ {\lccode`B=`b \language=4 \hyphenation{-q-}}
+ \interactionmode=\count20
+ {\lccode`B=`b \hyphenation{qq-B-pp}}
+ \endgroup
+ %
+ \message{enable e-TeX enhancements (TeXXeT),}
+ \TeXXeTstate=1
+ %
+ \message{prepare saved items (not to be dumped),}
+ \bgroup \savingvdiscards=1
+ \vfill \penalty 1234 % set \pagediscards
+ \setbox0=\vbox{\vbox to10pt{}\vskip5pt\penalty-4321}
+ \setbox1=\vsplit0 to10pt % set \splitdiscards
+ \egroup
+ %
+ \message{everyjob ...dumped.}
+ \everyjob={\message{e-IniTeX: e-Trip format loaded.}}
+ \expandafter\dump
+\fi
+
+%
+% -- Test \lostchars=1 and 2
+\begingroup
+ \tracingonline=0
+ \setbox0=\hbox{%
+ \tracinglostchars=0 \nullfont a%
+ \tracinglostchars=1 \nullfont b%
+ \tracinglostchars=2 \nullfont c%
+ }
+\endgroup
+%
+% -- Do the rest in silent, almost all of it:
+\batchmode
+
+%
+% -- Check that all e-TeX enhancements are switched off
+\ifnum\TeXXeTstate=0 \else
+ \error{dumped e-TeX enhancement state registers aren't switch off}
+\fi
+
+%
+% ============================== input/output: new csnames
+%
+% -- Check table of equivalents and the routines |id_lookup|,
+% |print_cmd_chr| for all new e-TeX control sequences
+% -- Check new primitive \unexpanded (first test)
+\typeout{Checking input/output of new csnames:}
+\begingroup
+ \edef\1{%
+ \unexpanded{%
+% --- additional e-TeX V 1 primitives
+ \eTeXversion \eTeXrevision \showgroups \showtokens
+ \tracingassigns \tracinggroups \tracingifs \tracingscantokens
+ \currentgrouplevel \currentgrouptype \middle \lastnodetype
+ \TeXXeTstate \beginL \endL \beginR \endR \predisplaydirection
+ \marks \topmarks \firstmarks \botmarks
+ \splitfirstmarks \splittopmarks
+ \protected \unexpanded \detokenize \scantokens \readline
+ \unless \ifdefined \ifcsname \everyeof \interactionmode
+% --- additional e-TeX V 2 primitives
+ \currentiflevel \currentiftype \currentifbranch \showifs
+ \fontcharwd \fontcharht \fontchardp \fontcharic \iffontchar
+ \tracingnesting \parshapelength \parshapeindent \parshapedimen
+ \numexpr \dimexpr \glueexpr \muexpr \mutoglue \gluetomu
+ \gluestretchorder \glueshrinkorder \gluestretch \glueshrink
+ \savingvdiscards \pagediscards \splitdiscards
+ \lastlinefit \savinghyphcodes \interlinepenalties
+ \clubpenalties \widowpenalties \displaywidowpenalties
+ }%
+ }
+
+% loop through the list, count the number of csnames,
+% insert the \newlinechar after the 2nd, 4th, 6th, ...
+ \ctmp=0\def\3{}
+ \def\2#1{\ifx\relax#1\else
+ \advance\ctmp\one
+ \edef\3{\unexpanded\expandafter{\3 #1}\ifodd\ctmp\else ^^J\fi}%
+ \expandafter\2\fi}
+ \expandafter\2\1\relax
+ \typeout{e-TeX Version \number\eTeXversion\space has
+ \number\ctmp\space new csnames:}%
+ \show\3\endgroup
+
+%
+% ============================== create and output nodes
+%
+% -- Check |new_...| routines and |short_display|, |show_node_list|
+% for all new e-TeX node types and subtypes
+% -- Check for new primitives disabled when read.
+\typeout{Checking creation and printing for new node types:}
+\tracingonline=1
+\showboxbreadth=255\showboxdepth=255
+\begingroup
+ \setbox0=\vbox{\hsize=0pt\TeXXeTstate=1\relax
+ %% []\trip a[]b[]p$q [] t$u[][] % <== \endR\endL at end
+ a\beginL b\beginR p$q\left[\mathpunct{r}\middle|s\right]t$u
+ %% \trip aMb
+ $$aMb$$ % \hbox ..., display
+ %% [][]\trip p[]q$st$u[] % <== \beginL\beginR at beginning
+ p\endR q\mathsurround=12.3pt$st$u % <== \endL at end
+ %% \trip rMs
+ $$rMs$$ % \hbox ..., display
+ %% []\trip tp[]u % <== \beginL at beginning
+ tp\endL u
+ %% \trip rMs
+ $$rMs$$ % \hbox ..., display
+ %% \trip tp % <== no \mark(s), no \(begin/end)(L/R)!
+ tp\mark{0old}\marks0{0}\marks1{1}\marks15{15}\marks32767{32767}%
+ \marks-1{-1}\marks32768{32768}% Bad register (-1) ...and (32768).
+ \TeXXeTstate=0\relax
+ \beginL\beginR\endL\endR % Improper \(begin/end)(L/R)
+ }\showbox0
+\endgroup
+
+%
+%
+% ============================== \interactionmode
+%
+% -- Check new special register \interactionmode
+\typeout{Checking \string\interactionmode:}
+\begingroup \ctmp=\interactionmode % save current value
+\nonstopmode
+% test inquiry using \interactionmode
+\def\3{\typeout{current interactionmode (l.\number\inputlineno):
+ \ifcase\interactionmode batch\or nonstop\or scroll\or
+ errorstop\else UNKNOWN!\fi}}
+\def\1#1{\relax\ifnum#1=\interactionmode \3 \else
+ \typeout{wrong interactionmode:
+ \number\interactionmode\space should be \number#1!}\fi}
+\batchmode \1 0
+\nonstopmode \1 1
+\scrollmode \1 2
+\errorstopmode \1 3
+% test setting |interaction_mode| using this special register
+\def\2#1{\interactionmode=#1\relax \1{#1}}
+ \nonstopmode
+ % generate two errors:
+ \interactionmode=-1 \1 1 % nonstop
+ \interactionmode=4 \1 1 % nonstop
+\2 2 \2 2 \2 1 \2 1 \2 3 \2 3 \2 0 \2 0
+\1 0{\interactionmode=3}\1 3 % global assignment!
+% Test for the correct call of |new_interaction|, i.e.
+% correct setting of |selector|:
+\interactionmode=1 \message{1 (l.\number\inputlineno)}% log+term
+\interactionmode=0 \message{0 (l.\number\inputlineno)}% log only
+\interactionmode=1 \message{1 (l.\number\inputlineno)}% log+term
+% Some tests with TeX's old command and register assignments
+\batchmode \1 0 \2 3 \scrollmode \1 2 \2 1
+\2 \ctmp
+\endgroup
+
+%
+% -- Check \tracingifs
+\typeout{Checking \string\tracingifs:}
+\begingroup
+ \def\1#1\1{\def\2{#1\iffalse \else \fi}#1\iftrue \2\else \2\fi}
+ \tracingifs=1
+ \1\1
+ \1\unless\1
+ \tracingcommands=2
+ \ifdefined\hbox \unless\ifdefined\abc \ifcase 2 \or \or
+ \ifcsname hbox\endcsname \ifcsname abc\endcsname \abc \else
+ \ifx\abc\relax \else \ifx\abc\relax \fi \fi \fi \fi \or\fi \fi \fi
+\endgroup
+%
+% -- Check \tracingassigns
+\typeout{Checking \string\tracingassigns:}
+\begingroup
+ \tracingrestores=1 \tracingassigns=1
+ \global\count17=7 \count17=7
+ \global\def\9{\relax} \global\let\8=\9 \let\8=\9
+ \bgroup
+ \global\count17=0 \count17=0
+ \global\let\9=\7 \global\let\8=\9 \let\8=\9
+ \egroup
+\endgroup
+
+%
+% -- Check \currentgrouptype, \currentgrouplevel, and \lastnodetype
+\typeout{Checking \string\currentgrouptype,
+ \string\currentgrouplevel, and \string\lastnodetype:}
+\typeout{current group level (l.\number\inputlineno):
+ \ifcase\currentgrouptype outer level\else BAD!\fi}
+\typeout{current group type (l.\number\inputlineno):
+ \ifcase\currentgrouptype bottom level\else BAD!\fi}
+\begingroup
+ \def\4{\typeout{current group type (l.\number\inputlineno):
+ \ifcase\currentgrouptype bottom level\or simple group\or
+ hbox group\or adjusted hbox group\or vbox group\or
+ vtop group\or align group\or no align group\or
+ output group\or math group\or disc group\or
+ insert group\or vcenter group\or math choice group\or
+ semi simple group\or math shift group\or
+ math left group\else UNKNOWN!\fi}}
+ \def\1 #1 {\relax\ifnum#1=\currentgrouptype \4\else
+ \typeout{wrong current group type:
+ \number\currentgrouptype\space should be #1!}\fi}
+ \def\5{\edef\6{\ifcase\lastnodetype char node\or hlist node\or
+ vlist node\or rule node\or ins node\or mark node\or
+ adjust node\or ligature node\or disc node\or whatsit node\or
+ math node\or glue node\or kern node\or penalty node\or
+ unset node\or math mode node\else
+ \ifnum-1=\lastnodetype empty\else UNKNOWN!\fi\fi}%
+ \typeout{last node type (l.\number\inputlineno): \6}}
+ \def\2 #1 {\relax\ifnum#1=\lastnodetype \5\else
+ \typeout{wrong last node type:
+ \number\lastnodetype\space should be #1!}\fi}
+ \def\3 #1 {\relax\ifnum#1=\currentgrouplevel \else
+ \typeout{wrong current group level:
+ \number\currentgrouplevel\space should be #1!}\fi}
+ \tracinggroups=1
+ \1 14 % semi simple group
+ \3 1 % group level 1
+ \setbox0=\vbox{\1 4 % vbox group
+ \hbox{\1 3 % adjusted hbox group
+ {\1 1 % simple group
+ }\2 -1 % empty list
+ \hbox{\1 2 % hbox group
+ \discretionary{\1 10 }{\1 10 }{\1 10 % disc group
+ \3 5 % group level 5
+ }\2 8 % disc node
+ A\2 0 % char node
+ AA\2 7 % ligature node
+ \insert27{\1 11 % insert group
+ }\2 4 % ins node
+ \vadjust{\1 11 % insert group
+ }\2 6 % adjust node
+ \mark{}\2 5 % mark node
+ \vrule \2 3 % rule node
+ \hfil \2 11 % glue node
+ \kern 0pt\2 12 % kern node
+ \penalty 0\2 13 % penalty node
+ \vtop{\1 5 % vtop group
+ }\2 2 % vlist node
+ \write5{}\2 9 % whatsit node
+ $\1 15 % math shift group
+ {\1 9 % math group
+ }
+ $\2 10 % math node
+ \TeXXeTstate=1\beginR\2 10 % math node
+ \endR\2 10 % math node
+ \valign{#\cr\1 6 % two align groups
+ \cr\noalign{\1 7 % no align agroup
+ \2 14 % unset node
+ }
+ }
+ }
+ }\2 1 % hlist node
+ $$\1 15 % math shift group
+ \2 -1 % empty list
+ \mathchoice{\1 13 }{\1 13 }{\1 13 }{\1 13 % math choice group
+ \vcenter{\1 12 % vcenter group
+ }\2 15 % math mode node
+ }\2 15 % math mode node
+ \left.\1 16 % math left group
+ \middle.\1 16 % math left group
+ \middle.\1 16 % math left group
+ \right.
+ $$
+ }
+ \output={\1 8 % output group
+ \setbox0=\box255
+ \setbox0=\vbox{ % vbox group % this is definitely weird!
+ \hbox spread 5pt{\hfil % adjusted hbox group
+ \raise5pt\hbox{ % hbox group
+ { %simple group
+ \valign{#\cr % two align groups
+ \noalign{ % no align group
+ $ % math shift group
+ \vtop{ % vtop group
+ $$ % math shift group
+ { % math group
+ \left.\middle. % math left group
+ \mathchoice{}{}{ % math choice group
+ \vcenter to 7pt{\vss % vcenter group
+ \noindent\vadjust{ % insert group
+ \discretionary{}{% disc group
+ \showgroups % show all of them
+ }{}
+ }
+ }
+ }{}
+ \right.
+ }
+ $$
+ }
+ $
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ \hbox{}\vfil\penalty-10000
+ \deadcycles=0
+\endgroup
+
+%
+% -- Check expansion of \protected macros
+\typeout{Checking expansion of \string\protected\space macros:}
+\begingroup
+ \protected\def\2{} \show\2
+ \let\3=\2 \show\3
+ \protected\unexpanded\bgroup\2\protected\3\protected\def\1{\2}} \show\1
+ \tracingmacros=1
+ \message{\expandafter\1\1}
+ \typeout{\expandafter\1\1}
+ \setbox0=\vbox{\special{\expandafter\1\1}} \showbox0
+ \edef\5{\expandafter\1\1} \show\5
+ \setbox0=\vbox{\halign{#\1&#\span\1\cr
+ \protected\def\1{\3}&\protected\def\1{\3}\cr}}
+\endgroup
+
+%
+% -- Check \scantokens, \tracingscantokens, \readline, and \everyeof
+\typeout{Checking \string\scantokens, \string\tracingscantokens,
+ \string\readline, and \string\everyeof:}
+\begingroup
+ \newlinechar=`\^^J
+ \def\1{\endgroup ^^J\fi ^^J\bgroup ^^J\iffalse \else}
+ \tracingoutput=1
+ \shipout\vbox{\global\advance\count\zero by\one
+ \openout1=\jobname.out
+ \write1{\unexpanded\expandafter{\1}}
+ \closeout1}
+ \begingroup \iftrue \input\jobname.out \egroup \fi
+ \begingroup \iftrue \scantokens\expandafter{\1} \egroup \fi
+ \errorcontextlines=1000 \tracingscantokens=1
+ \begingroup
+ \tracingnesting=1
+ \begingroup \iftrue \scantokens\expandafter{\1} \egroup \fi
+ \tracingnesting=2
+ \begingroup \unless\iffalse \scantokens\expandafter{\1} \egroup \fi
+% and now a really weird (although legitimate) combination
+ \setbox0=\hbox\bgroup
+ \unless\iftrue\else
+ \scantokens{\hbox\bgroup^^J\ifcase0^^J\tracingscantokens=0^^J
+ \newlinechar=`\^^Z
+ \scantokens{\egroup^^Z\else\fi^^Z\def\1{\egroup\fi}^^Z\1^^Z^^J
+ \setbox0=\vtop\bgroup^^Z\ifnum0=0^^Z$$^^Z\ifinner\else^^Z
+ \csname iffalse\endcsname^^J
+ }^^J % end of inner scantokens
+ $$^^J\fi
+ } % end of outer \scantokens
+ \egroup
+ \else\fi
+ \endgroup
+ \begingroup \iftrue \let\9=\endgroup \def\endgroup{\9\9}
+ \input\jobname.out \egroup \fi
+ \begingroup \iftrue \let\9=\endgroup \def\endgroup{\9\9}
+ \scantokens\expandafter{\1} \egroup \fi
+
+ \edef\1{\scantokens{\begingroup} % <== error
+ \everyeof={\noexpand}
+ \edef\1{\scantokens{\begingroup}\endgroup} % <== OK
+ \errorcontextlines=100
+ \def\2{\begingroup\scantokens{\message{level=\the\currentgrouplevel}}%
+ \endgroup}
+ \bgroup\bgroup\bgroup \edef\1{\egroup\egroup\egroup
+ \everyeof={\noexpand\ifnum\number\currentgrouplevel
+ \unexpanded{>\currentgrouplevel\2\else\9\fi}}}\1\2
+
+ \openin7=\jobname.out
+ \bgroup
+ \def\1{\unless\ifeof7\readline7to\2%
+ \endlinechar=-\one\2\expandafter\1\fi}
+ \tracingcommands=2 \tracingrestores=1 \tracingassigns=1
+ \setbox25=\hbox{\1\showlists}
+ \egroup
+
+\endgroup
+
+%
+% -- Check \marks etc., \showtokens, and \detokenize
+\typeout{Checking \string\marks\space etc., \string\showtokens, and
+ \string\detokenize:}
+\begingroup
+ \newlinechar=`\^^J
+ \def\4{\message{Current marks:\9^^J}}
+ \def\3#1{\edef\9{\9^^J \detokenize{#1}=\detokenize\expandafter{#1}.}}
+ \def\2#1 {\3{\splitfirstmarks#1}\3{\splitbotmarks#1}}
+ \def\0{\let\9=\empty}
+ \def\7{\penalty0\vskip40pt}
+ \def\1{\0\20 \21 \23 \4}
+ \setbox0=\vbox{%
+ \marks0{0-1}\marks1{1-1}\vskip1pt\vbox to9pt{}
+ \mark{0-2}\marks3{}\hbox{}\vskip5pt\vfil\7
+ \marks0{0-3}\vskip1pt\vbox to19pt{}\marks3{3-3}\vskip3ptplus1fil\7
+ \vbox to30pt{}\vfil\7\hbox to10pt{}}
+ \setbox4=\copy0
+ \1 \showbox0 \let\5=\3 \def\3#1{\showtokens\expandafter{#1}\5{#1}}
+ \setbox1=\vsplit0to17pt
+ \1 \showbox1 \showbox0 \let\3=\5
+ \setbox1=\vsplit0to27pt
+ \1 \showbox1 \showbox0
+ \setbox1=\vsplit0to37pt
+ \1 \showbox1 \showbox0
+ \def\2#1 {\3{\topmarks#1}\3{\firstmarks#1}\3{\botmarks#1}}
+ \vsize=35pt \output{\1 \showbox255 \setbox0=\box255}\1
+ \unvbox4\marks0{}\marks1{}\marks3{}\vfil\penalty-10000
+ \hbox{}\marks0{}\marks1{}\marks3{}\vfil\penalty-10000
+ \hbox{}\vfil\penalty-10000 % reclaim sparse array memory!
+ \deadcycles=0
+\endgroup
+
+%
+% -- Check \middle
+\typeout{Checking \string\middle:}
+\begingroup
+ \scriptfont1=\textfont1 \scriptscriptfont1=\scriptfont1
+ \setbox0=\vbox{\middle \par \right \par} % <== 8 errors
+ \setbox0=\hbox{%
+ $
+ \left[p
+ \left[q
+ \over r
+ \left[p
+ \middle|q
+ \middle|q
+ \left[p
+ \middle|q
+ \middle|q
+ \over r\showlists
+ \right]\showlists
+ \right]\showlists
+ \right]\showlists
+ \right]\showlists
+ $\showlists
+ }
+ \setbox0=\hbox{$\displaystyle
+ \left[\scriptstyle\middle|\mathchoice{p}{q}{r}{s}
+ \raise16.5pt\hbox{}\right]$\showlists}
+ \setbox0=\hbox{$\scriptscriptstyle
+ \left[\displaystyle\lower3pt\hbox{}\middle|\mathchoice{p}{q}{r}{s}
+ \right]$\showlists}
+\endgroup
+
+%
+% -- Check TeX--XeT's new primitives
+\typeout{Checking TeX--XeT enhancements:}
+\begingroup
+% -- incorrect matching & conversion
+% (extra `endL/R' nodes are converted to `kern 0.0' nodes)
+ \setbox0=\vbox{\TeXXeTstate=1
+ \parfillskip=0pt plus1fil\hsize=10pt\parindent=.5pt
+ \beginL\kern1pt\par
+ \beginR\kern2pt\par
+ \beginL\beginR\kern3pt\penalty0\hbox{}\kern3pt\endL\endR\endL\par
+ \endL\kern4pt\endR\par}
+ \showbox0
+% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% STILL INCOMPLETE!!!
+% %%%%% Missing: Test for functionality of all new primitives
+% \TeXXeTstate \beginL \endL \beginR \endR \predisplaydirection
+% %%%%%
+\endgroup
+
+%
+% -- Check optimized \aftergroup
+\typeout{Checking optimized \string\aftergroup:}
+\begingroup
+ \errorcontextlines=1000
+ {{\aftergroup\x\aftergroup}\aftergroup{\aftergroup\relax}}
+\endgroup
+
+%
+% -- Check \showifs, \currentiftype, \currentiflevel, and \currentifbranch
+\typeout{Checking \string\showifs, \string\currentiftype,
+ \string\currentiflevel, and \string\currentifbranch:}
+\begingroup
+ \def\1{ !BAD} \edef\2{ \ifnum0=\currentifbranch OK\else!BAD\fi}
+ \iftrue \expandafter \ifnum \number\currentifbranch=1
+ \iffalse \else \expandafter \ifnum \number\currentifbranch=-1
+ \ifnum \currentifbranch=0 \let\1=\2 \fi \fi \fi \fi \fi
+ \message{\string\currentifbranch \1}
+ \def\1 #1 {\edef\2{\number\currentiflevel}%
+ \ifnum\2=#1
+ \typeout{current if level (l.\number\inputlineno): \number\2}%
+ \else
+ \typeout{wrong current if level: \2\space should be #1!}%
+ \fi}
+ \1 0 % if level 0
+ \iftrue \1 1 % if level 1
+ \iftrue \1 2 % if level 2
+ \fi
+ \fi
+ \def\1 #1 #2 {\edef\2{\number\currentiftype}%
+ \edef\3{\number\currentifbranch}%
+ \ifnum\2=#1 \4\else
+ \typeout{wrong current if type: \2\space should be #1!}\fi
+ \ifnum\3=#2 \5\else
+ \typeout{wrong current if branch: \3\space should be #2!}\fi}
+ \def\4{\typeout{current if type (l.\number\inputlineno):
+ \ifnum\2<0 \string\unless\6{-\2}\else\6{\2}\fi}}
+ \def\5{\typeout{current if branch (l.\number\inputlineno):
+ \ifnum\3>0 true\else \ifnum\3<0 false\else
+ \ifnum0=\3 no\else !UNKNOWN\fi\fi\fi\space branch}}
+ \def\6#1{\string\if \ifcase#1!NONE\or \or cat\or num\or dim\or odd\or
+ vmode\or hmode\or mmode\or inner\or void\or hbox\or vbox\or x\or
+ eof\or true\or false\or case\or defined\or csname\or fontchar\else
+ !UNKNOWN\fi}
+ \1 0 0
+ \if00 \1 1 1 \fi \unless\if00 \else \1 -1 -1 \fi
+ \if0a \else \1 1 -1 \fi \unless\if0a \1 -1 1 \fi
+ \ifcat00 \1 2 1 \fi \unless\ifcat00 \else \1 -2 -1 \fi
+ \ifcat0a \else \1 2 -1 \fi \unless\ifcat0a \1 -2 1 \fi
+ \ifnum1=1 \1 3 1 \fi \unless\ifnum1<1 \1 -3 1 \fi
+ \ifdim1pt=2pt \else \1 4 -1 \fi \unless\ifdim1pt>2pt \1 -4 1 \fi
+ \ifodd5 \1 5 1 \fi \unless\ifodd5 \else \1 -5 -1 \fi
+ \setbox2=\vbox{
+ \ifvmode \1 6 1 \fi \unless\ifvmode \else \1 -6 -1 \fi
+ } \setbox0=\box2
+ \setbox1=\hbox{
+ \ifhmode \1 7 1 \fi \unless\ifhmode \else \1 -7 -1 \fi
+ $
+ \ifmmode \1 8 1 \fi \unless\ifmmode \else \1 -8 -1 \fi
+ $
+ \ifinner \1 9 1 \fi
+ }
+ \unless\ifinner \1 -9 1 \fi
+ \ifvoid2 \1 10 1 \fi \unless\ifvoid0 \1 -10 1 \fi
+ \ifhbox1 \1 11 1 \fi \unless\ifhbox2 \1 -11 1 \fi
+ \ifvbox0 \1 12 1 \fi \unless\ifvbox1 \1 -12 1 \fi
+ \ifx\abc\relax \else \1 13 -1 \fi \unless\ifx\relax\abc \1 -13 1 \fi
+ \ifeof7 \1 14 1 \fi \unless\ifeof5 \else \1 -14 -1 \fi
+ \iftrue \1 15 1 \fi \unless\iftrue \else \1 -15 -1 \fi
+ \iffalse \else \1 16 -1 \fi \unless\iffalse \1 -16 1 \fi
+ \ifcase2 \or \or \1 17 1 \fi \ifcase2 \or \else \1 17 -1 \fi
+ \ifdefined\hbox \1 18 1 \fi \unless\ifdefined\abc \1 -18 1 \fi
+ \ifcsname hbox\endcsname \1 19 1 \fi
+ \unless\ifcsname abc\endcsname \1 -19 1 \fi
+ \iffontchar\trip`b \1 20 1 \fi \unless\iffontchar\trip`c \1 -20 1 \fi
+%
+ \if00 \unless\if00 \else \if0a \else \unless\if0a
+ \ifcat00 \unless\ifcat00 \else \ifcat0a \else \unless\ifcat0a
+ \ifnum1=1 \unless\ifnum1<1 \ifdim1pt=2pt \else \unless\ifdim1pt>2pt
+ \ifodd5 \unless\ifodd5 \else
+ \setbox3=\vbox{\ifvmode \unless\ifvmode \else
+ \hbox{\ifhmode \unless\ifhmode \else
+ $\ifmmode \unless\ifmmode \else \ifinner \unless\ifinner \else
+ \ifvoid2 \unless\ifvoid0 \ifhbox1 \unless\ifhbox2
+ \ifvbox0 \unless\ifvbox1 \ifeof7 \unless\ifeof5 \else
+ \ifx\abc\relax \else \unless\ifx\relax\abc
+ \iftrue \unless\iftrue \else \iffalse \else \unless\iffalse
+ \ifcase2 \or \or \ifcase2 \or \else
+ \ifdefined\hbox \unless\ifdefined\abc
+ \begingroup \tracingifs=1
+ \ifcsname hbox\endcsname \unless\ifcsname abc\endcsname
+ \iffontchar\trip`b \unless\iffontchar\trip`c
+ \showifs % <== show 44 nested ifs
+ \fi \fi
+ \fi \fi
+ \endgroup
+ \fi \fi
+ \fi \fi
+ \fi \fi \fi \fi
+ \fi \fi
+ \fi \fi \fi \fi
+ \fi \fi \fi \fi
+ \fi \fi \fi \fi $
+ \fi \fi }
+ \fi \fi }
+ \fi \fi
+ \fi \fi \fi \fi
+ \fi \fi \fi \fi
+ \fi \fi \fi \fi
+\endgroup
+
+%
+% -- Check \iffontchar, \fontcharwd, etc.
+\typeout{Checking \string\iffontchar, \string\fontcharwd, etc.:}
+\begingroup
+ \iffontchar \else \fi % <== missing font identifier and number
+ \iffontchar\textfont2 -1 \else \fi % <== bad character code
+ \iffontchar\font 256 \else \fi % <== bad character code
+ \fontcharwd \fontcharht \fontchardp \fontcharic % <== can't use
+ \def\1#1#2{%
+ \def\2##1##2{\ifdim\csname fontchar##1##2\endcsname#1`#2=0pt \else
+ \space##1##2=\the\csname fontchar##1##2\endcsname#1`#2 \fi}%
+ \typeout{Font \string#1 character #2%
+ \iffontchar#1`#2:\2wd\2ht\2dp\2ic\else \space does not exist\fi}}
+ \1\font A \1{\textfont1}B \1{\scriptfont2}B \1{\scriptscriptfont3}B
+ \1\trip 7 \1\trip D \1\nullfont D
+%
+ \def\1#1{\cndx=\zero \ctmp=\zero
+ \def\2{\iffontchar#1\cndx \advance\ctmp by\one \fi
+ \advance\cndx by\one
+ \ifnum\cndx<256 \expandafter\2\fi}%
+ \2%
+ \typeout{Font \string#1 has \number\ctmp\space character%
+ \ifnum1=\cndx \else s\fi .}}
+ \1\font \1\trip \1\nullfont
+\endgroup
+
+%
+% -- Check \parshapelength, \parshapeindent, and \parshapedimen
+\typeout{Checking \string\parshapelength, \string\parshapeindent, and
+ \string\parshapedimen:}
+\begingroup
+ \parshapelength \parshapeindent \parshapedimen % <== can't use
+ \def\1#1 {\edef\2{\2 #1}}
+ \let\2=\empty
+ \ifdim\parshapeindent-5=0pt \else\1a \fi
+ \ifdim\parshapelength-5=0pt \else\1b \fi
+ \ifdim\parshapeindent-1=0pt \else\1c \fi
+ \ifdim\parshapelength-1=0pt \else\1d \fi
+ \ifdim\parshapeindent-0=0pt \else\1e \fi
+ \ifdim\parshapelength-0=0pt \else\1f \fi
+ \ifdim\parshapeindent 1=0pt \else\1g \fi
+ \ifdim\parshapelength 1=0pt \else\1h \fi
+ \ifdim\parshapeindent 5=0pt \else\1j \fi
+ \ifdim\parshapelength 5=0pt \else\1i \fi
+ \ifdim\parshapedimen-5=0pt \else\1k \fi
+ \ifdim\parshapedimen-1=0pt \else\1l \fi
+ \ifdim\parshapedimen 0=0pt \else\1m \fi
+ \ifdim\parshapedimen 1=0pt \else\1n \fi
+ \ifdim\parshapedimen 2=0pt \else\1o \fi
+ \typeout{Parshape test 1 \ifx\2\empty OK\else error(s):\2\fi}
+ \parshape=2 1pt 2pt 3pt 4pt
+ \let\2=\empty
+ \ifdim\parshapeindent-5=0pt \else\1a \fi
+ \ifdim\parshapelength-5=0pt \else\1b \fi
+ \ifdim\parshapeindent-1=0pt \else\1c \fi
+ \ifdim\parshapelength-1=0pt \else\1d \fi
+ \ifdim\parshapeindent-0=0pt \else\1e \fi
+ \ifdim\parshapelength-0=0pt \else\1f \fi
+ \ifdim\parshapedimen-5=0pt \else\1g \fi
+ \ifdim\parshapedimen-1=0pt \else\1h \fi
+ \ifdim\parshapedimen 0=0pt \else\1i \fi
+ \typeout{Parshape test 2 \ifx\2\empty OK\else error(s):\2\fi}
+ \parshape=2 1pt 2pt 3pt 4pt
+ \parshape=2 \parshapelength2 \parshapeindent2
+ \parshapelength1 \parshapeindent1
+ \let\2=\empty
+ \ifdim\parshapeindent1=4pt \else\1A \fi
+ \ifdim\parshapelength1=3pt \else\1B \fi
+ \ifdim\parshapeindent2=2pt \else\1C \fi
+ \ifdim\parshapelength2=1pt \else\1D \fi
+ \ifdim\parshapeindent3=2pt \else\1E \fi
+ \ifdim\parshapelength3=1pt \else\1F \fi
+ \ifdim\parshapeindent9=2pt \else\1G \fi
+ \ifdim\parshapelength9=1pt \else\1H \fi
+ \typeout{Parshape test 3 \ifx\2\empty OK\else error(s):\2\fi}
+ \parshape=2 1pt 2pt 3pt 4pt
+ \parshape=2 11\parshapedimen4 11\parshapedimen3
+ 11\parshapedimen2 11\parshapedimen1
+ \let\2=\empty
+ \ifdim\parshapedimen1=44pt \else\1A \fi
+ \ifdim\parshapedimen2=33pt \else\1B \fi
+ \ifdim\parshapedimen3=22pt \else\1C \fi
+ \ifdim\parshapedimen4=11pt \else\1D \fi
+ \ifdim\parshapedimen5=22pt \else\1E \fi
+ \ifdim\parshapedimen6=11pt \else\1F \fi
+ \ifdim\parshapedimen99=22pt \else\1G \fi
+ \ifdim\parshapedimen100=11pt \else\1H \fi
+ \typeout{Parshape test 4 \ifx\2\empty OK\else error(s):\2\fi}
+\endgroup
+
+%
+% -- Check \numexpr, \dimexpr, \glueexpr, and \muexpr
+\typeout{Checking \string\numexpr, \string\dimexpr, \string\glueexpr,
+ and \string\muexpr:}
+\begingroup
+ \numexpr \dimexpr \glueexpr \muexpr % <== can't use
+ \let\9=\relax
+ \count43=\numexpr ( ( 2 \9 \dimen43=\dimexpr ( 3pt \9
+ \skip43=\glueexpr 4pt plus 3fil \9 \muskip43=\muexpr(5muminus1mu)\9
+ \def\1#1 {\typeout{\detokenize{#1}=\the#1}}
+ \1\numexpr\count43 \1\dimexpr\dimen43
+ \1\glueexpr\skip43 \1\muexpr\muskip43
+
+ % Test arithmetic overflow
+ \begingroup
+ \tracingassigns=5
+ \count44=\numexpr"7FFFFFFE+1 \dimen44=\dimexpr"3FFFFFFEsp+1sp
+ \count44=\numexpr-"7FFFFFFE-1 \dimen44=\dimexpr-"3FFFFFFEsp-1sp
+ \count44=\numexpr"FFFF*"8000 \dimen44=\dimexpr"7FFFsp*"8000
+ \skip44="3FFFFFFFsp \advance\skip44by1sp \relax
+ \dimen45=\skip44 \dimen45=\dimexpr1sp*\skip44\9
+ \dimen44=-"3FFFFFFFsp \advance\dimen44by-1sp
+ \dimen45=\skip44 \dimen45=\dimexpr1sp*\skip44\9
+ \count44=\numexpr"7FFFFFFE+2\9 \dimen44=\dimexpr"3FFFFFFEsp+2sp\9
+ \count44=\numexpr-"7FFFFFFE-2\9 \dimen44=\dimexpr-"3FFFFFFEsp-2sp\9
+ \count44=\numexpr"10000*"8000\9 \dimen44=\dimexpr"8000sp*"8000\9
+ \count44=\numexpr"10000*-"8000\9 \dimen44=\dimexpr"8000sp*-"8000\9
+ \count44=\numexpr-"10000*"8000\9 \dimen44=\dimexpr-"8000sp*"8000\9
+ \count44=\numexpr-"10000*-"8000\9 \dimen44=\dimexpr-"8000sp*-"8000\9
+ \count44=\numexpr0/0\9 \dimen44=\dimexpr0pt/0\9
+ \count44=\numexpr1/0\9 \dimen44=\dimexpr1pt/0\9
+ \count44=\numexpr-1/0\9 \dimen44=\dimexpr-1pt/0\9
+ \endgroup
+
+ % Test glue arithmetic (add and sub)
+ \begingroup
+ \skip90=3pt plus 0fill minus 1fil
+ \skip91=3pt plus 1fil minus 0fill
+ \skip92=2pt plus -1fil minus 1fil
+ \tracingassigns=5
+ \skip93=\glueexpr\skip90+0pt \skip93=\glueexpr\skip90+0pt
+ \skip93=\glueexpr--\skip90 \skip93=\glueexpr--\skip90
+ \skip93=\glueexpr\skip91+0pt
+ \skip93=\glueexpr--\skip91 \skip93=\glueexpr--\skip91
+ \skip93=\glueexpr\skip92+0pt
+ \skip93=\glueexpr--\skip92 \skip93=\glueexpr--\skip92
+ \skip93=\glueexpr\skip90-\skip91
+ \skip93=\glueexpr\skip91-\skip92
+ \skip93=\glueexpr\skip91+\skip92
+ \endgroup
+
+ % Test rounding of division (all combinations of signs)
+ \def\2#1 {\edef\3{\3 #1}}
+ \def\1#1#2#3#4{\let\3=\empty
+ \ifnum#4=\numexpr#2/#3\else\2a \fi
+ \ifnum#4=-\numexpr-#2/#3\else\2b \fi
+ \ifnum-#4=\numexpr#2/-#3\else\2c \fi
+ \ifnum#4=\numexpr-#2/-#3\else\2d \fi
+ \typeout{Expr quotient rounding #1 \ifx\3\empty OK\else
+ error(s):\3\fi}}
+ \11{"3FFFFFFF}{"7FFFFFFF}{0}
+ \12{"40000000}{"7FFFFFFF}{1}
+ \13{"3FFFFFFE}{"7FFFFFFE}{0}
+ \14{"3FFFFFFF}{"7FFFFFFE}{1}
+ \def\1#1#2#3#4{\let\3=\empty
+ \ifnum#4=\numexpr#2/#3\else\2a \fi
+ \ifnum#4=-\dimexpr-#2sp/#3\else\2b \fi
+ \ifnum-#4=\glueexpr\muexpr#2mu/"10000\9/-#3\else\2c \fi
+ \ifnum#4=\muexpr-\dimexpr#2spplus-1muminus-1fil/-#3\else\2d \fi
+ \typeout{Expr quotient rounding #1 \ifx\3\empty OK\else
+ error(s):\3\fi}}
+ \15{32}{5}{6} % <== three mu_error's (! Incompatible glue units)
+ \16{33}{5}{7} % <== three mu_error's (! Incompatible glue units)
+ \17{25}{4}{6} % <== three mu_error's (! Incompatible glue units)
+ \18{26}{4}{7} % <== three mu_error's (! Incompatible glue units)
+
+ % Test rounding of fractions
+ \begingroup
+ \def\1#1 #2 #3 #4 #5 {\let\3=\empty
+ \ifnum#5=\numexpr#2*#3/#4\else\2a \fi
+ \ifnum-#5=\numexpr-#2*#3/#4\else\2b \fi
+ \ifnum-#5=\numexpr#2*-#3/#4\else\2c \fi
+ \ifnum#5=\numexpr-#2*-#3/#4\else\2d \fi
+ \ifnum-#5=\numexpr#2*#3/-#4\else\2e \fi
+ \ifnum#5=\numexpr-#2*#3/-#4\else\2f \fi
+ \ifnum#5=\numexpr#2*-#3/-#4\else\2g \fi
+ \ifnum-#5=\numexpr-#2*-#3/-#4\else\2h \fi
+ \4#1}
+ \def\4#1{\typeout{Expr fraction rounding #1 \ifx\3\empty OK\else
+ error(s):\3\fi}\let\3=\empty}
+ \11 "7FFFFFFE "7FFFFFFE "7FFFFFFD "7FFFFFFF
+ \12 "7FFFFFFE "7FFFFFFE "7FFFFFFF "7FFFFFFD
+ \def\1#1#2 #3 #4 #5 #6 {\let\3=\empty
+ \ifnum\numexpr#6=\numexpr(#3)*(#4)/(#5)\else\2#1 \fi
+ \ifdim\dimexpr1sp*#6=\dimexpr(#3sp)*(#4)/(#5)\else\2#2 \fi}
+ \1ab "3FFFFFFE "7FFFFFFE "7FFFFFFD "3FFFFFFF
+ \1cd "3FFFFFFE "7FFFFFFE "7FFFFFFF "3FFFFFFD
+ \1ef "1FFFBFFE "20003FFE "1FFFFFFE "1FFFFFFF
+ \1gh "1FFFBFFF "20003FFF "1FFFFFFF "20000000
+ \1ij "1FFFC000 "20004000 "20000000 "20000000
+ \1kl "1FFFC001 "20004001 "20000001 "20000001
+ \errorcontextlines=100
+ \1mn 1 "7FFFFFFF 2 "40000000
+ \43
+ \endgroup
+
+ \bgroup
+ \skip44=\glueexpr ( \skip43 ) + 3 pt plus 1 fil minus 1 fil l l
+ \muskip44=\muexpr (\muskip43)+3muplus1fill
+ \dimen44=\dimexpr\skip43+\count43pt
+ \dimen44=\dimexpr(\skip43)+(\count43pt)
+ \dimen44=\dimexpr\skip43*\count43
+ \skip44=\glueexpr\skip43/\count43
+ \skip44=\glueexpr\skip43*2/3
+ \egroup
+
+ % Test operator precedence
+ \bgroup
+ \def\1#1#2#3#4{#1#2#3#4=#2#3(#4)\else
+ \typeout{expression error (l.\number\inputlineno)}\fi}
+ \1\ifnum\numexpr{1+}{2*3}
+ \1\ifnum\numexpr{4-}{5*6}
+ \1\ifnum\numexpr{7+}{12/4}
+ \1\ifnum\numexpr{4-}{6/3}
+ \1\ifdim\dimexpr{1pt+}{2pt*3}
+ \1\ifdim\dimexpr{4pt-}{5pt*6}
+ \1\ifdim\dimexpr{7pt+}{12pt/4}
+ \1\ifdim\dimexpr{4pt-}{6pt/3}
+ \1\ifdim\glueexpr{7pt+}{12pt/4}
+ \egroup
+
+ % Test glue reference count handling
+ \shipout\hbox{}
+ \bgroup
+ \skip43=\glueexpr1ptplus0ptminus0pt
+ \skip43=\glueexpr1pt-0pt+0pt
+ \skip43=\glueexpr(((\skip43)))
+ \egroup
+ \shipout\hbox{}
+\endgroup
+
+%
+% -- Check \mutoglue and \gluetomu
+\typeout{Checking \string\mutoglue\space and \string\gluetomu:}
+\begingroup
+ \mutoglue \gluetomu % <== can't use
+ \skip1=-\mutoglue-\gluetomu9pt \muskip1=-\gluetomu-\mutoglue9mu
+ \skip2=\gluetomu\muskip1 % <== two mu_error's (! Incompatible glue units)
+ \muskip2=\mutoglue\skip1 % <== two mu_error's (! Incompatible glue units)
+ \tracingassigns=1
+ \skip1=\mutoglue1muplus-2muminus-3fil
+ \muskip1=\gluetomu1ptplus-2ptminus-3fil
+ \skip2=\mutoglue-4muplus5fillminus6filll
+ \muskip2=\gluetomu-4ptplus5fillminus6filll
+ \skip3=-\mutoglue\muskip1
+ \muskip3=-\gluetomu\skip1
+ \skip4=\mutoglue-\muskip2
+ \muskip4=\gluetomu-\skip2
+
+%
+% -- Check (mu)glue identity
+ \typeout{Checking (mu)glue identity:}
+ \skipdef\132767\1=7ptplus0filminus0fill\muskipdef\232766\2=\gluetomu\1
+ \tracingassigns=\1
+ \1=--\mutoglue--\muexpr(--\gluetomu--\glueexpr(--\1))
+ \2=--\gluetomu--\glueexpr(--\mutoglue--\muexpr(--\2))
+ \tracingassigns=0
+
+%
+% -- Check \gluestretchorder, \glueshrinkorder, \gluestretch, and \glueshrink
+ \typeout{Checking \string\gluestretchorder, \string\glueshrinkorder,
+ \string\gluestretch, and \string\glueshrink:}
+ \gluestretchorder \gluestretch % <== can't use
+ \glueshrinkorder \glueshrink % <== can't use
+ \skip5=1ptminus0fil
+ \skip6=1ptplus0fillminus0filll
+ \def\2#1{\typeout{wrong glue #1 (l.\number\inputlineno)}}
+ \def\1#1#2pt#3#4pt#5 {%
+ \ifnum\gluestretchorder#5=#1 \else \2{stretch order}\fi
+ \ifdim\gluestretch#5=#2pt \else \2{stretch}\fi
+ \ifnum\glueshrinkorder#5=#3 \else \2{shrink order}\fi
+ \ifdim\glueshrink#5=#4pt \else \2{shrink}\fi}
+ \def\9{\relax}
+ \100pt10pt1ptminus0fil
+ \100pt10pt\mutoglue1muminus0fil
+ \100pt10pt\mutoglue\gluetomu1ptminus0fil
+ \100pt10pt\skip5
+ \muskip5=\gluetomu\skip5
+ \100pt10pt\mutoglue\muskip5
+ \100pt10pt\glueexpr\mutoglue\muexpr\gluetomu\skip5\9\9
+ \100pt00pt\glueexpr\skip5+0pt\9
+ \120pt30pt1ptplus0fillminus0filll
+ \120pt30pt\mutoglue1muplus0fillminus0filll
+ \120pt30pt\mutoglue\gluetomu1ptplus0fillminus0filll
+ \120pt30pt\skip6
+ \muskip6=\gluetomu\skip6
+ \120pt30pt\mutoglue\muskip6
+ \120pt30pt\mutoglue\muexpr\gluetomu\glueexpr\skip6\9\9
+ \100pt00pt\glueexpr\skip6+0pt\9
+ \10-2pt1-3pt\skip1
+ \10-2pt1-3pt\mutoglue\muskip1
+ \125pt36pt\skip2
+ \125pt36pt\mutoglue\muskip2
+\endgroup
+
+%
+% -- Check sparse arrays
+\typeout{Checking sparse arrays:}
+\begingroup
+ \def\2#1{#1\1=-1#1\1=32768#1\1=0#1\1=32767\typeout{\meaning\1=\the\1.}}
+ \2\countdef % Bad register code (-1) ...and (32768).
+ \2\dimendef % Bad register code (-1) ...and (32768).
+ \2\skipdef % Bad register code (-1) ...and (32768).
+ \2\muskipdef % Bad register code (-1) ...and (32768).
+ \2\toksdef % Bad register code (-1) ...and (32768).
+ \tracingrestores=1
+ \count20=5
+ \count2000=5
+ \dimen21=5pt
+ \dimen2100=5pt
+ \skip22=5pt\relax \muskip2200=5mu\relax
+ \dimendef\8=256\relax \let\9=\8 \let\8=\relax \show\9
+\endgroup
+\begingroup
+ \def\4#1#2#3#4{{\typeout{testing #1 registers ...}%
+ \5\2{#1}\5\3{#1def}% define, e.g., \count and \countdef
+ \newlinechar=`^^J \tracingrestores=1 {\tracingassigns=1
+ \22000=#2} \22001=#3 \3\1=2002 \1=#4
+ \typeout{\6\22000=\the\22000,^^J \6\22001=\the\22001,^^J
+ \6\22002=\the\22002,^^J \7\1=\the\1.}%
+ \expandafter\unless\expandafter\ifx\2\toks
+% more tests for \count, \dimen, \skip, and \muskip
+ \advance\22000by#3 \advance\1by#3 \8
+ \multiply\22000by10 \multiply\1by10 \8
+ \divide\22000by5 \divide\1by5 \8
+ \else
+% more tests for \toks
+ \begingroup
+ \tracingassigns=1
+ \toks20=#2 \toks21=#3 \toks2100=#4
+ \1=\toks20 \1=\toks21
+ \toks2200=\toks20 \toks2200=\toks21
+ \1=\toks2000 \1=\toks2001
+ \toks2200=\toks2000 \toks2200=\toks2001
+ \toks30=\1 \toks30=\toks2000 \toks30=\toks2001
+ \toks3000=\1 \toks3000=\toks2000 \toks3000=\toks2001
+ \endgroup
+ \fi
+ \tracingassigns=1 \global\22002=#3 \1=#4 \global\1=#2
+ }}
+ \def\5#1#2{\edef#1{\csname#2\endcsname}}
+ \def\6{\expandafter\string}
+ \def\7{\expandafter\meaning}
+ \def\8{\typeout{\6\22000=\the\22000,^^J \6\22002=\the\22002,^^J
+ \7\1=\the\1.}}
+ \4{count}{0}{5}{7} % test \count, \countdef
+ \4{dimen}{0pt}{2.5pt}{3.5pt} % test \dimen, \dimendef
+ \4{skip}{0pt}{2.5ptplus1fil}{3.5ptminus1fill} % test \skip, \skipdef
+ \4{muskip}{0mu}{2.5muplus1fil}{3.5muminus1fill} % test \muskip, \muskipdef
+ \4{toks}{{}}{{a b c}}{{d e f}} % test \toks and \toksdef
+\endgroup
+\begingroup
+ \typeout{testing box registers ...}
+ \def\2#1{#1\1=-1#1\1=32768#1\1=0#1\1=32767\typeout{\meaning\1=\the\1.}}
+ \2\mathchardef % Bad mathchar (-1) ...and (32768).
+ \setbox-1=\copy32768 % Bad register code (-1) ...and (32768).
+ \global\setbox32768=\copy-1 % Bad register code (32768) ...and (-1).
+ \wd32768=\ht-1 % Bad register code (32768) ...and (-1).
+ \showbox-1 % Bad register code (-1).
+ \def\2#1{\typeout{\string\box#1=%
+ \ifhbox#1 \ifvbox#1 \else\ifvoid#1 \else\string\hbox\fi\fi\fi
+ \ifvbox#1 \ifhbox#1 \else\ifvoid#1 \else\string\vbox\fi\fi\fi
+ \ifvoid#1 void\else
+ \ifdim\ht#1 =0pt \else,ht=\the\ht#1 \fi
+ \ifdim\dp#1 =0pt \else,dp=\the\dp#1 \fi
+ \ifdim\wd#1 =0pt \else,wd=\the\wd#1 \fi
+ \fi.}}
+ \def\1#1{\2{3210#1}}
+ \tracingrestores=1
+ \setbox32101=\hbox to 3pt{%
+ \global\setbox32102=\vbox to 5pt{%
+ \setbox32103=\vtop to 7pt{%
+ \showgroups
+ }%
+ }%
+ }
+ \showbox32100
+ \showbox32101
+ \11\12\13
+ \setbox32103=\copy32101 \11\13
+ \setbox32104=\box32102 \12\14
+ \ht32101=2pt \11
+ \ht32102=4pt \12
+ \dp32103=6pt \13
+ \wd32104=8pt \14
+ \setbox32105=\hbox{\vbox to1pt{}\hskip5pt} \15
+ \setbox32106=\hbox{%
+ \unhcopy32105 \15%
+ \unhbox32105 \15%
+ \unhcopy32105 \unhbox32105 } \15 \16
+ \setbox32105=\vbox{\hbox to1pt{}\vskip5pt} \15
+ \setbox32106=\vbox{%
+ \unvcopy32105 \15%
+ \unvbox32105 \15%
+ \unvcopy32105 \unvbox32105 } \15 \16
+ \setbox32105=\vbox{\vbox to10pt{}\penalty0\vbox to20pt{}} \15
+ \setbox32106=\vsplit32105 to 10pt \16 \15
+\endgroup
+
+%
+% -- Check \lastlinefit
+\typeout{Checking \string\lastlinefit:}
+\begingroup
+ \def\1{\setbox0=\vbox{\noindent\2\2\2\2\3\2}\showbox0
+ \setbox0=\vbox{\unvbox0 \setbox0=\lastbox \showbox0 }}
+ \def\2{\hbox to30pt{}\hskip 5pt plus 20pt minus 4pt }
+ \def\3{}
+ \tracingparagraphs=1 \showboxdepth=1
+ \hbadness=100 \pretolerance=9000
+ \parfillskip=0pt plus 1fill \relax
+ \hsize=96pt
+ \lastlinefit=-1 \1
+ \lastlinefit=500 \1
+ \lastlinefit=1001 \1
+ \hsize=98pt
+ \begingroup
+ \rightskip=0pt plus 1fill \relax
+ \lastlinefit=1000 \1
+ \leftskip=0pt plus -1fill \relax
+ \lastlinefit=500 \1
+ \endgroup
+ \lastlinefit=1000 \1
+ \hsize=100pt
+ \lastlinefit=0 \1
+ \lastlinefit=500 \1
+ \lastlinefit=1000 \1
+ \hsize=110pt
+ \begingroup
+ \let\3=\hfil
+ \lastlinefit=1000 \1
+ \endgroup
+ \lastlinefit=500 \1
+ \lastlinefit=1000 \1
+ \hsize=120pt
+ \lastlinefit=0 \1
+ \lastlinefit=500 \1
+ \lastlinefit=1000 \1
+\endgroup
+
+%
+% -- Check expansion of V 2 \protected macros
+\typeout{Checking expansion of V 2 \string\protected\space macros:}
+\begingroup
+ \protected\def\1{\omit} \def\2{\omit} \def\3{relax}
+ \setbox0=\vbox{\halign{&\typeout{# (l.\number\inputlineno)}\cr
+ \1& \1\cr
+ \2& \2\cr
+ \3& \3\cr}}
+\endgroup
+
+%
+% -- Check hyphenation and \savinghyphcodes
+\typeout{Checking hyphenation and \string\savinghyphcodes:}
+\begingroup
+ \def\2#1#2 {\language=#1 #2 }
+ \def\1#1 {\noindent\trip\ \20#1 \21#1 \22#1 \23#1 \24#1 \par}
+ \parfillskip=0pt \hbadness=0 \showboxdepth=0
+ \hsize=16383.99999pt \pretolerance=-1 \tolerance=-1
+ \setbox0=\vbox{
+ \lccode`A=`a \lccode`B=`b
+ \language=0 \hyphenation{qq-App qqB-pp}
+ \language=1 \hyphenation{qq-App qqB-pp}
+ \language=2 \hyphenation{qq-A-pp qqB-pp}
+ \language=3 \hyphenation{qq-App qq-B-pp}
+ \1ppAqq \1upAqq \1ppBqq \1upBqq
+ \lccode`A=`r \lccode`B=`b
+ \1ppAqq \1upAqq \1ppBqq \1upBqq
+ \lccode`A=`a \lccode`B=`r
+ \1ppAqq \1upAqq \1ppBqq \1upBqq
+ }
+ \setbox0=\vbox{\language=3 \1qqapp \1qqbpp \1qqrpp }
+\endgroup
+
+%
+% -- Check \savingvdiscards, \pagediscards, and \splitdiscards
+\typeout{Checking \string\savingvdiscards, \string\pagediscards, and
+ \string\splitdiscards:}
+\begingroup
+ \setbox27=\vbox{\noindent$\splitdiscards\noindent$\pagediscards}
+ \showbox27
+ \setbox 27 = \vbox {
+ \vbox to 20 pt {}
+ \prevdepth = -10000 pt
+ \openout 0 = abc
+ \penalty 0
+ \write 1 {write 1}
+ \vskip 10 pt plus 1 pt minus 1 pt
+ \write 2 {write 2}
+ \penalty 0
+ \closeout 3
+ \kern 10 pt
+ \vbox to 20 pt {}
+ \vfil
+ }
+ \def\1 #1 #2 {%
+ \savingvdiscards = #1
+ \setbox 28 = \copy 27
+ {
+ \setbox 0 = \vbox {
+ \vsplit 28 to #2 pt
+ \prevdepth = -10000 pt
+ \splitdiscards
+ \box 28
+ }
+ \showbox 0
+ }
+ }
+ \1 -1 20 \1 0 30 \1 1 20 \1 2 30
+ \output = {%
+ \setbox 0 = \vbox { \pagediscards }
+ \showbox 0
+ \showbox 255
+ \setbox 0 = \box 255
+ \global \deadcycles = 0
+ }
+ \def\1{{\setbox 0 = \vbox { \pagediscards \showlists }}}
+ \savingvdiscards = 0 \vfil \kern 20 pt \1 \penalty -1 \1
+ \savingvdiscards = 1 \vfill \kern 2 pt \1 \penalty 10 \1
+ \kern 5 pt \write 1 {} \penalty 0
+ { \savingvdiscards = 0
+ \kern 6 pt \write 2 {} \penalty 1
+ }
+ \kern 7 pt \write 3 {} \hbox {} \penalty -10000
+ \1
+\endgroup
+
+%
+% -- Check \interlinepenalties, \clubpenalties, \widowpenalties,
+% and \displaywidowpenalties
+\typeout{Checking \string\interlinepenalties, \string\clubpenalties,
+ \string\widowpenalties, and \string\displaywidowpenalties:}
+\begingroup
+ \begingroup
+ \def\2#1{%
+ \typeout{\string#1-1=\the#1-1}%
+ \typeout{\string#10=\the#10}%
+ \typeout{\string#15=\the#15}%
+ \typeout{\string#1\string#10=\the#1#10}}
+ \def\1{%
+ \2\interlinepenalties
+ \2\clubpenalties
+ \2\widowpenalties
+ \2\displaywidowpenalties}
+ \def\5#1#2{\number#1#2
+ \ifnum#2<#10 \space\expandafter\5\expandafter#1\expandafter
+ {\number\numexpr#2+1\expandafter}\fi}
+ \def\4#1{\typeout{\string#1=\5#1{0}}}
+ \def\3{%
+ \4\interlinepenalties
+ \4\clubpenalties
+ \4\widowpenalties
+ \4\displaywidowpenalties}
+ \tracingassigns=1 \tracingrestores=1
+ \3 \1
+ \interlinepenalties=3 101 102 103
+ \clubpenalties=1 1 \clubpenalties=4 201 202 203 204
+ \widowpenalties=5 301 302 303 304 305
+ \displaywidowpenalties=6 401 402 403 404 405 406
+ \3 \1
+ \setbox0=\vbox{}
+ \endgroup
+ \parfillskip=0pt \interlinepenalty=7 \clubpenalty=500 \widowpenalty=300
+ \displaywidowpenalty=310 \rightskip=0ptplus1fil \hsize=20pt
+ \def\3#1 {\setbox0=\lastbox \unskip \count0=\lastpenalty \unpenalty
+ \ifnum\count0=#1 \else \typeout{Wrong penalty \number\count0
+ \space should be #1 (l.\number\inputlineno)}\fi}
+ \def\2{\vrule height1ptwidth19pt\hskip5pt }
+ \def\1#1#2 #3 #4 #5 #6 #7 {\setbox0=\vbox{#1\noindent\2\2\2\2$$
+ $$\2\2\2\2\par\3#7 \3#6 \3#5 \30 \30 \30 \30 \3#4 \3#3 \3#2 \30 }}
+
+ \1{\interlinepenalties=8 8 7 6 5 4 3 2 1 }508 7 316 501 1 301
+ \1{\clubpenalties=2 200 100 }207 107 417 207 107 407
+ \1{\widowpenalties=2 2000 1000 \displaywidowpenalties=3 2200 1100 0 }%
+ 507 1107 2207 1507 1007 2007
+\endgroup
+
+%
+\showboxbreadth=10\showboxdepth=10
+\tracingonline=1\tracingoutput=1
+\end
+\error{e-VirTeX: can't happen in e-trip test!}
+%% End of file `etrip.tex'.
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip.typ b/Build/source/texk/web2c/etexdir/etrip/etrip.typ
new file mode 100644
index 00000000000..a0b0d0f6856
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip.typ
@@ -0,0 +1,20 @@
+This is DVItype, Version 3.6
+Options selected:
+ Starting page = *.*.*.*.*.*.*.*.*.*
+ Maximum number of pages = 1000000
+ Output level = 2 (mnemonics)
+ Resolution = 72.27000000 pixels per inch
+numerator/denominator=25400000/473628672
+magnification=1000; 0.00001526 pixels per DVI unit
+' TeX output 2004.09.06:2313'
+
+42: beginning of page 1.0.0.0.0.0.0.0.0.0
+87: eop
+
+88: beginning of page 1.0.0.0.0.0.0.0.0.0
+133: eop
+
+134: beginning of page 1.0.0.0.0.0.0.0.0.0
+179: eop
+Postamble starts at byte 180.
+maxv=0, maxh=0, maxstackdepth=0, totalpages=3
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip1.in b/Build/source/texk/web2c/etexdir/etrip/etrip1.in
new file mode 100644
index 00000000000..0ad278fb43e
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip1.in
@@ -0,0 +1,2 @@
+
+*\input trip
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip2.in b/Build/source/texk/web2c/etexdir/etrip/etrip2.in
new file mode 100644
index 00000000000..8001246f85a
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip2.in
@@ -0,0 +1 @@
+*etrip
diff --git a/Build/source/texk/web2c/etexdir/etrip/etrip3.in b/Build/source/texk/web2c/etexdir/etrip/etrip3.in
new file mode 100644
index 00000000000..97e7957c245
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etrip3.in
@@ -0,0 +1 @@
+&etrip etrip
diff --git a/Build/source/texk/web2c/etexdir/etrip/etripin.log b/Build/source/texk/web2c/etexdir/etrip/etripin.log
new file mode 100644
index 00000000000..5e8c0286e90
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etripin.log
@@ -0,0 +1,40 @@
+This is e-TeX, Version 3.141592-2.2 (INITEX) 6 SEP 2004 23:13
+entering extended mode
+***etrip
+(etrip.tex This is the e-Trip test [2004-09-06] for e-TeX v3.141592-2.2.
+(You are using e-TeX version/revision 2.2)
+e-IniTeX: Assigning category codes, tracing switches, other codes,
+definitions for e-VirTeX e-Trip test run, constants and registers,
+fonts, some math characters, some math parameters, hyphenation,
+
+Underfull \hbox (badness 10000) in paragraph at lines 99--99
+[] \trip pp1aqq up1aqq ppb1qq upb1qq pp1r1qq up1r1qq qqb1pp
+
+\hbox(8.0+2.0)x16383.99998, glue set 1166.92857 []
+
+! Not a letter.
+l.100 ...guage=4 \hyphenation{-q
+ -}}
+Letters in \hyphenation words must have \lccode>0.
+Proceed; I'll ignore the character I just read.
+
+
+enable e-TeX enhancements (TeXXeT),
+prepare saved items (not to be dumped), everyjob ...dumped. )
+Beginning to dump on file etrip.fmt
+ (preloaded format=etrip 2004.9.6)
+1435 strings of total length 24590
+279 memory locations dumped; current usage is 36&165
+407 multiletter control sequences
+\font\nullfont=nullfont
+\font\trip=etrip
+\font\smalltrip=etrip at 5.0pt
+\font\bigtrip=etrip at 20.0pt
+2279 words of font info for 3 preloaded fonts
+2 hyphenation exceptions
+Hyphenation trie of length 434 has 12 ops out of 500
+ 3 for language 3
+ 3 for language 2
+ 3 for language 1
+ 3 for language 0
+No pages of output.
diff --git a/Build/source/texk/web2c/etexdir/etrip/etripman.tex b/Build/source/texk/web2c/etexdir/etrip/etripman.tex
new file mode 100644
index 00000000000..16464f8fb45
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/etripman.tex
@@ -0,0 +1,436 @@
+% The e-TRIP manual: How to validate e-TeX - last modified 25 Aug 2004
+%
+% some e-TeX numbers
+%
+\def\minps{32000} % minimum pool_size for e-TRIP test
+\def\minms{3200} % minimum max_string for e-TRIP test
+%
+\def\extracs{66} % additional multiletter control sequences
+\def\extrasv{2} % additional save stack positions
+\def\extrabf{23} % additional input buffer positions
+\def\extramw{38} % additional memory words dumped
+%
+\font\eighttt= cmtt8
+\font\eightrm= cmr8
+\font\rtitlefont= cmr7 scaled\magstep5
+\font\ititlefont= cmmi7 scaled\magstep5
+\def\titlefont{\rtitlefont \textfont1=\ititlefont}
+\def\eTeX{$\varepsilon$-\TeX}
+\def\NTS{NTS}
+\let\mc=\eightrm
+\rm
+\let\mainfont=\tenrm
+
+\def\.#1{\hbox{\tt#1}}
+\def\\#1{\hbox{\it#1\/\hskip.05em}} % italic type for identifiers
+
+\parskip 2pt plus 1pt
+\baselineskip 12pt plus .25pt
+
+\def\verbatim#1{\begingroup \frenchspacing
+ \def\do##1{\catcode`##1=12 } \dospecials
+ \parskip 0pt \parindent 0pt
+ \catcode`\ =\active \catcode`\^^M=\active
+ \tt \def\par{\ \endgraf} \obeylines \obeyspaces
+ \input #1 \endgroup}
+% a blank line will be typeset at the end of the file;
+% if you're unlucky it will appear on a page by itself!
+{\obeyspaces\global\let =\ }
+
+\def\verblines#1 {$$\frenchspacing \global\count255=-#1
+ \abovedisplayskip=0pt \belowdisplayskip=\abovedisplayskip
+ \def\do##1{\catcode`##1=12 }\dospecials
+ \def\par{\cr\noalign{\global\advance\count255by1 }%
+ \ifnum\count255<0 \else \egroup $$\fi}%
+ \obeylines \obeyspaces
+ \halign\bgroup\indent\tt##\hfil\cr}
+
+\output{\shipout\box255\global\advance\pageno by 1} % for the title page only
+\null
+\vfill
+\centerline{\titlefont A torture test for \eTeX}
+\vskip 6pt
+\centerline{({\sl Version 2.2, August 2004\/})}
+\vskip 18pt
+\centerline{by The \NTS\ Team}
+\vskip 6pt
+\centerline{Peter Breitenlohner, Max-Planck-Institut f\"ur Physik, M\"unchen}
+\vskip 6pt
+\centerline{Bernd Raichle, Institut f\"ur Informatik, Universit\"at Stuttgart}
+\vfill
+\centerline{\vbox{\hsize 4in
+\noindent Programs that claim to be implementations of \eTeX\ are
+supposed to be able to process the test routines described in this
+report, producing the outputs described in this report.}}
+\vskip 24pt
+{\baselineskip 9pt
+\eightrm\noindent
+The preparation of this report was supported in part by DANTE,
+Deutschsprachige Anwendervereinigung \TeX\ e.V.\hfil\break
+`\TeX' is a trademark of the American Mathematical Society.
+
+}\pageno=0\eject
+
+\output{\shipout\vbox{ % for subsequent pages
+ \baselineskip0pt\lineskip0pt
+ \hbox to\hsize{\strut
+ \ifodd\pageno \hfil\eightrm\firstmark\hfil
+ \mainfont\the\pageno
+ \else\mainfont\the\pageno\hfil
+ \eightrm\firstmark\hfil\fi}
+ \vskip 10pt
+ \box255}
+ \global\advance\pageno by 1}
+\let\runninghead=\mark
+\outer\def\section#1.{\noindent{\bf#1.}\quad
+ \runninghead{\uppercase{#1} }\ignorespaces}
+
+\section Introduction.
+The program \TeX82 by D.E.~Knuth is in the public domain, and its
+algorithms are published; he has done this since he does not want to
+discourage its use by placing proprietary restrictions on the software.
+However, he doesn't want faulty imitations to masquerade as \TeX\
+processors, since users want \TeX\ to produce identical results on
+different machines. He has copyrighted the programs so that he has some
+chance to forbid unauthorized copies; he explicitly authorizes copying
+of correct \TeX\ implementations, and not of incorrect ones! In order
+to determine, what is a correct implementation of \TeX, he has devised
+a test suite for \TeX, the \.{TRIP} test [1].
+
+The program \eTeX\ by `The \NTS\ Team' extends the capabilities of \TeX\
+by adding a relatively small amount (less than 10 per cent) of code; it
+is in the public domain, and its algorithms (beyond those of \TeX) are
+published. This report has been inspired by and is based on the
+\.{TRIP} manual. It describes the \.{e-TRIP} test, a test suite that
+allows one to determine whether what one has is a correct implementation
+of \eTeX.
+
+If somebody claims to have a correct implementation of \eTeX, we will
+not believe it until we see that the \.{e-TRIP} test is performed
+properly. We propose, in fact, that a program must meet two criteria
+before it can justifiably be called \eTeX: (1)~The person who wrote it
+must be happy with the way it works at his or her installation; and
+(2)~the program must produce the correct results from the \.{e-TRIP}
+test. Hence we are planning to do whatever we can to suppress any
+systems that call themselves \eTeX\ without meeting conditions (1)
+and~(2). We have copyrighted the program (1994,98 by The \NTS\ Team,
+1999-2004 by P.~Breitenlohner) so that we have some chance to forbid
+unauthorized copies; we explicitly authorize copying of correct \eTeX\
+implementations, and not of incorrect ones!
+
+The process of generating an \eTeX\ implementation for a particular
+system [2] is based on that of generating a \TeX\ implementation for the
+same system. Moreover, when \eTeX\ is used in compatibility mode, it is
+supposed to be 100 per cent compatible with \TeX. Thus a correct \eTeX\
+implementation, when running in compatibility mode, must pass the
+\.{TRIP} test. In fact, the first part of the \.{e-TRIP} test for a
+particular implementation of \eTeX\ consists in performing the standard
+\.{TRIP} test (a)~for \eTeX\ in compatibility mode and (b)~for \eTeX\ in
+extended mode. The deviations in the test output from step~(a) should,
+of course, be limited to those explicitly allowed by Knuth and described
+in Appendix~A, item~5 of the \.{TRIP} manual. Any additional deviations
+in the test output from step~(b) must be accounted for by \eTeX's
+additional algorithms and are described in detail in this report. Once
+an \eTeX\ implementation has passed these preliminary tests, it should be
+subjected to the second part of the \.{e-TRIP} test. There the extended
+features and algorithms of \eTeX\ are tested under normal circumstances
+as well as in situations a normal user would never dream of (in the
+spirit of the \.{TRIP} test).
+
+The remainder of this report consists of appendices, whose contents ought
+to be described briefly here:
+
+Appendix A explains in detail how to carry out the first part of the
+test of \eTeX, given copies of the files described in the \.{TRIP}
+manual.
+
+Appendix B explains how to carry out the \eTeX\ specific test, given
+copies of the files described in the other appendices.
+
+Appendix C is \.{eTRIP.TEX}, a fiendish test file for \eTeX.
+
+Appendix D is \.{eTRIP.PL}, the property-list description of a
+special font called \.{etrip}.
+
+Appendix E is \.{eTRIPIN.LOG}, a correct transcript file \.{eTRIP.LOG}
+that results if \.{e-TRIPTEX} is applied to \.{eTRIP.TEX}.
+This run of \.{e-TRIPTEX} also creates a binary format file called
+\.{eTRIP.FMT} (or similar).
+
+Appendix F is a correct transcript file \.{eTRIP.LOG} that results if
+\.{e-TRIPTEX} or any other version of \eTeX\ is applied to \.{eTRIP.TEX}
+with format \.{eTRIP.FMT}.
+
+Appendix G is \.{eTRIP.TYP}, the symbolic version of a correct output
+file \.{eTRIP.DVI} that was produced at the same time as the
+\.{eTRIP.LOG} file of Appendix~F.
+
+Appendix H is \.{eTRIP.OUT}, a short file written out and read in by
+\eTeX\ when it processes \.{eTRIP.TEX}.
+
+Appendix I is \.{eTRIP.FOT}, an abbreviated version of Appendix F that
+appears on the user's terminal during the run that produces
+\.{eTRIP.LOG}.
+
+\vskip 24pt plus 24pt
+\section References.
+\item {[1]}
+{\sl A torture test for \TeX\/},
+by Donald E.~Knuth, Stanford Computer Science Report~1027.
+
+\item {[2]}
+{\sl How to generate \eTeX\/},
+by The \NTS\ Team (Peter Breitenlohner and Phil Taylor).
+
+\item {[3]}
+{\sl The \.{WEB} system of structured documentation\/},
+by Donald E.~Knuth, Stanford Computer Science Report~980.
+
+\item {[4]}
+{\sl \TeX ware\/}, by Donald E.~Knuth and David R.~Fuchs,
+Stanford Computer Science Report~1097.
+
+\vfill\eject
+
+\section Appendix A: How to test \eTeX\ (part 1).
+
+\item{0.} Let's assume that you have copies of the files \.{TRIP.TEX},
+\.{TRIP.PL}, \.{TRIPIN.LOG}, \.{TRIP.LOG}, \.{TRIP.TYP}, and
+\.{TRIP.FOT} as described in Appendices~B, C, D, E, F, and~G of the
+\.{TRIP} manual [1] (in a safe place so that these ``master'' files will
+not be clobbered). Furthermore, let's suppose that you have a working
+\.{WEB} system [3], and that you have working programs \.{PLtoTF} and
+\.{DVItype}, as described in the \TeX ware report [4]. Finally let's
+assume that you are able to generate \eTeX\ as described in [2].
+
+\item{1.} Use \.{PLtoTF} to convert \.{TRIP.PL} into \.{TRIP.TFM};
+install \.{TRIP.TFM} in the standard file area for \TeX\ font metric
+files (or set a suitable environment variable or similar such that these
+files will be found by the program).
+
+\item{2.} Generate \.{e-TRIPTEX}, a special version of \.{e-INITEX}.
+The parameters for \.{e-TRIPTEX} should agree with those for \.{TRIPTEX}
+(as described in [1]), except that you should set \\{pool\_size} to a
+value $\ge\minps$ and \\{max\_strings} to a value $\ge\minms$.
+
+\item{3.} Perform the \.{TRIP} test as described in Appendix~A,
+items~3--7 of [1], with \.{e-TRIPTEX} as prepared in step~2. The program
+will run in compatibility mode and should therefore be fully compatible
+with \.{TRIPTEX} as described in [1]; apart from the allowed differences
+listed in item~5, the test output should deviate from the master files in
+the following \eTeX-specific point (and only in this one):
+
+\itemitem{a)} The name and version by which the program announces itself
+will be different; the extension of the format file produced during the
+first \.{e-TRIPTEX} run may be different.
+
+\def\bs{{\char`\\}}
+\def\sp{{\char'40}}
+
+\item{4.} Perform steps 3--7 of the \.{TRIP} test once again with
+\.{e-TRIPTEX}. During the first run type `\.{*\bs input\sp trip}'
+instead of `\.{\bs input\sp trip}', as a consequence \.{e-TRIPTEX} will
+run in extended mode. During the second run type `\.{\&trip\sp\bs
+toksdef\bs tokens=0\sp\bs input\sp trip}' instead of `\.{\sp\&trip\sp\sp
+trip\sp}'. The test output should differ from that of step~3 above in
+the following respects (and only in these):
+
+\itemitem{a)} The date and\slash or time will naturally be different.
+
+\itemitem{b)} The message `\.{entering extended mode}' will appear on
+the terminal and in the \.{TRIP.LOG} files.
+
+\itemitem{c)} The input `\.{*\bs input trip}' instead of
+`\.{\bs input trip}' is recorded in the first \.{TRIP.LOG} file;
+similarly the input `\.{\&trip\sp\bs toksdef\bs tokens=0\sp\bs input\sp
+trip}' instead of `\.{\sp\&trip\sp\sp trip\sp}' is recorded in the
+second \.{TRIP.LOG} file.
+
+\itemitem{d)} The following 6 lines (the last of them blank) will be
+missing from the first \.{TRIP.LOG} file\verblines 6
+! Bad register code (256).
+l.29 ...{1} \toksdef\tokens=256
+ \show\errorstopmode
+A register number must be between 0 and 255.
+I changed this one to zero.
+
+
+\itemitem{e)} The first \.{TRIP.LOG} file will report the dumping of
+\extramw~additional memory words.
+
+\itemitem{f)} If the date has changed, the number of string characters
+dumped by the first \.{e-TRIPTEX} run may vary by $\pm2$.
+
+\itemitem{g)} Both \.{e-TRIPTEX} runs report \extracs~additional
+multiletter control sequences (in the \.{TRIP.LOG} files).
+
+\itemitem{f)} The second \.{e-TRIPTEX} run reports the unfinished
+group(s) when the program terminates; there are three additional lines
+(the first of them blank) on the terminal and in the \.{TRIP.LOG}
+file\verblines 3
+
+### semi simple group (level 1) entered at line 429 (begingroup)
+### bottom level
+The second \.{TRIP.LOG} does not contain six lines\verblines 1
+{restoring \fam=-1}
+one line\verblines 1
+{restoring \displayindent=0.0pt}
+and one line\verblines 1
+{restoring current font=\ip}
+Ten lines displaying an \.{\bs hbox} contain the additional text
+`\.{, display}'.
+Finally the second \.{TRIP.LOG} reports the additional use of
+\extrabf~input buffer (\.{b}) and \extrasv~save (\.{s}) stack positions.
+
+\vfill\eject
+
+\section Appendix B: How to test \eTeX\ (part 2).
+
+\item{5.} Assume that you have copies of the ``master'' files
+\.{eTRIP.TEX}, \.{eTRIP.PL}, \.{eTRIPIN.LOG}, \.{eTRIP.LOG},
+\.{eTRIP.TYP}, \.{eTRIP.OUT}, and \.{eTRIP.FOT}, as in Appendices C, D,
+E, F, G, H, and~I (again in a safe place).
+
+\item{6.} Use \.{PLtoTF} to convert \.{eTRIP.PL} into \.{eTRIP.TFM};
+install \.{eTRIP.TFM} in the standard file area for \TeX\ font metric
+files (or set a suitable environment variable or similar).
+
+\item{7.} Run \.{e-TRIPTEX}; in response to the `\.{**}' prompt, type
+`\.{*etrip}'. You should get an output file \.{eTRIP.LOG} that matches
+the file \.{eTRIPIN.LOG} (Appendix~E). Contrary to the analogous step
+in the \.{TRIP} test (steps~3 and~4 above) there should be no error
+messages; lines in the output saying ``Emergency stop'' would indicate
+that you have performed this test with a standard \TeX\ or with \eTeX\
+in compatibility mode.
+
+\item{8.} Run \.{e-TRIPTEX} again; this time type
+`\.{\&etrip{\char'40}etrip}'. You should get outputs \.{eTRIP.LOG},
+\.{eTRIP.DVI}, and \.{eTRIP.OUT}. Furthermore, your terminal should
+receive output that matches \.{eTRIP.FOT} (Appendix~I). Once again, the
+terminal will be getting no output during the middle part of this test.
+
+\item{9.} Compare the \.{eTRIP.LOG} file from step 8 with the ``master''
+\.{eTRIP.LOG} file of step~5. There should be no lines saying
+``Emergency stop'' (see above) or ``Bug in your e-TeX implementation'';
+there should be perfect agreement between these files except in the
+following respects:
+
+\itemitem{a)} The dates and possibly the file names will naturally be
+different.
+
+\itemitem{b)} Glue settings in the displays of \TeX\ boxes are subject
+to system-dependent rounding, so slight deviations are permissible.
+However, such deviations apply only to the `\.{glue set}' values that
+appear at the end of an \.{\char'134hbox} or \.{\char'134vbox} line; all
+other numbers should agree exactly, since they are computed with integer
+arithmetic in a prescribed system-independent manner.
+
+\itemitem{c)} The amount of space in kerns that are marked ``for
+accent'' are, similarly, subject to system-dependent rounding.
+
+\itemitem{d)} If you had different values for \\{stack\_size},
+\\{buf\_size}, etc., the corresponding capacity values will be different
+when they are printed out at the end.
+
+\itemitem{e)} Help messages may be different; indeed, the author of
+\TeX\ encourages non-English help messages in versions of \TeX\ for
+people who don't understand English as well as some other language.
+Similarly, \eTeX\ could well be used with non-English help messages.
+
+\itemitem{f)} The total number and length of strings at the end may well
+be different.
+
+\itemitem{g)} If your \eTeX\ uses a different memory allocation or
+packing scheme or \.{DVI} output logic, the memory usage statistics may
+change.
+
+\item{10.} Use \.{DVItype} to convert your file \.{eTRIP.DVI} to a file
+\.{eTRIP.TYP}. The following options should be set when using
+\.{DVItype}:
+$$\vbox{\halign{#\hfil&\hfil#\cr
+Output level = 2\cr
+Starting page = \.{*.*.*.*.*.*.*.*.*.*}\hskip-20pt\cr
+Number of pages = 1000000&(this is the default)\cr
+Resolution = 7227/100&(this is one point per pixel)\cr
+New magnification = 0&(this is the default)\cr}}$$
+The resulting file should agree with the master \.{eTRIP.TYP} file of
+step~5, except that some of the values might be a little off due to
+floating-point rounding discrepancies. Furthermore there may be
+differences between `\\{right}' and `\\w' and `\\x' commands, and
+between `\\{down}' and `\\y' and `\\z'; the key thing is that all
+characters and rules and \\{xxx}'s should be in almost the same
+positions as specified in Appendix~G. If you have set
+\\{dvi\_buf\_size} to 800, then your \.{DVI} file should be virtually
+identical to the one supplied.)
+
+\vfill\eject
+
+\section Appendix C: The \.{eTRIP.TEX} file.
+The contents of the test routine are prefixed here with line numbers,
+for ease in comparing this file with the error messages printed later;
+the line numbers aren't actually present.
+\runninghead{APPENDIX C: \.{eTRIP.TEX} (CONTINUED)}
+
+\vskip 8pt
+\begingroup\count255=0
+\everypar{\global\advance\count255 by 1
+ \hbox to 20pt{\sevenrm\hfil\the\count255\ \ }}
+\verbatim{etrip.tex}
+\endgroup
+\vfill\eject
+
+\section Appendix D: The \.{eTRIP.PL} file.
+At the moment the \.{eTRIP.PL} file is just a copy of \.{TRIP.PL} as
+described in Appendix~C of [1].
+
+\section Appendix E: The \.{eTRIPIN.LOG} file.
+When \.{e-TRIPTEX} makes the \.{eTRIP.FMT} file, it also creates a file
+called \.{eTRIP.LOG} that looks like this.
+\runninghead{APPENDIX E: \.{eTRIPIN.LOG} (CONTINUED)}
+
+\vskip8pt
+\verbatim{etripin.log}
+\vfill\eject
+
+\section Appendix F: The \.{eTRIP.LOG} file.
+Here is the major output of the \.{e-TRIP} test; it is generated by
+running \.{e-TRIPTEX} and loading \.{eTRIP.FMT}, then reading
+\.{eTRIP.TEX}.
+\runninghead{APPENDIX F: \.{eTRIP.LOG} (CONTINUED)}
+
+{\let\tt=\eighttt\leftskip 1in\baselineskip 9pt plus .1pt minus .1pt
+\vskip8pt
+\verbatim{etrip.log}
+}
+\vfill\eject
+
+\section Appendix G: The \.{eTRIP.TYP} file.
+Here is another major component of the test. It shows the output of
+\.{DVItype} applied to the file \.{eTRIP.DVI} that was created at the
+same time Appendix F was produced.
+\runninghead{APPENDIX G: \.{eTRIP.TYP} (CONTINUED)}
+
+{\let\tt=\eighttt\leftskip 1in\baselineskip 9pt plus .1pt minus .1pt
+\vskip8pt
+\verbatim{etrip.typ}
+}
+\vfill\eject
+
+\section Appendix H: The \.{eTRIP.OUT} file.
+This short file was written out once and read in several times, during
+the time Appendix F was being produced. There are only four lines.
+\runninghead{APPENDIX H: \.{eTRIP.OUT} (CONTINUED)}
+
+\vskip8pt
+\verbatim{etrip.out}
+\vfill\eject
+
+\section Appendix I: The \.{eTRIP.FOT} file.
+This shows what appeared on the terminal while Appendix F was being
+produced.
+\runninghead{APPENDIX I: \.{eTRIP.FOT} (CONTINUED)}
+
+\vskip8pt
+\verbatim{etrip.fot}
+
+\vfill\end
diff --git a/Build/source/texk/web2c/etexdir/etrip/texmf.cnf b/Build/source/texk/web2c/etexdir/etrip/texmf.cnf
new file mode 100644
index 00000000000..d02f04dcd2d
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/texmf.cnf
@@ -0,0 +1,46 @@
+% triptrap/texmf.cnf -- configuration for the trip and trap tests.
+
+% These values apply to all the programs, and they are necessary for any
+% kind of reasonable diff.
+error_line = 64
+half_error_line = 32
+max_print_line = 72
+
+% e-TeX.
+main_memory.etex = 2999 % can't change mem_bot, it stays 0
+max_strings.etex = 3300
+pool_size.etex = 34000
+
+% In case you happen to run an ini* link by hand.
+main_memory.einitex = 2999 % can't change mem_bot, it stays 0
+max_strings.einitex = 3300
+pool_size.einitex = 34000
+
+string_vacancies = 8000
+pool_size = 32000
+
+% TeX end e-TeX.
+font_mem_size = 20000
+font_max = 75
+stack_size = 200
+nest_size = 40
+buf_size = 500
+save_size = 600
+dvi_buf_size = 800
+% Although hyph_size is settable, it can't be <hyph_prime, which is 607,
+% and the original trip setting is 307, so no point in changing the default.
+
+% Avoid running any MakeTeX* program.
+MAKETEXTFM = 0
+MAKETEXTEX = 0
+MAKETEXMF = 0
+
+% Search paths.
+% (e)trip.tex:
+TEXINPUTS = .
+% (e)trip.tfm:
+TFMFONTS = .
+% (e)trip.efmt:
+TEXFORMATS = .
+% etex.pool:
+TEXPOOL = .
diff --git a/Build/source/texk/web2c/etexdir/etrip/trip2.in b/Build/source/texk/web2c/etexdir/etrip/trip2.in
new file mode 100644
index 00000000000..86f72b31b17
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/etrip/trip2.in
@@ -0,0 +1 @@
+&trip \toksdef\tokens=0 \input trip
diff --git a/Build/source/texk/web2c/etexdir/tex.ch0 b/Build/source/texk/web2c/etexdir/tex.ch0
new file mode 100644
index 00000000000..a395aa8d274
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/tex.ch0
@@ -0,0 +1,22 @@
+% Change file to assist in creating the web2c-specific change file.
+% This one comes first, resolves inconsistencies between the generated
+% etex.web and tex.ch
+% Public domain.
+
+@x [1.2] l.188
+@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@#
+@d banner==eTeX_banner
+@y
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@z
+
+@x [17.236] l.4960 - first web2c, then e-TeX additional integer parameters
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@#
+@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters}
+@y
+@d int_pars=55 {total number of integer parameters}
+@#
+@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters}
+@z
diff --git a/Build/source/texk/web2c/etexdir/tex.ch1 b/Build/source/texk/web2c/etexdir/tex.ch1
new file mode 100644
index 00000000000..bf02fd83350
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/tex.ch1
@@ -0,0 +1,19 @@
+% Change file to assist in creating the web2c-specific change file.
+% This one resolves inconsistencies between tex.ch and tex.ech.
+% Public domain.
+
+@x [1] m.2 l.188 - banner
+@d banner==TeX_banner
+@d banner_k==TeX_banner_k
+@y
+@d banner==eTeX_banner
+@d banner_k==eTeX_banner_k
+@z
+
+@x [17.236] l.4960 - first web2c, then e-TeX additional integer parameters
+@d int_pars=web2c_int_pars {total number of integer parameters}
+@#
+@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters}
+@y
+@d etex_int_base=web2c_int_pars {base for \eTeX's integer parameters}
+@z
diff --git a/Build/source/texk/web2c/etexdir/tex.ech b/Build/source/texk/web2c/etexdir/tex.ech
new file mode 100644
index 00000000000..1d0409dd2c2
--- /dev/null
+++ b/Build/source/texk/web2c/etexdir/tex.ech
@@ -0,0 +1,111 @@
+% This is `tex.ech' in text format as of Aug 3, 2005,
+% for web2c-7.5 and e-TeX Version 2.1 as of Jul 19, 2004,
+% made by B. Raichle and P. Breitenlohner.
+% Public domain.
+
+% Note: This file, etexdir/tex.ech, contains the web2c changes for the
+% e-TeX specific part of etex.web (defined in etexdir/etex.ch) and is
+% used as follows to construct the web2c change file for e-TeX:
+%
+% etexdir/tex.ch0 )
+% + )
+% tex.ch )
+% + ) => tie -c ... => etex.ch
+% etexdir/tex.ch1 )
+% + )
+% etexdir/tex.ech )
+%
+% In addition, this file is used to construct the web2c change file
+% for pdfeTeX:
+%
+% pdfetexdir/tex.ch0 )
+% + )
+% tex.ch )
+% + )
+% etexdir/tex.ch1 )
+% + ) => tie -c ... => pdfetex.ch
+% etexdir/tex.ech )
+% + )
+% pdfetexdir/tex.ch1 )
+% + )
+% pdftexdir/tex.pch )
+%
+% where the four (small) files {,pdf}etexdir/tex.ch[01] take care
+% of interferences between web2c, e-Tex, pdfTeX changes.
+% Consequently, changes in all these files have to be coordinated.
+
+@x [1] m.2 l.188 - Web2C: extensions imply we're not e-TeX
+@d eTeX_banner=='This is e-TeX, Version 3.141592',eTeX_version_string
+@y
+@d eTeX_banner_k=='This is e-TeXk, Version 3.141592',eTeX_version_string
+@d eTeX_banner=='This is e-TeX, Version 3.141592',eTeX_version_string
+@z
+
+@x [51.1332] l.24203 (ca.) texarray
+ line_stack:=xmalloc_array (integer, max_in_open);
+@y
+ line_stack:=xmalloc_array (integer, max_in_open);
+ eof_seen:=xmalloc_array (boolean, max_in_open);
+ grp_stack:=xmalloc_array (save_pointer, max_in_open);
+ if_stack:=xmalloc_array (pointer, max_in_open);
+@z
+
+@x [51.1337] l.24371 (ca.) texarray
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+ hyph_root:=0; hyph_start:=0;
+@z
+
+@x [53a.1379] l.??? -etex command line switch
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+@y
+@!init if (etex_p or(buffer[loc]="*"))and(format_ident=" (INITEX)") then
+@z
+
+@x [53a.1379] l.??? -etex command line switch
+ incr(loc); eTeX_mode:=1; {enter extended mode}
+@y
+ if (buffer[loc]="*") then incr(loc);
+ eTeX_mode:=1; {enter extended mode}
+@z
+
+@x [53a.1383] l.??? -etex command line switch
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+@y
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+@!etex_p: boolean; {was the -etex option specified}
+@z
+
+@x [53a.1391] l.??? texarray
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+@y
+@!eof_seen : ^boolean; {has eof been seen?}
+@z
+
+@x [53a.1506] l.??? texarray
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+@y
+@!grp_stack : ^save_pointer; {initial |cur_boundary|}
+@!if_stack : ^pointer; {initial |cond_ptr|}
+@z
+
+@x [53a.1587] l.??? texarray
+hyph_root:=0; hyph_start:=0;
+@y
+@z
+
+@x [54/web2c.???] l.??? needed earlier
+replacement, but always existing character |font_bc[f]|.
+@^inner loop@>
+
+@<Declare additional functions for ML\TeX@>=
+function effective_char(@!err_p:boolean;
+@y
+replacement, but always existing character |font_bc[f]|.
+@^inner loop@>
+
+@<Declare \eTeX\ procedures for sc...@>=
+function effective_char(@!err_p:boolean;
+@z
diff --git a/Build/source/texk/web2c/fmtutil.in b/Build/source/texk/web2c/fmtutil.in
new file mode 100644
index 00000000000..084a00b857c
--- /dev/null
+++ b/Build/source/texk/web2c/fmtutil.in
@@ -0,0 +1,133 @@
+# Originally written by Thomas Esser, 1998. Public domain.
+# fmtutil.cnf: configuration file for fmtutil.
+#
+# This TeX Live fmtutil.cnf is not kept exactly in sync with the teTeX
+# fmtutil.cnf (and not maintained by te), since the two distributions
+# need different settings, although they are nearly the same. The TL
+# version has a few extra entries at the end, mainly.
+
+# Customize this file to your needs, e.g.
+# - remove or uncomment formats that you don't need
+# - add your own formats
+# - change default engine / flags for standard formats
+
+# Some notes:
+# 1) tex and amstex just load hyphen.tex. No customization.
+# You can have you own customized (via babel's hyphen.cfg)
+# formats on top of plain by using "bplain.tex" instead of
+# plain.tex (see e.g. bplain.ini file for bplain format).
+#
+# 2) etex loads language.def, not language.dat.
+#
+# 3) The symbolic link to the right engines (e.g. bplain -> tex)
+# will be generated by the "texlinks" script. So, if you call
+# fmtutil "by hand" and not via texconfig, please also call
+# texlinks afterwards.
+#
+# 4) usual comments start with "# ", whereas disabled configurations
+# start with "#! " in this file.
+
+# The format of the table is:
+
+# format engine pattern-file arguments
+
+# The last part of "arguments" must be the name of the file to run
+# initex (or another "ini"-engine) on.
+
+# metafont and metapost:
+mf mf - -translate-file=cp227.tcx mf.ini
+mpost mpost - -translate-file=cp227.tcx mpost.mp
+metafun mpost - -translate-file=cp227.tcx metafun.mp
+
+# Standard formats (plain, latex) with all engines:
+
+# Change "tex.ini -> bplain.ini" and "- -> language.dat"
+# if you want babel support in tex. Add -translate-file=cp227.tcx before tex.ini
+# if you want to make all characters directly "printable" for
+# any \write (instead of ^^xy).
+tex tex - tex.ini
+latex pdfetex language.dat -translate-file=cp227.tcx *latex.ini
+etex pdfetex language.def -translate-file=cp227.tcx *etex.ini
+pdftex pdfetex - -translate-file=cp227.tcx *pdftex.ini
+pdflatex pdfetex language.dat -translate-file=cp227.tcx *pdflatex.ini
+pdfetex pdfetex language.def -translate-file=cp227.tcx *pdfetex.ini
+@OMEGA@omega omega - omega.ini
+@OMEGA@lambda omega language.dat lambda.ini
+@ALEPH@aleph aleph - *aleph.ini
+@ALEPH@lamed aleph language.dat *lambda.ini
+
+# The amstex format:
+
+# Change "amstex.ini -> bamstex.ini" and "- -> language.dat"
+# if you want babel support in amstex:
+amstex pdfetex - -translate-file=cp227.tcx *amstex.ini
+
+# Change "pdfamstex.ini -> pdfbamstex.ini" and "- -> language.dat"
+# if you want babel support in pdfamstex:
+#! pdfamstex pdfetex - -translate-file=cp227.tcx *pdfamstex.ini
+
+# Context formats:
+#! cont-cz pdfetex cont-usr.tex -8bit *cont-cz.ini
+#! cont-de pdfetex cont-usr.tex -8bit *cont-de.ini
+cont-en pdfetex cont-usr.tex -8bit *cont-en.ini
+#! cont-nl pdfetex cont-usr.tex -8bit *cont-nl.ini
+#! cont-uk pdfetex cont-usr.tex -8bit *cont-uk.ini
+
+# language-specific things:
+
+# - Cyrillic:
+#! cyrtex pdfetex language.dat -translate-file=cp227.tcx *cyrtex.ini
+#! cyrtexinfo pdfetex language.dat -translate-file=cp227.tcx *cyrtxinf.ini
+#! cyramstex pdfetex language.dat -translate-file=cp227.tcx *cyramstx.ini
+
+# - Polish:
+platex pdfetex language.dat -translate-file=cp227.tcx *platex.ini
+pdfplatex pdfetex language.dat -translate-file=cp227.tcx *pdfplatex.ini
+mex pdfetex mexconf.tex -translate-file=cp227.tcx *mex.ini
+pdfmex pdfetex mexconf.tex -translate-file=cp227.tcx *pdfmex.ini
+utf8mex pdfetex mexconf.tex -enc *utf8mex.ini
+
+# - Polish with translated messages (experimental):
+#! platex-pl pdfetex - nls=pdfetex-pl,il2-pl *platex.ini
+#! mex-pl pdfetex mexconf.tex nls=pdfetex-pl,il2-pl *mex.ini
+#! pdfmex-pl pdfetex mexconf.tex nls=pdfetex-pl,il2-pl *pdfmex.ini
+
+# - Czech / Slovak for ISO-8859-2 locale (see below for UTF8). Enable
+# "by hand", not by "fmtutil --enablefmt", because definitions for
+# ISO-8859-2 / UTF8 share the same name.
+csplain pdfetex - -etex -translate-file=cp227.tcx csplain.ini
+cslatex pdfetex - -etex -translate-file=cp227.tcx cslatex.ini
+pdfcsplain pdfetex - -etex -translate-file=cp227.tcx csplain.ini
+pdfcslatex pdfetex - -etex -translate-file=cp227.tcx cslatex.ini
+
+# - Czech / Slovak for UTF8 locale (see above for ISO-8859-2). Enable
+# "by hand", not by "fmtutil --enablefmt", because definitions for
+# ISO-8859-2 / UTF8 share the same name.
+#! csplain pdfetex - -etex -enc csplain-utf8.ini
+#! cslatex pdfetex - -etex -enc cslatex-utf8.ini
+#! pdfcsplain pdfetex - -etex -enc csplain-utf8.ini
+#! pdfcslatex pdfetex - -etex -enc cslatex-utf8.ini
+
+# formats for mltex extension:
+mltex pdfetex - -translate-file=cp227.tcx -mltex mltex.ini
+mllatex pdfetex language.dat -translate-file=cp227.tcx -mltex mllatex.ini
+
+# Other formats:
+
+# Change "eplain.ini -> ebplain.ini" and "- -> language.dat"
+# if you want babel support in eplain:
+eplain pdfetex - -translate-file=cp227.tcx *eplain.ini
+
+# mptopdf utility
+mptopdf pdfetex - -translate-file=cp227.tcx mptopdf.tex
+
+# --- strange things
+texsis pdfetex - -translate-file=cp227.tcx texsis.ini
+physe pdfetex - physe.ini
+phyzzx pdfetex - physe.ini
+
+# formats with dependencies on earlier formats
+xmltex pdfetex language.dat &latex xmltex.ini
+pdfxmltex pdfetex language.dat &pdflatex pdfxmltex.ini
+jadetex pdfetex language.dat &latex jadetex.ini
+pdfjadetex pdfetex language.dat &pdflatex pdfjadetex.ini
diff --git a/Build/source/texk/web2c/gftodmem.h b/Build/source/texk/web2c/gftodmem.h
new file mode 100644
index 00000000000..edbda5da11d
--- /dev/null
+++ b/Build/source/texk/web2c/gftodmem.h
@@ -0,0 +1,7 @@
+/* This file is included from gftodvi.ch, since variant records are
+ too hard to translate automatically. */
+
+typedef union {
+ scaled sc;
+ fourquarters qqqq;
+} memoryword;
diff --git a/Build/source/texk/web2c/gftodvi.ch b/Build/source/texk/web2c/gftodvi.ch
new file mode 100644
index 00000000000..4808125681d
--- /dev/null
+++ b/Build/source/texk/web2c/gftodvi.ch
@@ -0,0 +1,715 @@
+% gftodvi.ch for C compilation with web2c.
+%
+% (More recent changes in the ChangeLog)
+% 01/20/90 Karl New gftodvi.web (same version number).
+% 12/02/89 Karl Berry To version 3.
+% Revision 1.7.1.5 86/02/01 15:29:58 richards
+% Released again for MF 1.0 package
+% Revision 1.7.1.4 86/02/01 15:06:50 richards
+% Added: <nl> at end of successful run
+% Revision 1.7.1.3 86/01/27 16:39:48 richards
+% Fixed: syntax error in previous edits
+% Revision 1.7.1.2 86/01/27 15:55:58 richards
+% Added: dvi_buf_type declaration and redefined dvi_buf[] in
+% terms of it, so we can use it as a parameter to b_write_buf()
+% Revision 1.7.1.1 86/01/27 15:39:10 richards
+% First edit to use new binary I/O routines
+% Revision 1.7 85/10/21 21:55:50 richards
+% Released for GFtoDVI 1.7
+% Revision 1.3.7.1 85/10/18 22:59:01 richards
+% Updated for GFtoDVI Version 1.7 (Distributed w/ MF84 Version 0.9999)
+% Revision 1.3.5.1 85/10/09 17:02:35 richards
+% First draft to run at 1.5 level
+% Revision 1.3 85/05/27 21:15:30 richards
+% Updated for GFtoDVI Version 1.3 (Distributed w/ MF84 Version 0.91)
+% Revision 1.2 85/04/25 19:33:30 richards
+% Updated to GFtoDVI Version 1.2 (Distributed w/ MF84 Version 0.81)
+% Revision 1.1 85/03/03 21:47:17 richards
+% Updated for GF utilities distributed with MF Version 0.77
+% Revision 1.0 84/12/16 22:38:22 richards
+% Updated for GFtoDVI Version 1.0 (New GF file format)
+% Revision 0.6 84/12/05 13:32:01 richards
+% Updated for GFtoDVI Version 0.6; merged in changes from sdcarl!rusty
+% Note: still has BUGFIX in section 199 to keep GFtoDVI from trying
+% to use non-existent characters in a gray font
+% Revision 0.3 84/11/17 23:51:56 richards
+% Base version for GFtoDVI Version 0.3
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{GF$\,$\lowercase{to}$\,$DVI changes for C}
+@z
+
+@x [3] Redirect output to term_out.
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl(#)==@+begin write_ln; write(#);@+end
+@y
+@d print(#)==write(stdout, #)
+@d print_ln(#)==write_ln(stdout, #)
+@d print_nl(#)==@+begin write_ln(stdout); write(stdout, #);@+end
+@z
+
+@x [still 3] Toss labels.
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
+ begin print_ln(banner);@/
+@y
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
+ begin
+ kpse_set_progname (argv[0]);
+ kpse_init_prog ('GFTODVI', 0, nil, nil);
+ parse_arguments;
+ if verbose then begin
+ print (banner);
+ print_ln (version_string);
+ end;
+@z
+
+% [4] Remove the final_end label.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+@y
+@ This module deleted, since it only defined the label |final_end|.
+@z
+
+@x [8] Add newline to end of abort() message, and exit abnormally.
+@d abort(#)==@+begin print(' ',#); jump_out;@+end
+@y
+@d abort(#)==@+begin write_ln (stderr, #); uexit (1);@+end
+@z
+
+% [8] Remove nonlocal goto.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p procedure jump_out;
+begin goto final_end;
+end;
+@y
+@p procedure jump_out;
+begin uexit(0);
+end;
+@z
+
+% [11] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [14] Allow any input character.
+for i:=0 to @'37 do xchr[i]:='?';
+for i:=@'177 to @'377 do xchr[i]:='?';
+@y
+for i:=1 to @'37 do xchr[i]:=chr(i);
+for i:=@'177 to @'377 do xchr[i]:=chr(i);
+@z
+
+
+@x [15] Change `update_terminal' to `flush', `term_in' is stdin.
+Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall call a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+
+@d update_terminal == break(output) {empty the terminal output buffer}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of 0..255;
+@!term_in:text_file; {the terminal, considered as an input file}
+@y
+Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall call a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+@^system dependencies@>
+
+@d update_terminal == fflush (stdout) {empty the terminal output buffer}
+@d term_in == stdin {standard input}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of 0..255;
+@z
+
+@x [17] Change term_in^, etc.
+@p procedure input_ln; {inputs a line from the terminal}
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+line_length:=0;
+while (line_length<terminal_line_length)and not eoln(term_in) do
+ begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in);
+ end;
+end;
+@y
+@p procedure input_ln; {inputs a line from the terminal}
+begin update_terminal;
+if eoln(term_in) then read_ln(term_in);
+line_length:=0;
+while (line_length<terminal_line_length)and not eoln(term_in) do
+ begin buffer[line_length]:=xord[getc(term_in)]; incr(line_length);
+ end;
+end;
+@z
+
+@x [47] Open files based on paths.
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file,name_of_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,name_of_file);
+end;
+@#
+procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
+begin rewrite(dvi_file,name_of_file);
+end;
+@y
+In C, we do path searching based on the user's environment or the
+default path. We also read the command line and print the banner here
+(since we don't want to print the banner if the command line is
+unreasonable).
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin
+ gf_file := kpse_open_file (stringcast(name_of_file), kpse_gf_format);
+ cur_loc := 0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin
+ tfm_file := kpse_open_file (stringcast(name_of_file), kpse_tfm_format);
+end;
+@#
+procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
+begin rewritebin(dvi_file,stringcast(name_of_file));
+end;
+@z
+
+% [48] Don't force a maximum length for name_of_file. See comments in
+% tex.ch for why we change the element type to text_char.
+@x
+@!name_of_file:packed array[1..file_name_size] of char; {external file name}
+@y
+@!name_of_file:^text_char;
+@z
+
+@x [51] Make get_n_bytes routines work with 16-bit math.
+get_two_bytes:=a*256+b;
+@y
+get_two_bytes:=a*intcast(256)+b;
+@z
+@x
+get_three_bytes:=(a*256+b)*256+c;
+@y
+get_three_bytes:=(a*intcast(256)+b)*256+c;
+@z
+@x
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+@y
+if a<128 then signed_quad:=((a*intcast(256)+b)*256+c)*256+d
+else signed_quad:=(((a-256)*intcast(256)+b)*256+c)*256+d;
+@z
+
+% [52] The memory_word structure is too hard to translate via web2c, so
+% we use a hand-coded include file. Also, b0 (et al.) is used both as a
+% field and as a regular variable. web2c puts field names in the global
+% symbol table, so this loses. Rather than fix web2c (hard), we change
+% the name of the field (ugly, but easy).
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case boolean of
+ true: (@!sc:scaled);
+ false: (@!qqqq:four_quarters);
+ end;
+@y
+@!four_quarters = packed record@;@/
+ @!B0:quarterword;
+ @!B1:quarterword;
+ @!B2:quarterword;
+ @!B3:quarterword;
+ end;
+@\@/@=#include "gftodmem.h";@>@\ {note the |;| so |web2c| will translate
+ types that come after this}
+@z
+
+% [55] fix references to .b0
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_info[width_base[#]+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 4].sc
+@d char_italic(#)==font_info[italic_base[#]+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 16].sc
+@d char_height(#)==font_info[height_base[#]+char_height_end
+@d char_depth_end(#)==# mod 16].sc
+@d char_depth(#)==font_info[depth_base[#]+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+@d skip_byte(#)==qo(#.b0)
+@d next_char(#)==#.b1
+@d op_byte(#)==qo(#.b2)
+@d rem_byte(#)==#.b3
+@y
+@d char_width_end(#)==#.B0].sc
+@d char_width(#)==font_info[width_base[#]+char_width_end
+@d char_exists(#)==(#.B0>min_quarterword)
+@d char_italic_end(#)==(qo(#.B2)) div 4].sc
+@d char_italic(#)==font_info[italic_base[#]+char_italic_end
+@d height_depth(#)==qo(#.B1)
+@d char_height_end(#)==(#) div 16].sc
+@d char_height(#)==font_info[height_base[#]+char_height_end
+@d char_depth_end(#)==# mod 16].sc
+@d char_depth(#)==font_info[depth_base[#]+char_depth_end
+@d char_tag(#)==((qo(#.B2)) mod 4)
+@d skip_byte(#)==qo(#.B0)
+@d next_char(#)==#.B1
+@d op_byte(#)==qo(#.B2)
+@d rem_byte(#)==#.B3
+@z
+
+% [60] Fix 16-bit arithmetic bugs in TFM calculations.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@ @d read_two_halves_end(#)==#:=b2*256+b3
+@d read_two_halves(#)==read_tfm_word; #:=b0*256+b1; read_two_halves_end
+@y
+@ @d read_two_halves_end(#)==#:=b2*intcast(256)+b3
+@d read_two_halves(#)==read_tfm_word; #:=b0*intcast(256)+b1; read_two_halves_end
+@z
+
+% [62] More .b?'s.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ qw.b0:=qi(b0); qw.b1:=qi(b1); qw.b2:=qi(b2); qw.b3:=qi(b3);
+@y
+ qw.B0:=qi(b0); qw.B1:=qi(b1); qw.B2:=qi(b2); qw.B3:=qi(b3);
+@z
+
+% [62] More arithmetic fixes.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+z:=((b0*256+b1)*256+b2)*16+(b3 div 16);
+@y
+z:=((b0*intcast(256)+b1)*intcast(256)+b2)*16+(b3 div 16);
+@z
+@x
+ else if 256*(b2-128)+b3>=nk then abend;
+@y
+ else if intcast(256)*(b2-128)+b3>=nk then abend;
+@z
+
+@x [78] Change default extension to `.2602gf'.
+l:=3; init_str3(".")("g")("f")(gf_ext);@/
+@y
+l:=7; init_str7(".")("2")("6")("0")("2")("g")("f")(gf_ext);@/
+@z
+
+@x [88] Change home_font_area to null_string.
+l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/
+@y
+l:=0; init_str0(home_font_area);@/
+@z
+
+@x [90] Change more_name to understand Unix file name syntax.
+else begin if (c=">")or(c=":") then
+ begin area_delimiter:=pool_ptr; ext_delimiter:=0;
+ end
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr;
+@y
+else begin if (c="/") then
+ begin area_delimiter:=pool_ptr; ext_delimiter:=0;
+ end
+ else if c="." then ext_delimiter:=pool_ptr;
+@z
+
+@x [92] pack_file_name must pack for C conventions.
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+@y
+@d append_to_name(#)==begin c:=#; incr(k);
+ name_of_file[k]:=xchr[c];
+@z
+
+@x
+@!name_length:0..file_name_size; {number of characters packed}
+begin k:=0;
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(str_pool[j]);
+for j:=str_start[n] to str_start[n+1]-1 do append_to_name(str_pool[j]);
+for j:=str_start[e] to str_start[e+1]-1 do append_to_name(str_pool[j]);
+if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+@!name_length: integer;
+begin
+ name_length := length (a) + length (n) + length (e);
+ name_of_file := xmalloc_array (ASCII_code, name_length);
+ k := -1; {C strings start at position zero.}
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(str_pool[j]);
+for j:=str_start[n] to str_start[n+1]-1 do append_to_name(str_pool[j]);
+for j:=str_start[e] to str_start[e+1]-1 do append_to_name(str_pool[j]);
+ name_of_file[name_length] := 0;
+@z
+
+@x [94] Change start_gf to get file name from the command line.
+@ The |start_gf| procedure prompts the user for the name of the generic
+font file to be input. It opens the file, making sure that some input is
+present; then it opens the output file.
+
+Although this routine is system-independent, it should probably be
+modified to take the file name from the command line (without an initial
+prompt), on systems that permit such things.
+
+@p procedure start_gf;
+label found,done;
+begin loop@+begin print_nl('GF file name: '); input_ln;
+@.GF file name@>
+ buf_ptr:=0; buffer[line_length]:="?";
+ while buffer[buf_ptr]=" " do incr(buf_ptr);
+ if buf_ptr<line_length then
+ begin @<Scan the file name in the buffer@>;
+ if cur_ext=null_string then cur_ext:=gf_ext;
+ pack_file_name(cur_name,cur_area,cur_ext); open_gf_file;
+ if not eof(gf_file) then goto found;
+ print_nl('Oops... I can''t find file '); print(name_of_file);
+@.Oops...@>
+@.I can't find...@>
+ end;
+ end;
+found:job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext);
+open_dvi_file;
+end;
+@y
+@ The |start_gf| procedure obtains the name of the generic font file to
+be input from the command line. It opens the file, making sure that
+some input is present; then it opens the output file.
+
+@p procedure start_gf;
+label done;
+var arg_buffer: ^char;
+ arg_buf_ptr: integer;
+begin
+ arg_buffer := cmdline (optind);
+ arg_buf_ptr := 0;
+ while (line_length < terminal_line_length)
+ and (arg_buffer[arg_buf_ptr] <> 0) do begin
+ buffer[line_length] := xord[arg_buffer[arg_buf_ptr]];
+ incr(line_length);
+ incr(arg_buf_ptr);
+ end;
+
+ buf_ptr:=0; buffer[line_length]:="?";
+ while buffer[buf_ptr]=" " do incr(buf_ptr);
+ if buf_ptr < line_length
+ then begin
+ @<Scan the file name in the buffer@>;
+ if cur_ext = null_string then cur_ext:=gf_ext;
+ pack_file_name (cur_name, cur_area, cur_ext);
+ open_gf_file;
+ end;
+ job_name := cur_name;
+ pack_file_name(job_name, null_string, dvi_ext);
+ open_dvi_file;
+end;
+@z
+
+@x [107] `write_dvi' is now an external C routine.
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+In C, we can write out the entire array with one call.
+@p procedure write_dvi(@!a,@!b:dvi_index);
+begin
+ write_chunk (dvi_file, dvi_buf, a, b);
+end;
+@z
+
+% [111] More .b?'s.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+dvi_out(qo(font_check[f].b0));
+dvi_out(qo(font_check[f].b1));
+dvi_out(qo(font_check[f].b2));
+dvi_out(qo(font_check[f].b3));@/
+@y
+dvi_out(qo(font_check[f].B0));
+dvi_out(qo(font_check[f].B1));
+dvi_out(qo(font_check[f].B2));
+dvi_out(qo(font_check[f].B3));@/
+@z
+
+% [115] Don't go to final_end, just exit; this is the normal exit from
+% the program, so we want to end with a newline if we are being verbose.
+@x
+goto final_end;
+@y
+if verbose then print_ln (' ');
+uexit (0);
+@z
+
+% [118] And still more .b?'s.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+dummy_info.b0:=qi(0); dummy_info.b1:=qi(0); dummy_info.b2:=qi(0);
+dummy_info.b3:=qi(0);
+@y
+dummy_info.B0:=qi(0); dummy_info.B1:=qi(0); dummy_info.B2:=qi(0);
+dummy_info.B3:=qi(0);
+@z
+
+% [138] write_ln formatting.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+begin if abs(r-slant_reported)>0.001 then
+ begin print_nl('Sorry, I can''t make diagonal rules of slant ',r:10:5,'!');
+@y
+begin if fabs(r-slant_reported)>0.001 then
+ begin print_nl('Sorry, I can''t make diagonal rules of slant ');
+ print_real(r,10,5); print('!');
+@z
+
+% [164] No progress report unless verbose.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+print('[',total_pages:1); update_terminal; {print a progress report}
+@y
+if verbose
+then begin
+ print('[',total_pages:1);
+ update_terminal; {print a progress report}
+end;
+@z
+
+@x
+print(']'); update_terminal;
+@y
+if verbose
+then begin
+ print(']');
+ if total_pages mod 13 = 0
+ then print_ln (' ')
+ else print (' ');
+ update_terminal;
+end;
+@z
+
+% [170] Change offset for overflow labels. The defaults adds about 2.1
+% inches to the right edge of the diagram, which puts it off the paper
+% for even moderately large fonts. Instead, we make it a command-line
+% option.
+@x
+over_col:=over_col+delta_x+10000000;
+@y
+over_col := over_col + delta_x + overflow_label_offset;
+@z
+
+% [215] Some broken compilers cannot handle 165 labels for the same
+% branch of a switch.
+@x
+@<Read and process...@>=
+loop @+begin continue: case cur_gf of
+ sixty_four_cases(0): k:=cur_gf;
+ paint1:k:=get_byte;
+ paint2:k:=get_two_bytes;
+ paint3:k:=get_three_bytes;
+ eoc:goto done1;
+ skip0:end_with(blank_rows:=0; do_skip);
+ skip1:end_with(blank_rows:=get_byte; do_skip);
+ skip2:end_with(blank_rows:=get_two_bytes; do_skip);
+ skip3:end_with(blank_rows:=get_three_bytes; do_skip);
+ sixty_four_cases(new_row_0),sixty_four_cases(new_row_0+64),
+ thirty_two_cases(new_row_0+128),five_cases(new_row_0+160):
+ end_with(z:=cur_gf-new_row_0;paint_black:=true);
+ xxx1,xxx2,xxx3,xxx4,yyy,no_op:begin skip_nop; goto continue;
+ end;
+ othercases bad_gf('Improper opcode')
+ endcases;@/
+@y
+@<Read and process...@>=
+loop @+begin continue:
+ if (cur_gf>=new_row_0)and(cur_gf<=new_row_0+164) then
+ end_with(z:=cur_gf-new_row_0;paint_black:=true)
+ else case cur_gf of
+ sixty_four_cases(0): k:=cur_gf;
+ paint1:k:=get_byte;
+ paint2:k:=get_two_bytes;
+ paint3:k:=get_three_bytes;
+ eoc:goto done1;
+ skip0:end_with(blank_rows:=0; do_skip);
+ skip1:end_with(blank_rows:=get_byte; do_skip);
+ skip2:end_with(blank_rows:=get_two_bytes; do_skip);
+ skip3:end_with(blank_rows:=get_three_bytes; do_skip);
+ xxx1,xxx2,xxx3,xxx4,yyy,no_op:begin skip_nop; goto continue;
+ end;
+ othercases bad_gf('Improper opcode')
+ endcases;@/
+@z
+
+@x [still 219] If verbose, output a newline at the end.
+final_end:end.
+@y
+ if verbose and (total_pages mod 13 <> 0) then print_ln (' ');
+end.
+@z
+
+@x [222] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoDVI} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 4; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('gftodvi');
+
+ end else if argument_is ('help') then begin
+ usage_help (GFTODVI_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.E. Knuth');
+
+ end else if argument_is ('overflow-label-offset') then begin
+ offset_in_points := atof (optarg);
+ overflow_label_offset := round (offset_in_points * 65536);
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one remaining argument.}
+ if (optind + 1 <> argc) then begin
+ write_ln (stderr, 'gftodvi: Need exactly one file argument.');
+ usage ('gftodvi');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@
+@<Initialize the option...@> =
+verbose := false;
+
+@ Change how far from the right edge of the character boxes we print
+overflow labels.
+@.-overflow-label-offset@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'overflow-label-offset';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ It's easier on the user to specify the value in \TeX\ points, but we
+want to store it in scaled points.
+
+@<Glob...@> =
+@!overflow_label_offset: integer; {in scaled points}
+@!offset_in_points: real;
+
+@ The default offset is ten million scaled points---a little more than
+two inches.
+
+@<Initialize the option...@> =
+overflow_label_offset := 10000000;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/gftodvi.rc b/Build/source/texk/web2c/gftodvi.rc
new file mode 100644
index 00000000000..8c00ec74a43
--- /dev/null
+++ b/Build/source/texk/web2c/gftodvi.rc
@@ -0,0 +1,32 @@
+/* gftodvi.rc: gftodvi resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " gftodvi 3.0"
+
+#define VER_INTERNALNAME_STR "gftodvi"
+#define VER_ORIGINALFILENAME_STR "gftodvi.exe"
+
+#define VER_FILEDESCRIPTION_STR "GF-to-DVI file converter"
+
+#include <texlive.version>
+
+/* gftodvi.rc ends here */
diff --git a/Build/source/texk/web2c/gftodvi.web b/Build/source/texk/web2c/gftodvi.web
new file mode 100644
index 00000000000..3540b500f1b
--- /dev/null
+++ b/Build/source/texk/web2c/gftodvi.web
@@ -0,0 +1,4393 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was completed on April 23, 1984.
+% Version 0.1 added char_code output (May 4).
+% Version 0.2 included rules and dots in the boundary calculations (May 25).
+% Version 0.3 added label type "/" (May 27).
+% Version 0.4 (by Arthur Samuel) improved the dot labeling routine (July 23).
+% Version 0.5 added the slant font for rules (September 2).
+% Version 0.6 changed label types and allowed invisible dots (September 28).
+% Version 1.0 switched to new GF format (December 8).
+% Version 1.1 switched to newer GF format (February 2, 1985).
+% Version 1.2 added the offset operations of MF version 0.8 (April 1, 1985).
+% Version 1.3 allowed online entry of gray font, etc. (April 22, 1985).
+% Version 1.4 allowed "almost" horizontal or vertical rules (May 20, 1985).
+% Version 1.5 corrected a bug in the diagonal slant routine (June 18, 1985).
+% Version 1.6 corrected a bug if labels exist but no dots (September 13, 1985).
+% Version 1.7 changed from am to cm fonts; fam became ext (October 5, 1985).
+% Version 2.0 was tuned up for the METAFONTware report (April, 1989).
+% Version 3.0 uses 8-bit codes and extended ligatures (October, 1989).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=manfnt % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\let\swap=\leftrightarrow
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{GF$\,$\lowercase{to}$\,$DVI}
+\def\contentspagenumber{301}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont GFtoDVI} processor}
+ \vskip 15pt
+ \centerline{(Version 3.0, October 1989)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926, MCS-8300984, and
+ CCR-8610181,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.
+ `{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley
+ Publishing Company.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{GFtoDVI} utility program reads binary generic font (``\.{GF}'')
+files that are produced by font compilers such as \MF, and converts them
+into device-independent (``\.{DVI}'') files that can be printed to give
+annotated hardcopy proofs of the character shapes. The annotations are
+specified by the comparatively simple conventions of plain \MF; i.e.,
+there are mechanisms for labeling chosen points and for superimposing
+horizontal or vertical rules on the enlarged character shapes.
+
+The purpose of \.{GFtoDVI} is simply to make proof copies; it does not
+exhaustively test the validity of a \.{GF} file, nor do its algorithms
+much resemble the algorithms that are typically used to prepare font
+descriptions for commercial typesetting equipment. Another program,
+\.{GFtype}, is available for validity checking; \.{GFtype} also serves
+as a model of programs that convert fonts from \.{GF} format to some
+other coding scheme.
+
+The |banner| string defined here should be changed whenever \.{GFtoDVI}
+gets modified.
+
+@d banner=='This is GFtoDVI, Version 3.0' {printed when the program starts}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{GFtoDVI} must read files whose names
+are dynamically specified, and such a task would be impossible in pure \PASCAL.
+All places where nonstandard constructions are used have been listed in
+the index under ``system dependencies.''
+@!@^system dependencies@>
+
+Another exception to standard \PASCAL\ occurs in the
+use of default branches in |case| statements; the conventions
+of \.{TANGLE}, \.{WEAVE}, etc., have been followed.
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The main input and output files are not mentioned in the program header,
+because their external names
+will be determined at run time (e.g., by interpreting the
+command line that invokes this program). Error messages and other remarks
+are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl(#)==@+begin write_ln; write(#);@+end
+
+@p program GF_to_DVI(@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{GFtoDVI}'s capacity.
+
+@<Constants...@>=
+@!max_labels=2000; {maximum number of labels and dots and rules per character}
+@!pool_size=10000; {maximum total length of labels and other strings}
+@!max_strings=1100; {maximum number of labels and other strings}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!file_name_size=50; {a file name shouldn't be longer than this}
+@!font_mem_size=2000; {space for font metric data}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!widest_row=8192; {maximum number of pixels per row}
+@!lig_lookahead=20; {size of stack used when inserting ligature characters}
+
+@ Labels are given symbolic names by the following definitions, so that
+occasional |goto| statements will be meaningful. We insert the label
+`|exit|:' just before the `\ignorespaces|end|\unskip' of a procedure in
+which we have used the `|return|' statement defined below; the label
+`|reswitch|' is occasionally used just prior to a |case|
+statement in which some cases change the conditions and we wish to branch
+to the newly applicable case. Loops that are set up with the |loop|
+construction defined below are commonly exited by going to `|done|' or to
+`|found|' or to `|not_found|', and they are sometimes repeated by going to
+`|continue|'.
+
+Incidentally, this program never declares a label that isn't actually used,
+because some fussy \PASCAL\ compilers will complain about redundant labels.
+
+@d exit=10 {go here to leave a procedure}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d done1=31 {like |done|, when there is more than one loop}
+@d found=40 {go here when you've found it}
+@d not_found=45 {go here when you've found nothing}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@f loop == xclause
+ {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil {\.{WEB} will henceforth say |return| instead of \\{return}}
+
+@ If the \.{GF} file is badly malformed, the whole process must be aborted;
+\.{GFtoDVI} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{GFtoDVI}.
+@^system dependencies@>
+
+@d abort(#)==@+begin print(' ',#); jump_out;@+end
+@d bad_gf(#)==abort('Bad GF file: ',#,'! (at byte ',cur_loc-1:1,')')
+@.Bad GF file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@ As in \TeX\ and \MF, this program deals with numeric quantities that
+are integer multiples of~$2^{16}$, and calls them |scaled|.
+
+@d unity==@'200000 {|scaled| representation of 1.0}
+
+@<Types ...@>=
+@!scaled=integer; {fixed-point numbers}
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{GFtoDVI} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used. Furthermore, both \.{GF} and \.{DVI} files use ASCII code
+for file names and certain other strings.
+The next few sections of \.{GFtoDVI} have therefore been copied from the
+analogous ones in the \.{WEB} system routines.
+
+@<Types ...@>=
+@!ASCII_code=0..255; {eight-bit numbers, a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when
+six-bit character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and
+small letters in a convenient way. So we shall assume that the
+\PASCAL\ system being used for \.{GFtoDVI} has a character set containing
+at least the standard visible ASCII characters (|"!"| through |"~"|). If
+additional characters are present, \.{GFtoDVI} can be configured to
+work with them too.
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Types ...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{GFtoDVI} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+
+@ Here now is the system-dependent part of the character set.
+If \.{GFtoDVI} is being implemented on a garden-variety \PASCAL\ for which
+only standard ASCII codes will appear in the input and output files, you
+don't need to make any changes here. But if you have, for example, an extended
+character set like the one in Appendix~C of {\sl The \TeX book}, the first
+line of code in this module should be changed to
+$$\hbox{|for i:=0 to @'37 do xchr[i]:=chr(i);|}$$
+\.{WEB}'s character set is essentially identical to \TeX's.
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+for i:=@'177 to @'377 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=" ";
+for i:=1 to @'377 do xord[xchr[i]]:=i;
+xord['?']:="?";
+
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input.
+@^system dependencies@>
+
+Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall call a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+
+@d update_terminal == break(output) {empty the terminal output buffer}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of 0..255;
+@!term_in:text_file; {the terminal, considered as an input file}
+
+@ A global variable |line_length| records the first buffer position after
+the line just read.
+@^system dependencies@>
+
+@p procedure input_ln; {inputs a line from the terminal}
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+line_length:=0;
+while (line_length<terminal_line_length)and not eoln(term_in) do
+ begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in);
+ end;
+end;
+
+@ The global variable |buf_ptr| is used while scanning each line of input;
+it points to the first unread character in |buffer|.
+
+@<Glob...@>=
+@!buf_ptr:0..terminal_line_length; {the number of characters read}
+@!line_length:0..terminal_line_length; {end of line read by |input_ln|}
+
+@* Device-independent file format.
+Before we get into the details of \.{GFtoDVI}, we need to know exactly
+what \.{DVI} files are. The form of such files was designed by David R.
+@^Fuchs, David Raymond@>
+Fuchs in 1979. Almost any reasonable typesetting device can be driven by
+a program that takes \.{DVI} files as input, and dozens of such
+\.{DVI}-to-whatever programs have been written. Thus, it is possible to
+print the output of document compilers like \TeX\ on many different kinds
+of equipment. (The following material has been copied almost verbatim from the
+program for \TeX.)
+
+A \.{DVI} file is a stream of 8-bit bytes, which may be regarded as a
+series of commands in a machine-like language. The first byte of each command
+is the operation code, and this code is followed by zero or more bytes
+that provide parameters to the command. The parameters themselves may consist
+of several consecutive bytes; for example, the `|set_rule|' command has two
+parameters, each of which is four bytes long. Parameters are usually
+regarded as nonnegative integers; but four-byte-long parameters,
+and shorter parameters that denote distances, can be
+either positive or negative. Such parameters are given in two's complement
+notation. For example, a two-byte-long distance parameter has a value between
+$-2^{15}$ and $2^{15}-1$.
+@.DVI {\rm files}@>
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@^BigEndian order@>
+
+A \.{DVI} file consists of a ``preamble,'' followed by a sequence of one
+or more ``pages,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that define the dimensions used in the
+file; this must come first. Each ``page'' consists of a |bop| command,
+followed by any number of other commands that tell where characters are to
+be placed on a physical page, followed by an |eop| command. The pages
+appear in the order that they were generated, not in any particular
+numerical order. If we ignore |nop| commands and \\{fnt\_def} commands
+(which are allowed between any two commands in the file), each |eop|
+command is immediately followed by a |bop| command, or by a |post|
+command; in the latter case, there are no more pages in the file, and the
+remaining bytes form the postamble. Further details about the postamble
+will be explained later.
+
+Some parameters in \.{DVI} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first byte is number~0, then comes number~1, and so on. For example,
+one of the parameters of a |bop| command points to the previous |bop|;
+this makes it feasible to read the pages in backwards order, in case the
+results are being directed to a device that stacks its output face up.
+Suppose the preamble of a \.{DVI} file occupies bytes 0 to 99. Now if the
+first page occupies bytes 100 to 999, say, and if the second
+page occupies bytes 1000 to 1999, then the |bop| that starts in byte 1000
+points to 100 and the |bop| that starts in byte 2000 points to 1000. (The
+very first |bop|, i.e., the one that starts in byte 100, has a pointer of $-1$.)
+
+@ The \.{DVI} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+implicit instead of explicit. When a \.{DVI}-reading program reads the
+commands for a page, it keeps track of several quantities: (a)~The current
+font |f| is an integer; this value is changed only
+by \\{fnt} and \\{fnt\_num} commands. (b)~The current position on the page
+is given by two numbers called the horizontal and vertical coordinates,
+|h| and |v|. Both coordinates are zero at the upper left corner of the page;
+moving to the right corresponds to increasing the horizontal coordinate, and
+moving down corresponds to increasing the vertical coordinate. Thus, the
+coordinates are essentially Cartesian, except that vertical directions are
+flipped; the Cartesian version of |(h,v)| would be |(h,-v)|. (c)~The
+current spacing amounts are given by four numbers |w|, |x|, |y|, and |z|,
+where |w| and~|x| are used for horizontal spacing and where |y| and~|z|
+are used for vertical spacing. (d)~There is a stack containing
+|(h,v,w,x,y,z)| values; the \.{DVI} commands |push| and |pop| are used to
+change the current level of operation. Note that the current font~|f| is
+not pushed and popped; the stack contains only information about
+positioning.
+
+The values of |h|, |v|, |w|, |x|, |y|, and |z| are signed integers having up
+to 32 bits, including the sign. Since they represent physical distances,
+there is a small unit of measurement such that increasing |h| by~1 means
+moving a certain tiny distance to the right. The actual unit of
+measurement is variable, as explained below.
+
+@ Here is a list of all the commands that may appear in a \.{DVI} file. Each
+command is specified by its symbolic name (e.g., |bop|), its opcode byte
+(e.g., 139), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|p[4]|' means that parameter |p| is four bytes long.
+
+\yskip\hang|set_char_0| 0. Typeset character number~0 from font~|f|
+such that the reference point of the character is at |(h,v)|. Then
+increase |h| by the width of that character. Note that a character may
+have zero or negative width, so one cannot be sure that |h| will advance
+after this command; but |h| usually does increase.
+
+\yskip\hang|set_char_1| through |set_char_127| (opcodes 1 to 127).
+Do the operations of |set_char_0|; but use the character whose number
+matches the opcode, instead of character~0.
+
+\yskip\hang|set1| 128 |c[1]|. Same as |set_char_0|, except that character
+number~|c| is typeset. \TeX82 uses this command for characters in the
+range |128<=c<256|.
+
+\yskip\hang|set2| 129 |c[2]|. Same as |set1|, except that |c|~is two
+bytes long, so it is in the range |0<=c<65536|.
+
+\yskip\hang|set3| 130 |c[3]|. Same as |set1|, except that |c|~is three
+bytes long, so it can be as large as $2^{24}-1$. Not even the Chinese
+language has this many characters, but this command might prove useful
+in some yet unforeseen way.
+
+\yskip\hang|set4| 131 |c[4]|. Same as |set1|, except that |c|~is four
+bytes long, possibly even negative. Imagine that.
+
+\yskip\hang|set_rule| 132 |a[4]| |b[4]|. Typeset a solid black rectangle
+of height |a| and width |b|, with its bottom left corner at |(h,v)|. Then
+set |h:=h+b|. If either |a<=0| or |b<=0|, nothing should be typeset. Note
+that if |b<0|, the value of |h| will decrease even though nothing else happens.
+
+\yskip\hang|put1| 133 |c[1]|. Typeset character number~|c| from font~|f|
+such that the reference point of the character is at |(h,v)|. (The `put'
+commands are exactly like the `set' commands, except that they simply put out a
+character or a rule without moving the reference point afterwards.)
+
+\yskip\hang|put2| 134 |c[2]|. Same as |set2|, except that |h| is not changed.
+
+\yskip\hang|put3| 135 |c[3]|. Same as |set3|, except that |h| is not changed.
+
+\yskip\hang|put4| 136 |c[4]|. Same as |set4|, except that |h| is not changed.
+
+\yskip\hang|put_rule| 137 |a[4]| |b[4]|. Same as |set_rule|, except that
+|h| is not changed.
+
+\yskip\hang|nop| 138. No operation, do nothing. Any number of |nop|'s
+may occur between \.{DVI} commands, but a |nop| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|bop| 139 $c_0[4]$ $c_1[4]$ $\ldots$ $c_9[4]$ $p[4]$. Beginning
+of a page: Set |(h,v,w,x,y,z):=(0,0,0,0,0,0)| and set the stack empty. Set
+the current font |f| to an undefined value. The ten $c_i$ parameters can
+be used to identify pages, if a user wants to print only part of a \.{DVI}
+file; \TeX82 gives them the values of \.{\\count0} $\ldots$ \.{\\count9}
+at the time \.{\\shipout} was invoked for this page. The parameter |p|
+points to the previous |bop| command in the file, where the first |bop|
+has $p=-1$.
+
+\yskip\hang|eop| 140. End of page: Print what you have read since the
+previous |bop|. At this point the stack should be empty. (The \.{DVI}-reading
+programs that drive most output devices will have kept a buffer of the
+material that appears on the page that has just ended. This material is
+largely, but not entirely, in order by |v| coordinate and (for fixed |v|) by
+|h|~coordinate; so it usually needs to be sorted into some order that is
+appropriate for the device in question. \.{GFtoDVI} does not do such sorting.)
+
+\yskip\hang|push| 141. Push the current values of |(h,v,w,x,y,z)| onto the
+top of the stack; do not change any of these values. Note that |f| is
+not pushed.
+
+\yskip\hang|pop| 142. Pop the top six values off of the stack and assign
+them to |(h,v,w,x,y,z)|. The number of pops should never exceed the number
+of pushes, since it would be highly embarrassing if the stack were empty
+at the time of a |pop| command.
+
+\yskip\hang|right1| 143 |b[1]|. Set |h:=h+b|, i.e., move right |b| units.
+The parameter is a signed number in two's complement notation, |-128<=b<128|;
+if |b<0|, the reference point actually moves left.
+
+\yskip\hang|right2| 144 |b[2]|. Same as |right1|, except that |b| is a
+two-byte quantity in the range |-32768<=b<32768|.
+
+\yskip\hang|right3| 145 |b[3]|. Same as |right1|, except that |b| is a
+three-byte quantity in the range |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|right4| 146 |b[4]|. Same as |right1|, except that |b| is a
+four-byte quantity in the range |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|w0| 147. Set |h:=h+w|; i.e., move right |w| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|w| gets particular values.
+
+\yskip\hang|w1| 148 |b[1]|. Set |w:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |w|~spacing and moves right by |b|.
+
+\yskip\hang|w2| 149 |b[2]|. Same as |w1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|w3| 150 |b[3]|. Same as |w1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|w4| 151 |b[4]|. Same as |w1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|x0| 152. Set |h:=h+x|; i.e., move right |x| units. The `|x|'
+commands are like the `|w|' commands except that they involve |x| instead
+of |w|.
+
+\yskip\hang|x1| 153 |b[1]|. Set |x:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |x|~spacing and moves right by |b|.
+
+\yskip\hang|x2| 154 |b[2]|. Same as |x1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|x3| 155 |b[3]|. Same as |x1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|x4| 156 |b[4]|. Same as |x1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|down1| 157 |a[1]|. Set |v:=v+a|, i.e., move down |a| units.
+The parameter is a signed number in two's complement notation, |-128<=a<128|;
+if |a<0|, the reference point actually moves up.
+
+\yskip\hang|down2| 158 |a[2]|. Same as |down1|, except that |a| is a
+two-byte quantity in the range |-32768<=a<32768|.
+
+\yskip\hang|down3| 159 |a[3]|. Same as |down1|, except that |a| is a
+three-byte quantity in the range |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|down4| 160 |a[4]|. Same as |down1|, except that |a| is a
+four-byte quantity in the range |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|y0| 161. Set |v:=v+y|; i.e., move down |y| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|y| gets particular values.
+
+\yskip\hang|y1| 162 |a[1]|. Set |y:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |y|~spacing and moves down by |a|.
+
+\yskip\hang|y2| 163 |a[2]|. Same as |y1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|y3| 164 |a[3]|. Same as |y1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|y4| 165 |a[4]|. Same as |y1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|z0| 166. Set |v:=v+z|; i.e., move down |z| units. The `|z|' commands
+are like the `|y|' commands except that they involve |z| instead of |y|.
+
+\yskip\hang|z1| 167 |a[1]|. Set |z:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |z|~spacing and moves down by |a|.
+
+\yskip\hang|z2| 168 |a[2]|. Same as |z1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|z3| 169 |a[3]|. Same as |z1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|z4| 170 |a[4]|. Same as |z1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|fnt_num_0| 171. Set |f:=0|. Font 0 must previously have been
+defined by a \\{fnt\_def} instruction, as explained below.
+
+\yskip\hang|fnt_num_1| through |fnt_num_63| (opcodes 172 to 234). Set
+|f:=1|, \dots, |f:=63|, respectively.
+
+\yskip\hang|fnt1| 235 |k[1]|. Set |f:=k|. \TeX82 uses this command for font
+numbers in the range |64<=k<256|.
+
+\yskip\hang|fnt2| 236 |k[2]|. Same as |fnt1|, except that |k|~is two
+bytes long, so it is in the range |0<=k<65536|. \TeX82 never generates this
+command, but large font numbers may prove useful for specifications of
+color or texture, or they may be used for special fonts that have fixed
+numbers in some external coding scheme.
+
+\yskip\hang|fnt3| 237 |k[3]|. Same as |fnt1|, except that |k|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|fnt4| 238 |k[4]|. Same as |fnt1|, except that |k|~is four
+bytes long; this is for the really big font numbers (and for the negative ones).
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |nop| unless special \.{DVI}-reading
+programs are being used. \TeX82 generates |xxx1| when a short enough
+\.{\\special} appears, setting |k| to the number of bytes being sent. It
+is recommended that |x| be a string having the form of a keyword followed
+by possible parameters relevant to that keyword.
+
+\yskip\hang|xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be ridiculously
+large. \TeX82 uses |xxx4| when |xxx1| would be incorrect.
+
+\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<256|; font definitions will be explained shortly.
+
+\yskip\hang|fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<65536|.
+
+\yskip\hang|fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
+
+\yskip\hang|pre| 247 |i[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameters |i|, |num|, |den|, |mag|, |k|, and |x| are explained below.
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@ Only a few of the operation codes above are actually needed by \.{GFtoDVI}.
+
+@d set1=128 {typeset a character and move right}
+@d put_rule=137 {typeset a rule}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right4=146 {move right}
+@d down4=160 {move down}
+@d z0=166 {move down |z|}
+@d z4=170 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+
+@ The preamble contains basic information about the file as a whole. As
+stated above, there are six parameters:
+$$\hbox{|@!i[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
+The |i| byte identifies \.{DVI} format; currently this byte is always set
+to~2. (The value |i=3| is currently used for an extended format that
+allows a mixture of right-to-left and left-to-right typesetting.
+Some day we will set |i=4|, when \.{DVI} format makes another
+incompatible change---perhaps in the year 2048.)
+
+The next two parameters, |num| and |den|, are positive integers that define
+the units of measurement; they are the numerator and denominator of a
+fraction by which all dimensions in the \.{DVI} file could be multiplied
+in order to get lengths in units of $10^{-7}$ meters. (For example, there are
+exactly 7227 \TeX\ points in 254 centimeters, and \TeX82 works with scaled
+points where there are $2^{16}$ sp in a point, so \TeX82 sets |num=25400000|
+and $|den|=7227\cdot2^{16}=473628672$.)
+@^sp@>
+
+The |mag| parameter is what \TeX82 calls \.{\\mag}, i.e., 1000 times the
+desired magnification. The actual fraction by which dimensions are
+multiplied is therefore $|mag|\cdot|num|/1000|den|$. Note that if a \TeX\
+source document does not call for any `\.{true}' dimensions, and if you
+change it only by specifying a different \.{\\mag} setting, the \.{DVI}
+file that \TeX\ creates will be completely unchanged except for the value
+of |mag| in the preamble and postamble. (Fancy \.{DVI}-reading programs allow
+users to override the |mag|~setting when a \.{DVI} file is being printed.)
+
+Finally, |k| and |x| allow the \.{DVI} writer to include a comment, which is not
+interpreted further. The length of comment |x| is |k|, where |0<=k<256|.
+
+@d dvi_id_byte=2 {identifies the kind of \.{DVI} files described here}
+
+@ Font definitions for a given font number |k| contain further parameters
+$$\hbox{|c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.}$$
+The four-byte value |c| is the check sum that \TeX\ (or whatever program
+generated the \.{DVI} file) found in the \.{TFM} file for this font;
+|c| should match the check sum of the font found by programs that read
+this \.{DVI} file.
+@^check sum@>
+
+Parameter |s| contains a fixed-point scale factor that is applied to the
+character widths in font |k|; font dimensions in \.{TFM} files and other
+font files are relative to this quantity, which is always positive and
+less than $2^{27}$. It is given in the same units as the other dimensions
+of the \.{DVI} file. Parameter |d| is similar to |s|; it is the ``design
+size,'' and (like~|s|) it is given in \.{DVI} units. Thus, font |k| is to be
+used at $|mag|\cdot s/1000d$ times its normal size.
+
+The remaining part of a font definition gives the external name of the font,
+which is an ASCII string of length |a+l|. The number |a| is the length
+of the ``area'' or directory, and |l| is the length of the font name itself;
+the standard local system font area is supposed to be used when |a=0|.
+The |n| field contains the area in its first |a| bytes.
+
+Font definitions must appear before the first use of a particular font number.
+Once font |k| is defined, it must not be defined again; however, we
+shall see below that font definitions appear in the postamble as well as
+in the pages, so in this sense each font number is defined exactly twice,
+if at all. Like |nop| commands, font definitions can
+appear before the first |bop|, or between an |eop| and a |bop|.
+
+@ The last page in a \.{DVI} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \TeX\ has
+accumulated about the file, making it possible to print subsets of the data
+with reasonable efficiency. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |num[4]| |den[4]| |mag[4]| |l[4]| |u[4]| |s[2]| |t[2]|\cr
+ $\langle\,$font definitions$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the final |bop| in the file. The next three
+parameters, |num|, |den|, and |mag|, are duplicates of the quantities that
+appeared in the preamble.
+
+Parameters |l| and |u| give respectively the height-plus-depth of the tallest
+page and the width of the widest page, in the same units as other dimensions
+of the file. These numbers might be used by a \.{DVI}-reading program to
+position individual ``pages'' on large sheets of film or paper; however,
+the standard convention for output on normal size paper is to position each
+page so that the upper left-hand corner is exactly one inch from the left
+and the top. Experience has shown that it is unwise to design \.{DVI}-to-printer
+software that attempts cleverly to center the output; a fixed position of
+the upper left corner is easiest for users to understand and to work with.
+Therefore |l| and~|u| are often ignored.
+
+Parameter |s| is the maximum stack depth (i.e., the largest excess of
+|push| commands over |pop| commands) needed to process this file. Then
+comes |t|, the total number of pages (|bop| commands) present.
+
+The postamble continues with font definitions, which are any number of
+\\{fnt\_def} commands as described above, possibly interspersed with |nop|
+commands. Each font number that is used in the \.{DVI} file must be defined
+exactly twice: Once before it is first selected by a \\{fnt} command, and once
+in the postamble.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the font definitions, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~2, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \TeX\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{DVI} file makes it feasible for
+\.{DVI}-reading programs to find the postamble first, on most computers,
+even though \TeX\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{DVI} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{DVI} reader can discover all the information needed for typesetting the
+pages. Note that it is also possible to skip through the \.{DVI} file at
+reasonably high speed to locate a particular page, if that proves
+desirable. This saves a lot of time, since \.{DVI} files used in production
+jobs tend to be large.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{DVI}
+format has been designed to work most efficiently with modern operating systems.
+
+@* Generic font file format.
+The ``generic font'' (\.{GF}) input files that \.{GFtoDVI} must deal with
+have a structure that was inspired by \.{DVI} format, although the
+operation codes are quite different in most cases. The term {\sl
+generic\/} indicates that this file format doesn't match the conventions
+of any name-brand manufacturer; but it is easy to convert \.{GF} files to
+the special format required by almost all digital phototypesetting
+equipment. There's a strong analogy between the \.{DVI} files written by
+\TeX\ and the \.{GF} files written by \MF; and, in fact, the reader will
+notice that many of the paragraphs below are identical to their
+counterparts in the description of \.{DVI} already given. The following
+description has been lifted almost verbatim from the program for \MF.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`|boc|' (beginning of character) command has six parameters, each of
+which is four bytes long. Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{DVI} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a |boc| command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an |eoc| command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each |eoc| command is immediately followed by a
+|boc| command, or by a |post| command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+@ The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~|m|; and (b)~the current row number,~|n|. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to get extremely large, but the \.{GF} format tries to be more general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising the
+region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
+coordinates |(x,y)| satisfy |m<=x<=m+1| and |n<=y<=n+1|. Negative values of
+|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of |n| and~|y| correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides |m| and |n|, there's also a third aspect of the current
+state, namely the @!|paint_switch|, which is always either \\{black} or
+\\{white}. Each \\{paint} command advances |m| by a specified amount~|d|,
+and blackens the intervening pixels if |paint_switch=black|; then
+the |paint_switch| changes to the opposite state. \.{GF}'s commands are
+designed so that |m| will never decrease within a row, and |n| will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened.
+
+@ Here is a list of all the commands that may appear in a \.{GF} file. Each
+command is specified by its symbolic name (e.g., |boc|), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|d[2]|' means that parameter |d| is two bytes long.
+
+\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
+nothing but change the |paint_switch| from \\{black} to \\{white} or vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with |d=1| to~63, defined as follows: If
+|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
+in columns |m| through |m+d-1| inclusive. Then, in any case,
+complement the |paint_switch| and advance |m| by~|d|.
+
+\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
+value of~|d|; \MF\ uses it to paint when |64<=d<256|.
+
+\yskip\hang|paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
+as~65535.
+
+\yskip\hang|paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
+|max_n[4]|. Beginning of a character: Here |c| is the character code, and
+|p| points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer |p| is |-1| if there was no
+prior character with an equivalent code.) The values of registers |m| and |n|
+defined by the instructions that follow for this character must
+satisfy |min_m<=m<=max_m| and |min_n<=n<=max_n|. (The values of |max_m| and
+|min_n| need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
+initialize the bounds of an array. Then it sets |m:=min_m|, |n:=max_n|, and
+|paint_switch:=white|.
+
+\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
+Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
+and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)
+
+\yskip\hang|eoc| 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have |eoc| immediately following |boc|.
+
+\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=white|. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m:=min_m|, and set
+|paint_switch:=white|. This is a way to produce |d| all-white rows.
+
+\yskip\hang|skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
+as 65535.
+
+\yskip\hang|skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=black|. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
+|new_row_0|, but with |m:=min_m+1| through |min_m+164|, respectively.
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear within characters,
+in \.{GF} files generated by other
+processors. It is recommended that |x| be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang|xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang|xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
+ridiculously large; |k| mustn't be negative.
+
+\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
+it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang|no_op| 244. No operation, do nothing. Any number of |no_op|'s
+may occur between \.{GF} commands, but a |no_op| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
+This command will appear only in the postamble, which will be explained shortly.
+
+\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
+Same as |char_loc|, except that |dy| is assumed to be zero, and the value
+of~|dx| is taken to be |65536*dm|, where |0<=dm<256|.
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter |i| is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first |boc|.)
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}
+
+@ Here are the opcodes that \.{GFtoDVI} actually refers to.
+
+@d paint_0=0 {beginning of the \\{paint} commands}
+@d paint1=64 {move right a given number of columns, then
+ black${}\swap{}$white}
+@d paint2=65 {ditto, with potentially larger number of columns}
+@d paint3=66 {ditto, with potentially excessive number of columns}
+@d boc=67 {beginning of a character}
+@d boc1=68 {abbreviated |boc|}
+@d eoc=69 {end of a character}
+@d skip0=70 {skip no blank rows}
+@d skip1=71 {skip over blank rows}
+@d skip2=72 {skip over lots of blank rows}
+@d skip3=73 {skip over a huge number of blank rows}
+@d new_row_0=74 {move down one row and then right}
+@d xxx1=239 {for \&{special} strings}
+@d xxx2=240 {for somewhat long \&{special} strings}
+@d xxx3=241 {for extremely long \&{special} strings}
+@d xxx4=242 {for incredibly long \&{special} strings}
+@d yyy=243 {for \&{numspecial} numbers}
+@d no_op=244 {no operation}
+
+@ The last character in a \.{GF} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
+ |@!min_m[4]| |@!max_m[4]| |@!min_n[4]| |@!max_n[4]|\cr
+ $\langle\,$character locators$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the byte following the final |eoc| in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The |ds| and |cs| parameters
+@^design size@> @^check sum@>
+give the design size and check sum, respectively, of the font (see the
+description of \.{TFM} format below).
+Parameters |hppp| and |vppp| are the ratios of
+pixels per point, horizontally and vertically, expressed as |scaled| integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
+registers |m| and~|n| assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; |max_m| and |min_n| may, on the
+other hand, be tighter than the similar bounds in |boc| commands. For
+example, some character may have |min_n=-100| in its |boc|, but it might
+turn out that |n| never gets lower than |-50| in any character; then
+|min_n| can have any value |<=-50|. If there are no characters in the file,
+it's possible to have |min_m>max_m| and/or |min_n>max_n|.)
+
+@ Character locators are introduced by |char_loc| commands,
+which specify a character residue~|c|, character escapements (|dx,dy|),
+a character width~|w|, and a pointer~|p|
+to the beginning of that character. (If two or more characters have the
+same code~|c| modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+The character escapements (|dx,dy|) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of |scaled| pixels;
+i.e., |dx| is in horizontal pixel units times $2^{16}$, and |dy| is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, |dy|
+should be zero, but other document file formats allow nonzero vertical
+escapement.
+
+The character width~|w| duplicates the information in the \.{TFM} file; it
+is $2^{24}$ times the ratio of the true width to the font's design size.
+
+The backpointer |p| points to the character's |boc|, or to the first of
+a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
+immediately precede the |boc|, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about |p| applies also to the backpointers
+in |boc| commands, even though it wasn't explained in the description
+of~|boc|. @^backpointers@>
+
+Pointer |p| might be |-1| if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had |proofing<0| when the character was being shipped out,
+but then made |proofing>=0| in order to get a \.{GF} file.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the character locators, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~131, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating systems.
+But if \.{GF} files have to be processed under the restrictions of standard
+\PASCAL, one can simply read them from front to back. This will
+be adequate for most applications. However, the postamble-first approach
+would facilitate a program that merges two \.{GF} files, replacing data
+from one that is overridden by corresponding data in the other.
+
+@* Extensions to the generic format.
+The \\{xxx} and \\{yyy} instructions understood by \.{GFtoDVI} will be
+listed now, so that we have a convenient reference to all of the special
+assumptions made later.
+
+Each special instruction begins with an \\{xxx} command, which consists of
+either a keyword by itself, or a keyword followed by a space followed
+by arguments. This \\{xxx} command may then be followed by \\{yyy}
+commands that are understood to be arguments.
+
+The keywords of special instructions that are intended to be used at
+many different sites should be published as widely as possible in order
+to minimize conflicts. The first person to establish a keyword presumably
+has a right to define it; \.{GFtoDVI}, as the first program
+to use extended \.{GF} commands, has the opportunity of choosing any
+keywords it likes, and the responsibility of choosing reasonable ones.
+Since labels are expected to account for the bulk of extended commands
+in typical uses of \MF, the ``null'' keyword has been set aside to
+denote a labeling command.
+
+@ Here then are the special commands of \.{GFtoDVI}.
+
+\def\string{$\langle\,$string$\,\rangle$}
+\def\okpagebreak{\vfil\penalty-100\vfilneg}
+\smallskip\hang\noindent
+\.{\SP n}\string\ $x$ $y$. Here \.n denotes the type of label; the
+characters \.1, \.2, \.3,~\.4 respectively denote labels forced to be
+at the top, left, right, or bottom of their dot, and the characters
+\.5, \.6, \.7,~\.8 stand for the same possibilities but with no dot printed.
+The character \.0 instructs \.{GFtoDVI} to choose one of the first four
+possibilities, if there's no overlap with other labels or dots, otherwise
+an ``overflow'' entry is placed at the right of the figure. The character
+\./ is the same as \.0 except that overflow entries are not produced. The
+label itself is the \string\ that follows. \MF\ coordinates of the
+point that is to receive this label are given by arguments $x$ and~$y$,
+in units of scaled pixels. (These arguments appear in \\{yyy} commands.)
+(Precise definitions of the size and positioning of labels, and of the
+notion of ``conflicting'' labels, will be given later.)
+
+\smallskip\hang\noindent
+\.{rule} $x_1$ $y_1$ $x_2$ $y_2$. This command draws a line from
+$(x_1,y_1)$ to $(x_2,y_2)$ in \MF\ coordinates. The present implementation
+does this only if the line is either horizontal or vertical, or if its
+slope matches the slope of the slant font.
+
+\smallskip\hang\noindent
+\.{title\SP}\string. This command (which is output by \MF\
+when it sees a ``title statement'') specifies a string that will appear
+at the top of the next proofsheet to be output by \.{GFtoDVI}.
+If more than one title is given, they will appear in sequence; titles
+should be short enough to fit on a single line.
+
+\smallskip\hang\noindent
+\.{titlefont\SP}\string. This command, and the other font-naming
+commands below, must precede the first |boc| in the \.{GF} file.
+It overrides the current font used to
+typeset the titles at the top of proofsheets. \.{GFtoDVI} has default
+fonts that will be used if none other are specified; the ``current'' title
+font is initially the default title font.
+
+\smallskip\hang\noindent
+\.{titlefontarea\SP}\string. This command overrides the current
+file area (or directory name) from which \.{GFtoDVI} will try to
+find metric information for the title font.
+
+\smallskip\hang\noindent
+\.{titlefontat} $s$. This command overrides the current ``at size'' that
+will be used for the title font. (See the discussion of font metric files
+below, for the meaning of ``at size'' versus ``design size.'') The
+value of~$s$ is given in units of scaled points.
+
+\okpagebreak
+\smallskip\hang\noindent
+\.{labelfont\SP}\string. This command overrides the current font
+used to typeset the labels that are superimposed on proof figures.
+(The label font is fairly arbitrary, but it should be dark enough to
+stand out when superimposed on gray pixels, and it should contain at
+least the decimal digits and the characters `\.(', `\.)', `\.=', `\.+',
+`\.-', `\.,', and `\..'.)
+
+\smallskip\hang\noindent
+\.{labelfontarea\SP}\string. This command overrides the current
+file area (or directory name) from which \.{GFtoDVI} will try to
+find metric information for the label font.
+
+\smallskip\hang\noindent
+\.{labelfontat} $s$. This command overrides the current ``at size'' that
+will be used for the label font.
+
+\okpagebreak
+\smallskip\hang\noindent
+\.{grayfont\SP}\string. This command overrides the current font
+used to typeset the black pixels and the dots for labels. (Gray fonts
+will be explained in detail later.)
+@^gray fonts@>
+
+\smallskip\hang\noindent
+\.{grayfontarea\SP}\string. This command overrides the current
+file area (or directory name) from which \.{GFtoDVI} will try to
+find metric information for the gray font.
+
+\smallskip\hang\noindent
+\.{grayfontat} $s$. This command overrides the current ``at size'' that
+will be used for the gray font.
+
+\okpagebreak
+\smallskip\hang\noindent
+\.{slantfont\SP}\string. This command overrides the current font
+used to typeset rules that are neither horizontal nor vertical. (Slant
+fonts will be explained in detail later.)
+@^slant fonts@>
+
+\smallskip\hang\noindent
+\.{slantfontarea\SP}\string. This command overrides the current
+file area (or directory name) from which \.{GFtoDVI} will try to
+find metric information for the slant font.
+
+\smallskip\hang\noindent
+\.{slantfontat} $s$. This command overrides the current ``at size'' that
+will be used for the slant font.
+
+\okpagebreak
+\smallskip\hang\noindent
+\.{rulethickness} $t$. This command overrides the current value used
+for the thickness of rules. If the current value is negative, no rule
+will be drawn; if the current value is zero, the rule thickness will
+be specified by a parameter of the gray font. Each \.{rule} command
+uses the rule thickness that is current at the time the command appears;
+hence it is possible to get different thicknesses of rules on the same
+figure. The value of $t$ is given in units of scaled points (\TeX's `\.{sp}').
+At the beginning of each character the current rule thickness is zero.
+
+\smallskip\hang\noindent
+\.{offset} $x$ $y$. This command overrides the current offset values
+that are added to all coordinates of a character being output; $x$ and
+$y$ are given as scaled \MF\ coordinates. This simply has the effect
+of repositioning the figures on the pages; the title line always appears
+in the same place, but the figure can be moved up, down, left, or right.
+At the beginning of each character the current offsets are zero.
+
+\smallskip\hang\noindent
+\.{xoffset} $x$. This command is output by \MF\ just before shipping out
+a character whose $x$~offset is nonzero. \.{GFtoDVI} adds the specified
+amount to the $x$ coordinates of all dots, labels, and rules
+in the following character.
+
+\smallskip\hang\noindent
+\.{yoffset} $y$. This command is output by \MF\ just before shipping out
+a character whose $y$~offset is nonzero. \.{GFtoDVI} adds the specified
+amount to the $y$ coordinates of all dots, labels, and rules
+in the following character.
+
+@* Font metric data.
+Before we can get into the meaty details of \.{GFtoDVI}, we need to
+deal with yet another esoteric binary file format, since \.{GFtoDVI}
+also does elementary typesetting operations. Therefore it has to
+read important information about the fonts it will be using.
+The following material (again copied almost verbatim from \TeX)
+describes the contents of so-called \TeX\ font metric (\.{TFM}) files.
+
+The idea behind \.{TFM} files is that typesetting routines
+need a compact way to store the relevant information about
+fonts, and computer centers need a compact way to store the
+relevant information about several hundred fonts. \.{TFM} files are
+compact, and most of the information they contain is highly relevant,
+so they provide a solution to the problem. \.{GFtoDVI} uses only
+four fonts, but interesting changes in its output will occur when
+those fonts are varied.
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of 4, we could
+also regard the file as a sequence of 32-bit words; but \TeX\ uses the
+byte interpretation, and so does \.{GFtoDVI}. The individual bytes
+are considered to be unsigned numbers.
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|@!lf|&length of the entire file, in words;\cr
+|@!lh|&length of the header data, in words;\cr
+|@!bc|&smallest character code in the font;\cr
+|@!ec|&largest character code in the font;\cr
+|@!nw|&number of words in the width table;\cr
+|@!nh|&number of words in the height table;\cr
+|@!nd|&number of words in the depth table;\cr
+|@!ni|&number of words in the italic correction table;\cr
+|@!nl|&number of words in the lig/kern table;\cr
+|@!nk|&number of words in the kern table;\cr
+|@!ne|&number of words in the extensible character table;\cr
+|@!np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|). When two or more 8-bit bytes are
+combined to form an integer of 16 or more bits, the bytes appear in
+BigEndian order.
+@^BigEndian order@>
+
+@<Glob...@>=
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np:0..@'77777;
+ {subfile sizes}
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
+header&|[0..lh-1]@t\\{stuff}@>|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but two of
+the |fix_word| values must lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+and for \.{TFM} files to be used with Xerox printing software it must
+contain at least 18 words, allocated as described below. When different
+kinds of devices need to be interfaced, it may be necessary to add further
+words to the header block.
+
+\yskip\hang|header[0]| is a 32-bit check sum that \.{GFtoDVI} will copy into the
+\.{DVI} output file whenever it uses the font. Later on when the \.{DVI}
+file is printed, possibly on another computer, the actual font that gets
+used is supposed to have a check sum that agrees with the one in the
+\.{TFM} file used by \.{GFtoDVI}. In this way, users will be warned about
+potential incompatibilities. (However, if the check sum is zero in either
+the font file or the \.{TFM} file, no check is made.) The actual relation
+between this check sum and the rest of the \.{TFM} file is not important;
+the check sum is simply an identification number with the property that
+incompatible fonts almost always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of the
+font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number
+must be at least 1.0; it is fairly arbitrary, but usually the design size
+is 10.0 for a ``10 point'' font, i.e., a font that was designed to look
+best at a 10-point size, whatever that really means. When a \TeX\ user
+asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the
+design size and replace it by $\delta$, and to multiply the $x$ and~$y$
+coordinates of the points in the font image by a factor of $\delta$
+divided by the design size. Similarly, specific sizes can be substituted
+for the design size by \.{GFtoDVI} commands like `\.{titlefontat}'. {\sl
+All other dimensions in the\/\ \.{TFM} file are |fix_word| numbers in
+design-size units.} Thus, for example, the value of |param[6]|, one \.{em}
+or \.{\\quad}, is often the |fix_word| value $2^{20}=1.0$, since many
+fonts have a design size equal to one em. The other dimensions must be
+less than 16 design-size units in absolute value; thus, |header[1]| and
+|param[1]| are the only |fix_word| entries in the whole \.{TFM} file whose
+first byte might be something besides 0 or 255. @^design size@>@^at size@>
+
+\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify
+the character coding scheme. The first byte, which must be between 0 and
+39, is the number of subsequent ASCII bytes actually relevant in this
+string, which is intended to specify what character-code-to-symbol
+convention is present in the font. Examples are \.{ASCII} for standard
+ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math
+extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for
+special-purpose non-alphabetic fonts, \.{GFGRAY} for \.{GFtoDVI}'s
+gray fonts, \.{GFSLANT} for \.{GFtoDVI}'s slant fonts, \.{UNSPECIFIED} for
+the default case when there is no information. Parentheses should not
+appear in this name. (Such a string is said to be in {\mc BCPL} format.)
+@^coding scheme@>@^gray fonts@>@^slant fonts@>
+
+\yskip\hang|header[12..@twhatever@>]| might also be present.
+
+@ Next comes the |char_info| array, which contains one |char_info_word|
+per character. Each |char_info_word| contains six fields packed into
+four bytes as follows.
+
+\yskip\hang first byte: |@!width_index| (8 bits)\par
+\hang second byte: |@!height_index| (4 bits) times 16, plus |@!depth_index|
+ (4~bits)\par
+\hang third byte: |@!italic_index| (6 bits) times 4, plus |@!tag|
+ (2~bits)\par
+\hang fourth byte: |@!remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is \\{width}|[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation $\\{width}[0]=\\{height}[0]=\\{depth}[0]=
+\\{italic}[0]=0$ should always hold, so that an index of zero implies a
+value of zero. The |width_index| should never be zero unless the
+character does not exist in the font, since a character is valid if and
+only if it lies between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at |lig_kern[remainder]|.\par
+\hang|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain. The
+|remainder| field gives the character code of the next larger character.\par
+\hang|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|@!exten[remainder]|.\par
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word in this array is a
+|@!lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+ step if the byte is 128 or more, otherwise the next step is obtained by
+ skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+ then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+ a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must have
+|256*op_byte+remainder<nl|. If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+or kerning command is performed.
+
+@d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@ Extensible characters are specified by an |@!extensible_recipe|, which
+consists of four bytes called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this
+order). These bytes are the character codes of individual pieces used to
+build up a large symbol. If |top|, |mid|, or |bot| are zero, they are not
+present in the built-up result. For example, an extensible vertical line is
+like an extensible bracket, except that the top and bottom pieces are missing.
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=@!slant| is the amount of italic slant.
+For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it's the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character |" "| in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the height of letters for which accents don't
+have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+When the character coding scheme is \.{GFGRAY} or \.{GFSLANT}, the font is
+supposed to contain an additional parameter called
+|default_rule_thickness|. Other special parameters go with other coding
+schemes.
+
+@* Input from binary files.
+We have seen that \.{GF} and \.{DVI} and \.{TFM} files are sequences of
+8-bit bytes. The bytes appear physically in what is called a `|packed
+file of 0..255|' in \PASCAL\ lingo.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{GFtoDVI} is written in standard \PASCAL.
+@^system dependencies@>
+
+One common way to solve the problem is to consider files of |integer|
+numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
+a sequence of four bytes $(a,b,c,d)$ using the following code, which
+avoids the controversial integer division of negative numbers:
+$$\vbox{\halign{#\hfil\cr
+|if x>=0 then a:=x div @'100000000|\cr
+|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
+\quad|end|;\cr
+|x:=x mod @'100000000;|\cr
+|b:=x div @'200000; x:=x mod @'200000;|\cr
+|c:=x div @'400; d:=x mod @'400;|\cr}}$$
+The four bytes are then kept in a buffer and output one by one. (On 36-bit
+computers, an additional division by 16 is necessary at the beginning.
+Another way to separate an integer into four bytes is to use/abuse
+\PASCAL's variant records, storing an integer and retrieving bytes that are
+packed in the same place; {\sl caveat implementor!\/}) It is also desirable
+in some cases to read a hundred or so integers at a time, maintaining a
+larger buffer.
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types ...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with three binary file variables: |gf_file| is the main
+input file that we are converting into a document; |dvi_file| is the main
+output file that will specify that document; and |tfm_file| is
+the current font metric file from which character-width information is
+being read.
+
+@<Glob...@>=
+@!gf_file:byte_file; {the character data we are reading}
+@!dvi_file:byte_file; {the typesetting instructions we are writing}
+@!tfm_file:byte_file; {a font metric file}
+
+@ To prepare these files for input or output, we |reset| or |rewrite|
+them. An extension of \PASCAL\ is needed, since we want to associate
+it with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|' and
+`|rewrite(f,s)|' do this, when |f| is a file variable and |s| is a string
+variable that specifies the file name.
+@^system dependencies@>
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file,name_of_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,name_of_file);
+end;
+@#
+procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
+begin rewrite(dvi_file,name_of_file);
+end;
+
+@ If you looked carefully at the preceding code, you probably asked,
+``What are |cur_loc| and |name_of_file|?'' Good question. They are global
+variables: The integer |cur_loc| tells which byte of the input file will
+be read next, and the string |name_of_file| will be set to the current
+file name before the file-opening procedures are called.
+
+@<Glob...@>=
+@!cur_loc:integer; {current byte number in |gf_file|}
+@!name_of_file:packed array[1..file_name_size] of char; {external file name}
+
+@ It turns out to be convenient to read four bytes at a time, when we are
+inputting from \.{TFM} files. The input goes into global variables
+|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3|
+the fourth.
+
+@<Glob...@>=
+@!b0,@!b1,@!b2,@!b3: eight_bits; {four bytes input at once}
+
+@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
+four bytes in the current \.{TFM} file.
+@^system dependencies@>
+
+@p procedure read_tfm_word;
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+end;
+
+@ We shall use another set of simple functions to read the next byte or
+bytes from |gf_file|. There are four possibilities, each of which is
+treated as a separate function in order to minimize the overhead for
+subroutine calls.
+@^system dependencies@>
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read(gf_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@* Reading the font information.
+Now let's get down to brass tacks and consider the more substantial
+routines that actually convert \.{TFM} data into a form suitable for
+computation. The routines in this part of the program have been borrowed
+from \TeX, with slight changes, since \.{GFtoDVI} has to do some of the
+things that \TeX\ does.
+
+The \.{TFM} data is stored in a large array called
+|font_info|. Each item of |font_info| is a |memory_word|; the |fix_word|
+data gets converted into |scaled| entries, while everything else goes into
+words of type |four_quarters|. (These data structures are special cases of
+the more general memory words of \TeX. On some machines it is necessary to
+define |min_quarterword=-128| and |max_quarterword=127| in order to pack
+four quarterwords into a single word.)
+@^system dependencies@>
+
+@d min_quarterword=0 {change this to allow efficient packing, if necessary}
+@d max_quarterword=255 {ditto}
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d title_font=1
+@d label_font=2
+@d gray_font=3
+@d slant_font=4
+@d logo_font=5
+@d non_char==qi(256)
+@d non_address==font_mem_size
+
+@<Types ...@>=
+@!font_index = 0..font_mem_size;
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case boolean of
+ true: (@!sc:scaled);
+ false: (@!qqqq:four_quarters);
+ end;
+@!internal_font_number=title_font..logo_font;
+
+@ Besides |font_info|, there are also a number of index arrays that point
+into it, so that we can locate width and height information, etc. For
+example, the |char_info| data for character |c| in font |f| will be in
+|font_info[char_base[f]+c].qqqq|; and if |w| is the |width_index| part of
+this word (the |b0| field), the width of the character is
+|font_info[width_base[f]+w].sc|. (These formulas assume that
+|min_quarterword| has already been added to |w|, but not to |c|.)
+
+@<Glob...@>=
+@!font_info:array[font_index] of memory_word; {the font metric data}
+@!fmem_ptr:font_index; {first unused word of |font_info|}
+@!font_check:array[internal_font_number] of four_quarters; {check sum}
+@!font_size:array[internal_font_number] of scaled; {``at'' size}
+@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
+@!font_bc:array[internal_font_number] of eight_bits;
+ {beginning (smallest) character code}
+@!font_ec:array[internal_font_number] of eight_bits;
+ {ending (largest) character code}
+@!char_base:array[internal_font_number] of integer;
+ {base addresses for |char_info|}
+@!width_base:array[internal_font_number] of integer;
+ {base addresses for widths}
+@!height_base:array[internal_font_number] of integer;
+ {base addresses for heights}
+@!depth_base:array[internal_font_number] of integer;
+ {base addresses for depths}
+@!italic_base:array[internal_font_number] of integer;
+ {base addresses for italic corrections}
+@!lig_kern_base:array[internal_font_number] of integer;
+ {base addresses for ligature/kerning programs}
+@!kern_base:array[internal_font_number] of integer;
+ {base addresses for kerns}
+@!exten_base:array[internal_font_number] of integer;
+ {base addresses for extensible recipes}
+@!param_base:array[internal_font_number] of integer;
+ {base addresses for font parameters}
+@!bchar_label:array[internal_font_number] of font_index;
+ {start of |lig_kern| program for left boundary character,
+ |non_address| if there is none}
+@!font_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {right boundary character, |non_char| if there is none}
+
+@ @<Set init...@>=
+fmem_ptr:=0;
+
+@ Of course we want to define macros that suppress the detail of how font
+information is actually packed, so that we don't have to write things like
+$$\hbox{|font_info[width_base[f]+font_info[char_base[f]+c].qqqq.b0].sc|}$$
+too often. The \.{WEB} definitions here make |char_info(f)(c)| the
+|four_quarters| word of font information corresponding to character
+|c| of font |f|. If |q| is such a word, |char_width(f)(q)| will be
+the character's width; hence the long formula above is at least
+abbreviated to
+$$\hbox{|char_width(f)(char_info(f)(c))|.}$$
+In practice we will try to fetch |q| first and look at several of its
+fields at the same time.
+
+The italic correction of a character will be denoted by
+|char_italic(f)(q)|, so it is analogous to |char_width|. But we will get
+at the height and depth in a slightly different way, since we usually want
+to compute both height and depth if we want either one. The value of
+|height_depth(q)| will be the 8-bit quantity
+$$b=|height_index|\times16+|depth_index|,$$ and if |b| is such a byte we
+will write |char_height(f)(b)| and |char_depth(f)(b)| for the height and
+depth of the character |c| for which |q=char_info(f)(c)|. Got that?
+
+The tag field will be called |char_tag(q)|; and the remainder byte will be
+called |rem_byte(q)|.
+
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_info[char_base[#]+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_info[width_base[#]+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 4].sc
+@d char_italic(#)==font_info[italic_base[#]+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 16].sc
+@d char_height(#)==font_info[height_base[#]+char_height_end
+@d char_depth_end(#)==# mod 16].sc
+@d char_depth(#)==font_info[depth_base[#]+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+@d skip_byte(#)==qo(#.b0)
+@d next_char(#)==#.b1
+@d op_byte(#)==qo(#.b2)
+@d rem_byte(#)==#.b3
+
+@ Here are some macros that help process ligatures and kerns.
+We write |char_kern(f)(j)| to find the amount of kerning specified by
+kerning command~|j| in font~|f|.
+
+@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program}
+@d lig_kern_restart_end(#)==256*(op_byte(#))+rem_byte(#)
+@d lig_kern_restart(#)==lig_kern_base[#]+lig_kern_restart_end
+@d char_kern_end(#)==256*(op_byte(#)-128)+rem_byte(#)].sc
+@d char_kern(#)==font_info[kern_base[#]+char_kern_end
+
+@ Font parameters are referred to as |slant(f)|, |space(f)|, etc.
+
+@d param_end(#)==param_base[#]].sc
+@d param(#)==font_info[#+param_end
+@d slant==param(1) {slant to the right, per unit distance upward}
+@d space==param(2) {normal space between words}
+@d x_height==param(5) {one ex}
+@d default_rule_thickness==param(8) {thickness of rules}
+
+@ Here is the subroutine that inputs the information on |tfm_file|, assuming
+that the file has just been reset. Parameter~|f| tells which metric file is
+being read (either |title_font| or |label_font| or |gray_font| or |slant_font|
+or |logo_font|); parameter~|s| is the ``at'' size, which will be
+substituted for the design size if it is positive.
+
+This routine does only limited checking of the validity of the file,
+because another program (\.{TFtoPL}) is available to diagnose errors in
+the rare case that something is amiss.
+
+@d bad_tfm=11 {label for |read_font_info|}
+@d abend==goto bad_tfm {do this when the \.{TFM} data is wrong}
+
+@p procedure read_font_info(@!f:integer;@!s:scaled); {input a \.{TFM} file}
+label done,bad_tfm;
+var k:font_index; {index into |font_info|}
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np:0..65535;
+ {sizes of subfiles}
+@!bch_label:integer; {left boundary label for ligatures}
+@!bchar:0..256; {right boundary character for ligatures}
+@!qw:four_quarters;@!sw:scaled; {accumulators}
+@!z:scaled; {the design size or the ``at'' size}
+@!alpha:integer;@!beta:1..16;
+ {auxiliary quantities used in fixed-point multiplication}
+begin @<Read and check the font data; |abend| if the \.{TFM} file is
+ malformed; otherwise |goto done|@>;
+bad_tfm: print_nl('Bad TFM file for');
+@.Bad TFM file...@>
+case f of
+title_font:abort('titles!');
+label_font:abort('labels!');
+gray_font:abort('pixels!');
+slant_font:abort('slants!');
+logo_font:abort('METAFONT logo!');
+end; {there are no other cases}
+done: {it might be good to close |tfm_file| now}
+end;
+
+@ @<Read and check...@>=
+@<Read the {\.{TFM}} size fields@>;
+@<Use size fields to allocate font information@>;
+@<Read the {\.{TFM}} header@>;
+@<Read character data@>;
+@<Read box dimensions@>;
+@<Read ligature/kern program@>;
+@<Read extensible character recipes@>;
+@<Read font parameters@>;
+@<Make final adjustments and |goto done|@>
+
+@ @d read_two_halves_end(#)==#:=b2*256+b3
+@d read_two_halves(#)==read_tfm_word; #:=b0*256+b1; read_two_halves_end
+
+@<Read the {\.{TFM}} size fields@>=
+begin read_two_halves(lf)(lh);
+read_two_halves(bc)(ec);
+if (bc>ec+1)or(ec>255) then abend;
+if bc>255 then {|bc=256| and |ec=255|}
+ begin bc:=1; ec:=0;
+ end;
+read_two_halves(nw)(nh);
+read_two_halves(nd)(ni);
+read_two_halves(nl)(nk);
+read_two_halves(ne)(np);
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abend;
+end
+
+@ The preliminary settings of the index variables |width_base|,
+|lig_kern_base|, |kern_base|, and |exten_base| will be corrected later by
+subtracting |min_quarterword| from them; and we will subtract 1 from
+|param_base| too. It's best to forget about such anomalies until later.
+
+@<Use size fields to allocate font information@>=
+lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
+if np<8 then lf:=lf+8-np; {at least eight parameters will appear}
+if fmem_ptr+lf>font_mem_size then abort('No room for TFM file!');
+@.No room for TFM file@>
+char_base[f]:=fmem_ptr-bc;
+width_base[f]:=char_base[f]+ec+1;
+height_base[f]:=width_base[f]+nw;
+depth_base[f]:=height_base[f]+nh;
+italic_base[f]:=depth_base[f]+nd;
+lig_kern_base[f]:=italic_base[f]+ni;
+kern_base[f]:=lig_kern_base[f]+nl;
+exten_base[f]:=kern_base[f]+nk;
+param_base[f]:=exten_base[f]+ne
+
+@ Only the first two words of the header are needed by \.{GFtoDVI}.
+
+@d store_four_quarters(#)==
+ begin read_tfm_word;
+ qw.b0:=qi(b0); qw.b1:=qi(b1); qw.b2:=qi(b2); qw.b3:=qi(b3);
+ #:=qw;
+ end
+
+@<Read the {\.{TFM}} header@>=
+begin if lh<2 then abend;
+store_four_quarters(font_check[f]);
+read_tfm_word;
+if b0>127 then abend; {design size must be positive}
+z:=((b0*256+b1)*256+b2)*16+(b3 div 16);
+if z<unity then abend;
+while lh>2 do
+ begin read_tfm_word; decr(lh); {ignore the rest of the header}
+ end;
+font_dsize[f]:=z;
+if s>0 then z:=s;
+font_size[f]:=z;
+end
+
+@ @<Read character data@>=
+for k:=fmem_ptr to width_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if (b0>=nw)or(b1 div @'20>=nh)or(b1 mod @'20>=nd)or
+ (b2 div 4>=ni) then abend;
+ case b2 mod 4 of
+ lig_tag: if b3>=nl then abend;
+ ext_tag: if b3>=ne then abend;
+ no_tag,list_tag: do_nothing;
+ end; {there are no other cases}
+ end
+
+@ A |fix_word| whose four bytes are $(b0,b1,b2,b3)$ from left to right
+represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b_1\cdot2^{-4}+b_2\cdot2^{-12}+b_3\cdot2^{-20}&b_0=0;\cr
+-16+b_1\cdot2^{-4}+b_2\cdot2^{-12}+b_3\cdot2^{-20}&b_0=255.\cr}}\right.$$
+(No other choices of |b0| are allowed, since the magnitude of a number in
+design-size units must be less than 16.) We want to multiply this
+quantity by the integer~|z|, which is known to be less than $2^{27}$. Let
+$\alpha=16z$. If $|z|<2^{23}$, the individual multiplications $b\cdot z$,
+$c\cdot z$, $d\cdot z$ cannot overflow; otherwise we will divide |z| by 2,
+4, 8, or 16, to obtain a multiplier less than $2^{23}$, and we can
+compensate for this later. If |z| has thereby been replaced by
+$|z|^\prime=|z|/2^e$, let $\beta=2^{4-e}$; we shall compute
+$$\lfloor(b_1+b_2\cdot2^{-8}+b_3\cdot2^{-16})\,z^\prime/\beta\rfloor$$
+if $a=0$, or the same quantity minus $\alpha$ if $a=255$.
+
+@d store_scaled(#)==begin read_tfm_word;
+ sw:=(((((b3*z)div@'400)+(b2*z))div@'400)+(b1*z))div beta;
+ if b0=0 then #:=sw@+else if b0=255 then #:=sw-alpha@+else abend;
+ end
+
+@<Read box dimensions@>=
+begin @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>;
+for k:=width_base[f] to lig_kern_base[f]-1 do
+ store_scaled(font_info[k].sc);
+if font_info[width_base[f]].sc<>0 then abend; {\\{width}[0] must be zero}
+if font_info[height_base[f]].sc<>0 then abend; {\\{height}[0] must be zero}
+if font_info[depth_base[f]].sc<>0 then abend; {\\{depth}[0] must be zero}
+if font_info[italic_base[f]].sc<>0 then abend; {\\{italic}[0] must be zero}
+end
+
+@ @<Replace |z|...@>=
+begin alpha:=16*z; beta:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; beta:=beta div 2;
+ end;
+end
+
+@ @d check_byte_range(#)==begin if (#<bc)or(#>ec) then abend@+end
+
+@<Read ligature/kern program@>=
+begin bch_label:=@'77777; bchar:=256;
+if nl>0 then
+ begin for k:=lig_kern_base[f] to kern_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if b0>stop_flag then
+ begin if 256*b2+b3>=nl then abend;
+ if b0=255 then if k=lig_kern_base[f] then bchar:=b1;
+ end
+ else begin if b1<>bchar then check_byte_range(b1);
+ if b2<kern_flag then check_byte_range(b3)
+ else if 256*(b2-128)+b3>=nk then abend;
+ end;
+ end;
+ if b0=255 then bch_label:=256*b2+b3;
+ end;
+for k:=kern_base[f] to exten_base[f]-1 do
+ store_scaled(font_info[k].sc);
+end
+
+@ @<Read extensible character recipes@>=
+for k:=exten_base[f] to param_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if b0<>0 then check_byte_range(b0);
+ if b1<>0 then check_byte_range(b1);
+ if b2<>0 then check_byte_range(b2);
+ check_byte_range(b3);
+ end
+
+@ @<Read font parameters@>=
+begin for k:=1 to np do
+ if k=1 then {the |slant| parameter is a pure number}
+ begin read_tfm_word;
+ if b0>127 then sw:=b0-256@+else sw:=b0;
+ sw:=sw*@'400+b1; sw:=sw*@'400+b2;
+ font_info[param_base[f]].sc:=(sw*@'20)+(b3 div@'20);
+ end
+ else store_scaled(font_info[param_base[f]+k-1].sc);
+for k:=np+1 to 8 do font_info[param_base[f]+k-1].sc:=0;
+end
+
+@ Now to wrap it up, we have checked all the necessary things about the \.{TFM}
+file, and all we need to do is put the finishing touches on the data for
+the new font.
+
+@d adjust(#)==#[f]:=qo(#[f])
+ {correct for the excess |min_quarterword| that was added}
+
+@<Make final adjustments...@>=
+font_bc[f]:=bc; font_ec[f]:=ec;
+if bch_label<nl then bchar_label[f]:=bch_label+lig_kern_base[f]
+else bchar_label[f]:=non_address;
+font_bchar[f]:=qi(bchar);
+adjust(width_base); adjust(lig_kern_base);
+adjust(kern_base); adjust(exten_base);
+decr(param_base[f]);
+fmem_ptr:=fmem_ptr+lf; goto done
+
+@* The string pool.
+\.{GFtoDVI} remembers strings by putting them into an array called
+|str_pool|. The |str_start| array tells where each string starts in the pool.
+
+@<Types ...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+
+@ As new strings enter, we keep track of the storage currently used, by
+means of two global variables called |pool_ptr| and |str_ptr|. These are
+periodically reset to their initial values when we move from one character
+to another, because most strings are of only temporary interest.
+
+@<Glob...@>=
+@!str_pool:packed array[pool_pointer] of ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@!pool_ptr : pool_pointer; {first unused position in |str_pool|}
+@!str_ptr : str_number; {start of the current string being created}
+@!init_str_ptr:str_number; {|str_ptr| setting when a new character starts}
+
+@ Several of the elementary string operations are performed using \.{WEB}
+macros instead of using \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a string.
+@.WEB@>
+
+@d length(#)==(str_start[#+1]-str_start[#]) {the number of characters
+ in string number \#}
+
+@ Strings are created by appending character codes to |str_pool|.
+The macro called |append_char|, defined here, does not check to see if the
+value of |pool_ptr| has gotten too high; that test is supposed to be
+made before |append_char| is used.
+
+To test if there is room to append |l| more characters to |str_pool|,
+we shall write |str_room(l)|, which aborts \.{GFtoDVI} and gives an
+apologetic error message if there isn't enough room.
+
+@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
+begin str_pool[pool_ptr]:=#; incr(pool_ptr);
+end
+@d str_room(#) == {make sure that the pool hasn't overflowed}
+ begin if pool_ptr+# > pool_size then
+ abort('Too many strings!');
+@.Too many strings@>
+ end
+
+@ Once a sequence of characters has been appended to |str_pool|, it
+officially becomes a string when the function |make_string| is called.
+This function returns the identification number of the new string as its
+value.
+
+@p function make_string : str_number; {current string enters the pool}
+begin if str_ptr=max_strings then
+ abort('Too many labels!');
+@.Too many labels@>
+incr(str_ptr); str_start[str_ptr]:=pool_ptr;
+make_string:=str_ptr-1;
+end;
+
+@ The first strings in the string pool are the keywords that \.{GFtoDVI}
+recognizes in the \\{xxx} commands of a \.{GF} file. They are entered
+into |str_pool| by means of a tedious bunch of assignment statements,
+together with calls on the |first_string| subroutine.
+
+@d init_str0(#)==first_string(#)
+@d init_str1(#)==buffer[1]:=#; init_str0
+@d init_str2(#)==buffer[2]:=#; init_str1
+@d init_str3(#)==buffer[3]:=#; init_str2
+@d init_str4(#)==buffer[4]:=#; init_str3
+@d init_str5(#)==buffer[5]:=#; init_str4
+@d init_str6(#)==buffer[6]:=#; init_str5
+@d init_str7(#)==buffer[7]:=#; init_str6
+@d init_str8(#)==buffer[8]:=#; init_str7
+@d init_str9(#)==buffer[9]:=#; init_str8
+@d init_str10(#)==buffer[10]:=#; init_str9
+@d init_str11(#)==buffer[11]:=#; init_str10
+@d init_str12(#)==buffer[12]:=#; init_str11
+@d init_str13(#)==buffer[13]:=#; init_str12
+@d longest_keyword=13
+
+@p procedure first_string(@!c:integer);
+begin if str_ptr<>c then abort('?'); {internal consistency check}
+@.?@>
+while l>0 do
+ begin append_char(buffer[l]); decr(l);
+ end;
+incr(str_ptr); str_start[str_ptr]:=pool_ptr;
+end;
+
+@ @<Glob...@>=
+@!l:integer; {length of string being made by |first_string|}
+
+@ Here are the tedious assignments just promised.
+String number 0 is the empty string.
+
+@d null_string=0 {the empty keyword}
+@d area_code=4 {add to font code for the `\.{area}' keywords}
+@d at_code=8 {add to font code for the `\.{at}' keywords}
+@d rule_code=13 {code for the keyword `\.{rule}'}
+@d title_code=14 {code for the keyword `\.{title}'}
+@d rule_thickness_code=15 {code for the keyword `\.{rulethickness}'}
+@d offset_code=16 {code for the keyword `\.{offset}'}
+@d x_offset_code=17 {code for the keyword `\.{xoffset}'}
+@d y_offset_code=18 {code for the keyword `\.{yoffset}'}
+@d max_keyword=18 {largest keyword code number}
+
+@<Initialize the strings@>=
+str_ptr:=0; pool_ptr:=0; str_start[0]:=0;@/
+l:=0; init_str0(null_string);@/
+l:=9; init_str9("t")("i")("t")("l")("e")("f")("o")("n")("t")(title_font);@/
+l:=9; init_str9("l")("a")("b")("e")("l")("f")("o")("n")("t")(label_font);@/
+l:=8; init_str8("g")("r")("a")("y")("f")("o")("n")("t")(gray_font);@/
+l:=9; init_str9("s")("l")("a")("n")("t")("f")("o")("n")("t")(slant_font);@/
+l:=13; init_str13("t")("i")("t")("l")("e")
+ ("f")("o")("n")("t")("a")("r")("e")("a")(title_font+area_code);@/
+l:=13; init_str13("l")("a")("b")("e")("l")
+ ("f")("o")("n")("t")("a")("r")("e")("a")(label_font+area_code);@/
+l:=12; init_str12("g")("r")("a")("y")
+ ("f")("o")("n")("t")("a")("r")("e")("a")(gray_font+area_code);@/
+l:=13; init_str13("s")("l")("a")("n")("t")
+ ("f")("o")("n")("t")("a")("r")("e")("a")(slant_font+area_code);@/
+l:=11; init_str11("t")("i")("t")("l")("e")
+ ("f")("o")("n")("t")("a")("t")(title_font+at_code);@/
+l:=11; init_str11("l")("a")("b")("e")("l")
+ ("f")("o")("n")("t")("a")("t")(label_font+at_code);@/
+l:=10; init_str10("g")("r")("a")("y")
+ ("f")("o")("n")("t")("a")("t")(gray_font+at_code);@/
+l:=11; init_str11("s")("l")("a")("n")("t")
+ ("f")("o")("n")("t")("a")("t")(slant_font+at_code);@/
+l:=4; init_str4("r")("u")("l")("e")(rule_code);@/
+l:=5; init_str5("t")("i")("t")("l")("e")(title_code);@/
+l:=13; init_str13("r")("u")("l")("e")
+ ("t")("h")("i")("c")("k")("n")("e")("s")("s")(rule_thickness_code);@/
+l:=6; init_str6("o")("f")("f")("s")("e")("t")(offset_code);@/
+l:=7; init_str7("x")("o")("f")("f")("s")("e")("t")(x_offset_code);@/
+l:=7; init_str7("y")("o")("f")("f")("s")("e")("t")(y_offset_code);@/
+
+@ We will also find it useful to have the following strings. (The names of
+default fonts will presumably be different at different sites.)
+@^system dependencies@>
+@^default fonts@>
+
+@d gf_ext=max_keyword+1 {string number for `\.{.gf}'}
+@d dvi_ext=max_keyword+2 {string number for `\.{.dvi}'}
+@d tfm_ext=max_keyword+3 {string number for `\.{.tfm}'}
+@d page_header=max_keyword+4 {string number for `\.{\ \ Page\ }'}
+@d char_header=max_keyword+5 {string number for `\.{\ \ Character\ }'}
+@d ext_header=max_keyword+6 {string number for `\.{\ \ Ext\ }'}
+@d left_quotes=max_keyword+7 {string number for `\.{\ \ ``}'}
+@d right_quotes=max_keyword+8 {string number for `\.{''}'}
+@d equals_sign=max_keyword+9 {string number for `\.{ = }'}
+@d plus_sign=max_keyword+10 {string number for `\.{ + (}'}
+@d default_title_font=max_keyword+11
+ {string number for the default |title_font|}
+@d default_label_font=max_keyword+12
+ {string number for the default |label_font|}
+@d default_gray_font=max_keyword+13 {string number for the default |gray_font|}
+@d logo_font_name=max_keyword+14 {string number for the font with \MF\ logo}
+@d small_logo=max_keyword+15 {string number for `\.{METAFONT}'}
+@d home_font_area=max_keyword+16 {string number for system-dependent font area}
+
+@<Initialize the strings@>=
+l:=3; init_str3(".")("g")("f")(gf_ext);@/
+l:=4; init_str4(".")("d")("v")("i")(dvi_ext);@/
+l:=4; init_str4(".")("t")("f")("m")(tfm_ext);@/
+l:=7; init_str7(" ")(" ")("P")("a")("g")("e")(" ")(page_header);@/
+l:=12; init_str12(" ")(" ")("C")("h")("a")("r")("a")("c")("t")("e")("r")(" ")
+ (char_header);@/
+l:=6; init_str6(" ")(" ")("E")("x")("t")(" ")(ext_header);@/
+l:=4; init_str4(" ")(" ")("`")("`")(left_quotes);@/
+l:=2; init_str2("'")("'")(right_quotes);@/
+l:=3; init_str3(" ")("=")(" ")(equals_sign);@/
+l:=4; init_str4(" ")("+")(" ")("(")(plus_sign);@/
+l:=4; init_str4("c")("m")("r")("8")(default_title_font);@/
+l:=6; init_str6("c")("m")("t")("t")("1")("0")(default_label_font);@/
+l:=4; init_str4("g")("r")("a")("y")(default_gray_font);@/
+l:=5; init_str5("l")("o")("g")("o")("8")(logo_font_name);@/
+l:=8; init_str8("M")("E")("T")("A")("F")("O")("N")("T")(small_logo);
+
+@ If an \\{xxx} command has just been encountered in the \.{GF} file,
+the following procedure interprets its keyword. More precisely, we assume
+that |cur_gf| contains an op-code byte just read from the \.{GF} file,
+where |xxx1<=cur_gf<=no_op|. The |interpret_xxx| procedure will read the
+rest of the command, in the following way:
+\smallskip
+\item{1)} If |cur_gf| is |no_op| or |yyy|, or if it's an \\{xxx} command with
+an unknown keyword, the bytes are simply read and ignored, and the
+value |no_operation| is returned.
+
+\item{2)} If |cur_gf| is an \\{xxx} command (either |xxx1| or $\cdots$
+or |xxx4|), and if the associated string matches a keyword exactly,
+the string number of that keyword is returned (e.g., |rule_thickness_code|).
+
+\item{3)} If |cur_gf| is an \\{xxx} command whose string begins with
+keyword and space, the string number of that keyword is returned, and
+the remainder of the string is put into the string pool (where it will be
+string number |cur_string|. Exception: If the keyword is |null_string|,
+the character immediately following the blank space is put into the
+global variable |label_type|, and the remaining characters go into the
+string pool.
+
+\smallskip\noindent
+In all cases, |cur_gf| will then be reset to the op-code byte that
+immediately follows the original command.
+
+@d no_operation=max_keyword+1
+
+@<Types ...@>=
+@!keyword_code=null_string..no_operation;
+
+@ @<Glob...@>=
+@!cur_gf:eight_bits; {the byte most recently read from |gf_file|}
+@!cur_string:str_number; {the string following a keyword and space}
+@!label_type:eight_bits; {the character following a null keyword and space}
+
+@ We will be using this procedure when reading the \.{GF} file just
+after the preamble and just after |eoc| commands.
+
+@p function interpret_xxx:keyword_code;
+label done,done1,not_found;
+var @!k:integer; {number of bytes in an \\{xxx} command}
+@!j:integer; {number of bytes read so far}
+@!l:0..longest_keyword; {length of keyword to check}
+@!m:keyword_code; {runs through the list of known keywords}
+@!n1:0..longest_keyword; {buffered character being checked}
+@!n2:pool_pointer; {pool character being checked}
+@!c:keyword_code; {the result to return}
+begin c:=no_operation; cur_string:=null_string;
+case cur_gf of
+no_op:goto done;
+yyy:begin k:=signed_quad; goto done;
+ end;
+xxx1:k:=get_byte;
+xxx2:k:=get_two_bytes;
+xxx3:k:=get_three_bytes;
+xxx4:k:=signed_quad;
+end; {there are no other cases}
+@<Read the next |k| characters of the \.{GF} file;
+ change |c| and |goto done| if a keyword is recognized@>;
+done: cur_gf:=get_byte; interpret_xxx:=c;
+end;
+
+@ @<Read the next |k|...@>=
+j:=0;@+if k<2 then goto not_found;
+loop@+ begin l:=j;
+ if j=k then goto done1;
+ if j=longest_keyword then goto not_found;
+ incr(j); buffer[j]:=get_byte;
+ if buffer[j]=" " then goto done1;
+ end;
+done1:@<If the keyword in |buffer[1..l]| is known, change |c| and |goto done|@>;
+not_found: while j<k do
+ begin incr(j); cur_gf:=get_byte;
+ end
+
+@ @<If the keyword...@>=
+for m:=null_string to max_keyword do if length(m)=l then
+ begin n1:=0; n2:=str_start[m];
+ while (n1<l)and(buffer[n1+1]=str_pool[n2]) do
+ begin incr(n1); incr(n2);
+ end;
+ if n1=l then
+ begin c:=m;
+ if m=null_string then
+ begin incr(j); label_type:=get_byte;
+ end;
+ str_room(k-j);
+ while j<k do
+ begin incr(j); append_char(get_byte);
+ end;
+ cur_string:=make_string; goto done;
+ end;
+ end
+
+@ When an \\{xxx} command takes a numeric argument, |get_yyy| reads
+that argument and puts the following byte into |cur_gf|.
+
+@p function get_yyy:scaled;
+var @!v:scaled; {value just read}
+begin if cur_gf<>yyy then get_yyy:=0
+else begin v:=signed_quad; cur_gf:=get_byte; get_yyy:=v;
+ end;
+end;
+
+@ A simpler method is used for special commands between |boc| and |eoc|,
+since \.{GFtoDVI} doesn't even look at them.
+
+@p procedure skip_nop;
+label done;
+var @!k:integer; {number of bytes in an \\{xxx} command}
+@!j:integer; {number of bytes read so far}
+begin case cur_gf of
+no_op:goto done;
+yyy:begin k:=signed_quad; goto done;
+ end;
+xxx1:k:=get_byte;
+xxx2:k:=get_two_bytes;
+xxx3:k:=get_three_bytes;
+xxx4:k:=signed_quad;
+end; {there are no other cases}
+for j:=1 to k do cur_gf:=get_byte;
+done: cur_gf:=get_byte;
+end;
+
+@* File names.
+It's time now to fret about file names. \.{GFtoDVI} uses the conventions of
+\TeX\ and \MF\ to convert file names into strings that can be used to open
+files. Three routines called |begin_name|, |more_name|, and |end_name| are
+involved, so that the system-dependent parts of file naming conventions are
+isolated from the system-independent ways in which file names are used.
+(See the \TeX\ or \MF\ program listing for further explanation.)
+@^system dependencies@>
+
+@<Glob...@>=
+@!cur_name:str_number; {name of file just scanned}
+@!cur_area:str_number; {file area just scanned, or |null_string|}
+@!cur_ext:str_number; {file extension just scanned, or |null_string|}
+
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters:
+
+@<Glob...@>=
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+
+@ Font metric files whose areas are not given
+explicitly are assumed to appear in a standard system area called
+|home_font_area|. This system area name will, of course, vary from place
+to place. The program here sets it to `\.{TeXfonts:}'.
+@^system dependencies@>
+@.TeXfonts@>
+
+@<Initialize the strings@>=
+l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/
+
+@ Here now is the first of the system-dependent routines for file name scanning.
+@^system dependencies@>
+
+@p procedure begin_name;
+begin area_delimiter:=0; ext_delimiter:=0;
+end;
+
+@ And here's the second.
+@^system dependencies@>
+
+@p function more_name(@!c:ASCII_code):boolean;
+begin if c=" " then more_name:=false
+else begin if (c=">")or(c=":") then
+ begin area_delimiter:=pool_ptr; ext_delimiter:=0;
+ end
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr;
+ str_room(1); append_char(c); {contribute |c| to the current string}
+ more_name:=true;
+ end;
+end;
+
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ abort('Too many strings!');
+@.Too many strings@>
+if area_delimiter=0 then cur_area:=null_string
+else begin cur_area:=str_ptr; incr(str_ptr);
+ str_start[str_ptr]:=area_delimiter+1;
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=null_string; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr; incr(str_ptr);
+ str_start[str_ptr]:=ext_delimiter; cur_ext:=make_string;
+ end;
+end;
+
+@ Another system-dependent routine is needed to convert three strings
+into the |name_of_file| value that is used to open files. The present code
+allows both lowercase and uppercase letters in the file name.
+@^system dependencies@>
+
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:integer; {index into |str_pool|}
+@!name_length:0..file_name_size; {number of characters packed}
+begin k:=0;
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(str_pool[j]);
+for j:=str_start[n] to str_start[n+1]-1 do append_to_name(str_pool[j]);
+for j:=str_start[e] to str_start[e+1]-1 do append_to_name(str_pool[j]);
+if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+end;
+
+@ Now let's consider the routines by which \.{GFtoDVI} deals with file names
+in a system-independent manner.
+The global variable |job_name| contains the \.{GF} file name that is
+being input. This name is extended by `\.{dvi}'
+in order to make the name of the output file.
+
+@<Glob...@>=
+@!job_name:str_number; {principal file name}
+
+@ The |start_gf| procedure prompts the user for the name of the generic
+font file to be input. It opens the file, making sure that some input is
+present; then it opens the output file.
+
+Although this routine is system-independent, it should probably be
+modified to take the file name from the command line (without an initial
+prompt), on systems that permit such things.
+
+@p procedure start_gf;
+label found,done;
+begin loop@+begin print_nl('GF file name: '); input_ln;
+@.GF file name@>
+ buf_ptr:=0; buffer[line_length]:="?";
+ while buffer[buf_ptr]=" " do incr(buf_ptr);
+ if buf_ptr<line_length then
+ begin @<Scan the file name in the buffer@>;
+ if cur_ext=null_string then cur_ext:=gf_ext;
+ pack_file_name(cur_name,cur_area,cur_ext); open_gf_file;
+ if not eof(gf_file) then goto found;
+ print_nl('Oops... I can''t find file '); print(name_of_file);
+@.Oops...@>
+@.I can't find...@>
+ end;
+ end;
+found:job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext);
+open_dvi_file;
+end;
+
+@ @<Scan the file name in the buffer@>=
+if buffer[line_length-1]="/" then
+ begin interaction:=true; decr(line_length);
+ end;
+begin_name;
+loop@+ begin if buf_ptr=line_length then goto done;
+ if not more_name(buffer[buf_ptr]) then goto done;
+ incr(buf_ptr);
+ end;
+done:end_name
+
+@ Special instructions found near the beginning of the \.{GF} file might
+change the names, areas, and ``at'' sizes of the fonts that \.{GFtoDVI}
+will be using. But when we reach the first |boc| instruction, we input
+all of the \.{TFM} files. The global variable |interaction| is set |true|
+if a |"/"| was removed at the end of the file name; this means that the
+user will have a chance to issue special instructions online just before
+the fonts are loaded.
+
+@d check_fonts==@+if fonts_not_loaded then load_fonts
+
+@<Glob...@>=
+@!interaction:boolean; {is the user allowed to type specials online?}
+@!fonts_not_loaded:boolean; {have the \.{TFM} files still not been input?}
+@!font_name:array[internal_font_number] of str_number; {current font names}
+@!font_area:array[internal_font_number] of str_number; {current font areas}
+@!font_at:array[internal_font_number] of scaled; {current font ``at'' sizes}
+
+@ @<Set init...@>=
+interaction:=false; fonts_not_loaded:=true;
+font_name[title_font]:=default_title_font;
+font_name[label_font]:=default_label_font;
+font_name[gray_font]:=default_gray_font;
+font_name[slant_font]:=null_string;
+font_name[logo_font]:=logo_font_name;
+for k:=title_font to logo_font do
+ begin font_area[k]:=null_string; font_at[k]:=0;
+ end;
+
+@ After the following procedure has been performed, there will be no
+turning back; the fonts will have been firmly established in
+\.{GFtoDVI}'s memory.
+
+@<Declare the procedure called |load_fonts|@>=
+procedure load_fonts;
+label done,continue,found,not_found;
+var @!f:internal_font_number;
+@!i:four_quarters; {font information word}
+@!j,@!k,@!v:integer; {registers for initializing font tables}
+@!m:title_font..slant_font+area_code; {keyword found}
+@!n1:0..longest_keyword; {buffered character being checked}
+@!n2:pool_pointer; {pool character being checked}
+begin if interaction then @<Get online special input@>;
+fonts_not_loaded:=false;
+for f:=title_font to logo_font do
+ if (f<>slant_font)or(length(font_name[f])>0) then
+ begin if length(font_area[f])=0 then font_area[f]:=home_font_area;
+ pack_file_name(font_name[f],font_area[f],tfm_ext);
+ open_tfm_file; read_font_info(f,font_at[f]);
+ if font_area[f]=home_font_area then font_area[f]:=null_string;
+ dvi_font_def(f); {put the font name in the \.{DVI} file}
+ end;
+@<Initialize global variables that depend on the font data@>;
+end;
+
+@ @<Get online special input@>=
+loop@+ begin not_found: print_nl('Special font substitution: ');
+@.Special font subst...@>
+ continue: input_ln;
+ if line_length=0 then goto done;
+ @<Search buffer for valid keyword; if successful, |goto found|@>;
+ print('Please say, e.g., "grayfont foo" or "slantfontarea baz".');
+ goto not_found;
+ found: @<Update the font name or area@>;
+ print('OK; any more? '); goto continue;
+ end;
+done:
+
+@ @<Search buffer for valid keyword; if successful, |goto found|@>=
+buf_ptr:=0; buffer[line_length]:=" ";
+while buffer[buf_ptr]<>" " do incr(buf_ptr);
+for m:=title_font to slant_font+area_code do if length(m)=buf_ptr then
+ begin n1:=0; n2:=str_start[m];
+ while (n1<buf_ptr)and(buffer[n1]=str_pool[n2]) do
+ begin incr(n1); incr(n2);
+ end;
+ if n1=buf_ptr then goto found;
+ end
+
+@ @<Update the font name or area@>=
+incr(buf_ptr); str_room(line_length-buf_ptr);
+while buf_ptr<line_length do
+ begin append_char(buffer[buf_ptr]); incr(buf_ptr);
+ end;
+if m>area_code then font_area[m-area_code]:=make_string
+else begin font_name[m]:=make_string; font_area[m]:=null_string;
+ font_at[m]:=0;
+ end;
+init_str_ptr:=str_ptr
+
+@* Shipping pages out.
+The following routines are used to write the \.{DVI} file. They have
+been copied from \TeX, but simplified; we don't have to handle
+nearly as much generality as \TeX\ does.
+
+Statistics about the entire set of pages that will be shipped out must be
+reported in the \.{DVI} postamble. The global variables |total_pages|,
+|max_v|, |max_h|, and |last_bop| are used to record this information.
+
+@<Glob...@>=
+@!total_pages:integer; {the number of pages that have been shipped out}
+@!max_v:scaled; {maximum height-plus-depth of pages shipped so far}
+@!max_h:scaled; {maximum width of pages shipped so far}
+@!last_bop:integer; {location of previous |bop| in the \.{DVI} output}
+
+@ @<Set init...@>=
+total_pages:=0; max_v:=0; max_h:=0; last_bop:=-1;
+
+@ The \.{DVI} bytes are output to a buffer instead of being written directly
+to the output file. This makes it possible to reduce the overhead of
+subroutine calls.
+
+The output buffer is divided into two parts of equal size; the bytes found
+in |dvi_buf[0..half_buf-1]| constitute the first half, and those in
+|dvi_buf[half_buf..dvi_buf_size-1]| constitute the second. The global
+variable |dvi_ptr| points to the position that will receive the next
+output byte. When |dvi_ptr| reaches |dvi_limit|, which is always equal
+to one of the two values |half_buf| or |dvi_buf_size|, the half buffer that
+is about to be invaded next is sent to the output and |dvi_limit| is
+changed to its other value. Thus, there is always at least a half buffer's
+worth of information present, except at the very beginning of the job.
+
+Bytes of the \.{DVI} file are numbered sequentially starting with 0;
+the next byte to be generated will be number |dvi_offset+dvi_ptr|.
+
+@<Types ...@>=
+@!dvi_index=0..dvi_buf_size; {an index into the output buffer}
+
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+
+@<Glob...@>=
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@!half_buf:dvi_index; {half of |dvi_buf_size|}
+@!dvi_limit:dvi_index; {end of the current half buffer}
+@!dvi_ptr:dvi_index; {the next available buffer address}
+@!dvi_offset:integer; {|dvi_buf_size| times the number of times the
+ output buffer has been fully emptied}
+
+@ Initially the buffer is all in one piece; we will output half of it only
+after it first fills up.
+
+@<Set init...@>=
+half_buf:=dvi_buf_size div 2; dvi_limit:=dvi_buf_size; dvi_ptr:=0;
+dvi_offset:=0;
+
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write_dvi(a,b)|. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_dvi(a,b)| is called; therefore it is possible on
+many machines to use efficient methods to pack four bytes per word and to
+output an array of words with one system call.
+@^system dependencies@>
+
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+
+@ To put a byte in the buffer without paying the cost of invoking a procedure
+each time, we use the macro |dvi_out|.
+
+@d dvi_out(#)==@+begin dvi_buf[dvi_ptr]:=#; incr(dvi_ptr);
+ if dvi_ptr=dvi_limit then dvi_swap;
+ end
+
+@p procedure dvi_swap; {outputs half of the buffer}
+begin if dvi_limit=dvi_buf_size then
+ begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
+ dvi_offset:=dvi_offset+dvi_buf_size; dvi_ptr:=0;
+ end
+else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
+ end;
+end;
+
+@ Here is how we clean out the buffer when \TeX\ is all through; |dvi_ptr|
+will be a multiple of~4.
+
+@<Empty the last bytes out of |dvi_buf|@>=
+if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
+if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
+
+@ The |dvi_four| procedure outputs four bytes in two's complement notation,
+without risking arithmetic overflow.
+
+@p procedure dvi_four(@!x:integer);
+begin if x>=0 then dvi_out(x div @'100000000)
+else begin x:=x+@'10000000000;
+ x:=x+@'10000000000;
+ dvi_out((x div @'100000000) + 128);
+ end;
+x:=x mod @'100000000; dvi_out(x div @'200000);
+x:=x mod @'200000; dvi_out(x div @'400);
+dvi_out(x mod @'400);
+end;
+
+@ Here's a procedure that outputs a font definition.
+
+@d select_font(#)==dvi_out(fnt_num_0+#) {set current font to \#}
+
+@p procedure dvi_font_def(@!f:internal_font_number);
+var k:integer; {index into |str_pool|}
+begin dvi_out(fnt_def1);
+dvi_out(f);@/
+dvi_out(qo(font_check[f].b0));
+dvi_out(qo(font_check[f].b1));
+dvi_out(qo(font_check[f].b2));
+dvi_out(qo(font_check[f].b3));@/
+dvi_four(font_size[f]);
+dvi_four(font_dsize[f]);@/
+dvi_out(length(font_area[f]));
+dvi_out(length(font_name[f]));
+@<Output the font name whose internal number is |f|@>;
+end;@/
+@t\4@>@<Declare the procedure called |load_fonts|@>@;
+
+@ @<Output the font name whose internal number is |f|@>=
+for k:=str_start[font_area[f]] to str_start[font_area[f]+1]-1 do
+ dvi_out(str_pool[k]);
+for k:=str_start[font_name[f]] to str_start[font_name[f]+1]-1 do
+ dvi_out(str_pool[k])
+
+@ The |typeset| subroutine typesets any eight-bit character.
+
+@p procedure typeset(@!c:eight_bits);
+begin if c>=128 then dvi_out(set1);
+dvi_out(c);
+end;
+
+@ The |dvi_scaled| subroutine takes a |real| value |x| and outputs
+a decimal approximation to |x/unity|, correct to one decimal place.
+
+@p procedure dvi_scaled(@!x:real);
+var @!n:integer; {an integer approximation to |10*x/unity|}
+@!m:integer; {the integer part of the answer}
+@!k:integer; {the number of digits in |m|}
+begin n:=round(x/6553.6);
+if n<0 then
+ begin dvi_out("-"); n:=-n;
+ end;
+m:=n div 10; k:=0;
+repeat incr(k); buffer[k]:=(m mod 10)+"0"; m:=m div 10;
+until m=0;
+repeat dvi_out(buffer[k]); decr(k);
+until k=0;
+if n mod 10 <> 0 then
+ begin dvi_out("."); dvi_out((n mod 10)+"0");
+ end;
+end;
+
+@ At the end of the program, we must finish things off by writing the
+post\-amble. An integer variable~|k| will be declared for use by this routine.
+
+@<Finish the \.{DVI} file and |goto final_end|@>=
+begin dvi_out(post); {beginning of the postamble}
+dvi_four(last_bop); last_bop:=dvi_offset+dvi_ptr-5; {|post| location}
+dvi_four(25400000); dvi_four(473628672); {conversion ratio for sp}
+dvi_four(1000); {magnification factor}
+dvi_four(max_v); dvi_four(max_h);@/
+dvi_out(0); dvi_out(3); {`\\{max\_push}' is said to be 3}@/
+dvi_out(total_pages div 256); dvi_out(total_pages mod 256);@/
+if not fonts_not_loaded then
+ for k:=title_font to logo_font do
+ if length(font_name[k])>0 then dvi_font_def(k);
+dvi_out(post_post); dvi_four(last_bop); dvi_out(dvi_id_byte);@/
+k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+while k>0 do
+ begin dvi_out(223); decr(k);
+ end;
+@<Empty the last bytes out of |dvi_buf|@>;
+goto final_end;
+end
+
+@* Rudimentary typesetting.
+One of \.{GFtoDVI}'s little duties is to be a mini-\TeX: It must be able
+to typeset the equivalent of `\.{\\hbox\{}$\langle$string$\rangle$\.\}' for
+a given string of ASCII characters, using either the title font or the
+label font.
+
+The |hbox| procedure does this. The width, height, and depth of the
+box defined by string~|s| in font~|f| are computed in global variables
+|box_width|, |box_height|, and |box_depth|.
+
+The task would be trivial if it weren't for ligatures and kerns, which
+are implemented here in full generality. (Infinite looping is possible
+if the \.{TFM} file is malformed; \.{TFtoPL} will diagnose such problems.)
+
+We assume that |" "| is a space character; character code @'40 will not
+be typeset unless it is accessed via a ligature.
+
+If parameter |send_it| is |false|, we merely want to know the box dimensions.
+Otherwise typesetting commands are also sent to
+the \.{DVI} file; we assume in this case that font |f| has already been
+selected in the \.{DVI} file as the current font.
+
+@d set_cur_r==if k<end_k then cur_r:=qi(str_pool[k])
+ else cur_r:=bchar
+
+@p procedure hbox(@!s:str_number;@!f:internal_font_number;@!send_it:boolean);
+label continue, done;
+var @!k,@!end_k,@!max_k:pool_pointer; {indices into |str_pool|}
+@!i,@!j:four_quarters; {font information words}
+@!cur_l:0..256; {character to the left of the ``cursor''}
+@!cur_r:min_quarterword..non_char; {character to the right of the ``cursor''}
+@!bchar:min_quarterword..non_char; {right boundary character}
+@!stack_ptr:0..lig_lookahead; {number of entries on |lig_stack|}
+@!l:font_index; {pointer to lig/kern instruction}
+@!kern_amount:scaled; {extra space to be typeset}
+@!hd:eight_bits; {height and depth indices for a character}
+@!x:scaled; {temporary register}
+@!save_c:ASCII_code; {character temporarily blanked out}
+begin box_width:=0; box_height:=0; box_depth:=0;@/
+k:=str_start[s]; max_k:=str_start[s+1];
+save_c:=str_pool[max_k]; str_pool[max_k]:=" ";
+while k<max_k do
+ begin if str_pool[k]=" " then @<Typeset a space in font |f| and advance~|k|@>
+ else begin end_k:=k;
+ repeat incr(end_k); until str_pool[end_k]=" ";
+ kern_amount:=0; cur_l:=256; stack_ptr:=0; bchar:=font_bchar[f];
+ set_cur_r; suppress_lig:=false;
+continue: @<If there's a ligature or kern at the cursor position,
+ update the cursor data structures, possibly advancing~|k|; continue
+ until the cursor wants to move right@>;
+ @<Typeset character |cur_l|, if it exists in the font;
+ also append an optional kern@>;
+ @<Move the cursor to the right and |goto continue|, if there's
+ more work to do in the current word@>;
+ end; {now |k=end_k|}
+ end;
+str_pool[max_k]:=save_c;
+end;
+
+@ @<Glob...@>=
+@!box_width:scaled; {width of box constructed by |hbox|}
+@!box_height:scaled; {height of box constructed by |hbox|}
+@!box_depth:scaled; {depth of box constructed by |hbox|}
+@!lig_stack:array[1..lig_lookahead] of quarterword; {inserted ligature chars}
+@!dummy_info:four_quarters; {fake |char_info| for nonexistent character}
+@!suppress_lig:boolean; {should we bypass checking for ligatures next time?}
+
+@ @<Set init...@>=
+dummy_info.b0:=qi(0); dummy_info.b1:=qi(0); dummy_info.b2:=qi(0);
+dummy_info.b3:=qi(0);
+
+@ @<Typeset a space...@>=
+begin box_width:=box_width+space(f);
+if send_it then
+ begin dvi_out(right4); dvi_four(space(f));
+ end;
+incr(k);
+end
+
+@ @<If there's a ligature...@>=
+if(cur_l<font_bc[f])or(cur_l>font_ec[f]) then
+ begin i:=dummy_info;
+ if cur_l=256 then l:=bchar_label[f]@+else l:=non_address;
+ end
+else begin i:=char_info(f)(cur_l);
+ if char_tag(i)<>lig_tag then l:=non_address
+ else begin l:=lig_kern_start(f)(i); j:=font_info[l].qqqq;
+ if skip_byte(j)>stop_flag then l:=lig_kern_restart(f)(j);
+ end;
+ end;
+if suppress_lig then suppress_lig:=false
+else while l<qi(kern_base[f]) do
+ begin j:=font_info[l].qqqq;
+ if next_char(j)=cur_r then if skip_byte(j)<=stop_flag then
+ if op_byte(j)>=kern_flag then
+ begin kern_amount:=char_kern(f)(j); goto done;
+ end
+ else @<Carry out a ligature operation, updating the cursor structure
+ and possibly advancing~|k|; |goto continue| if the cursor doesn't
+ advance, otherwise |goto done|@>;
+ if skip_byte(j)>=stop_flag then goto done;
+ l:=l+skip_byte(j)+1;
+ end;
+done:
+
+@ At this point |i| contains |char_info| for |cur_l|.
+
+@<Typeset character...@>=
+if char_exists(i) then
+ begin box_width:=box_width+char_width(f)(i)+kern_amount;@/
+ hd:=height_depth(i);
+ x:=char_height(f)(hd);
+ if x>box_height then box_height:=x;
+ x:=char_depth(f)(hd);
+ if x>box_depth then box_depth:=x;
+ if send_it then
+ begin typeset(cur_l);
+ if kern_amount<>0 then
+ begin dvi_out(right4); dvi_four(kern_amount);
+ end;
+ end;
+ kern_amount:=0;
+ end
+
+@ @d pop_stack==begin decr(stack_ptr);
+ if stack_ptr>0 then cur_r:=lig_stack[stack_ptr]
+ else set_cur_r;
+ end
+
+@<Carry out a ligature operation, updating the cursor structure...@>=
+begin case op_byte(j) of
+1,5:cur_l:=qo(rem_byte(j));
+2,6:begin cur_r:=rem_byte(j);
+ if stack_ptr=0 then
+ begin stack_ptr:=1;
+ if k<end_k then incr(k) {a non-space character is consumed}
+ else bchar:=non_char; {the right boundary character is consumed}
+ end;
+ lig_stack[stack_ptr]:=cur_r;
+ end;
+3,7,11:begin cur_r:=rem_byte(j); incr(stack_ptr); lig_stack[stack_ptr]:=cur_r;
+ if op_byte(j)=11 then suppress_lig:=true;
+ end;
+othercases begin cur_l:=qo(rem_byte(j));
+ if stack_ptr>0 then pop_stack
+ else if k=end_k then goto done
+ else begin incr(k); set_cur_r;
+ end;
+ end
+endcases;
+if op_byte(j)>3 then goto done;
+goto continue;
+end
+
+@ @<Move the cursor to the right and |goto continue|...@>=
+cur_l:=qo(cur_r);
+if stack_ptr>0 then
+ begin pop_stack; goto continue;
+ end;
+if k<end_k then
+ begin incr(k); set_cur_r; goto continue;
+ end
+
+@* Gray fonts.
+A proof diagram constructed by \.{GFtoDVI}
+can be regarded as an array of rectangles, where each rectangle is either
+blank or filled with a special symbol that we shall call $x$. A blank
+rectangle represents a white pixel, while $x$ represents a black pixel.
+Additional labels and reference lines are often superimposed on this
+array of rectangles; hence it is usually best to choose a symbol $x$ that
+has a somewhat gray appearance, although any symbol can actually be used.
+
+In order to construct such proofs, \.{GFtoDVI} needs to work with
+a special type of font known as a ``gray font''; it's possible to
+obtain a wide variety of different sorts of proofs by using different
+sorts of gray fonts. The next few paragraphs explain exactly what gray
+fonts are supposed to contain, in case you want to design your own.
+@^gray fonts@>
+
+@ The simplest gray font contains only two characters, namely $x$
+and another symbol that is used for dots that identify key points.
+If proofs with relatively large pixels are desired, a two-character
+gray font is all that's needed. However, if the pixel size is to be
+relatively small, practical considerations make a two-character
+font too inefficient, since it requires the typesetting of tens
+of thousands of tiny little characters; printing device drivers
+rarely work very well when they are presented with data that is
+so different from ordinary text. Therefore a gray font with small
+pixels usually has a number of characters that replicate $x$ in
+such a way that comparatively few characters actually need to be
+typeset.
+
+Since many printing devices are not able to cope with
+arbitrarily large or complex characters, it is not possible for a
+single gray font to work well on all machines. In fact,
+$x$ must have a width that is an integer multiple of the printing
+device's unit of horizontal position, since rounding the positions of grey
+characters would otherwise produce unsightly streaks on proof output.
+Thus, there is no way to make the gray font as device-independent as
+the rest of the system, in the sense that we would expect approximately
+identical output on machines with different resolution. Fortunately,
+proof sheets are rarely considered to be final documents; hence
+\.{GFtoDVI} is set up to provide results that adapt suitably to
+local conditions.
+
+@ With such constraints understood, we can now take a look at what
+\.{GFtoDVI} expects to see in a gray font. The character~$x$ always
+appears in position~1. It must have positive height~$h$ and positive
+width~$w$; its depth and italic correction are ignored.
+
+Positions 2--120 of a gray font are reserved for special combinations
+of $x$'s and blanks, stacked on top of each other. None of these character
+codes need be present in the font; but if they are, the slots should be
+occupied by characters of width~$w$ that have certain configurations of
+$x$'s and blanks, prescribed for each character position. For example,
+position~3 of the font should either contain no character at all,
+or it should contain a character consisting of two $x$'s, one above
+the other; one of these $x$'s should appear immediately above the
+baseline, and the other should appear immediately below.
+
+It will be convenient to use a horizontal notation like `\.{XOXXO}'
+to stand for a vertical stack of $x$'s and blanks. The convention
+will be that the stack is built from bottom to top, and the topmost
+rectangle should sit on the baseline. Thus, `\.{XOXXO}' stands
+actually for a character of depth~$4h$ that looks like this:
+$$\vcenter{\halign{\hfil#\hfil\cr
+blank\cr
+$x$\rlap{\qquad\raise8pt\hbox{\smash{\hbox{$\longleftarrow$ baseline}}}}\cr
+$x$\cr
+blank\cr
+$x$\cr
+}}$$
+(We use a horizontal notation instead of a vertical one in this explanation,
+because column
+vectors take too much space, and because the horizontal notation corresponds
+to binary numbers in a convenient way.)
+
+Positions 1--63 of a gray font are reserved for the patterns \.X, \.{XO},
+\.{XX}, \.{XOO}, \.{XOX}, \dots, \.{XXXXXX}, just as in the normal
+binary notation of the numbers 1--63. Positions 64--70 are reserved for
+the special patterns \.{XOOOOOO}, \.{XXOOOOO}, \dots, \.{XXXXXXO},
+\.{XXXXXXX} of length seven; positions 71--78 are, similarly, reserved for
+the length-eight patterns \.{XOOOOOOO} through \.{XXXXXXXX}. The
+length-nine patterns \.{XOOOOOOOO} through \.{XXXXXXXXX} are assigned
+to positions 79--87, the length-ten patterns to positions 88--97,
+the length-eleven patterns to positions 98--108, and the length-twelve
+patterns to positions 109--120.
+
+The following program sets a global array |c[1..120]| to the bit patterns
+just described. Another array |d[1..120]| is set to contain only the next
+higher bit; this determines the depth of the corresponding character.
+
+@<Set init...@>=
+c[1]:=1; d[1]:=2; two_to_the[0]:=1; m:=1;
+for k:=1 to 13 do two_to_the[k]:=2*two_to_the[k-1];
+for k:=2 to 6 do @<Add a full set of |k|-bit characters@>;
+for k:=7 to 12 do @<Add special |k|-bit characters of the form \.{X..XO..O}@>;
+
+@ @<Glob...@>=
+@!c:array[1..120] of 1..4095; {bit patterns for a gray font}
+@!d:array[1..120] of 2..4096; {the superleading bits}
+@!two_to_the:array[0..13] of 1..8192; {powers of 2}
+
+@ @<Add a full set of |k|-bit...@>=
+begin n:=two_to_the[k-1];
+for j:=0 to n-1 do
+ begin incr(m); c[m]:=m; d[m]:=n+n;
+ end;
+end
+
+@ @<Add special |k|-bit...@>=
+begin n:=two_to_the[k-1];
+for j:=k downto 1 do
+ begin incr(m); d[m]:=n+n;
+ if j=k then c[m]:=n
+ else c[m]:=c[m-1]+two_to_the[j-1];
+ end;
+end
+
+@ Position 0 of a gray font is reserved for the ``dot'' character, which
+should have positive height~$h'$ and positive width~$w'$. When \.{GFtoDVI}
+wants to put a dot at some place $(x,y)$ on the figure, it positions
+the dot character so that its reference point is at $(x,y)$. The
+dot will be considered to occupy a rectangle $(x+\delta,y+\epsilon)$
+for $-w'\leq\delta\leq w'$ and $-h'\leq\epsilon\leq h'$; the rectangular
+box for a label will butt up against the rectangle enclosing the dot.
+
+@ All other character positions of a gray font (namely, positions 121--255)
+are unreserved, in the sense that they have no predefined meaning.
+But \.{GFtoDVI} may access them via the ``character list'' feature of
+\.{TFM} files, starting with any of the characters in positions
+1--120. In such a case each succeeding character in a list should be
+equivalent to two of its predecessors, horizontally adjacent to each other.
+For example, in a character list like
+$$53,\;121,\;122,\;123$$
+character 121 will stand for two 53's, character 122 for two 121's (i.e.,
+four 53's), and character 123 for two 122's (i.e., eight 53's). Since
+position~53 contains the pattern \.{XXOXOX}, character~123 in this example
+would have height~$h$, depth~$5h$, and width~$8w$, and it would stand for
+the pattern
+$$\vcenter{\halign{&$\hfil#\hfil$\cr
+x&x&x&x&x&x&x&x\cr
+&&&&&&&\cr
+x&x&x&x&x&x&x&x\cr
+&&&&&&&\cr
+x&x&x&x&x&x&x&x\cr
+x&x&x&x&x&x&x&x\cr}}$$
+Such a pattern is, of course, rather unlikely to occur in a \.{GF} file,
+but \.{GFtoDVI} would be able to use if it were present. Designers
+of gray fonts should provide characters only for patterns that they think
+will occur often enough to make the doubling worthwhile. For example,
+the character in position 120 (\.{XXXXXXXXXXXX}), or whatever is the
+tallest stack of $x$'s present in the font, is a natural candidate for
+repeated doubling.
+
+Here's how \.{GFtoDVI} decides what characters of the gray font will be used,
+given a configuration of black and white pixels: If there are no black
+pixels, stop. Otherwise look at the top row that contains at least one
+black pixel, and the eleven rows that follow. For each such column,
+find the largest~$k$ such that $1\leq k\leq120$ and the gray font contains
+character~$k$ and the pattern assigned to position~$k$ appears in the
+given column. Typeset character $k$ (unless no such character exists)
+and erase the corresponding black pixels; use doubled characters,
+if they are present in the gray font, if two or more consecutive equal
+characters need to be typeset. Repeat the same process on the remaining
+configuration, until all the black pixels have been erased.
+
+If all characters in positions 1--120 are present, this process is guaranteed to
+take care of at least six rows each time; and it usually takes care of
+twelve, since all patterns that contain at most one ``run'' of $x$'s
+are present.
+
+@ Fonts have optional parameters, as described in Appendix~F of {\sl The
+\TeX book}, and some of these are important in gray fonts. The
+slant parameter~$s$, if nonzero, will cause \.{GFtoDVI} to skew its
+output; in this case the character $x$ will presumably be a parallelogram
+with a corresponding slant, rather than the usual rectangle. \MF's
+coordinate $(x,y)$ will appear in physical position $(xw+yhs,yh)$
+on the proofsheets.
+
+Parameter number~8 of a gray font specifies the thickness of rules
+that go on the proofs. If this parameter is zero, \TeX's default
+rule thickness (0.4\thinspace pt) will be used.
+
+The other parameters of a gray font are ignored by \.{GFtoDVI}, but
+it is conventional to set the font space parameter to~$w$ and the
+xheight parameter to~$h$.
+
+@ For best results the designer of a gray font should choose $h$ and~$w$
+so that the user's \.{DVI}-to-hardcopy software will not make any
+rounding errors. Furthermore, the dot should be an even number~$2m$ of
+pixels in diameter, and the rule thickness should work out to an
+even number~$2n$ of pixels; then the dots and rules will be centered on
+the correct positions, in case of integer coordinates. Gray fonts
+are almost always intended for particular output devices, even though
+`\.{DVI}' stands for `device independent'; we use \.{DVI} files for \MF\
+proofs chiefly because software to print \.{DVI} files is already in place.
+
+@* Slant fonts.
+\.{GFtoDVI} also makes use of another special type of font, if it is
+necessary to typeset slanted rules. The format of such so-called
+``slant fonts'' is quite a bit simpler than the format of gray fonts.
+
+A slant font should contain exactly $n$ characters, in positions 1 to~$n$,
+where the character in position~$k$ represents a slanted line $k$ units
+tall, starting at the baseline. These lines all have a fixed slant ratio~$s$.
+
+The following simple algorithm is used to typeset a rule that is $m$ units
+high: Compute $q=\lceil m/n\rceil$; then typeset $q$~characters of
+approximately equal size, namely $(m\bmod q)$ copies of character number
+$\lceil m/q\rceil$ and $q-(m\bmod q)$ copies of character number
+$\lfloor m/q\rfloor$. For example, if $n=15$ and $m=100$, we have $q=7$;
+a 100-unit-high rule will be composed of 7~pieces, using characters
+14,~14, 14, 14, 14, 15,~15.
+
+@<Glob...@>=
+@!rule_slant:real; {the slant ratio $s$ in the slant font,
+ or zero if there is no slant font}
+@!slant_n:integer; {the number of characters in the slant font}
+@!slant_unit:real; {the number of scaled points in the slant font unit}
+@!slant_reported:real; {invalid slant ratio reported to the user}
+
+@ \.{GFtoDVI} looks only at the height of character $n$, so the \.{TFM} file
+need not be accurate about the heights of the other characters. (This is
+fortunate, since \.{TFM} format allows at most 16 different heights per font.)
+
+The width of character~$k$ should be $k/n$ times $s$ times the height of
+character~$n$.
+
+The slant parameter of a slant file should be $s$. It is customary to
+set the |default_rule_thickness| parameter (number~8) to the thickness of
+the slanted rules, but \.{GFtoDVI} doesn't look at it.
+
+@ For best results on a particular output device, it is usually wise to
+choose the `unit' in the above discussion to be an integer number of pixels,
+and to make it no larger than the default rule thickness in the gray font
+being used.
+
+@ @<Initialize glob...@>=
+if length(font_name[slant_font])=0 then rule_slant:=0.0
+else begin rule_slant:=slant(slant_font)/unity;
+ slant_n:=font_ec[slant_font];
+ i:=char_info(slant_font)(slant_n);
+ slant_unit:=char_height(slant_font)(height_depth(i))/slant_n;
+ end;
+slant_reported:=0.0;
+
+@ The following error message is given when an absent slant has been
+requested.
+
+@p procedure slant_complaint(@!r:real);
+begin if abs(r-slant_reported)>0.001 then
+ begin print_nl('Sorry, I can''t make diagonal rules of slant ',r:10:5,'!');
+@.Sorry, I can't...@>
+ slant_reported:=r;
+ end;
+end;
+
+@* Representation of rectangles.
+OK---the preliminary spadework has now been done. We're ready at last
+to concentrate on \.{GFtoDVI}'s {\sl raison d'\^^Detre}.
+
+One of the most interesting tasks remaining is to make
+a ``map'' of the labels that have been allocated.
+There usually aren't a great many labels, so we don't need fancy data
+structures; but we do make use of linked nodes containing nine fields.
+The nodes generally represent rectangular boxes according to the
+following conventions:
+\smallskip\hang\noindent
+|xl|, |xr|, |yt|, and |yb| are the left, right, top, and bottom locations
+of a rectangle, expressed in \.{DVI} coordinates. (This program uses
+scaled points as \.{DVI} coordinates. Since \.{DVI} coordinates increase
+as one moves down the page, |yb| will be greater than |yt|.)
+\smallskip\hang\noindent
+|xx| and |yy| are the coordinates of the reference point of a box to be
+typeset from this node, again in \.{DVI} coordinates.
+\smallskip\hang\noindent
+|prev| and |next| point to the predecessor and successor of this node.
+Sometimes the nodes are singly linked and only |next| is relevant; otherwise
+the nodes are doubly linked in order of their |yy| coordinates, so that we
+can move down by going to |next|, or up by going to |prev|.
+\smallskip\hang\noindent
+|info| is the number of a string associated with this node.
+\smallskip\noindent
+
+The nine fields of a node appear in nine global arrays.
+Null pointers are denoted by |null|, which happens to be zero.
+
+@d null=0
+
+@<Types ...@>=
+@!node_pointer=null..max_labels;
+
+@ @<Glob...@>=
+@!xl,@!xr,@!yt,@!yb:array[1..max_labels] of scaled; {boundary coordinates}
+@!xx,@!yy:array[0..max_labels] of scaled; {reference coordinates}
+@!prev,@!next:array[0..max_labels] of node_pointer; {links}
+@!info:array[1..max_labels] of str_number; {associated strings}
+@!max_node:node_pointer; {the largest node in use}
+@!max_height:scaled; {greatest difference between |yy| and |yt|}
+@!max_depth:scaled; {greatest difference between |yb| and |yy|}
+
+
+@ It's easy to allocate a new node (unless no more room is left):
+
+@p function get_avail:node_pointer;
+begin incr(max_node);
+if max_node=max_labels then abort('Too many labels and/or rules!');
+@.Too many labels@>
+get_avail:=max_node;
+end;
+
+@ The doubly linked nodes are sorted by |yy| coordinates so that we don't have
+to work too hard to find nearest neighbors or to determine if rectangles overlap.
+The first node in the doubly linked rectangle list is always in location~0,
+and the last node is always in location |max_labels|; the |yy| coordinates
+of these nodes are very small and very large, respectively.
+
+@d end_of_list==max_labels
+
+@<Set init...@>=
+yy[0]:=-@'10000000000; yy[end_of_list]:=@'10000000000;
+
+@ The |node_ins| procedure inserts a new rectangle, represented by node~|p|,
+into the doubly linked list. There's a second parameter, |q|; node~|q| should
+already be in the doubly linked list, preferably with |yy[q]| near |yy[p]|.
+
+@p procedure node_ins(@!p,@!q:node_pointer);
+var @!r:node_pointer; {for tree traversal}
+begin if yy[p]>=yy[q] then
+ begin repeat r:=q; q:=next[q];@+until yy[p]<=yy[q];
+ next[r]:=p; prev[p]:=r; next[p]:=q; prev[q]:=p;
+ end
+else begin repeat r:=q; q:=prev[q];@+until yy[p]>=yy[q];
+ prev[r]:=p; next[p]:=r; prev[p]:=q; next[q]:=p;
+ end;
+if yy[p]-yt[p]>max_height then max_height:=yy[p]-yt[p];
+if yb[p]-yy[p]>max_depth then max_depth:=yb[p]-yy[p];
+end;
+
+@ The data structures need to be initialized for each character in the
+\.{GF} file.
+
+@<Initialize variables for the next character@>=
+max_node:=0; next[0]:=end_of_list; prev[end_of_list]:=0;
+max_height:=0; max_depth:=0;
+
+@ The |overlap| subroutine determines whether or not the rectangle specified
+in node~|p| has a nonempty intersection with some rectangle in the doubly
+linked list. Again |q|~is a parameter that gives us a starting point
+in the list. We assume that |q<>end_of_list|, so that |next[q]| is meaningful.
+
+@p function overlap(@!p,@!q:node_pointer):boolean;
+label exit;
+var @!y_thresh:scaled; {cutoff value to speed the search}
+@!x_left,@!x_right,@!y_top,@!y_bot:scaled; {boundaries to test for overlap}
+@!r:node_pointer; {runs through the neighbors of |q|}
+begin x_left:=xl[p]; x_right:=xr[p]; y_top:=yt[p]; y_bot:=yb[p];
+@<Look for overlaps in the successors of node |q|@>;
+@<Look for overlaps in node |q| and its predecessors@>;
+overlap:=false;
+exit: end;
+
+@ @<Look for overlaps in the successors of node |q|@>=
+y_thresh:=y_bot+max_height; r:=next[q];
+while yy[r]<y_thresh do
+ begin if y_bot > yt[r] then if x_left<xr[r] then
+ if x_right>xl[r] then if y_top<yb[r] then
+ begin overlap:=true; return;
+ end;
+ r:=next[r];
+ end
+
+@ @<Look for overlaps in node |q| and its predecessors@>=
+y_thresh:=y_top-max_depth; r:=q;
+while yy[r]>y_thresh do
+ begin if y_bot > yt[r] then if x_left<xr[r] then
+ if x_right>xl[r] then if y_top<yb[r] then
+ begin overlap:=true; return;
+ end;
+ r:=prev[r];
+ end
+
+@ Nodes that represent dots instead of labels satisfy the following
+constraints:
+$$\vcenter{\halign{#\hfil&\quad#\hfil\cr
+|info[p]<0;|&|p>=first_dot|;\cr
+|xl[p]=xx[p]-dot_width|,&|xr[p]=xx[p]+dot_width|;\cr
+|yt[p]=yy[p]-dot_height|,&|yb[p]=yy[p]+dot_height|.\cr}}$$
+
+The |nearest_dot| subroutine finds a node whose reference point is as
+close as possible to a given position, ignoring nodes that are too close.
+More precisely, the ``nearest'' node
+minimizes$$d(q,p)=\max\bigl(\vert |xx|[q]-|xx|[p]\vert,
+ \vert |yy|[q]-|yy|[p]\vert\bigr)$$ over all nodes~|q|
+with |d(q,p)>=d0|. We call the subroutine |nearest_dot| because it is used only
+when the doubly linked list contains nothing but dots.
+
+The routine also sets the global variable |twin| to |true|, if there is a
+node |q<>p| with |d(q,p)<d0|.
+
+@ @<Glob...@>=
+@!first_dot:node_pointer; {the node address where dots begin}
+@!twin:boolean; {is there a nearer dot than the ``nearest'' dot?}
+
+@ If there is no nearest dot, the value |null| is returned;
+otherwise a pointer to the nearest dot is returned.
+
+@p function nearest_dot(@!p:node_pointer; @!d0:scaled):node_pointer;
+var @!best_q:node_pointer; {value to return}
+@!d_min,@!d:scaled; {distances}
+begin twin:=false; best_q:=0; d_min:=@'2000000000;
+@<Search for the nearest dot in nodes following |p|@>;
+@<Search for the nearest dot in nodes preceding |p|@>;
+nearest_dot:=best_q;
+end;
+
+@ @<Search for the nearest dot in nodes following |p|@>=
+q:=next[p];
+while yy[q]<yy[p]+d_min do
+ begin d:=abs(xx[q]-xx[p]);
+ if d<yy[q]-yy[p] then d:=yy[q]-yy[p];
+ if d<d0 then twin:=true
+ else if d<d_min then
+ begin d_min:=d; best_q:=q;
+ end;
+ q:=next[q];
+ end
+
+@ @<Search for the nearest dot in nodes preceding |p|@>=
+q:=prev[p];
+while yy[q]>yy[p]-d_min do
+ begin d:=abs(xx[q]-xx[p]);
+ if d<yy[p]-yy[q] then d:=yy[p]-yy[q];
+ if d<d0 then twin:=true
+ else if d<d_min then
+ begin d_min:=d; best_q:=q;
+ end;
+ q:=prev[q];
+ end
+
+@* Doing the labels.
+Each ``character'' in the \.{GF} file is preceded by a number of special
+commands that define labels, titles, rules, etc. We store these away,
+to be considered later when the |boc| command appears. The |boc|
+command establishes the size information by which labels and rules
+can be positioned, so we spew out the label information as soon as
+we see the |boc|. The gray pixels will be typeset after all the labels
+for a particular character have been finished.
+
+@ Here is the part of \.{GFtoDVI} that stores information preceding a~|boc|.
+It comes into play when |cur_gf| is between |xxx1| and~|no_op|, inclusive.
+
+@d font_change(#)==if fonts_not_loaded then
+ begin #; end
+ else print_nl('(Tardy font change will be ignored (byte ',
+@.Tardy font change...@>
+ cur_loc:1,')!)')
+
+@<Process a no-op command@>=
+begin k:=interpret_xxx;
+case k of
+no_operation: do_nothing;
+title_font,label_font,gray_font,slant_font:font_change(font_name[k]:=cur_string;
+ font_area[k]:=null_string;font_at[k]:=0;init_str_ptr:=str_ptr);
+title_font+area_code,label_font+area_code,gray_font+area_code,
+ slant_font+area_code:@|
+ font_change(font_area[k-area_code]:=cur_string;init_str_ptr:=str_ptr);
+title_font+at_code,label_font+at_code,gray_font+at_code,
+ slant_font+at_code:@|
+ font_change(font_at[k-at_code]:=get_yyy;init_str_ptr:=str_ptr);
+rule_thickness_code:rule_thickness:=get_yyy;
+rule_code:@<Store a rule@>;
+offset_code:@<Override the offsets@>;
+x_offset_code:x_offset:=get_yyy;
+y_offset_code:y_offset:=get_yyy;
+title_code:@<Store a title@>;
+null_string:@<Store a label@>;
+end; {there are no other cases}
+end
+
+@ The following quantities are cleared just before reading the
+\.{GF} commands pertaining to a character.
+
+@<Glob...@>=
+@!rule_thickness:scaled; {the current rule thickness
+ (zero means use the default)}
+@!offset_x,@!offset_y:scaled; {the current offsets for images}
+@!x_offset,@!y_offset:scaled; {the current offsets for labels}
+@!pre_min_x,@!pre_max_x,@!pre_min_y,@!pre_max_y:scaled;
+ {extreme values of coordinates preceding a character, in \MF\ pixels}
+
+@ @<Initialize variables for the next character@>=
+rule_thickness:=0;
+offset_x:=0; offset_y:=0; x_offset:=0; y_offset:=0;
+pre_min_x:=@'2000000000; pre_max_x:=-@'2000000000;
+pre_min_y:=@'2000000000; pre_max_y:=-@'2000000000;
+
+@ @<Override the offsets@>=
+begin offset_x:=get_yyy; offset_y:=get_yyy;
+end
+
+@ Rules that will need to be drawn are kept in a linked list accessible
+via |rule_ptr|, in last-in-first-out order. The nodes of this list will
+never get into the doubly linked list, and indeed these nodes use different
+field conventions entirely (because rules may be slanted).
+
+@d x0==xl {starting |x| coordinate of a stored rule}
+@d y0==yt {starting |y| coordinate (in scaled \MF\ pixels)}
+@d x1==xr {ending |x| coordinate of a stored rule}
+@d y1==yb {ending |y| coordinate of a stored rule}
+@d rule_size==xx {thickness of a stored rule, in scaled points}
+
+@<Glob...@>=
+@!rule_ptr:node_pointer; {top of the stack of remembered rules}
+
+@ @<Store a rule@>=
+begin p:=get_avail; next[p]:=rule_ptr; rule_ptr:=p;@/
+x0[p]:=get_yyy; y0[p]:=get_yyy; x1[p]:=get_yyy; y1[p]:=get_yyy;
+if x0[p]<pre_min_x then pre_min_x:=x0[p];
+if x0[p]>pre_max_x then pre_max_x:=x0[p];
+if y0[p]<pre_min_y then pre_min_y:=y0[p];
+if y0[p]>pre_max_y then pre_max_y:=y0[p];
+if x1[p]<pre_min_x then pre_min_x:=x1[p];
+if x1[p]>pre_max_x then pre_max_x:=x1[p];
+if y1[p]<pre_min_y then pre_min_y:=y1[p];
+if y1[p]>pre_max_y then pre_max_y:=y1[p];
+rule_size[p]:=rule_thickness;
+end
+
+@ Titles and labels are, likewise, stored temporarily in singly linked lists.
+In this case the lists are first-in-first-out.
+Variables |title_tail| and |label_tail| point to the most recently inserted
+title or label; variables |title_head| and |label_head|
+point to the beginning of the list. (A standard coding trick is used
+for |label_head|, which is kept in |next[end_of_list]|; we have
+|label_tail=end_of_list| when the list is empty.)
+
+The |prev| field in nodes of the temporary label list specifies the
+type of label, so we call it |lab_typ|.
+
+@d lab_typ==prev {the type of a stored label (|"/"..."8"|)}
+@d label_head==next[end_of_list]
+
+@<Glob...@>=
+@!label_tail:node_pointer; {tail of the queue of remembered labels}
+@!title_head,@!title_tail:node_pointer; {head and tail of the queue for titles}
+
+@ We must start the lists out empty.
+
+@<Initialize variables for the next char...@>=
+rule_ptr:=null;
+title_head:=null; title_tail:=null; label_head:=null; label_tail:=end_of_list;
+first_dot:=max_labels;
+
+@ @<Store a title@>=
+begin p:=get_avail; info[p]:=cur_string;
+if title_head=null then title_head:=p
+else next[title_tail]:=p;
+title_tail:=p;
+end
+
+@ We store the coordinates of each label in units of \MF\ pixels; they
+will be converted to \.{DVI} coordinates later.
+
+@<Store a label@>=
+if (label_type<"/")or(label_type>"8") then
+ print_nl('Bad label type precedes byte ',cur_loc:1,'!')
+@.Bad label type...@>
+else begin p:=get_avail; next[label_tail]:=p; label_tail:=p;@/
+ lab_typ[p]:=label_type; info[p]:=cur_string;@/
+ xx[p]:=get_yyy; yy[p]:=get_yyy;
+ if xx[p]<pre_min_x then pre_min_x:=xx[p];
+ if xx[p]>pre_max_x then pre_max_x:=xx[p];
+ if yy[p]<pre_min_y then pre_min_y:=yy[p];
+ if yy[p]>pre_max_y then pre_max_y:=yy[p];
+ end
+
+@ The process of ferreting everything away comes to an abrupt halt
+when a |boc| command is sensed. The following steps are performed
+at such times:
+
+@<Process a character@>=
+begin check_fonts;
+@<Finish reading the parameters of the |boc|@>;
+@<Get ready to convert \MF\ coordinates to \.{DVI} coordinates@>;
+@<Output the |bop| and the title line@>;
+print('[',total_pages:1); update_terminal; {print a progress report}
+@<Output all rules for the current character@>;
+@<Output all labels for the current character@>;
+do_pixels;
+dvi_out(eop); {finish the page}
+@<Adjust the maximum page width@>;
+print(']'); update_terminal;
+end
+
+@ @<Finish reading the parameters of the |boc|@>=
+if cur_gf=boc then
+ begin ext:=signed_quad; {read the character code}
+ char_code:=ext mod 256;
+ if char_code<0 then char_code:=char_code+256;
+ ext:=(ext-char_code) div 256;
+ k:=signed_quad; {read and ignore the prev pointer}
+ min_x:=signed_quad; {read the minimum $x$ coordinate}
+ max_x:=signed_quad; {read the maximum $x$ coordinate}
+ min_y:=signed_quad; {read the minimum $y$ coordinate}
+ max_y:=signed_quad; {read the maximum $y$ coordinate}
+ end
+else begin ext:=0; char_code:=get_byte; {|cur_gf=boc1|}
+ min_x:=get_byte; max_x:=get_byte; min_x:=max_x-min_x;@/
+ min_y:=get_byte; max_y:=get_byte; min_y:=max_y-min_y;
+ end;
+if max_x-min_x>widest_row then abort('Character too wide!')
+@.Character too wide@>
+
+@ @<Glob...@>=
+@!char_code,@!ext:integer; {the current character code and extension}
+@!min_x,@!max_x,@!min_y,@!max_y:integer; {character boundaries, in pixels}
+@!x,@!y:integer; {current painting position, in pixels}
+@!z:integer; {initial painting position in row, relative to |min_x|}
+
+@ \MF\ coordinates $(x,y)$ are converted to \.{DVI} coordinates by the
+following routine. Real values |x_ratio|, |y_ratio|, and |slant_ratio|
+will have been calculated based on the gray font; |scaled| values
+|delta_x| and |delta_y| will have been computed so that, in the absence
+of slanting and offsets, the \MF\ coordinates |(min_x,max_y+1)| will correspond
+to the \.{DVI} coordinates $(0,50\,\rm pt)$.
+
+@p procedure convert(@!x,@!y:scaled);
+begin x:=x+x_offset; y:=y+y_offset;
+dvi_y:=-round(y_ratio*y)+delta_y;
+dvi_x:=round(x_ratio*x+slant_ratio*y)+delta_x;
+end;
+
+@ @<Glob...@>=
+@!x_ratio,@!y_ratio,@!slant_ratio:real; {conversion factors}
+@!unsc_x_ratio,@!unsc_y_ratio,@!unsc_slant_ratio:real;
+ {ditto, times |unity|}
+@!fudge_factor:real; {unconversion factor}
+@!delta_x,@!delta_y:scaled; {magic constants used by |convert|}
+@!dvi_x,@!dvi_y:scaled; {outputs of |convert|, in scaled points}
+@!over_col:scaled; {overflow labels start here}
+@!page_height,page_width:scaled; {size of the current page}
+
+@ @<Initialize global variables that depend on the font data@>=
+i:=char_info(gray_font)(1);
+if not char_exists(i) then abort('Missing pixel char!');
+@.Missing pixel char@>
+unsc_x_ratio:=char_width(gray_font)(i);
+x_ratio:=unsc_x_ratio/unity;
+unsc_y_ratio:=char_height(gray_font)(height_depth(i));
+y_ratio:=unsc_y_ratio/unity;
+unsc_slant_ratio:=slant(gray_font)*y_ratio;
+slant_ratio:=unsc_slant_ratio/unity;
+if x_ratio*y_ratio=0 then abort('Vanishing pixel size!');
+@.Vanishing pixel size@>
+fudge_factor:=(slant_ratio/x_ratio)/y_ratio;
+
+@ @<Get ready to convert...@>=
+if pre_min_x<min_x*unity then offset_x:=offset_x+min_x*unity-pre_min_x;
+if pre_max_y>max_y*unity then offset_y:=offset_y+max_y*unity-pre_max_y;
+if pre_max_x>max_x*unity then pre_max_x:=pre_max_x div unity
+else pre_max_x:=max_x;
+if pre_min_y<min_y*unity then pre_min_y:=pre_min_y div unity
+else pre_min_y:=min_y;
+delta_y:=round(unsc_y_ratio*(max_y+1)-y_ratio*offset_y)+3276800;
+delta_x:=round(x_ratio*offset_x-unsc_x_ratio*min_x);
+if slant_ratio>=0 then
+ over_col:=round(unsc_x_ratio*pre_max_x+unsc_slant_ratio*max_y)
+else over_col:=round(unsc_x_ratio*pre_max_x+unsc_slant_ratio*min_y);
+over_col:=over_col+delta_x+10000000;
+page_height:=round(unsc_y_ratio*(max_y+1-pre_min_y))+3276800-offset_y;
+if page_height>max_v then max_v:=page_height;
+page_width:=over_col-10000000
+
+@ The |dvi_goto| subroutine outputs bytes to the \.{DVI} file that
+will initiate typesetting at given \.{DVI} coordinates, assuming that
+the current position of the \.{DVI} reader is $(0,0)$. This subroutine
+begins by outputting a |push| command; therefore, a |pop| command should
+be given later. That |pop| will restore the \.{DVI} position to $(0,0)$.
+
+@p procedure dvi_goto(@!x,@!y:scaled);
+begin dvi_out(push);
+if x<>0 then
+ begin dvi_out(right4); dvi_four(x);
+ end;
+if y<>0 then
+ begin dvi_out(down4); dvi_four(y);
+ end;
+end;
+
+@ @<Output the |bop| and the title line@>=
+dvi_out(bop); incr(total_pages); dvi_four(total_pages);
+dvi_four(char_code); dvi_four(ext);
+for k:=3 to 9 do dvi_four(0);
+dvi_four(last_bop); last_bop:=dvi_offset+dvi_ptr-45;@/
+dvi_goto(0,655360); {the top baseline is 10\thinspace pt down}
+if use_logo then
+ begin select_font(logo_font); hbox(small_logo,logo_font,true);
+ end;
+select_font(title_font); hbox(time_stamp,title_font,true);@/
+hbox(page_header,title_font,true); dvi_scaled(total_pages*65536.0);@/
+if (char_code<>0)or(ext<>0) then
+ begin hbox(char_header,title_font,true); dvi_scaled(char_code*65536.0);
+ if ext<>0 then
+ begin hbox(ext_header,title_font,true); dvi_scaled(ext*65536.0);
+ end;
+ end;
+if title_head<>null then
+ begin next[title_tail]:=null;
+ repeat hbox(left_quotes,title_font,true);
+ hbox(info[title_head],title_font,true);
+ hbox(right_quotes,title_font,true);
+ title_head:=next[title_head];
+ until title_head=null;
+ end;
+dvi_out(pop)
+
+@ @d tol==6554 {one tenth of a point, in \.{DVI} coordinates}
+
+@<Output all rules for the current character@>=
+if rule_slant<>0 then select_font(slant_font);
+while rule_ptr<>null do
+ begin p:=rule_ptr; rule_ptr:=next[p];@/
+ if rule_size[p]=0 then rule_size[p]:=gray_rule_thickness;
+ if rule_size[p]>0 then
+ begin convert(x0[p],y0[p]); temp_x:=dvi_x; temp_y:=dvi_y;
+ convert(x1[p],y1[p]);
+ if abs(temp_x-dvi_x)<tol then @<Output a vertical rule@>
+ else if abs(temp_y-dvi_y)<tol then @<Output a horizontal rule@>
+ else @<Try to output a diagonal rule@>;
+ end;
+ end
+
+@ @<Glob...@>=
+@!gray_rule_thickness:scaled; {thickness of rules, according to the gray font}
+@!temp_x,@!temp_y:scaled; {temporary registers for intermediate calculations}
+
+@ @<Initialize glob...@>=
+gray_rule_thickness:=default_rule_thickness(gray_font);
+if gray_rule_thickness=0 then gray_rule_thickness:=26214; {0.4\thinspace pt}
+
+@ @<Output a vertical rule@>=
+begin if temp_y>dvi_y then
+ begin k:=temp_y; temp_y:=dvi_y; dvi_y:=k;
+ end;
+dvi_goto(dvi_x-(rule_size[p] div 2), dvi_y);
+dvi_out(put_rule); dvi_four(dvi_y-temp_y); dvi_four(rule_size[p]);
+dvi_out(pop);
+end
+
+@ @<Output a horizontal rule@>=
+begin if temp_x<dvi_x then
+ begin k:=temp_x; temp_x:=dvi_x; dvi_x:=k;
+ end;
+dvi_goto(dvi_x,dvi_y+(rule_size[p] div 2));
+dvi_out(put_rule); dvi_four(rule_size[p]); dvi_four(temp_x-dvi_x);
+dvi_out(pop);
+end
+
+@ @<Try to output a diagonal rule@>=
+if (rule_slant=0)or@|
+ (abs(temp_x+rule_slant*(temp_y-dvi_y)-dvi_x)>rule_size[p]) then
+ slant_complaint((dvi_x-temp_x)/(temp_y-dvi_y))
+else begin if temp_y>dvi_y then
+ begin k:=temp_y; temp_y:=dvi_y; dvi_y:=k;@/
+ k:=temp_x; temp_x:=dvi_x; dvi_x:=k;
+ end;
+ m:=round((dvi_y-temp_y)/slant_unit);
+ if m>0 then
+ begin dvi_goto(dvi_x,dvi_y);
+ q:=((m-1) div slant_n)+1; k:=m div q;
+ p:=m mod q; q:=q-p;
+ @<Vertically typeset |q| copies of character |k|@>;
+ @<Vertically typeset |p| copies of character |k+1|@>;
+ dvi_out(pop);
+ end;
+ end
+
+@ @<Vertically typeset |q| copies of character |k|@>=
+typeset(k); dy:=round(k*slant_unit); dvi_out(z4); dvi_four(-dy);
+while q>1 do
+ begin typeset(k); dvi_out(z0); decr(q);
+ end
+
+@ @<Vertically typeset |p| copies of character |k+1|@>=
+if p>0 then
+ begin incr(k); typeset(k);
+ dy:=round(k*slant_unit); dvi_out(z4); dvi_four(-dy);
+ while p>1 do
+ begin typeset(k); dvi_out(z0); decr(p);
+ end;
+ end
+
+@ Now we come to a more interesting part of the computation, where we
+go through the stored labels and try to fit them in the illustration for
+the current character, together with their associated dots.
+
+It would simplify font-switching slightly if we were to typeset the labels
+first, but we find it desirable to typeset the dots first and then turn to the
+labels. This procedure makes it possible for us to allow the dots to
+overlap each other without allowing the labels to overlap. After the
+dots are in place, we typeset all prescribed labels, that is, labels with a
+|lab_typ| of |"1".."8"|; these, too, are allowed to overlap the dots and
+each other.
+
+@<Output all labels for the current character@>=
+overflow_line:=1;
+if label_head<>null then
+ begin next[label_tail]:=null; select_font(gray_font);
+ @<Output all dots@>;
+ @<Find nearest dots, to help in label positioning@>;
+ select_font(label_font);
+ @<Output all prescribed labels@>;
+ @<Output all attachable labels@>;
+ @<Output all overflow labels@>;
+ end
+
+@ @<Glob...@>=
+@!overflow_line:integer; {the number of labels that didn't fit, plus~1}
+
+@ A label that appears above its dot is considered to occupy a
+rectangle of height~$h+\Delta$, depth~$d$, and width~$w+2\Delta$, where
+$(h,w,d)$ are the height, width, and depth of the label computed by |hbox|,
+and $\Delta$ is an additional amount of blank space that keeps labels from
+coming too close to each other. (\.{GFtoDVI} arbitrarily defines $\Delta$
+to be one half the width of a space in the label font.) This label is
+centered over its dot, with its baseline $d+h'$ above the center of the dot;
+here $h'=|dot_height|$ is the height of character~0 in the gray font.
+
+Similarly, a label that appears below its dot is considered to occupy
+a rectangle of height~$h$, depth~$d+\Delta$, and width~$w+2\Delta$; the
+baseline is $h+h'$ below the center of the dot.
+
+A label at the right of its dot is considered to occupy a rectangle of
+height~$h+\Delta$, depth~$d+\Delta$, and width~$w+\Delta$. Its
+reference point can be found by starting at the center of the dot and
+moving right $w'=|dot_width|$ (i.e., the width of character~0 in the
+gray font), then moving down by half the x-height of the label font.
+A label at the left of its dot is similar.
+
+A dot is considered to occupy a rectangle of height $2h'$ and width~$2w'$,
+centered on the dot.
+
+When the label type is |"1"| or more, the labels
+are put into the doubly linked list unconditionally.
+ Otherwise they are put into the list
+only if we can find a way to fit them in without
+overlapping any previously inserted rectangles.
+
+@<Glob...@>=
+@!delta:scaled; {extra padding to keep labels from being too close}
+@!half_x_height:scaled; {amount to drop baseline of label below the dot center}
+@!thrice_x_height:scaled; {baseline separation for overflow labels}
+@!dot_width,@!dot_height:scaled; {$w'$ and $h'$ in the discussion above}
+
+@ @<Initialize global variables that depend on the font data@>=
+i:=char_info(gray_font)(0);
+if not char_exists(i) then abort('Missing dot char!');
+@.Missing dot char@>
+dot_width:=char_width(gray_font)(i);
+dot_height:=char_height(gray_font)(height_depth(i));
+delta:=space(label_font) div 2;
+thrice_x_height:=3*x_height(label_font);
+half_x_height:=thrice_x_height div 6;
+
+@ Here is a subroutine that computes the rectangle boundaries
+|xl[p]|, |xr[p]|, |yt[p]|, |yb[p]|, and the reference point coordinates
+|xx[p]|,~|yy[p]|, for a label that is to be placed above a dot.
+The coordinates of the dot's center are assumed given in |dvi_x|
+and |dvi_y|; the |hbox| subroutine is assumed to have
+already computed the height, width, and depth of the label box.
+
+@p procedure top_coords(@!p:node_pointer);
+begin xx[p]:=dvi_x-(box_width div 2); xl[p]:=xx[p]-delta;
+xr[p]:=xx[p]+box_width+delta;@/
+yb[p]:=dvi_y-dot_height; yy[p]:=yb[p]-box_depth;
+yt[p]:=yy[p]-box_height-delta;
+end;
+
+@ The other three label positions are handled by similar routines.
+
+@p procedure bot_coords(@!p:node_pointer);
+begin xx[p]:=dvi_x-(box_width div 2); xl[p]:=xx[p]-delta;
+xr[p]:=xx[p]+box_width+delta;@/
+yt[p]:=dvi_y+dot_height; yy[p]:=yt[p]+box_height;
+yb[p]:=yy[p]+box_depth+delta;
+end;
+@#
+procedure right_coords(@!p:node_pointer);
+begin xl[p]:=dvi_x+dot_width; xx[p]:=xl[p]; xr[p]:=xx[p]+box_width+delta;@/
+yy[p]:=dvi_y+half_x_height; yb[p]:=yy[p]+box_depth+delta;
+yt[p]:=yy[p]-box_height-delta;
+end;
+@#
+procedure left_coords(@!p:node_pointer);
+begin xr[p]:=dvi_x-dot_width; xx[p]:=xr[p]-box_width; xl[p]:=xx[p]-delta;@/
+yy[p]:=dvi_y+half_x_height; yb[p]:=yy[p]+box_depth+delta;
+yt[p]:=yy[p]-box_height-delta;
+end;
+
+@ @<Output all dots@>=
+p:=label_head; first_dot:=max_node+1;
+while p<>null do
+ begin convert(xx[p],yy[p]); xx[p]:=dvi_x; yy[p]:=dvi_y;
+ if lab_typ[p]<"5" then
+ @<Enter a dot for label |p| in the rectangle list,
+ and typeset the dot@>;
+ p:=next[p];
+ end
+
+@ We plant links between dots and their labels by using (or abusing) the
+|xl| and |info| fields, which aren't needed for their normal purposes.
+
+@d dot_for_label==xl
+@d label_for_dot==info
+
+@<Enter a dot...@>=
+begin q:=get_avail; dot_for_label[p]:=q; label_for_dot[q]:=p;@/
+xx[q]:=dvi_x; xl[q]:=dvi_x-dot_width; xr[q]:=dvi_x+dot_width;@/
+yy[q]:=dvi_y; yt[q]:=dvi_y-dot_height; yb[q]:=dvi_y+dot_height;@/
+node_ins(q,0);@/
+dvi_goto(xx[q],yy[q]); dvi_out(0); dvi_out(pop);
+end
+
+@ Prescribed labels are now taken out of the singly linked list and
+inserted into the doubly linked list.
+
+@<Output all prescribed labels@>=
+q:=end_of_list; {|label_head=next[q]|}
+while next[q]<>null do
+ begin p:=next[q];
+ if lab_typ[p]>"0" then
+ begin next[q]:=next[p];
+ @<Enter a prescribed label for node |p| into the rectangle list,
+ and typeset it@>;
+ end
+ else q:=next[q];
+ end
+
+@ @<Enter a prescr...@>=
+begin hbox(info[p],label_font,false); {Compute the size of this label}
+dvi_x:=xx[p]; dvi_y:=yy[p];
+if lab_typ[p]<"5" then r:=dot_for_label[p]@+else r:=0;
+case lab_typ[p] of
+"1","5":top_coords(p);
+"2","6":left_coords(p);
+"3","7":right_coords(p);
+"4","8":bot_coords(p);
+end; {no other cases are possible}
+node_ins(p,r);@/
+dvi_goto(xx[p],yy[p]); hbox(info[p],label_font,true); dvi_out(pop);
+end
+
+@ \.{GFtoDVI}'s algorithm for positioning the ``floating'' labels
+was devised by Arthur~L. Samuel.
+@^Samuel, Arthur Lee@>
+It tries to place labels in a priority order, based on the position of
+the nearest dot to a given dot. If that dot, for example, lies in the first
+octant (i.e., east to northeast of the given dot), the given label will
+be put into the west slot unless that slot is already blocked; then the
+south slot will be tried, etc.
+
+First we need to compute the octants. We also note if two or more dots
+are nearly coincident, since Samuel's algorithm modifies the priority
+order on that case. The information is temporarily recorded in the |xr| array.
+
+@d octant==xr {octant code for nearest dot, plus 8 for coincident dots}
+
+@<Find nearest dots, to help in label positioning@>=
+p:=label_head;
+while p<>null do
+ begin if lab_typ[p]<="0" then
+ @<Compute the octant code for floating label |p|@>;
+ p:=next[p];
+ end;
+
+@ There's a sneaky way to identify octant numbers, represented by the
+code shown here. (Remember that |y|~coordinates increase downward
+in the \.{DVI} convention.)
+
+@d first_octant=0
+@d second_octant=1
+@d third_octant=2
+@d fourth_octant=3
+@d fifth_octant=7
+@d sixth_octant=6
+@d seventh_octant=5
+@d eighth_octant=4
+
+@<Compute the octant code for floating label |p|@>=
+begin r:=dot_for_label[p]; q:=nearest_dot(r,10);
+if twin then octant[p]:=8@+else octant[p]:=0;
+if q<>null then
+ begin dx:=xx[q]-xx[r]; dy:=yy[q]-yy[r];
+ if dy>0 then octant[p]:=octant[p]+4;
+ if dx<0 then incr(octant[p]);
+ if dy>dx then incr(octant[p]);
+ if -dy>dx then incr(octant[p]);
+ end;
+end
+
+@ A procedure called |place_label| will try to place the remaining
+labels in turn. If it fails, we ``disconnect'' the dot from this
+label so that an unlabeled dot will not appear as a reference in the
+overflow column.
+
+@<Output all attachable labels@>=
+q:=end_of_list; {now |next[q]=label_head|}
+while next[q]<>null do
+ begin p:=next[q]; r:=next[p]; s:=dot_for_label[p];
+ if place_label(p) then next[q]:=r
+ else begin label_for_dot[s]:=null; {disconnect the dot}
+ if lab_typ[p]="/" then next[q]:=r {remove label from list}
+ else q:=p; {retain label in list for the overflow column}
+ end;
+ end
+
+@ Here is the |place_label| routine, which uses the previously computed
+|octant| information as a heuristic. If the label can be placed, it
+is inserted into the rectangle list and typeset.
+
+@p function place_label(@!p:node_pointer):boolean;
+label exit, found;
+var @!oct:0..15; {octant code}
+@!dfl:node_pointer; {saved value of |dot_for_label[p]|}
+begin hbox(info[p],label_font,false); {Compute the size of this label}
+dvi_x:=xx[p]; dvi_y:=yy[p];
+@<Find non-overlapping coordinates, if possible, and |goto| found;
+ otherwise set |place_label:=false| and |return|@>;
+found:node_ins(p,dfl);@/
+dvi_goto(xx[p],yy[p]); hbox(info[p],label_font,true); dvi_out(pop);
+place_label:=true;
+exit:end;
+
+@ @<Find non-overlapping coordinates, if possible...@>=
+dfl:=dot_for_label[p]; oct:=octant[p];
+@<Try the first choice for label direction@>;
+@<Try the second choice for label direction@>;
+@<Try the third choice for label direction@>;
+@<Try the fourth choice for label direction@>;
+xx[p]:=dvi_x; yy[p]:=dvi_y; dot_for_label[p]:=dfl; {no luck; restore the coordinates}
+place_label:=false; return
+
+@ @<Try the first choice for label direction@>=
+case oct of
+first_octant,eighth_octant,second_octant+8,seventh_octant+8: left_coords(p);
+second_octant,third_octant,first_octant+8,fourth_octant+8: bot_coords(p);
+fourth_octant,fifth_octant,third_octant+8,sixth_octant+8: right_coords(p);
+sixth_octant,seventh_octant,fifth_octant+8,eighth_octant+8: top_coords(p);
+end;
+if not overlap(p,dfl) then goto found
+
+@ @<Try the second choice for label direction@>=
+case oct of
+first_octant,fourth_octant,fifth_octant+8,eighth_octant+8: bot_coords(p);
+second_octant,seventh_octant,third_octant+8,sixth_octant+8: left_coords(p);
+third_octant,sixth_octant,second_octant+8,seventh_octant+8: right_coords(p);
+fifth_octant,eighth_octant,first_octant+8,fourth_octant+8: top_coords(p);
+end;
+if not overlap(p,dfl) then goto found
+
+@ @<Try the third choice for label direction@>=
+case oct of
+first_octant,fourth_octant,sixth_octant+8,seventh_octant+8: top_coords(p);
+second_octant,seventh_octant,fourth_octant+8,fifth_octant+8: right_coords(p);
+third_octant,sixth_octant,first_octant+8,eighth_octant+8: left_coords(p);
+fifth_octant,eighth_octant,second_octant+8,third_octant+8: bot_coords(p);
+end;
+if not overlap(p,dfl) then goto found
+
+@ @<Try the fourth choice for label direction@>=
+case oct of
+first_octant,eighth_octant,first_octant+8,eighth_octant+8: right_coords(p);
+second_octant,third_octant,second_octant+8,third_octant+8: top_coords(p);
+fourth_octant,fifth_octant,fourth_octant+8,fifth_octant+8: left_coords(p);
+sixth_octant,seventh_octant,sixth_octant+8,seventh_octant+8: bot_coords(p);
+end;
+if not overlap(p,dfl) then goto found
+
+@ @<Output all overflow labels@>=
+@<Remove all rectangles from list, except for dots that have labels@>;
+p:=label_head;
+while p<>null do
+ begin @<Typeset an overflow label for |p|@>;
+ p:=next[p];
+ end
+
+@ When we remove a dot that couldn't be labeled, we set its |next| field
+to the preceding node that survives, so that we can use the |nearest_dot|
+routine later. (This is a bit of a kludge.)
+
+@<Remove all rectangles from list, except for dots that have labels@>=
+p:=next[0];
+while p<>end_of_list do
+ begin q:=next[p];
+ if (p<first_dot) or (label_for_dot[p]=null) then
+ begin r:=prev[p]; next[r]:=q; prev[q]:=r; next[p]:=r;
+ end;
+ p:=q;
+ end
+
+@ Now we have to insert |p| into the list temporarily, because of the
+way |nearest_dot| works.
+
+@<Typeset an overflow label for |p|@>=
+begin r:=next[dot_for_label[p]]; s:=next[r]; t:=next[p];
+next[p]:=s; prev[s]:=p; next[r]:=p; prev[p]:=r;@/
+q:=nearest_dot(p,0);@/
+next[r]:=s; prev[s]:=r; next[p]:=t; {remove |p| again}
+incr(overflow_line);
+dvi_goto(over_col,overflow_line*thrice_x_height+655360);
+hbox(info[p],label_font,true);
+if q<>null then
+ begin hbox(equals_sign,label_font,true);
+ hbox(info[label_for_dot[q]],label_font,true);
+ hbox(plus_sign,label_font,true);
+ dvi_scaled((xx[p]-xx[q])/x_ratio+(yy[p]-yy[q])*fudge_factor);
+ dvi_out(",");
+ dvi_scaled((yy[q]-yy[p])/y_ratio);
+ dvi_out(")");
+ end;
+dvi_out(pop);
+end
+
+@ @<Adjust the maximum page width@>=
+if overflow_line>1 then page_width:=over_col+10000000;
+ {overflow labels are estimated to occupy $10^7\,$sp}
+if page_width>max_h then max_h:=page_width
+
+@* Doing the pixels.
+The most interesting part of \.{GFtoDVI} is the way it makes use of a gray
+font to typeset the pixels of a character. In fact, the author must admit having
+great fun devising the algorithms below. Perhaps the reader will also
+enjoy reading them.
+
+The basic idea will be to use an array of 12-bit integers to represent the next
+twelve rows that need to be typeset. The binary expansions of these integers,
+reading from least significant bit to most significant bit, will represent
+pixels from top to bottom.
+
+@ We have already used such a binary representation in the tables
+|c[1..120]| and |d[1..120]| of bit patterns and lengths that are potentially
+present in a gray font; we shall now use those tables to compute
+an auxiliary array |b[0..4095]|. Given a 12-bit number~$v$, the gray-font
+character appropriate to $v$'s binary pattern will be~|b[v]|. If no
+character should be typeset for this pattern in the current row,
+|b[v]| will be~0.
+
+The array |b| can have many different configurations, depending on how
+many characters are actually present in the gray font. But
+it's not difficult to compute |b| by going through the existing characters
+in increasing order and marking all patterns~$x$ to which they apply.
+
+@<Initialize glob...@>=
+for k:=0 to 4095 do b[k]:=0;
+for k:=font_bc[gray_font] to font_ec[gray_font] do
+ if k>=1 then if k<=120 then
+ if char_exists(char_info(gray_font)(k)) then
+ begin v:=c[k];
+ repeat b[v]:=k; v:=v+d[k];
+ until v>4095;
+ end;
+
+@ We also compute an auxiliary array |rho[0..4095]| such that $\\{rho}[v]=2^j$
+when |v| is an odd multiple of~$2^j$; we also set $\\{rho}[0]=2^{12}$.
+
+@<Initialize g...@>=
+for j:=0 to 11 do
+ begin k:=two_to_the[j]; v:=k;
+ repeat rho[v]:=k; v:=v+k+k;
+ until v>4095;
+ end;
+rho[0]:=4096;
+
+@ @<Glob...@>=
+@!b:array[0..4095] of 0..120; {largest existing character for a given pattern}
+@!rho:array[0..4095] of 1..4096; {the ``ruler function''}
+
+@ But how will we use these tables? Let's imagine that the \.{DVI} file
+already contains instructions that have selected the gray font and moved
+to the proper horizontal coordinate for the row that we wish to process next.
+Let's suppose that 12-bit patterns have been set up in array~|a|, and that
+the global variables |starting_col| and |finishing_col| are known such
+that |a[j]| is zero unless |starting_col<=j<=finishing_col|. Here's what
+we can do, assuming that appropriate local variables and labels have
+been declared:
+
+@<Typeset the pixels of the current row@>=
+j:=starting_col;
+loop@+ begin while (j<=finishing_col)and(b[a[j]]=0) do incr(j);
+ if j>finishing_col then goto done;
+ dvi_out(push); @<Move to column |j| in the \.{DVI} output@>;
+ repeat v:=b[a[j]]; a[j]:=a[j]-c[v];
+ k:=j; incr(j);
+ while b[a[j]]=v do
+ begin a[j]:=a[j]-c[v]; incr(j);
+ end;
+ k:=j-k; @<Output the equivalent of |k| copies of character |v|@>;
+ until b[a[j]]=0;
+ dvi_out(pop);
+ end;
+done:
+
+@ @<Move to column |j| in the \.{DVI} output@>=
+dvi_out(right4);
+dvi_four(round(unsc_x_ratio*j+unsc_slant_ratio*y)+delta_x)
+
+@ The doubling-up property of gray font character lists is utilized here.
+
+@<Output the equivalent of |k| copies of character |v|@>=
+reswitch: if k=1 then typeset(v)
+else begin i:=char_info(gray_font)(v);
+ if char_tag(i)=list_tag then {|v| has a successor}
+ begin if odd(k) then typeset(v);
+ k:=k div 2; v:=qo(rem_byte(i)); goto reswitch;
+ end
+ else repeat typeset(v); decr(k);
+ until k=0;
+ end
+
+@ @<Glob...@>=
+@!a:array[0..widest_row] of 0..4095; {bit patterns for twelve rows}
+
+@ In order to use the approach above, we need to be able to initialize
+array~|a|, and we need to be able to keep it up to date as new rows
+scroll by. A moment's thought about the problem reveals that we will either
+have to read an entire character from the \.{GF} file into memory,
+or we'll need to adopt a coroutine-like approach: A single \\{skip}
+command in the \.{GF} file might need to be processed in pieces, since
+it might generate more rows of zeroes than we are ready to absorb
+all at once into~|a|.
+
+The coroutine method actually turns out to be quite simple, so we shall
+introduce a global variable |blank_rows|, which tells how many rows of
+blanks should be generated before we read the \.{GF} instructions
+for another row.
+
+@<Glob...@>=
+@!blank_rows:integer;
+ {rows of blanks carried over from a previous \.{GF} command}
+
+@ Initialization and updating of~|a| can now be handled as follows,
+if we introduce another variable~|l| that is set initially to~1:
+
+@<Add more rows to |a|, until 12-bit entries are obtained@>=
+repeat @<Put the bits for the next row, times |l|, into |a|@>;
+l:=l+l; decr(y);
+until l=4096;
+
+@ As before, |cur_gf| will contain the first \.{GF} command that has
+not yet been interpreted.
+
+@<Put the bits...@>=
+if blank_rows>0 then decr(blank_rows)
+else if cur_gf<>eoc then
+ begin x:=z;
+ if starting_col>x then starting_col:=x;
+ @<Read and process \.{GF} commands until coming to the end of this row@>;
+ end;
+
+@ @d do_skip==z:=0; paint_black:=false
+@d end_with(#)==begin #; cur_gf:=get_byte; goto done1;@+end
+@d five_cases(#)==#,#+1,#+2,#+3,#+4
+@d eight_cases(#)==#,#+1,#+2,#+3,#+4,#+5,#+6,#+7
+@d thirty_two_cases(#)==eight_cases(#),eight_cases(#+8),
+ eight_cases(#+16), eight_cases(#+24)
+@d sixty_four_cases(#)==thirty_two_cases(#), thirty_two_cases(#+32)
+
+@<Read and process...@>=
+loop @+begin continue: case cur_gf of
+ sixty_four_cases(0): k:=cur_gf;
+ paint1:k:=get_byte;
+ paint2:k:=get_two_bytes;
+ paint3:k:=get_three_bytes;
+ eoc:goto done1;
+ skip0:end_with(blank_rows:=0; do_skip);
+ skip1:end_with(blank_rows:=get_byte; do_skip);
+ skip2:end_with(blank_rows:=get_two_bytes; do_skip);
+ skip3:end_with(blank_rows:=get_three_bytes; do_skip);
+ sixty_four_cases(new_row_0),sixty_four_cases(new_row_0+64),
+ thirty_two_cases(new_row_0+128),five_cases(new_row_0+160):
+ end_with(z:=cur_gf-new_row_0;paint_black:=true);
+ xxx1,xxx2,xxx3,xxx4,yyy,no_op:begin skip_nop; goto continue;
+ end;
+ othercases bad_gf('Improper opcode')
+ endcases;@/
+ @<Paint |k| bits and read another command@>;
+ end;
+done1:
+
+@ @<Paint |k| bits and read another command@>=
+if x+k>finishing_col then finishing_col:=x+k;
+if paint_black then for j:=x to x+k-1 do a[j]:=a[j]+l;
+paint_black:=not paint_black;
+x:=x+k;
+cur_gf:=get_byte
+
+@ When the current row has been typeset, all entries of |a| will be even;
+we want to divide them by~2 and incorporate a new row with $l=2^{11}$.
+However, if they are all multiples of~4, we actually want to divide by~4
+and incorporate two new rows, with $l=2^{10}$ and $l=2^{11}$. In general,
+we want to divide by the maximum possible power of~2 and add the corresponding
+number of new rows; that's where the |rho|~array comes in handy:
+
+@<Advance to the next row that needs to be typeset;
+ or |return|, if we're all done@>=
+l:=rho[a[starting_col]];
+for j:=starting_col+1 to finishing_col do if l>rho[a[j]] then l:=rho[a[j]];
+if l=4096 then
+ if cur_gf=eoc then return
+ else begin y:=y-blank_rows; blank_rows:=0; l:=1;
+ starting_col:=z; finishing_col:=z;
+ end
+else begin while a[starting_col]=0 do incr(starting_col);
+ while a[finishing_col]=0 do decr(finishing_col);
+ for j:=starting_col to finishing_col do a[j]:=a[j] div l;
+ l:=4096 div l;
+ end
+
+@ We now have constructed the major components of the necessary routine;
+it simply remains to glue them all together in the proper framework.
+
+@p procedure do_pixels;
+label done,done1,reswitch,continue,exit;
+var @!paint_black:boolean; {the paint switch}
+@!starting_col,@!finishing_col:0..widest_row; {currently nonzero area}
+@!j:0..widest_row; {for traversing that area}
+@!l:integer; {power of two used to manipulate bit patterns}
+@!i:four_quarters; {character information word}
+@!v:eight_bits; {character corresponding to a pixel pattern}
+begin select_font(gray_font);
+delta_x:=delta_x+round(unsc_x_ratio*min_x);
+for j:=0 to max_x-min_x do a[j]:=0;
+l:=1; z:=0; starting_col:=0; finishing_col:=0; y:=max_y+12; paint_black:=false;
+blank_rows:=0; cur_gf:=get_byte;
+loop@+ begin @<Add more rows...@>;
+ dvi_goto(0,delta_y-round(unsc_y_ratio*y)); @<Typeset the pixels...@>;
+ dvi_out(pop); @<Advance to the next...@>;
+ end;
+exit:end;
+
+@* The main program.
+Now we are ready to put it all together. This is where \.{GFtoDVI} starts,
+and where it ends.
+
+@p begin initialize; {get all variables initialized}
+@<Initialize the strings@>;
+start_gf; {open the input and output files}
+@<Process the preamble@>;
+cur_gf:=get_byte; init_str_ptr:=str_ptr;
+loop@+ begin @<Initialize variables for the next character@>;
+ while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>;
+ if cur_gf=post then @<Finish the \.{DVI} file and |goto final_end|@>;
+ if cur_gf<>boc then if cur_gf<>boc1 then abort('Missing boc!');
+@.Missing boc@>
+ @<Process a character@>;
+ cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr];
+ end;
+final_end:end.
+
+@ The main program needs a few global variables in order to do its work.
+
+@<Glob...@>=
+@!k,@!m,@!p,@!q,@!r,@!s,@!t,@!dx,@!dy:integer; {general purpose registers}
+@!time_stamp:str_number; {the date and time when the input file was made}
+@!use_logo:boolean; {should \MF's logo be put on the title line?}
+
+@ \MF\ sets the opening string to 32 bytes that give date and time as follows:
+$$\hbox{|' METAFONT output yyyy.mm.dd:tttt'|}$$
+We copy this to the \.{DVI} file, but remove the `\.{METAFONT}' part so that
+it can be replaced by its proper logo.
+
+@<Process the preamble@>=
+if get_byte<>pre then bad_gf('No preamble');
+@.No preamble@>
+if get_byte<>gf_id_byte then bad_gf('Wrong ID');
+@.Wrong ID@>
+k:=get_byte; {|k| is the length of the initial string to be copied}
+for m:=1 to k do append_char(get_byte);
+dvi_out(pre); dvi_out(dvi_id_byte); {output the preamble}
+dvi_four(25400000); dvi_four(473628672); {conversion ratio for sp}
+dvi_four(1000); {magnification factor}
+dvi_out(k); use_logo:=false; s:=str_start[str_ptr];
+for m:=1 to k do dvi_out(str_pool[s+m-1]);
+if str_pool[s]=" " then
+ if str_pool[s+1]="M" then
+ if str_pool[s+2]="E" then
+ if str_pool[s+3]="T" then
+ if str_pool[s+4]="A" then
+ if str_pool[s+5]="F" then
+ if str_pool[s+6]="O" then
+ if str_pool[s+7]="N" then
+ if str_pool[s+8]="T" then
+ begin incr(str_ptr); str_start[str_ptr]:=s+9; use_logo:=true;
+ end; {we will substitute `\MF' for \.{METAFONT}}
+time_stamp:=make_string
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoDVI} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Here is a list of the section numbers where each identifier is used.
+Cross references to error messages and a few other tidbits of information
+also appear.
diff --git a/Build/source/texk/web2c/gftopk.ch b/Build/source/texk/web2c/gftopk.ch
new file mode 100644
index 00000000000..a62a73c6ef7
--- /dev/null
+++ b/Build/source/texk/web2c/gftopk.ch
@@ -0,0 +1,449 @@
+% gftopk.ch for C compilation with web2c.
+%
+% 09/19/88 Pierre A. MacKay Version 1.4.
+% 12/02/89 Karl Berry 2.1.
+% 01/20/90 Karl 2.2.
+% (more recent changes in the ChangeLog)
+%
+% One major change in output format is made by this change file. The
+% local gftopk preamble comment is ignored and the dated METAFONT
+% comment is passed through unaltered. This provides a continuous check
+% on the origin of fonts in both gf and pk formats. The program runs
+% silently unless it is given the -v switch in the command line.
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{GF$\,$\lowercase{to}$\,$PK changes C}
+@z
+
+@x [4] No global labels.
+@ The binary input comes from |gf_file|, and the output font is written
+on |pk_file|. All text output is written on \PASCAL's standard |output|
+file. The term |print| is used instead of |write| when this program writes
+on |output|, so that all such output could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program GFtoPK(@!gf_file,@!pk_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+@y
+@ The binary input comes from |gf_file|, and the output font is written
+on |pk_file|. All text output is written on \PASCAL's standard |output|
+file. The term |print| is used instead of |write| when this program writes
+on |output|, so that all such output could easily be redirected if desired.
+Since the terminal output is really not very interesting, it is
+produced only when the \.{-v} command line flag is presented.
+
+@d print(#)==if verbose then write(stdout, #)
+@d print_ln(#)==if verbose then write_ln(stdout, #)
+
+@p program GFtoPK(@!gf_file,@!pk_file,@!output);
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+begin
+ kpse_set_progname (argv[0]);
+ kpse_init_prog ('GFTOPK', 0, nil, nil);
+ parse_arguments;
+ print(banner); print_ln(version_string);
+@z
+
+@x [5] Eliminate the |final_end| label.
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+@y
+@ This module is deleted, because it is only useful for
+a non-local goto, which we can't use in C.
+@z
+
+@x [7] Allow for bigger fonts. Too bad it's not dynamically allocated.
+@!max_row=16000; {largest index in the main |row| array}
+@y
+@!max_row=100000; {largest index in the main |row| array}
+@z
+
+@x [8] Make `abort' end with a newline, and remove the nonlocal goto.
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_gf(#)==abort('Bad GF file: ',#,'!')
+@.Bad GF file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+@y
+@d abort(#)==begin write_ln(stderr, #); uexit (1);
+ end
+@d bad_gf(#)==abort('Bad GF file: ',#,'!')
+@.Bad GF file@>
+@z
+
+@x [40] Use paths in open_gf_file.
+@ To prepare the |gf_file| for input, we |reset| it.
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file);
+gf_loc := 0 ;
+end;
+@y
+@ In C, we do path searching based on the user's environment or the
+default paths.
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin
+ gf_file := kpse_open_file (gf_name, kpse_gf_format);
+ gf_loc := 0;
+end;
+@z
+
+% [41] If the PK filename isn't given on the command line, we construct
+% it from the GF filename.
+@x
+@p procedure open_pk_file; {prepares to write packed bytes in |pk_file|}
+begin rewrite(pk_file);
+pk_loc := 0 ; pk_open := true ;
+end;
+@y
+@p procedure open_pk_file; {prepares to write packed bytes in |pk_file|}
+begin
+ rewritebin (pk_file, pk_name);
+ pk_loc := 0;
+ pk_open := true;
+end;
+@z
+
+@x [46] Redefine pk_byte, pk_halfword, pk_three_bytes, and pk_word.
+@p procedure pk_byte(a:integer) ;
+begin
+ if pk_open then begin
+ if a < 0 then a := a + 256 ;
+ write(pk_file, a) ;
+ incr(pk_loc) ;
+ end ;
+end ;
+@#
+procedure pk_halfword(a:integer) ;
+begin
+ if a < 0 then a := a + 65536 ;
+ write(pk_file, a div 256) ;
+ write(pk_file, a mod 256) ;
+ pk_loc := pk_loc + 2 ;
+end ;
+@#
+procedure pk_three_bytes(a:integer);
+begin
+ write(pk_file, a div 65536 mod 256) ;
+ write(pk_file, a div 256 mod 256) ;
+ write(pk_file, a mod 256) ;
+ pk_loc := pk_loc + 3 ;
+end ;
+@#
+procedure pk_word(a:integer) ;
+var b : integer ;
+begin
+ if pk_open then begin
+ if a < 0 then begin
+ a := a + @'10000000000 ;
+ a := a + @'10000000000 ;
+ b := 128 + a div 16777216 ;
+ end else b := a div 16777216 ;
+ write(pk_file, b) ;
+ write(pk_file, a div 65536 mod 256) ;
+ write(pk_file, a div 256 mod 256) ;
+ write(pk_file, a mod 256) ;
+ pk_loc := pk_loc + 4 ;
+ end ;
+end ;
+@y
+@ Output is handled through |putbyte| which is supplied by web2c.
+
+@d pk_byte(#)==begin putbyte(#, pk_file); incr(pk_loc) end
+
+@p procedure pk_halfword(a:integer) ;
+begin
+ if a < 0 then a := a + 65536 ;
+ putbyte(a div 256, pk_file) ;
+ putbyte(a mod 256, pk_file) ;
+ pk_loc := pk_loc + 2 ;
+end ;
+@#
+procedure pk_three_bytes(a:integer);
+begin
+ putbyte(a div 65536 mod 256, pk_file) ;
+ putbyte(a div 256 mod 256, pk_file) ;
+ putbyte(a mod 256, pk_file) ;
+ pk_loc := pk_loc + 3 ;
+end ;
+@#
+procedure pk_word(a:integer) ;
+var b : integer ;
+begin
+ if a < 0 then begin
+ a := a + @'10000000000 ;
+ a := a + @'10000000000 ;
+ b := 128 + a div 16777216 ;
+ end else b := a div 16777216 ;
+ putbyte(b, pk_file) ;
+ putbyte(a div 65536 mod 256, pk_file) ;
+ putbyte(a div 256 mod 256, pk_file) ;
+ putbyte(a mod 256, pk_file) ;
+ pk_loc := pk_loc + 4 ;
+end ;
+@z
+
+@x [48] Redefine find_gf_length and move_to_byte.
+@p procedure find_gf_length ;
+begin
+ set_pos(gf_file, -1) ; gf_len := cur_pos(gf_file) ;
+end ;
+@#
+procedure move_to_byte(@!n : integer) ;
+begin
+ set_pos(gf_file, n); gf_loc := n ;
+end ;
+@y
+@d find_gf_length==gf_len:=gf_length
+
+@p function gf_length:integer;
+begin
+ xfseek (gf_file, 0, 2, 'gftopk');
+ gf_length := xftell (gf_file, 'gftopk');
+end;
+@#
+procedure move_to_byte (n:integer);
+begin xfseek (gf_file, n, 0, 'gftopk');
+end;
+@z
+
+% [53] Make sure that |gf_byte| gets past the comment when not
+% |verbose|; add do_the_rows to break up huge run of cases.
+@x
+ repeat
+ gf_com := gf_byte ;
+ case gf_com of
+@y
+ repeat
+ gf_com := gf_byte ;
+ do_the_rows:=false;
+ case gf_com of
+@z
+
+@x [54] Declare |thirty_seven_cases| to help avoid breaking yacc.
+@d one_sixty_five_cases(#)==sixty_four_cases(#),sixty_four_cases(#+64),
+ sixteen_cases(#+128),sixteen_cases(#+144),four_cases(#+160),#+164
+@y
+@d thirty_seven_cases(#)==sixteen_cases(#),sixteen_cases(#+16),
+ four_cases(#+32),#+36
+@d new_row_64=new_row_0 + 64
+@d new_row_128=new_row_64 + 64
+@z
+
+@x [59] Break up an oversized sequence of cases for yacc.
+one_sixty_five_cases(new_row_0) : begin
+ if on = state then put_in_rows(extra) ;
+ put_in_rows(end_of_row) ;
+ on := true ; extra := gf_com - new_row_0 ; state := false ;
+end ;
+@t\4@>@<Specials and |no_op| cases@> ;
+eoc : begin
+ if on = state then put_in_rows(extra) ;
+ if ( row_ptr > 2 ) and ( row[row_ptr - 1] <> end_of_row) then
+ put_in_rows(end_of_row) ;
+ put_in_rows(end_of_char) ;
+ if bad then abort('Ran out of internal memory for row counts!') ;
+@.Ran out of memory@>
+ pack_and_send_character ;
+ status[gf_ch_mod_256] := sent ;
+ if pk_loc <> pred_pk_loc then
+ abort('Internal error while writing character!') ;
+@.Internal error@>
+end ;
+othercases bad_gf('Unexpected ',gf_com:1,' command in character definition')
+@.Unexpected command@>
+ endcases ;
+@y
+sixty_four_cases(new_row_0) : do_the_rows:=true;
+sixty_four_cases(new_row_64) : do_the_rows:=true;
+thirty_seven_cases(new_row_128) : do_the_rows:=true;
+@<Specials and |no_op| cases@> ;
+eoc : begin
+ if on = state then put_in_rows(extra) ;
+ if ( row_ptr > 2 ) and ( row[row_ptr - 1] <> end_of_row) then
+ put_in_rows(end_of_row) ;
+ put_in_rows(end_of_char) ;
+ if bad then abort('Ran out of internal memory for row counts!') ;
+@.Ran out of memory@>
+ pack_and_send_character ;
+ status[gf_ch_mod_256] := sent ;
+ if pk_loc <> pred_pk_loc then
+ abort('Internal error while writing character!') ;
+@.Internal error@>
+end ;
+othercases bad_gf('Unexpected ',gf_com:1,' character in character definition');
+ endcases ;
+if do_the_rows then begin
+ do_the_rows:=false;
+ if on = state then put_in_rows(extra) ;
+ put_in_rows(end_of_row) ;
+ on := true ; extra := gf_com - new_row_0 ; state := false ;
+end ;
+@z
+
+@x [60] Add do_the_rows to break up huge run of cases.
+@ A few more locals used above and below:
+
+@<Locals to |convert_gf_file|@>=
+@y
+@ A few more locals used above and below:
+
+@<Locals to |convert_gf_file|@>=
+@!do_the_rows:boolean;
+@z
+
+@x [81] Don't add `GFtoPK 2.3 output from ' to the font comment.
+@d comm_length = 23 {length of |preamble_comment|}
+@d from_length = 6 {length of its |' from '| part}
+@y
+@d comm_length = 0 {length of |preamble_comment|}
+@d from_length = 0 {length of its |' from '| part}
+@z
+
+@x [83] Don't do any assignments to |preamble_comment|.
+@ @<Set init...@>=
+comment := preamble_comment ;
+@y
+@z
+
+@x [86] Remove the final_end label
+final_end : end .
+@y
+end.
+@z
+
+@x System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoPK} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 3; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('gftopk'); {|getopt| has already given an error message.}
+
+ end else if argument_is ('help') then begin
+ usage_help (GFTOPK_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'Tomas Rokicki');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one or two remaining arguments.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ write_ln (stderr, 'gftopk: Need one or two file arguments.');
+ usage ('gftopk');
+ end;
+
+ gf_name := cmdline (optind);
+
+ {If an explicit output filename isn't given, construct it from |gf_name|.}
+ if optind + 2 = argc then begin
+ pk_name := cmdline (optind + 1);
+ end else begin
+ pk_name := basename_change_suffix (gf_name, 'gf', 'pk');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@
+@<Initialize the option...@> =
+verbose := false;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!gf_name, @!pk_name, @!vpl_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/gftopk.rc b/Build/source/texk/web2c/gftopk.rc
new file mode 100644
index 00000000000..285d3f96e2a
--- /dev/null
+++ b/Build/source/texk/web2c/gftopk.rc
@@ -0,0 +1,32 @@
+/* gftopk.rc: gftopk resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " gftopk 2.3"
+
+#define VER_INTERNALNAME_STR "gftopk"
+#define VER_ORIGINALFILENAME_STR "gftopk.exe"
+
+#define VER_FILEDESCRIPTION_STR "GF-toPK file converter"
+
+#include <texlive.version>
+
+/* gftopk.rc ends here */
diff --git a/Build/source/texk/web2c/gftopk.web b/Build/source/texk/web2c/gftopk.web
new file mode 100644
index 00000000000..0812f33109a
--- /dev/null
+++ b/Build/source/texk/web2c/gftopk.web
@@ -0,0 +1,2188 @@
+% This program is by Tomas Rokicki. A few routines were borrowed from
+% GFtoPXL by Arthur Samuel, who borrowed from GFtype by DRF and DEK,
+% who borrowed from DVItype, and so on.
+
+% Version 0.0 (development): started 26 July 1985 TGR.
+% Version 1.0: finished 29 July 1985 TGR.
+% Version 1.1: revised for new pk format 9 August 1985 TGR.
+% Version 1.2: fixed two's complement bug 23 January 1985 TGR.
+% Version 1.3: fixed bounding box calculations and some documentation.
+% 7 September 1986 TGR
+% Version 1.4: fixed row to glyph conversion 14 November 1987 TGR
+% Version 1.5: eliminated semicolons before endcases 12 July 1988 TGR
+% Version 2.0: slightly tuned up for METAFONTware report 17 Apr 1989 DEK/TGR
+% Version 2.1: fixed paint0/endrow bug reported by John Hobby 31 Jul 1989 TGR
+% Version 2.2: minor tune up; retain previous source info 21 Nov 1989 don
+% Version 2.3: fixed a few bugs with selection of preamble types, if
+% gf_ch < 0, or if comp_size = 1016 (both unlikely). Removed some
+% code that would never get executed since bad_gf terminates. Also
+% some other nits that don't really affect functionality. 29 Jul 1990 TGR
+% Bugs and fixes reported by Peter Breitenlohner.
+% Corrected two typos -- 21 Dec 96 (don)
+
+\def\versiondate{29 July 1990}
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\font\tenss=cmss10 % for `The METAFONTbook'
+\def\PASCAL{Pascal}
+\def\ph{{\mc PASCAL-H}}
+\font\logo=manfnt % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+\let\swap=\leftrightarrow
+\def\round{\mathop{\rm round}\nolimits}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+\def\title{GFtoPK}
+\def\contentspagenumber{201}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont GFtoPK} processor}
+ \vskip 15pt
+ \centerline{(Version 2.3, \versiondate)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926, MCS-8300984, and
+ CCR-8610181,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.
+ `{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley
+ Publishing Company.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program reads a \.{GF} file and packs it into a \.{PK} file. \.{PK} files
+are significantly smaller than \.{GF} files, and they are much easier to
+interpret. This program is meant to be the bridge between \MF\ and \.{DVI}
+drivers that read \.{PK} files. Here are some statistics comparing typical
+input and output file sizes:
+
+$$\vbox{
+\halign{#\hfil\quad&\hfil#\qquad&&\hfil#\quad\cr
+Font&\omit\hfil Resolution\hfil\quad
+ &\.{GF} size&\.{PK} size&Reduction factor\cr
+\noalign{\medskip}
+cmr10&300&13200&5484&42\char`\%\cr
+cmr10&360&15342&6496&42\char`\%\cr
+cmr10&432&18120&7808&43\char`\%\cr
+cmr10&511&21020&9440&45\char`\%\cr
+cmr10&622&24880&11492&46\char`\%\cr
+cmr10&746&29464&13912&47\char`\%\cr
+cminch&300&48764&22076&45\char`\%\cr
+}}$$
+It is hoped that the simplicity and small size of the \.{PK} files will make
+them widely accepted.
+
+The \.{PK} format was designed and implemented by Tomas Rokicki during
+@^Rokicki, Tomas Gerhard Paul@>
+the summer of 1985. This program borrows a few routines from \.{GFtoPXL} by
+Arthur Samuel.
+@^Samuel, Arthur Lee@>
+
+The |banner| string defined here should be changed whenever \.{GFtoPK}
+gets modified. The |preamble_comment| macro (near the end of the program)
+should be changed too.
+
+@d banner=='This is GFtoPK, Version 2.3' {printed when the program starts}
+
+@ Some of the diagnostic information is printed using
+|d_print_ln|. When debugging, it should be set the same as
+|print_ln|, defined later.
+@^debugging@>
+
+@d d_print_ln(#)==
+
+@ This program is written in standard \PASCAL, except where it is
+necessary to use extensions; for example, one extension is to use a
+default |case| as in \.{TANGLE}, \.{WEAVE}, etc. All places where
+nonstandard constructions are used should be listed in the index under
+``system dependencies.''
+@!@^system dependencies@>
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The binary input comes from |gf_file|, and the output font is written
+on |pk_file|. All text output is written on \PASCAL's standard |output|
+file. The term |print| is used instead of |write| when this program writes
+on |output|, so that all such output could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program GFtoPK(@!gf_file,@!pk_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{GFtoPK}'s capacity. The values given here should be quite
+adequate for most uses. Assuming an average of about three strokes per
+raster line, there are six run-counts per line, and therefore |max_row|
+will be sufficient for a character 2600 pixels high.
+
+@<Constants...@>=
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!max_row=16000; {largest index in the main |row| array}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+
+@ If the \.{GF} file is badly malformed, the whole process must be aborted;
+\.{GFtoPK} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{GFtoPK}.
+@^system dependencies@>
+
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_gf(#)==abort('Bad GF file: ',#,'!')
+@.Bad GF file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{GFtoPK} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used.
+
+The next few sections of \.{GFtoPK} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{GFtoPK} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+If such codes appear in the \.{GF} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{GFtoPK}.
+So we shall assume that the \PASCAL\ system being used for \.{GFtoPK}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{GFtoPK} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Generic font file format.
+The most important output produced by a typical run of \MF\ is the
+``generic font'' (\.{GF}) file that specifies the bit patterns of the
+characters that have been drawn. The term {\sl generic\/} indicates that
+this file format doesn't match the conventions of any name-brand manufacturer;
+but it is easy to convert \.{GF} files to the special format required by
+almost all digital phototypesetting equipment. There's a strong analogy
+between the \.{DVI} files written by \TeX\ and the \.{GF} files written
+by \MF; and, in fact, the file formats have a lot in common.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`|boc|' (beginning of character) command has six parameters, each of
+which is four bytes long. Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a |boc| command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an |eoc| command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each |eoc| command is immediately followed by a
+|boc| command, or by a |post| command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+@ The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~|m|; and (b)~the current row number,~|n|. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to get extremely large, but the \.{GF} format tries to be more
+general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising
+the region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
+coordinates |(x,y)| satisfy |m<=x<=m+1| and |n<=y<=n+1|. Negative values of
+|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of |n| and~|y| correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides |m| and |n|, there's also a third aspect of the current
+state, namely the @!|paint_switch|, which is always either \\{black} or
+\\{white}. Each \\{paint} command advances |m| by a specified amount~|d|,
+and blackens the intervening pixels if |paint_switch=black|; then
+the |paint_switch| changes to the opposite state. \.{GF}'s commands are
+designed so that |m| will never decrease within a row, and |n| will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened.
+
+@ Here is a list of all the commands that may appear in a \.{GF} file. Each
+command is specified by its symbolic name (e.g., |boc|), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|d[2]|' means that parameter |d| is two bytes long.
+
+\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
+nothing but change the |paint_switch| from \\{black} to \\{white} or
+vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with |d=1| to~63, defined as follows: If
+|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
+in columns |m| through |m+d-1| inclusive. Then, in any case,
+complement the |paint_switch| and advance |m| by~|d|.
+
+\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
+value of~|d|; \MF\ uses it to paint when |64<=d<256|.
+
+\yskip\hang|@!paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
+as~65535.
+
+\yskip\hang|@!paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
+|max_n[4]|. Beginning of a character: Here |c| is the character code, and
+|p| points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer |p| is |-1| if there was no
+prior character with an equivalent code.) The values of registers |m| and |n|
+defined by the instructions that follow for this character must
+satisfy |min_m<=m<=max_m| and |min_n<=n<=max_n|. (The values of |max_m| and
+|min_n| need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
+initialize the bounds of an array. Then it sets |m:=min_m|, |n:=max_n|, and
+|paint_switch:=white|.
+
+\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
+Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
+and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)
+
+\yskip\hang|eoc| 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have |eoc| immediately following |boc|.
+
+\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=white|. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m:=min_m|, and set
+|paint_switch:=white|. This is a way to produce |d| all-white rows.
+
+\yskip\hang|@!skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
+as 65535.
+
+\yskip\hang|@!skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=black|. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
+|new_row_0|, but with |m:=min_m+1| through |min_m+164|, respectively.
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear within characters,
+in \.{GF} files generated by other
+processors. It is recommended that |x| be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang|@!xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
+ridiculously large; |k| mustn't be negative.
+
+\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
+it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang|no_op| 244. No operation, do nothing. Any number of |no_op|'s
+may occur between \.{GF} commands, but a |no_op| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
+This command will appear only in the postamble, which will be explained
+shortly.
+
+\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
+Same as |char_loc|, except that |dy| is assumed to be zero, and the value
+of~|dx| is taken to be |65536*dm|, where |0<=dm<256|.
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter |i| is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first |boc|.)
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}
+
+@ Here are the opcodes that \.{GFtoPK} actually refers to.
+
+@d paint_0=0 {beginning of the \\{paint} commands}
+@d paint1=64 {move right a given number of columns, then
+ black${}\swap{}$white}
+@d boc=67 {beginning of a character}
+@d boc1=68 {abbreviated |boc|}
+@d eoc=69 {end of a character}
+@d skip0=70 {skip no blank rows}
+@d skip1=71 {skip over blank rows}
+@d new_row_0=74 {move down one row and then right}
+@d max_new_row=238 {move down one row and then right}
+@d xxx1=239 {for \&{special} strings}
+@d yyy=243 {for \&{numspecial} numbers}
+@d no_op=244 {no operation}
+@d char_loc=245 {character locators in the postamble}
+@d char_loc0=246 {character locators in the postamble}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The last character in a \.{GF} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
+ |@!min_m[4]| |@!max_m[4]| |@!min_n[4]| |@!max_n[4]|\cr
+ $\langle\,$character locators$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the byte following the final |eoc| in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The |ds| and |cs| parameters
+@^design size@> @^check sum@>
+give the design size and check sum, respectively, which are exactly the
+values put into the header of any \.{TFM} file that shares information with
+this \.{GF} file. Parameters |hppp| and |vppp| are the ratios of
+pixels per point, horizontally and vertically, expressed as |scaled| integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
+registers |m| and~|n| assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; |max_m| and |min_n| may, on the
+other hand, be tighter than the similar bounds in |boc| commands. For
+example, some character may have |min_n=-100| in its |boc|, but it might
+turn out that |n| never gets lower than |-50| in any character; then
+|min_n| can have any value |<=-50|. If there are no characters in the file,
+it's possible to have |min_m>max_m| and/or |min_n>max_n|.)
+
+@ Character locators are introduced by |char_loc| commands,
+which specify a character residue~|c|, character escapements (|dx,dy|),
+a character width~|w|, and a pointer~|p|
+to the beginning of that character. (If two or more characters have the
+same code~|c| modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+The character escapements (|dx,dy|) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of |scaled| pixels;
+i.e., |dx| is in horizontal pixel units times $2^{16}$, and |dy| is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, |dy|
+should be zero, but other document file formats allow nonzero vertical
+escapement.
+
+The character width~|w| duplicates the information in the \.{TFM} file; it
+is $2^{24}$ times the ratio of the true width to the font's design size.
+
+The backpointer |p| points to the character's |boc|, or to the first of
+a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
+immediately precede the |boc|, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about |p| applies also to the backpointers
+in |boc| commands, even though it wasn't explained in the description
+of~|boc|. @^backpointers@>
+
+Pointer |p| might be |-1| if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had |proofing<0| when the character was being shipped out,
+but then made |proofing>=0| in order to get a \.{GF} file.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the character locators, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~131, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual
+characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating
+systems. \.{GFtoPK} first reads the postamble, and then scans the file from
+front to back.
+
+@* Packed file format.
+The packed file format is a compact representation of the data contained in a
+\.{GF} file. The information content is the same, but packed (\.{PK}) files
+are almost always less than half the size of their \.{GF} counterparts. They
+are also easier to convert into a raster representation because they do not
+have a profusion of \\{paint}, \\{skip}, and \\{new\_row} commands to be
+separately interpreted. In addition, the \.{PK} format expressly forbids
+\&{special} commands within a character. The minimum bounding box for each
+character is explicit in the format, and does not need to be scanned for as in
+the \.{GF} format. Finally, the width and escapement values are combined with
+the raster information into character ``packets'', making it simpler in many
+cases to process a character.
+
+A \.{PK} file is organized as a stream of 8-bit bytes. At times, these bytes
+might be split into 4-bit nybbles or single bits, or combined into multiple
+byte parameters. When bytes are split into smaller pieces, the `first' piece
+is always the most significant of the byte. For instance, the first bit of
+a byte is the bit with value 128; the first nybble can be found by dividing
+a byte by 16. Similarly, when bytes are combined into multiple byte
+parameters, the first byte is the most significant of the parameter. If the
+parameter is signed, it is represented by two's-complement notation.
+
+The set of possible eight-bit values is separated into two sets, those that
+introduce a character definition, and those that do not. The values that
+introduce a character definition range from 0 to 239; byte values
+above 239 are interpreted as commands. Bytes that introduce character
+definitions are called flag bytes, and various fields within the byte indicate
+various things about how the character definition is encoded. Command bytes
+have zero or more parameters, and can never appear within a character
+definition or between parameters of another command, where they would be
+interpeted as data.
+
+A \.{PK} file consists of a preamble, followed by a sequence of one or more
+character definitions, followed by a postamble. The preamble command must
+be the first byte in the file, followed immediately by its parameters.
+Any number of character definitions may follow, and any command but the
+preamble command and the postamble command may occur between character
+definitions. The very last command in the file must be the postamble.
+
+@ The packed file format is intended to be easy to read and interpret by
+device drivers. The small size of the file reduces the input/output overhead
+each time a font is loaded. For those drivers that load and save each font
+file into memory, the small size also helps reduce the memory requirements.
+The length of each character packet is specified, allowing the character raster
+data to be loaded into memory by simply counting bytes, rather than
+interpreting each command; then, each character can be interpreted on a demand
+basis. This also makes it possible for a driver to skip a particular
+character quickly if it knows that the character is unused.
+
+@ First, the command bytes will be presented; then the format of the
+character definitions will be defined. Eight of the possible sixteen
+commands (values 240 through 255) are currently defined; the others are
+reserved for future extensions. The commands are listed below. Each command
+is specified by its symbolic name (e.g., \\{pk\_no\_op}), its opcode byte,
+and any parameters. The parameters are followed by a bracketed number
+telling how many bytes they occupy, with the number preceded by a plus sign if
+it is a signed quantity. (Four byte quantities are always signed, however.)
+
+\yskip\hang|pk_xxx1| 240 |k[1]| |x[k]|. This command is undefined in general;
+it functions as a $(k+2)$-byte \\{no\_op} unless special \.{PK}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string. It is recommended that |x| be a string having the form
+of a keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang\\{pk\_xxx2} 241 |k[2]| |x[k]|. Like |pk_xxx1|, but |0<=k<65536|.
+
+\yskip\hang\\{pk\_xxx3} 242 |k[3]| |x[k]|. Like |pk_xxx1|, but
+|0<=k<@t$2^{24}$@>|. \MF\ uses this when sending a \&{special} string whose
+length exceeds~255.
+
+\yskip\hang\\{pk\_xxx4} 243 |k[4]| |x[k]|. Like |pk_xxx1|, but |k| can be
+ridiculously large; |k| musn't be negative.
+
+\yskip\hang|pk_yyy| 244 |y[4]|. This command is undefined in general; it
+functions as a five-byte \\{no\_op} unless special \.{PK} reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a result of
+\&{numspecial} commands; the intent is to provide numeric parameters to
+\\{xxx} commands that immediately precede.
+
+\yskip\hang|pk_post| 245. Beginning of the postamble. This command is
+followed by enough |pk_no_op| commands to make the file a multiple
+of four bytes long. Zero through three bytes are usual, but any number
+is allowed.
+This should make the file easy to read on machines that pack four bytes to
+a word.
+
+\yskip\hang|pk_no_op| 246. No operation, do nothing. Any number of
+|pk_no_op|'s may appear between \.{PK} commands, but a |pk_no_op| cannot be
+inserted between a command and its parameters, between two parameters, or
+inside a character definition.
+
+\yskip\hang|pk_pre| 247 |i[1]| |k[1]| |x[k]| |ds[4]| |cs[4]| |hppp[4]|
+|vppp[4]|. Preamble command. Here, |i| is the identification byte of the
+file, currently equal to 89. The string |x| is merely a comment, usually
+indicating the source of the \.{PK} file. The parameters |ds| and |cs| are
+the design size of the file in $1/2^{20}$ points, and the checksum of the
+file, respectively. The checksum should match the \.{TFM} file and the
+\.{GF} files for this font. Parameters |hppp| and |vppp| are the ratios
+of pixels per point, horizontally and vertically, multiplied by $2^{16}$; they
+can be used to correlate the font with specific device resolutions,
+magnifications, and ``at sizes''. Usually, the name of the \.{PK} file is
+formed by concatenating the font name (e.g., cmr10) with the resolution at
+which the font is prepared in pixels per inch multiplied by the magnification
+factor, and the letters \.{pk}. For instance, cmr10 at 300 dots per inch
+should be named \.{cmr10.300pk}; at one thousand dots per inch and magstephalf,
+it should be named \.{cmr10.1095pk}.
+
+@ We put a few of the above opcodes into definitions for symbolic use by
+this program.
+
+@d pk_id = 89 {the version of \.{PK} file described}
+@d pk_xxx1 = 240 {\&{special} commands}
+@d pk_yyy = 244 {\&{numspecial} commands}
+@d pk_post = 245 {postamble}
+@d pk_no_op = 246 {no operation}
+@d pk_pre = 247 {preamble}
+
+@ The \.{PK} format has two conflicting goals: to pack character raster and
+size information as compactly as possible, while retaining ease of translation
+into raster and other forms. A suitable compromise was found in the use of
+run-encoding of the raster information. Instead of packing the individual
+bits of the character, we instead count the number of consecutive `black' or
+`white' pixels in a horizontal raster row, and then encode this number. Run
+counts are found for each row from left to right, traversing rows from the
+top to bottom. This is essentially the way the \.{GF} format works.
+Instead of presenting each row individually, however, we concatenate all
+of the horizontal raster rows into one long string of pixels, and encode this
+row. With knowledge of the width of the bit-map, the original character glyph
+can easily be reconstructed. In addition, we do not need special commands to
+mark the end of one row and the beginning of the next.
+
+Next, we place the burden of finding the minimum bounding box on the part
+of the font generator, since the characters will usually be used much more
+often than they are generated. The minimum bounding box is the smallest
+rectangle that encloses all `black' pixels of a character. We also
+eliminate the need for a special end of character marker, by supplying
+exactly as many bits as are required to fill the minimum bounding box, from
+which the end of the character is implicit.
+
+Let us next consider the distribution of the run counts. Analysis of several
+dozen pixel files at 300 dots per inch yields a distribution peaking at four,
+falling off slowly until ten, then a bit more steeply until twenty, and then
+asymptotically approaching the horizontal. Thus, the great majority of our
+run counts will fit in a four-bit nybble. The eight-bit byte is attractive for
+our run-counts, as it is the standard on many systems; however, the wasted four
+bits in the majority of cases seem a high price to pay. Another possibility
+is to use a Huffman-type encoding scheme with a variable number of bits for
+each run-count; this was rejected because of the overhead in fetching and
+examining individual bits in the file. Thus, the character raster definitions
+in the \.{PK} file format are based on the four-bit nybble.
+
+@ An analysis of typical pixel files yielded another interesting statistic:
+Fully 37\char`\%\
+of the raster rows were duplicates of the previous row. Thus, the \.{PK}
+format allows the specification of repeat counts, which indicate how many times
+a horizontal raster row is to be repeated. These repeated rows are taken out
+of the character glyph before individual rows are concatenated into the long
+string of pixels.
+
+For elegance, we disallow a run count of zero. The case of a null raster
+description should be gleaned from the character width and height being equal
+to zero, and no raster data should be read. No other zero counts are ever
+necessary. Also, in the absence of repeat counts, the repeat value is set to
+be zero (only the original row is sent.) If a repeat count is seen, it takes
+effect on the current row. The current row is defined as the row on which the
+first pixel of the next run count will lie. The repeat count is set back to
+zero when the last pixel in the current row is seen, and the row is sent out.
+
+This poses a problem for entirely black and entirely white rows, however. Let
+us say that the current row ends with four white pixels, and then we have five
+entirely empty rows, followed by a black pixel at the beginning of the next
+row, and the character width is ten pixels. We would like to use a repeat
+count, but there is no legal place to put it. If we put it before the white
+run count, it will apply to the current row. If we put it after, it applies
+to the row with the black pixel at the beginning. Thus, entirely white or
+entirely black repeated rows are always packed as large run counts (in this
+case, a white run count of 54) rather than repeat counts.
+
+@ Now we turn our attention to the actual packing of the run counts and
+repeat counts into nybbles. There are only sixteen possible nybble values.
+We need to indicate run counts and repeat counts. Since the run counts are
+much more common, we will devote the majority of the nybble values to them.
+We therefore indicate a repeat count by a nybble of 14 followed by a packed
+number, where a packed number will be explained later. Since the repeat
+count value of one is so common, we indicate a repeat one command by a single
+nybble of 15. A 14 followed by the packed number 1 is still legal for a
+repeat one count. The run counts are coded directly as packed
+numbers.
+
+For packed numbers, therefore, we have the nybble values 0 through 13. We
+need to represent the positive integers up to, say, $2^{31}-1$. We would
+like the more common smaller numbers to take only one or two nybbles, and
+the infrequent large numbers to take three or more. We could therefore
+allocate one nybble value to indicate a large run count taking three or more
+nybbles. We do this with the value 0.
+
+@ We are left with the values 1 through 13. We can allocate some of these, say
+|dyn_f|, to be one-nybble run counts.
+These will work for the run counts |1..dyn_f|. For subsequent run
+counts, we will use a nybble greater than |dyn_f|, followed by a second nybble,
+whose value can run from 0 through 15. Thus, the two-nybble values will
+run from |dyn_f+1..(13-dyn_f)*16+dyn_f|. We have our definition of large run
+count values now, being all counts greater than |(13-dyn_f)*16+dyn_f|.
+
+We can analyze our several dozen pixel files and determine an optimal value of
+|dyn_f|, and use this value for all of the characters. Unfortunately, values
+of |dyn_f| that pack small characters well tend to pack the large characters
+poorly, and values that pack large characters well are not efficient for the
+smaller characters. Thus, we choose the optimal |dyn_f| on a character basis,
+picking the value that will pack each individual character in the smallest
+number of nybbles. Legal values of |dyn_f| run from 0 (with no one-nybble run
+counts) to 13 (with no two-nybble run counts).
+
+@ Our only remaining task in the coding of packed numbers is the large run
+counts. We use a scheme suggested by D.~E.~Knuth
+@^Knuth, Donald Ervin@>
+that simply and elegantly represents arbitrarily large values. The
+general scheme to represent an integer |i| is to write its hexadecimal
+representation, with leading zeros removed. Then we count the number of
+digits, and prepend one less than that many zeros before the hexadecimal
+representation. Thus, the values from one to fifteen occupy one nybble;
+the values sixteen through 255 occupy three, the values 256 through 4095
+require five, etc.
+
+For our purposes, however, we have already represented the numbers one
+through |(13-dyn_f)*16+dyn_f|. In addition, the one-nybble values have
+already been taken by our other commands, which means that only the values
+from sixteen up are available to us for long run counts. Thus, we simply
+normalize our long run counts, by subtracting |(13-dyn_f)*16+dyn_f+1| and
+adding 16, and then we represent the result according to the scheme above.
+
+@ The final algorithm for decoding the run counts based on the above scheme
+might look like this, assuming that a procedure called \\{get\_nyb} is
+available to get the next nybble from the file, and assuming that the global
+|repeat_count| indicates whether a row needs to be repeated. Note that this
+routine is recursive, but since a repeat count can never directly follow
+another repeat count, it can only be recursive to one level.
+
+@p@{ function pk_packed_num : integer ;
+var i,@!j : integer ;
+begin
+ i := get_nyb ;
+ if i = 0 then begin
+ repeat j := get_nyb ; incr(i) ; until j <> 0 ;
+ while i > 0 do begin j := j * 16 + get_nyb ; decr(i) ; end ;
+ pk_packed_num := j - 15 + (13-dyn_f)*16 + dyn_f ;
+ end else if i <= dyn_f then
+ pk_packed_num := i
+ else if i < 14 then
+ pk_packed_num := (i-dyn_f-1)*16+get_nyb+dyn_f+1
+ else begin
+ if i = 14 then
+ repeat_count := pk_packed_num
+ else
+ repeat_count := 1 ;
+ pk_packed_num := pk_packed_num ;
+ end ;
+end ; @}
+
+@ For low resolution fonts, or characters with `gray' areas, run encoding can
+often make the character many times larger. Therefore, for those characters
+that cannot be encoded efficiently with run counts, the \.{PK} format allows
+bit-mapping of the characters. This is indicated by a |dyn_f| value of
+14. The bits are packed tightly, by concatenating all of the horizontal raster
+rows into one long string, and then packing this string eight bits to a byte.
+The number of bytes required can be calculated by |(width*height+7) div 8|.
+This format should only be used when packing the character by run counts takes
+more bytes than this, although, of course, it is legal for any character.
+Any extra bits in the last byte should be set to zero.
+
+@ At this point, we are ready to introduce the format for a character
+descriptor. It consists of three parts: a flag byte, a character preamble,
+and the raster data. The most significant four bits of the flag byte
+yield the |dyn_f| value for that character. (Notice that only values of
+0 through 14 are legal for |dyn_f|, with 14 indicating a bit mapped character;
+thus, the flag bytes do not conflict with the command bytes, whose upper nybble
+is always 15.) The next bit (with weight 8) indicates whether the first run
+count is a black count or a white count, with a one indicating a black count.
+For bit-mapped characters, this bit should be set to a zero. The next bit
+(with weight 4) indicates whether certain later parameters (referred to as size
+parameters) are given in one-byte or two-byte quantities, with a one indicating
+that they are in two-byte quantities. The last two bits are concatenated on to
+the beginning of the packet-length parameter in the character preamble,
+which will be explained below.
+
+However, if the last three bits of the flag byte are all set (normally
+indicating that the size parameters are two-byte values and that a 3 should be
+prepended to the length parameter), then a long format of the character
+preamble should be used instead of one of the short forms.
+
+Therefore, there are three formats for the character preamble; the one that
+is used depends on the least significant three bits of the flag byte. If the
+least significant three bits are in the range zero through three, the short
+format is used. If they are in the range four through six, the extended short
+format is used. Otherwise, if the least significant bits are all set, then
+the long form of the character preamble is used. The preamble formats are
+explained below.
+
+\yskip\hang Short form: |flag[1]| |pl[1]| |cc[1]| |tfm[3]| |dm[1]| |w[1]|
+|h[1]| |hoff[+1]| |voff[+1]|.
+If this format of the character preamble is used, the above
+parameters must all fit in the indicated number of bytes, signed or unsigned
+as indicated. Almost all of the standard \TeX\ font characters fit; the few
+exceptions are fonts such as \.{cminch}.
+
+\yskip\hang Extended short form: |flag[1]| |pl[2]| |cc[1]| |tfm[3]| |dm[2]|
+|w[2]| |h[2]| |hoff[+2]| |voff[+2]|. Larger characters use this extended
+format.
+
+\yskip\hang Long form: |flag[1]| |pl[4]| |cc[4]| |tfm[4]| |dx[4]| |dy[4]|
+|w[4]| |h[4]| |hoff[4]| |voff[4]|. This is the general format that
+allows all of the
+parameters of the \.{GF} file format, including vertical escapement.
+\vskip\baselineskip
+The |flag| parameter is the flag byte. The parameter |pl| (packet length)
+contains the offset
+of the byte following this character descriptor, with respect to the beginning
+of the |tfm| width parameter. This is given so a \.{PK} reading program can,
+once it has read the flag byte, packet length, and character code (|cc|), skip
+over the character by simply reading this many more bytes. For the two short
+forms of the character preamble, the last two bits of the flag byte should be
+considered the two most-significant bits of the packet length. For the short
+format, the true packet length might be calculated as |(flag mod 4)*256+pl|;
+for the short extended format, it might be calculated as
+|(flag mod 4)*65536+pl|.
+
+The |w| parameter is the width and the |h| parameter is the height in pixels
+of the minimum bounding box. The |dx| and |dy| parameters are the horizontal
+and vertical escapements, respectively. In the short formats, |dy| is assumed
+to be zero and |dm| is |dx| but in pixels;
+in the long format, |dx| and |dy| are both
+in pixels multiplied by $2^{16}$. The |hoff| is the horizontal offset from the
+upper left pixel to the reference pixel; the |voff| is the vertical offset.
+They are both given in pixels, with right and down being positive. The
+reference pixel is the pixel that occupies the unit square in \MF; the
+\MF\ reference point is the lower left hand corner of this pixel. (See the
+example below.)
+
+@ \TeX\ requires all characters that have the same character codes
+modulo 256 to have also the same |tfm| widths and escapement values. The \.{PK}
+format does not itself make this a requirement, but in order for the font to
+work correctly with the \TeX\ software, this constraint should be observed.
+(The standard version of \TeX\ cannot output character codes greater
+than 255, but extended versions do exist.)
+
+Following the character preamble is the raster information for the
+character, packed by run counts or by bits, as indicated by the flag byte.
+If the character is packed by run counts and the required number of nybbles
+is odd, then the last byte of the raster description should have a zero
+for its least significant nybble.
+
+@ As an illustration of the \.{PK} format, the character \char4\ from the font
+amr10 at 300 dots per inch will be encoded. This character was chosen
+because it illustrates some
+of the borderline cases. The raster for the character looks like this (the
+row numbers are chosen for convenience, and are not \MF's row numbers.)
+
+\vskip\baselineskip
+{\def\smbox{\vrule height 7pt width 7pt depth 0pt \hskip 3pt}%
+\catcode`\*=\active \let*=\smbox
+\centerline{\vbox{\baselineskip=10pt
+\halign{\hfil#\quad&&\hfil#\hfil\cr
+0& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+1& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+2& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+3& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+4& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+5& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+6& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+7\cr
+8\cr
+9& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+10& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+11& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+12& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+13& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+14& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+15& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+16& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+17& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+18& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+19\cr
+20\cr
+21\cr
+22& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+23& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+24& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+25& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+26& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+27& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+28&+& &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+&\hphantom{*}&\hphantom{*}\cr
+}}}}
+The width of the minimum bounding box for this character is 20; its height
+is 29. The `+' represents the reference pixel; notice how it lies outside the
+minimum bounding box. The |hoff| value is $-2$, and the |voff| is~28.
+
+The first task is to calculate the run counts and repeat counts. The repeat
+counts are placed at the first transition (black to white or white to black)
+in a row, and are enclosed in brackets. White counts are enclosed in
+parentheses. It is relatively easy to generate the counts list:
+\vskip\baselineskip
+\centerline{82 [2] (16) 2 (42) [2] 2 (12) 2 (4) [3]}
+\centerline{16 (4) [2] 2 (12) 2 (62) [2] 2 (16) 82}
+\vskip\baselineskip
+Note that any duplicated rows that are not all white or all black are removed
+before the run counts are calculated. The rows thus removed are rows 5, 6,
+10, 11, 13, 14, 15, 17, 18, 23, and 24.
+
+@ The next step in the encoding of this character is to calculate the optimal
+value of |dyn_f|. The details of how this calculation is done are not
+important here; suffice it to say that there is a simple algorithm that can
+determine the best value of |dyn_f| in one pass over the count list. For this
+character, the optimal value turns out to be 8 (atypically low). Thus, all
+count values less than or equal to 8 are packed in one nybble; those from
+nine to $(13-8)*16+8$ or 88 are packed in two nybbles. The run encoded values
+now become (in hex, separated according to the above list):
+\vskip\baselineskip
+\centerline{\tt D9 E2 97 2 B1 E2 2 93 2 4 E3}
+\centerline{\tt 97 4 E2 2 93 2 C5 E2 2 97 D9}
+\vskip\baselineskip\noindent
+which comes to 36 nybbles, or 18 bytes. This is shorter than the 73 bytes
+required for the bit map, so we use the run count packing.
+
+@ The short form of the character preamble is used because all of the
+parameters fit in their respective lengths. The packet length is therefore
+18 bytes for the raster, plus
+eight bytes for the character preamble parameters following the character
+code, or 26. The |tfm| width for this character is 640796, or {\tt 9C71C} in
+hexadecimal. The horizontal escapement is 25 pixels. The flag byte is
+88 hex, indicating the short preamble, the black first count, and the
+|dyn_f| value of 8. The final total character packet, in hexadecimal, is:
+\vskip\baselineskip
+$$\vbox{\halign{\hfil #\quad&&{\tt #\ }\cr
+Flag byte&88\cr
+Packet length&1A\cr
+Character code&04\cr
+|tfm| width&09&C7&1C\cr
+Horizontal escapement (pixels)&19\cr
+Width of bit map&14\cr
+Height of bit map&1D\cr
+Horizontal offset (signed)&FE\cr
+Vertical offset&1C\cr
+Raster data&D9&E2&97\cr
+&2B&1E&22\cr
+&93&24&E3\cr
+&97&4E&22\cr
+&93&2C&5E\cr
+&22&97&D9\cr}}$$
+
+@* Input and output for binary files.
+We have seen that a \.{GF} file is a sequence of 8-bit bytes. The bytes
+appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo. The \.{PK} file is also a sequence of 8-bit bytes.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{GFtoPK} is written in standard \PASCAL.
+@^system dependencies@>
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with two binary file variables: |gf_file| is the
+input file that we are translating into \.{PK} format, to be written
+on |pk_file|.
+
+@<Glob...@>=
+@!gf_file:byte_file; {the stuff we are \.{GFtoPK}ing}
+@!pk_file:byte_file; {the stuff we have \.{GFtoPK}ed}
+
+@ To prepare the |gf_file| for input, we |reset| it.
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file);
+gf_loc := 0 ;
+end;
+
+@ To prepare the |pk_file| for output, we |rewrite| it.
+
+@p procedure open_pk_file; {prepares to write packed bytes in |pk_file|}
+begin rewrite(pk_file);
+pk_loc := 0 ; pk_open := true ;
+end;
+
+@ The variable |pk_loc| contains the number of the byte about to
+be written to the |pk_file|, and |gf_loc| is the byte about to be read
+from the |gf_file|. Also, |pk_open| indicates that the packed file has
+been opened and is ready for output.
+
+@<Glob...@>=
+@!pk_loc:integer; {where we are about to write, in |pk_file|}
+@!gf_loc:integer; {where are we in the |gf_file|}
+@!pk_open:boolean; {is the packed file open?}
+
+@ We do not open the |pk_file| until after the postamble of the |gf_file|
+has been read. This can be used, for instance, to calculate a resolution
+to put in the suffix of the |pk_file| name. This also means, however, that
+specials in the postamble (which \MF\ never generates) do not get sent to
+the |pk_file|.
+
+@<Set init...@>=
+pk_open := false ;
+
+@ We shall use two simple functions to read the next byte or
+bytes from |gf_file|. We either need to get an individual byte or a
+set of four bytes.
+@^system dependencies@>
+
+@p function gf_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then bad_gf('Unexpected end of file!')
+@.Unexpected end of file@>
+else begin read(gf_file,b); gf_byte:=b;
+ end;
+incr(gf_loc);
+end;
+@#
+function gf_signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+if a<128 then gf_signed_quad:=((a*256+b)*256+c)*256+d
+else gf_signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+gf_loc := gf_loc + 4 ;
+end;
+
+@ We also need a few routines to write data to the \.{PK} file. We write
+data in 4-, 8-, 16-, 24-, and 32-bit chunks, so we define the appropriate
+routines. We must be careful not to let the sign bit mess us up, as some
+\PASCAL s implement division of a negative integer differently.
+
+@p procedure pk_byte(a:integer) ;
+begin
+ if pk_open then begin
+ if a < 0 then a := a + 256 ;
+ write(pk_file, a) ;
+ incr(pk_loc) ;
+ end ;
+end ;
+@#
+procedure pk_halfword(a:integer) ;
+begin
+ if a < 0 then a := a + 65536 ;
+ write(pk_file, a div 256) ;
+ write(pk_file, a mod 256) ;
+ pk_loc := pk_loc + 2 ;
+end ;
+@#
+procedure pk_three_bytes(a:integer);
+begin
+ write(pk_file, a div 65536 mod 256) ;
+ write(pk_file, a div 256 mod 256) ;
+ write(pk_file, a mod 256) ;
+ pk_loc := pk_loc + 3 ;
+end ;
+@#
+procedure pk_word(a:integer) ;
+var b : integer ;
+begin
+ if pk_open then begin
+ if a < 0 then begin
+ a := a + @'10000000000 ;
+ a := a + @'10000000000 ;
+ b := 128 + a div 16777216 ;
+ end else b := a div 16777216 ;
+ write(pk_file, b) ;
+ write(pk_file, a div 65536 mod 256) ;
+ write(pk_file, a div 256 mod 256) ;
+ write(pk_file, a mod 256) ;
+ pk_loc := pk_loc + 4 ;
+ end ;
+end ;
+@#
+procedure pk_nyb(a:integer) ;
+begin
+ if bit_weight = 16 then begin
+ output_byte := a * 16 ;
+ bit_weight := 1 ;
+ end else begin
+ pk_byte(output_byte + a) ;
+ bit_weight := 16 ;
+ end ;
+end ;
+
+@ We need the globals |bit_weight| and |output_byte| for buffering.
+
+@<Glob...@>=
+@!bit_weight : integer ; {output bit weight}
+@!output_byte : integer ; {output byte for pk file}
+
+@ Finally we come to the routines that are used for random access of the
+|gf_file|. To correctly find and read the postamble of the file, we need
+two routines, one to find the length of the |gf_file|, and one to position
+the |gf_file|. We assume that the first byte of the file is numbered zero.
+
+Such routines are, of course, highly system dependent. They are implemented
+here in terms of two assumed system routines called |set_pos| and |cur_pos|.
+The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is negative
+or larger than the total number of items in |f|; in the latter case,
+|set_pos(f,n)| moves to the end of file |f|. The call |cur_pos(f)| gives the
+total number of items in |f|, if |eof(f)| is true; we use |cur_pos| only in
+such a situation.
+@^system dependencies@>
+
+@p procedure find_gf_length ;
+begin
+ set_pos(gf_file, -1) ; gf_len := cur_pos(gf_file) ;
+end ;
+@#
+procedure move_to_byte(@!n : integer) ;
+begin
+ set_pos(gf_file, n); gf_loc := n ;
+end ;
+
+@ The global |gf_len| contains the final total length of the |gf_file|.
+
+@<Glob...@>=
+@!gf_len : integer ; {length of |gf_file|}
+
+@* Plan of attack.
+It would seem at first that converting a \.{GF} file to \.{PK} format should
+be relatively easy, since they both use a form of run-encoding. Unfortunately,
+several idiosyncracies of the \.{GF} format make this conversion slightly
+cumbersome.
+The \.{GF} format separates the raster information from the escapement values
+and \.{TFM} widths; the \.{PK} format combines all information about a single
+character into one character packet. The \.{GF} run-encoding is
+on a row-by-row basis, and the \.{PK} format is on a glyph basis, as if all
+of the raster rows in the glyph were concatenated into one long row. The
+encoding of the run-counts in the \.{GF} files is fixed, whereas the \.{PK}
+format uses a dynamic encoding scheme that must be adjusted for each
+character. And,
+finally, any repeated rows can be marked and sent with a single command in
+the \.{PK} format.
+
+There are four major steps in the conversion process. First, the postamble
+of the |gf_file| is found and read, and the data from the character locators
+is stored in memory. Next, the preamble of the |pk_file| is written. The
+third and by far
+the most difficult step reads the raster representation of all of the
+characters from the \.{GF} file, packs them, and writes them to the |pk_file|.
+Finally, the postamble is written to the |pk_file|.
+
+The conversion of the character raster information from the |gf_file| to the
+format required by the |pk_file| takes several smaller steps.
+The \.{GF} file is read, the commands are interpreted, and the run
+counts are stored in the working |row| array. Each row is terminated by a
+|end_of_row| value, and the character glyph is terminated by an
+|end_of_char| value. Then, this representation of the character glyph
+is scanned to determine the minimum bounding box in which it will fit,
+correcting the |min_m|, |max_m|, |min_n|, and |max_n| values, and calculating
+the offset values. The third sub-step is to restructure the row list from
+a list based on rows to a list based on the entire glyph. Then, an optimal
+value of |dyn_f| is calculated, and the final
+size of the counts is found for the \.{PK} file format, and compared with
+the bit-wise packed glyph. If the run-encoding scheme is shorter, the
+character is written to the |pk_file| as row counts; otherwise, it is written
+using a bit-packed scheme.
+
+To save various information while the \.{GF} file is being loaded, we need
+several arrays. The |tfm_width|, |dx|, and |dy| arrays store the obvious
+values. The |status| array contains
+the current status of the particular character. A value of 0 indicates
+that the character has never been defined; a 1 indicates that the character
+locator for that character was read in; and a 2 indicates that the raster
+information for at least
+one character was read from the |gf_file| and written to the |pk_file|.
+The |row| array contains row counts. It is filled anew
+for each character, and is used as a general workspace. The \.{GF} counts are
+stored starting at location 2 in this array, so that the \.{PK} counts can be
+written to the same array, overwriting the \.{GF} counts, without destroying
+any counts before they are used. (A possible repeat count in the first row
+might make the first row of the \.{PK} file one count longer; all succeeding
+rows are guaranteed to be the same length or shorter because of the
+|end_of_row| flags in the \.{GF} format that are unnecessary in the \.{PK}
+format.)
+
+@d virgin==0 {never heard of this character yet}
+@d located==1 {locators read for this character}
+@d sent==2 {at least one of these characters has been sent}
+
+@<Glob...@>=
+@!tfm_width: array[0..255] of integer; {the \.{TFM} widths of characters}
+@!dx, @!dy: array[0..255] of integer; {the horizontal and vertical escapements}
+@!status: array[0..255] of virgin..sent; {character status}
+@!row: array[0..max_row] of integer; {the row counts for working}
+
+@ Here we initialize all of the character |status| values to |virgin|.
+
+@<Set init...@>=
+for i := 0 to 255 do
+ status[i] := virgin ;
+
+@ And, finally, we need to define the |end_of_row| and |end_of_char| values.
+These cannot be values that can be taken on either by legitimate run counts,
+even when wrapping around an entire character. Nor can they be values that
+repeat counts can take on. Since repeat counts can be arbitrarily large, we
+restrict ourselves to negative values whose absolute values are greater than
+the largest possible repeat count.
+
+@d end_of_row==(-99999) {indicates the end of a row}
+@d end_of_char==(-99998) {indicates the end of a character}
+
+@* Reading the generic font file.
+There are two major procedures in this program that do all of the work.
+The first is |convert_gf_file|, which interprets the \.{GF} commands and
+puts row counts into the |row| array. The second, which we only
+anticipate at the moment, actually packs the row counts into nybbles and
+writes them to the packed file.
+
+@p @<Packing procedures@> ;
+procedure convert_gf_file;
+var
+ @!i, @!j, @!k : integer ; {general purpose indices}
+ @!gf_com : integer ; {current gf command}
+ @<Locals to |convert_gf_file|@>
+begin
+ open_gf_file ;
+ if gf_byte <> pre then bad_gf('First byte is not preamble');
+@.First byte is not preamble@>
+ if gf_byte <> gf_id_byte then
+ bad_gf('Identification byte is incorrect');
+@.Identification byte incorrect@>
+ @<Find and interpret postamble@> ;
+ move_to_byte(2) ;
+ open_pk_file ;
+ @<Write preamble@> ;
+ repeat
+ gf_com := gf_byte ;
+ case gf_com of
+ boc, boc1 : @<Interpret character@> ;
+ @<Specials and |no_op| cases@> ;
+ post : ; {we will actually do the work for this one later}
+ othercases bad_gf('Unexpected ',gf_com:1,' command between characters')
+@.Unexpected command@>
+ endcases ;
+ until gf_com = post ;
+ @<Write postamble@> ;
+end ;
+
+@ We need a few easy macros to expand some case statements:
+
+@d four_cases(#)==#,#+1,#+2,#+3
+@d sixteen_cases(#)==four_cases(#),four_cases(#+4),four_cases(#+8),
+ four_cases(#+12)
+@d sixty_four_cases(#)==sixteen_cases(#),sixteen_cases(#+16),
+ sixteen_cases(#+32),sixteen_cases(#+48)
+@d one_sixty_five_cases(#)==sixty_four_cases(#),sixty_four_cases(#+64),
+ sixteen_cases(#+128),sixteen_cases(#+144),four_cases(#+160),#+164
+
+@ In this program, all special commands are passed unchanged and any |no_op|
+bytes are ignored, so we write some code to handle these:
+
+@<Specials and |no_op| cases@>=
+four_cases(xxx1) : begin
+ pk_byte(gf_com - xxx1 + pk_xxx1) ;
+ i := 0 ; for j := 0 to gf_com - xxx1 do begin
+ k := gf_byte ; pk_byte(k) ; i := i * 256 + k ;
+ end ;
+ for j := 1 to i do pk_byte(gf_byte) ; end ;
+yyy : begin pk_byte(pk_yyy) ; pk_word(gf_signed_quad) ; end ;
+no_op :
+
+@ Now we need the routine that handles the character commands. Again,
+only a subset of the gf commands are permissible inside character
+definitions, so we only look for these.
+
+@<Interpret character@>=
+begin
+ if gf_com = boc then begin
+ gf_ch := gf_signed_quad ;
+ i := gf_signed_quad ; {dispose of back pointer}
+ min_m := gf_signed_quad ;
+ max_m := gf_signed_quad ;
+ min_n := gf_signed_quad ;
+ max_n := gf_signed_quad ;
+ end else begin
+ gf_ch := gf_byte ;
+ i := gf_byte ;
+ max_m := gf_byte ;
+ min_m := max_m - i ;
+ i := gf_byte ;
+ max_n := gf_byte ;
+ min_n := max_n - i ;
+ end ;
+ d_print_ln('Character ',gf_ch:1) ;
+ if gf_ch>=0 then gf_ch_mod_256 := gf_ch mod 256
+ else gf_ch_mod_256 := 255-((-(1+gf_ch)) mod 256);
+ if status[gf_ch_mod_256] = virgin then
+ bad_gf('no character locator for character ',gf_ch:1) ;
+@.no character locator...@>
+ @<Convert character to packed form@> ;
+end
+
+@ Communication between the procedures |convert_gf_file| and
+|pack_and_send_character| is done with a few global variables.
+
+@<Glob...@>=
+@!gf_ch : integer ; {the character we are working with}
+@!gf_ch_mod_256 : integer ; {locater pointer}
+@!pred_pk_loc : integer ; {where we predict the end of the character to be.}
+@!max_n, @!min_n : integer ; {the maximum and minimum horizontal rows}
+@!max_m, @!min_m : integer ; {the maximum and minimum vertical rows}
+@!row_ptr : integer ; {where we are in the |row| array.}
+
+@ Now we are at the beginning of a character that we need the raster for.
+Before we get into the complexities of decoding the |paint|, |skip|, and
+|new_row| commands, let's define a macro that will help us fill up the
+|row| array. Note that we check that |row_ptr| never exceeds |max_row|;
+Instead of
+calling |bad_gf| directly, as this macro is repeated eight times, we simply
+set the |bad| flag true.
+
+@d put_in_rows(#)==begin if row_ptr > max_row then bad := true else begin
+row[row_ptr]:=#; incr(row_ptr); end ; end
+
+@ Now we have the procedure that decodes the various commands and puts counts
+into the |row| array. This would be a trivial procedure, except for
+the |paint_0| command. Because the |paint_0| command exists, it is possible
+to have a sequence like |paint| 42, |paint_0|, |paint| 38, |paint_0|,
+|paint_0|, |paint_0|, |paint| 33, |skip_0|. This would be an entirely empty
+row, but if we left the zeros in the |row| array, it would be difficult
+to recognize the row as empty.
+
+This type of situation probably would never
+occur in practice, but it is defined by the \.{GF} format, so we must be able
+to handle it. The extra code is really quite simple, just difficult to
+understand; and it does not cut down the speed appreciably. Our goal is
+this: to collapse sequences like |paint| 42, |paint_0|, |paint| 32 to a single
+count of 74, and to insure that the last count of a row is a black count rather
+than a white count. A buffer variable |extra|, and two state flags, |on| and
+|state|, enable us to accomplish this.
+
+The |on| variable is essentially the |paint_switch| described in the \.{GF}
+description. If it is true, then we are currently painting black pixels.
+The |extra| variable holds a count that is about to be placed into the
+|row| array. We hold it in this array until we get a |paint| command
+of the opposite color that is greater than 0. If we get a |paint_0| command,
+then the |state| flag is turned on, indicating that the next count we receive
+can be added to the |extra| variable as it is the same color.
+
+@<Convert character to packed form@>=
+begin
+ bad := false ;
+ row_ptr := 2 ;
+ on := false ;
+ extra := 0 ;
+ state := true ;
+ repeat
+ gf_com := gf_byte ;
+ case gf_com of
+@t\4@>@<Cases for |paint| commands@>;
+four_cases(skip0) : begin
+ i := 0 ; for j := 1 to gf_com - skip0 do i := i * 256 + gf_byte ;
+ if on = state then put_in_rows(extra) ;
+ for j := 0 to i do put_in_rows(end_of_row) ;
+ on := false ; extra := 0 ; state := true ;
+end ;
+one_sixty_five_cases(new_row_0) : begin
+ if on = state then put_in_rows(extra) ;
+ put_in_rows(end_of_row) ;
+ on := true ; extra := gf_com - new_row_0 ; state := false ;
+end ;
+@t\4@>@<Specials and |no_op| cases@> ;
+eoc : begin
+ if on = state then put_in_rows(extra) ;
+ if ( row_ptr > 2 ) and ( row[row_ptr - 1] <> end_of_row) then
+ put_in_rows(end_of_row) ;
+ put_in_rows(end_of_char) ;
+ if bad then abort('Ran out of internal memory for row counts!') ;
+@.Ran out of memory@>
+ pack_and_send_character ;
+ status[gf_ch_mod_256] := sent ;
+ if pk_loc <> pred_pk_loc then
+ abort('Internal error while writing character!') ;
+@.Internal error@>
+end ;
+othercases bad_gf('Unexpected ',gf_com:1,' command in character definition')
+@.Unexpected command@>
+ endcases ;
+ until gf_com = eoc ;
+end
+
+@ A few more locals used above and below:
+
+@<Locals to |convert_gf_file|@>=
+@!on : boolean ; {indicates whether we are white or black}
+@!state : boolean ; {a state variable---is the next count the same race as
+ the one in the |extra| buffer?}
+@!extra : integer ; {where we pool our counts}
+@!bad : boolean ; {did we run out of space?}
+
+@ @<Cases for |paint| commands@>=
+paint_0 : begin
+ state := not state ;
+ on := not on ;
+end ;
+sixty_four_cases(paint_0+1),paint1+1,paint1+2 : begin
+ if gf_com < paint1 then i := gf_com - paint_0
+ else begin
+ i := 0 ; for j := 0 to gf_com - paint1 do i := i * 256 + gf_byte ;
+ end ;
+ if state then begin
+ extra := extra + i ;
+ state := false ;
+ end else begin
+ put_in_rows(extra) ;
+ extra := i ;
+ end ;
+ on := not on ;
+end
+
+@ Our last remaining task is to interpret the postamble commands. The only
+things that may appear in the postamble are |post_post|, |char_loc|,
+|char_loc0|, and the special commands.
+Note that any special commands that might appear in the postamble are
+not written to the |pk_file|. Since \MF\ does not generate special commands
+in the postamble, this should not be a major difficulty.
+
+@<Find and interpret postamble@>=
+find_gf_length ;
+post_loc := gf_len - 4 ;
+repeat
+ if post_loc = 0 then bad_gf('all 223''s');
+@.all 223\char39s@>
+ move_to_byte(post_loc); k := gf_byte; decr(post_loc) ;
+until k <> 223 ;
+if k <> gf_id_byte then bad_gf('ID byte is ',k:1);
+@.ID byte is wrong@>
+move_to_byte(post_loc - 3);
+q := gf_signed_quad ;
+if (q<0) or (q>post_loc-3) then bad_gf('post pointer is ',q:1) ;
+@.post pointer is wrong@>
+move_to_byte(q) ; k := gf_byte ;
+if k <> post then bad_gf('byte at ',q:1,' is not post') ;
+@.byte is not post@>
+i := gf_signed_quad ; {skip over junk}
+design_size := gf_signed_quad ;
+check_sum := gf_signed_quad ;
+hppp := gf_signed_quad ;
+h_mag := round ( hppp * 72.27 / 65536 ) ;
+vppp := gf_signed_quad ;
+if hppp <> vppp then print_ln('Odd aspect ratio!') ;
+@.Odd aspect ratio@>
+i := gf_signed_quad ; i := gf_signed_quad ; {skip over junk}
+i := gf_signed_quad ; i := gf_signed_quad ;
+repeat
+ gf_com := gf_byte ;
+ case gf_com of
+char_loc, char_loc0 : begin
+ gf_ch := gf_byte ;
+ if status[gf_ch] <> virgin then
+ bad_gf('Locator for this character already found.');
+@.Locator...already found@>
+ if gf_com = char_loc then begin
+ dx[gf_ch] := gf_signed_quad ;
+ dy[gf_ch] := gf_signed_quad ;
+ end else begin
+ dx[gf_ch] := gf_byte * 65536 ;
+ dy[gf_ch] := 0 ;
+ end ;
+ tfm_width[gf_ch] := gf_signed_quad ;
+ i := gf_signed_quad ;
+ status[gf_ch] := located ;
+end ;
+@<Specials and |no_op| cases@> ;
+post_post : ;
+othercases bad_gf('Unexpected ',gf_com:1,' in postamble')
+@.Unexpected command@>
+ endcases ;
+until gf_com = post_post
+
+@ Just a few more locals:
+
+@<Locals to |convert_gf_file|@>=
+@!hppp, @!vppp : integer ; {horizontal and vertical pixels per point}
+@!q : integer ; {quad temporary}
+@!post_loc : integer ; {where the postamble was}
+
+@* Converting the counts to packed format.
+This procedure is passed the set of row counts from the \.{GF} file. It
+writes the character to the \.{PK} file. First, the minimum bounding box
+is determined. Next, the row-oriented count list is converted to a count
+list based on the entire glyph. Finally, we calculate
+the optimal |dyn_f| and send the character.
+
+@<Packing procedures@>=
+procedure pack_and_send_character ;
+var i, @!j, @!k : integer ; {general indices}
+@<Locals to |pack_and_send_character|@>
+begin
+ @<Scan for bounding box@> ;
+ @<Convert row-list to glyph-list@> ;
+ @<Calculate |dyn_f| and packed size and write character@> ;
+end
+
+@ Now we have the row counts in our |row| array. To find the real |max_n|,
+we look for
+the first non-|end_of_row| value in the |row|. If it is an |end_of_char|,
+the entire character is blank. Otherwise, we first eliminate all of the blank
+rows at the end of the character. Next, for each remaining row, we check the
+first white count for a new |min_m|, and the total length of the row
+for a new |max_m|.
+
+@<Scan for bounding box@>=
+i := 2 ; decr(row_ptr) ;
+while row[i] = end_of_row do incr(i) ;
+if row[i] <> end_of_char then begin
+ max_n := max_n - i + 2 ;
+ while row[row_ptr - 2] = end_of_row do begin
+ decr(row_ptr) ; row[row_ptr] := end_of_char ;
+ end ;
+ min_n := max_n + 1 ;
+ extra := max_m - min_m + 1 ;
+ max_m := 0 ;
+ j := i ;
+ while row[j] <> end_of_char do begin
+ decr(min_n) ;
+ if row[j] <> end_of_row then begin
+ k := row[j] ;
+ if k < extra then extra := k ;
+ incr(j) ;
+ while row[j] <> end_of_row do begin
+ k := k + row[j] ; incr(j) ;
+ end ;
+ if max_m < k then max_m := k ;
+ end ;
+ incr(j) ;
+ end ;
+ min_m := min_m + extra ;
+ max_m := min_m + max_m - 1 - extra ;
+ height := max_n - min_n + 1 ;
+ width := max_m - min_m + 1 ;
+ x_offset := - min_m ;
+ y_offset := max_n ;
+ d_print_ln('W ',width:1,' H ',height:1,' X ',x_offset:1, ' Y ',y_offset:1);
+end else begin
+ height := 0 ; width := 0 ; x_offset := 0 ; y_offset := 0 ;
+ d_print_ln('Empty raster.');
+end
+
+@ We must convert the run-count array from a row orientation to a glyph
+orientation, with repeat counts for repeated rows. We seperate this task
+into two smaller tasks, on a per row basis. But first, we define a new
+macro to help us fill up this new array. Here, we have no fear that we will
+run out of space, as the glyph representation is provably smaller than the
+rows representation.
+
+@d put_count(#)==begin row[put_ptr] := #; incr(put_ptr);
+if repeat_flag > 0 then begin
+ row[put_ptr] := - repeat_flag ; repeat_flag := 0 ; incr(put_ptr) ; end ;
+end
+
+@<Convert row-list to glyph-list@>=
+put_ptr := 0 ; row_ptr := 2 ; repeat_flag := 0 ;
+state := true ; buff := 0 ;
+while row[row_ptr] = end_of_row do incr(row_ptr) ;
+while row[row_ptr] <> end_of_char do begin
+ @<Skip over repeated rows@> ;
+ @<Reformat count list@> ;
+end ;
+if buff > 0 then
+ put_count(buff) ;
+put_count(end_of_char)
+
+@ Some more locals for |pack_and_send_character| used above:
+
+@<Locals to |pack_and_send_character|@>=
+@!extra : integer ; {little buffer for count values}
+@!put_ptr : integer ; {next location to fill in |row|}
+@!repeat_flag : integer ; {how many times the current row is repeated}
+@!h_bit : integer ; {horizontal bit count for each row}
+@!buff : integer ; {our count accumulator}
+
+@ In this short section of code, we are at the beginning of a new row.
+We scan forward, looking for repeated rows. If there are any, |repeat_flag|
+gets the count, and the |row_ptr| points to the beginning of the last of the
+repeated rows. Two points must be made here. First, we do not count all-black
+or all-white rows as repeated, as a large ``paint'' count will take care of
+them, and also there is no black to white or white to black transition in the
+row where we could insert a repeat count. That is the meaning of the big
+if statement that conditions this section. Secondly, the |while row[i] =
+row[j] do| loop is guaranteed to terminate, as $|j| > |i|$ and the character
+is terminated by a unique |end_of_char| value.
+
+@<Skip over repeated rows@>=
+i := row_ptr ;
+if ( row[i] <> end_of_row ) and ( ( row[i] <> extra ) or ( row[i+1] <>
+ width ) ) then begin
+ j := i + 1 ;
+ while row[j-1] <> end_of_row do incr(j) ;
+ while row[i] = row[j] do begin
+ if row[i] = end_of_row then begin
+ incr(repeat_flag) ;
+ row_ptr := i + 1 ;
+ end ;
+ incr(i) ; incr(j) ;
+ end ;
+end
+
+@ Here we actually spit out a row. The routine is somewhat similar to the
+routine where we actually interpret the \.{GF} commands in the count buffering.
+We must make sure to keep track of how many bits have actually been sent, so
+when we hit the end of a row, we can send a white count for the remaining
+bits, and possibly add the white count of the next row to it. And, finally,
+we must not forget to subtract the |extra| white space at the beginning of
+each row from the first white count.
+
+@<Reformat count list@>=
+if row[row_ptr] <> end_of_row then row[row_ptr] := row[row_ptr] - extra ;
+h_bit := 0;
+while row[row_ptr] <> end_of_row do begin
+ h_bit := h_bit + row[row_ptr] ;
+ if state then begin
+ buff := buff + row[row_ptr] ;
+ state := false ;
+ end else if row[row_ptr] > 0 then begin
+ put_count(buff) ;
+ buff := row[row_ptr] ;
+ end else state := true ;
+ incr(row_ptr) ;
+end ;
+if h_bit < width then
+ if state then
+ buff := buff + width - h_bit
+ else begin
+ put_count(buff) ;
+ buff := width - h_bit ;
+ state := true ;
+ end
+else state := false ;
+incr(row_ptr)
+
+@ Here is another piece of rather intricate code. We determine the
+smallest size in which we can pack the data, calculating |dyn_f| in the
+process. To do this, we calculate the size required if |dyn_f| is 0, and put
+this in |comp_size|. Then, we calculate the changes in the size for each
+increment of |dyn_f|, and stick these values in the |deriv| array. Finally,
+we scan through this array and find the final minimum value, which we then
+use to send the character data.
+
+@<Calculate |dyn_f| and packed size and write character@>=
+for i := 1 to 13 do deriv[i] := 0 ;
+i := 0 ;
+first_on := row[i] = 0 ;
+if first_on then incr(i) ;
+comp_size := 0 ;
+while row[i] <> end_of_char do
+ @<Process count for best |dyn_f| value@> ;
+b_comp_size := comp_size ;
+dyn_f := 0 ;
+for i := 1 to 13 do begin
+ comp_size := comp_size + deriv[i] ;
+ if comp_size <= b_comp_size then begin
+ b_comp_size := comp_size ;
+ dyn_f := i ;
+ end ;
+end ;
+comp_size := (b_comp_size + 1) div 2 ;
+if (comp_size > (height * width + 7) div 8) or (height * width = 0) then begin
+ comp_size := (height * width + 7) div 8 ;
+ dyn_f := 14 ;
+end ;
+d_print_ln('Best packing is dyn_f of ',dyn_f:1,' with length '
+ ,comp_size:1);
+@<Write character preamble@> ;
+if dyn_f <> 14 then
+ @<Send compressed format@>
+else if height > 0 then
+ @<Send bit map@>
+
+@ When we enter this module, we have a count at |row[i]|. First, we add to
+the |comp_size| the number of
+nybbles that this count would require, assuming |dyn_f| to be zero. When
+|dyn_f| is zero, there are no one nybble counts, so we simply choose between
+two-nybble and extensible counts and add the appropriate value.
+
+Next, we take the count value and determine the value of |dyn_f| (if any) that
+would cause this count to take either more or less nybbles. If a valid value
+for |dyn_f| exists in this range, we accumulate this change in the |deriv|
+array.
+
+One special case handled here is a repeat count of one.
+A repeat count of one will never change the length of the raster
+representation, no matter what |dyn_f| is, because it is always
+represented by the nybble value 15.
+
+@<Process count for best |dyn_f| value@>=
+begin
+ j := row[i] ;
+ if j = -1 then incr(comp_size)
+ else begin
+ if j < 0 then begin
+ incr(comp_size) ;
+ j := - j ;
+ end ;
+ if j < 209 then comp_size := comp_size + 2
+ else begin
+ k := j - 193 ;
+ while k >= 16 do begin
+ k := k div 16 ;
+ comp_size := comp_size + 2 ;
+ end ;
+ incr(comp_size) ;
+ end ;
+ if j < 14 then decr(deriv[j])
+ else if j < 209 then incr(deriv[(223 - j) div 15])
+ else begin
+ k := 16 ;
+ while ( k * 16 < j + 3 ) do k := k * 16 ;
+ if j-k <= 192 then deriv[(207-j+k) div 15] := deriv[(207-j+k) div 15]
+ + 2 ;
+ end ;
+ end ;
+ incr(i) ;
+end
+
+@ We need a handful of locals:
+
+@<Locals to |pack_and_send_character|@>=
+@!dyn_f : integer ; {packing value}
+@!height, @!width : integer ; {height and width of character}
+@!x_offset, @!y_offset : integer ; {offsets}
+@!deriv : array[1..13] of integer ; {derivative}
+@!b_comp_size : integer ; {best size}
+@!first_on : boolean ; {indicates that the first bit is on}
+@!flag_byte : integer ; {flag byte for character}
+@!state : boolean ; {state variable}
+@!on : boolean ; {white or black?}
+
+@ Now we write the character preamble information. First we need to determine
+which of the three formats we should use.
+
+@<Write character preamble@>=
+flag_byte := dyn_f * 16 ;
+if first_on then flag_byte := flag_byte + 8 ;
+if (gf_ch <> gf_ch_mod_256) or (tfm_width[gf_ch_mod_256] > 16777215) or
+ (tfm_width[gf_ch_mod_256] < 0) or (dy[gf_ch_mod_256] <> 0) or
+ (dx[gf_ch_mod_256] < 0) or (dx[gf_ch_mod_256] mod 65536 <> 0) or
+ (comp_size > 196594) or (width > 65535) or
+ (height > 65535) or (x_offset > 32767) or (y_offset > 32767) or
+ (x_offset < -32768) or (y_offset < -32768) then
+ @<Write long character preamble@>
+else if (dx[gf_ch] > 16777215) or (width > 255) or (height > 255) or
+ (x_offset > 127) or (y_offset > 127) or (x_offset < -128) or
+ (y_offset < -128) or (comp_size > 1015) then
+ @<Write two-byte short character preamble@>
+else
+ @<Write one-byte short character preamble@>
+
+@ If we must write a long character preamble, we
+adjust a few parameters, then write the data.
+
+@<Write long character preamble@>=
+begin
+ flag_byte := flag_byte + 7 ;
+ pk_byte(flag_byte) ;
+ comp_size := comp_size + 28 ;
+ pk_word(comp_size) ;
+ pk_word(gf_ch) ;
+ pred_pk_loc := pk_loc + comp_size ;
+ pk_word(tfm_width[gf_ch_mod_256]) ;
+ pk_word(dx[gf_ch_mod_256]) ;
+ pk_word(dy[gf_ch_mod_256]) ;
+ pk_word(width) ;
+ pk_word(height) ;
+ pk_word(x_offset) ;
+ pk_word(y_offset) ;
+end
+
+@ Here we write a short short character preamble, with one-byte size
+parameters.
+
+@<Write one-byte short character preamble@>=
+begin
+ comp_size := comp_size + 8 ;
+ flag_byte := flag_byte + comp_size div 256 ;
+ pk_byte(flag_byte) ;
+ pk_byte(comp_size mod 256) ;
+ pk_byte(gf_ch) ;
+ pred_pk_loc := pk_loc + comp_size ;
+ pk_three_bytes(tfm_width[gf_ch_mod_256]) ;
+ pk_byte(dx[gf_ch_mod_256] div 65536) ;
+ pk_byte(width) ;
+ pk_byte(height) ;
+ pk_byte(x_offset) ;
+ pk_byte(y_offset) ;
+end
+
+@ Here we write an extended short character preamble, with two-byte
+size parameters.
+
+@<Write two-byte short character preamble@>=
+begin
+ comp_size := comp_size + 13 ;
+ flag_byte := flag_byte + comp_size div 65536 + 4 ;
+ pk_byte(flag_byte) ;
+ pk_halfword(comp_size mod 65536) ;
+ pk_byte(gf_ch) ;
+ pred_pk_loc := pk_loc + comp_size ;
+ pk_three_bytes(tfm_width[gf_ch_mod_256]) ;
+ pk_halfword(dx[gf_ch_mod_256] div 65536) ;
+ pk_halfword(width) ;
+ pk_halfword(height) ;
+ pk_halfword(x_offset) ;
+ pk_halfword(y_offset) ;
+end
+
+@ At this point, we have decided that the run-encoded format is smaller. (This
+is almost always the case.) We send out the data, a nybble at a time.
+
+@<Send compressed format@>=
+begin
+ bit_weight := 16 ;
+ max_2 := 208 - 15 * dyn_f ;
+ i := 0 ;
+ if row[i] = 0 then incr(i) ;
+ while row[i] <> end_of_char do begin
+ j := row[i] ;
+ if j = -1 then
+ pk_nyb(15)
+ else begin
+ if j < 0 then begin
+ pk_nyb(14) ;
+ j := - j ;
+ end ;
+ if j <= dyn_f then pk_nyb(j)
+ else if j <= max_2 then begin
+ j := j - dyn_f - 1 ;
+ pk_nyb(j div 16 + dyn_f + 1) ;
+ pk_nyb(j mod 16) ;
+ end else begin
+ j := j - max_2 + 15 ;
+ k := 16 ;
+ while k <= j do begin
+ k := k * 16 ;
+ pk_nyb(0) ;
+ end ;
+ while k > 1 do begin
+ k := k div 16 ;
+ pk_nyb(j div k) ;
+ j := j mod k ;
+ end ;
+ end ;
+ end ;
+ incr(i) ;
+ end ;
+ if bit_weight <> 16 then pk_byte(output_byte) ;
+end
+
+@ This code is for the case where we have decided to send the character raster
+packed by bits. It uses the bit counts as well, sending eight at a time.
+Here we have a miniature packed format interpreter, as we must repeat any rows
+that are repeated. The algorithm to do this was a lot of fun to generate. Can
+you figure out how it works?
+
+@<Send bit map@>=
+begin
+ buff := 0 ;
+ p_bit := 8 ;
+ i := 1 ;
+ h_bit := width ;
+ on := false ;
+ state := false ;
+ count := row[0] ;
+ repeat_flag := 0 ;
+ while ( row[i] <> end_of_char ) or state or ( count > 0 ) do begin
+ if state then begin
+ count := r_count ; i := r_i ; on := r_on ;
+ decr(repeat_flag) ;
+ end else begin
+ r_count := count ; r_i := i ; r_on := on ;
+ end ;
+ @<Send one row by bits@> ;
+ if state and ( repeat_flag = 0 ) then begin
+ count := s_count ; i := s_i ; on := s_on ;
+ state := false ;
+ end else if not state and ( repeat_flag > 0 ) then begin
+ s_count := count ; s_i := i ; s_on := on ;
+ state := true ;
+ end ;
+ end ;
+ if p_bit <> 8 then pk_byte(buff) ;
+end
+
+@ All of the remaining locals:
+
+@<Locals to |pack_and_send_character|@>=
+@!comp_size : integer ; {length of the packed representation in bytes}
+@!count : integer ; {number of bits in current state to send}
+@!p_bit : integer ; {what bit are we about to send out?}
+@!r_on, @!s_on : boolean ; {state saving variables}
+@!r_count, @!s_count : integer ; {ditto}
+@!r_i, @!s_i : integer ; {and again.}
+@!max_2 : integer ; {the highest count that fits in two bytes}
+
+@ We make the |power| array global.
+
+@<Glob...@>=
+@!power : array[0..8] of integer ; {easy powers of two}
+
+@ We initialize the power array.
+
+@<Set init...@>=
+power[0] := 1 ;
+for i := 1 to 8 do power[i] := power[i-1] + power[i-1] ;
+
+@ Here we are at the beginning of a row and simply output the next |width| bits.
+We break the possibilities up into three cases: we finish a byte but not
+the row, we finish a row, and we finish neither a row nor a byte. But,
+first, we insure that we have a |count| value.
+
+@<Send one row by bits@>=
+repeat
+ if count = 0 then begin
+ if row[i] < 0 then begin
+ if not state then repeat_flag := - row[i] ;
+ incr(i) ;
+ end ;
+ count := row[i] ;
+ incr(i) ;
+ on := not on ;
+ end ;
+ if ( count >= p_bit ) and ( p_bit < h_bit ) then begin
+{ we end a byte, we don't end the row }
+ if on then buff := buff + power[p_bit] - 1 ;
+ pk_byte(buff) ; buff := 0 ;
+ h_bit := h_bit - p_bit ; count := count - p_bit ; p_bit := 8 ;
+ end else if ( count < p_bit ) and ( count < h_bit ) then begin
+{ we end neither the row nor the byte }
+ if on then buff := buff + power[p_bit] - power[p_bit - count] ;
+ p_bit := p_bit - count ; h_bit := h_bit - count ; count := 0 ;
+ end else begin
+{ we end a row and maybe a byte }
+ if on then buff := buff + power[p_bit] - power[p_bit - h_bit] ;
+ count := count - h_bit ; p_bit := p_bit - h_bit ; h_bit := width ;
+ if p_bit = 0 then begin
+ pk_byte(buff) ; buff := 0 ; p_bit := 8 ;
+ end ;
+ end ;
+until h_bit = width
+
+@ Now we are ready for the routine that writes the preamble of the packed
+file.
+
+@d preamble_comment == 'GFtoPK 2.3 output from '
+@d comm_length = 23 {length of |preamble_comment|}
+@d from_length = 6 {length of its |' from '| part}
+
+@<Write preamble@>=
+pk_byte(pk_pre) ;
+pk_byte(pk_id) ;
+i := gf_byte ; {get length of introductory comment}
+repeat if i=0 then j:="."@+else j:=gf_byte;
+decr(i); {some people think it's wise to avoid |goto| statements}
+until j<>" "; {remove leading blanks}
+incr(i); {this many bytes to copy}
+if i=0 then k:=comm_length-from_length
+else k := i+comm_length;
+if k>255 then pk_byte(255)@+else pk_byte(k);
+for k := 1 to comm_length do
+ if(i>0)or(k<=comm_length-from_length) then pk_byte(xord[comment[k]]) ;
+print('''') ;
+for k := 1 to i do
+ begin if k>1 then j:=gf_byte;
+ print(xchr[j]);
+ if k<256-comm_length then pk_byte(j);
+ end;
+print_ln('''') ;@/
+pk_word(design_size) ;
+pk_word(check_sum) ;
+pk_word(hppp) ;
+pk_word(vppp)
+
+@ Of course, we need an array to hold the comment.
+
+@<Glob...@>=
+@!comment : packed array[1..comm_length] of char ;
+
+@ @<Set init...@>=
+comment := preamble_comment ;
+
+@ Writing the postamble is even easier.
+
+@<Write postamble@>=
+pk_byte(pk_post) ;
+while (pk_loc mod 4 <> 0) do pk_byte(pk_no_op)
+
+@ Once we are finished with the \.{GF} file, we check the status of each
+character to insure that each character that had a locater also had raster
+information.
+
+@<Check for un-rasterized locaters@>=
+for i := 0 to 255 do
+ if status[i] = located then
+ print_ln('Character ',i:1,' missing raster information!')
+@.missing raster information@>
+
+@ Finally, the main program.
+
+@p begin
+ initialize ;
+ convert_gf_file ;
+ @<Check for un-rasterized locaters@> ;
+ print_ln(gf_len:1,' bytes packed to ',pk_loc:1,' bytes.') ;
+final_end : end .
+
+@ A few more globals.
+
+@<Glob...@>=
+@!check_sum : integer ; {the checksum of the file}
+@!design_size : integer ; {the design size of the font}
+@!h_mag : integer ; {the pixel magnification in pixels per inch}
+@!i : integer ;
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoPK} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/gftype.ch b/Build/source/texk/web2c/gftype.ch
new file mode 100644
index 00000000000..9c52f5099fa
--- /dev/null
+++ b/Build/source/texk/web2c/gftype.ch
@@ -0,0 +1,380 @@
+% gftype.ch for C compilation with web2c.
+%
+% 09/27/88 Pierre A. MacKay version 2.2.
+% 11/10/88 (PAM) Bugs reported by Irwin Meisels.
+% Corrected floating-point printout, and restored options
+% info printout to make trap look better.
+% 12/02/89 Karl Berry version 3.
+% (more recent changes in the ChangeLog)
+%
+% The C version of GFtype uses command line switches to
+% request mnemonic ouput or pixel image output.
+% The default is a restrained output which merely assures you
+% that all characters are there and reports their position, tfm_width
+% and escapement. The -m switch turns on mnemonics, the -i switch
+% turns on images. There is no terminal input to this program.
+% Output is to stdout, and may, of course, be redirected.
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{GF$\,$\lowercase{type} changes for C}
+@z
+
+@x [3] No global labels.
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+
+@p program GF_type(@!gf_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+@y
+@d print(#)==write(stdout, #)
+@d print_ln(#)==write_ln(stdout, #)
+@d print_nl==write_ln(stdout)
+
+@p program GF_type(@!gf_file,@!output);
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+begin
+ kpse_set_progname (argv[0]);
+ kpse_init_prog ('GFTYPE', 0, nil, nil);
+ parse_arguments;
+ print(banner);print_ln(version_string);
+@z
+
+@x [4] Eliminate the |final_end| label.
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+@y
+@ This module is deleted, because it is only useful for
+a non-local goto, which we can't use in C.
+@z
+
+@x [5] Remove |terminal_line_length|.
+@<Constants...@>=
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@y
+@<Constants...@>=
+@z
+
+@x [7] Remove jump_out, and make `abort' end with a newline.
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_gf(#)==abort('Bad GF file: ',#,'!')
+@.Bad GF file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+@y
+@d abort(#)==begin write_ln(stderr, #); uexit(1); end
+@d bad_gf(#)==abort('Bad GF file: ',#,'!')
+@.Bad GF file@>
+@z
+
+@x [22] Redo open_gf_file to do path searching.
+@ To prepare this file for input, we |reset| it.
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file);
+cur_loc:=0;
+end;
+@y
+
+@ In C, we do path searching based on the user's environment or the
+default path.
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin
+ gf_file := kpse_open_file (cmdline (optind), kpse_gf_format);
+ cur_loc := 0;
+ @<Print all the selected options@>;
+end;
+@z
+
+@x [25] Since we set these from getopt, they have to be ints, more's the pity.
+@!wants_mnemonics: boolean; {controls mnemonic output}
+@!wants_pixels: boolean; {controls pixel output}
+@y
+@!wants_mnemonics: c_int_type; {controls mnemonic output}
+@!wants_pixels: c_int_type; {controls pixel output}
+@z
+
+% [26] Initialize wants_pixels and wants_mnemonics to false implicitly
+% by virtue of being global variables. Can't do it here, since this is
+% after the option parsing.
+@x
+wants_mnemonics:=true; wants_pixels:=true;
+@y
+@z
+
+@x [27] No input, and no dialog.
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+@ There is no terminal input. The options for running this
+program are offered through command line options.
+@z
+
+@x [29] `input_ln' is not needed.
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+@y
+@z
+
+@x [30--34] Eliminate `dialog' and its friends.
+@ This is humdrum.
+
+@p function lower_casify(@!c:ASCII_code):ASCII_code;
+begin
+if (c>="A") and (c<="Z") then lower_casify:=c+"a"-"A"
+else lower_casify:=c;
+end;
+
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{GFtype} begins.
+@^system dependencies@>
+
+@p procedure dialog;
+label 1,2;
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);@/
+@<Determine whether the user |wants_mnemonics|@>;
+@<Determine whether the user |wants_pixels|@>;
+@<Print all the selected options@>;
+end;
+
+@ @<Determine whether the user |wants_mnemonics|@>=
+1: write(term_out,'Mnemonic output? (default=no, ? for help): ');
+@.Mnemonic output?@>
+input_ln;
+buffer[0]:=lower_casify(buffer[0]);
+if buffer[0]<>"?" then
+ wants_mnemonics:=(buffer[0]="y")or(buffer[0]="1")or(buffer[0]="t")
+else begin write(term_out,'Type Y for complete listing,');
+ write_ln(term_out,' N for errors/images only.');
+ goto 1;
+ end
+
+@ @<Determine whether the user |wants_pixels|@>=
+2: write(term_out,'Pixel output? (default=yes, ? for help): ');
+@.Pixel output?@>
+input_ln;
+buffer[0]:=lower_casify(buffer[0]);
+if buffer[0]<>"?" then
+ wants_pixels:=(buffer[0]="y")or(buffer[0]="1")or(buffer[0]="t")
+ or(buffer[0]=" ")
+else begin write(term_out,'Type Y to list characters pictorially');
+ write_ln(term_out,' with *''s, N to omit this option.');
+ goto 2;
+ end
+
+@ After the dialog is over, we print the options so that the user
+can see what \.{GFtype} thought was specified.
+
+@y
+@ This was so humdrum that we got rid of it. (module 30)
+
+@ The dialog procedure module is eliminated. (module 31)
+
+@ So is its first part. (module 32)
+
+@ So is its second part. (module 33)
+
+@ After the command-line switches have been processed,
+we print the options so that the user
+can see what \.{GFtype} thought was specified.
+@z
+
+@x [45] Change chr to xchr (should be changed in the web source).
+ print(chr(ord('0')+(s div unity))); s:=10*(s mod unity); delta:=delta*10;
+@y
+ print(xchr[ord('0')+(s div unity)]); s:=10*(s mod unity); delta:=delta*10;
+@z
+
+@x [48] Break up the first oversized case statement (or yacc breaks).
+sixty_four_cases(new_row_0), sixty_four_cases(new_row_0+64),
+ thirty_seven_cases(new_row_0+128): first_par:=o-new_row_0;
+@y
+sixty_four_cases(new_row_0): first_par:=o-new_row_0;
+sixty_four_cases(new_row_0+64): first_par:=o-new_row_0;
+thirty_seven_cases(new_row_0+128): first_par:=o-new_row_0;
+@z
+
+@x [64] Break up the second oversized case statement.
+sixty_four_cases(new_row_0), sixty_four_cases(new_row_0+64),
+ thirty_seven_cases(new_row_0+128):
+ @<Translate a |new_row| command@>;
+@t\4@>@<Cases for commands |no_op|, |pre|, |post|, |post_post|, |boc|,
+ and |eoc|@>@;
+four_cases(xxx1): @<Translate an |xxx| command@>;
+yyy: @<Translate a |yyy| command@>;
+othercases error('undefined command ',o:1,'!')
+@.undefined command@>
+endcases
+@y
+sixty_four_cases(new_row_0): @<Translate a |new_row| command@>;
+sixty_four_cases(new_row_0+64): @<Translate a |new_row| command@>;
+thirty_seven_cases(new_row_0+128): @<Translate a |new_row| command@>;
+@t\4@>@<Cases for commands |no_op|, |pre|, |post|, |post_post|, |boc|,
+ and |eoc|@>@;
+four_cases(xxx1): @<Translate an |xxx| command@>;
+yyy: @<Translate a |yyy| command@>;
+othercases error('undefined command ',o:1,'!')
+@.undefined command@>
+endcases
+@z
+
+@x [65] No label and no dialog; finish last line written.
+@p begin initialize; {get all variables initialized}
+dialog; {set up all the options}
+@<Process the preamble@>;
+@<Translate all the characters@>;
+print_nl;
+read_postamble;
+print('The file had ',total_chars:1,' character');
+if total_chars<>1 then print('s');
+print(' altogether.');
+@.The file had n characters...@>
+final_end:end.
+@y
+@p begin initialize; {get all variables initialized}
+@<Process the preamble@>;
+@<Translate all the characters@>;
+print_nl;
+read_postamble;
+print('The file had ',total_chars:1,' character');
+if total_chars<>1 then print('s');
+print_ln(' altogether.');
+@.The file had n characters...@>
+end.
+@z
+
+@x System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 4; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('gftype');
+
+ end else if argument_is ('help') then begin
+ usage_help (GFTYPE_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.R. Fuchs');
+
+ end; {Else it was a flag.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one remaining argument.}
+ if (optind + 1 <> argc) then begin
+ write_ln (stderr, 'gftype: Need exactly one file argument.');
+ usage ('gftype');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Translate commands?
+@<Define the option...@> =
+long_options[current_option].name := 'mnemonics';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (wants_mnemonics);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@ Show pixels?
+@<Define the option...@> =
+long_options[current_option].name := 'images';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (wants_pixels);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/gftype.rc b/Build/source/texk/web2c/gftype.rc
new file mode 100644
index 00000000000..fe3c9494df5
--- /dev/null
+++ b/Build/source/texk/web2c/gftype.rc
@@ -0,0 +1,32 @@
+/* gftype.rc: gftype resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " gftype 3.1"
+
+#define VER_INTERNALNAME_STR "gftype"
+#define VER_ORIGINALFILENAME_STR "gftype.exe"
+
+#define VER_FILEDESCRIPTION_STR "Converts GF File into symbolic form"
+
+#include <texlive.version>
+
+/* gftype.rc ends here */
diff --git a/Build/source/texk/web2c/gftype.web b/Build/source/texk/web2c/gftype.web
new file mode 100644
index 00000000000..ef6feeefef4
--- /dev/null
+++ b/Build/source/texk/web2c/gftype.web
@@ -0,0 +1,1394 @@
+% This program by D. R. Fuchs is not copyrighted and can be used freely.
+% Version 0 was implemented in March 1984, before METAFONT itself was complete.
+% Version 1.0 incorporated refinements for the TRAP test (August 1984).
+% Version 1.1 fixed a trivial bug in the stated initial y value (August 1984).
+% Version 1.2 clarified the pixel coordinates (September 1984).
+% Version 2.0 changed over to new GF format (December 1984).
+% Version 2.1 changed over to newer GF format (February 1985).
+% Version 2.2 changed `family' to `extension' (October 1985).
+% Version 3.0 changed the default prompts (April 1989).
+% Version 3.1 checked character locators (Breitenlohner, March 1991).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\font\tenss=cmss10 % for `The METAFONTbook'
+\def\PASCAL{Pascal}
+\def\ph{\hbox{Pascal-H}}
+\font\logo=manfnt % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+\let\swap=\leftrightarrow
+\def\round{\mathop{\rm round}\nolimits}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+\def\title{GFtype}
+\def\contentspagenumber{101}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont GFtype} processor}
+ \vskip 15pt
+ \centerline{(Version 3.1, March 1991)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926, MCS-8300984, and
+ CCR-8610181,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.
+ `{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley
+ Publishing Company.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{GFtype} utility program reads binary generic-font (``\.{GF}'')
+files that are produced by font compilers such as \MF, and converts them
+into symbolic form. This program has three chief purposes:
+(1)~It can be used to look at the pixels of a font, with one pixel per
+character in a text file; (2)~it can be used to
+determine whether a \.{GF} file is valid or invalid, when diagnosing
+compiler errors; and (3)~it serves as an example of a program that reads
+\.{GF} files correctly, for system programmers who are developing
+\.{GF}-related software.
+
+The original version of this program was written by David R. Fuchs in
+March, 1984. Donald E. Knuth made a few modifications later that year as
+\MF\ was taking shape.
+@^Fuchs, David Raymond@>
+@^Knuth, Donald Ervin@>
+
+The |banner| string defined here should be changed whenever \.{GFtype}
+gets modified.
+
+@d banner=='This is GFtype, Version 3.1' {printed when the program starts}
+
+@ This program is written in standard \PASCAL, except where it is
+necessary to use extensions; for example, one extension is to use a
+default |case| as in \.{TANGLE}, \.{WEAVE}, etc. All places where
+nonstandard constructions are used have been listed in the index under
+``system dependencies.''
+@!@^system dependencies@>
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The binary input comes from |gf_file|, and the symbolic output is written
+on \PASCAL's standard |output| file. The term |print| is used instead of
+|write| when this program writes on |output|, so that all such output
+could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+
+@p program GF_type(@!gf_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ Four parameters can be changed at compile time to extend or
+reduce \.{GFtype}'s capacity.
+Note that the total number of bits in the main |image_array| will be
+$$\hbox{$(|max_row|+1)\;\times\;(|max_col|+1)$}.$$
+(\MF's full pixel range is rarely implemented, because it would require
+8~megabytes of memory.)
+
+@<Constants...@>=
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!line_length=79; {\\{xxx} strings will not produce lines longer than this}
+@!max_row=79; {vertical extent of pixel image array}
+@!max_col=79; {horizontal extent of pixel image array}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d negate(#) == #:=-# {change the sign of a variable}
+
+@ If the \.{GF} file is badly malformed, the whole process must be aborted;
+\.{GFtype} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{GFtype}.
+@^system dependencies@>
+
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_gf(#)==abort('Bad GF file: ',#,'!')
+@.Bad GF file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{GFtype} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used.
+
+The next few sections of \.{GFtype} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{GFtype} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+If such codes appear in the \.{GF} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{GFtype}.
+So we shall assume that the \PASCAL\ system being used for \.{GFtype}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{GFtype} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Generic font file format.
+The most important output produced by a typical run of \MF\ is the
+``generic font'' (\.{GF}) file that specifies the bit patterns of the
+characters that have been drawn. The term {\sl generic\/} indicates that
+this file format doesn't match the conventions of any name-brand manufacturer;
+but it is easy to convert \.{GF} files to the special format required by
+almost all digital phototypesetting equipment. There's a strong analogy
+between the \.{DVI} files written by \TeX\ and the \.{GF} files written
+by \MF; and, in fact, the file formats have a lot in common.
+It is therefore not surprising that \.{GFtype} is identical in many
+respects to the \.{DVItype} program.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`|boc|' (beginning of character) command has six parameters, each of
+which is four bytes long. Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a |boc| command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an |eoc| command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each |eoc| command is immediately followed by a
+|boc| command, or by a |post| command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+@ The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~|m|; and (b)~the current row number,~|n|. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to get extremely large, but the \.{GF} format tries to be more general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising the
+region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
+coordinates |(x,y)| satisfy |m<=x<=m+1| and |n<=y<=n+1|. Negative values of
+|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of |n| and~|y| correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides |m| and |n|, there's also a third aspect of the current
+state, namely the @!|paint_switch|, which is always either \\{black} or
+\\{white}. Each \\{paint} command advances |m| by a specified amount~|d|,
+and blackens the intervening pixels if |paint_switch=black|; then
+the |paint_switch| changes to the opposite state. \.{GF}'s commands are
+designed so that |m| will never decrease within a row, and |n| will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened.
+
+@ Here is a list of all the commands that may appear in a \.{GF} file. Each
+command is specified by its symbolic name (e.g., |boc|), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|d[2]|' means that parameter |d| is two bytes long.
+
+\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
+nothing but change the |paint_switch| from \\{black} to \\{white} or vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with |d=1| to~63, defined as follows: If
+|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
+in columns |m| through |m+d-1| inclusive. Then, in any case,
+complement the |paint_switch| and advance |m| by~|d|.
+
+\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
+value of~|d|; \MF\ uses it to paint when |64<=d<256|.
+
+\yskip\hang|@!paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
+as~65535.
+
+\yskip\hang|@!paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
+|max_n[4]|. Beginning of a character: Here |c| is the character code, and
+|p| points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer |p| is |-1| if there was no
+prior character with an equivalent code.) The values of registers |m| and |n|
+defined by the instructions that follow for this character must
+satisfy |min_m<=m<=max_m| and |min_n<=n<=max_n|. (The values of |max_m| and
+|min_n| need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
+initialize the bounds of an array. Then it sets |m:=min_m|, |n:=max_n|, and
+|paint_switch:=white|.
+
+\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
+Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
+and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)
+
+\yskip\hang|eoc| 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have |eoc| immediately following |boc|.
+
+\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=white|. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m:=min_m|, and set
+|paint_switch:=white|. This is a way to produce |d| all-white rows.
+
+\yskip\hang|@!skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
+as 65535.
+
+\yskip\hang|@!skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=black|. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
+|new_row_0|, but with |m:=min_m+1| through |min_m+164|, respectively.
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear within characters,
+in \.{GF} files generated by other
+processors. It is recommended that |x| be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang|@!xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
+ridiculously large; |k| mustn't be negative.
+
+\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
+it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang|no_op| 244. No operation, do nothing. Any number of |no_op|'s
+may occur between \.{GF} commands, but a |no_op| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
+This command will appear only in the postamble, which will be explained shortly.
+
+\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
+Same as |char_loc|, except that |dy| is assumed to be zero, and the value
+of~|dx| is taken to be |65536*dm|, where |0<=dm<256|.
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter |i| is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first |boc|.)
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}
+
+@ Here are the opcodes that \.{GFtype} actually refers to.
+
+@d paint_0=0 {beginning of the \\{paint} commands}
+@d paint1=64 {move right a given number of columns, then
+ black${}\swap{}$white}
+@d boc=67 {beginning of a character}
+@d boc1=68 {abbreviated |boc|}
+@d eoc=69 {end of a character}
+@d skip0=70 {skip no blank rows}
+@d skip1=71 {skip over blank rows}
+@d new_row_0=74 {move down one row and then right}
+@d xxx1=239 {for \&{special} strings}
+@d yyy=243 {for \&{numspecial} numbers}
+@d no_op=244 {no operation}
+@d char_loc=245 {character locators in the postamble}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The last character in a \.{GF} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
+ |min_m[4]| |max_m[4]| |min_n[4]| |max_n[4]|\cr
+ $\langle\,$character locators$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the byte following the final |eoc| in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The |ds| and |cs| parameters
+@^design size@> @^check sum@>
+give the design size and check sum, respectively, which are exactly the
+values put into the header of any \.{TFM} file that shares information with this
+\.{GF} file. Parameters |hppp| and |vppp| are the ratios of
+pixels per point, horizontally and vertically, expressed as |scaled| integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
+registers |m| and~|n| assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; |max_m| and |min_n| may, on the
+other hand, be tighter than the similar bounds in |boc| commands. For
+example, some character may have |min_n=-100| in its |boc|, but it might
+turn out that |n| never gets lower than |-50| in any character; then
+|min_n| can have any value |<=-50|. If there are no characters in the file,
+it's possible to have |min_m>max_m| and/or |min_n>max_n|.)
+
+@ Character locators are introduced by |char_loc| commands,
+which specify a character residue~|c|, character escapements (|dx,dy|),
+a character width~|w|, and a pointer~|p|
+to the beginning of that character. (If two or more characters have the
+same code~|c| modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+The character escapements (|dx,dy|) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of |scaled| pixels;
+i.e., |dx| is in horizontal pixel units times $2^{16}$, and |dy| is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, |dy|
+should be zero, but other document file formats allow nonzero vertical
+escapement.
+
+The character width~|w| duplicates the information in the \.{TFM} file; it
+is $2^{24}$ times the ratio of the true width to the font's design size.
+
+The backpointer |p| points to the character's |boc|, or to the first of
+a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
+immediately precede the |boc|, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about |p| applies also to the backpointers
+in |boc| commands, even though it wasn't explained in the description
+of~|boc|. @^backpointers@>
+
+Pointer |p| might be |-1| if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had |proofing<0| when the character was being shipped out,
+but then made |proofing>=0| in order to get a \.{GF} file.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the character locators, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~131, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @"DF in hexadecimal).
+@^Fuchs, David Raymond@>
+\MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating systems.
+But if \.{GF} files have to be processed under the restrictions of standard
+\PASCAL, one can simply read them from front to back. This will
+be adequate for most applications. However, the postamble-first approach
+would facilitate a program that merges two \.{GF} files, replacing data
+from one that is overridden by corresponding data in the other.
+
+@* Input from binary files.
+We have seen that a \.{GF} file is a sequence of 8-bit bytes. The bytes
+appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{GFtype} is written in standard \PASCAL.
+@^system dependencies@>
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with one binary file variable: |gf_file| is the main
+input file that we are translating into symbolic form.
+
+@<Glob...@>=
+@!gf_file:byte_file; {the stuff we are \.{GF}typing}
+
+@ To prepare this file for input, we |reset| it.
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file);
+cur_loc:=0;
+end;
+
+@ If you looked carefully at the preceding code, you probably asked,
+``What is |cur_loc|?'' Good question. It's a global variable that holds
+the number of the byte about to be read next from |gf_file|.
+
+@<Glob...@>=
+@!cur_loc:integer; {where we are about to look, in |gf_file|}
+
+@ We shall use a set of simple functions to read the next byte or
+bytes from |gf_file|. There are four possibilities, each of which is
+treated as a separate function in order to minimize the overhead for
+subroutine calls.
+@^system dependencies@>
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read(gf_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@* Optional modes of output.
+\.{GFtype} will print different quantities of information based on some
+options that the user must specify: We set |wants_mnemonics| if the
+user wants to see a mnemonic dump of the \.{GF} file; and we set
+|wants_pixels| if the user wants to see a pixel image of each
+character.
+
+When \.{GFtype} begins, it engages the user in a brief dialog so that the
+options will be specified. This part of \.{GFtype} requires nonstandard
+\PASCAL\ constructions to handle the online interaction; so it may be
+preferable in some cases to omit the dialog and simply to produce the maximum
+possible output (|wants_mnemonics=wants_pixels=true|). On other hand, the
+necessary system-dependent routines are not complicated, so they can be
+introduced without terrible trauma.
+@^system dependencies@>
+
+@<Glob...@>=
+@!wants_mnemonics: boolean; {controls mnemonic output}
+@!wants_pixels: boolean; {controls pixel output}
+
+@ @<Set init...@>=
+wants_mnemonics:=true; wants_pixels:=true;
+
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+
+@ Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall invoke a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ During the dialog, extensions of \.{GFtype} might treat the first blank
+space in a line as the end of that line. Therefore |input_ln| makes sure
+that there is always at least one blank space in |buffer|.
+
+(This routine is more complex than the present implementation needs, but
+it has been copied from \.{DVItype} so that system-dependent changes that
+worked before will work again.)
+@^system dependencies@>
+
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+
+@ This is humdrum.
+
+@p function lower_casify(@!c:ASCII_code):ASCII_code;
+begin
+if (c>="A") and (c<="Z") then lower_casify:=c+"a"-"A"
+else lower_casify:=c;
+end;
+
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{GFtype} begins.
+@^system dependencies@>
+
+@p procedure dialog;
+label 1,2;
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);@/
+@<Determine whether the user |wants_mnemonics|@>;
+@<Determine whether the user |wants_pixels|@>;
+@<Print all the selected options@>;
+end;
+
+@ @<Determine whether the user |wants_mnemonics|@>=
+1: write(term_out,'Mnemonic output? (default=no, ? for help): ');
+@.Mnemonic output?@>
+input_ln;
+buffer[0]:=lower_casify(buffer[0]);
+if buffer[0]<>"?" then
+ wants_mnemonics:=(buffer[0]="y")or(buffer[0]="1")or(buffer[0]="t")
+else begin write(term_out,'Type Y for complete listing,');
+ write_ln(term_out,' N for errors/images only.');
+ goto 1;
+ end
+
+@ @<Determine whether the user |wants_pixels|@>=
+2: write(term_out,'Pixel output? (default=yes, ? for help): ');
+@.Pixel output?@>
+input_ln;
+buffer[0]:=lower_casify(buffer[0]);
+if buffer[0]<>"?" then
+ wants_pixels:=(buffer[0]="y")or(buffer[0]="1")or(buffer[0]="t")
+ or(buffer[0]=" ")
+else begin write(term_out,'Type Y to list characters pictorially');
+ write_ln(term_out,' with *''s, N to omit this option.');
+ goto 2;
+ end
+
+@ After the dialog is over, we print the options so that the user
+can see what \.{GFtype} thought was specified.
+
+@<Print all the selected options@>=
+print('Options selected: Mnemonic output = ');
+@.Options selected@>
+if wants_mnemonics then print('true')@+else print('false');
+print('; pixel output = ');
+if wants_pixels then print('true')@+else print('false');
+print_ln('.')
+
+@* The image array.
+The definition of \.{GF} files refers to two registers,
+|m| and~|n|, which hold integer column and row numbers. We actually
+keep the values $m'=m-|min_m|$ and $n'=|max_n|-n$ instead, so that
+our internal image array always has |m,n>=0|. We also
+need to remember |paint_switch|, whose value is either |black|
+or |white|.
+
+@<Glob...@>=
+@!m,@!n:integer; {current state values, modified by |min_m| and |max_n|}
+@!paint_switch: pixel;
+
+@ We'll need a big array of pixels to hold the character image. Each
+pixel should be represented as a single bit in order to save space.
+Some systems may prefer the following definitions, while others
+may do better using the |boolean| type and boolean constants.
+@^system dependencies@>
+
+@d white=0 {could also be |false|}
+@d black=1 {could also be |true|}
+
+@<Types...@>=
+@!pixel=white..black; {could also be |boolean|}
+
+@ In order to allow different systems to change the |image| array easily from
+row-major order to column-major order (or vice versa), or to transpose it top
+and bottom or left and right, we declare and access it as follows.
+@^system dependencies@>
+
+@d image==image_array[m,n]
+
+@<Glob...@>=
+@!image_array: packed array [0..max_col,0..max_row] of pixel;
+
+@ A |boc| command has parameters |min_m|, |max_m|, |min_n|, and |max_n|
+that define a rectangular subarray in which the pixels of the current
+character must lie. The program here computes limits on \.{GFtype}'s
+modified |m| and |n| variables, and clears the resulting subarray
+to all |white|.
+
+(There may be a faster way to clear a subarray on particular systems,
+using nonstandard extensions of \PASCAL.)
+@^system dependencies@>
+
+@<Clear the image@>=
+begin max_subcol:=max_m_stated-min_m_stated-1;
+if max_subcol>max_col then max_subcol:=max_col;
+max_subrow:=max_n_stated-min_n_stated;
+if max_subrow>max_row then max_subrow:=max_row;
+n:=0;
+while n<=max_subrow do
+ begin m:=0;
+ while m<=max_subcol do
+ begin image:=white; incr(m);
+ end;
+ incr(n);
+ end;
+end
+
+@ @<Glob...@>=
+@!max_subrow,@!max_subcol:integer; {size of current subarray of interest}
+
+@ As we paint the pixels of a character, we will record its actual
+boundaries in variables |max_m_observed| and |max_n_observed|.
+Then the following routine will be called on to output the image,
+using blanks for |white| and asterisks for |black|. Blanks are
+emitted only when they are followed by nonblanks, in order to conserve
+space in the output. Further compaction could be achieved on many
+systems by using tab marks.
+@^system dependencies@>
+
+An integer variable |b| will be declared for use in counting blanks.
+
+@<Print the image@>=
+begin @<Compare the subarray boundaries with the observed boundaries@>;
+if max_subcol>=0 then {there was at least one \\{paint} command}
+ @<Print asterisk patterns for rows 0 to |max_subrow|@>
+else print_ln('(The character is entirely blank.)');
+end
+
+@ @<Glob...@>=
+@!min_m_stated, @!max_m_stated, @!min_n_stated, @!max_n_stated: integer;
+ {bounds stated in the \.{GF} file}
+@!max_m_observed,@!max_n_observed: integer;
+ {bounds on $(m',n')$ actually observed when painting}
+@!min_m_overall, @!max_m_overall, @!min_n_overall, @!max_n_overall: integer;
+ {bounds observed in the entire file so far}
+
+@ If the given character is substantially smaller than the |boc|
+command predicted, we don't want to bother to output rows and columns
+that are all blank.
+
+@<Compare the subarray boundaries with the observed boundaries@>=
+if (max_m_observed>max_col)or(max_n_observed>max_row) then
+ print_ln('(The character is too large to be displayed in full.)');
+@.The character is too large...@>
+if max_subcol>max_m_observed then max_subcol:=max_m_observed;
+if max_subrow>max_n_observed then max_subrow:=max_n_observed;
+
+@ @<Print asterisk patterns...@>=
+begin print_ln('.<--This pixel''s lower left corner is at (',
+ min_m_stated:1,',',max_n_stated+1:1,') in METAFONT coordinates');
+@.This pixel's lower...@>
+n:=0;
+while n<=max_subrow do
+ begin m:=0; b:=0;
+ while m<=max_subcol do
+ begin if image=white then incr(b)
+ else begin while b>0 do
+ begin print(' '); decr(b);
+ end;
+ print('*');
+ end;
+ incr(m);
+ end;
+ print_nl; incr(n);
+ end;
+print_ln('.<--This pixel''s upper left corner is at (',
+ min_m_stated:1,',',max_n_stated-max_subrow:1,
+ ') in METAFONT coordinates');
+@.This pixel's upper@>
+end
+
+@* Translation to symbolic form.
+The main work of \.{GFtype} is accomplished by the |do_char| procedure,
+which produces the output for an entire character, assuming that the |boc|
+command for that character has already been processed. This procedure is
+essentially an interpretive routine that reads and acts on the \.{GF}
+commands.
+
+@ We steal the following routine from \MF.
+
+@d unity == @'200000 {$2^{16}$, represents 1.00000}
+
+@p procedure print_scaled(@!s:integer);
+ {prints a scaled number, rounded to five digits}
+var @!delta:integer; {amount of allowable inaccuracy}
+begin if s<0 then
+ begin print('-'); negate(s); {print the sign, if negative}
+ end;
+print(s div unity:1); {print the integer part}
+s:=10*(s mod unity)+5;
+if s<>5 then
+ begin delta:=10; print('.');
+ repeat if delta>unity then
+ s:=s+@'100000-(delta div 2); {round the final digit}
+ print(chr(ord('0')+(s div unity))); s:=10*(s mod unity); delta:=delta*10;
+ until s<=delta;
+ end;
+end;
+
+@ Let's keep track of how many characters are in the font, and the
+locations of where each one occurred in the file.
+
+@<Glob...@>=
+@!total_chars:integer; {the total number of characters seen so far}
+@!char_ptr: array[0..255] of integer; {correct character location pointer}
+@!gf_prev_ptr: integer; {|char_ptr| for next character}
+@!character_code: integer; {current character number}
+
+@ @<Set init...@>=
+for i:=0 to 255 do char_ptr[i]:=-1; {mark characters as not being in the file}
+total_chars:=0;
+
+@ Before we get into the details of |do_char|, it is convenient to
+consider a simpler routine that computes the first parameter of each
+opcode.
+
+@d four_cases(#)==#,#+1,#+2,#+3
+@d eight_cases(#)==four_cases(#),four_cases(#+4)
+@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
+@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
+@d thirty_seven_cases(#)==thirty_two_cases(#),four_cases(#+32),#+36
+@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
+
+@p function first_par(o:eight_bits):integer;
+begin case o of
+sixty_four_cases(paint_0): first_par:=o-paint_0;
+paint1,skip1,char_loc,char_loc+1,xxx1: first_par:=get_byte;
+paint1+1,skip1+1,xxx1+1: first_par:=get_two_bytes;
+paint1+2,skip1+2,xxx1+2: first_par:=get_three_bytes;
+xxx1+3,yyy: first_par:=signed_quad;
+boc,boc1,eoc,skip0,no_op,pre,post,post_post,undefined_commands: first_par:=0;
+sixty_four_cases(new_row_0), sixty_four_cases(new_row_0+64),
+ thirty_seven_cases(new_row_0+128): first_par:=o-new_row_0;
+end;
+end;
+
+@ Strictly speaking, the |do_char| procedure is really a function with
+side effects, not a `\&{procedure}'\thinspace; it returns the value |false|
+if \.{GFtype} should be aborted because of some unusual happening. The
+subroutine is organized as a typical interpreter, with a multiway branch
+on the command code.
+
+@p function do_char:boolean;
+label 9998,9999;
+var o:eight_bits; {operation code of the current command}
+@!p,@!q:integer; {parameters of the current command}
+@!aok:boolean; {the value to return}
+begin {we've already scanned the |boc|}
+aok:=true;
+while true do @<Translate the next command in the \.{GF} file;
+ |goto 9999| if it was |eoc|;
+ |goto 9998| if premature termination is needed@>;
+9998: print_ln('!'); aok:=false;
+9999: do_char:=aok;
+end;
+
+@ @d show_label(#)==print(a:1,': ',#)
+@d show_mnemonic(#)==if wants_mnemonics then begin print_nl; show_label(#); end
+@d error(#)==begin show_label('! ',#); print_nl; end
+@d nl_error(#)==begin print_nl; show_label('! ',#); print_nl; end
+@d start_op==a:=cur_loc; o:=get_byte; p:=first_par(o);
+ if eof(gf_file) then bad_gf('the file ended prematurely')
+@.the file ended prematurely@>
+
+@<Translate the next command...@>=
+begin start_op;
+@<Start translation of command |o| and |goto| the appropriate label to
+ finish the job@>;
+end
+
+@ The multiway switch in |first_par|, above, was organized by the length
+of each command; the one in |do_char| is organized by the semantics.
+
+@<Start translation...@>=
+if o<=paint1+3 then @<Translate a sequence of |paint| commands,
+ until reaching a non-|paint|@>;
+case o of
+four_cases(skip0): @<Translate a |skip| command@>;
+sixty_four_cases(new_row_0), sixty_four_cases(new_row_0+64),
+ thirty_seven_cases(new_row_0+128):
+ @<Translate a |new_row| command@>;
+@t\4@>@<Cases for commands |no_op|, |pre|, |post|, |post_post|, |boc|,
+ and |eoc|@>@;
+four_cases(xxx1): @<Translate an |xxx| command@>;
+yyy: @<Translate a |yyy| command@>;
+othercases error('undefined command ',o:1,'!')
+@.undefined command@>
+endcases
+
+@ @<Cases for commands |no_op|...@>=
+no_op: show_mnemonic('no op');
+pre: begin error('preamble command within a character!'); goto 9998;
+ end;
+@.preamble command within...@>
+post,post_post: begin error('postamble command within a character!');
+@.postamble command within...@>
+ goto 9998;
+ end;
+boc,boc1: begin error('boc occurred before eoc!'); goto 9998;
+@.boc occurred before eoc@>
+ end;
+eoc: begin show_mnemonic('eoc');
+ print_nl; goto 9999;
+ end;
+
+@ @<Translate an |xxx| command@>=
+begin show_mnemonic('xxx '''); bad_char:=false; b:=16;
+if p<0 then nl_error('string of negative length!');
+@.string of negative length@>
+while p>0 do
+ begin q:=get_byte;
+ if (q<" ")or(q>"~") then bad_char:=true;
+ if wants_mnemonics then
+ begin print(xchr[q]);
+ if b<line_length then incr(b)
+ else begin print_nl; b:=2;
+ end;
+ end;
+ decr(p);
+ end;
+if wants_mnemonics then print('''');
+if bad_char then nl_error('non-ASCII character in xxx command!');
+@.non-ASCII character...@>
+end
+
+@ @<Glob...@>=
+@!bad_char:boolean; {has a non-ASCII character code appeared in this \\{xxx}?}
+
+@ @<Translate a |yyy| command@>=
+begin show_mnemonic('yyy ',p:1,' (');
+if wants_mnemonics then
+ begin print_scaled(p); print(')');
+ end;
+end
+
+@ The bulk of a \.{GF} file generally consists of |paint| commands,
+so we collect them together and print them in an abbreviated format
+on one line.
+
+@<Translate a sequence of |paint| commands...@>=
+begin if wants_mnemonics then print(' paint ');
+repeat @<Paint the next |p| pixels@>;
+start_op;
+until o>paint1+3;
+end
+
+@ @<Paint the next...@>=
+if wants_mnemonics then
+ if paint_switch=white then print('(',p:1,')')@+else print(p:1);
+m:=m+p;
+if m>max_m_observed then max_m_observed:=m-1;
+if wants_pixels then
+ @<Paint pixels |m-p| through |m-1| in row |n| of the subarray@>;
+paint_switch:=white+black-paint_switch
+ {could also be |paint_switch:=not paint_switch|}
+
+@ We use the fact that the subarray has been initialized to all |white|.
+
+@<Paint pixels |m-p|...@>=
+if paint_switch=black then if n<=max_subrow then
+ begin l:=m-p; r:=m-1;
+ if r>max_subcol then r:=max_subcol;
+ m:=l;
+ while m<=r do
+ begin image:=black; incr(m);
+ end;
+ m:=l+p;
+ end
+
+@ @<Translate a |new_row| command@>=
+begin show_mnemonic('newrow ',p:1);
+incr(n); m:=p; paint_switch:=black;
+if wants_mnemonics then print(' (n=',max_n_stated-n:1,')');
+end
+
+@ @<Translate a |skip| command@>=
+begin show_mnemonic('skip',(o-skip1+1)mod 4:1,' ',p:1);
+n:=n+p+1; m:=0; paint_switch:=white;
+if wants_mnemonics then print(' (n=',max_n_stated-n:1,')');
+end
+
+@* Reading the postamble.
+Now imagine that we are reading the \.{GF} file and positioned just
+after the |post| command. That, in fact, is the situation,
+when the following part of \.{GFtype} is called upon to read, translate,
+and check the rest of the postamble.
+
+@p procedure read_postamble;
+var k:integer; {loop index}
+@!p,@!q,@!m,@!u,@!v,@!w,@!c:integer; {general purpose registers}
+begin post_loc:=cur_loc-1;
+print('Postamble starts at byte ',post_loc:1);
+@.Postamble starts at byte n@>
+if post_loc=gf_prev_ptr then print_ln('.')
+else print_ln(', after special info at byte ',gf_prev_ptr:1,'.');
+p:=signed_quad;
+if p<>gf_prev_ptr then
+ error('backpointer in byte ',cur_loc-4:1,
+ ' should be ',gf_prev_ptr:1,' not ',p:1,'!');
+@.backpointer...should be p@>
+design_size:=signed_quad; check_sum:=signed_quad;@/
+print('design size = ',design_size:1,' (');
+print_scaled(design_size div 16); print_ln('pt)');
+print_ln('check sum = ',check_sum:1);@/
+hppp:=signed_quad; vppp:=signed_quad;@/
+print('hppp = ',hppp:1,' ('); print_scaled(hppp); print_ln(')');
+print('vppp = ',vppp:1,' ('); print_scaled(vppp); print_ln(')');
+pix_ratio:=(design_size/1048576)*(hppp/1048576);
+min_m_stated:=signed_quad; max_m_stated:=signed_quad;
+min_n_stated:=signed_quad; max_n_stated:=signed_quad;@/
+print_ln('min m = ',min_m_stated:1,', max m = ',max_m_stated:1);@/
+if min_m_stated>min_m_overall then
+ error('min m should be <=',min_m_overall:1,'!');
+if max_m_stated<max_m_overall then
+ error('max m should be >=',max_m_overall:1,'!');
+print_ln('min n = ',min_n_stated:1,', max n = ',max_n_stated:1);@/
+if min_n_stated>min_n_overall then
+ error('min n should be <=',min_n_overall:1,'!');
+if max_n_stated<max_n_overall then
+ error('max n should be >=',max_n_overall:1,'!');
+@<Process the character locations in the postamble@>;
+@<Make sure that the end of the file is well-formed@>;
+end;
+
+@ @<Glob...@>=
+@!design_size,@!check_sum: integer; {\.{TFM}-oriented parameters}
+@!hppp, @!vppp: integer; {magnification-oriented parameters}
+@!post_loc: integer; {location of the |post| command}
+@!pix_ratio: real; {multiply by this to convert \.{TFM} width to scaled pixels}
+
+@ @<Set init...@>=
+min_m_overall:=max_int; max_m_overall:=-max_int;
+min_n_overall:=max_int; max_n_overall:=-max_int;
+
+@ When we get to the present code, the |post_post| command has
+just been read.
+
+@<Make sure that the end of the file is well-formed@>=
+if k<>post_post then
+ error('should be postpost!');
+@.should be postpost@>
+for k:=0 to 255 do if char_ptr[k]>0 then
+ error('missing locator for character ',k:1,'!');
+@.missing locator...@>
+q:=signed_quad;
+if q<>post_loc then
+ error('postamble pointer should be ',post_loc:1,' not ',q:1,'!');
+@.postamble pointer should be...@>
+m:=get_byte;
+if m<>gf_id_byte then error('identification byte should be ',gf_id_byte:1,
+ ', not ',m:1,'!');
+@.identification byte should be n@>
+k:=cur_loc; m:=223;
+while (m=223)and not eof(gf_file) do m:=get_byte;
+if not eof(gf_file) then bad_gf('signature in byte ',cur_loc-1:1,
+@.signature...should be...@>
+ ' should be 223')
+else if cur_loc<k+4 then
+ error('not enough signature bytes at end of file!')
+@.not enough signature bytes...@>
+
+@ @<Process the character locations...@>=
+repeat a:=cur_loc; k:=get_byte;
+if (k=char_loc)or(k=char_loc+1) then
+ begin c:=first_par(k);
+ if k=char_loc then
+ begin u:=signed_quad; v:=signed_quad;
+ end
+ else begin u:=get_byte*unity; v:=0;
+ end;
+ w:=signed_quad; p:=signed_quad;
+ print('Character ',c:1,': dx ',u:1,' (');
+ print_scaled(u);
+ if v<>0 then
+ begin print('), dy ',v:1,' ('); print_scaled(v);
+ end;
+ print('), width ',w:1,' (');
+ w:=round(w*pix_ratio);
+ print_scaled(w);
+ print_ln('), loc ',p:1);
+ if char_ptr[c]=0 then
+ error('duplicate locator for this character!')
+@.duplicate locator...@>
+ else if p<>char_ptr[c] then
+ error('character location should be ',char_ptr[c]:1,'!');
+@.character location should be...@>
+ char_ptr[c]:=0;
+ k:=no_op;
+ end;
+until k<>no_op
+
+@* The main program.
+Now we are ready to put it all together. This is where \.{GFtype} starts,
+and where it ends.
+
+@p begin initialize; {get all variables initialized}
+dialog; {set up all the options}
+@<Process the preamble@>;
+@<Translate all the characters@>;
+print_nl;
+read_postamble;
+print('The file had ',total_chars:1,' character');
+if total_chars<>1 then print('s');
+print(' altogether.');
+@.The file had n characters...@>
+final_end:end.
+
+@ The main program needs a few global variables in order to do its work.
+
+@<Glob...@>=
+@!a:integer; {byte number of the current command}
+@!b,@!c,@!l,@!o,@!p,@!q,@!r:integer; {general purpose registers}
+
+@ \.{GFtype} looks at the preamble in order to do error checking, and to
+display the introductory comment.
+
+@<Process the preamble@>=
+open_gf_file;
+o:=get_byte; {fetch the first byte}
+if o<>pre then bad_gf('First byte isn''t start of preamble!');
+@.First byte isn't...@>
+o:=get_byte; {fetch the identification byte}
+if o<>gf_id_byte then
+ bad_gf('identification byte should be ',gf_id_byte:1,
+ ' not ',o:1);
+@.identification byte should be n@>
+o:=get_byte; {fetch the length of the introductory comment}
+print('''');
+while o>0 do
+ begin decr(o); print(xchr[get_byte]);
+ end;
+print_ln('''');
+
+@ @<Translate all...@>=
+repeat gf_prev_ptr:=cur_loc;
+ @<Pass |no_op|, |xxx| and |yyy| commands@>;
+ if o<>post then
+ begin if o<>boc then if o<>boc1 then
+ bad_gf('byte ',cur_loc-1:1,' is not boc (',o:1,')');
+@.byte n is not boc@>
+ print_nl; print(cur_loc-1:1,': beginning of char ');
+ @<Pass a |boc| command@>;
+ if not do_char then bad_gf('char ended unexpectedly');
+@.char ended unexpectedly@>
+ max_n_observed:=n;
+ if wants_pixels then @<Print the image@>;
+ @<Pass an |eoc| command@>;
+ end;
+until o=post;
+
+@ @<Pass |no_op|, |xxx| and |yyy| commands@>=
+repeat start_op;
+ if o=yyy then
+ begin @<Translate a |yyy|...@>; o:=no_op;
+ end
+ else if (o>=xxx1) and (o<=xxx1+3) then
+ begin @<Translate an |xxx|...@>; o:=no_op;
+ end
+ else if o=no_op then show_mnemonic('no op');
+until o<>no_op;
+
+@ @<Pass a |boc|...@>=
+a:=cur_loc-1; incr(total_chars);
+if o=boc then
+ begin character_code:=signed_quad;
+ p:=signed_quad;
+ c:=character_code mod 256;
+ if c<0 then c:=c+256;
+ min_m_stated:=signed_quad; max_m_stated:=signed_quad;
+ min_n_stated:=signed_quad; max_n_stated:=signed_quad;
+ end
+else begin character_code:=get_byte; p:=-1; c:=character_code;
+ q:=get_byte; max_m_stated:=get_byte; min_m_stated:=max_m_stated-q;
+ q:=get_byte; max_n_stated:=get_byte; min_n_stated:=max_n_stated-q;
+ end;
+print(c:1);
+if character_code<>c then
+ print(' with extension ',(character_code-c) div 256 : 1);
+if wants_mnemonics then
+ print_ln(': ',min_m_stated:1,'<=m<=',max_m_stated:1,' ',
+ min_n_stated:1,'<=n<=',max_n_stated:1);
+max_m_observed:=-1;
+if char_ptr[c]<>p then
+ error('previous character pointer should be ',char_ptr[c]:1,
+ ', not ',p:1,'!')
+@.previous character...@>
+else if p>0 then if wants_mnemonics then
+ print_ln('(previous character with the same code started at byte ',
+ p:1,')');
+char_ptr[c]:=gf_prev_ptr;
+if wants_mnemonics then print('(initially n=',max_n_stated:1,')');
+if wants_pixels then @<Clear the image@>;
+m:=0; n:=0; paint_switch:=white;
+
+@ @<Pass an |eoc|...@>=
+max_m_observed:=min_m_stated+max_m_observed+1;
+n:=max_n_stated-max_n_observed; {now |n| is the minimum |n| observed}
+if min_m_stated<min_m_overall then min_m_overall:=min_m_stated;
+if max_m_observed>max_m_overall then max_m_overall:=max_m_observed;
+if n<min_n_overall then min_n_overall:=n;
+if max_n_stated>max_n_overall then max_n_overall:=max_n_stated;
+if max_m_observed>max_m_stated then
+ print_ln('The previous character should have had max m >= ',
+ max_m_observed:1,'!');
+@.previous character...@>
+if n<min_n_stated then
+ print_ln('The previous character should have had min n <= ',n:1,'!')
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/help.h b/Build/source/texk/web2c/help.h
new file mode 100644
index 00000000000..ad461ddad63
--- /dev/null
+++ b/Build/source/texk/web2c/help.h
@@ -0,0 +1,443 @@
+/* help.h: help messages for web2c programs.
+
+ This is included by everyone, from cpascal.h. This is better than
+ putting the help messages directly in the change files because (1)
+ multiline strings aren't supported by tangle, and it would be a pain
+ to make up a new syntax for them in web2c, and (2) when a help msg
+ changes, we need only recompile, not retangle or reconvert. The
+ downside is that everything gets recompiled when any msg changes, but
+ that's better than having umpteen separate tiny files. (For one
+ thing, the messages have a lot in common, so it's nice to have them
+ in one place.)
+
+Copyright (C) 1995, 96 Karl Berry, 2001, 03, 04 Olaf Weber.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* Note: Help messages for TeX & MF family moved to texmfmp-help.h, to
+ prevent multiple-definition errors. */
+
+#ifndef HELP_H
+#define HELP_H
+
+#ifdef BIBTEX
+const_string BIBTEXHELP[] = {
+ "Usage: bibtex [OPTION]... AUXFILE[.aux]",
+ " Write bibliography for entries in AUXFILE to AUXFILE.bbl.",
+ "",
+ "-min-crossrefs=NUMBER include item after NUMBER cross-refs; default 2",
+ "-terse do not print progress reports",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* BIBTEX */
+
+#ifdef CWEB
+const_string CWEAVEHELP[] = {
+ "Usage: cweave [OPTIONS] WEBFILE[.w] [{CHANGEFILE[.ch]|-}] [OUTFILE[.tex]]",
+ " Weave WEBFILE with CHANGEFILE into a TeX document.",
+ " Default CHANGEFILE is /dev/null;",
+ " TeX output goes to the basename of WEBFILE extended with `.tex'",
+ " unless otherwise specified by OUTFILE; in this case, '-' specifies",
+ " a null CHANGEFILE.",
+ "",
+ "-b suppress banner line on terminal",
+ "-f do not force a newline after every C statement in output",
+ "-h suppress success message on completion",
+ "-p suppress progress report messages",
+ "-x omit indices and table of contents",
+ "+e enclose C material in \\PB{...}",
+ "+s print usage statistics",
+ "--help display this help and exit",
+ "--version output version information and exit",
+ NULL
+};
+
+const_string CTANGLEHELP[] = {
+ "Usage: ctangle [OPTIONS] WEBFILE[.w] [{CHANGEFILE[.ch]|-}] [OUTFILE[.c]]",
+ " Tangle WEBFILE with CHANGEFILE into a C/C++ program.",
+ " Default CHANGEFILE is /dev/null;",
+ " C output goes to the basename of WEBFILE extended with `.c'",
+ " unless otherwise specified by OUTFILE; in this case, '-' specifies",
+ " a null CHANGEFILE.",
+ "",
+ "-b suppress banner line on terminal",
+ "-h suppress success message on completion",
+ "-p suppress progress report messages",
+ "+s print usage statistics",
+ "--help display this help and exit",
+ "--version output version information and exit",
+ NULL
+};
+#endif /* CWEB */
+
+#ifdef DVICOPY
+const_string DVICOPYHELP[] = {
+ "Usage: dvicopy [OPTION]... [INDVI[.dvi] [OUTDVI[.dvi]]]",
+ " Expand virtual font references in INDVI to OUTDVI.",
+ " Defaults are standard input and standard output, respectively.",
+ "",
+ "-magnification=NUMBER override existing magnification with NUMBER",
+ "-max-pages=NUMBER process NUMBER pages; default one million",
+ "-page-start=PAGE-SPEC start at PAGE-SPEC, for example `2' or `5.*.-2'",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* DVICOPY */
+
+#ifdef DVITOMP
+const_string DVITOMPHELP[] = {
+ "Usage: dvitomp [OPTION]... DVIFILE[.dvi] [MPXFILE[.mpx]]",
+ " Translate DVIFILE to the MetaPost MPXFILE.",
+ " Default MPXFILE is basename of DVIFILE extended with `.mpx'.",
+ "",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* DVITOMP */
+
+#ifdef DVITYPE
+const_string DVITYPEHELP[] = {
+ "Usage: dvitype [OPTION]... DVIFILE[.dvi]",
+ " Verify and translate DVIFILE to human-readable form,",
+ " written to standard output.",
+ "",
+ "-dpi=REAL set resolution to REAL pixels per inch; default 300.0",
+ "-magnification=NUMBER override existing magnification with NUMBER",
+ "-max-pages=NUMBER process NUMBER pages; default one million",
+ "-output-level=NUMBER verbosity level, from 0 to 4; default 4",
+ "-page-start=PAGE-SPEC start at PAGE-SPEC, for example `2' or `5.*.-2'",
+ "-show-opcodes show numeric opcodes (in decimal)",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* DVITYPE */
+
+#ifdef GFTODVI
+const_string GFTODVIHELP[] = {
+ "Usage: gftodvi [OPTION]... GFNAME",
+ " Translate each character in GFNAME to a page in a DVI file,",
+ " which is named with the basename of GFNAME extended with `.dvi'.",
+ "",
+ "-overflow-label-offset=REAL override 2.1in offset for overflow labels",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* GFTODVI */
+
+#ifdef GFTOPK
+const_string GFTOPKHELP[] = {
+ "Usage: gftopk [OPTION]... GFNAME [PKFILE]",
+ " Translate the bitmap font GFNAME to PKFILE.",
+ " Default PKFILE is basename of GFNAME extended with `pk'.",
+ "",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* GFTOPK */
+
+#ifdef GFTYPE
+const_string GFTYPEHELP[] = {
+ "Usage: gftype [OPTION]... GFNAME",
+ " Verify and translate the bitmap font GFNAME to human-readable form,",
+ " written to standard output.",
+ "",
+ "-images show characters as pixels",
+ "-mnemonics translate all GF commands",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* GFTYPE */
+
+#ifdef MFT
+const_string MFTHELP[] = {
+ "Usage: mft [OPTION]... NAME[.mf|.mp]",
+ " Translate MFNAME to TeX for printing, using the mftmac.tex (or",
+ " mptmac.tex) macros. Output goes to basename of NAME extended",
+ " with `.tex'.",
+ "",
+ "-change=CHFILE apply the change file CHFILE as with tangle and weave",
+ "-metapost assume NAME is a METAPOST source file",
+ "-style=MFTNAME use MFTNAME instead of plain.mft (or mplain.mft)",
+ " (this option can be given more than once)",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* MFT */
+
+#ifdef ODVICOPY
+const_string ODVICOPYHELP[] = {
+ "Usage: odvicopy [OPTION]... [INDVI[.dvi] [OUTDVI[.dvi]]]",
+ " Expand virtual font references in INDVI to OUTDVI.",
+ " Defaults are standard input and standard output, respectively.",
+ "",
+ "-magnification=NUMBER override existing magnification with NUMBER",
+ "-max-pages=NUMBER process NUMBER pages; default one million",
+ "-page-start=PAGE-SPEC start at PAGE-SPEC, for example `2' or `5.*.-2'",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* ODVICOPY */
+
+#ifdef ODVITYPE
+const_string ODVITYPEHELP[] = {
+ "Usage: odvitype [OPTION]... DVIFILE[.dvi]",
+ " Verify and translate DVIFILE to human-readable form,",
+ " written to standard output.",
+ "",
+ "-dpi=REAL set resolution to REAL pixels per inch; default 300.0",
+ "-magnification=NUMBER override existing magnification with NUMBER",
+ "-max-pages=NUMBER process NUMBER pages; default one million",
+ "-output-level=NUMBER verbosity level, from 0 to 4; default 4",
+ "-page-start=PAGE-SPEC start at PAGE-SPEC, for example `2' or `5.*.-2'",
+ "-show-opcodes show numeric opcodes (in decimal)",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* ODVITYPE */
+
+#ifdef OFM2OPL
+const_string OFM2OPLHELP[] = {
+ "Usage: ofm2opl [OPTION]... OFMNAME[.ofm] [OPLFILE[.opl]]",
+ " Translate the font metrics OFMNAME to human-readable property list file",
+ " OPLFILE or standard output.",
+ "",
+ "-charcode-format=TYPE output character codes according to TYPE,",
+ " either `hex' or `ascii'; default is hex,",
+ " ascii = ascii letters and digits, hex for all else",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* OFM2OPL */
+
+#ifdef OPL2OFM
+const_string OPL2OFMHELP[] = {
+ "Usage: opl2ofm [OPTION]... OPLFILE[.opl] [OFMFILE[.ofm]]",
+ " Translate the property list OPLFILE to OFMFILE.",
+ " Default OFMFILE is basename of OPLFILE extended with `.ofm'.",
+ "",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* OPL2OFM */
+
+#if defined (OTANGLE) || defined (OTANGLEBOOT)
+const_string OTANGLEHELP[] = {
+ "Usage: otangle [OPTION]... WEBFILE[.web] [CHANGEFILE[.ch]]",
+ " Tangle WEBFILE with CHANGEFILE into a Pascal program.",
+ " Default CHANGEFILE is /dev/null;",
+ " Pascal output goes to the basename of WEBFILE extended with `.p',",
+ " and a string pool file, if necessary, to the same extended with `.pool'.",
+ "",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* OTANGLE */
+
+#ifdef OVF2OVP
+const_string OVF2OVPHELP[] = {
+ "Usage: ovf2ovp [OPTION]... OVFNAME[.ovf] [OFMNAME[.ofm] [OVPFILE[.ovp]]]",
+ " Translate OVFNAME and companion OFMNAME to human-readable",
+ " virtual property list file OVPFILE or standard output.",
+ " If OFMNAME is not specified, OVFNAME (with `.ovf' removed) is used.",
+ "",
+ "-charcode-format=TYPE output character codes according to TYPE,",
+ " either `hex' or `ascii'; default is hex,",
+ " ascii = ascii letters and digits, hex for all else",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* OVF2OVP */
+
+#ifdef OVP2OVF
+const_string OVP2OVFHELP[] = {
+ "Usage: ovp2ovf [OPTION]... OVPFILE[.ovp] [OVFFILE[.ovf] [OFMFILE[.ofm]]]",
+ " Translate OVPFILE to OVFFILE and companion OFMFILE.",
+ " Default OVFFILE is basename of OVPFILE extended with `.ovf'.",
+ " Default OFMFILE is OVFFILE extended with `.ofm'.",
+ "",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* OVP2OVF */
+
+#ifdef PATGEN
+const_string PATGENHELP[] = {
+ "Usage: patgen [OPTION]... DICTIONARY PATTERNS OUTPUT TRANSLATE",
+ " Generate the OUTPUT hyphenation file for use with TeX",
+ " from the DICTIONARY, PATTERNS, and TRANSLATE files.",
+ "",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* PATGEN */
+
+#ifdef PKTOGF
+const_string PKTOGFHELP[] = {
+ "Usage: pktogf [OPTION]... PKNAME [GFFILE]",
+ " Translate the bitmap font PKNAME to GFFILE.",
+ " Default GFFILE is basename of PKNAME extended with `gf'.",
+ "",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* PKTOGF */
+
+#ifdef PKTYPE
+const_string PKTYPEHELP[] = {
+ "Usage: pktype [OPTION]... PKNAME",
+ " Verify and translate the bitmap font PKNAME to human-readable form,",
+ " written to standard output.",
+ "",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* PKTYPE */
+
+#ifdef PLTOTF
+const_string PLTOTFHELP[] = {
+ "Usage: pltotf [OPTION]... PLFILE[.pl] [TFMFILE[.tfm]]",
+ " Translate the property list PLFILE to TFMFILE.",
+ " Default TFMFILE is basename of PLFILE extended with `.tfm'.",
+ "",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* PLTOTF */
+
+#ifdef POOLTYPE
+const_string POOLTYPEHELP[] = {
+ "Usage: pooltype [OPTION]... POOLFILE[.pool]",
+ " Display the string number of each string in POOLFILE.",
+ "",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* POOLTYPE */
+
+#if defined (TANGLE) || defined (TANGLEBOOT)
+const_string TANGLEHELP[] = {
+ "Usage: tangle [OPTION]... WEBFILE[.web] [CHANGEFILE[.ch]]",
+ " Tangle WEBFILE with CHANGEFILE into a Pascal program.",
+ " Default CHANGEFILE is /dev/null;",
+ " Pascal output goes to the basename of WEBFILE extended with `.p',",
+ " and a string pool file, if necessary, to the same extended with `.pool'.",
+ "",
+ "-help display this help and exit",
+ "-length=NUMBER the first NUMBER characters of an identifier have to be",
+ " unique (default 32)",
+ "-loose honor the upper/lower/mixedcase and underline options when",
+ " comparing identifiers (default)",
+ "-lowercase make all identifiers lowercase",
+ "-mixedcase retain the case of identifiers unchanged (default)",
+ "-strict always smash case and remove underlines when comparing",
+ " identifiers",
+ "-underline do not remove underline characters from indentifiers",
+ "-uppercase make all identifiers uppercase",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* TANGLE */
+
+#ifdef TFTOPL
+const_string TFTOPLHELP[] = {
+ "Usage: tftopl [OPTION]... TFMNAME[.tfm] [PLFILE[.pl]]",
+ " Translate the font metrics TFMNAME to human-readable property list file",
+ " PLFILE or standard output.",
+ "",
+ "-charcode-format=TYPE output character codes according to TYPE,",
+ " either `octal' or `ascii'; default is ascii for",
+ " letters and digits, octal for all else",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* TFTOPL */
+
+#ifdef VFTOVP
+const_string VFTOVPHELP[] = {
+ "Usage: vftovp [OPTION]... VFNAME[.vf] [TFMNAME[.tfm] [VPLFILE[.vpl]]]",
+ " Translate VFNAME and companion TFMNAME to human-readable",
+ " virtual property list file VPLFILE or standard output.",
+ " If TFMNAME is not specified, VFNAME (with `.vf' removed) is used.",
+ "",
+ "-charcode-format=TYPE output character codes according to TYPE,",
+ " either `octal' or `ascii'; default is ascii for",
+ " letters and digits, octal for all else",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* VFTOVP */
+
+#ifdef VPTOVF
+const_string VPTOVFHELP[] = {
+ "Usage: vptovf [OPTION]... VPLFILE[.vpl] [VFFILE[.vf] [TFMFILE[.tfm]]]",
+ " Translate VPLFILE to VFFILE and companion TFMFILE.",
+ " Default VFFILE is basename of VPLFILE extended with `.vf'.",
+ " Default TFMFILE is VFFILE extended with `.tfm'.",
+ "",
+ "-help display this help and exit",
+ "-verbose display progress reports",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* VPTOVF */
+
+#ifdef WEAVE
+const_string WEAVEHELP[] = {
+ "Usage: weave [OPTION]... WEBFILE[.web] [CHANGEFILE[.ch]]",
+ " Weave WEBFILE with CHANGEFILE into a TeX document.",
+ " Default CHANGEFILE is /dev/null;",
+ " TeX output goes to the basename of WEBFILE extended with `.tex'.",
+ "",
+ "-x omit cross-reference information",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* WEAVE */
+
+#endif /* not HELP_H */
diff --git a/Build/source/texk/web2c/kpathsea.mk b/Build/source/texk/web2c/kpathsea.mk
new file mode 100644
index 00000000000..99fb51196a3
--- /dev/null
+++ b/Build/source/texk/web2c/kpathsea.mk
@@ -0,0 +1,7 @@
+# web2c/kpathsea.mk -- In subdirectories of web2c, the build directory
+# for kpathsea is one more level up. c_auto_h_dir is used by make depend.
+kpathsea_parent = ../..
+c_auto_h_dir = ..
+
+prog_cflags = -I.. -I$(srcdir)/..
+# End of web2c/kpathsea.mk.
diff --git a/Build/source/texk/web2c/lib/ChangeLog b/Build/source/texk/web2c/lib/ChangeLog
new file mode 100644
index 00000000000..be9c1de8894
--- /dev/null
+++ b/Build/source/texk/web2c/lib/ChangeLog
@@ -0,0 +1,2063 @@
+2005-08-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * printversion.c: Update copyright messages.
+
+2005-08-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Implement -etex switch.
+
+2005-07-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (opennameok): Check all occurrences of ".." in a
+ filename, not just the first. Reported by Yutaka OIWA
+ <y.oiwa@aist.go.jp>.
+
+2005-07-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * printversion.c: libkpathsea is covered by the LGPL, not the GPL,
+ and is the common factor that brings in the *GPL to all
+ web2c-based programs.
+
+ * texmfmp.c (get_seconds_and_micros): New function, gets high-res
+ time if possible. Remove references to pdfxtex.
+
+2005-07-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * input2int.c: The correct format string to use depends on whether
+ integer is an int or a long int. Reported by M.J. Rutter
+ <mjr19@cus.cam.ac.uk>.
+
+2005-06-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Replace ac_include with kpse_include. From Peter
+ Breitenlohner.
+
+2005-06-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c [MP][BANNER]: Update for MetaPost 0.901.
+
+2005-06-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (opennameok,openinnameok,openoutnameok): Add new
+ parameter to opennameok() so its diagnostics are correct wrt to
+ whether we are testing a file name for reading or writing.
+
+2005-04-12 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (getjobname): Add a parameter, the string to return if
+ --jobname wasn't given.
+ This is part of a group of changes that fix pdftex bug 302.
+ http://sarovar.org/tracker/?func=detail&atid=493&aid=302&group_id=106
+
+ * openclose.c (open_input): kpse_find_file() always returns a new
+ string, so we can unconditionally deallocate it.
+
+ * texmfmp.c (maininit): Factor out common code into texmf_yesno().
+ (texmf_yesno): New function, return true if a variable is set and set
+ to 't', 'y', or '1' in texmf.cnf or the environment.
+
+2004-12-20 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c [pdfTeX,pdfeTeX,pdfxTeX]: New variable ptexbanner.
+
+2004-12-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c [TeX] (maininit): For all TeX variants, recognize
+ "initex" and "virtex" program names, just in case.
+
+2004-09-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * printversion.c (printversionandexit): Hartmut Henkel
+ <hartmut_henkel@gmx.de> noticed that the engines start running
+ like this: "This is TeX, Version 3.141592 (Web2C 7.5.3)" but the
+ -version output looks like this "TeX (Web2C 7.5.3) 3.141592".
+ He supplied a small patch to rectify this.
+
+2004-08-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * openclose.c (open_input,open_output): Implement output_directory
+ option.
+
+ * texmfmp.c: Accept -output-directory option.
+
+2004-07-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (setupcharset): Remove this fuction. The
+ initialization is performed is done by the engine.
+ (read_char_translation_file): Rename to readtcxfile.
+ (readtcxfile): Some comment changes compared to its previous
+ incarnation.
+
+ * usage.c (usagehelp): Add second argument, email address for bug
+ reports. Requested by the pdftex team.
+
+ * texmfmp.c: Add -output-format to the long_options array.
+ Also add BUG_ADDRESS to the macros defined for each engine.
+ Call usagehelp with BUG_ADDRESS as second argument.
+
+2004-07-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (parse_options): Make it so that aleph and omega also
+ parse the -translate-file and -8bit options, even though they now
+ silently ignore them. (They have to ignore them in any case, as
+ neither makes sense for these programs.)
+
+2004-07-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c [TeX]: Implement -efmt as alternate spelling for -fmt.
+ This option is only present for backward compatibility, and will
+ go away in the future.
+
+2004-06-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Don't include alloca.o in the objects. It
+ shouldn't be used anywhere.
+
+2004-06-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (get_input_name): Off-by-one errors when
+ erasing/restoring the final quote. From Akira Kakuto
+ <kakuto@fsci.fuk.kindai.ac.jp>.
+
+2004-06-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: (normalize_quotes): New function, takes a filename
+ and returns an allocated string with the name quoted iff it
+ contains a space.
+ (get_input_file_name): Factor out normalize_quotes.
+ (getjobname): Add quotes if needed. callmakempx: Add quotes if
+ needed.
+
+2004-06-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (get_input_file_name): New function. Get the name of
+ the input file for use by parse_first_line(), and if the filename
+ contains spaces make sure a properly quoted version will be given
+ to TeX.
+ (parse_first_line): Now takes the name of the input file (or NULL) as
+ an argument, instead of looking for it.
+
+2004-05-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Remove -oem code.
+
+2004-05-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Remove much of the locale-dependent code. Some
+ pieces remain because they are related to the Win32 '-oem' option,
+ where I do not know yet whether that option should go as well.
+
+2004-05-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (setupcharset): Fixing a regression. When a line in a
+ TCX file contains two numbers and a comment, set printable=1.
+ Reported by Staszek Wawrykiewicz <staw@gust.org.pl>.
+
+2004-05-08 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (main): We can now put TEXMFENGINENAME into the
+ environment for $engine in all cases.
+
+ * texmfmp.c: Add -halt-on-error option.
+
+2004-05-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (maininit): Set $engine appropriately.
+
+ * texmfmp.c: Implement -8bit option.
+
+ * texmfmp.c (makesrcspecial): Always put a space after the line
+ number.
+
+2004-04-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (setupcharset): More compact xprn assignment.
+
+2004-03-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Implement -no-shell-escape, -no-parse-first-line,
+ -no-file-line-error.
+
+2004-03-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c [eTeX](maininit): e-TeX will no longer treat being
+ called as "initex" or "virtex" special.
+ (tcx_get_num): Additional argument, upper bound we're accepting.
+ (read_char_translation_file): Allow for a third integer, 0 or 1, to
+ set printable status. This way you can translate characters
+ without making them printable. However, enforce that 7bit ASCII
+ remains printable.
+
+ * texmfmp.c (maininit): Add sanity check for -enc or -mltex
+ without -ini.
+
+2004-03-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * zround.c: Add public domain notice.
+
+ * win32main.c: Add public domain notice.
+
+ * version.c: Add public domain notice.
+
+ * uexit.c: Add public domain notice.
+
+ * printversion.c: Bump 2003 to 2004 in copyright notices.
+
+ * main.c: Add public domain notice.
+
+ * inputint.c: Add public domain notice.
+
+ * input2int.c: Add public domain notice.
+
+ * fprintreal.c: Add public domain notice.
+
+ * eofeoln.c: Add public domain notice.
+
+2004-03-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (parse_options): Add -output-format for the pdf*TeX
+ family.
+
+ * texmfmp.c: Changes for Aleph.
+
+ * texmfmp.c (long_options): Enable "enc" option.
+
+2004-03-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Allow file:line:error style messages to be enabled
+ from texmf.cnf. From Akira Kakuto <kakuto@fsci.fuk.kindai.ac.jp>.
+
+2004-02-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Rename isprintable to xprn.
+
+ * win32main.c: Sync with TeXlive.
+
+ * texmfmp.c: Add -enc option.
+
+ * texmfmp.c: Add support for pdfxTeX.
+
+2003-02-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Update banners for TeX 3.141592, MF 2.71828.
+
+2003-02-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: e-Omega support.
+
+2003-01-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (setupcharset): Do not adapt the isprintable array to
+ the locale.
+
+2003-01-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * printversion.c (printversionandexit): Update copyright notice
+ years.
+
+2002-12-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Remove some unsused variables.
+
+2002-11-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Implement a -parse-first-line option. With the
+ current code it is possible to switch %&-line parsing on from the
+ command line. To switch it off when it is enabled in texmf.cnf
+ requires the use of an environment variable.
+
+2002-10-20 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Add support for -jobname option.
+
+2002-10-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (maybe_parse_first_line): Split
+ maybe_parse_first_line: maybe_parse_first_line is called to set
+ parse_first_line_p for TeX, MF, MP, and parse_first_line is called
+ to do the actual parsing.
+
+ * texmfmp.c: Add support for mktexfmt; from Fabrice Popineau.
+
+2002-06-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Do not allow texmf.cnf to set the src_specials
+ option.
+
+2002-06-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Change handling of source specials so that there is a
+ single flag, src_specials_p, which can be used to see if any
+ source specials are generated.
+
+ * win32main.c: From Fabrice.
+
+2002-04-02 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c [Omega] (ipcpage,gettexstring): Correction of the way
+ the strstartar array is handled. Reported by Akira Kakuto
+ <kakuto@fsci.fuk.kindai.ac.jp>
+
+2001-11-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (initscreen): Clarify message generated when an X
+ window cannot be opened.
+
+2001-11-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Remove unnecessary casts to (int*). If C++ ->
+ NO_MF_ASM.
+
+ * alloca.c: Changes to allow this file to compile with C++.
+
+2001-11-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Changes to keep C++ compilers from choking.
+
+ * openclose.c: Remove double declaration of recorder_name, make
+ prototype of open_input consistent with cpascal.h.
+
+2001-11-18 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * uexit.c: Changes to keep C++ compilers from choking.
+
+ * texmfmp.c: Changes to keep C++ compilers from choking. Changes
+ to support the filename recorder.
+
+ * printversion.c: Changes to keep C++ compilers from choking.
+
+ * openclose.c: Changes to keep C++ compilers from choking.
+ (recorder_start): New function, starts filename recorder.
+ (recorder_change_filename): New function, change the name of the file
+ used by the filename recorder.
+ (open_input,open_output): Record filename, starting recorder if
+ necessary.
+
+ * chartostring.c: Changes to keep C++ compilers from choking.
+
+ * basechsuffix.c: Changes to keep C++ compilers from choking.
+
+2001-11-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (getrandomseed): If available use gettimeofday or
+ ftime to obtain a random seed number. These functions have a
+ higher resolution, so fix the problem that subsequent MF or MP
+ runs could have the same seed.
+
+2001-10-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Add support for source specials.
+
+ * openclose.c: Add support for file:line:style messages.
+
+2001-10-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Implement -tex=program option for mp.
+
+2001-10-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * usage.c (usage): Remove first argument, should now only be
+ called on abnormal exit.
+ (usage_help): Print help message, implies a normal exit.
+
+ * texmfmp.c: Modify usage/usage_help invocation.
+
+ * eofeoln.c (readln): New function, read a line and accept CRNL,
+ CR, and NL as end-of-line delimiters.
+
+2001-04-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * eofeoln.c (eoln): Accept both CR and LF as end-of-line
+ characters.
+
+2000-08-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (setupboundvariable): Add parentheses for clarity, and
+ to silence stupid compilers.
+
+2000-05-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (calledit): The first argument should be a pointer to
+ packedASCIIcode. This matters for Omega. From "C.M. Connelly"
+ <c@eskimo.com>.
+
+2000-04-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c [WIN32]: Add support for -oem option. From Fabrice.
+
+2000-04-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * openclose.c: Disabled the supporting code for remembering the
+ full name while the code for C style error messages and source
+ specials is under review.
+
+2000-04-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * openclose.c (open_input): Save full name of found file in
+ full_name_of_file variable. For "C-style" error messages and
+ source-file specials. After Stefan Ulrich
+ <ulrich@cis.uni-muenchen.de> and Fabrice Popineau
+ <Fabrice.Popineau@supelec.fr>.
+
+2000-01-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (parse_options): Stop option-processing at the first
+ non-option, so that a command line like 'tex \&sgmlbase
+ -lhtmlbase.tex -ousing.html using.html' feeds the '-lhtmlbase.tex'
+ and '-ousing.html' to the format. Reported by Jonathan Fine
+ <fine@active-tex.demon.co.uk>.
+
+1999-07-12 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (maininit): Add a --default-translate-file option, to
+ facilitate CSTeX. Suggestion (relayed?) by Petr Olsak
+ <olsak@math.feld.cvut.cz>.
+ (input_line): Make sure that catching a SIGINT won't be seen as a EOF
+ on the terminal. Problem noticed by DEK.
+
+1999-06-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * openclose.c (open_input): The pdfTeX people asked that the disk
+ not be pounded for .vf files.
+
+1999-05-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (opennameok): Allow ./ or its equivalent. Use
+ IS_DIR_SEP rather than comparing against DIR_SEP.
+
+ * openclose.c (open_input): Correct comment.
+
+1999-03-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (parse_options): Explicit --progname override the
+ inferred programe of the --fmt option. Suggested by Sebastian.
+ (ztakefraction,ztakescaled,zmakescaled,blankrectangle,paintrow): Add
+ prototypes. From Thomas.
+
+1999-02-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: The translate_filename variable is now external. Use
+ kpse_web2c_format to find tcx files.
+
+1999-02-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Remove include for kpathsea/config.h because it is
+ superfluous.
+ (calledit): Use P?C macro in definition.
+
+1999-02-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (maybe_parse_first_line): Allow both --translate-file
+ and -translate-file in first line.
+
+ * main.c (main): Remove __cdecl, from Fabrice.
+
+1999-01-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * zround.c (zround): Add cast to quiet compiler. By Fabrice.
+
+ * usage.c (usage): Use KPSEDLL for kpse_bug_address. By Fabrice.
+
+ * texmfmp.c [WIN32]: include sys/timeb.h.
+ (mainbody): Add TEXDLL to declaration.
+ (maininit): The old main function renamed.
+ (main): A new main function, stripped to the bones.
+ (getrandomseed): Get a random seed from the current time.
+ All after Fabrice.
+
+ * printversion.c (printversionandexit): Add KPSEDLL for
+ kpathsea_version_string, by Fabrice.
+
+ * main.c (main): Add __cdecl, from Fabrice.
+
+1999-01-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Support for pdfeTeX. From Thomas Esser.
+
+ * texmfmp.c (maybe_parse_first_line): Default to parsing if
+ maybe_parse_first_line is not defined in texmf.cnf.
+ (opennameok): Add an argument to specify default.
+ (openinok): Default to "a" if no openin_any found.
+ (openoutok): Default to "p" if no openout_any found.
+
+ * mfmpw32.c: Change CRNL to NL line-endings.
+
+1999-01-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Further changes and fixes for maybe_parse_first_line.
+ Add openinnameok and openoutnameok, which call opennameok.
+ (opennameok): Change implementation to reflect this.
+
+1999-01-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Rename maybe_set_dump_default_from_input to
+ maybe_parse_first_line. Add TCX support in the form of allowing a
+ --translate-file pseudo-option, as proposed by Wlodzimierz Bzyl
+ <matwb@monika.univ.gda.pl>.
+
+ * printversion.c: Correct --version output.
+
+ * Makefile.in: Rename kpathsea.make to kpathsea.mk.
+
+1999-01-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Update banners, add MFNOWIN ifdef.
+
+ * printversion.c (printversionandexit): Improve & update message.
+
+ * Makefile.in: Change of ../make/*.make to ../make/*.mk.
+
+1998-12-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Replace isblank with ISBLANK, to improve handling of
+ whitespace.
+
+1998-07-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c (parse_options): Make --progname a no-op after --fmt
+ has been seen. Thus the order of these options no longer matters.
+
+ * texmfmp.c: Rename openoutnameok to opennameok.
+
+Sun May 31 17:27:22 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c: Add a parse_first_line configuration entry, so the
+ %&format construct can be switched off when desired. Suggested by
+ Denis B Roegel.
+ Add a --debug-format option.
+
+Mon May 4 19:41:22 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * basechsuffix.c (basenamechangesuffix): Replace call of basename
+ with xbasename.
+
+ * texmfmp.c (openoutnameok): Replace call of basename with
+ xbasename.
+
+Tue Mar 10 06:37:51 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmfmp.c [TeX & IPC] (ipcpage): Remember to set begun to true
+ once we've begun.
+
+Sun Mar 8 18:21:46 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * printversion.c (printversionandexit): Copyright year is 1998.
+
+Tue Feb 10 17:56:36 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c: Provide the hooks for the epsf server. From Mathias
+ Herberts.
+
+ * eofeoln.c: Prototype eoln. Spotted by Andreas Scherer
+ <Andreas.Scherer@Pobox.Com>
+
+ * fprintreal.c: Prototype fprintreal. Spotted by Andreas Scherer
+ <Andreas.Scherer@Pobox.Com>
+
+Fri Jan 23 15:01:31 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c: Various patches for Omega from John Plaice.
+ (ipcpage [Omega]): Fix because string handling in Omega differs.
+ (maybe_set_dump_default): Fix to get %& to work in more cases.
+
+Thu Dec 18 20:37:20 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c: Change spelling of -maketex option to -mktex.
+
+Fri Dec 12 10:22:52 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * openclose.c (open_output): Don't use TEXMFOUTPUT value if it is
+ the empty string.
+
+ * texmfmp.c (openoutnameok): Rewritten to support three levels of
+ permissiveness.
+ (main): Assignment to shellenabledp has been rewritten: we now
+ enable only if certain values are found.
+
+Mon Dec 1 19:05:06 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c (maybe_set_dump_default_from_input): Reset the program
+ name if the dump_name changes.
+
+ * texmfmp.c [WIN32 && !NO_MF_ASM]: Include "lib/mfmpw32.c" instead
+ of "../win32/mfmpi386.c".
+
+ * texmfmp.c (main, parse_options): Add support for --interaction
+ option.
+
+ * texmfmp.c (main) [eTeX]: Make sure calling e-TeX as initex or
+ virtex works as it should.
+
+Sat Nov 29 13:06:53 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c (main): We assume "plain" for the dump_name iff the
+ program was called as ini* or vir*. And in the case of ini*, the
+ file name will override this anyway.
+
+ * texmfmp.c (callmakempx): Add xstrdup, because we end up
+ potentially freeing a static string otherwise. From Fabrice
+ Popineau.
+
+Sun Nov 23 19:43:57 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c (openoutnameok): When we're trying to be safe, add
+ some extra paranoia supplied by Charles Karney <karney@pppl.gov>.
+
+Sat Nov 22 19:26:13 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c (main): Use kpse_set_program_name and
+ kpse_program_name instead of kpse_set_progname and
+ program_invocation_short_name.
+
+Sat Nov 15 21:27:23 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c: Various changes to support Omega.
+
+Fri Nov 14 16:43:28 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c [eTeX,PDFTeX]: Inclusion of header file with
+ appropriate banner.
+
+Fri Oct 24 13:41:56 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c: Prototypes for the mf_*_{blankrectangle,paintrow}
+ functions.
+
+Mon Oct 20 08:16:40 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c [WIN32]: Added support for WIN32WIN. Added suppport
+ for redirection of stderr to a logfile. Added support for asm
+ routines. Prototyped mainbody.
+ (setupboudvariable): Don't try to free expansion if it is NULL.
+ From Fabrice Popineau.
+
+ * main.c (main): Prototype mainbody. From Fabrice Popineau.
+
+Sun Oct 19 10:57:43 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * printversion.c (printversionandexit): Removed web2c maintainer's
+ name from version info.
+
+Fri Oct 17 10:33:06 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c: Correct prototypes for all the varieties of
+ ...initscreen and ...updatescreen. No prototypes for
+ ...blankrectangle and ...paintrow.
+
+ * texmfmp.c (main) [MSDOS, WIN32]: Use case-insensitive comparison
+ for filenames on MS-DOS/MS-Windows.
+ (openoutnameok): When testing for `unix' make sure `MSDOS' is NOT
+ defined since DJGPP defines both.
+ (initscreen): Use "mftalk" for DJGPP as well.
+ From Eli Zaretskii <eliz@is.elta.co.il>.
+
+Thu Oct 16 20:34:25 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c (parseoptions [TeX], main): Remove everything related
+ to the -extend-jobname option.
+
+Fri Oct 3 11:46:15 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c: Add prototypes for the mf_trap_* functions. After
+ Fabrice Popineau.
+
+Thu Oct 2 18:07:24 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmfmp.c (main): Added locale support. From Bernd Raichle
+ <raichle@informatik.uni-stuttgart.de>.
+
+Tue Sep 30 12:00:13 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * version.c: use version string from c-auto.h.
+
+ * texmfmp.c: Changed return type of main int.
+
+Fri Mar 21 16:38:48 1997 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (struct msg): Do not try to declare the zero-length
+ array, just leave it out.
+ Bug from: jumper@lens.sri.com (Greg Jumper)
+
+Wed Feb 12 08:18:07 1997 Fabrice POPINEAU <popineau@ese-metz.fr>
+
+ * texmfmp.c (catch_interrupt): Win32, differentiate between user
+ interrupt and console closing.
+
+Mon Feb 3 18:01:42 1997 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (parse_options): Check for -1, not EOF,
+ per new getopt.
+
+Mon Jan 27 22:44:29 1997 Ulrik vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * texmfmp.c (BANNER) [MP]: Update to version 0.632.
+
+Sat Jan 18 13:04:34 1997 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c: Update len.
+ From: Gregor Hoffleit <flight@mathi.uni-heidelberg.de>.
+
+Thu Jan 16 14:29:50 1997 Karl Berry <karl@cs.umb.edu>
+
+ * alloca.c: New version from /gd/gnu/lib.
+
+ * texmfmp.c (funny_core_dump): Move to new file.
+ * coredump.c: New file.
+ * Makefile.in (objects): Add coredump.o.
+ This makes it possible for BibTeX to find the function
+ (not that it needs it).
+ From: Richard Walker <Richard.Walker@cs.anu.edu.au>
+
+Sun Jan 5 16:11:12 1997 Karl Berry <karl@cs.umb.edu>
+
+ * printversion.c: It's 1997 now.
+
+Sun Dec 29 17:11:03 1996 Karl Berry <karl@cs.umb.edu>
+
+ * basechsuffix.c (basenamechangesuffix): Filename comparison may
+ be case-insensitive. From Fabrice.
+
+Sat Dec 28 17:37:14 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (ipcpage): Pass the whole DVI filename to the other
+ end of the connection, not just the relative name. (It may have
+ been already started up.)
+
+Sun Dec 15 16:50:25 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c: #if 0-out all the TCX file stuff.
+ Suggested by David Carlisle et al.
+
+Sun Dec 8 16:40:57 1996 Karl Berry <karl@cs.umb.edu>
+
+ * openclose.c (standardinput, standardoutput): Remove these;
+ make them globals in bibtex.ch itself.
+
+ * printversion.c, texmfmp.c, usage.c: WIN32 changes.
+ From Fabrice.
+
+Sat Dec 7 11:10:39 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (topenin): Rewrite to avoid strcat, for Omega.
+ From: John Plaice <plaice@iad.ift.ulaval.ca>.
+
+Fri Dec 6 17:44:45 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (main) [TeX && Omega]: Initialize MakeTeX{OCP,OFM}.
+ * openclose.c (ocptemp): New global.
+ (open_input): Read ahead in ofm and ocp files.
+
+Tue Dec 3 15:15:14 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * Makefile.in: Remove spurious targets for wsun.c and wx11.c.
+
+Tue Dec 3 15:15:14 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * texmfmp.c (long_options): mpost -T or -troff doesn't take an
+ optional argument.
+
+ * Makefile.in: Remove spurious targets for wsun.c and wx11.c.
+
+Wed Nov 27 10:02:21 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (NO_MF_ASM) [__sun__]: Define; our assembler code
+ doesn't work with the Solaris/x86 assembler.
+ * mfmpi386.asm: Doc fix.
+
+Sat Nov 23 14:42:53 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (openoutok): Allow .tex as a special case.
+
+Fri Nov 15 16:15:32 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (openoutnameok): Do not free the result of basename;
+ it's never dynamically allocated anyway.
+
+Sun Nov 10 16:37:19 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c: Check for inimpost and virmpost instead of
+ inimp and virmp.
+
+Mon Oct 14 17:27:34 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (DUMP_EXT) [DOS]: Only truncate to .bas if DOS,
+ not DOSISH; WinNT/Win95 support long filenames (at long last).
+ (initscreen) [WIN32]: Use mftalk a la OS2.
+ (get_date_and_time): Include parameter in old_handler decl.
+
+Mon Oct 7 12:49:38 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (objects): Include printversion.o.
+ * printversion.c: New file.
+
+ * texmfmp.c: Oops, iniversion doesn't it, it's global.
+ (parse_options): Call printversionandexit.
+
+Sun Oct 6 10:17:00 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (main): Initialize iniversion and virversion.
+
+Sat Sep 7 16:14:41 1996 Karl Berry <karl@cs.umb.edu>
+
+ * usage.c: Include the bug reporting address.
+
+Sun Aug 4 15:48:03 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (parse_options): Print the Kpathsea version string, too.
+ * version.c: Do `Web2c VERSION' instead of `C version VERSION'.
+
+Fri Jul 26 15:47:29 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Remove co.make.
+
+Sat Jun 1 13:17:09 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (openoutnameok): Change #ifdef to TeX || MP.
+
+Fri May 24 11:38:59 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (main): Initialize extend_jobname.
+ (parse_options) [TeX]: New option -extend-jobname.
+
+Sun Apr 28 15:13:22 1996 Karl Berry <karl@cs.umb.edu>
+
+ * mfmpi386.asm [ASM_NEEDS_UNDERSCORE]: #ifdef labels on new
+ configure condition.
+ From: Peter Breitenlohner <peb@MPPMU.MPG.DE>.
+
+Tue Apr 23 08:26:11 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (callmakempx): Always pass -troff, even if we got the
+ command name from texmf.cnf.
+
+Sun Apr 21 16:59:44 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (parse_options): New options -maketex and -no-maketex
+ for TeX and MF.
+
+Sat Apr 20 17:55:37 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c [IPC_DEBUG]: Text changes.
+
+Fri Mar 22 15:30:45 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Remove GPL from these files; Web2c proper can stay p.d.
+
+Sun Mar 10 16:12:14 1996 Karl Berry <karl@cs.umb.edu>
+
+ * openclose.c: Oops, forgot to #include variable.h.
+
+Fri Mar 8 16:00:20 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (init_maketex): Remove this; we will do it in Kpathsea
+ instead now, in the format initialization tex-file.c.
+
+ * openclose.c (open_output): Look for TEXMFOUTPUT in texmf.cnf.
+
+Wed Feb 21 11:45:02 1996 Karl Berry <karl@cs.umb.edu>
+
+ * openclose.c: Don't abort if the TFM file is empty.
+
+Sat Feb 17 15:22:52 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (openoutnameok): New function.
+
+Fri Feb 16 17:51:53 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (long_options) [NONASCII]: Include --translate
+ conditionally. (Really should change the help message, too.)
+
+Sat Feb 10 15:22:59 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (parse_options): Make DUMP_OPTION also set the user
+ progname, since -progname sets the dump name.
+
+Fri Dec 29 17:16:42 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: misc.make is now clean.make.
+
+Sun Dec 17 15:09:44 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (long_options): New option --debug-format, suggested
+ by David Carlisle.
+
+Sun Dec 10 16:13:46 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mfmpi386.asm: Remove _'s. From Wayne.
+
+ * texmfmp.c (PROGRAM_VERSION) [MP]: Now at 0.631.
+ [TeX] No asm stuff. From Gregor Hoffleit, et al.
+
+Sun Nov 26 13:39:00 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (main): Enable mltex extensions if --mltex option or
+ the program name is mltex.
+
+Fri Nov 17 14:35:45 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (-program): New option for TeX, MF, MP. Suggested by Bernd.
+
+Thu Nov 16 16:20:03 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (argv, argc): Do not define as static, as we declare
+ them extern in cpascal.h. From Andreas Scherer.
+
+Sun Nov 12 16:32:27 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (sysopt_o): Remove this stuff. From Wayne.
+ * texmfmp.c [i386 && GNUC && !NO_MF_ASM]: #include mfmpi386.asm
+ instead of using the C code.
+
+ * texmfmp.c: Disable shell escapes by default.
+
+Fri Oct 6 16:23:03 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (maybe_set_dump_default_from_input): Make %&ini set
+ iniversion. Suggested by Wayne.
+
+Mon Oct 2 15:48:21 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (init_maketex): Really disable if the value is zero.
+
+Sat Sep 30 16:02:56 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (main) [TeX]: Look up the `noshell' config variable.
+ (parse_options): No options -noshell and -output-comment.
+
+Sat Sep 23 15:04:54 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (objects): Remove strtol.o, this is in kpathsea now.
+
+Fri Sep 22 15:51:13 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (init_maketex): New routine.
+ (main): Call it, instead of repeating the weird code.
+
+Mon Sep 4 17:16:06 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (objects): Remove xopenfile.o.
+ * xopenfile.c: Move to kpathsea.
+
+Thu Aug 31 13:35:47 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c [!MF_ASM_FRACTION] (takefraction, ...): Conditionalize
+ the floating-point definitions on this, too.
+ * Makefile.in (optx86.o): New target.
+ * optx86.s: New file.
+
+Tue Aug 22 14:11:27 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Include rdepend.make, instead of repeating the code.
+
+Mon Jul 31 17:46:31 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (setupboundvariable): Call kpse_var_value, so we don't
+ have to pass in the $. Similarly everywhere else.
+
+Sat Jul 29 19:26:33 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (callmakempx): Rewrite to pass -troff flag, instead of
+ invoking troff script. And use new kpse_var_value.
+
+Fri Jul 28 11:10:26 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (depend): Comment out this target in the
+ distribution, it doesn't work when $srcdir != build-dir.
+
+ * texmfmp.c (callmakempx): Don't call anything if the command is
+ `none'.
+
+Tue Jul 25 13:39:04 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (callmakempx): Free the variable expansion.
+
+Mon Jul 24 11:48:35 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (callmakempx): New fn.
+
+Sun Jul 23 11:39:51 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmfmp.c (edit_value): Remove this #define.
+ (calledit): Call kpse_var_expand for TEXEDIT et al., instead of
+ just getenv.
+ (ztakefraction, zmakefraction, ztakescaled, zmakescaled): Include
+ Hobby's C code from mpmath.c.
+
+Sat Jul 22 14:20:38 1995 Karl Berry <karl@cs.umb.edu>
+
+ * openclose.c (open_input) [FUNNY_CORE_DUMP]: Recognize
+ HackyInput... for MetaPost. Doc fixes.
+
+ * texmf.c: Rename to texmfmp.c for MetaPost support.
+ (long_options) [MP]: Add -T and -troff.
+
+Thu Jul 20 13:40:39 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (setupboundvariable) [TeX]: Remove conditional, since MF
+ sets a couple simple variables dynamically now.
+ (initscreen): Get MFTERM from texmf.cnf file if it's there,
+ instead of just calling getenv.
+
+Tue Jul 18 13:40:25 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (initscreen): Give warning if they're using X, but there
+ is no X support.
+
+Mon Jul 17 13:10:37 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (NO_FMTBASE_SHARE): Rename to NO_DUMP_SHARE.
+ [MF]: Declare return types for window routines.
+ Also, move trap support to another file, window/trap.c.
+
+Sun Jul 16 14:35:33 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (main): Rewrite enabling of MakeTeX* to match new
+ configure stuff.
+
+Sat Jul 15 16:05:37 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c: Doc fix.
+
+Fri Jul 14 14:31:57 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (read_char_translation_file): Compute `charssavedbycharset'.
+ (setupcharset): Do not allow dynamic translation in initex.
+
+Thu Jul 13 14:05:24 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (setupcharset, read_char_translation_file,
+ tcx_get_num): New functions to implement dynamic char translations.
+ (parse_options): Add -translate-file option.
+
+Sun Jul 9 15:28:09 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (maybe_set_dump_default_from_input): Don't index
+ argv[optind] if optind is >= argc.
+
+Tue Jul 4 16:58:54 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (maybe_set_dump_default_from_input): Finish implementing
+ this (%&FNAME on first line => use FNAME for dump file).
+
+Thu Jun 29 17:50:38 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (parse_options) [TeX && IPC]: Concatenate TEX_IPC_HELP
+ to the help string.
+
+ * openclose.c (open_input): Detect nonexistent files correctly again.
+
+Wed Jun 21 15:54:45 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (parse_options): Add --fmt (TeX) and --base (MF).
+ (DUMP_OPTION): #ifdef'd #define to determine which.
+
+Mon Jun 19 20:09:34 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c: Add IPC support.
+ From: Shamim Mohamed <shamim@howland.isu.edu>
+ From: Tomas G. Rokicki <rokicki@CS.Stanford.EDU>
+
+Sat Jun 10 16:06:06 1995 Karl Berry <karl@cs.umb.edu>
+
+ * openclose.c: Doc fix.
+
+Fri Jun 9 19:36:12 1995 Karl Berry <karl@cs.umb.edu>
+
+ * main.c, texmf.c (main) [__EMX__]: Add _wildcard and _response calls.
+ * texmf.c: Add mftalk support.
+ (funny_core_dump, catch_interrupt) [__EMX__]: OS2 support.
+ From: rs@purple.in-ulm.de (Ralph Schleicher).
+
+Sun Jun 4 10:30:36 1995 Karl Berry <karl@cs.umb.edu>
+
+ * eofeoln.c (eof): Return true if the file doesn't exist.
+
+ * texmf.c: Add support for AMIGAWIN. From Andreas Scherer.
+
+ * alloca.c (NULL, xmalloc): Do not define these here, they're
+ (indirectly) in config.h. From Andreas Scherer.
+
+ * texmf.c (setupboundvariable): Don't complain about 0 in the cnf
+ file if the default is also 0.
+
+Sat Jun 3 11:54:28 1995 Karl Berry <karl@cs.umb.edu>
+
+ * xopenfile.c: Include the program name in the error message.
+
+ * texmf.c (setupboundvariable): If the variable is unset in
+ texmf.cnf, the expansion is the empty string, not NULL. Also, free
+ the expansion.
+
+Fri Jun 2 13:41:41 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (DUMP_EXT) [DOSISH]: Must be `.bas'. From Wayne.
+ (input_line): Cast buf_size in printf to avoid warning.
+ (setupboundvariable): New routine for lookup of dynamic bounds.
+
+Sun May 28 17:41:49 1995 Karl Berry <karl@cs.umb.edu>
+
+ * zround.c: Compare against TeX's boundary integers (as floating
+ point constants), instead of INTEGER_{MIN,MAX}.
+
+Fri May 26 17:47:47 1995 Karl Berry <karl@cs.umb.edu>
+
+ * strtol.c: New file, from textutils.
+ * Makefile.in (objects): Add strtol.o.
+
+Wed May 24 17:07:39 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c (parse_options): New routine for TeX & MF.
+ (PROGRAM_VERSION, PROGRAM_HELP): Define these.
+ (main): Call it.
+
+Sat May 20 17:28:51 1995 Karl Berry <karl@cs.umb.edu>
+
+ * xopenfile.c: Do perror if we had a full filename to try.
+
+ * basechsuffix.c: Take old suffix, and only do the change if the
+ old suffix matches.
+
+ * usage.c (usage): If bad status, construct the --help message.
+
+Tue May 9 15:46:25 1995 Karl Berry <karl@cs.umb.edu>
+
+ * usage.c: Doc fix.
+
+Sat May 6 11:23:23 1995 Karl Berry <karl@cs.umb.edu>
+
+ * usage.c: New file.
+ * Makefile.in (objects): Add it.
+
+Tue Apr 25 14:02:10 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (library): Set to lib instead of lib.a, to match the
+ other Makefile conventions.
+
+Sun Apr 23 10:54:35 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.c: Have to include {tex,mf}d.h before #ifdef TeX, so do it
+ from the Makefile.
+
+Sat Apr 22 10:26:10 1995 Karl Berry <karl@cs.umb.edu>
+
+ * main.c (main): Call mainbody, not main_body.
+
+ * openclose.c (aclose): Don't complain if the file is already closed.
+ (texinputtype): Define this.
+
+ * texmf.c (main): Do program_name stuff unconditionally, not just
+ in vir*, and rewrite it to use program_invocation_short_name.
+
+Fri Apr 21 11:39:14 1995 Karl Berry <karl@cs.umb.edu>
+
+ * main.c: Doc fix.
+
+ * input2int.c: Split off from inputint.c.
+
+Sun Apr 16 11:47:37 1995 Karl Berry <karl@cs.umb.edu>
+
+ * openclose.c (open_input, open_output): Retrieve and store the
+ filename from name_of_file + 1, not name_of_file, to avoid extra
+ hassles in the change files.
+
+Fri Apr 14 15:28:47 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (objects): Include openclose.o.
+ * openclose.c: New file, from openinout.c.
+
+Tue Feb 21 13:51:58 1995 Karl Berry <karl@cs.umb.edu>
+
+ * xopenfile.c: Have to take another arg, the original name.
+
+Mon Feb 20 17:18:59 1995 Karl Berry <karl@cs.umb.edu>
+
+ * xopenfile.c: New file.
+ * Makefile.in (objects): Add it, and remove xfopen-pas.o.
+
+Sun Feb 5 15:33:29 1995 Karl Berry <karl@cs.umb.edu>
+
+ * basechsuffix.c: New file.
+ * Makefile.in (objects): Add it.
+
+Tue Jan 10 13:20:47 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (objects): Remove strpascal.o (no longer needed) and
+ getopt.o (in kpathsea).
+
+Sun Dec 18 16:38:03 1994 Karl Berry <karl@cs.umb.edu>
+
+ * strpascal.c (errprintpascalstring, etc.): Don't need these any more?
+
+Sat Dec 17 13:42:03 1994 Karl Berry <karl@cs.umb.edu>
+
+ * mksuffixchar.c: This was short-lived.
+ * chartostring.c: This replaces it.
+ * Makefile.in (objects): Ditto. Also remove ourpaths.o.
+
+Mon Nov 14 15:13:50 1994 Karl Berry <karl@cs.umb.edu>
+
+ * mksuffixchar.c: New file.
+ * Makefile.in (objects): Add it.
+
+Sun Nov 13 16:43:40 1994 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (objects): Add w*.o.
+ (wsun.c, wx11.c): Add links for these.
+
+Fri Oct 28 11:14:08 1994 Karl Berry <karl@cs.umb.edu>
+
+ * strpascal.c (extendfilename): Remove this.
+
+Thu Oct 27 17:59:07 1994 Karl Berry <karl@cs.umb.edu>
+
+ * main.c (argv): Return a regular C string, instead of a Pascal string.
+
+Fri May 27 09:50:14 1994 Karl Berry (karl@cs.umb.edu)
+
+ * texmf.c (main): Don't look for USE_MAKETEX*.
+
+ * c-auto.h.top, texmf.c (NO_FMTBASE_SHARE): Rename from
+ NO_FMTBASE_SWAP.
+
+Thu May 26 20:37:24 1994 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.top: Why did I take out the #ifndef's? Put them back.
+
+Tue May 24 14:43:12 1994 Karl Berry (karl@cs.umb.edu)
+
+ * texmf.c (funny_core_dump): No need to declare, since we define
+ it later in this file.
+
+Mon Apr 18 17:31:59 1994 Karl Berry (karl@ra.cs.umb.edu)
+
+ * c-auto.h.top: Rename from c-auto.h.in for autoheader convention,
+ and don't #ifndef the #undef's.
+ * Makefile.in: autoheader/autoconf changes.
+
+Thu Feb 24 11:00:53 1994 Karl Berry (karl@cs.umb.edu)
+
+ * ourpaths.c: Include tex-file.h instead of init-path.h.
+
+Mon Feb 21 14:29:52 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: srcdir changes from simon.
+
+ * gftodmem.h: Move here from fontutil, to simplify srcdir stuff.
+
+Wed Feb 2 11:00:47 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Tue Feb 1 11:25:44 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (c-auto.h.in): New target.
+
+ * common.defines (rh): Declare as a field, for TeX--Xet.
+
+Mon Jan 24 07:33:49 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Thu Jan 20 14:22:07 1994 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.in: Doc fix.
+
+ * MakeTeX{TFM,MF}: Include these as samples, from
+ pnoma@wk.estec.esa.nl.
+
+Fri Dec 24 13:48:46 1993 Karl Berry (karl@cs.umb.edu)
+
+ * getopt.c (_NO_PROTO): Define before including config.h.
+
+Tue Dec 7 10:23:59 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (objs): Ah, flexfatal is in the library now.
+
+Sun Dec 5 15:23:47 1993 Karl Berry (karl@cs.umb.edu)
+
+ * ourpaths.c (setpaths): Remove the KPSE_MAKE_* enables, this file
+ is not compiled in the tex/mf/bibtex directories.
+ * texmf.c (main): Set them here.
+
+ * c-auto.h.in (XVIEWWIN): Remove this, as x11-Xt should work
+ with OpenWindows. (But leave it in configure, just for old-times'
+ sake.)
+
+Sat Dec 4 11:29:57 1993 Karl Berry (karl@cs.umb.edu)
+
+ * flexfatal.c: New file.
+ * Makefile.in (flexfatal.o): New target.
+ (objs): Include it.
+
+ * texmf.h (NO_DEBUG) [!TEXMF_DEBUG]: Define this.
+
+ * openinout.c (make_tex_file): Pass address of nameoffile, as required.
+
+Sun Nov 14 02:30:34 1993 Karl Berry (karl@cs.umb.edu)
+
+ * version.c (VERSION_STRING) [!VERSION_STRING]: Define and protect.
+
+Fri Nov 12 19:38:26 1993 Karl Berry (karl@cs.umb.edu)
+
+ * cpascal.h (reset, rewrite): Use FOPEN_[RW]BIN_MODE instead of
+ "r" and "w". Still not 100% right, but at least something of an
+ improvement.
+
+Sun Nov 7 14:17:24 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (.c.o): Use $< instead of $*.c; maybe it will help
+ with $(srcdir) stuff?
+
+ * texmf.c (input_line): Trim trailing spaces, tabs, and \r's.
+
+ * lib.h: Remove, this is in Kpathsea now.
+
+ * config.h (INTEGER_TYPE) [LONG_64_BITS && !NO_FMTBASE_SWAP]:
+ Define as int in this case.
+ (INTEGER_MAX,INTEGER_MIN): Define these as well.
+ * zround.c (zround): Use INTEGER_{MAX,MIN}.
+ From raichle@informatik.uni-stuttgart.de.
+
+Sat Nov 6 13:21:11 1993 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.in (NEXTWIN, REGISWIN): #undef by default.
+ * texmf.c (mfwin_sw): Add cases for regis and next.
+ (mf_{next,regis}_*) [NEXT,REGISWIN]: Declare.
+
+Tue Oct 12 14:03:23 1993 Karl Berry (karl@cs.umb.edu)
+
+ * openinout.c (open_input): Allow HackyCoreDump's for MF, too.
+
+ * ourpaths.c (testreadaccess): Update fontmap stuff, use it for GF
+ and PK as well as TFM.
+
+ * texmf.c: Doc fix.
+
+ * common.defines (cinttype): Declare.
+ * cpascal.h (cinttype): Define.
+
+Sun Oct 10 16:17:48 1993 Karl Berry (karl@cs.umb.edu)
+
+ * ourpaths.c: Rewrite for new kpathsea facilities.
+
+Sun Oct 3 13:49:40 1993 Karl Berry (karl@cs.umb.edu)
+
+ * ourpaths.c: kpathsea/pathsrch.h has been renamed to pathsearch.h.
+
+ * config.h [ibm032]: Remove all this stuff; I don't think it's
+ needed any longer.
+
+ * Makefile.in (*clean): Include standard targets.
+
+Mon Jun 7 08:29:45 1993 Karl Berry (karl@cs.umb.edu)
+
+ * cpascal.h (addressofint): Do not cast to int first.
+
+Mon May 31 09:40:00 1993 Karl Berry (karl@cs.umb.edu)
+
+ * config.h (EXIT_SUCCESS): Move to c-std.h.
+
+Tue May 25 14:37:16 1993 Karl Berry (karl@cs.umb.edu)
+
+ * config.h (EXIT_SUCCESS): Rename from EXIT_SUCCESS_CODE.
+ Change callers in various files.
+
+Fri May 21 11:56:02 1993 Karl Berry (karl@cs.umb.edu)
+
+ * texmf.c (paintrow): Put args in the printf for paintrow.
+
+ * texmf.c (custom_default) [INI]: Declare conditionally, since
+ it's used conditionally.
+ (main): Declare as void.
+
+ * openinout.c (open_input): Rename IS_PATH_SEP to IS_DIR_SEP.
+
+ * alloca.c: Replace with version from gcc 2.4.0.
+
+ * config.h (testreadaccess): Declare.
+
+ * xfopen-pas.c: Remove unused variable `cp'.
+
+ * main.c (main): Return 0 instead of using uexit.
+
+Tue May 18 13:43:07 1993 Karl Berry (karl@cs.umb.edu)
+
+ * texmf.c (do_undump) [VMS]: Remove this. barabash says it works ok.
+
+Thu May 13 16:53:47 1993 Karl Berry (karl@cs.umb.edu)
+
+ * getopt.c (my_index): Return const char *, and change callers.
+
+ * Not quite all of Bill's changes below have been merged (not the
+ new descrip.mms or convert.com files, in particular), but just to
+ get the gist, I'll include the whole log.
+
+Wed Mar 24 12:28:25 1993 Bill Barabash (barabash@ops5.lmo.dec.com)
+
+ * c-auto.h : It's too complicated to convert the big hairy config
+ shell script; I just created a VMS-acceptable c-auto.h manually.
+
+ * c-std.h : Declare VMS's unix-compatibillity routines by including
+ <unixlib.h> and <unixio.h>; don't declare popen() on VMS.
+
+ * common.h : Declare EXIT_SUCCESS_CODE to be 1 on VMS, 0 elsewhere.
+ Throw away the VMS system library's getname() declaration, it steps
+ on a WEB procedure and is not needed. Declare routines eof(),
+ testreadaccess(), zinput2ints(), extendfilename(), and uexit().
+
+ * convert.com : VMS command procedure based on the shell script
+ "convert" (new file).
+
+ * descrip.mms : VMS equivalent of makefile (new file).
+
+ * dirio.h : Don't declare xopendir and xclosedir on VMS.
+
+ * getopt.h : Make my_index accept and return a const character
+ pointer. Have it return NULL instead of 0 when necessary.
+
+ * main.c : Add function prototype for main_body().
+
+ * openinout.c, pascal.h, c-auto.h : For BibTeX, use stdin and stdout
+ on VMS (standardinput and standardoutput become macros).
+
+ * pascal.h : On VMS use system-defined abs() and fabs().
+
+ * paths.h : Hand-coded for VMS.
+
+ * pathsrch.c : On VMS, don't compile routine expand_subdir(), and
+ look in current directory for input file if path searching fails.
+ Routine absolute_p() can now deal with VMS directory specifications.
+
+ * texmf.c : Declare argc so that it links cleanly. Add an unused
+ formal parameter to catch_interrupt so that it can be passed to
+ signal without the compiler complaining. Cast argument to time()
+ as a (time_t *) rather than as a (long *). Get rid of the VMS
+ undump code contributed by joe%ril3.decnet@hydra.tamri.com -- it
+ causes the TRAP test to fail.
+
+ * texmf.h : Add function prototypes for routines in texmf.c and
+ openinout.c.
+
+Thu May 13 14:43:42 1993 Karl Berry (karl@cs.umb.edu)
+
+ * cpascal.h (fabs) [fabs]: Undefine if it's already defined.
+
+Sun May 9 09:53:05 1993 Karl Berry (karl@cs.umb.edu)
+
+ * convert: Redirect error echo to stderr; exit 0 if no error.
+
+ * config.h: Changes for kpathsea. Toss volatile defn.
+
+ * Makefile.in (objs): Remove kpathsea files.
+
+Fri Apr 30 15:06:29 1993 Karl Berry (karl@cs.umb.edu)
+
+ * openinout.c (make_tex_file): Free cmd.
+
+Fri Apr 16 19:42:15 1993 Karl Berry (karl@cs.umb.edu)
+
+ * find-suffix.c: Declare arg and return string const.
+ * lib.h (find_suffix): Change decl.
+
+ * c-pathch.h (IS_PATH_SEP) [DOS & otherwise]: New defn.
+ * pathsrch.c, openinout.c, find-suffix.c: Consequent changes.
+
+Mon Apr 12 06:14:42 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (clean): Remove core here.
+
+Sat Apr 10 15:20:25 1993 Karl Berry (karl@cs.umb.edu)
+
+ * openinout.c (make_tex_file): Throw away all output.
+
+ * texmf.c (swap_items): Add case for 16-byte items.
+ (From james@miller.cs.uwm.edu.)
+
+ * texmf.c (get_date_and_time): Cast arg to time_t *, not long *.
+ (From james@miller.cs.uwm.edu.)
+
+ * texmf.c (get_date_and_time) [SA_INTERRUPT]: Add code for SunOS
+ 4.1, from ken@cs.toronto.edu.
+
+ * pathsrch.c (expand_subdir) [UNIX_ST_NLINK]: Don't check st_link
+ if we don't have Unix semantics.
+ * c-auto.h.in (UNIX_ST_NLINK): Define if not DOS or VMS or VMCMS.
+ (Suggested by buers@dg1.chemie.uni-konstanz.de.)
+
+ * texmf.c (catch_interrupt): Declare a(n unused) parameter `arg'
+ (from beebe).
+ (get_date_and_time): Don't do assignment in if condition.
+
+Fri Apr 9 16:10:06 1993 Karl Berry (karl@cs.umb.edu)
+
+ * xrealloc.c (xrealloc): Don't print old_ptr.
+
+ * c-std.h (stddef.h): Don't include.
+
+ * openinout.c (make_tex_file): cmd is a string, not a character.
+
+Mon Mar 29 08:33:51 1993 Karl Berry (karl@cs.umb.edu)
+
+ * cpascal.h (abs) [abs]: Undef.
+
+Sat Mar 13 10:22:54 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (CPPFLAGS): Add @DEFS@, for -DHAVE_CONFIG_H.
+
+ * texmf.h: Include cpascal.h instead of config.h.
+
+ * common.h: Merge into config.h and remove.
+
+ * common.h (pascal.h): Don't include this.
+ * cpascal.h: Rename from pascal.h.
+
+ * convert: Exit with bad status if the pipeline failed; use
+ cpascal.h instead of config.h.
+
+ * openinout.c (make_tex_file): Call xmalloc instead of declaring
+ an array; put quotes around the arg of sh -c.
+
+Sun Feb 28 11:10:48 1993 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.in (MAKE_TEX_*): Replace single NO_MAKETEX with
+ individual symbols.
+
+ * openinout.c (maketex*) [MAKE_TEX*]: Make them individually
+ selectable.
+
+Sun Feb 21 08:28:06 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Version 5.851d.
+
+ * common.defines (maketexmf): New defn.
+
+ * Makefile.in (.c.o): Put $(CFLAGS) after $(CPPFLAGS).
+
+ * openinout.c: Include c-namemx.h.
+
+Tue Feb 16 17:53:54 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec, install-data): New targets.
+
+Mon Feb 15 10:19:02 1993 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.in (NO_MAKETEX): New #define for installers.
+
+ * openinout.c (maketex*): New routines, rewrite from yesterday.
+
+ * common.defines (maketextex): Define.
+
+Sun Feb 14 11:54:30 1993 Karl Berry (karl@cs.umb.edu)
+
+ * openinout.c (open_input) [BibTeX]: Only do NO_FILE_PATH stuff if
+ we are BibTeX; declare tfmtemp only when we need it, instead of at
+ the outer level; add support for MakeTeX{TeX,MF,TFM}.
+
+Fri Feb 12 07:33:49 1993 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.in (const): Add defn for Autoconf to use.
+
+ * paths.h.in (TEXFORMATS): Only define once.
+
+Sat Jan 30 09:46:04 1993 Karl Berry (karl@cs.umb.edu)
+
+ * fontmap.c (map_lookup): Only extend the filename if we have one.
+
+Tue Jan 26 16:07:21 1993 Karl Berry (karl@cs.umb.edu)
+
+ * version.c: New file to define web2c version.
+ * common.h (versionstring): Declare it here.
+ * common.defines (versionstring): And here.
+ * Makefile.in (objs): Add it.
+
+ * c-auto.h.in (X11WIN) [XVIEWWIN]: Undefine.
+
+Mon Jan 25 12:04:28 1993 Karl Berry (karl@cs.umb.edu)
+
+ * ourpaths.c (testreadaccess.c): Don't free `found' after copying,
+ as it might not be malloc-ed.
+
+Sun Jan 24 11:04:37 1993 Karl Berry (karl@cs.umb.edu)
+
+ * lib.h (FATAL*, WARNING*): Use `str' instead of `s' for macro formals.
+
+ * xcalloc.c: Remove prototypes.
+ * remove-suffx.c, line.c, fontmap.c: Cast *alloc calls to avoid
+ silly warnings.
+
+ * texmf.c (swap_items): Rewrite as four while loops, since `size'
+ is invariant. (From Tom.)
+
+Sat Jan 23 10:13:51 1993 Karl Berry (karl@cs.umb.edu)
+
+ * remove-suffx.c: New file.
+
+Thu Jan 21 11:21:14 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (objs5): New variable.
+ ($(lib)): Include it in the archive.
+
+ * extend-fname.c, find-suffix.c, xfopen.c, fontmap.[ch]: New files.
+
+ * ourpaths.c, fontmap.[ch]: Implement a mapping file.
+
+Sat Jan 16 08:36:36 1993 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.in, paths.h.in: Doc fix.
+
+Sun Jan 3 13:27:37 1993 Karl Berry (karl@cs.umb.edu)
+
+ * config.h: Move some includes to c-std.h.
+
+ * xcalloc.c: New file.
+ * Makefile.in (objs): Add it.
+
+ * Makefile.in (distclean): Remove Makefile; depend on clean.
+
+Fri Jan 1 14:17:37 1993 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.in, c-memstr.h, dirio.h: Changes for new Autoconf.
+
+ * texmf.c (RETSIGTYPE): Don't default to void.
+
+Fri Dec 18 13:16:47 1992 Karl Berry (karl@cs.umb.edu)
+
+ * strpascal.c (makesuffixpas): Rename to `extendfilename'.
+ * common.defines (extendfilename): Declare.
+
+Wed Dec 16 18:12:51 1992 Karl Berry (karl@cs.umb.edu)
+
+ * common.defines (atoi): Declare.
+
+Mon Dec 14 07:25:03 1992 Karl Berry (karl@cs.umb.edu)
+
+ * ourpaths.c: Include paths.h.
+
+Sun Dec 13 17:06:15 1992 Karl Berry (karl@cs.umb.edu)
+
+ * c-auto.h.in: Merge stuff from site.h.
+ * site.h: Delete.
+ * config.h: Don't include site.h.
+
+Sat Dec 12 13:08:52 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+ * openinout.c (open_{in,out}put): Take an extra arg for the fopen mode.
+ * texmf.h ([bw]open{in,out}): Use appropriate fopen modes.
+ * pascal.h (aopen{in,out}): Likewise.
+
+Fri Dec 11 15:19:25 1992 Karl Berry (karl@cs.umb.edu)
+
+ * texmf.c: Change ctype references to use uppercase macros.
+
+Sat Dec 5 15:21:24 1992 Karl Berry (karl@cs.umb.edu)
+
+ * texmf.h (writedvi, writegf): Check the return status of the write.
+
+ * config.h (UNSIGNED_SHORT_STRING): Toss; I think everyone
+ understands `unsigned short' now.
+
+Thu Dec 3 13:21:06 1992 Karl Berry (karl@cs.umb.edu)
+
+ * texmf.c: include c-pathch.h.
+
+Sun Nov 29 14:50:04 1992 Karl Berry (karl@cs.umb.edu)
+
+ * strpascal.c: include c-pathch.h.
+
+Mon Nov 16 08:12:16 1992 Karl Berry (karl@cs.umb.edu)
+
+ * openinout.c: include c-pathch.h.
+
+Tue Nov 10 06:49:33 1992 Karl Berry (karl@cs.umb.edu)
+
+ * texmf.c (main): Change '/' to PATH_SEP.
+ * openinout.c (open_input): Likewise.
+ * strpascal.c (makesuffixpas): And here.
+
+Mon Nov 9 09:38:58 1992 Karl Berry (karl@cs.umb.edu)
+
+ * openinout.c (open_input): Use FOPEN_RBIN_MODE instead of simply "r".
+ (open_output): Analogously.
+
+ * c-auto.h.in (DOS): New definition, #undef'd by default.
+
+Fri Nov 6 14:52:34 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile (lib): Use $(AR) and $(ARFLAGS) several times.
+ (AR, ARFLAGS): New variables.
+ (objs1..4): New variables, breaking up the old $(objs).
+
+Tue Oct 27 08:16:41 1992 Karl Berry (karl@cs.umb.edu)
+
+ * openinout.c (open_output): Remove `openable', just use *f !=
+ NULL; also, don't chdir to the envvar's directory, just prepend
+ the value and change nameoffile.
+
+ * site.h (TEXPOOLNAME): More instructions for MLTeX.
+
+Sun Oct 25 06:26:22 1992 Karl Berry (karl@cs.umb.edu)
+
+ * getopt.c: New version.
+
+Tue Oct 6 08:17:45 1992 Karl Berry (karl@cs.umb.edu)
+
+ * site.h.in: Doc fix.
+
+Thu Sep 24 11:06:14 1992 Karl Berry (karl@cs.umb.edu)
+
+ * site.h.in: change instructions for OpenWindows. (mroth@afit.af.mil)
+
+Thu Sep 17 08:29:53 1992 Karl Berry (karl@hayley)
+
+ * texmf.c (initscreen): if DISPLAY is set, assume we're running
+ under X11 for MF online output.
+
+ * texmf.c: remove BibTeX conditionals.
+
+Tue Sep 8 17:06:54 1992 Karl Berry (karl@hayley)
+
+ * c-auto.h.in (_MINIX, _{ALL,POSIX,POSIX_1}_SOURCE): add #undef's
+ for configure to define.
+
+Fri Sep 4 09:01:59 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+
+Fri Aug 14 07:02:41 1992 Karl Berry (karl@hayley)
+
+ * ourpaths.h (path_constant_type): remove trailing comma from
+ enum, since ANSI stupidly disallows this.
+
+Wed Aug 12 16:20:10 1992 Karl Berry (karl@hayley)
+
+ * texmf.c (catch_interrupt): change return type to `RETSIGTYPE'.
+
+ * config.h: remove conditional include of c-memstr if `index' is
+ defined.
+
+Sat Aug 8 10:11:18 1992 Karl Berry (karl@hayley)
+
+ * openinout.c (EXTERN) [!BibTeX]: define as `extern'. How did
+ this ever work?
+
+Fri Jul 3 11:23:32 1992 Karl Berry (karl@hayley)
+
+ * texmf.c (input_line): ignore \r's at the end of the line.
+
+ * site.h.in (XVIEWWIN): undef by default.
+ * texmf.c (X11WIN) [MF && (TRAP || INI)]: #undef.
+
+Thu Jul 2 16:11:46 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CPPFLAGS): new variable
+ (.c.o): use it.
+ (cflags): change to CFLAGS.
+
+Tue Jun 23 09:09:49 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CC): change default to `gcc -posix'.
+
+ * site.h.in (NONASCII): document that xord and xchr are ignored
+ unless this is defined.
+
+Thu Jun 11 09:20:51 1992 Karl Berry (karl@hayley)
+
+ * zround.c (zround): return LONG_MAX or LONG_MIN if the double
+ being rounded is outside the range of `integer'.
+ * c-minmax.h (LONG_{MIN,MAX}): define these if they aren't defined
+ by the system.
+
+Fri May 15 10:23:47 1992 Karl Berry (karl@hayley)
+
+ * getopt.[ch]: new versions.
+
+Thu May 14 19:21:40 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Wed May 13 14:32:14 1992 Karl Berry (karl@hayley)
+
+ * pathsrch.c (initalize_path_list): initialize path to the
+ original path.
+
+Mon May 4 14:50:20 1992 Karl Berry (karl@hayley)
+
+ * c-auto.h.in: doc fix.
+
+Sun May 3 08:06:07 1992 Karl Berry (karl@hayley)
+
+ * main.c (argv): use a prototype if possibile.
+
+ * texmf.ch (*dumpthings): parenthesize `len'.
+
+Wed Apr 29 16:07:52 1992 Karl Berry (karl@hayley)
+
+ * texmfmem.h (memoryword): had mutually exclusive #if's.
+ (twohalves.u): don't need junk at the end?
+
+Sat Apr 25 08:55:34 1992 Karl Berry (karl@hayley)
+
+ * c-auto.h.in (__CHAR_UNSIGNED__): protect with #ifndef.
+
+ * site.h.in: remove #ifndef's from around the #define's. I don't
+ think these help anything.
+
+Thu Apr 23 07:49:18 1992 Karl Berry (karl@hayley)
+
+ * c-auto.h.in: new file.
+
+Wed Apr 22 12:43:30 1992 Karl Berry (karl@hayley)
+
+ * texmf.c: SIGTYPE is now RETSIGTYPE.
+
+Sun Apr 19 10:26:16 1992 Karl Berry (karl@hayley)
+
+ * texmf.c: had sense of tests on FMTBASE_SWAP reversed.
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Tue Apr 14 17:06:57 1992 Karl Berry (karl@hayley)
+
+ * common.defines (BSTINPUTPATHBIT): define.
+
+Sun Apr 12 11:42:14 1992 Karl Berry (karl@hayley)
+
+ * common.defines (BSTINPUTPATH): define.
+ * ourpaths.h (path_constant_type): add BSTINPUTPATH.
+ (BSTINPUTPATHBIT): define.
+ * site.h-dist (BSTINPUTS): default is TEXINPUTS.
+ * ourpaths.c (setpaths): add stuff for BSTINPUTS.
+
+Sat Apr 11 09:26:55 1992 Karl Berry (karl@hayley)
+
+ * uexit.c: include config.h, for EXIT_SUCCESS_CODE.
+
+Fri Apr 10 16:56:18 1992 Karl Berry (karl@hayley)
+
+ * ourpaths.c (setpaths): don't pass cwd to initialize_path_list.
+
+ * site.h-dist (*INPUTS, TEXFONTS): add . to these paths.
+
+Wed Apr 8 15:34:21 1992 Karl Berry (karl@hayley)
+
+ * texmf.c [FMTBASE_SWAP]: make swapping conditional.
+ * site.h-dist: add it here for configuration.
+
+ * main.c (do_undump) [VMS]: add code from joe.
+
+ * main.c: use exit, not exit.
+
+ * Makefile (objs): add uexit.o.
+ * uexit.c: new file.
+ * pascal.h (uexit): remove this, as it's now a function.
+
+Fri Apr 3 09:55:00 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Thu Apr 2 11:57:06 1992 Karl Berry (karl at apollo.cs.umb.edu)
+
+ * c-memstr.h (memcpy) [!NEED_MEMORY_H]: conditionalize.
+
+Thu Apr 2 10:51:11 1992 Karl Berry (karl at ra.cs.umb.edu)
+
+ * xstat.c (xlstat): (un)prototype-ize.
+
+ * c-limits.h: test for FLOAT_H_MISSING instead of relying on
+ _POSIX_VERSION to include <float.h>.
+
+ * c-pathmx.h [_POSIX_VERSION]: don't do pathconf stuff.
+
+Wed Apr 1 16:57:30 1992 Karl Berry (karl at hayley)
+
+ * common.h (FATAL): use `str' as the arg name, not `s', since we
+ need to do `%s'.
+
+ * xopendir.c (xclosedir): prototype-ize it.
+
+ * dir-p (leaf_dir_p): don't initialize a structure (!).
+
+ * {concat,pathsrch,texmf,xmalloc,xstrdup,xrealloc}.c: cast results from
+ xmalloc/malloc/realloc (argh).
+
+ * alloca.c: comment things after #endif.
+
+ * site.h-dist (REGFIX): put this back.
+
+ * c-proto.h (P5C) [!__STDC__]: insert missing backslash.
+
+Mon Mar 30 07:28:25 1992 Karl Berry (karl at hayley)
+
+ * texmfmem.h (u, v, twohalves) [big MF]: define the halfword junks
+ again.
+
+Sun Mar 29 15:33:29 1992 Karl Berry (karl at hayley)
+
+ * alloca.c: new version from gcc 2.1.
+
+Sat Mar 28 09:46:53 1992 Karl Berry (karl at hayley)
+
+ * main.c (main): return int, exit (EXIT_SUCCESS_CODE).
+ * texmf.c (main): likewise.
+
+ * config.h (SCHAR_TYPE): use `__CHAR_UNSIGNED__' again.
+
+Thu Mar 26 06:57:38 1992 Karl Berry (karl at hayley)
+
+ * Makefile (clean, realclean): depend on mostlyclean.
+
+Sun Mar 22 09:16:04 1992 Karl Berry (karl at hayley)
+
+ * common.h [BibTeX]: remove the include of <setjmp.h>, as
+ bibtex/convert does it.
+
+Sat Mar 21 11:09:55 1992 Karl Berry (karl at hayley)
+
+ * common.defines (input2ints): for patgen2.
+ * inputint.c (zinput2ints): new routine.
+ * pascal.h (input2ints): new macro to call it.
+
+ * config.h: include c-pathmx.h.
+
+ * common.defines (TEXPOOLNAME): declare as a constant.
+
+Fri Mar 20 16:10:44 1992 Karl Berry (karl at hayley)
+
+ * paths.h: new file.
+
+ * config.h: update for new files c-*.h.
+ * common.h: remove stuff that is now in lib.h.
+
+Thu Mar 19 11:52:17 1992 Karl Berry (karl at hayley)
+
+ * ourpaths.c (append_path_list): remove this.
+
+ * ourpaths.c (setpaths): use the envvar TEXFONTS if VFFONTS isn't set.
+
+Tue Feb 11 10:27:38 1992 Karl Berry (karl at hayley)
+
+ * config.h [NEED_MEMORY_H]: include <memory.h>.
+
+ * config.h [LIMITS_H_MISSING]: include <sys/param.h>.
+
+Sun Feb 2 07:54:53 1992 Karl Berry (karl at hayley)
+
+ * pathsearch.c (parse_envpath): remove the second / before doing
+ subdirectories.
+
+ * pascal.h (optiontable): remove, as getopt no longer has a global
+ table for the long options.
+
+Sat Feb 1 15:32:50 1992 Karl Berry (karl at hayley)
+
+ * ourpaths.c (setpaths): use TEXFONTS if PKFONTS/GFFONTS is not
+ set for GF/PK files, as the documentation claims.
+
+ * ourpaths.c (setpaths): remove subdirectory stuff.
+ * pathsearch.[ch]: new versions to integrate subdirectories into
+ the main paths.
+
+ * texmf{,mem}.c (WEB2C_BIGENDIAN): rename to WORDS_BIGENDIAN.
+
+Fri Jan 31 11:54:46 1992 Karl Berry (karl at hayley)
+
+ * strpascal.c ({null,space}_terminate): do not translate using
+ xord/xchr (from raichle@azu.informatik.uni-stuttgart.de).
+
+Fri Jan 24 07:14:05 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+ * config.h (__CHAR_UNSIGNED__) [CHAR_UNSIGNED]: define as autoconf
+ uses the latter and gcc sometimes the former.
+
+ * config.h: move from config.
+
+ * openinout.c (extensionirrelevantp): new function.
+ * common.defines: declare it.
+
+ * ourpaths.h (path_constant_type): rename from `path_constants'.
+ * openinout.c (open_input): use it for the path arg.
+
+Wed Jan 15 11:13:45 1992 Karl Berry (karl at hayley)
+
+ * xgetcwd.c, xchdir.c: don't need these.
+ * Makefile (objs): remove from list.
+ * dirio.h: remove decls.
+
+ * pathsearch.c (check_subdir): do not cd to the directory we're
+ testing.
+ (add_directory): test if the name is a directory before adding it
+ to the list.
+ (parse_envpath): don't test if the names are directories here.
+ (initialize_path_list): don't find and cd to the current directory
+ between each subdirectory.
+
+Tue Jan 14 16:06:24 1992 Karl Berry (karl at hayley)
+
+ * texmf.c: do not include <sys/types.h>; it's in config.h now.
+ * types.h: likewise.
+
+Sun Jan 12 07:41:34 1992 Karl Berry (karl at hayley)
+
+ * pathsearch.c (initialize_path_list): cd back to . after checking
+ each subdirectory.
+
+ * dirio.h: change directory header stuff as suggested in the
+ autoconf manual.
+
+ * ourpaths.h: make the path list an enumeration type.
+
+ * openinout.c (open_input): correctly compute namelength.
+
+ * texmfmem.h (memoryword) [TeX]: make declaration of `glueratio'
+ conditional.
+
+ * openinout.c: rearrange ifdefs for coherency.
+
+ * ourpaths.c (append_path_list): overwrite the null in the first
+ list.
+
+ * pathsearch.c (initialize_path_list): unconditionally call
+ parse_envpath.
+ (parse_envpath): if the envvar name is null, don't call getenv.
+ If both args are null, do nothing.
+
+ * ourpaths.c (setpaths): initialize the TFM path.
+
+ * common.h (FATAL*): new macros.
+
+ * pascal.h (real): define to be `double'.
+
+ * xfopen-pas.c: new file.
+
+ * eofeoln.c (test_eof): rename to `eof'.
+ * pascal.h (eof): remove.
+
+ * pascal.h (reset, rewrite): `checked_fopen' => `xfopen_pas'.
+
+ * common.h (link): define as `link_var', to avoid conflicts
+ between the system call and the web var.
+
+ * common.defines (FILENAMESIZE): rename to `PATHMAX'.
+
+Tue Jan 7 11:26:02 1992 Karl Berry (karl at hayley)
+
+ * getopt*: new versions.
+
+ * extra.c (getwd) [GETWD_MISSING]: conditionalize.
+
+ * extra.c (zinput3ints): new implementation, from jmr@nada.kth.se.
+
+ * texmf.c (swap_items) [!WEB2C_BIG_ENDIAN]: ifdef on this.
+ * texmfmem.h (twohalves, fourquarters): incorporate changes from
+ raichle@azu.informatik.uni-stuttgart.de which he says make
+ format files finally work.
+
+ * common.h (SCHAR_TYPE): use `signed_char' if ANSI, `short' if
+ char is unsigned, otherwise `char'.
+
diff --git a/Build/source/texk/web2c/lib/Makefile.in b/Build/source/texk/web2c/lib/Makefile.in
new file mode 100644
index 00000000000..330b1b50eb2
--- /dev/null
+++ b/Build/source/texk/web2c/lib/Makefile.in
@@ -0,0 +1,32 @@
+# Makefile for the web2c library.
+
+kpse_include ../make/common.mk
+kpse_include ../make/library.mk
+kpse_include kpathsea.mk
+
+library = lib
+
+# We don't make `texmfmp.o', since TeX, Metafont, and MetaPost need to
+# use different routine names, hence they need different .o files. Maybe
+# we should change this via #define's someday ...
+objects = basechsuffix.o chartostring.o coredump.o \
+ eofeoln.o fprintreal.o inputint.o input2int.o main.o \
+ openclose.o printversion.o uexit.o usage.o version.o zround.o
+
+default all: $(library).a
+$(library).a: $(objects)
+ rm -f $@
+ $(AR) $(ARFLAGS) $@ $(objects)
+ $(RANLIB) $@
+
+# Do not use CPPFLAGS for this, because including config.h might
+# result in a conflicting decl of xmalloc. How annoying.
+alloca.o: alloca.c
+ $(CC) $(CFLAGS) -c $(srcdir)/alloca.c
+
+Makefile: Makefile.in ../config.status
+ cd .. && $(SHELL) config.status
+
+kpse_include ../make/clean.mk
+kpse_include ../make/rdepend.mk
+kpse_include lib/depend.mk
diff --git a/Build/source/texk/web2c/lib/README b/Build/source/texk/web2c/lib/README
new file mode 100644
index 00000000000..8cd3761bef9
--- /dev/null
+++ b/Build/source/texk/web2c/lib/README
@@ -0,0 +1,2 @@
+This directory contains the web2c library, just a few functions mostly
+common to both the TeX programs and the web2c conversion itself.
diff --git a/Build/source/texk/web2c/lib/alloca.c b/Build/source/texk/web2c/lib/alloca.c
new file mode 100644
index 00000000000..385793295fe
--- /dev/null
+++ b/Build/source/texk/web2c/lib/alloca.c
@@ -0,0 +1,504 @@
+/* alloca.c -- allocate automatically reclaimed memory
+ (Mostly) portable public-domain implementation -- D A Gwyn
+
+ This implementation of the PWB library alloca function,
+ which is used to allocate space off the run-time stack so
+ that it is automatically reclaimed upon procedure exit,
+ was inspired by discussions with J. Q. Johnson of Cornell.
+ J.Otto Tennant <jot@cray.com> contributed the Cray support.
+
+ There are some preprocessor constants that can
+ be defined when compiling for your specific system, for
+ improved efficiency; however, the defaults should be okay.
+
+ The general concept of this implementation is to keep
+ track of all alloca-allocated blocks, and reclaim any
+ that are found to be deeper in the stack than the current
+ invocation. This heuristic does not reclaim storage as
+ soon as it becomes invalid, but it will do so eventually.
+
+ As a special case, alloca(0) reclaims storage without
+ allocating any. It is a good idea to use alloca(0) in
+ your main control loop, etc. to force garbage collection. */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#ifdef emacs
+#include "blockinput.h"
+#endif
+
+/* If compiling with GCC 2, this file's not needed. */
+#if !defined (__GNUC__) || __GNUC__ < 2
+
+/* If someone has defined alloca as a macro,
+ there must be some other way alloca is supposed to work. */
+#ifndef alloca
+
+#ifdef emacs
+#ifdef static
+/* actually, only want this if static is defined as ""
+ -- this is for usg, in which emacs must undefine static
+ in order to make unexec workable
+ */
+#ifndef STACK_DIRECTION
+you
+lose
+-- must know STACK_DIRECTION at compile-time
+#endif /* STACK_DIRECTION undefined */
+#endif /* static */
+#endif /* emacs */
+
+/* If your stack is a linked list of frames, you have to
+ provide an "address metric" ADDRESS_FUNCTION macro. */
+
+#if defined (CRAY) && defined (CRAY_STACKSEG_END)
+long i00afunc ();
+#define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
+#else
+#define ADDRESS_FUNCTION(arg) &(arg)
+#endif
+
+#if __STDC__
+typedef void *pointer;
+#else
+typedef char *pointer;
+#endif
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+/* Different portions of Emacs need to call different versions of
+ malloc. The Emacs executable needs alloca to call xmalloc, because
+ ordinary malloc isn't protected from input signals. On the other
+ hand, the utilities in lib-src need alloca to call malloc; some of
+ them are very simple, and don't have an xmalloc routine.
+
+ Non-Emacs programs expect this to call use xmalloc.
+
+ Callers below should use malloc. */
+
+#ifndef emacs
+#define malloc xmalloc
+#endif
+extern pointer malloc ();
+
+/* Define STACK_DIRECTION if you know the direction of stack
+ growth for your system; otherwise it will be automatically
+ deduced at run-time.
+
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown */
+
+#ifndef STACK_DIRECTION
+#define STACK_DIRECTION 0 /* Direction unknown. */
+#endif
+
+#if STACK_DIRECTION != 0
+
+#define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
+
+#else /* STACK_DIRECTION == 0; need run-time code. */
+
+static int stack_dir; /* 1 or -1 once known. */
+#define STACK_DIR stack_dir
+
+static void
+find_stack_direction ()
+{
+ static char *addr = NULL; /* Address of first `dummy', once known. */
+ auto char dummy; /* To get stack address. */
+
+ if (addr == NULL)
+ { /* Initial entry. */
+ addr = ADDRESS_FUNCTION (dummy);
+
+ find_stack_direction (); /* Recurse once. */
+ }
+ else
+ {
+ /* Second entry. */
+ if (ADDRESS_FUNCTION (dummy) > addr)
+ stack_dir = 1; /* Stack grew upward. */
+ else
+ stack_dir = -1; /* Stack grew downward. */
+ }
+}
+
+#endif /* STACK_DIRECTION == 0 */
+
+/* An "alloca header" is used to:
+ (a) chain together all alloca'ed blocks;
+ (b) keep track of stack depth.
+
+ It is very important that sizeof(header) agree with malloc
+ alignment chunk size. The following default should work okay. */
+
+#ifndef ALIGN_SIZE
+#define ALIGN_SIZE sizeof(double)
+#endif
+
+typedef union hdr
+{
+ char align[ALIGN_SIZE]; /* To force sizeof(header). */
+ struct
+ {
+ union hdr *next; /* For chaining headers. */
+ char *deep; /* For stack depth measure. */
+ } h;
+} header;
+
+static header *last_alloca_header = NULL; /* -> last alloca header. */
+
+/* Return a pointer to at least SIZE bytes of storage,
+ which will be automatically reclaimed upon exit from
+ the procedure that called alloca. Originally, this space
+ was supposed to be taken from the current stack frame of the
+ caller, but that method cannot be made to work for some
+ implementations of C, for example under Gould's UTX/32. */
+
+pointer
+alloca (size)
+ unsigned size;
+{
+ auto char probe; /* Probes stack depth: */
+ register char *depth = ADDRESS_FUNCTION (probe);
+
+#if STACK_DIRECTION == 0
+ if (STACK_DIR == 0) /* Unknown growth direction. */
+ find_stack_direction ();
+#endif
+
+ /* Reclaim garbage, defined as all alloca'd storage that
+ was allocated from deeper in the stack than currently. */
+
+ {
+ register header *hp; /* Traverses linked list. */
+
+#ifdef emacs
+ BLOCK_INPUT;
+#endif
+
+ for (hp = last_alloca_header; hp != NULL;)
+ if ((STACK_DIR > 0 && hp->h.deep > depth)
+ || (STACK_DIR < 0 && hp->h.deep < depth))
+ {
+ register header *np = hp->h.next;
+
+ free ((pointer) hp); /* Collect garbage. */
+
+ hp = np; /* -> next header. */
+ }
+ else
+ break; /* Rest are not deeper. */
+
+ last_alloca_header = hp; /* -> last valid storage. */
+
+#ifdef emacs
+ UNBLOCK_INPUT;
+#endif
+ }
+
+ if (size == 0)
+ return NULL; /* No allocation required. */
+
+ /* Allocate combined header + user data storage. */
+
+ {
+ register pointer newm = malloc (sizeof (header) + size);
+ /* Address of header. */
+
+ if (newm == 0)
+ abort();
+
+ ((header *) newm)->h.next = last_alloca_header;
+ ((header *) newm)->h.deep = depth;
+
+ last_alloca_header = (header *) newm;
+
+ /* User storage begins just after header. */
+
+ return (pointer) ((char *) newm + sizeof (header));
+ }
+}
+
+#if defined (CRAY) && defined (CRAY_STACKSEG_END)
+
+#ifdef DEBUG_I00AFUNC
+#include <stdio.h>
+#endif
+
+#ifndef CRAY_STACK
+#define CRAY_STACK
+#ifndef CRAY2
+/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
+struct stack_control_header
+ {
+ long shgrow:32; /* Number of times stack has grown. */
+ long shaseg:32; /* Size of increments to stack. */
+ long shhwm:32; /* High water mark of stack. */
+ long shsize:32; /* Current size of stack (all segments). */
+ };
+
+/* The stack segment linkage control information occurs at
+ the high-address end of a stack segment. (The stack
+ grows from low addresses to high addresses.) The initial
+ part of the stack segment linkage control information is
+ 0200 (octal) words. This provides for register storage
+ for the routine which overflows the stack. */
+
+struct stack_segment_linkage
+ {
+ long ss[0200]; /* 0200 overflow words. */
+ long sssize:32; /* Number of words in this segment. */
+ long ssbase:32; /* Offset to stack base. */
+ long:32;
+ long sspseg:32; /* Offset to linkage control of previous
+ segment of stack. */
+ long:32;
+ long sstcpt:32; /* Pointer to task common address block. */
+ long sscsnm; /* Private control structure number for
+ microtasking. */
+ long ssusr1; /* Reserved for user. */
+ long ssusr2; /* Reserved for user. */
+ long sstpid; /* Process ID for pid based multi-tasking. */
+ long ssgvup; /* Pointer to multitasking thread giveup. */
+ long sscray[7]; /* Reserved for Cray Research. */
+ long ssa0;
+ long ssa1;
+ long ssa2;
+ long ssa3;
+ long ssa4;
+ long ssa5;
+ long ssa6;
+ long ssa7;
+ long sss0;
+ long sss1;
+ long sss2;
+ long sss3;
+ long sss4;
+ long sss5;
+ long sss6;
+ long sss7;
+ };
+
+#else /* CRAY2 */
+/* The following structure defines the vector of words
+ returned by the STKSTAT library routine. */
+struct stk_stat
+ {
+ long now; /* Current total stack size. */
+ long maxc; /* Amount of contiguous space which would
+ be required to satisfy the maximum
+ stack demand to date. */
+ long high_water; /* Stack high-water mark. */
+ long overflows; /* Number of stack overflow ($STKOFEN) calls. */
+ long hits; /* Number of internal buffer hits. */
+ long extends; /* Number of block extensions. */
+ long stko_mallocs; /* Block allocations by $STKOFEN. */
+ long underflows; /* Number of stack underflow calls ($STKRETN). */
+ long stko_free; /* Number of deallocations by $STKRETN. */
+ long stkm_free; /* Number of deallocations by $STKMRET. */
+ long segments; /* Current number of stack segments. */
+ long maxs; /* Maximum number of stack segments so far. */
+ long pad_size; /* Stack pad size. */
+ long current_address; /* Current stack segment address. */
+ long current_size; /* Current stack segment size. This
+ number is actually corrupted by STKSTAT to
+ include the fifteen word trailer area. */
+ long initial_address; /* Address of initial segment. */
+ long initial_size; /* Size of initial segment. */
+ };
+
+/* The following structure describes the data structure which trails
+ any stack segment. I think that the description in 'asdef' is
+ out of date. I only describe the parts that I am sure about. */
+
+struct stk_trailer
+ {
+ long this_address; /* Address of this block. */
+ long this_size; /* Size of this block (does not include
+ this trailer). */
+ long unknown2;
+ long unknown3;
+ long link; /* Address of trailer block of previous
+ segment. */
+ long unknown5;
+ long unknown6;
+ long unknown7;
+ long unknown8;
+ long unknown9;
+ long unknown10;
+ long unknown11;
+ long unknown12;
+ long unknown13;
+ long unknown14;
+ };
+
+#endif /* CRAY2 */
+#endif /* not CRAY_STACK */
+
+#ifdef CRAY2
+/* Determine a "stack measure" for an arbitrary ADDRESS.
+ I doubt that "lint" will like this much. */
+
+static long
+i00afunc (long *address)
+{
+ struct stk_stat status;
+ struct stk_trailer *trailer;
+ long *block, size;
+ long result = 0;
+
+ /* We want to iterate through all of the segments. The first
+ step is to get the stack status structure. We could do this
+ more quickly and more directly, perhaps, by referencing the
+ $LM00 common block, but I know that this works. */
+
+ STKSTAT (&status);
+
+ /* Set up the iteration. */
+
+ trailer = (struct stk_trailer *) (status.current_address
+ + status.current_size
+ - 15);
+
+ /* There must be at least one stack segment. Therefore it is
+ a fatal error if "trailer" is null. */
+
+ if (trailer == 0)
+ abort ();
+
+ /* Discard segments that do not contain our argument address. */
+
+ while (trailer != 0)
+ {
+ block = (long *) trailer->this_address;
+ size = trailer->this_size;
+ if (block == 0 || size == 0)
+ abort ();
+ trailer = (struct stk_trailer *) trailer->link;
+ if ((block <= address) && (address < (block + size)))
+ break;
+ }
+
+ /* Set the result to the offset in this segment and add the sizes
+ of all predecessor segments. */
+
+ result = address - block;
+
+ if (trailer == 0)
+ {
+ return result;
+ }
+
+ do
+ {
+ if (trailer->this_size <= 0)
+ abort ();
+ result += trailer->this_size;
+ trailer = (struct stk_trailer *) trailer->link;
+ }
+ while (trailer != 0);
+
+ /* We are done. Note that if you present a bogus address (one
+ not in any segment), you will get a different number back, formed
+ from subtracting the address of the first block. This is probably
+ not what you want. */
+
+ return (result);
+}
+
+#else /* not CRAY2 */
+/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
+ Determine the number of the cell within the stack,
+ given the address of the cell. The purpose of this
+ routine is to linearize, in some sense, stack addresses
+ for alloca. */
+
+static long
+i00afunc (long address)
+{
+ long stkl = 0;
+
+ long size, pseg, this_segment, stack;
+ long result = 0;
+
+ struct stack_segment_linkage *ssptr;
+
+ /* Register B67 contains the address of the end of the
+ current stack segment. If you (as a subprogram) store
+ your registers on the stack and find that you are past
+ the contents of B67, you have overflowed the segment.
+
+ B67 also points to the stack segment linkage control
+ area, which is what we are really interested in. */
+
+ stkl = CRAY_STACKSEG_END ();
+ ssptr = (struct stack_segment_linkage *) stkl;
+
+ /* If one subtracts 'size' from the end of the segment,
+ one has the address of the first word of the segment.
+
+ If this is not the first segment, 'pseg' will be
+ nonzero. */
+
+ pseg = ssptr->sspseg;
+ size = ssptr->sssize;
+
+ this_segment = stkl - size;
+
+ /* It is possible that calling this routine itself caused
+ a stack overflow. Discard stack segments which do not
+ contain the target address. */
+
+ while (!(this_segment <= address && address <= stkl))
+ {
+#ifdef DEBUG_I00AFUNC
+ fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
+#endif
+ if (pseg == 0)
+ break;
+ stkl = stkl - pseg;
+ ssptr = (struct stack_segment_linkage *) stkl;
+ size = ssptr->sssize;
+ pseg = ssptr->sspseg;
+ this_segment = stkl - size;
+ }
+
+ result = address - this_segment;
+
+ /* If you subtract pseg from the current end of the stack,
+ you get the address of the previous stack segment's end.
+ This seems a little convoluted to me, but I'll bet you save
+ a cycle somewhere. */
+
+ while (pseg != 0)
+ {
+#ifdef DEBUG_I00AFUNC
+ fprintf (stderr, "%011o %011o\n", pseg, size);
+#endif
+ stkl = stkl - pseg;
+ ssptr = (struct stack_segment_linkage *) stkl;
+ size = ssptr->sssize;
+ pseg = ssptr->sspseg;
+ result += size;
+ }
+ return (result);
+}
+
+#endif /* not CRAY2 */
+#endif /* CRAY */
+
+#endif /* no alloca */
+#endif /* not GCC version 2 */
diff --git a/Build/source/texk/web2c/lib/basechsuffix.c b/Build/source/texk/web2c/lib/basechsuffix.c
new file mode 100644
index 00000000000..f2c2d7bb06f
--- /dev/null
+++ b/Build/source/texk/web2c/lib/basechsuffix.c
@@ -0,0 +1,42 @@
+/* basechsuffix.c: replace the last bit of a filename with something else.
+
+ Written in 1995 by Karl Berry. Public domain. */
+
+#include "config.h"
+
+/* Return the basename of NAME, with trailing characters OLD replaced by
+ NEW. (If last characters in NAME are not OLD, just append NEW.)
+ Since this is used to turn, e.g., foo/cmr10.300pk -> cmr10.300gf,
+ don't assume a `.' preceding OLD or NEW.
+
+ In other words, we're implementing `basename NAME OLD`NEW. */
+
+string
+basenamechangesuffix P3C(const_string, name, const_string, old_suffix,
+ const_string, new_suffix)
+{
+ string answer;
+ unsigned c;
+ const_string base = xbasename (name);
+ unsigned base_len = strlen (base);
+ unsigned copy_limit = base_len;
+ unsigned old_suffix_len = strlen (old_suffix);
+
+ if (old_suffix_len <= base_len) {
+ for (c = 0; c < old_suffix_len; c++) {
+ if (!FILECHARCASEEQ (old_suffix[old_suffix_len - c - 1],
+ base[base_len - c - 1]))
+ break;
+ }
+ if (c == old_suffix_len) {
+ copy_limit -= old_suffix_len;
+ }
+ }
+
+ answer = (string)xmalloc (copy_limit + strlen (new_suffix) + 1);
+ strncpy (answer, base, copy_limit);
+ answer[copy_limit] = 0;
+ strcat (answer, new_suffix);
+
+ return answer;
+}
diff --git a/Build/source/texk/web2c/lib/chartostring.c b/Build/source/texk/web2c/lib/chartostring.c
new file mode 100644
index 00000000000..8f98feb7dac
--- /dev/null
+++ b/Build/source/texk/web2c/lib/chartostring.c
@@ -0,0 +1,22 @@
+/* chartostring.c: change a character (i.e., an integer) to a
+ one-character string.
+
+Written in 1994 by Karl Berry. Public domain. */
+
+#include "config.h"
+
+/* This is needed because web2c turns the Pascal construct 'x' into the
+ C character constant 'x', not the string "x". And we need to keep it
+ that way because that's how xord is initialized, etc. But sometimes
+ we want one-character strings -- e.g., in tangle.ch and weave.ch.
+ There's no real alternative to wasting the two bytes of memory (plus
+ malloc overhead) here, but it doesn't matter. */
+
+string
+chartostring P1C(char, ch)
+{
+ string str = (string)xmalloc (2);
+ str[0] = ch;
+ str[1] = 0;
+ return str;
+}
diff --git a/Build/source/texk/web2c/lib/coredump.c b/Build/source/texk/web2c/lib/coredump.c
new file mode 100644
index 00000000000..b465969294c
--- /dev/null
+++ b/Build/source/texk/web2c/lib/coredump.c
@@ -0,0 +1,58 @@
+/* coredump.c. Public domain.
+
+ This procedure is due to Chris Torek, chris@umd.edu. It makes a core
+ dump without any sort of error status (abort(2) does return an error
+ status, so we don't want to use that). It is used only when making a
+ preloaded TeX from virtex, and is triggered by a magic file name
+ requested as input (see `open_input', above). Finding a way to
+ reconstitute the core dump into a binary (i.e., with undump) is up to
+ you. Perl has some things to say about these days. */
+
+#include "config.h"
+
+/* Do not try to compile this Unix-y unportable stuff unless it's needed. */
+
+#ifdef FUNNY_CORE_DUMP
+#include <signal.h>
+#include <sys/wait.h>
+
+void
+funny_core_dump P1H(void)
+{
+#ifdef __EMX__
+ {
+ int handle = open ("core", O_WRONLY | O_CREAT | O_TRUNC | O_BINARY);
+ if (handle >= 0 && _core (handle) == 0)
+ exit (0);
+ (void) write (2, "attempt to dump core failed\n", 28);
+ exit (1);
+ }
+#else /* !__EMX__ */
+ int pid, w;
+ union wait status;
+
+ switch (pid = fork ())
+ {
+ case -1: /* failed */
+ perror ("vfork");
+ exit (-1);
+ /*NOTREACHED*/
+
+ case 0: /* child */
+ (void) signal (SIGQUIT, SIG_DFL);
+ (void) kill (getpid (), SIGQUIT);
+ (void) write (2, "how did we get here?\n", 21);
+ _exit (1);
+ /*NOTREACHED*/
+
+ default: /* parent */
+ while ((w = wait (&status)) != pid && w != -1)
+ ;
+ if (status.w_coredump)
+ exit (0);
+ (void) write (2, "attempt to dump core failed\n", 28);
+ exit (1);
+ }
+#endif /* not __EMX__ */
+}
+#endif /* FUNNY_CORE_DUMP */
diff --git a/Build/source/texk/web2c/lib/depend.mak b/Build/source/texk/web2c/lib/depend.mak
new file mode 100644
index 00000000000..ec2590f959e
--- /dev/null
+++ b/Build/source/texk/web2c/lib/depend.mak
@@ -0,0 +1,355 @@
+$(objdir)/coredump.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/basechsuffix.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/chartostring.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/usage.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/version.obj: \
+ ../c-auto.h
+
+$(objdir)/texmfmp.obj: \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/c-pathmx.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/line.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/readable.h \
+ $(kpathseadir)/c-proto.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/absolute.h \
+ ../texmfmp-help.h
+
+$(objdir)/printversion.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/input2int.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/openclose.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/c-pathch.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/tex-file.h \
+ $(kpathseadir)/variable.h \
+ $(kpathseadir)/absolute.h
+
+$(objdir)/oem.obj: \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/c-vararg.h
+
+$(objdir)/win32main.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/zround.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/uexit.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/eofeoln.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/main.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/fprintreal.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/alloca.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/inputint.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
diff --git a/Build/source/texk/web2c/lib/depend.mk b/Build/source/texk/web2c/lib/depend.mk
new file mode 100644
index 00000000000..20e5de20c8a
--- /dev/null
+++ b/Build/source/texk/web2c/lib/depend.mk
@@ -0,0 +1,140 @@
+alloca.o: alloca.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+basechsuffix.o: basechsuffix.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+chartostring.o: chartostring.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+coredump.o: coredump.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+eofeoln.o: eofeoln.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+fprintreal.o: fprintreal.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+input2int.o: input2int.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+inputint.o: inputint.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+main.o: main.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+mfmpw32.o: mfmpw32.c
+openclose.o: openclose.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-file.h $(kpathsea_srcdir)/variable.h \
+ $(kpathsea_srcdir)/absolute.h
+printversion.o: printversion.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+uexit.o: uexit.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+usage.o: usage.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+version.o: version.c ../c-auto.h
+win32main.o: win32main.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+zround.o: zround.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
diff --git a/Build/source/texk/web2c/lib/eofeoln.c b/Build/source/texk/web2c/lib/eofeoln.c
new file mode 100644
index 00000000000..1107a30e855
--- /dev/null
+++ b/Build/source/texk/web2c/lib/eofeoln.c
@@ -0,0 +1,65 @@
+/* eofeoln.c: implement Pascal's ideas for end-of-file and end-of-line
+ testing. Public domain. */
+
+#include "config.h"
+
+
+/* Return true if we're at the end of FILE, else false. This implements
+ Pascal's `eof' builtin. */
+
+boolean
+eof P1C(FILE *, file)
+{
+ register int c;
+
+ /* If FILE doesn't exist, return false. This happens when, for
+ example, when a user does `mft foo.mf' -- there's no change file,
+ so we never open it, so we end up calling this with a null pointer. */
+ if (!file)
+ return true;
+
+ /* Maybe we're already at the end? */
+ if (feof (file))
+ return true;
+
+ if ((c = getc (file)) == EOF)
+ return true;
+
+ /* We weren't at the end. Back up. */
+ (void) ungetc (c, file);
+
+ return false;
+}
+
+
+/* Return true on end-of-line in FILE or at the end of FILE, else false. */
+/* Accept both CR and LF as end-of-line. */
+
+boolean
+eoln P1C(FILE*, file)
+{
+ register int c;
+
+ if (feof (file))
+ return true;
+
+ c = getc (file);
+
+ if (c != EOF)
+ (void) ungetc (c, file);
+
+ return c == '\n' || c == '\r' || c == EOF;
+}
+
+/* Consume input up and including the first eol encountered. */
+/* Handle CRLF as a single end-of-line. */
+
+void
+readln P1C(FILE*, f)
+{
+ int c;
+ while ((c = getc (f)) != '\n' && c != '\r' && c != EOF)
+ ;
+ if (c == '\r' && (c = getc (f)) != '\n' && c != EOF)
+ ungetc (c, f);
+}
diff --git a/Build/source/texk/web2c/lib/fprintreal.c b/Build/source/texk/web2c/lib/fprintreal.c
new file mode 100644
index 00000000000..55f3fdc50a0
--- /dev/null
+++ b/Build/source/texk/web2c/lib/fprintreal.c
@@ -0,0 +1,14 @@
+/* fprintreal.c: print the real number R in the Pascal format N:M on the
+ file F. Public domain. */
+
+#include "config.h"
+
+void
+fprintreal P4C(FILE*, f, double, r, int, n, int, m)
+{
+ char fmt[50]; /* Surely enough, since N and M won't be more than 25
+ digits each! */
+
+ sprintf (fmt, "%%%d.%dlf", n, m);
+ fprintf (f, fmt, r);
+}
diff --git a/Build/source/texk/web2c/lib/input2int.c b/Build/source/texk/web2c/lib/input2int.c
new file mode 100644
index 00000000000..0ed5cf94686
--- /dev/null
+++ b/Build/source/texk/web2c/lib/input2int.c
@@ -0,0 +1,47 @@
+/* input2int.c: read two or three integers from text files. These
+ routines are only used in patgen. Public domain. */
+
+#include "config.h"
+
+#ifdef INTEGER_IS_INT
+#define SCAN2INT "%d %d"
+#define SCAN3INT "%d %d %d"
+#else
+#define SCAN2INT "%ld %ld"
+#define SCAN3INT "%ld %ld %ld"
+#endif
+
+/* Read two integers from stdin. */
+
+void
+zinput2ints P2C(integer *, a, integer *, b)
+{
+ int ch;
+
+ while (scanf (SCAN2INT, a, b) != 2)
+ {
+ while ((ch = getchar ()) != EOF && ch != '\n');
+ if (ch == EOF) return;
+ (void) fprintf (stderr, "Please enter two integers.\n");
+ }
+
+ while ((ch = getchar ()) != EOF && ch != '\n');
+}
+
+
+/* Read three integers from stdin. */
+
+void
+zinput3ints P3C(integer *, a, integer *, b, integer *, c)
+{
+ int ch;
+
+ while (scanf (SCAN3INT, a, b, c) != 3)
+ {
+ while ((ch = getchar ()) != EOF && ch != '\n');
+ if (ch == EOF) return;
+ (void) fprintf (stderr, "Please enter three integers.\n");
+ }
+
+ while ((ch = getchar ()) != EOF && ch != '\n');
+}
diff --git a/Build/source/texk/web2c/lib/inputint.c b/Build/source/texk/web2c/lib/inputint.c
new file mode 100644
index 00000000000..6ee9a59db00
--- /dev/null
+++ b/Build/source/texk/web2c/lib/inputint.c
@@ -0,0 +1,20 @@
+/* inputint.c: read integers from text files. These routines are only
+ used for debugging and such, so perfect error checking isn't
+ necessary. Public domain. */
+
+#include "config.h"
+
+
+/* Read an integer from the file F, reading past the subsequent end of
+ line. */
+
+integer
+inputint P1C(FILE *, f)
+{
+ char buffer[MAX_INT_LENGTH]; /* Long enough for anything reasonable. */
+
+ return
+ fgets (buffer, sizeof (buffer), f)
+ ? atoi (buffer)
+ : 0;
+}
diff --git a/Build/source/texk/web2c/lib/main.c b/Build/source/texk/web2c/lib/main.c
new file mode 100644
index 00000000000..b699db57b94
--- /dev/null
+++ b/Build/source/texk/web2c/lib/main.c
@@ -0,0 +1,42 @@
+/* main.c -- the main program for everything but TeX & MF. */
+/* Public domain. */
+
+#include "config.h"
+
+
+/* These variables are referenced from the change files. */
+char **argv;
+int argc;
+
+/* The entry point for all the programs except TeX and Metafont, which
+ have more to do. We just have to set up the command line. web2c
+ transforms Pascal's main block into a procedure `main_body'. */
+
+int main P2C(int, ac, string *, av)
+{
+#ifdef __EMX__
+ _wildcard (&ac, &av);
+ _response (&ac, &av);
+#endif
+ extern void mainbody P1H(void);
+
+ argc = ac;
+ argv = av;
+ mainbody ();
+ return EXIT_SUCCESS;
+}
+
+
+/* Return the Nth (counted as in C) argument from the command line. */
+
+string
+cmdline P1C(int, n)
+{
+ if (n >= argc)
+ { /* This error message should never happen, because the callers
+ should always check they've got the arguments they expect. */
+ fprintf (stderr, "%s: Oops; not enough arguments.\n", argv[0]);
+ uexit (1);
+ }
+ return argv[n];
+}
diff --git a/Build/source/texk/web2c/lib/mfmpi386.asm b/Build/source/texk/web2c/lib/mfmpi386.asm
new file mode 100644
index 00000000000..9f0df8825ea
--- /dev/null
+++ b/Build/source/texk/web2c/lib/mfmpi386.asm
@@ -0,0 +1,144 @@
+/* i386 assembly routines for inner loop fraction routines in Metafont
+ and MetaPost. Public domain. Included in texmfmp.c.
+ By Wayne Sullivan <wgs@maths.ucd.ie>. */
+
+asm(" .align 4\n"
+#ifdef ASM_NEEDS_UNDERSCORE
+".globl _ztakefraction\n"
+"_ztakefraction:\n"
+#else
+".globl ztakefraction\n"
+"ztakefraction:\n"
+#endif
+" pushl %ebp\n"
+" movl %esp,%ebp\n"
+" xorl %ecx,%ecx\n"
+" movl 8(%ebp),%eax\n"
+" cmpl $0x80000000,%eax\n"
+" jz LL5\n"
+" imull 12(%ebp)\n"
+" orl %edx,%edx\n"
+" jns LL2\n"
+" negl %edx\n"
+" negl %eax\n"
+" sbbl %ecx,%edx\n"
+" incl %ecx\n"
+"LL2:\n"
+" addl $0x08000000,%eax\n"
+" adcl $0,%edx\n"
+" cmpl $0x07ffffff,%edx\n"
+" ja LL3\n"
+" shrd $28, %edx,%eax\n"
+"LL1: jecxz LL4\n"
+" negl %eax\n"
+"LL4:\n"
+" movl %ebp,%esp\n"
+" popl %ebp\n"
+" ret\n"
+"LL5: incl %ecx\n"
+"LL3: movl $0x7fffffff,%eax\n"
+#ifdef ASM_NEEDS_UNDERSCORE
+" movb $1,_aritherror\n"
+#else
+" movb $1,aritherror\n"
+#endif
+" jmp LL1\n"
+" .align 4, 0x90\n"
+#ifdef ASM_NEEDS_UNDERSCORE
+".globl _ztakescaled\n"
+"_ztakescaled:\n"
+#else
+".globl ztakescaled\n"
+"ztakescaled:\n"
+#endif
+" pushl %ebp\n"
+" movl %esp,%ebp\n"
+" movl 8(%ebp),%eax\n"
+" xorl %ecx,%ecx\n"
+" cmpl $0x80000000,%eax\n"
+" jz LL5\n"
+" imull 12(%ebp)\n"
+" orl %edx,%edx\n"
+" jns LL12\n"
+" negl %edx\n"
+" negl %eax\n"
+" sbbl %ecx,%edx\n"
+" incl %ecx\n"
+"LL12:\n"
+" addl $0x00008000,%eax\n"
+" adcl $0,%edx\n"
+" cmpl $0x00007fff,%edx\n"
+" ja LL3\n"
+" shrd $16, %edx,%eax\n"
+" jecxz LL4\n"
+" negl %eax\n"
+" jmp LL4\n"
+" .align 4, 0x90\n"
+#ifdef ASM_NEEDS_UNDERSCORE
+".globl _zmakescaled\n"
+".globl _zmakefraction\n"
+"_zmakescaled:\n"
+#else
+".globl zmakescaled\n"
+".globl zmakefraction\n"
+"zmakescaled:\n"
+#endif
+" movb $16,%cl\n"
+" jmp LL30\n"
+" .align 4, 0x90\n"
+#ifdef ASM_NEEDS_UNDERSCORE
+"_zmakefraction:\n"
+#else
+"zmakefraction:\n"
+#endif
+" movb $4,%cl\n"
+"LL30:\n"
+" movb $0,%ch\n"
+" pushl %ebp\n"
+" movl %esp,%ebp\n"
+" pushl %ebx\n"
+" movl 8(%ebp),%edx\n"
+" xorl %eax,%eax\n"
+" orl %edx,%edx\n"
+" jns LL32\n"
+" inc %ch\n"
+" negl %edx\n"
+"LL32:\n"
+" movl 12(%ebp),%ebx\n"
+" orl %ebx,%ebx\n"
+" jns LL33\n"
+" dec %ch\n"
+" negl %ebx\n"
+" orl %ebx,%ebx\n"
+" js LL34\n"
+"LL33:\n"
+" orl %edx,%edx\n"
+" js LL34\n"
+" shrd %cl,%edx,%eax\n"
+" shrl %cl,%edx\n"
+" cmpl %ebx,%edx\n"
+" jae LL34\n"
+" divl %ebx\n"
+" addl %edx,%edx\n"
+" incl %edx\n"
+" subl %edx,%ebx\n"
+" adcl $0,%eax\n"
+" jc LL34\n"
+" cmpl $0x7fffffff,%eax\n"
+" ja LL34\n"
+"LL31: or %ch,%ch\n"
+" jz LL35\n"
+" negl %eax\n"
+"LL35:\n"
+" popl %ebx\n"
+" movl %ebp,%esp\n"
+" popl %ebp\n"
+" ret\n"
+"LL34: movl $0x7fffffff,%eax\n"
+#ifdef ASM_NEEDS_UNDERSCORE
+" movb $1,_aritherror\n"
+#else
+" movb $1,aritherror\n"
+#endif
+" jmp LL31\n");
+
diff --git a/Build/source/texk/web2c/lib/mfmpw32.c b/Build/source/texk/web2c/lib/mfmpw32.c
new file mode 100644
index 00000000000..de065fd96e2
--- /dev/null
+++ b/Build/source/texk/web2c/lib/mfmpw32.c
@@ -0,0 +1,189 @@
+/* i386 assembly routines for inner loop fraction routines in Metafont
+ and MetaPost. Included from texmfmp.c. By Wayne Sullivan
+ <wgs@maths.ucd.ie>. */
+
+/*
+ Converted to inline assembler for Visual C++ [45].xx
+ by Fabrice Popineau <Fabrice.Popineau@supelec.fr> */
+
+__declspec(naked) fraction __stdcall ztakefraction(integer p, integer q) {
+__asm {
+ push ebp
+ mov ebp,esp
+ xor ecx,ecx
+ mov eax, p
+; mov eax, [ebp+8]
+ cmp eax, 0x80000000
+ jz LL5
+ imul q
+ or edx,edx
+ jns LL2
+ neg edx
+ neg eax
+ sbb edx, ecx
+ inc ecx
+LL2:
+ add eax, 0x08000000
+ adc edx, 0
+ cmp edx, 0x07ffffff
+ ja LL3
+ shrd eax,edx,28
+LL1:
+ jecxz LL4
+ neg eax
+LL4:
+ mov esp,ebp
+ pop ebp
+ ret 8
+LL5:
+ inc ecx
+LL3:
+ mov eax, 0x7fffffff
+ mov aritherror, 1
+ jmp LL1
+}
+}
+
+__declspec(naked) integer __stdcall ztakescaled(integer p, scaled q) {
+__asm {
+ push ebp
+ mov ebp,esp
+; mov eax, [ebp+8]
+ xor ecx,ecx
+ mov eax, p
+ cmp eax, 0x80000000
+ jz LL5
+ imul q
+ or edx,edx
+ jns LL12
+ neg edx
+ neg eax
+ sbb edx,ecx
+ inc ecx
+LL12:
+ add eax, 0x00008000
+ adc edx, 0x0
+ cmp edx, 0x00007fff
+ ja LL3
+ shrd eax,edx,16
+LL1:
+ jecxz LL4
+ neg eax
+LL4:
+ mov esp,ebp
+ pop ebp
+ ret 8
+LL5:
+ inc ecx
+LL3:
+ mov eax, 0x7fffffff
+ mov aritherror, 1
+ jmp LL1
+ }
+}
+
+__declspec(naked) scaled __stdcall zmakescaled(integer p, integer q) {
+ __asm {
+ mov cx, 16
+ push ebp
+ mov ebp,esp
+ push ebx
+; mov edx, [ebp+8]
+ mov edx, p
+ xor eax,eax
+ or edx,edx
+ jns LL32
+ inc ch
+ neg edx
+LL32:
+; mov ebx, [ebp+12]
+ mov ebx,q
+ or ebx,ebx
+ jns LL33
+ dec ch
+ neg ebx
+ or ebx,ebx
+ js LL34
+LL33:
+ or edx,edx
+ js LL34
+ shrd eax,edx,cl
+ shr edx,cl
+ cmp edx,ebx
+ jae LL34
+ div ebx
+ add edx,edx
+ inc edx
+ sub ebx,edx
+ adc eax, 0
+ jc LL34
+ cmp eax, 0x7fffffff
+ ja LL34
+LL31: or ch,ch
+ jz LL35
+ neg eax
+LL35:
+ pop ebx
+ mov esp, ebp
+ pop ebp
+ ret 8
+LL34:
+ mov eax, 0x7fffffff
+ mov aritherror, 1
+ jmp LL31
+ }
+}
+
+__declspec(naked) fraction __stdcall zmakefraction(integer p, integer q) {
+ __asm {
+ mov cx, 4
+ push ebp
+ mov ebp,esp
+ push ebx
+ mov edx, p
+; mov [ebp+8],edx
+ xor eax,eax
+ or edx,edx
+ jns LL32
+ inc ch
+ neg edx
+LL32:
+; mov [ebp+12],ebx
+ mov ebx, q
+ or ebx,ebx
+ jns LL33
+ dec ch
+ neg ebx
+ or ebx,ebx
+ js LL34
+LL33:
+ or edx,edx
+ js LL34
+ shrd eax,edx, cl
+ shr edx,cl
+ cmp edx,ebx
+ jae LL34
+ div ebx
+ add edx,edx
+ inc edx
+ sub ebx,edx
+ adc eax, 0
+ jc LL34
+ cmp eax, 0x7fffffff
+ ja LL34
+LL31: or ch,ch
+ jz LL35
+ neg eax
+LL35:
+ pop ebx
+ mov esp, ebp
+ pop ebp
+ ret 8
+LL34:
+ mov eax, 0x7fffffff
+ mov aritherror, 1
+ jmp LL31
+ }
+}
+
+
diff --git a/Build/source/texk/web2c/lib/openclose.c b/Build/source/texk/web2c/lib/openclose.c
new file mode 100644
index 00000000000..6e542d247fa
--- /dev/null
+++ b/Build/source/texk/web2c/lib/openclose.c
@@ -0,0 +1,251 @@
+/* openclose.c: open and close files for TeX, Metafont, and BibTeX.
+
+ Written 1995, 96 Karl Berry. Public domain. */
+
+#include "config.h"
+#include <kpathsea/c-pathch.h>
+#include <kpathsea/tex-file.h>
+#include <kpathsea/variable.h>
+#include <kpathsea/absolute.h>
+
+/* The globals we use to communicate. */
+extern string nameoffile;
+extern unsigned namelength;
+/* For "file:line:error style error messages. */
+extern string fullnameoffile;
+/* For the filename recorder. */
+extern boolean recorder_enabled;
+/* For the output-dir option. */
+extern string output_directory;
+
+/* Define some variables. */
+string fullnameoffile; /* Defaults to NULL. */
+static string recorder_name; /* Defaults to NULL. */
+static FILE *recorder_file; /* Defaults to NULL. */
+boolean recorder_enabled; /* Defaults to false. */
+string output_directory; /* Defaults to NULL. */
+
+/* For TeX and MetaPost. See below. Always defined so we don't have to
+ #ifdef, and thus this file can be compiled once and go in lib.a. */
+int tfmtemp;
+int ocptemp;
+int texinputtype;
+
+/* Helpers for the filename recorder... */
+/* Start the recorder */
+static void
+recorder_start()
+{
+ /* Alas, while we might want to use mkstemp it is not portable.
+ So we have to be content with using a default name... */
+ string cwd;
+ recorder_name = (string)xmalloc(strlen(kpse_program_name)+5);
+ strcpy(recorder_name, kpse_program_name);
+ strcat(recorder_name, ".fls");
+ recorder_file = xfopen(recorder_name, FOPEN_W_MODE);
+ cwd = xgetcwd();
+ fprintf(recorder_file, "PWD %s\n", cwd);
+ free(cwd);
+}
+
+/* Change the name of the recorder file. */
+void
+recorder_change_filename P1C(string, new_name)
+{
+ if (!recorder_file)
+ return;
+ rename(recorder_name, new_name);
+ free(recorder_name);
+ recorder_name = xstrdup(new_name);
+}
+
+/* Open an input file F, using the kpathsea format FILEFMT and passing
+ FOPEN_MODE to fopen. The filename is in `nameoffile+1'. We return
+ whether or not the open succeeded. If it did, `nameoffile' is set to
+ the full filename opened, and `namelength' to its length. */
+
+boolean
+open_input P3C(FILE **, f_ptr, int, filefmt, const_string, fopen_mode)
+{
+ string fname = NULL;
+#ifdef FUNNY_CORE_DUMP
+ /* This only applies if a preloaded TeX/Metafont is being made;
+ it allows automatic creation of the core dump (typing ^\ loses
+ since that requires manual intervention). */
+ if ((filefmt == kpse_tex_format || filefmt == kpse_mf_format
+ || filefmt == kpse_mp_format)
+ && STREQ (nameoffile + 1, "HackyInputFileNameForCoreDump.tex"))
+ funny_core_dump ();
+#endif
+
+ /* We havent found anything yet. */
+ *f_ptr = NULL;
+ if (fullnameoffile)
+ free(fullnameoffile);
+ fullnameoffile = NULL;
+
+ /* Handle -output-directory.
+ FIXME: We assume that it is OK to look here first. Possibly it
+ would be better to replace lookups in "." with lookups in the
+ output_directory followed by "." but to do this requires much more
+ invasive surgery in libkpathsea. */
+ /* FIXME: This code assumes that the filename of the input file is
+ not an absolute filename. */
+ if (output_directory) {
+ fname = concat3(output_directory, DIR_SEP_STRING, nameoffile + 1);
+ *f_ptr = fopen(fname, fopen_mode);
+ if (*f_ptr) {
+ free(nameoffile);
+ namelength = strlen (fname);
+ nameoffile = (string)xmalloc (namelength + 2);
+ strcpy (nameoffile + 1, fname);
+ fullnameoffile = fname;
+ } else {
+ free(fname);
+ }
+ }
+
+ /* No file means do the normal search. */
+ if (*f_ptr == NULL) {
+ /* A negative FILEFMT means don't use a path. */
+ if (filefmt < 0) {
+ /* no_file_path, for BibTeX .aux files and MetaPost things. */
+ *f_ptr = fopen(nameoffile + 1, fopen_mode);
+ /* FIXME... fullnameoffile = xstrdup(nameoffile + 1); */
+ } else {
+ /* The only exception to `must_exist' being true is \openin, for
+ which we set `tex_input_type' to 0 in the change file. */
+ /* According to the pdfTeX people, pounding the disk for .vf files
+ is overkill as well. A more general solution would be nice. */
+ boolean must_exist = (filefmt != kpse_tex_format || texinputtype)
+ && (filefmt != kpse_vf_format);
+ fname = kpse_find_file (nameoffile + 1,
+ (kpse_file_format_type)filefmt,
+ must_exist);
+ if (fname) {
+ fullnameoffile = xstrdup(fname);
+ /* If we found the file in the current directory, don't leave
+ the `./' at the beginning of `nameoffile', since it looks
+ dumb when `tex foo' says `(./foo.tex ... )'. On the other
+ hand, if the user said `tex ./foo', and that's what we
+ opened, then keep it -- the user specified it, so we
+ shouldn't remove it. */
+ if (fname[0] == '.' && IS_DIR_SEP (fname[1])
+ && (nameoffile[1] != '.' || !IS_DIR_SEP (nameoffile[2])))
+ {
+ unsigned i = 0;
+ while (fname[i + 2] != 0) {
+ fname[i] = fname[i + 2];
+ i++;
+ }
+ fname[i] = 0;
+ }
+
+ /* kpse_find_file always returns a new string. */
+ free (nameoffile);
+ namelength = strlen (fname);
+ nameoffile = (string)xmalloc (namelength + 2);
+ strcpy (nameoffile + 1, fname);
+ free (fname);
+
+ /* This fopen is not allowed to fail. */
+ *f_ptr = xfopen (nameoffile + 1, fopen_mode);
+ }
+ }
+ }
+
+ if (*f_ptr) {
+ if (recorder_enabled) {
+ if (!recorder_file)
+ recorder_start();
+ fprintf(recorder_file, "INPUT %s\n", nameoffile + 1);
+ }
+
+ /* If we just opened a TFM file, we have to read the first
+ byte, to pretend we're Pascal. See tex.ch and mp.ch.
+ Ditto for the ocp/ofm Omega file formats. */
+ if (filefmt == kpse_tfm_format) {
+ tfmtemp = getc (*f_ptr);
+ /* We intentionally do not check for EOF here, i.e., an
+ empty TFM file. TeX will see the 255 byte and complain
+ about a bad TFM file, which is what we want. */
+ } else if (filefmt == kpse_ocp_format) {
+ ocptemp = getc (*f_ptr);
+ } else if (filefmt == kpse_ofm_format) {
+ tfmtemp = getc (*f_ptr);
+ }
+ }
+
+ return *f_ptr != NULL;
+}
+
+/* Open an output file F either in the current directory or in
+ $TEXMFOUTPUT/F, if the environment variable `TEXMFOUTPUT' exists.
+ (Actually, this also applies to the BibTeX and MetaPost output files,
+ but `TEXMFMPBIBOUTPUT' was just too long.) The filename is in the
+ global `nameoffile' + 1. We return whether or not the open
+ succeeded. If it did, `nameoffile' is reset to the name opened if
+ necessary, and `namelength' to its length. */
+
+boolean
+open_output P2C(FILE **, f_ptr, const_string, fopen_mode)
+{
+ string fname;
+ boolean absolute = kpse_absolute_p(nameoffile+1, false);
+
+ /* If we have an explicit output directory, use it. */
+ if (output_directory && !absolute) {
+ fname = concat3(output_directory, DIR_SEP_STRING, nameoffile + 1);
+ } else {
+ fname = nameoffile + 1;
+ }
+
+ /* Is the filename openable as given? */
+ *f_ptr = fopen (fname, fopen_mode);
+
+ if (!*f_ptr) {
+ /* Can't open as given. Try the envvar. */
+ string texmfoutput = kpse_var_value("TEXMFOUTPUT");
+
+ if (texmfoutput && *texmfoutput && !absolute) {
+ string fname = concat3(texmfoutput, DIR_SEP_STRING, nameoffile+1);
+ *f_ptr = fopen(fname, fopen_mode);
+ }
+ }
+ /* If this succeeded, change nameoffile accordingly. */
+ if (*f_ptr) {
+ if (fname != nameoffile + 1) {
+ free (nameoffile);
+ namelength = strlen (fname);
+ nameoffile = (string)xmalloc (namelength + 2);
+ strcpy (nameoffile + 1, fname);
+ }
+ if (recorder_enabled) {
+ if (!recorder_file)
+ recorder_start();
+ fprintf(recorder_file, "OUTPUT %s\n", fname);
+ }
+ }
+ if (fname != nameoffile +1)
+ free(fname);
+ return *f_ptr != NULL;
+}
+
+/* Close F. */
+
+void
+aclose P1C(FILE *, f)
+{
+ /* If F is null, just return. bad_pool might close a file that has
+ never been opened. */
+ if (!f)
+ return;
+
+ if (fclose (f) == EOF) {
+ /* It's not always nameoffile, we might have opened something else
+ in the meantime. And it's not easy to extract the filenames out
+ of the pool array. So just punt on the filename. Sigh. This
+ probably doesn't need to be a fatal error. */
+ perror ("fclose");
+ }
+}
diff --git a/Build/source/texk/web2c/lib/printversion.c b/Build/source/texk/web2c/lib/printversion.c
new file mode 100644
index 00000000000..cbcf5d56a00
--- /dev/null
+++ b/Build/source/texk/web2c/lib/printversion.c
@@ -0,0 +1,58 @@
+/* printversion.c: Output for the standard GNU option --version.
+
+ Written in 1996 by K. Berry. Public domain. */
+
+#include "config.h"
+
+/* We're passed in the original WEB banner string, which has the form
+This is PROGRAM, Version VERSION-NUMBER
+ We parse the PROGRAM and VERSION-NUMBER out of this.
+
+ If COPYRIGHT_HOLDER is specified and AUTHOR isn't, then use the
+ former for the latter. If AUTHOR is specified and COPYRIGHT_HOLDER
+ isn't, it means the original program is public domain.
+
+ Maybe I should have just done it all inline in each individual
+ program, but tangle doesn't allow multiline string constants ... */
+
+void
+printversionandexit P3C(const_string, banner,
+ const_string, copyright_holder, const_string, author)
+{
+ extern string versionstring; /* from web2c/lib/version.c */
+ extern KPSEDLL string kpathsea_version_string;/* from kpathsea/version.c */
+ string prog_name;
+ unsigned len;
+ const_string prog_name_end = strchr (banner, ',');
+ const_string prog_version = strrchr (banner, ' ');
+ assert (prog_name_end && prog_version);
+ prog_version++;
+
+ len = prog_name_end - banner - sizeof ("This is");
+ prog_name = (string)xmalloc (len + 1);
+ strncpy (prog_name, banner + sizeof ("This is"), len);
+ prog_name[len] = 0;
+
+ /* The Web2c version string starts with a space. */
+ printf ("%s %s%s\n", prog_name, prog_version, versionstring);
+ puts (kpathsea_version_string);
+
+ if (copyright_holder) {
+ printf ("Copyright 2005 %s.\n", copyright_holder);
+ if (!author)
+ author = copyright_holder;
+ }
+
+ puts ("Kpathsea is copyright 2005 Karl Berry and Olaf Weber.");
+
+ puts ("There is NO warranty. Redistribution of this software is");
+ fputs ("covered by the terms of ", stdout);
+ printf ("both the %s copyright and\n", prog_name);
+ puts ("the Lesser GNU General Public License.");
+ puts ("For more information about these matters, see the file");
+ printf ("named COPYING and the %s source.\n", prog_name);
+ printf ("Primary author of %s: %s.\n", prog_name, author);
+ puts ("Kpathsea written by Karl Berry, Olaf Weber, and others.\n");
+
+ uexit (0);
+}
diff --git a/Build/source/texk/web2c/lib/texmfmp.c b/Build/source/texk/web2c/lib/texmfmp.c
new file mode 100644
index 00000000000..ff69d12df4f
--- /dev/null
+++ b/Build/source/texk/web2c/lib/texmfmp.c
@@ -0,0 +1,2250 @@
+/* texmf.c: Hand-coded routines for TeX or Metafont in C. Originally
+ written by Tim Morgan, drawing from other Unix ports of TeX. This is
+ a collection of miscellany, everything that's easier (or only
+ possible) to do in C.
+
+ This file is public domain. */
+
+#define EXTERN /* Instantiate data from {tex,mf,mp}d.h here. */
+
+/* This file is used to create texextra.c etc., with this line
+ changed to include texd.h, mfd.h, or mpd.h. The ?d.h file is what
+ #defines TeX or MF or MP, which avoids the need for a special
+ Makefile rule. */
+#include "TEX-OR-MF-OR-MPd.h"
+
+#include <kpathsea/c-ctype.h>
+#include <kpathsea/line.h>
+#include <kpathsea/readable.h>
+#include <kpathsea/variable.h>
+#include <kpathsea/absolute.h>
+
+#include <time.h> /* For `struct tm'. */
+#if defined (HAVE_SYS_TIME_H)
+#include <sys/time.h>
+#elif defined (HAVE_SYS_TIMEB_H)
+#include <sys/timeb.h>
+#endif
+
+#if defined(__STDC__)
+#include <locale.h>
+#endif
+
+#include <signal.h> /* Catch interrupts. */
+
+#include <texmfmp-help.h>
+
+/* {tex,mf}d.h defines TeX, MF, INI, and other such symbols.
+ Unfortunately there's no way to get the banner into this code, so
+ just repeat the text. */
+#ifdef TeX
+#if defined (eTeX)
+#include <etexdir/etexextra.h>
+#elif defined (pdfTeX)
+#include <pdftexdir/pdftexextra.h>
+#elif defined (pdfeTeX)
+#include <pdfetexdir/pdfetexextra.h>
+#elif defined (Omega)
+#include <omegadir/omegaextra.h>
+#elif defined (eOmega)
+#include <eomegadir/eomegaextra.h>
+#elif defined (Aleph)
+#include <alephdir/alephextra.h>
+#else
+#define BANNER "This is TeX, Version 3.141592"
+#define COPYRIGHT_HOLDER "D.E. Knuth"
+#define AUTHOR NULL
+#define PROGRAM_HELP TEXHELP
+#define BUG_ADDRESS "tex-k@mail.tug.org"
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "initex"
+#define VIR_PROGRAM "virtex"
+#endif
+#define edit_var "TEXEDIT"
+#endif /* TeX */
+#ifdef MF
+#define BANNER "This is Metafont, Version 2.71828"
+#define COPYRIGHT_HOLDER "D.E. Knuth"
+#define AUTHOR NULL
+#define PROGRAM_HELP MFHELP
+#define BUG_ADDRESS "tex-k@mail.tug.org"
+#define DUMP_VAR MFbasedefault
+#define DUMP_LENGTH_VAR basedefaultlength
+#define DUMP_OPTION "base"
+#ifdef DOS
+#define DUMP_EXT ".bas"
+#else
+#define DUMP_EXT ".base"
+#endif
+#define INPUT_FORMAT kpse_mf_format
+#define INI_PROGRAM "inimf"
+#define VIR_PROGRAM "virmf"
+#define edit_var "MFEDIT"
+#endif /* MF */
+#ifdef MP
+#define BANNER "This is MetaPost, Version 0.901"
+#define COPYRIGHT_HOLDER "AT&T Bell Laboratories"
+#define AUTHOR "John Hobby"
+#define PROGRAM_HELP MPHELP
+#define BUG_ADDRESS "tex-k@mail.tug.org"
+#define DUMP_VAR MPmemdefault
+#define DUMP_LENGTH_VAR memdefaultlength
+#define DUMP_OPTION "mem"
+#define DUMP_EXT ".mem"
+#define INPUT_FORMAT kpse_mp_format
+#define INI_PROGRAM "inimpost"
+#define VIR_PROGRAM "virmpost"
+#define edit_var "MPEDIT"
+#endif /* MP */
+
+/* The main program, etc. */
+
+/* What we were invoked as and with. */
+char **argv;
+int argc;
+
+/* If the user overrides argv[0] with -progname. */
+static string user_progname;
+
+/* The C version of what might wind up in DUMP_VAR. */
+static const_string dump_name;
+
+/* The C version of the jobname, if given. */
+static const_string job_name;
+
+/* Full source file name. */
+extern string fullnameoffile;
+
+/* The filename for dynamic character translation, or NULL. */
+string translate_filename;
+string default_translate_filename;
+
+/* Needed for --src-specials option. */
+static char *last_source_name;
+static int last_lineno;
+static boolean srcspecialsoption = false;
+static void parse_src_specials_option P1H(const_string);
+
+/* The main body of the WEB is transformed into this procedure. */
+extern TEXDLL void mainbody P1H(void);
+
+/* Parsing a first %&-line in the input file. */
+static void parse_first_line P1H(const_string);
+
+/* Parse option flags. */
+static void parse_options P2H(int, string *);
+
+/* Try to figure out if we have been given a filename. */
+static string get_input_file_name P1H(void);
+
+#if defined(Omega) || defined(eOmega) || defined(Aleph)
+/* Declare this for Omega family, so they can parse the -8bit option,
+ * even though it is a no-op for them.
+ */
+static int eightbitp;
+#endif /* Omega || eOmega || Aleph */
+
+#if defined(pdfTeX) || defined(pdfeTeX)
+char *ptexbanner;
+#endif
+
+#ifdef MP
+/* name of TeX program to pass to makempx */
+static string mpost_tex_program = "";
+#endif
+
+/* Get a true/false value for a variable from texmf.cnf and the environment. */
+static boolean
+texmf_yesno(const_string var)
+{
+ string value = kpse_var_value (var);
+ return value && (*value == 't' || *value == 'y' || *value == '1');
+}
+
+/* The entry point: set up for reading the command line, which will
+ happen in `topenin', then call the main body. */
+
+void TEXDLL
+maininit P2C(int, ac, string *, av)
+{
+ string main_input_file;
+
+ /* Save to pass along to topenin. */
+ argc = ac;
+ argv = av;
+
+ /* Must be initialized before options are parsed. */
+ interactionoption = 4;
+
+#if defined(pdfTeX) || defined(pdfeTeX)
+ ptexbanner = BANNER;
+#endif
+
+ /* If the user says --help or --version, we need to notice early. And
+ since we want the --ini option, have to do it before getting into
+ the web (which would read the base file, etc.). */
+ parse_options (ac, av);
+
+ /* Do this early so we can inspect program_invocation_name and
+ kpse_program_name below, and because we have to do this before
+ any path searching. */
+ kpse_set_program_name (argv[0], user_progname);
+
+ /* FIXME: gather engine names in a single spot. */
+ xputenv("engine", TEXMFENGINENAME);
+
+ /* Were we given a simple filename? */
+ main_input_file = get_input_file_name();
+
+ /* Second chance to activate file:line:error style messages, this
+ time from texmf.cnf. */
+ if (filelineerrorstylep < 0) {
+ filelineerrorstylep = 0;
+ } else if (!filelineerrorstylep) {
+ filelineerrorstylep = texmf_yesno ("file_line_error_style");
+ }
+
+ /* If no dump default yet, and we're not doing anything special on
+ this run, we may want to look at the first line of the main input
+ file for a %&<dumpname> specifier. */
+ if (parsefirstlinep < 0) {
+ parsefirstlinep = 0;
+ } else if (!parsefirstlinep) {
+ parsefirstlinep = texmf_yesno ("parse_first_line");
+ }
+ if (parsefirstlinep && (!dump_name || !translate_filename)) {
+ parse_first_line (main_input_file);
+ }
+ /* Check whether there still is no translate_filename known. If so,
+ use the default_translate_filename. */
+ /* FIXME: deprecated. */
+ if (!translate_filename) {
+ translate_filename = default_translate_filename;
+ }
+ /* If we're preloaded, I guess everything is set up. I don't really
+ know any more, it's been so long since anyone preloaded. */
+ if (readyalready != 314159) {
+ /* The `ini_version' variable is declared/used in the change files. */
+ boolean virversion = false;
+ if (FILESTRCASEEQ (kpse_program_name, INI_PROGRAM)) {
+ iniversion = true;
+ } else if (FILESTRCASEEQ (kpse_program_name, VIR_PROGRAM)) {
+ virversion = true;
+#ifdef TeX
+ } else if (FILESTRCASEEQ (kpse_program_name, "initex")) {
+ iniversion = true;
+ } else if (FILESTRCASEEQ (kpse_program_name, "virtex")) {
+ virversion = true;
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+ } else if (FILESTRCASEEQ (kpse_program_name, "mltex")) {
+ mltexp = true;
+#endif /* !Omega && !eOmega && !Aleph */
+#endif /* TeX */
+ }
+
+ if (!dump_name) {
+ /* If called as *vir{mf,tex,mpost} use `plain'. Otherwise, use the
+ name we were invoked under. */
+ dump_name = (virversion ? "plain" : kpse_program_name);
+ }
+ }
+
+#ifdef TeX
+ /* Sanity check: -mltex, -enc, -etex only work in combination with -ini. */
+ if (!iniversion) {
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+ if (mltexp) {
+ fprintf(stderr, "-mltex only works with -ini\n");
+ }
+ if (enctexp) {
+ fprintf(stderr, "-enc only works with -ini\n");
+ }
+#endif
+#if defined(eTeX) || defined(pdfeTeX) || defined(Aleph)
+ if (etexp) {
+ fprintf(stderr, "-etex only works with -ini\n");
+ }
+#endif
+ }
+#endif
+
+ /* If we've set up the fmt/base default in any of the various ways
+ above, also set its length. */
+ if (dump_name) {
+ /* adjust array for Pascal and provide extension */
+ DUMP_VAR = concat3 (" ", dump_name, DUMP_EXT);
+ DUMP_LENGTH_VAR = strlen (DUMP_VAR + 1);
+ } else {
+ /* For dump_name to be NULL is a bug. */
+ abort();
+ }
+
+ /* Additional initializations. No particular reason for doing them
+ here instead of first thing in the change file; less symbols to
+ propagate through Webc, that's all. */
+#ifdef MF
+ kpse_set_program_enabled (kpse_mf_format, MAKE_TEX_MF_BY_DEFAULT,
+ kpse_src_compile);
+ kpse_set_program_enabled (kpse_base_format, MAKE_TEX_FMT_BY_DEFAULT,
+ kpse_src_compile);
+#endif /* MF */
+#ifdef MP
+ kpse_set_program_enabled (kpse_mem_format, MAKE_TEX_FMT_BY_DEFAULT,
+ kpse_src_compile);
+#endif /* MP */
+#ifdef TeX
+#if defined(Omega) || defined (eOmega) || defined (Aleph)
+ kpse_set_program_enabled (kpse_ocp_format, MAKE_OMEGA_OCP_BY_DEFAULT,
+ kpse_src_compile);
+ kpse_set_program_enabled (kpse_ofm_format, MAKE_OMEGA_OFM_BY_DEFAULT,
+ kpse_src_compile);
+ kpse_set_program_enabled (kpse_tfm_format, false, kpse_src_compile);
+#else /* !Omega && !eOmega && !Aleph */
+ kpse_set_program_enabled (kpse_tfm_format, MAKE_TEX_TFM_BY_DEFAULT,
+ kpse_src_compile);
+#endif /* !Omega && !eOmega && !Aleph */
+ kpse_set_program_enabled (kpse_tex_format, MAKE_TEX_TEX_BY_DEFAULT,
+ kpse_src_compile);
+ kpse_set_program_enabled (kpse_fmt_format, MAKE_TEX_FMT_BY_DEFAULT,
+ kpse_src_compile);
+
+ if (shellenabledp < 0) {
+ shellenabledp = 0;
+ } else if (!shellenabledp) {
+ shellenabledp = texmf_yesno ("shell_escape");
+ }
+ if (!outputcomment) {
+ outputcomment = kpse_var_value ("output_comment");
+ }
+#endif /* TeX */
+}
+
+#ifndef WIN32
+/* The entry point: set up for reading the command line, which will
+ happen in `topenin', then call the main body. */
+
+int
+main P2C(int, ac, string *, av)
+{
+#ifdef __EMX__
+ _wildcard (&ac, &av);
+ _response (&ac, &av);
+#endif
+
+ maininit(ac, av);
+
+ /* Call the real main program. */
+ mainbody ();
+ return EXIT_SUCCESS;
+}
+#endif /* ! WIN32 */
+
+/* This is supposed to ``open the terminal for input'', but what we
+ really do is copy command line arguments into TeX's or Metafont's
+ buffer, so they can handle them. If nothing is available, or we've
+ been called already (and hence, argc==0), we return with
+ `last=first'. */
+
+void
+topenin P1H(void)
+{
+ int i;
+
+ buffer[first] = 0; /* In case there are no arguments. */
+
+ if (optind < argc) { /* We have command line arguments. */
+ int k = first;
+ for (i = optind; i < argc; i++) {
+ char *ptr = &(argv[i][0]);
+ /* Don't use strcat, since in Omega the buffer elements aren't
+ single bytes. */
+ while (*ptr) {
+ buffer[k++] = *(ptr++);
+ }
+ buffer[k++] = ' ';
+ }
+ argc = 0; /* Don't do this again. */
+ buffer[k] = 0;
+ }
+
+ /* Find the end of the buffer. */
+ for (last = first; buffer[last]; ++last)
+ ;
+
+ /* Make `last' be one past the last non-blank character in `buffer'. */
+ /* ??? The test for '\r' should not be necessary. */
+ for (--last; last >= first
+ && ISBLANK (buffer[last]) && buffer[last] != '\r'; --last)
+ ;
+ last++;
+
+ /* One more time, this time converting to TeX's internal character
+ representation. */
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+ for (i = first; i < last; i++)
+ buffer[i] = xord[buffer[i]];
+#endif
+}
+
+/* IPC for TeX. By Tom Rokicki for the NeXT; it makes TeX ship out the
+ DVI file in a pipe to TeXView so that the output can be displayed
+ incrementally. Shamim Mohamed adapted it for Web2c. */
+#if defined (TeX) && defined (IPC)
+
+#include <sys/socket.h>
+#include <fcntl.h>
+#ifndef O_NONBLOCK /* POSIX */
+#ifdef O_NDELAY /* BSD */
+#define O_NONBLOCK O_NDELAY
+#else
+#ifdef FNDELAY /* NeXT */
+#define O_NONBLOCK O_FNDELAY
+#else
+what the fcntl? cannot implement IPC without equivalent for O_NONBLOCK.
+#endif /* no FNDELAY */
+#endif /* no O_NDELAY */
+#endif /* no O_NONBLOCK */
+
+#ifndef IPC_PIPE_NAME /* $HOME is prepended to this. */
+#define IPC_PIPE_NAME "/.TeXview_Pipe"
+#endif
+#ifndef IPC_SERVER_CMD /* Command to run to start the server. */
+#define IPC_SERVER_CMD "open `which TeXview`"
+#endif
+
+struct msg
+{
+ short namelength; /* length of auxiliary data */
+ int eof; /* new eof for dvi file */
+#if 0 /* see usage of struct msg below */
+ char more_data[0]; /* where the rest of the stuff goes */
+#endif
+};
+
+static char *ipc_name;
+static struct sockaddr *ipc_addr;
+static int ipc_addr_len;
+
+static int
+ipc_make_name P1H(void)
+{
+ if (ipc_addr_len == 0) {
+ string s = getenv ("HOME");
+ if (s) {
+ ipc_addr = (struct sockaddr*)xmalloc (strlen (s) + 40);
+ ipc_addr->sa_family = 0;
+ ipc_name = ipc_addr->sa_data;
+ strcpy (ipc_name, s);
+ strcat (ipc_name, IPC_PIPE_NAME);
+ ipc_addr_len = strlen (ipc_name) + 3;
+ }
+ }
+ return ipc_addr_len;
+}
+
+
+static int sock = -1;
+
+static int
+ipc_is_open P1H(void)
+{
+ return sock >= 0;
+}
+
+
+static void
+ipc_open_out P1H(void) {
+#ifdef IPC_DEBUG
+ fputs ("tex: Opening socket for IPC output ...\n", stderr);
+#endif
+ if (sock >= 0) {
+ return;
+ }
+
+ if (ipc_make_name () < 0) {
+ sock = -1;
+ return;
+ }
+
+ sock = socket (PF_UNIX, SOCK_STREAM, 0);
+ if (sock >= 0) {
+ if (connect (sock, ipc_addr, ipc_addr_len) != 0
+ || fcntl (sock, F_SETFL, O_NONBLOCK) < 0) {
+ close (sock);
+ sock = -1;
+ return;
+ }
+#ifdef IPC_DEBUG
+ fputs ("tex: Successfully opened IPC socket.\n", stderr);
+#endif
+ }
+}
+
+
+static void
+ipc_close_out P1H(void)
+{
+#ifdef IPC_DEBUG
+ fputs ("tex: Closing output socket ...\n", stderr);
+#endif
+ if (ipc_is_open ()) {
+ close (sock);
+ sock = -1;
+ }
+}
+
+
+static void
+ipc_snd P3C(int, n, int, is_eof, char *, data)
+{
+ struct
+ {
+ struct msg msg;
+ char more_data[1024];
+ } ourmsg;
+
+#ifdef IPC_DEBUG
+ fputs ("tex: Sending message to socket ...\n", stderr);
+#endif
+ if (!ipc_is_open ()) {
+ return;
+ }
+
+ ourmsg.msg.namelength = n;
+ ourmsg.msg.eof = is_eof;
+ if (n) {
+ strcpy (ourmsg.more_data, data);
+ }
+ n += sizeof (struct msg);
+#ifdef IPC_DEBUG
+ fputs ("tex: Writing to socket...\n", stderr);
+#endif
+ if (write (sock, &ourmsg, n) != n) {
+ ipc_close_out ();
+ }
+#ifdef IPC_DEBUG
+ fputs ("tex: IPC message sent.\n", stderr);
+#endif
+}
+
+
+/* This routine notifies the server if there is an eof, or the filename
+ if a new DVI file is starting. This is the routine called by TeX.
+ Omega defines str_start(#) as str_start_ar[# - too_big_char], with
+ too_big_char = biggest_char + 1 = 65536 (omstr.ch).*/
+
+void
+ipcpage P1C(int, is_eof)
+{
+ static boolean begun = false;
+ unsigned len = 0;
+ unsigned i;
+ string p = "";
+
+ if (!begun) {
+ string name; /* Just the filename. */
+ string cwd = xgetcwd ();
+
+ ipc_open_out ();
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+ len = strstart[outputfilename + 1] - strstart[outputfilename];
+#else
+ len = strstartar[outputfilename + 1 - 65536L] -
+ strstartar[outputfilename - 65536L];
+#endif
+ name = (string)xmalloc (len + 1);
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+ strncpy (name, &strpool[strstart[outputfilename]], len);
+#else
+ for (i=0; i<len; i++)
+ name[i] = strpool[i+strstartar[outputfilename - 65536L]];
+#endif
+ name[len] = 0;
+
+ /* Have to pass whole filename to the other end, since it may have
+ been started up and running as a daemon, e.g., as with the NeXT
+ preview program. */
+ p = concat3 (cwd, DIR_SEP_STRING, name);
+ free (name);
+ len = strlen(p);
+ begun = true;
+ }
+ ipc_snd (len, is_eof, p);
+
+ if (len > 0) {
+ free (p);
+ }
+}
+#endif /* TeX && IPC */
+
+#if defined (TeX) || defined (MF) || defined (MP)
+ /* TCX and Omega get along like sparks and gunpowder. */
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+
+/* Return the next number following START, setting POST to the following
+ character, as in strtol. Issue a warning and return -1 if no number
+ can be parsed. */
+
+static int
+tcx_get_num P4C(int, upb,
+ unsigned, line_count,
+ string, start,
+ string *, post)
+{
+ int num = strtol (start, post, 0);
+ assert (post && *post);
+ if (*post == start) {
+ /* Could not get a number. If blank line, fine. Else complain. */
+ string p = start;
+ while (*p && ISSPACE (*p))
+ p++;
+ if (*p != 0)
+ fprintf (stderr, "%s:%d: Expected numeric constant, not `%s'.\n",
+ translate_filename, line_count, start);
+ num = -1;
+ } else if (num < 0 || num > upb) {
+ fprintf (stderr, "%s:%d: Destination charcode %d <0 or >%d.\n",
+ translate_filename, line_count, num, upb);
+ num = -1;
+ }
+
+ return num;
+}
+
+/* Update the xchr, xord, and xprn arrays for TeX, allowing a
+ translation table specified at runtime via an external file.
+ Look for the character translation file FNAME along the same path as
+ tex.pool. If no suffix in FNAME, use .tcx (don't bother trying to
+ support extension-less names for these files). */
+
+/* FIXME: A new format ought to be introduced for these files. */
+
+void
+readtcxfile P1H(void)
+{
+ string orig_filename;
+ if (!find_suffix (translate_filename)) {
+ translate_filename = concat (translate_filename, ".tcx");
+ }
+ orig_filename = translate_filename;
+ translate_filename
+ = kpse_find_file (translate_filename, kpse_web2c_format, true);
+ if (translate_filename) {
+ string line;
+ unsigned line_count = 0;
+ FILE *translate_file = xfopen (translate_filename, FOPEN_R_MODE);
+ while (line = read_line (translate_file)) {
+ int first;
+ string start2;
+ string comment_loc = strchr (line, '%');
+ if (comment_loc)
+ *comment_loc = 0;
+
+ line_count++;
+
+ first = tcx_get_num (255, line_count, line, &start2);
+ if (first >= 0) {
+ string start3;
+ int second;
+ int printable;
+
+ second = tcx_get_num (255, line_count, start2, &start3);
+ if (second >= 0) {
+ /* I suppose we could check for nonempty junk following the
+ "printable" code, but let's not bother. */
+ string extra;
+
+ /* If they mention a second code, make that the internal number. */
+ xord[first] = second;
+ xchr[second] = first;
+
+ printable = tcx_get_num (1, line_count, start3, &extra);
+ /* Not-a-number, may be a comment. */
+ if (printable == -1)
+ printable = 1;
+ /* Don't allow the 7bit ASCII set to become unprintable. */
+ if (32 <= second && second <= 126)
+ printable = 1;
+ } else {
+ second = first; /* else make internal the same as external */
+ /* If they mention a charcode, call it printable. */
+ printable = 1;
+ }
+
+ xprn[second] = printable;
+ }
+ free (line);
+ }
+ xfclose(translate_file, translate_filename);
+ } else {
+ WARNING1 ("Could not open char translation file `%s'", orig_filename);
+ }
+}
+#endif /* !Omega && !eOmega && !Aleph */
+#endif /* TeX || MF || MP [character translation] */
+
+/* Normalize quoting of filename -- that is, only quote if there is a space,
+ and always use the quote-name-quote style. */
+string
+normalize_quotes P2C(const_string, name, const_string, mesg)
+{
+ boolean quoted = false;
+ boolean must_quote = (strchr(name, ' ') != NULL);
+ /* Leave room for quotes and NUL. */
+ string ret = (string)xmalloc(strlen(name)+3);
+ string p;
+ const_string q;
+ p = ret;
+ if (must_quote)
+ *p++ = '"';
+ for (q = name; *q; q++) {
+ if (*q == '"')
+ quoted = !quoted;
+ else
+ *p++ = *q;
+ }
+ if (must_quote)
+ *p++ = '"';
+ *p = '\0';
+ if (quoted) {
+ fprintf(stderr, "! Unbalanced quotes in %s %s\n", mesg, name);
+ uexit(1);
+ }
+ return ret;
+}
+
+/* Getting the input filename. */
+string
+get_input_file_name P1H(void)
+{
+ string input_file_name = NULL;
+
+ if (argv[optind] && argv[optind][0] != '&' && argv[optind][0] != '\\') {
+ /* Not &format, not \input, so assume simple filename. */
+ string name = normalize_quotes(argv[optind], "argument");
+ boolean quoted = (name[0] == '"');
+ if (quoted) {
+ /* Overwrite last quote and skip first quote. */
+ name[strlen(name)-1] = '\0';
+ name++;
+ }
+ input_file_name = kpse_find_file(name, INPUT_FORMAT, false);
+ if (quoted) {
+ /* Undo modifications */
+ name[strlen(name)] = '"';
+ name--;
+ }
+ argv[optind] = name;
+ }
+ return input_file_name;
+}
+
+/* Reading the options. */
+
+/* Test whether getopt found an option ``A''.
+ Assumes the option index is in the variable `option_index', and the
+ option table in a variable `long_options'. */
+#define ARGUMENT_IS(a) STREQ (long_options[option_index].name, a)
+
+/* SunOS cc can't initialize automatic structs, so make this static. */
+static struct option long_options[]
+ = { { DUMP_OPTION, 1, 0, 0 },
+#ifdef TeX
+ /* FIXME: Obsolete -- for backward compatibility only. */
+ { "efmt", 1, 0, 0 },
+#endif
+ { "help", 0, 0, 0 },
+ { "ini", 0, &iniversion, 1 },
+ { "interaction", 1, 0, 0 },
+ { "halt-on-error", 0, &haltonerrorp, 1 },
+ { "kpathsea-debug", 1, 0, 0 },
+ { "progname", 1, 0, 0 },
+ { "version", 0, 0, 0 },
+ { "recorder", 0, &recorder_enabled, 1 },
+#ifdef TeX
+#ifdef IPC
+ { "ipc", 0, &ipcon, 1 },
+ { "ipc-start", 0, &ipcon, 2 },
+#endif /* IPC */
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+ { "mltex", 0, &mltexp, 1 },
+ { "enc", 0, &enctexp, 1 },
+#endif /* !Omega && !eOmega && !Aleph */
+#if defined (eTeX) || defined(pdfeTeX) || defined(Aleph)
+ { "etex", 0, &etexp, 1 },
+#endif /* eTeX || pdfeTeX || Aleph */
+ { "output-comment", 1, 0, 0 },
+ { "output-directory", 1, 0, 0 },
+#if defined(pdfTeX) || defined(pdfeTeX)
+ { "output-format", 1, 0, 0 },
+#endif /* pdfTeX or pdfeTeX */
+ { "shell-escape", 0, &shellenabledp, 1 },
+ { "no-shell-escape", 0, &shellenabledp, -1 },
+ { "debug-format", 0, &debugformatfile, 1 },
+ { "src-specials", 2, 0, 0 },
+#endif /* TeX */
+#if defined (TeX) || defined (MF) || defined (MP)
+ { "file-line-error-style", 0, &filelineerrorstylep, 1 },
+ { "no-file-line-error-style", 0, &filelineerrorstylep, -1 },
+ /* Shorter option names for the above. */
+ { "file-line-error", 0, &filelineerrorstylep, 1 },
+ { "no-file-line-error", 0, &filelineerrorstylep, -1 },
+ { "jobname", 1, 0, 0 },
+ { "parse-first-line", 0, &parsefirstlinep, 1 },
+ { "no-parse-first-line", 0, &parsefirstlinep, -1 },
+ { "translate-file", 1, 0, 0 },
+ { "default-translate-file", 1, 0, 0 },
+ { "8bit", 0, &eightbitp, 1 },
+#endif /* TeX || MF || MP */
+#if defined (TeX) || defined (MF)
+ { "mktex", 1, 0, 0 },
+ { "no-mktex", 1, 0, 0 },
+#endif /* TeX or MF */
+#ifdef MP
+ { "T", 0, &troffmode, 1 },
+ { "troff", 0, &troffmode, 1 },
+ { "tex", 1, 0, 0 },
+#endif /* MP */
+ { 0, 0, 0, 0 } };
+
+
+static void
+parse_options P2C(int, argc, string *, argv)
+{
+ int g; /* `getopt' return code. */
+ int option_index;
+
+ for (;;) {
+ g = getopt_long_only (argc, argv, "+", long_options, &option_index);
+
+ if (g == -1) /* End of arguments, exit the loop. */
+ break;
+
+ if (g == '?') { /* Unknown option. */
+ /* FIXME: usage (argv[0]); replaced by continue. */
+ continue;
+ }
+
+ assert (g == 0); /* We have no short option names. */
+
+ if (ARGUMENT_IS ("kpathsea-debug")) {
+ kpathsea_debug |= atoi (optarg);
+
+ } else if (ARGUMENT_IS ("progname")) {
+ user_progname = optarg;
+
+ } else if (ARGUMENT_IS ("jobname")) {
+ job_name = normalize_quotes(optarg, "jobname");
+
+ } else if (ARGUMENT_IS (DUMP_OPTION)) {
+ dump_name = optarg;
+ if (!user_progname) user_progname = optarg;
+ dumpoption = true;
+
+#ifdef TeX
+ /* FIXME: Obsolete -- for backward compatibility only. */
+ } else if (ARGUMENT_IS ("efmt")) {
+ dump_name = optarg;
+ if (!user_progname) user_progname = optarg;
+ dumpoption = true;
+#endif
+
+ } else if (ARGUMENT_IS ("output-directory")) {
+ output_directory = optarg;
+
+#ifdef TeX
+ } else if (ARGUMENT_IS ("output-comment")) {
+ unsigned len = strlen (optarg);
+ if (len < 256) {
+ outputcomment = optarg;
+ } else {
+ WARNING2 ("Comment truncated to 255 characters from %d. (%s)",
+ len, optarg);
+ outputcomment = (string)xmalloc (256);
+ strncpy (outputcomment, optarg, 255);
+ outputcomment[255] = 0;
+ }
+
+#ifdef IPC
+ } else if (ARGUMENT_IS ("ipc-start")) {
+ ipc_open_out ();
+ /* Try to start up the other end if it's not already. */
+ if (!ipc_is_open ()) {
+ if (system (IPC_SERVER_CMD) == 0) {
+ unsigned i;
+ for (i = 0; i < 20 && !ipc_is_open (); i++) {
+ sleep (2);
+ ipc_open_out ();
+ }
+ }
+ }
+#endif /* IPC */
+ } else if (ARGUMENT_IS ("src-specials")) {
+ last_source_name = xstrdup("");
+ /* Option `--src" without any value means `auto' mode. */
+ if (optarg == NULL) {
+ insertsrcspecialeverypar = true;
+ insertsrcspecialauto = true;
+ srcspecialsoption = true;
+ srcspecialsp = true;
+ } else {
+ parse_src_specials_option(optarg);
+ }
+#endif /* TeX */
+#if defined(pdfTeX) || defined(pdfeTeX)
+ } else if (ARGUMENT_IS ("output-format")) {
+ pdfoutputoption = 1;
+ if (strcmp(optarg, "dvi") == 0) {
+ pdfoutputvalue = 0;
+ } else if (strcmp(optarg, "pdf") == 0) {
+ pdfoutputvalue = 2;
+ } else {
+ WARNING1 ("Ignoring unknown value `%s' for --output-format", optarg);
+ pdfoutputoption = 0;
+ }
+#endif /* pdfTeX || pdfeTeX */
+#if defined (TeX) || defined (MF) || defined (MP)
+ } else if (ARGUMENT_IS ("translate-file")) {
+ translate_filename = optarg;
+ } else if (ARGUMENT_IS ("default-translate-file")) {
+ default_translate_filename = optarg;
+#if defined(Omega) || defined(eOmega) || defined(Aleph)
+ } else if (ARGUMENT_IS ("8bit")) {
+ /* FIXME: print snippy message? Possibly also for above? */
+#endif /* !Omega && !eOmega && !Aleph */
+#endif /* TeX || MF || MP */
+
+#if defined (TeX) || defined (MF)
+ } else if (ARGUMENT_IS ("mktex")) {
+ kpse_maketex_option (optarg, true);
+
+ } else if (ARGUMENT_IS ("no-mktex")) {
+ kpse_maketex_option (optarg, false);
+#endif /* TeX or MF */
+#if defined (MP)
+ } else if (ARGUMENT_IS ("tex")) {
+ mpost_tex_program = optarg;
+#endif /* MP */
+ } else if (ARGUMENT_IS ("interaction")) {
+ /* These numbers match @d's in *.ch */
+ if (STREQ (optarg, "batchmode")) {
+ interactionoption = 0;
+ } else if (STREQ (optarg, "nonstopmode")) {
+ interactionoption = 1;
+ } else if (STREQ (optarg, "scrollmode")) {
+ interactionoption = 2;
+ } else if (STREQ (optarg, "errorstopmode")) {
+ interactionoption = 3;
+ } else {
+ WARNING1 ("Ignoring unknown argument `%s' to --interaction", optarg);
+ }
+
+ } else if (ARGUMENT_IS ("help")) {
+ usagehelp (PROGRAM_HELP, BUG_ADDRESS);
+
+ } else if (ARGUMENT_IS ("version")) {
+ printversionandexit (BANNER, COPYRIGHT_HOLDER, AUTHOR);
+
+ } /* Else it was a flag; getopt has already done the assignment. */
+ }
+}
+
+#if defined(TeX)
+void
+parse_src_specials_option P1C(const_string, opt_list)
+{
+ char * toklist = xstrdup(opt_list);
+ char * tok;
+ insertsrcspecialauto = false;
+ tok = strtok (toklist, ", ");
+ while (tok) {
+ if (strcmp (tok, "everypar") == 0
+ || strcmp (tok, "par") == 0
+ || strcmp (tok, "auto") == 0) {
+ insertsrcspecialauto = true;
+ insertsrcspecialeverypar = true;
+ } else if (strcmp (tok, "everyparend") == 0
+ || strcmp (tok, "parend") == 0)
+ insertsrcspecialeveryparend = true;
+ else if (strcmp (tok, "everycr") == 0
+ || strcmp (tok, "cr") == 0)
+ insertsrcspecialeverycr = true;
+ else if (strcmp (tok, "everymath") == 0
+ || strcmp (tok, "math") == 0)
+ insertsrcspecialeverymath = true;
+ else if (strcmp (tok, "everyhbox") == 0
+ || strcmp (tok, "hbox") == 0)
+ insertsrcspecialeveryhbox = true;
+ else if (strcmp (tok, "everyvbox") == 0
+ || strcmp (tok, "vbox") == 0)
+ insertsrcspecialeveryvbox = true;
+ else if (strcmp (tok, "everydisplay") == 0
+ || strcmp (tok, "display") == 0)
+ insertsrcspecialeverydisplay = true;
+ else if (strcmp (tok, "none") == 0) {
+ /* This one allows to reset an option that could appear in texmf.cnf */
+ insertsrcspecialauto = insertsrcspecialeverypar =
+ insertsrcspecialeveryparend = insertsrcspecialeverycr =
+ insertsrcspecialeverymath = insertsrcspecialeveryhbox =
+ insertsrcspecialeveryvbox = insertsrcspecialeverydisplay = false;
+ } else {
+ WARNING1 ("Ignoring unknown argument `%s' to --src-specials", tok);
+ }
+ tok = strtok(0, ", ");
+ }
+ free(toklist);
+ srcspecialsp=insertsrcspecialauto | insertsrcspecialeverypar |
+ insertsrcspecialeveryparend | insertsrcspecialeverycr |
+ insertsrcspecialeverymath | insertsrcspecialeveryhbox |
+ insertsrcspecialeveryvbox | insertsrcspecialeverydisplay;
+ srcspecialsoption = true;
+}
+#endif
+
+/* If the first thing on the command line (we use the globals `argv' and
+ `optind') is a normal filename (i.e., does not start with `&' or
+ `\'), and if we can open it, and if its first line is %&FORMAT, and
+ FORMAT is a readable dump file, then set DUMP_VAR to FORMAT.
+ Also call kpse_reset_program_name to ensure the correct paths for the
+ format are used. */
+static void
+parse_first_line P1C(const_string, filename)
+{
+ FILE *f = filename ? fopen (filename, FOPEN_R_MODE) : NULL;
+ if (f) {
+ string first_line = read_line (f);
+ xfclose (f, filename);
+
+ /* We deal with the general format "%&fmt --translate-file=tcx" */
+ /* The idea of using this format came from Wlodzimierz Bzyl
+ <matwb@monika.univ.gda.pl> */
+ if (first_line && first_line[0] == '%' && first_line[1] == '&') {
+ /* Parse the first line into at most three space-separated parts. */
+ char *s;
+ char *part[4];
+ int npart;
+ char **parse;
+
+ for (s = first_line+2; ISBLANK(*s); ++s)
+ ;
+ npart = 0;
+ while (*s && npart != 3) {
+ part[npart++] = s;
+ while (*s && *s != ' ') s++;
+ while (*s == ' ') *s++ = '\0';
+ }
+ part[npart] = NULL;
+ parse = part;
+ /* Look at what we've got. Very crude! */
+ if (*parse && **parse != '-') {
+ /* A format name */
+ if (dump_name) {
+ /* format already determined, do nothing. */
+ } else {
+ string f_name = concat (part[0], DUMP_EXT);
+ string d_name = kpse_find_file (f_name, DUMP_FORMAT, false);
+ if (d_name && kpse_readable_file (d_name)) {
+ dump_name = xstrdup (part[0]);
+ kpse_reset_program_name (dump_name);
+ /* Tell TeX/MF/MP we have a %&name line... */
+ dumpline = true;
+ }
+ free (f_name);
+ }
+ parse++;
+ }
+ /* The tcx stuff, if any. Should we support the -translate-file
+ form as well as --translate-file? */
+ if (*parse) {
+ if (translate_filename) {
+ /* TCX file already set, do nothing. */
+ } else if (STREQ (*parse, "--translate-file")) {
+ s = *(parse+1);
+ } else if (STREQ (*parse, "-translate-file")) {
+ s = *(parse+1);
+ } else if (STRNEQ (*parse, "--translate-file=", 17)) {
+ s = *parse+17;
+ } else if (STRNEQ (*parse, "-translate-file=", 16)) {
+ s = *parse+16;
+ }
+ /* Just set the name, no sanity checks here. */
+ /* FIXME: remove trailing spaces. */
+ if (s && *s) {
+ translate_filename = xstrdup(s);
+ }
+ }
+ }
+ if (first_line)
+ free (first_line);
+ }
+}
+
+/* Return true if FNAME is acceptable as a name for \openout, \openin, or
+ \input. */
+
+typedef enum ok_type {
+ ok_reading,
+ ok_writing
+} ok_type;
+
+static const_string ok_type_name[] = {
+ "reading",
+ "writing"
+};
+
+static boolean
+opennameok P4C(const_string, fname, const_string, check_var,
+ const_string, default_choice, ok_type, action)
+{
+ /* We distinguish three cases:
+ 'a' (any) allows any file to be opened.
+ 'r' (restricted) means disallowing special file names.
+ 'p' (paranoid) means being really paranoid: disallowing special file
+ names and restricting output files to be in or below
+ the working directory or $TEXMFOUTPUT, while input files
+ must be below the current directory, $TEXMFOUTPUT, or
+ (implicitly) in the system areas.
+ We default to "paranoid". The error messages from TeX will be somewhat
+ puzzling...
+ This function contains several return statements... */
+
+ const_string open_choice = kpse_var_value (check_var);
+
+ if (!open_choice) open_choice = default_choice;
+
+ if (*open_choice == 'a' || *open_choice == 'y' || *open_choice == '1')
+ return true;
+
+#if defined (unix) && !defined (MSDOS)
+ {
+ const_string base = xbasename (fname);
+ /* Disallow .rhosts, .login, etc. Allow .tex (for LaTeX). */
+ if (base[0] == 0 ||
+ (base[0] == '.' && !IS_DIR_SEP(base[1]) && !STREQ (base, ".tex"))) {
+ fprintf(stderr, "%s: Not %s to %s (%s = %s).\n",
+ program_invocation_name, ok_type_name[action], fname,
+ check_var, open_choice);
+ return false;
+ }
+ }
+#else
+ /* Other OSs don't have special names? */
+#endif
+
+ if (*open_choice == 'r' || *open_choice == 'n' || *open_choice == '0')
+ return true;
+
+ /* Paranoia supplied by Charles Karney... */
+ if (kpse_absolute_p (fname, false)) {
+ const_string texmfoutput = kpse_var_value ("TEXMFOUTPUT");
+ /* Absolute pathname is only OK if TEXMFOUTPUT is set, it's not empty,
+ fname begins the TEXMFOUTPUT, and is followed by / */
+ if (!texmfoutput || *texmfoutput == '\0'
+ || fname != strstr (fname, texmfoutput)
+ || !IS_DIR_SEP(fname[strlen(texmfoutput)])) {
+ fprintf(stderr, "%s: Not %s to %s (%s = %s).\n",
+ program_invocation_name, ok_type_name[action], fname,
+ check_var, open_choice);
+ return false;
+ }
+ }
+ /* For all pathnames, we disallow "../" at the beginning or "/../"
+ anywhere. */
+ if (fname[0] == '.' && fname[1] == '.' && IS_DIR_SEP(fname[2])) {
+ fprintf(stderr, "%s: Not %s to %s (%s = %s).\n",
+ program_invocation_name, ok_type_name[action], fname,
+ check_var, open_choice);
+ return false;
+ } else {
+ /* Check for "/../". Since more than one characted can be matched
+ by IS_DIR_SEP, we cannot use "/../" itself. */
+ const_string dotpair = strstr(fname, "..");
+ while (dotpair) {
+ /* If dotpair[2] == DIR_SEP, then dotpair[-1] is well-defined,
+ because the "../" case was handled above. */
+ if (IS_DIR_SEP(dotpair[2]) && IS_DIR_SEP(dotpair[-1])) {
+ fprintf(stderr, "%s: Not %s to %s (%s = %s).\n",
+ program_invocation_name, ok_type_name[action], fname,
+ check_var, open_choice);
+ return false;
+ }
+ /* Continue after the dotpair. */
+ dotpair = strstr(dotpair+2, "..");
+ }
+ }
+
+ /* We passed all tests. */
+ return true;
+}
+
+boolean openinnameok P1C(const_string, fname)
+{
+ /* For input default to all. */
+ return opennameok (fname, "openin_any", "a", ok_reading);
+}
+
+boolean openoutnameok P1C(const_string, fname)
+{
+ /* For output, default to paranoid. */
+ return opennameok (fname, "openout_any", "p", ok_writing);
+}
+
+/* All our interrupt handler has to do is set TeX's or Metafont's global
+ variable `interrupt'; then they will do everything needed. */
+#ifdef WIN32
+/* Win32 doesn't set SIGINT ... */
+BOOL WINAPI
+catch_interrupt (DWORD arg)
+{
+ switch (arg) {
+ case CTRL_C_EVENT:
+ case CTRL_BREAK_EVENT:
+ interrupt = 1;
+ return TRUE;
+ default:
+ /* No need to set interrupt as we are exiting anyway */
+ return FALSE;
+ }
+}
+#else /* not WIN32 */
+static RETSIGTYPE
+catch_interrupt P1C (int, arg)
+{
+ interrupt = 1;
+#ifdef OS2
+ (void) signal (SIGINT, SIG_ACK);
+#else
+ (void) signal (SIGINT, catch_interrupt);
+#endif /* not OS2 */
+}
+#endif /* not WIN32 */
+
+/* Besides getting the date and time here, we also set up the interrupt
+ handler, for no particularly good reason. It's just that since the
+ `fix_date_and_time' routine is called early on (section 1337 in TeX,
+ ``Get the first line of input and prepare to start''), this is as
+ good a place as any. */
+
+void
+get_date_and_time P4C(integer *, minutes, integer *, day,
+ integer *, month, integer *, year)
+{
+ time_t clock = time ((time_t *) 0);
+ struct tm *tmptr = localtime (&clock);
+
+ *minutes = tmptr->tm_hour * 60 + tmptr->tm_min;
+ *day = tmptr->tm_mday;
+ *month = tmptr->tm_mon + 1;
+ *year = tmptr->tm_year + 1900;
+
+ {
+#ifdef SA_INTERRUPT
+ /* Under SunOS 4.1.x, the default action after return from the
+ signal handler is to restart the I/O if nothing has been
+ transferred. The effect on TeX is that interrupts are ignored if
+ we are waiting for input. The following tells the system to
+ return EINTR from read() in this case. From ken@cs.toronto.edu. */
+
+ struct sigaction a, oa;
+
+ a.sa_handler = catch_interrupt;
+ sigemptyset (&a.sa_mask);
+ sigaddset (&a.sa_mask, SIGINT);
+ a.sa_flags = SA_INTERRUPT;
+ sigaction (SIGINT, &a, &oa);
+ if (oa.sa_handler != SIG_DFL)
+ sigaction (SIGINT, &oa, (struct sigaction *) 0);
+#else /* no SA_INTERRUPT */
+#ifdef WIN32
+ SetConsoleCtrlHandler(catch_interrupt, TRUE);
+#else /* not WIN32 */
+ RETSIGTYPE (*old_handler) P1H(int);
+
+ old_handler = signal (SIGINT, catch_interrupt);
+ if (old_handler != SIG_DFL)
+ signal (SIGINT, old_handler);
+#endif /* not WIN32 */
+#endif /* no SA_INTERRUPT */
+ }
+}
+
+/*
+ Getting a high resolution time.
+ */
+void
+get_seconds_and_micros P2C(integer *, seconds, integer *, micros)
+{
+#if defined (HAVE_GETTIMEOFDAY)
+ struct timeval tv;
+ gettimeofday(&tv, NULL);
+ *seconds = tv.tv_sec;
+ *micros = tv.tv_usec;
+#elif defined (HAVE_FTIME)
+ struct timeb tb;
+ ftime(&tb);
+ *seconds = tb.time;
+ *micros = tb.millitm*1000;
+#else
+ time_t clock = time((time_t*)NULL);
+ *seconds = clock;
+ *micros = 0;
+#endif
+}
+
+/*
+ Generating a better seed numbers
+ */
+integer
+getrandomseed()
+{
+#if defined (HAVE_GETTIMEOFDAY)
+ struct timeval tv;
+ gettimeofday(&tv, NULL);
+ return (tv.tv_usec + 1000000 * tv.tv_usec);
+#elif defined (HAVE_FTIME)
+ struct timeb tb;
+ ftime(&tb);
+ return (tb.millitm + 1000 * tb.time);
+#else
+ time_t clock = time ((time_t*)NULL);
+ struct tm *tmptr = localtime(&clock);
+ return (tmptr->tm_sec + 60*(tmptr->tm_min + 60*tmptr->tm_hour));
+#endif
+}
+
+/* Read a line of input as efficiently as possible while still looking
+ like Pascal. We set `last' to `first' and return `false' if we get
+ to eof. Otherwise, we return `true' and set last = first +
+ length(line except trailing whitespace). */
+
+boolean
+input_line P1C(FILE *, f)
+{
+ int i;
+
+ /* Recognize either LF or CR as a line terminator. */
+ last = first;
+ while (last < bufsize && (i = getc (f)) != EOF && i != '\n' && i != '\r')
+ buffer[last++] = i;
+
+ if (i == EOF && errno != EINTR && last == first)
+ return false;
+
+ /* We didn't get the whole line because our buffer was too small. */
+ if (i != EOF && i != '\n' && i != '\r') {
+ fprintf (stderr, "! Unable to read an entire line---bufsize=%u.\n",
+ (unsigned) bufsize);
+ fputs ("Please increase buf_size in texmf.cnf.\n", stderr);
+ uexit (1);
+ }
+
+ buffer[last] = ' ';
+ if (last >= maxbufstack)
+ maxbufstack = last;
+
+ /* If next char is LF of a CRLF, read it. */
+ if (i == '\r') {
+ while ((i = getc (f)) == EOF && errno == EINTR)
+ ;
+ if (i != '\n')
+ ungetc (i, f);
+ }
+
+ /* Trim trailing whitespace. */
+ while (last > first && ISBLANK (buffer[last - 1]))
+ --last;
+
+ /* Don't bother using xord if we don't need to. */
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+ for (i = first; i <= last; i++)
+ buffer[i] = xord[buffer[i]];
+#endif
+
+ return true;
+}
+
+/* This string specifies what the `e' option does in response to an
+ error message. */
+static char *edit_value = EDITOR;
+
+/* This procedure originally due to sjc@s1-c. TeX & Metafont call it when
+ the user types `e' in response to an error, invoking a text editor on
+ the erroneous source file. FNSTART is how far into FILENAME the
+ actual filename starts; FNLENGTH is how long the filename is. */
+
+void
+calledit P4C(packedASCIIcode *, filename,
+ poolpointer, fnstart,
+ integer, fnlength,
+ integer, linenumber)
+{
+ char *temp, *command;
+ char c;
+ int sdone, ddone, i;
+
+ sdone = ddone = 0;
+ filename += fnstart;
+
+ /* Close any open input files, since we're going to kill the job. */
+ for (i = 1; i <= inopen; i++)
+ xfclose (inputfile[i], "inputfile");
+
+ /* Replace the default with the value of the appropriate environment
+ variable or config file value, if it's set. */
+ temp = kpse_var_value (edit_var);
+ if (temp != NULL)
+ edit_value = temp;
+
+ /* Construct the command string. The `11' is the maximum length an
+ integer might be. */
+ command = (string) xmalloc (strlen (edit_value) + fnlength + 11);
+
+ /* So we can construct it as we go. */
+ temp = command;
+
+ while ((c = *edit_value++) != 0)
+ {
+ if (c == '%')
+ {
+ switch (c = *edit_value++)
+ {
+ case 'd':
+ if (ddone)
+ FATAL ("call_edit: `%%d' appears twice in editor command");
+ sprintf (temp, "%ld", linenumber);
+ while (*temp != '\0')
+ temp++;
+ ddone = 1;
+ break;
+
+ case 's':
+ if (sdone)
+ FATAL ("call_edit: `%%s' appears twice in editor command");
+ for (i =0; i < fnlength; i++)
+ *temp++ = Xchr (filename[i]);
+ sdone = 1;
+ break;
+
+ case '\0':
+ *temp++ = '%';
+ /* Back up to the null to force termination. */
+ edit_value--;
+ break;
+
+ default:
+ *temp++ = '%';
+ *temp++ = c;
+ break;
+ }
+ }
+ else
+ *temp++ = c;
+ }
+
+ *temp = 0;
+
+ /* Execute the command. */
+#ifdef WIN32
+ /* Win32 reimplementation of the system() command
+ provides opportunity to call it asynchronously */
+ if (win32_system(command, true) != 0 )
+#else
+ if (system (command) != 0)
+#endif
+ fprintf (stderr, "! Trouble executing `%s'.\n", command);
+
+ /* Quit, since we found an error. */
+ uexit (1);
+}
+
+/* Read and write dump files. As distributed, these files are
+ architecture dependent; specifically, BigEndian and LittleEndian
+ architectures produce different files. These routines always output
+ BigEndian files. This still does not guarantee them to be
+ architecture-independent, because it is possible to make a format
+ that dumps a glue ratio, i.e., a floating-point number. Fortunately,
+ none of the standard formats do that. */
+
+#if !defined (WORDS_BIGENDIAN) && !defined (NO_DUMP_SHARE) /* this fn */
+
+/* This macro is always invoked as a statement. It assumes a variable
+ `temp'. */
+
+#define SWAP(x, y) temp = (x); (x) = (y); (y) = temp
+
+
+/* Make the NITEMS items pointed at by P, each of size SIZE, be the
+ opposite-endianness of whatever they are now. */
+
+static void
+swap_items P3C(char *, p, int, nitems, int, size)
+{
+ char temp;
+
+ /* Since `size' does not change, we can write a while loop for each
+ case, and avoid testing `size' for each time. */
+ switch (size)
+ {
+ /* 16-byte items happen on the DEC Alpha machine when we are not
+ doing sharable memory dumps. */
+ case 16:
+ while (nitems--)
+ {
+ SWAP (p[0], p[15]);
+ SWAP (p[1], p[14]);
+ SWAP (p[2], p[13]);
+ SWAP (p[3], p[12]);
+ SWAP (p[4], p[11]);
+ SWAP (p[5], p[10]);
+ SWAP (p[6], p[9]);
+ SWAP (p[7], p[8]);
+ p += size;
+ }
+ break;
+
+ case 8:
+ while (nitems--)
+ {
+ SWAP (p[0], p[7]);
+ SWAP (p[1], p[6]);
+ SWAP (p[2], p[5]);
+ SWAP (p[3], p[4]);
+ p += size;
+ }
+ break;
+
+ case 4:
+ while (nitems--)
+ {
+ SWAP (p[0], p[3]);
+ SWAP (p[1], p[2]);
+ p += size;
+ }
+ break;
+
+ case 2:
+ while (nitems--)
+ {
+ SWAP (p[0], p[1]);
+ p += size;
+ }
+ break;
+
+ case 1:
+ /* Nothing to do. */
+ break;
+
+ default:
+ FATAL1 ("Can't swap a %d-byte item for (un)dumping", size);
+ }
+}
+#endif /* not WORDS_BIGENDIAN and not NO_DUMP_SHARE */
+
+
+/* Here we write NITEMS items, each item being ITEM_SIZE bytes long.
+ The pointer to the stuff to write is P, and we write to the file
+ OUT_FILE. */
+
+void
+do_dump P4C(char *, p, int, item_size, int, nitems, FILE *, out_file)
+{
+#if !defined (WORDS_BIGENDIAN) && !defined (NO_DUMP_SHARE)
+ swap_items (p, nitems, item_size);
+#endif
+
+ if (fwrite (p, item_size, nitems, out_file) != nitems)
+ {
+ fprintf (stderr, "! Could not write %d %d-byte item(s).\n",
+ nitems, item_size);
+ uexit (1);
+ }
+
+ /* Have to restore the old contents of memory, since some of it might
+ get used again. */
+#if !defined (WORDS_BIGENDIAN) && !defined (NO_DUMP_SHARE)
+ swap_items (p, nitems, item_size);
+#endif
+}
+
+
+/* Here is the dual of the writing routine. */
+
+void
+do_undump P4C(char *, p, int, item_size, int, nitems, FILE *, in_file)
+{
+ if (fread (p, item_size, nitems, in_file) != nitems)
+ FATAL2 ("Could not undump %d %d-byte item(s)", nitems, item_size);
+
+#if !defined (WORDS_BIGENDIAN) && !defined (NO_DUMP_SHARE)
+ swap_items (p, nitems, item_size);
+#endif
+}
+
+/* Look up VAR_NAME in texmf.cnf; assign either the value found there or
+ DFLT to *VAR. */
+
+void
+setupboundvariable P3C(integer *, var, const_string, var_name, integer, dflt)
+{
+ string expansion = kpse_var_value (var_name);
+ *var = dflt;
+
+ if (expansion) {
+ integer conf_val = atoi (expansion);
+ /* It's ok if the cnf file specifies 0 for extra_mem_{top,bot}, etc.
+ But negative numbers are always wrong. */
+ if (conf_val < 0 || (conf_val == 0 && dflt > 0)) {
+ fprintf (stderr,
+ "%s: Bad value (%ld) in texmf.cnf for %s, keeping %ld.\n",
+ program_invocation_name,
+ (long) conf_val, var_name + 1, (long) dflt);
+ } else {
+ *var = conf_val; /* We'll make further checks later. */
+ }
+ free (expansion);
+ }
+}
+
+/* FIXME -- some (most?) of this can/should be moved to the Pascal/WEB side. */
+#if defined(TeX) || defined(MP) || defined(MF)
+static void
+checkpoolpointer (poolpointer poolptr, size_t len)
+{
+ if (poolptr + len >= poolsize) {
+ fprintf (stderr, "\nstring pool overflow [%i bytes]\n",
+ (int)poolsize); /* fixme */
+ exit(1);
+ }
+}
+
+#if !defined(pdfTeX) && !defined(pdfeTeX)
+static int
+maketexstring(const_string s)
+{
+ size_t len;
+ assert (s != 0);
+ len = strlen(s);
+ checkpoolpointer (poolptr, len);
+ while (len-- > 0)
+ strpool[poolptr++] = *s++;
+ return (makestring());
+}
+#endif
+
+strnumber
+makefullnamestring()
+{
+ return maketexstring(fullnameoffile);
+}
+
+/* Get the job name to be used, which may have been set from the
+ command line. */
+strnumber
+getjobname(strnumber name)
+{
+ strnumber ret = name;
+ if (job_name != NULL)
+ ret = maketexstring(job_name);
+ return ret;
+}
+#endif
+
+#if defined(TeX)
+int
+compare_paths P2C(const_string, p1, const_string, p2)
+{
+ int ret;
+ while (
+#ifdef MONOCASE_FILENAMES
+ (((ret = (toupper(*p1) - toupper(*p2))) == 0) && (*p2 != 0))
+#else
+ (((ret = (*p1 - *p2)) == 0) && (*p2 != 0))
+#endif
+ || (IS_DIR_SEP(*p1) && IS_DIR_SEP(*p2))) {
+ p1++, p2++;
+ }
+ ret = (ret < 0 ? -1 : (ret > 0 ? 1 : 0));
+ return ret;
+}
+
+string
+gettexstring P1C(strnumber, s)
+{
+ poolpointer i, len;
+ string name;
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+ len = strstart[s + 1] - strstart[s];
+#else
+ len = strstartar[s + 1 - 65536L] - strstartar[s - 65536L];
+#endif
+ name = (string)xmalloc (len + 1);
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+ strncpy (name, (string)&strpool[strstart[s]], len);
+#else
+ /* Don't use strncpy. The strpool is not made up of chars. */
+ for (i=0; i<len; i++) name[i] = strpool[i+strstartar[s - 65536L]];
+#endif
+ name[len] = 0;
+ return name;
+}
+
+boolean
+isnewsource P2C(strnumber, srcfilename, int, lineno)
+{
+ char *name = gettexstring(srcfilename);
+ return (compare_paths(name, last_source_name) != 0 || lineno != last_lineno);
+}
+
+void
+remembersourceinfo P2C(strnumber, srcfilename,
+ int, lineno)
+{
+ if (last_source_name)
+ free(last_source_name);
+ last_source_name = gettexstring(srcfilename);
+ last_lineno = lineno;
+}
+
+poolpointer
+makesrcspecial P2C(strnumber, srcfilename,
+ int, lineno)
+{
+ poolpointer oldpoolptr = poolptr;
+ char *filename = gettexstring(srcfilename);
+ /* FIXME: Magic number. */
+ char buf[40];
+ size_t len = strlen(filename);
+ char * s = buf;
+
+ /* Always put a space after the number, which makes things easier
+ * to parse.
+ */
+ sprintf (buf, "src:%d ", lineno);
+
+ if (poolptr + strlen(buf) + strlen(filename) >= poolsize) {
+ fprintf (stderr, "\nstring pool overflow\n"); /* fixme */
+ exit (1);
+ }
+ s = buf;
+ while (*s)
+ strpool[poolptr++] = *s++;
+
+ s = filename;
+ while (*s)
+ strpool[poolptr++] = *s++;
+
+ return (oldpoolptr);
+}
+#endif
+
+#ifdef MP
+/* Invoke makempx (or troffmpx) to make sure there is an up-to-date
+ .mpx file for a given .mp file. (Original from John Hobby 3/14/90) */
+
+#include <kpathsea/concatn.h>
+
+#ifndef MPXCOMMAND
+#define MPXCOMMAND "makempx"
+#endif
+
+boolean
+callmakempx P2C(string, mpname, string, mpxname)
+{
+ int ret;
+ string cnf_cmd = kpse_var_value ("MPXCOMMAND");
+
+ if (cnf_cmd && STREQ (cnf_cmd, "0")) {
+ /* If they turned off this feature, just return success. */
+ ret = 0;
+
+ } else {
+ /* We will invoke something. Compile-time default if nothing else. */
+ string cmd;
+ string qmpname = normalize_quotes(mpname, "mpname");
+ string qmpxname = normalize_quotes(mpxname, "mpxname");
+ if (!cnf_cmd)
+ cnf_cmd = xstrdup (MPXCOMMAND);
+
+ if (troffmode)
+ cmd = concatn (cnf_cmd, " -troff ",
+ qmpname, " ", qmpxname, NULL);
+ else if (mpost_tex_program && *mpost_tex_program)
+ cmd = concatn (cnf_cmd, " -tex=", mpost_tex_program, " ",
+ qmpname, " ", qmpxname, NULL);
+ else
+ cmd = concatn (cnf_cmd, " -tex ", qmpname, " ", qmpxname, NULL);
+
+ /* Run it. */
+ ret = system (cmd);
+ free (cmd);
+ free (qmpname);
+ free (qmpxname);
+ }
+
+ free (cnf_cmd);
+ return ret == 0;
+}
+#endif /* MP */
+
+/* Metafont/MetaPost fraction routines. Replaced either by assembler or C.
+ The assembler syntax doesn't work on Solaris/x86. */
+#ifndef TeX
+#if defined (__sun__) || defined (__cplusplus)
+#define NO_MF_ASM
+#endif
+#if defined(WIN32) && !defined(NO_MF_ASM)
+#include "lib/mfmpw32.c"
+#elif defined (__i386__) && defined (__GNUC__) && !defined (NO_MF_ASM)
+#include "lib/mfmpi386.asm"
+#else
+/* Replace fixed-point fraction routines from mf.web and mp.web with
+ Hobby's floating-point C code. */
+
+/****************************************************************
+Copyright 1990 - 1995 by AT&T Bell Laboratories.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T Bell Laboratories or
+any of its entities not be used in advertising or publicity
+pertaining to distribution of the software without specific,
+written prior permission.
+
+AT&T disclaims all warranties with regard to this software,
+including all implied warranties of merchantability and fitness.
+In no event shall AT&T be liable for any special, indirect or
+consequential damages or any damages whatsoever resulting from
+loss of use, data or profits, whether in an action of contract,
+negligence or other tortious action, arising out of or in
+connection with the use or performance of this software.
+****************************************************************/
+
+/**********************************************************
+ The following is by John Hobby
+ **********************************************************/
+
+#ifndef FIXPT
+
+/* These replacements for takefraction, makefraction, takescaled, makescaled
+ run about 3 to 11 times faster than the standard versions on modern machines
+ that have fast hardware for double-precision floating point. They should
+ produce approximately correct results on all machines and agree exactly
+ with the standard versions on machines that satisfy the following conditions:
+ 1. Doubles must have at least 46 mantissa bits; i.e., numbers expressible
+ as n*2^k with abs(n)<2^46 should be representable.
+ 2. The following should hold for addition, subtraction, and multiplcation but
+ not necessarily for division:
+ A. If the true answer is between two representable numbers, the computed
+ answer must be one of them.
+ B. When the true answer is representable, this must be the computed result.
+ 3. Dividing one double by another should always produce a relative error of
+ at most one part in 2^46. (This is why the mantissa requirement is
+ 46 bits instead of 45 bits.)
+ 3. In the absence of overflow, double-to-integer conversion should truncate
+ toward zero and do this in an exact fashion.
+ 4. Integer-to-double convesion should produce exact results.
+ 5. Dividing one power of two by another should yield an exact result.
+ 6. ASCII to double conversion should be exact for integer values.
+ 7. Integer arithmetic must be done in the two's-complement system.
+*/
+#define ELGORDO 0x7fffffff
+#define TWEXP31 2147483648.0
+#define TWEXP28 268435456.0
+#define TWEXP16 65536.0
+#define TWEXP_16 (1.0/65536.0)
+#define TWEXP_28 (1.0/268435456.0)
+
+integer
+ztakefraction P2C(integer, p, integer, q) /* Approximate p*q/2^28 */
+{ register double d;
+ register integer i;
+ d = (double)p * (double)q * TWEXP_28;
+ if ((p^q) >= 0) {
+ d += 0.5;
+ if (d>=TWEXP31) {
+ if (d!=TWEXP31 || (((p&077777)*(q&077777))&040000)==0)
+ aritherror = true;
+ return ELGORDO;
+ }
+ i = (integer) d;
+ if (d==i && (((p&077777)*(q&077777))&040000)!=0) --i;
+ } else {
+ d -= 0.5;
+ if (d<= -TWEXP31) {
+ if (d!= -TWEXP31 || ((-(p&077777)*(q&077777))&040000)==0)
+ aritherror = true;
+ return -ELGORDO;
+ }
+ i = (integer) d;
+ if (d==i && ((-(p&077777)*(q&077777))&040000)!=0) ++i;
+ }
+ return i;
+}
+
+integer
+ztakescaled P2C(integer, p, integer, q) /* Approximate p*q/2^16 */
+{ register double d;
+ register integer i;
+ d = (double)p * (double)q * TWEXP_16;
+ if ((p^q) >= 0) {
+ d += 0.5;
+ if (d>=TWEXP31) {
+ if (d!=TWEXP31 || (((p&077777)*(q&077777))&040000)==0)
+ aritherror = true;
+ return ELGORDO;
+ }
+ i = (integer) d;
+ if (d==i && (((p&077777)*(q&077777))&040000)!=0) --i;
+ } else {
+ d -= 0.5;
+ if (d<= -TWEXP31) {
+ if (d!= -TWEXP31 || ((-(p&077777)*(q&077777))&040000)==0)
+ aritherror = true;
+ return -ELGORDO;
+ }
+ i = (integer) d;
+ if (d==i && ((-(p&077777)*(q&077777))&040000)!=0) ++i;
+ }
+ return i;
+}
+
+/* Note that d cannot exactly equal TWEXP31 when the overflow test is made
+ because the exact value of p/q cannot be strictly between (2^31-1)/2^28
+ and 8/1. No pair of integers less than 2^31 has such a ratio.
+*/
+integer
+zmakefraction P2C(integer, p, integer, q) /* Approximate 2^28*p/q */
+{ register double d;
+ register integer i;
+#ifdef DEBUG
+ if (q==0) confusion(47);
+#endif /* DEBUG */
+ d = TWEXP28 * (double)p /(double)q;
+ if ((p^q) >= 0) {
+ d += 0.5;
+ if (d>=TWEXP31) {aritherror=true; return ELGORDO;}
+ i = (integer) d;
+ if (d==i && ( ((q>0 ? -q : q)&077777)
+ * (((i&037777)<<1)-1) & 04000)!=0) --i;
+ } else {
+ d -= 0.5;
+ if (d<= -TWEXP31) {aritherror=true; return -ELGORDO;}
+ i = (integer) d;
+ if (d==i && ( ((q>0 ? q : -q)&077777)
+ * (((i&037777)<<1)+1) & 04000)!=0) ++i;
+ }
+ return i;
+}
+
+/* Note that d cannot exactly equal TWEXP31 when the overflow test is made
+ because the exact value of p/q cannot be strictly between (2^31-1)/2^16
+ and 2^15/1. No pair of integers less than 2^31 has such a ratio.
+*/
+integer
+zmakescaled P2C(integer, p, integer, q) /* Approximate 2^16*p/q */
+{ register double d;
+ register integer i;
+#ifdef DEBUG
+ if (q==0) confusion(47);
+#endif /* DEBUG */
+ d = TWEXP16 * (double)p /(double)q;
+ if ((p^q) >= 0) {
+ d += 0.5;
+ if (d>=TWEXP31) {aritherror=true; return ELGORDO;}
+ i = (integer) d;
+ if (d==i && ( ((q>0 ? -q : q)&077777)
+ * (((i&037777)<<1)-1) & 04000)!=0) --i;
+ } else {
+ d -= 0.5;
+ if (d<= -TWEXP31) {aritherror=true; return -ELGORDO;}
+ i = (integer) d;
+ if (d==i && ( ((q>0 ? q : -q)&077777)
+ * (((i&037777)<<1)+1) & 04000)!=0) ++i;
+ }
+ return i;
+}
+
+#endif /* not FIXPT */
+#endif /* not assembler */
+#endif /* not TeX, i.e., MF or MP */
+
+#ifdef MF
+/* On-line display routines for Metafont. Here we use a dispatch table
+ indexed by the MFTERM or TERM environment variable to select the
+ graphics routines appropriate to the user's terminal. stdout must be
+ connected to a terminal for us to do any graphics. */
+
+#ifdef MFNOWIN
+#undef AMIGAWIN
+#undef EPSFWIN
+#undef HP2627WIN
+#undef MFTALKWIN
+#undef NEXTWIN
+#undef REGISWIN
+#undef SUNWIN
+#undef TEKTRONIXWIN
+#undef UNITERMWIN
+#undef WIN32WIN
+#undef X11WIN
+#endif
+
+#ifdef AMIGAWIN
+extern int mf_amiga_initscreen P1H(void);
+extern void mf_amiga_updatescreen P1H(void);
+extern void mf_amiga_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_amiga_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef EPSFWIN
+extern int mf_epsf_initscreen P1H(void);
+extern void mf_epsf_updatescreen P1H(void);
+extern void mf_epsf_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_epsf_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef HP2627WIN
+extern int mf_hp2627_initscreen P1H(void);
+extern void mf_hp2627_updatescreen P1H(void);
+extern void mf_hp2627_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_hp2627_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef MFTALKWIN
+extern int mf_mftalk_initscreen P1H(void);
+extern void mf_mftalk_updatescreen P1H(void);
+extern void mf_mftalk_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_mftalk_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef NEXTWIN
+extern int mf_next_initscreen P1H(void);
+extern void mf_next_updatescreen P1H(void);
+extern void mf_next_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_next_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef REGISWIN
+extern int mf_regis_initscreen P1H(void);
+extern void mf_regis_updatescreen P1H(void);
+extern void mf_regis_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_regis_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef SUNWIN
+extern int mf_sun_initscreen P1H(void);
+extern void mf_sun_updatescreen P1H(void);
+extern void mf_sun_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_sun_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef TEKTRONIXWIN
+extern int mf_tektronix_initscreen P1H(void);
+extern void mf_tektronix_updatescreen P1H(void);
+extern void mf_tektronix_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_tektronix_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef UNITERMWIN
+extern int mf_uniterm_initscreen P1H(void);
+extern void mf_uniterm_updatescreen P1H(void);
+extern void mf_uniterm_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_uniterm_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef WIN32WIN
+extern int mf_win32_initscreen P1H(void);
+extern void mf_win32_updatescreen P1H(void);
+extern void mf_win32_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_win32_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+#ifdef X11WIN
+extern int mf_x11_initscreen P1H(void);
+extern void mf_x11_updatescreen P1H(void);
+extern void mf_x11_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_x11_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+extern int mf_trap_initscreen P1H(void);
+extern void mf_trap_updatescreen P1H(void);
+extern void mf_trap_blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void mf_trap_paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+
+
+/* This variable, `mfwsw', contains the dispatch tables for each
+ terminal. We map the Pascal calls to the routines `init_screen',
+ `update_screen', `blank_rectangle', and `paint_row' into the
+ appropriate entry point for the specific terminal that MF is being
+ run on. */
+
+struct mfwin_sw
+{
+ char *mfwsw_type; /* Name of terminal a la TERMCAP. */
+ int (*mfwsw_initscreen) P1H(void);
+ void (*mfwsw_updatescrn) P1H(void);
+ void (*mfwsw_blankrect) P4H(screencol, screencol, screenrow, screenrow);
+ void (*mfwsw_paintrow) P4H(screenrow, pixelcolor, transspec, screencol);
+} mfwsw[] =
+{
+#ifdef AMIGAWIN
+ { "amiterm", mf_amiga_initscreen, mf_amiga_updatescreen,
+ mf_amiga_blankrectangle, mf_amiga_paintrow },
+#endif
+#ifdef EPSFWIN
+ { "epsf", mf_epsf_initscreen, mf_epsf_updatescreen,
+ mf_epsf_blankrectangle, mf_epsf_paintrow },
+#endif
+#ifdef HP2627WIN
+ { "hp2627", mf_hp2627_initscreen, mf_hp2627_updatescreen,
+ mf_hp2627_blankrectangle, mf_hp2627_paintrow },
+#endif
+#ifdef MFTALKWIN
+ { "mftalk", mf_mftalk_initscreen, mf_mftalk_updatescreen,
+ mf_mftalk_blankrectangle, mf_mftalk_paintrow },
+#endif
+#ifdef NEXTWIN
+ { "next", mf_next_initscreen, mf_next_updatescreen,
+ mf_next_blankrectangle, mf_next_paintrow },
+#endif
+#ifdef REGISWIN
+ { "regis", mf_regis_initscreen, mf_regis_updatescreen,
+ mf_regis_blankrectangle, mf_regis_paintrow },
+#endif
+#ifdef SUNWIN
+ { "sun", mf_sun_initscreen, mf_sun_updatescreen,
+ mf_sun_blankrectangle, mf_sun_paintrow },
+#endif
+#ifdef TEKTRONIXWIN
+ { "tek", mf_tektronix_initscreen, mf_tektronix_updatescreen,
+ mf_tektronix_blankrectangle, mf_tektronix_paintrow },
+#endif
+#ifdef UNITERMWIN
+ { "uniterm", mf_uniterm_initscreen, mf_uniterm_updatescreen,
+ mf_uniterm_blankrectangle, mf_uniterm_paintrow },
+#endif
+#ifdef WIN32WIN
+ { "win32term", mf_win32_initscreen, mf_win32_updatescreen,
+ mf_win32_blankrectangle, mf_win32_paintrow },
+#endif
+#ifdef X11WIN
+ { "xterm", mf_x11_initscreen, mf_x11_updatescreen,
+ mf_x11_blankrectangle, mf_x11_paintrow },
+#endif
+
+ /* Always support this. */
+ { "trap", mf_trap_initscreen, mf_trap_updatescreen,
+ mf_trap_blankrectangle, mf_trap_paintrow },
+
+/* Finally, we must have an entry with a terminal type of NULL. */
+ { NULL, NULL, NULL, NULL, NULL }
+
+}; /* End of the array initialization. */
+
+
+/* This is a pointer to the mfwsw[] entry that we find. */
+static struct mfwin_sw *mfwp;
+
+
+/* The following are routines that just jump to the correct
+ terminal-specific graphics code. If none of the routines in the
+ dispatch table exist, or they fail, we produce trap-compatible
+ output, i.e., the same words and punctuation that the unchanged
+ mf.web would produce. */
+
+
+/* This returns true if we can do window operations, else false. */
+
+boolean
+initscreen P1H(void)
+{
+ /* If MFTERM is set, use it. */
+ const_string tty_type = kpse_var_value ("MFTERM");
+
+ if (tty_type == NULL)
+ {
+#if defined (AMIGA)
+ tty_type = "amiterm";
+#elif defined (WIN32)
+ tty_type = "win32term";
+#elif defined (OS2) || defined (__DJGPP__) /* not AMIGA nor WIN32 */
+ tty_type = "mftalk";
+#else /* not (OS2 or WIN32 or __DJGPP__ or AMIGA) */
+ /* If DISPLAY is set, we are X11; otherwise, who knows. */
+ boolean have_display = getenv ("DISPLAY") != NULL;
+ tty_type = have_display ? "xterm" : getenv ("TERM");
+
+ /* If we don't know what kind of terminal this is, or if Metafont
+ isn't being run interactively, don't do any online output. */
+ if (tty_type == NULL
+ || (!STREQ (tty_type, "trap") && !isatty (fileno (stdout))))
+ return 0;
+#endif /* not (OS2 or WIN32 or __DJGPP__ or AMIGA) */
+ }
+
+ /* Test each of the terminals given in `mfwsw' against the terminal
+ type, and take the first one that matches, or if the user is running
+ under Emacs, the first one. */
+ for (mfwp = mfwsw; mfwp->mfwsw_type != NULL; mfwp++) {
+ if (!strncmp (mfwp->mfwsw_type, tty_type, strlen (mfwp->mfwsw_type))
+ || STREQ (tty_type, "emacs"))
+ if (mfwp->mfwsw_initscreen)
+ return ((*mfwp->mfwsw_initscreen) ());
+ else {
+ fprintf (stderr, "mf: Couldn't initialize online display for `%s'.\n",
+ tty_type);
+ break;
+ }
+ }
+
+ /* We disable X support by default, since most sites don't use it, and
+ variations in X configurations seem impossible to overcome
+ automatically. Too frustrating for everyone involved. */
+ if (STREQ (tty_type, "xterm")) {
+ fputs ("\nmf: Window support for X was not compiled into this binary.\n",
+ stderr);
+ fputs ("mf: There may be a binary called `mfw' on your system which\n",
+ stderr);
+ fputs ("mf: does contain X window support.\n\n", stderr);
+ fputs ("mf: If you need to recompile, remember to give the --with-x\n",
+ stderr);
+ fputs ("mf: option to configure\n\n", stderr);
+ fputs ("mf: (Or perhaps you just failed to specify the mode.)\n", stderr);
+ }
+
+ /* The current terminal type wasn't found in any of the entries, or
+ initalization failed, so silently give up, assuming that the user
+ isn't on a terminal that supports graphic output. */
+ return 0;
+}
+
+
+/* Make sure everything is visible. */
+
+void
+updatescreen P1H(void)
+{
+ if (mfwp->mfwsw_updatescrn)
+ (*mfwp->mfwsw_updatescrn) ();
+}
+
+
+/* This sets the rectangle bounded by ([left,right], [top,bottom]) to
+ the background color. */
+
+void
+blankrectangle P4C(screencol, left, screencol, right,
+ screenrow, top, screenrow, bottom)
+{
+ if (mfwp->mfwsw_blankrect)
+ (*mfwp->mfwsw_blankrect) (left, right, top, bottom);
+}
+
+
+/* This paints ROW, starting with the color INIT_COLOR.
+ TRANSITION_VECTOR then specifies the length of the run; then we
+ switch colors. This goes on for VECTOR_SIZE transitions. */
+
+void
+paintrow P4C(screenrow, row, pixelcolor, init_color,
+ transspec, transition_vector, screencol, vector_size)
+{
+ if (mfwp->mfwsw_paintrow)
+ (*mfwp->mfwsw_paintrow) (row, init_color, transition_vector, vector_size);
+}
+#endif /* MF */
diff --git a/Build/source/texk/web2c/lib/uexit.c b/Build/source/texk/web2c/lib/uexit.c
new file mode 100644
index 00000000000..21f34ded35f
--- /dev/null
+++ b/Build/source/texk/web2c/lib/uexit.c
@@ -0,0 +1,20 @@
+/* uexit.c: define uexit to do an exit with the right status. We can't
+ just call `exit' from the web files, since the webs use `exit' as a
+ loop label. Public domain. */
+
+#include "config.h"
+
+void
+uexit P1C(int, unix_code)
+{
+ int final_code;
+
+ if (unix_code == 0)
+ final_code = EXIT_SUCCESS;
+ else if (unix_code == 1)
+ final_code = EXIT_FAILURE;
+ else
+ final_code = unix_code;
+
+ exit (final_code);
+}
diff --git a/Build/source/texk/web2c/lib/usage.c b/Build/source/texk/web2c/lib/usage.c
new file mode 100644
index 00000000000..194cc73c84d
--- /dev/null
+++ b/Build/source/texk/web2c/lib/usage.c
@@ -0,0 +1,35 @@
+/* usage.c: Output a help message (from help.h).
+
+ Modified in 2001 by O. Weber.
+ Written in 1995 by K. Berry. Public domain. */
+
+#include "config.h"
+
+/* Call usage if the program exits with an "usage error". STR is supposed
+ to be the program name. */
+
+void
+usage P1C(const_string, str)
+{
+ fprintf (stderr, "Try `%s --help' for more information.\n", str);
+ uexit (1);
+}
+
+/* Call usage if the program exits by printing the help message.
+ MESSAGE is an NULL-terminated array or strings which make up the
+ help message. Each string is printed on a separate line.
+ We use arrays instead of a single string to work around compiler
+ limitations (sigh).
+*/
+void
+usagehelp P2C(const_string*, message, const_string,bug_email)
+{
+ if (!bug_email)
+ bug_email = "tex-k@mail.tug.org";
+ while (*message) {
+ printf("%s\n", *message);
+ ++message;
+ }
+ printf("\nEmail bug reports to %s.\n", bug_email);
+ uexit(0);
+}
diff --git a/Build/source/texk/web2c/lib/version.c b/Build/source/texk/web2c/lib/version.c
new file mode 100644
index 00000000000..8c7efb17cc9
--- /dev/null
+++ b/Build/source/texk/web2c/lib/version.c
@@ -0,0 +1,6 @@
+#include "c-auto.h"
+
+/* This string is appended to all the banners and used in --version. */
+/* Public domain. */
+
+char *versionstring = WEB2CVERSION;
diff --git a/Build/source/texk/web2c/lib/win32.mak b/Build/source/texk/web2c/lib/win32.mak
new file mode 100644
index 00000000000..44b9ef118aa
--- /dev/null
+++ b/Build/source/texk/web2c/lib/win32.mak
@@ -0,0 +1,62 @@
+################################################################################
+#
+# Makefile : Web2C / library
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <02/10/26 18:58:43 popineau>
+#
+################################################################################
+root_srcdir=..\..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+USE_KPATHSEA = 1
+USE_GNUW32 = 1
+USE_TEX = 1
+
+!include <msvc/common.mak>
+
+DEFS = -I.. $(DEFS) -DMAKE_TEX_DLL -DHAVE_CONFIG_H -DOEM \
+ -DJOBTIME -DTIME_STATS \
+ -DOUTPUT_DIR -DHALT_ON_ERROR
+
+library = lib
+
+# We don't make `texmfmp.o', since TeX, Metafont, and MetaPost need to
+# use different routine names, hence they need different .o files. Maybe
+# we should change this via #define's someday ...
+objects = \
+ $(objdir)\basechsuffix.obj \
+ $(objdir)\oem.obj \
+ $(objdir)\chartostring.obj \
+ $(objdir)\coredump.obj \
+ $(objdir)\eofeoln.obj \
+ $(objdir)\fprintreal.obj \
+ $(objdir)\inputint.obj \
+ $(objdir)\input2int.obj \
+ $(objdir)\main.obj \
+ $(objdir)\openclose.obj \
+ $(objdir)\printversion.obj \
+ $(objdir)\uexit.obj \
+ $(objdir)\usage.obj \
+ $(objdir)\version.obj \
+ $(objdir)\zround.obj
+
+default: all
+
+all: $(objdir) $(objdir)\$(library).lib
+
+$(objdir)\$(library).lib: $(objects)
+ $(archive) $(objects)
+
+!include <msvc/install.mak>
+!include <msvc/clean.mak>
+!include <msvc/rdepend.mak>
+!include "./depend.mak"
+
+# Local Variables:
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/lib/win32main.c b/Build/source/texk/web2c/lib/win32main.c
new file mode 100644
index 00000000000..aa1c1f865d7
--- /dev/null
+++ b/Build/source/texk/web2c/lib/win32main.c
@@ -0,0 +1,30 @@
+#include "config.h"
+
+/* The entry point: set up for reading the command line, which will
+ happen in `topenin', then call the main body. Public domain. */
+
+extern TEXDLL void mainbody P1H(void);
+extern TEXDLL void maininit P2H(int, string *);
+
+int
+main P2C(int, ac, string *, av)
+{
+#ifdef __EMX__
+ _wildcard (&ac, &av);
+ _response (&ac, &av);
+#endif
+
+#if defined(WIN32)
+ /* if _DEBUG is not defined, these macros will result in nothing. */
+ SETUP_CRTDBG;
+ /* Set the debug-heap flag so that freed blocks are kept on the
+ linked list, to catch any inadvertent use of freed memory */
+ SET_CRT_DEBUG_FIELD( _CRTDBG_DELAY_FREE_MEM_DF );
+#endif
+
+ maininit(ac, av);
+
+ /* Call the real main program. */
+ mainbody ();
+ return EXIT_SUCCESS;
+}
diff --git a/Build/source/texk/web2c/lib/zround.c b/Build/source/texk/web2c/lib/zround.c
new file mode 100644
index 00000000000..1df2e5d5c96
--- /dev/null
+++ b/Build/source/texk/web2c/lib/zround.c
@@ -0,0 +1,41 @@
+/* zround.c: round R to the nearest whole number. This is supposed to
+ implement the predefined Pascal round function. Public domain. */
+
+#include "config.h"
+
+integer
+zround P1C(double, r)
+{
+ integer i;
+
+ /* R can be outside the range of an integer if glue is stretching or
+ shrinking a lot. We can't do any better than returning the largest
+ or smallest integer possible in that case. It doesn't seem to make
+ any practical difference. Here is a sample input file which
+ demonstrates the problem, from phil@cs.arizona.edu:
+ \documentstyle{article}
+ \begin{document}
+ \begin{flushleft}
+ $\hbox{} $\hfill
+ \filbreak
+ \eject
+
+ djb@silverton.berkeley.edu points out we should testing against
+ TeX's largest or smallest integer (32 bits), not the machine's. So
+ we might as well use a floating-point constant, and avoid potential
+ compiler bugs (also noted by djb, on BSDI). */
+ if (r > 2147483647.0)
+ i = 2147483647;
+ /* should be ...8, but atof bugs are too common */
+ else if (r < -2147483647.0)
+ i = -2147483647;
+ /* Admittedly some compilers don't follow the ANSI rules of casting
+ meaning truncating toward zero; but it doesn't matter enough to do
+ anything more complicated here. */
+ else if (r >= 0.0)
+ i = (integer)(r + 0.5);
+ else
+ i = (integer)(r - 0.5);
+
+ return i;
+}
diff --git a/Build/source/texk/web2c/man/ChangeLog b/Build/source/texk/web2c/man/ChangeLog
new file mode 100644
index 00000000000..90e1fa08ee3
--- /dev/null
+++ b/Build/source/texk/web2c/man/ChangeLog
@@ -0,0 +1,641 @@
+2005-08-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.man: Document -etex switch.
+
+ * pdfetex.man: Document -etex switch.
+
+2005-07-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Remove references to pdfxtex.
+
+2005-06-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Replace ac_include with kpse_include. From Peter
+ Breitenlohner.
+
+2005-06-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * newer.man: Update manual page for new interface of newer.
+
+2005-01-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mf.man: Omitted a man page correction. From Eric S. Raymond
+ <esr@thyrsus.com>.
+
+ * amstex.man, bibtex.man, dmp.man, dvitype.man, eplain.man,
+ etex.man, gftodvi.man, gftopk.man, gftype.man, makempx.man,
+ mf.man, mft.man, mpost.man, mpto.man, newer.man, omega.man,
+ patgen.man, pdfetex.man, pdftex.man, pdfxtex.man, pktogf.man,
+ pktype.man, pltotf.man, pooltype.man, tangle.man, tex.man,
+ tftopl.man, vftovp.man, vptovf.man, weave.man: Man page
+ corrections from Eric S. Raymond <esr@thyrsus.com>.
+
+2004-12-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in [manfiles]: Add cweb.1.
+
+ * cweb.man: Remove absolute path from FILES section. Remove
+ references to files that we don't install. Add reference to Web2C
+ to footer.
+
+ * cweb.man: Manual page for cweb programs, copied from cwebdir so
+ it can be modified.
+
+2004-10-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Clarify option handling a bit and reorganize some text.
+
+ * pdfxtex.man: Clarify option handling a bit and reorganize some
+ text.
+
+ * pdfetex.man: Clarify option handling a bit and reorganize some
+ text.
+
+ * pdftex.man: Clarify option handling a bit and reorganize some
+ text.
+
+ * etex.man: Clarify option handling a bit and reorganize some
+ text.
+
+ * omega.man: Clarify option handling a bit and reorganize some
+ text.
+
+ * mf.man: Clarify option handling a bit and reorganize some text.
+
+ * mpost.man: Clarify option handling a bit and reorganize some
+ text.
+
+ * pdfxtex.man: Correct mailing list info.
+
+ * pdfetex.man: Correct mailing list info.
+
+ * pdftex.man: Correct mailing list info.
+
+2004-09-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdfetex.man: .efmt -> .fmt Found by Hartmut Henkel
+ <hartmut_henkel@gmx.de>.
+
+ * pdfxtex.man: .efmt -> .fmt Found by Hartmut Henkel
+ <hartmut_henkel@gmx.de>.
+
+ * etex.man: .efmt -> .fmt Found by Hartmut Henkel
+ <hartmut_henkel@gmx.de>.
+
+2004-08-27 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.man: Fixed a typo.
+
+ * mf.man: Fixed a typo.
+
+ * mpost.man: Fixed a typo.
+
+ * omega.man: Fixed a typo.
+
+ * pdfetex.man: Fixed a typo.
+
+ * pdftex.man: Fixed a typo.
+
+ * pdfxtex.man: Fixed a typo.
+
+ * tex.man: Fixed a typo.
+
+2004-08-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdfxtex.man: Document -output-directory.
+
+ * pdftex.man: Document -output-directory.
+
+ * pdfetex.man: Document -output-directory.
+
+ * tex.man: Document -output-directory.
+
+ * mpost.man: Document -output-directory.
+
+ * mf.man: Document -output-directory.
+
+ * omega.man: Document -output-directory.
+
+ * etex.man: Document -output-directory.
+
+2004-08-23 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * patgen.man: Major rewrite.
+
+ * weave.man: Fixed a typo.
+
+2004-08-21 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex.man: Update author.
+
+ * etex.man, pdfetex.man: Change -efmt to -fmt.
+
+ * etex.man, tex.man: Remove references to PDF mode.
+
+2004-07-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mpost.man: Misspelt \*(MP macro. From Peter Breitenlohner
+ <peb@mppmu.mpg.de>.
+
+2004-07-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdfxtex.man: Change -efmt to -fmt.
+
+2004-06-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdfetex.man: Correct title to refer to pdfetex.
+
+ * pdfxtex.man: The pdfxtex manual page is based on the pdfetex
+ manual page.
+
+2004-05-08 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * omega.man: Document -halt-on-error.
+
+ * pdftex.man: Document -halt-on-error.
+
+ * pdfetex.man: Document -halt-on-error.
+
+ * etex.man: Document -halt-on-error.
+
+ * tex.man: Document -halt-on-error.
+
+ * mf.man: Document -halt-on-error.
+
+ * mpost.man: Document -halt-on-error.
+
+2004-05-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mf.man: Remove mention of mfw, document mf-nowin instead.
+
+2004-03-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Document -no-shell-escape, -no-parse-first-line,
+ -no-file-line-error.
+
+ * etex.man: Document -no-shell-escape, -no-parse-first-line,
+ -no-file-line-error.
+
+ * pdftex.man: Document -no-shell-escape, -no-parse-first-line,
+ -no-file-line-error.
+
+ * pdfetex.man: Document -no-shell-escape, -no-parse-first-line,
+ -no-file-line-error.
+
+ * mf.man: Document -no-parse-first-line, -no-file-line-error.
+
+ * mpost.man: Document -no-parse-first-line, -no-file-line-error.
+
+2004-03-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Update for new/previously undocumented options.
+
+ * etex.man: Update for new/previously undocumented options.
+
+ * pdftex.man: Update for new/previously undocumented options.
+
+ * pdfetex.man: Update for new/previously undocumented options.
+
+2004-02-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in [manfiles]: Add pdfxtex.1.
+
+2003-12-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * latex.man: Misspelt \*(TX macro, found by Eric S. Raymond
+ <esr@thyrsus.com>.
+
+2002-12-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Clarify notes of first-line parsing.
+
+2002-11-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mpost.man: Replace references to 'mp' with references to
+ 'mpost'.
+
+2002-11-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Document -parse-first-line; document TeX vs TeXk.
+
+ * pdftex.man: Document -parse-first-line; document pdfTeX vs
+ pdfTeXk.
+
+ * pdfetex.man: Document -parse-first-line; document pdfeTeX vs
+ pdfeTeXk.
+
+ * omega.man: Document -parse-first-line; document Omega vs Omegak.
+
+ * mpost.man: Document -parse-first-line.
+
+ * mf.man: Document -parse-first-line.
+
+ * etex.man: Document -parse-first-line; document e-TeX vs e-TeXk.
+
+2002-10-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * omega.man: Updated mailing list info (badly of out date now) --
+ replaced with a reference to the web site.
+
+2002-10-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * omega.man: Document oft extension instead of fmt.
+
+2002-10-20 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Document -jobname option.
+
+ * pdfetex.man: Document -jobname option.
+
+ * pdftex.man: Document -jobname option.
+
+ * mpost.man: Document -jobname option.
+
+ * mf.man: Document -jobname option.
+
+ * etex.man: Document -jobname option.
+
+ * tangle.man: Document new options.
+
+2002-07-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mpost.man: No such thing as .F macro... Found by "Eric
+ S. Raymond" <esr@golux.thyrsus.com>.
+
+2001-11-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mf.man: Mention mfw.
+
+2001-11-18 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Document --recorder option.
+
+ * pdftex.man: Document --recorder option.
+
+ * omega.man: Document --recorder option.
+
+ * mpost.man: Document --recorder option.
+
+ * mf.man: Document --recorder option.
+
+ * etex.man: Document --recorder option.
+
+2001-11-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Document -file-line-error-style.
+
+ * pdftex.man: Document -file-line-error-style.
+
+ * pdfetex.man: Document -file-line-error-style.
+
+ * mpost.man: Document -file-line-error-style.
+
+ * mf.man: Document -file-line-error-style.
+
+ * etex.man: Document -file-line-error-style.
+
+2001-10-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Typos.
+
+ * pdftex.man: Typo.
+
+ * etex.man: Typo.
+
+ * Makefile.in: Add pdfetex manual page.
+
+2001-10-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mf.man: Change /usr/ucb/vi to vi in example, as the path given
+ is system-dependent.
+
+2001-09-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * newer.man: Correct description of the exit conditions. After
+ Oliver Moeller <omoeller@csd.uu.se>.
+
+2000-04-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.man, omega.man, pdftex.man, tex.man:
+ Remove references to undump.
+
+2000-04-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dvitomp.man: New file by Jim Van Zandt <jrv@vanzandt.mv.com>.
+
+ * Makefile.in: Add dvitomp manual page.
+
+1999-06-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * omega.man: Mention the empty-path-component trick.
+
+ * tex.man: Mention the empty-path-component trick.
+
+ * pdftex.man: Mention the empty-path-component trick.
+
+ * etex.man: Mention the empty-path-component trick.
+
+1999-05-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man, pdftex.man, mpost.man, mf.man, latex.man, etex.man:
+ Correct date.
+
+1999-03-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * tex.man: Account for --translate-file option, %&
+ --translate-file tcxname construct.
+
+ * pdftex.man, mpost.man, mf.man, etex.man: Account for
+ --translate-file option.
+
+1999-01-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * latex.man: Correct typography of pdfTeX.
+
+1999-01-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dvicopy.man: Update page; description is still incomplete.
+
+1999-01-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Rename kpathsea.make to kpathsea.mk.
+
+1999-01-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdftex.man: Add definition of MF macro.
+
+ * Makefile.in: Change of ../make/*.make to ../make/*.mk.
+
+Fri Apr 10 06:24:25 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * etex.man: Definition of MF macro added.
+
+ * omega.man: Defnition of MF macro was missing.
+
+ * pdftex.man: Definition of MF macro was missing.
+
+Sat Mar 7 18:16:40 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * omega.man: Add authors list.
+
+ * pdftex.man: Add authors list.
+
+Tue Mar 3 09:07:10 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * omega.man: Corrected instructions for subscribing to the omega
+ list.
+
+Fri Jan 9 21:14:37 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Include clean.make, add a default target.
+
+Sun Jan 4 15:57:34 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Use man.make to supply rules for manual pages.
+
+ * Makefile.in: Changes to cope with new manual pages.
+
+Tue Dec 30 17:46:24 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Changes to all pages in an attempt to get them up-to-date. Some
+ pages (amslatex, lamstex, slitex, initex, virtex) have been
+ removed. Some renamed (etex -> eplain). Some added (etex,
+ pdftex, omega).
+
+Tue Dec 12 16:52:12 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (sedscript): Correct path for c-auto.h. From Ulrik.
+
+Tue Jun 13 11:31:35 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Use ../web2c, not /w.
+
+Mon Dec 19 13:07:24 1994 Karl Berry <karl@cs.umb.edu>
+
+ * dvitype.man: The .dvi file extended if necessary.
+ * vftovp.man: Similarly.
+
+Sat Dec 17 16:44:49 1994 Karl Berry <karl@cs.umb.edu>
+
+ * tftopl.man: Both the .tfm and .pl files are extended if
+ necessary now.
+ * vptovf.man: Similarly.
+
+Thu Nov 24 13:42:16 1994 Karl Berry <karl@cs.umb.edu>
+
+ * bibtex.man: We don't use TEXINPUTS to look for .bst files now.
+
+Mon Feb 21 14:50:51 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: srcdir changes from simon.
+
+Wed Feb 2 11:00:09 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Mon Jan 24 07:31:37 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Sat Jan 22 06:48:27 1994 Karl Berry (karl@cs.umb.edu)
+
+ * *.man: Remove ==== line after NAME section, since Sun's
+ makewhatis doesn't ignore it.
+
+Tue Dec 14 20:02:06 1993 Karl Berry (karl@cs.umb.edu)
+
+ * *.man: Update for new path variables, etc.
+ * Makefile.in (sedscript): Likewise.
+
+Sun Dec 12 19:14:19 1993 Karl Berry (karl@cs.umb.edu)
+
+ * mf.man: Don't mention cmsources.
+ * Makefile.in (cmsources): Don't bother with this.
+ (sedscript): Don't substitute for this, and rm the dependency on
+ lib/paths.h, since it doesn't exist any more.
+
+Sun Dec 5 16:04:51 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tex.man: Document the envvars MAKETEXTEX, USE_MAKETEXTEX, etc.
+ * mf.man: Likewise.
+
+Sun Nov 14 11:58:01 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: texfontdir => fontdir.
+
+Thu Oct 7 10:04:22 1993 Karl Berry (karl@cs.umb.edu)
+
+ * latex.man: Mention the LaTeX manual and the local guide. From
+ tuttle@crl.dec.com.
+
+Sat Jul 10 09:24:56 1993 Karl Berry (karl@cs.umb.edu)
+
+ * mf.man: The word `facilitates' bothers me.
+
+Tue May 18 14:03:49 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-*): mkdirchain on install dirs.
+
+Sun May 9 13:22:00 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Use ! instead of %, which loses on the EDITOR string.
+
+Tue May 4 10:23:33 1993 Karl Berry (karl@cs.umb.edu)
+
+ * weave.man: Correct date, other miscellany.
+
+Mon Mar 29 08:57:19 1993 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.man: System default for BSTINPUTS is BSTINPUTS, not
+ TEXINPUTS.
+
+Sat Mar 13 10:38:14 1993 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.man: Had stdout sentence end in wrong place.
+
+ * Makefile.in (sedscript): Use % instead of ; to delimit sed
+ arguments, since ; might occur in the yytext declaration. (From
+ ilan343@violet.berkeley.edu.)
+
+Sun Feb 28 10:52:01 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Separate clean targets.
+
+ * Makefile.in (clean): Don't remove Makefile here.
+
+Sun Feb 21 08:28:14 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Version 5.851d.
+
+Tue Feb 16 17:54:04 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec, install-data): New targets.
+
+Fri Feb 12 12:43:04 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tangle.man, weave.man: Separate.
+
+Fri Jan 29 12:07:08 1993 Karl Berry (karl@cs.umb.edu)
+
+ * tex.man: Describe texfonts.map.
+
+Mon Jan 25 13:55:40 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (sedscript): Don't use $@; get definitions from
+ c-auto.h as well as paths.h.
+
+Thu Jan 14 08:08:20 1993 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.man: Mention that DEK's bibtex doesn't have some of our
+ features.
+
+Sun Jan 3 13:35:05 1993 Karl Berry (karl@cs.umb.edu)
+
+ * etex.man: The listed features aren't the only ones.
+
+ * Makefile.in (distclean): Remove Makefile.
+
+Sat Jan 2 15:58:52 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (dw, spell, check, .ps, .txt): New targets from beebe.
+ * *.man: Likewise.
+
+Fri Dec 18 13:32:01 1992 Karl Berry (karl@cs.umb.edu)
+
+ * tftopl.man: .tfm is now added if necessary.
+
+Mon Dec 14 07:40:07 1992 Karl Berry (karl@cs.umb.edu)
+
+ * <many>.man: Remove end-of-sentence periods after paths.
+
+Sun Dec 13 15:00:23 1992 Karl Berry (karl@cs.umb.edu)
+
+ * bibtex.man: Document BSTINPUTS.
+
+Sat Dec 12 13:16:25 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+ * mf.man: Missing quotes in MFTERM line.
+
+Tue Oct 6 08:18:48 1992 Karl Berry (karl@cs.umb.edu)
+
+ * {mf,tex}.man: Use ~me instead of /usr/me.
+
+ * {gftodvi,gftopk,gftype,pktogf,pktype,vftovp}.man: Current
+ directory is not searched first.
+
+Fri Sep 4 09:02:22 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+
+Sun Jul 5 07:26:14 1992 Karl Berry (karl@hayley)
+
+ * tex.man: avoid lines >= 80 chars.
+
+ * Makefile (*clean): remove *.dvi and *.log; have `mostlyclean' do
+ nothing.
+
+Tue Jun 23 09:14:07 1992 Karl Berry (karl@hayley)
+
+ * Makefile (manext): default to `1', not `l'.
+
+Fri May 29 16:54:43 1992 Karl Berry (karl@hayley)
+
+ * bibtex.man: more paragraphs, etc.
+
+Sat May 23 12:26:53 1992 Karl Berry (karl@hayley)
+
+ * tex.man: document slightly different path searching.
+
+Thu May 14 19:21:49 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Thu Apr 23 12:06:30 1992 Karl Berry (karl@hayley)
+
+ * tex.man, mf.man: fix nroff quote problems.
+ * Makefile (sedscript): toss trailing comments.
+ These changes from Andreas.
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Sun Apr 12 11:51:58 1992 Karl Berry (karl@hayley)
+
+ * tex.man: . not searched first anymore.
+
+Fri Apr 3 09:55:14 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Sat Mar 21 09:14:20 1992 Karl Berry (karl at hayley)
+
+ * patgen.man: update for patgen2.
+
+ * *.man: (ENVIRONMENT VARIABLES): rename to `ENVIRONMENT'; remove
+ references to TEXFONTS_SUBDIR.
+
+ * tex.man (ENVIRONMENT): mention ~.
+
+ * Makefile (sedscript): depend using srcdir, not SITEDIR.
+
+Fri Mar 20 16:43:23 1992 Karl Berry (karl at hayley)
+
+ * Makefile (mostlyclean): new name for `clean'.
+ (clean): what `realclean' used to be.
+ (realclean): nothing to do anymore.
+ (install): install the stuff.
+
+Sat Feb 1 16:45:54 1992 Karl Berry (karl at hayley)
+
+ * tex.man: update path searching info.
+
+Sat Jan 11 08:47:26 1992 Karl Berry (karl at hayley)
+
+ * Makefile (initex.1, virtex.1): new targets.
+
+Tue Jan 7 16:04:29 1992 Karl Berry (karl at hayley)
+
+ * Use `1 Jan 1992' date format.
diff --git a/Build/source/texk/web2c/man/Makefile.in b/Build/source/texk/web2c/man/Makefile.in
new file mode 100644
index 00000000000..5b8d0d230e9
--- /dev/null
+++ b/Build/source/texk/web2c/man/Makefile.in
@@ -0,0 +1,80 @@
+# Makefile for web2c manual pages.
+#
+# You need to change the variables and the pathnames only if this
+# Makefile is invoked on its own, instead of from `../Makefile'.
+
+version = @WEB2CVERSION@
+
+SHELL = /bin/sh
+top_srcdir = @top_srcdir@
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+kpse_include ../make/common.mk
+kpse_include kpathsea.mk
+
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+
+DITROFF = ditroff
+DITROFF = groff
+
+# These pathnames are used to customize the manual pages with local
+# directory names. They should match the system directories so the
+# documentation and the programs will be consistent. They are overridden
+# by make from web2c/Makefile.
+kpse_include ../make/paths.mk
+
+localmodes = modes
+
+# If you like, delete the man pages for programs you aren't installing.
+# The programs are listed in alphabetical order.
+#
+manfiles= \
+ amstex.1 \
+ bibtex.1 \
+ cweb.1 \
+ dmp.1 \
+ dvicopy.1 \
+ dvitomp.1 \
+ dvitype.1 \
+ eplain.1 \
+ etex.1 \
+ gftodvi.1 \
+ gftopk.1 \
+ gftype.1 \
+ latex.1 \
+ makempx.1 \
+ mf.1 \
+ mft.1 \
+ mpost.1 \
+ mpto.1 \
+ newer.1 \
+ omega.1 \
+ patgen.1 \
+ pdfetex.1 \
+ pdftex.1 \
+ pktogf.1 \
+ pktype.1 \
+ pltotf.1 \
+ pooltype.1 \
+ tangle.1 \
+ tex.1 \
+ tftopl.1 \
+ vftovp.1 \
+ vptovf.1 \
+ weave.1
+
+default all: manfiles
+
+kpse_include ../make/man.mk
+
+install install-data: install-man
+
+Makefile: Makefile.in ../config.status
+ (cd ..; $(SHELL) config.status)
+
+kpse_include ../make/clean.mk
+
+# Prevent GNU make 3 from overflowing arg limit on system V.
+.NOEXPORT:
diff --git a/Build/source/texk/web2c/man/README b/Build/source/texk/web2c/man/README
new file mode 100644
index 00000000000..7f11613a67b
--- /dev/null
+++ b/Build/source/texk/web2c/man/README
@@ -0,0 +1,260 @@
+(This file written by Nelson H. F. Beebe <beebe@math.utah.edu>.)
+
+This directory contains UNIX manual pages for TeXware and MFware.
+
+Here are some guidelines for writing UNIX manual page files, based on
+the standards used by Sun Microsystems. The manual pages in this
+directory have been revised to conform to these guidelines.
+
+*** The sections of a manual page are identified by these headings:
+
+.TH PROGRAM 1 "dd month yyyy"
+.SH NAME
+.SH SYNOPSIS
+.SH DESCRIPTION
+.SH OPTIONS
+.SH ENVIRONMENT
+.SH FILES
+.SH "SEE ALSO"
+.SH AUTHOR
+
+Additional sections may be supplied, but the above section order
+should be preserved. If you are adding a new section, try to find
+several examples in existing UNIX manual pages to justify the header
+name you choose.
+
+To improve readability of the [nt]roff man page files in this
+directory, each section header has been prefixed by a comment line of
+the form
+.\"=====================================================================
+
+
+------------------------------------------------------------------------
+
+*** The
+
+.TH PROGRAM 1 "dd month yyyy"
+
+line should be the first [nt]roff dotted command in the .man file,
+other than comments, which begin with the 3-character sequence .\".
+
+The PROGRAM name should be spelled entirely in uppercase letters.
+
+The single character following PROGRAM is the manual page section,
+generally 1 for user commands. Any character from the set [1-8nl] is
+recognized by the UNIX man command, but the sections have specific
+meanings (1=user commands, 2=system calls, 3=library routines, 4=special
+files, 5=file formats and conventions, 6=games, 7=macro packages and
+language conventions, 8=maintenance, l=local, and n=new).
+
+Historically, man page files were stored in /usr/man/man[1-8nl], with
+local additions to /usr/man/manl. That approach offered no
+subdivision of local additions into sections, so the trend today is to
+leave the /usr/man tree in the state supplied by the vendor, and to
+maintain a separate tree, /usr/man/man[1-8nl], to hold local
+additions. Most UNIX man implementations support a MANPATH variable
+to specify a search path, such as /usr/man:/usr/local/man.
+
+If your man command doesn't support a MANPATH variable, get the
+freely-available man implementation man-1.0.tar.Z available on several
+Internet archive sites, including gatekeeper.dec.com in
+/.8/GNU/man-1.0.tar.Z. Some bugs exist in that version, and fixes were
+supplied to the program's author on 12 December 1992, so look for a new
+version, or ask Nelson Beebe <beebe@math.utah.edu> for a set of patches.
+This new man implementation has some nice features, including support
+for compressed files, and checking of formatted and raw file time stamps
+to decide whether to reformat or not. Furthermore, it can be configured
+to use either [nt]roff, or GNU groff; some UNIX vendors charge extra for
+[nt]roff, so groff may offer a cheaper man page implementation.
+
+The last argument to .TH is the date in the form 01 December 1992; the
+month is NOT abbreviated.
+
+
+------------------------------------------------------------------------
+
+*** Following
+.SH NAME
+should be a single line with NO macros, such as
+
+bibtex \- make a bibliography for (La)TeX
+
+This line is very important, because it is used by the "man -k" and
+"apropos" commands to look up commands by keywords; every word in the
+line is a potential keyword match.
+
+
+------------------------------------------------------------------------
+
+*** Following
+.SH SYNOPSIS
+there should be one or more lines in the form
+
+.B vftovp
+[
+.B \-verbose
+]
+[
+.BI \-charcode-format =format
+]
+.I vf_file_name
+.I tfm_file_name
+[
+.I vpl_file_name
+]
+
+Program names and option switches are typeset in bold type (.B), and
+file names in italics (.I). Switch values are in italics.
+
+Give option switches in alphabetical order in the SYNOPSIS
+section, and their descriptions in the same order in the OPTIONS
+section.
+
+
+------------------------------------------------------------------------
+
+*** Here are some general [nt]roff hints for writing the
+.SH DESCRIPTION
+section.
+
+
+*** Separate paragraphs by a .PP command, not by blank lines.
+
+
+*** When using the multi-font selectors, like .BI (bold, then italic),
+remember that fonts alternate in the following space-separated words:
+
+.BI aaa bbb ccc ddd
+
+will typeset aaa and cccc in bold, and bbb and ddd in italic, with NO
+intervening spaces, so the result here will be aaabbbcccddd. If you
+want spaces between the words, use quotation marks:
+
+.BI "aaa " "bbb " "ccc " ddd
+
+will produce aaa bbb ccc ddd.
+
+Use [nt]roff dotted font change sequences (.I, .B, .BI, .BR, ...)
+instead of the \fX...\fP alternatives. The single exception is when
+you need quotation marks in italics, such as \fIsetenv FOOBAR "foo
+bar"\fP.
+
+
+*** Represent en dashes by the current font minus (\-), and use the
+same character in front of option switches. Hyphens in words, as
+``multi-font'', are written with the ASCII minus sign.
+
+
+*** Quotation marks are [nt]roff grouping commands, analogous to curly
+braces in TeX files. They will NOT survive in the formatted output.
+If you want typeset quotation marks, use ``phrase'', just as in TeX.
+
+
+*** Ellipses (...) in [nt]roff are coded as .\|.\|., for the same
+reason that \ldots{} is used in TeX instead of ....
+
+
+*** UNIX is a trademark of AT&T Bell Laboratories and must be spelled
+in uppercase letters.
+
+
+*** Watch out for spaces. Unlike TeX, [nt]roff preserve ALL input
+spaces. This means you cannot indent [nt]roff input for readability.
+Two spaces should follow a sentence-ending period, and otherwise, only
+one space should be used. Tabs are special in [nt]roff; they are used
+to separate columns of tables, like & in TeX, and no other character
+can be used for that purpose. The man page files in this directory
+contain no tabs, and trailing blanks have been stripped from all
+files.
+
+
+*** Do not used fixed indentation dimensions for displayed material.
+Instead, use .RS and .RE to mark the indented paragraphs, with .IP to
+separate paragraphs:
+
+.RS
+Blah blah blah blah blah blah blah blah blah.
+Blah blah blah blah blah blah blah blah blah.
+.IP
+Blah blah blah blah blah blah blah blah blah.
+Blah blah blah blah blah blah blah blah blah.
+.RE
+
+
+*** Use macros for phrases that require special typesetting, such as
+the TeX logo, and provide both nroff and troff definitions:
+
+.if n .ds AB nroff-definition
+.if t .ds AB troff-definition
+
+Macro names are exactly 2 characters long, and are referenced by \*(
+prefixed to their names, e.g. \*(AB.
+
+If a macro expansion requires another macro, it must be given after
+that macro. For example, the BibTeX and LaTeX macros follow the TeX
+macro so they can use \*(TX in their definitions.
+
+Suitable macros have been provided for TeX, BibTeX, LaTeX, Metafont,
+and Web, and adjusted for troff's default Times Roman typeface to
+match their appearance with Computer Modern typefaces.
+
+
+------------------------------------------------------------------------
+
+*** The
+.SH ENVIRONMENT
+section should list all the relevant environment variables, with a brief
+description and system defaults if appropriate.
+
+
+*** Environment variables are spelled in uppercase letters, e.g.,
+TEXFONTS, and NO font size changes are made around them. When font
+sizes were changed in the past, many inconsistencies were present, so
+the practice has been abandoned.
+
+
+*** Do not use fixed dimensions for indented labelled paragraphs.
+Instead, use the width of the longest label, plus 2n, as follows:
+
+.TP \w'LONGESTLABEL'u+2n
+LABEL
+Blah blah blah blah blah blah blah blah blah.
+.TP
+LONGESTLABEL
+Blah blah blah blah blah blah blah blah blah.
+Blah blah blah blah blah blah blah blah blah.
+
+If the longest label is extremely long, pick a somewhat shorter one so
+as to avoid having very short paragraph lines.
+
+
+------------------------------------------------------------------------
+
+*** Spell TeX control sequences in Roman letters, doubling the
+backslash, e.g. \\input, or for better visibility, use italics
+with the backslash represented as \e:
+
+.I \einput
+
+Although some [nt]roff implementations support a typewriter font which
+is conventional for TeX control sequences, historically only roman,
+bold, italic, and special fonts were available.
+
+
+*** These manual pages in the *.man form are filtered by sedscript to
+expand @XYZ@ into something else, producing corresponding *.1 files
+which are installed in the system manual page directories. This is
+used to insert local paths into the manual pages, so that for example
+@TEXINPUTS@ is replaced by the local default TEXINPUTS search path.
+Such paths are set at installation time in the top-level Makefile.
+
+
+*** You can use the UNIX checknr utility to do a rudimentary validation of
+your manual page files, e.g.
+
+ checknr -c.BI.BR.IR.IB.RB.RI tex.man
+
+The -c.BI.BR.IR.IB.RB.RI is needed because checknr doesn't know about
+the -man document style, and otherwise complains about those font
+change commands. The command "make check" will run checknr with each
+of the *.1 files.
diff --git a/Build/source/texk/web2c/man/amslatex.min b/Build/source/texk/web2c/man/amslatex.min
new file mode 100644
index 00000000000..9c756daa82e
--- /dev/null
+++ b/Build/source/texk/web2c/man/amslatex.min
@@ -0,0 +1,108 @@
+.TH AMSLATEX 1 "23 January 1994"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.if t .ds LZ \
+\fRL\
+\\h'-0.3m'\\v'-0.21v'\s-2A\s0\\v'0.21v'\
+\\h'-0.15m'\\v'0.188v'M\\v'-0.188v'\
+\\h'-0.125m'S\
+\fP-\*(TX
+.if n .ds LZ LAmS-TeX
+.if t .ds OZ \
+\fIL\
+\\h'-0.3m'\\v'-0.21v'\s-2A\s0\\v'0.21v'\
+\\h'-0.15m'\\v'0.188v'M\\v'-0.188v'\
+\\h'-0.125m'S\
+\fP-\*(OX
+.if n .ds OZ LAmS-TeX
+.\"=====================================================================
+.SH NAME
+amslatex \- structured text formatting and typesetting
+.SH SYNOPSIS
+.B amslatex
+[ first-line ]
+.\"=====================================================================
+.SH DESCRIPTION
+\*(AY is an extension of \*(LX (see
+.IR "\*(LX \- A Document Preparation System" )
+that provides the powerful mathematical typesetting macros of
+\*(AX (see
+.IR "The Joy of \*(OX" )
+within the syntax of \*(LX. It should be contrasted with
+\*(LZ
+.RB ( lamstex (1)),
+which extends \*(AX with \*(LX-like features.
+.PP
+\*(AY documents can be processed
+by
+.BR latex (1),
+so a separate executable program named
+.B amslatex
+is not usually provided.
+.PP
+\*(AY is a \*(TX macro package, not a modification to the \*(TX source
+program, so all the capabilities described in
+.BR tex (1)
+are present.
+.PP
+The \*(AY macros encourage writers to think about the content of their
+documents, rather than the form. The ideal, not always realized, is to
+have no formatting commands (like ``switch to italic'' or ``skip 2
+picas'') in the document at all; instead, everything is done
+by specific markup instructions: ``emphasize'', ``start a section''.
+.PP
+\*(AX is the official typesetting system of the American Mathematical
+Society, and nearly all of its publications are typeset using \*(AX. The
+online version of AMS Math Reviews uses \*(AX input syntax for display of
+mathematical material. AMS authors can provide editors with
+computer-readable \*(AX or \*(AY files.
+.PP
+\*(AY will become deprecated in favor of \*(LX 2e, when the latter is
+released.
+.\"=====================================================================
+.SH FILES
+.TP \w'@@'u+2n
+.I "@DEFAULT_TEXMF@/doc/ams/amslatex/amsldoc.tex"
+Documentation for \*(AY, typesettable by \*(LX.
+This supersedes
+.IR "The Joy of \*(OX" ,
+but \*(AY users may still find that book a convenient supplement.
+.TP
+.I "@TEXINPUTDIR@/doc/ams/amslatex/testart.tex"
+Sample \*(LA document illustrating the
+.I amsart
+document style.
+.TP
+.I "@TEXINPUTDIR@/doc/ams/amslatex/testbook.tex"
+Sample \*(LA document illustrating the
+.I amsbook
+document style.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR amstex (1),
+.BR lamstex (1),
+.BR latex (1),
+.BR tex (1),
+.BR slitex (1).
+.br
+Leslie Lamport,
+.IR "\*(LX \- A Document Preparation System" ,
+Addison-Wesley, 1985, ISBN 0-201-15790-X.
+.br
+Michael Spivak,
+.IR "The Joy of \*(OX" ,
+2nd edition, Addison-Wesley, 1990, ISBN 0-8218-2997-1.
diff --git a/Build/source/texk/web2c/man/amstex.man b/Build/source/texk/web2c/man/amstex.man
new file mode 100644
index 00000000000..3119c898ee8
--- /dev/null
+++ b/Build/source/texk/web2c/man/amstex.man
@@ -0,0 +1,69 @@
+.TH AMSTEX 1 "27 December 1992" "Web2C @VERSION@"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.\"=====================================================================
+.SH NAME
+amstex \- structured text formatting and typesetting
+.SH SYNOPSIS
+.B amstex
+[ first line ]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The \*(AX language is described in the book
+.IR "The Joy of \*(OX" .
+\*(AX is a \*(TX macro package, not a modification to the \*(TX source
+program, so all the capabilities described in
+.BR tex (1)
+are present.
+.PP
+The \*(AX macros encourage writers to think about the content of their
+documents, rather than the form. The ideal, not always realized, is to
+have no formatting commands (like ``switch to italic'' or ``skip 2
+picas'') in the document at all; instead, everything is done
+by specific markup instructions: ``emphasize'', ``start a section''.
+.PP
+\*(AX is the official typesetting system of the American Mathematical
+Society, and nearly all of its publications are typeset using \*(AX. The
+online version of AMS Math Reviews uses \*(AX input syntax for display of
+mathematical material. AMS authors can provide editors with
+computer-readable \*(AX files.
+.PP
+For authors more familiar with \*(LX, an AMS-supported package called
+.I amsmath.sty
+is is available.
+.\"=====================================================================
+.SH FILES
+.TP
+.I amsguide.tex"
+Documentation for \*(AX, typesettable by \*(TX.
+.TP
+.I amfndoc.tex"
+Documentation for AMS fonts, typesettable by \*(TX.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR latex (1),
+.BR tex (1),
+.BR slitex (1).
+.br
+Michael Spivak,
+.IR "The Joy of \*(OX" ,
+2nd edition, Addison-Wesley, 1990, ISBN 0-8218-2997-1.
diff --git a/Build/source/texk/web2c/man/bibtex.man b/Build/source/texk/web2c/man/bibtex.man
new file mode 100644
index 00000000000..59b4034a847
--- /dev/null
+++ b/Build/source/texk/web2c/man/bibtex.man
@@ -0,0 +1,146 @@
+.TH BIBTEX 1 "24 November 1994" "Web2C @VERSION@"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\\s-2A\\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+bibtex \- make a bibliography for (La)TeX
+.SH SYNOPSIS
+.B bibtex
+[
+.BI -min-crossrefs =number
+]
+[
+.B -terse
+]
+[
+.I auxname
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+\*(BX reads the top-level auxiliary
+.RI ( .aux )
+file that was output during the running of
+.BR latex (1)
+or
+.BR tex (1)
+and creates a bibliography
+.RI ( .bbl )
+file that will be incorporated into the document on subsequent runs of
+\*(LX or \*(TX. The
+.I auxname
+on the command line must be given without the
+.I .aux
+extension. If you don't give the
+.IR auxname ,
+the program prompts you for it.
+.PP
+\*(BX looks up, in bibliographic database
+.RI ( .bib )
+files specified by the \\bibliography command,
+the entries specified by the \\cite and \\nocite commands
+in the \*(LX or \*(TX source file.
+It formats the information from those entries
+according to instructions in a bibliography style
+.RI ( .bst )
+file (specified by the \\bibliographystyle command,
+and it outputs the results to the
+.I .bbl
+file.
+.PP
+The \*(LX manual
+explains what a \*(LX source file must contain to work with \*(BX.
+Appendix B of the manual describes the format of the
+.I .bib
+files. The `\*(BXing' document describes extensions and details of
+this format, and it gives other useful hints for using \*(BX.
+.\"=====================================================================
+.SH OPTIONS
+The
+.B -min-crossrefs
+option defines the minimum number of
+.B crossref
+required for automatic inclusion of the crossref'd entry on the citation
+list; the default is two.
+With the
+.B -terse
+option, \*(BX operates silently. Without it, a banner and progress
+reports are printed on
+.IR stdout .
+.PP
+.\"=====================================================================
+.SH ENVIRONMENT
+\*(BX searches the directories in the
+path defined by the BSTINPUTS environment variable for
+.I .bst
+files. If BSTINPUTS is not set, it uses the system default.
+For
+.I .bib
+files, it uses the BIBINPUTS environment variable if that is set,
+otherwise the default.
+See
+.BR tex (1)
+for the details of the searching.
+.PP
+If the environment variable
+TEXMFOUTPUT is set, \*(BX attempts to put its output
+files in it, if they cannot be put in the current directory. Again, see
+.BR tex (1).
+No special searching is done for the
+.I .aux
+file.
+.\"=====================================================================
+.SH FILES
+.TP
+.I *.bst
+Bibliography style files.
+.TP
+.I btxdoc.tex
+``\*(BXing'' \- \*(LXable documentation for general \*(BX users
+.TP
+.I btxhak.tex
+``Designing \*(BX Styles'' \- \*(LXable documentation for style designers
+.TP
+.I btxdoc.bib
+database file for those two documents
+.TP
+.I xampl.bib
+database file giving examples of all standard entry types
+.TP
+.I btxbst.doc
+template file and documentation for the standard styles
+.PP
+All those files should be available somewhere on your system.
+.PP
+The host math.utah.edu has a vast collection of
+.I .bib
+files available for anonymous ftp, including references for all the
+standard \*(TX books and a complete bibliography for TUGboat.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR latex (1),
+.BR tex (1).
+.br
+Leslie Lamport,
+.IR "\*(LX \- A Document Preparation System" ,
+Addison-Wesley, 1985, ISBN 0-201-15790-X.
+.\"=====================================================================
+.SH AUTHOR
+Oren Patashnik, Stanford University. This man page describes the web2c
+version of \*(BX. Other ports of \*(BX, such as Donald Knuth's version
+using the Sun Pascal compiler, do not have the same path searching
+implementation, or the command-line options.
diff --git a/Build/source/texk/web2c/man/cweb.man b/Build/source/texk/web2c/man/cweb.man
new file mode 100644
index 00000000000..0e0cbf5b382
--- /dev/null
+++ b/Build/source/texk/web2c/man/cweb.man
@@ -0,0 +1,133 @@
+.TH CWEB 1 "19 December 2004" "Web2C @VERSION@"
+.
+.SH NAME
+ctangle, cweave \- translate CWEB to C and/or TeX
+.
+.SH SYNOPSIS
+.na
+.B ctangle
+[
+.B \-bhp
+] [
+.B +s
+] webfile[.w] [changefile[.ch]] [outputfile[.c]]
+.br
+.B cweave
+[
+.B \-befhpx
+] [
+.B +s
+] webfile[.w] [changefile[.ch]] [outputfile[.tex]]
+.ad
+.
+.SH DESCRIPTION
+The
+.I ctangle
+program converts a CWEB
+source document into a C\ program that may be compiled in the usual way.
+The output file includes #line specifications so that debugging can be
+done in terms of the CWEB source file.
+.PP
+The
+.I cweave
+program converts the same CWEB file into a TeX file that may be
+formatted and printed in the usual way.
+It takes appropriate care of typographic details like page
+layout and the use of indentation, italics, boldface, etc., and it supplies
+extensive cross-index information that it gathers automatically.
+.PP
+CWEB allows you to prepare a single
+document containing all the information that is needed both to produce
+a compilable C\ program and to produce a well-formatted document
+describing the program in as much detail as the writer may desire.
+The user of CWEB ought to be familiar with TeX as well as\ C.
+.PP
+The command line should have one, two, or three names on it.
+The first is taken as the CWEB file (and .w is added if there is no
+extension).
+If that file cannot be opened, the extension .web is tried instead.
+(But .w is recommended, since .web usually implies Pascal.)
+If there is a second name, it is a change file (and .ch is added if there is
+no extension).
+The change file overrides parts of the WEB file,
+as described in the documentation.
+If there is a third name, it overrides
+the default name of the output file, which is ordinarily the same as
+the name of the input file (but on the current directory) with the
+extension .c or .tex.
+.PP
+Options in the command line may be either turned off with\ \-
+(if they are on by default) or turned on with\ + (if they are off by
+default).
+In fact, the options are processed from left to right,
+so a sequence like -f\ +f corresponds to +f (which is the default).
+.PP
+The
+.B \-b
+option suppresses the banner line that normally appears on your terminal
+when ctangle or cweave begins.
+The
+.B \-h
+option suppresses the happy message that normally appears if the processing
+was successful.
+The
+.B \-p
+option suppresses progress reports (starred module numbers) as the processing
+takes place.
+If you say -bhp, you get nothing but error messages.
+.PP
+The
+.B +s
+option prints statistics about memory usage at the end of a run
+(assuming that the programs have been compiled with the -DSTAT switch).
+.PP
+There are three other options applicable to
+.I cweave
+only:
+.B \-f
+means do not force a newline after every statement in the formatted output.
+.B \-e
+inhibits the enclosure of C\ material formatted by
+.I cweave
+in brackets
+\ePB{...}.
+Such brackets are normally inserted so that special hooks
+can be used by
+.I cweb-latex
+and similar programs.
+.B \-x
+means omit the index and table of contents.
+.
+.SH FILES
+The location of the files mentioned below varies from system to
+system. Use the
+.B kpsewhich
+utility to find their locations.
+.TP
+.I cwebmac.tex
+TeX macros used by cweave output.
+.TP
+.I cwebman.tex
+The user manual.
+.
+.SH "SEE ALSO"
+.TP
+.I Literate Programming
+by D. E. Knuth
+.TP
+.I Weaving a Program
+by Wayne Sewell
+.TP
+.I The CWEB System of Structured Documentation
+by Donald E. Knuth and Silvio Levy (hardcopy version of cwebman.tex
+and the source code listings)
+.TP
+tex(1), cc(1)
+.
+.SH AUTHORS
+Don Knuth wrote WEB for TeX and Pascal.
+Silvio Levy designed and developed CWEB
+by adapting the WEB conventions to\ C and by recoding everything in CWEB.
+Knuth began using CWEB and made further refinements.
+Many other helpers are acknowledged in the CWEB manual.
+
diff --git a/Build/source/texk/web2c/man/dmp.man b/Build/source/texk/web2c/man/dmp.man
new file mode 100644
index 00000000000..44544157615
--- /dev/null
+++ b/Build/source/texk/web2c/man/dmp.man
@@ -0,0 +1,60 @@
+.TH DMP 1 "4 January 1998" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MP MetaPost
+.if t .ds MP MetaPost
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+dmp \- translate Troff output to low-level MetaPost input
+.SH SYNOPSIS
+.B dmp
+.RI [ option ]
+.I ditrofffile
+.RI [ mpxfile ]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B dmp
+program generates \*(MP source code from the
+.IR ditrofffile .
+The generated code is written in
+.I mpxfile
+if it is specified, and to standard output otherwise.
+.PP
+.B dmp
+is typically called from scripts like
+.BR makempx ,
+not from the command line.
+.\"=====================================================================
+.SH OPTIONS
+.B dmp
+accepts the following options:
+.TP
+.B --help
+.rb
+Print help message and exit.
+.TP
+.B --version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR mpost (1),
+.BR makempx (1).
diff --git a/Build/source/texk/web2c/man/dvicopy.man b/Build/source/texk/web2c/man/dvicopy.man
new file mode 100644
index 00000000000..bca57924070
--- /dev/null
+++ b/Build/source/texk/web2c/man/dvicopy.man
@@ -0,0 +1,22 @@
+.TH DVICOPY 1 TeX "24 January 1999" "Web2C @VERSION@"
+.SH NAME
+dvicopy \- produce modified copy of DVI file
+.SH SYNOPSIS
+.B dvicopy
+.RI [ options ]
+.RI [ infile\ [ outfile ]]
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+.B dvicopy
+reads a DVI file, expands any references to virtual fonts to base
+fonts, and writes the resulting DVI file. Thus you can use virtual
+fonts even if your DVI processor does not support them, by passing the
+documents through
+.B dvicopy
+first.
+.SH "SEE ALSO"
+dviselect(1)
diff --git a/Build/source/texk/web2c/man/dvitomp.man b/Build/source/texk/web2c/man/dvitomp.man
new file mode 100644
index 00000000000..a6b74030943
--- /dev/null
+++ b/Build/source/texk/web2c/man/dvitomp.man
@@ -0,0 +1,17 @@
+.TH DVITOMP 1 "October 30, 1999"
+.\" man page by Jim Van Zandt <jrv@vanzandt.mv.com> -*- nroff -*-
+.SH NAME
+dvitomp \- convert a TeX DVI file to a MetaPost MPXFILE
+.SH SYNOPSIS
+\fBdvitomp\fP [\fIoptions\fP] \fIdvifile\fP[.dvi] [\fImpxfile\fP[.mpx]]
+.SH DESCRIPTION
+\fBdvitomp\fP translates the given \fIdvifile\fP to a MetaPost
+MPXFILE. The default \fImpxfile\fP is the basename of \fIdvifile\fP
+extended with ".mpx".
+.SH OPTIONS
+.IP \fB-help\fP
+write usage summary and exit.
+.IP \fB-version\fP
+output version information and exit.
+.SH BUGS
+Email bug reports to tex-k@mail.tug.org.
diff --git a/Build/source/texk/web2c/man/dvitype.man b/Build/source/texk/web2c/man/dvitype.man
new file mode 100644
index 00000000000..cc93be28eea
--- /dev/null
+++ b/Build/source/texk/web2c/man/dvitype.man
@@ -0,0 +1,74 @@
+.TH DVITYPE 1 "19 December 1994" "Web2C @VERSION@"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+dvitype \- translate a dvi file for humans
+.SH SYNOPSIS
+.B dvitype
+.I dvi_name[.dvi]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B dvitype
+program translates a DVI (DeVice Independent) file output by (for example)
+.BR tex (1)
+or
+.BR gftodvi (1),
+to a file that humans can read. It also serves as a DVI file-validating
+program (i.e., if
+.B dvitype
+can read it, it's correct) and as an example of a DVI-reading
+program for future device drivers.
+.PP
+The output file can include all commands, just the important
+ones, or none at all (in which case only errors are reported).
+A subinterval of pages may be selected for transliteration; the
+magnification and resolution of the ``output device'' may be
+changed; and so on. All options are specified with an on-line dialog.
+.PP
+The
+.I .dvi
+extension is supplied if omitted from
+.IR dvi_name .
+The output goes to
+.IR stdout .
+.\"=====================================================================
+.SH ENVIRONMENT
+The environment variable TEXFONTS is used to search for the TFM files
+used in the DVI file. See
+.BR tex (1)
+for the details of the searching.
+If TEXFONTS is not set, it uses the system default.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR gftype (1),
+.BR pktype (1).
+.br
+Donald E. Knuth,
+.IR \*(OXware .
+.\"=====================================================================
+.SH BUGS
+The interactive dialog should be replaced by command-line options, as
+with
+.BR gftype .
+.SH AUTHORS
+Donald E. Knuth wrote the program. It was published as part of the
+.I \*(OXware
+technical report, available from the \*(TX Users Group.
+Howard Trickey and Pavel Curtis originally ported it to Unix.
diff --git a/Build/source/texk/web2c/man/eplain.man b/Build/source/texk/web2c/man/eplain.man
new file mode 100644
index 00000000000..e9a1805e022
--- /dev/null
+++ b/Build/source/texk/web2c/man/eplain.man
@@ -0,0 +1,103 @@
+.TH EPLAIN 1 "14 December 1993" "Web2C @VERSION@"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.\"=====================================================================
+.SH NAME
+eplain \- extended plain TeX
+.SH SYNOPSIS
+.B eplain
+[ first-line ]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+.B eplain
+is an extension of plain \*(TX described in the book
+.IR "\*(OX for the Impatient" .
+It adds these features (among others) to plain \*(TX:
+.TP \w'\(bu'u+2n
+\(bu
+left-justified displays
+.TP
+\(bu
+double-column output
+.TP
+\(bu
+tables of contents
+.TP
+\(bu
+.I \ehrule
+and
+.I \evrule
+with a different default than 0.4pt
+.TP
+\(bu
+time of day
+.TP
+\(bu
+verbatim file listing
+.TP
+\(bu
+generalized footnotes
+.TP
+\(bu
+blank and black boxes
+.TP
+\(bu
+citations using \*(BX
+.\"=====================================================================
+.SH FILES
+.TP
+.I eplain/doc/eplain.texi
+\*(TXable documentation of
+.B etex
+macros in
+.B texinfo
+format.
+.TP
+.I eplain.info*
+Online GNU Emacs
+.BR info (1)
+files produced from
+.IR eplain.texi .
+.PP
+The complete
+.I eplain
+distribution is available via anonymous ftp to the Internet host
+.I ftp.cs.umb.edu
+from the file
+.I pub/tex/eplain.tar.Z
+which is linked to another file containing the most recent version of
+the package. Major \*(TX archive sites should also have it.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR emacs (1),
+.BR info (1),
+.BR initex (1),
+.BR tex (1),
+.BR xinfo (1).
+.br
+Karl Berry,
+.IR eplain ,
+TUGboat 11(4), 571--572, 1990.
+.br
+Paul W. Abrahams with Karl Berry and Kathryn A. Hargreaves,
+.IR "\*(OX for the Impatient" ,
+Addison-Wesley, 1990, ISBN 0-201-51375-7.
diff --git a/Build/source/texk/web2c/man/etex.man b/Build/source/texk/web2c/man/etex.man
new file mode 100644
index 00000000000..dd9ff8c06d8
--- /dev/null
+++ b/Build/source/texk/web2c/man/etex.man
@@ -0,0 +1,429 @@
+.TH ETEX 1 "21 August 2004" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.\"=====================================================================
+.SH NAME
+etex, einitex, evirtex \- extended TeX
+.SH SYNOPSIS
+.B etex
+.RI [ options ]
+[\fB&\fR \fIformat\fR ]
+[ \fIfile\fR | \fB\e\fR \fIcommands\fR ]
+.\"=====================================================================
+.SH DESCRIPTION
+Run the e-\*(TX typesetter on
+.IR file ,
+usually creating
+.IR file.dvi .
+If the file argument has no extension, ".tex" will be appended to it.
+Instead of a filename, a set of e-\*(TX commands can be given, the first
+of which must start with a backslash.
+With a
+.BI & format
+argument e-\*(TX uses a different set of precompiled commands,
+contained in
+.IR format.fmt ;
+it is usually better to use the
+.B -fmt
+.I format
+option instead.
+.PP
+e-\*(TX is the first concrete result of an international research &
+development project, the NTS Project, which was established under the
+aegis of DANTE e.V. during 1992. The aims of the project are to
+perpetuate and develop the spirit and philosophy of \*(TX, whilst
+respecting Knuth's wish that \*(TX should remain frozen.
+.PP
+e-\*(TX can be used in two different modes: in
+.I compatibility mode
+it is supposed to be completely interchangable with standard \*(TX.
+In
+.I extended mode
+several new primitives are added that facilitate (among other things)
+bidirectional typesetting.
+.PP
+An extended mode format is generated by prefixing the name of the
+source file for the format with an asterisk (*). Such formats are
+often prefixed with an `e', hence
+.B etex
+as the extended version of
+.B tex
+and
+.B elatex
+as the extended version of
+.BR latex .
+However,
+.B eplain
+is an exception to this rule.
+.PP
+The
+.B einitex
+and
+.B evirtex
+commands are e-\*(TX's analogues to the
+.B initex
+and
+.B virtex
+commands. In this installation, they are symbolic links to the
+.B etex
+executable. These symbolic links may not exist at all.
+.PP
+e-\*(TX's handling of its command-line arguments is similar to that of
+the other \*(TX programs in the
+.I web2c
+implementation.
+.\"=====================================================================
+.SH OPTIONS
+This version of e-\*(TX understands the following command line options.
+.TP
+.BI -fmt \ format
+.rb
+Use
+.I format
+as the name of the format to be used, instead of the name by which
+e-\*(TX was called or a
+.I %&
+line.
+.TP
+.B -enc
+.rb
+Enable the enc\*(TX extensions. This option is only effective in
+combination with
+.BR -ini .
+For documentation of the enc\*(TX extensions see
+.BR http://www.olsak.net/enctex.html .
+.TP
+.B -etex
+.rb
+Enable the e-\*(TX extensions. This option is only effective in
+combination with
+.BR -ini .
+.TP
+.B -file-line-error
+.rb
+Print error messages in the form
+.I file:line:error
+which is similar to the way many compilers format them.
+.TP
+.B -no-file-line-error
+.rb
+Disable printing error messages in the
+.I file:line:error
+style.
+.TP
+.B -file-line-error-style
+.rb
+This is the old name of the
+.B -file-line-error
+option.
+.TP
+.B -halt-on-error
+.rb
+Exit with an error code when an error is encountered during processing.
+.TP
+.B -help
+.rb
+Print help message and exit.
+.TP
+.B -ini
+.rb
+Start in
+.I INI
+mode, which is used to dump formats. The
+.I INI
+mode can be used for typesetting, but no format is preloaded, and
+basic initializations like setting catcodes may be required.
+.TP
+.BI -interaction \ mode
+.rb
+Sets the interaction mode. The mode can be either
+.IR batchmode ,
+.IR nonstopmode ,
+.IR scrollmode ,
+and
+.IR errorstopmode .
+The meaning of these modes is the same as that of the corresponding
+\ecommands.
+.TP
+.B -ipc
+.rb
+Send DVI output to a socket as well as the usual output file. Whether
+this option is available is the choice of the installer.
+.TP
+.B -ipc-start
+.rb
+As
+.BR -ipc ,
+and starts the server at the other end as well. Whether this option
+is available is the choice of the installer.
+.TP
+.BI -jobname \ name
+.rb
+Use
+.I name
+for the job name, instead of deriving it from the name of the input file.
+.TP
+.BI -kpathsea-debug \ bitmask
+.rb
+Sets path searching debugging flags according to the bitmask. See the
+.I Kpathsea
+manual for details.
+.TP
+.BI -mktex \ fmt
+.rb
+Enable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.B -mltex
+.rb
+Enable ML\*(TX extensions. Only effective in combination with
+.BR -ini .
+.TP
+.BI -no-mktex \ fmt
+.rb
+Disable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.BI -output-comment \ string
+.rb
+Use
+.I string
+for the
+.I DVI
+file comment instead of the date.
+.TP
+.BI -output-directory \ directory
+.rb Write output files in
+.I directory
+instead of the current directory. Look up input files in
+.I directory
+first, the along the normal search path.
+.TP
+.B -parse-first-line
+.rb
+If the first line of the main input file begins with
+.I %&
+parse it to look for a dump name or a
+.B -translate-file
+option.
+.TP
+.B -no-parse-first-line
+.rb
+Disable parsing of the first line of the main input file.
+.TP
+.BI -progname \ name
+.rb
+Pretend to be program
+.IR name .
+This affects both the format used and the search paths.
+.TP
+.B -recorder
+.rb
+Enable the filename recorder. This leaves a trace of the files opened
+for input and output in a file with extension
+.IR .fls .
+.TP
+.B -shell-escape
+.rb
+Enable the
+.BI \ewrite18{ command }
+construct. The
+.I command
+can be any shell command. This construct is normally
+disallowed for security reasons.
+.TP
+.B -no-shell-escape
+.rb
+Disable the
+.BI \ewrite18{ command }
+construct, even if it is enabled in the
+.I texmf.cnf
+file.
+.TP
+.B -src-specials
+.rb
+Insert source specials into the
+.I DVI
+file.
+.TP
+.BI -src-specials \ where
+.rb
+Insert source specials in certain placed of the
+.I DVI
+file.
+.I where
+is a comma-separated value list:
+.IR cr ,
+.IR display ,
+.IR hbox ,
+.IR math ,
+.IR par ,
+.IR parent ,
+or
+.IR vbox .
+.TP
+.BI -translate-file \ tcxname
+.rb
+Use the
+.I tcxname
+translation table to set the mapping of input characters and
+re-mapping of output characters.
+.TP
+.BI -default-translate-file \ tcxname
+.rb
+Like
+.B -translate-file
+except that a
+.I %&
+line can overrule this setting.
+.TP
+.B -version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH ENVIRONMENT
+See the Kpathsearch library documentation (the `Path specifications'
+node) for precise details of how the environment variables are used.
+The
+.B kpsewhich
+utility can be used to query the values of the variables.
+.PP
+One caveat: In most e-\*(TX formats, you cannot use ~ in a filename you
+give directly to e-\*(TX, because ~ is an active character, and hence is
+expanded, not taken as part of the filename. Other programs, such as
+\*(MF, do not have this problem.
+.PP
+.TP
+TEXMFOUTPUT
+Normally, e-\*(TX puts its output files in the current directory. If
+any output file cannot be opened there, it tries to open it in the
+directory specified in the environment variable TEXMFOUTPUT.
+There is no default value for that variable. For example, if you say
+.I etex paper
+and the current directory is not writable, if TEXMFOUTPUT has
+the value
+.IR /tmp ,
+e-\*(TX attempts to create
+.I /tmp/paper.log
+(and
+.IR /tmp/paper.dvi ,
+if any output is produced.)
+.TP
+TEXINPUTS
+Search path for
+.I \einput
+and
+.I \eopenin
+files.
+This should probably start with ``.'', so
+that user files are found before system files. An empty path
+component will be replaced with the paths defined in the
+.I texmf.cnf
+file. For example, set TEXINPUTS to ".:/home/usr/tex:" to prepend the
+current direcory and ``/home/user/tex'' to the standard search path.
+.TP
+TEXFORMATS
+Search path for format files.
+.TP
+TEXPOOL
+search path for
+.B etex
+internal strings.
+.TP
+TEXEDIT
+Command template for switching to editor. The default, usually
+.BR vi ,
+is set when e-\*(TX is compiled.
+.TP
+TFMFONTS
+Search path for font metric
+.RI ( .tfm )
+files.
+.\"=====================================================================
+.SH FILES
+The location of the files mentioned below varies from system to
+system. Use the
+.B kpsewhich
+utility to find their locations.
+.TP
+.I etex.pool
+Text file containing e-\*(TX's internal strings.
+.TP
+.I texfonts.map
+Filename mapping definitions.
+.TP
+.I *.tfm
+Metric files for e-\*(TX's fonts.
+.TP
+.I *.fmt
+Predigested e-\*(TX format (.\|fmt) files.
+.br
+.\"=====================================================================
+.SH NOTES
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of e-\*(TX can be found in the info
+manual
+.IR "Web2C: A TeX implementation" .
+.\"=====================================================================
+.SH BUGS
+This version of e-\*(TX implements a number of optional extensions.
+In fact, many of these extensions conflict to a greater or lesser
+extent with the definition of e-\*(TX. When such extensions are
+enabled, the banner printed when e-\*(TX starts is changed to print
+.B e-TeXk
+instead of
+.BR e-TeX .
+.PP
+This version of e-\*(TX fails to trap arithmetic overflow when
+dimensions are added or subtracted. Cases where this occurs are rare,
+but when it does the generated
+.I DVI
+file will be invalid.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tex (1),
+.BR mf (1).
+.\"=====================================================================
+.SH AUTHORS
+e-\*(TX was developed by Peter Breitenlohner (and the NTS team).
+.PP
+\*(TX was designed by Donald E. Knuth,
+who implemented it using his \*(WB system for Pascal programs.
+It was ported to Unix at Stanford by Howard Trickey, and
+at Cornell by Pavel Curtis.
+The version now offered with the Unix \*(TX distribution is that
+generated by the \*(WB to C system
+.RB ( web2c ),
+originally written by Tomas Rokicki and Tim Morgan.
+.PP
+The enc\*(TX extensions were written by Petr Olsak.
diff --git a/Build/source/texk/web2c/man/gftodvi.man b/Build/source/texk/web2c/man/gftodvi.man
new file mode 100644
index 00000000000..eb152fe5f99
--- /dev/null
+++ b/Build/source/texk/web2c/man/gftodvi.man
@@ -0,0 +1,167 @@
+.TH GFTODVI 1 "14 December 1993" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+gftodvi \- make proof sheets from generic font files
+.SH SYNOPSIS
+.B gftodvi
+[
+.BI \-overflow-label-offset =real
+]
+[
+.B \-verbose
+]
+[
+.I gf_file_name
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B gftodvi
+program converts a generic font
+.RI ( gf )
+file output by, for example,
+.BR mf (1),
+to a device independent (DVI) file (that can then be typeset using the same
+software that has already been written for \*(TX). The characters in the
+.I gf
+file will appear one per page, with labels, titles, and annotations
+as specified in Appendix H (Hardcopy Proofs) of
+.IR "The \*(MFbook" .
+.PP
+.B gftodvi
+uses other fonts in addition to the main
+.I gf
+file.
+A `gray' font is used to typeset the
+pixels that actually make up the character. (We wouldn't
+want all the pixels to be simply black, since then labels,
+key points, and other information would be lost.) A `title' font
+is used for the information at the top of the page. A `label' font
+is used for the labels on key points of the figure. A `slant'
+font is used to typeset diagonal lines, which
+otherwise have to be simulated using horizontal and vertical rules.
+The default gray, title, and label fonts are
+.IR gray ,
+.IR cmr8 ,
+and
+.IR cmtt10 ,
+respectively; there is no default slant font.
+.PP
+To change the default fonts, you can give
+.BR special
+commands in your
+\*(MF source file, or you can change the fonts online. An online dialog
+ensues if you end the
+.I gf_file_name
+with a `/'. For example,
+.br
+.ti +2
+gftodvi cmr10.300gf/
+.br
+.ti +2
+Special font substitution: grayfont black
+.br
+.ti +2
+OK; any more? grayfontarea /home/art/don/
+.br
+.ti +2
+OK; any more? slantfont /home/fonts/slantimagen6
+.br
+.ti +2
+OK; any more? <RET>
+.br
+will use
+.I /home/art/don/black
+as the `gray' font and
+.I /home/fonts/slantimagen6
+as the `slant' font (this name indicates
+a font for lines with slope 1/6 at the resolution of an Imagen printer).
+.PP
+The
+.I gf_file_name
+on the command line must be complete. (The program prompts
+you for it if you don't give it.) Because
+the resolution is part of the extension, it would not make
+sense to append a default extension as is done with \*(TX or
+DVI-reading software. The output file name defaults to the same
+root as the
+.I gf
+file, with the
+.I dvi
+extension added. For example, the input file
+.I cmr10.2602gf
+would become
+.IR cmr10.dvi .
+.\"=====================================================================
+.SH OPTIONS
+The argument to
+.B \-overflow-label-offset
+specifies the distance from the right edge of the character
+bounding box at which the overflow equations (if any) are typeset.
+The value is given in \*(TX points. The default is a little over two
+inches.
+.PP
+Without the
+.B \-verbose
+option,
+.B gftodvi
+operates silently. With it, a banner and progress report are printed on
+.IR stdout .
+.\"=====================================================================
+.SH ENVIRONMENT
+.B gftodvi
+looks for
+.I gf_file_name
+using the
+environment variable GFFONTS. If that is not set, it uses the variable
+TEXFONTS. If that is not set, it uses the system default.
+.PP
+See
+.BR tex (1)
+for the details of the searching.
+.\"=====================================================================
+.SH FILES
+.TP
+.I {gray.tfm,.\|.\|.}
+The default fonts.
+.TP
+.I {gray.mf,.\|.\|.}
+The \*(MF sources.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tex (1),
+.BR mf (1).
+.br
+Donald E. Knuth,
+.I "The \*(MFbook"
+(Volume C of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13445-4.
+.br
+Donald E. Knuth et al.,
+.IR \*(MFware .
+.\"=====================================================================
+.SH AUTHORS
+Donald E. Knuth wrote the program. It was published as part of the
+.I \*(MFware
+technical report, available from the \*(TX Users Group.
+Paul Richards ported it to Unix.
diff --git a/Build/source/texk/web2c/man/gftopk.man b/Build/source/texk/web2c/man/gftopk.man
new file mode 100644
index 00000000000..4ac55f79b67
--- /dev/null
+++ b/Build/source/texk/web2c/man/gftopk.man
@@ -0,0 +1,103 @@
+.TH GFTOPK 1 "14 December 1993" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+gftopk \- convert generic font files to packed font files
+.SH SYNOPSIS
+.B gftopk
+[
+.B \-v
+]
+.I gf_file_name
+[
+.I pk_file_name
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B gftopk
+program converts a generic font file output by, for example,
+.BR mf (1),
+to a
+packed font file for use by DVI-reading programs. Packed
+font files
+.RI ( pk " files)"
+are much smaller than the corresponding
+.I gf
+files,
+so they are generally the font format of choice.
+.PP
+The
+.I gf_file_name
+on the command line must be complete. Because
+the resolution is part of the extension, it would not make
+sense to append a default extension as is done with \*(TX or
+DVI-reading software. The
+.I pk_file_name
+defaults to the same (stripped) name as
+.IR gf_file_name ,
+and it is placed in the current
+working directory with the
+.I pk
+suffix replacing
+.IR gf .
+For example, the input file
+.I cmr10.300gf
+would become
+.IR cmr10.300pk .
+.\"=====================================================================
+.SH OPTIONS
+Unless the
+.B \-v
+switch is given,
+.B gftopk
+operates silently. With
+.BR \-v ,
+the version number of the program and statistics about the
+packing are output to
+.IR stdout .
+.\"=====================================================================
+.SH ENVIRONMENT
+.B gftopk
+looks for
+.I gf_file_name
+first in the current directory. If it is not present there, it uses the
+environment variable GFFONTS. If that is not set, it uses the variable
+TEXFONTS. If that is not set, it uses the system default.
+.PP
+See
+.BR tex (1)
+for the details of the searching.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR gftype (1),
+.BR pktogf (1),
+.BR pktype (1).
+.br
+Donald E. Knuth et al.,
+.IR \*(MFware .
+.\"=====================================================================
+.SH AUTHORS
+Tomas Rokicki wrote the program. It was published as
+part of the
+.I \*(MFware
+technical report, available from the \*(TX Users Group.
+Paul Richards originally ported it to Unix.
diff --git a/Build/source/texk/web2c/man/gftype.man b/Build/source/texk/web2c/man/gftype.man
new file mode 100644
index 00000000000..f88c5c08ebc
--- /dev/null
+++ b/Build/source/texk/web2c/man/gftype.man
@@ -0,0 +1,97 @@
+.TH GFTYPE 1 "14 December 1993" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+gftype \- translate a generic font file for humans to read
+.SH SYNOPSIS
+.B gftype
+[
+.B \-i
+]
+[
+.B \-m
+]
+.I gf_file_name
+[
+.I output_file_name
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B gftype
+program
+translates a
+.I gf
+(generic font) file output by, for example,
+.BR mf (1),
+to a file that humans can read.
+It also serves as a
+.I gf
+file-validating
+program (i.e., if
+.B gftype
+can read it, it's correct) and as an example of a
+.IR gf -reading
+program for other software that wants to read
+.I gf
+files.
+.PP
+The
+.I gf_file_name
+on the command line must be complete. Because
+the resolution is part of the extension, it would not make
+sense to append a default extension as is done with \*(TX or
+DVI-reading software. If no
+.I output_file_name
+is specified, the output goes to
+.IR stdout .
+.\"=====================================================================
+.SH OPTIONS
+The output file includes
+bitmap images of the characters, if
+.B \-i
+is given on the command line, and a symbolic listing of the
+.I gf
+commands, if
+.B \-m
+is specified.
+.\"=====================================================================
+.SH ENVIRONMENT
+.B gftype
+looks for
+.I gf_file_name
+using the
+environment variable GFFONTS. If that is not set, it uses the variable
+TEXFONTS. If that is not set, it uses the system default.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR dvitype (1),
+.BR pktype (1).
+.br
+Donald E. Knuth et al.,
+.IR \*(MFware .
+.\"=====================================================================
+.SH AUTHORS
+David Fuchs and Don Knuth wrote the program. It was published as
+part of the
+.I \*(MFware
+technical report, available from the \*(TX Users Group.
+Paul Richards originally ported it to Unix.
diff --git a/Build/source/texk/web2c/man/initex.min b/Build/source/texk/web2c/man/initex.min
new file mode 100644
index 00000000000..3fdff8763c0
--- /dev/null
+++ b/Build/source/texk/web2c/man/initex.min
@@ -0,0 +1,147 @@
+.TH INITEX 1 "27 December 1992"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+initex \- initial TeX for making format (.fmt) files
+.SH DESCRIPTION
+.B initex
+is a special version of the \*(TX program that has
+no preloaded macro packages, but is capable of
+converting a macro package into a special
+preformatted binary file, called a
+.I format
+.RI ( .fmt )
+file. That format file can subsequently be read
+at high speed by
+.BR virtex .
+.PP
+Major macro packages may require \*(TX to process
+many thousands of lines of macros, and open and
+read scores of font files, all of which would
+contribute to a sizable startup overhead if the
+job had to be done every time \*(TX was run.
+.B initex
+allows \*(TX to do the job once, and then save the
+results in a binary format file that can be later
+loaded more rapidly by
+.BR virtex .
+.PP
+.B initex
+is normally required only at the time \*(TX is
+installed, or whenever major macro packages are
+updated. Thus, it will be rare for anyone but
+system installers to invoke it. Nevertheless, it
+is just a normal program without special
+privileges, so ordinary users can use it to
+prepare a private format file.
+.PP
+Here is how you can ask
+.B initex
+to prepare format files for several major
+packages:
+.PP
+For plain
+.BR tex :
+.RS
+.nf
+.I "initex 'plain \\\\dump'"
+.I "mv plain.fmt tex.fmt"
+.fi
+The single quotes are necessary to protect
+the backslash from interpretation as a Unix shell
+escape character.
+.RE
+.PP
+For
+.BR amstex :
+.RS
+.nf
+.I "initex '&tex amstex \\\\dump'"
+.fi
+The single quotes around the first argument
+protect the ampersand from interpretation as a
+Unix shell background request.
+.RE
+.PP
+For
+.BR etex :
+.RS
+.nf
+.I "initex '&tex eplain \\\\dump'"
+.I "mv eplain.fmt etex.fmt"
+.fi
+.RE
+.PP
+For
+.BR lamstex :
+.RS
+.nf
+.I "initex '&tex amstexl \\\\input lamstex \\\\dump'"
+.I "mv amstexl.fmt lamstex.fmt"
+.fi
+.RE
+.PP
+For
+.BR latex :
+.RS
+.nf
+.I "initex 'lplain \\\\dump'"
+.I "mv lplain.fmt latex.fmt"
+.fi
+.RE
+.PP
+For
+.BR slitex :
+.RS
+.nf
+.I "initex 'splain \\\\dump'"
+.I "mv splain.fmt slitex.fmt"
+.fi
+.RE
+.PP
+For
+.BR texinfo :
+.RS
+.nf
+.I "initex '&tex texinfo @dump'"
+.fi
+The last argument is different from the previous
+examples because
+.B texinfo
+redefines the \*(TX escape character from
+backslash to at-sign. As for
+.BR amstex ,
+the file
+.I tex.fmt
+must already be available.
+.RE
+.PP
+Note that several of these require that the format file for plain
+\*(TX be available, since the first argument word
+.I &tex
+asks for the loading of the file
+.IR tex.fmt .
+.PP
+It does not matter whether the command-line arguments are passed as a
+single argument, or as separate arguments, since \*(TX reconstructs
+the command line anyway.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR amslatex (1),
+.BR amstex (1),
+.BR lamstex (1),
+.BR latex (1),
+.BR slitex (1),
+.BR tex (1),
+.BR virtex (1).
diff --git a/Build/source/texk/web2c/man/lamstex.min b/Build/source/texk/web2c/man/lamstex.min
new file mode 100644
index 00000000000..59abcb4747c
--- /dev/null
+++ b/Build/source/texk/web2c/man/lamstex.min
@@ -0,0 +1,67 @@
+.TH LAMSTEX 1 "27 December 1992"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.if t .ds LZ \
+\fRL\
+\\h'-0.3m'\\v'-0.21v'\s-2A\s0\\v'0.21v'\
+\\h'-0.15m'\\v'0.188v'M\\v'-0.188v'\
+\\h'-0.125m'S\
+\fP-\*(TX
+.if n .ds LZ LAmS-TeX
+.if t .ds OZ \
+\fIL\
+\\h'-0.3m'\\v'-0.21v'\s-2A\s0\\v'0.21v'\
+\\h'-0.15m'\\v'0.188v'M\\v'-0.188v'\
+\\h'-0.125m'S\
+\fP-\*(OX
+.if n .ds OZ LAmS-TeX
+.\"=====================================================================
+.SH NAME
+lamstex \- structured text formatting and typesetting
+.SH SYNOPSIS
+.B lamstex
+[ first-line ]
+.\"=====================================================================
+.SH DESCRIPTION
+The \*(LZ language is described in the book
+.IR "\*(OZ: The Synthesis" .
+\*(LZ is a new system that augments \*(AX with \*(LX-like features,
+but retains the syntactical flavor of \*(AX. It can be compared with
+\*(AY, which augments \*(LX with \*(AX-like features.
+.PP
+\*(LZ is a \*(TX macro package, not a modification to the \*(TX source
+program, so all the capabilities described in
+.BR tex (1)
+are present.
+.PP
+The \*(LZ macros encourage writers to think about the content of their
+documents, rather than the form. The ideal, not always realized, is to
+have no formatting commands (like ``switch to italic'' or ``skip 2
+picas'') in the document at all; instead, everything is done
+by specific markup instructions: ``emphasize'', ``start a section''.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR amslatex (1),
+.BR amstex (1),
+.BR latex (1),
+.BR tex (1),
+.BR slitex (1).
+.br
+Michael Spivak,
+.IR "\*(OZ: The Synthesis" ,
+The \*(TXplorators Corporation, 3701 W. Alabama, Suite 450-273,
+Houston, TX 77027, USA, 1989.
diff --git a/Build/source/texk/web2c/man/latex.man b/Build/source/texk/web2c/man/latex.man
new file mode 100644
index 00000000000..73f4b5ad9e5
--- /dev/null
+++ b/Build/source/texk/web2c/man/latex.man
@@ -0,0 +1,70 @@
+.TH LATEX 1 "29 March 1999" "Web2C @VERSION@"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP\" for troff
+.el .ds OX TeX\" for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+latex, elatex, lambda, pdflatex \- structured text formatting and typesetting
+.SH SYNOPSIS
+.B latex
+[ first line ]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The \*(LX language is described in the book
+.IR "\*(LX \- A Document Preparation System" .
+\*(LX is a \*(TX macro package, not a modification to the \*(TX source
+program, so all the capabilities described in
+.BR tex (1)
+are present.
+.PP
+The \*(LX macros encourage writers to think about the content of their
+documents, rather than the form. The ideal, very difficult to realize, is to
+have no formatting commands (like ``switch to italic'' or ``skip 2
+picas'') in the document at all; instead, everything is done
+by specific markup instructions: ``emphasize'', ``start a section''.
+.PP
+The primary source of documentation for \*(LX is the \*(LX manual
+referenced below, and the local guide in the file
+.I local-guide.tex
+or
+.I local.tex
+or some such.
+.PP
+.B elatex
+is the e-\*(TX extended mode version of \*(LX format.
+.PP
+.B lambda
+is the Omega version of the \*(LX format.
+.PP
+.B pdflatex
+is the pdf\*(TX version of the \*(LX format.
+.PP
+On some systems
+.B latex209
+and
+.B slitex
+are available for compatibility with older versions of \*(LX. These
+should not be used for new texts.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR amslatex (1),
+.BR amstex (1),
+.BR tex (1),
+.br
+Leslie Lamport,
+.IR "\*(LX \- A Document Preparation System" ,
+Addison-Wesley, 1985, ISBN 0-201-15790-X.
diff --git a/Build/source/texk/web2c/man/makempx.man b/Build/source/texk/web2c/man/makempx.man
new file mode 100644
index 00000000000..193d6c42736
--- /dev/null
+++ b/Build/source/texk/web2c/man/makempx.man
@@ -0,0 +1,89 @@
+.TH MAKEMPX 1 "4 January 1998" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MP MetaPost
+.if t .ds MP MetaPost
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+makempx \- typeset labels in MetaPost pictures with TeX or Troff
+.SH SYNOPSIS
+.B makempx
+.RI [ --tex | --troff ]
+.I mpfile mpxfile
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+If
+.I mpxfile
+is older than
+.IR mpfile ,
+translate the labels from the \*(MP input file
+.I mpfile
+to low-level commands in
+.IR MPXFILE ,
+by running
+.BR "mpto -tex" ,
+.BR tex ,
+and
+.B dvitomp
+by default; or, if
+.B -troff
+is specified,
+.BR "mpto -troff" ,
+.BR "eqn -d\e$\e$ | troff -Tpost" ,
+and
+.BR dmp .
+.PP
+The current directory is used for writing temporary files. Errors are
+left in
+.IR mpxerr.{tex,log,dvi} .
+.PP
+If the file named in
+.I $MPTEXPRE
+(mptexpre.tex by default) exists, it is prepended to the output in tex
+mode.
+.PP
+.B makempx
+is typically called by
+.BR mpost ,
+not from the command line.
+.\"=====================================================================
+.SH OPTIONS
+.B makempx
+accepts the following options:
+.TP
+.B --help
+.rb
+Print help message and exit.
+.TP
+.B --tex
+.rb
+Assume input file contains \*(TX commands.
+.TP
+.B --troff
+.rb
+Assume input file contains Troff commands.
+.TP
+.B --version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR mpost (1),
+.BR mpto (1).
diff --git a/Build/source/texk/web2c/man/mf.man b/Build/source/texk/web2c/man/mf.man
new file mode 100644
index 00000000000..f535a37252c
--- /dev/null
+++ b/Build/source/texk/web2c/man/mf.man
@@ -0,0 +1,501 @@
+.\" t
+.TH MF 1 "10 November 2001" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if n .ds WB Web
+.if t .ds WB W\s-2EB\s0
+.\"=====================================================================
+.SH NAME
+mf, mf-nowin, inimf, virmf \- Metafont, a language for font and logo design
+.SH SYNOPSIS
+.B mf
+.RI [ options ]
+.RI [ commands ]
+.\"=====================================================================
+.SH DESCRIPTION
+\*(MF reads the program in the specified files
+and outputs font rasters (in
+.I gf
+format) and font metrics (in
+.I tfm
+format). The \*(MF
+language is described in
+.IR "The \*(MF\^book" .
+.PP
+Like
+\*(TX, \*(MF
+is normally used with a large body of precompiled macros, and font generation
+in particular requires the support of several macro files. This
+version of \*(MF looks at its command line to see what name it was
+called under. Both
+.B inimf
+and
+.B virmf
+are symlinks to the
+.B mf
+executable. When called as
+.BR inimf
+(or when the
+.B -ini
+option is given) it can be used to precompile macros into a
+.I .base
+file. When called as
+.B virmf
+it will use the
+.I plain
+base. When called under any other name, \*(MF will use that name as
+the name of the base to use. For example, when called as
+.B mf
+the
+.I mf
+base is used, which is identical to the
+.I plain
+base. Other bases than
+.I plain
+are rarely used.
+.PP
+The
+.I commands
+given on the command line to the \*(MF program are passed to it as the
+first input line. (But it is often easier to type extended arguments
+as the first input line, since UNIX shells tend to gobble up or
+misinterpret \*(MF's favorite symbols, like semicolons, unless you
+quote them.) As described in
+.IR "The \*(MF\^book" ,
+that first line should begin with a filename, a
+.RI \e controlsequence ,
+or a
+.IR &basename .
+.PP
+The normal usage is to say
+.IP
+\fBmf\ \fP '\\\|mode=<printengine>\^;\^ [\^mag=magstep(\fI\^n\fP\^)\^;\^]' input\ \^\fI font \fP
+.PP
+to start processing
+.IR font.mf .
+The single quotes are the best way of keeping the Unix
+shell from misinterpreting the semicolons and
+from removing the \\ character, which is needed here to
+keep \*(MF from thinking that you want to produce a font called
+.IR mode .
+(Or you can just say
+.I mf
+and give the other stuff on the next line, without quotes.) Other
+control sequences, such as
+.I batchmode
+(for silent operation) can also appear.
+The name
+.I font
+will be the ``jobname'', and is used in forming
+output file names.
+If \*(MF doesn't get a file name in the first line,
+the jobname is
+.IR mfput .
+The default extension,
+.IR .mf ,
+can be overridden by specifying an extension explicitly.
+.PP
+A log of error messages goes into the file \fIjobname\fP\fB\^.\^\fP\fIlog\fP.
+The output files are \fIjobname\fP\fB\^.\^\fP\fItfm\fP and
+\fIjobname\fP\fB\^.\^\fP\fI<\fP\^number\^\fI>gf\fP, where <number> depends on
+the resolution and magnification of the font. The
+.I mode
+in this
+example is shown generically as <printengine>, a symbolic term for which
+the name of an actual device or, most commonly, the name
+.I localfont
+(see below) must
+be substituted. If the mode is not specified or is not valid for your
+site, \*(MF will default to
+.I proof
+mode which produces
+large character images for use in font design and refinement. Proof
+mode can be recognized by the suffix
+.I .2602gf
+after the jobname. Examples of proof mode output can be found
+in
+.I "Computer Modern Typefaces"
+(Volume E of
+.IR "Computers and Typesetting" ).
+The system of
+.I magsteps
+is identical to the system used by
+\*(TX,
+with values generally in the range 0.5, 1.0, 2.0, 3.0, 4.0 and 5.0.
+A listing of
+.I gf
+numbers for 118-dpi, 240-dpi and 300-dpi fonts
+is shown below.
+.TS
+tab(:);
+c c c c
+l l l l.
+MAGSTEP:118 dpi:240 dpi:300 dpi
+mag=magstep(0):118:240:300
+mag=magstep(0.5):129:263:329
+mag=magstep(1):142:288:360
+mag=magstep(2):170:346:432
+mag=magstep(3):204:415:518
+mag=magstep(4):245:498:622
+mag=magstep(5):294:597:746
+.TE
+.PP
+Magnification can also be specified not as a magstep but as an
+arbitrary value, such as 1.315, to create special character sizes.
+.PP
+Before font production can begin, it is necessary to set up the
+appropriate base files. The minimum set of components for font
+production for a given print-engine is the
+.I plain.mf
+macro file
+and the local
+.I mode_def
+file. The macros in
+.I plain.mf
+can be
+studied in an appendix to the
+.IR "\*(MF\^book" ;
+they were developed by Donald E. Knuth, and this file should never be
+altered except when it is officially upgraded.
+Each
+.I mode_def
+specification helps adapt fonts to a particular print-engine.
+There is a regular discussion of
+.IR mode_def s
+in
+.IR TUGboat ,
+the journal of the
+\*(TX
+Users Group.
+The local ones in use on this computer should be in
+.IR modes.mf .
+.PP
+The
+.I e
+response to \*(MF\|'s error-recovery mode invokes the
+system default
+editor at the erroneous line of the source file.
+There is an environment variable, MFEDIT,
+that overrides the default editor.
+It should contain a string with "%s" indicating where the
+filename goes and "%d" indicating where the decimal linenumber (if any) goes.
+For example, an MFEDIT string for the
+.B vi
+editor can be set with the
+.B csh
+command
+.RS
+\fIsetenv MFEDIT "vi +%d %s"\fP
+.RE
+.PP
+A convenient file in the library is
+.IR null.mf ,
+containing nothing.
+When
+.B mf
+can't find the file it thinks you want to input, it keeps
+asking you for another file name; responding `null' gets you out
+of the loop if you don't want to input anything.
+.\"=====================================================================
+.SH "ONLINE GRAPHICS OUTPUT"
+\*(MF can use most modern displays, so you can see its output
+without printing. Chapter 23 of
+.I "The \*(MF\^book"
+describes what you can do. This implementation of \*(MF uses
+environment variables to determine which display device you want to use.
+First it looks for a variable MFTERM, and then for TERM.
+If it can't find either, you get no online output. Otherwise, the value
+of the variable determines the device to use:
+.BR hp2627 ,
+.B sun
+(for old SunView),
+.BR tek ,
+.B uniterm
+(for an Atari ST Tek 4014 emulator),
+.B xterm
+(for either X10 or X11).
+Some of these devices may not be supported in all \*(MF
+executables; the choice is made at compilation time.
+.PP
+On some systems, there are two \*(MF binaries,
+.B mf
+and
+.BR mf-nowin .
+On those systems the
+.B mf
+binary supports graphics, while the
+.B mf-nowin
+binary does not. The
+.B mf-nowin
+binary is used by scripts like
+.B mktexpk
+where graphics support is a nuisance rather than something helpful.
+.\"=====================================================================
+.SH OPTIONS
+This version of \*(MF understands the following command line options.
+.TP
+.BI -base \ base
+.rb
+Use
+.I base
+as the name of the base to be used, instead of the name by which
+\*(MF was called or a
+.I %&
+line.
+.TP
+.B -file-line-error
+.rb
+Print error messages in the form
+.I file:line:error
+which is similar to the way many compilers format them.
+.TP
+.B -no-file-line-error
+.rb
+Disable printing error messages in the
+.I file:line:error
+style.
+.TP
+.B -file-line-error-style
+.rb
+This is the old name of the
+.B -file-line-error
+option.
+.TP
+.B -halt-on-error
+.rb
+Exit with an error code when an error is encountered during processing.
+.TP
+.B -help
+.rb
+Print help message and exit.
+.TP
+.B -ini
+.rb
+Be
+.BR inimf ,
+for dumping bases; this is implicitly true if the program is called
+as
+.BR inimf .
+.TP
+.BI -interaction \ mode
+.rb
+Sets the interaction mode. The mode can be one of
+.IR batchmode ,
+.IR nonstopmode ,
+.IR scrollmode ,
+and
+.IR errorstopmode .
+The meaning of these modes is the same as that of the corresponding
+commands.
+.TP
+.BI -jobname \ name
+.rb
+Use
+.I name
+for the job name, instead of deriving it from the name of the input file.
+.TP
+.BI -kpathsea-debug \ bitmask
+.rb
+Sets path searching debugging flags according to the bitmask. See the
+.I Kpathsea
+manual for details.
+.TP
+.BI -maketex \ fmt
+.rb
+Enable
+.RI mktex fmt ,
+where
+.I fmt
+must be
+.IR mf .
+.TP
+.BI -no-maketex \ fmt
+.rb
+Disable
+.RI mktex fmt ,
+where
+.I fmt
+must be
+.IR mf .
+.TP
+.BI -output-directory \ directory
+.rb Write output files in
+.I directory
+instead of the current directory. Look up input files in
+.I directory
+first, the along the normal search path.
+.TP
+.B -parse-first-line
+.rb
+If the first line of the main input file begins with
+.I %&
+parse it to look for a dump name or a
+.B -translate-file
+option.
+.TP
+.B -no-parse-first-line
+.rb
+Disable parsing of the first line of the main input file.
+.TP
+.BI -progname \ name
+.rb
+Pretend to be program
+.IR name .
+This affects both the format used and the search paths.
+.TP
+.B -recorder
+.rb
+Enable the filename recorder. This leaves a trace of the files opened
+for input and output in a file with extension
+.IR .fls .
+.TP
+.BI -translate-file \ tcxname
+.rb
+Use the
+.I tcxname
+translation table.
+.TP
+.B -version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH ENVIRONMENT
+See the Kpathsearch library documentation (the `Path specifications'
+node) for the details of how the environment variables are use when
+searching. The
+.B kpsewhich
+utility can be used to query the values of the variables.
+.PP
+If the environment variable
+TEXMFOUTPUT is set, \*(MF attempts to put its output
+files in it, if they cannot be put in the current directory. Again, see
+.BR tex (1).
+.TP
+MFINPUTS
+Search path for
+.I input
+and
+.I openin
+files.
+.TP
+MFEDIT
+Command template for switching to editor.
+.TP
+MFTERM
+Determines the online graphics display. If MFTERM is not set,
+and DISPLAY is set, the Metafont window support for X is used.
+(DISPLAY must be set to a valid X server specification, as usual.)
+If neither MFTERM nor DISPLAY is set, TERM is used to guess the window
+support to use.
+.\"=====================================================================
+.SH "FONT UTILITIES"
+A number of utility programs are available.
+The following is a partial list of available utilities and their purpose.
+Consult your local \*(MF guru for details.
+.br
+.TP \w'gftodvi'u+2n
+.B gftopk
+Takes a
+.I gf
+file and produces a more tightly packed
+.I pk
+font file.
+.TP
+.B gftodvi
+Produces proof sheets for fonts.
+.TP
+.B gftype
+Displays the contents of a
+.I gf
+file in mnemonics and/or images.
+.TP
+.B pktype
+Mnemonically displays the contents of a
+.I pk
+file.
+.TP
+.B mft
+Formats a source file as shown in
+.IR "Computer Modern Typefaces" .
+.\"=====================================================================
+.SH "FILES"
+.TP
+.I "mf.pool"
+Encoded text of \*(MF's messages.
+.TP
+.I *.base
+Predigested \*(MF base files.
+.TP
+.I $TEXMFMAIN/metafont/base/plain.mf
+The standard base.
+.TP
+.I $TEXMFMAIN/metafont/misc/modes.mf
+The file of
+.IR mode_def s
+for your site's various printers
+.\"=====================================================================
+.SH NOTES
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(MF can be found in the info manual
+.IR "Web2C: A TeX implementation" .
+.\"=====================================================================
+.SH BUGS
+On January 4, 1986 the ``final'' bug in \*(MF was discovered
+and removed. If an error still lurks in the code, Donald E. Knuth promises to
+pay a finder's fee which doubles every year to the first person who finds
+it. Happy hunting.
+.\"=====================================================================
+.SH "SUGGESTED READING"
+Donald E. Knuth,
+.I "The \*(MF\^book"
+(Volume C of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13445-4.
+.br
+Donald E. Knuth,
+.I "\*(MF:\^ The Program"
+(Volume D of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13438-1.
+.br
+Donald E. Knuth,
+.I Computer Modern Typefaces
+(Volume E of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13446-2.
+.br
+.I TUGboat
+(the journal of the \*(TX Users Group).
+.\"=====================================================================
+.SH COMMENTS
+Warning: ``Type design can be hazardous to your other interests.
+Once you get hooked, you will develop intense feelings about letterforms;
+the medium will intrude on the messages that you read.
+And you will perpetually be thinking of improvements to the fonts that
+you see everywhere, especially those of your own design.''
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR gftopk (1),
+.BR gftodvi (1),
+.BR gftype (1),
+.BR mft (1),
+.BR pltotf (1),
+.BR tftopl (1).
+.\"=====================================================================
+.SH AUTHORS
+\*(MF was designed by Donald E. Knuth, who implemented it
+using his \*(WB system for Pascal programs. It was originally
+ported to Unix by Paul Richards at the University of Illinois at
+Urbana-Champaign. This page was mostly written by Pierre MacKay.
diff --git a/Build/source/texk/web2c/man/mft.man b/Build/source/texk/web2c/man/mft.man
new file mode 100644
index 00000000000..cedecd79630
--- /dev/null
+++ b/Build/source/texk/web2c/man/mft.man
@@ -0,0 +1,134 @@
+.TH MFT 1 "14 December 1993" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+mft \- translate Metafont code to TeX code for prettyprinting
+.SH SYNOPSIS
+.B mft
+.I mf_file_name[.mf]
+[
+[
+.B \-c
+]
+or
+[
+.I change_file_name[.ch]
+]
+]
+[
+[
+.B \-s
+]
+or
+[
+.I style_file_name[.mft]
+]
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B mft
+program creates a \*(TX file from a \*(MF program.
+It takes appropriate care of typographic details like page
+layout and the use of indentation, italics, boldface, etc., as illustrated
+in the book
+.IR "Computer Modern Typefaces" .
+Special conventions in \*(MF comments allow you to control things that
+would not otherwise come out right; section 1 of the MFT source program
+in the
+.I \*(MFware
+report explains these rules.
+.PP
+The command line has one required file name and two optional file names.
+The required
+one is a \*(MF source file; there is also an optional change file
+(which works just as the change files to
+.BR tangle (1)
+and
+.BR weave (1)
+do)
+and an optional style file (which is prepended to everything).
+.PP
+A file name that doesn't contain a dot is always given an extension,
+either
+.I .mf
+(\*(MF) or
+.I .ch
+(change) or
+.I .mft
+(style). If no style file is specified, the style file
+.I plain.mft
+is automatically used. The
+.I change_file_name
+is not searched for using any paths. The
+.I .mf
+file is searched for using the MFINPUTS environment variable if you
+have set it, or else the system default. The style file is searched
+for using the TEXINPUTS environment variable. See
+.BR tex (1)
+for the details of the searching.
+.PP
+The output \*(TX file name is formed by using
+.I .tex
+in place of the extension of
+.IR mf_file_name .
+.\"=====================================================================
+.SH OPTIONS
+Specify command-line options
+.B \-c
+to suppress the reading of a change file, and
+.B \-s
+to suppress the reading of a style file.
+.\"=====================================================================
+.SH FILES
+.TP
+.I mftmac.tex
+\*(TX macros used by
+.B mft
+output.
+.TP
+.I plain.mft
+Default style file.
+.TP
+.I cmbase.mft
+Style file for Computer Modern.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR mf (1),
+.BR weave (1).
+.br
+Donald E. Knuth,
+.I Computer Modern Typefaces
+(Volume E of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13446-2.
+.br
+Donald E. Knuth et al.,
+.IR \*(MFware .
+.\"=====================================================================
+.SH AUTHORS
+Donald E. Knuth wrote the program, and he ported it to Unix with the help of
+Pierre MacKay and the Unix port of
+.B weave
+by Howard Trickey and Pavel Curtis.
+The program is published in the
+.I \*(MFware
+technical report, available from the \*(TX Users Group.
diff --git a/Build/source/texk/web2c/man/mpost.man b/Build/source/texk/web2c/man/mpost.man
new file mode 100644
index 00000000000..f47911c9297
--- /dev/null
+++ b/Build/source/texk/web2c/man/mpost.man
@@ -0,0 +1,478 @@
+.TH MPOST 1 "10 November 2001" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MP MetaPost
+.if t .ds MP MetaPost
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if n .ds WB Web
+.if t .ds WB W\s-2EB\s0
+.\"=====================================================================
+.SH NAME
+mpost, inimpost, virmpost \- MetaPost, a system for drawing pictures
+.SH SYNOPSIS
+.B mpost
+.RI [ options ]
+.RI [ commands ]
+.\"=====================================================================
+.SH DESCRIPTION
+\*(MP interprets the \*(MP language and produces PostScript
+pictures. The \*(MP language is similar to Knuth's \*(MF
+with additional features for including
+.BR tex (1)
+or
+.BR troff (1)
+commands and accessing features of PostScript not found in \*(MF.
+.PP
+Like \*(TX and \*(MF, \*(MP is normally used with a large body of
+precompiled macros. This version of \*(MP looks at its command line
+to see what name it was called under. Both
+.B inimpost
+and
+.B virmpost
+are symlinks to the
+.B mpost
+executable. When called as
+.BR inimpost
+(or when the
+.B -ini
+option is given) it can be used to precompile macros into a
+.I .mem
+file. When called as
+.B virmpost
+it will use the
+.I plain
+mem. When called under any other name, \*(MP will use that name as
+the name of the mem to use. For example, when called as
+.B mpost
+the
+.I mpost
+mem is used, which is identical to the
+.I plain
+mem. Other mems than
+.I plain
+are rarely used.
+.PP
+The
+.I commands
+given on the command line to the \*(MP program are passed to it as the
+first input line. (But it is often easier to type extended arguments
+as the first input line, since UNIX shells tend to gobble up or
+misinterpret \*(MP's favorite symbols, like semicolons, unless you
+quote them.) The first line should begin with a filename, a
+.RI \e controlsequence ,
+or a
+.IR &memname .
+.PP
+The normal usage is to say
+.I mpost figs
+to process the file
+.IR figs.mp .
+The basename of
+.I figs
+becomes the ``jobname'',
+and is used in forming output file names. If no file is named, the
+jobname becomes
+.IR mpout .
+The default extension,
+.IR .mp ,
+can be overridden by specifying an extension explicitly.
+.PP
+There is normally one output file for each picture generated,
+and the output files are named \fIjobname\fP\fB\^.\^\fP\fInnn\fP,
+where \fInnn\fP
+is a number passed to the
+.I beginfig
+macro. The output file name
+can also be \fIjobname\fP\fB\^.\^\fP\fIps\fP
+if this number is negative.
+.PP
+The output files can be used as figures in a \*(TX document by including
+.ce
+.BI "\especial{psfile=" jobname.nnn }
+in the \*(TX document. Alternatively, one can
+.B \einput epsf.tex
+and then use the macro
+.ce
+.BI "\eepsfbox{" jobname.nnn }
+to produce a box of the appropriate size containing the figure.
+.TP
+.BI btex " TeX commands " etex
+This causes
+.I mpost
+to generate a \*(MP picture expression that corresponds to the
+\*(TX commands. If the \*(TX commands generate
+more than one line of text, it must be in a
+.I \evbox
+or a minipage environment.
+.TP
+.BI verbatimtex " TeX commands " etex
+This is ignored by
+.I mpost
+except that the \*(TX commands are passed on to \*(TX. When using \*(LX
+instead of \*(TX the input file must start with a
+.I verbatimtex
+block that gives the
+.I \edocumentstyle
+and
+.I "\ebegin{document}"
+commands. You can use the `%&' construct in the first verbatimtex
+block to ensure that the correct \*(TX format is used to process the
+commands.
+.PP
+Since most \*(TX fonts have to be downloaded as bitmaps, the
+.I btex
+feature works best when the output of
+.I mpost
+is to be included in a \*(TX document so that
+.BR dvips (1)
+can download the fonts. For self-contained PostScript output that can be
+used directly or included in a
+.I troff
+document, start your \*(MP input file with the command
+.I "prologues:=1"
+and stick to standard PostScript fonts. \*(TX and \*(MP use the names in the
+third column of the file
+.IR trfonts.map ,
+which can be found in the directories with support files for \*(MP.
+.PP
+\*(MP output can be included in a
+.I troff
+document via the
+.I "-m pictures"
+macro package. In this case
+.I mpost
+should be invoked with the
+.B -T
+flag so that the commands between
+.I btex
+and
+.I etex
+or between
+.I verbatimtex
+and
+.I etex
+are interpreted as
+.I troff
+instead of \*(TX. (This automatically sets
+.I "prologues:=1"
+).
+.\"=====================================================================
+.SH OPTIONS
+This version of \*(MP understands the following command line options.
+.TP
+.B -file-line-error
+.rb
+Print error messages in the form
+.I file:line:error
+which is similar to the way many compilers format them.
+.TP
+.B -no-file-line-error
+.rb
+Disable printing error messages in the
+.I file:line:error
+style.
+.TP
+.B -file-line-error-style
+.rb
+This is the old name of the
+.B -file-line-error
+option.
+.TP
+.B -halt-on-error
+.rb
+Exit with an error code when an error is encountered during processing.
+.TP
+.B -help
+.rb
+Print help message and exit.
+.TP
+.B -ini
+.rb
+Be
+.BR inimpost ,
+for dumping bases; this is implicitly true if the program is called
+as
+.BR inimpost .
+.TP
+.BI -interaction \ mode
+.rb
+Sets the interaction mode. The mode can be one of
+.IR batchmode ,
+.IR nonstopmode ,
+.IR scrollmode ,
+and
+.IR errorstopmode .
+The meaning of these modes is the same as that of the corresponding
+commands.
+.TP
+.BI -jobname \ name
+.rb
+Use
+.I name
+for the job name, instead of deriving it from the name of the input file.
+.TP
+.BI -kpathsea-debug \ bitmask
+.rb
+Sets path searching debugging flags according to the bitmask. See the
+.I Kpathsea
+manual for details.
+.TP
+.BI -mem \ mem
+.rb
+Use
+.I mem
+as the name of the mem to be used, instead of the name by which
+\*(MP was called or a
+.I %&
+line.
+.TP
+.BI -output-directory \ directory
+.rb Write output files in
+.I directory
+instead of the current directory. Look up input files in
+.I directory
+first, the along the normal search path.
+.TP
+.B -parse-first-line
+.rb
+If the first line of the main input file begins with
+.I %&
+parse it to look for a dump name or a
+.B -translate-file
+option.
+.TP
+.B -no-parse-first-line
+.rb
+Disable parsing of the first line of the main input file.
+.TP
+.BI -progname \ name
+.rb
+Pretend to be program
+.IR name .
+This affects both the format used and the search paths.
+.TP
+.B -recorder
+.rb
+Enable the filename recorder. This leaves a trace of the files opened
+for input and output in a file with extension
+.IR .fls .
+.TP
+.B -T
+.rb
+Produce TROFF output.
+.TP
+.BI -translate-file \ tcxname
+.rb
+Use the
+.I tcxname
+translation table.
+.TP
+.B -troff
+.rb
+As
+.BR -T .
+.TP
+.B -version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH ENVIRONMENT
+See the Kpathsearch library documentation (the `Path specifications'
+node) for the details of how the environment variables are use when
+searching. The
+.B kpsewhich
+utility can be used to query the values of the variables.
+.PP
+If the environment variable
+TEXMFOUTPUT is set, \*(MP attempts to put its output
+files in it, if they cannot be put in the current directory.
+.PP
+Here is a list of the environment variables affect the behavior of
+.IR mpost :
+.TP
+.TP
+MPINPUTS
+Search path for
+.I input
+files.
+.TP
+MFINPUTS
+Auxiliary search path for
+.I input
+files with
+.I .mf
+extensions.
+.TP
+MPSUPPORT
+Directory for various tables for handling included
+.I tex
+and
+.IR troff .
+.TP
+MPXCOMMAND
+The name of a shell script that converts embedded typesetting commands
+to a form that \*(MP understands. Defaults:
+.I makempx
+for
+.I tex
+and
+.I troffmpx
+for
+.IR troff .
+.TP
+TEX
+The version of \*(TX \- or \*(LX \- to use when processing
+.I btex
+and
+.I verbatimtex
+commands. Default
+.IR tex .
+This version of \*(MP allows you to use a `%&format' line instead.
+.TP
+TROFF
+The
+.I troff
+pipeline for
+.I btex
+and
+.I verbatimtex
+commands. Default
+.I eqn -d\e$\e$ | troff
+.TP
+MPEDIT
+A command template for invoking an editor.
+.PP
+A
+.I .mem
+file is a binary file that permits fast loading of macro packages.
+.I mpost
+reads the default
+.I plain.mem
+unless another
+.I .mem
+file is specified at the start of the first line with an
+.I &
+just before it. There is also an
+.I mfplain.mem
+that simulates plain \*(MF so that
+.I mpost
+can read
+.I .mf
+fonts. (Plain \*(MF is described in
+.IR "The \*(MF\^book" ).
+.PP
+Experts can create
+.I .mem
+files be invoking
+.I inimpost
+and giving macro definitions followed by a
+.I dump
+command.
+.PP
+The \*(MP language is similar to \*(MF, but the manual
+.I A User's Manual for \*(MP
+assumes no knowledge of \*(MF. \*(MP does not have bitmap
+output commands or \*(MF's online display mechanism.
+.\"=====================================================================
+.SH FILES
+.TP
+.I mpost.pool
+Encoded text of \*(MP's messages.
+.TP
+.I *.mem
+Predigested \*(MP mem files.
+.TP
+.I plain.mp
+The standard mem file.
+.TP
+.I mfplain.mp
+The \*(MF-compatible mem file. This is loaded when
+.I virmp
+is invoked via a symbolic link as
+.IR mfmp .
+.TP
+.I $TEXMFMAIN/metapost/base/*.mp
+The standard \*(MP macros included in the original distribution.
+.TP
+.I $TEXMFMAIN/metapost/support/*
+Various tables for handling included
+.I tex
+and
+.IR troff .
+.TP
+.I $TEXMFMAIN/metapost/support/trfonts.map
+Table of corresponding font names for
+.I troff
+and PostScript.
+.TP
+.I psfonts.map
+Table of corresponding font names for
+.I tex
+and PostScript.
+.TP
+.I $TEXMFMAIN/doc/metapost/examples.mp
+The source file for a few sample figures
+that are part of a \*(LX document
+.I $TEXMFMAIN/doc/metapost/mpintro.tex
+that describes the \*(MP system
+in a little more detail.
+.\"=====================================================================
+.SH NOTES
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(MP can be found in the info manual
+.IR "Web2C: A TeX implementation" .
+.\"=====================================================================
+.SH "SUGGESTED READING"
+Donald E. Knuth,
+.I "The \*(MF\^book"
+(Volume C of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13445-4.
+.br
+John D. Hobby,
+.IR "A User's Manual for \*(MP" ,
+CSTR 162, AT&T Bell Labs,
+.br
+John D. Hobby,
+.IR "Drawing Graphs with \*(MP" ,
+CSTR 164, AT&T Bell Labs,
+.br
+.I TUGboat
+(the journal of the \*(TX Users Group).
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tex (1),
+.BR mf (1),
+.BR dvips (1).
+.\"=====================================================================
+.SH AUTHORS
+\*(MP was designed by John D. Hobby, incorporating algorithms from
+\*(MF by Donald E. Knuth. It was originally implemented on Unix,
+incorporating system-dependent routines from
+.BR web2c ,
+while not relying on it except for the actual \*(WB-to-C translator.
+.PP
+Ulrik Vieth adapted \*(MP to take advantage of the advanced path
+searching features in more recent versions of
+.B web2c
+and worked towards fully integrating \*(MP into the canonical Unix
+\*(TX distribution. He also updated and extended this manual page.
+.\"=====================================================================
+.SH TRIVIA
+Unlike \*(TX and \*(MF, \*(MP originally didn't use any fancy logo.
+John Hobby says he prefers the spelling ``MetaPost'', yet Don Knuth
+has updated the \*(MF
+.I logo.mf
+font to be able to typeset a proper \*(MP logo similar to the \*(MF
+logo. Feel free to use whatever you think is more appropriate!
diff --git a/Build/source/texk/web2c/man/mpto.man b/Build/source/texk/web2c/man/mpto.man
new file mode 100644
index 00000000000..f5d99040a58
--- /dev/null
+++ b/Build/source/texk/web2c/man/mpto.man
@@ -0,0 +1,68 @@
+.TH MPTO 1 "4 January 1998" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MP MetaPost
+.if t .ds MP MetaPost
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+mpto \- extract labels in MetaPost pictures for typesetting
+.SH SYNOPSIS
+.B mpto
+.RI [ -tex | -troff ]
+.I mpfile
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+Strip
+.I btex..etex
+and
+.I verbatimtex...etex
+parts from \*(MP input file
+.IR mpfile ,
+converting to either \*(TX or Troff (\*(TX by default). The generated
+code is dumped on standard output.
+.PP
+.B mpto
+is typically called by
+.BR makempx ,
+not from the command line.
+.\"=====================================================================
+.SH OPTIONS
+.B mpto
+accepts the following options:
+.TP
+.B --help
+.rb
+Print help message and exit.
+.TP
+.B -tex
+.rb
+Assume input file contains \*(TX commands.
+.TP
+.B -troff
+.rb
+Assume input file contains Troff commands.
+.TP
+.B --version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR mpost (1),
+.BR makempx (1).
diff --git a/Build/source/texk/web2c/man/newer.man b/Build/source/texk/web2c/man/newer.man
new file mode 100644
index 00000000000..f96a2f1ee94
--- /dev/null
+++ b/Build/source/texk/web2c/man/newer.man
@@ -0,0 +1,41 @@
+.TH NEWER 1 "21 June 2005" "Web2C @VERSION@"
+.\"=====================================================================
+.SH NAME
+newer \- compare file modification times
+.SH SYNOPSIS
+.B newer
+.RI [ option ]
+.I src1
+[
+.I src2 ... srcN
+]
+.I target
+.\"=====================================================================
+.SH DESCRIPTION
+Exit successfully if files
+.I src1 ... srcN
+exist and at least one of them is not older than
+.IR target .
+Also exit successfully if
+.I target
+doesn't exist.
+.\"=====================================================================
+.SH OPTIONS
+.B newer
+accepts the following options:
+.TP
+.B --help
+.rb
+Print help message and exit.
+.TP
+.B --quiet, -q
+.rb
+Do not print any output, including error messages.
+.TP
+.B --version
+.rb
+Print version information and exit.
+.TP
+.B --verbose, -v
+.rb
+List missing source files. This is the default.
diff --git a/Build/source/texk/web2c/man/omega.man b/Build/source/texk/web2c/man/omega.man
new file mode 100644
index 00000000000..e48e22a9a9f
--- /dev/null
+++ b/Build/source/texk/web2c/man/omega.man
@@ -0,0 +1,292 @@
+.TH OMEGA 1 "27 December 1997" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.\"=====================================================================
+.SH NAME
+omega, iniomega, viromega \- extended unicode TeX
+.SH SYNOPSIS
+.B omega
+.RI [ options ]
+[\fB&\fR \fIformat\fR ]
+[ \fIfile\fR | \fB\e\fR \fIcommands\fR ]
+.\"=====================================================================
+.SH DESCRIPTION
+Run the Omega typesetter on
+.IR file ,
+usually creating
+.IR file.dvi .
+If the file argument has no extension, ".tex" will be appended to it.
+Instead of a filename, a set of Omega commands can be given, the first
+of which must start with a backslash.
+With a
+.BI & format
+argument Omega uses a different set of precompiled commands,
+contained in
+.IR format.fmt ;
+it is usually better to use the
+.B -fmt
+.I format
+option instead.
+.PP
+Omega is a version of the \*(TX program modified for multilingual
+typesetting. It uses unicode, and has additional primitives for
+(among other things) bidirectional typesetting.
+.PP
+The
+.B iniomega
+and
+.B viromega
+commands are Omega's analogues to the
+.B initex
+and
+.B virtex
+commands. In this installation, they are symlinks to the
+.B omega
+executable.
+.PP
+Omega's command line options are similar to those of \*(TX.
+.PP
+Omega is experimental software.
+.\"=====================================================================
+.SH OPTIONS
+This version of Omega understands the following command line options.
+.TP
+.BI --oft \ format
+.rb
+Use
+.I format
+as the name of the format to be used, instead of the name by which
+Omega was called or a
+.I %&
+line.
+.TP
+.B -halt-on-error
+.rb
+Exit with an error code when an error is encountered during processing.
+.TP
+.B --help
+.rb
+Print help message and exit.
+.TP
+.B --ini
+.rb
+Be
+.BR iniomega ,
+for dumping formats; this is implicitly true if the program is called
+as
+.BR iniomega .
+.TP
+.BI --interaction \ mode
+.rb
+Sets the interaction mode. The mode can be one of
+.IR batchmode ,
+.IR nonstopmode ,
+.IR scrollmode ,
+and
+.IR errorstopmode .
+The meaning of these modes is the same as that of the corresponding
+\ecommands.
+.TP
+.B --ipc
+.rb
+Send DVI output to a socket as well as the usual output file. Whether
+this option is available is the choice of the installer.
+.TP
+.B --ipc-start
+.rb
+As
+.BR --ipc ,
+and starts the server at the other end as well. Whether this option
+is available is the choice of the installer.
+.TP
+.BI --kpathsea-debug \ bitmask
+.rb
+Sets path searching debugging flags according to the bitmask. See the
+.I Kpathsea
+manual for details.
+.TP
+.BI --maketex \ fmt
+.rb
+Enable
+.RI mktex fmt ,
+where
+.I fmt
+must be one of
+.I tex
+or
+.IR tfm .
+.TP
+.BI --no-maketex \ fmt
+.rb
+Disable
+.RI mktex fmt ,
+where
+.I fmt
+must be one of
+.I tex
+or
+.IR tfm .
+.TP
+.BI --output-comment \ string
+.rb
+Use
+.I string
+for the DVI file comment instead of the date.
+.TP
+.BI -output-directory \ directory
+.rb Write output files in
+.I directory
+instead of the current directory. Look up input files in
+.I directory
+first, the along the normal search path.
+.TP
+.B --parse-first-line
+.rb
+If the first line of the main input file begins with
+.I %&
+parse it to look for a dump name.
+.TP
+.BI --progname \ name
+.rb
+Pretend to be program
+.IR name .
+This affects both the format used and the search paths.
+.TP
+.B --recorder
+.rb
+Enable the filename recorder. This leaves a trace of the files opened
+for input and output in a file with extension
+.IR .ofl .
+(This option is always on.)
+.TP
+.B --shell-escape
+.rb
+Enable the
+.BI \ewrite18{ command }
+construct. The
+.I command
+can be any Bourne shell command. This construct is normally
+disallowed for security reasons.
+.TP
+.B --version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH ENVIRONMENT
+See the Kpathsearch library documentation (the `Path specifications'
+node) for precise details of how the environment variables are used.
+The
+.B kpsewhich
+utility can be used to query the values of the variables.
+.PP
+One caveat: In most Omega formats, you cannot use ~ in a filename you
+give directly to Omega, because ~ is an active character, and hence is
+expanded, not taken as part of the filename. Other programs, such as
+\*(MF, do not have this problem.
+.PP
+.TP
+TEXMFOUTPUT
+Normally, Omega puts its output files in the current directory. If
+any output file cannot be opened there, it tries to open it in the
+directory specified in the environment variable TEXMFOUTPUT.
+There is no default value for that variable. For example, if you say
+.I tex paper
+and the current directory is not writable, if TEXMFOUTPUT has
+the value
+.IR /tmp ,
+Omega attempts to create
+.I /tmp/paper.log
+(and
+.IR /tmp/paper.dvi ,
+if any output is produced.)
+.TP
+TEXINPUTS
+Search path for
+.I \einput
+and
+.I \eopenin
+files.
+This should probably start with ``.'', so
+that user files are found before system files. An empty path
+component will be replaced with the paths defined in the
+.I texmf.cnf
+file. For example, set TEXINPUTS to ".:/home/usr/tex:" to prepend the
+current direcory and ``/home/user/tex'' to the standard search path.
+.TP
+TEXEDIT
+Command template for switching to editor. The default, usually
+.BR vi ,
+is set when Omega is compiled.
+.\"=====================================================================
+.SH FILES
+The location of the files mentioned below varies from system to
+system. Use the
+.B kpsewhich
+utility to find their locations.
+.TP
+.I omega.pool
+Encoded text of Omega's messages.
+.TP
+.I *.oft
+Predigested Omega format (.\|oft) files.
+.br
+.\"=====================================================================
+.SH NOTES
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of Omega can be found in the info
+manual
+.IR "Web2C: A TeX implementation" .
+.\"=====================================================================
+.SH BUGS
+This version of Omega implements a number of optional extensions.
+In fact, many of these extensions conflict to a greater or lesser
+extent with the definition of Omega. When such extensions are
+enabled, the banner printed when Omega starts is changed to print
+.B Omegak
+instead of
+.BR Omega .
+.PP
+This version of Omega fails to trap arithmetic overflow when
+dimensions are added or subtracted. Cases where this occurs are rare,
+but when it does the generated
+.I DVI
+file will be invalid.
+.PP
+The
+.I DVI
+files produced by Omega may use extensions which make them incompatible
+with most software designed to handle
+.I DVI
+files. In order to print or preview them, you should use
+.B odvips
+to generate a PostScript file.
+.PP
+Omega is experimental software, and if you are an active user it is
+strongly recommended that you subscribe to the Omega mailing list.
+Visit the Omega website
+.B http://omega.cse.unsw.edu.au
+for information on how to subscribe.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tex (1),
+.BR mf (1),
+.RB odvips (1),
+.\"=====================================================================
+.SH AUTHORS
+The primary authors of Omega are John Plaice and Yannis Haralambous.
diff --git a/Build/source/texk/web2c/man/patgen.man b/Build/source/texk/web2c/man/patgen.man
new file mode 100644
index 00000000000..d32f56e37a3
--- /dev/null
+++ b/Build/source/texk/web2c/man/patgen.man
@@ -0,0 +1,170 @@
+.TH PATGEN 1 "23 August 2004" "Web2C @VERSION@"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+patgen \- generate patterns for TeX hyphenation
+.SH SYNOPSIS
+.B patgen
+.I dictionary_file pattern_file patout_file translate_file
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B patgen
+program reads the
+.I dictionary_file
+containing a list of hyphenated words and the
+.I pattern_file
+containing previously-generated patterns (if any) for a particular
+language, and produces the
+.I patout_file
+with (previously- plus newly-generated) hyphenation patterns for that
+language. The
+.I translate_file
+defines language specific values for the parameters
+.IR left_hyphen_min " and " right_hyphen_min
+used by \*(TX's hyphenation algorithm and the external representation
+of the lower and upper case version(s) of all \`letters' of that
+language. Further details of the pattern generation process such as
+hyphenation levels and pattern lengths are requested interactively from
+the user's terminal. Optionally
+.B patgen
+creates a new dictionary file
+.BI pattmp. n
+showing the good and bad hyphens found by the generated patterns, where
+.I n
+is the highest hypenation level.
+.PP
+The patterns generated by
+.B patgen
+can be read by
+.B initex
+for use in hyphenating words. For a (very) long example of
+.IR patgen 's
+output, see
+.IR $TEXMFMAIN/tex/generic/hyphen/hyphen.tex ,
+which contains the patterns \*(TX uses for English.
+At some sites, patterns for several other languages may be available,
+and the local
+.B tex
+programs may have them preloaded; consult your
+.I Local Guide
+or your system administrator for details.
+.PP
+All filenames must be complete; no adding of default
+extensions or path searching is done.
+.\"=====================================================================
+.SH FILE FORMATS
+.TP \w'@@'u+2n
+.B Letters
+When
+.B initex
+digests hyphenation patterns, \*(TX first expands macros and the result
+must entirely consist of digits (hyphenation levels), dots (\`.', edge
+of a word), and letters. In pattern files for non-English languages
+letters are often represented by macros or other expandable constructs.
+For the purpose of
+.B patgen
+these are just character sequences, subject to the condition that no
+such sequence is a prefix of another one.
+.TP \w'@@'u+2n
+.B Dictionary file
+A dictionary file contains a weighted list of hyphenated words, one word
+per line starting in column 1. A digit in column 1 indicates a global
+word weight (initially =1) applicable to all following words up to the
+next global word weight. A digit at some intercharacter position
+indicates a weight for that position only.
+
+The hyphens in a word are indicated by \`-', \`*', or \`.' (or their
+replacements as defined in the translate file) for hyphens yet to be
+found, \`good' hyphens (correctly found by the patterns), and \`bad'
+hyphens (erroneously found by the patterns) respectively; when reading a
+dictionary file \`*' is treated like \`-' and \`.' is ignored.
+.TP \w'@@'u+2n
+.B Translate file
+A translate file starts with a line containing the values of
+.I left_hypen_min
+in columns 1-2,
+.I right_hyphen_min
+in columns 3-4, and either a blank or the replacement for one of the
+"hyphen" characters \`-', \`*', and \`.' in columns 5, 6, and 7. (Input
+lines are padded with blanks as for many \*(TX related programs.)
+
+Each following line defines one \`letter': an arbitrary delimiter
+character in column 1, followed by one or more external representations
+of that character (first the \`lower' case one used for output), each
+one terminated by the delimiter and the whole sequence terminated by
+another delimiter.
+
+If the translate file is empty, the values
+.IR left_hypen_min "=2, " right_hyphen_min "=3,"
+and the 26 lower case letters
+.IR a ... z
+with their upper case representations
+.IR A ... Z
+are assumed.
+.TP \w'@@'u+2n
+.B Terminal input
+After reading the
+.I translate_file
+and any previously-generated patterns from
+.IR pattern_file,
+.B patgen
+requests input from the user's terminal.
+
+First the integer values of
+.IR hyph_start " and " hyph_finish ,
+the lowest and highest hyphenation level for which patterns are to be
+generated. The value of
+.I hyph_start
+should be larger than any hyphenation level already present in
+.IR pattern_file .
+
+Then, for each hyphenation level, the integer values of
+.IR pat_start " and " pat_finish ,
+the smallest and largest pattern length to be analyzed, as well as
+.IR "good weight" ", " "bad weight" ", and " threshold ,
+the weights for good and bad hyphens and a weight threshold for useful
+patterns.
+
+Finally the decision (\`y' or \`Y' vs. anything else) whether or not to
+produce a hypenated word list.
+.\"=====================================================================
+.SH FILES
+.TP \w'@@'u+2n
+.I $TEXMFMAIN/tex/generic/hyphen/hyphen.tex
+Patterns for English.
+.\"=====================================================================
+.SH "SEE ALSO"
+Frank Liang,
+.IR "Word hy-phen-a-tion by com-puter" ,
+STAN-CS-83-977,
+Stanford University Ph.D. thesis, 1983.
+.br
+Donald E. Knuth,
+.IR "The \*(OXbook" ,
+Addison-Wesley, 1986, ISBN 0-201-13447-0, Appendix H.
+.\"=====================================================================
+.SH AUTHORS
+Frank Liang wrote the first version of this program. Peter
+Breitenlohner made a
+substantial revision in 1991 for \*(TX 3.
+The first version was published as the appendix to the
+.I \*(OXware
+technical report, available from the \*(TX Users Group. Howard Trickey
+originally ported it to Unix.
diff --git a/Build/source/texk/web2c/man/pdfetex.man b/Build/source/texk/web2c/man/pdfetex.man
new file mode 100644
index 00000000000..653cab10cbd
--- /dev/null
+++ b/Build/source/texk/web2c/man/pdfetex.man
@@ -0,0 +1,487 @@
+.TH PDFETEX 1 "21 August 2004" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP\" for troff
+.el .ds OX TeX\" for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.\"=====================================================================
+.SH NAME
+pdfetex, pdfeinitex, pdfevirtex \- PDF output from e-TeX
+.SH SYNOPSIS
+.B pdfetex
+.RI [ options ]
+[\fB&\fR \fIformat\fR ]
+[ \fIfile\fR | \fB\e\fR \fIcommands\fR ]
+.\"=====================================================================
+.SH DESCRIPTION
+Run the pdfe\*(TX typesetter on
+.IR file ,
+usually creating
+.IR file.pdf .
+If the file argument has no extension, ".tex" will be appended to it.
+Instead of a filename, a set of pdfe\*(TX commands can be given, the first
+of which must start with a backslash.
+With a
+.BI & format
+argument pdfe\*(TX uses a different set of precompiled commands,
+contained in
+.IR format.fmt ;
+it is usually better to use the
+.B -fmt
+.I format
+option instead.
+.PP
+pdfe\*(TX is a version of e-\*(TX that can create
+.I PDF
+files as well as
+.I DVI
+files.
+.PP
+In
+.I DVI
+mode, pdfe\*(TX can be used as a complete replacement of the e-\*(TX
+engine.
+.PP
+The typical use of pdfe\*(TX is with a pregenerated formats for which
+PDF output has been enabled. The
+.B pdfetex
+command uses the equivalent of the plain e-\*(TX format, and the
+.B pdfelatex
+command uses the equivalent of the e-\*(LX format.
+To generate formats, use the
+.B -ini
+switch.
+.PP
+The
+.B pdfeinitex
+and
+.B pdfevirtex
+commands are pdfe\*(TX's analogues to the
+.B einitex
+and
+.B evirtex
+commands. In this installation, they are symbolic links to the
+.B pdfetex
+executable. These symbolic links may not exist at all.
+.PP
+In
+.I PDF
+mode, pdfe\*(TX can natively handle the
+.IR PDF ,
+.IR JPG ,
+and
+.I PNG
+graphics formats.
+pdfe\*(TX's handling of its command-line arguments is similar to that of
+of the other \*(TX programs in the
+.I web2c
+implementation.
+.\"=====================================================================
+.SH OPTIONS
+This version of pdfe\*(TX understands the following command line options.
+.TP
+.B -enc
+.rb
+Enable the enc\*(TX extensions. This option is only effective in
+combination with
+.BR -ini .
+For documentation of the enc\*(TX extensions see
+.BR http://www.olsak.net/enctex.html .
+.TP
+.B -etex
+.rb
+Enable the e-\*(TX extensions. This option is only effective in
+combination with
+.BR -ini .
+.TP
+.B -file-line-error
+.rb
+Print error messages in the form
+.I file:line:error
+which is similar to the way many compilers format them.
+.TP
+.B -no-file-line-error
+.rb
+Disable printing error messages in the
+.I file:line:error
+style.
+.TP
+.B -file-line-error-style
+.rb
+This is the old name of the
+.B -file-line-error
+option.
+.TP
+.BI -fmt \ format
+.rb
+Use
+.I format
+as the name of the format to be used, instead of the name by which
+pdfe\*(TX was called or a
+.I %&
+line.
+.TP
+.B -halt-on-error
+.rb
+Exit with an error code when an error is encountered during processing.
+.TP
+.B -help
+.rb
+Print help message and exit.
+.TP
+.B -ini
+.rb
+Start in
+.I INI
+mode, which is used to dump formats. The
+.I INI
+mode can be used for typesetting, but no format is preloaded, and
+basic initializations like setting catcodes may be required.
+.TP
+.BI -interaction \ mode
+.rb
+Sets the interaction mode. The mode can be either
+.IR batchmode ,
+.IR nonstopmode ,
+.IR scrollmode ,
+and
+.IR errorstopmode .
+The meaning of these modes is the same as that of the corresponding
+\ecommands.
+.TP
+.B -ipc
+.rb
+Send DVI or PDF output to a socket as well as the usual output file.
+Whether this option is available is the choice of the installer.
+.TP
+.B -ipc-start
+.rb
+As
+.BR -ipc ,
+and starts the server at the other end as well. Whether this option
+is available is the choice of the installer.
+.TP
+.BI -jobname \ name
+.rb
+Use
+.I name
+for the job name, instead of deriving it from the name of the input file.
+.TP
+.BI -kpathsea-debug \ bitmask
+.rb
+Sets path searching debugging flags according to the bitmask. See the
+.I Kpathsea
+manual for details.
+.TP
+.BI -mktex \ fmt
+.rb
+Enable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.B -mltex
+.rb
+Enable ML\*(TX extensions. Only effective in combination with
+.BR -ini .
+.TP
+.BI -no-mktex \ fmt
+.rb
+Disable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.BI -output-comment \ string
+.rb
+In
+.I DVI
+mode, use
+.I string
+for the
+.I DVI
+file comment instead of the date. This option is ignored
+in
+.I PDF
+mode.
+.TP
+.BI -output-directory \ directory
+.rb Write output files in
+.I directory
+instead of the current directory. Look up input files in
+.I directory
+first, the along the normal search path.
+.TP
+.BI -output-format \ format
+.rb
+Set the output format mode, where
+.I format
+must be either
+.I pdf
+or
+.IR dvi .
+This also influences the set of graphics formats understood by pdfe\*(TX.
+.TP
+.B -parse-first-line
+.rb
+If the first line of the main input file begins with
+.I %&
+parse it to look for a dump name or a
+.B -translate-file
+option.
+.TP
+.B -no-parse-first-line
+.rb
+Disable parsing of the first line of the main input file.
+.TP
+.BI -progname \ name
+.rb
+Pretend to be program
+.IR name .
+This affects both the format used and the search paths.
+.TP
+.B -recorder
+.rb
+Enable the filename recorder.
+This leaves a trace of the files opened for input and output
+in a file with extension
+.IR .fls .
+.TP
+.B -shell-escape
+.rb
+Enable the
+.BI \ewrite18{ command }
+construct. The
+.I command
+can be any shell command. This construct is normally
+disallowed for security reasons.
+.TP
+.B -no-shell-escape
+.rb
+Disable the
+.BI \ewrite18{ command }
+construct, even if it is enabled in the
+.I texmf.cnf
+file.
+.TP
+.B -src-specials
+.rb
+In
+.I DVI
+mode, insert source specials into the
+.I DVI
+file.
+This option is ignored in
+.I PDF
+mode.
+.TP
+.BI -src-specials \ where
+.rb
+In
+.I DVI
+mode, insert source specials in certain placed of the
+.I DVI
+file.
+.I where
+is a comma-separated value list:
+.IR cr ,
+.IR display ,
+.IR hbox ,
+.IR math ,
+.IR par ,
+.IR parent ,
+or
+.IR vbox .
+This option is ignored in
+.I PDF
+mode.
+.TP
+.BI -translate-file \ tcxname
+.rb
+Use the
+.I tcxname
+translation table to set the mapping of input characters and
+re-mapping of output characters.
+.TP
+.BI -default-translate-file \ tcxname
+.rb
+Like
+.B -translate-file
+except that a
+.I %&
+line can overrule this setting.
+.TP
+.B -version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH ENVIRONMENT
+See the Kpathsearch library documentation (the `Path specifications'
+node) for precise details of how the environment variables are used.
+The
+.B kpsewhich
+utility can be used to query the values of the variables.
+.PP
+One caveat: In most pdfe\*(TX formats, you cannot use ~ in a filename you
+give directly to pdfe\*(TX, because ~ is an active character, and hence is
+expanded, not taken as part of the filename. Other programs, such as
+\*(MF, do not have this problem.
+.PP
+.TP
+TEXMFOUTPUT
+Normally, pdfe\*(TX puts its output files in the current directory. If
+any output file cannot be opened there, it tries to open it in the
+directory specified in the environment variable TEXMFOUTPUT.
+There is no default value for that variable. For example, if you say
+.I pdfetex paper
+and the current directory is not writable, if TEXMFOUTPUT has
+the value
+.IR /tmp ,
+pdfe\*(TX attempts to create
+.I /tmp/paper.log
+(and
+.IR /tmp/paper.pdf ,
+if any output is produced.)
+.TP
+TEXINPUTS
+Search path for
+.I \einput
+and
+.I \eopenin
+files.
+This should probably start with ``.'', so
+that user files are found before system files. An empty path
+component will be replaced with the paths defined in the
+.I texmf.cnf
+file. For example, set TEXINPUTS to ".:/home/usr/tex:" to prepend the
+current direcory and ``/home/user/tex'' to the standard search path.
+.TP
+TEXFORMATS
+Search path for format files.
+.TP
+TEXPOOL
+search path for
+.B pdfetex
+internal strings.
+.TP
+TEXEDIT
+Command template for switching to editor. The default, usually
+.BR vi ,
+is set when pdfe\*(TX is compiled.
+.TP
+TFMFONTS
+Search path for font metric
+.RI ( .tfm )
+files.
+.\"=====================================================================
+.SH FILES
+The location of the files mentioned below varies from system to
+system. Use the
+.B kpsewhich
+utility to find their locations.
+.TP
+.I pdfetex.pool
+Text file containing pdfe\*(TX's internal strings.
+.TP
+.I pdftex.map
+Filename mapping definitions.
+.TP
+.I *.tfm
+Metric files for pdfe\*(TX's fonts.
+.TP
+.I *.fmt
+Predigested pdfe\*(TX format (.\|fmt) files.
+.br
+.\"=====================================================================
+.SH NOTES
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of pdfe\*(TX can be found in the info
+manual
+.IR "Web2C: A TeX implementation" .
+.\"=====================================================================
+.SH BUGS
+This version of pdfe\*(TX implements a number of optional extensions.
+In fact, many of these extensions conflict to a greater or lesser
+extent with the definition of pdfe\*(TX. When such extensions are
+enabled, the banner printed when pdfe\*(TX starts is changed to print
+.B pdfeTeXk
+instead of
+.BR pdfeTeX .
+.PP
+This version of pdfe\*(TX fails to trap arithmetic overflow when
+dimensions are added or subtracted. Cases where this occurs are rare,
+but when it does the generated
+.I DVI
+file will be invalid. Whether a generated
+.I PDF
+file would be usable is unknown.
+.\"=====================================================================
+.SH AVAILABILITY
+pdfe\*(TX is available for a large variety of machine architectures
+and operation systems.
+pdfe\*(TX is part of all major \*(TX distributions.
+.P
+Information on how to get pdfe\*(TX and related information
+is available at the
+.BI "http://tug.org" \ TUG
+website.
+The most recent version of pdfe\*(TX is available for anonymous
+ftp at the
+.B http://www.pdftex.de/tex/pdftex/
+.IR "pdfe\*(TX development site" .
+.P
+The following pdfe\*(TX related mailing list is available:
+.BR pdftex@tug.org .
+This is a mailman list;
+to subscribe send a message containing
+.I subscribe
+to
+.BR pdftex-request@tug.org .
+More about the list can be found at the
+.B "http://tug.org/mailman/listinfo/pdftex"
+.I mailing list
+website.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tex (1),
+.BR mf (1),
+.BR etex (1),
+.BR pdftex (1).
+.\"=====================================================================
+.SH AUTHORS
+The primary authors of pdf\*(TX are Han The Thanh, Petr Sojka, and
+Jiri Zlatuska.
+.PP
+\*(TX was designed by Donald E. Knuth,
+who implemented it using his \*(WB system for Pascal programs.
+It was ported to Unix at Stanford by Howard Trickey, and
+at Cornell by Pavel Curtis.
+The version now offered with the Unix \*(TX distribution is that
+generated by the \*(WB to C system
+.RB ( web2c ),
+originally written by Tomas Rokicki and Tim Morgan.
+.PP
+The enc\*(TX extensions were written by Petr Olsak.
diff --git a/Build/source/texk/web2c/man/pdftex.man b/Build/source/texk/web2c/man/pdftex.man
new file mode 100644
index 00000000000..f8209fdeb2f
--- /dev/null
+++ b/Build/source/texk/web2c/man/pdftex.man
@@ -0,0 +1,479 @@
+.TH PDFTEX 1 "25 March 2004" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.\"=====================================================================
+.SH NAME
+pdftex, pdfinitex, pdfvirtex \- PDF output from TeX
+.SH SYNOPSIS
+.B pdftex
+.RI [ options ]
+[\fB&\fR \fIformat\fR ]
+[ \fIfile\fR | \fB\e\fR \fIcommands\fR ]
+.\"=====================================================================
+.SH DESCRIPTION
+Run the pdf\*(TX typesetter on
+.IR file ,
+usually creating
+.IR file.pdf .
+If the file argument has no extension, ".tex" will be appended to it.
+Instead of a filename, a set of pdf\*(TX commands can be given, the first
+of which must start with a backslash.
+With a
+.BI & format
+argument pdf\*(TX uses a different set of precompiled commands,
+contained in
+.IR format.fmt ;
+it is usually better to use the
+.B -fmt
+.I format
+option instead.
+.PP
+pdf\*(TX is a version of \*(TX that can create
+.I PDF
+files as well as
+.I DVI
+files.
+.PP
+In
+.I DVI
+mode, pdf\*(TX can be used as a complete replacement of the \*(TX
+engine.
+.PP
+The typical use of pdf\*(TX is with a pregenerated formats for which
+PDF output has been enabled. The
+.B pdftex
+command uses the equivalent of the plain \*(TX format, and the
+.B pdflatex
+command uses the equivalent of the \*(LX format.
+To generate formats, use the
+.B -ini
+switch.
+.PP
+The
+.B pdfinitex
+and
+.B pdfvirtex
+commands are pdf\*(TX's analogues to the
+.B initex
+and
+.B virtex
+commands. In this installation, they are symbolic links to the
+.B pdftex
+executable. These symbolic links may not exist at all.
+.PP
+In
+.I PDF
+mode, pdf\*(TX can natively handle the
+.IR PDF ,
+.IR JPG ,
+and
+.I PNG
+graphics formats.
+pdf\*(TX's handling of its command-line arguments is similar to that of
+of the other \*(TX programs in the
+.I web2c
+implementation.
+.\"=====================================================================
+.SH OPTIONS
+This version of pdf\*(TX understands the following command line options.
+.TP
+.B -enc
+.rb
+Enable the enc\*(TX extensions. This option is only effective in
+combination with
+.BR -ini .
+For documentation of the enc\*(TX extensions see
+.BR http://www.olsak.net/enctex.html .
+.TP
+.B -file-line-error
+.rb
+Print error messages in the form
+.I file:line:error
+which is similar to the way many compilers format them.
+.TP
+.B -no-file-line-error
+.rb
+Disable printing error messages in the
+.I file:line:error
+style.
+.TP
+.B -file-line-error-style
+.rb
+This is the old name of the
+.B -file-line-error
+option.
+.TP
+.BI -fmt \ format
+.rb
+Use
+.I format
+as the name of the format to be used, instead of the name by which
+pdf\*(TX was called or a
+.I %&
+line.
+.TP
+.B -halt-on-error
+.rb
+Exit with an error code when an error is encountered during processing.
+.TP
+.B -help
+.rb
+Print help message and exit.
+.TP
+.B -ini
+.rb
+Start in
+.I INI
+mode, which is used to dump formats. The
+.I INI
+mode can be used for typesetting, but no format is preloaded, and
+basic initializations like setting catcodes may be required.
+.TP
+.BI -interaction \ mode
+.rb
+Sets the interaction mode. The mode can be either
+.IR batchmode ,
+.IR nonstopmode ,
+.IR scrollmode ,
+and
+.IR errorstopmode .
+The meaning of these modes is the same as that of the corresponding
+\ecommands.
+.TP
+.B -ipc
+.rb
+Send DVI or PDF output to a socket as well as the usual output file.
+Whether this option is available is the choice of the installer.
+.TP
+.B -ipc-start
+.rb
+As
+.BR -ipc ,
+and starts the server at the other end as well. Whether this option
+is available is the choice of the installer.
+.TP
+.BI -jobname \ name
+.rb
+Use
+.I name
+for the job name, instead of deriving it from the name of the input file.
+.TP
+.BI -kpathsea-debug \ bitmask
+.rb
+Sets path searching debugging flags according to the bitmask. See the
+.I Kpathsea
+manual for details.
+.TP
+.BI -mktex \ fmt
+.rb
+Enable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.B -mltex
+.rb
+Enable ML\*(TX extensions. Only effective in combination with
+.BR -ini .
+.TP
+.BI -no-mktex \ fmt
+.rb
+Disable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.BI -output-comment \ string
+.rb
+In
+.I DVI
+mode, use
+.I string
+for the
+.I DVI
+file comment instead of the date. This option is ignored
+in
+.I PDF
+mode.
+.TP
+.BI -output-directory \ directory
+.rb Write output files in
+.I directory
+instead of the current directory. Look up input files in
+.I directory
+first, the along the normal search path.
+.TP
+.BI -output-format \ format
+.rb
+Set the output format mode, where
+.I format
+must be either
+.I pdf
+or
+.IR dvi .
+This also influences the set of graphics formats understood by pdf\*(TX.
+.TP
+.B -parse-first-line
+.rb
+If the first line of the main input file begins with
+.I %&
+parse it to look for a dump name or a
+.B -translate-file
+option.
+.TP
+.B -no-parse-first-line
+.rb
+Disable parsing of the first line of the main input file.
+.TP
+.BI -progname \ name
+.rb
+Pretend to be program
+.IR name .
+This affects both the format used and the search paths.
+.TP
+.B -recorder
+.rb
+Enable the filename recorder.
+This leaves a trace of the files opened for input and output
+in a file with extension
+.IR .fls .
+.TP
+.B -shell-escape
+.rb
+Enable the
+.BI \ewrite18{ command }
+construct. The
+.I command
+can be any shell command. This construct is normally
+disallowed for security reasons.
+.TP
+.B -no-shell-escape
+.rb
+Disable the
+.BI \ewrite18{ command }
+construct, even if it is enabled in the
+.I texmf.cnf
+file.
+.TP
+.B -src-specials
+.rb
+In
+.I DVI
+mode, insert source specials into the
+.I DVI
+file.
+This option is ignored in
+.I PDF
+mode.
+.TP
+.BI -src-specials \ where
+.rb
+In
+.I DVI
+mode, insert source specials in certain placed of the
+.I DVI
+file.
+.I where
+is a comma-separated value list:
+.IR cr ,
+.IR display ,
+.IR hbox ,
+.IR math ,
+.IR par ,
+.IR parent ,
+or
+.IR vbox .
+This option is ignored in
+.I PDF
+mode.
+.TP
+.BI -translate-file \ tcxname
+.rb
+Use the
+.I tcxname
+translation table to set the mapping of input characters and
+re-mapping of output characters.
+.TP
+.BI -default-translate-file \ tcxname
+.rb
+Like
+.B -translate-file
+except that a
+.I %&
+line can overrule this setting.
+.TP
+.B -version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH ENVIRONMENT
+See the Kpathsearch library documentation (the `Path specifications'
+node) for precise details of how the environment variables are used.
+The
+.B kpsewhich
+utility can be used to query the values of the variables.
+.PP
+One caveat: In most pdf\*(TX formats, you cannot use ~ in a filename you
+give directly to pdf\*(TX, because ~ is an active character, and hence is
+expanded, not taken as part of the filename. Other programs, such as
+\*(MF, do not have this problem.
+.PP
+.TP
+TEXMFOUTPUT
+Normally, pdf\*(TX puts its output files in the current directory. If
+any output file cannot be opened there, it tries to open it in the
+directory specified in the environment variable TEXMFOUTPUT.
+There is no default value for that variable. For example, if you say
+.I pdftex paper
+and the current directory is not writable, if TEXMFOUTPUT has
+the value
+.IR /tmp ,
+pdf\*(TX attempts to create
+.I /tmp/paper.log
+(and
+.IR /tmp/paper.pdf ,
+if any output is produced.)
+.TP
+TEXINPUTS
+Search path for
+.I \einput
+and
+.I \eopenin
+files.
+This should probably start with ``.'', so
+that user files are found before system files. An empty path
+component will be replaced with the paths defined in the
+.I texmf.cnf
+file. For example, set TEXINPUTS to ".:/home/usr/tex:" to prepend the
+current direcory and ``/home/user/tex'' to the standard search path.
+.TP
+TEXFORMATS
+Search path for format files.
+.TP
+TEXPOOL
+search path for
+.B pdftex
+internal strings.
+.TP
+TEXEDIT
+Command template for switching to editor. The default, usually
+.BR vi ,
+is set when pdf\*(TX is compiled.
+.TP
+TFMFONTS
+Search path for font metric
+.RI ( .tfm )
+files.
+.\"=====================================================================
+.SH FILES
+The location of the files mentioned below varies from system to
+system. Use the
+.B kpsewhich
+utility to find their locations.
+.TP
+.I pdftex.pool
+Text file containing pdf\*(TX's internal strings.
+.TP
+.I pdftex.map
+Filename mapping definitions.
+.TP
+.I *.tfm
+Metric files for pdf\*(TX's fonts.
+.TP
+.I *.fmt
+Predigested pdf\*(TX format (.\|fmt) files.
+.br
+.\"=====================================================================
+.SH NOTES
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of pdf\*(TX can be found in the info
+manual
+.IR "Web2C: A TeX implementation" .
+.\"=====================================================================
+.SH BUGS
+This version of pdf\*(TX implements a number of optional extensions.
+In fact, many of these extensions conflict to a greater or lesser
+extent with the definition of pdf\*(TX. When such extensions are
+enabled, the banner printed when pdf\*(TX starts is changed to print
+.B pdfTeXk
+instead of
+.BR pdfTeX .
+.PP
+This version of pdf\*(TX fails to trap arithmetic overflow when
+dimensions are added or subtracted. Cases where this occurs are rare,
+but when it does the generated
+.I DVI
+file will be invalid. Whether a generated
+.I PDF
+file would be usable is unknown.
+.\"=====================================================================
+.SH AVAILABILITY
+pdf\*(TX is available for a large variety of machine architectures
+and operation systems.
+pdf\*(TX is part of all major \*(TX distributions.
+.P
+Information on how to get pdfe\*(TX and related information
+is available at the
+.BI "http://tug.org" \ TUG
+website.
+The most recent version of pdf\*(TX is available for anonymous
+ftp at the
+.B http://www.pdftex.de/tex/pdftex/
+.IR "pdf\*(TX development site" .
+.P
+The following pdfe\*(TX related mailing list is available:
+.BR pdftex@tug.org .
+This is a mailman list;
+to subscribe send a message containing
+.I subscribe
+to
+.BR pdftex-request@tug.org .
+More about the list can be found at the
+.B "http://tug.org/mailman/listinfo/pdftex"
+.I mailing list
+website.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tex (1),
+.BR mf (1).
+.\"=====================================================================
+.SH AUTHORS
+The primary authors of pdf\*(TX are Han The Thanh, Petr Sojka, and
+Jiri Zlatuska.
+.PP
+\*(TX was designed by Donald E. Knuth,
+who implemented it using his \*(WB system for Pascal programs.
+It was ported to Unix at Stanford by Howard Trickey, and
+at Cornell by Pavel Curtis.
+The version now offered with the Unix \*(TX distribution is that
+generated by the \*(WB to C system
+.RB ( web2c ),
+originally written by Tomas Rokicki and Tim Morgan.
+.PP
+The enc\*(TX extensions were written by Petr Olsak.
diff --git a/Build/source/texk/web2c/man/pdftexman.m4 b/Build/source/texk/web2c/man/pdftexman.m4
new file mode 100644
index 00000000000..c80e8a1c28e
--- /dev/null
+++ b/Build/source/texk/web2c/man/pdftexman.m4
@@ -0,0 +1,671 @@
+m4_divert(-1)m4_dnl
+=======================================================================
+$Id: //depot/Build/source.development/TeX/texk/web2c/man/pdftexman.m4#2 $
+
+Common man page for pdftex and pdfetex, to be preprocessed by GNU m4:
+
+$ m4 -P -DOLD pdftexman.m4 > pdftex.man
+$ m4 -P pdfetexman.m4 > pdfetex.man
+
+=======================================================================
+
+m4_define(`M_MANDATE', `23 March 2004')
+m4_define(`M_WEB2CVERSION', `@VERSION@')
+
+m4_ifdef(`OLD',
+ `
+ m4_define(`M_LTXPP', `\*(LX')
+ m4_define(`M_TEXPP', `\*(TX')
+ m4_define(`M_TEXP', `TeX')
+ m4_define(`M_TEX', `tex')
+ m4_define(`M_PDFTEX', `PDFTEX')
+ m4_define(`M_PDFENGINI', `pdfinitex')
+ m4_define(`M_PDFENGVIR', `pdfvirtex')
+ m4_define(`M_PDFENGPP', `pdf\*(TX')
+ m4_define(`M_PDFENGKP', `pdfTeXk')
+ m4_define(`M_PDFENGP', `pdfTeX')
+ m4_define(`M_PDFENG', `pdftex')
+ m4_define(`M_ENGINI', `initex')
+ m4_define(`M_ENGVIR', `virtex')
+ m4_define(`M_PDFLTX', `pdflatex')
+ m4_define(`M_FMT', `fmt')
+ ', `
+ m4_define(`M_LTXPP', `e-\*(LX')
+ m4_define(`M_TEXPP', `e-\*(TX')
+ m4_define(`M_TEXP', `e-TeX')
+ m4_define(`M_TEX', `etex')
+ m4_define(`M_PDFTEX', `PDFETEX')
+ m4_define(`M_PDFENGINI', `pdfeinitex')
+ m4_define(`M_PDFENGVIR', `pdfevirtex')
+ m4_define(`M_PDFENGPP', `pdfe\*(TX')
+ m4_define(`M_PDFENGKP', `pdfeTeXk')
+ m4_define(`M_PDFENGP', `pdfeTeX')
+ m4_define(`M_PDFENG', `pdfetex')
+ m4_define(`M_ENGINI', `einitex')
+ m4_define(`M_ENGVIR', `evirtex')
+ m4_define(`M_PDFLTX', `pdfelatex')
+ m4_define(`M_FMT', `efmt')
+ '
+)
+m4_divert`'m4_dnl
+.TH M_PDFTEX 1 "M_MANDATE" "Web2C M_WEB2CVERSION"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP\" for troff
+.el .ds OX TeX\" for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.\"=====================================================================
+
+.SH NAME
+M_PDFENG \- Direct PDF or DVI output from M_TEXP
+.\"=====================================================================
+
+.SH SYNTAX
+.B M_PDFENG
+[\fIoption\fR] ... [\fItexname\fR[\fI.tex\fR]] ... [\fIcommands\fR]
+.br
+.B M_PDFENG
+[\fIoption\fR] ... \e\fIfirst-line\fR
+.br
+.B M_PDFENG
+[\fIoption\fR] ... &\fI`'M_FMT args\fR
+.br
+.B M_PDFENG \-\-version
+.br
+.B M_PDFENG \-\-help
+.\"=====================================================================
+
+.SH USAGE
+Run M_PDFENGPP on
+.IR texname ,
+usually creating
+.I texname.pdf
+or
+.IR texname.dvi .
+Any remaining
+.I commands
+are processed as M_PDFENGPP input, after
+.I texname
+is read.
+.P
+If the first line of
+.I texname
+is
+.IR "%&M_FMT" ,
+where
+.I M_FMT
+is an existing format
+.RI ( .M_FMT )
+file, and if parsing of the first line is enabled, use this format.
+Else use
+.IR "name.M_FMT" ,
+where
+.I name
+is the program invocation name, most commonly M_PDFENG.
+.P
+Alternatively, if the first non-option argument begins with a backslash
+.IR \e ,
+interpret all non-option arguments as a line of M_PDFENGPP input.
+.P
+Alternatively, if the first non-option argument begins with an ampersand
+.IR & ,
+the next word is taken as the format
+.I M_FMT
+to read, overriding all else.
+Any remaining arguments
+.I args
+are processed as above.
+.P
+If no arguments or options are specified, prompt for input.
+.P
+M_PDFENGPP's handling of its command line arguments is similar to
+that of the other \*(TX programs in the
+.I WEB2C
+implementation.
+.P
+Non-alphanumeric characters on the command line
+might need quoting, depending on the shell used.
+.\"=====================================================================
+
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive.
+The complete documentation for this version of a \*(TX engine
+can be found in the manual
+.IR "The pdfTeX user manual"
+and in the info file or manual
+.IR "Web2C: A TeX implementation" .
+.P
+M_PDFENGPP is a version of M_TEXPP that can create
+.I PDF
+files as well as
+.I DVI
+files.
+In
+.I DVI
+mode,
+M_PDFENGPP can be used as complete replacement for the M_TEXPP engine.
+The selection of
+.I PDF
+or
+.I DVI
+mode is done by the
+.B --output-format
+option or by setting the
+.BI \epdfoutput
+register.
+.P
+The typical use of M_PDFENGPP is with a pregenerated format
+for which PDF output has been enabled.
+The
+.B M_PDFENG
+command uses the equivalent of the plain M_TEXPP format, and the
+.B M_PDFLTX
+command uses the equivalent of the M_LTXPP format.
+.P
+M_PDFENGPP can also be used for generating format
+.RI ( .M_FMT )
+files by call
+.BR "M_PDFENG --ini" .
+This gives the same functionality as the former
+.B M_PDFENGINI
+command, which is considered as deprecated.
+.\" The
+.\" .B M_PDFENGINI
+.\" and
+.\" .B M_PDFENGVIR
+.\" commands are M_PDFENGPP's analogues to the
+.\" .B M_ENGINI
+.\" and
+.\" .B M_ENGVIR
+.\" commands. In this installation, they are symlinks to the
+.\" .B M_PDFENG
+.\" executable.
+.P
+In
+.I PDF
+mode, M_PDFENGPP can natively handle graphics input formats
+.IR PNG ,
+.IR JPEG ,
+and
+.IR PDF .
+m4_ifdef(`OLD', `m4_dnl
+.P
+Nowadays M_PDFENGPP usually is just a link to the pdfe\*(TX program.
+', `')m4_dnl
+.\"=====================================================================
+
+.SH OPTIONS
+This version of M_PDFENGPP understands the following command line options,
+which can be also given starting with a single dash.
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --default-translate-file \ tcxname
+.rb
+Use the default translation table from file
+.IR tcxname .
+This option does not override a setting given in a
+.I %&
+line.
+The
+.BI --translate-file
+can overwrite this setting.
+m4_dnl------------------------------------------------------------------
+.TP
+m4_ifdef(`OLD', `', `m4_dnl
+.BI --M_FMT \ M_FMT
+.rb
+Use
+.I M_FMT
+as the name of the format to be used, instead of the name by which
+M_PDFENGPP was called or a
+.I %&
+line.
+m4_dnl------------------------------------------------------------------
+.TP
+')m4_dnl
+.B --enc
+.rb
+Enable enc\*(TX extension by Petr Olsak, see the file
+.IR "encdoc-e.pdf" .
+m4_dnl------------------------------------------------------------------
+.TP
+.B --file-line-error-style
+.rb
+Print error messages in the form
+.I file:line:error
+which is similar to the way many compilers format them.
+m4_dnl------------------------------------------------------------------
+.TP
+m4_ifdef(`OLD', `m4_dnl
+.BI --M_FMT \ M_FMT
+.rb
+Use
+.I M_FMT
+as the name of the format to be used, instead of the name by which
+M_PDFENGPP was called or a
+.I %&
+line.
+m4_dnl------------------------------------------------------------------
+.TP
+', `')m4_dnl
+.B --help
+.rb
+Print help message with list of command line options and exit.
+m4_dnl------------------------------------------------------------------
+.TP
+.B --ini
+.rb
+Start in
+.I INI
+mode, for dumping a format M_FMT.
+The
+.I INI
+mode can als be used for general typesetting.
+As no format is preloaded,
+basic initializations like setting catcodes might be required.
+\." ; this is implicitly true if the program is called
+\." as
+\." .BR M_PDFENGINI .
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --interaction \ mode
+.rb
+Sets the interaction mode. The mode can be either
+.IR batchmode ,
+.IR nonstopmode ,
+.IR scrollmode ,
+and
+.IR errorstopmode .
+The meaning of these modes is the same as that of the corresponding
+\ecommands.
+m4_dnl------------------------------------------------------------------
+.TP
+.B --ipc
+.rb
+In
+.I DVI mode,
+send
+.I DVI
+output to a socket as well as the usual output file.
+Whether this option is available is the choice of the installer.
+This option is ignored in
+.I PDF
+mode.
+m4_dnl------------------------------------------------------------------
+.TP
+.B --ipc-start
+.rb
+In
+.DVI
+mode, works as
+.BR --ipc ,
+and starts the server at the other end as well.
+Whether this option is available is the choice of the installer.
+This option is ignored in
+.I PDF
+mode.
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --jobname \ name
+.rb
+Use
+.I name
+for the job name, instead of deriving it from the name of the input file.
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --kpathsea-debug \ bitmask
+.rb
+Sets path searching debugging flags according to the bitmask. See the
+.I Kpathsea
+manual for details.
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --mktex \ fmt
+.rb
+Enable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --mltex
+.rb
+Enable MLTeX extensions such as
+.IR \echarsubdef .
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --no-mktex \ fmt
+.rb
+Disable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --output-comment \ string
+.rb
+In
+.I DVI
+mode, use
+.I string
+for the DVI file comment instead of the date.
+This option is ignored in
+.I PDF
+mode.
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --output-format \ format
+.rb
+Set output format mode,
+where
+.I format
+must be either
+.I pdf
+or
+.IR dvi .
+This option can be overridden by setting the
+.BI \epdfoutput
+register.
+The output format mode also influences the set of graphics formats
+understood by M_PDFENGPP.
+m4_dnl------------------------------------------------------------------
+.TP
+.B --parse-first-line
+.rb
+If the first line of the main input file begins with
+.IR %& ,
+parse it to look for a dump name or a
+.B --translate-file
+option.
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --progname \ name
+.rb
+Pretend to be program
+.IR name .
+This affects both the format used and the search paths.
+.TP
+.B --recorder
+.rb
+Enable the filename recorder.
+This leaves a trace of the files opened for input and output
+in a file with extension
+.IR .fls .
+m4_dnl------------------------------------------------------------------
+.TP
+.B --shell-escape
+.rb
+Enable the
+.BI \ewrite18{ command }
+construct. The
+.I command
+can be any shell command.
+This construct is often disallowed for security reasons.
+m4_dnl------------------------------------------------------------------
+.TP
+.B --src-specials
+.rb
+In
+.I DVI
+mode, insert source specials into the
+.I DVI
+file.
+This option is ignored in
+.I PDF
+mode.
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --src-specials \ where
+.rb
+In
+.I DVI
+mode, insert source specials in certain placed of the
+.I DVI
+file.
+.I where
+is a comma-separated value list:
+.IR cr ,
+.IR display ,
+.IR hbox ,
+.IR math ,
+.IR par ,
+.IR parent ,
+or
+.IR vbox .
+This option is ignored in
+.I PDF
+mode.
+m4_dnl------------------------------------------------------------------
+.TP
+.BI --translate-file \ tcxname
+.rb
+Use the translation table in file
+.I tcxname
+for mapping of input characters
+and re-mapping of output characters.
+This option overrides a setting given in a
+.I %&
+line.
+m4_dnl------------------------------------------------------------------
+.TP
+.B --version
+.rb
+Print version and copyright information and exit.
+.\"=====================================================================
+
+.SH ENVIRONMENT
+See the
+.I Kpathsea library
+documentation, section ```Path searching'''
+for precise details of how the environment variables are used.
+The
+.B kpsewhich
+utility can be used to query the values of the variables.
+.P
+One caveat:
+In most M_PDFENGPP formats, you cannot use ~ in a filename
+you give directly to M_PDFENGPP, because ~ is an active character,
+and hence is expanded, not taken as part of the filename.
+Other programs, such as \*(MF, do not have this problem.
+.P
+.TP
+TEXMFOUTPUT
+Normally, M_PDFENGPP puts its output files in the current directory.
+If any output file cannot be opened there, it tries to open it in the
+directory specified in the environment variable TEXMFOUTPUT.
+There is no default value for that variable. For example, if you say
+.I M_PDFENG paper
+and the current directory is not writable, if TEXMFOUTPUT has
+the value
+.IR /tmp ,
+M_PDFENGPP attempts to create
+.I /tmp/paper.log
+(and
+.IR /tmp/paper.pdf ,
+if any output is produced.)
+.TP
+TEXINPUTS
+Search path for files read in by
+.I \einput
+and
+.I \eopenin
+commands,
+as well as for graphics files.
+This should probably start with ```.''', so
+that user files are found before system files. An empty path
+component will be replaced with the paths defined in the
+.I texmf.cnf
+file. For example, set TEXINPUTS to ".:/home/usr/tex:" to prepend the
+current direcory and ```/home/user/tex''' to the standard search path.
+.TP
+TEXFORMATS
+Search path for format
+.RI ( .M_FMT )
+files.
+.TP
+TEXPOOL
+Search path for string pool
+.RI ( .pool )
+files.
+.TP
+ENCFONTS
+Search path for font encoding
+.RI ( .enc )
+files.
+.TP
+TEXFONTMAPS
+Search path for font mapping
+.RI ( .map )
+files.
+.TP
+TFMFONTS
+Search path for font metric
+.RI ( .tfm )
+files.
+.TP
+VFFONTS
+Search path for virtual font
+.RI ( .vf )
+files.
+.TP
+T1FONTS
+Search path for Type 1 font files
+.RI ( .pfa )
+and
+.RI ( .pfb ")."
+.TP
+TTFONTS
+Search path for True-Type font
+.RI ( .ttf )
+files.
+.TP
+PKFONTS
+Search path for pixel font
+.RI ( .pk )
+files.
+.TP
+TEXEDIT
+Command template for switching to editor. The default, usually
+.BR vi ,
+is set when M_PDFENGPP is compiled.
+.\"=====================================================================
+
+.SH FILES
+The location of the files mentioned below varies from system to
+system. Use the
+.B kpsewhich
+utility to find their locations.
+.TP
+.I texmf.cnf
+Configuration file with default settings for M_PDFENGPP as well
+as for other \*(TX and \*(MF related programs and utilities.
+.TP
+.I *.M_FMT
+Predigested M_PDFENGPP format files.
+.TP
+.I *.pool
+String pool files.
+.TP
+.I *.enc
+Font encoding files.
+.TP
+.I *.map
+Text files containing font mapping definitions
+between TFM entries and font files.
+The default file is
+.IR pdftex.map .
+.TP
+.I *.tfm
+Font metric files.
+.TP
+.I *.vf
+Virtual font files.
+.TP
+.IR *.pfa , \ *.pfb
+Type 1 font files (ASCII and binary format).
+.TP
+.I *.ttf
+True-Type font files.
+.TP
+.I *.pk
+Pixel font files.
+.TP
+.I *.tcx
+Character translation table files.
+.\"=====================================================================
+
+.SH BUGS
+This version of M_PDFENGPP implements a number of optional extensions.
+In fact, many of these extensions conflict to a greater or lesser
+extent with the definition of M_PDFENGPP. When such extensions are
+enabled, the banner printed when M_PDFENGPP starts is changed to print
+.B M_PDFENGKP
+instead of
+.BR M_PDFENGP .
+.P
+This version of M_PDFENGPP fails to trap arithmetic overflow when
+dimensions are added or subtracted. Cases where this occurs are rare,
+but when it does the generated
+.I DVI
+file will be invalid. Whether a generated
+.I PDF
+file would be usable is unknown.
+\." .P
+.\"=====================================================================
+
+.SH AVAILABILITY
+M_PDFENGPP is available for a large variety of machine architectures
+and operation systems.
+M_PDFENGPP is part of all major \*(TX distributions.
+.P
+Information on how to get M_PDFENGPP and related information
+is available at the
+.BI "http://www.pdftex.org" \ pdf\*(TX
+website.
+.P
+The following M_PDFENGPP related mailing list is available:
+.BR "pdftex@tug.org" .
+This is a mailman list;
+to subscribe, send a message with the subject
+.I subscribe
+to
+.BR pdftex-request@tug.org .
+More about the list can be found at the
+.B "http://tug.org/mailman/listinfo/pdftex"
+.I mailing list
+website.
+.\"=====================================================================
+
+.SH "SEE ALSO"
+.BR tex (1),
+m4_ifdef(`OLD',m4_dnl
+`.BR mf (1).',m4_dnl
+`.BR mf (1),
+.BR etex (1).')
+.\"=====================================================================
+
+.SH AUTHORS
+The authors of M_PDFENGPP are Han The Thanh and the pdf\*(TX team.
diff --git a/Build/source/texk/web2c/man/pdfxtex.man b/Build/source/texk/web2c/man/pdfxtex.man
new file mode 100644
index 00000000000..edbfff44aa6
--- /dev/null
+++ b/Build/source/texk/web2c/man/pdfxtex.man
@@ -0,0 +1,481 @@
+.TH PDFXTEX 1 "25 March 2004" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.\"=====================================================================
+.SH NAME
+pdfxtex, pdfxinitex, pdfxvirtex \- PDF output from e-TeX
+.SH SYNOPSIS
+.B pdfxtex
+.RI [ options ]
+[\fB&\fR \fIformat\fR ]
+[ \fIfile\fR | \fB\e\fR \fIcommands\fR ]
+.\"=====================================================================
+.SH DESCRIPTION
+Run the pdfx\*(TX typesetter on
+.IR file ,
+usually creating
+.IR file.pdf .
+If the file argument has no extension, ".tex" will be appended to it.
+Instead of a filename, a set of pdfx\*(TX commands can be given, the first
+of which must start with a backslash.
+With a
+.BI & format
+argument pdfx\*(TX uses a different set of precompiled commands,
+contained in
+.IR format.fmt ;
+it is usually better to use the
+.B -fmt
+.I format
+option instead.
+.PP
+pdfx\*(TX is a version of e-\*(TX that can create
+.I PDF
+files as well as
+.I DVI
+files.
+.PP
+In
+.I DVI
+mode, pdfx\*(TX can be used as a complete replacement of the e-\*(TX
+engine.
+.PP
+The typical use of pdfx\*(TX is with a pregenerated formats for which
+PDF output has been enabled. The
+.B pdfxtex
+command uses the equivalent of the plain e-\*(TX format, and the
+.B pdfxlatex
+command uses the equivalent of the e-\*(LX format.
+To generate formats, use the
+.B -ini
+switch.
+.PP
+The
+.B pdfxinitex
+and
+.B pdfxvirtex
+commands are pdfx\*(TX's analogues to the
+.B einitex
+and
+.B evirtex
+commands. In this installation, they are symbolic links to the
+.B pdfxtex
+executable. These symbolic links may not exist at all.
+.PP
+In
+.I PDF
+mode, pdfx\*(TX can natively handle the
+.IR PDF ,
+.IR JPG ,
+and
+.I PNG
+graphics formats.
+pdfx\*(TX's handling of its command-line arguments is similar to that of
+of the other \*(TX programs in the
+.I web2c
+implementation.
+.\"=====================================================================
+.SH OPTIONS
+This version of pdfx\*(TX understands the following command line options.
+.TP
+.B -enc
+.rb
+Enable the enc\*(TX extensions. This option is only effective in
+combination with
+.BR -ini .
+For documentation of the enc\*(TX extensions see
+.BR http://www.olsak.net/enctex.html .
+.TP
+.B -file-line-error
+.rb
+Print error messages in the form
+.I file:line:error
+which is similar to the way many compilers format them.
+.TP
+.B -no-file-line-error
+.rb
+Disable printing error messages in the
+.I file:line:error
+style.
+.TP
+.B -file-line-error-style
+.rb
+This is the old name of the
+.B -file-line-error
+option.
+.TP
+.BI -fmt \ format
+.rb
+Use
+.I format
+as the name of the format to be used, instead of the name by which
+pdfx\*(TX was called or a
+.I %&
+line.
+.TP
+.B -halt-on-error
+.rb
+Exit with an error code when an error is encountered during processing.
+.TP
+.B -help
+.rb
+Print help message and exit.
+.TP
+.B -ini
+.rb
+Start in
+.I INI
+mode, which is used to dump formats. The
+.I INI
+mode can be used for typesetting, but no format is preloaded, and
+basic initializations like setting catcodes may be required.
+.TP
+.BI -interaction \ mode
+.rb
+Sets the interaction mode. The mode can be either
+.IR batchmode ,
+.IR nonstopmode ,
+.IR scrollmode ,
+and
+.IR errorstopmode .
+The meaning of these modes is the same as that of the corresponding
+\ecommands.
+.TP
+.B -ipc
+.rb
+Send DVI or PDF output to a socket as well as the usual output file.
+Whether this option is available is the choice of the installer.
+.TP
+.B -ipc-start
+.rb
+As
+.BR -ipc ,
+and starts the server at the other end as well. Whether this option
+is available is the choice of the installer.
+.TP
+.BI -jobname \ name
+.rb
+Use
+.I name
+for the job name, instead of deriving it from the name of the input file.
+.TP
+.BI -kpathsea-debug \ bitmask
+.rb
+Sets path searching debugging flags according to the bitmask. See the
+.I Kpathsea
+manual for details.
+.TP
+.BI -mktex \ fmt
+.rb
+Enable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.B -mltex
+.rb
+Enable ML\*(TX extensions. Only effective in combination with
+.BR -ini .
+.TP
+.BI -no-mktex \ fmt
+.rb
+Disable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.BI -output-comment \ string
+.rb
+In
+.I DVI
+mode, use
+.I string
+for the
+.I DVI
+file comment instead of the date. This option is ignored
+in
+.I PDF
+mode.
+.TP
+.BI -output-directory \ directory
+.rb Write output files in
+.I directory
+instead of the current directory. Look up input files in
+.I directory
+first, the along the normal search path.
+.TP
+.BI -output-format \ format
+.rb
+Set the output format mode, where
+.I format
+must be either
+.I pdf
+or
+.IR dvi .
+This also influences the set of graphics formats understood by pdfx\*(TX.
+.TP
+.B -parse-first-line
+.rb
+If the first line of the main input file begins with
+.I %&
+parse it to look for a dump name or a
+.B -translate-file
+option.
+.TP
+.B -no-parse-first-line
+.rb
+Disable parsing of the first line of the main input file.
+.TP
+.BI -progname \ name
+.rb
+Pretend to be program
+.IR name .
+This affects both the format used and the search paths.
+.TP
+.B -recorder
+.rb
+Enable the filename recorder.
+This leaves a trace of the files opened for input and output
+in a file with extension
+.IR .fls .
+.TP
+.B -shell-escape
+.rb
+Enable the
+.BI \ewrite18{ command }
+construct. The
+.I command
+can be any shell command. This construct is normally
+disallowed for security reasons.
+.TP
+.B -no-shell-escape
+.rb
+Disable the
+.BI \ewrite18{ command }
+construct, even if it is enabled in the
+.I texmf.cnf
+file.
+.TP
+.B -src-specials
+.rb
+In
+.I DVI
+mode, insert source specials into the
+.I DVI
+file.
+This option is ignored in
+.I PDF
+mode.
+.TP
+.BI -src-specials \ where
+.rb
+In
+.I DVI
+mode, insert source specials in certain placed of the
+.I DVI
+file.
+.I where
+is a comma-separated value list:
+.IR cr ,
+.IR display ,
+.IR hbox ,
+.IR math ,
+.IR par ,
+.IR parent ,
+or
+.IR vbox .
+This option is ignored in
+.I PDF
+mode.
+.TP
+.BI -translate-file \ tcxname
+.rb
+Use the
+.I tcxname
+translation table to set the mapping of input characters and
+re-mapping of output characters.
+.TP
+.BI -default-translate-file \ tcxname
+.rb
+Like
+.B -translate-file
+except that a
+.I %&
+line can overrule this setting.
+.TP
+.B -version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH ENVIRONMENT
+See the Kpathsearch library documentation (the `Path specifications'
+node) for precise details of how the environment variables are used.
+The
+.B kpsewhich
+utility can be used to query the values of the variables.
+.PP
+One caveat: In most pdfx\*(TX formats, you cannot use ~ in a filename you
+give directly to pdfx\*(TX, because ~ is an active character, and hence is
+expanded, not taken as part of the filename. Other programs, such as
+\*(MF, do not have this problem.
+.PP
+.TP
+TEXMFOUTPUT
+Normally, pdfx\*(TX puts its output files in the current directory. If
+any output file cannot be opened there, it tries to open it in the
+directory specified in the environment variable TEXMFOUTPUT.
+There is no default value for that variable. For example, if you say
+.I pdfxtex paper
+and the current directory is not writable, if TEXMFOUTPUT has
+the value
+.IR /tmp ,
+pdfx\*(TX attempts to create
+.I /tmp/paper.log
+(and
+.IR /tmp/paper.pdf ,
+if any output is produced.)
+.TP
+TEXINPUTS
+Search path for
+.I \einput
+and
+.I \eopenin
+files.
+This should probably start with ``.'', so
+that user files are found before system files. An empty path
+component will be replaced with the paths defined in the
+.I texmf.cnf
+file. For example, set TEXINPUTS to ".:/home/usr/tex:" to prepend the
+current direcory and ``/home/user/tex'' to the standard search path.
+.TP
+TEXFORMATS
+Search path for format files.
+.TP
+TEXPOOL
+search path for
+.B pdfxtex
+internal strings.
+.TP
+TEXEDIT
+Command template for switching to editor. The default, usually
+.BR vi ,
+is set when pdfx\*(TX is compiled.
+.TP
+TFMFONTS
+Search path for font metric
+.RI ( .tfm )
+files.
+.\"=====================================================================
+.SH FILES
+The location of the files mentioned below varies from system to
+system. Use the
+.B kpsewhich
+utility to find their locations.
+.TP
+.I pdfxtex.pool
+Text file containing pdfx\*(TX's internal strings.
+.TP
+.I pdftex.map
+Filename mapping definitions.
+.TP
+.I *.tfm
+Metric files for pdfx\*(TX's fonts.
+.TP
+.I *.fmt
+Predigested pdfx\*(TX format (.\|fmt) files.
+.br
+.\"=====================================================================
+.SH NOTES
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of pdfx\*(TX can be found in the info
+manual
+.IR "Web2C: A TeX implementation" .
+.\"=====================================================================
+.SH BUGS
+This version of pdfx\*(TX implements a number of optional extensions.
+In fact, many of these extensions conflict to a greater or lesser
+extent with the definition of pdfx\*(TX. When such extensions are
+enabled, the banner printed when pdfx\*(TX starts is changed to print
+.B pdfxTeXk
+instead of
+.BR pdfxTeX .
+.PP
+This version of pdfx\*(TX fails to trap arithmetic overflow when
+dimensions are added or subtracted. Cases where this occurs are rare,
+but when it does the generated
+.I DVI
+file will be invalid. Whether a generated
+.I PDF
+file would be usable is unknown.
+.\"=====================================================================
+.SH AVAILABILITY
+pdfx\*(TX is available for a large variety of machine architectures
+and operation systems.
+pdfx\*(TX is part of all major \*(TX distributions.
+.P
+Information on how to get pdfx\*(TX and related information
+is available at the
+.BI "http://tug.org" \ TUG
+website.
+The most recent version of pdfx\*(TX is available for anonymous
+ftp at the
+.B http://www.pdftex.de/tex/pdftex/
+.IR "pdfx\*(TX development site" .
+.P
+The following pdfx\*(TX related mailing list is available:
+.BR pdftex@tug.org .
+This is a mailman list;
+to subscribe send a message containing
+.I subscribe
+to
+.BR pdftex-request@tug.org .
+More about the list can be found at the
+.B "http://tug.org/mailman/listinfo/pdftex"
+.I mailing list
+website.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tex (1),
+.BR mf (1),
+.BR etex (1),
+.BR pdftex (1).
+.\"=====================================================================
+.SH AUTHORS
+The primary authors of pdf\*(TX are Han The Thanh, Petr Sojka, and
+Jiri Zlatuska.
+.PP
+\*(TX was designed by Donald E. Knuth,
+who implemented it using his \*(WB system for Pascal programs.
+It was ported to Unix at Stanford by Howard Trickey, and
+at Cornell by Pavel Curtis.
+The version now offered with the Unix \*(TX distribution is that
+generated by the \*(WB to C system
+.RB ( web2c ),
+originally written by Tomas Rokicki and Tim Morgan.
+.PP
+The enc\*(TX extensions were written by Petr Olsak.
diff --git a/Build/source/texk/web2c/man/pktogf.man b/Build/source/texk/web2c/man/pktogf.man
new file mode 100644
index 00000000000..808ec870af6
--- /dev/null
+++ b/Build/source/texk/web2c/man/pktogf.man
@@ -0,0 +1,103 @@
+.TH PKTOGF 1 "14 December 1993" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+pktogf \- convert packed font files to generic font files
+.SH SYNOPSIS
+.B pktogf
+[
+.B \-v
+]
+.I pk_file_name
+[
+.I gf_file_name
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B pktogf
+program converts a packed font file
+.RI ( pk )
+to a generic font file
+.RI ( gf ).
+Packed
+font files are much smaller than the corresponding
+.I gf
+files,
+but some DVI readers only understand
+.I gf
+files.
+.PP
+The
+.I pk_file_name
+on the command line must be complete. Because
+the resolution is part of the extension, it would not make
+sense to append a default extension as is done with \*(TX or
+DVI-reading software. The
+.I gf_file_name
+defaults to the same (stripped) name as
+.IR pk_file_name ,
+and it is placed in the current
+working directory with the
+.I gf
+suffix replacing
+.IR pk .
+For example, the input file
+.I io.300pk
+would become
+.IR io.300gf .
+.\"=====================================================================
+.SH OPTIONS
+Unless the
+.B \-v
+switch is given,
+.B pktogf
+operates silently. With
+.BR \-v ,
+the version number of the program and statistics about the
+unpacking are output to
+.IR stdout .
+.\"=====================================================================
+.SH ENVIRONMENT
+.B pktogf
+looks for
+.I pk_file_name
+using the
+environment variable PKFONTS. If that is not set, it uses the variable
+TEXPKS. If that is not set, it uses TEXFONTS. If that is not set, it
+uses the system default.
+.PP
+See
+.BR tex (1)
+for the details of the searching.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR gftopk (1),
+.BR gftype (1),
+.BR pktype (1).
+.br
+Donald E. Knuth et al.,
+.IR \*(MFware .
+.\"=====================================================================
+.SH AUTHORS
+Tomas Rokicki wrote the program.
+Pierre MacKay adapted it for compilation with
+.BR web2c .
diff --git a/Build/source/texk/web2c/man/pktype.man b/Build/source/texk/web2c/man/pktype.man
new file mode 100644
index 00000000000..9cb3508e79f
--- /dev/null
+++ b/Build/source/texk/web2c/man/pktype.man
@@ -0,0 +1,85 @@
+.TH PKTYPE 1 "13 March 1996" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+pktype \- verify and translate a packed font bitmap file to plain text
+.SH SYNOPSIS
+.B pktype
+.I pk_file
+[
+.I output_file
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B pktype
+program translates a packed font file
+.RI ( pk )
+(output by, for example,
+.BR gftopk (1)
+to a file that humans can read. It also serves as a
+.I pk
+file-validating program (i.e., if
+.B pktype
+can read it, it's correct) and as an example of a
+.IR pk -reading
+program for other software that wants to read
+.I pk
+files.
+.PP
+The
+.I pk_file
+on the command line must be complete. Because
+the resolution is part of the extension, it would not make
+sense to append a default extension as is done with \*(TX or
+DVI-reading software. If no
+.I output_file
+is specified, the plain text translation is written to standard output.
+.PP
+The output file gives a compact encoding of the packed encoding, using
+conventions described in the source code. Run lengths of black pixels
+alternate with parenthesized run lengths of white pixels, and brackets
+are used to indicate when a row should be repeated.
+.\"=====================================================================
+.SH ENVIRONMENT
+.B pktype
+looks for
+.I pk_file
+using the environment variable PKFONTS. If that is not set, it uses
+the variable TEXPKS. If that is not set, it uses TEXFONTS. If that
+is not set, it uses the system default.
+.PP
+See
+.BR tex (1)
+for the details of the searching.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR dvitype (1),
+.BR gftopk (1),
+.BR gftype (1).
+.br
+Donald E. Knuth et al.,
+.IR \*(MFware .
+.\"=====================================================================
+.SH AUTHORS
+Tomas Rokicki wrote the program.
+Donald E. Knuth originally ported it to Unix.
+Pierre MacKay adapted it for compilation with Web2c.
diff --git a/Build/source/texk/web2c/man/pltotf.man b/Build/source/texk/web2c/man/pltotf.man
new file mode 100644
index 00000000000..60a3b703cb1
--- /dev/null
+++ b/Build/source/texk/web2c/man/pltotf.man
@@ -0,0 +1,74 @@
+.TH PLTOTF 1 "27 December 1992" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if n .ds WB Web
+.if t .ds WB W\s-2EB\s0
+.\"=====================================================================
+.SH NAME
+pltotf \- convert property list files to TeX font metric (tfm) format
+.SH SYNOPSIS
+.B pltotf
+[
+.B \-verbose
+]
+.I pl_file_name
+.I tfm_file_name
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B pltotf
+program translates a (human-oriented) \*(WB property list file to a
+(program-oriented) \*(TX font metric file. Thus, after editing the property
+list file, a TFM file can be generated for use with, for example,
+.BR tex (1).
+.PP
+Both the
+.I pl_file_name
+and the
+.I tfm_file_name
+must be complete; no adding of default extensions or path searching is done.
+.\"=====================================================================
+.SH OPTIONS
+Without the
+.B \-verbose
+option,
+.B pltotf
+operates silently. With it, a banner and progress report are printed on
+.IR stdout .
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tftopl (1).
+.br
+Donald E. Knuth,
+.IR "\*(OXware" .
+.br
+Donald E. Knuth,
+.IR "The \*(MFbook" ,
+(Volume C of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13445-4.
+.\"=====================================================================
+.SH AUTHORS
+Donald E. Knuth wrote the program. It was published as
+part of the
+.I \*(OXware
+technical report, available from the \*(TX Users Group.
+Howard Trickey, Pavel Curtis, and Richard Furuta originally ported it to
+Unix.
diff --git a/Build/source/texk/web2c/man/pooltype.man b/Build/source/texk/web2c/man/pooltype.man
new file mode 100644
index 00000000000..bc7dabe36af
--- /dev/null
+++ b/Build/source/texk/web2c/man/pooltype.man
@@ -0,0 +1,45 @@
+.TH POOLTYPE 1 "27 December 1992" "Web2C @VERSION@"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if n .ds WB Web
+.if t .ds WB W\s-2EB\s0
+.\"=====================================================================
+.SH NAME
+pooltype \- display a WEB pool file
+.SH SYNOPSIS
+.B pooltype
+.I pool_file_name
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B pooltype
+program translates a (program-oriented) \*(WB string pool file to a
+(human-oriented) text file.
+.PP
+The
+.I pool_file_name
+must be complete; no adding of default extensions or path searching is done.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tangle (1).
+.\"=====================================================================
+.SH AUTHORS
+Donald E. Knuth wrote the program and originally ported it to Unix. It was
+published as part of the
+.I \*(OXware
+technical report, available from the \*(TX Users Group.
diff --git a/Build/source/texk/web2c/man/slitex.min b/Build/source/texk/web2c/man/slitex.min
new file mode 100644
index 00000000000..37031db8b60
--- /dev/null
+++ b/Build/source/texk/web2c/man/slitex.min
@@ -0,0 +1,39 @@
+.TH SLITEX 1 "27 December 1992"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+slitex \- make LaTeX slides
+.SH SYNOPSIS
+.B slitex
+[ first-line ]
+.\"=====================================================================
+.SH DESCRIPTION
+The
+.B slitex
+program is a variant of
+.BR latex (1),
+designed for generating slides.
+It is described in Appendix A of
+.IR "\*(LX \- A Document Preparation System" .
+All the capabilities described in
+.BR tex (1)
+are present.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR latex (1),
+.BR tex (1).
+.br
+Leslie Lamport,
+.IR "\*(LX \- A Document Preparation System" ,
+Addison-Wesley, 1985, ISBN 0-201-15790-X.
diff --git a/Build/source/texk/web2c/man/spell.add b/Build/source/texk/web2c/man/spell.add
new file mode 100644
index 00000000000..0d9bbd4159f
--- /dev/null
+++ b/Build/source/texk/web2c/man/spell.add
@@ -0,0 +1,236 @@
+AMSLATEX
+AMSTEX
+AY
+AmSLaTeX
+AmSTeX
+Atari
+BI
+BIBINPUTS
+BIBTEX
+BX
+BibTeX
+Breitenlohner
+CONTENTS.tex
+CS
+DOC
+DVI
+DVITYPE
+DeVice
+Furuta
+GFFONTS
+GFTODVI
+GFTOPK
+GFTYPE
+INITEX
+ISBN
+Ignacio
+LX
+LaTeX
+Lamport
+Liang
+MAGSTEP
+MF
+MFBASES
+MFEDIT
+MFINPUTS
+MFPOOL
+MFT
+MFTERM
+MacKay
+ONLINE
+Oren
+PATGEN
+PKFONTS
+PKTOGF
+PKTYPE
+PLTOTF
+POOLTYPE
+Patashnik
+Pavel
+Rokicki
+SLITEX
+Sewell
+Spivak
+SunView
+TEX
+TEXEDIT
+TEXFONTS
+TEXFORMATS
+TEXINPUTS
+TEXMFOUTPUT
+TEXPKS
+TEXPOOL
+TFM
+TFTOPL
+TUGboat
+TW
+TeX
+Tek
+Tomas
+Trickey
+VF
+VFFONTS
+VFTOVP
+VIRTEX
+VPTOVF
+WB
+Zabala
+a.out
+al
+amsart
+amsbook
+amslatex
+amslatex.tex
+amstex
+amstexl
+amstexl.fmt
+aux
+auxname
+batchmode
+bbl
+bibtex
+bitmap
+bitmaps
+blecchhh
+bst
+btxbst.doc
+btxdoc.bib
+btxdoc.tex
+btxhak.tex
+ch
+changefile
+charcode
+cmbase.mf
+cmbase.mft
+cmmf.base
+cmr8
+cmtt10
+com
+controlsequence
+def
+defs
+dpi
+ds
+dvi
+dvitype
+emacs
+font.mf
+foo
+foo.base
+footex
+footex.fmt
+gf
+gf,pk
+gftodvi
+gftopk
+gftype
+gray.mf
+gray.tfm
+grayfont
+grayfontarea
+hp2627
+hy
+hyphen.tex
+iffalse
+ing
+inimf
+initex
+io.2602gf
+io.300gf
+io.300pk
+io.dvi
+jobname
+karl
+lamstex
+lamstex.fmt
+lamstex.tmp
+latex.fmt
+letterforms
+linenumber
+litprog
+localfont
+lplain
+lplain.fmt
+mag
+magstep
+magsteps
+mf
+mf.pool
+mf.tbl
+mfput
+mft
+mftmac.tex
+modes.mf
+mybase
+myfmt
+myfonts
+mylib
+mytex
+mytex.fmt
+na
+nl
+nnn
+nocite
+nput
+nr
+null.mf
+null.tex
+online
+openin
+paper.dvi
+paper.log
+paper.tex
+patgen
+phen
+pk
+pktogf
+pktype
+pl
+plain.fmt
+plain.mf
+plain.mft
+plain.tex
+pltotf
+pooltype
+prettyprinting
+printengine
+puter
+setenv
+shsu.edu
+site.h
+slantfont
+slantimagen6
+slitex
+slitex.fmt
+splain
+splain.fmt
+supercedes
+sy
+tek
+testart.tex
+testbook.tex
+tex
+tex.fmt
+tex.pool
+texinfo
+texput
+tfm
+tftopl
+tion
+typesettable
+ucb
+ump
+uniterm
+username
+vf
+vfm
+vftovp
+virmf
+virtex
+vpl
+vptovf
+web2c
+webfile
+webmac.tex
+xampl.bib
+xterm
diff --git a/Build/source/texk/web2c/man/tangle.man b/Build/source/texk/web2c/man/tangle.man
new file mode 100644
index 00000000000..4cf40586f8d
--- /dev/null
+++ b/Build/source/texk/web2c/man/tangle.man
@@ -0,0 +1,180 @@
+.TH TANGLE 1 "20 October 2002" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if n .ds WB Web
+.if t .ds WB W\s-2EB\s0
+.\"=====================================================================
+.SH NAME
+tangle \- translate WEB to Pascal
+.SH SYNOPSIS
+.B tangle
+[
+.RI options
+]
+.I webfile[.web]
+[
+.I changefile[.ch]
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B tangle
+program converts a \*(WB
+source document into a Pascal program that may be compiled in the usual
+way with the on-line Pascal compiler (e.g.,
+.BR pc (1)).
+The output file is packed into lines of 72 characters or less, with
+the only concession to readability being the termination of lines at
+semicolons when this can be done conveniently.
+.PP
+The \*(WB language allows you to prepare a single document containing all
+the information that is needed both to produce a compilable Pascal
+program and to produce a well-formatted document describing the program
+in as much detail as the writer may desire. The user of \*(WB must be
+familiar with both \*(TX and Pascal. \*(WB also provides a relatively
+simple, although adequate, macro facility that permits a Pascal program
+to be written in small easily-understood modules.
+.PP
+The command line should have either one or two names on it.
+The first is taken as the \*(WB file (and
+.I .web
+is added if there is no
+extension).
+If there is another name, it is a change file (and
+.I .ch
+is added if there is
+no extension). The change file overrides parts of the \*(WB file,
+as described in the \*(WB system documentation.
+.PP
+The output files are a Pascal file and a string pool file,
+whose names are formed by adding
+.I .p
+and
+.I .pool
+respectively to the root of the \*(WB file name.
+.\"=====================================================================
+.SH "OPTIONS"
+This version of
+.B tangle
+understands the following options. Note that some of these options
+may render the output unsuitable for processing by a Pascal compiler.
+.TP
+.B --help
+.rb
+Print help message and exit.
+.TP
+.BI --length \ number
+.rb
+Compare only the first
+.I number
+characters of identifiers when checking for collisions. The default
+is 32, the original
+.B tangle
+used 7.
+.TP
+.B --loose
+.rb
+When checking for collisions between identifiers, honor the settings
+of the
+.BR --lowercase ,
+.BR --mixedcase ,
+.BR --uppercase ,
+and
+.B --underline
+options. This is the default.
+.TP
+.B --lowercase
+.rb
+Convert all identifiers to lowercase.
+.TP
+.B --mixedcase
+.rb
+Retain the case of identifiers. This is the default.
+.TP
+.B --strict
+.rb
+When checking for collisions between identifiers, strip underlines and
+convert all identifiers to uppercase first.
+.TP
+.B --underline
+.rb
+Retain underlines (also known as underscores) in identifiers.
+.TP
+.B --uppercase
+.rb
+Convert all identifiers to uppercase. This is the behaviour of the
+original
+.BR tangle .
+.TP
+.B --version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR pc (1),
+.BR pxp (1)
+(for formatting
+.B tangle
+output when debugging),
+.BR tex (1).
+.PP
+Donald E. Knuth,
+.IR "The \*(WB System of Structured Documentation" .
+.PP
+Donald E. Knuth,
+.IR "Literate Programming" ,
+Computer Journal
+.BR 27 ,
+97\-111, 1984.
+.PP
+Wayne Sewell,
+.IR "Weaving a Program" ,
+Van Nostrand Reinhold, 1989, ISBN 0-442-31946-0.
+.PP
+Donald E. Knuth,
+.I "\*(OX: The Program"
+(Volume B of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13437-3.
+.PP
+Donald E. Knuth,
+.I "\*(MF: The Program"
+(Volume D of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13438-1.
+.PP
+These last two are by far the largest extant examples of \*(WB
+programs.
+.PP
+There is an active Internet electronic mail discussion list on the
+subject of literate programming; send a subscription request to
+.I litprog-request@shsu.edu
+to join.
+.\"=====================================================================
+.SH AUTHORS
+\*(WB was designed by Donald E. Knuth, based on an earlier system
+called DOC (implemented by Ignacio Zabala).
+The
+.B tangle
+and
+.B weave
+programs are themselves written in \*(WB. The system
+was originally ported to Unix at Stanford by Howard Trickey, and at
+Cornell by Pavel Curtis.
diff --git a/Build/source/texk/web2c/man/tex.man b/Build/source/texk/web2c/man/tex.man
new file mode 100644
index 00000000000..349be90923e
--- /dev/null
+++ b/Build/source/texk/web2c/man/tex.man
@@ -0,0 +1,541 @@
+.TH TEX 1 "21 August 2004" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if n .ds WB Web
+.if t .ds WB W\s-2EB\s0
+.\" EX and EE are used for displays that are pure code
+.de EX
+.nf
+.ft CW
+..
+.de EE
+.ft R
+.fi
+..
+.\"=====================================================================
+.SH NAME
+tex, virtex, initex \- text formatting and typesetting
+.SH SYNOPSIS
+.B tex
+.RI [ options ]
+[\fB&\fR \fIformat\fR ]
+[ \fIfile\fR | \fB\e\fR \fIcommands\fR ]
+.\"=====================================================================
+.SH DESCRIPTION
+Run the \*(TX typesetter on
+.IR file ,
+usually creating
+.IR file.dvi .
+If the file argument has no extension, ".tex" will be appended to it.
+Instead of a filename, a set of \*(TX commands can be given, the first
+of which must start with a backslash.
+With a
+.BI & format
+argument \*(TX uses a different set of precompiled commands,
+contained in
+.IR format.fmt ;
+it is usually better to use the
+.B -fmt
+.I format
+option instead.
+.PP
+\*(TX
+formats the interspersed text and commands contained in the named
+files
+and outputs a typesetter independent file (called
+.IR DVI ,
+which is short for
+.IR "DeVice Independent" ).
+\*(TX's capabilities and language are described in
+.IR "The \*(OXbook" .
+\*(TX
+is normally used with a large body of precompiled macros,
+and there are several specific formatting systems, such as
+\*(LX,
+which require the support of several macro files.
+.PP
+This version of \*(TX looks at its command line to see what name it
+was called under. If they exist, then both
+.B initex
+and
+.B virtex
+are symbolic links to the
+.B tex
+executable. When called as
+.BR initex
+(or when the
+.B -ini
+option is given) it can be used to precompile macros into a
+.I .fmt
+file. When called as
+.B virtex
+it will use the
+.I plain
+format. When called under any other name, \*(TX will use that name as
+the name of the format to use. For example, when called as
+.B tex
+the
+.I tex
+format is used, which is identical to the
+.I plain
+format. The commands defined by the
+.I plain
+format are documented in
+.IR "The \*(OXbook" .
+Other formats that are often available include
+.I latex
+and
+.IR amstex .
+.PP
+The non-option command line arguments to the
+\*(TX
+program are passed to it as the first input line. (But it is often
+easier to type extended arguments as the first input line, since UNIX
+shells tend to gobble up or misinterpret \*(TX's favorite symbols,
+like backslashes, unless you quote them.)
+As described in
+.IR "The \*(OXbook" ,
+that first line should begin with a filename, a
+.IR \econtrolsequence ,
+or a
+.IR &formatname .
+.PP
+The normal usage is to say
+.EX
+tex paper
+.EE
+to start processing
+.IR paper.tex .
+The name
+.I paper
+will be the ``jobname'', and is used in forming
+output filenames.
+If \*(TX doesn't get a filename in the first line, the jobname is
+.IR texput .
+When looking for a file, \*(TX looks for the name with and without the
+default extension
+.RI ( .tex )
+appended, unless the name already contains that extension. If
+.I paper
+is the ``jobname'',
+a log of error messages, with rather more detail than normally appears
+on the screen, will appear in
+.IR paper.log ,
+and the output file will be in
+.IR paper.dvi .
+.PP
+This version of \*(TX can look in the first line of the file
+.I paper.tex
+to see if it begins with the magic sequence
+.IR %& .
+If the first line begins with
+.BI %& format
+.BI -translate-file \ tcxname
+then \*(TX will use the named format and transation table
+.I tcxname
+to process the source file. Either the format name or the
+.B -translate-file
+specification may be omitted, but not both. This overrides the
+format selection based on the name by which the program is invoked.
+The
+.B -parse-first-line
+option or the
+.B parse_first_line
+configuration variable controls whether this behaviour is enabled.
+.PP
+The
+.I e
+response to \*(TX's error prompt causes the system default editor to
+start up at the current line of the current file. The environment
+variable TEXEDIT can be used to change the editor used. It may
+contain a string with "%s" indicating where the filename goes and "%d"
+indicating where the decimal line number (if any) goes. For example,
+a TEXEDIT string for
+.B emacs
+can be set with the
+.B sh
+command
+.EX
+\fITEXEDIT="emacs +%d %s"; export TEXEDIT\fP
+.EE
+.PP
+A convenient file in the library is
+.IR null.tex ,
+containing nothing.
+When \*(TX can't find a file it thinks you want to input, it keeps
+asking you for another filename; responding `null' gets you out
+of the loop if you don't want to input anything. You can also type your
+EOF character (usually control-D).
+.PP
+.\"=====================================================================
+.SH OPTIONS
+This version of \*(TX understands the following command line options.
+.TP
+.B -enc
+.rb
+Enable the enc\*(TX extensions. This option is only effective in
+combination with
+.BR -ini .
+For documentation of the enc\*(TX extensions see
+.BR http://www.olsak.net/enctex.html .
+.TP
+.B -file-line-error
+.rb
+Print error messages in the form
+.I file:line:error
+which is similar to the way many compilers format them.
+.TP
+.B -no-file-line-error
+.rb
+Disable printing error messages in the
+.I file:line:error
+style.
+.TP
+.B -file-line-error-style
+.rb
+This is the old name of the
+.B -file-line-error
+option.
+.TP
+.BI -fmt \ format
+.rb
+Use
+.I format
+as the name of the format to be used, instead of the name by which
+\*(TX was called or a
+.I %&
+line.
+.TP
+.B -halt-on-error
+.rb
+Exit with an error code when an error is encountered during processing.
+.TP
+.B -help
+.rb
+Print help message and exit.
+.TP
+.B -ini
+.rb
+Start in
+.I INI
+mode, which is used to dump formats. The
+.I INI
+mode can be used for typesetting, but no format is preloaded, and
+basic initializations like setting catcodes may be required.
+.TP
+.BI -interaction \ mode
+.rb
+Sets the interaction mode. The mode can be either
+.IR batchmode ,
+.IR nonstopmode ,
+.IR scrollmode ,
+and
+.IR errorstopmode .
+The meaning of these modes is the same as that of the corresponding
+\ecommands.
+.TP
+.B -ipc
+.rb
+Send DVI output to a socket as well as the usual output file. Whether
+this option is available is the choice of the installer.
+.TP
+.B -ipc-start
+.rb
+As
+.BR -ipc ,
+and starts the server at the other end as well. Whether this option
+is available is the choice of the installer.
+.TP
+.BI -jobname \ name
+.rb
+Use
+.I name
+for the job name, instead of deriving it from the name of the input file.
+.TP
+.BI -kpathsea-debug \ bitmask
+.rb
+Sets path searching debugging flags according to the bitmask. See the
+.I Kpathsea
+manual for details.
+.TP
+.BI -mktex \ fmt
+.rb
+Enable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.B -mltex
+.rb
+Enable ML\*(TX extensions. Only effective in combination with
+.BR -ini .
+.TP
+.BI -no-mktex \ fmt
+.rb
+Disable
+.RI mktex fmt ,
+where
+.I fmt
+must be either
+.I tex
+or
+.IR tfm .
+.TP
+.BI -output-comment \ string
+.rb
+Use
+.I string
+for the
+.I DVI
+file comment instead of the date.
+.TP
+.BI -output-directory \ directory
+.rb Write output files in
+.I directory
+instead of the current directory. Look up input files in
+.I directory
+first, the along the normal search path.
+.TP
+.B -parse-first-line
+.rb
+If the first line of the main input file begins with
+.I %&
+parse it to look for a dump name or a
+.B -translate-file
+option.
+.TP
+.B -no-parse-first-line
+.rb
+Disable parsing of the first line of the main input file.
+.TP
+.BI -progname \ name
+.rb
+Pretend to be program
+.IR name .
+This affects both the format used and the search paths.
+.TP
+.B -recorder
+.rb
+Enable the filename recorder. This leaves a trace of the files opened
+for input and output in a file with extension
+.IR .fls .
+.TP
+.B -shell-escape
+.rb
+Enable the
+.BI \ewrite18{ command }
+construct. The
+.I command
+can be any shell command. This construct is normally
+disallowed for security reasons.
+.TP
+.B -no-shell-escape
+.rb
+Disable the
+.BI \ewrite18{ command }
+construct, even if it is enabled in the
+.I texmf.cnf
+file.
+.TP
+.B -src-specials
+.rb
+Insert source specials into the
+.I DVI
+file.
+.TP
+.BI -src-specials \ where
+.rb
+Insert source specials in certain places of the
+.I DVI
+file.
+.I where
+is a comma-separated value list:
+.IR cr ,
+.IR display ,
+.IR hbox ,
+.IR math ,
+.IR par ,
+.IR parent ,
+or
+.IR vbox .
+.TP
+.BI -translate-file \ tcxname
+.rb
+Use the
+.I tcxname
+translation table to set the mapping of input characters and
+re-mapping of output characters.
+.TP
+.BI -default-translate-file \ tcxname
+.rb
+Like
+.B -translate-file
+except that a
+.I %&
+line can overrule this setting.
+.TP
+.B -version
+.rb
+Print version information and exit.
+.\"=====================================================================
+.SH ENVIRONMENT
+See the Kpathsearch library documentation (the `Path specifications'
+node) for precise details of how the environment variables are used.
+The
+.B kpsewhich
+utility can be used to query the values of the variables.
+.PP
+One caveat: In most \*(TX formats, you cannot use ~ in a filename you
+give directly to \*(TX, because ~ is an active character, and hence is
+expanded, not taken as part of the filename. Other programs, such as
+\*(MF, do not have this problem.
+.PP
+.TP
+TEXMFOUTPUT
+Normally, \*(TX puts its output files in the current directory. If
+any output file cannot be opened there, it tries to open it in the
+directory specified in the environment variable TEXMFOUTPUT.
+There is no default value for that variable. For example, if you say
+.I tex paper
+and the current directory is not writable, if TEXMFOUTPUT has
+the value
+.IR /tmp ,
+\*(TX attempts to create
+.I /tmp/paper.log
+(and
+.IR /tmp/paper.dvi ,
+if any output is produced.)
+.TP
+TEXINPUTS
+Search path for
+.I \einput
+and
+.I \eopenin
+files.
+This should probably start with ``.'', so
+that user files are found before system files. An empty path
+component will be replaced with the paths defined in the
+.I texmf.cnf
+file. For example, set TEXINPUTS to ".:/home/usr/tex:" to prepend the
+current direcory and ``/home/user/tex'' to the standard search path.
+.TP
+TEXFORMATS
+Search path for format files.
+.TP
+TEXPOOL
+search path for
+.B tex
+internal strings.
+.TP
+TEXEDIT
+Command template for switching to editor. The default, usually
+.BR vi ,
+is set when \*(TX is compiled.
+.TP
+TFMFONTS
+Search path for font metric
+.RI ( .tfm )
+files.
+.\"=====================================================================
+.SH FILES
+The location of the files mentioned below varies from system to
+system. Use the
+.B kpsewhich
+utility to find their locations.
+.TP
+.I texmf.cnf
+Configuration file. This contains definitions of search paths as well
+as other configuration parameters like
+.BR parse_first_line .
+.TP
+.I tex.pool
+Text file containing \*(TX's internal strings.
+.TP
+.I texfonts.map
+Filename mapping definitions.
+.TP
+.I *.tfm
+Metric files for \*(TX's fonts.
+.TP
+.I *.fmt
+Predigested \*(TX format (.\|fmt) files.
+.TP
+.I $TEXMFMAIN/tex/plain/base/plain.tex
+The basic macro package described in the \*(OXbook.
+.br
+.\"=====================================================================
+.SH NOTES
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info manual
+.IR "Web2C: A TeX implementation" .
+.\"=====================================================================
+.SH BUGS
+This version of \*(TX implements a number of optional extensions.
+In fact, many of these extensions conflict to a greater or lesser
+extent with the definition of \*(TX. When such extensions are
+enabled, the banner printed when \*(TX starts is changed to print
+.B TeXk
+instead of
+.BR TeX .
+.PP
+This version of \*(TX fails to trap arithmetic overflow when
+dimensions are added or subtracted. Cases where this occurs are rare,
+but when it does the generated
+.I DVI
+file will be invalid.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR mf (1),
+.br
+Donald E. Knuth,
+.IR "The \*(OXbook" ,
+Addison-Wesley, 1986, ISBN 0-201-13447-0.
+.br
+Leslie Lamport,
+.IR "\*(LX \- A Document Preparation System" ,
+Addison-Wesley, 1985, ISBN 0-201-15790-X.
+.br
+K. Berry,
+.IR "Eplain: Expanded plain \*(TX" ,
+ftp://ftp.cs.umb.edu/pub/tex/eplain/doc.
+.br
+Michael Spivak,
+.IR "The Joy of \*(OX" ,
+2nd edition, Addison-Wesley, 1990, ISBN 0-8218-2997-1.
+.br
+.I TUGboat
+(the journal of the \*(TX Users Group).
+.\"=====================================================================
+.SH TRIVIA
+\*(TX, pronounced properly, rhymes with ``blecchhh.'' The proper
+spelling in typewriter-like fonts is ``TeX'' and not ``TEX'' or ``tex.''
+.\"=====================================================================
+.SH AUTHORS
+\*(TX was designed by Donald E. Knuth,
+who implemented it using his \*(WB system for Pascal programs.
+It was ported to Unix at Stanford by Howard Trickey, and
+at Cornell by Pavel Curtis.
+The version now offered with the Unix \*(TX distribution is that
+generated by the \*(WB to C system
+.RB ( web2c ),
+originally written by Tomas Rokicki and Tim Morgan.
+.PP
+The enc\*(TX extensions were written by Petr Olsak.
diff --git a/Build/source/texk/web2c/man/tftopl.man b/Build/source/texk/web2c/man/tftopl.man
new file mode 100644
index 00000000000..ffd5690df13
--- /dev/null
+++ b/Build/source/texk/web2c/man/tftopl.man
@@ -0,0 +1,117 @@
+.TH TFTOPL 1 "17 December 1994" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+tftopl \- convert TeX font metric (tfm) files to property lists
+.SH SYNOPSIS
+.B tftopl
+[
+.BI \-charcode-format =format
+]
+[
+.B \-verbose
+]
+.I tfm_name[.tfm]
+[
+.I pl_name[.pl]
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B tftopl
+program translates a (program-oriented) font metric file to a
+(human-oriented) property list file. Thus, you can edit the contents of
+the TFM files, if the font designer has not done his or her job
+properly, or if you're encountering strange difficulties, or if you're
+just curious. It also serves as a TFM-file validating program, i.e., if
+no error messages are given, the input file is correct.
+.PP
+The
+.I pl_name
+is extended with
+.I .pl
+if it lacks a suffix.
+If
+.I pl_name
+is not given, standard output is used. Likewise,
+.I tfm_name
+is extended with
+.I .tfm
+if it lacks a suffix. Also, path searching is done for the
+.I .tfm
+file
+using the environment variable TEXFONTS. If that is not set,
+.B tftopl
+uses the system default.
+.PP
+See
+.BR tex (1)
+for the details of the searching.
+.\"=====================================================================
+.SH OPTIONS
+The argument
+.I format
+to
+.B \-charcode-format
+specifies how character codes are output in the PL file. By
+default, only letters and digits are output using the
+.B C
+integer code (i.e., in ASCII); the others are output in octal. (Unless
+the font's coding scheme starts with
+.B "TeX math sy"
+or
+.BR "TeX math ex" ,
+in which case all character codes are output in octal.) If
+.I format
+is
+.BR ascii ,
+all character codes that correspond to graphic characters, besides the
+left and right parentheses, are output in ASCII. Finally, if
+.I format
+is
+.BR octal ,
+all character codes are output in octal.
+.PP
+Without the
+.B \-verbose
+option,
+.B tftopl
+operates silently. With it, a banner and progress report are printed on
+.IR stdout .
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR pltotf (1),
+.br
+Donald E. Knuth,
+.IR "\*(OXware" .
+.br
+Donald E. Knuth,
+.I "The \*(MFbook"
+(Volume C of
+.IR "Computers and Typesetting" ),
+Addison-Wesley, 1986, ISBN 0-201-13445-4.
+.\"=====================================================================
+.SH AUTHORS
+Donald E. Knuth wrote the program. It was published as
+part of the
+.I \*(OXware
+technical report, available from the \*(TX Users Group.
+Howard Trickey and Pavel Curtis originally ported it to Unix.
diff --git a/Build/source/texk/web2c/man/vftovp.man b/Build/source/texk/web2c/man/vftovp.man
new file mode 100644
index 00000000000..22d45bb2653
--- /dev/null
+++ b/Build/source/texk/web2c/man/vftovp.man
@@ -0,0 +1,100 @@
+.TH VFTOVP 1 "19 December 1994" "Web2C @VERSION@"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+vftovp \- convert virtual font (vf) files to virtual property lists (vpl)
+.SH SYNOPSIS
+.B vftovp
+[
+.BI \-charcode-format =format
+]
+[
+.B \-verbose
+]
+.I vf_name[.vf]
+.I tfm_name[.tfm]
+[
+.I vpl_name[.vpl]
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B vftovp
+program translates a (program-oriented) virtual font file and its
+accompanying \*(TX font metric file to a (human-oriented) property list file.
+Thus, the virtual font can be edited, and its exact contents can be
+displayed mnemonically. It also serves as a VF-file validating program;
+if no error messages are given, the input files are correct.
+.PP
+The filenames are extended with the appropriate extension if necessary.
+.\"=====================================================================
+.SH OPTIONS
+The argument
+.I format
+to
+.B \-charcode-format
+specifies how character codes are output in the VPL file. By
+default, only letters and digits are output using the
+.B C
+integer code (i.e., in ASCII); the others are output in octal. (Unless
+the font's coding scheme starts with
+.B "TeX math sy"
+or
+.BR "TeX math ex" ,
+when all are output in octal.) If
+.I format
+is
+.BR ascii ,
+all character codes that correspond to graphic characters, besides the
+left and right parentheses, are output in ASCII. On the other hand, if
+.I format
+is
+.BR octal ,
+all character codes are output in octal.
+.PP
+Without the
+.B \-verbose
+option,
+.B vftovp
+operates silently. With it, a banner and progress report are printed on
+.IR stdout .
+.\"=====================================================================
+.SH ENVIRONMENT
+.B vftovp
+looks for
+.I vf_name
+using the
+environment variable VFFONTS. If that is not set, it uses the variable
+TEXFONTS. If that is not set, it uses the system default.
+.PP
+See
+.BR tex (1)
+for the details of the searching.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR pltotf (1),
+.BR tftopl (1),
+.BR vptovf (1).
+.\"=====================================================================
+.SH AUTHORS
+Donald E. Knuth wrote the program, based in part on an idea of David Fuchs,
+starting with the code for
+.BR tftopl (1).
+Karl Berry adapted it for compilation with
+.BR web2c .
diff --git a/Build/source/texk/web2c/man/virtex.min b/Build/source/texk/web2c/man/virtex.min
new file mode 100644
index 00000000000..8d490e9ea15
--- /dev/null
+++ b/Build/source/texk/web2c/man/virtex.min
@@ -0,0 +1,81 @@
+.TH VIRTEX 1 "14 December 1993"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.if t .ds AX \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(TX
+.if n .ds AX AmSTeX
+.if t .ds AY \fRA\\h'-0.1667m'\\v'0.20v'M\\v'-0.20v'\\h'-0.125m'S\fP\*(LX
+.if n .ds AY AmSLaTeX
+.\"=====================================================================
+.SH NAME
+virtex \- virgin TeX for production typesetting
+.SH DESCRIPTION
+.B virtex
+is a version of the \*(TX program that has no
+preloaded macro packages, but is capable of
+loading a special preformatted binary file, called
+a
+.I format
+.RI ( .fmt )
+file produced by the
+.BR initex (1)
+program.
+.PP
+Preprocessing of large macro files and font
+definitions by
+.B initex
+makes it possible to rapidly load complex
+packages, like plain \*(TX, \*(AX, \*(AY, or \*(LX,
+without the overhead of macro parsing and file
+opening that would otherwise be experienced.
+.PP
+.B virtex
+can be invoked directly, providing it with a name
+of a format file specially prefixed by an
+ampersand:
+.RS
+.I "virtex '&plain' filename"
+.RE
+This causes it to load the binary file named
+.I plain.fmt
+from a directory in the standard TEXINPUTS search
+path, and then load the text file
+.I filename
+and process it. The quotes are needed to protect
+the ampersand from Unix shell interpretation.
+.PP
+Because this need occurs frequently, Unix
+.B virtex
+provides a convenient shorthand. If it is invoked
+under a name other than
+.BR virtex ,
+such as
+.BR footex ,
+it will behave as if it had been invoked as
+.I "virtex '&footex'"
+and first load a file named
+.IR footex.fmt .
+Thus,
+.BR amslatex ,
+.BR amstex ,
+.BR lamstex ,
+.BR latex ,
+.BR slitex ,
+.BR tex ,
+.BR texinfo ,
+and others can all be file system links to
+.BR virtex ,
+without requiring additional disk space.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR initex (1),
+.BR tex (1).
diff --git a/Build/source/texk/web2c/man/vptovf.man b/Build/source/texk/web2c/man/vptovf.man
new file mode 100644
index 00000000000..fbba8245e06
--- /dev/null
+++ b/Build/source/texk/web2c/man/vptovf.man
@@ -0,0 +1,68 @@
+.TH VPTOVF 1 "16 December 1994" "Web2C @VERSION@"
+.\"=====================================================================
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.if n .ds TX TeX
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.el .ds OX TeX for nroff
+.\" the same but obliqued
+.\" BX definition must follow TX so BX can use TX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.if n .ds BX BibTeX
+.\" LX definition must follow TX so LX can use TX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds LX LaTeX
+.\"=====================================================================
+.SH NAME
+vptovf \- convert virtual property lists to virtual font metrics
+.SH SYNOPSIS
+.B vptovf
+[
+.B \-verbose
+]
+.I vpl_name[.vpl]
+.I vfm_name[.vf]
+.I tfm_name[.tfm]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B vptovf
+program translates a (human-oriented) property list file to a pair of
+(program-oriented) files in the VF (virtual font) and TFM (\*(TX font metric)
+formats. Thus, a virtual font
+file can be edited and its exact contents
+can be displayed mnemonically.
+New virtual fonts, which map characters as seen by \*(TX into an arbitrary
+sequence of low-level typesetting operations,
+can also be created in this way.
+.PP
+All three filenames,
+.I vpl_name,
+.I vf_name,
+and
+.I tfm_name,
+are extended with the appropriate suffix, if they lack one.
+.\"=====================================================================
+.SH OPTIONS
+Without the
+.B \-verbose
+option,
+.B vptovf
+operates silently. With it, a banner and progress report are printed on
+.IR stdout .
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR pltotf (1),
+.BR tftopl (1),
+.BR vftovp (1).
+.\"=====================================================================
+.SH AUTHORS
+Donald E. Knuth wrote the program, based in part on an idea of David Fuchs,
+starting with the code for
+.BR pltotf (1).
+Karl Berry adapted it for compilation with
+.BR web2c .
diff --git a/Build/source/texk/web2c/man/weave.man b/Build/source/texk/web2c/man/weave.man
new file mode 100644
index 00000000000..b87cb84ff45
--- /dev/null
+++ b/Build/source/texk/web2c/man/weave.man
@@ -0,0 +1,77 @@
+.TH WEAVE 1 "4 May 1993" "Web2C @VERSION@"
+.\"=====================================================================
+.if n .ds MF Metafont
+.if t .ds MF M\s-2ETAFONT\s0
+.if n .ds TX TeX
+.if t .ds TX \fRT\\h'-0.1667m'\\v'0.20v'E\\v'-0.20v'\\h'-0.125m'X\fP
+.\" the same but obliqued
+.el .ds OX TeX for nroff
+.ie t .ds OX \fIT\v'+0.25m'E\v'-0.25m'X\fP for troff
+.\" BX definition must follow TX so BX can use TX
+.if n .ds BX BibTeX
+.if t .ds BX \fRB\s-2IB\s0\fP\*(TX
+.\" LX definition must follow TX so LX can use TX
+.if n .ds LX LaTeX
+.if t .ds LX \fRL\\h'-0.36m'\\v'-0.15v'\s-2A\s0\\h'-0.15m'\\v'0.15v'\fP\*(TX
+.if n .ds WB Web
+.if t .ds WB W\s-2EB\s0
+.\"=====================================================================
+.SH NAME
+weave \- translate WEB to TeX
+.SH SYNOPSIS
+.B weave
+[
+.B \-x
+]
+.I webfile[.web]
+[
+.I changefile[.ch]
+]
+.\"=====================================================================
+.SH DESCRIPTION
+This manual page is not meant to be exhaustive. The complete
+documentation for this version of \*(TX can be found in the info file
+or manual
+.IR "Web2C: A TeX implementation" .
+.PP
+The
+.B weave
+program is used to create a \*(TX file for viewing a \*(WB program.
+It takes appropriate care of typographic details like page
+layout and the use of indentation, italics, boldface, etc., and it supplies
+extensive cross-index information that it gathers automatically.
+The command line arguments are the same as for
+.B tangle
+except for the option:
+.B \-x
+says to omit the index, module name list, and table of contents pages.
+(A
+.I CONTENTS.tex
+file will still be written when the \*(TX file is processed,
+however, unless some macros in
+.I webmac.tex
+are redefined.)
+.PP
+The output \*(TX file name is formed by adding
+.I .tex
+to the root of the \*(WB file name.
+.PP
+There are several macros
+that probably should be redefined by
+the programmer at the beginning of the \*(WB file.
+It is a good idea to set \\title
+to the name of the program.
+And, to cause output of only changed modules, one can say
+\\let\\maybe=\\iffalse (usually as the first change in the
+change file).
+.\"=====================================================================
+.SH FILES
+.TP \w'@@'u+2n
+.I $TEXMFMAIN/tex/plain/base/webmac.tex
+\*(TX macros used by
+.B weave
+output.
+.\"=====================================================================
+.SH "SEE ALSO"
+.BR tangle (1)
+for references, authors, and other information.
diff --git a/Build/source/texk/web2c/man/win32.mak b/Build/source/texk/web2c/man/win32.mak
new file mode 100644
index 00000000000..969dd0ce05a
--- /dev/null
+++ b/Build/source/texk/web2c/man/win32.mak
@@ -0,0 +1,72 @@
+################################################################################
+#
+# Makefile : Web2C / man
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <03/02/19 17:37:40 popineau>
+#
+################################################################################
+root_srcdir = ..\..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+!include <msvc/common.mak>
+
+localmodes = modes
+
+# If you like, delete the man pages for programs you aren't installing.
+# The programs are listed in alphabetical order.
+#
+manfiles= \
+ amstex.1 \
+ bibtex.1 \
+ dmp.1 \
+ dvicopy.1 \
+ dvitype.1 \
+ eplain.1 \
+ etex.1 \
+ gftodvi.1 \
+ gftopk.1 \
+ gftype.1 \
+ latex.1 \
+ makempx.1 \
+ mf.1 \
+ mft.1 \
+ mpost.1 \
+ mpto.1 \
+ newer.1 \
+ omega.1 \
+ patgen.1 \
+ pdftex.1 \
+ pktogf.1 \
+ pktype.1 \
+ pltotf.1 \
+ pooltype.1 \
+ tangle.1 \
+ tex.1 \
+ tftopl.1 \
+ vftovp.1 \
+ vptovf.1 \
+ weave.1 \
+ tie.1
+
+default all: man
+
+tie.1: ..\tiedir\tie.1
+ if not exist tie.1 @$(copy) ..\tiedir\tie.1 tie.1
+
+cweb.1: ..\cwebdir\cweb.1
+ if not exist cweb.1 @$(copy) ..\cwebdir\cweb.1 cweb.1
+
+!include <msvc/install.mak>
+
+!include <msvc/clean.mak>
+
+#
+# Local variables:
+# page-delimiter: "^# \f"
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/metapost.mk b/Build/source/texk/web2c/metapost.mk
new file mode 100644
index 00000000000..1ea6157b228
--- /dev/null
+++ b/Build/source/texk/web2c/metapost.mk
@@ -0,0 +1,97 @@
+# Makefile fragment for MetaPost.
+# $Id: metapost.mk,v 1.2 2005/07/25 10:03:53 olaf Exp $
+#
+# Public domain.
+#
+# This facilitates a separate development track for MetaPost.
+
+Makefile: metapost.mk
+
+mpost = mpost
+
+# mpware is the subdirectory.
+mpware = mpware
+mpware_programs = mpware/dmp mpware/makempx mpware/mpto mpware/newer
+mpware_sources = mpware/dmp.c mpware/makempx.in mpware/mpto.c mpware/newer.c
+
+# mpost
+
+mp_c = mpini.c mp0.c mp1.c mp2.c
+mp_o = mpini.o mp0.o mp1.o mp2.o mpextra.o
+mpost: $(mp_o)
+ $(kpathsea_link) $(mp_o) $(LOADLIBES)
+$(mp_c) mpcoerce.h mpd.h: mp.p $(web2c_texmf) web2c/cvtmf1.sed web2c/cvtmf2.sed
+ $(web2c) mp
+mpextra.c: lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/mp/ $(srcdir)/lib/texmfmp.c >$@
+mp.p mp.pool: tangle mp.web mp.ch
+ $(tangle) mp.web mp.ch
+check: mpost-check
+mpost-check: mptrap mpost.mem $(mpware_programs)
+ ./mpost --progname=mpost '&./mpost \tracingstats:=1; end.'
+ TEXMFCNF=../kpathsea \
+ MAKEMPX_BINDIR=`pwd`:`pwd`/mpware MPXCOMMAND=mpware/makempx \
+ ./mpost --progname=mpost $(srcdir)/tests/mptest
+ ./mpost --progname=mpost $(srcdir)/tests/one.two
+ ./mpost --progname=mpost $(srcdir)/tests/uno.dos
+clean:: mpost-clean
+mpost-clean: mptrap-clean
+ $(LIBTOOL) --mode=clean rm -f mpost
+ rm -f $(mp_o) $(mp_c) mpextra.c mpcoerce.h mpd.h mp.p mp.pool
+ rm -f mpost.mem mpost.log
+ rm -f mpout.log mptest.log one.two.log uno.log
+
+# Can't run trap and mptrap in parallel, because both write trap.{log,tfm}.
+mptrap: mpost pltotf tftopl mptrap-clean
+ @echo ">>> See $(testdir)/mptrap.diffs for example of acceptable diffs." >&2
+ $(LN) $(testdir)/mtrap.mp . # get same filename in log
+ ./pltotf $(testdir)/trapf.pl trapf.tfm
+ -$(SHELL) -c '$(testenv) ./mpost --progname=inimpost mtrap'
+ -diff $(testdir)/mtrap.log mtrap.log
+ -diff $(testdir)/mtrap.0 mtrap.0
+ -diff $(testdir)/mtrap.1 mtrap.1
+ -diff $(testdir)/writeo writeo
+ -diff $(testdir)/writeo.2 writeo.2
+ $(LN) $(testdir)/trap.mp .
+ $(LN) $(testdir)/trap.mpx .
+ -$(SHELL) -c '$(testenv) ./mpost --progname=inimpost <$(testdir)/mptrap1.in >mptrapin.fot'
+ mv trap.log mptrapin.log
+ -diff $(testdir)/mptrapin.log mptrapin.log
+# Must run inimp or font_name[null_font] is not initialized, leading to diffs.
+ -$(SHELL) -c '$(testenv) ./mpost --progname=inimpost <$(testdir)/mptrap2.in >mptrap.fot'
+ mv trap.log mptrap.log
+ mv trap.tfm mptrap.tfm
+ -diff $(testdir)/mptrap.fot mptrap.fot
+ -diff $(testdir)/mptrap.log mptrap.log
+ -diff $(testdir)/trap.5 trap.5
+ -diff $(testdir)/trap.6 trap.6
+ -diff $(testdir)/trap.148 trap.148
+ -diff $(testdir)/trap.149 trap.149
+ -diff $(testdir)/trap.150 trap.150
+ -diff $(testdir)/trap.151 trap.151
+ -diff $(testdir)/trap.197 trap.197
+ -diff $(testdir)/trap.200 trap.200
+ ./tftopl ./mptrap.tfm mptrap.pl
+ -diff $(testdir)/mptrap.pl mptrap.pl
+
+mptrap-clean:
+ rm -f mtrap.mp mtrap.mem trapf.tfm
+ rm -f mtrap.log mtrap.0 mtrap.1 writeo writeo.log writeo.2
+ rm -f trap.mp trap.mpx mptrapin.fot mptrapin.log
+ rm -f mptrap.fot mptrap.log mptrap.tfm
+ rm -f trap.ps trap.mem trap.0 trap.5 trap.6 trap.95 trap.96 trap.97
+ rm -f trap.98 trap.99 trap.100 trap.101 trap.102 trap.103 trap.104
+ rm -f trap.105 trap.106 trap.107 trap.108 trap.109 trap.148
+ rm -f trap.149 trap.150 trap.151 trap.197 trap.200
+ rm -f mptrap.pl
+
+
+# mpware
+
+# We put mpware (written directly in C) in a subdirectory.
+$(mpware_programs): $(mpware_sources)
+ cd mpware && $(MAKE) $(common_makeargs)
+
+install-programs: install-mpware-programs
+install-mpware-programs: $(mpware_programs)
+ cd $(mpware) && $(MAKE) $(install_makeargs) install-exec
diff --git a/Build/source/texk/web2c/mf-supp-w32.ch b/Build/source/texk/web2c/mf-supp-w32.ch
new file mode 100644
index 00000000000..63793a92134
--- /dev/null
+++ b/Build/source/texk/web2c/mf-supp-w32.ch
@@ -0,0 +1,77 @@
+@x
+@!file_line_error_style_p:boolean; {output file:line:error style errors.}
+@y
+@!file_line_error_style_p:boolean; {output file:line:error style errors.}
+@!halt_on_error_p:boolean; {stop at first error.}
+@!quoted_filename : boolean;
+@z
+
+@x
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+@y
+ ready_already:=0;
+ texmf_finish_job;
+ if (history <> spotless) and (history <> warning_issued) then
+@z
+
+@x
+else begin print_char("."); show_context end;
+@y
+else begin print_char("."); show_context end;
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+@z
+
+@x
+begin area_delimiter:=0; ext_delimiter:=0;
+end;
+@y
+begin area_delimiter:=0; ext_delimiter:=0;
+quoted_filename:=false;
+end;
+@z
+
+@x
+begin if stop_at_space and ((c=" ")or(c=tab)) then more_name:=false
+else begin if IS_DIR_SEP (c) then
+@y
+begin
+if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+end;
+if ((c=" ")or(c=tab)) and stop_at_space and (not quoted_filename) then more_name:=false
+else begin
+ if (c="*") then c:=" "
+ else if (c="?") then c:="~";
+ if IS_DIR_SEP (c) then
+@z
+
+@x
+@<Basic printing...@>=
+procedure print_file_name(@!n,@!a,@!e:integer);
+begin slow_print(a); slow_print(n); slow_print(e);
+end;
+@y
+@d print_file_name==texmf_print_file_name
+@z
+
+@x
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+@x
+@p begin @!{|start_here|}
+@y
+@p begin @!{|start_here|}
+
+ texmf_start_job;
+@z
diff --git a/Build/source/texk/web2c/mf.ch b/Build/source/texk/web2c/mf.ch
new file mode 100644
index 00000000000..e9ea738a48e
--- /dev/null
+++ b/Build/source/texk/web2c/mf.ch
@@ -0,0 +1,2251 @@
+% mf.ch for C compilation with web2c, derived from various other change
+% files: INITEX.CH for Berkeley Unix TeX 1.1 (by Howard Trickey and
+% Pavel Curtis), by Paul Richards. web2c modifications by Tim Morgan, et al.
+%
+% (more recent changes in ChangeLog)
+% Revision 2.0 90/3/27 20:20:00 ken To version 2.0.
+% Revision 1.9 90/1/20 09:05:32 karl To version 1.9.
+% Revision 1.8 89/11/30 09:08:16 karl To version 1.8.
+% Revision 1.7 88/12/27 15:02:24 mackay Cosmetic upgrade for version 1.7
+% Revision 1.6 88/12/11 15:59:15 morgan Brought up to MF version 1.6
+% Revision 1.5 88/03/02 13:25:44 morgan More C changes
+% Revision 1.4 87/12/09 12:50:00 hesse Changes for C version
+% Revision 1.3 87/03/07 21:15:21 mackay
+% Minor changes found on archive version on SCORE
+% Revision 1.2 86/09/29 21:46:43 mackay
+% Made no-debug the default, and changed version number
+% to correspond with improved mf.web file
+% (Got rid of debug code to avoid bug in range check
+% code of VAX4.3 BSD and SUN3 version 3.1 Os pc interpreter)
+% Revision 1.0 86/01/31 15:46:08 richards
+% Incorporates: New binary I/O library, separate optimized
+% arithmetic for takefraction/makefraction, new graphics interface.
+
+@x [0] WEAVE: print changes only.
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+@y
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+\let\maybe=\iffalse
+\def\title{\MF\ changes for C}
+\def\glob{13}\def\gglob{20, 25} % these are defined in module 1
+@z
+
+@x [1.7] Convert `debug..gubed' and `stat..tats' into #ifdefs.
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==ifdef('TEXMF_DEBUG')
+@d gubed==endif('TEXMF_DEBUG')
+@z
+
+@x
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@y
+@d stat==ifdef('STAT')
+@d tats==endif('STAT')
+@z
+
+@x [1.8] Same, for `init..tini'.
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y
+@d init==ifdef('INIMF')
+@d tini==endif('INIMF')
+@z
+
+% [1.11] Compile-time constants. Although we only change a few of
+% these, listing them all makes the patch file for a big Metafont simpler.
+% 16K for BSD I/O; file_name_size is set from the system constant.
+@x
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \MF's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|}
+@!max_internal=100; {maximum number of internal quantities}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!screen_width=768; {number of pixels in each row of screen display}
+@!screen_depth=1024; {number of pixels in each column of screen display}
+@!stack_size=30; {maximum number of simultaneous input sources}
+@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MF's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MF's own strings, which is currently about 22000}
+@!move_size=5000; {space for storing moves in a single octant}
+@!max_wiggle=300; {number of autorounded points per cycle}
+@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='MFbases:MF.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.MFbases@>
+@!path_size=300; {maximum number of knots between breakpoints of a path}
+@!bistack_size=785; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=5000; {maximum number of ligature/kern steps, must be
+ at least 255 and at most 32510}
+@!max_kerns=500; {maximum number of distinct kern amounts}
+@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
+@y
+@d file_name_size == maxint
+@d ssup_error_line = 255
+
+@<Constants...@>=
+@!max_internal=300; {maximum number of internal quantities}
+@!screen_width=1664; {number of pixels in each row of screen display}
+@!screen_depth=1200; {number of pixels in each column of screen display}
+@!stack_size=300; {maximum number of simultaneous input sources}
+@!max_strings=7500; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=74000; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MF's own error messages are stored}
+@!pool_size=100000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MF's own strings, which is currently about 22000}
+@!move_size=20000; {space for storing moves in a single octant}
+@!max_wiggle=1000; {number of autorounded points per cycle}
+@!pool_name=TEXMF_POOL_NAME;
+ {string that tells where the string pool appears}
+@!engine_name=TEXMF_ENGINE_NAME; {the name of this engine}
+@!path_size=1000; {maximum number of knots between breakpoints of a path}
+@!bistack_size=1500; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=15000; {maximum number of ligature/kern steps, must be
+ at least 255 and at most 32510}
+@!max_kerns=2500; {maximum number of distinct kern amounts}
+@!max_font_dimen=60; {maximum number of \&{fontdimen} parameters}
+@#
+@!inf_main_memory = 3000;
+@!sup_main_memory = 8000000;
+
+@!inf_buf_size = 500;
+@!sup_buf_size = 300000;
+@z
+
+@x [1.12] Constants defined as WEB macros.
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF};
+ must be substantially larger than |mem_min|
+ and not greater than |mem_max|}
+@d hash_size=2100 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d max_in_open=6 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=150 {maximum number of simultaneous macro parameters}
+@y
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@d hash_size=9500 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=7919 {a prime number equal to about 85\pct! of |hash_size|}
+@d max_in_open=15 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=150 {maximum number of simultaneous macro parameters}
+@z
+
+@x [1.13] Global parameters that can be changed in texmf.cnf.
+@<Glob...@>=
+@!bad:integer; {is some ``constant'' wrong?}
+@y
+@<Glob...@>=
+@!bad:integer; {is some ``constant'' wrong?}
+@#
+@!init
+@!ini_version:boolean; {are we \.{INIMF}? Set in \.{lib/texmfmp.c}}
+@!dump_option:boolean; {was the dump name option used?}
+@!dump_line:boolean; {was a \.{\%\AM base} line seen?}
+tini@/
+@#
+@!bound_default:integer; {temporary for setup}
+@!bound_name:^char; {temporary for setup}
+@#
+@!main_memory:integer; {total memory words allocated in initex}
+@!mem_top:integer; {largest index in the |mem| array dumped by \.{INIMF};
+ must be substantially larger than |mem_bot|,
+ equal to |mem_max| in \.{INIMF}, else not greater than |mem_max|}
+@!mem_max:integer; {greatest index in \MF's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|}
+@!buf_size:integer; {maximum number of characters simultaneously present in
+ current lines of open files; must not exceed |max_halfword|}
+@!error_line:integer; {width of context lines on terminal error messages}
+@!half_error_line:integer; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line:integer; {width of longest text lines output;
+ should be at least 60}
+@!gf_buf_size:integer; {size of the output buffer, must be a multiple of 8}
+@!parse_first_line_p:c_int_type; {parse the first line for options}
+@!file_line_error_style_p:c_int_type; {output file:line:error style errors.}
+@!eight_bit_p:c_int_type; {make all characters printable by default}
+@!halt_on_error_p:c_int_type; {stop at first error}
+@!quoted_filename:boolean; {current filename is quoted}
+@z
+
+@x [1.16] Use C macros for `incr' and `decr'.
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@y
+@z
+
+% [2.19] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [2.22] Allow any character as input.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+@y
+@^character set dependencies@>
+@^system dependencies@>
+
+@d tab = @'11 { ASCII horizontal tab }
+@d form_feed = @'14 { ASCII form feed }
+
+@<Set init...@>=
+{Initialize |xchr| to the identity mapping.}
+for i:=0 to @'37 do xchr[i]:=i;
+for i:=@'177 to @'377 do xchr[i]:=i;
+@z
+
+@x [2.24]
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+@y
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+{Set |xprn| for printable ASCII, unless |eight_bit_p| is set.}
+for i:=0 to 255 do xprn[i]:=(eight_bit_p or ((i>=" ")and(i<="~")));
+
+{The idea for this dynamic translation comes from the patch by
+ Libor Skarvada \.{<libor@@informatics.muni.cz>}
+ and Petr Sojka \.{<sojka@@informatics.muni.cz>}. I didn't use any of the
+ actual code, though, preferring a more general approach.}
+
+{This updates the |xchr|, |xord|, and |xprn| arrays from the provided
+ |translate_filename|. See the function definition in \.{texmfmp.c} for
+ more comments.}
+if translate_filename then read_tcx_file;
+@z
+
+% [3.25] Declare name_of_file as a C string. See comments in tex.ch for
+% why we change the element type to text_char.
+@x
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@y
+@!name_of_file:^text_char;
+@z
+
+@x [3.26] Do file opening in C.
+@ The \ph\ compiler with which the present version of \MF\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `\ignorespaces|packed
+array[@t\<\\{any}>@>] of text_char|', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\MF\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\MF's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var @!f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var @!f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_out(var @!f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var @!f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var @!f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@ All of the file opening functions are defined in C.
+@z
+
+@x [3.27] Do file closing in C.
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+@p procedure a_close(var @!f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var @!f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var @!f:word_file); {close a word file}
+begin close(f);
+end;
+@y
+@ And all the file closing routines as well.
+@z
+
+@x [3.29] Array size of input buffer is determined at runtime.
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@y
+@!buffer:^ASCII_code; {lines of characters being read}
+@z
+
+@x [3.30] Do `input_ln' in C.
+Standard \PASCAL\ says that a file should have |eoln| immediately
+before |eof|, but \MF\ needs only a weaker restriction: If |eof|
+occurs in the middle of a line, the system function |eoln| should return
+a |true| result (even though |f^| will be undefined).
+
+@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+We define |input_ln| in C, for efficiency. Nevertheless we quote the module
+`Report overflow of the input buffer, and abort' here in order to make
+\.{WEAVE} happy.
+
+@p @{ @<Report overflow of the input buffer, and abort@> @}
+@z
+
+@x [3.31] `term_in' and `term_out' are standard input and output.
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+@y
+@d term_in==stdin {the terminal as an input file}
+@d term_out==stdout {the terminal as an output file}
+@z
+
+@x [3.32] We don't need to open the terminal files.
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+@y
+@ Here is how to open the terminal files. |t_open_out| does nothing.
+|t_open_in|, on the other hand, does the work of ``rescanning,'' or getting
+any command line arguments the user has provided. It's defined in C.
+
+@d t_open_out == {output already open for text output}
+@z
+
+@x [3.33] Flushing output.
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@y
+these operations can be specified with {\mc UNIX}. |update_terminal|
+does an |fflush|. |clear_terminal| is redefined
+to do nothing, since the user should control the terminal.
+@^system dependencies@>
+
+@d update_terminal == fflush(term_out)
+@d clear_terminal == do_nothing
+@z
+
+@x [3.36] Reading the command line.
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+@y
+@ The following program does the required initialization.
+Iff anything has been specified on the command line, then |t_open_in|
+will return with |last > first|.
+@^system dependencies@>
+
+@p
+function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin
+ t_open_in;
+ if last > first then begin
+ loc := first;
+ while (loc < last) and (buffer[loc]=' ') do
+ incr(loc);
+ if loc < last then begin
+ init_terminal := true;
+ goto exit;
+ end;
+ end;
+ loop@+begin
+ wake_up_terminal; write(term_out, '**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then begin {this shouldn't happen}
+ write_ln(term_out);
+ write_ln(term_out, '! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false;
+ return;
+ end;
+
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do
+ incr(loc);
+
+ if loc<last then begin
+ init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out, 'Please type the name of your input file.');
+ end;
+exit:
+end;
+@z
+
+@x [4.49] l.1239 -- change documentation (probably needed in more places)
+would like string @'32 to be the single character @'32 instead of the
+@y
+would like string @'32 to be printed as the single character @'32 instead
+of the
+@z
+
+% [4.51] Open the pool file using a path, and can't do string
+% assignments directly. (`strcpy' and `strlen' work here because
+% `pool_name' is a constant string, and thus ends in a null and doesn't
+% start with a space.)
+@x
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+@y
+name_length := strlen (pool_name);
+name_of_file := xmalloc_array (ASCII_code, 1 + name_length);
+strcpy (stringcast(name_of_file+1), pool_name); {copy the string}
+if a_open_in (pool_file, kpse_mfpool_format) then
+@z
+
+@x [4.51,52,53] Make `MF.POOL' lowercase, and change how it's read.
+else bad_pool('! I can''t read MF.POOL.')
+@y
+else bad_pool('! I can''t read ', pool_name, '; bad path?')
+@z
+@x
+begin if eof(pool_file) then bad_pool('! MF.POOL has no check sum.');
+@.MF.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+@y
+begin if eof(pool_file) then bad_pool('! ', pool_name, ' has no check sum.');
+@.MF.POOL has no check sum@>
+read(pool_file,m); read(pool_file,n); {read two digits of string length}
+@z
+@x
+ bad_pool('! MF.POOL line doesn''t begin with two digits.');
+@y
+ bad_pool('! ', pool_name, ' line doesn''t begin with two digits.');
+@z
+@x
+ bad_pool('! MF.POOL check sum doesn''t have nine digits.');
+@y
+ bad_pool('! ', pool_name, ' check sum doesn''t have nine digits.');
+@z
+@x
+done: if a<>@$ then bad_pool('! MF.POOL doesn''t match; TANGLE me again.');
+@y
+done: if a<>@$ then
+ bad_pool('! ', pool_name, ' doesn''t match; tangle me again (or fix the path).');
+@z
+
+@x [5.54] error_line is a variable, so can't be a subrange array bound
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+@y
+@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for
+@z
+
+@x [5.58] Do not expand printable characters.
+if (s<256)and(selector>pseudo) then print_char(s)
+@y
+if (s<256)and((selector>pseudo)or xprn[s]) then print_char(s)
+@z
+
+@x [5.59] Do not expand printable characters.
+if (s<256)and(selector>pseudo) then print_char(s)
+@y
+if (s<256)and((selector>pseudo) or xprn[s])then print_char(s)
+@z
+
+@x [5.61] Print rest of banner, eliminate misleading `(no base preloaded)'.
+wterm(banner);
+if base_ident=0 then wterm_ln(' (no base preloaded)')
+else begin slow_print(base_ident); print_ln;
+ end;
+@y
+wterm (banner);
+wterm (version_string);
+if base_ident>0 then slow_print(base_ident); print_ln;
+if translate_filename then begin
+ wterm('(');
+ fputs(translate_filename, stdout);
+ wterm_ln(')');
+end;
+@z
+
+@x [6.68] l.1603 - Add unspecified_mode.
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@y
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d unspecified_mode=4 {extra value for command-line switch}
+@z
+
+@x [6.68] l.1605 - file:line:error style messages.
+ print_nl("! "); print(#);
+@y
+ if (file_line_error_style_p and not terminal_input) then
+ begin
+ print_nl ("");
+ print (full_source_filename_stack[in_open]);
+ print (":"); print_int (line); print (": ");
+ print (#);
+ end
+ else begin print_nl("! "); print(#) end;
+@z
+
+@x [6.68] l.1610 - Add interaction_option.
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@y
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@!interaction_option:batch_mode..unspecified_mode; {set from command line}
+@z
+
+@x [6.69] l.1612 - Allow override by command line switch.
+@ @<Set init...@>=interaction:=error_stop_mode;
+@y
+@ @<Set init...@>=if interaction_option=unspecified_mode then
+ interaction:=error_stop_mode
+else
+ interaction:=interaction_option;
+@z
+
+@x [6.76] Eliminate non-local goto.
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_MF;
+end;
+@y
+@d do_final_end==begin
+ update_terminal;
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+ uexit(1)
+ else
+ uexit(0);
+ end
+@<Error hand...@>=
+procedure jump_out;
+begin
+close_files_and_terminate;
+do_final_end;
+end;
+@z
+
+@x [6.77] l.1736 -- halt on error?
+print_char("."); show_context;
+@y
+print_char("."); show_context;
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+@z
+
+@x [6.79] Handle the switch-to-editor option.
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@y
+line ready to be edited.
+We do this by calling the external procedure |call_edit| with a pointer to
+the filename, its length, and the line number.
+However, here we just set up the variables that will be used as arguments,
+since we don't want to do the switch-to-editor until after \MF\ has closed
+its files.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines have
+not been commented out.
+@^debugging@>
+@d edit_file==input_stack[file_ptr]
+@z
+@x
+"E": if file_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ slow_print(input_stack[file_ptr].name_field);
+ print(" at line "); print_int(line);@/
+ interaction:=scroll_mode; jump_out;
+@y
+"E": if file_ptr>0 then
+ begin
+ edit_name_start:=str_start[edit_file.name_field];
+ edit_name_length:=str_start[edit_file.name_field+1] -
+ str_start[edit_file.name_field];
+ edit_line:=line;
+ jump_out;
+@z
+
+@x [7.96] Do half in cpascal.h. And add halfp as in MetaPost for speed.
+@d half(#)==(#) div 2
+@y
+@z
+
+@x [102] Use halfp.
+round_decimals:=half(a+1);
+@y
+round_decimals:=halfp(a+1);
+@z
+
+@x [7.107-7.115] Optionally replace make_fraction etc. with external routines
+@p function make_fraction(@!p,@!q:integer):fraction;
+@y
+In the C version, there are external routines that use double precision
+floating point to simulate functions such as |make_fraction|. This is
+carefully done to be virtually machine-independent and it gives up to 12
+times speed-up on machines with hardware floating point. Since some
+machines do not have fast double-precision floating point, we provide a
+C preprocessor switch that allows selecting the standard versions given
+below. (There's no configure option to select FIXPT, however, since I
+don't expect anyone will actually notice.)
+
+@p ifdef('FIXPT')@/
+function make_fraction(@!p,@!q:integer):fraction;
+@z
+@x
+ if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n;
+ end;
+end;
+@y
+ if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n;
+ end;
+end;@/
+endif('FIXPT')
+@z
+@x
+@p function take_fraction(@!q:integer;@!f:fraction):integer;
+@y
+@p ifdef('FIXPT')@/
+function take_fraction(@!q:integer;@!f:fraction):integer;
+@z
+@x
+else take_fraction:=n+p;
+end;
+@y
+else take_fraction:=n+p;
+end;@/
+endif('FIXPT')
+@z
+
+@x [111]
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>=
+p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$}
+if q<fraction_four then
+ repeat if odd(f) then p:=half(p+q)@+else p:=half(p);
+ f:=half(f);
+ until f=1
+else repeat if odd(f) then p:=p+half(q-p)@+else p:=half(p);
+ f:=half(f);
+ until f=1
+@y
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>=
+p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$}
+if q<fraction_four then
+ repeat if odd(f) then p:=halfp(p+q)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+else repeat if odd(f) then p:=p+halfp(q-p)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+@z
+
+@x
+@p function take_scaled(@!q:integer;@!f:scaled):integer;
+@y
+@p ifdef('FIXPT')@/
+function take_scaled(@!q:integer;@!f:scaled):integer;
+@z
+@x
+else take_scaled:=n+p;
+end;
+@y
+else take_scaled:=n+p;
+end;@/
+endif('FIXPT')
+@z
+
+@x [113]
+@ @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>=
+p:=half_unit; {that's $2^{15}$; the invariants hold now with $k=16$}
+@^inner loop@>
+if q<fraction_four then
+ repeat if odd(f) then p:=half(p+q)@+else p:=half(p);
+ f:=half(f);
+ until f=1
+else repeat if odd(f) then p:=p+half(q-p)@+else p:=half(p);
+ f:=half(f);
+ until f=1
+@y
+@ @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>=
+p:=half_unit; {that's $2^{15}$; the invariants hold now with $k=16$}
+@^inner loop@>
+if q<fraction_four then
+ repeat if odd(f) then p:=halfp(p+q)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+else repeat if odd(f) then p:=p+halfp(q-p)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+@z
+
+@x
+operands are positive. \ (This procedure is not used especially often,
+so it is not part of \MF's inner loop.)
+
+@p function make_scaled(@!p,@!q:integer):scaled;
+@y
+operands are positive. \ (This procedure is not used especially often,
+so it is not part of \MF's inner loop, but we might as well allow for
+an external C routine.)
+
+@p ifdef('FIXPT')@/
+function make_scaled(@!p,@!q:integer):scaled;
+@z
+@x
+ if negative then make_scaled:=-(f+n)@+else make_scaled:=f+n;
+ end;
+end;
+@y
+ if negative then make_scaled:=-(f+n)@+else make_scaled:=f+n;
+ end;
+end;@/
+endif('FIXPT')
+@z
+
+@x [7.119] Do floor_scaled, floor_unscaled, round_unscaled, round_fraction in C.
+@p function floor_scaled(@!x:scaled):scaled;
+ {$2^{16}\lfloor x/2^{16}\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=0 then floor_scaled:=x-(x mod unity)
+else begin be_careful:=x+1;
+ floor_scaled:=x+((-be_careful) mod unity)+1-unity;
+ end;
+end;
+@#
+function floor_unscaled(@!x:scaled):integer;
+ {$\lfloor x/2^{16}\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=0 then floor_unscaled:=x div unity
+else begin be_careful:=x+1; floor_unscaled:=-(1+((-be_careful) div unity));
+ end;
+end;
+@#
+function round_unscaled(@!x:scaled):integer;
+ {$\lfloor x/2^{16}+.5\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=half_unit then round_unscaled:=1+((x-half_unit) div unity)
+else if x>=-half_unit then round_unscaled:=0
+else begin be_careful:=x+1;
+ round_unscaled:=-(1+((-be_careful-half_unit) div unity));
+ end;
+end;
+@#
+function round_fraction(@!x:fraction):scaled;
+ {$\lfloor x/2^{12}+.5\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=2048 then round_fraction:=1+((x-2048) div 4096)
+else if x>=-2048 then round_fraction:=0
+else begin be_careful:=x+1;
+ round_fraction:=-(1+((-be_careful-2048) div 4096));
+ end;
+end;
+@y
+@z
+
+@x [121]
+ square_rt:=half(q);
+@y
+ square_rt:=halfp(q);
+@z
+
+@x [126]
+@p function pyth_sub(@!a,@!b:integer):integer;
+label done;
+var @!r:fraction; {register used to transform |a| and |b|}
+@!big:boolean; {is the input dangerously near $2^{31}$?}
+begin a:=abs(a); b:=abs(b);
+if a<=b then @<Handle erroneous |pyth_sub| and set |a:=0|@>
+else begin if a<fraction_four then big:=false
+ else begin a:=half(a); b:=half(b); big:=true;
+ end;
+ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>;
+ if big then a:=a+a;
+ end;
+pyth_sub:=a;
+end;
+@y
+@p function pyth_sub(@!a,@!b:integer):integer;
+label done;
+var @!r:fraction; {register used to transform |a| and |b|}
+@!big:boolean; {is the input dangerously near $2^{31}$?}
+begin a:=abs(a); b:=abs(b);
+if a<=b then @<Handle erroneous |pyth_sub| and set |a:=0|@>
+else begin if a<fraction_four then big:=false
+ else begin a:=halfp(a); b:=halfp(b); big:=true;
+ end;
+ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>;
+ if big then a:=a+a;
+ end;
+pyth_sub:=a;
+end;
+@z
+
+@x [133]
+@ @<Increase |k| until |x| can...@>=
+begin z:=((x-1) div two_to_the[k])+1; {$z=\lceil x/2^k\rceil$}
+while x<fraction_four+z do
+ begin z:=half(z+1); k:=k+1;
+ end;
+y:=y+spec_log[k]; x:=x-z;
+end
+@y
+@ @<Increase |k| until |x| can...@>=
+begin z:=((x-1) div two_to_the[k])+1; {$z=\lceil x/2^k\rceil$}
+while x<fraction_four+z do
+ begin z:=halfp(z+1); k:=k+1;
+ end;
+y:=y+spec_log[k]; x:=x-z;
+end
+@z
+
+@x [142]
+@<Set variable |z| to the arg...@>=
+while x>=fraction_two do
+ begin x:=half(x); y:=half(y);
+ end;
+z:=0;
+if y>0 then
+ begin while x<fraction_one do
+ begin double(x); double(y);
+ end;
+ @<Increase |z| to the arg of $(x,y)$@>;
+ end
+@y
+@<Set variable |z| to the arg...@>=
+while x>=fraction_two do
+ begin x:=halfp(x); y:=halfp(y);
+ end;
+z:=0;
+if y>0 then
+ begin while x<fraction_one do
+ begin double(x); double(y);
+ end;
+ @<Increase |z| to the arg of $(x,y)$@>;
+ end
+@z
+
+@x [150]
+@p procedure init_randoms(@!seed:scaled);
+var @!j,@!jj,@!k:fraction; {more or less random integers}
+@!i:0..54; {index into |randoms|}
+begin j:=abs(seed);
+while j>=fraction_one do j:=half(j);
+k:=1;
+for i:=0 to 54 do
+ begin jj:=k; k:=j-k; j:=jj;
+ if k<0 then k:=k+fraction_one;
+ randoms[(i*21)mod 55]:=j;
+ end;
+new_randoms; new_randoms; new_randoms; {``warm up'' the array}
+end;
+@y
+@p procedure init_randoms(@!seed:scaled);
+var @!j,@!jj,@!k:fraction; {more or less random integers}
+@!i:0..54; {index into |randoms|}
+begin j:=abs(seed);
+while j>=fraction_one do j:=halfp(j);
+k:=1;
+for i:=0 to 54 do
+ begin jj:=k; k:=j-k; j:=jj;
+ if k<0 then k:=k+fraction_one;
+ randoms[(i*21)mod 55]:=j;
+ end;
+new_randoms; new_randoms; new_randoms; {``warm up'' the array}
+end;
+@z
+
+@x [9.153] Increase memory size.
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|}
+@z
+
+@x [9.155] Don't bother to subtract zero.
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@d qo(#)==#-min_quarterword {to read eight bits from a quarterword}
+@d qi(#)==#+min_quarterword {to store eight bits in a quarterword}
+@y
+@d ho(#)==#
+@d qo(#)==#
+@d qi(#)==#
+@z
+
+@x [9.156] memory_word is defined externally.
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case three_choices of
+ 1: (@!int:integer);
+ 2: (@!hh:two_halves);
+ 3: (@!qqqq:four_quarters);
+ end;
+@y
+@=#include "texmfmem.h";@>
+@z
+
+@x [10.159] mem is dynamically allocated.
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@y
+@!mem : ^memory_word; {the big dynamic storage area}
+@z
+
+@x [10.167] Fix an unsigned/signed problem in getnode.
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+@y
+if r>intcast(p+1) then @<Allocate from the top of node |p| and |goto found|@>;
+@z
+
+% [11.178] Change the word `free' so that it doesn't conflict with the
+% standard C library routine of the same name. Also change arrays that
+% use mem_max, since that's a variable now, effectively disabling the feature.
+@x
+are debugging.)
+
+@<Glob...@>=
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip1em@>@!was_free: packed array [mem_min..mem_max] of boolean;
+@y
+are debugging.)
+
+@d free==free_arr
+@<Glob...@>=
+@!debug @!free: packed array [0..1] of boolean; {free cells; this loses}
+@t\hskip1em@>@!was_free: packed array [0..1] of boolean; {this loses too}
+@z
+
+@x [11.182] Eliminate unsigned comparisons to zero.
+repeat if (p>=lo_mem_max)or(p<mem_min) then clobbered:=true
+ else if (rlink(p)>=lo_mem_max)or(rlink(p)<mem_min) then clobbered:=true
+@y
+repeat if (p>=lo_mem_max) then clobbered:=true
+ else if (rlink(p)>=lo_mem_max) then clobbered:=true
+@z
+
+@x [12.194] Do `fix_date_and_time' in C.
+@ The following procedure, which is called just before \MF\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+Note that the values are |scaled| integers. Hence \MF\ can no longer
+be used after the year 32767.
+
+@p procedure fix_date_and_time;
+begin internal[time]:=12*60*unity; {minutes since midnight}
+internal[day]:=4*unity; {fourth day of the month}
+internal[month]:=7*unity; {seventh month of the year}
+internal[year]:=1776*unity; {Anno Domini}
+end;
+@y
+@ The following procedure, which is called just before \MF\ initializes its
+input and output, establishes the initial values of the date and time.
+It is calls an externally defined |date_and_time|, even though it could
+be done from Pascal.
+The external procedure also sets up interrupt catching.
+@^system dependencies@>
+
+Note that the values are |scaled| integers. Hence \MF\ can no longer
+be used after the year 32767.
+
+@p procedure fix_date_and_time;
+begin
+ date_and_time(internal[time],internal[day],internal[month],internal[year]);
+ internal[time] := internal[time] * unity;
+ internal[day] := internal[day] * unity;
+ internal[month] := internal[month] * unity;
+ internal[year] := internal[year] * unity;
+end;
+@z
+
+@x [12.198] Change class to c_class to avoid C++ keyword.
+@d max_class=20 {the largest class number}
+@y
+@d max_class=20 {the largest class number}
+@d class==c_class
+@z
+
+@x [12.199] Allow tab and form feed as input.
+for k:=127 to 255 do char_class[k]:=invalid_class;
+@y
+for k:=127 to 255 do char_class[k]:=invalid_class;
+char_class[tab]:=space_class;
+char_class[form_feed]:=space_class;
+@z
+
+@x [232] Use halfp.
+@p procedure init_big_node(@!p:pointer);
+var @!q:pointer; {the new node}
+@!s:small_number; {its size}
+begin s:=big_node_size[type(p)]; q:=get_node(s);
+repeat s:=s-2; @<Make variable |q+s| newly independent@>;
+name_type(q+s):=half(s)+x_part_sector; link(q+s):=null;
+until s=0;
+link(q):=p; value(p):=q;
+end;
+@y
+@p procedure init_big_node(@!p:pointer);
+var @!q:pointer; {the new node}
+@!s:small_number; {its size}
+begin s:=big_node_size[type(p)]; q:=get_node(s);
+repeat s:=s-2; @<Make variable |q+s| newly independent@>;
+name_type(q+s):=halfp(s)+x_part_sector; link(q+s):=null;
+until s=0;
+link(q):=p; value(p):=q;
+end;
+@z
+
+ [20.329] |valid_range| uses |abs|, which we have defined as a C
+% macro. Some C preprocessors cannot expand the giant argument here.
+% So we add a temporary.
+@x
+@p procedure edge_prep(@!ml,@!mr,@!nl,@!nr:integer);
+var @!delta:halfword; {amount of change}
+@y
+@p procedure edge_prep(@!ml,@!mr,@!nl,@!nr:integer);
+var @!delta:halfword; {amount of change}
+temp:integer;
+@z
+
+@x
+if not valid_range(m_min(cur_edges)+m_offset(cur_edges)-zero_field) or@|
+ not valid_range(m_max(cur_edges)+m_offset(cur_edges)-zero_field) then
+@y
+temp := m_offset (cur_edges) - zero_field;
+if not valid_range (m_min (cur_edges) + temp)
+ or not valid_range (m_max (cur_edges) + temp)
+then
+@z
+
+@x [442] Use halfp.
+@<Compute a good coordinate at a diagonal transition@>=
+begin if cur_pen=null_pen then pen_edge:=0
+else if cur_path_type=double_path_code then @<Compute a compromise |pen_edge|@>
+else if right_type(q)<=switch_x_and_y then pen_edge:=diag_offset(right_type(q))
+else pen_edge:=-diag_offset(right_type(q));
+if odd(right_type(q)) then a:=good_val(b,pen_edge+half(cur_gran))
+else a:=good_val(b-1,pen_edge+half(cur_gran));
+end
+@y
+@<Compute a good coordinate at a diagonal transition@>=
+begin if cur_pen=null_pen then pen_edge:=0
+else if cur_path_type=double_path_code then @<Compute a compromise |pen_edge|@>
+else if right_type(q)<=switch_x_and_y then pen_edge:=diag_offset(right_type(q))
+else pen_edge:=-diag_offset(right_type(q));
+if odd(right_type(q)) then a:=good_val(b,pen_edge+halfp(cur_gran))
+else a:=good_val(b-1,pen_edge+halfp(cur_gran));
+end
+@z
+
+@x [24.509] i18n fix
+print(" ("); print_int(info(h)); print(" offset");
+if info(h)<>1 then print_char("s");
+@y
+print(" ("); print_int(info(h));
+if info(h)<>1 then print(" offsets")
+else print(" offset");
+@z
+
+% [25.530] |make_fraction| and |take_fraction| arguments are too long for
+% some preprocessors, when they were defined as macros, just as in the
+% previous change.
+@x
+ alpha:=take_fraction(take_fraction(major_axis,
+ make_fraction(gamma,beta)),n_cos)@|
+ -take_fraction(take_fraction(minor_axis,
+ make_fraction(delta,beta)),n_sin);
+ alpha:=(alpha+half_unit) div unity;
+ gamma:=pyth_add(take_fraction(major_axis,n_cos),
+ take_fraction(minor_axis,n_sin));
+@y
+ alpha := make_fraction (gamma, beta);
+ alpha := take_fraction (major_axis, alpha);
+ alpha := take_fraction (alpha, n_cos);
+ alpha := (alpha+half_unit) div unity;
+ gamma := take_fraction (minor_axis, n_sin);
+ gamma := pyth_add (take_fraction (major_axis, n_cos), gamma);
+@z
+
+@x [556]
+@p procedure cubic_intersection(@!p,@!pp:pointer);
+label continue, not_found, exit;
+var @!q,@!qq:pointer; {|link(p)|, |link(pp)|}
+begin time_to_go:=max_patience; max_t:=2;
+@<Initialize for intersections at level zero@>;
+loop@+ begin continue:
+ if delx-tol<=stack_max(x_packet(xy))-stack_min(u_packet(uv)) then
+ if delx+tol>=stack_min(x_packet(xy))-stack_max(u_packet(uv)) then
+ if dely-tol<=stack_max(y_packet(xy))-stack_min(v_packet(uv)) then
+ if dely+tol>=stack_min(y_packet(xy))-stack_max(v_packet(uv)) then
+ begin if cur_t>=max_t then
+ begin if max_t=two then {we've done 17 bisections}
+ begin cur_t:=half(cur_t+1); cur_tt:=half(cur_tt+1); return;
+ end;
+ double(max_t); appr_t:=cur_t; appr_tt:=cur_tt;
+ end;
+ @<Subdivide for a new level of intersection@>;
+ goto continue;
+ end;
+ if time_to_go>0 then decr(time_to_go)
+ else begin while appr_t<unity do
+ begin double(appr_t); double(appr_tt);
+ end;
+ cur_t:=appr_t; cur_tt:=appr_tt; return;
+ end;
+ @<Advance to the next pair |(cur_t,cur_tt)|@>;
+ end;
+exit:end;
+@y
+@p procedure cubic_intersection(@!p,@!pp:pointer);
+label continue, not_found, exit;
+var @!q,@!qq:pointer; {|link(p)|, |link(pp)|}
+begin time_to_go:=max_patience; max_t:=2;
+@<Initialize for intersections at level zero@>;
+loop@+ begin continue:
+ if delx-tol<=stack_max(x_packet(xy))-stack_min(u_packet(uv)) then
+ if delx+tol>=stack_min(x_packet(xy))-stack_max(u_packet(uv)) then
+ if dely-tol<=stack_max(y_packet(xy))-stack_min(v_packet(uv)) then
+ if dely+tol>=stack_min(y_packet(xy))-stack_max(v_packet(uv)) then
+ begin if cur_t>=max_t then
+ begin if max_t=two then {we've done 17 bisections}
+ begin cur_t:=halfp(cur_t+1); cur_tt:=halfp(cur_tt+1); return;
+ end;
+ double(max_t); appr_t:=cur_t; appr_tt:=cur_tt;
+ end;
+ @<Subdivide for a new level of intersection@>;
+ goto continue;
+ end;
+ if time_to_go>0 then decr(time_to_go)
+ else begin while appr_t<unity do
+ begin double(appr_t); double(appr_tt);
+ end;
+ cur_t:=appr_t; cur_tt:=appr_tt; return;
+ end;
+ @<Advance to the next pair |(cur_t,cur_tt)|@>;
+ end;
+exit:end;
+@z
+
+@x [561]
+@ @<Descend to the previous level...@>=
+begin cur_t:=half(cur_t); cur_tt:=half(cur_tt);
+if cur_t=0 then return;
+bisect_ptr:=bisect_ptr-int_increment; three_l:=three_l-tol_step;
+delx:=stack_dx; dely:=stack_dy; tol:=stack_tol; uv:=stack_uv; xy:=stack_xy;@/
+goto not_found;
+end
+@y
+@ @<Descend to the previous level...@>=
+begin cur_t:=halfp(cur_t); cur_tt:=halfp(cur_tt);
+if cur_t=0 then return;
+bisect_ptr:=bisect_ptr-int_increment; three_l:=three_l-tol_step;
+delx:=stack_dx; dely:=stack_dy; tol:=stack_tol; uv:=stack_uv; xy:=stack_xy;@/
+goto not_found;
+end
+@z
+
+@x [27.564] The window functions are defined externally, in C.
+@p function init_screen:boolean;
+begin init_screen:=false;
+end;
+@#
+procedure update_screen; {will be called only if |init_screen| returns |true|}
+begin @!init wlog_ln('Calling UPDATESCREEN');@+tini {for testing only}
+end;
+@y
+{These functions/procedures are defined externally in C.}
+@z
+
+@x [27.567]
+@p procedure blank_rectangle(@!left_col,@!right_col:screen_col;
+ @!top_row,@!bot_row:screen_row);
+var @!r:screen_row;
+@!c:screen_col;
+begin @{@+for r:=top_row to bot_row-1 do
+ for c:=left_col to right_col-1 do
+ screen_pixel[r,c]:=white;@+@}@/
+@!init wlog_cr; {this will be done only after |init_screen=true|}
+wlog_ln('Calling BLANKRECTANGLE(',left_col:1,',',
+ right_col:1,',',top_row:1,',',bot_row:1,')');@+tini
+end;
+@y
+{Same thing.}
+@z
+
+@x [27.568]
+@p procedure paint_row(@!r:screen_row;@!b:pixel_color;var @!a:trans_spec;
+ @!n:screen_col);
+var @!k:screen_col; {an index into |a|}
+@!c:screen_col; {an index into |screen_pixel|}
+begin @{ k:=0; c:=a[0];
+repeat incr(k);
+ repeat screen_pixel[r,c]:=b; incr(c);
+ until c=a[k];
+ b:=black-b; {$|black|\swap|white|$}
+ until k=n;@+@}@/
+@!init wlog('Calling PAINTROW(',r:1,',',b:1,';');
+ {this is done only after |init_screen=true|}
+for k:=0 to n do
+ begin wlog(a[k]:1); if k<>n then wlog(',');
+ end;
+wlog_ln(')');@+tini
+end;
+@y
+{Same thing}
+@z
+
+@x [28.585] Check for overflow of the serial numbers.
+@d s_scale=64 {the serial numbers are multiplied by this factor}
+@d new_indep(#)== {create a new independent variable}
+ begin type(#):=independent; serial_no:=serial_no+s_scale;
+ value(#):=serial_no;
+ end
+@y
+@d s_scale=64 {the serial numbers are multiplied by this factor}
+@d max_indep_vars==@'177777777 {$2^{25}-1$}
+@d max_serial_no==@'17777777700 {|max_indep_vars*s_scale|}
+@d new_indep(#)== {create a new independent variable}
+ begin if serial_no=max_serial_no then
+ overflow("independent variables",max_indep_vars);
+ type(#):=independent; serial_no:=serial_no+s_scale;
+ value(#):=serial_no;
+ end
+@z
+
+@x [596] Use halfp.
+@ @<Contribute a term from |q|, multiplied by~|f|@>=
+begin if tt=dependent then v:=take_fraction(f,value(q))
+else v:=take_scaled(f,value(q));
+if abs(v)>half(threshold) then
+ begin s:=get_node(dep_node_size); info(s):=qq; value(s):=v;
+ if abs(v)>=coef_bound then if watch_coefs then
+ begin type(qq):=independent_needing_fix; fix_needed:=true;
+ end;
+ link(r):=s; r:=s;
+ end;
+q:=link(q); qq:=info(q);
+end
+@y
+@ @<Contribute a term from |q|, multiplied by~|f|@>=
+begin if tt=dependent then v:=take_fraction(f,value(q))
+else v:=take_scaled(f,value(q));
+if abs(v)>halfp(threshold) then
+ begin s:=get_node(dep_node_size); info(s):=qq; value(s):=v;
+ if abs(v)>=coef_bound then if watch_coefs then
+ begin type(qq):=independent_needing_fix; fix_needed:=true;
+ end;
+ link(r):=s; r:=s;
+ end;
+q:=link(q); qq:=info(q);
+end
+@z
+
+@x [31.631] l.13346 - Add datastructures for file:line:error.
+@!line_stack : array[1..max_in_open] of integer;
+@y
+@!line_stack : array[1..max_in_open] of integer;
+@!source_filename_stack : ^str_number;
+@!full_source_filename_stack : ^str_number;
+@z
+
+@x [38.768] Area and extension rules.
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters:
+
+@<Glob...@>=
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+@y
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\./', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep
+track of the occurrences of area and extension delimiters:
+
+@<Glob...@>=
+@!area_delimiter:pool_pointer; {the most recent `\./', if any}
+@!ext_delimiter:pool_pointer; {the most recent `\..', if any}
+@z
+
+@x [38.769] MF area directories.
+@d MF_area=="MFinputs:"
+@.MFinputs@>
+@y
+In C, the default paths are specified separately.
+@z
+
+@x [38.770] filenames: quoted
+begin area_delimiter:=0; ext_delimiter:=0;
+@y
+begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false;
+@z
+
+@x [38.771] more_name
+begin if c=" " then more_name:=false
+else begin if (c=">")or(c=":") then
+@y
+begin
+if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+ end
+else if ((c=" ")or(c=tab)) and stop_at_space and (not quoted_filename) then
+ more_name:=false
+else begin
+ if IS_DIR_SEP (c) then
+@z
+
+@x [38.771] more_name
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr;
+@y
+ else if c="." then ext_delimiter:=pool_ptr;
+@z
+
+@x [38.772] end_name
+@p procedure end_name;
+begin if str_ptr+3>max_str_ptr then
+ begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:METAFONT capacity exceeded number of strings}{\quad number of strings@>
+ max_str_ptr:=str_ptr+3;
+ end;
+@y
+@p procedure end_name;
+var must_quote:boolean; {whether we need to quote a string}
+@!j,@!s,@!t: pool_pointer; {running indices}
+begin if str_ptr+3>max_str_ptr then
+ begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:METAFONT capacity exceeded number of strings}{\quad number of strings@>
+ max_str_ptr:=str_ptr+3;
+ end;
+str_room(6); {room for quotes, if they are needed}
+if area_delimiter<>0 then begin
+ {maybe quote |cur_area|}
+ must_quote:=false;
+ s:=str_start[str_ptr];
+ t:=area_delimiter+1;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=' '; incr(j);
+ end;
+ if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+ area_delimiter:=area_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+ s:=area_delimiter+1;
+ end
+else begin
+ s:=str_start[str_ptr];
+ end;
+{maybe quote |cur_name|}
+if ext_delimiter=0 then t:=pool_ptr else t:=ext_delimiter;
+must_quote:=false;
+j:=s;
+while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+if ext_delimiter<>0 then begin
+ {maybe quote |cur_ext|}
+ s:=ext_delimiter;
+ t:=pool_ptr;
+ must_quote:=false;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=' '; incr(j);
+ end;
+ if must_quote then begin
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ pool_ptr:=pool_ptr+2;
+ end;
+ end;
+@z
+
+@x [38.773] print_file_name: quote if spaces in names.
+begin slow_print(a); slow_print(n); slow_print(e);
+@y
+var must_quote: boolean; {whether to quote the filename}
+@!j:pool_pointer; {index into |str_pool|}
+begin
+must_quote:=false;
+if a<>0 then begin
+ j:=str_start[a];
+ while (not must_quote) and (j<>str_start[a+1]) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if n<>0 then begin
+ j:=str_start[n];
+ while (not must_quote) and (j<>str_start[n+1]) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if e<>0 then begin
+ j:=str_start[e];
+ while (not must_quote) and (j<>str_start[e+1]) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if must_quote then slow_print("""");
+if a<>0 then
+ for j:=str_start[a] to str_start[a+1]-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]));
+if n<>0 then
+ for j:=str_start[n] to str_start[n+1]-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]));
+if e<>0 then
+ for j:=str_start[e] to str_start[e+1]-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]));
+if must_quote then slow_print("""");
+@z
+
+@x [38.774] have append_to_name skip quotes.
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+@x [38.774] (pack_file_name) malloc and null terminate name_of_file.
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file := xmalloc_array (ASCII_code, length(a)+length(n)+length(e)+1);
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
+@z
+@x
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length + 1] := 0;
+@z
+
+@x [38.775] The default base.
+@d base_default_length=18 {length of the |MF_base_default| string}
+@d base_area_length=8 {length of its area part}
+@y
+@d base_area_length=0 {no fixed area in C}
+@z
+
+@x [38.776] Where `plain.base' is.
+@!MF_base_default:packed array[1..base_default_length] of char;
+
+@ @<Set init...@>=
+MF_base_default:='MFbases:plain.base';
+@y
+@!base_default_length: integer;
+@!MF_base_default: ^char;
+
+@ We set the name of the default format file and the length of that name
+in \.{texmfmp.c}, since we want them to depend on the name of the
+program.
+@z
+
+@x [38.778] Change to pack_buffered_name as with pack_file_name.
+for j:=1 to n do append_to_name(xord[MF_base_default[j]]);
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file := xmalloc_array (ASCII_code, n + (b-a+1) + base_ext_length + 1);
+for j:=1 to n do append_to_name(xord[MF_base_default[j]]);
+@z
+% @x [38.778] Set program name to match format.
+% for j:=a to b do append_to_name(buffer[j]);
+% @y
+% for j:=a to b do append_to_name(buffer[j]);
+% name_of_file[k+1]:=0;
+% kpse_reset_program_name(name_of_file+1);
+% @z
+@x [38.778] Change to pack_buffered_name as with pack_file_name.
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length + 1] := 0;
+@z
+
+@x [38.779] Base file opening: do path searching for the default, not plain.
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(base_file) then goto found;
+ pack_buffered_name(base_area_length,loc,j-1);
+ {now try the system base file area}
+ if w_open_in(base_file) then goto found;
+@y
+ pack_buffered_name(0,loc,j-1);
+ if w_open_in(base_file) then goto found;
+@z
+@x
+ wterm_ln('Sorry, I can''t find that base;',' will try PLAIN.');
+@y
+ wterm ('Sorry, I can''t find the base `');
+ fputs (stringcast(name_of_file + 1), stdout);
+ wterm ('''; will try `');
+ fputs (MF_base_default + 1, stdout);
+ wterm_ln ('''.');
+@z
+@x
+ wterm_ln('I can''t find the PLAIN base file!');
+@.I can't find PLAIN...@>
+@y
+ wterm ('I can''t find the base file `');
+ fputs (MF_base_default + 1, stdout);
+ wterm_ln ('''!');
+@.I can't find the base...@>
+@z
+
+@x [38.780] make_name_string
+ make_name_string:=make_string;
+ end;
+@y
+ make_name_string:=make_string;
+ end;
+ {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to
+ match the contents of |name_of_file|.}
+ k:=1;
+ begin_name;
+ stop_at_space:=false;
+ while (k<=name_length)and(more_name(name_of_file[k])) do
+ incr(k);
+ stop_at_space:=true;
+ end_name;
+@z
+
+@x [38.781] Make scan_file_name ignore leading tabs as well as spaces.
+while buffer[loc]=" " do incr(loc);
+@y
+while (buffer[loc]=" ")or(buffer[loc]=tab) do incr(loc);
+@z
+
+@x [38.782] `logname' is declared in <unistd.h> on some systems.
+`\.{.base}' and `\.{.tfm}' in the names of \MF's output files.
+@y
+`\.{.base}' and `\.{.tfm}' in the names of \MF's output files.
+@d log_name == texmf_log_name
+@z
+
+@x [38.786] prompt_file_name: avoid empty filenames.
+var @!k:0..buf_size; {index into |buffer|}
+@y
+var @!k:0..buf_size; {index into |buffer|}
+@!saved_cur_name:str_number; {to catch empty terminal input}
+@z
+
+@x [38.786] prompt_file_name: avoid empty filenames.
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+@y
+saved_cur_name:=cur_name;
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+if length(cur_name)=0 then cur_name:=saved_cur_name;
+@z
+
+@x [38.787] <Scan file name...> needs similar leading tab treatment.
+while (buffer[k]=" ")and(k<last) do incr(k);
+@y
+while ((buffer[k]=" ")or(buffer[k]=tab))and(k<last) do incr(k);
+@z
+
+@x [38.788] Adjust for C string conventions.
+@!months:packed array [1..36] of char; {abbreviations of month names}
+@y
+@!months:^char;
+@z
+
+@x [38.788] Set correct filename for recorder.
+if job_name=0 then job_name:="mfput";
+@.mfput@>
+pack_job_name(".log");
+@y
+if job_name=0 then job_name:=get_job_name("mfput");
+@.mfput@>
+pack_job_name(".fls");
+recorder_change_filename(stringcast(name_of_file+1));
+pack_job_name(".log");
+@z
+
+@x [38.790]
+begin wlog(banner);
+slow_print(base_ident); print(" ");
+print_int(round_unscaled(internal[day])); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@y
+begin wlog(banner);
+wlog (version_string);
+slow_print(base_ident); print(" ");
+print_int(round_unscaled(internal[day])); print_char(" ");
+months := ' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@z
+
+@x [38.790] l.15898 - Print TCX name, if given.
+end
+@y
+if translate_filename then begin
+ wlog_cr;
+ wlog('(');
+ fputs(translate_filename, log_file);
+ wlog(')');
+end;
+end
+@z
+
+@x [38.793] (start_input) a_open_in of input file needs path specifier.
+begin @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>;
+if cur_ext="" then cur_ext:=".mf";
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,MF_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+@y Don't assume a single . in filenames.
+var temp_str: str_number; k: integer;
+begin @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>;
+pack_cur_name;
+loop@+begin
+ begin_file_reading; {set up |cur_file| and new level of input}
+ if cur_ext = ".mf" then begin
+ cur_ext := "";
+ pack_cur_name;
+ end;
+ {Kpathsea tries all the various ways to get the file.}
+ if open_in_name_ok(stringcast(name_of_file+1))
+ and a_open_in(cur_file, kpse_mf_format) then
+ goto done;
+@z
+
+@x [38.793] l.15938 - The job name may have been given on the command line.
+ begin job_name:=cur_name; open_log_file;
+@y
+ begin job_name:=get_job_name(cur_name); open_log_file;
+@z
+
+@x [38.793] Can't return name to string pool because of editor option?
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string(name); name:=cur_name;
+ end;
+@y
+@z
+
+@x [866] Use halfp.
+@<Change node |q|...@>=
+begin tx:=x_coord(q); ty:=y_coord(q);
+txx:=left_x(q)-tx; tyx:=left_y(q)-ty;
+txy:=right_x(q)-tx; tyy:=right_y(q)-ty;
+a_minus_b:=pyth_add(txx-tyy,tyx+txy); a_plus_b:=pyth_add(txx+tyy,tyx-txy);
+major_axis:=half(a_minus_b+a_plus_b); minor_axis:=half(abs(a_plus_b-a_minus_b));
+if major_axis=minor_axis then theta:=0 {circle}
+else theta:=half(n_arg(txx-tyy,tyx+txy)+n_arg(txx+tyy,tyx-txy));
+free_node(q,knot_node_size);
+q:=make_ellipse(major_axis,minor_axis,theta);
+if (tx<>0)or(ty<>0) then @<Shift the coordinates of path |q|@>;
+end
+@y
+@<Change node |q|...@>=
+begin tx:=x_coord(q); ty:=y_coord(q);
+txx:=left_x(q)-tx; tyx:=left_y(q)-ty;
+txy:=right_x(q)-tx; tyy:=right_y(q)-ty;
+a_minus_b:=pyth_add(txx-tyy,tyx+txy); a_plus_b:=pyth_add(txx+tyy,tyx-txy);
+major_axis:=halfp(a_minus_b+a_plus_b); minor_axis:=halfp(abs(a_plus_b-a_minus_b));
+if major_axis=minor_axis then theta:=0 {circle}
+else theta:=half(n_arg(txx-tyy,tyx+txy)+n_arg(txx+tyy,tyx-txy));
+free_node(q,knot_node_size);
+q:=make_ellipse(major_axis,minor_axis,theta);
+if (tx<>0)or(ty<>0) then @<Shift the coordinates of path |q|@>;
+end
+@z
+
+@x [42.965] A C casting problem.
+if (m_min(cur_edges)+tx<=0)or(m_max(cur_edges)+tx>=8192)or@|
+ (n_min(cur_edges)+ty<=0)or(n_max(cur_edges)+ty>=8191)or@|
+@y
+if (intcast(m_min(cur_edges))+tx<=0)or(m_max(cur_edges)+tx>=8192)or@|
+ (intcast(n_min(cur_edges))+ty<=0)or(n_max(cur_edges)+ty>=8191)or@|
+@z
+
+@x [44.1023] if batchmode, MakeTeX... scripts should be silent.
+mode_command: begin print_ln; interaction:=cur_mod;
+@y
+mode_command: begin print_ln; interaction:=cur_mod;
+if interaction = batch_mode
+then kpse_make_tex_discard_errors := 1
+else kpse_make_tex_discard_errors := 0;
+@z
+
+% [45.1120] `threshold' is both a function and a variable. Since the
+% function is used much less often than the variable, we'll change that
+@x
+@p function threshold(@!m:integer):scaled;
+var @!d:scaled; {lower bound on the smallest interval size}
+begin excess:=min_cover(0)-m;
+if excess<=0 then threshold:=0
+else begin repeat d:=perturbation;
+ until min_cover(d+d)<=m;
+ while min_cover(d)>m do d:=perturbation;
+ threshold:=d;
+@y
+@p function threshold_fn(@!m:integer):scaled;
+var @!d:scaled; {lower bound on the smallest interval size}
+begin excess:=min_cover(0)-m;
+if excess<=0 then threshold_fn:=0
+else begin repeat d:=perturbation;
+ until min_cover(d+d)<=m;
+ while min_cover(d)>m do d:=perturbation;
+ threshold_fn:=d;
+@z
+
+@x [45.1121] Change the call to the threshold function.
+begin d:=threshold(m); perturbation:=0;
+@y
+begin d:=threshold_fn(m); perturbation:=0;
+@z
+
+@x [1122]
+@ @<Replace an interval...@>=
+begin repeat p:=link(p); info(p):=m;
+decr(excess);@+if excess=0 then d:=0;
+until value(link(p))>l+d;
+v:=l+half(value(p)-l);
+if value(p)-v>perturbation then perturbation:=value(p)-v;
+r:=q;
+repeat r:=link(r); value(r):=v;
+until r=p;
+link(q):=p; {remove duplicate values from the current list}
+end
+@y
+@ @<Replace an interval...@>=
+begin repeat p:=link(p); info(p):=m;
+decr(excess);@+if excess=0 then d:=0;
+until value(link(p))>l+d;
+v:=l+halfp(value(p)-l);
+if value(p)-v>perturbation then perturbation:=value(p)-v;
+r:=q;
+repeat r:=link(r); value(r):=v;
+until r=p;
+link(q):=p; {remove duplicate values from the current list}
+end
+@z
+
+@x [45.1133] Use C macros to do the TFM writing, to avoid casting(?) problems.
+@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|}
+
+@p procedure tfm_two(@!x:integer); {output two bytes to |tfm_file|}
+begin tfm_out(x div 256); tfm_out(x mod 256);
+end;
+@#
+procedure tfm_four(@!x:integer); {output four bytes to |tfm_file|}
+begin if x>=0 then tfm_out(x div three_bytes)
+else begin x:=x+@'10000000000; {use two's complement for negative values}
+ x:=x+@'10000000000;
+ tfm_out((x div three_bytes) + 128);
+ end;
+x:=x mod three_bytes; tfm_out(x div unity);
+x:=x mod unity; tfm_out(x div @'400);
+tfm_out(x mod @'400);
+end;
+@#
+procedure tfm_qqqq(@!x:four_quarters); {output four quarterwords to |tfm_file|}
+@y
+The default definitions for |tfm_two| and |tfm_four| don't work.
+I don't know why not. Some casting problem?
+
+@d tfm_out(#) == put_byte (#, tfm_file)
+@d tfm_two(#) == put_2_bytes (tfm_file, #)
+@d tfm_four(#) == put_4_bytes (tfm_file, #)
+
+@p procedure tfm_qqqq(@!x:four_quarters); {output four quarterwords to |tfm_file|}
+@z
+
+@x [47.1134] print_file_name
+print_nl("Font metrics written on "); slow_print(metric_file_name);
+@y
+print_nl("Font metrics written on "); print_file_name(0,metric_file_name,0);
+@z
+
+@x [47.1152] declare gf_buf as a pointer, for dynamic allocated
+@!gf_buf:array[gf_index] of eight_bits; {buffer for \.{GF} output}
+@y
+@!gf_buf:^eight_bits; {dynamically-allocated buffer for \.{GF} output}
+@z
+
+@x [47.1154] omit write_gf
+@<Declare generic font output procedures@>=
+procedure write_gf(@!a,@!b:gf_index);
+var k:gf_index;
+begin for k:=a to b do write(gf_file,gf_buf[k]);
+end;
+@y
+In C, we use a macro to call |fwrite| or |write| directly, writing all
+the bytes to be written in one shot. Much better than writing four
+bytes at a time.
+@z
+
+@x [47.1163] C needs k to be 0..256 instead of 0..255.
+procedure init_gf;
+var @!k:eight_bits; {runs through all possible character codes}
+@y
+procedure init_gf;
+var @!k:0..256; {runs through all possible character codes}
+@z
+
+@x [47.1169] Fix signed/unsigned comparison problem in C.
+if prev_m-m_offset(cur_edges)+x_off>gf_max_m then
+ gf_max_m:=prev_m-m_offset(cur_edges)+x_off
+@y
+if prev_m-intcast(m_offset(cur_edges))+x_off>gf_max_m then
+ gf_max_m:=prev_m-m_offset(cur_edges)+x_off
+@z
+
+@x [47.1182] print_file_name
+print_nl("Output written on "); slow_print(output_file_name);
+@y
+print_nl("Output written on "); print_file_name(0,output_file_name,0);
+@z
+
+@x [47.1182] i18n fix
+print(" ("); print_int(total_chars); print(" character");
+if total_chars<>1 then print_char("s");
+@y
+print(" ("); print_int(total_chars);
+if total_chars<>1 then print(" characters")
+else print(" character");
+@z
+
+@x [48.1185] INI = VIR.
+base_ident:=" (INIMF)";
+@y
+if ini_version then base_ident:=" (INIMF)";
+@z
+
+@x [48.1186] Add base_engine.
+@!w: four_quarters; {four ASCII codes}
+@y
+@!w: four_quarters; {four ASCII codes}
+@!base_engine: ^text_char;
+@z
+
+@x [48.1187] Add base_engine.
+@!w: four_quarters; {four ASCII codes}
+@y
+@!w: four_quarters; {four ASCII codes}
+@!base_engine: ^text_char;
+@!dummy_xord: ASCII_code;
+@!dummy_xchr: text_char;
+@!dummy_xprn: ASCII_code;
+@z
+
+@x [48.1188] Reading and writing of `base_file' is done in C.
+@d dump_wd(#)==begin base_file^:=#; put(base_file);@+end
+@d dump_int(#)==begin base_file^.int:=#; put(base_file);@+end
+@d dump_hh(#)==begin base_file^.hh:=#; put(base_file);@+end
+@d dump_qqqq(#)==begin base_file^.qqqq:=#; put(base_file);@+end
+@y
+@z
+
+@x [48.1189]
+@d undump_wd(#)==begin get(base_file); #:=base_file^;@+end
+@d undump_int(#)==begin get(base_file); #:=base_file^.int;@+end
+@d undump_hh(#)==begin get(base_file); #:=base_file^.hh;@+end
+@d undump_qqqq(#)==begin get(base_file); #:=base_file^.qqqq;@+end
+@y
+@z
+
+@x [48.1190] Dump engine name.
+dump_int(@$);@/
+@y
+dump_int(@"57324D46); {Web2C \MF's magic constant: "W2MF"}
+{Align engine to 4 bytes with one or more trailing NUL}
+x:=strlen(engine_name);
+base_engine:=xmalloc_array(text_char,x+4);
+strcpy(base_engine, engine_name);
+for k:=x to x+3 do base_engine[k]:=0;
+x:=x+4-(x mod 4);
+dump_int(x);dump_things(base_engine[0], x);
+libc_free(base_engine);@/
+dump_int(@$);@/
+@<Dump |xord|, |xchr|, and |xprn|@>;
+@z
+
+@x [48.1191] Avoid Pascal file convention.
+x:=base_file^.int;
+if x<>@$ then goto off_base; {check that strings are the same}
+undump_int(x);
+if x<>mem_min then goto off_base;
+undump_int(x);
+if x<>mem_top then goto off_base;
+@y
+undump_int(x);
+if x<>@"57324D46 then goto off_base; {not a base file}
+undump_int(x);
+if (x<0) or (x>256) then goto off_base; {corrupted base file}
+base_engine:=xmalloc_array(text_char, x);
+undump_things(base_engine[0], x);
+base_engine[x-1]:=0; {force string termination, just in case}
+if strcmp(engine_name, base_engine) then
+ begin wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' was written by ', base_engine);
+ libc_free(base_engine);
+ goto off_base;
+end;
+libc_free(base_engine);
+undump_int(x);
+if x<>@$ then begin {check that strings are the same}
+ wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' doesn''t match ', pool_name);
+ goto off_base;
+end;
+@<Undump |xord|, |xchr|, and |xprn|@>;
+undump_int(x);
+if x<>mem_min then goto off_base;
+{Now we deal with dynamically allocating the memory. We don't provide
+ all the fancy features \.{tex.ch} does---all that matters is enough to
+ run the trap test with a memory size of 3000.}
+@+init
+if ini_version then begin
+ {We allocated this at start-up, but now we need to reallocate.}
+ libc_free (mem);
+end;
+@+tini
+undump_int (mem_top); {Overwrite whatever we had.}
+if mem_max < mem_top then mem_max:=mem_top; {Use at least what we dumped.}
+if mem_min+1100>mem_top then goto off_base;
+mem:=xmalloc_array (memory_word, mem_max - mem_min + 1);
+@z
+
+@x [48.1199] l.22725 - - Allow command line to override dumped value.
+undump(batch_mode)(error_stop_mode)(interaction);
+@y
+undump(batch_mode)(error_stop_mode)(interaction);
+if interaction_option<>unspecified_mode then interaction:=interaction_option;
+@z
+
+@x [48.1199] eof is like C feof here.
+undump_int(x);@+if (x<>69069)or eof(base_file) then goto off_base
+@y
+undump_int(x);@+if (x<>69069)or feof(base_file) then goto off_base
+@z
+
+@x [48.1200] Eliminate probably-wrong word `preloaded' from base_idents.
+print(" (preloaded base="); print(job_name); print_char(" ");
+@y
+print(" (base="); print(job_name); print_char(" ");
+@z
+
+@x [49.1204] Dynamic allocation.
+@p begin @!{|start_here|}
+@y
+@d const_chk(#) == begin if # < inf@&# then # := inf@&# else
+ if # > sup@&# then # := sup@&# end
+{|setup_bound_var| stuff duplicated in \.{tex.ch}.}
+@d setup_bound_var(#) == bound_default := #; setup_bound_var_end
+@d setup_bound_var_end(#) == bound_name := #; setup_bound_var_end_end
+@d setup_bound_var_end_end(#) ==
+ setup_bound_variable (address_of (#), bound_name, bound_default);
+
+@p begin @!{|start_here|}
+ {See comments in \.{tex.ch} for why the name has to be duplicated.}
+ setup_bound_var (250000)('main_memory')(main_memory);
+ {|memory_word|s for |mem| in \.{INIMF}}
+ setup_bound_var (3000)('buf_size')(buf_size);
+ setup_bound_var (79)('error_line')(error_line);
+ setup_bound_var (50)('half_error_line')(half_error_line);
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ setup_bound_var (16384)('gf_buf_size')(gf_buf_size);
+ if error_line > ssup_error_line then error_line := ssup_error_line;
+
+ const_chk (main_memory);
+ {|mem_top| is an index, |main_memory| is a size}
+ mem_top := mem_min + main_memory - 1;
+ mem_max := mem_top;
+ const_chk (buf_size);
+
+ buffer:=xmalloc_array (ASCII_code, buf_size);
+ gf_buf:=xmalloc_array (eight_bits, gf_buf_size);
+ source_filename_stack:=xmalloc_array (str_number, max_in_open);
+ full_source_filename_stack:=xmalloc_array (str_number, max_in_open);
+
+@+init
+if ini_version then begin
+ mem:=xmalloc_array (memory_word, mem_top - mem_min + 1);
+end;
+@+tini
+@z
+
+@x [49.1204] Only do get_strings_started if ini.
+@!init if not get_strings_started then goto final_end;
+init_tab; {initialize the tables}
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;@/
+max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+@y 22833
+@!init
+if ini_version then begin
+if not get_strings_started then goto final_end;
+init_tab; {initialize the tables}
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;@/
+max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr; fix_date_and_time;
+end;
+tini@/
+@z
+
+@x
+end_of_MF: close_files_and_terminate;
+final_end: ready_already:=0;
+@y
+close_files_and_terminate;
+final_end: do_final_end;
+@z
+
+% [49.1205] close_files_and_terminate: Print new line before
+% termination; switch to editor if necessary.
+@x
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+@y
+ print_file_name(0,log_name,0); print_char(".");
+ end;
+ end;
+print_ln;
+if (edit_name_start<>0) and (interaction>batch_mode) then
+ call_edit(str_pool,edit_name_start,edit_name_length,edit_line);
+@z
+
+@x [49.1209] Only do dump if ini.
+ begin @!init store_base_file; return;@+tini@/
+@y
+ begin
+ @!init if ini_version then begin store_base_file; return;end;@+tini@/
+@z
+
+%@x [49.1211] l.23002 - Handle %&base line.
+%if (base_ident=0)or(buffer[loc]="&") then
+%@y
+%if (base_ident=0)or(buffer[loc]="&")or dump_line then
+%@z
+
+@x [51.1214] Add editor-switch variable to globals.
+This section should be replaced, if necessary, by any special
+modifications of the program
+that are necessary to make \MF\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Here are the variables used to hold ``switch-to-editor'' information.
+@^system dependencies@>
+
+@<Global...@>=
+@!edit_name_start: pool_pointer;
+@!edit_name_length,@!edit_line: integer;
+@!xprn: array[ASCII_code] of ASCII_code; {use \.{\^\^} notation?}
+@!stop_at_space: boolean; {whether |more_name| returns false for space}
+
+@ The |edit_name_start| will be set to point into |str_pool| somewhere after
+its beginning if \MF\ is supposed to switch to an editor on exit.
+
+@<Set init...@>=
+edit_name_start:=0;
+stop_at_space:=true;
+
+@ Dumping the |xord|, |xchr|, and |xprn| arrays. We dump these always
+in the format, so a TCX file loaded during format creation can set a
+default for users of the format.
+
+@<Dump |xord|, |xchr|, and |xprn|@>=
+dump_things(xord[0], 256);
+dump_things(xchr[0], 256);
+dump_things(xprn[0], 256);
+
+@ Undumping the |xord|, |xchr|, and |xprn| arrays. This code is more
+complicated, because we want to ensure that a TCX file specified on
+the command line will override whatever is in the format. Since the
+tcx file has already been loaded, that implies throwing away the data
+in the format. Also, if no |translate_filename| is given, but
+|eight_bit_p| is set we have to make all characters printable.
+
+@<Undump |xord|, |xchr|, and |xprn|@>=
+if translate_filename then begin
+ for k:=0 to 255 do undump_things(dummy_xord, 1);
+ for k:=0 to 255 do undump_things(dummy_xchr, 1);
+ for k:=0 to 255 do undump_things(dummy_xprn, 1);
+ end
+else begin
+ undump_things(xord[0], 256);
+ undump_things(xchr[0], 256);
+ undump_things(xprn[0], 256);
+ if eight_bit_p then
+ for k:=0 to 255 do
+ xprn[k]:=1;
+end;
+@z
diff --git a/Build/source/texk/web2c/mf.rc b/Build/source/texk/web2c/mf.rc
new file mode 100644
index 00000000000..4e5f0363293
--- /dev/null
+++ b/Build/source/texk/web2c/mf.rc
@@ -0,0 +1,37 @@
+/* mf.rc: mf resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " metafont 2.7182"
+
+#define VER_INTERNALNAME_STR TEXLIVE_LIBRARYPREFIX_STR "mf"
+#define VER_ORIGINALFILENAME_STR TEXLIVE_LIBRARYPREFIX_STR "mf.dll"
+
+#define VER_FILEDESCRIPTION_STR "METAFONT DLL"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1984 by D. E. Knuth"
+#define VER_LEGALTRADEMARKS_STR "METAFONT is a trademark of Addison-Wesley Publishing Company."
+
+#define VER_FILETYPE VFT_DLL
+
+#include <texlive.version>
+
+/* mf.rc ends here */
diff --git a/Build/source/texk/web2c/mf.tex b/Build/source/texk/web2c/mf.tex
new file mode 100644
index 00000000000..a1a8bda5e63
--- /dev/null
+++ b/Build/source/texk/web2c/mf.tex
@@ -0,0 +1,34385 @@
+\input webmac
+% This program is copyright (C) 1984 by D. E. Knuth; all rights are reserved.
+% Copying of this file is authorized only if (1) you are D. E. Knuth, or if
+% (2) you make absolutely no changes to your copy. (The WEB system provides
+% for alterations via an auxiliary file; the master file should stay intact.)
+% In other words, METAFONT is under essentially the same ground rules as TeX.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+
+% Version 0 was completed on July 28, 1984.
+% Version 1 was completed on January 4, 1986; it corresponds to "Volume D".
+% Version 1.1 trivially corrected the punctuation in one message (June 1986).
+% Version 1.2 corrected an arithmetic overflow problem (July 1986).
+% Version 1.3 improved rounding when elliptical pens are made (November 1986).
+% Version 1.4 corrected scan_declared_variable timing (May 1988).
+% Version 1.5 fixed negative halving in allocator when mem_min<0 (June 1988).
+% Version 1.6 kept open_log_file from calling fatal_error (November 1988).
+% Version 1.7 solved that problem a better way (December 1988).
+% Version 1.8 introduced major changes for 8-bit extensions (September 1989).
+% Version 1.9 improved skimping and was edited for style (December 1989).
+% Version 2.0 fixed bug in addto; released with TeX version 3.0 (March 1990).
+% Version 2.7 made consistent with TeX version 3.1 (September 1990).
+% Version 2.71 fixed bug in draw, allowed unprintable filenames (March 1992).
+% Version 2.718 fixed bug in <Choose a dependent...> (March 1995).
+% Version 2.7182 fixed bugs related to "<unprintable char>" (August 1996).
+% Version 2.71828 suppressed autorounding in dangerous cases (December 2002).
+
+% A reward of $327.68 will be paid to the first finder of any remaining bug.
+
+% Although considerable effort has been expended to make the METAFONT program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the author hopes that users enjoy it.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\def\ph{\hbox{Pascal-H}}
+\def\psqrt#1{\sqrt{\mathstrut#1}}
+\def\k{_{k+1}}
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\font\tenlogo=logo10 % font used for the METAFONT logo
+\font\logos=logosl10
+\font\eightlogo=logo8
+\def\MF{{\tenlogo META}\-{\tenlogo FONT}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+\let\swap=\leftrightarrow
+\def\round{\mathop{\rm round}\nolimits}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @:sort key}{entry@>
+
+\outer\def\N#1. \[#2]#3.{\MN#1.\vfil\eject % begin starred section
+ \def\rhead{PART #2:\uppercase{#3}} % define running headline
+ \message{*\modno} % progress report
+ \edef\next{\write\cont{\Z{\?#2]#3}{\modno}{\the\pageno}}}\next
+ \ifon\startsection{\bf\ignorespaces#3.\quad}\ignorespaces}
+\let\?=\relax % we want to be able to \write a \?
+
+\def\title{{\eightlogo METAFONT}}
+\def\topofcontents{\hsize 5.5in
+ \vglue -30pt plus 1fil minus 1.5in
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+\pageno=3
+\def\glob{13} % this should be the section number of "<Global...>"
+\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
+
+
+\N1. \[1] Introduction.
+This is \MF, a font compiler intended to produce typefaces of high quality.
+The \PASCAL\ program that follows is the definition of \MF84, a standard
+version of \MF\ that is designed to be highly portable so that identical output
+will be obtainable on a great variety of computers. The conventions
+of \MF84 are the same as those of \TeX82.
+
+The main purpose of the following program is to explain the algorithms of \MF\
+as clearly as possible. As a result, the program will not necessarily be very
+efficient when a particular \PASCAL\ compiler has translated it into a
+particular machine language. However, the program has been written so that it
+can be tuned to run efficiently in a wide variety of operating environments
+by making comparatively few changes. Such flexibility is possible because
+the documentation that follows is written in the \.{WEB} language, which is
+at a higher level than \PASCAL; the preprocessing step that converts \.{WEB}
+to \PASCAL\ is able to introduce most of the necessary refinements.
+Semi-automatic translation to other languages is also feasible, because the
+program below does not make extensive use of features that are peculiar to
+\PASCAL.
+
+A large piece of software like \MF\ has inherent complexity that cannot
+be reduced below a certain level of difficulty, although each individual
+part is fairly simple by itself. The \.{WEB} language is intended to make
+the algorithms as readable as possible, by reflecting the way the
+individual program pieces fit together and by providing the
+cross-references that connect different parts. Detailed comments about
+what is going on, and about why things were done in certain ways, have
+been liberally sprinkled throughout the program. These comments explain
+features of the implementation, but they rarely attempt to explain the
+\MF\ language itself, since the reader is supposed to be familiar with
+{\sl The {\logos METAFONT\/}book}.
+
+\fi
+
+\M2. The present implementation has a long ancestry, beginning in the spring
+of~1977, when its author wrote a prototype set of subroutines and macros
+that were used to develop the first Computer Modern fonts.
+This original proto-\MF\ required the user to recompile a {\mc SAIL} program
+whenever any character was changed, because it was not a ``language'' for
+font design; the language was {\mc SAIL}. After several hundred characters
+had been designed in that way, the author developed an interpretable language
+called \MF, in which it was possible to express the Computer Modern programs
+less cryptically. A complete \MF\ processor was designed and coded by the
+author in 1979. This program, written in {\mc SAIL}, was adapted for use
+with a variety of typesetting equipment and display terminals by Leo Guibas,
+Lyle Ramshaw, and David Fuchs.
+Major improvements to the design of Computer Modern fonts were made in the
+spring of 1982, after which it became clear that a new language would
+better express the needs of letterform designers. Therefore an entirely
+new \MF\ language and system were developed in 1984; the present system
+retains the name and some of the spirit of \MF79, but all of the details
+have changed.
+
+No doubt there still is plenty of room for improvement, but the author
+is firmly committed to keeping \MF84 ``frozen'' from now on; stability
+and reliability are to be its main virtues.
+
+On the other hand, the \.{WEB} description can be extended without changing
+the core of \MF84 itself, and the program has been designed so that such
+extensions are not extremely difficult to make.
+The \\{banner} string defined here should be changed whenever \MF\
+undergoes any modifications, so that it will be clear which version of
+\MF\ might be the guilty party when a problem arises.
+
+If this program is changed, the resulting system should not be called
+`\MF\kern.5pt'; the official name `\MF\kern.5pt' by itself is reserved
+for software systems that are fully compatible with each other.
+A special test suite called the ``\.{TRAP} test'' is available for
+helping to determine whether an implementation deserves to be
+known as `\MF\kern.5pt' [cf.~Stanford Computer Science report CS1095,
+January 1986].
+
+\Y\P\D \37$\\{banner}\S\.{\'This\ is\ METAFONT,\ Version\ 2.71828\'}$\C{printed
+when \MF\ starts}\par
+\fi
+
+\M3. Different \PASCAL s have slightly different conventions, and the present
+program expresses \MF\ in terms of the \PASCAL\ that was
+available to the author in 1984. Constructions that apply to
+this particular compiler, which we shall call \ph, should help the
+reader see how to make an appropriate interface for other systems
+if necessary. (\ph\ is Charles Hedrick's modification of a compiler
+for the DECsystem-10 that was originally developed at the University of
+Hamburg; cf.\ {\sl SOFTWARE---Practice \AM\ Experience \bf6} (1976),
+29--42. The \MF\ program below is intended to be adaptable, without
+extensive changes, to most other versions of \PASCAL, so it does not fully
+use the admirable features of \ph. Indeed, a conscious effort has been
+made here to avoid using several idiosyncratic features of standard
+\PASCAL\ itself, so that most of the code can be translated mechanically
+into other high-level languages. For example, the `\&{with}' and `\\{new}'
+features are not used, nor are pointer types, set types, or enumerated
+scalar types; there are no `\&{var}' parameters, except in the case of files
+or in the system-dependent \\{paint\_row} procedure;
+there are no tag fields on variant records; there are no \\{real} variables;
+no procedures are declared local to other procedures.)
+
+The portions of this program that involve system-dependent code, where
+changes might be necessary because of differences between \PASCAL\ compilers
+and/or differences between
+operating systems, can be identified by looking at the sections whose
+numbers are listed under `system dependencies' in the index. Furthermore,
+the index entries for `dirty \PASCAL' list all places where the restrictions
+of \PASCAL\ have not been followed perfectly, for one reason or another.
+
+\fi
+
+\M4. The program begins with a normal \PASCAL\ program heading, whose
+components will be filled in later, using the conventions of \.{WEB}.
+For example, the portion of the program called `\X\glob:Global
+variables\X' below will be replaced by a sequence of variable declarations
+that starts in $\section\glob$ of this documentation. In this way, we are able
+to define each individual global variable when we are prepared to
+understand what it means; we do not have to define all of the globals at
+once. Cross references in $\section\glob$, where it says ``See also
+sections \gglob, \dots,'' also make it possible to look at the set of
+all global variables, if desired. Similar remarks apply to the other
+portions of the program heading.
+
+Actually the heading shown here is not quite normal: The \&{program}\ line
+does not mention any \\{output} file, because \ph\ would ask the \MF\ user
+to specify a file name if \\{output} were specified here.
+
+\Y\P\D \37$\\{mtype}\S\|t\J\|y\J\|p\J\|e$\C{this is a \.{WEB} coding trick:}\par
+\P\F \37$\\{mtype}\S\\{type}$\C{`\&{mtype}' will be equivalent to `\&{type}'}%
+\par
+\P\F \37$\\{type}\S\\{true}$\C{but `\\{type}' will not be treated as a reserved
+word}\par
+\Y\P\hbox{\4}\X9:Compiler directives\X\6
+\4\&{program}\1\ \37\\{MF};\C{all file names are defined dynamically}\6
+\4\&{label} \37\X6:Labels in the outer block\X\6
+\4\&{const} \37\X11:Constants in the outer block\X\6
+\4\&{mtype} \37\X18:Types in the outer block\X\6
+\4\&{var} \37\X13:Global variables\X\7
+\4\&{procedure}\1\ \37\\{initialize};\C{this procedure gets things started
+properly}\6
+\4\&{var} \37\X19:Local variables for initialization\X\2\6
+\&{begin} \37\X21:Set initial values of key variables\X\6
+\&{end};\7
+\hbox{\4}\X57:Basic printing procedures\X\6
+\hbox{\4}\X73:Error handling procedures\X\par
+\fi
+
+\M5. The overall \MF\ program begins with the heading just shown, after which
+comes a bunch of procedure declarations and function declarations.
+Finally we will get to the main program, which begins with the
+comment `\\{start\_here}'. If you want to skip down to the
+main program now, you can look up `\\{start\_here}' in the index.
+But the author suggests that the best way to understand this program
+is to follow pretty much the order of \MF's components as they appear in the
+\.{WEB} description you are now reading, since the present ordering is
+intended to combine the advantages of the ``bottom up'' and ``top down''
+approaches to the problem of understanding a somewhat complicated system.
+
+\fi
+
+\M6. Three labels must be declared in the main program, so we give them
+symbolic names.
+
+\Y\P\D \37$\\{start\_of\_MF}=1$\C{go here when \MF's variables are initialized}%
+\par
+\P\D \37$\\{end\_of\_MF}=9998$\C{go here to close files and terminate
+gracefully}\par
+\P\D \37$\\{final\_end}=9999$\C{this label marks the ending of the program}\par
+\Y\P$\4\X6:Labels in the outer block\X\S$\6
+$\\{start\_of\_MF}\hbox{\hskip-2pt},\39\\{end\_of\_MF}\hbox{\hskip-2pt},\39\,%
+\\{final\_end}$;\C{key control points}\par
+\U4.\fi
+
+\M7. Some of the code below is intended to be used only when diagnosing the
+strange behavior that sometimes occurs when \MF\ is being installed or
+when system wizards are fooling around with \MF\ without quite knowing
+what they are doing. Such code will not normally be compiled; it is
+delimited by the codewords `$ \&{debug} \ldots \&{gubed} $', with apologies
+to people who wish to preserve the purity of English.
+
+Similarly, there is some conditional code delimited by
+`$ \&{stat} \ldots \&{tats} $' that is intended for use when statistics are to
+be
+kept about \MF's memory usage. The \&{stat} $\ldots$ \&{tats} code also
+implements special diagnostic information that is printed when
+$\\{tracingedges}>1$.
+
+\Y\P\D \37$\\{debug}\S\B$\C{change this to `$\\{debug}\equiv\null$' when
+debugging}\par
+\P\D \37$\\{gubed}\S\hbox{}\T$\C{change this to `$\\{gubed}\equiv\null$' when
+debugging}\par
+\P\F \37$\\{debug}\S\\{begin}$\par
+\P\F \37$\\{gubed}\S\\{end}$\Y\par
+\P\D \37$\\{stat}\S\B$\C{change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}\par
+\P\D \37$\\{tats}\S\hbox{}\T$\C{change this to `$\\{tats}\equiv\null$' when
+gathering usage statistics}\par
+\P\F \37$\\{stat}\S\\{begin}$\par
+\P\F \37$\\{tats}\S\\{end}$\par
+\fi
+
+\M8. This program has two important variations: (1) There is a long and slow
+version called \.{INIMF}, which does the extra calculations needed to
+initialize \MF's internal tables; and (2)~there is a shorter and faster
+production version, which cuts the initialization to a bare minimum.
+Parts of the program that are needed in (1) but not in (2) are delimited by
+the codewords `$ \&{init} \ldots \&{tini} $'.
+
+\Y\P\D \37$\\{init}\S$\C{change this to `$\\{init}\equiv\.{@\{}$' in the
+production version}\par
+\P\D \37$\\{tini}\S$\C{change this to `$\\{tini}\equiv\.{@\}}$' in the
+production version}\par
+\P\F \37$\\{init}\S\\{begin}$\par
+\P\F \37$\\{tini}\S\\{end}$\par
+\fi
+
+\M9. If the first character of a \PASCAL\ comment is a dollar sign,
+\ph\ treats the comment as a list of ``compiler directives'' that will
+affect the translation of this program into machine language. The
+directives shown below specify full checking and inclusion of the \PASCAL\
+debugger when \MF\ is being debugged, but they cause range checking and other
+redundant code to be eliminated when the production system is being generated.
+Arithmetic overflow will be detected in all cases.
+
+\Y\P$\4\X9:Compiler directives\X\S$\6
+$\B\J\$\|C-,\39\|A+,\39\|D-\T$\C{no range check, catch arithmetic overflow, no
+debug overhead}\6
+\&{debug} \37$\B\J\$\|C+,\39\|D+\T$\ \&{gubed}\C{but turn everything on when
+debugging}\par
+\U4.\fi
+
+\M10. This \MF\ implementation conforms to the rules of the {\sl Pascal User
+Manual} published by Jensen and Wirth in 1975, except where system-dependent
+code is necessary to make a useful system program, and except in another
+respect where such conformity would unnecessarily obscure the meaning
+and clutter up the code: We assume that \&{case} statements may include a
+default case that applies if no matching label is found. Thus, we shall use
+constructions like
+$$\vbox{\halign{\ignorespaces#\hfil\cr
+ \&{case} $\|x$ \&{of}\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+ \&{othercases} $\langle\,$code for $\|x\I1$ and $\|x\I3$$\,\rangle$\cr
+ \&{endcases} \cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the \ph\
+compiler allows `\\{others}:' as a default label, and other \PASCAL s allow
+syntaxes like `\&{else}' or `\&{otherwise}' or `\\{otherwise}:', etc. The
+definitions of \&{othercases} and \&{endcases} should be changed to agree
+with
+local conventions. Note that no semicolon appears before \&{endcases} in
+this program, so the definition of \&{endcases} should include a semicolon
+if the compiler wants one. (Of course, if no default mechanism is
+available, the \&{case} statements of \MF\ will have to be laboriously
+extended by listing all remaining cases. People who are stuck with such
+\PASCAL s have, in fact, done this, successfully but not happily!)
+
+\Y\P\D \37$\\{othercases}\S\\{others}$: \37\C{default for cases not listed
+explicitly}\par
+\P\D \37$\\{endcases}\S$\ \&{end} \C{follows the default case in an extended %
+\&{case} statement}\par
+\P\F \37$\\{othercases}\S\\{else}$\par
+\P\F \37$\\{endcases}\S\\{end}$\par
+\fi
+
+\M11. The following parameters can be changed at compile time to extend or
+reduce \MF's capacity. They may have different values in \.{INIMF} and
+in production versions of \MF.
+
+\Y\P$\4\X11:Constants in the outer block\X\S$\6
+$\\{mem\_max}=30000$;\C{greatest index in \MF's internal \\{mem} array; must
+be strictly less than \\{max\_halfword}; must be equal to \\{mem\_top} in %
+\.{INIMF}, otherwise $\G\\{mem\_top}$}\6
+$\\{max\_internal}=100$;\C{maximum number of internal quantities}\6
+$\\{buf\_size}=500$;\C{maximum number of characters simultaneously present in
+current lines of open files; must not exceed \\{max\_halfword}}\6
+$\\{error\_line}=72$;\C{width of context lines on terminal error messages}\6
+$\\{half\_error\_line}=42$;\C{width of first lines of contexts in terminal
+error messages; should be between 30 and $\\{error\_line}-15$}\6
+$\\{max\_print\_line}=79$;\C{width of longest text lines output; should be at
+least 60}\6
+$\\{screen\_width}=768$;\C{number of pixels in each row of screen display}\6
+$\\{screen\_depth}=1024$;\C{number of pixels in each column of screen display}\6
+$\\{stack\_size}=30$;\C{maximum number of simultaneous input sources}\6
+$\\{max\_strings}=2000$;\C{maximum number of strings; must not exceed \\{max%
+\_halfword}}\6
+$\\{string\_vacancies}=8000$;\C{the minimum number of characters that should be
+ available for the user's identifier names and strings, after \MF's own
+error messages are stored}\6
+$\\{pool\_size}=32000$;\C{maximum number of characters in strings, including
+all error messages and help texts, and the names of all identifiers; must
+exceed \\{string\_vacancies} by the total length of \MF's own strings, which
+is currently about 22000}\6
+$\\{move\_size}=5000$;\C{space for storing moves in a single octant}\6
+$\\{max\_wiggle}=300$;\C{number of autorounded points per cycle}\6
+$\\{gf\_buf\_size}=800$;\C{size of the output buffer, must be a multiple of 8}\6
+$\\{file\_name\_size}=40$;\C{file names shouldn't be longer than this}\6
+$\\{pool\_name}=\.{\'MFbases:MF.POOL\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \
+\ \ \ \'}$;\C{string of length \\{file\_name\_size}; tells where the string
+pool appears}\6
+$\\{path\_size}=300$;\C{maximum number of knots between breakpoints of a path}\6
+$\\{bistack\_size}=785$;\C{size of stack for bisection algorithms; should
+probably be left at this value}\6
+$\\{header\_size}=100$;\C{maximum number of \.{TFM} header words, times~4}\6
+$\\{lig\_table\_size}=5000$;\C{maximum number of ligature/kern steps, must be
+at least 255 and at most 32510}\6
+$\\{max\_kerns}=500$;\C{maximum number of distinct kern amounts}\6
+$\\{max\_font\_dimen}=50$;\C{maximum number of \&{fontdimen} parameters}\par
+\U4.\fi
+
+\M12. Like the preceding parameters, the following quantities can be changed
+at compile time to extend or reduce \MF's capacity. But if they are changed,
+it is necessary to rerun the initialization program \.{INIMF}
+to generate new tables for the production \MF\ program.
+One can't simply make helter-skelter changes to the following constants,
+since certain rather complex initialization
+numbers are computed from them. They are defined here using
+\.{WEB} macros, instead of being put into \PASCAL's \&{const} list, in order
+to
+emphasize this distinction.
+
+\Y\P\D \37$\\{mem\_min}=0$\C{smallest index in the \\{mem} array, must not be
+less than \\{min\_halfword}}\par
+\P\D \37$\\{mem\_top}\S30000$\C{largest index in the \\{mem} array dumped by %
+\.{INIMF}; must be substantially larger than \\{mem\_min} and not greater
+than \\{mem\_max}}\par
+\P\D \37$\\{hash\_size}=2100$\C{maximum number of symbolic tokens, must be
+less than $\\{max\_halfword}-3\ast\\{param\_size}$}\par
+\P\D \37$\\{hash\_prime}=1777$\C{a prime number equal to about 85\pct! of %
+\\{hash\_size}}\par
+\P\D \37$\\{max\_in\_open}=6$\C{maximum number of input files and error
+insertions that can be going on simultaneously}\par
+\P\D \37$\\{param\_size}=150$\C{maximum number of simultaneous macro
+parameters}\par
+\fi
+
+\M13. In case somebody has inadvertently made bad settings of the
+``constants,''
+\MF\ checks them using a global variable called \\{bad}.
+
+This is the first of many sections of \MF\ where global variables are
+defined.
+
+\Y\P$\4\X13:Global variables\X\S$\6
+\4\\{bad}: \37\\{integer};\C{is some ``constant'' wrong?}\par
+\As20, 25, 29, 31, 38, 42, 50, 54, 68, 71, 74, 91, 97, 129, 137, 144, 148, 159,
+160, 161, 166, 178, 190, 196, 198, 200, 201, 225, 230, 250, 267, 279, 283, 298,
+308, 309, 327, 371, 379, 389, 395, 403, 427, 430, 448, 455, 461, 464, 507, 552,
+555, 557, 566, 569, 572, 579, 585, 592, 624, 628, 631, 633, 634, 659, 680, 699,
+738, 752, 767, 768, 775, 782, 785, 791, 796, 813, 821, 954, 1077, 1084, 1087,
+1096, 1119, 1125, 1130, 1149, 1152, 1162, 1183, 1188\ETs1203.
+\U4.\fi
+
+\M14. Later on we will say `\ignorespaces \&{if} $\\{mem\_max}\G\\{max%
+\_halfword}$ \&{then} $\\{bad}\K10$',
+or something similar. (We can't do that until \\{max\_halfword} has been
+defined.)
+
+\Y\P$\4\X14:Check the ``constant'' values for consistency\X\S$\6
+$\\{bad}\K0$;\6
+\&{if} $(\\{half\_error\_line}<30)\V(\\{half\_error\_line}>\\{error\_line}-15)$
+\1\&{then}\5
+$\\{bad}\K1$;\2\6
+\&{if} $\\{max\_print\_line}<60$ \1\&{then}\5
+$\\{bad}\K2$;\2\6
+\&{if} $\\{gf\_buf\_size}\mathbin{\&{mod}}8\I0$ \1\&{then}\5
+$\\{bad}\K3$;\2\6
+\&{if} $\\{mem\_min}+1100>\\{mem\_top}$ \1\&{then}\5
+$\\{bad}\K4$;\2\6
+\&{if} $\\{hash\_prime}>\\{hash\_size}$ \1\&{then}\5
+$\\{bad}\K5$;\2\6
+\&{if} $\\{header\_size}\mathbin{\&{mod}}4\I0$ \1\&{then}\5
+$\\{bad}\K6$;\2\6
+\&{if} $(\\{lig\_table\_size}<255)\V(\\{lig\_table\_size}>32510)$ \1\&{then}\5
+$\\{bad}\K7$;\2\par
+\As154, 204, 214, 310, 553\ETs777.
+\U1204.\fi
+
+\M15. Labels are given symbolic names by the following definitions, so that
+occasional \&{goto} statements will be meaningful. We insert the label
+`\\{exit}' just before the `\ignorespaces \&{end} \unskip' of a procedure in
+which we have used the `\&{return}' statement defined below; the label
+`\\{restart}' is occasionally used at the very beginning of a procedure; and
+the label `\\{reswitch}' is occasionally used just prior to a \&{case}
+statement in which some cases change the conditions and we wish to branch
+to the newly applicable case. Loops that are set up with the \~ \&{loop}
+construction defined below are commonly exited by going to `\\{done}' or to
+`\\{found}' or to `\\{not\_found}', and they are sometimes repeated by going to
+`\\{continue}'. If two or more parts of a subroutine start differently but
+end up the same, the shared code may be gathered together at
+`\\{common\_ending}'.
+
+Incidentally, this program never declares a label that isn't actually used,
+because some fussy \PASCAL\ compilers will complain about redundant labels.
+
+\Y\P\D \37$\\{exit}=10$\C{go here to leave a procedure}\par
+\P\D \37$\\{restart}=20$\C{go here to start a procedure again}\par
+\P\D \37$\\{reswitch}=21$\C{go here to start a case statement again}\par
+\P\D \37$\\{continue}=22$\C{go here to resume a loop}\par
+\P\D \37$\\{done}=30$\C{go here to exit a loop}\par
+\P\D \37$\\{done1}=31$\C{like \\{done}, when there is more than one loop}\par
+\P\D \37$\\{done2}=32$\C{for exiting the second loop in a long block}\par
+\P\D \37$\\{done3}=33$\C{for exiting the third loop in a very long block}\par
+\P\D \37$\\{done4}=34$\C{for exiting the fourth loop in an extremely long
+block}\par
+\P\D \37$\\{done5}=35$\C{for exiting the fifth loop in an immense block}\par
+\P\D \37$\\{done6}=36$\C{for exiting the sixth loop in a block}\par
+\P\D \37$\\{found}=40$\C{go here when you've found it}\par
+\P\D \37$\\{found1}=41$\C{like \\{found}, when there's more than one per
+routine}\par
+\P\D \37$\\{found2}=42$\C{like \\{found}, when there's more than two per
+routine}\par
+\P\D \37$\\{not\_found}=45$\C{go here when you've found nothing}\par
+\P\D \37$\\{common\_ending}=50$\C{go here when you want to merge with another
+branch}\par
+\fi
+
+\M16. Here are some macros for common programming idioms.
+
+\Y\P\D \37$\\{incr}(\#)\S\#\K\#+1$\C{increase a variable by unity}\par
+\P\D \37$\\{decr}(\#)\S\#\K\#-1$\C{decrease a variable by unity}\par
+\P\D \37$\\{negate}(\#)\S\#\K-\#$\C{change the sign of a variable}\par
+\P\D \37$\\{double}(\#)\S\#\K\#+\#$\C{multiply a variable by two}\par
+\P\D \37$\\{loop}\S$\ \&{while} $\\{true}$ \1\&{do}\ \C{repeat over and over
+until a \&{goto} happens}\par
+\P\F \37$\\{loop}\S\\{xclause}$\C{\.{WEB}'s \~ \&{xclause} acts like `%
+\ignorespaces \&{while} $\\{true}$ \&{do}\unskip'}\par
+\P\D \37$\\{do\_nothing}\S$\C{empty statement}\par
+\P\D \37$\\{return}\S$\1\5
+\&{goto} \37\\{exit}\C{terminate a procedure call}\2\par
+\P\F \37$\\{return}\S\\{nil}$\C{\.{WEB} will henceforth say \&{return} instead
+of \\{return}}\par
+\fi
+
+\N17. \[2] The character set.
+In order to make \MF\ readily portable to a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+code that includes standard ASCII, the ``American Standard Code for
+Information Interchange.'' This conversion is done immediately when each
+character is read in. Conversely, characters are converted from ASCII to
+the user's external representation just before they are output to a
+text file.
+
+Such an internal code is relevant to users of \MF\ only with respect to
+the \&{char} and \&{ASCII} operations, and the comparison of strings.
+
+\fi
+
+\M18. Characters of text that have been converted to \MF's internal form
+are said to be of type \\{ASCII\_code}, which is a subrange of the integers.
+
+\Y\P$\4\X18:Types in the outer block\X\S$\6
+$\\{ASCII\_code}=0\to255$;\C{eight-bit numbers}\par
+\As24, 37, 101, 105, 106, 156, 186, 565, 571, 627\ETs1151.
+\U4.\fi
+
+\M19. The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, especially in a program for font design;
+so the present specification of \MF\ has been written under the assumption
+that the \PASCAL\ compiler and run-time system permit the use of text files
+with more than 64 distinguishable characters. More precisely, we assume that
+the character set contains at least the letters and symbols associated
+with ASCII codes \O{40} through \O{176}; all of these characters are now
+available on most computer terminals.
+
+Since we are dealing with more characters than were present in the first
+\PASCAL\ compilers, we have to decide what to call the associated data
+type. Some \PASCAL s use the original name \\{char} for the
+characters in text files, even though there now are more than 64 such
+characters, while other \PASCAL s consider \\{char} to be a 64-element
+subrange of a larger data type that has some other name.
+
+In order to accommodate this difference, we shall use the name \\{text\_char}
+to stand for the data type of the characters that are converted to and
+from \\{ASCII\_code} when they are input and output. We shall also assume
+that \\{text\_char} consists of the elements $\\{chr}(\\{first\_text\_char})$
+through
+$\\{chr}(\\{last\_text\_char})$, inclusive. The following definitions should be
+adjusted if necessary.
+
+\Y\P\D \37$\\{text\_char}\S\\{char}$\C{the data type of characters in text
+files}\par
+\P\D \37$\\{first\_text\_char}=0$\C{ordinal number of the smallest element of %
+\\{text\_char}}\par
+\P\D \37$\\{last\_text\_char}=255$\C{ordinal number of the largest element of %
+\\{text\_char}}\par
+\Y\P$\4\X19:Local variables for initialization\X\S$\6
+\4\|i: \37\\{integer};\par
+\A130.
+\U4.\fi
+
+\M20. The \MF\ processor converts between ASCII code and
+the user's external character set by means of arrays \\{xord} and \\{xchr}
+that are analogous to \PASCAL's \\{ord} and \\{chr} functions.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{xord}: \37\&{array} $[\\{text\_char}]$ \1\&{of}\5
+\\{ASCII\_code};\C{specifies conversion of input characters}\2\6
+\4\\{xchr}: \37\&{array} $[\\{ASCII\_code}]$ \1\&{of}\5
+\\{text\_char};\C{specifies conversion of output characters}\2\par
+\fi
+
+\M21. Since we are assuming that our \PASCAL\ system is able to read and
+write the visible characters of standard ASCII (although not
+necessarily using the ASCII codes to represent them), the following
+assignment statements initialize the standard part of the \\{xchr} array
+properly, without needing any system-dependent changes. On the other
+hand, it is possible to implement \MF\ with less complete character
+sets, and in such cases it will be necessary to change something here.
+
+\Y\P$\4\X21:Set initial values of key variables\X\S$\6
+$\\{xchr}[\O{40}]\K\.{\'\ \'}$;\5
+$\\{xchr}[\O{41}]\K\.{\'!\'}$;\5
+$\\{xchr}[\O{42}]\K\.{\'"\'}$;\5
+$\\{xchr}[\O{43}]\K\.{\'\#\'}$;\5
+$\\{xchr}[\O{44}]\K\.{\'\$\'}$;\5
+$\\{xchr}[\O{45}]\K\.{\'\%\'}$;\5
+$\\{xchr}[\O{46}]\K\.{\'\&\'}$;\5
+$\\{xchr}[\O{47}]\K\.{\'\'}\.{\'\'}$;\6
+$\\{xchr}[\O{50}]\K\.{\'(\'}$;\5
+$\\{xchr}[\O{51}]\K\.{\')\'}$;\5
+$\\{xchr}[\O{52}]\K\.{\'*\'}$;\5
+$\\{xchr}[\O{53}]\K\.{\'+\'}$;\5
+$\\{xchr}[\O{54}]\K\.{\',\'}$;\5
+$\\{xchr}[\O{55}]\K\.{\'-\'}$;\5
+$\\{xchr}[\O{56}]\K\.{\'.\'}$;\5
+$\\{xchr}[\O{57}]\K\.{\'/\'}$;\6
+$\\{xchr}[\O{60}]\K\.{\'0\'}$;\5
+$\\{xchr}[\O{61}]\K\.{\'1\'}$;\5
+$\\{xchr}[\O{62}]\K\.{\'2\'}$;\5
+$\\{xchr}[\O{63}]\K\.{\'3\'}$;\5
+$\\{xchr}[\O{64}]\K\.{\'4\'}$;\5
+$\\{xchr}[\O{65}]\K\.{\'5\'}$;\5
+$\\{xchr}[\O{66}]\K\.{\'6\'}$;\5
+$\\{xchr}[\O{67}]\K\.{\'7\'}$;\6
+$\\{xchr}[\O{70}]\K\.{\'8\'}$;\5
+$\\{xchr}[\O{71}]\K\.{\'9\'}$;\5
+$\\{xchr}[\O{72}]\K\.{\':\'}$;\5
+$\\{xchr}[\O{73}]\K\.{\';\'}$;\5
+$\\{xchr}[\O{74}]\K\.{\'<\'}$;\5
+$\\{xchr}[\O{75}]\K\.{\'=\'}$;\5
+$\\{xchr}[\O{76}]\K\.{\'>\'}$;\5
+$\\{xchr}[\O{77}]\K\.{\'?\'}$;\6
+$\\{xchr}[\O{100}]\K\.{\'@\'}$;\5
+$\\{xchr}[\O{101}]\K\.{\'A\'}$;\5
+$\\{xchr}[\O{102}]\K\.{\'B\'}$;\5
+$\\{xchr}[\O{103}]\K\.{\'C\'}$;\5
+$\\{xchr}[\O{104}]\K\.{\'D\'}$;\5
+$\\{xchr}[\O{105}]\K\.{\'E\'}$;\5
+$\\{xchr}[\O{106}]\K\.{\'F\'}$;\5
+$\\{xchr}[\O{107}]\K\.{\'G\'}$;\6
+$\\{xchr}[\O{110}]\K\.{\'H\'}$;\5
+$\\{xchr}[\O{111}]\K\.{\'I\'}$;\5
+$\\{xchr}[\O{112}]\K\.{\'J\'}$;\5
+$\\{xchr}[\O{113}]\K\.{\'K\'}$;\5
+$\\{xchr}[\O{114}]\K\.{\'L\'}$;\5
+$\\{xchr}[\O{115}]\K\.{\'M\'}$;\5
+$\\{xchr}[\O{116}]\K\.{\'N\'}$;\5
+$\\{xchr}[\O{117}]\K\.{\'O\'}$;\6
+$\\{xchr}[\O{120}]\K\.{\'P\'}$;\5
+$\\{xchr}[\O{121}]\K\.{\'Q\'}$;\5
+$\\{xchr}[\O{122}]\K\.{\'R\'}$;\5
+$\\{xchr}[\O{123}]\K\.{\'S\'}$;\5
+$\\{xchr}[\O{124}]\K\.{\'T\'}$;\5
+$\\{xchr}[\O{125}]\K\.{\'U\'}$;\5
+$\\{xchr}[\O{126}]\K\.{\'V\'}$;\5
+$\\{xchr}[\O{127}]\K\.{\'W\'}$;\6
+$\\{xchr}[\O{130}]\K\.{\'X\'}$;\5
+$\\{xchr}[\O{131}]\K\.{\'Y\'}$;\5
+$\\{xchr}[\O{132}]\K\.{\'Z\'}$;\5
+$\\{xchr}[\O{133}]\K\.{\'[\'}$;\5
+$\\{xchr}[\O{134}]\K\.{\'\\\'}$;\5
+$\\{xchr}[\O{135}]\K\.{\']\'}$;\5
+$\\{xchr}[\O{136}]\K\.{\'\^\'}$;\5
+$\\{xchr}[\O{137}]\K\.{\'\_\'}$;\6
+$\\{xchr}[\O{140}]\K\.{\'\`\'}$;\5
+$\\{xchr}[\O{141}]\K\.{\'a\'}$;\5
+$\\{xchr}[\O{142}]\K\.{\'b\'}$;\5
+$\\{xchr}[\O{143}]\K\.{\'c\'}$;\5
+$\\{xchr}[\O{144}]\K\.{\'d\'}$;\5
+$\\{xchr}[\O{145}]\K\.{\'e\'}$;\5
+$\\{xchr}[\O{146}]\K\.{\'f\'}$;\5
+$\\{xchr}[\O{147}]\K\.{\'g\'}$;\6
+$\\{xchr}[\O{150}]\K\.{\'h\'}$;\5
+$\\{xchr}[\O{151}]\K\.{\'i\'}$;\5
+$\\{xchr}[\O{152}]\K\.{\'j\'}$;\5
+$\\{xchr}[\O{153}]\K\.{\'k\'}$;\5
+$\\{xchr}[\O{154}]\K\.{\'l\'}$;\5
+$\\{xchr}[\O{155}]\K\.{\'m\'}$;\5
+$\\{xchr}[\O{156}]\K\.{\'n\'}$;\5
+$\\{xchr}[\O{157}]\K\.{\'o\'}$;\6
+$\\{xchr}[\O{160}]\K\.{\'p\'}$;\5
+$\\{xchr}[\O{161}]\K\.{\'q\'}$;\5
+$\\{xchr}[\O{162}]\K\.{\'r\'}$;\5
+$\\{xchr}[\O{163}]\K\.{\'s\'}$;\5
+$\\{xchr}[\O{164}]\K\.{\'t\'}$;\5
+$\\{xchr}[\O{165}]\K\.{\'u\'}$;\5
+$\\{xchr}[\O{166}]\K\.{\'v\'}$;\5
+$\\{xchr}[\O{167}]\K\.{\'w\'}$;\6
+$\\{xchr}[\O{170}]\K\.{\'x\'}$;\5
+$\\{xchr}[\O{171}]\K\.{\'y\'}$;\5
+$\\{xchr}[\O{172}]\K\.{\'z\'}$;\5
+$\\{xchr}[\O{173}]\K\.{\'\{\'}$;\5
+$\\{xchr}[\O{174}]\K\.{\'|\'}$;\5
+$\\{xchr}[\O{175}]\K\.{\'\}\'}$;\5
+$\\{xchr}[\O{176}]\K\.{\'\~\'}$;\par
+\As22, 23, 69, 72, 75, 92, 98, 131, 138, 179, 191, 199, 202, 231, 251, 396,
+428, 449, 456, 462, 570, 573, 593, 739, 753, 776, 797, 822, 1078, 1085, 1097,
+1150, 1153\ETs1184.
+\U4.\fi
+
+\M22. The ASCII code is ``standard'' only to a certain extent, since many
+computer installations have found it advantageous to have ready access
+to more than 94 printing characters. If \MF\ is being used
+on a garden-variety \PASCAL\ for which only standard ASCII
+codes will appear in the input and output files, it doesn't really matter
+what codes are specified in $\\{xchr}[0\to\O{37}]$, but the safest policy is to
+blank everything out by using the code shown below.
+
+However, other settings of \\{xchr} will make \MF\ more friendly on
+computers that have an extended character set, so that users can type things
+like `\.^^Z' instead of `\.{<>}'.
+People with extended character sets can
+assign codes arbitrarily, giving an \\{xchr} equivalent to whatever
+characters the users of \MF\ are allowed to have in their input files.
+Appropriate changes to \MF's \\{char\_class} table should then be made.
+(Unlike \TeX, each installation of \MF\ has a fixed assignment of category
+codes, called the \\{char\_class}.) Such changes make portability of programs
+more difficult, so they should be introduced cautiously if at all.
+
+\Y\P$\4\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+\&{for} $\|i\K0\mathrel{\&{to}}\O{37}$ \1\&{do}\5
+$\\{xchr}[\|i]\K\.{\'\ \'}$;\2\6
+\&{for} $\|i\K\O{177}\mathrel{\&{to}}\O{377}$ \1\&{do}\5
+$\\{xchr}[\|i]\K\.{\'\ \'}$;\2\par
+\fi
+
+\M23. The following system-independent code makes the \\{xord} array contain a
+suitable inverse to the information in \\{xchr}. Note that if $\\{xchr}[\|i]=%
+\\{xchr}[\|j]$
+where $\|i<\|j<\O{177}$, the value of $\\{xord}[\\{xchr}[\|i]]$ will turn out
+to be
+\|j or more; hence, standard ASCII code numbers will be used instead of
+codes below \O{40} in case there is a coincidence.
+
+\Y\P$\4\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+\&{for} $\|i\K\\{first\_text\_char}\mathrel{\&{to}}\\{last\_text\_char}$ \1%
+\&{do}\5
+$\\{xord}[\\{chr}(\|i)]\K\O{177}$;\2\6
+\&{for} $\|i\K\O{200}\mathrel{\&{to}}\O{377}$ \1\&{do}\5
+$\\{xord}[\\{xchr}[\|i]]\K\|i$;\2\6
+\&{for} $\|i\K0\mathrel{\&{to}}\O{176}$ \1\&{do}\5
+$\\{xord}[\\{xchr}[\|i]]\K\|i$;\2\par
+\fi
+
+\N24. \[3] Input and output.
+The bane of portability is the fact that different operating systems treat
+input and output quite differently, perhaps because computer scientists
+have not given sufficient attention to this problem. People have felt somehow
+that input and output are not part of ``real'' programming. Well, it is true
+that some kinds of programming are more fun than others. With existing
+input/output conventions being so diverse and so messy, the only sources of
+joy in such parts of the code are the rare occasions when one can find a
+way to make the program a little less bad than it might have been. We have
+two choices, either to attack I/O now and get it over with, or to postpone
+I/O until near the end. Neither prospect is very attractive, so let's
+get it over with.
+
+The basic operations we need to do are (1)~inputting and outputting of
+text, to or from a file or the user's terminal; (2)~inputting and
+outputting of eight-bit bytes, to or from a file; (3)~instructing the
+operating system to initiate (``open'') or to terminate (``close'') input or
+output from a specified file; (4)~testing whether the end of an input
+file has been reached; (5)~display of bits on the user's screen.
+The bit-display operation will be discussed in a later section; we shall
+deal here only with more traditional kinds of I/O.
+
+\MF\ needs to deal with two kinds of files.
+We shall use the term \\{alpha\_file} for a file that contains textual data,
+and the term \\{byte\_file} for a file that contains eight-bit binary
+information.
+These two types turn out to be the same on many computers, but
+sometimes there is a significant distinction, so we shall be careful to
+distinguish between them. Standard protocols for transferring
+such files from computer to computer, via high-speed networks, are
+now becoming available to more and more communities of users.
+
+The program actually makes use also of a third kind of file, called a
+\\{word\_file}, when dumping and reloading base information for its own
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{eight\_bits}=0\to255$;\C{unsigned one-byte quantity}\6
+$\\{alpha\_file}=$\1\5
+\&{packed} \37\&{file} \1\&{of}\5
+\\{text\_char};\C{files that contain textual data}\2\2\6
+$\\{byte\_file}=$\1\5
+\&{packed} \37\&{file} \1\&{of}\5
+\\{eight\_bits};\C{files that contain binary data}\2\2\par
+\fi
+
+\M25. Most of what we need to do with respect to input and output can be
+handled
+by the I/O facilities that are standard in \PASCAL, i.e., the routines
+called \\{get}, \\{put}, \\{eof}, and so on. But
+standard \PASCAL\ does not allow file variables to be associated with file
+names that are determined at run time, so it cannot be used to implement
+\MF; some sort of extension to \PASCAL's ordinary \\{reset} and \\{rewrite}
+is crucial for our purposes. We shall assume that \\{name\_of\_file} is a
+variable
+of an appropriate type such that the \PASCAL\ run-time system being used to
+implement \MF\ can open a file whose external name is specified by
+\\{name\_of\_file}.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{name\_of\_file}: \37\&{packed} \37\&{array} $[1\to\\{file\_name\_size}]$ %
+\1\&{of}\5
+\\{char};\2\6
+\C{on some systems this may be a \&{record} variable}\6
+\4\\{name\_length}: \37$0\to\\{file\_name\_size}$;\6
+\C{this many characters are actually relevant in \\{name\_of\_file} (the rest
+are blank)}\par
+\fi
+
+\M26. The \ph\ compiler with which the present version of \MF\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~\|f,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+$\\{reset}(\|f,\hbox{\\{name}},\.{\'/O\'})$&for input;\cr
+$\\{rewrite}(\|f,\hbox{\\{name}},\.{\'/O\'})$&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `\ignorespaces\&{packed} \&{array}
+$[\hbox{\<\\{any}>}]$ \&{of} \\{text\_char}', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+$\\{erstat}(\|f)\I0$ after an unsuccessful \\{reset} or \\{rewrite}. This
+allows
+\MF\ to undertake appropriate corrective action.
+
+\MF's file-opening procedures return \\{false} if no file identified by
+\\{name\_of\_file} could be opened.
+
+\Y\P\D \37$\\{reset\_OK}(\#)\S\\{erstat}(\#)=0$\par
+\P\D \37$\\{rewrite\_OK}(\#)\S\\{erstat}(\#)=0$\par
+\Y\P\4\&{function}\1\ \37$\\{a\_open\_in}(\mathop{\&{var}}\|f:\\{alpha%
+\_file})$: \37\\{boolean};\C{open a text file for input}\2\6
+\&{begin} \37$\\{reset}(\|f,\39\\{name\_of\_file},\39\.{\'/O\'})$;\5
+$\\{a\_open\_in}\K\\{reset\_OK}(\|f)$;\6
+\&{end};\7
+\4\&{function}\1\ \37$\\{a\_open\_out}(\mathop{\&{var}}\|f:\\{alpha\_file})$: %
+\37\\{boolean};\C{open a text file for output}\2\6
+\&{begin} \37$\\{rewrite}(\|f,\39\\{name\_of\_file},\39\.{\'/O\'})$;\5
+$\\{a\_open\_out}\K\\{rewrite\_OK}(\|f)$;\6
+\&{end};\7
+\4\&{function}\1\ \37$\\{b\_open\_out}(\mathop{\&{var}}\|f:\\{byte\_file})$: %
+\37\\{boolean};\C{open a binary file for output}\2\6
+\&{begin} \37$\\{rewrite}(\|f,\39\\{name\_of\_file},\39\.{\'/O\'})$;\5
+$\\{b\_open\_out}\K\\{rewrite\_OK}(\|f)$;\6
+\&{end};\7
+\4\&{function}\1\ \37$\\{w\_open\_in}(\mathop{\&{var}}\|f:\\{word\_file})$: %
+\37\\{boolean};\C{open a word file for input}\2\6
+\&{begin} \37$\\{reset}(\|f,\39\\{name\_of\_file},\39\.{\'/O\'})$;\5
+$\\{w\_open\_in}\K\\{reset\_OK}(\|f)$;\6
+\&{end};\7
+\4\&{function}\1\ \37$\\{w\_open\_out}(\mathop{\&{var}}\|f:\\{word\_file})$: %
+\37\\{boolean};\C{open a word file for output}\2\6
+\&{begin} \37$\\{rewrite}(\|f,\39\\{name\_of\_file},\39\.{\'/O\'})$;\5
+$\\{w\_open\_out}\K\\{rewrite\_OK}(\|f)$;\6
+\&{end};\par
+\fi
+
+\M27. Files can be closed with the \ph\ routine `$\\{close}(\|f)$', which
+should be used when all input or output with respect to \|f has been completed.
+This makes \|f available to be opened again, if desired; and if \|f was used
+for
+output, the \\{close} operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+\Y\P\4\&{procedure}\1\ \37$\\{a\_close}(\mathop{\&{var}}\|f:\\{alpha\_file})$;%
+\C{close a text file}\2\6
+\&{begin} \37$\\{close}(\|f)$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37$\\{b\_close}(\mathop{\&{var}}\|f:\\{byte\_file})$;%
+\C{close a binary file}\2\6
+\&{begin} \37$\\{close}(\|f)$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37$\\{w\_close}(\mathop{\&{var}}\|f:\\{word\_file})$;%
+\C{close a word file}\2\6
+\&{begin} \37$\\{close}(\|f)$;\6
+\&{end};\par
+\fi
+
+\M28. Binary input and output are done with \PASCAL's ordinary \\{get} and %
+\\{put}
+procedures, so we don't have to make any other special arrangements for
+binary~I/O. Text output is also easy to do with standard \PASCAL\ routines.
+The treatment of text input is more difficult, however, because
+of the necessary translation to \\{ASCII\_code} values.
+\MF's conventions should be efficient, and they should
+blend nicely with the user's operating environment.
+
+\fi
+
+\M29. Input from text files is read one line at a time, using a routine called
+\\{input\_ln}. This function is defined in terms of global variables called
+\\{buffer}, \\{first}, and \\{last} that will be described in detail later; for
+now, it suffices for us to know that \\{buffer} is an array of \\{ASCII\_code}
+values, and that \\{first} and \\{last} are indices into this array
+representing the beginning and ending of a line of text.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{buffer}: \37\&{array} $[0\to\\{buf\_size}]$ \1\&{of}\5
+\\{ASCII\_code};\C{lines of characters being read}\2\6
+\4\\{first}: \37$0\to\\{buf\_size}$;\C{the first unused position in \\{buffer}}%
+\6
+\4\\{last}: \37$0\to\\{buf\_size}$;\C{end of the line just input to \\{buffer}}%
+\6
+\4\\{max\_buf\_stack}: \37$0\to\\{buf\_size}$;\C{largest index used in %
+\\{buffer}}\par
+\fi
+
+\M30. The \\{input\_ln} function brings the next line of input from the
+specified
+field into available positions of the buffer array and returns the value
+\\{true}, unless the file has already been entirely read, in which case it
+returns \\{false} and sets $\\{last}\K\\{first}$. In general, the \\{ASCII%
+\_code}
+numbers that represent the next line of the file are input into
+$\\{buffer}[\\{first}]$, $\\{buffer}[\\{first}+1]$, \dots, $\\{buffer}[%
+\\{last}-1]$; and the
+global variable \\{last} is set equal to \\{first} plus the length of the
+line. Trailing blanks are removed from the line; thus, either $\\{last}=%
+\\{first}$
+(in which case the line was entirely blank) or $\\{buffer}[\\{last}-1]\I\.{"\
+"}$.
+
+An overflow error is given, however, if the normal actions of \\{input\_ln}
+would make $\\{last}\G\\{buf\_size}$; this is done so that other parts of \MF\
+can safely look at the contents of $\\{buffer}[\\{last}+1]$ without
+overstepping
+the bounds of the \\{buffer} array. Upon entry to \\{input\_ln}, the condition
+$\\{first}<\\{buf\_size}$ will always hold, so that there is always room for an
+``empty'' line.
+
+The variable \\{max\_buf\_stack}, which is used to keep track of how large
+the \\{buf\_size} parameter must be to accommodate the present job, is
+also kept up to date by \\{input\_ln}.
+
+If the \\{bypass\_eoln} parameter is \\{true}, \\{input\_ln} will do a \\{get}
+before looking at the first character of the line; this skips over
+an \\{eoln} that was in $\|f\^$. The procedure does not do a \\{get} when it
+reaches the end of the line; therefore it can be used to acquire input
+from the user's terminal as well as from ordinary text files.
+
+Standard \PASCAL\ says that a file should have \\{eoln} immediately
+before \\{eof}, but \MF\ needs only a weaker restriction: If \\{eof}
+occurs in the middle of a line, the system function \\{eoln} should return
+a \\{true} result (even though $\|f\^$ will be undefined).
+
+\Y\P\4\&{function}\1\ \37$\\{input\_ln}(\mathop{\&{var}}\|f:\\{alpha\_file};\,%
+\35\\{bypass\_eoln}:\\{boolean})$: \37\\{boolean};\C{inputs the next line or
+returns \\{false}}\6
+\4\&{var} \37\\{last\_nonblank}: \37$0\to\\{buf\_size}$;\C{\\{last} with
+trailing blanks removed}\2\6
+\&{begin} \37\&{if} $\\{bypass\_eoln}$ \1\&{then}\6
+\&{if} $\R\\{eof}(\|f)$ \1\&{then}\5
+$\\{get}(\|f)$;\C{input the first character of the line into $\|f\^$}\2\2\6
+$\\{last}\K\\{first}$;\C{cf.\ Matthew 19\thinspace:\thinspace30}\6
+\&{if} $\\{eof}(\|f)$ \1\&{then}\5
+$\\{input\_ln}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\\{last\_nonblank}\K\\{first}$;\6
+\&{while} $\R\\{eoln}(\|f)$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{last}\G\\{max\_buf\_stack}$ \1\&{then}\6
+\&{begin} \37$\\{max\_buf\_stack}\K\\{last}+1$;\6
+\&{if} $\\{max\_buf\_stack}=\\{buf\_size}$ \1\&{then}\5
+\X34:Report overflow of the input buffer, and abort\X;\2\6
+\&{end};\2\6
+$\\{buffer}[\\{last}]\K\\{xord}[\|f\^]$;\5
+$\\{get}(\|f)$;\5
+$\\{incr}(\\{last})$;\6
+\&{if} $\\{buffer}[\\{last}-1]\I\.{"\ "}$ \1\&{then}\5
+$\\{last\_nonblank}\K\\{last}$;\2\6
+\&{end};\2\6
+$\\{last}\K\\{last\_nonblank}$;\5
+$\\{input\_ln}\K\\{true}$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M31. The user's terminal acts essentially like other files of text, except
+that it is used both for input and for output. When the terminal is
+considered an input file, the file variable is called \\{term\_in}, and when it
+is considered an output file the file variable is \\{term\_out}.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{term\_in}: \37\\{alpha\_file};\C{the terminal as an input file}\6
+\4\\{term\_out}: \37\\{alpha\_file};\C{the terminal as an output file}\par
+\fi
+
+\M32. Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first \\{get}.
+
+\Y\P\D \37$\\{t\_open\_in}\S\\{reset}(\\{term\_in},\39\.{\'TTY:\'},\39\.{\'/O/I%
+\'})$\C{open the terminal for text input}\par
+\P\D \37$\\{t\_open\_out}\S\\{rewrite}(\\{term\_out},\39\.{\'TTY:\'},\39\.{\'/O%
+\'})$\C{open the terminal for text output}\par
+\fi
+
+\M33. Sometimes it is necessary to synchronize the input/output mixture that
+happens on the user's terminal, and three system-dependent
+procedures are used for this
+purpose. The first of these, \\{update\_terminal}, is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+The second, \\{clear\_terminal}, is called when we wish to cancel any
+input that the user may have typed ahead (since we are about to
+issue an unexpected error message). The third, \\{wake\_up\_terminal},
+is supposed to revive the terminal if the user has disabled it by
+some instruction to the operating system. The following macros show how
+these operations can be specified in \ph:
+
+\Y\P\D \37$\\{update\_terminal}\S\\{break}(\\{term\_out})$\C{empty the terminal
+output buffer}\par
+\P\D \37$\\{clear\_terminal}\S\\{break\_in}(\\{term\_in},\39\\{true})$\C{clear
+the terminal input buffer}\par
+\P\D \37$\\{wake\_up\_terminal}\S\\{do\_nothing}$\C{cancel the user's
+cancellation of output}\par
+\fi
+
+\M34. We need a special routine to read the first line of \MF\ input from
+the user's terminal. This line is different because it is read before we
+have opened the transcript file; there is sort of a ``chicken and
+egg'' problem here. If the user types `\.{input cmr10}' on the first
+line, or if some macro invoked by that line does such an \.{input},
+the transcript file will be named `\.{cmr10.log}'; but if no \.{input}
+commands are performed during the first line of terminal input, the transcript
+file will acquire its default name `\.{mfput.log}'. (The transcript file
+will not contain error messages generated by the first line before the
+first \.{input} command.)
+
+The first line is even more special if we are lucky enough to have an operating
+system that treats \MF\ differently from a run-of-the-mill \PASCAL\ object
+program. It's nice to let the user start running a \MF\ job by typing
+a command line like `\.{MF cmr10}'; in such a case, \MF\ will operate
+as if the first line of input were `\.{cmr10}', i.e., the first line will
+consist of the remainder of the command line, after the part that invoked \MF.
+
+The first line is special also because it may be read before \MF\ has
+input a base file. In such cases, normal error messages cannot yet
+be given. The following code uses concepts that will be explained later.
+(If the \PASCAL\ compiler does not support non-local \&{goto} , the
+statement `\&{goto} \\{final\_end}' should be replaced by something that
+quietly terminates the program.)
+
+\Y\P$\4\X34:Report overflow of the input buffer, and abort\X\S$\6
+\&{if} $\\{base\_ident}=0$ \1\&{then}\6
+\&{begin} \37$\\{write\_ln}(\\{term\_out},\39\.{\'Buffer\ size\ exceeded!\'})$;%
+\5
+\&{goto} \37\\{final\_end};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{cur\_input}.\\{loc\_field}\K\\{first}$;\5
+$\\{cur\_input}.\\{limit\_field}\K\\{last}-1$;\5
+$\\{overflow}(\.{"buffer\ size"},\39\\{buf\_size})$;\6
+\&{end}\2\par
+\U30.\fi
+
+\M35. Different systems have different ways to get started. But regardless of
+what conventions are adopted, the routine that initializes the terminal
+should satisfy the following specifications:
+
+\yskip\textindent{1)}It should open file \\{term\_in} for input from the
+terminal. (The file \\{term\_out} will already be open for output to the
+terminal.)
+
+\textindent{2)}If the user has given a command line, this line should be
+considered the first line of terminal input. Otherwise the
+user should be prompted with `\.{**}', and the first line of input
+should be whatever is typed in response.
+
+\textindent{3)}The first line of input, which might or might not be a
+command line, should appear in locations \\{first} to $\\{last}-1$ of the
+\\{buffer} array.
+
+\textindent{4)}The global variable \\{loc} should be set so that the
+character to be read next by \MF\ is in $\\{buffer}[\\{loc}]$. This
+character should not be blank, and we should have $\\{loc}<\\{last}$.
+
+\yskip\noindent(It may be necessary to prompt the user several times
+before a non-blank line comes in. The prompt is `\.{**}' instead of the
+later `\.*' because the meaning is slightly different: `\.{input}' need
+not be typed immediately after~`\.{**}'.)
+
+\Y\P\D \37$\\{loc}\S\\{cur\_input}.\\{loc\_field}$\C{location of first unread
+character in \\{buffer}}\par
+\fi
+
+\M36. The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+
+\Y\P\4\&{function}\1\ \37\\{init\_terminal}: \37\\{boolean};\C{gets the
+terminal input started}\6
+\4\&{label} \37\\{exit};\2\6
+\&{begin} \37\\{t\_open\_in};\6
+\~ \1\&{loop}\ \&{begin} \37\\{wake\_up\_terminal};\5
+$\\{write}(\\{term\_out},\39\.{\'**\'})$;\5
+\\{update\_terminal};\6
+\&{if} $\R\\{input\_ln}(\\{term\_in},\39\\{true})$ \1\&{then}\C{this shouldn't
+happen}\6
+\&{begin} \37$\\{write\_ln}(\\{term\_out})$;\5
+$\\{write}(\\{term\_out},\39\.{\'!\ End\ of\ file\ on\ the\ terminal...\ why?%
+\'})$;\5
+$\\{init\_terminal}\K\\{false}$;\5
+\&{return};\6
+\&{end};\2\6
+$\\{loc}\K\\{first}$;\6
+\&{while} $(\\{loc}<\\{last})\W(\\{buffer}[\\{loc}]=\.{"\ "})$ \1\&{do}\5
+$\\{incr}(\\{loc})$;\2\6
+\&{if} $\\{loc}<\\{last}$ \1\&{then}\6
+\&{begin} \37$\\{init\_terminal}\K\\{true}$;\5
+\&{return};\C{return unless the line was all blank}\6
+\&{end};\2\6
+$\\{write\_ln}(\\{term\_out},\39\.{\'Please\ type\ the\ name\ of\ your\ input\
+file.\'})$;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\N37. \[4] String handling.
+Symbolic token names and diagnostic messages are variable-length strings
+of eight-bit characters. Since \PASCAL\ does not have a well-developed string
+mechanism, \MF\ does all of its string processing by homegrown methods.
+
+Elaborate facilities for dynamic strings are not needed, so all of the
+necessary operations can be handled with a simple data structure.
+The array \\{str\_pool} contains all of the (eight-bit) ASCII codes in all
+of the strings, and the array \\{str\_start} contains indices of the starting
+points of each string. Strings are referred to by integer numbers, so that
+string number \|s comprises the characters $\\{str\_pool}[\|j]$ for
+$\\{str\_start}[\|s]\L\|j<\\{str\_start}[\|s+1]$. Additional integer variables
+\\{pool\_ptr} and \\{str\_ptr} indicate the number of entries used so far
+in \\{str\_pool} and \\{str\_start}, respectively; locations
+$\\{str\_pool}[\\{pool\_ptr}]$ and $\\{str\_start}[\\{str\_ptr}]$ are
+ready for the next string to be allocated.
+
+String numbers 0 to 255 are reserved for strings that correspond to single
+ASCII characters. This is in accordance with the conventions of \.{WEB},
+which converts single-character strings into the ASCII code number of the
+single character involved, while it converts other strings into integers
+and builds a string pool file. Thus, when the string constant \.{"."} appears
+in the program below, \.{WEB} converts it into the integer 46, which is the
+ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"}
+into some integer greater than~255. String number 46 will presumably be the
+single character `\..'\thinspace; but some ASCII codes have no standard visible
+representation, and \MF\ may need to be able to print an arbitrary
+ASCII character, so the first 256 strings are used to specify exactly what
+should be printed for each of the 256 possibilities.
+
+Elements of the \\{str\_pool} array must be ASCII codes that can actually be
+printed; i.e., they must have an \\{xchr} equivalent in the local
+character set. (This restriction applies only to preloaded strings,
+not to those generated dynamically by the user.)
+
+Some \PASCAL\ compilers won't pack integers into a single byte unless the
+integers lie in the range $-128\to127$. To accommodate such systems
+we access the string pool only via macros that can easily be redefined.
+
+\Y\P\D \37$\\{si}(\#)\S\#$\C{convert from \\{ASCII\_code} to \\{packed\_ASCII%
+\_code}}\par
+\P\D \37$\\{so}(\#)\S\#$\C{convert from \\{packed\_ASCII\_code} to \\{ASCII%
+\_code}}\par
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{pool\_pointer}=0\to\\{pool\_size}$;\C{for variables that point into \\{str%
+\_pool}}\6
+$\\{str\_number}=0\to\\{max\_strings}$;\C{for variables that point into \\{str%
+\_start}}\6
+$\\{packed\_ASCII\_code}=0\to255$;\C{elements of \\{str\_pool} array}\par
+\fi
+
+\M38. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{str\_pool}: \37\&{packed} \37\&{array} $[\\{pool\_pointer}]$ \1\&{of}\5
+\\{packed\_ASCII\_code};\C{the characters}\2\6
+\4\\{str\_start}: \37\&{array} $[\\{str\_number}]$ \1\&{of}\5
+\\{pool\_pointer};\C{the starting pointers}\2\6
+\4\\{pool\_ptr}: \37\\{pool\_pointer};\C{first unused position in \\{str%
+\_pool}}\6
+\4\\{str\_ptr}: \37\\{str\_number};\C{number of the current string being
+created}\6
+\4\\{init\_pool\_ptr}: \37\\{pool\_pointer};\C{the starting value of \\{pool%
+\_ptr}}\6
+\4\\{init\_str\_ptr}: \37\\{str\_number};\C{the starting value of \\{str\_ptr}}%
+\6
+\4\\{max\_pool\_ptr}: \37\\{pool\_pointer};\C{the maximum so far of \\{pool%
+\_ptr}}\6
+\4\\{max\_str\_ptr}: \37\\{str\_number};\C{the maximum so far of \\{str\_ptr}}%
+\par
+\fi
+
+\M39. Several of the elementary string operations are performed using \.{WEB}
+macros instead of \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a string.
+
+\Y\P\D \37$\\{length}(\#)\S(\\{str\_start}[\#+1]-\\{str\_start}[\#])$\C{the
+number of characters in string number \#}\par
+\fi
+
+\M40. The length of the current string is called \\{cur\_length}:
+
+\Y\P\D \37$\\{cur\_length}\S(\\{pool\_ptr}-\\{str\_start}[\\{str\_ptr}])$\par
+\fi
+
+\M41. Strings are created by appending character codes to \\{str\_pool}.
+The \\{append\_char} macro, defined here, does not check to see if the
+value of \\{pool\_ptr} has gotten too high; this test is supposed to be
+made before \\{append\_char} is used.
+
+To test if there is room to append \|l more characters to \\{str\_pool},
+we shall write $\\{str\_room}(\|l)$, which aborts \MF\ and gives an
+apologetic error message if there isn't enough room.
+
+\Y\P\D \37$\\{append\_char}(\#)\S$\C{put \\{ASCII\_code} \# at the end of %
+\\{str\_pool}}\6
+\&{begin} \37$\\{str\_pool}[\\{pool\_ptr}]\K\\{si}(\#)$;\5
+$\\{incr}(\\{pool\_ptr})$;\6
+\&{end}\par
+\P\D \37$\\{str\_room}(\#)\S$\C{make sure that the pool hasn't overflowed}\6
+\&{begin} \37\&{if} $\\{pool\_ptr}+\#>\\{max\_pool\_ptr}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{pool\_ptr}+\#>\\{pool\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"pool\ size"},\39\\{pool\_size}-\\{init\_pool\_ptr})$;\2\6
+$\\{max\_pool\_ptr}\K\\{pool\_ptr}+\#$;\6
+\&{end};\2\6
+\&{end}\par
+\fi
+
+\M42. \MF's string expressions are implemented in a brute-force way: Every
+new string or substring that is needed is simply copied into the string pool.
+
+Such a scheme can be justified because string expressions aren't a big
+deal in \MF\ applications; strings rarely need to be saved from one
+statement to the next. But it would waste space needlessly if we didn't
+try to reclaim the space of strings that are going to be used only once.
+
+Therefore a simple reference count mechanism is provided: If there are
+no references to a certain string from elsewhere in the program, and
+if there are no references to any strings created subsequent to it,
+then the string space will be reclaimed.
+
+The number of references to string number \|s will be $\\{str\_ref}[\|s]$. The
+special value $\\{str\_ref}[\|s]=\\{max\_str\_ref}=127$ is used to denote an
+unknown
+positive number of references; such strings will never be recycled. If
+a string is ever referred to more than 126 times, simultaneously, we
+put it in this category. Hence a single byte suffices to store each \\{str%
+\_ref}.
+
+\Y\P\D \37$\\{max\_str\_ref}=127$\C{``infinite'' number of references}\par
+\P\D \37$\\{add\_str\_ref}(\#)\S$\1\6
+\&{begin} \37\&{if} $\\{str\_ref}[\#]<\\{max\_str\_ref}$ \1\&{then}\5
+$\\{incr}(\\{str\_ref}[\#])$;\2\6
+\&{end}\2\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{str\_ref}: \37\&{array} $[\\{str\_number}]$ \1\&{of}\5
+$0\to\\{max\_str\_ref}$;\2\par
+\fi
+
+\M43. Here's what we do when a string reference disappears:
+
+\Y\P\D \37$\\{delete\_str\_ref}(\#)\S$\1\6
+\&{begin} \37\&{if} $\\{str\_ref}[\#]<\\{max\_str\_ref}$ \1\&{then}\6
+\&{if} $\\{str\_ref}[\#]>1$ \1\&{then}\5
+$\\{decr}(\\{str\_ref}[\#])$\ \&{else} $\\{flush\_string}(\#)$;\2\2\6
+\&{end}\2\par
+\Y\P$\4\X43:Declare the procedure called \\{flush\_string}\X\S$\6
+\4\&{procedure}\1\ \37$\\{flush\_string}(\|s:\\{str\_number})$;\2\6
+\&{begin} \37\&{if} $\|s<\\{str\_ptr}-1$ \1\&{then}\5
+$\\{str\_ref}[\|s]\K0$\6
+\4\&{else} \1\&{repeat} \37$\\{decr}(\\{str\_ptr})$;\6
+\4\&{until}\5
+$\\{str\_ref}[\\{str\_ptr}-1]\I0$;\2\2\6
+$\\{pool\_ptr}\K\\{str\_start}[\\{str\_ptr}]$;\6
+\&{end};\par
+\U73.\fi
+
+\M44. Once a sequence of characters has been appended to \\{str\_pool}, it
+officially becomes a string when the function \\{make\_string} is called.
+This function returns the identification number of the new string as its
+value.
+
+\Y\P\4\&{function}\1\ \37\\{make\_string}: \37\\{str\_number};\C{current
+string enters the pool}\2\6
+\&{begin} \37\&{if} $\\{str\_ptr}=\\{max\_str\_ptr}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{str\_ptr}=\\{max\_strings}$ \1\&{then}\5
+$\\{overflow}(\.{"number\ of\ strings"},\39\\{max\_strings}-\\{init\_str%
+\_ptr})$;\2\6
+$\\{incr}(\\{max\_str\_ptr})$;\6
+\&{end};\2\6
+$\\{str\_ref}[\\{str\_ptr}]\K1$;\5
+$\\{incr}(\\{str\_ptr})$;\5
+$\\{str\_start}[\\{str\_ptr}]\K\\{pool\_ptr}$;\5
+$\\{make\_string}\K\\{str\_ptr}-1$;\6
+\&{end};\par
+\fi
+
+\M45. The following subroutine compares string \|s with another string of the
+same length that appears in \\{buffer} starting at position \|k;
+the result is \\{true} if and only if the strings are equal.
+
+\Y\P\4\&{function}\1\ \37$\\{str\_eq\_buf}(\|s:\\{str\_number};\,\35\|k:%
+\\{integer})$: \37\\{boolean};\C{test equality of strings}\6
+\4\&{label} \37\\{not\_found};\C{loop exit}\6
+\4\&{var} \37\|j: \37\\{pool\_pointer};\C{running index}\6
+\\{result}: \37\\{boolean};\C{result of comparison}\2\6
+\&{begin} \37$\|j\K\\{str\_start}[\|s]$;\6
+\&{while} $\|j<\\{str\_start}[\|s+1]$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{so}(\\{str\_pool}[\|j])\I\\{buffer}[\|k]$ \1\&{then}\6
+\&{begin} \37$\\{result}\K\\{false}$;\5
+\&{goto} \37\\{not\_found};\6
+\&{end};\2\6
+$\\{incr}(\|j)$;\5
+$\\{incr}(\|k)$;\6
+\&{end};\2\6
+$\\{result}\K\\{true}$;\6
+\4\\{not\_found}: \37$\\{str\_eq\_buf}\K\\{result}$;\6
+\&{end};\par
+\fi
+
+\M46. Here is a similar routine, but it compares two strings in the string
+pool,
+and it does not assume that they have the same length. If the first string
+is lexicographically greater than, less than, or equal to the second,
+the result is respectively positive, negative, or zero.
+
+\Y\P\4\&{function}\1\ \37$\\{str\_vs\_str}(\|s,\39\|t:\\{str\_number})$: \37%
+\\{integer};\C{test equality of strings}\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37$\|j,\39\|k$: \37\\{pool\_pointer};\C{running indices}\6
+$\\{ls},\39\\{lt}$: \37\\{integer};\C{lengths}\6
+\|l: \37\\{integer};\C{length remaining to test}\2\6
+\&{begin} \37$\\{ls}\K\\{length}(\|s)$;\5
+$\\{lt}\K\\{length}(\|t)$;\6
+\&{if} $\\{ls}\L\\{lt}$ \1\&{then}\5
+$\|l\K\\{ls}$\ \&{else} $\|l\K\\{lt}$;\2\6
+$\|j\K\\{str\_start}[\|s]$;\5
+$\|k\K\\{str\_start}[\|t]$;\6
+\&{while} $\|l>0$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{str\_pool}[\|j]\I\\{str\_pool}[\|k]$ \1\&{then}\6
+\&{begin} \37$\\{str\_vs\_str}\K\\{str\_pool}[\|j]-\\{str\_pool}[\|k]$;\5
+\&{return};\6
+\&{end};\2\6
+$\\{incr}(\|j)$;\5
+$\\{incr}(\|k)$;\5
+$\\{decr}(\|l)$;\6
+\&{end};\2\6
+$\\{str\_vs\_str}\K\\{ls}-\\{lt}$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M47. The initial values of \\{str\_pool}, \\{str\_start}, \\{pool\_ptr},
+and \\{str\_ptr} are computed by the \.{INIMF} program, based in part
+on the information that \.{WEB} has output while processing \MF.
+
+\Y\P\&{init} \37\&{function}\1\ \37\\{get\_strings\_started}: \37\\{boolean};%
+\C{initializes the string pool, but returns \\{false} if something goes
+wrong}\6
+\4\&{label} \37$\\{done},\39\\{exit}$;\6
+\4\&{var} \37$\|k,\39\|l$: \37$0\to255$;\C{small indices or counters}\6
+$\|m,\39\|n$: \37\\{text\_char};\C{characters input from \\{pool\_file}}\6
+\|g: \37\\{str\_number};\C{garbage}\6
+\|a: \37\\{integer};\C{accumulator for check sum}\6
+\|c: \37\\{boolean};\C{check sum has been checked}\2\6
+\&{begin} \37$\\{pool\_ptr}\K0$;\5
+$\\{str\_ptr}\K0$;\5
+$\\{max\_pool\_ptr}\K0$;\5
+$\\{max\_str\_ptr}\K0$;\5
+$\\{str\_start}[0]\K0$;\5
+\X48:Make the first 256 strings\X;\6
+\X51:Read the other strings from the \.{MF.POOL} file and return \\{true}, or
+give an error message and return \\{false}\X;\6
+\4\\{exit}: \37\&{end};\6
+\&{tini}\par
+\fi
+
+\M48. \P\D \37$\\{app\_lc\_hex}(\#)\S\|l\K\#$;\6
+\&{if} $\|l<10$ \1\&{then}\5
+$\\{append\_char}(\|l+\.{"0"})$\ \&{else} $\\{append\_char}(\|l-10+\.{"a"})$\2%
+\par
+\Y\P$\4\X48:Make the first 256 strings\X\S$\6
+\&{for} $\|k\K0\mathrel{\&{to}}255$ \1\&{do}\6
+\&{begin} \37\&{if} $(\X49:Character \|k cannot be printed\X)$ \1\&{then}\6
+\&{begin} \37$\\{append\_char}(\.{"\^"})$;\5
+$\\{append\_char}(\.{"\^"})$;\6
+\&{if} $\|k<\O{100}$ \1\&{then}\5
+$\\{append\_char}(\|k+\O{100})$\6
+\4\&{else} \&{if} $\|k<\O{200}$ \1\&{then}\5
+$\\{append\_char}(\|k-\O{100})$\6
+\4\&{else} \&{begin} \37$\\{app\_lc\_hex}(\|k\mathbin{\&{div}}16)$;\5
+$\\{app\_lc\_hex}(\|k\mathbin{\&{mod}}16)$;\6
+\&{end};\2\2\6
+\&{end}\6
+\4\&{else} $\\{append\_char}(\|k)$;\2\6
+$\|g\K\\{make\_string}$;\5
+$\\{str\_ref}[\|g]\K\\{max\_str\_ref}$;\6
+\&{end}\2\par
+\U47.\fi
+
+\M49. The first 128 strings will contain 95 standard ASCII characters, and the
+other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
+unless a system-dependent change is made here. Installations that have
+an extended character set, where for example $\\{xchr}[\O{32}]=\hbox{\.{\'^^Z%
+\'}}$,
+would like string \O{32} to be the single character \O{32} instead of the
+three characters \O{136}, \O{136}, \O{132} (\.{\^\^Z}). On the other hand,
+even people with an extended character set will want to represent string
+\O{15} by \.{\^\^M}, since \O{15} is ASCII's ``carriage return'' code; the idea
+is
+to produce visible strings instead of tabs or line-feeds or carriage-returns
+or bell-rings or characters that are treated anomalously in text files.
+
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+The boolean expression defined here should be \\{true} unless \MF\ internal
+code number~\|k corresponds to a non-troublesome visible symbol in the
+local character set.
+If character \|k cannot be printed, and $\|k<\O{200}$, then character $\|k+%
+\O{100}$ or
+$\|k-\O{100}$ must be printable; moreover, ASCII codes $[\O{60}\to\O{71},%
+\O{141}\to\O{146}]$
+must be printable.
+
+\Y\P$\4\X49:Character \|k cannot be printed\X\S$\6
+$(\|k<\.{"\ "})\V(\|k>\.{"\~"})$\par
+\U48.\fi
+
+\M50. When the \.{WEB} system program called \.{TANGLE} processes the %
+\.{MF.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{MF.PAS} and also a string pool file called \.{MF.POOL}. The \.{INIMF}
+program reads the latter file, where each string appears as a two-digit decimal
+length followed by the string itself, and the information is recorded in
+\MF's string memory.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\&{init} \37\\{pool\_file}: \37\\{alpha\_file};\C{the string-pool file output
+by \.{TANGLE}}\6
+\&{tini}\par
+\fi
+
+\M51. \P\D \37$\\{bad\_pool}(\#)\S$\1\6
+\&{begin} \37\\{wake\_up\_terminal};\5
+$\\{write\_ln}(\\{term\_out},\39\#)$;\5
+$\\{a\_close}(\\{pool\_file})$;\5
+$\\{get\_strings\_started}\K\\{false}$;\5
+\&{return};\6
+\&{end}\2\par
+\Y\P$\4\X51:Read the other strings from the \.{MF.POOL} file and return %
+\\{true}, or give an error message and return \\{false}\X\S$\6
+$\\{name\_of\_file}\K\\{pool\_name}$;\C{we needn't set \\{name\_length}}\6
+\&{if} $\\{a\_open\_in}(\\{pool\_file})$ \1\&{then}\6
+\&{begin} \37$\|c\K\\{false}$;\6
+\1\&{repeat} \37\X52:Read one string, but return \\{false} if the string memory
+space is getting too tight for comfort\X;\6
+\4\&{until}\5
+\|c;\2\6
+$\\{a\_close}(\\{pool\_file})$;\5
+$\\{get\_strings\_started}\K\\{true}$;\6
+\&{end}\6
+\4\&{else} $\\{bad\_pool}(\.{\'!\ I\ can\'}\.{\'t\ read\ MF.POOL.\'})$\2\par
+\U47.\fi
+
+\M52. \P$\X52:Read one string, but return \\{false} if the string memory space
+is getting too tight for comfort\X\S$\6
+\&{begin} \37\&{if} $\\{eof}(\\{pool\_file})$ \1\&{then}\5
+$\\{bad\_pool}(\.{\'!\ MF.POOL\ has\ no\ check\ sum.\'})$;\2\6
+$\\{read}(\\{pool\_file},\39\|m,\39\|n)$;\C{read two digits of string length}\6
+\&{if} $\|m=\.{\'*\'}$ \1\&{then}\5
+\X53:Check the pool check sum\X\6
+\4\&{else} \&{begin} \37\&{if} $(\\{xord}[\|m]<\.{"0"})\V(\\{xord}[\|m]>%
+\.{"9"})\V\30(\\{xord}[\|n]<\.{"0"})\V(\\{xord}[\|n]>\.{"9"})$ \1\&{then}\5
+$\\{bad\_pool}(\.{\'!\ MF.POOL\ line\ doesn\'}\.{\'t\ begin\ with\ two\ digits.%
+\'})$;\2\6
+$\|l\K\\{xord}[\|m]\ast10+\\{xord}[\|n]-\.{"0"}\ast11$;\C{compute the length}\6
+\&{if} $\\{pool\_ptr}+\|l+\\{string\_vacancies}>\\{pool\_size}$ \1\&{then}\5
+$\\{bad\_pool}(\.{\'!\ You\ have\ to\ increase\ POOLSIZE.\'})$;\2\6
+\&{for} $\|k\K1\mathrel{\&{to}}\|l$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{eoln}(\\{pool\_file})$ \1\&{then}\5
+$\|m\K\.{\'\ \'}$\ \&{else} $\\{read}(\\{pool\_file},\39\|m)$;\2\6
+$\\{append\_char}(\\{xord}[\|m])$;\6
+\&{end};\2\6
+$\\{read\_ln}(\\{pool\_file})$;\5
+$\|g\K\\{make\_string}$;\5
+$\\{str\_ref}[\|g]\K\\{max\_str\_ref}$;\6
+\&{end};\2\6
+\&{end}\par
+\U51.\fi
+
+\M53. The \.{WEB} operation \.{@\$} denotes the value that should be at the
+end of this \.{MF.POOL} file; any other value means that the wrong pool
+file has been loaded.
+
+\Y\P$\4\X53:Check the pool check sum\X\S$\6
+\&{begin} \37$\|a\K0$;\5
+$\|k\K1$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $(\\{xord}[\|n]<\.{"0"})\V(\\{xord}[\|n]>%
+\.{"9"})$ \1\&{then}\5
+$\\{bad\_pool}(\.{\'!\ MF.POOL\ check\ sum\ doesn\'}\.{\'t\ have\ nine\ digits.%
+\'})$;\2\6
+$\|a\K10\ast\|a+\\{xord}[\|n]-\.{"0"}$;\6
+\&{if} $\|k=9$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{incr}(\|k)$;\5
+$\\{read}(\\{pool\_file},\39\|n)$;\6
+\&{end};\2\6
+\4\\{done}: \37\&{if} $\|a\I\)$ \1\&{then}\5
+$\\{bad\_pool}(\.{\'!\ MF.POOL\ doesn\'}\.{\'t\ match;\ TANGLE\ me\ again.%
+\'})$;\2\6
+$\|c\K\\{true}$;\6
+\&{end}\par
+\U52.\fi
+
+\N54. \[5] On-line and off-line printing.
+Messages that are sent to a user's terminal and to the transcript-log file
+are produced by several `\\{print}' procedures. These procedures will
+direct their output to a variety of places, based on the setting of
+the global variable \\{selector}, which has the following possible
+values:
+
+\yskip
+\hang \\{term\_and\_log}, the normal setting, prints on the terminal and on the
+transcript file.
+
+\hang \\{log\_only}, prints only on the transcript file.
+
+\hang \\{term\_only}, prints only on the terminal.
+
+\hang \\{no\_print}, doesn't print at all. This is used only in rare cases
+before the transcript file is open.
+
+\hang \\{pseudo}, puts output into a cyclic buffer that is used
+by the \\{show\_context} routine; when we get to that routine we shall discuss
+the reasoning behind this curious mode.
+
+\hang \\{new\_string}, appends the output to the current string in the
+string pool.
+
+\yskip
+\noindent The symbolic names `\\{term\_and\_log}', etc., have been assigned
+numeric codes that satisfy the convenient relations $\\{no\_print}+1=\\{term%
+\_only}$,
+$\\{no\_print}+2=\\{log\_only}$, $\\{term\_only}+2=\\{log\_only}+1=\\{term\_and%
+\_log}$.
+
+Three additional global variables, \\{tally} and \\{term\_offset} and
+\\{file\_offset}, record the number of characters that have been printed
+since they were most recently cleared to zero. We use \\{tally} to record
+the length of (possibly very long) stretches of printing; \\{term\_offset}
+and \\{file\_offset}, on the other hand, keep track of how many characters
+have appeared so far on the current line that has been output to the
+terminal or to the transcript file, respectively.
+
+\Y\P\D \37$\\{no\_print}=0$\C{\\{selector} setting that makes data disappear}%
+\par
+\P\D \37$\\{term\_only}=1$\C{printing is destined for the terminal only}\par
+\P\D \37$\\{log\_only}=2$\C{printing is destined for the transcript file only}%
+\par
+\P\D \37$\\{term\_and\_log}=3$\C{normal \\{selector} setting}\par
+\P\D \37$\\{pseudo}=4$\C{special \\{selector} setting for \\{show\_context}}\par
+\P\D \37$\\{new\_string}=5$\C{printing is deflected to the string pool}\par
+\P\D \37$\\{max\_selector}=5$\C{highest selector setting}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{log\_file}: \37\\{alpha\_file};\C{transcript of \MF\ session}\6
+\4\\{selector}: \37$0\to\\{max\_selector}$;\C{where to print a message}\6
+\4\\{dig}: \37\&{array} $[0\to22]$ \1\&{of}\5
+$0\to15$;\C{digits in a number being output}\2\6
+\4\\{tally}: \37\\{integer};\C{the number of characters recently printed}\6
+\4\\{term\_offset}: \37$0\to\\{max\_print\_line}$;\C{the number of characters
+on the current terminal line}\6
+\4\\{file\_offset}: \37$0\to\\{max\_print\_line}$;\C{the number of characters
+on the current file line}\6
+\4\\{trick\_buf}: \37\&{array} $[0\to\\{error\_line}]$ \1\&{of}\5
+\\{ASCII\_code};\C{circular buffer for pseudoprinting}\2\6
+\4\\{trick\_count}: \37\\{integer};\C{threshold for pseudoprinting, explained
+later}\6
+\4\\{first\_count}: \37\\{integer};\C{another variable for pseudoprinting}\par
+\fi
+
+\M55. \P$\X55:Initialize the output routines\X\S$\6
+$\\{selector}\K\\{term\_only}$;\5
+$\\{tally}\K0$;\5
+$\\{term\_offset}\K0$;\5
+$\\{file\_offset}\K0$;\par
+\As61, 783\ETs792.
+\U1204.\fi
+
+\M56. Macro abbreviations for output to the terminal and to the log file are
+defined here for convenience. Some systems need special conventions
+for terminal output, and it is possible to adhere to those conventions
+by changing \\{wterm}, \\{wterm\_ln}, and \\{wterm\_cr} here.
+
+\Y\P\D \37$\\{wterm}(\#)\S\\{write}(\\{term\_out},\39\#)$\par
+\P\D \37$\\{wterm\_ln}(\#)\S\\{write\_ln}(\\{term\_out},\39\#)$\par
+\P\D \37$\\{wterm\_cr}\S\\{write\_ln}(\\{term\_out})$\par
+\P\D \37$\\{wlog}(\#)\S\\{write}(\\{log\_file},\39\#)$\par
+\P\D \37$\\{wlog\_ln}(\#)\S\\{write\_ln}(\\{log\_file},\39\#)$\par
+\P\D \37$\\{wlog\_cr}\S\\{write\_ln}(\\{log\_file})$\par
+\fi
+
+\M57. To end a line of text output, we call \\{print\_ln}.
+
+\Y\P$\4\X57:Basic printing procedures\X\S$\6
+\4\&{procedure}\1\ \37\\{print\_ln};\C{prints an end-of-line}\2\6
+\&{begin} \37\&{case} $\\{selector}$ \1\&{of}\6
+\4\\{term\_and\_log}: \37\&{begin} \37\\{wterm\_cr};\5
+\\{wlog\_cr};\5
+$\\{term\_offset}\K0$;\5
+$\\{file\_offset}\K0$;\6
+\&{end};\6
+\4\\{log\_only}: \37\&{begin} \37\\{wlog\_cr};\5
+$\\{file\_offset}\K0$;\6
+\&{end};\6
+\4\\{term\_only}: \37\&{begin} \37\\{wterm\_cr};\5
+$\\{term\_offset}\K0$;\6
+\&{end};\6
+\4$\\{no\_print},\39\\{pseudo},\39\\{new\_string}$: \37\\{do\_nothing};\2\6
+\&{end};\C{there are no other cases}\6
+\&{end};\C{note that \\{tally} is not affected}\par
+\As58, 59, 60, 62, 63, 64, 103, 104, 187, 195, 197\ETs773.
+\U4.\fi
+
+\M58. The \\{print\_char} procedure sends one character to the desired
+destination,
+using the \\{xchr} array to map it into an external character compatible with
+\\{input\_ln}. All printing comes through \\{print\_ln} or \\{print\_char}.
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_char}(\|s:\\{ASCII\_code})$;\C{prints a
+single character}\2\6
+\&{begin} \37\&{case} $\\{selector}$ \1\&{of}\6
+\4\\{term\_and\_log}: \37\&{begin} \37$\\{wterm}(\\{xchr}[\|s])$;\5
+$\\{wlog}(\\{xchr}[\|s])$;\5
+$\\{incr}(\\{term\_offset})$;\5
+$\\{incr}(\\{file\_offset})$;\6
+\&{if} $\\{term\_offset}=\\{max\_print\_line}$ \1\&{then}\6
+\&{begin} \37\\{wterm\_cr};\5
+$\\{term\_offset}\K0$;\6
+\&{end};\2\6
+\&{if} $\\{file\_offset}=\\{max\_print\_line}$ \1\&{then}\6
+\&{begin} \37\\{wlog\_cr};\5
+$\\{file\_offset}\K0$;\6
+\&{end};\2\6
+\&{end};\6
+\4\\{log\_only}: \37\&{begin} \37$\\{wlog}(\\{xchr}[\|s])$;\5
+$\\{incr}(\\{file\_offset})$;\6
+\&{if} $\\{file\_offset}=\\{max\_print\_line}$ \1\&{then}\5
+\\{print\_ln};\2\6
+\&{end};\6
+\4\\{term\_only}: \37\&{begin} \37$\\{wterm}(\\{xchr}[\|s])$;\5
+$\\{incr}(\\{term\_offset})$;\6
+\&{if} $\\{term\_offset}=\\{max\_print\_line}$ \1\&{then}\5
+\\{print\_ln};\2\6
+\&{end};\6
+\4\\{no\_print}: \37\\{do\_nothing};\6
+\4\\{pseudo}: \37\&{if} $\\{tally}<\\{trick\_count}$ \1\&{then}\5
+$\\{trick\_buf}[\\{tally}\mathbin{\&{mod}}\\{error\_line}]\K\|s$;\2\6
+\4\\{new\_string}: \37\&{begin} \37\&{if} $\\{pool\_ptr}<\\{pool\_size}$ \1%
+\&{then}\5
+$\\{append\_char}(\|s)$;\2\6
+\&{end};\C{we drop characters if the string space is full}\2\6
+\&{end};\C{there are no other cases}\6
+$\\{incr}(\\{tally})$;\6
+\&{end};\par
+\fi
+
+\M59. An entire string is output by calling \\{print}. Note that if we are
+outputting
+the single standard ASCII character \.c, we could call $\\{print}(\.{"c"})$,
+since
+$\.{"c"}=99$ is the number of a single-character string, as explained above.
+But
+$\\{print\_char}(\.{"c"})$ is quicker, so \MF\ goes directly to the \\{print%
+\_char}
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print}(\|s:\\{integer})$;\C{prints string \|s}\6
+\4\&{var} \37\|j: \37\\{pool\_pointer};\C{current character code position}\2\6
+\&{begin} \37\&{if} $(\|s<0)\V(\|s\G\\{str\_ptr})$ \1\&{then}\5
+$\|s\K\.{"???"}$;\C{this can't happen}\2\6
+\&{if} $(\|s<256)\W(\\{selector}>\\{pseudo})$ \1\&{then}\5
+$\\{print\_char}(\|s)$\6
+\4\&{else} \&{begin} \37$\|j\K\\{str\_start}[\|s]$;\6
+\&{while} $\|j<\\{str\_start}[\|s+1]$ \1\&{do}\6
+\&{begin} \37$\\{print\_char}(\\{so}(\\{str\_pool}[\|j]))$;\5
+$\\{incr}(\|j)$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M60. Sometimes it's necessary to print a string whose characters
+may not be visible ASCII codes. In that case \\{slow\_print} is used.
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{slow\_print}(\|s:\\{integer})$;\C{prints string \|s}%
+\6
+\4\&{var} \37\|j: \37\\{pool\_pointer};\C{current character code position}\2\6
+\&{begin} \37\&{if} $(\|s<0)\V(\|s\G\\{str\_ptr})$ \1\&{then}\5
+$\|s\K\.{"???"}$;\C{this can't happen}\2\6
+\&{if} $(\|s<256)\W(\\{selector}>\\{pseudo})$ \1\&{then}\5
+$\\{print\_char}(\|s)$\6
+\4\&{else} \&{begin} \37$\|j\K\\{str\_start}[\|s]$;\6
+\&{while} $\|j<\\{str\_start}[\|s+1]$ \1\&{do}\6
+\&{begin} \37$\\{print}(\\{so}(\\{str\_pool}[\|j]))$;\5
+$\\{incr}(\|j)$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M61. Here is the very first thing that \MF\ prints: a headline that identifies
+the version number and base name. The \\{term\_offset} variable is temporarily
+incorrect, but the discrepancy is not serious since we assume that the banner
+and base identifier together will occupy at most \\{max\_print\_line}
+character positions.
+
+\Y\P$\4\X55:Initialize the output routines\X\mathrel{+}\S$\6
+$\\{wterm}(\\{banner})$;\6
+\&{if} $\\{base\_ident}=0$ \1\&{then}\5
+$\\{wterm\_ln}(\.{\'\ (no\ base\ preloaded)\'})$\6
+\4\&{else} \&{begin} \37$\\{slow\_print}(\\{base\_ident})$;\5
+\\{print\_ln};\6
+\&{end};\2\6
+\\{update\_terminal};\par
+\fi
+
+\M62. The procedure \\{print\_nl} is like \\{print}, but it makes sure that the
+string appears at the beginning of a new line.
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_nl}(\|s:\\{str\_number})$;\C{prints string %
+\|s at beginning of line}\2\6
+\&{begin} \37\&{if} $((\\{term\_offset}>0)\W(\\{odd}(\\{selector})))\V\30((%
+\\{file\_offset}>0)\W(\\{selector}\G\\{log\_only}))$ \1\&{then}\5
+\\{print\_ln};\2\6
+$\\{print}(\|s)$;\6
+\&{end};\par
+\fi
+
+\M63. An array of digits in the range $0\to9$ is printed by \\{print\_the%
+\_digs}.
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_the\_digs}(\|k:\\{eight\_bits})$;\C{prints $%
+\\{dig}[\|k-1]$$\,\ldots\,$$\\{dig}[0]$}\2\6
+\&{begin} \37\&{while} $\|k>0$ \1\&{do}\6
+\&{begin} \37$\\{decr}(\|k)$;\5
+$\\{print\_char}(\.{"0"}+\\{dig}[\|k])$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M64. The following procedure, which prints out the decimal representation of a
+given integer \|n, has been written carefully so that it works properly
+if $\|n=0$ or if $(-\|n)$ would cause overflow. It does not apply $\mathbin{%
+\&{mod}}$ or $\mathbin{\&{div}}$
+to negative arguments, since such operations are not implemented consistently
+by all \PASCAL\ compilers.
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_int}(\|n:\\{integer})$;\C{prints an integer
+in decimal form}\6
+\4\&{var} \37\|k: \37$0\to23$;\C{index to current digit; we assume that $%
+\|n<10^{23}$}\6
+\|m: \37\\{integer};\C{used to negate \|n in possibly dangerous cases}\2\6
+\&{begin} \37$\|k\K0$;\6
+\&{if} $\|n<0$ \1\&{then}\6
+\&{begin} \37$\\{print\_char}(\.{"-"})$;\6
+\&{if} $\|n>-100000000$ \1\&{then}\5
+$\\{negate}(\|n)$\6
+\4\&{else} \&{begin} \37$\|m\K-1-\|n$;\5
+$\|n\K\|m\mathbin{\&{div}}10$;\5
+$\|m\K(\|m\mathbin{\&{mod}}10)+1$;\5
+$\|k\K1$;\6
+\&{if} $\|m<10$ \1\&{then}\5
+$\\{dig}[0]\K\|m$\6
+\4\&{else} \&{begin} \37$\\{dig}[0]\K0$;\5
+$\\{incr}(\|n)$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\2\6
+\1\&{repeat} \37$\\{dig}[\|k]\K\|n\mathbin{\&{mod}}10$;\5
+$\|n\K\|n\mathbin{\&{div}}10$;\5
+$\\{incr}(\|k)$;\6
+\4\&{until}\5
+$\|n=0$;\2\6
+$\\{print\_the\_digs}(\|k)$;\6
+\&{end};\par
+\fi
+
+\M65. \MF\ also makes use of a trivial procedure to print two digits. The
+following subroutine is usually called with a parameter in the range $0\L\|n%
+\L99$.
+
+\Y\P\4\&{procedure}\1\ \37$\\{print\_dd}(\|n:\\{integer})$;\C{prints two least
+significant digits}\2\6
+\&{begin} \37$\|n\K\\{abs}(\|n)\mathbin{\&{mod}}100$;\5
+$\\{print\_char}(\.{"0"}+(\|n\mathbin{\&{div}}10))$;\5
+$\\{print\_char}(\.{"0"}+(\|n\mathbin{\&{mod}}10))$;\6
+\&{end};\par
+\fi
+
+\M66. Here is a procedure that asks the user to type a line of input,
+assuming that the \\{selector} setting is either \\{term\_only} or \\{term\_and%
+\_log}.
+The input is placed into locations \\{first} through $\\{last}-1$ of the
+\\{buffer} array, and echoed on the transcript file if appropriate.
+
+This procedure is never called when $\\{interaction}<\\{scroll\_mode}$.
+
+\Y\P\D \37$\\{prompt\_input}(\#)\S$\1\6
+\&{begin} \37\\{wake\_up\_terminal};\5
+$\\{print}(\#)$;\5
+\\{term\_input};\6
+\&{end}\C{prints a string and gets a line of input}\2\par
+\Y\P\4\&{procedure}\1\ \37\\{term\_input};\C{gets a line from the terminal}\6
+\4\&{var} \37\|k: \37$0\to\\{buf\_size}$;\C{index into \\{buffer}}\2\6
+\&{begin} \37\\{update\_terminal};\C{now the user sees the prompt for sure}\6
+\&{if} $\R\\{input\_ln}(\\{term\_in},\39\\{true})$ \1\&{then}\5
+$\\{fatal\_error}(\.{"End\ of\ file\ on\ the\ terminal!"})$;\2\6
+$\\{term\_offset}\K0$;\C{the user's line ended with \<\rm return>}\6
+$\\{decr}(\\{selector})$;\C{prepare to echo the input}\6
+\&{if} $\\{last}\I\\{first}$ \1\&{then}\6
+\&{for} $\|k\K\\{first}\mathrel{\&{to}}\\{last}-1$ \1\&{do}\5
+$\\{print}(\\{buffer}[\|k])$;\2\2\6
+\\{print\_ln};\5
+$\\{buffer}[\\{last}]\K\.{"\%"}$;\5
+$\\{incr}(\\{selector})$;\C{restore previous status}\6
+\&{end};\par
+\fi
+
+\N67. \[6] Reporting errors.
+When something anomalous is detected, \MF\ typically does something like this:
+$$\vbox{\halign{#\hfil\cr
+$\\{print\_err}(\.{"Something\ anomalous\ has\ been\ detected"})$;\cr
+$\\{help3}(\.{"This\ is\ the\ first\ line\ of\ my\ offer\ to\ help."})$\cr
+$(\.{"This\ is\ the\ second\ line.\ I\'m\ trying\ to"})$\cr
+$(\.{"explain\ the\ best\ way\ for\ you\ to\ proceed."})$;\cr
+\\{error};\cr}}$$
+A two-line help message would be given using \\{help2}, etc.; these informal
+helps should use simple vocabulary that complements the words used in the
+official error message that was printed. (Outside the U.S.A., the help
+messages should preferably be translated into the local vernacular. Each
+line of help is at most 60 characters long, in the present implementation,
+so that \\{max\_print\_line} will not be exceeded.)
+
+The \\{print\_err} procedure supplies a `\.!' before the official message,
+and makes sure that the terminal is awake if a stop is going to occur.
+The \\{error} procedure supplies a `\..' after the official message, then it
+shows the location of the error; and if $\\{interaction}=\\{error\_stop%
+\_mode}$,
+it also enters into a dialog with the user, during which time the help
+message may be printed.
+
+\fi
+
+\M68. The global variable \\{interaction} has four settings, representing
+increasing
+amounts of user interaction:
+
+\Y\P\D \37$\\{batch\_mode}=0$\C{omits all stops and omits terminal output}\par
+\P\D \37$\\{nonstop\_mode}=1$\C{omits all stops}\par
+\P\D \37$\\{scroll\_mode}=2$\C{omits error stops}\par
+\P\D \37$\\{error\_stop\_mode}=3$\C{stops at every opportunity to interact}\par
+\P\D \37$\\{print\_err}(\#)\S$\1\6
+\&{begin} \37\&{if} $\\{interaction}=\\{error\_stop\_mode}$ \1\&{then}\5
+\\{wake\_up\_terminal};\2\6
+$\\{print\_nl}(\.{"!\ "})$;\5
+$\\{print}(\#)$;\6
+\&{end}\2\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{interaction}: \37$\\{batch\_mode}\to\\{error\_stop\_mode}$;\C{current
+level of interaction}\par
+\fi
+
+\M69. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{interaction}\K\\{error\_stop\_mode}$;\par
+\fi
+
+\M70. \MF\ is careful not to call \\{error} when the print \\{selector} setting
+might be unusual. The only possible values of \\{selector} at the time of
+error messages are
+
+\yskip\hang\\{no\_print} (when $\\{interaction}=\\{batch\_mode}$
+and \\{log\_file} not yet open);
+
+\hang\\{term\_only} (when $\\{interaction}>\\{batch\_mode}$ and \\{log\_file}
+not yet open);
+
+\hang\\{log\_only} (when $\\{interaction}=\\{batch\_mode}$ and \\{log\_file} is
+open);
+
+\hang\\{term\_and\_log} (when $\\{interaction}>\\{batch\_mode}$ and \\{log%
+\_file} is open).
+
+\Y\P$\4\X70:Initialize the print \\{selector} based on \\{interaction}\X\S$\6
+\&{if} $\\{interaction}=\\{batch\_mode}$ \1\&{then}\5
+$\\{selector}\K\\{no\_print}$\ \&{else} $\\{selector}\K\\{term\_only}$\2\par
+\Us1023\ET1211.\fi
+
+\M71. A global variable \\{deletions\_allowed} is set \\{false} if the \\{get%
+\_next}
+routine is active when \\{error} is called; this ensures that \\{get\_next}
+will never be called recursively.
+
+The global variable \\{history} records the worst level of error that
+has been detected. It has four possible values: \\{spotless}, \\{warning%
+\_issued},
+\\{error\_message\_issued}, and \\{fatal\_error\_stop}.
+
+Another global variable, \\{error\_count}, is increased by one when an
+\\{error} occurs without an interactive dialog, and it is reset to zero at
+the end of every statement. If \\{error\_count} reaches 100, \MF\ decides
+that there is no point in continuing further.
+
+\Y\P\D \37$\\{spotless}=0$\C{\\{history} value when nothing has been amiss yet}%
+\par
+\P\D \37$\\{warning\_issued}=1$\C{\\{history} value when \\{begin\_diagnostic}
+has been called}\par
+\P\D \37$\\{error\_message\_issued}=2$\C{\\{history} value when \\{error} has
+been called}\par
+\P\D \37$\\{fatal\_error\_stop}=3$\C{\\{history} value when termination was
+premature}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{deletions\_allowed}: \37\\{boolean};\C{is it safe for \\{error} to call %
+\\{get\_next}?}\6
+\4\\{history}: \37$\\{spotless}\to\\{fatal\_error\_stop}$;\C{has the source
+input been clean so far?}\6
+\4\\{error\_count}: \37$-1\to100$;\C{the number of scrolled errors since the
+last statement ended}\par
+\fi
+
+\M72. The value of \\{history} is initially \\{fatal\_error\_stop}, but it will
+be changed to \\{spotless} if \MF\ survives the initialization process.
+
+\Y\P$\4\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{deletions\_allowed}\K\\{true}$;\5
+$\\{error\_count}\K0$;\C{\\{history} is initialized elsewhere}\par
+\fi
+
+\M73. Since errors can be detected almost anywhere in \MF, we want to declare
+the
+error procedures near the beginning of the program. But the error procedures
+in turn use some other procedures, which need to be declared \\{forward}
+before we get to \\{error} itself.
+
+It is possible for \\{error} to be called recursively if some error arises
+when \\{get\_next} is being used to delete a token, and/or if some fatal error
+occurs while \MF\ is trying to fix a non-fatal one. But such recursion
+is never more than two levels deep.
+
+\Y\P$\4\X73:Error handling procedures\X\S$\6
+\4\&{procedure}\1\ \37\\{normalize\_selector};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{get\_next};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{term\_input};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{show\_context};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{begin\_file\_reading};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{open\_log\_file};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{close\_files\_and\_terminate};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{clear\_for\_error\_prompt};\5
+\\{forward};\5
+\hbox{\2}\6
+\hbox{\4\hskip-\fontdimen2\font}\ \&{debug} \37\ \&{procedure}\1\ \37\\{debug%
+\_help};\5
+\\{forward};\ \&{gubed} \6
+\hbox{\4}\X43:Declare the procedure called \\{flush\_string}\X\par
+\As76, 77, 88, 89\ETs90.
+\U4.\fi
+
+\M74. Individual lines of help are recorded in the array \\{help\_line}, which
+contains entries in positions $0\to(\\{help\_ptr}-1)$. They should be printed
+in reverse order, i.e., with $\\{help\_line}[0]$ appearing last.
+
+\Y\P\D \37$\\{hlp1}(\#)\S\\{help\_line}[0]\K\#$;\ \&{end} \par
+\P\D \37$\\{hlp2}(\#)\S\\{help\_line}[1]\K\#$;\5
+\\{hlp1}\par
+\P\D \37$\\{hlp3}(\#)\S\\{help\_line}[2]\K\#$;\5
+\\{hlp2}\par
+\P\D \37$\\{hlp4}(\#)\S\\{help\_line}[3]\K\#$;\5
+\\{hlp3}\par
+\P\D \37$\\{hlp5}(\#)\S\\{help\_line}[4]\K\#$;\5
+\\{hlp4}\par
+\P\D \37$\\{hlp6}(\#)\S\\{help\_line}[5]\K\#$;\5
+\\{hlp5}\par
+\P\D \37$\\{help0}\S\\{help\_ptr}\K0$\C{sometimes there might be no help}\par
+\P\D \37$\\{help1}\S$\ \&{begin} \37$\\{help\_ptr}\K1$;\5
+\\{hlp1}\C{use this with one help line}\par
+\P\D \37$\\{help2}\S$\ \&{begin} \37$\\{help\_ptr}\K2$;\5
+\\{hlp2}\C{use this with two help lines}\par
+\P\D \37$\\{help3}\S$\ \&{begin} \37$\\{help\_ptr}\K3$;\5
+\\{hlp3}\C{use this with three help lines}\par
+\P\D \37$\\{help4}\S$\ \&{begin} \37$\\{help\_ptr}\K4$;\5
+\\{hlp4}\C{use this with four help lines}\par
+\P\D \37$\\{help5}\S$\ \&{begin} \37$\\{help\_ptr}\K5$;\5
+\\{hlp5}\C{use this with five help lines}\par
+\P\D \37$\\{help6}\S$\ \&{begin} \37$\\{help\_ptr}\K6$;\5
+\\{hlp6}\C{use this with six help lines}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{help\_line}: \37\&{array} $[0\to5]$ \1\&{of}\5
+\\{str\_number};\C{helps for the next \\{error}}\2\6
+\4\\{help\_ptr}: \37$0\to6$;\C{the number of help lines present}\6
+\4\\{use\_err\_help}: \37\\{boolean};\C{should the \\{err\_help} string be
+shown?}\6
+\4\\{err\_help}: \37\\{str\_number};\C{a string set up by \&{errhelp}}\par
+\fi
+
+\M75. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{help\_ptr}\K0$;\5
+$\\{use\_err\_help}\K\\{false}$;\5
+$\\{err\_help}\K0$;\par
+\fi
+
+\M76. The \\{jump\_out} procedure just cuts across all active procedure levels
+and
+goes to \\{end\_of\_MF}. This is the only nontrivial \&{goto} statement in the
+whole program. It is used when there is no recovery from a particular error.
+
+Some \PASCAL\ compilers do not implement non-local \&{goto} statements.
+In such cases the body of \\{jump\_out} should simply be
+`\\{close\_files\_and\_terminate};\thinspace' followed by a call on some system
+procedure that quietly terminates the program.
+
+\Y\P$\4\X73:Error handling procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{jump\_out};\2\6
+\&{begin} \37\&{goto} \37\\{end\_of\_MF};\6
+\&{end};\par
+\fi
+
+\M77. Here now is the general \\{error} routine.
+
+\Y\P$\4\X73:Error handling procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{error};\C{completes the job of error reporting}\6
+\4\&{label} \37$\\{continue},\39\\{exit}$;\6
+\4\&{var} \37\|c: \37\\{ASCII\_code};\C{what the user types}\6
+$\\{s1},\39\\{s2},\39\\{s3}$: \37\\{integer};\C{used to save global variables
+when deleting tokens}\6
+\|j: \37\\{pool\_pointer};\C{character position being printed}\2\6
+\&{begin} \37\&{if} $\\{history}<\\{error\_message\_issued}$ \1\&{then}\5
+$\\{history}\K\\{error\_message\_issued}$;\2\6
+$\\{print\_char}(\.{"."})$;\5
+\\{show\_context};\6
+\&{if} $\\{interaction}=\\{error\_stop\_mode}$ \1\&{then}\5
+\X78:Get user's advice and \&{return}\X;\2\6
+$\\{incr}(\\{error\_count})$;\6
+\&{if} $\\{error\_count}=100$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"(That\ makes\ 100\ errors;\ please\ try\
+again.)"})$;\5
+$\\{history}\K\\{fatal\_error\_stop}$;\5
+\\{jump\_out};\6
+\&{end};\2\6
+\X86:Put help message on the transcript file\X;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M78. \P$\X78:Get user's advice and \&{return}\X\S$\6
+\~ \1\&{loop}\ \&{begin} \37\\{continue}: \37\\{clear\_for\_error\_prompt};\5
+$\\{prompt\_input}(\.{"?\ "})$;\6
+\&{if} $\\{last}=\\{first}$ \1\&{then}\5
+\&{return};\2\6
+$\|c\K\\{buffer}[\\{first}]$;\6
+\&{if} $\|c\G\.{"a"}$ \1\&{then}\5
+$\|c\K\|c+\.{"A"}-\.{"a"}$;\C{convert to uppercase}\2\6
+\X79:Interpret code \|c and \&{return} if done\X;\6
+\&{end}\2\par
+\U77.\fi
+
+\M79. It is desirable to provide an `\.E' option here that gives the user
+an easy way to return from \MF\ to the system editor, with the offending
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+
+\Y\P$\4\X79:Interpret code \|c and \&{return} if done\X\S$\6
+\&{case} $\|c$ \1\&{of}\6
+\4$\.{"0"},\39\.{"1"},\39\.{"2"},\39\.{"3"},\39\.{"4"},\39\.{"5"},\39\.{"6"},%
+\39\.{"7"},\39\.{"8"},\39\.{"9"}$: \37\&{if} $\\{deletions\_allowed}$ \1%
+\&{then}\5
+\X83:Delete $\|c-\.{"0"}$ tokens and \&{goto} \\{continue}\X;\2\6
+\hbox{\4\4}\ \&{debug} \37\.{"D"}: \37\&{begin} \37\\{debug\_help};\5
+\&{goto} \37\\{continue};\ \&{end};\ \&{gubed}\6
+\4\.{"E"}: \37\&{if} $\\{file\_ptr}>0$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"You\ want\ to\ edit\ file\ "})$;\5
+$\\{slow\_print}(\\{input\_stack}[\\{file\_ptr}].\\{name\_field})$;\5
+$\\{print}(\.{"\ at\ line\ "})$;\5
+$\\{print\_int}(\\{line})$;\6
+$\\{interaction}\K\\{scroll\_mode}$;\5
+\\{jump\_out};\6
+\&{end};\2\6
+\4\.{"H"}: \37\X84:Print the help information and \&{goto} \\{continue}\X;\6
+\4\.{"I"}: \37\X82:Introduce new material from the terminal and \&{return}\X;\6
+\4$\.{"Q"},\39\.{"R"},\39\.{"S"}$: \37\X81:Change the interaction level and %
+\&{return}\X;\6
+\4\.{"X"}: \37\&{begin} \37$\\{interaction}\K\\{scroll\_mode}$;\5
+\\{jump\_out};\6
+\&{end};\6
+\4\&{othercases} \37\\{do\_nothing}\2\6
+\&{endcases};\6
+\X80:Print the menu of available options\X\par
+\U78.\fi
+
+\M80. \P$\X80:Print the menu of available options\X\S$\6
+\&{begin} \37$\\{print}(\.{"Type\ <return>\ to\ proceed,\ S\ to\ scroll\ future%
+\ error\ messages,"})$;\6
+$\\{print\_nl}(\.{"R\ to\ run\ without\ stopping,\ Q\ to\ run\ quietly,"})$;\6
+$\\{print\_nl}(\.{"I\ to\ insert\ something,\ "})$;\6
+\&{if} $\\{file\_ptr}>0$ \1\&{then}\5
+$\\{print}(\.{"E\ to\ edit\ your\ file,"})$;\2\6
+\&{if} $\\{deletions\_allowed}$ \1\&{then}\5
+$\\{print\_nl}(\.{"1\ or\ ...\ or\ 9\ to\ ignore\ the\ next\ 1\ to\ 9\ tokens\
+of\ input,"})$;\2\6
+$\\{print\_nl}(\.{"H\ for\ help,\ X\ to\ quit."})$;\6
+\&{end}\par
+\U79.\fi
+
+\M81. Here the author of \MF\ apologizes for making use of the numerical
+relation between \.{"Q"}, \.{"R"}, \.{"S"}, and the desired interaction
+settings
+\\{batch\_mode}, \\{nonstop\_mode}, \\{scroll\_mode}.
+
+\Y\P$\4\X81:Change the interaction level and \&{return}\X\S$\6
+\&{begin} \37$\\{error\_count}\K0$;\5
+$\\{interaction}\K\\{batch\_mode}+\|c-\.{"Q"}$;\5
+$\\{print}(\.{"OK,\ entering\ "})$;\6
+\&{case} $\|c$ \1\&{of}\6
+\4\.{"Q"}: \37\&{begin} \37$\\{print}(\.{"batchmode"})$;\5
+$\\{decr}(\\{selector})$;\6
+\&{end};\6
+\4\.{"R"}: \37$\\{print}(\.{"nonstopmode"})$;\6
+\4\.{"S"}: \37$\\{print}(\.{"scrollmode"})$;\2\6
+\&{end};\C{there are no other cases}\6
+$\\{print}(\.{"..."})$;\5
+\\{print\_ln};\5
+\\{update\_terminal};\5
+\&{return};\6
+\&{end}\par
+\U79.\fi
+
+\M82. When the following code is executed, $\\{buffer}[(\\{first}+1)\to(%
+\\{last}-1)]$ may
+contain the material inserted by the user; otherwise another prompt will
+be given. In order to understand this part of the program fully, you need
+to be familiar with \MF's input stacks.
+
+\Y\P$\4\X82:Introduce new material from the terminal and \&{return}\X\S$\6
+\&{begin} \37\\{begin\_file\_reading};\C{enter a new syntactic level for
+terminal input}\6
+\&{if} $\\{last}>\\{first}+1$ \1\&{then}\6
+\&{begin} \37$\\{loc}\K\\{first}+1$;\5
+$\\{buffer}[\\{first}]\K\.{"\ "}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{prompt\_input}(\.{"insert>"})$;\5
+$\\{loc}\K\\{first}$;\6
+\&{end};\2\6
+$\\{first}\K\\{last}+1$;\5
+$\\{cur\_input}.\\{limit\_field}\K\\{last}$;\5
+\&{return};\6
+\&{end}\par
+\U79.\fi
+
+\M83. We allow deletion of up to 99 tokens at a time.
+
+\Y\P$\4\X83:Delete $\|c-\.{"0"}$ tokens and \&{goto} \\{continue}\X\S$\6
+\&{begin} \37$\\{s1}\K\\{cur\_cmd}$;\5
+$\\{s2}\K\\{cur\_mod}$;\5
+$\\{s3}\K\\{cur\_sym}$;\5
+$\\{OK\_to\_interrupt}\K\\{false}$;\6
+\&{if} $(\\{last}>\\{first}+1)\W(\\{buffer}[\\{first}+1]\G\.{"0"})\W(%
+\\{buffer}[\\{first}+1]\L\.{"9"})$ \1\&{then}\5
+$\|c\K\|c\ast10+\\{buffer}[\\{first}+1]-\.{"0"}\ast11$\6
+\4\&{else} $\|c\K\|c-\.{"0"}$;\2\6
+\&{while} $\|c>0$ \1\&{do}\6
+\&{begin} \37\\{get\_next};\C{one-level recursive call of \\{error} is
+possible}\6
+\X743:Decrease the string reference count, if the current token is a string\X;\6
+$\\{decr}(\|c)$;\6
+\&{end};\2\6
+$\\{cur\_cmd}\K\\{s1}$;\5
+$\\{cur\_mod}\K\\{s2}$;\5
+$\\{cur\_sym}\K\\{s3}$;\5
+$\\{OK\_to\_interrupt}\K\\{true}$;\5
+$\\{help2}(\.{"I\ have\ just\ deleted\ some\ text,\ as\ you\ asked."})$\6
+$(\.{"You\ can\ now\ delete\ more,\ or\ insert,\ or\ whatever."})$;\5
+\\{show\_context};\5
+\&{goto} \37\\{continue};\6
+\&{end}\par
+\U79.\fi
+
+\M84. \P$\X84:Print the help information and \&{goto} \\{continue}\X\S$\6
+\&{begin} \37\&{if} $\\{use\_err\_help}$ \1\&{then}\6
+\&{begin} \37\X85:Print the string \\{err\_help}, possibly on several lines\X;\6
+$\\{use\_err\_help}\K\\{false}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{help\_ptr}=0$ \1\&{then}\5
+$\\{help2}(\.{"Sorry,\ I\ don\'t\ know\ how\ to\ help\ in\ this\ situation."})$%
+\2\6
+$\hbox{\kern1em}(\.{"Maybe\ you\ should\ try\ asking\ a\ human?"})$;\6
+\1\&{repeat} \37$\\{decr}(\\{help\_ptr})$;\5
+$\\{print}(\\{help\_line}[\\{help\_ptr}])$;\5
+\\{print\_ln};\6
+\4\&{until}\5
+$\\{help\_ptr}=0$;\2\6
+\&{end};\2\6
+$\\{help4}(\.{"Sorry,\ I\ already\ gave\ what\ help\ I\ could..."})$\6
+$(\.{"Maybe\ you\ should\ try\ asking\ a\ human?"})$\6
+$(\.{"An\ error\ might\ have\ occurred\ before\ I\ noticed\ any\ problems."})$\6
+$(\.{"\`\`If\ all\ else\ fails,\ read\ the\ instructions.\'\'"})$;\6
+\&{goto} \37\\{continue};\6
+\&{end}\par
+\U79.\fi
+
+\M85. \P$\X85:Print the string \\{err\_help}, possibly on several lines\X\S$\6
+$\|j\K\\{str\_start}[\\{err\_help}]$;\6
+\&{while} $\|j<\\{str\_start}[\\{err\_help}+1]$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{str\_pool}[\|j]\I\\{si}(\.{"\%"})$ \1\&{then}\5
+$\\{print}(\\{so}(\\{str\_pool}[\|j]))$\6
+\4\&{else} \&{if} $\|j+1=\\{str\_start}[\\{err\_help}+1]$ \1\&{then}\5
+\\{print\_ln}\6
+\4\&{else} \&{if} $\\{str\_pool}[\|j+1]\I\\{si}(\.{"\%"})$ \1\&{then}\5
+\\{print\_ln}\6
+\4\&{else} \&{begin} \37$\\{incr}(\|j)$;\5
+$\\{print\_char}(\.{"\%"})$;\6
+\&{end};\2\2\2\6
+$\\{incr}(\|j)$;\6
+\&{end}\2\par
+\Us84\ET86.\fi
+
+\M86. \P$\X86:Put help message on the transcript file\X\S$\6
+\&{if} $\\{interaction}>\\{batch\_mode}$ \1\&{then}\5
+$\\{decr}(\\{selector})$;\C{avoid terminal output}\2\6
+\&{if} $\\{use\_err\_help}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{""})$;\5
+\X85:Print the string \\{err\_help}, possibly on several lines\X;\6
+\&{end}\6
+\4\&{else} \&{while} $\\{help\_ptr}>0$ \1\&{do}\6
+\&{begin} \37$\\{decr}(\\{help\_ptr})$;\5
+$\\{print\_nl}(\\{help\_line}[\\{help\_ptr}])$;\6
+\&{end};\2\2\6
+\\{print\_ln};\6
+\&{if} $\\{interaction}>\\{batch\_mode}$ \1\&{then}\5
+$\\{incr}(\\{selector})$;\C{re-enable terminal output}\2\6
+\\{print\_ln}\par
+\U77.\fi
+
+\M87. In anomalous cases, the print selector might be in an unknown state;
+the following subroutine is called to fix things just enough to keep
+running a bit longer.
+
+\Y\P\4\&{procedure}\1\ \37\\{normalize\_selector};\2\6
+\&{begin} \37\&{if} $\\{log\_opened}$ \1\&{then}\5
+$\\{selector}\K\\{term\_and\_log}$\6
+\4\&{else} $\\{selector}\K\\{term\_only}$;\2\6
+\&{if} $\\{job\_name}=0$ \1\&{then}\5
+\\{open\_log\_file};\2\6
+\&{if} $\\{interaction}=\\{batch\_mode}$ \1\&{then}\5
+$\\{decr}(\\{selector})$;\2\6
+\&{end};\par
+\fi
+
+\M88. The following procedure prints \MF's last words before dying.
+
+\Y\P\D \37$\\{succumb}\S$\1\6
+\&{begin} \37\&{if} $\\{interaction}=\\{error\_stop\_mode}$ \1\&{then}\5
+$\\{interaction}\K\\{scroll\_mode}$;\C{no more interaction}\2\6
+\&{if} $\\{log\_opened}$ \1\&{then}\5
+\\{error};\2\6
+\&{debug} \37\&{if} $\\{interaction}>\\{batch\_mode}$ \1\&{then}\5
+\\{debug\_help};\2\ \&{gubed}\6
+$\\{history}\K\\{fatal\_error\_stop}$;\5
+\\{jump\_out};\C{irrecoverable error}\6
+\&{end}\2\par
+\Y\P$\4\X73:Error handling procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{fatal\_error}(\|s:\\{str\_number})$;\C{prints \|s,
+and that's it}\2\6
+\&{begin} \37\\{normalize\_selector};\6
+$\\{print\_err}(\.{"Emergency\ stop"})$;\5
+$\\{help1}(\|s)$;\5
+\\{succumb};\6
+\&{end};\par
+\fi
+
+\M89. Here is the most dreaded error message.
+
+\Y\P$\4\X73:Error handling procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{overflow}(\|s:\\{str\_number};\,\35\|n:%
+\\{integer})$;\C{stop due to finiteness}\2\6
+\&{begin} \37\\{normalize\_selector};\5
+$\\{print\_err}(\.{"METAFONT\ capacity\ exceeded,\ sorry\ ["})$;\5
+$\\{print}(\|s)$;\5
+$\\{print\_char}(\.{"="})$;\5
+$\\{print\_int}(\|n)$;\5
+$\\{print\_char}(\.{"]"})$;\5
+$\\{help2}(\.{"If\ you\ really\ absolutely\ need\ more\ capacity,"})$\6
+$(\.{"you\ can\ ask\ a\ wizard\ to\ enlarge\ me."})$;\5
+\\{succumb};\6
+\&{end};\par
+\fi
+
+\M90. The program might sometime run completely amok, at which point there is
+no choice but to stop. If no previous error has been detected, that's bad
+news; a message is printed that is really intended for the \MF\
+maintenance person instead of the user (unless the user has been
+particularly diabolical). The index entries for `this can't happen' may
+help to pinpoint the problem.
+
+\Y\P$\4\X73:Error handling procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{confusion}(\|s:\\{str\_number})$;\C{consistency
+check violated; \|s tells where}\2\6
+\&{begin} \37\\{normalize\_selector};\6
+\&{if} $\\{history}<\\{error\_message\_issued}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"This\ can\'t\ happen\ ("})$;\5
+$\\{print}(\|s)$;\5
+$\\{print\_char}(\.{")"})$;\5
+$\\{help1}(\.{"I\'m\ broken.\ Please\ show\ this\ to\ someone\ who\ can\ fix\
+can\ fix"})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"I\ can\'t\ go\ on\ meeting\ you\
+like\ this"})$;\5
+$\\{help2}(\.{"One\ of\ your\ faux\ pas\ seems\ to\ have\ wounded\ me\
+deeply..."})$\6
+$(\.{"in\ fact,\ I\'m\ barely\ conscious.\ Please\ fix\ it\ and\ try\
+again."})$;\6
+\&{end};\2\6
+\\{succumb};\6
+\&{end};\par
+\fi
+
+\M91. Users occasionally want to interrupt \MF\ while it's running.
+If the \PASCAL\ runtime system allows this, one can implement
+a routine that sets the global variable \\{interrupt} to some nonzero value
+when such an interrupt is signalled. Otherwise there is probably at least
+a way to make \\{interrupt} nonzero using the \PASCAL\ debugger.
+
+\Y\P\D \37$\\{check\_interrupt}\S$\1\6
+\&{begin} \37\&{if} $\\{interrupt}\I0$ \1\&{then}\5
+\\{pause\_for\_instructions};\2\6
+\&{end}\2\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{interrupt}: \37\\{integer};\C{should \MF\ pause for instructions?}\6
+\4\\{OK\_to\_interrupt}: \37\\{boolean};\C{should interrupts be observed?}\par
+\fi
+
+\M92. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{interrupt}\K0$;\5
+$\\{OK\_to\_interrupt}\K\\{true}$;\par
+\fi
+
+\M93. When an interrupt has been detected, the program goes into its
+highest interaction level and lets the user have the full flexibility of
+the \\{error} routine. \MF\ checks for interrupts only at times when it is
+safe to do this.
+
+\Y\P\4\&{procedure}\1\ \37\\{pause\_for\_instructions};\2\6
+\&{begin} \37\&{if} $\\{OK\_to\_interrupt}$ \1\&{then}\6
+\&{begin} \37$\\{interaction}\K\\{error\_stop\_mode}$;\6
+\&{if} $(\\{selector}=\\{log\_only})\V(\\{selector}=\\{no\_print})$ \1\&{then}\5
+$\\{incr}(\\{selector})$;\2\6
+$\\{print\_err}(\.{"Interruption"})$;\5
+$\\{help3}(\.{"You\ rang?"})$\6
+$(\.{"Try\ to\ insert\ some\ instructions\ for\ me\ (e.g.,\`I\ show\ x\'),"})$\6
+$(\.{"unless\ you\ just\ want\ to\ quit\ by\ typing\ \`X\'."})$;\5
+$\\{deletions\_allowed}\K\\{false}$;\5
+\\{error};\5
+$\\{deletions\_allowed}\K\\{true}$;\5
+$\\{interrupt}\K0$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M94. Many of \MF's error messages state that a missing token has been
+inserted behind the scenes. We can save string space and program space
+by putting this common code into a subroutine.
+
+\Y\P\4\&{procedure}\1\ \37$\\{missing\_err}(\|s:\\{str\_number})$;\2\6
+\&{begin} \37$\\{print\_err}(\.{"Missing\ \`"})$;\5
+$\\{print}(\|s)$;\5
+$\\{print}(\.{"\'\ has\ been\ inserted"})$;\6
+\&{end};\par
+\fi
+
+\N95. \[7] Arithmetic with scaled numbers.
+The principal computations performed by \MF\ are done entirely in terms of
+integers less than $2^{31}$ in magnitude; thus, the arithmetic specified in
+this
+program can be carried out in exactly the same way on a wide variety of
+computers, including some small ones.
+
+But \PASCAL\ does not define the $\mathbin{\&{div}}$
+operation in the case of negative dividends; for example, the result of
+$(-2\ast\|n-1)\mathbin{\&{div}}2$ is $-(\|n+1)$ on some computers and $-\|n$ on
+others.
+There are two principal types of arithmetic: ``translation-preserving,''
+in which the identity $(\|a+\|q\ast\|b)\mathbin{\&{div}}\|b=(\|a\mathbin{%
+\&{div}}\|b)+\|q$ is valid; and
+``negation-preserving,'' in which $(-\|a)\mathbin{\&{div}}\|b=-(\|a\mathbin{%
+\&{div}}\|b)$. This leads to
+two \MF s, which can produce different results, although the differences
+should be negligible when the language is being used properly.
+The \TeX\ processor has been defined carefully so that both varieties
+of arithmetic will produce identical output, but it would be too
+inefficient to constrain \MF\ in a similar way.
+
+\Y\P\D \37$\\{el\_gordo}\S\O{17777777777}$\C{$2^{31}-1$, the largest value that
+\MF\ likes}\par
+\fi
+
+\M96. One of \MF's most common operations is the calculation of
+$\lfloor{a+b\over2}\rfloor$,
+the midpoint of two given integers \|a and~\|b. The only decent way to do
+this in \PASCAL\ is to write `$(\|a+\|b)\mathbin{\&{div}}2$'; but on most
+machines it is
+far more efficient to calculate `$(\|a+\|b)$ right shifted one bit'.
+
+Therefore the midpoint operation will always be denoted by `$\\{half}(\|a+%
+\|b)$'
+in this program. If \MF\ is being implemented with languages that permit
+binary shifting, the \\{half} macro should be changed to make this operation
+as efficient as possible.
+
+\Y\P\D \37$\\{half}(\#)\S(\#)\mathbin{\&{div}}2$\par
+\fi
+
+\M97. A single computation might use several subroutine calls, and it is
+desirable to avoid producing multiple error messages in case of arithmetic
+overflow. So the routines below set the global variable \\{arith\_error} to %
+\\{true}
+instead of reporting errors directly to the user.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{arith\_error}: \37\\{boolean};\C{has arithmetic overflow occurred
+recently?}\par
+\fi
+
+\M98. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{arith\_error}\K\\{false}$;\par
+\fi
+
+\M99. At crucial points the program will say \\{check\_arith}, to test if
+an arithmetic error has been detected.
+
+\Y\P\D \37$\\{check\_arith}\S$\1\6
+\&{begin} \37\&{if} $\\{arith\_error}$ \1\&{then}\5
+\\{clear\_arith};\ \2\6
+\&{end}\2\par
+\Y\P\4\&{procedure}\1\ \37\\{clear\_arith};\2\6
+\&{begin} \37$\\{print\_err}(\.{"Arithmetic\ overflow"})$;\5
+$\\{help4}(\.{"Uh,\ oh.\ A\ little\ while\ ago\ one\ of\ the\ quantities\ that\
+I\ was"})$\6
+$(\.{"computing\ got\ too\ large,\ so\ I\'m\ afraid\ your\ answers\ will\
+be"})$\6
+$(\.{"somewhat\ askew.\ You\'ll\ probably\ have\ to\ adopt\ different"})$\6
+$(\.{"tactics\ next\ time.\ But\ I\ shall\ try\ to\ carry\ on\ anyway."})$;\5
+\\{error};\5
+$\\{arith\_error}\K\\{false}$;\6
+\&{end};\par
+\fi
+
+\M100. Addition is not always checked to make sure that it doesn't overflow,
+but in places where overflow isn't too unlikely the \\{slow\_add} routine
+is used.
+
+\Y\P\4\&{function}\1\ \37$\\{slow\_add}(\|x,\39\|y:\\{integer})$: \37%
+\\{integer};\2\6
+\&{begin} \37\&{if} $\|x\G0$ \1\&{then}\6
+\&{if} $\|y\L\\{el\_gordo}-\|x$ \1\&{then}\5
+$\\{slow\_add}\K\|x+\|y$\6
+\4\&{else} \&{begin} \37$\\{arith\_error}\K\\{true}$;\5
+$\\{slow\_add}\K\\{el\_gordo}$;\6
+\&{end}\2\6
+\4\&{else} \&{if} $-\|y\L\\{el\_gordo}+\|x$ \1\&{then}\5
+$\\{slow\_add}\K\|x+\|y$\6
+\4\&{else} \&{begin} \37$\\{arith\_error}\K\\{true}$;\5
+$\\{slow\_add}\K-\\{el\_gordo}$;\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M101. Fixed-point arithmetic is done on {\sl scaled integers\/} that are
+multiples
+of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit
+positions from the right end of a binary computer word.
+
+\Y\P\D \37$\\{quarter\_unit}\S\O{40000}$\C{$2^{14}$, represents 0.250000}\par
+\P\D \37$\\{half\_unit}\S\O{100000}$\C{$2^{15}$, represents 0.50000}\par
+\P\D \37$\\{three\_quarter\_unit}\S\O{140000}$\C{$3\cdot2^{14}$, represents
+0.75000}\par
+\P\D \37$\\{unity}\S\O{200000}$\C{$2^{16}$, represents 1.00000}\par
+\P\D \37$\\{two}\S\O{400000}$\C{$2^{17}$, represents 2.00000}\par
+\P\D \37$\\{three}\S\O{600000}$\C{$2^{17}+2^{16}$, represents 3.00000}\par
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{scaled}=\\{integer}$;\C{this type is used for scaled integers}\6
+$\\{small\_number}=0\to63$;\C{this type is self-explanatory}\par
+\fi
+
+\M102. The following function is used to create a scaled integer from a given
+decimal
+fraction $(.d_0d_1\ldots d_{k-1})$, where $0\L\|k\L17$. The digit $d_i$ is
+given in $\\{dig}[\|i]$, and the calculation produces a correctly rounded
+result.
+
+\Y\P\4\&{function}\1\ \37$\\{round\_decimals}(\|k:\\{small\_number})$: \37%
+\\{scaled};\C{converts a decimal fraction}\6
+\4\&{var} \37\|a: \37\\{integer};\C{the accumulator}\2\6
+\&{begin} \37$\|a\K0$;\6
+\&{while} $\|k>0$ \1\&{do}\6
+\&{begin} \37$\\{decr}(\|k)$;\5
+$\|a\K(\|a+\\{dig}[\|k]\ast\\{two})\mathbin{\&{div}}10$;\6
+\&{end};\2\6
+$\\{round\_decimals}\K\\{half}(\|a+1)$;\6
+\&{end};\par
+\fi
+
+\M103. Conversely, here is a procedure analogous to \\{print\_int}. If the
+output
+of this procedure is subsequently read by \MF\ and converted by the
+\\{round\_decimals} routine above, it turns out that the original value will
+be reproduced exactly. A decimal point is printed only if the value is
+not an integer. If there is more than one way to print the result with
+the optimum number of digits following the decimal point, the closest
+possible value is given.
+
+The invariant relation in the \&{repeat} loop is that a sequence of
+decimal digits yet to be printed will yield the original number if and only if
+they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$.
+We can stop if and only if $f=0$ satisfies this condition; the loop will
+terminate before $s$ can possibly become zero.
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_scaled}(\|s:\\{scaled})$;\C{prints scaled
+real, rounded to five digits}\6
+\4\&{var} \37\\{delta}: \37\\{scaled};\C{amount of allowable inaccuracy}\2\6
+\&{begin} \37\&{if} $\|s<0$ \1\&{then}\6
+\&{begin} \37$\\{print\_char}(\.{"-"})$;\5
+$\\{negate}(\|s)$;\C{print the sign, if negative}\6
+\&{end};\2\6
+$\\{print\_int}(\|s\mathbin{\&{div}}\\{unity})$;\C{print the integer part}\6
+$\|s\K10\ast(\|s\mathbin{\&{mod}}\\{unity})+5$;\6
+\&{if} $\|s\I5$ \1\&{then}\6
+\&{begin} \37$\\{delta}\K10$;\5
+$\\{print\_char}(\.{"."})$;\6
+\1\&{repeat} \37\&{if} $\\{delta}>\\{unity}$ \1\&{then}\5
+$\|s\K\|s+\O{100000}-(\\{delta}\mathbin{\&{div}}2)$;\C{round the final digit}\2%
+\6
+$\\{print\_char}(\.{"0"}+(\|s\mathbin{\&{div}}\\{unity}))$;\5
+$\|s\K10\ast(\|s\mathbin{\&{mod}}\\{unity})$;\5
+$\\{delta}\K\\{delta}\ast10$;\6
+\4\&{until}\5
+$\|s\L\\{delta}$;\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M104. We often want to print two scaled quantities in parentheses,
+separated by a comma.
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_two}(\|x,\39\|y:\\{scaled})$;\C{prints `$(%
+\|x,\|y)$'}\2\6
+\&{begin} \37$\\{print\_char}(\.{"("})$;\5
+$\\{print\_scaled}(\|x)$;\5
+$\\{print\_char}(\.{","})$;\5
+$\\{print\_scaled}(\|y)$;\5
+$\\{print\_char}(\.{")"})$;\6
+\&{end};\par
+\fi
+
+\M105. The \\{scaled} quantities in \MF\ programs are generally supposed to be
+less than $2^{12}$ in absolute value, so \MF\ does much of its internal
+arithmetic with 28~significant bits of precision. A \\{fraction} denotes
+a scaled integer whose binary point is assumed to be 28 bit positions
+from the right.
+
+\Y\P\D \37$\\{fraction\_half}\S\O{1000000000}$\C{$2^{27}$, represents
+0.50000000}\par
+\P\D \37$\\{fraction\_one}\S\O{2000000000}$\C{$2^{28}$, represents 1.00000000}%
+\par
+\P\D \37$\\{fraction\_two}\S\O{4000000000}$\C{$2^{29}$, represents 2.00000000}%
+\par
+\P\D \37$\\{fraction\_three}\S\O{6000000000}$\C{$3\cdot2^{28}$, represents
+3.00000000}\par
+\P\D \37$\\{fraction\_four}\S\O{10000000000}$\C{$2^{30}$, represents
+4.00000000}\par
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{fraction}=\\{integer}$;\C{this type is used for scaled fractions}\par
+\fi
+
+\M106. In fact, the two sorts of scaling discussed above aren't quite
+sufficient; \MF\ has yet another, used internally to keep track of angles
+in units of $2^{-20}$ degrees.
+
+\Y\P\D \37$\\{forty\_five\_deg}\S\O{264000000}$\C{$45\cdot2^{20}$, represents
+$45^\circ$}\par
+\P\D \37$\\{ninety\_deg}\S\O{550000000}$\C{$90\cdot2^{20}$, represents $90^%
+\circ$}\par
+\P\D \37$\\{one\_eighty\_deg}\S\O{1320000000}$\C{$180\cdot2^{20}$, represents
+$180^\circ$}\par
+\P\D \37$\\{three\_sixty\_deg}\S\O{2640000000}$\C{$360\cdot2^{20}$, represents
+$360^\circ$}\par
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{angle}=\\{integer}$;\C{this type is used for scaled angles}\par
+\fi
+
+\M107. The \\{make\_fraction} routine produces the \\{fraction} equivalent of
+$\|p/\|q$, given integers \|p and~\|q; it computes the integer
+$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are
+positive. If \|p and \|q are both of the same scaled type \|t,
+the ``type relation'' $\\{make\_fraction}(\|t,\|t)=\\{fraction}$ is valid;
+and it's also possible to use the subroutine ``backwards,'' using
+the relation $\\{make\_fraction}(\|t,\\{fraction})=\|t$ between scaled types.
+
+If the result would have magnitude $2^{31}$ or more, \\{make\_fraction}
+sets $\\{arith\_error}\K\\{true}$. Most of \MF's internal computations have
+been designed to avoid this sort of error.
+
+Notice that if 64-bit integer arithmetic were available,
+we could simply compute $(\hbox{$(2^{29}$}\ast\|p+\|q)\mathbin{\&{div}}(2\ast%
+\|q)$.
+But when we are restricted to \PASCAL's 32-bit arithmetic we
+must either resort to multiple-precision maneuvering
+or use a simple but slow iteration. The multiple-precision technique
+would be about three times faster than the code adopted here, but it
+would be comparatively long and tricky, involving about sixteen
+additional multiplications and divisions.
+
+This operation is part of \MF's ``inner loop''; indeed, it will
+consume nearly 10\pct! of the running time (exclusive of input and output)
+if the code below is left unchanged. A machine-dependent recoding
+will therefore make \MF\ run faster. The present implementation
+is highly portable, but slow; it avoids multiplication and division
+except in the initial stage. System wizards should be careful to
+replace it with a routine that is guaranteed to produce identical
+results in all cases.
+
+As noted below, a few more routines should also be replaced by
+machine-dependent
+code, for efficiency. But when a procedure is not part of the ``inner loop,''
+such changes aren't advisable; simplicity and robustness are
+preferable to trickery, unless the cost is too high.
+
+\Y\P\4\&{function}\1\ \37$\\{make\_fraction}(\|p,\39\|q:\\{integer})$: \37%
+\\{fraction};\6
+\4\&{var} \37\|f: \37\\{integer};\C{the fraction bits, with a leading 1 bit}\6
+\|n: \37\\{integer};\C{the integer part of $\vert p/q\vert$}\6
+\\{negative}: \37\\{boolean};\C{should the result be negated?}\6
+\\{be\_careful}: \37\\{integer};\C{disables certain compiler optimizations}\2\6
+\&{begin} \37\&{if} $\|p\G0$ \1\&{then}\5
+$\\{negative}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\\{negate}(\|p)$;\5
+$\\{negative}\K\\{true}$;\6
+\&{end};\2\6
+\&{if} $\|q\L0$ \1\&{then}\6
+\&{begin} \37\&{debug} \37\&{if} $\|q=0$ \1\&{then}\5
+$\\{confusion}(\.{"/"})$;\2\ \&{gubed}\6
+$\\{negate}(\|q)$;\5
+$\\{negative}\K\R\\{negative}$;\6
+\&{end};\2\6
+$\|n\K\|p\mathbin{\&{div}}\|q$;\5
+$\|p\K\|p\mathbin{\&{mod}}\|q$;\6
+\&{if} $\|n\G8$ \1\&{then}\6
+\&{begin} \37$\\{arith\_error}\K\\{true}$;\6
+\&{if} $\\{negative}$ \1\&{then}\5
+$\\{make\_fraction}\K-\\{el\_gordo}$\ \&{else} $\\{make\_fraction}\K\\{el%
+\_gordo}$;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|n\K(\|n-1)\ast\\{fraction\_one}$;\5
+\X108:Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$\X;\6
+\&{if} $\\{negative}$ \1\&{then}\5
+$\\{make\_fraction}\K-(\|f+\|n)$\ \&{else} $\\{make\_fraction}\K\|f+\|n$;\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M108. The \&{repeat} loop here preserves the following invariant relations
+between \|f, \|p, and~\|q:
+(i)~$0\L\|p<\|q$; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and
+$p_0$ is the original value of~$p$.
+
+Notice that the computation specifies
+$(\|p-\|q)+\|p$ instead of $(\|p+\|p)-\|q$, because the latter could overflow.
+Let us hope that optimizing compilers do not miss this point; a
+special variable \\{be\_careful} is used to emphasize the necessary
+order of computation. Optimizing compilers should keep \\{be\_careful}
+in a register, not store it in memory.
+
+\Y\P$\4\X108:Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$\X\S$\6
+$\|f\K1$;\6
+\1\&{repeat} \37$\\{be\_careful}\K\|p-\|q$;\5
+$\|p\K\\{be\_careful}+\|p$;\6
+\&{if} $\|p\G0$ \1\&{then}\5
+$\|f\K\|f+\|f+1$\6
+\4\&{else} \&{begin} \37$\\{double}(\|f)$;\5
+$\|p\K\|p+\|q$;\6
+\&{end};\2\6
+\4\&{until}\5
+$\|f\G\\{fraction\_one}$;\2\6
+$\\{be\_careful}\K\|p-\|q$;\6
+\&{if} $\\{be\_careful}+\|p\G0$ \1\&{then}\5
+$\\{incr}(\|f)$\2\par
+\U107.\fi
+
+\M109. The dual of \\{make\_fraction} is \\{take\_fraction}, which multiplies a
+given integer~\|q by a fraction~\|f. When the operands are positive, it
+computes $p=\lfloor qf/2^{28}+{1\over2}\rfloor$, a symmetric function
+of \|q and~\|f.
+
+This routine is even more ``inner loopy'' than \\{make\_fraction};
+the present implementation consumes almost 20\pct! of \MF's computation
+time during typical jobs, so a machine-language or 64-bit
+substitute is advisable.
+
+\Y\P\4\&{function}\1\ \37$\\{take\_fraction}(\|q:\\{integer};\,\35\|f:%
+\\{fraction})$: \37\\{integer};\6
+\4\&{var} \37\|p: \37\\{integer};\C{the fraction so far}\6
+\\{negative}: \37\\{boolean};\C{should the result be negated?}\6
+\|n: \37\\{integer};\C{additional multiple of $q$}\6
+\\{be\_careful}: \37\\{integer};\C{disables certain compiler optimizations}\2\6
+\&{begin} \37\X110:Reduce to the case that $\|f\G0$ and $\|q>0$\X;\6
+\&{if} $\|f<\\{fraction\_one}$ \1\&{then}\5
+$\|n\K0$\6
+\4\&{else} \&{begin} \37$\|n\K\|f\mathbin{\&{div}}\\{fraction\_one}$;\5
+$\|f\K\|f\mathbin{\&{mod}}\\{fraction\_one}$;\6
+\&{if} $\|q\L\\{el\_gordo}\mathbin{\&{div}}\|n$ \1\&{then}\5
+$\|n\K\|n\ast\|q$\6
+\4\&{else} \&{begin} \37$\\{arith\_error}\K\\{true}$;\5
+$\|n\K\\{el\_gordo}$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\|f\K\|f+\\{fraction\_one}$;\5
+\X111:Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$\X;\6
+$\\{be\_careful}\K\|n-\\{el\_gordo}$;\6
+\&{if} $\\{be\_careful}+\|p>0$ \1\&{then}\6
+\&{begin} \37$\\{arith\_error}\K\\{true}$;\5
+$\|n\K\\{el\_gordo}-\|p$;\6
+\&{end};\2\6
+\&{if} $\\{negative}$ \1\&{then}\5
+$\\{take\_fraction}\K-(\|n+\|p)$\6
+\4\&{else} $\\{take\_fraction}\K\|n+\|p$;\2\6
+\&{end};\par
+\fi
+
+\M110. \P$\X110:Reduce to the case that $\|f\G0$ and $\|q>0$\X\S$\6
+\&{if} $\|f\G0$ \1\&{then}\5
+$\\{negative}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\\{negate}(\|f)$;\5
+$\\{negative}\K\\{true}$;\6
+\&{end};\2\6
+\&{if} $\|q<0$ \1\&{then}\6
+\&{begin} \37$\\{negate}(\|q)$;\5
+$\\{negative}\K\R\\{negative}$;\6
+\&{end};\2\par
+\Us109\ET112.\fi
+
+\M111. The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor
+=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and
+$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$.
+
+\Y\P$\4\X111:Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$\X\S$\6
+$\|p\K\\{fraction\_half}$;\C{that's $2^{27}$; the invariants hold now with
+$k=28$}\6
+\&{if} $\|q<\\{fraction\_four}$ \1\&{then}\6
+\1\&{repeat} \37\&{if} $\\{odd}(\|f)$ \1\&{then}\5
+$\|p\K\\{half}(\|p+\|q)$\ \&{else} $\|p\K\\{half}(\|p)$;\2\6
+$\|f\K\\{half}(\|f)$;\6
+\4\&{until}\5
+$\|f=1$\2\6
+\4\&{else} \1\&{repeat} \37\&{if} $\\{odd}(\|f)$ \1\&{then}\5
+$\|p\K\|p+\\{half}(\|q-\|p)$\ \&{else} $\|p\K\\{half}(\|p)$;\2\6
+$\|f\K\\{half}(\|f)$;\6
+\4\&{until}\5
+$\|f=1$\2\2\par
+\U109.\fi
+
+\M112. When we want to multiply something by a \\{scaled} quantity, we use a
+scheme
+analogous to \\{take\_fraction} but with a different scaling.
+Given positive operands, \\{take\_scaled}
+computes the quantity $p=\lfloor qf/2^{16}+{1\over2}\rfloor$.
+
+Once again it is a good idea to use 64-bit arithmetic if
+possible; otherwise \\{take\_scaled} will use more than 2\pct! of the running
+time
+when the Computer Modern fonts are being generated.
+
+\Y\P\4\&{function}\1\ \37$\\{take\_scaled}(\|q:\\{integer};\,\35\|f:%
+\\{scaled})$: \37\\{integer};\6
+\4\&{var} \37\|p: \37\\{integer};\C{the fraction so far}\6
+\\{negative}: \37\\{boolean};\C{should the result be negated?}\6
+\|n: \37\\{integer};\C{additional multiple of $q$}\6
+\\{be\_careful}: \37\\{integer};\C{disables certain compiler optimizations}\2\6
+\&{begin} \37\X110:Reduce to the case that $\|f\G0$ and $\|q>0$\X;\6
+\&{if} $\|f<\\{unity}$ \1\&{then}\5
+$\|n\K0$\6
+\4\&{else} \&{begin} \37$\|n\K\|f\mathbin{\&{div}}\\{unity}$;\5
+$\|f\K\|f\mathbin{\&{mod}}\\{unity}$;\6
+\&{if} $\|q\L\\{el\_gordo}\mathbin{\&{div}}\|n$ \1\&{then}\5
+$\|n\K\|n\ast\|q$\6
+\4\&{else} \&{begin} \37$\\{arith\_error}\K\\{true}$;\5
+$\|n\K\\{el\_gordo}$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\|f\K\|f+\\{unity}$;\5
+\X113:Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$\X;\6
+$\\{be\_careful}\K\|n-\\{el\_gordo}$;\6
+\&{if} $\\{be\_careful}+\|p>0$ \1\&{then}\6
+\&{begin} \37$\\{arith\_error}\K\\{true}$;\5
+$\|n\K\\{el\_gordo}-\|p$;\6
+\&{end};\2\6
+\&{if} $\\{negative}$ \1\&{then}\5
+$\\{take\_scaled}\K-(\|n+\|p)$\6
+\4\&{else} $\\{take\_scaled}\K\|n+\|p$;\2\6
+\&{end};\par
+\fi
+
+\M113. \P$\X113:Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$\X\S$\6
+$\|p\K\\{half\_unit}$;\C{that's $2^{15}$; the invariants hold now with $k=16$}\6
+\&{if} $\|q<\\{fraction\_four}$ \1\&{then}\6
+\1\&{repeat} \37\&{if} $\\{odd}(\|f)$ \1\&{then}\5
+$\|p\K\\{half}(\|p+\|q)$\ \&{else} $\|p\K\\{half}(\|p)$;\2\6
+$\|f\K\\{half}(\|f)$;\6
+\4\&{until}\5
+$\|f=1$\2\6
+\4\&{else} \1\&{repeat} \37\&{if} $\\{odd}(\|f)$ \1\&{then}\5
+$\|p\K\|p+\\{half}(\|q-\|p)$\ \&{else} $\|p\K\\{half}(\|p)$;\2\6
+$\|f\K\\{half}(\|f)$;\6
+\4\&{until}\5
+$\|f=1$\2\2\par
+\U112.\fi
+
+\M114. For completeness, there's also \\{make\_scaled}, which computes a
+quotient as a \\{scaled} number instead of as a \\{fraction}.
+In other words, the result is $\lfloor2^{16}p/q+{1\over2}\rfloor$, if the
+operands are positive. \ (This procedure is not used especially often,
+so it is not part of \MF's inner loop.)
+
+\Y\P\4\&{function}\1\ \37$\\{make\_scaled}(\|p,\39\|q:\\{integer})$: \37%
+\\{scaled};\6
+\4\&{var} \37\|f: \37\\{integer};\C{the fraction bits, with a leading 1 bit}\6
+\|n: \37\\{integer};\C{the integer part of $\vert p/q\vert$}\6
+\\{negative}: \37\\{boolean};\C{should the result be negated?}\6
+\\{be\_careful}: \37\\{integer};\C{disables certain compiler optimizations}\2\6
+\&{begin} \37\&{if} $\|p\G0$ \1\&{then}\5
+$\\{negative}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\\{negate}(\|p)$;\5
+$\\{negative}\K\\{true}$;\6
+\&{end};\2\6
+\&{if} $\|q\L0$ \1\&{then}\6
+\&{begin} \37\&{debug} \37\&{if} $\|q=0$ \1\&{then}\5
+$\\{confusion}(\.{"/"})$;\ \2\6
+\&{gubed}\6
+$\\{negate}(\|q)$;\5
+$\\{negative}\K\R\\{negative}$;\6
+\&{end};\2\6
+$\|n\K\|p\mathbin{\&{div}}\|q$;\5
+$\|p\K\|p\mathbin{\&{mod}}\|q$;\6
+\&{if} $\|n\G\O{100000}$ \1\&{then}\6
+\&{begin} \37$\\{arith\_error}\K\\{true}$;\6
+\&{if} $\\{negative}$ \1\&{then}\5
+$\\{make\_scaled}\K-\\{el\_gordo}$\ \&{else} $\\{make\_scaled}\K\\{el\_gordo}$;%
+\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|n\K(\|n-1)\ast\\{unity}$;\5
+\X115:Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$\X;\6
+\&{if} $\\{negative}$ \1\&{then}\5
+$\\{make\_scaled}\K-(\|f+\|n)$\ \&{else} $\\{make\_scaled}\K\|f+\|n$;\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M115. \P$\X115:Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$\X\S$\6
+$\|f\K1$;\6
+\1\&{repeat} \37$\\{be\_careful}\K\|p-\|q$;\5
+$\|p\K\\{be\_careful}+\|p$;\6
+\&{if} $\|p\G0$ \1\&{then}\5
+$\|f\K\|f+\|f+1$\6
+\4\&{else} \&{begin} \37$\\{double}(\|f)$;\5
+$\|p\K\|p+\|q$;\6
+\&{end};\2\6
+\4\&{until}\5
+$\|f\G\\{unity}$;\2\6
+$\\{be\_careful}\K\|p-\|q$;\6
+\&{if} $\\{be\_careful}+\|p\G0$ \1\&{then}\5
+$\\{incr}(\|f)$\2\par
+\U114.\fi
+
+\M116. Here is a typical example of how the routines above can be used.
+It computes the function
+$${1\over3\tau}f(\theta,\phi)=
+{\tau^{-1}\bigl(2+\sqrt2\,(\sin\theta-{1\over16}\sin\phi)
+(\sin\phi-{1\over16}\sin\theta)(\cos\theta-\cos\phi)\bigr)\over
+3\,\bigl(1+{1\over2}(\sqrt5-1)\cos\theta+{1\over2}(3-\sqrt5\,)\cos\phi%
+\bigr)},$$
+where $\tau$ is a \\{scaled} ``tension'' parameter. This is \MF's magic
+fudge factor for placing the first control point of a curve that starts
+at an angle $\theta$ and ends at an angle $\phi$ from the straight path.
+(Actually, if the stated quantity exceeds 4, \MF\ reduces it to~4.)
+
+The trigonometric quantity to be multiplied by $\sqrt2$ is less than $\sqrt2$.
+(It's a sum of eight terms whose absolute values can be bounded using
+relations such as $\sin\theta\cos\theta\L{1\over2}$.) Thus the numerator
+is positive; and since the tension $\tau$ is constrained to be at least
+$3\over4$, the numerator is less than $16\over3$. The denominator is
+nonnegative and at most~6. Hence the fixed-point calculations below
+are guaranteed to stay within the bounds of a 32-bit computer word.
+
+The angles $\theta$ and $\phi$ are given implicitly in terms of \\{fraction}
+arguments \\{st}, \\{ct}, \\{sf}, and \\{cf}, representing $\sin\theta$, $\cos%
+\theta$,
+$\sin\phi$, and $\cos\phi$, respectively.
+
+\Y\P\4\&{function}\1\ \37$\\{velocity}(\\{st},\39\\{ct},\39\\{sf},\39\\{cf}:%
+\\{fraction};\,\35\|t:\\{scaled})$: \37\\{fraction};\6
+\4\&{var} \37$\\{acc},\39\\{num},\39\\{denom}$: \37\\{integer};\C{registers for
+intermediate calculations}\2\6
+\&{begin} \37$\\{acc}\K\\{take\_fraction}(\\{st}-(\\{sf}\mathbin{\&{div}}16),%
+\39\\{sf}-(\\{st}\mathbin{\&{div}}16))$;\5
+$\\{acc}\K\\{take\_fraction}(\\{acc},\39\\{ct}-\\{cf})$;\5
+$\\{num}\K\\{fraction\_two}+\\{take\_fraction}(\\{acc},\39379625062)$;%
+\C{$2^{28}\sqrt2\approx379625062.497$}\6
+$\\{denom}\K\\{fraction\_three}+\\{take\_fraction}(\\{ct},\39497706707)+\\{take%
+\_fraction}(\\{cf},\39307599661)$;\C{$3\cdot2^{27}\cdot(\sqrt5-1)%
+\approx497706706.78$ and $3\cdot2^{27}\cdot(3-\sqrt5\,)%
+\approx307599661.22$}\6
+\&{if} $\|t\I\\{unity}$ \1\&{then}\5
+$\\{num}\K\\{make\_scaled}(\\{num},\39\|t)$;\C{$\\{make\_scaled}(\\{fraction},%
+\\{scaled})=\\{fraction}$}\2\6
+\&{if} $\\{num}\mathbin{\&{div}}4\G\\{denom}$ \1\&{then}\5
+$\\{velocity}\K\\{fraction\_four}$\6
+\4\&{else} $\\{velocity}\K\\{make\_fraction}(\\{num},\39\\{denom})$;\2\6
+\&{end};\par
+\fi
+
+\M117. The following somewhat different subroutine tests rigorously if $ab$ is
+greater than, equal to, or less than~$cd$,
+given integers $(a,b,c,d)$. In most cases a quick decision is reached.
+The result is $+1$, 0, or~$-1$ in the three respective cases.
+
+\Y\P\D \37$\\{return\_sign}(\#)\S$\1\6
+\&{begin} \37$\\{ab\_vs\_cd}\K\#$;\5
+\&{return};\6
+\&{end}\2\par
+\Y\P\4\&{function}\1\ \37$\\{ab\_vs\_cd}(\|a,\39\|b,\39\|c,\39\|d:%
+\\{integer})$: \37\\{integer};\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37$\|q,\39\|r$: \37\\{integer};\C{temporary registers}\2\6
+\&{begin} \37\X118:Reduce to the case that $\|a,\|c\G0$, $\|b,\|d>0$\X;\6
+\~ \1\&{loop}\ \&{begin} \37$\|q\K\|a\mathbin{\&{div}}\|d$;\5
+$\|r\K\|c\mathbin{\&{div}}\|b$;\6
+\&{if} $\|q\I\|r$ \1\&{then}\6
+\&{if} $\|q>\|r$ \1\&{then}\5
+$\\{return\_sign}(1)$\ \&{else} $\\{return\_sign}(-1)$;\2\2\6
+$\|q\K\|a\mathbin{\&{mod}}\|d$;\5
+$\|r\K\|c\mathbin{\&{mod}}\|b$;\6
+\&{if} $\|r=0$ \1\&{then}\6
+\&{if} $\|q=0$ \1\&{then}\5
+$\\{return\_sign}(0)$\ \&{else} $\\{return\_sign}(1)$;\2\2\6
+\&{if} $\|q=0$ \1\&{then}\5
+$\\{return\_sign}(-1)$;\2\6
+$\|a\K\|b$;\5
+$\|b\K\|q$;\5
+$\|c\K\|d$;\5
+$\|d\K\|r$;\6
+\&{end};\C{now $\|a>\|d>0$ and $\|c>\|b>0$}\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M118. \P$\X118:Reduce to the case that $\|a,\|c\G0$, $\|b,\|d>0$\X\S$\6
+\&{if} $\|a<0$ \1\&{then}\6
+\&{begin} \37$\\{negate}(\|a)$;\5
+$\\{negate}(\|b)$;\6
+\&{end};\2\6
+\&{if} $\|c<0$ \1\&{then}\6
+\&{begin} \37$\\{negate}(\|c)$;\5
+$\\{negate}(\|d)$;\6
+\&{end};\2\6
+\&{if} $\|d\L0$ \1\&{then}\6
+\&{begin} \37\&{if} $\|b\G0$ \1\&{then}\6
+\&{if} $((\|a=0)\V(\|b=0))\W((\|c=0)\V(\|d=0))$ \1\&{then}\5
+$\\{return\_sign}(0)$\6
+\4\&{else} $\\{return\_sign}(1)$;\2\2\6
+\&{if} $\|d=0$ \1\&{then}\6
+\&{if} $\|a=0$ \1\&{then}\5
+$\\{return\_sign}(0)$\ \&{else} $\\{return\_sign}(-1)$;\2\2\6
+$\|q\K\|a$;\5
+$\|a\K\|c$;\5
+$\|c\K\|q$;\5
+$\|q\K-\|b$;\5
+$\|b\K-\|d$;\5
+$\|d\K\|q$;\6
+\&{end}\6
+\4\&{else} \&{if} $\|b\L0$ \1\&{then}\6
+\&{begin} \37\&{if} $\|b<0$ \1\&{then}\6
+\&{if} $\|a>0$ \1\&{then}\5
+$\\{return\_sign}(-1)$;\2\2\6
+\&{if} $\|c=0$ \1\&{then}\5
+$\\{return\_sign}(0)$\6
+\4\&{else} $\\{return\_sign}(-1)$;\2\6
+\&{end}\2\2\par
+\U117.\fi
+
+\M119. We conclude this set of elementary routines with some simple rounding
+and truncation operations that are coded in a machine-independent fashion.
+The routines are slightly complicated because we want them to work
+without overflow whenever $-2^{31}\L x<2^{31}$.
+
+\Y\P\4\&{function}\1\ \37$\\{floor\_scaled}(\|x:\\{scaled})$: \37\\{scaled};%
+\C{$2^{16}\lfloor x/2^{16}\rfloor$}\6
+\4\&{var} \37\\{be\_careful}: \37\\{integer};\C{temporary register}\2\6
+\&{begin} \37\&{if} $\|x\G0$ \1\&{then}\5
+$\\{floor\_scaled}\K\|x-(\|x\mathbin{\&{mod}}\\{unity})$\6
+\4\&{else} \&{begin} \37$\\{be\_careful}\K\|x+1$;\5
+$\\{floor\_scaled}\K\|x+((-\\{be\_careful})\mathbin{\&{mod}}\\{unity})+1-%
+\\{unity}$;\6
+\&{end};\2\6
+\&{end};\7
+\4\&{function}\1\ \37$\\{floor\_unscaled}(\|x:\\{scaled})$: \37\\{integer};%
+\C{$\lfloor x/2^{16}\rfloor$}\6
+\4\&{var} \37\\{be\_careful}: \37\\{integer};\C{temporary register}\2\6
+\&{begin} \37\&{if} $\|x\G0$ \1\&{then}\5
+$\\{floor\_unscaled}\K\|x\mathbin{\&{div}}\\{unity}$\6
+\4\&{else} \&{begin} \37$\\{be\_careful}\K\|x+1$;\5
+$\\{floor\_unscaled}\K-(1+((-\\{be\_careful})\mathbin{\&{div}}\\{unity}))$;\6
+\&{end};\2\6
+\&{end};\7
+\4\&{function}\1\ \37$\\{round\_unscaled}(\|x:\\{scaled})$: \37\\{integer};%
+\C{$\lfloor x/2^{16}+.5\rfloor$}\6
+\4\&{var} \37\\{be\_careful}: \37\\{integer};\C{temporary register}\2\6
+\&{begin} \37\&{if} $\|x\G\\{half\_unit}$ \1\&{then}\5
+$\\{round\_unscaled}\K1+((\|x-\\{half\_unit})\mathbin{\&{div}}\\{unity})$\6
+\4\&{else} \&{if} $\|x\G-\\{half\_unit}$ \1\&{then}\5
+$\\{round\_unscaled}\K0$\6
+\4\&{else} \&{begin} \37$\\{be\_careful}\K\|x+1$;\5
+$\\{round\_unscaled}\K-(1+((-\\{be\_careful}-\\{half\_unit})\mathbin{\&{div}}%
+\\{unity}))$;\6
+\&{end};\2\2\6
+\&{end};\7
+\4\&{function}\1\ \37$\\{round\_fraction}(\|x:\\{fraction})$: \37\\{scaled};%
+\C{$\lfloor x/2^{12}+.5\rfloor$}\6
+\4\&{var} \37\\{be\_careful}: \37\\{integer};\C{temporary register}\2\6
+\&{begin} \37\&{if} $\|x\G2048$ \1\&{then}\5
+$\\{round\_fraction}\K1+((\|x-2048)\mathbin{\&{div}}4096)$\6
+\4\&{else} \&{if} $\|x\G-2048$ \1\&{then}\5
+$\\{round\_fraction}\K0$\6
+\4\&{else} \&{begin} \37$\\{be\_careful}\K\|x+1$;\5
+$\\{round\_fraction}\K-(1+((-\\{be\_careful}-2048)\mathbin{\&{div}}4096))$;\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\N120. \[8] Algebraic and transcendental functions.
+\MF\ computes all of the necessary special functions from scratch, without
+relying on \\{real} arithmetic or system subroutines for sines, cosines, etc.
+
+\fi
+
+\M121. To get the square root of a \\{scaled} number \|x, we want to calculate
+$s=\lfloor 2^8\!\sqrt x +{1\over2}\rfloor$. If $x>0$, this is the unique
+integer such that $2^{16}x-s\L s^2<2^{16}x+s$. The following subroutine
+determines $s$ by an iterative method that maintains the invariant
+relations $x=2^{46-2k}x_0\bmod 2^{30}$, $0<y=\lfloor 2^{16-2k}x_0\rfloor
+-s^2+s\L q=2s$, where $x_0$ is the initial value of $x$. The value of~$y$
+might, however, be zero at the start of the first iteration.
+
+\Y\P\4\&{function}\1\ \37$\\{square\_rt}(\|x:\\{scaled})$: \37\\{scaled};\6
+\4\&{var} \37\|k: \37\\{small\_number};\C{iteration control counter}\6
+$\|y,\39\|q$: \37\\{integer};\C{registers for intermediate calculations}\2\6
+\&{begin} \37\&{if} $\|x\L0$ \1\&{then}\5
+\X122:Handle square root of zero or negative argument\X\6
+\4\&{else} \&{begin} \37$\|k\K23$;\5
+$\|q\K2$;\6
+\&{while} $\|x<\\{fraction\_two}$ \1\&{do}\C{i.e., \&{while} $\|x<%
+\hbox{$2^{29}$}$\unskip}\6
+\&{begin} \37$\\{decr}(\|k)$;\5
+$\|x\K\|x+\|x+\|x+\|x$;\6
+\&{end};\2\6
+\&{if} $\|x<\\{fraction\_four}$ \1\&{then}\5
+$\|y\K0$\6
+\4\&{else} \&{begin} \37$\|x\K\|x-\\{fraction\_four}$;\5
+$\|y\K1$;\6
+\&{end};\2\6
+\1\&{repeat} \37\X123:Decrease \|k by 1, maintaining the invariant relations
+between \|x, \|y, and~\|q\X;\6
+\4\&{until}\5
+$\|k=0$;\2\6
+$\\{square\_rt}\K\\{half}(\|q)$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M122. \P$\X122:Handle square root of zero or negative argument\X\S$\6
+\&{begin} \37\&{if} $\|x<0$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Square\ root\ of\ "})$;\5
+$\\{print\_scaled}(\|x)$;\5
+$\\{print}(\.{"\ has\ been\ replaced\ by\ 0"})$;\5
+$\\{help2}(\.{"Since\ I\ don\'t\ take\ square\ roots\ of\ negative\
+numbers,"})$\6
+$(\.{"I\'m\ zeroing\ this\ one.\ Proceed,\ with\ fingers\ crossed."})$;\5
+\\{error};\6
+\&{end};\2\6
+$\\{square\_rt}\K0$;\6
+\&{end}\par
+\U121.\fi
+
+\M123. \P$\X123:Decrease \|k by 1, maintaining the invariant relations between %
+\|x, \|y, and~\|q\X\S$\6
+$\\{double}(\|x)$;\5
+$\\{double}(\|y)$;\6
+\&{if} $\|x\G\\{fraction\_four}$ \1\&{then}\C{note that $\\{fraction\_four}=%
+\hbox{$2^{30}$}$}\6
+\&{begin} \37$\|x\K\|x-\\{fraction\_four}$;\5
+$\\{incr}(\|y)$;\6
+\&{end};\2\6
+$\\{double}(\|x)$;\5
+$\|y\K\|y+\|y-\|q$;\5
+$\\{double}(\|q)$;\6
+\&{if} $\|x\G\\{fraction\_four}$ \1\&{then}\6
+\&{begin} \37$\|x\K\|x-\\{fraction\_four}$;\5
+$\\{incr}(\|y)$;\6
+\&{end};\2\6
+\&{if} $\|y>\|q$ \1\&{then}\6
+\&{begin} \37$\|y\K\|y-\|q$;\5
+$\|q\K\|q+2$;\6
+\&{end}\6
+\4\&{else} \&{if} $\|y\L0$ \1\&{then}\6
+\&{begin} \37$\|q\K\|q-2$;\5
+$\|y\K\|y+\|q$;\6
+\&{end};\2\2\6
+$\\{decr}(\|k)$\par
+\U121.\fi
+
+\M124. Pythagorean addition $\psqrt{a^2+b^2}$ is implemented by an elegant
+iterative scheme due to Cleve Moler and Donald Morrison [{\sl IBM Journal
+of Research and Development\/ \bf27} (1983), 577--581]. It modifies \|a and~\|b
+in such a way that their Pythagorean sum remains invariant, while the
+smaller argument decreases.
+
+\Y\P\4\&{function}\1\ \37$\\{pyth\_add}(\|a,\39\|b:\\{integer})$: \37%
+\\{integer};\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|r: \37\\{fraction};\C{register used to transform \|a and \|b}\6
+\\{big}: \37\\{boolean};\C{is the result dangerously near $2^{31}$?}\2\6
+\&{begin} \37$\|a\K\\{abs}(\|a)$;\5
+$\|b\K\\{abs}(\|b)$;\6
+\&{if} $\|a<\|b$ \1\&{then}\6
+\&{begin} \37$\|r\K\|b$;\5
+$\|b\K\|a$;\5
+$\|a\K\|r$;\6
+\&{end};\C{now $0\L\|b\L\|a$}\2\6
+\&{if} $\|b>0$ \1\&{then}\6
+\&{begin} \37\&{if} $\|a<\\{fraction\_two}$ \1\&{then}\5
+$\\{big}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\|a\K\|a\mathbin{\&{div}}4$;\5
+$\|b\K\|b\mathbin{\&{div}}4$;\5
+$\\{big}\K\\{true}$;\6
+\&{end};\C{we reduced the precision to avoid arithmetic overflow}\2\6
+\X125:Replace \|a by an approximation to $\psqrt{a^2+b^2}$\X;\6
+\&{if} $\\{big}$ \1\&{then}\6
+\&{if} $\|a<\\{fraction\_two}$ \1\&{then}\5
+$\|a\K\|a+\|a+\|a+\|a$\6
+\4\&{else} \&{begin} \37$\\{arith\_error}\K\\{true}$;\5
+$\|a\K\\{el\_gordo}$;\6
+\&{end};\2\2\6
+\&{end};\2\6
+$\\{pyth\_add}\K\|a$;\6
+\&{end};\par
+\fi
+
+\M125. The key idea here is to reflect the vector $(a,b)$ about the
+line through $(a,b/2)$.
+
+\Y\P$\4\X125:Replace \|a by an approximation to $\psqrt{a^2+b^2}$\X\S$\6
+\~ \1\&{loop}\ \&{begin} \37$\|r\K\\{make\_fraction}(\|b,\39\|a)$;\5
+$\|r\K\\{take\_fraction}(\|r,\39\|r)$;\C{now $r\approx b^2/a^2$}\6
+\&{if} $\|r=0$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|r\K\\{make\_fraction}(\|r,\39\\{fraction\_four}+\|r)$;\5
+$\|a\K\|a+\\{take\_fraction}(\|a+\|a,\39\|r)$;\5
+$\|b\K\\{take\_fraction}(\|b,\39\|r)$;\6
+\&{end};\2\6
+\4\\{done}: \37\par
+\U124.\fi
+
+\M126. Here is a similar algorithm for $\psqrt{a^2-b^2}$.
+It converges slowly when $b$ is near $a$, but otherwise it works fine.
+
+\Y\P\4\&{function}\1\ \37$\\{pyth\_sub}(\|a,\39\|b:\\{integer})$: \37%
+\\{integer};\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|r: \37\\{fraction};\C{register used to transform \|a and \|b}\6
+\\{big}: \37\\{boolean};\C{is the input dangerously near $2^{31}$?}\2\6
+\&{begin} \37$\|a\K\\{abs}(\|a)$;\5
+$\|b\K\\{abs}(\|b)$;\6
+\&{if} $\|a\L\|b$ \1\&{then}\5
+\X128:Handle erroneous \\{pyth\_sub} and set $\|a\K0$\X\6
+\4\&{else} \&{begin} \37\&{if} $\|a<\\{fraction\_four}$ \1\&{then}\5
+$\\{big}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\|a\K\\{half}(\|a)$;\5
+$\|b\K\\{half}(\|b)$;\5
+$\\{big}\K\\{true}$;\6
+\&{end};\2\6
+\X127:Replace \|a by an approximation to $\psqrt{a^2-b^2}$\X;\6
+\&{if} $\\{big}$ \1\&{then}\5
+$\|a\K\|a+\|a$;\2\6
+\&{end};\2\6
+$\\{pyth\_sub}\K\|a$;\6
+\&{end};\par
+\fi
+
+\M127. \P$\X127:Replace \|a by an approximation to $\psqrt{a^2-b^2}$\X\S$\6
+\~ \1\&{loop}\ \&{begin} \37$\|r\K\\{make\_fraction}(\|b,\39\|a)$;\5
+$\|r\K\\{take\_fraction}(\|r,\39\|r)$;\C{now $r\approx b^2/a^2$}\6
+\&{if} $\|r=0$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|r\K\\{make\_fraction}(\|r,\39\\{fraction\_four}-\|r)$;\5
+$\|a\K\|a-\\{take\_fraction}(\|a+\|a,\39\|r)$;\5
+$\|b\K\\{take\_fraction}(\|b,\39\|r)$;\6
+\&{end};\2\6
+\4\\{done}: \37\par
+\U126.\fi
+
+\M128. \P$\X128:Handle erroneous \\{pyth\_sub} and set $\|a\K0$\X\S$\6
+\&{begin} \37\&{if} $\|a<\|b$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Pythagorean\ subtraction\ "})$;\5
+$\\{print\_scaled}(\|a)$;\5
+$\\{print}(\.{"+-+"})$;\5
+$\\{print\_scaled}(\|b)$;\5
+$\\{print}(\.{"\ has\ been\ replaced\ by\ 0"})$;\5
+$\\{help2}(\.{"Since\ I\ don\'t\ take\ square\ roots\ of\ negative\
+numbers,"})$\6
+$(\.{"I\'m\ zeroing\ this\ one.\ Proceed,\ with\ fingers\ crossed."})$;\5
+\\{error};\6
+\&{end};\2\6
+$\|a\K0$;\6
+\&{end}\par
+\U126.\fi
+
+\M129. The subroutines for logarithm and exponential involve two tables.
+The first is simple: $\\{two\_to\_the}[\|k]$ equals $2^k$. The second involves
+a bit more calculation, which the author claims to have done correctly:
+$\\{spec\_log}[\|k]$ is $2^{27}$ times $\ln\bigl(1/(1-2^{-k})\bigr)=
+2^{-k}+{1\over2}2^{-2k}+{1\over3}2^{-3k}+\cdots\,$, rounded to the
+nearest integer.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{two\_to\_the}: \37\&{array} $[0\to30]$ \1\&{of}\5
+\\{integer};\C{powers of two}\2\6
+\4\\{spec\_log}: \37\&{array} $[1\to28]$ \1\&{of}\5
+\\{integer};\C{special logarithms}\2\par
+\fi
+
+\M130. \P$\X19:Local variables for initialization\X\mathrel{+}\S$\6
+\4\|k: \37\\{integer};\C{all-purpose loop index}\par
+\fi
+
+\M131. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{two\_to\_the}[0]\K1$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}30$ \1\&{do}\5
+$\\{two\_to\_the}[\|k]\K2\ast\\{two\_to\_the}[\|k-1]$;\2\6
+$\\{spec\_log}[1]\K93032640$;\5
+$\\{spec\_log}[2]\K38612034$;\5
+$\\{spec\_log}[3]\K17922280$;\5
+$\\{spec\_log}[4]\K8662214$;\5
+$\\{spec\_log}[5]\K4261238$;\5
+$\\{spec\_log}[6]\K2113709$;\5
+$\\{spec\_log}[7]\K1052693$;\5
+$\\{spec\_log}[8]\K525315$;\5
+$\\{spec\_log}[9]\K262400$;\5
+$\\{spec\_log}[10]\K131136$;\5
+$\\{spec\_log}[11]\K65552$;\5
+$\\{spec\_log}[12]\K32772$;\5
+$\\{spec\_log}[13]\K16385$;\6
+\&{for} $\|k\K14\mathrel{\&{to}}27$ \1\&{do}\5
+$\\{spec\_log}[\|k]\K\\{two\_to\_the}[27-\|k]$;\2\6
+$\\{spec\_log}[28]\K1$;\par
+\fi
+
+\M132. Here is the routine that calculates $2^8$ times the natural logarithm
+of a \\{scaled} quantity; it is an integer approximation to $2^{24}%
+\ln(x/2^{16})$,
+when \|x is a given positive integer.
+
+The method is based on exercise 1.2.2--25 in {\sl The Art of Computer
+Programming\/}: During the main iteration we have $1\L 2^{-30}x<1/(1-2^{1-k})$,
+and the logarithm of $2^{30}x$ remains to be added to an accumulator
+register called~$y$. Three auxiliary bits of accuracy are retained in~$y$
+during the calculation, and sixteen auxiliary bits to extend \|y are
+kept in~\|z during the initial argument reduction. (We add
+$100\cdot2^{16}=6553600$ to~\|z and subtract 100 from~\|y so that \|z will
+not become negative; also, the actual amount subtracted from~\|y is~96,
+not~100, because we want to add~4 for rounding before the final division by~8.)
+
+\Y\P\4\&{function}\1\ \37$\\{m\_log}(\|x:\\{scaled})$: \37\\{scaled};\6
+\4\&{var} \37$\|y,\39\|z$: \37\\{integer};\C{auxiliary registers}\6
+\|k: \37\\{integer};\C{iteration counter}\2\6
+\&{begin} \37\&{if} $\|x\L0$ \1\&{then}\5
+\X134:Handle non-positive logarithm\X\6
+\4\&{else} \&{begin} \37$\|y\K1302456956+4-100$;\C{$14\times2^{27}\ln2%
+\approx1302456956.421063$}\6
+$\|z\K27595+6553600$;\C{and $2^{16}\times .421063\approx 27595$}\6
+\&{while} $\|x<\\{fraction\_four}$ \1\&{do}\6
+\&{begin} \37$\\{double}(\|x)$;\5
+$\|y\K\|y-93032639$;\5
+$\|z\K\|z-48782$;\6
+\&{end};\C{$2^{27}\ln2\approx 93032639.74436163$ and $2^{16}%
+\times.74436163\approx 48782$}\2\6
+$\|y\K\|y+(\|z\mathbin{\&{div}}\\{unity})$;\5
+$\|k\K2$;\6
+\&{while} $\|x>\\{fraction\_four}+4$ \1\&{do}\5
+\X133:Increase \|k until \|x can be multiplied by a factor of $2^{-k}$, and
+adjust $y$ accordingly\X;\2\6
+$\\{m\_log}\K\|y\mathbin{\&{div}}8$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M133. \P$\X133:Increase \|k until \|x can be multiplied by a factor of
+$2^{-k}$, and adjust $y$ accordingly\X\S$\6
+\&{begin} \37$\|z\K((\|x-1)\mathbin{\&{div}}\\{two\_to\_the}[\|k])+1$;\C{$z=%
+\lceil x/2^k\rceil$}\6
+\&{while} $\|x<\\{fraction\_four}+\|z$ \1\&{do}\6
+\&{begin} \37$\|z\K\\{half}(\|z+1)$;\5
+$\|k\K\|k+1$;\6
+\&{end};\2\6
+$\|y\K\|y+\\{spec\_log}[\|k]$;\5
+$\|x\K\|x-\|z$;\6
+\&{end}\par
+\U132.\fi
+
+\M134. \P$\X134:Handle non-positive logarithm\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Logarithm\ of\ "})$;\5
+$\\{print\_scaled}(\|x)$;\5
+$\\{print}(\.{"\ has\ been\ replaced\ by\ 0"})$;\5
+$\\{help2}(\.{"Since\ I\ don\'t\ take\ logs\ of\ non-positive\ numbers,"})$\6
+$(\.{"I\'m\ zeroing\ this\ one.\ Proceed,\ with\ fingers\ crossed."})$;\5
+\\{error};\5
+$\\{m\_log}\K0$;\6
+\&{end}\par
+\U132.\fi
+
+\M135. Conversely, the exponential routine calculates $\exp(x/2^8)$,
+when \|x is \\{scaled}. The result is an integer approximation to
+$2^{16}\exp(x/2^{24})$, when \|x is regarded as an integer.
+
+\Y\P\4\&{function}\1\ \37$\\{m\_exp}(\|x:\\{scaled})$: \37\\{scaled};\6
+\4\&{var} \37\|k: \37\\{small\_number};\C{loop control index}\6
+$\|y,\39\|z$: \37\\{integer};\C{auxiliary registers}\2\6
+\&{begin} \37\&{if} $\|x>174436200$ \1\&{then}\C{$2^{24}\ln((2^{31}-1)/2^{16})%
+\approx 174436199.51$}\6
+\&{begin} \37$\\{arith\_error}\K\\{true}$;\5
+$\\{m\_exp}\K\\{el\_gordo}$;\6
+\&{end}\6
+\4\&{else} \&{if} $\|x<-197694359$ \1\&{then}\5
+$\\{m\_exp}\K0$\C{$2^{24}\ln(2^{-1}/2^{16})\approx-197694359.45$}\6
+\4\&{else} \&{begin} \37\&{if} $\|x\L0$ \1\&{then}\6
+\&{begin} \37$\|z\K-8\ast\|x$;\5
+$\|y\K\O{4000000}$;\C{$y=2^{20}$}\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\|x\L127919879$ \1\&{then}\5
+$\|z\K1023359037-8\ast\|x$\C{$2^{27}\ln((2^{31}-1)/2^{20})\approx
+1023359037.125$}\6
+\4\&{else} $\|z\K8\ast(174436200-\|x)$;\C{\|z is always nonnegative}\2\6
+$\|y\K\\{el\_gordo}$;\6
+\&{end};\2\6
+\X136:Multiply \|y by $\exp(-z/2^{27})$\X;\6
+\&{if} $\|x\L127919879$ \1\&{then}\5
+$\\{m\_exp}\K(\|y+8)\mathbin{\&{div}}16$\ \&{else} $\\{m\_exp}\K\|y$;\2\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M136. The idea here is that subtracting $\\{spec\_log}[\|k]$ from \|z
+corresponds
+to multiplying \|y by $1-2^{-k}$.
+
+A subtle point (which had to be checked) was that if $x=127919879$, the
+value of~\|y will decrease so that $\|y+8$ doesn't overflow. In fact,
+$z$ will be 5 in this case, and \|y will decrease by~64 when $\|k=25$
+and by~16 when $\|k=27$.
+
+\Y\P$\4\X136:Multiply \|y by $\exp(-z/2^{27})$\X\S$\6
+$\|k\K1$;\6
+\&{while} $\|z>0$ \1\&{do}\6
+\&{begin} \37\&{while} $\|z\G\\{spec\_log}[\|k]$ \1\&{do}\6
+\&{begin} \37$\|z\K\|z-\\{spec\_log}[\|k]$;\5
+$\|y\K\|y-1-((\|y-\\{two\_to\_the}[\|k-1])\mathbin{\&{div}}\\{two\_to\_the}[%
+\|k])$;\6
+\&{end};\2\6
+$\\{incr}(\|k)$;\6
+\&{end}\2\par
+\U135.\fi
+
+\M137. The trigonometric subroutines use an auxiliary table such that
+$\\{spec\_atan}[\|k]$ contains an approximation to the \\{angle} whose tangent
+is~$1/2^k$.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{spec\_atan}: \37\&{array} $[1\to26]$ \1\&{of}\5
+\\{angle};\C{$\arctan2^{-k}$ times $2^{20}\cdot180/\pi$}\2\par
+\fi
+
+\M138. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{spec\_atan}[1]\K27855475$;\5
+$\\{spec\_atan}[2]\K14718068$;\5
+$\\{spec\_atan}[3]\K7471121$;\5
+$\\{spec\_atan}[4]\K3750058$;\5
+$\\{spec\_atan}[5]\K1876857$;\5
+$\\{spec\_atan}[6]\K938658$;\5
+$\\{spec\_atan}[7]\K469357$;\5
+$\\{spec\_atan}[8]\K234682$;\5
+$\\{spec\_atan}[9]\K117342$;\5
+$\\{spec\_atan}[10]\K58671$;\5
+$\\{spec\_atan}[11]\K29335$;\5
+$\\{spec\_atan}[12]\K14668$;\5
+$\\{spec\_atan}[13]\K7334$;\5
+$\\{spec\_atan}[14]\K3667$;\5
+$\\{spec\_atan}[15]\K1833$;\5
+$\\{spec\_atan}[16]\K917$;\5
+$\\{spec\_atan}[17]\K458$;\5
+$\\{spec\_atan}[18]\K229$;\5
+$\\{spec\_atan}[19]\K115$;\5
+$\\{spec\_atan}[20]\K57$;\5
+$\\{spec\_atan}[21]\K29$;\5
+$\\{spec\_atan}[22]\K14$;\5
+$\\{spec\_atan}[23]\K7$;\5
+$\\{spec\_atan}[24]\K4$;\5
+$\\{spec\_atan}[25]\K2$;\5
+$\\{spec\_atan}[26]\K1$;\par
+\fi
+
+\M139. Given integers \|x and \|y, not both zero, the \\{n\_arg} function
+returns the \\{angle} whose tangent points in the direction $(x,y)$.
+This subroutine first determines the correct octant, then solves the
+problem for $0\L\|y\L\|x$, then converts the result appropriately to
+return an answer in the range $-\\{one\_eighty\_deg}\L\hbox{$\theta$}\L\\{one%
+\_eighty\_deg}$.
+(The answer is $+\\{one\_eighty\_deg}$ if $\|y=0$ and $\|x<0$, but an answer of
+$-\\{one\_eighty\_deg}$ is possible if, for example, $\|y=-1$ and $x=-2^{30}$.)
+
+The octants are represented in a ``Gray code,'' since that turns out
+to be computationally simplest.
+
+\Y\P\D \37$\\{negate\_x}=1$\par
+\P\D \37$\\{negate\_y}=2$\par
+\P\D \37$\\{switch\_x\_and\_y}=4$\par
+\P\D \37$\\{first\_octant}=1$\par
+\P\D \37$\\{second\_octant}=\\{first\_octant}+\\{switch\_x\_and\_y}$\par
+\P\D \37$\\{third\_octant}=\\{first\_octant}+\\{switch\_x\_and\_y}+\\{negate%
+\_x}$\par
+\P\D \37$\\{fourth\_octant}=\\{first\_octant}+\\{negate\_x}$\par
+\P\D \37$\\{fifth\_octant}=\\{first\_octant}+\\{negate\_x}+\\{negate\_y}$\par
+\P\D \37$\\{sixth\_octant}=\\{first\_octant}+\\{switch\_x\_and\_y}+\\{negate%
+\_x}+\\{negate\_y}$\par
+\P\D \37$\\{seventh\_octant}=\\{first\_octant}+\\{switch\_x\_and\_y}+\\{negate%
+\_y}$\par
+\P\D \37$\\{eighth\_octant}=\\{first\_octant}+\\{negate\_y}$\par
+\Y\P\4\&{function}\1\ \37$\\{n\_arg}(\|x,\39\|y:\\{integer})$: \37\\{angle};\6
+\4\&{var} \37\|z: \37\\{angle};\C{auxiliary register}\6
+\|t: \37\\{integer};\C{temporary storage}\6
+\|k: \37\\{small\_number};\C{loop counter}\6
+\\{octant}: \37$\\{first\_octant}\to\\{sixth\_octant}$;\C{octant code}\2\6
+\&{begin} \37\&{if} $\|x\G0$ \1\&{then}\5
+$\\{octant}\K\\{first\_octant}$\6
+\4\&{else} \&{begin} \37$\\{negate}(\|x)$;\5
+$\\{octant}\K\\{first\_octant}+\\{negate\_x}$;\6
+\&{end};\2\6
+\&{if} $\|y<0$ \1\&{then}\6
+\&{begin} \37$\\{negate}(\|y)$;\5
+$\\{octant}\K\\{octant}+\\{negate\_y}$;\6
+\&{end};\2\6
+\&{if} $\|x<\|y$ \1\&{then}\6
+\&{begin} \37$\|t\K\|y$;\5
+$\|y\K\|x$;\5
+$\|x\K\|t$;\5
+$\\{octant}\K\\{octant}+\\{switch\_x\_and\_y}$;\6
+\&{end};\2\6
+\&{if} $\|x=0$ \1\&{then}\5
+\X140:Handle undefined arg\X\6
+\4\&{else} \&{begin} \37\X142:Set variable \|z to the arg of $(x,y)$\X;\6
+\X141:Return an appropriate answer based on \|z and \\{octant}\X;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M140. \P$\X140:Handle undefined arg\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"angle(0,0)\ is\ taken\ as\ zero"})$;\5
+$\\{help2}(\.{"The\ \`angle\'\ between\ two\ identical\ points\ is\
+undefined."})$\6
+$(\.{"I\'m\ zeroing\ this\ one.\ Proceed,\ with\ fingers\ crossed."})$;\5
+\\{error};\5
+$\\{n\_arg}\K0$;\6
+\&{end}\par
+\U139.\fi
+
+\M141. \P$\X141:Return an appropriate answer based on \|z and \\{octant}\X\S$\6
+\&{case} $\\{octant}$ \1\&{of}\6
+\4\\{first\_octant}: \37$\\{n\_arg}\K\|z$;\6
+\4\\{second\_octant}: \37$\\{n\_arg}\K\\{ninety\_deg}-\|z$;\6
+\4\\{third\_octant}: \37$\\{n\_arg}\K\\{ninety\_deg}+\|z$;\6
+\4\\{fourth\_octant}: \37$\\{n\_arg}\K\\{one\_eighty\_deg}-\|z$;\6
+\4\\{fifth\_octant}: \37$\\{n\_arg}\K\|z-\\{one\_eighty\_deg}$;\6
+\4\\{sixth\_octant}: \37$\\{n\_arg}\K-\|z-\\{ninety\_deg}$;\6
+\4\\{seventh\_octant}: \37$\\{n\_arg}\K\|z-\\{ninety\_deg}$;\6
+\4\\{eighth\_octant}: \37$\\{n\_arg}\K-\|z$;\2\6
+\&{end}\C{there are no other cases}\par
+\U139.\fi
+
+\M142. At this point we have $\|x\G\|y\G0$, and $\|x>0$. The numbers are scaled
+up
+or down until $2^{28}\L x<2^{29}$, so that accurate fixed-point calculations
+will be made.
+
+\Y\P$\4\X142:Set variable \|z to the arg of $(x,y)$\X\S$\6
+\&{while} $\|x\G\\{fraction\_two}$ \1\&{do}\6
+\&{begin} \37$\|x\K\\{half}(\|x)$;\5
+$\|y\K\\{half}(\|y)$;\6
+\&{end};\2\6
+$\|z\K0$;\6
+\&{if} $\|y>0$ \1\&{then}\6
+\&{begin} \37\&{while} $\|x<\\{fraction\_one}$ \1\&{do}\6
+\&{begin} \37$\\{double}(\|x)$;\5
+$\\{double}(\|y)$;\6
+\&{end};\2\6
+\X143:Increase \|z to the arg of $(x,y)$\X;\6
+\&{end}\2\par
+\U139.\fi
+
+\M143. During the calculations of this section, variables \|x and~\|y
+represent actual coordinates $(x,2^{-k}y)$. We will maintain the
+condition $\|x\G\|y$, so that the tangent will be at most $2^{-k}$.
+If $x<2y$, the tangent is greater than $2^{-k-1}$. The transformation
+$(a,b)\mapsto(a+b\tan\phi,b-a\tan\phi)$ replaces $(a,b)$ by
+coordinates whose angle has decreased by~$\phi$; in the special case
+$a=x$, $b=2^{-k}y$, and $\tan\phi=2^{-k-1}$, this operation reduces
+to the particularly simple iteration shown here. [Cf.~John E. Meggitt,
+{\sl IBM Journal of Research and Development\/ \bf6} (1962), 210--226.]
+
+The initial value of \|x will be multiplied by at most
+$(1+{1\over2})(1+{1\over8})(1+{1\over32})\cdots\approx 1.7584$; hence
+there is no chance of integer overflow.
+
+\Y\P$\4\X143:Increase \|z to the arg of $(x,y)$\X\S$\6
+$\|k\K0$;\6
+\1\&{repeat} \37$\\{double}(\|y)$;\5
+$\\{incr}(\|k)$;\6
+\&{if} $\|y>\|x$ \1\&{then}\6
+\&{begin} \37$\|z\K\|z+\\{spec\_atan}[\|k]$;\5
+$\|t\K\|x$;\5
+$\|x\K\|x+(\|y\mathbin{\&{div}}\\{two\_to\_the}[\|k+\|k])$;\5
+$\|y\K\|y-\|t$;\6
+\&{end};\2\6
+\4\&{until}\5
+$\|k=15$;\2\6
+\1\&{repeat} \37$\\{double}(\|y)$;\5
+$\\{incr}(\|k)$;\6
+\&{if} $\|y>\|x$ \1\&{then}\6
+\&{begin} \37$\|z\K\|z+\\{spec\_atan}[\|k]$;\5
+$\|y\K\|y-\|x$;\6
+\&{end};\2\6
+\4\&{until}\5
+$\|k=26$\2\par
+\U142.\fi
+
+\M144. Conversely, the \\{n\_sin\_cos} routine takes an \\{angle} and produces
+the sine
+and cosine of that angle. The results of this routine are
+stored in global integer variables \\{n\_sin} and \\{n\_cos}.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{n\_sin},\39\\{n\_cos}$: \37\\{fraction};\C{results computed by \\{n\_sin%
+\_cos}}\par
+\fi
+
+\M145. Given an integer \|z that is $2^{20}$ times an angle $\theta$ in
+degrees,
+the purpose of $\\{n\_sin\_cos}(\|z)$ is to set
+$\|x=\hbox{$r\cos\theta$}$ and $\|y=\hbox{$r\sin\theta$}$ (approximately),
+for some rather large number~\|r. The maximum of \|x and \|y
+will be between $2^{28}$ and $2^{30}$, so that there will be hardly
+any loss of accuracy. Then \|x and~\|y are divided by~\|r.
+
+\Y\P\4\&{procedure}\1\ \37$\\{n\_sin\_cos}(\|z:\\{angle})$;\C{computes a
+multiple of the sine and cosine}\6
+\4\&{var} \37\|k: \37\\{small\_number};\C{loop control variable}\6
+\|q: \37$0\to7$;\C{specifies the quadrant}\6
+\|r: \37\\{fraction};\C{magnitude of $(\|x,\|y)$}\6
+$\|x,\39\|y,\39\|t$: \37\\{integer};\C{temporary registers}\2\6
+\&{begin} \37\&{while} $\|z<0$ \1\&{do}\5
+$\|z\K\|z+\\{three\_sixty\_deg}$;\2\6
+$\|z\K\|z\mathbin{\&{mod}}\\{three\_sixty\_deg}$;\C{now $0\L\|z<\\{three\_sixty%
+\_deg}$}\6
+$\|q\K\|z\mathbin{\&{div}}\\{forty\_five\_deg}$;\5
+$\|z\K\|z\mathbin{\&{mod}}\\{forty\_five\_deg}$;\5
+$\|x\K\\{fraction\_one}$;\5
+$\|y\K\|x$;\6
+\&{if} $\R\\{odd}(\|q)$ \1\&{then}\5
+$\|z\K\\{forty\_five\_deg}-\|z$;\2\6
+\X147:Subtract angle \|z from $(\|x,\|y)$\X;\6
+\X146:Convert $(\|x,\|y)$ to the octant determined by~\|q\X;\6
+$\|r\K\\{pyth\_add}(\|x,\39\|y)$;\5
+$\\{n\_cos}\K\\{make\_fraction}(\|x,\39\|r)$;\5
+$\\{n\_sin}\K\\{make\_fraction}(\|y,\39\|r)$;\6
+\&{end};\par
+\fi
+
+\M146. In this case the octants are numbered sequentially.
+
+\Y\P$\4\X146:Convert $(\|x,\|y)$ to the octant determined by~\|q\X\S$\6
+\&{case} $\|q$ \1\&{of}\6
+\40: \37\\{do\_nothing};\6
+\41: \37\&{begin} \37$\|t\K\|x$;\5
+$\|x\K\|y$;\5
+$\|y\K\|t$;\6
+\&{end};\6
+\42: \37\&{begin} \37$\|t\K\|x$;\5
+$\|x\K-\|y$;\5
+$\|y\K\|t$;\6
+\&{end};\6
+\43: \37$\\{negate}(\|x)$;\6
+\44: \37\&{begin} \37$\\{negate}(\|x)$;\5
+$\\{negate}(\|y)$;\6
+\&{end};\6
+\45: \37\&{begin} \37$\|t\K\|x$;\5
+$\|x\K-\|y$;\5
+$\|y\K-\|t$;\6
+\&{end};\6
+\46: \37\&{begin} \37$\|t\K\|x$;\5
+$\|x\K\|y$;\5
+$\|y\K-\|t$;\6
+\&{end};\6
+\47: \37$\\{negate}(\|y)$;\2\6
+\&{end}\C{there are no other cases}\par
+\U145.\fi
+
+\M147. The main iteration of \\{n\_sin\_cos} is similar to that of \\{n\_arg}
+but
+applied in reverse. The values of $\\{spec\_atan}[\|k]$ decrease slowly enough
+that this loop is guaranteed to terminate before the (nonexistent) value
+$\\{spec\_atan}[27]$ would be required.
+
+\Y\P$\4\X147:Subtract angle \|z from $(\|x,\|y)$\X\S$\6
+$\|k\K1$;\6
+\&{while} $\|z>0$ \1\&{do}\6
+\&{begin} \37\&{if} $\|z\G\\{spec\_atan}[\|k]$ \1\&{then}\6
+\&{begin} \37$\|z\K\|z-\\{spec\_atan}[\|k]$;\5
+$\|t\K\|x$;\6
+$\|x\K\|t+\|y\mathbin{\&{div}}\\{two\_to\_the}[\|k]$;\5
+$\|y\K\|y-\|t\mathbin{\&{div}}\\{two\_to\_the}[\|k]$;\6
+\&{end};\2\6
+$\\{incr}(\|k)$;\6
+\&{end};\2\6
+\&{if} $\|y<0$ \1\&{then}\5
+$\|y\K0$\C{this precaution may never be needed}\2\par
+\U145.\fi
+
+\M148. And now let's complete our collection of numeric utility routines
+by considering random number generation.
+\MF\ generates pseudo-random numbers with the additive scheme recommended
+in Section 3.6 of {\sl The Art of Computer Programming}; however, the
+results are random fractions between 0 and $\\{fraction\_one}-1$, inclusive.
+
+There's an auxiliary array \\{randoms} that contains 55 pseudo-random
+fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-24})\bmod 2^{28}$,
+we generate batches of 55 new $x_n$'s at a time by calling \\{new\_randoms}.
+The global variable \\{j\_random} tells which element has most recently
+been consumed.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{randoms}: \37\&{array} $[0\to54]$ \1\&{of}\5
+\\{fraction};\C{the last 55 random values generated}\2\6
+\4\\{j\_random}: \37$0\to54$;\C{the number of unused \\{randoms}}\par
+\fi
+
+\M149. To consume a random fraction, the program below will say `\\{next%
+\_random}'
+and then it will fetch $\\{randoms}[\\{j\_random}]$. The \\{next\_random} macro
+actually accesses the numbers backwards; blocks of 55~$x$'s are
+essentially being ``flipped.'' But that doesn't make them less random.
+
+\Y\P\D \37$\\{next\_random}\S$\1\6
+\&{if} $\\{j\_random}=0$ \1\&{then}\5
+\\{new\_randoms}\6
+\4\&{else} $\\{decr}(\\{j\_random})$\2\2\par
+\Y\P\4\&{procedure}\1\ \37\\{new\_randoms};\6
+\4\&{var} \37\|k: \37$0\to54$;\C{index into \\{randoms}}\6
+\|x: \37\\{fraction};\C{accumulator}\2\6
+\&{begin} \37\&{for} $\|k\K0\mathrel{\&{to}}23$ \1\&{do}\6
+\&{begin} \37$\|x\K\\{randoms}[\|k]-\\{randoms}[\|k+31]$;\6
+\&{if} $\|x<0$ \1\&{then}\5
+$\|x\K\|x+\\{fraction\_one}$;\2\6
+$\\{randoms}[\|k]\K\|x$;\6
+\&{end};\2\6
+\&{for} $\|k\K24\mathrel{\&{to}}54$ \1\&{do}\6
+\&{begin} \37$\|x\K\\{randoms}[\|k]-\\{randoms}[\|k-24]$;\6
+\&{if} $\|x<0$ \1\&{then}\5
+$\|x\K\|x+\\{fraction\_one}$;\2\6
+$\\{randoms}[\|k]\K\|x$;\6
+\&{end};\2\6
+$\\{j\_random}\K54$;\6
+\&{end};\par
+\fi
+
+\M150. To initialize the \\{randoms} table, we call the following routine.
+
+\Y\P\4\&{procedure}\1\ \37$\\{init\_randoms}(\\{seed}:\\{scaled})$;\6
+\4\&{var} \37$\|j,\39\\{jj},\39\|k$: \37\\{fraction};\C{more or less random
+integers}\6
+\|i: \37$0\to54$;\C{index into \\{randoms}}\2\6
+\&{begin} \37$\|j\K\\{abs}(\\{seed})$;\6
+\&{while} $\|j\G\\{fraction\_one}$ \1\&{do}\5
+$\|j\K\\{half}(\|j)$;\2\6
+$\|k\K1$;\6
+\&{for} $\|i\K0\mathrel{\&{to}}54$ \1\&{do}\6
+\&{begin} \37$\\{jj}\K\|k$;\5
+$\|k\K\|j-\|k$;\5
+$\|j\K\\{jj}$;\6
+\&{if} $\|k<0$ \1\&{then}\5
+$\|k\K\|k+\\{fraction\_one}$;\2\6
+$\\{randoms}[(\|i\ast21)\mathbin{\&{mod}}55]\K\|j$;\6
+\&{end};\2\6
+\\{new\_randoms};\5
+\\{new\_randoms};\5
+\\{new\_randoms};\C{``warm up'' the array}\6
+\&{end};\par
+\fi
+
+\M151. To produce a uniform random number in the range $0\L\|u<\|x$ or $0\G\|u>%
+\|x$
+or $0=\|u=\|x$, given a \\{scaled} value~\|x, we proceed as shown here.
+
+Note that the call of \\{take\_fraction} will produce the values 0 and~\|x
+with about half the probability that it will produce any other particular
+values between 0 and~\|x, because it rounds its answers.
+
+\Y\P\4\&{function}\1\ \37$\\{unif\_rand}(\|x:\\{scaled})$: \37\\{scaled};\6
+\4\&{var} \37\|y: \37\\{scaled};\C{trial value}\2\6
+\&{begin} \37\\{next\_random};\5
+$\|y\K\\{take\_fraction}(\\{abs}(\|x),\39\\{randoms}[\\{j\_random}])$;\6
+\&{if} $\|y=\\{abs}(\|x)$ \1\&{then}\5
+$\\{unif\_rand}\K0$\6
+\4\&{else} \&{if} $\|x>0$ \1\&{then}\5
+$\\{unif\_rand}\K\|y$\6
+\4\&{else} $\\{unif\_rand}\K-\|y$;\2\2\6
+\&{end};\par
+\fi
+
+\M152. Finally, a normal deviate with mean zero and unit standard deviation
+can readily be obtained with the ratio method (Algorithm 3.4.1R in
+{\sl The Art of Computer Programming\/}).
+
+\Y\P\4\&{function}\1\ \37\\{norm\_rand}: \37\\{scaled};\6
+\4\&{var} \37$\|x,\39\|u,\39\|l$: \37\\{integer};\C{what the book would call
+$2^{16}X$, $2^{28}U$, and $-2^{24}\ln U$}\2\6
+\&{begin} \37\1\&{repeat} \37\1\&{repeat} \37\\{next\_random};\5
+$\|x\K\\{take\_fraction}(112429,\39\\{randoms}[\\{j\_random}]-\\{fraction%
+\_half})$;\C{$2^{16}\sqrt{8/e}\approx 112428.82793$}\6
+\\{next\_random};\5
+$\|u\K\\{randoms}[\\{j\_random}]$;\6
+\4\&{until}\5
+$\\{abs}(\|x)<\|u$;\2\6
+$\|x\K\\{make\_fraction}(\|x,\39\|u)$;\5
+$\|l\K139548960-\\{m\_log}(\|u)$;\C{$2^{24}\cdot12\ln2\approx139548959.6165$}\6
+\4\&{until}\5
+$\\{ab\_vs\_cd}(1024,\39\|l,\39\|x,\39\|x)\G0$;\2\6
+$\\{norm\_rand}\K\|x$;\6
+\&{end};\par
+\fi
+
+\N153. \[9] Packed data.
+In order to make efficient use of storage space, \MF\ bases its major data
+structures on a \\{memory\_word}, which contains either a (signed) integer,
+possibly scaled, or a small number of fields that are one half or one
+quarter of the size used for storing integers.
+
+If \|x is a variable of type \\{memory\_word}, it contains up to four
+fields that can be referred to as follows:
+$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr
+\|x&.\\{int}&(an \\{integer})\cr
+\|x&.\\{sc}\qquad&(a \\{scaled} integer)\cr
+\|x.\\{hh}.\\{lh}, \|x.\\{hh}&.\\{rh}&(two halfword fields)\cr
+\|x.\\{hh}.\\{b0}, \|x.\\{hh}.\\{b1}, \|x.\\{hh}&.\\{rh}&(two quarterword
+fields, one halfword
+field)\cr
+\|x.\\{qqqq}.\\{b0}, \|x.\\{qqqq}.\\{b1}, \|x.\\{qqqq}&.\\{b2}, \|x.\\{qqqq}.%
+\\{b3}\hskip-100pt
+&\qquad\qquad\qquad(four quarterword fields)\cr}}$$
+This is somewhat cumbersome to write, and not very readable either, but
+macros will be used to make the notation shorter and more transparent.
+The \PASCAL\ code below gives a formal definition of \\{memory\_word} and
+its subsidiary types, using packed variant records. \MF\ makes no
+assumptions about the relative positions of the fields within a word.
+
+Since we are assuming 32-bit integers, a halfword must contain at least
+16 bits, and a quarterword must contain at least 8 bits.
+But it doesn't hurt to have more bits; for example, with enough 36-bit
+words you might be able to have \\{mem\_max} as large as 262142.
+
+N.B.: Valuable memory space will be dreadfully wasted unless \MF\ is compiled
+by a \PASCAL\ that packs all of the \\{memory\_word} variants into
+the space of a single integer. Some \PASCAL\ compilers will pack an
+integer whose subrange is `$0\to255$' into an eight-bit field, but others
+insist on allocating space for an additional sign bit; on such systems you
+can get 256 values into a quarterword only if the subrange is `$-128\to127$'.
+
+The present implementation tries to accommodate as many variations as possible,
+so it makes few assumptions. If integers having the subrange
+`$\\{min\_quarterword}\to\\{max\_quarterword}$' can be packed into a
+quarterword,
+and if integers having the subrange `$\\{min\_halfword}\to\\{max\_halfword}$'
+can be packed into a halfword, everything should work satisfactorily.
+
+It is usually most efficient to have $\\{min\_quarterword}=\\{min%
+\_halfword}=0$,
+so one should try to achieve this unless it causes a severe problem.
+The values defined here are recommended for most 32-bit computers.
+
+\Y\P\D \37$\\{min\_quarterword}=0$\C{smallest allowable value in a %
+\\{quarterword}}\par
+\P\D \37$\\{max\_quarterword}=255$\C{largest allowable value in a %
+\\{quarterword}}\par
+\P\D \37$\\{min\_halfword}\S0$\C{smallest allowable value in a \\{halfword}}\par
+\P\D \37$\\{max\_halfword}\S65535$\C{largest allowable value in a \\{halfword}}%
+\par
+\fi
+
+\M154. Here are the inequalities that the quarterword and halfword values
+must satisfy (or rather, the inequalities that they mustn't satisfy):
+
+\Y\P$\4\X14:Check the ``constant'' values for consistency\X\mathrel{+}\S$\6
+\&{init} \37\&{if} $\\{mem\_max}\I\\{mem\_top}$ \1\&{then}\5
+$\\{bad}\K10$;\ \2\6
+\&{tini}\6
+\&{if} $\\{mem\_max}<\\{mem\_top}$ \1\&{then}\5
+$\\{bad}\K10$;\2\6
+\&{if} $(\\{min\_quarterword}>0)\V(\\{max\_quarterword}<127)$ \1\&{then}\5
+$\\{bad}\K11$;\2\6
+\&{if} $(\\{min\_halfword}>0)\V(\\{max\_halfword}<32767)$ \1\&{then}\5
+$\\{bad}\K12$;\2\6
+\&{if} $(\\{min\_quarterword}<\\{min\_halfword})\V\30(\\{max\_quarterword}>%
+\\{max\_halfword})$ \1\&{then}\5
+$\\{bad}\K13$;\2\6
+\&{if} $(\\{mem\_min}<\\{min\_halfword})\V(\\{mem\_max}\G\\{max\_halfword})$ \1%
+\&{then}\5
+$\\{bad}\K14$;\2\6
+\&{if} $\\{max\_strings}>\\{max\_halfword}$ \1\&{then}\5
+$\\{bad}\K15$;\2\6
+\&{if} $\\{buf\_size}>\\{max\_halfword}$ \1\&{then}\5
+$\\{bad}\K16$;\2\6
+\&{if} $(\\{max\_quarterword}-\\{min\_quarterword}<255)\V\30(\\{max\_halfword}-%
+\\{min\_halfword}<65535)$ \1\&{then}\5
+$\\{bad}\K17$;\2\par
+\fi
+
+\M155. The operation of subtracting \\{min\_halfword} occurs rather frequently
+in
+\MF, so it is convenient to abbreviate this operation by using the macro
+\\{ho} defined here. \MF\ will run faster with respect to compilers that
+don't optimize the expression `$\|x-0$', if this macro is simplified in the
+obvious way when $\\{min\_halfword}=0$. Similarly, \\{qi} and \\{qo} are used
+for
+input to and output from quarterwords.
+
+\Y\P\D \37$\\{ho}(\#)\S\#-\\{min\_halfword}$\C{to take a sixteen-bit item from
+a halfword}\par
+\P\D \37$\\{qo}(\#)\S\#-\\{min\_quarterword}$\C{to read eight bits from a
+quarterword}\par
+\P\D \37$\\{qi}(\#)\S\#+\\{min\_quarterword}$\C{to store eight bits in a
+quarterword}\par
+\fi
+
+\M156. The reader should study the following definitions closely:
+
+\Y\P\D \37$\\{sc}\S\\{int}$\C{\\{scaled} data is equivalent to \\{integer}}\par
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{quarterword}=\\{min\_quarterword}\to\\{max\_quarterword}$;\C{1/4 of a word}%
+\6
+$\\{halfword}=\\{min\_halfword}\to\\{max\_halfword}$;\C{1/2 of a word}\6
+$\\{two\_choices}=1\to2$;\C{used when there are two variants in a record}\6
+$\\{three\_choices}=1\to3$;\C{used when there are three variants in a record}\6
+$\\{two\_halves}=$\1\5
+\&{packed} \37\1\&{record} \37\\{rh}: \37\\{halfword};\2\6
+\&{case} $\\{two\_choices}$ \1\&{of}\6
+\41: \37$(\\{lh}:\\{halfword})$;\6
+\42: \37$(\\{b0}:\\{quarterword};\,\35\\{b1}:\\{quarterword})$;\2\6
+\&{end};\2\6
+$\\{four\_quarters}=$\1\5
+\&{packed} \37\1\&{record} \37\\{b0}: \37\\{quarterword};\6
+\4\\{b1}: \37\\{quarterword};\6
+\4\\{b2}: \37\\{quarterword};\6
+\4\\{b3}: \37\\{quarterword};\2\6
+\&{end};\2\6
+$\\{memory\_word}=$\1\5
+\1\&{record} \37\2\6
+\&{case} $\\{three\_choices}$ \1\&{of}\6
+\41: \37$(\\{int}:\\{integer})$;\6
+\42: \37$(\\{hh}:\\{two\_halves})$;\6
+\43: \37$(\\{qqqq}:\\{four\_quarters})$;\2\6
+\&{end};\2\6
+$\\{word\_file}=$\1\5
+\&{file} \1\&{of}\5
+\\{memory\_word};\2\2\par
+\fi
+
+\M157. When debugging, we may want to print a \\{memory\_word} without knowing
+what type it is; so we print it in all modes.
+
+\Y\P\&{debug} \37\&{procedure}\1\ \37$\\{print\_word}(\|w:\\{memory\_word})$;%
+\C{prints \|w in all ways}\2\6
+\&{begin} \37$\\{print\_int}(\|w.\\{int})$;\5
+$\\{print\_char}(\.{"\ "})$;\6
+$\\{print\_scaled}(\|w.\\{sc})$;\5
+$\\{print\_char}(\.{"\ "})$;\5
+$\\{print\_scaled}(\|w.\\{sc}\mathbin{\&{div}}\O{10000})$;\5
+\\{print\_ln};\6
+$\\{print\_int}(\|w.\\{hh}.\\{lh})$;\5
+$\\{print\_char}(\.{"="})$;\5
+$\\{print\_int}(\|w.\\{hh}.\\{b0})$;\5
+$\\{print\_char}(\.{":"})$;\5
+$\\{print\_int}(\|w.\\{hh}.\\{b1})$;\5
+$\\{print\_char}(\.{";"})$;\5
+$\\{print\_int}(\|w.\\{hh}.\\{rh})$;\5
+$\\{print\_char}(\.{"\ "})$;\6
+$\\{print\_int}(\|w.\\{qqqq}.\\{b0})$;\5
+$\\{print\_char}(\.{":"})$;\5
+$\\{print\_int}(\|w.\\{qqqq}.\\{b1})$;\5
+$\\{print\_char}(\.{":"})$;\5
+$\\{print\_int}(\|w.\\{qqqq}.\\{b2})$;\5
+$\\{print\_char}(\.{":"})$;\5
+$\\{print\_int}(\|w.\\{qqqq}.\\{b3})$;\6
+\&{end};\6
+\&{gubed}\par
+\fi
+
+\N158. \[10] Dynamic memory allocation.
+The \MF\ system does nearly all of its own memory allocation, so that it
+can readily be transported into environments that do not have automatic
+facilities for strings, garbage collection, etc., and so that it can be in
+control of what error messages the user receives. The dynamic storage
+requirements of \MF\ are handled by providing a large array \\{mem} in
+which consecutive blocks of words are used as nodes by the \MF\ routines.
+
+Pointer variables are indices into this array, or into another array
+called \\{eqtb} that will be explained later. A pointer variable might
+also be a special flag that lies outside the bounds of \\{mem}, so we
+allow pointers to assume any \\{halfword} value. The minimum memory
+index represents a null pointer.
+
+\Y\P\D \37$\\{pointer}\S\\{halfword}$\C{a flag or a location in \\{mem} or %
+\\{eqtb}}\par
+\P\D \37$\\{null}\S\\{mem\_min}$\C{the null pointer}\par
+\fi
+
+\M159. The \\{mem} array is divided into two regions that are allocated
+separately,
+but the dividing line between these two regions is not fixed; they grow
+together until finding their ``natural'' size in a particular job.
+Locations less than or equal to \\{lo\_mem\_max} are used for storing
+variable-length records consisting of two or more words each. This region
+is maintained using an algorithm similar to the one described in exercise
+2.5--19 of {\sl The Art of Computer Programming}. However, no size field
+appears in the allocated nodes; the program is responsible for knowing the
+relevant size when a node is freed. Locations greater than or equal to
+\\{hi\_mem\_min} are used for storing one-word records; a conventional
+\.{AVAIL} stack is used for allocation in this region.
+
+Locations of \\{mem} between \\{mem\_min} and \\{mem\_top} may be dumped as
+part
+of preloaded format files, by the \.{INIMF} preprocessor.
+Production versions of \MF\ may extend the memory at the top end in order to
+provide more space; these locations, between \\{mem\_top} and \\{mem\_max},
+are always used for single-word nodes.
+
+The key pointers that govern \\{mem} allocation have a prescribed order:
+$$\hbox{$\\{null}=\\{mem\_min}<\\{lo\_mem\_max}<\\{hi\_mem\_min}<\\{mem\_top}\L%
+\\{mem\_end}\L\\{mem\_max}$.}$$
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{mem}: \37\&{array} $[\\{mem\_min}\to\\{mem\_max}]$ \1\&{of}\5
+\\{memory\_word};\C{the big dynamic storage area}\2\6
+\4\\{lo\_mem\_max}: \37\\{pointer};\C{the largest location of variable-size
+memory in use}\6
+\4\\{hi\_mem\_min}: \37\\{pointer};\C{the smallest location of one-word memory
+in use}\par
+\fi
+
+\M160. Users who wish to study the memory requirements of specific applications
+can
+use optional special features that keep track of current and
+maximum memory usage. When code between the delimiters \&{stat} $\ldots$
+ \&{tats} is not ``commented out,'' \MF\ will run a bit slower but it will
+report these statistics when \\{tracing\_stats} is positive.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{var\_used},\39\\{dyn\_used}$: \37\\{integer};\C{how much memory is in
+use}\par
+\fi
+
+\M161. Let's consider the one-word memory region first, since it's the
+simplest. The pointer variable \\{mem\_end} holds the highest-numbered location
+of \\{mem} that has ever been used. The free locations of \\{mem} that
+occur between \\{hi\_mem\_min} and \\{mem\_end}, inclusive, are of type
+\\{two\_halves}, and we write $\\{info}(\|p)$ and $\\{link}(\|p)$ for the %
+\\{lh}
+and \\{rh} fields of $\\{mem}[\|p]$ when it is of this type. The single-word
+free locations form a linked list
+$$\\{avail},\;\hbox{$\\{link}(\\{avail})$},\;\hbox{$\\{link}(\\{link}(%
+\\{avail}))$},\;\ldots$$
+terminated by \\{null}.
+
+\Y\P\D \37$\\{link}(\#)\S\\{mem}[\#].\\{hh}.\\{rh}$\C{the \\{link} field of a
+memory word}\par
+\P\D \37$\\{info}(\#)\S\\{mem}[\#].\\{hh}.\\{lh}$\C{the \\{info} field of a
+memory word}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{avail}: \37\\{pointer};\C{head of the list of available one-word nodes}\6
+\4\\{mem\_end}: \37\\{pointer};\C{the last one-word node used in \\{mem}}\par
+\fi
+
+\M162. If one-word memory is exhausted, it might mean that the user has
+forgotten
+a token like `\&{enddef}' or `\&{endfor}'. We will define some procedures
+later that try to help pinpoint the trouble.
+
+\Y\P\hbox{\4}\X217:Declare the procedure called \\{show\_token\_list}\X\6
+\hbox{\4}\X665:Declare the procedure called \\{runaway}\X\par
+\fi
+
+\M163. The function \\{get\_avail} returns a pointer to a new one-word node
+whose
+\\{link} field is null. However, \MF\ will halt if there is no more room left.
+
+\Y\P\4\&{function}\1\ \37\\{get\_avail}: \37\\{pointer};\C{single-word node
+allocation}\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the new node being got}\2\6
+\&{begin} \37$\|p\K\\{avail}$;\C{get top location in the \\{avail} stack}\6
+\&{if} $\|p\I\\{null}$ \1\&{then}\5
+$\\{avail}\K\\{link}(\\{avail})$\C{and pop it off}\6
+\4\&{else} \&{if} $\\{mem\_end}<\\{mem\_max}$ \1\&{then}\C{or go into virgin
+territory}\6
+\&{begin} \37$\\{incr}(\\{mem\_end})$;\5
+$\|p\K\\{mem\_end}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{decr}(\\{hi\_mem\_min})$;\5
+$\|p\K\\{hi\_mem\_min}$;\6
+\&{if} $\\{hi\_mem\_min}\L\\{lo\_mem\_max}$ \1\&{then}\6
+\&{begin} \37\\{runaway};\C{if memory is exhausted, display possible runaway
+text}\6
+$\\{overflow}(\.{"main\ memory\ size"},\39\\{mem\_max}+1-\\{mem\_min})$;%
+\C{quit; all one-word nodes are busy}\6
+\&{end};\2\6
+\&{end};\2\2\6
+$\\{link}(\|p)\K\\{null}$;\C{provide an oft-desired initialization of the new
+node}\6
+\&{stat} \37$\\{incr}(\\{dyn\_used})$;\ \&{tats}\C{maintain statistics}\6
+$\\{get\_avail}\K\|p$;\6
+\&{end};\par
+\fi
+
+\M164. Conversely, a one-word node is recycled by calling \\{free\_avail}.
+
+\Y\P\D \37$\\{free\_avail}(\#)\S$\C{single-word node liberation}\6
+\&{begin} \37$\\{link}(\#)\K\\{avail}$;\5
+$\\{avail}\K\#$;\6
+\&{stat} \37$\\{decr}(\\{dyn\_used})$;\ \&{tats}\6
+\&{end}\par
+\fi
+
+\M165. There's also a \\{fast\_get\_avail} routine, which saves the
+procedure-call
+overhead at the expense of extra programming. This macro is used in
+the places that would otherwise account for the most calls of \\{get\_avail}.
+
+\Y\P\D \37$\\{fast\_get\_avail}(\#)\S\hbox{}$\6
+\&{begin} \37$\#\K\\{avail}$;\C{avoid \\{get\_avail} if possible, to save time}%
+\6
+\&{if} $\#=\\{null}$ \1\&{then}\5
+$\#\K\\{get\_avail}$\6
+\4\&{else} \&{begin} \37$\\{avail}\K\\{link}(\#)$;\5
+$\\{link}(\#)\K\\{null}$;\6
+\&{stat} \37$\\{incr}(\\{dyn\_used})$;\ \&{tats}\6
+\&{end};\2\6
+\&{end}\par
+\fi
+
+\M166. The available-space list that keeps track of the variable-size portion
+of \\{mem} is a nonempty, doubly-linked circular list of empty nodes,
+pointed to by the roving pointer \\{rover}.
+
+Each empty node has size 2 or more; the first word contains the special
+value \\{max\_halfword} in its \\{link} field and the size in its \\{info}
+field;
+the second word contains the two pointers for double linking.
+
+Each nonempty node also has size 2 or more. Its first word is of type
+\\{two\_halves}\kern-1pt, and its \\{link} field is never equal to \\{max%
+\_halfword}.
+Otherwise there is complete flexibility with respect to the contents
+of its other fields and its other words.
+
+(We require $\\{mem\_max}<\\{max\_halfword}$ because terrible things can happen
+when \\{max\_halfword} appears in the \\{link} field of a nonempty node.)
+
+\Y\P\D \37$\\{empty\_flag}\S\\{max\_halfword}$\C{the \\{link} of an empty
+variable-size node}\par
+\P\D \37$\\{is\_empty}(\#)\S(\\{link}(\#)=\\{empty\_flag})$\C{tests for empty
+node}\par
+\P\D \37$\\{node\_size}\S\\{info}$\C{the size field in empty variable-size
+nodes}\par
+\P\D \37$\\{llink}(\#)\S\\{info}(\#+1)$\C{left link in doubly-linked list of
+empty nodes}\par
+\P\D \37$\\{rlink}(\#)\S\\{link}(\#+1)$\C{right link in doubly-linked list of
+empty nodes}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{rover}: \37\\{pointer};\C{points to some node in the list of empties}\par
+\fi
+
+\M167. A call to \\{get\_node} with argument \|s returns a pointer to a new
+node
+of size~\|s, which must be 2~or more. The \\{link} field of the first word
+of this new node is set to null. An overflow stop occurs if no suitable
+space exists.
+
+If \\{get\_node} is called with $s=2^{30}$, it simply merges adjacent free
+areas and returns the value \\{max\_halfword}.
+
+\Y\P\4\&{function}\1\ \37$\\{get\_node}(\|s:\\{integer})$: \37\\{pointer};%
+\C{variable-size node allocation}\6
+\4\&{label} \37$\\{found},\39\\{exit},\39\\{restart}$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the node currently under inspection}\6
+\|q: \37\\{pointer};\C{the node physically after node \|p}\6
+\|r: \37\\{integer};\C{the newly allocated node, or a candidate for this honor}%
+\6
+$\|t,\39\\{tt}$: \37\\{integer};\C{temporary registers}\2\6
+\&{begin} \37\\{restart}: \37$\|p\K\\{rover}$;\C{start at some free node in the
+ring}\6
+\1\&{repeat} \37\X169:Try to allocate within node \|p and its physical
+successors, and \&{goto} \\{found} if allocation was possible\X;\6
+$\|p\K\\{rlink}(\|p)$;\C{move to the next node in the ring}\6
+\4\&{until}\5
+$\|p=\\{rover}$;\C{repeat until the whole list has been traversed}\2\6
+\&{if} $\|s=\O{10000000000}$ \1\&{then}\6
+\&{begin} \37$\\{get\_node}\K\\{max\_halfword}$;\5
+\&{return};\6
+\&{end};\2\6
+\&{if} $\\{lo\_mem\_max}+2<\\{hi\_mem\_min}$ \1\&{then}\6
+\&{if} $\\{lo\_mem\_max}+2\L\\{mem\_min}+\\{max\_halfword}$ \1\&{then}\5
+\X168:Grow more variable-size memory and \&{goto} \\{restart}\X;\2\2\6
+$\\{overflow}(\.{"main\ memory\ size"},\39\\{mem\_max}+1-\\{mem\_min})$;%
+\C{sorry, nothing satisfactory is left}\6
+\4\\{found}: \37$\\{link}(\|r)\K\\{null}$;\C{this node is now nonempty}\6
+\&{stat} \37$\\{var\_used}\K\\{var\_used}+\|s$;\C{maintain usage statistics}\6
+\&{tats}\6
+$\\{get\_node}\K\|r$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M168. The lower part of \\{mem} grows by 1000 words at a time, unless
+we are very close to going under. When it grows, we simply link
+a new node into the available-space list. This method of controlled
+growth helps to keep the \\{mem} usage consecutive when \MF\ is
+implemented on ``virtual memory'' systems.
+
+\Y\P$\4\X168:Grow more variable-size memory and \&{goto} \\{restart}\X\S$\6
+\&{begin} \37\&{if} $\\{hi\_mem\_min}-\\{lo\_mem\_max}\G1998$ \1\&{then}\5
+$\|t\K\\{lo\_mem\_max}+1000$\6
+\4\&{else} $\|t\K\\{lo\_mem\_max}+1+(\\{hi\_mem\_min}-\\{lo\_mem\_max})%
+\mathbin{\&{div}}2$;\C{$\\{lo\_mem\_max}+2\L\|t<\\{hi\_mem\_min}$}\2\6
+\&{if} $\|t>\\{mem\_min}+\\{max\_halfword}$ \1\&{then}\5
+$\|t\K\\{mem\_min}+\\{max\_halfword}$;\2\6
+$\|p\K\\{llink}(\\{rover})$;\5
+$\|q\K\\{lo\_mem\_max}$;\5
+$\\{rlink}(\|p)\K\|q$;\5
+$\\{llink}(\\{rover})\K\|q$;\6
+$\\{rlink}(\|q)\K\\{rover}$;\5
+$\\{llink}(\|q)\K\|p$;\5
+$\\{link}(\|q)\K\\{empty\_flag}$;\5
+$\\{node\_size}(\|q)\K\|t-\\{lo\_mem\_max}$;\6
+$\\{lo\_mem\_max}\K\|t$;\5
+$\\{link}(\\{lo\_mem\_max})\K\\{null}$;\5
+$\\{info}(\\{lo\_mem\_max})\K\\{null}$;\5
+$\\{rover}\K\|q$;\5
+\&{goto} \37\\{restart};\6
+\&{end}\par
+\U167.\fi
+
+\M169. \P$\X169:Try to allocate within node \|p and its physical successors,
+and \&{goto} \\{found} if allocation was possible\X\S$\6
+$\|q\K\|p+\\{node\_size}(\|p)$;\C{find the physical successor}\6
+\&{while} $\\{is\_empty}(\|q)$ \1\&{do}\C{merge node \|p with node \|q}\6
+\&{begin} \37$\|t\K\\{rlink}(\|q)$;\5
+$\\{tt}\K\\{llink}(\|q)$;\6
+\&{if} $\|q=\\{rover}$ \1\&{then}\5
+$\\{rover}\K\|t$;\2\6
+$\\{llink}(\|t)\K\\{tt}$;\5
+$\\{rlink}(\\{tt})\K\|t$;\6
+$\|q\K\|q+\\{node\_size}(\|q)$;\6
+\&{end};\2\6
+$\|r\K\|q-\|s$;\6
+\&{if} $\|r>\|p+1$ \1\&{then}\5
+\X170:Allocate from the top of node \|p and \&{goto} \\{found}\X;\2\6
+\&{if} $\|r=\|p$ \1\&{then}\6
+\&{if} $\\{rlink}(\|p)\I\|p$ \1\&{then}\5
+\X171:Allocate entire node \|p and \&{goto} \\{found}\X;\2\2\6
+$\\{node\_size}(\|p)\K\|q-\|p$\C{reset the size in case it grew}\par
+\U167.\fi
+
+\M170. \P$\X170:Allocate from the top of node \|p and \&{goto} \\{found}\X\S$\6
+\&{begin} \37$\\{node\_size}(\|p)\K\|r-\|p$;\C{store the remaining size}\6
+$\\{rover}\K\|p$;\C{start searching here next time}\6
+\&{goto} \37\\{found};\6
+\&{end}\par
+\U169.\fi
+
+\M171. Here we delete node \|p from the ring, and let \\{rover} rove around.
+
+\Y\P$\4\X171:Allocate entire node \|p and \&{goto} \\{found}\X\S$\6
+\&{begin} \37$\\{rover}\K\\{rlink}(\|p)$;\5
+$\|t\K\\{llink}(\|p)$;\5
+$\\{llink}(\\{rover})\K\|t$;\5
+$\\{rlink}(\|t)\K\\{rover}$;\5
+\&{goto} \37\\{found};\6
+\&{end}\par
+\U169.\fi
+
+\M172. Conversely, when some variable-size node \|p of size \|s is no longer
+needed,
+the operation $\\{free\_node}(\|p,\|s)$ will make its words available, by
+inserting
+\|p as a new empty node just before where \\{rover} now points.
+
+\Y\P\4\&{procedure}\1\ \37$\\{free\_node}(\|p:\\{pointer};\,\35\|s:%
+\\{halfword})$;\C{variable-size node liberation}\6
+\4\&{var} \37\|q: \37\\{pointer};\C{$\\{llink}(\\{rover})$}\2\6
+\&{begin} \37$\\{node\_size}(\|p)\K\|s$;\5
+$\\{link}(\|p)\K\\{empty\_flag}$;\5
+$\|q\K\\{llink}(\\{rover})$;\5
+$\\{llink}(\|p)\K\|q$;\5
+$\\{rlink}(\|p)\K\\{rover}$;\C{set both links}\6
+$\\{llink}(\\{rover})\K\|p$;\5
+$\\{rlink}(\|q)\K\|p$;\C{insert \|p into the ring}\6
+\&{stat} \37$\\{var\_used}\K\\{var\_used}-\|s$;\ \&{tats}\C{maintain
+statistics}\6
+\&{end};\par
+\fi
+
+\M173. Just before \.{INIMF} writes out the memory, it sorts the doubly linked
+available space list. The list is probably very short at such times, so a
+simple insertion sort is used. The smallest available location will be
+pointed to by \\{rover}, the next-smallest by $\\{rlink}(\\{rover})$, etc.
+
+\Y\P\&{init} \37\&{procedure}\1\ \37\\{sort\_avail};\C{sorts the available
+variable-size nodes by location}\6
+\4\&{var} \37$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{indices into \\{mem}}\6
+\\{old\_rover}: \37\\{pointer};\C{initial \\{rover} setting}\2\6
+\&{begin} \37$\|p\K\\{get\_node}(\O{10000000000})$;\C{merge adjacent free
+areas}\6
+$\|p\K\\{rlink}(\\{rover})$;\5
+$\\{rlink}(\\{rover})\K\\{max\_halfword}$;\5
+$\\{old\_rover}\K\\{rover}$;\6
+\&{while} $\|p\I\\{old\_rover}$ \1\&{do}\5
+\X174:Sort \|p into the list starting at \\{rover} and advance \|p to $%
+\\{rlink}(\|p)$\X;\2\6
+$\|p\K\\{rover}$;\6
+\&{while} $\\{rlink}(\|p)\I\\{max\_halfword}$ \1\&{do}\6
+\&{begin} \37$\\{llink}(\\{rlink}(\|p))\K\|p$;\5
+$\|p\K\\{rlink}(\|p)$;\6
+\&{end};\2\6
+$\\{rlink}(\|p)\K\\{rover}$;\5
+$\\{llink}(\\{rover})\K\|p$;\6
+\&{end};\6
+\&{tini}\par
+\fi
+
+\M174. The following \&{while} loop is guaranteed to
+terminate, since the list that starts at
+\\{rover} ends with \\{max\_halfword} during the sorting procedure.
+
+\Y\P$\4\X174:Sort \|p into the list starting at \\{rover} and advance \|p to $%
+\\{rlink}(\|p)$\X\S$\6
+\&{if} $\|p<\\{rover}$ \1\&{then}\6
+\&{begin} \37$\|q\K\|p$;\5
+$\|p\K\\{rlink}(\|q)$;\5
+$\\{rlink}(\|q)\K\\{rover}$;\5
+$\\{rover}\K\|q$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|q\K\\{rover}$;\6
+\&{while} $\\{rlink}(\|q)<\|p$ \1\&{do}\5
+$\|q\K\\{rlink}(\|q)$;\2\6
+$\|r\K\\{rlink}(\|p)$;\5
+$\\{rlink}(\|p)\K\\{rlink}(\|q)$;\5
+$\\{rlink}(\|q)\K\|p$;\5
+$\|p\K\|r$;\6
+\&{end}\2\par
+\U173.\fi
+
+\N175. \[11] Memory layout.
+Some areas of \\{mem} are dedicated to fixed usage, since static allocation is
+more efficient than dynamic allocation when we can get away with it. For
+example, locations \\{mem\_min} to $\\{mem\_min}+2$ are always used to store
+the
+specification for null pen coordinates that are `$(0,0)$'. The
+following macro definitions accomplish the static allocation by giving
+symbolic names to the fixed positions. Static variable-size nodes appear
+in locations \\{mem\_min} through \\{lo\_mem\_stat\_max}, and static
+single-word nodes
+appear in locations \\{hi\_mem\_stat\_min} through \\{mem\_top}, inclusive.
+
+\Y\P\D \37$\\{null\_coords}\S\\{mem\_min}$\C{specification for pen offsets of
+$(0,0)$}\par
+\P\D \37$\\{null\_pen}\S\\{null\_coords}+3$\C{we will define $\\{coord\_node%
+\_size}=3$}\par
+\P\D \37$\\{dep\_head}\S\\{null\_pen}+10$\C{and $\\{pen\_node\_size}=10$}\par
+\P\D \37$\\{zero\_val}\S\\{dep\_head}+2$\C{two words for a permanently zero
+value}\par
+\P\D \37$\\{temp\_val}\S\\{zero\_val}+2$\C{two words for a temporary value
+node}\par
+\P\D \37$\\{end\_attr}\S\\{temp\_val}$\C{we use $\\{end\_attr}+2$ only}\par
+\P\D \37$\\{inf\_val}\S\\{end\_attr}+2$\C{and $\\{inf\_val}+1$ only}\par
+\P\D \37$\\{bad\_vardef}\S\\{inf\_val}+2$\C{two words for \&{vardef} error
+recovery}\par
+\P\D \37$\\{lo\_mem\_stat\_max}\S\\{bad\_vardef}+1$\C{largest statically
+allocated word in the variable-size \\{mem}}\Y\par
+\P\D \37$\\{sentinel}\S\\{mem\_top}$\C{end of sorted lists}\par
+\P\D \37$\\{temp\_head}\S\\{mem\_top}-1$\C{head of a temporary list of some
+kind}\par
+\P\D \37$\\{hold\_head}\S\\{mem\_top}-2$\C{head of a temporary list of another
+kind}\par
+\P\D \37$\\{hi\_mem\_stat\_min}\S\\{mem\_top}-2$\C{smallest statically
+allocated word in the one-word \\{mem}}\par
+\fi
+
+\M176. The following code gets the dynamic part of \\{mem} off to a good start,
+when \MF\ is initializing itself the slow way.
+
+\Y\P$\4\X176:Initialize table entries (done by \.{INIMF} only)\X\S$\6
+$\\{rover}\K\\{lo\_mem\_stat\_max}+1$;\C{initialize the dynamic memory}\6
+$\\{link}(\\{rover})\K\\{empty\_flag}$;\5
+$\\{node\_size}(\\{rover})\K1000$;\C{which is a 1000-word available node}\6
+$\\{llink}(\\{rover})\K\\{rover}$;\5
+$\\{rlink}(\\{rover})\K\\{rover}$;\6
+$\\{lo\_mem\_max}\K\\{rover}+1000$;\5
+$\\{link}(\\{lo\_mem\_max})\K\\{null}$;\5
+$\\{info}(\\{lo\_mem\_max})\K\\{null}$;\6
+\&{for} $\|k\K\\{hi\_mem\_stat\_min}\mathrel{\&{to}}\\{mem\_top}$ \1\&{do}\5
+$\\{mem}[\|k]\K\\{mem}[\\{lo\_mem\_max}]$;\C{clear list heads}\2\6
+$\\{avail}\K\\{null}$;\5
+$\\{mem\_end}\K\\{mem\_top}$;\5
+$\\{hi\_mem\_min}\K\\{hi\_mem\_stat\_min}$;\C{initialize the one-word memory}\6
+$\\{var\_used}\K\\{lo\_mem\_stat\_max}+1-\\{mem\_min}$;\5
+$\\{dyn\_used}\K\\{mem\_top}+1-\\{hi\_mem\_min}$;\C{initialize statistics}\par
+\As193, 203, 229, 324, 475, 587, 702, 759, 911, 1116, 1127\ETs1185.
+\U1210.\fi
+
+\M177. The procedure $\\{flush\_list}(\|p)$ frees an entire linked list of
+one-word
+nodes that starts at a given position, until coming to \\{sentinel} or a
+pointer that is not in the one-word region. Another procedure,
+\\{flush\_node\_list}, frees an entire linked list of one-word and two-word
+nodes, until coming to a \\{null} pointer.
+
+\Y\P\4\&{procedure}\1\ \37$\\{flush\_list}(\|p:\\{pointer})$;\C{makes list of
+single-word nodes available}\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37$\|q,\39\|r$: \37\\{pointer};\C{list traversers}\2\6
+\&{begin} \37\&{if} $\|p\G\\{hi\_mem\_min}$ \1\&{then}\6
+\&{if} $\|p\I\\{sentinel}$ \1\&{then}\6
+\&{begin} \37$\|r\K\|p$;\6
+\1\&{repeat} \37$\|q\K\|r$;\5
+$\|r\K\\{link}(\|r)$;\6
+\&{stat} \37$\\{decr}(\\{dyn\_used})$;\ \&{tats}\6
+\&{if} $\|r<\\{hi\_mem\_min}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\4\&{until}\5
+$\|r=\\{sentinel}$;\2\6
+\4\\{done}: \37\C{now \|q is the last node on the list}\6
+$\\{link}(\|q)\K\\{avail}$;\5
+$\\{avail}\K\|p$;\6
+\&{end};\2\2\6
+\&{end};\7
+\4\&{procedure}\1\ \37$\\{flush\_node\_list}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the node being recycled}\2\6
+\&{begin} \37\&{while} $\|p\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\|q\K\|p$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{if} $\|q<\\{hi\_mem\_min}$ \1\&{then}\5
+$\\{free\_node}(\|q,\392)$\ \&{else} $\\{free\_avail}(\|q)$;\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M178. If \MF\ is extended improperly, the \\{mem} array might get screwed up.
+For example, some pointers might be wrong, or some ``dead'' nodes might not
+have been freed when the last reference to them disappeared. Procedures
+\\{check\_mem} and \\{search\_mem} are available to help diagnose such
+problems. These procedures make use of two arrays called \\{free} and
+\\{was\_free} that are present only if \MF's debugging routines have
+been included. (You may want to decrease the size of \\{mem} while you
+are debugging.)
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\&{debug} \37\\{free}: \37\&{packed} \37\&{array} $[\\{mem\_min}\to\\{mem%
+\_max}]$ \1\&{of}\5
+\\{boolean};\C{free cells}\2\6
+\4\hbox{\hskip1em}\\{was\_free}: \37\&{packed} \37\&{array} $[\\{mem\_min}\to%
+\\{mem\_max}]$ \1\&{of}\5
+\\{boolean};\C{previously free cells}\2\6
+\4$\hbox{\hskip1em}\\{was\_mem\_end},\39\\{was\_lo\_max},\39\\{was\_hi\_min}$: %
+\37\\{pointer};\C{previous \\{mem\_end}, \\{lo\_mem\_max}, and \\{hi\_mem%
+\_min}}\6
+\4\hbox{\hskip1em}\\{panicking}: \37\\{boolean};\C{do we want to check memory
+constantly?}\6
+\&{gubed}\par
+\fi
+
+\M179. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+\&{debug} \37$\\{was\_mem\_end}\K\\{mem\_min}$;\C{indicate that everything was
+previously free}\6
+$\\{was\_lo\_max}\K\\{mem\_min}$;\5
+$\\{was\_hi\_min}\K\\{mem\_max}$;\5
+$\\{panicking}\K\\{false}$;\6
+\&{gubed}\par
+\fi
+
+\M180. Procedure \\{check\_mem} makes sure that the available space lists of
+\\{mem} are well formed, and it optionally prints out all locations
+that are reserved now but were free the last time this procedure was called.
+
+\Y\P\&{debug} \37\&{procedure}\1\ \37$\\{check\_mem}(\\{print\_locs}:%
+\\{boolean})$;\6
+\4\&{label} \37$\\{done1},\39\\{done2}$;\C{loop exits}\6
+\4\&{var} \37$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{current locations of
+interest in \\{mem}}\6
+\\{clobbered}: \37\\{boolean};\C{is something amiss?}\2\6
+\&{begin} \37\&{for} $\|p\K\\{mem\_min}\mathrel{\&{to}}\\{lo\_mem\_max}$ \1%
+\&{do}\5
+$\\{free}[\|p]\K\\{false}$;\C{you can probably do this faster}\2\6
+\&{for} $\|p\K\\{hi\_mem\_min}\mathrel{\&{to}}\\{mem\_end}$ \1\&{do}\5
+$\\{free}[\|p]\K\\{false}$;\C{ditto}\2\6
+\X181:Check single-word \\{avail} list\X;\6
+\X182:Check variable-size \\{avail} list\X;\6
+\X183:Check flags of unavailable nodes\X;\6
+\X617:Check the list of linear dependencies\X;\6
+\&{if} $\\{print\_locs}$ \1\&{then}\5
+\X184:Print newly busy locations\X;\2\6
+\&{for} $\|p\K\\{mem\_min}\mathrel{\&{to}}\\{lo\_mem\_max}$ \1\&{do}\5
+$\\{was\_free}[\|p]\K\\{free}[\|p]$;\2\6
+\&{for} $\|p\K\\{hi\_mem\_min}\mathrel{\&{to}}\\{mem\_end}$ \1\&{do}\5
+$\\{was\_free}[\|p]\K\\{free}[\|p]$;\C{$\\{was\_free}\K\\{free}$ might be
+faster}\2\6
+$\\{was\_mem\_end}\K\\{mem\_end}$;\5
+$\\{was\_lo\_max}\K\\{lo\_mem\_max}$;\5
+$\\{was\_hi\_min}\K\\{hi\_mem\_min}$;\6
+\&{end};\6
+\&{gubed}\par
+\fi
+
+\M181. \P$\X181:Check single-word \\{avail} list\X\S$\6
+$\|p\K\\{avail}$;\5
+$\|q\K\\{null}$;\5
+$\\{clobbered}\K\\{false}$;\6
+\&{while} $\|p\I\\{null}$ \1\&{do}\6
+\&{begin} \37\&{if} $(\|p>\\{mem\_end})\V(\|p<\\{hi\_mem\_min})$ \1\&{then}\5
+$\\{clobbered}\K\\{true}$\6
+\4\&{else} \&{if} $\\{free}[\|p]$ \1\&{then}\5
+$\\{clobbered}\K\\{true}$;\2\2\6
+\&{if} $\\{clobbered}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"AVAIL\ list\ clobbered\ at\ "})$;\5
+$\\{print\_int}(\|q)$;\5
+\&{goto} \37\\{done1};\6
+\&{end};\2\6
+$\\{free}[\|p]\K\\{true}$;\5
+$\|q\K\|p$;\5
+$\|p\K\\{link}(\|q)$;\6
+\&{end};\2\6
+\4\\{done1}: \37\par
+\U180.\fi
+
+\M182. \P$\X182:Check variable-size \\{avail} list\X\S$\6
+$\|p\K\\{rover}$;\5
+$\|q\K\\{null}$;\5
+$\\{clobbered}\K\\{false}$;\6
+\1\&{repeat} \37\&{if} $(\|p\G\\{lo\_mem\_max})\V(\|p<\\{mem\_min})$ \1\&{then}%
+\5
+$\\{clobbered}\K\\{true}$\6
+\4\&{else} \&{if} $(\\{rlink}(\|p)\G\\{lo\_mem\_max})\V(\\{rlink}(\|p)<\\{mem%
+\_min})$ \1\&{then}\5
+$\\{clobbered}\K\\{true}$\6
+\4\&{else} \&{if} $\R(\\{is\_empty}(\|p))\V(\\{node\_size}(\|p)<2)\V\30(\|p+%
+\\{node\_size}(\|p)>\\{lo\_mem\_max})\V\30(\\{llink}(\\{rlink}(\|p))\I\|p)$ \1%
+\&{then}\5
+$\\{clobbered}\K\\{true}$;\2\2\2\6
+\&{if} $\\{clobbered}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"Double-AVAIL\ list\ clobbered\ at\ "})$;\5
+$\\{print\_int}(\|q)$;\5
+\&{goto} \37\\{done2};\6
+\&{end};\2\6
+\&{for} $\|q\K\|p\mathrel{\&{to}}\|p+\\{node\_size}(\|p)-1$ \1\&{do}\C{mark all
+locations free}\6
+\&{begin} \37\&{if} $\\{free}[\|q]$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"Doubly\ free\ location\ at\ "})$;\5
+$\\{print\_int}(\|q)$;\5
+\&{goto} \37\\{done2};\6
+\&{end};\2\6
+$\\{free}[\|q]\K\\{true}$;\6
+\&{end};\2\6
+$\|q\K\|p$;\5
+$\|p\K\\{rlink}(\|p)$;\6
+\4\&{until}\5
+$\|p=\\{rover}$;\2\6
+\4\\{done2}: \37\par
+\U180.\fi
+
+\M183. \P$\X183:Check flags of unavailable nodes\X\S$\6
+$\|p\K\\{mem\_min}$;\6
+\&{while} $\|p\L\\{lo\_mem\_max}$ \1\&{do}\C{node \|p should not be empty}\6
+\&{begin} \37\&{if} $\\{is\_empty}(\|p)$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"Bad\ flag\ at\ "})$;\5
+$\\{print\_int}(\|p)$;\6
+\&{end};\2\6
+\&{while} $(\|p\L\\{lo\_mem\_max})\W\R\\{free}[\|p]$ \1\&{do}\5
+$\\{incr}(\|p)$;\2\6
+\&{while} $(\|p\L\\{lo\_mem\_max})\W\\{free}[\|p]$ \1\&{do}\5
+$\\{incr}(\|p)$;\2\6
+\&{end}\2\par
+\U180.\fi
+
+\M184. \P$\X184:Print newly busy locations\X\S$\6
+\&{begin} \37$\\{print\_nl}(\.{"New\ busy\ locs:"})$;\6
+\&{for} $\|p\K\\{mem\_min}\mathrel{\&{to}}\\{lo\_mem\_max}$ \1\&{do}\6
+\&{if} $\R\\{free}[\|p]\W((\|p>\\{was\_lo\_max})\V\\{was\_free}[\|p])$ \1%
+\&{then}\6
+\&{begin} \37$\\{print\_char}(\.{"\ "})$;\5
+$\\{print\_int}(\|p)$;\6
+\&{end};\2\2\6
+\&{for} $\|p\K\\{hi\_mem\_min}\mathrel{\&{to}}\\{mem\_end}$ \1\&{do}\6
+\&{if} $\R\\{free}[\|p]\W((\|p<\\{was\_hi\_min})\V(\|p>\\{was\_mem\_end})\V%
+\\{was\_free}[\|p])$ \1\&{then}\6
+\&{begin} \37$\\{print\_char}(\.{"\ "})$;\5
+$\\{print\_int}(\|p)$;\6
+\&{end};\2\2\6
+\&{end}\par
+\U180.\fi
+
+\M185. The \\{search\_mem} procedure attempts to answer the question ``Who
+points
+to node~\|p?'' In doing so, it fetches \\{link} and \\{info} fields of \\{mem}
+that might not be of type \\{two\_halves}. Strictly speaking, this is
+undefined in \PASCAL, and it can lead to ``false drops'' (words that seem to
+point to \|p purely by coincidence). But for debugging purposes, we want
+to rule out the places that do {\sl not\/} point to \|p, so a few false
+drops are tolerable.
+
+\Y\P\&{debug} \37\&{procedure}\1\ \37$\\{search\_mem}(\|p:\\{pointer})$;%
+\C{look for pointers to \|p}\6
+\4\&{var} \37\|q: \37\\{integer};\C{current position being searched}\2\6
+\&{begin} \37\&{for} $\|q\K\\{mem\_min}\mathrel{\&{to}}\\{lo\_mem\_max}$ \1%
+\&{do}\6
+\&{begin} \37\&{if} $\\{link}(\|q)=\|p$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"LINK("})$;\5
+$\\{print\_int}(\|q)$;\5
+$\\{print\_char}(\.{")"})$;\6
+\&{end};\2\6
+\&{if} $\\{info}(\|q)=\|p$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"INFO("})$;\5
+$\\{print\_int}(\|q)$;\5
+$\\{print\_char}(\.{")"})$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{for} $\|q\K\\{hi\_mem\_min}\mathrel{\&{to}}\\{mem\_end}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{link}(\|q)=\|p$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"LINK("})$;\5
+$\\{print\_int}(\|q)$;\5
+$\\{print\_char}(\.{")"})$;\6
+\&{end};\2\6
+\&{if} $\\{info}(\|q)=\|p$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"INFO("})$;\5
+$\\{print\_int}(\|q)$;\5
+$\\{print\_char}(\.{")"})$;\6
+\&{end};\2\6
+\&{end};\2\6
+\X209:Search \\{eqtb} for equivalents equal to \|p\X;\6
+\&{end};\6
+\&{gubed}\par
+\fi
+
+\N186. \[12] The command codes.
+Before we can go much further, we need to define symbolic names for the
+internal
+code numbers that represent the various commands obeyed by \MF. These codes
+are somewhat arbitrary, but not completely so. For example,
+some codes have been made adjacent so that \&{case} statements in the
+program need not consider cases that are widely spaced, or so that \&{case}
+statements can be replaced by \&{if} statements. A command can begin an
+expression if and only if its code lies between \\{min\_primary\_command} and
+\\{max\_primary\_command}, inclusive. The first token of a statement that
+doesn't
+begin with an expression has a command code between \\{min\_command} and
+\\{max\_statement\_command}, inclusive. The ordering of the highest-numbered
+commands ($\\{comma}<\\{semicolon}<\\{end\_group}<\\{stop}$) is crucial for the
+parsing
+and error-recovery methods of this program.
+
+At any rate, here is the list, for future reference.
+
+\Y\P\D \37$\\{if\_test}=1$\C{conditional text (\&{if})}\par
+\P\D \37$\\{fi\_or\_else}=2$\C{delimiters for conditionals (\&{elseif}, %
+\&{else}, \&{fi}}\par
+\P\D \37$\\{input}=3$\C{input a source file (\&{input}, \&{endinput})}\par
+\P\D \37$\\{iteration}=4$\C{iterate (\&{for}, \&{forsuffixes}, \&{forever}, %
+\&{endfor})}\par
+\P\D \37$\\{repeat\_loop}=5$\C{special command substituted for \&{endfor}}\par
+\P\D \37$\\{exit\_test}=6$\C{premature exit from a loop (\&{exitif})}\par
+\P\D \37$\\{relax}=7$\C{do nothing (\.{\char`\\})}\par
+\P\D \37$\\{scan\_tokens}=8$\C{put a string into the input buffer}\par
+\P\D \37$\\{expand\_after}=9$\C{look ahead one token}\par
+\P\D \37$\\{defined\_macro}=10$\C{a macro defined by the user}\par
+\P\D \37$\\{min\_command}=\\{defined\_macro}+1$\par
+\P\D \37$\\{display\_command}=11$\C{online graphic output (\&{display})}\par
+\P\D \37$\\{save\_command}=12$\C{save a list of tokens (\&{save})}\par
+\P\D \37$\\{interim\_command}=13$\C{save an internal quantity (\&{interim})}\par
+\P\D \37$\\{let\_command}=14$\C{redefine a symbolic token (\&{let})}\par
+\P\D \37$\\{new\_internal}=15$\C{define a new internal quantity (%
+\&{newinternal})}\par
+\P\D \37$\\{macro\_def}=16$\C{define a macro (\&{def}, \&{vardef}, etc.)}\par
+\P\D \37$\\{ship\_out\_command}=17$\C{output a character (\&{shipout})}\par
+\P\D \37$\\{add\_to\_command}=18$\C{add to edges (\&{addto})}\par
+\P\D \37$\\{cull\_command}=19$\C{cull and normalize edges (\&{cull})}\par
+\P\D \37$\\{tfm\_command}=20$\C{command for font metric info (\&{ligtable},
+etc.)}\par
+\P\D \37$\\{protection\_command}=21$\C{set protection flag (\&{outer}, %
+\&{inner})}\par
+\P\D \37$\\{show\_command}=22$\C{diagnostic output (\&{show}, \&{showvariable},
+etc.)}\par
+\P\D \37$\\{mode\_command}=23$\C{set interaction level (\&{batchmode}, etc.)}%
+\par
+\P\D \37$\\{random\_seed}=24$\C{initialize random number generator (%
+\&{randomseed})}\par
+\P\D \37$\\{message\_command}=25$\C{communicate to user (\&{message}, %
+\&{errmessage})}\par
+\P\D \37$\\{every\_job\_command}=26$\C{designate a starting token (%
+\&{everyjob})}\par
+\P\D \37$\\{delimiters}=27$\C{define a pair of delimiters (\&{delimiters})}\par
+\P\D \37$\\{open\_window}=28$\C{define a window on the screen (\&{openwindow})}%
+\par
+\P\D \37$\\{special\_command}=29$\C{output special info (\&{special}, %
+\&{numspecial})}\par
+\P\D \37$\\{type\_name}=30$\C{declare a type (\&{numeric}, \&{pair}, etc.}\par
+\P\D \37$\\{max\_statement\_command}=\\{type\_name}$\par
+\P\D \37$\\{min\_primary\_command}=\\{type\_name}$\par
+\P\D \37$\\{left\_delimiter}=31$\C{the left delimiter of a matching pair}\par
+\P\D \37$\\{begin\_group}=32$\C{beginning of a group (\&{begingroup})}\par
+\P\D \37$\\{nullary}=33$\C{an operator without arguments (e.g., %
+\&{normaldeviate})}\par
+\P\D \37$\\{unary}=34$\C{an operator with one argument (e.g., \&{sqrt})}\par
+\P\D \37$\\{str\_op}=35$\C{convert a suffix to a string (\&{str})}\par
+\P\D \37$\\{cycle}=36$\C{close a cyclic path (\&{cycle})}\par
+\P\D \37$\\{primary\_binary}=37$\C{binary operation taking `\&{of}' (e.g., %
+\&{point})}\par
+\P\D \37$\\{capsule\_token}=38$\C{a value that has been put into a token list}%
+\par
+\P\D \37$\\{string\_token}=39$\C{a string constant (e.g., \.{"hello"})}\par
+\P\D \37$\\{internal\_quantity}=40$\C{internal numeric parameter (e.g., %
+\&{pausing})}\par
+\P\D \37$\\{min\_suffix\_token}=\\{internal\_quantity}$\par
+\P\D \37$\\{tag\_token}=41$\C{a symbolic token without a primitive meaning}\par
+\P\D \37$\\{numeric\_token}=42$\C{a numeric constant (e.g., \.{3.14159})}\par
+\P\D \37$\\{max\_suffix\_token}=\\{numeric\_token}$\par
+\P\D \37$\\{plus\_or\_minus}=43$\C{either `\.+' or `\.-'}\par
+\P\D \37$\\{max\_primary\_command}=\\{plus\_or\_minus}$\C{should also be $%
+\\{numeric\_token}+1$}\par
+\P\D \37$\\{min\_tertiary\_command}=\\{plus\_or\_minus}$\par
+\P\D \37$\\{tertiary\_secondary\_macro}=44$\C{a macro defined by %
+\&{secondarydef}}\par
+\P\D \37$\\{tertiary\_binary}=45$\C{an operator at the tertiary level (e.g., `%
+\.{++}')}\par
+\P\D \37$\\{max\_tertiary\_command}=\\{tertiary\_binary}$\par
+\P\D \37$\\{left\_brace}=46$\C{the operator `\.{\char`\{}'}\par
+\P\D \37$\\{min\_expression\_command}=\\{left\_brace}$\par
+\P\D \37$\\{path\_join}=47$\C{the operator `\.{..}'}\par
+\P\D \37$\\{ampersand}=48$\C{the operator `\.\&'}\par
+\P\D \37$\\{expression\_tertiary\_macro}=49$\C{a macro defined by %
+\&{tertiarydef}}\par
+\P\D \37$\\{expression\_binary}=50$\C{an operator at the expression level
+(e.g., `\.<')}\par
+\P\D \37$\\{equals}=51$\C{the operator `\.='}\par
+\P\D \37$\\{max\_expression\_command}=\\{equals}$\par
+\P\D \37$\\{and\_command}=52$\C{the operator `\&{and}'}\par
+\P\D \37$\\{min\_secondary\_command}=\\{and\_command}$\par
+\P\D \37$\\{secondary\_primary\_macro}=53$\C{a macro defined by \&{primarydef}}%
+\par
+\P\D \37$\\{slash}=54$\C{the operator `\./'}\par
+\P\D \37$\\{secondary\_binary}=55$\C{an operator at the binary level (e.g., %
+\&{shifted})}\par
+\P\D \37$\\{max\_secondary\_command}=\\{secondary\_binary}$\par
+\P\D \37$\\{param\_type}=56$\C{type of parameter (\&{primary}, \&{expr}, %
+\&{suffix}, etc.)}\par
+\P\D \37$\\{controls}=57$\C{specify control points explicitly (\&{controls})}%
+\par
+\P\D \37$\\{tension}=58$\C{specify tension between knots (\&{tension})}\par
+\P\D \37$\\{at\_least}=59$\C{bounded tension value (\&{atleast})}\par
+\P\D \37$\\{curl\_command}=60$\C{specify curl at an end knot (\&{curl})}\par
+\P\D \37$\\{macro\_special}=61$\C{special macro operators (\&{quote}, \.{\#%
+\AT!}, etc.)}\par
+\P\D \37$\\{right\_delimiter}=62$\C{the right delimiter of a matching pair}\par
+\P\D \37$\\{left\_bracket}=63$\C{the operator `\.['}\par
+\P\D \37$\\{right\_bracket}=64$\C{the operator `\.]'}\par
+\P\D \37$\\{right\_brace}=65$\C{the operator `\.{\char`\}}'}\par
+\P\D \37$\\{with\_option}=66$\C{option for filling (\&{withpen}, %
+\&{withweight})}\par
+\P\D \37$\\{cull\_op}=67$\C{the operator `\&{keeping}' or `\&{dropping}'}\par
+\P\D \37$\\{thing\_to\_add}=68$\C{variant of \&{addto} (\&{contour}, %
+\&{doublepath}, \&{also})}\par
+\P\D \37$\\{of\_token}=69$\C{the operator `\&{of}'}\par
+\P\D \37$\\{from\_token}=70$\C{the operator `\&{from}'}\par
+\P\D \37$\\{to\_token}=71$\C{the operator `\&{to}'}\par
+\P\D \37$\\{at\_token}=72$\C{the operator `\&{at}'}\par
+\P\D \37$\\{in\_window}=73$\C{the operator `\&{inwindow}'}\par
+\P\D \37$\\{step\_token}=74$\C{the operator `\&{step}'}\par
+\P\D \37$\\{until\_token}=75$\C{the operator `\&{until}'}\par
+\P\D \37$\\{lig\_kern\_token}=76$\C{the operators `\&{kern}' and `\.{=:}' and `%
+\.{=:\char'174}, etc.}\par
+\P\D \37$\\{assignment}=77$\C{the operator `\.{:=}'}\par
+\P\D \37$\\{skip\_to}=78$\C{the operation `\&{skipto}'}\par
+\P\D \37$\\{bchar\_label}=79$\C{the operator `\.{\char'174\char'174:}'}\par
+\P\D \37$\\{double\_colon}=80$\C{the operator `\.{::}'}\par
+\P\D \37$\\{colon}=81$\C{the operator `\.:'}\Y\par
+\P\D \37$\\{comma}=82$\C{the operator `\.,', must be $\\{colon}+1$}\par
+\P\D \37$\\{end\_of\_statement}\S\\{cur\_cmd}>\\{comma}$\par
+\P\D \37$\\{semicolon}=83$\C{the operator `\.;', must be $\\{comma}+1$}\par
+\P\D \37$\\{end\_group}=84$\C{end a group (\&{endgroup}), must be $%
+\\{semicolon}+1$}\par
+\P\D \37$\\{stop}=85$\C{end a job (\&{end}, \&{dump}), must be $\\{end%
+\_group}+1$}\par
+\P\D \37$\\{max\_command\_code}=\\{stop}$\par
+\P\D \37$\\{outer\_tag}=\\{max\_command\_code}+1$\C{protection code added to
+command code}\par
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{command\_code}=1\to\\{max\_command\_code}$;\par
+\fi
+
+\M187. Variables and capsules in \MF\ have a variety of ``types,''
+distinguished by the following code numbers:
+
+\Y\P\D \37$\\{undefined}=0$\C{no type has been declared}\par
+\P\D \37$\\{unknown\_tag}=1$\C{this constant is added to certain type codes
+below}\par
+\P\D \37$\\{vacuous}=1$\C{no expression was present}\par
+\P\D \37$\\{boolean\_type}=2$\C{\&{boolean} with a known value}\par
+\P\D \37$\\{unknown\_boolean}=\\{boolean\_type}+\\{unknown\_tag}$\par
+\P\D \37$\\{string\_type}=4$\C{\&{string} with a known value}\par
+\P\D \37$\\{unknown\_string}=\\{string\_type}+\\{unknown\_tag}$\par
+\P\D \37$\\{pen\_type}=6$\C{\&{pen} with a known value}\par
+\P\D \37$\\{unknown\_pen}=\\{pen\_type}+\\{unknown\_tag}$\par
+\P\D \37$\\{future\_pen}=8$\C{subexpression that will become a \&{pen} at a
+higher level}\par
+\P\D \37$\\{path\_type}=9$\C{\&{path} with a known value}\par
+\P\D \37$\\{unknown\_path}=\\{path\_type}+\\{unknown\_tag}$\par
+\P\D \37$\\{picture\_type}=11$\C{\&{picture} with a known value}\par
+\P\D \37$\\{unknown\_picture}=\\{picture\_type}+\\{unknown\_tag}$\par
+\P\D \37$\\{transform\_type}=13$\C{\&{transform} variable or capsule}\par
+\P\D \37$\\{pair\_type}=14$\C{\&{pair} variable or capsule}\par
+\P\D \37$\\{numeric\_type}=15$\C{variable that has been declared \&{numeric}
+but not used}\par
+\P\D \37$\\{known}=16$\C{\&{numeric} with a known value}\par
+\P\D \37$\\{dependent}=17$\C{a linear combination with \\{fraction}
+coefficients}\par
+\P\D \37$\\{proto\_dependent}=18$\C{a linear combination with \\{scaled}
+coefficients}\par
+\P\D \37$\\{independent}=19$\C{\&{numeric} with unknown value}\par
+\P\D \37$\\{token\_list}=20$\C{variable name or suffix argument or text
+argument}\par
+\P\D \37$\\{structured}=21$\C{variable with subscripts and attributes}\par
+\P\D \37$\\{unsuffixed\_macro}=22$\C{variable defined with \&{vardef} but no %
+\.{\AT!\#}}\par
+\P\D \37$\\{suffixed\_macro}=23$\C{variable defined with \&{vardef} and \.{\AT!%
+\#}}\Y\par
+\P\D \37$\\{unknown\_types}\S\\{unknown\_boolean},\39\\{unknown\_string},\39%
+\\{unknown\_pen},\39\\{unknown\_picture},\39\\{unknown\_path}$\par
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_type}(\|t:\\{small\_number})$;\2\6
+\&{begin} \37\&{case} $\|t$ \1\&{of}\6
+\4\\{vacuous}: \37$\\{print}(\.{"vacuous"})$;\6
+\4\\{boolean\_type}: \37$\\{print}(\.{"boolean"})$;\6
+\4\\{unknown\_boolean}: \37$\\{print}(\.{"unknown\ boolean"})$;\6
+\4\\{string\_type}: \37$\\{print}(\.{"string"})$;\6
+\4\\{unknown\_string}: \37$\\{print}(\.{"unknown\ string"})$;\6
+\4\\{pen\_type}: \37$\\{print}(\.{"pen"})$;\6
+\4\\{unknown\_pen}: \37$\\{print}(\.{"unknown\ pen"})$;\6
+\4\\{future\_pen}: \37$\\{print}(\.{"future\ pen"})$;\6
+\4\\{path\_type}: \37$\\{print}(\.{"path"})$;\6
+\4\\{unknown\_path}: \37$\\{print}(\.{"unknown\ path"})$;\6
+\4\\{picture\_type}: \37$\\{print}(\.{"picture"})$;\6
+\4\\{unknown\_picture}: \37$\\{print}(\.{"unknown\ picture"})$;\6
+\4\\{transform\_type}: \37$\\{print}(\.{"transform"})$;\6
+\4\\{pair\_type}: \37$\\{print}(\.{"pair"})$;\6
+\4\\{known}: \37$\\{print}(\.{"known\ numeric"})$;\6
+\4\\{dependent}: \37$\\{print}(\.{"dependent"})$;\6
+\4\\{proto\_dependent}: \37$\\{print}(\.{"proto-dependent"})$;\6
+\4\\{numeric\_type}: \37$\\{print}(\.{"numeric"})$;\6
+\4\\{independent}: \37$\\{print}(\.{"independent"})$;\6
+\4\\{token\_list}: \37$\\{print}(\.{"token\ list"})$;\6
+\4\\{structured}: \37$\\{print}(\.{"structured"})$;\6
+\4\\{unsuffixed\_macro}: \37$\\{print}(\.{"unsuffixed\ macro"})$;\6
+\4\\{suffixed\_macro}: \37$\\{print}(\.{"suffixed\ macro"})$;\6
+\4\&{othercases} \37$\\{print}(\.{"undefined"})$\2\6
+\&{endcases};\6
+\&{end};\par
+\fi
+
+\M188. Values inside \MF\ are stored in two-word nodes that have a \\{name%
+\_type}
+as well as a \\{type}. The possibilities for \\{name\_type} are defined
+here; they will be explained in more detail later.
+
+\Y\P\D \37$\\{root}=0$\C{\\{name\_type} at the top level of a variable}\par
+\P\D \37$\\{saved\_root}=1$\C{same, when the variable has been saved}\par
+\P\D \37$\\{structured\_root}=2$\C{\\{name\_type} where a \\{structured} branch
+occurs}\par
+\P\D \37$\\{subscr}=3$\C{\\{name\_type} in a subscript node}\par
+\P\D \37$\\{attr}=4$\C{\\{name\_type} in an attribute node}\par
+\P\D \37$\\{x\_part\_sector}=5$\C{\\{name\_type} in the \&{xpart} of a node}\par
+\P\D \37$\\{y\_part\_sector}=6$\C{\\{name\_type} in the \&{ypart} of a node}\par
+\P\D \37$\\{xx\_part\_sector}=7$\C{\\{name\_type} in the \&{xxpart} of a node}%
+\par
+\P\D \37$\\{xy\_part\_sector}=8$\C{\\{name\_type} in the \&{xypart} of a node}%
+\par
+\P\D \37$\\{yx\_part\_sector}=9$\C{\\{name\_type} in the \&{yxpart} of a node}%
+\par
+\P\D \37$\\{yy\_part\_sector}=10$\C{\\{name\_type} in the \&{yypart} of a node}%
+\par
+\P\D \37$\\{capsule}=11$\C{\\{name\_type} in stashed-away subexpressions}\par
+\P\D \37$\\{token}=12$\C{\\{name\_type} in a numeric token or string token}\par
+\fi
+
+\M189. Primitive operations that produce values have a secondary identification
+code in addition to their command code; it's something like genera and species.
+For example, `\.*' has the command code \\{primary\_binary}, and its
+secondary identification is \\{times}. The secondary codes start at 30 so that
+they don't overlap with the type codes; some type codes (e.g., \\{string%
+\_type})
+are used as operators as well as type identifications.
+
+\Y\P\D \37$\\{true\_code}=30$\C{operation code for \.{true}}\par
+\P\D \37$\\{false\_code}=31$\C{operation code for \.{false}}\par
+\P\D \37$\\{null\_picture\_code}=32$\C{operation code for \.{nullpicture}}\par
+\P\D \37$\\{null\_pen\_code}=33$\C{operation code for \.{nullpen}}\par
+\P\D \37$\\{job\_name\_op}=34$\C{operation code for \.{jobname}}\par
+\P\D \37$\\{read\_string\_op}=35$\C{operation code for \.{readstring}}\par
+\P\D \37$\\{pen\_circle}=36$\C{operation code for \.{pencircle}}\par
+\P\D \37$\\{normal\_deviate}=37$\C{operation code for \.{normaldeviate}}\par
+\P\D \37$\\{odd\_op}=38$\C{operation code for \.{odd}}\par
+\P\D \37$\\{known\_op}=39$\C{operation code for \.{known}}\par
+\P\D \37$\\{unknown\_op}=40$\C{operation code for \.{unknown}}\par
+\P\D \37$\\{not\_op}=41$\C{operation code for \.{not}}\par
+\P\D \37$\\{decimal}=42$\C{operation code for \.{decimal}}\par
+\P\D \37$\\{reverse}=43$\C{operation code for \.{reverse}}\par
+\P\D \37$\\{make\_path\_op}=44$\C{operation code for \.{makepath}}\par
+\P\D \37$\\{make\_pen\_op}=45$\C{operation code for \.{makepen}}\par
+\P\D \37$\\{total\_weight\_op}=46$\C{operation code for \.{totalweight}}\par
+\P\D \37$\\{oct\_op}=47$\C{operation code for \.{oct}}\par
+\P\D \37$\\{hex\_op}=48$\C{operation code for \.{hex}}\par
+\P\D \37$\\{ASCII\_op}=49$\C{operation code for \.{ASCII}}\par
+\P\D \37$\\{char\_op}=50$\C{operation code for \.{char}}\par
+\P\D \37$\\{length\_op}=51$\C{operation code for \.{length}}\par
+\P\D \37$\\{turning\_op}=52$\C{operation code for \.{turningnumber}}\par
+\P\D \37$\\{x\_part}=53$\C{operation code for \.{xpart}}\par
+\P\D \37$\\{y\_part}=54$\C{operation code for \.{ypart}}\par
+\P\D \37$\\{xx\_part}=55$\C{operation code for \.{xxpart}}\par
+\P\D \37$\\{xy\_part}=56$\C{operation code for \.{xypart}}\par
+\P\D \37$\\{yx\_part}=57$\C{operation code for \.{yxpart}}\par
+\P\D \37$\\{yy\_part}=58$\C{operation code for \.{yypart}}\par
+\P\D \37$\\{sqrt\_op}=59$\C{operation code for \.{sqrt}}\par
+\P\D \37$\\{m\_exp\_op}=60$\C{operation code for \.{mexp}}\par
+\P\D \37$\\{m\_log\_op}=61$\C{operation code for \.{mlog}}\par
+\P\D \37$\\{sin\_d\_op}=62$\C{operation code for \.{sind}}\par
+\P\D \37$\\{cos\_d\_op}=63$\C{operation code for \.{cosd}}\par
+\P\D \37$\\{floor\_op}=64$\C{operation code for \.{floor}}\par
+\P\D \37$\\{uniform\_deviate}=65$\C{operation code for \.{uniformdeviate}}\par
+\P\D \37$\\{char\_exists\_op}=66$\C{operation code for \.{charexists}}\par
+\P\D \37$\\{angle\_op}=67$\C{operation code for \.{angle}}\par
+\P\D \37$\\{cycle\_op}=68$\C{operation code for \.{cycle}}\par
+\P\D \37$\\{plus}=69$\C{operation code for \.+}\par
+\P\D \37$\\{minus}=70$\C{operation code for \.-}\par
+\P\D \37$\\{times}=71$\C{operation code for \.*}\par
+\P\D \37$\\{over}=72$\C{operation code for \./}\par
+\P\D \37$\\{pythag\_add}=73$\C{operation code for \.{++}}\par
+\P\D \37$\\{pythag\_sub}=74$\C{operation code for \.{+-+}}\par
+\P\D \37$\\{or\_op}=75$\C{operation code for \.{or}}\par
+\P\D \37$\\{and\_op}=76$\C{operation code for \.{and}}\par
+\P\D \37$\\{less\_than}=77$\C{operation code for \.<}\par
+\P\D \37$\\{less\_or\_equal}=78$\C{operation code for \.{<=}}\par
+\P\D \37$\\{greater\_than}=79$\C{operation code for \.>}\par
+\P\D \37$\\{greater\_or\_equal}=80$\C{operation code for \.{>=}}\par
+\P\D \37$\\{equal\_to}=81$\C{operation code for \.=}\par
+\P\D \37$\\{unequal\_to}=82$\C{operation code for \.{<>}}\par
+\P\D \37$\\{concatenate}=83$\C{operation code for \.\&}\par
+\P\D \37$\\{rotated\_by}=84$\C{operation code for \.{rotated}}\par
+\P\D \37$\\{slanted\_by}=85$\C{operation code for \.{slanted}}\par
+\P\D \37$\\{scaled\_by}=86$\C{operation code for \.{scaled}}\par
+\P\D \37$\\{shifted\_by}=87$\C{operation code for \.{shifted}}\par
+\P\D \37$\\{transformed\_by}=88$\C{operation code for \.{transformed}}\par
+\P\D \37$\\{x\_scaled}=89$\C{operation code for \.{xscaled}}\par
+\P\D \37$\\{y\_scaled}=90$\C{operation code for \.{yscaled}}\par
+\P\D \37$\\{z\_scaled}=91$\C{operation code for \.{zscaled}}\par
+\P\D \37$\\{intersect}=92$\C{operation code for \.{intersectiontimes}}\par
+\P\D \37$\\{double\_dot}=93$\C{operation code for improper \.{..}}\par
+\P\D \37$\\{substring\_of}=94$\C{operation code for \.{substring}}\par
+\P\D \37$\\{min\_of}=\\{substring\_of}$\par
+\P\D \37$\\{subpath\_of}=95$\C{operation code for \.{subpath}}\par
+\P\D \37$\\{direction\_time\_of}=96$\C{operation code for \.{directiontime}}\par
+\P\D \37$\\{point\_of}=97$\C{operation code for \.{point}}\par
+\P\D \37$\\{precontrol\_of}=98$\C{operation code for \.{precontrol}}\par
+\P\D \37$\\{postcontrol\_of}=99$\C{operation code for \.{postcontrol}}\par
+\P\D \37$\\{pen\_offset\_of}=100$\C{operation code for \.{penoffset}}\par
+\Y\P\4\&{procedure}\1\ \37$\\{print\_op}(\|c:\\{quarterword})$;\2\6
+\&{begin} \37\&{if} $\|c\L\\{numeric\_type}$ \1\&{then}\5
+$\\{print\_type}(\|c)$\6
+\4\&{else} \&{case} $\|c$ \1\&{of}\6
+\4\\{true\_code}: \37$\\{print}(\.{"true"})$;\6
+\4\\{false\_code}: \37$\\{print}(\.{"false"})$;\6
+\4\\{null\_picture\_code}: \37$\\{print}(\.{"nullpicture"})$;\6
+\4\\{null\_pen\_code}: \37$\\{print}(\.{"nullpen"})$;\6
+\4\\{job\_name\_op}: \37$\\{print}(\.{"jobname"})$;\6
+\4\\{read\_string\_op}: \37$\\{print}(\.{"readstring"})$;\6
+\4\\{pen\_circle}: \37$\\{print}(\.{"pencircle"})$;\6
+\4\\{normal\_deviate}: \37$\\{print}(\.{"normaldeviate"})$;\6
+\4\\{odd\_op}: \37$\\{print}(\.{"odd"})$;\6
+\4\\{known\_op}: \37$\\{print}(\.{"known"})$;\6
+\4\\{unknown\_op}: \37$\\{print}(\.{"unknown"})$;\6
+\4\\{not\_op}: \37$\\{print}(\.{"not"})$;\6
+\4\\{decimal}: \37$\\{print}(\.{"decimal"})$;\6
+\4\\{reverse}: \37$\\{print}(\.{"reverse"})$;\6
+\4\\{make\_path\_op}: \37$\\{print}(\.{"makepath"})$;\6
+\4\\{make\_pen\_op}: \37$\\{print}(\.{"makepen"})$;\6
+\4\\{total\_weight\_op}: \37$\\{print}(\.{"totalweight"})$;\6
+\4\\{oct\_op}: \37$\\{print}(\.{"oct"})$;\6
+\4\\{hex\_op}: \37$\\{print}(\.{"hex"})$;\6
+\4\\{ASCII\_op}: \37$\\{print}(\.{"ASCII"})$;\6
+\4\\{char\_op}: \37$\\{print}(\.{"char"})$;\6
+\4\\{length\_op}: \37$\\{print}(\.{"length"})$;\6
+\4\\{turning\_op}: \37$\\{print}(\.{"turningnumber"})$;\6
+\4\\{x\_part}: \37$\\{print}(\.{"xpart"})$;\6
+\4\\{y\_part}: \37$\\{print}(\.{"ypart"})$;\6
+\4\\{xx\_part}: \37$\\{print}(\.{"xxpart"})$;\6
+\4\\{xy\_part}: \37$\\{print}(\.{"xypart"})$;\6
+\4\\{yx\_part}: \37$\\{print}(\.{"yxpart"})$;\6
+\4\\{yy\_part}: \37$\\{print}(\.{"yypart"})$;\6
+\4\\{sqrt\_op}: \37$\\{print}(\.{"sqrt"})$;\6
+\4\\{m\_exp\_op}: \37$\\{print}(\.{"mexp"})$;\6
+\4\\{m\_log\_op}: \37$\\{print}(\.{"mlog"})$;\6
+\4\\{sin\_d\_op}: \37$\\{print}(\.{"sind"})$;\6
+\4\\{cos\_d\_op}: \37$\\{print}(\.{"cosd"})$;\6
+\4\\{floor\_op}: \37$\\{print}(\.{"floor"})$;\6
+\4\\{uniform\_deviate}: \37$\\{print}(\.{"uniformdeviate"})$;\6
+\4\\{char\_exists\_op}: \37$\\{print}(\.{"charexists"})$;\6
+\4\\{angle\_op}: \37$\\{print}(\.{"angle"})$;\6
+\4\\{cycle\_op}: \37$\\{print}(\.{"cycle"})$;\6
+\4\\{plus}: \37$\\{print\_char}(\.{"+"})$;\6
+\4\\{minus}: \37$\\{print\_char}(\.{"-"})$;\6
+\4\\{times}: \37$\\{print\_char}(\.{"*"})$;\6
+\4\\{over}: \37$\\{print\_char}(\.{"/"})$;\6
+\4\\{pythag\_add}: \37$\\{print}(\.{"++"})$;\6
+\4\\{pythag\_sub}: \37$\\{print}(\.{"+-+"})$;\6
+\4\\{or\_op}: \37$\\{print}(\.{"or"})$;\6
+\4\\{and\_op}: \37$\\{print}(\.{"and"})$;\6
+\4\\{less\_than}: \37$\\{print\_char}(\.{"<"})$;\6
+\4\\{less\_or\_equal}: \37$\\{print}(\.{"<="})$;\6
+\4\\{greater\_than}: \37$\\{print\_char}(\.{">"})$;\6
+\4\\{greater\_or\_equal}: \37$\\{print}(\.{">="})$;\6
+\4\\{equal\_to}: \37$\\{print\_char}(\.{"="})$;\6
+\4\\{unequal\_to}: \37$\\{print}(\.{"<>"})$;\6
+\4\\{concatenate}: \37$\\{print}(\.{"\&"})$;\6
+\4\\{rotated\_by}: \37$\\{print}(\.{"rotated"})$;\6
+\4\\{slanted\_by}: \37$\\{print}(\.{"slanted"})$;\6
+\4\\{scaled\_by}: \37$\\{print}(\.{"scaled"})$;\6
+\4\\{shifted\_by}: \37$\\{print}(\.{"shifted"})$;\6
+\4\\{transformed\_by}: \37$\\{print}(\.{"transformed"})$;\6
+\4\\{x\_scaled}: \37$\\{print}(\.{"xscaled"})$;\6
+\4\\{y\_scaled}: \37$\\{print}(\.{"yscaled"})$;\6
+\4\\{z\_scaled}: \37$\\{print}(\.{"zscaled"})$;\6
+\4\\{intersect}: \37$\\{print}(\.{"intersectiontimes"})$;\6
+\4\\{substring\_of}: \37$\\{print}(\.{"substring"})$;\6
+\4\\{subpath\_of}: \37$\\{print}(\.{"subpath"})$;\6
+\4\\{direction\_time\_of}: \37$\\{print}(\.{"directiontime"})$;\6
+\4\\{point\_of}: \37$\\{print}(\.{"point"})$;\6
+\4\\{precontrol\_of}: \37$\\{print}(\.{"precontrol"})$;\6
+\4\\{postcontrol\_of}: \37$\\{print}(\.{"postcontrol"})$;\6
+\4\\{pen\_offset\_of}: \37$\\{print}(\.{"penoffset"})$;\6
+\4\&{othercases} \37$\\{print}(\.{".."})$\2\6
+\&{endcases};\2\6
+\&{end};\par
+\fi
+
+\M190. \MF\ also has a bunch of internal parameters that a user might want to
+fuss with. Every such parameter has an identifying code number, defined here.
+
+\Y\P\D \37$\\{tracing\_titles}=1$\C{show titles online when they appear}\par
+\P\D \37$\\{tracing\_equations}=2$\C{show each variable when it becomes known}%
+\par
+\P\D \37$\\{tracing\_capsules}=3$\C{show capsules too}\par
+\P\D \37$\\{tracing\_choices}=4$\C{show the control points chosen for paths}\par
+\P\D \37$\\{tracing\_specs}=5$\C{show subdivision of paths into octants before
+digitizing}\par
+\P\D \37$\\{tracing\_pens}=6$\C{show details of pens that are made}\par
+\P\D \37$\\{tracing\_commands}=7$\C{show commands and operations before they
+are performed}\par
+\P\D \37$\\{tracing\_restores}=8$\C{show when a variable or internal is
+restored}\par
+\P\D \37$\\{tracing\_macros}=9$\C{show macros before they are expanded}\par
+\P\D \37$\\{tracing\_edges}=10$\C{show digitized edges as they are computed}\par
+\P\D \37$\\{tracing\_output}=11$\C{show digitized edges as they are output}\par
+\P\D \37$\\{tracing\_stats}=12$\C{show memory usage at end of job}\par
+\P\D \37$\\{tracing\_online}=13$\C{show long diagnostics on terminal and in the
+log file}\par
+\P\D \37$\\{year}=14$\C{the current year (e.g., 1984)}\par
+\P\D \37$\\{month}=15$\C{the current month (e.g, 3 $\equiv$ March)}\par
+\P\D \37$\\{day}=16$\C{the current day of the month}\par
+\P\D \37$\\{time}=17$\C{the number of minutes past midnight when this job
+started}\par
+\P\D \37$\\{char\_code}=18$\C{the number of the next character to be output}\par
+\P\D \37$\\{char\_ext}=19$\C{the extension code of the next character to be
+output}\par
+\P\D \37$\\{char\_wd}=20$\C{the width of the next character to be output}\par
+\P\D \37$\\{char\_ht}=21$\C{the height of the next character to be output}\par
+\P\D \37$\\{char\_dp}=22$\C{the depth of the next character to be output}\par
+\P\D \37$\\{char\_ic}=23$\C{the italic correction of the next character to be
+output}\par
+\P\D \37$\\{char\_dx}=24$\C{the device's $x$ movement for the next character,
+in pixels}\par
+\P\D \37$\\{char\_dy}=25$\C{the device's $y$ movement for the next character,
+in pixels}\par
+\P\D \37$\\{design\_size}=26$\C{the unit of measure used for $\\{char\_wd}\to%
+\\{char\_ic}$, in points}\par
+\P\D \37$\\{hppp}=27$\C{the number of horizontal pixels per point}\par
+\P\D \37$\\{vppp}=28$\C{the number of vertical pixels per point}\par
+\P\D \37$\\{x\_offset}=29$\C{horizontal displacement of shipped-out characters}%
+\par
+\P\D \37$\\{y\_offset}=30$\C{vertical displacement of shipped-out characters}%
+\par
+\P\D \37$\\{pausing}=31$\C{positive to display lines on the terminal before
+they are read}\par
+\P\D \37$\\{showstopping}=32$\C{positive to stop after each \&{show} command}%
+\par
+\P\D \37$\\{fontmaking}=33$\C{positive if font metric output is to be produced}%
+\par
+\P\D \37$\\{proofing}=34$\C{positive for proof mode, negative to suppress
+output}\par
+\P\D \37$\\{smoothing}=35$\C{positive if moves are to be ``smoothed''}\par
+\P\D \37$\\{autorounding}=36$\C{controls path modification to ``good'' points}%
+\par
+\P\D \37$\\{granularity}=37$\C{autorounding uses this pixel size}\par
+\P\D \37$\\{fillin}=38$\C{extra darkness of diagonal lines}\par
+\P\D \37$\\{turning\_check}=39$\C{controls reorientation of clockwise paths}\par
+\P\D \37$\\{warning\_check}=40$\C{controls error message when variable value is
+large}\par
+\P\D \37$\\{boundary\_char}=41$\C{the right boundary character for ligatures}%
+\par
+\P\D \37$\\{max\_given\_internal}=41$\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{internal}: \37\&{array} $[1\to\\{max\_internal}]$ \1\&{of}\5
+\\{scaled};\C{the values of internal quantities}\2\6
+\4\\{int\_name}: \37\&{array} $[1\to\\{max\_internal}]$ \1\&{of}\5
+\\{str\_number};\C{their names}\2\6
+\4\\{int\_ptr}: \37$\\{max\_given\_internal}\to\\{max\_internal}$;\C{the
+maximum internal quantity defined so far}\par
+\fi
+
+\M191. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+\&{for} $\|k\K1\mathrel{\&{to}}\\{max\_given\_internal}$ \1\&{do}\5
+$\\{internal}[\|k]\K0$;\2\6
+$\\{int\_ptr}\K\\{max\_given\_internal}$;\par
+\fi
+
+\M192. The symbolic names for internal quantities are put into \MF's hash table
+by using a routine called \\{primitive}, which will be defined later. Let us
+enter them now, so that we don't have to list all those names again
+anywhere else.
+
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\S$\6
+$\\{primitive}(\.{"tracingtitles"},\39\\{internal\_quantity},\39\\{tracing%
+\_titles})$;\6
+$\\{primitive}(\.{"tracingequations"},\39\\{internal\_quantity},\39\\{tracing%
+\_equations})$;\6
+$\\{primitive}(\.{"tracingcapsules"},\39\\{internal\_quantity},\39\\{tracing%
+\_capsules})$;\6
+$\\{primitive}(\.{"tracingchoices"},\39\\{internal\_quantity},\39\\{tracing%
+\_choices})$;\6
+$\\{primitive}(\.{"tracingspecs"},\39\\{internal\_quantity},\39\\{tracing%
+\_specs})$;\6
+$\\{primitive}(\.{"tracingpens"},\39\\{internal\_quantity},\39\\{tracing%
+\_pens})$;\6
+$\\{primitive}(\.{"tracingcommands"},\39\\{internal\_quantity},\39\\{tracing%
+\_commands})$;\6
+$\\{primitive}(\.{"tracingrestores"},\39\\{internal\_quantity},\39\\{tracing%
+\_restores})$;\6
+$\\{primitive}(\.{"tracingmacros"},\39\\{internal\_quantity},\39\\{tracing%
+\_macros})$;\6
+$\\{primitive}(\.{"tracingedges"},\39\\{internal\_quantity},\39\\{tracing%
+\_edges})$;\6
+$\\{primitive}(\.{"tracingoutput"},\39\\{internal\_quantity},\39\\{tracing%
+\_output})$;\6
+$\\{primitive}(\.{"tracingstats"},\39\\{internal\_quantity},\39\\{tracing%
+\_stats})$;\6
+$\\{primitive}(\.{"tracingonline"},\39\\{internal\_quantity},\39\\{tracing%
+\_online})$;\6
+$\\{primitive}(\.{"year"},\39\\{internal\_quantity},\39\\{year})$;\6
+$\\{primitive}(\.{"month"},\39\\{internal\_quantity},\39\\{month})$;\6
+$\\{primitive}(\.{"day"},\39\\{internal\_quantity},\39\\{day})$;\6
+$\\{primitive}(\.{"time"},\39\\{internal\_quantity},\39\\{time})$;\6
+$\\{primitive}(\.{"charcode"},\39\\{internal\_quantity},\39\\{char\_code})$;\6
+$\\{primitive}(\.{"charext"},\39\\{internal\_quantity},\39\\{char\_ext})$;\6
+$\\{primitive}(\.{"charwd"},\39\\{internal\_quantity},\39\\{char\_wd})$;\6
+$\\{primitive}(\.{"charht"},\39\\{internal\_quantity},\39\\{char\_ht})$;\6
+$\\{primitive}(\.{"chardp"},\39\\{internal\_quantity},\39\\{char\_dp})$;\6
+$\\{primitive}(\.{"charic"},\39\\{internal\_quantity},\39\\{char\_ic})$;\6
+$\\{primitive}(\.{"chardx"},\39\\{internal\_quantity},\39\\{char\_dx})$;\6
+$\\{primitive}(\.{"chardy"},\39\\{internal\_quantity},\39\\{char\_dy})$;\6
+$\\{primitive}(\.{"designsize"},\39\\{internal\_quantity},\39\\{design%
+\_size})$;\6
+$\\{primitive}(\.{"hppp"},\39\\{internal\_quantity},\39\\{hppp})$;\6
+$\\{primitive}(\.{"vppp"},\39\\{internal\_quantity},\39\\{vppp})$;\6
+$\\{primitive}(\.{"xoffset"},\39\\{internal\_quantity},\39\\{x\_offset})$;\6
+$\\{primitive}(\.{"yoffset"},\39\\{internal\_quantity},\39\\{y\_offset})$;\6
+$\\{primitive}(\.{"pausing"},\39\\{internal\_quantity},\39\\{pausing})$;\6
+$\\{primitive}(\.{"showstopping"},\39\\{internal\_quantity},\39%
+\\{showstopping})$;\6
+$\\{primitive}(\.{"fontmaking"},\39\\{internal\_quantity},\39\\{fontmaking})$;\6
+$\\{primitive}(\.{"proofing"},\39\\{internal\_quantity},\39\\{proofing})$;\6
+$\\{primitive}(\.{"smoothing"},\39\\{internal\_quantity},\39\\{smoothing})$;\6
+$\\{primitive}(\.{"autorounding"},\39\\{internal\_quantity},\39%
+\\{autorounding})$;\6
+$\\{primitive}(\.{"granularity"},\39\\{internal\_quantity},\39%
+\\{granularity})$;\6
+$\\{primitive}(\.{"fillin"},\39\\{internal\_quantity},\39\\{fillin})$;\6
+$\\{primitive}(\.{"turningcheck"},\39\\{internal\_quantity},\39\\{turning%
+\_check})$;\6
+$\\{primitive}(\.{"warningcheck"},\39\\{internal\_quantity},\39\\{warning%
+\_check})$;\6
+$\\{primitive}(\.{"boundarychar"},\39\\{internal\_quantity},\39\\{boundary%
+\_char})$;\par
+\As211, 683, 688, 695, 709, 740, 893, 1013, 1018, 1024, 1027, 1037, 1052, 1079,
+1101, 1108\ETs1176.
+\U1210.\fi
+
+\M193. Well, we do have to list the names one more time, for use in symbolic
+printouts.
+
+\Y\P$\4\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}\S$\6
+$\\{int\_name}[\\{tracing\_titles}]\K\.{"tracingtitles"}$;\5
+$\\{int\_name}[\\{tracing\_equations}]\K\.{"tracingequations"}$;\5
+$\\{int\_name}[\\{tracing\_capsules}]\K\.{"tracingcapsules"}$;\5
+$\\{int\_name}[\\{tracing\_choices}]\K\.{"tracingchoices"}$;\5
+$\\{int\_name}[\\{tracing\_specs}]\K\.{"tracingspecs"}$;\5
+$\\{int\_name}[\\{tracing\_pens}]\K\.{"tracingpens"}$;\5
+$\\{int\_name}[\\{tracing\_commands}]\K\.{"tracingcommands"}$;\5
+$\\{int\_name}[\\{tracing\_restores}]\K\.{"tracingrestores"}$;\5
+$\\{int\_name}[\\{tracing\_macros}]\K\.{"tracingmacros"}$;\5
+$\\{int\_name}[\\{tracing\_edges}]\K\.{"tracingedges"}$;\5
+$\\{int\_name}[\\{tracing\_output}]\K\.{"tracingoutput"}$;\5
+$\\{int\_name}[\\{tracing\_stats}]\K\.{"tracingstats"}$;\5
+$\\{int\_name}[\\{tracing\_online}]\K\.{"tracingonline"}$;\5
+$\\{int\_name}[\\{year}]\K\.{"year"}$;\5
+$\\{int\_name}[\\{month}]\K\.{"month"}$;\5
+$\\{int\_name}[\\{day}]\K\.{"day"}$;\5
+$\\{int\_name}[\\{time}]\K\.{"time"}$;\5
+$\\{int\_name}[\\{char\_code}]\K\.{"charcode"}$;\5
+$\\{int\_name}[\\{char\_ext}]\K\.{"charext"}$;\5
+$\\{int\_name}[\\{char\_wd}]\K\.{"charwd"}$;\5
+$\\{int\_name}[\\{char\_ht}]\K\.{"charht"}$;\5
+$\\{int\_name}[\\{char\_dp}]\K\.{"chardp"}$;\5
+$\\{int\_name}[\\{char\_ic}]\K\.{"charic"}$;\5
+$\\{int\_name}[\\{char\_dx}]\K\.{"chardx"}$;\5
+$\\{int\_name}[\\{char\_dy}]\K\.{"chardy"}$;\5
+$\\{int\_name}[\\{design\_size}]\K\.{"designsize"}$;\5
+$\\{int\_name}[\\{hppp}]\K\.{"hppp"}$;\5
+$\\{int\_name}[\\{vppp}]\K\.{"vppp"}$;\5
+$\\{int\_name}[\\{x\_offset}]\K\.{"xoffset"}$;\5
+$\\{int\_name}[\\{y\_offset}]\K\.{"yoffset"}$;\5
+$\\{int\_name}[\\{pausing}]\K\.{"pausing"}$;\5
+$\\{int\_name}[\\{showstopping}]\K\.{"showstopping"}$;\5
+$\\{int\_name}[\\{fontmaking}]\K\.{"fontmaking"}$;\5
+$\\{int\_name}[\\{proofing}]\K\.{"proofing"}$;\5
+$\\{int\_name}[\\{smoothing}]\K\.{"smoothing"}$;\5
+$\\{int\_name}[\\{autorounding}]\K\.{"autorounding"}$;\5
+$\\{int\_name}[\\{granularity}]\K\.{"granularity"}$;\5
+$\\{int\_name}[\\{fillin}]\K\.{"fillin"}$;\5
+$\\{int\_name}[\\{turning\_check}]\K\.{"turningcheck"}$;\5
+$\\{int\_name}[\\{warning\_check}]\K\.{"warningcheck"}$;\5
+$\\{int\_name}[\\{boundary\_char}]\K\.{"boundarychar"}$;\par
+\fi
+
+\M194. The following procedure, which is called just before \MF\ initializes
+its
+input and output, establishes the initial values of the date and time.
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+Note that the values are \\{scaled} integers. Hence \MF\ can no longer
+be used after the year 32767.
+
+\Y\P\4\&{procedure}\1\ \37\\{fix\_date\_and\_time};\2\6
+\&{begin} \37$\\{internal}[\\{time}]\K12\ast60\ast\\{unity}$;\C{minutes since
+midnight}\6
+$\\{internal}[\\{day}]\K4\ast\\{unity}$;\C{fourth day of the month}\6
+$\\{internal}[\\{month}]\K7\ast\\{unity}$;\C{seventh month of the year}\6
+$\\{internal}[\\{year}]\K1776\ast\\{unity}$;\C{Anno Domini}\6
+\&{end};\par
+\fi
+
+\M195. \MF\ is occasionally supposed to print diagnostic information that
+goes only into the transcript file, unless \\{tracing\_online} is positive.
+Now that we have defined \\{tracing\_online} we can define
+two routines that adjust the destination of print commands:
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{begin\_diagnostic};\C{prepare to do some tracing}\2\6
+\&{begin} \37$\\{old\_setting}\K\\{selector}$;\6
+\&{if} $(\\{internal}[\\{tracing\_online}]\L0)\W(\\{selector}=\\{term\_and%
+\_log})$ \1\&{then}\6
+\&{begin} \37$\\{decr}(\\{selector})$;\6
+\&{if} $\\{history}=\\{spotless}$ \1\&{then}\5
+$\\{history}\K\\{warning\_issued}$;\2\6
+\&{end};\2\6
+\&{end};\7
+\4\&{procedure}\1\ \37$\\{end\_diagnostic}(\\{blank\_line}:\\{boolean})$;%
+\C{restore proper conditions after tracing}\2\6
+\&{begin} \37$\\{print\_nl}(\.{""})$;\6
+\&{if} $\\{blank\_line}$ \1\&{then}\5
+\\{print\_ln};\2\6
+$\\{selector}\K\\{old\_setting}$;\6
+\&{end};\par
+\fi
+
+\M196. Of course we had better declare another global variable, if the previous
+routines are going to work.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{old\_setting}: \37$0\to\\{max\_selector}$;\par
+\fi
+
+\M197. We will occasionally use \\{begin\_diagnostic} in connection with
+line-number
+printing, as follows. (The parameter \|s is typically \.{"Path"} or
+\.{"Cycle\ spec"}, etc.)
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_diagnostic}(\|s,\39\|t:\\{str\_number};\,\35%
+\\{nuline}:\\{boolean})$;\2\6
+\&{begin} \37\\{begin\_diagnostic};\6
+\&{if} $\\{nuline}$ \1\&{then}\5
+$\\{print\_nl}(\|s)$\ \&{else} $\\{print}(\|s)$;\2\6
+$\\{print}(\.{"\ at\ line\ "})$;\5
+$\\{print\_int}(\\{line})$;\5
+$\\{print}(\|t)$;\5
+$\\{print\_char}(\.{":"})$;\6
+\&{end};\par
+\fi
+
+\M198. The 256 \\{ASCII\_code} characters are grouped into classes by means of
+the \\{char\_class} table. Individual class numbers have no semantic
+or syntactic significance, except in a few instances defined here.
+There's also \\{max\_class}, which can be used as a basis for additional
+class numbers in nonstandard extensions of \MF.
+
+\Y\P\D \37$\\{digit\_class}=0$\C{the class number of \.{0123456789}}\par
+\P\D \37$\\{period\_class}=1$\C{the class number of `\..'}\par
+\P\D \37$\\{space\_class}=2$\C{the class number of spaces and nonstandard
+characters}\par
+\P\D \37$\\{percent\_class}=3$\C{the class number of `\.\%'}\par
+\P\D \37$\\{string\_class}=4$\C{the class number of `\."'}\par
+\P\D \37$\\{right\_paren\_class}=8$\C{the class number of `\.)'}\par
+\P\D \37$\\{isolated\_classes}\S5,\396,\397,\398$\C{characters that make
+length-one tokens only}\par
+\P\D \37$\\{letter\_class}=9$\C{letters and the underline character}\par
+\P\D \37$\\{left\_bracket\_class}=17$\C{`\.['}\par
+\P\D \37$\\{right\_bracket\_class}=18$\C{`\.]'}\par
+\P\D \37$\\{invalid\_class}=20$\C{bad character in the input}\par
+\P\D \37$\\{max\_class}=20$\C{the largest class number}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{char\_class}: \37\&{array} $[\\{ASCII\_code}]$ \1\&{of}\5
+$0\to\\{max\_class}$;\C{the class numbers}\2\par
+\fi
+
+\M199. If changes are made to accommodate non-ASCII character sets, they should
+follow the guidelines in Appendix~C of {\sl The {\logos METAFONT\/}book}.
+
+\Y\P$\4\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+\&{for} $\|k\K\.{"0"}\mathrel{\&{to}}\.{"9"}$ \1\&{do}\5
+$\\{char\_class}[\|k]\K\\{digit\_class}$;\2\6
+$\\{char\_class}[\.{"."}]\K\\{period\_class}$;\5
+$\\{char\_class}[\.{"\ "}]\K\\{space\_class}$;\5
+$\\{char\_class}[\.{"\%"}]\K\\{percent\_class}$;\5
+$\\{char\_class}[\.{""}\.{""}]\K\\{string\_class}$;\6
+$\\{char\_class}[\.{","}]\K5$;\5
+$\\{char\_class}[\.{";"}]\K6$;\5
+$\\{char\_class}[\.{"("}]\K7$;\5
+$\\{char\_class}[\.{")"}]\K\\{right\_paren\_class}$;\6
+\&{for} $\|k\K\.{"A"}\mathrel{\&{to}}\.{"Z"}$ \1\&{do}\5
+$\\{char\_class}[\|k]\K\\{letter\_class}$;\2\6
+\&{for} $\|k\K\.{"a"}\mathrel{\&{to}}\.{"z"}$ \1\&{do}\5
+$\\{char\_class}[\|k]\K\\{letter\_class}$;\2\6
+$\\{char\_class}[\.{"\_"}]\K\\{letter\_class}$;\6
+$\\{char\_class}[\.{"<"}]\K10$;\5
+$\\{char\_class}[\.{"="}]\K10$;\5
+$\\{char\_class}[\.{">"}]\K10$;\5
+$\\{char\_class}[\.{":"}]\K10$;\5
+$\\{char\_class}[\.{"|"}]\K10$;\6
+$\\{char\_class}[\.{"\`"}]\K11$;\5
+$\\{char\_class}[\.{"\'"}]\K11$;\6
+$\\{char\_class}[\.{"+"}]\K12$;\5
+$\\{char\_class}[\.{"-"}]\K12$;\6
+$\\{char\_class}[\.{"/"}]\K13$;\5
+$\\{char\_class}[\.{"*"}]\K13$;\5
+$\\{char\_class}[\.{"\\"}]\K13$;\6
+$\\{char\_class}[\.{"!"}]\K14$;\5
+$\\{char\_class}[\.{"?"}]\K14$;\6
+$\\{char\_class}[\.{"\#"}]\K15$;\5
+$\\{char\_class}[\.{"\&"}]\K15$;\5
+$\\{char\_class}[\.{"@"}]\K15$;\5
+$\\{char\_class}[\.{"\$"}]\K15$;\6
+$\\{char\_class}[\.{"\^"}]\K16$;\5
+$\\{char\_class}[\.{"\~"}]\K16$;\6
+$\\{char\_class}[\.{"["}]\K\\{left\_bracket\_class}$;\5
+$\\{char\_class}[\.{"]"}]\K\\{right\_bracket\_class}$;\6
+$\\{char\_class}[\.{"\{"}]\K19$;\5
+$\\{char\_class}[\.{"\}"}]\K19$;\6
+\&{for} $\|k\K0\mathrel{\&{to}}\.{"\ "}-1$ \1\&{do}\5
+$\\{char\_class}[\|k]\K\\{invalid\_class}$;\2\6
+\&{for} $\|k\K127\mathrel{\&{to}}255$ \1\&{do}\5
+$\\{char\_class}[\|k]\K\\{invalid\_class}$;\2\par
+\fi
+
+\N200. \[13] The hash table.
+Symbolic tokens are stored and retrieved by means of a fairly standard hash
+table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C
+in {\sl The Art of Computer Programming\/}). Once a symbolic token enters the
+table, it is never removed.
+
+The actual sequence of characters forming a symbolic token is
+stored in the \\{str\_pool} array together with all the other strings. An
+auxiliary array \\{hash} consists of items with two halfword fields per
+word. The first of these, called $\\{next}(\|p)$, points to the next identifier
+belonging to the same coalesced list as the identifier corresponding to~\|p;
+and the other, called $\\{text}(\|p)$, points to the \\{str\_start} entry for
+\|p's identifier. If position~\|p of the hash table is empty, we have
+$\\{text}(\|p)=0$; if position \|p is either empty or the end of a coalesced
+hash list, we have $\\{next}(\|p)=0$.
+
+An auxiliary pointer variable called \\{hash\_used} is maintained in such a
+way that all locations $\|p\G\\{hash\_used}$ are nonempty. The global variable
+\\{st\_count} tells how many symbolic tokens have been defined, if statistics
+are being kept.
+
+The first 256 locations of \\{hash} are reserved for symbols of length one.
+
+There's a parallel array called \\{eqtb} that contains the current equivalent
+values of each symbolic token. The entries of this array consist of
+two halfwords called \\{eq\_type} (a command code) and \\{equiv} (a secondary
+piece of information that qualifies the \\{eq\_type}).
+
+\Y\P\D \37$\\{next}(\#)\S\\{hash}[\#].\\{lh}$\C{link for coalesced lists}\par
+\P\D \37$\\{text}(\#)\S\\{hash}[\#].\\{rh}$\C{string number for symbolic token
+name}\par
+\P\D \37$\\{eq\_type}(\#)\S\\{eqtb}[\#].\\{lh}$\C{the current ``meaning'' of a
+symbolic token}\par
+\P\D \37$\\{equiv}(\#)\S\\{eqtb}[\#].\\{rh}$\C{parametric part of a token's
+meaning}\par
+\P\D \37$\\{hash\_base}=257$\C{hashing actually starts here}\par
+\P\D \37$\\{hash\_is\_full}\S(\\{hash\_used}=\\{hash\_base})$\C{are all
+positions occupied?}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{hash\_used}: \37\\{pointer};\C{allocation pointer for \\{hash}}\6
+\4\\{st\_count}: \37\\{integer};\C{total number of known identifiers}\par
+\fi
+
+\M201. Certain entries in the hash table are ``frozen'' and not redefinable,
+since they are used in error recovery.
+
+\Y\P\D \37$\\{hash\_top}\S\\{hash\_base}+\\{hash\_size}$\C{the first location
+of the frozen area}\par
+\P\D \37$\\{frozen\_inaccessible}\S\\{hash\_top}$\C{\\{hash} location to
+protect the frozen area}\par
+\P\D \37$\\{frozen\_repeat\_loop}\S\\{hash\_top}+1$\C{\\{hash} location of a
+loop-repeat token}\par
+\P\D \37$\\{frozen\_right\_delimiter}\S\\{hash\_top}+2$\C{\\{hash} location of
+a permanent `\.)'}\par
+\P\D \37$\\{frozen\_left\_bracket}\S\\{hash\_top}+3$\C{\\{hash} location of a
+permanent `\.['}\par
+\P\D \37$\\{frozen\_slash}\S\\{hash\_top}+4$\C{\\{hash} location of a permanent
+`\./'}\par
+\P\D \37$\\{frozen\_colon}\S\\{hash\_top}+5$\C{\\{hash} location of a permanent
+`\.:'}\par
+\P\D \37$\\{frozen\_semicolon}\S\\{hash\_top}+6$\C{\\{hash} location of a
+permanent `\.;'}\par
+\P\D \37$\\{frozen\_end\_for}\S\\{hash\_top}+7$\C{\\{hash} location of a
+permanent \&{endfor}}\par
+\P\D \37$\\{frozen\_end\_def}\S\\{hash\_top}+8$\C{\\{hash} location of a
+permanent \&{enddef}}\par
+\P\D \37$\\{frozen\_fi}\S\\{hash\_top}+9$\C{\\{hash} location of a permanent %
+\&{fi}}\par
+\P\D \37$\\{frozen\_end\_group}\S\\{hash\_top}+10$\C{\\{hash} location of a
+permanent `\.{endgroup}'}\par
+\P\D \37$\\{frozen\_bad\_vardef}\S\\{hash\_top}+11$\C{\\{hash} location of `%
+\.{a bad variable}'}\par
+\P\D \37$\\{frozen\_undefined}\S\\{hash\_top}+12$\C{\\{hash} location that
+never gets defined}\par
+\P\D \37$\\{hash\_end}\S\\{hash\_top}+12$\C{the actual size of the \\{hash} and
+\\{eqtb} arrays}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{hash}: \37\&{array} $[1\to\\{hash\_end}]$ \1\&{of}\5
+\\{two\_halves};\C{the hash table}\2\6
+\4\\{eqtb}: \37\&{array} $[1\to\\{hash\_end}]$ \1\&{of}\5
+\\{two\_halves};\C{the equivalents}\2\par
+\fi
+
+\M202. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{next}(1)\K0$;\5
+$\\{text}(1)\K0$;\5
+$\\{eq\_type}(1)\K\\{tag\_token}$;\5
+$\\{equiv}(1)\K\\{null}$;\6
+\&{for} $\|k\K2\mathrel{\&{to}}\\{hash\_end}$ \1\&{do}\6
+\&{begin} \37$\\{hash}[\|k]\K\\{hash}[1]$;\5
+$\\{eqtb}[\|k]\K\\{eqtb}[1]$;\6
+\&{end};\2\par
+\fi
+
+\M203. \P$\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}%
+\S$\6
+$\\{hash\_used}\K\\{frozen\_inaccessible}$;\C{nothing is used}\6
+$\\{st\_count}\K0$;\6
+$\\{text}(\\{frozen\_bad\_vardef})\K\.{"a\ bad\ variable"}$;\5
+$\\{text}(\\{frozen\_fi})\K\.{"fi"}$;\5
+$\\{text}(\\{frozen\_end\_group})\K\.{"endgroup"}$;\5
+$\\{text}(\\{frozen\_end\_def})\K\.{"enddef"}$;\5
+$\\{text}(\\{frozen\_end\_for})\K\.{"endfor"}$;\6
+$\\{text}(\\{frozen\_semicolon})\K\.{";"}$;\5
+$\\{text}(\\{frozen\_colon})\K\.{":"}$;\5
+$\\{text}(\\{frozen\_slash})\K\.{"/"}$;\5
+$\\{text}(\\{frozen\_left\_bracket})\K\.{"["}$;\5
+$\\{text}(\\{frozen\_right\_delimiter})\K\.{")"}$;\6
+$\\{text}(\\{frozen\_inaccessible})\K\.{"\ INACCESSIBLE"}$;\6
+$\\{eq\_type}(\\{frozen\_right\_delimiter})\K\\{right\_delimiter}$;\par
+\fi
+
+\M204. \P$\X14:Check the ``constant'' values for consistency\X\mathrel{+}\S$\6
+\&{if} $\\{hash\_end}+\\{max\_internal}>\\{max\_halfword}$ \1\&{then}\5
+$\\{bad}\K21$;\2\par
+\fi
+
+\M205. Here is the subroutine that searches the hash table for an identifier
+that matches a given string of length~\|l appearing in $\\{buffer}[\|j\to(\|j+%
+\|l-1)]$. If the identifier is not found, it is inserted; hence it
+will always be found, and the corresponding hash table address
+will be returned.
+
+\Y\P\4\&{function}\1\ \37$\\{id\_lookup}(\|j,\39\|l:\\{integer})$: \37%
+\\{pointer};\C{search the hash table}\6
+\4\&{label} \37\\{found};\C{go here when you've found it}\6
+\4\&{var} \37\|h: \37\\{integer};\C{hash code}\6
+\|p: \37\\{pointer};\C{index in \\{hash} array}\6
+\|k: \37\\{pointer};\C{index in \\{buffer} array}\2\6
+\&{begin} \37\&{if} $\|l=1$ \1\&{then}\5
+\X206:Treat special case of length 1 and \&{goto} \\{found}\X;\2\6
+\X208:Compute the hash code \|h\X;\6
+$\|p\K\|h+\\{hash\_base}$;\C{we start searching here; note that $0\L\|h<\\{hash%
+\_prime}$}\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\\{text}(\|p)>0$ \1\&{then}\6
+\&{if} $\\{length}(\\{text}(\|p))=\|l$ \1\&{then}\6
+\&{if} $\\{str\_eq\_buf}(\\{text}(\|p),\39\|j)$ \1\&{then}\5
+\&{goto} \37\\{found};\2\2\2\6
+\&{if} $\\{next}(\|p)=0$ \1\&{then}\5
+\X207:Insert a new symbolic token after \|p, then make \|p point to it and %
+\&{goto} \\{found}\X;\2\6
+$\|p\K\\{next}(\|p)$;\6
+\&{end};\2\6
+\4\\{found}: \37$\\{id\_lookup}\K\|p$;\6
+\&{end};\par
+\fi
+
+\M206. \P$\X206:Treat special case of length 1 and \&{goto} \\{found}\X\S$\6
+\&{begin} \37$\|p\K\\{buffer}[\|j]+1$;\5
+$\\{text}(\|p)\K\|p-1$;\5
+\&{goto} \37\\{found};\6
+\&{end}\par
+\U205.\fi
+
+\M207. \P$\X207:Insert a new symbolic token after \|p, then make \|p point to
+it and \&{goto} \\{found}\X\S$\6
+\&{begin} \37\&{if} $\\{text}(\|p)>0$ \1\&{then}\6
+\&{begin} \37\1\&{repeat} \37\&{if} $\\{hash\_is\_full}$ \1\&{then}\5
+$\\{overflow}(\.{"hash\ size"},\39\\{hash\_size})$;\2\6
+$\\{decr}(\\{hash\_used})$;\6
+\4\&{until}\5
+$\\{text}(\\{hash\_used})=0$;\C{search for an empty location in \\{hash}}\2\6
+$\\{next}(\|p)\K\\{hash\_used}$;\5
+$\|p\K\\{hash\_used}$;\6
+\&{end};\2\6
+$\\{str\_room}(\|l)$;\6
+\&{for} $\|k\K\|j\mathrel{\&{to}}\|j+\|l-1$ \1\&{do}\5
+$\\{append\_char}(\\{buffer}[\|k])$;\2\6
+$\\{text}(\|p)\K\\{make\_string}$;\5
+$\\{str\_ref}[\\{text}(\|p)]\K\\{max\_str\_ref}$;\6
+\&{stat} \37$\\{incr}(\\{st\_count})$;\ \&{tats}\6
+\&{goto} \37\\{found};\6
+\&{end}\par
+\U205.\fi
+
+\M208. The value of \\{hash\_prime} should be roughly 85\pct! of \\{hash%
+\_size}, and it
+should be a prime number. The theory of hashing tells us to expect fewer
+than two table probes, on the average, when the search is successful.
+[See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983), 231--258.]
+
+\Y\P$\4\X208:Compute the hash code \|h\X\S$\6
+$\|h\K\\{buffer}[\|j]$;\6
+\&{for} $\|k\K\|j+1\mathrel{\&{to}}\|j+\|l-1$ \1\&{do}\6
+\&{begin} \37$\|h\K\|h+\|h+\\{buffer}[\|k]$;\6
+\&{while} $\|h\G\\{hash\_prime}$ \1\&{do}\5
+$\|h\K\|h-\\{hash\_prime}$;\2\6
+\&{end}\2\par
+\U205.\fi
+
+\M209. \P$\X209:Search \\{eqtb} for equivalents equal to \|p\X\S$\6
+\&{for} $\|q\K1\mathrel{\&{to}}\\{hash\_end}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{equiv}(\|q)=\|p$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"EQUIV("})$;\5
+$\\{print\_int}(\|q)$;\5
+$\\{print\_char}(\.{")"})$;\6
+\&{end};\2\6
+\&{end}\2\par
+\U185.\fi
+
+\M210. We need to put \MF's ``primitive'' symbolic tokens into the hash
+table, together with their command code (which will be the \\{eq\_type})
+and an operand (which will be the \\{equiv}). The \\{primitive} procedure
+does this, in a way that no \MF\ user can. The global value \\{cur\_sym}
+contains the new \\{eqtb} pointer after \\{primitive} has acted.
+
+\Y\P\&{init} \37\&{procedure}\1\ \37$\\{primitive}(\|s:\\{str\_number};\,\35%
+\|c:\\{halfword};\,\35\|o:\\{halfword})$;\6
+\4\&{var} \37\|k: \37\\{pool\_pointer};\C{index into \\{str\_pool}}\6
+\|j: \37\\{small\_number};\C{index into \\{buffer}}\6
+\|l: \37\\{small\_number};\C{length of the string}\2\6
+\&{begin} \37$\|k\K\\{str\_start}[\|s]$;\5
+$\|l\K\\{str\_start}[\|s+1]-\|k$;\C{we will move \|s into the (empty) %
+\\{buffer}}\6
+\&{for} $\|j\K0\mathrel{\&{to}}\|l-1$ \1\&{do}\5
+$\\{buffer}[\|j]\K\\{so}(\\{str\_pool}[\|k+\|j])$;\2\6
+$\\{cur\_sym}\K\\{id\_lookup}(0,\39\|l)$;\6
+\&{if} $\|s\G256$ \1\&{then}\C{we don't want to have the string twice}\6
+\&{begin} \37$\\{flush\_string}(\\{str\_ptr}-1)$;\5
+$\\{text}(\\{cur\_sym})\K\|s$;\6
+\&{end};\2\6
+$\\{eq\_type}(\\{cur\_sym})\K\|c$;\5
+$\\{equiv}(\\{cur\_sym})\K\|o$;\6
+\&{end};\6
+\&{tini}\par
+\fi
+
+\M211. Many of \MF's primitives need no \\{equiv}, since they are identifiable
+by their \\{eq\_type} alone. These primitives are loaded into the hash table
+as follows:
+
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{".."},\39\\{path\_join},\390)$;\6
+$\\{primitive}(\.{"["},\39\\{left\_bracket},\390)$;\5
+$\\{eqtb}[\\{frozen\_left\_bracket}]\K\\{eqtb}[\\{cur\_sym}]$;\6
+$\\{primitive}(\.{"]"},\39\\{right\_bracket},\390)$;\6
+$\\{primitive}(\.{"\}"},\39\\{right\_brace},\390)$;\6
+$\\{primitive}(\.{"\{"},\39\\{left\_brace},\390)$;\6
+$\\{primitive}(\.{":"},\39\\{colon},\390)$;\5
+$\\{eqtb}[\\{frozen\_colon}]\K\\{eqtb}[\\{cur\_sym}]$;\6
+$\\{primitive}(\.{"::"},\39\\{double\_colon},\390)$;\6
+$\\{primitive}(\.{"||:"},\39\\{bchar\_label},\390)$;\6
+$\\{primitive}(\.{":="},\39\\{assignment},\390)$;\6
+$\\{primitive}(\.{","},\39\\{comma},\390)$;\6
+$\\{primitive}(\.{";"},\39\\{semicolon},\390)$;\5
+$\\{eqtb}[\\{frozen\_semicolon}]\K\\{eqtb}[\\{cur\_sym}]$;\6
+$\\{primitive}(\.{"\\"},\39\\{relax},\390)$;\7
+$\\{primitive}(\.{"addto"},\39\\{add\_to\_command},\390)$;\6
+$\\{primitive}(\.{"at"},\39\\{at\_token},\390)$;\6
+$\\{primitive}(\.{"atleast"},\39\\{at\_least},\390)$;\6
+$\\{primitive}(\.{"begingroup"},\39\\{begin\_group},\390)$;\5
+$\\{bg\_loc}\K\\{cur\_sym}$;\6
+$\\{primitive}(\.{"controls"},\39\\{controls},\390)$;\6
+$\\{primitive}(\.{"cull"},\39\\{cull\_command},\390)$;\6
+$\\{primitive}(\.{"curl"},\39\\{curl\_command},\390)$;\6
+$\\{primitive}(\.{"delimiters"},\39\\{delimiters},\390)$;\6
+$\\{primitive}(\.{"display"},\39\\{display\_command},\390)$;\6
+$\\{primitive}(\.{"endgroup"},\39\\{end\_group},\390)$;\5
+$\\{eqtb}[\\{frozen\_end\_group}]\K\\{eqtb}[\\{cur\_sym}]$;\5
+$\\{eg\_loc}\K\\{cur\_sym}$;\6
+$\\{primitive}(\.{"everyjob"},\39\\{every\_job\_command},\390)$;\6
+$\\{primitive}(\.{"exitif"},\39\\{exit\_test},\390)$;\6
+$\\{primitive}(\.{"expandafter"},\39\\{expand\_after},\390)$;\6
+$\\{primitive}(\.{"from"},\39\\{from\_token},\390)$;\6
+$\\{primitive}(\.{"inwindow"},\39\\{in\_window},\390)$;\6
+$\\{primitive}(\.{"interim"},\39\\{interim\_command},\390)$;\6
+$\\{primitive}(\.{"let"},\39\\{let\_command},\390)$;\6
+$\\{primitive}(\.{"newinternal"},\39\\{new\_internal},\390)$;\6
+$\\{primitive}(\.{"of"},\39\\{of\_token},\390)$;\6
+$\\{primitive}(\.{"openwindow"},\39\\{open\_window},\390)$;\6
+$\\{primitive}(\.{"randomseed"},\39\\{random\_seed},\390)$;\6
+$\\{primitive}(\.{"save"},\39\\{save\_command},\390)$;\6
+$\\{primitive}(\.{"scantokens"},\39\\{scan\_tokens},\390)$;\6
+$\\{primitive}(\.{"shipout"},\39\\{ship\_out\_command},\390)$;\6
+$\\{primitive}(\.{"skipto"},\39\\{skip\_to},\390)$;\6
+$\\{primitive}(\.{"step"},\39\\{step\_token},\390)$;\6
+$\\{primitive}(\.{"str"},\39\\{str\_op},\390)$;\6
+$\\{primitive}(\.{"tension"},\39\\{tension},\390)$;\6
+$\\{primitive}(\.{"to"},\39\\{to\_token},\390)$;\6
+$\\{primitive}(\.{"until"},\39\\{until\_token},\390)$;\par
+\fi
+
+\M212. Each primitive has a corresponding inverse, so that it is possible to
+display the cryptic numeric contents of \\{eqtb} in symbolic form.
+Every call of \\{primitive} in this program is therefore accompanied by some
+straightforward code that forms part of the \\{print\_cmd\_mod} routine
+explained below.
+
+\Y\P$\4\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of primitives\X%
+\S$\6
+\4\\{add\_to\_command}: \37$\\{print}(\.{"addto"})$;\6
+\4\\{assignment}: \37$\\{print}(\.{":="})$;\6
+\4\\{at\_least}: \37$\\{print}(\.{"atleast"})$;\6
+\4\\{at\_token}: \37$\\{print}(\.{"at"})$;\6
+\4\\{bchar\_label}: \37$\\{print}(\.{"||:"})$;\6
+\4\\{begin\_group}: \37$\\{print}(\.{"begingroup"})$;\6
+\4\\{colon}: \37$\\{print}(\.{":"})$;\6
+\4\\{comma}: \37$\\{print}(\.{","})$;\6
+\4\\{controls}: \37$\\{print}(\.{"controls"})$;\6
+\4\\{cull\_command}: \37$\\{print}(\.{"cull"})$;\6
+\4\\{curl\_command}: \37$\\{print}(\.{"curl"})$;\6
+\4\\{delimiters}: \37$\\{print}(\.{"delimiters"})$;\6
+\4\\{display\_command}: \37$\\{print}(\.{"display"})$;\6
+\4\\{double\_colon}: \37$\\{print}(\.{"::"})$;\6
+\4\\{end\_group}: \37$\\{print}(\.{"endgroup"})$;\6
+\4\\{every\_job\_command}: \37$\\{print}(\.{"everyjob"})$;\6
+\4\\{exit\_test}: \37$\\{print}(\.{"exitif"})$;\6
+\4\\{expand\_after}: \37$\\{print}(\.{"expandafter"})$;\6
+\4\\{from\_token}: \37$\\{print}(\.{"from"})$;\6
+\4\\{in\_window}: \37$\\{print}(\.{"inwindow"})$;\6
+\4\\{interim\_command}: \37$\\{print}(\.{"interim"})$;\6
+\4\\{left\_brace}: \37$\\{print}(\.{"\{"})$;\6
+\4\\{left\_bracket}: \37$\\{print}(\.{"["})$;\6
+\4\\{let\_command}: \37$\\{print}(\.{"let"})$;\6
+\4\\{new\_internal}: \37$\\{print}(\.{"newinternal"})$;\6
+\4\\{of\_token}: \37$\\{print}(\.{"of"})$;\6
+\4\\{open\_window}: \37$\\{print}(\.{"openwindow"})$;\6
+\4\\{path\_join}: \37$\\{print}(\.{".."})$;\6
+\4\\{random\_seed}: \37$\\{print}(\.{"randomseed"})$;\6
+\4\\{relax}: \37$\\{print\_char}(\.{"\\"})$;\6
+\4\\{right\_brace}: \37$\\{print}(\.{"\}"})$;\6
+\4\\{right\_bracket}: \37$\\{print}(\.{"]"})$;\6
+\4\\{save\_command}: \37$\\{print}(\.{"save"})$;\6
+\4\\{scan\_tokens}: \37$\\{print}(\.{"scantokens"})$;\6
+\4\\{semicolon}: \37$\\{print}(\.{";"})$;\6
+\4\\{ship\_out\_command}: \37$\\{print}(\.{"shipout"})$;\6
+\4\\{skip\_to}: \37$\\{print}(\.{"skipto"})$;\6
+\4\\{step\_token}: \37$\\{print}(\.{"step"})$;\6
+\4\\{str\_op}: \37$\\{print}(\.{"str"})$;\6
+\4\\{tension}: \37$\\{print}(\.{"tension"})$;\6
+\4\\{to\_token}: \37$\\{print}(\.{"to"})$;\6
+\4\\{until\_token}: \37$\\{print}(\.{"until"})$;\par
+\As684, 689, 696, 710, 741, 894, 1014, 1019, 1025, 1028, 1038, 1043, 1053,
+1080, 1102, 1109\ETs1180.
+\U625.\fi
+
+\M213. We will deal with the other primitives later, at some point in the
+program
+where their \\{eq\_type} and \\{equiv} values are more meaningful. For
+example,
+the primitives for macro definitions will be loaded when we consider the
+routines that define macros.
+It is easy to find where each particular
+primitive was treated by looking in the index at the end; for example, the
+section where \.{"def"} entered \\{eqtb} is listed under `\&{def} primitive'.
+
+\fi
+
+\N214. \[14] Token lists.
+A \MF\ token is either symbolic or numeric or a string, or it denotes
+a macro parameter or capsule; so there are five corresponding ways to encode it
+internally: (1)~A symbolic token whose hash code is~\|p
+is represented by the number \|p, in the \\{info} field of a single-word
+node in~\\{mem}. (2)~A numeric token whose \\{scaled} value is~\|v is
+represented in a two-word node of~\\{mem}; the \\{type} field is \\{known},
+the \\{name\_type} field is \\{token}, and the \\{value} field holds~\|v.
+The fact that this token appears in a two-word node rather than a
+one-word node is, of course, clear from the node address.
+(3)~A string token is also represented in a two-word node; the \\{type}
+field is \\{string\_type}, the \\{name\_type} field is \\{token}, and the
+\\{value} field holds the corresponding \\{str\_number}. (4)~Capsules have
+$\\{name\_type}=\\{capsule}$, and their \\{type} and \\{value} fields represent
+arbitrary values (in ways to be explained later). (5)~Macro parameters
+are like symbolic tokens in that they appear in \\{info} fields of
+one-word nodes. The $k$th parameter is represented by $\\{expr\_base}+\|k$ if
+it
+is of type \&{expr}, or by $\\{suffix\_base}+\|k$ if it is of type \&{suffix},
+or
+by $\\{text\_base}+\|k$ if it is of type \&{text}. (Here $0\L\|k<\\{param%
+\_size}$.)
+Actual values of these parameters are kept in a separate stack, as we will
+see later. The constants \\{expr\_base}, \\{suffix\_base}, and \\{text\_base}
+are,
+of course, chosen so that there will be no confusion between symbolic
+tokens and parameters of various types.
+
+It turns out that $\\{value}(\\{null})=0$, because $\\{null}=\\{null\_coords}$;
+we will make use of this coincidence later.
+
+Incidentally, while we're speaking of coincidences, we might note that
+the `\\{type}' field of a node has nothing to do with ``type'' in a
+printer's sense. It's curious that the same word is used in such different
+ways.
+
+\Y\P\D \37$\\{type}(\#)\S\\{mem}[\#].\\{hh}.\\{b0}$\C{identifies what kind of
+value this is}\par
+\P\D \37$\\{name\_type}(\#)\S\\{mem}[\#].\\{hh}.\\{b1}$\C{a clue to the name of
+this value}\par
+\P\D \37$\\{token\_node\_size}=2$\C{the number of words in a large token node}%
+\par
+\P\D \37$\\{value\_loc}(\#)\S\#+1$\C{the word that contains the \\{value}
+field}\par
+\P\D \37$\\{value}(\#)\S\\{mem}[\\{value\_loc}(\#)].\\{int}$\C{the value stored
+in a large token node}\par
+\P\D \37$\\{expr\_base}\S\\{hash\_end}+1$\C{code for the zeroth \&{expr}
+parameter}\par
+\P\D \37$\\{suffix\_base}\S\\{expr\_base}+\\{param\_size}$\C{code for the
+zeroth \&{suffix} parameter}\par
+\P\D \37$\\{text\_base}\S\\{suffix\_base}+\\{param\_size}$\C{code for the
+zeroth \&{text} parameter}\par
+\Y\P$\4\X14:Check the ``constant'' values for consistency\X\mathrel{+}\S$\6
+\&{if} $\\{text\_base}+\\{param\_size}>\\{max\_halfword}$ \1\&{then}\5
+$\\{bad}\K22$;\2\par
+\fi
+
+\M215. A numeric token is created by the following trivial routine.
+
+\Y\P\4\&{function}\1\ \37$\\{new\_num\_tok}(\|v:\\{scaled})$: \37\\{pointer};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the new node}\2\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{token\_node\_size})$;\5
+$\\{value}(\|p)\K\|v$;\5
+$\\{type}(\|p)\K\\{known}$;\5
+$\\{name\_type}(\|p)\K\\{token}$;\5
+$\\{new\_num\_tok}\K\|p$;\6
+\&{end};\par
+\fi
+
+\M216. A token list is a singly linked list of nodes in \\{mem}, where
+each node contains a token and a link. Here's a subroutine that gets rid
+of a token list when it is no longer needed.
+
+\Y\P\4\&{procedure}\1\ \37\\{token\_recycle};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37$\\{flush\_token\_list}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the node being recycled}\2\6
+\&{begin} \37\&{while} $\|p\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\|q\K\|p$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{if} $\|q\G\\{hi\_mem\_min}$ \1\&{then}\5
+$\\{free\_avail}(\|q)$\6
+\4\&{else} \&{begin} \37\&{case} $\\{type}(\|q)$ \1\&{of}\6
+\4$\\{vacuous},\39\\{boolean\_type},\39\\{known}$: \37\\{do\_nothing};\6
+\4\\{string\_type}: \37$\\{delete\_str\_ref}(\\{value}(\|q))$;\6
+\4$\\{unknown\_types},\39\\{pen\_type},\39\\{path\_type},\39\\{future\_pen},\39%
+\\{picture\_type},\39\\{pair\_type},\39\\{transform\_type},\39\\{dependent},\39%
+\\{proto\_dependent},\39\\{independent}$: \37\&{begin} \37$\\{g\_pointer}\K%
+\|q$;\5
+\\{token\_recycle};\6
+\&{end};\6
+\4\&{othercases} \37$\\{confusion}(\.{"token"})$\2\6
+\&{endcases};\6
+$\\{free\_node}(\|q,\39\\{token\_node\_size})$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M217. The procedure \\{show\_token\_list}, which prints a symbolic form of
+the token list that starts at a given node \|p, illustrates these
+conventions. The token list being displayed should not begin with a reference
+count. However, the procedure is intended to be fairly robust, so that if the
+memory links are awry or if \|p is not really a pointer to a token list,
+almost nothing catastrophic can happen.
+
+An additional parameter \|q is also given; this parameter is either null
+or it points to a node in the token list where a certain magic computation
+takes place that will be explained later. (Basically, \|q is non-null when
+we are printing the two-line context information at the time of an error
+message; \|q marks the place corresponding to where the second line
+should begin.)
+
+The generation will stop, and `\.{\char`\ ETC.}' will be printed, if the length
+of printing exceeds a given limit~\|l; the length of printing upon entry is
+assumed to be a given amount called \\{null\_tally}. (Note that
+\\{show\_token\_list} sometimes uses itself recursively to print
+variable names within a capsule.)
+
+Unusual entries are printed in the form of all-caps tokens
+preceded by a space, e.g., `\.{\char`\ BAD}'.
+
+\Y\P$\4\X217:Declare the procedure called \\{show\_token\_list}\X\S$\6
+\4\&{procedure}\1\ \37\\{print\_capsule};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37$\\{show\_token\_list}(\|p,\39\|q:\\{integer};\,\35\|l,%
+\39\\{null\_tally}:\\{integer})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37$\\{class},\39\|c$: \37\\{small\_number};\C{the \\{char\_class} of
+previous and new tokens}\6
+$\|r,\39\|v$: \37\\{integer};\C{temporary registers}\2\6
+\&{begin} \37$\\{class}\K\\{percent\_class}$;\5
+$\\{tally}\K\\{null\_tally}$;\6
+\&{while} $(\|p\I\\{null})\W(\\{tally}<\|l)$ \1\&{do}\6
+\&{begin} \37\&{if} $\|p=\|q$ \1\&{then}\5
+\X646:Do magic computation\X;\2\6
+\X218:Display token \|p and set \|c to its class; but \&{return} if there are
+problems\X;\6
+$\\{class}\K\|c$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\&{if} $\|p\I\\{null}$ \1\&{then}\5
+$\\{print}(\.{"\ ETC."})$;\2\6
+\4\\{exit}: \37\&{end};\par
+\U162.\fi
+
+\M218. \P$\X218:Display token \|p and set \|c to its class; but \&{return} if
+there are problems\X\S$\6
+$\|c\K\\{letter\_class}$;\C{the default}\6
+\&{if} $(\|p<\\{mem\_min})\V(\|p>\\{mem\_end})$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"\ CLOBBERED"})$;\5
+\&{return};\6
+\&{end};\2\6
+\&{if} $\|p<\\{hi\_mem\_min}$ \1\&{then}\5
+\X219:Display two-word token\X\6
+\4\&{else} \&{begin} \37$\|r\K\\{info}(\|p)$;\6
+\&{if} $\|r\G\\{expr\_base}$ \1\&{then}\5
+\X222:Display a parameter token\X\6
+\4\&{else} \&{if} $\|r<1$ \1\&{then}\6
+\&{if} $\|r=0$ \1\&{then}\5
+\X221:Display a collective subscript\X\6
+\4\&{else} $\\{print}(\.{"\ IMPOSSIBLE"})$\2\6
+\4\&{else} \&{begin} \37$\|r\K\\{text}(\|r)$;\6
+\&{if} $(\|r<0)\V(\|r\G\\{str\_ptr})$ \1\&{then}\5
+$\\{print}(\.{"\ NONEXISTENT"})$\6
+\4\&{else} \X223:Print string \|r as a symbolic token and set \|c to its class%
+\X;\2\6
+\&{end};\2\2\6
+\&{end}\2\par
+\U217.\fi
+
+\M219. \P$\X219:Display two-word token\X\S$\6
+\&{if} $\\{name\_type}(\|p)=\\{token}$ \1\&{then}\6
+\&{if} $\\{type}(\|p)=\\{known}$ \1\&{then}\5
+\X220:Display a numeric token\X\6
+\4\&{else} \&{if} $\\{type}(\|p)\I\\{string\_type}$ \1\&{then}\5
+$\\{print}(\.{"\ BAD"})$\6
+\4\&{else} \&{begin} \37$\\{print\_char}(\.{""}\.{""})$;\5
+$\\{slow\_print}(\\{value}(\|p))$;\5
+$\\{print\_char}(\.{""}\.{""})$;\5
+$\|c\K\\{string\_class}$;\6
+\&{end}\2\2\6
+\4\&{else} \&{if} $(\\{name\_type}(\|p)\I\\{capsule})\V(\\{type}(\|p)<%
+\\{vacuous})\V(\\{type}(\|p)>\\{independent})$ \1\&{then}\5
+$\\{print}(\.{"\ BAD"})$\6
+\4\&{else} \&{begin} \37$\\{g\_pointer}\K\|p$;\5
+\\{print\_capsule};\5
+$\|c\K\\{right\_paren\_class}$;\6
+\&{end}\2\2\par
+\U218.\fi
+
+\M220. \P$\X220:Display a numeric token\X\S$\6
+\&{begin} \37\&{if} $\\{class}=\\{digit\_class}$ \1\&{then}\5
+$\\{print\_char}(\.{"\ "})$;\2\6
+$\|v\K\\{value}(\|p)$;\6
+\&{if} $\|v<0$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{class}=\\{left\_bracket\_class}$ \1\&{then}\5
+$\\{print\_char}(\.{"\ "})$;\2\6
+$\\{print\_char}(\.{"["})$;\5
+$\\{print\_scaled}(\|v)$;\5
+$\\{print\_char}(\.{"]"})$;\5
+$\|c\K\\{right\_bracket\_class}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{print\_scaled}(\|v)$;\5
+$\|c\K\\{digit\_class}$;\6
+\&{end};\2\6
+\&{end}\par
+\U219.\fi
+
+\M221. Strictly speaking, a genuine token will never have $\\{info}(\|p)=0$.
+But we will see later (in the \\{print\_variable\_name} routine) that
+it is convenient to let $\\{info}(\|p)=0$ stand for `\.{[]}'.
+
+\Y\P$\4\X221:Display a collective subscript\X\S$\6
+\&{begin} \37\&{if} $\\{class}=\\{left\_bracket\_class}$ \1\&{then}\5
+$\\{print\_char}(\.{"\ "})$;\2\6
+$\\{print}(\.{"[]"})$;\5
+$\|c\K\\{right\_bracket\_class}$;\6
+\&{end}\par
+\U218.\fi
+
+\M222. \P$\X222:Display a parameter token\X\S$\6
+\&{begin} \37\&{if} $\|r<\\{suffix\_base}$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"(EXPR"})$;\5
+$\|r\K\|r-(\\{expr\_base})$;\6
+\&{end}\6
+\4\&{else} \&{if} $\|r<\\{text\_base}$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"(SUFFIX"})$;\5
+$\|r\K\|r-(\\{suffix\_base})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{print}(\.{"(TEXT"})$;\5
+$\|r\K\|r-(\\{text\_base})$;\6
+\&{end};\2\2\6
+$\\{print\_int}(\|r)$;\5
+$\\{print\_char}(\.{")"})$;\5
+$\|c\K\\{right\_paren\_class}$;\6
+\&{end}\par
+\U218.\fi
+
+\M223. \P$\X223:Print string \|r as a symbolic token and set \|c to its class\X%
+\S$\6
+\&{begin} \37$\|c\K\\{char\_class}[\\{so}(\\{str\_pool}[\\{str\_start}[%
+\|r]])]$;\6
+\&{if} $\|c=\\{class}$ \1\&{then}\6
+\&{case} $\|c$ \1\&{of}\6
+\4\\{letter\_class}: \37$\\{print\_char}(\.{"."})$;\6
+\4\\{isolated\_classes}: \37\\{do\_nothing};\6
+\4\&{othercases} \37$\\{print\_char}(\.{"\ "})$\2\6
+\&{endcases};\2\6
+$\\{slow\_print}(\|r)$;\6
+\&{end}\par
+\U218.\fi
+
+\M224. The following procedures have been declared \\{forward} with no
+parameters,
+because the author dislikes \PASCAL's convention about \\{forward} procedures
+with parameters. It was necessary to do something, because \\{show\_token%
+\_list}
+is recursive (although the recursion is limited to one level), and because
+\\{flush\_token\_list} is syntactically (but not semantically) recursive.
+
+\Y\P$\4\X224:Declare miscellaneous procedures that were declared \\{forward}\X%
+\S$\6
+\4\&{procedure}\1\ \37\\{print\_capsule};\2\6
+\&{begin} \37$\\{print\_char}(\.{"("})$;\5
+$\\{print\_exp}(\\{g\_pointer},\390)$;\5
+$\\{print\_char}(\.{")"})$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37\\{token\_recycle};\2\6
+\&{begin} \37$\\{recycle\_value}(\\{g\_pointer})$;\6
+\&{end};\par
+\U1202.\fi
+
+\M225. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{g\_pointer}: \37\\{pointer};\C{(global) parameter to the \\{forward}
+procedures}\par
+\fi
+
+\M226. Macro definitions are kept in \MF's memory in the form of token lists
+that have a few extra one-word nodes at the beginning.
+
+The first node contains a reference count that is used to tell when the
+list is no longer needed. To emphasize the fact that a reference count is
+present, we shall refer to the \\{info} field of this special node as the
+\\{ref\_count} field.
+
+The next node or nodes after the reference count serve to describe the
+formal parameters. They either contain a code word that specifies all
+of the parameters, or they contain zero or more parameter tokens followed
+by the code `\\{general\_macro}'.
+
+\Y\P\D \37$\\{ref\_count}\S\\{info}$\C{reference count preceding a macro
+definition or pen header}\par
+\P\D \37$\\{add\_mac\_ref}(\#)\S\\{incr}(\\{ref\_count}(\#))$\C{make a new
+reference to a macro list}\par
+\P\D \37$\\{general\_macro}=0$\C{preface to a macro defined with a parameter
+list}\par
+\P\D \37$\\{primary\_macro}=1$\C{preface to a macro with a \&{primary}
+parameter}\par
+\P\D \37$\\{secondary\_macro}=2$\C{preface to a macro with a \&{secondary}
+parameter}\par
+\P\D \37$\\{tertiary\_macro}=3$\C{preface to a macro with a \&{tertiary}
+parameter}\par
+\P\D \37$\\{expr\_macro}=4$\C{preface to a macro with an undelimited \&{expr}
+parameter}\par
+\P\D \37$\\{of\_macro}=5$\C{preface to a macro with undelimited `\&{expr} \|x
+\&{of}~\|y' parameters}\par
+\P\D \37$\\{suffix\_macro}=6$\C{preface to a macro with an undelimited %
+\&{suffix} parameter}\par
+\P\D \37$\\{text\_macro}=7$\C{preface to a macro with an undelimited \&{text}
+parameter}\par
+\Y\P\4\&{procedure}\1\ \37$\\{delete\_mac\_ref}(\|p:\\{pointer})$;\C{\|p
+points to the reference count of a macro list that is losing one reference}%
+\2\6
+\&{begin} \37\&{if} $\\{ref\_count}(\|p)=\\{null}$ \1\&{then}\5
+$\\{flush\_token\_list}(\|p)$\6
+\4\&{else} $\\{decr}(\\{ref\_count}(\|p))$;\2\6
+\&{end};\par
+\fi
+
+\M227. The following subroutine displays a macro, given a pointer to its
+reference count.
+
+\Y\P\hbox{\4}\X625:Declare the procedure called \\{print\_cmd\_mod}\X\6
+\4\&{procedure}\1\ \37$\\{show\_macro}(\|p:\\{pointer};\,\35\|q,\39\|l:%
+\\{integer})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|r: \37\\{pointer};\C{temporary storage}\2\6
+\&{begin} \37$\|p\K\\{link}(\|p)$;\C{bypass the reference count}\6
+\&{while} $\\{info}(\|p)>\\{text\_macro}$ \1\&{do}\6
+\&{begin} \37$\|r\K\\{link}(\|p)$;\5
+$\\{link}(\|p)\K\\{null}$;\5
+$\\{show\_token\_list}(\|p,\39\\{null},\39\|l,\390)$;\5
+$\\{link}(\|p)\K\|r$;\5
+$\|p\K\|r$;\6
+\&{if} $\|l>0$ \1\&{then}\5
+$\|l\K\|l-\\{tally}$\ \&{else} \&{return};\2\6
+\&{end};\C{control printing of `\.{ETC.}'}\2\6
+$\\{tally}\K0$;\6
+\&{case} $\\{info}(\|p)$ \1\&{of}\6
+\4\\{general\_macro}: \37$\\{print}(\.{"->"})$;\6
+\4$\\{primary\_macro},\39\\{secondary\_macro},\39\\{tertiary\_macro}$: \37%
+\&{begin} \37$\\{print\_char}(\.{"<"})$;\5
+$\\{print\_cmd\_mod}(\\{param\_type},\39\\{info}(\|p))$;\5
+$\\{print}(\.{">->"})$;\6
+\&{end};\6
+\4\\{expr\_macro}: \37$\\{print}(\.{"<expr>->"})$;\6
+\4\\{of\_macro}: \37$\\{print}(\.{"<expr>of<primary>->"})$;\6
+\4\\{suffix\_macro}: \37$\\{print}(\.{"<suffix>->"})$;\6
+\4\\{text\_macro}: \37$\\{print}(\.{"<text>->"})$;\2\6
+\&{end};\C{there are no other cases}\6
+$\\{show\_token\_list}(\\{link}(\|p),\39\|q,\39\|l-\\{tally},\390)$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\N228. \[15] Data structures for variables.
+The variables of \MF\ programs can be simple, like `\.x', or they can
+combine the structural properties of arrays and records, like `\.{x20a.b}'.
+A \MF\ user assigns a type to a variable like \.{x20a.b} by saying, for
+example, `\.{boolean} \.{x20a.b}'. It's time for us to study how such
+things are represented inside of the computer.
+
+Each variable value occupies two consecutive words, either in a two-word
+node called a value node, or as a two-word subfield of a larger node. One
+of those two words is called the \\{value} field; it is an integer,
+containing either a \\{scaled} numeric value or the representation of some
+other type of quantity. (It might also be subdivided into halfwords, in
+which case it is referred to by other names instead of \\{value}.) The other
+word is broken into subfields called \\{type}, \\{name\_type}, and \\{link}.
+The
+\\{type} field is a quarterword that specifies the variable's type, and
+\\{name\_type} is a quarterword from which \MF\ can reconstruct the
+variable's name (sometimes by using the \\{link} field as well). Thus, only
+1.25 words are actually devoted to the value itself; the other
+three-quarters of a word are overhead, but they aren't wasted because they
+allow \MF\ to deal with sparse arrays and to provide meaningful diagnostics.
+
+In this section we shall be concerned only with the structural aspects of
+variables, not their values. Later parts of the program will change the
+\\{type} and \\{value} fields, but we shall treat those fields as black boxes
+whose contents should not be touched.
+
+However, if the \\{type} field is \\{structured}, there is no \\{value} field,
+and the second word is broken into two pointer fields called \\{attr\_head}
+and \\{subscr\_head}. Those fields point to additional nodes that
+contain structural information, as we shall see.
+
+\Y\P\D \37$\\{subscr\_head\_loc}(\#)\S\#+1$\C{where \\{value}, \\{subscr%
+\_head}, and \\{attr\_head} are}\par
+\P\D \37$\\{attr\_head}(\#)\S\\{info}(\\{subscr\_head\_loc}(\#))$\C{pointer to
+attribute info}\par
+\P\D \37$\\{subscr\_head}(\#)\S\\{link}(\\{subscr\_head\_loc}(\#))$\C{pointer
+to subscript info}\par
+\P\D \37$\\{value\_node\_size}=2$\C{the number of words in a value node}\par
+\fi
+
+\M229. An attribute node is three words long. Two of these words contain %
+\\{type}
+and \\{value} fields as described above, and the third word contains
+additional information: There is an \\{attr\_loc} field, which contains the
+hash address of the token that names this attribute; and there's also a
+\\{parent} field, which points to the value node of \\{structured} type at the
+next higher level (i.e., at the level to which this attribute is
+subsidiary). The \\{name\_type} in an attribute node is `\\{attr}'. The
+\\{link} field points to the next attribute with the same parent; these are
+arranged in increasing order, so that $\\{attr\_loc}(\\{link}(\|p))>\\{attr%
+\_loc}(\|p)$. The
+final attribute node links to the constant \\{end\_attr}, whose \\{attr\_loc}
+field is greater than any legal hash address. The \\{attr\_head} in the
+parent points to a node whose \\{name\_type} is \\{structured\_root}; this
+node represents the null attribute, i.e., the variable that is relevant
+when no attributes are attached to the parent. The \\{attr\_head} node is
+either
+a value node, a subscript node, or an attribute node, depending on what
+the parent would be if it were not structured; but the subscript and
+attribute fields are ignored, so it effectively contains only the data of
+a value node. The \\{link} field in this special node points to an attribute
+node whose \\{attr\_loc} field is zero; the latter node represents a collective
+subscript `\.{[]}' attached to the parent, and its \\{link} field points to
+the first non-special attribute node (or to \\{end\_attr} if there are none).
+
+A subscript node likewise occupies three words, with \\{type} and \\{value}
+fields
+plus extra information; its \\{name\_type} is \\{subscr}. In this case the
+third word is called the \\{subscript} field, which is a \\{scaled} integer.
+The \\{link} field points to the subscript node with the next larger
+subscript, if any; otherwise the \\{link} points to the attribute node
+for collective subscripts at this level. We have seen that the latter node
+contains an upward pointer, so that the parent can be deduced.
+
+The \\{name\_type} in a parent-less value node is \\{root}, and the \\{link}
+is the hash address of the token that names this value.
+
+In other words, variables have a hierarchical structure that includes
+enough threads running around so that the program is able to move easily
+between siblings, parents, and children. An example should be helpful:
+(The reader is advised to draw a picture while reading the following
+description, since that will help to firm up the ideas.)
+Suppose that `\.x' and `\.{x.a}' and `\.{x[]b}' and `\.{x5}'
+and `\.{x20b}' have been mentioned in a user's program, where
+\.{x[]b} has been declared to be of \&{boolean} type. Let $\|h(\|x)$, $\|h(%
+\|a)$,
+and $\|h(\|b)$ be the hash addresses of \.x, \.a, and~\.b. Then
+$\\{eq\_type}(\|h(\|x))=\\{tag\_token}$ and $\\{equiv}(\|h(\|x))=\|p$, where %
+\|p~is a two-word value
+node with $\\{name\_type}(\|p)=\\{root}$ and $\\{link}(\|p)=\|h(\|x)$. We have
+$\\{type}(\|p)=\\{structured}$,
+$\\{attr\_head}(\|p)=\|q$, and $\\{subscr\_head}(\|p)=\|r$, where \|q points to
+a value
+node and \|r to a subscript node. (Are you still following this? Use
+a pencil to draw a diagram.) The lone variable `\.x' is represented by
+$\\{type}(\|q)$ and $\\{value}(\|q)$; furthermore
+$\\{name\_type}(\|q)=\\{structured\_root}$ and $\\{link}(\|q)=\\{q1}$, where %
+\\{q1} points
+to an attribute node representing `\.{x[]}'. Thus $\\{name\_type}(\\{q1})=%
+\\{attr}$,
+$\\{attr\_loc}(\\{q1})=\\{collective\_subscript}=0$, $\\{parent}(\\{q1})=\|p$,
+$\\{type}(\\{q1})=\\{structured}$, $\\{attr\_head}(\\{q1})=\\{qq}$, and $%
+\\{subscr\_head}(\\{q1})=\\{qq1}$;
+\\{qq} is a value node with $\\{type}(\\{qq})=\\{numeric\_type}$ (assuming that
+\.{x5} is
+numeric, because \\{qq} represents `\.{x[]}' with no further attributes),
+$\\{name\_type}(\\{qq})=\\{structured\_root}$, and
+$\\{link}(\\{qq})=\\{qq1}$. (Now pay attention to the next part.) Node \\{qq1}
+is
+an attribute node representing `\.{x[][]}', which has never yet
+occurred; its \\{type} field is \\{undefined}, and its \\{value} field is
+undefined. We have $\\{name\_type}(\\{qq1})=\\{attr}$, $\\{attr\_loc}(\\{qq1})=%
+\\{collective\_subscript}$,
+$\\{parent}(\\{qq1})=\\{q1}$, and $\\{link}(\\{qq1})=\\{qq2}$. Since \\{qq2}
+represents
+`\.{x[]b}', $\\{type}(\\{qq2})=\\{unknown\_boolean}$; also $\\{attr\_loc}(%
+\\{qq2})=\|h(\|b)$,
+$\\{parent}(\\{qq2})=\\{q1}$, $\\{name\_type}(\\{qq2})=\\{attr}$, $\\{link}(%
+\\{qq2})=\\{end\_attr}$.
+(Maybe colored lines will help untangle your picture.)
+Node \|r is a subscript node with \\{type} and \\{value}
+representing `\.{x5}'; $\\{name\_type}(\|r)=\\{subscr}$, $\\{subscript}(%
+\|r)=5.0$,
+and $\\{link}(\|r)=\\{r1}$ is another subscript node. To complete the picture,
+see if you can guess what $\\{link}(\\{r1})$ is; give up? It's~\\{q1}.
+Furthermore $\\{subscript}(\\{r1})=20.0$, $\\{name\_type}(\\{r1})=\\{subscr}$,
+$\\{type}(\\{r1})=\\{structured}$, $\\{attr\_head}(\\{r1})=\\{qqq}$, $\\{subscr%
+\_head}(\\{r1})=\\{qqq1}$,
+and we finish things off with three more nodes
+\\{qqq}, \\{qqq1}, and \\{qqq2} hung onto~\\{r1}. (Perhaps you should start
+again
+with a larger sheet of paper.) The value of variable \.{x20b}
+appears in node~\\{qqq2}, as you can well imagine.
+
+If the example in the previous paragraph doesn't make things crystal
+clear, a glance at some of the simpler subroutines below will reveal how
+things work out in practice.
+
+The only really unusual thing about these conventions is the use of
+collective subscript attributes. The idea is to avoid repeating a lot of
+type information when many elements of an array are identical macros
+(for which distinct values need not be stored) or when they don't have
+all of the possible attributes. Branches of the structure below collective
+subscript attributes do not carry actual values except for macro identifiers;
+branches of the structure below subscript nodes do not carry significant
+information in their collective subscript attributes.
+
+\Y\P\D \37$\\{attr\_loc\_loc}(\#)\S\#+2$\C{where the \\{attr\_loc} and %
+\\{parent} fields are}\par
+\P\D \37$\\{attr\_loc}(\#)\S\\{info}(\\{attr\_loc\_loc}(\#))$\C{hash address of
+this attribute}\par
+\P\D \37$\\{parent}(\#)\S\\{link}(\\{attr\_loc\_loc}(\#))$\C{pointer to %
+\\{structured} variable}\par
+\P\D \37$\\{subscript\_loc}(\#)\S\#+2$\C{where the \\{subscript} field lives}%
+\par
+\P\D \37$\\{subscript}(\#)\S\\{mem}[\\{subscript\_loc}(\#)].\\{sc}$\C{subscript
+of this variable}\par
+\P\D \37$\\{attr\_node\_size}=3$\C{the number of words in an attribute node}\par
+\P\D \37$\\{subscr\_node\_size}=3$\C{the number of words in a subscript node}%
+\par
+\P\D \37$\\{collective\_subscript}=0$\C{code for the attribute `\.{[]}'}\par
+\Y\P$\4\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}\S$\6
+$\\{attr\_loc}(\\{end\_attr})\K\\{hash\_end}+1$;\5
+$\\{parent}(\\{end\_attr})\K\\{null}$;\par
+\fi
+
+\M230. Variables of type \&{pair} will have values that point to four-word
+nodes containing two numeric values. The first of these values has
+$\\{name\_type}=\\{x\_part\_sector}$ and the second has $\\{name\_type}=\\{y%
+\_part\_sector}$;
+the \\{link} in the first points back to the node whose \\{value} points
+to this four-word node.
+
+Variables of type \&{transform} are similar, but in this case their
+\\{value} points to a 12-word node containing six values, identified by
+\\{x\_part\_sector}, \\{y\_part\_sector}, \\{xx\_part\_sector}, \\{xy\_part%
+\_sector},
+\\{yx\_part\_sector}, and \\{yy\_part\_sector}.
+
+When an entire structured variable is saved, the \\{root} indication
+is temporarily replaced by \\{saved\_root}.
+
+Some variables have no name; they just are used for temporary storage
+while expressions are being evaluated. We call them {\sl capsules}.
+
+\Y\P\D \37$\\{x\_part\_loc}(\#)\S\#$\C{where the \&{xpart} is found in a pair
+or transform node}\par
+\P\D \37$\\{y\_part\_loc}(\#)\S\#+2$\C{where the \&{ypart} is found in a pair
+or transform node}\par
+\P\D \37$\\{xx\_part\_loc}(\#)\S\#+4$\C{where the \&{xxpart} is found in a
+transform node}\par
+\P\D \37$\\{xy\_part\_loc}(\#)\S\#+6$\C{where the \&{xypart} is found in a
+transform node}\par
+\P\D \37$\\{yx\_part\_loc}(\#)\S\#+8$\C{where the \&{yxpart} is found in a
+transform node}\par
+\P\D \37$\\{yy\_part\_loc}(\#)\S\#+10$\C{where the \&{yypart} is found in a
+transform node}\Y\par
+\P\D \37$\\{pair\_node\_size}=4$\C{the number of words in a pair node}\par
+\P\D \37$\\{transform\_node\_size}=12$\C{the number of words in a transform
+node}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{big\_node\_size}: \37\&{array} $[\\{transform\_type}\to\\{pair\_type}]$ \1%
+\&{of}\5
+\\{small\_number};\2\par
+\fi
+
+\M231. The \\{big\_node\_size} array simply contains two constants that \MF\
+occasionally needs to know.
+
+\Y\P$\4\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{big\_node\_size}[\\{transform\_type}]\K\\{transform\_node\_size}$;\5
+$\\{big\_node\_size}[\\{pair\_type}]\K\\{pair\_node\_size}$;\par
+\fi
+
+\M232. If $\\{type}(\|p)=\\{pair\_type}$ or \\{transform\_type} and if $%
+\\{value}(\|p)=\\{null}$, the
+procedure call $\\{init\_big\_node}(\|p)$ will allocate a pair or transform
+node
+for~\|p. The individual parts of such nodes are initially of type
+\\{independent}.
+
+\Y\P\4\&{procedure}\1\ \37$\\{init\_big\_node}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the new node}\6
+\|s: \37\\{small\_number};\C{its size}\2\6
+\&{begin} \37$\|s\K\\{big\_node\_size}[\\{type}(\|p)]$;\5
+$\|q\K\\{get\_node}(\|s)$;\6
+\1\&{repeat} \37$\|s\K\|s-2$;\5
+\X586:Make variable $\|q+\|s$ newly independent\X;\6
+$\\{name\_type}(\|q+\|s)\K\\{half}(\|s)+\\{x\_part\_sector}$;\5
+$\\{link}(\|q+\|s)\K\\{null}$;\6
+\4\&{until}\5
+$\|s=0$;\2\6
+$\\{link}(\|q)\K\|p$;\5
+$\\{value}(\|p)\K\|q$;\6
+\&{end};\par
+\fi
+
+\M233. The \\{id\_transform} function creates a capsule for the
+identity transformation.
+
+\Y\P\4\&{function}\1\ \37\\{id\_transform}: \37\\{pointer};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{list manipulation
+registers}\2\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{type}(\|p)\K\\{transform\_type}$;\5
+$\\{name\_type}(\|p)\K\\{capsule}$;\5
+$\\{value}(\|p)\K\\{null}$;\5
+$\\{init\_big\_node}(\|p)$;\5
+$\|q\K\\{value}(\|p)$;\5
+$\|r\K\|q+\\{transform\_node\_size}$;\6
+\1\&{repeat} \37$\|r\K\|r-2$;\5
+$\\{type}(\|r)\K\\{known}$;\5
+$\\{value}(\|r)\K0$;\6
+\4\&{until}\5
+$\|r=\|q$;\2\6
+$\\{value}(\\{xx\_part\_loc}(\|q))\K\\{unity}$;\5
+$\\{value}(\\{yy\_part\_loc}(\|q))\K\\{unity}$;\5
+$\\{id\_transform}\K\|p$;\6
+\&{end};\par
+\fi
+
+\M234. Tokens are of type \\{tag\_token} when they first appear, but they point
+to \\{null} until they are first used as the root of a variable.
+The following subroutine establishes the root node on such grand occasions.
+
+\Y\P\4\&{procedure}\1\ \37$\\{new\_root}(\|x:\\{pointer})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the new node}\2\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{type}(\|p)\K\\{undefined}$;\5
+$\\{name\_type}(\|p)\K\\{root}$;\5
+$\\{link}(\|p)\K\|x$;\5
+$\\{equiv}(\|x)\K\|p$;\6
+\&{end};\par
+\fi
+
+\M235. These conventions for variable representation are illustrated by the
+\\{print\_variable\_name} routine, which displays the full name of a
+variable given only a pointer to its two-word value packet.
+
+\Y\P\4\&{procedure}\1\ \37$\\{print\_variable\_name}(\|p:\\{pointer})$;\6
+\4\&{label} \37$\\{found},\39\\{exit}$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{a token list that will name the variable's
+suffix}\6
+\|r: \37\\{pointer};\C{temporary for token list creation}\2\6
+\&{begin} \37\&{while} $\\{name\_type}(\|p)\G\\{x\_part\_sector}$ \1\&{do}\5
+\X237:Preface the output with a part specifier; \&{return} in the case of a
+capsule\X;\2\6
+$\|q\K\\{null}$;\6
+\&{while} $\\{name\_type}(\|p)>\\{saved\_root}$ \1\&{do}\5
+\X236:Ascend one level, pushing a token onto list \|q and replacing \|p by its
+parent\X;\2\6
+$\|r\K\\{get\_avail}$;\5
+$\\{info}(\|r)\K\\{link}(\|p)$;\5
+$\\{link}(\|r)\K\|q$;\6
+\&{if} $\\{name\_type}(\|p)=\\{saved\_root}$ \1\&{then}\5
+$\\{print}(\.{"(SAVED)"})$;\2\6
+$\\{show\_token\_list}(\|r,\39\\{null},\39\\{el\_gordo},\39\\{tally})$;\5
+$\\{flush\_token\_list}(\|r)$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M236. \P$\X236:Ascend one level, pushing a token onto list \|q and replacing %
+\|p by its parent\X\S$\6
+\&{begin} \37\&{if} $\\{name\_type}(\|p)=\\{subscr}$ \1\&{then}\6
+\&{begin} \37$\|r\K\\{new\_num\_tok}(\\{subscript}(\|p))$;\6
+\1\&{repeat} \37$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\\{name\_type}(\|p)=\\{attr}$;\2\6
+\&{end}\6
+\4\&{else} \&{if} $\\{name\_type}(\|p)=\\{structured\_root}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{link}(\|p)$;\5
+\&{goto} \37\\{found};\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{name\_type}(\|p)\I\\{attr}$ \1\&{then}\5
+$\\{confusion}(\.{"var"})$;\2\6
+$\|r\K\\{get\_avail}$;\5
+$\\{info}(\|r)\K\\{attr\_loc}(\|p)$;\6
+\&{end};\2\2\6
+$\\{link}(\|r)\K\|q$;\5
+$\|q\K\|r$;\6
+\4\\{found}: \37$\|p\K\\{parent}(\|p)$;\6
+\&{end}\par
+\U235.\fi
+
+\M237. \P$\X237:Preface the output with a part specifier; \&{return} in the
+case of a capsule\X\S$\6
+\&{begin} \37\&{case} $\\{name\_type}(\|p)$ \1\&{of}\6
+\4\\{x\_part\_sector}: \37$\\{print\_char}(\.{"x"})$;\6
+\4\\{y\_part\_sector}: \37$\\{print\_char}(\.{"y"})$;\6
+\4\\{xx\_part\_sector}: \37$\\{print}(\.{"xx"})$;\6
+\4\\{xy\_part\_sector}: \37$\\{print}(\.{"xy"})$;\6
+\4\\{yx\_part\_sector}: \37$\\{print}(\.{"yx"})$;\6
+\4\\{yy\_part\_sector}: \37$\\{print}(\.{"yy"})$;\6
+\4\\{capsule}: \37\&{begin} \37$\\{print}(\.{"\%CAPSULE"})$;\5
+$\\{print\_int}(\|p-\\{null})$;\5
+\&{return};\6
+\&{end};\2\6
+\&{end};\C{there are no other cases}\6
+$\\{print}(\.{"part\ "})$;\5
+$\|p\K\\{link}(\|p-2\ast(\\{name\_type}(\|p)-\\{x\_part\_sector}))$;\6
+\&{end}\par
+\U235.\fi
+
+\M238. The \\{interesting} function returns \\{true} if a given variable is not
+in a capsule, or if the user wants to trace capsules.
+
+\Y\P\4\&{function}\1\ \37$\\{interesting}(\|p:\\{pointer})$: \37\\{boolean};\6
+\4\&{var} \37\|t: \37\\{small\_number};\C{a \\{name\_type}}\2\6
+\&{begin} \37\&{if} $\\{internal}[\\{tracing\_capsules}]>0$ \1\&{then}\5
+$\\{interesting}\K\\{true}$\6
+\4\&{else} \&{begin} \37$\|t\K\\{name\_type}(\|p)$;\6
+\&{if} $\|t\G\\{x\_part\_sector}$ \1\&{then}\6
+\&{if} $\|t\I\\{capsule}$ \1\&{then}\5
+$\|t\K\\{name\_type}(\\{link}(\|p-2\ast(\|t-\\{x\_part\_sector})))$;\2\2\6
+$\\{interesting}\K(\|t\I\\{capsule})$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M239. Now here is a subroutine that converts an unstructured type into an
+equivalent structured type, by inserting a \\{structured} node that is
+capable of growing. This operation is done only when $\\{name\_type}(\|p)=%
+\\{root}$,
+\\{subscr}, or \\{attr}.
+
+The procedure returns a pointer to the new node that has taken node~\|p's
+place in the structure. Node~\|p itself does not move, nor are its
+\\{value} or \\{type} fields changed in any way.
+
+\Y\P\4\&{function}\1\ \37$\\{new\_structure}(\|p:\\{pointer})$: \37%
+\\{pointer};\6
+\4\&{var} \37$\|q,\39\|r$: \37\\{pointer};\C{list manipulation registers}\2\6
+\&{begin} \37\&{case} $\\{name\_type}(\|p)$ \1\&{of}\6
+\4\\{root}: \37\&{begin} \37$\|q\K\\{link}(\|p)$;\5
+$\|r\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{equiv}(\|q)\K\|r$;\6
+\&{end};\6
+\4\\{subscr}: \37\X240:Link a new subscript node \|r in place of node \|p\X;\6
+\4\\{attr}: \37\X241:Link a new attribute node \|r in place of node \|p\X;\6
+\4\&{othercases} \37$\\{confusion}(\.{"struct"})$\2\6
+\&{endcases};\6
+$\\{link}(\|r)\K\\{link}(\|p)$;\5
+$\\{type}(\|r)\K\\{structured}$;\5
+$\\{name\_type}(\|r)\K\\{name\_type}(\|p)$;\5
+$\\{attr\_head}(\|r)\K\|p$;\5
+$\\{name\_type}(\|p)\K\\{structured\_root}$;\6
+$\|q\K\\{get\_node}(\\{attr\_node\_size})$;\5
+$\\{link}(\|p)\K\|q$;\5
+$\\{subscr\_head}(\|r)\K\|q$;\5
+$\\{parent}(\|q)\K\|r$;\5
+$\\{type}(\|q)\K\\{undefined}$;\5
+$\\{name\_type}(\|q)\K\\{attr}$;\5
+$\\{link}(\|q)\K\\{end\_attr}$;\5
+$\\{attr\_loc}(\|q)\K\\{collective\_subscript}$;\5
+$\\{new\_structure}\K\|r$;\6
+\&{end};\par
+\fi
+
+\M240. \P$\X240:Link a new subscript node \|r in place of node \|p\X\S$\6
+\&{begin} \37$\|q\K\|p$;\6
+\1\&{repeat} \37$\|q\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\\{name\_type}(\|q)=\\{attr}$;\2\6
+$\|q\K\\{parent}(\|q)$;\5
+$\|r\K\\{subscr\_head\_loc}(\|q)$;\C{$\\{link}(\|r)=\\{subscr\_head}(\|q)$}\6
+\1\&{repeat} \37$\|q\K\|r$;\5
+$\|r\K\\{link}(\|r)$;\6
+\4\&{until}\5
+$\|r=\|p$;\2\6
+$\|r\K\\{get\_node}(\\{subscr\_node\_size})$;\5
+$\\{link}(\|q)\K\|r$;\5
+$\\{subscript}(\|r)\K\\{subscript}(\|p)$;\6
+\&{end}\par
+\U239.\fi
+
+\M241. If the attribute is \\{collective\_subscript}, there are two pointers to
+node~\|p, so we must change both of them.
+
+\Y\P$\4\X241:Link a new attribute node \|r in place of node \|p\X\S$\6
+\&{begin} \37$\|q\K\\{parent}(\|p)$;\5
+$\|r\K\\{attr\_head}(\|q)$;\6
+\1\&{repeat} \37$\|q\K\|r$;\5
+$\|r\K\\{link}(\|r)$;\6
+\4\&{until}\5
+$\|r=\|p$;\2\6
+$\|r\K\\{get\_node}(\\{attr\_node\_size})$;\5
+$\\{link}(\|q)\K\|r$;\6
+$\\{mem}[\\{attr\_loc\_loc}(\|r)]\K\\{mem}[\\{attr\_loc\_loc}(\|p)]$;\C{copy %
+\\{attr\_loc} and \\{parent}}\6
+\&{if} $\\{attr\_loc}(\|p)=\\{collective\_subscript}$ \1\&{then}\6
+\&{begin} \37$\|q\K\\{subscr\_head\_loc}(\\{parent}(\|p))$;\6
+\&{while} $\\{link}(\|q)\I\|p$ \1\&{do}\5
+$\|q\K\\{link}(\|q)$;\2\6
+$\\{link}(\|q)\K\|r$;\6
+\&{end};\2\6
+\&{end}\par
+\U239.\fi
+
+\M242. The \\{find\_variable} routine is given a pointer~\|t to a nonempty
+token
+list of suffixes; it returns a pointer to the corresponding two-word
+value. For example, if \|t points to token \.x followed by a numeric
+token containing the value~7, \\{find\_variable} finds where the value of
+\.{x7} is stored in memory. This may seem a simple task, and it
+usually is, except when \.{x7} has never been referenced before.
+Indeed, \.x may never have even been subscripted before; complexities
+arise with respect to updating the collective subscript information.
+
+If a macro type is detected anywhere along path~\|t, or if the first
+item on \|t isn't a \\{tag\_token}, the value \\{null} is returned.
+Otherwise \|p will be a non-null pointer to a node such that
+$\\{undefined}<\\{type}(\|p)<\\{structured}$.
+
+\Y\P\D \37$\\{abort\_find}\S$\1\6
+\&{begin} \37$\\{find\_variable}\K\\{null}$;\5
+\&{return};\ \&{end}\2\par
+\Y\P\4\&{function}\1\ \37$\\{find\_variable}(\|t:\\{pointer})$: \37%
+\\{pointer};\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\C{nodes in the
+``value'' line}\6
+$\\{pp},\39\\{qq},\39\\{rr},\39\\{ss}$: \37\\{pointer};\C{nodes in the
+``collective'' line}\6
+\|n: \37\\{integer};\C{subscript or attribute}\6
+\\{save\_word}: \37\\{memory\_word};\C{temporary storage for a word of \\{mem}}%
+\2\6
+\&{begin} \37$\|p\K\\{info}(\|t)$;\5
+$\|t\K\\{link}(\|t)$;\6
+\&{if} $\\{eq\_type}(\|p)\mathbin{\&{mod}}\\{outer\_tag}\I\\{tag\_token}$ \1%
+\&{then}\5
+\\{abort\_find};\2\6
+\&{if} $\\{equiv}(\|p)=\\{null}$ \1\&{then}\5
+$\\{new\_root}(\|p)$;\2\6
+$\|p\K\\{equiv}(\|p)$;\5
+$\\{pp}\K\|p$;\6
+\&{while} $\|t\I\\{null}$ \1\&{do}\6
+\&{begin} \37\X243:Make sure that both nodes \|p and \\{pp} are of %
+\\{structured} type\X;\6
+\&{if} $\|t<\\{hi\_mem\_min}$ \1\&{then}\5
+\X244:Descend one level for the subscript $\\{value}(\|t)$\X\6
+\4\&{else} \X245:Descend one level for the attribute $\\{info}(\|t)$\X;\2\6
+$\|t\K\\{link}(\|t)$;\6
+\&{end};\2\6
+\&{if} $\\{type}(\\{pp})\G\\{structured}$ \1\&{then}\6
+\&{if} $\\{type}(\\{pp})=\\{structured}$ \1\&{then}\5
+$\\{pp}\K\\{attr\_head}(\\{pp})$\ \&{else} \\{abort\_find};\2\2\6
+\&{if} $\\{type}(\|p)=\\{structured}$ \1\&{then}\5
+$\|p\K\\{attr\_head}(\|p)$;\2\6
+\&{if} $\\{type}(\|p)=\\{undefined}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{type}(\\{pp})=\\{undefined}$ \1\&{then}\6
+\&{begin} \37$\\{type}(\\{pp})\K\\{numeric\_type}$;\5
+$\\{value}(\\{pp})\K\\{null}$;\6
+\&{end};\2\6
+$\\{type}(\|p)\K\\{type}(\\{pp})$;\5
+$\\{value}(\|p)\K\\{null}$;\6
+\&{end};\2\6
+$\\{find\_variable}\K\|p$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M243. Although \\{pp} and \|p begin together, they diverge when a subscript
+occurs;
+\\{pp}~stays in the collective line while \|p~goes through actual subscript
+values.
+
+\Y\P$\4\X243:Make sure that both nodes \|p and \\{pp} are of \\{structured}
+type\X\S$\6
+\&{if} $\\{type}(\\{pp})\I\\{structured}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{type}(\\{pp})>\\{structured}$ \1\&{then}\5
+\\{abort\_find};\2\6
+$\\{ss}\K\\{new\_structure}(\\{pp})$;\6
+\&{if} $\|p=\\{pp}$ \1\&{then}\5
+$\|p\K\\{ss}$;\2\6
+$\\{pp}\K\\{ss}$;\6
+\&{end};\C{now $\\{type}(\\{pp})=\\{structured}$}\2\6
+\&{if} $\\{type}(\|p)\I\\{structured}$ \1\&{then}\C{it cannot be $>%
+\\{structured}$}\6
+$\|p\K\\{new\_structure}(\|p)$\C{now $\\{type}(\|p)=\\{structured}$}\2\par
+\U242.\fi
+
+\M244. We want this part of the program to be reasonably fast, in case there
+are
+lots of subscripts at the same level of the data structure. Therefore
+we store an ``infinite'' value in the word that appears at the end of the
+subscript list, even though that word isn't part of a subscript node.
+
+\Y\P$\4\X244:Descend one level for the subscript $\\{value}(\|t)$\X\S$\6
+\&{begin} \37$\|n\K\\{value}(\|t)$;\5
+$\\{pp}\K\\{link}(\\{attr\_head}(\\{pp}))$;\C{now $\\{attr\_loc}(\\{pp})=%
+\\{collective\_subscript}$}\6
+$\|q\K\\{link}(\\{attr\_head}(\|p))$;\5
+$\\{save\_word}\K\\{mem}[\\{subscript\_loc}(\|q)]$;\5
+$\\{subscript}(\|q)\K\\{el\_gordo}$;\5
+$\|s\K\\{subscr\_head\_loc}(\|p)$;\C{$\\{link}(\|s)=\\{subscr\_head}(\|p)$}\6
+\1\&{repeat} \37$\|r\K\|s$;\5
+$\|s\K\\{link}(\|s)$;\6
+\4\&{until}\5
+$\|n\L\\{subscript}(\|s)$;\2\6
+\&{if} $\|n=\\{subscript}(\|s)$ \1\&{then}\5
+$\|p\K\|s$\6
+\4\&{else} \&{begin} \37$\|p\K\\{get\_node}(\\{subscr\_node\_size})$;\5
+$\\{link}(\|r)\K\|p$;\5
+$\\{link}(\|p)\K\|s$;\5
+$\\{subscript}(\|p)\K\|n$;\5
+$\\{name\_type}(\|p)\K\\{subscr}$;\5
+$\\{type}(\|p)\K\\{undefined}$;\6
+\&{end};\2\6
+$\\{mem}[\\{subscript\_loc}(\|q)]\K\\{save\_word}$;\6
+\&{end}\par
+\U242.\fi
+
+\M245. \P$\X245:Descend one level for the attribute $\\{info}(\|t)$\X\S$\6
+\&{begin} \37$\|n\K\\{info}(\|t)$;\5
+$\\{ss}\K\\{attr\_head}(\\{pp})$;\6
+\1\&{repeat} \37$\\{rr}\K\\{ss}$;\5
+$\\{ss}\K\\{link}(\\{ss})$;\6
+\4\&{until}\5
+$\|n\L\\{attr\_loc}(\\{ss})$;\2\6
+\&{if} $\|n<\\{attr\_loc}(\\{ss})$ \1\&{then}\6
+\&{begin} \37$\\{qq}\K\\{get\_node}(\\{attr\_node\_size})$;\5
+$\\{link}(\\{rr})\K\\{qq}$;\5
+$\\{link}(\\{qq})\K\\{ss}$;\5
+$\\{attr\_loc}(\\{qq})\K\|n$;\5
+$\\{name\_type}(\\{qq})\K\\{attr}$;\5
+$\\{type}(\\{qq})\K\\{undefined}$;\5
+$\\{parent}(\\{qq})\K\\{pp}$;\5
+$\\{ss}\K\\{qq}$;\6
+\&{end};\2\6
+\&{if} $\|p=\\{pp}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{ss}$;\5
+$\\{pp}\K\\{ss}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{pp}\K\\{ss}$;\5
+$\|s\K\\{attr\_head}(\|p)$;\6
+\1\&{repeat} \37$\|r\K\|s$;\5
+$\|s\K\\{link}(\|s)$;\6
+\4\&{until}\5
+$\|n\L\\{attr\_loc}(\|s)$;\2\6
+\&{if} $\|n=\\{attr\_loc}(\|s)$ \1\&{then}\5
+$\|p\K\|s$\6
+\4\&{else} \&{begin} \37$\|q\K\\{get\_node}(\\{attr\_node\_size})$;\5
+$\\{link}(\|r)\K\|q$;\5
+$\\{link}(\|q)\K\|s$;\5
+$\\{attr\_loc}(\|q)\K\|n$;\5
+$\\{name\_type}(\|q)\K\\{attr}$;\5
+$\\{type}(\|q)\K\\{undefined}$;\5
+$\\{parent}(\|q)\K\|p$;\5
+$\|p\K\|q$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end}\par
+\U242.\fi
+
+\M246. Variables lose their former values when they appear in a type
+declaration,
+or when they are defined to be macros or \&{let} equal to something else.
+A subroutine will be defined later that recycles the storage associated
+with any particular \\{type} or \\{value}; our goal now is to study a higher
+level process called \\{flush\_variable}, which selectively frees parts of a
+variable structure.
+
+This routine has some complexity because of examples such as
+`\hbox{\tt numeric x[]a[]b}',
+which recycles all variables of the form \.{x[i]a[j]b} (and no others), while
+`\hbox{\tt vardef x[]a[]=...}'
+discards all variables of the form \.{x[i]a[j]} followed by an arbitrary
+suffix, except for the collective node \.{x[]a[]} itself. The obvious way
+to handle such examples is to use recursion; so that's what we~do.
+
+Parameter \|p points to the root information of the variable;
+parameter \|t points to a list of one-word nodes that represent
+suffixes, with $\\{info}=\\{collective\_subscript}$ for subscripts.
+
+\Y\P\hbox{\4}\X257:Declare subroutines for printing expressions\X\6
+\hbox{\4}\X594:Declare basic dependency-list subroutines\X\6
+\hbox{\4}\X268:Declare the recycling subroutines\X\6
+\hbox{\4}\X808:Declare the procedure called \\{flush\_cur\_exp}\X\6
+\hbox{\4}\X247:Declare the procedure called \\{flush\_below\_variable}\X\6
+\4\&{procedure}\1\ \37$\\{flush\_variable}(\|p,\39\|t:\\{pointer};\,\35%
+\\{discard\_suffixes}:\\{boolean})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37$\|q,\39\|r$: \37\\{pointer};\C{list manipulation}\6
+\|n: \37\\{halfword};\C{attribute to match}\2\6
+\&{begin} \37\&{while} $\|t\I\\{null}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{type}(\|p)\I\\{structured}$ \1\&{then}\5
+\&{return};\2\6
+$\|n\K\\{info}(\|t)$;\5
+$\|t\K\\{link}(\|t)$;\6
+\&{if} $\|n=\\{collective\_subscript}$ \1\&{then}\6
+\&{begin} \37$\|r\K\\{subscr\_head\_loc}(\|p)$;\5
+$\|q\K\\{link}(\|r)$;\C{$\|q=\\{subscr\_head}(\|p)$}\6
+\&{while} $\\{name\_type}(\|q)=\\{subscr}$ \1\&{do}\6
+\&{begin} \37$\\{flush\_variable}(\|q,\39\|t,\39\\{discard\_suffixes})$;\6
+\&{if} $\|t=\\{null}$ \1\&{then}\6
+\&{if} $\\{type}(\|q)=\\{structured}$ \1\&{then}\5
+$\|r\K\|q$\6
+\4\&{else} \&{begin} \37$\\{link}(\|r)\K\\{link}(\|q)$;\5
+$\\{free\_node}(\|q,\39\\{subscr\_node\_size})$;\6
+\&{end}\2\6
+\4\&{else} $\|r\K\|q$;\2\6
+$\|q\K\\{link}(\|r)$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\|p\K\\{attr\_head}(\|p)$;\6
+\1\&{repeat} \37$\|r\K\|p$;\5
+$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\\{attr\_loc}(\|p)\G\|n$;\2\6
+\&{if} $\\{attr\_loc}(\|p)\I\|n$ \1\&{then}\5
+\&{return};\2\6
+\&{end};\2\6
+\&{if} $\\{discard\_suffixes}$ \1\&{then}\5
+$\\{flush\_below\_variable}(\|p)$\6
+\4\&{else} \&{begin} \37\&{if} $\\{type}(\|p)=\\{structured}$ \1\&{then}\5
+$\|p\K\\{attr\_head}(\|p)$;\2\6
+$\\{recycle\_value}(\|p)$;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M247. The next procedure is simpler; it wipes out everything but \|p itself,
+which becomes undefined.
+
+\Y\P$\4\X247:Declare the procedure called \\{flush\_below\_variable}\X\S$\6
+\4\&{procedure}\1\ \37$\\{flush\_below\_variable}(\|p:\\{pointer})$;\6
+\4\&{var} \37$\|q,\39\|r$: \37\\{pointer};\C{list manipulation registers}\2\6
+\&{begin} \37\&{if} $\\{type}(\|p)\I\\{structured}$ \1\&{then}\5
+$\\{recycle\_value}(\|p)$\C{this sets $\\{type}(\|p)=\\{undefined}$}\6
+\4\&{else} \&{begin} \37$\|q\K\\{subscr\_head}(\|p)$;\6
+\&{while} $\\{name\_type}(\|q)=\\{subscr}$ \1\&{do}\6
+\&{begin} \37$\\{flush\_below\_variable}(\|q)$;\5
+$\|r\K\|q$;\5
+$\|q\K\\{link}(\|q)$;\5
+$\\{free\_node}(\|r,\39\\{subscr\_node\_size})$;\6
+\&{end};\2\6
+$\|r\K\\{attr\_head}(\|p)$;\5
+$\|q\K\\{link}(\|r)$;\5
+$\\{recycle\_value}(\|r)$;\6
+\&{if} $\\{name\_type}(\|p)\L\\{saved\_root}$ \1\&{then}\5
+$\\{free\_node}(\|r,\39\\{value\_node\_size})$\6
+\4\&{else} $\\{free\_node}(\|r,\39\\{subscr\_node\_size})$;\C{we assume that $%
+\\{subscr\_node\_size}=\\{attr\_node\_size}$}\2\6
+\1\&{repeat} \37$\\{flush\_below\_variable}(\|q)$;\5
+$\|r\K\|q$;\5
+$\|q\K\\{link}(\|q)$;\5
+$\\{free\_node}(\|r,\39\\{attr\_node\_size})$;\6
+\4\&{until}\5
+$\|q=\\{end\_attr}$;\2\6
+$\\{type}(\|p)\K\\{undefined}$;\6
+\&{end};\2\6
+\&{end};\par
+\U246.\fi
+
+\M248. Just before assigning a new value to a variable, we will recycle the
+old value and make the old value undefined. The \\{und\_type} routine
+determines what type of undefined value should be given, based on
+the current type before recycling.
+
+\Y\P\4\&{function}\1\ \37$\\{und\_type}(\|p:\\{pointer})$: \37\\{small%
+\_number};\2\6
+\&{begin} \37\&{case} $\\{type}(\|p)$ \1\&{of}\6
+\4$\\{undefined},\39\\{vacuous}$: \37$\\{und\_type}\K\\{undefined}$;\6
+\4$\\{boolean\_type},\39\\{unknown\_boolean}$: \37$\\{und\_type}\K\\{unknown%
+\_boolean}$;\6
+\4$\\{string\_type},\39\\{unknown\_string}$: \37$\\{und\_type}\K\\{unknown%
+\_string}$;\6
+\4$\\{pen\_type},\39\\{unknown\_pen},\39\\{future\_pen}$: \37$\\{und\_type}\K%
+\\{unknown\_pen}$;\6
+\4$\\{path\_type},\39\\{unknown\_path}$: \37$\\{und\_type}\K\\{unknown\_path}$;%
+\6
+\4$\\{picture\_type},\39\\{unknown\_picture}$: \37$\\{und\_type}\K\\{unknown%
+\_picture}$;\6
+\4$\\{transform\_type},\39\\{pair\_type},\39\\{numeric\_type}$: \37$\\{und%
+\_type}\K\\{type}(\|p)$;\6
+\4$\\{known},\39\\{dependent},\39\\{proto\_dependent},\39\\{independent}$: \37$%
+\\{und\_type}\K\\{numeric\_type}$;\2\6
+\&{end};\C{there are no other cases}\6
+\&{end};\par
+\fi
+
+\M249. The \\{clear\_symbol} routine is used when we want to redefine the
+equivalent
+of a symbolic token. It must remove any variable structure or macro
+definition that is currently attached to that symbol. If the \\{saving}
+parameter is true, a subsidiary structure is saved instead of destroyed.
+
+\Y\P\4\&{procedure}\1\ \37$\\{clear\_symbol}(\|p:\\{pointer};\,\35\\{saving}:%
+\\{boolean})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{$\\{equiv}(\|p)$}\2\6
+\&{begin} \37$\|q\K\\{equiv}(\|p)$;\6
+\&{case} $\\{eq\_type}(\|p)\mathbin{\&{mod}}\\{outer\_tag}$ \1\&{of}\6
+\4$\\{defined\_macro},\39\\{secondary\_primary\_macro},\39\\{tertiary%
+\_secondary\_macro},\39\\{expression\_tertiary\_macro}$: \37\&{if} $\R%
+\\{saving}$ \1\&{then}\5
+$\\{delete\_mac\_ref}(\|q)$;\2\6
+\4\\{tag\_token}: \37\&{if} $\|q\I\\{null}$ \1\&{then}\6
+\&{if} $\\{saving}$ \1\&{then}\5
+$\\{name\_type}(\|q)\K\\{saved\_root}$\6
+\4\&{else} \&{begin} \37$\\{flush\_below\_variable}(\|q)$;\5
+$\\{free\_node}(\|q,\39\\{value\_node\_size})$;\6
+\&{end};\2\6
+\4\&{othercases} \\{do\_nothing}\2\2\6
+\&{endcases};\6
+$\\{eqtb}[\|p]\K\\{eqtb}[\\{frozen\_undefined}]$;\6
+\&{end};\par
+\fi
+
+\N250. \[16] Saving and restoring equivalents.
+The nested structure provided by \&{begingroup} and \&{endgroup}
+allows \\{eqtb} entries to be saved and restored, so that temporary changes
+can be made without difficulty. When the user requests a current value to
+be saved, \MF\ puts that value into its ``save stack.'' An appearance of
+\&{endgroup} ultimately causes the old values to be removed from the save
+stack and put back in their former places.
+
+The save stack is a linked list containing three kinds of entries,
+distinguished by their \\{info} fields. If \|p points to a saved item,
+then
+
+\smallskip\hang
+$\\{info}(\|p)=0$ stands for a group boundary; each \&{begingroup} contributes
+such an item to the save stack and each \&{endgroup} cuts back the stack
+until the most recent such entry has been removed.
+
+\smallskip\hang
+$\\{info}(\|p)=\|q$, where $1\L\|q\L\\{hash\_end}$, means that $\\{mem}[\|p+1]$
+holds the former
+contents of $\\{eqtb}[\|q]$. Such save stack entries are generated by \&{save}
+commands or suitable \&{interim} commands.
+
+\smallskip\hang
+$\\{info}(\|p)=\\{hash\_end}+\|q$, where $\|q>0$, means that $\\{value}(\|p)$
+is a \\{scaled}
+integer to be restored to internal parameter number~\|q. Such entries
+are generated by \&{interim} commands.
+
+\smallskip\noindent
+The global variable \\{save\_ptr} points to the top item on the save stack.
+
+\Y\P\D \37$\\{save\_node\_size}=2$\C{number of words per non-boundary
+save-stack node}\par
+\P\D \37$\\{saved\_equiv}(\#)\S\\{mem}[\#+1].\\{hh}$\C{where an \\{eqtb} entry
+gets saved}\par
+\P\D \37$\\{save\_boundary\_item}(\#)\S$\1\6
+\&{begin} \37$\#\K\\{get\_avail}$;\5
+$\\{info}(\#)\K0$;\5
+$\\{link}(\#)\K\\{save\_ptr}$;\5
+$\\{save\_ptr}\K\#$;\6
+\&{end}\2\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{save\_ptr}: \37\\{pointer};\C{the most recently saved item}\par
+\fi
+
+\M251. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{save\_ptr}\K\\{null}$;\par
+\fi
+
+\M252. The \\{save\_variable} routine is given a hash address \|q; it salts
+this
+address in the save stack, together with its current equivalent,
+then makes token~\|q behave as though it were brand new.
+
+Nothing is stacked when $\\{save\_ptr}=\\{null}$, however; there's no way to
+remove
+things from the stack when the program is not inside a group, so there's
+no point in wasting the space.
+
+\Y\P\4\&{procedure}\1\ \37$\\{save\_variable}(\|q:\\{pointer})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{temporary register}\2\6
+\&{begin} \37\&{if} $\\{save\_ptr}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{save\_node\_size})$;\5
+$\\{info}(\|p)\K\|q$;\5
+$\\{link}(\|p)\K\\{save\_ptr}$;\5
+$\\{saved\_equiv}(\|p)\K\\{eqtb}[\|q]$;\5
+$\\{save\_ptr}\K\|p$;\6
+\&{end};\2\6
+$\\{clear\_symbol}(\|q,\39(\\{save\_ptr}\I\\{null}))$;\6
+\&{end};\par
+\fi
+
+\M253. Similarly, \\{save\_internal} is given the location \|q of an internal
+quantity like \\{tracing\_pens}. It creates a save stack entry of the
+third kind.
+
+\Y\P\4\&{procedure}\1\ \37$\\{save\_internal}(\|q:\\{halfword})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{new item for the save stack}\2\6
+\&{begin} \37\&{if} $\\{save\_ptr}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{save\_node\_size})$;\5
+$\\{info}(\|p)\K\\{hash\_end}+\|q$;\5
+$\\{link}(\|p)\K\\{save\_ptr}$;\5
+$\\{value}(\|p)\K\\{internal}[\|q]$;\5
+$\\{save\_ptr}\K\|p$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M254. At the end of a group, the \\{unsave} routine restores all of the saved
+equivalents in reverse order. This routine will be called only when there
+is at least one boundary item on the save stack.
+
+\Y\P\4\&{procedure}\1\ \37\\{unsave};\6
+\4\&{var} \37\|q: \37\\{pointer};\C{index to saved item}\6
+\|p: \37\\{pointer};\C{temporary register}\2\6
+\&{begin} \37\&{while} $\\{info}(\\{save\_ptr})\I0$ \1\&{do}\6
+\&{begin} \37$\|q\K\\{info}(\\{save\_ptr})$;\6
+\&{if} $\|q>\\{hash\_end}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{internal}[\\{tracing\_restores}]>0$ \1\&{then}\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\{restoring\ "})$;\5
+$\\{slow\_print}(\\{int\_name}[\|q-(\\{hash\_end})])$;\5
+$\\{print\_char}(\.{"="})$;\5
+$\\{print\_scaled}(\\{value}(\\{save\_ptr}))$;\5
+$\\{print\_char}(\.{"\}"})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end};\2\6
+$\\{internal}[\|q-(\\{hash\_end})]\K\\{value}(\\{save\_ptr})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{internal}[\\{tracing\_restores}]>0$ \1%
+\&{then}\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\{restoring\ "})$;\5
+$\\{slow\_print}(\\{text}(\|q))$;\5
+$\\{print\_char}(\.{"\}"})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end};\2\6
+$\\{clear\_symbol}(\|q,\39\\{false})$;\5
+$\\{eqtb}[\|q]\K\\{saved\_equiv}(\\{save\_ptr})$;\6
+\&{if} $\\{eq\_type}(\|q)\mathbin{\&{mod}}\\{outer\_tag}=\\{tag\_token}$ \1%
+\&{then}\6
+\&{begin} \37$\|p\K\\{equiv}(\|q)$;\6
+\&{if} $\|p\I\\{null}$ \1\&{then}\5
+$\\{name\_type}(\|p)\K\\{root}$;\2\6
+\&{end};\2\6
+\&{end};\2\6
+$\|p\K\\{link}(\\{save\_ptr})$;\5
+$\\{free\_node}(\\{save\_ptr},\39\\{save\_node\_size})$;\5
+$\\{save\_ptr}\K\|p$;\6
+\&{end};\2\6
+$\|p\K\\{link}(\\{save\_ptr})$;\5
+$\\{free\_avail}(\\{save\_ptr})$;\5
+$\\{save\_ptr}\K\|p$;\6
+\&{end};\par
+\fi
+
+\N255. \[17] Data structures for paths.
+When a \MF\ user specifies a path, \MF\ will create a list of knots
+and control points for the associated cubic spline curves. If the
+knots are $z_0$, $z_1$, \dots, $z_n$, there are control points
+$z_k^+$ and $z_{k+1}^-$ such that the cubic splines between knots
+$z_k$ and $z_{k+1}$ are defined by B\'ezier's formula
+$$\eqalign{z(t)&=B(z_k,z_k^+,z_{k+1}^-,z_{k+1};t)\cr
+&=(1-t)^3z_k+3(1-t)^2tz_k^++3(1-t)t^2z_{k+1}^-+t^3z_{k+1}\cr}$$
+for $0\L\|t\L1$.
+
+There is a 7-word node for each knot $z_k$, containing one word of
+control information and six words for the \|x and \|y coordinates
+of $z_k^-$ and $z_k$ and~$z_k^+$. The control information appears
+in the \\{left\_type} and \\{right\_type} fields, which each occupy
+a quarter of the first word in the node; they specify properties
+of the curve as it enters and leaves the knot. There's also a
+halfword \\{link} field, which points to the following knot.
+
+If the path is a closed contour, knots 0 and \|n are identical;
+i.e., the \\{link} in knot $\|n-1$ points to knot~0. But if the path
+is not closed, the \\{left\_type} of knot~0 and the \\{right\_type} of knot~\|n
+are equal to \\{endpoint}. In the latter case the \\{link} in knot~\|n points
+to knot~0, and the control points $z_0^-$ and $z_n^+$ are not used.
+
+\Y\P\D \37$\\{left\_type}(\#)\S\\{mem}[\#].\\{hh}.\\{b0}$\C{characterizes the
+path entering this knot}\par
+\P\D \37$\\{right\_type}(\#)\S\\{mem}[\#].\\{hh}.\\{b1}$\C{characterizes the
+path leaving this knot}\par
+\P\D \37$\\{endpoint}=0$\C{\\{left\_type} at path beginning and \\{right\_type}
+at path end}\par
+\P\D \37$\\{x\_coord}(\#)\S\\{mem}[\#+1].\\{sc}$\C{the \|x coordinate of this
+knot}\par
+\P\D \37$\\{y\_coord}(\#)\S\\{mem}[\#+2].\\{sc}$\C{the \|y coordinate of this
+knot}\par
+\P\D \37$\\{left\_x}(\#)\S\\{mem}[\#+3].\\{sc}$\C{the \|x coordinate of
+previous control point}\par
+\P\D \37$\\{left\_y}(\#)\S\\{mem}[\#+4].\\{sc}$\C{the \|y coordinate of
+previous control point}\par
+\P\D \37$\\{right\_x}(\#)\S\\{mem}[\#+5].\\{sc}$\C{the \|x coordinate of next
+control point}\par
+\P\D \37$\\{right\_y}(\#)\S\\{mem}[\#+6].\\{sc}$\C{the \|y coordinate of next
+control point}\par
+\P\D \37$\\{knot\_node\_size}=7$\C{number of words in a knot node}\par
+\fi
+
+\M256. Before the B\'ezier control points have been calculated, the memory
+space they will ultimately occupy is taken up by information that can be
+used to compute them. There are four cases:
+
+\yskip
+\textindent{$\bullet$} If $\\{right\_type}=\\{open}$, the curve should leave
+the knot in the same direction it entered; \MF\ will figure out a
+suitable direction.
+
+\yskip
+\textindent{$\bullet$} If $\\{right\_type}=\\{curl}$, the curve should leave
+the
+knot in a direction depending on the angle at which it enters the next
+knot and on the curl parameter stored in \\{right\_curl}.
+
+\yskip
+\textindent{$\bullet$} If $\\{right\_type}=\\{given}$, the curve should leave
+the
+knot in a nonzero direction stored as an \\{angle} in \\{right\_given}.
+
+\yskip
+\textindent{$\bullet$} If $\\{right\_type}=\\{explicit}$, the B\'ezier control
+point for leaving this knot has already been computed; it is in the
+\\{right\_x} and \\{right\_y} fields.
+
+\yskip\noindent
+The rules for \\{left\_type} are similar, but they refer to the curve entering
+the knot, and to \\{left} fields instead of \\{right} fields.
+
+Non-\\{explicit} control points will be chosen based on ``tension'' parameters
+in the \\{left\_tension} and \\{right\_tension} fields. The
+`\&{atleast}' option is represented by negative tension values.
+
+For example, the \MF\ path specification
+$$\.{z0..z1..tension atleast 1..\{curl 2\}z2..z3\{-1,-2\}..tension
+3 and 4..p},$$
+where \.p is the path `\.{z4..controls z45 and z54..z5}', will be represented
+by the six knots
+\def\lodash{\hbox to 1.1em{\thinspace\hrulefill\thinspace}}
+$$\vbox{\halign{#\hfil&&\qquad#\hfil\cr
+\\{left\_type}&\\{left} info&$\\{x\_coord},\\{y\_coord}$&\\{right\_type}&%
+\\{right} info\cr
+\noalign{\yskip}
+\\{endpoint}&\lodash$,\,$\lodash&$x_0,y_0$&\\{curl}&$1.0,1.0$\cr
+\\{open}&\lodash$,1.0$&$x_1,y_1$&\\{open}&\lodash$,-1.0$\cr
+\\{curl}&$2.0,-1.0$&$x_2,y_2$&\\{curl}&$2.0,1.0$\cr
+\\{given}&$d,1.0$&$x_3,y_3$&\\{given}&$d,3.0$\cr
+\\{open}&\lodash$,4.0$&$x_4,y_4$&\\{explicit}&$x_{45},y_{45}$\cr
+\\{explicit}&$x_{54},y_{54}$&$x_5,y_5$&\\{endpoint}&\lodash$,\,$\lodash\cr}}$$
+Here \|d is the \\{angle} obtained by calling $\\{n\_arg}(-\\{unity},-%
+\\{two})$.
+Of course, this example is more complicated than anything a normal user
+would ever write.
+
+These types must satisfy certain restrictions because of the form of \MF's
+path syntax:
+(i)~\\{open} type never appears in the same node together with \\{endpoint},
+\\{given}, or \\{curl}.
+(ii)~The \\{right\_type} of a node is \\{explicit} if and only if the
+\\{left\_type} of the following node is \\{explicit}.
+(iii)~\\{endpoint} types occur only at the ends, as mentioned above.
+
+\Y\P\D \37$\\{left\_curl}\S\\{left\_x}$\C{curl information when entering this
+knot}\par
+\P\D \37$\\{left\_given}\S\\{left\_x}$\C{given direction when entering this
+knot}\par
+\P\D \37$\\{left\_tension}\S\\{left\_y}$\C{tension information when entering
+this knot}\par
+\P\D \37$\\{right\_curl}\S\\{right\_x}$\C{curl information when leaving this
+knot}\par
+\P\D \37$\\{right\_given}\S\\{right\_x}$\C{given direction when leaving this
+knot}\par
+\P\D \37$\\{right\_tension}\S\\{right\_y}$\C{tension information when leaving
+this knot}\par
+\P\D \37$\\{explicit}=1$\C{\\{left\_type} or \\{right\_type} when control
+points are known}\par
+\P\D \37$\\{given}=2$\C{\\{left\_type} or \\{right\_type} when a direction is
+given}\par
+\P\D \37$\\{curl}=3$\C{\\{left\_type} or \\{right\_type} when a curl is
+desired}\par
+\P\D \37$\\{open}=4$\C{\\{left\_type} or \\{right\_type} when \MF\ should
+choose the direction}\par
+\fi
+
+\M257. Here is a diagnostic routine that prints a given knot list
+in symbolic form. It illustrates the conventions discussed above,
+and checks for anomalies that might arise while \MF\ is being debugged.
+
+\Y\P$\4\X257:Declare subroutines for printing expressions\X\S$\6
+\4\&{procedure}\1\ \37$\\{print\_path}(\|h:\\{pointer};\,\35\|s:\\{str%
+\_number};\,\35\\{nuline}:\\{boolean})$;\6
+\4\&{label} \37$\\{done},\39\\{done1}$;\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{for list traversal}\2\6
+\&{begin} \37$\\{print\_diagnostic}(\.{"Path"},\39\|s,\39\\{nuline})$;\5
+\\{print\_ln};\5
+$\|p\K\|h$;\6
+\1\&{repeat} \37$\|q\K\\{link}(\|p)$;\6
+\&{if} $(\|p=\\{null})\V(\|q=\\{null})$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"???"})$;\5
+\&{goto} \37\\{done};\C{this won't happen}\6
+\&{end};\2\6
+\X258:Print information for adjacent knots \|p and \|q\X;\6
+$\|p\K\|q$;\6
+\&{if} $(\|p\I\|h)\V(\\{left\_type}(\|h)\I\\{endpoint})$ \1\&{then}\5
+\X259:Print two dots, followed by \\{given} or \\{curl} if present\X;\2\6
+\4\&{until}\5
+$\|p=\|h$;\2\6
+\&{if} $\\{left\_type}(\|h)\I\\{endpoint}$ \1\&{then}\5
+$\\{print}(\.{"cycle"})$;\2\6
+\4\\{done}: \37$\\{end\_diagnostic}(\\{true})$;\6
+\&{end};\par
+\As332, 388, 473, 589, 801\ETs807.
+\U246.\fi
+
+\M258. \P$\X258:Print information for adjacent knots \|p and \|q\X\S$\6
+$\\{print\_two}(\\{x\_coord}(\|p),\39\\{y\_coord}(\|p))$;\6
+\&{case} $\\{right\_type}(\|p)$ \1\&{of}\6
+\4\\{endpoint}: \37\&{begin} \37\&{if} $\\{left\_type}(\|p)=\\{open}$ \1%
+\&{then}\5
+$\\{print}(\.{"\{open?\}"})$;\C{can't happen}\2\6
+\&{if} $(\\{left\_type}(\|q)\I\\{endpoint})\V(\|q\I\|h)$ \1\&{then}\5
+$\|q\K\\{null}$;\C{force an error}\2\6
+\&{goto} \37\\{done1};\6
+\&{end};\6
+\4\\{explicit}: \37\X261:Print control points between \|p and \|q, then %
+\&{goto} \\{done1}\X;\6
+\4\\{open}: \37\X262:Print information for a curve that begins \\{open}\X;\6
+\4$\\{curl},\39\\{given}$: \37\X263:Print information for a curve that begins %
+\\{curl} or \\{given}\X;\6
+\4\&{othercases} \37$\\{print}(\.{"???"})$\C{can't happen}\2\6
+\&{endcases};\6
+\&{if} $\\{left\_type}(\|q)\L\\{explicit}$ \1\&{then}\5
+$\\{print}(\.{"..control?"})$\C{can't happen}\6
+\4\&{else} \&{if} $(\\{right\_tension}(\|p)\I\\{unity})\V(\\{left\_tension}(%
+\|q)\I\\{unity})$ \1\&{then}\5
+\X260:Print tension between \|p and \|q\X;\2\2\6
+\4\\{done1}: \37\par
+\U257.\fi
+
+\M259. Since \\{n\_sin\_cos} produces \\{fraction} results, which we will print
+as if they
+were \\{scaled}, the magnitude of a \\{given} direction vector will be~4096.
+
+\Y\P$\4\X259:Print two dots, followed by \\{given} or \\{curl} if present\X\S$\6
+\&{begin} \37$\\{print\_nl}(\.{"\ .."})$;\6
+\&{if} $\\{left\_type}(\|p)=\\{given}$ \1\&{then}\6
+\&{begin} \37$\\{n\_sin\_cos}(\\{left\_given}(\|p))$;\5
+$\\{print\_char}(\.{"\{"})$;\5
+$\\{print\_scaled}(\\{n\_cos})$;\5
+$\\{print\_char}(\.{","})$;\5
+$\\{print\_scaled}(\\{n\_sin})$;\5
+$\\{print\_char}(\.{"\}"})$;\6
+\&{end}\6
+\4\&{else} \&{if} $\\{left\_type}(\|p)=\\{curl}$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"\{curl\ "})$;\5
+$\\{print\_scaled}(\\{left\_curl}(\|p))$;\5
+$\\{print\_char}(\.{"\}"})$;\6
+\&{end};\2\2\6
+\&{end}\par
+\U257.\fi
+
+\M260. \P$\X260:Print tension between \|p and \|q\X\S$\6
+\&{begin} \37$\\{print}(\.{"..tension\ "})$;\6
+\&{if} $\\{right\_tension}(\|p)<0$ \1\&{then}\5
+$\\{print}(\.{"atleast"})$;\2\6
+$\\{print\_scaled}(\\{abs}(\\{right\_tension}(\|p)))$;\6
+\&{if} $\\{right\_tension}(\|p)\I\\{left\_tension}(\|q)$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"\ and\ "})$;\6
+\&{if} $\\{left\_tension}(\|q)<0$ \1\&{then}\5
+$\\{print}(\.{"atleast"})$;\2\6
+$\\{print\_scaled}(\\{abs}(\\{left\_tension}(\|q)))$;\6
+\&{end};\2\6
+\&{end}\par
+\U258.\fi
+
+\M261. \P$\X261:Print control points between \|p and \|q, then \&{goto} %
+\\{done1}\X\S$\6
+\&{begin} \37$\\{print}(\.{"..controls\ "})$;\5
+$\\{print\_two}(\\{right\_x}(\|p),\39\\{right\_y}(\|p))$;\5
+$\\{print}(\.{"\ and\ "})$;\6
+\&{if} $\\{left\_type}(\|q)\I\\{explicit}$ \1\&{then}\5
+$\\{print}(\.{"??"})$\C{can't happen}\6
+\4\&{else} $\\{print\_two}(\\{left\_x}(\|q),\39\\{left\_y}(\|q))$;\2\6
+\&{goto} \37\\{done1};\6
+\&{end}\par
+\U258.\fi
+
+\M262. \P$\X262:Print information for a curve that begins \\{open}\X\S$\6
+\&{if} $(\\{left\_type}(\|p)\I\\{explicit})\W(\\{left\_type}(\|p)\I\\{open})$ %
+\1\&{then}\5
+$\\{print}(\.{"\{open?\}"})$\C{can't happen}\2\par
+\U258.\fi
+
+\M263. A curl of 1 is shown explicitly, so that the user sees clearly that
+\MF's default curl is present.
+
+The code here uses the fact that $\\{left\_curl}\S\\{left\_given}$ and
+$\\{right\_curl}\S\\{right\_given}$.
+
+\Y\P$\4\X263:Print information for a curve that begins \\{curl} or \\{given}\X%
+\S$\6
+\&{begin} \37\&{if} $\\{left\_type}(\|p)=\\{open}$ \1\&{then}\5
+$\\{print}(\.{"??"})$;\C{can't happen}\2\6
+\&{if} $\\{right\_type}(\|p)=\\{curl}$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"\{curl\ "})$;\5
+$\\{print\_scaled}(\\{right\_curl}(\|p))$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{n\_sin\_cos}(\\{right\_given}(\|p))$;\5
+$\\{print\_char}(\.{"\{"})$;\5
+$\\{print\_scaled}(\\{n\_cos})$;\5
+$\\{print\_char}(\.{","})$;\5
+$\\{print\_scaled}(\\{n\_sin})$;\6
+\&{end};\2\6
+$\\{print\_char}(\.{"\}"})$;\6
+\&{end}\par
+\U258.\fi
+
+\M264. If we want to duplicate a knot node, we can say \\{copy\_knot}:
+
+\Y\P\4\&{function}\1\ \37$\\{copy\_knot}(\|p:\\{pointer})$: \37\\{pointer};\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the copy}\6
+\|k: \37$0\to\\{knot\_node\_size}-1$;\C{runs through the words of a knot node}%
+\2\6
+\&{begin} \37$\|q\K\\{get\_node}(\\{knot\_node\_size})$;\6
+\&{for} $\|k\K0\mathrel{\&{to}}\\{knot\_node\_size}-1$ \1\&{do}\5
+$\\{mem}[\|q+\|k]\K\\{mem}[\|p+\|k]$;\2\6
+$\\{copy\_knot}\K\|q$;\6
+\&{end};\par
+\fi
+
+\M265. The \\{copy\_path} routine makes a clone of a given path.
+
+\Y\P\4\&{function}\1\ \37$\\{copy\_path}(\|p:\\{pointer})$: \37\\{pointer};\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37$\|q,\39\\{pp},\39\\{qq}$: \37\\{pointer};\C{for list
+manipulation}\2\6
+\&{begin} \37$\|q\K\\{get\_node}(\\{knot\_node\_size})$;\C{this will correspond
+to \|p}\6
+$\\{qq}\K\|q$;\5
+$\\{pp}\K\|p$;\6
+\~ \1\&{loop}\ \&{begin} \37$\\{left\_type}(\\{qq})\K\\{left\_type}(\\{pp})$;\5
+$\\{right\_type}(\\{qq})\K\\{right\_type}(\\{pp})$;\6
+$\\{x\_coord}(\\{qq})\K\\{x\_coord}(\\{pp})$;\5
+$\\{y\_coord}(\\{qq})\K\\{y\_coord}(\\{pp})$;\6
+$\\{left\_x}(\\{qq})\K\\{left\_x}(\\{pp})$;\5
+$\\{left\_y}(\\{qq})\K\\{left\_y}(\\{pp})$;\6
+$\\{right\_x}(\\{qq})\K\\{right\_x}(\\{pp})$;\5
+$\\{right\_y}(\\{qq})\K\\{right\_y}(\\{pp})$;\6
+\&{if} $\\{link}(\\{pp})=\|p$ \1\&{then}\6
+\&{begin} \37$\\{link}(\\{qq})\K\|q$;\5
+$\\{copy\_path}\K\|q$;\5
+\&{return};\6
+\&{end};\2\6
+$\\{link}(\\{qq})\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{qq}\K\\{link}(\\{qq})$;\5
+$\\{pp}\K\\{link}(\\{pp})$;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M266. Similarly, there's a way to copy the {\sl reverse\/} of a path. This
+procedure
+returns a pointer to the first node of the copy, if the path is a cycle,
+but to the final node of a non-cyclic copy. The global
+variable \\{path\_tail} will point to the final node of the original path;
+this trick makes it easier to implement `\&{doublepath}'.
+
+All node types are assumed to be \\{endpoint} or \\{explicit} only.
+
+\Y\P\4\&{function}\1\ \37$\\{htap\_ypoc}(\|p:\\{pointer})$: \37\\{pointer};\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37$\|q,\39\\{pp},\39\\{qq},\39\\{rr}$: \37\\{pointer};\C{for list
+manipulation}\2\6
+\&{begin} \37$\|q\K\\{get\_node}(\\{knot\_node\_size})$;\C{this will correspond
+to \|p}\6
+$\\{qq}\K\|q$;\5
+$\\{pp}\K\|p$;\6
+\~ \1\&{loop}\ \&{begin} \37$\\{right\_type}(\\{qq})\K\\{left\_type}(\\{pp})$;\5
+$\\{left\_type}(\\{qq})\K\\{right\_type}(\\{pp})$;\6
+$\\{x\_coord}(\\{qq})\K\\{x\_coord}(\\{pp})$;\5
+$\\{y\_coord}(\\{qq})\K\\{y\_coord}(\\{pp})$;\6
+$\\{right\_x}(\\{qq})\K\\{left\_x}(\\{pp})$;\5
+$\\{right\_y}(\\{qq})\K\\{left\_y}(\\{pp})$;\6
+$\\{left\_x}(\\{qq})\K\\{right\_x}(\\{pp})$;\5
+$\\{left\_y}(\\{qq})\K\\{right\_y}(\\{pp})$;\6
+\&{if} $\\{link}(\\{pp})=\|p$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|q)\K\\{qq}$;\5
+$\\{path\_tail}\K\\{pp}$;\5
+$\\{htap\_ypoc}\K\|q$;\5
+\&{return};\6
+\&{end};\2\6
+$\\{rr}\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{link}(\\{rr})\K\\{qq}$;\5
+$\\{qq}\K\\{rr}$;\5
+$\\{pp}\K\\{link}(\\{pp})$;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M267. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{path\_tail}: \37\\{pointer};\C{the node that links to the beginning of a
+path}\par
+\fi
+
+\M268. When a cyclic list of knot nodes is no longer needed, it can be recycled
+by
+calling the following subroutine.
+
+\Y\P$\4\X268:Declare the recycling subroutines\X\S$\6
+\4\&{procedure}\1\ \37$\\{toss\_knot\_list}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the node being freed}\6
+\|r: \37\\{pointer};\C{the next node}\2\6
+\&{begin} \37$\|q\K\|p$;\6
+\1\&{repeat} \37$\|r\K\\{link}(\|q)$;\5
+$\\{free\_node}(\|q,\39\\{knot\_node\_size})$;\5
+$\|q\K\|r$;\6
+\4\&{until}\5
+$\|q=\|p$;\2\6
+\&{end};\par
+\As385, 487, 620\ETs809.
+\U246.\fi
+
+\N269. \[18] Choosing control points.
+Now we must actually delve into one of \MF's more difficult routines,
+the \\{make\_choices} procedure that chooses angles and control points for
+the splines of a curve when the user has not specified them explicitly.
+The parameter to \\{make\_choices} points to a list of knots and
+path information, as described above.
+
+A path decomposes into independent segments at ``breakpoint'' knots,
+which are knots whose left and right angles are both prespecified in
+some way (i.e., their \\{left\_type} and \\{right\_type} aren't both open).
+
+\Y\P\hbox{\4}\X284:Declare the procedure called \\{solve\_choices}\X\6
+\4\&{procedure}\1\ \37$\\{make\_choices}(\\{knots}:\\{pointer})$;\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|h: \37\\{pointer};\C{the first breakpoint}\6
+$\|p,\39\|q$: \37\\{pointer};\C{consecutive breakpoints being processed}\6
+\X280:Other local variables for \\{make\_choices}\X\2\6
+\&{begin} \37\\{check\_arith};\C{make sure that $\\{arith\_error}=\\{false}$}\6
+\&{if} $\\{internal}[\\{tracing\_choices}]>0$ \1\&{then}\5
+$\\{print\_path}(\\{knots},\39\.{",\ before\ choices"},\39\\{true})$;\2\6
+\X271:If consecutive knots are equal, join them explicitly\X;\6
+\X272:Find the first breakpoint, \|h, on the path; insert an artificial
+breakpoint if the path is an unbroken cycle\X;\6
+$\|p\K\|h$;\6
+\1\&{repeat} \37\X273:Fill in the control points between \|p and the next
+breakpoint, then advance \|p to that breakpoint\X;\6
+\4\&{until}\5
+$\|p=\|h$;\2\6
+\&{if} $\\{internal}[\\{tracing\_choices}]>0$ \1\&{then}\5
+$\\{print\_path}(\\{knots},\39\.{",\ after\ choices"},\39\\{true})$;\2\6
+\&{if} $\\{arith\_error}$ \1\&{then}\5
+\X270:Report an unexpected problem during the choice-making\X;\2\6
+\&{end};\par
+\fi
+
+\M270. \P$\X270:Report an unexpected problem during the choice-making\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Some\ number\ got\ too\ big"})$;\5
+$\\{help2}(\.{"The\ path\ that\ I\ just\ computed\ is\ out\ of\ range."})$\6
+$(\.{"So\ it\ will\ probably\ look\ funny.\ Proceed,\ for\ a\ laugh."})$;\5
+\\{put\_get\_error};\5
+$\\{arith\_error}\K\\{false}$;\6
+\&{end}\par
+\U269.\fi
+
+\M271. Two knots in a row with the same coordinates will always be joined
+by an explicit ``curve'' whose control points are identical with the
+knots.
+
+\Y\P$\4\X271:If consecutive knots are equal, join them explicitly\X\S$\6
+$\|p\K\\{knots}$;\6
+\1\&{repeat} \37$\|q\K\\{link}(\|p)$;\6
+\&{if} $\\{x\_coord}(\|p)=\\{x\_coord}(\|q)$ \1\&{then}\6
+\&{if} $\\{y\_coord}(\|p)=\\{y\_coord}(\|q)$ \1\&{then}\6
+\&{if} $\\{right\_type}(\|p)>\\{explicit}$ \1\&{then}\6
+\&{begin} \37$\\{right\_type}(\|p)\K\\{explicit}$;\6
+\&{if} $\\{left\_type}(\|p)=\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{left\_type}(\|p)\K\\{curl}$;\5
+$\\{left\_curl}(\|p)\K\\{unity}$;\6
+\&{end};\2\6
+$\\{left\_type}(\|q)\K\\{explicit}$;\6
+\&{if} $\\{right\_type}(\|q)=\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{right\_type}(\|q)\K\\{curl}$;\5
+$\\{right\_curl}(\|q)\K\\{unity}$;\6
+\&{end};\2\6
+$\\{right\_x}(\|p)\K\\{x\_coord}(\|p)$;\5
+$\\{left\_x}(\|q)\K\\{x\_coord}(\|p)$;\6
+$\\{right\_y}(\|p)\K\\{y\_coord}(\|p)$;\5
+$\\{left\_y}(\|q)\K\\{y\_coord}(\|p)$;\6
+\&{end};\2\2\2\6
+$\|p\K\|q$;\6
+\4\&{until}\5
+$\|p=\\{knots}$\2\par
+\U269.\fi
+
+\M272. If there are no breakpoints, it is necessary to compute the direction
+angles around an entire cycle. In this case the \\{left\_type} of the first
+node is temporarily changed to \\{end\_cycle}.
+
+\Y\P\D \37$\\{end\_cycle}=\\{open}+1$\par
+\Y\P$\4\X272:Find the first breakpoint, \|h, on the path; insert an artificial
+breakpoint if the path is an unbroken cycle\X\S$\6
+$\|h\K\\{knots}$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\\{left\_type}(\|h)\I\\{open}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\\{right\_type}(\|h)\I\\{open}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|h\K\\{link}(\|h)$;\6
+\&{if} $\|h=\\{knots}$ \1\&{then}\6
+\&{begin} \37$\\{left\_type}(\|h)\K\\{end\_cycle}$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+\&{end};\2\6
+\4\\{done}: \37\par
+\U269.\fi
+
+\M273. If $\\{right\_type}(\|p)<\\{given}$ and $\|q=\\{link}(\|p)$, we must
+have
+$\\{right\_type}(\|p)=\\{left\_type}(\|q)=\\{explicit}$ or \\{endpoint}.
+
+\Y\P$\4\X273:Fill in the control points between \|p and the next breakpoint,
+then advance \|p to that breakpoint\X\S$\6
+$\|q\K\\{link}(\|p)$;\6
+\&{if} $\\{right\_type}(\|p)\G\\{given}$ \1\&{then}\6
+\&{begin} \37\&{while} $(\\{left\_type}(\|q)=\\{open})\W(\\{right\_type}(\|q)=%
+\\{open})$ \1\&{do}\5
+$\|q\K\\{link}(\|q)$;\2\6
+\X278:Fill in the control information between consecutive breakpoints \|p and %
+\|q\X;\6
+\&{end};\2\6
+$\|p\K\|q$\par
+\U269.\fi
+
+\M274. Before we can go further into the way choices are made, we need to
+consider the underlying theory. The basic ideas implemented in \\{make%
+\_choices}
+are due to John Hobby, who introduced the notion of ``mock curvature''
+at a knot. Angles are chosen so that they preserve mock curvature when
+a knot is passed, and this has been found to produce excellent results.
+
+It is convenient to introduce some notations that simplify the necessary
+formulas. Let $d_{k,k+1}=\vert z\k-z_k\vert$ be the (nonzero) distance
+between knots \|k and $\|k+1$; and let
+$${z\k-z_k\over z_k-z_{k-1}}={d_{k,k+1}\over d_{k-1,k}}e^{i\psi_k}$$
+so that a polygonal line from $z_{k-1}$ to $z_k$ to $z\k$ turns left
+through an angle of~$\psi_k$. We assume that $\vert\psi_k\vert\L180^\circ$.
+The control points for the spline from $z_k$ to $z\k$ will be denoted by
+$$\eqalign{z_k^+&=z_k+
+\textstyle{1\over3}\rho_k e^{i\theta_k}(z\k-z_k),\cr
+z\k^-&=z\k-
+\textstyle{1\over3}\sigma\k e^{-i\phi\k}(z\k-z_k),\cr}$$
+where $\rho_k$ and $\sigma\k$ are nonnegative ``velocity ratios'' at the
+beginning and end of the curve, while $\theta_k$ and $\phi\k$ are the
+corresponding ``offset angles.'' These angles satisfy the condition
+$$\theta_k+\phi_k+\psi_k=0,\eqno(*)$$
+whenever the curve leaves an intermediate knot~\|k in the direction that
+it enters.
+
+\fi
+
+\M275. Let $\alpha_k$ and $\beta\k$ be the reciprocals of the ``tension'' of
+the curve at its beginning and ending points. This means that
+$\rho_k=\alpha_k f(\theta_k,\phi\k)$ and $\sigma\k=\beta\k f(\phi\k,\theta_k)$,
+where $f(\theta,\phi)$ is \MF's standard velocity function defined in
+the \\{velocity} subroutine. The cubic spline $B(z_k^{\phantom+},z_k^+,
+z\k^-,z\k^{\phantom+};t)$
+has curvature
+$${2\sigma\k\sin(\theta_k+\phi\k)-6\sin\theta_k\over\rho_k^2d_{k,k+1}}
+\qquad{\rm and}\qquad
+{2\rho_k\sin(\theta_k+\phi\k)-6\sin\phi\k\over\sigma\k^2d_{k,k+1}}$$
+at $\|t=0$ and $\|t=1$, respectively. The mock curvature is the linear
+approximation to this true curvature that arises in the limit for
+small $\theta_k$ and~$\phi\k$, if second-order terms are discarded.
+The standard velocity function satisfies
+$$f(\theta,\phi)=1+O(\theta^2+\theta\phi+\phi^2);$$
+hence the mock curvatures are respectively
+$${2\beta\k(\theta_k+\phi\k)-6\theta_k\over\alpha_k^2d_{k,k+1}}
+\qquad{\rm and}\qquad
+{2\alpha_k(\theta_k+\phi\k)-6\phi\k\over\beta\k^2d_{k,k+1}}.\eqno(**)$$
+
+\fi
+
+\M276. The turning angles $\psi_k$ are given, and equation $(*)$ above
+determines $\phi_k$ when $\theta_k$ is known, so the task of
+angle selection is essentially to choose appropriate values for each
+$\theta_k$. When equation~$(*)$ is used to eliminate $\phi$~variables
+from $(**)$, we obtain a system of linear equations of the form
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+where
+$$A_k={\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
+\qquad B_k={3-\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
+\qquad C_k={3-\beta\k\over\alpha_k^2d_{k,k+1}},
+\qquad D_k={\beta\k\over\alpha_k^2d_{k,k+1}}.$$
+The tensions are always $3\over4$ or more, hence each $\alpha$ and~$\beta$
+will be at most $4\over3$. It follows that $B_k\G{5\over4}A_k$ and
+$C_k\G{5\over4}D_k$; hence the equations are diagonally dominant;
+hence they have a unique solution. Moreover, in most cases the tensions
+are equal to~1, so that $B_k=2A_k$ and $C_k=2D_k$. This makes the
+solution numerically stable, and there is an exponential damping
+effect: The data at knot $k\pm j$ affects the angle at knot~$k$ by
+a factor of~$O(2^{-j})$.
+
+\fi
+
+\M277. However, we still must consider the angles at the starting and ending
+knots of a non-cyclic path. These angles might be given explicitly, or
+they might be specified implicitly in terms of an amount of ``curl.''
+
+Let's assume that angles need to be determined for a non-cyclic path
+starting at $z_0$ and ending at~$z_n$. Then equations of the form
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta_{k+1}=R_k$$
+have been given for $0<k<n$, and it will be convenient to introduce
+equations of the same form for $k=0$ and $k=n$, where
+$$A_0=B_0=C_n=D_n=0.$$
+If $\theta_0$ is supposed to have a given value $E_0$, we simply
+define $C_0=0$, $D_0=0$, and $R_0=E_0$. Otherwise a curl
+parameter, $\gamma_0$, has been specified at~$z_0$; this means
+that the mock curvature at $z_0$ should be $\gamma_0$ times the
+mock curvature at $z_1$; i.e.,
+$${2\beta_1(\theta_0+\phi_1)-6\theta_0\over\alpha_0^2d_{01}}
+=\gamma_0{2\alpha_0(\theta_0+\phi_1)-6\phi_1\over\beta_1^2d_{01}}.$$
+This equation simplifies to
+$$(\alpha_0\chi_0+3-\beta_1)\theta_0+
+\bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\theta_1=
+-\bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\psi_1,$$
+where $\chi_0=\alpha_0^2\gamma_0/\beta_1^2$; so we can set $C_0=
+\chi_0\alpha_0+3-\beta_1$, $D_0=(3-\alpha_0)\chi_0+\beta_1$, $R_0=-D_0\psi_1$.
+It can be shown that $C_0>0$ and $C_0B_1-A_1D_0>0$ when $\gamma_0\G0$,
+hence the linear equations remain nonsingular.
+
+Similar considerations apply at the right end, when the final angle $\phi_n$
+may or may not need to be determined. It is convenient to let $\psi_n=0$,
+hence $\theta_n=-\phi_n$. We either have an explicit equation $\theta_n=E_n$,
+or we have
+$$\bigl((3-\beta_n)\chi_n+\alpha_{n-1}\bigr)\theta_{n-1}+
+(\beta_n\chi_n+3-\alpha_{n-1})\theta_n=0,\qquad
+\chi_n={\beta_n^2\gamma_n\over\alpha_{n-1}^2}.$$
+
+When \\{make\_choices} chooses angles, it must compute the coefficients of
+these linear equations, then solve the equations. To compute the coefficients,
+it is necessary to compute arctangents of the given turning angles~$\psi_k$.
+When the equations are solved, the chosen directions $\theta_k$ are put
+back into the form of control points by essentially computing sines and
+cosines.
+
+\fi
+
+\M278. OK, we are ready to make the hard choices of \\{make\_choices}.
+Most of the work is relegated to an auxiliary procedure
+called \\{solve\_choices}, which has been introduced to keep
+\\{make\_choices} from being extremely long.
+
+\Y\P$\4\X278:Fill in the control information between consecutive breakpoints %
+\|p and \|q\X\S$\6
+\X281:Calculate the turning angles $\psi_k$ and the distances $d_{k,k+1}$; set
+$n$ to the length of the path\X;\6
+\X282:Remove \\{open} types at the breakpoints\X;\6
+$\\{solve\_choices}(\|p,\39\|q,\39\|n)$\par
+\U273.\fi
+
+\M279. It's convenient to precompute quantities that will be needed several
+times later. The values of $\\{delta\_x}[\|k]$ and $\\{delta\_y}[\|k]$ will be
+the
+coordinates of $z\k-z_k$, and the magnitude of this vector will be
+$\\{delta}[\|k]=\hbox{$d_{k,k+1}$}$. The path angle $\psi_k$ between
+$z_k-z_{k-1}$
+and $z\k-z_k$ will be stored in $\\{psi}[\|k]$.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{delta\_x},\39\\{delta\_y},\39\\{delta}$: \37\&{array} $[0\to\\{path%
+\_size}]$ \1\&{of}\5
+\\{scaled};\C{knot differences}\2\6
+\4\\{psi}: \37\&{array} $[1\to\\{path\_size}]$ \1\&{of}\5
+\\{angle};\C{turning angles}\2\par
+\fi
+
+\M280. \P$\X280:Other local variables for \\{make\_choices}\X\S$\6
+\4$\|k,\39\|n$: \37$0\to\\{path\_size}$;\C{current and final knot numbers}\6
+\4$\|s,\39\|t$: \37\\{pointer};\C{registers for list traversal}\6
+\4$\\{delx},\39\\{dely}$: \37\\{scaled};\C{directions where \\{open} meets %
+\\{explicit}}\6
+\4$\\{sine},\39\\{cosine}$: \37\\{fraction};\C{trig functions of various
+angles}\par
+\U269.\fi
+
+\M281. \P$\X281:Calculate the turning angles $\psi_k$ and the distances
+$d_{k,k+1}$; set $n$ to the length of the path\X\S$\6
+$\|k\K0$;\5
+$\|s\K\|p$;\5
+$\|n\K\\{path\_size}$;\6
+\1\&{repeat} \37$\|t\K\\{link}(\|s)$;\5
+$\\{delta\_x}[\|k]\K\\{x\_coord}(\|t)-\\{x\_coord}(\|s)$;\5
+$\\{delta\_y}[\|k]\K\\{y\_coord}(\|t)-\\{y\_coord}(\|s)$;\5
+$\\{delta}[\|k]\K\\{pyth\_add}(\\{delta\_x}[\|k],\39\\{delta\_y}[\|k])$;\6
+\&{if} $\|k>0$ \1\&{then}\6
+\&{begin} \37$\\{sine}\K\\{make\_fraction}(\\{delta\_y}[\|k-1],\39\\{delta}[%
+\|k-1])$;\5
+$\\{cosine}\K\\{make\_fraction}(\\{delta\_x}[\|k-1],\39\\{delta}[\|k-1])$;\5
+$\\{psi}[\|k]\K\\{n\_arg}(\\{take\_fraction}(\\{delta\_x}[\|k],\39\\{cosine})+%
+\\{take\_fraction}(\\{delta\_y}[\|k],\39\\{sine}),\39\\{take\_fraction}(%
+\\{delta\_y}[\|k],\39\\{cosine})-\\{take\_fraction}(\\{delta\_x}[\|k],\39%
+\\{sine}))$;\6
+\&{end};\2\6
+$\\{incr}(\|k)$;\5
+$\|s\K\|t$;\6
+\&{if} $\|k=\\{path\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"path\ size"},\39\\{path\_size})$;\2\6
+\&{if} $\|s=\|q$ \1\&{then}\5
+$\|n\K\|k$;\2\6
+\4\&{until}\5
+$(\|k\G\|n)\W(\\{left\_type}(\|s)\I\\{end\_cycle})$;\2\6
+\&{if} $\|k=\|n$ \1\&{then}\5
+$\\{psi}[\|n]\K0$\ \&{else} $\\{psi}[\|k]\K\\{psi}[1]$\2\par
+\U278.\fi
+
+\M282. When we get to this point of the code, $\\{right\_type}(\|p)$ is either
+\\{given} or \\{curl} or \\{open}. If it is \\{open}, we must have
+$\\{left\_type}(\|p)=\\{end\_cycle}$ or $\\{left\_type}(\|p)=\\{explicit}$. In
+the latter
+case, the \\{open} type is converted to \\{given}; however, if the
+velocity coming into this knot is zero, the \\{open} type is
+converted to a \\{curl}, since we don't know the incoming direction.
+
+Similarly, $\\{left\_type}(\|q)$ is either \\{given} or \\{curl} or \\{open} or
+\\{end\_cycle}. The \\{open} possibility is reduced either to \\{given} or to %
+\\{curl}.
+
+\Y\P$\4\X282:Remove \\{open} types at the breakpoints\X\S$\6
+\&{if} $\\{left\_type}(\|q)=\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{delx}\K\\{right\_x}(\|q)-\\{x\_coord}(\|q)$;\5
+$\\{dely}\K\\{right\_y}(\|q)-\\{y\_coord}(\|q)$;\6
+\&{if} $(\\{delx}=0)\W(\\{dely}=0)$ \1\&{then}\6
+\&{begin} \37$\\{left\_type}(\|q)\K\\{curl}$;\5
+$\\{left\_curl}(\|q)\K\\{unity}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{left\_type}(\|q)\K\\{given}$;\5
+$\\{left\_given}(\|q)\K\\{n\_arg}(\\{delx},\39\\{dely})$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{if} $(\\{right\_type}(\|p)=\\{open})\W(\\{left\_type}(\|p)=\\{explicit})$ \1%
+\&{then}\6
+\&{begin} \37$\\{delx}\K\\{x\_coord}(\|p)-\\{left\_x}(\|p)$;\5
+$\\{dely}\K\\{y\_coord}(\|p)-\\{left\_y}(\|p)$;\6
+\&{if} $(\\{delx}=0)\W(\\{dely}=0)$ \1\&{then}\6
+\&{begin} \37$\\{right\_type}(\|p)\K\\{curl}$;\5
+$\\{right\_curl}(\|p)\K\\{unity}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{right\_type}(\|p)\K\\{given}$;\5
+$\\{right\_given}(\|p)\K\\{n\_arg}(\\{delx},\39\\{dely})$;\6
+\&{end};\2\6
+\&{end}\2\par
+\U278.\fi
+
+\M283. Linear equations need to be solved whenever $\|n>1$; and also when $%
+\|n=1$
+and exactly one of the breakpoints involves a curl. The simplest case occurs
+when $\|n=1$ and there is a curl at both breakpoints; then we simply draw
+a straight line.
+
+But before coding up the simple cases, we might as well face the general case,
+since we must deal with it sooner or later, and since the general case
+is likely to give some insight into the way simple cases can be handled best.
+
+When there is no cycle, the linear equations to be solved form a tri-diagonal
+system, and we can apply the standard technique of Gaussian elimination
+to convert that system to a sequence of equations of the form
+$$\theta_0+u_0\theta_1=v_0,\quad
+\theta_1+u_1\theta_2=v_1,\quad\ldots,\quad
+\theta_{n-1}+u_{n-1}\theta_n=v_{n-1},\quad
+\theta_n=v_n.$$
+It is possible to do this diagonalization while generating the equations.
+Once $\theta_n$ is known, it is easy to determine $\theta_{n-1}$, \dots,
+$\theta_1$, $\theta_0$; thus, the equations will be solved.
+
+The procedure is slightly more complex when there is a cycle, but the
+basic idea will be nearly the same. In the cyclic case the right-hand
+sides will be $v_k+w_k\theta_0$ instead of simply $v_k$, and we will start
+the process off with $u_0=v_0=0$, $w_0=1$. The final equation will be not
+$\theta_n=v_n$ but $\theta_n+u_n\theta_1=v_n+w_n\theta_0$; an appropriate
+ending routine will take account of the fact that $\theta_n=\theta_0$ and
+eliminate the $w$'s from the system, after which the solution can be
+obtained as before.
+
+When $u_k$, $v_k$, and $w_k$ are being computed, the three pointer
+variables \|r, \|s,~\|t will point respectively to knots $\|k-1$, \|k,
+and~$\|k+1$. The $u$'s and $w$'s are scaled by $2^{28}$, i.e., they are
+of type \\{fraction}; the $\theta$'s and $v$'s are of type \\{angle}.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{theta}: \37\&{array} $[0\to\\{path\_size}]$ \1\&{of}\5
+\\{angle};\C{values of $\theta_k$}\2\6
+\4\\{uu}: \37\&{array} $[0\to\\{path\_size}]$ \1\&{of}\5
+\\{fraction};\C{values of $u_k$}\2\6
+\4\\{vv}: \37\&{array} $[0\to\\{path\_size}]$ \1\&{of}\5
+\\{angle};\C{values of $v_k$}\2\6
+\4\\{ww}: \37\&{array} $[0\to\\{path\_size}]$ \1\&{of}\5
+\\{fraction};\C{values of $w_k$}\2\par
+\fi
+
+\M284. Our immediate problem is to get the ball rolling by setting up the
+first equation or by realizing that no equations are needed, and to fit
+this initialization into a framework suitable for the overall computation.
+
+\Y\P$\4\X284:Declare the procedure called \\{solve\_choices}\X\S$\6
+\hbox{\4}\X296:Declare subroutines needed by \\{solve\_choices}\X\6
+\4\&{procedure}\1\ \37$\\{solve\_choices}(\|p,\39\|q:\\{pointer};\,\35\|n:%
+\\{halfword})$;\6
+\4\&{label} \37$\\{found},\39\\{exit}$;\6
+\4\&{var} \37\|k: \37$0\to\\{path\_size}$;\C{current knot number}\6
+$\|r,\39\|s,\39\|t$: \37\\{pointer};\C{registers for list traversal}\6
+\X286:Other local variables for \\{solve\_choices}\X\2\6
+\&{begin} \37$\|k\K0$;\5
+$\|s\K\|p$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|t\K\\{link}(\|s)$;\6
+\&{if} $\|k=0$ \1\&{then}\5
+\X285:Get the linear equations started; or \&{return} with the control points
+in place, if linear equations needn't be solved\X\6
+\4\&{else} \&{case} $\\{left\_type}(\|s)$ \1\&{of}\6
+\4$\\{end\_cycle},\39\\{open}$: \37\X287:Set up equation to match mock
+curvatures at $z_k$; then \&{goto} \\{found} with $\theta_n$ adjusted to equal
+$\theta_0$, if a cycle has ended\X;\6
+\4\\{curl}: \37\X295:Set up equation for a curl at $\theta_n$ and \&{goto} %
+\\{found}\X;\6
+\4\\{given}: \37\X292:Calculate the given value of $\theta_n$ and \&{goto} %
+\\{found}\X;\2\6
+\&{end};\C{there are no other cases}\2\6
+$\|r\K\|s$;\5
+$\|s\K\|t$;\5
+$\\{incr}(\|k)$;\6
+\&{end};\2\6
+\4\\{found}: \37\X297:Finish choosing angles and assigning control points\X;\6
+\4\\{exit}: \37\&{end};\par
+\U269.\fi
+
+\M285. On the first time through the loop, we have $\|k=0$ and \|r is not yet
+defined. The first linear equation, if any, will have $A_0=B_0=0$.
+
+\Y\P$\4\X285:Get the linear equations started; or \&{return} with the control
+points in place, if linear equations needn't be solved\X\S$\6
+\&{case} $\\{right\_type}(\|s)$ \1\&{of}\6
+\4\\{given}: \37\&{if} $\\{left\_type}(\|t)=\\{given}$ \1\&{then}\5
+\X301:Reduce to simple case of two givens and \&{return}\X\6
+\4\&{else} \X293:Set up the equation for a given value of $\theta_0$\X;\2\6
+\4\\{curl}: \37\&{if} $\\{left\_type}(\|t)=\\{curl}$ \1\&{then}\5
+\X302:Reduce to simple case of straight line and \&{return}\X\6
+\4\&{else} \X294:Set up the equation for a curl at $\theta_0$\X;\2\6
+\4\\{open}: \37\&{begin} \37$\\{uu}[0]\K0$;\5
+$\\{vv}[0]\K0$;\5
+$\\{ww}[0]\K\\{fraction\_one}$;\6
+\&{end};\C{this begins a cycle}\2\6
+\&{end}\C{there are no other cases}\par
+\U284.\fi
+
+\M286. The general equation that specifies equality of mock curvature at $z_k$
+is
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+as derived above. We want to combine this with the already-derived equation
+$\theta_{k-1}+u_{k-1}\theta_k=v_{k-1}+w_{k-1}\theta_0$ in order to obtain
+a new equation
+$\theta_k+u_k\theta\k=v_k+w_k\theta_0$. This can be done by dividing the
+equation
+$$(B_k-u_{k-1}A_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k-A_kv_{k-1}
+-A_kw_{k-1}\theta_0$$
+by $B_k-u_{k-1}A_k+C_k$. The trick is to do this carefully with
+fixed-point arithmetic, avoiding the chance of overflow while retaining
+suitable precision.
+
+The calculations will be performed in several registers that
+provide temporary storage for intermediate quantities.
+
+\Y\P$\4\X286:Other local variables for \\{solve\_choices}\X\S$\6
+\4$\\{aa},\39\\{bb},\39\\{cc},\39\\{ff},\39\\{acc}$: \37\\{fraction};%
+\C{temporary registers}\6
+\4$\\{dd},\39\\{ee}$: \37\\{scaled};\C{likewise, but \\{scaled}}\6
+\4$\\{lt},\39\\{rt}$: \37\\{scaled};\C{tension values}\par
+\U284.\fi
+
+\M287. \P$\X287:Set up equation to match mock curvatures at $z_k$; then %
+\&{goto} \\{found} with $\theta_n$ adjusted to equal $\theta_0$, if a cycle has
+ended\X\S$\6
+\&{begin} \37\X288:Calculate the values $\\{aa}=A_k/B_k$, $\\{bb}=D_k/C_k$, $%
+\\{dd}=(3-\alpha_{k-1})d_{k,k+1}$, $\\{ee}=(3-\beta\k)d_{k-1,k}$, and $%
+\\{cc}=(B_k-u_{k-1}A_k)/B_k$\X;\6
+\X289:Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$\X;\6
+$\\{uu}[\|k]\K\\{take\_fraction}(\\{ff},\39\\{bb})$;\5
+\X290:Calculate the values of $v_k$ and $w_k$\X;\6
+\&{if} $\\{left\_type}(\|s)=\\{end\_cycle}$ \1\&{then}\5
+\X291:Adjust $\theta_n$ to equal $\theta_0$ and \&{goto} \\{found}\X;\2\6
+\&{end}\par
+\U284.\fi
+
+\M288. Since tension values are never less than 3/4, the values \\{aa} and
+\\{bb} computed here are never more than 4/5.
+
+\Y\P$\4\X288:Calculate the values $\\{aa}=A_k/B_k$, $\\{bb}=D_k/C_k$, $%
+\\{dd}=(3-\alpha_{k-1})d_{k,k+1}$, $\\{ee}=(3-\beta\k)d_{k-1,k}$, and $%
+\\{cc}=(B_k-u_{k-1}A_k)/B_k$\X\S$\6
+\&{if} $\\{abs}(\\{right\_tension}(\|r))=\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{aa}\K\\{fraction\_half}$;\5
+$\\{dd}\K2\ast\\{delta}[\|k]$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{aa}\K\\{make\_fraction}(\\{unity},\393\ast\\{abs}(%
+\\{right\_tension}(\|r))-\\{unity})$;\5
+$\\{dd}\K\\{take\_fraction}(\\{delta}[\|k],\39\\{fraction\_three}-\\{make%
+\_fraction}(\\{unity},\39\\{abs}(\\{right\_tension}(\|r))))$;\6
+\&{end};\2\6
+\&{if} $\\{abs}(\\{left\_tension}(\|t))=\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{bb}\K\\{fraction\_half}$;\5
+$\\{ee}\K2\ast\\{delta}[\|k-1]$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{bb}\K\\{make\_fraction}(\\{unity},\393\ast\\{abs}(%
+\\{left\_tension}(\|t))-\\{unity})$;\5
+$\\{ee}\K\\{take\_fraction}(\\{delta}[\|k-1],\39\\{fraction\_three}-\\{make%
+\_fraction}(\\{unity},\39\\{abs}(\\{left\_tension}(\|t))))$;\6
+\&{end};\2\6
+$\\{cc}\K\\{fraction\_one}-\\{take\_fraction}(\\{uu}[\|k-1],\39\\{aa})$\par
+\U287.\fi
+
+\M289. The ratio to be calculated in this step can be written in the form
+$$\beta_k^2\cdot\\{ee}\over\beta_k^2\cdot\\{ee}+\alpha_k^2\cdot
+\\{cc}\cdot\\{dd},$$
+because of the quantities just calculated. The values of \\{dd} and \\{ee}
+will not be needed after this step has been performed.
+
+\Y\P$\4\X289:Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$\X\S$\6
+$\\{dd}\K\\{take\_fraction}(\\{dd},\39\\{cc})$;\5
+$\\{lt}\K\\{abs}(\\{left\_tension}(\|s))$;\5
+$\\{rt}\K\\{abs}(\\{right\_tension}(\|s))$;\6
+\&{if} $\\{lt}\I\\{rt}$ \1\&{then}\C{$\beta_k^{-1}\ne\alpha_k^{-1}$}\6
+\&{if} $\\{lt}<\\{rt}$ \1\&{then}\6
+\&{begin} \37$\\{ff}\K\\{make\_fraction}(\\{lt},\39\\{rt})$;\5
+$\\{ff}\K\\{take\_fraction}(\\{ff},\39\\{ff})$;\C{$\alpha_k^2/\beta_k^2$}\6
+$\\{dd}\K\\{take\_fraction}(\\{dd},\39\\{ff})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{ff}\K\\{make\_fraction}(\\{rt},\39\\{lt})$;\5
+$\\{ff}\K\\{take\_fraction}(\\{ff},\39\\{ff})$;\C{$\beta_k^2/\alpha_k^2$}\6
+$\\{ee}\K\\{take\_fraction}(\\{ee},\39\\{ff})$;\6
+\&{end};\2\2\6
+$\\{ff}\K\\{make\_fraction}(\\{ee},\39\\{ee}+\\{dd})$\par
+\U287.\fi
+
+\M290. The value of $u_{k-1}$ will be $\L1$ except when $k=1$ and the previous
+equation was specified by a curl. In that case we must use a special
+method of computation to prevent overflow.
+
+Fortunately, the calculations turn out to be even simpler in this ``hard''
+case. The curl equation makes $w_0=0$ and $v_0=-u_0\psi_1$, hence
+$-B_1\psi_1-A_1v_0=-(B_1-u_0A_1)\psi_1=-\\{cc}\cdot B_1\psi_1$.
+
+\Y\P$\4\X290:Calculate the values of $v_k$ and $w_k$\X\S$\6
+$\\{acc}\K-\\{take\_fraction}(\\{psi}[\|k+1],\39\\{uu}[\|k])$;\6
+\&{if} $\\{right\_type}(\|r)=\\{curl}$ \1\&{then}\6
+\&{begin} \37$\\{ww}[\|k]\K0$;\5
+$\\{vv}[\|k]\K\\{acc}-\\{take\_fraction}(\\{psi}[1],\39\\{fraction\_one}-%
+\\{ff})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{ff}\K\\{make\_fraction}(\\{fraction\_one}-\\{ff},%
+\39\\{cc})$;\C{this is $B_k/(C_k+B_k-u_{k-1}A_k)<5$}\6
+$\\{acc}\K\\{acc}-\\{take\_fraction}(\\{psi}[\|k],\39\\{ff})$;\5
+$\\{ff}\K\\{take\_fraction}(\\{ff},\39\\{aa})$;\C{this is
+$A_k/(C_k+B_k-u_{k-1}A_k)$}\6
+$\\{vv}[\|k]\K\\{acc}-\\{take\_fraction}(\\{vv}[\|k-1],\39\\{ff})$;\6
+\&{if} $\\{ww}[\|k-1]=0$ \1\&{then}\5
+$\\{ww}[\|k]\K0$\6
+\4\&{else} $\\{ww}[\|k]\K-\\{take\_fraction}(\\{ww}[\|k-1],\39\\{ff})$;\2\6
+\&{end}\2\par
+\U287.\fi
+
+\M291. When a complete cycle has been traversed, we have $\theta_k+u_k\theta\k=
+v_k+w_k\theta_0$, for $1\L\|k\L\|n$. We would like to determine the value of
+$\theta_n$ and reduce the system to the form $\theta_k+u_k\theta\k=v_k$
+for $0\L\|k<\|n$, so that the cyclic case can be finished up just as if there
+were no cycle.
+
+The idea in the following code is to observe that
+$$\eqalign{\theta_n&=v_n+w_n\theta_0-u_n\theta_1=\cdots\cr
+&=v_n+w_n\theta_0-u_n\bigl(v_1+w_1\theta_0-u_1(v_2+\cdots
+-u_{n-2}(v_{n-1}+w_{n-1}\theta_0-u_{n-1}\theta_0)\ldots{})\bigr),\cr}$$
+so we can solve for $\theta_n=\theta_0$.
+
+\Y\P$\4\X291:Adjust $\theta_n$ to equal $\theta_0$ and \&{goto} \\{found}\X\S$\6
+\&{begin} \37$\\{aa}\K0$;\5
+$\\{bb}\K\\{fraction\_one}$;\C{we have $\|k=\|n$}\6
+\1\&{repeat} \37$\\{decr}(\|k)$;\6
+\&{if} $\|k=0$ \1\&{then}\5
+$\|k\K\|n$;\2\6
+$\\{aa}\K\\{vv}[\|k]-\\{take\_fraction}(\\{aa},\39\\{uu}[\|k])$;\5
+$\\{bb}\K\\{ww}[\|k]-\\{take\_fraction}(\\{bb},\39\\{uu}[\|k])$;\6
+\4\&{until}\5
+$\|k=\|n$;\C{now $\theta_n=\\{aa}+\\{bb}\cdot\theta_n$}\2\6
+$\\{aa}\K\\{make\_fraction}(\\{aa},\39\\{fraction\_one}-\\{bb})$;\5
+$\\{theta}[\|n]\K\\{aa}$;\5
+$\\{vv}[0]\K\\{aa}$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}\|n-1$ \1\&{do}\5
+$\\{vv}[\|k]\K\\{vv}[\|k]+\\{take\_fraction}(\\{aa},\39\\{ww}[\|k])$;\2\6
+\&{goto} \37\\{found};\6
+\&{end}\par
+\U287.\fi
+
+\M292. \P\D \37$\\{reduce\_angle}(\#)\S$\1\6
+\&{if} $\\{abs}(\#)>\\{one\_eighty\_deg}$ \1\&{then}\6
+\&{if} $\#>0$ \1\&{then}\5
+$\#\K\#-\\{three\_sixty\_deg}$\ \&{else} $\#\K\#+\\{three\_sixty\_deg}$\2\2\2%
+\par
+\Y\P$\4\X292:Calculate the given value of $\theta_n$ and \&{goto} \\{found}\X%
+\S$\6
+\&{begin} \37$\\{theta}[\|n]\K\\{left\_given}(\|s)-\\{n\_arg}(\\{delta\_x}[%
+\|n-1],\39\\{delta\_y}[\|n-1])$;\5
+$\\{reduce\_angle}(\\{theta}[\|n])$;\5
+\&{goto} \37\\{found};\6
+\&{end}\par
+\U284.\fi
+
+\M293. \P$\X293:Set up the equation for a given value of $\theta_0$\X\S$\6
+\&{begin} \37$\\{vv}[0]\K\\{right\_given}(\|s)-\\{n\_arg}(\\{delta\_x}[0],\39%
+\\{delta\_y}[0])$;\5
+$\\{reduce\_angle}(\\{vv}[0])$;\5
+$\\{uu}[0]\K0$;\5
+$\\{ww}[0]\K0$;\6
+\&{end}\par
+\U285.\fi
+
+\M294. \P$\X294:Set up the equation for a curl at $\theta_0$\X\S$\6
+\&{begin} \37$\\{cc}\K\\{right\_curl}(\|s)$;\5
+$\\{lt}\K\\{abs}(\\{left\_tension}(\|t))$;\5
+$\\{rt}\K\\{abs}(\\{right\_tension}(\|s))$;\6
+\&{if} $(\\{rt}=\\{unity})\W(\\{lt}=\\{unity})$ \1\&{then}\5
+$\\{uu}[0]\K\\{make\_fraction}(\\{cc}+\\{cc}+\\{unity},\39\\{cc}+\\{two})$\6
+\4\&{else} $\\{uu}[0]\K\\{curl\_ratio}(\\{cc},\39\\{rt},\39\\{lt})$;\2\6
+$\\{vv}[0]\K-\\{take\_fraction}(\\{psi}[1],\39\\{uu}[0])$;\5
+$\\{ww}[0]\K0$;\6
+\&{end}\par
+\U285.\fi
+
+\M295. \P$\X295:Set up equation for a curl at $\theta_n$ and \&{goto} \\{found}%
+\X\S$\6
+\&{begin} \37$\\{cc}\K\\{left\_curl}(\|s)$;\5
+$\\{lt}\K\\{abs}(\\{left\_tension}(\|s))$;\5
+$\\{rt}\K\\{abs}(\\{right\_tension}(\|r))$;\6
+\&{if} $(\\{rt}=\\{unity})\W(\\{lt}=\\{unity})$ \1\&{then}\5
+$\\{ff}\K\\{make\_fraction}(\\{cc}+\\{cc}+\\{unity},\39\\{cc}+\\{two})$\6
+\4\&{else} $\\{ff}\K\\{curl\_ratio}(\\{cc},\39\\{lt},\39\\{rt})$;\2\6
+$\\{theta}[\|n]\K-\\{make\_fraction}(\\{take\_fraction}(\\{vv}[\|n-1],\39%
+\\{ff}),\39\\{fraction\_one}-\\{take\_fraction}(\\{ff},\39\\{uu}[\|n-1]))$;\5
+\&{goto} \37\\{found};\6
+\&{end}\par
+\U284.\fi
+
+\M296. The \\{curl\_ratio} subroutine has three arguments, which our previous
+notation
+encourages us to call $\gamma$, $\alpha^{-1}$, and $\beta^{-1}$. It is
+a somewhat tedious program to calculate
+$${(3-\alpha)\alpha^2\gamma+\beta^3\over
+\alpha^3\gamma+(3-\beta)\beta^2},$$
+with the result reduced to 4 if it exceeds 4. (This reduction of curl
+is necessary only if the curl and tension are both large.)
+The values of $\alpha$ and $\beta$ will be at most~4/3.
+
+\Y\P$\4\X296:Declare subroutines needed by \\{solve\_choices}\X\S$\6
+\4\&{function}\1\ \37$\\{curl\_ratio}(\\{gamma},\39\\{a\_tension},\39\\{b%
+\_tension}:\\{scaled})$: \37\\{fraction};\6
+\4\&{var} \37$\\{alpha},\39\\{beta},\39\\{num},\39\\{denom},\39\\{ff}$: \37%
+\\{fraction};\C{registers}\2\6
+\&{begin} \37$\\{alpha}\K\\{make\_fraction}(\\{unity},\39\\{a\_tension})$;\5
+$\\{beta}\K\\{make\_fraction}(\\{unity},\39\\{b\_tension})$;\6
+\&{if} $\\{alpha}\L\\{beta}$ \1\&{then}\6
+\&{begin} \37$\\{ff}\K\\{make\_fraction}(\\{alpha},\39\\{beta})$;\5
+$\\{ff}\K\\{take\_fraction}(\\{ff},\39\\{ff})$;\5
+$\\{gamma}\K\\{take\_fraction}(\\{gamma},\39\\{ff})$;\6
+$\\{beta}\K\\{beta}\mathbin{\&{div}}\O{10000}$;\C{convert \\{fraction} to %
+\\{scaled}}\6
+$\\{denom}\K\\{take\_fraction}(\\{gamma},\39\\{alpha})+\\{three}-\\{beta}$;\5
+$\\{num}\K\\{take\_fraction}(\\{gamma},\39\\{fraction\_three}-\\{alpha})+%
+\\{beta}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{ff}\K\\{make\_fraction}(\\{beta},\39\\{alpha})$;\5
+$\\{ff}\K\\{take\_fraction}(\\{ff},\39\\{ff})$;\5
+$\\{beta}\K\\{take\_fraction}(\\{beta},\39\\{ff})\mathbin{\&{div}}\O{10000}$;%
+\C{convert \\{fraction} to \\{scaled}}\6
+$\\{denom}\K\\{take\_fraction}(\\{gamma},\39\\{alpha})+(\\{ff}\mathbin{%
+\&{div}}1365)-\\{beta}$;\C{$1365\approx 2^{12}/3$}\6
+$\\{num}\K\\{take\_fraction}(\\{gamma},\39\\{fraction\_three}-\\{alpha})+%
+\\{beta}$;\6
+\&{end};\2\6
+\&{if} $\\{num}\G\\{denom}+\\{denom}+\\{denom}+\\{denom}$ \1\&{then}\5
+$\\{curl\_ratio}\K\\{fraction\_four}$\6
+\4\&{else} $\\{curl\_ratio}\K\\{make\_fraction}(\\{num},\39\\{denom})$;\2\6
+\&{end};\par
+\A299.
+\U284.\fi
+
+\M297. We're in the home stretch now.
+
+\Y\P$\4\X297:Finish choosing angles and assigning control points\X\S$\6
+\&{for} $\|k\K\|n-1\mathrel{\&{downto}}0$ \1\&{do}\5
+$\\{theta}[\|k]\K\\{vv}[\|k]-\\{take\_fraction}(\\{theta}[\|k+1],\39\\{uu}[%
+\|k])$;\2\6
+$\|s\K\|p$;\5
+$\|k\K0$;\6
+\1\&{repeat} \37$\|t\K\\{link}(\|s)$;\6
+$\\{n\_sin\_cos}(\\{theta}[\|k])$;\5
+$\\{st}\K\\{n\_sin}$;\5
+$\\{ct}\K\\{n\_cos}$;\6
+$\\{n\_sin\_cos}(-\\{psi}[\|k+1]-\\{theta}[\|k+1])$;\5
+$\\{sf}\K\\{n\_sin}$;\5
+$\\{cf}\K\\{n\_cos}$;\6
+$\\{set\_controls}(\|s,\39\|t,\39\|k)$;\6
+$\\{incr}(\|k)$;\5
+$\|s\K\|t$;\6
+\4\&{until}\5
+$\|k=\|n$\2\par
+\U284.\fi
+
+\M298. The \\{set\_controls} routine actually puts the control points into
+a pair of consecutive nodes \|p and~\|q. Global variables are used to
+record the values of $\sin\theta$, $\cos\theta$, $\sin\phi$, and
+$\cos\phi$ needed in this calculation.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{st},\39\\{ct},\39\\{sf},\39\\{cf}$: \37\\{fraction};\C{sines and cosines}%
+\par
+\fi
+
+\M299. \P$\X296:Declare subroutines needed by \\{solve\_choices}\X\mathrel{+}%
+\S$\6
+\4\&{procedure}\1\ \37$\\{set\_controls}(\|p,\39\|q:\\{pointer};\,\35\|k:%
+\\{integer})$;\6
+\4\&{var} \37$\\{rr},\39\\{ss}$: \37\\{fraction};\C{velocities, divided by
+thrice the tension}\6
+$\\{lt},\39\\{rt}$: \37\\{scaled};\C{tensions}\6
+\\{sine}: \37\\{fraction};\C{$\sin(\theta+\phi)$}\2\6
+\&{begin} \37$\\{lt}\K\\{abs}(\\{left\_tension}(\|q))$;\5
+$\\{rt}\K\\{abs}(\\{right\_tension}(\|p))$;\5
+$\\{rr}\K\\{velocity}(\\{st},\39\\{ct},\39\\{sf},\39\\{cf},\39\\{rt})$;\5
+$\\{ss}\K\\{velocity}(\\{sf},\39\\{cf},\39\\{st},\39\\{ct},\39\\{lt})$;\6
+\&{if} $(\\{right\_tension}(\|p)<0)\V(\\{left\_tension}(\|q)<0)$ \1\&{then}\5
+\X300:Decrease the velocities, if necessary, to stay inside the bounding
+triangle\X;\2\6
+$\\{right\_x}(\|p)\K\\{x\_coord}(\|p)+\\{take\_fraction}(\\{take\_fraction}(%
+\\{delta\_x}[\|k],\39\\{ct})-\\{take\_fraction}(\\{delta\_y}[\|k],\39\\{st}),%
+\39\\{rr})$;\5
+$\\{right\_y}(\|p)\K\\{y\_coord}(\|p)+\\{take\_fraction}(\\{take\_fraction}(%
+\\{delta\_y}[\|k],\39\\{ct})+\\{take\_fraction}(\\{delta\_x}[\|k],\39\\{st}),%
+\39\\{rr})$;\5
+$\\{left\_x}(\|q)\K\\{x\_coord}(\|q)-\\{take\_fraction}(\\{take\_fraction}(%
+\\{delta\_x}[\|k],\39\\{cf})+\\{take\_fraction}(\\{delta\_y}[\|k],\39\\{sf}),%
+\39\\{ss})$;\5
+$\\{left\_y}(\|q)\K\\{y\_coord}(\|q)-\\{take\_fraction}(\\{take\_fraction}(%
+\\{delta\_y}[\|k],\39\\{cf})-\\{take\_fraction}(\\{delta\_x}[\|k],\39\\{sf}),%
+\39\\{ss})$;\5
+$\\{right\_type}(\|p)\K\\{explicit}$;\5
+$\\{left\_type}(\|q)\K\\{explicit}$;\6
+\&{end};\par
+\fi
+
+\M300. The boundedness conditions $\\{rr}\L\sin\phi\,/\sin(\theta+\phi)$ and
+$\\{ss}\L\sin\theta\,/\sin(\theta+\phi)$ are to be enforced if $\sin\theta$,
+$\sin\phi$, and $\sin(\theta+\phi)$ all have the same sign. Otherwise
+there is no ``bounding triangle.''
+
+\Y\P$\4\X300:Decrease the velocities, if necessary, to stay inside the bounding
+triangle\X\S$\6
+\&{if} $((\\{st}\G0)\W(\\{sf}\G0))\V((\\{st}\L0)\W(\\{sf}\L0))$ \1\&{then}\6
+\&{begin} \37$\\{sine}\K\\{take\_fraction}(\\{abs}(\\{st}),\39\\{cf})+\\{take%
+\_fraction}(\\{abs}(\\{sf}),\39\\{ct})$;\6
+\&{if} $\\{sine}>0$ \1\&{then}\6
+\&{begin} \37$\\{sine}\K\\{take\_fraction}(\\{sine},\39\\{fraction\_one}+%
+\\{unity})$;\C{safety factor}\6
+\&{if} $\\{right\_tension}(\|p)<0$ \1\&{then}\6
+\&{if} $\\{ab\_vs\_cd}(\\{abs}(\\{sf}),\39\\{fraction\_one},\39\\{rr},\39%
+\\{sine})<0$ \1\&{then}\5
+$\\{rr}\K\\{make\_fraction}(\\{abs}(\\{sf}),\39\\{sine})$;\2\2\6
+\&{if} $\\{left\_tension}(\|q)<0$ \1\&{then}\6
+\&{if} $\\{ab\_vs\_cd}(\\{abs}(\\{st}),\39\\{fraction\_one},\39\\{ss},\39%
+\\{sine})<0$ \1\&{then}\5
+$\\{ss}\K\\{make\_fraction}(\\{abs}(\\{st}),\39\\{sine})$;\2\2\6
+\&{end};\2\6
+\&{end}\2\par
+\U299.\fi
+
+\M301. Only the simple cases remain to be handled.
+
+\Y\P$\4\X301:Reduce to simple case of two givens and \&{return}\X\S$\6
+\&{begin} \37$\\{aa}\K\\{n\_arg}(\\{delta\_x}[0],\39\\{delta\_y}[0])$;\6
+$\\{n\_sin\_cos}(\\{right\_given}(\|p)-\\{aa})$;\5
+$\\{ct}\K\\{n\_cos}$;\5
+$\\{st}\K\\{n\_sin}$;\6
+$\\{n\_sin\_cos}(\\{left\_given}(\|q)-\\{aa})$;\5
+$\\{cf}\K\\{n\_cos}$;\5
+$\\{sf}\K-\\{n\_sin}$;\6
+$\\{set\_controls}(\|p,\39\|q,\390)$;\5
+\&{return};\6
+\&{end}\par
+\U285.\fi
+
+\M302. \P$\X302:Reduce to simple case of straight line and \&{return}\X\S$\6
+\&{begin} \37$\\{right\_type}(\|p)\K\\{explicit}$;\5
+$\\{left\_type}(\|q)\K\\{explicit}$;\5
+$\\{lt}\K\\{abs}(\\{left\_tension}(\|q))$;\5
+$\\{rt}\K\\{abs}(\\{right\_tension}(\|p))$;\6
+\&{if} $\\{rt}=\\{unity}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{delta\_x}[0]\G0$ \1\&{then}\5
+$\\{right\_x}(\|p)\K\\{x\_coord}(\|p)+((\\{delta\_x}[0]+1)\mathbin{\&{div}}3)$\6
+\4\&{else} $\\{right\_x}(\|p)\K\\{x\_coord}(\|p)+((\\{delta\_x}[0]-1)\mathbin{%
+\&{div}}3)$;\2\6
+\&{if} $\\{delta\_y}[0]\G0$ \1\&{then}\5
+$\\{right\_y}(\|p)\K\\{y\_coord}(\|p)+((\\{delta\_y}[0]+1)\mathbin{\&{div}}3)$\6
+\4\&{else} $\\{right\_y}(\|p)\K\\{y\_coord}(\|p)+((\\{delta\_y}[0]-1)\mathbin{%
+\&{div}}3)$;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{ff}\K\\{make\_fraction}(\\{unity},\393\ast\\{rt})$;%
+\C{$\alpha/3$}\6
+$\\{right\_x}(\|p)\K\\{x\_coord}(\|p)+\\{take\_fraction}(\\{delta\_x}[0],\39%
+\\{ff})$;\5
+$\\{right\_y}(\|p)\K\\{y\_coord}(\|p)+\\{take\_fraction}(\\{delta\_y}[0],\39%
+\\{ff})$;\6
+\&{end};\2\6
+\&{if} $\\{lt}=\\{unity}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{delta\_x}[0]\G0$ \1\&{then}\5
+$\\{left\_x}(\|q)\K\\{x\_coord}(\|q)-((\\{delta\_x}[0]+1)\mathbin{\&{div}}3)$\6
+\4\&{else} $\\{left\_x}(\|q)\K\\{x\_coord}(\|q)-((\\{delta\_x}[0]-1)\mathbin{%
+\&{div}}3)$;\2\6
+\&{if} $\\{delta\_y}[0]\G0$ \1\&{then}\5
+$\\{left\_y}(\|q)\K\\{y\_coord}(\|q)-((\\{delta\_y}[0]+1)\mathbin{\&{div}}3)$\6
+\4\&{else} $\\{left\_y}(\|q)\K\\{y\_coord}(\|q)-((\\{delta\_y}[0]-1)\mathbin{%
+\&{div}}3)$;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{ff}\K\\{make\_fraction}(\\{unity},\393\ast\\{lt})$;%
+\C{$\beta/3$}\6
+$\\{left\_x}(\|q)\K\\{x\_coord}(\|q)-\\{take\_fraction}(\\{delta\_x}[0],\39%
+\\{ff})$;\5
+$\\{left\_y}(\|q)\K\\{y\_coord}(\|q)-\\{take\_fraction}(\\{delta\_y}[0],\39%
+\\{ff})$;\6
+\&{end};\2\6
+\&{return};\6
+\&{end}\par
+\U285.\fi
+
+\N303. \[19] Generating discrete moves.
+The purpose of the next part of \MF\ is to compute discrete approximations
+to curves described as parametric polynomial functions $z(t)$.
+We shall start with the low level first, because an efficient ``engine''
+is needed to support the high-level constructions.
+
+Most of the subroutines are based on variations of a single theme,
+namely the idea of {\sl bisection}. Given a Bernshte{\u\i}n polynomial
+$$B(z_0,z_1,\ldots,z_n;t)=\sum_k{n\choose k}t^k(1-t)^{n-k}z_k,$$
+we can conveniently bisect its range as follows:
+
+\smallskip
+\textindent{1)} Let $z_k^{(0)}=z_k$, for $0\L\|k\L\|n$.
+
+\smallskip
+\textindent{2)} Let $z_k^{(j+1)}={1\over2}(z_k^{(j)}+z\k^{(j)})$, for
+$0\L\|k<\|n-\|j$, for $0\L\|j<\|n$.
+
+\smallskip\noindent
+Then
+$$B(z_0,z_1,\ldots,z_n;t)=B(z_0^{(0)},z_0^{(1)},\ldots,z_0^{(n)};2t)
+=B(z_0^{(n)},z_1^{(n-1)},\ldots,z_n^{(0)};2t-1).$$
+This formula gives us the coefficients of polynomials to use over the ranges
+$0\L t\L{1\over2}$ and ${1\over2}\L t\L1$.
+
+In our applications it will usually be possible to work indirectly with
+numbers that allow us to deduce relevant properties of the polynomials
+without actually computing the polynomial values. We will deal with
+coefficients $Z_k=2^l(z_k-z_{k-1})$ for $1\L\|k\L\|n$, instead of
+the actual numbers $z_0$, $z_1$, \dots,~$z_n$, and the value of~\|l will
+increase by~1 at each bisection step. This technique reduces the
+amount of calculation needed for bisection and also increases the
+accuracy of evaluation (since one bit of precision is gained at each
+bisection). Indeed, the bisection process now becomes one level shorter:
+
+\smallskip
+\textindent{$1'$)} Let $Z_k^{(1)}=Z_k$, for $1\L\|k\L\|n$.
+
+\smallskip
+\textindent{$2'$)} Let $Z_k^{(j+1)}={1\over2}(Z_k^{(j)}+Z\k^{(j)})$, for
+$1\L\|k\L\|n-\|j$, for $1\L\|j<\|n$.
+
+\smallskip\noindent
+The relevant coefficients $(Z'_1,\ldots,Z'_n)$ and $(Z''_1,\ldots,Z''_n)$
+for the two subintervals after bisection are respectively
+$(Z_1^{(1)},Z_1^{(2)},\ldots,Z_1^{(n)})$ and
+$(Z_1^{(n)},Z_2^{(n-1)},\ldots,Z_n^{(1)})$.
+And the values of $z_0$ appropriate for the bisected interval are $z'_0=z_0$
+and $z''_0=z_0+(Z_1+Z_2+\cdots+Z_n)/2^{l+1}$.
+
+Step $2'$ involves division by~2, which introduces computational errors
+of at most $1\over2$ at each step; thus after $l$~levels of bisection the
+integers $Z_k$ will differ from their true values by at most $(n-1)l/2$.
+This error rate is quite acceptable, considering that we have $l$~more
+bits of precision in the $Z$'s by comparison with the~$z$'s. Note also
+that the $Z$'s remain bounded; there's no danger of integer overflow, even
+though we have the identity $Z_k=2^l(z_k-z_{k-1})$ for arbitrarily large~$l$.
+
+In fact, we can show not only that the $Z$'s remain bounded, but also that
+they become nearly equal, since they are control points for a polynomial
+of one less degree. If $\vert Z\k-Z_k\vert\L M$ initially, it is possible
+to prove that $\vert Z\k-Z_k\vert\L\lceil M/2^l\rceil$ after $l$~levels
+of bisection, even in the presence of rounding errors. Here's the
+proof [cf.~Lane and Riesenfeld, {\sl IEEE Trans.\ on Pattern Analysis
+and Machine Intelligence\/ \bf PAMI-2} (1980), 35--46]: Assuming that
+$\vert Z\k-Z_k\vert\L M$ before bisection, we want to prove that
+$\vert Z\k-Z_k\vert\L\lceil M/2\rceil$ afterward. First we show that
+$\vert Z\k^{(j)}-Z_k^{(j)}\vert\L M$ for all $j$ and~$k$, by induction
+on~$j$; this follows from the fact that
+$$\bigl\vert\\{half}(a+b)-\\{half}(b+c)\bigr\vert\L
+\max\bigl(\vert a-b\vert,\vert b-c\vert\bigr)$$
+holds for both of the rounding rules $\\{half}(x)=\lfloor x/2\rfloor$
+and $\\{half}(x)={\rm sign}(x)\lfloor\vert x/2\vert\rfloor$.
+(If $\vert a-b\vert$ and $\vert b-c\vert$ are equal, then
+$a+b$ and $b+c$ are both even or both odd. The rounding errors either
+cancel or round the numbers toward each other; hence
+$$\eqalign{\bigl\vert\\{half}(a+b)-\\{half}(b+c)\bigr\vert
+&\L\textstyle\bigl\vert{1\over2}(a+b)-{1\over2}(b+c)\bigr\vert\cr
+&=\textstyle\bigl\vert{1\over2}(a-b)+{1\over2}(b-c)\bigr\vert
+\L\max\bigl(\vert a-b\vert,\vert b-c\vert\bigr),\cr}$$
+as required. A simpler argument applies if $\vert a-b\vert$ and
+$\vert b-c\vert$ are unequal.) Now it is easy to see that
+$\vert Z_1^{(j+1)}-Z_1^{(j)}\vert\L\bigl\lfloor{1\over2}
+\vert Z_2^{(j)}-Z_1^{(j)}\vert+{1\over2}\bigr\rfloor
+\L\bigl\lfloor{1\over2}(M+1)\bigr\rfloor=\lceil M/2\rceil$.
+
+Another interesting fact about bisection is the identity
+$$Z_1'+\cdots+Z_n'+Z_1''+\cdots+Z_n''=2(Z_1+\cdots+Z_n+E),$$
+where $E$ is the sum of the rounding errors in all of the halving
+operations ($\vert E\vert\L n(n-1)/4$).
+
+\fi
+
+\M304. We will later reduce the problem of digitizing a complex cubic
+$z(t)=B(z_0,z_1,z_2,z_3;t)$ to the following simpler problem:
+Given two real cubics
+$x(t)=B(x_0,x_1,x_2,x_3;t)$
+and $y(t)=B(y_0,y_1,y_2,y_3;t)$ that are monotone nondecreasing,
+determine the set of integer points
+$$P=\bigl\{\bigl(\lfloor x(t)\rfloor,\lfloor y(t)\rfloor\bigr)
+\bigm\vert 0\L t\L 1\bigr\}.$$
+Well, the problem isn't actually quite so clean as this; when the path
+goes very near an integer point $(a,b)$, computational errors may
+make us think that $P$ contains $(a-1,b)$ while in reality it should
+contain $(a,b-1)$. Furthermore, if the path goes {\sl exactly\/}
+through the integer points $(a-1,b-1)$ and
+$(a,b)$, we will want $P$ to contain one
+of the two points $(a-1,b)$ or $(a,b-1)$, so that $P$ can be described
+entirely by ``rook moves'' upwards or to the right; no diagonal
+moves from $(a-1,b-1)$ to~$(a,b)$ will be allowed.
+
+Thus, the set $P$ we wish to compute will merely be an approximation
+to the set described in the formula above. It will consist of
+$\lfloor x(1)\rfloor-\lfloor x(0)\rfloor$ rightward moves and
+$\lfloor y(1)\rfloor-\lfloor y(0)\rfloor$ upward moves, intermixed
+in some order. Our job will be to figure out a suitable order.
+
+The following recursive strategy suggests itself, when we recall that
+$x(0)=x_0$, $x(1)=x_3$, $y(0)=y_0$, and $y(1)=y_3$:
+
+\smallskip
+If $\lfloor x_0\rfloor=\lfloor x_3\rfloor$ then take
+$\lfloor y_3\rfloor-\lfloor y_0\rfloor$ steps up.
+
+Otherwise if $\lfloor y_0\rfloor=\lfloor y_3\rfloor$ then take
+$\lfloor x_3\rfloor-\lfloor x_0\rfloor$ steps to the right.
+
+Otherwise bisect the current cubics and repeat the process on both halves.
+
+\yskip\noindent
+This intuitively appealing formulation does not quite solve the problem,
+because it may never terminate. For example, it's not hard to see that
+no steps will {\sl ever\/} be taken if $(x_0,x_1,x_2,x_3)=(y_0,y_1,y_2,y_3)$!
+However, we can surmount this difficulty with a bit of care; so let's
+proceed to flesh out the algorithm as stated, before worrying about
+such details.
+
+The bisect-and-double strategy discussed above suggests that we represent
+$(x_0,x_1,x_2,x_3)$ by $(X_1,X_2,X_3)$, where $X_k=2^l(x_k-x_{k-1})$
+for some~$l$. Initially $l=16$, since the $x$'s are \\{scaled}.
+In order to deal with other aspects of the algorithm we will want to
+maintain also the quantities $m=\lfloor x_3\rfloor-\lfloor x_0\rfloor$
+and $R=2^l(x_0\bmod 1)$. Similarly,
+$(y_0,y_1,y_2,y_3)$ will be represented by $(Y_1,Y_2,Y_3)$,
+$n=\lfloor y_3\rfloor-\lfloor y_0\rfloor$,
+and $S=2^l(y_0\bmod 1)$. The algorithm now takes the following form:
+
+\smallskip
+If $m=0$ then take $n$ steps up.
+
+Otherwise if $n=0$ then take $m$ steps to the right.
+
+Otherwise bisect the current cubics and repeat the process on both halves.
+
+\smallskip\noindent
+The bisection process for $(X_1,X_2,X_3,m,R,l)$ reduces, in essence,
+to the following formulas:
+$$\vbox{\halign{$#\hfil$\cr
+X_2'=\\{half}(X_1+X_2),\quad
+X_2''=\\{half}(X_2+X_3),\quad
+X_3'=\\{half}(X_2'+X_2''),\cr
+X_1'=X_1,\quad
+X_1''=X_3',\quad
+X_3''=X_3,\cr
+R'=2R,\quad
+T=X_1'+X_2'+X_3'+R',\quad
+R''=T\bmod 2^{l+1},\cr
+m'=\lfloor T/2^{l+1}\rfloor,\quad
+m''=m-m'.\cr}}$$
+
+\fi
+
+\M305. When $m=n=1$, the computation can be speeded up because we simply
+need to decide between two alternatives, (up,\thinspace right)
+versus (right,\thinspace up). There appears to be no simple, direct
+way to make the correct decision by looking at the values of
+$(X_1,X_2,X_3,R)$ and
+$(Y_1,Y_2,Y_3,S)$; but we can streamline the bisection process, and
+we can use the fact that only one of the two descendants needs to
+be examined after each bisection. Furthermore, we observed earlier
+that after several levels of bisection the $X$'s and $Y$'s will be nearly
+equal; so we will be justified in assuming that the curve is essentially a
+straight line. (This, incidentally, solves the problem of infinite
+recursion mentioned earlier.)
+
+It is possible to show that
+$$m=\bigl\lfloor(X_1+X_2+X_3+R+E)\,/\,2^l\bigr\rfloor,$$
+where $E$ is an accumulated rounding error that is at most
+$3\cdot(2^{l-16}-1)$ in absolute value. We will make sure that
+the $X$'s are less than $2^{28}$; hence when $l=30$ we must
+have $\|m\L1$. This proves that the special case $m=n=1$ is
+bound to be reached by the time $l=30$. Furthermore $l=30$ is
+a suitable time to make the straight line approximation,
+if the recursion hasn't already died out, because the maximum
+difference between $X$'s will then be $<2^{14}$; this corresponds
+to an error of $<1$ with respect to the original scaling.
+(Stating this another way, each bisection makes the curve two bits
+closer to a straight line, hence 14 bisections are sufficient for
+28-bit accuracy.)
+
+In the case of a straight line, the curve goes first right, then up,
+if and only if $(T-2^l)(2^l-S)>(U-2^l)(2^l-R)$, where
+$T=X_1+X_2+X_3+R$ and $U=Y_1+Y_2+Y_3+S$. For the actual curve
+essentially runs from $(R/2^l,S/2^l)$ to $(T/2^l,U/2^l)$, and
+we are testing whether or not $(1,1)$ is above the straight
+line connecting these two points. (This formula assumes that $(1,1)$
+is not exactly on the line.)
+
+\fi
+
+\M306. We have glossed over the problem of tie-breaking in ambiguous
+cases when the cubic curve passes exactly through integer points.
+\MF\ finesses this problem by assuming that coordinates
+$(x,y)$ actually stand for slightly perturbed values $(x+\xi,y+\eta)$,
+where $\xi$ and~$\eta$ are infinitesimals whose signs will determine
+what to do when $x$ and/or~$y$ are exact integers. The quantities
+$\lfloor x\rfloor$ and~$\lfloor y\rfloor$ in the formulas above
+should actually read $\lfloor x+\xi\rfloor$ and $\lfloor y+\eta\rfloor$.
+
+If $x$ is a \\{scaled} value, we have $\lfloor x+\xi\rfloor=\lfloor x\rfloor$
+if $\xi>0$, and $\lfloor x+\xi\rfloor=\lfloor x-2^{-16}\rfloor$ if
+$\xi<0$. It is convenient to represent $\xi$ by the integer \\{xi\_corr},
+defined to be 0~if $\xi>0$ and 1~if $\xi<0$; then, for example, the
+integer $\lfloor x+\xi\rfloor$ can be computed as
+$\\{floor\_unscaled}(\|x-\\{xi\_corr})$. Similarly, $\eta$ is conveniently
+represented by~\\{eta\_corr}.
+
+In our applications the sign of $\xi-\eta$ will always be the same as
+the sign of $\xi$. Therefore it turns out that the rule for straight
+lines, as stated above, should be modified as follows in the case of
+ties: The line goes first right, then up, if and only if
+$(T-2^l)(2^l-S)+\xi>(U-2^l)(2^l-R)$. And this relation holds iff
+$\\{ab\_vs\_cd}(T-2^l,2^l-S,U-2^l,2^l-R)-\\{xi\_corr}\ge0$.
+
+These conventions for rounding are symmetrical, in the sense that the
+digitized moves obtained from $(x_0,x_1,x_2,x_3,y_0,y_1,y_2,y_3,\xi,\eta)$
+will be exactly complementary to the moves that would be obtained from
+$(-x_3,-x_2,-x_1,-x_0,-y_3,-y_2,-y_1,-y_0,-\xi,-\eta)$, if arithmetic
+is exact. However, truncation errors in the bisection process might
+upset the symmetry. We can restore much of the lost symmetry by adding
+\\{xi\_corr} or \\{eta\_corr} when halving the data.
+
+\fi
+
+\M307. One further possibility needs to be mentioned: The algorithm
+will be applied only to cubic polynomials $B(x_0,x_1,x_2,x_3;t)$ that
+are nondecreasing as $t$~varies from 0 to~1; this condition turns
+out to hold if and only if $x_0\L x_1$, $x_2\L x_3$, and either
+$x_1\L x_2$ or $(x_1-x_2)^2\L(x_1-x_0)(x_3-x_2)$. If bisection were
+carried out with perfect accuracy, these relations would remain
+invariant. But rounding errors can creep in, hence the bisection
+algorithm can produce non-monotonic subproblems from monotonic
+initial conditions. This leads to the potential danger that $m$ or~$n$
+could become negative in the algorithm described above.
+
+For example, if we start with $(x_1-x_0,x_2-x_1,x_3-x_2)=
+(X_1,X_2,X_3)=(7,-16,58)$, the corresponding polynomial is
+monotonic, because $16^2<7\cdot39$. But the bisection algorithm
+produces the left descendant $(7,-5,3)$, which is nonmonotonic;
+its right descendant is~$(0,-1,3)$.
+
+\def\xt{{\tilde x}}
+Fortunately we can prove that such rounding errors will never cause
+the algorithm to make a tragic mistake. At every stage we are working
+with numbers corresponding to a cubic polynomial $B(\xt_0,
+\xt_1,\xt_2,\xt_3)$ that approximates some
+monotonic polynomial $B(x_0,x_1,x_2,x_3)$. The accumulated errors are
+controlled so that $\vert x_k-\xt_k\vert<\epsilon=3\cdot2^{-16}$.
+If bisection is done at some stage of the recursion, we have
+$m=\lfloor\xt_3\rfloor-\lfloor\xt_0\rfloor>0$, and the algorithm
+computes a bisection value $\bar x$ such that $m'=\lfloor\bar x\rfloor-
+\lfloor\xt_0\rfloor$
+and $m''=\lfloor\xt_3\rfloor-\lfloor\bar x\rfloor$. We want to prove
+that neither $m'$ nor $m''$ can be negative. Since $\bar x$ is an
+approximation to a value in the interval $[x_0,x_3]$, we have
+$\bar x>x_0-\epsilon$ and $\bar x<x_3+\epsilon$, hence $\bar x>
+\xt_0-2\epsilon$ and $\bar x<\xt_3+2\epsilon$.
+If $m'$ is negative we must have $\xt_0\bmod 1<2\epsilon$;
+if $m''$ is negative we must have $\xt_3\bmod 1>1-2\epsilon$.
+In either case the condition $\lfloor\xt_3\rfloor-\lfloor\xt_0\rfloor>0$
+implies that $\xt_3-\xt_0>1-2\epsilon$, hence $x_3-x_0>1-4\epsilon$.
+But it can be shown that if $B(x_0,x_1,x_2,x_3;t)$ is a monotonic
+cubic, then $B(x_0,x_1,x_2,x_3;{1\over2})$ is always between
+$.14[x_0,x_3]$ and $.86[x_0,x_3]$; and it is impossible for $\bar x$
+to be within~$\epsilon$ of such a number. Contradiction!
+(The constant .14 is actually $(7-\sqrt{28}\,)/12$; the worst case
+occurs for polynomials like $B(0,28-4\sqrt{28},14-5\sqrt{28},42;t)$.)
+
+\fi
+
+\M308. OK, now that a long theoretical preamble has justified the
+bisection-and-doubling algorithm, we are ready to proceed with
+its actual coding. But we still haven't discussed the
+form of the output.
+
+For reasons to be discussed later, we shall find it convenient to
+record the output as follows: Moving one step up is represented by
+appending a `1' to a list; moving one step right is represented by
+adding unity to the element at the end of the list. Thus, for example,
+the net effect of ``(up, right, right, up, right)'' is to append
+$(3,2)$.
+
+The list is kept in a global array called \\{move}. Before starting the
+algorithm, \MF\ should check that $\\{move\_ptr}+\lfloor y_3\rfloor
+-\lfloor y_0\rfloor\L\\{move\_size}$, so that the list won't exceed
+the bounds of this array.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{move}: \37\&{array} $[0\to\\{move\_size}]$ \1\&{of}\5
+\\{integer};\C{the recorded moves}\2\6
+\4\\{move\_ptr}: \37$0\to\\{move\_size}$;\C{the number of items in the \\{move}
+list}\par
+\fi
+
+\M309. When bisection occurs, we ``push'' the subproblem corresponding
+to the right-hand subinterval onto the \\{bisect\_stack} while
+we continue to work on the left-hand subinterval. Thus, the \\{bisect\_stack}
+will hold $(X_1,X_2,X_3,R,m,Y_1,Y_2,Y_3,S,n,l)$ values for
+subproblems yet to be tackled.
+
+At most 15 subproblems will be on the stack at once (namely, for
+$l=15$,~16, \dots,~29); but the stack is bigger than this, because
+it is used also for more complicated bisection algorithms.
+
+\Y\P\D \37$\\{stack\_x1}\S\\{bisect\_stack}[\\{bisect\_ptr}]$\C{stacked value
+of $X_1$}\par
+\P\D \37$\\{stack\_x2}\S\\{bisect\_stack}[\\{bisect\_ptr}+1]$\C{stacked value
+of $X_2$}\par
+\P\D \37$\\{stack\_x3}\S\\{bisect\_stack}[\\{bisect\_ptr}+2]$\C{stacked value
+of $X_3$}\par
+\P\D \37$\\{stack\_r}\S\\{bisect\_stack}[\\{bisect\_ptr}+3]$\C{stacked value of
+$R$}\par
+\P\D \37$\\{stack\_m}\S\\{bisect\_stack}[\\{bisect\_ptr}+4]$\C{stacked value of
+$m$}\par
+\P\D \37$\\{stack\_y1}\S\\{bisect\_stack}[\\{bisect\_ptr}+5]$\C{stacked value
+of $Y_1$}\par
+\P\D \37$\\{stack\_y2}\S\\{bisect\_stack}[\\{bisect\_ptr}+6]$\C{stacked value
+of $Y_2$}\par
+\P\D \37$\\{stack\_y3}\S\\{bisect\_stack}[\\{bisect\_ptr}+7]$\C{stacked value
+of $Y_3$}\par
+\P\D \37$\\{stack\_s}\S\\{bisect\_stack}[\\{bisect\_ptr}+8]$\C{stacked value of
+$S$}\par
+\P\D \37$\\{stack\_n}\S\\{bisect\_stack}[\\{bisect\_ptr}+9]$\C{stacked value of
+$n$}\par
+\P\D \37$\\{stack\_l}\S\\{bisect\_stack}[\\{bisect\_ptr}+10]$\C{stacked value
+of $l$}\par
+\P\D \37$\\{move\_increment}=11$\C{number of items pushed by \\{make\_moves}}%
+\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{bisect\_stack}: \37\&{array} $[0\to\\{bistack\_size}]$ \1\&{of}\5
+\\{integer};\2\6
+\4\\{bisect\_ptr}: \37$0\to\\{bistack\_size}$;\par
+\fi
+
+\M310. \P$\X14:Check the ``constant'' values for consistency\X\mathrel{+}\S$\6
+\&{if} $15\ast\\{move\_increment}>\\{bistack\_size}$ \1\&{then}\5
+$\\{bad}\K31$;\2\par
+\fi
+
+\M311. The \\{make\_moves} subroutine is given \\{scaled} values
+$(x_0,x_1,x_2,x_3)$
+and $(y_0,y_1,y_2,y_3)$ that represent monotone-nondecreasing polynomials;
+it makes $\lfloor x_3+\xi\rfloor-\lfloor x_0+\xi\rfloor$ rightward moves
+and $\lfloor y_3+\eta\rfloor-\lfloor y_0+\eta\rfloor$ upward moves, as
+explained earlier. (Here $\lfloor x+\xi\rfloor$ actually stands for
+$\lfloor x/2^{16}-\\{xi\_corr}\rfloor$, if $x$ is regarded as an integer
+without scaling.) The unscaled integers $x_k$ and~$y_k$ should be less
+than $2^{28}$ in magnitude.
+
+It is assumed that $\\{move\_ptr} + \lfloor y_3+\eta\rfloor -
+\lfloor y_0+\eta\rfloor < \\{move\_size}$ when this procedure is called,
+so that the capacity of the \\{move} array will not be exceeded.
+
+The variables \|r and \|s in this procedure stand respectively for
+$R-\\{xi\_corr}$ and $S-\\{eta\_corr}$ in the theory discussed above.
+
+\Y\P\4\&{procedure}\1\ \37$\\{make\_moves}(\\{xx0},\39\\{xx1},\39\\{xx2},\39%
+\\{xx3},\39\\{yy0},\39\\{yy1},\39\\{yy2},\39\\{yy3}:\\{scaled};\,\35\\{xi%
+\_corr},\39\\{eta\_corr}:\\{small\_number})$;\6
+\4\&{label} \37$\\{continue},\39\\{done},\39\\{exit}$;\6
+\4\&{var} \37$\\{x1},\39\\{x2},\39\\{x3},\39\|m,\39\|r,\39\\{y1},\39\\{y2},\39%
+\\{y3},\39\|n,\39\|s,\39\|l$: \37\\{integer};\C{bisection variables explained
+above}\6
+$\|q,\39\|t,\39\|u,\39\\{x2a},\39\\{x3a},\39\\{y2a},\39\\{y3a}$: \37%
+\\{integer};\C{additional temporary registers}\2\6
+\&{begin} \37\&{if} $(\\{xx3}<\\{xx0})\V(\\{yy3}<\\{yy0})$ \1\&{then}\5
+$\\{confusion}(\.{"m"})$;\2\6
+$\|l\K16$;\5
+$\\{bisect\_ptr}\K0$;\6
+$\\{x1}\K\\{xx1}-\\{xx0}$;\5
+$\\{x2}\K\\{xx2}-\\{xx1}$;\5
+$\\{x3}\K\\{xx3}-\\{xx2}$;\6
+\&{if} $\\{xx0}\G\\{xi\_corr}$ \1\&{then}\5
+$\|r\K(\\{xx0}-\\{xi\_corr})\mathbin{\&{mod}}\\{unity}$\6
+\4\&{else} $\|r\K\\{unity}-1-((-\\{xx0}+\\{xi\_corr}-1)\mathbin{\&{mod}}%
+\\{unity})$;\2\6
+$\|m\K(\\{xx3}-\\{xx0}+\|r)\mathbin{\&{div}}\\{unity}$;\6
+$\\{y1}\K\\{yy1}-\\{yy0}$;\5
+$\\{y2}\K\\{yy2}-\\{yy1}$;\5
+$\\{y3}\K\\{yy3}-\\{yy2}$;\6
+\&{if} $\\{yy0}\G\\{eta\_corr}$ \1\&{then}\5
+$\|s\K(\\{yy0}-\\{eta\_corr})\mathbin{\&{mod}}\\{unity}$\6
+\4\&{else} $\|s\K\\{unity}-1-((-\\{yy0}+\\{eta\_corr}-1)\mathbin{\&{mod}}%
+\\{unity})$;\2\6
+$\|n\K(\\{yy3}-\\{yy0}+\|s)\mathbin{\&{div}}\\{unity}$;\6
+\&{if} $(\\{xx3}-\\{xx0}\G\\{fraction\_one})\V(\\{yy3}-\\{yy0}\G\\{fraction%
+\_one})$ \1\&{then}\5
+\X313:Divide the variables by two, to avoid overflow problems\X;\2\6
+\~ \1\&{loop}\ \&{begin} \37\\{continue}: \37\X314:Make moves for current
+subinterval; if bisection is necessary, push the second subinterval onto the
+stack, and \&{goto} \\{continue} in order to handle the first subinterval\X;\6
+\&{if} $\\{bisect\_ptr}=0$ \1\&{then}\5
+\&{return};\2\6
+\X312:Remove a subproblem for \\{make\_moves} from the stack\X;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M312. \P$\X312:Remove a subproblem for \\{make\_moves} from the stack\X\S$\6
+$\\{bisect\_ptr}\K\\{bisect\_ptr}-\\{move\_increment}$;\6
+$\\{x1}\K\\{stack\_x1}$;\5
+$\\{x2}\K\\{stack\_x2}$;\5
+$\\{x3}\K\\{stack\_x3}$;\5
+$\|r\K\\{stack\_r}$;\5
+$\|m\K\\{stack\_m}$;\6
+$\\{y1}\K\\{stack\_y1}$;\5
+$\\{y2}\K\\{stack\_y2}$;\5
+$\\{y3}\K\\{stack\_y3}$;\5
+$\|s\K\\{stack\_s}$;\5
+$\|n\K\\{stack\_n}$;\6
+$\|l\K\\{stack\_l}$\par
+\U311.\fi
+
+\M313. Our variables $(\\{x1},\\{x2},\\{x3})$ correspond to $(X_1,X_2,X_3)$ in
+the notation
+of the theory developed above. We need to keep them less than $2^{28}$
+in order to avoid integer overflow in weird circumstances.
+For example, data like $x_0=-2^{28}+2^{16}-1$ and $x_1=x_2=x_3=2^{28}-1$
+would otherwise be problematical. Hence this part of the code is
+needed, if only to thwart malicious users.
+
+\Y\P$\4\X313:Divide the variables by two, to avoid overflow problems\X\S$\6
+\&{begin} \37$\\{x1}\K\\{half}(\\{x1}+\\{xi\_corr})$;\5
+$\\{x2}\K\\{half}(\\{x2}+\\{xi\_corr})$;\5
+$\\{x3}\K\\{half}(\\{x3}+\\{xi\_corr})$;\5
+$\|r\K\\{half}(\|r+\\{xi\_corr})$;\6
+$\\{y1}\K\\{half}(\\{y1}+\\{eta\_corr})$;\5
+$\\{y2}\K\\{half}(\\{y2}+\\{eta\_corr})$;\5
+$\\{y3}\K\\{half}(\\{y3}+\\{eta\_corr})$;\5
+$\|s\K\\{half}(\|s+\\{eta\_corr})$;\6
+$\|l\K15$;\6
+\&{end}\par
+\U311.\fi
+
+\M314. \P$\X314:Make moves for current subinterval; if bisection is necessary,
+push the second subinterval onto the stack, and \&{goto} \\{continue} in order
+to handle the first subinterval\X\S$\6
+\&{if} $\|m=0$ \1\&{then}\5
+\X315:Move upward \|n steps\X\6
+\4\&{else} \&{if} $\|n=0$ \1\&{then}\5
+\X316:Move to the right \|m steps\X\6
+\4\&{else} \&{if} $\|m+\|n=2$ \1\&{then}\5
+\X317:Make one move of each kind\X\6
+\4\&{else} \&{begin} \37$\\{incr}(\|l)$;\5
+$\\{stack\_l}\K\|l$;\6
+$\\{stack\_x3}\K\\{x3}$;\5
+$\\{stack\_x2}\K\\{half}(\\{x2}+\\{x3}+\\{xi\_corr})$;\5
+$\\{x2}\K\\{half}(\\{x1}+\\{x2}+\\{xi\_corr})$;\5
+$\\{x3}\K\\{half}(\\{x2}+\\{stack\_x2}+\\{xi\_corr})$;\5
+$\\{stack\_x1}\K\\{x3}$;\6
+$\|r\K\|r+\|r+\\{xi\_corr}$;\5
+$\|t\K\\{x1}+\\{x2}+\\{x3}+\|r$;\6
+$\|q\K\|t\mathbin{\&{div}}\\{two\_to\_the}[\|l]$;\5
+$\\{stack\_r}\K\|t\mathbin{\&{mod}}\\{two\_to\_the}[\|l]$;\6
+$\\{stack\_m}\K\|m-\|q$;\5
+$\|m\K\|q$;\6
+$\\{stack\_y3}\K\\{y3}$;\5
+$\\{stack\_y2}\K\\{half}(\\{y2}+\\{y3}+\\{eta\_corr})$;\5
+$\\{y2}\K\\{half}(\\{y1}+\\{y2}+\\{eta\_corr})$;\5
+$\\{y3}\K\\{half}(\\{y2}+\\{stack\_y2}+\\{eta\_corr})$;\5
+$\\{stack\_y1}\K\\{y3}$;\6
+$\|s\K\|s+\|s+\\{eta\_corr}$;\5
+$\|u\K\\{y1}+\\{y2}+\\{y3}+\|s$;\6
+$\|q\K\|u\mathbin{\&{div}}\\{two\_to\_the}[\|l]$;\5
+$\\{stack\_s}\K\|u\mathbin{\&{mod}}\\{two\_to\_the}[\|l]$;\6
+$\\{stack\_n}\K\|n-\|q$;\5
+$\|n\K\|q$;\6
+$\\{bisect\_ptr}\K\\{bisect\_ptr}+\\{move\_increment}$;\5
+\&{goto} \37\\{continue};\6
+\&{end}\2\2\2\par
+\U311.\fi
+
+\M315. \P$\X315:Move upward \|n steps\X\S$\6
+\&{while} $\|n>0$ \1\&{do}\6
+\&{begin} \37$\\{incr}(\\{move\_ptr})$;\5
+$\\{move}[\\{move\_ptr}]\K1$;\5
+$\\{decr}(\|n)$;\6
+\&{end}\2\par
+\U314.\fi
+
+\M316. \P$\X316:Move to the right \|m steps\X\S$\6
+$\\{move}[\\{move\_ptr}]\K\\{move}[\\{move\_ptr}]+\|m$\par
+\U314.\fi
+
+\M317. \P$\X317:Make one move of each kind\X\S$\6
+\&{begin} \37$\|r\K\\{two\_to\_the}[\|l]-\|r$;\5
+$\|s\K\\{two\_to\_the}[\|l]-\|s$;\6
+\&{while} $\|l<30$ \1\&{do}\6
+\&{begin} \37$\\{x3a}\K\\{x3}$;\5
+$\\{x2a}\K\\{half}(\\{x2}+\\{x3}+\\{xi\_corr})$;\5
+$\\{x2}\K\\{half}(\\{x1}+\\{x2}+\\{xi\_corr})$;\5
+$\\{x3}\K\\{half}(\\{x2}+\\{x2a}+\\{xi\_corr})$;\5
+$\|t\K\\{x1}+\\{x2}+\\{x3}$;\5
+$\|r\K\|r+\|r-\\{xi\_corr}$;\6
+$\\{y3a}\K\\{y3}$;\5
+$\\{y2a}\K\\{half}(\\{y2}+\\{y3}+\\{eta\_corr})$;\5
+$\\{y2}\K\\{half}(\\{y1}+\\{y2}+\\{eta\_corr})$;\5
+$\\{y3}\K\\{half}(\\{y2}+\\{y2a}+\\{eta\_corr})$;\5
+$\|u\K\\{y1}+\\{y2}+\\{y3}$;\5
+$\|s\K\|s+\|s-\\{eta\_corr}$;\6
+\&{if} $\|t<\|r$ \1\&{then}\6
+\&{if} $\|u<\|s$ \1\&{then}\5
+\X318:Switch to the right subinterval\X\6
+\4\&{else} \&{begin} \37\X320:Move up then right\X;\6
+\&{goto} \37\\{done};\6
+\&{end}\2\6
+\4\&{else} \&{if} $\|u<\|s$ \1\&{then}\6
+\&{begin} \37\X319:Move right then up\X;\6
+\&{goto} \37\\{done};\6
+\&{end};\2\2\6
+$\\{incr}(\|l)$;\6
+\&{end};\2\6
+$\|r\K\|r-\\{xi\_corr}$;\5
+$\|s\K\|s-\\{eta\_corr}$;\6
+\&{if} $\\{ab\_vs\_cd}(\\{x1}+\\{x2}+\\{x3},\39\|s,\39\\{y1}+\\{y2}+\\{y3},\39%
+\|r)-\\{xi\_corr}\G0$ \1\&{then}\5
+\X319:Move right then up\X\6
+\4\&{else} \X320:Move up then right\X;\2\6
+\4\\{done}: \37\&{end}\par
+\U314.\fi
+
+\M318. \P$\X318:Switch to the right subinterval\X\S$\6
+\&{begin} \37$\\{x1}\K\\{x3}$;\5
+$\\{x2}\K\\{x2a}$;\5
+$\\{x3}\K\\{x3a}$;\5
+$\|r\K\|r-\|t$;\5
+$\\{y1}\K\\{y3}$;\5
+$\\{y2}\K\\{y2a}$;\5
+$\\{y3}\K\\{y3a}$;\5
+$\|s\K\|s-\|u$;\6
+\&{end}\par
+\U317.\fi
+
+\M319. \P$\X319:Move right then up\X\S$\6
+\&{begin} \37$\\{incr}(\\{move}[\\{move\_ptr}])$;\5
+$\\{incr}(\\{move\_ptr})$;\5
+$\\{move}[\\{move\_ptr}]\K1$;\6
+\&{end}\par
+\Us317\ET317.\fi
+
+\M320. \P$\X320:Move up then right\X\S$\6
+\&{begin} \37$\\{incr}(\\{move\_ptr})$;\5
+$\\{move}[\\{move\_ptr}]\K2$;\6
+\&{end}\par
+\Us317\ET317.\fi
+
+\M321. After \\{make\_moves} has acted, possibly for several curves that move
+toward
+the same octant, a ``smoothing'' operation might be done on the \\{move} array.
+This removes optical glitches that can arise even when the curve has been
+digitized without rounding errors.
+
+The smoothing process replaces the integers $a_0\ldots a_n$ in
+$\\{move}[\|b\to\|t]$ by ``smoothed'' integers $a_0'\ldots a_n'$ defined as
+follows:
+$$a_k'=a_k+\delta\k-\delta_k;\qquad
+\delta_k=\cases{+1,&if $1<k<n$ and $a_{k-2}\G a_{k-1}\ll a_k\G a\k$;\cr
+-1,&if $1<k<n$ and $a_{k-2}\L a_{k-1}\gg a_k\L a\k$;\cr
+0,&otherwise.\cr}$$
+Here $a\ll b$ means that $a\L b-2$, and $a\gg b$ means that $a\G b+2$.
+
+The smoothing operation is symmetric in the sense that, if $a_0\ldots a_n$
+smoothes to $a_0'\ldots a_n'$, then the reverse sequence $a_n\ldots a_0$
+smoothes to $a_n'\ldots a_0'$; also the complementary sequence
+$(m-a_0)\ldots(m-a_n)$ smoothes to $(m-a_0')\ldots(m-a_n')$.
+We have $a_0'+\cdots+a_n'=a_0+\cdots+a_n$ because $\delta_0=\delta_{n+1}=0$.
+
+\Y\P\4\&{procedure}\1\ \37$\\{smooth\_moves}(\|b,\39\|t:\\{integer})$;\6
+\4\&{var} \37\|k: \37$1\to\\{move\_size}$;\C{index into \\{move}}\6
+$\|a,\39\\{aa},\39\\{aaa}$: \37\\{integer};\C{original values of $\\{move}[%
+\|k],\\{move}[\|k-1],\\{move}[\|k-2]$}\2\6
+\&{begin} \37\&{if} $\|t-\|b\G3$ \1\&{then}\6
+\&{begin} \37$\|k\K\|b+2$;\5
+$\\{aa}\K\\{move}[\|k-1]$;\5
+$\\{aaa}\K\\{move}[\|k-2]$;\6
+\1\&{repeat} \37$\|a\K\\{move}[\|k]$;\6
+\&{if} $\\{abs}(\|a-\\{aa})>1$ \1\&{then}\5
+\X322:Increase and decrease $\\{move}[\|k-1]$ and $\\{move}[\|k]$ by $\delta_k$%
+\X;\2\6
+$\\{incr}(\|k)$;\5
+$\\{aaa}\K\\{aa}$;\5
+$\\{aa}\K\|a$;\6
+\4\&{until}\5
+$\|k=\|t$;\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M322. \P$\X322:Increase and decrease $\\{move}[\|k-1]$ and $\\{move}[\|k]$ by
+$\delta_k$\X\S$\6
+\&{if} $\|a>\\{aa}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{aaa}\G\\{aa}$ \1\&{then}\6
+\&{if} $\|a\G\\{move}[\|k+1]$ \1\&{then}\6
+\&{begin} \37$\\{incr}(\\{move}[\|k-1])$;\5
+$\\{move}[\|k]\K\|a-1$;\6
+\&{end};\2\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{aaa}\L\\{aa}$ \1\&{then}\6
+\&{if} $\|a\L\\{move}[\|k+1]$ \1\&{then}\6
+\&{begin} \37$\\{decr}(\\{move}[\|k-1])$;\5
+$\\{move}[\|k]\K\|a+1$;\6
+\&{end};\2\2\6
+\&{end}\2\par
+\U321.\fi
+
+\N323. \[20] Edge structures.
+Now we come to \MF's internal scheme for representing what the user can
+actually ``see,'' the edges between pixels. Each pixel has an integer
+weight, obtained by summing the weights on all edges to its left. \MF\
+represents only the nonzero edge weights, since most of the edges are
+weightless; in this way, the data storage requirements grow only linearly
+with respect to the number of pixels per point, even though two-dimensional
+data is being represented. (Well, the actual dependence on the underlying
+resolution is order $n\log n$, but the the $\log n$ factor is buried in our
+implicit restriction on the maximum raster size.) The sum of all edge
+weights in each row should be zero.
+
+The data structure for edge weights must be compact and flexible,
+yet it should support efficient updating and display operations. We
+want to be able to have many different edge structures in memory at
+once, and we want the computer to be able to translate them, reflect them,
+and/or merge them together with relative ease.
+
+\MF's solution to this problem requires one single-word node per
+nonzero edge weight, plus one two-word node for each row in a contiguous
+set of rows. There's also a header node that provides global information
+about the entire structure.
+
+\fi
+
+\M324. Let's consider the edge-weight nodes first. The \\{info} field of such
+nodes contains both an $m$~value and a weight~$w$, in the form
+$8m+w+c$, where $c$ is a constant that depends on data found in the header.
+We shall consider $c$ in detail later; for now, it's best just to think
+of it as a way to compensate for the fact that $m$ and~$w$ can be negative,
+together with the fact that an \\{info} field must have a value between
+\\{min\_halfword} and \\{max\_halfword}. The $m$ value is an unscaled
+$x$~coordinate,
+so it satisfies $\vert m\vert<
+4096$; the $w$ value is always in the range $1\L\vert w\vert\L3$. We can
+unpack the data in the \\{info} field by fetching $\\{ho}(\\{info}(\|p))=%
+\\{info}(\|p)-\\{min\_halfword}$ and dividing this nonnegative number by~8;
+the constant~$c$ will be chosen so that the remainder of this division
+is $4+w$. Thus, for example, a remainder of~3 will correspond to
+the edge weight $w=-1$.
+
+Every row of an edge structure contains two lists of such edge-weight
+nodes, called the \\{sorted} and \\{unsorted} lists, linked together by their
+\\{link} fields in the normal way. The difference between them is that we
+always have $\\{info}(\|p)\L\\{info}(\\{link}(\|p))$ in the \\{sorted} list,
+but there's no
+such restriction on the elements of the \\{unsorted} list. The reason for
+this distinction is that it would take unnecessarily long to maintain
+edge-weight lists in sorted order while they're being updated; but when we
+need to process an entire row from left to right in order of the
+$m$~values, it's fairly easy and quick to sort a short list of unsorted
+elements and to merge them into place among their sorted cohorts.
+Furthermore, the fact that the \\{unsorted} list is empty can sometimes be
+used to good advantage, because it allows us to conclude that a particular
+row has not changed since the last time we sorted it.
+
+The final \\{link} of the \\{sorted} list will be \\{sentinel}, which points to
+a special one-word node whose \\{info} field is essentially infinite; this
+facilitates the sorting and merging operations. The final \\{link} of the
+\\{unsorted} list will be either \\{null} or \\{void}, where $\\{void}=%
+\\{null}+1$
+is used to avoid redisplaying data that has not changed:
+A \\{void} value is stored at the head of the
+unsorted list whenever the corresponding row has been displayed.
+
+\Y\P\D \37$\\{zero\_w}=4$\par
+\P\D \37$\\{void}\S\\{null}+1$\par
+\Y\P$\4\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}\S$\6
+$\\{info}(\\{sentinel})\K\\{max\_halfword}$;\C{$\\{link}(\\{sentinel})=%
+\\{null}$}\par
+\fi
+
+\M325. The rows themselves are represented by row-header nodes that
+contain four link fields. Two of these four, \\{sorted} and \\{unsorted},
+point to the first items of the edge-weight lists just mentioned.
+The other two, \\{link} and \\{knil}, point to the headers of the two
+adjacent rows. If \|p points to the header for row number~\|n, then
+$\\{link}(\|p)$ points up to the header for row~$\|n+1$, and $\\{knil}(\|p)$
+points
+down to the header for row~$\|n-1$. This double linking makes it
+convenient to move through consecutive rows either upward or downward;
+as usual, we have $\\{link}(\\{knil}(\|p))=\\{knil}(\\{link}(\|p))=\|p$ for all
+row headers~\|p.
+
+The row associated with a given value of \|n contains weights for
+edges that run between the lattice points $(\|m,\|n)$ and $(\|m,\|n+1)$.
+
+\Y\P\D \37$\\{knil}\S\\{info}$\C{inverse of the \\{link} field, in a doubly
+linked list}\par
+\P\D \37$\\{sorted\_loc}(\#)\S\#+1$\C{where the \\{sorted} link field resides}%
+\par
+\P\D \37$\\{sorted}(\#)\S\\{link}(\\{sorted\_loc}(\#))$\C{beginning of the list
+of sorted edge weights}\par
+\P\D \37$\\{unsorted}(\#)\S\\{info}(\#+1)$\C{beginning of the list of unsorted
+edge weights}\par
+\P\D \37$\\{row\_node\_size}=2$\C{number of words in a row header node}\par
+\fi
+
+\M326. The main header node \|h for an edge structure has \\{link} and \\{knil}
+fields that link it above the topmost row and below the bottommost row.
+It also has fields called \\{m\_min}, \\{m\_max}, \\{n\_min}, and \\{n\_max}
+that
+bound the current extent of the edge data: All \|m values in edge-weight
+nodes should lie between $\\{m\_min}(\|h)-4096$ and $\\{m\_max}(\|h)-4096$,
+inclusive.
+Furthermore the topmost row header, pointed to by $\\{knil}(\|h)$,
+is for row number $\\{n\_max}(\|h)-4096$; the bottommost row header, pointed to
+by
+$\\{link}(\|h)$, is for row number $\\{n\_min}(\|h)-4096$.
+
+The offset constant \|c that's used in all of the edge-weight data is
+represented implicitly in $\\{m\_offset}(\|h)$; its actual value is
+$$\hbox{$\|c=\\{min\_halfword}+\\{zero\_w}+8\ast\\{m\_offset}(\|h)$.}$$
+Notice that it's possible to shift an entire edge structure by an
+amount $(\Delta m,\Delta n)$ by adding $\Delta n$ to $\\{n\_min}(\|h)$ and $%
+\\{n\_max}(\|h)$,
+adding $\Delta m$ to $\\{m\_min}(\|h)$ and $\\{m\_max}(\|h)$, and subtracting
+$\Delta m$ from $\\{m\_offset}(\|h)$;
+none of the other edge data needs to be modified. Initially the \\{m\_offset}
+field is~4096, but it will change if the user requests such a shift.
+The contents of these five fields should always be positive and less than
+8192; \\{n\_max} should, in fact, be less than 8191. Furthermore
+$\\{m\_min}+\\{m\_offset}-4096$ and $\\{m\_max}+\\{m\_offset}-4096$ must also
+lie strictly
+between 0 and 8192, so that the \\{info} fields of edge-weight nodes will
+fit in a halfword.
+
+The header node of an edge structure also contains two somewhat unusual
+fields that are called $\\{last\_window}(\|h)$ and $\\{last\_window\_time}(%
+\|h)$. When this
+structure is displayed in window~\|k of the user's screen, after that
+window has been updated \|t times, \MF\ sets $\\{last\_window}(\|h)\K\|k$ and
+$\\{last\_window\_time}(\|h)\K\|t$; it also sets $\\{unsorted}(\|p)\K\\{void}$
+for all row
+headers~\|p, after merging any existing unsorted weights with the sorted
+ones. A subsequent display in the same window will be able to avoid
+redisplaying rows whose \\{unsorted} list is still \\{void}, if the window
+hasn't been used for something else in the meantime.
+
+A pointer to the row header of row $\\{n\_pos}(\|h)-4096$ is provided in
+$\\{n\_rover}(\|h)$. Most of the algorithms that update an edge structure
+are able to get by without random row references; they usually
+access rows that are neighbors of each other or of the current \\{n\_pos} row.
+Exception: If $\\{link}(\|h)=\|h$ (so that the edge structure contains
+no rows), we have $\\{n\_rover}(\|h)=\|h$, and $\\{n\_pos}(\|h)$ is irrelevant.
+
+\Y\P\D \37$\\{zero\_field}=4096$\C{amount added to coordinates to make them
+positive}\par
+\P\D \37$\\{n\_min}(\#)\S\\{info}(\#+1)$\C{minimum row number present, plus %
+\\{zero\_field}}\par
+\P\D \37$\\{n\_max}(\#)\S\\{link}(\#+1)$\C{maximum row number present, plus %
+\\{zero\_field}}\par
+\P\D \37$\\{m\_min}(\#)\S\\{info}(\#+2)$\C{minimum column number present, plus %
+\\{zero\_field}}\par
+\P\D \37$\\{m\_max}(\#)\S\\{link}(\#+2)$\C{maximum column number present, plus %
+\\{zero\_field}}\par
+\P\D \37$\\{m\_offset}(\#)\S\\{info}(\#+3)$\C{translation of $m$ data in
+edge-weight nodes}\par
+\P\D \37$\\{last\_window}(\#)\S\\{link}(\#+3)$\C{the last display went into
+this window}\par
+\P\D \37$\\{last\_window\_time}(\#)\S\\{mem}[\#+4].\\{int}$\C{after this many
+window updates}\par
+\P\D \37$\\{n\_pos}(\#)\S\\{info}(\#+5)$\C{the row currently in \\{n\_rover},
+plus \\{zero\_field}}\par
+\P\D \37$\\{n\_rover}(\#)\S\\{link}(\#+5)$\C{a row recently referenced}\par
+\P\D \37$\\{edge\_header\_size}=6$\C{number of words in an edge-structure
+header}\par
+\P\D \37$\\{valid\_range}(\#)\S(\\{abs}(\#-4096)<4096)$\C{is $\#$ strictly
+between 0 and 8192?}\par
+\P\D \37$\\{empty\_edges}(\#)\S\\{link}(\#)=\#$\C{are there no rows in this
+edge header?}\par
+\Y\P\4\&{procedure}\1\ \37$\\{init\_edges}(\|h:\\{pointer})$;\C{initialize an
+edge header to null values}\2\6
+\&{begin} \37$\\{knil}(\|h)\K\|h$;\5
+$\\{link}(\|h)\K\|h$;\6
+$\\{n\_min}(\|h)\K\\{zero\_field}+4095$;\5
+$\\{n\_max}(\|h)\K\\{zero\_field}-4095$;\5
+$\\{m\_min}(\|h)\K\\{zero\_field}+4095$;\5
+$\\{m\_max}(\|h)\K\\{zero\_field}-4095$;\5
+$\\{m\_offset}(\|h)\K\\{zero\_field}$;\6
+$\\{last\_window}(\|h)\K0$;\5
+$\\{last\_window\_time}(\|h)\K0$;\6
+$\\{n\_rover}(\|h)\K\|h$;\5
+$\\{n\_pos}(\|h)\K0$;\6
+\&{end};\par
+\fi
+
+\M327. When a lot of work is being done on a particular edge structure, we
+plant
+a pointer to its main header in the global variable \\{cur\_edges}.
+This saves us from having to pass this pointer as a parameter over and
+over again between subroutines.
+
+Similarly, \\{cur\_wt} is a global weight that is being used by several
+procedures at once.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{cur\_edges}: \37\\{pointer};\C{the edge structure of current interest}\6
+\4\\{cur\_wt}: \37\\{integer};\C{the edge weight of current interest}\par
+\fi
+
+\M328. The \\{fix\_offset} routine goes through all the edge-weight nodes of
+\\{cur\_edges} and adds a constant to their \\{info} fields, so that
+$\\{m\_offset}(\\{cur\_edges})$ can be brought back to \\{zero\_field}. (This
+is necessary only in unusual cases when the offset has gotten too
+large or too small.)
+
+\Y\P\4\&{procedure}\1\ \37\\{fix\_offset};\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{list traversers}\6
+\\{delta}: \37\\{integer};\C{the amount of change}\2\6
+\&{begin} \37$\\{delta}\K8\ast(\\{m\_offset}(\\{cur\_edges})-\\{zero\_field})$;%
+\5
+$\\{m\_offset}(\\{cur\_edges})\K\\{zero\_field}$;\5
+$\|q\K\\{link}(\\{cur\_edges})$;\6
+\&{while} $\|q\I\\{cur\_edges}$ \1\&{do}\6
+\&{begin} \37$\|p\K\\{sorted}(\|q)$;\6
+\&{while} $\|p\I\\{sentinel}$ \1\&{do}\6
+\&{begin} \37$\\{info}(\|p)\K\\{info}(\|p)-\\{delta}$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+$\|p\K\\{unsorted}(\|q)$;\6
+\&{while} $\|p>\\{void}$ \1\&{do}\6
+\&{begin} \37$\\{info}(\|p)\K\\{info}(\|p)-\\{delta}$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M329. The \\{edge\_prep} routine makes the \\{cur\_edges} structure ready to
+accept new data whose coordinates satisfy $\\{ml}\L\|m\L\\{mr}$ and $\\{nl}\L%
+\|n\L\\{nr}-1$,
+assuming that $-4096<\\{ml}\L\\{mr}<4096$ and $-4096<\\{nl}\L\\{nr}<4096$. It
+makes
+appropriate adjustments to \\{m\_min}, \\{m\_max}, \\{n\_min}, and \\{n\_max},
+adding new empty rows if necessary.
+
+\Y\P\4\&{procedure}\1\ \37$\\{edge\_prep}(\\{ml},\39\\{mr},\39\\{nl},\39%
+\\{nr}:\\{integer})$;\6
+\4\&{var} \37\\{delta}: \37\\{halfword};\C{amount of change}\6
+$\|p,\39\|q$: \37\\{pointer};\C{for list manipulation}\2\6
+\&{begin} \37$\\{ml}\K\\{ml}+\\{zero\_field}$;\5
+$\\{mr}\K\\{mr}+\\{zero\_field}$;\5
+$\\{nl}\K\\{nl}+\\{zero\_field}$;\5
+$\\{nr}\K\\{nr}-1+\\{zero\_field}$;\6
+\&{if} $\\{ml}<\\{m\_min}(\\{cur\_edges})$ \1\&{then}\5
+$\\{m\_min}(\\{cur\_edges})\K\\{ml}$;\2\6
+\&{if} $\\{mr}>\\{m\_max}(\\{cur\_edges})$ \1\&{then}\5
+$\\{m\_max}(\\{cur\_edges})\K\\{mr}$;\2\6
+\&{if} $\R\\{valid\_range}(\\{m\_min}(\\{cur\_edges})+\\{m\_offset}(\\{cur%
+\_edges})-\\{zero\_field})\V\30\R\\{valid\_range}(\\{m\_max}(\\{cur\_edges})+%
+\\{m\_offset}(\\{cur\_edges})-\\{zero\_field})$ \1\&{then}\5
+\\{fix\_offset};\2\6
+\&{if} $\\{empty\_edges}(\\{cur\_edges})$ \1\&{then}\C{there are no rows}\6
+\&{begin} \37$\\{n\_min}(\\{cur\_edges})\K\\{nr}+1$;\5
+$\\{n\_max}(\\{cur\_edges})\K\\{nr}$;\6
+\&{end};\2\6
+\&{if} $\\{nl}<\\{n\_min}(\\{cur\_edges})$ \1\&{then}\5
+\X330:Insert exactly $\\{n\_min}(\\{cur\_edges})-\\{nl}$ empty rows at the
+bottom\X;\2\6
+\&{if} $\\{nr}>\\{n\_max}(\\{cur\_edges})$ \1\&{then}\5
+\X331:Insert exactly $\\{nr}-\\{n\_max}(\\{cur\_edges})$ empty rows at the top%
+\X;\2\6
+\&{end};\par
+\fi
+
+\M330. \P$\X330:Insert exactly $\\{n\_min}(\\{cur\_edges})-\\{nl}$ empty rows
+at the bottom\X\S$\6
+\&{begin} \37$\\{delta}\K\\{n\_min}(\\{cur\_edges})-\\{nl}$;\5
+$\\{n\_min}(\\{cur\_edges})\K\\{nl}$;\5
+$\|p\K\\{link}(\\{cur\_edges})$;\6
+\1\&{repeat} \37$\|q\K\\{get\_node}(\\{row\_node\_size})$;\5
+$\\{sorted}(\|q)\K\\{sentinel}$;\5
+$\\{unsorted}(\|q)\K\\{void}$;\5
+$\\{knil}(\|p)\K\|q$;\5
+$\\{link}(\|q)\K\|p$;\5
+$\|p\K\|q$;\5
+$\\{decr}(\\{delta})$;\6
+\4\&{until}\5
+$\\{delta}=0$;\2\6
+$\\{knil}(\|p)\K\\{cur\_edges}$;\5
+$\\{link}(\\{cur\_edges})\K\|p$;\6
+\&{if} $\\{n\_rover}(\\{cur\_edges})=\\{cur\_edges}$ \1\&{then}\5
+$\\{n\_pos}(\\{cur\_edges})\K\\{nl}-1$;\2\6
+\&{end}\par
+\U329.\fi
+
+\M331. \P$\X331:Insert exactly $\\{nr}-\\{n\_max}(\\{cur\_edges})$ empty rows
+at the top\X\S$\6
+\&{begin} \37$\\{delta}\K\\{nr}-\\{n\_max}(\\{cur\_edges})$;\5
+$\\{n\_max}(\\{cur\_edges})\K\\{nr}$;\5
+$\|p\K\\{knil}(\\{cur\_edges})$;\6
+\1\&{repeat} \37$\|q\K\\{get\_node}(\\{row\_node\_size})$;\5
+$\\{sorted}(\|q)\K\\{sentinel}$;\5
+$\\{unsorted}(\|q)\K\\{void}$;\5
+$\\{link}(\|p)\K\|q$;\5
+$\\{knil}(\|q)\K\|p$;\5
+$\|p\K\|q$;\5
+$\\{decr}(\\{delta})$;\6
+\4\&{until}\5
+$\\{delta}=0$;\2\6
+$\\{link}(\|p)\K\\{cur\_edges}$;\5
+$\\{knil}(\\{cur\_edges})\K\|p$;\6
+\&{if} $\\{n\_rover}(\\{cur\_edges})=\\{cur\_edges}$ \1\&{then}\5
+$\\{n\_pos}(\\{cur\_edges})\K\\{nr}+1$;\2\6
+\&{end}\par
+\U329.\fi
+
+\M332. The \\{print\_edges} subroutine gives a symbolic rendition of an edge
+structure, for use in `\&{show}' commands. A rather terse output
+format has been chosen since edge structures can grow quite large.
+
+\Y\P$\4\X257:Declare subroutines for printing expressions\X\mathrel{+}\S$\6
+\hbox{\4}\X333:Declare the procedure called \\{print\_weight}\X\6
+\4\&{procedure}\1\ \37$\\{print\_edges}(\|s:\\{str\_number};\,\35\\{nuline}:%
+\\{boolean};\,\35\\{x\_off},\39\\{y\_off}:\\{integer})$;\6
+\4\&{var} \37$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{for list traversal}\6
+\|n: \37\\{integer};\C{row number}\2\6
+\&{begin} \37$\\{print\_diagnostic}(\.{"Edge\ structure"},\39\|s,\39%
+\\{nuline})$;\5
+$\|p\K\\{knil}(\\{cur\_edges})$;\5
+$\|n\K\\{n\_max}(\\{cur\_edges})-\\{zero\_field}$;\6
+\&{while} $\|p\I\\{cur\_edges}$ \1\&{do}\6
+\&{begin} \37$\|q\K\\{unsorted}(\|p)$;\5
+$\|r\K\\{sorted}(\|p)$;\6
+\&{if} $(\|q>\\{void})\V(\|r\I\\{sentinel})$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"row\ "})$;\5
+$\\{print\_int}(\|n+\\{y\_off})$;\5
+$\\{print\_char}(\.{":"})$;\6
+\&{while} $\|q>\\{void}$ \1\&{do}\6
+\&{begin} \37$\\{print\_weight}(\|q,\39\\{x\_off})$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+$\\{print}(\.{"\ |"})$;\6
+\&{while} $\|r\I\\{sentinel}$ \1\&{do}\6
+\&{begin} \37$\\{print\_weight}(\|r,\39\\{x\_off})$;\5
+$\|r\K\\{link}(\|r)$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\|p\K\\{knil}(\|p)$;\5
+$\\{decr}(\|n)$;\6
+\&{end};\2\6
+$\\{end\_diagnostic}(\\{true})$;\6
+\&{end};\par
+\fi
+
+\M333. \P$\X333:Declare the procedure called \\{print\_weight}\X\S$\6
+\4\&{procedure}\1\ \37$\\{print\_weight}(\|q:\\{pointer};\,\35\\{x\_off}:%
+\\{integer})$;\6
+\4\&{var} \37$\|w,\39\|m$: \37\\{integer};\C{unpacked weight and coordinate}\6
+\|d: \37\\{integer};\C{temporary data register}\2\6
+\&{begin} \37$\|d\K\\{ho}(\\{info}(\|q))$;\5
+$\|w\K\|d\mathbin{\&{mod}}8$;\5
+$\|m\K(\|d\mathbin{\&{div}}8)-\\{m\_offset}(\\{cur\_edges})$;\6
+\&{if} $\\{file\_offset}>\\{max\_print\_line}-9$ \1\&{then}\5
+$\\{print\_nl}(\.{"\ "})$\6
+\4\&{else} $\\{print\_char}(\.{"\ "})$;\2\6
+$\\{print\_int}(\|m+\\{x\_off})$;\6
+\&{while} $\|w>\\{zero\_w}$ \1\&{do}\6
+\&{begin} \37$\\{print\_char}(\.{"+"})$;\5
+$\\{decr}(\|w)$;\6
+\&{end};\2\6
+\&{while} $\|w<\\{zero\_w}$ \1\&{do}\6
+\&{begin} \37$\\{print\_char}(\.{"-"})$;\5
+$\\{incr}(\|w)$;\6
+\&{end};\2\6
+\&{end};\par
+\U332.\fi
+
+\M334. Here's a trivial subroutine that copies an edge structure. (Let's hope
+that the given structure isn't too gigantic.)
+
+\Y\P\4\&{function}\1\ \37$\\{copy\_edges}(\|h:\\{pointer})$: \37\\{pointer};\6
+\4\&{var} \37$\|p,\39\|r$: \37\\{pointer};\C{variables that traverse the given
+structure}\6
+$\\{hh},\39\\{pp},\39\\{qq},\39\\{rr},\39\\{ss}$: \37\\{pointer};\C{variables
+that traverse the new structure}\2\6
+\&{begin} \37$\\{hh}\K\\{get\_node}(\\{edge\_header\_size})$;\5
+$\\{mem}[\\{hh}+1]\K\\{mem}[\|h+1]$;\5
+$\\{mem}[\\{hh}+2]\K\\{mem}[\|h+2]$;\5
+$\\{mem}[\\{hh}+3]\K\\{mem}[\|h+3]$;\5
+$\\{mem}[\\{hh}+4]\K\\{mem}[\|h+4]$;\C{we've now copied \\{n\_min}, \\{n\_max},
+ \\{m\_min}, \\{m\_max}, \\{m\_offset}, \\{last\_window}, and \\{last\_window%
+\_time}}\6
+$\\{n\_pos}(\\{hh})\K\\{n\_max}(\\{hh})+1$;\5
+$\\{n\_rover}(\\{hh})\K\\{hh}$;\6
+$\|p\K\\{link}(\|h)$;\5
+$\\{qq}\K\\{hh}$;\6
+\&{while} $\|p\I\|h$ \1\&{do}\6
+\&{begin} \37$\\{pp}\K\\{get\_node}(\\{row\_node\_size})$;\5
+$\\{link}(\\{qq})\K\\{pp}$;\5
+$\\{knil}(\\{pp})\K\\{qq}$;\5
+\X335:Copy both \\{sorted} and \\{unsorted} lists of \|p to \\{pp}\X;\6
+$\|p\K\\{link}(\|p)$;\5
+$\\{qq}\K\\{pp}$;\6
+\&{end};\2\6
+$\\{link}(\\{qq})\K\\{hh}$;\5
+$\\{knil}(\\{hh})\K\\{qq}$;\5
+$\\{copy\_edges}\K\\{hh}$;\6
+\&{end};\par
+\fi
+
+\M335. \P$\X335:Copy both \\{sorted} and \\{unsorted} lists of \|p to \\{pp}\X%
+\S$\6
+$\|r\K\\{sorted}(\|p)$;\5
+$\\{rr}\K\\{sorted\_loc}(\\{pp})$;\C{$\\{link}(\\{rr})=\\{sorted}(\\{pp})$}\6
+\&{while} $\|r\I\\{sentinel}$ \1\&{do}\6
+\&{begin} \37$\\{ss}\K\\{get\_avail}$;\5
+$\\{link}(\\{rr})\K\\{ss}$;\5
+$\\{rr}\K\\{ss}$;\5
+$\\{info}(\\{rr})\K\\{info}(\|r)$;\6
+$\|r\K\\{link}(\|r)$;\6
+\&{end};\2\6
+$\\{link}(\\{rr})\K\\{sentinel}$;\6
+$\|r\K\\{unsorted}(\|p)$;\5
+$\\{rr}\K\\{temp\_head}$;\6
+\&{while} $\|r>\\{void}$ \1\&{do}\6
+\&{begin} \37$\\{ss}\K\\{get\_avail}$;\5
+$\\{link}(\\{rr})\K\\{ss}$;\5
+$\\{rr}\K\\{ss}$;\5
+$\\{info}(\\{rr})\K\\{info}(\|r)$;\6
+$\|r\K\\{link}(\|r)$;\6
+\&{end};\2\6
+$\\{link}(\\{rr})\K\|r$;\5
+$\\{unsorted}(\\{pp})\K\\{link}(\\{temp\_head})$\par
+\Us334\ET341.\fi
+
+\M336. Another trivial routine flips \\{cur\_edges} about the \|x-axis
+(i.e., negates all the \|y coordinates), assuming that at least
+one row is present.
+
+\Y\P\4\&{procedure}\1\ \37\\{y\_reflect\_edges};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{list manipulation
+registers}\2\6
+\&{begin} \37$\|p\K\\{n\_min}(\\{cur\_edges})$;\5
+$\\{n\_min}(\\{cur\_edges})\K\\{zero\_field}+\\{zero\_field}-1-\\{n\_max}(%
+\\{cur\_edges})$;\5
+$\\{n\_max}(\\{cur\_edges})\K\\{zero\_field}+\\{zero\_field}-1-\|p$;\5
+$\\{n\_pos}(\\{cur\_edges})\K\\{zero\_field}+\\{zero\_field}-1-\\{n\_pos}(%
+\\{cur\_edges})$;\6
+$\|p\K\\{link}(\\{cur\_edges})$;\5
+$\|q\K\\{cur\_edges}$;\C{we assume that $\|p\I\|q$}\6
+\1\&{repeat} \37$\|r\K\\{link}(\|p)$;\5
+$\\{link}(\|p)\K\|q$;\5
+$\\{knil}(\|q)\K\|p$;\5
+$\|q\K\|p$;\5
+$\|p\K\|r$;\6
+\4\&{until}\5
+$\|q=\\{cur\_edges}$;\2\6
+$\\{last\_window\_time}(\\{cur\_edges})\K0$;\6
+\&{end};\par
+\fi
+
+\M337. It's somewhat more difficult, yet not too hard, to reflect about the %
+\|y-axis.
+
+\Y\P\4\&{procedure}\1\ \37\\{x\_reflect\_edges};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\C{list manipulation
+registers}\6
+\|m: \37\\{integer};\C{\\{info} fields will be reflected with respect to this
+number}\2\6
+\&{begin} \37$\|p\K\\{m\_min}(\\{cur\_edges})$;\5
+$\\{m\_min}(\\{cur\_edges})\K\\{zero\_field}+\\{zero\_field}-\\{m\_max}(\\{cur%
+\_edges})$;\5
+$\\{m\_max}(\\{cur\_edges})\K\\{zero\_field}+\\{zero\_field}-\|p$;\5
+$\|m\K(\\{zero\_field}+\\{m\_offset}(\\{cur\_edges}))\ast8+\\{zero\_w}+\\{min%
+\_halfword}+\\{zero\_w}+\\{min\_halfword}$;\5
+$\\{m\_offset}(\\{cur\_edges})\K\\{zero\_field}$;\5
+$\|p\K\\{link}(\\{cur\_edges})$;\6
+\1\&{repeat} \37\X339:Reflect the edge-and-weight data in $\\{sorted}(\|p)$\X;\6
+\X338:Reflect the edge-and-weight data in $\\{unsorted}(\|p)$\X;\6
+$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\|p=\\{cur\_edges}$;\2\6
+$\\{last\_window\_time}(\\{cur\_edges})\K0$;\6
+\&{end};\par
+\fi
+
+\M338. We want to change the sign of the weight as we change the sign of the
+\|x~coordinate. Fortunately, it's easier to do this than to negate
+one without the other.
+
+\Y\P$\4\X338:Reflect the edge-and-weight data in $\\{unsorted}(\|p)$\X\S$\6
+$\|q\K\\{unsorted}(\|p)$;\6
+\&{while} $\|q>\\{void}$ \1\&{do}\6
+\&{begin} \37$\\{info}(\|q)\K\|m-\\{info}(\|q)$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{end}\2\par
+\U337.\fi
+
+\M339. Reversing the order of a linked list is best thought of as the process
+of
+popping nodes off one stack and pushing them on another. In this case we
+pop from stack~\|q and push to stack~\|r.
+
+\Y\P$\4\X339:Reflect the edge-and-weight data in $\\{sorted}(\|p)$\X\S$\6
+$\|q\K\\{sorted}(\|p)$;\5
+$\|r\K\\{sentinel}$;\6
+\&{while} $\|q\I\\{sentinel}$ \1\&{do}\6
+\&{begin} \37$\|s\K\\{link}(\|q)$;\5
+$\\{link}(\|q)\K\|r$;\5
+$\|r\K\|q$;\5
+$\\{info}(\|r)\K\|m-\\{info}(\|q)$;\5
+$\|q\K\|s$;\6
+\&{end};\2\6
+$\\{sorted}(\|p)\K\|r$\par
+\U337.\fi
+
+\M340. Now let's multiply all the $y$~coordinates of a nonempty edge structure
+by a small integer $s>1$:
+
+\Y\P\4\&{procedure}\1\ \37$\\{y\_scale\_edges}(\|s:\\{integer})$;\6
+\4\&{var} \37$\|p,\39\|q,\39\\{pp},\39\|r,\39\\{rr},\39\\{ss}$: \37\\{pointer};%
+\C{list manipulation registers}\6
+\|t: \37\\{integer};\C{replication counter}\2\6
+\&{begin} \37\&{if} $(\|s\ast(\\{n\_max}(\\{cur\_edges})+1-\\{zero\_field})%
+\G4096)\V\30(\|s\ast(\\{n\_min}(\\{cur\_edges})-\\{zero\_field})\L-4096)$ \1%
+\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Scaled\ picture\ would\ be\ too\ big"})$;\5
+$\\{help3}(\.{"I\ can\'t\ yscale\ the\ picture\ as\ requested---it\ would"})$\6
+$(\.{"make\ some\ coordinates\ too\ large\ or\ too\ small."})$\6
+$(\.{"Proceed,\ and\ I\'ll\ omit\ the\ transformation."})$;\5
+\\{put\_get\_error};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{n\_max}(\\{cur\_edges})\K\|s\ast(\\{n\_max}(\\{cur%
+\_edges})+1-\\{zero\_field})-1+\\{zero\_field}$;\5
+$\\{n\_min}(\\{cur\_edges})\K\|s\ast(\\{n\_min}(\\{cur\_edges})-\\{zero%
+\_field})+\\{zero\_field}$;\5
+\X341:Replicate every row exactly $s$ times\X;\6
+$\\{last\_window\_time}(\\{cur\_edges})\K0$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M341. \P$\X341:Replicate every row exactly $s$ times\X\S$\6
+$\|p\K\\{cur\_edges}$;\6
+\1\&{repeat} \37$\|q\K\|p$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{for} $\|t\K2\mathrel{\&{to}}\|s$ \1\&{do}\6
+\&{begin} \37$\\{pp}\K\\{get\_node}(\\{row\_node\_size})$;\5
+$\\{link}(\|q)\K\\{pp}$;\5
+$\\{knil}(\|p)\K\\{pp}$;\5
+$\\{link}(\\{pp})\K\|p$;\5
+$\\{knil}(\\{pp})\K\|q$;\5
+$\|q\K\\{pp}$;\5
+\X335:Copy both \\{sorted} and \\{unsorted} lists of \|p to \\{pp}\X;\6
+\&{end};\2\6
+\4\&{until}\5
+$\\{link}(\|p)=\\{cur\_edges}$\2\par
+\U340.\fi
+
+\M342. Scaling the $x$~coordinates is, of course, our next task.
+
+\Y\P\4\&{procedure}\1\ \37$\\{x\_scale\_edges}(\|s:\\{integer})$;\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{list manipulation registers}\6
+\|t: \37$0\to65535$;\C{unpacked \\{info} field}\6
+\|w: \37$0\to7$;\C{unpacked weight}\6
+\\{delta}: \37\\{integer};\C{amount added to scaled \\{info}}\2\6
+\&{begin} \37\&{if} $(\|s\ast(\\{m\_max}(\\{cur\_edges})-\\{zero\_field})%
+\G4096)\V\30(\|s\ast(\\{m\_min}(\\{cur\_edges})-\\{zero\_field})\L-4096)$ \1%
+\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Scaled\ picture\ would\ be\ too\ big"})$;\5
+$\\{help3}(\.{"I\ can\'t\ xscale\ the\ picture\ as\ requested---it\ would"})$\6
+$(\.{"make\ some\ coordinates\ too\ large\ or\ too\ small."})$\6
+$(\.{"Proceed,\ and\ I\'ll\ omit\ the\ transformation."})$;\5
+\\{put\_get\_error};\6
+\&{end}\6
+\4\&{else} \&{if} $(\\{m\_max}(\\{cur\_edges})\I\\{zero\_field})\V(\\{m\_min}(%
+\\{cur\_edges})\I\\{zero\_field})$ \1\&{then}\6
+\&{begin} \37$\\{m\_max}(\\{cur\_edges})\K\|s\ast(\\{m\_max}(\\{cur\_edges})-%
+\\{zero\_field})+\\{zero\_field}$;\5
+$\\{m\_min}(\\{cur\_edges})\K\|s\ast(\\{m\_min}(\\{cur\_edges})-\\{zero%
+\_field})+\\{zero\_field}$;\5
+$\\{delta}\K8\ast(\\{zero\_field}-\|s\ast\\{m\_offset}(\\{cur\_edges}))+\\{min%
+\_halfword}$;\5
+$\\{m\_offset}(\\{cur\_edges})\K\\{zero\_field}$;\6
+\X343:Scale the $x$~coordinates of each row by $s$\X;\6
+$\\{last\_window\_time}(\\{cur\_edges})\K0$;\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M343. The multiplications cannot overflow because we know that $\|s<4096$.
+
+\Y\P$\4\X343:Scale the $x$~coordinates of each row by $s$\X\S$\6
+$\|q\K\\{link}(\\{cur\_edges})$;\6
+\1\&{repeat} \37$\|p\K\\{sorted}(\|q)$;\6
+\&{while} $\|p\I\\{sentinel}$ \1\&{do}\6
+\&{begin} \37$\|t\K\\{ho}(\\{info}(\|p))$;\5
+$\|w\K\|t\mathbin{\&{mod}}8$;\5
+$\\{info}(\|p)\K(\|t-\|w)\ast\|s+\|w+\\{delta}$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+$\|p\K\\{unsorted}(\|q)$;\6
+\&{while} $\|p>\\{void}$ \1\&{do}\6
+\&{begin} \37$\|t\K\\{ho}(\\{info}(\|p))$;\5
+$\|w\K\|t\mathbin{\&{mod}}8$;\5
+$\\{info}(\|p)\K(\|t-\|w)\ast\|s+\|w+\\{delta}$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+$\|q\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\|q=\\{cur\_edges}$\2\par
+\U342.\fi
+
+\M344. Here is a routine that changes the signs of all the weights, without
+changing anything else.
+
+\Y\P\4\&{procedure}\1\ \37$\\{negate\_edges}(\|h:\\{pointer})$;\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s,\39\|t,\39\|u$: \37\\{pointer};%
+\C{structure traversers}\2\6
+\&{begin} \37$\|p\K\\{link}(\|h)$;\6
+\&{while} $\|p\I\|h$ \1\&{do}\6
+\&{begin} \37$\|q\K\\{unsorted}(\|p)$;\6
+\&{while} $\|q>\\{void}$ \1\&{do}\6
+\&{begin} \37$\\{info}(\|q)\K8-2\ast((\\{ho}(\\{info}(\|q)))\mathbin{%
+\&{mod}}8)+\\{info}(\|q)$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+$\|q\K\\{sorted}(\|p)$;\6
+\&{if} $\|q\I\\{sentinel}$ \1\&{then}\6
+\&{begin} \37\1\&{repeat} \37$\\{info}(\|q)\K8-2\ast((\\{ho}(\\{info}(\|q)))%
+\mathbin{\&{mod}}8)+\\{info}(\|q)$;\5
+$\|q\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\|q=\\{sentinel}$;\2\6
+\X345:Put the list $\\{sorted}(\|p)$ back into sort\X;\6
+\&{end};\2\6
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+$\\{last\_window\_time}(\|h)\K0$;\6
+\&{end};\par
+\fi
+
+\M345. \MF\ would work even if the code in this section were omitted, because
+a list of edge-and-weight data that is sorted only by
+\|m but not~\|w turns out to be good enough for correct operation.
+However, the author decided not to make the program even trickier than
+it is already, since \\{negate\_edges} isn't needed very often.
+The simpler-to-state condition, ``keep the \\{sorted} list fully sorted,''
+is therefore being preserved at the cost of extra computation.
+
+\Y\P$\4\X345:Put the list $\\{sorted}(\|p)$ back into sort\X\S$\6
+$\|u\K\\{sorted\_loc}(\|p)$;\5
+$\|q\K\\{link}(\|u)$;\5
+$\|r\K\|q$;\5
+$\|s\K\\{link}(\|r)$;\C{$\|q=\\{sorted}(\|p)$}\6
+\~ \1\&{loop}\ \&{if} $\\{info}(\|s)>\\{info}(\|r)$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|u)\K\|q$;\6
+\&{if} $\|s=\\{sentinel}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|u\K\|r$;\5
+$\|q\K\|s$;\5
+$\|r\K\|q$;\5
+$\|s\K\\{link}(\|r)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|t\K\|s$;\5
+$\|s\K\\{link}(\|t)$;\5
+$\\{link}(\|t)\K\|q$;\5
+$\|q\K\|t$;\6
+\&{end};\2\2\6
+\4\\{done}: \37$\\{link}(\|r)\K\\{sentinel}$\par
+\U344.\fi
+
+\M346. The \\{unsorted} edges of a row are merged into the \\{sorted} ones by
+a subroutine called \\{sort\_edges}. It uses simple insertion sort,
+followed by a merge, because the unsorted list is supposedly quite short.
+However, the unsorted list is assumed to be nonempty.
+
+\Y\P\4\&{procedure}\1\ \37$\\{sort\_edges}(\|h:\\{pointer})$;\C{\|h is a row
+header}\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|k: \37\\{halfword};\C{key register that we compare to $\\{info}(%
+\|q)$}\6
+$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\2\6
+\&{begin} \37$\|r\K\\{unsorted}(\|h)$;\5
+$\\{unsorted}(\|h)\K\\{null}$;\5
+$\|p\K\\{link}(\|r)$;\5
+$\\{link}(\|r)\K\\{sentinel}$;\5
+$\\{link}(\\{temp\_head})\K\|r$;\6
+\&{while} $\|p>\\{void}$ \1\&{do}\C{sort node \|p into the list that starts at %
+\\{temp\_head}}\6
+\&{begin} \37$\|k\K\\{info}(\|p)$;\5
+$\|q\K\\{temp\_head}$;\6
+\1\&{repeat} \37$\|r\K\|q$;\5
+$\|q\K\\{link}(\|r)$;\6
+\4\&{until}\5
+$\|k\L\\{info}(\|q)$;\2\6
+$\\{link}(\|r)\K\|p$;\5
+$\|r\K\\{link}(\|p)$;\5
+$\\{link}(\|p)\K\|q$;\5
+$\|p\K\|r$;\6
+\&{end};\2\6
+\X347:Merge the \\{temp\_head} list into $\\{sorted}(\|h)$\X;\6
+\&{end};\par
+\fi
+
+\M347. In this step we use the fact that $\\{sorted}(\|h)=\\{link}(\\{sorted%
+\_loc}(\|h))$.
+
+\Y\P$\4\X347:Merge the \\{temp\_head} list into $\\{sorted}(\|h)$\X\S$\6
+\&{begin} \37$\|r\K\\{sorted\_loc}(\|h)$;\5
+$\|q\K\\{link}(\|r)$;\5
+$\|p\K\\{link}(\\{temp\_head})$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|k\K\\{info}(\|p)$;\6
+\&{while} $\|k>\\{info}(\|q)$ \1\&{do}\6
+\&{begin} \37$\|r\K\|q$;\5
+$\|q\K\\{link}(\|r)$;\6
+\&{end};\2\6
+$\\{link}(\|r)\K\|p$;\5
+$\|s\K\\{link}(\|p)$;\5
+$\\{link}(\|p)\K\|q$;\6
+\&{if} $\|s=\\{sentinel}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|r\K\|p$;\5
+$\|p\K\|s$;\6
+\&{end};\2\6
+\4\\{done}: \37\&{end}\par
+\U346.\fi
+
+\M348. The \\{cull\_edges} procedure ``optimizes'' an edge structure by making
+all
+the pixel weights either \\{w\_out} or~\\{w\_in}. The weight will be~\\{w\_in}
+after the
+operation if and only if it was in the closed interval $[\\{w\_lo},\\{w\_hi}]$
+before, where $\\{w\_lo}\L\\{w\_hi}$. Either \\{w\_out} or \\{w\_in} is zero,
+while the other is
+$\pm1$, $\pm2$, or $\pm3$. The parameters will be such that zero-weight
+pixels will remain of weight zero. (This is fortunate,
+because there are infinitely many of them.)
+
+The procedure also computes the tightest possible bounds on the resulting
+data, by updating \\{m\_min}, \\{m\_max}, \\{n\_min}, and~\\{n\_max}.
+
+\Y\P\4\&{procedure}\1\ \37$\\{cull\_edges}(\\{w\_lo},\39\\{w\_hi},\39\\{w%
+\_out},\39\\{w\_in}:\\{integer})$;\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\C{for list
+manipulation}\6
+\|w: \37\\{integer};\C{new weight after culling}\6
+\|d: \37\\{integer};\C{data register for unpacking}\6
+\|m: \37\\{integer};\C{the previous column number, including \\{m\_offset}}\6
+\\{mm}: \37\\{integer};\C{the next column number, including \\{m\_offset}}\6
+\\{ww}: \37\\{integer};\C{accumulated weight before culling}\6
+\\{prev\_w}: \37\\{integer};\C{value of \|w before column \|m}\6
+$\|n,\39\\{min\_n},\39\\{max\_n}$: \37\\{pointer};\C{current and extreme row
+numbers}\6
+$\\{min\_d},\39\\{max\_d}$: \37\\{pointer};\C{extremes of the new
+edge-and-weight data}\2\6
+\&{begin} \37$\\{min\_d}\K\\{max\_halfword}$;\5
+$\\{max\_d}\K\\{min\_halfword}$;\5
+$\\{min\_n}\K\\{max\_halfword}$;\5
+$\\{max\_n}\K\\{min\_halfword}$;\6
+$\|p\K\\{link}(\\{cur\_edges})$;\5
+$\|n\K\\{n\_min}(\\{cur\_edges})$;\6
+\&{while} $\|p\I\\{cur\_edges}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{unsorted}(\|p)>\\{void}$ \1\&{then}\5
+$\\{sort\_edges}(\|p)$;\2\6
+\&{if} $\\{sorted}(\|p)\I\\{sentinel}$ \1\&{then}\5
+\X349:Cull superfluous edge-weight entries from $\\{sorted}(\|p)$\X;\2\6
+$\|p\K\\{link}(\|p)$;\5
+$\\{incr}(\|n)$;\6
+\&{end};\2\6
+\X352:Delete empty rows at the top and/or bottom; update the boundary values in
+the header\X;\6
+$\\{last\_window\_time}(\\{cur\_edges})\K0$;\6
+\&{end};\par
+\fi
+
+\M349. The entire \\{sorted} list is returned to available memory in this step;
+a new list is built starting (temporarily) at \\{temp\_head}.
+Since several edges can occur at the same column, we need to be looking
+ahead of where the actual culling takes place. This means that it's
+slightly tricky to get the iteration started and stopped.
+
+\Y\P$\4\X349:Cull superfluous edge-weight entries from $\\{sorted}(\|p)$\X\S$\6
+\&{begin} \37$\|r\K\\{temp\_head}$;\5
+$\|q\K\\{sorted}(\|p)$;\5
+$\\{ww}\K0$;\5
+$\|m\K1000000$;\5
+$\\{prev\_w}\K0$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\|q=\\{sentinel}$ \1\&{then}\5
+$\\{mm}\K1000000$\6
+\4\&{else} \&{begin} \37$\|d\K\\{ho}(\\{info}(\|q))$;\5
+$\\{mm}\K\|d\mathbin{\&{div}}8$;\5
+$\\{ww}\K\\{ww}+(\|d\mathbin{\&{mod}}8)-\\{zero\_w}$;\6
+\&{end};\2\6
+\&{if} $\\{mm}>\|m$ \1\&{then}\6
+\&{begin} \37\X350:Insert an edge-weight for edge \|m, if the new pixel weight
+has changed\X;\6
+\&{if} $\|q=\\{sentinel}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{end};\2\6
+$\|m\K\\{mm}$;\6
+\&{if} $\\{ww}\G\\{w\_lo}$ \1\&{then}\6
+\&{if} $\\{ww}\L\\{w\_hi}$ \1\&{then}\5
+$\|w\K\\{w\_in}$\6
+\4\&{else} $\|w\K\\{w\_out}$\2\6
+\4\&{else} $\|w\K\\{w\_out}$;\2\6
+$\|s\K\\{link}(\|q)$;\5
+$\\{free\_avail}(\|q)$;\5
+$\|q\K\|s$;\6
+\&{end};\2\6
+\4\\{done}: \37$\\{link}(\|r)\K\\{sentinel}$;\5
+$\\{sorted}(\|p)\K\\{link}(\\{temp\_head})$;\6
+\&{if} $\|r\I\\{temp\_head}$ \1\&{then}\5
+\X351:Update the max/min amounts\X;\2\6
+\&{end}\par
+\U348.\fi
+
+\M350. \P$\X350:Insert an edge-weight for edge \|m, if the new pixel weight has
+changed\X\S$\6
+\&{if} $\|w\I\\{prev\_w}$ \1\&{then}\6
+\&{begin} \37$\|s\K\\{get\_avail}$;\5
+$\\{link}(\|r)\K\|s$;\5
+$\\{info}(\|s)\K8\ast\|m+\\{min\_halfword}+\\{zero\_w}+\|w-\\{prev\_w}$;\5
+$\|r\K\|s$;\5
+$\\{prev\_w}\K\|w$;\6
+\&{end}\2\par
+\U349.\fi
+
+\M351. \P$\X351:Update the max/min amounts\X\S$\6
+\&{begin} \37\&{if} $\\{min\_n}=\\{max\_halfword}$ \1\&{then}\5
+$\\{min\_n}\K\|n$;\2\6
+$\\{max\_n}\K\|n$;\6
+\&{if} $\\{min\_d}>\\{info}(\\{link}(\\{temp\_head}))$ \1\&{then}\5
+$\\{min\_d}\K\\{info}(\\{link}(\\{temp\_head}))$;\2\6
+\&{if} $\\{max\_d}<\\{info}(\|r)$ \1\&{then}\5
+$\\{max\_d}\K\\{info}(\|r)$;\2\6
+\&{end}\par
+\U349.\fi
+
+\M352. \P$\X352:Delete empty rows at the top and/or bottom; update the boundary
+values in the header\X\S$\6
+\&{if} $\\{min\_n}>\\{max\_n}$ \1\&{then}\5
+\X353:Delete all the row headers\X\6
+\4\&{else} \&{begin} \37$\|n\K\\{n\_min}(\\{cur\_edges})$;\5
+$\\{n\_min}(\\{cur\_edges})\K\\{min\_n}$;\6
+\&{while} $\\{min\_n}>\|n$ \1\&{do}\6
+\&{begin} \37$\|p\K\\{link}(\\{cur\_edges})$;\5
+$\\{link}(\\{cur\_edges})\K\\{link}(\|p)$;\5
+$\\{knil}(\\{link}(\|p))\K\\{cur\_edges}$;\5
+$\\{free\_node}(\|p,\39\\{row\_node\_size})$;\5
+$\\{incr}(\|n)$;\6
+\&{end};\2\6
+$\|n\K\\{n\_max}(\\{cur\_edges})$;\5
+$\\{n\_max}(\\{cur\_edges})\K\\{max\_n}$;\5
+$\\{n\_pos}(\\{cur\_edges})\K\\{max\_n}+1$;\5
+$\\{n\_rover}(\\{cur\_edges})\K\\{cur\_edges}$;\6
+\&{while} $\\{max\_n}<\|n$ \1\&{do}\6
+\&{begin} \37$\|p\K\\{knil}(\\{cur\_edges})$;\5
+$\\{knil}(\\{cur\_edges})\K\\{knil}(\|p)$;\5
+$\\{link}(\\{knil}(\|p))\K\\{cur\_edges}$;\5
+$\\{free\_node}(\|p,\39\\{row\_node\_size})$;\5
+$\\{decr}(\|n)$;\6
+\&{end};\2\6
+$\\{m\_min}(\\{cur\_edges})\K((\\{ho}(\\{min\_d}))\mathbin{\&{div}}8)-\\{m%
+\_offset}(\\{cur\_edges})+\\{zero\_field}$;\5
+$\\{m\_max}(\\{cur\_edges})\K((\\{ho}(\\{max\_d}))\mathbin{\&{div}}8)-\\{m%
+\_offset}(\\{cur\_edges})+\\{zero\_field}$;\6
+\&{end}\2\par
+\U348.\fi
+
+\M353. We get here if the edges have been entirely culled away.
+
+\Y\P$\4\X353:Delete all the row headers\X\S$\6
+\&{begin} \37$\|p\K\\{link}(\\{cur\_edges})$;\6
+\&{while} $\|p\I\\{cur\_edges}$ \1\&{do}\6
+\&{begin} \37$\|q\K\\{link}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{row\_node\_size})$;\5
+$\|p\K\|q$;\6
+\&{end};\2\6
+$\\{init\_edges}(\\{cur\_edges})$;\6
+\&{end}\par
+\U352.\fi
+
+\M354. The last and most difficult routine for transforming an edge
+structure---and
+the most interesting one!---is \\{xy\_swap\_edges}, which interchanges the
+r\^^Doles of rows and columns. Its task can be viewed as the job of
+creating an edge structure that contains only horizontal edges, linked
+together in columns, given an edge structure that contains only
+vertical edges linked together in rows; we must do this without changing
+the implied pixel weights.
+
+Given any two adjacent rows of an edge structure, it is not difficult to
+determine the horizontal edges that lie ``between'' them: We simply look
+for vertically adjacent pixels that have different weight, and insert
+a horizontal edge containing the difference in weights. Every horizontal
+edge determined in this way should be put into an appropriate linked
+list. Since random access to these linked lists is desirable, we use
+the \\{move} array to hold the list heads. If we work through the given
+edge structure from top to bottom, the constructed lists will not need
+to be sorted, since they will already be in order.
+
+The following algorithm makes use of some ideas suggested by John Hobby.
+It assumes that the edge structure is non-null, i.e., that $\\{link}(\\{cur%
+\_edges})\I\\{cur\_edges}$, hence $\\{m\_max}(\\{cur\_edges})\G\\{m\_min}(%
+\\{cur\_edges})$.
+
+\Y\P\4\&{procedure}\1\ \37\\{xy\_swap\_edges};\C{interchange \|x and \|y in %
+\\{cur\_edges}}\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37$\\{m\_magic},\39\\{n\_magic}$: \37\\{integer};\C{special values
+that account for offsets}\6
+$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\C{pointers that traverse the given
+structure}\6
+\X357:Other local variables for \\{xy\_swap\_edges}\X\2\6
+\&{begin} \37\X356:Initialize the array of new edge list heads\X;\6
+\X355:Insert blank rows at the top and bottom, and set \|p to the new top row%
+\X;\6
+\X365:Compute the magic offset values\X;\6
+\1\&{repeat} \37$\|q\K\\{knil}(\|p)$;\ \&{if} $\\{unsorted}(\|q)>\\{void}$ \1%
+\&{then}\5
+$\\{sort\_edges}(\|q)$;\2\6
+\X358:Insert the horizontal edges defined by adjacent rows $\|p,\|q$, and
+destroy row~\|p\X;\6
+$\|p\K\|q$;\5
+$\\{n\_magic}\K\\{n\_magic}-8$;\6
+\4\&{until}\5
+$\\{knil}(\|p)=\\{cur\_edges}$;\2\6
+$\\{free\_node}(\|p,\39\\{row\_node\_size})$;\C{now all original rows have been
+recycled}\6
+\X364:Adjust the header to reflect the new edges\X;\6
+\&{end};\par
+\fi
+
+\M355. Here we don't bother to keep the \\{link} entries up to date, since the
+procedure looks only at the \\{knil} fields as it destroys the former
+edge structure.
+
+\Y\P$\4\X355:Insert blank rows at the top and bottom, and set \|p to the new
+top row\X\S$\6
+$\|p\K\\{get\_node}(\\{row\_node\_size})$;\5
+$\\{sorted}(\|p)\K\\{sentinel}$;\5
+$\\{unsorted}(\|p)\K\\{null}$;\6
+$\\{knil}(\|p)\K\\{cur\_edges}$;\5
+$\\{knil}(\\{link}(\\{cur\_edges}))\K\|p$;\C{the new bottom row}\6
+$\|p\K\\{get\_node}(\\{row\_node\_size})$;\5
+$\\{sorted}(\|p)\K\\{sentinel}$;\5
+$\\{knil}(\|p)\K\\{knil}(\\{cur\_edges})$;\C{the new top row}\par
+\U354.\fi
+
+\M356. The new lists will become \\{sorted} lists later, so we initialize
+empty lists to \\{sentinel}.
+
+\Y\P$\4\X356:Initialize the array of new edge list heads\X\S$\6
+$\\{m\_spread}\K\\{m\_max}(\\{cur\_edges})-\\{m\_min}(\\{cur\_edges})$;\C{this
+is $\G0$ by assumption}\6
+\&{if} $\\{m\_spread}>\\{move\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"move\ table\ size"},\39\\{move\_size})$;\2\6
+\&{for} $\|j\K0\mathrel{\&{to}}\\{m\_spread}$ \1\&{do}\5
+$\\{move}[\|j]\K\\{sentinel}$\2\par
+\U354.\fi
+
+\M357. \P$\X357:Other local variables for \\{xy\_swap\_edges}\X\S$\6
+\4\\{m\_spread}: \37\\{integer};\C{the difference between \\{m\_max} and \\{m%
+\_min}}\6
+\4$\|j,\39\\{jj}$: \37$0\to\\{move\_size}$;\C{indices into \\{move}}\6
+\4$\|m,\39\\{mm}$: \37\\{integer};\C{\|m values at vertical edges}\6
+\4$\\{pd},\39\\{rd}$: \37\\{integer};\C{data fields from edge-and-weight nodes}%
+\6
+\4$\\{pm},\39\\{rm}$: \37\\{integer};\C{\|m values from edge-and-weight nodes}\6
+\4\|w: \37\\{integer};\C{the difference in accumulated weight}\6
+\4\\{ww}: \37\\{integer};\C{as much of \|w that can be stored in a single node}%
+\6
+\4\\{dw}: \37\\{integer};\C{an increment to be added to \|w}\par
+\A363.
+\U354.\fi
+
+\M358. At the point where we test $\|w\I0$, variable \|w contains
+the accumulated weight from edges already passed in
+row~\|p minus the accumulated weight from edges already passed in row~\|q.
+
+\Y\P$\4\X358:Insert the horizontal edges defined by adjacent rows $\|p,\|q$,
+and destroy row~\|p\X\S$\6
+$\|r\K\\{sorted}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{row\_node\_size})$;\5
+$\|p\K\|r$;\6
+$\\{pd}\K\\{ho}(\\{info}(\|p))$;\5
+$\\{pm}\K\\{pd}\mathbin{\&{div}}8$;\6
+$\|r\K\\{sorted}(\|q)$;\5
+$\\{rd}\K\\{ho}(\\{info}(\|r))$;\5
+$\\{rm}\K\\{rd}\mathbin{\&{div}}8$;\5
+$\|w\K0$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\\{pm}<\\{rm}$ \1\&{then}\5
+$\\{mm}\K\\{pm}$\ \&{else} $\\{mm}\K\\{rm}$;\2\6
+\&{if} $\|w\I0$ \1\&{then}\5
+\X362:Insert horizontal edges of weight \|w between \|m and~\\{mm}\X;\2\6
+\&{if} $\\{pd}<\\{rd}$ \1\&{then}\6
+\&{begin} \37$\\{dw}\K(\\{pd}\mathbin{\&{mod}}8)-\\{zero\_w}$;\5
+\X360:Advance pointer \|p to the next vertical edge, after destroying the
+previous one\X;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\|r=\\{sentinel}$ \1\&{then}\5
+\&{goto} \37\\{done};\C{$\\{rd}=\\{pd}=\\{ho}(\\{max\_halfword})$}\2\6
+$\\{dw}\K-((\\{rd}\mathbin{\&{mod}}8)-\\{zero\_w})$;\5
+\X359:Advance pointer \|r to the next vertical edge\X;\6
+\&{end};\2\6
+$\|m\K\\{mm}$;\5
+$\|w\K\|w+\\{dw}$;\6
+\&{end};\2\6
+\4\\{done}: \37\par
+\U354.\fi
+
+\M359. \P$\X359:Advance pointer \|r to the next vertical edge\X\S$\6
+$\|r\K\\{link}(\|r)$;\5
+$\\{rd}\K\\{ho}(\\{info}(\|r))$;\5
+$\\{rm}\K\\{rd}\mathbin{\&{div}}8$\par
+\U358.\fi
+
+\M360. \P$\X360:Advance pointer \|p to the next vertical edge, after destroying
+the previous one\X\S$\6
+$\|s\K\\{link}(\|p)$;\5
+$\\{free\_avail}(\|p)$;\5
+$\|p\K\|s$;\5
+$\\{pd}\K\\{ho}(\\{info}(\|p))$;\5
+$\\{pm}\K\\{pd}\mathbin{\&{div}}8$\par
+\U358.\fi
+
+\M361. Certain ``magic'' values are needed to make the following code work,
+because of the various offsets in our data structure. For now, let's not
+worry about their precise values; we shall compute \\{m\_magic} and \\{n%
+\_magic}
+later, after we see what the code looks like.
+
+\fi
+
+\M362. \P$\X362:Insert horizontal edges of weight \|w between \|m and~\\{mm}\X%
+\S$\6
+\&{if} $\|m\I\\{mm}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{mm}-\\{m\_magic}\G\\{move\_size}$ \1\&{then}\5
+$\\{confusion}(\.{"xy"})$;\2\6
+$\\{extras}\K(\\{abs}(\|w)-1)\mathbin{\&{div}}3$;\6
+\&{if} $\\{extras}>0$ \1\&{then}\6
+\&{begin} \37\&{if} $\|w>0$ \1\&{then}\5
+$\\{xw}\K+3$\ \&{else} $\\{xw}\K-3$;\2\6
+$\\{ww}\K\|w-\\{extras}\ast\\{xw}$;\6
+\&{end}\6
+\4\&{else} $\\{ww}\K\|w$;\2\6
+\1\&{repeat} \37$\|j\K\|m-\\{m\_magic}$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}\\{extras}$ \1\&{do}\6
+\&{begin} \37$\|s\K\\{get\_avail}$;\5
+$\\{info}(\|s)\K\\{n\_magic}+\\{xw}$;\5
+$\\{link}(\|s)\K\\{move}[\|j]$;\5
+$\\{move}[\|j]\K\|s$;\6
+\&{end};\2\6
+$\|s\K\\{get\_avail}$;\5
+$\\{info}(\|s)\K\\{n\_magic}+\\{ww}$;\5
+$\\{link}(\|s)\K\\{move}[\|j]$;\5
+$\\{move}[\|j]\K\|s$;\6
+$\\{incr}(\|m)$;\6
+\4\&{until}\5
+$\|m=\\{mm}$;\2\6
+\&{end}\2\par
+\U358.\fi
+
+\M363. \P$\X357:Other local variables for \\{xy\_swap\_edges}\X\mathrel{+}\S$\6
+\4\\{extras}: \37\\{integer};\C{the number of additional nodes to make weights
+$>3$}\6
+\4\\{xw}: \37$-3\to3$;\C{the additional weight in extra nodes}\6
+\4\|k: \37\\{integer};\C{loop counter for inserting extra nodes}\par
+\fi
+
+\M364. At the beginning of this step, $\\{move}[\\{m\_spread}]=\\{sentinel}$,
+because no
+horizontal edges will extend to the right of column $\\{m\_max}(\\{cur%
+\_edges})$.
+
+\Y\P$\4\X364:Adjust the header to reflect the new edges\X\S$\6
+$\\{move}[\\{m\_spread}]\K0$;\5
+$\|j\K0$;\6
+\&{while} $\\{move}[\|j]=\\{sentinel}$ \1\&{do}\5
+$\\{incr}(\|j)$;\2\6
+\&{if} $\|j=\\{m\_spread}$ \1\&{then}\5
+$\\{init\_edges}(\\{cur\_edges})$\C{all edge weights are zero}\6
+\4\&{else} \&{begin} \37$\\{mm}\K\\{m\_min}(\\{cur\_edges})$;\5
+$\\{m\_min}(\\{cur\_edges})\K\\{n\_min}(\\{cur\_edges})$;\5
+$\\{m\_max}(\\{cur\_edges})\K\\{n\_max}(\\{cur\_edges})+1$;\5
+$\\{m\_offset}(\\{cur\_edges})\K\\{zero\_field}$;\5
+$\\{jj}\K\\{m\_spread}-1$;\6
+\&{while} $\\{move}[\\{jj}]=\\{sentinel}$ \1\&{do}\5
+$\\{decr}(\\{jj})$;\2\6
+$\\{n\_min}(\\{cur\_edges})\K\|j+\\{mm}$;\5
+$\\{n\_max}(\\{cur\_edges})\K\\{jj}+\\{mm}$;\5
+$\|q\K\\{cur\_edges}$;\6
+\1\&{repeat} \37$\|p\K\\{get\_node}(\\{row\_node\_size})$;\5
+$\\{link}(\|q)\K\|p$;\5
+$\\{knil}(\|p)\K\|q$;\5
+$\\{sorted}(\|p)\K\\{move}[\|j]$;\5
+$\\{unsorted}(\|p)\K\\{null}$;\5
+$\\{incr}(\|j)$;\5
+$\|q\K\|p$;\6
+\4\&{until}\5
+$\|j>\\{jj}$;\2\6
+$\\{link}(\|q)\K\\{cur\_edges}$;\5
+$\\{knil}(\\{cur\_edges})\K\|q$;\5
+$\\{n\_pos}(\\{cur\_edges})\K\\{n\_max}(\\{cur\_edges})+1$;\5
+$\\{n\_rover}(\\{cur\_edges})\K\\{cur\_edges}$;\5
+$\\{last\_window\_time}(\\{cur\_edges})\K0$;\6
+\&{end};\2\par
+\U354.\fi
+
+\M365. The values of \\{m\_magic} and \\{n\_magic} can be worked out by trying
+the
+code above on a small example; if they work correctly in simple cases,
+they should work in general.
+
+\Y\P$\4\X365:Compute the magic offset values\X\S$\6
+$\\{m\_magic}\K\\{m\_min}(\\{cur\_edges})+\\{m\_offset}(\\{cur\_edges})-\\{zero%
+\_field}$;\5
+$\\{n\_magic}\K8\ast\\{n\_max}(\\{cur\_edges})+8+\\{zero\_w}+\\{min\_halfword}$%
+\par
+\U354.\fi
+
+\M366. Now let's look at the subroutine that merges the edges from a given
+edge structure into \\{cur\_edges}. The given edge structure loses all its
+edges.
+
+\Y\P\4\&{procedure}\1\ \37$\\{merge\_edges}(\|h:\\{pointer})$;\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\\{pp},\39\\{qq},\39\\{rr}$: \37\\{pointer};%
+\C{list manipulation registers}\6
+\|n: \37\\{integer};\C{row number}\6
+\|k: \37\\{halfword};\C{key register that we compare to $\\{info}(\|q)$}\6
+\\{delta}: \37\\{integer};\C{change to the edge/weight data}\2\6
+\&{begin} \37\&{if} $\\{link}(\|h)\I\|h$ \1\&{then}\6
+\&{begin} \37\&{if} $(\\{m\_min}(\|h)<\\{m\_min}(\\{cur\_edges}))\V(\\{m\_max}(%
+\|h)>\\{m\_max}(\\{cur\_edges}))\V\30(\\{n\_min}(\|h)<\\{n\_min}(\\{cur%
+\_edges}))\V(\\{n\_max}(\|h)>\\{n\_max}(\\{cur\_edges}))$ \1\&{then}\5
+$\\{edge\_prep}(\\{m\_min}(\|h)-\\{zero\_field},\39\\{m\_max}(\|h)-\\{zero%
+\_field},\39\\{n\_min}(\|h)-\\{zero\_field},\39\\{n\_max}(\|h)-\\{zero%
+\_field}+1)$;\2\6
+\&{if} $\\{m\_offset}(\|h)\I\\{m\_offset}(\\{cur\_edges})$ \1\&{then}\5
+\X367:Adjust the data of \|h to account for a difference of offsets\X;\2\6
+$\|n\K\\{n\_min}(\\{cur\_edges})$;\5
+$\|p\K\\{link}(\\{cur\_edges})$;\5
+$\\{pp}\K\\{link}(\|h)$;\6
+\&{while} $\|n<\\{n\_min}(\|h)$ \1\&{do}\6
+\&{begin} \37$\\{incr}(\|n)$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\1\&{repeat} \37\X368:Merge row \\{pp} into row \|p\X;\6
+$\\{pp}\K\\{link}(\\{pp})$;\5
+$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\\{pp}=\|h$;\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M367. \P$\X367:Adjust the data of \|h to account for a difference of offsets\X%
+\S$\6
+\&{begin} \37$\\{pp}\K\\{link}(\|h)$;\5
+$\\{delta}\K8\ast(\\{m\_offset}(\\{cur\_edges})-\\{m\_offset}(\|h))$;\6
+\1\&{repeat} \37$\\{qq}\K\\{sorted}(\\{pp})$;\6
+\&{while} $\\{qq}\I\\{sentinel}$ \1\&{do}\6
+\&{begin} \37$\\{info}(\\{qq})\K\\{info}(\\{qq})+\\{delta}$;\5
+$\\{qq}\K\\{link}(\\{qq})$;\6
+\&{end};\2\6
+$\\{qq}\K\\{unsorted}(\\{pp})$;\6
+\&{while} $\\{qq}>\\{void}$ \1\&{do}\6
+\&{begin} \37$\\{info}(\\{qq})\K\\{info}(\\{qq})+\\{delta}$;\5
+$\\{qq}\K\\{link}(\\{qq})$;\6
+\&{end};\2\6
+$\\{pp}\K\\{link}(\\{pp})$;\6
+\4\&{until}\5
+$\\{pp}=\|h$;\2\6
+\&{end}\par
+\U366.\fi
+
+\M368. The \\{sorted} and \\{unsorted} lists are merged separately. After this
+step, row~\\{pp} will have no edges remaining, since they will all have
+been merged into row~\|p.
+
+\Y\P$\4\X368:Merge row \\{pp} into row \|p\X\S$\6
+$\\{qq}\K\\{unsorted}(\\{pp})$;\6
+\&{if} $\\{qq}>\\{void}$ \1\&{then}\6
+\&{if} $\\{unsorted}(\|p)\L\\{void}$ \1\&{then}\5
+$\\{unsorted}(\|p)\K\\{qq}$\6
+\4\&{else} \&{begin} \37\&{while} $\\{link}(\\{qq})>\\{void}$ \1\&{do}\5
+$\\{qq}\K\\{link}(\\{qq})$;\2\6
+$\\{link}(\\{qq})\K\\{unsorted}(\|p)$;\5
+$\\{unsorted}(\|p)\K\\{unsorted}(\\{pp})$;\6
+\&{end};\2\2\6
+$\\{unsorted}(\\{pp})\K\\{null}$;\5
+$\\{qq}\K\\{sorted}(\\{pp})$;\6
+\&{if} $\\{qq}\I\\{sentinel}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{unsorted}(\|p)=\\{void}$ \1\&{then}\5
+$\\{unsorted}(\|p)\K\\{null}$;\2\6
+$\\{sorted}(\\{pp})\K\\{sentinel}$;\5
+$\|r\K\\{sorted\_loc}(\|p)$;\5
+$\|q\K\\{link}(\|r)$;\C{$\|q=\\{sorted}(\|p)$}\6
+\&{if} $\|q=\\{sentinel}$ \1\&{then}\5
+$\\{sorted}(\|p)\K\\{qq}$\6
+\4\&{else} \~ \1\&{loop}\ \&{begin} \37$\|k\K\\{info}(\\{qq})$;\6
+\&{while} $\|k>\\{info}(\|q)$ \1\&{do}\6
+\&{begin} \37$\|r\K\|q$;\5
+$\|q\K\\{link}(\|r)$;\6
+\&{end};\2\6
+$\\{link}(\|r)\K\\{qq}$;\5
+$\\{rr}\K\\{link}(\\{qq})$;\5
+$\\{link}(\\{qq})\K\|q$;\6
+\&{if} $\\{rr}=\\{sentinel}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|r\K\\{qq}$;\5
+$\\{qq}\K\\{rr}$;\6
+\&{end};\2\2\6
+\&{end};\2\6
+\4\\{done}: \37\par
+\U366.\fi
+
+\M369. The \\{total\_weight} routine computes the total of all pixel weights
+in a given edge structure. It's not difficult to prove that this is
+the sum of $(-w)$ times $x$ taken over all edges,
+where $w$ and~$x$ are the weight and $x$~coordinates stored in an edge.
+It's not necessary to worry that this quantity will overflow the
+size of an \\{integer} register, because it will be less than~$2^{31}$
+unless the edge structure has more than 174,762 edges. However, we had
+better not try to compute it as a \\{scaled} integer, because a total
+weight of almost $12\times 2^{12}$ can be produced by only four edges.
+
+\Y\P\4\&{function}\1\ \37$\\{total\_weight}(\|h:\\{pointer})$: \37\\{integer};%
+\C{\|h is an edge header}\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{variables that traverse the given
+structure}\6
+\|n: \37\\{integer};\C{accumulated total so far}\6
+\|m: \37$0\to65535$;\C{packed $x$ and $w$ values, including offsets}\2\6
+\&{begin} \37$\|n\K0$;\5
+$\|p\K\\{link}(\|h)$;\6
+\&{while} $\|p\I\|h$ \1\&{do}\6
+\&{begin} \37$\|q\K\\{sorted}(\|p)$;\6
+\&{while} $\|q\I\\{sentinel}$ \1\&{do}\5
+\X370:Add the contribution of node \|q to the total weight, and set $\|q\K%
+\\{link}(\|q)$\X;\2\6
+$\|q\K\\{unsorted}(\|p)$;\6
+\&{while} $\|q>\\{void}$ \1\&{do}\5
+\X370:Add the contribution of node \|q to the total weight, and set $\|q\K%
+\\{link}(\|q)$\X;\2\6
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+$\\{total\_weight}\K\|n$;\6
+\&{end};\par
+\fi
+
+\M370. It's not necessary to add the offsets to the $x$ coordinates, because
+an entire edge structure can be shifted without affecting its total weight.
+Similarly, we don't need to subtract \\{zero\_field}.
+
+\Y\P$\4\X370:Add the contribution of node \|q to the total weight, and set $\|q%
+\K\\{link}(\|q)$\X\S$\6
+\&{begin} \37$\|m\K\\{ho}(\\{info}(\|q))$;\5
+$\|n\K\|n-((\|m\mathbin{\&{mod}}8)-\\{zero\_w})\ast(\|m\mathbin{\&{div}}8)$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{end}\par
+\Us369\ET369.\fi
+
+\M371. So far we've done lots of things to edge structures assuming that
+edges are actually present, but we haven't seen how edges get created
+in the first place. Let's turn now to the problem of generating new edges.
+
+\MF\ will display new edges as they are being computed, if \\{tracing\_edges}
+is positive. In order to keep such data reasonably compact, only the
+points at which the path makes a $90^\circ$ or $180^\circ$ turn are listed.
+
+The tracing algorithm must remember some past history in order to suppress
+unnecessary data. Three variables \\{trace\_x}, \\{trace\_y}, and \\{trace\_yy}
+provide this history: The last coordinates printed were $(\\{trace\_x},\\{trace%
+\_y})$,
+and the previous edge traced ended at $(\\{trace\_x},\\{trace\_yy})$. Before
+anything
+at all has been traced, $\\{trace\_x}=-4096$.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{trace\_x}: \37\\{integer};\C{$x$~coordinate most recently shown in a
+trace}\6
+\4\\{trace\_y}: \37\\{integer};\C{$y$~coordinate most recently shown in a
+trace}\6
+\4\\{trace\_yy}: \37\\{integer};\C{$y$~coordinate most recently encountered}\par
+\fi
+
+\M372. Edge tracing is initiated by the \\{begin\_edge\_tracing} routine,
+continued by the \\{trace\_a\_corner} routine, and terminated by the
+\\{end\_edge\_tracing} routine.
+
+\Y\P\4\&{procedure}\1\ \37\\{begin\_edge\_tracing};\2\6
+\&{begin} \37$\\{print\_diagnostic}(\.{"Tracing\ edges"},\39\.{""},\39%
+\\{true})$;\5
+$\\{print}(\.{"\ (weight\ "})$;\5
+$\\{print\_int}(\\{cur\_wt})$;\5
+$\\{print\_char}(\.{")"})$;\5
+$\\{trace\_x}\K-4096$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37\\{trace\_a\_corner};\2\6
+\&{begin} \37\&{if} $\\{file\_offset}>\\{max\_print\_line}-13$ \1\&{then}\5
+$\\{print\_nl}(\.{""})$;\2\6
+$\\{print\_char}(\.{"("})$;\5
+$\\{print\_int}(\\{trace\_x})$;\5
+$\\{print\_char}(\.{","})$;\5
+$\\{print\_int}(\\{trace\_yy})$;\5
+$\\{print\_char}(\.{")"})$;\5
+$\\{trace\_y}\K\\{trace\_yy}$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37\\{end\_edge\_tracing};\2\6
+\&{begin} \37\&{if} $\\{trace\_x}=-4096$ \1\&{then}\5
+$\\{print\_nl}(\.{"(No\ new\ edges\ added.)"})$\6
+\4\&{else} \&{begin} \37\\{trace\_a\_corner};\5
+$\\{print\_char}(\.{"."})$;\6
+\&{end};\2\6
+$\\{end\_diagnostic}(\\{true})$;\6
+\&{end};\par
+\fi
+
+\M373. Just after a new edge weight has been put into the \\{info} field of
+node~\|r, in row~\|n, the following routine continues an ongoing trace.
+
+\Y\P\4\&{procedure}\1\ \37$\\{trace\_new\_edge}(\|r:\\{pointer};\,\35\|n:%
+\\{integer})$;\6
+\4\&{var} \37\|d: \37\\{integer};\C{temporary data register}\6
+\|w: \37$-3\to3$;\C{weight associated with an edge transition}\6
+$\|m,\39\\{n0},\39\\{n1}$: \37\\{integer};\C{column and row numbers}\2\6
+\&{begin} \37$\|d\K\\{ho}(\\{info}(\|r))$;\5
+$\|w\K(\|d\mathbin{\&{mod}}8)-\\{zero\_w}$;\5
+$\|m\K(\|d\mathbin{\&{div}}8)-\\{m\_offset}(\\{cur\_edges})$;\6
+\&{if} $\|w=\\{cur\_wt}$ \1\&{then}\6
+\&{begin} \37$\\{n0}\K\|n+1$;\5
+$\\{n1}\K\|n$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{n0}\K\|n$;\5
+$\\{n1}\K\|n+1$;\6
+\&{end};\C{the edges run from $(\|m,\\{n0})$ to $(\|m,\\{n1})$}\2\6
+\&{if} $\|m\I\\{trace\_x}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{trace\_x}=-4096$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{""})$;\5
+$\\{trace\_yy}\K\\{n0}$;\6
+\&{end}\6
+\4\&{else} \&{if} $\\{trace\_yy}\I\\{n0}$ \1\&{then}\5
+$\\{print\_char}(\.{"?"})$\C{shouldn't happen}\6
+\4\&{else} \\{trace\_a\_corner};\2\2\6
+$\\{trace\_x}\K\|m$;\5
+\\{trace\_a\_corner};\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{n0}\I\\{trace\_yy}$ \1\&{then}\5
+$\\{print\_char}(\.{"!"})$;\C{shouldn't happen}\2\6
+\&{if} $((\\{n0}<\\{n1})\W(\\{trace\_y}>\\{trace\_yy}))\V((\\{n0}>\\{n1})\W(%
+\\{trace\_y}<\\{trace\_yy}))$ \1\&{then}\5
+\\{trace\_a\_corner};\2\6
+\&{end};\2\6
+$\\{trace\_yy}\K\\{n1}$;\6
+\&{end};\par
+\fi
+
+\M374. One way to put new edge weights into an edge structure is to use the
+following routine, which simply draws a straight line from $(\\{x0},\\{y0})$ to
+$(\\{x1},\\{y1})$. More precisely, it introduces weights for the edges of the
+discrete path $\bigl(\lfloor t[x_0,x_1]+{1\over2}+\epsilon\rfloor,
+\lfloor t[y_0,y_1]+{1\over2}+\epsilon\delta\rfloor\bigr)$,
+as $t$ varies from 0 to~1, where $\epsilon$ and $\delta$ are extremely small
+positive numbers.
+
+The structure header is assumed to be \\{cur\_edges}; downward edge weights
+will be \\{cur\_wt}, while upward ones will be $-\\{cur\_wt}$.
+
+Of course, this subroutine will be called only in connection with others
+that eventually draw a complete cycle, so that the sum of the edge weights
+in each row will be zero whenever the row is displayed.
+
+\Y\P\4\&{procedure}\1\ \37$\\{line\_edges}(\\{x0},\39\\{y0},\39\\{x1},\39%
+\\{y1}:\\{scaled})$;\6
+\4\&{label} \37$\\{done},\39\\{done1}$;\6
+\4\&{var} \37$\\{m0},\39\\{n0},\39\\{m1},\39\\{n1}$: \37\\{integer};\C{rounded
+and unscaled coordinates}\6
+$\\{delx},\39\\{dely}$: \37\\{scaled};\C{the coordinate differences of the
+line}\6
+\\{yt}: \37\\{scaled};\C{smallest \|y coordinate that rounds the same as %
+\\{y0}}\6
+\\{tx}: \37\\{scaled};\C{tentative change in \|x}\6
+$\|p,\39\|r$: \37\\{pointer};\C{list manipulation registers}\6
+\\{base}: \37\\{integer};\C{amount added to edge-and-weight data}\6
+\|n: \37\\{integer};\C{current row number}\2\6
+\&{begin} \37$\\{n0}\K\\{round\_unscaled}(\\{y0})$;\5
+$\\{n1}\K\\{round\_unscaled}(\\{y1})$;\6
+\&{if} $\\{n0}\I\\{n1}$ \1\&{then}\6
+\&{begin} \37$\\{m0}\K\\{round\_unscaled}(\\{x0})$;\5
+$\\{m1}\K\\{round\_unscaled}(\\{x1})$;\5
+$\\{delx}\K\\{x1}-\\{x0}$;\5
+$\\{dely}\K\\{y1}-\\{y0}$;\5
+$\\{yt}\K\\{n0}\ast\\{unity}-\\{half\_unit}$;\5
+$\\{y0}\K\\{y0}-\\{yt}$;\5
+$\\{y1}\K\\{y1}-\\{yt}$;\6
+\&{if} $\\{n0}<\\{n1}$ \1\&{then}\5
+\X375:Insert upward edges for a line\X\6
+\4\&{else} \X376:Insert downward edges for a line\X;\2\6
+$\\{n\_rover}(\\{cur\_edges})\K\|p$;\5
+$\\{n\_pos}(\\{cur\_edges})\K\|n+\\{zero\_field}$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M375. Here we are careful to cancel any effect of rounding error.
+
+\Y\P$\4\X375:Insert upward edges for a line\X\S$\6
+\&{begin} \37$\\{base}\K8\ast\\{m\_offset}(\\{cur\_edges})+\\{min\_halfword}+%
+\\{zero\_w}-\\{cur\_wt}$;\6
+\&{if} $\\{m0}\L\\{m1}$ \1\&{then}\5
+$\\{edge\_prep}(\\{m0},\39\\{m1},\39\\{n0},\39\\{n1})$\ \&{else} $\\{edge%
+\_prep}(\\{m1},\39\\{m0},\39\\{n0},\39\\{n1})$;\2\6
+\X377:Move to row \\{n0}, pointed to by \|p\X;\6
+$\\{y0}\K\\{unity}-\\{y0}$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|r\K\\{get\_avail}$;\5
+$\\{link}(\|r)\K\\{unsorted}(\|p)$;\5
+$\\{unsorted}(\|p)\K\|r$;\6
+$\\{tx}\K\\{take\_fraction}(\\{delx},\39\\{make\_fraction}(\\{y0},\39%
+\\{dely}))$;\6
+\&{if} $\\{ab\_vs\_cd}(\\{delx},\39\\{y0},\39\\{dely},\39\\{tx})<0$ \1\&{then}\5
+$\\{decr}(\\{tx})$;\C{now $\\{tx}=\lfloor\\{y0}\cdot\\{delx}/\\{dely}\rfloor$}%
+\2\6
+$\\{info}(\|r)\K8\ast\\{round\_unscaled}(\\{x0}+\\{tx})+\\{base}$;\6
+$\\{y1}\K\\{y1}-\\{unity}$;\6
+\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+$\\{trace\_new\_edge}(\|r,\39\|n)$;\2\6
+\&{if} $\\{y1}<\\{unity}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|p\K\\{link}(\|p)$;\5
+$\\{y0}\K\\{y0}+\\{unity}$;\5
+$\\{incr}(\|n)$;\6
+\&{end};\2\6
+\4\\{done}: \37\&{end}\par
+\U374.\fi
+
+\M376. \P$\X376:Insert downward edges for a line\X\S$\6
+\&{begin} \37$\\{base}\K8\ast\\{m\_offset}(\\{cur\_edges})+\\{min\_halfword}+%
+\\{zero\_w}+\\{cur\_wt}$;\6
+\&{if} $\\{m0}\L\\{m1}$ \1\&{then}\5
+$\\{edge\_prep}(\\{m0},\39\\{m1},\39\\{n1},\39\\{n0})$\ \&{else} $\\{edge%
+\_prep}(\\{m1},\39\\{m0},\39\\{n1},\39\\{n0})$;\2\6
+$\\{decr}(\\{n0})$;\5
+\X377:Move to row \\{n0}, pointed to by \|p\X;\6
+\~ \1\&{loop}\ \&{begin} \37$\|r\K\\{get\_avail}$;\5
+$\\{link}(\|r)\K\\{unsorted}(\|p)$;\5
+$\\{unsorted}(\|p)\K\|r$;\6
+$\\{tx}\K\\{take\_fraction}(\\{delx},\39\\{make\_fraction}(\\{y0},\39%
+\\{dely}))$;\6
+\&{if} $\\{ab\_vs\_cd}(\\{delx},\39\\{y0},\39\\{dely},\39\\{tx})<0$ \1\&{then}\5
+$\\{incr}(\\{tx})$;\C{now $\\{tx}=\lceil\\{y0}\cdot\\{delx}/\\{dely}\rceil$,
+since $\\{dely}<0$}\2\6
+$\\{info}(\|r)\K8\ast\\{round\_unscaled}(\\{x0}-\\{tx})+\\{base}$;\6
+$\\{y1}\K\\{y1}+\\{unity}$;\6
+\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+$\\{trace\_new\_edge}(\|r,\39\|n)$;\2\6
+\&{if} $\\{y1}\G0$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+$\|p\K\\{knil}(\|p)$;\5
+$\\{y0}\K\\{y0}+\\{unity}$;\5
+$\\{decr}(\|n)$;\6
+\&{end};\2\6
+\4\\{done1}: \37\&{end}\par
+\U374.\fi
+
+\M377. \P$\X377:Move to row \\{n0}, pointed to by \|p\X\S$\6
+$\|n\K\\{n\_pos}(\\{cur\_edges})-\\{zero\_field}$;\5
+$\|p\K\\{n\_rover}(\\{cur\_edges})$;\6
+\&{if} $\|n\I\\{n0}$ \1\&{then}\6
+\&{if} $\|n<\\{n0}$ \1\&{then}\6
+\1\&{repeat} \37$\\{incr}(\|n)$;\5
+$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\|n=\\{n0}$\2\6
+\4\&{else} \1\&{repeat} \37$\\{decr}(\|n)$;\5
+$\|p\K\\{knil}(\|p)$;\6
+\4\&{until}\5
+$\|n=\\{n0}$\2\2\2\par
+\Us375, 376, 381, 382, 383\ETs384.\fi
+
+\M378. \MF\ inserts most of its edges into edge structures via the
+\\{move\_to\_edges} subroutine, which uses the data stored in the \\{move}
+array
+to specify a sequence of ``rook moves.'' The starting point $(\\{m0},\\{n0})$
+and finishing point $(\\{m1},\\{n1})$ of these moves, as seen from the
+standpoint
+of the first octant, are supplied as parameters; the moves should, however,
+be rotated into a given octant. (We're going to study octant
+transformations in great detail later; the reader may wish to come back to
+this part of the program after mastering the mysteries of octants.)
+
+The rook moves themselves are defined as follows, from a \\{first\_octant}
+point of view: ``Go right $\\{move}[\|k]$ steps, then go up one, for $0\L\|k<%
+\\{n1}-\\{n0}$;
+then go right $\\{move}[\\{n1}-\\{n0}]$ steps and stop.'' The sum of $\\{move}[%
+\|k]$
+for $0\L\|k\L\\{n1}-\\{n0}$ will be equal to $\\{m1}-\\{m0}$.
+
+As in the \\{line\_edges} routine, we use $+\\{cur\_wt}$ as the weight of
+all downward edges and $-\\{cur\_wt}$ as the weight of all upward edges,
+after the moves have been rotated to the proper octant direction.
+
+There are two main cases to consider: \\{fast\_case} is for moves that
+travel in the direction of octants 1, 4, 5, and~8, while \\{slow\_case}
+is for moves that travel toward octants 2, 3, 6, and~7. The latter directions
+are comparatively cumbersome because they generate more upward or downward
+edges; a curve that travels horizontally doesn't produce any edges at all,
+but a curve that travels vertically touches lots of rows.
+
+\Y\P\D \37$\\{fast\_case\_up}=60$\C{for octants 1 and 4}\par
+\P\D \37$\\{fast\_case\_down}=61$\C{for octants 5 and 8}\par
+\P\D \37$\\{slow\_case\_up}=62$\C{for octants 2 and 3}\par
+\P\D \37$\\{slow\_case\_down}=63$\C{for octants 6 and 7}\par
+\Y\P\4\&{procedure}\1\ \37$\\{move\_to\_edges}(\\{m0},\39\\{n0},\39\\{m1},\39%
+\\{n1}:\\{integer})$;\6
+\4\&{label} \37$\\{fast\_case\_up},\39\\{fast\_case\_down},\39\\{slow\_case%
+\_up},\39\\{slow\_case\_down},\39\\{done}$;\6
+\4\&{var} \37\\{delta}: \37$0\to\\{move\_size}$;\C{extent of \\{move} data}\6
+\|k: \37$0\to\\{move\_size}$;\C{index into \\{move}}\6
+$\|p,\39\|r$: \37\\{pointer};\C{list manipulation registers}\6
+\\{dx}: \37\\{integer};\C{change in edge-weight \\{info} when \|x changes by 1}%
+\6
+\\{edge\_and\_weight}: \37\\{integer};\C{\\{info} to insert}\6
+\|j: \37\\{integer};\C{number of consecutive vertical moves}\6
+\|n: \37\\{integer};\C{the current row pointed to by \|p}\2\6
+\&{debug} \37\\{sum}: \37\\{integer};\ \&{gubed}\6
+\&{begin} \37$\\{delta}\K\\{n1}-\\{n0}$;\6
+\&{debug} \37$\\{sum}\K\\{move}[0]$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}\\{delta}$ \1\&{do}\5
+$\\{sum}\K\\{sum}+\\{abs}(\\{move}[\|k])$;\2\6
+\&{if} $\\{sum}\I\\{m1}-\\{m0}$ \1\&{then}\5
+$\\{confusion}(\.{"0"})$;\ \2\6
+\&{gubed}\6
+\X380:Prepare for and switch to the appropriate case, based on \\{octant}\X;\6
+\4\\{fast\_case\_up}: \37\X381:Add edges for first or fourth octants, then %
+\&{goto} \\{done}\X;\6
+\4\\{fast\_case\_down}: \37\X382:Add edges for fifth or eighth octants, then %
+\&{goto} \\{done}\X;\6
+\4\\{slow\_case\_up}: \37\X383:Add edges for second or third octants, then %
+\&{goto} \\{done}\X;\6
+\4\\{slow\_case\_down}: \37\X384:Add edges for sixth or seventh octants, then %
+\&{goto} \\{done}\X;\6
+\4\\{done}: \37$\\{n\_pos}(\\{cur\_edges})\K\|n+\\{zero\_field}$;\5
+$\\{n\_rover}(\\{cur\_edges})\K\|p$;\6
+\&{end};\par
+\fi
+
+\M379. The current octant code appears in a global variable. If, for example,
+we have $\\{octant}=\\{third\_octant}$, it means that a curve traveling in a
+north to
+north-westerly direction has been rotated for the purposes of internal
+calculations so that the \\{move} data travels in an east to north-easterly
+direction. We want to unrotate as we update the edge structure.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{octant}: \37$\\{first\_octant}\to\\{sixth\_octant}$;\C{the current octant
+of interest}\par
+\fi
+
+\M380. \P$\X380:Prepare for and switch to the appropriate case, based on %
+\\{octant}\X\S$\6
+\&{case} $\\{octant}$ \1\&{of}\6
+\4\\{first\_octant}: \37\&{begin} \37$\\{dx}\K8$;\5
+$\\{edge\_prep}(\\{m0},\39\\{m1},\39\\{n0},\39\\{n1})$;\5
+\&{goto} \37\\{fast\_case\_up};\6
+\&{end};\6
+\4\\{second\_octant}: \37\&{begin} \37$\\{dx}\K8$;\5
+$\\{edge\_prep}(\\{n0},\39\\{n1},\39\\{m0},\39\\{m1})$;\5
+\&{goto} \37\\{slow\_case\_up};\6
+\&{end};\6
+\4\\{third\_octant}: \37\&{begin} \37$\\{dx}\K-8$;\5
+$\\{edge\_prep}(-\\{n1},\39-\\{n0},\39\\{m0},\39\\{m1})$;\5
+$\\{negate}(\\{n0})$;\5
+\&{goto} \37\\{slow\_case\_up};\6
+\&{end};\6
+\4\\{fourth\_octant}: \37\&{begin} \37$\\{dx}\K-8$;\5
+$\\{edge\_prep}(-\\{m1},\39-\\{m0},\39\\{n0},\39\\{n1})$;\5
+$\\{negate}(\\{m0})$;\5
+\&{goto} \37\\{fast\_case\_up};\6
+\&{end};\6
+\4\\{fifth\_octant}: \37\&{begin} \37$\\{dx}\K-8$;\5
+$\\{edge\_prep}(-\\{m1},\39-\\{m0},\39-\\{n1},\39-\\{n0})$;\5
+$\\{negate}(\\{m0})$;\5
+\&{goto} \37\\{fast\_case\_down};\6
+\&{end};\6
+\4\\{sixth\_octant}: \37\&{begin} \37$\\{dx}\K-8$;\5
+$\\{edge\_prep}(-\\{n1},\39-\\{n0},\39-\\{m1},\39-\\{m0})$;\5
+$\\{negate}(\\{n0})$;\5
+\&{goto} \37\\{slow\_case\_down};\6
+\&{end};\6
+\4\\{seventh\_octant}: \37\&{begin} \37$\\{dx}\K8$;\5
+$\\{edge\_prep}(\\{n0},\39\\{n1},\39-\\{m1},\39-\\{m0})$;\5
+\&{goto} \37\\{slow\_case\_down};\6
+\&{end};\6
+\4\\{eighth\_octant}: \37\&{begin} \37$\\{dx}\K8$;\5
+$\\{edge\_prep}(\\{m0},\39\\{m1},\39-\\{n1},\39-\\{n0})$;\5
+\&{goto} \37\\{fast\_case\_down};\6
+\&{end};\2\6
+\&{end};\C{there are only eight octants}\par
+\U378.\fi
+
+\M381. \P$\X381:Add edges for first or fourth octants, then \&{goto} \\{done}\X%
+\S$\6
+\X377:Move to row \\{n0}, pointed to by \|p\X;\6
+\&{if} $\\{delta}>0$ \1\&{then}\6
+\&{begin} \37$\|k\K0$;\5
+$\\{edge\_and\_weight}\K8\ast(\\{m0}+\\{m\_offset}(\\{cur\_edges}))+\\{min%
+\_halfword}+\\{zero\_w}-\\{cur\_wt}$;\6
+\1\&{repeat} \37$\\{edge\_and\_weight}\K\\{edge\_and\_weight}+\\{dx}\ast%
+\\{move}[\|k]$;\5
+$\\{fast\_get\_avail}(\|r)$;\5
+$\\{link}(\|r)\K\\{unsorted}(\|p)$;\5
+$\\{info}(\|r)\K\\{edge\_and\_weight}$;\6
+\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+$\\{trace\_new\_edge}(\|r,\39\|n)$;\2\6
+$\\{unsorted}(\|p)\K\|r$;\5
+$\|p\K\\{link}(\|p)$;\5
+$\\{incr}(\|k)$;\5
+$\\{incr}(\|n)$;\6
+\4\&{until}\5
+$\|k=\\{delta}$;\2\6
+\&{end};\2\6
+\&{goto} \37\\{done}\par
+\U378.\fi
+
+\M382. \P$\X382:Add edges for fifth or eighth octants, then \&{goto} \\{done}\X%
+\S$\6
+$\\{n0}\K-\\{n0}-1$;\5
+\X377:Move to row \\{n0}, pointed to by \|p\X;\6
+\&{if} $\\{delta}>0$ \1\&{then}\6
+\&{begin} \37$\|k\K0$;\5
+$\\{edge\_and\_weight}\K8\ast(\\{m0}+\\{m\_offset}(\\{cur\_edges}))+\\{min%
+\_halfword}+\\{zero\_w}+\\{cur\_wt}$;\6
+\1\&{repeat} \37$\\{edge\_and\_weight}\K\\{edge\_and\_weight}+\\{dx}\ast%
+\\{move}[\|k]$;\5
+$\\{fast\_get\_avail}(\|r)$;\5
+$\\{link}(\|r)\K\\{unsorted}(\|p)$;\5
+$\\{info}(\|r)\K\\{edge\_and\_weight}$;\6
+\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+$\\{trace\_new\_edge}(\|r,\39\|n)$;\2\6
+$\\{unsorted}(\|p)\K\|r$;\5
+$\|p\K\\{knil}(\|p)$;\5
+$\\{incr}(\|k)$;\5
+$\\{decr}(\|n)$;\6
+\4\&{until}\5
+$\|k=\\{delta}$;\2\6
+\&{end};\2\6
+\&{goto} \37\\{done}\par
+\U378.\fi
+
+\M383. \P$\X383:Add edges for second or third octants, then \&{goto} \\{done}\X%
+\S$\6
+$\\{edge\_and\_weight}\K8\ast(\\{n0}+\\{m\_offset}(\\{cur\_edges}))+\\{min%
+\_halfword}+\\{zero\_w}-\\{cur\_wt}$;\5
+$\\{n0}\K\\{m0}$;\5
+$\|k\K0$;\5
+\X377:Move to row \\{n0}, pointed to by \|p\X;\6
+\1\&{repeat} \37$\|j\K\\{move}[\|k]$;\6
+\&{while} $\|j>0$ \1\&{do}\6
+\&{begin} \37$\\{fast\_get\_avail}(\|r)$;\5
+$\\{link}(\|r)\K\\{unsorted}(\|p)$;\5
+$\\{info}(\|r)\K\\{edge\_and\_weight}$;\6
+\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+$\\{trace\_new\_edge}(\|r,\39\|n)$;\2\6
+$\\{unsorted}(\|p)\K\|r$;\5
+$\|p\K\\{link}(\|p)$;\5
+$\\{decr}(\|j)$;\5
+$\\{incr}(\|n)$;\6
+\&{end};\2\6
+$\\{edge\_and\_weight}\K\\{edge\_and\_weight}+\\{dx}$;\5
+$\\{incr}(\|k)$;\6
+\4\&{until}\5
+$\|k>\\{delta}$;\2\6
+\&{goto} \37\\{done}\par
+\U378.\fi
+
+\M384. \P$\X384:Add edges for sixth or seventh octants, then \&{goto} \\{done}%
+\X\S$\6
+$\\{edge\_and\_weight}\K8\ast(\\{n0}+\\{m\_offset}(\\{cur\_edges}))+\\{min%
+\_halfword}+\\{zero\_w}+\\{cur\_wt}$;\5
+$\\{n0}\K-\\{m0}-1$;\5
+$\|k\K0$;\5
+\X377:Move to row \\{n0}, pointed to by \|p\X;\6
+\1\&{repeat} \37$\|j\K\\{move}[\|k]$;\6
+\&{while} $\|j>0$ \1\&{do}\6
+\&{begin} \37$\\{fast\_get\_avail}(\|r)$;\5
+$\\{link}(\|r)\K\\{unsorted}(\|p)$;\5
+$\\{info}(\|r)\K\\{edge\_and\_weight}$;\6
+\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+$\\{trace\_new\_edge}(\|r,\39\|n)$;\2\6
+$\\{unsorted}(\|p)\K\|r$;\5
+$\|p\K\\{knil}(\|p)$;\5
+$\\{decr}(\|j)$;\5
+$\\{decr}(\|n)$;\6
+\&{end};\2\6
+$\\{edge\_and\_weight}\K\\{edge\_and\_weight}+\\{dx}$;\5
+$\\{incr}(\|k)$;\6
+\4\&{until}\5
+$\|k>\\{delta}$;\2\6
+\&{goto} \37\\{done}\par
+\U378.\fi
+
+\M385. All the hard work of building an edge structure is undone by the
+following
+subroutine.
+
+\Y\P$\4\X268:Declare the recycling subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{toss\_edges}(\|h:\\{pointer})$;\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{for list manipulation}\2\6
+\&{begin} \37$\|q\K\\{link}(\|h)$;\6
+\&{while} $\|q\I\|h$ \1\&{do}\6
+\&{begin} \37$\\{flush\_list}(\\{sorted}(\|q))$;\6
+\&{if} $\\{unsorted}(\|q)>\\{void}$ \1\&{then}\5
+$\\{flush\_list}(\\{unsorted}(\|q))$;\2\6
+$\|p\K\|q$;\5
+$\|q\K\\{link}(\|q)$;\5
+$\\{free\_node}(\|p,\39\\{row\_node\_size})$;\6
+\&{end};\2\6
+$\\{free\_node}(\|h,\39\\{edge\_header\_size})$;\6
+\&{end};\par
+\fi
+
+\N386. \[21] Subdivision into octants.
+When \MF\ digitizes a path, it reduces the problem to the special
+case of paths that travel in ``first octant'' directions; i.e.,
+each cubic $z(t)=\bigl(x(t),y(t)\bigr)$ being digitized will have the property
+that $0\L y'(t)\L x'(t)$. This assumption makes digitizing simpler
+and faster than if the direction of motion has to be tested repeatedly.
+
+When $z(t)$ is cubic, $x'(t)$ and $y'(t)$ are quadratic, hence the four
+polynomials $x'(t)$, $y'(t)$, $x'(t)-y'(t)$, and $x'(t)+y'(t)$ cross
+through~0 at most twice each. If we subdivide the given cubic at these
+places, we get at most nine subintervals in each of which
+$x'(t)$, $y'(t)$, $x'(t)-y'(t)$, and $x'(t)+y'(t)$ all have a constant
+sign. The curve can be transformed in each of these subintervals so that
+it travels entirely in first octant directions, if we reflect $x\swap-x$,
+$y\swap-y$, and/or $x\swap y$ as necessary. (Incidentally, it can be
+shown that a cubic such that $x'(t)=16(2t-1)^2+2(2t-1)-1$ and
+$y'(t)=8(2t-1)^2+4(2t-1)$ does indeed split into nine subintervals.)
+
+\fi
+
+\M387. The transformation that rotates coordinates, so that first octant motion
+can be assumed, is defined by the \\{skew} subroutine, which sets global
+variables \\{cur\_x} and \\{cur\_y} to the values that are appropriate in a
+given octant. (Octants are encoded as they were in the \\{n\_arg} subroutine.)
+
+This transformation is ``skewed'' by replacing $(\|x,\|y)$ by $(\|x-\|y,\|y)$,
+once first octant motion has been established. It turns out that
+skewed coordinates are somewhat better to work with when curves are
+actually digitized.
+
+\Y\P\D \37$\\{set\_two\_end}(\#)\S\\{cur\_y}\K\#$;\ \&{end} \par
+\P\D $\\{set\_two}(\#)\S$ \6
+\&{begin} \37$\\{cur\_x}\K\#$;\5
+\\{set\_two\_end}\par
+\Y\P\4\&{procedure}\1\ \37$\\{skew}(\|x,\39\|y:\\{scaled};\,\35\\{octant}:%
+\\{small\_number})$;\2\6
+\&{begin} \37\&{case} $\\{octant}$ \1\&{of}\6
+\4\\{first\_octant}: \37$\\{set\_two}(\|x-\|y)(\|y)$;\6
+\4\\{second\_octant}: \37$\\{set\_two}(\|y-\|x)(\|x)$;\6
+\4\\{third\_octant}: \37$\\{set\_two}(\|y+\|x)(-\|x)$;\6
+\4\\{fourth\_octant}: \37$\\{set\_two}(-\|x-\|y)(\|y)$;\6
+\4\\{fifth\_octant}: \37$\\{set\_two}(-\|x+\|y)(-\|y)$;\6
+\4\\{sixth\_octant}: \37$\\{set\_two}(-\|y+\|x)(-\|x)$;\6
+\4\\{seventh\_octant}: \37$\\{set\_two}(-\|y-\|x)(\|x)$;\6
+\4\\{eighth\_octant}: \37$\\{set\_two}(\|x+\|y)(-\|y)$;\2\6
+\&{end};\C{there are no other cases}\6
+\&{end};\par
+\fi
+
+\M388. Conversely, the following subroutine sets \\{cur\_x} and
+\\{cur\_y} to the original coordinate values of a point, given an octant
+code and the point's coordinates $(\|x,\|y)$ after they have been mapped into
+the first octant and skewed.
+
+\Y\P$\4\X257:Declare subroutines for printing expressions\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{unskew}(\|x,\39\|y:\\{scaled};\,\35\\{octant}:%
+\\{small\_number})$;\2\6
+\&{begin} \37\&{case} $\\{octant}$ \1\&{of}\6
+\4\\{first\_octant}: \37$\\{set\_two}(\|x+\|y)(\|y)$;\6
+\4\\{second\_octant}: \37$\\{set\_two}(\|y)(\|x+\|y)$;\6
+\4\\{third\_octant}: \37$\\{set\_two}(-\|y)(\|x+\|y)$;\6
+\4\\{fourth\_octant}: \37$\\{set\_two}(-\|x-\|y)(\|y)$;\6
+\4\\{fifth\_octant}: \37$\\{set\_two}(-\|x-\|y)(-\|y)$;\6
+\4\\{sixth\_octant}: \37$\\{set\_two}(-\|y)(-\|x-\|y)$;\6
+\4\\{seventh\_octant}: \37$\\{set\_two}(\|y)(-\|x-\|y)$;\6
+\4\\{eighth\_octant}: \37$\\{set\_two}(\|x+\|y)(-\|y)$;\2\6
+\&{end};\C{there are no other cases}\6
+\&{end};\par
+\fi
+
+\M389. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{cur\_x},\39\\{cur\_y}$: \37\\{scaled};\C{outputs of \\{rotate}, %
+\\{unrotate}, and a few other routines}\par
+\fi
+
+\M390. The conversion to skewed and rotated coordinates takes place in
+stages, and at one point in the transformation we will have negated the
+$x$ and/or $y$ coordinates so as to make curves travel in the first
+{\sl quadrant}. At this point the relevant ``octant'' code will be
+either \\{first\_octant} (when no transformation has been done),
+or $\\{fourth\_octant}=\\{first\_octant}+\\{negate\_x}$ (when $x$ has been
+negated),
+or $\\{fifth\_octant}=\\{first\_octant}+\\{negate\_x}+\\{negate\_y}$ (when both
+have been
+negated), or $\\{eighth\_octant}=\\{first\_octant}+\\{negate\_y}$ (when $y$ has
+been
+negated). The \\{abnegate} routine is sometimes needed to convert
+from one of these transformations to another.
+
+\Y\P\4\&{procedure}\1\ \37$\\{abnegate}(\|x,\39\|y:\\{scaled};\,\35\\{octant%
+\_before},\39\\{octant\_after}:\\{small\_number})$;\2\6
+\&{begin} \37\&{if} $\\{odd}(\\{octant\_before})=\\{odd}(\\{octant\_after})$ \1%
+\&{then}\5
+$\\{cur\_x}\K\|x$\6
+\4\&{else} $\\{cur\_x}\K-\|x$;\2\6
+\&{if} $(\\{octant\_before}>\\{negate\_y})=(\\{octant\_after}>\\{negate\_y})$ %
+\1\&{then}\5
+$\\{cur\_y}\K\|y$\6
+\4\&{else} $\\{cur\_y}\K-\|y$;\2\6
+\&{end};\par
+\fi
+
+\M391. Now here's a subroutine that's handy for subdivision: Given a
+quadratic polynomial $B(a,b,c;t)$, the \\{crossing\_point} function
+returns the unique \\{fraction} value \|t between 0 and~1 at which
+$B(a,b,c;t)$ changes from positive to negative, or returns
+$\|t=\\{fraction\_one}+1$ if no such value exists. If $\|a<0$ (so that
+$B(a,b,c;t)$
+is already negative at $\|t=0$), \\{crossing\_point} returns the value zero.
+
+\Y\P\D \37$\\{no\_crossing}\S$\1\6
+\&{begin} \37$\\{crossing\_point}\K\\{fraction\_one}+1$;\5
+\&{return};\6
+\&{end}\2\par
+\P\D \37$\\{one\_crossing}\S$\1\6
+\&{begin} \37$\\{crossing\_point}\K\\{fraction\_one}$;\5
+\&{return};\6
+\&{end}\2\par
+\P\D \37$\\{zero\_crossing}\S$\1\6
+\&{begin} \37$\\{crossing\_point}\K0$;\5
+\&{return};\6
+\&{end}\2\par
+\Y\P\4\&{function}\1\ \37$\\{crossing\_point}(\|a,\39\|b,\39\|c:\\{integer})$:
+\37\\{fraction};\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|d: \37\\{integer};\C{recursive counter}\6
+$\|x,\39\\{xx},\39\\{x0},\39\\{x1},\39\\{x2}$: \37\\{integer};\C{temporary
+registers for bisection}\2\6
+\&{begin} \37\&{if} $\|a<0$ \1\&{then}\5
+\\{zero\_crossing};\2\6
+\&{if} $\|c\G0$ \1\&{then}\6
+\&{begin} \37\&{if} $\|b\G0$ \1\&{then}\6
+\&{if} $\|c>0$ \1\&{then}\5
+\\{no\_crossing}\6
+\4\&{else} \&{if} $(\|a=0)\W(\|b=0)$ \1\&{then}\5
+\\{no\_crossing}\6
+\4\&{else} \\{one\_crossing};\2\2\2\6
+\&{if} $\|a=0$ \1\&{then}\5
+\\{zero\_crossing};\2\6
+\&{end}\6
+\4\&{else} \&{if} $\|a=0$ \1\&{then}\6
+\&{if} $\|b\L0$ \1\&{then}\5
+\\{zero\_crossing};\2\2\2\6
+\X392:Use bisection to find the crossing point, if one exists\X;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M392. The general bisection method is quite simple when $n=2$, hence
+\\{crossing\_point} does not take much time. At each stage in the
+recursion we have a subinterval defined by \|l and~\|j such that
+$B(a,b,c;2^{-l}(j+t))=B(x_0,x_1,x_2;t)$, and we want to ``zero in'' on
+the subinterval where $x_0\G0$ and $\min(x_1,x_2)<0$.
+
+It is convenient for purposes of calculation to combine the values
+of \|l and~\|j in a single variable $d=2^l+j$, because the operation
+of bisection then corresponds simply to doubling $d$ and possibly
+adding~1. Furthermore it proves to be convenient to modify
+our previous conventions for bisection slightly, maintaining the
+variables $X_0=2^lx_0$, $X_1=2^l(x_0-x_1)$, and $X_2=2^l(x_1-x_2)$.
+With these variables the conditions $x_0\ge0$ and $\min(x_1,x_2)<0$ are
+equivalent to $\max(X_1,X_1+X_2)>X_0\ge0$.
+
+The following code maintains the invariant relations
+$0\L\\{x0}<\max(\\{x1},\\{x1}+\\{x2})$,
+$\vert\\{x1}\vert<2^{30}$, $\vert\\{x2}\vert<2^{30}$;
+it has been constructed in such a way that no arithmetic overflow
+will occur if the inputs satisfy
+$a<2^{30}$, $\vert a-b\vert<2^{30}$, and $\vert b-c\vert<2^{30}$.
+
+\Y\P$\4\X392:Use bisection to find the crossing point, if one exists\X\S$\6
+$\|d\K1$;\5
+$\\{x0}\K\|a$;\5
+$\\{x1}\K\|a-\|b$;\5
+$\\{x2}\K\|b-\|c$;\6
+\1\&{repeat} \37$\|x\K\\{half}(\\{x1}+\\{x2})$;\6
+\&{if} $\\{x1}-\\{x0}>\\{x0}$ \1\&{then}\6
+\&{begin} \37$\\{x2}\K\|x$;\5
+$\\{double}(\\{x0})$;\5
+$\\{double}(\|d)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{xx}\K\\{x1}+\|x-\\{x0}$;\6
+\&{if} $\\{xx}>\\{x0}$ \1\&{then}\6
+\&{begin} \37$\\{x2}\K\|x$;\5
+$\\{double}(\\{x0})$;\5
+$\\{double}(\|d)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{x0}\K\\{x0}-\\{xx}$;\6
+\&{if} $\|x\L\\{x0}$ \1\&{then}\6
+\&{if} $\|x+\\{x2}\L\\{x0}$ \1\&{then}\5
+\\{no\_crossing};\2\2\6
+$\\{x1}\K\|x$;\5
+$\|d\K\|d+\|d+1$;\6
+\&{end};\2\6
+\&{end};\2\6
+\4\&{until}\5
+$\|d\G\\{fraction\_one}$;\2\6
+$\\{crossing\_point}\K\|d-\\{fraction\_one}$\par
+\U391.\fi
+
+\M393. Octant subdivision is applied only to cycles, i.e., to closed paths.
+A ``cycle spec'' is a data structure that contains specifications of
+cubic curves and octant mappings for the cycle that has been subdivided
+into segments belonging to single octants. It is composed entirely of
+knot nodes, similar to those in the representation of paths; but the
+\\{explicit} type indications have been replaced by positive numbers
+that give further information. Additional \\{endpoint} data is also
+inserted at the octant boundaries.
+
+Recall that a cubic polynomial is represented by four control points
+that appear in adjacent nodes \|p and~\|q of a knot list. The \|x~coordinates
+are $\\{x\_coord}(\|p)$, $\\{right\_x}(\|p)$, $\\{left\_x}(\|q)$, and $\\{x%
+\_coord}(\|q)$; the
+\|y~coordinates are similar. We shall call this ``the cubic following~\|p''
+or ``the cubic between \|p and~\|q'' or ``the cubic preceding~\|q.''
+
+Cycle specs are circular lists of cubic curves mixed with octant
+boundaries. Like cubics, the octant boundaries are represented in
+consecutive knot nodes \|p and~\|q. In such cases $\\{right\_type}(\|p)=\\{left%
+\_type}(\|q)=\\{endpoint}$, and the fields $\\{right\_x}(\|p)$, $\\{right\_y}(%
+\|p)$,
+$\\{left\_x}(\|q)$, and $\\{left\_y}(\|q)$ are replaced by other fields called
+$\\{right\_octant}(\|p)$, $\\{right\_transition}(\|p)$, $\\{left\_octant}(%
+\|q)$, and
+$\\{left\_transition}(\|q)$, respectively. For example, when the curve
+direction
+moves from the third octant to the fourth octant, the boundary nodes say
+$\\{right\_octant}(\|p)=\\{third\_octant}$, $\\{left\_octant}(\|q)=\\{fourth%
+\_octant}$,
+and $\\{right\_transition}(\|p)=\\{left\_transition}(\|q)=\\{diagonal}$. A %
+\\{diagonal}
+transition occurs when moving between octants 1~\AM~2, 3~\AM~4, 5~\AM~6, or
+7~\AM~8; an \\{axis} transition occurs when moving between octants 8~\AM~1,
+2~\AM~3, 4~\AM~5, 6~\AM~7. (Such transition information is redundant
+but convenient.) Fields $\\{x\_coord}(\|p)$ and $\\{y\_coord}(\|p)$ will
+contain
+coordinates of the transition point after rotation from third octant
+to first octant; i.e., if the true coordinates are $(x,y)$, the
+coordinates $(y,-x)$ will appear in node~\|p. Similarly, a fourth-octant
+transformation will have been applied after the transition, so
+we will have $\\{x\_coord}(\|q)=\hbox{$-x$}$ and $\\{y\_coord}(\|q)=\|y$.
+
+The cubic between \|p and \|q will contain positive numbers in the
+fields $\\{right\_type}(\|p)$ and $\\{left\_type}(\|q)$; this makes cubics
+distinguishable from octant boundaries, because $\\{endpoint}=0$.
+The value of $\\{right\_type}(\|p)$ will be the current octant code,
+during the time that cycle specs are being constructed; it will
+refer later to a pen offset position, if the envelope of a cycle is
+being computed. A cubic that comes from some subinterval of the $k$th
+step in the original cyclic path will have $\\{left\_type}(\|q)=\|k$.
+
+\Y\P\D \37$\\{right\_octant}\S\\{right\_x}$\C{the octant code before a
+transition}\par
+\P\D \37$\\{left\_octant}\S\\{left\_x}$\C{the octant after a transition}\par
+\P\D \37$\\{right\_transition}\S\\{right\_y}$\C{the type of transition}\par
+\P\D \37$\\{left\_transition}\S\\{left\_y}$\C{ditto, either \\{axis} or %
+\\{diagonal}}\par
+\P\D \37$\\{axis}=0$\C{a transition across the $x'$- or $y'$-axis}\par
+\P\D \37$\\{diagonal}=1$\C{a transition where $y'=\pm x'$}\par
+\fi
+
+\M394. Here's a routine that prints a cycle spec in symbolic form, so that it
+is possible to see what subdivision has been made. The point coordinates
+are converted back from \MF's internal ``rotated'' form to the external
+``true'' form. The global variable~\\{cur\_spec} should point to a knot just
+after the beginning of an octant boundary, i.e., such that
+$\\{left\_type}(\\{cur\_spec})=\\{endpoint}$.
+
+\Y\P\D \37$\\{print\_two\_true}(\#)\S\\{unskew}(\#,\39\\{octant})$;\5
+$\\{print\_two}(\\{cur\_x},\39\\{cur\_y})$\par
+\Y\P\4\&{procedure}\1\ \37$\\{print\_spec}(\|s:\\{str\_number})$;\6
+\4\&{label} \37$\\{not\_found},\39\\{done}$;\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{for list traversal}\6
+\\{octant}: \37\\{small\_number};\C{the current octant code}\2\6
+\&{begin} \37$\\{print\_diagnostic}(\.{"Cycle\ spec"},\39\|s,\39\\{true})$;\5
+$\|p\K\\{cur\_spec}$;\5
+$\\{octant}\K\\{left\_octant}(\|p)$;\5
+\\{print\_ln};\5
+$\\{print\_two\_true}(\\{x\_coord}(\\{cur\_spec}),\39\\{y\_coord}(\\{cur%
+\_spec}))$;\5
+$\\{print}(\.{"\ \%\ beginning\ in\ octant\ \`"})$;\6
+\~ \1\&{loop}\ \&{begin} \37$\\{print}(\\{octant\_dir}[\\{octant}])$;\5
+$\\{print\_char}(\.{"\'"})$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|q\K\\{link}(\|p)$;\6
+\&{if} $\\{right\_type}(\|p)=\\{endpoint}$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\X397:Print the cubic between \|p and \|q\X;\6
+$\|p\K\|q$;\6
+\&{end};\2\6
+\4\\{not\_found}: \37\&{if} $\|q=\\{cur\_spec}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|p\K\|q$;\5
+$\\{octant}\K\\{left\_octant}(\|p)$;\5
+$\\{print\_nl}(\.{"\%\ entering\ octant\ \`"})$;\6
+\&{end};\2\6
+\4\\{done}: \37$\\{print\_nl}(\.{"\ \&\ cycle"})$;\5
+$\\{end\_diagnostic}(\\{true})$;\6
+\&{end};\par
+\fi
+
+\M395. Symbolic octant direction names are kept in the \\{octant\_dir} array.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{octant\_dir}: \37\&{array} $[\\{first\_octant}\to\\{sixth\_octant}]$ \1%
+\&{of}\5
+\\{str\_number};\2\par
+\fi
+
+\M396. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{octant\_dir}[\\{first\_octant}]\K\.{"ENE"}$;\5
+$\\{octant\_dir}[\\{second\_octant}]\K\.{"NNE"}$;\5
+$\\{octant\_dir}[\\{third\_octant}]\K\.{"NNW"}$;\5
+$\\{octant\_dir}[\\{fourth\_octant}]\K\.{"WNW"}$;\5
+$\\{octant\_dir}[\\{fifth\_octant}]\K\.{"WSW"}$;\5
+$\\{octant\_dir}[\\{sixth\_octant}]\K\.{"SSW"}$;\5
+$\\{octant\_dir}[\\{seventh\_octant}]\K\.{"SSE"}$;\5
+$\\{octant\_dir}[\\{eighth\_octant}]\K\.{"ESE"}$;\par
+\fi
+
+\M397. \P$\X397:Print the cubic between \|p and \|q\X\S$\6
+\&{begin} \37$\\{print\_nl}(\.{"\ \ \ ..controls\ "})$;\5
+$\\{print\_two\_true}(\\{right\_x}(\|p),\39\\{right\_y}(\|p))$;\5
+$\\{print}(\.{"\ and\ "})$;\5
+$\\{print\_two\_true}(\\{left\_x}(\|q),\39\\{left\_y}(\|q))$;\5
+$\\{print\_nl}(\.{"\ .."})$;\5
+$\\{print\_two\_true}(\\{x\_coord}(\|q),\39\\{y\_coord}(\|q))$;\5
+$\\{print}(\.{"\ \%\ segment\ "})$;\5
+$\\{print\_int}(\\{left\_type}(\|q)-1)$;\6
+\&{end}\par
+\U394.\fi
+
+\M398. A much more compact version of a spec is printed to help users identify
+``strange paths.''
+
+\Y\P\4\&{procedure}\1\ \37$\\{print\_strange}(\|s:\\{str\_number})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{for list traversal}\6
+\|f: \37\\{pointer};\C{starting point in the cycle}\6
+\|q: \37\\{pointer};\C{octant boundary to be printed}\6
+\|t: \37\\{integer};\C{segment number, plus 1}\2\6
+\&{begin} \37\&{if} $\\{interaction}=\\{error\_stop\_mode}$ \1\&{then}\5
+\\{wake\_up\_terminal};\2\6
+$\\{print\_nl}(\.{">"})$;\5
+\X399:Find the starting point, \|f\X;\6
+\X400:Determine the octant boundary \|q that precedes \|f\X;\6
+$\|t\K0$;\6
+\1\&{repeat} \37\&{if} $\\{left\_type}(\|p)\I\\{endpoint}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{left\_type}(\|p)\I\|t$ \1\&{then}\6
+\&{begin} \37$\|t\K\\{left\_type}(\|p)$;\5
+$\\{print\_char}(\.{"\ "})$;\5
+$\\{print\_int}(\|t-1)$;\6
+\&{end};\2\6
+\&{if} $\|q\I\\{null}$ \1\&{then}\6
+\&{begin} \37\X401:Print the turns, if any, that start at \|q, and advance \|q%
+\X;\6
+$\\{print\_char}(\.{"\ "})$;\5
+$\\{print}(\\{octant\_dir}[\\{left\_octant}(\|q)])$;\5
+$\|q\K\\{null}$;\6
+\&{end};\2\6
+\&{end}\6
+\4\&{else} \&{if} $\|q=\\{null}$ \1\&{then}\5
+$\|q\K\|p$;\2\2\6
+$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\|p=\|f$;\2\6
+$\\{print\_char}(\.{"\ "})$;\5
+$\\{print\_int}(\\{left\_type}(\|p)-1)$;\6
+\&{if} $\|q\I\\{null}$ \1\&{then}\5
+\X401:Print the turns, if any, that start at \|q, and advance \|q\X;\2\6
+$\\{print\_err}(\|s)$;\6
+\&{end};\par
+\fi
+
+\M399. If the segment numbers on the cycle are $t_1$, $t_2$, \dots, $t_m$,
+we have $t_{k-1}\L t_k$ except for at most one value of~$k$. If there are
+no exceptions, $f$ will point to $t_1$; otherwise it will point to the
+exceptional~$t_k$.
+
+There is at least one segment number (i.e., we always have $m>0$), because
+\\{print\_strange} is never called upon to display an entirely ``dead'' cycle.
+
+\Y\P$\4\X399:Find the starting point, \|f\X\S$\6
+$\|p\K\\{cur\_spec}$;\5
+$\|t\K\\{max\_quarterword}+1$;\6
+\1\&{repeat} \37$\|p\K\\{link}(\|p)$;\6
+\&{if} $\\{left\_type}(\|p)\I\\{endpoint}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{left\_type}(\|p)<\|t$ \1\&{then}\5
+$\|f\K\|p$;\2\6
+$\|t\K\\{left\_type}(\|p)$;\6
+\&{end};\2\6
+\4\&{until}\5
+$\|p=\\{cur\_spec}$\2\par
+\U398.\fi
+
+\M400. \P$\X400:Determine the octant boundary \|q that precedes \|f\X\S$\6
+$\|p\K\\{cur\_spec}$;\5
+$\|q\K\|p$;\6
+\1\&{repeat} \37$\|p\K\\{link}(\|p)$;\6
+\&{if} $\\{left\_type}(\|p)=\\{endpoint}$ \1\&{then}\5
+$\|q\K\|p$;\2\6
+\4\&{until}\5
+$\|p=\|f$\2\par
+\U398.\fi
+
+\M401. When two octant boundaries are adjacent, the path is simply changing
+direction
+without moving. Such octant directions are shown in parentheses.
+
+\Y\P$\4\X401:Print the turns, if any, that start at \|q, and advance \|q\X\S$\6
+\&{if} $\\{left\_type}(\\{link}(\|q))=\\{endpoint}$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"\ ("})$;\5
+$\\{print}(\\{octant\_dir}[\\{left\_octant}(\|q)])$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{while} $\\{left\_type}(\\{link}(\|q))=\\{endpoint}$ \1\&{do}\6
+\&{begin} \37$\\{print\_char}(\.{"\ "})$;\5
+$\\{print}(\\{octant\_dir}[\\{left\_octant}(\|q)])$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+$\\{print\_char}(\.{")"})$;\6
+\&{end}\2\par
+\Us398\ET398.\fi
+
+\M402. The \\{make\_spec} routine is what subdivides paths into octants:
+Given a pointer \\{cur\_spec} to a cyclic path, \\{make\_spec} mungs the path
+data
+and returns a pointer to the corresponding cyclic spec.
+All ``dead'' cubics (i.e., cubics that don't move at all from
+their starting points) will have been removed from the result.
+
+The idea of \\{make\_spec} is fairly simple: Each cubic is first
+subdivided, if necessary, into pieces belonging to single octants;
+then the octant boundaries are inserted. But some of the details of
+this transformation are not quite obvious.
+
+If $\\{autorounding}>0$, the path will be adjusted so that critical tangent
+directions occur at ``good'' points with respect to the pen called \\{cur%
+\_pen}.
+
+The resulting spec will have all \|x and \|y coordinates at most
+$2^{28}-\\{half\_unit}-1-\\{safety\_margin}$ in absolute value. The pointer
+that is returned will start some octant, as required by \\{print\_spec}.
+
+\Y\P\hbox{\4}\X405:Declare subroutines needed by \\{make\_spec}\X\6
+\4\&{function}\1\ \37$\\{make\_spec}(\|h:\\{pointer};\,\35\\{safety\_margin}:%
+\\{scaled};\,\35\\{tracing}:\\{integer})$: \37\\{pointer};\C{converts a path to
+a cycle spec}\6
+\4\&{label} \37$\\{continue},\39\\{done}$;\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\C{for traversing the
+lists}\6
+\|k: \37\\{integer};\C{serial number of path segment, or octant code}\6
+\\{chopped}: \37\\{integer};\C{positive if data truncated, negative
+if data dangerously large}\6
+\X453:Other local variables for \\{make\_spec}\X\2\6
+\&{begin} \37$\\{cur\_spec}\K\|h$;\6
+\&{if} $\\{tracing}>0$ \1\&{then}\5
+$\\{print\_path}(\\{cur\_spec},\39\.{",\ before\ subdivision\ into\ octants"},%
+\39\\{true})$;\2\6
+$\\{max\_allowed}\K\\{fraction\_one}-\\{half\_unit}-1-\\{safety\_margin}$;\5
+\X404:Truncate the values of all coordinates that exceed \\{max\_allowed}, and
+stamp segment numbers in each \\{left\_type} field\X;\6
+\\{quadrant\_subdivide};\C{subdivide each cubic into pieces belonging to
+quadrants}\6
+\&{if} $(\\{internal}[\\{autorounding}]>0)\W(\\{chopped}=0)$ \1\&{then}\5
+\\{xy\_round};\2\6
+\\{octant\_subdivide};\C{complete the subdivision}\6
+\&{if} $(\\{internal}[\\{autorounding}]>\\{unity})\W(\\{chopped}=0)$ \1\&{then}%
+\5
+\\{diag\_round};\2\6
+\X447:Remove dead cubics\X;\6
+\X450:Insert octant boundaries and compute the turning number\X;\6
+\&{while} $\\{left\_type}(\\{cur\_spec})\I\\{endpoint}$ \1\&{do}\5
+$\\{cur\_spec}\K\\{link}(\\{cur\_spec})$;\2\6
+\&{if} $\\{tracing}>0$ \1\&{then}\6
+\&{if} $(\\{internal}[\\{autorounding}]\L0)\V(\\{chopped}\I0)$ \1\&{then}\5
+$\\{print\_spec}(\.{",\ after\ subdivision"})$\6
+\4\&{else} \&{if} $\\{internal}[\\{autorounding}]>\\{unity}$ \1\&{then}\5
+$\\{print\_spec}(\.{",\ after\ subdivision\ and\ double\ autorounding"})$\6
+\4\&{else} $\\{print\_spec}(\.{",\ after\ subdivision\ and\ autorounding"})$;\2%
+\2\2\6
+$\\{make\_spec}\K\\{cur\_spec}$;\6
+\&{end};\par
+\fi
+
+\M403. The \\{make\_spec} routine has an interesting side effect, namely to set
+the global variable \\{turning\_number} to the number of times the tangent
+vector of the given cyclic path winds around the origin.
+
+Another global variable \\{cur\_spec} points to the specification as it is
+being made, since several subroutines must go to work on it.
+
+And there are two global variables that affect the rounding
+decisions, as we'll see later; they are called \\{cur\_pen} and \\{cur\_path%
+\_type}.
+The latter will be \\{double\_path\_code} if \\{make\_spec} is being
+applied to a double path.
+
+\Y\P\D \37$\\{double\_path\_code}=0$\C{command modifier for `\&{doublepath}'}%
+\par
+\P\D \37$\\{contour\_code}=1$\C{command modifier for `\&{contour}'}\par
+\P\D \37$\\{also\_code}=2$\C{command modifier for `\&{also}'}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{cur\_spec}: \37\\{pointer};\C{the principal output of \\{make\_spec}}\6
+\4\\{turning\_number}: \37\\{integer};\C{another output of \\{make\_spec}}\6
+\4\\{cur\_pen}: \37\\{pointer};\C{an implicit input of \\{make\_spec}, used in
+autorounding}\6
+\4\\{cur\_path\_type}: \37$\\{double\_path\_code}\to\\{contour\_code}$;%
+\C{likewise}\6
+\4\\{max\_allowed}: \37\\{scaled};\C{coordinates must be at most this big}\par
+\fi
+
+\M404. First we do a simple preprocessing step. The segment numbers inserted
+here will propagate to all descendants of cubics that are split into
+subintervals. These numbers must be nonzero, but otherwise they are
+present merely for diagnostic purposes. The cubic from \|p to~\|q
+that represents ``time interval'' $(\|t-1)\to\|t$ usually has $\\{right\_type}(%
+\|q)=\|t$,
+except when \|t is too large to be stored in a quarterword.
+
+\Y\P\D \37$\\{procrustes}(\#)\S$\ \&{if} $\\{abs}(\#)\G\\{dmax}$ \1\&{then}\6
+\&{if} $\\{abs}(\#)>\\{max\_allowed}$ \1\&{then}\6
+\&{begin} \37$\\{chopped}\K1$;\6
+\&{if} $\#>0$ \1\&{then}\5
+$\#\K\\{max\_allowed}$\ \&{else} $\#\K-\\{max\_allowed}$;\2\6
+\&{end}\6
+\4\&{else} \&{if} $\\{chopped}=0$ \1\&{then}\5
+$\\{chopped}\K-1$\2\2\2\par
+\Y\P$\4\X404:Truncate the values of all coordinates that exceed \\{max%
+\_allowed}, and stamp segment numbers in each \\{left\_type} field\X\S$\6
+$\|p\K\\{cur\_spec}$;\5
+$\|k\K1$;\5
+$\\{chopped}\K0$;\5
+$\\{dmax}\K\\{max\_allowed}/2$;\6
+\1\&{repeat} \37$\\{procrustes}(\\{left\_x}(\|p))$;\5
+$\\{procrustes}(\\{left\_y}(\|p))$;\5
+$\\{procrustes}(\\{x\_coord}(\|p))$;\5
+$\\{procrustes}(\\{y\_coord}(\|p))$;\5
+$\\{procrustes}(\\{right\_x}(\|p))$;\5
+$\\{procrustes}(\\{right\_y}(\|p))$;\6
+$\|p\K\\{link}(\|p)$;\5
+$\\{left\_type}(\|p)\K\|k$;\6
+\&{if} $\|k<\\{max\_quarterword}$ \1\&{then}\5
+$\\{incr}(\|k)$\ \&{else} $\|k\K1$;\2\6
+\4\&{until}\5
+$\|p=\\{cur\_spec}$;\2\6
+\&{if} $\\{chopped}>0$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Curve\ out\ of\ range"})$;\5
+$\\{help4}(\.{"At\ least\ one\ of\ the\ coordinates\ in\ the\ path\ I\'m\ about%
+\ to"})$\6
+$(\.{"digitize\ was\ really\ huge\ (potentially\ bigger\ than\ 4095)."})$\6
+$(\.{"So\ I\'ve\ cut\ it\ back\ to\ the\ maximum\ size."})$\6
+$(\.{"The\ results\ will\ probably\ be\ pretty\ wild."})$;\5
+\\{put\_get\_error};\6
+\&{end}\2\par
+\U402.\fi
+
+\M405. We may need to get rid of constant ``dead'' cubics that clutter up
+the data structure and interfere with autorounding.
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\S$\6
+\4\&{procedure}\1\ \37$\\{remove\_cubic}(\|p:\\{pointer})$;\C{removes the
+cubic following~\|p}\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the node that disappears}\2\6
+\&{begin} \37$\|q\K\\{link}(\|p)$;\5
+$\\{right\_type}(\|p)\K\\{right\_type}(\|q)$;\5
+$\\{link}(\|p)\K\\{link}(\|q)$;\6
+$\\{x\_coord}(\|p)\K\\{x\_coord}(\|q)$;\5
+$\\{y\_coord}(\|p)\K\\{y\_coord}(\|q)$;\6
+$\\{right\_x}(\|p)\K\\{right\_x}(\|q)$;\5
+$\\{right\_y}(\|p)\K\\{right\_y}(\|q)$;\6
+$\\{free\_node}(\|q,\39\\{knot\_node\_size})$;\6
+\&{end};\par
+\As406, 419, 426, 429, 431, 432, 433, 440\ETs451.
+\U402.\fi
+
+\M406. The subdivision process proceeds by first swapping $x\swap-x$, if
+necessary, to ensure that $x'\G0$; then swapping $y\swap-y$, if necessary,
+to ensure that $y'\G0$; and finally swapping $x\swap y$, if necessary,
+to ensure that $x'\G y'$.
+
+Recall that the octant codes have been defined in such a way that, for
+example, $\\{third\_octant}=\\{first\_octant}+\\{negate\_x}+\\{switch\_x\_and%
+\_y}$. The program
+uses the fact that $\\{negate\_x}<\\{negate\_y}<\\{switch\_x\_and\_y}$ to
+handle ``double
+negation'': If \|c is an octant code that possibly involves \\{negate\_x}
+and/or \\{negate\_y}, but not \\{switch\_x\_and\_y}, then negating~\|y changes~%
+\|c
+either to $\|c+\\{negate\_y}$ or $\|c-\\{negate\_y}$, depending on whether
+$\|c\L\\{negate\_y}$ or $\|c>\\{negate\_y}$. Octant codes are always greater
+than zero.
+
+The first step is to subdivide on \|x and \|y only, so that horizontal
+and vertical autorounding can be done before we compare $x'$ to $y'$.
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\mathrel{+}\S$\6
+\hbox{\4}\X410:Declare the procedure called \\{split\_cubic}\X\6
+\4\&{procedure}\1\ \37\\{quadrant\_subdivide};\6
+\4\&{label} \37$\\{continue},\39\\{exit}$;\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s,\39\\{pp},\39\\{qq}$: \37\\{pointer};%
+\C{for traversing the lists}\6
+$\\{first\_x},\39\\{first\_y}$: \37\\{scaled};\C{unnegated coordinates of node %
+\\{cur\_spec}}\6
+$\\{del1},\39\\{del2},\39\\{del3},\39\\{del},\39\\{dmax}$: \37\\{scaled};%
+\C{proportional to the control points of a quadratic derived from a cubic}\6
+\|t: \37\\{fraction};\C{where a quadratic crosses zero}\6
+$\\{dest\_x},\39\\{dest\_y}$: \37\\{scaled};\C{final values of \|x and \|y in
+the current cubic}\6
+\\{constant\_x}: \37\\{boolean};\C{is \|x constant between \|p and \|q?}\2\6
+\&{begin} \37$\|p\K\\{cur\_spec}$;\5
+$\\{first\_x}\K\\{x\_coord}(\\{cur\_spec})$;\5
+$\\{first\_y}\K\\{y\_coord}(\\{cur\_spec})$;\6
+\1\&{repeat} \37\\{continue}: \37$\|q\K\\{link}(\|p)$;\5
+\X407:Subdivide the cubic between \|p and \|q so that the results travel toward
+the right halfplane\X;\6
+\X413:Subdivide all cubics between \|p and \|q so that the results travel
+toward the first quadrant; but \&{return} or \&{goto} \\{continue} if the cubic
+from \|p to \|q was dead\X;\6
+$\|p\K\|q$;\6
+\4\&{until}\5
+$\|p=\\{cur\_spec}$;\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M407. All three subdivision processes are similar, so it's possible to
+get the general idea by studying the first one (which is the simplest).
+The calculation makes use of the fact that the derivatives of
+Bernshte{\u\i}n polynomials satisfy
+$B'(z_0,z_1,\ldots,z_n;t)=nB(z_1-z_0,\ldots,z_n-z_{n-1};t)$.
+
+When this routine begins, $\\{right\_type}(\|p)$ is \\{explicit}; we should
+set $\\{right\_type}(\|p)\K\\{first\_octant}$. However, no assignment is made,
+because $\\{explicit}=\\{first\_octant}$. The author apologizes for using
+such trickery here; it is really hard to do redundant computations
+just for the sake of purity.
+
+\Y\P$\4\X407:Subdivide the cubic between \|p and \|q so that the results travel
+toward the right halfplane\X\S$\6
+\&{if} $\|q=\\{cur\_spec}$ \1\&{then}\6
+\&{begin} \37$\\{dest\_x}\K\\{first\_x}$;\5
+$\\{dest\_y}\K\\{first\_y}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{dest\_x}\K\\{x\_coord}(\|q)$;\5
+$\\{dest\_y}\K\\{y\_coord}(\|q)$;\6
+\&{end};\2\6
+$\\{del1}\K\\{right\_x}(\|p)-\\{x\_coord}(\|p)$;\5
+$\\{del2}\K\\{left\_x}(\|q)-\\{right\_x}(\|p)$;\5
+$\\{del3}\K\\{dest\_x}-\\{left\_x}(\|q)$;\5
+\X408:Scale up \\{del1}, \\{del2}, and \\{del3} for greater accuracy; also set %
+\\{del} to the first nonzero element of $(\\{del1},\\{del2},\\{del3})$\X;\6
+\&{if} $\\{del}=0$ \1\&{then}\5
+$\\{constant\_x}\K\\{true}$\6
+\4\&{else} \&{begin} \37$\\{constant\_x}\K\\{false}$;\6
+\&{if} $\\{del}<0$ \1\&{then}\5
+\X409:Complement the \|x coordinates of the cubic between \|p and~\|q\X;\2\6
+$\|t\K\\{crossing\_point}(\\{del1},\39\\{del2},\39\\{del3})$;\6
+\&{if} $\|t<\\{fraction\_one}$ \1\&{then}\5
+\X411:Subdivide the cubic with respect to $x'$, possibly twice\X;\2\6
+\&{end}\2\par
+\U406.\fi
+
+\M408. If $\\{del1}=\\{del2}=\\{del3}=0$, it's impossible to obey the title of
+this
+section. We just set $\\{del}=0$ in that case.
+
+\Y\P$\4\X408:Scale up \\{del1}, \\{del2}, and \\{del3} for greater accuracy;
+also set \\{del} to the first nonzero element of $(\\{del1},\\{del2},\\{del3})$%
+\X\S$\6
+\&{if} $\\{del1}\I0$ \1\&{then}\5
+$\\{del}\K\\{del1}$\6
+\4\&{else} \&{if} $\\{del2}\I0$ \1\&{then}\5
+$\\{del}\K\\{del2}$\6
+\4\&{else} $\\{del}\K\\{del3}$;\2\2\6
+\&{if} $\\{del}\I0$ \1\&{then}\6
+\&{begin} \37$\\{dmax}\K\\{abs}(\\{del1})$;\6
+\&{if} $\\{abs}(\\{del2})>\\{dmax}$ \1\&{then}\5
+$\\{dmax}\K\\{abs}(\\{del2})$;\2\6
+\&{if} $\\{abs}(\\{del3})>\\{dmax}$ \1\&{then}\5
+$\\{dmax}\K\\{abs}(\\{del3})$;\2\6
+\&{while} $\\{dmax}<\\{fraction\_half}$ \1\&{do}\6
+\&{begin} \37$\\{double}(\\{dmax})$;\5
+$\\{double}(\\{del1})$;\5
+$\\{double}(\\{del2})$;\5
+$\\{double}(\\{del3})$;\6
+\&{end};\2\6
+\&{end}\2\par
+\Us407, 413\ETs420.\fi
+
+\M409. During the subdivision phases of \\{make\_spec}, the \\{x\_coord} and %
+\\{y\_coord}
+fields of node~\|q are not transformed to agree with the octant
+stated in $\\{right\_type}(\|p)$; they remain consistent with $\\{right\_type}(%
+\|q)$.
+But $\\{left\_x}(\|q)$ and $\\{left\_y}(\|q)$ are governed by $\\{right\_type}(%
+\|p)$.
+
+\Y\P$\4\X409:Complement the \|x coordinates of the cubic between \|p and~\|q\X%
+\S$\6
+\&{begin} \37$\\{negate}(\\{x\_coord}(\|p))$;\5
+$\\{negate}(\\{right\_x}(\|p))$;\5
+$\\{negate}(\\{left\_x}(\|q))$;\6
+$\\{negate}(\\{del1})$;\5
+$\\{negate}(\\{del2})$;\5
+$\\{negate}(\\{del3})$;\6
+$\\{negate}(\\{dest\_x})$;\5
+$\\{right\_type}(\|p)\K\\{first\_octant}+\\{negate\_x}$;\6
+\&{end}\par
+\U407.\fi
+
+\M410. When a cubic is split at a \\{fraction} value \|t, we obtain two cubics
+whose B\'ezier control points are obtained by a generalization of the
+bisection process: The formula
+`$z_k^{(j+1)}={1\over2}(z_k^{(j)}+z\k^{(j)})$' becomes
+`$z_k^{(j+1)}=t[z_k^{(j)},z\k^{(j)}]$'.
+
+It is convenient to define a \.{WEB} macro \\{t\_of\_the\_way} such that
+$\\{t\_of\_the\_way}(\|a)(\|b)$ expands to $\|a-(\|a-\|b)\ast\|t$, i.e., to $%
+\|t[\|a,\|b]$.
+
+If $0\L\|t\L1$, the quantity $\|t[\|a,\|b]$ is always between \|a and~\|b, even
+in
+the presence of rounding errors. Our subroutines
+also obey the identity $\|t[\|a,\|b]+\|t[\|b,\|a]=\|a+\|b$.
+
+\Y\P\D \37$\\{t\_of\_the\_way\_end}(\#)\S\#,\39\|t\={)}$\par
+\P\D \37$\\{t\_of\_the\_way}(\#)\S\#-\\{take\_fraction}\={(}\#-\\{t\_of\_the%
+\_way\_end}$\par
+\Y\P$\4\X410:Declare the procedure called \\{split\_cubic}\X\S$\6
+\4\&{procedure}\1\ \37$\\{split\_cubic}(\|p:\\{pointer};\,\35\|t:\\{fraction};%
+\,\35\\{xq},\39\\{yq}:\\{scaled})$;\C{splits the cubic after \|p}\6
+\4\&{var} \37\|v: \37\\{scaled};\C{an intermediate value}\6
+$\|q,\39\|r$: \37\\{pointer};\C{for list manipulation}\2\6
+\&{begin} \37$\|q\K\\{link}(\|p)$;\5
+$\|r\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{link}(\|p)\K\|r$;\5
+$\\{link}(\|r)\K\|q$;\6
+$\\{left\_type}(\|r)\K\\{left\_type}(\|q)$;\5
+$\\{right\_type}(\|r)\K\\{right\_type}(\|p)$;\7
+$\|v\K\\{t\_of\_the\_way}(\\{right\_x}(\|p))(\\{left\_x}(\|q))$;\5
+$\\{right\_x}(\|p)\K\\{t\_of\_the\_way}(\\{x\_coord}(\|p))(\\{right\_x}(\|p))$;%
+\5
+$\\{left\_x}(\|q)\K\\{t\_of\_the\_way}(\\{left\_x}(\|q))(\\{xq})$;\5
+$\\{left\_x}(\|r)\K\\{t\_of\_the\_way}(\\{right\_x}(\|p))(\|v)$;\5
+$\\{right\_x}(\|r)\K\\{t\_of\_the\_way}(\|v)(\\{left\_x}(\|q))$;\5
+$\\{x\_coord}(\|r)\K\\{t\_of\_the\_way}(\\{left\_x}(\|r))(\\{right\_x}(\|r))$;\7
+$\|v\K\\{t\_of\_the\_way}(\\{right\_y}(\|p))(\\{left\_y}(\|q))$;\5
+$\\{right\_y}(\|p)\K\\{t\_of\_the\_way}(\\{y\_coord}(\|p))(\\{right\_y}(\|p))$;%
+\5
+$\\{left\_y}(\|q)\K\\{t\_of\_the\_way}(\\{left\_y}(\|q))(\\{yq})$;\5
+$\\{left\_y}(\|r)\K\\{t\_of\_the\_way}(\\{right\_y}(\|p))(\|v)$;\5
+$\\{right\_y}(\|r)\K\\{t\_of\_the\_way}(\|v)(\\{left\_y}(\|q))$;\5
+$\\{y\_coord}(\|r)\K\\{t\_of\_the\_way}(\\{left\_y}(\|r))(\\{right\_y}(\|r))$;\6
+\&{end};\par
+\U406.\fi
+
+\M411. Since $x'(t)$ is a quadratic equation, it can cross through zero
+at~most twice. When it does cross zero, we make doubly sure that the
+derivative is really zero at the splitting point, in case rounding errors
+have caused the split cubic to have an apparently nonzero derivative.
+We also make sure that the split cubic is monotonic.
+
+\Y\P$\4\X411:Subdivide the cubic with respect to $x'$, possibly twice\X\S$\6
+\&{begin} \37$\\{split\_cubic}(\|p,\39\|t,\39\\{dest\_x},\39\\{dest\_y})$;\5
+$\|r\K\\{link}(\|p)$;\6
+\&{if} $\\{right\_type}(\|r)>\\{negate\_x}$ \1\&{then}\5
+$\\{right\_type}(\|r)\K\\{first\_octant}$\6
+\4\&{else} $\\{right\_type}(\|r)\K\\{first\_octant}+\\{negate\_x}$;\2\6
+\&{if} $\\{x\_coord}(\|r)<\\{x\_coord}(\|p)$ \1\&{then}\5
+$\\{x\_coord}(\|r)\K\\{x\_coord}(\|p)$;\2\6
+$\\{left\_x}(\|r)\K\\{x\_coord}(\|r)$;\6
+\&{if} $\\{right\_x}(\|p)>\\{x\_coord}(\|r)$ \1\&{then}\5
+$\\{right\_x}(\|p)\K\\{x\_coord}(\|r)$;\C{we always have $\\{x\_coord}(\|p)\L%
+\\{right\_x}(\|p)$}\2\6
+$\\{negate}(\\{x\_coord}(\|r))$;\5
+$\\{right\_x}(\|r)\K\\{x\_coord}(\|r)$;\5
+$\\{negate}(\\{left\_x}(\|q))$;\5
+$\\{negate}(\\{dest\_x})$;\6
+$\\{del2}\K\\{t\_of\_the\_way}(\\{del2})(\\{del3})$;\C{now $0,\\{del2},%
+\\{del3}$ represent $x'$ on the remaining interval}\6
+\&{if} $\\{del2}>0$ \1\&{then}\5
+$\\{del2}\K0$;\2\6
+$\|t\K\\{crossing\_point}(0,\39-\\{del2},\39-\\{del3})$;\6
+\&{if} $\|t<\\{fraction\_one}$ \1\&{then}\5
+\X412:Subdivide the cubic a second time with respect to $x'$\X\6
+\4\&{else} \&{begin} \37\&{if} $\\{x\_coord}(\|r)>\\{dest\_x}$ \1\&{then}\6
+\&{begin} \37$\\{x\_coord}(\|r)\K\\{dest\_x}$;\5
+$\\{left\_x}(\|r)\K-\\{x\_coord}(\|r)$;\5
+$\\{right\_x}(\|r)\K\\{x\_coord}(\|r)$;\6
+\&{end};\2\6
+\&{if} $\\{left\_x}(\|q)>\\{dest\_x}$ \1\&{then}\5
+$\\{left\_x}(\|q)\K\\{dest\_x}$\6
+\4\&{else} \&{if} $\\{left\_x}(\|q)<\\{x\_coord}(\|r)$ \1\&{then}\5
+$\\{left\_x}(\|q)\K\\{x\_coord}(\|r)$;\2\2\6
+\&{end};\2\6
+\&{end}\par
+\U407.\fi
+
+\M412. \P$\X412:Subdivide the cubic a second time with respect to $x'$\X\S$\6
+\&{begin} \37$\\{split\_cubic}(\|r,\39\|t,\39\\{dest\_x},\39\\{dest\_y})$;\5
+$\|s\K\\{link}(\|r)$;\6
+\&{if} $\\{x\_coord}(\|s)<\\{dest\_x}$ \1\&{then}\5
+$\\{x\_coord}(\|s)\K\\{dest\_x}$;\2\6
+\&{if} $\\{x\_coord}(\|s)<\\{x\_coord}(\|r)$ \1\&{then}\5
+$\\{x\_coord}(\|s)\K\\{x\_coord}(\|r)$;\2\6
+$\\{right\_type}(\|s)\K\\{right\_type}(\|p)$;\5
+$\\{left\_x}(\|s)\K\\{x\_coord}(\|s)$;\C{now $\\{x\_coord}(\|r)=\\{right\_x}(%
+\|r)\L\\{left\_x}(\|s)$}\6
+\&{if} $\\{left\_x}(\|q)<\\{dest\_x}$ \1\&{then}\5
+$\\{left\_x}(\|q)\K-\\{dest\_x}$\6
+\4\&{else} \&{if} $\\{left\_x}(\|q)>\\{x\_coord}(\|s)$ \1\&{then}\5
+$\\{left\_x}(\|q)\K-\\{x\_coord}(\|s)$\6
+\4\&{else} $\\{negate}(\\{left\_x}(\|q))$;\2\2\6
+$\\{negate}(\\{x\_coord}(\|s))$;\5
+$\\{right\_x}(\|s)\K\\{x\_coord}(\|s)$;\6
+\&{end}\par
+\U411.\fi
+
+\M413. The process of subdivision with respect to $y'$ is like that with
+respect
+to~$x'$, with the slight additional complication that two or three cubics
+might now appear between \|p and~\|q.
+
+\Y\P$\4\X413:Subdivide all cubics between \|p and \|q so that the results
+travel toward the first quadrant; but \&{return} or \&{goto} \\{continue} if
+the cubic from \|p to \|q was dead\X\S$\6
+$\\{pp}\K\|p$;\6
+\1\&{repeat} \37$\\{qq}\K\\{link}(\\{pp})$;\5
+$\\{abnegate}(\\{x\_coord}(\\{qq}),\39\\{y\_coord}(\\{qq}),\39\\{right\_type}(%
+\\{qq}),\39\\{right\_type}(\\{pp}))$;\5
+$\\{dest\_x}\K\\{cur\_x}$;\5
+$\\{dest\_y}\K\\{cur\_y}$;\6
+$\\{del1}\K\\{right\_y}(\\{pp})-\\{y\_coord}(\\{pp})$;\5
+$\\{del2}\K\\{left\_y}(\\{qq})-\\{right\_y}(\\{pp})$;\5
+$\\{del3}\K\\{dest\_y}-\\{left\_y}(\\{qq})$;\5
+\X408:Scale up \\{del1}, \\{del2}, and \\{del3} for greater accuracy; also set %
+\\{del} to the first nonzero element of $(\\{del1},\\{del2},\\{del3})$\X;\6
+\&{if} $\\{del}\I0$ \1\&{then}\C{they weren't all zero}\6
+\&{begin} \37\&{if} $\\{del}<0$ \1\&{then}\5
+\X414:Complement the \|y coordinates of the cubic between \\{pp} and~\\{qq}\X;%
+\2\6
+$\|t\K\\{crossing\_point}(\\{del1},\39\\{del2},\39\\{del3})$;\6
+\&{if} $\|t<\\{fraction\_one}$ \1\&{then}\5
+\X415:Subdivide the cubic with respect to $y'$, possibly twice\X;\2\6
+\&{end}\6
+\4\&{else} \X417:Do any special actions needed when \|y is constant; \&{return}
+or \&{goto} \\{continue} if a dead cubic from \|p to \|q is removed\X;\2\6
+$\\{pp}\K\\{qq}$;\6
+\4\&{until}\5
+$\\{pp}=\|q$;\2\6
+\&{if} $\\{constant\_x}$ \1\&{then}\5
+\X418:Correct the octant code in segments with decreasing \|y\X\2\par
+\U406.\fi
+
+\M414. \P$\X414:Complement the \|y coordinates of the cubic between \\{pp} and~%
+\\{qq}\X\S$\6
+\&{begin} \37$\\{negate}(\\{y\_coord}(\\{pp}))$;\5
+$\\{negate}(\\{right\_y}(\\{pp}))$;\5
+$\\{negate}(\\{left\_y}(\\{qq}))$;\6
+$\\{negate}(\\{del1})$;\5
+$\\{negate}(\\{del2})$;\5
+$\\{negate}(\\{del3})$;\6
+$\\{negate}(\\{dest\_y})$;\5
+$\\{right\_type}(\\{pp})\K\\{right\_type}(\\{pp})+\\{negate\_y}$;\6
+\&{end}\par
+\Us413\ET417.\fi
+
+\M415. \P$\X415:Subdivide the cubic with respect to $y'$, possibly twice\X\S$\6
+\&{begin} \37$\\{split\_cubic}(\\{pp},\39\|t,\39\\{dest\_x},\39\\{dest\_y})$;\5
+$\|r\K\\{link}(\\{pp})$;\6
+\&{if} $\\{right\_type}(\|r)>\\{negate\_y}$ \1\&{then}\5
+$\\{right\_type}(\|r)\K\\{right\_type}(\|r)-\\{negate\_y}$\6
+\4\&{else} $\\{right\_type}(\|r)\K\\{right\_type}(\|r)+\\{negate\_y}$;\2\6
+\&{if} $\\{y\_coord}(\|r)<\\{y\_coord}(\\{pp})$ \1\&{then}\5
+$\\{y\_coord}(\|r)\K\\{y\_coord}(\\{pp})$;\2\6
+$\\{left\_y}(\|r)\K\\{y\_coord}(\|r)$;\6
+\&{if} $\\{right\_y}(\\{pp})>\\{y\_coord}(\|r)$ \1\&{then}\5
+$\\{right\_y}(\\{pp})\K\\{y\_coord}(\|r)$;\C{we always have $\\{y\_coord}(%
+\\{pp})\L\\{right\_y}(\\{pp})$}\2\6
+$\\{negate}(\\{y\_coord}(\|r))$;\5
+$\\{right\_y}(\|r)\K\\{y\_coord}(\|r)$;\5
+$\\{negate}(\\{left\_y}(\\{qq}))$;\5
+$\\{negate}(\\{dest\_y})$;\6
+\&{if} $\\{x\_coord}(\|r)<\\{x\_coord}(\\{pp})$ \1\&{then}\5
+$\\{x\_coord}(\|r)\K\\{x\_coord}(\\{pp})$\6
+\4\&{else} \&{if} $\\{x\_coord}(\|r)>\\{dest\_x}$ \1\&{then}\5
+$\\{x\_coord}(\|r)\K\\{dest\_x}$;\2\2\6
+\&{if} $\\{left\_x}(\|r)>\\{x\_coord}(\|r)$ \1\&{then}\6
+\&{begin} \37$\\{left\_x}(\|r)\K\\{x\_coord}(\|r)$;\6
+\&{if} $\\{right\_x}(\\{pp})>\\{x\_coord}(\|r)$ \1\&{then}\5
+$\\{right\_x}(\\{pp})\K\\{x\_coord}(\|r)$;\2\6
+\&{end};\2\6
+\&{if} $\\{right\_x}(\|r)<\\{x\_coord}(\|r)$ \1\&{then}\6
+\&{begin} \37$\\{right\_x}(\|r)\K\\{x\_coord}(\|r)$;\6
+\&{if} $\\{left\_x}(\\{qq})<\\{x\_coord}(\|r)$ \1\&{then}\5
+$\\{left\_x}(\\{qq})\K\\{x\_coord}(\|r)$;\2\6
+\&{end};\2\6
+$\\{del2}\K\\{t\_of\_the\_way}(\\{del2})(\\{del3})$;\C{now $0,\\{del2},%
+\\{del3}$ represent $y'$ on the remaining interval}\6
+\&{if} $\\{del2}>0$ \1\&{then}\5
+$\\{del2}\K0$;\2\6
+$\|t\K\\{crossing\_point}(0,\39-\\{del2},\39-\\{del3})$;\6
+\&{if} $\|t<\\{fraction\_one}$ \1\&{then}\5
+\X416:Subdivide the cubic a second time with respect to $y'$\X\6
+\4\&{else} \&{begin} \37\&{if} $\\{y\_coord}(\|r)>\\{dest\_y}$ \1\&{then}\6
+\&{begin} \37$\\{y\_coord}(\|r)\K\\{dest\_y}$;\5
+$\\{left\_y}(\|r)\K-\\{y\_coord}(\|r)$;\5
+$\\{right\_y}(\|r)\K\\{y\_coord}(\|r)$;\6
+\&{end};\2\6
+\&{if} $\\{left\_y}(\\{qq})>\\{dest\_y}$ \1\&{then}\5
+$\\{left\_y}(\\{qq})\K\\{dest\_y}$\6
+\4\&{else} \&{if} $\\{left\_y}(\\{qq})<\\{y\_coord}(\|r)$ \1\&{then}\5
+$\\{left\_y}(\\{qq})\K\\{y\_coord}(\|r)$;\2\2\6
+\&{end};\2\6
+\&{end}\par
+\U413.\fi
+
+\M416. \P$\X416:Subdivide the cubic a second time with respect to $y'$\X\S$\6
+\&{begin} \37$\\{split\_cubic}(\|r,\39\|t,\39\\{dest\_x},\39\\{dest\_y})$;\5
+$\|s\K\\{link}(\|r)$;\6
+\&{if} $\\{y\_coord}(\|s)<\\{dest\_y}$ \1\&{then}\5
+$\\{y\_coord}(\|s)\K\\{dest\_y}$;\2\6
+\&{if} $\\{y\_coord}(\|s)<\\{y\_coord}(\|r)$ \1\&{then}\5
+$\\{y\_coord}(\|s)\K\\{y\_coord}(\|r)$;\2\6
+$\\{right\_type}(\|s)\K\\{right\_type}(\\{pp})$;\5
+$\\{left\_y}(\|s)\K\\{y\_coord}(\|s)$;\C{now $\\{y\_coord}(\|r)=\\{right\_y}(%
+\|r)\L\\{left\_y}(\|s)$}\6
+\&{if} $\\{left\_y}(\\{qq})<\\{dest\_y}$ \1\&{then}\5
+$\\{left\_y}(\\{qq})\K-\\{dest\_y}$\6
+\4\&{else} \&{if} $\\{left\_y}(\\{qq})>\\{y\_coord}(\|s)$ \1\&{then}\5
+$\\{left\_y}(\\{qq})\K-\\{y\_coord}(\|s)$\6
+\4\&{else} $\\{negate}(\\{left\_y}(\\{qq}))$;\2\2\6
+$\\{negate}(\\{y\_coord}(\|s))$;\5
+$\\{right\_y}(\|s)\K\\{y\_coord}(\|s)$;\6
+\&{if} $\\{x\_coord}(\|s)<\\{x\_coord}(\|r)$ \1\&{then}\5
+$\\{x\_coord}(\|s)\K\\{x\_coord}(\|r)$\6
+\4\&{else} \&{if} $\\{x\_coord}(\|s)>\\{dest\_x}$ \1\&{then}\5
+$\\{x\_coord}(\|s)\K\\{dest\_x}$;\2\2\6
+\&{if} $\\{left\_x}(\|s)>\\{x\_coord}(\|s)$ \1\&{then}\6
+\&{begin} \37$\\{left\_x}(\|s)\K\\{x\_coord}(\|s)$;\6
+\&{if} $\\{right\_x}(\|r)>\\{x\_coord}(\|s)$ \1\&{then}\5
+$\\{right\_x}(\|r)\K\\{x\_coord}(\|s)$;\2\6
+\&{end};\2\6
+\&{if} $\\{right\_x}(\|s)<\\{x\_coord}(\|s)$ \1\&{then}\6
+\&{begin} \37$\\{right\_x}(\|s)\K\\{x\_coord}(\|s)$;\6
+\&{if} $\\{left\_x}(\\{qq})<\\{x\_coord}(\|s)$ \1\&{then}\5
+$\\{left\_x}(\\{qq})\K\\{x\_coord}(\|s)$;\2\6
+\&{end};\2\6
+\&{end}\par
+\U415.\fi
+
+\M417. If the cubic is constant in $y$ and increasing in $x$, we have
+classified
+it as traveling in the first octant. If the cubic is constant
+in~$y$ and decreasing in~$x$, it is desirable to classify it as traveling
+in the fifth octant (not the fourth), because autorounding will be consistent
+with respect to doublepaths only if the octant number changes by four when
+the path is reversed. Therefore we negate the $y$~coordinates
+when they are constant but the curve is decreasing in~$x$; this gives
+the desired result except in pathological paths.
+
+If the cubic is ``dead,'' i.e., constant in both \|x and \|y, we remove
+it unless it is the only cubic in the entire path. We \&{goto} \\{continue}
+if it wasn't the final cubic, so that the test $\|p=\\{cur\_spec}$ does not
+falsely imply that all cubics have been processed.
+
+\Y\P$\4\X417:Do any special actions needed when \|y is constant; \&{return} or %
+\&{goto} \\{continue} if a dead cubic from \|p to \|q is removed\X\S$\6
+\&{if} $\\{constant\_x}$ \1\&{then}\C{$\|p=\\{pp}$, $\|q=\\{qq}$, and the cubic
+is dead}\6
+\&{begin} \37\&{if} $\|q\I\|p$ \1\&{then}\6
+\&{begin} \37$\\{remove\_cubic}(\|p)$;\C{remove the dead cycle and recycle node
+\|q}\6
+\&{if} $\\{cur\_spec}\I\|q$ \1\&{then}\5
+\&{goto} \37\\{continue}\6
+\4\&{else} \&{begin} \37$\\{cur\_spec}\K\|p$;\5
+\&{return};\6
+\&{end};\C{the final cubic was dead and is gone}\2\6
+\&{end};\2\6
+\&{end}\6
+\4\&{else} \&{if} $\R\\{odd}(\\{right\_type}(\\{pp}))$ \1\&{then}\C{the $x$
+coordinates were negated}\6
+\X414:Complement the \|y coordinates of the cubic between \\{pp} and~\\{qq}\X\2%
+\2\par
+\U413.\fi
+
+\M418. A similar correction to octant codes deserves to be made when \|x is
+constant and \|y is decreasing.
+
+\Y\P$\4\X418:Correct the octant code in segments with decreasing \|y\X\S$\6
+\&{begin} \37$\\{pp}\K\|p$;\6
+\1\&{repeat} \37$\\{qq}\K\\{link}(\\{pp})$;\6
+\&{if} $\\{right\_type}(\\{pp})>\\{negate\_y}$ \1\&{then}\C{the $y$ coordinates
+were negated}\6
+\&{begin} \37$\\{right\_type}(\\{pp})\K\\{right\_type}(\\{pp})+\\{negate\_x}$;\5
+$\\{negate}(\\{x\_coord}(\\{pp}))$;\5
+$\\{negate}(\\{right\_x}(\\{pp}))$;\5
+$\\{negate}(\\{left\_x}(\\{qq}))$;\6
+\&{end};\2\6
+$\\{pp}\K\\{qq}$;\6
+\4\&{until}\5
+$\\{pp}=\|q$;\2\6
+\&{end}\par
+\U413.\fi
+
+\M419. Finally, the process of subdividing to make $x'\G y'$ is like the other
+two subdivisions, with a few new twists. We skew the coordinates at this time.
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{octant\_subdivide};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\C{for traversing the
+lists}\6
+$\\{del1},\39\\{del2},\39\\{del3},\39\\{del},\39\\{dmax}$: \37\\{scaled};%
+\C{proportional to the control points of a quadratic derived from a cubic}\6
+\|t: \37\\{fraction};\C{where a quadratic crosses zero}\6
+$\\{dest\_x},\39\\{dest\_y}$: \37\\{scaled};\C{final values of \|x and \|y in
+the current cubic}\2\6
+\&{begin} \37$\|p\K\\{cur\_spec}$;\6
+\1\&{repeat} \37$\|q\K\\{link}(\|p)$;\6
+$\\{x\_coord}(\|p)\K\\{x\_coord}(\|p)-\\{y\_coord}(\|p)$;\5
+$\\{right\_x}(\|p)\K\\{right\_x}(\|p)-\\{right\_y}(\|p)$;\5
+$\\{left\_x}(\|q)\K\\{left\_x}(\|q)-\\{left\_y}(\|q)$;\6
+\X420:Subdivide the cubic between \|p and \|q so that the results travel toward
+the first octant\X;\6
+$\|p\K\|q$;\6
+\4\&{until}\5
+$\|p=\\{cur\_spec}$;\2\6
+\&{end};\par
+\fi
+
+\M420. \P$\X420:Subdivide the cubic between \|p and \|q so that the results
+travel toward the first octant\X\S$\6
+\X421:Set up the variables $(\\{del1},\\{del2},\\{del3})$ to represent $x'-y'$%
+\X;\6
+\X408:Scale up \\{del1}, \\{del2}, and \\{del3} for greater accuracy; also set %
+\\{del} to the first nonzero element of $(\\{del1},\\{del2},\\{del3})$\X;\6
+\&{if} $\\{del}\I0$ \1\&{then}\C{they weren't all zero}\6
+\&{begin} \37\&{if} $\\{del}<0$ \1\&{then}\5
+\X423:Swap the \|x and \|y coordinates of the cubic between \|p and~\|q\X;\2\6
+$\|t\K\\{crossing\_point}(\\{del1},\39\\{del2},\39\\{del3})$;\6
+\&{if} $\|t<\\{fraction\_one}$ \1\&{then}\5
+\X424:Subdivide the cubic with respect to $x'-y'$, possibly twice\X;\2\6
+\&{end}\2\par
+\U419.\fi
+
+\M421. \P$\X421:Set up the variables $(\\{del1},\\{del2},\\{del3})$ to
+represent $x'-y'$\X\S$\6
+\&{if} $\|q=\\{cur\_spec}$ \1\&{then}\6
+\&{begin} \37$\\{unskew}(\\{x\_coord}(\|q),\39\\{y\_coord}(\|q),\39\\{right%
+\_type}(\|q))$;\5
+$\\{skew}(\\{cur\_x},\39\\{cur\_y},\39\\{right\_type}(\|p))$;\5
+$\\{dest\_x}\K\\{cur\_x}$;\5
+$\\{dest\_y}\K\\{cur\_y}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{abnegate}(\\{x\_coord}(\|q),\39\\{y\_coord}(\|q),%
+\39\\{right\_type}(\|q),\39\\{right\_type}(\|p))$;\5
+$\\{dest\_x}\K\\{cur\_x}-\\{cur\_y}$;\5
+$\\{dest\_y}\K\\{cur\_y}$;\6
+\&{end};\2\6
+$\\{del1}\K\\{right\_x}(\|p)-\\{x\_coord}(\|p)$;\5
+$\\{del2}\K\\{left\_x}(\|q)-\\{right\_x}(\|p)$;\5
+$\\{del3}\K\\{dest\_x}-\\{left\_x}(\|q)$\par
+\U420.\fi
+
+\M422. The swapping here doesn't simply interchange \|x and \|y values,
+because the coordinates are skewed. It turns out that this is easier
+than ordinary swapping, because it can be done in two assignment statements
+rather than three.
+
+\fi
+
+\M423. \P$\X423:Swap the \|x and \|y coordinates of the cubic between \|p and~%
+\|q\X\S$\6
+\&{begin} \37$\\{y\_coord}(\|p)\K\\{x\_coord}(\|p)+\\{y\_coord}(\|p)$;\5
+$\\{negate}(\\{x\_coord}(\|p))$;\6
+$\\{right\_y}(\|p)\K\\{right\_x}(\|p)+\\{right\_y}(\|p)$;\5
+$\\{negate}(\\{right\_x}(\|p))$;\6
+$\\{left\_y}(\|q)\K\\{left\_x}(\|q)+\\{left\_y}(\|q)$;\5
+$\\{negate}(\\{left\_x}(\|q))$;\6
+$\\{negate}(\\{del1})$;\5
+$\\{negate}(\\{del2})$;\5
+$\\{negate}(\\{del3})$;\6
+$\\{dest\_y}\K\\{dest\_x}+\\{dest\_y}$;\5
+$\\{negate}(\\{dest\_x})$;\6
+$\\{right\_type}(\|p)\K\\{right\_type}(\|p)+\\{switch\_x\_and\_y}$;\6
+\&{end}\par
+\U420.\fi
+
+\M424. A somewhat tedious case analysis is carried out here to make sure that
+nasty rounding errors don't destroy our assumptions of monotonicity.
+
+\Y\P$\4\X424:Subdivide the cubic with respect to $x'-y'$, possibly twice\X\S$\6
+\&{begin} \37$\\{split\_cubic}(\|p,\39\|t,\39\\{dest\_x},\39\\{dest\_y})$;\5
+$\|r\K\\{link}(\|p)$;\6
+\&{if} $\\{right\_type}(\|r)>\\{switch\_x\_and\_y}$ \1\&{then}\5
+$\\{right\_type}(\|r)\K\\{right\_type}(\|r)-\\{switch\_x\_and\_y}$\6
+\4\&{else} $\\{right\_type}(\|r)\K\\{right\_type}(\|r)+\\{switch\_x\_and\_y}$;%
+\2\6
+\&{if} $\\{y\_coord}(\|r)<\\{y\_coord}(\|p)$ \1\&{then}\5
+$\\{y\_coord}(\|r)\K\\{y\_coord}(\|p)$\6
+\4\&{else} \&{if} $\\{y\_coord}(\|r)>\\{dest\_y}$ \1\&{then}\5
+$\\{y\_coord}(\|r)\K\\{dest\_y}$;\2\2\6
+\&{if} $\\{x\_coord}(\|p)+\\{y\_coord}(\|r)>\\{dest\_x}+\\{dest\_y}$ \1\&{then}%
+\5
+$\\{y\_coord}(\|r)\K\\{dest\_x}+\\{dest\_y}-\\{x\_coord}(\|p)$;\2\6
+\&{if} $\\{left\_y}(\|r)>\\{y\_coord}(\|r)$ \1\&{then}\6
+\&{begin} \37$\\{left\_y}(\|r)\K\\{y\_coord}(\|r)$;\6
+\&{if} $\\{right\_y}(\|p)>\\{y\_coord}(\|r)$ \1\&{then}\5
+$\\{right\_y}(\|p)\K\\{y\_coord}(\|r)$;\2\6
+\&{end};\2\6
+\&{if} $\\{right\_y}(\|r)<\\{y\_coord}(\|r)$ \1\&{then}\6
+\&{begin} \37$\\{right\_y}(\|r)\K\\{y\_coord}(\|r)$;\6
+\&{if} $\\{left\_y}(\|q)<\\{y\_coord}(\|r)$ \1\&{then}\5
+$\\{left\_y}(\|q)\K\\{y\_coord}(\|r)$;\2\6
+\&{end};\2\6
+\&{if} $\\{x\_coord}(\|r)<\\{x\_coord}(\|p)$ \1\&{then}\5
+$\\{x\_coord}(\|r)\K\\{x\_coord}(\|p)$\6
+\4\&{else} \&{if} $\\{x\_coord}(\|r)+\\{y\_coord}(\|r)>\\{dest\_x}+\\{dest\_y}$
+\1\&{then}\5
+$\\{x\_coord}(\|r)\K\\{dest\_x}+\\{dest\_y}-\\{y\_coord}(\|r)$;\2\2\6
+$\\{left\_x}(\|r)\K\\{x\_coord}(\|r)$;\6
+\&{if} $\\{right\_x}(\|p)>\\{x\_coord}(\|r)$ \1\&{then}\5
+$\\{right\_x}(\|p)\K\\{x\_coord}(\|r)$;\C{we always have $\\{x\_coord}(\|p)\L%
+\\{right\_x}(\|p)$}\2\6
+$\\{y\_coord}(\|r)\K\\{y\_coord}(\|r)+\\{x\_coord}(\|r)$;\5
+$\\{right\_y}(\|r)\K\\{right\_y}(\|r)+\\{x\_coord}(\|r)$;\6
+$\\{negate}(\\{x\_coord}(\|r))$;\5
+$\\{right\_x}(\|r)\K\\{x\_coord}(\|r)$;\6
+$\\{left\_y}(\|q)\K\\{left\_y}(\|q)+\\{left\_x}(\|q)$;\5
+$\\{negate}(\\{left\_x}(\|q))$;\6
+$\\{dest\_y}\K\\{dest\_y}+\\{dest\_x}$;\5
+$\\{negate}(\\{dest\_x})$;\6
+\&{if} $\\{right\_y}(\|r)<\\{y\_coord}(\|r)$ \1\&{then}\6
+\&{begin} \37$\\{right\_y}(\|r)\K\\{y\_coord}(\|r)$;\6
+\&{if} $\\{left\_y}(\|q)<\\{y\_coord}(\|r)$ \1\&{then}\5
+$\\{left\_y}(\|q)\K\\{y\_coord}(\|r)$;\2\6
+\&{end};\2\6
+$\\{del2}\K\\{t\_of\_the\_way}(\\{del2})(\\{del3})$;\C{now $0,\\{del2},%
+\\{del3}$ represent $x'-y'$ on the remaining interval}\6
+\&{if} $\\{del2}>0$ \1\&{then}\5
+$\\{del2}\K0$;\2\6
+$\|t\K\\{crossing\_point}(0,\39-\\{del2},\39-\\{del3})$;\6
+\&{if} $\|t<\\{fraction\_one}$ \1\&{then}\5
+\X425:Subdivide the cubic a second time with respect to $x'-y'$\X\6
+\4\&{else} \&{begin} \37\&{if} $\\{x\_coord}(\|r)>\\{dest\_x}$ \1\&{then}\6
+\&{begin} \37$\\{x\_coord}(\|r)\K\\{dest\_x}$;\5
+$\\{left\_x}(\|r)\K-\\{x\_coord}(\|r)$;\5
+$\\{right\_x}(\|r)\K\\{x\_coord}(\|r)$;\6
+\&{end};\2\6
+\&{if} $\\{left\_x}(\|q)>\\{dest\_x}$ \1\&{then}\5
+$\\{left\_x}(\|q)\K\\{dest\_x}$\6
+\4\&{else} \&{if} $\\{left\_x}(\|q)<\\{x\_coord}(\|r)$ \1\&{then}\5
+$\\{left\_x}(\|q)\K\\{x\_coord}(\|r)$;\2\2\6
+\&{end};\2\6
+\&{end}\par
+\U420.\fi
+
+\M425. \P$\X425:Subdivide the cubic a second time with respect to $x'-y'$\X\S$\6
+\&{begin} \37$\\{split\_cubic}(\|r,\39\|t,\39\\{dest\_x},\39\\{dest\_y})$;\5
+$\|s\K\\{link}(\|r)$;\6
+\&{if} $\\{y\_coord}(\|s)<\\{y\_coord}(\|r)$ \1\&{then}\5
+$\\{y\_coord}(\|s)\K\\{y\_coord}(\|r)$\6
+\4\&{else} \&{if} $\\{y\_coord}(\|s)>\\{dest\_y}$ \1\&{then}\5
+$\\{y\_coord}(\|s)\K\\{dest\_y}$;\2\2\6
+\&{if} $\\{x\_coord}(\|r)+\\{y\_coord}(\|s)>\\{dest\_x}+\\{dest\_y}$ \1\&{then}%
+\5
+$\\{y\_coord}(\|s)\K\\{dest\_x}+\\{dest\_y}-\\{x\_coord}(\|r)$;\2\6
+\&{if} $\\{left\_y}(\|s)>\\{y\_coord}(\|s)$ \1\&{then}\6
+\&{begin} \37$\\{left\_y}(\|s)\K\\{y\_coord}(\|s)$;\6
+\&{if} $\\{right\_y}(\|r)>\\{y\_coord}(\|s)$ \1\&{then}\5
+$\\{right\_y}(\|r)\K\\{y\_coord}(\|s)$;\2\6
+\&{end};\2\6
+\&{if} $\\{right\_y}(\|s)<\\{y\_coord}(\|s)$ \1\&{then}\6
+\&{begin} \37$\\{right\_y}(\|s)\K\\{y\_coord}(\|s)$;\6
+\&{if} $\\{left\_y}(\|q)<\\{y\_coord}(\|s)$ \1\&{then}\5
+$\\{left\_y}(\|q)\K\\{y\_coord}(\|s)$;\2\6
+\&{end};\2\6
+\&{if} $\\{x\_coord}(\|s)+\\{y\_coord}(\|s)>\\{dest\_x}+\\{dest\_y}$ \1\&{then}%
+\5
+$\\{x\_coord}(\|s)\K\\{dest\_x}+\\{dest\_y}-\\{y\_coord}(\|s)$\6
+\4\&{else} \&{begin} \37\&{if} $\\{x\_coord}(\|s)<\\{dest\_x}$ \1\&{then}\5
+$\\{x\_coord}(\|s)\K\\{dest\_x}$;\2\6
+\&{if} $\\{x\_coord}(\|s)<\\{x\_coord}(\|r)$ \1\&{then}\5
+$\\{x\_coord}(\|s)\K\\{x\_coord}(\|r)$;\2\6
+\&{end};\2\6
+$\\{right\_type}(\|s)\K\\{right\_type}(\|p)$;\5
+$\\{left\_x}(\|s)\K\\{x\_coord}(\|s)$;\C{now $\\{x\_coord}(\|r)=\\{right\_x}(%
+\|r)\L\\{left\_x}(\|s)$}\6
+\&{if} $\\{left\_x}(\|q)<\\{dest\_x}$ \1\&{then}\6
+\&{begin} \37$\\{left\_y}(\|q)\K\\{left\_y}(\|q)+\\{dest\_x}$;\5
+$\\{left\_x}(\|q)\K-\\{dest\_x}$;\ \&{end}\6
+\4\&{else} \&{if} $\\{left\_x}(\|q)>\\{x\_coord}(\|s)$ \1\&{then}\6
+\&{begin} \37$\\{left\_y}(\|q)\K\\{left\_y}(\|q)+\\{x\_coord}(\|s)$;\5
+$\\{left\_x}(\|q)\K-\\{x\_coord}(\|s)$;\ \&{end}\6
+\4\&{else} \&{begin} \37$\\{left\_y}(\|q)\K\\{left\_y}(\|q)+\\{left\_x}(\|q)$;\5
+$\\{negate}(\\{left\_x}(\|q))$;\ \&{end};\2\2\6
+$\\{y\_coord}(\|s)\K\\{y\_coord}(\|s)+\\{x\_coord}(\|s)$;\5
+$\\{right\_y}(\|s)\K\\{right\_y}(\|s)+\\{x\_coord}(\|s)$;\6
+$\\{negate}(\\{x\_coord}(\|s))$;\5
+$\\{right\_x}(\|s)\K\\{x\_coord}(\|s)$;\6
+\&{if} $\\{right\_y}(\|s)<\\{y\_coord}(\|s)$ \1\&{then}\6
+\&{begin} \37$\\{right\_y}(\|s)\K\\{y\_coord}(\|s)$;\6
+\&{if} $\\{left\_y}(\|q)<\\{y\_coord}(\|s)$ \1\&{then}\5
+$\\{left\_y}(\|q)\K\\{y\_coord}(\|s)$;\2\6
+\&{end};\2\6
+\&{end}\par
+\U424.\fi
+
+\M426. It's time now to consider ``autorounding,'' which tries to make
+horizontal,
+vertical, and diagonal tangents occur at places that will produce appropriate
+images after the curve is digitized.
+
+The first job is to fix things so that $\|x(\|t)$ is an integer multiple of the
+current ``granularity'' when the derivative $x'(t)$ crosses through zero.
+The given cyclic path contains regions where $x'(t)\G0$ and regions
+where $x'(t)\L0$. The \\{quadrant\_subdivide} routine is called into action
+before any of the path coordinates have been skewed, but some of them
+may have been negated. In regions where $x'(t)\G0$ we have $\\{right\_type}=%
+\\{first\_octant}$ or $\\{right\_type}=\\{eighth\_octant}$; in regions where
+$x'(t)\L0$,
+we have $\\{right\_type}=\\{fifth\_octant}$ or $\\{right\_type}=\\{fourth%
+\_octant}$.
+
+Within any such region the transformed $x$ values increase monotonically
+from, say, $x_0$ to~$x_1$. We want to modify things by applying a linear
+transformation to all $x$ coordinates in the region, after which
+the $x$ values will increase monotonically from round$(x_0)$ to round$(x_1)$.
+
+This rounding scheme sounds quite simple, and it usually is. But several
+complications can arise that might make the task more difficult. In the
+first place, autorounding is inappropriate at cusps where $x'$ jumps
+discontinuously past zero without ever being zero. In the second place,
+the current pen might be unsymmetric in such a way that $x$ coordinates
+should round differently when $x'$ becomes positive than when it becomes
+negative. These considerations imply that round$(x_0)$ might be greater
+than round$(x_1)$, even though $x_0\L x_1$; in such cases we do not want
+to carry out the linear transformation. Furthermore, it's possible to have
+round$(x_1)-\hbox{round} (x_0)$ positive but much greater than $x_1-x_0$;
+then the transformation might distort the curve drastically, and again we
+want to avoid it. Finally, the rounded points must be consistent between
+adjacent regions, hence we can't transform one region without knowing
+about its neighbors.
+
+To handle all these complications, we must first look at the whole
+cycle and choose rounded $x$ values that are ``safe.'' The following
+procedure does this: Given $m$~values $(b_0,b_1,\ldots,b_{m-1})$ before
+rounding and $m$~corresponding values $(a_0,a_1,\ldots,a_{m-1})$ that would
+be desirable after rounding, the \\{make\_safe} routine sets $a$'s to $b$'s
+if necessary so that $0\L(a\k-a_k)/(b\k-b_k)\L2$ afterwards. It is
+symmetric under cyclic permutation, reversal, and/or negation of the inputs.
+(Instead of \|a, \|b, and~\|m, the program uses the names \\{after},
+\\{before}, and \\{cur\_rounding\_ptr}.)
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{make\_safe};\6
+\4\&{var} \37\|k: \37$0\to\\{max\_wiggle}$;\C{runs through the list of inputs}\6
+\\{all\_safe}: \37\\{boolean};\C{does everything look OK so far?}\6
+\\{next\_a}: \37\\{scaled};\C{$\\{after}[\|k]$ before it might have changed}\6
+$\\{delta\_a},\39\\{delta\_b}$: \37\\{scaled};\C{$\\{after}[\|k+1]-\\{after}[%
+\|k]$ and $\\{before}[\|k+1]-\\{before}[\|k]$}\2\6
+\&{begin} \37$\\{before}[\\{cur\_rounding\_ptr}]\K\\{before}[0]$;\C{wrap
+around}\6
+$\\{node\_to\_round}[\\{cur\_rounding\_ptr}]\K\\{node\_to\_round}[0]$;\6
+\1\&{repeat} \37$\\{after}[\\{cur\_rounding\_ptr}]\K\\{after}[0]$;\5
+$\\{all\_safe}\K\\{true}$;\5
+$\\{next\_a}\K\\{after}[0]$;\6
+\&{for} $\|k\K0\mathrel{\&{to}}\\{cur\_rounding\_ptr}-1$ \1\&{do}\6
+\&{begin} \37$\\{delta\_b}\K\\{before}[\|k+1]-\\{before}[\|k]$;\6
+\&{if} $\\{delta\_b}\G0$ \1\&{then}\5
+$\\{delta\_a}\K\\{after}[\|k+1]-\\{next\_a}$\6
+\4\&{else} $\\{delta\_a}\K\\{next\_a}-\\{after}[\|k+1]$;\2\6
+$\\{next\_a}\K\\{after}[\|k+1]$;\6
+\&{if} $(\\{delta\_a}<0)\V(\\{delta\_a}>\\{abs}(\\{delta\_b}+\\{delta\_b}))$ \1%
+\&{then}\6
+\&{begin} \37$\\{all\_safe}\K\\{false}$;\5
+$\\{after}[\|k]\K\\{before}[\|k]$;\6
+\&{if} $\|k=\\{cur\_rounding\_ptr}-1$ \1\&{then}\5
+$\\{after}[0]\K\\{before}[0]$\6
+\4\&{else} $\\{after}[\|k+1]\K\\{before}[\|k+1]$;\2\6
+\&{end};\2\6
+\&{end};\2\6
+\4\&{until}\5
+\\{all\_safe};\2\6
+\&{end};\par
+\fi
+
+\M427. The global arrays used by \\{make\_safe} are accompanied by an array of
+pointers into the current knot list.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{before},\39\\{after}$: \37\&{array} $[0\to\\{max\_wiggle}]$ \1\&{of}\5
+\\{scaled};\C{data for \\{make\_safe}}\2\6
+\4\\{node\_to\_round}: \37\&{array} $[0\to\\{max\_wiggle}]$ \1\&{of}\5
+\\{pointer};\C{reference back to the path}\2\6
+\4\\{cur\_rounding\_ptr}: \37$0\to\\{max\_wiggle}$;\C{how many are being used}\6
+\4\\{max\_rounding\_ptr}: \37$0\to\\{max\_wiggle}$;\C{how many have been used}%
+\par
+\fi
+
+\M428. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{max\_rounding\_ptr}\K0$;\par
+\fi
+
+\M429. New entries go into the tables via the \\{before\_and\_after} routine:
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{before\_and\_after}(\|b,\39\|a:\\{scaled};\,\35\|p:%
+\\{pointer})$;\2\6
+\&{begin} \37\&{if} $\\{cur\_rounding\_ptr}=\\{max\_rounding\_ptr}$ \1\&{then}\6
+\&{if} $\\{max\_rounding\_ptr}<\\{max\_wiggle}$ \1\&{then}\5
+$\\{incr}(\\{max\_rounding\_ptr})$\6
+\4\&{else} $\\{overflow}(\.{"rounding\ table\ size"},\39\\{max\_wiggle})$;\2\2\6
+$\\{after}[\\{cur\_rounding\_ptr}]\K\|a$;\5
+$\\{before}[\\{cur\_rounding\_ptr}]\K\|b$;\5
+$\\{node\_to\_round}[\\{cur\_rounding\_ptr}]\K\|p$;\5
+$\\{incr}(\\{cur\_rounding\_ptr})$;\6
+\&{end};\par
+\fi
+
+\M430. A global variable called \\{cur\_gran} is used instead of $\\{internal}[%
+\\{granularity}]$, because we want to work with a number that's guaranteed to
+be positive.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{cur\_gran}: \37\\{scaled};\C{the current granularity (which normally is %
+\\{unity})}\par
+\fi
+
+\M431. The \\{good\_val} function computes a number \|a that's as close as
+possible to~\|b, with the property that $\|a+\|o$ is a multiple of
+\\{cur\_gran}.
+
+If we assume that \\{cur\_gran} is even (since it will in fact be a multiple
+of \\{unity} in all reasonable applications), we have the identity
+$\\{good\_val}(-\|b-1,-\|o)=-\\{good\_val}(\|b,\|o)$.
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\mathrel{+}\S$\6
+\4\&{function}\1\ \37$\\{good\_val}(\|b,\39\|o:\\{scaled})$: \37\\{scaled};\6
+\4\&{var} \37\|a: \37\\{scaled};\C{accumulator}\2\6
+\&{begin} \37$\|a\K\|b+\|o$;\6
+\&{if} $\|a\G0$ \1\&{then}\5
+$\|a\K\|a-(\|a\mathbin{\&{mod}}\\{cur\_gran})-\|o$\6
+\4\&{else} $\|a\K\|a+((-(\|a+1))\mathbin{\&{mod}}\\{cur\_gran})-\\{cur%
+\_gran}+1-\|o$;\2\6
+\&{if} $\|b-\|a<\|a+\\{cur\_gran}-\|b$ \1\&{then}\5
+$\\{good\_val}\K\|a$\6
+\4\&{else} $\\{good\_val}\K\|a+\\{cur\_gran}$;\2\6
+\&{end};\par
+\fi
+
+\M432. When we're rounding a doublepath, we might need to compromise between
+two opposing tendencies, if the pen thickness is not a multiple of the
+granularity. The following ``compromise'' adjustment, suggested by
+John Hobby, finds the best way out of the dilemma. (Only the value
+modulo \\{cur\_gran} is relevant in our applications, so the result turns
+out to be essentially symmetric in \|u and~\|v.)
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\mathrel{+}\S$\6
+\4\&{function}\1\ \37$\\{compromise}(\|u,\39\|v:\\{scaled})$: \37\\{scaled};\2%
+\6
+\&{begin} \37$\\{compromise}\K\\{half}(\\{good\_val}(\|u+\|u,\39-\|u-\|v))$;\6
+\&{end};\par
+\fi
+
+\M433. Here, then, is the procedure that rounds $x$ coordinates as described;
+it does the same for $y$ coordinates too, independently.
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{xy\_round};\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{list manipulation registers}\6
+$\|b,\39\|a$: \37\\{scaled};\C{before and after values}\6
+\\{pen\_edge}: \37\\{scaled};\C{offset that governs rounding}\6
+\\{alpha}: \37\\{fraction};\C{coefficient of linear transformation}\2\6
+\&{begin} \37$\\{cur\_gran}\K\\{abs}(\\{internal}[\\{granularity}])$;\6
+\&{if} $\\{cur\_gran}=0$ \1\&{then}\5
+$\\{cur\_gran}\K\\{unity}$;\2\6
+$\|p\K\\{cur\_spec}$;\5
+$\\{cur\_rounding\_ptr}\K0$;\6
+\1\&{repeat} \37$\|q\K\\{link}(\|p)$;\5
+\X434:If node \|q is a transition point for \|x coordinates, compute and save
+its before-and-after coordinates\X;\6
+$\|p\K\|q$;\6
+\4\&{until}\5
+$\|p=\\{cur\_spec}$;\2\6
+\&{if} $\\{cur\_rounding\_ptr}>0$ \1\&{then}\5
+\X436:Transform the \|x coordinates\X;\2\6
+$\|p\K\\{cur\_spec}$;\5
+$\\{cur\_rounding\_ptr}\K0$;\6
+\1\&{repeat} \37$\|q\K\\{link}(\|p)$;\5
+\X437:If node \|q is a transition point for \|y coordinates, compute and save
+its before-and-after coordinates\X;\6
+$\|p\K\|q$;\6
+\4\&{until}\5
+$\|p=\\{cur\_spec}$;\2\6
+\&{if} $\\{cur\_rounding\_ptr}>0$ \1\&{then}\5
+\X439:Transform the \|y coordinates\X;\2\6
+\&{end};\par
+\fi
+
+\M434. When \|x has been negated, the \\{octant} codes are even. We allow
+for an error of up to .01 pixel (i.e., 655 \\{scaled} units) in the
+derivative calculations at transition nodes.
+
+\Y\P$\4\X434:If node \|q is a transition point for \|x coordinates, compute and
+save its before-and-after coordinates\X\S$\6
+\&{if} $\\{odd}(\\{right\_type}(\|p))\I\\{odd}(\\{right\_type}(\|q))$ \1%
+\&{then}\6
+\&{begin} \37\&{if} $\\{odd}(\\{right\_type}(\|q))$ \1\&{then}\5
+$\|b\K\\{x\_coord}(\|q)$\ \&{else} $\|b\K-\\{x\_coord}(\|q)$;\2\6
+\&{if} $(\\{abs}(\\{x\_coord}(\|q)-\\{right\_x}(\|q))<655)\V\30(\\{abs}(\\{x%
+\_coord}(\|q)+\\{left\_x}(\|q))<655)$ \1\&{then}\5
+\X435:Compute before-and-after \|x values based on the current pen\X\6
+\4\&{else} $\|a\K\|b$;\2\6
+\&{if} $\\{abs}(\|a)>\\{max\_allowed}$ \1\&{then}\6
+\&{if} $\|a>0$ \1\&{then}\5
+$\|a\K\\{max\_allowed}$\ \&{else} $\|a\K-\\{max\_allowed}$;\2\2\6
+$\\{before\_and\_after}(\|b,\39\|a,\39\|q)$;\6
+\&{end}\2\par
+\U433.\fi
+
+\M435. When we study the data representation for pens, we'll learn that the
+\|x~coordinate of the current pen's west edge is
+$$\hbox{$\\{y\_coord}(\\{link}(\\{cur\_pen}+\\{seventh\_octant}))$},$$
+and that there are similar ways to address other important offsets.
+An ``\\{east\_west\_edge}'' is computed as a compromise between east and
+west, for use in doublepaths, in case the two edges have conflicting
+tendencies.
+
+\Y\P\D \37$\\{north\_edge}(\#)\S\\{y\_coord}(\\{link}(\#+\\{fourth\_octant}))$%
+\par
+\P\D \37$\\{south\_edge}(\#)\S\\{y\_coord}(\\{link}(\#+\\{first\_octant}))$\par
+\P\D \37$\\{east\_edge}(\#)\S\\{y\_coord}(\\{link}(\#+\\{second\_octant}))$\par
+\P\D \37$\\{west\_edge}(\#)\S\\{y\_coord}(\\{link}(\#+\\{seventh\_octant}))$\par
+\P\D \37$\\{north\_south\_edge}(\#)\S\\{mem}[\#+10].\\{int}$\C{compromise
+between north and south}\par
+\P\D \37$\\{east\_west\_edge}(\#)\S\\{mem}[\#+11].\\{int}$\C{compromise between
+east and west}\par
+\P\D \37$\\{NE\_SW\_edge}(\#)\S\\{mem}[\#+12].\\{int}$\C{compromise between
+northeast and southwest}\par
+\P\D \37$\\{NW\_SE\_edge}(\#)\S\\{mem}[\#+13].\\{int}$\C{compromise between
+northwest and southeast}\par
+\Y\P$\4\X435:Compute before-and-after \|x values based on the current pen\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_pen}=\\{null\_pen}$ \1\&{then}\5
+$\\{pen\_edge}\K0$\6
+\4\&{else} \&{if} $\\{cur\_path\_type}=\\{double\_path\_code}$ \1\&{then}\5
+$\\{pen\_edge}\K\\{compromise}(\\{east\_edge}(\\{cur\_pen}),\39\\{west\_edge}(%
+\\{cur\_pen}))$\6
+\4\&{else} \&{if} $\\{odd}(\\{right\_type}(\|q))$ \1\&{then}\5
+$\\{pen\_edge}\K\\{west\_edge}(\\{cur\_pen})$\6
+\4\&{else} $\\{pen\_edge}\K\\{east\_edge}(\\{cur\_pen})$;\2\2\2\6
+$\|a\K\\{good\_val}(\|b,\39\\{pen\_edge})$;\6
+\&{end}\par
+\U434.\fi
+
+\M436. The monotone transformation computed here with fixed-point arithmetic
+is
+guaranteed to take consecutive \\{before} values $(b,b')$ into consecutive
+\\{after} values $(a,a')$, even in the presence of rounding errors,
+as long as $\vert b-b'\vert<2^{28}$.
+
+\Y\P$\4\X436:Transform the \|x coordinates\X\S$\6
+\&{begin} \37\\{make\_safe};\6
+\1\&{repeat} \37$\\{decr}(\\{cur\_rounding\_ptr})$;\6
+\&{if} $(\\{after}[\\{cur\_rounding\_ptr}]\I\\{before}[\\{cur\_rounding\_ptr}])%
+\V\30(\\{after}[\\{cur\_rounding\_ptr}+1]\I\\{before}[\\{cur\_rounding%
+\_ptr}+1])$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{node\_to\_round}[\\{cur\_rounding\_ptr}]$;\6
+\&{if} $\\{odd}(\\{right\_type}(\|p))$ \1\&{then}\6
+\&{begin} \37$\|b\K\\{before}[\\{cur\_rounding\_ptr}]$;\5
+$\|a\K\\{after}[\\{cur\_rounding\_ptr}]$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|b\K-\\{before}[\\{cur\_rounding\_ptr}]$;\5
+$\|a\K-\\{after}[\\{cur\_rounding\_ptr}]$;\6
+\&{end};\2\6
+\&{if} $\\{before}[\\{cur\_rounding\_ptr}]=\\{before}[\\{cur\_rounding%
+\_ptr}+1]$ \1\&{then}\5
+$\\{alpha}\K\\{fraction\_one}$\6
+\4\&{else} $\\{alpha}\K\\{make\_fraction}(\\{after}[\\{cur\_rounding\_ptr}+1]-%
+\\{after}[\\{cur\_rounding\_ptr}],\39\30\\{before}[\\{cur\_rounding\_ptr}+1]-%
+\\{before}[\\{cur\_rounding\_ptr}])$;\2\6
+\1\&{repeat} \37$\\{x\_coord}(\|p)\K\\{take\_fraction}(\\{alpha},\39\\{x%
+\_coord}(\|p)-\|b)+\|a$;\5
+$\\{right\_x}(\|p)\K\\{take\_fraction}(\\{alpha},\39\\{right\_x}(\|p)-\|b)+%
+\|a$;\5
+$\|p\K\\{link}(\|p)$;\5
+$\\{left\_x}(\|p)\K\\{take\_fraction}(\\{alpha},\39\\{left\_x}(\|p)-\|b)+\|a$;\6
+\4\&{until}\5
+$\|p=\\{node\_to\_round}[\\{cur\_rounding\_ptr}+1]$;\2\6
+\&{end};\2\6
+\4\&{until}\5
+$\\{cur\_rounding\_ptr}=0$;\2\6
+\&{end}\par
+\U433.\fi
+
+\M437. When \|y has been negated, the \\{octant} codes are $>\\{negate\_y}$.
+Otherwise
+these routines are essentially identical to the routines for \|x coordinates
+that we have just seen.
+
+\Y\P$\4\X437:If node \|q is a transition point for \|y coordinates, compute and
+save its before-and-after coordinates\X\S$\6
+\&{if} $(\\{right\_type}(\|p)>\\{negate\_y})\I(\\{right\_type}(\|q)>\\{negate%
+\_y})$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{right\_type}(\|q)\L\\{negate\_y}$ \1\&{then}\5
+$\|b\K\\{y\_coord}(\|q)$\ \&{else} $\|b\K-\\{y\_coord}(\|q)$;\2\6
+\&{if} $(\\{abs}(\\{y\_coord}(\|q)-\\{right\_y}(\|q))<655)\V\30(\\{abs}(\\{y%
+\_coord}(\|q)+\\{left\_y}(\|q))<655)$ \1\&{then}\5
+\X438:Compute before-and-after \|y values based on the current pen\X\6
+\4\&{else} $\|a\K\|b$;\2\6
+\&{if} $\\{abs}(\|a)>\\{max\_allowed}$ \1\&{then}\6
+\&{if} $\|a>0$ \1\&{then}\5
+$\|a\K\\{max\_allowed}$\ \&{else} $\|a\K-\\{max\_allowed}$;\2\2\6
+$\\{before\_and\_after}(\|b,\39\|a,\39\|q)$;\6
+\&{end}\2\par
+\U433.\fi
+
+\M438. \P$\X438:Compute before-and-after \|y values based on the current pen\X%
+\S$\6
+\&{begin} \37\&{if} $\\{cur\_pen}=\\{null\_pen}$ \1\&{then}\5
+$\\{pen\_edge}\K0$\6
+\4\&{else} \&{if} $\\{cur\_path\_type}=\\{double\_path\_code}$ \1\&{then}\5
+$\\{pen\_edge}\K\\{compromise}(\\{north\_edge}(\\{cur\_pen}),\39\\{south%
+\_edge}(\\{cur\_pen}))$\6
+\4\&{else} \&{if} $\\{right\_type}(\|q)\L\\{negate\_y}$ \1\&{then}\5
+$\\{pen\_edge}\K\\{south\_edge}(\\{cur\_pen})$\6
+\4\&{else} $\\{pen\_edge}\K\\{north\_edge}(\\{cur\_pen})$;\2\2\2\6
+$\|a\K\\{good\_val}(\|b,\39\\{pen\_edge})$;\6
+\&{end}\par
+\U437.\fi
+
+\M439. \P$\X439:Transform the \|y coordinates\X\S$\6
+\&{begin} \37\\{make\_safe};\6
+\1\&{repeat} \37$\\{decr}(\\{cur\_rounding\_ptr})$;\6
+\&{if} $(\\{after}[\\{cur\_rounding\_ptr}]\I\\{before}[\\{cur\_rounding\_ptr}])%
+\V\30(\\{after}[\\{cur\_rounding\_ptr}+1]\I\\{before}[\\{cur\_rounding%
+\_ptr}+1])$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{node\_to\_round}[\\{cur\_rounding\_ptr}]$;\6
+\&{if} $\\{right\_type}(\|p)\L\\{negate\_y}$ \1\&{then}\6
+\&{begin} \37$\|b\K\\{before}[\\{cur\_rounding\_ptr}]$;\5
+$\|a\K\\{after}[\\{cur\_rounding\_ptr}]$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|b\K-\\{before}[\\{cur\_rounding\_ptr}]$;\5
+$\|a\K-\\{after}[\\{cur\_rounding\_ptr}]$;\6
+\&{end};\2\6
+\&{if} $\\{before}[\\{cur\_rounding\_ptr}]=\\{before}[\\{cur\_rounding%
+\_ptr}+1]$ \1\&{then}\5
+$\\{alpha}\K\\{fraction\_one}$\6
+\4\&{else} $\\{alpha}\K\\{make\_fraction}(\\{after}[\\{cur\_rounding\_ptr}+1]-%
+\\{after}[\\{cur\_rounding\_ptr}],\39\30\\{before}[\\{cur\_rounding\_ptr}+1]-%
+\\{before}[\\{cur\_rounding\_ptr}])$;\2\6
+\1\&{repeat} \37$\\{y\_coord}(\|p)\K\\{take\_fraction}(\\{alpha},\39\\{y%
+\_coord}(\|p)-\|b)+\|a$;\5
+$\\{right\_y}(\|p)\K\\{take\_fraction}(\\{alpha},\39\\{right\_y}(\|p)-\|b)+%
+\|a$;\5
+$\|p\K\\{link}(\|p)$;\5
+$\\{left\_y}(\|p)\K\\{take\_fraction}(\\{alpha},\39\\{left\_y}(\|p)-\|b)+\|a$;\6
+\4\&{until}\5
+$\|p=\\{node\_to\_round}[\\{cur\_rounding\_ptr}+1]$;\2\6
+\&{end};\2\6
+\4\&{until}\5
+$\\{cur\_rounding\_ptr}=0$;\2\6
+\&{end}\par
+\U433.\fi
+
+\M440. Rounding at diagonal tangents takes place after the subdivision into
+octants is complete, hence after the coordinates have been skewed.
+The details are somewhat tricky, because we want to round to points
+whose skewed coordinates are halfway between integer multiples of
+the granularity. Furthermore, both coordinates change when they are
+rounded; this means we need a generalization of the \\{make\_safe} routine,
+ensuring safety in both \|x and \|y.
+
+In spite of these extra complications, we can take comfort in the fact
+that the basic structure of the routine is the same as before.
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{diag\_round};\6
+\4\&{var} \37$\|p,\39\|q,\39\\{pp}$: \37\\{pointer};\C{list manipulation
+registers}\6
+$\|b,\39\|a,\39\\{bb},\39\\{aa},\39\|d,\39\|c,\39\\{dd},\39\\{cc}$: \37%
+\\{scaled};\C{before and after values}\6
+\\{pen\_edge}: \37\\{scaled};\C{offset that governs rounding}\6
+$\\{alpha},\39\\{beta}$: \37\\{fraction};\C{coefficients of linear
+transformation}\6
+\\{next\_a}: \37\\{scaled};\C{$\\{after}[\|k]$ before it might have changed}\6
+\\{all\_safe}: \37\\{boolean};\C{does everything look OK so far?}\6
+\|k: \37$0\to\\{max\_wiggle}$;\C{runs through before-and-after values}\6
+$\\{first\_x},\39\\{first\_y}$: \37\\{scaled};\C{coordinates before rounding}\2%
+\6
+\&{begin} \37$\|p\K\\{cur\_spec}$;\5
+$\\{cur\_rounding\_ptr}\K0$;\6
+\1\&{repeat} \37$\|q\K\\{link}(\|p)$;\5
+\X441:If node \|q is a transition point between octants, compute and save its
+before-and-after coordinates\X;\6
+$\|p\K\|q$;\6
+\4\&{until}\5
+$\|p=\\{cur\_spec}$;\2\6
+\&{if} $\\{cur\_rounding\_ptr}>0$ \1\&{then}\5
+\X444:Transform the skewed coordinates\X;\2\6
+\&{end};\par
+\fi
+
+\M441. We negate the skewed \|x coordinates in the before-and-after table when
+the octant code is greater than \\{switch\_x\_and\_y}.
+
+\Y\P$\4\X441:If node \|q is a transition point between octants, compute and
+save its before-and-after coordinates\X\S$\6
+\&{if} $\\{right\_type}(\|p)\I\\{right\_type}(\|q)$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{right\_type}(\|q)>\\{switch\_x\_and\_y}$ \1\&{then}\5
+$\|b\K-\\{x\_coord}(\|q)$\6
+\4\&{else} $\|b\K\\{x\_coord}(\|q)$;\2\6
+\&{if} $\\{abs}(\\{right\_type}(\|q)-\\{right\_type}(\|p))=\\{switch\_x\_and%
+\_y}$ \1\&{then}\6
+\&{if} $(\\{abs}(\\{x\_coord}(\|q)-\\{right\_x}(\|q))<655)\V(\\{abs}(\\{x%
+\_coord}(\|q)+\\{left\_x}(\|q))<655)$ \1\&{then}\5
+\X442:Compute a good coordinate at a diagonal transition\X\6
+\4\&{else} $\|a\K\|b$\2\6
+\4\&{else} $\|a\K\|b$;\2\6
+$\\{before\_and\_after}(\|b,\39\|a,\39\|q)$;\6
+\&{end}\2\par
+\U440.\fi
+
+\M442. In octants whose code number is even, $x$~has been
+negated; we want to round ambiguous cases downward instead of upward,
+so that the rounding will be consistent with octants whose code
+number is odd. This downward bias can be achieved by
+subtracting~1 from the first argument of \\{good\_val}.
+
+\Y\P\D \37$\\{diag\_offset}(\#)\S\\{x\_coord}(\\{knil}(\\{link}(\\{cur\_pen}+%
+\#)))$\par
+\Y\P$\4\X442:Compute a good coordinate at a diagonal transition\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_pen}=\\{null\_pen}$ \1\&{then}\5
+$\\{pen\_edge}\K0$\6
+\4\&{else} \&{if} $\\{cur\_path\_type}=\\{double\_path\_code}$ \1\&{then}\5
+\X443:Compute a compromise \\{pen\_edge}\X\6
+\4\&{else} \&{if} $\\{right\_type}(\|q)\L\\{switch\_x\_and\_y}$ \1\&{then}\5
+$\\{pen\_edge}\K\\{diag\_offset}(\\{right\_type}(\|q))$\6
+\4\&{else} $\\{pen\_edge}\K-\\{diag\_offset}(\\{right\_type}(\|q))$;\2\2\2\6
+\&{if} $\\{odd}(\\{right\_type}(\|q))$ \1\&{then}\5
+$\|a\K\\{good\_val}(\|b,\39\\{pen\_edge}+\\{half}(\\{cur\_gran}))$\6
+\4\&{else} $\|a\K\\{good\_val}(\|b-1,\39\\{pen\_edge}+\\{half}(\\{cur%
+\_gran}))$;\2\6
+\&{end}\par
+\U441.\fi
+
+\M443. (It seems a shame to compute these compromise offsets repeatedly. The
+author would have stored them directly in the pen data structure, if the
+granularity had been constant.)
+
+\Y\P$\4\X443:Compute a compromise \\{pen\_edge}\X\S$\6
+\&{case} $\\{right\_type}(\|q)$ \1\&{of}\6
+\4$\\{first\_octant},\39\\{second\_octant}$: \37$\\{pen\_edge}\K\\{compromise}(%
+\\{diag\_offset}(\\{first\_octant}),\39\30-\\{diag\_offset}(\\{fifth%
+\_octant}))$;\6
+\4$\\{fifth\_octant},\39\\{sixth\_octant}$: \37$\\{pen\_edge}\K-\\{compromise}(%
+\\{diag\_offset}(\\{first\_octant}),\39\30-\\{diag\_offset}(\\{fifth%
+\_octant}))$;\6
+\4$\\{third\_octant},\39\\{fourth\_octant}$: \37$\\{pen\_edge}\K\\{compromise}(%
+\\{diag\_offset}(\\{fourth\_octant}),\39\30-\\{diag\_offset}(\\{eighth%
+\_octant}))$;\6
+\4$\\{seventh\_octant},\39\\{eighth\_octant}$: \37$\\{pen\_edge}\K-%
+\\{compromise}(\\{diag\_offset}(\\{fourth\_octant}),\39\30-\\{diag\_offset}(%
+\\{eighth\_octant}))$;\2\6
+\&{end}\C{there are no other cases}\par
+\U442.\fi
+
+\M444. \P$\X444:Transform the skewed coordinates\X\S$\6
+\&{begin} \37$\|p\K\\{node\_to\_round}[0]$;\5
+$\\{first\_x}\K\\{x\_coord}(\|p)$;\5
+$\\{first\_y}\K\\{y\_coord}(\|p)$;\5
+\X446:Make sure that all the diagonal roundings are safe\X;\6
+\&{for} $\|k\K0\mathrel{\&{to}}\\{cur\_rounding\_ptr}-1$ \1\&{do}\6
+\&{begin} \37$\|a\K\\{after}[\|k]$;\5
+$\|b\K\\{before}[\|k]$;\5
+$\\{aa}\K\\{after}[\|k+1]$;\5
+$\\{bb}\K\\{before}[\|k+1]$;\6
+\&{if} $(\|a\I\|b)\V(\\{aa}\I\\{bb})$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{node\_to\_round}[\|k]$;\5
+$\\{pp}\K\\{node\_to\_round}[\|k+1]$;\5
+\X445:Determine the before-and-after values of both coordinates\X;\6
+\&{if} $\|b=\\{bb}$ \1\&{then}\5
+$\\{alpha}\K\\{fraction\_one}$\6
+\4\&{else} $\\{alpha}\K\\{make\_fraction}(\\{aa}-\|a,\39\\{bb}-\|b)$;\2\6
+\&{if} $\|d=\\{dd}$ \1\&{then}\5
+$\\{beta}\K\\{fraction\_one}$\6
+\4\&{else} $\\{beta}\K\\{make\_fraction}(\\{cc}-\|c,\39\\{dd}-\|d)$;\2\6
+\1\&{repeat} \37$\\{x\_coord}(\|p)\K\\{take\_fraction}(\\{alpha},\39\\{x%
+\_coord}(\|p)-\|b)+\|a$;\5
+$\\{y\_coord}(\|p)\K\\{take\_fraction}(\\{beta},\39\\{y\_coord}(\|p)-\|d)+\|c$;%
+\5
+$\\{right\_x}(\|p)\K\\{take\_fraction}(\\{alpha},\39\\{right\_x}(\|p)-\|b)+%
+\|a$;\5
+$\\{right\_y}(\|p)\K\\{take\_fraction}(\\{beta},\39\\{right\_y}(\|p)-\|d)+\|c$;%
+\5
+$\|p\K\\{link}(\|p)$;\5
+$\\{left\_x}(\|p)\K\\{take\_fraction}(\\{alpha},\39\\{left\_x}(\|p)-\|b)+\|a$;\5
+$\\{left\_y}(\|p)\K\\{take\_fraction}(\\{beta},\39\\{left\_y}(\|p)-\|d)+\|c$;\6
+\4\&{until}\5
+$\|p=\\{pp}$;\2\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end}\par
+\U440.\fi
+
+\M445. In node \|p, the coordinates $(\|b,\|d)$ will be rounded to $(\|a,\|c)$;
+in node \\{pp}, the coordinates $(\\{bb},\\{dd})$ will be rounded to $(\\{aa},%
+\\{cc})$.
+(We transform the values from node \\{pp} so that they agree with the
+conventions of node \|p.)
+
+If $\\{aa}\I\\{bb}$, we know that $\\{abs}(\\{right\_type}(\|p)-\\{right%
+\_type}(\\{pp}))=\\{switch\_x\_and\_y}$.
+
+\Y\P$\4\X445:Determine the before-and-after values of both coordinates\X\S$\6
+\&{if} $\\{aa}=\\{bb}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{pp}=\\{node\_to\_round}[0]$ \1\&{then}\5
+$\\{unskew}(\\{first\_x},\39\\{first\_y},\39\\{right\_type}(\\{pp}))$\6
+\4\&{else} $\\{unskew}(\\{x\_coord}(\\{pp}),\39\\{y\_coord}(\\{pp}),\39\\{right%
+\_type}(\\{pp}))$;\2\6
+$\\{skew}(\\{cur\_x},\39\\{cur\_y},\39\\{right\_type}(\|p))$;\5
+$\\{bb}\K\\{cur\_x}$;\5
+$\\{aa}\K\\{bb}$;\5
+$\\{dd}\K\\{cur\_y}$;\5
+$\\{cc}\K\\{dd}$;\6
+\&{if} $\\{right\_type}(\|p)>\\{switch\_x\_and\_y}$ \1\&{then}\6
+\&{begin} \37$\|b\K-\|b$;\5
+$\|a\K-\|a$;\6
+\&{end};\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{right\_type}(\|p)>\\{switch\_x\_and\_y}$ \1%
+\&{then}\6
+\&{begin} \37$\\{bb}\K-\\{bb}$;\5
+$\\{aa}\K-\\{aa}$;\5
+$\|b\K-\|b$;\5
+$\|a\K-\|a$;\6
+\&{end};\2\6
+\&{if} $\\{pp}=\\{node\_to\_round}[0]$ \1\&{then}\5
+$\\{dd}\K\\{first\_y}-\\{bb}$\ \&{else} $\\{dd}\K\\{y\_coord}(\\{pp})-\\{bb}$;%
+\2\6
+\&{if} $\\{odd}(\\{aa}-\\{bb})$ \1\&{then}\6
+\&{if} $\\{right\_type}(\|p)>\\{switch\_x\_and\_y}$ \1\&{then}\5
+$\\{cc}\K\\{dd}-\\{half}(\\{aa}-\\{bb}+1)$\6
+\4\&{else} $\\{cc}\K\\{dd}-\\{half}(\\{aa}-\\{bb}-1)$\2\6
+\4\&{else} $\\{cc}\K\\{dd}-\\{half}(\\{aa}-\\{bb})$;\2\6
+\&{end};\2\6
+$\|d\K\\{y\_coord}(\|p)$;\6
+\&{if} $\\{odd}(\|a-\|b)$ \1\&{then}\6
+\&{if} $\\{right\_type}(\|p)>\\{switch\_x\_and\_y}$ \1\&{then}\5
+$\|c\K\|d-\\{half}(\|a-\|b-1)$\6
+\4\&{else} $\|c\K\|d-\\{half}(\|a-\|b+1)$\2\6
+\4\&{else} $\|c\K\|d-\\{half}(\|a-\|b)$\2\par
+\Us444\ET446.\fi
+
+\M446. \P$\X446:Make sure that all the diagonal roundings are safe\X\S$\6
+$\\{before}[\\{cur\_rounding\_ptr}]\K\\{before}[0]$;\C{cf.~\\{make\_safe}}\6
+$\\{node\_to\_round}[\\{cur\_rounding\_ptr}]\K\\{node\_to\_round}[0]$;\6
+\1\&{repeat} \37$\\{after}[\\{cur\_rounding\_ptr}]\K\\{after}[0]$;\5
+$\\{all\_safe}\K\\{true}$;\5
+$\\{next\_a}\K\\{after}[0]$;\6
+\&{for} $\|k\K0\mathrel{\&{to}}\\{cur\_rounding\_ptr}-1$ \1\&{do}\6
+\&{begin} \37$\|a\K\\{next\_a}$;\5
+$\|b\K\\{before}[\|k]$;\5
+$\\{next\_a}\K\\{after}[\|k+1]$;\5
+$\\{aa}\K\\{next\_a}$;\5
+$\\{bb}\K\\{before}[\|k+1]$;\6
+\&{if} $(\|a\I\|b)\V(\\{aa}\I\\{bb})$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{node\_to\_round}[\|k]$;\5
+$\\{pp}\K\\{node\_to\_round}[\|k+1]$;\5
+\X445:Determine the before-and-after values of both coordinates\X;\6
+\&{if} $(\\{aa}<\|a)\V(\\{cc}<\|c)\V(\\{aa}-\|a>2\ast(\\{bb}-\|b))\V(\\{cc}-%
+\|c>2\ast(\\{dd}-\|d))$ \1\&{then}\6
+\&{begin} \37$\\{all\_safe}\K\\{false}$;\5
+$\\{after}[\|k]\K\\{before}[\|k]$;\6
+\&{if} $\|k=\\{cur\_rounding\_ptr}-1$ \1\&{then}\5
+$\\{after}[0]\K\\{before}[0]$\6
+\4\&{else} $\\{after}[\|k+1]\K\\{before}[\|k+1]$;\2\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\2\6
+\4\&{until}\5
+\\{all\_safe}\2\par
+\U444.\fi
+
+\M447. Here we get rid of ``dead'' cubics, i.e., polynomials that don't move at
+all when \|t~changes, since the subdivision process might have introduced
+such things. If the cycle reduces to a single point, however, we are left
+with a single dead cubic that will not be removed until later.
+
+\Y\P$\4\X447:Remove dead cubics\X\S$\6
+$\|p\K\\{cur\_spec}$;\6
+\1\&{repeat} \37\\{continue}: \37$\|q\K\\{link}(\|p)$;\6
+\&{if} $\|p\I\|q$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{x\_coord}(\|p)=\\{right\_x}(\|p)$ \1\&{then}\6
+\&{if} $\\{y\_coord}(\|p)=\\{right\_y}(\|p)$ \1\&{then}\6
+\&{if} $\\{x\_coord}(\|p)=\\{left\_x}(\|q)$ \1\&{then}\6
+\&{if} $\\{y\_coord}(\|p)=\\{left\_y}(\|q)$ \1\&{then}\6
+\&{begin} \37$\\{unskew}(\\{x\_coord}(\|q),\39\\{y\_coord}(\|q),\39\\{right%
+\_type}(\|q))$;\5
+$\\{skew}(\\{cur\_x},\39\\{cur\_y},\39\\{right\_type}(\|p))$;\6
+\&{if} $\\{x\_coord}(\|p)=\\{cur\_x}$ \1\&{then}\6
+\&{if} $\\{y\_coord}(\|p)=\\{cur\_y}$ \1\&{then}\6
+\&{begin} \37$\\{remove\_cubic}(\|p)$;\C{remove the cubic following \|p}\6
+\&{if} $\|q\I\\{cur\_spec}$ \1\&{then}\5
+\&{goto} \37\\{continue};\2\6
+$\\{cur\_spec}\K\|p$;\5
+$\|q\K\|p$;\6
+\&{end};\2\2\6
+\&{end};\2\2\2\2\6
+\&{end};\2\6
+$\|p\K\|q$;\6
+\4\&{until}\5
+$\|p=\\{cur\_spec}$;\2\par
+\U402.\fi
+
+\M448. Finally we come to the last steps of \\{make\_spec}, when boundary nodes
+are inserted between cubics that move in different octants. The main
+complication remaining arises from consecutive cubics whose octants
+are not adjacent; we should insert more than one octant boundary
+at such sharp turns, so that the envelope-forming routine will work.
+
+For this purpose, conversion tables between numeric and Gray codes for
+octants are desirable.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{octant\_number}: \37\&{array} $[\\{first\_octant}\to\\{sixth\_octant}]$ \1%
+\&{of}\5
+$1\to8$;\2\6
+\4\\{octant\_code}: \37\&{array} $[1\to8]$ \1\&{of}\5
+$\\{first\_octant}\to\\{sixth\_octant}$;\2\par
+\fi
+
+\M449. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{octant\_code}[1]\K\\{first\_octant}$;\5
+$\\{octant\_code}[2]\K\\{second\_octant}$;\5
+$\\{octant\_code}[3]\K\\{third\_octant}$;\5
+$\\{octant\_code}[4]\K\\{fourth\_octant}$;\5
+$\\{octant\_code}[5]\K\\{fifth\_octant}$;\5
+$\\{octant\_code}[6]\K\\{sixth\_octant}$;\5
+$\\{octant\_code}[7]\K\\{seventh\_octant}$;\5
+$\\{octant\_code}[8]\K\\{eighth\_octant}$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}8$ \1\&{do}\5
+$\\{octant\_number}[\\{octant\_code}[\|k]]\K\|k$;\2\par
+\fi
+
+\M450. The main loop for boundary insertion deals with three consecutive
+nodes $\|p,\|q,\|r$.
+
+\Y\P$\4\X450:Insert octant boundaries and compute the turning number\X\S$\6
+$\\{turning\_number}\K0$;\5
+$\|p\K\\{cur\_spec}$;\5
+$\|q\K\\{link}(\|p)$;\6
+\1\&{repeat} \37$\|r\K\\{link}(\|q)$;\6
+\&{if} $(\\{right\_type}(\|p)\I\\{right\_type}(\|q))\V(\|q=\|r)$ \1\&{then}\5
+\X452:Insert one or more octant boundary nodes just before~\|q\X;\2\6
+$\|p\K\|q$;\5
+$\|q\K\|r$;\6
+\4\&{until}\5
+$\|p=\\{cur\_spec}$;\2\par
+\U402.\fi
+
+\M451. The \\{new\_boundary} subroutine comes in handy at this point. It
+inserts
+a new boundary node just after a given node \|p, using a given octant code
+to transform the new node's coordinates. The ``transition'' fields are
+not computed here.
+
+\Y\P$\4\X405:Declare subroutines needed by \\{make\_spec}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{new\_boundary}(\|p:\\{pointer};\,\35\\{octant}:%
+\\{small\_number})$;\6
+\4\&{var} \37$\|q,\39\|r$: \37\\{pointer};\C{for list manipulation}\2\6
+\&{begin} \37$\|q\K\\{link}(\|p)$;\C{we assume that $\\{right\_type}(\|q)\I%
+\\{endpoint}$}\6
+$\|r\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{link}(\|r)\K\|q$;\5
+$\\{link}(\|p)\K\|r$;\5
+$\\{left\_type}(\|r)\K\\{left\_type}(\|q)$;\C{but possibly $\\{left\_type}(%
+\|q)=\\{endpoint}$}\6
+$\\{left\_x}(\|r)\K\\{left\_x}(\|q)$;\5
+$\\{left\_y}(\|r)\K\\{left\_y}(\|q)$;\5
+$\\{right\_type}(\|r)\K\\{endpoint}$;\5
+$\\{left\_type}(\|q)\K\\{endpoint}$;\5
+$\\{right\_octant}(\|r)\K\\{octant}$;\5
+$\\{left\_octant}(\|q)\K\\{right\_type}(\|q)$;\5
+$\\{unskew}(\\{x\_coord}(\|q),\39\\{y\_coord}(\|q),\39\\{right\_type}(\|q))$;\5
+$\\{skew}(\\{cur\_x},\39\\{cur\_y},\39\\{octant})$;\5
+$\\{x\_coord}(\|r)\K\\{cur\_x}$;\5
+$\\{y\_coord}(\|r)\K\\{cur\_y}$;\6
+\&{end};\par
+\fi
+
+\M452. The case $\|q=\|r$ occurs if and only if $\|p=\|q=\|r=\\{cur\_spec}$,
+when we want to turn
+$360^\circ$ in eight steps and then remove a solitary dead cubic.
+The program below happens to work in that case, but the reader isn't
+expected to understand why.
+
+\Y\P$\4\X452:Insert one or more octant boundary nodes just before~\|q\X\S$\6
+\&{begin} \37$\\{new\_boundary}(\|p,\39\\{right\_type}(\|p))$;\5
+$\|s\K\\{link}(\|p)$;\5
+$\\{o1}\K\\{octant\_number}[\\{right\_type}(\|p)]$;\5
+$\\{o2}\K\\{octant\_number}[\\{right\_type}(\|q)]$;\6
+\&{case} $\\{o2}-\\{o1}$ \1\&{of}\6
+\4$1,\39-7,\397,\39-1$: \37\&{goto} \37\\{done};\6
+\4$2,\39-6$: \37$\\{clockwise}\K\\{false}$;\6
+\4$3,\39-5,\394,\39-4,\395,\39-3$: \37\X454:Decide whether or not to go
+clockwise\X;\6
+\4$6,\39-2$: \37$\\{clockwise}\K\\{true}$;\6
+\40: \37$\\{clockwise}\K\\{rev\_turns}$;\2\6
+\&{end};\C{there are no other cases}\6
+\X458:Insert additional boundary nodes, then \&{goto} \\{done}\X;\6
+\4\\{done}: \37\&{if} $\|q=\|r$ \1\&{then}\6
+\&{begin} \37$\|q\K\\{link}(\|q)$;\5
+$\|r\K\|q$;\5
+$\|p\K\|s$;\5
+$\\{link}(\|s)\K\|q$;\5
+$\\{left\_octant}(\|q)\K\\{right\_octant}(\|q)$;\5
+$\\{left\_type}(\|q)\K\\{endpoint}$;\5
+$\\{free\_node}(\\{cur\_spec},\39\\{knot\_node\_size})$;\5
+$\\{cur\_spec}\K\|q$;\6
+\&{end};\2\6
+\X459:Fix up the transition fields and adjust the turning number\X;\6
+\&{end}\par
+\U450.\fi
+
+\M453. \P$\X453:Other local variables for \\{make\_spec}\X\S$\6
+\4$\\{o1},\39\\{o2}$: \37\\{small\_number};\C{octant numbers}\6
+\4\\{clockwise}: \37\\{boolean};\C{should we turn clockwise?}\6
+\4$\\{dx1},\39\\{dy1},\39\\{dx2},\39\\{dy2}$: \37\\{integer};\C{directions of
+travel at a cusp}\6
+\4$\\{dmax},\39\\{del}$: \37\\{integer};\C{temporary registers}\par
+\U402.\fi
+
+\M454. A tricky question arises when a path jumps four octants. We want the
+direction of turning to be counterclockwise if the curve has changed
+direction by $180^\circ$, or by something so close to $180^\circ$ that
+the difference is probably due to rounding errors; otherwise we want to
+turn through an angle of less than $180^\circ$. This decision needs to
+be made even when a curve seems to have jumped only three octants, since
+a curve may approach direction $(-1,0)$ from the fourth octant, then
+it might leave from direction $(+1,0)$ into the first.
+
+The following code solves the problem by analyzing the incoming
+direction $(\\{dx1},\\{dy1})$ and the outgoing direction $(\\{dx2},\\{dy2})$.
+
+\Y\P$\4\X454:Decide whether or not to go clockwise\X\S$\6
+\&{begin} \37\X457:Compute the incoming and outgoing directions\X;\6
+$\\{unskew}(\\{dx1},\39\\{dy1},\39\\{right\_type}(\|p))$;\5
+$\\{del}\K\\{pyth\_add}(\\{cur\_x},\39\\{cur\_y})$;\6
+$\\{dx1}\K\\{make\_fraction}(\\{cur\_x},\39\\{del})$;\5
+$\\{dy1}\K\\{make\_fraction}(\\{cur\_y},\39\\{del})$;\C{$\cos\theta_1$ and $%
+\sin\theta_1$}\6
+$\\{unskew}(\\{dx2},\39\\{dy2},\39\\{right\_type}(\|q))$;\5
+$\\{del}\K\\{pyth\_add}(\\{cur\_x},\39\\{cur\_y})$;\6
+$\\{dx2}\K\\{make\_fraction}(\\{cur\_x},\39\\{del})$;\5
+$\\{dy2}\K\\{make\_fraction}(\\{cur\_y},\39\\{del})$;\C{$\cos\theta_2$ and $%
+\sin\theta_2$}\6
+$\\{del}\K\\{take\_fraction}(\\{dx1},\39\\{dy2})-\\{take\_fraction}(\\{dx2},\39%
+\\{dy1})$;\C{$\sin(\theta_2-\theta_1)$}\6
+\&{if} $\\{del}>4684844$ \1\&{then}\5
+$\\{clockwise}\K\\{false}$\6
+\4\&{else} \&{if} $\\{del}<-4684844$ \1\&{then}\5
+$\\{clockwise}\K\\{true}$\C{$2^{28}\cdot\sin 1^\circ\approx4684844.68$}\6
+\4\&{else} $\\{clockwise}\K\\{rev\_turns}$;\2\2\6
+\&{end}\par
+\U452.\fi
+
+\M455. Actually the turnarounds just computed will be clockwise,
+not counterclockwise, if
+the global variable \\{rev\_turns} is \\{true}; it is usually \\{false}.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{rev\_turns}: \37\\{boolean};\C{should we make U-turns in the English
+manner?}\par
+\fi
+
+\M456. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{rev\_turns}\K\\{false}$;\par
+\fi
+
+\M457. \P$\X457:Compute the incoming and outgoing directions\X\S$\6
+$\\{dx1}\K\\{x\_coord}(\|s)-\\{left\_x}(\|s)$;\5
+$\\{dy1}\K\\{y\_coord}(\|s)-\\{left\_y}(\|s)$;\6
+\&{if} $\\{dx1}=0$ \1\&{then}\6
+\&{if} $\\{dy1}=0$ \1\&{then}\6
+\&{begin} \37$\\{dx1}\K\\{x\_coord}(\|s)-\\{right\_x}(\|p)$;\5
+$\\{dy1}\K\\{y\_coord}(\|s)-\\{right\_y}(\|p)$;\6
+\&{if} $\\{dx1}=0$ \1\&{then}\6
+\&{if} $\\{dy1}=0$ \1\&{then}\6
+\&{begin} \37$\\{dx1}\K\\{x\_coord}(\|s)-\\{x\_coord}(\|p)$;\5
+$\\{dy1}\K\\{y\_coord}(\|s)-\\{y\_coord}(\|p)$;\6
+\&{end};\C{and they {\sl can't} both be zero}\2\2\6
+\&{end};\2\2\6
+$\\{dmax}\K\\{abs}(\\{dx1})$;\ \&{if} $\\{abs}(\\{dy1})>\\{dmax}$ \1\&{then}\5
+$\\{dmax}\K\\{abs}(\\{dy1})$;\2\6
+\&{while} $\\{dmax}<\\{fraction\_one}$ \1\&{do}\6
+\&{begin} \37$\\{double}(\\{dmax})$;\5
+$\\{double}(\\{dx1})$;\5
+$\\{double}(\\{dy1})$;\6
+\&{end};\2\6
+$\\{dx2}\K\\{right\_x}(\|q)-\\{x\_coord}(\|q)$;\5
+$\\{dy2}\K\\{right\_y}(\|q)-\\{y\_coord}(\|q)$;\6
+\&{if} $\\{dx2}=0$ \1\&{then}\6
+\&{if} $\\{dy2}=0$ \1\&{then}\6
+\&{begin} \37$\\{dx2}\K\\{left\_x}(\|r)-\\{x\_coord}(\|q)$;\5
+$\\{dy2}\K\\{left\_y}(\|r)-\\{y\_coord}(\|q)$;\6
+\&{if} $\\{dx2}=0$ \1\&{then}\6
+\&{if} $\\{dy2}=0$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{right\_type}(\|r)=\\{endpoint}$ \1\&{then}\6
+\&{begin} \37$\\{cur\_x}\K\\{x\_coord}(\|r)$;\5
+$\\{cur\_y}\K\\{y\_coord}(\|r)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{unskew}(\\{x\_coord}(\|r),\39\\{y\_coord}(\|r),\39%
+\\{right\_type}(\|r))$;\5
+$\\{skew}(\\{cur\_x},\39\\{cur\_y},\39\\{right\_type}(\|q))$;\6
+\&{end};\2\6
+$\\{dx2}\K\\{cur\_x}-\\{x\_coord}(\|q)$;\5
+$\\{dy2}\K\\{cur\_y}-\\{y\_coord}(\|q)$;\6
+\&{end};\C{and they {\sl can't} both be zero}\2\2\6
+\&{end};\2\2\6
+$\\{dmax}\K\\{abs}(\\{dx2})$;\ \&{if} $\\{abs}(\\{dy2})>\\{dmax}$ \1\&{then}\5
+$\\{dmax}\K\\{abs}(\\{dy2})$;\2\6
+\&{while} $\\{dmax}<\\{fraction\_one}$ \1\&{do}\6
+\&{begin} \37$\\{double}(\\{dmax})$;\5
+$\\{double}(\\{dx2})$;\5
+$\\{double}(\\{dy2})$;\6
+\&{end}\2\par
+\U454.\fi
+
+\M458. \P$\X458:Insert additional boundary nodes, then \&{goto} \\{done}\X\S$\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\\{clockwise}$ \1\&{then}\6
+\&{if} $\\{o1}=1$ \1\&{then}\5
+$\\{o1}\K8$\ \&{else} $\\{decr}(\\{o1})$\2\6
+\4\&{else} \&{if} $\\{o1}=8$ \1\&{then}\5
+$\\{o1}\K1$\ \&{else} $\\{incr}(\\{o1})$;\2\2\6
+\&{if} $\\{o1}=\\{o2}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{new\_boundary}(\|s,\39\\{octant\_code}[\\{o1}])$;\5
+$\|s\K\\{link}(\|s)$;\5
+$\\{left\_octant}(\|s)\K\\{right\_octant}(\|s)$;\6
+\&{end}\2\par
+\U452.\fi
+
+\M459. Now it remains to insert the redundant
+transition information into the \\{left\_transition}
+and \\{right\_transition} fields between adjacent octants, in the octant
+boundary nodes that have just been inserted between $\\{link}(\|p)$ and~\|q.
+The turning number is easily computed from these transitions.
+
+\Y\P$\4\X459:Fix up the transition fields and adjust the turning number\X\S$\6
+$\|p\K\\{link}(\|p)$;\6
+\1\&{repeat} \37$\|s\K\\{link}(\|p)$;\5
+$\\{o1}\K\\{octant\_number}[\\{right\_octant}(\|p)]$;\5
+$\\{o2}\K\\{octant\_number}[\\{left\_octant}(\|s)]$;\6
+\&{if} $\\{abs}(\\{o1}-\\{o2})=1$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{o2}<\\{o1}$ \1\&{then}\5
+$\\{o2}\K\\{o1}$;\2\6
+\&{if} $\\{odd}(\\{o2})$ \1\&{then}\5
+$\\{right\_transition}(\|p)\K\\{axis}$\6
+\4\&{else} $\\{right\_transition}(\|p)\K\\{diagonal}$;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{o1}=8$ \1\&{then}\5
+$\\{incr}(\\{turning\_number})$\ \&{else} $\\{decr}(\\{turning\_number})$;\2\6
+$\\{right\_transition}(\|p)\K\\{axis}$;\6
+\&{end};\2\6
+$\\{left\_transition}(\|s)\K\\{right\_transition}(\|p)$;\5
+$\|p\K\|s$;\6
+\4\&{until}\5
+$\|p=\|q$\2\par
+\U452.\fi
+
+\N460. \[22] Filling a contour.
+Given the low-level machinery for making moves and for transforming a
+cyclic path into a cycle spec, we're almost able to fill a digitized path.
+All we need is a high-level routine that walks through the cycle spec and
+controls the overall process.
+
+Our overall goal is to plot the integer points $\bigl(\round(x(t)),
+\round(y(t))\bigr)$ and to connect them by rook moves, assuming that
+$\round(x(t))$ and $\round(y(t))$ don't both jump simultaneously from
+one integer to another as $t$~varies; these rook moves will be the edge
+of the contour that will be filled. We have reduced this problem to the
+case of curves that travel in first octant directions, i.e., curves
+such that $0\L y'(t)\L x'(t)$, by transforming the original coordinates.
+
+\def\xtilde{{\tilde x}} \def\ytilde{{\tilde y}}
+Another transformation makes the problem still simpler. We shall say that
+we are working with {\sl biased coordinates\/} when $(x,y)$ has been
+replaced by $(\xtilde,\ytilde)=(x-y,y+{1\over2})$. When a curve travels
+in first octant directions, the corresponding curve with biased
+coordinates travels in first {\sl quadrant\/} directions; the latter
+condition is symmetric in $x$ and~$y$, so it has advantages for the
+design of algorithms. The \\{make\_spec} routine gives us skewed coordinates
+$(x-y,y)$, hence we obtain biased coordinates by simply adding $1\over2$
+to the second component.
+
+The most important fact about biased coordinates is that we can determine the
+rounded unbiased path $\bigl(\round(x(t)),\round(y(t))\bigr)$ from the
+truncated biased path $\bigl(\lfloor\xtilde(t)\rfloor,\lfloor\ytilde(t)\rfloor
+\bigr)$ and information about the initial and final endpoints. If the
+unrounded and unbiased
+path begins at $(x_0,y_0)$ and ends at $(x_1,y_1)$, it's possible to
+prove (by induction on the length of truncated biased path) that the
+rounded unbiased path is obtained by the following construction:
+
+\yskip\textindent{1)} Start at $\bigl(\round(x_0),\round(y_0)\bigr)$.
+
+\yskip\textindent{2)} If $(x_0+{1\over2})\bmod1\G(y_0+{1\over2})\bmod1$,
+move one step right.
+
+\yskip\textindent{3)} Whenever the path
+$\bigl(\lfloor\xtilde(t)\rfloor,\lfloor\ytilde(t)\rfloor\bigr)$
+takes an upward step (i.e., when
+$\lfloor\xtilde(t+\epsilon)\rfloor=\lfloor\xtilde(t)\rfloor$ and
+$\lfloor\ytilde(t+\epsilon)\rfloor=\lfloor\ytilde(t)\rfloor+1$),
+move one step up and then one step right.
+
+\yskip\textindent{4)} Whenever the path
+$\bigl(\lfloor\xtilde(t)\rfloor,\lfloor\ytilde(t)\rfloor\bigr)$
+takes a rightward step (i.e., when
+$\lfloor\xtilde(t+\epsilon)\rfloor=\lfloor\xtilde(t)\rfloor+1$ and
+$\lfloor\ytilde(t+\epsilon)\rfloor=\lfloor\ytilde(t)\rfloor$),
+move one step right.
+
+\yskip\textindent{5)} Finally, if
+$(x_1+{1\over2})\bmod1\G(y_1+{1\over2})\bmod1$, move one step left (thereby
+cancelling the previous move, which was one step right). You will now be
+at the point $\bigl(\round(x_1),\round(y_1)\bigr)$.
+
+\fi
+
+\M461. In order to validate the assumption that $\round(x(t))$ and $%
+\round(y(t))$
+don't both jump simultaneously, we shall consider that a coordinate pair
+$(x,y)$ actually represents $(x+\epsilon,y+\epsilon\delta)$, where
+$\epsilon$ and $\delta$ are extremely small positive numbers---so small
+that their precise values never matter. This convention makes rounding
+unambiguous, since there is always a unique integer point nearest to any
+given scaled numbers~$(x,y)$.
+
+When coordinates are transformed so that \MF\ needs to work only in ``first
+octant'' directions, the transformations involve negating~$x$, negating~$y$,
+and/or interchanging $x$ with~$y$. Corresponding adjustments to the
+rounding conventions must be made so that consistent values will be
+obtained. For example, suppose that we're working with coordinates that
+have been transformed so that a third-octant curve travels in first-octant
+directions. The skewed coordinates $(x,y)$ in our data structure represent
+unskewed coordinates $(-y,x+y)$, which are actually $(-y+\epsilon,
+x+y+\epsilon\delta)$. We should therefore round as if our skewed coordinates
+were $(x+\epsilon+\epsilon\delta,y-\epsilon)$ instead of $(x,y)$. The following
+table shows how the skewed coordinates should be perturbed when rounding
+decisions are made:
+$$\vcenter{\halign{#\hfil&&\quad$#$\hfil&\hskip4em#\hfil\cr
+\\{first\_octant}&(x+\epsilon-\epsilon\delta,y+\epsilon\delta)&
+\\{fifth\_octant}&(x-\epsilon+\epsilon\delta,y-\epsilon\delta)\cr
+\\{second\_octant}&(x-\epsilon+\epsilon\delta,y+\epsilon)&
+\\{sixth\_octant}&(x+\epsilon-\epsilon\delta,y-\epsilon)\cr
+\\{third\_octant}&(x+\epsilon+\epsilon\delta,y-\epsilon)&
+\\{seventh\_octant}&(x-\epsilon-\epsilon\delta,y+\epsilon)\cr
+\\{fourth\_octant}&(x-\epsilon-\epsilon\delta,y+\epsilon\delta)&
+\\{eighth\_octant}&(x+\epsilon+\epsilon\delta,y-\epsilon\delta)\cr}}$$
+
+Four small arrays are set up so that the rounding operations will be
+fairly easy in any given octant.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{y\_corr},\39\\{xy\_corr},\39\\{z\_corr}$: \37\&{array} $[\\{first%
+\_octant}\to\\{sixth\_octant}]$ \1\&{of}\5
+$0\to1$;\2\6
+\4\\{x\_corr}: \37\&{array} $[\\{first\_octant}\to\\{sixth\_octant}]$ \1\&{of}\5
+$-1\to1$;\2\par
+\fi
+
+\M462. Here \\{xy\_corr} is 1 if and only if the $x$ component of a skewed
+coordinate
+is to be decreased by an infinitesimal amount; \\{y\_corr} is similar, but for
+the $y$ components. The other tables are set up so that the condition
+$$(x+y+\\{half\_unit})\bmod\\{unity}\G(y+\\{half\_unit})\bmod\\{unity}$$
+is properly perturbed to the condition
+$$(x+y+\\{half\_unit}-\\{x\_corr}-\\{y\_corr})\bmod\\{unity}\G
+(y+\\{half\_unit}-\\{y\_corr})\bmod\\{unity}+\\{z\_corr}.$$
+
+\Y\P$\4\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{x\_corr}[\\{first\_octant}]\K0$;\5
+$\\{y\_corr}[\\{first\_octant}]\K0$;\5
+$\\{xy\_corr}[\\{first\_octant}]\K0$;\6
+$\\{x\_corr}[\\{second\_octant}]\K0$;\5
+$\\{y\_corr}[\\{second\_octant}]\K0$;\5
+$\\{xy\_corr}[\\{second\_octant}]\K1$;\6
+$\\{x\_corr}[\\{third\_octant}]\K-1$;\5
+$\\{y\_corr}[\\{third\_octant}]\K1$;\5
+$\\{xy\_corr}[\\{third\_octant}]\K0$;\6
+$\\{x\_corr}[\\{fourth\_octant}]\K1$;\5
+$\\{y\_corr}[\\{fourth\_octant}]\K0$;\5
+$\\{xy\_corr}[\\{fourth\_octant}]\K1$;\6
+$\\{x\_corr}[\\{fifth\_octant}]\K0$;\5
+$\\{y\_corr}[\\{fifth\_octant}]\K1$;\5
+$\\{xy\_corr}[\\{fifth\_octant}]\K1$;\6
+$\\{x\_corr}[\\{sixth\_octant}]\K0$;\5
+$\\{y\_corr}[\\{sixth\_octant}]\K1$;\5
+$\\{xy\_corr}[\\{sixth\_octant}]\K0$;\6
+$\\{x\_corr}[\\{seventh\_octant}]\K1$;\5
+$\\{y\_corr}[\\{seventh\_octant}]\K0$;\5
+$\\{xy\_corr}[\\{seventh\_octant}]\K1$;\6
+$\\{x\_corr}[\\{eighth\_octant}]\K-1$;\5
+$\\{y\_corr}[\\{eighth\_octant}]\K1$;\5
+$\\{xy\_corr}[\\{eighth\_octant}]\K0$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}8$ \1\&{do}\5
+$\\{z\_corr}[\|k]\K\\{xy\_corr}[\|k]-\\{x\_corr}[\|k]$;\2\par
+\fi
+
+\M463. Here's a procedure that handles the details of rounding at the
+endpoints: Given skewed coordinates $(\|x,\|y)$, it sets $(\\{m1},\\{n1})$
+to the corresponding rounded lattice points, taking the current
+\\{octant} into account. Global variable \\{d1} is also set to 1 if
+$(x+y+{1\over2})\bmod1\G(y+{1\over2})\bmod1$.
+
+\Y\P\4\&{procedure}\1\ \37$\\{end\_round}(\|x,\39\|y:\\{scaled})$;\2\6
+\&{begin} \37$\|y\K\|y+\\{half\_unit}-\\{y\_corr}[\\{octant}]$;\5
+$\|x\K\|x+\|y-\\{x\_corr}[\\{octant}]$;\5
+$\\{m1}\K\\{floor\_unscaled}(\|x)$;\5
+$\\{n1}\K\\{floor\_unscaled}(\|y)$;\6
+\&{if} $\|x-\\{unity}\ast\\{m1}\G\|y-\\{unity}\ast\\{n1}+\\{z\_corr}[%
+\\{octant}]$ \1\&{then}\5
+$\\{d1}\K1$\ \&{else} $\\{d1}\K0$;\2\6
+\&{end};\par
+\fi
+
+\M464. The outputs $(\\{m1},\\{n1},\\{d1})$ of \\{end\_round} will sometimes be
+moved
+to $(\\{m0},\\{n0},\\{d0})$.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{m0},\39\\{n0},\39\\{m1},\39\\{n1}$: \37\\{integer};\C{lattice point
+coordinates}\6
+\4$\\{d0},\39\\{d1}$: \37$0\to1$;\C{displacement corrections}\par
+\fi
+
+\M465. We're ready now to fill the pixels enclosed by a given cycle spec~\|h;
+the knot list that represents the cycle is destroyed in the process.
+The edge structure that gets all the resulting data is \\{cur\_edges},
+and the edges are weighted by \\{cur\_wt}.
+
+\Y\P\4\&{procedure}\1\ \37$\\{fill\_spec}(\|h:\\{pointer})$;\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\C{for list traversal}%
+\2\6
+\&{begin} \37\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+\\{begin\_edge\_tracing};\2\6
+$\|p\K\|h$;\C{we assume that $\\{left\_type}(\|h)=\\{endpoint}$}\6
+\1\&{repeat} \37$\\{octant}\K\\{left\_octant}(\|p)$;\5
+\X466:Set variable \|q to the node at the end of the current octant\X;\6
+\&{if} $\|q\I\|p$ \1\&{then}\6
+\&{begin} \37\X467:Determine the starting and ending lattice points $(\\{m0},%
+\\{n0})$ and $(\\{m1},\\{n1})$\X;\6
+\X468:Make the moves for the current octant\X;\6
+$\\{move\_to\_edges}(\\{m0},\39\\{n0},\39\\{m1},\39\\{n1})$;\6
+\&{end};\2\6
+$\|p\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\|p=\|h$;\2\6
+$\\{toss\_knot\_list}(\|h)$;\6
+\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+\\{end\_edge\_tracing};\2\6
+\&{end};\par
+\fi
+
+\M466. \P$\X466:Set variable \|q to the node at the end of the current octant\X%
+\S$\6
+$\|q\K\|p$;\6
+\&{while} $\\{right\_type}(\|q)\I\\{endpoint}$ \1\&{do}\5
+$\|q\K\\{link}(\|q)$\2\par
+\Us465, 506\ETs506.\fi
+
+\M467. \P$\X467:Determine the starting and ending lattice points $(\\{m0},%
+\\{n0})$ and $(\\{m1},\\{n1})$\X\S$\6
+$\\{end\_round}(\\{x\_coord}(\|p),\39\\{y\_coord}(\|p))$;\5
+$\\{m0}\K\\{m1}$;\5
+$\\{n0}\K\\{n1}$;\5
+$\\{d0}\K\\{d1}$;\6
+$\\{end\_round}(\\{x\_coord}(\|q),\39\\{y\_coord}(\|q))$\par
+\U465.\fi
+
+\M468. Finally we perform the five-step process that was explained at
+the very beginning of this part of the program.
+
+\Y\P$\4\X468:Make the moves for the current octant\X\S$\6
+\&{if} $\\{n1}-\\{n0}\G\\{move\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"move\ table\ size"},\39\\{move\_size})$;\2\6
+$\\{move}[0]\K\\{d0}$;\5
+$\\{move\_ptr}\K0$;\5
+$\|r\K\|p$;\6
+\1\&{repeat} \37$\|s\K\\{link}(\|r)$;\6
+$\\{make\_moves}(\\{x\_coord}(\|r),\39\\{right\_x}(\|r),\39\\{left\_x}(\|s),\39%
+\\{x\_coord}(\|s),\39\30\\{y\_coord}(\|r)+\\{half\_unit},\39\\{right\_y}(\|r)+%
+\\{half\_unit},\39\\{left\_y}(\|s)+\\{half\_unit},\39\\{y\_coord}(\|s)+\\{half%
+\_unit},\39\30\\{xy\_corr}[\\{octant}],\39\\{y\_corr}[\\{octant}])$;\5
+$\|r\K\|s$;\6
+\4\&{until}\5
+$\|r=\|q$;\2\6
+$\\{move}[\\{move\_ptr}]\K\\{move}[\\{move\_ptr}]-\\{d1}$;\6
+\&{if} $\\{internal}[\\{smoothing}]>0$ \1\&{then}\5
+$\\{smooth\_moves}(0,\39\\{move\_ptr})$\2\par
+\U465.\fi
+
+\N469. \[23] Polygonal pens.
+The next few parts of the program deal with the additional complications
+associated with ``envelopes,'' leading up to an algorithm that fills a
+contour with respect to a pen whose boundary is a convex polygon. The
+mathematics underlying this algorithm is based on simple aspects of the
+theory of tracings developed by Leo Guibas, Lyle Ramshaw, and Jorge
+Stolfi [``A kinetic framework for computational geometry,''
+{\sl Proc.\ IEEE Symp.\ Foundations of Computer Science\/ \bf24} (1983),
+100--111].
+
+If the vertices of the polygon are $w_0$, $w_1$, \dots, $w_{n-1}$, $w_n=w_0$,
+in counterclockwise order, the convexity condition requires that ``left
+turns'' are made at each vertex when a person proceeds from $w_0$ to
+$w_1$ to $\cdots$ to~$w_n$. The envelope is obtained if we offset a given
+curve $z(t)$ by $w_k$ when that curve is traveling in a direction
+$z'(t)$ lying between the directions $w_k-w_{k-1}$ and $w\k-w_k$.
+At times~$t$ when the curve direction $z'(t)$ increases past
+$w\k-w_k$, we temporarily stop plotting the offset curve and we insert
+a straight line from $z(t)+w_k$ to $z(t)+w\k$; notice that this straight
+line is tangent to the offset curve. Similarly, when the curve direction
+decreases past $w_k-w_{k-1}$, we stop plotting and insert a straight
+line from $z(t)+w_k$ to $z(t)+w_{k-1}$; the latter line is actually a
+``retrograde'' step, which won't be part of the final envelope under
+\MF's assumptions. The result of this construction is a continuous path
+that consists of alternating curves and straight line segments. The
+segments are usually so short, in practice, that they blend with the
+curves; after all, it's possible to represent any digitized path as
+a sequence of digitized straight lines.
+
+The nicest feature of this approach to envelopes is that it blends
+perfectly with the octant subdivision process we have already developed.
+The envelope travels in the same direction as the curve itself, as we
+plot it, and we need merely be careful what offset is being added.
+Retrograde motion presents a problem, but we will see that there is
+a decent way to handle it.
+
+\fi
+
+\M470. We shall represent pens by maintaining eight lists of offsets,
+one for each octant direction. The offsets at the boundary points
+where a curve turns into a new octant will appear in the lists for
+both octants. This means that we can restrict consideration to
+segments of the original polygon whose directions aim in the first
+octant, as we have done in the simpler case when envelopes were not
+required.
+
+An example should help to clarify this situation: Consider the
+quadrilateral whose vertices are $w_0=(0,-1)$, $w_1=(3,-1)$,
+$w_2=(6,1)$, and $w_3=(1,2)$. A curve that travels in the first octant
+will be offset by $w_1$ or $w_2$, unless its slope drops to zero
+en route to the eighth octant; in the latter case we should switch to $w_0$ as
+we cross the octant boundary. Our list for the first octant will
+contain the three offsets $w_0$, $w_1$,~$w_2$. By convention we will
+duplicate a boundary offset if the angle between octants doesn't
+explicitly appear; in this case there is no explicit line of slope~1
+at the end of the list, so the full list is
+$$w_0\;w_1\;w_2\;w_2\;=\;(0,-1)\;(3,-1)\;(6,1)\;(6,1).$$
+With skewed coordinates $(u-v,v)$ instead of $(u,v)$ we obtain the list
+$$w_0\;w_1\;w_2\;w_2\;\mapsto\;(1,-1)\;(4,-1)\;(5,1)\;(5,1),$$
+which is what actually appears in the data structure. In the second
+octant there's only one offset; we list it three times (with coordinates
+interchanged, so as to make the second octant look like the first),
+and skew those coordinates, obtaining
+$$\tabskip\centering
+\halign to\hsize{$\hfil#\;\mapsto\;{}$\tabskip=0pt&
+$#\hfil$&\quad in the #\hfil\tabskip\centering\cr
+w_2\;w_2\;w_2&(-5,6)\;(-5,6)\;(-5,6)\cr
+\noalign{\vskip\belowdisplayskip
+\vbox{\noindent\strut as the list of transformed and skewed offsets to use
+when curves that travel in the second octant. Similarly, we will have\strut}
+\vskip\abovedisplayskip}
+w_2\;w_2\;w_2&(7,-6)\;(7,-6)\;(7,-6)&third;\cr
+w_2\;w_2\;w_3\;w_3&(-7,1)\;(-7,1)\;(-3,2)\;(-3,2)&fourth;\cr
+w_3\;w_3\;w_3&(3,-2)\;(3,-2)\;(3,-2)&fifth;\cr
+w_3\;w_3\;w_0\;w_0&(-3,1)\;(-3,1)\;(1,0)\;(1,0)&sixth;\cr
+w_0\;w_0\;w_0&(1,0)\;(1,0)\;(1,0)&seventh;\cr
+w_0\;w_0\;w_0&(-1,1)\;(-1,1)\;(-1,1)&eighth.\cr}$$
+Notice that $w_1$ is considered here to be internal to the first octant;
+it's not part of the eighth. We could equally well have taken $w_0$ out
+of the first octant list and put it into the eighth; then the first octant
+list would have been
+$$w_1\;w_1\;w_2\;w_2\;\mapsto\;(4,-1)\;(4,-1)\;(5,1)\;(5,1)$$
+and the eighth octant list would have been
+$$w_0\;w_0\;w_1\;\mapsto\;(-1,1)\;(-1,1)\;(2,1).$$
+
+Actually, there's one more complication: The order of offsets is reversed
+in even-numbered octants, because the transformation of coordinates has
+reversed counterclockwise and clockwise orientations in those octants.
+The offsets in the fourth octant, for example, are really $w_3$, $w_3$,
+$w_2$,~$w_2$, not $w_2$, $w_2$, $w_3$,~$w_3$.
+
+\fi
+
+\M471. In general, the list of offsets for an octant will have the form
+$$w_0\;\;w_1\;\;\ldots\;\;w_n\;\;w_{n+1}$$
+(if we renumber the subscripts in each list), where $w_0$ and $w_{n+1}$
+are offsets common to the neighboring lists. We'll often have $w_0=w_1$
+and/or $w_n=w_{n+1}$, but the other $w$'s will be distinct. Curves
+that travel between slope~0 and direction $w_2-w_1$ will use offset~$w_1$;
+curves that travel between directions $w_k-w_{k-1}$ and $w\k-w_k$ will
+use offset~$w_k$, for $1<k<n$; curves between direction $w_n-w_{n-1}$
+and slope~1 (actually slope~$\infty$ after skewing) will use offset~$w_n$.
+In even-numbered octants, the directions are actually $w_k-w\k$ instead
+of $w\k-w_k$, because the offsets have been listed in reverse order.
+
+Each offset $w_k$ is represented by skewed coordinates $(u_k-v_k,v_k)$,
+where $(u_k,v_k)$ is the representation of $w_k$ after it has been rotated
+into a first-octant disguise.
+
+\fi
+
+\M472. The top-level data structure of a pen polygon is a 10-word node
+containing
+a reference count followed by pointers to the eight pen lists, followed
+by an indication of the pen's range of values.
+
+If \|p~points to such a node, and if the
+offset list for, say, the fourth octant has entries $w_0$, $w_1$, \dots,
+$w_n$,~$w_{n+1}$, then $\\{info}(\|p+\\{fourth\_octant})$ will equal~$n$, and
+$\\{link}(\|p+\\{fourth\_octant})$ will point to the offset node
+containing~$w_0$.
+Memory location $\|p+\\{fourth\_octant}$ is said to be the {\sl header\/} of
+the pen-offset list for the fourth octant. Since this is an even-numbered
+octant, $w_0$ is the offset that goes with the fifth octant, and
+$w_{n+1}$ goes with the third.
+
+The elements of the offset list themselves are doubly linked 3-word nodes,
+containing coordinates in their \\{x\_coord} and \\{y\_coord} fields.
+The two link fields are called \\{link} and \\{knil}; if \|w~points to
+the node for~$w_k$, then $\\{link}(\|w)$ and $\\{knil}(\|w)$ point respectively
+to the nodes for $w\k$ and~$w_{k-1}$. If \|h is the list header,
+$\\{link}(\|h)$ points to the node for~$w_0$ and $\\{knil}(\\{link}(\|h))$ to
+the
+node for~$w_{n+1}$.
+
+The tenth word of a pen header node contains the maximum absolute value of
+an $x$ or $y$ coordinate among all of the unskewed pen offsets.
+
+The \\{link} field of a pen header node should be \\{null} if and only if
+the pen has no offsets.
+
+\Y\P\D \37$\\{pen\_node\_size}=10$\par
+\P\D \37$\\{coord\_node\_size}=3$\par
+\P\D \37$\\{max\_offset}(\#)\S\\{mem}[\#+9].\\{sc}$\par
+\fi
+
+\M473. The \\{print\_pen} subroutine illustrates these conventions by
+reconstructing the vertices of a polygon from \MF's complicated
+internal offset representation.
+
+\Y\P$\4\X257:Declare subroutines for printing expressions\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_pen}(\|p:\\{pointer};\,\35\|s:\\{str%
+\_number};\,\35\\{nuline}:\\{boolean})$;\6
+\4\&{var} \37\\{nothing\_printed}: \37\\{boolean};\C{has there been any action
+yet?}\6
+\|k: \37$1\to8$;\C{octant number}\6
+\|h: \37\\{pointer};\C{offset list head}\6
+$\|m,\39\|n$: \37\\{integer};\C{offset indices}\6
+$\|w,\39\\{ww}$: \37\\{pointer};\C{pointers that traverse the offset list}\2\6
+\&{begin} \37$\\{print\_diagnostic}(\.{"Pen\ polygon"},\39\|s,\39\\{nuline})$;\5
+$\\{nothing\_printed}\K\\{true}$;\5
+\\{print\_ln};\6
+\&{for} $\|k\K1\mathrel{\&{to}}8$ \1\&{do}\6
+\&{begin} \37$\\{octant}\K\\{octant\_code}[\|k]$;\5
+$\|h\K\|p+\\{octant}$;\5
+$\|n\K\\{info}(\|h)$;\5
+$\|w\K\\{link}(\|h)$;\6
+\&{if} $\R\\{odd}(\|k)$ \1\&{then}\5
+$\|w\K\\{knil}(\|w)$;\C{in even octants, start at $w_{n+1}$}\2\6
+\&{for} $\|m\K1\mathrel{\&{to}}\|n+1$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{odd}(\|k)$ \1\&{then}\5
+$\\{ww}\K\\{link}(\|w)$\ \&{else} $\\{ww}\K\\{knil}(\|w)$;\2\6
+\&{if} $(\\{x\_coord}(\\{ww})\I\\{x\_coord}(\|w))\V(\\{y\_coord}(\\{ww})\I\\{y%
+\_coord}(\|w))$ \1\&{then}\5
+\X474:Print the unskewed and unrotated coordinates of node \\{ww}\X;\2\6
+$\|w\K\\{ww}$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{if} $\\{nothing\_printed}$ \1\&{then}\6
+\&{begin} \37$\|w\K\\{link}(\|p+\\{first\_octant})$;\5
+$\\{print\_two}(\\{x\_coord}(\|w)+\\{y\_coord}(\|w),\39\\{y\_coord}(\|w))$;\6
+\&{end};\2\6
+$\\{print\_nl}(\.{"\ ..\ cycle"})$;\5
+$\\{end\_diagnostic}(\\{true})$;\6
+\&{end};\par
+\fi
+
+\M474. \P$\X474:Print the unskewed and unrotated coordinates of node \\{ww}\X%
+\S$\6
+\&{begin} \37\&{if} $\\{nothing\_printed}$ \1\&{then}\5
+$\\{nothing\_printed}\K\\{false}$\6
+\4\&{else} $\\{print\_nl}(\.{"\ ..\ "})$;\2\6
+$\\{print\_two\_true}(\\{x\_coord}(\\{ww}),\39\\{y\_coord}(\\{ww}))$;\6
+\&{end}\par
+\U473.\fi
+
+\M475. A null pen polygon, which has just one vertex $(0,0)$, is
+predeclared for error recovery. It doesn't need a proper
+reference count, because the \\{toss\_pen} procedure below
+will never delete it from memory.
+
+\Y\P$\4\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}\S$\6
+$\\{ref\_count}(\\{null\_pen})\K\\{null}$;\5
+$\\{link}(\\{null\_pen})\K\\{null}$;\6
+$\\{info}(\\{null\_pen}+1)\K1$;\5
+$\\{link}(\\{null\_pen}+1)\K\\{null\_coords}$;\6
+\&{for} $\|k\K\\{null\_pen}+2\mathrel{\&{to}}\\{null\_pen}+8$ \1\&{do}\5
+$\\{mem}[\|k]\K\\{mem}[\\{null\_pen}+1]$;\2\6
+$\\{max\_offset}(\\{null\_pen})\K0$;\6
+$\\{link}(\\{null\_coords})\K\\{null\_coords}$;\5
+$\\{knil}(\\{null\_coords})\K\\{null\_coords}$;\6
+$\\{x\_coord}(\\{null\_coords})\K0$;\5
+$\\{y\_coord}(\\{null\_coords})\K0$;\par
+\fi
+
+\M476. Here's a trivial subroutine that inserts a copy of an offset
+on the \\{link} side of its clone in the doubly linked list.
+
+\Y\P\4\&{procedure}\1\ \37$\\{dup\_offset}(\|w:\\{pointer})$;\6
+\4\&{var} \37\|r: \37\\{pointer};\C{the new node}\2\6
+\&{begin} \37$\|r\K\\{get\_node}(\\{coord\_node\_size})$;\5
+$\\{x\_coord}(\|r)\K\\{x\_coord}(\|w)$;\5
+$\\{y\_coord}(\|r)\K\\{y\_coord}(\|w)$;\5
+$\\{link}(\|r)\K\\{link}(\|w)$;\5
+$\\{knil}(\\{link}(\|w))\K\|r$;\5
+$\\{knil}(\|r)\K\|w$;\5
+$\\{link}(\|w)\K\|r$;\6
+\&{end};\par
+\fi
+
+\M477. The following algorithm is somewhat more interesting: It converts a
+knot list for a cyclic path into a pen polygon, ignoring everything
+but the \\{x\_coord}, \\{y\_coord}, and \\{link} fields. If the given path
+vertices do not define a convex polygon, an error message is issued
+and the null pen is returned.
+
+\Y\P\4\&{function}\1\ \37$\\{make\_pen}(\|h:\\{pointer})$: \37\\{pointer};\6
+\4\&{label} \37$\\{done},\39\\{done1},\39\\{not\_found},\39\\{found}$;\6
+\4\&{var} \37$\|o,\39\\{oo},\39\|k$: \37\\{small\_number};\C{octant
+numbers---old, new, and current}\6
+\|p: \37\\{pointer};\C{top-level node for the new pen}\6
+$\|q,\39\|r,\39\|s,\39\|w,\39\\{hh}$: \37\\{pointer};\C{for list manipulation}\6
+\|n: \37\\{integer};\C{offset counter}\6
+$\\{dx},\39\\{dy}$: \37\\{scaled};\C{polygon direction}\6
+\\{mc}: \37\\{scaled};\C{the largest coordinate}\2\6
+\&{begin} \37\X479:Stamp all nodes with an octant code, compute the maximum
+offset, and set \\{hh} to the node that begins the first octant; \&{goto} %
+\\{not\_found} if there's a problem\X;\6
+\&{if} $\\{mc}\G\\{fraction\_one}-\\{half\_unit}$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\|p\K\\{get\_node}(\\{pen\_node\_size})$;\5
+$\|q\K\\{hh}$;\5
+$\\{max\_offset}(\|p)\K\\{mc}$;\5
+$\\{ref\_count}(\|p)\K\\{null}$;\6
+\&{if} $\\{link}(\|q)\I\|q$ \1\&{then}\5
+$\\{link}(\|p)\K\\{null}+1$;\2\6
+\&{for} $\|k\K1\mathrel{\&{to}}8$ \1\&{do}\5
+\X481:Construct the offset list for the \|kth octant\X;\2\6
+\&{goto} \37\\{found};\6
+\4\\{not\_found}: \37$\|p\K\\{null\_pen}$;\5
+\X478:Complain about a bad pen path\X;\6
+\4\\{found}: \37\&{if} $\\{internal}[\\{tracing\_pens}]>0$ \1\&{then}\5
+$\\{print\_pen}(\|p,\39\.{"\ (newly\ created)"},\39\\{true})$;\2\6
+$\\{make\_pen}\K\|p$;\6
+\&{end};\par
+\fi
+
+\M478. \P$\X478:Complain about a bad pen path\X\S$\6
+\&{if} $\\{mc}\G\\{fraction\_one}-\\{half\_unit}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Pen\ too\ large"})$;\5
+$\\{help2}(\.{"The\ cycle\ you\ specified\ has\ a\ coordinate\ of\ 4095.5\ or\
+more."})$\6
+$(\.{"So\ I\'ve\ replaced\ it\ by\ the\ trivial\ path\ \`(0,0)..cycle\'."})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"Pen\ cycle\ must\ be\ convex"})$;\5
+$\\{help3}(\.{"The\ cycle\ you\ specified\ either\ has\ consecutive\ equal\
+points"})$\6
+$(\.{"or\ turns\ right\ or\ turns\ through\ more\ than\ 360\ degrees."})$\6
+$(\.{"So\ I\'ve\ replaced\ it\ by\ the\ trivial\ path\ \`(0,0)..cycle\'."})$;\6
+\&{end};\2\6
+\\{put\_get\_error}\par
+\U477.\fi
+
+\M479. There should be exactly one node whose octant number is less than its
+predecessor in the cycle; that is node~\\{hh}.
+
+The loop here will terminate in all cases, but the proof is somewhat tricky:
+If there are at least two distinct $y$~coordinates in the cycle, we will have
+$\|o>4$ and $\|o\L4$ at different points of the cycle. Otherwise there are
+at least two distinct $x$~coordinates, and we will have $\|o>2$ somewhere,
+$\|o\L2$ somewhere.
+
+\Y\P$\4\X479:Stamp all nodes with an octant code, compute the maximum offset,
+and set \\{hh} to the node that begins the first octant; \&{goto} \\{not%
+\_found} if there's a problem\X\S$\6
+$\|q\K\|h$;\5
+$\|r\K\\{link}(\|q)$;\5
+$\\{mc}\K\\{abs}(\\{x\_coord}(\|h))$;\6
+\&{if} $\|q=\|r$ \1\&{then}\6
+\&{begin} \37$\\{hh}\K\|h$;\5
+$\\{right\_type}(\|h)\K0$;\C{this trick is explained below}\6
+\&{if} $\\{mc}<\\{abs}(\\{y\_coord}(\|h))$ \1\&{then}\5
+$\\{mc}\K\\{abs}(\\{y\_coord}(\|h))$;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|o\K0$;\5
+$\\{hh}\K\\{null}$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|s\K\\{link}(\|r)$;\6
+\&{if} $\\{mc}<\\{abs}(\\{x\_coord}(\|r))$ \1\&{then}\5
+$\\{mc}\K\\{abs}(\\{x\_coord}(\|r))$;\2\6
+\&{if} $\\{mc}<\\{abs}(\\{y\_coord}(\|r))$ \1\&{then}\5
+$\\{mc}\K\\{abs}(\\{y\_coord}(\|r))$;\2\6
+$\\{dx}\K\\{x\_coord}(\|r)-\\{x\_coord}(\|q)$;\5
+$\\{dy}\K\\{y\_coord}(\|r)-\\{y\_coord}(\|q)$;\6
+\&{if} $\\{dx}=0$ \1\&{then}\6
+\&{if} $\\{dy}=0$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\C{double point}\2\2\6
+\&{if} $\\{ab\_vs\_cd}(\\{dx},\39\\{y\_coord}(\|s)-\\{y\_coord}(\|r),\39\\{dy},%
+\39\\{x\_coord}(\|s)-\\{x\_coord}(\|r))<0$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\C{right turn}\2\6
+\X480:Determine the octant code for direction $(\\{dx},\\{dy})$\X;\6
+$\\{right\_type}(\|q)\K\\{octant}$;\5
+$\\{oo}\K\\{octant\_number}[\\{octant}]$;\6
+\&{if} $\|o>\\{oo}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{hh}\I\\{null}$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\C{$>360^\circ$}\2\6
+$\\{hh}\K\|q$;\6
+\&{end};\2\6
+$\|o\K\\{oo}$;\6
+\&{if} $(\|q=\|h)\W(\\{hh}\I\\{null})$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|q\K\|r$;\5
+$\|r\K\|s$;\6
+\&{end};\2\6
+\4\\{done}: \37\&{end}\2\par
+\U477.\fi
+
+\M480. We want the octant for $(-\\{dx},-\\{dy})$ to be
+exactly opposite the octant for $(\\{dx},\\{dy})$.
+
+\Y\P$\4\X480:Determine the octant code for direction $(\\{dx},\\{dy})$\X\S$\6
+\&{if} $\\{dx}>0$ \1\&{then}\5
+$\\{octant}\K\\{first\_octant}$\6
+\4\&{else} \&{if} $\\{dx}=0$ \1\&{then}\6
+\&{if} $\\{dy}>0$ \1\&{then}\5
+$\\{octant}\K\\{first\_octant}$\ \&{else} $\\{octant}\K\\{first\_octant}+%
+\\{negate\_x}$\2\6
+\4\&{else} \&{begin} \37$\\{negate}(\\{dx})$;\5
+$\\{octant}\K\\{first\_octant}+\\{negate\_x}$;\6
+\&{end};\2\2\6
+\&{if} $\\{dy}<0$ \1\&{then}\6
+\&{begin} \37$\\{negate}(\\{dy})$;\5
+$\\{octant}\K\\{octant}+\\{negate\_y}$;\6
+\&{end}\6
+\4\&{else} \&{if} $\\{dy}=0$ \1\&{then}\6
+\&{if} $\\{octant}>\\{first\_octant}$ \1\&{then}\5
+$\\{octant}\K\\{first\_octant}+\\{negate\_x}+\\{negate\_y}$;\2\2\2\6
+\&{if} $\\{dx}<\\{dy}$ \1\&{then}\5
+$\\{octant}\K\\{octant}+\\{switch\_x\_and\_y}$\2\par
+\U479.\fi
+
+\M481. Now \|q points to the node that the present octant shares with the
+previous
+octant, and $\\{right\_type}(\|q)$ is the octant code during which \|q~should
+advance.
+We have set $\\{right\_type}(\|q)=0$ in the special case that \|q should never
+advance
+(because the pen is degenerate).
+
+The number of offsets \|n must be smaller than \\{max\_quarterword}, because
+the \\{fill\_envelope} routine stores $\|n+1$ in the \\{right\_type} field
+of a knot node.
+
+\Y\P$\4\X481:Construct the offset list for the \|kth octant\X\S$\6
+\&{begin} \37$\\{octant}\K\\{octant\_code}[\|k]$;\5
+$\|n\K0$;\5
+$\|h\K\|p+\\{octant}$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|r\K\\{get\_node}(\\{coord\_node\_size})$;\5
+$\\{skew}(\\{x\_coord}(\|q),\39\\{y\_coord}(\|q),\39\\{octant})$;\5
+$\\{x\_coord}(\|r)\K\\{cur\_x}$;\5
+$\\{y\_coord}(\|r)\K\\{cur\_y}$;\6
+\&{if} $\|n=0$ \1\&{then}\5
+$\\{link}(\|h)\K\|r$\6
+\4\&{else} \X482:Link node \|r to the previous node\X;\2\6
+$\|w\K\|r$;\6
+\&{if} $\\{right\_type}(\|q)\I\\{octant}$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+$\|q\K\\{link}(\|q)$;\5
+$\\{incr}(\|n)$;\6
+\&{end};\2\6
+\4\\{done1}: \37\X483:Finish linking the offset nodes, and duplicate the
+borderline offset nodes if necessary\X;\6
+\&{if} $\|n\G\\{max\_quarterword}$ \1\&{then}\5
+$\\{overflow}(\.{"pen\ polygon\ size"},\39\\{max\_quarterword})$;\2\6
+$\\{info}(\|h)\K\|n$;\6
+\&{end}\par
+\U477.\fi
+
+\M482. Now \|w points to the node that was inserted most recently, and
+\|k is the current octant number.
+
+\Y\P$\4\X482:Link node \|r to the previous node\X\S$\6
+\&{if} $\\{odd}(\|k)$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|w)\K\|r$;\5
+$\\{knil}(\|r)\K\|w$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{knil}(\|w)\K\|r$;\5
+$\\{link}(\|r)\K\|w$;\6
+\&{end}\2\par
+\U481.\fi
+
+\M483. We have inserted $\|n+1$ nodes; it remains to duplicate the nodes at the
+ends, if slopes 0 and~$\infty$ aren't already represented. At the end of
+this section the total number of offset nodes should be $\|n+2$
+(since we call them $w_0$, $w_1$, \dots,~$w_{n+1}$).
+
+\Y\P$\4\X483:Finish linking the offset nodes, and duplicate the borderline
+offset nodes if necessary\X\S$\6
+$\|r\K\\{link}(\|h)$;\6
+\&{if} $\\{odd}(\|k)$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|w)\K\|r$;\5
+$\\{knil}(\|r)\K\|w$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{knil}(\|w)\K\|r$;\5
+$\\{link}(\|r)\K\|w$;\5
+$\\{link}(\|h)\K\|w$;\5
+$\|r\K\|w$;\6
+\&{end};\2\6
+\&{if} $(\\{y\_coord}(\|r)\I\\{y\_coord}(\\{link}(\|r)))\V(\|n=0)$ \1\&{then}\6
+\&{begin} \37$\\{dup\_offset}(\|r)$;\5
+$\\{incr}(\|n)$;\6
+\&{end};\2\6
+$\|r\K\\{knil}(\|r)$;\6
+\&{if} $\\{x\_coord}(\|r)\I\\{x\_coord}(\\{knil}(\|r))$ \1\&{then}\5
+$\\{dup\_offset}(\|r)$\6
+\4\&{else} $\\{decr}(\|n)$\2\par
+\U481.\fi
+
+\M484. Conversely, \\{make\_path} goes back from a pen to a cyclic path that
+might have generated it. The structure of this subroutine is essentially
+the same as \\{print\_pen}.
+
+\Y\P\hbox{\4}\X486:Declare the function called \\{trivial\_knot}\X\6
+\4\&{function}\1\ \37$\\{make\_path}(\\{pen\_head}:\\{pointer})$: \37%
+\\{pointer};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the most recently copied knot}\6
+\|k: \37$1\to8$;\C{octant number}\6
+\|h: \37\\{pointer};\C{offset list head}\6
+$\|m,\39\|n$: \37\\{integer};\C{offset indices}\6
+$\|w,\39\\{ww}$: \37\\{pointer};\C{pointers that traverse the offset list}\2\6
+\&{begin} \37$\|p\K\\{temp\_head}$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}8$ \1\&{do}\6
+\&{begin} \37$\\{octant}\K\\{octant\_code}[\|k]$;\5
+$\|h\K\\{pen\_head}+\\{octant}$;\5
+$\|n\K\\{info}(\|h)$;\5
+$\|w\K\\{link}(\|h)$;\6
+\&{if} $\R\\{odd}(\|k)$ \1\&{then}\5
+$\|w\K\\{knil}(\|w)$;\C{in even octants, start at $w_{n+1}$}\2\6
+\&{for} $\|m\K1\mathrel{\&{to}}\|n+1$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{odd}(\|k)$ \1\&{then}\5
+$\\{ww}\K\\{link}(\|w)$\ \&{else} $\\{ww}\K\\{knil}(\|w)$;\2\6
+\&{if} $(\\{x\_coord}(\\{ww})\I\\{x\_coord}(\|w))\V(\\{y\_coord}(\\{ww})\I\\{y%
+\_coord}(\|w))$ \1\&{then}\5
+\X485:Copy the unskewed and unrotated coordinates of node \\{ww}\X;\2\6
+$\|w\K\\{ww}$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{if} $\|p=\\{temp\_head}$ \1\&{then}\6
+\&{begin} \37$\|w\K\\{link}(\\{pen\_head}+\\{first\_octant})$;\5
+$\|p\K\\{trivial\_knot}(\\{x\_coord}(\|w)+\\{y\_coord}(\|w),\39\\{y\_coord}(%
+\|w))$;\5
+$\\{link}(\\{temp\_head})\K\|p$;\6
+\&{end};\2\6
+$\\{link}(\|p)\K\\{link}(\\{temp\_head})$;\5
+$\\{make\_path}\K\\{link}(\\{temp\_head})$;\6
+\&{end};\par
+\fi
+
+\M485. \P$\X485:Copy the unskewed and unrotated coordinates of node \\{ww}\X\S$%
+\6
+\&{begin} \37$\\{unskew}(\\{x\_coord}(\\{ww}),\39\\{y\_coord}(\\{ww}),\39%
+\\{octant})$;\5
+$\\{link}(\|p)\K\\{trivial\_knot}(\\{cur\_x},\39\\{cur\_y})$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end}\par
+\U484.\fi
+
+\M486. \P$\X486:Declare the function called \\{trivial\_knot}\X\S$\6
+\4\&{function}\1\ \37$\\{trivial\_knot}(\|x,\39\|y:\\{scaled})$: \37%
+\\{pointer};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{a new knot for explicit coordinates \|x and
+\|y}\2\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{left\_type}(\|p)\K\\{explicit}$;\5
+$\\{right\_type}(\|p)\K\\{explicit}$;\6
+$\\{x\_coord}(\|p)\K\|x$;\5
+$\\{left\_x}(\|p)\K\|x$;\5
+$\\{right\_x}(\|p)\K\|x$;\6
+$\\{y\_coord}(\|p)\K\|y$;\5
+$\\{left\_y}(\|p)\K\|y$;\5
+$\\{right\_y}(\|p)\K\|y$;\6
+$\\{trivial\_knot}\K\|p$;\6
+\&{end};\par
+\U484.\fi
+
+\M487. That which can be created can be destroyed.
+
+\Y\P\D \37$\\{add\_pen\_ref}(\#)\S\\{incr}(\\{ref\_count}(\#))$\par
+\P\D \37$\\{delete\_pen\_ref}(\#)\S$\1\6
+\&{if} $\\{ref\_count}(\#)=\\{null}$ \1\&{then}\5
+$\\{toss\_pen}(\#)$\6
+\4\&{else} $\\{decr}(\\{ref\_count}(\#))$\2\2\par
+\Y\P$\4\X268:Declare the recycling subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{toss\_pen}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|k: \37$1\to8$;\C{relative header locations}\6
+$\|w,\39\\{ww}$: \37\\{pointer};\C{pointers to offset nodes}\2\6
+\&{begin} \37\&{if} $\|p\I\\{null\_pen}$ \1\&{then}\6
+\&{begin} \37\&{for} $\|k\K1\mathrel{\&{to}}8$ \1\&{do}\6
+\&{begin} \37$\|w\K\\{link}(\|p+\|k)$;\6
+\1\&{repeat} \37$\\{ww}\K\\{link}(\|w)$;\5
+$\\{free\_node}(\|w,\39\\{coord\_node\_size})$;\5
+$\|w\K\\{ww}$;\6
+\4\&{until}\5
+$\|w=\\{link}(\|p+\|k)$;\2\6
+\&{end};\2\6
+$\\{free\_node}(\|p,\39\\{pen\_node\_size})$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M488. The \\{find\_offset} procedure sets $(\\{cur\_x},\\{cur\_y})$ to the
+offset associated
+with a given direction~$(\|x,\|y)$ and a given pen~\|p. If $\|x=\|y=0$, the
+result is $(0,0)$. If two different offsets apply, one of them is
+chosen arbitrarily.
+
+\Y\P\4\&{procedure}\1\ \37$\\{find\_offset}(\|x,\39\|y:\\{scaled};\,\35\|p:%
+\\{pointer})$;\6
+\4\&{label} \37$\\{done},\39\\{exit}$;\6
+\4\&{var} \37\\{octant}: \37$\\{first\_octant}\to\\{sixth\_octant}$;\C{octant
+code for $(\|x,\|y)$}\6
+\|s: \37$-1\to+1$;\C{sign of the octant}\6
+\|n: \37\\{integer};\C{number of offsets remaining}\6
+$\|h,\39\|w,\39\\{ww}$: \37\\{pointer};\C{list traversal registers}\2\6
+\&{begin} \37\X489:Compute the octant code; skew and rotate the coordinates $(%
+\|x,\|y)$\X;\6
+\&{if} $\\{odd}(\\{octant\_number}[\\{octant}])$ \1\&{then}\5
+$\|s\K-1$\ \&{else} $\|s\K+1$;\2\6
+$\|h\K\|p+\\{octant}$;\5
+$\|w\K\\{link}(\\{link}(\|h))$;\5
+$\\{ww}\K\\{link}(\|w)$;\5
+$\|n\K\\{info}(\|h)$;\6
+\&{while} $\|n>1$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{ab\_vs\_cd}(\|x,\39\\{y\_coord}(\\{ww})-\\{y\_coord}(%
+\|w),\39\30\|y,\39\\{x\_coord}(\\{ww})-\\{x\_coord}(\|w))\I\|s$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|w\K\\{ww}$;\5
+$\\{ww}\K\\{link}(\|w)$;\5
+$\\{decr}(\|n)$;\6
+\&{end};\2\6
+\4\\{done}: \37$\\{unskew}(\\{x\_coord}(\|w),\39\\{y\_coord}(\|w),\39%
+\\{octant})$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M489. \P$\X489:Compute the octant code; skew and rotate the coordinates $(\|x,%
+\|y)$\X\S$\6
+\&{if} $\|x>0$ \1\&{then}\5
+$\\{octant}\K\\{first\_octant}$\6
+\4\&{else} \&{if} $\|x=0$ \1\&{then}\6
+\&{if} $\|y\L0$ \1\&{then}\6
+\&{if} $\|y=0$ \1\&{then}\6
+\&{begin} \37$\\{cur\_x}\K0$;\5
+$\\{cur\_y}\K0$;\5
+\&{return};\6
+\&{end}\6
+\4\&{else} $\\{octant}\K\\{first\_octant}+\\{negate\_x}$\2\6
+\4\&{else} $\\{octant}\K\\{first\_octant}$\2\6
+\4\&{else} \&{begin} \37$\|x\K-\|x$;\6
+\&{if} $\|y=0$ \1\&{then}\5
+$\\{octant}\K\\{first\_octant}+\\{negate\_x}+\\{negate\_y}$\6
+\4\&{else} $\\{octant}\K\\{first\_octant}+\\{negate\_x}$;\2\6
+\&{end};\2\2\6
+\&{if} $\|y<0$ \1\&{then}\6
+\&{begin} \37$\\{octant}\K\\{octant}+\\{negate\_y}$;\5
+$\|y\K-\|y$;\6
+\&{end};\2\6
+\&{if} $\|x\G\|y$ \1\&{then}\5
+$\|x\K\|x-\|y$\6
+\4\&{else} \&{begin} \37$\\{octant}\K\\{octant}+\\{switch\_x\_and\_y}$;\5
+$\|x\K\|y-\|x$;\5
+$\|y\K\|y-\|x$;\6
+\&{end}\2\par
+\U488.\fi
+
+\N490. \[24] Filling an envelope.
+We are about to reach the culmination of \MF's digital plotting routines:
+Almost all of the previous algorithms will be brought to bear on \MF's
+most difficult task, which is to fill the envelope of a given cyclic path
+with respect to a given pen polygon.
+
+But we still must complete some of the preparatory work before taking such
+a big plunge.
+
+\fi
+
+\M491. Given a pointer \|c to a nonempty list of cubics,
+and a pointer~\|h to the header information of a pen polygon segment,
+the \\{offset\_prep} routine changes the list into cubics that are
+associated with particular pen offsets. Namely, the cubic between \|p
+and~\|q should be associated with the \|kth offset when $\\{right\_type}(\|p)=%
+\|k$.
+
+List \|c is actually part of a cycle spec, so it terminates at the
+first node whose \\{right\_type} is \\{endpoint}. The cubics all have
+monotone-nondecreasing $x'(t)$ and $y'(t)$.
+
+\Y\P\hbox{\4}\X493:Declare subroutines needed by \\{offset\_prep}\X\6
+\4\&{procedure}\1\ \37$\\{offset\_prep}(\|c,\39\|h:\\{pointer})$;\6
+\4\&{label} \37$\\{done},\39\\{not\_found}$;\6
+\4\&{var} \37\|n: \37\\{halfword};\C{the number of pen offsets}\6
+$\|p,\39\|q,\39\|r,\39\\{lh},\39\\{ww}$: \37\\{pointer};\C{for list
+manipulation}\6
+\|k: \37\\{halfword};\C{the current offset index}\6
+\|w: \37\\{pointer};\C{a pointer to offset $w_k$}\6
+\X495:Other local variables for \\{offset\_prep}\X\2\6
+\&{begin} \37$\|p\K\|c$;\5
+$\|n\K\\{info}(\|h)$;\5
+$\\{lh}\K\\{link}(\|h)$;\C{now \\{lh} points to $w_0$}\6
+\&{while} $\\{right\_type}(\|p)\I\\{endpoint}$ \1\&{do}\6
+\&{begin} \37$\|q\K\\{link}(\|p)$;\5
+\X494:Split the cubic between \|p and \|q, if necessary, into cubics associated
+with single offsets, after which \|q should point to the end of the final such
+cubic\X;\6
+\X492:Advance \|p to node \|q, removing any ``dead'' cubics that might have
+been introduced by the splitting process\X;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M492. \P$\X492:Advance \|p to node \|q, removing any ``dead'' cubics that
+might have been introduced by the splitting process\X\S$\6
+\1\&{repeat} \37$\|r\K\\{link}(\|p)$;\6
+\&{if} $\\{x\_coord}(\|p)=\\{right\_x}(\|p)$ \1\&{then}\6
+\&{if} $\\{y\_coord}(\|p)=\\{right\_y}(\|p)$ \1\&{then}\6
+\&{if} $\\{x\_coord}(\|p)=\\{left\_x}(\|r)$ \1\&{then}\6
+\&{if} $\\{y\_coord}(\|p)=\\{left\_y}(\|r)$ \1\&{then}\6
+\&{if} $\\{x\_coord}(\|p)=\\{x\_coord}(\|r)$ \1\&{then}\6
+\&{if} $\\{y\_coord}(\|p)=\\{y\_coord}(\|r)$ \1\&{then}\6
+\&{begin} \37$\\{remove\_cubic}(\|p)$;\6
+\&{if} $\|r=\|q$ \1\&{then}\5
+$\|q\K\|p$;\2\6
+$\|r\K\|p$;\6
+\&{end};\2\2\2\2\2\2\6
+$\|p\K\|r$;\6
+\4\&{until}\5
+$\|p=\|q$\2\par
+\U491.\fi
+
+\M493. The splitting process uses a subroutine like \\{split\_cubic}, but
+(for ``bulletproof'' operation) we check to make sure that the
+resulting (skewed) coordinates satisfy $\Delta x\G0$ and $\Delta y\G0$
+after splitting; \\{make\_spec} has made sure that these relations hold
+before splitting. (This precaution is surely unnecessary, now that
+\\{make\_spec} is so much more careful than it used to be. But who
+wants to take a chance? Maybe the hardware will fail or something.)
+
+\Y\P$\4\X493:Declare subroutines needed by \\{offset\_prep}\X\S$\6
+\4\&{procedure}\1\ \37$\\{split\_for\_offset}(\|p:\\{pointer};\,\35\|t:%
+\\{fraction})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the successor of \|p}\6
+\|r: \37\\{pointer};\C{the new node}\2\6
+\&{begin} \37$\|q\K\\{link}(\|p)$;\5
+$\\{split\_cubic}(\|p,\39\|t,\39\\{x\_coord}(\|q),\39\\{y\_coord}(\|q))$;\5
+$\|r\K\\{link}(\|p)$;\6
+\&{if} $\\{y\_coord}(\|r)<\\{y\_coord}(\|p)$ \1\&{then}\5
+$\\{y\_coord}(\|r)\K\\{y\_coord}(\|p)$\6
+\4\&{else} \&{if} $\\{y\_coord}(\|r)>\\{y\_coord}(\|q)$ \1\&{then}\5
+$\\{y\_coord}(\|r)\K\\{y\_coord}(\|q)$;\2\2\6
+\&{if} $\\{x\_coord}(\|r)<\\{x\_coord}(\|p)$ \1\&{then}\5
+$\\{x\_coord}(\|r)\K\\{x\_coord}(\|p)$\6
+\4\&{else} \&{if} $\\{x\_coord}(\|r)>\\{x\_coord}(\|q)$ \1\&{then}\5
+$\\{x\_coord}(\|r)\K\\{x\_coord}(\|q)$;\2\2\6
+\&{end};\par
+\A497.
+\U491.\fi
+
+\M494. If the pen polygon has \|n offsets, and if $w_k=(u_k,v_k)$ is the $k$th
+of these, the $k$th pen slope is defined by the formula
+$$s_k={v\k-v_k\over u\k-u_k},\qquad\hbox{for $0<k<n$}.$$
+In odd-numbered octants, the numerator and denominator of this fraction
+will be positive; in even-numbered octants they will both be negative.
+Furthermore we always have $0=s_0<s_1<\cdots<s_n=\infty$. The goal of
+\\{offset\_prep} is to find an offset index~\|k to associate with
+each cubic, such that the slope $s(t)$ of the cubic satisfies
+$$s_{k-1}\le s(t)\le s_k\qquad\hbox{for $0\le t\le 1$.}\eqno(*)$$
+We may have to split a cubic into as many as $2n-1$ pieces before each
+piece corresponds to a unique offset.
+
+\Y\P$\4\X494:Split the cubic between \|p and \|q, if necessary, into cubics
+associated with single offsets, after which \|q should point to the end of the
+final such cubic\X\S$\6
+\&{if} $\|n\L1$ \1\&{then}\5
+$\\{right\_type}(\|p)\K1$\C{this case is easy}\6
+\4\&{else} \&{begin} \37\X496:Prepare for derivative computations; \&{goto} %
+\\{not\_found} if the current cubic is dead\X;\6
+\X501:Find the initial slope, $\\{dy}/\\{dx}$\X;\6
+\&{if} $\\{dx}=0$ \1\&{then}\5
+\X505:Handle the special case of infinite slope\X\6
+\4\&{else} \&{begin} \37\X502:Find the index \|k such that $s_{k-1}\L\\{dy}/%
+\\{dx}<s_k$\X;\6
+\X503:Complete the offset splitting process\X;\6
+\&{end};\2\6
+\4\\{not\_found}: \37\&{end}\2\par
+\U491.\fi
+
+\M495. The slope of a cubic $B(z_0,z_1,z_2,z_3;t)=\bigl(x(t),y(t)\bigr)$ can be
+calculated from the quadratic polynomials
+${1\over3}x'(t)=B(x_1-x_0,x_2-x_1,x_3-x_2;t)$ and
+${1\over3}y'(t)=B(y_1-y_0,y_2-y_1,y_3-y_2;t)$.
+Since we may be calculating slopes from several cubics
+split from the current one, it is desirable to do these calculations
+without losing too much precision. ``Scaled up'' values of the
+derivatives, which will be less tainted by accumulated errors than
+derivatives found from the cubics themselves, are maintained in
+local variables \\{x0}, \\{x1}, and \\{x2}, representing $X_0=2^l(x_1-x_0)$,
+$X_1=2^l(x_2-x_1)$, and $X_2=2^l(x_3-x_2)$; similarly \\{y0}, \\{y1}, and~%
+\\{y2}
+represent $Y_0=2^l(y_1-y_0)$, $Y_1=2^l(y_2-y_1)$, and $Y_2=2^l(y_3-y_2)$.
+To test whether the slope of the cubic is $\ge s$ or $\le s$, we will test
+the sign of the quadratic ${1\over3}2^l\bigl(y'(t)-sx'(t)\bigr)$ if $s\le1$,
+or ${1\over3}2^l\bigl(y'(t)/s-x'(t)\bigr)$ if $s>1$.
+
+\Y\P$\4\X495:Other local variables for \\{offset\_prep}\X\S$\6
+\4$\\{x0},\39\\{x1},\39\\{x2},\39\\{y0},\39\\{y1},\39\\{y2}$: \37\\{integer};%
+\C{representatives of derivatives}\6
+\4$\\{t0},\39\\{t1},\39\\{t2}$: \37\\{integer};\C{coefficients of polynomial
+for slope testing}\6
+\4$\\{du},\39\\{dv},\39\\{dx},\39\\{dy}$: \37\\{integer};\C{for slopes of the
+pen and the curve}\6
+\4\\{max\_coef}: \37\\{integer};\C{used while scaling}\6
+\4$\\{x0a},\39\\{x1a},\39\\{x2a},\39\\{y0a},\39\\{y1a},\39\\{y2a}$: \37%
+\\{integer};\C{intermediate values}\6
+\4\|t: \37\\{fraction};\C{where the derivative passes through zero}\6
+\4\|s: \37\\{fraction};\C{slope or reciprocal slope}\par
+\U491.\fi
+
+\M496. \P$\X496:Prepare for derivative computations; \&{goto} \\{not\_found} if
+the current cubic is dead\X\S$\6
+$\\{x0}\K\\{right\_x}(\|p)-\\{x\_coord}(\|p)$;\C{should be $\G0$}\6
+$\\{x2}\K\\{x\_coord}(\|q)-\\{left\_x}(\|q)$;\C{likewise}\6
+$\\{x1}\K\\{left\_x}(\|q)-\\{right\_x}(\|p)$;\C{but this might be negative}\6
+$\\{y0}\K\\{right\_y}(\|p)-\\{y\_coord}(\|p)$;\5
+$\\{y2}\K\\{y\_coord}(\|q)-\\{left\_y}(\|q)$;\5
+$\\{y1}\K\\{left\_y}(\|q)-\\{right\_y}(\|p)$;\5
+$\\{max\_coef}\K\\{abs}(\\{x0})$;\C{we take \\{abs} just to make sure}\6
+\&{if} $\\{abs}(\\{x1})>\\{max\_coef}$ \1\&{then}\5
+$\\{max\_coef}\K\\{abs}(\\{x1})$;\2\6
+\&{if} $\\{abs}(\\{x2})>\\{max\_coef}$ \1\&{then}\5
+$\\{max\_coef}\K\\{abs}(\\{x2})$;\2\6
+\&{if} $\\{abs}(\\{y0})>\\{max\_coef}$ \1\&{then}\5
+$\\{max\_coef}\K\\{abs}(\\{y0})$;\2\6
+\&{if} $\\{abs}(\\{y1})>\\{max\_coef}$ \1\&{then}\5
+$\\{max\_coef}\K\\{abs}(\\{y1})$;\2\6
+\&{if} $\\{abs}(\\{y2})>\\{max\_coef}$ \1\&{then}\5
+$\\{max\_coef}\K\\{abs}(\\{y2})$;\2\6
+\&{if} $\\{max\_coef}=0$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\&{while} $\\{max\_coef}<\\{fraction\_half}$ \1\&{do}\6
+\&{begin} \37$\\{double}(\\{max\_coef})$;\5
+$\\{double}(\\{x0})$;\5
+$\\{double}(\\{x1})$;\5
+$\\{double}(\\{x2})$;\5
+$\\{double}(\\{y0})$;\5
+$\\{double}(\\{y1})$;\5
+$\\{double}(\\{y2})$;\6
+\&{end}\2\par
+\U494.\fi
+
+\M497. Let us first solve a special case of the problem: Suppose we
+know an index~$k$ such that either (i)~$s(t)\G s_{k-1}$ for all~$t$
+and $s(0)<s_k$, or (ii)~$s(t)\L s_k$ for all~$t$ and $s(0)>s_{k-1}$.
+Then, in a sense, we're halfway done, since one of the two inequalities
+in $(*)$ is satisfied, and the other couldn't be satisfied for
+any other value of~\|k.
+
+The \\{fin\_offset\_prep} subroutine solves the stated subproblem.
+It has a boolean parameter called \\{rising} that is \\{true} in
+case~(i), \\{false} in case~(ii). When $\\{rising}=\\{false}$, parameters
+\\{x0} through \\{y2} represent the negative of the derivative of
+the cubic following \|p; otherwise they represent the actual derivative.
+The \|w parameter should point to offset~$w_k$.
+
+\Y\P$\4\X493:Declare subroutines needed by \\{offset\_prep}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{fin\_offset\_prep}(\|p:\\{pointer};\,\35\|k:%
+\\{halfword};\,\35\|w:\\{pointer};\,\35\\{x0},\39\\{x1},\39\\{x2},\39\\{y0},\39%
+\\{y1},\39\\{y2}:\\{integer};\,\35\\{rising}:\\{boolean};\,\35\|n:%
+\\{integer})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\\{ww}: \37\\{pointer};\C{for list manipulation}\6
+$\\{du},\39\\{dv}$: \37\\{scaled};\C{for slope calculation}\6
+$\\{t0},\39\\{t1},\39\\{t2}$: \37\\{integer};\C{test coefficients}\6
+\|t: \37\\{fraction};\C{place where the derivative passes a critical slope}\6
+\|s: \37\\{fraction};\C{slope or reciprocal slope}\6
+\|v: \37\\{integer};\C{intermediate value for updating $\\{x0}\to\\{y2}$}\2\6
+\&{begin} \37\~ \1\&{loop}\6
+\&{begin} \37$\\{right\_type}(\|p)\K\|k$;\6
+\&{if} $\\{rising}$ \1\&{then}\6
+\&{if} $\|k=\|n$ \1\&{then}\5
+\&{return}\6
+\4\&{else} $\\{ww}\K\\{link}(\|w)$\C{a pointer to $w\k$}\2\6
+\4\&{else} \&{if} $\|k=1$ \1\&{then}\5
+\&{return}\6
+\4\&{else} $\\{ww}\K\\{knil}(\|w)$;\C{a pointer to $w_{k-1}$}\2\2\6
+\X498:Compute test coefficients $(\\{t0},\\{t1},\\{t2})$ for $s(t)$ versus
+$s_k$ or $s_{k-1}$\X;\6
+$\|t\K\\{crossing\_point}(\\{t0},\39\\{t1},\39\\{t2})$;\6
+\&{if} $\|t\G\\{fraction\_one}$ \1\&{then}\5
+\&{return};\2\6
+\X499:Split the cubic at $t$, and split off another cubic if the derivative
+crosses back\X;\6
+\&{if} $\\{rising}$ \1\&{then}\5
+$\\{incr}(\|k)$\ \&{else} $\\{decr}(\|k)$;\2\6
+$\|w\K\\{ww}$;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M498. \P$\X498:Compute test coefficients $(\\{t0},\\{t1},\\{t2})$ for $s(t)$
+versus $s_k$ or $s_{k-1}$\X\S$\6
+$\\{du}\K\\{x\_coord}(\\{ww})-\\{x\_coord}(\|w)$;\5
+$\\{dv}\K\\{y\_coord}(\\{ww})-\\{y\_coord}(\|w)$;\6
+\&{if} $\\{abs}(\\{du})\G\\{abs}(\\{dv})$ \1\&{then}\C{$s_{k\pm1}\le1$}\6
+\&{begin} \37$\|s\K\\{make\_fraction}(\\{dv},\39\\{du})$;\5
+$\\{t0}\K\\{take\_fraction}(\\{x0},\39\|s)-\\{y0}$;\5
+$\\{t1}\K\\{take\_fraction}(\\{x1},\39\|s)-\\{y1}$;\5
+$\\{t2}\K\\{take\_fraction}(\\{x2},\39\|s)-\\{y2}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|s\K\\{make\_fraction}(\\{du},\39\\{dv})$;\5
+$\\{t0}\K\\{x0}-\\{take\_fraction}(\\{y0},\39\|s)$;\5
+$\\{t1}\K\\{x1}-\\{take\_fraction}(\\{y1},\39\|s)$;\5
+$\\{t2}\K\\{x2}-\\{take\_fraction}(\\{y2},\39\|s)$;\6
+\&{end}\2\par
+\Us497\ET503.\fi
+
+\M499. The curve has crossed $s_k$ or $s_{k-1}$; its initial segment satisfies
+$(*)$, and it might cross again and return towards $s_k$, yielding another
+solution of $(*)$.
+
+\Y\P$\4\X499:Split the cubic at $t$, and split off another cubic if the
+derivative crosses back\X\S$\6
+\&{begin} \37$\\{split\_for\_offset}(\|p,\39\|t)$;\5
+$\\{right\_type}(\|p)\K\|k$;\5
+$\|p\K\\{link}(\|p)$;\6
+$\|v\K\\{t\_of\_the\_way}(\\{x0})(\\{x1})$;\5
+$\\{x1}\K\\{t\_of\_the\_way}(\\{x1})(\\{x2})$;\5
+$\\{x0}\K\\{t\_of\_the\_way}(\|v)(\\{x1})$;\6
+$\|v\K\\{t\_of\_the\_way}(\\{y0})(\\{y1})$;\5
+$\\{y1}\K\\{t\_of\_the\_way}(\\{y1})(\\{y2})$;\5
+$\\{y0}\K\\{t\_of\_the\_way}(\|v)(\\{y1})$;\6
+$\\{t1}\K\\{t\_of\_the\_way}(\\{t1})(\\{t2})$;\6
+\&{if} $\\{t1}>0$ \1\&{then}\5
+$\\{t1}\K0$;\C{without rounding error, \\{t1} would be $\L0$}\2\6
+$\|t\K\\{crossing\_point}(0,\39-\\{t1},\39-\\{t2})$;\6
+\&{if} $\|t<\\{fraction\_one}$ \1\&{then}\6
+\&{begin} \37$\\{split\_for\_offset}(\|p,\39\|t)$;\5
+$\\{right\_type}(\\{link}(\|p))\K\|k$;\6
+$\|v\K\\{t\_of\_the\_way}(\\{x1})(\\{x2})$;\5
+$\\{x1}\K\\{t\_of\_the\_way}(\\{x0})(\\{x1})$;\5
+$\\{x2}\K\\{t\_of\_the\_way}(\\{x1})(\|v)$;\6
+$\|v\K\\{t\_of\_the\_way}(\\{y1})(\\{y2})$;\5
+$\\{y1}\K\\{t\_of\_the\_way}(\\{y0})(\\{y1})$;\5
+$\\{y2}\K\\{t\_of\_the\_way}(\\{y1})(\|v)$;\6
+\&{end};\2\6
+\&{end}\par
+\U497.\fi
+
+\M500. Now we must consider the general problem of \\{offset\_prep}, when
+nothing is known about a given cubic. We start by finding its
+slope $s(0)$ in the vicinity of $\|t=0$.
+
+If $z'(t)=0$, the given cubic is numerically unstable, since the
+slope direction is probably being influenced primarily by rounding
+errors. A user who specifies such cuspy curves should expect to generate
+rather wild results. The present code tries its best to believe the
+existing data, as if no rounding errors were present.
+
+\fi
+
+\M501. \P$\X501:Find the initial slope, $\\{dy}/\\{dx}$\X\S$\6
+$\\{dx}\K\\{x0}$;\5
+$\\{dy}\K\\{y0}$;\6
+\&{if} $\\{dx}=0$ \1\&{then}\6
+\&{if} $\\{dy}=0$ \1\&{then}\6
+\&{begin} \37$\\{dx}\K\\{x1}$;\5
+$\\{dy}\K\\{y1}$;\6
+\&{if} $\\{dx}=0$ \1\&{then}\6
+\&{if} $\\{dy}=0$ \1\&{then}\6
+\&{begin} \37$\\{dx}\K\\{x2}$;\5
+$\\{dy}\K\\{y2}$;\6
+\&{end};\2\2\6
+\&{end}\2\2\par
+\U494.\fi
+
+\M502. The next step is to bracket the initial slope between consecutive
+slopes of the pen polygon. The most important invariant relation in the
+following loop is that $\\{dy}/\\{dx}\G\hbox{$s_{k-1}$}$.
+
+\Y\P$\4\X502:Find the index \|k such that $s_{k-1}\L\\{dy}/\\{dx}<s_k$\X\S$\6
+$\|k\K1$;\5
+$\|w\K\\{link}(\\{lh})$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\|k=\|n$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{ww}\K\\{link}(\|w)$;\6
+\&{if} $\\{ab\_vs\_cd}(\\{dy},\39\\{abs}(\\{x\_coord}(\\{ww})-\\{x\_coord}(%
+\|w)),\39\30\\{dx},\39\\{abs}(\\{y\_coord}(\\{ww})-\\{y\_coord}(\|w)))\G0$ \1%
+\&{then}\6
+\&{begin} \37$\\{incr}(\|k)$;\5
+$\|w\K\\{ww}$;\6
+\&{end}\6
+\4\&{else} \&{goto} \37\\{done};\2\6
+\&{end};\2\6
+\4\\{done}: \37\par
+\U494.\fi
+
+\M503. Finally we want to reduce the general problem to situations that
+\\{fin\_offset\_prep} can handle. If $\|k=1$, we already are in the desired
+situation. Otherwise we can split the cubic into at most three parts
+with respect to $s_{k-1}$, and apply \\{fin\_offset\_prep} to each part.
+
+\Y\P$\4\X503:Complete the offset splitting process\X\S$\6
+\&{if} $\|k=1$ \1\&{then}\5
+$\|t\K\\{fraction\_one}+1$\6
+\4\&{else} \&{begin} \37$\\{ww}\K\\{knil}(\|w)$;\5
+\X498:Compute test coefficients $(\\{t0},\\{t1},\\{t2})$ for $s(t)$ versus
+$s_k$ or $s_{k-1}$\X;\6
+$\|t\K\\{crossing\_point}(-\\{t0},\39-\\{t1},\39-\\{t2})$;\6
+\&{end};\2\6
+\&{if} $\|t\G\\{fraction\_one}$ \1\&{then}\5
+$\\{fin\_offset\_prep}(\|p,\39\|k,\39\|w,\39\\{x0},\39\\{x1},\39\\{x2},\39%
+\\{y0},\39\\{y1},\39\\{y2},\39\\{true},\39\|n)$\6
+\4\&{else} \&{begin} \37$\\{split\_for\_offset}(\|p,\39\|t)$;\5
+$\|r\K\\{link}(\|p)$;\6
+$\\{x1a}\K\\{t\_of\_the\_way}(\\{x0})(\\{x1})$;\5
+$\\{x1}\K\\{t\_of\_the\_way}(\\{x1})(\\{x2})$;\5
+$\\{x2a}\K\\{t\_of\_the\_way}(\\{x1a})(\\{x1})$;\6
+$\\{y1a}\K\\{t\_of\_the\_way}(\\{y0})(\\{y1})$;\5
+$\\{y1}\K\\{t\_of\_the\_way}(\\{y1})(\\{y2})$;\5
+$\\{y2a}\K\\{t\_of\_the\_way}(\\{y1a})(\\{y1})$;\6
+$\\{fin\_offset\_prep}(\|p,\39\|k,\39\|w,\39\\{x0},\39\\{x1a},\39\\{x2a},\39%
+\\{y0},\39\\{y1a},\39\\{y2a},\39\\{true},\39\|n)$;\5
+$\\{x0}\K\\{x2a}$;\5
+$\\{y0}\K\\{y2a}$;\5
+$\\{t1}\K\\{t\_of\_the\_way}(\\{t1})(\\{t2})$;\6
+\&{if} $\\{t1}<0$ \1\&{then}\5
+$\\{t1}\K0$;\2\6
+$\|t\K\\{crossing\_point}(0,\39\\{t1},\39\\{t2})$;\6
+\&{if} $\|t<\\{fraction\_one}$ \1\&{then}\5
+\X504:Split off another \\{rising} cubic for \\{fin\_offset\_prep}\X;\2\6
+$\\{fin\_offset\_prep}(\|r,\39\|k-1,\39\\{ww},\39-\\{x0},\39-\\{x1},\39-\\{x2},%
+\39-\\{y0},\39-\\{y1},\39-\\{y2},\39\\{false},\39\|n)$;\6
+\&{end}\2\par
+\U494.\fi
+
+\M504. \P$\X504:Split off another \\{rising} cubic for \\{fin\_offset\_prep}\X%
+\S$\6
+\&{begin} \37$\\{split\_for\_offset}(\|r,\39\|t)$;\6
+$\\{x1a}\K\\{t\_of\_the\_way}(\\{x1})(\\{x2})$;\5
+$\\{x1}\K\\{t\_of\_the\_way}(\\{x0})(\\{x1})$;\5
+$\\{x0a}\K\\{t\_of\_the\_way}(\\{x1})(\\{x1a})$;\6
+$\\{y1a}\K\\{t\_of\_the\_way}(\\{y1})(\\{y2})$;\5
+$\\{y1}\K\\{t\_of\_the\_way}(\\{y0})(\\{y1})$;\5
+$\\{y0a}\K\\{t\_of\_the\_way}(\\{y1})(\\{y1a})$;\6
+$\\{fin\_offset\_prep}(\\{link}(\|r),\39\|k,\39\|w,\39\\{x0a},\39\\{x1a},\39%
+\\{x2},\39\\{y0a},\39\\{y1a},\39\\{y2},\39\\{true},\39\|n)$;\5
+$\\{x2}\K\\{x0a}$;\5
+$\\{y2}\K\\{y0a}$;\6
+\&{end}\par
+\U503.\fi
+
+\M505. \P$\X505:Handle the special case of infinite slope\X\S$\6
+$\\{fin\_offset\_prep}(\|p,\39\|n,\39\\{knil}(\\{knil}(\\{lh})),\39-\\{x0},\39-%
+\\{x1},\39-\\{x2},\39-\\{y0},\39-\\{y1},\39-\\{y2},\39\\{false},\39\|n)$\par
+\U494.\fi
+
+\M506. OK, it's time now for the biggie. The \\{fill\_envelope} routine
+generalizes
+\\{fill\_spec} to polygonal envelopes. Its outer structure is essentially the
+same as before, except that octants with no cubics do contribute to
+the envelope.
+
+\Y\P\hbox{\4}\X510:Declare the procedure called \\{skew\_line\_edges}\X\6
+\hbox{\4}\X518:Declare the procedure called \\{dual\_moves}\X\6
+\4\&{procedure}\1\ \37$\\{fill\_envelope}(\\{spec\_head}:\\{pointer})$;\6
+\4\&{label} \37$\\{done},\39\\{done1}$;\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\C{for list traversal}\6
+\|h: \37\\{pointer};\C{head of pen offset list for current octant}\6
+\\{www}: \37\\{pointer};\C{a pen offset of temporary interest}\6
+\X511:Other local variables for \\{fill\_envelope}\X\2\6
+\&{begin} \37\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+\\{begin\_edge\_tracing};\2\6
+$\|p\K\\{spec\_head}$;\C{we assume that $\\{left\_type}(\\{spec\_head})=%
+\\{endpoint}$}\6
+\1\&{repeat} \37$\\{octant}\K\\{left\_octant}(\|p)$;\5
+$\|h\K\\{cur\_pen}+\\{octant}$;\5
+\X466:Set variable \|q to the node at the end of the current octant\X;\6
+\X508:Determine the envelope's starting and ending lattice points $(\\{m0},%
+\\{n0})$ and $(\\{m1},\\{n1})$\X;\6
+$\\{offset\_prep}(\|p,\39\|h)$;\C{this may clobber node~\|q, if it becomes
+``dead''}\6
+\X466:Set variable \|q to the node at the end of the current octant\X;\6
+\X512:Make the envelope moves for the current octant and insert them in the
+pixel data\X;\6
+$\|p\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\|p=\\{spec\_head}$;\2\6
+\&{if} $\\{internal}[\\{tracing\_edges}]>0$ \1\&{then}\5
+\\{end\_edge\_tracing};\2\6
+$\\{toss\_knot\_list}(\\{spec\_head})$;\6
+\&{end};\par
+\fi
+
+\M507. In even-numbered octants we have reflected the coordinates an odd number
+of times, hence clockwise and counterclockwise are reversed; this means that
+the envelope is being formed in a ``dual'' manner. For the time being, let's
+concentrate on odd-numbered octants, since they're easier to understand.
+After we have coded the program for odd-numbered octants, the changes needed
+to dualize it will not be so mysterious.
+
+It is convenient to assume that we enter an odd-numbered octant with
+an \\{axis} transition (where the skewed slope is zero) and leave at a
+\\{diagonal} one (where the skewed slope is infinite). Then all of the
+offset points $z(t)+w(t)$ will lie in a rectangle whose lower left and
+upper right corners are the initial and final offset points. If this
+assumption doesn't hold we can implicitly change the curve so that it does.
+For example, if the entering transition is diagonal, we can draw a
+straight line from $z_0+w_{n+1}$ to $z_0+w_0$ and continue as if the
+curve were moving rightward. The effect of this on the envelope is simply
+to ``doubly color'' the region enveloped by a section of the pen that
+goes from $w_0$ to $w_1$ to $\cdots$ to $w_{n+1}$ to~$w_0$. The additional
+straight line at the beginning (and a similar one at the end, where it
+may be necessary to go from $z_1+w_{n+1}$ to $z_1+w_0$) can be drawn by
+the \\{line\_edges} routine; we are thereby saved from the embarrassment that
+these lines travel backwards from the current octant direction.
+
+Once we have established the assumption that the curve goes from
+$z_0+w_0$ to $z_1+w_{n+1}$, any further retrograde moves that might
+occur within the octant can be essentially ignored; we merely need to
+keep track of the rightmost edge in each row, in order to compute
+the envelope.
+
+Envelope moves consist of offset cubics intermixed with straight line
+segments. We record them in a separate \\{env\_move} array, which is
+something like \\{move} but it keeps track of the rightmost position of the
+envelope in each row.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{env\_move}: \37\&{array} $[0\to\\{move\_size}]$ \1\&{of}\5
+\\{integer};\2\par
+\fi
+
+\M508. \P$\X508:Determine the envelope's starting and ending lattice points $(%
+\\{m0},\\{n0})$ and $(\\{m1},\\{n1})$\X\S$\6
+$\|w\K\\{link}(\|h)$;\ \&{if} $\\{left\_transition}(\|p)=\\{diagonal}$ \1%
+\&{then}\5
+$\|w\K\\{knil}(\|w)$;\2\6
+\&{stat} \37\&{if} $\\{internal}[\\{tracing\_edges}]>\\{unity}$ \1\&{then}\5
+\X509:Print a line of diagnostic info to introduce this octant\X;\2\6
+\&{tats}\6
+$\\{ww}\K\\{link}(\|h)$;\5
+$\\{www}\K\\{ww}$;\C{starting and ending offsets}\6
+\&{if} $\\{odd}(\\{octant\_number}[\\{octant}])$ \1\&{then}\5
+$\\{www}\K\\{knil}(\\{www})$\ \&{else} $\\{ww}\K\\{knil}(\\{ww})$;\2\6
+\&{if} $\|w\I\\{ww}$ \1\&{then}\5
+$\\{skew\_line\_edges}(\|p,\39\|w,\39\\{ww})$;\2\6
+$\\{end\_round}(\\{x\_coord}(\|p)+\\{x\_coord}(\\{ww}),\39\\{y\_coord}(\|p)+%
+\\{y\_coord}(\\{ww}))$;\5
+$\\{m0}\K\\{m1}$;\5
+$\\{n0}\K\\{n1}$;\5
+$\\{d0}\K\\{d1}$;\6
+$\\{end\_round}(\\{x\_coord}(\|q)+\\{x\_coord}(\\{www}),\39\\{y\_coord}(\|q)+%
+\\{y\_coord}(\\{www}))$;\6
+\&{if} $\\{n1}-\\{n0}\G\\{move\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"move\ table\ size"},\39\\{move\_size})$\2\par
+\U506.\fi
+
+\M509. \P$\X509:Print a line of diagnostic info to introduce this octant\X\S$\6
+\&{begin} \37$\\{print\_nl}(\.{"@\ Octant\ "})$;\5
+$\\{print}(\\{octant\_dir}[\\{octant}])$;\5
+$\\{print}(\.{"\ ("})$;\5
+$\\{print\_int}(\\{info}(\|h))$;\5
+$\\{print}(\.{"\ offset"})$;\6
+\&{if} $\\{info}(\|h)\I1$ \1\&{then}\5
+$\\{print\_char}(\.{"s"})$;\2\6
+$\\{print}(\.{"),\ from\ "})$;\5
+$\\{print\_two\_true}(\\{x\_coord}(\|p)+\\{x\_coord}(\|w),\39\\{y\_coord}(\|p)+%
+\\{y\_coord}(\|w))$;\5
+$\\{ww}\K\\{link}(\|h)$;\ \&{if} $\\{right\_transition}(\|q)=\\{diagonal}$ \1%
+\&{then}\5
+$\\{ww}\K\\{knil}(\\{ww})$;\2\6
+$\\{print}(\.{"\ to\ "})$;\5
+$\\{print\_two\_true}(\\{x\_coord}(\|q)+\\{x\_coord}(\\{ww}),\39\\{y\_coord}(%
+\|q)+\\{y\_coord}(\\{ww}))$;\6
+\&{end}\par
+\U508.\fi
+
+\M510. A slight variation of the \\{line\_edges} procedure comes in handy
+when we must draw the retrograde lines for nonstandard entry and exit
+conditions.
+
+\Y\P$\4\X510:Declare the procedure called \\{skew\_line\_edges}\X\S$\6
+\4\&{procedure}\1\ \37$\\{skew\_line\_edges}(\|p,\39\|w,\39\\{ww}:%
+\\{pointer})$;\6
+\4\&{var} \37$\\{x0},\39\\{y0},\39\\{x1},\39\\{y1}$: \37\\{scaled};\C{from and
+to}\2\6
+\&{begin} \37\&{if} $(\\{x\_coord}(\|w)\I\\{x\_coord}(\\{ww}))\V(\\{y\_coord}(%
+\|w)\I\\{y\_coord}(\\{ww}))$ \1\&{then}\6
+\&{begin} \37$\\{x0}\K\\{x\_coord}(\|p)+\\{x\_coord}(\|w)$;\5
+$\\{y0}\K\\{y\_coord}(\|p)+\\{y\_coord}(\|w)$;\6
+$\\{x1}\K\\{x\_coord}(\|p)+\\{x\_coord}(\\{ww})$;\5
+$\\{y1}\K\\{y\_coord}(\|p)+\\{y\_coord}(\\{ww})$;\6
+$\\{unskew}(\\{x0},\39\\{y0},\39\\{octant})$;\C{unskew and unrotate the
+coordinates}\6
+$\\{x0}\K\\{cur\_x}$;\5
+$\\{y0}\K\\{cur\_y}$;\6
+$\\{unskew}(\\{x1},\39\\{y1},\39\\{octant})$;\6
+\&{stat} \37\&{if} $\\{internal}[\\{tracing\_edges}]>\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"@\ retrograde\ line\ from\ "})$;\5
+$\\{print\_two}(\\{x0},\39\\{y0})$;\5
+$\\{print}(\.{"\ to\ "})$;\5
+$\\{print\_two}(\\{cur\_x},\39\\{cur\_y})$;\5
+$\\{print\_nl}(\.{""})$;\6
+\&{end};\ \2\6
+\&{tats}\6
+$\\{line\_edges}(\\{x0},\39\\{y0},\39\\{cur\_x},\39\\{cur\_y})$;\C{then draw a
+straight line}\6
+\&{end};\2\6
+\&{end};\par
+\U506.\fi
+
+\M511. The envelope calculations require more local variables than we needed
+in the simpler case of \\{fill\_spec}. At critical points in the computation,
+\|w will point to offset $w_k$; \|m and \|n will record the current
+lattice positions. The values of \\{move\_ptr} after the initial and before
+the final offset adjustments are stored in \\{smooth\_bot} and \\{smooth\_top},
+respectively.
+
+\Y\P$\4\X511:Other local variables for \\{fill\_envelope}\X\S$\6
+\4$\|m,\39\|n$: \37\\{integer};\C{current lattice position}\6
+\4$\\{mm0},\39\\{mm1}$: \37\\{integer};\C{skewed equivalents of \\{m0} and %
+\\{m1}}\6
+\4\|k: \37\\{integer};\C{current offset number}\6
+\4$\|w,\39\\{ww}$: \37\\{pointer};\C{pointers to the current offset and its
+neighbor}\6
+\4$\\{smooth\_bot},\39\\{smooth\_top}$: \37$0\to\\{move\_size}$;\C{boundaries
+of smoothing}\6
+\4$\\{xx},\39\\{yy},\39\\{xp},\39\\{yp},\39\\{delx},\39\\{dely},\39\\{tx},\39%
+\\{ty}$: \37\\{scaled};\C{registers for coordinate calculations}\par
+\Us506\ET518.\fi
+
+\M512. \P$\X512:Make the envelope moves for the current octant and insert them
+in the pixel data\X\S$\6
+\&{if} $\\{odd}(\\{octant\_number}[\\{octant}])$ \1\&{then}\6
+\&{begin} \37\X513:Initialize for ordinary envelope moves\X;\6
+$\|r\K\|p$;\5
+$\\{right\_type}(\|q)\K\\{info}(\|h)+1$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\|r=\|q$ \1\&{then}\5
+$\\{smooth\_top}\K\\{move\_ptr}$;\2\6
+\&{while} $\\{right\_type}(\|r)\I\|k$ \1\&{do}\5
+\X515:Insert a line segment to approach the correct offset\X;\2\6
+\&{if} $\|r=\|p$ \1\&{then}\5
+$\\{smooth\_bot}\K\\{move\_ptr}$;\2\6
+\&{if} $\|r=\|q$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{move}[\\{move\_ptr}]\K1$;\5
+$\|n\K\\{move\_ptr}$;\5
+$\|s\K\\{link}(\|r)$;\6
+$\\{make\_moves}(\\{x\_coord}(\|r)+\\{x\_coord}(\|w),\39\\{right\_x}(\|r)+\\{x%
+\_coord}(\|w),\39\\{left\_x}(\|s)+\\{x\_coord}(\|w),\39\\{x\_coord}(\|s)+\\{x%
+\_coord}(\|w),\39\30\\{y\_coord}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit},\39%
+\\{right\_y}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit},\39\\{left\_y}(\|s)+\\{y%
+\_coord}(\|w)+\\{half\_unit},\39\\{y\_coord}(\|s)+\\{y\_coord}(\|w)+\\{half%
+\_unit},\39\30\\{xy\_corr}[\\{octant}],\39\\{y\_corr}[\\{octant}])$;\6
+\X514:Transfer moves from the \\{move} array to \\{env\_move}\X;\6
+$\|r\K\|s$;\6
+\&{end};\2\6
+\4\\{done}: \37\X517:Insert the new envelope moves in the pixel data\X;\6
+\&{end}\6
+\4\&{else} $\\{dual\_moves}(\|h,\39\|p,\39\|q)$;\2\6
+$\\{right\_type}(\|q)\K\\{endpoint}$\par
+\U506.\fi
+
+\M513. \P$\X513:Initialize for ordinary envelope moves\X\S$\6
+$\|k\K0$;\5
+$\|w\K\\{link}(\|h)$;\5
+$\\{ww}\K\\{knil}(\|w)$;\5
+$\\{mm0}\K\\{floor\_unscaled}(\\{x\_coord}(\|p)+\\{x\_coord}(\|w)-\\{xy\_corr}[%
+\\{octant}])$;\5
+$\\{mm1}\K\\{floor\_unscaled}(\\{x\_coord}(\|q)+\\{x\_coord}(\\{ww})-\\{xy%
+\_corr}[\\{octant}])$;\6
+\&{for} $\|n\K0\mathrel{\&{to}}\\{n1}-\\{n0}$ \1\&{do}\5
+$\\{env\_move}[\|n]\K\\{mm0}$;\2\6
+$\\{env\_move}[\\{n1}-\\{n0}]\K\\{mm1}$;\5
+$\\{move\_ptr}\K0$;\5
+$\|m\K\\{mm0}$\par
+\U512.\fi
+
+\M514. At this point \|n holds the value of \\{move\_ptr} that was current
+when \\{make\_moves} began to record its moves.
+
+\Y\P$\4\X514:Transfer moves from the \\{move} array to \\{env\_move}\X\S$\6
+\1\&{repeat} \37$\|m\K\|m+\\{move}[\|n]-1$;\6
+\&{if} $\|m>\\{env\_move}[\|n]$ \1\&{then}\5
+$\\{env\_move}[\|n]\K\|m$;\2\6
+$\\{incr}(\|n)$;\6
+\4\&{until}\5
+$\|n>\\{move\_ptr}$\2\par
+\U512.\fi
+
+\M515. Retrograde lines (when \|k decreases) do not need to be recorded in
+\\{env\_move} because their edges are not the furthest right in any row.
+
+\Y\P$\4\X515:Insert a line segment to approach the correct offset\X\S$\6
+\&{begin} \37$\\{xx}\K\\{x\_coord}(\|r)+\\{x\_coord}(\|w)$;\5
+$\\{yy}\K\\{y\_coord}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit}$;\6
+\&{stat} \37\&{if} $\\{internal}[\\{tracing\_edges}]>\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"@\ transition\ line\ "})$;\5
+$\\{print\_int}(\|k)$;\5
+$\\{print}(\.{",\ from\ "})$;\5
+$\\{print\_two\_true}(\\{xx},\39\\{yy}-\\{half\_unit})$;\6
+\&{end};\ \2\6
+\&{tats}\6
+\&{if} $\\{right\_type}(\|r)>\|k$ \1\&{then}\6
+\&{begin} \37$\\{incr}(\|k)$;\5
+$\|w\K\\{link}(\|w)$;\5
+$\\{xp}\K\\{x\_coord}(\|r)+\\{x\_coord}(\|w)$;\5
+$\\{yp}\K\\{y\_coord}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit}$;\6
+\&{if} $\\{yp}\I\\{yy}$ \1\&{then}\5
+\X516:Record a line segment from $(\\{xx},\\{yy})$ to $(\\{xp},\\{yp})$ in %
+\\{env\_move}\X;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{decr}(\|k)$;\5
+$\|w\K\\{knil}(\|w)$;\5
+$\\{xp}\K\\{x\_coord}(\|r)+\\{x\_coord}(\|w)$;\5
+$\\{yp}\K\\{y\_coord}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit}$;\6
+\&{end};\2\6
+\&{stat} \37\&{if} $\\{internal}[\\{tracing\_edges}]>\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"\ to\ "})$;\5
+$\\{print\_two\_true}(\\{xp},\39\\{yp}-\\{half\_unit})$;\5
+$\\{print\_nl}(\.{""})$;\6
+\&{end};\ \2\6
+\&{tats}\6
+$\|m\K\\{floor\_unscaled}(\\{xp}-\\{xy\_corr}[\\{octant}])$;\5
+$\\{move\_ptr}\K\\{floor\_unscaled}(\\{yp}-\\{y\_corr}[\\{octant}])-\\{n0}$;\6
+\&{if} $\|m>\\{env\_move}[\\{move\_ptr}]$ \1\&{then}\5
+$\\{env\_move}[\\{move\_ptr}]\K\|m$;\2\6
+\&{end}\par
+\U512.\fi
+
+\M516. In this step we have $\\{xp}\G\\{xx}$ and $\\{yp}\G\\{yy}$.
+
+\Y\P$\4\X516:Record a line segment from $(\\{xx},\\{yy})$ to $(\\{xp},\\{yp})$
+in \\{env\_move}\X\S$\6
+\&{begin} \37$\\{ty}\K\\{floor\_scaled}(\\{yy}-\\{y\_corr}[\\{octant}])$;\5
+$\\{dely}\K\\{yp}-\\{yy}$;\5
+$\\{yy}\K\\{yy}-\\{ty}$;\5
+$\\{ty}\K\\{yp}-\\{y\_corr}[\\{octant}]-\\{ty}$;\6
+\&{if} $\\{ty}\G\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{delx}\K\\{xp}-\\{xx}$;\5
+$\\{yy}\K\\{unity}-\\{yy}$;\6
+\~ \1\&{loop}\ \&{begin} \37$\\{tx}\K\\{take\_fraction}(\\{delx},\39\\{make%
+\_fraction}(\\{yy},\39\\{dely}))$;\6
+\&{if} $\\{ab\_vs\_cd}(\\{tx},\39\\{dely},\39\\{delx},\39\\{yy})+\\{xy\_corr}[%
+\\{octant}]>0$ \1\&{then}\5
+$\\{decr}(\\{tx})$;\2\6
+$\|m\K\\{floor\_unscaled}(\\{xx}+\\{tx})$;\6
+\&{if} $\|m>\\{env\_move}[\\{move\_ptr}]$ \1\&{then}\5
+$\\{env\_move}[\\{move\_ptr}]\K\|m$;\2\6
+$\\{ty}\K\\{ty}-\\{unity}$;\6
+\&{if} $\\{ty}<\\{unity}$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+$\\{yy}\K\\{yy}+\\{unity}$;\5
+$\\{incr}(\\{move\_ptr})$;\6
+\&{end};\2\6
+\4\\{done1}: \37\&{end};\2\6
+\&{end}\par
+\U515.\fi
+
+\M517. \P$\X517:Insert the new envelope moves in the pixel data\X\S$\6
+\&{debug} \37\&{if} $(\|m\I\\{mm1})\V(\\{move\_ptr}\I\\{n1}-\\{n0})$ \1\&{then}%
+\5
+$\\{confusion}(\.{"1"})$;\ \2\6
+\&{gubed}\6
+$\\{move}[0]\K\\{d0}+\\{env\_move}[0]-\\{mm0}$;\6
+\&{for} $\|n\K1\mathrel{\&{to}}\\{move\_ptr}$ \1\&{do}\5
+$\\{move}[\|n]\K\\{env\_move}[\|n]-\\{env\_move}[\|n-1]+1$;\2\6
+$\\{move}[\\{move\_ptr}]\K\\{move}[\\{move\_ptr}]-\\{d1}$;\6
+\&{if} $\\{internal}[\\{smoothing}]>0$ \1\&{then}\5
+$\\{smooth\_moves}(\\{smooth\_bot},\39\\{smooth\_top})$;\2\6
+$\\{move\_to\_edges}(\\{m0},\39\\{n0},\39\\{m1},\39\\{n1})$;\6
+\&{if} $\\{right\_transition}(\|q)=\\{axis}$ \1\&{then}\6
+\&{begin} \37$\|w\K\\{link}(\|h)$;\5
+$\\{skew\_line\_edges}(\|q,\39\\{knil}(\|w),\39\|w)$;\6
+\&{end}\2\par
+\U512.\fi
+
+\M518. We've done it all in the odd-octant case; the only thing remaining
+is to repeat the same ideas, upside down and/or backwards.
+
+The following code has been split off as a subprocedure of \\{fill\_envelope},
+because some \PASCAL\ compilers cannot handle procedures as large as
+\\{fill\_envelope} would otherwise be.
+
+\Y\P$\4\X518:Declare the procedure called \\{dual\_moves}\X\S$\6
+\4\&{procedure}\1\ \37$\\{dual\_moves}(\|h,\39\|p,\39\|q:\\{pointer})$;\6
+\4\&{label} \37$\\{done},\39\\{done1}$;\6
+\4\&{var} \37$\|r,\39\|s$: \37\\{pointer};\C{for list traversal}\6
+\X511:Other local variables for \\{fill\_envelope}\X\2\6
+\&{begin} \37\X519:Initialize for dual envelope moves\X;\6
+$\|r\K\|p$;\C{recall that $\\{right\_type}(\|q)=\\{endpoint}=0$ now}\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\|r=\|q$ \1\&{then}\5
+$\\{smooth\_top}\K\\{move\_ptr}$;\2\6
+\&{while} $\\{right\_type}(\|r)\I\|k$ \1\&{do}\5
+\X521:Insert a line segment dually to approach the correct offset\X;\2\6
+\&{if} $\|r=\|p$ \1\&{then}\5
+$\\{smooth\_bot}\K\\{move\_ptr}$;\2\6
+\&{if} $\|r=\|q$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{move}[\\{move\_ptr}]\K1$;\5
+$\|n\K\\{move\_ptr}$;\5
+$\|s\K\\{link}(\|r)$;\6
+$\\{make\_moves}(\\{x\_coord}(\|r)+\\{x\_coord}(\|w),\39\\{right\_x}(\|r)+\\{x%
+\_coord}(\|w),\39\\{left\_x}(\|s)+\\{x\_coord}(\|w),\39\\{x\_coord}(\|s)+\\{x%
+\_coord}(\|w),\39\30\\{y\_coord}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit},\39%
+\\{right\_y}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit},\39\\{left\_y}(\|s)+\\{y%
+\_coord}(\|w)+\\{half\_unit},\39\\{y\_coord}(\|s)+\\{y\_coord}(\|w)+\\{half%
+\_unit},\39\30\\{xy\_corr}[\\{octant}],\39\\{y\_corr}[\\{octant}])$;\5
+\X520:Transfer moves dually from the \\{move} array to \\{env\_move}\X;\6
+$\|r\K\|s$;\6
+\&{end};\2\6
+\4\\{done}: \37\X523:Insert the new envelope moves dually in the pixel data\X;\6
+\&{end};\par
+\U506.\fi
+
+\M519. In the dual case the normal situation is to arrive with a \\{diagonal}
+transition and to leave at the \\{axis}. The leftmost edge in each row
+is relevant instead of the rightmost one.
+
+\Y\P$\4\X519:Initialize for dual envelope moves\X\S$\6
+$\|k\K\\{info}(\|h)+1$;\5
+$\\{ww}\K\\{link}(\|h)$;\5
+$\|w\K\\{knil}(\\{ww})$;\6
+$\\{mm0}\K\\{floor\_unscaled}(\\{x\_coord}(\|p)+\\{x\_coord}(\|w)-\\{xy\_corr}[%
+\\{octant}])$;\5
+$\\{mm1}\K\\{floor\_unscaled}(\\{x\_coord}(\|q)+\\{x\_coord}(\\{ww})-\\{xy%
+\_corr}[\\{octant}])$;\6
+\&{for} $\|n\K1\mathrel{\&{to}}\\{n1}-\\{n0}+1$ \1\&{do}\5
+$\\{env\_move}[\|n]\K\\{mm1}$;\2\6
+$\\{env\_move}[0]\K\\{mm0}$;\5
+$\\{move\_ptr}\K0$;\5
+$\|m\K\\{mm0}$\par
+\U518.\fi
+
+\M520. \P$\X520:Transfer moves dually from the \\{move} array to \\{env\_move}%
+\X\S$\6
+\1\&{repeat} \37\&{if} $\|m<\\{env\_move}[\|n]$ \1\&{then}\5
+$\\{env\_move}[\|n]\K\|m$;\2\6
+$\|m\K\|m+\\{move}[\|n]-1$;\5
+$\\{incr}(\|n)$;\6
+\4\&{until}\5
+$\|n>\\{move\_ptr}$\2\par
+\U518.\fi
+
+\M521. Dual retrograde lines occur when \|k increases; the edges of such lines
+are not the furthest left in any row.
+
+\Y\P$\4\X521:Insert a line segment dually to approach the correct offset\X\S$\6
+\&{begin} \37$\\{xx}\K\\{x\_coord}(\|r)+\\{x\_coord}(\|w)$;\5
+$\\{yy}\K\\{y\_coord}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit}$;\6
+\&{stat} \37\&{if} $\\{internal}[\\{tracing\_edges}]>\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"@\ transition\ line\ "})$;\5
+$\\{print\_int}(\|k)$;\5
+$\\{print}(\.{",\ from\ "})$;\5
+$\\{print\_two\_true}(\\{xx},\39\\{yy}-\\{half\_unit})$;\6
+\&{end};\ \2\6
+\&{tats}\6
+\&{if} $\\{right\_type}(\|r)<\|k$ \1\&{then}\6
+\&{begin} \37$\\{decr}(\|k)$;\5
+$\|w\K\\{knil}(\|w)$;\5
+$\\{xp}\K\\{x\_coord}(\|r)+\\{x\_coord}(\|w)$;\5
+$\\{yp}\K\\{y\_coord}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit}$;\6
+\&{if} $\\{yp}\I\\{yy}$ \1\&{then}\5
+\X522:Record a line segment from $(\\{xx},\\{yy})$ to $(\\{xp},\\{yp})$ dually
+in \\{env\_move}\X;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{incr}(\|k)$;\5
+$\|w\K\\{link}(\|w)$;\5
+$\\{xp}\K\\{x\_coord}(\|r)+\\{x\_coord}(\|w)$;\5
+$\\{yp}\K\\{y\_coord}(\|r)+\\{y\_coord}(\|w)+\\{half\_unit}$;\6
+\&{end};\2\6
+\&{stat} \37\&{if} $\\{internal}[\\{tracing\_edges}]>\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"\ to\ "})$;\5
+$\\{print\_two\_true}(\\{xp},\39\\{yp}-\\{half\_unit})$;\5
+$\\{print\_nl}(\.{""})$;\6
+\&{end};\ \2\6
+\&{tats}\6
+$\|m\K\\{floor\_unscaled}(\\{xp}-\\{xy\_corr}[\\{octant}])$;\5
+$\\{move\_ptr}\K\\{floor\_unscaled}(\\{yp}-\\{y\_corr}[\\{octant}])-\\{n0}$;\6
+\&{if} $\|m<\\{env\_move}[\\{move\_ptr}]$ \1\&{then}\5
+$\\{env\_move}[\\{move\_ptr}]\K\|m$;\2\6
+\&{end}\par
+\U518.\fi
+
+\M522. Again, $\\{xp}\G\\{xx}$ and $\\{yp}\G\\{yy}$; but this time we are
+interested in the {\sl
+smallest\/} \|m that belongs to a given \\{move\_ptr} position, instead of
+the largest~\|m.
+
+\Y\P$\4\X522:Record a line segment from $(\\{xx},\\{yy})$ to $(\\{xp},\\{yp})$
+dually in \\{env\_move}\X\S$\6
+\&{begin} \37$\\{ty}\K\\{floor\_scaled}(\\{yy}-\\{y\_corr}[\\{octant}])$;\5
+$\\{dely}\K\\{yp}-\\{yy}$;\5
+$\\{yy}\K\\{yy}-\\{ty}$;\5
+$\\{ty}\K\\{yp}-\\{y\_corr}[\\{octant}]-\\{ty}$;\6
+\&{if} $\\{ty}\G\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{delx}\K\\{xp}-\\{xx}$;\5
+$\\{yy}\K\\{unity}-\\{yy}$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\|m<\\{env\_move}[\\{move\_ptr}]$ \1%
+\&{then}\5
+$\\{env\_move}[\\{move\_ptr}]\K\|m$;\2\6
+$\\{tx}\K\\{take\_fraction}(\\{delx},\39\\{make\_fraction}(\\{yy},\39%
+\\{dely}))$;\6
+\&{if} $\\{ab\_vs\_cd}(\\{tx},\39\\{dely},\39\\{delx},\39\\{yy})+\\{xy\_corr}[%
+\\{octant}]>0$ \1\&{then}\5
+$\\{decr}(\\{tx})$;\2\6
+$\|m\K\\{floor\_unscaled}(\\{xx}+\\{tx})$;\5
+$\\{ty}\K\\{ty}-\\{unity}$;\5
+$\\{incr}(\\{move\_ptr})$;\6
+\&{if} $\\{ty}<\\{unity}$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+$\\{yy}\K\\{yy}+\\{unity}$;\6
+\&{end};\2\6
+\4\\{done1}: \37\&{if} $\|m<\\{env\_move}[\\{move\_ptr}]$ \1\&{then}\5
+$\\{env\_move}[\\{move\_ptr}]\K\|m$;\2\6
+\&{end};\2\6
+\&{end}\par
+\U521.\fi
+
+\M523. Since \\{env\_move} contains minimum values instead of maximum values,
+the
+finishing-up process is slightly different in the dual case.
+
+\Y\P$\4\X523:Insert the new envelope moves dually in the pixel data\X\S$\6
+\&{debug} \37\&{if} $(\|m\I\\{mm1})\V(\\{move\_ptr}\I\\{n1}-\\{n0})$ \1\&{then}%
+\5
+$\\{confusion}(\.{"2"})$;\ \2\6
+\&{gubed}\6
+$\\{move}[0]\K\\{d0}+\\{env\_move}[1]-\\{mm0}$;\6
+\&{for} $\|n\K1\mathrel{\&{to}}\\{move\_ptr}$ \1\&{do}\5
+$\\{move}[\|n]\K\\{env\_move}[\|n+1]-\\{env\_move}[\|n]+1$;\2\6
+$\\{move}[\\{move\_ptr}]\K\\{move}[\\{move\_ptr}]-\\{d1}$;\6
+\&{if} $\\{internal}[\\{smoothing}]>0$ \1\&{then}\5
+$\\{smooth\_moves}(\\{smooth\_bot},\39\\{smooth\_top})$;\2\6
+$\\{move\_to\_edges}(\\{m0},\39\\{n0},\39\\{m1},\39\\{n1})$;\6
+\&{if} $\\{right\_transition}(\|q)=\\{diagonal}$ \1\&{then}\6
+\&{begin} \37$\|w\K\\{link}(\|h)$;\5
+$\\{skew\_line\_edges}(\|q,\39\|w,\39\\{knil}(\|w))$;\6
+\&{end}\2\par
+\U518.\fi
+
+\N524. \[25] Elliptical pens.
+To get the envelope of a cyclic path with respect to an ellipse, \MF\
+calculates the envelope with respect to a polygonal approximation to
+the ellipse, using an approach due to John Hobby (Ph.D. thesis,
+Stanford University, 1985).
+This has two important advantages over trying to obtain the ``exact''
+envelope:
+
+\yskip\textindent{1)}It gives better results, because the polygon has been
+designed to counteract problems that arise from digitization; the
+polygon includes sub-pixel corrections to an exact ellipse that make
+the results essentially independent of where the path falls on the raster.
+For example, the exact envelope with respect to a pen of diameter~1
+blackens a pixel if and only if the path intersects a circle of diameter~1
+inscribed in that pixel; the resulting pattern has ``blots'' when the path
+is travelling diagonally in unfortunate raster positions. A much better
+result is obtained when pixels are blackened only when the path intersects
+an inscribed {\sl diamond\/} of diameter~1. Such a diamond is precisely
+the polygon that \MF\ uses in the special case of a circle whose diameter is~1.
+
+\yskip\textindent{2)}Polygonal envelopes of cubic splines are cubic
+splines, hence it isn't necessary to introduce completely different
+routines. By contrast, exact envelopes of cubic splines with respect
+to circles are complicated curves, more difficult to plot than cubics.
+
+\fi
+
+\M525. Hobby's construction involves some interesting number theory.
+If $u$ and~$v$ are relatively prime integers, we divide the
+set of integer points $(m,n)$ into equivalence classes by saying
+that $(m,n)$ belongs to class $um+vn$. Then any two integer points
+that lie on a line of slope $-u/v$ belong to the same class, because
+such points have the form $(m+tv,n-tu)$. Neighboring lines of slope $-u/v$
+that go through integer points are separated by distance $1/\psqrt{u^2+v^2}$
+from each other, and these lines are perpendicular to lines of slope~$v/u$.
+If we start at the origin and travel a distance $k/\psqrt{u^2+v^2}$ in
+direction $(u,v)$, we reach the line of slope~$-u/v$ whose points
+belong to class~$k$.
+
+For example, let $u=2$ and $v=3$. Then the points $(0,0)$, $(3,-2)$,
+$\ldots$ belong to class~0; the points $(-1,1)$, $(2,-1)$, $\ldots$ belong
+to class~1; and the distance between these two lines is $1/\sqrt{13}$.
+The point $(2,3)$ itself belongs to class~13, hence its distance from
+the origin is $13/\sqrt{13}=\sqrt{13}$ (which we already knew).
+
+Suppose we wish to plot envelopes with respect to polygons with
+integer vertices. Then the best polygon for curves that travel in
+direction $(v,-u)$ will contain the points of class~$k$ such that
+$k/\psqrt{u^2+v^2}$ is as close as possible to~$d$, where $d$ is the
+maximum distance of the given ellipse from the line $ux+vy=0$.
+
+The \\{fillin} correction assumes that a diagonal line has an
+apparent thickness $$2f\cdot\min(\vert u\vert,\vert v\vert)/\psqrt{u^2+v^2}$$
+greater than would be obtained with truly square pixels. (If a
+white pixel at an exterior corner is assumed to have apparent
+darkness $f_1$ and a black pixel at an interior corner is assumed
+to have apparent darkness $1-f_2$, then $f=f_1-f_2$ is the \\{fillin}
+parameter.) Under this assumption we want to choose $k$ so that
+$\bigl(k+2f\cdot\min(\vert u\vert,\vert v\vert)\bigr)\big/\psqrt{u^2+v^2}$
+is as close as possible to $d$.
+
+Integer coordinates for the vertices work nicely because the thickness of
+the envelope at any given slope is independent of the position of the
+path with respect to the raster. It turns out, in fact, that the same
+property holds for polygons whose vertices have coordinates that are
+integer multiples of~$1\over2$, because ellipses are symmetric about
+the origin. It's convenient to double all dimensions and require the
+resulting polygon to have vertices with integer coordinates. For example,
+to get a circle of {\sl diameter}~$r$, we shall compute integer
+coordinates for a circle of {\sl radius}~$r$. The circle of radius~$r$
+will want to be represented by a polygon that contains the boundary
+points $(0,\pm r)$ and~$(\pm r,0)$; later we will divide everything
+by~2 and get a polygon with $(0,\pm{1\over2}r)$ and $(\pm{1\over2}r,0)$
+on its boundary.
+
+\fi
+
+\M526. In practice the important slopes are those having small values of
+$u$ and~$v$; these make regular patterns in which our eyes quickly
+spot irregularities. For example, horizontal and vertical lines
+(when $u=0$ and $\vert v\vert=1$, or $\vert u\vert=1$ and $v=0$)
+are the most important; diagonal lines (when $\vert u\vert=\vert v\vert=1$)
+are next; and then come lines with slope $\pm2$ or $\pm1/2$.
+
+The nicest way to generate all rational directions having small
+numerators and denominators is to generalize the Stern-Brocot tree
+[cf.~{\sl Concrete Mathematics}, section 4.5]
+to a ``Stern-Brocot wreath'' as follows: Begin with four nodes
+arranged in a circle, containing the respective directions
+$(u,v)=(1,0)$, $(0,1)$, $(-1,0)$, and~$(0,-1)$. Then between pairs of
+consecutive terms $(u,v)$ and $(u',v')$ of the wreath, insert the
+direction $(u+u',v+v')$; continue doing this until some stopping
+criterion is fulfilled.
+
+It is not difficult to verify that, regardless of the stopping
+criterion, consecutive directions $(u,v)$ and $(u',v')$ of this
+wreath will always satisfy the relation $uv'-u'v=1$. Such pairs
+of directions have a nice property with respect to the equivalence
+classes described above. Let $l$ be a line of equivalent integer points
+$(m+tv,n-tu)$ with respect to~$(u,v)$, and let $l'$ be a line of
+equivalent integer points $(m'+tv',n'-tu')$ with respect to~$(u',v')$.
+Then $l$ and~$l'$ intersect in an integer point $(m'',n'')$, because
+the determinant of the linear equations for intersection is $uv'-u'v=1$.
+Notice that the class number of $(m'',n'')$ with respect to $(u+u',v+v')$
+is the sum of its class numbers with respect to $(u,v)$ and~$(u',v')$.
+Moreover, consecutive points on~$l$ and~$l'$ belong to classes that
+differ by exactly~1 with respect to $(u+u',v+v')$.
+
+This leads to a nice algorithm in which we construct a polygon having
+``correct'' class numbers for as many small-integer directions $(u,v)$
+as possible: Assuming that lines $l$ and~$l'$ contain points of the
+correct class for $(u,v)$ and~$(u',v')$, respectively, we determine
+the intersection $(m'',n'')$ and compute its class with respect to
+$(u+u',v+v')$. If the class is too large to be the best approximation,
+we move back the proper number of steps from $(m'',n'')$ toward smaller
+class numbers on both $l$ and~$l'$, unless this requires moving to points
+that are no longer in the polygon; in this we arrive at two points that
+determine a line~$l''$ having the appropriate class. The process continues
+recursively, until it cannot proceed without removing the last remaining
+point from the class for $(u,v)$ or the class for $(u',v')$.
+
+\fi
+
+\M527. The \\{make\_ellipse} subroutine produces a pointer to a cyclic path
+whose vertices define a polygon suitable for envelopes. The control
+points on this path will be ignored; in fact, the fields in knot nodes
+that are usually reserved for control points are occupied by other
+data that helps \\{make\_ellipse} compute the desired polygon.
+
+Parameters \\{major\_axis} and \\{minor\_axis} define the axes of the ellipse;
+and parameter \\{theta} is an angle by which the ellipse is rotated
+counterclockwise. If $\\{theta}=0$, the ellipse has the equation
+$(x/a)^2+(y/b)^2=1$, where $\|a=\\{major\_axis}/2$ and $\|b=\\{minor\_axis}/2$.
+In general, the points of the ellipse are generated in the complex plane
+by the formula $e^{i\theta}(a\cos t+ib\sin t)$, as $t$~ranges over all
+angles. Notice that if $\\{major\_axis}=\\{minor\_axis}=\|d$, we obtain a
+circle
+of diameter~\|d, regardless of the value of \\{theta}.
+
+The method sketched above is used to produce the elliptical polygon,
+except that the main work is done only in the halfplane obtained from
+the three starting directions $(0,-1)$, $(1,0)$,~$(0,1)$. Since the ellipse
+has circular symmetry, we use the fact that the last half of the polygon
+is simply the negative of the first half. Furthermore, we need to compute only
+one quarter of the polygon if the ellipse has axis symmetry.
+
+\Y\P\4\&{function}\1\ \37$\\{make\_ellipse}(\\{major\_axis},\39\\{minor%
+\_axis}:\\{scaled};\,\35\\{theta}:\\{angle})$: \37\\{pointer};\6
+\4\&{label} \37$\\{done},\39\\{done1},\39\\{found}$;\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s$: \37\\{pointer};\C{for list
+manipulation}\6
+\|h: \37\\{pointer};\C{head of the constructed knot list}\6
+$\\{alpha},\39\\{beta},\39\\{gamma},\39\\{delta}$: \37\\{integer};\C{special
+points}\6
+$\|c,\39\|d$: \37\\{integer};\C{class numbers}\6
+$\|u,\39\|v$: \37\\{integer};\C{directions}\6
+\\{symmetric}: \37\\{boolean};\C{should the result be symmetric about the
+axes?}\2\6
+\&{begin} \37\X528:Initialize the ellipse data structure by beginning with
+directions $(0,-1)$, $(1,0)$, $(0,1)$\X;\6
+\X531:Interpolate new vertices in the ellipse data structure until improvement
+is impossible\X;\6
+\&{if} $\\{symmetric}$ \1\&{then}\5
+\X536:Complete the half ellipse by reflecting the quarter already computed\X;\2%
+\6
+\X537:Complete the ellipse by copying the negative of the half already computed%
+\X;\6
+$\\{make\_ellipse}\K\|h$;\6
+\&{end};\par
+\fi
+
+\M528. A special data structure is used only with \\{make\_ellipse}: The
+\\{right\_x}, \\{left\_x}, \\{right\_y}, and \\{left\_y} fields of knot nodes
+are renamed \\{right\_u}, \\{left\_v}, \\{right\_class}, and \\{left\_length},
+in order to store information that simplifies the necessary computations.
+
+If \|p and \|q are consecutive knots in this data structure, the
+\\{x\_coord} and \\{y\_coord} fields of \|p and~\|q contain current vertices
+of the polygon; their values are integer multiples
+of \\{half\_unit}. Both of these vertices belong to equivalence class
+$\\{right\_class}(\|p)$ with respect to the direction
+$\bigl($$\\{right\_u}(\|p),\\{left\_v}(\|q)$$\bigr)$. The number of points of
+this class
+on the line from vertex~\|p to vertex~\|q is $1+\\{left\_length}(\|q)$.
+In particular, $\\{left\_length}(\|q)=0$ means that $\\{x\_coord}(\|p)=\\{x%
+\_coord}(\|q)$
+and $\\{y\_coord}(\|p)=\\{y\_coord}(\|q)$; such duplicate vertices will be
+discarded during the course of the algorithm.
+
+The contents of $\\{right\_u}(\|p)$ and $\\{left\_v}(\|q)$ are integer
+multiples
+of \\{half\_unit}, just like the coordinate fields. Hence, for example,
+the point $\bigl($$\\{x\_coord}(\|p)-\\{left\_v}(\|q),\\{y\_coord}(\|p)+%
+\\{right\_u}(\|q)$$\bigr)$
+also belongs to class number $\\{right\_class}(\|p)$. This point is one
+step closer to the vertex in node~\|q; it equals that vertex
+if and only if $\\{left\_length}(\|q)=1$.
+
+The \\{left\_type} and \\{right\_type} fields are not used, but \\{link}
+has its normal meaning.
+
+To start the process, we create four nodes for the three directions
+$(0,-1)$, $(1,0)$, and $(0,1)$. The corresponding vertices are
+$(-\alpha,-\beta)$, $(\gamma,-\beta)$, $(\gamma,\beta)$, and
+$(\alpha,\beta)$, where $(\alpha,\beta)$ is a half-integer approximation
+to where the ellipse rises highest above the $x$-axis, and where
+$\gamma$ is a half-integer approximation to the maximum $x$~coordinate
+of the ellipse. The fourth of these nodes is not actually calculated
+if the ellipse has axis symmetry.
+
+\Y\P\D \37$\\{right\_u}\S\\{right\_x}$\C{\|u value for a pen edge}\par
+\P\D \37$\\{left\_v}\S\\{left\_x}$\C{\|v value for a pen edge}\par
+\P\D \37$\\{right\_class}\S\\{right\_y}$\C{equivalence class number of a pen
+edge}\par
+\P\D \37$\\{left\_length}\S\\{left\_y}$\C{length of a pen edge}\par
+\Y\P$\4\X528:Initialize the ellipse data structure by beginning with directions
+$(0,-1)$, $(1,0)$, $(0,1)$\X\S$\6
+\X530:Calculate integers $\alpha$, $\beta$, $\gamma$ for the vertex coordinates%
+\X;\6
+$\|p\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\|q\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\|r\K\\{get\_node}(\\{knot\_node\_size})$;\6
+\&{if} $\\{symmetric}$ \1\&{then}\5
+$\|s\K\\{null}$\ \&{else} $\|s\K\\{get\_node}(\\{knot\_node\_size})$;\2\6
+$\|h\K\|p$;\5
+$\\{link}(\|p)\K\|q$;\5
+$\\{link}(\|q)\K\|r$;\5
+$\\{link}(\|r)\K\|s$;\C{$\|s=\\{null}$ or $\\{link}(\|s)=\\{null}$}\6
+\X529:Revise the values of $\alpha$, $\beta$, $\gamma$, if necessary, so that
+degenerate lines of length zero will not be obtained\X;\6
+$\\{x\_coord}(\|p)\K-\\{alpha}\ast\\{half\_unit}$;\5
+$\\{y\_coord}(\|p)\K-\\{beta}\ast\\{half\_unit}$;\5
+$\\{x\_coord}(\|q)\K\\{gamma}\ast\\{half\_unit}$;\6
+$\\{y\_coord}(\|q)\K\\{y\_coord}(\|p)$;\5
+$\\{x\_coord}(\|r)\K\\{x\_coord}(\|q)$;\6
+$\\{right\_u}(\|p)\K0$;\5
+$\\{left\_v}(\|q)\K-\\{half\_unit}$;\6
+$\\{right\_u}(\|q)\K\\{half\_unit}$;\5
+$\\{left\_v}(\|r)\K0$;\6
+$\\{right\_u}(\|r)\K0$;\5
+$\\{right\_class}(\|p)\K\\{beta}$;\5
+$\\{right\_class}(\|q)\K\\{gamma}$;\5
+$\\{right\_class}(\|r)\K\\{beta}$;\6
+$\\{left\_length}(\|q)\K\\{gamma}+\\{alpha}$;\6
+\&{if} $\\{symmetric}$ \1\&{then}\6
+\&{begin} \37$\\{y\_coord}(\|r)\K0$;\5
+$\\{left\_length}(\|r)\K\\{beta}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{y\_coord}(\|r)\K-\\{y\_coord}(\|p)$;\5
+$\\{left\_length}(\|r)\K\\{beta}+\\{beta}$;\6
+$\\{x\_coord}(\|s)\K-\\{x\_coord}(\|p)$;\5
+$\\{y\_coord}(\|s)\K\\{y\_coord}(\|r)$;\6
+$\\{left\_v}(\|s)\K\\{half\_unit}$;\5
+$\\{left\_length}(\|s)\K\\{gamma}-\\{alpha}$;\6
+\&{end}\2\par
+\U527.\fi
+
+\M529. One of the important invariants of the pen data structure is that
+the points are distinct. We may need to correct the pen specification
+in order to avoid this. (The result of \&{pencircle} will always be at
+least one pixel wide and one pixel tall, although \&{makepen} is
+capable of producing smaller pens.)
+
+\Y\P$\4\X529:Revise the values of $\alpha$, $\beta$, $\gamma$, if necessary, so
+that degenerate lines of length zero will not be obtained\X\S$\6
+\&{if} $\\{beta}=0$ \1\&{then}\5
+$\\{beta}\K1$;\2\6
+\&{if} $\\{gamma}=0$ \1\&{then}\5
+$\\{gamma}\K1$;\2\6
+\&{if} $\\{gamma}\L\\{abs}(\\{alpha})$ \1\&{then}\6
+\&{if} $\\{alpha}>0$ \1\&{then}\5
+$\\{alpha}\K\\{gamma}-1$\6
+\4\&{else} $\\{alpha}\K1-\\{gamma}$\2\2\par
+\U528.\fi
+
+\M530. If $a$ and $b$ are the semi-major and semi-minor axes,
+the given ellipse rises highest above the $y$-axis at the point
+$\bigl((a^2-b^2)\sin\theta\cos\theta/\rho\bigr)+i\rho$, where
+$\rho=\sqrt{(a\sin\theta)^2+(b\cos\theta)^2}$. It reaches
+furthest to the right of~the $x$-axis at the point
+$\sigma+i(a^2-b^2)\sin\theta\cos\theta/\sigma$, where
+$\sigma=\sqrt{(a\cos\theta)^2+(b\sin\theta)^2}$.
+
+\Y\P$\4\X530:Calculate integers $\alpha$, $\beta$, $\gamma$ for the vertex
+coordinates\X\S$\6
+\&{if} $(\\{major\_axis}=\\{minor\_axis})\V(\\{theta}\mathbin{\&{mod}}\\{ninety%
+\_deg}=0)$ \1\&{then}\6
+\&{begin} \37$\\{symmetric}\K\\{true}$;\5
+$\\{alpha}\K0$;\6
+\&{if} $\\{odd}(\\{theta}\mathbin{\&{div}}\\{ninety\_deg})$ \1\&{then}\6
+\&{begin} \37$\\{beta}\K\\{major\_axis}$;\5
+$\\{gamma}\K\\{minor\_axis}$;\5
+$\\{n\_sin}\K\\{fraction\_one}$;\5
+$\\{n\_cos}\K0$;\C{\\{n\_sin} and \\{n\_cos} are used later}\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{beta}\K\\{minor\_axis}$;\5
+$\\{gamma}\K\\{major\_axis}$;\6
+\&{end};\C{\\{n\_sin} and \\{n\_cos} aren't needed in this case}\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{symmetric}\K\\{false}$;\5
+$\\{n\_sin\_cos}(\\{theta})$;\C{set up $\\{n\_sin}=\sin\theta$ and $\\{n\_cos}=%
+\cos\theta$}\6
+$\\{gamma}\K\\{take\_fraction}(\\{major\_axis},\39\\{n\_sin})$;\5
+$\\{delta}\K\\{take\_fraction}(\\{minor\_axis},\39\\{n\_cos})$;\5
+$\\{beta}\K\\{pyth\_add}(\\{gamma},\39\\{delta})$;\5
+$\\{alpha}\K\\{take\_fraction}(\\{take\_fraction}(\\{major\_axis},\39\\{make%
+\_fraction}(\\{gamma},\39\\{beta})),\39\\{n\_cos})\30-\\{take\_fraction}(%
+\\{take\_fraction}(\\{minor\_axis},\39\\{make\_fraction}(\\{delta},\39%
+\\{beta})),\39\\{n\_sin})$;\5
+$\\{alpha}\K(\\{alpha}+\\{half\_unit})\mathbin{\&{div}}\\{unity}$;\5
+$\\{gamma}\K\\{pyth\_add}(\\{take\_fraction}(\\{major\_axis},\39\\{n\_cos}),\39%
+\\{take\_fraction}(\\{minor\_axis},\39\\{n\_sin}))$;\6
+\&{end};\2\6
+$\\{beta}\K(\\{beta}+\\{half\_unit})\mathbin{\&{div}}\\{unity}$;\5
+$\\{gamma}\K(\\{gamma}+\\{half\_unit})\mathbin{\&{div}}\\{unity}$\par
+\U528.\fi
+
+\M531. Now \|p, \|q, and \|r march through the list, always representing
+three consecutive vertices and two consecutive slope directions.
+When a new slope is interpolated, we back up slightly, until
+further refinement is impossible; then we march forward again.
+The somewhat magical operations performed in this part of the
+algorithm are justified by the theory sketched earlier.
+Complications arise only from the need to keep zero-length lines
+out of the final data structure.
+
+\Y\P$\4\X531:Interpolate new vertices in the ellipse data structure until
+improvement is impossible\X\S$\6
+\~ \1\&{loop}\ \&{begin} \37$\|u\K\\{right\_u}(\|p)+\\{right\_u}(\|q)$;\5
+$\|v\K\\{left\_v}(\|q)+\\{left\_v}(\|r)$;\5
+$\|c\K\\{right\_class}(\|p)+\\{right\_class}(\|q)$;\6
+\X533:Compute the distance \|d from class~0 to the edge of the ellipse in
+direction $(\|u,\|v)$, times $\psqrt{u^2+v^2}$, rounded to the nearest integer%
+\X;\6
+$\\{delta}\K\|c-\|d$;\C{we want to move \\{delta} steps back from the
+intersection vertex~\|q}\6
+\&{if} $\\{delta}>0$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{delta}>\\{left\_length}(\|r)$ \1\&{then}\5
+$\\{delta}\K\\{left\_length}(\|r)$;\2\6
+\&{if} $\\{delta}\G\\{left\_length}(\|q)$ \1\&{then}\5
+\X534:Remove the line from \|p to \|q, and adjust vertex~\|q to introduce a new
+line\X\6
+\4\&{else} \X535:Insert a new line for direction $(\|u,\|v)$ between \|p and~%
+\|q\X;\2\6
+\&{end}\6
+\4\&{else} $\|p\K\|q$;\2\6
+\X532:Move to the next remaining triple $(\|p,\|q,\|r)$, removing and skipping
+past zero-length lines that might be present; \&{goto} \\{done} if all triples
+have been processed\X;\6
+\&{end};\2\6
+\4\\{done}: \37\par
+\U527.\fi
+
+\M532. The appearance of a zero-length line means that we should advance \|p
+past it. We must not try to straddle a missing direction, because the
+algorithm works only on consecutive pairs of directions.
+
+\Y\P$\4\X532:Move to the next remaining triple $(\|p,\|q,\|r)$, removing and
+skipping past zero-length lines that might be present; \&{goto} \\{done} if all
+triples have been processed\X\S$\6
+\~ \1\&{loop}\ \&{begin} \37$\|q\K\\{link}(\|p)$;\6
+\&{if} $\|q=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\\{left\_length}(\|q)=0$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|p)\K\\{link}(\|q)$;\5
+$\\{right\_class}(\|p)\K\\{right\_class}(\|q)$;\5
+$\\{right\_u}(\|p)\K\\{right\_u}(\|q)$;\5
+$\\{free\_node}(\|q,\39\\{knot\_node\_size})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|r\K\\{link}(\|q)$;\6
+\&{if} $\|r=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\\{left\_length}(\|r)=0$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|p)\K\|r$;\5
+$\\{free\_node}(\|q,\39\\{knot\_node\_size})$;\5
+$\|p\K\|r$;\6
+\&{end}\6
+\4\&{else} \&{goto} \37\\{found};\2\6
+\&{end};\2\6
+\&{end};\2\6
+\4\\{found}: \37\par
+\U531.\fi
+
+\M533. The `\&{div} 8' near the end of this step comes from
+the fact that \\{delta} is scaled by~$2^{15}$ and $d$~by~$2^{16}$,
+while \\{take\_fraction} removes a scale factor of~$2^{28}$.
+We also make sure that $d\G\max(\vert u\vert,\vert v\vert)$, so that
+the pen will always include a circular pen of diameter~1 as a subset;
+then it won't be possible to get disconnected path envelopes.
+
+\Y\P$\4\X533:Compute the distance \|d from class~0 to the edge of the ellipse
+in direction $(\|u,\|v)$, times $\psqrt{u^2+v^2}$, rounded to the nearest
+integer\X\S$\6
+$\\{delta}\K\\{pyth\_add}(\|u,\39\|v)$;\6
+\&{if} $\\{major\_axis}=\\{minor\_axis}$ \1\&{then}\5
+$\|d\K\\{major\_axis}$\C{circles are easy}\6
+\4\&{else} \&{begin} \37\&{if} $\\{theta}=0$ \1\&{then}\6
+\&{begin} \37$\\{alpha}\K\|u$;\5
+$\\{beta}\K\|v$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{alpha}\K\\{take\_fraction}(\|u,\39\\{n\_cos})+%
+\\{take\_fraction}(\|v,\39\\{n\_sin})$;\5
+$\\{beta}\K\\{take\_fraction}(\|v,\39\\{n\_cos})-\\{take\_fraction}(\|u,\39\\{n%
+\_sin})$;\6
+\&{end};\2\6
+$\\{alpha}\K\\{make\_fraction}(\\{alpha},\39\\{delta})$;\5
+$\\{beta}\K\\{make\_fraction}(\\{beta},\39\\{delta})$;\5
+$\|d\K\\{pyth\_add}(\\{take\_fraction}(\\{major\_axis},\39\\{alpha}),\39\\{take%
+\_fraction}(\\{minor\_axis},\39\\{beta}))$;\6
+\&{end};\2\6
+$\\{alpha}\K\\{abs}(\|u)$;\5
+$\\{beta}\K\\{abs}(\|v)$;\6
+\&{if} $\\{alpha}<\\{beta}$ \1\&{then}\6
+\&{begin} \37$\\{alpha}\K\\{abs}(\|v)$;\5
+$\\{beta}\K\\{abs}(\|u)$;\6
+\&{end};\C{now $\alpha=\max(\vert u\vert,\vert v\vert)$, $\beta=\min(%
+\vert u\vert,\vert v\vert)$}\2\6
+\&{if} $\\{internal}[\\{fillin}]\I0$ \1\&{then}\5
+$\|d\K\|d-\\{take\_fraction}(\\{internal}[\\{fillin}],\39\\{make\_fraction}(%
+\\{beta}+\\{beta},\39\\{delta}))$;\2\6
+$\|d\K\\{take\_fraction}((\|d+4)\mathbin{\&{div}}8,\39\\{delta})$;\5
+$\\{alpha}\K\\{alpha}\mathbin{\&{div}}\\{half\_unit}$;\6
+\&{if} $\|d<\\{alpha}$ \1\&{then}\5
+$\|d\K\\{alpha}$\2\par
+\U531.\fi
+
+\M534. At this point there's a line of length $\L\\{delta}$ from vertex~\|p
+to vertex~\|q, orthogonal to direction $\bigl($$\\{right\_u}(\|p),\\{left\_v}(%
+\|q)$$\bigr)$;
+and there's a line of length $\G\\{delta}$ from vertex~\|q to
+to vertex~\|r, orthogonal to direction $\bigl($$\\{right\_u}(\|q),\\{left\_v}(%
+\|r)$$\bigr)$.
+The best line to direction $(u,v)$ should replace the line from
+\|p to~\|q; this new line will have the same length as the old.
+
+\Y\P$\4\X534:Remove the line from \|p to \|q, and adjust vertex~\|q to
+introduce a new line\X\S$\6
+\&{begin} \37$\\{delta}\K\\{left\_length}(\|q)$;\6
+$\\{right\_class}(\|p)\K\|c-\\{delta}$;\5
+$\\{right\_u}(\|p)\K\|u$;\5
+$\\{left\_v}(\|q)\K\|v$;\6
+$\\{x\_coord}(\|q)\K\\{x\_coord}(\|q)-\\{delta}\ast\\{left\_v}(\|r)$;\5
+$\\{y\_coord}(\|q)\K\\{y\_coord}(\|q)+\\{delta}\ast\\{right\_u}(\|q)$;\6
+$\\{left\_length}(\|r)\K\\{left\_length}(\|r)-\\{delta}$;\6
+\&{end}\par
+\U531.\fi
+
+\M535. Here is the main case, now that we have dealt with the exception:
+We insert a new line of length \\{delta} for direction $(\|u,\|v)$, decreasing
+each of the adjacent lines by \\{delta} steps.
+
+\Y\P$\4\X535:Insert a new line for direction $(\|u,\|v)$ between \|p and~\|q\X%
+\S$\6
+\&{begin} \37$\|s\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{link}(\|p)\K\|s$;\5
+$\\{link}(\|s)\K\|q$;\6
+$\\{x\_coord}(\|s)\K\\{x\_coord}(\|q)+\\{delta}\ast\\{left\_v}(\|q)$;\5
+$\\{y\_coord}(\|s)\K\\{y\_coord}(\|q)-\\{delta}\ast\\{right\_u}(\|p)$;\6
+$\\{x\_coord}(\|q)\K\\{x\_coord}(\|q)-\\{delta}\ast\\{left\_v}(\|r)$;\5
+$\\{y\_coord}(\|q)\K\\{y\_coord}(\|q)+\\{delta}\ast\\{right\_u}(\|q)$;\6
+$\\{left\_v}(\|s)\K\\{left\_v}(\|q)$;\5
+$\\{right\_u}(\|s)\K\|u$;\5
+$\\{left\_v}(\|q)\K\|v$;\6
+$\\{right\_class}(\|s)\K\|c-\\{delta}$;\6
+$\\{left\_length}(\|s)\K\\{left\_length}(\|q)-\\{delta}$;\5
+$\\{left\_length}(\|q)\K\\{delta}$;\5
+$\\{left\_length}(\|r)\K\\{left\_length}(\|r)-\\{delta}$;\6
+\&{end}\par
+\U531.\fi
+
+\M536. Only the coordinates need to be copied, not the class numbers and other
+stuff.
+
+\Y\P$\4\X536:Complete the half ellipse by reflecting the quarter already
+computed\X\S$\6
+\&{begin} \37$\|s\K\\{null}$;\5
+$\|q\K\|h$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|r\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{link}(\|r)\K\|s$;\5
+$\|s\K\|r$;\6
+$\\{x\_coord}(\|s)\K\\{x\_coord}(\|q)$;\5
+$\\{y\_coord}(\|s)\K-\\{y\_coord}(\|q)$;\6
+\&{if} $\|q=\|p$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+$\|q\K\\{link}(\|q)$;\6
+\&{if} $\\{y\_coord}(\|q)=0$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+\&{end};\2\6
+\4\\{done1}: \37$\\{link}(\|p)\K\|s$;\5
+$\\{beta}\K-\\{y\_coord}(\|h)$;\6
+\&{while} $\\{y\_coord}(\|p)\I\\{beta}$ \1\&{do}\5
+$\|p\K\\{link}(\|p)$;\2\6
+$\|q\K\\{link}(\|p)$;\6
+\&{end}\par
+\U527.\fi
+
+\M537. Now we use a somewhat tricky fact: The pointer \|q will be null if and
+only if the line for the final direction $(0,1)$ has been removed. If
+that line still survives, it should be combined with a possibly
+surviving line in the initial direction $(0,-1)$.
+
+\Y\P$\4\X537:Complete the ellipse by copying the negative of the half already
+computed\X\S$\6
+\&{if} $\|q\I\\{null}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{right\_u}(\|h)=0$ \1\&{then}\6
+\&{begin} \37$\|p\K\|h$;\5
+$\|h\K\\{link}(\|h)$;\5
+$\\{free\_node}(\|p,\39\\{knot\_node\_size})$;\6
+$\\{x\_coord}(\|q)\K-\\{x\_coord}(\|h)$;\6
+\&{end};\2\6
+$\|p\K\|q$;\6
+\&{end}\6
+\4\&{else} $\|q\K\|p$;\2\6
+$\|r\K\\{link}(\|h)$;\C{now $\|p=\|q$, $\\{x\_coord}(\|p)=-\\{x\_coord}(\|h)$,
+$\\{y\_coord}(\|p)=-\\{y\_coord}(\|h)$}\6
+\1\&{repeat} \37$\|s\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{link}(\|p)\K\|s$;\5
+$\|p\K\|s$;\6
+$\\{x\_coord}(\|p)\K-\\{x\_coord}(\|r)$;\5
+$\\{y\_coord}(\|p)\K-\\{y\_coord}(\|r)$;\5
+$\|r\K\\{link}(\|r)$;\6
+\4\&{until}\5
+$\|r=\|q$;\2\6
+$\\{link}(\|p)\K\|h$\par
+\U527.\fi
+
+\N538. \[26] Direction and intersection times.
+A path of length $n$ is defined parametrically by functions $x(t)$ and
+$y(t)$, for $0\L\|t\L\|n$; we can regard $t$ as the ``time'' at which the path
+reaches the point $\bigl(x(t),y(t)\bigr)$. In this section of the program
+we shall consider operations that determine special times associated with
+given paths: the first time that a path travels in a given direction, and
+a pair of times at which two paths cross each other.
+
+\fi
+
+\M539. Let's start with the easier task. The function \\{find\_direction\_time}
+is
+given a direction $(\|x,\|y)$ and a path starting at~\|h. If the path never
+travels in direction $(\|x,\|y)$, the direction time will be~$-1$; otherwise
+it will be nonnegative.
+
+Certain anomalous cases can arise: If $(\|x,\|y)=(0,0)$, so that the given
+direction is undefined, the direction time will be~0. If $\bigl(x'(t),
+y'(t)\bigr)=(0,0)$, so that the path direction is undefined, it will be
+assumed to match any given direction at time~\|t.
+
+The routine solves this problem in nondegenerate cases by rotating the path
+and the given direction so that $(\|x,\|y)=(1,0)$; i.e., the main task will be
+to find when a given path first travels ``due east.''
+
+\Y\P\4\&{function}\1\ \37$\\{find\_direction\_time}(\|x,\39\|y:\\{scaled};\,%
+\35\|h:\\{pointer})$: \37\\{scaled};\6
+\4\&{label} \37$\\{exit},\39\\{found},\39\\{not\_found},\39\\{done}$;\6
+\4\&{var} \37\\{max}: \37\\{scaled};\C{$\max\bigl(\vert x\vert,\vert y\vert%
+\bigr)$}\6
+$\|p,\39\|q$: \37\\{pointer};\C{for list traversal}\6
+\|n: \37\\{scaled};\C{the direction time at knot \|p}\6
+\\{tt}: \37\\{scaled};\C{the direction time within a cubic}\6
+\X542:Other local variables for \\{find\_direction\_time}\X\2\6
+\&{begin} \37\X540:Normalize the given direction for better accuracy; but %
+\&{return} with zero result if it's zero\X;\6
+$\|n\K0$;\5
+$\|p\K\|h$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\\{right\_type}(\|p)=\\{endpoint}$ \1%
+\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\|q\K\\{link}(\|p)$;\5
+\X541:Rotate the cubic between \|p and \|q; then \&{goto} \\{found} if the
+rotated cubic travels due east at some time \\{tt}; but \&{goto} \\{not\_found}
+if an entire cyclic path has been traversed\X;\6
+$\|p\K\|q$;\5
+$\|n\K\|n+\\{unity}$;\6
+\&{end};\2\6
+\4\\{not\_found}: \37$\\{find\_direction\_time}\K-\\{unity}$;\5
+\&{return};\6
+\4\\{found}: \37$\\{find\_direction\_time}\K\|n+\\{tt}$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M540. \P$\X540:Normalize the given direction for better accuracy; but %
+\&{return} with zero result if it's zero\X\S$\6
+\&{if} $\\{abs}(\|x)<\\{abs}(\|y)$ \1\&{then}\6
+\&{begin} \37$\|x\K\\{make\_fraction}(\|x,\39\\{abs}(\|y))$;\6
+\&{if} $\|y>0$ \1\&{then}\5
+$\|y\K\\{fraction\_one}$\ \&{else} $\|y\K-\\{fraction\_one}$;\2\6
+\&{end}\6
+\4\&{else} \&{if} $\|x=0$ \1\&{then}\6
+\&{begin} \37$\\{find\_direction\_time}\K0$;\5
+\&{return};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|y\K\\{make\_fraction}(\|y,\39\\{abs}(\|x))$;\6
+\&{if} $\|x>0$ \1\&{then}\5
+$\|x\K\\{fraction\_one}$\ \&{else} $\|x\K-\\{fraction\_one}$;\2\6
+\&{end}\2\2\par
+\U539.\fi
+
+\M541. Since we're interested in the tangent directions, we work with the
+derivative $${\textstyle1\over3}B'(x_0,x_1,x_2,x_3;t)=
+B(x_1-x_0,x_2-x_1,x_3-x_2;t)$$ instead of
+$B(x_0,x_1,x_2,x_3;t)$ itself. The derived coefficients are also scaled up
+in order to achieve better accuracy.
+
+The given path may turn abruptly at a knot, and it might pass the critical
+tangent direction at such a time. Therefore we remember the direction \\{phi}
+in which the previous rotated cubic was traveling. (The value of \\{phi} will
+be
+undefined on the first cubic, i.e., when $\|n=0$.)
+
+\Y\P$\4\X541:Rotate the cubic between \|p and \|q; then \&{goto} \\{found} if
+the rotated cubic travels due east at some time \\{tt}; but \&{goto} \\{not%
+\_found} if an entire cyclic path has been traversed\X\S$\6
+$\\{tt}\K0$;\5
+\X543:Set local variables $\\{x1},\\{x2},\\{x3}$ and $\\{y1},\\{y2},\\{y3}$ to
+multiples of the control points of the rotated derivatives\X;\6
+\&{if} $\\{y1}=0$ \1\&{then}\6
+\&{if} $\\{x1}\G0$ \1\&{then}\5
+\&{goto} \37\\{found};\2\2\6
+\&{if} $\|n>0$ \1\&{then}\6
+\&{begin} \37\X544:Exit to \\{found} if an eastward direction occurs at knot %
+\|p\X;\6
+\&{if} $\|p=\|h$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\&{end};\2\6
+\&{if} $(\\{x3}\I0)\V(\\{y3}\I0)$ \1\&{then}\5
+$\\{phi}\K\\{n\_arg}(\\{x3},\39\\{y3})$;\2\6
+\X546:Exit to \\{found} if the curve whose derivatives are specified by $%
+\\{x1},\\{x2},\\{x3},\\{y1},\\{y2},\\{y3}$ travels eastward at some time~\\{tt}%
+\X\par
+\U539.\fi
+
+\M542. \P$\X542:Other local variables for \\{find\_direction\_time}\X\S$\6
+\4$\\{x1},\39\\{x2},\39\\{x3},\39\\{y1},\39\\{y2},\39\\{y3}$: \37\\{scaled};%
+\C{multiples of rotated derivatives}\6
+\4$\\{theta},\39\\{phi}$: \37\\{angle};\C{angles of exit and entry at a knot}\6
+\4\|t: \37\\{fraction};\C{temp storage}\par
+\U539.\fi
+
+\M543. \P$\X543:Set local variables $\\{x1},\\{x2},\\{x3}$ and $\\{y1},\\{y2},%
+\\{y3}$ to multiples of the control points of the rotated derivatives\X\S$\6
+$\\{x1}\K\\{right\_x}(\|p)-\\{x\_coord}(\|p)$;\5
+$\\{x2}\K\\{left\_x}(\|q)-\\{right\_x}(\|p)$;\5
+$\\{x3}\K\\{x\_coord}(\|q)-\\{left\_x}(\|q)$;\6
+$\\{y1}\K\\{right\_y}(\|p)-\\{y\_coord}(\|p)$;\5
+$\\{y2}\K\\{left\_y}(\|q)-\\{right\_y}(\|p)$;\5
+$\\{y3}\K\\{y\_coord}(\|q)-\\{left\_y}(\|q)$;\6
+$\\{max}\K\\{abs}(\\{x1})$;\6
+\&{if} $\\{abs}(\\{x2})>\\{max}$ \1\&{then}\5
+$\\{max}\K\\{abs}(\\{x2})$;\2\6
+\&{if} $\\{abs}(\\{x3})>\\{max}$ \1\&{then}\5
+$\\{max}\K\\{abs}(\\{x3})$;\2\6
+\&{if} $\\{abs}(\\{y1})>\\{max}$ \1\&{then}\5
+$\\{max}\K\\{abs}(\\{y1})$;\2\6
+\&{if} $\\{abs}(\\{y2})>\\{max}$ \1\&{then}\5
+$\\{max}\K\\{abs}(\\{y2})$;\2\6
+\&{if} $\\{abs}(\\{y3})>\\{max}$ \1\&{then}\5
+$\\{max}\K\\{abs}(\\{y3})$;\2\6
+\&{if} $\\{max}=0$ \1\&{then}\5
+\&{goto} \37\\{found};\2\6
+\&{while} $\\{max}<\\{fraction\_half}$ \1\&{do}\6
+\&{begin} \37$\\{double}(\\{max})$;\5
+$\\{double}(\\{x1})$;\5
+$\\{double}(\\{x2})$;\5
+$\\{double}(\\{x3})$;\5
+$\\{double}(\\{y1})$;\5
+$\\{double}(\\{y2})$;\5
+$\\{double}(\\{y3})$;\6
+\&{end};\2\6
+$\|t\K\\{x1}$;\5
+$\\{x1}\K\\{take\_fraction}(\\{x1},\39\|x)+\\{take\_fraction}(\\{y1},\39\|y)$;\5
+$\\{y1}\K\\{take\_fraction}(\\{y1},\39\|x)-\\{take\_fraction}(\|t,\39\|y)$;\6
+$\|t\K\\{x2}$;\5
+$\\{x2}\K\\{take\_fraction}(\\{x2},\39\|x)+\\{take\_fraction}(\\{y2},\39\|y)$;\5
+$\\{y2}\K\\{take\_fraction}(\\{y2},\39\|x)-\\{take\_fraction}(\|t,\39\|y)$;\6
+$\|t\K\\{x3}$;\5
+$\\{x3}\K\\{take\_fraction}(\\{x3},\39\|x)+\\{take\_fraction}(\\{y3},\39\|y)$;\5
+$\\{y3}\K\\{take\_fraction}(\\{y3},\39\|x)-\\{take\_fraction}(\|t,\39\|y)$\par
+\U541.\fi
+
+\M544. \P$\X544:Exit to \\{found} if an eastward direction occurs at knot \|p\X%
+\S$\6
+$\\{theta}\K\\{n\_arg}(\\{x1},\39\\{y1})$;\6
+\&{if} $\\{theta}\G0$ \1\&{then}\6
+\&{if} $\\{phi}\L0$ \1\&{then}\6
+\&{if} $\\{phi}\G\\{theta}-\\{one\_eighty\_deg}$ \1\&{then}\5
+\&{goto} \37\\{found};\2\2\2\6
+\&{if} $\\{theta}\L0$ \1\&{then}\6
+\&{if} $\\{phi}\G0$ \1\&{then}\6
+\&{if} $\\{phi}\L\\{theta}+\\{one\_eighty\_deg}$ \1\&{then}\5
+\&{goto} \37\\{found}\2\2\2\par
+\U541.\fi
+
+\M545. In this step we want to use the \\{crossing\_point} routine to find the
+roots of the quadratic equation $B(y_1,y_2,y_3;t)=0$.
+Several complications arise: If the quadratic equation has a double root,
+the curve never crosses zero, and \\{crossing\_point} will find nothing;
+this case occurs iff $y_1y_3=y_2^2$ and $y_1y_2<0$. If the quadratic
+equation has simple roots, or only one root, we may have to negate it
+so that $B(y_1,y_2,y_3;t)$ crosses from positive to negative at its first root.
+And finally, we need to do special things if $B(y_1,y_2,y_3;t)$ is
+identically zero.
+
+\fi
+
+\M546. \P$\X546:Exit to \\{found} if the curve whose derivatives are specified
+by $\\{x1},\\{x2},\\{x3},\\{y1},\\{y2},\\{y3}$ travels eastward at some time~%
+\\{tt}\X\S$\6
+\&{if} $\\{x1}<0$ \1\&{then}\6
+\&{if} $\\{x2}<0$ \1\&{then}\6
+\&{if} $\\{x3}<0$ \1\&{then}\5
+\&{goto} \37\\{done};\2\2\2\6
+\&{if} $\\{ab\_vs\_cd}(\\{y1},\39\\{y3},\39\\{y2},\39\\{y2})=0$ \1\&{then}\5
+\X548:Handle the test for eastward directions when $y_1y_3=y_2^2$; either %
+\&{goto} \\{found} or \&{goto} \\{done}\X;\2\6
+\&{if} $\\{y1}\L0$ \1\&{then}\6
+\&{if} $\\{y1}<0$ \1\&{then}\6
+\&{begin} \37$\\{y1}\K-\\{y1}$;\5
+$\\{y2}\K-\\{y2}$;\5
+$\\{y3}\K-\\{y3}$;\6
+\&{end}\6
+\4\&{else} \&{if} $\\{y2}>0$ \1\&{then}\6
+\&{begin} \37$\\{y2}\K-\\{y2}$;\5
+$\\{y3}\K-\\{y3}$;\6
+\&{end};\2\2\2\6
+\X547:Check the places where $B(y_1,y_2,y_3;t)=0$ to see if $B(x_1,x_2,x_3;t)%
+\ge0$\X;\6
+\4\\{done}: \37\par
+\U541.\fi
+
+\M547. The quadratic polynomial $B(y_1,y_2,y_3;t)$ begins $\G0$ and has at most
+two roots, because we know that it isn't identically zero.
+
+It must be admitted that the \\{crossing\_point} routine is not perfectly
+accurate;
+rounding errors might cause it to find a root when $y_1y_3>y_2^2$, or to
+miss the roots when $y_1y_3<y_2^2$. The rotation process is itself
+subject to rounding errors. Yet this code optimistically tries to
+do the right thing.
+
+\Y\P\D \37$\\{we\_found\_it}\S$\1\6
+\&{begin} \37$\\{tt}\K(\|t+\O{4000})\mathbin{\&{div}}\O{10000}$;\5
+\&{goto} \37\\{found};\6
+\&{end}\2\par
+\Y\P$\4\X547:Check the places where $B(y_1,y_2,y_3;t)=0$ to see if
+$B(x_1,x_2,x_3;t)\ge0$\X\S$\6
+$\|t\K\\{crossing\_point}(\\{y1},\39\\{y2},\39\\{y3})$;\6
+\&{if} $\|t>\\{fraction\_one}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{y2}\K\\{t\_of\_the\_way}(\\{y2})(\\{y3})$;\5
+$\\{x1}\K\\{t\_of\_the\_way}(\\{x1})(\\{x2})$;\5
+$\\{x2}\K\\{t\_of\_the\_way}(\\{x2})(\\{x3})$;\5
+$\\{x1}\K\\{t\_of\_the\_way}(\\{x1})(\\{x2})$;\6
+\&{if} $\\{x1}\G0$ \1\&{then}\5
+\\{we\_found\_it};\2\6
+\&{if} $\\{y2}>0$ \1\&{then}\5
+$\\{y2}\K0$;\2\6
+$\\{tt}\K\|t$;\5
+$\|t\K\\{crossing\_point}(0,\39-\\{y2},\39-\\{y3})$;\6
+\&{if} $\|t>\\{fraction\_one}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{x1}\K\\{t\_of\_the\_way}(\\{x1})(\\{x2})$;\5
+$\\{x2}\K\\{t\_of\_the\_way}(\\{x2})(\\{x3})$;\6
+\&{if} $\\{t\_of\_the\_way}(\\{x1})(\\{x2})\G0$ \1\&{then}\6
+\&{begin} \37$\|t\K\\{t\_of\_the\_way}(\\{tt})(\\{fraction\_one})$;\5
+\\{we\_found\_it};\6
+\&{end}\2\par
+\U546.\fi
+
+\M548. \P$\X548:Handle the test for eastward directions when $y_1y_3=y_2^2$;
+either \&{goto} \\{found} or \&{goto} \\{done}\X\S$\6
+\&{begin} \37\&{if} $\\{ab\_vs\_cd}(\\{y1},\39\\{y2},\390,\390)<0$ \1\&{then}\6
+\&{begin} \37$\|t\K\\{make\_fraction}(\\{y1},\39\\{y1}-\\{y2})$;\5
+$\\{x1}\K\\{t\_of\_the\_way}(\\{x1})(\\{x2})$;\5
+$\\{x2}\K\\{t\_of\_the\_way}(\\{x2})(\\{x3})$;\6
+\&{if} $\\{t\_of\_the\_way}(\\{x1})(\\{x2})\G0$ \1\&{then}\5
+\\{we\_found\_it};\2\6
+\&{end}\6
+\4\&{else} \&{if} $\\{y3}=0$ \1\&{then}\6
+\&{if} $\\{y1}=0$ \1\&{then}\5
+\X549:Exit to \\{found} if the derivative $B(x_1,x_2,x_3;t)$ becomes $\G0$\X\6
+\4\&{else} \&{if} $\\{x3}\G0$ \1\&{then}\6
+\&{begin} \37$\\{tt}\K\\{unity}$;\5
+\&{goto} \37\\{found};\6
+\&{end};\2\2\2\2\6
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U546.\fi
+
+\M549. At this point we know that the derivative of $\|y(\|t)$ is identically
+zero,
+and that $\\{x1}<0$; but either $\\{x2}\G0$ or $\\{x3}\G0$, so there's some
+hope of
+traveling east.
+
+\Y\P$\4\X549:Exit to \\{found} if the derivative $B(x_1,x_2,x_3;t)$ becomes $%
+\G0$\X\S$\6
+\&{begin} \37$\|t\K\\{crossing\_point}(-\\{x1},\39-\\{x2},\39-\\{x3})$;\6
+\&{if} $\|t\L\\{fraction\_one}$ \1\&{then}\5
+\\{we\_found\_it};\2\6
+\&{if} $\\{ab\_vs\_cd}(\\{x1},\39\\{x3},\39\\{x2},\39\\{x2})\L0$ \1\&{then}\6
+\&{begin} \37$\|t\K\\{make\_fraction}(\\{x1},\39\\{x1}-\\{x2})$;\5
+\\{we\_found\_it};\6
+\&{end};\2\6
+\&{end}\par
+\U548.\fi
+
+\M550. The intersection of two cubics can be found by an interesting variant
+of the general bisection scheme described in the introduction to \\{make%
+\_moves}.\
+Given $w(t)=B(w_0,w_1,w_2,w_3;t)$ and $z(t)=B(z_0,z_1,z_2,z_3;t)$,
+we wish to find a pair of times $(t_1,t_2)$ such that $w(t_1)=z(t_2)$,
+if an intersection exists. First we find the smallest rectangle that
+encloses the points $\{w_0,w_1,w_2,w_3\}$ and check that it overlaps
+the smallest rectangle that encloses
+$\{z_0,z_1,z_2,z_3\}$; if not, the cubics certainly don't intersect.
+But if the rectangles do overlap, we bisect the intervals, getting
+new cubics $w'$ and~$w''$, $z'$~and~$z''$; the intersection routine first
+tries for an intersection between $w'$ and~$z'$, then (if unsuccessful)
+between $w'$ and~$z''$, then (if still unsuccessful) between $w''$ and~$z'$,
+finally (if thrice unsuccessful) between $w''$ and~$z''$. After $l$~successful
+levels of bisection we will have determined the intersection times $t_1$
+and~$t_2$ to $l$~bits of accuracy.
+
+\def\submin{_{\rm min}} \def\submax{_{\rm max}}
+As before, it is better to work with the numbers $W_k=2^l(w_k-w_{k-1})$
+and $Z_k=2^l(z_k-z_{k-1})$ rather than the coefficients $w_k$ and $z_k$
+themselves. We also need one other quantity, $\Delta=2^l(w_0-z_0)$,
+to determine when the enclosing rectangles overlap. Here's why:
+The $x$~coordinates of~$w(t)$ are between $u\submin$ and $u\submax$,
+and the $x$~coordinates of~$z(t)$ are between $x\submin$ and $x\submax$,
+if we write $w_k=(u_k,v_k)$ and $z_k=(x_k,y_k)$ and $u\submin=
+\min(u_0,u_1,u_2,u_3)$, etc. These intervals of $x$~coordinates
+overlap if and only if $u\submin\L x\submax$ and
+$x\submin\L u\submax$. Letting
+$$U\submin=\min(0,U_1,U_1+U_2,U_1+U_2+U_3),\;
+U\submax=\max(0,U_1,U_1+U_2,U_1+U_2+U_3),$$
+we have $u\submin=2^lu_0+U\submin$, etc.; the condition for overlap
+reduces to
+$$X\submin-U\submax\L 2^l(u_0-x_0)\L X\submax-U\submin.$$
+Thus we want to maintain the quantity $2^l(u_0-x_0)$; similarly,
+the quantity $2^l(v_0-y_0)$ accounts for the $y$~coordinates. The
+coordinates of $\Delta=2^l(w_0-z_0)$ must stay bounded as $l$ increases,
+because of the overlap condition; i.e., we know that $X\submin$,
+$X\submax$, and their relatives are bounded, hence $X\submax-
+U\submin$ and $X\submin-U\submax$ are bounded.
+
+\fi
+
+\M551. Incidentally, if the given cubics intersect more than once, the process
+just sketched will not necessarily find the lexicographically smallest pair
+$(t_1,t_2)$. The solution actually obtained will be smallest in ``shuffled
+order''; i.e., if $t_1=(.a_1a_2\ldots a_{16})_2$ and
+$t_2=(.b_1b_2\ldots b_{16})_2$, then we will minimize
+$a_1b_1a_2b_2\ldots a_{16}b_{16}$, not
+$a_1a_2\ldots a_{16}b_1b_2\ldots b_{16}$.
+Shuffled order agrees with lexicographic order if all pairs of solutions
+$(t_1,t_2)$ and $(t_1',t_2')$ have the property that $t_1<t_1'$ iff
+$t_2<t_2'$; but in general, lexicographic order can be quite different,
+and the bisection algorithm would be substantially less efficient if it were
+constrained by lexicographic order.
+
+For example, suppose that an overlap has been found for $l=3$ and
+$(t_1,t_2)= (.101,.011)$ in binary, but that no overlap is produced by
+either of the alternatives $(.1010,.0110)$, $(.1010,.0111)$ at level~4.
+Then there is probably an intersection in one of the subintervals
+$(.1011,.011x)$; but lexicographic order would require us to explore
+$(.1010,.1xxx)$ and $(.1011,.00xx)$ and $(.1011,.010x)$ first. We wouldn't
+want to store all of the subdivision data for the second path, so the
+subdivisions would have to be regenerated many times. Such inefficiencies
+would be associated with every `1' in the binary representation of~$t_1$.
+
+\fi
+
+\M552. The subdivision process introduces rounding errors, hence we need to
+make a more liberal test for overlap. It is not hard to show that the
+computed values of $U_i$ differ from the truth by at most~$l$, on
+level~$l$, hence $U\submin$ and $U\submax$ will be at most $3l$ in error.
+If $\beta$ is an upper bound on the absolute error in the computed
+components of $\Delta=(\\{delx},\\{dely})$ on level~$l$, we will replace
+the test `$X\submin-U\submax\L\\{delx}$' by the more liberal test
+`$X\submin-U\submax\L\\{delx}+\\{tol}$', where $\\{tol}=6l+\beta$.
+
+More accuracy is obtained if we try the algorithm first with $\\{tol}=0$;
+the more liberal tolerance is used only if an exact approach fails.
+It is convenient to do this double-take by letting `3' in the preceding
+paragraph be a parameter, which is first 0, then 3.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{tol\_step}: \37$0\to6$;\C{either 0 or 3, usually}\par
+\fi
+
+\M553. We shall use an explicit stack to implement the recursive bisection
+method described above. In fact, the \\{bisect\_stack} array is available for
+this purpose. It will contain numerous 5-word packets like
+$(U_1,U_2,U_3,U\submin,U\submax)$, as well as 20-word packets comprising
+the 5-word packets for $U$, $V$, $X$, and~$Y$.
+
+The following macros define the allocation of stack positions to
+the quantities needed for bisection-intersection.
+
+\Y\P\D \37$\\{stack\_1}(\#)\S\\{bisect\_stack}[\#]$\C{$U_1$, $V_1$, $X_1$, or
+$Y_1$}\par
+\P\D \37$\\{stack\_2}(\#)\S\\{bisect\_stack}[\#+1]$\C{$U_2$, $V_2$, $X_2$, or
+$Y_2$}\par
+\P\D \37$\\{stack\_3}(\#)\S\\{bisect\_stack}[\#+2]$\C{$U_3$, $V_3$, $X_3$, or
+$Y_3$}\par
+\P\D \37$\\{stack\_min}(\#)\S\\{bisect\_stack}[\#+3]$\C{$U\submin$, $V\submin$,
+$X\submin$, or $Y\submin$}\par
+\P\D \37$\\{stack\_max}(\#)\S\\{bisect\_stack}[\#+4]$\C{$U\submax$, $V\submax$,
+$X\submax$, or $Y\submax$}\par
+\P\D \37$\\{int\_packets}=20$\C{number of words to represent $U_k$, $V_k$,
+$X_k$, and $Y_k$}\Y\par
+\P\D \37$\\{u\_packet}(\#)\S\#-5$\par
+\P\D \37$\\{v\_packet}(\#)\S\#-10$\par
+\P\D \37$\\{x\_packet}(\#)\S\#-15$\par
+\P\D \37$\\{y\_packet}(\#)\S\#-20$\par
+\P\D \37$\\{l\_packets}\S\\{bisect\_ptr}-\\{int\_packets}$\par
+\P\D \37$\\{r\_packets}\S\\{bisect\_ptr}$\par
+\P\D \37$\\{ul\_packet}\S\\{u\_packet}(\\{l\_packets})$\C{base of $U'_k$
+variables}\par
+\P\D \37$\\{vl\_packet}\S\\{v\_packet}(\\{l\_packets})$\C{base of $V'_k$
+variables}\par
+\P\D \37$\\{xl\_packet}\S\\{x\_packet}(\\{l\_packets})$\C{base of $X'_k$
+variables}\par
+\P\D \37$\\{yl\_packet}\S\\{y\_packet}(\\{l\_packets})$\C{base of $Y'_k$
+variables}\par
+\P\D \37$\\{ur\_packet}\S\\{u\_packet}(\\{r\_packets})$\C{base of $U''_k$
+variables}\par
+\P\D \37$\\{vr\_packet}\S\\{v\_packet}(\\{r\_packets})$\C{base of $V''_k$
+variables}\par
+\P\D \37$\\{xr\_packet}\S\\{x\_packet}(\\{r\_packets})$\C{base of $X''_k$
+variables}\par
+\P\D \37$\\{yr\_packet}\S\\{y\_packet}(\\{r\_packets})$\C{base of $Y''_k$
+variables}\Y\par
+\P\D \37$\\{u1l}\S\\{stack\_1}(\\{ul\_packet})$\C{$U'_1$}\par
+\P\D \37$\\{u2l}\S\\{stack\_2}(\\{ul\_packet})$\C{$U'_2$}\par
+\P\D \37$\\{u3l}\S\\{stack\_3}(\\{ul\_packet})$\C{$U'_3$}\par
+\P\D \37$\\{v1l}\S\\{stack\_1}(\\{vl\_packet})$\C{$V'_1$}\par
+\P\D \37$\\{v2l}\S\\{stack\_2}(\\{vl\_packet})$\C{$V'_2$}\par
+\P\D \37$\\{v3l}\S\\{stack\_3}(\\{vl\_packet})$\C{$V'_3$}\par
+\P\D \37$\\{x1l}\S\\{stack\_1}(\\{xl\_packet})$\C{$X'_1$}\par
+\P\D \37$\\{x2l}\S\\{stack\_2}(\\{xl\_packet})$\C{$X'_2$}\par
+\P\D \37$\\{x3l}\S\\{stack\_3}(\\{xl\_packet})$\C{$X'_3$}\par
+\P\D \37$\\{y1l}\S\\{stack\_1}(\\{yl\_packet})$\C{$Y'_1$}\par
+\P\D \37$\\{y2l}\S\\{stack\_2}(\\{yl\_packet})$\C{$Y'_2$}\par
+\P\D \37$\\{y3l}\S\\{stack\_3}(\\{yl\_packet})$\C{$Y'_3$}\par
+\P\D \37$\\{u1r}\S\\{stack\_1}(\\{ur\_packet})$\C{$U''_1$}\par
+\P\D \37$\\{u2r}\S\\{stack\_2}(\\{ur\_packet})$\C{$U''_2$}\par
+\P\D \37$\\{u3r}\S\\{stack\_3}(\\{ur\_packet})$\C{$U''_3$}\par
+\P\D \37$\\{v1r}\S\\{stack\_1}(\\{vr\_packet})$\C{$V''_1$}\par
+\P\D \37$\\{v2r}\S\\{stack\_2}(\\{vr\_packet})$\C{$V''_2$}\par
+\P\D \37$\\{v3r}\S\\{stack\_3}(\\{vr\_packet})$\C{$V''_3$}\par
+\P\D \37$\\{x1r}\S\\{stack\_1}(\\{xr\_packet})$\C{$X''_1$}\par
+\P\D \37$\\{x2r}\S\\{stack\_2}(\\{xr\_packet})$\C{$X''_2$}\par
+\P\D \37$\\{x3r}\S\\{stack\_3}(\\{xr\_packet})$\C{$X''_3$}\par
+\P\D \37$\\{y1r}\S\\{stack\_1}(\\{yr\_packet})$\C{$Y''_1$}\par
+\P\D \37$\\{y2r}\S\\{stack\_2}(\\{yr\_packet})$\C{$Y''_2$}\par
+\P\D \37$\\{y3r}\S\\{stack\_3}(\\{yr\_packet})$\C{$Y''_3$}\Y\par
+\P\D \37$\\{stack\_dx}\S\\{bisect\_stack}[\\{bisect\_ptr}]$\C{stacked value of %
+\\{delx}}\par
+\P\D \37$\\{stack\_dy}\S\\{bisect\_stack}[\\{bisect\_ptr}+1]$\C{stacked value
+of \\{dely}}\par
+\P\D \37$\\{stack\_tol}\S\\{bisect\_stack}[\\{bisect\_ptr}+2]$\C{stacked value
+of \\{tol}}\par
+\P\D \37$\\{stack\_uv}\S\\{bisect\_stack}[\\{bisect\_ptr}+3]$\C{stacked value
+of \\{uv}}\par
+\P\D \37$\\{stack\_xy}\S\\{bisect\_stack}[\\{bisect\_ptr}+4]$\C{stacked value
+of \\{xy}}\par
+\P\D \37$\\{int\_increment}=\\{int\_packets}+\\{int\_packets}+5$\C{number of
+stack words per level}\par
+\Y\P$\4\X14:Check the ``constant'' values for consistency\X\mathrel{+}\S$\6
+\&{if} $\\{int\_packets}+17\ast\\{int\_increment}>\\{bistack\_size}$ \1\&{then}%
+\5
+$\\{bad}\K32$;\2\par
+\fi
+
+\M554. Computation of the min and max is a tedious but fairly fast sequence of
+instructions; exactly four comparisons are made in each branch.
+
+\Y\P\D \37$\\{set\_min\_max}(\#)\S$\1\6
+\&{if} $\\{stack\_1}(\#)<0$ \1\&{then}\6
+\&{if} $\\{stack\_3}(\#)\G0$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{stack\_2}(\#)<0$ \1\&{then}\5
+$\\{stack\_min}(\#)\K\\{stack\_1}(\#)+\\{stack\_2}(\#)$\6
+\4\&{else} $\\{stack\_min}(\#)\K\\{stack\_1}(\#)$;\2\6
+$\\{stack\_max}(\#)\K\\{stack\_1}(\#)+\\{stack\_2}(\#)+\\{stack\_3}(\#)$;\6
+\&{if} $\\{stack\_max}(\#)<0$ \1\&{then}\5
+$\\{stack\_max}(\#)\K0$;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{stack\_min}(\#)\K\\{stack\_1}(\#)+\\{stack\_2}(\#)+%
+\\{stack\_3}(\#)$;\6
+\&{if} $\\{stack\_min}(\#)>\\{stack\_1}(\#)$ \1\&{then}\5
+$\\{stack\_min}(\#)\K\\{stack\_1}(\#)$;\2\6
+$\\{stack\_max}(\#)\K\\{stack\_1}(\#)+\\{stack\_2}(\#)$;\6
+\&{if} $\\{stack\_max}(\#)<0$ \1\&{then}\5
+$\\{stack\_max}(\#)\K0$;\2\6
+\&{end}\2\6
+\4\&{else} \&{if} $\\{stack\_3}(\#)\L0$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{stack\_2}(\#)>0$ \1\&{then}\5
+$\\{stack\_max}(\#)\K\\{stack\_1}(\#)+\\{stack\_2}(\#)$\6
+\4\&{else} $\\{stack\_max}(\#)\K\\{stack\_1}(\#)$;\2\6
+$\\{stack\_min}(\#)\K\\{stack\_1}(\#)+\\{stack\_2}(\#)+\\{stack\_3}(\#)$;\6
+\&{if} $\\{stack\_min}(\#)>0$ \1\&{then}\5
+$\\{stack\_min}(\#)\K0$;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{stack\_max}(\#)\K\\{stack\_1}(\#)+\\{stack\_2}(\#)+%
+\\{stack\_3}(\#)$;\6
+\&{if} $\\{stack\_max}(\#)<\\{stack\_1}(\#)$ \1\&{then}\5
+$\\{stack\_max}(\#)\K\\{stack\_1}(\#)$;\2\6
+$\\{stack\_min}(\#)\K\\{stack\_1}(\#)+\\{stack\_2}(\#)$;\6
+\&{if} $\\{stack\_min}(\#)>0$ \1\&{then}\5
+$\\{stack\_min}(\#)\K0$;\2\6
+\&{end}\2\2\2\par
+\fi
+
+\M555. It's convenient to keep the current values of $l$, $t_1$, and $t_2$ in
+the integer form $2^l+2^lt_1$ and $2^l+2^lt_2$. The \\{cubic\_intersection}
+routine uses global variables \\{cur\_t} and \\{cur\_tt} for this purpose;
+after successful completion, \\{cur\_t} and \\{cur\_tt} will contain \\{unity}
+plus the \\{scaled} values of $t_1$ and~$t_2$.
+
+The values of \\{cur\_t} and \\{cur\_tt} will be set to zero if \\{cubic%
+\_intersection}
+finds no intersection. The routine gives up and gives an approximate answer
+if it has backtracked
+more than 5000 times (otherwise there are cases where several minutes
+of fruitless computation would be possible).
+
+\Y\P\D \37$\\{max\_patience}=5000$\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{cur\_t},\39\\{cur\_tt}$: \37\\{integer};\C{controls and results of %
+\\{cubic\_intersection}}\6
+\4\\{time\_to\_go}: \37\\{integer};\C{this many backtracks before giving up}\6
+\4\\{max\_t}: \37\\{integer};\C{maximum of $2^{l+1}$ so far achieved}\par
+\fi
+
+\M556. The given cubics $B(w_0,w_1,w_2,w_3;t)$ and
+$B(z_0,z_1,z_2,z_3;t)$ are specified in adjacent knot nodes $(\|p,\\{link}(%
+\|p))$
+and $(\\{pp},\\{link}(\\{pp}))$, respectively.
+
+\Y\P\4\&{procedure}\1\ \37$\\{cubic\_intersection}(\|p,\39\\{pp}:%
+\\{pointer})$;\6
+\4\&{label} \37$\\{continue},\39\\{not\_found},\39\\{exit}$;\6
+\4\&{var} \37$\|q,\39\\{qq}$: \37\\{pointer};\C{$\\{link}(\|p)$, $\\{link}(%
+\\{pp})$}\2\6
+\&{begin} \37$\\{time\_to\_go}\K\\{max\_patience}$;\5
+$\\{max\_t}\K2$;\5
+\X558:Initialize for intersections at level zero\X;\6
+\~ \1\&{loop}\ \&{begin} \37\\{continue}: \37\&{if} $\\{delx}-\\{tol}\L\\{stack%
+\_max}(\\{x\_packet}(\\{xy}))-\\{stack\_min}(\\{u\_packet}(\\{uv}))$ \1\&{then}%
+\6
+\&{if} $\\{delx}+\\{tol}\G\\{stack\_min}(\\{x\_packet}(\\{xy}))-\\{stack\_max}(%
+\\{u\_packet}(\\{uv}))$ \1\&{then}\6
+\&{if} $\\{dely}-\\{tol}\L\\{stack\_max}(\\{y\_packet}(\\{xy}))-\\{stack\_min}(%
+\\{v\_packet}(\\{uv}))$ \1\&{then}\6
+\&{if} $\\{dely}+\\{tol}\G\\{stack\_min}(\\{y\_packet}(\\{xy}))-\\{stack\_max}(%
+\\{v\_packet}(\\{uv}))$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{cur\_t}\G\\{max\_t}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{max\_t}=\\{two}$ \1\&{then}\C{we've done 17 bisections}%
+\6
+\&{begin} \37$\\{cur\_t}\K\\{half}(\\{cur\_t}+1)$;\5
+$\\{cur\_tt}\K\\{half}(\\{cur\_tt}+1)$;\5
+\&{return};\6
+\&{end};\2\6
+$\\{double}(\\{max\_t})$;\5
+$\\{appr\_t}\K\\{cur\_t}$;\5
+$\\{appr\_tt}\K\\{cur\_tt}$;\6
+\&{end};\2\6
+\X559:Subdivide for a new level of intersection\X;\6
+\&{goto} \37\\{continue};\6
+\&{end};\2\2\2\2\6
+\&{if} $\\{time\_to\_go}>0$ \1\&{then}\5
+$\\{decr}(\\{time\_to\_go})$\6
+\4\&{else} \&{begin} \37\&{while} $\\{appr\_t}<\\{unity}$ \1\&{do}\6
+\&{begin} \37$\\{double}(\\{appr\_t})$;\5
+$\\{double}(\\{appr\_tt})$;\6
+\&{end};\2\6
+$\\{cur\_t}\K\\{appr\_t}$;\5
+$\\{cur\_tt}\K\\{appr\_tt}$;\5
+\&{return};\6
+\&{end};\2\6
+\X560:Advance to the next pair $(\\{cur\_t},\\{cur\_tt})$\X;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M557. The following variables are global, although they are used only by
+\\{cubic\_intersection}, because it is necessary on some machines to
+split \\{cubic\_intersection} up into two procedures.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{delx},\39\\{dely}$: \37\\{integer};\C{the components of $%
+\Delta=2^l(w_0-z_0)$}\6
+\4\\{tol}: \37\\{integer};\C{bound on the uncertainly in the overlap test}\6
+\4$\\{uv},\39\\{xy}$: \37$0\to\\{bistack\_size}$;\C{pointers to the current
+packets of interest}\6
+\4\\{three\_l}: \37\\{integer};\C{\\{tol\_step} times the bisection level}\6
+\4$\\{appr\_t},\39\\{appr\_tt}$: \37\\{integer};\C{best approximations known to
+the answers}\par
+\fi
+
+\M558. We shall assume that the coordinates are sufficiently non-extreme that
+integer overflow will not occur.
+
+\Y\P$\4\X558:Initialize for intersections at level zero\X\S$\6
+$\|q\K\\{link}(\|p)$;\5
+$\\{qq}\K\\{link}(\\{pp})$;\5
+$\\{bisect\_ptr}\K\\{int\_packets}$;\6
+$\\{u1r}\K\\{right\_x}(\|p)-\\{x\_coord}(\|p)$;\5
+$\\{u2r}\K\\{left\_x}(\|q)-\\{right\_x}(\|p)$;\5
+$\\{u3r}\K\\{x\_coord}(\|q)-\\{left\_x}(\|q)$;\5
+$\\{set\_min\_max}(\\{ur\_packet})$;\6
+$\\{v1r}\K\\{right\_y}(\|p)-\\{y\_coord}(\|p)$;\5
+$\\{v2r}\K\\{left\_y}(\|q)-\\{right\_y}(\|p)$;\5
+$\\{v3r}\K\\{y\_coord}(\|q)-\\{left\_y}(\|q)$;\5
+$\\{set\_min\_max}(\\{vr\_packet})$;\6
+$\\{x1r}\K\\{right\_x}(\\{pp})-\\{x\_coord}(\\{pp})$;\5
+$\\{x2r}\K\\{left\_x}(\\{qq})-\\{right\_x}(\\{pp})$;\5
+$\\{x3r}\K\\{x\_coord}(\\{qq})-\\{left\_x}(\\{qq})$;\5
+$\\{set\_min\_max}(\\{xr\_packet})$;\6
+$\\{y1r}\K\\{right\_y}(\\{pp})-\\{y\_coord}(\\{pp})$;\5
+$\\{y2r}\K\\{left\_y}(\\{qq})-\\{right\_y}(\\{pp})$;\5
+$\\{y3r}\K\\{y\_coord}(\\{qq})-\\{left\_y}(\\{qq})$;\5
+$\\{set\_min\_max}(\\{yr\_packet})$;\6
+$\\{delx}\K\\{x\_coord}(\|p)-\\{x\_coord}(\\{pp})$;\5
+$\\{dely}\K\\{y\_coord}(\|p)-\\{y\_coord}(\\{pp})$;\6
+$\\{tol}\K0$;\5
+$\\{uv}\K\\{r\_packets}$;\5
+$\\{xy}\K\\{r\_packets}$;\5
+$\\{three\_l}\K0$;\5
+$\\{cur\_t}\K1$;\5
+$\\{cur\_tt}\K1$\par
+\U556.\fi
+
+\M559. \P$\X559:Subdivide for a new level of intersection\X\S$\6
+$\\{stack\_dx}\K\\{delx}$;\5
+$\\{stack\_dy}\K\\{dely}$;\5
+$\\{stack\_tol}\K\\{tol}$;\5
+$\\{stack\_uv}\K\\{uv}$;\5
+$\\{stack\_xy}\K\\{xy}$;\5
+$\\{bisect\_ptr}\K\\{bisect\_ptr}+\\{int\_increment}$;\6
+$\\{double}(\\{cur\_t})$;\5
+$\\{double}(\\{cur\_tt})$;\6
+$\\{u1l}\K\\{stack\_1}(\\{u\_packet}(\\{uv}))$;\5
+$\\{u3r}\K\\{stack\_3}(\\{u\_packet}(\\{uv}))$;\5
+$\\{u2l}\K\\{half}(\\{u1l}+\\{stack\_2}(\\{u\_packet}(\\{uv})))$;\5
+$\\{u2r}\K\\{half}(\\{u3r}+\\{stack\_2}(\\{u\_packet}(\\{uv})))$;\5
+$\\{u3l}\K\\{half}(\\{u2l}+\\{u2r})$;\5
+$\\{u1r}\K\\{u3l}$;\5
+$\\{set\_min\_max}(\\{ul\_packet})$;\5
+$\\{set\_min\_max}(\\{ur\_packet})$;\6
+$\\{v1l}\K\\{stack\_1}(\\{v\_packet}(\\{uv}))$;\5
+$\\{v3r}\K\\{stack\_3}(\\{v\_packet}(\\{uv}))$;\5
+$\\{v2l}\K\\{half}(\\{v1l}+\\{stack\_2}(\\{v\_packet}(\\{uv})))$;\5
+$\\{v2r}\K\\{half}(\\{v3r}+\\{stack\_2}(\\{v\_packet}(\\{uv})))$;\5
+$\\{v3l}\K\\{half}(\\{v2l}+\\{v2r})$;\5
+$\\{v1r}\K\\{v3l}$;\5
+$\\{set\_min\_max}(\\{vl\_packet})$;\5
+$\\{set\_min\_max}(\\{vr\_packet})$;\6
+$\\{x1l}\K\\{stack\_1}(\\{x\_packet}(\\{xy}))$;\5
+$\\{x3r}\K\\{stack\_3}(\\{x\_packet}(\\{xy}))$;\5
+$\\{x2l}\K\\{half}(\\{x1l}+\\{stack\_2}(\\{x\_packet}(\\{xy})))$;\5
+$\\{x2r}\K\\{half}(\\{x3r}+\\{stack\_2}(\\{x\_packet}(\\{xy})))$;\5
+$\\{x3l}\K\\{half}(\\{x2l}+\\{x2r})$;\5
+$\\{x1r}\K\\{x3l}$;\5
+$\\{set\_min\_max}(\\{xl\_packet})$;\5
+$\\{set\_min\_max}(\\{xr\_packet})$;\6
+$\\{y1l}\K\\{stack\_1}(\\{y\_packet}(\\{xy}))$;\5
+$\\{y3r}\K\\{stack\_3}(\\{y\_packet}(\\{xy}))$;\5
+$\\{y2l}\K\\{half}(\\{y1l}+\\{stack\_2}(\\{y\_packet}(\\{xy})))$;\5
+$\\{y2r}\K\\{half}(\\{y3r}+\\{stack\_2}(\\{y\_packet}(\\{xy})))$;\5
+$\\{y3l}\K\\{half}(\\{y2l}+\\{y2r})$;\5
+$\\{y1r}\K\\{y3l}$;\5
+$\\{set\_min\_max}(\\{yl\_packet})$;\5
+$\\{set\_min\_max}(\\{yr\_packet})$;\6
+$\\{uv}\K\\{l\_packets}$;\5
+$\\{xy}\K\\{l\_packets}$;\5
+$\\{double}(\\{delx})$;\5
+$\\{double}(\\{dely})$;\6
+$\\{tol}\K\\{tol}-\\{three\_l}+\\{tol\_step}$;\5
+$\\{double}(\\{tol})$;\5
+$\\{three\_l}\K\\{three\_l}+\\{tol\_step}$\par
+\U556.\fi
+
+\M560. \P$\X560:Advance to the next pair $(\\{cur\_t},\\{cur\_tt})$\X\S$\6
+\4\\{not\_found}: \37\&{if} $\\{odd}(\\{cur\_tt})$ \1\&{then}\6
+\&{if} $\\{odd}(\\{cur\_t})$ \1\&{then}\5
+\X561:Descend to the previous level and \&{goto} \\{not\_found}\X\6
+\4\&{else} \&{begin} \37$\\{incr}(\\{cur\_t})$;\5
+$\\{delx}\K\\{delx}+\\{stack\_1}(\\{u\_packet}(\\{uv}))+\\{stack\_2}(\\{u%
+\_packet}(\\{uv}))+\\{stack\_3}(\\{u\_packet}(\\{uv}))$;\5
+$\\{dely}\K\\{dely}+\\{stack\_1}(\\{v\_packet}(\\{uv}))+\\{stack\_2}(\\{v%
+\_packet}(\\{uv}))+\\{stack\_3}(\\{v\_packet}(\\{uv}))$;\5
+$\\{uv}\K\\{uv}+\\{int\_packets}$;\C{switch from \\{l\_packet} to \\{r%
+\_packet}}\6
+$\\{decr}(\\{cur\_tt})$;\5
+$\\{xy}\K\\{xy}-\\{int\_packets}$;\C{switch from \\{r\_packet} to \\{l%
+\_packet}}\6
+$\\{delx}\K\\{delx}+\\{stack\_1}(\\{x\_packet}(\\{xy}))+\\{stack\_2}(\\{x%
+\_packet}(\\{xy}))+\\{stack\_3}(\\{x\_packet}(\\{xy}))$;\5
+$\\{dely}\K\\{dely}+\\{stack\_1}(\\{y\_packet}(\\{xy}))+\\{stack\_2}(\\{y%
+\_packet}(\\{xy}))+\\{stack\_3}(\\{y\_packet}(\\{xy}))$;\6
+\&{end}\2\6
+\4\&{else} \&{begin} \37$\\{incr}(\\{cur\_tt})$;\5
+$\\{tol}\K\\{tol}+\\{three\_l}$;\5
+$\\{delx}\K\\{delx}-\\{stack\_1}(\\{x\_packet}(\\{xy}))-\\{stack\_2}(\\{x%
+\_packet}(\\{xy}))-\\{stack\_3}(\\{x\_packet}(\\{xy}))$;\5
+$\\{dely}\K\\{dely}-\\{stack\_1}(\\{y\_packet}(\\{xy}))-\\{stack\_2}(\\{y%
+\_packet}(\\{xy}))-\\{stack\_3}(\\{y\_packet}(\\{xy}))$;\5
+$\\{xy}\K\\{xy}+\\{int\_packets}$;\C{switch from \\{l\_packet} to \\{r%
+\_packet}}\6
+\&{end}\2\par
+\U556.\fi
+
+\M561. \P$\X561:Descend to the previous level and \&{goto} \\{not\_found}\X\S$\6
+\&{begin} \37$\\{cur\_t}\K\\{half}(\\{cur\_t})$;\5
+$\\{cur\_tt}\K\\{half}(\\{cur\_tt})$;\6
+\&{if} $\\{cur\_t}=0$ \1\&{then}\5
+\&{return};\2\6
+$\\{bisect\_ptr}\K\\{bisect\_ptr}-\\{int\_increment}$;\5
+$\\{three\_l}\K\\{three\_l}-\\{tol\_step}$;\5
+$\\{delx}\K\\{stack\_dx}$;\5
+$\\{dely}\K\\{stack\_dy}$;\5
+$\\{tol}\K\\{stack\_tol}$;\5
+$\\{uv}\K\\{stack\_uv}$;\5
+$\\{xy}\K\\{stack\_xy}$;\6
+\&{goto} \37\\{not\_found};\6
+\&{end}\par
+\U560.\fi
+
+\M562. The \\{path\_intersection} procedure is much simpler.
+It invokes \\{cubic\_intersection} in lexicographic order until finding a
+pair of cubics that intersect. The final intersection times are placed in
+\\{cur\_t} and~\\{cur\_tt}.
+
+\Y\P\4\&{procedure}\1\ \37$\\{path\_intersection}(\|h,\39\\{hh}:\\{pointer})$;%
+\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37$\|p,\39\\{pp}$: \37\\{pointer};\C{link registers that traverse
+the given paths}\6
+$\|n,\39\\{nn}$: \37\\{integer};\C{integer parts of intersection times, minus %
+\\{unity}}\2\6
+\&{begin} \37\X563:Change one-point paths into dead cycles\X;\6
+$\\{tol\_step}\K0$;\6
+\1\&{repeat} \37$\|n\K-\\{unity}$;\5
+$\|p\K\|h$;\6
+\1\&{repeat} \37\&{if} $\\{right\_type}(\|p)\I\\{endpoint}$ \1\&{then}\6
+\&{begin} \37$\\{nn}\K-\\{unity}$;\5
+$\\{pp}\K\\{hh}$;\6
+\1\&{repeat} \37\&{if} $\\{right\_type}(\\{pp})\I\\{endpoint}$ \1\&{then}\6
+\&{begin} \37$\\{cubic\_intersection}(\|p,\39\\{pp})$;\6
+\&{if} $\\{cur\_t}>0$ \1\&{then}\6
+\&{begin} \37$\\{cur\_t}\K\\{cur\_t}+\|n$;\5
+$\\{cur\_tt}\K\\{cur\_tt}+\\{nn}$;\5
+\&{return};\6
+\&{end};\2\6
+\&{end};\2\6
+$\\{nn}\K\\{nn}+\\{unity}$;\5
+$\\{pp}\K\\{link}(\\{pp})$;\6
+\4\&{until}\5
+$\\{pp}=\\{hh}$;\2\6
+\&{end};\2\6
+$\|n\K\|n+\\{unity}$;\5
+$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\|p=\|h$;\2\6
+$\\{tol\_step}\K\\{tol\_step}+3$;\6
+\4\&{until}\5
+$\\{tol\_step}>3$;\2\6
+$\\{cur\_t}\K-\\{unity}$;\5
+$\\{cur\_tt}\K-\\{unity}$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M563. \P$\X563:Change one-point paths into dead cycles\X\S$\6
+\&{if} $\\{right\_type}(\|h)=\\{endpoint}$ \1\&{then}\6
+\&{begin} \37$\\{right\_x}(\|h)\K\\{x\_coord}(\|h)$;\5
+$\\{left\_x}(\|h)\K\\{x\_coord}(\|h)$;\5
+$\\{right\_y}(\|h)\K\\{y\_coord}(\|h)$;\5
+$\\{left\_y}(\|h)\K\\{y\_coord}(\|h)$;\5
+$\\{right\_type}(\|h)\K\\{explicit}$;\6
+\&{end};\2\6
+\&{if} $\\{right\_type}(\\{hh})=\\{endpoint}$ \1\&{then}\6
+\&{begin} \37$\\{right\_x}(\\{hh})\K\\{x\_coord}(\\{hh})$;\5
+$\\{left\_x}(\\{hh})\K\\{x\_coord}(\\{hh})$;\5
+$\\{right\_y}(\\{hh})\K\\{y\_coord}(\\{hh})$;\5
+$\\{left\_y}(\\{hh})\K\\{y\_coord}(\\{hh})$;\5
+$\\{right\_type}(\\{hh})\K\\{explicit}$;\6
+\&{end};\2\par
+\U562.\fi
+
+\N564. \[27] Online graphic output.
+\MF\ displays images on the user's screen by means of a few primitive
+operations that are defined below. These operations have deliberately been
+kept simple so that they can be implemented without great difficulty on a
+wide variety of machines. Since \PASCAL\ has no traditional standards for
+graphic output, some system-dependent code needs to be written in order to
+support this aspect of \MF; but the necessary routines are usually quite
+easy to write.
+
+In fact, there are exactly four such routines:
+
+\yskip\hang
+\\{init\_screen} does whatever initialization is necessary to
+support the other operations; it is a boolean function that returns
+\\{false} if graphic output cannot be supported (e.g., if the other three
+routines have not been written, or if the user doesn't have the
+right kind of terminal).
+
+\yskip\hang
+\\{blank\_rectangle} updates a buffer area in memory so that
+all pixels in a specified rectangle will be set to the background color.
+
+\yskip\hang
+\\{paint\_row} assigns values to specified pixels in a row of
+the buffer just mentioned, based on ``transition'' indices explained below.
+
+\yskip\hang
+\\{update\_screen} displays the current screen buffer; the
+effects of \\{blank\_rectangle} and \\{paint\_row} commands may or may not
+become visible until the next \\{update\_screen} operation is performed.
+(Thus, \\{update\_screen} is analogous to \\{update\_terminal}.)
+
+\yskip\noindent
+The \PASCAL\ code here is a minimum version of \\{init\_screen} and
+\\{update\_screen}, usable on \MF\ installations that don't
+support screen output. If \\{init\_screen} is changed to return \\{true}
+instead of \\{false}, the other routines will simply log the fact
+that they have been called; they won't really display anything.
+The standard test routines for \MF\ use this log information to check
+that \MF\ is working properly, but the \\{wlog} instructions should be
+removed from production versions of \MF.
+
+\Y\P\4\&{function}\1\ \37\\{init\_screen}: \37\\{boolean};\2\6
+\&{begin} \37$\\{init\_screen}\K\\{false}$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37\\{update\_screen};\C{will be called only if \\{init%
+\_screen} returns \\{true}}\2\6
+\&{begin} \37\&{init} \37$\\{wlog\_ln}(\.{\'Calling\ UPDATESCREEN\'})$;\ %
+\&{tini}\C{for testing only}\6
+\&{end};\par
+\fi
+
+\M565. The user's screen is assumed to be a rectangular area, \\{screen\_width}
+pixels wide and \\{screen\_depth} pixels deep. The pixel in the upper left
+corner is said to be in column~0 of row~0; the pixel in the lower right
+corner is said to be in column $\\{screen\_width}-1$ of row $\\{screen%
+\_depth}-1$.
+Notice that row numbers increase from top to bottom, contrary to \MF's
+other coordinates.
+
+Each pixel is assumed to have two states, referred to in this documentation
+as \\{black} and \\{white}. The background color is called \\{white} and the
+other color is called \\{black}; but any two distinct pixel values
+can actually be used. For example, the author developed \MF\ on a
+system for which \\{white} was black and \\{black} was bright green.
+
+\Y\P\D \37$\\{white}=0$\C{background pixels}\par
+\P\D \37$\\{black}=1$\C{visible pixels}\par
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{screen\_row}=0\to\\{screen\_depth}$;\C{a row number on the screen}\6
+$\\{screen\_col}=0\to\\{screen\_width}$;\C{a column number on the screen}\6
+$\\{trans\_spec}=$\1\5
+\&{array} $[\\{screen\_col}]$ \1\&{of}\5
+\\{screen\_col};\C{a transition spec, see below}\2\2\6
+$\\{pixel\_color}=\\{white}\to\\{black}$;\C{specifies one of the two pixel
+values}\par
+\fi
+
+\M566. We'll illustrate the \\{blank\_rectangle} and \\{paint\_row} operations
+by
+pretending to declare a screen buffer called \\{screen\_pixel}. This code
+is actually commented out, but it does specify the intended effects.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\B\\{screen\_pixel}$: \37\&{array} $[\\{screen\_row},\39\\{screen\_col}]$ \1%
+\&{of}\5
+\\{pixel\_color};\ \2\6
+$\T$\par
+\fi
+
+\M567. The \\{blank\_rectangle} routine simply whitens all pixels that lie in
+columns \\{left\_col} through $\\{right\_col}-1$, inclusive, of rows
+\\{top\_row} through $\\{bot\_row}-1$, inclusive, given four parameters that
+satisfy
+the relations
+$$\hbox{$0\L\\{left\_col}\L\\{right\_col}\L\\{screen\_width}$,\quad
+$0\L\\{top\_row}\L\\{bot\_row}\L\\{screen\_depth}$.}$$
+If $\\{left\_col}=\\{right\_col}$ or $\\{top\_row}=\\{bot\_row}$, nothing
+happens.
+
+The commented-out code in the following procedure is for illustrative
+purposes only.
+
+\Y\P\4\&{procedure}\1\ \37$\\{blank\_rectangle}(\\{left\_col},\39\\{right%
+\_col}:\\{screen\_col};\,\35\\{top\_row},\39\\{bot\_row}:\\{screen\_row})$;\6
+\4\&{var} \37\|r: \37\\{screen\_row};\5
+\|c: \37\\{screen\_col};\2\6
+\&{begin} \37$\B$\ \&{for} $\|r\K\\{top\_row}\mathrel{\&{to}}\\{bot\_row}-1$ \1%
+\&{do}\6
+\&{for} $\|c\K\\{left\_col}\mathrel{\&{to}}\\{right\_col}-1$ \1\&{do}\5
+$\\{screen\_pixel}[\|r,\39\|c]\K\\{white}$;\ \2\2\6
+$\T$\6
+\&{init} \37\\{wlog\_cr};\C{this will be done only after $\\{init\_screen}=%
+\\{true}$}\6
+$\\{wlog\_ln}(\.{\'Calling\ BLANKRECTANGLE(\'},\39\\{left\_col}:1,\39\.{\',\'},%
+\39\\{right\_col}:1,\39\.{\',\'},\39\\{top\_row}:1,\39\.{\',\'},\39\\{bot%
+\_row}:1,\39\.{\')\'})$;\ \&{tini}\6
+\&{end};\par
+\fi
+
+\M568. The real work of screen display is done by \\{paint\_row}. But it's not
+hard work, because the operation affects only
+one of the screen rows, and it affects only a contiguous set of columns
+in that row. There are four parameters: \|r~(the row),
+\|b~(the initial color),
+\|a~(the array of transition specifications),
+and \|n~(the number of transitions). The elements of~\|a will satisfy
+$$0\L a[0]<a[1]<\cdots<a[n]\L \\{screen\_width};$$
+the value of \|r will satisfy $0\L\|r<\\{screen\_depth}$; and \|n will be
+positive.
+
+The general idea is to paint blocks of pixels in alternate colors;
+the precise details are best conveyed by means of a \PASCAL\
+program (see the commented-out code below).
+
+\Y\P\4\&{procedure}\1\ \37$\\{paint\_row}(\|r:\\{screen\_row};\,\35\|b:%
+\\{pixel\_color};\,\35\mathop{\&{var}}\|a:\\{trans\_spec};\,\35\|n:\\{screen%
+\_col})$;\6
+\4\&{var} \37\|k: \37\\{screen\_col};\C{an index into \|a}\6
+\|c: \37\\{screen\_col};\C{an index into \\{screen\_pixel}}\2\6
+\&{begin} \37$\B\|k\K0$;\5
+$\|c\K\|a[0]$;\6
+\1\&{repeat} \37$\\{incr}(\|k)$;\6
+\1\&{repeat} \37$\\{screen\_pixel}[\|r,\39\|c]\K\|b$;\5
+$\\{incr}(\|c)$;\6
+\4\&{until}\5
+$\|c=\|a[\|k]$;\2\6
+$\|b\K\\{black}-\|b$;\C{$\\{black}\swap\\{white}$}\6
+\4\&{until}\5
+$\|k=\|n$;\ \2\6
+$\T$\6
+\&{init} \37$\\{wlog}(\.{\'Calling\ PAINTROW(\'},\39\|r:1,\39\.{\',\'},\39%
+\|b:1,\39\.{\';\'})$;\C{this is done only after $\\{init\_screen}=\\{true}$}\6
+\&{for} $\|k\K0\mathrel{\&{to}}\|n$ \1\&{do}\6
+\&{begin} \37$\\{wlog}(\|a[\|k]:1)$;\6
+\&{if} $\|k\I\|n$ \1\&{then}\5
+$\\{wlog}(\.{\',\'})$;\2\6
+\&{end};\2\6
+$\\{wlog\_ln}(\.{\')\'})$;\ \&{tini}\6
+\&{end};\par
+\fi
+
+\M569. The remainder of \MF's screen routines are system-independent calls
+on the four primitives just defined.
+
+First we have a global boolean variable that tells if \\{init\_screen}
+has been called, and another one that tells if \\{init\_screen} has
+given a \\{true} response.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{screen\_started}: \37\\{boolean};\C{have the screen primitives been
+initialized?}\6
+\4\\{screen\_OK}: \37\\{boolean};\C{is it legitimate to call \\{blank%
+\_rectangle}, \\{paint\_row}, and \\{update\_screen}?}\par
+\fi
+
+\M570. \P\D \37$\\{start\_screen}\S$\1\6
+\&{begin} \37\&{if} $\R\\{screen\_started}$ \1\&{then}\6
+\&{begin} \37$\\{screen\_OK}\K\\{init\_screen}$;\5
+$\\{screen\_started}\K\\{true}$;\6
+\&{end};\2\6
+\&{end}\2\par
+\Y\P$\4\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{screen\_started}\K\\{false}$;\5
+$\\{screen\_OK}\K\\{false}$;\par
+\fi
+
+\M571. \MF\ provides the user with 16 ``window'' areas on the screen, in each
+of which it is possible to produce independent displays.
+
+It should be noted that \MF's windows aren't really independent
+``clickable'' entities in the sense of multi-window graphic workstations;
+\MF\ simply maps them into subsets of a single screen image that is
+controlled by \\{init\_screen}, \\{blank\_rectangle}, \\{paint\_row}, and
+\\{update\_screen} as described above. Implementations of \MF\ on a
+multi-window workstation probably therefore make use of only two
+windows in the other sense: one for the terminal output and another
+for the screen with \MF's 16 areas. Henceforth we shall
+use the term window only in \MF's sense.
+
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{window\_number}=0\to15$;\par
+\fi
+
+\M572. A user doesn't have to use any of the 16 windows. But when a window is
+``opened,'' it is allocated to a specific rectangular portion of the screen
+and to a specific rectangle with respect to \MF's coordinates. The relevant
+data is stored in global arrays \\{window\_open}, \\{left\_col}, \\{right%
+\_col},
+\\{top\_row}, \\{bot\_row}, \\{m\_window}, and \\{n\_window}.
+
+The \\{window\_open} array is boolean, and its significance is obvious. The
+\\{left\_col}, \dots, \\{bot\_row} arrays contain screen coordinates that
+can be used to blank the entire window with \\{blank\_rectangle}. And the
+other two arrays just mentioned handle the conversion between
+actual coordinates and screen coordinates: \MF's pixel in column~$m$
+of row~$n$ will appear in screen column $\\{m\_window}+\|m$ and in screen row
+$\\{n\_window}-\|n$, provided that these lie inside the boundaries of the
+window.
+
+Another array \\{window\_time} holds the number of times this window has
+been updated.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{window\_open}: \37\&{array} $[\\{window\_number}]$ \1\&{of}\5
+\\{boolean};\C{has this window been opened?}\2\6
+\4\\{left\_col}: \37\&{array} $[\\{window\_number}]$ \1\&{of}\5
+\\{screen\_col};\C{leftmost column position on screen}\2\6
+\4\\{right\_col}: \37\&{array} $[\\{window\_number}]$ \1\&{of}\5
+\\{screen\_col};\C{rightmost column position, plus~1}\2\6
+\4\\{top\_row}: \37\&{array} $[\\{window\_number}]$ \1\&{of}\5
+\\{screen\_row};\C{topmost row position on screen}\2\6
+\4\\{bot\_row}: \37\&{array} $[\\{window\_number}]$ \1\&{of}\5
+\\{screen\_row};\C{bottommost row position, plus~1}\2\6
+\4\\{m\_window}: \37\&{array} $[\\{window\_number}]$ \1\&{of}\5
+\\{integer};\C{offset between user and screen columns}\2\6
+\4\\{n\_window}: \37\&{array} $[\\{window\_number}]$ \1\&{of}\5
+\\{integer};\C{offset between user and screen rows}\2\6
+\4\\{window\_time}: \37\&{array} $[\\{window\_number}]$ \1\&{of}\5
+\\{integer};\C{it has been updated this often}\2\par
+\fi
+
+\M573. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+\&{for} $\|k\K0\mathrel{\&{to}}15$ \1\&{do}\6
+\&{begin} \37$\\{window\_open}[\|k]\K\\{false}$;\5
+$\\{window\_time}[\|k]\K0$;\6
+\&{end};\2\par
+\fi
+
+\M574. Opening a window isn't like opening a file, because you can open it
+as often as you like, and you never have to close it again. The idea is
+simply to define special points on the current screen display.
+
+Overlapping window specifications may cause complex effects that can
+be understood only by scrutinizing \MF's display algorithms; thus it
+has been left undefined in the \MF\ user manual, although the behavior
+is in fact predictable.
+
+Here is a subroutine that implements the command `\&{openwindow}~\|k
+\&{from}~$(\\{r0},\\{c0})$ \&{to}~$(\\{r1},\\{c1})$ \&{at}~$(x,y)$'.
+
+\Y\P\4\&{procedure}\1\ \37$\\{open\_a\_window}(\|k:\\{window\_number};\,\35%
+\\{r0},\39\\{c0},\39\\{r1},\39\\{c1}:\\{scaled};\,\35\|x,\39\|y:\\{scaled})$;\6
+\4\&{var} \37$\|m,\39\|n$: \37\\{integer};\C{pixel coordinates}\2\6
+\&{begin} \37\X575:Adjust the coordinates $(\\{r0},\\{c0})$ and $(\\{r1},%
+\\{c1})$ so that they lie in the proper range\X;\6
+$\\{window\_open}[\|k]\K\\{true}$;\5
+$\\{incr}(\\{window\_time}[\|k])$;\6
+$\\{left\_col}[\|k]\K\\{c0}$;\5
+$\\{right\_col}[\|k]\K\\{c1}$;\5
+$\\{top\_row}[\|k]\K\\{r0}$;\5
+$\\{bot\_row}[\|k]\K\\{r1}$;\6
+\X576:Compute the offsets between screen coordinates and actual coordinates\X;\6
+\\{start\_screen};\6
+\&{if} $\\{screen\_OK}$ \1\&{then}\6
+\&{begin} \37$\\{blank\_rectangle}(\\{c0},\39\\{c1},\39\\{r0},\39\\{r1})$;\5
+\\{update\_screen};\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M575. A window whose coordinates don't fit the existing screen size will be
+truncated until they do.
+
+\Y\P$\4\X575:Adjust the coordinates $(\\{r0},\\{c0})$ and $(\\{r1},\\{c1})$ so
+that they lie in the proper range\X\S$\6
+\&{if} $\\{r0}<0$ \1\&{then}\5
+$\\{r0}\K0$\ \&{else} $\\{r0}\K\\{round\_unscaled}(\\{r0})$;\2\6
+$\\{r1}\K\\{round\_unscaled}(\\{r1})$;\6
+\&{if} $\\{r1}>\\{screen\_depth}$ \1\&{then}\5
+$\\{r1}\K\\{screen\_depth}$;\2\6
+\&{if} $\\{r1}<\\{r0}$ \1\&{then}\6
+\&{if} $\\{r0}>\\{screen\_depth}$ \1\&{then}\5
+$\\{r0}\K\\{r1}$\ \&{else} $\\{r1}\K\\{r0}$;\2\2\6
+\&{if} $\\{c0}<0$ \1\&{then}\5
+$\\{c0}\K0$\ \&{else} $\\{c0}\K\\{round\_unscaled}(\\{c0})$;\2\6
+$\\{c1}\K\\{round\_unscaled}(\\{c1})$;\6
+\&{if} $\\{c1}>\\{screen\_width}$ \1\&{then}\5
+$\\{c1}\K\\{screen\_width}$;\2\6
+\&{if} $\\{c1}<\\{c0}$ \1\&{then}\6
+\&{if} $\\{c0}>\\{screen\_width}$ \1\&{then}\5
+$\\{c0}\K\\{c1}$\ \&{else} $\\{c1}\K\\{c0}$\2\2\par
+\U574.\fi
+
+\M576. Three sets of coordinates are rampant, and they must be kept straight!
+(i)~\MF's main coordinates refer to the edges between pixels. (ii)~\MF's
+pixel coordinates (within edge structures) say that the pixel bounded by
+$(m,n)$, $(m,n+1)$, $(m+1,n)$, and~$(m+1,n+1)$ is in pixel row number~$n$
+and pixel column number~$m$. (iii)~Screen coordinates, on the other hand,
+have rows numbered in increasing order from top to bottom, as mentioned
+above.
+
+The program here first computes integers $m$ and $n$ such that
+pixel column~$m$ of pixel row~$n$ will be at the upper left corner
+of the window. Hence pixel column $\|m-\\{c0}$ of pixel row $\|n+\\{r0}$
+will be at the upper left corner of the screen.
+
+\Y\P$\4\X576:Compute the offsets between screen coordinates and actual
+coordinates\X\S$\6
+$\|m\K\\{round\_unscaled}(\|x)$;\5
+$\|n\K\\{round\_unscaled}(\|y)-1$;\6
+$\\{m\_window}[\|k]\K\\{c0}-\|m$;\5
+$\\{n\_window}[\|k]\K\\{r0}+\|n$\par
+\U574.\fi
+
+\M577. Now here comes \MF's most complicated operation related to window
+display: Given the number~\|k of an open window, the pixels of positive
+weight in \\{cur\_edges} will be shown as \\{black} in the window; all other
+pixels will be shown as \\{white}.
+
+\Y\P\4\&{procedure}\1\ \37$\\{disp\_edges}(\|k:\\{window\_number})$;\6
+\4\&{label} \37$\\{done},\39\\{found}$;\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{for list manipulation}\6
+\\{already\_there}: \37\\{boolean};\C{is a previous incarnation in the window?}%
+\6
+\|r: \37\\{integer};\C{row number}\6
+\X580:Other local variables for \\{disp\_edges}\X\2\6
+\&{begin} \37\&{if} $\\{screen\_OK}$ \1\&{then}\6
+\&{if} $\\{left\_col}[\|k]<\\{right\_col}[\|k]$ \1\&{then}\6
+\&{if} $\\{top\_row}[\|k]<\\{bot\_row}[\|k]$ \1\&{then}\6
+\&{begin} \37$\\{already\_there}\K\\{false}$;\6
+\&{if} $\\{last\_window}(\\{cur\_edges})=\|k$ \1\&{then}\6
+\&{if} $\\{last\_window\_time}(\\{cur\_edges})=\\{window\_time}[\|k]$ \1%
+\&{then}\5
+$\\{already\_there}\K\\{true}$;\2\2\6
+\&{if} $\R\\{already\_there}$ \1\&{then}\5
+$\\{blank\_rectangle}(\\{left\_col}[\|k],\39\\{right\_col}[\|k],\39\\{top%
+\_row}[\|k],\39\\{bot\_row}[\|k])$;\2\6
+\X581:Initialize for the display computations\X;\6
+$\|p\K\\{link}(\\{cur\_edges})$;\5
+$\|r\K\\{n\_window}[\|k]-(\\{n\_min}(\\{cur\_edges})-\\{zero\_field})$;\6
+\&{while} $(\|p\I\\{cur\_edges})\W(\|r\G\\{top\_row}[\|k])$ \1\&{do}\6
+\&{begin} \37\&{if} $\|r<\\{bot\_row}[\|k]$ \1\&{then}\5
+\X578:Display the pixels of edge row \|p in screen row \|r\X;\2\6
+$\|p\K\\{link}(\|p)$;\5
+$\\{decr}(\|r)$;\6
+\&{end};\2\6
+\\{update\_screen};\5
+$\\{incr}(\\{window\_time}[\|k])$;\5
+$\\{last\_window}(\\{cur\_edges})\K\|k$;\5
+$\\{last\_window\_time}(\\{cur\_edges})\K\\{window\_time}[\|k]$;\6
+\&{end};\2\2\2\6
+\&{end};\par
+\fi
+
+\M578. Since it takes some work to display a row, we try to avoid recomputation
+whenever we can.
+
+\Y\P$\4\X578:Display the pixels of edge row \|p in screen row \|r\X\S$\6
+\&{begin} \37\&{if} $\\{unsorted}(\|p)>\\{void}$ \1\&{then}\5
+$\\{sort\_edges}(\|p)$\6
+\4\&{else} \&{if} $\\{unsorted}(\|p)=\\{void}$ \1\&{then}\6
+\&{if} $\\{already\_there}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\2\2\6
+$\\{unsorted}(\|p)\K\\{void}$;\C{this time we'll paint, but maybe not next
+time}\6
+\X582:Set up the parameters needed for \\{paint\_row}; but \&{goto} \\{done} if
+no painting is needed after all\X;\6
+$\\{paint\_row}(\|r,\39\|b,\39\\{row\_transition},\39\|n)$;\6
+\4\\{done}: \37\&{end}\par
+\U577.\fi
+
+\M579. The transition-specification parameter to \\{paint\_row} is always the
+same
+array.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{row\_transition}: \37\\{trans\_spec};\C{an array of \\{black}/\\{white}
+transitions}\par
+\fi
+
+\M580. The job remaining is to go through the list $\\{sorted}(\|p)$, unpacking
+the
+\\{info} fields into \|m and weight, then making \\{black} the pixels whose
+accumulated weight~\|w is positive.
+
+\Y\P$\4\X580:Other local variables for \\{disp\_edges}\X\S$\6
+\4\|n: \37\\{screen\_col};\C{the highest active index in \\{row\_transition}}\6
+\4$\|w,\39\\{ww}$: \37\\{integer};\C{old and new accumulated weights}\6
+\4\|b: \37\\{pixel\_color};\C{status of first pixel in the row transitions}\6
+\4$\|m,\39\\{mm}$: \37\\{integer};\C{old and new screen column positions}\6
+\4\|d: \37\\{integer};\C{edge-and-weight without \\{min\_halfword}
+compensation}\6
+\4\\{m\_adjustment}: \37\\{integer};\C{conversion between edge and screen
+coordinates}\6
+\4\\{right\_edge}: \37\\{integer};\C{largest edge-and-weight that could affect
+the window}\6
+\4\\{min\_col}: \37\\{screen\_col};\C{the smallest screen column number in the
+window}\par
+\U577.\fi
+
+\M581. Some precomputed constants make the display calculations faster.
+
+\Y\P$\4\X581:Initialize for the display computations\X\S$\6
+$\\{m\_adjustment}\K\\{m\_window}[\|k]-\\{m\_offset}(\\{cur\_edges})$;\6
+$\\{right\_edge}\K8\ast(\\{right\_col}[\|k]-\\{m\_adjustment})$;\6
+$\\{min\_col}\K\\{left\_col}[\|k]$\par
+\U577.\fi
+
+\M582. \P$\X582:Set up the parameters needed for \\{paint\_row}; but \&{goto} %
+\\{done} if no painting is needed after all\X\S$\6
+$\|n\K0$;\5
+$\\{ww}\K0$;\5
+$\|m\K-1$;\5
+$\|w\K0$;\5
+$\|q\K\\{sorted}(\|p)$;\5
+$\\{row\_transition}[0]\K\\{min\_col}$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\|q=\\{sentinel}$ \1\&{then}\5
+$\|d\K\\{right\_edge}$\6
+\4\&{else} $\|d\K\\{ho}(\\{info}(\|q))$;\2\6
+$\\{mm}\K(\|d\mathbin{\&{div}}8)+\\{m\_adjustment}$;\6
+\&{if} $\\{mm}\I\|m$ \1\&{then}\6
+\&{begin} \37\X583:Record a possible transition in column \|m\X;\6
+$\|m\K\\{mm}$;\5
+$\|w\K\\{ww}$;\6
+\&{end};\2\6
+\&{if} $\|d\G\\{right\_edge}$ \1\&{then}\5
+\&{goto} \37\\{found};\2\6
+$\\{ww}\K\\{ww}+(\|d\mathbin{\&{mod}}8)-\\{zero\_w}$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+\4\\{found}: \37\X584:Wind up the \\{paint\_row} parameter calculation by
+inserting the final transition; \&{goto} \\{done} if no painting is needed\X;%
+\par
+\U578.\fi
+
+\M583. Now \|m is a screen column $<\\{right\_col}[\|k]$.
+
+\Y\P$\4\X583:Record a possible transition in column \|m\X\S$\6
+\&{if} $\|w\L0$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{ww}>0$ \1\&{then}\6
+\&{if} $\|m>\\{min\_col}$ \1\&{then}\6
+\&{begin} \37\&{if} $\|n=0$ \1\&{then}\6
+\&{if} $\\{already\_there}$ \1\&{then}\6
+\&{begin} \37$\|b\K\\{white}$;\5
+$\\{incr}(\|n)$;\6
+\&{end}\6
+\4\&{else} $\|b\K\\{black}$\2\6
+\4\&{else} $\\{incr}(\|n)$;\2\6
+$\\{row\_transition}[\|n]\K\|m$;\6
+\&{end};\2\2\6
+\&{end}\6
+\4\&{else} \&{if} $\\{ww}\L0$ \1\&{then}\6
+\&{if} $\|m>\\{min\_col}$ \1\&{then}\6
+\&{begin} \37\&{if} $\|n=0$ \1\&{then}\5
+$\|b\K\\{black}$;\2\6
+$\\{incr}(\|n)$;\5
+$\\{row\_transition}[\|n]\K\|m$;\6
+\&{end}\2\2\2\par
+\U582.\fi
+
+\M584. If the entire row is \\{white} in the window area, we can omit painting
+it
+when \\{already\_there} is false, since it has already been blanked out in
+that case.
+
+When the following code is invoked, $\\{row\_transition}[\|n]$ will be
+strictly less than $\\{right\_col}[\|k]$.
+
+\Y\P$\4\X584:Wind up the \\{paint\_row} parameter calculation by inserting the
+final transition; \&{goto} \\{done} if no painting is needed\X\S$\6
+\&{if} $\\{already\_there}\V(\\{ww}>0)$ \1\&{then}\6
+\&{begin} \37\&{if} $\|n=0$ \1\&{then}\6
+\&{if} $\\{ww}>0$ \1\&{then}\5
+$\|b\K\\{black}$\6
+\4\&{else} $\|b\K\\{white}$;\2\2\6
+$\\{incr}(\|n)$;\5
+$\\{row\_transition}[\|n]\K\\{right\_col}[\|k]$;\6
+\&{end}\6
+\4\&{else} \&{if} $\|n=0$ \1\&{then}\5
+\&{goto} \37\\{done}\2\2\par
+\U582.\fi
+
+\N585. \[28] Dynamic linear equations.
+\MF\ users define variables implicitly by stating equations that should be
+satisfied; the computer is supposed to be smart enough to solve those
+equations.
+And indeed, the computer tries valiantly to do so, by distinguishing five
+different types of numeric values:
+
+\smallskip\hang
+$\\{type}(\|p)=\\{known}$ is the nice case, when $\\{value}(\|p)$ is the %
+\\{scaled} value
+of the variable whose address is~\|p.
+
+\smallskip\hang
+$\\{type}(\|p)=\\{dependent}$ means that $\\{value}(\|p)$ is not present, but $%
+\\{dep\_list}(\|p)$
+points to a {\sl dependency list\/} that expresses the value of variable~\|p
+as a \\{scaled} number plus a sum of independent variables with \\{fraction}
+coefficients.
+
+\smallskip\hang
+$\\{type}(\|p)=\\{independent}$ means that $\\{value}(\|p)=64\|s+\|m$, where $%
+\|s>0$ is a ``serial
+number'' reflecting the time this variable was first used in an equation;
+also $0\L\|m<64$, and each dependent variable
+that refers to this one is actually referring to the future value of
+this variable times~$2^m$. (Usually $\|m=0$, but higher degrees of
+scaling are sometimes needed to keep the coefficients in dependency lists
+from getting too large. The value of~\|m will always be even.)
+
+\smallskip\hang
+$\\{type}(\|p)=\\{numeric\_type}$ means that variable \|p hasn't appeared in an
+equation before, but it has been explicitly declared to be numeric.
+
+\smallskip\hang
+$\\{type}(\|p)=\\{undefined}$ means that variable \|p hasn't appeared before.
+
+\smallskip\noindent
+We have actually discussed these five types in the reverse order of their
+history during a computation: Once \\{known}, a variable never again
+becomes \\{dependent}; once \\{dependent}, it almost never again becomes
+\\{independent}; once \\{independent}, it never again becomes \\{numeric%
+\_type};
+and once \\{numeric\_type}, it never again becomes \\{undefined} (except
+of course when the user specifically decides to scrap the old value
+and start again). A backward step may, however, take place: Sometimes
+a \\{dependent} variable becomes \\{independent} again, when one of the
+independent variables it depends on is reverting to \\{undefined}.
+
+\Y\P\D \37$\\{s\_scale}=64$\C{the serial numbers are multiplied by this factor}%
+\par
+\P\D \37$\\{new\_indep}(\#)\S$\C{create a new independent variable}\6
+\&{begin} \37$\\{type}(\#)\K\\{independent}$;\5
+$\\{serial\_no}\K\\{serial\_no}+\\{s\_scale}$;\5
+$\\{value}(\#)\K\\{serial\_no}$;\6
+\&{end}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{serial\_no}: \37\\{integer};\C{the most recent serial number, times \\{s%
+\_scale}}\par
+\fi
+
+\M586. \P$\X586:Make variable $\|q+\|s$ newly independent\X\S$\6
+$\\{new\_indep}(\|q+\|s)$\par
+\U232.\fi
+
+\M587. But how are dependency lists represented? It's simple: The linear
+combination
+$\alpha_1v_1+\cdots+\alpha_kv_k+\beta$ appears in $\|k+1$ value nodes. If
+$\|q=\\{dep\_list}(\|p)$ points to this list, and if $\|k>0$, then $\\{value}(%
+\|q)=\hbox{$\alpha_1$}$ (which is a \\{fraction}); $\\{info}(\|q)$ points to
+the location
+of $v_1$; and $\\{link}(\|p)$ points to the dependency list
+$\alpha_2v_2+\cdots+\alpha_kv_k+\beta$. On the other hand if $\|k=0$,
+then $\\{value}(\|q)=\hbox{$\beta$}$ (which is \\{scaled}) and $\\{info}(\|q)=%
+\\{null}$.
+The independent variables $v_1$, \dots,~$v_k$ have been sorted so that
+they appear in decreasing order of their \\{value} fields (i.e., of
+their serial numbers). \ (It is convenient to use decreasing order,
+since $\\{value}(\\{null})=0$. If the independent variables were not sorted by
+serial number but by some other criterion, such as their location in \\{mem},
+the equation-solving mechanism would be too system-dependent, because
+the ordering can affect the computed results.)
+
+The \\{link} field in the node that contains the constant term $\beta$ is
+called the {\sl final link\/} of the dependency list. \MF\ maintains
+a doubly-linked master list of all dependency lists, in terms of a permanently
+allocated node
+in \\{mem} called \\{dep\_head}. If there are no dependencies, we have
+$\\{link}(\\{dep\_head})=\\{dep\_head}$ and $\\{prev\_dep}(\\{dep\_head})=%
+\\{dep\_head}$;
+otherwise $\\{link}(\\{dep\_head})$ points to the first dependent variable,
+say~\|p,
+and $\\{prev\_dep}(\|p)=\\{dep\_head}$. We have $\\{type}(\|p)=\\{dependent}$,
+and $\\{dep\_list}(\|p)$
+points to its dependency list. If the final link of that dependency list
+occurs in location~\|q, then $\\{link}(\|q)$ points to the next dependent
+variable (say~\|r); and we have $\\{prev\_dep}(\|r)=\|q$, etc.
+
+\Y\P\D \37$\\{dep\_list}(\#)\S\\{link}(\\{value\_loc}(\#))$\C{half of the %
+\\{value} field in a \\{dependent} variable}\par
+\P\D \37$\\{prev\_dep}(\#)\S\\{info}(\\{value\_loc}(\#))$\C{the other half;
+makes a doubly linked list}\par
+\P\D \37$\\{dep\_node\_size}=2$\C{the number of words per dependency node}\par
+\Y\P$\4\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}\S$\6
+$\\{serial\_no}\K0$;\5
+$\\{link}(\\{dep\_head})\K\\{dep\_head}$;\5
+$\\{prev\_dep}(\\{dep\_head})\K\\{dep\_head}$;\5
+$\\{info}(\\{dep\_head})\K\\{null}$;\5
+$\\{dep\_list}(\\{dep\_head})\K\\{null}$;\par
+\fi
+
+\M588. Actually the description above contains a little white lie. There's
+another kind of variable called \\{proto\_dependent}, which is
+just like a \\{dependent} one except that the $\alpha$ coefficients
+in its dependency list are \\{scaled} instead of being fractions.
+Proto-dependency lists are mixed with dependency lists in the
+nodes reachable from \\{dep\_head}.
+
+\fi
+
+\M589. Here is a procedure that prints a dependency list in symbolic form.
+The second parameter should be either \\{dependent} or \\{proto\_dependent},
+to indicate the scaling of the coefficients.
+
+\Y\P$\4\X257:Declare subroutines for printing expressions\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_dependency}(\|p:\\{pointer};\,\35\|t:\\{small%
+\_number})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|v: \37\\{integer};\C{a coefficient}\6
+$\\{pp},\39\|q$: \37\\{pointer};\C{for list manipulation}\2\6
+\&{begin} \37$\\{pp}\K\|p$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|v\K\\{abs}(\\{value}(\|p))$;\5
+$\|q\K\\{info}(\|p)$;\6
+\&{if} $\|q=\\{null}$ \1\&{then}\C{the constant term}\6
+\&{begin} \37\&{if} $(\|v\I0)\V(\|p=\\{pp})$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{value}(\|p)>0$ \1\&{then}\6
+\&{if} $\|p\I\\{pp}$ \1\&{then}\5
+$\\{print\_char}(\.{"+"})$;\2\2\6
+$\\{print\_scaled}(\\{value}(\|p))$;\6
+\&{end};\2\6
+\&{return};\6
+\&{end};\2\6
+\X590:Print the coefficient, unless it's $\pm1.0$\X;\6
+\&{if} $\\{type}(\|q)\I\\{independent}$ \1\&{then}\5
+$\\{confusion}(\.{"dep"})$;\2\6
+$\\{print\_variable\_name}(\|q)$;\5
+$\|v\K\\{value}(\|q)\mathbin{\&{mod}}\\{s\_scale}$;\6
+\&{while} $\|v>0$ \1\&{do}\6
+\&{begin} \37$\\{print}(\.{"*4"})$;\5
+$\|v\K\|v-2$;\6
+\&{end};\2\6
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M590. \P$\X590:Print the coefficient, unless it's $\pm1.0$\X\S$\6
+\&{if} $\\{value}(\|p)<0$ \1\&{then}\5
+$\\{print\_char}(\.{"-"})$\6
+\4\&{else} \&{if} $\|p\I\\{pp}$ \1\&{then}\5
+$\\{print\_char}(\.{"+"})$;\2\2\6
+\&{if} $\|t=\\{dependent}$ \1\&{then}\5
+$\|v\K\\{round\_fraction}(\|v)$;\2\6
+\&{if} $\|v\I\\{unity}$ \1\&{then}\5
+$\\{print\_scaled}(\|v)$\2\par
+\U589.\fi
+
+\M591. The maximum absolute value of a coefficient in a given dependency list
+is returned by the following simple function.
+
+\Y\P\4\&{function}\1\ \37$\\{max\_coef}(\|p:\\{pointer})$: \37\\{fraction};\6
+\4\&{var} \37\|x: \37\\{fraction};\C{the maximum so far}\2\6
+\&{begin} \37$\|x\K0$;\6
+\&{while} $\\{info}(\|p)\I\\{null}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{abs}(\\{value}(\|p))>\|x$ \1\&{then}\5
+$\|x\K\\{abs}(\\{value}(\|p))$;\2\6
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+$\\{max\_coef}\K\|x$;\6
+\&{end};\par
+\fi
+
+\M592. One of the main operations needed on dependency lists is to add a
+multiple
+of one list to the other; we call this \\{p\_plus\_fq}, where \|p and~\|q point
+to dependency lists and \|f is a fraction.
+
+If the coefficient of any independent variable becomes \\{coef\_bound} or
+more, in absolute value, this procedure changes the type of that variable
+to `\\{independent\_needing\_fix}', and sets the global variable \\{fix%
+\_needed}
+to~\\{true}. The value of $\\{coef\_bound}=\mu$ is chosen so that
+$\mu^2+\mu<8$; this means that the numbers we deal with won't
+get too large. (Instead of the ``optimum'' $\mu=(\sqrt{33}-1)/2\approx
+2.3723$, the safer value 7/3 is taken as the threshold.)
+
+The changes mentioned in the preceding paragraph are actually done only if
+the global variable \\{watch\_coefs} is \\{true}. But it usually is; in fact,
+it is \\{false} only when \MF\ is making a dependency list that will soon
+be equated to zero.
+
+Several procedures that act on dependency lists, including \\{p\_plus\_fq},
+set the global variable \\{dep\_final} to the final (constant term) node of
+the dependency list that they produce.
+
+\Y\P\D \37$\\{coef\_bound}\S\O{4525252525}$\C{\\{fraction} approximation to
+7/3}\par
+\P\D \37$\\{independent\_needing\_fix}=0$\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{fix\_needed}: \37\\{boolean};\C{does at least one \\{independent} variable
+need scaling?}\6
+\4\\{watch\_coefs}: \37\\{boolean};\C{should we scale coefficients that exceed %
+\\{coef\_bound}?}\6
+\4\\{dep\_final}: \37\\{pointer};\C{location of the constant term and final
+link}\par
+\fi
+
+\M593. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{fix\_needed}\K\\{false}$;\5
+$\\{watch\_coefs}\K\\{true}$;\par
+\fi
+
+\M594. The \\{p\_plus\_fq} procedure has a fourth parameter, \|t, that should
+be
+set to \\{proto\_dependent} if \|p is a proto-dependency list. In this
+case \|f will be \\{scaled}, not a \\{fraction}. Similarly, the fifth
+parameter~\\{tt}
+should be \\{proto\_dependent} if \|q is a proto-dependency list.
+
+List \|q is unchanged by the operation; but list \|p is totally destroyed.
+
+The final link of the dependency list or proto-dependency list returned
+by \\{p\_plus\_fq} is the same as the original final link of~\|p. Indeed, the
+constant term of the result will be located in the same \\{mem} location
+as the original constant term of~\|p.
+
+Coefficients of the result are assumed to be zero if they are less than
+a certain threshold. This compensates for inevitable rounding errors,
+and tends to make more variables `\\{known}'. The threshold is approximately
+$10^{-5}$ in the case of normal dependency lists, $10^{-4}$ for
+proto-dependencies.
+
+\Y\P\D \37$\\{fraction\_threshold}=2685$\C{a \\{fraction} coefficient less than
+this is zeroed}\par
+\P\D \37$\\{half\_fraction\_threshold}=1342$\C{half of \\{fraction\_threshold}}%
+\par
+\P\D \37$\\{scaled\_threshold}=8$\C{a \\{scaled} coefficient less than this is
+zeroed}\par
+\P\D \37$\\{half\_scaled\_threshold}=4$\C{half of \\{scaled\_threshold}}\par
+\Y\P$\4\X594:Declare basic dependency-list subroutines\X\S$\6
+\4\&{function}\1\ \37$\\{p\_plus\_fq}(\|p:\\{pointer};\,\35\|f:\\{integer};\,%
+\35\|q:\\{pointer};\,\35\|t,\39\\{tt}:\\{small\_number})$: \37\\{pointer};\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37$\\{pp},\39\\{qq}$: \37\\{pointer};\C{$\\{info}(\|p)$ and $%
+\\{info}(\|q)$, respectively}\6
+$\|r,\39\|s$: \37\\{pointer};\C{for list manipulation}\6
+\\{threshold}: \37\\{integer};\C{defines a neighborhood of zero}\6
+\|v: \37\\{integer};\C{temporary register}\2\6
+\&{begin} \37\&{if} $\|t=\\{dependent}$ \1\&{then}\5
+$\\{threshold}\K\\{fraction\_threshold}$\6
+\4\&{else} $\\{threshold}\K\\{scaled\_threshold}$;\2\6
+$\|r\K\\{temp\_head}$;\5
+$\\{pp}\K\\{info}(\|p)$;\5
+$\\{qq}\K\\{info}(\|q)$;\6
+\~ \1\&{loop}\ \&{if} $\\{pp}=\\{qq}$ \1\&{then}\6
+\&{if} $\\{pp}=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{done}\6
+\4\&{else} \X595:Contribute a term from \|p, plus \|f times the corresponding
+term from \|q\X\2\6
+\4\&{else} \&{if} $\\{value}(\\{pp})<\\{value}(\\{qq})$ \1\&{then}\5
+\X596:Contribute a term from \|q, multiplied by~\|f\X\6
+\4\&{else} \&{begin} \37$\\{link}(\|r)\K\|p$;\5
+$\|r\K\|p$;\5
+$\|p\K\\{link}(\|p)$;\5
+$\\{pp}\K\\{info}(\|p)$;\6
+\&{end};\2\2\2\6
+\4\\{done}: \37\&{if} $\|t=\\{dependent}$ \1\&{then}\5
+$\\{value}(\|p)\K\\{slow\_add}(\\{value}(\|p),\39\\{take\_fraction}(\\{value}(%
+\|q),\39\|f))$\6
+\4\&{else} $\\{value}(\|p)\K\\{slow\_add}(\\{value}(\|p),\39\\{take\_scaled}(%
+\\{value}(\|q),\39\|f))$;\2\6
+$\\{link}(\|r)\K\|p$;\5
+$\\{dep\_final}\K\|p$;\5
+$\\{p\_plus\_fq}\K\\{link}(\\{temp\_head})$;\6
+\&{end};\par
+\As600, 602, 603\ETs604.
+\U246.\fi
+
+\M595. \P$\X595:Contribute a term from \|p, plus \|f times the corresponding
+term from \|q\X\S$\6
+\&{begin} \37\&{if} $\\{tt}=\\{dependent}$ \1\&{then}\5
+$\|v\K\\{value}(\|p)+\\{take\_fraction}(\|f,\39\\{value}(\|q))$\6
+\4\&{else} $\|v\K\\{value}(\|p)+\\{take\_scaled}(\|f,\39\\{value}(\|q))$;\2\6
+$\\{value}(\|p)\K\|v$;\5
+$\|s\K\|p$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{if} $\\{abs}(\|v)<\\{threshold}$ \1\&{then}\5
+$\\{free\_node}(\|s,\39\\{dep\_node\_size})$\6
+\4\&{else} \&{begin} \37\&{if} $\\{abs}(\|v)\G\\{coef\_bound}$ \1\&{then}\6
+\&{if} $\\{watch\_coefs}$ \1\&{then}\6
+\&{begin} \37$\\{type}(\\{qq})\K\\{independent\_needing\_fix}$;\5
+$\\{fix\_needed}\K\\{true}$;\6
+\&{end};\2\2\6
+$\\{link}(\|r)\K\|s$;\5
+$\|r\K\|s$;\6
+\&{end};\2\6
+$\\{pp}\K\\{info}(\|p)$;\5
+$\|q\K\\{link}(\|q)$;\5
+$\\{qq}\K\\{info}(\|q)$;\6
+\&{end}\par
+\U594.\fi
+
+\M596. \P$\X596:Contribute a term from \|q, multiplied by~\|f\X\S$\6
+\&{begin} \37\&{if} $\\{tt}=\\{dependent}$ \1\&{then}\5
+$\|v\K\\{take\_fraction}(\|f,\39\\{value}(\|q))$\6
+\4\&{else} $\|v\K\\{take\_scaled}(\|f,\39\\{value}(\|q))$;\2\6
+\&{if} $\\{abs}(\|v)>\\{half}(\\{threshold})$ \1\&{then}\6
+\&{begin} \37$\|s\K\\{get\_node}(\\{dep\_node\_size})$;\5
+$\\{info}(\|s)\K\\{qq}$;\5
+$\\{value}(\|s)\K\|v$;\6
+\&{if} $\\{abs}(\|v)\G\\{coef\_bound}$ \1\&{then}\6
+\&{if} $\\{watch\_coefs}$ \1\&{then}\6
+\&{begin} \37$\\{type}(\\{qq})\K\\{independent\_needing\_fix}$;\5
+$\\{fix\_needed}\K\\{true}$;\6
+\&{end};\2\2\6
+$\\{link}(\|r)\K\|s$;\5
+$\|r\K\|s$;\6
+\&{end};\2\6
+$\|q\K\\{link}(\|q)$;\5
+$\\{qq}\K\\{info}(\|q)$;\6
+\&{end}\par
+\U594.\fi
+
+\M597. It is convenient to have another subroutine for the special case
+of \\{p\_plus\_fq} when $\|f=1.0$. In this routine lists \|p and \|q are
+both of the same type~\|t (either \\{dependent} or \\{proto\_dependent}).
+
+\Y\P\4\&{function}\1\ \37$\\{p\_plus\_q}(\|p:\\{pointer};\,\35\|q:\\{pointer};%
+\,\35\|t:\\{small\_number})$: \37\\{pointer};\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37$\\{pp},\39\\{qq}$: \37\\{pointer};\C{$\\{info}(\|p)$ and $%
+\\{info}(\|q)$, respectively}\6
+$\|r,\39\|s$: \37\\{pointer};\C{for list manipulation}\6
+\\{threshold}: \37\\{integer};\C{defines a neighborhood of zero}\6
+\|v: \37\\{integer};\C{temporary register}\2\6
+\&{begin} \37\&{if} $\|t=\\{dependent}$ \1\&{then}\5
+$\\{threshold}\K\\{fraction\_threshold}$\6
+\4\&{else} $\\{threshold}\K\\{scaled\_threshold}$;\2\6
+$\|r\K\\{temp\_head}$;\5
+$\\{pp}\K\\{info}(\|p)$;\5
+$\\{qq}\K\\{info}(\|q)$;\6
+\~ \1\&{loop}\ \&{if} $\\{pp}=\\{qq}$ \1\&{then}\6
+\&{if} $\\{pp}=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{done}\6
+\4\&{else} \X598:Contribute a term from \|p, plus the corresponding term from %
+\|q\X\2\6
+\4\&{else} \&{if} $\\{value}(\\{pp})<\\{value}(\\{qq})$ \1\&{then}\6
+\&{begin} \37$\|s\K\\{get\_node}(\\{dep\_node\_size})$;\5
+$\\{info}(\|s)\K\\{qq}$;\5
+$\\{value}(\|s)\K\\{value}(\|q)$;\5
+$\|q\K\\{link}(\|q)$;\5
+$\\{qq}\K\\{info}(\|q)$;\5
+$\\{link}(\|r)\K\|s$;\5
+$\|r\K\|s$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{link}(\|r)\K\|p$;\5
+$\|r\K\|p$;\5
+$\|p\K\\{link}(\|p)$;\5
+$\\{pp}\K\\{info}(\|p)$;\6
+\&{end};\2\2\2\6
+\4\\{done}: \37$\\{value}(\|p)\K\\{slow\_add}(\\{value}(\|p),\39\\{value}(%
+\|q))$;\5
+$\\{link}(\|r)\K\|p$;\5
+$\\{dep\_final}\K\|p$;\5
+$\\{p\_plus\_q}\K\\{link}(\\{temp\_head})$;\6
+\&{end};\par
+\fi
+
+\M598. \P$\X598:Contribute a term from \|p, plus the corresponding term from %
+\|q\X\S$\6
+\&{begin} \37$\|v\K\\{value}(\|p)+\\{value}(\|q)$;\5
+$\\{value}(\|p)\K\|v$;\5
+$\|s\K\|p$;\5
+$\|p\K\\{link}(\|p)$;\5
+$\\{pp}\K\\{info}(\|p)$;\6
+\&{if} $\\{abs}(\|v)<\\{threshold}$ \1\&{then}\5
+$\\{free\_node}(\|s,\39\\{dep\_node\_size})$\6
+\4\&{else} \&{begin} \37\&{if} $\\{abs}(\|v)\G\\{coef\_bound}$ \1\&{then}\6
+\&{if} $\\{watch\_coefs}$ \1\&{then}\6
+\&{begin} \37$\\{type}(\\{qq})\K\\{independent\_needing\_fix}$;\5
+$\\{fix\_needed}\K\\{true}$;\6
+\&{end};\2\2\6
+$\\{link}(\|r)\K\|s$;\5
+$\|r\K\|s$;\6
+\&{end};\2\6
+$\|q\K\\{link}(\|q)$;\5
+$\\{qq}\K\\{info}(\|q)$;\6
+\&{end}\par
+\U597.\fi
+
+\M599. A somewhat simpler routine will multiply a dependency list
+by a given constant~\|v. The constant is either a \\{fraction} less than
+\\{fraction\_one}, or it is \\{scaled}. In the latter case we might be forced
+to
+convert a dependency list to a proto-dependency list.
+Parameters \\{t0} and \\{t1} are the list types before and after;
+they should agree unless $\\{t0}=\\{dependent}$ and $\\{t1}=\\{proto%
+\_dependent}$
+and $\\{v\_is\_scaled}=\\{true}$.
+
+\Y\P\4\&{function}\1\ \37$\\{p\_times\_v}(\|p:\\{pointer};\,\35\|v:%
+\\{integer};\,\35\\{t0},\39\\{t1}:\\{small\_number};\,\35\\{v\_is\_scaled}:%
+\\{boolean})$: \37\\{pointer};\6
+\4\&{var} \37$\|r,\39\|s$: \37\\{pointer};\C{for list manipulation}\6
+\|w: \37\\{integer};\C{tentative coefficient}\6
+\\{threshold}: \37\\{integer};\5
+\\{scaling\_down}: \37\\{boolean};\2\6
+\&{begin} \37\&{if} $\\{t0}\I\\{t1}$ \1\&{then}\5
+$\\{scaling\_down}\K\\{true}$\ \&{else} $\\{scaling\_down}\K\R\\{v\_is%
+\_scaled}$;\2\6
+\&{if} $\\{t1}=\\{dependent}$ \1\&{then}\5
+$\\{threshold}\K\\{half\_fraction\_threshold}$\6
+\4\&{else} $\\{threshold}\K\\{half\_scaled\_threshold}$;\2\6
+$\|r\K\\{temp\_head}$;\6
+\&{while} $\\{info}(\|p)\I\\{null}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{scaling\_down}$ \1\&{then}\5
+$\|w\K\\{take\_fraction}(\|v,\39\\{value}(\|p))$\6
+\4\&{else} $\|w\K\\{take\_scaled}(\|v,\39\\{value}(\|p))$;\2\6
+\&{if} $\\{abs}(\|w)\L\\{threshold}$ \1\&{then}\6
+\&{begin} \37$\|s\K\\{link}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{dep\_node\_size})$;\5
+$\|p\K\|s$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{abs}(\|w)\G\\{coef\_bound}$ \1\&{then}\6
+\&{begin} \37$\\{fix\_needed}\K\\{true}$;\5
+$\\{type}(\\{info}(\|p))\K\\{independent\_needing\_fix}$;\6
+\&{end};\2\6
+$\\{link}(\|r)\K\|p$;\5
+$\|r\K\|p$;\5
+$\\{value}(\|p)\K\|w$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\\{link}(\|r)\K\|p$;\6
+\&{if} $\\{v\_is\_scaled}$ \1\&{then}\5
+$\\{value}(\|p)\K\\{take\_scaled}(\\{value}(\|p),\39\|v)$\6
+\4\&{else} $\\{value}(\|p)\K\\{take\_fraction}(\\{value}(\|p),\39\|v)$;\2\6
+$\\{p\_times\_v}\K\\{link}(\\{temp\_head})$;\6
+\&{end};\par
+\fi
+
+\M600. Similarly, we sometimes need to divide a dependency list
+by a given \\{scaled} constant.
+
+\Y\P$\4\X594:Declare basic dependency-list subroutines\X\mathrel{+}\S$\6
+\4\&{function}\1\ \37$\\{p\_over\_v}(\|p:\\{pointer};\,\35\|v:\\{scaled};\,\35%
+\\{t0},\39\\{t1}:\\{small\_number})$: \37\\{pointer};\6
+\4\&{var} \37$\|r,\39\|s$: \37\\{pointer};\C{for list manipulation}\6
+\|w: \37\\{integer};\C{tentative coefficient}\6
+\\{threshold}: \37\\{integer};\5
+\\{scaling\_down}: \37\\{boolean};\2\6
+\&{begin} \37\&{if} $\\{t0}\I\\{t1}$ \1\&{then}\5
+$\\{scaling\_down}\K\\{true}$\ \&{else} $\\{scaling\_down}\K\\{false}$;\2\6
+\&{if} $\\{t1}=\\{dependent}$ \1\&{then}\5
+$\\{threshold}\K\\{half\_fraction\_threshold}$\6
+\4\&{else} $\\{threshold}\K\\{half\_scaled\_threshold}$;\2\6
+$\|r\K\\{temp\_head}$;\6
+\&{while} $\\{info}(\|p)\I\\{null}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{scaling\_down}$ \1\&{then}\6
+\&{if} $\\{abs}(\|v)<\O{2000000}$ \1\&{then}\5
+$\|w\K\\{make\_scaled}(\\{value}(\|p),\39\|v\ast\O{10000})$\6
+\4\&{else} $\|w\K\\{make\_scaled}(\\{round\_fraction}(\\{value}(\|p)),\39\|v)$%
+\2\6
+\4\&{else} $\|w\K\\{make\_scaled}(\\{value}(\|p),\39\|v)$;\2\6
+\&{if} $\\{abs}(\|w)\L\\{threshold}$ \1\&{then}\6
+\&{begin} \37$\|s\K\\{link}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{dep\_node\_size})$;\5
+$\|p\K\|s$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{abs}(\|w)\G\\{coef\_bound}$ \1\&{then}\6
+\&{begin} \37$\\{fix\_needed}\K\\{true}$;\5
+$\\{type}(\\{info}(\|p))\K\\{independent\_needing\_fix}$;\6
+\&{end};\2\6
+$\\{link}(\|r)\K\|p$;\5
+$\|r\K\|p$;\5
+$\\{value}(\|p)\K\|w$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\\{link}(\|r)\K\|p$;\5
+$\\{value}(\|p)\K\\{make\_scaled}(\\{value}(\|p),\39\|v)$;\5
+$\\{p\_over\_v}\K\\{link}(\\{temp\_head})$;\6
+\&{end};\par
+\fi
+
+\M601. Here's another utility routine for dependency lists. When an independent
+variable becomes dependent, we want to remove it from all existing
+dependencies. The \\{p\_with\_x\_becoming\_q} function computes the
+dependency list of~\|p after variable~\|x has been replaced by~\|q.
+
+This procedure has basically the same calling conventions as \\{p\_plus\_fq}:
+List~\|q is unchanged; list~\|p is destroyed; the constant node and the
+final link are inherited from~\|p; and the fourth parameter tells whether
+or not \|p is \\{proto\_dependent}. However, the global variable \\{dep\_final}
+is not altered if \|x does not occur in list~\|p.
+
+\Y\P\4\&{function}\1\ \37$\\{p\_with\_x\_becoming\_q}(\|p,\39\|x,\39\|q:%
+\\{pointer};\,\35\|t:\\{small\_number})$: \37\\{pointer};\6
+\4\&{var} \37$\|r,\39\|s$: \37\\{pointer};\C{for list manipulation}\6
+\|v: \37\\{integer};\C{coefficient of \|x}\6
+\\{sx}: \37\\{integer};\C{serial number of \|x}\2\6
+\&{begin} \37$\|s\K\|p$;\5
+$\|r\K\\{temp\_head}$;\5
+$\\{sx}\K\\{value}(\|x)$;\6
+\&{while} $\\{value}(\\{info}(\|s))>\\{sx}$ \1\&{do}\6
+\&{begin} \37$\|r\K\|s$;\5
+$\|s\K\\{link}(\|s)$;\6
+\&{end};\2\6
+\&{if} $\\{info}(\|s)\I\|x$ \1\&{then}\5
+$\\{p\_with\_x\_becoming\_q}\K\|p$\6
+\4\&{else} \&{begin} \37$\\{link}(\\{temp\_head})\K\|p$;\5
+$\\{link}(\|r)\K\\{link}(\|s)$;\5
+$\|v\K\\{value}(\|s)$;\5
+$\\{free\_node}(\|s,\39\\{dep\_node\_size})$;\5
+$\\{p\_with\_x\_becoming\_q}\K\\{p\_plus\_fq}(\\{link}(\\{temp\_head}),\39\|v,%
+\39\|q,\39\|t,\39\\{dependent})$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M602. Here's a simple procedure that reports an error when a variable
+has just received a known value that's out of the required range.
+
+\Y\P$\4\X594:Declare basic dependency-list subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{val\_too\_big}(\|x:\\{scaled})$;\2\6
+\&{begin} \37\&{if} $\\{internal}[\\{warning\_check}]>0$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Value\ is\ too\ large\ ("})$;\5
+$\\{print\_scaled}(\|x)$;\5
+$\\{print\_char}(\.{")"})$;\5
+$\\{help4}(\.{"The\ equation\ I\ just\ processed\ has\ given\ some\
+variable"})$\6
+$(\.{"a\ value\ of\ 4096\ or\ more.\ Continue\ and\ I\'ll\ try\ to\ cope"})$\6
+$(\.{"with\ that\ big\ value;\ but\ it\ might\ be\ dangerous."})$\6
+$(\.{"(Set\ warningcheck:=0\ to\ suppress\ this\ message.)"})$;\5
+\\{error};\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M603. When a dependent variable becomes known, the following routine
+removes its dependency list. Here \|p points to the variable, and
+\|q points to the dependency list (which is one node long).
+
+\Y\P$\4\X594:Declare basic dependency-list subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{make\_known}(\|p,\39\|q:\\{pointer})$;\6
+\4\&{var} \37\|t: \37$\\{dependent}\to\\{proto\_dependent}$;\C{the previous
+type}\2\6
+\&{begin} \37$\\{prev\_dep}(\\{link}(\|q))\K\\{prev\_dep}(\|p)$;\5
+$\\{link}(\\{prev\_dep}(\|p))\K\\{link}(\|q)$;\5
+$\|t\K\\{type}(\|p)$;\5
+$\\{type}(\|p)\K\\{known}$;\5
+$\\{value}(\|p)\K\\{value}(\|q)$;\5
+$\\{free\_node}(\|q,\39\\{dep\_node\_size})$;\6
+\&{if} $\\{abs}(\\{value}(\|p))\G\\{fraction\_one}$ \1\&{then}\5
+$\\{val\_too\_big}(\\{value}(\|p))$;\2\6
+\&{if} $\\{internal}[\\{tracing\_equations}]>0$ \1\&{then}\6
+\&{if} $\\{interesting}(\|p)$ \1\&{then}\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\#\#\#\#\ "})$;\5
+$\\{print\_variable\_name}(\|p)$;\5
+$\\{print\_char}(\.{"="})$;\5
+$\\{print\_scaled}(\\{value}(\|p))$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end};\2\2\6
+\&{if} $\\{cur\_exp}=\|p$ \1\&{then}\6
+\&{if} $\\{cur\_type}=\|t$ \1\&{then}\6
+\&{begin} \37$\\{cur\_type}\K\\{known}$;\5
+$\\{cur\_exp}\K\\{value}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$;\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M604. The \\{fix\_dependencies} routine is called into action when \\{fix%
+\_needed}
+has been triggered. The program keeps a list~\|s of independent variables
+whose coefficients must be divided by~4.
+
+In unusual cases, this fixup process might reduce one or more coefficients
+to zero, so that a variable will become known more or less by default.
+
+\Y\P$\4\X594:Declare basic dependency-list subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{fix\_dependencies};\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\|s,\39\|t$: \37\\{pointer};\C{list
+manipulation registers}\6
+\|x: \37\\{pointer};\C{an independent variable}\2\6
+\&{begin} \37$\|r\K\\{link}(\\{dep\_head})$;\5
+$\|s\K\\{null}$;\6
+\&{while} $\|r\I\\{dep\_head}$ \1\&{do}\6
+\&{begin} \37$\|t\K\|r$;\5
+\X605:Run through the dependency list for variable \|t, fixing all nodes, and
+ending with final link~\|q\X;\6
+$\|r\K\\{link}(\|q)$;\6
+\&{if} $\|q=\\{dep\_list}(\|t)$ \1\&{then}\5
+$\\{make\_known}(\|t,\39\|q)$;\2\6
+\&{end};\2\6
+\&{while} $\|s\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\|p\K\\{link}(\|s)$;\5
+$\|x\K\\{info}(\|s)$;\5
+$\\{free\_avail}(\|s)$;\5
+$\|s\K\|p$;\5
+$\\{type}(\|x)\K\\{independent}$;\5
+$\\{value}(\|x)\K\\{value}(\|x)+2$;\6
+\&{end};\2\6
+$\\{fix\_needed}\K\\{false}$;\6
+\&{end};\par
+\fi
+
+\M605. \P\D \37$\\{independent\_being\_fixed}=1$\C{this variable already
+appears in \|s}\par
+\Y\P$\4\X605:Run through the dependency list for variable \|t, fixing all
+nodes, and ending with final link~\|q\X\S$\6
+$\|r\K\\{value\_loc}(\|t)$;\C{$\\{link}(\|r)=\\{dep\_list}(\|t)$}\6
+\~ \1\&{loop}\ \&{begin} \37$\|q\K\\{link}(\|r)$;\5
+$\|x\K\\{info}(\|q)$;\6
+\&{if} $\|x=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\\{type}(\|x)\L\\{independent\_being\_fixed}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{type}(\|x)<\\{independent\_being\_fixed}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{get\_avail}$;\5
+$\\{link}(\|p)\K\|s$;\5
+$\|s\K\|p$;\5
+$\\{info}(\|s)\K\|x$;\5
+$\\{type}(\|x)\K\\{independent\_being\_fixed}$;\6
+\&{end};\2\6
+$\\{value}(\|q)\K\\{value}(\|q)\mathbin{\&{div}}4$;\6
+\&{if} $\\{value}(\|q)=0$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|r)\K\\{link}(\|q)$;\5
+$\\{free\_node}(\|q,\39\\{dep\_node\_size})$;\5
+$\|q\K\|r$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\|r\K\|q$;\6
+\&{end};\2\6
+\4\\{done}: \37\par
+\U604.\fi
+
+\M606. The \\{new\_dep} routine installs a dependency list~\|p into the value
+node~\|q,
+linking it into the list of all known dependencies. We assume that
+\\{dep\_final} points to the final node of list~\|p.
+
+\Y\P\4\&{procedure}\1\ \37$\\{new\_dep}(\|q,\39\|p:\\{pointer})$;\6
+\4\&{var} \37\|r: \37\\{pointer};\C{what used to be the first dependency}\2\6
+\&{begin} \37$\\{dep\_list}(\|q)\K\|p$;\5
+$\\{prev\_dep}(\|q)\K\\{dep\_head}$;\5
+$\|r\K\\{link}(\\{dep\_head})$;\5
+$\\{link}(\\{dep\_final})\K\|r$;\5
+$\\{prev\_dep}(\|r)\K\\{dep\_final}$;\5
+$\\{link}(\\{dep\_head})\K\|q$;\6
+\&{end};\par
+\fi
+
+\M607. Here is one of the ways a dependency list gets started.
+The \\{const\_dependency} routine produces a list that has nothing but
+a constant term.
+
+\Y\P\4\&{function}\1\ \37$\\{const\_dependency}(\|v:\\{scaled})$: \37%
+\\{pointer};\2\6
+\&{begin} \37$\\{dep\_final}\K\\{get\_node}(\\{dep\_node\_size})$;\5
+$\\{value}(\\{dep\_final})\K\|v$;\5
+$\\{info}(\\{dep\_final})\K\\{null}$;\5
+$\\{const\_dependency}\K\\{dep\_final}$;\6
+\&{end};\par
+\fi
+
+\M608. And here's a more interesting way to start a dependency list from
+scratch:
+The parameter to \\{single\_dependency} is the location of an
+independent variable~\|x, and the result is the simple dependency list
+`$\|x+0$'.
+
+In the unlikely event that the given independent variable has been doubled so
+often that we can't refer to it with a nonzero coefficient,
+\\{single\_dependency} returns the simple list `0'. This case can be
+recognized by testing that the returned list pointer is equal to
+\\{dep\_final}.
+
+\Y\P\4\&{function}\1\ \37$\\{single\_dependency}(\|p:\\{pointer})$: \37%
+\\{pointer};\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the new dependency list}\6
+\|m: \37\\{integer};\C{the number of doublings}\2\6
+\&{begin} \37$\|m\K\\{value}(\|p)\mathbin{\&{mod}}\\{s\_scale}$;\6
+\&{if} $\|m>28$ \1\&{then}\5
+$\\{single\_dependency}\K\\{const\_dependency}(0)$\6
+\4\&{else} \&{begin} \37$\|q\K\\{get\_node}(\\{dep\_node\_size})$;\5
+$\\{value}(\|q)\K\\{two\_to\_the}[28-\|m]$;\5
+$\\{info}(\|q)\K\|p$;\6
+$\\{link}(\|q)\K\\{const\_dependency}(0)$;\5
+$\\{single\_dependency}\K\|q$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M609. We sometimes need to make an exact copy of a dependency list.
+
+\Y\P\4\&{function}\1\ \37$\\{copy\_dep\_list}(\|p:\\{pointer})$: \37%
+\\{pointer};\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the new dependency list}\2\6
+\&{begin} \37$\|q\K\\{get\_node}(\\{dep\_node\_size})$;\5
+$\\{dep\_final}\K\|q$;\6
+\~ \1\&{loop}\ \&{begin} \37$\\{info}(\\{dep\_final})\K\\{info}(\|p)$;\5
+$\\{value}(\\{dep\_final})\K\\{value}(\|p)$;\6
+\&{if} $\\{info}(\\{dep\_final})=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{link}(\\{dep\_final})\K\\{get\_node}(\\{dep\_node\_size})$;\5
+$\\{dep\_final}\K\\{link}(\\{dep\_final})$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\4\\{done}: \37$\\{copy\_dep\_list}\K\|q$;\6
+\&{end};\par
+\fi
+
+\M610. But how do variables normally become known? Ah, now we get to the heart
+of the
+equation-solving mechanism. The \\{linear\_eq} procedure is given a %
+\\{dependent}
+or \\{proto\_dependent} list,~\|p, in which at least one independent variable
+appears. It equates this list to zero, by choosing an independent variable
+with the largest coefficient and making it dependent on the others. The
+newly dependent variable is eliminated from all current dependencies,
+thereby possibly making other dependent variables known.
+
+The given list \|p is, of course, totally destroyed by all this processing.
+
+\Y\P\4\&{procedure}\1\ \37$\\{linear\_eq}(\|p:\\{pointer};\,\35\|t:\\{small%
+\_number})$;\6
+\4\&{var} \37$\|q,\39\|r,\39\|s$: \37\\{pointer};\C{for link manipulation}\6
+\|x: \37\\{pointer};\C{the variable that loses its independence}\6
+\|n: \37\\{integer};\C{the number of times \|x had been halved}\6
+\|v: \37\\{integer};\C{the coefficient of \|x in list \|p}\6
+\\{prev\_r}: \37\\{pointer};\C{lags one step behind \|r}\6
+\\{final\_node}: \37\\{pointer};\C{the constant term of the new dependency
+list}\6
+\|w: \37\\{integer};\C{a tentative coefficient}\2\6
+\&{begin} \37\X611:Find a node \|q in list \|p whose coefficient \|v is largest%
+\X;\6
+$\|x\K\\{info}(\|q)$;\5
+$\|n\K\\{value}(\|x)\mathbin{\&{mod}}\\{s\_scale}$;\6
+\X612:Divide list \|p by $-\|v$, removing node \|q\X;\6
+\&{if} $\\{internal}[\\{tracing\_equations}]>0$ \1\&{then}\5
+\X613:Display the new dependency\X;\2\6
+\X614:Simplify all existing dependencies by substituting for \|x\X;\6
+\X615:Change variable \|x from \\{independent} to \\{dependent} or \\{known}\X;%
+\6
+\&{if} $\\{fix\_needed}$ \1\&{then}\5
+\\{fix\_dependencies};\2\6
+\&{end};\par
+\fi
+
+\M611. \P$\X611:Find a node \|q in list \|p whose coefficient \|v is largest\X%
+\S$\6
+$\|q\K\|p$;\5
+$\|r\K\\{link}(\|p)$;\5
+$\|v\K\\{value}(\|q)$;\6
+\&{while} $\\{info}(\|r)\I\\{null}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{abs}(\\{value}(\|r))>\\{abs}(\|v)$ \1\&{then}\6
+\&{begin} \37$\|q\K\|r$;\5
+$\|v\K\\{value}(\|r)$;\6
+\&{end};\2\6
+$\|r\K\\{link}(\|r)$;\6
+\&{end}\2\par
+\U610.\fi
+
+\M612. Here we want to change the coefficients from \\{scaled} to \\{fraction},
+except in the constant term. In the common case of a trivial equation
+like `\.{x=3.14}', we will have $\|v=-\\{fraction\_one}$, $\|q=\|p$, and $\|t=%
+\\{dependent}$.
+
+\Y\P$\4\X612:Divide list \|p by $-\|v$, removing node \|q\X\S$\6
+$\|s\K\\{temp\_head}$;\5
+$\\{link}(\|s)\K\|p$;\5
+$\|r\K\|p$;\6
+\1\&{repeat} \37\&{if} $\|r=\|q$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|s)\K\\{link}(\|r)$;\5
+$\\{free\_node}(\|r,\39\\{dep\_node\_size})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|w\K\\{make\_fraction}(\\{value}(\|r),\39\|v)$;\6
+\&{if} $\\{abs}(\|w)\L\\{half\_fraction\_threshold}$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|s)\K\\{link}(\|r)$;\5
+$\\{free\_node}(\|r,\39\\{dep\_node\_size})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{value}(\|r)\K-\|w$;\5
+$\|s\K\|r$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\|r\K\\{link}(\|s)$;\6
+\4\&{until}\5
+$\\{info}(\|r)=\\{null}$;\2\6
+\&{if} $\|t=\\{proto\_dependent}$ \1\&{then}\5
+$\\{value}(\|r)\K-\\{make\_scaled}(\\{value}(\|r),\39\|v)$\6
+\4\&{else} \&{if} $\|v\I-\\{fraction\_one}$ \1\&{then}\5
+$\\{value}(\|r)\K-\\{make\_fraction}(\\{value}(\|r),\39\|v)$;\2\2\6
+$\\{final\_node}\K\|r$;\5
+$\|p\K\\{link}(\\{temp\_head})$\par
+\U610.\fi
+
+\M613. \P$\X613:Display the new dependency\X\S$\6
+\&{if} $\\{interesting}(\|x)$ \1\&{then}\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\#\#\ "})$;\5
+$\\{print\_variable\_name}(\|x)$;\5
+$\|w\K\|n$;\6
+\&{while} $\|w>0$ \1\&{do}\6
+\&{begin} \37$\\{print}(\.{"*4"})$;\5
+$\|w\K\|w-2$;\6
+\&{end};\2\6
+$\\{print\_char}(\.{"="})$;\5
+$\\{print\_dependency}(\|p,\39\\{dependent})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\2\par
+\U610.\fi
+
+\M614. \P$\X614:Simplify all existing dependencies by substituting for \|x\X\S$%
+\6
+$\\{prev\_r}\K\\{dep\_head}$;\5
+$\|r\K\\{link}(\\{dep\_head})$;\6
+\&{while} $\|r\I\\{dep\_head}$ \1\&{do}\6
+\&{begin} \37$\|s\K\\{dep\_list}(\|r)$;\5
+$\|q\K\\{p\_with\_x\_becoming\_q}(\|s,\39\|x,\39\|p,\39\\{type}(\|r))$;\6
+\&{if} $\\{info}(\|q)=\\{null}$ \1\&{then}\5
+$\\{make\_known}(\|r,\39\|q)$\6
+\4\&{else} \&{begin} \37$\\{dep\_list}(\|r)\K\|q$;\6
+\1\&{repeat} \37$\|q\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\\{info}(\|q)=\\{null}$;\2\6
+$\\{prev\_r}\K\|q$;\6
+\&{end};\2\6
+$\|r\K\\{link}(\\{prev\_r})$;\6
+\&{end}\2\par
+\U610.\fi
+
+\M615. \P$\X615:Change variable \|x from \\{independent} to \\{dependent} or %
+\\{known}\X\S$\6
+\&{if} $\|n>0$ \1\&{then}\5
+\X616:Divide list \|p by $2^n$\X;\2\6
+\&{if} $\\{info}(\|p)=\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{type}(\|x)\K\\{known}$;\5
+$\\{value}(\|x)\K\\{value}(\|p)$;\6
+\&{if} $\\{abs}(\\{value}(\|x))\G\\{fraction\_one}$ \1\&{then}\5
+$\\{val\_too\_big}(\\{value}(\|x))$;\2\6
+$\\{free\_node}(\|p,\39\\{dep\_node\_size})$;\6
+\&{if} $\\{cur\_exp}=\|x$ \1\&{then}\6
+\&{if} $\\{cur\_type}=\\{independent}$ \1\&{then}\6
+\&{begin} \37$\\{cur\_exp}\K\\{value}(\|x)$;\5
+$\\{cur\_type}\K\\{known}$;\5
+$\\{free\_node}(\|x,\39\\{value\_node\_size})$;\6
+\&{end};\2\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{type}(\|x)\K\\{dependent}$;\5
+$\\{dep\_final}\K\\{final\_node}$;\5
+$\\{new\_dep}(\|x,\39\|p)$;\6
+\&{if} $\\{cur\_exp}=\|x$ \1\&{then}\6
+\&{if} $\\{cur\_type}=\\{independent}$ \1\&{then}\5
+$\\{cur\_type}\K\\{dependent}$;\2\2\6
+\&{end}\2\par
+\U610.\fi
+
+\M616. \P$\X616:Divide list \|p by $2^n$\X\S$\6
+\&{begin} \37$\|s\K\\{temp\_head}$;\5
+$\\{link}(\\{temp\_head})\K\|p$;\5
+$\|r\K\|p$;\6
+\1\&{repeat} \37\&{if} $\|n>30$ \1\&{then}\5
+$\|w\K0$\6
+\4\&{else} $\|w\K\\{value}(\|r)\mathbin{\&{div}}\\{two\_to\_the}[\|n]$;\2\6
+\&{if} $(\\{abs}(\|w)\L\\{half\_fraction\_threshold})\W(\\{info}(\|r)\I%
+\\{null})$ \1\&{then}\6
+\&{begin} \37$\\{link}(\|s)\K\\{link}(\|r)$;\5
+$\\{free\_node}(\|r,\39\\{dep\_node\_size})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{value}(\|r)\K\|w$;\5
+$\|s\K\|r$;\6
+\&{end};\2\6
+$\|r\K\\{link}(\|s)$;\6
+\4\&{until}\5
+$\\{info}(\|s)=\\{null}$;\2\6
+$\|p\K\\{link}(\\{temp\_head})$;\6
+\&{end}\par
+\U615.\fi
+
+\M617. The \\{check\_mem} procedure, which is used only when \MF\ is being
+debugged, makes sure that the current dependency lists are well formed.
+
+\Y\P$\4\X617:Check the list of linear dependencies\X\S$\6
+$\|q\K\\{dep\_head}$;\5
+$\|p\K\\{link}(\|q)$;\6
+\&{while} $\|p\I\\{dep\_head}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{prev\_dep}(\|p)\I\|q$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"Bad\ PREVDEP\ at\ "})$;\5
+$\\{print\_int}(\|p)$;\6
+\&{end};\2\6
+$\|p\K\\{dep\_list}(\|p)$;\5
+$\|r\K\\{inf\_val}$;\6
+\1\&{repeat} \37\&{if} $\\{value}(\\{info}(\|p))\G\\{value}(\|r)$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"Out\ of\ order\ at\ "})$;\5
+$\\{print\_int}(\|p)$;\6
+\&{end};\2\6
+$\|r\K\\{info}(\|p)$;\5
+$\|q\K\|p$;\5
+$\|p\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\|r=\\{null}$;\2\6
+\&{end}\2\par
+\U180.\fi
+
+\N618. \[29] Dynamic nonlinear equations.
+Variables of numeric type are maintained by the general scheme of
+independent, dependent, and known values that we have just studied;
+and the components of pair and transform variables are handled in the
+same way. But \MF\ also has five other types of values: \&{boolean},
+\&{string}, \&{pen}, \&{path}, and \&{picture}; what about them?
+
+Equations are allowed between nonlinear quantities, but only in a
+simple form. Two variables that haven't yet been assigned values are
+either equal to each other, or they're not.
+
+Before a boolean variable has received a value, its type is \\{unknown%
+\_boolean};
+similarly, there are variables whose type is \\{unknown\_string}, \\{unknown%
+\_pen},
+\\{unknown\_path}, and \\{unknown\_picture}. In such cases the value is either
+\\{null} (which means that no other variables are equivalent to this one), or
+it points to another variable of the same undefined type. The pointers in the
+latter case form a cycle of nodes, which we shall call a ``ring.''
+Rings of undefined variables may include capsules, which arise as
+intermediate results within expressions or as \&{expr} parameters to macros.
+
+When one member of a ring receives a value, the same value is given to
+all the other members. In the case of paths and pictures, this implies
+making separate copies of a potentially large data structure; users should
+restrain their enthusiasm for such generality, unless they have lots and
+lots of memory space.
+
+\fi
+
+\M619. The following procedure is called when a capsule node is being
+added to a ring (e.g., when an unknown variable is mentioned in an expression).
+
+\Y\P\4\&{function}\1\ \37$\\{new\_ring\_entry}(\|p:\\{pointer})$: \37%
+\\{pointer};\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the new capsule node}\2\6
+\&{begin} \37$\|q\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{name\_type}(\|q)\K\\{capsule}$;\5
+$\\{type}(\|q)\K\\{type}(\|p)$;\6
+\&{if} $\\{value}(\|p)=\\{null}$ \1\&{then}\5
+$\\{value}(\|q)\K\|p$\ \&{else} $\\{value}(\|q)\K\\{value}(\|p)$;\2\6
+$\\{value}(\|p)\K\|q$;\5
+$\\{new\_ring\_entry}\K\|q$;\6
+\&{end};\par
+\fi
+
+\M620. Conversely, we might delete a capsule or a variable before it becomes
+known.
+The following procedure simply detaches a quantity from its ring,
+without recycling the storage.
+
+\Y\P$\4\X268:Declare the recycling subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{ring\_delete}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\2\6
+\&{begin} \37$\|q\K\\{value}(\|p)$;\6
+\&{if} $\|q\I\\{null}$ \1\&{then}\6
+\&{if} $\|q\I\|p$ \1\&{then}\6
+\&{begin} \37\&{while} $\\{value}(\|q)\I\|p$ \1\&{do}\5
+$\|q\K\\{value}(\|q)$;\2\6
+$\\{value}(\|q)\K\\{value}(\|p)$;\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M621. Eventually there might be an equation that assigns values to all of the
+variables in a ring. The \\{nonlinear\_eq} subroutine does the necessary
+propagation of values.
+
+If the parameter \\{flush\_p} is \\{true}, node \|p itself needn't receive a
+value; it will soon be recycled.
+
+\Y\P\4\&{procedure}\1\ \37$\\{nonlinear\_eq}(\|v:\\{integer};\,\35\|p:%
+\\{pointer};\,\35\\{flush\_p}:\\{boolean})$;\6
+\4\&{var} \37\|t: \37\\{small\_number};\C{the type of ring \|p}\6
+$\|q,\39\|r$: \37\\{pointer};\C{link manipulation registers}\2\6
+\&{begin} \37$\|t\K\\{type}(\|p)-\\{unknown\_tag}$;\5
+$\|q\K\\{value}(\|p)$;\6
+\&{if} $\\{flush\_p}$ \1\&{then}\5
+$\\{type}(\|p)\K\\{vacuous}$\ \&{else} $\|p\K\|q$;\2\6
+\1\&{repeat} \37$\|r\K\\{value}(\|q)$;\5
+$\\{type}(\|q)\K\|t$;\6
+\&{case} $\|t$ \1\&{of}\6
+\4\\{boolean\_type}: \37$\\{value}(\|q)\K\|v$;\6
+\4\\{string\_type}: \37\&{begin} \37$\\{value}(\|q)\K\|v$;\5
+$\\{add\_str\_ref}(\|v)$;\6
+\&{end};\6
+\4\\{pen\_type}: \37\&{begin} \37$\\{value}(\|q)\K\|v$;\5
+$\\{add\_pen\_ref}(\|v)$;\6
+\&{end};\6
+\4\\{path\_type}: \37$\\{value}(\|q)\K\\{copy\_path}(\|v)$;\6
+\4\\{picture\_type}: \37$\\{value}(\|q)\K\\{copy\_edges}(\|v)$;\2\6
+\&{end};\C{there ain't no more cases}\6
+$\|q\K\|r$;\6
+\4\&{until}\5
+$\|q=\|p$;\2\6
+\&{end};\par
+\fi
+
+\M622. If two members of rings are equated, and if they have the same type,
+the \\{ring\_merge} procedure is called on to make them equivalent.
+
+\Y\P\4\&{procedure}\1\ \37$\\{ring\_merge}(\|p,\39\|q:\\{pointer})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|r: \37\\{pointer};\C{traverses one list}\2\6
+\&{begin} \37$\|r\K\\{value}(\|p)$;\6
+\&{while} $\|r\I\|p$ \1\&{do}\6
+\&{begin} \37\&{if} $\|r=\|q$ \1\&{then}\6
+\&{begin} \37\X623:Exclaim about a redundant equation\X;\6
+\&{return};\6
+\&{end};\2\6
+$\|r\K\\{value}(\|r)$;\6
+\&{end};\2\6
+$\|r\K\\{value}(\|p)$;\5
+$\\{value}(\|p)\K\\{value}(\|q)$;\5
+$\\{value}(\|q)\K\|r$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M623. \P$\X623:Exclaim about a redundant equation\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Redundant\ equation"})$;\6
+$\\{help2}(\.{"I\ already\ knew\ that\ this\ equation\ was\ true."})$\6
+$(\.{"But\ perhaps\ no\ harm\ has\ been\ done;\ let\'s\ continue."})$;\6
+\\{put\_get\_error};\6
+\&{end}\par
+\Us622, 1004\ETs1008.\fi
+
+\N624. \[30] Introduction to the syntactic routines.
+Let's pause a moment now and try to look at the Big Picture.
+The \MF\ program consists of three main parts: syntactic routines,
+semantic routines, and output routines. The chief purpose of the
+syntactic routines is to deliver the user's input to the semantic routines,
+while parsing expressions and locating operators and operands. The
+semantic routines act as an interpreter responding to these operators,
+which may be regarded as commands. And the output routines are
+periodically called on to produce compact font descriptions that can be
+used for typesetting or for making interim proof drawings. We have
+discussed the basic data structures and many of the details of semantic
+operations, so we are good and ready to plunge into the part of \MF\ that
+actually controls the activities.
+
+Our current goal is to come to grips with the \\{get\_next} procedure,
+which is the keystone of \MF's input mechanism. Each call of \\{get\_next}
+sets the value of three variables \\{cur\_cmd}, \\{cur\_mod}, and \\{cur\_sym},
+representing the next input token.
+$$\vbox{\halign{#\hfil\cr
+\hbox{\\{cur\_cmd} denotes a command code from the long list of codes
+given earlier;}\cr
+\hbox{\\{cur\_mod} denotes a modifier of the command code;}\cr
+\hbox{\\{cur\_sym} is the hash address of the symbolic token that was
+just scanned,}\cr
+\hbox{\qquad or zero in the case of a numeric or string
+or capsule token.}\cr}}$$
+Underlying this external behavior of \\{get\_next} is all the machinery
+necessary to convert from character files to tokens. At a given time we
+may be only partially finished with the reading of several files (for
+which \&{input} was specified), and partially finished with the expansion
+of some user-defined macros and/or some macro parameters, and partially
+finished reading some text that the user has inserted online,
+and so on. When reading a character file, the characters must be
+converted to tokens; comments and blank spaces must
+be removed, numeric and string tokens must be evaluated.
+
+To handle these situations, which might all be present simultaneously,
+\MF\ uses various stacks that hold information about the incomplete
+activities, and there is a finite state control for each level of the
+input mechanism. These stacks record the current state of an implicitly
+recursive process, but the \\{get\_next} procedure is not recursive.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{cur\_cmd}: \37\\{eight\_bits};\C{current command set by \\{get\_next}}\6
+\4\\{cur\_mod}: \37\\{integer};\C{operand of current command}\6
+\4\\{cur\_sym}: \37\\{halfword};\C{hash address of current symbol}\par
+\fi
+
+\M625. The \\{print\_cmd\_mod} routine prints a symbolic interpretation of a
+command code and its modifier.
+It consists of a rather tedious sequence of print
+commands, and most of it is essentially an inverse to the \\{primitive}
+routine that enters a \MF\ primitive into \\{hash} and \\{eqtb}. Therefore
+almost
+all of this procedure appears elsewhere in the program, together with the
+corresponding \\{primitive} calls.
+
+\Y\P$\4\X625:Declare the procedure called \\{print\_cmd\_mod}\X\S$\6
+\4\&{procedure}\1\ \37$\\{print\_cmd\_mod}(\|c,\39\|m:\\{integer})$;\2\6
+\&{begin} \37\&{case} $\|c$ \1\&{of}\6
+\hbox{\4}\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of primitives%
+\X\6
+\4\&{othercases} \37$\\{print}(\.{"[unknown\ command\ code!]"})$\2\6
+\&{endcases};\6
+\&{end};\par
+\U227.\fi
+
+\M626. Here is a procedure that displays a given command in braces, in the
+user's transcript file.
+
+\Y\P\D \37$\\{show\_cur\_cmd\_mod}\S\\{show\_cmd\_mod}(\\{cur\_cmd},\39\\{cur%
+\_mod})$\par
+\Y\P\4\&{procedure}\1\ \37$\\{show\_cmd\_mod}(\|c,\39\|m:\\{integer})$;\2\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\{"})$;\5
+$\\{print\_cmd\_mod}(\|c,\39\|m)$;\5
+$\\{print\_char}(\.{"\}"})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end};\par
+\fi
+
+\N627. \[31] Input stacks and states.
+The state of \MF's input mechanism appears in the input stack, whose
+entries are records with five fields, called \\{index}, \\{start}, \\{loc},
+\\{limit}, and \\{name}. The top element of this stack is maintained in a
+global variable for which no subscripting needs to be done; the other
+elements of the stack appear in an array. Hence the stack is declared thus:
+
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{in\_state\_record}=$\1\5
+\1\&{record} \37\\{index\_field}: \37\\{quarterword};\6
+\4$\\{start\_field},\39\\{loc\_field},\39\\{limit\_field},\39\\{name\_field}$: %
+\37\\{halfword};\2\6
+\&{end};\2\par
+\fi
+
+\M628. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{input\_stack}: \37\&{array} $[0\to\\{stack\_size}]$ \1\&{of}\5
+\\{in\_state\_record};\2\6
+\4\\{input\_ptr}: \37$0\to\\{stack\_size}$;\C{first unused location of \\{input%
+\_stack}}\6
+\4\\{max\_in\_stack}: \37$0\to\\{stack\_size}$;\C{largest value of \\{input%
+\_ptr} when pushing}\6
+\4\\{cur\_input}: \37\\{in\_state\_record};\C{the ``top'' input state}\par
+\fi
+
+\M629. We've already defined the special variable $\\{loc}\S\\{cur\_input}.%
+\\{loc\_field}$
+in our discussion of basic input-output routines. The other components of
+\\{cur\_input} are defined in the same way:
+
+\Y\P\D \37$\\{index}\S\\{cur\_input}.\\{index\_field}$\C{reference for buffer
+information}\par
+\P\D \37$\\{start}\S\\{cur\_input}.\\{start\_field}$\C{starting position in %
+\\{buffer}}\par
+\P\D \37$\\{limit}\S\\{cur\_input}.\\{limit\_field}$\C{end of current line in %
+\\{buffer}}\par
+\P\D \37$\\{name}\S\\{cur\_input}.\\{name\_field}$\C{name of the current file}%
+\par
+\fi
+
+\M630. Let's look more closely now at the five control variables
+(\\{index},~\\{start},~\\{loc},~\\{limit},~\\{name}),
+assuming that \MF\ is reading a line of characters that have been input
+from some file or from the user's terminal. There is an array called
+\\{buffer} that acts as a stack of all lines of characters that are
+currently being read from files, including all lines on subsidiary
+levels of the input stack that are not yet completed. \MF\ will return to
+the other lines when it is finished with the present input file.
+
+(Incidentally, on a machine with byte-oriented addressing, it would be
+appropriate to combine \\{buffer} with the \\{str\_pool} array,
+letting the buffer entries grow downward from the top of the string pool
+and checking that these two tables don't bump into each other.)
+
+The line we are currently working on begins in position \\{start} of the
+buffer; the next character we are about to read is $\\{buffer}[\\{loc}]$; and
+\\{limit} is the location of the last character present. We always have
+$\\{loc}\L\\{limit}$. For convenience, $\\{buffer}[\\{limit}]$ has been set to %
+\.{"\%"}, so
+that the end of a line is easily sensed.
+
+The \\{name} variable is a string number that designates the name of
+the current file, if we are reading a text file. It is 0 if we
+are reading from the terminal for normal input, or 1 if we are executing a
+\&{readstring} command, or 2 if we are reading a string that was
+moved into the buffer by \&{scantokens}.
+
+\fi
+
+\M631. Additional information about the current line is available via the
+\\{index} variable, which counts how many lines of characters are present
+in the buffer below the current level. We have $\\{index}=0$ when reading
+from the terminal and prompting the user for each line; then if the user types,
+e.g., `\.{input font}', we will have $\\{index}=1$ while reading
+the file \.{font.mf}. However, it does not follow that \\{index} is the
+same as the input stack pointer, since many of the levels on the input
+stack may come from token lists.
+
+The global variable \\{in\_open} is equal to the \\{index}
+value of the highest non-token-list level. Thus, the number of partially read
+lines in the buffer is $\\{in\_open}+1$, and we have $\\{in\_open}=\\{index}$
+when we are not reading a token list.
+
+If we are not currently reading from the terminal,
+we are reading from the file variable $\\{input\_file}[\\{index}]$. We use
+the notation \\{terminal\_input} as a convenient abbreviation for $\\{name}=0$,
+and \\{cur\_file} as an abbreviation for $\\{input\_file}[\\{index}]$.
+
+The global variable \\{line} contains the line number in the topmost
+open file, for use in error messages. If we are not reading from
+the terminal, $\\{line\_stack}[\\{index}]$ holds the line number for the
+enclosing level, so that \\{line} can be restored when the current
+file has been read.
+
+If more information about the input state is needed, it can be
+included in small arrays like those shown here. For example,
+the current page or segment number in the input file might be
+put into a variable \\{page}, maintained for enclosing levels in
+`\ignorespaces \\{page\_stack}: \&{array} $[1\to\\{max\_in\_open}]$ \&{of} %
+\\{integer}\unskip'
+by analogy with \\{line\_stack}.
+
+\Y\P\D \37$\\{terminal\_input}\S(\\{name}=0)$\C{are we reading from the
+terminal?}\par
+\P\D \37$\\{cur\_file}\S\\{input\_file}[\\{index}]$\C{the current \\{alpha%
+\_file} variable}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{in\_open}: \37$0\to\\{max\_in\_open}$;\C{the number of lines in the
+buffer, less one}\6
+\4\\{open\_parens}: \37$0\to\\{max\_in\_open}$;\C{the number of open text
+files}\6
+\4\\{input\_file}: \37\&{array} $[1\to\\{max\_in\_open}]$ \1\&{of}\5
+\\{alpha\_file};\2\6
+\4\\{line}: \37\\{integer};\C{current line number in the current source file}\6
+\4\\{line\_stack}: \37\&{array} $[1\to\\{max\_in\_open}]$ \1\&{of}\5
+\\{integer};\2\par
+\fi
+
+\M632. However, all this discussion about input state really applies only to
+the
+case that we are inputting from a file. There is another important case,
+namely when we are currently getting input from a token list. In this case
+$\\{index}>\\{max\_in\_open}$, and the conventions about the other state
+variables
+are different:
+
+\yskip\hang\\{loc} is a pointer to the current node in the token list, i.e.,
+the node that will be read next. If $\\{loc}=\\{null}$, the token list has been
+fully read.
+
+\yskip\hang\\{start} points to the first node of the token list; this node
+may or may not contain a reference count, depending on the type of token
+list involved.
+
+\yskip\hang\\{token\_type}, which takes the place of \\{index} in the
+discussion above, is a code number that explains what kind of token list
+is being scanned.
+
+\yskip\hang\\{name} points to the \\{eqtb} address of the control sequence
+being expanded, if the current token list is a macro not defined by
+\&{vardef}. Macros defined by \&{vardef} have $\\{name}=\\{null}$; their name
+can be deduced by looking at their first two parameters.
+
+\yskip\hang\\{param\_start}, which takes the place of \\{limit}, tells where
+the parameters of the current macro or loop text begin in the \\{param\_stack}.
+
+\yskip\noindent The \\{token\_type} can take several values, depending on
+where the current token list came from:
+
+\yskip
+\indent\\{forever\_text}, if the token list being scanned is the body of
+a \&{forever} loop;
+
+\indent\\{loop\_text}, if the token list being scanned is the body of
+a \&{for} or \&{forsuffixes} loop;
+
+\indent\\{parameter}, if a \&{text} or \&{suffix} parameter is being scanned;
+
+\indent\\{backed\_up}, if the token list being scanned has been inserted as
+`to be read again'.
+
+\indent\\{inserted}, if the token list being scanned has been inserted as
+part of error recovery;
+
+\indent\\{macro}, if the expansion of a user-defined symbolic token is being
+scanned.
+
+\yskip\noindent
+The token list begins with a reference count if and only if $\\{token\_type}=%
+\\{macro}$.
+
+\Y\P\D \37$\\{token\_type}\S\\{index}$\C{type of current token list}\par
+\P\D \37$\\{token\_state}\S(\\{index}>\\{max\_in\_open})$\C{are we scanning a
+token list?}\par
+\P\D \37$\\{file\_state}\S(\\{index}\L\\{max\_in\_open})$\C{are we scanning a
+file line?}\par
+\P\D \37$\\{param\_start}\S\\{limit}$\C{base of macro parameters in \\{param%
+\_stack}}\par
+\P\D \37$\\{forever\_text}=\\{max\_in\_open}+1$\C{\\{token\_type} code for loop
+texts}\par
+\P\D \37$\\{loop\_text}=\\{max\_in\_open}+2$\C{\\{token\_type} code for loop
+texts}\par
+\P\D \37$\\{parameter}=\\{max\_in\_open}+3$\C{\\{token\_type} code for
+parameter texts}\par
+\P\D \37$\\{backed\_up}=\\{max\_in\_open}+4$\C{\\{token\_type} code for texts
+to be reread}\par
+\P\D \37$\\{inserted}=\\{max\_in\_open}+5$\C{\\{token\_type} code for inserted
+texts}\par
+\P\D \37$\\{macro}=\\{max\_in\_open}+6$\C{\\{token\_type} code for macro
+replacement texts}\par
+\fi
+
+\M633. The \\{param\_stack} is an auxiliary array used to hold pointers to the
+token
+lists for parameters at the current level and subsidiary levels of input.
+This stack grows at a different rate from the others.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{param\_stack}: \37\&{array} $[0\to\\{param\_size}]$ \1\&{of}\5
+\\{pointer};\C{token list pointers for parameters}\2\6
+\4\\{param\_ptr}: \37$0\to\\{param\_size}$;\C{first unused entry in \\{param%
+\_stack}}\6
+\4\\{max\_param\_stack}: \37\\{integer};\C{largest value of \\{param\_ptr}}\par
+\fi
+
+\M634. Thus, the ``current input state'' can be very complicated indeed; there
+can be many levels and each level can arise in a variety of ways. The
+\\{show\_context} procedure, which is used by \MF's error-reporting routine to
+print out the current input state on all levels down to the most recent
+line of characters from an input file, illustrates most of these conventions.
+The global variable \\{file\_ptr} contains the lowest level that was
+displayed by this procedure.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{file\_ptr}: \37$0\to\\{stack\_size}$;\C{shallowest level shown by \\{show%
+\_context}}\par
+\fi
+
+\M635. The status at each level is indicated by printing two lines, where the
+first
+line indicates what was read so far and the second line shows what remains
+to be read. The context is cropped, if necessary, so that the first line
+contains at most \\{half\_error\_line} characters, and the second contains
+at most \\{error\_line}. Non-current input levels whose \\{token\_type} is
+`\\{backed\_up}' are shown only if they have not been fully read.
+
+\Y\P\4\&{procedure}\1\ \37\\{show\_context};\C{prints where the scanner is}\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\\{old\_setting}: \37$0\to\\{max\_selector}$;\C{saved \\{selector}
+setting}\6
+\X641:Local variables for formatting calculations\X\2\6
+\&{begin} \37$\\{file\_ptr}\K\\{input\_ptr}$;\5
+$\\{input\_stack}[\\{file\_ptr}]\K\\{cur\_input}$;\C{store current state}\6
+\~ \1\&{loop}\ \&{begin} \37$\\{cur\_input}\K\\{input\_stack}[\\{file\_ptr}]$;%
+\C{enter into the context}\6
+\X636:Display the current context\X;\6
+\&{if} $\\{file\_state}$ \1\&{then}\6
+\&{if} $(\\{name}>2)\V(\\{file\_ptr}=0)$ \1\&{then}\5
+\&{goto} \37\\{done};\2\2\6
+$\\{decr}(\\{file\_ptr})$;\6
+\&{end};\2\6
+\4\\{done}: \37$\\{cur\_input}\K\\{input\_stack}[\\{input\_ptr}]$;\C{restore
+original state}\6
+\&{end};\par
+\fi
+
+\M636. \P$\X636:Display the current context\X\S$\6
+\&{if} $(\\{file\_ptr}=\\{input\_ptr})\V\\{file\_state}\V(\\{token\_type}\I%
+\\{backed\_up})\V(\\{loc}\I\\{null})$ \1\&{then}\C{we omit backed-up token
+lists that have already been read}\6
+\&{begin} \37$\\{tally}\K0$;\C{get ready to count characters}\6
+$\\{old\_setting}\K\\{selector}$;\6
+\&{if} $\\{file\_state}$ \1\&{then}\6
+\&{begin} \37\X637:Print location of current line\X;\6
+\X644:Pseudoprint the line\X;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\X638:Print type of token list\X;\6
+\X645:Pseudoprint the token list\X;\6
+\&{end};\2\6
+$\\{selector}\K\\{old\_setting}$;\C{stop pseudoprinting}\6
+\X643:Print two lines using the tricky pseudoprinted information\X;\6
+\&{end}\2\par
+\U635.\fi
+
+\M637. This routine should be changed, if necessary, to give the best possible
+indication of where the current line resides in the input file.
+For example, on some systems it is best to print both a page and line number.
+
+\Y\P$\4\X637:Print location of current line\X\S$\6
+\&{if} $\\{name}\L1$ \1\&{then}\6
+\&{if} $\\{terminal\_input}\W(\\{file\_ptr}=0)$ \1\&{then}\5
+$\\{print\_nl}(\.{"<*>"})$\6
+\4\&{else} $\\{print\_nl}(\.{"<insert>"})$\2\6
+\4\&{else} \&{if} $\\{name}=2$ \1\&{then}\5
+$\\{print\_nl}(\.{"<scantokens>"})$\6
+\4\&{else} \&{begin} \37$\\{print\_nl}(\.{"l."})$;\5
+$\\{print\_int}(\\{line})$;\6
+\&{end};\2\2\6
+$\\{print\_char}(\.{"\ "})$\par
+\U636.\fi
+
+\M638. \P$\X638:Print type of token list\X\S$\6
+\&{case} $\\{token\_type}$ \1\&{of}\6
+\4\\{forever\_text}: \37$\\{print\_nl}(\.{"<forever>\ "})$;\6
+\4\\{loop\_text}: \37\X639:Print the current loop value\X;\6
+\4\\{parameter}: \37$\\{print\_nl}(\.{"<argument>\ "})$;\6
+\4\\{backed\_up}: \37\&{if} $\\{loc}=\\{null}$ \1\&{then}\5
+$\\{print\_nl}(\.{"<recently\ read>\ "})$\6
+\4\&{else} $\\{print\_nl}(\.{"<to\ be\ read\ again>\ "})$;\2\6
+\4\\{inserted}: \37$\\{print\_nl}(\.{"<inserted\ text>\ "})$;\6
+\4\\{macro}: \37\&{begin} \37\\{print\_ln};\6
+\&{if} $\\{name}\I\\{null}$ \1\&{then}\5
+$\\{slow\_print}(\\{text}(\\{name}))$\6
+\4\&{else} \X640:Print the name of a \&{vardef}'d macro\X;\2\6
+$\\{print}(\.{"->"})$;\6
+\&{end};\6
+\4\&{othercases} \37$\\{print\_nl}(\.{"?"})$\C{this should never happen}\2\6
+\&{endcases}\par
+\U636.\fi
+
+\M639. The parameter that corresponds to a loop text is either a token list
+(in the case of \&{forsuffixes}) or a ``capsule'' (in the case of \&{for}).
+We'll discuss capsules later; for now, all we need to know is that
+the \\{link} field in a capsule parameter is \\{void} and that
+$\\{print\_exp}(\|p,0)$ displays the value of capsule~\|p in abbreviated form.
+
+\Y\P$\4\X639:Print the current loop value\X\S$\6
+\&{begin} \37$\\{print\_nl}(\.{"<for("})$;\5
+$\|p\K\\{param\_stack}[\\{param\_start}]$;\6
+\&{if} $\|p\I\\{null}$ \1\&{then}\6
+\&{if} $\\{link}(\|p)=\\{void}$ \1\&{then}\5
+$\\{print\_exp}(\|p,\390)$\C{we're in a \&{for} loop}\6
+\4\&{else} $\\{show\_token\_list}(\|p,\39\\{null},\3920,\39\\{tally})$;\2\2\6
+$\\{print}(\.{")>\ "})$;\6
+\&{end}\par
+\U638.\fi
+
+\M640. The first two parameters of a macro defined by \&{vardef} will be token
+lists representing the macro's prefix and ``at point.'' By putting these
+together, we get the macro's full name.
+
+\Y\P$\4\X640:Print the name of a \&{vardef}'d macro\X\S$\6
+\&{begin} \37$\|p\K\\{param\_stack}[\\{param\_start}]$;\6
+\&{if} $\|p=\\{null}$ \1\&{then}\5
+$\\{show\_token\_list}(\\{param\_stack}[\\{param\_start}+1],\39\\{null},\3920,%
+\39\\{tally})$\6
+\4\&{else} \&{begin} \37$\|q\K\|p$;\6
+\&{while} $\\{link}(\|q)\I\\{null}$ \1\&{do}\5
+$\|q\K\\{link}(\|q)$;\2\6
+$\\{link}(\|q)\K\\{param\_stack}[\\{param\_start}+1]$;\5
+$\\{show\_token\_list}(\|p,\39\\{null},\3920,\39\\{tally})$;\5
+$\\{link}(\|q)\K\\{null}$;\6
+\&{end};\2\6
+\&{end}\par
+\U638.\fi
+
+\M641. Now it is necessary to explain a little trick. We don't want to store a
+long
+string that corresponds to a token list, because that string might take up
+lots of memory; and we are printing during a time when an error message is
+being given, so we dare not do anything that might overflow one of \MF's
+tables. So `pseudoprinting' is the answer: We enter a mode of printing
+that stores characters into a buffer of length \\{error\_line}, where character
+$k+1$ is placed into \hbox{$\\{trick\_buf}[\|k\mathbin{\&{mod}}\\{error%
+\_line}]$} if
+$\|k<\\{trick\_count}$, otherwise character \|k is dropped. Initially we set
+$\\{tally}\K0$ and $\\{trick\_count}\K1000000$; then when we reach the
+point where transition from line 1 to line 2 should occur, we
+set $\\{first\_count}\K\\{tally}$ and $\\{trick\_count}\K\hbox{max}(\\{error%
+\_line},\\{tally}+1+\\{error\_line}-\\{half\_error\_line})$. At the end of the
+pseudoprinting, the values of \\{first\_count}, \\{tally}, and
+\\{trick\_count} give us all the information we need to print the two lines,
+and all of the necessary text is in \\{trick\_buf}.
+
+Namely, let \|l be the length of the descriptive information that appears
+on the first line. The length of the context information gathered for that
+line is $\|k=\\{first\_count}$, and the length of the context information
+gathered for line~2 is $m=\min(\\{tally}, \\{trick\_count})-k$. If $\|l+\|k\L%
+\|h$,
+where $\|h=\\{half\_error\_line}$, we print $\\{trick\_buf}[0\to\|k-1]$ after
+the
+descriptive information on line~1, and set $\|n\K\|l+\|k$; here \|n is the
+length of line~1. If $l+k>h$, some cropping is necessary, so we set $\|n\K\|h$
+and print `\.{...}' followed by
+$$\hbox{$\\{trick\_buf}[(\|l+\|k-\|h+3)\to\|k-1]$,}$$
+where subscripts of \\{trick\_buf} are circular modulo \\{error\_line}. The
+second line consists of \|n~spaces followed by $\\{trick\_buf}[\|k\to(\|k+%
+\|m-1)]$,
+unless $\|n+\|m>\\{error\_line}$; in the latter case, further cropping is done.
+This is easier to program than to explain.
+
+\Y\P$\4\X641:Local variables for formatting calculations\X\S$\6
+\4\|i: \37$0\to\\{buf\_size}$;\C{index into \\{buffer}}\6
+\4\|l: \37\\{integer};\C{length of descriptive information on line 1}\6
+\4\|m: \37\\{integer};\C{context information gathered for line 2}\6
+\4\|n: \37$0\to\\{error\_line}$;\C{length of line 1}\6
+\4\|p: \37\\{integer};\C{starting or ending place in \\{trick\_buf}}\6
+\4\|q: \37\\{integer};\C{temporary index}\par
+\U635.\fi
+
+\M642. The following code tells the print routines to gather
+the desired information.
+
+\Y\P\D \37$\\{begin\_pseudoprint}\S$\1\6
+\&{begin} \37$\|l\K\\{tally}$;\5
+$\\{tally}\K0$;\5
+$\\{selector}\K\\{pseudo}$;\5
+$\\{trick\_count}\K1000000$;\6
+\&{end}\2\par
+\P\D \37$\\{set\_trick\_count}\S$\1\6
+\&{begin} \37$\\{first\_count}\K\\{tally}$;\5
+$\\{trick\_count}\K\\{tally}+1+\\{error\_line}-\\{half\_error\_line}$;\6
+\&{if} $\\{trick\_count}<\\{error\_line}$ \1\&{then}\5
+$\\{trick\_count}\K\\{error\_line}$;\2\6
+\&{end}\2\par
+\fi
+
+\M643. And the following code uses the information after it has been gathered.
+
+\Y\P$\4\X643:Print two lines using the tricky pseudoprinted information\X\S$\6
+\&{if} $\\{trick\_count}=1000000$ \1\&{then}\5
+\\{set\_trick\_count};\C{\\{set\_trick\_count} must be performed}\2\6
+\&{if} $\\{tally}<\\{trick\_count}$ \1\&{then}\5
+$\|m\K\\{tally}-\\{first\_count}$\6
+\4\&{else} $\|m\K\\{trick\_count}-\\{first\_count}$;\C{context on line 2}\2\6
+\&{if} $\|l+\\{first\_count}\L\\{half\_error\_line}$ \1\&{then}\6
+\&{begin} \37$\|p\K0$;\5
+$\|n\K\|l+\\{first\_count}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{print}(\.{"..."})$;\5
+$\|p\K\|l+\\{first\_count}-\\{half\_error\_line}+3$;\5
+$\|n\K\\{half\_error\_line}$;\6
+\&{end};\2\6
+\&{for} $\|q\K\|p\mathrel{\&{to}}\\{first\_count}-1$ \1\&{do}\5
+$\\{print\_char}(\\{trick\_buf}[\|q\mathbin{\&{mod}}\\{error\_line}])$;\2\6
+\\{print\_ln};\6
+\&{for} $\|q\K1\mathrel{\&{to}}\|n$ \1\&{do}\5
+$\\{print\_char}(\.{"\ "})$;\C{print \|n spaces to begin line~2}\2\6
+\&{if} $\|m+\|n\L\\{error\_line}$ \1\&{then}\5
+$\|p\K\\{first\_count}+\|m$\6
+\4\&{else} $\|p\K\\{first\_count}+(\\{error\_line}-\|n-3)$;\2\6
+\&{for} $\|q\K\\{first\_count}\mathrel{\&{to}}\|p-1$ \1\&{do}\5
+$\\{print\_char}(\\{trick\_buf}[\|q\mathbin{\&{mod}}\\{error\_line}])$;\2\6
+\&{if} $\|m+\|n>\\{error\_line}$ \1\&{then}\5
+$\\{print}(\.{"..."})$\2\par
+\U636.\fi
+
+\M644. But the trick is distracting us from our current goal, which is to
+understand the input state. So let's concentrate on the data structures that
+are being pseudoprinted as we finish up the \\{show\_context} procedure.
+
+\Y\P$\4\X644:Pseudoprint the line\X\S$\6
+\\{begin\_pseudoprint};\6
+\&{if} $\\{limit}>0$ \1\&{then}\6
+\&{for} $\|i\K\\{start}\mathrel{\&{to}}\\{limit}-1$ \1\&{do}\6
+\&{begin} \37\&{if} $\|i=\\{loc}$ \1\&{then}\5
+\\{set\_trick\_count};\2\6
+$\\{print}(\\{buffer}[\|i])$;\6
+\&{end}\2\2\par
+\U636.\fi
+
+\M645. \P$\X645:Pseudoprint the token list\X\S$\6
+\\{begin\_pseudoprint};\6
+\&{if} $\\{token\_type}\I\\{macro}$ \1\&{then}\5
+$\\{show\_token\_list}(\\{start},\39\\{loc},\39100000,\390)$\6
+\4\&{else} $\\{show\_macro}(\\{start},\39\\{loc},\39100000)$\2\par
+\U636.\fi
+
+\M646. Here is the missing piece of \\{show\_token\_list} that is activated
+when the
+token beginning line~2 is about to be shown:
+
+\Y\P$\4\X646:Do magic computation\X\S$\6
+\\{set\_trick\_count}\par
+\U217.\fi
+
+\N647. \[32] Maintaining the input stacks.
+The following subroutines change the input status in commonly needed ways.
+
+First comes \\{push\_input}, which stores the current state and creates a
+new level (having, initially, the same properties as the old).
+
+\Y\P\D \37$\\{push\_input}\S\hbox{}$\C{enter a new input level, save the old}\6
+\&{begin} \37\&{if} $\\{input\_ptr}>\\{max\_in\_stack}$ \1\&{then}\6
+\&{begin} \37$\\{max\_in\_stack}\K\\{input\_ptr}$;\6
+\&{if} $\\{input\_ptr}=\\{stack\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"input\ stack\ size"},\39\\{stack\_size})$;\2\6
+\&{end};\2\6
+$\\{input\_stack}[\\{input\_ptr}]\K\\{cur\_input}$;\C{stack the record}\6
+$\\{incr}(\\{input\_ptr})$;\6
+\&{end}\par
+\fi
+
+\M648. And of course what goes up must come down.
+
+\Y\P\D \37$\\{pop\_input}\S\hbox{}$\C{leave an input level, re-enter the old}\6
+\&{begin} \37$\\{decr}(\\{input\_ptr})$;\5
+$\\{cur\_input}\K\\{input\_stack}[\\{input\_ptr}]$;\6
+\&{end}\par
+\fi
+
+\M649. Here is a procedure that starts a new level of token-list input, given
+a token list \|p and its type \|t. If $\|t=\\{macro}$, the calling routine
+should
+set \\{name}, reset~\\{loc}, and increase the macro's reference count.
+
+\Y\P\D \37$\\{back\_list}(\#)\S\\{begin\_token\_list}(\#,\39\\{backed\_up})$%
+\C{backs up a simple token list}\par
+\Y\P\4\&{procedure}\1\ \37$\\{begin\_token\_list}(\|p:\\{pointer};\,\35\|t:%
+\\{quarterword})$;\2\6
+\&{begin} \37\\{push\_input};\5
+$\\{start}\K\|p$;\5
+$\\{token\_type}\K\|t$;\5
+$\\{param\_start}\K\\{param\_ptr}$;\5
+$\\{loc}\K\|p$;\6
+\&{end};\par
+\fi
+
+\M650. When a token list has been fully scanned, the following computations
+should be done as we leave that level of input.
+
+\Y\P\4\&{procedure}\1\ \37\\{end\_token\_list};\C{leave a token-list input
+level}\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{temporary register}\2\6
+\&{begin} \37\&{if} $\\{token\_type}\G\\{backed\_up}$ \1\&{then}\C{token list
+to be deleted}\6
+\&{if} $\\{token\_type}\L\\{inserted}$ \1\&{then}\6
+\&{begin} \37$\\{flush\_token\_list}(\\{start})$;\5
+\&{goto} \37\\{done};\6
+\&{end}\6
+\4\&{else} $\\{delete\_mac\_ref}(\\{start})$;\C{update reference count}\2\2\6
+\&{while} $\\{param\_ptr}>\\{param\_start}$ \1\&{do}\C{parameters must be
+flushed}\6
+\&{begin} \37$\\{decr}(\\{param\_ptr})$;\5
+$\|p\K\\{param\_stack}[\\{param\_ptr}]$;\6
+\&{if} $\|p\I\\{null}$ \1\&{then}\6
+\&{if} $\\{link}(\|p)=\\{void}$ \1\&{then}\C{it's an \&{expr} parameter}\6
+\&{begin} \37$\\{recycle\_value}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$;\6
+\&{end}\6
+\4\&{else} $\\{flush\_token\_list}(\|p)$;\C{it's a \&{suffix} or \&{text}
+parameter}\2\2\6
+\&{end};\2\6
+\4\\{done}: \37\\{pop\_input};\5
+\\{check\_interrupt};\6
+\&{end};\par
+\fi
+
+\M651. The contents of $\\{cur\_cmd},\\{cur\_mod},\\{cur\_sym}$ are placed into
+an equivalent
+token by the \\{cur\_tok} routine.
+
+\Y\P\hbox{\4}\X855:Declare the procedure called \\{make\_exp\_copy}\X\6
+\4\&{function}\1\ \37\\{cur\_tok}: \37\\{pointer};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{a new token node}\6
+\\{save\_type}: \37\\{small\_number};\C{\\{cur\_type} to be restored}\6
+\\{save\_exp}: \37\\{integer};\C{\\{cur\_exp} to be restored}\2\6
+\&{begin} \37\&{if} $\\{cur\_sym}=0$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}=\\{capsule\_token}$ \1\&{then}\6
+\&{begin} \37$\\{save\_type}\K\\{cur\_type}$;\5
+$\\{save\_exp}\K\\{cur\_exp}$;\5
+$\\{make\_exp\_copy}(\\{cur\_mod})$;\5
+$\|p\K\\{stash\_cur\_exp}$;\5
+$\\{link}(\|p)\K\\{null}$;\5
+$\\{cur\_type}\K\\{save\_type}$;\5
+$\\{cur\_exp}\K\\{save\_exp}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|p\K\\{get\_node}(\\{token\_node\_size})$;\5
+$\\{value}(\|p)\K\\{cur\_mod}$;\5
+$\\{name\_type}(\|p)\K\\{token}$;\6
+\&{if} $\\{cur\_cmd}=\\{numeric\_token}$ \1\&{then}\5
+$\\{type}(\|p)\K\\{known}$\6
+\4\&{else} $\\{type}(\|p)\K\\{string\_type}$;\2\6
+\&{end}\2\6
+\4\&{else} \&{begin} \37$\\{fast\_get\_avail}(\|p)$;\5
+$\\{info}(\|p)\K\\{cur\_sym}$;\6
+\&{end};\2\6
+$\\{cur\_tok}\K\|p$;\6
+\&{end};\par
+\fi
+
+\M652. Sometimes \MF\ has read too far and wants to ``unscan'' what it has
+seen. The \\{back\_input} procedure takes care of this by putting the token
+just scanned back into the input stream, ready to be read again.
+If $\\{cur\_sym}\I0$, the values of \\{cur\_cmd} and \\{cur\_mod} are
+irrelevant.
+
+\Y\P\4\&{procedure}\1\ \37\\{back\_input};\C{undoes one token of input}\6
+\4\&{var} \37\|p: \37\\{pointer};\C{a token list of length one}\2\6
+\&{begin} \37$\|p\K\\{cur\_tok}$;\6
+\&{while} $\\{token\_state}\W(\\{loc}=\\{null})$ \1\&{do}\5
+\\{end\_token\_list};\C{conserve stack space}\2\6
+$\\{back\_list}(\|p)$;\6
+\&{end};\par
+\fi
+
+\M653. The \\{back\_error} routine is used when we want to restore or replace
+an
+offending token just before issuing an error message. We disable interrupts
+during the call of \\{back\_input} so that the help message won't be lost.
+
+\Y\P\4\&{procedure}\1\ \37\\{back\_error};\C{back up one token and call %
+\\{error}}\2\6
+\&{begin} \37$\\{OK\_to\_interrupt}\K\\{false}$;\5
+\\{back\_input};\5
+$\\{OK\_to\_interrupt}\K\\{true}$;\5
+\\{error};\6
+\&{end};\7
+\4\&{procedure}\1\ \37\\{ins\_error};\C{back up one inserted token and call %
+\\{error}}\2\6
+\&{begin} \37$\\{OK\_to\_interrupt}\K\\{false}$;\5
+\\{back\_input};\5
+$\\{token\_type}\K\\{inserted}$;\5
+$\\{OK\_to\_interrupt}\K\\{true}$;\5
+\\{error};\6
+\&{end};\par
+\fi
+
+\M654. The \\{begin\_file\_reading} procedure starts a new level of input for
+lines
+of characters to be read from a file, or as an insertion from the
+terminal. It does not take care of opening the file, nor does it set \\{loc}
+or \\{limit} or \\{line}.
+
+\Y\P\4\&{procedure}\1\ \37\\{begin\_file\_reading};\2\6
+\&{begin} \37\&{if} $\\{in\_open}=\\{max\_in\_open}$ \1\&{then}\5
+$\\{overflow}(\.{"text\ input\ levels"},\39\\{max\_in\_open})$;\2\6
+\&{if} $\\{first}=\\{buf\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"buffer\ size"},\39\\{buf\_size})$;\2\6
+$\\{incr}(\\{in\_open})$;\5
+\\{push\_input};\5
+$\\{index}\K\\{in\_open}$;\5
+$\\{line\_stack}[\\{index}]\K\\{line}$;\5
+$\\{start}\K\\{first}$;\5
+$\\{name}\K0$;\C{\\{terminal\_input} is now \\{true}}\6
+\&{end};\par
+\fi
+
+\M655. Conversely, the variables must be downdated when such a level of input
+is finished:
+
+\Y\P\4\&{procedure}\1\ \37\\{end\_file\_reading};\2\6
+\&{begin} \37$\\{first}\K\\{start}$;\5
+$\\{line}\K\\{line\_stack}[\\{index}]$;\6
+\&{if} $\\{index}\I\\{in\_open}$ \1\&{then}\5
+$\\{confusion}(\.{"endinput"})$;\2\6
+\&{if} $\\{name}>2$ \1\&{then}\5
+$\\{a\_close}(\\{cur\_file})$;\C{forget it}\2\6
+\\{pop\_input};\5
+$\\{decr}(\\{in\_open})$;\6
+\&{end};\par
+\fi
+
+\M656. In order to keep the stack from overflowing during a long sequence of
+inserted `\.{show}' commands, the following routine removes completed
+error-inserted lines from memory.
+
+\Y\P\4\&{procedure}\1\ \37\\{clear\_for\_error\_prompt};\2\6
+\&{begin} \37\&{while} $\\{file\_state}\W\\{terminal\_input}\W\30(\\{input%
+\_ptr}>0)\W(\\{loc}=\\{limit})$ \1\&{do}\5
+\\{end\_file\_reading};\2\6
+\\{print\_ln};\5
+\\{clear\_terminal};\6
+\&{end};\par
+\fi
+
+\M657. To get \MF's whole input mechanism going, we perform the following
+actions.
+
+\Y\P$\4\X657:Initialize the input routines\X\S$\6
+\&{begin} \37$\\{input\_ptr}\K0$;\5
+$\\{max\_in\_stack}\K0$;\5
+$\\{in\_open}\K0$;\5
+$\\{open\_parens}\K0$;\5
+$\\{max\_buf\_stack}\K0$;\5
+$\\{param\_ptr}\K0$;\5
+$\\{max\_param\_stack}\K0$;\5
+$\\{first}\K1$;\5
+$\\{start}\K1$;\5
+$\\{index}\K0$;\5
+$\\{line}\K0$;\5
+$\\{name}\K0$;\5
+$\\{force\_eof}\K\\{false}$;\6
+\&{if} $\R\\{init\_terminal}$ \1\&{then}\5
+\&{goto} \37\\{final\_end};\2\6
+$\\{limit}\K\\{last}$;\5
+$\\{first}\K\\{last}+1$;\C{\\{init\_terminal} has set \\{loc} and \\{last}}\6
+\&{end};\par
+\A660.
+\U1211.\fi
+
+\N658. \[33] Getting the next token.
+The heart of \MF's input mechanism is the \\{get\_next} procedure, which
+we shall develop in the next few sections of the program. Perhaps we
+shouldn't actually call it the ``heart,'' however; it really acts as \MF's
+eyes and mouth, reading the source files and gobbling them up. And it also
+helps \MF\ to regurgitate stored token lists that are to be processed again.
+
+The main duty of \\{get\_next} is to input one token and to set \\{cur\_cmd}
+and \\{cur\_mod} to that token's command code and modifier. Furthermore, if
+the input token is a symbolic token, that token's \\{hash} address
+is stored in \\{cur\_sym}; otherwise \\{cur\_sym} is set to zero.
+
+Underlying this simple description is a certain amount of complexity
+because of all the cases that need to be handled.
+However, the inner loop of \\{get\_next} is reasonably short and fast.
+
+\fi
+
+\M659. Before getting into \\{get\_next}, we need to consider a mechanism by
+which
+\MF\ helps keep errors from propagating too far. Whenever the program goes
+into a mode where it keeps calling \\{get\_next} repeatedly until a certain
+condition is met, it sets \\{scanner\_status} to some value other than %
+\\{normal}.
+Then if an input file ends, or if an `\&{outer}' symbol appears,
+an appropriate error recovery will be possible.
+
+The global variable \\{warning\_info} helps in this error recovery by providing
+additional information. For example, \\{warning\_info} might indicate the
+name of a macro whose replacement text is being scanned.
+
+\Y\P\D \37$\\{normal}=0$\C{\\{scanner\_status} at ``quiet times''}\par
+\P\D \37$\\{skipping}=1$\C{\\{scanner\_status} when false conditional text is
+being skipped}\par
+\P\D \37$\\{flushing}=2$\C{\\{scanner\_status} when junk after a statement is
+being ignored}\par
+\P\D \37$\\{absorbing}=3$\C{\\{scanner\_status} when a \&{text} parameter is
+being scanned}\par
+\P\D \37$\\{var\_defining}=4$\C{\\{scanner\_status} when a \&{vardef} is being
+scanned}\par
+\P\D \37$\\{op\_defining}=5$\C{\\{scanner\_status} when a macro \&{def} is
+being scanned}\par
+\P\D \37$\\{loop\_defining}=6$\C{\\{scanner\_status} when a \&{for} loop is
+being scanned}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{scanner\_status}: \37$\\{normal}\to\\{loop\_defining}$;\C{are we scanning
+at high speed?}\6
+\4\\{warning\_info}: \37\\{integer};\C{if so, what else do we need to know,
+in case an error occurs?}\par
+\fi
+
+\M660. \P$\X657:Initialize the input routines\X\mathrel{+}\S$\6
+$\\{scanner\_status}\K\\{normal}$;\par
+\fi
+
+\M661. The following subroutine
+is called when an `\&{outer}' symbolic token has been scanned or
+when the end of a file has been reached. These two cases are distinguished
+by \\{cur\_sym}, which is zero at the end of a file.
+
+\Y\P\4\&{function}\1\ \37\\{check\_outer\_validity}: \37\\{boolean};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{points to inserted token list}\2\6
+\&{begin} \37\&{if} $\\{scanner\_status}=\\{normal}$ \1\&{then}\5
+$\\{check\_outer\_validity}\K\\{true}$\6
+\4\&{else} \&{begin} \37$\\{deletions\_allowed}\K\\{false}$;\5
+\X662:Back up an outer symbolic token so that it can be reread\X;\6
+\&{if} $\\{scanner\_status}>\\{skipping}$ \1\&{then}\5
+\X663:Tell the user what has run away and try to recover\X\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"Incomplete\ if;\ all\ text\ was\
+ignored\ after\ line\ "})$;\5
+$\\{print\_int}(\\{warning\_info})$;\6
+$\\{help3}(\.{"A\ forbidden\ \`outer\'\ token\ occurred\ in\ skipped\ text."})$%
+\6
+$(\.{"This\ kind\ of\ error\ happens\ when\ you\ say\ \`if...\'\ and\
+forget"})$\6
+$(\.{"the\ matching\ \`fi\'.\ I\'ve\ inserted\ a\ \`fi\';\ this\ might\
+work."})$;\6
+\&{if} $\\{cur\_sym}=0$ \1\&{then}\5
+$\\{help\_line}[2]\K\30\.{"The\ file\ ended\ while\ I\ was\ skipping\
+conditional\ text."}$;\2\6
+$\\{cur\_sym}\K\\{frozen\_fi}$;\5
+\\{ins\_error};\6
+\&{end};\2\6
+$\\{deletions\_allowed}\K\\{true}$;\5
+$\\{check\_outer\_validity}\K\\{false}$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M662. \P$\X662:Back up an outer symbolic token so that it can be reread\X\S$\6
+\&{if} $\\{cur\_sym}\I0$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{get\_avail}$;\5
+$\\{info}(\|p)\K\\{cur\_sym}$;\5
+$\\{back\_list}(\|p)$;\C{prepare to read the symbolic token again}\6
+\&{end}\2\par
+\U661.\fi
+
+\M663. \P$\X663:Tell the user what has run away and try to recover\X\S$\6
+\&{begin} \37\\{runaway};\C{print the definition-so-far}\6
+\&{if} $\\{cur\_sym}=0$ \1\&{then}\5
+$\\{print\_err}(\.{"File\ ended"})$\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"Forbidden\ token\ found"})$;\6
+\&{end};\2\6
+$\\{print}(\.{"\ while\ scanning\ "})$;\5
+$\\{help4}(\.{"I\ suspect\ you\ have\ forgotten\ an\ \`enddef\',"})$\6
+$(\.{"causing\ me\ to\ read\ past\ where\ you\ wanted\ me\ to\ stop."})$\6
+$(\.{"I\'ll\ try\ to\ recover;\ but\ if\ the\ error\ is\ serious,"})$\6
+$(\.{"you\'d\ better\ type\ \`E\'\ or\ \`X\'\ now\ and\ fix\ your\ file."})$;\6
+\&{case} $\\{scanner\_status}$ \1\&{of}\6
+\hbox{\4}\X664:Complete the error message, and set \\{cur\_sym} to a token that
+might help recover from the error\X\2\6
+\&{end};\C{there are no other cases}\6
+\\{ins\_error};\6
+\&{end}\par
+\U661.\fi
+
+\M664. As we consider various kinds of errors, it is also appropriate to
+change the first line of the help message just given; $\\{help\_line}[3]$
+points to the string that might be changed.
+
+\Y\P$\4\X664:Complete the error message, and set \\{cur\_sym} to a token that
+might help recover from the error\X\S$\6
+\4\\{flushing}: \37\&{begin} \37$\\{print}(\.{"to\ the\ end\ of\ the\
+statement"})$;\5
+$\\{help\_line}[3]\K\.{"A\ previous\ error\ seems\ to\ have\ propagated,"}$;\5
+$\\{cur\_sym}\K\\{frozen\_semicolon}$;\6
+\&{end};\6
+\4\\{absorbing}: \37\&{begin} \37$\\{print}(\.{"a\ text\ argument"})$;\5
+$\\{help\_line}[3]\K\.{"It\ seems\ that\ a\ right\ delimiter\ was\ left\
+out,"}$;\6
+\&{if} $\\{warning\_info}=0$ \1\&{then}\5
+$\\{cur\_sym}\K\\{frozen\_end\_group}$\6
+\4\&{else} \&{begin} \37$\\{cur\_sym}\K\\{frozen\_right\_delimiter}$;\5
+$\\{equiv}(\\{frozen\_right\_delimiter})\K\\{warning\_info}$;\6
+\&{end};\2\6
+\&{end};\6
+\4$\\{var\_defining},\39\\{op\_defining}$: \37\&{begin} \37$\\{print}(\.{"the\
+definition\ of\ "})$;\6
+\&{if} $\\{scanner\_status}=\\{op\_defining}$ \1\&{then}\5
+$\\{slow\_print}(\\{text}(\\{warning\_info}))$\6
+\4\&{else} $\\{print\_variable\_name}(\\{warning\_info})$;\2\6
+$\\{cur\_sym}\K\\{frozen\_end\_def}$;\6
+\&{end};\6
+\4\\{loop\_defining}: \37\&{begin} \37$\\{print}(\.{"the\ text\ of\ a\ "})$;\5
+$\\{slow\_print}(\\{text}(\\{warning\_info}))$;\5
+$\\{print}(\.{"\ loop"})$;\5
+$\\{help\_line}[3]\K\.{"I\ suspect\ you\ have\ forgotten\ an\ \`endfor\',"}$;\5
+$\\{cur\_sym}\K\\{frozen\_end\_for}$;\6
+\&{end};\par
+\U663.\fi
+
+\M665. The \\{runaway} procedure displays the first part of the text that
+occurred
+when \MF\ began its special \\{scanner\_status}, if that text has been saved.
+
+\Y\P$\4\X665:Declare the procedure called \\{runaway}\X\S$\6
+\4\&{procedure}\1\ \37\\{runaway};\2\6
+\&{begin} \37\&{if} $\\{scanner\_status}>\\{flushing}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"Runaway\ "})$;\6
+\&{case} $\\{scanner\_status}$ \1\&{of}\6
+\4\\{absorbing}: \37$\\{print}(\.{"text?"})$;\6
+\4$\\{var\_defining},\39\\{op\_defining}$: \37$\\{print}(\.{"definition?"})$;\6
+\4\\{loop\_defining}: \37$\\{print}(\.{"loop?"})$;\2\6
+\&{end};\C{there are no other cases}\6
+\\{print\_ln};\5
+$\\{show\_token\_list}(\\{link}(\\{hold\_head}),\39\\{null},\39\\{error%
+\_line}-10,\390)$;\6
+\&{end};\2\6
+\&{end};\par
+\U162.\fi
+
+\M666. We need to mention a procedure that may be called by \\{get\_next}.
+
+\Y\P\4\&{procedure}\1\ \37\\{firm\_up\_the\_line};\5
+\\{forward};\par
+\fi
+
+\M667. And now we're ready to take the plunge into \\{get\_next} itself.
+
+\Y\P\D \37$\\{switch}=25$\C{a label in \\{get\_next}}\par
+\P\D \37$\\{start\_numeric\_token}=85$\C{another}\par
+\P\D \37$\\{start\_decimal\_token}=86$\C{and another}\par
+\P\D \37$\\{fin\_numeric\_token}=87$\C{and still another, although \&{goto} is
+considered harmful}\par
+\Y\P\4\&{procedure}\1\ \37\\{get\_next};\C{sets \\{cur\_cmd}, \\{cur\_mod}, %
+\\{cur\_sym} to next token}\6
+\4\&{label} \37$\\{restart},\39$\C{go here to get the next input token}\6
+$\\{exit},\39$\C{go here when the next input token has been got}\6
+$\\{found},\39$\C{go here when the end of a symbolic token has been found}\6
+$\\{switch},\39$\C{go here to branch on the class of an input character}\6
+$\\{start\_numeric\_token},\39\\{start\_decimal\_token},\39\\{fin\_numeric%
+\_token},\39\\{done}$;\C{go here at crucial stages when scanning a number}\6
+\4\&{var} \37\|k: \37$0\to\\{buf\_size}$;\C{an index into \\{buffer}}\6
+\|c: \37\\{ASCII\_code};\C{the current character in the buffer}\6
+\\{class}: \37\\{ASCII\_code};\C{its class number}\6
+$\|n,\39\|f$: \37\\{integer};\C{registers for decimal-to-binary conversion}\2\6
+\&{begin} \37\\{restart}: \37$\\{cur\_sym}\K0$;\6
+\&{if} $\\{file\_state}$ \1\&{then}\5
+\X669:Input from external file; \&{goto} \\{restart} if no input found, or %
+\&{return} if a non-symbolic token is found\X\6
+\4\&{else} \X676:Input from token list; \&{goto} \\{restart} if end of list or
+if a parameter needs to be expanded, or \&{return} if a non-symbolic token is
+found\X;\2\6
+\X668:Finish getting the symbolic token in \\{cur\_sym}; \&{goto} \\{restart}
+if it is illegal\X;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M668. When a symbolic token is declared to be `\&{outer}', its command code
+is increased by \\{outer\_tag}.
+
+\Y\P$\4\X668:Finish getting the symbolic token in \\{cur\_sym}; \&{goto} %
+\\{restart} if it is illegal\X\S$\6
+$\\{cur\_cmd}\K\\{eq\_type}(\\{cur\_sym})$;\5
+$\\{cur\_mod}\K\\{equiv}(\\{cur\_sym})$;\6
+\&{if} $\\{cur\_cmd}\G\\{outer\_tag}$ \1\&{then}\6
+\&{if} $\\{check\_outer\_validity}$ \1\&{then}\5
+$\\{cur\_cmd}\K\\{cur\_cmd}-\\{outer\_tag}$\6
+\4\&{else} \&{goto} \37\\{restart}\2\2\par
+\U667.\fi
+
+\M669. A percent sign appears in $\\{buffer}[\\{limit}]$; this makes it
+unnecessary
+to have a special test for end-of-line.
+
+\Y\P$\4\X669:Input from external file; \&{goto} \\{restart} if no input found,
+or \&{return} if a non-symbolic token is found\X\S$\6
+\&{begin} \37\\{switch}: \37$\|c\K\\{buffer}[\\{loc}]$;\5
+$\\{incr}(\\{loc})$;\5
+$\\{class}\K\\{char\_class}[\|c]$;\6
+\&{case} $\\{class}$ \1\&{of}\6
+\4\\{digit\_class}: \37\&{goto} \37\\{start\_numeric\_token};\6
+\4\\{period\_class}: \37\&{begin} \37$\\{class}\K\\{char\_class}[\\{buffer}[%
+\\{loc}]]$;\6
+\&{if} $\\{class}>\\{period\_class}$ \1\&{then}\5
+\&{goto} \37\\{switch}\6
+\4\&{else} \&{if} $\\{class}<\\{period\_class}$ \1\&{then}\C{$\\{class}=%
+\\{digit\_class}$}\6
+\&{begin} \37$\|n\K0$;\5
+\&{goto} \37\\{start\_decimal\_token};\6
+\&{end};\2\2\6
+\&{end};\6
+\4\\{space\_class}: \37\&{goto} \37\\{switch};\6
+\4\\{percent\_class}: \37\&{begin} \37\X679:Move to next line of file, or %
+\&{goto} \\{restart} if there is no next line\X;\6
+\\{check\_interrupt};\5
+\&{goto} \37\\{switch};\6
+\&{end};\6
+\4\\{string\_class}: \37\X671:Get a string token and \&{return}\X;\6
+\4\\{isolated\_classes}: \37\&{begin} \37$\|k\K\\{loc}-1$;\5
+\&{goto} \37\\{found};\6
+\&{end};\6
+\4\\{invalid\_class}: \37\X670:Decry the invalid character and \&{goto} %
+\\{restart}\X;\6
+\4\&{othercases} \37\\{do\_nothing}\C{letters, etc.}\2\6
+\&{endcases};\6
+$\|k\K\\{loc}-1$;\6
+\&{while} $\\{char\_class}[\\{buffer}[\\{loc}]]=\\{class}$ \1\&{do}\5
+$\\{incr}(\\{loc})$;\2\6
+\&{goto} \37\\{found};\6
+\4\\{start\_numeric\_token}: \37\X673:Get the integer part \|n of a numeric
+token; set $\|f\K0$ and \&{goto} \\{fin\_numeric\_token} if there is no decimal
+point\X;\6
+\4\\{start\_decimal\_token}: \37\X674:Get the fraction part \|f of a numeric
+token\X;\6
+\4\\{fin\_numeric\_token}: \37\X675:Pack the numeric and fraction parts of a
+numeric token and \&{return}\X;\6
+\4\\{found}: \37$\\{cur\_sym}\K\\{id\_lookup}(\|k,\39\\{loc}-\|k)$;\6
+\&{end}\par
+\U667.\fi
+
+\M670. We go to \\{restart} instead of to \\{switch}, because \\{state} might
+equal
+\\{token\_list} after the error has been dealt with
+(cf.\ \\{clear\_for\_error\_prompt}).
+
+\Y\P$\4\X670:Decry the invalid character and \&{goto} \\{restart}\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Text\ line\ contains\ an\ invalid\
+character"})$;\5
+$\\{help2}(\.{"A\ funny\ symbol\ that\ I\ can\'t\ read\ has\ just\ been\
+input."})$\6
+$(\.{"Continue,\ and\ I\'ll\ forget\ that\ it\ ever\ happened."})$;\6
+$\\{deletions\_allowed}\K\\{false}$;\5
+\\{error};\5
+$\\{deletions\_allowed}\K\\{true}$;\5
+\&{goto} \37\\{restart};\6
+\&{end}\par
+\U669.\fi
+
+\M671. \P$\X671:Get a string token and \&{return}\X\S$\6
+\&{begin} \37\&{if} $\\{buffer}[\\{loc}]=\.{""}\.{""}$ \1\&{then}\5
+$\\{cur\_mod}\K\.{""}$\6
+\4\&{else} \&{begin} \37$\|k\K\\{loc}$;\5
+$\\{buffer}[\\{limit}+1]\K\.{""}\.{""}$;\6
+\1\&{repeat} \37$\\{incr}(\\{loc})$;\6
+\4\&{until}\5
+$\\{buffer}[\\{loc}]=\.{""}\.{""}$;\2\6
+\&{if} $\\{loc}>\\{limit}$ \1\&{then}\5
+\X672:Decry the missing string delimiter and \&{goto} \\{restart}\X;\2\6
+\&{if} $(\\{loc}=\|k+1)\W(\\{length}(\\{buffer}[\|k])=1)$ \1\&{then}\5
+$\\{cur\_mod}\K\\{buffer}[\|k]$\6
+\4\&{else} \&{begin} \37$\\{str\_room}(\\{loc}-\|k)$;\6
+\1\&{repeat} \37$\\{append\_char}(\\{buffer}[\|k])$;\5
+$\\{incr}(\|k)$;\6
+\4\&{until}\5
+$\|k=\\{loc}$;\2\6
+$\\{cur\_mod}\K\\{make\_string}$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\\{incr}(\\{loc})$;\5
+$\\{cur\_cmd}\K\\{string\_token}$;\5
+\&{return};\6
+\&{end}\par
+\U669.\fi
+
+\M672. We go to \\{restart} after this error message, not to \\{switch},
+because the \\{clear\_for\_error\_prompt} routine might have reinstated
+\\{token\_state} after \\{error} has finished.
+
+\Y\P$\4\X672:Decry the missing string delimiter and \&{goto} \\{restart}\X\S$\6
+\&{begin} \37$\\{loc}\K\\{limit}$;\C{the next character to be read on this line
+will be \.{"\%"}}\6
+$\\{print\_err}(\.{"Incomplete\ string\ token\ has\ been\ flushed"})$;\5
+$\\{help3}(\.{"Strings\ should\ finish\ on\ the\ same\ line\ as\ they\
+began."})$\6
+$(\.{"I\'ve\ deleted\ the\ partial\ string;\ you\ might\ want\ to"})$\6
+$(\.{"insert\ another\ by\ typing,\ e.g.,\ \`I"}\.{"new\ string"}\.{"\'."})$;\6
+$\\{deletions\_allowed}\K\\{false}$;\5
+\\{error};\5
+$\\{deletions\_allowed}\K\\{true}$;\5
+\&{goto} \37\\{restart};\6
+\&{end}\par
+\U671.\fi
+
+\M673. \P$\X673:Get the integer part \|n of a numeric token; set $\|f\K0$ and %
+\&{goto} \\{fin\_numeric\_token} if there is no decimal point\X\S$\6
+$\|n\K\|c-\.{"0"}$;\6
+\&{while} $\\{char\_class}[\\{buffer}[\\{loc}]]=\\{digit\_class}$ \1\&{do}\6
+\&{begin} \37\&{if} $\|n<4096$ \1\&{then}\5
+$\|n\K10\ast\|n+\\{buffer}[\\{loc}]-\.{"0"}$;\2\6
+$\\{incr}(\\{loc})$;\6
+\&{end};\2\6
+\&{if} $\\{buffer}[\\{loc}]=\.{"."}$ \1\&{then}\6
+\&{if} $\\{char\_class}[\\{buffer}[\\{loc}+1]]=\\{digit\_class}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\2\6
+$\|f\K0$;\5
+\&{goto} \37\\{fin\_numeric\_token};\6
+\4\\{done}: \37$\\{incr}(\\{loc})$\par
+\U669.\fi
+
+\M674. \P$\X674:Get the fraction part \|f of a numeric token\X\S$\6
+$\|k\K0$;\6
+\1\&{repeat} \37\&{if} $\|k<17$ \1\&{then}\C{digits for $\|k\G17$ cannot affect
+the result}\6
+\&{begin} \37$\\{dig}[\|k]\K\\{buffer}[\\{loc}]-\.{"0"}$;\5
+$\\{incr}(\|k)$;\6
+\&{end};\2\6
+$\\{incr}(\\{loc})$;\6
+\4\&{until}\5
+$\\{char\_class}[\\{buffer}[\\{loc}]]\I\\{digit\_class}$;\2\6
+$\|f\K\\{round\_decimals}(\|k)$;\6
+\&{if} $\|f=\\{unity}$ \1\&{then}\6
+\&{begin} \37$\\{incr}(\|n)$;\5
+$\|f\K0$;\6
+\&{end}\2\par
+\U669.\fi
+
+\M675. \P$\X675:Pack the numeric and fraction parts of a numeric token and %
+\&{return}\X\S$\6
+\&{if} $\|n<4096$ \1\&{then}\5
+$\\{cur\_mod}\K\|n\ast\\{unity}+\|f$\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"Enormous\ number\ has\ been\
+reduced"})$;\5
+$\\{help2}(\.{"I\ can\'t\ handle\ numbers\ bigger\ than\ about\ 4095.99998;"})$%
+\6
+$(\.{"so\ I\'ve\ changed\ your\ constant\ to\ that\ maximum\ amount."})$;\6
+$\\{deletions\_allowed}\K\\{false}$;\5
+\\{error};\5
+$\\{deletions\_allowed}\K\\{true}$;\5
+$\\{cur\_mod}\K\O{1777777777}$;\6
+\&{end};\2\6
+$\\{cur\_cmd}\K\\{numeric\_token}$;\5
+\&{return}\par
+\U669.\fi
+
+\M676. Let's consider now what happens when \\{get\_next} is looking at a token
+list.
+
+\Y\P$\4\X676:Input from token list; \&{goto} \\{restart} if end of list or if a
+parameter needs to be expanded, or \&{return} if a non-symbolic token is found%
+\X\S$\6
+\&{if} $\\{loc}\G\\{hi\_mem\_min}$ \1\&{then}\C{one-word token}\6
+\&{begin} \37$\\{cur\_sym}\K\\{info}(\\{loc})$;\5
+$\\{loc}\K\\{link}(\\{loc})$;\C{move to next}\6
+\&{if} $\\{cur\_sym}\G\\{expr\_base}$ \1\&{then}\6
+\&{if} $\\{cur\_sym}\G\\{suffix\_base}$ \1\&{then}\5
+\X677:Insert a suffix or text parameter and \&{goto} \\{restart}\X\6
+\4\&{else} \&{begin} \37$\\{cur\_cmd}\K\\{capsule\_token}$;\5
+$\\{cur\_mod}\K\\{param\_stack}[\\{param\_start}+\\{cur\_sym}-(\\{expr%
+\_base})]$;\5
+$\\{cur\_sym}\K0$;\5
+\&{return};\6
+\&{end};\2\2\6
+\&{end}\6
+\4\&{else} \&{if} $\\{loc}>\\{null}$ \1\&{then}\5
+\X678:Get a stored numeric or string or capsule token and \&{return}\X\6
+\4\&{else} \&{begin} \37\C{we are done with this token list}\6
+\\{end\_token\_list};\5
+\&{goto} \37\\{restart};\C{resume previous level}\6
+\&{end}\2\2\par
+\U667.\fi
+
+\M677. \P$\X677:Insert a suffix or text parameter and \&{goto} \\{restart}\X\S$%
+\6
+\&{begin} \37\&{if} $\\{cur\_sym}\G\\{text\_base}$ \1\&{then}\5
+$\\{cur\_sym}\K\\{cur\_sym}-\\{param\_size}$;\C{$\\{param\_size}=\\{text%
+\_base}-\\{suffix\_base}$}\2\6
+$\\{begin\_token\_list}(\\{param\_stack}[\\{param\_start}+\\{cur\_sym}-(%
+\\{suffix\_base})],\39\\{parameter})$;\5
+\&{goto} \37\\{restart};\6
+\&{end}\par
+\U676.\fi
+
+\M678. \P$\X678:Get a stored numeric or string or capsule token and \&{return}%
+\X\S$\6
+\&{begin} \37\&{if} $\\{name\_type}(\\{loc})=\\{token}$ \1\&{then}\6
+\&{begin} \37$\\{cur\_mod}\K\\{value}(\\{loc})$;\6
+\&{if} $\\{type}(\\{loc})=\\{known}$ \1\&{then}\5
+$\\{cur\_cmd}\K\\{numeric\_token}$\6
+\4\&{else} \&{begin} \37$\\{cur\_cmd}\K\\{string\_token}$;\5
+$\\{add\_str\_ref}(\\{cur\_mod})$;\6
+\&{end};\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{cur\_mod}\K\\{loc}$;\5
+$\\{cur\_cmd}\K\\{capsule\_token}$;\6
+\&{end};\2\6
+$\\{loc}\K\\{link}(\\{loc})$;\5
+\&{return};\6
+\&{end}\par
+\U676.\fi
+
+\M679. All of the easy branches of \\{get\_next} have now been taken care of.
+There is one more branch.
+
+\Y\P$\4\X679:Move to next line of file, or \&{goto} \\{restart} if there is no
+next line\X\S$\6
+\&{if} $\\{name}>2$ \1\&{then}\5
+\X681:Read next line of file into \\{buffer}, or \&{goto} \\{restart} if the
+file has ended\X\6
+\4\&{else} \&{begin} \37\&{if} $\\{input\_ptr}>0$ \1\&{then}\C{text was
+inserted during error recovery or by \&{scantokens}}\6
+\&{begin} \37\\{end\_file\_reading};\5
+\&{goto} \37\\{restart};\C{resume previous level}\6
+\&{end};\2\6
+\&{if} $\\{selector}<\\{log\_only}$ \1\&{then}\5
+\\{open\_log\_file};\2\6
+\&{if} $\\{interaction}>\\{nonstop\_mode}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{limit}=\\{start}$ \1\&{then}\C{previous line was empty}%
+\6
+$\\{print\_nl}(\.{"(Please\ type\ a\ command\ or\ say\ \`end\')"})$;\2\6
+\\{print\_ln};\5
+$\\{first}\K\\{start}$;\5
+$\\{prompt\_input}(\.{"*"})$;\C{input on-line into \\{buffer}}\6
+$\\{limit}\K\\{last}$;\5
+$\\{buffer}[\\{limit}]\K\.{"\%"}$;\5
+$\\{first}\K\\{limit}+1$;\5
+$\\{loc}\K\\{start}$;\6
+\&{end}\6
+\4\&{else} $\\{fatal\_error}(\.{"***\ (job\ aborted,\ no\ legal\ end\
+found)"})$;\C{nonstop mode, which is intended for overnight batch processing,
+ never waits for on-line input}\2\6
+\&{end}\2\par
+\U669.\fi
+
+\M680. The global variable \\{force\_eof} is normally \\{false}; it is set %
+\\{true}
+by an \&{endinput} command.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{force\_eof}: \37\\{boolean};\C{should the next \&{input} be aborted
+early?}\par
+\fi
+
+\M681. \P$\X681:Read next line of file into \\{buffer}, or \&{goto} \\{restart}
+if the file has ended\X\S$\6
+\&{begin} \37$\\{incr}(\\{line})$;\5
+$\\{first}\K\\{start}$;\6
+\&{if} $\R\\{force\_eof}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{input\_ln}(\\{cur\_file},\39\\{true})$ \1\&{then}\C{not
+end of file}\6
+\\{firm\_up\_the\_line}\C{this sets \\{limit}}\6
+\4\&{else} $\\{force\_eof}\K\\{true}$;\2\6
+\&{end};\2\6
+\&{if} $\\{force\_eof}$ \1\&{then}\6
+\&{begin} \37$\\{print\_char}(\.{")"})$;\5
+$\\{decr}(\\{open\_parens})$;\5
+\\{update\_terminal};\C{show user that file has been read}\6
+$\\{force\_eof}\K\\{false}$;\5
+\\{end\_file\_reading};\C{resume previous level}\6
+\&{if} $\\{check\_outer\_validity}$ \1\&{then}\5
+\&{goto} \37\\{restart}\ \&{else} \&{goto} \37\\{restart};\2\6
+\&{end};\2\6
+$\\{buffer}[\\{limit}]\K\.{"\%"}$;\5
+$\\{first}\K\\{limit}+1$;\5
+$\\{loc}\K\\{start}$;\C{ready to read}\6
+\&{end}\par
+\U679.\fi
+
+\M682. If the user has set the \\{pausing} parameter to some positive value,
+and if nonstop mode has not been selected, each line of input is displayed
+on the terminal and the transcript file, followed by `\.{=>}'.
+\MF\ waits for a response. If the response is null (i.e., if nothing is
+typed except perhaps a few blank spaces), the original
+line is accepted as it stands; otherwise the line typed is
+used instead of the line in the file.
+
+\Y\P\4\&{procedure}\1\ \37\\{firm\_up\_the\_line};\6
+\4\&{var} \37\|k: \37$0\to\\{buf\_size}$;\C{an index into \\{buffer}}\2\6
+\&{begin} \37$\\{limit}\K\\{last}$;\6
+\&{if} $\\{internal}[\\{pausing}]>0$ \1\&{then}\6
+\&{if} $\\{interaction}>\\{nonstop\_mode}$ \1\&{then}\6
+\&{begin} \37\\{wake\_up\_terminal};\5
+\\{print\_ln};\6
+\&{if} $\\{start}<\\{limit}$ \1\&{then}\6
+\&{for} $\|k\K\\{start}\mathrel{\&{to}}\\{limit}-1$ \1\&{do}\5
+$\\{print}(\\{buffer}[\|k])$;\2\2\6
+$\\{first}\K\\{limit}$;\5
+$\\{prompt\_input}(\.{"=>"})$;\C{wait for user response}\6
+\&{if} $\\{last}>\\{first}$ \1\&{then}\6
+\&{begin} \37\&{for} $\|k\K\\{first}\mathrel{\&{to}}\\{last}-1$ \1\&{do}\C{move
+line down in buffer}\6
+$\\{buffer}[\|k+\\{start}-\\{first}]\K\\{buffer}[\|k]$;\2\6
+$\\{limit}\K\\{start}+\\{last}-\\{first}$;\6
+\&{end};\2\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\N683. \[34] Scanning macro definitions.
+\MF\ has a variety of ways to tuck tokens away into token lists for later
+use: Macros can be defined with \&{def}, \&{vardef}, \&{primarydef}, etc.;
+repeatable code can be defined with \&{for}, \&{forever}, \&{forsuffixes}.
+All such operations are handled by the routines in this part of the program.
+
+The modifier part of each command code is zero for the ``ending delimiters''
+like \&{enddef} and \&{endfor}.
+
+\Y\P\D \37$\\{start\_def}=1$\C{command modifier for \&{def}}\par
+\P\D \37$\\{var\_def}=2$\C{command modifier for \&{vardef}}\par
+\P\D \37$\\{end\_def}=0$\C{command modifier for \&{enddef}}\par
+\P\D \37$\\{start\_forever}=1$\C{command modifier for \&{forever}}\par
+\P\D \37$\\{end\_for}=0$\C{command modifier for \&{endfor}}\par
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"def"},\39\\{macro\_def},\39\\{start\_def})$;\6
+$\\{primitive}(\.{"vardef"},\39\\{macro\_def},\39\\{var\_def})$;\6
+$\\{primitive}(\.{"primarydef"},\39\\{macro\_def},\39\\{secondary\_primary%
+\_macro})$;\6
+$\\{primitive}(\.{"secondarydef"},\39\\{macro\_def},\39\\{tertiary\_secondary%
+\_macro})$;\6
+$\\{primitive}(\.{"tertiarydef"},\39\\{macro\_def},\39\\{expression\_tertiary%
+\_macro})$;\6
+$\\{primitive}(\.{"enddef"},\39\\{macro\_def},\39\\{end\_def})$;\5
+$\\{eqtb}[\\{frozen\_end\_def}]\K\\{eqtb}[\\{cur\_sym}]$;\7
+$\\{primitive}(\.{"for"},\39\\{iteration},\39\\{expr\_base})$;\6
+$\\{primitive}(\.{"forsuffixes"},\39\\{iteration},\39\\{suffix\_base})$;\6
+$\\{primitive}(\.{"forever"},\39\\{iteration},\39\\{start\_forever})$;\6
+$\\{primitive}(\.{"endfor"},\39\\{iteration},\39\\{end\_for})$;\5
+$\\{eqtb}[\\{frozen\_end\_for}]\K\\{eqtb}[\\{cur\_sym}]$;\par
+\fi
+
+\M684. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{macro\_def}: \37\&{if} $\|m\L\\{var\_def}$ \1\&{then}\6
+\&{if} $\|m=\\{start\_def}$ \1\&{then}\5
+$\\{print}(\.{"def"})$\6
+\4\&{else} \&{if} $\|m<\\{start\_def}$ \1\&{then}\5
+$\\{print}(\.{"enddef"})$\6
+\4\&{else} $\\{print}(\.{"vardef"})$\2\2\6
+\4\&{else} \&{if} $\|m=\\{secondary\_primary\_macro}$ \1\&{then}\5
+$\\{print}(\.{"primarydef"})$\6
+\4\&{else} \&{if} $\|m=\\{tertiary\_secondary\_macro}$ \1\&{then}\5
+$\\{print}(\.{"secondarydef"})$\6
+\4\&{else} $\\{print}(\.{"tertiarydef"})$;\2\2\2\6
+\4\\{iteration}: \37\&{if} $\|m\L\\{start\_forever}$ \1\&{then}\6
+\&{if} $\|m=\\{start\_forever}$ \1\&{then}\5
+$\\{print}(\.{"forever"})$\ \&{else} $\\{print}(\.{"endfor"})$\2\6
+\4\&{else} \&{if} $\|m=\\{expr\_base}$ \1\&{then}\5
+$\\{print}(\.{"for"})$\ \&{else} $\\{print}(\.{"forsuffixes"})$;\2\2\par
+\fi
+
+\M685. Different macro-absorbing operations have different syntaxes, but they
+also have a lot in common. There is a list of special symbols that are to
+be replaced by parameter tokens; there is a special command code that
+ends the definition; the quotation conventions are identical. Therefore
+it makes sense to have most of the work done by a single subroutine. That
+subroutine is called \\{scan\_toks}.
+
+The first parameter to \\{scan\_toks} is the command code that will
+terminate scanning (either \\{macro\_def}, \\{loop\_repeat}, or \\{iteration}).
+
+The second parameter, \\{subst\_list}, points to a (possibly empty) list
+of two-word nodes whose \\{info} and \\{value} fields specify symbol tokens
+before and after replacement. The list will be returned to free storage
+by \\{scan\_toks}.
+
+The third parameter is simply appended to the token list that is built.
+And the final parameter tells how many of the special operations
+\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#} are to be replaced by suffix parameters.
+When such parameters are present, they are called \.{(SUFFIX0)},
+\.{(SUFFIX1)}, and \.{(SUFFIX2)}.
+
+\Y\P\4\&{function}\1\ \37$\\{scan\_toks}(\\{terminator}:\\{command\_code};\,%
+\35\\{subst\_list},\39\\{tail\_end}:\\{pointer};\,\35\\{suffix\_count}:\\{small%
+\_number})$: \37\\{pointer};\6
+\4\&{label} \37$\\{done},\39\\{found}$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{tail of the token list being built}\6
+\|q: \37\\{pointer};\C{temporary for link management}\6
+\\{balance}: \37\\{integer};\C{left delimiters minus right delimiters}\2\6
+\&{begin} \37$\|p\K\\{hold\_head}$;\5
+$\\{balance}\K1$;\5
+$\\{link}(\\{hold\_head})\K\\{null}$;\6
+\~ \1\&{loop}\ \&{begin} \37\\{get\_next};\6
+\&{if} $\\{cur\_sym}>0$ \1\&{then}\6
+\&{begin} \37\X686:Substitute for \\{cur\_sym}, if it's on the \\{subst\_list}%
+\X;\6
+\&{if} $\\{cur\_cmd}=\\{terminator}$ \1\&{then}\5
+\X687:Adjust the balance; \&{goto} \\{done} if it's zero\X\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{macro\_special}$ \1\&{then}\5
+\X690:Handle quoted symbols, \.{\#\AT!}, \.{\AT!}, or \.{\AT!\#}\X;\2\2\6
+\&{end};\2\6
+$\\{link}(\|p)\K\\{cur\_tok}$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\4\\{done}: \37$\\{link}(\|p)\K\\{tail\_end}$;\5
+$\\{flush\_node\_list}(\\{subst\_list})$;\5
+$\\{scan\_toks}\K\\{link}(\\{hold\_head})$;\6
+\&{end};\par
+\fi
+
+\M686. \P$\X686:Substitute for \\{cur\_sym}, if it's on the \\{subst\_list}\X%
+\S$\6
+\&{begin} \37$\|q\K\\{subst\_list}$;\6
+\&{while} $\|q\I\\{null}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{info}(\|q)=\\{cur\_sym}$ \1\&{then}\6
+\&{begin} \37$\\{cur\_sym}\K\\{value}(\|q)$;\5
+$\\{cur\_cmd}\K\\{relax}$;\5
+\&{goto} \37\\{found};\6
+\&{end};\2\6
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+\4\\{found}: \37\&{end}\par
+\U685.\fi
+
+\M687. \P$\X687:Adjust the balance; \&{goto} \\{done} if it's zero\X\S$\6
+\&{if} $\\{cur\_mod}>0$ \1\&{then}\5
+$\\{incr}(\\{balance})$\6
+\4\&{else} \&{begin} \37$\\{decr}(\\{balance})$;\6
+\&{if} $\\{balance}=0$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{end}\2\par
+\U685.\fi
+
+\M688. Four commands are intended to be used only within macro texts: %
+\&{quote},
+\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#}. They are variants of a single command
+code called \\{macro\_special}.
+
+\Y\P\D \37$\\{quote}=0$\C{\\{macro\_special} modifier for \&{quote}}\par
+\P\D \37$\\{macro\_prefix}=1$\C{\\{macro\_special} modifier for \.{\#\AT!}}\par
+\P\D \37$\\{macro\_at}=2$\C{\\{macro\_special} modifier for \.{\AT!}}\par
+\P\D \37$\\{macro\_suffix}=3$\C{\\{macro\_special} modifier for \.{\AT!\#}}\par
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"quote"},\39\\{macro\_special},\39\\{quote})$;\6
+$\\{primitive}(\.{"\#@"},\39\\{macro\_special},\39\\{macro\_prefix})$;\6
+$\\{primitive}(\.{"@"},\39\\{macro\_special},\39\\{macro\_at})$;\6
+$\\{primitive}(\.{"@\#"},\39\\{macro\_special},\39\\{macro\_suffix})$;\par
+\fi
+
+\M689. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{macro\_special}: \37\&{case} $\|m$ \1\&{of}\6
+\4\\{macro\_prefix}: \37$\\{print}(\.{"\#@"})$;\6
+\4\\{macro\_at}: \37$\\{print\_char}(\.{"@"})$;\6
+\4\\{macro\_suffix}: \37$\\{print}(\.{"@\#"})$;\6
+\4\&{othercases} \37$\\{print}(\.{"quote"})$\2\6
+\&{endcases};\par
+\fi
+
+\M690. \P$\X690:Handle quoted symbols, \.{\#\AT!}, \.{\AT!}, or \.{\AT!\#}\X\S$%
+\6
+\&{begin} \37\&{if} $\\{cur\_mod}=\\{quote}$ \1\&{then}\5
+\\{get\_next}\6
+\4\&{else} \&{if} $\\{cur\_mod}\L\\{suffix\_count}$ \1\&{then}\5
+$\\{cur\_sym}\K\\{suffix\_base}-1+\\{cur\_mod}$;\2\2\6
+\&{end}\par
+\U685.\fi
+
+\M691. Here is a routine that's used whenever a token will be redefined. If
+the user's token is unredefinable, the `\\{frozen\_inaccessible}' token is
+substituted; the latter is redefinable but essentially impossible to use,
+hence \MF's tables won't get fouled up.
+
+\Y\P\4\&{procedure}\1\ \37\\{get\_symbol};\C{sets \\{cur\_sym} to a safe
+symbol}\6
+\4\&{label} \37\\{restart};\2\6
+\&{begin} \37\\{restart}: \37\\{get\_next};\6
+\&{if} $(\\{cur\_sym}=0)\V(\\{cur\_sym}>\\{frozen\_inaccessible})$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Missing\ symbolic\ token\ inserted"})$;\5
+$\\{help3}(\.{"Sorry:\ You\ can\'t\ redefine\ a\ number,\ string,\ or\
+expr."})$\6
+$(\.{"I\'ve\ inserted\ an\ inaccessible\ symbol\ so\ that\ your"})$\6
+$(\.{"definition\ will\ be\ completed\ without\ mixing\ me\ up\ too\
+badly."})$;\6
+\&{if} $\\{cur\_sym}>0$ \1\&{then}\5
+$\\{help\_line}[2]\K\.{"Sorry:\ You\ can\'t\ redefine\ my\ error-recovery\
+tokens."}$\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{string\_token}$ \1\&{then}\5
+$\\{delete\_str\_ref}(\\{cur\_mod})$;\2\2\6
+$\\{cur\_sym}\K\\{frozen\_inaccessible}$;\5
+\\{ins\_error};\5
+\&{goto} \37\\{restart};\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M692. Before we actually redefine a symbolic token, we need to clear away its
+former value, if it was a variable. The following stronger version of
+\\{get\_symbol} does that.
+
+\Y\P\4\&{procedure}\1\ \37\\{get\_clear\_symbol};\2\6
+\&{begin} \37\\{get\_symbol};\5
+$\\{clear\_symbol}(\\{cur\_sym},\39\\{false})$;\6
+\&{end};\par
+\fi
+
+\M693. Here's another little subroutine; it checks that an equals sign
+or assignment sign comes along at the proper place in a macro definition.
+
+\Y\P\4\&{procedure}\1\ \37\\{check\_equals};\2\6
+\&{begin} \37\&{if} $\\{cur\_cmd}\I\\{equals}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}\I\\{assignment}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{"="})$;\6
+$\\{help5}(\.{"The\ next\ thing\ in\ this\ \`def\'\ should\ have\ been\ \`=%
+\',"})$\6
+$(\.{"because\ I\'ve\ already\ looked\ at\ the\ definition\ heading."})$\6
+$(\.{"But\ don\'t\ worry;\ I\'ll\ pretend\ that\ an\ equals\ sign"})$\6
+$(\.{"was\ present.\ Everything\ from\ here\ to\ \`enddef\'"})$\6
+$(\.{"will\ be\ the\ replacement\ text\ of\ this\ macro."})$;\5
+\\{back\_error};\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M694. A \&{primarydef}, \&{secondarydef}, or \&{tertiarydef} is rather easily
+handled now that we have \\{scan\_toks}. In this case there are
+two parameters, which will be \.{EXPR0} and \.{EXPR1} (i.e.,
+\\{expr\_base} and $\\{expr\_base}+1$).
+
+\Y\P\4\&{procedure}\1\ \37\\{make\_op\_def};\6
+\4\&{var} \37\|m: \37\\{command\_code};\C{the type of definition}\6
+$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{for list manipulation}\2\6
+\&{begin} \37$\|m\K\\{cur\_mod}$;\6
+\\{get\_symbol};\5
+$\|q\K\\{get\_node}(\\{token\_node\_size})$;\5
+$\\{info}(\|q)\K\\{cur\_sym}$;\5
+$\\{value}(\|q)\K\\{expr\_base}$;\6
+\\{get\_clear\_symbol};\5
+$\\{warning\_info}\K\\{cur\_sym}$;\6
+\\{get\_symbol};\5
+$\|p\K\\{get\_node}(\\{token\_node\_size})$;\5
+$\\{info}(\|p)\K\\{cur\_sym}$;\5
+$\\{value}(\|p)\K\\{expr\_base}+1$;\5
+$\\{link}(\|p)\K\|q$;\6
+\\{get\_next};\5
+\\{check\_equals};\6
+$\\{scanner\_status}\K\\{op\_defining}$;\5
+$\|q\K\\{get\_avail}$;\5
+$\\{ref\_count}(\|q)\K\\{null}$;\5
+$\|r\K\\{get\_avail}$;\5
+$\\{link}(\|q)\K\|r$;\5
+$\\{info}(\|r)\K\\{general\_macro}$;\5
+$\\{link}(\|r)\K\\{scan\_toks}(\\{macro\_def},\39\|p,\39\\{null},\390)$;\5
+$\\{scanner\_status}\K\\{normal}$;\5
+$\\{eq\_type}(\\{warning\_info})\K\|m$;\5
+$\\{equiv}(\\{warning\_info})\K\|q$;\5
+\\{get\_x\_next};\6
+\&{end};\par
+\fi
+
+\M695. Parameters to macros are introduced by the keywords \&{expr},
+\&{suffix}, \&{text}, \&{primary}, \&{secondary}, and \&{tertiary}.
+
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"expr"},\39\\{param\_type},\39\\{expr\_base})$;\6
+$\\{primitive}(\.{"suffix"},\39\\{param\_type},\39\\{suffix\_base})$;\6
+$\\{primitive}(\.{"text"},\39\\{param\_type},\39\\{text\_base})$;\6
+$\\{primitive}(\.{"primary"},\39\\{param\_type},\39\\{primary\_macro})$;\6
+$\\{primitive}(\.{"secondary"},\39\\{param\_type},\39\\{secondary\_macro})$;\6
+$\\{primitive}(\.{"tertiary"},\39\\{param\_type},\39\\{tertiary\_macro})$;\par
+\fi
+
+\M696. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{param\_type}: \37\&{if} $\|m\G\\{expr\_base}$ \1\&{then}\6
+\&{if} $\|m=\\{expr\_base}$ \1\&{then}\5
+$\\{print}(\.{"expr"})$\6
+\4\&{else} \&{if} $\|m=\\{suffix\_base}$ \1\&{then}\5
+$\\{print}(\.{"suffix"})$\6
+\4\&{else} $\\{print}(\.{"text"})$\2\2\6
+\4\&{else} \&{if} $\|m<\\{secondary\_macro}$ \1\&{then}\5
+$\\{print}(\.{"primary"})$\6
+\4\&{else} \&{if} $\|m=\\{secondary\_macro}$ \1\&{then}\5
+$\\{print}(\.{"secondary"})$\6
+\4\&{else} $\\{print}(\.{"tertiary"})$;\2\2\2\par
+\fi
+
+\M697. Let's turn next to the more complex processing associated with \&{def}
+and \&{vardef}. When the following procedure is called, \\{cur\_mod}
+should be either \\{start\_def} or \\{var\_def}.
+
+\Y\P\hbox{\4}\X1032:Declare the procedure called \\{check\_delimiter}\X\6
+\hbox{\4}\X1011:Declare the function called \\{scan\_declared\_variable}\X\6
+\4\&{procedure}\1\ \37\\{scan\_def};\6
+\4\&{var} \37\|m: \37$\\{start\_def}\to\\{var\_def}$;\C{the type of definition}%
+\6
+\|n: \37$0\to3$;\C{the number of special suffix parameters}\6
+\|k: \37$0\to\\{param\_size}$;\C{the total number of parameters}\6
+\|c: \37$\\{general\_macro}\to\\{text\_macro}$;\C{the kind of macro we're
+defining}\6
+\|r: \37\\{pointer};\C{parameter-substitution list}\6
+\|q: \37\\{pointer};\C{tail of the macro token list}\6
+\|p: \37\\{pointer};\C{temporary storage}\6
+\\{base}: \37\\{halfword};\C{\\{expr\_base}, \\{suffix\_base}, or \\{text%
+\_base}}\6
+$\\{l\_delim},\39\\{r\_delim}$: \37\\{pointer};\C{matching delimiters}\2\6
+\&{begin} \37$\|m\K\\{cur\_mod}$;\5
+$\|c\K\\{general\_macro}$;\5
+$\\{link}(\\{hold\_head})\K\\{null}$;\6
+$\|q\K\\{get\_avail}$;\5
+$\\{ref\_count}(\|q)\K\\{null}$;\5
+$\|r\K\\{null}$;\6
+\X700:Scan the token or variable to be defined; set \|n, \\{scanner\_status},
+and \\{warning\_info}\X;\6
+$\|k\K\|n$;\6
+\&{if} $\\{cur\_cmd}=\\{left\_delimiter}$ \1\&{then}\5
+\X703:Absorb delimited parameters, putting them into lists \|q and \|r\X;\2\6
+\&{if} $\\{cur\_cmd}=\\{param\_type}$ \1\&{then}\5
+\X705:Absorb undelimited parameters, putting them into list \|r\X;\2\6
+\\{check\_equals};\5
+$\|p\K\\{get\_avail}$;\5
+$\\{info}(\|p)\K\|c$;\5
+$\\{link}(\|q)\K\|p$;\5
+\X698:Attach the replacement text to the tail of node \|p\X;\6
+$\\{scanner\_status}\K\\{normal}$;\5
+\\{get\_x\_next};\6
+\&{end};\par
+\fi
+
+\M698. We don't put `\\{frozen\_end\_group}' into the replacement text of
+a \&{vardef}, because the user may want to redefine `\.{endgroup}'.
+
+\Y\P$\4\X698:Attach the replacement text to the tail of node \|p\X\S$\6
+\&{if} $\|m=\\{start\_def}$ \1\&{then}\5
+$\\{link}(\|p)\K\\{scan\_toks}(\\{macro\_def},\39\|r,\39\\{null},\39\|n)$\6
+\4\&{else} \&{begin} \37$\|q\K\\{get\_avail}$;\5
+$\\{info}(\|q)\K\\{bg\_loc}$;\5
+$\\{link}(\|p)\K\|q$;\5
+$\|p\K\\{get\_avail}$;\5
+$\\{info}(\|p)\K\\{eg\_loc}$;\5
+$\\{link}(\|q)\K\\{scan\_toks}(\\{macro\_def},\39\|r,\39\|p,\39\|n)$;\6
+\&{end};\2\6
+\&{if} $\\{warning\_info}=\\{bad\_vardef}$ \1\&{then}\5
+$\\{flush\_token\_list}(\\{value}(\\{bad\_vardef}))$\2\par
+\U697.\fi
+
+\M699. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{bg\_loc},\39\\{eg\_loc}$: \37$1\to\\{hash\_end}$;\C{hash addresses of `%
+\.{begingroup}' and `\.{endgroup}'}\par
+\fi
+
+\M700. \P$\X700:Scan the token or variable to be defined; set \|n, \\{scanner%
+\_status}, and \\{warning\_info}\X\S$\6
+\&{if} $\|m=\\{start\_def}$ \1\&{then}\6
+\&{begin} \37\\{get\_clear\_symbol};\5
+$\\{warning\_info}\K\\{cur\_sym}$;\5
+\\{get\_next};\5
+$\\{scanner\_status}\K\\{op\_defining}$;\5
+$\|n\K0$;\5
+$\\{eq\_type}(\\{warning\_info})\K\\{defined\_macro}$;\5
+$\\{equiv}(\\{warning\_info})\K\|q$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|p\K\\{scan\_declared\_variable}$;\5
+$\\{flush\_variable}(\\{equiv}(\\{info}(\|p)),\39\\{link}(\|p),\39\\{true})$;\5
+$\\{warning\_info}\K\\{find\_variable}(\|p)$;\5
+$\\{flush\_list}(\|p)$;\6
+\&{if} $\\{warning\_info}=\\{null}$ \1\&{then}\5
+\X701:Change to `\.{a bad variable}'\X;\2\6
+$\\{scanner\_status}\K\\{var\_defining}$;\5
+$\|n\K2$;\6
+\&{if} $\\{cur\_cmd}=\\{macro\_special}$ \1\&{then}\6
+\&{if} $\\{cur\_mod}=\\{macro\_suffix}$ \1\&{then}\C{\.{\AT!\#}}\6
+\&{begin} \37$\|n\K3$;\5
+\\{get\_next};\6
+\&{end};\2\2\6
+$\\{type}(\\{warning\_info})\K\\{unsuffixed\_macro}-2+\|n$;\5
+$\\{value}(\\{warning\_info})\K\|q$;\6
+\&{end}\C{$\\{suffixed\_macro}=\\{unsuffixed\_macro}+1$}\2\par
+\U697.\fi
+
+\M701. \P$\X701:Change to `\.{a bad variable}'\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"This\ variable\ already\ starts\ with\ a\
+macro"})$;\5
+$\\{help2}(\.{"After\ \`vardef\ a\'\ you\ can\'t\ say\ \`vardef\ a.b\'."})$\6
+$(\.{"So\ I\'ll\ have\ to\ discard\ this\ definition."})$;\5
+\\{error};\5
+$\\{warning\_info}\K\\{bad\_vardef}$;\6
+\&{end}\par
+\U700.\fi
+
+\M702. \P$\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}%
+\S$\6
+$\\{name\_type}(\\{bad\_vardef})\K\\{root}$;\5
+$\\{link}(\\{bad\_vardef})\K\\{frozen\_bad\_vardef}$;\5
+$\\{equiv}(\\{frozen\_bad\_vardef})\K\\{bad\_vardef}$;\5
+$\\{eq\_type}(\\{frozen\_bad\_vardef})\K\\{tag\_token}$;\par
+\fi
+
+\M703. \P$\X703:Absorb delimited parameters, putting them into lists \|q and %
+\|r\X\S$\6
+\1\&{repeat} \37$\\{l\_delim}\K\\{cur\_sym}$;\5
+$\\{r\_delim}\K\\{cur\_mod}$;\5
+\\{get\_next};\6
+\&{if} $(\\{cur\_cmd}=\\{param\_type})\W(\\{cur\_mod}\G\\{expr\_base})$ \1%
+\&{then}\5
+$\\{base}\K\\{cur\_mod}$\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"Missing\ parameter\ type;\ \`expr\'%
+\ will\ be\ assumed"})$;\5
+$\\{help1}(\.{"You\ should\'ve\ had\ \`expr\'\ or\ \`suffix\'\ or\ \`text\'\
+here."})$;\5
+\\{back\_error};\5
+$\\{base}\K\\{expr\_base}$;\6
+\&{end};\2\6
+\X704:Absorb parameter tokens for type \\{base}\X;\6
+$\\{check\_delimiter}(\\{l\_delim},\39\\{r\_delim})$;\5
+\\{get\_next};\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{left\_delimiter}$\2\par
+\U697.\fi
+
+\M704. \P$\X704:Absorb parameter tokens for type \\{base}\X\S$\6
+\1\&{repeat} \37$\\{link}(\|q)\K\\{get\_avail}$;\5
+$\|q\K\\{link}(\|q)$;\5
+$\\{info}(\|q)\K\\{base}+\|k$;\6
+\\{get\_symbol};\5
+$\|p\K\\{get\_node}(\\{token\_node\_size})$;\5
+$\\{value}(\|p)\K\\{base}+\|k$;\5
+$\\{info}(\|p)\K\\{cur\_sym}$;\6
+\&{if} $\|k=\\{param\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"parameter\ stack\ size"},\39\\{param\_size})$;\2\6
+$\\{incr}(\|k)$;\5
+$\\{link}(\|p)\K\|r$;\5
+$\|r\K\|p$;\5
+\\{get\_next};\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$\2\par
+\U703.\fi
+
+\M705. \P$\X705:Absorb undelimited parameters, putting them into list \|r\X\S$\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{token\_node\_size})$;\6
+\&{if} $\\{cur\_mod}<\\{expr\_base}$ \1\&{then}\6
+\&{begin} \37$\|c\K\\{cur\_mod}$;\5
+$\\{value}(\|p)\K\\{expr\_base}+\|k$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{value}(\|p)\K\\{cur\_mod}+\|k$;\6
+\&{if} $\\{cur\_mod}=\\{expr\_base}$ \1\&{then}\5
+$\|c\K\\{expr\_macro}$\6
+\4\&{else} \&{if} $\\{cur\_mod}=\\{suffix\_base}$ \1\&{then}\5
+$\|c\K\\{suffix\_macro}$\6
+\4\&{else} $\|c\K\\{text\_macro}$;\2\2\6
+\&{end};\2\6
+\&{if} $\|k=\\{param\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"parameter\ stack\ size"},\39\\{param\_size})$;\2\6
+$\\{incr}(\|k)$;\5
+\\{get\_symbol};\5
+$\\{info}(\|p)\K\\{cur\_sym}$;\5
+$\\{link}(\|p)\K\|r$;\5
+$\|r\K\|p$;\5
+\\{get\_next};\6
+\&{if} $\|c=\\{expr\_macro}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}=\\{of\_token}$ \1\&{then}\6
+\&{begin} \37$\|c\K\\{of\_macro}$;\5
+$\|p\K\\{get\_node}(\\{token\_node\_size})$;\6
+\&{if} $\|k=\\{param\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"parameter\ stack\ size"},\39\\{param\_size})$;\2\6
+$\\{value}(\|p)\K\\{expr\_base}+\|k$;\5
+\\{get\_symbol};\5
+$\\{info}(\|p)\K\\{cur\_sym}$;\5
+$\\{link}(\|p)\K\|r$;\5
+$\|r\K\|p$;\5
+\\{get\_next};\6
+\&{end};\2\2\6
+\&{end}\par
+\U697.\fi
+
+\N706. \[35] Expanding the next token.
+Only a few command codes $<\\{min\_command}$ can possibly be returned by
+\\{get\_next}; in increasing order, they are
+\\{if\_test}, \\{fi\_or\_else}, \\{input}, \\{iteration}, \\{repeat\_loop},
+\\{exit\_test}, \\{relax}, \\{scan\_tokens}, \\{expand\_after}, and \\{defined%
+\_macro}.
+
+\MF\ usually gets the next token of input by saying \\{get\_x\_next}. This is
+like \\{get\_next} except that it keeps getting more tokens until
+finding $\\{cur\_cmd}\G\\{min\_command}$. In other words, \\{get\_x\_next}
+expands
+macros and removes conditionals or iterations or input instructions that
+might be present.
+
+It follows that \\{get\_x\_next} might invoke itself recursively. In fact,
+there is massive recursion, since macro expansion can involve the
+scanning of arbitrarily complex expressions, which in turn involve
+macro expansion and conditionals, etc.
+
+Therefore it's necessary to declare a whole bunch of \\{forward}
+procedures at this point, and to insert some other procedures
+that will be invoked by \\{get\_x\_next}.
+
+\Y\P\4\&{procedure}\1\ \37\\{scan\_primary};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{scan\_secondary};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{scan\_tertiary};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{scan\_expression};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{scan\_suffix};\5
+\\{forward};\5
+\hbox{\2}\6
+\hbox{\4}\X720:Declare the procedure called \\{macro\_call}\X\6
+\4\&{procedure}\1\ \37\\{get\_boolean};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{pass\_text};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{conditional};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{start\_input};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{begin\_iteration};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{resume\_iteration};\5
+\\{forward}; \hbox{\2} \6
+\4\&{procedure}\1\ \37\\{stop\_iteration};\5
+\\{forward};\5
+\hbox{\2}\par
+\fi
+
+\M707. An auxiliary subroutine called \\{expand} is used by \\{get\_x\_next}
+when it has to do exotic expansion commands.
+
+\Y\P\4\&{procedure}\1\ \37\\{expand};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{for list manipulation}\6
+\|k: \37\\{integer};\C{something that we hope is $\L\\{buf\_size}$}\6
+\|j: \37\\{pool\_pointer};\C{index into \\{str\_pool}}\2\6
+\&{begin} \37\&{if} $\\{internal}[\\{tracing\_commands}]>\\{unity}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}\I\\{defined\_macro}$ \1\&{then}\5
+\\{show\_cur\_cmd\_mod};\2\2\6
+\&{case} $\\{cur\_cmd}$ \1\&{of}\6
+\4\\{if\_test}: \37\\{conditional};\C{this procedure is discussed in Part 36
+below}\6
+\4\\{fi\_or\_else}: \37\X751:Terminate the current conditional and skip to %
+\&{fi}\X;\6
+\4\\{input}: \37\X711:Initiate or terminate input from a file\X;\6
+\4\\{iteration}: \37\&{if} $\\{cur\_mod}=\\{end\_for}$ \1\&{then}\5
+\X708:Scold the user for having an extra \&{endfor}\X\6
+\4\&{else} \\{begin\_iteration};\C{this procedure is discussed in Part 37
+below}\2\6
+\4\\{repeat\_loop}: \37\X712:Repeat a loop\X;\6
+\4\\{exit\_test}: \37\X713:Exit a loop if the proper time has come\X;\6
+\4\\{relax}: \37\\{do\_nothing};\6
+\4\\{expand\_after}: \37\X715:Expand the token after the next token\X;\6
+\4\\{scan\_tokens}: \37\X716:Put a string into the input buffer\X;\6
+\4\\{defined\_macro}: \37$\\{macro\_call}(\\{cur\_mod},\39\\{null},\39\\{cur%
+\_sym})$;\2\6
+\&{end};\C{there are no other cases}\6
+\&{end};\par
+\fi
+
+\M708. \P$\X708:Scold the user for having an extra \&{endfor}\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Extra\ \`endfor\'"})$;\5
+$\\{help2}(\.{"I\'m\ not\ currently\ working\ on\ a\ for\ loop,"})$\6
+$(\.{"so\ I\ had\ better\ not\ try\ to\ end\ anything."})$;\6
+\\{error};\6
+\&{end}\par
+\U707.\fi
+
+\M709. The processing of \&{input} involves the \\{start\_input} subroutine,
+which will be declared later; the processing of \&{endinput} is trivial.
+
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"input"},\39\\{input},\390)$;\6
+$\\{primitive}(\.{"endinput"},\39\\{input},\391)$;\par
+\fi
+
+\M710. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{input}: \37\&{if} $\|m=0$ \1\&{then}\5
+$\\{print}(\.{"input"})$\ \&{else} $\\{print}(\.{"endinput"})$;\2\par
+\fi
+
+\M711. \P$\X711:Initiate or terminate input from a file\X\S$\6
+\&{if} $\\{cur\_mod}>0$ \1\&{then}\5
+$\\{force\_eof}\K\\{true}$\6
+\4\&{else} \\{start\_input}\2\par
+\U707.\fi
+
+\M712. We'll discuss the complicated parts of loop operations later. For now
+it suffices to know that there's a global variable called \\{loop\_ptr}
+that will be \\{null} if no loop is in progress.
+
+\Y\P$\4\X712:Repeat a loop\X\S$\6
+\&{begin} \37\&{while} $\\{token\_state}\W(\\{loc}=\\{null})$ \1\&{do}\5
+\\{end\_token\_list};\C{conserve stack space}\2\6
+\&{if} $\\{loop\_ptr}=\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Lost\ loop"})$;\5
+$\\{help2}(\.{"I\'m\ confused;\ after\ exiting\ from\ a\ loop,\ I\ still\
+seem"})$\6
+$(\.{"to\ want\ to\ repeat\ it.\ I\'ll\ try\ to\ forget\ the\ problem."})$;\6
+\\{error};\6
+\&{end}\6
+\4\&{else} \\{resume\_iteration};\C{this procedure is in Part 37 below}\2\6
+\&{end}\par
+\U707.\fi
+
+\M713. \P$\X713:Exit a loop if the proper time has come\X\S$\6
+\&{begin} \37\\{get\_boolean};\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>\\{unity}$ \1\&{then}\5
+$\\{show\_cmd\_mod}(\\{nullary},\39\\{cur\_exp})$;\2\6
+\&{if} $\\{cur\_exp}=\\{true\_code}$ \1\&{then}\6
+\&{if} $\\{loop\_ptr}=\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"No\ loop\ is\ in\ progress"})$;\5
+$\\{help1}(\.{"Why\ say\ \`exitif\'\ when\ there\'s\ nothing\ to\ exit\
+from?"})$;\6
+\&{if} $\\{cur\_cmd}=\\{semicolon}$ \1\&{then}\5
+\\{error}\ \&{else} \\{back\_error};\2\6
+\&{end}\6
+\4\&{else} \X714:Exit prematurely from an iteration\X\2\6
+\4\&{else} \&{if} $\\{cur\_cmd}\I\\{semicolon}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{";"})$;\6
+$\\{help2}(\.{"After\ \`exitif\ <boolean\ exp>\'\ I\ expect\ to\ see\ a\
+semicolon."})$\6
+$(\.{"I\ shall\ pretend\ that\ one\ was\ there."})$;\5
+\\{back\_error};\6
+\&{end};\2\2\6
+\&{end}\par
+\U707.\fi
+
+\M714. Here we use the fact that \\{forever\_text} is the only \\{token\_type}
+that
+is less than \\{loop\_text}.
+
+\Y\P$\4\X714:Exit prematurely from an iteration\X\S$\6
+\&{begin} \37$\|p\K\\{null}$;\6
+\1\&{repeat} \37\&{if} $\\{file\_state}$ \1\&{then}\5
+\\{end\_file\_reading}\6
+\4\&{else} \&{begin} \37\&{if} $\\{token\_type}\L\\{loop\_text}$ \1\&{then}\5
+$\|p\K\\{start}$;\2\6
+\\{end\_token\_list};\6
+\&{end};\2\6
+\4\&{until}\5
+$\|p\I\\{null}$;\2\6
+\&{if} $\|p\I\\{info}(\\{loop\_ptr})$ \1\&{then}\5
+$\\{fatal\_error}(\.{"***\ (loop\ confusion)"})$;\2\6
+\\{stop\_iteration};\C{this procedure is in Part 37 below}\6
+\&{end}\par
+\U713.\fi
+
+\M715. \P$\X715:Expand the token after the next token\X\S$\6
+\&{begin} \37\\{get\_next};\5
+$\|p\K\\{cur\_tok}$;\5
+\\{get\_next};\6
+\&{if} $\\{cur\_cmd}<\\{min\_command}$ \1\&{then}\5
+\\{expand}\6
+\4\&{else} \\{back\_input};\2\6
+$\\{back\_list}(\|p)$;\6
+\&{end}\par
+\U707.\fi
+
+\M716. \P$\X716:Put a string into the input buffer\X\S$\6
+\&{begin} \37\\{get\_x\_next};\5
+\\{scan\_primary};\6
+\&{if} $\\{cur\_type}\I\\{string\_type}$ \1\&{then}\6
+\&{begin} \37$\\{disp\_err}(\\{null},\39\.{"Not\ a\ string"})$;\5
+$\\{help2}(\.{"I\'m\ going\ to\ flush\ this\ expression,\ since"})$\6
+$(\.{"scantokens\ should\ be\ followed\ by\ a\ known\ string."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\\{back\_input};\6
+\&{if} $\\{length}(\\{cur\_exp})>0$ \1\&{then}\5
+\X717:Pretend we're reading a new one-line file\X;\2\6
+\&{end};\2\6
+\&{end}\par
+\U707.\fi
+
+\M717. \P$\X717:Pretend we're reading a new one-line file\X\S$\6
+\&{begin} \37\\{begin\_file\_reading};\5
+$\\{name}\K2$;\5
+$\|k\K\\{first}+\\{length}(\\{cur\_exp})$;\6
+\&{if} $\|k\G\\{max\_buf\_stack}$ \1\&{then}\6
+\&{begin} \37\&{if} $\|k\G\\{buf\_size}$ \1\&{then}\6
+\&{begin} \37$\\{max\_buf\_stack}\K\\{buf\_size}$;\5
+$\\{overflow}(\.{"buffer\ size"},\39\\{buf\_size})$;\6
+\&{end};\2\6
+$\\{max\_buf\_stack}\K\|k+1$;\6
+\&{end};\2\6
+$\|j\K\\{str\_start}[\\{cur\_exp}]$;\5
+$\\{limit}\K\|k$;\6
+\&{while} $\\{first}<\\{limit}$ \1\&{do}\6
+\&{begin} \37$\\{buffer}[\\{first}]\K\\{so}(\\{str\_pool}[\|j])$;\5
+$\\{incr}(\|j)$;\5
+$\\{incr}(\\{first})$;\6
+\&{end};\2\6
+$\\{buffer}[\\{limit}]\K\.{"\%"}$;\5
+$\\{first}\K\\{limit}+1$;\5
+$\\{loc}\K\\{start}$;\5
+$\\{flush\_cur\_exp}(0)$;\6
+\&{end}\par
+\U716.\fi
+
+\M718. Here finally is \\{get\_x\_next}.
+
+The expression scanning routines to be considered later
+communicate via the global quantities \\{cur\_type} and \\{cur\_exp};
+we must be very careful to save and restore these quantities while
+macros are being expanded.
+
+\Y\P\4\&{procedure}\1\ \37\\{get\_x\_next};\6
+\4\&{var} \37\\{save\_exp}: \37\\{pointer};\C{a capsule to save \\{cur\_type}
+and \\{cur\_exp}}\2\6
+\&{begin} \37\\{get\_next};\6
+\&{if} $\\{cur\_cmd}<\\{min\_command}$ \1\&{then}\6
+\&{begin} \37$\\{save\_exp}\K\\{stash\_cur\_exp}$;\6
+\1\&{repeat} \37\&{if} $\\{cur\_cmd}=\\{defined\_macro}$ \1\&{then}\5
+$\\{macro\_call}(\\{cur\_mod},\39\\{null},\39\\{cur\_sym})$\6
+\4\&{else} \\{expand};\2\6
+\\{get\_next};\6
+\4\&{until}\5
+$\\{cur\_cmd}\G\\{min\_command}$;\2\6
+$\\{unstash\_cur\_exp}(\\{save\_exp})$;\C{that restores \\{cur\_type} and %
+\\{cur\_exp}}\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M719. Now let's consider the \\{macro\_call} procedure, which is used to start
+up
+all user-defined macros. Since the arguments to a macro might be expressions,
+\\{macro\_call} is recursive.
+
+The first parameter to \\{macro\_call} points to the reference count of the
+token list that defines the macro. The second parameter contains any
+arguments that have already been parsed (see below). The third parameter
+points to the symbolic token that names the macro. If the third parameter
+is \\{null}, the macro was defined by \&{vardef}, so its name can be
+reconstructed from the prefix and ``at'' arguments found within the
+second parameter.
+
+What is this second parameter? It's simply a linked list of one-word items,
+whose \\{info} fields point to the arguments. In other words, if $\\{arg%
+\_list}=\\{null}$,
+no arguments have been scanned yet; otherwise $\\{info}(\\{arg\_list})$ points
+to
+the first scanned argument, and $\\{link}(\\{arg\_list})$ points to the list of
+further arguments (if any).
+
+Arguments of type \&{expr} are so-called capsules, which we will
+discuss later when we concentrate on expressions; they can be
+recognized easily because their \\{link} field is \\{void}. Arguments of type
+\&{suffix} and \&{text} are token lists without reference counts.
+
+\fi
+
+\M720. After argument scanning is complete, the arguments are moved to the
+\\{param\_stack}. (They can't be put on that stack any sooner, because
+the stack is growing and shrinking in unpredictable ways as more arguments
+are being acquired.) Then the macro body is fed to the scanner; i.e.,
+the replacement text of the macro is placed at the top of the \MF's
+input stack, so that \\{get\_next} will proceed to read it next.
+
+\Y\P$\4\X720:Declare the procedure called \\{macro\_call}\X\S$\6
+\hbox{\4}\X722:Declare the procedure called \\{print\_macro\_name}\X\6
+\hbox{\4}\X723:Declare the procedure called \\{print\_arg}\X\6
+\hbox{\4}\X730:Declare the procedure called \\{scan\_text\_arg}\X\6
+\4\&{procedure}\1\ \37$\\{macro\_call}(\\{def\_ref},\39\\{arg\_list},\39%
+\\{macro\_name}:\\{pointer})$;\C{invokes a user-defined control sequence}\6
+\4\&{label} \37\\{found};\6
+\4\&{var} \37\|r: \37\\{pointer};\C{current node in the macro's token list}\6
+$\|p,\39\|q$: \37\\{pointer};\C{for list manipulation}\6
+\|n: \37\\{integer};\C{the number of arguments}\6
+$\\{l\_delim},\39\\{r\_delim}$: \37\\{pointer};\C{a delimiter pair}\6
+\\{tail}: \37\\{pointer};\C{tail of the argument list}\2\6
+\&{begin} \37$\|r\K\\{link}(\\{def\_ref})$;\5
+$\\{add\_mac\_ref}(\\{def\_ref})$;\6
+\&{if} $\\{arg\_list}=\\{null}$ \1\&{then}\5
+$\|n\K0$\6
+\4\&{else} \X724:Determine the number \|n of arguments already supplied, and
+set \\{tail} to the tail of \\{arg\_list}\X;\2\6
+\&{if} $\\{internal}[\\{tracing\_macros}]>0$ \1\&{then}\5
+\X721:Show the text of the macro being expanded, and the existing arguments\X;%
+\2\6
+\X725:Scan the remaining arguments, if any; set \|r to the first token of the
+replacement text\X;\6
+\X736:Feed the arguments and replacement text to the scanner\X;\6
+\&{end};\par
+\U706.\fi
+
+\M721. \P$\X721:Show the text of the macro being expanded, and the existing
+arguments\X\S$\6
+\&{begin} \37\\{begin\_diagnostic};\5
+\\{print\_ln};\5
+$\\{print\_macro\_name}(\\{arg\_list},\39\\{macro\_name})$;\6
+\&{if} $\|n=3$ \1\&{then}\5
+$\\{print}(\.{"@\#"})$;\C{indicate a suffixed macro}\2\6
+$\\{show\_macro}(\\{def\_ref},\39\\{null},\39100000)$;\6
+\&{if} $\\{arg\_list}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\|n\K0$;\5
+$\|p\K\\{arg\_list}$;\6
+\1\&{repeat} \37$\|q\K\\{info}(\|p)$;\5
+$\\{print\_arg}(\|q,\39\|n,\390)$;\5
+$\\{incr}(\|n)$;\5
+$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\|p=\\{null}$;\2\6
+\&{end};\2\6
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\par
+\U720.\fi
+
+\M722. \P$\X722:Declare the procedure called \\{print\_macro\_name}\X\S$\6
+\4\&{procedure}\1\ \37$\\{print\_macro\_name}(\|a,\39\|n:\\{pointer})$;\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{they traverse the first part of %
+\|a}\2\6
+\&{begin} \37\&{if} $\|n\I\\{null}$ \1\&{then}\5
+$\\{slow\_print}(\\{text}(\|n))$\6
+\4\&{else} \&{begin} \37$\|p\K\\{info}(\|a)$;\6
+\&{if} $\|p=\\{null}$ \1\&{then}\5
+$\\{slow\_print}(\\{text}(\\{info}(\\{info}(\\{link}(\|a)))))$\6
+\4\&{else} \&{begin} \37$\|q\K\|p$;\6
+\&{while} $\\{link}(\|q)\I\\{null}$ \1\&{do}\5
+$\|q\K\\{link}(\|q)$;\2\6
+$\\{link}(\|q)\K\\{info}(\\{link}(\|a))$;\5
+$\\{show\_token\_list}(\|p,\39\\{null},\391000,\390)$;\5
+$\\{link}(\|q)\K\\{null}$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\par
+\U720.\fi
+
+\M723. \P$\X723:Declare the procedure called \\{print\_arg}\X\S$\6
+\4\&{procedure}\1\ \37$\\{print\_arg}(\|q:\\{pointer};\,\35\|n:\\{integer};\,%
+\35\|b:\\{pointer})$;\2\6
+\&{begin} \37\&{if} $\\{link}(\|q)=\\{void}$ \1\&{then}\5
+$\\{print\_nl}(\.{"(EXPR"})$\6
+\4\&{else} \&{if} $(\|b<\\{text\_base})\W(\|b\I\\{text\_macro})$ \1\&{then}\5
+$\\{print\_nl}(\.{"(SUFFIX"})$\6
+\4\&{else} $\\{print\_nl}(\.{"(TEXT"})$;\2\2\6
+$\\{print\_int}(\|n)$;\5
+$\\{print}(\.{")<-"})$;\6
+\&{if} $\\{link}(\|q)=\\{void}$ \1\&{then}\5
+$\\{print\_exp}(\|q,\391)$\6
+\4\&{else} $\\{show\_token\_list}(\|q,\39\\{null},\391000,\390)$;\2\6
+\&{end};\par
+\U720.\fi
+
+\M724. \P$\X724:Determine the number \|n of arguments already supplied, and set
+\\{tail} to the tail of \\{arg\_list}\X\S$\6
+\&{begin} \37$\|n\K1$;\5
+$\\{tail}\K\\{arg\_list}$;\6
+\&{while} $\\{link}(\\{tail})\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\\{incr}(\|n)$;\5
+$\\{tail}\K\\{link}(\\{tail})$;\6
+\&{end};\2\6
+\&{end}\par
+\U720.\fi
+
+\M725. \P$\X725:Scan the remaining arguments, if any; set \|r to the first
+token of the replacement text\X\S$\6
+$\\{cur\_cmd}\K\\{comma}+1$;\C{anything $\I\\{comma}$ will do}\6
+\&{while} $\\{info}(\|r)\G\\{expr\_base}$ \1\&{do}\6
+\&{begin} \37\X726:Scan the delimited argument represented by $\\{info}(\|r)$%
+\X;\6
+$\|r\K\\{link}(\|r)$;\6
+\&{end};\2\6
+\&{if} $\\{cur\_cmd}=\\{comma}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Too\ many\ arguments\ to\ "})$;\5
+$\\{print\_macro\_name}(\\{arg\_list},\39\\{macro\_name})$;\5
+$\\{print\_char}(\.{";"})$;\5
+$\\{print\_nl}(\.{"\ \ Missing\ \`"})$;\5
+$\\{slow\_print}(\\{text}(\\{r\_delim}))$;\5
+$\\{print}(\.{"\'\ has\ been\ inserted"})$;\5
+$\\{help3}(\.{"I\'m\ going\ to\ assume\ that\ the\ comma\ I\ just\ read\ was\
+a"})$\6
+$(\.{"right\ delimiter,\ and\ then\ I\'ll\ begin\ expanding\ the\ macro."})$\6
+$(\.{"You\ might\ want\ to\ delete\ some\ tokens\ before\ continuing."})$;\5
+\\{error};\6
+\&{end};\2\6
+\&{if} $\\{info}(\|r)\I\\{general\_macro}$ \1\&{then}\5
+\X733:Scan undelimited argument(s)\X;\2\6
+$\|r\K\\{link}(\|r)$\par
+\U720.\fi
+
+\M726. At this point, the reader will find it advisable to review the
+explanation
+of token list format that was presented earlier, paying special attention to
+the conventions that apply only at the beginning of a macro's token list.
+
+On the other hand, the reader will have to take the expression-parsing
+aspects of the following program on faith; we will explain \\{cur\_type}
+and \\{cur\_exp} later. (Several things in this program depend on each other,
+and it's necessary to jump into the circle somewhere.)
+
+\Y\P$\4\X726:Scan the delimited argument represented by $\\{info}(\|r)$\X\S$\6
+\&{if} $\\{cur\_cmd}\I\\{comma}$ \1\&{then}\6
+\&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}\I\\{left\_delimiter}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Missing\ argument\ to\ "})$;\5
+$\\{print\_macro\_name}(\\{arg\_list},\39\\{macro\_name})$;\5
+$\\{help3}(\.{"That\ macro\ has\ more\ parameters\ than\ you\ thought."})$\6
+$(\.{"I\'ll\ continue\ by\ pretending\ that\ each\ missing\ argument"})$\6
+$(\.{"is\ either\ zero\ or\ null."})$;\6
+\&{if} $\\{info}(\|r)\G\\{suffix\_base}$ \1\&{then}\6
+\&{begin} \37$\\{cur\_exp}\K\\{null}$;\5
+$\\{cur\_type}\K\\{token\_list}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{cur\_exp}\K0$;\5
+$\\{cur\_type}\K\\{known}$;\6
+\&{end};\2\6
+\\{back\_error};\5
+$\\{cur\_cmd}\K\\{right\_delimiter}$;\5
+\&{goto} \37\\{found};\6
+\&{end};\2\6
+$\\{l\_delim}\K\\{cur\_sym}$;\5
+$\\{r\_delim}\K\\{cur\_mod}$;\6
+\&{end};\2\6
+\X729:Scan the argument represented by $\\{info}(\|r)$\X;\6
+\&{if} $\\{cur\_cmd}\I\\{comma}$ \1\&{then}\5
+\X727:Check that the proper right delimiter was present\X;\2\6
+\4\\{found}: \37\X728:Append the current expression to \\{arg\_list}\X\par
+\U725.\fi
+
+\M727. \P$\X727:Check that the proper right delimiter was present\X\S$\6
+\&{if} $(\\{cur\_cmd}\I\\{right\_delimiter})\V(\\{cur\_mod}\I\\{l\_delim})$ \1%
+\&{then}\6
+\&{if} $\\{info}(\\{link}(\|r))\G\\{expr\_base}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{","})$;\5
+$\\{help3}(\.{"I\'ve\ finished\ reading\ a\ macro\ argument\ and\ am\ about\
+to"})$\6
+$(\.{"read\ another;\ the\ arguments\ weren\'t\ delimited\ correctly."})$\6
+$(\.{"You\ might\ want\ to\ delete\ some\ tokens\ before\ continuing."})$;\5
+\\{back\_error};\5
+$\\{cur\_cmd}\K\\{comma}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{missing\_err}(\\{text}(\\{r\_delim}))$;\5
+$\\{help2}(\.{"I\'ve\ gotten\ to\ the\ end\ of\ the\ macro\ parameter\
+list."})$\6
+$(\.{"You\ might\ want\ to\ delete\ some\ tokens\ before\ continuing."})$;\5
+\\{back\_error};\6
+\&{end}\2\2\par
+\U726.\fi
+
+\M728. A \&{suffix} or \&{text} parameter will be have been scanned as
+a token list pointed to by \\{cur\_exp}, in which case we will have
+$\\{cur\_type}=\\{token\_list}$.
+
+\Y\P$\4\X728:Append the current expression to \\{arg\_list}\X\S$\6
+\&{begin} \37$\|p\K\\{get\_avail}$;\6
+\&{if} $\\{cur\_type}=\\{token\_list}$ \1\&{then}\5
+$\\{info}(\|p)\K\\{cur\_exp}$\6
+\4\&{else} $\\{info}(\|p)\K\\{stash\_cur\_exp}$;\2\6
+\&{if} $\\{internal}[\\{tracing\_macros}]>0$ \1\&{then}\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_arg}(\\{info}(\|p),\39\|n,\39\\{info}(\|r))$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end};\2\6
+\&{if} $\\{arg\_list}=\\{null}$ \1\&{then}\5
+$\\{arg\_list}\K\|p$\6
+\4\&{else} $\\{link}(\\{tail})\K\|p$;\2\6
+$\\{tail}\K\|p$;\5
+$\\{incr}(\|n)$;\6
+\&{end}\par
+\Us726\ET733.\fi
+
+\M729. \P$\X729:Scan the argument represented by $\\{info}(\|r)$\X\S$\6
+\&{if} $\\{info}(\|r)\G\\{text\_base}$ \1\&{then}\5
+$\\{scan\_text\_arg}(\\{l\_delim},\39\\{r\_delim})$\6
+\4\&{else} \&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{info}(\|r)\G\\{suffix\_base}$ \1\&{then}\5
+\\{scan\_suffix}\6
+\4\&{else} \\{scan\_expression};\2\6
+\&{end}\2\par
+\U726.\fi
+
+\M730. The parameters to \\{scan\_text\_arg} are either a pair of delimiters
+or zero; the latter case is for undelimited text arguments, which
+end with the first semicolon or \&{endgroup} or \&{end} that is not
+contained in a group.
+
+\Y\P$\4\X730:Declare the procedure called \\{scan\_text\_arg}\X\S$\6
+\4\&{procedure}\1\ \37$\\{scan\_text\_arg}(\\{l\_delim},\39\\{r\_delim}:%
+\\{pointer})$;\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\\{balance}: \37\\{integer};\C{excess of \\{l\_delim} over \\{r%
+\_delim}}\6
+\|p: \37\\{pointer};\C{list tail}\2\6
+\&{begin} \37$\\{warning\_info}\K\\{l\_delim}$;\5
+$\\{scanner\_status}\K\\{absorbing}$;\5
+$\|p\K\\{hold\_head}$;\5
+$\\{balance}\K1$;\5
+$\\{link}(\\{hold\_head})\K\\{null}$;\6
+\~ \1\&{loop}\ \&{begin} \37\\{get\_next};\6
+\&{if} $\\{l\_delim}=0$ \1\&{then}\5
+\X732:Adjust the balance for an undelimited argument; \&{goto} \\{done} if done%
+\X\6
+\4\&{else} \X731:Adjust the balance for a delimited argument; \&{goto} \\{done}
+if done\X;\2\6
+$\\{link}(\|p)\K\\{cur\_tok}$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\4\\{done}: \37$\\{cur\_exp}\K\\{link}(\\{hold\_head})$;\5
+$\\{cur\_type}\K\\{token\_list}$;\5
+$\\{scanner\_status}\K\\{normal}$;\6
+\&{end};\par
+\U720.\fi
+
+\M731. \P$\X731:Adjust the balance for a delimited argument; \&{goto} \\{done}
+if done\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_cmd}=\\{right\_delimiter}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{cur\_mod}=\\{l\_delim}$ \1\&{then}\6
+\&{begin} \37$\\{decr}(\\{balance})$;\6
+\&{if} $\\{balance}=0$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{end};\2\6
+\&{end}\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{left\_delimiter}$ \1\&{then}\6
+\&{if} $\\{cur\_mod}=\\{r\_delim}$ \1\&{then}\5
+$\\{incr}(\\{balance})$;\2\2\2\6
+\&{end}\par
+\U730.\fi
+
+\M732. \P$\X732:Adjust the balance for an undelimited argument; \&{goto} %
+\\{done} if done\X\S$\6
+\&{begin} \37\&{if} $\\{end\_of\_statement}$ \1\&{then}\C{$\\{cur\_cmd}=%
+\\{semicolon}$, \\{end\_group}, or \\{stop}}\6
+\&{begin} \37\&{if} $\\{balance}=1$ \1\&{then}\5
+\&{goto} \37\\{done}\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{end\_group}$ \1\&{then}\5
+$\\{decr}(\\{balance})$;\2\2\6
+\&{end}\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{begin\_group}$ \1\&{then}\5
+$\\{incr}(\\{balance})$;\2\2\6
+\&{end}\par
+\U730.\fi
+
+\M733. \P$\X733:Scan undelimited argument(s)\X\S$\6
+\&{begin} \37\&{if} $\\{info}(\|r)<\\{text\_macro}$ \1\&{then}\6
+\&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{info}(\|r)\I\\{suffix\_macro}$ \1\&{then}\6
+\&{if} $(\\{cur\_cmd}=\\{equals})\V(\\{cur\_cmd}=\\{assignment})$ \1\&{then}\5
+\\{get\_x\_next};\2\2\6
+\&{end};\2\6
+\&{case} $\\{info}(\|r)$ \1\&{of}\6
+\4\\{primary\_macro}: \37\\{scan\_primary};\6
+\4\\{secondary\_macro}: \37\\{scan\_secondary};\6
+\4\\{tertiary\_macro}: \37\\{scan\_tertiary};\6
+\4\\{expr\_macro}: \37\\{scan\_expression};\6
+\4\\{of\_macro}: \37\X734:Scan an expression followed by `\&{of} $%
+\langle$primary$\rangle$'\X;\6
+\4\\{suffix\_macro}: \37\X735:Scan a suffix with optional delimiters\X;\6
+\4\\{text\_macro}: \37$\\{scan\_text\_arg}(0,\390)$;\2\6
+\&{end};\C{there are no other cases}\6
+\\{back\_input};\5
+\X728:Append the current expression to \\{arg\_list}\X;\6
+\&{end}\par
+\U725.\fi
+
+\M734. \P$\X734:Scan an expression followed by `\&{of} $\langle$primary$%
+\rangle$'\X\S$\6
+\&{begin} \37\\{scan\_expression};\5
+$\|p\K\\{get\_avail}$;\5
+$\\{info}(\|p)\K\\{stash\_cur\_exp}$;\6
+\&{if} $\\{internal}[\\{tracing\_macros}]>0$ \1\&{then}\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_arg}(\\{info}(\|p),\39\|n,\390)$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end};\2\6
+\&{if} $\\{arg\_list}=\\{null}$ \1\&{then}\5
+$\\{arg\_list}\K\|p$\ \&{else} $\\{link}(\\{tail})\K\|p$;\2\6
+$\\{tail}\K\|p$;\5
+$\\{incr}(\|n)$;\6
+\&{if} $\\{cur\_cmd}\I\\{of\_token}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{"of"})$;\5
+$\\{print}(\.{"\ for\ "})$;\5
+$\\{print\_macro\_name}(\\{arg\_list},\39\\{macro\_name})$;\5
+$\\{help1}(\.{"I\'ve\ got\ the\ first\ argument;\ will\ look\ now\ for\ the\
+other."})$;\5
+\\{back\_error};\6
+\&{end};\2\6
+\\{get\_x\_next};\5
+\\{scan\_primary};\6
+\&{end}\par
+\U733.\fi
+
+\M735. \P$\X735:Scan a suffix with optional delimiters\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_cmd}\I\\{left\_delimiter}$ \1\&{then}\5
+$\\{l\_delim}\K\\{null}$\6
+\4\&{else} \&{begin} \37$\\{l\_delim}\K\\{cur\_sym}$;\5
+$\\{r\_delim}\K\\{cur\_mod}$;\5
+\\{get\_x\_next};\6
+\&{end};\2\6
+\\{scan\_suffix};\6
+\&{if} $\\{l\_delim}\I\\{null}$ \1\&{then}\6
+\&{begin} \37\&{if} $(\\{cur\_cmd}\I\\{right\_delimiter})\V(\\{cur\_mod}\I\\{l%
+\_delim})$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\\{text}(\\{r\_delim}))$;\5
+$\\{help2}(\.{"I\'ve\ gotten\ to\ the\ end\ of\ the\ macro\ parameter\
+list."})$\6
+$(\.{"You\ might\ want\ to\ delete\ some\ tokens\ before\ continuing."})$;\5
+\\{back\_error};\6
+\&{end};\2\6
+\\{get\_x\_next};\6
+\&{end};\2\6
+\&{end}\par
+\U733.\fi
+
+\M736. Before we put a new token list on the input stack, it is wise to clean
+off
+all token lists that have recently been depleted. Then a user macro that ends
+with a call to itself will not require unbounded stack space.
+
+\Y\P$\4\X736:Feed the arguments and replacement text to the scanner\X\S$\6
+\&{while} $\\{token\_state}\W(\\{loc}=\\{null})$ \1\&{do}\5
+\\{end\_token\_list};\C{conserve stack space}\2\6
+\&{if} $\\{param\_ptr}+\|n>\\{max\_param\_stack}$ \1\&{then}\6
+\&{begin} \37$\\{max\_param\_stack}\K\\{param\_ptr}+\|n$;\6
+\&{if} $\\{max\_param\_stack}>\\{param\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"parameter\ stack\ size"},\39\\{param\_size})$;\2\6
+\&{end};\2\6
+$\\{begin\_token\_list}(\\{def\_ref},\39\\{macro})$;\5
+$\\{name}\K\\{macro\_name}$;\5
+$\\{loc}\K\|r$;\6
+\&{if} $\|n>0$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{arg\_list}$;\6
+\1\&{repeat} \37$\\{param\_stack}[\\{param\_ptr}]\K\\{info}(\|p)$;\5
+$\\{incr}(\\{param\_ptr})$;\5
+$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\|p=\\{null}$;\2\6
+$\\{flush\_list}(\\{arg\_list})$;\6
+\&{end}\2\par
+\U720.\fi
+
+\M737. It's sometimes necessary to put a single argument onto \\{param\_stack}.
+The \\{stack\_argument} subroutine does this.
+
+\Y\P\4\&{procedure}\1\ \37$\\{stack\_argument}(\|p:\\{pointer})$;\2\6
+\&{begin} \37\&{if} $\\{param\_ptr}=\\{max\_param\_stack}$ \1\&{then}\6
+\&{begin} \37$\\{incr}(\\{max\_param\_stack})$;\6
+\&{if} $\\{max\_param\_stack}>\\{param\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"parameter\ stack\ size"},\39\\{param\_size})$;\2\6
+\&{end};\2\6
+$\\{param\_stack}[\\{param\_ptr}]\K\|p$;\5
+$\\{incr}(\\{param\_ptr})$;\6
+\&{end};\par
+\fi
+
+\N738. \[36] Conditional processing.
+Let's consider now the way \&{if} commands are handled.
+
+Conditions can be inside conditions, and this nesting has a stack
+that is independent of other stacks.
+Four global variables represent the top of the condition stack:
+\\{cond\_ptr} points to pushed-down entries, if~any; \\{cur\_if} tells whether
+we are processing \&{if} or \&{elseif}; \\{if\_limit} specifies
+the largest code of a \\{fi\_or\_else} command that is syntactically legal;
+and \\{if\_line} is the line number at which the current conditional began.
+
+If no conditions are currently in progress, the condition stack has the
+special state $\\{cond\_ptr}=\\{null}$, $\\{if\_limit}=\\{normal}$, $\\{cur%
+\_if}=0$, $\\{if\_line}=0$.
+Otherwise \\{cond\_ptr} points to a two-word node; the \\{type}, \\{name%
+\_type}, and
+\\{link} fields of the first word contain \\{if\_limit}, \\{cur\_if}, and
+\\{cond\_ptr} at the next level, and the second word contains the
+corresponding \\{if\_line}.
+
+\Y\P\D \37$\\{if\_node\_size}=2$\C{number of words in stack entry for
+conditionals}\par
+\P\D \37$\\{if\_line\_field}(\#)\S\\{mem}[\#+1].\\{int}$\par
+\P\D \37$\\{if\_code}=1$\C{code for \&{if} being evaluated}\par
+\P\D \37$\\{fi\_code}=2$\C{code for \&{fi}}\par
+\P\D \37$\\{else\_code}=3$\C{code for \&{else}}\par
+\P\D \37$\\{else\_if\_code}=4$\C{code for \&{elseif}}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{cond\_ptr}: \37\\{pointer};\C{top of the condition stack}\6
+\4\\{if\_limit}: \37$\\{normal}\to\\{else\_if\_code}$;\C{upper bound on \\{fi%
+\_or\_else} codes}\6
+\4\\{cur\_if}: \37\\{small\_number};\C{type of conditional being worked on}\6
+\4\\{if\_line}: \37\\{integer};\C{line where that conditional began}\par
+\fi
+
+\M739. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{cond\_ptr}\K\\{null}$;\5
+$\\{if\_limit}\K\\{normal}$;\5
+$\\{cur\_if}\K0$;\5
+$\\{if\_line}\K0$;\par
+\fi
+
+\M740. \P$\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}%
+\S$\6
+$\\{primitive}(\.{"if"},\39\\{if\_test},\39\\{if\_code})$;\6
+$\\{primitive}(\.{"fi"},\39\\{fi\_or\_else},\39\\{fi\_code})$;\5
+$\\{eqtb}[\\{frozen\_fi}]\K\\{eqtb}[\\{cur\_sym}]$;\6
+$\\{primitive}(\.{"else"},\39\\{fi\_or\_else},\39\\{else\_code})$;\6
+$\\{primitive}(\.{"elseif"},\39\\{fi\_or\_else},\39\\{else\_if\_code})$;\par
+\fi
+
+\M741. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4$\\{if\_test},\39\\{fi\_or\_else}$: \37\&{case} $\|m$ \1\&{of}\6
+\4\\{if\_code}: \37$\\{print}(\.{"if"})$;\6
+\4\\{fi\_code}: \37$\\{print}(\.{"fi"})$;\6
+\4\\{else\_code}: \37$\\{print}(\.{"else"})$;\6
+\4\&{othercases} \37$\\{print}(\.{"elseif"})$\2\6
+\&{endcases};\par
+\fi
+
+\M742. Here is a procedure that ignores text until coming to an \&{elseif},
+\&{else}, or \&{fi} at level zero of $\&{if}\ldots\&{fi}$
+nesting. After it has acted, \\{cur\_mod} will indicate the token that
+was found.
+
+\MF's smallest two command codes are \\{if\_test} and \\{fi\_or\_else}; this
+makes the skipping process a bit simpler.
+
+\Y\P\4\&{procedure}\1\ \37\\{pass\_text};\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|l: \37\\{integer};\2\6
+\&{begin} \37$\\{scanner\_status}\K\\{skipping}$;\5
+$\|l\K0$;\5
+$\\{warning\_info}\K\\{line}$;\6
+\~ \1\&{loop}\ \&{begin} \37\\{get\_next};\6
+\&{if} $\\{cur\_cmd}\L\\{fi\_or\_else}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}<\\{fi\_or\_else}$ \1\&{then}\5
+$\\{incr}(\|l)$\6
+\4\&{else} \&{begin} \37\&{if} $\|l=0$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\\{cur\_mod}=\\{fi\_code}$ \1\&{then}\5
+$\\{decr}(\|l)$;\2\6
+\&{end}\2\6
+\4\&{else} \X743:Decrease the string reference count, if the current token is a
+string\X;\2\6
+\&{end};\2\6
+\4\\{done}: \37$\\{scanner\_status}\K\\{normal}$;\6
+\&{end};\par
+\fi
+
+\M743. \P$\X743:Decrease the string reference count, if the current token is a
+string\X\S$\6
+\&{if} $\\{cur\_cmd}=\\{string\_token}$ \1\&{then}\5
+$\\{delete\_str\_ref}(\\{cur\_mod})$\2\par
+\Us83, 742, 991\ETs1016.\fi
+
+\M744. When we begin to process a new \&{if}, we set $\\{if\_limit}\K\\{if%
+\_code}$; then
+if \&{elseif} or \&{else} or \&{fi} occurs before the current \&{if}
+condition has been evaluated, a colon will be inserted.
+A construction like `\.{if fi}' would otherwise get \MF\ confused.
+
+\Y\P$\4\X744:Push the condition stack\X\S$\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{if\_node\_size})$;\5
+$\\{link}(\|p)\K\\{cond\_ptr}$;\5
+$\\{type}(\|p)\K\\{if\_limit}$;\5
+$\\{name\_type}(\|p)\K\\{cur\_if}$;\5
+$\\{if\_line\_field}(\|p)\K\\{if\_line}$;\5
+$\\{cond\_ptr}\K\|p$;\5
+$\\{if\_limit}\K\\{if\_code}$;\5
+$\\{if\_line}\K\\{line}$;\5
+$\\{cur\_if}\K\\{if\_code}$;\6
+\&{end}\par
+\U748.\fi
+
+\M745. \P$\X745:Pop the condition stack\X\S$\6
+\&{begin} \37$\|p\K\\{cond\_ptr}$;\5
+$\\{if\_line}\K\\{if\_line\_field}(\|p)$;\5
+$\\{cur\_if}\K\\{name\_type}(\|p)$;\5
+$\\{if\_limit}\K\\{type}(\|p)$;\5
+$\\{cond\_ptr}\K\\{link}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{if\_node\_size})$;\6
+\&{end}\par
+\Us748, 749\ETs751.\fi
+
+\M746. Here's a procedure that changes the \\{if\_limit} code corresponding to
+a given value of \\{cond\_ptr}.
+
+\Y\P\4\&{procedure}\1\ \37$\\{change\_if\_limit}(\|l:\\{small\_number};\,\35%
+\|p:\\{pointer})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|q: \37\\{pointer};\2\6
+\&{begin} \37\&{if} $\|p=\\{cond\_ptr}$ \1\&{then}\5
+$\\{if\_limit}\K\|l$\C{that's the easy case}\6
+\4\&{else} \&{begin} \37$\|q\K\\{cond\_ptr}$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\|q=\\{null}$ \1\&{then}\5
+$\\{confusion}(\.{"if"})$;\2\6
+\&{if} $\\{link}(\|q)=\|p$ \1\&{then}\6
+\&{begin} \37$\\{type}(\|q)\K\|l$;\5
+\&{return};\6
+\&{end};\2\6
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M747. The user is supposed to put colons into the proper parts of conditional
+statements. Therefore, \MF\ has to check for their presence.
+
+\Y\P\4\&{procedure}\1\ \37\\{check\_colon};\2\6
+\&{begin} \37\&{if} $\\{cur\_cmd}\I\\{colon}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{":"})$;\6
+$\\{help2}(\.{"There\ should\'ve\ been\ a\ colon\ after\ the\ condition."})$\6
+$(\.{"I\ shall\ pretend\ that\ one\ was\ there."})$;\5
+\\{back\_error};\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M748. A condition is started when the \\{get\_x\_next} procedure encounters
+an \\{if\_test} command; in that case \\{get\_x\_next} calls \\{conditional},
+which is a recursive procedure.
+
+\Y\P\4\&{procedure}\1\ \37\\{conditional};\6
+\4\&{label} \37$\\{exit},\39\\{done},\39\\{reswitch},\39\\{found}$;\6
+\4\&{var} \37\\{save\_cond\_ptr}: \37\\{pointer};\C{\\{cond\_ptr} corresponding
+to this conditional}\6
+\\{new\_if\_limit}: \37$\\{fi\_code}\to\\{else\_if\_code}$;\C{future value of %
+\\{if\_limit}}\6
+\|p: \37\\{pointer};\C{temporary register}\2\6
+\&{begin} \37\X744:Push the condition stack\X;\ $\\{save\_cond\_ptr}\K\\{cond%
+\_ptr}$;\6
+\4\\{reswitch}: \37\\{get\_boolean};\5
+$\\{new\_if\_limit}\K\\{else\_if\_code}$;\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>\\{unity}$ \1\&{then}\5
+\X750:Display the boolean value of \\{cur\_exp}\X;\2\6
+\4\\{found}: \37\\{check\_colon};\6
+\&{if} $\\{cur\_exp}=\\{true\_code}$ \1\&{then}\6
+\&{begin} \37$\\{change\_if\_limit}(\\{new\_if\_limit},\39\\{save\_cond%
+\_ptr})$;\5
+\&{return};\C{wait for \&{elseif}, \&{else}, or \&{fi}}\6
+\&{end};\2\6
+\X749:Skip to \&{elseif} or \&{else} or \&{fi}, then \&{goto} \\{done}\X;\6
+\4\\{done}: \37$\\{cur\_if}\K\\{cur\_mod}$;\5
+$\\{if\_line}\K\\{line}$;\6
+\&{if} $\\{cur\_mod}=\\{fi\_code}$ \1\&{then}\5
+\X745:Pop the condition stack\X\6
+\4\&{else} \&{if} $\\{cur\_mod}=\\{else\_if\_code}$ \1\&{then}\5
+\&{goto} \37\\{reswitch}\6
+\4\&{else} \&{begin} \37$\\{cur\_exp}\K\\{true\_code}$;\5
+$\\{new\_if\_limit}\K\\{fi\_code}$;\5
+\\{get\_x\_next};\5
+\&{goto} \37\\{found};\6
+\&{end};\2\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M749. In a construction like `\&{if} \&{if} \&{true}: $0=1$: \\{foo}
+\&{else}: \\{bar} \&{fi}', the first \&{else}
+that we come to after learning that the \&{if} is false is not the
+\&{else} we're looking for. Hence the following curious logic is needed.
+
+\Y\P$\4\X749:Skip to \&{elseif} or \&{else} or \&{fi}, then \&{goto} \\{done}\X%
+\S$\6
+\~ \1\&{loop}\ \&{begin} \37\\{pass\_text};\6
+\&{if} $\\{cond\_ptr}=\\{save\_cond\_ptr}$ \1\&{then}\5
+\&{goto} \37\\{done}\6
+\4\&{else} \&{if} $\\{cur\_mod}=\\{fi\_code}$ \1\&{then}\5
+\X745:Pop the condition stack\X;\2\2\6
+\&{end}\2\par
+\U748.\fi
+
+\M750. \P$\X750:Display the boolean value of \\{cur\_exp}\X\S$\6
+\&{begin} \37\\{begin\_diagnostic};\6
+\&{if} $\\{cur\_exp}=\\{true\_code}$ \1\&{then}\5
+$\\{print}(\.{"\{true\}"})$\ \&{else} $\\{print}(\.{"\{false\}"})$;\2\6
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\par
+\U748.\fi
+
+\M751. The processing of conditionals is complete except for the following
+code, which is actually part of \\{get\_x\_next}. It comes into play when
+\&{elseif}, \&{else}, or \&{fi} is scanned.
+
+\Y\P$\4\X751:Terminate the current conditional and skip to \&{fi}\X\S$\6
+\&{if} $\\{cur\_mod}>\\{if\_limit}$ \1\&{then}\6
+\&{if} $\\{if\_limit}=\\{if\_code}$ \1\&{then}\C{condition not yet evaluated}\6
+\&{begin} \37$\\{missing\_err}(\.{":"})$;\5
+\\{back\_input};\5
+$\\{cur\_sym}\K\\{frozen\_colon}$;\5
+\\{ins\_error};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"Extra\ "})$;\5
+$\\{print\_cmd\_mod}(\\{fi\_or\_else},\39\\{cur\_mod})$;\5
+$\\{help1}(\.{"I\'m\ ignoring\ this;\ it\ doesn\'t\ match\ any\ if."})$;\5
+\\{error};\6
+\&{end}\2\6
+\4\&{else} \&{begin} \37\&{while} $\\{cur\_mod}\I\\{fi\_code}$ \1\&{do}\5
+\\{pass\_text};\C{skip to \&{fi}}\2\6
+\X745:Pop the condition stack\X;\6
+\&{end}\2\par
+\U707.\fi
+
+\N752. \[37] Iterations.
+To bring our treatment of \\{get\_x\_next} to a close, we need to consider what
+\MF\ does when it sees \&{for}, \&{forsuffixes}, and \&{forever}.
+
+There's a global variable \\{loop\_ptr} that keeps track of the \&{for} loops
+that are currently active. If $\\{loop\_ptr}=\\{null}$, no loops are in
+progress;
+otherwise $\\{info}(\\{loop\_ptr})$ points to the iterative text of the current
+(innermost) loop, and $\\{link}(\\{loop\_ptr})$ points to the data for any
+other
+loops that enclose the current one.
+
+A loop-control node also has two other fields, called \\{loop\_type} and
+\\{loop\_list}, whose contents depend on the type of loop:
+
+\yskip\indent$\\{loop\_type}(\\{loop\_ptr})=\\{null}$ means that $\\{loop%
+\_list}(\\{loop\_ptr})$
+points to a list of one-word nodes whose \\{info} fields point to the
+remaining argument values of a suffix list and expression list.
+
+\yskip\indent$\\{loop\_type}(\\{loop\_ptr})=\\{void}$ means that the current
+loop is
+`\&{forever}'.
+
+\yskip\indent$\\{loop\_type}(\\{loop\_ptr})=\|p>\\{void}$ means that $%
+\\{value}(\|p)$,
+$\\{step\_size}(\|p)$, and $\\{final\_value}(\|p)$ contain the data for an
+arithmetic
+progression.
+
+\yskip\noindent In the latter case, \|p points to a ``progression node''
+whose first word is not used. (No value could be stored there because the
+link field of words in the dynamic memory area cannot be arbitrary.)
+
+\Y\P\D \37$\\{loop\_list\_loc}(\#)\S\#+1$\C{where the \\{loop\_list} field
+resides}\par
+\P\D \37$\\{loop\_type}(\#)\S\\{info}(\\{loop\_list\_loc}(\#))$\C{the type of %
+\&{for} loop}\par
+\P\D \37$\\{loop\_list}(\#)\S\\{link}(\\{loop\_list\_loc}(\#))$\C{the remaining
+list elements}\par
+\P\D \37$\\{loop\_node\_size}=2$\C{the number of words in a loop control node}%
+\par
+\P\D \37$\\{progression\_node\_size}=4$\C{the number of words in a progression
+node}\par
+\P\D \37$\\{step\_size}(\#)\S\\{mem}[\#+2].\\{sc}$\C{the step size in an
+arithmetic progression}\par
+\P\D \37$\\{final\_value}(\#)\S\\{mem}[\#+3].\\{sc}$\C{the final value in an
+arithmetic progression}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{loop\_ptr}: \37\\{pointer};\C{top of the loop-control-node stack}\par
+\fi
+
+\M753. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{loop\_ptr}\K\\{null}$;\par
+\fi
+
+\M754. If the expressions that define an arithmetic progression in
+a \&{for} loop don't have known numeric values, the \\{bad\_for}
+subroutine screams at the user.
+
+\Y\P\4\&{procedure}\1\ \37$\\{bad\_for}(\|s:\\{str\_number})$;\2\6
+\&{begin} \37$\\{disp\_err}(\\{null},\39\.{"Improper\ "})$;\C{show the bad
+expression above the message}\6
+$\\{print}(\|s)$;\5
+$\\{print}(\.{"\ has\ been\ replaced\ by\ 0"})$;\5
+$\\{help4}(\.{"When\ you\ say\ \`for\ x=a\ step\ b\ until\ c\',"})$\6
+$(\.{"the\ initial\ value\ \`a\'\ and\ the\ step\ size\ \`b\'"})$\6
+$(\.{"and\ the\ final\ value\ \`c\'\ must\ have\ known\ numeric\ values."})$\6
+$(\.{"I\'m\ zeroing\ this\ one.\ Proceed,\ with\ fingers\ crossed."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end};\par
+\fi
+
+\M755. Here's what \MF\ does when \&{for}, \&{forsuffixes}, or \&{forever}
+has just been scanned. (This code requires slight familiarity with
+expression-parsing routines that we have not yet discussed; but it seems
+to belong in the present part of the program, even though the author
+didn't write it until later. The reader may wish to come back to it.)
+
+\Y\P\4\&{procedure}\1\ \37\\{begin\_iteration};\6
+\4\&{label} \37$\\{continue},\39\\{done},\39\\{found}$;\6
+\4\&{var} \37\|m: \37\\{halfword};\C{\\{expr\_base} (\&{for}) or \\{suffix%
+\_base} (\&{forsuffixes})}\6
+\|n: \37\\{halfword};\C{hash address of the current symbol}\6
+$\|p,\39\|q,\39\|s,\39\\{pp}$: \37\\{pointer};\C{link manipulation registers}\2%
+\6
+\&{begin} \37$\|m\K\\{cur\_mod}$;\5
+$\|n\K\\{cur\_sym}$;\5
+$\|s\K\\{get\_node}(\\{loop\_node\_size})$;\6
+\&{if} $\|m=\\{start\_forever}$ \1\&{then}\6
+\&{begin} \37$\\{loop\_type}(\|s)\K\\{void}$;\5
+$\|p\K\\{null}$;\5
+\\{get\_x\_next};\5
+\&{goto} \37\\{found};\6
+\&{end};\2\6
+\\{get\_symbol};\5
+$\|p\K\\{get\_node}(\\{token\_node\_size})$;\5
+$\\{info}(\|p)\K\\{cur\_sym}$;\5
+$\\{value}(\|p)\K\|m$;\6
+\\{get\_x\_next};\6
+\&{if} $(\\{cur\_cmd}\I\\{equals})\W(\\{cur\_cmd}\I\\{assignment})$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{"="})$;\6
+$\\{help3}(\.{"The\ next\ thing\ in\ this\ loop\ should\ have\ been\ \`=\'\ or\
+\`:=\'."})$\6
+$(\.{"But\ don\'t\ worry;\ I\'ll\ pretend\ that\ an\ equals\ sign"})$\6
+$(\.{"was\ present,\ and\ I\'ll\ look\ for\ the\ values\ next."})$;\6
+\\{back\_error};\6
+\&{end};\2\6
+\X764:Scan the values to be used in the loop\X;\6
+\4\\{found}: \37\X756:Check for the presence of a colon\X;\6
+\X758:Scan the loop text and put it on the loop control stack\X;\6
+\\{resume\_iteration};\6
+\&{end};\par
+\fi
+
+\M756. \P$\X756:Check for the presence of a colon\X\S$\6
+\&{if} $\\{cur\_cmd}\I\\{colon}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{":"})$;\6
+$\\{help3}(\.{"The\ next\ thing\ in\ this\ loop\ should\ have\ been\ a\ \`:%
+\'."})$\6
+$(\.{"So\ I\'ll\ pretend\ that\ a\ colon\ was\ present;"})$\6
+$(\.{"everything\ from\ here\ to\ \`endfor\'\ will\ be\ iterated."})$;\5
+\\{back\_error};\6
+\&{end}\2\par
+\U755.\fi
+
+\M757. We append a special \\{frozen\_repeat\_loop} token in place of the
+`\&{endfor}' at the end of the loop. This will come through \MF's scanner
+at the proper time to cause the loop to be repeated.
+
+(If the user tries some shenanigan like `\&{for} $\ldots$ \&{let} \&{endfor}',
+he will be foiled by the \\{get\_symbol} routine, which keeps frozen
+tokens unchanged. Furthermore the \\{frozen\_repeat\_loop} is an \&{outer}
+token, so it won't be lost accidentally.)
+
+\fi
+
+\M758. \P$\X758:Scan the loop text and put it on the loop control stack\X\S$\6
+$\|q\K\\{get\_avail}$;\5
+$\\{info}(\|q)\K\\{frozen\_repeat\_loop}$;\5
+$\\{scanner\_status}\K\\{loop\_defining}$;\5
+$\\{warning\_info}\K\|n$;\5
+$\\{info}(\|s)\K\\{scan\_toks}(\\{iteration},\39\|p,\39\|q,\390)$;\5
+$\\{scanner\_status}\K\\{normal}$;\6
+$\\{link}(\|s)\K\\{loop\_ptr}$;\5
+$\\{loop\_ptr}\K\|s$\par
+\U755.\fi
+
+\M759. \P$\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}%
+\S$\6
+$\\{eq\_type}(\\{frozen\_repeat\_loop})\K\\{repeat\_loop}+\\{outer\_tag}$;\5
+$\\{text}(\\{frozen\_repeat\_loop})\K\.{"\ ENDFOR"}$;\par
+\fi
+
+\M760. The loop text is inserted into \MF's scanning apparatus by the
+\\{resume\_iteration} routine.
+
+\Y\P\4\&{procedure}\1\ \37\\{resume\_iteration};\6
+\4\&{label} \37$\\{not\_found},\39\\{exit}$;\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{link registers}\2\6
+\&{begin} \37$\|p\K\\{loop\_type}(\\{loop\_ptr})$;\6
+\&{if} $\|p>\\{void}$ \1\&{then}\C{\|p points to a progression node}\6
+\&{begin} \37$\\{cur\_exp}\K\\{value}(\|p)$;\6
+\&{if} $\X761:The arithmetic progression has ended\X$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\\{cur\_type}\K\\{known}$;\5
+$\|q\K\\{stash\_cur\_exp}$;\C{make \|q an \&{expr} argument}\6
+$\\{value}(\|p)\K\\{cur\_exp}+\\{step\_size}(\|p)$;\C{set $\\{value}(\|p)$ for
+the next iteration}\6
+\&{end}\6
+\4\&{else} \&{if} $\|p<\\{void}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{loop\_list}(\\{loop\_ptr})$;\6
+\&{if} $\|p=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\\{loop\_list}(\\{loop\_ptr})\K\\{link}(\|p)$;\5
+$\|q\K\\{info}(\|p)$;\5
+$\\{free\_avail}(\|p)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{begin\_token\_list}(\\{info}(\\{loop\_ptr}),\39%
+\\{forever\_text})$;\5
+\&{return};\6
+\&{end};\2\2\6
+$\\{begin\_token\_list}(\\{info}(\\{loop\_ptr}),\39\\{loop\_text})$;\5
+$\\{stack\_argument}(\|q)$;\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>\\{unity}$ \1\&{then}\5
+\X762:Trace the start of a loop\X;\2\6
+\&{return};\6
+\4\\{not\_found}: \37\\{stop\_iteration};\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M761. \P$\X761:The arithmetic progression has ended\X\S$\6
+$((\\{step\_size}(\|p)>0)\W(\\{cur\_exp}>\\{final\_value}(\|p)))\V\30((\\{step%
+\_size}(\|p)<0)\W(\\{cur\_exp}<\\{final\_value}(\|p)))$\par
+\U760.\fi
+
+\M762. \P$\X762:Trace the start of a loop\X\S$\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\{loop\ value="})$;\6
+\&{if} $(\|q\I\\{null})\W(\\{link}(\|q)=\\{void})$ \1\&{then}\5
+$\\{print\_exp}(\|q,\391)$\6
+\4\&{else} $\\{show\_token\_list}(\|q,\39\\{null},\3950,\390)$;\2\6
+$\\{print\_char}(\.{"\}"})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\par
+\U760.\fi
+
+\M763. A level of loop control disappears when \\{resume\_iteration} has
+decided
+not to resume, or when an \&{exitif} construction has removed the loop text
+from the input stack.
+
+\Y\P\4\&{procedure}\1\ \37\\{stop\_iteration};\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{the usual}\2\6
+\&{begin} \37$\|p\K\\{loop\_type}(\\{loop\_ptr})$;\6
+\&{if} $\|p>\\{void}$ \1\&{then}\5
+$\\{free\_node}(\|p,\39\\{progression\_node\_size})$\6
+\4\&{else} \&{if} $\|p<\\{void}$ \1\&{then}\6
+\&{begin} \37$\|q\K\\{loop\_list}(\\{loop\_ptr})$;\6
+\&{while} $\|q\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\|p\K\\{info}(\|q)$;\6
+\&{if} $\|p\I\\{null}$ \1\&{then}\6
+\&{if} $\\{link}(\|p)=\\{void}$ \1\&{then}\C{it's an \&{expr} parameter}\6
+\&{begin} \37$\\{recycle\_value}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$;\6
+\&{end}\6
+\4\&{else} $\\{flush\_token\_list}(\|p)$;\C{it's a \&{suffix} or \&{text}
+parameter}\2\2\6
+$\|p\K\|q$;\5
+$\|q\K\\{link}(\|q)$;\5
+$\\{free\_avail}(\|p)$;\6
+\&{end};\2\6
+\&{end};\2\2\6
+$\|p\K\\{loop\_ptr}$;\5
+$\\{loop\_ptr}\K\\{link}(\|p)$;\5
+$\\{flush\_token\_list}(\\{info}(\|p))$;\5
+$\\{free\_node}(\|p,\39\\{loop\_node\_size})$;\6
+\&{end};\par
+\fi
+
+\M764. Now that we know all about loop control, we can finish up
+the missing portion of \\{begin\_iteration} and we'll be done.
+
+The following code is performed after the `\.=' has been scanned in
+a \&{for} construction (if $\|m=\\{expr\_base}$) or a \&{forsuffixes}
+construction
+(if $\|m=\\{suffix\_base}$).
+
+\Y\P$\4\X764:Scan the values to be used in the loop\X\S$\6
+$\\{loop\_type}(\|s)\K\\{null}$;\5
+$\|q\K\\{loop\_list\_loc}(\|s)$;\5
+$\\{link}(\|q)\K\\{null}$;\C{$\\{link}(\|q)=\\{loop\_list}(\|s)$}\6
+\1\&{repeat} \37\\{get\_x\_next};\6
+\&{if} $\|m\I\\{expr\_base}$ \1\&{then}\5
+\\{scan\_suffix}\6
+\4\&{else} \&{begin} \37\&{if} $\\{cur\_cmd}\G\\{colon}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}\L\\{comma}$ \1\&{then}\5
+\&{goto} \37\\{continue};\2\2\6
+\\{scan\_expression};\6
+\&{if} $\\{cur\_cmd}=\\{step\_token}$ \1\&{then}\6
+\&{if} $\|q=\\{loop\_list\_loc}(\|s)$ \1\&{then}\5
+\X765:Prepare for step-until construction and \&{goto} \\{done}\X;\2\2\6
+$\\{cur\_exp}\K\\{stash\_cur\_exp}$;\6
+\&{end};\2\6
+$\\{link}(\|q)\K\\{get\_avail}$;\5
+$\|q\K\\{link}(\|q)$;\5
+$\\{info}(\|q)\K\\{cur\_exp}$;\5
+$\\{cur\_type}\K\\{vacuous}$;\6
+\4\\{continue}: \37\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$;\2\6
+\4\\{done}: \37\par
+\U755.\fi
+
+\M765. \P$\X765:Prepare for step-until construction and \&{goto} \\{done}\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+$\\{bad\_for}(\.{"initial\ value"})$;\2\6
+$\\{pp}\K\\{get\_node}(\\{progression\_node\_size})$;\5
+$\\{value}(\\{pp})\K\\{cur\_exp}$;\6
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+$\\{bad\_for}(\.{"step\ size"})$;\2\6
+$\\{step\_size}(\\{pp})\K\\{cur\_exp}$;\6
+\&{if} $\\{cur\_cmd}\I\\{until\_token}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{"until"})$;\6
+$\\{help2}(\.{"I\ assume\ you\ meant\ to\ say\ \`until\'\ after\ \`step\'."})$\6
+$(\.{"So\ I\'ll\ look\ for\ the\ final\ value\ and\ colon\ next."})$;\5
+\\{back\_error};\6
+\&{end};\2\6
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+$\\{bad\_for}(\.{"final\ value"})$;\2\6
+$\\{final\_value}(\\{pp})\K\\{cur\_exp}$;\5
+$\\{loop\_type}(\|s)\K\\{pp}$;\5
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U764.\fi
+
+\N766. \[38] File names.
+It's time now to fret about file names. Besides the fact that different
+operating systems treat files in different ways, we must cope with the
+fact that completely different naming conventions are used by different
+groups of people. The following programs show what is required for one
+particular operating system; similar routines for other systems are not
+difficult to devise.
+
+\MF\ assumes that a file name has three parts: the name proper; its
+``extension''; and a ``file area'' where it is found in an external file
+system. The extension of an input file is assumed to be
+`\.{.mf}' unless otherwise specified; it is `\.{.log}' on the
+transcript file that records each run of \MF; it is `\.{.tfm}' on the font
+metric files that describe characters in the fonts \MF\ creates; it is
+`\.{.gf}' on the output files that specify generic font information; and it
+is `\.{.base}' on the base files written by \.{INIMF} to initialize \MF.
+The file area can be arbitrary on input files, but files are usually
+output to the user's current area. If an input file cannot be
+found on the specified area, \MF\ will look for it on a special system
+area; this special area is intended for commonly used input files.
+
+Simple uses of \MF\ refer only to file names that have no explicit
+extension or area. For example, a person usually says `\.{input} \.{cmr10}'
+instead of `\.{input} \.{cmr10.new}'. Simple file
+names are best, because they make the \MF\ source files portable;
+whenever a file name consists entirely of letters and digits, it should be
+treated in the same way by all implementations of \MF. However, users
+need the ability to refer to other files in their environment, especially
+when responding to error messages concerning unopenable files; therefore
+we want to let them use the syntax that appears in their favorite
+operating system.
+
+\fi
+
+\M767. \MF\ uses the same conventions that have proved to be satisfactory for
+\TeX. In order to isolate the system-dependent aspects of file names, the
+system-independent parts of \MF\ are expressed in terms
+of three system-dependent
+procedures called \\{begin\_name}, \\{more\_name}, and \\{end\_name}. In
+essence, if the user-specified characters of the file name are $c_1\ldots c_n$,
+the system-independent driver program does the operations
+$$\\{begin\_name};\,\\{more\_name}(c_1);\,\ldots\,;\\{more\_name}(c_n);
+\,\\{end\_name}.$$
+These three procedures communicate with each other via global variables.
+Afterwards the file name will appear in the string pool as three strings
+called \\{cur\_name}\penalty10000\hskip-.05em,
+\\{cur\_area}, and \\{cur\_ext}; the latter two are null (i.e.,
+\.{""}), unless they were explicitly specified by the user.
+
+Actually the situation is slightly more complicated, because \MF\ needs
+to know when the file name ends. The \\{more\_name} routine is a function
+(with side effects) that returns \\{true} on the calls \\{more\_name}$(c_1)$,
+\dots, \\{more\_name}$(c_{n-1})$. The final call \\{more\_name}$(c_n)$
+returns \\{false}; or, it returns \\{true} and $c_n$ is the last character
+on the current input line. In other words,
+\\{more\_name} is supposed to return \\{true} unless it is sure that the
+file name has been completely scanned; and \\{end\_name} is supposed to be able
+to finish the assembly of \\{cur\_name}, \\{cur\_area}, and \\{cur\_ext}
+regardless of
+whether $\\{more\_name}(c_n)$ returned \\{true} or \\{false}.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{cur\_name}: \37\\{str\_number};\C{name of file just scanned}\6
+\4\\{cur\_area}: \37\\{str\_number};\C{file area just scanned, or \.{""}}\6
+\4\\{cur\_ext}: \37\\{str\_number};\C{file extension just scanned, or \.{""}}%
+\par
+\fi
+
+\M768. The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+
+We can scan such file names easily by using two global variables that keep
+track
+of the occurrences of area and extension delimiters:
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{area\_delimiter}: \37\\{pool\_pointer};\C{the most recent `\.>' or `\.:',
+if any}\6
+\4\\{ext\_delimiter}: \37\\{pool\_pointer};\C{the relevant `\..', if any}\par
+\fi
+
+\M769. Input files that can't be found in the user's area may appear in a
+standard
+system area called \\{MF\_area}.
+This system area name will, of course, vary from place to place.
+
+\Y\P\D \37$\\{MF\_area}\S\.{"MFinputs:"}$\par
+\fi
+
+\M770. Here now is the first of the system-dependent routines for file name
+scanning.
+
+\Y\P\4\&{procedure}\1\ \37\\{begin\_name};\2\6
+\&{begin} \37$\\{area\_delimiter}\K0$;\5
+$\\{ext\_delimiter}\K0$;\6
+\&{end};\par
+\fi
+
+\M771. And here's the second.
+
+\Y\P\4\&{function}\1\ \37$\\{more\_name}(\|c:\\{ASCII\_code})$: \37%
+\\{boolean};\2\6
+\&{begin} \37\&{if} $\|c=\.{"\ "}$ \1\&{then}\5
+$\\{more\_name}\K\\{false}$\6
+\4\&{else} \&{begin} \37\&{if} $(\|c=\.{">"})\V(\|c=\.{":"})$ \1\&{then}\6
+\&{begin} \37$\\{area\_delimiter}\K\\{pool\_ptr}$;\5
+$\\{ext\_delimiter}\K0$;\6
+\&{end}\6
+\4\&{else} \&{if} $(\|c=\.{"."})\W(\\{ext\_delimiter}=0)$ \1\&{then}\5
+$\\{ext\_delimiter}\K\\{pool\_ptr}$;\2\2\6
+$\\{str\_room}(1)$;\5
+$\\{append\_char}(\|c)$;\C{contribute \|c to the current string}\6
+$\\{more\_name}\K\\{true}$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M772. The third.
+
+\Y\P\4\&{procedure}\1\ \37\\{end\_name};\2\6
+\&{begin} \37\&{if} $\\{str\_ptr}+3>\\{max\_str\_ptr}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{str\_ptr}+3>\\{max\_strings}$ \1\&{then}\5
+$\\{overflow}(\.{"number\ of\ strings"},\39\\{max\_strings}-\\{init\_str%
+\_ptr})$;\2\6
+$\\{max\_str\_ptr}\K\\{str\_ptr}+3$;\6
+\&{end};\2\6
+\&{if} $\\{area\_delimiter}=0$ \1\&{then}\5
+$\\{cur\_area}\K\.{""}$\6
+\4\&{else} \&{begin} \37$\\{cur\_area}\K\\{str\_ptr}$;\5
+$\\{incr}(\\{str\_ptr})$;\5
+$\\{str\_start}[\\{str\_ptr}]\K\\{area\_delimiter}+1$;\6
+\&{end};\2\6
+\&{if} $\\{ext\_delimiter}=0$ \1\&{then}\6
+\&{begin} \37$\\{cur\_ext}\K\.{""}$;\5
+$\\{cur\_name}\K\\{make\_string}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{cur\_name}\K\\{str\_ptr}$;\5
+$\\{incr}(\\{str\_ptr})$;\5
+$\\{str\_start}[\\{str\_ptr}]\K\\{ext\_delimiter}$;\5
+$\\{cur\_ext}\K\\{make\_string}$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M773. Conversely, here is a routine that takes three strings and prints a file
+name that might have produced them. (The routine is system dependent, because
+some operating systems put the file area last instead of first.)
+
+\Y\P$\4\X57:Basic printing procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_file\_name}(\|n,\39\|a,\39\|e:\\{integer})$;%
+\2\6
+\&{begin} \37$\\{slow\_print}(\|a)$;\5
+$\\{slow\_print}(\|n)$;\5
+$\\{slow\_print}(\|e)$;\6
+\&{end};\par
+\fi
+
+\M774. Another system-dependent routine is needed to convert three internal
+\MF\ strings
+to the \\{name\_of\_file} value that is used to open files. The present code
+allows both lowercase and uppercase letters in the file name.
+
+\Y\P\D \37$\\{append\_to\_name}(\#)\S$\1\6
+\&{begin} \37$\|c\K\#$;\5
+$\\{incr}(\|k)$;\6
+\&{if} $\|k\L\\{file\_name\_size}$ \1\&{then}\5
+$\\{name\_of\_file}[\|k]\K\\{xchr}[\|c]$;\2\6
+\&{end}\2\par
+\Y\P\4\&{procedure}\1\ \37$\\{pack\_file\_name}(\|n,\39\|a,\39\|e:\\{str%
+\_number})$;\6
+\4\&{var} \37\|k: \37\\{integer};\C{number of positions filled in \\{name\_of%
+\_file}}\6
+\|c: \37\\{ASCII\_code};\C{character being packed}\6
+\|j: \37\\{pool\_pointer};\C{index into \\{str\_pool}}\2\6
+\&{begin} \37$\|k\K0$;\6
+\&{for} $\|j\K\\{str\_start}[\|a]\mathrel{\&{to}}\\{str\_start}[\|a+1]-1$ \1%
+\&{do}\5
+$\\{append\_to\_name}(\\{so}(\\{str\_pool}[\|j]))$;\2\6
+\&{for} $\|j\K\\{str\_start}[\|n]\mathrel{\&{to}}\\{str\_start}[\|n+1]-1$ \1%
+\&{do}\5
+$\\{append\_to\_name}(\\{so}(\\{str\_pool}[\|j]))$;\2\6
+\&{for} $\|j\K\\{str\_start}[\|e]\mathrel{\&{to}}\\{str\_start}[\|e+1]-1$ \1%
+\&{do}\5
+$\\{append\_to\_name}(\\{so}(\\{str\_pool}[\|j]))$;\2\6
+\&{if} $\|k\L\\{file\_name\_size}$ \1\&{then}\5
+$\\{name\_length}\K\|k$\ \&{else} $\\{name\_length}\K\\{file\_name\_size}$;\2\6
+\&{for} $\|k\K\\{name\_length}+1\mathrel{\&{to}}\\{file\_name\_size}$ \1\&{do}\5
+$\\{name\_of\_file}[\|k]\K\.{\'\ \'}$;\2\6
+\&{end};\par
+\fi
+
+\M775. A messier routine is also needed, since base file names must be scanned
+before \MF's string mechanism has been initialized. We shall use the
+global variable \\{MF\_base\_default} to supply the text for default system
+areas
+and extensions related to base files.
+
+\Y\P\D \37$\\{base\_default\_length}=18$\C{length of the \\{MF\_base\_default}
+string}\par
+\P\D \37$\\{base\_area\_length}=8$\C{length of its area part}\par
+\P\D \37$\\{base\_ext\_length}=5$\C{length of its `\.{.base}' part}\par
+\P\D \37$\\{base\_extension}=\.{".base"}$\C{the extension, as a \.{WEB}
+constant}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{MF\_base\_default}: \37\&{packed} \37\&{array} $[1\to\\{base\_default%
+\_length}]$ \1\&{of}\5
+\\{char};\2\par
+\fi
+
+\M776. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{MF\_base\_default}\K\.{\'MFbases:plain.base\'}$;\par
+\fi
+
+\M777. \P$\X14:Check the ``constant'' values for consistency\X\mathrel{+}\S$\6
+\&{if} $\\{base\_default\_length}>\\{file\_name\_size}$ \1\&{then}\5
+$\\{bad}\K41$;\2\par
+\fi
+
+\M778. Here is the messy routine that was just mentioned. It sets \\{name\_of%
+\_file}
+from the first \|n characters of \\{MF\_base\_default}, followed by
+$\\{buffer}[\|a\to\|b]$, followed by the last \\{base\_ext\_length} characters
+of
+\\{MF\_base\_default}.
+
+We dare not give error messages here, since \MF\ calls this routine before
+the \\{error} routine is ready to roll. Instead, we simply drop excess
+characters,
+since the error will be detected in another way when a strange file name
+isn't found.
+
+\Y\P\4\&{procedure}\1\ \37$\\{pack\_buffered\_name}(\|n:\\{small\_number};\,%
+\35\|a,\39\|b:\\{integer})$;\6
+\4\&{var} \37\|k: \37\\{integer};\C{number of positions filled in \\{name\_of%
+\_file}}\6
+\|c: \37\\{ASCII\_code};\C{character being packed}\6
+\|j: \37\\{integer};\C{index into \\{buffer} or \\{MF\_base\_default}}\2\6
+\&{begin} \37\&{if} $\|n+\|b-\|a+1+\\{base\_ext\_length}>\\{file\_name\_size}$ %
+\1\&{then}\5
+$\|b\K\|a+\\{file\_name\_size}-\|n-1-\\{base\_ext\_length}$;\2\6
+$\|k\K0$;\6
+\&{for} $\|j\K1\mathrel{\&{to}}\|n$ \1\&{do}\5
+$\\{append\_to\_name}(\\{xord}[\\{MF\_base\_default}[\|j]])$;\2\6
+\&{for} $\|j\K\|a\mathrel{\&{to}}\|b$ \1\&{do}\5
+$\\{append\_to\_name}(\\{buffer}[\|j])$;\2\6
+\&{for} $\|j\K\\{base\_default\_length}-\\{base\_ext\_length}+1\mathrel{\&{to}}%
+\\{base\_default\_length}$ \1\&{do}\5
+$\\{append\_to\_name}(\\{xord}[\\{MF\_base\_default}[\|j]])$;\2\6
+\&{if} $\|k\L\\{file\_name\_size}$ \1\&{then}\5
+$\\{name\_length}\K\|k$\ \&{else} $\\{name\_length}\K\\{file\_name\_size}$;\2\6
+\&{for} $\|k\K\\{name\_length}+1\mathrel{\&{to}}\\{file\_name\_size}$ \1\&{do}\5
+$\\{name\_of\_file}[\|k]\K\.{\'\ \'}$;\2\6
+\&{end};\par
+\fi
+
+\M779. Here is the only place we use \\{pack\_buffered\_name}. This part of the
+program
+becomes active when a ``virgin'' \MF\ is trying to get going, just after
+the preliminary initialization, or when the user is substituting another
+base file by typing `\.\&' after the initial `\.{**}' prompt. The buffer
+contains the first line of input in $\\{buffer}[\\{loc}\to(\\{last}-1)]$, where
+$\\{loc}<\\{last}$ and $\\{buffer}[\\{loc}]\I\.{"\ "}$.
+
+\Y\P$\4\X779:Declare the function called \\{open\_base\_file}\X\S$\6
+\4\&{function}\1\ \37\\{open\_base\_file}: \37\\{boolean};\6
+\4\&{label} \37$\\{found},\39\\{exit}$;\6
+\4\&{var} \37\|j: \37$0\to\\{buf\_size}$;\C{the first space after the file
+name}\2\6
+\&{begin} \37$\|j\K\\{loc}$;\6
+\&{if} $\\{buffer}[\\{loc}]=\.{"\&"}$ \1\&{then}\6
+\&{begin} \37$\\{incr}(\\{loc})$;\5
+$\|j\K\\{loc}$;\5
+$\\{buffer}[\\{last}]\K\.{"\ "}$;\6
+\&{while} $\\{buffer}[\|j]\I\.{"\ "}$ \1\&{do}\5
+$\\{incr}(\|j)$;\2\6
+$\\{pack\_buffered\_name}(0,\39\\{loc},\39\|j-1)$;\C{try first without the
+system file area}\6
+\&{if} $\\{w\_open\_in}(\\{base\_file})$ \1\&{then}\5
+\&{goto} \37\\{found};\2\6
+$\\{pack\_buffered\_name}(\\{base\_area\_length},\39\\{loc},\39\|j-1)$;\C{now
+try the system base file area}\6
+\&{if} $\\{w\_open\_in}(\\{base\_file})$ \1\&{then}\5
+\&{goto} \37\\{found};\2\6
+\\{wake\_up\_terminal};\5
+$\\{wterm\_ln}(\.{\'Sorry,\ I\ can\'}\.{\'t\ find\ that\ base;\'},\39\.{\'\
+will\ try\ PLAIN.\'})$;\5
+\\{update\_terminal};\6
+\&{end};\C{now pull out all the stops: try for the system \.{plain} file}\2\6
+$\\{pack\_buffered\_name}(\\{base\_default\_length}-\\{base\_ext\_length},\391,%
+\390)$;\6
+\&{if} $\R\\{w\_open\_in}(\\{base\_file})$ \1\&{then}\6
+\&{begin} \37\\{wake\_up\_terminal};\5
+$\\{wterm\_ln}(\.{\'I\ can\'}\.{\'t\ find\ the\ PLAIN\ base\ file!\'})$;\5
+$\\{open\_base\_file}\K\\{false}$;\5
+\&{return};\6
+\&{end};\2\6
+\4\\{found}: \37$\\{loc}\K\|j$;\5
+$\\{open\_base\_file}\K\\{true}$;\6
+\4\\{exit}: \37\&{end};\par
+\U1187.\fi
+
+\M780. Operating systems often make it possible to determine the exact name
+(and
+possible version number) of a file that has been opened. The following routine,
+which simply makes a \MF\ string from the value of \\{name\_of\_file}, should
+ideally be changed to deduce the full name of file~\|f, which is the file
+most recently opened, if it is possible to do this in a \PASCAL\ program.
+
+This routine might be called after string memory has overflowed, hence
+we dare not use `\\{str\_room}'.
+
+\Y\P\4\&{function}\1\ \37\\{make\_name\_string}: \37\\{str\_number};\6
+\4\&{var} \37\|k: \37$1\to\\{file\_name\_size}$;\C{index into \\{name\_of%
+\_file}}\2\6
+\&{begin} \37\&{if} $(\\{pool\_ptr}+\\{name\_length}>\\{pool\_size})\V(\\{str%
+\_ptr}=\\{max\_strings})$ \1\&{then}\5
+$\\{make\_name\_string}\K\.{"?"}$\6
+\4\&{else} \&{begin} \37\&{for} $\|k\K1\mathrel{\&{to}}\\{name\_length}$ \1%
+\&{do}\5
+$\\{append\_char}(\\{xord}[\\{name\_of\_file}[\|k]])$;\2\6
+$\\{make\_name\_string}\K\\{make\_string}$;\6
+\&{end};\2\6
+\&{end};\6
+\4\&{function}\1\ \37$\\{a\_make\_name\_string}(\mathop{\&{var}}\|f:\\{alpha%
+\_file})$: \37\\{str\_number};\2\6
+\&{begin} \37$\\{a\_make\_name\_string}\K\\{make\_name\_string}$;\6
+\&{end};\6
+\4\&{function}\1\ \37$\\{b\_make\_name\_string}(\mathop{\&{var}}\|f:\\{byte%
+\_file})$: \37\\{str\_number};\2\6
+\&{begin} \37$\\{b\_make\_name\_string}\K\\{make\_name\_string}$;\6
+\&{end};\6
+\4\&{function}\1\ \37$\\{w\_make\_name\_string}(\mathop{\&{var}}\|f:\\{word%
+\_file})$: \37\\{str\_number};\2\6
+\&{begin} \37$\\{w\_make\_name\_string}\K\\{make\_name\_string}$;\6
+\&{end};\par
+\fi
+
+\M781. Now let's consider the ``driver''
+routines by which \MF\ deals with file names
+in a system-independent manner. First comes a procedure that looks for a
+file name in the input by taking the information from the input buffer.
+(We can't use \\{get\_next}, because the conversion to tokens would
+destroy necessary information.)
+
+This procedure doesn't allow semicolons or percent signs to be part of
+file names, because of other conventions of \MF. The manual doesn't
+use semicolons or percents immediately after file names, but some users
+no doubt will find it natural to do so; therefore system-dependent
+changes to allow such characters in file names should probably
+be made with reluctance, and only when an entire file name that
+includes special characters is ``quoted'' somehow.
+
+\Y\P\4\&{procedure}\1\ \37\\{scan\_file\_name};\6
+\4\&{label} \37\\{done};\2\6
+\&{begin} \37\\{begin\_name};\6
+\&{while} $\\{buffer}[\\{loc}]=\.{"\ "}$ \1\&{do}\5
+$\\{incr}(\\{loc})$;\2\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $(\\{buffer}[\\{loc}]=\.{";"})\V(\\{buffer}[%
+\\{loc}]=\.{"\%"})$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\R\\{more\_name}(\\{buffer}[\\{loc}])$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{incr}(\\{loc})$;\6
+\&{end};\2\6
+\4\\{done}: \37\\{end\_name};\6
+\&{end};\par
+\fi
+
+\M782. The global variable \\{job\_name} contains the file name that was first
+\&{input} by the user. This name is extended by `\.{.log}' and `\.{.gf}' and
+`\.{.base}' and `\.{.tfm}' in the names of \MF's output files.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{job\_name}: \37\\{str\_number};\C{principal file name}\6
+\4\\{log\_opened}: \37\\{boolean};\C{has the transcript file been opened?}\6
+\4\\{log\_name}: \37\\{str\_number};\C{full name of the log file}\par
+\fi
+
+\M783. Initially $\\{job\_name}=0$; it becomes nonzero as soon as the true name
+is known.
+We have $\\{job\_name}=0$ if and only if the `\.{log}' file has not been
+opened,
+except of course for a short time just after \\{job\_name} has become nonzero.
+
+\Y\P$\4\X55:Initialize the output routines\X\mathrel{+}\S$\6
+$\\{job\_name}\K0$;\5
+$\\{log\_opened}\K\\{false}$;\par
+\fi
+
+\M784. Here is a routine that manufactures the output file names, assuming that
+$\\{job\_name}\I0$. It ignores and changes the current settings of \\{cur%
+\_area}
+and \\{cur\_ext}.
+
+\Y\P\D \37$\\{pack\_cur\_name}\S\\{pack\_file\_name}(\\{cur\_name},\39\\{cur%
+\_area},\39\\{cur\_ext})$\par
+\Y\P\4\&{procedure}\1\ \37$\\{pack\_job\_name}(\|s:\\{str\_number})$;\C{$\|s=%
+\.{".log"}$, \.{".gf"}, \.{".tfm"}, or \\{base\_extension}}\2\6
+\&{begin} \37$\\{cur\_area}\K\.{""}$;\5
+$\\{cur\_ext}\K\|s$;\5
+$\\{cur\_name}\K\\{job\_name}$;\5
+\\{pack\_cur\_name};\6
+\&{end};\par
+\fi
+
+\M785. Actually the main output file extension is usually something like
+\.{".300gf"} instead of just \.{".gf"}; the additional number indicates the
+resolution in pixels per inch, based on the setting of \\{hppp} when
+the file is opened.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{gf\_ext}: \37\\{str\_number};\C{default extension for the output file}\par
+\fi
+
+\M786. If some trouble arises when \MF\ tries to open a file, the following
+routine calls upon the user to supply another file name. Parameter~\|s
+is used in the error message to identify the type of file; parameter~\|e
+is the default extension if none is given. Upon exit from the routine,
+variables \\{cur\_name}, \\{cur\_area}, \\{cur\_ext}, and \\{name\_of\_file}
+are
+ready for another attempt at file opening.
+
+\Y\P\4\&{procedure}\1\ \37$\\{prompt\_file\_name}(\|s,\39\|e:\\{str%
+\_number})$;\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|k: \37$0\to\\{buf\_size}$;\C{index into \\{buffer}}\2\6
+\&{begin} \37\&{if} $\\{interaction}=\\{scroll\_mode}$ \1\&{then}\5
+\\{wake\_up\_terminal};\2\6
+\&{if} $\|s=\.{"input\ file\ name"}$ \1\&{then}\5
+$\\{print\_err}(\.{"I\ can\'t\ find\ file\ \`"})$\6
+\4\&{else} $\\{print\_err}(\.{"I\ can\'t\ write\ on\ file\ \`"})$;\2\6
+$\\{print\_file\_name}(\\{cur\_name},\39\\{cur\_area},\39\\{cur\_ext})$;\5
+$\\{print}(\.{"\'."})$;\6
+\&{if} $\|e=\.{".mf"}$ \1\&{then}\5
+\\{show\_context};\2\6
+$\\{print\_nl}(\.{"Please\ type\ another\ "})$;\5
+$\\{print}(\|s)$;\6
+\&{if} $\\{interaction}<\\{scroll\_mode}$ \1\&{then}\5
+$\\{fatal\_error}(\.{"***\ (job\ aborted,\ file\ error\ in\ nonstop\ mode)"})$;%
+\2\6
+\\{clear\_terminal};\5
+$\\{prompt\_input}(\.{":\ "})$;\5
+\X787:Scan file name in the buffer\X;\6
+\&{if} $\\{cur\_ext}=\.{""}$ \1\&{then}\5
+$\\{cur\_ext}\K\|e$;\2\6
+\\{pack\_cur\_name};\6
+\&{end};\par
+\fi
+
+\M787. \P$\X787:Scan file name in the buffer\X\S$\6
+\&{begin} \37\\{begin\_name};\5
+$\|k\K\\{first}$;\6
+\&{while} $(\\{buffer}[\|k]=\.{"\ "})\W(\|k<\\{last})$ \1\&{do}\5
+$\\{incr}(\|k)$;\2\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\|k=\\{last}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\R\\{more\_name}(\\{buffer}[\|k])$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\\{incr}(\|k)$;\6
+\&{end};\2\6
+\4\\{done}: \37\\{end\_name};\6
+\&{end}\par
+\U786.\fi
+
+\M788. The \\{open\_log\_file} routine is used to open the transcript file and
+to help
+it catch up to what has previously been printed on the terminal.
+
+\Y\P\4\&{procedure}\1\ \37\\{open\_log\_file};\6
+\4\&{var} \37\\{old\_setting}: \37$0\to\\{max\_selector}$;\C{previous %
+\\{selector} setting}\6
+\|k: \37$0\to\\{buf\_size}$;\C{index into \\{months} and \\{buffer}}\6
+\|l: \37$0\to\\{buf\_size}$;\C{end of first input line}\6
+\|m: \37\\{integer};\C{the current month}\6
+\\{months}: \37\&{packed} \37\&{array} $[1\to36]$ \1\&{of}\5
+\\{char};\C{abbreviations of month names}\2\2\6
+\&{begin} \37$\\{old\_setting}\K\\{selector}$;\6
+\&{if} $\\{job\_name}=0$ \1\&{then}\5
+$\\{job\_name}\K\.{"mfput"}$;\2\6
+$\\{pack\_job\_name}(\.{".log"})$;\6
+\&{while} $\R\\{a\_open\_out}(\\{log\_file})$ \1\&{do}\5
+\X789:Try to get a different log file name\X;\2\6
+$\\{log\_name}\K\\{a\_make\_name\_string}(\\{log\_file})$;\5
+$\\{selector}\K\\{log\_only}$;\5
+$\\{log\_opened}\K\\{true}$;\5
+\X790:Print the banner line, including the date and time\X;\6
+$\\{input\_stack}[\\{input\_ptr}]\K\\{cur\_input}$;\C{make sure bottom level is
+in memory}\6
+$\\{print\_nl}(\.{"**"})$;\5
+$\|l\K\\{input\_stack}[0].\\{limit\_field}-1$;\C{last position of first line}\6
+\&{for} $\|k\K1\mathrel{\&{to}}\|l$ \1\&{do}\5
+$\\{print}(\\{buffer}[\|k])$;\2\6
+\\{print\_ln};\C{now the transcript file contains the first line of input}\6
+$\\{selector}\K\\{old\_setting}+2$;\C{\\{log\_only} or \\{term\_and\_log}}\6
+\&{end};\par
+\fi
+
+\M789. Sometimes \\{open\_log\_file} is called at awkward moments when \MF\ is
+unable to print error messages or even to \\{show\_context}.
+The \\{prompt\_file\_name} routine can result in a \\{fatal\_error}, but the %
+\\{error}
+routine will not be invoked because \\{log\_opened} will be false.
+
+The normal idea of \\{batch\_mode} is that nothing at all should be written
+on the terminal. However, in the unusual case that
+no log file could be opened, we make an exception and allow
+an explanatory message to be seen.
+
+Incidentally, the program always refers to the log file as a `\.{transcript
+file}', because some systems cannot use the extension `\.{.log}' for
+this file.
+
+\Y\P$\4\X789:Try to get a different log file name\X\S$\6
+\&{begin} \37$\\{selector}\K\\{term\_only}$;\5
+$\\{prompt\_file\_name}(\.{"transcript\ file\ name"},\39\.{".log"})$;\6
+\&{end}\par
+\U788.\fi
+
+\M790. \P$\X790:Print the banner line, including the date and time\X\S$\6
+\&{begin} \37$\\{wlog}(\\{banner})$;\5
+$\\{slow\_print}(\\{base\_ident})$;\5
+$\\{print}(\.{"\ \ "})$;\5
+$\\{print\_int}(\\{round\_unscaled}(\\{internal}[\\{day}]))$;\5
+$\\{print\_char}(\.{"\ "})$;\5
+$\\{months}\K\.{\'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC\'}$;\5
+$\|m\K\\{round\_unscaled}(\\{internal}[\\{month}])$;\6
+\&{for} $\|k\K3\ast\|m-2\mathrel{\&{to}}3\ast\|m$ \1\&{do}\5
+$\\{wlog}(\\{months}[\|k])$;\2\6
+$\\{print\_char}(\.{"\ "})$;\5
+$\\{print\_int}(\\{round\_unscaled}(\\{internal}[\\{year}]))$;\5
+$\\{print\_char}(\.{"\ "})$;\5
+$\|m\K\\{round\_unscaled}(\\{internal}[\\{time}])$;\5
+$\\{print\_dd}(\|m\mathbin{\&{div}}60)$;\5
+$\\{print\_char}(\.{":"})$;\5
+$\\{print\_dd}(\|m\mathbin{\&{mod}}60)$;\6
+\&{end}\par
+\U788.\fi
+
+\M791. Here's an example of how these file-name-parsing routines work in
+practice.
+We shall use the macro \\{set\_output\_file\_name} when it is time to
+crank up the output file.
+
+\Y\P\D \37$\\{set\_output\_file\_name}\S$\1\6
+\&{begin} \37\&{if} $\\{job\_name}=0$ \1\&{then}\5
+\\{open\_log\_file};\2\6
+$\\{pack\_job\_name}(\\{gf\_ext})$;\6
+\&{while} $\R\\{b\_open\_out}(\\{gf\_file})$ \1\&{do}\5
+$\\{prompt\_file\_name}(\.{"file\ name\ for\ output"},\39\\{gf\_ext})$;\2\6
+$\\{output\_file\_name}\K\\{b\_make\_name\_string}(\\{gf\_file})$;\6
+\&{end}\2\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{gf\_file}: \37\\{byte\_file};\C{the generic font output goes here}\6
+\4\\{output\_file\_name}: \37\\{str\_number};\C{full name of the output file}%
+\par
+\fi
+
+\M792. \P$\X55:Initialize the output routines\X\mathrel{+}\S$\6
+$\\{output\_file\_name}\K0$;\par
+\fi
+
+\M793. Let's turn now to the procedure that is used to initiate file reading
+when an `\.{input}' command is being processed.
+
+\Y\P\4\&{procedure}\1\ \37\\{start\_input};\C{\MF\ will \.{input} something}\6
+\4\&{label} \37\\{done};\2\6
+\&{begin} \37\X795:Put the desired file name in $(\\{cur\_name},\\{cur\_ext},%
+\\{cur\_area})$\X;\6
+\&{if} $\\{cur\_ext}=\.{""}$ \1\&{then}\5
+$\\{cur\_ext}\K\.{".mf"}$;\2\6
+\\{pack\_cur\_name};\6
+\~ \1\&{loop}\ \&{begin} \37\\{begin\_file\_reading};\C{set up \\{cur\_file}
+and new level of input}\6
+\&{if} $\\{a\_open\_in}(\\{cur\_file})$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\\{cur\_area}=\.{""}$ \1\&{then}\6
+\&{begin} \37$\\{pack\_file\_name}(\\{cur\_name},\39\\{MF\_area},\39\\{cur%
+\_ext})$;\6
+\&{if} $\\{a\_open\_in}(\\{cur\_file})$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{end};\2\6
+\\{end\_file\_reading};\C{remove the level that didn't work}\6
+$\\{prompt\_file\_name}(\.{"input\ file\ name"},\39\.{".mf"})$;\6
+\&{end};\2\6
+\4\\{done}: \37$\\{name}\K\\{a\_make\_name\_string}(\\{cur\_file})$;\5
+$\\{str\_ref}[\\{cur\_name}]\K\\{max\_str\_ref}$;\6
+\&{if} $\\{job\_name}=0$ \1\&{then}\6
+\&{begin} \37$\\{job\_name}\K\\{cur\_name}$;\5
+\\{open\_log\_file};\6
+\&{end};\C{\\{open\_log\_file} doesn't \\{show\_context}, so \\{limit} and %
+\\{loc} needn't be set to meaningful values yet}\2\6
+\&{if} $\\{term\_offset}+\\{length}(\\{name})>\\{max\_print\_line}-2$ \1%
+\&{then}\5
+\\{print\_ln}\6
+\4\&{else} \&{if} $(\\{term\_offset}>0)\V(\\{file\_offset}>0)$ \1\&{then}\5
+$\\{print\_char}(\.{"\ "})$;\2\2\6
+$\\{print\_char}(\.{"("})$;\5
+$\\{incr}(\\{open\_parens})$;\5
+$\\{slow\_print}(\\{name})$;\5
+\\{update\_terminal};\6
+\&{if} $\\{name}=\\{str\_ptr}-1$ \1\&{then}\C{we can conserve string pool space
+now}\6
+\&{begin} \37$\\{flush\_string}(\\{name})$;\5
+$\\{name}\K\\{cur\_name}$;\6
+\&{end};\2\6
+\X794:Read the first line of the new file\X;\6
+\&{end};\par
+\fi
+
+\M794. Here we have to remember to tell the \\{input\_ln} routine not to
+start with a \\{get}. If the file is empty, it is considered to
+contain a single blank line.
+
+\Y\P$\4\X794:Read the first line of the new file\X\S$\6
+\&{begin} \37$\\{line}\K1$;\6
+\&{if} $\\{input\_ln}(\\{cur\_file},\39\\{false})$ \1\&{then}\5
+\\{do\_nothing};\2\6
+\\{firm\_up\_the\_line};\5
+$\\{buffer}[\\{limit}]\K\.{"\%"}$;\5
+$\\{first}\K\\{limit}+1$;\5
+$\\{loc}\K\\{start}$;\6
+\&{end}\par
+\U793.\fi
+
+\M795. \P$\X795:Put the desired file name in $(\\{cur\_name},\\{cur\_ext},%
+\\{cur\_area})$\X\S$\6
+\&{while} $\\{token\_state}\W(\\{loc}=\\{null})$ \1\&{do}\5
+\\{end\_token\_list};\2\6
+\&{if} $\\{token\_state}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"File\ names\ can\'t\ appear\ within\
+macros"})$;\5
+$\\{help3}(\.{"Sorry...I\'ve\ converted\ what\ follows\ to\ tokens,"})$\6
+$(\.{"possibly\ garbaging\ the\ name\ you\ gave."})$\6
+$(\.{"Please\ delete\ the\ tokens\ and\ insert\ the\ name\ again."})$;\6
+\\{error};\6
+\&{end};\2\6
+\&{if} $\\{file\_state}$ \1\&{then}\5
+\\{scan\_file\_name}\6
+\4\&{else} \&{begin} \37$\\{cur\_name}\K\.{""}$;\5
+$\\{cur\_ext}\K\.{""}$;\5
+$\\{cur\_area}\K\.{""}$;\6
+\&{end}\2\par
+\U793.\fi
+
+\N796. \[39] Introduction to the parsing routines.
+We come now to the central nervous system that sparks many of \MF's activities.
+By evaluating expressions, from their primary constituents to ever larger
+subexpressions, \MF\ builds the structures that ultimately define fonts of
+type.
+
+Four mutually recursive subroutines are involved in this process: We call them
+$$\hbox{\\{scan\_primary}, \\{scan\_secondary}, \\{scan\_tertiary},
+and \\{scan\_expression}.}$$
+Each of them is parameterless and begins with the first token to be scanned
+already represented in \\{cur\_cmd}, \\{cur\_mod}, and \\{cur\_sym}. After
+execution,
+the value of the primary or secondary or tertiary or expression that was
+found will appear in the global variables \\{cur\_type} and \\{cur\_exp}. The
+token following the expression will be represented in \\{cur\_cmd}, \\{cur%
+\_mod},
+and \\{cur\_sym}.
+
+Technically speaking, the parsing algorithms are ``LL(1),'' more or less;
+backup mechanisms have been added in order to provide reasonable error
+recovery.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{cur\_type}: \37\\{small\_number};\C{the type of the expression just found}%
+\6
+\4\\{cur\_exp}: \37\\{integer};\C{the value of the expression just found}\par
+\fi
+
+\M797. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{cur\_exp}\K0$;\par
+\fi
+
+\M798. Many different kinds of expressions are possible, so it is wise to have
+precise descriptions of what \\{cur\_type} and \\{cur\_exp} mean in all cases:
+
+\smallskip\hang
+$\\{cur\_type}=\\{vacuous}$ means that this expression didn't turn out to have
+a
+value at all, because it arose from a \&{begingroup}$\,\ldots\,$\&{endgroup}
+construction in which there was no expression before the \&{endgroup}.
+In this case \\{cur\_exp} has some irrelevant value.
+
+\smallskip\hang
+$\\{cur\_type}=\\{boolean\_type}$ means that \\{cur\_exp} is either \\{true%
+\_code}
+or \\{false\_code}.
+
+\smallskip\hang
+$\\{cur\_type}=\\{unknown\_boolean}$ means that \\{cur\_exp} points to a
+capsule
+node that is in the ring of variables equivalent
+to at least one undefined boolean variable.
+
+\smallskip\hang
+$\\{cur\_type}=\\{string\_type}$ means that \\{cur\_exp} is a string number
+(i.e., an
+integer in the range $0\L\\{cur\_exp}<\\{str\_ptr}$). That string's reference
+count
+includes this particular reference.
+
+\smallskip\hang
+$\\{cur\_type}=\\{unknown\_string}$ means that \\{cur\_exp} points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined string variable.
+
+\smallskip\hang
+$\\{cur\_type}=\\{pen\_type}$ means that \\{cur\_exp} points to a pen header
+node. This
+node contains a reference count, which takes account of this particular
+reference.
+
+\smallskip\hang
+$\\{cur\_type}=\\{unknown\_pen}$ means that \\{cur\_exp} points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined pen variable.
+
+\smallskip\hang
+$\\{cur\_type}=\\{future\_pen}$ means that \\{cur\_exp} points to a knot list
+that
+should eventually be made into a pen. Nobody else points to this particular
+knot list. The \\{future\_pen} option occurs only as an output of \\{scan%
+\_primary}
+and \\{scan\_secondary}, not as an output of \\{scan\_tertiary} or \\{scan%
+\_expression}.
+
+\smallskip\hang
+$\\{cur\_type}=\\{path\_type}$ means that \\{cur\_exp} points to a the first
+node of
+a path; nobody else points to this particular path. The control points of
+the path will have been chosen.
+
+\smallskip\hang
+$\\{cur\_type}=\\{unknown\_path}$ means that \\{cur\_exp} points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined path variable.
+
+\smallskip\hang
+$\\{cur\_type}=\\{picture\_type}$ means that \\{cur\_exp} points to an edges
+header node.
+Nobody else points to this particular set of edges.
+
+\smallskip\hang
+$\\{cur\_type}=\\{unknown\_picture}$ means that \\{cur\_exp} points to a
+capsule
+node that is in the ring of variables equivalent
+to at least one undefined picture variable.
+
+\smallskip\hang
+$\\{cur\_type}=\\{transform\_type}$ means that \\{cur\_exp} points to a %
+\\{transform\_type}
+capsule node. The \\{value} part of this capsule
+points to a transform node that contains six numeric values,
+each of which is \\{independent}, \\{dependent}, \\{proto\_dependent}, or %
+\\{known}.
+
+\smallskip\hang
+$\\{cur\_type}=\\{pair\_type}$ means that \\{cur\_exp} points to a capsule
+node whose type is \\{pair\_type}. The \\{value} part of this capsule
+points to a pair node that contains two numeric values,
+each of which is \\{independent}, \\{dependent}, \\{proto\_dependent}, or %
+\\{known}.
+
+\smallskip\hang
+$\\{cur\_type}=\\{known}$ means that \\{cur\_exp} is a \\{scaled} value.
+
+\smallskip\hang
+$\\{cur\_type}=\\{dependent}$ means that \\{cur\_exp} points to a capsule node
+whose type
+is \\{dependent}. The \\{dep\_list} field in this capsule points to the
+associated
+dependency list.
+
+\smallskip\hang
+$\\{cur\_type}=\\{proto\_dependent}$ means that \\{cur\_exp} points to a %
+\\{proto\_dependent}
+capsule node . The \\{dep\_list} field in this capsule
+points to the associated dependency list.
+
+\smallskip\hang
+$\\{cur\_type}=\\{independent}$ means that \\{cur\_exp} points to a capsule
+node
+whose type is \\{independent}. This somewhat unusual case can arise, for
+example, in the expression
+`$x+\&{begingroup}\penalty0\,\&{string}\,x; 0\,\&{endgroup}$'.
+
+\smallskip\hang
+$\\{cur\_type}=\\{token\_list}$ means that \\{cur\_exp} points to a linked list
+of
+tokens. This case arises only on the left-hand side of an assignment
+(`\.{:=}') operation, under very special circumstances.
+
+\smallskip\noindent
+The possible settings of \\{cur\_type} have been listed here in increasing
+numerical order. Notice that \\{cur\_type} will never be \\{numeric\_type} or
+\\{suffixed\_macro} or \\{unsuffixed\_macro}, although variables of those types
+are allowed. Conversely, \MF\ has no variables of type \\{vacuous} or
+\\{token\_list}.
+
+\fi
+
+\M799. Capsules are two-word nodes that have a similar meaning
+to \\{cur\_type} and \\{cur\_exp}. Such nodes have $\\{name\_type}=\\{capsule}$
+and $\\{link}\L\\{void}$; and their \\{type} field is one of the possibilities
+for
+\\{cur\_type} listed above.
+
+The \\{value} field of a capsule is, in most cases, the value that
+corresponds to its \\{type}, as \\{cur\_exp} corresponds to \\{cur\_type}.
+However, when \\{cur\_exp} would point to a capsule,
+no extra layer of indirection is present; the \\{value}
+field is what would have been called $\\{value}(\\{cur\_exp})$ if it had not
+been
+encapsulated. Furthermore, if the type is \\{dependent} or
+\\{proto\_dependent}, the \\{value} field of a capsule is replaced by
+\\{dep\_list} and \\{prev\_dep} fields, since dependency lists in capsules are
+always part of the general \\{dep\_list} structure.
+
+The \\{get\_x\_next} routine is careful not to change the values of \\{cur%
+\_type}
+and \\{cur\_exp} when it gets an expanded token. However, \\{get\_x\_next}
+might
+call a macro, which might parse an expression, which might execute lots of
+commands in a group; hence it's possible that \\{cur\_type} might change
+from, say, \\{unknown\_boolean} to \\{boolean\_type}, or from \\{dependent} to
+\\{known} or \\{independent}, during the time \\{get\_x\_next} is called. The
+programs below are careful to stash sensitive intermediate results in
+capsules, so that \MF's generality doesn't cause trouble.
+
+Here's a procedure that illustrates these conventions. It takes
+the contents of $(\\{cur\_type}\kern-.3pt,\\{cur\_exp}\kern-.3pt)$
+and stashes them away in a
+capsule. It is not used when $\\{cur\_type}=\\{token\_list}$.
+After the operation, $\\{cur\_type}=\\{vacuous}$; hence there is no need to
+copy path lists or to update reference counts, etc.
+
+The special link \\{void} is put on the capsule returned by
+\\{stash\_cur\_exp}, because this procedure is used to store macro parameters
+that must be easily distinguishable from token lists.
+
+\Y\P$\4\X799:Declare the stashing/unstashing routines\X\S$\6
+\4\&{function}\1\ \37\\{stash\_cur\_exp}: \37\\{pointer};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the capsule that will be returned}\2\6
+\&{begin} \37\&{case} $\\{cur\_type}$ \1\&{of}\6
+\4$\\{unknown\_types},\39\\{transform\_type},\39\\{pair\_type},\39%
+\\{dependent},\39\\{proto\_dependent},\39\\{independent}$: \37$\|p\K\\{cur%
+\_exp}$;\6
+\4\&{othercases} \37\&{begin} \37$\|p\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{name\_type}(\|p)\K\\{capsule}$;\5
+$\\{type}(\|p)\K\\{cur\_type}$;\5
+$\\{value}(\|p)\K\\{cur\_exp}$;\6
+\&{end}\2\6
+\&{endcases};\6
+$\\{cur\_type}\K\\{vacuous}$;\5
+$\\{link}(\|p)\K\\{void}$;\5
+$\\{stash\_cur\_exp}\K\|p$;\6
+\&{end};\par
+\A800.
+\U801.\fi
+
+\M800. The inverse of \\{stash\_cur\_exp} is the following procedure, which
+deletes an unnecessary capsule and puts its contents into \\{cur\_type}
+and \\{cur\_exp}.
+
+The program steps of \MF\ can be divided into two categories: those in
+which \\{cur\_type} and \\{cur\_exp} are ``alive'' and those in which they are
+``dead,'' in the sense that \\{cur\_type} and \\{cur\_exp} contain relevant
+information or not. It's important not to ignore them when they're alive,
+and it's important not to pay attention to them when they're dead.
+
+There's also an intermediate category: If $\\{cur\_type}=\\{vacuous}$, then
+\\{cur\_exp} is irrelevant, hence we can proceed without caring if \\{cur%
+\_type}
+and \\{cur\_exp} are alive or dead. In such cases we say that \\{cur\_type}
+and \\{cur\_exp} are {\sl dormant}. It is permissible to call \\{get\_x\_next}
+only when they are alive or dormant.
+
+The \\{stash} procedure above assumes that \\{cur\_type} and \\{cur\_exp}
+are alive or dormant. The \\{unstash} procedure assumes that they are
+dead or dormant; it resuscitates them.
+
+\Y\P$\4\X799:Declare the stashing/unstashing routines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{unstash\_cur\_exp}(\|p:\\{pointer})$;\2\6
+\&{begin} \37$\\{cur\_type}\K\\{type}(\|p)$;\6
+\&{case} $\\{cur\_type}$ \1\&{of}\6
+\4$\\{unknown\_types},\39\\{transform\_type},\39\\{pair\_type},\39%
+\\{dependent},\39\\{proto\_dependent},\39\\{independent}$: \37$\\{cur\_exp}\K%
+\|p$;\6
+\4\&{othercases} \37\&{begin} \37$\\{cur\_exp}\K\\{value}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$;\6
+\&{end}\2\6
+\&{endcases};\6
+\&{end};\par
+\fi
+
+\M801. The following procedure prints the values of expressions in an
+abbreviated format. If its first parameter \|p is null, the value of
+$(\\{cur\_type},\\{cur\_exp})$ is displayed; otherwise \|p should be a capsule
+containing the desired value. The second parameter controls the amount of
+output. If it is~0, dependency lists will be abbreviated to
+`\.{linearform}' unless they consist of a single term. If it is greater
+than~1, complicated structures (pens, pictures, and paths) will be displayed
+in full.
+
+\Y\P$\4\X257:Declare subroutines for printing expressions\X\mathrel{+}\S$\6
+\hbox{\4}\X805:Declare the procedure called \\{print\_dp}\X\6
+\hbox{\4}\X799:Declare the stashing/unstashing routines\X\6
+\4\&{procedure}\1\ \37$\\{print\_exp}(\|p:\\{pointer};\,\35\\{verbosity}:%
+\\{small\_number})$;\6
+\4\&{var} \37\\{restore\_cur\_exp}: \37\\{boolean};\C{should \\{cur\_exp} be
+restored?}\6
+\|t: \37\\{small\_number};\C{the type of the expression}\6
+\|v: \37\\{integer};\C{the value of the expression}\6
+\|q: \37\\{pointer};\C{a big node being displayed}\2\6
+\&{begin} \37\&{if} $\|p\I\\{null}$ \1\&{then}\5
+$\\{restore\_cur\_exp}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\|p\K\\{stash\_cur\_exp}$;\5
+$\\{restore\_cur\_exp}\K\\{true}$;\6
+\&{end};\2\6
+$\|t\K\\{type}(\|p)$;\6
+\&{if} $\|t<\\{dependent}$ \1\&{then}\5
+$\|v\K\\{value}(\|p)$\ \&{else} \&{if} $\|t<\\{independent}$ \1\&{then}\5
+$\|v\K\\{dep\_list}(\|p)$;\2\2\6
+\X802:Print an abbreviated value of \|v with format depending on \|t\X;\6
+\&{if} $\\{restore\_cur\_exp}$ \1\&{then}\5
+$\\{unstash\_cur\_exp}(\|p)$;\2\6
+\&{end};\par
+\fi
+
+\M802. \P$\X802:Print an abbreviated value of \|v with format depending on \|t%
+\X\S$\6
+\&{case} $\|t$ \1\&{of}\6
+\4\\{vacuous}: \37$\\{print}(\.{"vacuous"})$;\6
+\4\\{boolean\_type}: \37\&{if} $\|v=\\{true\_code}$ \1\&{then}\5
+$\\{print}(\.{"true"})$\ \&{else} $\\{print}(\.{"false"})$;\2\6
+\4$\\{unknown\_types},\39\\{numeric\_type}$: \37\X806:Display a variable that's
+been declared but not defined\X;\6
+\4\\{string\_type}: \37\&{begin} \37$\\{print\_char}(\.{""}\.{""})$;\5
+$\\{slow\_print}(\|v)$;\5
+$\\{print\_char}(\.{""}\.{""})$;\6
+\&{end};\6
+\4$\\{pen\_type},\39\\{future\_pen},\39\\{path\_type},\39\\{picture\_type}$: %
+\37\X804:Display a complex type\X;\6
+\4$\\{transform\_type},\39\\{pair\_type}$: \37\&{if} $\|v=\\{null}$ \1\&{then}\5
+$\\{print\_type}(\|t)$\6
+\4\&{else} \X803:Display a big node\X;\2\6
+\4\\{known}: \37$\\{print\_scaled}(\|v)$;\6
+\4$\\{dependent},\39\\{proto\_dependent}$: \37$\\{print\_dp}(\|t,\39\|v,\39%
+\\{verbosity})$;\6
+\4\\{independent}: \37$\\{print\_variable\_name}(\|p)$;\6
+\4\&{othercases} \37$\\{confusion}(\.{"exp"})$\2\6
+\&{endcases}\par
+\U801.\fi
+
+\M803. \P$\X803:Display a big node\X\S$\6
+\&{begin} \37$\\{print\_char}(\.{"("})$;\5
+$\|q\K\|v+\\{big\_node\_size}[\|t]$;\6
+\1\&{repeat} \37\&{if} $\\{type}(\|v)=\\{known}$ \1\&{then}\5
+$\\{print\_scaled}(\\{value}(\|v))$\6
+\4\&{else} \&{if} $\\{type}(\|v)=\\{independent}$ \1\&{then}\5
+$\\{print\_variable\_name}(\|v)$\6
+\4\&{else} $\\{print\_dp}(\\{type}(\|v),\39\\{dep\_list}(\|v),\39%
+\\{verbosity})$;\2\2\6
+$\|v\K\|v+2$;\6
+\&{if} $\|v\I\|q$ \1\&{then}\5
+$\\{print\_char}(\.{","})$;\2\6
+\4\&{until}\5
+$\|v=\|q$;\2\6
+$\\{print\_char}(\.{")"})$;\6
+\&{end}\par
+\U802.\fi
+
+\M804. Values of type \&{picture}, \&{path}, and \&{pen} are displayed
+verbosely
+in the log file only, unless the user has given a positive value to
+\\{tracingonline}.
+
+\Y\P$\4\X804:Display a complex type\X\S$\6
+\&{if} $\\{verbosity}\L1$ \1\&{then}\5
+$\\{print\_type}(\|t)$\6
+\4\&{else} \&{begin} \37\&{if} $\\{selector}=\\{term\_and\_log}$ \1\&{then}\6
+\&{if} $\\{internal}[\\{tracing\_online}]\L0$ \1\&{then}\6
+\&{begin} \37$\\{selector}\K\\{term\_only}$;\5
+$\\{print\_type}(\|t)$;\5
+$\\{print}(\.{"\ (see\ the\ transcript\ file)"})$;\5
+$\\{selector}\K\\{term\_and\_log}$;\6
+\&{end};\2\2\6
+\&{case} $\|t$ \1\&{of}\6
+\4\\{pen\_type}: \37$\\{print\_pen}(\|v,\39\.{""},\39\\{false})$;\6
+\4\\{future\_pen}: \37$\\{print\_path}(\|v,\39\.{"\ (future\ pen)"},\39%
+\\{false})$;\6
+\4\\{path\_type}: \37$\\{print\_path}(\|v,\39\.{""},\39\\{false})$;\6
+\4\\{picture\_type}: \37\&{begin} \37$\\{cur\_edges}\K\|v$;\5
+$\\{print\_edges}(\.{""},\39\\{false},\390,\390)$;\6
+\&{end};\2\6
+\&{end};\C{there are no other cases}\6
+\&{end}\2\par
+\U802.\fi
+
+\M805. \P$\X805:Declare the procedure called \\{print\_dp}\X\S$\6
+\4\&{procedure}\1\ \37$\\{print\_dp}(\|t:\\{small\_number};\,\35\|p:%
+\\{pointer};\,\35\\{verbosity}:\\{small\_number})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the node following \|p}\2\6
+\&{begin} \37$\|q\K\\{link}(\|p)$;\6
+\&{if} $(\\{info}(\|q)=\\{null})\V(\\{verbosity}>0)$ \1\&{then}\5
+$\\{print\_dependency}(\|p,\39\|t)$\6
+\4\&{else} $\\{print}(\.{"linearform"})$;\2\6
+\&{end};\par
+\U801.\fi
+
+\M806. The displayed name of a variable in a ring will not be a capsule unless
+the ring consists entirely of capsules.
+
+\Y\P$\4\X806:Display a variable that's been declared but not defined\X\S$\6
+\&{begin} \37$\\{print\_type}(\|t)$;\6
+\&{if} $\|v\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{print\_char}(\.{"\ "})$;\6
+\&{while} $(\\{name\_type}(\|v)=\\{capsule})\W(\|v\I\|p)$ \1\&{do}\5
+$\|v\K\\{value}(\|v)$;\2\6
+$\\{print\_variable\_name}(\|v)$;\6
+\&{end};\2\6
+\&{end}\par
+\U802.\fi
+
+\M807. When errors are detected during parsing, it is often helpful to
+display an expression just above the error message, using \\{exp\_err}
+or \\{disp\_err} instead of \\{print\_err}.
+
+\Y\P\D \37$\\{exp\_err}(\#)\S\\{disp\_err}(\\{null},\39\#)$\C{displays the
+current expression}\par
+\Y\P$\4\X257:Declare subroutines for printing expressions\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{disp\_err}(\|p:\\{pointer};\,\35\|s:\\{str%
+\_number})$;\2\6
+\&{begin} \37\&{if} $\\{interaction}=\\{error\_stop\_mode}$ \1\&{then}\5
+\\{wake\_up\_terminal};\2\6
+$\\{print\_nl}(\.{">>\ "})$;\5
+$\\{print\_exp}(\|p,\391)$;\C{``medium verbose'' printing of the expression}\6
+\&{if} $\|s\I\.{""}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"!\ "})$;\5
+$\\{print}(\|s)$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M808. If \\{cur\_type} and \\{cur\_exp} contain relevant information that
+should
+be recycled, we will use the following procedure, which changes \\{cur\_type}
+to \\{known} and stores a given value in \\{cur\_exp}. We can think of \\{cur%
+\_type}
+and \\{cur\_exp} as either alive or dormant after this has been done,
+because \\{cur\_exp} will not contain a pointer value.
+
+\Y\P$\4\X808:Declare the procedure called \\{flush\_cur\_exp}\X\S$\6
+\4\&{procedure}\1\ \37$\\{flush\_cur\_exp}(\|v:\\{scaled})$;\2\6
+\&{begin} \37\&{case} $\\{cur\_type}$ \1\&{of}\6
+\4$\\{unknown\_types},\39\\{transform\_type},\39\\{pair\_type},\39\30%
+\\{dependent},\39\\{proto\_dependent},\39\\{independent}$: \37\&{begin} \37$%
+\\{recycle\_value}(\\{cur\_exp})$;\5
+$\\{free\_node}(\\{cur\_exp},\39\\{value\_node\_size})$;\6
+\&{end};\6
+\4\\{pen\_type}: \37$\\{delete\_pen\_ref}(\\{cur\_exp})$;\6
+\4\\{string\_type}: \37$\\{delete\_str\_ref}(\\{cur\_exp})$;\6
+\4$\\{future\_pen},\39\\{path\_type}$: \37$\\{toss\_knot\_list}(\\{cur\_exp})$;%
+\6
+\4\\{picture\_type}: \37$\\{toss\_edges}(\\{cur\_exp})$;\6
+\4\&{othercases} \37\\{do\_nothing}\2\6
+\&{endcases};\6
+$\\{cur\_type}\K\\{known}$;\5
+$\\{cur\_exp}\K\|v$;\6
+\&{end};\par
+\A820.
+\U246.\fi
+
+\M809. There's a much more general procedure that is capable of releasing
+the storage associated with any two-word value packet.
+
+\Y\P$\4\X268:Declare the recycling subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{recycle\_value}(\|p:\\{pointer})$;\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|t: \37\\{small\_number};\C{a type code}\6
+\|v: \37\\{integer};\C{a value}\6
+\\{vv}: \37\\{integer};\C{another value}\6
+$\|q,\39\|r,\39\|s,\39\\{pp}$: \37\\{pointer};\C{link manipulation registers}\2%
+\6
+\&{begin} \37$\|t\K\\{type}(\|p)$;\6
+\&{if} $\|t<\\{dependent}$ \1\&{then}\5
+$\|v\K\\{value}(\|p)$;\2\6
+\&{case} $\|t$ \1\&{of}\6
+\4$\\{undefined},\39\\{vacuous},\39\\{boolean\_type},\39\\{known},\39\\{numeric%
+\_type}$: \37\\{do\_nothing};\6
+\4\\{unknown\_types}: \37$\\{ring\_delete}(\|p)$;\6
+\4\\{string\_type}: \37$\\{delete\_str\_ref}(\|v)$;\6
+\4\\{pen\_type}: \37$\\{delete\_pen\_ref}(\|v)$;\6
+\4$\\{path\_type},\39\\{future\_pen}$: \37$\\{toss\_knot\_list}(\|v)$;\6
+\4\\{picture\_type}: \37$\\{toss\_edges}(\|v)$;\6
+\4$\\{pair\_type},\39\\{transform\_type}$: \37\X810:Recycle a big node\X;\6
+\4$\\{dependent},\39\\{proto\_dependent}$: \37\X811:Recycle a dependency list%
+\X;\6
+\4\\{independent}: \37\X812:Recycle an independent variable\X;\6
+\4$\\{token\_list},\39\\{structured}$: \37$\\{confusion}(\.{"recycle"})$;\6
+\4$\\{unsuffixed\_macro},\39\\{suffixed\_macro}$: \37$\\{delete\_mac\_ref}(%
+\\{value}(\|p))$;\2\6
+\&{end};\C{there are no other cases}\6
+$\\{type}(\|p)\K\\{undefined}$;\6
+\&{end};\par
+\fi
+
+\M810. \P$\X810:Recycle a big node\X\S$\6
+\&{if} $\|v\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\|q\K\|v+\\{big\_node\_size}[\|t]$;\6
+\1\&{repeat} \37$\|q\K\|q-2$;\5
+$\\{recycle\_value}(\|q)$;\6
+\4\&{until}\5
+$\|q=\|v$;\2\6
+$\\{free\_node}(\|v,\39\\{big\_node\_size}[\|t])$;\6
+\&{end}\2\par
+\U809.\fi
+
+\M811. \P$\X811:Recycle a dependency list\X\S$\6
+\&{begin} \37$\|q\K\\{dep\_list}(\|p)$;\6
+\&{while} $\\{info}(\|q)\I\\{null}$ \1\&{do}\5
+$\|q\K\\{link}(\|q)$;\2\6
+$\\{link}(\\{prev\_dep}(\|p))\K\\{link}(\|q)$;\5
+$\\{prev\_dep}(\\{link}(\|q))\K\\{prev\_dep}(\|p)$;\5
+$\\{link}(\|q)\K\\{null}$;\5
+$\\{flush\_node\_list}(\\{dep\_list}(\|p))$;\6
+\&{end}\par
+\U809.\fi
+
+\M812. When an independent variable disappears, it simply fades away, unless
+something depends on it. In the latter case, a dependent variable whose
+coefficient of dependence is maximal will take its place.
+The relevant algorithm is due to Ignacio~A. Zabala, who implemented it
+as part of his Ph.D. thesis (Stanford University, December 1982).
+
+For example, suppose that variable $x$ is being recycled, and that the
+only variables depending on~$x$ are $y=2x+a$ and $z=x+b$. In this case
+we want to make $y$ independent and $z=.5y-.5a+b$; no other variables
+will depend on~$y$. If $\\{tracingequations}>0$ in this situation,
+we will print `\.{\#\#\# -2x=-y+a}'.
+
+There's a slight complication, however: An independent variable $x$
+can occur both in dependency lists and in proto-dependency lists.
+This makes it necessary to be careful when deciding which coefficient
+is maximal.
+
+Furthermore, this complication is not so slight when
+a proto-dependent variable is chosen to become independent. For example,
+suppose that $y=2x+100a$ is proto-dependent while $z=x+b$ is dependent;
+then we must change $z=.5y-50a+b$ to a proto-dependency, because of the
+large coefficient `50'.
+
+In order to deal with these complications without wasting too much time,
+we shall link together the occurrences of~$x$ among all the linear
+dependencies, maintaining separate lists for the dependent and
+proto-dependent cases.
+
+\Y\P$\4\X812:Recycle an independent variable\X\S$\6
+\&{begin} \37$\\{max\_c}[\\{dependent}]\K0$;\5
+$\\{max\_c}[\\{proto\_dependent}]\K0$;\6
+$\\{max\_link}[\\{dependent}]\K\\{null}$;\5
+$\\{max\_link}[\\{proto\_dependent}]\K\\{null}$;\6
+$\|q\K\\{link}(\\{dep\_head})$;\6
+\&{while} $\|q\I\\{dep\_head}$ \1\&{do}\6
+\&{begin} \37$\|s\K\\{value\_loc}(\|q)$;\C{now $\\{link}(\|s)=\\{dep\_list}(%
+\|q)$}\6
+\~ \1\&{loop}\ \&{begin} \37$\|r\K\\{link}(\|s)$;\6
+\&{if} $\\{info}(\|r)=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\\{info}(\|r)\I\|p$ \1\&{then}\5
+$\|s\K\|r$\6
+\4\&{else} \&{begin} \37$\|t\K\\{type}(\|q)$;\5
+$\\{link}(\|s)\K\\{link}(\|r)$;\5
+$\\{info}(\|r)\K\|q$;\6
+\&{if} $\\{abs}(\\{value}(\|r))>\\{max\_c}[\|t]$ \1\&{then}\5
+\X814:Record a new maximum coefficient of type \|t\X\6
+\4\&{else} \&{begin} \37$\\{link}(\|r)\K\\{max\_link}[\|t]$;\5
+$\\{max\_link}[\|t]\K\|r$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\2\6
+\4\\{done}: \37$\|q\K\\{link}(\|r)$;\6
+\&{end};\2\6
+\&{if} $(\\{max\_c}[\\{dependent}]>0)\V(\\{max\_c}[\\{proto\_dependent}]>0)$ \1%
+\&{then}\5
+\X815:Choose a dependent variable to take the place of the disappearing
+independent variable, and change all remaining dependencies accordingly\X;\2\6
+\&{end}\par
+\U809.\fi
+
+\M813. The code for independency removal makes use of three two-word arrays.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{max\_c}: \37\&{array} $[\\{dependent}\to\\{proto\_dependent}]$ \1\&{of}\5
+\\{integer};\C{max coefficient magnitude}\2\6
+\4\\{max\_ptr}: \37\&{array} $[\\{dependent}\to\\{proto\_dependent}]$ \1\&{of}\5
+\\{pointer};\C{where \|p occurs with \\{max\_c}}\2\6
+\4\\{max\_link}: \37\&{array} $[\\{dependent}\to\\{proto\_dependent}]$ \1\&{of}%
+\5
+\\{pointer};\C{other occurrences of \|p}\2\par
+\fi
+
+\M814. \P$\X814:Record a new maximum coefficient of type \|t\X\S$\6
+\&{begin} \37\&{if} $\\{max\_c}[\|t]>0$ \1\&{then}\6
+\&{begin} \37$\\{link}(\\{max\_ptr}[\|t])\K\\{max\_link}[\|t]$;\5
+$\\{max\_link}[\|t]\K\\{max\_ptr}[\|t]$;\6
+\&{end};\2\6
+$\\{max\_c}[\|t]\K\\{abs}(\\{value}(\|r))$;\5
+$\\{max\_ptr}[\|t]\K\|r$;\6
+\&{end}\par
+\U812.\fi
+
+\M815. \P$\X815:Choose a dependent variable to take the place of the
+disappearing independent variable, and change all remaining dependencies
+accordingly\X\S$\6
+\&{begin} \37\&{if} $(\\{max\_c}[\\{dependent}]\mathbin{\&{div}}\O{10000}\G%
+\\{max\_c}[\\{proto\_dependent}])$ \1\&{then}\5
+$\|t\K\\{dependent}$\6
+\4\&{else} $\|t\K\\{proto\_dependent}$;\2\6
+\X816:Determine the dependency list \|s to substitute for the independent
+variable~\|p\X;\6
+$\|t\K\\{dependent}+\\{proto\_dependent}-\|t$;\C{complement \|t}\6
+\&{if} $\\{max\_c}[\|t]>0$ \1\&{then}\C{we need to pick up an unchosen
+dependency}\6
+\&{begin} \37$\\{link}(\\{max\_ptr}[\|t])\K\\{max\_link}[\|t]$;\5
+$\\{max\_link}[\|t]\K\\{max\_ptr}[\|t]$;\6
+\&{end};\2\6
+\&{if} $\|t\I\\{dependent}$ \1\&{then}\5
+\X818:Substitute new dependencies in place of \|p\X\6
+\4\&{else} \X819:Substitute new proto-dependencies in place of \|p\X;\2\6
+$\\{flush\_node\_list}(\|s)$;\6
+\&{if} $\\{fix\_needed}$ \1\&{then}\5
+\\{fix\_dependencies};\2\6
+\\{check\_arith};\6
+\&{end}\par
+\U812.\fi
+
+\M816. Let $\|s=\\{max\_ptr}[\|t]$. At this point we have $\\{value}(s)=\pm%
+\\{max\_c}[t]$,
+and $\\{info}(\|s)$ points to the dependent variable~\\{pp} of type~\|t from
+whose dependency list we have removed node~\|s. We must reinsert
+node~\|s into the dependency list, with coefficient $-1.0$, and with
+\\{pp} as the new independent variable. Since \\{pp} will have a larger serial
+number than any other variable, we can put node \|s at the head of the
+list.
+
+\Y\P$\4\X816:Determine the dependency list \|s to substitute for the
+independent variable~\|p\X\S$\6
+$\|s\K\\{max\_ptr}[\|t]$;\5
+$\\{pp}\K\\{info}(\|s)$;\5
+$\|v\K\\{value}(\|s)$;\6
+\&{if} $\|t=\\{dependent}$ \1\&{then}\5
+$\\{value}(\|s)\K-\\{fraction\_one}$\ \&{else} $\\{value}(\|s)\K-\\{unity}$;\2\6
+$\|r\K\\{dep\_list}(\\{pp})$;\5
+$\\{link}(\|s)\K\|r$;\6
+\&{while} $\\{info}(\|r)\I\\{null}$ \1\&{do}\5
+$\|r\K\\{link}(\|r)$;\2\6
+$\|q\K\\{link}(\|r)$;\5
+$\\{link}(\|r)\K\\{null}$;\5
+$\\{prev\_dep}(\|q)\K\\{prev\_dep}(\\{pp})$;\5
+$\\{link}(\\{prev\_dep}(\\{pp}))\K\|q$;\5
+$\\{new\_indep}(\\{pp})$;\6
+\&{if} $\\{cur\_exp}=\\{pp}$ \1\&{then}\6
+\&{if} $\\{cur\_type}=\|t$ \1\&{then}\5
+$\\{cur\_type}\K\\{independent}$;\2\2\6
+\&{if} $\\{internal}[\\{tracing\_equations}]>0$ \1\&{then}\5
+\X817:Show the transformed dependency\X\2\par
+\U815.\fi
+
+\M817. Now $(-v)$ times the formerly independent variable~\|p is being replaced
+by the dependency list~\|s.
+
+\Y\P$\4\X817:Show the transformed dependency\X\S$\6
+\&{if} $\\{interesting}(\|p)$ \1\&{then}\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\#\#\#\ "})$;\6
+\&{if} $\|v>0$ \1\&{then}\5
+$\\{print\_char}(\.{"-"})$;\2\6
+\&{if} $\|t=\\{dependent}$ \1\&{then}\5
+$\\{vv}\K\\{round\_fraction}(\\{max\_c}[\\{dependent}])$\6
+\4\&{else} $\\{vv}\K\\{max\_c}[\\{proto\_dependent}]$;\2\6
+\&{if} $\\{vv}\I\\{unity}$ \1\&{then}\5
+$\\{print\_scaled}(\\{vv})$;\2\6
+$\\{print\_variable\_name}(\|p)$;\6
+\&{while} $\\{value}(\|p)\mathbin{\&{mod}}\\{s\_scale}>0$ \1\&{do}\6
+\&{begin} \37$\\{print}(\.{"*4"})$;\5
+$\\{value}(\|p)\K\\{value}(\|p)-2$;\6
+\&{end};\2\6
+\&{if} $\|t=\\{dependent}$ \1\&{then}\5
+$\\{print\_char}(\.{"="})$\ \&{else} $\\{print}(\.{"\ =\ "})$;\2\6
+$\\{print\_dependency}(\|s,\39\|t)$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\2\par
+\U816.\fi
+
+\M818. Finally, there are dependent and proto-dependent variables whose
+dependency lists must be brought up to date.
+
+\Y\P$\4\X818:Substitute new dependencies in place of \|p\X\S$\6
+\&{for} $\|t\K\\{dependent}\mathrel{\&{to}}\\{proto\_dependent}$ \1\&{do}\6
+\&{begin} \37$\|r\K\\{max\_link}[\|t]$;\6
+\&{while} $\|r\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\|q\K\\{info}(\|r)$;\5
+$\\{dep\_list}(\|q)\K\\{p\_plus\_fq}(\\{dep\_list}(\|q),\39\30\\{make%
+\_fraction}(\\{value}(\|r),\39-\|v),\39\|s,\39\|t,\39\\{dependent})$;\6
+\&{if} $\\{dep\_list}(\|q)=\\{dep\_final}$ \1\&{then}\5
+$\\{make\_known}(\|q,\39\\{dep\_final})$;\2\6
+$\|q\K\|r$;\5
+$\|r\K\\{link}(\|r)$;\5
+$\\{free\_node}(\|q,\39\\{dep\_node\_size})$;\6
+\&{end};\2\6
+\&{end}\2\par
+\U815.\fi
+
+\M819. \P$\X819:Substitute new proto-dependencies in place of \|p\X\S$\6
+\&{for} $\|t\K\\{dependent}\mathrel{\&{to}}\\{proto\_dependent}$ \1\&{do}\6
+\&{begin} \37$\|r\K\\{max\_link}[\|t]$;\6
+\&{while} $\|r\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\|q\K\\{info}(\|r)$;\6
+\&{if} $\|t=\\{dependent}$ \1\&{then}\C{for safety's sake, we change \|q to %
+\\{proto\_dependent}}\6
+\&{begin} \37\&{if} $\\{cur\_exp}=\|q$ \1\&{then}\6
+\&{if} $\\{cur\_type}=\\{dependent}$ \1\&{then}\5
+$\\{cur\_type}\K\\{proto\_dependent}$;\2\2\6
+$\\{dep\_list}(\|q)\K\\{p\_over\_v}(\\{dep\_list}(\|q),\39\\{unity},\39%
+\\{dependent},\39\\{proto\_dependent})$;\5
+$\\{type}(\|q)\K\\{proto\_dependent}$;\5
+$\\{value}(\|r)\K\\{round\_fraction}(\\{value}(\|r))$;\6
+\&{end};\2\6
+$\\{dep\_list}(\|q)\K\\{p\_plus\_fq}(\\{dep\_list}(\|q),\39\30\\{make\_scaled}(%
+\\{value}(\|r),\39-\|v),\39\|s,\39\\{proto\_dependent},\39\\{proto%
+\_dependent})$;\6
+\&{if} $\\{dep\_list}(\|q)=\\{dep\_final}$ \1\&{then}\5
+$\\{make\_known}(\|q,\39\\{dep\_final})$;\2\6
+$\|q\K\|r$;\5
+$\|r\K\\{link}(\|r)$;\5
+$\\{free\_node}(\|q,\39\\{dep\_node\_size})$;\6
+\&{end};\2\6
+\&{end}\2\par
+\U815.\fi
+
+\M820. Here are some routines that provide handy combinations of actions
+that are often needed during error recovery. For example,
+`\\{flush\_error}' flushes the current expression, replaces it by
+a given value, and calls \\{error}.
+
+Errors often are detected after an extra token has already been scanned.
+The `\\{put\_get}' routines put that token back before calling \\{error};
+then they get it back again. (Or perhaps they get another token, if
+the user has changed things.)
+
+\Y\P$\4\X808:Declare the procedure called \\{flush\_cur\_exp}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{flush\_error}(\|v:\\{scaled})$;\ \2\6
+\&{begin} \37\\{error};\5
+$\\{flush\_cur\_exp}(\|v)$;\ \&{end};\7
+\4\&{procedure}\1\ \37\\{back\_error};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{get\_x\_next};\5
+\\{forward};\5
+\hbox{\2}\7
+\4\&{procedure}\1\ \37\\{put\_get\_error};\ \2\6
+\&{begin} \37\\{back\_error};\5
+\\{get\_x\_next};\ \&{end};\7
+\4\&{procedure}\1\ \37$\\{put\_get\_flush\_error}(\|v:\\{scaled})$;\ \2\6
+\&{begin} \37\\{put\_get\_error};\5
+$\\{flush\_cur\_exp}(\|v)$;\ \&{end};\par
+\fi
+
+\M821. A global variable called \\{var\_flag} is set to a special command code
+just before \MF\ calls \\{scan\_expression}, if the expression should be
+treated as a variable when this command code immediately follows. For
+example, \\{var\_flag} is set to \\{assignment} at the beginning of a
+statement, because we want to know the {\sl location\/} of a variable at
+the left of `\.{:=}', not the {\sl value\/} of that variable.
+
+The \\{scan\_expression} subroutine calls \\{scan\_tertiary},
+which calls \\{scan\_secondary}, which calls \\{scan\_primary}, which sets
+$\\{var\_flag}\K0$. In this way each of the scanning routines ``knows''
+when it has been called with a special \\{var\_flag}, but \\{var\_flag} is
+usually zero.
+
+A variable preceding a command that equals \\{var\_flag} is converted to a
+token list rather than a value. Furthermore, an `\.{=}' sign following an
+expression with $\\{var\_flag}=\\{assignment}$ is not considered to be a
+relation
+that produces boolean expressions.
+
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{var\_flag}: \37$0\to\\{max\_command\_code}$;\C{command that wants a
+variable}\par
+\fi
+
+\M822. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{var\_flag}\K0$;\par
+\fi
+
+\N823. \[40] Parsing primary expressions.
+The first parsing routine, \\{scan\_primary}, is also the most complicated one,
+since it involves so many different cases. But each case---with one
+exception---is fairly simple by itself.
+
+When \\{scan\_primary} begins, the first token of the primary to be scanned
+should already appear in \\{cur\_cmd}, \\{cur\_mod}, and \\{cur\_sym}. The
+values
+of \\{cur\_type} and \\{cur\_exp} should be either dead or dormant, as
+explained
+earlier. If \\{cur\_cmd} is not between \\{min\_primary\_command} and
+\\{max\_primary\_command}, inclusive, a syntax error will be signalled.
+
+\Y\P$\4\X823:Declare the basic parsing subroutines\X\S$\6
+\4\&{procedure}\1\ \37\\{scan\_primary};\6
+\4\&{label} \37$\\{restart},\39\\{done},\39\\{done1},\39\\{done2}$;\6
+\4\&{var} \37$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{for list manipulation}\6
+\|c: \37\\{quarterword};\C{a primitive operation code}\6
+\\{my\_var\_flag}: \37$0\to\\{max\_command\_code}$;\C{initial value of \\{my%
+\_var\_flag}}\6
+$\\{l\_delim},\39\\{r\_delim}$: \37\\{pointer};\C{hash addresses of a delimiter
+pair}\6
+\X831:Other local variables for \\{scan\_primary}\X\2\6
+\&{begin} \37$\\{my\_var\_flag}\K\\{var\_flag}$;\5
+$\\{var\_flag}\K0$;\6
+\4\\{restart}: \37\\{check\_arith};\5
+\X825:Supply diagnostic information, if requested\X;\6
+\&{case} $\\{cur\_cmd}$ \1\&{of}\6
+\4\\{left\_delimiter}: \37\X826:Scan a delimited primary\X;\6
+\4\\{begin\_group}: \37\X832:Scan a grouped primary\X;\6
+\4\\{string\_token}: \37\X833:Scan a string constant\X;\6
+\4\\{numeric\_token}: \37\X837:Scan a primary that starts with a numeric token%
+\X;\6
+\4\\{nullary}: \37\X834:Scan a nullary operation\X;\6
+\4$\\{unary},\39\\{type\_name},\39\\{cycle},\39\\{plus\_or\_minus}$: \37%
+\X835:Scan a unary operation\X;\6
+\4\\{primary\_binary}: \37\X839:Scan a binary operation with `\&{of}' between
+its operands\X;\6
+\4\\{str\_op}: \37\X840:Convert a suffix to a string\X;\6
+\4\\{internal\_quantity}: \37\X841:Scan an internal numeric quantity\X;\6
+\4\\{capsule\_token}: \37$\\{make\_exp\_copy}(\\{cur\_mod})$;\6
+\4\\{tag\_token}: \37\X844:Scan a variable primary; \&{goto} \\{restart} if it
+turns out to be a macro\X;\6
+\4\&{othercases} \37\&{begin} \37$\\{bad\_exp}(\.{"A\ primary"})$;\5
+\&{goto} \37\\{restart};\6
+\&{end}\2\6
+\&{endcases};\6
+\\{get\_x\_next};\C{the routines \&{goto} \\{done} if they don't want this}\6
+\4\\{done}: \37\&{if} $\\{cur\_cmd}=\\{left\_bracket}$ \1\&{then}\6
+\&{if} $\\{cur\_type}\G\\{known}$ \1\&{then}\5
+\X859:Scan a mediation construction\X;\2\2\6
+\&{end};\par
+\As860, 862, 864, 868\ETs892.
+\U1202.\fi
+
+\M824. Errors at the beginning of expressions are flagged by \\{bad\_exp}.
+
+\Y\P\4\&{procedure}\1\ \37$\\{bad\_exp}(\|s:\\{str\_number})$;\6
+\4\&{var} \37\\{save\_flag}: \37$0\to\\{max\_command\_code}$;\2\6
+\&{begin} \37$\\{print\_err}(\|s)$;\5
+$\\{print}(\.{"\ expression\ can\'t\ begin\ with\ \`"})$;\5
+$\\{print\_cmd\_mod}(\\{cur\_cmd},\39\\{cur\_mod})$;\5
+$\\{print\_char}(\.{"\'"})$;\5
+$\\{help4}(\.{"I\'m\ afraid\ I\ need\ some\ sort\ of\ value\ in\ order\ to\
+continue,"})$\6
+$(\.{"so\ I\'ve\ tentatively\ inserted\ \`0\'.\ You\ may\ want\ to"})$\6
+$(\.{"delete\ this\ zero\ and\ insert\ something\ else;"})$\6
+$(\.{"see\ Chapter\ 27\ of\ The\ METAFONTbook\ for\ an\ example."})$;\5
+\\{back\_input};\5
+$\\{cur\_sym}\K0$;\5
+$\\{cur\_cmd}\K\\{numeric\_token}$;\5
+$\\{cur\_mod}\K0$;\5
+\\{ins\_error};\6
+$\\{save\_flag}\K\\{var\_flag}$;\5
+$\\{var\_flag}\K0$;\5
+\\{get\_x\_next};\5
+$\\{var\_flag}\K\\{save\_flag}$;\6
+\&{end};\par
+\fi
+
+\M825. \P$\X825:Supply diagnostic information, if requested\X\S$\6
+\&{debug} \37\&{if} $\\{panicking}$ \1\&{then}\5
+$\\{check\_mem}(\\{false})$;\ \2\6
+\&{gubed}\6
+\&{if} $\\{interrupt}\I0$ \1\&{then}\6
+\&{if} $\\{OK\_to\_interrupt}$ \1\&{then}\6
+\&{begin} \37\\{back\_input};\5
+\\{check\_interrupt};\5
+\\{get\_x\_next};\6
+\&{end}\2\2\par
+\U823.\fi
+
+\M826. \P$\X826:Scan a delimited primary\X\S$\6
+\&{begin} \37$\\{l\_delim}\K\\{cur\_sym}$;\5
+$\\{r\_delim}\K\\{cur\_mod}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $(\\{cur\_cmd}=\\{comma})\W(\\{cur\_type}\G\\{known})$ \1\&{then}\5
+\X830:Scan the second of a pair of numerics\X\6
+\4\&{else} $\\{check\_delimiter}(\\{l\_delim},\39\\{r\_delim})$;\2\6
+\&{end}\par
+\U823.\fi
+
+\M827. The \\{stash\_in} subroutine puts the current (numeric) expression into
+a field
+within a ``big node.''
+
+\Y\P\4\&{procedure}\1\ \37$\\{stash\_in}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{temporary register}\2\6
+\&{begin} \37$\\{type}(\|p)\K\\{cur\_type}$;\6
+\&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\5
+$\\{value}(\|p)\K\\{cur\_exp}$\6
+\4\&{else} \&{begin} \37\&{if} $\\{cur\_type}=\\{independent}$ \1\&{then}\5
+\X829:Stash an independent \\{cur\_exp} into a big node\X\6
+\4\&{else} \&{begin} \37$\\{mem}[\\{value\_loc}(\|p)]\K\\{mem}[\\{value\_loc}(%
+\\{cur\_exp})]$;\C{$\\{dep\_list}(\|p)\K\\{dep\_list}(\\{cur\_exp})$ and $%
+\\{prev\_dep}(\|p)\K\\{prev\_dep}(\\{cur\_exp})$}\6
+$\\{link}(\\{prev\_dep}(\|p))\K\|p$;\6
+\&{end};\2\6
+$\\{free\_node}(\\{cur\_exp},\39\\{value\_node\_size})$;\6
+\&{end};\2\6
+$\\{cur\_type}\K\\{vacuous}$;\6
+\&{end};\par
+\fi
+
+\M828. In rare cases the current expression can become \\{independent}. There
+may be many dependency lists pointing to such an independent capsule,
+so we can't simply move it into place within a big node. Instead,
+we copy it, then recycle it.
+
+\fi
+
+\M829. \P$\X829:Stash an independent \\{cur\_exp} into a big node\X\S$\6
+\&{begin} \37$\|q\K\\{single\_dependency}(\\{cur\_exp})$;\6
+\&{if} $\|q=\\{dep\_final}$ \1\&{then}\6
+\&{begin} \37$\\{type}(\|p)\K\\{known}$;\5
+$\\{value}(\|p)\K0$;\5
+$\\{free\_node}(\|q,\39\\{dep\_node\_size})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{type}(\|p)\K\\{dependent}$;\5
+$\\{new\_dep}(\|p,\39\|q)$;\6
+\&{end};\2\6
+$\\{recycle\_value}(\\{cur\_exp})$;\6
+\&{end}\par
+\U827.\fi
+
+\M830. \P$\X830:Scan the second of a pair of numerics\X\S$\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{type}(\|p)\K\\{pair\_type}$;\5
+$\\{name\_type}(\|p)\K\\{capsule}$;\5
+$\\{init\_big\_node}(\|p)$;\5
+$\|q\K\\{value}(\|p)$;\5
+$\\{stash\_in}(\\{x\_part\_loc}(\|q))$;\6
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}<\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Nonnumeric\ ypart\ has\ been\ replaced\ by\
+0"})$;\5
+$\\{help4}(\.{"I\ thought\ you\ were\ giving\ me\ a\ pair\ \`(x,y)\';\ but"})$\6
+$(\.{"after\ finding\ a\ nice\ xpart\ \`x\'\ I\ found\ a\ ypart\ \`y\'"})$\6
+$(\.{"that\ isn\'t\ of\ numeric\ type.\ So\ I\'ve\ changed\ y\ to\ zero."})$\6
+$(\.{"(The\ y\ that\ I\ didn\'t\ like\ appears\ above\ the\ error\
+message.)"})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end};\2\6
+$\\{stash\_in}(\\{y\_part\_loc}(\|q))$;\5
+$\\{check\_delimiter}(\\{l\_delim},\39\\{r\_delim})$;\5
+$\\{cur\_type}\K\\{pair\_type}$;\5
+$\\{cur\_exp}\K\|p$;\6
+\&{end}\par
+\U826.\fi
+
+\M831. The local variable \\{group\_line} keeps track of the line
+where a \&{begingroup} command occurred; this will be useful
+in an error message if the group doesn't actually end.
+
+\Y\P$\4\X831:Other local variables for \\{scan\_primary}\X\S$\6
+\4\\{group\_line}: \37\\{integer};\C{where a group began}\par
+\As836\ET843.
+\U823.\fi
+
+\M832. \P$\X832:Scan a grouped primary\X\S$\6
+\&{begin} \37$\\{group\_line}\K\\{line}$;\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>0$ \1\&{then}\5
+\\{show\_cur\_cmd\_mod};\2\6
+$\\{save\_boundary\_item}(\|p)$;\6
+\1\&{repeat} \37\\{do\_statement};\C{ends with $\\{cur\_cmd}\G\\{semicolon}$}\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{semicolon}$;\2\6
+\&{if} $\\{cur\_cmd}\I\\{end\_group}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"A\ group\ begun\ on\ line\ "})$;\5
+$\\{print\_int}(\\{group\_line})$;\5
+$\\{print}(\.{"\ never\ ended"})$;\5
+$\\{help2}(\.{"I\ saw\ a\ \`begingroup\'\ back\ there\ that\ hasn\'t\ been\
+matched"})$\6
+$(\.{"by\ \`endgroup\'.\ So\ I\'ve\ inserted\ \`endgroup\'\ now."})$;\5
+\\{back\_error};\5
+$\\{cur\_cmd}\K\\{end\_group}$;\6
+\&{end};\2\6
+\\{unsave};\C{this might change \\{cur\_type}, if independent variables are
+recycled}\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>0$ \1\&{then}\5
+\\{show\_cur\_cmd\_mod};\2\6
+\&{end}\par
+\U823.\fi
+
+\M833. \P$\X833:Scan a string constant\X\S$\6
+\&{begin} \37$\\{cur\_type}\K\\{string\_type}$;\5
+$\\{cur\_exp}\K\\{cur\_mod}$;\6
+\&{end}\par
+\U823.\fi
+
+\M834. Later we'll come to procedures that perform actual operations like
+addition, square root, and so on; our purpose now is to do the parsing.
+But we might as well mention those future procedures now, so that the
+suspense won't be too bad:
+
+\smallskip
+$\\{do\_nullary}(\|c)$ does primitive operations that have no operands (e.g.,
+`\&{true}' or `\&{pencircle}');
+
+\smallskip
+$\\{do\_unary}(\|c)$ applies a primitive operation to the current expression;
+
+\smallskip
+$\\{do\_binary}(\|p,\|c)$ applies a primitive operation to the capsule~\|p
+and the current expression.
+
+\Y\P$\4\X834:Scan a nullary operation\X\S$\6
+$\\{do\_nullary}(\\{cur\_mod})$\par
+\U823.\fi
+
+\M835. \P$\X835:Scan a unary operation\X\S$\6
+\&{begin} \37$\|c\K\\{cur\_mod}$;\5
+\\{get\_x\_next};\5
+\\{scan\_primary};\5
+$\\{do\_unary}(\|c)$;\5
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U823.\fi
+
+\M836. A numeric token might be a primary by itself, or it might be the
+numerator of a fraction composed solely of numeric tokens, or it might
+multiply the primary that follows (provided that the primary doesn't begin
+with a plus sign or a minus sign). The code here uses the facts that
+$\\{max\_primary\_command}=\\{plus\_or\_minus}$ and
+$\\{max\_primary\_command}-1=\\{numeric\_token}$. If a fraction is found that
+is less
+than unity, we try to retain higher precision when we use it in scalar
+multiplication.
+
+\Y\P$\4\X831:Other local variables for \\{scan\_primary}\X\mathrel{+}\S$\6
+\4$\\{num},\39\\{denom}$: \37\\{scaled};\C{for primaries that are fractions,
+like `1/2'}\par
+\fi
+
+\M837. \P$\X837:Scan a primary that starts with a numeric token\X\S$\6
+\&{begin} \37$\\{cur\_exp}\K\\{cur\_mod}$;\5
+$\\{cur\_type}\K\\{known}$;\5
+\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}\I\\{slash}$ \1\&{then}\6
+\&{begin} \37$\\{num}\K0$;\5
+$\\{denom}\K0$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}\I\\{numeric\_token}$ \1\&{then}\6
+\&{begin} \37\\{back\_input};\5
+$\\{cur\_cmd}\K\\{slash}$;\5
+$\\{cur\_mod}\K\\{over}$;\5
+$\\{cur\_sym}\K\\{frozen\_slash}$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+$\\{num}\K\\{cur\_exp}$;\5
+$\\{denom}\K\\{cur\_mod}$;\6
+\&{if} $\\{denom}=0$ \1\&{then}\5
+\X838:Protest division by zero\X\6
+\4\&{else} $\\{cur\_exp}\K\\{make\_scaled}(\\{num},\39\\{denom})$;\2\6
+\\{check\_arith};\5
+\\{get\_x\_next};\6
+\&{end};\2\6
+\&{if} $\\{cur\_cmd}\G\\{min\_primary\_command}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}<\\{numeric\_token}$ \1\&{then}\C{in particular, $\\{cur%
+\_cmd}\I\\{plus\_or\_minus}$}\6
+\&{begin} \37$\|p\K\\{stash\_cur\_exp}$;\5
+\\{scan\_primary};\6
+\&{if} $(\\{abs}(\\{num})\G\\{abs}(\\{denom}))\V(\\{cur\_type}<\\{pair\_type})$
+\1\&{then}\5
+$\\{do\_binary}(\|p,\39\\{times})$\6
+\4\&{else} \&{begin} \37$\\{frac\_mult}(\\{num},\39\\{denom})$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$;\6
+\&{end};\2\6
+\&{end};\2\2\6
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U823.\fi
+
+\M838. \P$\X838:Protest division by zero\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Division\ by\ zero"})$;\5
+$\\{help1}(\.{"I\'ll\ pretend\ that\ you\ meant\ to\ divide\ by\ 1."})$;\5
+\\{error};\6
+\&{end}\par
+\U837.\fi
+
+\M839. \P$\X839:Scan a binary operation with `\&{of}' between its operands\X\S$%
+\6
+\&{begin} \37$\|c\K\\{cur\_mod}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_cmd}\I\\{of\_token}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{"of"})$;\5
+$\\{print}(\.{"\ for\ "})$;\5
+$\\{print\_cmd\_mod}(\\{primary\_binary},\39\|c)$;\5
+$\\{help1}(\.{"I\'ve\ got\ the\ first\ argument;\ will\ look\ now\ for\ the\
+other."})$;\5
+\\{back\_error};\6
+\&{end};\2\6
+$\|p\K\\{stash\_cur\_exp}$;\5
+\\{get\_x\_next};\5
+\\{scan\_primary};\5
+$\\{do\_binary}(\|p,\39\|c)$;\5
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U823.\fi
+
+\M840. \P$\X840:Convert a suffix to a string\X\S$\6
+\&{begin} \37\\{get\_x\_next};\5
+\\{scan\_suffix};\5
+$\\{old\_setting}\K\\{selector}$;\5
+$\\{selector}\K\\{new\_string}$;\5
+$\\{show\_token\_list}(\\{cur\_exp},\39\\{null},\39100000,\390)$;\5
+$\\{flush\_token\_list}(\\{cur\_exp})$;\5
+$\\{cur\_exp}\K\\{make\_string}$;\5
+$\\{selector}\K\\{old\_setting}$;\5
+$\\{cur\_type}\K\\{string\_type}$;\5
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U823.\fi
+
+\M841. If an internal quantity appears all by itself on the left of an
+assignment, we return a token list of length one, containing the address
+of the internal quantity plus \\{hash\_end}. (This accords with the conventions
+of the save stack, as described earlier.)
+
+\Y\P$\4\X841:Scan an internal numeric quantity\X\S$\6
+\&{begin} \37$\|q\K\\{cur\_mod}$;\6
+\&{if} $\\{my\_var\_flag}=\\{assignment}$ \1\&{then}\6
+\&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}=\\{assignment}$ \1\&{then}\6
+\&{begin} \37$\\{cur\_exp}\K\\{get\_avail}$;\5
+$\\{info}(\\{cur\_exp})\K\|q+\\{hash\_end}$;\5
+$\\{cur\_type}\K\\{token\_list}$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+\\{back\_input};\6
+\&{end};\2\6
+$\\{cur\_type}\K\\{known}$;\5
+$\\{cur\_exp}\K\\{internal}[\|q]$;\6
+\&{end}\par
+\U823.\fi
+
+\M842. The most difficult part of \\{scan\_primary} has been saved for last,
+since
+it was necessary to build up some confidence first. We can now face the task
+of scanning a variable.
+
+As we scan a variable, we build a token list containing the relevant
+names and subscript values, simultaneously following along in the
+``collective'' structure to see if we are actually dealing with a macro
+instead of a value.
+
+The local variables \\{pre\_head} and \\{post\_head} will point to the
+beginning
+of the prefix and suffix lists; \\{tail} will point to the end of the list
+that is currently growing.
+
+Another local variable, \\{tt}, contains partial information about the
+declared type of the variable-so-far. If $\\{tt}\G\\{unsuffixed\_macro}$, the
+relation $\\{tt}=\\{type}(\|q)$ will always hold. If $\\{tt}=\\{undefined}$,
+the routine
+doesn't bother to update its information about type. And if
+$\\{undefined}<\\{tt}<\\{unsuffixed\_macro}$, the precise value of \\{tt} isn't
+critical.
+
+\fi
+
+\M843. \P$\X831:Other local variables for \\{scan\_primary}\X\mathrel{+}\S$\6
+\4$\\{pre\_head},\39\\{post\_head},\39\\{tail}$: \37\\{pointer};\C{prefix and
+suffix list variables}\6
+\4\\{tt}: \37\\{small\_number};\C{approximation to the type of the
+variable-so-far}\6
+\4\|t: \37\\{pointer};\C{a token}\6
+\4\\{macro\_ref}: \37\\{pointer};\C{reference count for a suffixed macro}\par
+\fi
+
+\M844. \P$\X844:Scan a variable primary; \&{goto} \\{restart} if it turns out
+to be a macro\X\S$\6
+\&{begin} \37$\\{fast\_get\_avail}(\\{pre\_head})$;\5
+$\\{tail}\K\\{pre\_head}$;\5
+$\\{post\_head}\K\\{null}$;\5
+$\\{tt}\K\\{vacuous}$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|t\K\\{cur\_tok}$;\5
+$\\{link}(\\{tail})\K\|t$;\6
+\&{if} $\\{tt}\I\\{undefined}$ \1\&{then}\6
+\&{begin} \37\X850:Find the approximate type \\{tt} and corresponding~\|q\X;\6
+\&{if} $\\{tt}\G\\{unsuffixed\_macro}$ \1\&{then}\5
+\X845:Either begin an unsuffixed macro call or prepare for a suffixed one\X;\2\6
+\&{end};\2\6
+\\{get\_x\_next};\5
+$\\{tail}\K\|t$;\6
+\&{if} $\\{cur\_cmd}=\\{left\_bracket}$ \1\&{then}\5
+\X846:Scan for a subscript; replace \\{cur\_cmd} by \\{numeric\_token} if found%
+\X;\2\6
+\&{if} $\\{cur\_cmd}>\\{max\_suffix\_token}$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+\&{if} $\\{cur\_cmd}<\\{min\_suffix\_token}$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+\&{end};\C{now \\{cur\_cmd} is \\{internal\_quantity}, \\{tag\_token}, or %
+\\{numeric\_token}}\2\6
+\4\\{done1}: \37\X852:Handle unusual cases that masquerade as variables, and %
+\&{goto} \\{restart} or \&{goto} \\{done} if appropriate; otherwise make a copy
+of the variable and \&{goto} \\{done}\X;\6
+\&{end}\par
+\U823.\fi
+
+\M845. \P$\X845:Either begin an unsuffixed macro call or prepare for a suffixed
+one\X\S$\6
+\&{begin} \37$\\{link}(\\{tail})\K\\{null}$;\6
+\&{if} $\\{tt}>\\{unsuffixed\_macro}$ \1\&{then}\C{$\\{tt}=\\{suffixed%
+\_macro}$}\6
+\&{begin} \37$\\{post\_head}\K\\{get\_avail}$;\5
+$\\{tail}\K\\{post\_head}$;\5
+$\\{link}(\\{tail})\K\|t$;\6
+$\\{tt}\K\\{undefined}$;\5
+$\\{macro\_ref}\K\\{value}(\|q)$;\5
+$\\{add\_mac\_ref}(\\{macro\_ref})$;\6
+\&{end}\6
+\4\&{else} \X853:Set up unsuffixed macro call and \&{goto} \\{restart}\X;\2\6
+\&{end}\par
+\U844.\fi
+
+\M846. \P$\X846:Scan for a subscript; replace \\{cur\_cmd} by \\{numeric%
+\_token} if found\X\S$\6
+\&{begin} \37\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_cmd}\I\\{right\_bracket}$ \1\&{then}\5
+\X847:Put the left bracket and the expression back to be rescanned\X\6
+\4\&{else} \&{begin} \37\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+\\{bad\_subscript};\2\6
+$\\{cur\_cmd}\K\\{numeric\_token}$;\5
+$\\{cur\_mod}\K\\{cur\_exp}$;\5
+$\\{cur\_sym}\K0$;\6
+\&{end};\2\6
+\&{end}\par
+\U844.\fi
+
+\M847. The left bracket that we thought was introducing a subscript might have
+actually been the left bracket in a mediation construction like `\.{x[a,b]}'.
+So we don't issue an error message at this point; but we do want to back up
+so as to avoid any embarrassment about our incorrect assumption.
+
+\Y\P$\4\X847:Put the left bracket and the expression back to be rescanned\X\S$\6
+\&{begin} \37\\{back\_input};\C{that was the token following the current
+expression}\6
+\\{back\_expr};\5
+$\\{cur\_cmd}\K\\{left\_bracket}$;\5
+$\\{cur\_mod}\K0$;\5
+$\\{cur\_sym}\K\\{frozen\_left\_bracket}$;\6
+\&{end}\par
+\Us846\ET859.\fi
+
+\M848. Here's a routine that puts the current expression back to be read again.
+
+\Y\P\4\&{procedure}\1\ \37\\{back\_expr};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{capsule token}\2\6
+\&{begin} \37$\|p\K\\{stash\_cur\_exp}$;\5
+$\\{link}(\|p)\K\\{null}$;\5
+$\\{back\_list}(\|p)$;\6
+\&{end};\par
+\fi
+
+\M849. Unknown subscripts lead to the following error message.
+
+\Y\P\4\&{procedure}\1\ \37\\{bad\_subscript};\2\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ subscript\ has\ been\ replaced\ by\
+zero"})$;\5
+$\\{help3}(\.{"A\ bracketed\ subscript\ must\ have\ a\ known\ numeric\
+value;"})$\6
+$(\.{"unfortunately,\ what\ I\ found\ was\ the\ value\ that\ appears\ just"})$\6
+$(\.{"above\ this\ error\ message.\ So\ I\'ll\ try\ a\ zero\ subscript."})$;\5
+$\\{flush\_error}(0)$;\6
+\&{end};\par
+\fi
+
+\M850. Every time we call \\{get\_x\_next}, there's a chance that the variable
+we've
+been looking at will disappear. Thus, we cannot safely keep \|q pointing
+into the variable structure; we need to start searching from the root each
+time.
+
+\Y\P$\4\X850:Find the approximate type \\{tt} and corresponding~\|q\X\S$\6
+\&{begin} \37$\|p\K\\{link}(\\{pre\_head})$;\5
+$\|q\K\\{info}(\|p)$;\5
+$\\{tt}\K\\{undefined}$;\6
+\&{if} $\\{eq\_type}(\|q)\mathbin{\&{mod}}\\{outer\_tag}=\\{tag\_token}$ \1%
+\&{then}\6
+\&{begin} \37$\|q\K\\{equiv}(\|q)$;\6
+\&{if} $\|q=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{done2};\2\6
+\~ \1\&{loop}\ \&{begin} \37$\|p\K\\{link}(\|p)$;\6
+\&{if} $\|p=\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{tt}\K\\{type}(\|q)$;\5
+\&{goto} \37\\{done2};\6
+\&{end};\2\6
+\&{if} $\\{type}(\|q)\I\\{structured}$ \1\&{then}\5
+\&{goto} \37\\{done2};\2\6
+$\|q\K\\{link}(\\{attr\_head}(\|q))$;\C{the \\{collective\_subscript}
+attribute}\6
+\&{if} $\|p\G\\{hi\_mem\_min}$ \1\&{then}\C{it's not a subscript}\6
+\&{begin} \37\1\&{repeat} \37$\|q\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\\{attr\_loc}(\|q)\G\\{info}(\|p)$;\2\6
+\&{if} $\\{attr\_loc}(\|q)>\\{info}(\|p)$ \1\&{then}\5
+\&{goto} \37\\{done2};\2\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\2\6
+\4\\{done2}: \37\&{end}\par
+\U844.\fi
+
+\M851. How do things stand now? Well, we have scanned an entire variable name,
+including possible subscripts and/or attributes; \\{cur\_cmd}, \\{cur\_mod},
+and
+\\{cur\_sym} represent the token that follows. If $\\{post\_head}=\\{null}$, a
+token list for this variable name starts at $\\{link}(\\{pre\_head})$, with all
+subscripts evaluated. But if $\\{post\_head}\I\\{null}$, the variable turned
+out
+to be a suffixed macro; \\{pre\_head} is the head of the prefix list, while
+\\{post\_head} is the head of a token list containing both `\.{\AT!}' and
+the suffix.
+
+Our immediate problem is to see if this variable still exists. (Variable
+structures can change drastically whenever we call \\{get\_x\_next}; users
+aren't supposed to do this, but the fact that it is possible means that
+we must be cautious.)
+
+The following procedure prints an error message when a variable
+unexpectedly disappears. Its help message isn't quite right for
+our present purposes, but we'll be able to fix that up.
+
+\Y\P\4\&{procedure}\1\ \37$\\{obliterated}(\|q:\\{pointer})$;\2\6
+\&{begin} \37$\\{print\_err}(\.{"Variable\ "})$;\5
+$\\{show\_token\_list}(\|q,\39\\{null},\391000,\390)$;\5
+$\\{print}(\.{"\ has\ been\ obliterated"})$;\5
+$\\{help5}(\.{"It\ seems\ you\ did\ a\ nasty\ thing---probably\ by\
+accident,"})$\6
+$(\.{"but\ nevertheless\ you\ nearly\ hornswoggled\ me..."})$\6
+$(\.{"While\ I\ was\ evaluating\ the\ right-hand\ side\ of\ this"})$\6
+$(\.{"command,\ something\ happened,\ and\ the\ left-hand\ side"})$\6
+$(\.{"is\ no\ longer\ a\ variable!\ So\ I\ won\'t\ change\ anything."})$;\6
+\&{end};\par
+\fi
+
+\M852. If the variable does exist, we also need to check
+for a few other special cases before deciding that a plain old ordinary
+variable has, indeed, been scanned.
+
+\Y\P$\4\X852:Handle unusual cases that masquerade as variables, and \&{goto} %
+\\{restart} or \&{goto} \\{done} if appropriate; otherwise make a copy of the
+variable and \&{goto} \\{done}\X\S$\6
+\&{if} $\\{post\_head}\I\\{null}$ \1\&{then}\5
+\X854:Set up suffixed macro call and \&{goto} \\{restart}\X;\2\6
+$\|q\K\\{link}(\\{pre\_head})$;\5
+$\\{free\_avail}(\\{pre\_head})$;\6
+\&{if} $\\{cur\_cmd}=\\{my\_var\_flag}$ \1\&{then}\6
+\&{begin} \37$\\{cur\_type}\K\\{token\_list}$;\5
+$\\{cur\_exp}\K\|q$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+$\|p\K\\{find\_variable}(\|q)$;\6
+\&{if} $\|p\I\\{null}$ \1\&{then}\5
+$\\{make\_exp\_copy}(\|p)$\6
+\4\&{else} \&{begin} \37$\\{obliterated}(\|q)$;\6
+$\\{help\_line}[2]\K\.{"While\ I\ was\ evaluating\ the\ suffix\ of\ this\
+variable,"}$;\5
+$\\{help\_line}[1]\K\.{"something\ was\ redefined,\ and\ it\'s\ no\ longer\ a\
+variable!"}$;\5
+$\\{help\_line}[0]\K\.{"In\ order\ to\ get\ back\ on\ my\ feet,\ I\'ve\
+inserted\ \`0\'\ instead."}$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end};\2\6
+$\\{flush\_node\_list}(\|q)$;\5
+\&{goto} \37\\{done}\par
+\U844.\fi
+
+\M853. The only complication associated with macro calling is that the prefix
+and ``at'' parameters must be packaged in an appropriate list of lists.
+
+\Y\P$\4\X853:Set up unsuffixed macro call and \&{goto} \\{restart}\X\S$\6
+\&{begin} \37$\|p\K\\{get\_avail}$;\5
+$\\{info}(\\{pre\_head})\K\\{link}(\\{pre\_head})$;\5
+$\\{link}(\\{pre\_head})\K\|p$;\5
+$\\{info}(\|p)\K\|t$;\5
+$\\{macro\_call}(\\{value}(\|q),\39\\{pre\_head},\39\\{null})$;\5
+\\{get\_x\_next};\5
+\&{goto} \37\\{restart};\6
+\&{end}\par
+\U845.\fi
+
+\M854. If the ``variable'' that turned out to be a suffixed macro no longer
+exists,
+we don't care, because we have reserved a pointer (\\{macro\_ref}) to its
+token list.
+
+\Y\P$\4\X854:Set up suffixed macro call and \&{goto} \\{restart}\X\S$\6
+\&{begin} \37\\{back\_input};\5
+$\|p\K\\{get\_avail}$;\5
+$\|q\K\\{link}(\\{post\_head})$;\5
+$\\{info}(\\{pre\_head})\K\\{link}(\\{pre\_head})$;\5
+$\\{link}(\\{pre\_head})\K\\{post\_head}$;\5
+$\\{info}(\\{post\_head})\K\|q$;\5
+$\\{link}(\\{post\_head})\K\|p$;\5
+$\\{info}(\|p)\K\\{link}(\|q)$;\5
+$\\{link}(\|q)\K\\{null}$;\5
+$\\{macro\_call}(\\{macro\_ref},\39\\{pre\_head},\39\\{null})$;\5
+$\\{decr}(\\{ref\_count}(\\{macro\_ref}))$;\5
+\\{get\_x\_next};\5
+\&{goto} \37\\{restart};\6
+\&{end}\par
+\U852.\fi
+
+\M855. Our remaining job is simply to make a copy of the value that has been
+found. Some cases are harder than others, but complexity arises solely
+because of the multiplicity of possible cases.
+
+\Y\P$\4\X855:Declare the procedure called \\{make\_exp\_copy}\X\S$\6
+\hbox{\4}\X856:Declare subroutines needed by \\{make\_exp\_copy}\X\6
+\4\&{procedure}\1\ \37$\\{make\_exp\_copy}(\|p:\\{pointer})$;\6
+\4\&{label} \37\\{restart};\6
+\4\&{var} \37$\|q,\39\|r,\39\|t$: \37\\{pointer};\C{registers for list
+manipulation}\2\6
+\&{begin} \37\\{restart}: \37$\\{cur\_type}\K\\{type}(\|p)$;\6
+\&{case} $\\{cur\_type}$ \1\&{of}\6
+\4$\\{vacuous},\39\\{boolean\_type},\39\\{known}$: \37$\\{cur\_exp}\K\\{value}(%
+\|p)$;\6
+\4\\{unknown\_types}: \37$\\{cur\_exp}\K\\{new\_ring\_entry}(\|p)$;\6
+\4\\{string\_type}: \37\&{begin} \37$\\{cur\_exp}\K\\{value}(\|p)$;\5
+$\\{add\_str\_ref}(\\{cur\_exp})$;\6
+\&{end};\6
+\4\\{pen\_type}: \37\&{begin} \37$\\{cur\_exp}\K\\{value}(\|p)$;\5
+$\\{add\_pen\_ref}(\\{cur\_exp})$;\6
+\&{end};\6
+\4\\{picture\_type}: \37$\\{cur\_exp}\K\\{copy\_edges}(\\{value}(\|p))$;\6
+\4$\\{path\_type},\39\\{future\_pen}$: \37$\\{cur\_exp}\K\\{copy\_path}(%
+\\{value}(\|p))$;\6
+\4$\\{transform\_type},\39\\{pair\_type}$: \37\X857:Copy the big node \|p\X;\6
+\4$\\{dependent},\39\\{proto\_dependent}$: \37$\\{encapsulate}(\\{copy\_dep%
+\_list}(\\{dep\_list}(\|p)))$;\6
+\4\\{numeric\_type}: \37\&{begin} \37$\\{new\_indep}(\|p)$;\5
+\&{goto} \37\\{restart};\6
+\&{end};\6
+\4\\{independent}: \37\&{begin} \37$\|q\K\\{single\_dependency}(\|p)$;\6
+\&{if} $\|q=\\{dep\_final}$ \1\&{then}\6
+\&{begin} \37$\\{cur\_type}\K\\{known}$;\5
+$\\{cur\_exp}\K0$;\5
+$\\{free\_node}(\|q,\39\\{value\_node\_size})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{cur\_type}\K\\{dependent}$;\5
+$\\{encapsulate}(\|q)$;\6
+\&{end};\2\6
+\&{end};\6
+\4\&{othercases} \37$\\{confusion}(\.{"copy"})$\2\6
+\&{endcases};\6
+\&{end};\par
+\U651.\fi
+
+\M856. The \\{encapsulate} subroutine assumes that \\{dep\_final} is the
+tail of dependency list~\|p.
+
+\Y\P$\4\X856:Declare subroutines needed by \\{make\_exp\_copy}\X\S$\6
+\4\&{procedure}\1\ \37$\\{encapsulate}(\|p:\\{pointer})$;\2\6
+\&{begin} \37$\\{cur\_exp}\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{type}(\\{cur\_exp})\K\\{cur\_type}$;\5
+$\\{name\_type}(\\{cur\_exp})\K\\{capsule}$;\5
+$\\{new\_dep}(\\{cur\_exp},\39\|p)$;\6
+\&{end};\par
+\A858.
+\U855.\fi
+
+\M857. The most tedious case arises when the user refers to a
+\&{pair} or \&{transform} variable; we must copy several fields,
+each of which can be \\{independent}, \\{dependent}, \\{proto\_dependent},
+or \\{known}.
+
+\Y\P$\4\X857:Copy the big node \|p\X\S$\6
+\&{begin} \37\&{if} $\\{value}(\|p)=\\{null}$ \1\&{then}\5
+$\\{init\_big\_node}(\|p)$;\2\6
+$\|t\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{name\_type}(\|t)\K\\{capsule}$;\5
+$\\{type}(\|t)\K\\{cur\_type}$;\5
+$\\{init\_big\_node}(\|t)$;\6
+$\|q\K\\{value}(\|p)+\\{big\_node\_size}[\\{cur\_type}]$;\5
+$\|r\K\\{value}(\|t)+\\{big\_node\_size}[\\{cur\_type}]$;\6
+\1\&{repeat} \37$\|q\K\|q-2$;\5
+$\|r\K\|r-2$;\5
+$\\{install}(\|r,\39\|q)$;\6
+\4\&{until}\5
+$\|q=\\{value}(\|p)$;\2\6
+$\\{cur\_exp}\K\|t$;\6
+\&{end}\par
+\U855.\fi
+
+\M858. The \\{install} procedure copies a numeric field~\|q into field~\|r of
+a big node that will be part of a capsule.
+
+\Y\P$\4\X856:Declare subroutines needed by \\{make\_exp\_copy}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{install}(\|r,\39\|q:\\{pointer})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{temporary register}\2\6
+\&{begin} \37\&{if} $\\{type}(\|q)=\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{value}(\|r)\K\\{value}(\|q)$;\5
+$\\{type}(\|r)\K\\{known}$;\6
+\&{end}\6
+\4\&{else} \&{if} $\\{type}(\|q)=\\{independent}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{single\_dependency}(\|q)$;\6
+\&{if} $\|p=\\{dep\_final}$ \1\&{then}\6
+\&{begin} \37$\\{type}(\|r)\K\\{known}$;\5
+$\\{value}(\|r)\K0$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{type}(\|r)\K\\{dependent}$;\5
+$\\{new\_dep}(\|r,\39\|p)$;\6
+\&{end};\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{type}(\|r)\K\\{type}(\|q)$;\5
+$\\{new\_dep}(\|r,\39\\{copy\_dep\_list}(\\{dep\_list}(\|q)))$;\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M859. Expressions of the form `\.{a[b,c]}' are converted into
+`\.{b+a*(c-b)}', without checking the types of \.b~or~\.c,
+provided that \.a is numeric.
+
+\Y\P$\4\X859:Scan a mediation construction\X\S$\6
+\&{begin} \37$\|p\K\\{stash\_cur\_exp}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_cmd}\I\\{comma}$ \1\&{then}\6
+\&{begin} \37\X847:Put the left bracket and the expression back to be rescanned%
+\X;\6
+$\\{unstash\_cur\_exp}(\|p)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|q\K\\{stash\_cur\_exp}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_cmd}\I\\{right\_bracket}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{"]"})$;\6
+$\\{help3}(\.{"I\'ve\ scanned\ an\ expression\ of\ the\ form\ \`a[b,c\',"})$\6
+$(\.{"so\ a\ right\ bracket\ should\ have\ come\ next."})$\6
+$(\.{"I\ shall\ pretend\ that\ one\ was\ there."})$;\6
+\\{back\_error};\6
+\&{end};\2\6
+$\|r\K\\{stash\_cur\_exp}$;\5
+$\\{make\_exp\_copy}(\|q)$;\6
+$\\{do\_binary}(\|r,\39\\{minus})$;\5
+$\\{do\_binary}(\|p,\39\\{times})$;\5
+$\\{do\_binary}(\|q,\39\\{plus})$;\5
+\\{get\_x\_next};\6
+\&{end};\2\6
+\&{end}\par
+\U823.\fi
+
+\M860. Here is a comparatively simple routine that is used to scan the
+\&{suffix} parameters of a macro.
+
+\Y\P$\4\X823:Declare the basic parsing subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{scan\_suffix};\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37$\|h,\39\|t$: \37\\{pointer};\C{head and tail of the list being
+built}\6
+\|p: \37\\{pointer};\C{temporary register}\2\6
+\&{begin} \37$\|h\K\\{get\_avail}$;\5
+$\|t\K\|h$;\6
+\~ \1\&{loop}\ \&{begin} \37\&{if} $\\{cur\_cmd}=\\{left\_bracket}$ \1\&{then}\5
+\X861:Scan a bracketed subscript and set $\\{cur\_cmd}\K\\{numeric\_token}$\X;%
+\2\6
+\&{if} $\\{cur\_cmd}=\\{numeric\_token}$ \1\&{then}\5
+$\|p\K\\{new\_num\_tok}(\\{cur\_mod})$\6
+\4\&{else} \&{if} $(\\{cur\_cmd}=\\{tag\_token})\V(\\{cur\_cmd}=\\{internal%
+\_quantity})$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{get\_avail}$;\5
+$\\{info}(\|p)\K\\{cur\_sym}$;\6
+\&{end}\6
+\4\&{else} \&{goto} \37\\{done};\2\2\6
+$\\{link}(\|t)\K\|p$;\5
+$\|t\K\|p$;\5
+\\{get\_x\_next};\6
+\&{end};\2\6
+\4\\{done}: \37$\\{cur\_exp}\K\\{link}(\|h)$;\5
+$\\{free\_avail}(\|h)$;\5
+$\\{cur\_type}\K\\{token\_list}$;\6
+\&{end};\par
+\fi
+
+\M861. \P$\X861:Scan a bracketed subscript and set $\\{cur\_cmd}\K\\{numeric%
+\_token}$\X\S$\6
+\&{begin} \37\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+\\{bad\_subscript};\2\6
+\&{if} $\\{cur\_cmd}\I\\{right\_bracket}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{"]"})$;\6
+$\\{help3}(\.{"I\'ve\ seen\ a\ \`[\'\ and\ a\ subscript\ value,\ in\ a\
+suffix,"})$\6
+$(\.{"so\ a\ right\ bracket\ should\ have\ come\ next."})$\6
+$(\.{"I\ shall\ pretend\ that\ one\ was\ there."})$;\6
+\\{back\_error};\6
+\&{end};\2\6
+$\\{cur\_cmd}\K\\{numeric\_token}$;\5
+$\\{cur\_mod}\K\\{cur\_exp}$;\6
+\&{end}\par
+\U860.\fi
+
+\N862. \[41] Parsing secondary and higher expressions.
+After the intricacies of \\{scan\_primary}\kern-1pt,
+the \\{scan\_secondary} routine is
+refreshingly simple. It's not trivial, but the operations are relatively
+straightforward; the main difficulty is, again, that expressions and data
+structures might change drastically every time we call \\{get\_x\_next}, so a
+cautious approach is mandatory. For example, a macro defined by
+\&{primarydef} might have disappeared by the time its second argument has
+been scanned; we solve this by increasing the reference count of its token
+list, so that the macro can be called even after it has been clobbered.
+
+\Y\P$\4\X823:Declare the basic parsing subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{scan\_secondary};\6
+\4\&{label} \37$\\{restart},\39\\{continue}$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{for list manipulation}\6
+$\|c,\39\|d$: \37\\{halfword};\C{operation codes or modifiers}\6
+\\{mac\_name}: \37\\{pointer};\C{token defined with \&{primarydef}}\2\6
+\&{begin} \37\\{restart}: \37\&{if} $(\\{cur\_cmd}<\\{min\_primary\_command})\V%
+\30(\\{cur\_cmd}>\\{max\_primary\_command})$ \1\&{then}\5
+$\\{bad\_exp}(\.{"A\ secondary"})$;\2\6
+\\{scan\_primary};\6
+\4\\{continue}: \37\&{if} $\\{cur\_cmd}\L\\{max\_secondary\_command}$ \1%
+\&{then}\6
+\&{if} $\\{cur\_cmd}\G\\{min\_secondary\_command}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{stash\_cur\_exp}$;\5
+$\|c\K\\{cur\_mod}$;\5
+$\|d\K\\{cur\_cmd}$;\6
+\&{if} $\|d=\\{secondary\_primary\_macro}$ \1\&{then}\6
+\&{begin} \37$\\{mac\_name}\K\\{cur\_sym}$;\5
+$\\{add\_mac\_ref}(\|c)$;\6
+\&{end};\2\6
+\\{get\_x\_next};\5
+\\{scan\_primary};\6
+\&{if} $\|d\I\\{secondary\_primary\_macro}$ \1\&{then}\5
+$\\{do\_binary}(\|p,\39\|c)$\6
+\4\&{else} \&{begin} \37\\{back\_input};\5
+$\\{binary\_mac}(\|p,\39\|c,\39\\{mac\_name})$;\5
+$\\{decr}(\\{ref\_count}(\|c))$;\5
+\\{get\_x\_next};\5
+\&{goto} \37\\{restart};\6
+\&{end};\2\6
+\&{goto} \37\\{continue};\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M863. The following procedure calls a macro that has two parameters,
+\|p and \\{cur\_exp}.
+
+\Y\P\4\&{procedure}\1\ \37$\\{binary\_mac}(\|p,\39\|c,\39\|n:\\{pointer})$;\6
+\4\&{var} \37$\|q,\39\|r$: \37\\{pointer};\C{nodes in the parameter list}\2\6
+\&{begin} \37$\|q\K\\{get\_avail}$;\5
+$\|r\K\\{get\_avail}$;\5
+$\\{link}(\|q)\K\|r$;\6
+$\\{info}(\|q)\K\|p$;\5
+$\\{info}(\|r)\K\\{stash\_cur\_exp}$;\6
+$\\{macro\_call}(\|c,\39\|q,\39\|n)$;\6
+\&{end};\par
+\fi
+
+\M864. The next procedure, \\{scan\_tertiary}, is pretty much the same deal.
+
+\Y\P$\4\X823:Declare the basic parsing subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{scan\_tertiary};\6
+\4\&{label} \37$\\{restart},\39\\{continue}$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{for list manipulation}\6
+$\|c,\39\|d$: \37\\{halfword};\C{operation codes or modifiers}\6
+\\{mac\_name}: \37\\{pointer};\C{token defined with \&{secondarydef}}\2\6
+\&{begin} \37\\{restart}: \37\&{if} $(\\{cur\_cmd}<\\{min\_primary\_command})\V%
+\30(\\{cur\_cmd}>\\{max\_primary\_command})$ \1\&{then}\5
+$\\{bad\_exp}(\.{"A\ tertiary"})$;\2\6
+\\{scan\_secondary};\6
+\&{if} $\\{cur\_type}=\\{future\_pen}$ \1\&{then}\5
+\\{materialize\_pen};\2\6
+\4\\{continue}: \37\&{if} $\\{cur\_cmd}\L\\{max\_tertiary\_command}$ \1\&{then}%
+\6
+\&{if} $\\{cur\_cmd}\G\\{min\_tertiary\_command}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{stash\_cur\_exp}$;\5
+$\|c\K\\{cur\_mod}$;\5
+$\|d\K\\{cur\_cmd}$;\6
+\&{if} $\|d=\\{tertiary\_secondary\_macro}$ \1\&{then}\6
+\&{begin} \37$\\{mac\_name}\K\\{cur\_sym}$;\5
+$\\{add\_mac\_ref}(\|c)$;\6
+\&{end};\2\6
+\\{get\_x\_next};\5
+\\{scan\_secondary};\6
+\&{if} $\|d\I\\{tertiary\_secondary\_macro}$ \1\&{then}\5
+$\\{do\_binary}(\|p,\39\|c)$\6
+\4\&{else} \&{begin} \37\\{back\_input};\5
+$\\{binary\_mac}(\|p,\39\|c,\39\\{mac\_name})$;\5
+$\\{decr}(\\{ref\_count}(\|c))$;\5
+\\{get\_x\_next};\5
+\&{goto} \37\\{restart};\6
+\&{end};\2\6
+\&{goto} \37\\{continue};\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M865. A \\{future\_pen} becomes a full-fledged pen here.
+
+\Y\P\4\&{procedure}\1\ \37\\{materialize\_pen};\6
+\4\&{label} \37\\{common\_ending};\6
+\4\&{var} \37$\\{a\_minus\_b},\39\\{a\_plus\_b},\39\\{major\_axis},\39\\{minor%
+\_axis}$: \37\\{scaled};\C{ellipse variables}\6
+\\{theta}: \37\\{angle};\C{amount by which the ellipse has been rotated}\6
+\|p: \37\\{pointer};\C{path traverser}\6
+\|q: \37\\{pointer};\C{the knot list to be made into a pen}\2\6
+\&{begin} \37$\|q\K\\{cur\_exp}$;\6
+\&{if} $\\{left\_type}(\|q)=\\{endpoint}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Pen\ path\ must\ be\ a\ cycle"})$;\5
+$\\{help2}(\.{"I\ can\'t\ make\ a\ pen\ from\ the\ given\ path."})$\6
+$(\.{"So\ I\'ve\ replaced\ it\ by\ the\ trivial\ path\ \`(0,0)..cycle\'."})$;\5
+\\{put\_get\_error};\5
+$\\{cur\_exp}\K\\{null\_pen}$;\5
+\&{goto} \37\\{common\_ending};\6
+\&{end}\6
+\4\&{else} \&{if} $\\{left\_type}(\|q)=\\{open}$ \1\&{then}\5
+\X866:Change node \|q to a path for an elliptical pen\X;\2\2\6
+$\\{cur\_exp}\K\\{make\_pen}(\|q)$;\6
+\4\\{common\_ending}: \37$\\{toss\_knot\_list}(\|q)$;\5
+$\\{cur\_type}\K\\{pen\_type}$;\6
+\&{end};\par
+\fi
+
+\M866. We placed the three points $(0,0)$, $(1,0)$, $(0,1)$ into a %
+\&{pencircle},
+and they have now been transformed to $(u,v)$, $(A+u,B+v)$, $(C+u,D+v)$;
+this gives us enough information to deduce the transformation
+$(x,y)\mapsto(Ax+Cy+u,Bx+Dy+v)$.
+
+Given ($A,B,C,D)$ we can always find $(a,b,\theta,\phi)$ such that
+$$\eqalign{A&=a\cos\phi\cos\theta-b\sin\phi\sin\theta;\cr
+B&=a\cos\phi\sin\theta+b\sin\phi\cos\theta;\cr
+C&=-a\sin\phi\cos\theta-b\cos\phi\sin\theta;\cr
+D&=-a\sin\phi\sin\theta+b\cos\phi\cos\theta.\cr}$$
+In this notation, the unit circle $(\cos t,\sin t)$ is transformed into
+$$\bigl(a\cos(\phi+t)\cos\theta-b\sin(\phi+t)\sin\theta,\;
+a\cos(\phi+t)\sin\theta+b\sin(\phi+t)\cos\theta\bigr)\;+\;(u,v),$$
+which is an ellipse with semi-axes~$(a,b)$, rotated by~$\theta$ and
+shifted by~$(u,v)$. To solve the stated equations, we note that it is
+necessary and sufficient to solve
+$$\eqalign{A-D&=(a-b)\cos(\theta-\phi),\cr
+B+C&=(a-b)\sin(\theta-\phi),\cr}
+\qquad
+\eqalign{A+D&=(a+b)\cos(\theta+\phi),\cr
+B-C&=(a+b)\sin(\theta+\phi);\cr}$$
+and it is easy to find $a-b$, $a+b$, $\theta-\phi$, and $\theta+\phi$
+from these formulas.
+
+The code below uses $(\\{txx},\\{tyx},\\{txy},\\{tyy},\\{tx},\\{ty})$ to stand
+for
+$(A,B,C,D,u,v)$.
+
+\Y\P$\4\X866:Change node \|q to a path for an elliptical pen\X\S$\6
+\&{begin} \37$\\{tx}\K\\{x\_coord}(\|q)$;\5
+$\\{ty}\K\\{y\_coord}(\|q)$;\5
+$\\{txx}\K\\{left\_x}(\|q)-\\{tx}$;\5
+$\\{tyx}\K\\{left\_y}(\|q)-\\{ty}$;\5
+$\\{txy}\K\\{right\_x}(\|q)-\\{tx}$;\5
+$\\{tyy}\K\\{right\_y}(\|q)-\\{ty}$;\5
+$\\{a\_minus\_b}\K\\{pyth\_add}(\\{txx}-\\{tyy},\39\\{tyx}+\\{txy})$;\5
+$\\{a\_plus\_b}\K\\{pyth\_add}(\\{txx}+\\{tyy},\39\\{tyx}-\\{txy})$;\5
+$\\{major\_axis}\K\\{half}(\\{a\_minus\_b}+\\{a\_plus\_b})$;\5
+$\\{minor\_axis}\K\\{half}(\\{abs}(\\{a\_plus\_b}-\\{a\_minus\_b}))$;\6
+\&{if} $\\{major\_axis}=\\{minor\_axis}$ \1\&{then}\5
+$\\{theta}\K0$\C{circle}\6
+\4\&{else} $\\{theta}\K\\{half}(\\{n\_arg}(\\{txx}-\\{tyy},\39\\{tyx}+\\{txy})+%
+\\{n\_arg}(\\{txx}+\\{tyy},\39\\{tyx}-\\{txy}))$;\2\6
+$\\{free\_node}(\|q,\39\\{knot\_node\_size})$;\5
+$\|q\K\\{make\_ellipse}(\\{major\_axis},\39\\{minor\_axis},\39\\{theta})$;\6
+\&{if} $(\\{tx}\I0)\V(\\{ty}\I0)$ \1\&{then}\5
+\X867:Shift the coordinates of path \|q\X;\2\6
+\&{end}\par
+\U865.\fi
+
+\M867. \P$\X867:Shift the coordinates of path \|q\X\S$\6
+\&{begin} \37$\|p\K\|q$;\6
+\1\&{repeat} \37$\\{x\_coord}(\|p)\K\\{x\_coord}(\|p)+\\{tx}$;\5
+$\\{y\_coord}(\|p)\K\\{y\_coord}(\|p)+\\{ty}$;\5
+$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\|p=\|q$;\2\6
+\&{end}\par
+\U866.\fi
+
+\M868. Finally we reach the deepest level in our quartet of parsing routines.
+This one is much like the others; but it has an extra complication from
+paths, which materialize here.
+
+\Y\P\D \37$\\{continue\_path}=25$\C{a label inside of \\{scan\_expression}}\par
+\P\D \37$\\{finish\_path}=26$\C{another}\par
+\Y\P$\4\X823:Declare the basic parsing subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{scan\_expression};\6
+\4\&{label} \37$\\{restart},\39\\{done},\39\\{continue},\39\\{continue\_path},%
+\39\\{finish\_path},\39\\{exit}$;\6
+\4\&{var} \37$\|p,\39\|q,\39\|r,\39\\{pp},\39\\{qq}$: \37\\{pointer};\C{for
+list manipulation}\6
+$\|c,\39\|d$: \37\\{halfword};\C{operation codes or modifiers}\6
+\\{my\_var\_flag}: \37$0\to\\{max\_command\_code}$;\C{initial value of \\{var%
+\_flag}}\6
+\\{mac\_name}: \37\\{pointer};\C{token defined with \&{tertiarydef}}\6
+\\{cycle\_hit}: \37\\{boolean};\C{did a path expression just end with `%
+\&{cycle}'?}\6
+$\|x,\39\|y$: \37\\{scaled};\C{explicit coordinates or tension at a path join}\6
+\|t: \37$\\{endpoint}\to\\{open}$;\C{knot type following a path join}\2\6
+\&{begin} \37$\\{my\_var\_flag}\K\\{var\_flag}$;\6
+\4\\{restart}: \37\&{if} $(\\{cur\_cmd}<\\{min\_primary\_command})\V\30(\\{cur%
+\_cmd}>\\{max\_primary\_command})$ \1\&{then}\5
+$\\{bad\_exp}(\.{"An"})$;\2\6
+\\{scan\_tertiary};\6
+\4\\{continue}: \37\&{if} $\\{cur\_cmd}\L\\{max\_expression\_command}$ \1%
+\&{then}\6
+\&{if} $\\{cur\_cmd}\G\\{min\_expression\_command}$ \1\&{then}\6
+\&{if} $(\\{cur\_cmd}\I\\{equals})\V(\\{my\_var\_flag}\I\\{assignment})$ \1%
+\&{then}\6
+\&{begin} \37$\|p\K\\{stash\_cur\_exp}$;\5
+$\|c\K\\{cur\_mod}$;\5
+$\|d\K\\{cur\_cmd}$;\6
+\&{if} $\|d=\\{expression\_tertiary\_macro}$ \1\&{then}\6
+\&{begin} \37$\\{mac\_name}\K\\{cur\_sym}$;\5
+$\\{add\_mac\_ref}(\|c)$;\6
+\&{end};\2\6
+\&{if} $(\|d<\\{ampersand})\V((\|d=\\{ampersand})\W\30((\\{type}(\|p)=\\{pair%
+\_type})\V(\\{type}(\|p)=\\{path\_type})))$ \1\&{then}\5
+\X869:Scan a path construction operation; but \&{return} if \|p has the wrong
+type\X\6
+\4\&{else} \&{begin} \37\\{get\_x\_next};\5
+\\{scan\_tertiary};\6
+\&{if} $\|d\I\\{expression\_tertiary\_macro}$ \1\&{then}\5
+$\\{do\_binary}(\|p,\39\|c)$\6
+\4\&{else} \&{begin} \37\\{back\_input};\5
+$\\{binary\_mac}(\|p,\39\|c,\39\\{mac\_name})$;\5
+$\\{decr}(\\{ref\_count}(\|c))$;\5
+\\{get\_x\_next};\5
+\&{goto} \37\\{restart};\6
+\&{end};\2\6
+\&{end};\2\6
+\&{goto} \37\\{continue};\6
+\&{end};\2\2\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M869. The reader should review the data structure conventions for paths before
+hoping to understand the next part of this code.
+
+\Y\P$\4\X869:Scan a path construction operation; but \&{return} if \|p has the
+wrong type\X\S$\6
+\&{begin} \37$\\{cycle\_hit}\K\\{false}$;\5
+\X870:Convert the left operand, \|p, into a partial path ending at~\|q; but %
+\&{return} if \|p doesn't have a suitable type\X;\6
+\4\\{continue\_path}: \37\X874:Determine the path join parameters; but \&{goto}
+\\{finish\_path} if there's only a direction specifier\X;\6
+\&{if} $\\{cur\_cmd}=\\{cycle}$ \1\&{then}\5
+\X886:Get ready to close a cycle\X\6
+\4\&{else} \&{begin} \37\\{scan\_tertiary};\5
+\X885:Convert the right operand, \\{cur\_exp}, into a partial path from \\{pp}
+to~\\{qq}\X;\6
+\&{end};\2\6
+\X887:Join the partial paths and reset \|p and \|q to the head and tail of the
+result\X;\6
+\&{if} $\\{cur\_cmd}\G\\{min\_expression\_command}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}\L\\{ampersand}$ \1\&{then}\6
+\&{if} $\R\\{cycle\_hit}$ \1\&{then}\5
+\&{goto} \37\\{continue\_path};\2\2\2\6
+\4\\{finish\_path}: \37\X891:Choose control points for the path and put the
+result into \\{cur\_exp}\X;\6
+\&{end}\par
+\U868.\fi
+
+\M870. \P$\X870:Convert the left operand, \|p, into a partial path ending at~%
+\|q; but \&{return} if \|p doesn't have a suitable type\X\S$\6
+\&{begin} \37$\\{unstash\_cur\_exp}(\|p)$;\6
+\&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\5
+$\|p\K\\{new\_knot}$\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{path\_type}$ \1\&{then}\5
+$\|p\K\\{cur\_exp}$\6
+\4\&{else} \&{return};\2\2\6
+$\|q\K\|p$;\6
+\&{while} $\\{link}(\|q)\I\|p$ \1\&{do}\5
+$\|q\K\\{link}(\|q)$;\2\6
+\&{if} $\\{left\_type}(\|p)\I\\{endpoint}$ \1\&{then}\C{open up a cycle}\6
+\&{begin} \37$\|r\K\\{copy\_knot}(\|p)$;\5
+$\\{link}(\|q)\K\|r$;\5
+$\|q\K\|r$;\6
+\&{end};\2\6
+$\\{left\_type}(\|p)\K\\{open}$;\5
+$\\{right\_type}(\|q)\K\\{open}$;\6
+\&{end}\par
+\U869.\fi
+
+\M871. A pair of numeric values is changed into a knot node for a one-point
+path
+when \MF\ discovers that the pair is part of a path.
+
+\Y\P\hbox{\4}\X872:Declare the procedure called \\{known\_pair}\X\6
+\4\&{function}\1\ \37\\{new\_knot}: \37\\{pointer};\C{convert a pair to a knot
+with two endpoints}\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the new node}\2\6
+\&{begin} \37$\|q\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{left\_type}(\|q)\K\\{endpoint}$;\5
+$\\{right\_type}(\|q)\K\\{endpoint}$;\5
+$\\{link}(\|q)\K\|q$;\6
+\\{known\_pair};\5
+$\\{x\_coord}(\|q)\K\\{cur\_x}$;\5
+$\\{y\_coord}(\|q)\K\\{cur\_y}$;\5
+$\\{new\_knot}\K\|q$;\6
+\&{end};\par
+\fi
+
+\M872. The \\{known\_pair} subroutine sets \\{cur\_x} and \\{cur\_y} to the
+components
+of the current expression, assuming that the current expression is a
+pair of known numerics. Unknown components are zeroed, and the
+current expression is flushed.
+
+\Y\P$\4\X872:Declare the procedure called \\{known\_pair}\X\S$\6
+\4\&{procedure}\1\ \37\\{known\_pair};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the pair node}\2\6
+\&{begin} \37\&{if} $\\{cur\_type}\I\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Undefined\ coordinates\ have\ been\ replaced\ by%
+\ (0,0)"})$;\5
+$\\{help5}(\.{"I\ need\ x\ and\ y\ numbers\ for\ this\ part\ of\ the\ path."})$%
+\6
+$(\.{"The\ value\ I\ found\ (see\ above)\ was\ no\ good;"})$\6
+$(\.{"so\ I\'ll\ try\ to\ keep\ going\ by\ using\ zero\ instead."})$\6
+$(\.{"(Chapter\ 27\ of\ The\ METAFONTbook\ explains\ that"})$\6
+$(\.{"you\ might\ want\ to\ type\ \`I\ ???\'\ now.)"})$;\5
+$\\{put\_get\_flush\_error}(0)$;\5
+$\\{cur\_x}\K0$;\5
+$\\{cur\_y}\K0$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|p\K\\{value}(\\{cur\_exp})$;\5
+\X873:Make sure that both \|x and \|y parts of \|p are known; copy them into %
+\\{cur\_x} and \\{cur\_y}\X;\6
+$\\{flush\_cur\_exp}(0)$;\6
+\&{end};\2\6
+\&{end};\par
+\U871.\fi
+
+\M873. \P$\X873:Make sure that both \|x and \|y parts of \|p are known; copy
+them into \\{cur\_x} and \\{cur\_y}\X\S$\6
+\&{if} $\\{type}(\\{x\_part\_loc}(\|p))=\\{known}$ \1\&{then}\5
+$\\{cur\_x}\K\\{value}(\\{x\_part\_loc}(\|p))$\6
+\4\&{else} \&{begin} \37$\\{disp\_err}(\\{x\_part\_loc}(\|p),\39\.{"Undefined\
+x\ coordinate\ has\ been\ replaced\ by\ 0"})$;\5
+$\\{help5}(\.{"I\ need\ a\ \`known\'\ x\ value\ for\ this\ part\ of\ the\
+path."})$\6
+$(\.{"The\ value\ I\ found\ (see\ above)\ was\ no\ good;"})$\6
+$(\.{"so\ I\'ll\ try\ to\ keep\ going\ by\ using\ zero\ instead."})$\6
+$(\.{"(Chapter\ 27\ of\ The\ METAFONTbook\ explains\ that"})$\6
+$(\.{"you\ might\ want\ to\ type\ \`I\ ???\'\ now.)"})$;\5
+\\{put\_get\_error};\5
+$\\{recycle\_value}(\\{x\_part\_loc}(\|p))$;\5
+$\\{cur\_x}\K0$;\6
+\&{end};\2\6
+\&{if} $\\{type}(\\{y\_part\_loc}(\|p))=\\{known}$ \1\&{then}\5
+$\\{cur\_y}\K\\{value}(\\{y\_part\_loc}(\|p))$\6
+\4\&{else} \&{begin} \37$\\{disp\_err}(\\{y\_part\_loc}(\|p),\39\.{"Undefined\
+y\ coordinate\ has\ been\ replaced\ by\ 0"})$;\5
+$\\{help5}(\.{"I\ need\ a\ \`known\'\ y\ value\ for\ this\ part\ of\ the\
+path."})$\6
+$(\.{"The\ value\ I\ found\ (see\ above)\ was\ no\ good;"})$\6
+$(\.{"so\ I\'ll\ try\ to\ keep\ going\ by\ using\ zero\ instead."})$\6
+$(\.{"(Chapter\ 27\ of\ The\ METAFONTbook\ explains\ that"})$\6
+$(\.{"you\ might\ want\ to\ type\ \`I\ ???\'\ now.)"})$;\5
+\\{put\_get\_error};\5
+$\\{recycle\_value}(\\{y\_part\_loc}(\|p))$;\5
+$\\{cur\_y}\K0$;\6
+\&{end}\2\par
+\U872.\fi
+
+\M874. At this point \\{cur\_cmd} is either \\{ampersand}, \\{left\_brace}, or %
+\\{path\_join}.
+
+\Y\P$\4\X874:Determine the path join parameters; but \&{goto} \\{finish\_path}
+if there's only a direction specifier\X\S$\6
+\&{if} $\\{cur\_cmd}=\\{left\_brace}$ \1\&{then}\5
+\X879:Put the pre-join direction information into node \|q\X;\2\6
+$\|d\K\\{cur\_cmd}$;\6
+\&{if} $\|d=\\{path\_join}$ \1\&{then}\5
+\X881:Determine the tension and/or control points\X\6
+\4\&{else} \&{if} $\|d\I\\{ampersand}$ \1\&{then}\5
+\&{goto} \37\\{finish\_path};\2\2\6
+\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}=\\{left\_brace}$ \1\&{then}\5
+\X880:Put the post-join direction information into \|x and \|t\X\6
+\4\&{else} \&{if} $\\{right\_type}(\|q)\I\\{explicit}$ \1\&{then}\6
+\&{begin} \37$\|t\K\\{open}$;\5
+$\|x\K0$;\6
+\&{end}\2\2\par
+\U869.\fi
+
+\M875. The \\{scan\_direction} subroutine looks at the directional information
+that is enclosed in braces, and also scans ahead to the following character.
+A type code is returned, either \\{open} (if the direction was $(0,0)$),
+or \\{curl} (if the direction was a curl of known value \\{cur\_exp}), or
+\\{given} (if the direction is given by the \\{angle} value that now
+appears in \\{cur\_exp}).
+
+There's nothing difficult about this subroutine, but the program is rather
+lengthy because a variety of potential errors need to be nipped in the bud.
+
+\Y\P\4\&{function}\1\ \37\\{scan\_direction}: \37\\{small\_number};\6
+\4\&{var} \37\|t: \37$\\{given}\to\\{open}$;\C{the type of information found}\6
+\|x: \37\\{scaled};\C{an \|x coordinate}\2\6
+\&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}=\\{curl\_command}$ \1\&{then}\5
+\X876:Scan a curl specification\X\6
+\4\&{else} \X877:Scan a given direction\X;\2\6
+\&{if} $\\{cur\_cmd}\I\\{right\_brace}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{"\}"})$;\6
+$\\{help3}(\.{"I\'ve\ scanned\ a\ direction\ spec\ for\ part\ of\ a\ path,"})$\6
+$(\.{"so\ a\ right\ brace\ should\ have\ come\ next."})$\6
+$(\.{"I\ shall\ pretend\ that\ one\ was\ there."})$;\6
+\\{back\_error};\6
+\&{end};\2\6
+\\{get\_x\_next};\5
+$\\{scan\_direction}\K\|t$;\6
+\&{end};\par
+\fi
+
+\M876. \P$\X876:Scan a curl specification\X\S$\6
+\&{begin} \37\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $(\\{cur\_type}\I\\{known})\V(\\{cur\_exp}<0)$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ curl\ has\ been\ replaced\ by\ 1"})$;\5
+$\\{help1}(\.{"A\ curl\ must\ be\ a\ known,\ nonnegative\ number."})$;\5
+$\\{put\_get\_flush\_error}(\\{unity})$;\6
+\&{end};\2\6
+$\|t\K\\{curl}$;\6
+\&{end}\par
+\U875.\fi
+
+\M877. \P$\X877:Scan a given direction\X\S$\6
+\&{begin} \37\\{scan\_expression};\6
+\&{if} $\\{cur\_type}>\\{pair\_type}$ \1\&{then}\5
+\X878:Get given directions separated by commas\X\6
+\4\&{else} \\{known\_pair};\2\6
+\&{if} $(\\{cur\_x}=0)\W(\\{cur\_y}=0)$ \1\&{then}\5
+$\|t\K\\{open}$\6
+\4\&{else} \&{begin} \37$\|t\K\\{given}$;\5
+$\\{cur\_exp}\K\\{n\_arg}(\\{cur\_x},\39\\{cur\_y})$;\6
+\&{end};\2\6
+\&{end}\par
+\U875.\fi
+
+\M878. \P$\X878:Get given directions separated by commas\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Undefined\ x\ coordinate\ has\ been\ replaced\
+by\ 0"})$;\5
+$\\{help5}(\.{"I\ need\ a\ \`known\'\ x\ value\ for\ this\ part\ of\ the\
+path."})$\6
+$(\.{"The\ value\ I\ found\ (see\ above)\ was\ no\ good;"})$\6
+$(\.{"so\ I\'ll\ try\ to\ keep\ going\ by\ using\ zero\ instead."})$\6
+$(\.{"(Chapter\ 27\ of\ The\ METAFONTbook\ explains\ that"})$\6
+$(\.{"you\ might\ want\ to\ type\ \`I\ ???\'\ now.)"})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end};\2\6
+$\|x\K\\{cur\_exp}$;\6
+\&{if} $\\{cur\_cmd}\I\\{comma}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{","})$;\6
+$\\{help2}(\.{"I\'ve\ got\ the\ x\ coordinate\ of\ a\ path\ direction;"})$\6
+$(\.{"will\ look\ for\ the\ y\ coordinate\ next."})$;\5
+\\{back\_error};\6
+\&{end};\2\6
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Undefined\ y\ coordinate\ has\ been\ replaced\
+by\ 0"})$;\5
+$\\{help5}(\.{"I\ need\ a\ \`known\'\ y\ value\ for\ this\ part\ of\ the\
+path."})$\6
+$(\.{"The\ value\ I\ found\ (see\ above)\ was\ no\ good;"})$\6
+$(\.{"so\ I\'ll\ try\ to\ keep\ going\ by\ using\ zero\ instead."})$\6
+$(\.{"(Chapter\ 27\ of\ The\ METAFONTbook\ explains\ that"})$\6
+$(\.{"you\ might\ want\ to\ type\ \`I\ ???\'\ now.)"})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end};\2\6
+$\\{cur\_y}\K\\{cur\_exp}$;\5
+$\\{cur\_x}\K\|x$;\6
+\&{end}\par
+\U877.\fi
+
+\M879. At this point $\\{right\_type}(\|q)$ is usually \\{open}, but it may
+have been
+set to some other value by a previous splicing operation. We must maintain
+the value of $\\{right\_type}(\|q)$ in unusual cases such as
+`\.{..z1\{z2\}\&\{z3\}z1\{0,0\}..}'.
+
+\Y\P$\4\X879:Put the pre-join direction information into node \|q\X\S$\6
+\&{begin} \37$\|t\K\\{scan\_direction}$;\6
+\&{if} $\|t\I\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{right\_type}(\|q)\K\|t$;\5
+$\\{right\_given}(\|q)\K\\{cur\_exp}$;\6
+\&{if} $\\{left\_type}(\|q)=\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{left\_type}(\|q)\K\|t$;\5
+$\\{left\_given}(\|q)\K\\{cur\_exp}$;\6
+\&{end};\C{note that $\\{left\_given}(\|q)=\\{left\_curl}(\|q)$}\2\6
+\&{end};\2\6
+\&{end}\par
+\U874.\fi
+
+\M880. Since \\{left\_tension} and \\{left\_y} share the same position in knot
+nodes,
+and since \\{left\_given} is similarly equivalent to \\{left\_x}, we use
+\|x and \|y to hold the given direction and tension information when
+there are no explicit control points.
+
+\Y\P$\4\X880:Put the post-join direction information into \|x and \|t\X\S$\6
+\&{begin} \37$\|t\K\\{scan\_direction}$;\6
+\&{if} $\\{right\_type}(\|q)\I\\{explicit}$ \1\&{then}\5
+$\|x\K\\{cur\_exp}$\6
+\4\&{else} $\|t\K\\{explicit}$;\C{the direction information is superfluous}\2\6
+\&{end}\par
+\U874.\fi
+
+\M881. \P$\X881:Determine the tension and/or control points\X\S$\6
+\&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}=\\{tension}$ \1\&{then}\5
+\X882:Set explicit tensions\X\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{controls}$ \1\&{then}\5
+\X884:Set explicit control points\X\6
+\4\&{else} \&{begin} \37$\\{right\_tension}(\|q)\K\\{unity}$;\5
+$\|y\K\\{unity}$;\5
+\\{back\_input};\C{default tension}\6
+\&{goto} \37\\{done};\6
+\&{end};\2\2\6
+\&{if} $\\{cur\_cmd}\I\\{path\_join}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{".."})$;\6
+$\\{help1}(\.{"A\ path\ join\ command\ should\ end\ with\ two\ dots."})$;\5
+\\{back\_error};\6
+\&{end};\2\6
+\4\\{done}: \37\&{end}\par
+\U874.\fi
+
+\M882. \P$\X882:Set explicit tensions\X\S$\6
+\&{begin} \37\\{get\_x\_next};\5
+$\|y\K\\{cur\_cmd}$;\6
+\&{if} $\\{cur\_cmd}=\\{at\_least}$ \1\&{then}\5
+\\{get\_x\_next};\2\6
+\\{scan\_primary};\5
+\X883:Make sure that the current expression is a valid tension setting\X;\6
+\&{if} $\|y=\\{at\_least}$ \1\&{then}\5
+$\\{negate}(\\{cur\_exp})$;\2\6
+$\\{right\_tension}(\|q)\K\\{cur\_exp}$;\6
+\&{if} $\\{cur\_cmd}=\\{and\_command}$ \1\&{then}\6
+\&{begin} \37\\{get\_x\_next};\5
+$\|y\K\\{cur\_cmd}$;\6
+\&{if} $\\{cur\_cmd}=\\{at\_least}$ \1\&{then}\5
+\\{get\_x\_next};\2\6
+\\{scan\_primary};\5
+\X883:Make sure that the current expression is a valid tension setting\X;\6
+\&{if} $\|y=\\{at\_least}$ \1\&{then}\5
+$\\{negate}(\\{cur\_exp})$;\2\6
+\&{end};\2\6
+$\|y\K\\{cur\_exp}$;\6
+\&{end}\par
+\U881.\fi
+
+\M883. \P\D \37$\\{min\_tension}\S\\{three\_quarter\_unit}$\par
+\Y\P$\4\X883:Make sure that the current expression is a valid tension setting\X%
+\S$\6
+\&{if} $(\\{cur\_type}\I\\{known})\V(\\{cur\_exp}<\\{min\_tension})$ \1\&{then}%
+\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ tension\ has\ been\ set\ to\ 1"})$;\5
+$\\{help1}(\.{"The\ expression\ above\ should\ have\ been\ a\ number\
+>=3/4."})$;\5
+$\\{put\_get\_flush\_error}(\\{unity})$;\6
+\&{end}\2\par
+\Us882\ET882.\fi
+
+\M884. \P$\X884:Set explicit control points\X\S$\6
+\&{begin} \37$\\{right\_type}(\|q)\K\\{explicit}$;\5
+$\|t\K\\{explicit}$;\5
+\\{get\_x\_next};\5
+\\{scan\_primary};\6
+\\{known\_pair};\5
+$\\{right\_x}(\|q)\K\\{cur\_x}$;\5
+$\\{right\_y}(\|q)\K\\{cur\_y}$;\6
+\&{if} $\\{cur\_cmd}\I\\{and\_command}$ \1\&{then}\6
+\&{begin} \37$\|x\K\\{right\_x}(\|q)$;\5
+$\|y\K\\{right\_y}(\|q)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\\{get\_x\_next};\5
+\\{scan\_primary};\6
+\\{known\_pair};\5
+$\|x\K\\{cur\_x}$;\5
+$\|y\K\\{cur\_y}$;\6
+\&{end};\2\6
+\&{end}\par
+\U881.\fi
+
+\M885. \P$\X885:Convert the right operand, \\{cur\_exp}, into a partial path
+from \\{pp} to~\\{qq}\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_type}\I\\{path\_type}$ \1\&{then}\5
+$\\{pp}\K\\{new\_knot}$\6
+\4\&{else} $\\{pp}\K\\{cur\_exp}$;\2\6
+$\\{qq}\K\\{pp}$;\6
+\&{while} $\\{link}(\\{qq})\I\\{pp}$ \1\&{do}\5
+$\\{qq}\K\\{link}(\\{qq})$;\2\6
+\&{if} $\\{left\_type}(\\{pp})\I\\{endpoint}$ \1\&{then}\C{open up a cycle}\6
+\&{begin} \37$\|r\K\\{copy\_knot}(\\{pp})$;\5
+$\\{link}(\\{qq})\K\|r$;\5
+$\\{qq}\K\|r$;\6
+\&{end};\2\6
+$\\{left\_type}(\\{pp})\K\\{open}$;\5
+$\\{right\_type}(\\{qq})\K\\{open}$;\6
+\&{end}\par
+\U869.\fi
+
+\M886. If a person tries to define an entire path by saying `\.{(x,y)\&cycle}',
+we silently change the specification to `\.{(x,y)..cycle}', since a cycle
+shouldn't have length zero.
+
+\Y\P$\4\X886:Get ready to close a cycle\X\S$\6
+\&{begin} \37$\\{cycle\_hit}\K\\{true}$;\5
+\\{get\_x\_next};\5
+$\\{pp}\K\|p$;\5
+$\\{qq}\K\|p$;\6
+\&{if} $\|d=\\{ampersand}$ \1\&{then}\6
+\&{if} $\|p=\|q$ \1\&{then}\6
+\&{begin} \37$\|d\K\\{path\_join}$;\5
+$\\{right\_tension}(\|q)\K\\{unity}$;\5
+$\|y\K\\{unity}$;\6
+\&{end};\2\2\6
+\&{end}\par
+\U869.\fi
+
+\M887. \P$\X887:Join the partial paths and reset \|p and \|q to the head and
+tail of the result\X\S$\6
+\&{begin} \37\&{if} $\|d=\\{ampersand}$ \1\&{then}\6
+\&{if} $(\\{x\_coord}(\|q)\I\\{x\_coord}(\\{pp}))\V(\\{y\_coord}(\|q)\I\\{y%
+\_coord}(\\{pp}))$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Paths\ don\'t\ touch;\ \`\&\'\ will\ be\
+changed\ to\ \`..\'"})$;\5
+$\\{help3}(\.{"When\ you\ join\ paths\ \`p\&q\',\ the\ ending\ point\ of\ p"})$%
+\6
+$(\.{"must\ be\ exactly\ equal\ to\ the\ starting\ point\ of\ q."})$\6
+$(\.{"So\ I\'m\ going\ to\ pretend\ that\ you\ said\ \`p..q\'\ instead."})$;\5
+\\{put\_get\_error};\5
+$\|d\K\\{path\_join}$;\5
+$\\{right\_tension}(\|q)\K\\{unity}$;\5
+$\|y\K\\{unity}$;\6
+\&{end};\2\2\6
+\X889:Plug an opening in $\\{right\_type}(\\{pp})$, if possible\X;\6
+\&{if} $\|d=\\{ampersand}$ \1\&{then}\5
+\X890:Splice independent paths together\X\6
+\4\&{else} \&{begin} \37\X888:Plug an opening in $\\{right\_type}(\|q)$, if
+possible\X;\6
+$\\{link}(\|q)\K\\{pp}$;\5
+$\\{left\_y}(\\{pp})\K\|y$;\6
+\&{if} $\|t\I\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{left\_x}(\\{pp})\K\|x$;\5
+$\\{left\_type}(\\{pp})\K\|t$;\6
+\&{end};\2\6
+\&{end};\2\6
+$\|q\K\\{qq}$;\6
+\&{end}\par
+\U869.\fi
+
+\M888. \P$\X888:Plug an opening in $\\{right\_type}(\|q)$, if possible\X\S$\6
+\&{if} $\\{right\_type}(\|q)=\\{open}$ \1\&{then}\6
+\&{if} $(\\{left\_type}(\|q)=\\{curl})\V(\\{left\_type}(\|q)=\\{given})$ \1%
+\&{then}\6
+\&{begin} \37$\\{right\_type}(\|q)\K\\{left\_type}(\|q)$;\5
+$\\{right\_given}(\|q)\K\\{left\_given}(\|q)$;\6
+\&{end}\2\2\par
+\U887.\fi
+
+\M889. \P$\X889:Plug an opening in $\\{right\_type}(\\{pp})$, if possible\X\S$\6
+\&{if} $\\{right\_type}(\\{pp})=\\{open}$ \1\&{then}\6
+\&{if} $(\|t=\\{curl})\V(\|t=\\{given})$ \1\&{then}\6
+\&{begin} \37$\\{right\_type}(\\{pp})\K\|t$;\5
+$\\{right\_given}(\\{pp})\K\|x$;\6
+\&{end}\2\2\par
+\U887.\fi
+
+\M890. \P$\X890:Splice independent paths together\X\S$\6
+\&{begin} \37\&{if} $\\{left\_type}(\|q)=\\{open}$ \1\&{then}\6
+\&{if} $\\{right\_type}(\|q)=\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{left\_type}(\|q)\K\\{curl}$;\5
+$\\{left\_curl}(\|q)\K\\{unity}$;\6
+\&{end};\2\2\6
+\&{if} $\\{right\_type}(\\{pp})=\\{open}$ \1\&{then}\6
+\&{if} $\|t=\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{right\_type}(\\{pp})\K\\{curl}$;\5
+$\\{right\_curl}(\\{pp})\K\\{unity}$;\6
+\&{end};\2\2\6
+$\\{right\_type}(\|q)\K\\{right\_type}(\\{pp})$;\5
+$\\{link}(\|q)\K\\{link}(\\{pp})$;\6
+$\\{right\_x}(\|q)\K\\{right\_x}(\\{pp})$;\5
+$\\{right\_y}(\|q)\K\\{right\_y}(\\{pp})$;\5
+$\\{free\_node}(\\{pp},\39\\{knot\_node\_size})$;\6
+\&{if} $\\{qq}=\\{pp}$ \1\&{then}\5
+$\\{qq}\K\|q$;\2\6
+\&{end}\par
+\U887.\fi
+
+\M891. \P$\X891:Choose control points for the path and put the result into %
+\\{cur\_exp}\X\S$\6
+\&{if} $\\{cycle\_hit}$ \1\&{then}\6
+\&{begin} \37\&{if} $\|d=\\{ampersand}$ \1\&{then}\5
+$\|p\K\|q$;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{left\_type}(\|p)\K\\{endpoint}$;\6
+\&{if} $\\{right\_type}(\|p)=\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{right\_type}(\|p)\K\\{curl}$;\5
+$\\{right\_curl}(\|p)\K\\{unity}$;\6
+\&{end};\2\6
+$\\{right\_type}(\|q)\K\\{endpoint}$;\6
+\&{if} $\\{left\_type}(\|q)=\\{open}$ \1\&{then}\6
+\&{begin} \37$\\{left\_type}(\|q)\K\\{curl}$;\5
+$\\{left\_curl}(\|q)\K\\{unity}$;\6
+\&{end};\2\6
+$\\{link}(\|q)\K\|p$;\6
+\&{end};\2\6
+$\\{make\_choices}(\|p)$;\5
+$\\{cur\_type}\K\\{path\_type}$;\5
+$\\{cur\_exp}\K\|p$\par
+\U869.\fi
+
+\M892. Finally, we sometimes need to scan an expression whose value is
+supposed to be either \\{true\_code} or \\{false\_code}.
+
+\Y\P$\4\X823:Declare the basic parsing subroutines\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{get\_boolean};\2\6
+\&{begin} \37\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{boolean\_type}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Undefined\ condition\ will\ be\ treated\ as\ %
+\`false\'"})$;\5
+$\\{help2}(\.{"The\ expression\ shown\ above\ should\ have\ had\ a\
+definite"})$\6
+$(\.{"true-or-false\ value.\ I\'m\ changing\ it\ to\ \`false\'."})$;\6
+$\\{put\_get\_flush\_error}(\\{false\_code})$;\5
+$\\{cur\_type}\K\\{boolean\_type}$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\N893. \[42] Doing the operations.
+The purpose of parsing is primarily to permit people to avoid piles of
+parentheses. But the real work is done after the structure of an expression
+has been recognized; that's when new expressions are generated. We
+turn now to the guts of \MF, which handles individual operators that
+have come through the parsing mechanism.
+
+We'll start with the easy ones that take no operands, then work our way
+up to operators with one and ultimately two arguments. In other words,
+we will write the three procedures \\{do\_nullary}, \\{do\_unary}, and \\{do%
+\_binary}
+that are invoked periodically by the expression scanners.
+
+First let's make sure that all of the primitive operators are in the
+hash table. Although \\{scan\_primary} and its relatives made use of the
+\\{cmd} code for these operators, the \\{do} routines base everything
+on the \\{mod} code. For example, \\{do\_binary} doesn't care whether the
+operation it performs is a \\{primary\_binary} or \\{secondary\_binary}, etc.
+
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"true"},\39\\{nullary},\39\\{true\_code})$;\6
+$\\{primitive}(\.{"false"},\39\\{nullary},\39\\{false\_code})$;\6
+$\\{primitive}(\.{"nullpicture"},\39\\{nullary},\39\\{null\_picture\_code})$;\6
+$\\{primitive}(\.{"nullpen"},\39\\{nullary},\39\\{null\_pen\_code})$;\6
+$\\{primitive}(\.{"jobname"},\39\\{nullary},\39\\{job\_name\_op})$;\6
+$\\{primitive}(\.{"readstring"},\39\\{nullary},\39\\{read\_string\_op})$;\6
+$\\{primitive}(\.{"pencircle"},\39\\{nullary},\39\\{pen\_circle})$;\6
+$\\{primitive}(\.{"normaldeviate"},\39\\{nullary},\39\\{normal\_deviate})$;\6
+$\\{primitive}(\.{"odd"},\39\\{unary},\39\\{odd\_op})$;\6
+$\\{primitive}(\.{"known"},\39\\{unary},\39\\{known\_op})$;\6
+$\\{primitive}(\.{"unknown"},\39\\{unary},\39\\{unknown\_op})$;\6
+$\\{primitive}(\.{"not"},\39\\{unary},\39\\{not\_op})$;\6
+$\\{primitive}(\.{"decimal"},\39\\{unary},\39\\{decimal})$;\6
+$\\{primitive}(\.{"reverse"},\39\\{unary},\39\\{reverse})$;\6
+$\\{primitive}(\.{"makepath"},\39\\{unary},\39\\{make\_path\_op})$;\6
+$\\{primitive}(\.{"makepen"},\39\\{unary},\39\\{make\_pen\_op})$;\6
+$\\{primitive}(\.{"totalweight"},\39\\{unary},\39\\{total\_weight\_op})$;\6
+$\\{primitive}(\.{"oct"},\39\\{unary},\39\\{oct\_op})$;\6
+$\\{primitive}(\.{"hex"},\39\\{unary},\39\\{hex\_op})$;\6
+$\\{primitive}(\.{"ASCII"},\39\\{unary},\39\\{ASCII\_op})$;\6
+$\\{primitive}(\.{"char"},\39\\{unary},\39\\{char\_op})$;\6
+$\\{primitive}(\.{"length"},\39\\{unary},\39\\{length\_op})$;\6
+$\\{primitive}(\.{"turningnumber"},\39\\{unary},\39\\{turning\_op})$;\6
+$\\{primitive}(\.{"xpart"},\39\\{unary},\39\\{x\_part})$;\6
+$\\{primitive}(\.{"ypart"},\39\\{unary},\39\\{y\_part})$;\6
+$\\{primitive}(\.{"xxpart"},\39\\{unary},\39\\{xx\_part})$;\6
+$\\{primitive}(\.{"xypart"},\39\\{unary},\39\\{xy\_part})$;\6
+$\\{primitive}(\.{"yxpart"},\39\\{unary},\39\\{yx\_part})$;\6
+$\\{primitive}(\.{"yypart"},\39\\{unary},\39\\{yy\_part})$;\6
+$\\{primitive}(\.{"sqrt"},\39\\{unary},\39\\{sqrt\_op})$;\6
+$\\{primitive}(\.{"mexp"},\39\\{unary},\39\\{m\_exp\_op})$;\6
+$\\{primitive}(\.{"mlog"},\39\\{unary},\39\\{m\_log\_op})$;\6
+$\\{primitive}(\.{"sind"},\39\\{unary},\39\\{sin\_d\_op})$;\6
+$\\{primitive}(\.{"cosd"},\39\\{unary},\39\\{cos\_d\_op})$;\6
+$\\{primitive}(\.{"floor"},\39\\{unary},\39\\{floor\_op})$;\6
+$\\{primitive}(\.{"uniformdeviate"},\39\\{unary},\39\\{uniform\_deviate})$;\6
+$\\{primitive}(\.{"charexists"},\39\\{unary},\39\\{char\_exists\_op})$;\6
+$\\{primitive}(\.{"angle"},\39\\{unary},\39\\{angle\_op})$;\6
+$\\{primitive}(\.{"cycle"},\39\\{cycle},\39\\{cycle\_op})$;\6
+$\\{primitive}(\.{"+"},\39\\{plus\_or\_minus},\39\\{plus})$;\6
+$\\{primitive}(\.{"-"},\39\\{plus\_or\_minus},\39\\{minus})$;\6
+$\\{primitive}(\.{"*"},\39\\{secondary\_binary},\39\\{times})$;\6
+$\\{primitive}(\.{"/"},\39\\{slash},\39\\{over})$;\5
+$\\{eqtb}[\\{frozen\_slash}]\K\\{eqtb}[\\{cur\_sym}]$;\6
+$\\{primitive}(\.{"++"},\39\\{tertiary\_binary},\39\\{pythag\_add})$;\6
+$\\{primitive}(\.{"+-+"},\39\\{tertiary\_binary},\39\\{pythag\_sub})$;\6
+$\\{primitive}(\.{"and"},\39\\{and\_command},\39\\{and\_op})$;\6
+$\\{primitive}(\.{"or"},\39\\{tertiary\_binary},\39\\{or\_op})$;\6
+$\\{primitive}(\.{"<"},\39\\{expression\_binary},\39\\{less\_than})$;\6
+$\\{primitive}(\.{"<="},\39\\{expression\_binary},\39\\{less\_or\_equal})$;\6
+$\\{primitive}(\.{">"},\39\\{expression\_binary},\39\\{greater\_than})$;\6
+$\\{primitive}(\.{">="},\39\\{expression\_binary},\39\\{greater\_or\_equal})$;\6
+$\\{primitive}(\.{"="},\39\\{equals},\39\\{equal\_to})$;\6
+$\\{primitive}(\.{"<>"},\39\\{expression\_binary},\39\\{unequal\_to})$;\6
+$\\{primitive}(\.{"substring"},\39\\{primary\_binary},\39\\{substring\_of})$;\6
+$\\{primitive}(\.{"subpath"},\39\\{primary\_binary},\39\\{subpath\_of})$;\6
+$\\{primitive}(\.{"directiontime"},\39\\{primary\_binary},\39\\{direction\_time%
+\_of})$;\6
+$\\{primitive}(\.{"point"},\39\\{primary\_binary},\39\\{point\_of})$;\6
+$\\{primitive}(\.{"precontrol"},\39\\{primary\_binary},\39\\{precontrol\_of})$;%
+\6
+$\\{primitive}(\.{"postcontrol"},\39\\{primary\_binary},\39\\{postcontrol%
+\_of})$;\6
+$\\{primitive}(\.{"penoffset"},\39\\{primary\_binary},\39\\{pen\_offset\_of})$;%
+\6
+$\\{primitive}(\.{"\&"},\39\\{ampersand},\39\\{concatenate})$;\6
+$\\{primitive}(\.{"rotated"},\39\\{secondary\_binary},\39\\{rotated\_by})$;\6
+$\\{primitive}(\.{"slanted"},\39\\{secondary\_binary},\39\\{slanted\_by})$;\6
+$\\{primitive}(\.{"scaled"},\39\\{secondary\_binary},\39\\{scaled\_by})$;\6
+$\\{primitive}(\.{"shifted"},\39\\{secondary\_binary},\39\\{shifted\_by})$;\6
+$\\{primitive}(\.{"transformed"},\39\\{secondary\_binary},\39\\{transformed%
+\_by})$;\6
+$\\{primitive}(\.{"xscaled"},\39\\{secondary\_binary},\39\\{x\_scaled})$;\6
+$\\{primitive}(\.{"yscaled"},\39\\{secondary\_binary},\39\\{y\_scaled})$;\6
+$\\{primitive}(\.{"zscaled"},\39\\{secondary\_binary},\39\\{z\_scaled})$;\6
+$\\{primitive}(\.{"intersectiontimes"},\39\\{tertiary\_binary},\39%
+\\{intersect})$;\par
+\fi
+
+\M894. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4$\\{nullary},\39\\{unary},\39\\{primary\_binary},\39\\{secondary\_binary},\39%
+\\{tertiary\_binary},\39\\{expression\_binary},\39\\{cycle},\39\\{plus\_or%
+\_minus},\39\\{slash},\39\\{ampersand},\39\\{equals},\39\\{and\_command}$: \37$%
+\\{print\_op}(\|m)$;\par
+\fi
+
+\M895. OK, let's look at the simplest \\{do} procedure first.
+
+\Y\P\4\&{procedure}\1\ \37$\\{do\_nullary}(\|c:\\{quarterword})$;\6
+\4\&{var} \37\|k: \37\\{integer};\C{all-purpose loop index}\2\6
+\&{begin} \37\\{check\_arith};\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>\\{two}$ \1\&{then}\5
+$\\{show\_cmd\_mod}(\\{nullary},\39\|c)$;\2\6
+\&{case} $\|c$ \1\&{of}\6
+\4$\\{true\_code},\39\\{false\_code}$: \37\&{begin} \37$\\{cur\_type}\K%
+\\{boolean\_type}$;\5
+$\\{cur\_exp}\K\|c$;\6
+\&{end};\6
+\4\\{null\_picture\_code}: \37\&{begin} \37$\\{cur\_type}\K\\{picture\_type}$;\5
+$\\{cur\_exp}\K\\{get\_node}(\\{edge\_header\_size})$;\5
+$\\{init\_edges}(\\{cur\_exp})$;\6
+\&{end};\6
+\4\\{null\_pen\_code}: \37\&{begin} \37$\\{cur\_type}\K\\{pen\_type}$;\5
+$\\{cur\_exp}\K\\{null\_pen}$;\6
+\&{end};\6
+\4\\{normal\_deviate}: \37\&{begin} \37$\\{cur\_type}\K\\{known}$;\5
+$\\{cur\_exp}\K\\{norm\_rand}$;\6
+\&{end};\6
+\4\\{pen\_circle}: \37\X896:Make a special knot node for \&{pencircle}\X;\6
+\4\\{job\_name\_op}: \37\&{begin} \37\&{if} $\\{job\_name}=0$ \1\&{then}\5
+\\{open\_log\_file};\2\6
+$\\{cur\_type}\K\\{string\_type}$;\5
+$\\{cur\_exp}\K\\{job\_name}$;\6
+\&{end};\6
+\4\\{read\_string\_op}: \37\X897:Read a string from the terminal\X;\2\6
+\&{end};\C{there are no other cases}\6
+\\{check\_arith};\6
+\&{end};\par
+\fi
+
+\M896. \P$\X896:Make a special knot node for \&{pencircle}\X\S$\6
+\&{begin} \37$\\{cur\_type}\K\\{future\_pen}$;\5
+$\\{cur\_exp}\K\\{get\_node}(\\{knot\_node\_size})$;\5
+$\\{left\_type}(\\{cur\_exp})\K\\{open}$;\5
+$\\{right\_type}(\\{cur\_exp})\K\\{open}$;\5
+$\\{link}(\\{cur\_exp})\K\\{cur\_exp}$;\6
+$\\{x\_coord}(\\{cur\_exp})\K0$;\5
+$\\{y\_coord}(\\{cur\_exp})\K0$;\6
+$\\{left\_x}(\\{cur\_exp})\K\\{unity}$;\5
+$\\{left\_y}(\\{cur\_exp})\K0$;\6
+$\\{right\_x}(\\{cur\_exp})\K0$;\5
+$\\{right\_y}(\\{cur\_exp})\K\\{unity}$;\6
+\&{end}\par
+\U895.\fi
+
+\M897. \P$\X897:Read a string from the terminal\X\S$\6
+\&{begin} \37\&{if} $\\{interaction}\L\\{nonstop\_mode}$ \1\&{then}\5
+$\\{fatal\_error}(\.{"***\ (cannot\ readstring\ in\ nonstop\ modes)"})$;\2\6
+\\{begin\_file\_reading};\5
+$\\{name}\K1$;\5
+$\\{prompt\_input}(\.{""})$;\5
+$\\{str\_room}(\\{last}-\\{start})$;\6
+\&{for} $\|k\K\\{start}\mathrel{\&{to}}\\{last}-1$ \1\&{do}\5
+$\\{append\_char}(\\{buffer}[\|k])$;\2\6
+\\{end\_file\_reading};\5
+$\\{cur\_type}\K\\{string\_type}$;\5
+$\\{cur\_exp}\K\\{make\_string}$;\6
+\&{end}\par
+\U895.\fi
+
+\M898. Things get a bit more interesting when there's an operand. The
+operand to \\{do\_unary} appears in \\{cur\_type} and \\{cur\_exp}.
+
+\Y\P\hbox{\4}\X899:Declare unary action procedures\X\6
+\4\&{procedure}\1\ \37$\\{do\_unary}(\|c:\\{quarterword})$;\6
+\4\&{var} \37$\|p,\39\|q$: \37\\{pointer};\C{for list manipulation}\6
+\|x: \37\\{integer};\C{a temporary register}\2\6
+\&{begin} \37\\{check\_arith};\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>\\{two}$ \1\&{then}\5
+\X902:Trace the current unary operation\X;\2\6
+\&{case} $\|c$ \1\&{of}\6
+\4\\{plus}: \37\&{if} $\\{cur\_type}<\\{pair\_type}$ \1\&{then}\6
+\&{if} $\\{cur\_type}\I\\{picture\_type}$ \1\&{then}\5
+$\\{bad\_unary}(\\{plus})$;\2\2\6
+\4\\{minus}: \37\X903:Negate the current expression\X;\6
+\hbox{\4}\X905:Additional cases of unary operators\X\2\6
+\&{end};\C{there are no other cases}\6
+\\{check\_arith};\6
+\&{end};\par
+\fi
+
+\M899. The \\{nice\_pair} function returns \\{true} if both components of a
+pair
+are known.
+
+\Y\P$\4\X899:Declare unary action procedures\X\S$\6
+\4\&{function}\1\ \37$\\{nice\_pair}(\|p:\\{integer};\,\35\|t:%
+\\{quarterword})$: \37\\{boolean};\6
+\4\&{label} \37\\{exit};\2\6
+\&{begin} \37\&{if} $\|t=\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{value}(\|p)$;\6
+\&{if} $\\{type}(\\{x\_part\_loc}(\|p))=\\{known}$ \1\&{then}\6
+\&{if} $\\{type}(\\{y\_part\_loc}(\|p))=\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{nice\_pair}\K\\{true}$;\5
+\&{return};\6
+\&{end};\2\2\6
+\&{end};\2\6
+$\\{nice\_pair}\K\\{false}$;\6
+\4\\{exit}: \37\&{end};\par
+\As900, 901, 904, 908, 910, 913, 916\ETs919.
+\U898.\fi
+
+\M900. \P$\X899:Declare unary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{print\_known\_or\_unknown\_type}(\|t:\\{small%
+\_number};\,\35\|v:\\{integer})$;\2\6
+\&{begin} \37$\\{print\_char}(\.{"("})$;\6
+\&{if} $\|t<\\{dependent}$ \1\&{then}\6
+\&{if} $\|t\I\\{pair\_type}$ \1\&{then}\5
+$\\{print\_type}(\|t)$\6
+\4\&{else} \&{if} $\\{nice\_pair}(\|v,\39\\{pair\_type})$ \1\&{then}\5
+$\\{print}(\.{"pair"})$\6
+\4\&{else} $\\{print}(\.{"unknown\ pair"})$\2\2\6
+\4\&{else} $\\{print}(\.{"unknown\ numeric"})$;\2\6
+$\\{print\_char}(\.{")"})$;\6
+\&{end};\par
+\fi
+
+\M901. \P$\X899:Declare unary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{bad\_unary}(\|c:\\{quarterword})$;\2\6
+\&{begin} \37$\\{exp\_err}(\.{"Not\ implemented:\ "})$;\5
+$\\{print\_op}(\|c)$;\5
+$\\{print\_known\_or\_unknown\_type}(\\{cur\_type},\39\\{cur\_exp})$;\5
+$\\{help3}(\.{"I\'m\ afraid\ I\ don\'t\ know\ how\ to\ apply\ that\ operation\
+to\ that"})$\6
+$(\.{"particular\ type.\ Continue,\ and\ I\'ll\ simply\ return\ the"})$\6
+$(\.{"argument\ (shown\ above)\ as\ the\ result\ of\ the\ operation."})$;\5
+\\{put\_get\_error};\6
+\&{end};\par
+\fi
+
+\M902. \P$\X902:Trace the current unary operation\X\S$\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\{"})$;\5
+$\\{print\_op}(\|c)$;\5
+$\\{print\_char}(\.{"("})$;\6
+$\\{print\_exp}(\\{null},\390)$;\C{show the operand, but not verbosely}\6
+$\\{print}(\.{")\}"})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\par
+\U898.\fi
+
+\M903. Negation is easy except when the current expression
+is of type \\{independent}, or when it is a pair with one or more
+\\{independent} components.
+
+It is tempting to argue that the negative of an independent variable
+is an independent variable, hence we don't have to do anything when
+negating it. The fallacy is that other dependent variables pointing
+to the current expression must change the sign of their
+coefficients if we make no change to the current expression.
+
+Instead, we work around the problem by copying the current expression
+and recycling it afterwards (cf.~the \\{stash\_in} routine).
+
+\Y\P$\4\X903:Negate the current expression\X\S$\6
+\&{case} $\\{cur\_type}$ \1\&{of}\6
+\4$\\{pair\_type},\39\\{independent}$: \37\&{begin} \37$\|q\K\\{cur\_exp}$;\5
+$\\{make\_exp\_copy}(\|q)$;\6
+\&{if} $\\{cur\_type}=\\{dependent}$ \1\&{then}\5
+$\\{negate\_dep\_list}(\\{dep\_list}(\\{cur\_exp}))$\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{value}(\\{cur\_exp})$;\6
+\&{if} $\\{type}(\\{x\_part\_loc}(\|p))=\\{known}$ \1\&{then}\5
+$\\{negate}(\\{value}(\\{x\_part\_loc}(\|p)))$\6
+\4\&{else} $\\{negate\_dep\_list}(\\{dep\_list}(\\{x\_part\_loc}(\|p)))$;\2\6
+\&{if} $\\{type}(\\{y\_part\_loc}(\|p))=\\{known}$ \1\&{then}\5
+$\\{negate}(\\{value}(\\{y\_part\_loc}(\|p)))$\6
+\4\&{else} $\\{negate\_dep\_list}(\\{dep\_list}(\\{y\_part\_loc}(\|p)))$;\2\6
+\&{end};\C{if $\\{cur\_type}=\\{known}$ then $\\{cur\_exp}=0$}\2\2\6
+$\\{recycle\_value}(\|q)$;\5
+$\\{free\_node}(\|q,\39\\{value\_node\_size})$;\6
+\&{end};\6
+\4$\\{dependent},\39\\{proto\_dependent}$: \37$\\{negate\_dep\_list}(\\{dep%
+\_list}(\\{cur\_exp}))$;\6
+\4\\{known}: \37$\\{negate}(\\{cur\_exp})$;\6
+\4\\{picture\_type}: \37$\\{negate\_edges}(\\{cur\_exp})$;\6
+\4\&{othercases} \37$\\{bad\_unary}(\\{minus})$\2\6
+\&{endcases}\par
+\U898.\fi
+
+\M904. \P$\X899:Declare unary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{negate\_dep\_list}(\|p:\\{pointer})$;\6
+\4\&{label} \37\\{exit};\2\6
+\&{begin} \37\~ \1\&{loop}\ \&{begin} \37$\\{negate}(\\{value}(\|p))$;\6
+\&{if} $\\{info}(\|p)=\\{null}$ \1\&{then}\5
+\&{return};\2\6
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M905. \P$\X905:Additional cases of unary operators\X\S$\6
+\4\\{not\_op}: \37\&{if} $\\{cur\_type}\I\\{boolean\_type}$ \1\&{then}\5
+$\\{bad\_unary}(\\{not\_op})$\6
+\4\&{else} $\\{cur\_exp}\K\\{true\_code}+\\{false\_code}-\\{cur\_exp}$;\2\par
+\As906, 907, 909, 912, 915, 917, 918, 920\ETs921.
+\U898.\fi
+
+\M906. \P\D \37$\\{three\_sixty\_units}\S23592960$\C{that's $360\ast\\{unity}$}%
+\par
+\P\D \37$\\{boolean\_reset}(\#)\S$\1\6
+\&{if} $\#$ \1\&{then}\5
+$\\{cur\_exp}\K\\{true\_code}$\ \&{else} $\\{cur\_exp}\K\\{false\_code}$\2\2\par
+\Y\P$\4\X905:Additional cases of unary operators\X\mathrel{+}\S$\6
+\4$\\{sqrt\_op},\39\\{m\_exp\_op},\39\\{m\_log\_op},\39\\{sin\_d\_op},\39\\{cos%
+\_d\_op},\39\\{floor\_op},\39\\{uniform\_deviate},\39\\{odd\_op},\39\\{char%
+\_exists\_op}$: \37\hbox{}\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+$\\{bad\_unary}(\|c)$\6
+\4\&{else} \&{case} $\|c$ \1\&{of}\6
+\4\\{sqrt\_op}: \37$\\{cur\_exp}\K\\{square\_rt}(\\{cur\_exp})$;\6
+\4\\{m\_exp\_op}: \37$\\{cur\_exp}\K\\{m\_exp}(\\{cur\_exp})$;\6
+\4\\{m\_log\_op}: \37$\\{cur\_exp}\K\\{m\_log}(\\{cur\_exp})$;\6
+\4$\\{sin\_d\_op},\39\\{cos\_d\_op}$: \37\&{begin} \37$\\{n\_sin\_cos}((\\{cur%
+\_exp}\mathbin{\&{mod}}\\{three\_sixty\_units})\ast16)$;\6
+\&{if} $\|c=\\{sin\_d\_op}$ \1\&{then}\5
+$\\{cur\_exp}\K\\{round\_fraction}(\\{n\_sin})$\6
+\4\&{else} $\\{cur\_exp}\K\\{round\_fraction}(\\{n\_cos})$;\2\6
+\&{end};\6
+\4\\{floor\_op}: \37$\\{cur\_exp}\K\\{floor\_scaled}(\\{cur\_exp})$;\6
+\4\\{uniform\_deviate}: \37$\\{cur\_exp}\K\\{unif\_rand}(\\{cur\_exp})$;\6
+\4\\{odd\_op}: \37\&{begin} \37$\\{boolean\_reset}(\\{odd}(\\{round\_unscaled}(%
+\\{cur\_exp})))$;\5
+$\\{cur\_type}\K\\{boolean\_type}$;\6
+\&{end};\6
+\4\\{char\_exists\_op}: \37\X1181:Determine if a character has been shipped out%
+\X;\2\6
+\&{end};\C{there are no other cases}\2\par
+\fi
+
+\M907. \P$\X905:Additional cases of unary operators\X\mathrel{+}\S$\6
+\4\\{angle\_op}: \37\&{if} $\\{nice\_pair}(\\{cur\_exp},\39\\{cur\_type})$ \1%
+\&{then}\6
+\&{begin} \37$\|p\K\\{value}(\\{cur\_exp})$;\5
+$\|x\K\\{n\_arg}(\\{value}(\\{x\_part\_loc}(\|p)),\39\\{value}(\\{y\_part%
+\_loc}(\|p)))$;\6
+\&{if} $\|x\G0$ \1\&{then}\5
+$\\{flush\_cur\_exp}((\|x+8)\mathbin{\&{div}}16)$\6
+\4\&{else} $\\{flush\_cur\_exp}(-((-\|x+8)\mathbin{\&{div}}16))$;\2\6
+\&{end}\6
+\4\&{else} $\\{bad\_unary}(\\{angle\_op})$;\2\par
+\fi
+
+\M908. If the current expression is a pair, but the context wants it to
+be a path, we call \\{pair\_to\_path}.
+
+\Y\P$\4\X899:Declare unary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{pair\_to\_path};\2\6
+\&{begin} \37$\\{cur\_exp}\K\\{new\_knot}$;\5
+$\\{cur\_type}\K\\{path\_type}$;\6
+\&{end};\par
+\fi
+
+\M909. \P$\X905:Additional cases of unary operators\X\mathrel{+}\S$\6
+\4$\\{x\_part},\39\\{y\_part}$: \37\&{if} $(\\{cur\_type}\L\\{pair\_type})\W(%
+\\{cur\_type}\G\\{transform\_type})$ \1\&{then}\5
+$\\{take\_part}(\|c)$\6
+\4\&{else} $\\{bad\_unary}(\|c)$;\2\6
+\4$\\{xx\_part},\39\\{xy\_part},\39\\{yx\_part},\39\\{yy\_part}$: \37\&{if} $%
+\\{cur\_type}=\\{transform\_type}$ \1\&{then}\5
+$\\{take\_part}(\|c)$\6
+\4\&{else} $\\{bad\_unary}(\|c)$;\2\par
+\fi
+
+\M910. In the following procedure, \\{cur\_exp} points to a capsule, which
+points to
+a big node. We want to delete all but one part of the big node.
+
+\Y\P$\4\X899:Declare unary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{take\_part}(\|c:\\{quarterword})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the big node}\2\6
+\&{begin} \37$\|p\K\\{value}(\\{cur\_exp})$;\5
+$\\{value}(\\{temp\_val})\K\|p$;\5
+$\\{type}(\\{temp\_val})\K\\{cur\_type}$;\5
+$\\{link}(\|p)\K\\{temp\_val}$;\5
+$\\{free\_node}(\\{cur\_exp},\39\\{value\_node\_size})$;\5
+$\\{make\_exp\_copy}(\|p+2\ast(\|c-\\{x\_part}))$;\5
+$\\{recycle\_value}(\\{temp\_val})$;\6
+\&{end};\par
+\fi
+
+\M911. \P$\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}%
+\S$\6
+$\\{name\_type}(\\{temp\_val})\K\\{capsule}$;\par
+\fi
+
+\M912. \P$\X905:Additional cases of unary operators\X\mathrel{+}\S$\6
+\4\\{char\_op}: \37\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+$\\{bad\_unary}(\\{char\_op})$\6
+\4\&{else} \&{begin} \37$\\{cur\_exp}\K\\{round\_unscaled}(\\{cur\_exp})%
+\mathbin{\&{mod}}256$;\5
+$\\{cur\_type}\K\\{string\_type}$;\6
+\&{if} $\\{cur\_exp}<0$ \1\&{then}\5
+$\\{cur\_exp}\K\\{cur\_exp}+256$;\2\6
+\&{if} $\\{length}(\\{cur\_exp})\I1$ \1\&{then}\6
+\&{begin} \37$\\{str\_room}(1)$;\5
+$\\{append\_char}(\\{cur\_exp})$;\5
+$\\{cur\_exp}\K\\{make\_string}$;\6
+\&{end};\2\6
+\&{end};\2\6
+\4\\{decimal}: \37\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+$\\{bad\_unary}(\\{decimal})$\6
+\4\&{else} \&{begin} \37$\\{old\_setting}\K\\{selector}$;\5
+$\\{selector}\K\\{new\_string}$;\5
+$\\{print\_scaled}(\\{cur\_exp})$;\5
+$\\{cur\_exp}\K\\{make\_string}$;\5
+$\\{selector}\K\\{old\_setting}$;\5
+$\\{cur\_type}\K\\{string\_type}$;\6
+\&{end};\2\6
+\4$\\{oct\_op},\39\\{hex\_op},\39\\{ASCII\_op}$: \37\&{if} $\\{cur\_type}\I%
+\\{string\_type}$ \1\&{then}\5
+$\\{bad\_unary}(\|c)$\6
+\4\&{else} $\\{str\_to\_num}(\|c)$;\2\par
+\fi
+
+\M913. \P$\X899:Declare unary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{str\_to\_num}(\|c:\\{quarterword})$;\C{converts a
+string to a number}\6
+\4\&{var} \37\|n: \37\\{integer};\C{accumulator}\6
+\|m: \37\\{ASCII\_code};\C{current character}\6
+\|k: \37\\{pool\_pointer};\C{index into \\{str\_pool}}\6
+\|b: \37$8\to16$;\C{radix of conversion}\6
+\\{bad\_char}: \37\\{boolean};\C{did the string contain an invalid digit?}\2\6
+\&{begin} \37\&{if} $\|c=\\{ASCII\_op}$ \1\&{then}\6
+\&{if} $\\{length}(\\{cur\_exp})=0$ \1\&{then}\5
+$\|n\K-1$\6
+\4\&{else} $\|n\K\\{so}(\\{str\_pool}[\\{str\_start}[\\{cur\_exp}]])$\2\6
+\4\&{else} \&{begin} \37\&{if} $\|c=\\{oct\_op}$ \1\&{then}\5
+$\|b\K8$\ \&{else} $\|b\K16$;\2\6
+$\|n\K0$;\5
+$\\{bad\_char}\K\\{false}$;\6
+\&{for} $\|k\K\\{str\_start}[\\{cur\_exp}]\mathrel{\&{to}}\\{str\_start}[\\{cur%
+\_exp}+1]-1$ \1\&{do}\6
+\&{begin} \37$\|m\K\\{so}(\\{str\_pool}[\|k])$;\6
+\&{if} $(\|m\G\.{"0"})\W(\|m\L\.{"9"})$ \1\&{then}\5
+$\|m\K\|m-\.{"0"}$\6
+\4\&{else} \&{if} $(\|m\G\.{"A"})\W(\|m\L\.{"F"})$ \1\&{then}\5
+$\|m\K\|m-\.{"A"}+10$\6
+\4\&{else} \&{if} $(\|m\G\.{"a"})\W(\|m\L\.{"f"})$ \1\&{then}\5
+$\|m\K\|m-\.{"a"}+10$\6
+\4\&{else} \&{begin} \37$\\{bad\_char}\K\\{true}$;\5
+$\|m\K0$;\6
+\&{end};\2\2\2\6
+\&{if} $\|m\G\|b$ \1\&{then}\6
+\&{begin} \37$\\{bad\_char}\K\\{true}$;\5
+$\|m\K0$;\6
+\&{end};\2\6
+\&{if} $\|n<32768\mathbin{\&{div}}\|b$ \1\&{then}\5
+$\|n\K\|n\ast\|b+\|m$\ \&{else} $\|n\K32767$;\2\6
+\&{end};\2\6
+\X914:Give error messages if \\{bad\_char} or $\|n\G4096$\X;\6
+\&{end};\2\6
+$\\{flush\_cur\_exp}(\|n\ast\\{unity})$;\6
+\&{end};\par
+\fi
+
+\M914. \P$\X914:Give error messages if \\{bad\_char} or $\|n\G4096$\X\S$\6
+\&{if} $\\{bad\_char}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"String\ contains\ illegal\ digits"})$;\6
+\&{if} $\|c=\\{oct\_op}$ \1\&{then}\5
+$\\{help1}(\.{"I\ zeroed\ out\ characters\ that\ weren\'t\ in\ the\ range\
+0..7."})$\6
+\4\&{else} $\\{help1}(\.{"I\ zeroed\ out\ characters\ that\ weren\'t\ hex\
+digits."})$;\2\6
+\\{put\_get\_error};\6
+\&{end};\2\6
+\&{if} $\|n>4095$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Number\ too\ large\ ("})$;\5
+$\\{print\_int}(\|n)$;\5
+$\\{print\_char}(\.{")"})$;\5
+$\\{help1}(\.{"I\ have\ trouble\ with\ numbers\ greater\ than\ 4095;\ watch\
+out."})$;\5
+\\{put\_get\_error};\6
+\&{end}\2\par
+\U913.\fi
+
+\M915. The length operation is somewhat unusual in that it applies to a variety
+of different types of operands.
+
+\Y\P$\4\X905:Additional cases of unary operators\X\mathrel{+}\S$\6
+\4\\{length\_op}: \37\&{if} $\\{cur\_type}=\\{string\_type}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(\\{length}(\\{cur\_exp})\ast\\{unity})$\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{path\_type}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(\\{path\_length})$\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\5
+$\\{cur\_exp}\K\\{abs}(\\{cur\_exp})$\6
+\4\&{else} \&{if} $\\{nice\_pair}(\\{cur\_exp},\39\\{cur\_type})$ \1\&{then}\5
+$\\{flush\_cur\_exp}(\\{pyth\_add}(\\{value}(\\{x\_part\_loc}(\\{value}(\\{cur%
+\_exp}))),\39\30\\{value}(\\{y\_part\_loc}(\\{value}(\\{cur\_exp})))))$\6
+\4\&{else} $\\{bad\_unary}(\|c)$;\2\2\2\2\par
+\fi
+
+\M916. \P$\X899:Declare unary action procedures\X\mathrel{+}\S$\6
+\4\&{function}\1\ \37\\{path\_length}: \37\\{scaled};\C{computes the length of
+the current path}\6
+\4\&{var} \37\|n: \37\\{scaled};\C{the path length so far}\6
+\|p: \37\\{pointer};\C{traverser}\2\6
+\&{begin} \37$\|p\K\\{cur\_exp}$;\6
+\&{if} $\\{left\_type}(\|p)=\\{endpoint}$ \1\&{then}\5
+$\|n\K-\\{unity}$\ \&{else} $\|n\K0$;\2\6
+\1\&{repeat} \37$\|p\K\\{link}(\|p)$;\5
+$\|n\K\|n+\\{unity}$;\6
+\4\&{until}\5
+$\|p=\\{cur\_exp}$;\2\6
+$\\{path\_length}\K\|n$;\6
+\&{end};\par
+\fi
+
+\M917. The turning number is computed only with respect to null pens. A
+different
+pen might affect the turning number, in degenerate cases, because autorounding
+will produce a slightly different path, or because excessively large
+coordinates
+might be truncated.
+
+\Y\P$\4\X905:Additional cases of unary operators\X\mathrel{+}\S$\6
+\4\\{turning\_op}: \37\&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(0)$\6
+\4\&{else} \&{if} $\\{cur\_type}\I\\{path\_type}$ \1\&{then}\5
+$\\{bad\_unary}(\\{turning\_op})$\6
+\4\&{else} \&{if} $\\{left\_type}(\\{cur\_exp})=\\{endpoint}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(0)$\C{not a cyclic path}\6
+\4\&{else} \&{begin} \37$\\{cur\_pen}\K\\{null\_pen}$;\5
+$\\{cur\_path\_type}\K\\{contour\_code}$;\5
+$\\{cur\_exp}\K\\{make\_spec}(\\{cur\_exp},\39\\{fraction\_one}-\\{half%
+\_unit}-1-\\{el\_gordo},\390)$;\5
+$\\{flush\_cur\_exp}(\\{turning\_number}\ast\\{unity})$;\C{convert to %
+\\{scaled}}\6
+\&{end};\2\2\2\par
+\fi
+
+\M918. \P\D \37$\\{type\_test\_end}\S\\{flush\_cur\_exp}(\\{true\_code})$\6
+\4\&{else} \37$\\{flush\_cur\_exp}(\\{false\_code})$;\5
+$\\{cur\_type}\K\\{boolean\_type}$; \6
+\&{end} \par
+\P\D $\\{type\_range\_end}(\#)\S(\\{cur\_type}\L\#)$ \&{then} \\{type\_test%
+\_end}\par
+\P\D $\\{type\_range}(\#)\S$ \6
+\&{begin} \6
+\&{if} $(\\{cur\_type}\G\#)\W\\{type\_range\_end}$\par
+\P\D $\\{type\_test}(\#)\S$ \6
+\&{begin} \37\&{if} $\\{cur\_type}=\#$ \1\&{then}\5
+\\{type\_test\_end}\2\par
+\Y\P$\4\X905:Additional cases of unary operators\X\mathrel{+}\S$\6
+\4\\{boolean\_type}: \37$\\{type\_range}(\\{boolean\_type})(\\{unknown%
+\_boolean})$;\6
+\4\\{string\_type}: \37$\\{type\_range}(\\{string\_type})(\\{unknown%
+\_string})$;\6
+\4\\{pen\_type}: \37$\\{type\_range}(\\{pen\_type})(\\{future\_pen})$;\6
+\4\\{path\_type}: \37$\\{type\_range}(\\{path\_type})(\\{unknown\_path})$;\6
+\4\\{picture\_type}: \37$\\{type\_range}(\\{picture\_type})(\\{unknown%
+\_picture})$;\6
+\4$\\{transform\_type},\39\\{pair\_type}$: \37$\\{type\_test}(\|c)$;\6
+\4\\{numeric\_type}: \37$\\{type\_range}(\\{known})(\\{independent})$;\6
+\4$\\{known\_op},\39\\{unknown\_op}$: \37$\\{test\_known}(\|c)$;\par
+\fi
+
+\M919. \P$\X899:Declare unary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{test\_known}(\|c:\\{quarterword})$;\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|b: \37$\\{true\_code}\to\\{false\_code}$;\C{is the current
+expression known?}\6
+$\|p,\39\|q$: \37\\{pointer};\C{locations in a big node}\2\6
+\&{begin} \37$\|b\K\\{false\_code}$;\6
+\&{case} $\\{cur\_type}$ \1\&{of}\6
+\4$\\{vacuous},\39\\{boolean\_type},\39\\{string\_type},\39\\{pen\_type},\39%
+\\{future\_pen},\39\\{path\_type},\39\\{picture\_type},\39\\{known}$: \37$\|b\K%
+\\{true\_code}$;\6
+\4$\\{transform\_type},\39\\{pair\_type}$: \37\&{begin} \37$\|p\K\\{value}(%
+\\{cur\_exp})$;\5
+$\|q\K\|p+\\{big\_node\_size}[\\{cur\_type}]$;\6
+\1\&{repeat} \37$\|q\K\|q-2$;\6
+\&{if} $\\{type}(\|q)\I\\{known}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\4\&{until}\5
+$\|q=\|p$;\2\6
+$\|b\K\\{true\_code}$;\6
+\4\\{done}: \37\&{end};\6
+\4\&{othercases} \37\\{do\_nothing}\2\6
+\&{endcases};\6
+\&{if} $\|c=\\{known\_op}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(\|b)$\6
+\4\&{else} $\\{flush\_cur\_exp}(\\{true\_code}+\\{false\_code}-\|b)$;\2\6
+$\\{cur\_type}\K\\{boolean\_type}$;\6
+\&{end};\par
+\fi
+
+\M920. \P$\X905:Additional cases of unary operators\X\mathrel{+}\S$\6
+\4\\{cycle\_op}: \37\&{begin} \37\&{if} $\\{cur\_type}\I\\{path\_type}$ \1%
+\&{then}\5
+$\\{flush\_cur\_exp}(\\{false\_code})$\6
+\4\&{else} \&{if} $\\{left\_type}(\\{cur\_exp})\I\\{endpoint}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(\\{true\_code})$\6
+\4\&{else} $\\{flush\_cur\_exp}(\\{false\_code})$;\2\2\6
+$\\{cur\_type}\K\\{boolean\_type}$;\6
+\&{end};\par
+\fi
+
+\M921. \P$\X905:Additional cases of unary operators\X\mathrel{+}\S$\6
+\4\\{make\_pen\_op}: \37\&{begin} \37\&{if} $\\{cur\_type}=\\{pair\_type}$ \1%
+\&{then}\5
+\\{pair\_to\_path};\2\6
+\&{if} $\\{cur\_type}=\\{path\_type}$ \1\&{then}\5
+$\\{cur\_type}\K\\{future\_pen}$\6
+\4\&{else} $\\{bad\_unary}(\\{make\_pen\_op})$;\2\6
+\&{end};\6
+\4\\{make\_path\_op}: \37\&{begin} \37\&{if} $\\{cur\_type}=\\{future\_pen}$ \1%
+\&{then}\5
+\\{materialize\_pen};\2\6
+\&{if} $\\{cur\_type}\I\\{pen\_type}$ \1\&{then}\5
+$\\{bad\_unary}(\\{make\_path\_op})$\6
+\4\&{else} \&{begin} \37$\\{flush\_cur\_exp}(\\{make\_path}(\\{cur\_exp}))$;\5
+$\\{cur\_type}\K\\{path\_type}$;\6
+\&{end};\2\6
+\&{end};\6
+\4\\{total\_weight\_op}: \37\&{if} $\\{cur\_type}\I\\{picture\_type}$ \1%
+\&{then}\5
+$\\{bad\_unary}(\\{total\_weight\_op})$\6
+\4\&{else} $\\{flush\_cur\_exp}(\\{total\_weight}(\\{cur\_exp}))$;\2\6
+\4\\{reverse}: \37\&{if} $\\{cur\_type}=\\{path\_type}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{htap\_ypoc}(\\{cur\_exp})$;\6
+\&{if} $\\{right\_type}(\|p)=\\{endpoint}$ \1\&{then}\5
+$\|p\K\\{link}(\|p)$;\2\6
+$\\{toss\_knot\_list}(\\{cur\_exp})$;\5
+$\\{cur\_exp}\K\|p$;\6
+\&{end}\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\5
+\\{pair\_to\_path}\6
+\4\&{else} $\\{bad\_unary}(\\{reverse})$;\2\2\par
+\fi
+
+\M922. Finally, we have the operations that combine a capsule~\|p
+with the current expression.
+
+\Y\P\hbox{\4}\X923:Declare binary action procedures\X\6
+\4\&{procedure}\1\ \37$\\{do\_binary}(\|p:\\{pointer};\,\35\|c:%
+\\{quarterword})$;\6
+\4\&{label} \37$\\{done},\39\\{done1},\39\\{exit}$;\6
+\4\&{var} \37$\|q,\39\|r,\39\\{rr}$: \37\\{pointer};\C{for list manipulation}\6
+$\\{old\_p},\39\\{old\_exp}$: \37\\{pointer};\C{capsules to recycle}\6
+\|v: \37\\{integer};\C{for numeric manipulation}\2\6
+\&{begin} \37\\{check\_arith};\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>\\{two}$ \1\&{then}\5
+\X924:Trace the current binary operation\X;\2\6
+\X926:Sidestep \\{independent} cases in capsule \|p\X;\6
+\X927:Sidestep \\{independent} cases in the current expression\X;\6
+\&{case} $\|c$ \1\&{of}\6
+\4$\\{plus},\39\\{minus}$: \37\X929:Add or subtract the current expression from
+\|p\X;\6
+\hbox{\4}\X936:Additional cases of binary operators\X\2\6
+\&{end};\C{there are no other cases}\6
+$\\{recycle\_value}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$;\C{\&{return} to avoid this}\6
+\4\\{exit}: \37\\{check\_arith};\5
+\X925:Recycle any sidestepped \\{independent} capsules\X;\6
+\&{end};\par
+\fi
+
+\M923. \P$\X923:Declare binary action procedures\X\S$\6
+\4\&{procedure}\1\ \37$\\{bad\_binary}(\|p:\\{pointer};\,\35\|c:%
+\\{quarterword})$;\2\6
+\&{begin} \37$\\{disp\_err}(\|p,\39\.{""})$;\5
+$\\{exp\_err}(\.{"Not\ implemented:\ "})$;\6
+\&{if} $\|c\G\\{min\_of}$ \1\&{then}\5
+$\\{print\_op}(\|c)$;\2\6
+$\\{print\_known\_or\_unknown\_type}(\\{type}(\|p),\39\|p)$;\6
+\&{if} $\|c\G\\{min\_of}$ \1\&{then}\5
+$\\{print}(\.{"of"})$\ \&{else} $\\{print\_op}(\|c)$;\2\6
+$\\{print\_known\_or\_unknown\_type}(\\{cur\_type},\39\\{cur\_exp})$;\6
+$\\{help3}(\.{"I\'m\ afraid\ I\ don\'t\ know\ how\ to\ apply\ that\ operation\
+to\ that"})$\6
+$(\.{"combination\ of\ types.\ Continue,\ and\ I\'ll\ return\ the\ second"})$\6
+$(\.{"argument\ (see\ above)\ as\ the\ result\ of\ the\ operation."})$;\5
+\\{put\_get\_error};\6
+\&{end};\par
+\As928, 930, 943, 946, 949, 953, 960, 961, 962, 963, 966, 976, 977, 978, 982,
+984\ETs985.
+\U922.\fi
+
+\M924. \P$\X924:Trace the current binary operation\X\S$\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\{("})$;\5
+$\\{print\_exp}(\|p,\390)$;\C{show the operand, but not verbosely}\6
+$\\{print\_char}(\.{")"})$;\5
+$\\{print\_op}(\|c)$;\5
+$\\{print\_char}(\.{"("})$;\6
+$\\{print\_exp}(\\{null},\390)$;\5
+$\\{print}(\.{")\}"})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\par
+\U922.\fi
+
+\M925. Several of the binary operations are potentially complicated by the
+fact that \\{independent} values can sneak into capsules. For example,
+we've seen an instance of this difficulty in the unary operation
+of negation. In order to reduce the number of cases that need to be
+handled, we first change the two operands (if necessary)
+to rid them of \\{independent} components. The original operands are
+put into capsules called \\{old\_p} and \\{old\_exp}, which will be
+recycled after the binary operation has been safely carried out.
+
+\Y\P$\4\X925:Recycle any sidestepped \\{independent} capsules\X\S$\6
+\&{if} $\\{old\_p}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{recycle\_value}(\\{old\_p})$;\5
+$\\{free\_node}(\\{old\_p},\39\\{value\_node\_size})$;\6
+\&{end};\2\6
+\&{if} $\\{old\_exp}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{recycle\_value}(\\{old\_exp})$;\5
+$\\{free\_node}(\\{old\_exp},\39\\{value\_node\_size})$;\6
+\&{end}\2\par
+\U922.\fi
+
+\M926. A big node is considered to be ``tarnished'' if it contains at least one
+independent component. We will define a simple function called `\\{tarnished}'
+that returns \\{null} if and only if its argument is not tarnished.
+
+\Y\P$\4\X926:Sidestep \\{independent} cases in capsule \|p\X\S$\6
+\&{case} $\\{type}(\|p)$ \1\&{of}\6
+\4$\\{transform\_type},\39\\{pair\_type}$: \37$\\{old\_p}\K\\{tarnished}(\|p)$;%
+\6
+\4\\{independent}: \37$\\{old\_p}\K\\{void}$;\6
+\4\&{othercases} \37$\\{old\_p}\K\\{null}$\2\6
+\&{endcases};\6
+\&{if} $\\{old\_p}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\|q\K\\{stash\_cur\_exp}$;\5
+$\\{old\_p}\K\|p$;\5
+$\\{make\_exp\_copy}(\\{old\_p})$;\5
+$\|p\K\\{stash\_cur\_exp}$;\5
+$\\{unstash\_cur\_exp}(\|q)$;\6
+\&{end};\2\par
+\U922.\fi
+
+\M927. \P$\X927:Sidestep \\{independent} cases in the current expression\X\S$\6
+\&{case} $\\{cur\_type}$ \1\&{of}\6
+\4$\\{transform\_type},\39\\{pair\_type}$: \37$\\{old\_exp}\K\\{tarnished}(%
+\\{cur\_exp})$;\6
+\4\\{independent}: \37$\\{old\_exp}\K\\{void}$;\6
+\4\&{othercases} \37$\\{old\_exp}\K\\{null}$\2\6
+\&{endcases};\6
+\&{if} $\\{old\_exp}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{old\_exp}\K\\{cur\_exp}$;\5
+$\\{make\_exp\_copy}(\\{old\_exp})$;\6
+\&{end}\2\par
+\U922.\fi
+
+\M928. \P$\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{function}\1\ \37$\\{tarnished}(\|p:\\{pointer})$: \37\\{pointer};\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|q: \37\\{pointer};\C{beginning of the big node}\6
+\|r: \37\\{pointer};\C{current position in the big node}\2\6
+\&{begin} \37$\|q\K\\{value}(\|p)$;\5
+$\|r\K\|q+\\{big\_node\_size}[\\{type}(\|p)]$;\6
+\1\&{repeat} \37$\|r\K\|r-2$;\6
+\&{if} $\\{type}(\|r)=\\{independent}$ \1\&{then}\6
+\&{begin} \37$\\{tarnished}\K\\{void}$;\5
+\&{return};\6
+\&{end};\2\6
+\4\&{until}\5
+$\|r=\|q$;\2\6
+$\\{tarnished}\K\\{null}$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M929. \P$\X929:Add or subtract the current expression from \|p\X\S$\6
+\&{if} $(\\{cur\_type}<\\{pair\_type})\V(\\{type}(\|p)<\\{pair\_type})$ \1%
+\&{then}\6
+\&{if} $(\\{cur\_type}=\\{picture\_type})\W(\\{type}(\|p)=\\{picture\_type})$ %
+\1\&{then}\6
+\&{begin} \37\&{if} $\|c=\\{minus}$ \1\&{then}\5
+$\\{negate\_edges}(\\{cur\_exp})$;\2\6
+$\\{cur\_edges}\K\\{cur\_exp}$;\5
+$\\{merge\_edges}(\\{value}(\|p))$;\6
+\&{end}\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\|c)$\2\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\6
+\&{if} $\\{type}(\|p)\I\\{pair\_type}$ \1\&{then}\5
+$\\{bad\_binary}(\|p,\39\|c)$\6
+\4\&{else} \&{begin} \37$\|q\K\\{value}(\|p)$;\5
+$\|r\K\\{value}(\\{cur\_exp})$;\5
+$\\{add\_or\_subtract}(\\{x\_part\_loc}(\|q),\39\\{x\_part\_loc}(\|r),\39\|c)$;%
+\5
+$\\{add\_or\_subtract}(\\{y\_part\_loc}(\|q),\39\\{y\_part\_loc}(\|r),\39\|c)$;%
+\6
+\&{end}\2\6
+\4\&{else} \&{if} $\\{type}(\|p)=\\{pair\_type}$ \1\&{then}\5
+$\\{bad\_binary}(\|p,\39\|c)$\6
+\4\&{else} $\\{add\_or\_subtract}(\|p,\39\\{null},\39\|c)$\2\2\2\par
+\U922.\fi
+
+\M930. The first argument to \\{add\_or\_subtract} is the location of a value
+node
+in a capsule or pair node that will soon be recycled. The second argument
+is either a location within a pair or transform node of \\{cur\_exp},
+or it is null (which means that \\{cur\_exp} itself should be the second
+argument). The third argument is either \\{plus} or \\{minus}.
+
+The sum or difference of the numeric quantities will replace the second
+operand. Arithmetic overflow may go undetected; users aren't supposed to
+be monkeying around with really big values.
+
+\Y\P$\4\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\hbox{\4}\X935:Declare the procedure called \\{dep\_finish}\X\6
+\4\&{procedure}\1\ \37$\\{add\_or\_subtract}(\|p,\39\|q:\\{pointer};\,\35\|c:%
+\\{quarterword})$;\6
+\4\&{label} \37$\\{done},\39\\{exit}$;\6
+\4\&{var} \37$\|s,\39\|t$: \37\\{small\_number};\C{operand types}\6
+\|r: \37\\{pointer};\C{list traverser}\6
+\|v: \37\\{integer};\C{second operand value}\2\6
+\&{begin} \37\&{if} $\|q=\\{null}$ \1\&{then}\6
+\&{begin} \37$\|t\K\\{cur\_type}$;\6
+\&{if} $\|t<\\{dependent}$ \1\&{then}\5
+$\|v\K\\{cur\_exp}$\ \&{else} $\|v\K\\{dep\_list}(\\{cur\_exp})$;\2\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|t\K\\{type}(\|q)$;\6
+\&{if} $\|t<\\{dependent}$ \1\&{then}\5
+$\|v\K\\{value}(\|q)$\ \&{else} $\|v\K\\{dep\_list}(\|q)$;\2\6
+\&{end};\2\6
+\&{if} $\|t=\\{known}$ \1\&{then}\6
+\&{begin} \37\&{if} $\|c=\\{minus}$ \1\&{then}\5
+$\\{negate}(\|v)$;\2\6
+\&{if} $\\{type}(\|p)=\\{known}$ \1\&{then}\6
+\&{begin} \37$\|v\K\\{slow\_add}(\\{value}(\|p),\39\|v)$;\6
+\&{if} $\|q=\\{null}$ \1\&{then}\5
+$\\{cur\_exp}\K\|v$\ \&{else} $\\{value}(\|q)\K\|v$;\2\6
+\&{return};\6
+\&{end};\2\6
+\X931:Add a known value to the constant term of $\\{dep\_list}(\|p)$\X;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\|c=\\{minus}$ \1\&{then}\5
+$\\{negate\_dep\_list}(\|v)$;\2\6
+\X932:Add operand \|p to the dependency list \|v\X;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M931. \P$\X931:Add a known value to the constant term of $\\{dep\_list}(\|p)$%
+\X\S$\6
+$\|r\K\\{dep\_list}(\|p)$;\6
+\&{while} $\\{info}(\|r)\I\\{null}$ \1\&{do}\5
+$\|r\K\\{link}(\|r)$;\2\6
+$\\{value}(\|r)\K\\{slow\_add}(\\{value}(\|r),\39\|v)$;\6
+\&{if} $\|q=\\{null}$ \1\&{then}\6
+\&{begin} \37$\|q\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{cur\_exp}\K\|q$;\5
+$\\{cur\_type}\K\\{type}(\|p)$;\5
+$\\{name\_type}(\|q)\K\\{capsule}$;\6
+\&{end};\2\6
+$\\{dep\_list}(\|q)\K\\{dep\_list}(\|p)$;\5
+$\\{type}(\|q)\K\\{type}(\|p)$;\5
+$\\{prev\_dep}(\|q)\K\\{prev\_dep}(\|p)$;\5
+$\\{link}(\\{prev\_dep}(\|p))\K\|q$;\5
+$\\{type}(\|p)\K\\{known}$;\C{this will keep the recycler from collecting
+non-garbage}\par
+\U930.\fi
+
+\M932. We prefer \\{dependent} lists to \\{proto\_dependent} ones, because it
+is
+nice to retain the extra accuracy of \\{fraction} coefficients.
+But we have to handle both kinds, and mixtures too.
+
+\Y\P$\4\X932:Add operand \|p to the dependency list \|v\X\S$\6
+\&{if} $\\{type}(\|p)=\\{known}$ \1\&{then}\5
+\X933:Add the known $\\{value}(\|p)$ to the constant term of \|v\X\6
+\4\&{else} \&{begin} \37$\|s\K\\{type}(\|p)$;\5
+$\|r\K\\{dep\_list}(\|p)$;\6
+\&{if} $\|t=\\{dependent}$ \1\&{then}\6
+\&{begin} \37\&{if} $\|s=\\{dependent}$ \1\&{then}\6
+\&{if} $\\{max\_coef}(\|r)+\\{max\_coef}(\|v)<\\{coef\_bound}$ \1\&{then}\6
+\&{begin} \37$\|v\K\\{p\_plus\_q}(\|v,\39\|r,\39\\{dependent})$;\5
+\&{goto} \37\\{done};\6
+\&{end};\C{\\{fix\_needed} will necessarily be false}\2\2\6
+$\|t\K\\{proto\_dependent}$;\5
+$\|v\K\\{p\_over\_v}(\|v,\39\\{unity},\39\\{dependent},\39\\{proto%
+\_dependent})$;\6
+\&{end};\2\6
+\&{if} $\|s=\\{proto\_dependent}$ \1\&{then}\5
+$\|v\K\\{p\_plus\_q}(\|v,\39\|r,\39\\{proto\_dependent})$\6
+\4\&{else} $\|v\K\\{p\_plus\_fq}(\|v,\39\\{unity},\39\|r,\39\\{proto%
+\_dependent},\39\\{dependent})$;\2\6
+\4\\{done}: \37\X934:Output the answer, \|v (which might have become \\{known})%
+\X;\6
+\&{end}\2\par
+\U930.\fi
+
+\M933. \P$\X933:Add the known $\\{value}(\|p)$ to the constant term of \|v\X\S$%
+\6
+\&{begin} \37\&{while} $\\{info}(\|v)\I\\{null}$ \1\&{do}\5
+$\|v\K\\{link}(\|v)$;\2\6
+$\\{value}(\|v)\K\\{slow\_add}(\\{value}(\|p),\39\\{value}(\|v))$;\6
+\&{end}\par
+\U932.\fi
+
+\M934. \P$\X934:Output the answer, \|v (which might have become \\{known})\X\S$%
+\6
+\&{if} $\|q\I\\{null}$ \1\&{then}\5
+$\\{dep\_finish}(\|v,\39\|q,\39\|t)$\6
+\4\&{else} \&{begin} \37$\\{cur\_type}\K\|t$;\5
+$\\{dep\_finish}(\|v,\39\\{null},\39\|t)$;\6
+\&{end}\2\par
+\U932.\fi
+
+\M935. Here's the current situation: The dependency list \|v of type \|t
+should either be put into the current expression (if $\|q=\\{null}$) or
+into location \|q within a pair node (otherwise). The destination (\\{cur\_exp}
+or \|q) formerly held a dependency list with the same
+final pointer as the list \|v.
+
+\Y\P$\4\X935:Declare the procedure called \\{dep\_finish}\X\S$\6
+\4\&{procedure}\1\ \37$\\{dep\_finish}(\|v,\39\|q:\\{pointer};\,\35\|t:%
+\\{small\_number})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the destination}\6
+\\{vv}: \37\\{scaled};\C{the value, if it is \\{known}}\2\6
+\&{begin} \37\&{if} $\|q=\\{null}$ \1\&{then}\5
+$\|p\K\\{cur\_exp}$\ \&{else} $\|p\K\|q$;\2\6
+$\\{dep\_list}(\|p)\K\|v$;\5
+$\\{type}(\|p)\K\|t$;\6
+\&{if} $\\{info}(\|v)=\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{vv}\K\\{value}(\|v)$;\6
+\&{if} $\|q=\\{null}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(\\{vv})$\6
+\4\&{else} \&{begin} \37$\\{recycle\_value}(\|p)$;\5
+$\\{type}(\|q)\K\\{known}$;\5
+$\\{value}(\|q)\K\\{vv}$;\6
+\&{end};\2\6
+\&{end}\6
+\4\&{else} \&{if} $\|q=\\{null}$ \1\&{then}\5
+$\\{cur\_type}\K\|t$;\2\2\6
+\&{if} $\\{fix\_needed}$ \1\&{then}\5
+\\{fix\_dependencies};\2\6
+\&{end};\par
+\U930.\fi
+
+\M936. Let's turn now to the six basic relations of comparison.
+
+\Y\P$\4\X936:Additional cases of binary operators\X\S$\6
+\4$\\{less\_than},\39\\{less\_or\_equal},\39\\{greater\_than},\39\\{greater\_or%
+\_equal},\39\\{equal\_to},\39\\{unequal\_to}$: \37\&{begin} \37\hbox{}\6
+\&{if} $(\\{cur\_type}>\\{pair\_type})\W(\\{type}(\|p)>\\{pair\_type})$ \1%
+\&{then}\5
+$\\{add\_or\_subtract}(\|p,\39\\{null},\39\\{minus})$\C{$\\{cur\_exp}\K(\|p)-%
+\\{cur\_exp}$}\6
+\4\&{else} \&{if} $\\{cur\_type}\I\\{type}(\|p)$ \1\&{then}\6
+\&{begin} \37$\\{bad\_binary}(\|p,\39\|c)$;\5
+\&{goto} \37\\{done};\6
+\&{end}\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{string\_type}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(\\{str\_vs\_str}(\\{value}(\|p),\39\\{cur\_exp}))$\6
+\4\&{else} \&{if} $(\\{cur\_type}=\\{unknown\_string})\V(\\{cur\_type}=%
+\\{unknown\_boolean})$ \1\&{then}\5
+\X938:Check if unknowns have been equated\X\6
+\4\&{else} \&{if} $(\\{cur\_type}=\\{pair\_type})\V(\\{cur\_type}=\\{transform%
+\_type})$ \1\&{then}\5
+\X939:Reduce comparison of big nodes to comparison of scalars\X\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{boolean\_type}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(\\{cur\_exp}-\\{value}(\|p))$\6
+\4\&{else} \&{begin} \37$\\{bad\_binary}(\|p,\39\|c)$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\2\2\2\2\2\6
+\X937:Compare the current expression with zero\X;\6
+\4\\{done}: \37\&{end};\par
+\As940, 941, 948, 951, 952, 975, 983\ETs988.
+\U922.\fi
+
+\M937. \P$\X937:Compare the current expression with zero\X\S$\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{cur\_type}<\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{disp\_err}(\|p,\39\.{""})$;\5
+$\\{help1}(\.{"The\ quantities\ shown\ above\ have\ not\ been\ equated."})$\6
+\&{end}\6
+\4\&{else} $\\{help2}(\.{"Oh\ dear.\ I\ can\'t\ decide\ if\ the\ expression\
+above\ is\ positive,"})$\2\6
+$(\.{"negative,\ or\ zero.\ So\ this\ comparison\ test\ won\'t\ be\ \`true%
+\'."})$;\5
+$\\{exp\_err}(\.{"Unknown\ relation\ will\ be\ considered\ false"})$;\5
+$\\{put\_get\_flush\_error}(\\{false\_code})$;\6
+\&{end}\6
+\4\&{else} \&{case} $\|c$ \1\&{of}\6
+\4\\{less\_than}: \37$\\{boolean\_reset}(\\{cur\_exp}<0)$;\6
+\4\\{less\_or\_equal}: \37$\\{boolean\_reset}(\\{cur\_exp}\L0)$;\6
+\4\\{greater\_than}: \37$\\{boolean\_reset}(\\{cur\_exp}>0)$;\6
+\4\\{greater\_or\_equal}: \37$\\{boolean\_reset}(\\{cur\_exp}\G0)$;\6
+\4\\{equal\_to}: \37$\\{boolean\_reset}(\\{cur\_exp}=0)$;\6
+\4\\{unequal\_to}: \37$\\{boolean\_reset}(\\{cur\_exp}\I0)$;\2\6
+\&{end};\C{there are no other cases}\2\6
+$\\{cur\_type}\K\\{boolean\_type}$\par
+\U936.\fi
+
+\M938. When two unknown strings are in the same ring, we know that they are
+equal. Otherwise, we don't know whether they are equal or not, so we
+make no change.
+
+\Y\P$\4\X938:Check if unknowns have been equated\X\S$\6
+\&{begin} \37$\|q\K\\{value}(\\{cur\_exp})$;\6
+\&{while} $(\|q\I\\{cur\_exp})\W(\|q\I\|p)$ \1\&{do}\5
+$\|q\K\\{value}(\|q)$;\2\6
+\&{if} $\|q=\|p$ \1\&{then}\5
+$\\{flush\_cur\_exp}(0)$;\2\6
+\&{end}\par
+\U936.\fi
+
+\M939. \P$\X939:Reduce comparison of big nodes to comparison of scalars\X\S$\6
+\&{begin} \37$\|q\K\\{value}(\|p)$;\5
+$\|r\K\\{value}(\\{cur\_exp})$;\5
+$\\{rr}\K\|r+\\{big\_node\_size}[\\{cur\_type}]-2$;\6
+\~ \1\&{loop}\ \&{begin} \37$\\{add\_or\_subtract}(\|q,\39\|r,\39\\{minus})$;\6
+\&{if} $\\{type}(\|r)\I\\{known}$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+\&{if} $\\{value}(\|r)\I0$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+\&{if} $\|r=\\{rr}$ \1\&{then}\5
+\&{goto} \37\\{done1};\2\6
+$\|q\K\|q+2$;\5
+$\|r\K\|r+2$;\6
+\&{end};\2\6
+\4\\{done1}: \37$\\{take\_part}(\\{x\_part}+\\{half}(\|r-\\{value}(\\{cur%
+\_exp})))$;\6
+\&{end}\par
+\U936.\fi
+
+\M940. Here we use the sneaky fact that $\\{and\_op}-\\{false\_code}=\\{or%
+\_op}-\\{true\_code}$.
+
+\Y\P$\4\X936:Additional cases of binary operators\X\mathrel{+}\S$\6
+\4$\\{and\_op},\39\\{or\_op}$: \37\&{if} $(\\{type}(\|p)\I\\{boolean\_type})\V(%
+\\{cur\_type}\I\\{boolean\_type})$ \1\&{then}\5
+$\\{bad\_binary}(\|p,\39\|c)$\6
+\4\&{else} \&{if} $\\{value}(\|p)=\|c+\\{false\_code}-\\{and\_op}$ \1\&{then}\5
+$\\{cur\_exp}\K\\{value}(\|p)$;\2\2\par
+\fi
+
+\M941. \P$\X936:Additional cases of binary operators\X\mathrel{+}\S$\6
+\4\\{times}: \37\&{if} $(\\{cur\_type}<\\{pair\_type})\V(\\{type}(\|p)<\\{pair%
+\_type})$ \1\&{then}\5
+$\\{bad\_binary}(\|p,\39\\{times})$\6
+\4\&{else} \&{if} $(\\{cur\_type}=\\{known})\V(\\{type}(\|p)=\\{known})$ \1%
+\&{then}\5
+\X942:Multiply when at least one operand is known\X\6
+\4\&{else} \&{if} $(\\{nice\_pair}(\|p,\39\\{type}(\|p))\W(\\{cur\_type}>%
+\\{pair\_type}))\V(\\{nice\_pair}(\\{cur\_exp},\39\\{cur\_type})\W(\\{type}(%
+\|p)>\\{pair\_type}))$ \1\&{then}\6
+\&{begin} \37$\\{hard\_times}(\|p)$;\5
+\&{return};\6
+\&{end}\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\\{times})$;\2\2\2\par
+\fi
+
+\M942. \P$\X942:Multiply when at least one operand is known\X\S$\6
+\&{begin} \37\&{if} $\\{type}(\|p)=\\{known}$ \1\&{then}\6
+\&{begin} \37$\|v\K\\{value}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|v\K\\{cur\_exp}$;\5
+$\\{unstash\_cur\_exp}(\|p)$;\6
+\&{end};\2\6
+\&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\5
+$\\{cur\_exp}\K\\{take\_scaled}(\\{cur\_exp},\39\|v)$\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{value}(\\{cur\_exp})$;\5
+$\\{dep\_mult}(\\{x\_part\_loc}(\|p),\39\|v,\39\\{true})$;\5
+$\\{dep\_mult}(\\{y\_part\_loc}(\|p),\39\|v,\39\\{true})$;\6
+\&{end}\6
+\4\&{else} $\\{dep\_mult}(\\{null},\39\|v,\39\\{true})$;\2\2\6
+\&{return};\6
+\&{end}\par
+\U941.\fi
+
+\M943. \P$\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{dep\_mult}(\|p:\\{pointer};\,\35\|v:\\{integer};\,%
+\35\\{v\_is\_scaled}:\\{boolean})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the dependency list being multiplied by %
+\|v}\6
+$\|s,\39\|t$: \37\\{small\_number};\C{its type, before and after}\2\6
+\&{begin} \37\&{if} $\|p=\\{null}$ \1\&{then}\5
+$\|q\K\\{cur\_exp}$\6
+\4\&{else} \&{if} $\\{type}(\|p)\I\\{known}$ \1\&{then}\5
+$\|q\K\|p$\6
+\4\&{else} \&{begin} \37\&{if} $\\{v\_is\_scaled}$ \1\&{then}\5
+$\\{value}(\|p)\K\\{take\_scaled}(\\{value}(\|p),\39\|v)$\6
+\4\&{else} $\\{value}(\|p)\K\\{take\_fraction}(\\{value}(\|p),\39\|v)$;\2\6
+\&{return};\6
+\&{end};\2\2\6
+$\|t\K\\{type}(\|q)$;\5
+$\|q\K\\{dep\_list}(\|q)$;\5
+$\|s\K\|t$;\6
+\&{if} $\|t=\\{dependent}$ \1\&{then}\6
+\&{if} $\\{v\_is\_scaled}$ \1\&{then}\6
+\&{if} $\\{ab\_vs\_cd}(\\{max\_coef}(\|q),\39\\{abs}(\|v),\39\\{coef\_bound}-1,%
+\39\\{unity})\G0$ \1\&{then}\5
+$\|t\K\\{proto\_dependent}$;\2\2\2\6
+$\|q\K\\{p\_times\_v}(\|q,\39\|v,\39\|s,\39\|t,\39\\{v\_is\_scaled})$;\5
+$\\{dep\_finish}(\|q,\39\|p,\39\|t)$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M944. Here is a routine that is similar to \\{times}; but it is invoked only
+internally, when \|v is a \\{fraction} whose magnitude is at most~1,
+and when $\\{cur\_type}\G\\{pair\_type}$.
+
+\Y\P\4\&{procedure}\1\ \37$\\{frac\_mult}(\|n,\39\|d:\\{scaled})$;%
+\C{multiplies \\{cur\_exp} by $\|n/\|d$}\6
+\4\&{var} \37\|p: \37\\{pointer};\C{a pair node}\6
+\\{old\_exp}: \37\\{pointer};\C{a capsule to recycle}\6
+\|v: \37\\{fraction};\C{$\|n/\|d$}\2\6
+\&{begin} \37\&{if} $\\{internal}[\\{tracing\_commands}]>\\{two}$ \1\&{then}\5
+\X945:Trace the fraction multiplication\X;\2\6
+\&{case} $\\{cur\_type}$ \1\&{of}\6
+\4$\\{transform\_type},\39\\{pair\_type}$: \37$\\{old\_exp}\K\\{tarnished}(%
+\\{cur\_exp})$;\6
+\4\\{independent}: \37$\\{old\_exp}\K\\{void}$;\6
+\4\&{othercases} \37$\\{old\_exp}\K\\{null}$\2\6
+\&{endcases};\6
+\&{if} $\\{old\_exp}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{old\_exp}\K\\{cur\_exp}$;\5
+$\\{make\_exp\_copy}(\\{old\_exp})$;\6
+\&{end};\2\6
+$\|v\K\\{make\_fraction}(\|n,\39\|d)$;\6
+\&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\5
+$\\{cur\_exp}\K\\{take\_fraction}(\\{cur\_exp},\39\|v)$\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{value}(\\{cur\_exp})$;\5
+$\\{dep\_mult}(\\{x\_part\_loc}(\|p),\39\|v,\39\\{false})$;\5
+$\\{dep\_mult}(\\{y\_part\_loc}(\|p),\39\|v,\39\\{false})$;\6
+\&{end}\6
+\4\&{else} $\\{dep\_mult}(\\{null},\39\|v,\39\\{false})$;\2\2\6
+\&{if} $\\{old\_exp}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{recycle\_value}(\\{old\_exp})$;\5
+$\\{free\_node}(\\{old\_exp},\39\\{value\_node\_size})$;\6
+\&{end}\2\6
+\&{end};\par
+\fi
+
+\M945. \P$\X945:Trace the fraction multiplication\X\S$\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\{("})$;\5
+$\\{print\_scaled}(\|n)$;\5
+$\\{print\_char}(\.{"/"})$;\5
+$\\{print\_scaled}(\|d)$;\5
+$\\{print}(\.{")*("})$;\5
+$\\{print\_exp}(\\{null},\390)$;\5
+$\\{print}(\.{")\}"})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\par
+\U944.\fi
+
+\M946. The \\{hard\_times} routine multiplies a nice pair by a dependency list.
+
+\Y\P$\4\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{hard\_times}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{a copy of the dependent variable \|p}\6
+\|r: \37\\{pointer};\C{the big node for the nice pair}\6
+$\|u,\39\|v$: \37\\{scaled};\C{the known values of the nice pair}\2\6
+\&{begin} \37\&{if} $\\{type}(\|p)=\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\|q\K\\{stash\_cur\_exp}$;\5
+$\\{unstash\_cur\_exp}(\|p)$;\5
+$\|p\K\|q$;\6
+\&{end};\C{now $\\{cur\_type}=\\{pair\_type}$}\2\6
+$\|r\K\\{value}(\\{cur\_exp})$;\5
+$\|u\K\\{value}(\\{x\_part\_loc}(\|r))$;\5
+$\|v\K\\{value}(\\{y\_part\_loc}(\|r))$;\5
+\X947:Move the dependent variable \|p into both parts of the pair node \|r\X;\6
+$\\{dep\_mult}(\\{x\_part\_loc}(\|r),\39\|u,\39\\{true})$;\5
+$\\{dep\_mult}(\\{y\_part\_loc}(\|r),\39\|v,\39\\{true})$;\6
+\&{end};\par
+\fi
+
+\M947. \P$\X947:Move the dependent variable \|p into both parts of the pair
+node \|r\X\S$\6
+$\\{type}(\\{y\_part\_loc}(\|r))\K\\{type}(\|p)$;\5
+$\\{new\_dep}(\\{y\_part\_loc}(\|r),\39\\{copy\_dep\_list}(\\{dep\_list}(%
+\|p)))$;\6
+$\\{type}(\\{x\_part\_loc}(\|r))\K\\{type}(\|p)$;\5
+$\\{mem}[\\{value\_loc}(\\{x\_part\_loc}(\|r))]\K\\{mem}[\\{value\_loc}(\|p)]$;%
+\5
+$\\{link}(\\{prev\_dep}(\|p))\K\\{x\_part\_loc}(\|r)$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$\par
+\U946.\fi
+
+\M948. \P$\X936:Additional cases of binary operators\X\mathrel{+}\S$\6
+\4\\{over}: \37\&{if} $(\\{cur\_type}\I\\{known})\V(\\{type}(\|p)<\\{pair%
+\_type})$ \1\&{then}\5
+$\\{bad\_binary}(\|p,\39\\{over})$\6
+\4\&{else} \&{begin} \37$\|v\K\\{cur\_exp}$;\5
+$\\{unstash\_cur\_exp}(\|p)$;\6
+\&{if} $\|v=0$ \1\&{then}\5
+\X950:Squeal about division by zero\X\6
+\4\&{else} \&{begin} \37\&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\5
+$\\{cur\_exp}\K\\{make\_scaled}(\\{cur\_exp},\39\|v)$\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{value}(\\{cur\_exp})$;\5
+$\\{dep\_div}(\\{x\_part\_loc}(\|p),\39\|v)$;\5
+$\\{dep\_div}(\\{y\_part\_loc}(\|p),\39\|v)$;\6
+\&{end}\6
+\4\&{else} $\\{dep\_div}(\\{null},\39\|v)$;\2\2\6
+\&{end};\2\6
+\&{return};\6
+\&{end};\2\par
+\fi
+
+\M949. \P$\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{dep\_div}(\|p:\\{pointer};\,\35\|v:\\{scaled})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|q: \37\\{pointer};\C{the dependency list being divided by \|v}\6
+$\|s,\39\|t$: \37\\{small\_number};\C{its type, before and after}\2\6
+\&{begin} \37\&{if} $\|p=\\{null}$ \1\&{then}\5
+$\|q\K\\{cur\_exp}$\6
+\4\&{else} \&{if} $\\{type}(\|p)\I\\{known}$ \1\&{then}\5
+$\|q\K\|p$\6
+\4\&{else} \&{begin} \37$\\{value}(\|p)\K\\{make\_scaled}(\\{value}(\|p),\39%
+\|v)$;\5
+\&{return};\6
+\&{end};\2\2\6
+$\|t\K\\{type}(\|q)$;\5
+$\|q\K\\{dep\_list}(\|q)$;\5
+$\|s\K\|t$;\6
+\&{if} $\|t=\\{dependent}$ \1\&{then}\6
+\&{if} $\\{ab\_vs\_cd}(\\{max\_coef}(\|q),\39\\{unity},\39\\{coef\_bound}-1,\39%
+\\{abs}(\|v))\G0$ \1\&{then}\5
+$\|t\K\\{proto\_dependent}$;\2\2\6
+$\|q\K\\{p\_over\_v}(\|q,\39\|v,\39\|s,\39\|t)$;\5
+$\\{dep\_finish}(\|q,\39\|p,\39\|t)$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M950. \P$\X950:Squeal about division by zero\X\S$\6
+\&{begin} \37$\\{exp\_err}(\.{"Division\ by\ zero"})$;\5
+$\\{help2}(\.{"You\'re\ trying\ to\ divide\ the\ quantity\ shown\ above\ the\
+error"})$\6
+$(\.{"message\ by\ zero.\ I\'m\ going\ to\ divide\ it\ by\ one\ instead."})$;\5
+\\{put\_get\_error};\6
+\&{end}\par
+\U948.\fi
+
+\M951. \P$\X936:Additional cases of binary operators\X\mathrel{+}\S$\6
+\4$\\{pythag\_add},\39\\{pythag\_sub}$: \37\&{if} $(\\{cur\_type}=\\{known})\W(%
+\\{type}(\|p)=\\{known})$ \1\&{then}\6
+\&{if} $\|c=\\{pythag\_add}$ \1\&{then}\5
+$\\{cur\_exp}\K\\{pyth\_add}(\\{value}(\|p),\39\\{cur\_exp})$\6
+\4\&{else} $\\{cur\_exp}\K\\{pyth\_sub}(\\{value}(\|p),\39\\{cur\_exp})$\2\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\|c)$;\2\par
+\fi
+
+\M952. The next few sections of the program deal with affine transformations
+of coordinate data.
+
+\Y\P$\4\X936:Additional cases of binary operators\X\mathrel{+}\S$\6
+\4$\\{rotated\_by},\39\\{slanted\_by},\39\\{scaled\_by},\39\\{shifted\_by},\39%
+\\{transformed\_by},\39\\{x\_scaled},\39\\{y\_scaled},\39\\{z\_scaled}$: \37%
+\hbox{}\6
+\&{if} $(\\{type}(\|p)=\\{path\_type})\V(\\{type}(\|p)=\\{future\_pen})\V(%
+\\{type}(\|p)=\\{pen\_type})$ \1\&{then}\6
+\&{begin} \37$\\{path\_trans}(\|p,\39\|c)$;\5
+\&{return};\6
+\&{end}\6
+\4\&{else} \&{if} $(\\{type}(\|p)=\\{pair\_type})\V(\\{type}(\|p)=\\{transform%
+\_type})$ \1\&{then}\5
+$\\{big\_trans}(\|p,\39\|c)$\6
+\4\&{else} \&{if} $\\{type}(\|p)=\\{picture\_type}$ \1\&{then}\6
+\&{begin} \37$\\{edges\_trans}(\|p,\39\|c)$;\5
+\&{return};\6
+\&{end}\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\|c)$;\2\2\2\par
+\fi
+
+\M953. Let \|c be one of the eight transform operators. The procedure call
+$\\{set\_up\_trans}(\|c)$ first changes \\{cur\_exp} to a transform that
+corresponds to
+\|c and the original value of \\{cur\_exp}. (In particular, \\{cur\_exp}
+doesn't
+change at all if $\|c=\\{transformed\_by}$.)
+
+Then, if all components of the resulting transform are \\{known}, they are
+moved to the global variables \\{txx}, \\{txy}, \\{tyx}, \\{tyy}, \\{tx}, %
+\\{ty};
+and \\{cur\_exp} is changed to the known value zero.
+
+\Y\P$\4\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{set\_up\_trans}(\|c:\\{quarterword})$;\6
+\4\&{label} \37$\\{done},\39\\{exit}$;\6
+\4\&{var} \37$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{list manipulation
+registers}\2\6
+\&{begin} \37\&{if} $(\|c\I\\{transformed\_by})\V(\\{cur\_type}\I\\{transform%
+\_type})$ \1\&{then}\5
+\X955:Put the current transform into \\{cur\_exp}\X;\2\6
+\X956:If the current transform is entirely known, stash it in global variables;
+otherwise \&{return}\X;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M954. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{txx},\39\\{txy},\39\\{tyx},\39\\{tyy},\39\\{tx},\39\\{ty}$: \37%
+\\{scaled};\C{current transform coefficients}\par
+\fi
+
+\M955. \P$\X955:Put the current transform into \\{cur\_exp}\X\S$\6
+\&{begin} \37$\|p\K\\{stash\_cur\_exp}$;\5
+$\\{cur\_exp}\K\\{id\_transform}$;\5
+$\\{cur\_type}\K\\{transform\_type}$;\5
+$\|q\K\\{value}(\\{cur\_exp})$;\6
+\&{case} $\|c$ \1\&{of}\6
+\X957:For each of the eight cases, change the relevant fields of \\{cur\_exp}
+and \&{goto} \\{done}; but do nothing if capsule \|p doesn't have the
+appropriate type\X\2\6
+\&{end};\C{there are no other cases}\6
+$\\{disp\_err}(\|p,\39\.{"Improper\ transformation\ argument"})$;\5
+$\\{help3}(\.{"The\ expression\ shown\ above\ has\ the\ wrong\ type,"})$\6
+$(\.{"so\ I\ can\'t\ transform\ anything\ using\ it."})$\6
+$(\.{"Proceed,\ and\ I\'ll\ omit\ the\ transformation."})$;\5
+\\{put\_get\_error};\6
+\4\\{done}: \37$\\{recycle\_value}(\|p)$;\5
+$\\{free\_node}(\|p,\39\\{value\_node\_size})$;\6
+\&{end}\par
+\U953.\fi
+
+\M956. \P$\X956:If the current transform is entirely known, stash it in global
+variables; otherwise \&{return}\X\S$\6
+$\|q\K\\{value}(\\{cur\_exp})$;\5
+$\|r\K\|q+\\{transform\_node\_size}$;\6
+\1\&{repeat} \37$\|r\K\|r-2$;\6
+\&{if} $\\{type}(\|r)\I\\{known}$ \1\&{then}\5
+\&{return};\2\6
+\4\&{until}\5
+$\|r=\|q$;\2\6
+$\\{txx}\K\\{value}(\\{xx\_part\_loc}(\|q))$;\5
+$\\{txy}\K\\{value}(\\{xy\_part\_loc}(\|q))$;\5
+$\\{tyx}\K\\{value}(\\{yx\_part\_loc}(\|q))$;\5
+$\\{tyy}\K\\{value}(\\{yy\_part\_loc}(\|q))$;\5
+$\\{tx}\K\\{value}(\\{x\_part\_loc}(\|q))$;\5
+$\\{ty}\K\\{value}(\\{y\_part\_loc}(\|q))$;\5
+$\\{flush\_cur\_exp}(0)$\par
+\U953.\fi
+
+\M957. \P$\X957:For each of the eight cases, change the relevant fields of %
+\\{cur\_exp} and \&{goto} \\{done}; but do nothing if capsule \|p doesn't have
+the appropriate type\X\S$\6
+\4\\{rotated\_by}: \37\&{if} $\\{type}(\|p)=\\{known}$ \1\&{then}\5
+\X958:Install sines and cosines, then \&{goto} \\{done}\X;\2\6
+\4\\{slanted\_by}: \37\&{if} $\\{type}(\|p)>\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\\{install}(\\{xy\_part\_loc}(\|q),\39\|p)$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+\4\\{scaled\_by}: \37\&{if} $\\{type}(\|p)>\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\\{install}(\\{xx\_part\_loc}(\|q),\39\|p)$;\5
+$\\{install}(\\{yy\_part\_loc}(\|q),\39\|p)$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+\4\\{shifted\_by}: \37\&{if} $\\{type}(\|p)=\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\|r\K\\{value}(\|p)$;\5
+$\\{install}(\\{x\_part\_loc}(\|q),\39\\{x\_part\_loc}(\|r))$;\5
+$\\{install}(\\{y\_part\_loc}(\|q),\39\\{y\_part\_loc}(\|r))$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+\4\\{x\_scaled}: \37\&{if} $\\{type}(\|p)>\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\\{install}(\\{xx\_part\_loc}(\|q),\39\|p)$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+\4\\{y\_scaled}: \37\&{if} $\\{type}(\|p)>\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\\{install}(\\{yy\_part\_loc}(\|q),\39\|p)$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+\4\\{z\_scaled}: \37\&{if} $\\{type}(\|p)=\\{pair\_type}$ \1\&{then}\5
+\X959:Install a complex multiplier, then \&{goto} \\{done}\X;\2\6
+\4\\{transformed\_by}: \37\\{do\_nothing};\par
+\U955.\fi
+
+\M958. \P$\X958:Install sines and cosines, then \&{goto} \\{done}\X\S$\6
+\&{begin} \37$\\{n\_sin\_cos}((\\{value}(\|p)\mathbin{\&{mod}}\\{three\_sixty%
+\_units})\ast16)$;\5
+$\\{value}(\\{xx\_part\_loc}(\|q))\K\\{round\_fraction}(\\{n\_cos})$;\5
+$\\{value}(\\{yx\_part\_loc}(\|q))\K\\{round\_fraction}(\\{n\_sin})$;\5
+$\\{value}(\\{xy\_part\_loc}(\|q))\K-\\{value}(\\{yx\_part\_loc}(\|q))$;\5
+$\\{value}(\\{yy\_part\_loc}(\|q))\K\\{value}(\\{xx\_part\_loc}(\|q))$;\5
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U957.\fi
+
+\M959. \P$\X959:Install a complex multiplier, then \&{goto} \\{done}\X\S$\6
+\&{begin} \37$\|r\K\\{value}(\|p)$;\5
+$\\{install}(\\{xx\_part\_loc}(\|q),\39\\{x\_part\_loc}(\|r))$;\5
+$\\{install}(\\{yy\_part\_loc}(\|q),\39\\{x\_part\_loc}(\|r))$;\5
+$\\{install}(\\{yx\_part\_loc}(\|q),\39\\{y\_part\_loc}(\|r))$;\6
+\&{if} $\\{type}(\\{y\_part\_loc}(\|r))=\\{known}$ \1\&{then}\5
+$\\{negate}(\\{value}(\\{y\_part\_loc}(\|r)))$\6
+\4\&{else} $\\{negate\_dep\_list}(\\{dep\_list}(\\{y\_part\_loc}(\|r)))$;\2\6
+$\\{install}(\\{xy\_part\_loc}(\|q),\39\\{y\_part\_loc}(\|r))$;\5
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U957.\fi
+
+\M960. Procedure \\{set\_up\_known\_trans} is like \\{set\_up\_trans}, but it
+insists that the transformation be entirely known.
+
+\Y\P$\4\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{set\_up\_known\_trans}(\|c:\\{quarterword})$;\2\6
+\&{begin} \37$\\{set\_up\_trans}(\|c)$;\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Transform\ components\ aren\'t\ all\ known"})$;\5
+$\\{help3}(\.{"I\'m\ unable\ to\ apply\ a\ partially\ specified\
+transformation"})$\6
+$(\.{"except\ to\ a\ fully\ known\ pair\ or\ transform."})$\6
+$(\.{"Proceed,\ and\ I\'ll\ omit\ the\ transformation."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\5
+$\\{txx}\K\\{unity}$;\5
+$\\{txy}\K0$;\5
+$\\{tyx}\K0$;\5
+$\\{tyy}\K\\{unity}$;\5
+$\\{tx}\K0$;\5
+$\\{ty}\K0$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M961. Here's a procedure that applies the transform $\\{txx}\to\\{ty}$ to a
+pair of
+coordinates in locations \|p and~\|q.
+
+\Y\P$\4\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{trans}(\|p,\39\|q:\\{pointer})$;\6
+\4\&{var} \37\|v: \37\\{scaled};\C{the new \|x value}\2\6
+\&{begin} \37$\|v\K\\{take\_scaled}(\\{mem}[\|p].\\{sc},\39\\{txx})+\\{take%
+\_scaled}(\\{mem}[\|q].\\{sc},\39\\{txy})+\\{tx}$;\5
+$\\{mem}[\|q].\\{sc}\K\\{take\_scaled}(\\{mem}[\|p].\\{sc},\39\\{tyx})+\\{take%
+\_scaled}(\\{mem}[\|q].\\{sc},\39\\{tyy})+\\{ty}$;\5
+$\\{mem}[\|p].\\{sc}\K\|v$;\6
+\&{end};\par
+\fi
+
+\M962. The simplest transformation procedure applies a transform to all
+coordinates of a path. The \\{null\_pen} remains unchanged if it isn't
+being shifted.
+
+\Y\P$\4\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{path\_trans}(\|p:\\{pointer};\,\35\|c:%
+\\{quarterword})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|q: \37\\{pointer};\C{list traverser}\2\6
+\&{begin} \37$\\{set\_up\_known\_trans}(\|c)$;\5
+$\\{unstash\_cur\_exp}(\|p)$;\6
+\&{if} $\\{cur\_type}=\\{pen\_type}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{max\_offset}(\\{cur\_exp})=0$ \1\&{then}\6
+\&{if} $\\{tx}=0$ \1\&{then}\6
+\&{if} $\\{ty}=0$ \1\&{then}\5
+\&{return};\2\2\2\6
+$\\{flush\_cur\_exp}(\\{make\_path}(\\{cur\_exp}))$;\5
+$\\{cur\_type}\K\\{future\_pen}$;\6
+\&{end};\2\6
+$\|q\K\\{cur\_exp}$;\6
+\1\&{repeat} \37\&{if} $\\{left\_type}(\|q)\I\\{endpoint}$ \1\&{then}\5
+$\\{trans}(\|q+3,\39\|q+4)$;\C{that's \\{left\_x} and \\{left\_y}}\2\6
+$\\{trans}(\|q+1,\39\|q+2)$;\C{that's \\{x\_coord} and \\{y\_coord}}\6
+\&{if} $\\{right\_type}(\|q)\I\\{endpoint}$ \1\&{then}\5
+$\\{trans}(\|q+5,\39\|q+6)$;\C{that's \\{right\_x} and \\{right\_y}}\2\6
+$\|q\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\|q=\\{cur\_exp}$;\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M963. The next simplest transformation procedure applies to edges.
+It is simple primarily because \MF\ doesn't allow very general
+transformations to be made, and because the tricky subroutines
+for edge transformation have already been written.
+
+\Y\P$\4\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{edges\_trans}(\|p:\\{pointer};\,\35\|c:%
+\\{quarterword})$;\6
+\4\&{label} \37\\{exit};\2\6
+\&{begin} \37$\\{set\_up\_known\_trans}(\|c)$;\5
+$\\{unstash\_cur\_exp}(\|p)$;\5
+$\\{cur\_edges}\K\\{cur\_exp}$;\6
+\&{if} $\\{empty\_edges}(\\{cur\_edges})$ \1\&{then}\5
+\&{return};\C{the empty set is easy to transform}\2\6
+\&{if} $\\{txx}=0$ \1\&{then}\6
+\&{if} $\\{tyy}=0$ \1\&{then}\6
+\&{if} $\\{txy}\mathbin{\&{mod}}\\{unity}=0$ \1\&{then}\6
+\&{if} $\\{tyx}\mathbin{\&{mod}}\\{unity}=0$ \1\&{then}\6
+\&{begin} \37\\{xy\_swap\_edges};\5
+$\\{txx}\K\\{txy}$;\5
+$\\{tyy}\K\\{tyx}$;\5
+$\\{txy}\K0$;\5
+$\\{tyx}\K0$;\6
+\&{if} $\\{empty\_edges}(\\{cur\_edges})$ \1\&{then}\5
+\&{return};\2\6
+\&{end};\2\2\2\2\6
+\&{if} $\\{txy}=0$ \1\&{then}\6
+\&{if} $\\{tyx}=0$ \1\&{then}\6
+\&{if} $\\{txx}\mathbin{\&{mod}}\\{unity}=0$ \1\&{then}\6
+\&{if} $\\{tyy}\mathbin{\&{mod}}\\{unity}=0$ \1\&{then}\5
+\X964:Scale the edges, shift them, and \&{return}\X;\2\2\2\2\6
+$\\{print\_err}(\.{"That\ transformation\ is\ too\ hard"})$;\5
+$\\{help3}(\.{"I\ can\ apply\ complicated\ transformations\ to\ paths,"})$\6
+$(\.{"but\ I\ can\ only\ do\ integer\ operations\ on\ pictures."})$\6
+$(\.{"Proceed,\ and\ I\'ll\ omit\ the\ transformation."})$;\5
+\\{put\_get\_error};\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M964. \P$\X964:Scale the edges, shift them, and \&{return}\X\S$\6
+\&{begin} \37\&{if} $(\\{txx}=0)\V(\\{tyy}=0)$ \1\&{then}\6
+\&{begin} \37$\\{toss\_edges}(\\{cur\_edges})$;\5
+$\\{cur\_exp}\K\\{get\_node}(\\{edge\_header\_size})$;\5
+$\\{init\_edges}(\\{cur\_exp})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{txx}<0$ \1\&{then}\6
+\&{begin} \37\\{x\_reflect\_edges};\5
+$\\{txx}\K-\\{txx}$;\6
+\&{end};\2\6
+\&{if} $\\{tyy}<0$ \1\&{then}\6
+\&{begin} \37\\{y\_reflect\_edges};\5
+$\\{tyy}\K-\\{tyy}$;\6
+\&{end};\2\6
+\&{if} $\\{txx}\I\\{unity}$ \1\&{then}\5
+$\\{x\_scale\_edges}(\\{txx}\mathbin{\&{div}}\\{unity})$;\2\6
+\&{if} $\\{tyy}\I\\{unity}$ \1\&{then}\5
+$\\{y\_scale\_edges}(\\{tyy}\mathbin{\&{div}}\\{unity})$;\2\6
+\X965:Shift the edges by $(\\{tx},\\{ty})$, rounded\X;\6
+\&{end};\2\6
+\&{return};\6
+\&{end}\par
+\U963.\fi
+
+\M965. \P$\X965:Shift the edges by $(\\{tx},\\{ty})$, rounded\X\S$\6
+$\\{tx}\K\\{round\_unscaled}(\\{tx})$;\5
+$\\{ty}\K\\{round\_unscaled}(\\{ty})$;\6
+\&{if} $(\\{m\_min}(\\{cur\_edges})+\\{tx}\L0)\V(\\{m\_max}(\\{cur\_edges})+%
+\\{tx}\G8192)\V\30(\\{n\_min}(\\{cur\_edges})+\\{ty}\L0)\V(\\{n\_max}(\\{cur%
+\_edges})+\\{ty}\G8191)\V\30(\\{abs}(\\{tx})\G4096)\V(\\{abs}(\\{ty})\G4096)$ %
+\1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Too\ far\ to\ shift"})$;\5
+$\\{help3}(\.{"I\ can\'t\ shift\ the\ picture\ as\ requested---it\ would"})$\6
+$(\.{"make\ some\ coordinates\ too\ large\ or\ too\ small."})$\6
+$(\.{"Proceed,\ and\ I\'ll\ omit\ the\ transformation."})$;\5
+\\{put\_get\_error};\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $\\{tx}\I0$ \1\&{then}\6
+\&{begin} \37\&{if} $\R\\{valid\_range}(\\{m\_offset}(\\{cur\_edges})-\\{tx})$ %
+\1\&{then}\5
+\\{fix\_offset};\2\6
+$\\{m\_min}(\\{cur\_edges})\K\\{m\_min}(\\{cur\_edges})+\\{tx}$;\5
+$\\{m\_max}(\\{cur\_edges})\K\\{m\_max}(\\{cur\_edges})+\\{tx}$;\5
+$\\{m\_offset}(\\{cur\_edges})\K\\{m\_offset}(\\{cur\_edges})-\\{tx}$;\5
+$\\{last\_window\_time}(\\{cur\_edges})\K0$;\6
+\&{end};\2\6
+\&{if} $\\{ty}\I0$ \1\&{then}\6
+\&{begin} \37$\\{n\_min}(\\{cur\_edges})\K\\{n\_min}(\\{cur\_edges})+\\{ty}$;\5
+$\\{n\_max}(\\{cur\_edges})\K\\{n\_max}(\\{cur\_edges})+\\{ty}$;\5
+$\\{n\_pos}(\\{cur\_edges})\K\\{n\_pos}(\\{cur\_edges})+\\{ty}$;\5
+$\\{last\_window\_time}(\\{cur\_edges})\K0$;\6
+\&{end};\2\6
+\&{end}\2\par
+\U964.\fi
+
+\M966. The hard cases of transformation occur when big nodes are involved,
+and when some of their components are unknown.
+
+\Y\P$\4\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\hbox{\4}\X968:Declare subroutines needed by \\{big\_trans}\X\6
+\4\&{procedure}\1\ \37$\\{big\_trans}(\|p:\\{pointer};\,\35\|c:%
+\\{quarterword})$;\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37$\|q,\39\|r,\39\\{pp},\39\\{qq}$: \37\\{pointer};\C{list
+manipulation registers}\6
+\|s: \37\\{small\_number};\C{size of a big node}\2\6
+\&{begin} \37$\|s\K\\{big\_node\_size}[\\{type}(\|p)]$;\5
+$\|q\K\\{value}(\|p)$;\5
+$\|r\K\|q+\|s$;\6
+\1\&{repeat} \37$\|r\K\|r-2$;\6
+\&{if} $\\{type}(\|r)\I\\{known}$ \1\&{then}\5
+\X967:Transform an unknown big node and \&{return}\X;\2\6
+\4\&{until}\5
+$\|r=\|q$;\2\6
+\X970:Transform a known big node\X;\6
+\4\\{exit}: \37\&{end};\C{node \|p will now be recycled by \\{do\_binary}}\par
+\fi
+
+\M967. \P$\X967:Transform an unknown big node and \&{return}\X\S$\6
+\&{begin} \37$\\{set\_up\_known\_trans}(\|c)$;\5
+$\\{make\_exp\_copy}(\|p)$;\5
+$\|r\K\\{value}(\\{cur\_exp})$;\6
+\&{if} $\\{cur\_type}=\\{transform\_type}$ \1\&{then}\6
+\&{begin} \37$\\{bilin1}(\\{yy\_part\_loc}(\|r),\39\\{tyy},\39\\{xy\_part%
+\_loc}(\|q),\39\\{tyx},\390)$;\5
+$\\{bilin1}(\\{yx\_part\_loc}(\|r),\39\\{tyy},\39\\{xx\_part\_loc}(\|q),\39%
+\\{tyx},\390)$;\5
+$\\{bilin1}(\\{xy\_part\_loc}(\|r),\39\\{txx},\39\\{yy\_part\_loc}(\|q),\39%
+\\{txy},\390)$;\5
+$\\{bilin1}(\\{xx\_part\_loc}(\|r),\39\\{txx},\39\\{yx\_part\_loc}(\|q),\39%
+\\{txy},\390)$;\6
+\&{end};\2\6
+$\\{bilin1}(\\{y\_part\_loc}(\|r),\39\\{tyy},\39\\{x\_part\_loc}(\|q),\39%
+\\{tyx},\39\\{ty})$;\5
+$\\{bilin1}(\\{x\_part\_loc}(\|r),\39\\{txx},\39\\{y\_part\_loc}(\|q),\39%
+\\{txy},\39\\{tx})$;\5
+\&{return};\6
+\&{end}\par
+\U966.\fi
+
+\M968. Let \|p point to a two-word value field inside a big node of \\{cur%
+\_exp},
+and let \|q point to a another value field. The \\{bilin1} procedure
+replaces \|p by $p\cdot t+q\cdot u+\delta$.
+
+\Y\P$\4\X968:Declare subroutines needed by \\{big\_trans}\X\S$\6
+\4\&{procedure}\1\ \37$\\{bilin1}(\|p:\\{pointer};\,\35\|t:\\{scaled};\,\35%
+\|q:\\{pointer};\,\35\|u,\39\\{delta}:\\{scaled})$;\6
+\4\&{var} \37\|r: \37\\{pointer};\C{list traverser}\2\6
+\&{begin} \37\&{if} $\|t\I\\{unity}$ \1\&{then}\5
+$\\{dep\_mult}(\|p,\39\|t,\39\\{true})$;\2\6
+\&{if} $\|u\I0$ \1\&{then}\6
+\&{if} $\\{type}(\|q)=\\{known}$ \1\&{then}\5
+$\\{delta}\K\\{delta}+\\{take\_scaled}(\\{value}(\|q),\39\|u)$\6
+\4\&{else} \&{begin} \37\X969:Ensure that $\\{type}(\|p)=\\{proto\_dependent}$%
+\X;\6
+$\\{dep\_list}(\|p)\K\\{p\_plus\_fq}(\\{dep\_list}(\|p),\39\|u,\39\\{dep%
+\_list}(\|q),\39\\{proto\_dependent},\39\\{type}(\|q))$;\6
+\&{end};\2\2\6
+\&{if} $\\{type}(\|p)=\\{known}$ \1\&{then}\5
+$\\{value}(\|p)\K\\{value}(\|p)+\\{delta}$\6
+\4\&{else} \&{begin} \37$\|r\K\\{dep\_list}(\|p)$;\6
+\&{while} $\\{info}(\|r)\I\\{null}$ \1\&{do}\5
+$\|r\K\\{link}(\|r)$;\2\6
+$\\{delta}\K\\{value}(\|r)+\\{delta}$;\6
+\&{if} $\|r\I\\{dep\_list}(\|p)$ \1\&{then}\5
+$\\{value}(\|r)\K\\{delta}$\6
+\4\&{else} \&{begin} \37$\\{recycle\_value}(\|p)$;\5
+$\\{type}(\|p)\K\\{known}$;\5
+$\\{value}(\|p)\K\\{delta}$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{if} $\\{fix\_needed}$ \1\&{then}\5
+\\{fix\_dependencies};\2\6
+\&{end};\par
+\As971, 972\ETs974.
+\U966.\fi
+
+\M969. \P$\X969:Ensure that $\\{type}(\|p)=\\{proto\_dependent}$\X\S$\6
+\&{if} $\\{type}(\|p)\I\\{proto\_dependent}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{type}(\|p)=\\{known}$ \1\&{then}\5
+$\\{new\_dep}(\|p,\39\\{const\_dependency}(\\{value}(\|p)))$\6
+\4\&{else} $\\{dep\_list}(\|p)\K\\{p\_times\_v}(\\{dep\_list}(\|p),\39%
+\\{unity},\39\\{dependent},\39\\{proto\_dependent},\39\\{true})$;\2\6
+$\\{type}(\|p)\K\\{proto\_dependent}$;\6
+\&{end}\2\par
+\U968.\fi
+
+\M970. \P$\X970:Transform a known big node\X\S$\6
+$\\{set\_up\_trans}(\|c)$;\6
+\&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\5
+\X973:Transform known by known\X\6
+\4\&{else} \&{begin} \37$\\{pp}\K\\{stash\_cur\_exp}$;\5
+$\\{qq}\K\\{value}(\\{pp})$;\5
+$\\{make\_exp\_copy}(\|p)$;\5
+$\|r\K\\{value}(\\{cur\_exp})$;\6
+\&{if} $\\{cur\_type}=\\{transform\_type}$ \1\&{then}\6
+\&{begin} \37$\\{bilin2}(\\{yy\_part\_loc}(\|r),\39\\{yy\_part\_loc}(\\{qq}),%
+\39\\{value}(\\{xy\_part\_loc}(\|q)),\39\\{yx\_part\_loc}(\\{qq}),\39%
+\\{null})$;\5
+$\\{bilin2}(\\{yx\_part\_loc}(\|r),\39\\{yy\_part\_loc}(\\{qq}),\39\\{value}(%
+\\{xx\_part\_loc}(\|q)),\39\\{yx\_part\_loc}(\\{qq}),\39\\{null})$;\5
+$\\{bilin2}(\\{xy\_part\_loc}(\|r),\39\\{xx\_part\_loc}(\\{qq}),\39\\{value}(%
+\\{yy\_part\_loc}(\|q)),\39\\{xy\_part\_loc}(\\{qq}),\39\\{null})$;\5
+$\\{bilin2}(\\{xx\_part\_loc}(\|r),\39\\{xx\_part\_loc}(\\{qq}),\39\\{value}(%
+\\{yx\_part\_loc}(\|q)),\39\\{xy\_part\_loc}(\\{qq}),\39\\{null})$;\6
+\&{end};\2\6
+$\\{bilin2}(\\{y\_part\_loc}(\|r),\39\\{yy\_part\_loc}(\\{qq}),\39\\{value}(%
+\\{x\_part\_loc}(\|q)),\39\\{yx\_part\_loc}(\\{qq}),\39\\{y\_part\_loc}(%
+\\{qq}))$;\5
+$\\{bilin2}(\\{x\_part\_loc}(\|r),\39\\{xx\_part\_loc}(\\{qq}),\39\\{value}(%
+\\{y\_part\_loc}(\|q)),\39\\{xy\_part\_loc}(\\{qq}),\39\\{x\_part\_loc}(%
+\\{qq}))$;\5
+$\\{recycle\_value}(\\{pp})$;\5
+$\\{free\_node}(\\{pp},\39\\{value\_node\_size})$;\6
+\&{end};\2\par
+\U966.\fi
+
+\M971. Let \|p be a \\{proto\_dependent} value whose dependency list ends
+at \\{dep\_final}. The following procedure adds \|v times another
+numeric quantity to~\|p.
+
+\Y\P$\4\X968:Declare subroutines needed by \\{big\_trans}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{add\_mult\_dep}(\|p:\\{pointer};\,\35\|v:\\{scaled};%
+\,\35\|r:\\{pointer})$;\2\6
+\&{begin} \37\&{if} $\\{type}(\|r)=\\{known}$ \1\&{then}\5
+$\\{value}(\\{dep\_final})\K\\{value}(\\{dep\_final})+\\{take\_scaled}(%
+\\{value}(\|r),\39\|v)$\6
+\4\&{else} \&{begin} \37$\\{dep\_list}(\|p)\K\\{p\_plus\_fq}(\\{dep\_list}(%
+\|p),\39\|v,\39\\{dep\_list}(\|r),\39\\{proto\_dependent},\39\\{type}(\|r))$;\6
+\&{if} $\\{fix\_needed}$ \1\&{then}\5
+\\{fix\_dependencies};\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M972. The \\{bilin2} procedure is something like \\{bilin1}, but with known
+and unknown quantities reversed. Parameter \|p points to a value field
+within the big node for \\{cur\_exp}; and $\\{type}(\|p)=\\{known}$. Parameters
+\|t and~\|u point to value fields elsewhere; so does parameter~\|q,
+unless it is \\{null} (which stands for zero). Location~\|p will be
+replaced by $p\cdot t+v\cdot u+q$.
+
+\Y\P$\4\X968:Declare subroutines needed by \\{big\_trans}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{bilin2}(\|p,\39\|t:\\{pointer};\,\35\|v:\\{scaled};%
+\,\35\|u,\39\|q:\\{pointer})$;\6
+\4\&{var} \37\\{vv}: \37\\{scaled};\C{temporary storage for $\\{value}(\|p)$}\2%
+\6
+\&{begin} \37$\\{vv}\K\\{value}(\|p)$;\5
+$\\{type}(\|p)\K\\{proto\_dependent}$;\5
+$\\{new\_dep}(\|p,\39\\{const\_dependency}(0))$;\C{this sets \\{dep\_final}}\6
+\&{if} $\\{vv}\I0$ \1\&{then}\5
+$\\{add\_mult\_dep}(\|p,\39\\{vv},\39\|t)$;\C{\\{dep\_final} doesn't change}\2\6
+\&{if} $\|v\I0$ \1\&{then}\5
+$\\{add\_mult\_dep}(\|p,\39\|v,\39\|u)$;\2\6
+\&{if} $\|q\I\\{null}$ \1\&{then}\5
+$\\{add\_mult\_dep}(\|p,\39\\{unity},\39\|q)$;\2\6
+\&{if} $\\{dep\_list}(\|p)=\\{dep\_final}$ \1\&{then}\6
+\&{begin} \37$\\{vv}\K\\{value}(\\{dep\_final})$;\5
+$\\{recycle\_value}(\|p)$;\5
+$\\{type}(\|p)\K\\{known}$;\5
+$\\{value}(\|p)\K\\{vv}$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M973. \P$\X973:Transform known by known\X\S$\6
+\&{begin} \37$\\{make\_exp\_copy}(\|p)$;\5
+$\|r\K\\{value}(\\{cur\_exp})$;\6
+\&{if} $\\{cur\_type}=\\{transform\_type}$ \1\&{then}\6
+\&{begin} \37$\\{bilin3}(\\{yy\_part\_loc}(\|r),\39\\{tyy},\39\\{value}(\\{xy%
+\_part\_loc}(\|q)),\39\\{tyx},\390)$;\5
+$\\{bilin3}(\\{yx\_part\_loc}(\|r),\39\\{tyy},\39\\{value}(\\{xx\_part\_loc}(%
+\|q)),\39\\{tyx},\390)$;\5
+$\\{bilin3}(\\{xy\_part\_loc}(\|r),\39\\{txx},\39\\{value}(\\{yy\_part\_loc}(%
+\|q)),\39\\{txy},\390)$;\5
+$\\{bilin3}(\\{xx\_part\_loc}(\|r),\39\\{txx},\39\\{value}(\\{yx\_part\_loc}(%
+\|q)),\39\\{txy},\390)$;\6
+\&{end};\2\6
+$\\{bilin3}(\\{y\_part\_loc}(\|r),\39\\{tyy},\39\\{value}(\\{x\_part\_loc}(%
+\|q)),\39\\{tyx},\39\\{ty})$;\5
+$\\{bilin3}(\\{x\_part\_loc}(\|r),\39\\{txx},\39\\{value}(\\{y\_part\_loc}(%
+\|q)),\39\\{txy},\39\\{tx})$;\6
+\&{end}\par
+\U970.\fi
+
+\M974. Finally, in \\{bilin3} everything is \\{known}.
+
+\Y\P$\4\X968:Declare subroutines needed by \\{big\_trans}\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{bilin3}(\|p:\\{pointer};\,\35\|t,\39\|v,\39\|u,\39%
+\\{delta}:\\{scaled})$;\2\6
+\&{begin} \37\&{if} $\|t\I\\{unity}$ \1\&{then}\5
+$\\{delta}\K\\{delta}+\\{take\_scaled}(\\{value}(\|p),\39\|t)$\6
+\4\&{else} $\\{delta}\K\\{delta}+\\{value}(\|p)$;\2\6
+\&{if} $\|u\I0$ \1\&{then}\5
+$\\{value}(\|p)\K\\{delta}+\\{take\_scaled}(\|v,\39\|u)$\6
+\4\&{else} $\\{value}(\|p)\K\\{delta}$;\2\6
+\&{end};\par
+\fi
+
+\M975. \P$\X936:Additional cases of binary operators\X\mathrel{+}\S$\6
+\4\\{concatenate}: \37\&{if} $(\\{cur\_type}=\\{string\_type})\W(\\{type}(\|p)=%
+\\{string\_type})$ \1\&{then}\5
+$\\{cat}(\|p)$\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\\{concatenate})$;\2\6
+\4\\{substring\_of}: \37\&{if} $\\{nice\_pair}(\|p,\39\\{type}(\|p))\W(\\{cur%
+\_type}=\\{string\_type})$ \1\&{then}\5
+$\\{chop\_string}(\\{value}(\|p))$\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\\{substring\_of})$;\2\6
+\4\\{subpath\_of}: \37\&{begin} \37\&{if} $\\{cur\_type}=\\{pair\_type}$ \1%
+\&{then}\5
+\\{pair\_to\_path};\2\6
+\&{if} $\\{nice\_pair}(\|p,\39\\{type}(\|p))\W(\\{cur\_type}=\\{path\_type})$ %
+\1\&{then}\5
+$\\{chop\_path}(\\{value}(\|p))$\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\\{subpath\_of})$;\2\6
+\&{end};\par
+\fi
+
+\M976. \P$\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{cat}(\|p:\\{pointer})$;\6
+\4\&{var} \37$\|a,\39\|b$: \37\\{str\_number};\C{the strings being
+concatenated}\6
+\|k: \37\\{pool\_pointer};\C{index into \\{str\_pool}}\2\6
+\&{begin} \37$\|a\K\\{value}(\|p)$;\5
+$\|b\K\\{cur\_exp}$;\5
+$\\{str\_room}(\\{length}(\|a)+\\{length}(\|b))$;\6
+\&{for} $\|k\K\\{str\_start}[\|a]\mathrel{\&{to}}\\{str\_start}[\|a+1]-1$ \1%
+\&{do}\5
+$\\{append\_char}(\\{so}(\\{str\_pool}[\|k]))$;\2\6
+\&{for} $\|k\K\\{str\_start}[\|b]\mathrel{\&{to}}\\{str\_start}[\|b+1]-1$ \1%
+\&{do}\5
+$\\{append\_char}(\\{so}(\\{str\_pool}[\|k]))$;\2\6
+$\\{cur\_exp}\K\\{make\_string}$;\5
+$\\{delete\_str\_ref}(\|b)$;\6
+\&{end};\par
+\fi
+
+\M977. \P$\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{chop\_string}(\|p:\\{pointer})$;\6
+\4\&{var} \37$\|a,\39\|b$: \37\\{integer};\C{start and stop points}\6
+\|l: \37\\{integer};\C{length of the original string}\6
+\|k: \37\\{integer};\C{runs from \|a to \|b}\6
+\|s: \37\\{str\_number};\C{the original string}\6
+\\{reversed}: \37\\{boolean};\C{was $\|a>\|b$?}\2\6
+\&{begin} \37$\|a\K\\{round\_unscaled}(\\{value}(\\{x\_part\_loc}(\|p)))$;\5
+$\|b\K\\{round\_unscaled}(\\{value}(\\{y\_part\_loc}(\|p)))$;\6
+\&{if} $\|a\L\|b$ \1\&{then}\5
+$\\{reversed}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\\{reversed}\K\\{true}$;\5
+$\|k\K\|a$;\5
+$\|a\K\|b$;\5
+$\|b\K\|k$;\6
+\&{end};\2\6
+$\|s\K\\{cur\_exp}$;\5
+$\|l\K\\{length}(\|s)$;\6
+\&{if} $\|a<0$ \1\&{then}\6
+\&{begin} \37$\|a\K0$;\6
+\&{if} $\|b<0$ \1\&{then}\5
+$\|b\K0$;\2\6
+\&{end};\2\6
+\&{if} $\|b>\|l$ \1\&{then}\6
+\&{begin} \37$\|b\K\|l$;\6
+\&{if} $\|a>\|l$ \1\&{then}\5
+$\|a\K\|l$;\2\6
+\&{end};\2\6
+$\\{str\_room}(\|b-\|a)$;\6
+\&{if} $\\{reversed}$ \1\&{then}\6
+\&{for} $\|k\K\\{str\_start}[\|s]+\|b-1\mathrel{\&{downto}}\\{str\_start}[\|s]+%
+\|a$ \1\&{do}\5
+$\\{append\_char}(\\{so}(\\{str\_pool}[\|k]))$\2\6
+\4\&{else} \&{for} $\|k\K\\{str\_start}[\|s]+\|a\mathrel{\&{to}}\\{str\_start}[%
+\|s]+\|b-1$ \1\&{do}\5
+$\\{append\_char}(\\{so}(\\{str\_pool}[\|k]))$;\2\2\6
+$\\{cur\_exp}\K\\{make\_string}$;\5
+$\\{delete\_str\_ref}(\|s)$;\6
+\&{end};\par
+\fi
+
+\M978. \P$\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{chop\_path}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{a knot in the original path}\6
+$\\{pp},\39\\{qq},\39\\{rr},\39\\{ss}$: \37\\{pointer};\C{link variables for
+copies of path nodes}\6
+$\|a,\39\|b,\39\|k,\39\|l$: \37\\{scaled};\C{indices for chopping}\6
+\\{reversed}: \37\\{boolean};\C{was $\|a>\|b$?}\2\6
+\&{begin} \37$\|l\K\\{path\_length}$;\5
+$\|a\K\\{value}(\\{x\_part\_loc}(\|p))$;\5
+$\|b\K\\{value}(\\{y\_part\_loc}(\|p))$;\6
+\&{if} $\|a\L\|b$ \1\&{then}\5
+$\\{reversed}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\\{reversed}\K\\{true}$;\5
+$\|k\K\|a$;\5
+$\|a\K\|b$;\5
+$\|b\K\|k$;\6
+\&{end};\2\6
+\X979:Dispense with the cases $\|a<0$ and/or $\|b>\|l$\X;\6
+$\|q\K\\{cur\_exp}$;\6
+\&{while} $\|a\G\\{unity}$ \1\&{do}\6
+\&{begin} \37$\|q\K\\{link}(\|q)$;\5
+$\|a\K\|a-\\{unity}$;\5
+$\|b\K\|b-\\{unity}$;\6
+\&{end};\2\6
+\&{if} $\|b=\|a$ \1\&{then}\5
+\X981:Construct a path from \\{pp} to \\{qq} of length zero\X\6
+\4\&{else} \X980:Construct a path from \\{pp} to \\{qq} of length $\lceil b%
+\rceil$\X;\2\6
+$\\{left\_type}(\\{pp})\K\\{endpoint}$;\5
+$\\{right\_type}(\\{qq})\K\\{endpoint}$;\5
+$\\{link}(\\{qq})\K\\{pp}$;\5
+$\\{toss\_knot\_list}(\\{cur\_exp})$;\6
+\&{if} $\\{reversed}$ \1\&{then}\6
+\&{begin} \37$\\{cur\_exp}\K\\{link}(\\{htap\_ypoc}(\\{pp}))$;\5
+$\\{toss\_knot\_list}(\\{pp})$;\6
+\&{end}\6
+\4\&{else} $\\{cur\_exp}\K\\{pp}$;\2\6
+\&{end};\par
+\fi
+
+\M979. \P$\X979:Dispense with the cases $\|a<0$ and/or $\|b>\|l$\X\S$\6
+\&{if} $\|a<0$ \1\&{then}\6
+\&{if} $\\{left\_type}(\\{cur\_exp})=\\{endpoint}$ \1\&{then}\6
+\&{begin} \37$\|a\K0$;\6
+\&{if} $\|b<0$ \1\&{then}\5
+$\|b\K0$;\2\6
+\&{end}\6
+\4\&{else} \1\&{repeat} \37$\|a\K\|a+\|l$;\5
+$\|b\K\|b+\|l$;\6
+\4\&{until}\5
+$\|a\G0$;\C{a cycle always has length $\|l>0$}\2\2\2\6
+\&{if} $\|b>\|l$ \1\&{then}\6
+\&{if} $\\{left\_type}(\\{cur\_exp})=\\{endpoint}$ \1\&{then}\6
+\&{begin} \37$\|b\K\|l$;\6
+\&{if} $\|a>\|l$ \1\&{then}\5
+$\|a\K\|l$;\2\6
+\&{end}\6
+\4\&{else} \&{while} $\|a\G\|l$ \1\&{do}\6
+\&{begin} \37$\|a\K\|a-\|l$;\5
+$\|b\K\|b-\|l$;\6
+\&{end}\2\2\2\par
+\U978.\fi
+
+\M980. \P$\X980:Construct a path from \\{pp} to \\{qq} of length $\lceil b%
+\rceil$\X\S$\6
+\&{begin} \37$\\{pp}\K\\{copy\_knot}(\|q)$;\5
+$\\{qq}\K\\{pp}$;\6
+\1\&{repeat} \37$\|q\K\\{link}(\|q)$;\5
+$\\{rr}\K\\{qq}$;\5
+$\\{qq}\K\\{copy\_knot}(\|q)$;\5
+$\\{link}(\\{rr})\K\\{qq}$;\5
+$\|b\K\|b-\\{unity}$;\6
+\4\&{until}\5
+$\|b\L0$;\2\6
+\&{if} $\|a>0$ \1\&{then}\6
+\&{begin} \37$\\{ss}\K\\{pp}$;\5
+$\\{pp}\K\\{link}(\\{pp})$;\5
+$\\{split\_cubic}(\\{ss},\39\|a\ast\O{10000},\39\\{x\_coord}(\\{pp}),\39\\{y%
+\_coord}(\\{pp}))$;\5
+$\\{pp}\K\\{link}(\\{ss})$;\5
+$\\{free\_node}(\\{ss},\39\\{knot\_node\_size})$;\6
+\&{if} $\\{rr}=\\{ss}$ \1\&{then}\6
+\&{begin} \37$\|b\K\\{make\_scaled}(\|b,\39\\{unity}-\|a)$;\5
+$\\{rr}\K\\{pp}$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{if} $\|b<0$ \1\&{then}\6
+\&{begin} \37$\\{split\_cubic}(\\{rr},\39(\|b+\\{unity})\ast\O{10000},\39\\{x%
+\_coord}(\\{qq}),\39\\{y\_coord}(\\{qq}))$;\5
+$\\{free\_node}(\\{qq},\39\\{knot\_node\_size})$;\5
+$\\{qq}\K\\{link}(\\{rr})$;\6
+\&{end};\2\6
+\&{end}\par
+\U978.\fi
+
+\M981. \P$\X981:Construct a path from \\{pp} to \\{qq} of length zero\X\S$\6
+\&{begin} \37\&{if} $\|a>0$ \1\&{then}\6
+\&{begin} \37$\\{qq}\K\\{link}(\|q)$;\5
+$\\{split\_cubic}(\|q,\39\|a\ast\O{10000},\39\\{x\_coord}(\\{qq}),\39\\{y%
+\_coord}(\\{qq}))$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+$\\{pp}\K\\{copy\_knot}(\|q)$;\5
+$\\{qq}\K\\{pp}$;\6
+\&{end}\par
+\U978.\fi
+
+\M982. The \\{pair\_value} routine changes the current expression to a
+given ordered pair of values.
+
+\Y\P$\4\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{pair\_value}(\|x,\39\|y:\\{scaled})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{a pair node}\2\6
+\&{begin} \37$\|p\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{flush\_cur\_exp}(\|p)$;\5
+$\\{cur\_type}\K\\{pair\_type}$;\5
+$\\{type}(\|p)\K\\{pair\_type}$;\5
+$\\{name\_type}(\|p)\K\\{capsule}$;\5
+$\\{init\_big\_node}(\|p)$;\5
+$\|p\K\\{value}(\|p)$;\6
+$\\{type}(\\{x\_part\_loc}(\|p))\K\\{known}$;\5
+$\\{value}(\\{x\_part\_loc}(\|p))\K\|x$;\6
+$\\{type}(\\{y\_part\_loc}(\|p))\K\\{known}$;\5
+$\\{value}(\\{y\_part\_loc}(\|p))\K\|y$;\6
+\&{end};\par
+\fi
+
+\M983. \P$\X936:Additional cases of binary operators\X\mathrel{+}\S$\6
+\4$\\{point\_of},\39\\{precontrol\_of},\39\\{postcontrol\_of}$: \37\&{begin} %
+\37\&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\5
+\\{pair\_to\_path};\2\6
+\&{if} $(\\{cur\_type}=\\{path\_type})\W(\\{type}(\|p)=\\{known})$ \1\&{then}\5
+$\\{find\_point}(\\{value}(\|p),\39\|c)$\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\|c)$;\2\6
+\&{end};\6
+\4\\{pen\_offset\_of}: \37\&{begin} \37\&{if} $\\{cur\_type}=\\{future\_pen}$ %
+\1\&{then}\5
+\\{materialize\_pen};\2\6
+\&{if} $(\\{cur\_type}=\\{pen\_type})\W\\{nice\_pair}(\|p,\39\\{type}(\|p))$ \1%
+\&{then}\5
+$\\{set\_up\_offset}(\\{value}(\|p))$\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\\{pen\_offset\_of})$;\2\6
+\&{end};\6
+\4\\{direction\_time\_of}: \37\&{begin} \37\&{if} $\\{cur\_type}=\\{pair%
+\_type}$ \1\&{then}\5
+\\{pair\_to\_path};\2\6
+\&{if} $(\\{cur\_type}=\\{path\_type})\W\\{nice\_pair}(\|p,\39\\{type}(\|p))$ %
+\1\&{then}\5
+$\\{set\_up\_direction\_time}(\\{value}(\|p))$\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\\{direction\_time\_of})$;\2\6
+\&{end};\par
+\fi
+
+\M984. \P$\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{set\_up\_offset}(\|p:\\{pointer})$;\2\6
+\&{begin} \37$\\{find\_offset}(\\{value}(\\{x\_part\_loc}(\|p)),\39\\{value}(%
+\\{y\_part\_loc}(\|p)),\39\\{cur\_exp})$;\5
+$\\{pair\_value}(\\{cur\_x},\39\\{cur\_y})$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37$\\{set\_up\_direction\_time}(\|p:\\{pointer})$;\2\6
+\&{begin} \37$\\{flush\_cur\_exp}(\\{find\_direction\_time}(\\{value}(\\{x%
+\_part\_loc}(\|p)),\39\\{value}(\\{y\_part\_loc}(\|p)),\39\\{cur\_exp}))$;\6
+\&{end};\par
+\fi
+
+\M985. \P$\X923:Declare binary action procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{find\_point}(\|v:\\{scaled};\,\35\|c:%
+\\{quarterword})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{the path}\6
+\|n: \37\\{scaled};\C{its length}\6
+\|q: \37\\{pointer};\C{successor of \|p}\2\6
+\&{begin} \37$\|p\K\\{cur\_exp}$;\6
+\&{if} $\\{left\_type}(\|p)=\\{endpoint}$ \1\&{then}\5
+$\|n\K-\\{unity}$\ \&{else} $\|n\K0$;\2\6
+\1\&{repeat} \37$\|p\K\\{link}(\|p)$;\5
+$\|n\K\|n+\\{unity}$;\6
+\4\&{until}\5
+$\|p=\\{cur\_exp}$;\2\6
+\&{if} $\|n=0$ \1\&{then}\5
+$\|v\K0$\6
+\4\&{else} \&{if} $\|v<0$ \1\&{then}\6
+\&{if} $\\{left\_type}(\|p)=\\{endpoint}$ \1\&{then}\5
+$\|v\K0$\6
+\4\&{else} $\|v\K\|n-1-((-\|v-1)\mathbin{\&{mod}}\|n)$\2\6
+\4\&{else} \&{if} $\|v>\|n$ \1\&{then}\6
+\&{if} $\\{left\_type}(\|p)=\\{endpoint}$ \1\&{then}\5
+$\|v\K\|n$\6
+\4\&{else} $\|v\K\|v\mathbin{\&{mod}}\|n$;\2\2\2\2\6
+$\|p\K\\{cur\_exp}$;\6
+\&{while} $\|v\G\\{unity}$ \1\&{do}\6
+\&{begin} \37$\|p\K\\{link}(\|p)$;\5
+$\|v\K\|v-\\{unity}$;\6
+\&{end};\2\6
+\&{if} $\|v\I0$ \1\&{then}\5
+\X986:Insert a fractional node by splitting the cubic\X;\2\6
+\X987:Set the current expression to the desired path coordinates\X;\6
+\&{end};\par
+\fi
+
+\M986. \P$\X986:Insert a fractional node by splitting the cubic\X\S$\6
+\&{begin} \37$\|q\K\\{link}(\|p)$;\5
+$\\{split\_cubic}(\|p,\39\|v\ast\O{10000},\39\\{x\_coord}(\|q),\39\\{y\_coord}(%
+\|q))$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end}\par
+\U985.\fi
+
+\M987. \P$\X987:Set the current expression to the desired path coordinates\X\S$%
+\6
+\&{case} $\|c$ \1\&{of}\6
+\4\\{point\_of}: \37$\\{pair\_value}(\\{x\_coord}(\|p),\39\\{y\_coord}(\|p))$;\6
+\4\\{precontrol\_of}: \37\&{if} $\\{left\_type}(\|p)=\\{endpoint}$ \1\&{then}\5
+$\\{pair\_value}(\\{x\_coord}(\|p),\39\\{y\_coord}(\|p))$\6
+\4\&{else} $\\{pair\_value}(\\{left\_x}(\|p),\39\\{left\_y}(\|p))$;\2\6
+\4\\{postcontrol\_of}: \37\&{if} $\\{right\_type}(\|p)=\\{endpoint}$ \1\&{then}%
+\5
+$\\{pair\_value}(\\{x\_coord}(\|p),\39\\{y\_coord}(\|p))$\6
+\4\&{else} $\\{pair\_value}(\\{right\_x}(\|p),\39\\{right\_y}(\|p))$;\2\2\6
+\&{end}\C{there are no other cases}\par
+\U985.\fi
+
+\M988. \P$\X936:Additional cases of binary operators\X\mathrel{+}\S$\6
+\4\\{intersect}: \37\&{begin} \37\&{if} $\\{type}(\|p)=\\{pair\_type}$ \1%
+\&{then}\6
+\&{begin} \37$\|q\K\\{stash\_cur\_exp}$;\5
+$\\{unstash\_cur\_exp}(\|p)$;\5
+\\{pair\_to\_path};\5
+$\|p\K\\{stash\_cur\_exp}$;\5
+$\\{unstash\_cur\_exp}(\|q)$;\6
+\&{end};\2\6
+\&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\5
+\\{pair\_to\_path};\2\6
+\&{if} $(\\{cur\_type}=\\{path\_type})\W(\\{type}(\|p)=\\{path\_type})$ \1%
+\&{then}\6
+\&{begin} \37$\\{path\_intersection}(\\{value}(\|p),\39\\{cur\_exp})$;\5
+$\\{pair\_value}(\\{cur\_t},\39\\{cur\_tt})$;\6
+\&{end}\6
+\4\&{else} $\\{bad\_binary}(\|p,\39\\{intersect})$;\2\6
+\&{end};\par
+\fi
+
+\N989. \[43] Statements and commands.
+The chief executive of \MF\ is the \\{do\_statement} routine, which
+contains the master switch that causes all the various pieces of \MF\
+to do their things, in the right order.
+
+In a sense, this is the grand climax of the program: It applies all the
+tools that we have worked so hard to construct. In another sense, this is
+the messiest part of the program: It necessarily refers to other pieces
+of code all over the place, so that a person can't fully understand what is
+going on without paging back and forth to be reminded of conventions that
+are defined elsewhere. We are now at the hub of the web.
+
+The structure of \\{do\_statement} itself is quite simple. The first token
+of the statement is fetched using \\{get\_x\_next}. If it can be the first
+token of an expression, we look for an equation, an assignment, or a
+title. Otherwise we use a \&{case} construction to branch at high speed to
+the appropriate routine for various and sundry other types of commands,
+each of which has an ``action procedure'' that does the necessary work.
+
+The program uses the fact that
+$$\hbox{$\\{min\_primary\_command}=\\{max\_statement\_command}=\\{type%
+\_name}$}$$
+to interpret a statement that starts with, e.g., `\&{string}',
+as a type declaration rather than a boolean expression.
+
+\Y\P\hbox{\4}\X1154:Declare generic font output procedures\X\6
+\hbox{\4}\X995:Declare action procedures for use by \\{do\_statement}\X\6
+\4\&{procedure}\1\ \37\\{do\_statement};\C{governs \MF's activities}\2\6
+\&{begin} \37$\\{cur\_type}\K\\{vacuous}$;\5
+\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}>\\{max\_primary\_command}$ \1\&{then}\5
+\X990:Worry about bad statement\X\6
+\4\&{else} \&{if} $\\{cur\_cmd}>\\{max\_statement\_command}$ \1\&{then}\5
+\X993:Do an equation, assignment, title, or `$\langle\,$expression$\,\rangle\,$%
+\&{endgroup}'\X\6
+\4\&{else} \X992:Do a statement that doesn't begin with an expression\X;\2\2\6
+\&{if} $\\{cur\_cmd}<\\{semicolon}$ \1\&{then}\5
+\X991:Flush unparsable junk that was found after the statement\X;\2\6
+$\\{error\_count}\K0$;\6
+\&{end};\par
+\fi
+
+\M990. The only command codes $>\\{max\_primary\_command}$ that can be present
+at the beginning of a statement are \\{semicolon} and higher; these
+occur when the statement is null.
+
+\Y\P$\4\X990:Worry about bad statement\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_cmd}<\\{semicolon}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"A\ statement\ can\'t\ begin\ with\ \`"})$;\5
+$\\{print\_cmd\_mod}(\\{cur\_cmd},\39\\{cur\_mod})$;\5
+$\\{print\_char}(\.{"\'"})$;\5
+$\\{help5}(\.{"I\ was\ looking\ for\ the\ beginning\ of\ a\ new\ statement."})$%
+\6
+$(\.{"If\ you\ just\ proceed\ without\ changing\ anything,\ I\'ll\ ignore"})$\6
+$(\.{"everything\ up\ to\ the\ next\ \`;\'.\ Please\ insert\ a\ semicolon"})$\6
+$(\.{"now\ in\ front\ of\ anything\ that\ you\ don\'t\ want\ me\ to\
+delete."})$\6
+$(\.{"(See\ Chapter\ 27\ of\ The\ METAFONTbook\ for\ an\ example.)"})$;\6
+\\{back\_error};\5
+\\{get\_x\_next};\6
+\&{end};\2\6
+\&{end}\par
+\U989.\fi
+
+\M991. The help message printed here says that everything is flushed up to
+a semicolon, but actually the commands \\{end\_group} and \\{stop} will
+also terminate a statement.
+
+\Y\P$\4\X991:Flush unparsable junk that was found after the statement\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Extra\ tokens\ will\ be\ flushed"})$;\5
+$\\{help6}(\.{"I\'ve\ just\ read\ as\ much\ of\ that\ statement\ as\ I\ could\
+fathom,"})$\6
+$(\.{"so\ a\ semicolon\ should\ have\ been\ next.\ It\'s\ very\ puzzling..."})$%
+\6
+$(\.{"but\ I\'ll\ try\ to\ get\ myself\ back\ together,\ by\ ignoring"})$\6
+$(\.{"everything\ up\ to\ the\ next\ \`;\'.\ Please\ insert\ a\ semicolon"})$\6
+$(\.{"now\ in\ front\ of\ anything\ that\ you\ don\'t\ want\ me\ to\
+delete."})$\6
+$(\.{"(See\ Chapter\ 27\ of\ The\ METAFONTbook\ for\ an\ example.)"})$;\6
+\\{back\_error};\5
+$\\{scanner\_status}\K\\{flushing}$;\6
+\1\&{repeat} \37\\{get\_next};\5
+\X743:Decrease the string reference count, if the current token is a string\X;\6
+\4\&{until}\5
+\\{end\_of\_statement};\C{$\\{cur\_cmd}=\\{semicolon}$, \\{end\_group}, or %
+\\{stop}}\2\6
+$\\{scanner\_status}\K\\{normal}$;\6
+\&{end}\par
+\U989.\fi
+
+\M992. If \\{do\_statement} ends with $\\{cur\_cmd}=\\{end\_group}$, we should
+have
+$\\{cur\_type}=\\{vacuous}$ unless the statement was simply an expression;
+in the latter case, \\{cur\_type} and \\{cur\_exp} should represent that
+expression.
+
+\Y\P$\4\X992:Do a statement that doesn't begin with an expression\X\S$\6
+\&{begin} \37\&{if} $\\{internal}[\\{tracing\_commands}]>0$ \1\&{then}\5
+\\{show\_cur\_cmd\_mod};\2\6
+\&{case} $\\{cur\_cmd}$ \1\&{of}\6
+\4\\{type\_name}: \37\\{do\_type\_declaration};\6
+\4\\{macro\_def}: \37\&{if} $\\{cur\_mod}>\\{var\_def}$ \1\&{then}\5
+\\{make\_op\_def}\6
+\4\&{else} \&{if} $\\{cur\_mod}>\\{end\_def}$ \1\&{then}\5
+\\{scan\_def};\2\2\6
+\hbox{\4}\X1020:Cases of \\{do\_statement} that invoke particular commands\X\2\6
+\&{end};\C{there are no other cases}\6
+$\\{cur\_type}\K\\{vacuous}$;\6
+\&{end}\par
+\U989.\fi
+
+\M993. The most important statements begin with expressions.
+
+\Y\P$\4\X993:Do an equation, assignment, title, or `$\langle\,$expression$\,%
+\rangle\,$\&{endgroup}'\X\S$\6
+\&{begin} \37$\\{var\_flag}\K\\{assignment}$;\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_cmd}<\\{end\_group}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{cur\_cmd}=\\{equals}$ \1\&{then}\5
+\\{do\_equation}\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{assignment}$ \1\&{then}\5
+\\{do\_assignment}\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{string\_type}$ \1\&{then}\5
+\X994:Do a title\X\6
+\4\&{else} \&{if} $\\{cur\_type}\I\\{vacuous}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Isolated\ expression"})$;\5
+$\\{help3}(\.{"I\ couldn\'t\ find\ an\ \`=\'\ or\ \`:=\'\ after\ the"})$\6
+$(\.{"expression\ that\ is\ shown\ above\ this\ error\ message,"})$\6
+$(\.{"so\ I\ guess\ I\'ll\ just\ ignore\ it\ and\ carry\ on."})$;\5
+\\{put\_get\_error};\6
+\&{end};\2\2\2\2\6
+$\\{flush\_cur\_exp}(0)$;\5
+$\\{cur\_type}\K\\{vacuous}$;\6
+\&{end};\2\6
+\&{end}\par
+\U989.\fi
+
+\M994. \P$\X994:Do a title\X\S$\6
+\&{begin} \37\&{if} $\\{internal}[\\{tracing\_titles}]>0$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{""})$;\5
+$\\{slow\_print}(\\{cur\_exp})$;\5
+\\{update\_terminal};\6
+\&{end};\2\6
+\&{if} $\\{internal}[\\{proofing}]>0$ \1\&{then}\5
+\X1179:Send the current expression as a title to the output file\X;\2\6
+\&{end}\par
+\U993.\fi
+
+\M995. Equations and assignments are performed by the pair of mutually
+recursive
+routines \\{do\_equation} and \\{do\_assignment}. These routines are called
+when
+$\\{cur\_cmd}=\\{equals}$ and when $\\{cur\_cmd}=\\{assignment}$, respectively;
+the left-hand
+side is in \\{cur\_type} and \\{cur\_exp}, while the right-hand side is yet
+to be scanned. After the routines are finished, \\{cur\_type} and \\{cur\_exp}
+will be equal to the right-hand side (which will normally be equal
+to the left-hand side).
+
+\Y\P$\4\X995:Declare action procedures for use by \\{do\_statement}\X\S$\6
+\hbox{\4}\X1006:Declare the procedure called \\{try\_eq}\X\6
+\hbox{\4}\X1001:Declare the procedure called \\{make\_eq}\X\6
+\4\&{procedure}\1\ \37\\{do\_assignment};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{do\_equation};\6
+\4\&{var} \37\\{lhs}: \37\\{pointer};\C{capsule for the left-hand side}\6
+\|p: \37\\{pointer};\C{temporary register}\2\6
+\&{begin} \37$\\{lhs}\K\\{stash\_cur\_exp}$;\5
+\\{get\_x\_next};\5
+$\\{var\_flag}\K\\{assignment}$;\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_cmd}=\\{equals}$ \1\&{then}\5
+\\{do\_equation}\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{assignment}$ \1\&{then}\5
+\\{do\_assignment};\2\2\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>\\{two}$ \1\&{then}\5
+\X997:Trace the current equation\X;\2\6
+\&{if} $\\{cur\_type}=\\{unknown\_path}$ \1\&{then}\6
+\&{if} $\\{type}(\\{lhs})=\\{pair\_type}$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{stash\_cur\_exp}$;\5
+$\\{unstash\_cur\_exp}(\\{lhs})$;\5
+$\\{lhs}\K\|p$;\6
+\&{end};\C{in this case \\{make\_eq} will change the pair to a path}\2\2\6
+$\\{make\_eq}(\\{lhs})$;\C{equate \\{lhs} to $(\\{cur\_type},\\{cur\_exp})$}\6
+\&{end};\par
+\As996, 1015, 1021, 1029, 1031, 1034, 1035, 1036, 1040, 1041, 1044, 1045, 1046,
+1049, 1050, 1051, 1054, 1057, 1059, 1070, 1071, 1072, 1073, 1074, 1082, 1103,
+1104, 1106, 1177\ETs1186.
+\U989.\fi
+
+\M996. And \\{do\_assignment} is similar to \\{do\_expression}:
+
+\Y\P$\4\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_assignment};\6
+\4\&{var} \37\\{lhs}: \37\\{pointer};\C{token list for the left-hand side}\6
+\|p: \37\\{pointer};\C{where the left-hand value is stored}\6
+\|q: \37\\{pointer};\C{temporary capsule for the right-hand value}\2\6
+\&{begin} \37\&{if} $\\{cur\_type}\I\\{token\_list}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ \`:=\'\ will\ be\ changed\ to\ \`=%
+\'"})$;\5
+$\\{help2}(\.{"I\ didn\'t\ find\ a\ variable\ name\ at\ the\ left\ of\ the\ %
+\`:=\',"})$\6
+$(\.{"so\ I\'m\ going\ to\ pretend\ that\ you\ said\ \`=\'\ instead."})$;\6
+\\{error};\5
+\\{do\_equation};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{lhs}\K\\{cur\_exp}$;\5
+$\\{cur\_type}\K\\{vacuous}$;\6
+\\{get\_x\_next};\5
+$\\{var\_flag}\K\\{assignment}$;\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_cmd}=\\{equals}$ \1\&{then}\5
+\\{do\_equation}\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{assignment}$ \1\&{then}\5
+\\{do\_assignment};\2\2\6
+\&{if} $\\{internal}[\\{tracing\_commands}]>\\{two}$ \1\&{then}\5
+\X998:Trace the current assignment\X;\2\6
+\&{if} $\\{info}(\\{lhs})>\\{hash\_end}$ \1\&{then}\5
+\X999:Assign the current expression to an internal variable\X\6
+\4\&{else} \X1000:Assign the current expression to the variable \\{lhs}\X;\2\6
+$\\{flush\_node\_list}(\\{lhs})$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M997. \P$\X997:Trace the current equation\X\S$\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\{("})$;\5
+$\\{print\_exp}(\\{lhs},\390)$;\5
+$\\{print}(\.{")=("})$;\5
+$\\{print\_exp}(\\{null},\390)$;\5
+$\\{print}(\.{")\}"})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\par
+\U995.\fi
+
+\M998. \P$\X998:Trace the current assignment\X\S$\6
+\&{begin} \37\\{begin\_diagnostic};\5
+$\\{print\_nl}(\.{"\{"})$;\6
+\&{if} $\\{info}(\\{lhs})>\\{hash\_end}$ \1\&{then}\5
+$\\{slow\_print}(\\{int\_name}[\\{info}(\\{lhs})-(\\{hash\_end})])$\6
+\4\&{else} $\\{show\_token\_list}(\\{lhs},\39\\{null},\391000,\390)$;\2\6
+$\\{print}(\.{":="})$;\5
+$\\{print\_exp}(\\{null},\390)$;\5
+$\\{print\_char}(\.{"\}"})$;\5
+$\\{end\_diagnostic}(\\{false})$;\6
+\&{end}\par
+\U996.\fi
+
+\M999. \P$\X999:Assign the current expression to an internal variable\X\S$\6
+\&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\5
+$\\{internal}[\\{info}(\\{lhs})-(\\{hash\_end})]\K\\{cur\_exp}$\6
+\4\&{else} \&{begin} \37$\\{exp\_err}(\.{"Internal\ quantity\ \`"})$;\5
+$\\{slow\_print}(\\{int\_name}[\\{info}(\\{lhs})-(\\{hash\_end})])$;\5
+$\\{print}(\.{"\'\ must\ receive\ a\ known\ value"})$;\5
+$\\{help2}(\.{"I\ can\'t\ set\ an\ internal\ quantity\ to\ anything\ but\ a\
+known"})$\6
+$(\.{"numeric\ value,\ so\ I\'ll\ have\ to\ ignore\ this\ assignment."})$;\5
+\\{put\_get\_error};\6
+\&{end}\2\par
+\U996.\fi
+
+\M1000. \P$\X1000:Assign the current expression to the variable \\{lhs}\X\S$\6
+\&{begin} \37$\|p\K\\{find\_variable}(\\{lhs})$;\6
+\&{if} $\|p\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\|q\K\\{stash\_cur\_exp}$;\5
+$\\{cur\_type}\K\\{und\_type}(\|p)$;\5
+$\\{recycle\_value}(\|p)$;\5
+$\\{type}(\|p)\K\\{cur\_type}$;\5
+$\\{value}(\|p)\K\\{null}$;\5
+$\\{make\_exp\_copy}(\|p)$;\5
+$\|p\K\\{stash\_cur\_exp}$;\5
+$\\{unstash\_cur\_exp}(\|q)$;\5
+$\\{make\_eq}(\|p)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{obliterated}(\\{lhs})$;\5
+\\{put\_get\_error};\6
+\&{end};\2\6
+\&{end}\par
+\U996.\fi
+
+\M1001. And now we get to the nitty-gritty. The \\{make\_eq} procedure is given
+a pointer to a capsule that is to be equated to the current expression.
+
+\Y\P$\4\X1001:Declare the procedure called \\{make\_eq}\X\S$\6
+\4\&{procedure}\1\ \37$\\{make\_eq}(\\{lhs}:\\{pointer})$;\6
+\4\&{label} \37$\\{restart},\39\\{done},\39\\{not\_found}$;\6
+\4\&{var} \37\|t: \37\\{small\_number};\C{type of the left-hand side}\6
+\|v: \37\\{integer};\C{value of the left-hand side}\6
+$\|p,\39\|q$: \37\\{pointer};\C{pointers inside of big nodes}\2\6
+\&{begin} \37\\{restart}: \37$\|t\K\\{type}(\\{lhs})$;\6
+\&{if} $\|t\L\\{pair\_type}$ \1\&{then}\5
+$\|v\K\\{value}(\\{lhs})$;\2\6
+\&{case} $\|t$ \1\&{of}\6
+\hbox{\4}\X1003:For each type \|t, make an equation and \&{goto} \\{done}
+unless \\{cur\_type} is incompatible with~\|t\X\2\6
+\&{end};\C{all cases have been listed}\6
+\X1002:Announce that the equation cannot be performed\X;\6
+\4\\{done}: \37\\{check\_arith};\5
+$\\{recycle\_value}(\\{lhs})$;\5
+$\\{free\_node}(\\{lhs},\39\\{value\_node\_size})$;\6
+\&{end};\par
+\U995.\fi
+
+\M1002. \P$\X1002:Announce that the equation cannot be performed\X\S$\6
+$\\{disp\_err}(\\{lhs},\39\.{""})$;\5
+$\\{exp\_err}(\.{"Equation\ cannot\ be\ performed\ ("})$;\6
+\&{if} $\\{type}(\\{lhs})\L\\{pair\_type}$ \1\&{then}\5
+$\\{print\_type}(\\{type}(\\{lhs}))$\ \&{else} $\\{print}(\.{"numeric"})$;\2\6
+$\\{print\_char}(\.{"="})$;\6
+\&{if} $\\{cur\_type}\L\\{pair\_type}$ \1\&{then}\5
+$\\{print\_type}(\\{cur\_type})$\ \&{else} $\\{print}(\.{"numeric"})$;\2\6
+$\\{print\_char}(\.{")"})$;\6
+$\\{help2}(\.{"I\'m\ sorry,\ but\ I\ don\'t\ know\ how\ to\ make\ such\ things\
+equal."})$\6
+$(\.{"(See\ the\ two\ expressions\ just\ above\ the\ error\ message.)"})$;\5
+\\{put\_get\_error}\par
+\U1001.\fi
+
+\M1003. \P$\X1003:For each type \|t, make an equation and \&{goto} \\{done}
+unless \\{cur\_type} is incompatible with~\|t\X\S$\6
+\4$\\{boolean\_type},\39\\{string\_type},\39\\{pen\_type},\39\\{path\_type},\39%
+\\{picture\_type}$: \37\&{if} $\\{cur\_type}=\|t+\\{unknown\_tag}$ \1\&{then}\6
+\&{begin} \37$\\{nonlinear\_eq}(\|v,\39\\{cur\_exp},\39\\{false})$;\5
+\&{goto} \37\\{done};\6
+\&{end}\6
+\4\&{else} \&{if} $\\{cur\_type}=\|t$ \1\&{then}\5
+\X1004:Report redundant or inconsistent equation and \&{goto} \\{done}\X;\2\2\6
+\4\\{unknown\_types}: \37\&{if} $\\{cur\_type}=\|t-\\{unknown\_tag}$ \1\&{then}%
+\6
+\&{begin} \37$\\{nonlinear\_eq}(\\{cur\_exp},\39\\{lhs},\39\\{true})$;\5
+\&{goto} \37\\{done};\6
+\&{end}\6
+\4\&{else} \&{if} $\\{cur\_type}=\|t$ \1\&{then}\6
+\&{begin} \37$\\{ring\_merge}(\\{lhs},\39\\{cur\_exp})$;\5
+\&{goto} \37\\{done};\6
+\&{end}\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\6
+\&{if} $\|t=\\{unknown\_path}$ \1\&{then}\6
+\&{begin} \37\\{pair\_to\_path};\5
+\&{goto} \37\\{restart};\6
+\&{end};\2\2\2\2\6
+\4$\\{transform\_type},\39\\{pair\_type}$: \37\&{if} $\\{cur\_type}=\|t$ \1%
+\&{then}\5
+\X1005:Do multiple equations and \&{goto} \\{done}\X;\2\6
+\4$\\{known},\39\\{dependent},\39\\{proto\_dependent},\39\\{independent}$: \37%
+\&{if} $\\{cur\_type}\G\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{try\_eq}(\\{lhs},\39\\{null})$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+\4\\{vacuous}: \37\\{do\_nothing};\par
+\U1001.\fi
+
+\M1004. \P$\X1004:Report redundant or inconsistent equation and \&{goto} %
+\\{done}\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_type}\L\\{string\_type}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{cur\_type}=\\{string\_type}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{str\_vs\_str}(\|v,\39\\{cur\_exp})\I0$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\&{end}\6
+\4\&{else} \&{if} $\|v\I\\{cur\_exp}$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\2\6
+\X623:Exclaim about a redundant equation\X;\6
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+$\\{print\_err}(\.{"Redundant\ or\ inconsistent\ equation"})$;\5
+$\\{help2}(\.{"An\ equation\ between\ already-known\ quantities\ can\'t\
+help."})$\6
+$(\.{"But\ don\'t\ worry;\ continue\ and\ I\'ll\ just\ ignore\ it."})$;\5
+\\{put\_get\_error};\5
+\&{goto} \37\\{done};\6
+\4\\{not\_found}: \37$\\{print\_err}(\.{"Inconsistent\ equation"})$;\5
+$\\{help2}(\.{"The\ equation\ I\ just\ read\ contradicts\ what\ was\ said\
+before."})$\6
+$(\.{"But\ don\'t\ worry;\ continue\ and\ I\'ll\ just\ ignore\ it."})$;\5
+\\{put\_get\_error};\5
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U1003.\fi
+
+\M1005. \P$\X1005:Do multiple equations and \&{goto} \\{done}\X\S$\6
+\&{begin} \37$\|p\K\|v+\\{big\_node\_size}[\|t]$;\5
+$\|q\K\\{value}(\\{cur\_exp})+\\{big\_node\_size}[\|t]$;\6
+\1\&{repeat} \37$\|p\K\|p-2$;\5
+$\|q\K\|q-2$;\5
+$\\{try\_eq}(\|p,\39\|q)$;\6
+\4\&{until}\5
+$\|p=\|v$;\2\6
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U1003.\fi
+
+\M1006. The first argument to \\{try\_eq} is the location of a value node
+in a capsule that will soon be recycled. The second argument is
+either a location within a pair or transform node pointed to by
+\\{cur\_exp}, or it is \\{null} (which means that \\{cur\_exp} itself
+serves as the second argument). The idea is to leave \\{cur\_exp} unchanged,
+but to equate the two operands.
+
+\Y\P$\4\X1006:Declare the procedure called \\{try\_eq}\X\S$\6
+\4\&{procedure}\1\ \37$\\{try\_eq}(\|l,\39\|r:\\{pointer})$;\6
+\4\&{label} \37$\\{done},\39\\{done1}$;\6
+\4\&{var} \37\|p: \37\\{pointer};\C{dependency list for right operand minus
+left operand}\6
+\|t: \37$\\{known}\to\\{independent}$;\C{the type of list \|p}\6
+\|q: \37\\{pointer};\C{the constant term of \|p is here}\6
+\\{pp}: \37\\{pointer};\C{dependency list for right operand}\6
+\\{tt}: \37$\\{dependent}\to\\{independent}$;\C{the type of list \\{pp}}\6
+\\{copied}: \37\\{boolean};\C{have we copied a list that ought to be recycled?}%
+\2\6
+\&{begin} \37\X1007:Remove the left operand from its container, negate it, and
+put it into dependency list~\|p with constant term~\|q\X;\6
+\X1009:Add the right operand to list \|p\X;\6
+\&{if} $\\{info}(\|p)=\\{null}$ \1\&{then}\5
+\X1008:Deal with redundant or inconsistent equation\X\6
+\4\&{else} \&{begin} \37$\\{linear\_eq}(\|p,\39\|t)$;\6
+\&{if} $\|r=\\{null}$ \1\&{then}\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\6
+\&{if} $\\{type}(\\{cur\_exp})=\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{pp}\K\\{cur\_exp}$;\5
+$\\{cur\_exp}\K\\{value}(\\{cur\_exp})$;\5
+$\\{cur\_type}\K\\{known}$;\5
+$\\{free\_node}(\\{pp},\39\\{value\_node\_size})$;\6
+\&{end};\2\2\2\6
+\&{end};\2\6
+\&{end};\par
+\U995.\fi
+
+\M1007. \P$\X1007:Remove the left operand from its container, negate it, and
+put it into dependency list~\|p with constant term~\|q\X\S$\6
+$\|t\K\\{type}(\|l)$;\6
+\&{if} $\|t=\\{known}$ \1\&{then}\6
+\&{begin} \37$\|t\K\\{dependent}$;\5
+$\|p\K\\{const\_dependency}(-\\{value}(\|l))$;\5
+$\|q\K\|p$;\6
+\&{end}\6
+\4\&{else} \&{if} $\|t=\\{independent}$ \1\&{then}\6
+\&{begin} \37$\|t\K\\{dependent}$;\5
+$\|p\K\\{single\_dependency}(\|l)$;\5
+$\\{negate}(\\{value}(\|p))$;\5
+$\|q\K\\{dep\_final}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|p\K\\{dep\_list}(\|l)$;\5
+$\|q\K\|p$;\6
+\~ \1\&{loop}\ \&{begin} \37$\\{negate}(\\{value}(\|q))$;\6
+\&{if} $\\{info}(\|q)=\\{null}$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+\4\\{done}: \37$\\{link}(\\{prev\_dep}(\|l))\K\\{link}(\|q)$;\5
+$\\{prev\_dep}(\\{link}(\|q))\K\\{prev\_dep}(\|l)$;\5
+$\\{type}(\|l)\K\\{known}$;\6
+\&{end}\2\2\par
+\U1006.\fi
+
+\M1008. \P$\X1008:Deal with redundant or inconsistent equation\X\S$\6
+\&{begin} \37\&{if} $\\{abs}(\\{value}(\|p))>64$ \1\&{then}\C{off by .001 or
+more}\6
+\&{begin} \37$\\{print\_err}(\.{"Inconsistent\ equation"})$;\6
+$\\{print}(\.{"\ (off\ by\ "})$;\5
+$\\{print\_scaled}(\\{value}(\|p))$;\5
+$\\{print\_char}(\.{")"})$;\5
+$\\{help2}(\.{"The\ equation\ I\ just\ read\ contradicts\ what\ was\ said\
+before."})$\6
+$(\.{"But\ don\'t\ worry;\ continue\ and\ I\'ll\ just\ ignore\ it."})$;\5
+\\{put\_get\_error};\6
+\&{end}\6
+\4\&{else} \&{if} $\|r=\\{null}$ \1\&{then}\5
+\X623:Exclaim about a redundant equation\X;\2\2\6
+$\\{free\_node}(\|p,\39\\{dep\_node\_size})$;\6
+\&{end}\par
+\U1006.\fi
+
+\M1009. \P$\X1009:Add the right operand to list \|p\X\S$\6
+\&{if} $\|r=\\{null}$ \1\&{then}\6
+\&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{value}(\|q)\K\\{value}(\|q)+\\{cur\_exp}$;\5
+\&{goto} \37\\{done1};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{tt}\K\\{cur\_type}$;\6
+\&{if} $\\{tt}=\\{independent}$ \1\&{then}\5
+$\\{pp}\K\\{single\_dependency}(\\{cur\_exp})$\6
+\4\&{else} $\\{pp}\K\\{dep\_list}(\\{cur\_exp})$;\2\6
+\&{end}\2\6
+\4\&{else} \&{if} $\\{type}(\|r)=\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{value}(\|q)\K\\{value}(\|q)+\\{value}(\|r)$;\5
+\&{goto} \37\\{done1};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{tt}\K\\{type}(\|r)$;\6
+\&{if} $\\{tt}=\\{independent}$ \1\&{then}\5
+$\\{pp}\K\\{single\_dependency}(\|r)$\6
+\4\&{else} $\\{pp}\K\\{dep\_list}(\|r)$;\2\6
+\&{end};\2\2\6
+\&{if} $\\{tt}\I\\{independent}$ \1\&{then}\5
+$\\{copied}\K\\{false}$\6
+\4\&{else} \&{begin} \37$\\{copied}\K\\{true}$;\5
+$\\{tt}\K\\{dependent}$;\6
+\&{end};\2\6
+\X1010:Add dependency list \\{pp} of type \\{tt} to dependency list~\|p of
+type~\|t\X;\6
+\&{if} $\\{copied}$ \1\&{then}\5
+$\\{flush\_node\_list}(\\{pp})$;\2\6
+\4\\{done1}: \37\par
+\U1006.\fi
+
+\M1010. \P$\X1010:Add dependency list \\{pp} of type \\{tt} to dependency list~%
+\|p of type~\|t\X\S$\6
+$\\{watch\_coefs}\K\\{false}$;\6
+\&{if} $\|t=\\{tt}$ \1\&{then}\5
+$\|p\K\\{p\_plus\_q}(\|p,\39\\{pp},\39\|t)$\6
+\4\&{else} \&{if} $\|t=\\{proto\_dependent}$ \1\&{then}\5
+$\|p\K\\{p\_plus\_fq}(\|p,\39\\{unity},\39\\{pp},\39\\{proto\_dependent},\39%
+\\{dependent})$\6
+\4\&{else} \&{begin} \37$\|q\K\|p$;\6
+\&{while} $\\{info}(\|q)\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\\{value}(\|q)\K\\{round\_fraction}(\\{value}(\|q))$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+$\|t\K\\{proto\_dependent}$;\5
+$\|p\K\\{p\_plus\_q}(\|p,\39\\{pp},\39\|t)$;\6
+\&{end};\2\2\6
+$\\{watch\_coefs}\K\\{true}$;\par
+\U1009.\fi
+
+\M1011. Our next goal is to process type declarations. For this purpose it's
+convenient to have a procedure that scans a $\langle\,$declared
+variable$\,\rangle$ and returns the corresponding token list. After the
+following procedure has acted, the token after the declared variable
+will have been scanned, so it will appear in \\{cur\_cmd}, \\{cur\_mod},
+and~\\{cur\_sym}.
+
+\Y\P$\4\X1011:Declare the function called \\{scan\_declared\_variable}\X\S$\6
+\4\&{function}\1\ \37\\{scan\_declared\_variable}: \37\\{pointer};\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|x: \37\\{pointer};\C{hash address of the variable's root}\6
+$\|h,\39\|t$: \37\\{pointer};\C{head and tail of the token list to be returned}%
+\6
+\|l: \37\\{pointer};\C{hash address of left bracket}\2\6
+\&{begin} \37\\{get\_symbol};\5
+$\|x\K\\{cur\_sym}$;\6
+\&{if} $\\{cur\_cmd}\I\\{tag\_token}$ \1\&{then}\5
+$\\{clear\_symbol}(\|x,\39\\{false})$;\2\6
+$\|h\K\\{get\_avail}$;\5
+$\\{info}(\|h)\K\|x$;\5
+$\|t\K\|h$;\6
+\~ \1\&{loop}\ \&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{cur\_sym}=0$ \1\&{then}\5
+\&{goto} \37\\{done};\2\6
+\&{if} $\\{cur\_cmd}\I\\{tag\_token}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}\I\\{internal\_quantity}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}=\\{left\_bracket}$ \1\&{then}\5
+\X1012:Descend past a collective subscript\X\6
+\4\&{else} \&{goto} \37\\{done};\2\2\2\6
+$\\{link}(\|t)\K\\{get\_avail}$;\5
+$\|t\K\\{link}(\|t)$;\5
+$\\{info}(\|t)\K\\{cur\_sym}$;\6
+\&{end};\2\6
+\4\\{done}: \37\&{if} $\\{eq\_type}(\|x)\I\\{tag\_token}$ \1\&{then}\5
+$\\{clear\_symbol}(\|x,\39\\{false})$;\2\6
+\&{if} $\\{equiv}(\|x)=\\{null}$ \1\&{then}\5
+$\\{new\_root}(\|x)$;\2\6
+$\\{scan\_declared\_variable}\K\|h$;\6
+\&{end};\par
+\U697.\fi
+
+\M1012. If the subscript isn't collective, we don't accept it as part of the
+declared variable.
+
+\Y\P$\4\X1012:Descend past a collective subscript\X\S$\6
+\&{begin} \37$\|l\K\\{cur\_sym}$;\5
+\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}\I\\{right\_bracket}$ \1\&{then}\6
+\&{begin} \37\\{back\_input};\5
+$\\{cur\_sym}\K\|l$;\5
+$\\{cur\_cmd}\K\\{left\_bracket}$;\5
+\&{goto} \37\\{done};\6
+\&{end}\6
+\4\&{else} $\\{cur\_sym}\K\\{collective\_subscript}$;\2\6
+\&{end}\par
+\U1011.\fi
+
+\M1013. Type declarations are introduced by the following primitive operations.
+
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"numeric"},\39\\{type\_name},\39\\{numeric\_type})$;\6
+$\\{primitive}(\.{"string"},\39\\{type\_name},\39\\{string\_type})$;\6
+$\\{primitive}(\.{"boolean"},\39\\{type\_name},\39\\{boolean\_type})$;\6
+$\\{primitive}(\.{"path"},\39\\{type\_name},\39\\{path\_type})$;\6
+$\\{primitive}(\.{"pen"},\39\\{type\_name},\39\\{pen\_type})$;\6
+$\\{primitive}(\.{"picture"},\39\\{type\_name},\39\\{picture\_type})$;\6
+$\\{primitive}(\.{"transform"},\39\\{type\_name},\39\\{transform\_type})$;\6
+$\\{primitive}(\.{"pair"},\39\\{type\_name},\39\\{pair\_type})$;\par
+\fi
+
+\M1014. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{type\_name}: \37$\\{print\_type}(\|m)$;\par
+\fi
+
+\M1015. Now we are ready to handle type declarations, assuming that a
+\\{type\_name} has just been scanned.
+
+\Y\P$\4\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_type\_declaration};\6
+\4\&{var} \37\|t: \37\\{small\_number};\C{the type being declared}\6
+\|p: \37\\{pointer};\C{token list for a declared variable}\6
+\|q: \37\\{pointer};\C{value node for the variable}\2\6
+\&{begin} \37\&{if} $\\{cur\_mod}\G\\{transform\_type}$ \1\&{then}\5
+$\|t\K\\{cur\_mod}$\ \&{else} $\|t\K\\{cur\_mod}+\\{unknown\_tag}$;\2\6
+\1\&{repeat} \37$\|p\K\\{scan\_declared\_variable}$;\5
+$\\{flush\_variable}(\\{equiv}(\\{info}(\|p)),\39\\{link}(\|p),\39\\{false})$;\6
+$\|q\K\\{find\_variable}(\|p)$;\6
+\&{if} $\|q\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{type}(\|q)\K\|t$;\5
+$\\{value}(\|q)\K\\{null}$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"Declared\ variable\ conflicts\ with%
+\ previous\ vardef"})$;\5
+$\\{help2}(\.{"You\ can\'t\ use,\ e.g.,\ \`numeric\ foo[]\'\ after\ \`vardef\
+foo\'."})$\6
+$(\.{"Proceed,\ and\ I\'ll\ ignore\ the\ illegal\ redeclaration."})$;\5
+\\{put\_get\_error};\6
+\&{end};\2\6
+$\\{flush\_list}(\|p)$;\6
+\&{if} $\\{cur\_cmd}<\\{comma}$ \1\&{then}\5
+\X1016:Flush spurious symbols after the declared variable\X;\2\6
+\4\&{until}\5
+\\{end\_of\_statement};\2\6
+\&{end};\par
+\fi
+
+\M1016. \P$\X1016:Flush spurious symbols after the declared variable\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Illegal\ suffix\ of\ declared\ variable\ will\
+be\ flushed"})$;\5
+$\\{help5}(\.{"Variables\ in\ declarations\ must\ consist\ entirely\ of"})$\6
+$(\.{"names\ and\ collective\ subscripts,\ e.g.,\ \`x[]a\'."})$\6
+$(\.{"Are\ you\ trying\ to\ use\ a\ reserved\ word\ in\ a\ variable\ name?"})$\6
+$(\.{"I\'m\ going\ to\ discard\ the\ junk\ I\ found\ here,"})$\6
+$(\.{"up\ to\ the\ next\ comma\ or\ the\ end\ of\ the\ declaration."})$;\6
+\&{if} $\\{cur\_cmd}=\\{numeric\_token}$ \1\&{then}\5
+$\\{help\_line}[2]\K\.{"Explicit\ subscripts\ like\ \`x15a\'\ aren\'t\
+permitted."}$;\2\6
+\\{put\_get\_error};\5
+$\\{scanner\_status}\K\\{flushing}$;\6
+\1\&{repeat} \37\\{get\_next};\5
+\X743:Decrease the string reference count, if the current token is a string\X;\6
+\4\&{until}\5
+$\\{cur\_cmd}\G\\{comma}$;\C{either \\{end\_of\_statement} or $\\{cur\_cmd}=%
+\\{comma}$}\2\6
+$\\{scanner\_status}\K\\{normal}$;\6
+\&{end}\par
+\U1015.\fi
+
+\M1017. \MF's \\{main\_control} procedure just calls \\{do\_statement}
+repeatedly
+until coming to the end of the user's program.
+Each execution of \\{do\_statement} concludes with
+$\\{cur\_cmd}=\\{semicolon}$, \\{end\_group}, or \\{stop}.
+
+\Y\P\4\&{procedure}\1\ \37\\{main\_control};\2\6
+\&{begin} \37\1\&{repeat} \37\\{do\_statement};\6
+\&{if} $\\{cur\_cmd}=\\{end\_group}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Extra\ \`endgroup\'"})$;\5
+$\\{help2}(\.{"I\'m\ not\ currently\ working\ on\ a\ \`begingroup\',"})$\6
+$(\.{"so\ I\ had\ better\ not\ try\ to\ end\ anything."})$;\5
+$\\{flush\_error}(0)$;\6
+\&{end};\2\6
+\4\&{until}\5
+$\\{cur\_cmd}=\\{stop}$;\2\6
+\&{end};\par
+\fi
+
+\M1018. \P$\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}%
+\S$\6
+$\\{primitive}(\.{"end"},\39\\{stop},\390)$;\6
+$\\{primitive}(\.{"dump"},\39\\{stop},\391)$;\par
+\fi
+
+\M1019. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{stop}: \37\&{if} $\|m=0$ \1\&{then}\5
+$\\{print}(\.{"end"})$\ \&{else} $\\{print}(\.{"dump"})$;\2\par
+\fi
+
+\N1020. \[44] Commands.
+Let's turn now to statements that are classified as ``commands'' because
+of their imperative nature. We'll begin with simple ones, so that it
+will be clear how to hook command processing into the \\{do\_statement}
+routine;
+then we'll tackle the tougher commands.
+
+Here's one of the simplest:
+
+\Y\P$\4\X1020:Cases of \\{do\_statement} that invoke particular commands\X\S$\6
+\4\\{random\_seed}: \37\\{do\_random\_seed};\par
+\As1023, 1026, 1030, 1033, 1039, 1058, 1069, 1076, 1081, 1100\ETs1175.
+\U992.\fi
+
+\M1021. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_random\_seed};\2\6
+\&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}\I\\{assignment}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{":="})$;\5
+$\\{help1}(\.{"Always\ say\ \`randomseed:=<numeric\ expression>\'."})$;\5
+\\{back\_error};\6
+\&{end};\2\6
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Unknown\ value\ will\ be\ ignored"})$;\5
+$\\{help2}(\.{"Your\ expression\ was\ too\ random\ for\ me\ to\ handle,"})$\6
+$(\.{"so\ I\ won\'t\ change\ the\ random\ seed\ just\ now."})$;\6
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end}\6
+\4\&{else} \X1022:Initialize the random seed to \\{cur\_exp}\X;\2\6
+\&{end};\par
+\fi
+
+\M1022. \P$\X1022:Initialize the random seed to \\{cur\_exp}\X\S$\6
+\&{begin} \37$\\{init\_randoms}(\\{cur\_exp})$;\6
+\&{if} $\\{selector}\G\\{log\_only}$ \1\&{then}\6
+\&{begin} \37$\\{old\_setting}\K\\{selector}$;\5
+$\\{selector}\K\\{log\_only}$;\5
+$\\{print\_nl}(\.{"\{randomseed:="})$;\5
+$\\{print\_scaled}(\\{cur\_exp})$;\5
+$\\{print\_char}(\.{"\}"})$;\5
+$\\{print\_nl}(\.{""})$;\5
+$\\{selector}\K\\{old\_setting}$;\6
+\&{end};\2\6
+\&{end}\par
+\U1021.\fi
+
+\M1023. And here's another simple one (somewhat different in flavor):
+
+\Y\P$\4\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{mode\_command}: \37\&{begin} \37\\{print\_ln};\5
+$\\{interaction}\K\\{cur\_mod}$;\5
+\X70:Initialize the print \\{selector} based on \\{interaction}\X;\6
+\&{if} $\\{log\_opened}$ \1\&{then}\5
+$\\{selector}\K\\{selector}+2$;\2\6
+\\{get\_x\_next};\6
+\&{end};\par
+\fi
+
+\M1024. \P$\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}%
+\S$\6
+$\\{primitive}(\.{"batchmode"},\39\\{mode\_command},\39\\{batch\_mode})$;\5
+$\\{primitive}(\.{"nonstopmode"},\39\\{mode\_command},\39\\{nonstop\_mode})$;\5
+$\\{primitive}(\.{"scrollmode"},\39\\{mode\_command},\39\\{scroll\_mode})$;\5
+$\\{primitive}(\.{"errorstopmode"},\39\\{mode\_command},\39\\{error\_stop%
+\_mode})$;\par
+\fi
+
+\M1025. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{mode\_command}: \37\&{case} $\|m$ \1\&{of}\6
+\4\\{batch\_mode}: \37$\\{print}(\.{"batchmode"})$;\6
+\4\\{nonstop\_mode}: \37$\\{print}(\.{"nonstopmode"})$;\6
+\4\\{scroll\_mode}: \37$\\{print}(\.{"scrollmode"})$;\6
+\4\&{othercases} \37$\\{print}(\.{"errorstopmode"})$\2\6
+\&{endcases};\par
+\fi
+
+\M1026. The `\&{inner}' and `\&{outer}' commands are only slightly harder.
+
+\Y\P$\4\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{protection\_command}: \37\\{do\_protection};\par
+\fi
+
+\M1027. \P$\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}%
+\S$\6
+$\\{primitive}(\.{"inner"},\39\\{protection\_command},\390)$;\6
+$\\{primitive}(\.{"outer"},\39\\{protection\_command},\391)$;\par
+\fi
+
+\M1028. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{protection\_command}: \37\&{if} $\|m=0$ \1\&{then}\5
+$\\{print}(\.{"inner"})$\ \&{else} $\\{print}(\.{"outer"})$;\2\par
+\fi
+
+\M1029. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_protection};\6
+\4\&{var} \37\|m: \37$0\to1$;\C{0 to unprotect, 1 to protect}\6
+\|t: \37\\{halfword};\C{the \\{eq\_type} before we change it}\2\6
+\&{begin} \37$\|m\K\\{cur\_mod}$;\6
+\1\&{repeat} \37\\{get\_symbol};\5
+$\|t\K\\{eq\_type}(\\{cur\_sym})$;\6
+\&{if} $\|m=0$ \1\&{then}\6
+\&{begin} \37\&{if} $\|t\G\\{outer\_tag}$ \1\&{then}\5
+$\\{eq\_type}(\\{cur\_sym})\K\|t-\\{outer\_tag}$;\2\6
+\&{end}\6
+\4\&{else} \&{if} $\|t<\\{outer\_tag}$ \1\&{then}\5
+$\\{eq\_type}(\\{cur\_sym})\K\|t+\\{outer\_tag}$;\2\2\6
+\\{get\_x\_next};\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$;\2\6
+\&{end};\par
+\fi
+
+\M1030. \MF\ never defines the tokens `\.(' and `\.)' to be primitives, but
+plain \MF\ begins with the declaration `\&{delimiters} \.{()}'. Such a
+declaration assigns the command code \\{left\_delimiter} to `\.{(}' and
+\\{right\_delimiter} to `\.{)}'; the \\{equiv} of each delimiter is the
+hash address of its mate.
+
+\Y\P$\4\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{delimiters}: \37\\{def\_delims};\par
+\fi
+
+\M1031. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{def\_delims};\6
+\4\&{var} \37$\\{l\_delim},\39\\{r\_delim}$: \37\\{pointer};\C{the new
+delimiter pair}\2\6
+\&{begin} \37\\{get\_clear\_symbol};\5
+$\\{l\_delim}\K\\{cur\_sym}$;\6
+\\{get\_clear\_symbol};\5
+$\\{r\_delim}\K\\{cur\_sym}$;\6
+$\\{eq\_type}(\\{l\_delim})\K\\{left\_delimiter}$;\5
+$\\{equiv}(\\{l\_delim})\K\\{r\_delim}$;\6
+$\\{eq\_type}(\\{r\_delim})\K\\{right\_delimiter}$;\5
+$\\{equiv}(\\{r\_delim})\K\\{l\_delim}$;\6
+\\{get\_x\_next};\6
+\&{end};\par
+\fi
+
+\M1032. Here is a procedure that is called when \MF\ has reached a point
+where some right delimiter is mandatory.
+
+\Y\P$\4\X1032:Declare the procedure called \\{check\_delimiter}\X\S$\6
+\4\&{procedure}\1\ \37$\\{check\_delimiter}(\\{l\_delim},\39\\{r\_delim}:%
+\\{pointer})$;\6
+\4\&{label} \37\\{exit};\2\6
+\&{begin} \37\&{if} $\\{cur\_cmd}=\\{right\_delimiter}$ \1\&{then}\6
+\&{if} $\\{cur\_mod}=\\{l\_delim}$ \1\&{then}\5
+\&{return};\2\2\6
+\&{if} $\\{cur\_sym}\I\\{r\_delim}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\\{text}(\\{r\_delim}))$;\6
+$\\{help2}(\.{"I\ found\ no\ right\ delimiter\ to\ match\ a\ left\ one.\ So\ I%
+\'ve"})$\6
+$(\.{"put\ one\ in,\ behind\ the\ scenes;\ this\ may\ fix\ the\ problem."})$;\5
+\\{back\_error};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"The\ token\ \`"})$;\5
+$\\{slow\_print}(\\{text}(\\{r\_delim}))$;\5
+$\\{print}(\.{"\'\ is\ no\ longer\ a\ right\ delimiter"})$;\5
+$\\{help3}(\.{"Strange:\ This\ token\ has\ lost\ its\ former\ meaning!"})$\6
+$(\.{"I\'ll\ read\ it\ as\ a\ right\ delimiter\ this\ time;"})$\6
+$(\.{"but\ watch\ out,\ I\'ll\ probably\ miss\ it\ later."})$;\5
+\\{error};\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\U697.\fi
+
+\M1033. The next four commands save or change the values associated with
+tokens.
+
+\Y\P$\4\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{save\_command}: \37\1\&{repeat} \37\\{get\_symbol};\5
+$\\{save\_variable}(\\{cur\_sym})$;\5
+\\{get\_x\_next};\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$;\2\6
+\4\\{interim\_command}: \37\\{do\_interim};\6
+\4\\{let\_command}: \37\\{do\_let};\6
+\4\\{new\_internal}: \37\\{do\_new\_internal};\par
+\fi
+
+\M1034. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_statement};\5
+\\{forward};\5
+\hbox{\2}\6
+\4\&{procedure}\1\ \37\\{do\_interim};\2\6
+\&{begin} \37\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}\I\\{internal\_quantity}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"The\ token\ \`"})$;\6
+\&{if} $\\{cur\_sym}=0$ \1\&{then}\5
+$\\{print}(\.{"(\%CAPSULE)"})$\6
+\4\&{else} $\\{slow\_print}(\\{text}(\\{cur\_sym}))$;\2\6
+$\\{print}(\.{"\'\ isn\'t\ an\ internal\ quantity"})$;\5
+$\\{help1}(\.{"Something\ like\ \`tracingonline\'\ should\ follow\ \`interim%
+\'."})$;\5
+\\{back\_error};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{save\_internal}(\\{cur\_mod})$;\5
+\\{back\_input};\6
+\&{end};\2\6
+\\{do\_statement};\6
+\&{end};\par
+\fi
+
+\M1035. The following procedure is careful not to undefine the left-hand symbol
+too soon, lest commands like `{\tt let x=x}' have a surprising effect.
+
+\Y\P$\4\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_let};\6
+\4\&{var} \37\|l: \37\\{pointer};\C{hash location of the left-hand symbol}\2\6
+\&{begin} \37\\{get\_symbol};\5
+$\|l\K\\{cur\_sym}$;\5
+\\{get\_x\_next};\6
+\&{if} $\\{cur\_cmd}\I\\{equals}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}\I\\{assignment}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{"="})$;\5
+$\\{help3}(\.{"You\ should\ have\ said\ \`let\ symbol\ =\ something\'."})$\6
+$(\.{"But\ don\'t\ worry;\ I\'ll\ pretend\ that\ an\ equals\ sign"})$\6
+$(\.{"was\ present.\ The\ next\ token\ I\ read\ will\ be\ \`something\'."})$;\5
+\\{back\_error};\6
+\&{end};\2\2\6
+\\{get\_symbol};\6
+\&{case} $\\{cur\_cmd}$ \1\&{of}\6
+\4$\\{defined\_macro},\39\\{secondary\_primary\_macro},\39\\{tertiary%
+\_secondary\_macro},\39\\{expression\_tertiary\_macro}$: \37$\\{add\_mac\_ref}(%
+\\{cur\_mod})$;\6
+\4\&{othercases} \37\\{do\_nothing}\2\6
+\&{endcases};\6
+$\\{clear\_symbol}(\|l,\39\\{false})$;\5
+$\\{eq\_type}(\|l)\K\\{cur\_cmd}$;\6
+\&{if} $\\{cur\_cmd}=\\{tag\_token}$ \1\&{then}\5
+$\\{equiv}(\|l)\K\\{null}$\6
+\4\&{else} $\\{equiv}(\|l)\K\\{cur\_mod}$;\2\6
+\\{get\_x\_next};\6
+\&{end};\par
+\fi
+
+\M1036. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_new\_internal};\2\6
+\&{begin} \37\1\&{repeat} \37\&{if} $\\{int\_ptr}=\\{max\_internal}$ \1\&{then}%
+\5
+$\\{overflow}(\.{"number\ of\ internals"},\39\\{max\_internal})$;\2\6
+\\{get\_clear\_symbol};\5
+$\\{incr}(\\{int\_ptr})$;\5
+$\\{eq\_type}(\\{cur\_sym})\K\\{internal\_quantity}$;\5
+$\\{equiv}(\\{cur\_sym})\K\\{int\_ptr}$;\5
+$\\{int\_name}[\\{int\_ptr}]\K\\{text}(\\{cur\_sym})$;\5
+$\\{internal}[\\{int\_ptr}]\K0$;\5
+\\{get\_x\_next};\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$;\2\6
+\&{end};\par
+\fi
+
+\M1037. The various `\&{show}' commands are distinguished by modifier fields
+in the usual way.
+
+\Y\P\D \37$\\{show\_token\_code}=0$\C{show the meaning of a single token}\par
+\P\D \37$\\{show\_stats\_code}=1$\C{show current memory and string usage}\par
+\P\D \37$\\{show\_code}=2$\C{show a list of expressions}\par
+\P\D \37$\\{show\_var\_code}=3$\C{show a variable and its descendents}\par
+\P\D \37$\\{show\_dependencies\_code}=4$\C{show dependent variables in terms of
+independents}\par
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"showtoken"},\39\\{show\_command},\39\\{show\_token\_code})$;%
+\6
+$\\{primitive}(\.{"showstats"},\39\\{show\_command},\39\\{show\_stats\_code})$;%
+\6
+$\\{primitive}(\.{"show"},\39\\{show\_command},\39\\{show\_code})$;\6
+$\\{primitive}(\.{"showvariable"},\39\\{show\_command},\39\\{show\_var%
+\_code})$;\6
+$\\{primitive}(\.{"showdependencies"},\39\\{show\_command},\39\\{show%
+\_dependencies\_code})$;\par
+\fi
+
+\M1038. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{show\_command}: \37\&{case} $\|m$ \1\&{of}\6
+\4\\{show\_token\_code}: \37$\\{print}(\.{"showtoken"})$;\6
+\4\\{show\_stats\_code}: \37$\\{print}(\.{"showstats"})$;\6
+\4\\{show\_code}: \37$\\{print}(\.{"show"})$;\6
+\4\\{show\_var\_code}: \37$\\{print}(\.{"showvariable"})$;\6
+\4\&{othercases} \37$\\{print}(\.{"showdependencies"})$\2\6
+\&{endcases};\par
+\fi
+
+\M1039. \P$\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{show\_command}: \37\\{do\_show\_whatever};\par
+\fi
+
+\M1040. The value of \\{cur\_mod} controls the \\{verbosity} in the \\{print%
+\_exp} routine:
+If it's \\{show\_code}, complicated structures are abbreviated, otherwise
+they aren't.
+
+\Y\P$\4\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_show};\2\6
+\&{begin} \37\1\&{repeat} \37\\{get\_x\_next};\5
+\\{scan\_expression};\5
+$\\{print\_nl}(\.{">>\ "})$;\5
+$\\{print\_exp}(\\{null},\392)$;\5
+$\\{flush\_cur\_exp}(0)$;\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$;\2\6
+\&{end};\par
+\fi
+
+\M1041. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{disp\_token};\2\6
+\&{begin} \37$\\{print\_nl}(\.{">\ "})$;\6
+\&{if} $\\{cur\_sym}=0$ \1\&{then}\5
+\X1042:Show a numeric or string or capsule token\X\6
+\4\&{else} \&{begin} \37$\\{slow\_print}(\\{text}(\\{cur\_sym}))$;\5
+$\\{print\_char}(\.{"="})$;\6
+\&{if} $\\{eq\_type}(\\{cur\_sym})\G\\{outer\_tag}$ \1\&{then}\5
+$\\{print}(\.{"(outer)\ "})$;\2\6
+$\\{print\_cmd\_mod}(\\{cur\_cmd},\39\\{cur\_mod})$;\6
+\&{if} $\\{cur\_cmd}=\\{defined\_macro}$ \1\&{then}\6
+\&{begin} \37\\{print\_ln};\5
+$\\{show\_macro}(\\{cur\_mod},\39\\{null},\39100000)$;\6
+\&{end};\C{this avoids recursion between \\{show\_macro} and \\{print\_cmd%
+\_mod}}\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M1042. \P$\X1042:Show a numeric or string or capsule token\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_cmd}=\\{numeric\_token}$ \1\&{then}\5
+$\\{print\_scaled}(\\{cur\_mod})$\6
+\4\&{else} \&{if} $\\{cur\_cmd}=\\{capsule\_token}$ \1\&{then}\6
+\&{begin} \37$\\{g\_pointer}\K\\{cur\_mod}$;\5
+\\{print\_capsule};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{print\_char}(\.{""}\.{""})$;\5
+$\\{slow\_print}(\\{cur\_mod})$;\5
+$\\{print\_char}(\.{""}\.{""})$;\5
+$\\{delete\_str\_ref}(\\{cur\_mod})$;\6
+\&{end};\2\2\6
+\&{end}\par
+\U1041.\fi
+
+\M1043. The following cases of \\{print\_cmd\_mod} might arise in connection
+with \\{disp\_token}, although they don't correspond to any
+primitive tokens.
+
+\Y\P$\4\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of primitives\X%
+\mathrel{+}\S$\6
+\4$\\{left\_delimiter},\39\\{right\_delimiter}$: \37\&{begin} \37\&{if} $\|c=%
+\\{left\_delimiter}$ \1\&{then}\5
+$\\{print}(\.{"lef"})$\6
+\4\&{else} $\\{print}(\.{"righ"})$;\2\6
+$\\{print}(\.{"t\ delimiter\ that\ matches\ "})$;\5
+$\\{slow\_print}(\\{text}(\|m))$;\6
+\&{end};\6
+\4\\{tag\_token}: \37\&{if} $\|m=\\{null}$ \1\&{then}\5
+$\\{print}(\.{"tag"})$\ \&{else} $\\{print}(\.{"variable"})$;\2\6
+\4\\{defined\_macro}: \37$\\{print}(\.{"macro:"})$;\6
+\4$\\{secondary\_primary\_macro},\39\\{tertiary\_secondary\_macro},\39%
+\\{expression\_tertiary\_macro}$: \37\&{begin} \37$\\{print\_cmd\_mod}(\\{macro%
+\_def},\39\|c)$;\5
+$\\{print}(\.{"\'d\ macro:"})$;\5
+\\{print\_ln};\5
+$\\{show\_token\_list}(\\{link}(\\{link}(\|m)),\39\\{null},\391000,\390)$;\6
+\&{end};\6
+\4\\{repeat\_loop}: \37$\\{print}(\.{"[repeat\ the\ loop]"})$;\6
+\4\\{internal\_quantity}: \37$\\{slow\_print}(\\{int\_name}[\|m])$;\par
+\fi
+
+\M1044. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_show\_token};\2\6
+\&{begin} \37\1\&{repeat} \37\\{get\_next};\5
+\\{disp\_token};\5
+\\{get\_x\_next};\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$;\2\6
+\&{end};\par
+\fi
+
+\M1045. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_show\_stats};\2\6
+\&{begin} \37$\\{print\_nl}(\.{"Memory\ usage\ "})$;\6
+\&{stat} \37$\\{print\_int}(\\{var\_used})$;\5
+$\\{print\_char}(\.{"\&"})$;\5
+$\\{print\_int}(\\{dyn\_used})$;\6
+\&{if} $\\{false}$ \1\&{then}\ \2\6
+\&{tats}\hbox{}\6
+$\\{print}(\.{"unknown"})$;\5
+$\\{print}(\.{"\ ("})$;\5
+$\\{print\_int}(\\{hi\_mem\_min}-\\{lo\_mem\_max}-1)$;\5
+$\\{print}(\.{"\ still\ untouched)"})$;\5
+\\{print\_ln};\5
+$\\{print\_nl}(\.{"String\ usage\ "})$;\5
+$\\{print\_int}(\\{str\_ptr}-\\{init\_str\_ptr})$;\5
+$\\{print\_char}(\.{"\&"})$;\5
+$\\{print\_int}(\\{pool\_ptr}-\\{init\_pool\_ptr})$;\5
+$\\{print}(\.{"\ ("})$;\5
+$\\{print\_int}(\\{max\_strings}-\\{max\_str\_ptr})$;\5
+$\\{print\_char}(\.{"\&"})$;\5
+$\\{print\_int}(\\{pool\_size}-\\{max\_pool\_ptr})$;\5
+$\\{print}(\.{"\ still\ untouched)"})$;\5
+\\{print\_ln};\5
+\\{get\_x\_next};\6
+\&{end};\par
+\fi
+
+\M1046. Here's a recursive procedure that gives an abbreviated account
+of a variable, for use by \\{do\_show\_var}.
+
+\Y\P$\4\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{disp\_var}(\|p:\\{pointer})$;\6
+\4\&{var} \37\|q: \37\\{pointer};\C{traverses attributes and subscripts}\6
+\|n: \37$0\to\\{max\_print\_line}$;\C{amount of macro text to show}\2\6
+\&{begin} \37\&{if} $\\{type}(\|p)=\\{structured}$ \1\&{then}\5
+\X1047:Descend the structure\X\6
+\4\&{else} \&{if} $\\{type}(\|p)\G\\{unsuffixed\_macro}$ \1\&{then}\5
+\X1048:Display a variable macro\X\6
+\4\&{else} \&{if} $\\{type}(\|p)\I\\{undefined}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{""})$;\5
+$\\{print\_variable\_name}(\|p)$;\5
+$\\{print\_char}(\.{"="})$;\5
+$\\{print\_exp}(\|p,\390)$;\6
+\&{end};\2\2\2\6
+\&{end};\par
+\fi
+
+\M1047. \P$\X1047:Descend the structure\X\S$\6
+\&{begin} \37$\|q\K\\{attr\_head}(\|p)$;\6
+\1\&{repeat} \37$\\{disp\_var}(\|q)$;\5
+$\|q\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\|q=\\{end\_attr}$;\2\6
+$\|q\K\\{subscr\_head}(\|p)$;\6
+\&{while} $\\{name\_type}(\|q)=\\{subscr}$ \1\&{do}\6
+\&{begin} \37$\\{disp\_var}(\|q)$;\5
+$\|q\K\\{link}(\|q)$;\6
+\&{end};\2\6
+\&{end}\par
+\U1046.\fi
+
+\M1048. \P$\X1048:Display a variable macro\X\S$\6
+\&{begin} \37$\\{print\_nl}(\.{""})$;\5
+$\\{print\_variable\_name}(\|p)$;\6
+\&{if} $\\{type}(\|p)>\\{unsuffixed\_macro}$ \1\&{then}\5
+$\\{print}(\.{"@\#"})$;\C{\\{suffixed\_macro}}\2\6
+$\\{print}(\.{"=macro:"})$;\6
+\&{if} $\\{file\_offset}\G\\{max\_print\_line}-20$ \1\&{then}\5
+$\|n\K5$\6
+\4\&{else} $\|n\K\\{max\_print\_line}-\\{file\_offset}-15$;\2\6
+$\\{show\_macro}(\\{value}(\|p),\39\\{null},\39\|n)$;\6
+\&{end}\par
+\U1046.\fi
+
+\M1049. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_show\_var};\6
+\4\&{label} \37\\{done};\2\6
+\&{begin} \37\1\&{repeat} \37\\{get\_next};\6
+\&{if} $\\{cur\_sym}>0$ \1\&{then}\6
+\&{if} $\\{cur\_sym}\L\\{hash\_end}$ \1\&{then}\6
+\&{if} $\\{cur\_cmd}=\\{tag\_token}$ \1\&{then}\6
+\&{if} $\\{cur\_mod}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{disp\_var}(\\{cur\_mod})$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\2\2\2\6
+\\{disp\_token};\6
+\4\\{done}: \37\\{get\_x\_next};\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$;\2\6
+\&{end};\par
+\fi
+
+\M1050. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_show\_dependencies};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{link that runs through all dependencies}\2\6
+\&{begin} \37$\|p\K\\{link}(\\{dep\_head})$;\6
+\&{while} $\|p\I\\{dep\_head}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{interesting}(\|p)$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{""})$;\5
+$\\{print\_variable\_name}(\|p)$;\6
+\&{if} $\\{type}(\|p)=\\{dependent}$ \1\&{then}\5
+$\\{print\_char}(\.{"="})$\6
+\4\&{else} $\\{print}(\.{"\ =\ "})$;\C{extra spaces imply proto-dependency}\2\6
+$\\{print\_dependency}(\\{dep\_list}(\|p),\39\\{type}(\|p))$;\6
+\&{end};\2\6
+$\|p\K\\{dep\_list}(\|p)$;\6
+\&{while} $\\{info}(\|p)\I\\{null}$ \1\&{do}\5
+$\|p\K\\{link}(\|p)$;\2\6
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\\{get\_x\_next};\6
+\&{end};\par
+\fi
+
+\M1051. Finally we are ready for the procedure that governs all of the
+show commands.
+
+\Y\P$\4\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_show\_whatever};\2\6
+\&{begin} \37\&{if} $\\{interaction}=\\{error\_stop\_mode}$ \1\&{then}\5
+\\{wake\_up\_terminal};\2\6
+\&{case} $\\{cur\_mod}$ \1\&{of}\6
+\4\\{show\_token\_code}: \37\\{do\_show\_token};\6
+\4\\{show\_stats\_code}: \37\\{do\_show\_stats};\6
+\4\\{show\_code}: \37\\{do\_show};\6
+\4\\{show\_var\_code}: \37\\{do\_show\_var};\6
+\4\\{show\_dependencies\_code}: \37\\{do\_show\_dependencies};\2\6
+\&{end};\C{there are no other cases}\6
+\&{if} $\\{internal}[\\{showstopping}]>0$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"OK"})$;\6
+\&{if} $\\{interaction}<\\{error\_stop\_mode}$ \1\&{then}\6
+\&{begin} \37\\{help0};\5
+$\\{decr}(\\{error\_count})$;\6
+\&{end}\6
+\4\&{else} $\\{help1}(\.{"This\ isn\'t\ an\ error\ message;\ I\'m\ just\
+showing\ something."})$;\2\6
+\&{if} $\\{cur\_cmd}=\\{semicolon}$ \1\&{then}\5
+\\{error}\ \&{else} \\{put\_get\_error};\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M1052. The `\&{addto}' command needs the following additional primitives:
+
+\Y\P\D \37$\\{drop\_code}=0$\C{command modifier for `\&{dropping}'}\par
+\P\D \37$\\{keep\_code}=1$\C{command modifier for `\&{keeping}'}\par
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"contour"},\39\\{thing\_to\_add},\39\\{contour\_code})$;\6
+$\\{primitive}(\.{"doublepath"},\39\\{thing\_to\_add},\39\\{double\_path%
+\_code})$;\6
+$\\{primitive}(\.{"also"},\39\\{thing\_to\_add},\39\\{also\_code})$;\6
+$\\{primitive}(\.{"withpen"},\39\\{with\_option},\39\\{pen\_type})$;\6
+$\\{primitive}(\.{"withweight"},\39\\{with\_option},\39\\{known})$;\6
+$\\{primitive}(\.{"dropping"},\39\\{cull\_op},\39\\{drop\_code})$;\6
+$\\{primitive}(\.{"keeping"},\39\\{cull\_op},\39\\{keep\_code})$;\par
+\fi
+
+\M1053. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{thing\_to\_add}: \37\&{if} $\|m=\\{contour\_code}$ \1\&{then}\5
+$\\{print}(\.{"contour"})$\6
+\4\&{else} \&{if} $\|m=\\{double\_path\_code}$ \1\&{then}\5
+$\\{print}(\.{"doublepath"})$\6
+\4\&{else} $\\{print}(\.{"also"})$;\2\2\6
+\4\\{with\_option}: \37\&{if} $\|m=\\{pen\_type}$ \1\&{then}\5
+$\\{print}(\.{"withpen"})$\6
+\4\&{else} $\\{print}(\.{"withweight"})$;\2\6
+\4\\{cull\_op}: \37\&{if} $\|m=\\{drop\_code}$ \1\&{then}\5
+$\\{print}(\.{"dropping"})$\6
+\4\&{else} $\\{print}(\.{"keeping"})$;\2\par
+\fi
+
+\M1054. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{function}\1\ \37\\{scan\_with}: \37\\{boolean};\6
+\4\&{var} \37\|t: \37\\{small\_number};\C{\\{known} or \\{pen\_type}}\6
+\\{result}: \37\\{boolean};\C{the value to return}\2\6
+\&{begin} \37$\|t\K\\{cur\_mod}$;\5
+$\\{cur\_type}\K\\{vacuous}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\5
+$\\{result}\K\\{false}$;\6
+\&{if} $\\{cur\_type}\I\|t$ \1\&{then}\5
+\X1055:Complain about improper type\X\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{pen\_type}$ \1\&{then}\5
+$\\{result}\K\\{true}$\6
+\4\&{else} \X1056:Check the tentative weight\X;\2\2\6
+$\\{scan\_with}\K\\{result}$;\6
+\&{end};\par
+\fi
+
+\M1055. \P$\X1055:Complain about improper type\X\S$\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ type"})$;\5
+$\\{help2}(\.{"Next\ time\ say\ \`withweight\ <known\ numeric\ expression>%
+\';"})$\6
+$(\.{"I\'ll\ ignore\ the\ bad\ \`with\'\ clause\ and\ look\ for\ another."})$;\6
+\&{if} $\|t=\\{pen\_type}$ \1\&{then}\5
+$\\{help\_line}[1]\K\.{"Next\ time\ say\ \`withpen\ <known\ pen\ expression>%
+\';"}$;\2\6
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end}\par
+\U1054.\fi
+
+\M1056. \P$\X1056:Check the tentative weight\X\S$\6
+\&{begin} \37$\\{cur\_exp}\K\\{round\_unscaled}(\\{cur\_exp})$;\6
+\&{if} $(\\{abs}(\\{cur\_exp})<4)\W(\\{cur\_exp}\I0)$ \1\&{then}\5
+$\\{result}\K\\{true}$\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"Weight\ must\ be\ -3,\ -2,\ -1,\
++1,\ +2,\ or\ +3"})$;\5
+$\\{help1}(\.{"I\'ll\ ignore\ the\ bad\ \`with\'\ clause\ and\ look\ for\
+another."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end};\2\6
+\&{end}\par
+\U1054.\fi
+
+\M1057. One of the things we need to do when we've parsed an \&{addto} or
+similar command is set \\{cur\_edges} to the header of a supposed \&{picture}
+variable, given a token list for that variable.
+
+\Y\P$\4\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{find\_edges\_var}(\|t:\\{pointer})$;\6
+\4\&{var} \37\|p: \37\\{pointer};\2\6
+\&{begin} \37$\|p\K\\{find\_variable}(\|t)$;\5
+$\\{cur\_edges}\K\\{null}$;\6
+\&{if} $\|p=\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{obliterated}(\|t)$;\5
+\\{put\_get\_error};\6
+\&{end}\6
+\4\&{else} \&{if} $\\{type}(\|p)\I\\{picture\_type}$ \1\&{then}\6
+\&{begin} \37$\\{print\_err}(\.{"Variable\ "})$;\5
+$\\{show\_token\_list}(\|t,\39\\{null},\391000,\390)$;\5
+$\\{print}(\.{"\ is\ the\ wrong\ type\ ("})$;\5
+$\\{print\_type}(\\{type}(\|p))$;\5
+$\\{print\_char}(\.{")"})$;\5
+$\\{help2}(\.{"I\ was\ looking\ for\ a\ "}\.{"known"}\.{"\ picture\
+variable."})$\6
+$(\.{"So\ I\'ll\ not\ change\ anything\ just\ now."})$;\5
+\\{put\_get\_error};\6
+\&{end}\6
+\4\&{else} $\\{cur\_edges}\K\\{value}(\|p)$;\2\2\6
+$\\{flush\_node\_list}(\|t)$;\6
+\&{end};\par
+\fi
+
+\M1058. \P$\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{add\_to\_command}: \37\\{do\_add\_to};\par
+\fi
+
+\M1059. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_add\_to};\6
+\4\&{label} \37$\\{done},\39\\{not\_found}$;\6
+\4\&{var} \37$\\{lhs},\39\\{rhs}$: \37\\{pointer};\C{variable on left, path on
+right}\6
+\|w: \37\\{integer};\C{tentative weight}\6
+\|p: \37\\{pointer};\C{list manipulation register}\6
+\|q: \37\\{pointer};\C{beginning of second half of doubled path}\6
+\\{add\_to\_type}: \37$\\{double\_path\_code}\to\\{also\_code}$;\C{modifier of %
+\&{addto}}\2\6
+\&{begin} \37\\{get\_x\_next};\5
+$\\{var\_flag}\K\\{thing\_to\_add}$;\5
+\\{scan\_primary};\6
+\&{if} $\\{cur\_type}\I\\{token\_list}$ \1\&{then}\5
+\X1060:Abandon edges command because there's no variable\X\6
+\4\&{else} \&{begin} \37$\\{lhs}\K\\{cur\_exp}$;\5
+$\\{add\_to\_type}\K\\{cur\_mod}$;\6
+$\\{cur\_type}\K\\{vacuous}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{add\_to\_type}=\\{also\_code}$ \1\&{then}\5
+\X1061:Augment some edges by others\X\6
+\4\&{else} \X1062:Get ready to fill a contour, and fill it\X;\2\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M1060. \P$\X1060:Abandon edges command because there's no variable\X\S$\6
+\&{begin} \37$\\{exp\_err}(\.{"Not\ a\ suitable\ variable"})$;\5
+$\\{help4}(\.{"At\ this\ point\ I\ needed\ to\ see\ the\ name\ of\ a\ picture\
+variable."})$\6
+$(\.{"(Or\ perhaps\ you\ have\ indeed\ presented\ me\ with\ one;\ I\ might"})$\6
+$(\.{"have\ missed\ it,\ if\ it\ wasn\'t\ followed\ by\ the\ proper\
+token.)"})$\6
+$(\.{"So\ I\'ll\ not\ change\ anything\ just\ now."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end}\par
+\Us1059, 1070, 1071\ETs1074.\fi
+
+\M1061. \P$\X1061:Augment some edges by others\X\S$\6
+\&{begin} \37$\\{find\_edges\_var}(\\{lhs})$;\6
+\&{if} $\\{cur\_edges}=\\{null}$ \1\&{then}\5
+$\\{flush\_cur\_exp}(0)$\6
+\4\&{else} \&{if} $\\{cur\_type}\I\\{picture\_type}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ \`addto\'"})$;\5
+$\\{help2}(\.{"This\ expression\ should\ have\ specified\ a\ known\
+picture."})$\6
+$(\.{"So\ I\'ll\ not\ change\ anything\ just\ now."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{merge\_edges}(\\{cur\_exp})$;\5
+$\\{flush\_cur\_exp}(0)$;\6
+\&{end};\2\2\6
+\&{end}\par
+\U1059.\fi
+
+\M1062. \P$\X1062:Get ready to fill a contour, and fill it\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_type}=\\{pair\_type}$ \1\&{then}\5
+\\{pair\_to\_path};\2\6
+\&{if} $\\{cur\_type}\I\\{path\_type}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ \`addto\'"})$;\5
+$\\{help2}(\.{"This\ expression\ should\ have\ been\ a\ known\ path."})$\6
+$(\.{"So\ I\'ll\ not\ change\ anything\ just\ now."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\5
+$\\{flush\_token\_list}(\\{lhs})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{rhs}\K\\{cur\_exp}$;\5
+$\|w\K1$;\5
+$\\{cur\_pen}\K\\{null\_pen}$;\6
+\&{while} $\\{cur\_cmd}=\\{with\_option}$ \1\&{do}\6
+\&{if} $\\{scan\_with}$ \1\&{then}\6
+\&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\5
+$\|w\K\\{cur\_exp}$\6
+\4\&{else} \X1063:Change the tentative pen\X;\2\2\2\6
+\X1064:Complete the contour filling operation\X;\6
+$\\{delete\_pen\_ref}(\\{cur\_pen})$;\6
+\&{end};\2\6
+\&{end}\par
+\U1059.\fi
+
+\M1063. We could say `$\\{add\_pen\_ref}(\\{cur\_pen})$; $\\{flush\_cur%
+\_exp}(0)$' after changing
+\\{cur\_pen} here. But that would have no effect, because the current
+expression
+will not be flushed. Thus we save a bit of code (at the risk of being too
+tricky).
+
+\Y\P$\4\X1063:Change the tentative pen\X\S$\6
+\&{begin} \37$\\{delete\_pen\_ref}(\\{cur\_pen})$;\5
+$\\{cur\_pen}\K\\{cur\_exp}$;\6
+\&{end}\par
+\U1062.\fi
+
+\M1064. \P$\X1064:Complete the contour filling operation\X\S$\6
+$\\{find\_edges\_var}(\\{lhs})$;\6
+\&{if} $\\{cur\_edges}=\\{null}$ \1\&{then}\5
+$\\{toss\_knot\_list}(\\{rhs})$\6
+\4\&{else} \&{begin} \37$\\{lhs}\K\\{null}$;\5
+$\\{cur\_path\_type}\K\\{add\_to\_type}$;\6
+\&{if} $\\{left\_type}(\\{rhs})=\\{endpoint}$ \1\&{then}\6
+\&{if} $\\{cur\_path\_type}=\\{double\_path\_code}$ \1\&{then}\5
+\X1065:Double the path\X\6
+\4\&{else} \X1067:Complain about non-cycle and \&{goto} \\{not\_found}\X\2\6
+\4\&{else} \&{if} $\\{cur\_path\_type}=\\{double\_path\_code}$ \1\&{then}\5
+$\\{lhs}\K\\{htap\_ypoc}(\\{rhs})$;\2\2\6
+$\\{cur\_wt}\K\|w$;\5
+$\\{rhs}\K\\{make\_spec}(\\{rhs},\39\\{max\_offset}(\\{cur\_pen}),\39%
+\\{internal}[\\{tracing\_specs}])$;\5
+\X1068:Check the turning number\X;\6
+\&{if} $\\{max\_offset}(\\{cur\_pen})=0$ \1\&{then}\5
+$\\{fill\_spec}(\\{rhs})$\6
+\4\&{else} $\\{fill\_envelope}(\\{rhs})$;\2\6
+\&{if} $\\{lhs}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\\{rev\_turns}\K\\{true}$;\5
+$\\{lhs}\K\\{make\_spec}(\\{lhs},\39\\{max\_offset}(\\{cur\_pen}),\39%
+\\{internal}[\\{tracing\_specs}])$;\5
+$\\{rev\_turns}\K\\{false}$;\6
+\&{if} $\\{max\_offset}(\\{cur\_pen})=0$ \1\&{then}\5
+$\\{fill\_spec}(\\{lhs})$\6
+\4\&{else} $\\{fill\_envelope}(\\{lhs})$;\2\6
+\&{end};\2\6
+\4\\{not\_found}: \37\&{end}\2\par
+\U1062.\fi
+
+\M1065. \P$\X1065:Double the path\X\S$\6
+\&{if} $\\{link}(\\{rhs})=\\{rhs}$ \1\&{then}\5
+\X1066:Make a trivial one-point path cycle\X\6
+\4\&{else} \&{begin} \37$\|p\K\\{htap\_ypoc}(\\{rhs})$;\5
+$\|q\K\\{link}(\|p)$;\6
+$\\{right\_x}(\\{path\_tail})\K\\{right\_x}(\|q)$;\5
+$\\{right\_y}(\\{path\_tail})\K\\{right\_y}(\|q)$;\5
+$\\{right\_type}(\\{path\_tail})\K\\{right\_type}(\|q)$;\5
+$\\{link}(\\{path\_tail})\K\\{link}(\|q)$;\5
+$\\{free\_node}(\|q,\39\\{knot\_node\_size})$;\6
+$\\{right\_x}(\|p)\K\\{right\_x}(\\{rhs})$;\5
+$\\{right\_y}(\|p)\K\\{right\_y}(\\{rhs})$;\5
+$\\{right\_type}(\|p)\K\\{right\_type}(\\{rhs})$;\5
+$\\{link}(\|p)\K\\{link}(\\{rhs})$;\5
+$\\{free\_node}(\\{rhs},\39\\{knot\_node\_size})$;\6
+$\\{rhs}\K\|p$;\6
+\&{end}\2\par
+\U1064.\fi
+
+\M1066. \P$\X1066:Make a trivial one-point path cycle\X\S$\6
+\&{begin} \37$\\{right\_x}(\\{rhs})\K\\{x\_coord}(\\{rhs})$;\5
+$\\{right\_y}(\\{rhs})\K\\{y\_coord}(\\{rhs})$;\5
+$\\{left\_x}(\\{rhs})\K\\{x\_coord}(\\{rhs})$;\5
+$\\{left\_y}(\\{rhs})\K\\{y\_coord}(\\{rhs})$;\5
+$\\{left\_type}(\\{rhs})\K\\{explicit}$;\5
+$\\{right\_type}(\\{rhs})\K\\{explicit}$;\6
+\&{end}\par
+\U1065.\fi
+
+\M1067. \P$\X1067:Complain about non-cycle and \&{goto} \\{not\_found}\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Not\ a\ cycle"})$;\5
+$\\{help2}(\.{"That\ contour\ should\ have\ ended\ with\ \`..cycle\'\ or\ \`%
+\&cycle\'."})$\6
+$(\.{"So\ I\'ll\ not\ change\ anything\ just\ now."})$;\5
+\\{put\_get\_error};\5
+$\\{toss\_knot\_list}(\\{rhs})$;\5
+\&{goto} \37\\{not\_found};\6
+\&{end}\par
+\U1064.\fi
+
+\M1068. \P$\X1068:Check the turning number\X\S$\6
+\&{if} $\\{turning\_number}\L0$ \1\&{then}\6
+\&{if} $\\{cur\_path\_type}\I\\{double\_path\_code}$ \1\&{then}\6
+\&{if} $\\{internal}[\\{turning\_check}]>0$ \1\&{then}\6
+\&{if} $(\\{turning\_number}<0)\W(\\{link}(\\{cur\_pen})=\\{null})$ \1\&{then}\5
+$\\{negate}(\\{cur\_wt})$\6
+\4\&{else} \&{begin} \37\&{if} $\\{turning\_number}=0$ \1\&{then}\6
+\&{if} $(\\{internal}[\\{turning\_check}]\L\\{unity})\W(\\{link}(\\{cur\_pen})=%
+\\{null})$ \1\&{then}\5
+\&{goto} \37\\{done}\6
+\4\&{else} $\\{print\_strange}(\.{"Strange\ path\ (turning\ number\ is\
+zero)"})$\2\6
+\4\&{else} $\\{print\_strange}(\.{"Backwards\ path\ (turning\ number\ is\
+negative)"})$;\2\6
+$\\{help3}(\.{"The\ path\ doesn\'t\ have\ a\ counterclockwise\ orientation,"})$%
+\6
+$(\.{"so\ I\'ll\ probably\ have\ trouble\ drawing\ it."})$\6
+$(\.{"(See\ Chapter\ 27\ of\ The\ METAFONTbook\ for\ more\ help.)"})$;\5
+\\{put\_get\_error};\6
+\&{end};\2\2\2\2\6
+\4\\{done}: \37\par
+\U1064.\fi
+
+\M1069. \P$\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{ship\_out\_command}: \37\\{do\_ship\_out};\6
+\4\\{display\_command}: \37\\{do\_display};\6
+\4\\{open\_window}: \37\\{do\_open\_window};\6
+\4\\{cull\_command}: \37\\{do\_cull};\par
+\fi
+
+\M1070. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\hbox{\4}\X1098:Declare the function called \\{tfm\_check}\X\6
+\4\&{procedure}\1\ \37\\{do\_ship\_out};\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|c: \37\\{integer};\C{the character code}\2\6
+\&{begin} \37\\{get\_x\_next};\5
+$\\{var\_flag}\K\\{semicolon}$;\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{token\_list}$ \1\&{then}\6
+\&{if} $\\{cur\_type}=\\{picture\_type}$ \1\&{then}\5
+$\\{cur\_edges}\K\\{cur\_exp}$\6
+\4\&{else} \&{begin} \37\X1060:Abandon edges command because there's no
+variable\X;\6
+\&{return};\6
+\&{end}\2\6
+\4\&{else} \&{begin} \37$\\{find\_edges\_var}(\\{cur\_exp})$;\5
+$\\{cur\_type}\K\\{vacuous}$;\6
+\&{end};\2\6
+\&{if} $\\{cur\_edges}\I\\{null}$ \1\&{then}\6
+\&{begin} \37$\|c\K\\{round\_unscaled}(\\{internal}[\\{char\_code}])\mathbin{%
+\&{mod}}256$;\6
+\&{if} $\|c<0$ \1\&{then}\5
+$\|c\K\|c+256$;\2\6
+\X1099:Store the width information for character code~\|c\X;\6
+\&{if} $\\{internal}[\\{proofing}]\G0$ \1\&{then}\5
+$\\{ship\_out}(\|c)$;\2\6
+\&{end};\2\6
+$\\{flush\_cur\_exp}(0)$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M1071. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_display};\6
+\4\&{label} \37$\\{not\_found},\39\\{common\_ending},\39\\{exit}$;\6
+\4\&{var} \37\|e: \37\\{pointer};\C{token list for a picture variable}\2\6
+\&{begin} \37\\{get\_x\_next};\5
+$\\{var\_flag}\K\\{in\_window}$;\5
+\\{scan\_primary};\6
+\&{if} $\\{cur\_type}\I\\{token\_list}$ \1\&{then}\5
+\X1060:Abandon edges command because there's no variable\X\6
+\4\&{else} \&{begin} \37$\|e\K\\{cur\_exp}$;\5
+$\\{cur\_type}\K\\{vacuous}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+\&{goto} \37\\{common\_ending};\2\6
+$\\{cur\_exp}\K\\{round\_unscaled}(\\{cur\_exp})$;\6
+\&{if} $\\{cur\_exp}<0$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\&{if} $\\{cur\_exp}>15$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\&{if} $\R\\{window\_open}[\\{cur\_exp}]$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\\{find\_edges\_var}(\|e)$;\6
+\&{if} $\\{cur\_edges}\I\\{null}$ \1\&{then}\5
+$\\{disp\_edges}(\\{cur\_exp})$;\2\6
+\&{return};\6
+\4\\{not\_found}: \37$\\{cur\_exp}\K\\{cur\_exp}\ast\\{unity}$;\6
+\4\\{common\_ending}: \37$\\{exp\_err}(\.{"Bad\ window\ number"})$;\5
+$\\{help1}(\.{"It\ should\ be\ the\ number\ of\ an\ open\ window."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\5
+$\\{flush\_token\_list}(\|e)$;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M1072. The only thing difficult about `\&{openwindow}' is that the syntax
+allows the user to go astray in many ways. The following subroutine
+helps keep the necessary program reasonably short and sweet.
+
+\Y\P$\4\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{function}\1\ \37$\\{get\_pair}(\|c:\\{command\_code})$: \37\\{boolean};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{a pair of values that are known (we hope)}\6
+\|b: \37\\{boolean};\C{did we find such a pair?}\2\6
+\&{begin} \37\&{if} $\\{cur\_cmd}\I\|c$ \1\&{then}\5
+$\\{get\_pair}\K\\{false}$\6
+\4\&{else} \&{begin} \37\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{nice\_pair}(\\{cur\_exp},\39\\{cur\_type})$ \1\&{then}\6
+\&{begin} \37$\|p\K\\{value}(\\{cur\_exp})$;\5
+$\\{cur\_x}\K\\{value}(\\{x\_part\_loc}(\|p))$;\5
+$\\{cur\_y}\K\\{value}(\\{y\_part\_loc}(\|p))$;\5
+$\|b\K\\{true}$;\6
+\&{end}\6
+\4\&{else} $\|b\K\\{false}$;\2\6
+$\\{flush\_cur\_exp}(0)$;\5
+$\\{get\_pair}\K\|b$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M1073. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_open\_window};\6
+\4\&{label} \37$\\{not\_found},\39\\{exit}$;\6
+\4\&{var} \37\|k: \37\\{integer};\C{the window number in question}\6
+$\\{r0},\39\\{c0},\39\\{r1},\39\\{c1}$: \37\\{scaled};\C{window coordinates}\2\6
+\&{begin} \37\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\|k\K\\{round\_unscaled}(\\{cur\_exp})$;\6
+\&{if} $\|k<0$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\&{if} $\|k>15$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\&{if} $\R\\{get\_pair}(\\{from\_token})$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\\{r0}\K\\{cur\_x}$;\5
+$\\{c0}\K\\{cur\_y}$;\6
+\&{if} $\R\\{get\_pair}(\\{to\_token})$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\\{r1}\K\\{cur\_x}$;\5
+$\\{c1}\K\\{cur\_y}$;\6
+\&{if} $\R\\{get\_pair}(\\{at\_token})$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\\{open\_a\_window}(\|k,\39\\{r0},\39\\{c0},\39\\{r1},\39\\{c1},\39\\{cur\_x},%
+\39\\{cur\_y})$;\5
+\&{return};\6
+\4\\{not\_found}: \37$\\{print\_err}(\.{"Improper\ \`openwindow\'"})$;\5
+$\\{help2}(\.{"Say\ \`openwindow\ k\ from\ (r0,c0)\ to\ (r1,c1)\ at\ (x,y)%
+\',"})$\6
+$(\.{"where\ all\ quantities\ are\ known\ and\ k\ is\ between\ 0\ and\ 15."})$;%
+\5
+\\{put\_get\_error};\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M1074. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_cull};\6
+\4\&{label} \37$\\{not\_found},\39\\{exit}$;\6
+\4\&{var} \37\|e: \37\\{pointer};\C{token list for a picture variable}\6
+\\{keeping}: \37$\\{drop\_code}\to\\{keep\_code}$;\C{modifier of \\{cull\_op}}\6
+$\|w,\39\\{w\_in},\39\\{w\_out}$: \37\\{integer};\C{culling weights}\2\6
+\&{begin} \37$\|w\K1$;\5
+\\{get\_x\_next};\5
+$\\{var\_flag}\K\\{cull\_op}$;\5
+\\{scan\_primary};\6
+\&{if} $\\{cur\_type}\I\\{token\_list}$ \1\&{then}\5
+\X1060:Abandon edges command because there's no variable\X\6
+\4\&{else} \&{begin} \37$\|e\K\\{cur\_exp}$;\5
+$\\{cur\_type}\K\\{vacuous}$;\5
+$\\{keeping}\K\\{cur\_mod}$;\6
+\&{if} $\R\\{get\_pair}(\\{cull\_op})$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\&{while} $(\\{cur\_cmd}=\\{with\_option})\W(\\{cur\_mod}=\\{known})$ \1\&{do}\6
+\&{if} $\\{scan\_with}$ \1\&{then}\5
+$\|w\K\\{cur\_exp}$;\2\2\6
+\X1075:Set up the culling weights, or \&{goto} \\{not\_found} if the thresholds
+are bad\X;\6
+$\\{find\_edges\_var}(\|e)$;\6
+\&{if} $\\{cur\_edges}\I\\{null}$ \1\&{then}\5
+$\\{cull\_edges}(\\{floor\_unscaled}(\\{cur\_x}+\\{unity}-1),\39\\{floor%
+\_unscaled}(\\{cur\_y}),\39\\{w\_out},\39\\{w\_in})$;\2\6
+\&{return};\6
+\4\\{not\_found}: \37$\\{print\_err}(\.{"Bad\ culling\ amounts"})$;\5
+$\\{help1}(\.{"Always\ cull\ by\ known\ amounts\ that\ exclude\ 0."})$;\5
+\\{put\_get\_error};\5
+$\\{flush\_token\_list}(\|e)$;\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M1075. \P$\X1075:Set up the culling weights, or \&{goto} \\{not\_found} if the
+thresholds are bad\X\S$\6
+\&{if} $\\{cur\_x}>\\{cur\_y}$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+\&{if} $\\{keeping}=\\{drop\_code}$ \1\&{then}\6
+\&{begin} \37\&{if} $(\\{cur\_x}>0)\V(\\{cur\_y}<0)$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\\{w\_out}\K\|w$;\5
+$\\{w\_in}\K0$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\&{if} $(\\{cur\_x}\L0)\W(\\{cur\_y}\G0)$ \1\&{then}\5
+\&{goto} \37\\{not\_found};\2\6
+$\\{w\_out}\K0$;\5
+$\\{w\_in}\K\|w$;\6
+\&{end}\2\par
+\U1074.\fi
+
+\M1076. The \&{everyjob} command simply assigns a nonzero value to the global
+variable
+\\{start\_sym}.
+
+\Y\P$\4\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{every\_job\_command}: \37\&{begin} \37\\{get\_symbol};\5
+$\\{start\_sym}\K\\{cur\_sym}$;\5
+\\{get\_x\_next};\6
+\&{end};\par
+\fi
+
+\M1077. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{start\_sym}: \37\\{halfword};\C{a symbolic token to insert at beginning of
+job}\par
+\fi
+
+\M1078. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{start\_sym}\K0$;\par
+\fi
+
+\M1079. Finally, we have only the ``message'' commands remaining.
+
+\Y\P\D \37$\\{message\_code}=0$\par
+\P\D \37$\\{err\_message\_code}=1$\par
+\P\D \37$\\{err\_help\_code}=2$\par
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"message"},\39\\{message\_command},\39\\{message\_code})$;\6
+$\\{primitive}(\.{"errmessage"},\39\\{message\_command},\39\\{err\_message%
+\_code})$;\6
+$\\{primitive}(\.{"errhelp"},\39\\{message\_command},\39\\{err\_help\_code})$;%
+\par
+\fi
+
+\M1080. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{message\_command}: \37\&{if} $\|m<\\{err\_message\_code}$ \1\&{then}\5
+$\\{print}(\.{"message"})$\6
+\4\&{else} \&{if} $\|m=\\{err\_message\_code}$ \1\&{then}\5
+$\\{print}(\.{"errmessage"})$\6
+\4\&{else} $\\{print}(\.{"errhelp"})$;\2\2\par
+\fi
+
+\M1081. \P$\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{message\_command}: \37\\{do\_message};\par
+\fi
+
+\M1082. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_message};\6
+\4\&{var} \37\|m: \37$\\{message\_code}\to\\{err\_help\_code}$;\C{the type of
+message}\2\6
+\&{begin} \37$\|m\K\\{cur\_mod}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{string\_type}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Not\ a\ string"})$;\5
+$\\{help1}(\.{"A\ message\ should\ be\ a\ known\ string\ expression."})$;\5
+\\{put\_get\_error};\6
+\&{end}\6
+\4\&{else} \&{case} $\|m$ \1\&{of}\6
+\4\\{message\_code}: \37\&{begin} \37$\\{print\_nl}(\.{""})$;\5
+$\\{slow\_print}(\\{cur\_exp})$;\6
+\&{end};\6
+\4\\{err\_message\_code}: \37\X1086:Print string \\{cur\_exp} as an error
+message\X;\6
+\4\\{err\_help\_code}: \37\X1083:Save string \\{cur\_exp} as the \\{err\_help}%
+\X;\2\6
+\&{end};\C{there are no other cases}\2\6
+$\\{flush\_cur\_exp}(0)$;\6
+\&{end};\par
+\fi
+
+\M1083. The global variable \\{err\_help} is zero when the user has most
+recently
+given an empty help string, or if none has ever been given.
+
+\Y\P$\4\X1083:Save string \\{cur\_exp} as the \\{err\_help}\X\S$\6
+\&{begin} \37\&{if} $\\{err\_help}\I0$ \1\&{then}\5
+$\\{delete\_str\_ref}(\\{err\_help})$;\2\6
+\&{if} $\\{length}(\\{cur\_exp})=0$ \1\&{then}\5
+$\\{err\_help}\K0$\6
+\4\&{else} \&{begin} \37$\\{err\_help}\K\\{cur\_exp}$;\5
+$\\{add\_str\_ref}(\\{err\_help})$;\6
+\&{end};\2\6
+\&{end}\par
+\U1082.\fi
+
+\M1084. If \&{errmessage} occurs often in \\{scroll\_mode}, without
+user-defined
+\&{errhelp}, we don't want to give a long help message each time. So we
+give a verbose explanation only once.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{long\_help\_seen}: \37\\{boolean};\C{has the long \&{errmessage} help been
+used?}\par
+\fi
+
+\M1085. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{long\_help\_seen}\K\\{false}$;\par
+\fi
+
+\M1086. \P$\X1086:Print string \\{cur\_exp} as an error message\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{""})$;\5
+$\\{slow\_print}(\\{cur\_exp})$;\6
+\&{if} $\\{err\_help}\I0$ \1\&{then}\5
+$\\{use\_err\_help}\K\\{true}$\6
+\4\&{else} \&{if} $\\{long\_help\_seen}$ \1\&{then}\5
+$\\{help1}(\.{"(That\ was\ another\ \`errmessage\'.)"})$\6
+\4\&{else} \&{begin} \37\&{if} $\\{interaction}<\\{error\_stop\_mode}$ \1%
+\&{then}\5
+$\\{long\_help\_seen}\K\\{true}$;\2\6
+$\\{help4}(\.{"This\ error\ message\ was\ generated\ by\ an\ \`errmessage\'"})$%
+\6
+$(\.{"command,\ so\ I\ can\'t\ give\ any\ explicit\ help."})$\6
+$(\.{"Pretend\ that\ you\'re\ Miss\ Marple:\ Examine\ all\ clues,"})$\6
+$(\.{"and\ deduce\ the\ truth\ by\ inspired\ guesses."})$;\6
+\&{end};\2\2\6
+\\{put\_get\_error};\5
+$\\{use\_err\_help}\K\\{false}$;\6
+\&{end}\par
+\U1082.\fi
+
+\N1087. \[45] Font metric data.
+\TeX\ gets its knowledge about fonts from font metric files, also called
+\.{TFM} files; the `\.T' in `\.{TFM}' stands for \TeX,
+but other programs know about them too. One of \MF's duties is to
+write \.{TFM} files so that the user's fonts can readily be
+applied to typesetting.
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of~4, we could
+also regard the file as a sequence of 32-bit words, but \MF\ uses the
+byte interpretation. The format of \.{TFM} files was designed by
+Lyle Ramshaw in 1980. The intent is to convey a lot of different kinds
+of information in a compact but useful form.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{tfm\_file}: \37\\{byte\_file};\C{the font metric output goes here}\6
+\4\\{metric\_file\_name}: \37\\{str\_number};\C{full name of the font metric
+file}\par
+\fi
+
+\M1088. The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+\\{lf}&length of the entire file, in words;\cr
+\\{lh}&length of the header data, in words;\cr
+\\{bc}&smallest character code in the font;\cr
+\\{ec}&largest character code in the font;\cr
+\\{nw}&number of words in the width table;\cr
+\\{nh}&number of words in the height table;\cr
+\\{nd}&number of words in the depth table;\cr
+\\{ni}&number of words in the italic correction table;\cr
+\\{nl}&number of words in the lig/kern table;\cr
+\\{nk}&number of words in the kern table;\cr
+\\{ne}&number of words in the extensible character table;\cr
+\\{np}&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have $\\{bc}-1\L\\{ec}%
+\L255$,
+$\\{ne}\L256$, and
+$$\hbox{$\\{lf}=6+\\{lh}+(\\{ec}-\\{bc}+1)+\\{nw}+\\{nh}+\\{nd}+\\{ni}+\\{nl}+%
+\\{nk}+\\{ne}+\\{np}$.}$$
+Note that a font may contain as many as 256 characters (if $\\{bc}=0$ and $%
+\\{ec}=255$),
+and as few as 0 characters (if $\\{bc}=\\{ec}+1$).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+
+\fi
+
+\M1089. The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\tabskip\centering
+\halign to\displaywidth{\hfil\\{#}\tabskip=0pt&$\,:\,$\arr#\hfil
+\tabskip\centering\cr
+header&$[0\to\\{lh}-1]\hbox{\\{stuff}}$\cr
+char\_info&$[\\{bc}\to\\{ec}]\\{char\_info\_word}$\cr
+width&$[0\to\\{nw}-1]\\{fix\_word}$\cr
+height&$[0\to\\{nh}-1]\\{fix\_word}$\cr
+depth&$[0\to\\{nd}-1]\\{fix\_word}$\cr
+italic&$[0\to\\{ni}-1]\\{fix\_word}$\cr
+lig\_kern&$[0\to\\{nl}-1]\\{lig\_kern\_command}$\cr
+kern&$[0\to\\{nk}-1]\\{fix\_word}$\cr
+exten&$[0\to\\{ne}-1]\\{extensible\_recipe}$\cr
+param&$[1\to\\{np}]\\{fix\_word}$\cr}$$
+The most important data type used here is a \\{fix\_word}, which is
+a 32-bit representation of a binary fraction. A \\{fix\_word} is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a \\{fix\_word}, exactly 12 are to the left of the
+binary point; thus, the largest \\{fix\_word} value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but two of
+the \\{fix\_word} values must lie between $-16$ and $+16$.
+
+\fi
+
+\M1090. The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+$\\{header}[0]$ and $\\{header}[1]$, whose meaning is explained below.
+Additional
+header information of use to other software routines might also be
+included, and \MF\ will generate it if the \.{headerbyte} command occurs.
+For example, 16 more words of header information are in use at the Xerox
+Palo Alto Research Center; the first ten specify the character coding
+scheme used (e.g., `\.{XEROX TEXT}' or `\.{TEX MATHSY}'), the next five
+give the font family name (e.g., `\.{HELVETICA}' or `\.{CMSY}'), and the
+last gives the ``face byte.''
+
+\yskip\hang$\\{header}[0]$ is a 32-bit check sum that \MF\ will copy into
+the \.{GF} output file. This helps ensure consistency between files,
+since \TeX\ records the check sums from the \.{TFM}'s it reads, and these
+should match the check sums on actual fonts that are used. The actual
+relation between this check sum and the rest of the \.{TFM} file is not
+important; the check sum is simply an identification number with the
+property that incompatible fonts almost always have distinct check sums.
+
+\yskip\hang$\\{header}[1]$ is a \\{fix\_word} containing the design size of the
+font, in units of \TeX\ points. This number must be at least 1.0; it is
+fairly arbitrary, but usually the design size is 10.0 for a ``10 point''
+font, i.e., a font that was designed to look best at a 10-point size,
+whatever that really means. When a \TeX\ user asks for a font `\.{at}
+$\delta$ \.{pt}', the effect is to override the design size and replace it
+by $\delta$, and to multiply the $x$ and~$y$ coordinates of the points in
+the font image by a factor of $\delta$ divided by the design size. {\sl
+All other dimensions in the\/ \.{TFM} file are \\{fix\_word}\kern-1pt\
+numbers in design-size units.} Thus, for example, the value of $\\{param}[6]$,
+which defines the \.{em} unit, is often the \\{fix\_word} value $2^{20}=1.0$,
+since many fonts have a design size equal to one em. The other dimensions
+must be less than 16 design-size units in absolute value; thus,
+$\\{header}[1]$ and $\\{param}[1]$ are the only \\{fix\_word} entries in the
+whole
+\.{TFM} file whose first byte might be something besides 0 or 255.
+
+\fi
+
+\M1091. Next comes the \\{char\_info} array, which contains one \\{char\_info%
+\_word}
+per character. Each word in this part of the file contains six fields
+packed into four bytes as follows.
+
+\yskip\hang first byte: \\{width\_index} (8 bits)\par
+\hang second byte: \\{height\_index} (4 bits) times 16, plus \\{depth\_index}
+(4~bits)\par
+\hang third byte: \\{italic\_index} (6 bits) times 4, plus \\{tag}
+(2~bits)\par
+\hang fourth byte: \\{remainder} (8 bits)\par
+\yskip\noindent
+The actual width of a character is \\{width}$[\\{width\_index}]$, in
+design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation $\\{width}[0]=\\{height}[0]=\\{depth}[0]=
+\\{italic}[0]=0$ should always hold, so that an index of zero implies a
+value of zero. The \\{width\_index} should never be zero unless the
+character does not exist in the font, since a character is valid if and
+only if it lies between \\{bc} and \\{ec} and has a nonzero \\{width\_index}.
+
+\fi
+
+\M1092. The \\{tag} field in a \\{char\_info\_word} has four values that
+explain how to
+interpret the \\{remainder} field.
+
+\def\hangg#1 {\hang\hbox{#1 }}
+\yskip\hangg$\\{tag}=0$ (\\{no\_tag}) means that \\{remainder} is unused.\par
+\hangg$\\{tag}=1$ (\\{lig\_tag}) means that this character has a
+ligature/kerning
+program starting at location \\{remainder} in the \\{lig\_kern} array.\par
+\hangg$\\{tag}=2$ (\\{list\_tag}) means that this character is part of a chain
+of
+characters of ascending sizes, and not the largest in the chain. The
+\\{remainder} field gives the character code of the next larger character.\par
+\hangg$\\{tag}=3$ (\\{ext\_tag}) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+$\\{exten}[\\{remainder}]$.\par
+\yskip\noindent
+Characters with $\\{tag}=2$ and $\\{tag}=3$ are treated as characters with $%
+\\{tag}=0$
+unless they are used in special circumstances in math formulas. For example,
+\TeX's \.{\\sum} operation looks for a \\{list\_tag}, and the \.{\\left}
+operation looks for both \\{list\_tag} and \\{ext\_tag}.
+
+\Y\P\D \37$\\{no\_tag}=0$\C{vanilla character}\par
+\P\D \37$\\{lig\_tag}=1$\C{character has a ligature/kerning program}\par
+\P\D \37$\\{list\_tag}=2$\C{character has a successor in a charlist}\par
+\P\D \37$\\{ext\_tag}=3$\C{character is extensible}\par
+\fi
+
+\M1093. The \\{lig\_kern} array contains instructions in a simple programming
+language
+that explains what to do for special letter pairs. Each word in this array is a
+\\{lig\_kern\_command} of four bytes.
+
+\yskip\hang first byte: \\{skip\_byte}, indicates that this is the final
+program
+step if the byte is 128 or more, otherwise the next step is obtained by
+skipping this number of intervening steps.\par
+\hang second byte: \\{next\_char}, ``if \\{next\_char} follows the current
+character,
+then perform the operation and stop, otherwise continue.''\par
+\hang third byte: \\{op\_byte}, indicates a ligature step if less than~128,
+a kern step otherwise.\par
+\hang fourth byte: \\{remainder}.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to $\\{kern}[256\ast(\\{op\_byte}-128)+\\{remainder}]$
+is inserted
+between the current character and \\{next\_char}. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having \\{op\_byte} codes $4a+2b+c$
+where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+\\{remainder} is inserted between the current character and \\{next\_char};
+then the current character is deleted if $b=0$, and \\{next\_char} is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+If the very first instruction of the \\{lig\_kern} array has $\\{skip%
+\_byte}=255$,
+the \\{next\_char} byte is the so-called right boundary character of this font;
+the value of \\{next\_char} need not lie between \\{bc} and~\\{ec}.
+If the very last instruction of the \\{lig\_kern} array has $\\{skip%
+\_byte}=255$,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location $256\ast\\{op\_byte}+\\{remainder}$.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's \\{lig\_kern} program has
+$\\{skip\_byte}>128$, the program actually begins in location
+$256\ast\\{op\_byte}+\\{remainder}$. This feature allows access to large \\{lig%
+\_kern}
+arrays, because the first instruction must otherwise
+appear in a location $\L255$.
+
+Any instruction with $\\{skip\_byte}>128$ in the \\{lig\_kern} array must
+satisfy
+the condition
+$$\hbox{$256\ast\\{op\_byte}+\\{remainder}<\\{nl}$.}$$
+If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+command is performed.
+
+\Y\P\D \37$\\{stop\_flag}=128+\\{min\_quarterword}$\C{value indicating `%
+\.{STOP}' in a lig/kern program}\par
+\P\D \37$\\{kern\_flag}=128+\\{min\_quarterword}$\C{op code for a kern step}\par
+\P\D \37$\\{skip\_byte}(\#)\S\\{lig\_kern}[\#].\\{b0}$\par
+\P\D \37$\\{next\_char}(\#)\S\\{lig\_kern}[\#].\\{b1}$\par
+\P\D \37$\\{op\_byte}(\#)\S\\{lig\_kern}[\#].\\{b2}$\par
+\P\D \37$\\{rem\_byte}(\#)\S\\{lig\_kern}[\#].\\{b3}$\par
+\fi
+
+\M1094. Extensible characters are specified by an \\{extensible\_recipe}, which
+consists of four bytes called \\{top}, \\{mid}, \\{bot}, and \\{rep} (in this
+order). These bytes are the character codes of individual pieces used to
+build up a large symbol. If \\{top}, \\{mid}, or \\{bot} are zero, they are
+not
+present in the built-up result. For example, an extensible vertical line is
+like an extensible bracket, except that the top and bottom pieces are missing.
+
+Let $T$, $M$, $B$, and $R$ denote the respective pieces, or an empty box
+if the piece isn't present. Then the extensible characters have the form
+$TR^kMR^kB$ from top to bottom, for some $\|k\G0$, unless $M$ is absent;
+in the latter case we can have $TR^kB$ for both even and odd values of~\|k.
+The width of the extensible character is the width of $R$; and the
+height-plus-depth is the sum of the individual height-plus-depths of the
+components used, since the pieces are butted together in a vertical list.
+
+\Y\P\D \37$\\{ext\_top}(\#)\S\\{exten}[\#].\\{b0}$\C{\\{top} piece in a recipe}%
+\par
+\P\D \37$\\{ext\_mid}(\#)\S\\{exten}[\#].\\{b1}$\C{\\{mid} piece in a recipe}%
+\par
+\P\D \37$\\{ext\_bot}(\#)\S\\{exten}[\#].\\{b2}$\C{\\{bot} piece in a recipe}%
+\par
+\P\D \37$\\{ext\_rep}(\#)\S\\{exten}[\#].\\{b3}$\C{\\{rep} piece in a recipe}%
+\par
+\fi
+
+\M1095. The final portion of a \.{TFM} file is the \\{param} array, which is
+another
+sequence of \\{fix\_word} values.
+
+\yskip\hang$\\{param}[1]=\\{slant}$ is the amount of italic slant, which is
+used
+to help position accents. For example, $\\{slant}=.25$ means that when you go
+up one unit, you also go .25 units to the right. The \\{slant} is a pure
+number; it is the only \\{fix\_word} other than the design size itself that is
+not scaled by the design size.
+
+\hang$\\{param}[2]=\\{space}$ is the normal spacing between words in text.
+Note that character \O{40} in the font need not have anything to do with
+blank spaces.
+
+\hang$\\{param}[3]=\\{space\_stretch}$ is the amount of glue stretching between
+words.
+
+\hang$\\{param}[4]=\\{space\_shrink}$ is the amount of glue shrinking between
+words.
+
+\hang$\\{param}[5]=\\{x\_height}$ is the size of one ex in the font; it is also
+the height of letters for which accents don't have to be raised or lowered.
+
+\hang$\\{param}[6]=\\{quad}$ is the size of one em in the font.
+
+\hang$\\{param}[7]=\\{extra\_space}$ is the amount added to $\\{param}[2]$ at
+the
+ends of sentences.
+
+\yskip\noindent
+If fewer than seven parameters are present, \TeX\ sets the missing parameters
+to zero.
+
+\Y\P\D \37$\\{slant\_code}=1$\par
+\P\D \37$\\{space\_code}=2$\par
+\P\D \37$\\{space\_stretch\_code}=3$\par
+\P\D \37$\\{space\_shrink\_code}=4$\par
+\P\D \37$\\{x\_height\_code}=5$\par
+\P\D \37$\\{quad\_code}=6$\par
+\P\D \37$\\{extra\_space\_code}=7$\par
+\fi
+
+\M1096. So that is what \.{TFM} files hold. One of \MF's duties is to output
+such
+information, and it does this all at once at the end of a job.
+In order to prepare for such frenetic activity, it squirrels away the
+necessary facts in various arrays as information becomes available.
+
+Character dimensions (\&{charwd}, \&{charht}, \&{chardp}, and \&{charic})
+are stored respectively in \\{tfm\_width}, \\{tfm\_height}, \\{tfm\_depth}, and
+\\{tfm\_ital\_corr}. Other information about a character (e.g., about
+its ligatures or successors) is accessible via the \\{char\_tag} and
+\\{char\_remainder} arrays. Other information about the font as a whole
+is kept in additional arrays called \\{header\_byte}, \\{lig\_kern},
+\\{kern}, \\{exten}, and \\{param}.
+
+\Y\P\D \37$\\{undefined\_label}\S\\{lig\_table\_size}$\C{an undefined local
+label}\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{bc},\39\\{ec}$: \37\\{eight\_bits};\C{smallest and largest character
+codes shipped out}\6
+\4\\{tfm\_width}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+\\{scaled};\C{\&{charwd} values}\2\6
+\4\\{tfm\_height}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+\\{scaled};\C{\&{charht} values}\2\6
+\4\\{tfm\_depth}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+\\{scaled};\C{\&{chardp} values}\2\6
+\4\\{tfm\_ital\_corr}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+\\{scaled};\C{\&{charic} values}\2\6
+\4\\{char\_exists}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+\\{boolean};\C{has this code been shipped out?}\2\6
+\4\\{char\_tag}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+$\\{no\_tag}\to\\{ext\_tag}$;\C{\\{remainder} category}\2\6
+\4\\{char\_remainder}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+$0\to\\{lig\_table\_size}$;\C{the \\{remainder} byte}\2\6
+\4\\{header\_byte}: \37\&{array} $[1\to\\{header\_size}]$ \1\&{of}\5
+$-1\to255$;\C{bytes of the \.{TFM} header, or $-1$ if unset}\2\6
+\4\\{lig\_kern}: \37\&{array} $[0\to\\{lig\_table\_size}]$ \1\&{of}\5
+\\{four\_quarters};\C{the ligature/kern table}\2\6
+\4\\{nl}: \37$0\to32767-256$;\C{the number of ligature/kern steps so far}\6
+\4\\{kern}: \37\&{array} $[0\to\\{max\_kerns}]$ \1\&{of}\5
+\\{scaled};\C{distinct kerning amounts}\2\6
+\4\\{nk}: \37$0\to\\{max\_kerns}$;\C{the number of distinct kerns so far}\6
+\4\\{exten}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+\\{four\_quarters};\C{extensible character recipes}\2\6
+\4\\{ne}: \37$0\to256$;\C{the number of extensible characters so far}\6
+\4\\{param}: \37\&{array} $[1\to\\{max\_font\_dimen}]$ \1\&{of}\5
+\\{scaled};\C{\&{fontinfo} parameters}\2\6
+\4\\{np}: \37$0\to\\{max\_font\_dimen}$;\C{the largest \&{fontinfo} parameter
+specified so far}\6
+\4$\\{nw},\39\\{nh},\39\\{nd},\39\\{ni}$: \37$0\to256$;\C{sizes of \.{TFM}
+subtables}\6
+\4\\{skip\_table}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+$0\to\\{lig\_table\_size}$;\C{local label status}\2\6
+\4\\{lk\_started}: \37\\{boolean};\C{has there been a lig/kern step in this
+command yet?}\6
+\4\\{bchar}: \37\\{integer};\C{right boundary character}\6
+\4\\{bch\_label}: \37$0\to\\{lig\_table\_size}$;\C{left boundary starting
+location}\6
+\4$\\{ll},\39\\{lll}$: \37$0\to\\{lig\_table\_size}$;\C{registers used for
+lig/kern processing}\6
+\4\\{label\_loc}: \37\&{array} $[0\to256]$ \1\&{of}\5
+$-1\to\\{lig\_table\_size}$;\C{lig/kern starting addresses}\2\6
+\4\\{label\_char}: \37\&{array} $[1\to256]$ \1\&{of}\5
+\\{eight\_bits};\C{characters for \\{label\_loc}}\2\6
+\4\\{label\_ptr}: \37$0\to256$;\C{highest position occupied in \\{label\_loc}}%
+\par
+\fi
+
+\M1097. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+\&{for} $\|k\K0\mathrel{\&{to}}255$ \1\&{do}\6
+\&{begin} \37$\\{tfm\_width}[\|k]\K0$;\5
+$\\{tfm\_height}[\|k]\K0$;\5
+$\\{tfm\_depth}[\|k]\K0$;\5
+$\\{tfm\_ital\_corr}[\|k]\K0$;\5
+$\\{char\_exists}[\|k]\K\\{false}$;\5
+$\\{char\_tag}[\|k]\K\\{no\_tag}$;\5
+$\\{char\_remainder}[\|k]\K0$;\5
+$\\{skip\_table}[\|k]\K\\{undefined\_label}$;\6
+\&{end};\2\6
+\&{for} $\|k\K1\mathrel{\&{to}}\\{header\_size}$ \1\&{do}\5
+$\\{header\_byte}[\|k]\K-1$;\2\6
+$\\{bc}\K255$;\5
+$\\{ec}\K0$;\5
+$\\{nl}\K0$;\5
+$\\{nk}\K0$;\5
+$\\{ne}\K0$;\5
+$\\{np}\K0$;\6
+$\\{internal}[\\{boundary\_char}]\K-\\{unity}$;\5
+$\\{bch\_label}\K\\{undefined\_label}$;\6
+$\\{label\_loc}[0]\K-1$;\5
+$\\{label\_ptr}\K0$;\par
+\fi
+
+\M1098. \P$\X1098:Declare the function called \\{tfm\_check}\X\S$\6
+\4\&{function}\1\ \37$\\{tfm\_check}(\|m:\\{small\_number})$: \37\\{scaled};\2%
+\6
+\&{begin} \37\&{if} $\\{abs}(\\{internal}[\|m])\G\\{fraction\_half}$ \1\&{then}%
+\6
+\&{begin} \37$\\{print\_err}(\.{"Enormous\ "})$;\5
+$\\{print}(\\{int\_name}[\|m])$;\5
+$\\{print}(\.{"\ has\ been\ reduced"})$;\5
+$\\{help1}(\.{"Font\ metric\ dimensions\ must\ be\ less\ than\ 2048pt."})$;\5
+\\{put\_get\_error};\6
+\&{if} $\\{internal}[\|m]>0$ \1\&{then}\5
+$\\{tfm\_check}\K\\{fraction\_half}-1$\6
+\4\&{else} $\\{tfm\_check}\K1-\\{fraction\_half}$;\2\6
+\&{end}\6
+\4\&{else} $\\{tfm\_check}\K\\{internal}[\|m]$;\2\6
+\&{end};\par
+\U1070.\fi
+
+\M1099. \P$\X1099:Store the width information for character code~\|c\X\S$\6
+\&{if} $\|c<\\{bc}$ \1\&{then}\5
+$\\{bc}\K\|c$;\2\6
+\&{if} $\|c>\\{ec}$ \1\&{then}\5
+$\\{ec}\K\|c$;\2\6
+$\\{char\_exists}[\|c]\K\\{true}$;\5
+$\\{gf\_dx}[\|c]\K\\{internal}[\\{char\_dx}]$;\5
+$\\{gf\_dy}[\|c]\K\\{internal}[\\{char\_dy}]$;\5
+$\\{tfm\_width}[\|c]\K\\{tfm\_check}(\\{char\_wd})$;\5
+$\\{tfm\_height}[\|c]\K\\{tfm\_check}(\\{char\_ht})$;\5
+$\\{tfm\_depth}[\|c]\K\\{tfm\_check}(\\{char\_dp})$;\5
+$\\{tfm\_ital\_corr}[\|c]\K\\{tfm\_check}(\\{char\_ic})$\par
+\U1070.\fi
+
+\M1100. Now let's consider \MF's special \.{TFM}-oriented commands.
+
+\Y\P$\4\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{tfm\_command}: \37\\{do\_tfm\_command};\par
+\fi
+
+\M1101. \P\D \37$\\{char\_list\_code}=0$\par
+\P\D \37$\\{lig\_table\_code}=1$\par
+\P\D \37$\\{extensible\_code}=2$\par
+\P\D \37$\\{header\_byte\_code}=3$\par
+\P\D \37$\\{font\_dimen\_code}=4$\par
+\Y\P$\4\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}\S$\6
+$\\{primitive}(\.{"charlist"},\39\\{tfm\_command},\39\\{char\_list\_code})$;\6
+$\\{primitive}(\.{"ligtable"},\39\\{tfm\_command},\39\\{lig\_table\_code})$;\6
+$\\{primitive}(\.{"extensible"},\39\\{tfm\_command},\39\\{extensible\_code})$;\6
+$\\{primitive}(\.{"headerbyte"},\39\\{tfm\_command},\39\\{header\_byte%
+\_code})$;\6
+$\\{primitive}(\.{"fontdimen"},\39\\{tfm\_command},\39\\{font\_dimen\_code})$;%
+\par
+\fi
+
+\M1102. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{tfm\_command}: \37\&{case} $\|m$ \1\&{of}\6
+\4\\{char\_list\_code}: \37$\\{print}(\.{"charlist"})$;\6
+\4\\{lig\_table\_code}: \37$\\{print}(\.{"ligtable"})$;\6
+\4\\{extensible\_code}: \37$\\{print}(\.{"extensible"})$;\6
+\4\\{header\_byte\_code}: \37$\\{print}(\.{"headerbyte"})$;\6
+\4\&{othercases} \37$\\{print}(\.{"fontdimen"})$\2\6
+\&{endcases};\par
+\fi
+
+\M1103. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{function}\1\ \37\\{get\_code}: \37\\{eight\_bits};\C{scans a character
+code value}\6
+\4\&{label} \37\\{found};\6
+\4\&{var} \37\|c: \37\\{integer};\C{the code value found}\2\6
+\&{begin} \37\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}=\\{known}$ \1\&{then}\6
+\&{begin} \37$\|c\K\\{round\_unscaled}(\\{cur\_exp})$;\6
+\&{if} $\|c\G0$ \1\&{then}\6
+\&{if} $\|c<256$ \1\&{then}\5
+\&{goto} \37\\{found};\2\2\6
+\&{end}\6
+\4\&{else} \&{if} $\\{cur\_type}=\\{string\_type}$ \1\&{then}\6
+\&{if} $\\{length}(\\{cur\_exp})=1$ \1\&{then}\6
+\&{begin} \37$\|c\K\\{so}(\\{str\_pool}[\\{str\_start}[\\{cur\_exp}]])$;\5
+\&{goto} \37\\{found};\6
+\&{end};\2\2\2\6
+$\\{exp\_err}(\.{"Invalid\ code\ has\ been\ replaced\ by\ 0"})$;\5
+$\\{help2}(\.{"I\ was\ looking\ for\ a\ number\ between\ 0\ and\ 255,\ or\ for\
+a"})$\6
+$(\.{"string\ of\ length\ 1.\ Didn\'t\ find\ it;\ will\ use\ 0\ instead."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\5
+$\|c\K0$;\6
+\4\\{found}: \37$\\{get\_code}\K\|c$;\6
+\&{end};\par
+\fi
+
+\M1104. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{set\_tag}(\|c:\\{halfword};\,\35\|t:\\{small%
+\_number};\,\35\|r:\\{halfword})$;\2\6
+\&{begin} \37\&{if} $\\{char\_tag}[\|c]=\\{no\_tag}$ \1\&{then}\6
+\&{begin} \37$\\{char\_tag}[\|c]\K\|t$;\5
+$\\{char\_remainder}[\|c]\K\|r$;\6
+\&{if} $\|t=\\{lig\_tag}$ \1\&{then}\6
+\&{begin} \37$\\{incr}(\\{label\_ptr})$;\5
+$\\{label\_loc}[\\{label\_ptr}]\K\|r$;\5
+$\\{label\_char}[\\{label\_ptr}]\K\|c$;\6
+\&{end};\2\6
+\&{end}\6
+\4\&{else} \X1105:Complain about a character tag conflict\X;\2\6
+\&{end};\par
+\fi
+
+\M1105. \P$\X1105:Complain about a character tag conflict\X\S$\6
+\&{begin} \37$\\{print\_err}(\.{"Character\ "})$;\6
+\&{if} $(\|c>\.{"\ "})\W(\|c<127)$ \1\&{then}\5
+$\\{print}(\|c)$\6
+\4\&{else} \&{if} $\|c=256$ \1\&{then}\5
+$\\{print}(\.{"||"})$\6
+\4\&{else} \&{begin} \37$\\{print}(\.{"code\ "})$;\5
+$\\{print\_int}(\|c)$;\6
+\&{end};\2\2\6
+$\\{print}(\.{"\ is\ already\ "})$;\6
+\&{case} $\\{char\_tag}[\|c]$ \1\&{of}\6
+\4\\{lig\_tag}: \37$\\{print}(\.{"in\ a\ ligtable"})$;\6
+\4\\{list\_tag}: \37$\\{print}(\.{"in\ a\ charlist"})$;\6
+\4\\{ext\_tag}: \37$\\{print}(\.{"extensible"})$;\2\6
+\&{end};\C{there are no other cases}\6
+$\\{help2}(\.{"It\'s\ not\ legal\ to\ label\ a\ character\ more\ than\
+once."})$\6
+$(\.{"So\ I\'ll\ not\ change\ anything\ just\ now."})$;\5
+\\{put\_get\_error};\6
+\&{end}\par
+\U1104.\fi
+
+\M1106. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_tfm\_command};\6
+\4\&{label} \37$\\{continue},\39\\{done}$;\6
+\4\&{var} \37$\|c,\39\\{cc}$: \37$0\to256$;\C{character codes}\6
+\|k: \37$0\to\\{max\_kerns}$;\C{index into the \\{kern} array}\6
+\|j: \37\\{integer};\C{index into \\{header\_byte} or \\{param}}\2\6
+\&{begin} \37\&{case} $\\{cur\_mod}$ \1\&{of}\6
+\4\\{char\_list\_code}: \37\&{begin} \37$\|c\K\\{get\_code}$;\C{we will store a
+list of character successors}\6
+\&{while} $\\{cur\_cmd}=\\{colon}$ \1\&{do}\6
+\&{begin} \37$\\{cc}\K\\{get\_code}$;\5
+$\\{set\_tag}(\|c,\39\\{list\_tag},\39\\{cc})$;\5
+$\|c\K\\{cc}$;\6
+\&{end};\2\6
+\&{end};\6
+\4\\{lig\_table\_code}: \37\X1107:Store a list of ligature/kern steps\X;\6
+\4\\{extensible\_code}: \37\X1113:Define an extensible recipe\X;\6
+\4$\\{header\_byte\_code},\39\\{font\_dimen\_code}$: \37\&{begin} \37$\|c\K%
+\\{cur\_mod}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $(\\{cur\_type}\I\\{known})\V(\\{cur\_exp}<\\{half\_unit})$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ location"})$;\5
+$\\{help2}(\.{"I\ was\ looking\ for\ a\ known,\ positive\ number."})$\6
+$(\.{"For\ safety\'s\ sake\ I\'ll\ ignore\ the\ present\ command."})$;\5
+\\{put\_get\_error};\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\|j\K\\{round\_unscaled}(\\{cur\_exp})$;\6
+\&{if} $\\{cur\_cmd}\I\\{colon}$ \1\&{then}\6
+\&{begin} \37$\\{missing\_err}(\.{":"})$;\5
+$\\{help1}(\.{"A\ colon\ should\ follow\ a\ headerbyte\ or\ fontinfo\
+location."})$;\5
+\\{back\_error};\6
+\&{end};\2\6
+\&{if} $\|c=\\{header\_byte\_code}$ \1\&{then}\5
+\X1114:Store a list of header bytes\X\6
+\4\&{else} \X1115:Store a list of font dimensions\X;\2\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\C{there are no other cases}\6
+\&{end};\par
+\fi
+
+\M1107. \P$\X1107:Store a list of ligature/kern steps\X\S$\6
+\&{begin} \37$\\{lk\_started}\K\\{false}$;\6
+\4\\{continue}: \37\\{get\_x\_next};\6
+\&{if} $(\\{cur\_cmd}=\\{skip\_to})\W\\{lk\_started}$ \1\&{then}\5
+\X1110:Process a \\{skip\_to} command and \&{goto} \\{done}\X;\2\6
+\&{if} $\\{cur\_cmd}=\\{bchar\_label}$ \1\&{then}\6
+\&{begin} \37$\|c\K256$;\5
+$\\{cur\_cmd}\K\\{colon}$;\ \&{end}\6
+\4\&{else} \&{begin} \37\\{back\_input};\5
+$\|c\K\\{get\_code}$;\ \&{end};\2\6
+\&{if} $(\\{cur\_cmd}=\\{colon})\V(\\{cur\_cmd}=\\{double\_colon})$ \1\&{then}\5
+\X1111:Record a label in a lig/kern subprogram and \&{goto} \\{continue}\X;\2\6
+\&{if} $\\{cur\_cmd}=\\{lig\_kern\_token}$ \1\&{then}\5
+\X1112:Compile a ligature/kern command\X\6
+\4\&{else} \&{begin} \37$\\{print\_err}(\.{"Illegal\ ligtable\ step"})$;\5
+$\\{help1}(\.{"I\ was\ looking\ for\ \`=:\'\ or\ \`kern\'\ here."})$;\5
+\\{back\_error};\5
+$\\{next\_char}(\\{nl})\K\\{qi}(0)$;\5
+$\\{op\_byte}(\\{nl})\K\\{qi}(0)$;\5
+$\\{rem\_byte}(\\{nl})\K\\{qi}(0)$;\6
+$\\{skip\_byte}(\\{nl})\K\\{stop\_flag}+1$;\C{this specifies an unconditional
+stop}\6
+\&{end};\2\6
+\&{if} $\\{nl}=\\{lig\_table\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"ligtable\ size"},\39\\{lig\_table\_size})$;\2\6
+$\\{incr}(\\{nl})$;\6
+\&{if} $\\{cur\_cmd}=\\{comma}$ \1\&{then}\5
+\&{goto} \37\\{continue};\2\6
+\&{if} $\\{skip\_byte}(\\{nl}-1)<\\{stop\_flag}$ \1\&{then}\5
+$\\{skip\_byte}(\\{nl}-1)\K\\{stop\_flag}$;\2\6
+\4\\{done}: \37\&{end}\par
+\U1106.\fi
+
+\M1108. \P$\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}%
+\S$\6
+$\\{primitive}(\.{"=:"},\39\\{lig\_kern\_token},\390)$;\5
+$\\{primitive}(\.{"=:|"},\39\\{lig\_kern\_token},\391)$;\5
+$\\{primitive}(\.{"=:|>"},\39\\{lig\_kern\_token},\395)$;\5
+$\\{primitive}(\.{"|=:"},\39\\{lig\_kern\_token},\392)$;\5
+$\\{primitive}(\.{"|=:>"},\39\\{lig\_kern\_token},\396)$;\5
+$\\{primitive}(\.{"|=:|"},\39\\{lig\_kern\_token},\393)$;\5
+$\\{primitive}(\.{"|=:|>"},\39\\{lig\_kern\_token},\397)$;\5
+$\\{primitive}(\.{"|=:|>>"},\39\\{lig\_kern\_token},\3911)$;\5
+$\\{primitive}(\.{"kern"},\39\\{lig\_kern\_token},\39128)$;\par
+\fi
+
+\M1109. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{lig\_kern\_token}: \37\&{case} $\|m$ \1\&{of}\6
+\40: \37$\\{print}(\.{"=:"})$;\6
+\41: \37$\\{print}(\.{"=:|"})$;\6
+\42: \37$\\{print}(\.{"|=:"})$;\6
+\43: \37$\\{print}(\.{"|=:|"})$;\6
+\45: \37$\\{print}(\.{"=:|>"})$;\6
+\46: \37$\\{print}(\.{"|=:>"})$;\6
+\47: \37$\\{print}(\.{"|=:|>"})$;\6
+\411: \37$\\{print}(\.{"|=:|>>"})$;\6
+\4\&{othercases} \37$\\{print}(\.{"kern"})$\2\6
+\&{endcases};\par
+\fi
+
+\M1110. Local labels are implemented by maintaining the \\{skip\_table} array,
+where $\\{skip\_table}[\|c]$ is either \\{undefined\_label} or the address of
+the
+most recent lig/kern instruction that skips to local label~\|c. In the
+latter case, the \\{skip\_byte} in that instruction will (temporarily)
+be zero if there were no prior skips to this label, or it will be the
+distance to the prior skip.
+
+We may need to cancel skips that span more than 127 lig/kern steps.
+
+\Y\P\D \37$\\{cancel\_skips}(\#)\S\\{ll}\K\#$;\6
+\1\&{repeat} \37$\\{lll}\K\\{qo}(\\{skip\_byte}(\\{ll}))$;\5
+$\\{skip\_byte}(\\{ll})\K\\{stop\_flag}$;\5
+$\\{ll}\K\\{ll}-\\{lll}$;\6
+\4\&{until}\5
+$\\{lll}=0$\2\par
+\P\D \37$\\{skip\_error}(\#)\S$\1\6
+\&{begin} \37$\\{print\_err}(\.{"Too\ far\ to\ skip"})$;\5
+$\\{help1}(\.{"At\ most\ 127\ lig/kern\ steps\ can\ separate\ skipto1\ from\
+1::."})$;\5
+\\{error};\5
+$\\{cancel\_skips}(\#)$;\6
+\&{end}\2\par
+\Y\P$\4\X1110:Process a \\{skip\_to} command and \&{goto} \\{done}\X\S$\6
+\&{begin} \37$\|c\K\\{get\_code}$;\6
+\&{if} $\\{nl}-\\{skip\_table}[\|c]>128$ \1\&{then}\C{$\\{skip\_table}[\|c]<<%
+\\{nl}\L\\{undefined\_label}$}\6
+\&{begin} \37$\\{skip\_error}(\\{skip\_table}[\|c])$;\5
+$\\{skip\_table}[\|c]\K\\{undefined\_label}$;\6
+\&{end};\2\6
+\&{if} $\\{skip\_table}[\|c]=\\{undefined\_label}$ \1\&{then}\5
+$\\{skip\_byte}(\\{nl}-1)\K\\{qi}(0)$\6
+\4\&{else} $\\{skip\_byte}(\\{nl}-1)\K\\{qi}(\\{nl}-\\{skip\_table}[\|c]-1)$;\2%
+\6
+$\\{skip\_table}[\|c]\K\\{nl}-1$;\5
+\&{goto} \37\\{done};\6
+\&{end}\par
+\U1107.\fi
+
+\M1111. \P$\X1111:Record a label in a lig/kern subprogram and \&{goto} %
+\\{continue}\X\S$\6
+\&{begin} \37\&{if} $\\{cur\_cmd}=\\{colon}$ \1\&{then}\6
+\&{if} $\|c=256$ \1\&{then}\5
+$\\{bch\_label}\K\\{nl}$\6
+\4\&{else} $\\{set\_tag}(\|c,\39\\{lig\_tag},\39\\{nl})$\2\6
+\4\&{else} \&{if} $\\{skip\_table}[\|c]<\\{undefined\_label}$ \1\&{then}\6
+\&{begin} \37$\\{ll}\K\\{skip\_table}[\|c]$;\5
+$\\{skip\_table}[\|c]\K\\{undefined\_label}$;\6
+\1\&{repeat} \37$\\{lll}\K\\{qo}(\\{skip\_byte}(\\{ll}))$;\6
+\&{if} $\\{nl}-\\{ll}>128$ \1\&{then}\6
+\&{begin} \37$\\{skip\_error}(\\{ll})$;\5
+\&{goto} \37\\{continue};\6
+\&{end};\2\6
+$\\{skip\_byte}(\\{ll})\K\\{qi}(\\{nl}-\\{ll}-1)$;\5
+$\\{ll}\K\\{ll}-\\{lll}$;\6
+\4\&{until}\5
+$\\{lll}=0$;\2\6
+\&{end};\2\2\6
+\&{goto} \37\\{continue};\6
+\&{end}\par
+\U1107.\fi
+
+\M1112. \P$\X1112:Compile a ligature/kern command\X\S$\6
+\&{begin} \37$\\{next\_char}(\\{nl})\K\\{qi}(\|c)$;\5
+$\\{skip\_byte}(\\{nl})\K\\{qi}(0)$;\6
+\&{if} $\\{cur\_mod}<128$ \1\&{then}\C{ligature op}\6
+\&{begin} \37$\\{op\_byte}(\\{nl})\K\\{qi}(\\{cur\_mod})$;\5
+$\\{rem\_byte}(\\{nl})\K\\{qi}(\\{get\_code})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ kern"})$;\5
+$\\{help2}(\.{"The\ amount\ of\ kern\ should\ be\ a\ known\ numeric\ value."})$%
+\6
+$(\.{"I\'m\ zeroing\ this\ one.\ Proceed,\ with\ fingers\ crossed."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end};\2\6
+$\\{kern}[\\{nk}]\K\\{cur\_exp}$;\5
+$\|k\K0$;\ \&{while} $\\{kern}[\|k]\I\\{cur\_exp}$ \1\&{do}\5
+$\\{incr}(\|k)$;\2\6
+\&{if} $\|k=\\{nk}$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{nk}=\\{max\_kerns}$ \1\&{then}\5
+$\\{overflow}(\.{"kern"},\39\\{max\_kerns})$;\2\6
+$\\{incr}(\\{nk})$;\6
+\&{end};\2\6
+$\\{op\_byte}(\\{nl})\K\\{kern\_flag}+(\|k\mathbin{\&{div}}256)$;\5
+$\\{rem\_byte}(\\{nl})\K\\{qi}((\|k\mathbin{\&{mod}}256))$;\6
+\&{end};\2\6
+$\\{lk\_started}\K\\{true}$;\6
+\&{end}\par
+\U1107.\fi
+
+\M1113. \P\D \37$\\{missing\_extensible\_punctuation}(\#)\S$\1\6
+\&{begin} \37$\\{missing\_err}(\#)$;\5
+$\\{help1}(\.{"I\'m\ processing\ \`extensible\ c:\ t,m,b,r\'."})$;\5
+\\{back\_error};\6
+\&{end}\2\par
+\Y\P$\4\X1113:Define an extensible recipe\X\S$\6
+\&{begin} \37\&{if} $\\{ne}=256$ \1\&{then}\5
+$\\{overflow}(\.{"extensible"},\39256)$;\2\6
+$\|c\K\\{get\_code}$;\5
+$\\{set\_tag}(\|c,\39\\{ext\_tag},\39\\{ne})$;\6
+\&{if} $\\{cur\_cmd}\I\\{colon}$ \1\&{then}\5
+$\\{missing\_extensible\_punctuation}(\.{":"})$;\2\6
+$\\{ext\_top}(\\{ne})\K\\{qi}(\\{get\_code})$;\6
+\&{if} $\\{cur\_cmd}\I\\{comma}$ \1\&{then}\5
+$\\{missing\_extensible\_punctuation}(\.{","})$;\2\6
+$\\{ext\_mid}(\\{ne})\K\\{qi}(\\{get\_code})$;\6
+\&{if} $\\{cur\_cmd}\I\\{comma}$ \1\&{then}\5
+$\\{missing\_extensible\_punctuation}(\.{","})$;\2\6
+$\\{ext\_bot}(\\{ne})\K\\{qi}(\\{get\_code})$;\6
+\&{if} $\\{cur\_cmd}\I\\{comma}$ \1\&{then}\5
+$\\{missing\_extensible\_punctuation}(\.{","})$;\2\6
+$\\{ext\_rep}(\\{ne})\K\\{qi}(\\{get\_code})$;\5
+$\\{incr}(\\{ne})$;\6
+\&{end}\par
+\U1106.\fi
+
+\M1114. \P$\X1114:Store a list of header bytes\X\S$\6
+\1\&{repeat} \37\&{if} $\|j>\\{header\_size}$ \1\&{then}\5
+$\\{overflow}(\.{"headerbyte"},\39\\{header\_size})$;\2\6
+$\\{header\_byte}[\|j]\K\\{get\_code}$;\5
+$\\{incr}(\|j)$;\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$\2\par
+\U1106.\fi
+
+\M1115. \P$\X1115:Store a list of font dimensions\X\S$\6
+\1\&{repeat} \37\&{if} $\|j>\\{max\_font\_dimen}$ \1\&{then}\5
+$\\{overflow}(\.{"fontdimen"},\39\\{max\_font\_dimen})$;\2\6
+\&{while} $\|j>\\{np}$ \1\&{do}\6
+\&{begin} \37$\\{incr}(\\{np})$;\5
+$\\{param}[\\{np}]\K0$;\6
+\&{end};\2\6
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{cur\_type}\I\\{known}$ \1\&{then}\6
+\&{begin} \37$\\{exp\_err}(\.{"Improper\ font\ parameter"})$;\5
+$\\{help1}(\.{"I\'m\ zeroing\ this\ one.\ Proceed,\ with\ fingers\
+crossed."})$;\5
+$\\{put\_get\_flush\_error}(0)$;\6
+\&{end};\2\6
+$\\{param}[\|j]\K\\{cur\_exp}$;\5
+$\\{incr}(\|j)$;\6
+\4\&{until}\5
+$\\{cur\_cmd}\I\\{comma}$\2\par
+\U1106.\fi
+
+\M1116. OK: We've stored all the data that is needed for the \.{TFM} file.
+All that remains is to output it in the correct format.
+
+An interesting problem needs to be solved in this connection, because
+the \.{TFM} format allows at most 256~widths, 16~heights, 16~depths,
+and 64~italic corrections. If the data has more distinct values than
+this, we want to meet the necessary restrictions by perturbing the
+given values as little as possible.
+
+\MF\ solves this problem in two steps. First the values of a given
+kind (widths, heights, depths, or italic corrections) are sorted;
+then the list of sorted values is perturbed, if necessary.
+
+The sorting operation is facilitated by having a special node of
+essentially infinite \\{value} at the end of the current list.
+
+\Y\P$\4\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}\S$\6
+$\\{value}(\\{inf\_val})\K\\{fraction\_four}$;\par
+\fi
+
+\M1117. Straight linear insertion is good enough for sorting, since the lists
+are usually not terribly long. As we work on the data, the current list
+will start at $\\{link}(\\{temp\_head})$ and end at \\{inf\_val}; the nodes in
+this
+list will be in increasing order of their \\{value} fields.
+
+Given such a list, the \\{sort\_in} function takes a value and returns a
+pointer
+to where that value can be found in the list. The value is inserted in
+the proper place, if necessary.
+
+At the time we need to do these operations, most of \MF's work has been
+completed, so we will have plenty of memory to play with. The value nodes
+that are allocated for sorting will never be returned to free storage.
+
+\Y\P\D \37$\\{clear\_the\_list}\S\\{link}(\\{temp\_head})\K\\{inf\_val}$\par
+\Y\P\4\&{function}\1\ \37$\\{sort\_in}(\|v:\\{scaled})$: \37\\{pointer};\6
+\4\&{label} \37\\{found};\6
+\4\&{var} \37$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{list manipulation
+registers}\2\6
+\&{begin} \37$\|p\K\\{temp\_head}$;\6
+\~ \1\&{loop}\ \&{begin} \37$\|q\K\\{link}(\|p)$;\6
+\&{if} $\|v\L\\{value}(\|q)$ \1\&{then}\5
+\&{goto} \37\\{found};\2\6
+$\|p\K\|q$;\6
+\&{end};\2\6
+\4\\{found}: \37\&{if} $\|v<\\{value}(\|q)$ \1\&{then}\6
+\&{begin} \37$\|r\K\\{get\_node}(\\{value\_node\_size})$;\5
+$\\{value}(\|r)\K\|v$;\5
+$\\{link}(\|r)\K\|q$;\5
+$\\{link}(\|p)\K\|r$;\6
+\&{end};\2\6
+$\\{sort\_in}\K\\{link}(\|p)$;\6
+\&{end};\par
+\fi
+
+\M1118. Now we come to the interesting part, where we reduce the list if
+necessary
+until it has the required size. The \\{min\_cover} routine is basic to this
+process; it computes the minimum number~\|m such that the values of the
+current sorted list can be covered by \|m~intervals of width~\|d. It
+also sets the global value \\{perturbation} to the smallest value $d'>d$
+such that the covering found by this algorithm would be different.
+
+In particular, $\\{min\_cover}(0)$ returns the number of distinct values in the
+current list and sets \\{perturbation} to the minimum distance between
+adjacent values.
+
+\Y\P\4\&{function}\1\ \37$\\{min\_cover}(\|d:\\{scaled})$: \37\\{integer};\6
+\4\&{var} \37\|p: \37\\{pointer};\C{runs through the current list}\6
+\|l: \37\\{scaled};\C{the least element covered by the current interval}\6
+\|m: \37\\{integer};\C{lower bound on the size of the minimum cover}\2\6
+\&{begin} \37$\|m\K0$;\5
+$\|p\K\\{link}(\\{temp\_head})$;\5
+$\\{perturbation}\K\\{el\_gordo}$;\6
+\&{while} $\|p\I\\{inf\_val}$ \1\&{do}\6
+\&{begin} \37$\\{incr}(\|m)$;\5
+$\|l\K\\{value}(\|p)$;\6
+\1\&{repeat} \37$\|p\K\\{link}(\|p)$;\6
+\4\&{until}\5
+$\\{value}(\|p)>\|l+\|d$;\2\6
+\&{if} $\\{value}(\|p)-\|l<\\{perturbation}$ \1\&{then}\5
+$\\{perturbation}\K\\{value}(\|p)-\|l$;\2\6
+\&{end};\2\6
+$\\{min\_cover}\K\|m$;\6
+\&{end};\par
+\fi
+
+\M1119. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{perturbation}: \37\\{scaled};\C{quantity related to \.{TFM} rounding}\6
+\4\\{excess}: \37\\{integer};\C{the list is this much too long}\par
+\fi
+
+\M1120. The smallest \|d such that a given list can be covered with \|m
+intervals
+is determined by the \\{threshold} routine, which is sort of an inverse
+to \\{min\_cover}. The idea is to increase the interval size rapidly until
+finding the range, then to go sequentially until the exact borderline has
+been discovered.
+
+\Y\P\4\&{function}\1\ \37$\\{threshold}(\|m:\\{integer})$: \37\\{scaled};\6
+\4\&{var} \37\|d: \37\\{scaled};\C{lower bound on the smallest interval size}\2%
+\6
+\&{begin} \37$\\{excess}\K\\{min\_cover}(0)-\|m$;\6
+\&{if} $\\{excess}\L0$ \1\&{then}\5
+$\\{threshold}\K0$\6
+\4\&{else} \&{begin} \37\1\&{repeat} \37$\|d\K\\{perturbation}$;\6
+\4\&{until}\5
+$\\{min\_cover}(\|d+\|d)\L\|m$;\2\6
+\&{while} $\\{min\_cover}(\|d)>\|m$ \1\&{do}\5
+$\|d\K\\{perturbation}$;\2\6
+$\\{threshold}\K\|d$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M1121. The \\{skimp} procedure reduces the current list to at most \|m
+entries,
+by changing values if necessary. It also sets $\\{info}(\|p)\K\|k$ if $%
+\\{value}(\|p)$
+is the \|kth distinct value on the resulting list, and it sets
+\\{perturbation} to the maximum amount by which a \\{value} field has
+been changed. The size of the resulting list is returned as the
+value of \\{skimp}.
+
+\Y\P\4\&{function}\1\ \37$\\{skimp}(\|m:\\{integer})$: \37\\{integer};\6
+\4\&{var} \37\|d: \37\\{scaled};\C{the size of intervals being coalesced}\6
+$\|p,\39\|q,\39\|r$: \37\\{pointer};\C{list manipulation registers}\6
+\|l: \37\\{scaled};\C{the least value in the current interval}\6
+\|v: \37\\{scaled};\C{a compromise value}\2\6
+\&{begin} \37$\|d\K\\{threshold}(\|m)$;\5
+$\\{perturbation}\K0$;\5
+$\|q\K\\{temp\_head}$;\5
+$\|m\K0$;\5
+$\|p\K\\{link}(\\{temp\_head})$;\6
+\&{while} $\|p\I\\{inf\_val}$ \1\&{do}\6
+\&{begin} \37$\\{incr}(\|m)$;\5
+$\|l\K\\{value}(\|p)$;\5
+$\\{info}(\|p)\K\|m$;\6
+\&{if} $\\{value}(\\{link}(\|p))\L\|l+\|d$ \1\&{then}\5
+\X1122:Replace an interval of values by its midpoint\X;\2\6
+$\|q\K\|p$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+$\\{skimp}\K\|m$;\6
+\&{end};\par
+\fi
+
+\M1122. \P$\X1122:Replace an interval of values by its midpoint\X\S$\6
+\&{begin} \37\1\&{repeat} \37$\|p\K\\{link}(\|p)$;\5
+$\\{info}(\|p)\K\|m$;\5
+$\\{decr}(\\{excess})$;\ \&{if} $\\{excess}=0$ \1\&{then}\5
+$\|d\K0$;\2\6
+\4\&{until}\5
+$\\{value}(\\{link}(\|p))>\|l+\|d$;\2\6
+$\|v\K\|l+\\{half}(\\{value}(\|p)-\|l)$;\6
+\&{if} $\\{value}(\|p)-\|v>\\{perturbation}$ \1\&{then}\5
+$\\{perturbation}\K\\{value}(\|p)-\|v$;\2\6
+$\|r\K\|q$;\6
+\1\&{repeat} \37$\|r\K\\{link}(\|r)$;\5
+$\\{value}(\|r)\K\|v$;\6
+\4\&{until}\5
+$\|r=\|p$;\2\6
+$\\{link}(\|q)\K\|p$;\C{remove duplicate values from the current list}\6
+\&{end}\par
+\U1121.\fi
+
+\M1123. A warning message is issued whenever something is perturbed by
+more than 1/16\thinspace pt.
+
+\Y\P\4\&{procedure}\1\ \37$\\{tfm\_warning}(\|m:\\{small\_number})$;\2\6
+\&{begin} \37$\\{print\_nl}(\.{"(some\ "})$;\5
+$\\{print}(\\{int\_name}[\|m])$;\5
+$\\{print}(\.{"\ values\ had\ to\ be\ adjusted\ by\ as\ much\ as\ "})$;\5
+$\\{print\_scaled}(\\{perturbation})$;\5
+$\\{print}(\.{"pt)"})$;\6
+\&{end};\par
+\fi
+
+\M1124. Here's an example of how we use these routines.
+The width data needs to be perturbed only if there are 256 distinct
+widths, but \MF\ must check for this case even though it is
+highly unusual.
+
+An integer variable \|k will be defined when we use this code.
+The \\{dimen\_head} array will contain pointers to the sorted
+lists of dimensions.
+
+\Y\P$\4\X1124:Massage the \.{TFM} widths\X\S$\6
+\\{clear\_the\_list};\6
+\&{for} $\|k\K\\{bc}\mathrel{\&{to}}\\{ec}$ \1\&{do}\6
+\&{if} $\\{char\_exists}[\|k]$ \1\&{then}\5
+$\\{tfm\_width}[\|k]\K\\{sort\_in}(\\{tfm\_width}[\|k])$;\2\2\6
+$\\{nw}\K\\{skimp}(255)+1$;\5
+$\\{dimen\_head}[1]\K\\{link}(\\{temp\_head})$;\6
+\&{if} $\\{perturbation}\G\O{10000}$ \1\&{then}\5
+$\\{tfm\_warning}(\\{char\_wd})$\2\par
+\U1206.\fi
+
+\M1125. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{dimen\_head}: \37\&{array} $[1\to4]$ \1\&{of}\5
+\\{pointer};\C{lists of \.{TFM} dimensions}\2\par
+\fi
+
+\M1126. Heights, depths, and italic corrections are different from widths
+not only because their list length is more severely restricted, but
+also because zero values do not need to be put into the lists.
+
+\Y\P$\4\X1126:Massage the \.{TFM} heights, depths, and italic corrections\X\S$\6
+\\{clear\_the\_list};\6
+\&{for} $\|k\K\\{bc}\mathrel{\&{to}}\\{ec}$ \1\&{do}\6
+\&{if} $\\{char\_exists}[\|k]$ \1\&{then}\6
+\&{if} $\\{tfm\_height}[\|k]=0$ \1\&{then}\5
+$\\{tfm\_height}[\|k]\K\\{zero\_val}$\6
+\4\&{else} $\\{tfm\_height}[\|k]\K\\{sort\_in}(\\{tfm\_height}[\|k])$;\2\2\2\6
+$\\{nh}\K\\{skimp}(15)+1$;\5
+$\\{dimen\_head}[2]\K\\{link}(\\{temp\_head})$;\6
+\&{if} $\\{perturbation}\G\O{10000}$ \1\&{then}\5
+$\\{tfm\_warning}(\\{char\_ht})$;\2\6
+\\{clear\_the\_list};\6
+\&{for} $\|k\K\\{bc}\mathrel{\&{to}}\\{ec}$ \1\&{do}\6
+\&{if} $\\{char\_exists}[\|k]$ \1\&{then}\6
+\&{if} $\\{tfm\_depth}[\|k]=0$ \1\&{then}\5
+$\\{tfm\_depth}[\|k]\K\\{zero\_val}$\6
+\4\&{else} $\\{tfm\_depth}[\|k]\K\\{sort\_in}(\\{tfm\_depth}[\|k])$;\2\2\2\6
+$\\{nd}\K\\{skimp}(15)+1$;\5
+$\\{dimen\_head}[3]\K\\{link}(\\{temp\_head})$;\6
+\&{if} $\\{perturbation}\G\O{10000}$ \1\&{then}\5
+$\\{tfm\_warning}(\\{char\_dp})$;\2\6
+\\{clear\_the\_list};\6
+\&{for} $\|k\K\\{bc}\mathrel{\&{to}}\\{ec}$ \1\&{do}\6
+\&{if} $\\{char\_exists}[\|k]$ \1\&{then}\6
+\&{if} $\\{tfm\_ital\_corr}[\|k]=0$ \1\&{then}\5
+$\\{tfm\_ital\_corr}[\|k]\K\\{zero\_val}$\6
+\4\&{else} $\\{tfm\_ital\_corr}[\|k]\K\\{sort\_in}(\\{tfm\_ital\_corr}[\|k])$;%
+\2\2\2\6
+$\\{ni}\K\\{skimp}(63)+1$;\5
+$\\{dimen\_head}[4]\K\\{link}(\\{temp\_head})$;\6
+\&{if} $\\{perturbation}\G\O{10000}$ \1\&{then}\5
+$\\{tfm\_warning}(\\{char\_ic})$\2\par
+\U1206.\fi
+
+\M1127. \P$\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}%
+\S$\6
+$\\{value}(\\{zero\_val})\K0$;\5
+$\\{info}(\\{zero\_val})\K0$;\par
+\fi
+
+\M1128. Bytes 5--8 of the header are set to the design size, unless the user
+has
+some crazy reason for specifying them differently.
+
+Error messages are not allowed at the time this procedure is called,
+so a warning is printed instead.
+
+The value of \\{max\_tfm\_dimen} is calculated so that
+$$\hbox{$\\{make\_scaled}(16\ast\\{max\_tfm\_dimen},\\{internal}[\\{design%
+\_size}])$}
+< \\{three\_bytes}.$$
+
+\Y\P\D \37$\\{three\_bytes}\S\O{100000000}$\C{$2^{24}$}\par
+\Y\P\4\&{procedure}\1\ \37\\{fix\_design\_size};\6
+\4\&{var} \37\|d: \37\\{scaled};\C{the design size}\2\6
+\&{begin} \37$\|d\K\\{internal}[\\{design\_size}]$;\6
+\&{if} $(\|d<\\{unity})\V(\|d\G\\{fraction\_half})$ \1\&{then}\6
+\&{begin} \37\&{if} $\|d\I0$ \1\&{then}\5
+$\\{print\_nl}(\.{"(illegal\ design\ size\ has\ been\ changed\ to\ 128pt)"})$;%
+\2\6
+$\|d\K\O{40000000}$;\5
+$\\{internal}[\\{design\_size}]\K\|d$;\6
+\&{end};\2\6
+\&{if} $\\{header\_byte}[5]<0$ \1\&{then}\6
+\&{if} $\\{header\_byte}[6]<0$ \1\&{then}\6
+\&{if} $\\{header\_byte}[7]<0$ \1\&{then}\6
+\&{if} $\\{header\_byte}[8]<0$ \1\&{then}\6
+\&{begin} \37$\\{header\_byte}[5]\K\|d\mathbin{\&{div}}\O{4000000}$;\5
+$\\{header\_byte}[6]\K(\|d\mathbin{\&{div}}4096)\mathbin{\&{mod}}256$;\5
+$\\{header\_byte}[7]\K(\|d\mathbin{\&{div}}16)\mathbin{\&{mod}}256$;\5
+$\\{header\_byte}[8]\K(\|d\mathbin{\&{mod}}16)\ast16$;\6
+\&{end};\2\2\2\2\6
+$\\{max\_tfm\_dimen}\K16\ast\\{internal}[\\{design\_size}]-\\{internal}[%
+\\{design\_size}]\mathbin{\&{div}}\O{10000000}$;\6
+\&{if} $\\{max\_tfm\_dimen}\G\\{fraction\_half}$ \1\&{then}\5
+$\\{max\_tfm\_dimen}\K\\{fraction\_half}-1$;\2\6
+\&{end};\par
+\fi
+
+\M1129. The \\{dimen\_out} procedure computes a \\{fix\_word} relative to the
+design size. If the data was out of range, it is corrected and the
+global variable \\{tfm\_changed} is increased by~one.
+
+\Y\P\4\&{function}\1\ \37$\\{dimen\_out}(\|x:\\{scaled})$: \37\\{integer};\2\6
+\&{begin} \37\&{if} $\\{abs}(\|x)>\\{max\_tfm\_dimen}$ \1\&{then}\6
+\&{begin} \37$\\{incr}(\\{tfm\_changed})$;\6
+\&{if} $\|x>0$ \1\&{then}\5
+$\|x\K\\{three\_bytes}-1$\ \&{else} $\|x\K1-\\{three\_bytes}$;\2\6
+\&{end}\6
+\4\&{else} $\|x\K\\{make\_scaled}(\|x\ast16,\39\\{internal}[\\{design%
+\_size}])$;\2\6
+$\\{dimen\_out}\K\|x$;\6
+\&{end};\par
+\fi
+
+\M1130. \P$\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{max\_tfm\_dimen}: \37\\{scaled};\C{bound on widths, heights, kerns, etc.}\6
+\4\\{tfm\_changed}: \37\\{integer};\C{the number of data entries that were out
+of bounds}\par
+\fi
+
+\M1131. If the user has not specified any of the first four header bytes,
+the \\{fix\_check\_sum} procedure replaces them by a ``check sum'' computed
+from the \\{tfm\_width} data relative to the design size.
+
+\Y\P\4\&{procedure}\1\ \37\\{fix\_check\_sum};\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|k: \37\\{eight\_bits};\C{runs through character codes}\6
+$\\{b1},\39\\{b2},\39\\{b3},\39\\{b4}$: \37\\{eight\_bits};\C{bytes of the
+check sum}\6
+\|x: \37\\{integer};\C{hash value used in check sum computation}\2\6
+\&{begin} \37\&{if} $\\{header\_byte}[1]<0$ \1\&{then}\6
+\&{if} $\\{header\_byte}[2]<0$ \1\&{then}\6
+\&{if} $\\{header\_byte}[3]<0$ \1\&{then}\6
+\&{if} $\\{header\_byte}[4]<0$ \1\&{then}\6
+\&{begin} \37\X1132:Compute a check sum in $(\\{b1},\\{b2},\\{b3},\\{b4})$\X;\6
+$\\{header\_byte}[1]\K\\{b1}$;\5
+$\\{header\_byte}[2]\K\\{b2}$;\5
+$\\{header\_byte}[3]\K\\{b3}$;\5
+$\\{header\_byte}[4]\K\\{b4}$;\5
+\&{return};\6
+\&{end};\2\2\2\2\6
+\&{for} $\|k\K1\mathrel{\&{to}}4$ \1\&{do}\6
+\&{if} $\\{header\_byte}[\|k]<0$ \1\&{then}\5
+$\\{header\_byte}[\|k]\K0$;\2\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M1132. \P$\X1132:Compute a check sum in $(\\{b1},\\{b2},\\{b3},\\{b4})$\X\S$\6
+$\\{b1}\K\\{bc}$;\5
+$\\{b2}\K\\{ec}$;\5
+$\\{b3}\K\\{bc}$;\5
+$\\{b4}\K\\{ec}$;\5
+$\\{tfm\_changed}\K0$;\6
+\&{for} $\|k\K\\{bc}\mathrel{\&{to}}\\{ec}$ \1\&{do}\6
+\&{if} $\\{char\_exists}[\|k]$ \1\&{then}\6
+\&{begin} \37$\|x\K\\{dimen\_out}(\\{value}(\\{tfm\_width}[\|k]))+(\|k+4)\ast%
+\O{20000000}$;\C{this is positive}\6
+$\\{b1}\K(\\{b1}+\\{b1}+\|x)\mathbin{\&{mod}}255$;\5
+$\\{b2}\K(\\{b2}+\\{b2}+\|x)\mathbin{\&{mod}}253$;\5
+$\\{b3}\K(\\{b3}+\\{b3}+\|x)\mathbin{\&{mod}}251$;\5
+$\\{b4}\K(\\{b4}+\\{b4}+\|x)\mathbin{\&{mod}}247$;\6
+\&{end}\2\2\par
+\U1131.\fi
+
+\M1133. Finally we're ready to actually write the \.{TFM} information.
+Here are some utility routines for this purpose.
+
+\Y\P\D \37$\\{tfm\_out}(\#)\S\\{write}(\\{tfm\_file},\39\#)$\C{output one byte
+to \\{tfm\_file}}\par
+\Y\P\4\&{procedure}\1\ \37$\\{tfm\_two}(\|x:\\{integer})$;\C{output two bytes
+to \\{tfm\_file}}\2\6
+\&{begin} \37$\\{tfm\_out}(\|x\mathbin{\&{div}}256)$;\5
+$\\{tfm\_out}(\|x\mathbin{\&{mod}}256)$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37$\\{tfm\_four}(\|x:\\{integer})$;\C{output four bytes to
+\\{tfm\_file}}\2\6
+\&{begin} \37\&{if} $\|x\G0$ \1\&{then}\5
+$\\{tfm\_out}(\|x\mathbin{\&{div}}\\{three\_bytes})$\6
+\4\&{else} \&{begin} \37$\|x\K\|x+\O{10000000000}$;\C{use two's complement for
+negative values}\6
+$\|x\K\|x+\O{10000000000}$;\5
+$\\{tfm\_out}((\|x\mathbin{\&{div}}\\{three\_bytes})+128)$;\6
+\&{end};\2\6
+$\|x\K\|x\mathbin{\&{mod}}\\{three\_bytes}$;\5
+$\\{tfm\_out}(\|x\mathbin{\&{div}}\\{unity})$;\5
+$\|x\K\|x\mathbin{\&{mod}}\\{unity}$;\5
+$\\{tfm\_out}(\|x\mathbin{\&{div}}\O{400})$;\5
+$\\{tfm\_out}(\|x\mathbin{\&{mod}}\O{400})$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37$\\{tfm\_qqqq}(\|x:\\{four\_quarters})$;\C{output four
+quarterwords to \\{tfm\_file}}\2\6
+\&{begin} \37$\\{tfm\_out}(\\{qo}(\|x.\\{b0}))$;\5
+$\\{tfm\_out}(\\{qo}(\|x.\\{b1}))$;\5
+$\\{tfm\_out}(\\{qo}(\|x.\\{b2}))$;\5
+$\\{tfm\_out}(\\{qo}(\|x.\\{b3}))$;\6
+\&{end};\par
+\fi
+
+\M1134. \P$\X1134:Finish the \.{TFM} file\X\S$\6
+\&{if} $\\{job\_name}=0$ \1\&{then}\5
+\\{open\_log\_file};\2\6
+$\\{pack\_job\_name}(\.{".tfm"})$;\6
+\&{while} $\R\\{b\_open\_out}(\\{tfm\_file})$ \1\&{do}\5
+$\\{prompt\_file\_name}(\.{"file\ name\ for\ font\ metrics"},\39\.{".tfm"})$;\2%
+\6
+$\\{metric\_file\_name}\K\\{b\_make\_name\_string}(\\{tfm\_file})$;\5
+\X1135:Output the subfile sizes and header bytes\X;\6
+\X1136:Output the character information bytes, then output the dimensions
+themselves\X;\6
+\X1139:Output the ligature/kern program\X;\6
+\X1140:Output the extensible character recipes and the font metric parameters%
+\X;\6
+\&{stat} \37\&{if} $\\{internal}[\\{tracing\_stats}]>0$ \1\&{then}\5
+\X1141:Log the subfile sizes of the \.{TFM} file\X;\2\ \&{tats}\6
+$\\{print\_nl}(\.{"Font\ metrics\ written\ on\ "})$;\5
+$\\{slow\_print}(\\{metric\_file\_name})$;\5
+$\\{print\_char}(\.{"."})$;\5
+$\\{b\_close}(\\{tfm\_file})$\par
+\U1206.\fi
+
+\M1135. Integer variables \\{lh}, \|k, and \\{lk\_offset} will be defined when
+we use
+this code.
+
+\Y\P$\4\X1135:Output the subfile sizes and header bytes\X\S$\6
+$\|k\K\\{header\_size}$;\6
+\&{while} $\\{header\_byte}[\|k]<0$ \1\&{do}\5
+$\\{decr}(\|k)$;\2\6
+$\\{lh}\K(\|k+3)\mathbin{\&{div}}4$;\C{this is the number of header words}\6
+\&{if} $\\{bc}>\\{ec}$ \1\&{then}\5
+$\\{bc}\K1$;\C{if there are no characters, $\\{ec}=0$ and $\\{bc}=1$}\2\6
+\X1137:Compute the ligature/kern program offset and implant the left boundary
+label\X;\6
+$\\{tfm\_two}(6+\\{lh}+(\\{ec}-\\{bc}+1)+\\{nw}+\\{nh}+\\{nd}+\\{ni}+\\{nl}+%
+\\{lk\_offset}+\\{nk}+\\{ne}+\\{np})$;\C{this is the total number of file words
+that will be output}\6
+$\\{tfm\_two}(\\{lh})$;\5
+$\\{tfm\_two}(\\{bc})$;\5
+$\\{tfm\_two}(\\{ec})$;\5
+$\\{tfm\_two}(\\{nw})$;\5
+$\\{tfm\_two}(\\{nh})$;\5
+$\\{tfm\_two}(\\{nd})$;\5
+$\\{tfm\_two}(\\{ni})$;\5
+$\\{tfm\_two}(\\{nl}+\\{lk\_offset})$;\5
+$\\{tfm\_two}(\\{nk})$;\5
+$\\{tfm\_two}(\\{ne})$;\5
+$\\{tfm\_two}(\\{np})$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}4\ast\\{lh}$ \1\&{do}\6
+\&{begin} \37\&{if} $\\{header\_byte}[\|k]<0$ \1\&{then}\5
+$\\{header\_byte}[\|k]\K0$;\2\6
+$\\{tfm\_out}(\\{header\_byte}[\|k])$;\6
+\&{end}\2\par
+\U1134.\fi
+
+\M1136. \P$\X1136:Output the character information bytes, then output the
+dimensions themselves\X\S$\6
+\&{for} $\|k\K\\{bc}\mathrel{\&{to}}\\{ec}$ \1\&{do}\6
+\&{if} $\R\\{char\_exists}[\|k]$ \1\&{then}\5
+$\\{tfm\_four}(0)$\6
+\4\&{else} \&{begin} \37$\\{tfm\_out}(\\{info}(\\{tfm\_width}[\|k]))$;\C{the
+width index}\6
+$\\{tfm\_out}((\\{info}(\\{tfm\_height}[\|k]))\ast16+\\{info}(\\{tfm\_depth}[%
+\|k]))$;\5
+$\\{tfm\_out}((\\{info}(\\{tfm\_ital\_corr}[\|k]))\ast4+\\{char\_tag}[\|k])$;\5
+$\\{tfm\_out}(\\{char\_remainder}[\|k])$;\6
+\&{end};\2\2\6
+$\\{tfm\_changed}\K0$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}4$ \1\&{do}\6
+\&{begin} \37$\\{tfm\_four}(0)$;\5
+$\|p\K\\{dimen\_head}[\|k]$;\6
+\&{while} $\|p\I\\{inf\_val}$ \1\&{do}\6
+\&{begin} \37$\\{tfm\_four}(\\{dimen\_out}(\\{value}(\|p)))$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+\&{end}\2\par
+\U1134.\fi
+
+\M1137. We need to output special instructions at the beginning of the
+\\{lig\_kern} array in order to specify the right boundary character
+and/or to handle starting addresses that exceed 255. The \\{label\_loc}
+and \\{label\_char} arrays have been set up to record all the
+starting addresses; we have $-1=\\{label\_loc}[0]<\\{label\_loc}[1]\le\cdots
+\le\\{label\_loc}[\\{label\_ptr} ] $.
+
+\Y\P$\4\X1137:Compute the ligature/kern program offset and implant the left
+boundary label\X\S$\6
+$\\{bchar}\K\\{round\_unscaled}(\\{internal}[\\{boundary\_char}])$;\6
+\&{if} $(\\{bchar}<0)\V(\\{bchar}>255)$ \1\&{then}\6
+\&{begin} \37$\\{bchar}\K-1$;\5
+$\\{lk\_started}\K\\{false}$;\5
+$\\{lk\_offset}\K0$;\ \&{end}\6
+\4\&{else} \&{begin} \37$\\{lk\_started}\K\\{true}$;\5
+$\\{lk\_offset}\K1$;\ \&{end};\2\6
+\X1138:Find the minimum \\{lk\_offset} and adjust all remainders\X;\6
+\&{if} $\\{bch\_label}<\\{undefined\_label}$ \1\&{then}\6
+\&{begin} \37$\\{skip\_byte}(\\{nl})\K\\{qi}(255)$;\5
+$\\{next\_char}(\\{nl})\K\\{qi}(0)$;\5
+$\\{op\_byte}(\\{nl})\K\\{qi}(((\\{bch\_label}+\\{lk\_offset})\mathbin{%
+\&{div}}256))$;\5
+$\\{rem\_byte}(\\{nl})\K\\{qi}(((\\{bch\_label}+\\{lk\_offset})\mathbin{%
+\&{mod}}256))$;\5
+$\\{incr}(\\{nl})$;\C{possibly $\\{nl}=\\{lig\_table\_size}+1$}\6
+\&{end}\2\par
+\U1135.\fi
+
+\M1138. \P$\X1138:Find the minimum \\{lk\_offset} and adjust all remainders\X%
+\S$\6
+$\|k\K\\{label\_ptr}$;\C{pointer to the largest unallocated label}\6
+\&{if} $\\{label\_loc}[\|k]+\\{lk\_offset}>255$ \1\&{then}\6
+\&{begin} \37$\\{lk\_offset}\K0$;\5
+$\\{lk\_started}\K\\{false}$;\C{location 0 can do double duty}\6
+\1\&{repeat} \37$\\{char\_remainder}[\\{label\_char}[\|k]]\K\\{lk\_offset}$;\6
+\&{while} $\\{label\_loc}[\|k-1]=\\{label\_loc}[\|k]$ \1\&{do}\6
+\&{begin} \37$\\{decr}(\|k)$;\5
+$\\{char\_remainder}[\\{label\_char}[\|k]]\K\\{lk\_offset}$;\6
+\&{end};\2\6
+$\\{incr}(\\{lk\_offset})$;\5
+$\\{decr}(\|k)$;\6
+\4\&{until}\5
+$\\{lk\_offset}+\\{label\_loc}[\|k]<256$;\C{N.B.: $\\{lk\_offset}=256$
+satisfies this when $\|k=0$}\2\6
+\&{end};\2\6
+\&{if} $\\{lk\_offset}>0$ \1\&{then}\6
+\&{while} $\|k>0$ \1\&{do}\6
+\&{begin} \37$\\{char\_remainder}[\\{label\_char}[\|k]]\K\\{char\_remainder}[%
+\\{label\_char}[\|k]]+\\{lk\_offset}$;\5
+$\\{decr}(\|k)$;\6
+\&{end}\2\2\par
+\U1137.\fi
+
+\M1139. \P$\X1139:Output the ligature/kern program\X\S$\6
+\&{for} $\|k\K0\mathrel{\&{to}}255$ \1\&{do}\6
+\&{if} $\\{skip\_table}[\|k]<\\{undefined\_label}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"(local\ label\ "})$;\5
+$\\{print\_int}(\|k)$;\5
+$\\{print}(\.{"::\ was\ missing)"})$;\5
+$\\{cancel\_skips}(\\{skip\_table}[\|k])$;\6
+\&{end};\2\2\6
+\&{if} $\\{lk\_started}$ \1\&{then}\C{$\\{lk\_offset}=1$ for the special %
+\\{bchar}}\6
+\&{begin} \37$\\{tfm\_out}(255)$;\5
+$\\{tfm\_out}(\\{bchar})$;\5
+$\\{tfm\_two}(0)$;\6
+\&{end}\6
+\4\&{else} \&{for} $\|k\K1\mathrel{\&{to}}\\{lk\_offset}$ \1\&{do}\C{output the
+redirection specs}\6
+\&{begin} \37$\\{ll}\K\\{label\_loc}[\\{label\_ptr}]$;\6
+\&{if} $\\{bchar}<0$ \1\&{then}\6
+\&{begin} \37$\\{tfm\_out}(254)$;\5
+$\\{tfm\_out}(0)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{tfm\_out}(255)$;\5
+$\\{tfm\_out}(\\{bchar})$;\6
+\&{end};\2\6
+$\\{tfm\_two}(\\{ll}+\\{lk\_offset})$;\6
+\1\&{repeat} \37$\\{decr}(\\{label\_ptr})$;\6
+\4\&{until}\5
+$\\{label\_loc}[\\{label\_ptr}]<\\{ll}$;\2\6
+\&{end};\2\2\6
+\&{for} $\|k\K0\mathrel{\&{to}}\\{nl}-1$ \1\&{do}\5
+$\\{tfm\_qqqq}(\\{lig\_kern}[\|k])$;\2\6
+\&{for} $\|k\K0\mathrel{\&{to}}\\{nk}-1$ \1\&{do}\5
+$\\{tfm\_four}(\\{dimen\_out}(\\{kern}[\|k]))$\2\par
+\U1134.\fi
+
+\M1140. \P$\X1140:Output the extensible character recipes and the font metric
+parameters\X\S$\6
+\&{for} $\|k\K0\mathrel{\&{to}}\\{ne}-1$ \1\&{do}\5
+$\\{tfm\_qqqq}(\\{exten}[\|k])$;\2\6
+\&{for} $\|k\K1\mathrel{\&{to}}\\{np}$ \1\&{do}\6
+\&{if} $\|k=1$ \1\&{then}\6
+\&{if} $\\{abs}(\\{param}[1])<\\{fraction\_half}$ \1\&{then}\5
+$\\{tfm\_four}(\\{param}[1]\ast16)$\6
+\4\&{else} \&{begin} \37$\\{incr}(\\{tfm\_changed})$;\6
+\&{if} $\\{param}[1]>0$ \1\&{then}\5
+$\\{tfm\_four}(\\{el\_gordo})$\6
+\4\&{else} $\\{tfm\_four}(-\\{el\_gordo})$;\2\6
+\&{end}\2\6
+\4\&{else} $\\{tfm\_four}(\\{dimen\_out}(\\{param}[\|k]))$;\2\2\6
+\&{if} $\\{tfm\_changed}>0$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{tfm\_changed}=1$ \1\&{then}\5
+$\\{print\_nl}(\.{"(a\ font\ metric\ dimension"})$\6
+\4\&{else} \&{begin} \37$\\{print\_nl}(\.{"("})$;\5
+$\\{print\_int}(\\{tfm\_changed})$;\5
+$\\{print}(\.{"\ font\ metric\ dimensions"})$;\6
+\&{end};\2\6
+$\\{print}(\.{"\ had\ to\ be\ decreased)"})$;\6
+\&{end}\2\par
+\U1134.\fi
+
+\M1141. \P$\X1141:Log the subfile sizes of the \.{TFM} file\X\S$\6
+\&{begin} \37$\\{wlog\_ln}(\.{\'\ \'})$;\6
+\&{if} $\\{bch\_label}<\\{undefined\_label}$ \1\&{then}\5
+$\\{decr}(\\{nl})$;\2\6
+$\\{wlog\_ln}(\.{\'(You\ used\ \'},\39\\{nw}:1,\39\.{\'w,\'},\39\30\\{nh}:1,\39%
+\.{\'h,\'},\39\30\\{nd}:1,\39\.{\'d,\'},\39\30\\{ni}:1,\39\.{\'i,\'},\39\30%
+\\{nl}:1,\39\.{\'l,\'},\39\30\\{nk}:1,\39\.{\'k,\'},\39\30\\{ne}:1,\39\.{\'e,%
+\'},\39\30\\{np}:1,\39\.{\'p\ metric\ file\ positions\'})$;\5
+$\\{wlog\_ln}(\.{\'\ \ out\ of\ \'},\39\30\.{\'256w,16h,16d,64i,\'},\39\30%
+\\{lig\_table\_size}:1,\39\.{\'l,\'},\39\\{max\_kerns}:1,\39\.{\'k,256e,\'},\39%
+\30\\{max\_font\_dimen}:1,\39\.{\'p)\'})$;\6
+\&{end}\par
+\U1134.\fi
+
+\N1142. \[46] Generic font file format.
+The most important output produced by a typical run of \MF\ is the
+``generic font'' (\.{GF}) file that specifies the bit patterns of the
+characters that have been drawn. The term {\sl generic\/} indicates that
+this file format doesn't match the conventions of any name-brand manufacturer;
+but it is easy to convert \.{GF} files to the special format required by
+almost all digital phototypesetting equipment. There's a strong analogy
+between the \.{DVI} files written by \TeX\ and the \.{GF} files written
+by \MF; and, in fact, the file formats have a lot in common.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`\\{boc}' (beginning of character) command has six parameters, each of
+which is four bytes long. Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+\\{pre} command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a \\{boc} command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an \\{eoc} command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each \\{eoc} command is immediately followed by a
+\\{boc} command, or by a \\{post} command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+\fi
+
+\M1143. The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~\|m; and (b)~the current row number,~\|n. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to get extremely large, but the \.{GF} format tries to be more
+general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising
+the
+region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~\|n and column~\|m consists of the points whose \MF\
+coordinates $(\|x,\|y)$ satisfy $\|m\L\|x\L\|m+1$ and $\|n\L\|y\L\|n+1$.
+Negative values of
+\|m and~\|x correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of \|n and~\|y correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides \|m and \|n, there's also a third aspect of the current
+state, namely the \\{paint\_switch}, which is always either \\{black} or
+\\{white}. Each \\{paint} command advances \|m by a specified amount~\|d,
+and blackens the intervening pixels if $\\{paint\_switch}=\\{black}$; then
+the \\{paint\_switch} changes to the opposite state. \.{GF}'s commands are
+designed so that \|m will never decrease within a row, and \|n will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened.
+
+\fi
+
+\M1144. Here is a list of all the commands that may appear in a \.{GF} file.
+Each
+command is specified by its symbolic name (e.g., \\{boc}), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`$\|d[2]$' means that parameter \|d is two bytes long.
+
+\yskip\hang\\{paint\_0} 0. This is a \\{paint} command with $\|d=0$; it does
+nothing but change the \\{paint\_switch} from \\{black} to \\{white} or
+vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with $\|d=1$ to~63, defined as follows: If
+$\\{paint\_switch}=\\{black}$, blacken \|d~pixels of the current row~\|n,
+in columns \|m through $\|m+\|d-1$ inclusive. Then, in any case,
+complement the \\{paint\_switch} and advance \|m by~\|d.
+
+\yskip\hang\\{paint1} 64 $\|d[1]$. This is a \\{paint} command with a specified
+value of~\|d; \MF\ uses it to paint when $64\L\|d<256$.
+
+\yskip\hang\\{paint2} 65 $\|d[2]$. Same as \\{paint1}, but \|d~can be as high
+as~65535.
+
+\yskip\hang\\{paint3} 66 $\|d[3]$. Same as \\{paint1}, but \|d~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang\\{boc} 67 $\|c[4]$ $\|p[4]$ $\\{min\_m}[4]$ $\\{max\_m}[4]$ $\\{min%
+\_n}[4]$
+$\\{max\_n}[4]$. Beginning of a character: Here \|c is the character code, and
+\|p points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer \|p is $-1$ if there was no
+prior character with an equivalent code.) The values of registers \|m and \|n
+defined by the instructions that follow for this character must
+satisfy $\\{min\_m}\L\|m\L\\{max\_m}$ and $\\{min\_n}\L\|n\L\\{max\_n}$. (The
+values of \\{max\_m} and
+\\{min\_n} need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a \\{boc}, it can use \\{min\_m}, \\{max\_m}, \\{min\_n}, and %
+\\{max\_n} to
+initialize the bounds of an array. Then it sets $\|m\K\\{min\_m}$, $\|n\K\\{max%
+\_n}$, and
+$\\{paint\_switch}\K\\{white}$.
+
+\yskip\hang\\{boc1} 68 $\|c[1]$ $\\{del\_m}[1]$ $\\{max\_m}[1]$ $\\{del\_n}[1]$
+$\\{max\_n}[1]$.
+Same as \\{boc}, but \|p is assumed to be~$-1$; also $\\{del\_m}=\\{max\_m}-%
+\\{min\_m}$
+and $\\{del\_n}=\\{max\_n}-\\{min\_n}$ are given instead of \\{min\_m} and %
+\\{min\_n}.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated \\{boc} saves 19~bytes per character, in common cases.)
+
+\yskip\hang\\{eoc} 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have \\{eoc} immediately following \\{boc}.
+
+\yskip\hang\\{skip0} 70. Decrease \|n by 1 and set $\|m\K\\{min\_m}$,
+$\\{paint\_switch}\K\\{white}$. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang\\{skip1} 71 $\|d[1]$. Decrease \|n by $\|d+1$, set $\|m\K\\{min%
+\_m}$, and set
+$\\{paint\_switch}\K\\{white}$. This is a way to produce \|d all-white rows.
+
+\yskip\hang\\{skip2} 72 $\|d[2]$. Same as \\{skip1}, but \|d can be as large
+as 65535.
+
+\yskip\hang\\{skip3} 73 $\|d[3]$. Same as \\{skip1}, but \|d can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang\\{new\_row\_0} 74. Decrease \|n by 1 and set $\|m\K\\{min\_m}$,
+$\\{paint\_switch}\K\\{black}$. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang\\{new\_row\_1} through \\{new\_row\_164} (opcodes 75 to 238). Same
+as
+\\{new\_row\_0}, but with $\|m\K\\{min\_m}+1$ through $\\{min\_m}+164$,
+respectively.
+
+\yskip\hang\\{xxx1} 239 $\|k[1]$ $\|x[\|k]$. This command is undefined in
+general; it functions as a $(k+2)$-byte \\{no\_op} unless special %
+\.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear within characters,
+in \.{GF} files generated by other
+processors. It is recommended that \|x be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang\\{xxx2} 240 $\|k[2]$ $\|x[\|k]$. Like \\{xxx1}, but $0\L\|k<65536$.
+
+\yskip\hang\\{xxx3} 241 $\|k[3]$ $\|x[\|k]$. Like \\{xxx1}, but $0\L\|k<%
+\hbox{$2^{24}$}$.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang\\{xxx4} 242 $\|k[4]$ $\|x[\|k]$. Like \\{xxx1}, but \|k can be
+ridiculously large; \|k mustn't be negative.
+
+\yskip\hang\\{yyy} 243 $\|y[4]$. This command is undefined in general;
+it functions as a 5-byte \\{no\_op} unless special \.{GF}-reading programs
+are being used. \MF\ puts \\{scaled} numbers into \\{yyy}'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang\\{no\_op} 244. No operation, do nothing. Any number of \\{no\_op}'s
+may occur between \.{GF} commands, but a \\{no\_op} cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang\\{char\_loc} 245 $\|c[1]$ $\\{dx}[4]$ $\\{dy}[4]$ $\|w[4]$ $%
+\|p[4]$.
+This command will appear only in the postamble, which will be explained
+shortly.
+
+\yskip\hang\\{char\_loc0} 246 $\|c[1]$ $\\{dm}[1]$ $\|w[4]$ $\|p[4]$.
+Same as \\{char\_loc}, except that \\{dy} is assumed to be zero, and the value
+of~\\{dx} is taken to be $65536\ast\\{dm}$, where $0\L\\{dm}<256$.
+
+\yskip\hang\\{pre} 247 $\|i[1]$ $\|k[1]$ $\|x[\|k]$.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter \|i is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first \\{boc}.)
+
+\yskip\hang\\{post} 248. Beginning of the postamble, see below.
+
+\yskip\hang\\{post\_post} 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+\Y\P\D \37$\\{gf\_id\_byte}=131$\C{identifies the kind of \.{GF} files
+described here}\par
+\fi
+
+\M1145. \MF\ refers to the following opcodes explicitly.
+
+\Y\P\D \37$\\{paint\_0}=0$\C{beginning of the \\{paint} commands}\par
+\P\D \37$\\{paint1}=64$\C{move right a given number of columns, then black${}%
+\swap{}$white}\par
+\P\D \37$\\{boc}=67$\C{beginning of a character}\par
+\P\D \37$\\{boc1}=68$\C{short form of \\{boc}}\par
+\P\D \37$\\{eoc}=69$\C{end of a character}\par
+\P\D \37$\\{skip0}=70$\C{skip no blank rows}\par
+\P\D \37$\\{skip1}=71$\C{skip over blank rows}\par
+\P\D \37$\\{new\_row\_0}=74$\C{move down one row and then right}\par
+\P\D \37$\\{max\_new\_row}=164$\C{the largest \\{new\_row} command is \\{new%
+\_row\_164}}\par
+\P\D \37$\\{xxx1}=239$\C{for \&{special} strings}\par
+\P\D \37$\\{xxx3}=241$\C{for long \&{special} strings}\par
+\P\D \37$\\{yyy}=243$\C{for \&{numspecial} numbers}\par
+\P\D \37$\\{char\_loc}=245$\C{character locators in the postamble}\par
+\P\D \37$\\{pre}=247$\C{preamble}\par
+\P\D \37$\\{post}=248$\C{postamble beginning}\par
+\P\D \37$\\{post\_post}=249$\C{postamble ending}\par
+\fi
+
+\M1146. The last character in a \.{GF} file is followed by `\\{post}'; this
+command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+\\{post} $\|p[4]$ $\\{ds}[4]$ $\\{cs}[4]$ $\\{hppp}[4]$ $\\{vppp}[4]$
+$\\{min\_m}[4]$ $\\{max\_m}[4]$ $\\{min\_n}[4]$ $\\{max\_n}[4]$\cr
+$\langle\,$character locators$\,\rangle$\cr
+\\{post\_post} $\|q[4]$ $\|i[1]$ 223's$[{\G}4]$\cr}}$$
+Here \|p is a pointer to the byte following the final \\{eoc} in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The \\{ds} and \\{cs} parameters
+give the design size and check sum, respectively, which are exactly the
+values put into the header of the \.{TFM} file that \MF\ produces (or
+would produce) on this run. Parameters \\{hppp} and \\{vppp} are the ratios of
+pixels per point, horizontally and vertically, expressed as \\{scaled} integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come \\{min\_m}, \\{max\_m}, \\{min\_n}, and \\{max\_n}, which bound the values
+that
+registers \|m and~\|n assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; \\{max\_m} and \\{min\_n} may, on
+the
+other hand, be tighter than the similar bounds in \\{boc} commands. For
+example, some character may have $\\{min\_n}=-100$ in its \\{boc}, but it might
+turn out that \|n never gets lower than $-50$ in any character; then
+\\{min\_n} can have any value $\L-50$. If there are no characters in the file,
+it's possible to have $\\{min\_m}>\\{max\_m}$ and/or $\\{min\_n}>\\{max\_n}$.)
+
+\fi
+
+\M1147. Character locators are introduced by \\{char\_loc} commands,
+which specify a character residue~\|c, character escapements ($\\{dx},\\{dy}$),
+a character width~\|w, and a pointer~\|p
+to the beginning of that character. (If two or more characters have the
+same code~\|c modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+
+The character escapements ($\\{dx},\\{dy}$) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of \\{scaled} pixels;
+i.e., \\{dx} is in horizontal pixel units times $2^{16}$, and \\{dy} is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, \\{dy}
+should be zero, but other document file formats allow nonzero vertical
+escapement.
+
+The character width~\|w duplicates the information in the \.{TFM} file; it
+is a \\{fix\_word} value relative to the design size, and it should be
+independent of magnification.
+
+The backpointer \|p points to the character's \\{boc}, or to the first of
+a sequence of consecutive \\{xxx} or \\{yyy} or \\{no\_op} commands that
+immediately precede the \\{boc}, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about \|p applies also to the backpointers
+in \\{boc} commands, even though it wasn't explained in the description
+of~\\{boc}.
+
+Pointer \|p might be $-1$ if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had $\\{proofing}<0$ when the character was being shipped out,
+but then made $\\{proofing}\G0$ in order to get a \.{GF} file.
+
+\fi
+
+\M1148. The last part of the postamble, following the \\{post\_post} byte that
+signifies the end of the character locators, contains \|q, a pointer to the
+\\{post} command that started the postamble. An identification byte, \|i,
+comes next; this currently equals~131, as in the preamble.
+
+The \|i byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., \O{337} in octal). \MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+\|q, and move to byte \|q of the file. This byte should, of course,
+contain the value 248 (\\{post}); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual
+characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating
+systems.
+But if \.{GF} files have to be processed under the restrictions of standard
+\PASCAL, one can simply read them from front to back. This will
+be adequate for most applications. However, the postamble-first approach
+would facilitate a program that merges two \.{GF} files, replacing data
+from one that is overridden by corresponding data in the other.
+
+\fi
+
+\N1149. \[47] Shipping characters out.
+The \\{ship\_out} procedure, to be described below, is given a pointer to
+an edge structure. Its mission is to describe the the positive pixels
+in \.{GF} form, outputting a ``character'' to \\{gf\_file}.
+
+Several global variables hold information about the font file as a whole:\
+\\{gf\_min\_m}, \\{gf\_max\_m}, \\{gf\_min\_n}, and \\{gf\_max\_n} are the
+minimum and
+maximum \.{GF} coordinates output so far; \\{gf\_prev\_ptr} is the byte number
+following the preamble or the last \\{eoc} command in the output;
+\\{total\_chars} is the total number of characters (i.e., $\\{boc}\to\\{eoc}$
+segments)
+shipped out. There's also an array, \\{char\_ptr}, containing the starting
+positions of each character in the file, as required for the postamble. If
+character code~\|c has not yet been output, $\\{char\_ptr}[\|c]=-1$.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{gf\_min\_m},\39\\{gf\_max\_m},\39\\{gf\_min\_n},\39\\{gf\_max\_n}$: \37%
+\\{integer};\C{bounding rectangle}\6
+\4\\{gf\_prev\_ptr}: \37\\{integer};\C{where the present/next character
+started/starts}\6
+\4\\{total\_chars}: \37\\{integer};\C{the number of characters output so far}\6
+\4\\{char\_ptr}: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+\\{integer};\C{where individual characters started}\2\6
+\4$\\{gf\_dx},\39\\{gf\_dy}$: \37\&{array} $[\\{eight\_bits}]$ \1\&{of}\5
+\\{integer};\C{device escapements}\2\par
+\fi
+
+\M1150. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{gf\_prev\_ptr}\K0$;\5
+$\\{total\_chars}\K0$;\par
+\fi
+
+\M1151. The \.{GF} bytes are output to a buffer instead of being sent
+byte-by-byte to \\{gf\_file}, because this tends to save a lot of
+subroutine-call overhead. \MF\ uses the same conventions for \\{gf\_file}
+as \TeX\ uses for its \\{dvi\_file}; hence if system-dependent
+changes are needed, they should probably be the same for both programs.
+
+The output buffer is divided into two parts of equal size; the bytes found
+in $\\{gf\_buf}[0\to\\{half\_buf}-1]$ constitute the first half, and those in
+$\\{gf\_buf}[\\{half\_buf}\to\\{gf\_buf\_size}-1]$ constitute the second. The
+global
+variable \\{gf\_ptr} points to the position that will receive the next
+output byte. When \\{gf\_ptr} reaches \\{gf\_limit}, which is always equal
+to one of the two values \\{half\_buf} or \\{gf\_buf\_size}, the half buffer
+that
+is about to be invaded next is sent to the output and \\{gf\_limit} is
+changed to its other value. Thus, there is always at least a half buffer's
+worth of information present, except at the very beginning of the job.
+
+Bytes of the \.{GF} file are numbered sequentially starting with 0;
+the next byte to be generated will be number $\\{gf\_offset}+\\{gf\_ptr}$.
+
+\Y\P$\4\X18:Types in the outer block\X\mathrel{+}\S$\6
+$\\{gf\_index}=0\to\\{gf\_buf\_size}$;\C{an index into the output buffer}\par
+\fi
+
+\M1152. Some systems may find it more efficient to make \\{gf\_buf} a %
+\&{packed}
+array, since output of four bytes at once may be facilitated.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{gf\_buf}: \37\&{array} $[\\{gf\_index}]$ \1\&{of}\5
+\\{eight\_bits};\C{buffer for \.{GF} output}\2\6
+\4\\{half\_buf}: \37\\{gf\_index};\C{half of \\{gf\_buf\_size}}\6
+\4\\{gf\_limit}: \37\\{gf\_index};\C{end of the current half buffer}\6
+\4\\{gf\_ptr}: \37\\{gf\_index};\C{the next available buffer address}\6
+\4\\{gf\_offset}: \37\\{integer};\C{\\{gf\_buf\_size} times the number of times
+the output buffer has been fully emptied}\par
+\fi
+
+\M1153. Initially the buffer is all in one piece; we will output half of it
+only
+after it first fills up.
+
+\Y\P$\4\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{half\_buf}\K\\{gf\_buf\_size}\mathbin{\&{div}}2$;\5
+$\\{gf\_limit}\K\\{gf\_buf\_size}$;\5
+$\\{gf\_ptr}\K0$;\5
+$\\{gf\_offset}\K0$;\par
+\fi
+
+\M1154. The actual output of $\\{gf\_buf}[\|a\to\|b]$ to \\{gf\_file} is
+performed by calling
+$\\{write\_gf}(\|a,\|b)$. It is safe to assume that \|a and $\|b+1$ will both
+be
+multiples of 4 when $\\{write\_gf}(\|a,\|b)$ is called; therefore it is
+possible on
+many machines to use efficient methods to pack four bytes per word and to
+output an array of words with one system call.
+
+\Y\P$\4\X1154:Declare generic font output procedures\X\S$\6
+\4\&{procedure}\1\ \37$\\{write\_gf}(\|a,\39\|b:\\{gf\_index})$;\6
+\4\&{var} \37\|k: \37\\{gf\_index};\2\6
+\&{begin} \37\&{for} $\|k\K\|a\mathrel{\&{to}}\|b$ \1\&{do}\5
+$\\{write}(\\{gf\_file},\39\\{gf\_buf}[\|k])$;\2\6
+\&{end};\par
+\As1155, 1157, 1158, 1159, 1160, 1161, 1163\ETs1165.
+\U989.\fi
+
+\M1155. To put a byte in the buffer without paying the cost of invoking a
+procedure
+each time, we use the macro \\{gf\_out}.
+
+\Y\P\D \37$\\{gf\_out}(\#)\S$\ \&{begin} \37$\\{gf\_buf}[\\{gf\_ptr}]\K\#$;\5
+$\\{incr}(\\{gf\_ptr})$;\6
+\&{if} $\\{gf\_ptr}=\\{gf\_limit}$ \1\&{then}\5
+\\{gf\_swap};\2\6
+\&{end}\par
+\Y\P$\4\X1154:Declare generic font output procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{gf\_swap};\C{outputs half of the buffer}\2\6
+\&{begin} \37\&{if} $\\{gf\_limit}=\\{gf\_buf\_size}$ \1\&{then}\6
+\&{begin} \37$\\{write\_gf}(0,\39\\{half\_buf}-1)$;\5
+$\\{gf\_limit}\K\\{half\_buf}$;\5
+$\\{gf\_offset}\K\\{gf\_offset}+\\{gf\_buf\_size}$;\5
+$\\{gf\_ptr}\K0$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{write\_gf}(\\{half\_buf},\39\\{gf\_buf\_size}-1)$;\5
+$\\{gf\_limit}\K\\{gf\_buf\_size}$;\6
+\&{end};\2\6
+\&{end};\par
+\fi
+
+\M1156. Here is how we clean out the buffer when \MF\ is all through; \\{gf%
+\_ptr}
+will be a multiple of~4.
+
+\Y\P$\4\X1156:Empty the last bytes out of \\{gf\_buf}\X\S$\6
+\&{if} $\\{gf\_limit}=\\{half\_buf}$ \1\&{then}\5
+$\\{write\_gf}(\\{half\_buf},\39\\{gf\_buf\_size}-1)$;\2\6
+\&{if} $\\{gf\_ptr}>0$ \1\&{then}\5
+$\\{write\_gf}(0,\39\\{gf\_ptr}-1)$\2\par
+\U1182.\fi
+
+\M1157. The \\{gf\_four} procedure outputs four bytes in two's complement
+notation,
+without risking arithmetic overflow.
+
+\Y\P$\4\X1154:Declare generic font output procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{gf\_four}(\|x:\\{integer})$;\2\6
+\&{begin} \37\&{if} $\|x\G0$ \1\&{then}\5
+$\\{gf\_out}(\|x\mathbin{\&{div}}\\{three\_bytes})$\6
+\4\&{else} \&{begin} \37$\|x\K\|x+\O{10000000000}$;\5
+$\|x\K\|x+\O{10000000000}$;\5
+$\\{gf\_out}((\|x\mathbin{\&{div}}\\{three\_bytes})+128)$;\6
+\&{end};\2\6
+$\|x\K\|x\mathbin{\&{mod}}\\{three\_bytes}$;\5
+$\\{gf\_out}(\|x\mathbin{\&{div}}\\{unity})$;\5
+$\|x\K\|x\mathbin{\&{mod}}\\{unity}$;\5
+$\\{gf\_out}(\|x\mathbin{\&{div}}\O{400})$;\5
+$\\{gf\_out}(\|x\mathbin{\&{mod}}\O{400})$;\6
+\&{end};\par
+\fi
+
+\M1158. Of course, it's even easier to output just two or three bytes.
+
+\Y\P$\4\X1154:Declare generic font output procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{gf\_two}(\|x:\\{integer})$;\2\6
+\&{begin} \37$\\{gf\_out}(\|x\mathbin{\&{div}}\O{400})$;\5
+$\\{gf\_out}(\|x\mathbin{\&{mod}}\O{400})$;\6
+\&{end};\7
+\4\&{procedure}\1\ \37$\\{gf\_three}(\|x:\\{integer})$;\2\6
+\&{begin} \37$\\{gf\_out}(\|x\mathbin{\&{div}}\\{unity})$;\5
+$\\{gf\_out}((\|x\mathbin{\&{mod}}\\{unity})\mathbin{\&{div}}\O{400})$;\5
+$\\{gf\_out}(\|x\mathbin{\&{mod}}\O{400})$;\6
+\&{end};\par
+\fi
+
+\M1159. We need a simple routine to generate a \\{paint}
+command of the appropriate type.
+
+\Y\P$\4\X1154:Declare generic font output procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{gf\_paint}(\|d:\\{integer})$;\C{here $0\L\|d<65536$}%
+\2\6
+\&{begin} \37\&{if} $\|d<64$ \1\&{then}\5
+$\\{gf\_out}(\\{paint\_0}+\|d)$\6
+\4\&{else} \&{if} $\|d<256$ \1\&{then}\6
+\&{begin} \37$\\{gf\_out}(\\{paint1})$;\5
+$\\{gf\_out}(\|d)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{gf\_out}(\\{paint1}+1)$;\5
+$\\{gf\_two}(\|d)$;\6
+\&{end};\2\2\6
+\&{end};\par
+\fi
+
+\M1160. And \\{gf\_string} outputs one or two strings. If the first string
+number
+is nonzero, an \\{xxx} command is generated.
+
+\Y\P$\4\X1154:Declare generic font output procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{gf\_string}(\|s,\39\|t:\\{str\_number})$;\6
+\4\&{var} \37\|k: \37\\{pool\_pointer};\5
+\|l: \37\\{integer};\C{length of the strings to output}\2\6
+\&{begin} \37\&{if} $\|s\I0$ \1\&{then}\6
+\&{begin} \37$\|l\K\\{length}(\|s)$;\6
+\&{if} $\|t\I0$ \1\&{then}\5
+$\|l\K\|l+\\{length}(\|t)$;\2\6
+\&{if} $\|l\L255$ \1\&{then}\6
+\&{begin} \37$\\{gf\_out}(\\{xxx1})$;\5
+$\\{gf\_out}(\|l)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{gf\_out}(\\{xxx3})$;\5
+$\\{gf\_three}(\|l)$;\6
+\&{end};\2\6
+\&{for} $\|k\K\\{str\_start}[\|s]\mathrel{\&{to}}\\{str\_start}[\|s+1]-1$ \1%
+\&{do}\5
+$\\{gf\_out}(\\{so}(\\{str\_pool}[\|k]))$;\2\6
+\&{end};\2\6
+\&{if} $\|t\I0$ \1\&{then}\6
+\&{for} $\|k\K\\{str\_start}[\|t]\mathrel{\&{to}}\\{str\_start}[\|t+1]-1$ \1%
+\&{do}\5
+$\\{gf\_out}(\\{so}(\\{str\_pool}[\|k]))$;\2\2\6
+\&{end};\par
+\fi
+
+\M1161. The choice between \\{boc} commands is handled by \\{gf\_boc}.
+
+\Y\P\D $\\{one\_byte}(\#)\S\#\G0$ \&{then} \6
+\&{if} $\#<256$\par
+\Y\P$\4\X1154:Declare generic font output procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{gf\_boc}(\\{min\_m},\39\\{max\_m},\39\\{min\_n},\39%
+\\{max\_n}:\\{integer})$;\6
+\4\&{label} \37\\{exit};\2\6
+\&{begin} \37\&{if} $\\{min\_m}<\\{gf\_min\_m}$ \1\&{then}\5
+$\\{gf\_min\_m}\K\\{min\_m}$;\2\6
+\&{if} $\\{max\_n}>\\{gf\_max\_n}$ \1\&{then}\5
+$\\{gf\_max\_n}\K\\{max\_n}$;\2\6
+\&{if} $\\{boc\_p}=-1$ \1\&{then}\6
+\&{if} $\\{one\_byte}(\\{boc\_c})$ \1\&{then}\6
+\&{if} $\\{one\_byte}(\\{max\_m}-\\{min\_m})$ \1\&{then}\6
+\&{if} $\\{one\_byte}(\\{max\_m})$ \1\&{then}\6
+\&{if} $\\{one\_byte}(\\{max\_n}-\\{min\_n})$ \1\&{then}\6
+\&{if} $\\{one\_byte}(\\{max\_n})$ \1\&{then}\6
+\&{begin} \37$\\{gf\_out}(\\{boc1})$;\5
+$\\{gf\_out}(\\{boc\_c})$;\6
+$\\{gf\_out}(\\{max\_m}-\\{min\_m})$;\5
+$\\{gf\_out}(\\{max\_m})$;\5
+$\\{gf\_out}(\\{max\_n}-\\{min\_n})$;\5
+$\\{gf\_out}(\\{max\_n})$;\5
+\&{return};\6
+\&{end};\2\2\2\2\2\2\6
+$\\{gf\_out}(\\{boc})$;\5
+$\\{gf\_four}(\\{boc\_c})$;\5
+$\\{gf\_four}(\\{boc\_p})$;\6
+$\\{gf\_four}(\\{min\_m})$;\5
+$\\{gf\_four}(\\{max\_m})$;\5
+$\\{gf\_four}(\\{min\_n})$;\5
+$\\{gf\_four}(\\{max\_n})$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M1162. Two of the parameters to \\{gf\_boc} are global.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4$\\{boc\_c},\39\\{boc\_p}$: \37\\{integer};\C{parameters of the next \\{boc}
+command}\par
+\fi
+
+\M1163. Here is a routine that gets a \.{GF} file off to a good start.
+
+\Y\P\D \37$\\{check\_gf}\S\hbox{}$\ \&{if} $\\{output\_file\_name}=0$ \1%
+\&{then}\5
+\\{init\_gf}\2\par
+\Y\P$\4\X1154:Declare generic font output procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{init\_gf};\6
+\4\&{var} \37\|k: \37\\{eight\_bits};\C{runs through all possible character
+codes}\6
+\|t: \37\\{integer};\C{the time of this run}\2\6
+\&{begin} \37$\\{gf\_min\_m}\K4096$;\5
+$\\{gf\_max\_m}\K-4096$;\5
+$\\{gf\_min\_n}\K4096$;\5
+$\\{gf\_max\_n}\K-4096$;\6
+\&{for} $\|k\K0\mathrel{\&{to}}255$ \1\&{do}\5
+$\\{char\_ptr}[\|k]\K-1$;\2\6
+\X1164:Determine the file extension, \\{gf\_ext}\X;\6
+\\{set\_output\_file\_name};\5
+$\\{gf\_out}(\\{pre})$;\5
+$\\{gf\_out}(\\{gf\_id\_byte})$;\C{begin to output the preamble}\6
+$\\{old\_setting}\K\\{selector}$;\5
+$\\{selector}\K\\{new\_string}$;\5
+$\\{print}(\.{"\ METAFONT\ output\ "})$;\5
+$\\{print\_int}(\\{round\_unscaled}(\\{internal}[\\{year}]))$;\5
+$\\{print\_char}(\.{"."})$;\5
+$\\{print\_dd}(\\{round\_unscaled}(\\{internal}[\\{month}]))$;\5
+$\\{print\_char}(\.{"."})$;\5
+$\\{print\_dd}(\\{round\_unscaled}(\\{internal}[\\{day}]))$;\5
+$\\{print\_char}(\.{":"})$;\6
+$\|t\K\\{round\_unscaled}(\\{internal}[\\{time}])$;\5
+$\\{print\_dd}(\|t\mathbin{\&{div}}60)$;\5
+$\\{print\_dd}(\|t\mathbin{\&{mod}}60)$;\6
+$\\{selector}\K\\{old\_setting}$;\5
+$\\{gf\_out}(\\{cur\_length})$;\5
+$\\{str\_start}[\\{str\_ptr}+1]\K\\{pool\_ptr}$;\5
+$\\{gf\_string}(0,\39\\{str\_ptr})$;\5
+$\\{pool\_ptr}\K\\{str\_start}[\\{str\_ptr}]$;\C{flush that string from memory}%
+\6
+$\\{gf\_prev\_ptr}\K\\{gf\_offset}+\\{gf\_ptr}$;\6
+\&{end};\par
+\fi
+
+\M1164. \P$\X1164:Determine the file extension, \\{gf\_ext}\X\S$\6
+\&{if} $\\{internal}[\\{hppp}]\L0$ \1\&{then}\5
+$\\{gf\_ext}\K\.{".gf"}$\6
+\4\&{else} \&{begin} \37$\\{old\_setting}\K\\{selector}$;\5
+$\\{selector}\K\\{new\_string}$;\5
+$\\{print\_char}(\.{"."})$;\5
+$\\{print\_int}(\\{make\_scaled}(\\{internal}[\\{hppp}],\3959429463))$;%
+\C{$2^{32}/72.27\approx59429463.07$}\6
+$\\{print}(\.{"gf"})$;\5
+$\\{gf\_ext}\K\\{make\_string}$;\5
+$\\{selector}\K\\{old\_setting}$;\6
+\&{end}\2\par
+\U1163.\fi
+
+\M1165. With those preliminaries out of the way, \\{ship\_out} is not
+especially
+difficult.
+
+\Y\P$\4\X1154:Declare generic font output procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37$\\{ship\_out}(\|c:\\{eight\_bits})$;\6
+\4\&{label} \37\\{done};\6
+\4\&{var} \37\|f: \37\\{integer};\C{current character extension}\6
+$\\{prev\_m},\39\|m,\39\\{mm}$: \37\\{integer};\C{previous and current pixel
+column numbers}\6
+$\\{prev\_n},\39\|n$: \37\\{integer};\C{previous and current pixel row numbers}%
+\6
+$\|p,\39\|q$: \37\\{pointer};\C{for list traversal}\6
+$\\{prev\_w},\39\|w,\39\\{ww}$: \37\\{integer};\C{old and new weights}\6
+\|d: \37\\{integer};\C{data from edge-weight node}\6
+\\{delta}: \37\\{integer};\C{number of rows to skip}\6
+\\{cur\_min\_m}: \37\\{integer};\C{starting column, relative to the current
+offset}\6
+$\\{x\_off},\39\\{y\_off}$: \37\\{integer};\C{offsets, rounded to integers}\2\6
+\&{begin} \37\\{check\_gf};\5
+$\|f\K\\{round\_unscaled}(\\{internal}[\\{char\_ext}])$;\6
+$\\{x\_off}\K\\{round\_unscaled}(\\{internal}[\\{x\_offset}])$;\5
+$\\{y\_off}\K\\{round\_unscaled}(\\{internal}[\\{y\_offset}])$;\6
+\&{if} $\\{term\_offset}>\\{max\_print\_line}-9$ \1\&{then}\5
+\\{print\_ln}\6
+\4\&{else} \&{if} $(\\{term\_offset}>0)\V(\\{file\_offset}>0)$ \1\&{then}\5
+$\\{print\_char}(\.{"\ "})$;\2\2\6
+$\\{print\_char}(\.{"["})$;\5
+$\\{print\_int}(\|c)$;\6
+\&{if} $\|f\I0$ \1\&{then}\6
+\&{begin} \37$\\{print\_char}(\.{"."})$;\5
+$\\{print\_int}(\|f)$;\6
+\&{end};\2\6
+\\{update\_terminal};\5
+$\\{boc\_c}\K256\ast\|f+\|c$;\5
+$\\{boc\_p}\K\\{char\_ptr}[\|c]$;\5
+$\\{char\_ptr}[\|c]\K\\{gf\_prev\_ptr}$;\6
+\&{if} $\\{internal}[\\{proofing}]>0$ \1\&{then}\5
+\X1166:Send nonzero offsets to the output file\X;\2\6
+\X1167:Output the character represented in \\{cur\_edges}\X;\6
+$\\{gf\_out}(\\{eoc})$;\5
+$\\{gf\_prev\_ptr}\K\\{gf\_offset}+\\{gf\_ptr}$;\5
+$\\{incr}(\\{total\_chars})$;\5
+$\\{print\_char}(\.{"]"})$;\5
+\\{update\_terminal};\C{progress report}\6
+\&{if} $\\{internal}[\\{tracing\_output}]>0$ \1\&{then}\5
+$\\{print\_edges}(\.{"\ (just\ shipped\ out)"},\39\\{true},\39\\{x\_off},\39%
+\\{y\_off})$;\2\6
+\&{end};\par
+\fi
+
+\M1166. \P$\X1166:Send nonzero offsets to the output file\X\S$\6
+\&{begin} \37\&{if} $\\{x\_off}\I0$ \1\&{then}\6
+\&{begin} \37$\\{gf\_string}(\.{"xoffset"},\390)$;\5
+$\\{gf\_out}(\\{yyy})$;\5
+$\\{gf\_four}(\\{x\_off}\ast\\{unity})$;\6
+\&{end};\2\6
+\&{if} $\\{y\_off}\I0$ \1\&{then}\6
+\&{begin} \37$\\{gf\_string}(\.{"yoffset"},\390)$;\5
+$\\{gf\_out}(\\{yyy})$;\5
+$\\{gf\_four}(\\{y\_off}\ast\\{unity})$;\6
+\&{end};\2\6
+\&{end}\par
+\U1165.\fi
+
+\M1167. \P$\X1167:Output the character represented in \\{cur\_edges}\X\S$\6
+$\\{prev\_n}\K4096$;\5
+$\|p\K\\{knil}(\\{cur\_edges})$;\5
+$\|n\K\\{n\_max}(\\{cur\_edges})-\\{zero\_field}$;\6
+\&{while} $\|p\I\\{cur\_edges}$ \1\&{do}\6
+\&{begin} \37\X1169:Output the pixels of edge row \|p to font row \|n\X;\6
+$\|p\K\\{knil}(\|p)$;\5
+$\\{decr}(\|n)$;\6
+\&{end};\2\6
+\&{if} $\\{prev\_n}=4096$ \1\&{then}\5
+\X1168:Finish off an entirely blank character\X\6
+\4\&{else} \&{if} $\\{prev\_n}+\\{y\_off}<\\{gf\_min\_n}$ \1\&{then}\5
+$\\{gf\_min\_n}\K\\{prev\_n}+\\{y\_off}$\2\2\par
+\U1165.\fi
+
+\M1168. \P$\X1168:Finish off an entirely blank character\X\S$\6
+\&{begin} \37$\\{gf\_boc}(0,\390,\390,\390)$;\6
+\&{if} $\\{gf\_max\_m}<0$ \1\&{then}\5
+$\\{gf\_max\_m}\K0$;\2\6
+\&{if} $\\{gf\_min\_n}>0$ \1\&{then}\5
+$\\{gf\_min\_n}\K0$;\2\6
+\&{end}\par
+\U1167.\fi
+
+\M1169. In this loop, \\{prev\_w} represents the weight at column \\{prev\_m},
+which is
+the most recent column reflected in the output so far; \|w represents the
+weight at column~\|m, which is the most recent column in the edge data.
+Several edges might cancel at the same column position, so we need to
+look ahead to column~\\{mm} before actually outputting anything.
+
+\Y\P$\4\X1169:Output the pixels of edge row \|p to font row \|n\X\S$\6
+\&{if} $\\{unsorted}(\|p)>\\{void}$ \1\&{then}\5
+$\\{sort\_edges}(\|p)$;\2\6
+$\|q\K\\{sorted}(\|p)$;\5
+$\|w\K0$;\5
+$\\{prev\_m}\K-\\{fraction\_one}$;\C{$\\{fraction\_one}\approx\infty$}\6
+$\\{ww}\K0$;\5
+$\\{prev\_w}\K0$;\5
+$\|m\K\\{prev\_m}$;\6
+\1\&{repeat} \37\&{if} $\|q=\\{sentinel}$ \1\&{then}\5
+$\\{mm}\K\\{fraction\_one}$\6
+\4\&{else} \&{begin} \37$\|d\K\\{ho}(\\{info}(\|q))$;\5
+$\\{mm}\K\|d\mathbin{\&{div}}8$;\5
+$\\{ww}\K\\{ww}+(\|d\mathbin{\&{mod}}8)-\\{zero\_w}$;\6
+\&{end};\2\6
+\&{if} $\\{mm}\I\|m$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{prev\_w}\L0$ \1\&{then}\6
+\&{begin} \37\&{if} $\|w>0$ \1\&{then}\5
+\X1170:Start black at $(m,n)$\X;\2\6
+\&{end}\6
+\4\&{else} \&{if} $\|w\L0$ \1\&{then}\5
+\X1171:Stop black at $(m,n)$\X;\2\2\6
+$\|m\K\\{mm}$;\6
+\&{end};\2\6
+$\|w\K\\{ww}$;\5
+$\|q\K\\{link}(\|q)$;\6
+\4\&{until}\5
+$\\{mm}=\\{fraction\_one}$;\2\6
+\&{if} $\|w\I0$ \1\&{then}\C{this should be impossible}\6
+$\\{print\_nl}(\.{"(There\'s\ unbounded\ black\ in\ character\ shipped\
+out!)"})$;\2\6
+\&{if} $\\{prev\_m}-\\{m\_offset}(\\{cur\_edges})+\\{x\_off}>\\{gf\_max\_m}$ \1%
+\&{then}\5
+$\\{gf\_max\_m}\K\\{prev\_m}-\\{m\_offset}(\\{cur\_edges})+\\{x\_off}$\2\par
+\U1167.\fi
+
+\M1170. \P$\X1170:Start black at $(m,n)$\X\S$\6
+\&{begin} \37\&{if} $\\{prev\_m}=-\\{fraction\_one}$ \1\&{then}\5
+\X1172:Start a new row at $(m,n)$\X\6
+\4\&{else} $\\{gf\_paint}(\|m-\\{prev\_m})$;\2\6
+$\\{prev\_m}\K\|m$;\5
+$\\{prev\_w}\K\|w$;\6
+\&{end}\par
+\U1169.\fi
+
+\M1171. \P$\X1171:Stop black at $(m,n)$\X\S$\6
+\&{begin} \37$\\{gf\_paint}(\|m-\\{prev\_m})$;\5
+$\\{prev\_m}\K\|m$;\5
+$\\{prev\_w}\K\|w$;\6
+\&{end}\par
+\U1169.\fi
+
+\M1172. \P$\X1172:Start a new row at $(m,n)$\X\S$\6
+\&{begin} \37\&{if} $\\{prev\_n}=4096$ \1\&{then}\6
+\&{begin} \37$\\{gf\_boc}(\\{m\_min}(\\{cur\_edges})+\\{x\_off}-\\{zero%
+\_field},\39\\{m\_max}(\\{cur\_edges})+\\{x\_off}-\\{zero\_field},\39\30\\{n%
+\_min}(\\{cur\_edges})+\\{y\_off}-\\{zero\_field},\39\|n+\\{y\_off})$;\5
+$\\{cur\_min\_m}\K\\{m\_min}(\\{cur\_edges})-\\{zero\_field}+\\{m\_offset}(%
+\\{cur\_edges})$;\6
+\&{end}\6
+\4\&{else} \&{if} $\\{prev\_n}>\|n+1$ \1\&{then}\5
+\X1174:Skip down $\\{prev\_n}-\|n$ rows\X\6
+\4\&{else} \X1173:Skip to column $m$ in the next row and \&{goto} \\{done}, or
+skip zero rows\X;\2\2\6
+$\\{gf\_paint}(\|m-\\{cur\_min\_m})$;\C{skip to column $m$, painting white}\6
+\4\\{done}: \37$\\{prev\_n}\K\|n$;\6
+\&{end}\par
+\U1170.\fi
+
+\M1173. \P$\X1173:Skip to column $m$ in the next row and \&{goto} \\{done}, or
+skip zero rows\X\S$\6
+\&{begin} \37$\\{delta}\K\|m-\\{cur\_min\_m}$;\6
+\&{if} $\\{delta}>\\{max\_new\_row}$ \1\&{then}\5
+$\\{gf\_out}(\\{skip0})$\6
+\4\&{else} \&{begin} \37$\\{gf\_out}(\\{new\_row\_0}+\\{delta})$;\5
+\&{goto} \37\\{done};\6
+\&{end};\2\6
+\&{end}\par
+\U1172.\fi
+
+\M1174. \P$\X1174:Skip down $\\{prev\_n}-\|n$ rows\X\S$\6
+\&{begin} \37$\\{delta}\K\\{prev\_n}-\|n-1$;\6
+\&{if} $\\{delta}<\O{400}$ \1\&{then}\6
+\&{begin} \37$\\{gf\_out}(\\{skip1})$;\5
+$\\{gf\_out}(\\{delta})$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{gf\_out}(\\{skip1}+1)$;\5
+$\\{gf\_two}(\\{delta})$;\6
+\&{end};\2\6
+\&{end}\par
+\U1172.\fi
+
+\M1175. Now that we've finished \\{ship\_out}, let's look at the other commands
+by which a user can send things to the \.{GF} file.
+
+\Y\P$\4\X1020:Cases of \\{do\_statement} that invoke particular commands\X%
+\mathrel{+}\S$\6
+\4\\{special\_command}: \37\\{do\_special};\par
+\fi
+
+\M1176. \P$\X192:Put each of \MF's primitives into the hash table\X\mathrel{+}%
+\S$\6
+$\\{primitive}(\.{"special"},\39\\{special\_command},\39\\{string\_type})$;\6
+$\\{primitive}(\.{"numspecial"},\39\\{special\_command},\39\\{known})$;\par
+\fi
+
+\M1177. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{do\_special};\6
+\4\&{var} \37\|m: \37\\{small\_number};\C{either \\{string\_type} or \\{known}}%
+\2\6
+\&{begin} \37$\|m\K\\{cur\_mod}$;\5
+\\{get\_x\_next};\5
+\\{scan\_expression};\6
+\&{if} $\\{internal}[\\{proofing}]\G0$ \1\&{then}\6
+\&{if} $\\{cur\_type}\I\|m$ \1\&{then}\5
+\X1178:Complain about improper special operation\X\6
+\4\&{else} \&{begin} \37\\{check\_gf};\6
+\&{if} $\|m=\\{string\_type}$ \1\&{then}\5
+$\\{gf\_string}(\\{cur\_exp},\390)$\6
+\4\&{else} \&{begin} \37$\\{gf\_out}(\\{yyy})$;\5
+$\\{gf\_four}(\\{cur\_exp})$;\6
+\&{end};\2\6
+\&{end};\2\2\6
+$\\{flush\_cur\_exp}(0)$;\6
+\&{end};\par
+\fi
+
+\M1178. \P$\X1178:Complain about improper special operation\X\S$\6
+\&{begin} \37$\\{exp\_err}(\.{"Unsuitable\ expression"})$;\5
+$\\{help1}(\.{"The\ expression\ shown\ above\ has\ the\ wrong\ type\ to\ be\
+output."})$;\5
+\\{put\_get\_error};\6
+\&{end}\par
+\U1177.\fi
+
+\M1179. \P$\X1179:Send the current expression as a title to the output file\X%
+\S$\6
+\&{begin} \37\\{check\_gf};\5
+$\\{gf\_string}(\.{"title\ "},\39\\{cur\_exp})$;\6
+\&{end}\par
+\U994.\fi
+
+\M1180. \P$\X212:Cases of \\{print\_cmd\_mod} for symbolic printing of
+primitives\X\mathrel{+}\S$\6
+\4\\{special\_command}: \37\&{if} $\|m=\\{known}$ \1\&{then}\5
+$\\{print}(\.{"numspecial"})$\6
+\4\&{else} $\\{print}(\.{"special"})$;\2\par
+\fi
+
+\M1181. \P$\X1181:Determine if a character has been shipped out\X\S$\6
+\&{begin} \37$\\{cur\_exp}\K\\{round\_unscaled}(\\{cur\_exp})\mathbin{%
+\&{mod}}256$;\6
+\&{if} $\\{cur\_exp}<0$ \1\&{then}\5
+$\\{cur\_exp}\K\\{cur\_exp}+256$;\2\6
+$\\{boolean\_reset}(\\{char\_exists}[\\{cur\_exp}])$;\5
+$\\{cur\_type}\K\\{boolean\_type}$;\6
+\&{end}\par
+\U906.\fi
+
+\M1182. At the end of the program we must finish things off by writing the
+postamble.
+The \.{TFM} information should have been computed first.
+
+An integer variable \|k and a \\{scaled} variable \|x will be declared for
+use by this routine.
+
+\Y\P$\4\X1182:Finish the \.{GF} file\X\S$\6
+\&{begin} \37$\\{gf\_out}(\\{post})$;\C{beginning of the postamble}\6
+$\\{gf\_four}(\\{gf\_prev\_ptr})$;\5
+$\\{gf\_prev\_ptr}\K\\{gf\_offset}+\\{gf\_ptr}-5$;\C{\\{post} location}\6
+$\\{gf\_four}(\\{internal}[\\{design\_size}]\ast16)$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}4$ \1\&{do}\5
+$\\{gf\_out}(\\{header\_byte}[\|k])$;\C{the check sum}\2\6
+$\\{gf\_four}(\\{internal}[\\{hppp}])$;\5
+$\\{gf\_four}(\\{internal}[\\{vppp}])$;\6
+$\\{gf\_four}(\\{gf\_min\_m})$;\5
+$\\{gf\_four}(\\{gf\_max\_m})$;\5
+$\\{gf\_four}(\\{gf\_min\_n})$;\5
+$\\{gf\_four}(\\{gf\_max\_n})$;\6
+\&{for} $\|k\K0\mathrel{\&{to}}255$ \1\&{do}\6
+\&{if} $\\{char\_exists}[\|k]$ \1\&{then}\6
+\&{begin} \37$\|x\K\\{gf\_dx}[\|k]\mathbin{\&{div}}\\{unity}$;\6
+\&{if} $(\\{gf\_dy}[\|k]=0)\W(\|x\G0)\W(\|x<256)\W(\\{gf\_dx}[\|k]=\|x\ast%
+\\{unity})$ \1\&{then}\6
+\&{begin} \37$\\{gf\_out}(\\{char\_loc}+1)$;\5
+$\\{gf\_out}(\|k)$;\5
+$\\{gf\_out}(\|x)$;\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{gf\_out}(\\{char\_loc})$;\5
+$\\{gf\_out}(\|k)$;\5
+$\\{gf\_four}(\\{gf\_dx}[\|k])$;\5
+$\\{gf\_four}(\\{gf\_dy}[\|k])$;\6
+\&{end};\2\6
+$\|x\K\\{value}(\\{tfm\_width}[\|k])$;\6
+\&{if} $\\{abs}(\|x)>\\{max\_tfm\_dimen}$ \1\&{then}\6
+\&{if} $\|x>0$ \1\&{then}\5
+$\|x\K\\{three\_bytes}-1$\ \&{else} $\|x\K1-\\{three\_bytes}$\2\6
+\4\&{else} $\|x\K\\{make\_scaled}(\|x\ast16,\39\\{internal}[\\{design%
+\_size}])$;\2\6
+$\\{gf\_four}(\|x)$;\5
+$\\{gf\_four}(\\{char\_ptr}[\|k])$;\6
+\&{end};\2\2\6
+$\\{gf\_out}(\\{post\_post})$;\5
+$\\{gf\_four}(\\{gf\_prev\_ptr})$;\5
+$\\{gf\_out}(\\{gf\_id\_byte})$;\6
+$\|k\K4+((\\{gf\_buf\_size}-\\{gf\_ptr})\mathbin{\&{mod}}4)$;\C{the number of
+223's}\6
+\&{while} $\|k>0$ \1\&{do}\6
+\&{begin} \37$\\{gf\_out}(223)$;\5
+$\\{decr}(\|k)$;\6
+\&{end};\2\6
+\X1156:Empty the last bytes out of \\{gf\_buf}\X;\6
+$\\{print\_nl}(\.{"Output\ written\ on\ "})$;\5
+$\\{slow\_print}(\\{output\_file\_name})$;\5
+$\\{print}(\.{"\ ("})$;\5
+$\\{print\_int}(\\{total\_chars})$;\5
+$\\{print}(\.{"\ character"})$;\6
+\&{if} $\\{total\_chars}\I1$ \1\&{then}\5
+$\\{print\_char}(\.{"s"})$;\2\6
+$\\{print}(\.{",\ "})$;\5
+$\\{print\_int}(\\{gf\_offset}+\\{gf\_ptr})$;\5
+$\\{print}(\.{"\ bytes)."})$;\5
+$\\{b\_close}(\\{gf\_file})$;\6
+\&{end}\par
+\U1206.\fi
+
+\N1183. \[48] Dumping and undumping the tables.
+After \.{INIMF} has seen a collection of macros, it
+can write all the necessary information on an auxiliary file so
+that production versions of \MF\ are able to initialize their
+memory at high speed. The present section of the program takes
+care of such output and input. We shall consider simultaneously
+the processes of storing and restoring,
+so that the inverse relation between them is clear.
+
+The global variable \\{base\_ident} is a string that is printed right
+after the \\{banner} line when \MF\ is ready to start. For \.{INIMF} this
+string says simply `\.{(INIMF)}'; for other versions of \MF\ it says,
+for example, `\.{(preloaded base=plain 84.2.29)}', showing the year,
+month, and day that the base file was created. We have $\\{base\_ident}=0$
+before \MF's tables are loaded.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{base\_ident}: \37\\{str\_number};\par
+\fi
+
+\M1184. \P$\X21:Set initial values of key variables\X\mathrel{+}\S$\6
+$\\{base\_ident}\K0$;\par
+\fi
+
+\M1185. \P$\X176:Initialize table entries (done by \.{INIMF} only)\X\mathrel{+}%
+\S$\6
+$\\{base\_ident}\K\.{"\ (INIMF)"}$;\par
+\fi
+
+\M1186. \P$\X995:Declare action procedures for use by \\{do\_statement}\X%
+\mathrel{+}\S$\6
+\&{init} \37\&{procedure}\1\ \37\\{store\_base\_file};\6
+\4\&{var} \37\|k: \37\\{integer};\C{all-purpose index}\6
+$\|p,\39\|q$: \37\\{pointer};\C{all-purpose pointers}\6
+\|x: \37\\{integer};\C{something to dump}\6
+\|w: \37\\{four\_quarters};\C{four ASCII codes}\2\6
+\&{begin} \37\X1200:Create the \\{base\_ident}, open the base file, and inform
+the user that dumping has begun\X;\6
+\X1190:Dump constants for consistency check\X;\6
+\X1192:Dump the string pool\X;\6
+\X1194:Dump the dynamic memory\X;\6
+\X1196:Dump the table of equivalents and the hash table\X;\6
+\X1198:Dump a few more things and the closing check word\X;\6
+\X1201:Close the base file\X;\6
+\&{end};\6
+\&{tini}\par
+\fi
+
+\M1187. Corresponding to the procedure that dumps a base file, we also have a
+function
+that reads~one~in. The function returns \\{false} if the dumped base is
+incompatible with the present \MF\ table sizes, etc.
+
+\Y\P\D \37$\\{off\_base}=6666$\C{go here if the base file is unacceptable}\par
+\P\D \37$\\{too\_small}(\#)\S$\1\6
+\&{begin} \37\\{wake\_up\_terminal};\5
+$\\{wterm\_ln}(\.{\'---!\ Must\ increase\ the\ \'},\39\#)$;\5
+\&{goto} \37\\{off\_base};\6
+\&{end}\2\par
+\Y\P\hbox{\4}\X779:Declare the function called \\{open\_base\_file}\X\6
+\4\&{function}\1\ \37\\{load\_base\_file}: \37\\{boolean};\6
+\4\&{label} \37$\\{off\_base},\39\\{exit}$;\6
+\4\&{var} \37\|k: \37\\{integer};\C{all-purpose index}\6
+$\|p,\39\|q$: \37\\{pointer};\C{all-purpose pointers}\6
+\|x: \37\\{integer};\C{something undumped}\6
+\|w: \37\\{four\_quarters};\C{four ASCII codes}\2\6
+\&{begin} \37\X1191:Undump constants for consistency check\X;\6
+\X1193:Undump the string pool\X;\6
+\X1195:Undump the dynamic memory\X;\6
+\X1197:Undump the table of equivalents and the hash table\X;\6
+\X1199:Undump a few more things and the closing check word\X;\6
+$\\{load\_base\_file}\K\\{true}$;\5
+\&{return};\C{it worked!}\6
+\4\\{off\_base}: \37\\{wake\_up\_terminal};\5
+$\\{wterm\_ln}(\.{\'(Fatal\ base\ file\ error;\ I\'}\.{\'m\ stymied)\'})$;\5
+$\\{load\_base\_file}\K\\{false}$;\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M1188. Base files consist of \\{memory\_word} items, and we use the following
+macros to dump words of different types:
+
+\Y\P\D \37$\\{dump\_wd}(\#)\S$\1\6
+\&{begin} \37$\\{base\_file}\^\K\#$;\5
+$\\{put}(\\{base\_file})$;\ \&{end}\2\par
+\P\D \37$\\{dump\_int}(\#)\S$\1\6
+\&{begin} \37$\\{base\_file}\^.\\{int}\K\#$;\5
+$\\{put}(\\{base\_file})$;\ \&{end}\2\par
+\P\D \37$\\{dump\_hh}(\#)\S$\1\6
+\&{begin} \37$\\{base\_file}\^.\\{hh}\K\#$;\5
+$\\{put}(\\{base\_file})$;\ \&{end}\2\par
+\P\D \37$\\{dump\_qqqq}(\#)\S$\1\6
+\&{begin} \37$\\{base\_file}\^.\\{qqqq}\K\#$;\5
+$\\{put}(\\{base\_file})$;\ \&{end}\2\par
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{base\_file}: \37\\{word\_file};\C{for input or output of base information}%
+\par
+\fi
+
+\M1189. The inverse macros are slightly more complicated, since we need to
+check
+the range of the values we are reading in. We say `$\\{undump}(\|a)(\|b)(\|x)$'
+to
+read an integer value \|x that is supposed to be in the range $\|a\L\|x\L\|b$.
+
+\Y\P\D \37$\\{undump\_wd}(\#)\S$\1\6
+\&{begin} \37$\\{get}(\\{base\_file})$;\5
+$\#\K\\{base\_file}\^$;\ \&{end}\2\par
+\P\D \37$\\{undump\_int}(\#)\S$\1\6
+\&{begin} \37$\\{get}(\\{base\_file})$;\5
+$\#\K\\{base\_file}\^.\\{int}$;\ \&{end}\2\par
+\P\D \37$\\{undump\_hh}(\#)\S$\1\6
+\&{begin} \37$\\{get}(\\{base\_file})$;\5
+$\#\K\\{base\_file}\^.\\{hh}$;\ \&{end}\2\par
+\P\D \37$\\{undump\_qqqq}(\#)\S$\1\6
+\&{begin} \37$\\{get}(\\{base\_file})$;\5
+$\#\K\\{base\_file}\^.\\{qqqq}$;\ \&{end}\2\par
+\P\D \37$\\{undump\_end\_end}(\#)\S\#\K\|x$;\ \&{end} \par
+\P\D $\\{undump\_end}(\#)\S(\|x>\#)$ \&{then} \&{goto} \37\\{off\_base}\ %
+\&{else} \37\\{undump\_end\_end}\par
+\P\D $\\{undump}(\#)\S$ \6
+\&{begin} \37$\\{undump\_int}(\|x)$; \6
+\&{if} $(\|x<\#)\V\\{undump\_end}$\par
+\P\D \37$\\{undump\_size\_end\_end}(\#)\S\\{too\_small}(\#)$\ \&{else} \37%
+\\{undump\_end\_end}\par
+\P\D \37$\\{undump\_size\_end}(\#)\S$\1\6
+\&{if} $\|x>\#$ \1\&{then}\5
+\\{undump\_size\_end\_end}\2\2\par
+\P\D $\\{undump\_size}(\#)\S$ \6
+\&{begin} \37$\\{undump\_int}(\|x)$;\6
+\&{if} $\|x<\#$ \1\&{then}\5
+\&{goto} \37\\{off\_base};\2\6
+\\{undump\_size\_end}\par
+\fi
+
+\M1190. The next few sections of the program should make it clear how we use
+the
+dump/undump macros.
+
+\Y\P$\4\X1190:Dump constants for consistency check\X\S$\6
+$\\{dump\_int}(\))$;\6
+$\\{dump\_int}(\\{mem\_min})$;\6
+$\\{dump\_int}(\\{mem\_top})$;\6
+$\\{dump\_int}(\\{hash\_size})$;\6
+$\\{dump\_int}(\\{hash\_prime})$;\6
+$\\{dump\_int}(\\{max\_in\_open})$\par
+\U1186.\fi
+
+\M1191. Sections of a \.{WEB} program that are ``commented out'' still
+contribute
+strings to the string pool; therefore \.{INIMF} and \MF\ will have
+the same strings. (And it is, of course, a good thing that they do.)
+
+\Y\P$\4\X1191:Undump constants for consistency check\X\S$\6
+$\|x\K\\{base\_file}\^.\\{int}$;\6
+\&{if} $\|x\I\)$ \1\&{then}\5
+\&{goto} \37\\{off\_base};\C{check that strings are the same}\2\6
+$\\{undump\_int}(\|x)$;\6
+\&{if} $\|x\I\\{mem\_min}$ \1\&{then}\5
+\&{goto} \37\\{off\_base};\2\6
+$\\{undump\_int}(\|x)$;\6
+\&{if} $\|x\I\\{mem\_top}$ \1\&{then}\5
+\&{goto} \37\\{off\_base};\2\6
+$\\{undump\_int}(\|x)$;\6
+\&{if} $\|x\I\\{hash\_size}$ \1\&{then}\5
+\&{goto} \37\\{off\_base};\2\6
+$\\{undump\_int}(\|x)$;\6
+\&{if} $\|x\I\\{hash\_prime}$ \1\&{then}\5
+\&{goto} \37\\{off\_base};\2\6
+$\\{undump\_int}(\|x)$;\6
+\&{if} $\|x\I\\{max\_in\_open}$ \1\&{then}\5
+\&{goto} \37\\{off\_base}\2\par
+\U1187.\fi
+
+\M1192. \P\D \37$\\{dump\_four\_ASCII}\S\|w.\\{b0}\K\\{qi}(\\{so}(\\{str%
+\_pool}[\|k]))$;\5
+$\|w.\\{b1}\K\\{qi}(\\{so}(\\{str\_pool}[\|k+1]))$;\5
+$\|w.\\{b2}\K\\{qi}(\\{so}(\\{str\_pool}[\|k+2]))$;\5
+$\|w.\\{b3}\K\\{qi}(\\{so}(\\{str\_pool}[\|k+3]))$;\5
+$\\{dump\_qqqq}(\|w)$\par
+\Y\P$\4\X1192:Dump the string pool\X\S$\6
+$\\{dump\_int}(\\{pool\_ptr})$;\5
+$\\{dump\_int}(\\{str\_ptr})$;\6
+\&{for} $\|k\K0\mathrel{\&{to}}\\{str\_ptr}$ \1\&{do}\5
+$\\{dump\_int}(\\{str\_start}[\|k])$;\2\6
+$\|k\K0$;\6
+\&{while} $\|k+4<\\{pool\_ptr}$ \1\&{do}\6
+\&{begin} \37\\{dump\_four\_ASCII};\5
+$\|k\K\|k+4$;\6
+\&{end};\2\6
+$\|k\K\\{pool\_ptr}-4$;\5
+\\{dump\_four\_ASCII};\5
+\\{print\_ln};\5
+$\\{print\_int}(\\{str\_ptr})$;\5
+$\\{print}(\.{"\ strings\ of\ total\ length\ "})$;\5
+$\\{print\_int}(\\{pool\_ptr})$\par
+\U1186.\fi
+
+\M1193. \P\D \37$\\{undump\_four\_ASCII}\S\\{undump\_qqqq}(\|w)$;\5
+$\\{str\_pool}[\|k]\K\\{si}(\\{qo}(\|w.\\{b0}))$;\5
+$\\{str\_pool}[\|k+1]\K\\{si}(\\{qo}(\|w.\\{b1}))$;\5
+$\\{str\_pool}[\|k+2]\K\\{si}(\\{qo}(\|w.\\{b2}))$;\5
+$\\{str\_pool}[\|k+3]\K\\{si}(\\{qo}(\|w.\\{b3}))$\par
+\Y\P$\4\X1193:Undump the string pool\X\S$\6
+$\\{undump\_size}(0)(\\{pool\_size})(\.{\'string\ pool\ size\'})(\\{pool%
+\_ptr})$;\5
+$\\{undump\_size}(0)(\\{max\_strings})(\.{\'max\ strings\'})(\\{str\_ptr})$;\6
+\&{for} $\|k\K0\mathrel{\&{to}}\\{str\_ptr}$ \1\&{do}\6
+\&{begin} \37$\\{undump}(0)(\\{pool\_ptr})(\\{str\_start}[\|k])$;\5
+$\\{str\_ref}[\|k]\K\\{max\_str\_ref}$;\6
+\&{end};\2\6
+$\|k\K0$;\6
+\&{while} $\|k+4<\\{pool\_ptr}$ \1\&{do}\6
+\&{begin} \37\\{undump\_four\_ASCII};\5
+$\|k\K\|k+4$;\6
+\&{end};\2\6
+$\|k\K\\{pool\_ptr}-4$;\5
+\\{undump\_four\_ASCII};\5
+$\\{init\_str\_ptr}\K\\{str\_ptr}$;\5
+$\\{init\_pool\_ptr}\K\\{pool\_ptr}$;\5
+$\\{max\_str\_ptr}\K\\{str\_ptr}$;\5
+$\\{max\_pool\_ptr}\K\\{pool\_ptr}$\par
+\U1187.\fi
+
+\M1194. By sorting the list of available spaces in the variable-size portion of
+\\{mem}, we are usually able to get by without having to dump very much
+of the dynamic memory.
+
+We recompute \\{var\_used} and \\{dyn\_used}, so that \.{INIMF} dumps valid
+information even when it has not been gathering statistics.
+
+\Y\P$\4\X1194:Dump the dynamic memory\X\S$\6
+\\{sort\_avail};\5
+$\\{var\_used}\K0$;\5
+$\\{dump\_int}(\\{lo\_mem\_max})$;\5
+$\\{dump\_int}(\\{rover})$;\5
+$\|p\K\\{mem\_min}$;\5
+$\|q\K\\{rover}$;\5
+$\|x\K0$;\6
+\1\&{repeat} \37\&{for} $\|k\K\|p\mathrel{\&{to}}\|q+1$ \1\&{do}\5
+$\\{dump\_wd}(\\{mem}[\|k])$;\2\6
+$\|x\K\|x+\|q+2-\|p$;\5
+$\\{var\_used}\K\\{var\_used}+\|q-\|p$;\5
+$\|p\K\|q+\\{node\_size}(\|q)$;\5
+$\|q\K\\{rlink}(\|q)$;\6
+\4\&{until}\5
+$\|q=\\{rover}$;\2\6
+$\\{var\_used}\K\\{var\_used}+\\{lo\_mem\_max}-\|p$;\5
+$\\{dyn\_used}\K\\{mem\_end}+1-\\{hi\_mem\_min}$;\6
+\&{for} $\|k\K\|p\mathrel{\&{to}}\\{lo\_mem\_max}$ \1\&{do}\5
+$\\{dump\_wd}(\\{mem}[\|k])$;\2\6
+$\|x\K\|x+\\{lo\_mem\_max}+1-\|p$;\5
+$\\{dump\_int}(\\{hi\_mem\_min})$;\5
+$\\{dump\_int}(\\{avail})$;\6
+\&{for} $\|k\K\\{hi\_mem\_min}\mathrel{\&{to}}\\{mem\_end}$ \1\&{do}\5
+$\\{dump\_wd}(\\{mem}[\|k])$;\2\6
+$\|x\K\|x+\\{mem\_end}+1-\\{hi\_mem\_min}$;\5
+$\|p\K\\{avail}$;\6
+\&{while} $\|p\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\\{decr}(\\{dyn\_used})$;\5
+$\|p\K\\{link}(\|p)$;\6
+\&{end};\2\6
+$\\{dump\_int}(\\{var\_used})$;\5
+$\\{dump\_int}(\\{dyn\_used})$;\5
+\\{print\_ln};\5
+$\\{print\_int}(\|x)$;\5
+$\\{print}(\.{"\ memory\ locations\ dumped;\ current\ usage\ is\ "})$;\5
+$\\{print\_int}(\\{var\_used})$;\5
+$\\{print\_char}(\.{"\&"})$;\5
+$\\{print\_int}(\\{dyn\_used})$\par
+\U1186.\fi
+
+\M1195. \P$\X1195:Undump the dynamic memory\X\S$\6
+$\\{undump}(\\{lo\_mem\_stat\_max}+1000)(\\{hi\_mem\_stat\_min}-1)(\\{lo\_mem%
+\_max})$;\5
+$\\{undump}(\\{lo\_mem\_stat\_max}+1)(\\{lo\_mem\_max})(\\{rover})$;\5
+$\|p\K\\{mem\_min}$;\5
+$\|q\K\\{rover}$;\6
+\1\&{repeat} \37\&{for} $\|k\K\|p\mathrel{\&{to}}\|q+1$ \1\&{do}\5
+$\\{undump\_wd}(\\{mem}[\|k])$;\2\6
+$\|p\K\|q+\\{node\_size}(\|q)$;\6
+\&{if} $(\|p>\\{lo\_mem\_max})\V((\|q\G\\{rlink}(\|q))\W(\\{rlink}(\|q)\I%
+\\{rover}))$ \1\&{then}\5
+\&{goto} \37\\{off\_base};\2\6
+$\|q\K\\{rlink}(\|q)$;\6
+\4\&{until}\5
+$\|q=\\{rover}$;\2\6
+\&{for} $\|k\K\|p\mathrel{\&{to}}\\{lo\_mem\_max}$ \1\&{do}\5
+$\\{undump\_wd}(\\{mem}[\|k])$;\2\6
+$\\{undump}(\\{lo\_mem\_max}+1)(\\{hi\_mem\_stat\_min})(\\{hi\_mem\_min})$;\5
+$\\{undump}(\\{null})(\\{mem\_top})(\\{avail})$;\5
+$\\{mem\_end}\K\\{mem\_top}$;\6
+\&{for} $\|k\K\\{hi\_mem\_min}\mathrel{\&{to}}\\{mem\_end}$ \1\&{do}\5
+$\\{undump\_wd}(\\{mem}[\|k])$;\2\6
+$\\{undump\_int}(\\{var\_used})$;\5
+$\\{undump\_int}(\\{dyn\_used})$\par
+\U1187.\fi
+
+\M1196. A different scheme is used to compress the hash table, since its lower
+region
+is usually sparse. When $\\{text}(\|p)\I0$ for $\|p\L\\{hash\_used}$, we output
+three
+words: \|p, $\\{hash}[\|p]$, and $\\{eqtb}[\|p]$. The hash table is, of course,
+densely
+packed for $\|p\G\\{hash\_used}$, so the remaining entries are output
+in~a~block.
+
+\Y\P$\4\X1196:Dump the table of equivalents and the hash table\X\S$\6
+$\\{dump\_int}(\\{hash\_used})$;\5
+$\\{st\_count}\K\\{frozen\_inaccessible}-1-\\{hash\_used}$;\6
+\&{for} $\|p\K1\mathrel{\&{to}}\\{hash\_used}$ \1\&{do}\6
+\&{if} $\\{text}(\|p)\I0$ \1\&{then}\6
+\&{begin} \37$\\{dump\_int}(\|p)$;\5
+$\\{dump\_hh}(\\{hash}[\|p])$;\5
+$\\{dump\_hh}(\\{eqtb}[\|p])$;\5
+$\\{incr}(\\{st\_count})$;\6
+\&{end};\2\2\6
+\&{for} $\|p\K\\{hash\_used}+1\mathrel{\&{to}}\\{hash\_end}$ \1\&{do}\6
+\&{begin} \37$\\{dump\_hh}(\\{hash}[\|p])$;\5
+$\\{dump\_hh}(\\{eqtb}[\|p])$;\6
+\&{end};\2\6
+$\\{dump\_int}(\\{st\_count})$;\6
+\\{print\_ln};\5
+$\\{print\_int}(\\{st\_count})$;\5
+$\\{print}(\.{"\ symbolic\ tokens"})$\par
+\U1186.\fi
+
+\M1197. \P$\X1197:Undump the table of equivalents and the hash table\X\S$\6
+$\\{undump}(1)(\\{frozen\_inaccessible})(\\{hash\_used})$;\5
+$\|p\K0$;\6
+\1\&{repeat} \37$\\{undump}(\|p+1)(\\{hash\_used})(\|p)$;\5
+$\\{undump\_hh}(\\{hash}[\|p])$;\5
+$\\{undump\_hh}(\\{eqtb}[\|p])$;\6
+\4\&{until}\5
+$\|p=\\{hash\_used}$;\2\6
+\&{for} $\|p\K\\{hash\_used}+1\mathrel{\&{to}}\\{hash\_end}$ \1\&{do}\6
+\&{begin} \37$\\{undump\_hh}(\\{hash}[\|p])$;\5
+$\\{undump\_hh}(\\{eqtb}[\|p])$;\6
+\&{end};\2\6
+$\\{undump\_int}(\\{st\_count})$\par
+\U1187.\fi
+
+\M1198. We have already printed a lot of statistics, so we set $\\{tracing%
+\_stats}\K0$
+to prevent them from appearing again.
+
+\Y\P$\4\X1198:Dump a few more things and the closing check word\X\S$\6
+$\\{dump\_int}(\\{int\_ptr})$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}\\{int\_ptr}$ \1\&{do}\6
+\&{begin} \37$\\{dump\_int}(\\{internal}[\|k])$;\5
+$\\{dump\_int}(\\{int\_name}[\|k])$;\6
+\&{end};\2\6
+$\\{dump\_int}(\\{start\_sym})$;\5
+$\\{dump\_int}(\\{interaction})$;\5
+$\\{dump\_int}(\\{base\_ident})$;\5
+$\\{dump\_int}(\\{bg\_loc})$;\5
+$\\{dump\_int}(\\{eg\_loc})$;\5
+$\\{dump\_int}(\\{serial\_no})$;\5
+$\\{dump\_int}(69069)$;\5
+$\\{internal}[\\{tracing\_stats}]\K0$\par
+\U1186.\fi
+
+\M1199. \P$\X1199:Undump a few more things and the closing check word\X\S$\6
+$\\{undump}(\\{max\_given\_internal})(\\{max\_internal})(\\{int\_ptr})$;\6
+\&{for} $\|k\K1\mathrel{\&{to}}\\{int\_ptr}$ \1\&{do}\6
+\&{begin} \37$\\{undump\_int}(\\{internal}[\|k])$;\5
+$\\{undump}(0)(\\{str\_ptr})(\\{int\_name}[\|k])$;\6
+\&{end};\2\6
+$\\{undump}(0)(\\{frozen\_inaccessible})(\\{start\_sym})$;\5
+$\\{undump}(\\{batch\_mode})(\\{error\_stop\_mode})(\\{interaction})$;\5
+$\\{undump}(0)(\\{str\_ptr})(\\{base\_ident})$;\5
+$\\{undump}(1)(\\{hash\_end})(\\{bg\_loc})$;\5
+$\\{undump}(1)(\\{hash\_end})(\\{eg\_loc})$;\5
+$\\{undump\_int}(\\{serial\_no})$;\6
+$\\{undump\_int}(\|x)$;\ \&{if} $(\|x\I69069)\V\\{eof}(\\{base\_file})$ \1%
+\&{then}\5
+\&{goto} \37\\{off\_base}\2\par
+\U1187.\fi
+
+\M1200. \P$\X1200:Create the \\{base\_ident}, open the base file, and inform
+the user that dumping has begun\X\S$\6
+$\\{selector}\K\\{new\_string}$;\5
+$\\{print}(\.{"\ (preloaded\ base="})$;\5
+$\\{print}(\\{job\_name})$;\5
+$\\{print\_char}(\.{"\ "})$;\5
+$\\{print\_int}(\\{round\_unscaled}(\\{internal}[\\{year}]))$;\5
+$\\{print\_char}(\.{"."})$;\5
+$\\{print\_int}(\\{round\_unscaled}(\\{internal}[\\{month}]))$;\5
+$\\{print\_char}(\.{"."})$;\5
+$\\{print\_int}(\\{round\_unscaled}(\\{internal}[\\{day}]))$;\5
+$\\{print\_char}(\.{")"})$;\6
+\&{if} $\\{interaction}=\\{batch\_mode}$ \1\&{then}\5
+$\\{selector}\K\\{log\_only}$\6
+\4\&{else} $\\{selector}\K\\{term\_and\_log}$;\2\6
+$\\{str\_room}(1)$;\5
+$\\{base\_ident}\K\\{make\_string}$;\5
+$\\{str\_ref}[\\{base\_ident}]\K\\{max\_str\_ref}$;\6
+$\\{pack\_job\_name}(\\{base\_extension})$;\6
+\&{while} $\R\\{w\_open\_out}(\\{base\_file})$ \1\&{do}\5
+$\\{prompt\_file\_name}(\.{"base\ file\ name"},\39\\{base\_extension})$;\2\6
+$\\{print\_nl}(\.{"Beginning\ to\ dump\ on\ file\ "})$;\5
+$\\{slow\_print}(\\{w\_make\_name\_string}(\\{base\_file}))$;\5
+$\\{flush\_string}(\\{str\_ptr}-1)$;\5
+$\\{print\_nl}(\.{""})$;\5
+$\\{slow\_print}(\\{base\_ident})$\par
+\U1186.\fi
+
+\M1201. \P$\X1201:Close the base file\X\S$\6
+$\\{w\_close}(\\{base\_file})$\par
+\U1186.\fi
+
+\N1202. \[49] The main program.
+This is it: the part of \MF\ that executes all those procedures we have
+written.
+
+Well---almost. We haven't put the parsing subroutines into the
+program yet; and we'd better leave space for a few more routines that may
+have been forgotten.
+
+\Y\P\X823:Declare the basic parsing subroutines\X\6
+\X224:Declare miscellaneous procedures that were declared \\{forward}\X\6
+\X1205:Last-minute procedures\X\par
+\fi
+
+\M1203. We've noted that there are two versions of \MF84. One, called %
+\.{INIMF},
+has to be run first; it initializes everything from scratch, without
+reading a base file, and it has the capability of dumping a base file.
+The other one is called `\.{VIRMF}'; it is a ``virgin'' program that needs
+to input a base file in order to get started. \.{VIRMF} typically has
+a bit more memory capacity than \.{INIMF}, because it does not need the
+space consumed by the dumping/undumping routines and the numerous calls on
+\\{primitive}, etc.
+
+The \.{VIRMF} program cannot read a base file instantaneously, of course;
+the best implementations therefore allow for production versions of \MF\ that
+not only avoid the loading routine for \PASCAL\ object code, they also have
+a base file pre-loaded. This is impossible to do if we stick to standard
+\PASCAL; but there is a simple way to fool many systems into avoiding the
+initialization, as follows:\quad(1)~We declare a global integer variable
+called \\{ready\_already}. The probability is negligible that this
+variable holds any particular value like 314159 when \.{VIRMF} is first
+loaded.\quad(2)~After we have read in a base file and initialized
+everything, we set $\\{ready\_already}\K314159$.\quad(3)~Soon \.{VIRMF}
+will print `\.*', waiting for more input; and at this point we
+interrupt the program and save its core image in some form that the
+operating system can reload speedily.\quad(4)~When that core image is
+activated, the program starts again at the beginning; but now
+$\\{ready\_already}=314159$ and all the other global variables have
+their initial values too. The former chastity has vanished!
+
+In other words, if we allow ourselves to test the condition
+$\\{ready\_already}=314159$, before \\{ready\_already} has been
+assigned a value, we can avoid the lengthy initialization. Dirty tricks
+rarely pay off so handsomely.
+
+On systems that allow such preloading, the standard program called \.{MF}
+should be the one that has \.{plain} base preloaded, since that agrees
+with {\sl The {\logos METAFONT\/}book}. Other versions, e.g., \.{cmbase},
+should also be provided for commonly used bases.
+
+\Y\P$\4\X13:Global variables\X\mathrel{+}\S$\6
+\4\\{ready\_already}: \37\\{integer};\C{a sacrifice of purity for economy}\par
+\fi
+
+\M1204. Now this is really it: \MF\ starts and ends here.
+
+The initial test involving \\{ready\_already} should be deleted if the
+\PASCAL\ runtime system is smart enough to detect such a ``mistake.''
+
+\Y\P\&{begin} \37\C{\\{start\_here}}\6
+$\\{history}\K\\{fatal\_error\_stop}$;\C{in case we quit during initialization}%
+\6
+\\{t\_open\_out};\C{open the terminal for output}\6
+\&{if} $\\{ready\_already}=314159$ \1\&{then}\5
+\&{goto} \37\\{start\_of\_MF};\2\6
+\X14:Check the ``constant'' values for consistency\X\6
+\&{if} $\\{bad}>0$ \1\&{then}\6
+\&{begin} \37$\\{wterm\_ln}(\.{\'Ouch---my\ internal\ constants\ have\ been\
+clobbered!\'},\39\.{\'---case\ \'},\39\\{bad}:1)$;\5
+\&{goto} \37\\{final\_end};\6
+\&{end};\2\6
+\\{initialize};\C{set global variables to their starting values}\6
+\&{init} \37\&{if} $\R\\{get\_strings\_started}$ \1\&{then}\5
+\&{goto} \37\\{final\_end};\2\6
+\\{init\_tab};\C{initialize the tables}\6
+\\{init\_prim};\C{call \\{primitive} for each primitive}\6
+$\\{init\_str\_ptr}\K\\{str\_ptr}$;\5
+$\\{init\_pool\_ptr}\K\\{pool\_ptr}$;\6
+$\\{max\_str\_ptr}\K\\{str\_ptr}$;\5
+$\\{max\_pool\_ptr}\K\\{pool\_ptr}$;\5
+\\{fix\_date\_and\_time};\6
+\&{tini}\6
+$\\{ready\_already}\K314159$;\6
+\4\\{start\_of\_MF}: \37\X55:Initialize the output routines\X;\6
+\X1211:Get the first line of input and prepare to start\X;\6
+$\\{history}\K\\{spotless}$;\C{ready to go!}\6
+\&{if} $\\{start\_sym}>0$ \1\&{then}\C{insert the `\&{everyjob}' symbol}\6
+\&{begin} \37$\\{cur\_sym}\K\\{start\_sym}$;\5
+\\{back\_input};\6
+\&{end};\2\6
+\\{main\_control};\C{come to life}\6
+\\{final\_cleanup};\C{prepare for death}\6
+\4\\{end\_of\_MF}: \37\\{close\_files\_and\_terminate};\6
+\4\\{final\_end}: \37$\\{ready\_already}\K0$;\6
+\&{end}.\par
+\fi
+
+\M1205. Here we do whatever is needed to complete \MF's job gracefully on the
+local operating system. The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+\\{str\_room} or \\{make\_string} at this time, because a call on \\{overflow}
+might lead to an infinite loop.
+
+This program doesn't bother to close the input files that may still be open.
+
+\Y\P$\4\X1205:Last-minute procedures\X\S$\6
+\4\&{procedure}\1\ \37\\{close\_files\_and\_terminate};\6
+\4\&{var} \37\|k: \37\\{integer};\C{all-purpose index}\6
+\\{lh}: \37\\{integer};\C{the length of the \.{TFM} header, in words}\6
+\\{lk\_offset}: \37$0\to256$;\C{extra words inserted at beginning of \\{lig%
+\_kern} array}\6
+\|p: \37\\{pointer};\C{runs through a list of \.{TFM} dimensions}\6
+\|x: \37\\{scaled};\C{a \\{tfm\_width} value being output to the \.{GF} file}\2%
+\6
+\&{begin} \37\&{stat} \37\&{if} $\\{internal}[\\{tracing\_stats}]>0$ \1\&{then}%
+\5
+\X1208:Output statistics about this job\X;\2\ \&{tats}\6
+\\{wake\_up\_terminal};\5
+\X1206:Finish the \.{TFM} and \.{GF} files\X;\6
+\&{if} $\\{log\_opened}$ \1\&{then}\6
+\&{begin} \37\\{wlog\_cr};\5
+$\\{a\_close}(\\{log\_file})$;\5
+$\\{selector}\K\\{selector}-2$;\6
+\&{if} $\\{selector}=\\{term\_only}$ \1\&{then}\6
+\&{begin} \37$\\{print\_nl}(\.{"Transcript\ written\ on\ "})$;\5
+$\\{slow\_print}(\\{log\_name})$;\5
+$\\{print\_char}(\.{"."})$;\6
+\&{end};\2\6
+\&{end};\2\6
+\&{end};\par
+\As1209, 1210\ETs1212.
+\U1202.\fi
+
+\M1206. We want to finish the \.{GF} file if and only if it has already been
+started;
+this will be true if and only if \\{gf\_prev\_ptr} is positive.
+We want to produce a \.{TFM} file if and only if \\{fontmaking} is positive.
+The \.{TFM} widths must be computed if there's a \.{GF} file, even if
+there's going to be no \.{TFM}~file.
+
+We reclaim all of the variable-size memory at this point, so that
+there is no chance of another memory overflow after the memory capacity
+has already been exceeded.
+
+\Y\P$\4\X1206:Finish the \.{TFM} and \.{GF} files\X\S$\6
+\&{if} $(\\{gf\_prev\_ptr}>0)\V(\\{internal}[\\{fontmaking}]>0)$ \1\&{then}\6
+\&{begin} \37\X1207:Make the dynamic memory into one big available node\X;\6
+\X1124:Massage the \.{TFM} widths\X;\6
+\\{fix\_design\_size};\5
+\\{fix\_check\_sum};\6
+\&{if} $\\{internal}[\\{fontmaking}]>0$ \1\&{then}\6
+\&{begin} \37\X1126:Massage the \.{TFM} heights, depths, and italic corrections%
+\X;\6
+$\\{internal}[\\{fontmaking}]\K0$;\C{avoid loop in case of fatal error}\6
+\X1134:Finish the \.{TFM} file\X;\6
+\&{end};\2\6
+\&{if} $\\{gf\_prev\_ptr}>0$ \1\&{then}\5
+\X1182:Finish the \.{GF} file\X;\2\6
+\&{end}\2\par
+\U1205.\fi
+
+\M1207. \P$\X1207:Make the dynamic memory into one big available node\X\S$\6
+$\\{rover}\K\\{lo\_mem\_stat\_max}+1$;\5
+$\\{link}(\\{rover})\K\\{empty\_flag}$;\5
+$\\{lo\_mem\_max}\K\\{hi\_mem\_min}-1$;\6
+\&{if} $\\{lo\_mem\_max}-\\{rover}>\\{max\_halfword}$ \1\&{then}\5
+$\\{lo\_mem\_max}\K\\{max\_halfword}+\\{rover}$;\2\6
+$\\{node\_size}(\\{rover})\K\\{lo\_mem\_max}-\\{rover}$;\5
+$\\{llink}(\\{rover})\K\\{rover}$;\5
+$\\{rlink}(\\{rover})\K\\{rover}$;\5
+$\\{link}(\\{lo\_mem\_max})\K\\{null}$;\5
+$\\{info}(\\{lo\_mem\_max})\K\\{null}$\par
+\U1206.\fi
+
+\M1208. The present section goes directly to the log file instead of using
+\\{print} commands, because there's no need for these strings to take
+up \\{str\_pool} memory when a non-{\bf stat} version of \MF\ is being used.
+
+\Y\P$\4\X1208:Output statistics about this job\X\S$\6
+\&{if} $\\{log\_opened}$ \1\&{then}\6
+\&{begin} \37$\\{wlog\_ln}(\.{\'\ \'})$;\5
+$\\{wlog\_ln}(\.{\'Here\ is\ how\ much\ of\ METAFONT\'}\.{\'s\ memory\'},\39\.{%
+\'\ you\ used:\'})$;\5
+$\\{wlog}(\.{\'\ \'},\39\\{max\_str\_ptr}-\\{init\_str\_ptr}:1,\39\.{\'\ string%
+\'})$;\6
+\&{if} $\\{max\_str\_ptr}\I\\{init\_str\_ptr}+1$ \1\&{then}\5
+$\\{wlog}(\.{\'s\'})$;\2\6
+$\\{wlog\_ln}(\.{\'\ out\ of\ \'},\39\\{max\_strings}-\\{init\_str\_ptr}:1)$;\6
+$\\{wlog\_ln}(\.{\'\ \'},\39\\{max\_pool\_ptr}-\\{init\_pool\_ptr}:1,\39\.{\'\
+string\ characters\ out\ of\ \'},\39\\{pool\_size}-\\{init\_pool\_ptr}:1)$;\6
+$\\{wlog\_ln}(\.{\'\ \'},\39\\{lo\_mem\_max}-\\{mem\_min}+\\{mem\_end}-\\{hi%
+\_mem\_min}+2:1,\39\30\.{\'\ words\ of\ memory\ out\ of\ \'},\39\\{mem\_end}+1-%
+\\{mem\_min}:1)$;\6
+$\\{wlog\_ln}(\.{\'\ \'},\39\\{st\_count}:1,\39\.{\'\ symbolic\ tokens\ out\ of%
+\ \'},\39\\{hash\_size}:1)$;\6
+$\\{wlog\_ln}(\.{\'\ \'},\39\\{max\_in\_stack}:1,\39\.{\'i,\'},\39\30\\{int%
+\_ptr}:1,\39\.{\'n,\'},\39\30\\{max\_rounding\_ptr}:1,\39\.{\'r,\'},\39\30%
+\\{max\_param\_stack}:1,\39\.{\'p,\'},\39\30\\{max\_buf\_stack}+1:1,\39\.{\'b\
+stack\ positions\ out\ of\ \'},\39\30\\{stack\_size}:1,\39\.{\'i,\'},\39\\{max%
+\_internal}:1,\39\.{\'n,\'},\39\\{max\_wiggle}:1,\39\.{\'r,\'},\39\\{param%
+\_size}:1,\39\.{\'p,\'},\39\\{buf\_size}:1,\39\.{\'b\'})$;\6
+\&{end}\2\par
+\U1205.\fi
+
+\M1209. We get to the \\{final\_cleanup} routine when \&{end} or \&{dump} has
+been scanned.
+
+\Y\P$\4\X1205:Last-minute procedures\X\mathrel{+}\S$\6
+\4\&{procedure}\1\ \37\\{final\_cleanup};\6
+\4\&{label} \37\\{exit};\6
+\4\&{var} \37\|c: \37\\{small\_number};\C{0 for \&{end}, 1 for \&{dump}}\2\6
+\&{begin} \37$\|c\K\\{cur\_mod}$;\6
+\&{if} $\\{job\_name}=0$ \1\&{then}\5
+\\{open\_log\_file};\2\6
+\&{while} $\\{input\_ptr}>0$ \1\&{do}\6
+\&{if} $\\{token\_state}$ \1\&{then}\5
+\\{end\_token\_list}\ \&{else} \\{end\_file\_reading};\2\2\6
+\&{while} $\\{loop\_ptr}\I\\{null}$ \1\&{do}\5
+\\{stop\_iteration};\2\6
+\&{while} $\\{open\_parens}>0$ \1\&{do}\6
+\&{begin} \37$\\{print}(\.{"\ )"})$;\5
+$\\{decr}(\\{open\_parens})$;\6
+\&{end};\2\6
+\&{while} $\\{cond\_ptr}\I\\{null}$ \1\&{do}\6
+\&{begin} \37$\\{print\_nl}(\.{"(end\ occurred\ when\ "})$;\6
+$\\{print\_cmd\_mod}(\\{fi\_or\_else},\39\\{cur\_if})$;\C{`\.{if}' or `%
+\.{elseif}' or `\.{else}'}\6
+\&{if} $\\{if\_line}\I0$ \1\&{then}\6
+\&{begin} \37$\\{print}(\.{"\ on\ line\ "})$;\5
+$\\{print\_int}(\\{if\_line})$;\6
+\&{end};\2\6
+$\\{print}(\.{"\ was\ incomplete)"})$;\5
+$\\{if\_line}\K\\{if\_line\_field}(\\{cond\_ptr})$;\5
+$\\{cur\_if}\K\\{name\_type}(\\{cond\_ptr})$;\5
+$\\{loop\_ptr}\K\\{cond\_ptr}$;\5
+$\\{cond\_ptr}\K\\{link}(\\{cond\_ptr})$;\5
+$\\{free\_node}(\\{loop\_ptr},\39\\{if\_node\_size})$;\6
+\&{end};\2\6
+\&{if} $\\{history}\I\\{spotless}$ \1\&{then}\6
+\&{if} $((\\{history}=\\{warning\_issued})\V(\\{interaction}<\\{error\_stop%
+\_mode}))$ \1\&{then}\6
+\&{if} $\\{selector}=\\{term\_and\_log}$ \1\&{then}\6
+\&{begin} \37$\\{selector}\K\\{term\_only}$;\5
+$\\{print\_nl}(\.{"(see\ the\ transcript\ file\ for\ additional\
+information)"})$;\5
+$\\{selector}\K\\{term\_and\_log}$;\6
+\&{end};\2\2\2\6
+\&{if} $\|c=1$ \1\&{then}\6
+\&{begin} \37\&{init} \37\\{store\_base\_file};\5
+\&{return};\ \&{tini}\6
+$\\{print\_nl}(\.{"(dump\ is\ performed\ only\ by\ INIMF)"})$;\5
+\&{return};\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\par
+\fi
+
+\M1210. \P$\X1205:Last-minute procedures\X\mathrel{+}\S$\6
+\&{init} \37\&{procedure}\1\ \37\\{init\_prim};\C{initialize all the
+primitives}\2\6
+\&{begin} \37\X192:Put each of \MF's primitives into the hash table\X;\6
+\&{end};\7
+\4\&{procedure}\1\ \37\\{init\_tab};\C{initialize other tables}\6
+\4\&{var} \37\|k: \37\\{integer};\C{all-purpose index}\2\6
+\&{begin} \37\X176:Initialize table entries (done by \.{INIMF} only)\X\6
+\&{end};\6
+\&{tini}\par
+\fi
+
+\M1211. When we begin the following code, \MF's tables may still contain
+garbage;
+the strings might not even be present. Thus we must proceed cautiously to get
+bootstrapped in.
+
+But when we finish this part of the program, \MF\ is ready to call on the
+\\{main\_control} routine to do its work.
+
+\Y\P$\4\X1211:Get the first line of input and prepare to start\X\S$\6
+\&{begin} \37\X657:Initialize the input routines\X;\6
+\&{if} $(\\{base\_ident}=0)\V(\\{buffer}[\\{loc}]=\.{"\&"})$ \1\&{then}\6
+\&{begin} \37\&{if} $\\{base\_ident}\I0$ \1\&{then}\5
+\\{initialize};\C{erase preloaded base}\2\6
+\&{if} $\R\\{open\_base\_file}$ \1\&{then}\5
+\&{goto} \37\\{final\_end};\2\6
+\&{if} $\R\\{load\_base\_file}$ \1\&{then}\6
+\&{begin} \37$\\{w\_close}(\\{base\_file})$;\5
+\&{goto} \37\\{final\_end};\6
+\&{end};\2\6
+$\\{w\_close}(\\{base\_file})$;\6
+\&{while} $(\\{loc}<\\{limit})\W(\\{buffer}[\\{loc}]=\.{"\ "})$ \1\&{do}\5
+$\\{incr}(\\{loc})$;\2\6
+\&{end};\2\6
+$\\{buffer}[\\{limit}]\K\.{"\%"}$;\6
+\\{fix\_date\_and\_time};\5
+$\\{init\_randoms}((\\{internal}[\\{time}]\mathbin{\&{div}}\\{unity})+%
+\\{internal}[\\{day}])$;\6
+\X70:Initialize the print \\{selector} based on \\{interaction}\X;\6
+\&{if} $\\{loc}<\\{limit}$ \1\&{then}\6
+\&{if} $\\{buffer}[\\{loc}]\I\.{"\\"}$ \1\&{then}\5
+\\{start\_input};\C{\&{input} assumed}\2\2\6
+\&{end}\par
+\U1204.\fi
+
+\N1212. \[50] Debugging.
+Once \MF\ is working, you should be able to diagnose most errors with
+the \.{show} commands and other diagnostic features. But for the initial
+stages of debugging, and for the revelation of really deep mysteries, you
+can compile \MF\ with a few more aids, including the \PASCAL\ runtime
+checks and its debugger. An additional routine called \\{debug\_help}
+will also come into play when you type `\.D' after an error message;
+\\{debug\_help} also occurs just before a fatal error causes \MF\ to succumb.
+
+The interface to \\{debug\_help} is primitive, but it is good enough when used
+with a \PASCAL\ debugger that allows you to set breakpoints and to read
+variables and change their values. After getting the prompt `\.{debug \#}', you
+type either a negative number (this exits \\{debug\_help}), or zero (this
+goes to a location where you can set a breakpoint, thereby entering into
+dialog with the \PASCAL\ debugger), or a positive number \|m followed by
+an argument \|n. The meaning of \|m and \|n will be clear from the
+program below. (If $\|m=13$, there is an additional argument, \|l.)
+
+\Y\P\D \37$\\{breakpoint}=888$\C{place where a breakpoint is desirable}\par
+\Y\P$\4\X1205:Last-minute procedures\X\mathrel{+}\S$\6
+\&{debug} \37\&{procedure}\1\ \37\\{debug\_help};\C{routine to display various
+things}\6
+\4\&{label} \37$\\{breakpoint},\39\\{exit}$;\6
+\4\&{var} \37$\|k,\39\|l,\39\|m,\39\|n$: \37\\{integer};\2\6
+\&{begin} \37\~ \1\&{loop}\6
+\&{begin} \37\\{wake\_up\_terminal};\5
+$\\{print\_nl}(\.{"debug\ \#\ (-1\ to\ exit):"})$;\5
+\\{update\_terminal};\5
+$\\{read}(\\{term\_in},\39\|m)$;\6
+\&{if} $\|m<0$ \1\&{then}\5
+\&{return}\6
+\4\&{else} \&{if} $\|m=0$ \1\&{then}\6
+\&{begin} \37\&{goto} \37\\{breakpoint};\5
+\]\C{go to every label at least once}\6
+\4\\{breakpoint}: \37$\|m\K0$;\5
+$\B\.{\'BREAKPOINT\'}\T\]$\6
+\&{end}\6
+\4\&{else} \&{begin} \37$\\{read}(\\{term\_in},\39\|n)$;\6
+\&{case} $\|m$ \1\&{of}\6
+\hbox{\4}\X1213:Numbered cases for \\{debug\_help}\X\6
+\4\&{othercases} \37$\\{print}(\.{"?"})$\2\6
+\&{endcases};\6
+\&{end};\2\2\6
+\&{end};\2\6
+\4\\{exit}: \37\&{end};\6
+\&{gubed}\par
+\fi
+
+\M1213. \P$\X1213:Numbered cases for \\{debug\_help}\X\S$\6
+\41: \37$\\{print\_word}(\\{mem}[\|n])$;\C{display $\\{mem}[\|n]$ in all forms}%
+\6
+\42: \37$\\{print\_int}(\\{info}(\|n))$;\6
+\43: \37$\\{print\_int}(\\{link}(\|n))$;\6
+\44: \37\&{begin} \37$\\{print\_int}(\\{eq\_type}(\|n))$;\5
+$\\{print\_char}(\.{":"})$;\5
+$\\{print\_int}(\\{equiv}(\|n))$;\6
+\&{end};\6
+\45: \37$\\{print\_variable\_name}(\|n)$;\6
+\46: \37$\\{print\_int}(\\{internal}[\|n])$;\6
+\47: \37\\{do\_show\_dependencies};\6
+\49: \37$\\{show\_token\_list}(\|n,\39\\{null},\39100000,\390)$;\6
+\410: \37$\\{slow\_print}(\|n)$;\6
+\411: \37$\\{check\_mem}(\|n>0)$;\C{check wellformedness; print new busy
+locations if $\|n>0$}\6
+\412: \37$\\{search\_mem}(\|n)$;\C{look for pointers to \|n}\6
+\413: \37\&{begin} \37$\\{read}(\\{term\_in},\39\|l)$;\5
+$\\{print\_cmd\_mod}(\|n,\39\|l)$;\6
+\&{end};\6
+\414: \37\&{for} $\|k\K0\mathrel{\&{to}}\|n$ \1\&{do}\5
+$\\{print}(\\{buffer}[\|k])$;\2\6
+\415: \37$\\{panicking}\K\R\\{panicking}$;\par
+\U1212.\fi
+
+\N1214. \[51] System-dependent changes.
+This section should be replaced, if necessary, by any special
+modifications of the program
+that are necessary to make \MF\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+
+\fi
+
+\N1215. \[52] Index.
+Here is where you can find all uses of each identifier in the program,
+with underlined entries pointing to where the identifier was defined.
+If the identifier is only one letter long, however, you get to see only
+the underlined entries. {\sl All references are to section numbers instead of
+page numbers.}
+
+This index also lists error messages and other aspects of the program
+that you might want to look up some day. For example, the entry
+for ``system dependencies'' lists all sections that should receive
+special attention from people who are installing \MF\ in a new
+operating environment. A list of various things that can't happen appears
+under ``this can't happen''.
+Approximately 25 sections are listed under ``inner loop''; these account
+for more than 60\pct! of \MF's running time, exclusive of input and output.
+\fi
+
+
+\inx
+\:\9{!!!}{\.{\&} primitive}, \[893].
+\:\.{!\relax}, 68, 807.
+\:\9{* }{\.{*} primitive}, \[893].
+\:\.{**}, 36, 788.
+\:\.{*\relax}, 679.
+\:\9{+ }{\.{+} primitive}, \[893].
+\:\9{++\_}{\.{++} primitive}, \[893].
+\:\9{+-+\_}{\.{+-+} primitive}, \[893].
+\:\9{, }{\., primitive}, \[211].
+\:\9{- }{\.{-} primitive}, \[893].
+\:\.{->}, 227.
+\:\9{. }{\..\ token}, 669.
+\:\9{..\_}{\.{..} primitive}, \[211].
+\:\9{/ }{\.{/} primitive}, \[893].
+\:\9{: }{\.{:} primitive}, \[211].
+\:\9{:: }{\.{::} primitive}, \[211].
+\:\9{::: }{\.{\char'174\char'174:} primitive}, \[211].
+\:\9{:=\_}{\.{:=} primitive}, \[211].
+\:\9{; }{\.; primitive}, \[211].
+\:\9{< }{\.{<} primitive}, \[893].
+\:\9{<=\_}{\.{<=} primitive}, \[893].
+\:\9{<>\_}{\.{<>} primitive}, \[893].
+\:\9{= }{\.{=} primitive}, \[893].
+\:\9{=:/>\_}{\.{=:\char'174>} primitive}, \[1108].
+\:\9{=:/>\_}{\.{\char'174=:>} primitive}, \[1108].
+\:\9{=:/>\_}{\.{\char'174=:\char'174>>} primitive}, \[1108].
+\:\9{=:/>\_}{\.{\char'174=:\char'174>} primitive}, \[1108].
+\:\9{=:/\_}{\.{=:\char'174} primitive}, \[1108].
+\:\9{=:/\_}{\.{\char'174=:\char'174} primitive}, \[1108].
+\:\9{=:/\_}{\.{\char'174=:} primitive}, \[1108].
+\:\9{=:\_}{\.{=:} primitive}, \[1108].
+\:\.{=>}, 682.
+\:\9{> }{\.{>} primitive}, \[893].
+\:\9{>=\_}{\.{>=} primitive}, \[893].
+\:\.{>>}, 807, 1040.
+\:\.{>\relax}, 398, 1041.
+\:\.{??}, 261, 263.
+\:\.{???}, 59, 60, 257, 258.
+\:\.{?\relax}, 78, 638.
+\:\9{[ }{\.{[} primitive}, \[211].
+\:\9{] }{\.{]} primitive}, \[211].
+\:\9{][}{\.{\char`\{} primitive}, \[211].
+\:\9{]]\\}{\.{\char`\\} primitive}, \[211].
+\:\9{]]]\#\#\#\#\_}{\.{\#\#\#\#}}, 603.
+\:\9{]]]\#\#\#\_}{\.{\#\#\#}}, 817.
+\:\9{]]]\#\#\_}{\.{\#\#}}, 613.
+\:\9{]]]\#\AT!\_}{\.{\#\AT!} primitive}, \[688].
+\:\9{]]]\AT!\#\_}{\.{\AT!\#} primitive}, \[688].
+\:\9{]]]\AT!\_}{\.{\AT!} primitive}, \[688].
+\:\9{]]]\AT!\_Octant}{\.{\AT! Octant...}}, 509.
+\:\9{]]]\AT!\_retro\_}{\.{\AT! retrograde line...}}, 510.
+\:\9{]]]\AT!\_trans\_}{\.{\AT! transition line...}}, 515, 521.
+\:\9{]]}{\.{\char`\}} primitive}, \[211].
+\:\|{a}, \[47], \[102], \[117], \[124], \[126], \[321], \[391], \[429], \[431],
+\[433], \[440], \[568], \[722], \[773], \[774], \[778], \[976], \[977], \[978],
+\[1154].
+\:\.{a font metric dimension...}, 1140.
+\:\.{A group...never ended}, 832.
+\:\.{A primary expression...}, 823.
+\:\.{A secondary expression...}, 862.
+\:\.{A statement can't begin with x}, 990.
+\:\.{A tertiary expression...}, 864.
+\:\\{a\_close}, \[27], 51, 655, 1205.
+\:\\{a\_make\_name\_string}, \[780], 788, 793.
+\:\\{a\_minus\_b}, \[865], 866.
+\:\\{a\_open\_in}, \[26], 51, 793.
+\:\\{a\_open\_out}, \[26], 788.
+\:\\{a\_plus\_b}, \[865], 866.
+\:\\{a\_tension}, \[296].
+\:\\{aa}, \[286], 288, 290, 291, 301, \[321], 322, \[440], 444, 445, 446.
+\:\\{aaa}, \[321], 322.
+\:\\{ab\_vs\_cd}, \[117], 152, 300, 306, 317, 375, 376, 479, 488, 502, 516,
+522, 546, 548, 549, 943, 949.
+\:\\{abnegate}, \[390], 413, 421.
+\:\\{abort\_find}, \[242], 243.
+\:\\{abs}, 65, 124, 126, 150, 151, 152, 260, 288, 289, 292, 294, 295, 299, 300,
+302, 321, 326, 362, 378, 404, 408, 426, 433, 434, 437, 441, 445, 457, 459, 479,
+496, 498, 502, 529, 533, 540, 543, 589, 591, 595, 596, 598, 599, 600, 603, 611,
+612, 615, 616, 812, 814, 837, 866, 915, 943, 949, 965, 1008, 1056, 1098, 1129,
+1140, 1182.
+\:\\{absorbing}, \[659], 664, 665, 730.
+\:\\{acc}, \[116], \[286], 290.
+\:\\{add\_mac\_ref}, \[226], 720, 845, 862, 864, 868, 1035.
+\:\\{add\_mult\_dep}, \[971], 972.
+\:\\{add\_or\_subtract}, 929, \[930], 936, 939.
+\:\\{add\_pen\_ref}, \[487], 621, 855, 1063.
+\:\\{add\_str\_ref}, \[42], 621, 678, 855, 1083.
+\:\9{add\_to\_}{\&{addto} primitive}, \[211].
+\:\\{add\_to\_command}, \[186], 211, 212, 1058.
+\:\\{add\_to\_type}, \[1059], 1064.
+\:\\{after}, 426, \[427], 429, 436, 439, 440, 444, 446.
+\:\\{all\_safe}, \[426], \[440], 446.
+\:\\{alpha}, \[296], \[433], 436, 439, \[440], 444, \[527], 528, 529, 530, 533.
+\:\\{alpha\_file}, \[24], 26, 27, 30, 31, 50, 54, 631, 780.
+\:\\{already\_there}, \[577], 578, 583, 584.
+\:\9{also\_}{\&{also} primitive}, \[1052].
+\:\\{also\_code}, \[403], 1052, 1059.
+\:\\{ampersand}, \[186], 868, 869, 874, 886, 887, 891, 893, 894.
+\:\.{An expression...}, 868.
+\:\9{and\_}{\&{and} primitive}, \[893].
+\:\\{and\_command}, \[186], 882, 884, 893, 894.
+\:\\{and\_op}, \[189], 893, 940.
+\:\\{angle}, \[106], 137, 139, 144, 145, 256, 279, 283, 527, 542, 865, 875.
+\:\.{angle(0,0)...zero}, 140.
+\:\9{angle\_}{\&{angle} primitive}, \[893].
+\:\\{angle\_op}, \[189], 893, 907.
+\:\\{app\_lc\_hex}, \[48].
+\:\\{append\_char}, \[41], 48, 52, 58, 207, 671, 771, 780, 897, 912, 976, 977.
+\:\\{append\_to\_name}, \[774], 778.
+\:\\{appr\_t}, 556, \[557].
+\:\\{appr\_tt}, 556, \[557].
+\:\\{area\_delimiter}, \[768], 770, 771, 772.
+\:\\{arg\_list}, 719, \[720], 721, 724, 725, 726, 728, 734, 736.
+\:\\{arith\_error}, \[97], 98, 99, 100, 107, 109, 112, 114, 124, 135, 269, 270.
+\:\.{Arithmetic overflow}, 99.
+\:{ASCII code}, 17.
+\:\9{ASCII\_}{\&{ASCII} primitive}, \[893].
+\:\\{ASCII\_code}, \[18], 19, 20, 28, 29, 30, 37, 41, 54, 58, 77, 198, 667,
+771, 774, 778, 913.
+\:\\{ASCII\_op}, \[189], 893, 912, 913.
+\:\\{assignment}, \[186], 211, 212, 693, 733, 755, 821, 841, 868, 993, 995,
+996, 1021, 1035.
+\:\9{at\_}{\&{at} primitive}, \[211].
+\:\\{at\_least}, \[186], 211, 212, 882.
+\:\9{at\_least\_}{\&{atleast} primitive}, \[211], \[256], \[300].
+\:\\{at\_token}, \[186], 211, 212, 1073.
+\:\\{attr}, \[188], 229, 236, 239, 240, 245.
+\:\\{attr\_head}, \[228], 229, 239, 241, 242, 244, 245, 246, 247, 850, 1047.
+\:\\{attr\_loc}, \[229], 236, 239, 241, 244, 245, 246, 850.
+\:\\{attr\_loc\_loc}, \[229], 241.
+\:\\{attr\_node\_size}, \[229], 239, 241, 245, 247.
+\:\\{autorounding}, \[190], 192, 193, 402.
+\:\9{autorounding\_}{\&{autorounding} primitive}, \[192].
+\:\\{avail}, \[161], 163, 164, 165, 176, 177, 181, 1194, 1195.
+\:\.{AVAIL list clobbered...}, 181.
+\:\\{axis}, \[393], 459, 507, 517, 519.
+\:\|{b}, \[124], \[126], \[321], \[391], \[429], \[431], \[433], \[440], %
+\[568], \[580], \[723], \[778], \[913], \[919], \[976], \[977], \[978], %
+\[1072], \[1154].
+\:\\{b\_close}, \[27], 1134, 1182.
+\:\\{b\_make\_name\_string}, \[780], 791, 1134.
+\:\\{b\_open\_out}, \[26], 791, 1134.
+\:\\{b\_tension}, \[296].
+\:\\{back\_error}, \[653], 693, 703, 713, 726, 727, 734, 735, 747, 755, 756,
+765, 820, 832, 839, 859, 861, 875, 878, 881, 990, 991, 1021, 1032, 1034, 1035,
+1106, 1107, 1113.
+\:\\{back\_expr}, 847, \[848].
+\:\\{back\_input}, \[652], 653, 715, 716, 733, 751, 824, 825, 837, 841, 847,
+854, 862, 864, 868, 881, 1012, 1034, 1107, 1204.
+\:\\{back\_list}, \[649], 652, 662, 715, 848.
+\:\\{backed\_up}, \[632], 635, 636, 638, 649, 650.
+\:{backpointers}, 1147.
+\:\.{Backwards path...}, 1068.
+\:\.{BAD}, 219.
+\:\\{bad}, \[13], 14, 154, 204, 214, 310, 553, 777, 1204.
+\:\.{Bad culling amounts}, 1074.
+\:\.{Bad flag...}, 183.
+\:\.{Bad PREVDEP...}, 617.
+\:\.{Bad window number}, 1071.
+\:\\{bad\_binary}, \[923], 929, 936, 940, 941, 948, 951, 952, 975, 983, 988.
+\:\\{bad\_char}, \[913], 914.
+\:\\{bad\_exp}, 823, \[824], 862, 864, 868.
+\:\\{bad\_for}, \[754], 765.
+\:\\{bad\_pool}, \[51], 52, 53.
+\:\\{bad\_subscript}, 846, \[849], 861.
+\:\\{bad\_unary}, 898, \[901], 903, 905, 906, 907, 909, 912, 915, 917, 921.
+\:\\{bad\_vardef}, \[175], 698, 701, 702.
+\:\\{balance}, \[685], 687, \[730], 731, 732.
+\:\\{banner}, \[2], 61, 790, 1183.
+\:\\{base}, \[374], 375, 376, \[697], 703, 704.
+\:\\{base\_area\_length}, \[775], 779.
+\:\\{base\_default\_length}, \[775], 777, 778, 779.
+\:\\{base\_ext\_length}, \[775], 778, 779.
+\:\\{base\_extension}, \[775], 784, 1200.
+\:\\{base\_file}, 779, \[1188], 1189, 1191, 1199, 1200, 1201, 1211.
+\:\\{base\_ident}, 34, 61, 790, \[1183], 1184, 1185, 1198, 1199, 1200, 1211.
+\:\\{batch\_mode}, \[68], 70, 81, 86, 87, 88, 789, 1024, 1025, 1199, 1200.
+\:\9{batch\_mode\_}{\&{batchmode} primitive}, \[1024].
+\:\\{bb}, \[286], 287, 288, 291, \[440], 444, 445, 446.
+\:\\{bc}, 1088, 1089, 1091, 1093, \[1096], 1097, 1099, 1124, 1126, 1132, 1135,
+1136.
+\:\\{bch\_label}, \[1096], 1097, 1111, 1137, 1141.
+\:\\{bchar}, \[1096], 1137, 1139.
+\:\\{bchar\_label}, \[186], 211, 212, 1107.
+\:\\{be\_careful}, \[107], 108, \[109], \[112], \[114], 115, \[119].
+\:\\{before}, 426, \[427], 429, 436, 439, 444, 446.
+\:\\{before\_and\_after}, \[429], 434, 437, 441.
+\:\&{begin}, 7, 8.
+\:\\{begin\_diagnostic}, 71, \[195], 197, 254, 603, 613, 626, 721, 728, 734,
+750, 762, 817, 902, 924, 945, 997, 998.
+\:\\{begin\_edge\_tracing}, \[372], 465, 506.
+\:\\{begin\_file\_reading}, 73, 82, \[654], 717, 793, 897.
+\:\\{begin\_group}, \[186], 211, 212, 732, 823.
+\:\9{begin\_group\_}{\&{begingroup} primitive}, \[211].
+\:\\{begin\_iteration}, 706, 707, \[755], 764.
+\:\\{begin\_name}, 767, \[770], 781, 787.
+\:\\{begin\_pseudoprint}, \[642], 644, 645.
+\:\\{begin\_token\_list}, \[649], 677, 736, 760.
+\:\.{Beginning to dump...}, 1200.
+\:{Bernshte{\u\i}n, Serge{\u\i} Natanovich}, 303.
+\:\\{beta}, \[296], \[440], 444, \[527], 528, 529, 530, 533, 536.
+\:\9{Bezier}{B\'ezier, Pierre Etienne}, 255.
+\:\\{bg\_loc}, 211, 698, \[699], 1198, 1199.
+\:\\{big}, \[124], \[126].
+\:\\{big\_node\_size}, \[230], 231, 232, 803, 810, 857, 919, 928, 939, 966,
+1005.
+\:\\{big\_trans}, 952, \[966].
+\:{BigEndian order}, \[1088].
+\:\\{bilin1}, 967, \[968], 972.
+\:\\{bilin2}, 970, \[972].
+\:\\{bilin3}, 973, \[974].
+\:\\{binary\_mac}, 862, \[863], 864, 868.
+\:\\{bisect\_ptr}, \[309], 311, 312, 314, 553, 558, 559, 561.
+\:\\{bisect\_stack}, \[309], 553.
+\:\\{bistack\_size}, \[11], 309, 310, 553, 557.
+\:\\{black}, \[565], 568, 577, 579, 580, 583, 584, 1143, 1144.
+\:\\{blank\_line}, \[195].
+\:\\{blank\_rectangle}, 564, 566, \[567], 569, 571, 572, 574, 577.
+\:\\{boc}, 1142, 1144, \[1145], 1146, 1147, 1149, 1161, 1162.
+\:\\{boc\_c}, 1161, \[1162], 1165.
+\:\\{boc\_p}, 1161, \[1162], 1165.
+\:\\{boc1}, 1144, \[1145], 1161.
+\:\\{boolean}, 26, 30, 36, 45, 47, 71, 74, 91, 97, 107, 109, 112, 114, 124,
+126, 178, 180, 195, 197, 238, 246, 249, 257, 332, 406, 426, 440, 453, 455, 473,
+497, 527, 564, 569, 572, 577, 592, 599, 600, 621, 661, 680, 771, 779, 782, 801,
+868, 899, 913, 943, 977, 978, 1006, 1054, 1072, 1084, 1096, 1187.
+\:\9{boolean\_}{\&{boolean} primitive}, \[1013].
+\:\\{boolean\_reset}, \[906], 937, 1181.
+\:\\{boolean\_type}, \[187], 216, 248, 621, 798, 799, 802, 809, 855, 892, 895,
+905, 906, 918, 919, 920, 936, 937, 940, 1003, 1013, 1181.
+\:\\{bot}, \[1094].
+\:\\{bot\_row}, \[567], \[572], 574, 577.
+\:\\{boundary\_char}, \[190], 192, 193, 1097, 1137.
+\:\9{boundary\_char\_}{\&{boundarychar} primitive}, \[192].
+\:\\{break}, 33.
+\:\\{break\_in}, 33.
+\:\\{breakpoint}, \[1212].
+\:{Brocot, Achille}, 526.
+\:\\{buf\_size}, \[11], 29, 30, 34, 66, 154, 641, 654, 667, 682, 707, 717, 779,
+786, 788, 1208.
+\:\\{buffer}, \[29], 30, 35, 36, 45, 66, 78, 82, 83, 205, 206, 207, 208, 210,
+629, 630, 641, 644, 667, 669, 671, 673, 674, 679, 681, 682, 717, 778, 779, 781,
+786, 787, 788, 794, 897, 1211, 1213.
+\:\.{Buffer size exceeded}, 34.
+\:\\{bypass\_eoln}, \[30].
+\:\\{byte\_file}, \[24], 26, 27, 780, 791, 1087.
+\:\\{b0}, 153, \[156], 157, 214, 255, 1093, 1094, 1133, 1192, 1193.
+\:\\{b1}, 153, \[156], 157, 214, 255, 1093, 1094, \[1131], 1132, 1133, 1192,
+1193.
+\:\\{b2}, 153, \[156], 157, 1093, 1094, \[1131], 1132, 1133, 1192, 1193.
+\:\\{b3}, 153, \[156], 157, 1093, 1094, \[1131], 1132, 1133, 1192, 1193.
+\:\\{b4}, \[1131], 1132.
+\:\|{c}, \[47], \[77], \[189], \[210], \[217], \[391], \[440], \[491], \[527], %
+\[567], \[568], \[625], \[626], \[667], \[697], \[771], \[774], \[778], \[823],
+\[862], \[863], \[864], \[868], \[895], \[898], \[901], \[910], \[913], \[919],
+\[922], \[923], \[930], \[953], \[960], \[962], \[963], \[966], \[985], %
+\[1070], \[1072], \[1103], \[1104], \[1106], \[1165], \[1209].
+\:\\{cancel\_skips}, \[1110], 1139.
+\:\.{CAPSULE}, 237.
+\:\\{capsule}, \[188], 214, 219, 233, 237, 238, 619, 799, 806, 830, 856, 857,
+911, 931, 982.
+\:\\{capsule\_token}, \[186], 651, 676, 678, 823, 1042.
+\:\\{cat}, 975, \[976].
+\:\\{cc}, \[286], 288, 289, 290, 294, 295, \[440], 444, 445, 446, \[1106].
+\:\\{cf}, \[116], 297, \[298], 299, 300, 301.
+\:\\{change\_if\_limit}, \[746], 748.
+\:\\{char}, 19, 25, 775, 788.
+\:\9{char\_}{\&{char} primitive}, \[893].
+\:\\{char\_class}, 22, \[198], 199, 217, 223, 669, 673, 674.
+\:\\{char\_code}, \[190], 192, 193, 1070.
+\:\9{char\_code\_}{\&{charcode} primitive}, \[192].
+\:\\{char\_dp}, \[190], 192, 193, 1099, 1126.
+\:\9{char\_dp\_}{\&{chardp} primitive}, \[192].
+\:\\{char\_dx}, \[190], 192, 193, 1099.
+\:\9{char\_dx\_}{\&{chardx} primitive}, \[192].
+\:\\{char\_dy}, \[190], 192, 193, 1099.
+\:\9{char\_dy\_}{\&{chardy} primitive}, \[192].
+\:\\{char\_exists}, \[1096], 1097, 1099, 1124, 1126, 1132, 1136, 1181, 1182.
+\:\9{char\_exists\_}{\&{charexists} primitive}, \[893].
+\:\\{char\_exists\_op}, \[189], 893, 906.
+\:\\{char\_ext}, \[190], 192, 193, 1165.
+\:\9{char\_ext\_}{\&{charext} primitive}, \[192].
+\:\\{char\_ht}, \[190], 192, 193, 1099, 1126.
+\:\9{char\_ht\_}{\&{charht} primitive}, \[192].
+\:\\{char\_ic}, \[190], 192, 193, 1099, 1126.
+\:\9{char\_ic\_}{\&{charic} primitive}, \[192].
+\:\\{char\_info}, 1091.
+\:\\{char\_info\_word}, 1089, \[1091], 1092.
+\:\9{char\_list\_}{\&{charlist} primitive}, \[1101].
+\:\\{char\_list\_code}, \[1101], 1102, 1106.
+\:\\{char\_loc}, 1144, \[1145], 1147, 1182.
+\:\\{char\_loc0}, \[1144].
+\:\\{char\_op}, \[189], 893, 912.
+\:\\{char\_ptr}, \[1149], 1163, 1165, 1182.
+\:\\{char\_remainder}, \[1096], 1097, 1104, 1136, 1138.
+\:\\{char\_tag}, \[1096], 1097, 1104, 1105, 1136.
+\:\\{char\_wd}, \[190], 192, 193, 1099, 1124.
+\:\9{char\_wd\_}{\&{charwd} primitive}, \[192].
+\:\.{Character c is already...}, 1105.
+\:{character set dependencies}, 22, 49.
+\:{check sum}, 53, 1090, 1131, 1146.
+\:\\{check\_arith}, \[99], 269, 815, 823, 837, 895, 898, 922, 1001.
+\:\\{check\_colon}, \[747], 748.
+\:\\{check\_delimiter}, 703, 826, 830, \[1032].
+\:\\{check\_equals}, \[693], 694, 697.
+\:\\{check\_gf}, \[1163], 1165, 1177, 1179.
+\:\\{check\_interrupt}, \[91], 650, 669, 825.
+\:\\{check\_mem}, 178, \[180], 617, 825, 1213.
+\:\\{check\_outer\_validity}, \[661], 668, 681.
+\:{Chinese characters}, 1147.
+\:\\{chop\_path}, 975, \[978].
+\:\\{chop\_string}, 975, \[977].
+\:\\{chopped}, \[402], 404.
+\:\\{chr}, 19, 20, 23.
+\:\\{class}, \[217], 220, 221, 223, \[667], 669.
+\:\\{clear\_arith}, \[99].
+\:\\{clear\_for\_error\_prompt}, 73, 78, \[656], 670, 672.
+\:\\{clear\_symbol}, \[249], 252, 254, 692, 1011, 1035.
+\:\\{clear\_terminal}, \[33], 656, 786.
+\:\\{clear\_the\_list}, \[1117], 1124, 1126.
+\:\.{CLOBBERED}, 218.
+\:\\{clobbered}, \[180], 181, 182.
+\:\\{clockwise}, 452, \[453], 454, 458.
+\:\\{close}, 27.
+\:\\{close\_files\_and\_terminate}, 73, 76, 1204, \[1205].
+\:\.{cmbase}, 1203.
+\:\\{coef\_bound}, \[592], 595, 596, 598, 599, 600, 932, 943, 949.
+\:\\{collective\_subscript}, \[229], 239, 241, 244, 246, 850, 1012.
+\:\\{colon}, \[186], 211, 212, 747, 756, 764, 1106, 1107, 1111, 1113.
+\:\\{comma}, \[186], 211, 212, 704, 725, 726, 727, 764, 826, 859, 878, 1015,
+1016, 1029, 1033, 1036, 1040, 1044, 1049, 1107, 1113, 1114, 1115.
+\:\\{command\_code}, \[186], 685, 694, 1072.
+\:\\{common\_ending}, \[15], 865, 1071.
+\:\\{compromise}, \[432], 435, 438, 443.
+\:\\{concatenate}, \[189], 893, 975.
+\:\\{cond\_ptr}, \[738], 739, 744, 745, 746, 748, 749, 1209.
+\:\\{conditional}, 706, 707, \[748].
+\:\\{confusion}, \[90], 107, 114, 216, 236, 239, 311, 362, 378, 517, 523, 589,
+655, 746, 802, 809, 855.
+\:\\{const\_dependency}, \[607], 608, 969, 972, 1007.
+\:\\{constant\_x}, \[406], 407, 413, 417.
+\:\\{continue}, \[15], 77, 78, 79, 83, 84, 311, 314, 402, 406, 417, 447, 556,
+755, 764, 862, 864, 868, 1106, 1107, 1111.
+\:\\{continue\_path}, \[868], 869.
+\:\9{contour\_}{\&{contour} primitive}, \[1052].
+\:\\{contour\_code}, \[403], 917, 1052, 1053.
+\:\.{control?}, 258.
+\:\\{controls}, \[186], 211, 212, 881.
+\:\9{controls\_}{\&{controls} primitive}, \[211].
+\:\\{coord\_node\_size}, 175, \[472], 476, 481, 487.
+\:{coordinates, explained}, 576.
+\:\\{copied}, \[1006], 1009.
+\:\\{copy\_dep\_list}, \[609], 855, 858, 947.
+\:\\{copy\_edges}, \[334], 621, 855.
+\:\\{copy\_knot}, \[264], 870, 885, 980, 981.
+\:\\{copy\_path}, \[265], 621, 855.
+\:\9{cos\_d\_}{\&{cosd} primitive}, \[893].
+\:\\{cos\_d\_op}, \[189], 893, 906.
+\:\\{cosine}, \[280], 281.
+\:\\{crossing\_point}, \[391], 392, 407, 411, 413, 415, 420, 424, 497, 499,
+503, 545, 547, 549.
+\:\\{cs}, \[1146].
+\:\\{ct}, \[116], 297, \[298], 299, 300, 301.
+\:\\{cubic\_intersection}, 555, \[556], 557, 562.
+\:\9{cull\_}{\&{cull} primitive}, \[211].
+\:\\{cull\_command}, \[186], 211, 212, 1069.
+\:\\{cull\_edges}, \[348], 1074.
+\:\\{cull\_op}, \[186], 1052, 1053, 1074.
+\:\\{cur\_area}, \[767], 772, 784, 786, 793, 795.
+\:\\{cur\_cmd}, 83, 186, \[624], 626, 651, 652, 658, 667, 668, 671, 675, 676,
+678, 685, 686, 691, 693, 697, 700, 703, 704, 705, 706, 707, 713, 715, 718, 725,
+726, 727, 731, 732, 733, 734, 735, 742, 743, 747, 755, 756, 764, 765, 796, 823,
+824, 826, 832, 837, 839, 841, 844, 846, 847, 851, 852, 859, 860, 861, 862, 864,
+868, 869, 874, 875, 878, 881, 882, 884, 989, 990, 991, 992, 993, 995, 996,
+1011, 1012, 1015, 1016, 1017, 1021, 1029, 1032, 1033, 1034, 1035, 1036, 1040,
+1041, 1042, 1044, 1049, 1051, 1062, 1072, 1074, 1106, 1107, 1111, 1113, 1114,
+1115.
+\:\\{cur\_edges}, \[327], 328, 329, 330, 331, 332, 333, 336, 337, 340, 341,
+342, 343, 348, 352, 353, 354, 355, 356, 364, 365, 366, 367, 373, 374, 375, 376,
+377, 378, 381, 382, 383, 384, 465, 577, 581, 804, 929, 963, 964, 965, 1057,
+1061, 1064, 1070, 1071, 1074, 1167, 1169, 1172.
+\:\\{cur\_exp}, 603, 615, 651, 713, 716, 717, 718, 726, 728, 730, 748, 750,
+760, 761, 764, 765, \[796], 797, 798, 799, 800, 801, 808, 816, 819, 823, 827,
+829, 830, 833, 837, 840, 841, 846, 852, 855, 856, 857, 860, 861, 863, 865, 870,
+872, 875, 876, 877, 878, 879, 880, 882, 883, 885, 891, 895, 896, 897, 898, 901,
+903, 905, 906, 907, 908, 910, 912, 913, 915, 916, 917, 919, 920, 921, 923, 927,
+929, 930, 931, 935, 936, 937, 938, 939, 940, 941, 942, 943, 944, 946, 948, 949,
+951, 953, 955, 956, 962, 963, 964, 967, 968, 970, 972, 973, 976, 977, 978, 979,
+984, 985, 988, 992, 994, 995, 996, 999, 1003, 1004, 1005, 1006, 1009, 1022,
+1056, 1059, 1061, 1062, 1063, 1070, 1071, 1072, 1073, 1074, 1082, 1083, 1086,
+1103, 1106, 1112, 1115, 1177, 1179, 1181.
+\:\\{cur\_ext}, \[767], 772, 784, 786, 793, 795.
+\:\\{cur\_file}, \[631], 655, 681, 793, 794.
+\:\\{cur\_gran}, \[430], 431, 432, 433, 442.
+\:\\{cur\_if}, \[738], 739, 744, 745, 748, 1209.
+\:\\{cur\_input}, 34, 35, 82, \[628], 629, 635, 647, 648, 788.
+\:\\{cur\_length}, \[40], 1163.
+\:\\{cur\_min\_m}, \[1165], 1172, 1173.
+\:\\{cur\_mod}, 83, \[624], 626, 651, 652, 658, 667, 668, 671, 675, 676, 678,
+687, 690, 691, 694, 697, 700, 703, 705, 707, 711, 718, 726, 727, 731, 735, 742,
+743, 748, 749, 751, 755, 796, 823, 824, 826, 833, 834, 835, 837, 839, 841, 846,
+847, 851, 860, 861, 862, 864, 868, 990, 992, 1011, 1015, 1023, 1029, 1032,
+1034, 1035, 1040, 1041, 1042, 1049, 1051, 1054, 1059, 1074, 1082, 1106, 1112,
+1177, 1209.
+\:\\{cur\_name}, \[767], 772, 784, 786, 793, 795.
+\:\\{cur\_path\_type}, \[403], 435, 438, 442, 917, 1064, 1068.
+\:\\{cur\_pen}, 402, \[403], 435, 438, 442, 506, 917, 1062, 1063, 1064, 1068.
+\:\\{cur\_rounding\_ptr}, 426, \[427], 429, 433, 436, 439, 440, 444, 446.
+\:\\{cur\_spec}, 394, 399, 400, 402, \[403], 404, 406, 407, 417, 419, 421, 433,
+440, 447, 450, 452.
+\:\\{cur\_sym}, 83, 210, 211, \[624], 651, 652, 658, 661, 662, 663, 664, 667,
+668, 669, 676, 677, 683, 685, 686, 690, 691, 692, 694, 700, 703, 704, 705, 707,
+718, 726, 735, 740, 751, 755, 796, 823, 824, 826, 837, 846, 847, 851, 860, 862,
+864, 868, 893, 1011, 1012, 1029, 1031, 1032, 1033, 1034, 1035, 1036, 1041,
+1049, 1076, 1204.
+\:\\{cur\_t}, \[555], 556, 558, 559, 560, 561, 562, 988.
+\:\\{cur\_tok}, \[651], 652, 685, 715, 730, 844.
+\:\\{cur\_tt}, \[555], 556, 558, 559, 560, 561, 562, 988.
+\:\\{cur\_type}, 603, 615, 651, 716, 718, 726, 728, 730, 760, 764, 765, \[796],
+798, 799, 800, 801, 808, 816, 819, 823, 826, 827, 830, 832, 833, 837, 840, 841,
+846, 852, 855, 856, 857, 860, 861, 864, 865, 870, 872, 876, 877, 878, 883, 885,
+891, 892, 895, 896, 897, 898, 901, 903, 905, 906, 907, 908, 909, 910, 912, 915,
+917, 918, 919, 920, 921, 923, 927, 929, 930, 931, 934, 935, 936, 937, 939, 940,
+941, 942, 944, 946, 948, 951, 953, 955, 960, 962, 967, 970, 973, 975, 982, 983,
+988, 989, 992, 993, 995, 996, 999, 1000, 1002, 1003, 1004, 1006, 1009, 1021,
+1054, 1059, 1061, 1062, 1070, 1071, 1072, 1073, 1074, 1082, 1103, 1106, 1112,
+1115, 1177, 1181.
+\:\\{cur\_wt}, \[327], 372, 373, 374, 375, 376, 378, 381, 382, 383, 384, 465,
+1064, 1068.
+\:\\{cur\_x}, 387, 388, \[389], 390, 394, 413, 421, 445, 447, 451, 454, 457,
+481, 485, 488, 489, 510, 871, 872, 873, 877, 878, 884, 984, 1072, 1073, 1074,
+1075.
+\:\\{cur\_y}, 387, 388, \[389], 390, 394, 413, 421, 445, 447, 451, 454, 457,
+481, 485, 488, 489, 510, 871, 872, 873, 877, 878, 884, 984, 1072, 1073, 1074,
+1075.
+\:\\{curl}, \[256], 258, 259, 263, 271, 282, 284, 285, 290, 875, 876, 888, 889,
+890, 891.
+\:\9{curl\_}{\&{curl} primitive}, \[211].
+\:\\{curl\_command}, \[186], 211, 212, 875.
+\:\\{curl\_ratio}, 294, 295, \[296].
+\:{curvature}, 275.
+\:\.{Curve out of range}, 404.
+\:\\{cycle}, \[186], 823, 869, 893, 894.
+\:{cycle spec}, \[393].
+\:\.{Cycle spec at line...}, 394.
+\:\9{cycle\_}{\&{cycle} primitive}, \[893].
+\:\\{cycle\_hit}, \[868], 869, 886, 891.
+\:\\{cycle\_op}, \[189], 893, 920.
+\:\\{c0}, \[574], 575, 576, \[1073].
+\:\\{c1}, \[574], 575, \[1073].
+\:\|{d}, \[333], \[348], \[373], \[391], \[440], \[527], \[580], \[862], %
+\[864], \[868], \[944], \[1118], \[1120], \[1121], \[1128], \[1159], \[1165].
+\:{data structure assumptions}, 176.
+\:\\{day}, \[190], 192, 193, 194, 790, 1163, 1200, 1211.
+\:\9{day\_}{\&{day} primitive}, \[192].
+\:\\{dd}, \[286], 288, 289, \[440], 444, 445, 446.
+\:{dead cubics}, \[402].
+\:\&{debug}, \[7], \[9], \[73], \[79], \[88], \[157], \[178], \[179], \[180], %
+\[185], \[1212].
+\:\.{debug \#}, 1212.
+\:\\{debug\_help}, 73, 79, 88, \[1212].
+\:{debugging}, 7, 79, 91, 157, 178, 1212.
+\:\\{decimal}, \[189], 893, 912.
+\:\9{decimal\_}{\&{decimal} primitive}, \[893].
+\:\.{Declared variable conflicts...}, 1015.
+\:\\{decr}, \[16], 43, 46, 63, 66, 81, 83, 84, 86, 87, 102, 121, 123, 149, 163,
+164, 177, 195, 207, 226, 291, 315, 322, 330, 331, 332, 333, 352, 364, 375, 376,
+377, 382, 383, 384, 436, 439, 458, 459, 483, 487, 488, 497, 515, 516, 521, 522,
+556, 560, 577, 635, 648, 650, 655, 681, 687, 731, 732, 742, 854, 862, 864, 868,
+1051, 1122, 1135, 1138, 1139, 1141, 1167, 1182, 1194, 1209.
+\:\9{def\_}{\&{def} primitive}, \[683].
+\:\\{def\_delims}, 1030, \[1031].
+\:\\{def\_ref}, \[720], 721, 736.
+\:\\{defined\_macro}, \[186], 249, 700, 706, 707, 718, 1035, 1041, 1043.
+\:\\{del}, \[406], 407, 408, 413, \[419], 420, \[453], 454.
+\:\\{del\_m}, \[1144].
+\:\\{del\_n}, \[1144].
+\:\\{delete\_mac\_ref}, \[226], 249, 650, 809.
+\:\\{delete\_pen\_ref}, \[487], 808, 809, 1062, 1063.
+\:\\{delete\_str\_ref}, \[43], 216, 691, 743, 808, 809, 976, 977, 1042, 1083.
+\:\\{deletions\_allowed}, \[71], 72, 79, 80, 93, 661, 670, 672, 675.
+\:\\{delimiters}, \[186], 211, 212, 1030.
+\:\9{delimiters\_}{\&{delimiters} primitive}, \[211].
+\:\\{delta}, \[103], \[279], 281, 288, \[328], \[329], 330, 331, \[342], 343, %
+\[366], 367, \[378], 381, 382, 383, 384, \[527], 530, 531, 533, 534, 535, %
+\[968], \[974], \[1165], 1173, 1174.
+\:\\{delta\_a}, \[426].
+\:\\{delta\_b}, \[426].
+\:\\{delta\_x}, \[279], 281, 292, 293, 299, 301, 302.
+\:\\{delta\_y}, \[279], 281, 292, 293, 299, 301, 302.
+\:\\{delx}, \[280], 282, \[374], 375, 376, \[511], 516, 522, 552, 553, 556, %
+\[557], 558, 559, 560, 561.
+\:\\{dely}, \[280], 282, \[374], 375, 376, \[511], 516, 522, 552, 553, 556, %
+\[557], 558, 559, 560, 561.
+\:\\{del1}, \[406], 407, 408, 409, 413, 414, \[419], 420, 421, 423.
+\:\\{del2}, \[406], 407, 408, 409, 411, 413, 414, 415, \[419], 420, 421, 423,
+424.
+\:\\{del3}, \[406], 407, 408, 409, 411, 413, 414, 415, \[419], 420, 421, 423,
+424.
+\:\\{denom}, \[116], \[296], \[836], 837.
+\:\\{dep\_div}, 948, \[949].
+\:\\{dep\_final}, \[592], 594, 597, 601, 606, 607, 608, 609, 615, 818, 819,
+829, 855, 856, 858, 971, 972, 1007.
+\:\\{dep\_finish}, 934, \[935], 943, 949.
+\:\\{dep\_head}, \[175], 587, 588, 604, 606, 614, 617, 812, 1050.
+\:\\{dep\_list}, 585, \[587], 604, 605, 606, 614, 617, 798, 799, 801, 803, 811,
+812, 816, 818, 819, 827, 855, 858, 903, 930, 931, 932, 935, 943, 947, 949, 959,
+968, 969, 971, 972, 1007, 1009, 1050.
+\:\\{dep\_mult}, 942, \[943], 944, 946, 968.
+\:\\{dep\_node\_size}, \[587], 595, 596, 597, 598, 599, 600, 601, 603, 605,
+607, 608, 609, 612, 615, 616, 818, 819, 829, 1008.
+\:\\{dependent}, \[187], 216, 248, 585, 587, 588, 589, 590, 594, 595, 596, 597,
+599, 600, 601, 603, 610, 612, 613, 615, 798, 799, 800, 801, 802, 808, 809, 812,
+813, 815, 816, 817, 818, 819, 829, 855, 857, 858, 900, 903, 930, 932, 943, 949,
+969, 1003, 1006, 1007, 1009, 1010, 1050.
+\:\\{depth\_index}, \[1091].
+\:{design size}, 1146.
+\:\\{design\_size}, \[190], 192, 193, 1128, 1129, 1182.
+\:\9{design\_size\_}{\&{designsize} primitive}, \[192].
+\:\\{dest\_x}, \[406], 407, 409, 411, 412, 413, 415, 416, \[419], 421, 423,
+424, 425.
+\:\\{dest\_y}, \[406], 407, 411, 412, 413, 414, 415, 416, \[419], 421, 423,
+424, 425.
+\:\\{diag\_offset}, \[442], 443.
+\:\\{diag\_round}, 402, \[440].
+\:\\{diagonal}, \[393], 459, 507, 508, 509, 519, 523.
+\:\\{dig}, \[54], 63, 64, 102, 674.
+\:\\{digit\_class}, \[198], 199, 220, 669, 673, 674.
+\:\\{dimen\_head}, 1124, \[1125], 1126, 1136.
+\:\\{dimen\_out}, \[1129], 1132, 1136, 1139, 1140.
+\:\9{direction\_time\_}{\&{directiontime} primitive}, \[893].
+\:\\{direction\_time\_of}, \[189], 893, 983.
+\:{dirty \PASCAL}, \[3], 157, 185, 1203.
+\:\\{discard\_suffixes}, \[246].
+\:\\{disp\_edges}, \[577], 1071.
+\:\\{disp\_err}, 716, 754, \[807], 873, 923, 937, 955, 1002.
+\:\\{disp\_token}, \[1041], 1043, 1044, 1049.
+\:\\{disp\_var}, \[1046], 1047, 1049.
+\:\9{display\_}{\&{display} primitive}, \[211].
+\:\\{display\_command}, \[186], 211, 212, 1069.
+\:\&{div}, \[95].
+\:\.{Division by zero}, 838, 950.
+\:\\{dm}, \[1144].
+\:\\{dmax}, 404, \[406], 408, \[419], \[453], 457.
+\:\\{do\_add\_to}, 1058, \[1059].
+\:\\{do\_assignment}, 993, 995, \[996].
+\:\\{do\_binary}, 834, 837, 839, 859, 862, 864, 868, 893, \[922], 966.
+\:\\{do\_cull}, 1069, \[1074].
+\:\\{do\_display}, 1069, \[1071].
+\:\\{do\_equation}, 993, \[995], 996.
+\:\\{do\_expression}, 996.
+\:\\{do\_interim}, 1033, \[1034].
+\:\\{do\_let}, 1033, \[1035].
+\:\\{do\_message}, 1081, \[1082].
+\:\\{do\_new\_internal}, 1033, \[1036].
+\:\\{do\_nothing}, \[16], 33, 57, 58, 79, 146, 216, 223, 249, 669, 707, 794,
+808, 809, 919, 957, 1003, 1035.
+\:\\{do\_nullary}, 834, 893, \[895].
+\:\\{do\_open\_window}, 1069, \[1073].
+\:\\{do\_protection}, 1026, \[1029].
+\:\\{do\_random\_seed}, 1020, \[1021].
+\:\\{do\_ship\_out}, 1069, \[1070].
+\:\\{do\_show}, \[1040], 1051.
+\:\\{do\_show\_dependencies}, \[1050], 1051, 1213.
+\:\\{do\_show\_stats}, \[1045], 1051.
+\:\\{do\_show\_token}, \[1044], 1051.
+\:\\{do\_show\_var}, 1046, \[1049], 1051.
+\:\\{do\_show\_whatever}, 1039, \[1051].
+\:\\{do\_special}, 1175, \[1177].
+\:\\{do\_statement}, 832, \[989], 992, 1017, 1020, 1034.
+\:\\{do\_tfm\_command}, 1100, \[1106].
+\:\\{do\_type\_declaration}, 992, \[1015].
+\:\\{do\_unary}, 834, 835, 893, \[898].
+\:\\{done}, \[15], 47, 53, 124, 125, 126, 127, 177, 257, 269, 272, 311, 317,
+344, 345, 346, 347, 348, 349, 354, 358, 366, 368, 374, 375, 378, 381, 382, 383,
+384, 394, 402, 452, 458, 477, 479, 488, 491, 502, 506, 512, 518, 527, 531, 532,
+539, 546, 547, 548, 577, 578, 584, 594, 597, 604, 605, 609, 635, 650, 667, 673,
+685, 687, 730, 731, 732, 742, 748, 749, 755, 764, 765, 781, 786, 787, 793, 809,
+812, 823, 835, 837, 839, 840, 841, 852, 860, 868, 881, 919, 922, 930, 932, 936,
+953, 955, 957, 958, 959, 1001, 1003, 1004, 1005, 1006, 1007, 1011, 1012, 1049,
+1059, 1068, 1106, 1107, 1110, 1165, 1172, 1173.
+\:\\{done1}, \[15], 180, 181, 257, 258, 261, 374, 376, 477, 481, 506, 516, 518,
+522, 527, 536, 823, 844, 922, 939, 1006, 1009.
+\:\\{done2}, \[15], 180, 182, 823, 850.
+\:\\{done3}, \[15].
+\:\\{done4}, \[15].
+\:\\{done5}, \[15].
+\:\\{done6}, \[15].
+\:\\{double}, \[16], 108, 115, 123, 132, 142, 143, 392, 408, 457, 496, 543,
+556, 559.
+\:\.{Double-AVAIL list clobbered...}, 182.
+\:\\{double\_colon}, \[186], 211, 212, 1107.
+\:\\{double\_dot}, \[189].
+\:\9{double\_path\_}{\&{doublepath} primitive}, \[1052].
+\:\\{double\_path\_code}, \[403], 435, 438, 442, 1052, 1053, 1059, 1064, 1068.
+\:\.{Doubly free location...}, 182.
+\:\\{drop\_code}, \[1052], 1053, 1074, 1075.
+\:\9{dropping\_}{\&{dropping} primitive}, \[1052].
+\:{dry rot}, 90.
+\:\\{ds}, \[1146].
+\:\\{du}, \[495], \[497], 498.
+\:\\{dual\_moves}, 512, \[518].
+\:\.{dump...only by INIMF}, 1209.
+\:\9{dump\_}{\&{dump} primitive}, \[1018].
+\:\\{dump\_four\_ASCII}, \[1192].
+\:\\{dump\_hh}, \[1188], 1196.
+\:\\{dump\_int}, \[1188], 1190, 1192, 1194, 1196, 1198.
+\:\\{dump\_qqqq}, \[1188], 1192.
+\:\\{dump\_wd}, \[1188], 1194.
+\:\\{dup\_offset}, \[476], 483.
+\:\\{dv}, \[495], \[497], 498.
+\:\\{dw}, \[357], 358.
+\:\\{dx}, \[378], 380, 381, 382, 383, 384, \[477], 479, 480, 494, \[495], 501,
+502, 1144, 1147.
+\:\\{dx1}, \[453], 454, 457.
+\:\\{dx2}, \[453], 454, 457.
+\:\\{dy}, \[477], 479, 480, \[495], 501, 502, 1144, 1147.
+\:\\{dyn\_used}, \[160], 163, 164, 165, 176, 177, 1045, 1194, 1195.
+\:\\{dy1}, \[453], 454, 457.
+\:\\{dy2}, \[453], 454, 457.
+\:\\{d0}, \[464], 467, 468, 508, 517, 523.
+\:\\{d1}, 463, \[464], 467, 468, 508, 517, 523.
+\:\|{e}, \[773], \[774], \[786], \[1071], \[1074].
+\:\\{east\_edge}, \[435].
+\:\\{east\_west\_edge}, \[435].
+\:\\{ec}, 1088, 1089, 1091, 1093, \[1096], 1097, 1099, 1124, 1126, 1132, 1135,
+1136.
+\:\\{edge\_and\_weight}, \[378], 381, 382, 383, 384.
+\:\\{edge\_header\_size}, \[326], 334, 385, 895, 964.
+\:\\{edge\_prep}, \[329], 366, 375, 376, 380.
+\:\\{edges\_trans}, 952, \[963].
+\:\\{ee}, \[286], 288, 289.
+\:\\{eg\_loc}, 211, 698, \[699], 1198, 1199.
+\:\\{eight\_bits}, \[24], 63, 624, 1096, 1103, 1131, 1149, 1152, 1163, 1165.
+\:\\{eighth\_octant}, \[139], 141, 380, 387, 388, 390, 396, 426, 443, 449, 461,
+462.
+\:\\{el\_gordo}, \[95], 100, 107, 109, 112, 114, 124, 135, 235, 244, 917, 1118,
+1140.
+\:\&{else}, 10.
+\:\9{else\_}{\&{else} primitive}, \[740].
+\:\\{else\_code}, \[738], 740, 741.
+\:\9{else\_if\_}{\&{elseif} primitive}, \[740].
+\:\\{else\_if\_code}, \[738], 740, 748.
+\:\.{Emergency stop}, 88.
+\:\\{empty\_edges}, \[326], 329, 963.
+\:\\{empty\_flag}, \[166], 168, 172, 176, 1207.
+\:\\{encapsulate}, 855, \[856].
+\:\&{end}, 7, 8, 10.
+\:\.{end occurred...}, 1209.
+\:\.{End of file on the terminal}, 36, 66.
+\:\9{end\_}{\&{end} primitive}, \[1018].
+\:\\{end\_attr}, \[175], 229, 239, 247, 1047.
+\:\\{end\_cycle}, \[272], 281, 282, 284, 287.
+\:\\{end\_def}, \[683], 992.
+\:\9{end\_def\_}{\&{enddef} primitive}, \[683].
+\:\\{end\_diagnostic}, \[195], 254, 257, 332, 372, 394, 473, 603, 613, 626,
+721, 728, 734, 750, 762, 817, 902, 924, 945, 997, 998.
+\:\\{end\_edge\_tracing}, \[372], 465, 506.
+\:\\{end\_file\_reading}, \[655], 656, 679, 681, 714, 793, 897, 1209.
+\:\\{end\_for}, \[683], 707.
+\:\9{end\_for\_}{\&{endfor} primitive}, \[683].
+\:\\{end\_group}, \[186], 211, 212, 732, 832, 991, 992, 993, 1017.
+\:\9{end\_input\_}{\&{endinput} primitive}, \[709].
+\:\\{end\_name}, 767, \[772], 781, 787.
+\:\\{end\_of\_MF}, \[6], 76, 1204.
+\:\\{end\_of\_statement}, \[186], 732, 991, 1015, 1016.
+\:\\{end\_round}, \[463], 464, 467, 508.
+\:\\{end\_token\_list}, \[650], 652, 676, 712, 714, 736, 795, 1209.
+\:\&{endcases}, \[10].
+\:\9{endgroup\_}{\&{endgroup} primitive}, \[211].
+\:\\{endpoint}, \[255], 256, 257, 258, 266, 273, 393, 394, 398, 399, 400, 401,
+402, 451, 452, 457, 465, 466, 491, 506, 512, 518, 539, 562, 563, 865, 868, 870,
+871, 885, 891, 916, 917, 920, 921, 962, 978, 979, 985, 987, 1064.
+\:\.{Enormous chardp...}, 1098.
+\:\.{Enormous charht...}, 1098.
+\:\.{Enormous charic...}, 1098.
+\:\.{Enormous charwd...}, 1098.
+\:\.{Enormous designsize...}, 1098.
+\:\.{Enormous number...}, 675.
+\:\.{entering the nth octant}, 394.
+\:\\{env\_move}, \[507], 513, 514, 515, 516, 517, 519, 520, 521, 522, 523.
+\:\\{eoc}, 1142, 1144, \[1145], 1146, 1149, 1165.
+\:\\{eof}, 25, 30, 52, 1199.
+\:\\{eoln}, 30, 52.
+\:\\{eq\_type}, \[200], 202, 203, 210, 211, 213, 229, 242, 249, 254, 668, 694,
+700, 702, 759, 850, 1011, 1029, 1031, 1035, 1036, 1041, 1213.
+\:\\{eqtb}, 158, 200, \[201], 202, 210, 211, 212, 213, 249, 250, 252, 254, 625,
+632, 683, 740, 893, 1196, 1197.
+\:\\{equal\_to}, \[189], 893, 936, 937.
+\:\\{equals}, \[186], 693, 733, 755, 868, 893, 894, 993, 995, 996, 1035.
+\:\.{Equation cannot be performed}, 1002.
+\:\\{equiv}, \[200], 202, 209, 210, 211, 213, 229, 234, 239, 242, 249, 254,
+664, 668, 694, 700, 702, 850, 1011, 1015, 1030, 1031, 1035, 1036, 1213.
+\:\\{err\_help}, \[74], 75, 85, 1083, 1086.
+\:\9{err\_help\_}{\&{errhelp} primitive}, \[1079].
+\:\\{err\_help\_code}, \[1079], 1082.
+\:\9{err\_message\_}{\&{errmessage} primitive}, \[1079].
+\:\\{err\_message\_code}, \[1079], 1080, 1082.
+\:\\{error}, 67, 70, 71, 73, 74, \[77], 83, 88, 93, 99, 122, 128, 134, 140,
+602, 653, 670, 672, 675, 701, 708, 712, 713, 725, 751, 778, 789, 795, 820, 838,
+996, 1032, 1051, 1110.
+\:\\{error\_count}, \[71], 72, 77, 81, 989, 1051.
+\:\\{error\_line}, \[11], 14, 54, 58, 635, 641, 642, 643, 665.
+\:\\{error\_message\_issued}, \[71], 77, 90.
+\:\\{error\_stop\_mode}, 67, \[68], 69, 77, 88, 93, 398, 807, 1024, 1051, 1086,
+1199, 1209.
+\:\9{error\_stop\_mode\_}{\&{errorstopmode} primitive}, \[1024].
+\:\\{erstat}, \[26].
+\:\\{eta\_corr}, 306, \[311], 313, 314, 317.
+\:\.{ETC}, 217, 227.
+\:\9{every\_job\_}{\&{everyjob} primitive}, \[211].
+\:\\{every\_job\_command}, \[186], 211, 212, 1076.
+\:\\{excess}, \[1119], 1120, 1122.
+\:\\{exit}, \[15], 16, 36, 46, 47, 77, 117, 167, 217, 227, 235, 242, 246, 265,
+266, 284, 311, 391, 406, 488, 497, 539, 556, 562, 589, 622, 667, 746, 748, 760,
+779, 868, 899, 904, 922, 928, 930, 943, 949, 953, 962, 963, 966, 1032, 1070,
+1071, 1073, 1074, 1131, 1161, 1187, 1209, 1212.
+\:\9{exit\_if\_}{\&{exitif} primitive}, \[211].
+\:\\{exit\_test}, \[186], 211, 212, 706, 707.
+\:\\{exp\_err}, \[807], 830, 849, 872, 876, 878, 883, 892, 901, 914, 923, 937,
+950, 960, 993, 996, 999, 1002, 1021, 1055, 1060, 1061, 1062, 1071, 1082, 1103,
+1106, 1112, 1115, 1178.
+\:\\{expand}, \[707], 715, 718.
+\:\\{expand\_after}, \[186], 211, 212, 706, 707.
+\:\9{expand\_after\_}{\&{expandafter} primitive}, \[211].
+\:\\{explicit}, \[256], 258, 261, 262, 266, 271, 273, 280, 282, 299, 302, 393,
+407, 486, 563, 874, 880, 884, 1066.
+\:\.{EXPR}, 222.
+\:\9{expr\_}{\&{expr} primitive}, \[695].
+\:\\{expr\_base}, \[214], 218, 222, 676, 683, 684, 694, 695, 696, 697, 703,
+705, 725, 727, 755, 764.
+\:\\{expr\_macro}, \[226], 227, 705, 733.
+\:\\{expression\_binary}, \[186], 893, 894.
+\:\\{expression\_tertiary\_macro}, \[186], 249, 683, 868, 1035, 1043.
+\:\\{ext\_bot}, \[1094], 1113.
+\:\\{ext\_delimiter}, \[768], 770, 771, 772.
+\:\\{ext\_mid}, \[1094], 1113.
+\:\\{ext\_rep}, \[1094], 1113.
+\:\\{ext\_tag}, \[1092], 1096, 1105, 1113.
+\:\\{ext\_top}, \[1094], 1113.
+\:\\{exten}, \[1092], 1094, \[1096], 1140.
+\:\9{extensible\_}{\&{extensible} primitive}, \[1101].
+\:\\{extensible\_code}, \[1101], 1102, 1106.
+\:\\{extensible\_recipe}, 1089, \[1094].
+\:{extensions to \MF}, 2.
+\:\.{Extra `endfor'}, 708.
+\:\.{Extra `endgroup'}, 1017.
+\:\.{Extra else}, 751.
+\:\.{Extra elseif}, 751.
+\:\.{Extra fi}, 751.
+\:\.{Extra tokens will be flushed}, 991.
+\:\\{extra\_space}, 1095.
+\:\\{extra\_space\_code}, \[1095].
+\:\\{extras}, 362, \[363].
+\:\|{f}, \[26], \[27], \[30], \[107], \[109], \[112], \[114], \[398], \[594], %
+\[667], \[780], \[1165].
+\:\\{false}, 26, 30, 36, 45, 47, 51, 71, 75, 83, 84, 93, 98, 99, 107, 110, 114,
+124, 126, 179, 180, 181, 182, 254, 269, 270, 407, 426, 446, 452, 454, 455, 456,
+474, 497, 503, 505, 530, 564, 570, 573, 577, 592, 593, 600, 603, 604, 613, 626,
+653, 657, 661, 670, 672, 675, 680, 681, 692, 721, 728, 734, 750, 762, 767, 771,
+779, 783, 794, 801, 804, 817, 825, 869, 899, 902, 913, 924, 944, 945, 977, 978,
+997, 998, 1003, 1009, 1010, 1011, 1015, 1035, 1045, 1054, 1064, 1072, 1085,
+1086, 1097, 1107, 1137, 1138, 1187.
+\:\9{false\_}{\&{false} primitive}, \[893].
+\:\\{false\_code}, \[189], 798, 892, 893, 895, 905, 906, 918, 919, 920, 937,
+940.
+\:\\{fast\_case\_down}, \[378], 380.
+\:\\{fast\_case\_up}, \[378], 380.
+\:\\{fast\_get\_avail}, \[165], 381, 382, 383, 384, 651, 844.
+\:\.{Fatal base file error}, 1187.
+\:\\{fatal\_error}, 66, \[88], 679, 714, 786, 789, 897.
+\:\\{fatal\_error\_stop}, \[71], 72, 77, 88, 1204.
+\:\\{ff}, \[286], 287, 289, 290, 295, \[296], 302.
+\:\9{fi\_}{\&{fi} primitive}, \[740].
+\:\\{fi\_code}, \[738], 740, 741, 742, 748, 749, 751.
+\:\\{fi\_or\_else}, \[186], 706, 707, 738, 740, 741, 742, 751, 1209.
+\:\\{fifth\_octant}, \[139], 141, 380, 387, 388, 390, 396, 426, 443, 449, 461,
+462.
+\:\.{File ended while scanning...}, 663.
+\:\.{File names can't...}, 795.
+\:\\{file\_name\_size}, \[11], 25, 774, 777, 778, 780.
+\:\\{file\_offset}, \[54], 55, 57, 58, 62, 333, 372, 793, 1048, 1165.
+\:\\{file\_ptr}, 79, 80, \[634], 635, 636, 637.
+\:\\{file\_state}, \[632], 635, 636, 656, 667, 714, 795.
+\:\\{fill\_envelope}, 481, \[506], 518, 1064.
+\:\\{fill\_spec}, \[465], 506, 511, 1064.
+\:\\{fillin}, \[190], 192, 193, 525, 533.
+\:\9{fillin\_}{\&{fillin} primitive}, \[192].
+\:\\{fin\_numeric\_token}, \[667], 669, 673.
+\:\\{fin\_offset\_prep}, \[497], 503, 504, 505.
+\:\\{final\_cleanup}, 1204, \[1209].
+\:\\{final\_end}, \[6], 34, 657, 1204, 1211.
+\:\\{final\_node}, \[610], 612, 615.
+\:\\{final\_value}, \[752], 761, 765.
+\:\\{find\_direction\_time}, \[539], 540, 984.
+\:\\{find\_edges\_var}, \[1057], 1061, 1064, 1070, 1071, 1074.
+\:\\{find\_offset}, \[488], 984.
+\:\\{find\_point}, 983, \[985].
+\:\\{find\_variable}, \[242], 700, 852, 1000, 1015, 1057.
+\:\\{finish\_path}, \[868], 869, 874.
+\:\\{firm\_up\_the\_line}, 666, 681, \[682], 794.
+\:\\{first}, \[29], 30, 34, 35, 36, 66, 78, 82, 83, 654, 655, 657, 679, 681,
+682, 717, 787, 794.
+\:\\{first\_count}, \[54], 641, 642, 643.
+\:\\{first\_octant}, \[139], 141, 378, 379, 380, 387, 388, 390, 395, 396, 406,
+407, 409, 411, 426, 435, 443, 448, 449, 461, 462, 473, 480, 484, 488, 489.
+\:\\{first\_text\_char}, \[19], 23.
+\:\\{first\_x}, \[406], 407, \[440], 444, 445.
+\:\\{first\_y}, \[406], 407, \[440], 444, 445.
+\:\\{fix\_check\_sum}, \[1131], 1206.
+\:\\{fix\_date\_and\_time}, \[194], 1204, 1211.
+\:\\{fix\_dependencies}, \[604], 610, 815, 935, 968, 971.
+\:\\{fix\_design\_size}, \[1128], 1206.
+\:\\{fix\_needed}, \[592], 593, 595, 596, 598, 599, 600, 604, 610, 815, 932,
+935, 968, 971.
+\:\\{fix\_offset}, \[328], 329, 965.
+\:\\{fix\_word}, \[1089], 1090, 1095, 1129, 1147.
+\:\9{floor\_}{\&{floor} primitive}, \[893].
+\:\\{floor\_op}, \[189], 893, 906.
+\:\\{floor\_scaled}, \[119], 516, 522, 906.
+\:\\{floor\_unscaled}, \[119], 306, 463, 513, 515, 516, 519, 521, 522, 1074.
+\:\\{flush\_below\_variable}, 246, \[247], 249.
+\:\\{flush\_cur\_exp}, 717, \[808], 820, 872, 907, 913, 915, 917, 918, 919,
+920, 921, 935, 936, 938, 956, 962, 982, 984, 993, 1040, 1061, 1063, 1070, 1072,
+1082, 1177.
+\:\\{flush\_error}, \[820], 849, 1017.
+\:\\{flush\_list}, \[177], 385, 700, 736, 1015.
+\:\\{flush\_node\_list}, \[177], 685, 811, 815, 852, 996, 1009, 1057.
+\:\\{flush\_p}, \[621].
+\:\\{flush\_string}, \[43], 210, 793, 1200.
+\:\\{flush\_token\_list}, \[216], 224, 226, 235, 650, 698, 763, 840, 1062,
+1071, 1074.
+\:\\{flush\_variable}, \[246], 700, 1015.
+\:\\{flushing}, \[659], 664, 665, 991, 1016.
+\:\.{font metric dimensions...}, 1140.
+\:{font metric files}, 1087.
+\:\.{Font metrics written...}, 1134.
+\:\9{font\_dimen\_}{\&{fontdimen} primitive}, \[1101].
+\:\\{font\_dimen\_code}, \[1101], 1106.
+\:\\{fontmaking}, \[190], 192, 193, 1206.
+\:\9{fontmaking\_}{\&{fontmaking} primitive}, \[192].
+\:\9{for\_}{\&{for} primitive}, \[683].
+\:\9{for\_suffixes\_}{\&{forsuffixes} primitive}, \[683].
+\:\.{Forbidden token found...}, 663.
+\:\\{force\_eof}, 657, \[680], 681, 711.
+\:\9{forever\_}{\&{forever} primitive}, \[683].
+\:\\{forever\_text}, \[632], 638, 714, 760.
+\:\\{forty\_five\_deg}, \[106], 145.
+\:\\{forward}, 73, 216, 217, 224, 225, 666, 706, 820, 995, 1034.
+\:\\{found}, \[15], 167, 170, 171, 205, 206, 207, 235, 236, 284, 291, 292, 295,
+477, 527, 532, 539, 541, 543, 544, 547, 548, 577, 582, 667, 669, 685, 686, 720,
+726, 748, 755, 779, 1103, 1117.
+\:\\{found1}, \[15].
+\:\\{found2}, \[15].
+\:\\{four\_quarters}, \[156], 1096, 1133, 1186, 1187.
+\:\\{fourth\_octant}, \[139], 141, 380, 387, 388, 390, 393, 396, 426, 435, 443,
+449, 461, 462, 472.
+\:\\{frac\_mult}, 837, \[944].
+\:\\{fraction}, \[105], 107, 109, 114, 116, 119, 124, 126, 144, 145, 148, 149,
+150, 187, 259, 280, 283, 286, 296, 298, 299, 391, 406, 410, 419, 433, 440, 493,
+495, 497, 542, 585, 587, 591, 592, 594, 599, 612, 932, 944.
+\:\\{fraction\_four}, \[105], 111, 113, 116, 121, 123, 125, 126, 127, 132, 133,
+296, 1116.
+\:\\{fraction\_half}, \[105], 111, 152, 288, 408, 496, 543, 1098, 1128, 1140.
+\:\\{fraction\_one}, \[105], 107, 108, 109, 142, 145, 148, 149, 150, 285, 288,
+290, 291, 295, 300, 311, 391, 392, 402, 407, 411, 413, 415, 420, 424, 436, 439,
+444, 457, 477, 478, 497, 499, 503, 530, 540, 547, 549, 599, 603, 612, 615, 816,
+917, 1169, 1170.
+\:\\{fraction\_three}, \[105], 116, 288, 296.
+\:\\{fraction\_threshold}, \[594], 597.
+\:\\{fraction\_two}, \[105], 116, 121, 124, 142.
+\:\\{free}, \[178], 180, 181, 182, 183, 184.
+\:\\{free\_avail}, \[164], 177, 216, 254, 349, 360, 604, 760, 763, 852, 860.
+\:\\{free\_node}, \[172], 177, 216, 246, 247, 249, 254, 268, 352, 353, 354,
+358, 385, 405, 452, 487, 532, 537, 595, 598, 599, 600, 601, 603, 605, 612, 615,
+616, 650, 745, 763, 800, 808, 810, 818, 819, 827, 829, 837, 855, 858, 866, 890,
+903, 910, 922, 925, 942, 944, 947, 955, 970, 980, 1001, 1006, 1008, 1065, 1209.
+\:\9{from\_}{\&{from} primitive}, \[211].
+\:\\{from\_token}, \[186], 211, 212, 1073.
+\:\\{frozen\_bad\_vardef}, \[201], 203, 702.
+\:\\{frozen\_colon}, \[201], 203, 211, 751.
+\:\\{frozen\_end\_def}, \[201], 203, 664, 683.
+\:\\{frozen\_end\_for}, \[201], 203, 664, 683.
+\:\\{frozen\_end\_group}, \[201], 203, 211, 664, 698.
+\:\\{frozen\_fi}, \[201], 203, 661, 740.
+\:\\{frozen\_inaccessible}, \[201], 203, 691, 1196, 1197, 1199.
+\:\\{frozen\_left\_bracket}, \[201], 203, 211, 847.
+\:\\{frozen\_repeat\_loop}, \[201], 757, 758, 759.
+\:\\{frozen\_right\_delimiter}, \[201], 203, 664.
+\:\\{frozen\_semicolon}, \[201], 203, 211, 664.
+\:\\{frozen\_slash}, \[201], 203, 837, 893.
+\:\\{frozen\_undefined}, \[201], 249.
+\:{Fuchs, David Raymond}, 2, 1148.
+\:\\{future\_pen}, \[187], 216, 248, 798, 802, 804, 808, 809, 855, 864, 865,
+896, 918, 919, 921, 952, 962, 983.
+\:\|{g}, \[47].
+\:\\{g\_pointer}, 216, 219, 224, \[225], 1042.
+\:\\{gamma}, \[296], \[527], 528, 529, 530.
+\:\\{general\_macro}, \[226], 227, 694, 697, 725.
+\:\\{get}, 25, 28, 30, 32, 794, 1189.
+\:\\{get\_avail}, \[163], 165, 235, 236, 250, 335, 350, 362, 375, 376, 605,
+662, 694, 697, 698, 704, 728, 734, 758, 764, 841, 845, 853, 854, 860, 863, 1011.
+\:\\{get\_boolean}, 706, 713, 748, \[892].
+\:\\{get\_clear\_symbol}, \[692], 694, 700, 1031, 1036.
+\:\\{get\_code}, \[1103], 1106, 1107, 1110, 1112, 1113, 1114.
+\:\\{get\_next}, 71, 73, 83, 624, 658, 659, 666, \[667], 676, 679, 685, 690,
+691, 694, 700, 703, 704, 705, 706, 715, 718, 720, 730, 742, 781, 991, 1016,
+1044, 1049.
+\:\\{get\_node}, \[167], 173, 215, 232, 233, 234, 239, 240, 241, 244, 245, 252,
+253, 264, 265, 266, 330, 331, 334, 341, 355, 364, 410, 451, 476, 477, 481, 486,
+528, 535, 536, 537, 596, 597, 607, 608, 609, 619, 651, 694, 704, 705, 744, 755,
+765, 799, 830, 856, 857, 871, 895, 896, 931, 964, 982, 1117.
+\:\\{get\_pair}, \[1072], 1073, 1074.
+\:\\{get\_strings\_started}, \[47], 51, 1204.
+\:\\{get\_symbol}, \[691], 692, 694, 704, 705, 755, 757, 1011, 1029, 1033,
+1035, 1076.
+\:\\{get\_x\_next}, 694, 697, 706, 707, 716, \[718], 726, 729, 733, 734, 735,
+748, 751, 752, 755, 764, 765, 799, 800, 820, 823, 824, 825, 826, 830, 835, 837,
+839, 840, 841, 844, 846, 850, 851, 853, 854, 859, 860, 861, 862, 864, 868, 874,
+875, 876, 878, 881, 882, 884, 886, 892, 989, 990, 995, 996, 1011, 1012, 1021,
+1023, 1029, 1031, 1033, 1034, 1035, 1036, 1040, 1044, 1045, 1049, 1050, 1054,
+1059, 1070, 1071, 1072, 1073, 1074, 1076, 1082, 1103, 1106, 1107, 1112, 1115,
+1177.
+\:\\{gf\_boc}, \[1161], 1162, 1168, 1172.
+\:\\{gf\_buf}, 1151, \[1152], 1154, 1155.
+\:\\{gf\_buf\_size}, \[11], 14, 1151, 1152, 1153, 1155, 1156, 1182.
+\:\\{gf\_dx}, 1099, \[1149], 1182.
+\:\\{gf\_dy}, 1099, \[1149], 1182.
+\:\\{gf\_ext}, \[785], 791, 1164.
+\:\\{gf\_file}, \[791], 1149, 1151, 1154, 1182.
+\:\\{gf\_four}, \[1157], 1161, 1166, 1177, 1182.
+\:\\{gf\_id\_byte}, \[1144], 1163, 1182.
+\:\\{gf\_index}, \[1151], 1152, 1154.
+\:\\{gf\_limit}, 1151, \[1152], 1153, 1155, 1156.
+\:\\{gf\_max\_m}, \[1149], 1163, 1168, 1169, 1182.
+\:\\{gf\_max\_n}, \[1149], 1161, 1163, 1182.
+\:\\{gf\_min\_m}, \[1149], 1161, 1163, 1182.
+\:\\{gf\_min\_n}, \[1149], 1163, 1167, 1168, 1182.
+\:\\{gf\_offset}, 1151, \[1152], 1153, 1155, 1163, 1165, 1182.
+\:\\{gf\_out}, \[1155], 1157, 1158, 1159, 1160, 1161, 1163, 1165, 1166, 1173,
+1174, 1177, 1182.
+\:\\{gf\_paint}, \[1159], 1170, 1171, 1172.
+\:\\{gf\_prev\_ptr}, \[1149], 1150, 1163, 1165, 1182, 1206.
+\:\\{gf\_ptr}, 1151, \[1152], 1153, 1155, 1156, 1163, 1165, 1182.
+\:\\{gf\_string}, \[1160], 1163, 1166, 1177, 1179.
+\:\\{gf\_swap}, \[1155].
+\:\\{gf\_three}, \[1158], 1160.
+\:\\{gf\_two}, \[1158], 1159, 1174.
+\:\\{given}, \[256], 258, 259, 273, 282, 284, 285, 875, 877, 888, 889.
+\:\\{good\_val}, \[431], 432, 435, 438, 442.
+\:\&{goto}, \[34], \[76].
+\:\\{granularity}, \[190], 192, 193, 430, 433.
+\:\9{granularity\_}{\&{granularity} primitive}, \[192].
+\:\\{greater\_or\_equal}, \[189], 893, 936, 937.
+\:\\{greater\_than}, \[189], 893, 936, 937.
+\:\\{group\_line}, \[831], 832.
+\:\&{gubed}, \[7].
+\:{Guibas, Leonidas Ioannis}, 2, 469.
+\:\|{h}, \[205], \[257], \[269], \[326], \[334], \[344], \[346], \[366], %
+\[369], \[385], \[402], \[465], \[473], \[477], \[484], \[488], \[491], \[506],
+\[518], \[527], \[539], \[562], \[860], \[1011].
+\:\\{half}, \[96], 102, 111, 113, 121, 126, 133, 142, 150, 232, 313, 314, 317,
+392, 432, 442, 445, 556, 559, 561, 596, 866, 939, 1122.
+\:\\{half\_buf}, 1151, \[1152], 1153, 1155, 1156.
+\:\\{half\_error\_line}, \[11], 14, 635, 641, 642, 643.
+\:\\{half\_fraction\_threshold}, \[594], 599, 600, 612, 616.
+\:\\{half\_scaled\_threshold}, \[594], 599, 600.
+\:\\{half\_unit}, \[101], 113, 119, 374, 402, 462, 463, 468, 477, 478, 512,
+515, 518, 521, 528, 530, 533, 917, 1106.
+\:\\{halfword}, 153, \[156], 158, 172, 210, 246, 253, 284, 329, 346, 366, 491,
+497, 624, 627, 697, 755, 862, 864, 868, 1029, 1077, 1104.
+\:\\{hard\_times}, 941, \[946].
+\:\\{hash}, 200, \[201], 202, 205, 207, 625, 658, 1196, 1197.
+\:\\{hash\_base}, \[200], 201, 205.
+\:\\{hash\_end}, \[201], 202, 204, 209, 214, 229, 250, 253, 254, 699, 841, 996,
+998, 999, 1049, 1196, 1197, 1199.
+\:\\{hash\_is\_full}, \[200], 207.
+\:\\{hash\_prime}, \[12], 14, 205, 208, 1190, 1191.
+\:\\{hash\_size}, \[12], 14, 201, 207, 208, 1190, 1191, 1208.
+\:\\{hash\_top}, \[201].
+\:\\{hash\_used}, \[200], 203, 207, 1196, 1197.
+\:\\{header}, 1090.
+\:\\{header\_byte}, \[1096], 1097, 1106, 1114, 1128, 1131, 1135, 1182.
+\:\9{header\_byte\_}{\&{headerbyte} primitive}, \[1101].
+\:\\{header\_byte\_code}, \[1101], 1102, 1106.
+\:\\{header\_size}, \[11], 14, 1096, 1097, 1114, 1135.
+\:{Hedrick, Charles Locke}, 3.
+\:\\{height\_index}, \[1091].
+\:\\{help\_line}, \[74], 84, 86, 661, 664, 691, 852, 1016, 1055.
+\:\\{help\_ptr}, \[74], 75, 84, 86.
+\:\\{help0}, \[74], 1051.
+\:\\{help1}, \[74], 88, 90, 703, 713, 734, 751, 838, 839, 876, 881, 883, 914,
+937, 1021, 1034, 1051, 1056, 1071, 1074, 1082, 1086, 1098, 1106, 1107, 1110,
+1113, 1115, 1178.
+\:\\{help2}, 67, \[74], 83, 84, 89, 90, 122, 128, 134, 140, 270, 478, 623, 670,
+675, 701, 708, 712, 713, 716, 727, 735, 747, 765, 832, 865, 878, 892, 937, 950,
+996, 999, 1002, 1004, 1008, 1015, 1017, 1021, 1032, 1055, 1057, 1061, 1062,
+1067, 1073, 1103, 1105, 1106, 1112.
+\:\\{help3}, 67, \[74], 93, 340, 342, 478, 661, 672, 691, 725, 726, 727, 755,
+756, 795, 849, 859, 861, 875, 887, 901, 923, 955, 960, 963, 965, 993, 1032,
+1035, 1068.
+\:\\{help4}, \[74], 84, 99, 404, 602, 663, 754, 824, 830, 1060, 1086.
+\:\\{help5}, \[74], 693, 851, 872, 873, 878, 990, 1016.
+\:\\{help6}, \[74], 991.
+\:\.{Here is how much...}, 1208.
+\:\9{hex\_}{\&{hex} primitive}, \[893].
+\:\\{hex\_op}, \[189], 893, 912.
+\:\\{hh}, 153, \[156], 157, 161, 214, 250, 255, \[334], \[477], 479, \[562],
+563, 1188, 1189.
+\:\\{hi\_mem\_min}, \[159], 161, 163, 167, 168, 176, 177, 178, 180, 181, 184,
+185, 216, 218, 242, 676, 850, 1045, 1194, 1195, 1207, 1208.
+\:\\{hi\_mem\_stat\_min}, \[175], 176, 1195.
+\:\\{history}, \[71], 72, 77, 88, 90, 195, 1204, 1209.
+\:\\{hlp1}, \[74].
+\:\\{hlp2}, \[74].
+\:\\{hlp3}, \[74].
+\:\\{hlp4}, \[74].
+\:\\{hlp5}, \[74].
+\:\\{hlp6}, \[74].
+\:\\{ho}, \[155], 324, 333, 343, 344, 349, 352, 358, 359, 360, 370, 373, 582,
+1169.
+\:{Hobby, John Douglas}, 274, 354, 432, 524.
+\:\\{hold\_head}, \[175], 665, 685, 697, 730.
+\:\\{hppp}, \[190], 192, 193, 785, \[1146], 1164, 1182.
+\:\9{hppp\_}{\&{hppp} primitive}, \[192].
+\:\\{htap\_ypoc}, \[266], 921, 978, 1064, 1065.
+\:\|{i}, \[19], \[150], \[641].
+\:\.{I can't find file x}, 786.
+\:\.{I can't find PLAIN...}, 779.
+\:\.{I can't go on...}, 90.
+\:\.{I can't read MF.POOL}, 51.
+\:\.{I can't write on file x}, 786.
+\:\\{id\_lookup}, \[205], 210, 669.
+\:\\{id\_transform}, \[233], 955.
+\:\9{if\_}{\&{if} primitive}, \[740].
+\:\\{if\_code}, \[738], 740, 741, 744, 751.
+\:\\{if\_limit}, \[738], 739, 744, 745, 746, 748, 751.
+\:\\{if\_line}, \[738], 739, 744, 745, 748, 1209.
+\:\\{if\_line\_field}, \[738], 744, 745, 1209.
+\:\\{if\_node\_size}, \[738], 744, 745, 1209.
+\:\\{if\_test}, \[186], 706, 707, 740, 741, 742, 748.
+\:\.{illegal design size...}, 1128.
+\:\.{Illegal ligtable step}, 1107.
+\:\.{Illegal suffix...flushed}, 1016.
+\:\.{IMPOSSIBLE}, 218.
+\:\.{Improper `:='}, 996.
+\:\.{Improper `addto'}, 1061, 1062.
+\:\.{Improper `openwindow'}, 1073.
+\:\.{Improper curl}, 876.
+\:\.{Improper font parameter}, 1115.
+\:\.{Improper kern}, 1112.
+\:\.{Improper location}, 1106.
+\:\.{Improper subscript...}, 849.
+\:\.{Improper tension}, 883.
+\:\.{Improper transformation argument}, 955.
+\:\.{Improper type}, 1055.
+\:\.{Improper...replaced by 0}, 754.
+\:\\{in\_open}, \[631], 654, 655, 657.
+\:\\{in\_state\_record}, \[627], 628.
+\:\\{in\_window}, \[186], 211, 212, 1071.
+\:\9{in\_window\_}{\&{inwindow} primitive}, \[211].
+\:\.{Incomplete if...}, 661.
+\:\.{Incomplete string token...}, 672.
+\:\.{Inconsistent equation}, 1004, 1008.
+\:\\{incr}, \[16], 30, 36, 41, 42, 44, 45, 46, 53, 58, 59, 60, 64, 66, 77, 85,
+86, 93, 108, 115, 123, 136, 143, 147, 163, 165, 183, 207, 226, 281, 284, 297,
+314, 315, 317, 319, 320, 321, 322, 333, 348, 352, 362, 364, 366, 375, 376, 377,
+381, 382, 383, 384, 404, 429, 458, 459, 481, 483, 487, 497, 502, 514, 515, 516,
+520, 521, 522, 560, 568, 574, 577, 583, 584, 647, 654, 669, 671, 673, 674, 681,
+687, 704, 705, 717, 721, 724, 728, 731, 732, 734, 736, 737, 742, 772, 774, 779,
+781, 787, 793, 1036, 1104, 1107, 1112, 1113, 1114, 1115, 1118, 1121, 1129,
+1137, 1138, 1140, 1155, 1165, 1196, 1211.
+\:\\{independent}, \[187], 216, 219, 232, 248, 585, 589, 592, 604, 615, 798,
+799, 800, 801, 802, 803, 808, 809, 816, 827, 828, 855, 857, 858, 903, 918, 925,
+926, 927, 928, 944, 1003, 1006, 1007, 1009.
+\:\\{independent\_being\_fixed}, \[605].
+\:\\{independent\_needing\_fix}, \[592], 595, 596, 598, 599, 600.
+\:\\{index}, 627, \[629], 630, 631, 632, 654, 655, 657.
+\:\\{index\_field}, \[627], 629.
+\:\\{inf\_val}, \[175], 617, 1116, 1117, 1118, 1121, 1136.
+\:\\{info}, \[161], 166, 168, 176, 185, 214, 218, 221, 226, 227, 228, 229, 235,
+236, 242, 245, 246, 250, 252, 253, 254, 324, 325, 326, 328, 333, 335, 337, 338,
+339, 342, 343, 344, 345, 346, 347, 349, 350, 351, 358, 359, 360, 362, 366, 367,
+368, 370, 373, 375, 376, 378, 381, 382, 383, 384, 472, 473, 475, 481, 484, 488,
+491, 509, 512, 519, 580, 582, 587, 589, 591, 594, 595, 596, 597, 598, 599, 600,
+601, 604, 605, 607, 608, 609, 610, 611, 612, 614, 615, 616, 617, 651, 662, 676,
+685, 686, 694, 697, 698, 700, 704, 705, 714, 719, 721, 722, 725, 726, 727, 728,
+729, 733, 734, 736, 752, 755, 758, 760, 763, 764, 805, 811, 812, 816, 818, 819,
+841, 850, 853, 854, 860, 863, 904, 931, 933, 935, 968, 996, 998, 999, 1006,
+1007, 1010, 1011, 1015, 1050, 1121, 1122, 1127, 1136, 1169, 1207, 1213.
+\:\.{INIMF}, 8, 11, 12, 47, 50, 159, 1183, 1203.
+\:\&{init}, \[8], \[47], \[50], \[173], \[210], \[564], \[567], \[568], %
+\[1186], \[1204], \[1209], \[1210].
+\:\\{init\_big\_node}, \[232], 233, 830, 857, 982.
+\:\\{init\_edges}, \[326], 353, 364, 895, 964.
+\:\\{init\_gf}, \[1163].
+\:\\{init\_pool\_ptr}, \[38], 41, 1045, 1193, 1204, 1208.
+\:\\{init\_prim}, 1204, \[1210].
+\:\\{init\_randoms}, \[150], 1022, 1211.
+\:\\{init\_screen}, \[564], 567, 568, 569, 570, 571.
+\:\\{init\_str\_ptr}, \[38], 44, 772, 1045, 1193, 1204, 1208.
+\:\\{init\_tab}, 1204, \[1210].
+\:\\{init\_terminal}, \[36], 657.
+\:\\{initialize}, \[4], 1204, 1211.
+\:{inner loop}, 30, 107, 108, 109, 111, 112, 113, 163, 165, 167, 169, 172, 177,
+242, 244, 408, 650, 651, 667, 668, 669, 676, 718, 850.
+\:\9{inner\_}{\&{inner} primitive}, \[1027].
+\:\\{input}, \[186], 706, 707, 709, 710.
+\:\9{input\_}{\&{input} primitive}, \[709].
+\:\\{input\_file}, \[631].
+\:\\{input\_ln}, 29, \[30], 36, 58, 66, 681, 794.
+\:\\{input\_ptr}, \[628], 635, 636, 647, 648, 656, 657, 679, 788, 1209.
+\:\\{input\_stack}, 79, \[628], 635, 647, 648, 788.
+\:\\{ins\_error}, \[653], 661, 663, 691, 751, 824.
+\:\.{insert>}, 82.
+\:\\{inserted}, \[632], 638, 650, 653.
+\:\\{install}, 857, \[858], 957, 959.
+\:\\{int}, 153, \[156], 157, 214, 326, 435, 738, 1188, 1189, 1191.
+\:\\{int\_increment}, \[553], 559, 561.
+\:\\{int\_name}, \[190], 193, 254, 998, 999, 1036, 1043, 1098, 1123, 1198, 1199.
+\:\\{int\_packets}, \[553], 558, 560.
+\:\\{int\_ptr}, \[190], 191, 1036, 1198, 1199, 1208.
+\:\\{integer}, 13, 19, 45, 46, 47, 54, 59, 60, 64, 65, 77, 89, 91, 100, 101,
+102, 105, 106, 107, 109, 112, 114, 116, 117, 119, 121, 124, 126, 129, 130, 132,
+135, 139, 145, 152, 153, 156, 160, 167, 185, 200, 205, 217, 227, 242, 299, 308,
+309, 311, 321, 327, 328, 329, 332, 333, 337, 340, 342, 348, 354, 357, 363, 366,
+369, 371, 373, 374, 378, 391, 398, 402, 403, 453, 464, 473, 477, 484, 488, 495,
+497, 507, 511, 527, 555, 557, 562, 572, 574, 577, 580, 585, 589, 594, 597, 599,
+600, 601, 608, 610, 621, 624, 625, 626, 631, 633, 641, 651, 659, 667, 685, 707,
+720, 723, 730, 738, 742, 773, 774, 778, 788, 796, 801, 809, 813, 831, 895, 898,
+899, 900, 913, 922, 930, 943, 977, 1001, 1059, 1070, 1073, 1074, 1096, 1103,
+1106, 1118, 1119, 1120, 1121, 1129, 1130, 1131, 1133, 1149, 1152, 1157, 1158,
+1159, 1160, 1161, 1162, 1163, 1165, 1186, 1187, 1203, 1205, 1210, 1212.
+\:\\{interaction}, 66, 67, \[68], 69, 70, 77, 79, 81, 86, 87, 88, 93, 398, 679,
+682, 786, 807, 897, 1023, 1051, 1086, 1198, 1199, 1200, 1209.
+\:\\{interesting}, \[238], 603, 613, 817, 1050.
+\:\9{interim\_}{\&{interim} primitive}, \[211].
+\:\\{interim\_command}, \[186], 211, 212, 1033.
+\:\\{internal}, \[190], 191, 194, 195, 238, 253, 254, 269, 375, 376, 381, 382,
+383, 384, 402, 430, 433, 465, 468, 477, 506, 508, 510, 515, 517, 521, 523, 533,
+602, 603, 610, 682, 707, 713, 720, 728, 734, 748, 760, 790, 804, 816, 832, 841,
+895, 898, 922, 944, 992, 994, 995, 996, 999, 1036, 1051, 1064, 1068, 1070,
+1097, 1098, 1099, 1128, 1129, 1134, 1137, 1163, 1164, 1165, 1177, 1182, 1198,
+1199, 1200, 1205, 1206, 1211, 1213.
+\:\.{Internal quantity...}, 999.
+\:\\{internal\_quantity}, \[186], 192, 823, 844, 860, 1011, 1034, 1036, 1043.
+\:\\{interrupt}, \[91], 92, 93, 825.
+\:\.{Interruption}, 93.
+\:\\{intersect}, \[189], 893, 988.
+\:\9{intersection\_times\_}{\&{intersectiontimes} primitive}, \[893].
+\:\.{Invalid code...}, 1103.
+\:\\{invalid\_class}, \[198], 199, 669.
+\:\\{is\_empty}, \[166], 169, 182, 183.
+\:\.{Isolated expression}, 993.
+\:\\{isolated\_classes}, \[198], 223, 669.
+\:\\{italic\_index}, \[1091].
+\:\\{iteration}, \[186], 683, 684, 685, 706, 707, 758.
+\:\|{j}, \[45], \[46], \[59], \[60], \[77], \[150], \[205], \[210], \[357], %
+\[378], \[707], \[774], \[778], \[779], \[1106].
+\:\\{j\_random}, \[148], 149, 151, 152.
+\:{Japanese characters}, 1147.
+\:{Jensen, Kathleen}, 10.
+\:\\{jj}, \[150], \[357], 364.
+\:\.{job aborted}, 679.
+\:\.{job aborted, file error...}, 786.
+\:\\{job\_name}, 87, \[782], 783, 784, 788, 791, 793, 895, 1134, 1200, 1209.
+\:\9{job\_name\_}{\&{jobname} primitive}, \[893].
+\:\\{job\_name\_op}, \[189], 893, 895.
+\:\\{jump\_out}, \[76], 77, 79, 88.
+\:\|{k}, \[45], \[46], \[47], \[63], \[64], \[66], \[102], \[121], \[130], %
+\[132], \[135], \[139], \[145], \[149], \[150], \[205], \[210], \[264], \[280],
+\[284], \[299], \[321], \[346], \[363], \[366], \[378], \[402], \[426], \[440],
+\[473], \[477], \[484], \[487], \[491], \[497], \[511], \[568], \[574], \[577],
+\[667], \[682], \[697], \[707], \[774], \[778], \[780], \[786], \[788], \[895],
+\[913], \[976], \[977], \[978], \[1073], \[1106], \[1131], \[1154], \[1160], %
+\[1163], \[1186], \[1187], \[1205], \[1210], \[1212].
+\:\\{keep\_code}, \[1052], 1074.
+\:\\{keeping}, \[1074], 1075.
+\:\9{keeping\_}{\&{keeping} primitive}, \[1052].
+\:\\{kern}, 1093, \[1096], 1106, 1112, 1139.
+\:\9{kern\_}{\&{kern} primitive}, \[1108].
+\:\\{kern\_flag}, \[1093], 1112.
+\:\\{knil}, \[325], 326, 330, 331, 332, 334, 336, 341, 352, 354, 355, 364, 376,
+377, 382, 384, 442, 472, 473, 475, 476, 482, 483, 484, 497, 503, 505, 508, 509,
+513, 515, 517, 519, 521, 523, 1167.
+\:\\{knot\_node\_size}, \[255], 264, 265, 266, 268, 405, 410, 451, 452, 486,
+528, 532, 535, 536, 537, 866, 871, 890, 896, 980, 1065.
+\:\\{knots}, \[269], 271, 272.
+\:\\{known}, \[187], 214, 215, 216, 219, 233, 248, 585, 594, 603, 615, 651,
+678, 726, 760, 765, 798, 799, 802, 803, 808, 809, 823, 826, 827, 829, 830, 837,
+841, 846, 855, 857, 858, 861, 873, 876, 878, 883, 895, 899, 903, 906, 912, 915,
+918, 919, 930, 931, 932, 935, 937, 939, 941, 942, 943, 944, 948, 949, 951, 953,
+956, 957, 959, 960, 966, 968, 969, 970, 971, 972, 974, 982, 983, 999, 1003,
+1006, 1007, 1009, 1021, 1052, 1054, 1062, 1071, 1073, 1074, 1103, 1106, 1112,
+1115, 1176, 1177, 1180.
+\:\9{known\_}{\&{known} primitive}, \[893].
+\:\\{known\_op}, \[189], 893, 918, 919.
+\:\\{known\_pair}, 871, \[872], 877, 884.
+\:{Knuth, Donald Ervin}, 2, 81.
+\:\|{l}, \[46], \[47], \[152], \[205], \[210], \[217], \[227], \[311], \[641], %
+\[742], \[746], \[788], \[977], \[978], \[1006], \[1011], \[1035], \[1118], %
+\[1121], \[1160], \[1212].
+\:\\{l\_delim}, \[697], 703, \[720], 726, 727, 729, \[730], 731, 735, \[823],
+826, 830, \[1031], \[1032].
+\:\\{l\_packet}, 560.
+\:\\{l\_packets}, \[553], 559.
+\:\\{label\_char}, \[1096], 1104, 1137, 1138.
+\:\\{label\_loc}, \[1096], 1097, 1104, 1137, 1138, 1139.
+\:\\{label\_ptr}, \[1096], 1097, 1104, 1137, 1138, 1139.
+\:{Lane, Jeffrey Michael}, 303.
+\:\\{last}, \[29], 30, 34, 35, 36, 66, 78, 82, 83, 657, 679, 682, 779, 787, 897.
+\:\\{last\_nonblank}, \[30].
+\:\\{last\_text\_char}, \[19], 23.
+\:\\{last\_window}, \[326], 334, 577.
+\:\\{last\_window\_time}, \[326], 334, 336, 337, 340, 342, 344, 348, 364, 577,
+965.
+\:\\{left\_brace}, \[186], 211, 212, 874.
+\:\\{left\_bracket}, \[186], 211, 212, 823, 844, 847, 860, 1011, 1012.
+\:\\{left\_bracket\_class}, \[198], 199, 220, 221.
+\:\\{left\_col}, \[567], \[572], 574, 577, 581.
+\:\\{left\_curl}, \[256], 259, 263, 271, 282, 295, 879, 890, 891.
+\:\\{left\_delimiter}, \[186], 697, 703, 726, 731, 735, 823, 1030, 1031, 1043.
+\:\\{left\_given}, \[256], 259, 263, 282, 292, 301, 879, 880, 888.
+\:\\{left\_length}, \[528], 531, 532, 534, 535.
+\:\\{left\_octant}, \[393], 394, 398, 401, 451, 452, 458, 459, 465, 506.
+\:\\{left\_tension}, \[256], 258, 260, 288, 289, 294, 295, 299, 300, 302, 880.
+\:\\{left\_transition}, \[393], 459, 508.
+\:\\{left\_type}, \[255], 256, 257, 258, 259, 261, 262, 263, 265, 266, 269,
+271, 272, 273, 281, 282, 284, 285, 287, 299, 302, 393, 394, 397, 398, 399, 400,
+401, 402, 404, 410, 451, 452, 465, 486, 506, 528, 865, 870, 871, 879, 885, 887,
+888, 890, 891, 896, 916, 917, 920, 962, 978, 979, 985, 987, 1064, 1066.
+\:\\{left\_v}, \[528], 531, 534, 535.
+\:\\{left\_x}, \[255], 256, 261, 265, 266, 271, 282, 299, 302, 393, 397, 404,
+407, 409, 410, 411, 412, 415, 416, 418, 419, 421, 423, 424, 425, 434, 436, 441,
+444, 447, 451, 457, 468, 486, 492, 496, 512, 518, 528, 543, 558, 563, 866, 880,
+887, 896, 962, 987, 1066.
+\:\\{left\_y}, \[255], 256, 261, 265, 266, 271, 282, 299, 302, 393, 397, 404,
+409, 410, 413, 414, 415, 416, 419, 423, 424, 425, 437, 439, 444, 447, 451, 457,
+468, 486, 492, 496, 512, 518, 528, 543, 558, 563, 866, 880, 887, 896, 962, 987,
+1066.
+\:\\{length}, \[39], 46, 205, 671, 716, 717, 793, 912, 913, 915, 976, 977,
+1083, 1103, 1160.
+\:\9{length\_}{\&{length} primitive}, \[893].
+\:\\{length\_op}, \[189], 893, 915.
+\:\\{less\_or\_equal}, \[189], 893, 936, 937.
+\:\\{less\_than}, \[189], 893, 936, 937.
+\:\9{let\_}{\&{let} primitive}, \[211].
+\:\\{let\_command}, \[186], 211, 212, 1033.
+\:\\{letter\_class}, \[198], 199, 218, 223.
+\:\\{lf}, 1088.
+\:\\{lh}, 153, \[156], 157, 161, 200, \[491], 502, 505, 1088, 1089, 1135, %
+\[1205].
+\:\\{lhs}, \[995], \[996], 997, 998, 999, 1000, \[1001], 1002, 1003, \[1059],
+1061, 1062, 1064.
+\:\\{lig\_kern}, 1092, 1093, \[1096], 1137, 1139, 1205.
+\:\\{lig\_kern\_command}, 1089, \[1093].
+\:\\{lig\_kern\_token}, \[186], 1107, 1108, 1109.
+\:\9{lig\_table\_}{\&{ligtable} primitive}, \[1101].
+\:\\{lig\_table\_code}, \[1101], 1102, 1106.
+\:\\{lig\_table\_size}, \[11], 14, 1096, 1107, 1137, 1141.
+\:\\{lig\_tag}, \[1092], 1104, 1105, 1111.
+\:\\{limit}, 627, \[629], 630, 632, 644, 654, 656, 657, 669, 671, 672, 679,
+681, 682, 717, 793, 794, 1211.
+\:\\{limit\_field}, 34, 82, \[627], 629, 788.
+\:\\{line}, 79, 197, \[631], 637, 654, 655, 657, 681, 742, 744, 748, 794, 832.
+\:\\{line\_edges}, \[374], 378, 507, 510.
+\:\\{line\_stack}, \[631], 654, 655.
+\:\\{linear\_eq}, \[610], 1006.
+\:\\{link}, \[161], 163, 164, 165, 166, 167, 168, 172, 176, 177, 181, 185, 216,
+217, 227, 228, 229, 230, 232, 234, 235, 236, 237, 238, 239, 240, 241, 242, 244,
+245, 246, 247, 250, 252, 253, 254, 255, 257, 265, 266, 268, 271, 272, 273, 281,
+284, 297, 324, 325, 326, 328, 330, 331, 332, 334, 335, 336, 337, 338, 339, 341,
+343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, 355, 359, 360, 362,
+364, 366, 367, 368, 369, 370, 375, 376, 377, 381, 382, 383, 384, 385, 394, 398,
+399, 400, 401, 402, 404, 405, 406, 410, 411, 412, 413, 415, 416, 418, 419, 424,
+425, 433, 435, 436, 439, 440, 442, 444, 447, 450, 451, 452, 458, 459, 465, 466,
+468, 472, 473, 475, 476, 477, 479, 481, 482, 483, 484, 485, 487, 488, 491, 492,
+493, 497, 499, 502, 503, 504, 506, 508, 509, 512, 513, 515, 517, 518, 519, 521,
+523, 528, 532, 535, 536, 537, 539, 556, 558, 562, 577, 582, 587, 589, 591, 594,
+595, 596, 597, 598, 599, 600, 601, 603, 604, 605, 606, 608, 609, 611, 612, 614,
+616, 617, 639, 640, 650, 651, 665, 676, 678, 685, 686, 694, 697, 698, 700, 702,
+704, 705, 719, 720, 721, 722, 723, 724, 725, 727, 728, 730, 734, 736, 738, 744,
+745, 746, 752, 758, 760, 762, 763, 764, 799, 805, 811, 812, 814, 815, 816, 818,
+819, 827, 844, 845, 848, 850, 851, 852, 853, 854, 860, 863, 867, 870, 871, 885,
+887, 890, 891, 896, 904, 910, 916, 921, 931, 933, 947, 962, 968, 978, 980, 981,
+985, 986, 1007, 1010, 1011, 1015, 1043, 1047, 1050, 1065, 1068, 1117, 1118,
+1121, 1122, 1124, 1126, 1136, 1169, 1194, 1207, 1209, 1213.
+\:\\{list\_tag}, \[1092], 1105, 1106.
+\:\\{lk\_offset}, 1135, 1137, 1138, 1139, \[1205].
+\:\\{lk\_started}, \[1096], 1107, 1112, 1137, 1138, 1139.
+\:\\{ll}, \[1096], 1110, 1111, 1139.
+\:\\{llink}, \[166], 168, 169, 171, 172, 173, 176, 182, 1207.
+\:\\{lll}, \[1096], 1110, 1111.
+\:\\{lo\_mem\_max}, \[159], 163, 167, 168, 176, 178, 180, 182, 183, 184, 185,
+1045, 1194, 1195, 1207, 1208.
+\:\\{lo\_mem\_stat\_max}, \[175], 176, 1195, 1207.
+\:\\{load\_base\_file}, \[1187], 1211.
+\:\\{loc}, \[35], 36, 82, 627, \[629], 630, 632, 636, 638, 644, 645, 649, 652,
+654, 656, 657, 669, 671, 672, 673, 674, 676, 678, 679, 681, 712, 717, 736, 779,
+781, 793, 794, 795, 1211.
+\:\\{loc\_field}, 34, 35, \[627], 629.
+\:\.{local label l:: was missing}, 1139.
+\:\\{log\_file}, \[54], 56, 70, 788, 1205.
+\:\\{log\_name}, \[782], 788, 1205.
+\:\\{log\_only}, \[54], 57, 58, 62, 70, 93, 679, 788, 1022, 1200.
+\:\\{log\_opened}, 87, 88, \[782], 783, 788, 789, 1023, 1205, 1208.
+\:\.{Logarithm...replaced by 0}, 134.
+\:\\{long\_help\_seen}, \[1084], 1085, 1086.
+\:\&{loop}, 15, \[16].
+\:\.{loop confusion}, 714.
+\:\.{loop value=n}, 762.
+\:\\{loop\_defining}, \[659], 664, 665, 758.
+\:\\{loop\_list}, \[752], 760, 763, 764.
+\:\\{loop\_list\_loc}, \[752], 764.
+\:\\{loop\_node\_size}, \[752], 755, 763.
+\:\\{loop\_ptr}, 712, 713, 714, \[752], 753, 758, 760, 763, 1209.
+\:\\{loop\_repeat}, 685.
+\:\\{loop\_text}, \[632], 638, 714, 760.
+\:\\{loop\_type}, \[752], 755, 760, 763, 764, 765.
+\:\.{Lost loop}, 712.
+\:\\{ls}, \[46].
+\:\\{lt}, \[46], \[286], 289, 294, 295, \[299], 302.
+\:\|{m}, \[47], \[64], \[311], \[333], \[337], \[348], \[357], \[369], \[373], %
+\[473], \[484], \[511], \[574], \[580], \[608], \[625], \[626], \[641], \[694],
+\[697], \[755], \[788], \[913], \[1029], \[1082], \[1098], \[1118], \[1120], %
+\[1121], \[1123], \[1165], \[1177], \[1212].
+\:\\{m\_adjustment}, \[580], 581, 582.
+\:\\{m\_exp}, \[135], 906.
+\:\9{m\_exp\_}{\&{mexp} primitive}, \[893].
+\:\\{m\_exp\_op}, \[189], 893, 906.
+\:\\{m\_log}, \[132], 134, 152, 906.
+\:\9{m\_log\_}{\&{mlog} primitive}, \[893].
+\:\\{m\_log\_op}, \[189], 893, 906.
+\:\\{m\_magic}, \[354], 361, 362, 365.
+\:\\{m\_max}, \[326], 329, 334, 337, 342, 348, 352, 354, 356, 357, 364, 366,
+965, 1172.
+\:\\{m\_min}, \[326], 329, 334, 337, 342, 348, 352, 354, 356, 357, 364, 365,
+366, 965, 1172.
+\:\\{m\_offset}, \[326], 328, 329, 333, 334, 337, 342, 348, 352, 364, 365, 366,
+367, 373, 375, 376, 381, 382, 383, 384, 581, 965, 1169, 1172.
+\:\\{m\_spread}, 356, \[357], 364.
+\:\\{m\_window}, \[572], 576, 581.
+\:\\{mac\_name}, \[862], \[864], \[868].
+\:\\{macro}, \[632], 638, 645, 649, 736.
+\:\\{macro\_at}, \[688], 689.
+\:\\{macro\_call}, 707, 718, 719, \[720], 853, 854, 863.
+\:\\{macro\_def}, \[186], 683, 684, 685, 694, 698, 992, 1043.
+\:\\{macro\_name}, \[720], 721, 725, 726, 734, 736.
+\:\\{macro\_prefix}, \[688], 689.
+\:\\{macro\_ref}, \[843], 845, 854.
+\:\\{macro\_special}, \[186], 685, 688, 689, 700.
+\:\\{macro\_suffix}, \[688], 689, 700.
+\:\\{main\_control}, \[1017], 1204, 1211.
+\:\\{major\_axis}, \[527], 530, 533, \[865], 866.
+\:\\{make\_choices}, \[269], 274, 277, 278, 891.
+\:\\{make\_ellipse}, \[527], 528, 866.
+\:\\{make\_eq}, 995, 1000, \[1001].
+\:\\{make\_exp\_copy}, 651, 823, 852, \[855], 859, 903, 910, 926, 927, 944,
+967, 970, 973, 1000.
+\:\\{make\_fraction}, \[107], 109, 116, 125, 127, 145, 152, 281, 288, 289, 290,
+291, 294, 295, 296, 300, 302, 375, 376, 436, 439, 444, 454, 498, 516, 522, 530,
+533, 540, 548, 549, 612, 818, 944.
+\:\\{make\_known}, \[603], 604, 614, 818, 819.
+\:\\{make\_moves}, 309, \[311], 321, 468, 512, 514, 518, 550.
+\:\\{make\_name\_string}, \[780].
+\:\\{make\_op\_def}, \[694], 992.
+\:\\{make\_path}, \[484], 921, 962.
+\:\9{make\_path\_}{\&{makepath} primitive}, \[893].
+\:\\{make\_path\_op}, \[189], 893, 921.
+\:\\{make\_pen}, \[477], 865.
+\:\9{make\_pen\_}{\&{makepen} primitive}, \[893].
+\:\\{make\_pen\_op}, \[189], 893, 921.
+\:\\{make\_safe}, \[426], 427, 436, 439, 440, 446.
+\:\\{make\_scaled}, \[114], 116, 600, 612, 819, 837, 948, 949, 980, 1128, 1129,
+1164, 1182.
+\:\\{make\_spec}, \[402], 403, 409, 448, 460, 493, 917, 1064.
+\:\\{make\_string}, \[44], 48, 52, 207, 671, 772, 780, 840, 897, 912, 976, 977,
+1164, 1200, 1205.
+\:{Marple, Jane}, 1086.
+\:\\{materialize\_pen}, 864, \[865], 921, 983.
+\:\\{max}, \[539], 543.
+\:\\{max\_allowed}, 402, \[403], 404, 434, 437.
+\:\\{max\_buf\_stack}, \[29], 30, 657, 717, 1208.
+\:\\{max\_c}, 812, \[813], 814, 815, 816, 817.
+\:\\{max\_class}, \[198].
+\:\\{max\_coef}, \[495], 496, \[591], 932, 943, 949.
+\:\\{max\_command\_code}, \[186], 821, 823, 824, 868.
+\:\\{max\_d}, \[348], 351, 352.
+\:\\{max\_expression\_command}, \[186], 868.
+\:\\{max\_font\_dimen}, \[11], 1096, 1115, 1141.
+\:\\{max\_given\_internal}, \[190], 191, 1199.
+\:\\{max\_halfword}, 11, 12, 14, \[153], 154, 156, 166, 167, 168, 173, 174,
+204, 214, 324, 348, 351, 358, 1207.
+\:\\{max\_in\_open}, \[12], 631, 632, 654, 1190, 1191.
+\:\\{max\_in\_stack}, \[628], 647, 657, 1208.
+\:\\{max\_internal}, \[11], 190, 204, 1036, 1199, 1208.
+\:\\{max\_kerns}, \[11], 1096, 1106, 1112, 1141.
+\:\\{max\_link}, 812, \[813], 814, 815, 818, 819.
+\:\\{max\_m}, 1144, \[1146], \[1161].
+\:\\{max\_n}, \[348], 351, 352, 1144, \[1146], \[1161].
+\:\\{max\_new\_row}, \[1145], 1173.
+\:\\{max\_offset}, \[472], 475, 477, 962, 1064.
+\:\\{max\_param\_stack}, \[633], 657, 736, 737, 1208.
+\:\\{max\_patience}, \[555], 556.
+\:\\{max\_pool\_ptr}, \[38], 41, 47, 1045, 1193, 1204, 1208.
+\:\\{max\_primary\_command}, \[186], 823, 836, 862, 864, 868, 989, 990.
+\:\\{max\_print\_line}, \[11], 14, 54, 58, 61, 67, 333, 372, 793, 1046, 1048,
+1165.
+\:\\{max\_ptr}, \[813], 814, 815, 816.
+\:\\{max\_quarterword}, \[153], 154, 156, 399, 404, 481.
+\:\\{max\_rounding\_ptr}, \[427], 428, 429, 1208.
+\:\\{max\_secondary\_command}, \[186], 862.
+\:\\{max\_selector}, \[54], 196, 635, 788.
+\:\\{max\_statement\_command}, \[186], 989.
+\:\\{max\_str\_ptr}, \[38], 44, 47, 772, 1045, 1193, 1204, 1208.
+\:\\{max\_str\_ref}, \[42], 43, 48, 52, 207, 793, 1193, 1200.
+\:\\{max\_strings}, \[11], 37, 44, 154, 772, 780, 1045, 1193, 1208.
+\:\\{max\_suffix\_token}, \[186], 844.
+\:\\{max\_t}, \[555], 556.
+\:\\{max\_tertiary\_command}, \[186], 864.
+\:\\{max\_tfm\_dimen}, 1128, 1129, \[1130], 1182.
+\:\\{max\_wiggle}, \[11], 426, 427, 429, 440, 1208.
+\:\\{mc}, \[477], 478, 479.
+\:{Meggitt, John E.}, 143.
+\:\\{mem}, 11, 12, 158, \[159], 161, 166, 168, 173, 175, 176, 178, 180, 185,
+214, 216, 229, 241, 242, 244, 250, 255, 264, 326, 334, 435, 472, 475, 587, 594,
+738, 752, 827, 947, 961, 1194, 1195, 1213.
+\:\\{mem\_end}, 159, \[161], 163, 176, 178, 180, 181, 184, 185, 218, 1194,
+1195, 1208.
+\:\\{mem\_max}, \[11], 12, 14, 153, 154, 159, 163, 166, 167, 178, 179.
+\:\\{mem\_min}, \[12], 14, 154, 158, 159, 163, 167, 168, 175, 176, 178, 179,
+180, 182, 183, 184, 185, 218, 1190, 1191, 1194, 1195, 1208.
+\:\\{mem\_top}, 11, \[12], 14, 154, 159, 175, 176, 1190, 1191, 1195.
+\:\.{Memory usage...}, 1045.
+\:\\{memory\_word}, 153, \[156], 157, 159, 242, 1188.
+\:\\{merge\_edges}, \[366], 929, 1061.
+\:\9{message\_}{\&{message} primitive}, \[1079].
+\:\\{message\_code}, \[1079], 1082.
+\:\\{message\_command}, \[186], 1079, 1080, 1081.
+\:\.{METAFONT capacity exceeded ...}, 89.
+\:\9{METAFONT capacity exceeded buffer size}{\quad buffer size}, 34, 654, 717.
+\:\9{METAFONT capacity exceeded extensible}{\quad extensible}, 1113.
+\:\9{METAFONT capacity exceeded fontdimen}{\quad fontdimen}, 1115.
+\:\9{METAFONT capacity exceeded hash size}{\quad hash size}, 207.
+\:\9{METAFONT capacity exceeded headerbyte}{\quad headerbyte}, 1114.
+\:\9{METAFONT capacity exceeded input stack size}{\quad input stack size}, 647.
+\:\9{METAFONT capacity exceeded kern}{\quad kern}, 1112.
+\:\9{METAFONT capacity exceeded ligtable size}{\quad ligtable size}, 1107.
+\:\9{METAFONT capacity exceeded main memory size}{\quad main memory size}, 163,
+167.
+\:\9{METAFONT capacity exceeded move table size}{\quad move table size}, 356,
+468, 508.
+\:\9{METAFONT capacity exceeded number of int}{\quad number of internals}, 1036.
+\:\9{METAFONT capacity exceeded number of strings}{\quad number of strings},
+44, 772.
+\:\9{METAFONT capacity exceeded parameter stack size}{\quad parameter stack
+size}, 704, 736, 737.
+\:\9{METAFONT capacity exceeded path size}{\quad path size}, 281.
+\:\9{METAFONT capacity exceeded pen polygon size}{\quad pen polygon size}, 481.
+\:\9{METAFONT capacity exceeded pool size}{\quad pool size}, 41.
+\:\9{METAFONT capacity exceeded rounding table size}{\quad rounding table
+size}, 429.
+\:\9{METAFONT capacity exceeded text input levels}{\quad text input levels},
+654.
+\:\9{METAFONTbook}{\sl The {\logos METAFONT\/}book}, 1, 199, 574, 824, 872,
+873, 878, 990, 991, 1068, 1203.
+\:\9{METAFONT84}{\MF84}, \[1].
+\:\\{metric\_file\_name}, \[1087], 1134.
+\:\\{MF}, \[4].
+\:\.{MF.POOL check sum...}, 53.
+\:\.{MF.POOL doesn't match}, 53.
+\:\.{MF.POOL has no check sum}, 52.
+\:\.{MF.POOL line doesn't...}, 52.
+\:\\{MF\_area}, \[769], 793.
+\:\\{MF\_base\_default}, \[775], 776, 778.
+\:\.{MFbases}, 11, 776.
+\:\.{MFinputs}, 769.
+\:\.{mfput}, 34, 788.
+\:\\{mid}, \[1094].
+\:\\{min\_col}, \[580], 581, 582, 583.
+\:\\{min\_command}, \[186], 706, 715, 718.
+\:\\{min\_cover}, \[1118], 1120.
+\:\\{min\_d}, \[348], 351, 352.
+\:\\{min\_expression\_command}, \[186], 868, 869.
+\:\\{min\_halfword}, 12, \[153], 154, 155, 156, 324, 326, 337, 342, 348, 350,
+365, 375, 376, 381, 382, 383, 384, 580.
+\:\\{min\_m}, 1144, \[1146], \[1161].
+\:\\{min\_n}, \[348], 351, 352, 1144, \[1146], \[1161].
+\:\\{min\_of}, \[189], 923.
+\:\\{min\_primary\_command}, \[186], 823, 837, 862, 864, 868, 989.
+\:\\{min\_quarterword}, \[153], 154, 155, 156, 1093.
+\:\\{min\_secondary\_command}, \[186], 862.
+\:\\{min\_suffix\_token}, \[186], 844.
+\:\\{min\_tension}, \[883].
+\:\\{min\_tertiary\_command}, \[186], 864.
+\:\\{minor\_axis}, \[527], 530, 533, \[865], 866.
+\:\\{minus}, \[189], 859, 893, 898, 903, 922, 929, 930, 936, 939.
+\:\.{Missing `)'}, 727, 735, 1032.
+\:\.{Missing `)'...}, 725.
+\:\.{Missing `,'}, 727, 878.
+\:\.{Missing `..'}, 881.
+\:\.{Missing `:'}, 747, 751, 756, 1106.
+\:\.{Missing `:='}, 1021.
+\:\.{Missing `;'}, 713.
+\:\.{Missing `='}, 693, 755, 1035.
+\:\.{Missing `\char`\#'}, 1113.
+\:\.{Missing `\char`\}'}, 875.
+\:\.{Missing `]'}, 859, 861.
+\:\.{Missing `of'}, 734, 839.
+\:\.{Missing `until'}, 765.
+\:\.{Missing argument...}, 726.
+\:\.{Missing parameter type}, 703.
+\:\.{Missing symbolic token...}, 691.
+\:\.{Missing...inserted}, 94.
+\:\\{missing\_err}, \[94], 693, 713, 727, 734, 735, 747, 751, 755, 756, 765,
+839, 859, 861, 875, 878, 881, 1021, 1032, 1035, 1106, 1113.
+\:\\{missing\_extensible\_punctuation}, \[1113].
+\:\\{ml}, \[329].
+\:\\{mm}, \[348], 349, \[357], 358, 362, 364, \[580], 582, \[1165], 1169.
+\:\\{mm0}, \[511], 513, 517, 519, 523.
+\:\\{mm1}, \[511], 513, 517, 519, 523.
+\:{mock curvature}, 275.
+\:\\{mode\_command}, \[186], 1023, 1024, 1025.
+\:{Moler, Cleve Barry}, 124.
+\:\\{month}, \[190], 192, 193, 194, 790, 1163, 1200.
+\:\9{month\_}{\&{month} primitive}, \[192].
+\:\\{months}, \[788], 790.
+\:\\{more\_name}, 767, \[771], 781, 787.
+\:{Morrison, Donald Ross}, 124.
+\:\\{move}, \[308], 311, 315, 316, 319, 320, 321, 322, 354, 356, 357, 362, 364,
+378, 379, 381, 382, 383, 384, 468, 507, 512, 514, 517, 518, 520, 523.
+\:\\{move\_increment}, \[309], 310, 312, 314.
+\:\\{move\_ptr}, \[308], 311, 315, 316, 319, 320, 468, 511, 512, 513, 514, 515,
+516, 517, 518, 519, 520, 521, 522, 523.
+\:\\{move\_size}, \[11], 308, 311, 321, 356, 357, 362, 378, 468, 507, 508, 511.
+\:\\{move\_to\_edges}, \[378], 465, 517, 523.
+\:\\{mr}, \[329].
+\:\&{mtype}, \[4].
+\:\.{Must increase the x}, 1187.
+\:\\{my\_var\_flag}, \[823], 841, 852, \[868].
+\:\\{m0}, \[374], 375, 376, \[378], 380, 381, 382, 383, 384, \[464], 465, 467,
+508, 511, 517, 523.
+\:\\{m1}, \[374], 375, 376, \[378], 380, 463, \[464], 465, 467, 508, 511, 517,
+523.
+\:\|{n}, \[47], \[64], \[65], \[89], \[107], \[109], \[112], \[114], \[242], %
+\[246], \[280], \[284], \[311], \[332], \[348], \[366], \[369], \[373], \[374],
+\[378], \[473], \[477], \[484], \[488], \[491], \[497], \[511], \[539], \[562],
+\[568], \[574], \[580], \[610], \[641], \[667], \[697], \[720], \[722], \[723],
+\[755], \[773], \[774], \[778], \[863], \[913], \[916], \[944], \[985], %
+\[1046], \[1165], \[1212].
+\:\\{n\_arg}, \[139], 140, 141, 147, 256, 281, 282, 292, 293, 301, 387, 541,
+544, 866, 877, 907.
+\:\\{n\_cos}, \[144], 145, 259, 263, 297, 301, 530, 533, 906, 958.
+\:\\{n\_magic}, \[354], 361, 362, 365.
+\:\\{n\_max}, \[326], 329, 331, 332, 334, 336, 340, 348, 352, 364, 365, 366,
+965, 1167.
+\:\\{n\_min}, \[326], 329, 330, 334, 336, 340, 348, 352, 364, 366, 577, 965,
+1172.
+\:\\{n\_pos}, \[326], 330, 331, 334, 336, 352, 364, 374, 377, 378, 965.
+\:\\{n\_rover}, \[326], 330, 331, 334, 352, 364, 374, 377, 378.
+\:\\{n\_sin}, \[144], 145, 259, 263, 297, 301, 530, 533, 906, 958.
+\:\\{n\_sin\_cos}, 144, \[145], 147, 259, 263, 297, 301, 530, 906, 958.
+\:\\{n\_window}, \[572], 576, 577.
+\:\\{name}, 627, \[629], 630, 631, 632, 635, 637, 638, 649, 654, 655, 657, 679,
+717, 736, 793, 897.
+\:\\{name\_field}, 79, \[627], 629.
+\:\\{name\_length}, \[25], 51, 774, 778, 780.
+\:\\{name\_of\_file}, \[25], 26, 51, 774, 778, 780, 786.
+\:\\{name\_type}, 188, \[214], 215, 219, 228, 229, 230, 232, 233, 234, 235,
+236, 237, 238, 239, 240, 244, 245, 246, 247, 249, 254, 619, 651, 678, 702, 738,
+744, 745, 799, 806, 830, 856, 857, 911, 931, 982, 1047, 1209.
+\:\\{nd}, 1088, 1089, \[1096], 1126, 1135, 1141.
+\:\\{ne}, 1088, 1089, \[1096], 1097, 1113, 1135, 1140, 1141.
+\:\\{NE\_SW\_edge}, \[435].
+\:\\{negate}, \[16], 64, 103, 107, 110, 114, 118, 139, 146, 380, 409, 411, 412,
+414, 415, 416, 418, 423, 424, 425, 480, 882, 903, 904, 930, 959, 1007, 1068.
+\:\\{negate\_dep\_list}, 903, \[904], 930, 959.
+\:\\{negate\_edges}, \[344], 345, 903, 929.
+\:\\{negate\_x}, \[139], 390, 406, 409, 411, 418, 480, 489.
+\:\\{negate\_y}, \[139], 390, 406, 414, 415, 418, 437, 438, 439, 480, 489.
+\:\\{negative}, \[107], \[109], 110, \[112], \[114].
+\:\.{New busy locs}, 184.
+\:\\{new\_boundary}, \[451], 452, 458.
+\:\\{new\_dep}, \[606], 615, 829, 856, 858, 947, 969, 972.
+\:\\{new\_if\_limit}, \[748].
+\:\\{new\_indep}, \[585], 586, 816, 855.
+\:\\{new\_internal}, \[186], 211, 212, 1033.
+\:\9{new\_internal\_}{\&{newinternal} primitive}, \[211].
+\:\\{new\_knot}, 870, \[871], 885, 908.
+\:\\{new\_num\_tok}, \[215], 236, 860.
+\:\\{new\_randoms}, 148, \[149], 150.
+\:\\{new\_ring\_entry}, \[619], 855.
+\:\\{new\_root}, \[234], 242, 1011.
+\:\\{new\_row\_0}, 1144, \[1145], 1173.
+\:\\{new\_row\_1}, \[1144].
+\:\\{new\_row\_164}, \[1144], 1145.
+\:\\{new\_string}, \[54], 57, 58, 840, 912, 1163, 1164, 1200.
+\:\\{new\_structure}, \[239], 243.
+\:\\{next}, \[200], 202, 205, 207.
+\:\\{next\_a}, \[426], \[440], 446.
+\:\\{next\_char}, \[1093], 1107, 1112, 1137.
+\:\\{next\_random}, \[149], 151, 152.
+\:\\{nh}, 1088, 1089, \[1096], 1126, 1135, 1141.
+\:\\{ni}, 1088, 1089, \[1096], 1126, 1135, 1141.
+\:\\{nice\_pair}, \[899], 900, 907, 915, 941, 975, 983, 1072.
+\:\&{nil}, 16.
+\:\\{ninety\_deg}, \[106], 141, 530.
+\:\\{nk}, 1088, 1089, \[1096], 1097, 1112, 1135, 1139, 1141.
+\:\\{nl}, \[329], 330, 1088, 1089, 1093, \[1096], 1097, 1107, 1110, 1111, 1112,
+1135, 1137, 1139, 1141.
+\:\\{nn}, \[562].
+\:\.{No loop is in progress}, 713.
+\:\.{No new edges added}, 372.
+\:\\{no\_crossing}, \[391], 392.
+\:\\{no\_op}, \[1144], 1147.
+\:\\{no\_print}, \[54], 57, 58, 70, 93.
+\:\\{no\_tag}, \[1092], 1096, 1097, 1104.
+\:\\{node\_size}, \[166], 168, 169, 170, 172, 176, 182, 1194, 1195, 1207.
+\:\\{node\_to\_round}, 426, \[427], 429, 436, 439, 444, 445, 446.
+\:\.{NONEXISTENT}, 218.
+\:\\{nonlinear\_eq}, \[621], 1003.
+\:\.{Nonnumeric...replaced by 0}, 830.
+\:\\{nonstop\_mode}, \[68], 81, 679, 682, 897, 1024, 1025.
+\:\9{nonstop\_mode\_}{\&{nonstopmode} primitive}, \[1024].
+\:\\{norm\_rand}, \[152], 895.
+\:\\{normal}, \[659], 660, 661, 694, 697, 730, 738, 739, 742, 758, 991, 1016.
+\:\\{normal\_deviate}, \[189], 893, 895.
+\:\9{normal\_deviate\_}{\&{normaldeviate} primitive}, \[893].
+\:\\{normalize\_selector}, 73, \[87], 88, 89, 90.
+\:\\{north\_edge}, \[435], 438.
+\:\\{north\_south\_edge}, \[435].
+\:\.{Not a cycle}, 1067.
+\:\.{Not a string}, 716, 1082.
+\:\.{Not a suitable variable}, 1060.
+\:\.{Not implemented...}, 901, 923.
+\:\9{not\_}{\&{not} primitive}, \[893].
+\:\\{not\_found}, \[15], 45, 394, 477, 479, 491, 494, 496, 539, 541, 556, 560,
+561, 760, 1001, 1004, 1059, 1064, 1067, 1071, 1073, 1074, 1075.
+\:\\{not\_op}, \[189], 893, 905.
+\:\\{nothing\_printed}, \[473], 474.
+\:\\{np}, 1088, 1089, \[1096], 1097, 1115, 1135, 1140, 1141.
+\:\\{nr}, \[329], 331.
+\:\\{nuline}, \[197], \[257], \[332], \[473].
+\:\\{null}, \[158], 159, 161, 163, 165, 167, 168, 176, 177, 181, 182, 202, 214,
+216, 217, 226, 227, 229, 232, 233, 234, 235, 237, 242, 246, 249, 251, 252, 253,
+254, 257, 258, 324, 346, 355, 364, 368, 398, 472, 475, 477, 479, 487, 528, 532,
+536, 537, 587, 589, 591, 594, 597, 599, 600, 604, 605, 607, 609, 611, 612, 614,
+615, 616, 617, 618, 619, 620, 632, 636, 638, 639, 640, 650, 651, 652, 665, 676,
+685, 686, 694, 697, 698, 700, 707, 712, 713, 714, 716, 718, 719, 720, 721, 722,
+723, 724, 726, 728, 730, 734, 735, 736, 738, 739, 746, 752, 753, 754, 755, 760,
+762, 763, 764, 795, 801, 802, 805, 806, 807, 810, 811, 812, 816, 818, 819, 840,
+844, 845, 848, 850, 851, 852, 853, 854, 857, 902, 904, 924, 925, 926, 927, 928,
+929, 930, 931, 933, 934, 935, 936, 942, 943, 944, 945, 948, 949, 968, 970, 972,
+997, 998, 1000, 1003, 1006, 1007, 1008, 1009, 1010, 1011, 1015, 1035, 1040,
+1041, 1043, 1048, 1049, 1050, 1057, 1061, 1064, 1068, 1070, 1071, 1074, 1194,
+1195, 1207, 1209, 1213.
+\:\\{null\_coords}, \[175], 214, 475.
+\:\\{null\_pen}, \[175], 435, 438, 442, 475, 477, 487, 865, 895, 917, 962, 1062.
+\:\9{null\_pen\_}{\&{nullpen} primitive}, \[893].
+\:\\{null\_pen\_code}, \[189], 893, 895.
+\:\9{null\_picture\_}{\&{nullpicture} primitive}, \[893].
+\:\\{null\_picture\_code}, \[189], 893, 895.
+\:\\{null\_tally}, \[217].
+\:\\{nullary}, \[186], 713, 823, 893, 894, 895.
+\:\\{num}, \[116], \[296], \[836], 837.
+\:\9{num\_special\_}{\&{numspecial} primitive}, \[1176].
+\:\.{Number too large}, 914.
+\:\9{numeric\_}{\&{numeric} primitive}, \[1013].
+\:\\{numeric\_token}, \[186], 651, 675, 678, 823, 824, 836, 837, 844, 846, 860,
+861, 1016, 1042.
+\:\\{numeric\_type}, \[187], 189, 229, 242, 248, 585, 798, 802, 809, 855, 918,
+1013.
+\:\\{nw}, 1088, 1089, \[1096], 1124, 1135, 1141.
+\:\\{NW\_SE\_edge}, \[435].
+\:\\{n0}, \[373], \[374], 375, 376, 377, \[378], 380, 382, 383, 384, \[464],
+465, 467, 468, 508, 513, 515, 517, 519, 521, 523.
+\:\\{n1}, \[373], \[374], 375, 376, \[378], 380, 463, \[464], 465, 467, 468,
+508, 513, 517, 519, 523.
+\:\|{o}, \[210], \[431], \[477].
+\:\\{obliterated}, \[851], 852, 1000, 1057.
+\:\9{oct\_}{\&{oct} primitive}, \[893].
+\:\\{oct\_op}, \[189], 893, 912, 913, 914.
+\:\\{octant}, \[139], 141, \[379], 380, \[387], \[388], \[394], 434, 437, %
+\[451], 463, 465, 468, 473, 479, 480, 481, 484, 485, \[488], 489, 506, 508,
+509, 510, 512, 513, 515, 516, 518, 519, 521, 522.
+\:\\{octant\_after}, \[390].
+\:\\{octant\_before}, \[390].
+\:\\{octant\_code}, \[448], 449, 458, 473, 481, 484.
+\:\\{octant\_dir}, 394, \[395], 396, 398, 401, 509.
+\:\\{octant\_number}, \[448], 449, 452, 459, 479, 488, 508, 512.
+\:\\{octant\_subdivide}, 402, \[419].
+\:\\{odd}, 62, 111, 113, 145, 390, 417, 434, 435, 436, 442, 445, 459, 473, 482,
+483, 484, 488, 508, 512, 530, 560, 906.
+\:\9{odd\_}{\&{odd} primitive}, \[893].
+\:\\{odd\_op}, \[189], 893, 906.
+\:\9{of\_}{\&{of} primitive}, \[211].
+\:\\{of\_macro}, \[226], 227, 705, 733.
+\:\\{of\_token}, \[186], 211, 212, 705, 734, 839.
+\:\\{off\_base}, \[1187], 1189, 1191, 1195, 1199.
+\:\\{offset\_prep}, \[491], 494, 500, 506.
+\:\.{OK}, 1051.
+\:\\{OK\_to\_interrupt}, 83, \[91], 92, 93, 653, 825.
+\:\\{old\_exp}, \[922], 925, 927, \[944].
+\:\\{old\_p}, \[922], 925, 926.
+\:\\{old\_rover}, \[173].
+\:\\{old\_setting}, 195, \[196], \[635], 636, \[788], 840, 912, 1022, 1163,
+1164.
+\:\\{one\_byte}, \[1161].
+\:\\{one\_crossing}, \[391].
+\:\\{one\_eighty\_deg}, \[106], 139, 141, 292, 544.
+\:\\{oo}, \[477], 479.
+\:\\{op\_byte}, \[1093], 1107, 1112, 1137.
+\:\\{op\_defining}, \[659], 664, 665, 694, 700.
+\:\\{open}, \[256], 258, 262, 263, 271, 272, 273, 280, 282, 284, 285, 865, 868,
+870, 874, 875, 877, 879, 885, 887, 888, 889, 890, 891, 896.
+\:\.{open?}, 258, 262.
+\:\\{open\_a\_window}, \[574], 1073.
+\:\\{open\_base\_file}, \[779], 1211.
+\:\\{open\_log\_file}, 73, 87, 679, \[788], 789, 791, 793, 895, 1134, 1209.
+\:\\{open\_parens}, \[631], 657, 681, 793, 1209.
+\:\\{open\_window}, \[186], 211, 212, 1069.
+\:\9{open\_window\_}{\&{openwindow} primitive}, \[211].
+\:\9{or\_}{\&{or} primitive}, \[893].
+\:\\{or\_op}, \[189], 893, 940.
+\:\\{ord}, 20.
+\:{oriental characters}, 1147.
+\:\&{othercases}, \[10].
+\:\\{others}, 10.
+\:\.{Ouch...clobbered}, 1204.
+\:\.{Out of order...}, 617.
+\:\9{outer\_}{\&{outer} primitive}, \[1027].
+\:\\{outer\_tag}, \[186], 242, 249, 254, 668, 759, 850, 1029, 1041.
+\:\\{output}, \[4].
+\:\.{Output written...}, 1182.
+\:\\{output\_file\_name}, \[791], 792, 1163, 1182.
+\:\\{over}, \[189], 837, 893, 948.
+\:\\{overflow}, 34, 41, 44, \[89], 163, 167, 207, 281, 356, 429, 468, 481, 508,
+647, 654, 704, 705, 717, 736, 737, 772, 1036, 1107, 1112, 1113, 1114, 1115,
+1205.
+\:{Overflow in arithmetic}, 9.
+\:\\{o1}, 452, \[453], 458, 459.
+\:\\{o2}, 452, \[453], 458, 459.
+\:\|{p}, \[107], \[109], \[112], \[114], \[163], \[167], \[172], \[173], %
+\[177], \[180], \[185], \[205], \[215], \[216], \[217], \[226], \[227], \[232],
+\[233], \[234], \[235], \[238], \[239], \[242], \[246], \[247], \[248], \[249],
+\[252], \[253], \[254], \[257], \[264], \[265], \[266], \[268], \[269], \[284],
+\[299], \[328], \[329], \[332], \[334], \[336], \[337], \[340], \[342], \[344],
+\[346], \[348], \[354], \[366], \[369], \[374], \[378], \[385], \[394], \[398],
+\[402], \[405], \[406], \[410], \[419], \[429], \[433], \[440], \[451], \[465],
+\[473], \[477], \[484], \[486], \[487], \[488], \[491], \[493], \[497], \[506],
+\[510], \[518], \[527], \[539], \[556], \[562], \[577], \[589], \[591], \[594],
+\[597], \[599], \[600], \[601], \[603], \[604], \[606], \[608], \[609], \[610],
+\[619], \[620], \[621], \[622], \[641], \[649], \[650], \[651], \[652], \[661],
+\[685], \[694], \[697], \[707], \[720], \[722], \[730], \[737], \[746], \[748],
+\[755], \[760], \[763], \[799], \[800], \[801], \[805], \[807], \[809], \[823],
+\[827], \[848], \[855], \[856], \[858], \[860], \[862], \[863], \[864], \[865],
+\[868], \[872], \[898], \[899], \[904], \[910], \[916], \[919], \[922], \[923],
+\[928], \[930], \[935], \[943], \[944], \[946], \[949], \[953], \[961], \[962],
+\[963], \[966], \[968], \[971], \[972], \[974], \[976], \[977], \[978], \[982],
+\[984], \[985], \[995], \[996], \[1001], \[1006], \[1015], \[1046], \[1050], %
+\[1057], \[1059], \[1072], \[1117], \[1118], \[1121], \[1165], \[1186], %
+\[1187], \[1205].
+\:\\{p\_over\_v}, \[600], 819, 932, 949.
+\:\\{p\_plus\_fq}, 592, \[594], 597, 601, 818, 819, 932, 968, 971, 1010.
+\:\\{p\_plus\_q}, \[597], 932, 1010.
+\:\\{p\_times\_v}, \[599], 943, 969.
+\:\\{p\_with\_x\_becoming\_q}, \[601], 614.
+\:\\{pack\_buffered\_name}, \[778], 779.
+\:\\{pack\_cur\_name}, \[784], 786, 793.
+\:\\{pack\_file\_name}, \[774], 784, 793.
+\:\\{pack\_job\_name}, \[784], 788, 791, 1134, 1200.
+\:\\{packed\_ASCII\_code}, \[37], 38.
+\:\\{page}, \[631].
+\:\\{page\_stack}, \[631].
+\:\\{paint\_row}, 3, 564, 566, \[568], 569, 571, 578, 579.
+\:\\{paint\_switch}, \[1143], 1144.
+\:\\{paint\_0}, 1144, \[1145], 1159.
+\:\\{paint1}, 1144, \[1145], 1159.
+\:\\{paint2}, \[1144].
+\:\\{paint3}, \[1144].
+\:\9{pair\_}{\&{pair} primitive}, \[1013].
+\:\\{pair\_node\_size}, \[230], 231.
+\:\\{pair\_to\_path}, \[908], 921, 975, 983, 988, 1003, 1062.
+\:\\{pair\_type}, \[187], 216, 230, 231, 232, 248, 798, 799, 800, 802, 808,
+809, 830, 837, 855, 868, 870, 872, 877, 898, 899, 900, 903, 909, 917, 918, 919,
+921, 926, 927, 929, 936, 941, 942, 944, 946, 948, 952, 957, 975, 982, 983, 988,
+995, 1001, 1002, 1003, 1013, 1062.
+\:\\{pair\_value}, \[982], 984, 987, 988.
+\:\\{panicking}, \[178], 179, 825, 1213.
+\:\\{param}, 1090, 1095, \[1096], 1106, 1115, 1140.
+\:\\{param\_ptr}, \[633], 649, 650, 657, 736, 737.
+\:\\{param\_size}, \[12], 214, 633, 677, 697, 704, 705, 736, 737, 1208.
+\:\\{param\_stack}, 632, \[633], 639, 640, 650, 676, 677, 720, 736, 737.
+\:\\{param\_start}, \[632], 639, 640, 649, 650, 676, 677.
+\:\\{param\_type}, \[186], 227, 695, 696, 697, 703.
+\:\\{parameter}, \[632], 638, 677.
+\:\\{parent}, \[229], 236, 239, 240, 241, 245.
+\:\9{PASCAL H}{\ph}, \[3], 26.
+\:\9{PASCAL}{\PASCAL}, 1, 10.
+\:\\{pass\_text}, 706, \[742], 749, 751.
+\:\.{Path at line...}, 257.
+\:\9{path\_}{\&{path} primitive}, \[1013].
+\:\\{path\_intersection}, \[562], 988.
+\:\\{path\_join}, \[186], 211, 212, 874, 881, 886, 887.
+\:\\{path\_length}, 915, \[916], 978.
+\:\\{path\_size}, \[11], 279, 280, 281, 283, 284.
+\:\\{path\_tail}, 266, \[267], 1065.
+\:\\{path\_trans}, 952, \[962].
+\:\\{path\_type}, \[187], 216, 248, 621, 798, 802, 804, 808, 809, 855, 868,
+870, 885, 891, 908, 915, 917, 918, 919, 920, 921, 952, 975, 983, 988, 1003,
+1013, 1062.
+\:\.{Paths don't touch}, 887.
+\:\\{pause\_for\_instructions}, 91, \[93].
+\:\\{pausing}, \[190], 192, 193, 682.
+\:\9{pausing\_}{\&{pausing} primitive}, \[192].
+\:\\{pd}, \[357], 358, 360.
+\:\.{Pen cycle must be convex}, 478.
+\:\.{Pen path must be a cycle}, 865.
+\:\.{Pen too large}, 478.
+\:\9{pen\_}{\&{pen} primitive}, \[1013].
+\:\\{pen\_circle}, \[189], 893, 895.
+\:\9{pen\_circle\_}{\&{pencircle} primitive}, \[893].
+\:\\{pen\_edge}, \[433], 435, 438, \[440], 442, 443.
+\:\\{pen\_head}, \[484].
+\:\\{pen\_node\_size}, 175, \[472], 477, 487.
+\:\9{pen\_offset\_}{\&{penoffset} primitive}, \[893].
+\:\\{pen\_offset\_of}, \[189], 893, 983.
+\:\\{pen\_type}, \[187], 216, 248, 621, 798, 802, 804, 808, 809, 855, 865, 895,
+918, 919, 921, 952, 962, 983, 1003, 1013, 1052, 1053, 1054, 1055.
+\:\\{percent\_class}, \[198], 199, 217, 669.
+\:\\{period\_class}, \[198], 199, 669.
+\:\\{perturbation}, 1118, \[1119], 1120, 1121, 1122, 1123, 1124, 1126.
+\:\\{phi}, 541, \[542], 544.
+\:\9{picture\_}{\&{picture} primitive}, \[1013].
+\:\\{picture\_type}, \[187], 216, 248, 621, 798, 802, 804, 808, 809, 855, 895,
+898, 903, 918, 919, 921, 929, 952, 1003, 1013, 1057, 1061, 1070.
+\:\\{pixel\_color}, \[565], 566, 568, 580.
+\:\.{plain}, 776, 779, 1203.
+\:\.{Please type...}, 679, 786.
+\:\\{plus}, \[189], 859, 893, 898, 922, 930.
+\:\\{plus\_or\_minus}, \[186], 823, 836, 837, 893, 894.
+\:\\{pm}, \[357], 358, 360.
+\:\9{point\_}{\&{point} primitive}, \[893].
+\:\\{point\_of}, \[189], 893, 983, 987.
+\:\\{pointer}, \[158], 159, 161, 163, 166, 167, 172, 173, 177, 178, 180, 185,
+200, 205, 215, 216, 225, 226, 227, 232, 233, 234, 235, 238, 239, 242, 246, 247,
+248, 249, 250, 252, 253, 254, 257, 264, 265, 266, 267, 268, 269, 280, 284, 299,
+326, 327, 328, 329, 332, 333, 334, 336, 337, 340, 342, 344, 346, 348, 354, 366,
+369, 373, 374, 378, 385, 394, 398, 402, 403, 405, 406, 410, 419, 427, 429, 433,
+440, 451, 465, 473, 476, 477, 484, 486, 487, 488, 491, 493, 497, 506, 510, 511,
+518, 527, 539, 556, 562, 577, 589, 591, 592, 594, 597, 599, 600, 601, 603, 604,
+606, 607, 608, 609, 610, 619, 620, 621, 622, 633, 649, 650, 651, 652, 661, 685,
+694, 697, 707, 718, 720, 722, 723, 730, 737, 738, 746, 748, 752, 755, 760, 763,
+799, 800, 801, 805, 807, 809, 813, 823, 827, 843, 848, 851, 855, 856, 858, 860,
+862, 863, 864, 865, 868, 871, 872, 898, 904, 910, 916, 919, 922, 923, 928, 930,
+935, 943, 944, 946, 949, 953, 961, 962, 963, 966, 968, 971, 972, 974, 976, 977,
+978, 982, 984, 985, 995, 996, 1001, 1006, 1011, 1015, 1031, 1032, 1035, 1046,
+1050, 1057, 1059, 1071, 1072, 1074, 1117, 1118, 1121, 1125, 1165, 1186, 1187,
+1205.
+\:\\{pool\_file}, 47, \[50], 51, 52, 53.
+\:\\{pool\_name}, \[11], 51.
+\:\\{pool\_pointer}, \[37], 38, 45, 46, 59, 60, 77, 210, 707, 768, 774, 913,
+976, 1160.
+\:\\{pool\_ptr}, 37, \[38], 40, 41, 43, 44, 47, 52, 58, 771, 780, 1045, 1163,
+1192, 1193, 1204.
+\:\\{pool\_size}, \[11], 37, 41, 52, 58, 780, 1045, 1193, 1208.
+\:\\{pop\_input}, \[648], 650, 655.
+\:\\{post}, 1142, 1144, \[1145], 1146, 1148, 1182.
+\:\\{post\_head}, 842, \[843], 844, 845, 851, 852, 854.
+\:\\{post\_post}, 1144, \[1145], 1146, 1148, 1182.
+\:\9{postcontrol\_}{\&{postcontrol} primitive}, \[893].
+\:\\{postcontrol\_of}, \[189], 893, 983, 987.
+\:\\{pp}, \[242], 243, 244, 245, \[265], \[266], \[334], 335, \[340], 341, %
+\[366], 367, 368, \[406], 413, 414, 415, 416, 417, 418, \[440], 444, 445, 446, %
+\[556], 558, \[562], \[589], 590, \[594], 595, \[597], 598, \[755], 765, %
+\[809], 816, \[868], 885, 886, 887, 889, 890, \[966], 970, \[978], 980, 981, %
+\[1006], 1009, 1010.
+\:\\{pre}, 1142, 1144, \[1145], 1163.
+\:\\{pre\_head}, 842, \[843], 844, 850, 851, 852, 853, 854.
+\:\9{precontrol\_}{\&{precontrol} primitive}, \[893].
+\:\\{precontrol\_of}, \[189], 893, 983, 987.
+\:\\{prev\_dep}, \[587], 603, 606, 617, 799, 811, 816, 827, 931, 947, 1007.
+\:\\{prev\_m}, \[1165], 1169, 1170, 1171.
+\:\\{prev\_n}, \[1165], 1167, 1172, 1174.
+\:\\{prev\_r}, \[610], 614.
+\:\\{prev\_w}, \[348], 349, 350, \[1165], 1169, 1170, 1171.
+\:\9{primary\_}{\&{primary} primitive}, \[695].
+\:\\{primary\_binary}, \[186], 189, 823, 839, 893, 894.
+\:\9{primary\_def\_}{\&{primarydef} primitive}, \[683].
+\:\\{primary\_macro}, \[226], 227, 695, 733.
+\:\\{primitive}, 192, \[210], 211, 212, 625, 683, 688, 695, 709, 740, 893,
+1013, 1018, 1024, 1027, 1037, 1052, 1079, 1101, 1108, 1176, 1203, 1204.
+\:\\{print}, 54, \[59], 60, 62, 66, 68, 79, 80, 81, 84, 85, 89, 90, 94, 122,
+128, 134, 187, 189, 197, 212, 217, 218, 219, 221, 222, 227, 235, 237, 257, 258,
+259, 260, 261, 262, 263, 332, 372, 394, 397, 398, 401, 509, 510, 515, 521, 589,
+613, 625, 638, 639, 643, 644, 663, 664, 665, 682, 684, 689, 696, 710, 721, 723,
+725, 734, 741, 750, 754, 786, 788, 790, 802, 804, 805, 807, 817, 824, 832, 839,
+851, 900, 902, 923, 924, 945, 997, 998, 999, 1002, 1008, 1019, 1025, 1028,
+1032, 1034, 1038, 1041, 1043, 1045, 1048, 1050, 1053, 1057, 1080, 1098, 1102,
+1105, 1109, 1123, 1139, 1140, 1163, 1164, 1180, 1182, 1192, 1194, 1196, 1200,
+1208, 1209, 1212, 1213.
+\:\\{print\_arg}, 721, \[723], 728, 734.
+\:\\{print\_capsule}, 217, 219, \[224], 1042.
+\:\\{print\_char}, \[58], 59, 60, 63, 64, 65, 77, 85, 89, 90, 103, 104, 157,
+184, 185, 189, 197, 209, 212, 219, 220, 221, 222, 223, 224, 227, 237, 254, 259,
+263, 332, 333, 372, 373, 394, 398, 401, 509, 589, 590, 602, 603, 613, 626, 637,
+643, 681, 689, 725, 762, 790, 793, 802, 803, 806, 817, 824, 900, 902, 914, 924,
+945, 990, 998, 1002, 1008, 1022, 1041, 1042, 1045, 1046, 1050, 1057, 1134,
+1163, 1164, 1165, 1182, 1194, 1200, 1205, 1213.
+\:\\{print\_cmd\_mod}, 212, 227, \[625], 626, 751, 824, 839, 990, 1041, 1043,
+1209, 1213.
+\:\\{print\_dd}, \[65], 790, 1163.
+\:\\{print\_dependency}, \[589], 613, 805, 817, 1050.
+\:\\{print\_diagnostic}, \[197], 257, 332, 372, 394, 473.
+\:\\{print\_dp}, 802, 803, \[805].
+\:\\{print\_edges}, \[332], 804, 1165.
+\:\\{print\_err}, 67, \[68], 88, 89, 90, 93, 94, 99, 122, 128, 134, 140, 270,
+340, 342, 398, 404, 478, 602, 623, 661, 663, 670, 672, 675, 691, 701, 703, 708,
+712, 713, 725, 726, 751, 786, 795, 807, 824, 832, 838, 851, 865, 887, 914, 963,
+965, 990, 991, 1004, 1008, 1015, 1016, 1017, 1032, 1034, 1051, 1056, 1057,
+1067, 1073, 1074, 1086, 1098, 1105, 1107, 1110.
+\:\\{print\_exp}, 224, 639, 723, 762, \[801], 807, 902, 924, 945, 997, 998,
+1040, 1046.
+\:\\{print\_file\_name}, \[773], 786.
+\:\\{print\_int}, \[64], 79, 89, 103, 157, 181, 182, 183, 184, 185, 197, 209,
+222, 237, 332, 333, 372, 397, 398, 509, 515, 521, 617, 637, 661, 723, 790, 832,
+914, 1045, 1105, 1139, 1140, 1163, 1164, 1165, 1182, 1192, 1194, 1196, 1200,
+1209, 1213.
+\:\\{print\_known\_or\_unknown\_type}, \[900], 901, 923.
+\:\\{print\_ln}, \[57], 58, 61, 62, 66, 81, 84, 85, 86, 157, 195, 257, 394,
+473, 638, 643, 656, 665, 679, 682, 721, 788, 793, 1023, 1041, 1043, 1045, 1165,
+1192, 1194, 1196.
+\:\\{print\_locs}, \[180].
+\:\\{print\_macro\_name}, 721, \[722], 725, 726, 734.
+\:\\{print\_nl}, \[62], 68, 77, 79, 80, 86, 181, 182, 183, 184, 185, 195, 197,
+209, 254, 257, 259, 332, 333, 372, 373, 394, 397, 398, 473, 474, 509, 510, 515,
+521, 603, 613, 617, 626, 637, 638, 639, 665, 679, 723, 725, 762, 786, 788, 807,
+817, 902, 924, 945, 994, 997, 998, 1022, 1040, 1041, 1045, 1046, 1048, 1050,
+1082, 1123, 1128, 1134, 1139, 1140, 1169, 1182, 1200, 1205, 1209, 1212.
+\:\\{print\_op}, \[189], 894, 901, 902, 923, 924.
+\:\\{print\_path}, \[257], 269, 402, 804.
+\:\\{print\_pen}, \[473], 477, 484, 804.
+\:\\{print\_scaled}, \[103], 104, 122, 128, 134, 157, 220, 254, 259, 260, 263,
+589, 590, 602, 603, 802, 803, 817, 912, 945, 1008, 1022, 1042, 1123.
+\:\\{print\_spec}, \[394], 402.
+\:\\{print\_strange}, \[398], 399, 1068.
+\:\\{print\_the\_digs}, \[63], 64.
+\:\\{print\_two}, \[104], 258, 261, 394, 473, 510.
+\:\\{print\_two\_true}, \[394], 397, 474, 509, 515, 521.
+\:\\{print\_type}, \[187], 189, 802, 804, 806, 900, 1002, 1014, 1057.
+\:\\{print\_variable\_name}, 221, \[235], 589, 603, 613, 664, 802, 803, 806,
+817, 1046, 1048, 1050, 1213.
+\:\\{print\_weight}, 332, \[333].
+\:\\{print\_word}, \[157], 1213.
+\:\\{procrustes}, \[404].
+\:\\{progression\_node\_size}, \[752], 763, 765.
+\:\\{prompt\_file\_name}, \[786], 789, 791, 793, 1134, 1200.
+\:\\{prompt\_input}, \[66], 78, 82, 679, 682, 786, 897.
+\:\\{proofing}, \[190], 192, 193, 994, 1070, 1147, 1165, 1177.
+\:\9{proofing\_}{\&{proofing} primitive}, \[192].
+\:\\{protection\_command}, \[186], 1026, 1027, 1028.
+\:\\{proto\_dependent}, \[187], 216, 248, 588, 589, 594, 597, 599, 601, 603,
+610, 612, 798, 799, 800, 802, 808, 809, 812, 813, 815, 817, 818, 819, 855, 857,
+903, 932, 943, 949, 968, 969, 971, 972, 1003, 1010.
+\:\\{pseudo}, \[54], 57, 58, 59, 60, 642.
+\:\\{psi}, \[279], 281, 290, 294, 297.
+\:\\{push\_input}, \[647], 649, 654.
+\:\\{put}, 25, 28, 1188.
+\:\\{put\_get\_error}, 270, 340, 342, 404, 478, 623, \[820], 865, 873, 887,
+901, 914, 923, 950, 955, 963, 965, 993, 999, 1000, 1002, 1004, 1008, 1015,
+1016, 1051, 1057, 1067, 1068, 1073, 1074, 1082, 1086, 1098, 1105, 1106, 1178.
+\:\\{put\_get\_flush\_error}, 716, 754, \[820], 830, 852, 872, 876, 878, 883,
+892, 937, 960, 1021, 1055, 1056, 1060, 1061, 1062, 1071, 1103, 1112, 1115.
+\:\\{pyth\_add}, \[124], 145, 281, 454, 530, 533, 866, 915, 951.
+\:\\{pyth\_sub}, \[126], 951.
+\:\\{pythag\_add}, \[189], 893, 951.
+\:\\{pythag\_sub}, \[189], 893, 951.
+\:\.{Pythagorean...}, 128.
+\:\|{q}, \[107], \[109], \[112], \[114], \[117], \[121], \[145], \[167], %
+\[172], \[173], \[177], \[180], \[185], \[216], \[217], \[227], \[232], \[233],
+\[235], \[239], \[242], \[246], \[247], \[249], \[252], \[253], \[254], \[257],
+\[264], \[265], \[266], \[268], \[269], \[284], \[299], \[311], \[328], \[329],
+\[332], \[333], \[336], \[337], \[340], \[342], \[344], \[346], \[348], \[354],
+\[366], \[369], \[385], \[394], \[398], \[402], \[405], \[406], \[410], \[419],
+\[433], \[440], \[451], \[465], \[477], \[491], \[493], \[506], \[518], \[527],
+\[539], \[556], \[577], \[589], \[594], \[597], \[601], \[603], \[604], \[606],
+\[608], \[609], \[610], \[619], \[620], \[621], \[622], \[641], \[685], \[694],
+\[697], \[720], \[722], \[723], \[746], \[755], \[760], \[763], \[801], \[805],
+\[809], \[823], \[827], \[851], \[855], \[858], \[863], \[865], \[868], \[871],
+\[898], \[919], \[922], \[928], \[930], \[935], \[943], \[946], \[949], \[953],
+\[961], \[962], \[966], \[968], \[972], \[978], \[985], \[996], \[1001], %
+\[1006], \[1015], \[1046], \[1059], \[1117], \[1121], \[1165], \[1186], \[1187].
+\:\\{qi}, \[155], 1107, 1110, 1111, 1112, 1113, 1137, 1192.
+\:\\{qo}, \[155], 1110, 1111, 1133, 1193.
+\:\\{qq}, 229, \[242], 245, \[265], \[266], \[334], \[366], 367, 368, \[406],
+413, 414, 415, 416, 417, 418, \[556], 558, \[594], 595, 596, \[597], 598, %
+\[868], 885, 886, 887, 890, \[966], 970, \[978], 980, 981.
+\:\\{qqq}, 229.
+\:\\{qqqq}, 153, \[156], 157, 1188, 1189.
+\:\\{qqq1}, 229.
+\:\\{qqq2}, 229.
+\:\\{qq1}, 229.
+\:\\{qq2}, 229.
+\:\\{quad}, 1095.
+\:\\{quad\_code}, \[1095].
+\:\\{quadrant\_subdivide}, 402, \[406], 426.
+\:\\{quarter\_unit}, \[101].
+\:\\{quarterword}, 153, \[156], 189, 627, 649, 823, 895, 898, 899, 901, 910,
+913, 919, 922, 923, 930, 953, 960, 962, 963, 966, 985.
+\:\\{quote}, \[688], 690.
+\:\9{quote\_}{\&{quote} primitive}, \[688].
+\:\\{q1}, 229.
+\:\|{r}, \[117], \[124], \[126], \[145], \[167], \[173], \[177], \[180], %
+\[217], \[227], \[233], \[235], \[239], \[242], \[246], \[247], \[268], \[284],
+\[311], \[332], \[334], \[336], \[337], \[340], \[344], \[346], \[348], \[354],
+\[366], \[373], \[374], \[378], \[402], \[406], \[410], \[419], \[451], \[465],
+\[476], \[477], \[491], \[493], \[506], \[518], \[527], \[567], \[568], \[577],
+\[594], \[597], \[599], \[600], \[601], \[604], \[606], \[610], \[621], \[622],
+\[694], \[697], \[720], \[809], \[823], \[855], \[858], \[863], \[868], \[922],
+\[928], \[930], \[946], \[953], \[966], \[968], \[971], \[1006], \[1104], %
+\[1117], \[1121].
+\:\\{r\_delim}, \[697], 703, \[720], 725, 726, 727, 729, \[730], 731, 735, %
+\[823], 826, 830, 1031, \[1032].
+\:\\{r\_packet}, 560.
+\:\\{r\_packets}, \[553], 558.
+\:{Ramshaw, Lyle Harold}, 2, 469, 1087.
+\:\\{random\_seed}, \[186], 211, 212, 1020.
+\:\9{random\_seed\_}{\&{randomseed} primitive}, \[211].
+\:\\{randoms}, \[148], 149, 150, 151, 152.
+\:\\{rd}, \[357], 358, 359.
+\:\\{read}, 52, 53, 1212, 1213.
+\:\\{read\_ln}, 52.
+\:\9{read\_string\_}{\&{readstring} primitive}, \[893].
+\:\\{read\_string\_op}, \[189], 893, 895.
+\:\\{ready\_already}, \[1203], 1204.
+\:\\{real}, 3, 120.
+\:{recursion}, 71, 73, 217, 224, 246, 706, 719, 748, 796, 995, 1041.
+\:\\{recycle\_value}, 224, 246, 247, 650, 763, 808, \[809], 810, 829, 873, 903,
+910, 922, 925, 935, 944, 955, 968, 970, 972, 1000, 1001.
+\:\\{reduce\_angle}, \[292], 293.
+\:\.{Redundant equation}, 623.
+\:\.{Redundant or inconsistent equation}, 1004.
+\:\\{ref\_count}, \[226], 475, 477, 487, 694, 697, 854, 862, 864, 868.
+\:{reference counts}, 42, 226, 632.
+\:\\{relax}, \[186], 211, 212, 686, 706, 707.
+\:\\{rem\_byte}, \[1093], 1107, 1112, 1137.
+\:\\{remainder}, \[1091], 1092, 1093, 1096.
+\:\\{remove\_cubic}, \[405], 417, 447, 492.
+\:\\{rep}, \[1094].
+\:\\{repeat\_loop}, \[186], 706, 707, 759, 1043.
+\:\\{reset}, 25, 26, 32.
+\:\\{reset\_OK}, \[26].
+\:\\{restart}, \[15], 167, 168, 667, 668, 670, 672, 676, 677, 679, 681, 691,
+823, 853, 854, 855, 862, 864, 868, 1001, 1003.
+\:\\{restore\_cur\_exp}, \[801].
+\:\\{result}, \[45], \[1054], 1056.
+\:\\{resume\_iteration}, 706, 712, 755, \[760], 763.
+\:\\{reswitch}, \[15], 748.
+\:\.{retrograde line...}, 510.
+\:\&{return}, 15, \[16].
+\:\\{return\_sign}, \[117], 118.
+\:\\{rev\_turns}, 452, 454, \[455], 456, 1064.
+\:\\{reverse}, \[189], 893, 921.
+\:\9{reverse\_}{\&{reverse} primitive}, \[893].
+\:\\{reversed}, \[977], \[978].
+\:\\{rewrite}, 25, 26, 32.
+\:\\{rewrite\_OK}, \[26].
+\:\\{rh}, 153, \[156], 157, 161, 200.
+\:\\{rhs}, \[1059], 1062, 1064, 1065, 1066, 1067.
+\:{Riesenfeld, Richard Franklin}, 303.
+\:\\{right\_brace}, \[186], 211, 212, 875.
+\:\\{right\_bracket}, \[186], 211, 212, 846, 859, 861, 1012.
+\:\\{right\_bracket\_class}, \[198], 199, 220, 221.
+\:\\{right\_class}, \[528], 531, 532, 534, 535.
+\:\\{right\_col}, \[567], \[572], 574, 577, 581, 583, 584.
+\:\\{right\_curl}, \[256], 263, 271, 282, 294, 890, 891.
+\:\\{right\_delimiter}, \[186], 203, 726, 727, 731, 735, 1030, 1031, 1032, 1043.
+\:\\{right\_edge}, \[580], 581, 582.
+\:\\{right\_given}, \[256], 263, 282, 293, 301, 879, 888, 889.
+\:\\{right\_octant}, \[393], 451, 452, 458, 459.
+\:\\{right\_paren\_class}, \[198], 199, 219, 222.
+\:\\{right\_tension}, \[256], 258, 260, 288, 289, 294, 295, 299, 300, 302, 881,
+882, 886, 887.
+\:\\{right\_transition}, \[393], 459, 509, 517, 523.
+\:\\{right\_type}, \[255], 256, 258, 263, 265, 266, 269, 271, 272, 273, 282,
+285, 290, 299, 302, 393, 394, 404, 405, 407, 409, 410, 411, 412, 413, 414, 415,
+416, 417, 418, 421, 423, 424, 425, 426, 434, 435, 436, 437, 438, 439, 441, 442,
+443, 445, 447, 450, 451, 452, 454, 457, 466, 479, 481, 486, 491, 494, 497, 499,
+512, 515, 518, 521, 528, 539, 562, 563, 870, 871, 874, 879, 880, 884, 885, 888,
+889, 890, 891, 896, 921, 962, 978, 987, 1065, 1066.
+\:\\{right\_u}, \[528], 531, 532, 534, 535, 537.
+\:\\{right\_x}, \[255], 256, 261, 265, 266, 271, 282, 299, 302, 393, 397, 404,
+405, 407, 409, 410, 411, 412, 415, 416, 418, 419, 421, 423, 424, 425, 434, 436,
+441, 444, 447, 457, 468, 486, 492, 496, 512, 518, 528, 543, 558, 563, 866, 884,
+890, 896, 962, 987, 1065, 1066.
+\:\\{right\_y}, \[255], 256, 261, 265, 266, 271, 282, 299, 302, 393, 397, 404,
+405, 410, 413, 414, 415, 416, 419, 423, 424, 425, 437, 439, 444, 447, 457, 468,
+486, 492, 496, 512, 518, 528, 543, 558, 563, 866, 884, 890, 896, 962, 987,
+1065, 1066.
+\:\\{ring\_delete}, \[620], 809.
+\:\\{ring\_merge}, \[622], 1003.
+\:\\{rising}, \[497].
+\:\\{rlink}, \[166], 167, 168, 169, 171, 172, 173, 174, 176, 182, 1194, 1195,
+1207.
+\:\\{rm}, \[357], 358, 359.
+\:\\{root}, \[188], 229, 230, 234, 239, 254, 702.
+\:\\{rotate}, 389.
+\:\9{rotated\_}{\&{rotated} primitive}, \[893].
+\:\\{rotated\_by}, \[189], 893, 952, 957.
+\:\\{round\_decimals}, \[102], 103, 674.
+\:\\{round\_fraction}, \[119], 590, 600, 817, 819, 906, 958, 1010.
+\:\\{round\_unscaled}, \[119], 374, 375, 376, 575, 576, 790, 906, 912, 965,
+977, 1056, 1070, 1071, 1073, 1103, 1106, 1137, 1163, 1165, 1181, 1200.
+\:\\{rover}, \[166], 167, 168, 169, 170, 171, 172, 173, 174, 176, 182, 1194,
+1195, 1207.
+\:\\{row\_node\_size}, \[325], 330, 331, 334, 341, 352, 353, 354, 355, 358,
+364, 385.
+\:\\{row\_transition}, 578, \[579], 580, 582, 583, 584.
+\:\\{rr}, \[242], 245, \[266], \[299], 300, \[334], 335, \[340], \[366], 368, %
+\[922], 939, \[978], 980.
+\:\\{rt}, \[286], 289, 294, 295, \[299], 302.
+\:\\{runaway}, 163, 663, \[665].
+\:\\{r0}, \[574], 575, 576, \[1073].
+\:\\{r1}, 229, \[574], 575, \[1073].
+\:\|{s}, \[43], \[45], \[46], \[58], \[59], \[60], \[62], \[88], \[89], \[90], %
+\[94], \[103], \[167], \[172], \[197], \[210], \[232], \[242], \[257], \[280], %
+\[284], \[311], \[332], \[337], \[340], \[342], \[344], \[346], \[348], \[354],
+\[394], \[398], \[402], \[406], \[419], \[465], \[473], \[477], \[488], \[495],
+\[497], \[506], \[518], \[527], \[594], \[597], \[599], \[600], \[601], \[604],
+\[610], \[754], \[755], \[784], \[786], \[807], \[809], \[824], \[930], \[943],
+\[949], \[966], \[977], \[1160].
+\:\\{s\_scale}, \[585], 589, 608, 610, 817.
+\:\\{safety\_margin}, \[402].
+\:\9{save\_}{\&{save} primitive}, \[211].
+\:\\{save\_boundary\_item}, \[250], 832.
+\:\\{save\_command}, \[186], 211, 212, 1033.
+\:\\{save\_cond\_ptr}, \[748], 749.
+\:\\{save\_exp}, \[651], \[718].
+\:\\{save\_flag}, \[824].
+\:\\{save\_internal}, \[253], 1034.
+\:\\{save\_node\_size}, \[250], 252, 253, 254.
+\:\\{save\_ptr}, \[250], 251, 252, 253, 254.
+\:\\{save\_type}, \[651].
+\:\\{save\_variable}, \[252], 1033.
+\:\\{save\_word}, \[242], 244.
+\:\.{SAVED}, 235.
+\:\\{saved\_equiv}, \[250], 252, 254.
+\:\\{saved\_root}, \[188], 230, 235, 247, 249.
+\:\\{saving}, \[249].
+\:\\{sc}, 153, \[156], 157, 229, 255, 472, 752, 961.
+\:\\{scaled}, \[101], 102, 103, 104, 105, 112, 114, 116, 119, 121, 132, 135,
+150, 151, 152, 153, 156, 187, 190, 194, 214, 215, 228, 229, 250, 259, 279, 280,
+286, 296, 299, 304, 306, 311, 369, 374, 387, 388, 389, 390, 402, 403, 406, 410,
+419, 426, 427, 429, 430, 431, 432, 433, 434, 440, 463, 477, 486, 488, 497, 510,
+511, 527, 539, 542, 555, 574, 585, 587, 588, 594, 599, 600, 602, 607, 612, 798,
+808, 820, 836, 865, 868, 875, 916, 917, 935, 944, 946, 949, 954, 961, 968, 971,
+972, 974, 978, 982, 985, 1073, 1096, 1098, 1117, 1118, 1119, 1120, 1121, 1128,
+1129, 1130, 1144, 1146, 1147, 1182, 1205.
+\:\.{Scaled picture...big}, 340, 342.
+\:\9{scaled\_}{\&{scaled} primitive}, \[893].
+\:\\{scaled\_by}, \[189], 893, 952, 957.
+\:\\{scaled\_threshold}, \[594], 597.
+\:\\{scaling\_down}, \[599], \[600].
+\:\\{scan\_declared\_variable}, 700, \[1011], 1015.
+\:\\{scan\_def}, \[697], 992.
+\:\\{scan\_direction}, \[875], 879, 880.
+\:\\{scan\_expression}, 706, 729, 733, 734, 764, 765, 796, 798, 821, 826, 830,
+839, 846, 859, 861, \[868], 876, 877, 878, 892, 993, 995, 996, 1021, 1040,
+1054, 1059, 1070, 1071, 1072, 1073, 1082, 1103, 1106, 1112, 1115, 1177.
+\:\\{scan\_file\_name}, \[781], 795.
+\:\\{scan\_primary}, 706, 716, 733, 734, 796, 798, 821, \[823], 835, 837, 839,
+842, 862, 882, 884, 893, 1059, 1071, 1074.
+\:\\{scan\_secondary}, 706, 733, 796, 798, 821, \[862], 864.
+\:\\{scan\_suffix}, 706, 729, 735, 764, 840, \[860].
+\:\\{scan\_tertiary}, 706, 733, 796, 798, 821, \[864], 868, 869.
+\:\\{scan\_text\_arg}, 729, \[730], 733.
+\:\\{scan\_tokens}, \[186], 211, 212, 706, 707.
+\:\9{scan\_tokens\_}{\&{scantokens} primitive}, \[211].
+\:\\{scan\_toks}, \[685], 694, 698, 758.
+\:\\{scan\_with}, \[1054], 1062, 1074.
+\:\\{scanner\_status}, \[659], 660, 661, 663, 664, 665, 694, 697, 700, 730,
+742, 758, 991, 1016.
+\:\\{screen\_col}, \[565], 566, 567, 568, 572, 580.
+\:\\{screen\_depth}, \[11], 565, 567, 568, 575.
+\:\\{screen\_OK}, \[569], 570, 574, 577.
+\:\\{screen\_pixel}, \[566], 567, 568.
+\:\\{screen\_row}, \[565], 566, 567, 568, 572.
+\:\\{screen\_started}, \[569], 570.
+\:\\{screen\_width}, \[11], 565, 567, 568, 575.
+\:\\{scroll\_mode}, 66, \[68], 79, 81, 88, 786, 1024, 1025, 1084.
+\:\9{scroll\_mode\_}{\&{scrollmode} primitive}, \[1024].
+\:\\{search\_mem}, 178, \[185], 1213.
+\:\\{second\_octant}, \[139], 141, 380, 387, 388, 396, 435, 443, 449, 461, 462.
+\:\9{secondary\_}{\&{secondary} primitive}, \[695].
+\:\\{secondary\_binary}, \[186], 893, 894.
+\:\9{secondary\_def\_}{\&{secondarydef} primitive}, \[683].
+\:\\{secondary\_macro}, \[226], 227, 695, 696, 733.
+\:\\{secondary\_primary\_macro}, \[186], 249, 683, 684, 862, 1035, 1043.
+\:\.{see the transcript file...}, 1209.
+\:\\{seed}, \[150].
+\:\\{selector}, \[54], 55, 57, 58, 59, 60, 62, 66, 70, 81, 86, 87, 93, 195,
+635, 636, 642, 679, 788, 789, 804, 840, 912, 1022, 1023, 1163, 1164, 1200,
+1205, 1209.
+\:\\{semicolon}, \[186], 211, 212, 713, 732, 832, 989, 990, 991, 1017, 1051,
+1070.
+\:\\{sentinel}, \[175], 177, 324, 328, 330, 331, 332, 335, 339, 343, 344, 345,
+346, 347, 348, 349, 355, 356, 358, 364, 367, 368, 369, 582, 1169.
+\:\\{serial\_no}, \[585], 587, 1198, 1199.
+\:\\{set\_controls}, 297, 298, \[299], 301.
+\:\\{set\_min\_max}, \[554], 558, 559.
+\:\\{set\_output\_file\_name}, \[791], 1163.
+\:\\{set\_tag}, \[1104], 1106, 1111, 1113.
+\:\\{set\_trick\_count}, \[642], 643, 644, 646.
+\:\\{set\_two}, \[387], 388.
+\:\\{set\_two\_end}, \[387].
+\:\\{set\_up\_direction\_time}, 983, \[984].
+\:\\{set\_up\_known\_trans}, \[960], 962, 963, 967.
+\:\\{set\_up\_offset}, 983, \[984].
+\:\\{set\_up\_trans}, \[953], 960, 970.
+\:\\{seventh\_octant}, \[139], 141, 380, 387, 388, 396, 435, 443, 449, 461, 462.
+\:\\{sf}, \[116], 297, \[298], 299, 300, 301.
+\:\9{shifted\_}{\&{shifted} primitive}, \[893].
+\:\\{shifted\_by}, \[189], 893, 952, 957.
+\:\\{ship\_out}, 1070, 1149, \[1165], 1175.
+\:\9{ship\_out\_}{\&{shipout} primitive}, \[211].
+\:\\{ship\_out\_command}, \[186], 211, 212, 1069.
+\:\9{show\_}{\&{show} primitive}, \[1037].
+\:\\{show\_cmd\_mod}, \[626], 713, 895.
+\:\\{show\_code}, \[1037], 1038, 1040, 1051.
+\:\\{show\_command}, \[186], 1037, 1038, 1039.
+\:\\{show\_context}, 54, 73, 77, 83, 634, \[635], 644, 786, 789, 793.
+\:\\{show\_cur\_cmd\_mod}, \[626], 707, 832, 992.
+\:\9{show\_dependencies\_}{\&{showdependencies} primitive}, \[1037].
+\:\\{show\_dependencies\_code}, \[1037], 1051.
+\:\\{show\_macro}, \[227], 645, 721, 1041, 1048.
+\:\9{show\_stats\_}{\&{showstats} primitive}, \[1037].
+\:\\{show\_stats\_code}, \[1037], 1038, 1051.
+\:\9{show\_token\_}{\&{showtoken} primitive}, \[1037].
+\:\\{show\_token\_code}, \[1037], 1038, 1051.
+\:\\{show\_token\_list}, \[217], 224, 227, 235, 639, 640, 645, 646, 665, 722,
+723, 762, 840, 851, 998, 1043, 1057, 1213.
+\:\9{show\_var\_}{\&{showvariable} primitive}, \[1037].
+\:\\{show\_var\_code}, \[1037], 1038, 1051.
+\:\\{showstopping}, \[190], 192, 193, 1051.
+\:\9{showstopping\_}{\&{showstopping} primitive}, \[192].
+\:\\{si}, \[37], 41, 85, 1193.
+\:\9{sin\_d\_}{\&{sind} primitive}, \[893].
+\:\\{sin\_d\_op}, \[189], 893, 906.
+\:\\{sine}, \[280], 281, \[299], 300.
+\:\\{single\_dependency}, \[608], 829, 855, 858, 1007, 1009.
+\:\\{sixth\_octant}, \[139], 141, 379, 380, 387, 388, 395, 396, 443, 448, 449,
+461, 462, 488.
+\:\\{skew}, \[387], 421, 445, 447, 451, 457, 481.
+\:\\{skew\_line\_edges}, 508, \[510], 517, 523.
+\:\\{skimp}, \[1121], 1124, 1126.
+\:\\{skip\_byte}, \[1093], 1107, 1110, 1111, 1112, 1137.
+\:\\{skip\_error}, \[1110], 1111.
+\:\\{skip\_table}, \[1096], 1097, 1110, 1111, 1139.
+\:\\{skip\_to}, \[186], 211, 212, 1107.
+\:\9{skip\_to\_}{\&{skipto} primitive}, \[211].
+\:\\{skipping}, \[659], 661, 742.
+\:\\{skip0}, 1144, \[1145], 1173.
+\:\\{skip1}, 1144, \[1145], 1174.
+\:\\{skip2}, \[1144].
+\:\\{skip3}, \[1144].
+\:\\{slant}, 1095.
+\:\\{slant\_code}, \[1095].
+\:\9{slanted\_}{\&{slanted} primitive}, \[893].
+\:\\{slanted\_by}, \[189], 893, 952, 957.
+\:\\{slash}, \[186], 837, 893, 894.
+\:\\{slow\_add}, \[100], 594, 597, 930, 931, 933.
+\:\\{slow\_case\_down}, \[378], 380.
+\:\\{slow\_case\_up}, \[378], 380.
+\:\\{slow\_print}, \[60], 61, 79, 219, 223, 254, 638, 664, 722, 725, 773, 790,
+793, 802, 994, 998, 999, 1032, 1034, 1041, 1042, 1043, 1082, 1086, 1134, 1182,
+1200, 1205, 1213.
+\:{small computers}, 95.
+\:\\{small\_number}, \[101], 102, 121, 135, 139, 145, 187, 210, 217, 230, 232,
+238, 248, 311, 387, 388, 390, 394, 451, 453, 477, 589, 594, 597, 599, 600, 601,
+610, 621, 651, 685, 738, 746, 778, 796, 801, 805, 809, 843, 875, 900, 930, 935,
+943, 949, 966, 1001, 1015, 1054, 1098, 1104, 1123, 1177, 1209.
+\:\\{smooth\_bot}, \[511], 512, 517, 518, 523.
+\:\\{smooth\_moves}, \[321], 468, 517, 523.
+\:\\{smooth\_top}, \[511], 512, 517, 518, 523.
+\:\\{smoothing}, \[190], 192, 193, 468, 517, 523.
+\:\9{smoothing\_}{\&{smoothing} primitive}, \[192].
+\:\\{so}, \[37], 45, 59, 60, 85, 210, 223, 717, 774, 913, 976, 977, 1103, 1160,
+1192.
+\:\\{solve\_choices}, 278, \[284].
+\:\.{some chardps...}, 1123.
+\:\.{some charhts...}, 1123.
+\:\.{some charics...}, 1123.
+\:\.{some charwds...}, 1123.
+\:\.{Some number got too big}, 270.
+\:\.{Sorry, I can't find...}, 779.
+\:\\{sort\_avail}, \[173], 1194.
+\:\\{sort\_edges}, \[346], 348, 354, 578, 1169.
+\:\\{sort\_in}, \[1117], 1124, 1126.
+\:\\{sorted}, 324, \[325], 328, 330, 331, 332, 335, 339, 343, 344, 345, 346,
+347, 348, 349, 355, 356, 358, 364, 367, 368, 369, 385, 580, 582, 1169.
+\:\\{sorted\_loc}, \[325], 335, 345, 347, 368.
+\:\\{south\_edge}, \[435], 438.
+\:\\{space}, 1095.
+\:\\{space\_class}, \[198], 199, 669.
+\:\\{space\_code}, \[1095].
+\:\\{space\_shrink}, 1095.
+\:\\{space\_shrink\_code}, \[1095].
+\:\\{space\_stretch}, 1095.
+\:\\{space\_stretch\_code}, \[1095].
+\:\\{spec\_atan}, \[137], 138, 143, 147.
+\:\\{spec\_head}, \[506].
+\:\\{spec\_log}, \[129], 131, 133, 136.
+\:\9{special\_}{\&{special} primitive}, \[1176].
+\:\\{special\_command}, \[186], 1175, 1176, 1180.
+\:\\{split\_cubic}, \[410], 411, 412, 415, 416, 424, 425, 493, 980, 981, 986.
+\:\\{split\_for\_offset}, \[493], 499, 503, 504.
+\:\\{spotless}, \[71], 72, 195, 1204, 1209.
+\:\9{sqrt\_}{\&{sqrt} primitive}, \[893].
+\:\\{sqrt\_op}, \[189], 893, 906.
+\:\.{Square root...replaced by 0}, 122.
+\:\\{square\_rt}, \[121], 122, 906.
+\:\\{ss}, \[242], 243, 245, \[299], 300, \[334], 335, \[340], \[978], 980.
+\:\\{st}, \[116], 297, \[298], 299, 300, 301.
+\:\\{st\_count}, \[200], 203, 207, 1196, 1197, 1208.
+\:\\{stack\_argument}, \[737], 760.
+\:\\{stack\_dx}, \[553], 559, 561.
+\:\\{stack\_dy}, \[553], 559, 561.
+\:\\{stack\_l}, \[309], 312, 314.
+\:\\{stack\_m}, \[309], 312, 314.
+\:\\{stack\_max}, \[553], 554, 556.
+\:\\{stack\_min}, \[553], 554, 556.
+\:\\{stack\_n}, \[309], 312, 314.
+\:\\{stack\_r}, \[309], 312, 314.
+\:\\{stack\_s}, \[309], 312, 314.
+\:\\{stack\_size}, \[11], 628, 634, 647, 1208.
+\:\\{stack\_tol}, \[553], 559, 561.
+\:\\{stack\_uv}, \[553], 559, 561.
+\:\\{stack\_xy}, \[553], 559, 561.
+\:\\{stack\_x1}, \[309], 312, 314.
+\:\\{stack\_x2}, \[309], 312, 314.
+\:\\{stack\_x3}, \[309], 312, 314.
+\:\\{stack\_y1}, \[309], 312, 314.
+\:\\{stack\_y2}, \[309], 312, 314.
+\:\\{stack\_y3}, \[309], 312, 314.
+\:\\{stack\_1}, \[553], 554, 559, 560.
+\:\\{stack\_2}, \[553], 554, 559, 560.
+\:\\{stack\_3}, \[553], 554, 559, 560.
+\:\\{start}, 627, \[629], 630, 632, 644, 645, 649, 650, 654, 655, 657, 679,
+681, 682, 714, 717, 794, 897.
+\:\\{start\_decimal\_token}, \[667], 669.
+\:\\{start\_def}, \[683], 684, 697, 698, 700.
+\:\\{start\_field}, \[627], 629.
+\:\\{start\_forever}, \[683], 684, 755.
+\:\\{start\_here}, 5, \[1204].
+\:\\{start\_input}, 706, 709, 711, \[793], 1211.
+\:\\{start\_numeric\_token}, \[667], 669.
+\:\\{start\_of\_MF}, \[6], 1204.
+\:\\{start\_screen}, \[570], 574.
+\:\\{start\_sym}, 1076, \[1077], 1078, 1198, 1199, 1204.
+\:\\{stash\_cur\_exp}, 651, 718, 728, 734, 760, 764, \[799], 800, 801, 837,
+839, 848, 859, 862, 863, 864, 868, 926, 946, 955, 970, 988, 995, 1000.
+\:\\{stash\_in}, \[827], 830, 903.
+\:\&{stat}, \[7], \[160], \[163], \[164], \[165], \[167], \[172], \[177], %
+\[207], \[508], \[510], \[515], \[521], \[1045], \[1134], \[1205].
+\:\\{state}, 670.
+\:\9{step\_}{\&{step} primitive}, \[211].
+\:\\{step\_size}, \[752], 760, 761, 765.
+\:\\{step\_token}, \[186], 211, 212, 764.
+\:{Stern, Moritz Abraham}, 526.
+\:{Stolfi, Jorge}, 469.
+\:\\{stop}, \[186], 732, 991, 1017, 1018, 1019.
+\:\\{stop\_flag}, \[1093], 1107, 1110.
+\:\\{stop\_iteration}, 706, 714, 760, \[763], 1209.
+\:\\{store\_base\_file}, \[1186], 1209.
+\:\9{str\_}{\&{str} primitive}, \[211].
+\:\\{str\_eq\_buf}, \[45], 205.
+\:\\{str\_number}, \[37], 38, 42, 43, 44, 45, 46, 47, 62, 74, 88, 89, 90, 94,
+190, 197, 210, 214, 257, 332, 394, 395, 398, 473, 754, 767, 774, 780, 782, 784,
+785, 786, 791, 807, 824, 976, 977, 1087, 1160, 1183.
+\:\\{str\_op}, \[186], 211, 212, 823.
+\:\\{str\_pool}, 37, \[38], 41, 44, 45, 46, 47, 59, 60, 85, 200, 210, 223, 630,
+707, 717, 774, 913, 976, 977, 1103, 1160, 1192, 1193, 1208.
+\:\\{str\_ptr}, 37, \[38], 40, 43, 44, 47, 59, 60, 210, 218, 772, 780, 793,
+798, 1045, 1163, 1192, 1193, 1199, 1200, 1204.
+\:\\{str\_ref}, \[42], 43, 44, 48, 52, 207, 793, 1193, 1200.
+\:\\{str\_room}, \[41], 207, 671, 771, 780, 897, 912, 976, 977, 1200, 1205.
+\:\\{str\_start}, 37, \[38], 39, 40, 43, 44, 45, 46, 47, 59, 60, 85, 200, 210,
+223, 717, 772, 774, 913, 976, 977, 1103, 1160, 1163, 1192, 1193.
+\:\\{str\_to\_num}, 912, \[913].
+\:\\{str\_vs\_str}, \[46], 936, 1004.
+\:\.{Strange path...}, 1068.
+\:\.{String contains illegal digits}, 914.
+\:{string pool}, 47, 1191.
+\:\9{string\_}{\&{string} primitive}, \[1013].
+\:\\{string\_class}, \[198], 199, 219, 669.
+\:\\{string\_token}, \[186], 671, 678, 691, 743, 823.
+\:\\{string\_type}, \[187], 189, 214, 216, 219, 248, 621, 651, 716, 798, 802,
+808, 809, 833, 840, 855, 895, 897, 912, 915, 918, 919, 936, 975, 993, 1003,
+1004, 1013, 1082, 1103, 1176, 1177.
+\:\\{string\_vacancies}, \[11], 52.
+\:\\{structured}, \[187], 188, 228, 229, 239, 242, 243, 246, 247, 809, 850,
+1046.
+\:\\{structured\_root}, \[188], 229, 236, 239.
+\:\9{subpath\_}{\&{subpath} primitive}, \[893].
+\:\\{subpath\_of}, \[189], 893, 975.
+\:\\{subscr}, \[188], 229, 236, 239, 244, 246, 247, 1047.
+\:\\{subscr\_head}, \[228], 229, 239, 240, 244, 246, 247, 1047.
+\:\\{subscr\_head\_loc}, \[228], 240, 241, 244, 246.
+\:\\{subscr\_node\_size}, \[229], 240, 244, 246, 247.
+\:\\{subscript}, \[229], 236, 240, 244.
+\:\\{subscript\_loc}, \[229], 244.
+\:\\{subst\_list}, \[685], 686.
+\:\9{substring\_}{\&{substring} primitive}, \[893].
+\:\\{substring\_of}, \[189], 893, 975.
+\:\\{succumb}, \[88], 89, 90.
+\:\.{SUFFIX}, 222.
+\:\9{suffix\_}{\&{suffix} primitive}, \[695].
+\:\\{suffix\_base}, \[214], 222, 676, 677, 683, 690, 695, 696, 697, 705, 726,
+729, 755, 764.
+\:\\{suffix\_count}, \[685], 690.
+\:\\{suffix\_macro}, \[226], 227, 705, 733.
+\:\\{suffixed\_macro}, \[187], 700, 798, 809, 845, 1048.
+\:\\{sum}, \[378].
+\:\\{switch}, \[667], 669, 670, 672.
+\:\\{switch\_x\_and\_y}, \[139], 406, 423, 424, 441, 442, 445, 480, 489.
+\:\\{sx}, \[601].
+\:\\{symmetric}, \[527], 528, 530.
+\:{system dependencies}, 2, \[3], 4, 9, 10, 11, 12, 19, 21, 22, 25, 26, 27, 31,
+32, 33, 34, 36, 49, 56, 59, 67, 76, 79, 91, 107, 109, 153, 155, 156, 194, 199,
+564, 567, 568, 631, 637, 654, 766, 767, 768, 769, 770, 771, 772, 773, 774, 775,
+776, 778, 780, 781, 794, 1148, 1152, 1154, 1203, 1204, 1205, 1212, 1214.
+\:\\{s1}, \[77], 83.
+\:\\{s2}, \[77], 83.
+\:\\{s3}, \[77], 83.
+\:\|{t}, \[46], \[116], \[139], \[145], \[167], \[187], \[197], \[238], \[242],
+\[246], \[280], \[284], \[311], \[321], \[340], \[342], \[344], \[398], \[406],
+\[410], \[419], \[493], \[495], \[497], \[542], \[589], \[594], \[597], \[601],
+\[603], \[604], \[610], \[621], \[649], \[801], \[805], \[809], \[843], \[855],
+\[860], \[868], \[875], \[899], \[900], \[930], \[935], \[943], \[949], \[968],
+\[972], \[974], \[1001], \[1006], \[1011], \[1015], \[1029], \[1054], \[1057], %
+\[1104], \[1160], \[1163].
+\:\\{t\_of\_the\_way}, \[410], 411, 415, 424, 499, 503, 504, 547, 548.
+\:\\{t\_of\_the\_way\_end}, \[410].
+\:\\{t\_open\_in}, \[32], 36.
+\:\\{t\_open\_out}, \[32], 1204.
+\:\\{tag}, \[1091], 1092.
+\:\\{tag\_token}, \[186], 202, 229, 234, 242, 249, 254, 702, 823, 844, 850,
+860, 1011, 1035, 1043, 1049.
+\:\\{tail}, \[720], 724, 728, 734, 842, \[843], 844, 845.
+\:\\{tail\_end}, \[685].
+\:\\{take\_fraction}, \[109], 112, 116, 125, 127, 151, 152, 281, 287, 288, 289,
+290, 291, 294, 295, 296, 297, 299, 300, 302, 375, 376, 410, 436, 439, 444, 454,
+498, 516, 522, 530, 533, 543, 594, 595, 596, 599, 943, 944.
+\:\\{take\_part}, 909, \[910], 939.
+\:\\{take\_scaled}, \[112], 594, 595, 596, 599, 942, 943, 961, 968, 971, 974.
+\:\\{tally}, \[54], 55, 57, 58, 217, 227, 235, 636, 639, 640, 641, 642, 643.
+\:\\{tarnished}, 926, 927, \[928], 944.
+\:\&{tats}, \[7].
+\:\\{temp\_head}, \[175], 335, 346, 347, 349, 351, 484, 594, 597, 599, 600,
+601, 612, 616, 1117, 1118, 1121, 1124, 1126.
+\:\\{temp\_val}, \[175], 910, 911.
+\:\\{tension}, \[186], 211, 212, 881.
+\:\9{tension\_}{\&{tension} primitive}, \[211].
+\:\\{term\_and\_log}, \[54], 57, 58, 66, 70, 87, 195, 788, 804, 1200, 1209.
+\:\\{term\_in}, \[31], 32, 33, 35, 36, 66, 1212, 1213.
+\:\\{term\_input}, \[66], 73.
+\:\\{term\_offset}, \[54], 55, 57, 58, 61, 62, 66, 793, 1165.
+\:\\{term\_only}, \[54], 55, 57, 58, 66, 70, 87, 789, 804, 1205, 1209.
+\:\\{term\_out}, \[31], 32, 33, 34, 35, 36, 51, 56.
+\:\\{terminal\_input}, \[631], 637, 654, 656.
+\:\\{terminator}, \[685].
+\:\9{tertiary\_}{\&{tertiary} primitive}, \[695].
+\:\\{tertiary\_binary}, \[186], 893, 894.
+\:\9{tertiary\_def\_}{\&{tertiarydef} primitive}, \[683].
+\:\\{tertiary\_macro}, \[226], 227, 695, 733.
+\:\\{tertiary\_secondary\_macro}, \[186], 249, 683, 684, 864, 1035, 1043.
+\:\\{test\_known}, 918, \[919].
+\:\\{text}, \[200], 202, 203, 205, 206, 207, 210, 218, 254, 638, 664, 722, 725,
+727, 735, 759, 1032, 1034, 1036, 1041, 1043, 1196.
+\:\.{TEXT}, 222.
+\:\.{Text line contains...}, 670.
+\:\9{text\_}{\&{text} primitive}, \[695].
+\:\\{text\_base}, \[214], 222, 677, 695, 697, 723, 729.
+\:\\{text\_char}, \[19], 20, 24, 26, 47.
+\:\\{text\_macro}, \[226], 227, 697, 705, 723, 733.
+\:\9{TFM files}{\.{TFM} files}, 1087.
+\:\\{tfm\_changed}, 1129, \[1130], 1132, 1136, 1140.
+\:\\{tfm\_check}, \[1098], 1099.
+\:\\{tfm\_command}, \[186], 1100, 1101, 1102.
+\:\\{tfm\_depth}, \[1096], 1097, 1099, 1126, 1136.
+\:\\{tfm\_file}, \[1087], 1133, 1134.
+\:\\{tfm\_four}, \[1133], 1136, 1139, 1140.
+\:\\{tfm\_height}, \[1096], 1097, 1099, 1126, 1136.
+\:\\{tfm\_ital\_corr}, \[1096], 1097, 1099, 1126, 1136.
+\:\\{tfm\_out}, \[1133], 1135, 1136, 1139.
+\:\\{tfm\_qqqq}, \[1133], 1139, 1140.
+\:\\{tfm\_two}, \[1133], 1135, 1139.
+\:\\{tfm\_warning}, \[1123], 1124, 1126.
+\:\\{tfm\_width}, \[1096], 1097, 1099, 1124, 1131, 1132, 1136, 1182, 1205.
+\:\.{That makes 100 errors...}, 77.
+\:\.{That transformation...}, 963.
+\:\.{The token...delimiter}, 1032.
+\:\.{The token...quantity}, 1034.
+\:\.{There's unbounded black...}, 1169.
+\:\\{theta}, \[283], 291, 292, 295, 297, \[527], 530, 533, \[542], 544, \[865],
+866.
+\:\\{thing\_to\_add}, \[186], 1052, 1053, 1059.
+\:\\{third\_octant}, \[139], 141, 379, 380, 387, 388, 393, 396, 406, 443, 449,
+461, 462.
+\:\.{This can't happen}, 90.
+\:\9{this can't happen /}{\quad \./}, 107, 114.
+\:\9{this can't happen copy}{\quad copy}, 855.
+\:\9{this can't happen dep}{\quad dep}, 589.
+\:\9{this can't happen endinput}{\quad endinput}, 655.
+\:\9{this can't happen exp}{\quad exp}, 802.
+\:\9{this can't happen if}{\quad if}, 746.
+\:\9{this can't happen m}{\quad m}, 311.
+\:\9{this can't happen recycle}{\quad recycle}, 809.
+\:\9{this can't happen struct}{\quad struct}, 239.
+\:\9{this can't happen token}{\quad token}, 216.
+\:\9{this can't happen var}{\quad var}, 236.
+\:\9{this can't happen xy}{\quad xy}, 362.
+\:\9{this can't happen 0}{\quad 0}, 378.
+\:\.{This variable already...}, 701.
+\:\\{three}, \[101], 296.
+\:\\{three\_bytes}, \[1128], 1129, 1133, 1157, 1182.
+\:\\{three\_choices}, \[156].
+\:\\{three\_l}, \[557], 558, 559, 560, 561.
+\:\\{three\_quarter\_unit}, \[101], 883.
+\:\\{three\_sixty\_deg}, \[106], 145, 292.
+\:\\{three\_sixty\_units}, \[906], 958.
+\:\\{threshold}, \[594], 595, 596, \[597], 598, \[599], \[600], \[1120], 1121.
+\:\\{time}, \[190], 192, 193, 194, 790, 1163, 1211.
+\:\9{time\_}{\&{time} primitive}, \[192].
+\:\\{time\_to\_go}, \[555], 556.
+\:\\{times}, \[189], 837, 859, 893, 941, 944.
+\:\&{tini}, \[8].
+\:\9{to\_}{\&{to} primitive}, \[211].
+\:\\{to\_token}, \[186], 211, 212, 1073.
+\:{token}, 214.
+\:\\{token}, \[188], 214, 215, 219, 651, 678.
+\:\\{token\_list}, \[187], 670, 726, 728, 730, 798, 799, 809, 841, 852, 860,
+996, 1059, 1070, 1071, 1074.
+\:\\{token\_node\_size}, \[214], 215, 216, 651, 694, 704, 705, 755.
+\:\\{token\_recycle}, 216, \[224].
+\:\\{token\_state}, \[632], 652, 672, 712, 736, 795, 1209.
+\:\\{token\_type}, \[632], 635, 636, 638, 645, 649, 650, 653, 714.
+\:\\{tol}, 552, 553, 556, \[557], 558, 559, 560, 561.
+\:\\{tol\_step}, \[552], 557, 559, 561, 562.
+\:\.{Too far to shift}, 965.
+\:\.{Too far to skip}, 1110.
+\:\.{Too many arguments...}, 725.
+\:\\{too\_small}, \[1187], 1189.
+\:\\{top}, \[1094].
+\:\\{top\_row}, \[567], \[572], 574, 577.
+\:\\{toss\_edges}, \[385], 808, 809, 964.
+\:\\{toss\_knot\_list}, \[268], 465, 506, 808, 809, 865, 921, 978, 1064, 1067.
+\:\\{toss\_pen}, 475, \[487].
+\:\\{total\_chars}, \[1149], 1150, 1165, 1182.
+\:\\{total\_weight}, \[369], 921.
+\:\9{total\_weight\_}{\&{totalweight} primitive}, \[893].
+\:\\{total\_weight\_op}, \[189], 893, 921.
+\:\\{trace\_a\_corner}, \[372], 373.
+\:\\{trace\_new\_edge}, \[373], 375, 376, 381, 382, 383, 384.
+\:\\{trace\_x}, \[371], 372, 373.
+\:\\{trace\_y}, \[371], 372, 373.
+\:\\{trace\_yy}, \[371], 372, 373.
+\:\\{tracing}, \[402].
+\:\\{tracing\_capsules}, \[190], 192, 193, 238.
+\:\9{tracing\_capsules\_}{\&{tracingcapsules} primitive}, \[192].
+\:\\{tracing\_choices}, \[190], 192, 193, 269.
+\:\9{tracing\_choices\_}{\&{tracingchoices} primitive}, \[192].
+\:\\{tracing\_commands}, \[190], 192, 193, 707, 713, 748, 760, 832, 895, 898,
+922, 944, 992, 995, 996.
+\:\9{tracing\_commands\_}{\&{tracingcommands} primitive}, \[192].
+\:\\{tracing\_edges}, \[190], 192, 193, 371, 375, 376, 381, 382, 383, 384, 465,
+506, 508, 510, 515, 521.
+\:\9{tracing\_edges\_}{\&{tracingedges} primitive}, \[192].
+\:\\{tracing\_equations}, \[190], 192, 193, 603, 610, 816.
+\:\9{tracing\_equations\_}{\&{tracingequations} primitive}, \[192].
+\:\\{tracing\_macros}, \[190], 192, 193, 720, 728, 734.
+\:\9{tracing\_macros\_}{\&{tracingmacros} primitive}, \[192].
+\:\\{tracing\_online}, \[190], 192, 193, 195, 804.
+\:\9{tracing\_online\_}{\&{tracingonline} primitive}, \[192].
+\:\\{tracing\_output}, \[190], 192, 193, 1165.
+\:\9{tracing\_output\_}{\&{tracingoutput} primitive}, \[192].
+\:\\{tracing\_pens}, \[190], 192, 193, 253, 477.
+\:\9{tracing\_pens\_}{\&{tracingpens} primitive}, \[192].
+\:\\{tracing\_restores}, \[190], 192, 193, 254.
+\:\9{tracing\_restores\_}{\&{tracingrestores} primitive}, \[192].
+\:\\{tracing\_specs}, \[190], 192, 193, 1064.
+\:\9{tracing\_specs\_}{\&{tracingspecs} primitive}, \[192].
+\:\\{tracing\_stats}, 160, \[190], 192, 193, 1134, 1198, 1205.
+\:\9{tracing\_stats\_}{\&{tracingstats} primitive}, \[192].
+\:\\{tracing\_titles}, \[190], 192, 193, 994.
+\:\9{tracingtitles\_}{\&{tracingtitles} primitive}, \[192].
+\:\\{trans}, \[961], 962.
+\:\\{trans\_spec}, \[565], 568, 579.
+\:\.{Transcript written...}, 1205.
+\:\.{Transform components...}, 960.
+\:\9{transform\_}{\&{transform} primitive}, \[1013].
+\:\\{transform\_node\_size}, \[230], 231, 233, 956.
+\:\\{transform\_type}, \[187], 216, 230, 231, 232, 233, 248, 798, 799, 800,
+802, 808, 809, 855, 909, 918, 919, 926, 927, 936, 944, 952, 953, 955, 967, 970,
+973, 1003, 1013, 1015.
+\:\9{transformed\_}{\&{transformed} primitive}, \[893].
+\:\\{transformed\_by}, \[189], 893, 952, 953, 957.
+\:\.{transition line...}, 515, 521.
+\:\\{trick\_buf}, \[54], 58, 641, 643.
+\:\\{trick\_count}, \[54], 58, 641, 642, 643.
+\:\\{trivial\_knot}, 484, 485, \[486].
+\:\\{true}, 4, 16, 30, 33, 36, 45, 49, 51, 53, 66, 72, 83, 92, 93, 97, 100,
+107, 109, 110, 112, 114, 124, 126, 135, 181, 182, 238, 257, 269, 332, 372, 394,
+402, 407, 426, 446, 452, 454, 455, 473, 477, 497, 503, 504, 530, 564, 567, 568,
+569, 570, 574, 577, 592, 593, 595, 596, 598, 599, 600, 621, 653, 654, 661, 670,
+672, 675, 680, 681, 700, 711, 767, 771, 779, 788, 801, 886, 899, 913, 942, 946,
+968, 969, 977, 978, 1003, 1009, 1010, 1054, 1056, 1064, 1072, 1086, 1099, 1112,
+1137, 1165, 1187.
+\:\9{true\_}{\&{true} primitive}, \[893].
+\:\\{true\_code}, \[189], 713, 748, 750, 798, 802, 892, 893, 895, 905, 906,
+918, 919, 920, 940.
+\:\\{try\_eq}, 1003, 1005, \[1006].
+\:\\{tt}, \[167], 169, \[539], 541, 547, 548, \[594], 595, 596, 842, \[843],
+844, 845, 850, \[1006], 1009, 1010.
+\:\\{turning\_check}, \[190], 192, 193, 1068.
+\:\9{turning\_check\_}{\&{turningcheck} primitive}, \[192].
+\:\\{turning\_number}, \[403], 450, 459, 917, 1068.
+\:\9{turning\_number\_}{\&{turningnumber} primitive}, \[893].
+\:\\{turning\_op}, \[189], 893, 917.
+\:\\{two}, \[101], 102, 256, 294, 295, 556, 895, 898, 922, 944, 995, 996.
+\:\\{two\_choices}, \[156].
+\:\\{two\_halves}, \[156], 161, 166, 185, 201.
+\:\\{two\_to\_the}, \[129], 131, 133, 136, 143, 147, 314, 317, 608, 616.
+\:\\{tx}, \[374], 375, 376, \[511], 516, 522, 866, 867, 953, \[954], 956, 960,
+961, 962, 965, 967, 973.
+\:\\{txx}, 866, 953, \[954], 956, 960, 961, 963, 964, 967, 973.
+\:\\{txy}, 866, 953, \[954], 956, 960, 961, 963, 967, 973.
+\:\\{ty}, \[511], 516, 522, 866, 867, 953, \[954], 956, 960, 961, 962, 965,
+967, 973.
+\:\\{type}, \[4], 188, \[214], 215, 216, 219, 228, 229, 232, 233, 234, 239,
+242, 243, 244, 245, 246, 247, 248, 585, 587, 589, 595, 596, 598, 599, 600, 603,
+604, 605, 614, 615, 619, 621, 651, 678, 700, 738, 744, 745, 746, 799, 800, 801,
+803, 809, 812, 819, 827, 829, 830, 842, 850, 855, 856, 857, 858, 868, 873, 899,
+903, 910, 919, 923, 926, 928, 929, 930, 931, 932, 935, 936, 939, 940, 941, 942,
+943, 946, 947, 948, 949, 951, 952, 956, 957, 959, 966, 968, 969, 971, 972, 975,
+982, 983, 988, 995, 1000, 1001, 1002, 1006, 1007, 1009, 1015, 1046, 1048, 1050,
+1057.
+\:\.{Type <return> to proceed...}, 80.
+\:\\{type\_name}, \[186], 823, 989, 992, 1013, 1014, 1015.
+\:\\{type\_range}, \[918].
+\:\\{type\_range\_end}, \[918].
+\:\\{type\_test}, \[918].
+\:\\{type\_test\_end}, \[918].
+\:\\{tyx}, 866, 953, \[954], 956, 960, 961, 963, 967, 973.
+\:\\{tyy}, 866, 953, \[954], 956, 960, 961, 963, 964, 967, 973.
+\:\\{t0}, \[495], \[497], 498, 503, \[599], \[600].
+\:\\{t1}, \[495], \[497], 498, 499, 503, \[599], \[600].
+\:\\{t2}, \[495], \[497], 498, 499, 503.
+\:\|{u}, \[152], \[311], \[344], \[432], \[527], \[946], \[968], \[972], \[974].
+\:\\{u\_packet}, \[553], 556, 559, 560.
+\:\\{ul\_packet}, \[553], 559.
+\:\\{unary}, \[186], 823, 893, 894.
+\:\\{und\_type}, \[248], 1000.
+\:\\{undefined}, \[187], 229, 234, 239, 242, 244, 245, 247, 248, 585, 809, 842,
+844, 845, 850, 1046.
+\:\.{Undefined condition...}, 892.
+\:\.{Undefined coordinates...}, 872, 873, 878.
+\:\\{undefined\_label}, \[1096], 1097, 1110, 1111, 1137, 1139, 1141.
+\:\\{undump}, \[1189], 1193, 1195, 1197, 1199.
+\:\\{undump\_end}, \[1189].
+\:\\{undump\_end\_end}, \[1189].
+\:\\{undump\_four\_ASCII}, \[1193].
+\:\\{undump\_hh}, \[1189], 1197.
+\:\\{undump\_int}, \[1189], 1191, 1195, 1197, 1199.
+\:\\{undump\_qqqq}, \[1189], 1193.
+\:\\{undump\_size}, \[1189], 1193.
+\:\\{undump\_size\_end}, \[1189].
+\:\\{undump\_size\_end\_end}, \[1189].
+\:\\{undump\_wd}, \[1189], 1195.
+\:\\{unequal\_to}, \[189], 893, 936, 937.
+\:\\{unif\_rand}, \[151], 906.
+\:\\{uniform\_deviate}, \[189], 893, 906.
+\:\9{uniform\_deviate\_}{\&{uniformdeviate} primitive}, \[893].
+\:\\{unity}, \[101], 103, 112, 114, 115, 116, 119, 132, 194, 233, 256, 258,
+271, 282, 288, 294, 295, 296, 300, 302, 311, 374, 375, 376, 402, 430, 431, 433,
+462, 463, 508, 510, 515, 516, 521, 522, 530, 539, 548, 555, 556, 562, 590, 674,
+675, 707, 713, 748, 760, 816, 817, 819, 876, 881, 883, 886, 887, 890, 891, 896,
+906, 913, 915, 916, 917, 932, 943, 949, 960, 963, 964, 968, 969, 972, 974, 978,
+980, 985, 1010, 1068, 1071, 1074, 1097, 1128, 1133, 1157, 1158, 1166, 1182,
+1211.
+\:\.{Unknown relation...}, 937.
+\:\.{Unknown value...ignored}, 1021.
+\:\9{unknown\_}{\&{unknown} primitive}, \[893].
+\:\\{unknown\_boolean}, \[187], 229, 248, 618, 798, 799, 918, 936.
+\:\\{unknown\_op}, \[189], 893, 918.
+\:\\{unknown\_path}, \[187], 248, 618, 798, 918, 995, 1003.
+\:\\{unknown\_pen}, \[187], 248, 618, 798.
+\:\\{unknown\_picture}, \[187], 248, 618, 798, 918.
+\:\\{unknown\_string}, \[187], 248, 618, 798, 918, 936.
+\:\\{unknown\_tag}, \[187], 621, 1003, 1015.
+\:\\{unknown\_types}, \[187], 216, 799, 800, 802, 808, 809, 855, 1003.
+\:\\{unrotate}, 389.
+\:\\{unsave}, \[254], 832.
+\:\\{unskew}, \[388], 394, 421, 445, 447, 451, 454, 457, 485, 488, 510.
+\:\\{unsorted}, 324, \[325], 326, 328, 330, 331, 332, 335, 338, 343, 344, 346,
+348, 354, 355, 364, 367, 368, 369, 375, 376, 381, 382, 383, 384, 385, 578, 1169.
+\:\\{unstash\_cur\_exp}, 718, \[800], 801, 859, 870, 926, 942, 946, 948, 962,
+963, 988, 995, 1000.
+\:\\{unsuffixed\_macro}, \[187], 700, 798, 809, 842, 844, 845, 1046, 1048.
+\:\.{Unsuitable expression}, 1178.
+\:\9{until\_}{\&{until} primitive}, \[211].
+\:\\{until\_token}, \[186], 211, 212, 765.
+\:\\{update\_screen}, \[564], 569, 571, 574, 577.
+\:\\{update\_terminal}, \[33], 36, 61, 66, 81, 564, 681, 779, 793, 994, 1165,
+1212.
+\:\\{ur\_packet}, \[553], 558, 559.
+\:\\{use\_err\_help}, \[74], 75, 84, 86, 1086.
+\:\\{uu}, \[283], 285, 287, 288, 290, 291, 293, 294, 295, 297.
+\:\\{uv}, 553, 556, \[557], 558, 559, 560, 561.
+\:\\{u1l}, \[553], 559.
+\:\\{u1r}, \[553], 558, 559.
+\:\\{u2l}, \[553], 559.
+\:\\{u2r}, \[553], 558, 559.
+\:\\{u3l}, \[553], 559.
+\:\\{u3r}, \[553], 558, 559.
+\:\|{v}, \[215], \[217], \[410], \[432], \[497], \[527], \[589], \[594], %
+\[597], \[599], \[600], \[601], \[607], \[610], \[621], \[801], \[808], \[809],
+\[820], \[900], \[922], \[930], \[935], \[943], \[944], \[946], \[949], \[961],
+\[971], \[972], \[974], \[985], \[1001], \[1117], \[1121].
+\:\\{v\_is\_scaled}, \[599], \[943].
+\:\\{v\_packet}, \[553], 556, 559, 560.
+\:\\{vacuous}, \[187], 216, 219, 248, 621, 764, 798, 799, 800, 802, 809, 827,
+844, 855, 919, 989, 992, 993, 996, 1003, 1054, 1059, 1070, 1071, 1074.
+\:\\{val\_too\_big}, \[602], 603, 615.
+\:\\{valid\_range}, \[326], 329, 965.
+\:\\{value}, \[214], 215, 216, 219, 220, 228, 229, 230, 232, 233, 239, 242,
+244, 246, 250, 253, 254, 585, 587, 589, 590, 591, 594, 595, 596, 597, 598, 599,
+600, 601, 603, 604, 605, 607, 608, 609, 610, 611, 612, 615, 616, 617, 619, 620,
+621, 622, 651, 678, 685, 686, 694, 698, 700, 704, 705, 752, 755, 760, 765, 798,
+799, 800, 801, 803, 806, 809, 812, 814, 816, 817, 818, 819, 827, 829, 830, 845,
+853, 855, 857, 858, 872, 873, 899, 903, 904, 907, 910, 915, 919, 928, 929, 930,
+931, 933, 935, 936, 938, 939, 940, 942, 943, 944, 946, 948, 949, 951, 955, 956,
+957, 958, 959, 966, 967, 968, 969, 970, 971, 972, 973, 974, 975, 976, 977, 978,
+982, 983, 984, 988, 1000, 1001, 1005, 1006, 1007, 1008, 1009, 1010, 1015, 1048,
+1057, 1072, 1116, 1117, 1118, 1121, 1122, 1127, 1132, 1136, 1182.
+\:\.{Value is too large}, 602.
+\:\\{value\_loc}, \[214], 587, 605, 812, 827, 947.
+\:\\{value\_node\_size}, \[228], 233, 234, 239, 247, 249, 603, 615, 619, 650,
+763, 799, 800, 808, 827, 830, 837, 855, 856, 857, 858, 903, 910, 922, 925, 931,
+942, 944, 947, 955, 970, 982, 1001, 1006, 1117.
+\:\\{var\_def}, \[683], 684, 697, 992.
+\:\9{var\_def\_}{\&{vardef} primitive}, \[683].
+\:\\{var\_defining}, \[659], 664, 665, 700.
+\:\\{var\_flag}, \[821], 822, 823, 824, 868, 993, 995, 996, 1059, 1070, 1071,
+1074.
+\:\\{var\_used}, \[160], 167, 172, 176, 1045, 1194, 1195.
+\:\.{Variable x is the wrong type}, 1057.
+\:\.{Variable...obliterated}, 851.
+\:\\{velocity}, \[116], 275, 299.
+\:\\{verbosity}, \[801], 802, 803, 804, \[805], 1040.
+\:\.{VIRMF}, 1203.
+\:{virtual memory}, 168.
+\:{Vitter, Jeffrey Scott}, 208.
+\:\\{vl\_packet}, \[553], 559.
+\:\\{void}, \[324], 326, 328, 330, 331, 332, 335, 338, 343, 344, 346, 348, 354,
+367, 368, 369, 385, 578, 639, 650, 719, 723, 752, 755, 760, 762, 763, 799, 926,
+927, 928, 944, 1169.
+\:\\{vppp}, \[190], 192, 193, \[1146], 1182.
+\:\9{vppp\_}{\&{vppp} primitive}, \[192].
+\:\\{vr\_packet}, \[553], 558, 559.
+\:\\{vv}, \[283], 285, 290, 291, 293, 294, 295, 297, \[809], 817, \[935], %
+\[972].
+\:\\{v1l}, \[553], 559.
+\:\\{v1r}, \[553], 558, 559.
+\:\\{v2l}, \[553], 559.
+\:\\{v2r}, \[553], 558, 559.
+\:\\{v3l}, \[553], 559.
+\:\\{v3r}, \[553], 558, 559.
+\:\|{w}, \[157], \[333], \[342], \[348], \[357], \[373], \[473], \[476], %
+\[477], \[484], \[487], \[488], \[491], \[497], \[510], \[511], \[580], \[599],
+\[600], \[610], \[1059], \[1074], \[1165], \[1186], \[1187].
+\:\\{w\_close}, \[27], 1201, 1211.
+\:\\{w\_hi}, \[348], 349.
+\:\\{w\_in}, \[348], 349, \[1074], 1075.
+\:\\{w\_lo}, \[348], 349.
+\:\\{w\_make\_name\_string}, \[780], 1200.
+\:\\{w\_open\_in}, \[26], 779.
+\:\\{w\_open\_out}, \[26], 1200.
+\:\\{w\_out}, \[348], 349, \[1074], 1075.
+\:\\{wake\_up\_terminal}, \[33], 36, 51, 66, 68, 398, 682, 779, 786, 807, 1051,
+1187, 1205, 1212.
+\:\\{warning\_check}, \[190], 192, 193, 602.
+\:\9{warning\_check\_}{\&{warningcheck} primitive}, \[192].
+\:\\{warning\_info}, \[659], 661, 664, 694, 698, 700, 701, 730, 742, 758.
+\:\\{warning\_issued}, \[71], 195, 1209.
+\:\\{was\_free}, \[178], 180, 184.
+\:\\{was\_hi\_min}, \[178], 179, 180, 184.
+\:\\{was\_lo\_max}, \[178], 179, 180, 184.
+\:\\{was\_mem\_end}, \[178], 179, 180, 184.
+\:\\{watch\_coefs}, \[592], 593, 595, 596, 598, 1010.
+\:\\{we\_found\_it}, \[547], 548, 549.
+\:\.{WEB}, 1, 4, 37, 39, 50, 1191.
+\:\.{Weight must be...}, 1056.
+\:\\{west\_edge}, \[435].
+\:\\{white}, \[565], 567, 568, 577, 579, 583, 584, 1143, 1144.
+\:\\{width\_index}, \[1091].
+\:\\{window\_number}, \[571], 572, 574, 577.
+\:\\{window\_open}, \[572], 573, 574, 1071.
+\:\\{window\_time}, \[572], 573, 574, 577.
+\:{Wirth, Niklaus}, 10.
+\:\\{with\_option}, \[186], 1052, 1053, 1062, 1074.
+\:\9{with\_pen\_}{\&{withpen} primitive}, \[1052].
+\:\9{with\_weight\_}{\&{withweight} primitive}, \[1052].
+\:\\{wlog}, \[56], 58, 564, 568, 790, 1208.
+\:\\{wlog\_cr}, \[56], 57, 58, 567, 1205.
+\:\\{wlog\_ln}, \[56], 564, 567, 568, 1141, 1208.
+\:\\{word\_file}, 24, 26, 27, \[156], 780, 1188.
+\:\\{write}, 36, 56, 1133, 1154.
+\:\\{write\_gf}, \[1154], 1155, 1156.
+\:\\{write\_ln}, 34, 36, 51, 56.
+\:\\{wterm}, \[56], 58, 61.
+\:\\{wterm\_cr}, \[56], 57, 58.
+\:\\{wterm\_ln}, \[56], 61, 779, 1187, 1204.
+\:\\{ww}, \[283], 285, 290, 291, 293, 294, \[348], 349, \[357], 362, \[473],
+474, \[484], 485, \[487], \[488], \[491], \[497], 498, 502, 503, 508, 509, %
+\[510], \[511], 513, 519, \[580], 582, 583, 584, \[1165], 1169.
+\:\\{www}, \[506], 508.
+\:\|{x}, \[100], \[104], \[119], \[121], \[132], \[135], \[139], \[145], %
+\[149], \[151], \[152], \[234], \[387], \[388], \[390], \[391], \[463], \[486],
+\[488], \[539], \[574], \[591], \[601], \[602], \[604], \[610], \[868], \[875],
+\[898], \[982], \[1011], \[1129], \[1131], \[1133], \[1157], \[1158], \[1186], %
+\[1187], \[1205].
+\:\\{x\_coord}, \[255], 256, 258, 265, 266, 271, 281, 282, 299, 302, 393, 394,
+397, 404, 405, 406, 407, 409, 410, 411, 412, 413, 415, 416, 418, 419, 421, 423,
+424, 425, 434, 436, 441, 442, 444, 445, 447, 451, 457, 467, 468, 472, 473, 474,
+475, 476, 477, 479, 481, 483, 484, 485, 486, 488, 492, 493, 496, 498, 502, 508,
+509, 510, 512, 513, 515, 518, 519, 521, 528, 534, 535, 536, 537, 543, 558, 563,
+866, 867, 871, 887, 896, 962, 980, 981, 986, 987, 1066.
+\:\\{x\_corr}, \[461], 462, 463.
+\:\\{x\_height}, 1095.
+\:\\{x\_height\_code}, \[1095].
+\:\\{x\_off}, \[332], \[333], \[1165], 1166, 1169, 1172.
+\:\\{x\_offset}, \[190], 192, 193, 1165.
+\:\9{x\_offset\_}{\&{xoffset} primitive}, \[192].
+\:\\{x\_packet}, \[553], 556, 559, 560.
+\:\\{x\_part}, \[189], 893, 909, 910, 939.
+\:\9{x\_part\_}{\&{xpart} primitive}, \[893].
+\:\\{x\_part\_loc}, \[230], 830, 873, 899, 903, 907, 915, 929, 942, 944, 946,
+947, 948, 956, 957, 959, 967, 970, 973, 977, 978, 982, 984, 1072.
+\:\\{x\_part\_sector}, \[188], 230, 232, 235, 237, 238.
+\:\\{x\_reflect\_edges}, \[337], 964.
+\:\\{x\_scale\_edges}, \[342], 964.
+\:\\{x\_scaled}, \[189], 893, 952, 957.
+\:\9{x\_scaled\_}{\&{xscaled} primitive}, \[893].
+\:\\{xchr}, \[20], 21, 22, 23, 37, 49, 58, 774.
+\:\&{xclause}, 16.
+\:\\{xi\_corr}, 306, \[311], 313, 314, 317.
+\:\\{xl\_packet}, \[553], 559.
+\:\\{xord}, \[20], 23, 30, 52, 53, 778, 780.
+\:\\{xp}, \[511], 515, 516, 521, 522.
+\:\\{xq}, \[410].
+\:\\{xr\_packet}, \[553], 558, 559.
+\:\\{xw}, 362, \[363].
+\:\\{xx}, \[391], 392, \[511], 515, 516, 521, 522.
+\:\\{xx\_part}, \[189], 893, 909.
+\:\9{xx\_part\_}{\&{xxpart} primitive}, \[893].
+\:\\{xx\_part\_loc}, \[230], 233, 956, 957, 958, 959, 967, 970, 973.
+\:\\{xx\_part\_sector}, \[188], 230, 237.
+\:\\{xxx1}, 1144, \[1145], 1160.
+\:\\{xxx2}, \[1144].
+\:\\{xxx3}, 1144, \[1145], 1160.
+\:\\{xxx4}, \[1144].
+\:\\{xx0}, \[311].
+\:\\{xx1}, \[311].
+\:\\{xx2}, \[311].
+\:\\{xx3}, \[311].
+\:\\{xy}, 553, 556, \[557], 558, 559, 560, 561.
+\:\\{xy\_corr}, \[461], 462, 468, 512, 513, 515, 516, 518, 519, 521, 522.
+\:\\{xy\_part}, \[189], 893, 909.
+\:\9{xy\_part\_}{\&{xypart} primitive}, \[893].
+\:\\{xy\_part\_loc}, \[230], 956, 957, 958, 959, 967, 970, 973.
+\:\\{xy\_part\_sector}, \[188], 230, 237.
+\:\\{xy\_round}, 402, \[433].
+\:\\{xy\_swap\_edges}, \[354], 963.
+\:\\{x0}, \[374], 375, 376, \[391], 392, \[495], 496, \[497], 498, 499, 501,
+503, 504, 505, \[510].
+\:\\{x0a}, \[495], 504.
+\:\\{x1}, \[311], 312, 313, 314, 317, 318, \[374], \[391], 392, \[495], 496, %
+\[497], 498, 499, 501, 503, 504, 505, \[510], 541, \[542], 543, 544, 546, 547,
+548, 549.
+\:\\{x1a}, \[495], 503, 504.
+\:\\{x1l}, \[553], 559.
+\:\\{x1r}, \[553], 558, 559.
+\:\\{x2}, \[311], 312, 313, 314, 317, 318, \[391], 392, \[495], 496, \[497],
+498, 499, 501, 503, 504, 505, \[542], 543, 546, 547, 548, 549.
+\:\\{x2a}, \[311], 317, 318, \[495], 503.
+\:\\{x2l}, \[553], 559.
+\:\\{x2r}, \[553], 558, 559.
+\:\\{x3}, \[311], 312, 313, 314, 317, 318, 541, \[542], 543, 546, 547, 548, 549.
+\:\\{x3a}, \[311], 317, 318.
+\:\\{x3l}, \[553], 559.
+\:\\{x3r}, \[553], 558, 559.
+\:\|{y}, \[100], \[104], \[121], \[132], \[135], \[139], \[145], \[151], %
+\[387], \[388], \[390], \[463], \[486], \[488], \[539], \[574], \[868], \[982].
+\:\\{y\_coord}, \[255], 256, 258, 265, 266, 271, 281, 282, 299, 302, 393, 394,
+397, 404, 405, 406, 407, 409, 410, 413, 414, 415, 416, 419, 421, 423, 424, 425,
+435, 437, 439, 444, 445, 447, 451, 457, 467, 468, 472, 473, 474, 475, 476, 477,
+479, 481, 483, 484, 485, 486, 488, 492, 493, 496, 498, 502, 508, 509, 510, 512,
+515, 518, 521, 528, 534, 535, 536, 537, 543, 558, 563, 866, 867, 871, 887, 896,
+962, 980, 981, 986, 987, 1066.
+\:\\{y\_corr}, \[461], 462, 463, 468, 512, 515, 516, 518, 521, 522.
+\:\\{y\_off}, \[332], \[1165], 1166, 1167, 1172.
+\:\\{y\_offset}, \[190], 192, 193, 1165.
+\:\9{y\_offset\_}{\&{yoffset} primitive}, \[192].
+\:\\{y\_packet}, \[553], 556, 559, 560.
+\:\\{y\_part}, \[189], 893, 909.
+\:\9{y\_part\_}{\&{ypart} primitive}, \[893].
+\:\\{y\_part\_loc}, \[230], 830, 873, 899, 903, 907, 915, 929, 942, 944, 946,
+947, 948, 956, 957, 959, 967, 970, 973, 977, 978, 982, 984, 1072.
+\:\\{y\_part\_sector}, \[188], 230, 237.
+\:\\{y\_reflect\_edges}, \[336], 964.
+\:\\{y\_scale\_edges}, \[340], 964.
+\:\\{y\_scaled}, \[189], 893, 952, 957.
+\:\9{y\_scaled\_}{\&{yscaled} primitive}, \[893].
+\:\\{year}, \[190], 192, 193, 194, 790, 1163, 1200.
+\:\9{year\_}{\&{year} primitive}, \[192].
+\:\\{yl\_packet}, \[553], 559.
+\:\.{You have to increase POOLSIZE}, 52.
+\:\.{You want to edit file x}, 79.
+\:\\{yp}, \[511], 515, 516, 521, 522.
+\:\\{yq}, \[410].
+\:\\{yr\_packet}, \[553], 558, 559.
+\:\\{yt}, \[374].
+\:\\{yx\_part}, \[189], 893, 909.
+\:\9{yx\_part\_}{\&{yxpart} primitive}, \[893].
+\:\\{yx\_part\_loc}, \[230], 956, 958, 959, 967, 970, 973.
+\:\\{yx\_part\_sector}, \[188], 230, 237.
+\:\\{yy}, \[511], 515, 516, 521, 522.
+\:\\{yy\_part}, \[189], 893, 909.
+\:\9{yy\_part\_}{\&{yypart} primitive}, \[893].
+\:\\{yy\_part\_loc}, \[230], 233, 956, 957, 958, 959, 967, 970, 973.
+\:\\{yy\_part\_sector}, \[188], 230, 237.
+\:\\{yyy}, 1144, \[1145], 1147, 1166, 1177.
+\:\\{yy0}, \[311].
+\:\\{yy1}, \[311].
+\:\\{yy2}, \[311].
+\:\\{yy3}, \[311].
+\:\\{y0}, \[374], 375, 376, \[495], 496, \[497], 498, 499, 501, 503, 504, 505, %
+\[510].
+\:\\{y0a}, \[495], 504.
+\:\\{y1}, \[311], 312, 313, 314, 317, 318, \[374], 375, 376, \[495], 496, %
+\[497], 498, 499, 501, 503, 504, 505, \[510], 541, \[542], 543, 544, 546, 547,
+548.
+\:\\{y1a}, \[495], 503, 504.
+\:\\{y1l}, \[553], 559.
+\:\\{y1r}, \[553], 558, 559.
+\:\\{y2}, \[311], 312, 313, 314, 317, 318, \[495], 496, \[497], 498, 499, 501,
+503, 504, 505, \[542], 543, 546, 547, 548.
+\:\\{y2a}, \[311], 317, 318, \[495], 503.
+\:\\{y2l}, \[553], 559.
+\:\\{y2r}, \[553], 558, 559.
+\:\\{y3}, \[311], 312, 313, 314, 317, 318, 541, \[542], 543, 546, 547, 548.
+\:\\{y3a}, \[311], 317, 318.
+\:\\{y3l}, \[553], 559.
+\:\\{y3r}, \[553], 558, 559.
+\:\|{z}, \[132], \[135], \[139], \[145].
+\:\\{z\_corr}, \[461], 462, 463.
+\:\\{z\_scaled}, \[189], 893, 952, 957.
+\:\9{z\_scaled\_}{\&{zscaled} primitive}, \[893].
+\:{Zabala Salelles, Ignacio Andres}, 812.
+\:\\{zero\_crossing}, \[391].
+\:\\{zero\_field}, \[326], 328, 329, 332, 336, 337, 340, 342, 352, 364, 365,
+366, 370, 374, 377, 378, 577, 1167, 1172.
+\:\\{zero\_val}, \[175], 1126, 1127.
+\:\\{zero\_w}, \[324], 326, 333, 337, 349, 350, 358, 365, 370, 373, 375, 376,
+381, 382, 383, 384, 582, 1169.
+\fin
+\:\X1060:Abandon edges command because there's no variable\X
+\Us1059, 1070, 1071\ETs1074.
+\:\X703:Absorb delimited parameters, putting them into lists \|q and \|r\X
+\U697.
+\:\X704:Absorb parameter tokens for type \\{base}\X
+\U703.
+\:\X705:Absorb undelimited parameters, putting them into list \|r\X
+\U697.
+\:\X931:Add a known value to the constant term of $\\{dep\_list}(\|p)$\X
+\U930.
+\:\X1010:Add dependency list \\{pp} of type \\{tt} to dependency list~\|p of
+type~\|t\X
+\U1009.
+\:\X382:Add edges for fifth or eighth octants, then \&{goto} \\{done}\X
+\U378.
+\:\X381:Add edges for first or fourth octants, then \&{goto} \\{done}\X
+\U378.
+\:\X383:Add edges for second or third octants, then \&{goto} \\{done}\X
+\U378.
+\:\X384:Add edges for sixth or seventh octants, then \&{goto} \\{done}\X
+\U378.
+\:\X932:Add operand \|p to the dependency list \|v\X
+\U930.
+\:\X929:Add or subtract the current expression from \|p\X
+\U922.
+\:\X370:Add the contribution of node \|q to the total weight, and set $\|q\K%
+\\{link}(\|q)$\X
+\Us369\ET369.
+\:\X933:Add the known $\\{value}(\|p)$ to the constant term of \|v\X
+\U932.
+\:\X1009:Add the right operand to list \|p\X
+\U1006.
+\:\X936, 940, 941, 948, 951, 952, 975, 983, 988:Additional cases of binary
+operators\X
+\U922.
+\:\X905, 906, 907, 909, 912, 915, 917, 918, 920, 921:Additional cases of unary
+operators\X
+\U898.
+\:\X291:Adjust $\theta_n$ to equal $\theta_0$ and \&{goto} \\{found}\X
+\U287.
+\:\X731:Adjust the balance for a delimited argument; \&{goto} \\{done} if done\X
+\U730.
+\:\X732:Adjust the balance for an undelimited argument; \&{goto} \\{done} if
+done\X
+\U730.
+\:\X687:Adjust the balance; \&{goto} \\{done} if it's zero\X
+\U685.
+\:\X575:Adjust the coordinates $(\\{r0},\\{c0})$ and $(\\{r1},\\{c1})$ so that
+they lie in the proper range\X
+\U574.
+\:\X367:Adjust the data of \|h to account for a difference of offsets\X
+\U366.
+\:\X364:Adjust the header to reflect the new edges\X
+\U354.
+\:\X360:Advance pointer \|p to the next vertical edge, after destroying the
+previous one\X
+\U358.
+\:\X359:Advance pointer \|r to the next vertical edge\X
+\U358.
+\:\X560:Advance to the next pair $(\\{cur\_t},\\{cur\_tt})$\X
+\U556.
+\:\X492:Advance \|p to node \|q, removing any ``dead'' cubics that might have
+been introduced by the splitting process\X
+\U491.
+\:\X171:Allocate entire node \|p and \&{goto} \\{found}\X
+\U169.
+\:\X170:Allocate from the top of node \|p and \&{goto} \\{found}\X
+\U169.
+\:\X1002:Announce that the equation cannot be performed\X
+\U1001.
+\:\X728:Append the current expression to \\{arg\_list}\X
+\Us726\ET733.
+\:\X236:Ascend one level, pushing a token onto list \|q and replacing \|p by
+its parent\X
+\U235.
+\:\X999:Assign the current expression to an internal variable\X
+\U996.
+\:\X1000:Assign the current expression to the variable \\{lhs}\X
+\U996.
+\:\X698:Attach the replacement text to the tail of node \|p\X
+\U697.
+\:\X1061:Augment some edges by others\X
+\U1059.
+\:\X662:Back up an outer symbolic token so that it can be reread\X
+\U661.
+\:\X57, 58, 59, 60, 62, 63, 64, 103, 104, 187, 195, 197, 773:Basic printing
+procedures\X
+\U4.
+\:\X530:Calculate integers $\alpha$, $\beta$, $\gamma$ for the vertex
+coordinates\X
+\U528.
+\:\X292:Calculate the given value of $\theta_n$ and \&{goto} \\{found}\X
+\U284.
+\:\X289:Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$\X
+\U287.
+\:\X281:Calculate the turning angles $\psi_k$ and the distances $d_{k,k+1}$;
+set $n$ to the length of the path\X
+\U278.
+\:\X288:Calculate the values $\\{aa}=A_k/B_k$, $\\{bb}=D_k/C_k$, $\\{dd}=(3-%
+\alpha_{k-1})d_{k,k+1}$, $\\{ee}=(3-\beta\k)d_{k-1,k}$, and $%
+\\{cc}=(B_k-u_{k-1}A_k)/B_k$\X
+\U287.
+\:\X290:Calculate the values of $v_k$ and $w_k$\X
+\U287.
+\:\X1020, 1023, 1026, 1030, 1033, 1039, 1058, 1069, 1076, 1081, 1100,
+1175:Cases of \\{do\_statement} that invoke particular commands\X
+\U992.
+\:\X212, 684, 689, 696, 710, 741, 894, 1014, 1019, 1025, 1028, 1038, 1043,
+1053, 1080, 1102, 1109, 1180:Cases of \\{print\_cmd\_mod} for symbolic printing
+of primitives\X
+\U625.
+\:\X866:Change node \|q to a path for an elliptical pen\X
+\U865.
+\:\X563:Change one-point paths into dead cycles\X
+\U562.
+\:\X81:Change the interaction level and \&{return}\X
+\U79.
+\:\X1063:Change the tentative pen\X
+\U1062.
+\:\X701:Change to `\.{a bad variable}'\X
+\U700.
+\:\X615:Change variable \|x from \\{independent} to \\{dependent} or \\{known}\X
+\U610.
+\:\X49:Character \|k cannot be printed\X
+\U48.
+\:\X183:Check flags of unavailable nodes\X
+\U180.
+\:\X756:Check for the presence of a colon\X
+\U755.
+\:\X938:Check if unknowns have been equated\X
+\U936.
+\:\X181:Check single-word \\{avail} list\X
+\U180.
+\:\X727:Check that the proper right delimiter was present\X
+\U726.
+\:\X14, 154, 204, 214, 310, 553, 777:Check the ``constant'' values for
+consistency\X
+\U1204.
+\:\X617:Check the list of linear dependencies\X
+\U180.
+\:\X547:Check the places where $B(y_1,y_2,y_3;t)=0$ to see if $B(x_1,x_2,x_3;t)%
+\ge0$\X
+\U546.
+\:\X53:Check the pool check sum\X
+\U52.
+\:\X1056:Check the tentative weight\X
+\U1054.
+\:\X1068:Check the turning number\X
+\U1064.
+\:\X182:Check variable-size \\{avail} list\X
+\U180.
+\:\X815:Choose a dependent variable to take the place of the disappearing
+independent variable, and change all remaining dependencies accordingly\X
+\U812.
+\:\X891:Choose control points for the path and put the result into \\{cur\_exp}%
+\X
+\U869.
+\:\X1201:Close the base file\X
+\U1186.
+\:\X937:Compare the current expression with zero\X
+\U936.
+\:\X1112:Compile a ligature/kern command\X
+\U1107.
+\:\X9:Compiler directives\X
+\U4.
+\:\X478:Complain about a bad pen path\X
+\U477.
+\:\X1105:Complain about a character tag conflict\X
+\U1104.
+\:\X1178:Complain about improper special operation\X
+\U1177.
+\:\X1055:Complain about improper type\X
+\U1054.
+\:\X1067:Complain about non-cycle and \&{goto} \\{not\_found}\X
+\U1064.
+\:\X409:Complement the \|x coordinates of the cubic between \|p and~\|q\X
+\U407.
+\:\X414:Complement the \|y coordinates of the cubic between \\{pp} and~\\{qq}\X
+\Us413\ET417.
+\:\X1064:Complete the contour filling operation\X
+\U1062.
+\:\X537:Complete the ellipse by copying the negative of the half already
+computed\X
+\U527.
+\:\X664:Complete the error message, and set \\{cur\_sym} to a token that might
+help recover from the error\X
+\U663.
+\:\X536:Complete the half ellipse by reflecting the quarter already computed\X
+\U527.
+\:\X503:Complete the offset splitting process\X
+\U494.
+\:\X115:Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$\X
+\U114.
+\:\X108:Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$\X
+\U107.
+\:\X113:Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$\X
+\U112.
+\:\X111:Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$\X
+\U109.
+\:\X1132:Compute a check sum in $(\\{b1},\\{b2},\\{b3},\\{b4})$\X
+\U1131.
+\:\X443:Compute a compromise \\{pen\_edge}\X
+\U442.
+\:\X442:Compute a good coordinate at a diagonal transition\X
+\U441.
+\:\X435:Compute before-and-after \|x values based on the current pen\X
+\U434.
+\:\X438:Compute before-and-after \|y values based on the current pen\X
+\U437.
+\:\X498:Compute test coefficients $(\\{t0},\\{t1},\\{t2})$ for $s(t)$ versus
+$s_k$ or $s_{k-1}$\X
+\Us497\ET503.
+\:\X533:Compute the distance \|d from class~0 to the edge of the ellipse in
+direction $(\|u,\|v)$, times $\psqrt{u^2+v^2}$, rounded to the nearest integer\X
+\U531.
+\:\X208:Compute the hash code \|h\X
+\U205.
+\:\X457:Compute the incoming and outgoing directions\X
+\U454.
+\:\X1137:Compute the ligature/kern program offset and implant the left boundary
+label\X
+\U1135.
+\:\X365:Compute the magic offset values\X
+\U354.
+\:\X489:Compute the octant code; skew and rotate the coordinates $(\|x,\|y)$\X
+\U488.
+\:\X576:Compute the offsets between screen coordinates and actual coordinates\X
+\U574.
+\:\X11:Constants in the outer block\X
+\U4.
+\:\X980:Construct a path from \\{pp} to \\{qq} of length $\lceil b\rceil$\X
+\U978.
+\:\X981:Construct a path from \\{pp} to \\{qq} of length zero\X
+\U978.
+\:\X481:Construct the offset list for the \|kth octant\X
+\U477.
+\:\X598:Contribute a term from \|p, plus the corresponding term from \|q\X
+\U597.
+\:\X595:Contribute a term from \|p, plus \|f times the corresponding term from %
+\|q\X
+\U594.
+\:\X596:Contribute a term from \|q, multiplied by~\|f\X
+\U594.
+\:\X840:Convert a suffix to a string\X
+\U823.
+\:\X870:Convert the left operand, \|p, into a partial path ending at~\|q; but %
+\&{return} if \|p doesn't have a suitable type\X
+\U869.
+\:\X885:Convert the right operand, \\{cur\_exp}, into a partial path from %
+\\{pp} to~\\{qq}\X
+\U869.
+\:\X146:Convert $(\|x,\|y)$ to the octant determined by~\|q\X
+\U145.
+\:\X335:Copy both \\{sorted} and \\{unsorted} lists of \|p to \\{pp}\X
+\Us334\ET341.
+\:\X857:Copy the big node \|p\X
+\U855.
+\:\X485:Copy the unskewed and unrotated coordinates of node \\{ww}\X
+\U484.
+\:\X418:Correct the octant code in segments with decreasing \|y\X
+\U413.
+\:\X1200:Create the \\{base\_ident}, open the base file, and inform the user
+that dumping has begun\X
+\U1186.
+\:\X349:Cull superfluous edge-weight entries from $\\{sorted}(\|p)$\X
+\U348.
+\:\X1008:Deal with redundant or inconsistent equation\X
+\U1006.
+\:\X454:Decide whether or not to go clockwise\X
+\U452.
+\:\X995, 996, 1015, 1021, 1029, 1031, 1034, 1035, 1036, 1040, 1041, 1044, 1045,
+1046, 1049, 1050, 1051, 1054, 1057, 1059, 1070, 1071, 1072, 1073, 1074, 1082,
+1103, 1104, 1106, 1177, 1186:Declare action procedures for use by \\{do%
+\_statement}\X
+\U989.
+\:\X594, 600, 602, 603, 604:Declare basic dependency-list subroutines\X
+\U246.
+\:\X923, 928, 930, 943, 946, 949, 953, 960, 961, 962, 963, 966, 976, 977, 978,
+982, 984, 985:Declare binary action procedures\X
+\U922.
+\:\X1154, 1155, 1157, 1158, 1159, 1160, 1161, 1163, 1165:Declare generic font
+output procedures\X
+\U989.
+\:\X224:Declare miscellaneous procedures that were declared \\{forward}\X
+\U1202.
+\:\X257, 332, 388, 473, 589, 801, 807:Declare subroutines for printing
+expressions\X
+\U246.
+\:\X968, 971, 972, 974:Declare subroutines needed by \\{big\_trans}\X
+\U966.
+\:\X856, 858:Declare subroutines needed by \\{make\_exp\_copy}\X
+\U855.
+\:\X405, 406, 419, 426, 429, 431, 432, 433, 440, 451:Declare subroutines needed
+by \\{make\_spec}\X
+\U402.
+\:\X493, 497:Declare subroutines needed by \\{offset\_prep}\X
+\U491.
+\:\X296, 299:Declare subroutines needed by \\{solve\_choices}\X
+\U284.
+\:\X823, 860, 862, 864, 868, 892:Declare the basic parsing subroutines\X
+\U1202.
+\:\X779:Declare the function called \\{open\_base\_file}\X
+\U1187.
+\:\X1011:Declare the function called \\{scan\_declared\_variable}\X
+\U697.
+\:\X1098:Declare the function called \\{tfm\_check}\X
+\U1070.
+\:\X486:Declare the function called \\{trivial\_knot}\X
+\U484.
+\:\X1032:Declare the procedure called \\{check\_delimiter}\X
+\U697.
+\:\X935:Declare the procedure called \\{dep\_finish}\X
+\U930.
+\:\X518:Declare the procedure called \\{dual\_moves}\X
+\U506.
+\:\X247:Declare the procedure called \\{flush\_below\_variable}\X
+\U246.
+\:\X808, 820:Declare the procedure called \\{flush\_cur\_exp}\X
+\U246.
+\:\X43:Declare the procedure called \\{flush\_string}\X
+\U73.
+\:\X872:Declare the procedure called \\{known\_pair}\X
+\U871.
+\:\X720:Declare the procedure called \\{macro\_call}\X
+\U706.
+\:\X1001:Declare the procedure called \\{make\_eq}\X
+\U995.
+\:\X855:Declare the procedure called \\{make\_exp\_copy}\X
+\U651.
+\:\X723:Declare the procedure called \\{print\_arg}\X
+\U720.
+\:\X625:Declare the procedure called \\{print\_cmd\_mod}\X
+\U227.
+\:\X805:Declare the procedure called \\{print\_dp}\X
+\U801.
+\:\X722:Declare the procedure called \\{print\_macro\_name}\X
+\U720.
+\:\X333:Declare the procedure called \\{print\_weight}\X
+\U332.
+\:\X665:Declare the procedure called \\{runaway}\X
+\U162.
+\:\X730:Declare the procedure called \\{scan\_text\_arg}\X
+\U720.
+\:\X217:Declare the procedure called \\{show\_token\_list}\X
+\U162.
+\:\X510:Declare the procedure called \\{skew\_line\_edges}\X
+\U506.
+\:\X284:Declare the procedure called \\{solve\_choices}\X
+\U269.
+\:\X410:Declare the procedure called \\{split\_cubic}\X
+\U406.
+\:\X1006:Declare the procedure called \\{try\_eq}\X
+\U995.
+\:\X268, 385, 487, 620, 809:Declare the recycling subroutines\X
+\U246.
+\:\X799, 800:Declare the stashing/unstashing routines\X
+\U801.
+\:\X899, 900, 901, 904, 908, 910, 913, 916, 919:Declare unary action procedures%
+\X
+\U898.
+\:\X743:Decrease the string reference count, if the current token is a string\X
+\Us83, 742, 991\ETs1016.
+\:\X300:Decrease the velocities, if necessary, to stay inside the bounding
+triangle\X
+\U299.
+\:\X123:Decrease \|k by 1, maintaining the invariant relations between \|x, %
+\|y, and~\|q\X
+\U121.
+\:\X670:Decry the invalid character and \&{goto} \\{restart}\X
+\U669.
+\:\X672:Decry the missing string delimiter and \&{goto} \\{restart}\X
+\U671.
+\:\X1113:Define an extensible recipe\X
+\U1106.
+\:\X353:Delete all the row headers\X
+\U352.
+\:\X352:Delete empty rows at the top and/or bottom; update the boundary values
+in the header\X
+\U348.
+\:\X83:Delete $\|c-\.{"0"}$ tokens and \&{goto} \\{continue}\X
+\U79.
+\:\X245:Descend one level for the attribute $\\{info}(\|t)$\X
+\U242.
+\:\X244:Descend one level for the subscript $\\{value}(\|t)$\X
+\U242.
+\:\X1012:Descend past a collective subscript\X
+\U1011.
+\:\X1047:Descend the structure\X
+\U1046.
+\:\X561:Descend to the previous level and \&{goto} \\{not\_found}\X
+\U560.
+\:\X1181:Determine if a character has been shipped out\X
+\U906.
+\:\X445:Determine the before-and-after values of both coordinates\X
+\Us444\ET446.
+\:\X816:Determine the dependency list \|s to substitute for the independent
+variable~\|p\X
+\U815.
+\:\X508:Determine the envelope's starting and ending lattice points $(\\{m0},%
+\\{n0})$ and $(\\{m1},\\{n1})$\X
+\U506.
+\:\X1164:Determine the file extension, \\{gf\_ext}\X
+\U1163.
+\:\X724:Determine the number \|n of arguments already supplied, and set %
+\\{tail} to the tail of \\{arg\_list}\X
+\U720.
+\:\X400:Determine the octant boundary \|q that precedes \|f\X
+\U398.
+\:\X480:Determine the octant code for direction $(\\{dx},\\{dy})$\X
+\U479.
+\:\X874:Determine the path join parameters; but \&{goto} \\{finish\_path} if
+there's only a direction specifier\X
+\U869.
+\:\X467:Determine the starting and ending lattice points $(\\{m0},\\{n0})$ and
+$(\\{m1},\\{n1})$\X
+\U465.
+\:\X881:Determine the tension and/or control points\X
+\U874.
+\:\X979:Dispense with the cases $\|a<0$ and/or $\|b>\|l$\X
+\U978.
+\:\X803:Display a big node\X
+\U802.
+\:\X221:Display a collective subscript\X
+\U218.
+\:\X804:Display a complex type\X
+\U802.
+\:\X220:Display a numeric token\X
+\U219.
+\:\X222:Display a parameter token\X
+\U218.
+\:\X1048:Display a variable macro\X
+\U1046.
+\:\X806:Display a variable that's been declared but not defined\X
+\U802.
+\:\X750:Display the boolean value of \\{cur\_exp}\X
+\U748.
+\:\X636:Display the current context\X
+\U635.
+\:\X613:Display the new dependency\X
+\U610.
+\:\X578:Display the pixels of edge row \|p in screen row \|r\X
+\U577.
+\:\X218:Display token \|p and set \|c to its class; but \&{return} if there are
+problems\X
+\U217.
+\:\X219:Display two-word token\X
+\U218.
+\:\X616:Divide list \|p by $2^n$\X
+\U615.
+\:\X612:Divide list \|p by $-\|v$, removing node \|q\X
+\U610.
+\:\X313:Divide the variables by two, to avoid overflow problems\X
+\U311.
+\:\X992:Do a statement that doesn't begin with an expression\X
+\U989.
+\:\X994:Do a title\X
+\U993.
+\:\X993:Do an equation, assignment, title, or `$\langle\,$expression$\,\rangle%
+\,$\&{endgroup}'\X
+\U989.
+\:\X417:Do any special actions needed when \|y is constant; \&{return} or %
+\&{goto} \\{continue} if a dead cubic from \|p to \|q is removed\X
+\U413.
+\:\X646:Do magic computation\X
+\U217.
+\:\X1005:Do multiple equations and \&{goto} \\{done}\X
+\U1003.
+\:\X1065:Double the path\X
+\U1064.
+\:\X1198:Dump a few more things and the closing check word\X
+\U1186.
+\:\X1190:Dump constants for consistency check\X
+\U1186.
+\:\X1194:Dump the dynamic memory\X
+\U1186.
+\:\X1192:Dump the string pool\X
+\U1186.
+\:\X1196:Dump the table of equivalents and the hash table\X
+\U1186.
+\:\X845:Either begin an unsuffixed macro call or prepare for a suffixed one\X
+\U844.
+\:\X1156:Empty the last bytes out of \\{gf\_buf}\X
+\U1182.
+\:\X969:Ensure that $\\{type}(\|p)=\\{proto\_dependent}$\X
+\U968.
+\:\X73, 76, 77, 88, 89, 90:Error handling procedures\X
+\U4.
+\:\X623:Exclaim about a redundant equation\X
+\Us622, 1004\ETs1008.
+\:\X713:Exit a loop if the proper time has come\X
+\U707.
+\:\X714:Exit prematurely from an iteration\X
+\U713.
+\:\X544:Exit to \\{found} if an eastward direction occurs at knot \|p\X
+\U541.
+\:\X546:Exit to \\{found} if the curve whose derivatives are specified by $%
+\\{x1},\\{x2},\\{x3},\\{y1},\\{y2},\\{y3}$ travels eastward at some time~\\{tt}%
+\X
+\U541.
+\:\X549:Exit to \\{found} if the derivative $B(x_1,x_2,x_3;t)$ becomes $\G0$\X
+\U548.
+\:\X715:Expand the token after the next token\X
+\U707.
+\:\X736:Feed the arguments and replacement text to the scanner\X
+\U720.
+\:\X278:Fill in the control information between consecutive breakpoints \|p and
+\|q\X
+\U273.
+\:\X273:Fill in the control points between \|p and the next breakpoint, then
+advance \|p to that breakpoint\X
+\U269.
+\:\X611:Find a node \|q in list \|p whose coefficient \|v is largest\X
+\U610.
+\:\X850:Find the approximate type \\{tt} and corresponding~\|q\X
+\U844.
+\:\X272:Find the first breakpoint, \|h, on the path; insert an artificial
+breakpoint if the path is an unbroken cycle\X
+\U269.
+\:\X502:Find the index \|k such that $s_{k-1}\L\\{dy}/\\{dx}<s_k$\X
+\U494.
+\:\X501:Find the initial slope, $\\{dy}/\\{dx}$\X
+\U494.
+\:\X1138:Find the minimum \\{lk\_offset} and adjust all remainders\X
+\U1137.
+\:\X399:Find the starting point, \|f\X
+\U398.
+\:\X297:Finish choosing angles and assigning control points\X
+\U284.
+\:\X668:Finish getting the symbolic token in \\{cur\_sym}; \&{goto} \\{restart}
+if it is illegal\X
+\U667.
+\:\X483:Finish linking the offset nodes, and duplicate the borderline offset
+nodes if necessary\X
+\U481.
+\:\X1168:Finish off an entirely blank character\X
+\U1167.
+\:\X1182:Finish the \.{GF} file\X
+\U1206.
+\:\X1206:Finish the \.{TFM} and \.{GF} files\X
+\U1205.
+\:\X1134:Finish the \.{TFM} file\X
+\U1206.
+\:\X459:Fix up the transition fields and adjust the turning number\X
+\U452.
+\:\X1016:Flush spurious symbols after the declared variable\X
+\U1015.
+\:\X991:Flush unparsable junk that was found after the statement\X
+\U989.
+\:\X957:For each of the eight cases, change the relevant fields of \\{cur\_exp}
+and \&{goto} \\{done}; but do nothing if capsule \|p doesn't have the
+appropriate type\X
+\U955.
+\:\X1003:For each type \|t, make an equation and \&{goto} \\{done} unless %
+\\{cur\_type} is incompatible with~\|t\X
+\U1001.
+\:\X678:Get a stored numeric or string or capsule token and \&{return}\X
+\U676.
+\:\X671:Get a string token and \&{return}\X
+\U669.
+\:\X878:Get given directions separated by commas\X
+\U877.
+\:\X886:Get ready to close a cycle\X
+\U869.
+\:\X1062:Get ready to fill a contour, and fill it\X
+\U1059.
+\:\X1211:Get the first line of input and prepare to start\X
+\U1204.
+\:\X674:Get the fraction part \|f of a numeric token\X
+\U669.
+\:\X673:Get the integer part \|n of a numeric token; set $\|f\K0$ and \&{goto} %
+\\{fin\_numeric\_token} if there is no decimal point\X
+\U669.
+\:\X285:Get the linear equations started; or \&{return} with the control points
+in place, if linear equations needn't be solved\X
+\U284.
+\:\X78:Get user's advice and \&{return}\X
+\U77.
+\:\X914:Give error messages if \\{bad\_char} or $\|n\G4096$\X
+\U913.
+\:\X13, 20, 25, 29, 31, 38, 42, 50, 54, 68, 71, 74, 91, 97, 129, 137, 144, 148,
+159, 160, 161, 166, 178, 190, 196, 198, 200, 201, 225, 230, 250, 267, 279, 283,
+298, 308, 309, 327, 371, 379, 389, 395, 403, 427, 430, 448, 455, 461, 464, 507,
+552, 555, 557, 566, 569, 572, 579, 585, 592, 624, 628, 631, 633, 634, 659, 680,
+699, 738, 752, 767, 768, 775, 782, 785, 791, 796, 813, 821, 954, 1077, 1084,
+1087, 1096, 1119, 1125, 1130, 1149, 1152, 1162, 1183, 1188, 1203:Global
+variables\X
+\U4.
+\:\X168:Grow more variable-size memory and \&{goto} \\{restart}\X
+\U167.
+\:\X128:Handle erroneous \\{pyth\_sub} and set $\|a\K0$\X
+\U126.
+\:\X134:Handle non-positive logarithm\X
+\U132.
+\:\X690:Handle quoted symbols, \.{\#\AT!}, \.{\AT!}, or \.{\AT!\#}\X
+\U685.
+\:\X122:Handle square root of zero or negative argument\X
+\U121.
+\:\X505:Handle the special case of infinite slope\X
+\U494.
+\:\X548:Handle the test for eastward directions when $y_1y_3=y_2^2$; either %
+\&{goto} \\{found} or \&{goto} \\{done}\X
+\U546.
+\:\X140:Handle undefined arg\X
+\U139.
+\:\X852:Handle unusual cases that masquerade as variables, and \&{goto} %
+\\{restart} or \&{goto} \\{done} if appropriate; otherwise make a copy of the
+variable and \&{goto} \\{done}\X
+\U844.
+\:\X271:If consecutive knots are equal, join them explicitly\X
+\U269.
+\:\X441:If node \|q is a transition point between octants, compute and save its
+before-and-after coordinates\X
+\U440.
+\:\X434:If node \|q is a transition point for \|x coordinates, compute and save
+its before-and-after coordinates\X
+\U433.
+\:\X437:If node \|q is a transition point for \|y coordinates, compute and save
+its before-and-after coordinates\X
+\U433.
+\:\X956:If the current transform is entirely known, stash it in global
+variables; otherwise \&{return}\X
+\U953.
+\:\X322:Increase and decrease $\\{move}[\|k-1]$ and $\\{move}[\|k]$ by $%
+\delta_k$\X
+\U321.
+\:\X133:Increase \|k until \|x can be multiplied by a factor of $2^{-k}$, and
+adjust $y$ accordingly\X
+\U132.
+\:\X143:Increase \|z to the arg of $(x,y)$\X
+\U142.
+\:\X519:Initialize for dual envelope moves\X
+\U518.
+\:\X558:Initialize for intersections at level zero\X
+\U556.
+\:\X513:Initialize for ordinary envelope moves\X
+\U512.
+\:\X581:Initialize for the display computations\X
+\U577.
+\:\X176, 193, 203, 229, 324, 475, 587, 702, 759, 911, 1116, 1127,
+1185:Initialize table entries (done by \.{INIMF} only)\X
+\U1210.
+\:\X356:Initialize the array of new edge list heads\X
+\U354.
+\:\X528:Initialize the ellipse data structure by beginning with directions
+$(0,-1)$, $(1,0)$, $(0,1)$\X
+\U527.
+\:\X657, 660:Initialize the input routines\X
+\U1211.
+\:\X55, 61, 783, 792:Initialize the output routines\X
+\U1204.
+\:\X70:Initialize the print \\{selector} based on \\{interaction}\X
+\Us1023\ET1211.
+\:\X1022:Initialize the random seed to \\{cur\_exp}\X
+\U1021.
+\:\X711:Initiate or terminate input from a file\X
+\U707.
+\:\X669:Input from external file; \&{goto} \\{restart} if no input found, or %
+\&{return} if a non-symbolic token is found\X
+\U667.
+\:\X676:Input from token list; \&{goto} \\{restart} if end of list or if a
+parameter needs to be expanded, or \&{return} if a non-symbolic token is found\X
+\U667.
+\:\X986:Insert a fractional node by splitting the cubic\X
+\U985.
+\:\X521:Insert a line segment dually to approach the correct offset\X
+\U518.
+\:\X515:Insert a line segment to approach the correct offset\X
+\U512.
+\:\X535:Insert a new line for direction $(\|u,\|v)$ between \|p and~\|q\X
+\U531.
+\:\X207:Insert a new symbolic token after \|p, then make \|p point to it and %
+\&{goto} \\{found}\X
+\U205.
+\:\X677:Insert a suffix or text parameter and \&{goto} \\{restart}\X
+\U676.
+\:\X458:Insert additional boundary nodes, then \&{goto} \\{done}\X
+\U452.
+\:\X350:Insert an edge-weight for edge \|m, if the new pixel weight has changed%
+\X
+\U349.
+\:\X355:Insert blank rows at the top and bottom, and set \|p to the new top row%
+\X
+\U354.
+\:\X376:Insert downward edges for a line\X
+\U374.
+\:\X330:Insert exactly $\\{n\_min}(\\{cur\_edges})-\\{nl}$ empty rows at the
+bottom\X
+\U329.
+\:\X331:Insert exactly $\\{nr}-\\{n\_max}(\\{cur\_edges})$ empty rows at the
+top\X
+\U329.
+\:\X362:Insert horizontal edges of weight \|w between \|m and~\\{mm}\X
+\U358.
+\:\X450:Insert octant boundaries and compute the turning number\X
+\U402.
+\:\X452:Insert one or more octant boundary nodes just before~\|q\X
+\U450.
+\:\X358:Insert the horizontal edges defined by adjacent rows $\|p,\|q$, and
+destroy row~\|p\X
+\U354.
+\:\X523:Insert the new envelope moves dually in the pixel data\X
+\U518.
+\:\X517:Insert the new envelope moves in the pixel data\X
+\U512.
+\:\X375:Insert upward edges for a line\X
+\U374.
+\:\X959:Install a complex multiplier, then \&{goto} \\{done}\X
+\U957.
+\:\X958:Install sines and cosines, then \&{goto} \\{done}\X
+\U957.
+\:\X531:Interpolate new vertices in the ellipse data structure until
+improvement is impossible\X
+\U527.
+\:\X79:Interpret code \|c and \&{return} if done\X
+\U78.
+\:\X82:Introduce new material from the terminal and \&{return}\X
+\U79.
+\:\X887:Join the partial paths and reset \|p and \|q to the head and tail of
+the result\X
+\U869.
+\:\X6:Labels in the outer block\X
+\U4.
+\:\X1205, 1209, 1210, 1212:Last-minute procedures\X
+\U1202.
+\:\X241:Link a new attribute node \|r in place of node \|p\X
+\U239.
+\:\X240:Link a new subscript node \|r in place of node \|p\X
+\U239.
+\:\X482:Link node \|r to the previous node\X
+\U481.
+\:\X641:Local variables for formatting calculations\X
+\U635.
+\:\X19, 130:Local variables for initialization\X
+\U4.
+\:\X1141:Log the subfile sizes of the \.{TFM} file\X
+\U1134.
+\:\X896:Make a special knot node for \&{pencircle}\X
+\U895.
+\:\X1066:Make a trivial one-point path cycle\X
+\U1065.
+\:\X314:Make moves for current subinterval; if bisection is necessary, push the
+second subinterval onto the stack, and \&{goto} \\{continue} in order to handle
+the first subinterval\X
+\U311.
+\:\X317:Make one move of each kind\X
+\U314.
+\:\X446:Make sure that all the diagonal roundings are safe\X
+\U444.
+\:\X243:Make sure that both nodes \|p and \\{pp} are of \\{structured} type\X
+\U242.
+\:\X873:Make sure that both \|x and \|y parts of \|p are known; copy them into %
+\\{cur\_x} and \\{cur\_y}\X
+\U872.
+\:\X883:Make sure that the current expression is a valid tension setting\X
+\Us882\ET882.
+\:\X1207:Make the dynamic memory into one big available node\X
+\U1206.
+\:\X512:Make the envelope moves for the current octant and insert them in the
+pixel data\X
+\U506.
+\:\X48:Make the first 256 strings\X
+\U47.
+\:\X468:Make the moves for the current octant\X
+\U465.
+\:\X586:Make variable $\|q+\|s$ newly independent\X
+\U232.
+\:\X1126:Massage the \.{TFM} heights, depths, and italic corrections\X
+\U1206.
+\:\X1124:Massage the \.{TFM} widths\X
+\U1206.
+\:\X368:Merge row \\{pp} into row \|p\X
+\U366.
+\:\X347:Merge the \\{temp\_head} list into $\\{sorted}(\|h)$\X
+\U346.
+\:\X319:Move right then up\X
+\Us317\ET317.
+\:\X947:Move the dependent variable \|p into both parts of the pair node \|r\X
+\U946.
+\:\X679:Move to next line of file, or \&{goto} \\{restart} if there is no next
+line\X
+\U669.
+\:\X377:Move to row \\{n0}, pointed to by \|p\X
+\Us375, 376, 381, 382, 383\ETs384.
+\:\X532:Move to the next remaining triple $(\|p,\|q,\|r)$, removing and
+skipping past zero-length lines that might be present; \&{goto} \\{done} if all
+triples have been processed\X
+\U531.
+\:\X316:Move to the right \|m steps\X
+\U314.
+\:\X320:Move up then right\X
+\Us317\ET317.
+\:\X315:Move upward \|n steps\X
+\U314.
+\:\X942:Multiply when at least one operand is known\X
+\U941.
+\:\X136:Multiply \|y by $\exp(-z/2^{27})$\X
+\U135.
+\:\X903:Negate the current expression\X
+\U898.
+\:\X540:Normalize the given direction for better accuracy; but \&{return} with
+zero result if it's zero\X
+\U539.
+\:\X1213:Numbered cases for \\{debug\_help}\X
+\U1212.
+\:\X580:Other local variables for \\{disp\_edges}\X
+\U577.
+\:\X511:Other local variables for \\{fill\_envelope}\X
+\Us506\ET518.
+\:\X542:Other local variables for \\{find\_direction\_time}\X
+\U539.
+\:\X280:Other local variables for \\{make\_choices}\X
+\U269.
+\:\X453:Other local variables for \\{make\_spec}\X
+\U402.
+\:\X495:Other local variables for \\{offset\_prep}\X
+\U491.
+\:\X831, 836, 843:Other local variables for \\{scan\_primary}\X
+\U823.
+\:\X286:Other local variables for \\{solve\_choices}\X
+\U284.
+\:\X357, 363:Other local variables for \\{xy\_swap\_edges}\X
+\U354.
+\:\X1208:Output statistics about this job\X
+\U1205.
+\:\X934:Output the answer, \|v (which might have become \\{known})\X
+\U932.
+\:\X1136:Output the character information bytes, then output the dimensions
+themselves\X
+\U1134.
+\:\X1167:Output the character represented in \\{cur\_edges}\X
+\U1165.
+\:\X1140:Output the extensible character recipes and the font metric parameters%
+\X
+\U1134.
+\:\X1139:Output the ligature/kern program\X
+\U1134.
+\:\X1169:Output the pixels of edge row \|p to font row \|n\X
+\U1167.
+\:\X1135:Output the subfile sizes and header bytes\X
+\U1134.
+\:\X675:Pack the numeric and fraction parts of a numeric token and \&{return}\X
+\U669.
+\:\X889:Plug an opening in $\\{right\_type}(\\{pp})$, if possible\X
+\U887.
+\:\X888:Plug an opening in $\\{right\_type}(\|q)$, if possible\X
+\U887.
+\:\X745:Pop the condition stack\X
+\Us748, 749\ETs751.
+\:\X237:Preface the output with a part specifier; \&{return} in the case of a
+capsule\X
+\U235.
+\:\X380:Prepare for and switch to the appropriate case, based on \\{octant}\X
+\U378.
+\:\X496:Prepare for derivative computations; \&{goto} \\{not\_found} if the
+current cubic is dead\X
+\U494.
+\:\X765:Prepare for step-until construction and \&{goto} \\{done}\X
+\U764.
+\:\X717:Pretend we're reading a new one-line file\X
+\U716.
+\:\X509:Print a line of diagnostic info to introduce this octant\X
+\U508.
+\:\X802:Print an abbreviated value of \|v with format depending on \|t\X
+\U801.
+\:\X261:Print control points between \|p and \|q, then \&{goto} \\{done1}\X
+\U258.
+\:\X263:Print information for a curve that begins \\{curl} or \\{given}\X
+\U258.
+\:\X262:Print information for a curve that begins \\{open}\X
+\U258.
+\:\X258:Print information for adjacent knots \|p and \|q\X
+\U257.
+\:\X637:Print location of current line\X
+\U636.
+\:\X184:Print newly busy locations\X
+\U180.
+\:\X1086:Print string \\{cur\_exp} as an error message\X
+\U1082.
+\:\X223:Print string \|r as a symbolic token and set \|c to its class\X
+\U218.
+\:\X260:Print tension between \|p and \|q\X
+\U258.
+\:\X790:Print the banner line, including the date and time\X
+\U788.
+\:\X590:Print the coefficient, unless it's $\pm1.0$\X
+\U589.
+\:\X397:Print the cubic between \|p and \|q\X
+\U394.
+\:\X639:Print the current loop value\X
+\U638.
+\:\X84:Print the help information and \&{goto} \\{continue}\X
+\U79.
+\:\X80:Print the menu of available options\X
+\U79.
+\:\X640:Print the name of a \&{vardef}'d macro\X
+\U638.
+\:\X85:Print the string \\{err\_help}, possibly on several lines\X
+\Us84\ET86.
+\:\X401:Print the turns, if any, that start at \|q, and advance \|q\X
+\Us398\ET398.
+\:\X474:Print the unskewed and unrotated coordinates of node \\{ww}\X
+\U473.
+\:\X259:Print two dots, followed by \\{given} or \\{curl} if present\X
+\U257.
+\:\X643:Print two lines using the tricky pseudoprinted information\X
+\U636.
+\:\X638:Print type of token list\X
+\U636.
+\:\X1110:Process a \\{skip\_to} command and \&{goto} \\{done}\X
+\U1107.
+\:\X838:Protest division by zero\X
+\U837.
+\:\X644:Pseudoprint the line\X
+\U636.
+\:\X645:Pseudoprint the token list\X
+\U636.
+\:\X744:Push the condition stack\X
+\U748.
+\:\X716:Put a string into the input buffer\X
+\U707.
+\:\X192, 211, 683, 688, 695, 709, 740, 893, 1013, 1018, 1024, 1027, 1037, 1052,
+1079, 1101, 1108, 1176:Put each of \MF's primitives into the hash table\X
+\U1210.
+\:\X86:Put help message on the transcript file\X
+\U77.
+\:\X955:Put the current transform into \\{cur\_exp}\X
+\U953.
+\:\X795:Put the desired file name in $(\\{cur\_name},\\{cur\_ext},\\{cur%
+\_area})$\X
+\U793.
+\:\X847:Put the left bracket and the expression back to be rescanned\X
+\Us846\ET859.
+\:\X345:Put the list $\\{sorted}(\|p)$ back into sort\X
+\U344.
+\:\X880:Put the post-join direction information into \|x and \|t\X
+\U874.
+\:\X879:Put the pre-join direction information into node \|q\X
+\U874.
+\:\X897:Read a string from the terminal\X
+\U895.
+\:\X681:Read next line of file into \\{buffer}, or \&{goto} \\{restart} if the
+file has ended\X
+\U679.
+\:\X52:Read one string, but return \\{false} if the string memory space is
+getting too tight for comfort\X
+\U51.
+\:\X794:Read the first line of the new file\X
+\U793.
+\:\X51:Read the other strings from the \.{MF.POOL} file and return \\{true}, or
+give an error message and return \\{false}\X
+\U47.
+\:\X1111:Record a label in a lig/kern subprogram and \&{goto} \\{continue}\X
+\U1107.
+\:\X522:Record a line segment from $(\\{xx},\\{yy})$ to $(\\{xp},\\{yp})$
+dually in \\{env\_move}\X
+\U521.
+\:\X516:Record a line segment from $(\\{xx},\\{yy})$ to $(\\{xp},\\{yp})$ in %
+\\{env\_move}\X
+\U515.
+\:\X814:Record a new maximum coefficient of type \|t\X
+\U812.
+\:\X583:Record a possible transition in column \|m\X
+\U582.
+\:\X810:Recycle a big node\X
+\U809.
+\:\X811:Recycle a dependency list\X
+\U809.
+\:\X812:Recycle an independent variable\X
+\U809.
+\:\X925:Recycle any sidestepped \\{independent} capsules\X
+\U922.
+\:\X939:Reduce comparison of big nodes to comparison of scalars\X
+\U936.
+\:\X302:Reduce to simple case of straight line and \&{return}\X
+\U285.
+\:\X301:Reduce to simple case of two givens and \&{return}\X
+\U285.
+\:\X118:Reduce to the case that $\|a,\|c\G0$, $\|b,\|d>0$\X
+\U117.
+\:\X110:Reduce to the case that $\|f\G0$ and $\|q>0$\X
+\Us109\ET112.
+\:\X339:Reflect the edge-and-weight data in $\\{sorted}(\|p)$\X
+\U337.
+\:\X338:Reflect the edge-and-weight data in $\\{unsorted}(\|p)$\X
+\U337.
+\:\X312:Remove a subproblem for \\{make\_moves} from the stack\X
+\U311.
+\:\X447:Remove dead cubics\X
+\U402.
+\:\X1007:Remove the left operand from its container, negate it, and put it into
+dependency list~\|p with constant term~\|q\X
+\U1006.
+\:\X534:Remove the line from \|p to \|q, and adjust vertex~\|q to introduce a
+new line\X
+\U531.
+\:\X282:Remove \\{open} types at the breakpoints\X
+\U278.
+\:\X712:Repeat a loop\X
+\U707.
+\:\X1122:Replace an interval of values by its midpoint\X
+\U1121.
+\:\X125:Replace \|a by an approximation to $\psqrt{a^2+b^2}$\X
+\U124.
+\:\X127:Replace \|a by an approximation to $\psqrt{a^2-b^2}$\X
+\U126.
+\:\X341:Replicate every row exactly $s$ times\X
+\U340.
+\:\X270:Report an unexpected problem during the choice-making\X
+\U269.
+\:\X34:Report overflow of the input buffer, and abort\X
+\U30.
+\:\X1004:Report redundant or inconsistent equation and \&{goto} \\{done}\X
+\U1003.
+\:\X141:Return an appropriate answer based on \|z and \\{octant}\X
+\U139.
+\:\X529:Revise the values of $\alpha$, $\beta$, $\gamma$, if necessary, so that
+degenerate lines of length zero will not be obtained\X
+\U528.
+\:\X541:Rotate the cubic between \|p and \|q; then \&{goto} \\{found} if the
+rotated cubic travels due east at some time \\{tt}; but \&{goto} \\{not\_found}
+if an entire cyclic path has been traversed\X
+\U539.
+\:\X605:Run through the dependency list for variable \|t, fixing all nodes, and
+ending with final link~\|q\X
+\U604.
+\:\X1083:Save string \\{cur\_exp} as the \\{err\_help}\X
+\U1082.
+\:\X343:Scale the $x$~coordinates of each row by $s$\X
+\U342.
+\:\X964:Scale the edges, shift them, and \&{return}\X
+\U963.
+\:\X408:Scale up \\{del1}, \\{del2}, and \\{del3} for greater accuracy; also
+set \\{del} to the first nonzero element of $(\\{del1},\\{del2},\\{del3})$\X
+\Us407, 413\ETs420.
+\:\X839:Scan a binary operation with `\&{of}' between its operands\X
+\U823.
+\:\X861:Scan a bracketed subscript and set $\\{cur\_cmd}\K\\{numeric\_token}$\X
+\U860.
+\:\X876:Scan a curl specification\X
+\U875.
+\:\X826:Scan a delimited primary\X
+\U823.
+\:\X877:Scan a given direction\X
+\U875.
+\:\X832:Scan a grouped primary\X
+\U823.
+\:\X859:Scan a mediation construction\X
+\U823.
+\:\X834:Scan a nullary operation\X
+\U823.
+\:\X869:Scan a path construction operation; but \&{return} if \|p has the wrong
+type\X
+\U868.
+\:\X837:Scan a primary that starts with a numeric token\X
+\U823.
+\:\X833:Scan a string constant\X
+\U823.
+\:\X735:Scan a suffix with optional delimiters\X
+\U733.
+\:\X835:Scan a unary operation\X
+\U823.
+\:\X844:Scan a variable primary; \&{goto} \\{restart} if it turns out to be a
+macro\X
+\U823.
+\:\X734:Scan an expression followed by `\&{of} $\langle$primary$\rangle$'\X
+\U733.
+\:\X841:Scan an internal numeric quantity\X
+\U823.
+\:\X787:Scan file name in the buffer\X
+\U786.
+\:\X846:Scan for a subscript; replace \\{cur\_cmd} by \\{numeric\_token} if
+found\X
+\U844.
+\:\X729:Scan the argument represented by $\\{info}(\|r)$\X
+\U726.
+\:\X726:Scan the delimited argument represented by $\\{info}(\|r)$\X
+\U725.
+\:\X758:Scan the loop text and put it on the loop control stack\X
+\U755.
+\:\X725:Scan the remaining arguments, if any; set \|r to the first token of the
+replacement text\X
+\U720.
+\:\X830:Scan the second of a pair of numerics\X
+\U826.
+\:\X700:Scan the token or variable to be defined; set \|n, \\{scanner\_status},
+and \\{warning\_info}\X
+\U697.
+\:\X764:Scan the values to be used in the loop\X
+\U755.
+\:\X733:Scan undelimited argument(s)\X
+\U725.
+\:\X708:Scold the user for having an extra \&{endfor}\X
+\U707.
+\:\X209:Search \\{eqtb} for equivalents equal to \|p\X
+\U185.
+\:\X1166:Send nonzero offsets to the output file\X
+\U1165.
+\:\X1179:Send the current expression as a title to the output file\X
+\U994.
+\:\X884:Set explicit control points\X
+\U881.
+\:\X882:Set explicit tensions\X
+\U881.
+\:\X21, 22, 23, 69, 72, 75, 92, 98, 131, 138, 179, 191, 199, 202, 231, 251,
+396, 428, 449, 456, 462, 570, 573, 593, 739, 753, 776, 797, 822, 1078, 1085,
+1097, 1150, 1153, 1184:Set initial values of key variables\X
+\U4.
+\:\X543:Set local variables $\\{x1},\\{x2},\\{x3}$ and $\\{y1},\\{y2},\\{y3}$
+to multiples of the control points of the rotated derivatives\X
+\U541.
+\:\X987:Set the current expression to the desired path coordinates\X
+\U985.
+\:\X295:Set up equation for a curl at $\theta_n$ and \&{goto} \\{found}\X
+\U284.
+\:\X287:Set up equation to match mock curvatures at $z_k$; then \&{goto} %
+\\{found} with $\theta_n$ adjusted to equal $\theta_0$, if a cycle has ended\X
+\U284.
+\:\X854:Set up suffixed macro call and \&{goto} \\{restart}\X
+\U852.
+\:\X1075:Set up the culling weights, or \&{goto} \\{not\_found} if the
+thresholds are bad\X
+\U1074.
+\:\X294:Set up the equation for a curl at $\theta_0$\X
+\U285.
+\:\X293:Set up the equation for a given value of $\theta_0$\X
+\U285.
+\:\X582:Set up the parameters needed for \\{paint\_row}; but \&{goto} \\{done}
+if no painting is needed after all\X
+\U578.
+\:\X421:Set up the variables $(\\{del1},\\{del2},\\{del3})$ to represent
+$x'-y'$\X
+\U420.
+\:\X853:Set up unsuffixed macro call and \&{goto} \\{restart}\X
+\U845.
+\:\X466:Set variable \|q to the node at the end of the current octant\X
+\Us465, 506\ETs506.
+\:\X142:Set variable \|z to the arg of $(x,y)$\X
+\U139.
+\:\X867:Shift the coordinates of path \|q\X
+\U866.
+\:\X965:Shift the edges by $(\\{tx},\\{ty})$, rounded\X
+\U964.
+\:\X1042:Show a numeric or string or capsule token\X
+\U1041.
+\:\X721:Show the text of the macro being expanded, and the existing arguments\X
+\U720.
+\:\X817:Show the transformed dependency\X
+\U816.
+\:\X926:Sidestep \\{independent} cases in capsule \|p\X
+\U922.
+\:\X927:Sidestep \\{independent} cases in the current expression\X
+\U922.
+\:\X614:Simplify all existing dependencies by substituting for \|x\X
+\U610.
+\:\X1174:Skip down $\\{prev\_n}-\|n$ rows\X
+\U1172.
+\:\X749:Skip to \&{elseif} or \&{else} or \&{fi}, then \&{goto} \\{done}\X
+\U748.
+\:\X1173:Skip to column $m$ in the next row and \&{goto} \\{done}, or skip zero
+rows\X
+\U1172.
+\:\X174:Sort \|p into the list starting at \\{rover} and advance \|p to $%
+\\{rlink}(\|p)$\X
+\U173.
+\:\X890:Splice independent paths together\X
+\U887.
+\:\X504:Split off another \\{rising} cubic for \\{fin\_offset\_prep}\X
+\U503.
+\:\X499:Split the cubic at $t$, and split off another cubic if the derivative
+crosses back\X
+\U497.
+\:\X494:Split the cubic between \|p and \|q, if necessary, into cubics
+associated with single offsets, after which \|q should point to the end of the
+final such cubic\X
+\U491.
+\:\X950:Squeal about division by zero\X
+\U948.
+\:\X479:Stamp all nodes with an octant code, compute the maximum offset, and
+set \\{hh} to the node that begins the first octant; \&{goto} \\{not\_found} if
+there's a problem\X
+\U477.
+\:\X1172:Start a new row at $(m,n)$\X
+\U1170.
+\:\X1170:Start black at $(m,n)$\X
+\U1169.
+\:\X829:Stash an independent \\{cur\_exp} into a big node\X
+\U827.
+\:\X1171:Stop black at $(m,n)$\X
+\U1169.
+\:\X1115:Store a list of font dimensions\X
+\U1106.
+\:\X1114:Store a list of header bytes\X
+\U1106.
+\:\X1107:Store a list of ligature/kern steps\X
+\U1106.
+\:\X1099:Store the width information for character code~\|c\X
+\U1070.
+\:\X413:Subdivide all cubics between \|p and \|q so that the results travel
+toward the first quadrant; but \&{return} or \&{goto} \\{continue} if the cubic
+from \|p to \|q was dead\X
+\U406.
+\:\X559:Subdivide for a new level of intersection\X
+\U556.
+\:\X412:Subdivide the cubic a second time with respect to $x'$\X
+\U411.
+\:\X425:Subdivide the cubic a second time with respect to $x'-y'$\X
+\U424.
+\:\X416:Subdivide the cubic a second time with respect to $y'$\X
+\U415.
+\:\X420:Subdivide the cubic between \|p and \|q so that the results travel
+toward the first octant\X
+\U419.
+\:\X407:Subdivide the cubic between \|p and \|q so that the results travel
+toward the right halfplane\X
+\U406.
+\:\X411:Subdivide the cubic with respect to $x'$, possibly twice\X
+\U407.
+\:\X424:Subdivide the cubic with respect to $x'-y'$, possibly twice\X
+\U420.
+\:\X415:Subdivide the cubic with respect to $y'$, possibly twice\X
+\U413.
+\:\X686:Substitute for \\{cur\_sym}, if it's on the \\{subst\_list}\X
+\U685.
+\:\X818:Substitute new dependencies in place of \|p\X
+\U815.
+\:\X819:Substitute new proto-dependencies in place of \|p\X
+\U815.
+\:\X147:Subtract angle \|z from $(\|x,\|y)$\X
+\U145.
+\:\X825:Supply diagnostic information, if requested\X
+\U823.
+\:\X423:Swap the \|x and \|y coordinates of the cubic between \|p and~\|q\X
+\U420.
+\:\X318:Switch to the right subinterval\X
+\U317.
+\:\X663:Tell the user what has run away and try to recover\X
+\U661.
+\:\X751:Terminate the current conditional and skip to \&{fi}\X
+\U707.
+\:\X761:The arithmetic progression has ended\X
+\U760.
+\:\X998:Trace the current assignment\X
+\U996.
+\:\X924:Trace the current binary operation\X
+\U922.
+\:\X997:Trace the current equation\X
+\U995.
+\:\X902:Trace the current unary operation\X
+\U898.
+\:\X945:Trace the fraction multiplication\X
+\U944.
+\:\X762:Trace the start of a loop\X
+\U760.
+\:\X520:Transfer moves dually from the \\{move} array to \\{env\_move}\X
+\U518.
+\:\X514:Transfer moves from the \\{move} array to \\{env\_move}\X
+\U512.
+\:\X970:Transform a known big node\X
+\U966.
+\:\X967:Transform an unknown big node and \&{return}\X
+\U966.
+\:\X973:Transform known by known\X
+\U970.
+\:\X444:Transform the skewed coordinates\X
+\U440.
+\:\X436:Transform the \|x coordinates\X
+\U433.
+\:\X439:Transform the \|y coordinates\X
+\U433.
+\:\X206:Treat special case of length 1 and \&{goto} \\{found}\X
+\U205.
+\:\X404:Truncate the values of all coordinates that exceed \\{max\_allowed},
+and stamp segment numbers in each \\{left\_type} field\X
+\U402.
+\:\X169:Try to allocate within node \|p and its physical successors, and %
+\&{goto} \\{found} if allocation was possible\X
+\U167.
+\:\X789:Try to get a different log file name\X
+\U788.
+\:\X18, 24, 37, 101, 105, 106, 156, 186, 565, 571, 627, 1151:Types in the outer
+block\X
+\U4.
+\:\X1199:Undump a few more things and the closing check word\X
+\U1187.
+\:\X1191:Undump constants for consistency check\X
+\U1187.
+\:\X1195:Undump the dynamic memory\X
+\U1187.
+\:\X1193:Undump the string pool\X
+\U1187.
+\:\X1197:Undump the table of equivalents and the hash table\X
+\U1187.
+\:\X351:Update the max/min amounts\X
+\U349.
+\:\X392:Use bisection to find the crossing point, if one exists\X
+\U391.
+\:\X584:Wind up the \\{paint\_row} parameter calculation by inserting the final
+transition; \&{goto} \\{done} if no painting is needed\X
+\U582.
+\:\X990:Worry about bad statement\X
+\U989.
+\con
diff --git a/Build/source/texk/web2c/mf.web b/Build/source/texk/web2c/mf.web
new file mode 100644
index 00000000000..81b5302536f
--- /dev/null
+++ b/Build/source/texk/web2c/mf.web
@@ -0,0 +1,23114 @@
+% This program is copyright (C) 1984 by D. E. Knuth; all rights are reserved.
+% Copying of this file is authorized only if (1) you are D. E. Knuth, or if
+% (2) you make absolutely no changes to your copy. (The WEB system provides
+% for alterations via an auxiliary file; the master file should stay intact.)
+% In other words, METAFONT is under essentially the same ground rules as TeX.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+
+% Version 0 was completed on July 28, 1984.
+% Version 1 was completed on January 4, 1986; it corresponds to "Volume D".
+% Version 1.1 trivially corrected the punctuation in one message (June 1986).
+% Version 1.2 corrected an arithmetic overflow problem (July 1986).
+% Version 1.3 improved rounding when elliptical pens are made (November 1986).
+% Version 1.4 corrected scan_declared_variable timing (May 1988).
+% Version 1.5 fixed negative halving in allocator when mem_min<0 (June 1988).
+% Version 1.6 kept open_log_file from calling fatal_error (November 1988).
+% Version 1.7 solved that problem a better way (December 1988).
+% Version 1.8 introduced major changes for 8-bit extensions (September 1989).
+% Version 1.9 improved skimping and was edited for style (December 1989).
+% Version 2.0 fixed bug in addto; released with TeX version 3.0 (March 1990).
+% Version 2.7 made consistent with TeX version 3.1 (September 1990).
+% Version 2.71 fixed bug in draw, allowed unprintable filenames (March 1992).
+% Version 2.718 fixed bug in <Choose a dependent...> (March 1995).
+% Version 2.7182 fixed bugs related to "<unprintable char>" (August 1996).
+% Version 2.71828 suppressed autorounding in dangerous cases (December 2002).
+
+% A reward of $327.68 will be paid to the first finder of any remaining bug.
+
+% Although considerable effort has been expended to make the METAFONT program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the author hopes that users enjoy it.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\def\ph{\hbox{Pascal-H}}
+\def\psqrt#1{\sqrt{\mathstrut#1}}
+\def\k{_{k+1}}
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\font\tenlogo=logo10 % font used for the METAFONT logo
+\font\logos=logosl10
+\font\eightlogo=logo8
+\def\MF{{\tenlogo META}\-{\tenlogo FONT}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+\let\swap=\leftrightarrow
+\def\round{\mathop{\rm round}\nolimits}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+\outer\def\N#1. \[#2]#3.{\MN#1.\vfil\eject % begin starred section
+ \def\rhead{PART #2:\uppercase{#3}} % define running headline
+ \message{*\modno} % progress report
+ \edef\next{\write\cont{\Z{\?#2]#3}{\modno}{\the\pageno}}}\next
+ \ifon\startsection{\bf\ignorespaces#3.\quad}\ignorespaces}
+\let\?=\relax % we want to be able to \write a \?
+
+\def\title{{\eightlogo METAFONT}}
+\def\topofcontents{\hsize 5.5in
+ \vglue -30pt plus 1fil minus 1.5in
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+\pageno=3
+\def\glob{13} % this should be the section number of "<Global...>"
+\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
+
+@* \[1] Introduction.
+This is \MF, a font compiler intended to produce typefaces of high quality.
+The \PASCAL\ program that follows is the definition of \MF84, a standard
+@:PASCAL}{\PASCAL@>
+@!@:METAFONT84}{\MF84@>
+version of \MF\ that is designed to be highly portable so that identical output
+will be obtainable on a great variety of computers. The conventions
+of \MF84 are the same as those of \TeX82.
+
+The main purpose of the following program is to explain the algorithms of \MF\
+as clearly as possible. As a result, the program will not necessarily be very
+efficient when a particular \PASCAL\ compiler has translated it into a
+particular machine language. However, the program has been written so that it
+can be tuned to run efficiently in a wide variety of operating environments
+by making comparatively few changes. Such flexibility is possible because
+the documentation that follows is written in the \.{WEB} language, which is
+at a higher level than \PASCAL; the preprocessing step that converts \.{WEB}
+to \PASCAL\ is able to introduce most of the necessary refinements.
+Semi-automatic translation to other languages is also feasible, because the
+program below does not make extensive use of features that are peculiar to
+\PASCAL.
+
+A large piece of software like \MF\ has inherent complexity that cannot
+be reduced below a certain level of difficulty, although each individual
+part is fairly simple by itself. The \.{WEB} language is intended to make
+the algorithms as readable as possible, by reflecting the way the
+individual program pieces fit together and by providing the
+cross-references that connect different parts. Detailed comments about
+what is going on, and about why things were done in certain ways, have
+been liberally sprinkled throughout the program. These comments explain
+features of the implementation, but they rarely attempt to explain the
+\MF\ language itself, since the reader is supposed to be familiar with
+{\sl The {\logos METAFONT\/}book}.
+@.WEB@>
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+
+@ The present implementation has a long ancestry, beginning in the spring
+of~1977, when its author wrote a prototype set of subroutines and macros
+@^Knuth, Donald Ervin@>
+that were used to develop the first Computer Modern fonts.
+This original proto-\MF\ required the user to recompile a {\mc SAIL} program
+whenever any character was changed, because it was not a ``language'' for
+font design; the language was {\mc SAIL}. After several hundred characters
+had been designed in that way, the author developed an interpretable language
+called \MF, in which it was possible to express the Computer Modern programs
+less cryptically. A complete \MF\ processor was designed and coded by the
+author in 1979. This program, written in {\mc SAIL}, was adapted for use
+with a variety of typesetting equipment and display terminals by Leo Guibas,
+Lyle Ramshaw, and David Fuchs.
+@^Guibas, Leonidas Ioannis@>
+@^Ramshaw, Lyle Harold@>
+@^Fuchs, David Raymond@>
+Major improvements to the design of Computer Modern fonts were made in the
+spring of 1982, after which it became clear that a new language would
+better express the needs of letterform designers. Therefore an entirely
+new \MF\ language and system were developed in 1984; the present system
+retains the name and some of the spirit of \MF79, but all of the details
+have changed.
+
+No doubt there still is plenty of room for improvement, but the author
+is firmly committed to keeping \MF84 ``frozen'' from now on; stability
+and reliability are to be its main virtues.
+
+On the other hand, the \.{WEB} description can be extended without changing
+the core of \MF84 itself, and the program has been designed so that such
+extensions are not extremely difficult to make.
+The |banner| string defined here should be changed whenever \MF\
+undergoes any modifications, so that it will be clear which version of
+\MF\ might be the guilty party when a problem arises.
+@^extensions to \MF@>
+@^system dependencies@>
+
+If this program is changed, the resulting system should not be called
+`\MF\kern.5pt'; the official name `\MF\kern.5pt' by itself is reserved
+for software systems that are fully compatible with each other.
+A special test suite called the ``\.{TRAP} test'' is available for
+helping to determine whether an implementation deserves to be
+known as `\MF\kern.5pt' [cf.~Stanford Computer Science report CS1095,
+January 1986].
+
+@d banner=='This is METAFONT, Version 2.71828' {printed when \MF\ starts}
+
+@ Different \PASCAL s have slightly different conventions, and the present
+@!@:PASCAL H}{\ph@>
+program expresses \MF\ in terms of the \PASCAL\ that was
+available to the author in 1984. Constructions that apply to
+this particular compiler, which we shall call \ph, should help the
+reader see how to make an appropriate interface for other systems
+if necessary. (\ph\ is Charles Hedrick's modification of a compiler
+@^Hedrick, Charles Locke@>
+for the DECsystem-10 that was originally developed at the University of
+Hamburg; cf.\ {\sl SOFTWARE---Practice \AM\ Experience \bf6} (1976),
+29--42. The \MF\ program below is intended to be adaptable, without
+extensive changes, to most other versions of \PASCAL, so it does not fully
+use the admirable features of \ph. Indeed, a conscious effort has been
+made here to avoid using several idiosyncratic features of standard
+\PASCAL\ itself, so that most of the code can be translated mechanically
+into other high-level languages. For example, the `\&{with}' and `\\{new}'
+features are not used, nor are pointer types, set types, or enumerated
+scalar types; there are no `\&{var}' parameters, except in the case of files
+or in the system-dependent |paint_row| procedure;
+there are no tag fields on variant records; there are no |real| variables;
+no procedures are declared local to other procedures.)
+
+The portions of this program that involve system-dependent code, where
+changes might be necessary because of differences between \PASCAL\ compilers
+and/or differences between
+operating systems, can be identified by looking at the sections whose
+numbers are listed under `system dependencies' in the index. Furthermore,
+the index entries for `dirty \PASCAL' list all places where the restrictions
+of \PASCAL\ have not been followed perfectly, for one reason or another.
+@!@^system dependencies@>
+@!@^dirty \PASCAL@>
+
+@ The program begins with a normal \PASCAL\ program heading, whose
+components will be filled in later, using the conventions of \.{WEB}.
+@.WEB@>
+For example, the portion of the program called `\X\glob:Global
+variables\X' below will be replaced by a sequence of variable declarations
+that starts in $\section\glob$ of this documentation. In this way, we are able
+to define each individual global variable when we are prepared to
+understand what it means; we do not have to define all of the globals at
+once. Cross references in $\section\glob$, where it says ``See also
+sections \gglob, \dots,'' also make it possible to look at the set of
+all global variables, if desired. Similar remarks apply to the other
+portions of the program heading.
+
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \MF\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+
+@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:}
+@f mtype==type {`\&{mtype}' will be equivalent to `\&{type}'}
+@f type==true {but `|type|' will not be treated as a reserved word}
+
+@p @t\4@>@<Compiler directives@>@/
+program MF; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+mtype @<Types in the outer block@>@/
+var @<Global variables@>@/
+@#
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values of key variables@>@/
+ end;@#
+@t\4@>@<Basic printing procedures@>@/
+@t\4@>@<Error handling procedures@>@/
+
+@ The overall \MF\ program begins with the heading just shown, after which
+comes a bunch of procedure declarations and function declarations.
+Finally we will get to the main program, which begins with the
+comment `|start_here|'. If you want to skip down to the
+main program now, you can look up `|start_here|' in the index.
+But the author suggests that the best way to understand this program
+is to follow pretty much the order of \MF's components as they appear in the
+\.{WEB} description you are now reading, since the present ordering is
+intended to combine the advantages of the ``bottom up'' and ``top down''
+approaches to the problem of understanding a somewhat complicated system.
+
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_MF=1 {go here when \MF's variables are initialized}
+@d end_of_MF=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_MF@t\hskip-2pt@>, end_of_MF@t\hskip-2pt@>,@,final_end;
+ {key control points}
+
+@ Some of the code below is intended to be used only when diagnosing the
+strange behavior that sometimes occurs when \MF\ is being installed or
+when system wizards are fooling around with \MF\ without quite knowing
+what they are doing. Such code will not normally be compiled; it is
+delimited by the codewords `$|debug|\ldots|gubed|$', with apologies
+to people who wish to preserve the purity of English.
+
+Similarly, there is some conditional code delimited by
+`$|stat|\ldots|tats|$' that is intended for use when statistics are to be
+kept about \MF's memory usage. The |stat| $\ldots$ |tats| code also
+implements special diagnostic information that is printed when
+$\\{tracingedges}>1$.
+@^debugging@>
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@f stat==begin
+@f tats==end
+
+@ This program has two important variations: (1) There is a long and slow
+version called \.{INIMF}, which does the extra calculations needed to
+@.INIMF@>
+initialize \MF's internal tables; and (2)~there is a shorter and faster
+production version, which cuts the initialization to a bare minimum.
+Parts of the program that are needed in (1) but not in (2) are delimited by
+the codewords `$|init|\ldots|tini|$'.
+
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@f init==begin
+@f tini==end
+
+@ If the first character of a \PASCAL\ comment is a dollar sign,
+\ph\ treats the comment as a list of ``compiler directives'' that will
+affect the translation of this program into machine language. The
+directives shown below specify full checking and inclusion of the \PASCAL\
+debugger when \MF\ is being debugged, but they cause range checking and other
+redundant code to be eliminated when the production system is being generated.
+Arithmetic overflow will be detected in all cases.
+@^system dependencies@>
+@^Overflow in arithmetic@>
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ This \MF\ implementation conforms to the rules of the {\sl Pascal User
+@:PASCAL}{\PASCAL@>
+@^system dependencies@>
+Manual} published by Jensen and Wirth in 1975, except where system-dependent
+@^Wirth, Niklaus@>
+@^Jensen, Kathleen@>
+code is necessary to make a useful system program, and except in another
+respect where such conformity would unnecessarily obscure the meaning
+and clutter up the code: We assume that |case| statements may include a
+default case that applies if no matching label is found. Thus, we shall use
+constructions like
+$$\vbox{\halign{\ignorespaces#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the \ph\
+compiler allows `|others|:' as a default label, and other \PASCAL s allow
+syntaxes like `\&{else}' or `\&{otherwise}' or `\\{otherwise}:', etc. The
+definitions of |othercases| and |endcases| should be changed to agree with
+local conventions. Note that no semicolon appears before |endcases| in
+this program, so the definition of |endcases| should include a semicolon
+if the compiler wants one. (Of course, if no default mechanism is
+available, the |case| statements of \MF\ will have to be laboriously
+extended by listing all remaining cases. People who are stuck with such
+\PASCAL s have, in fact, done this, successfully but not happily!)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters can be changed at compile time to extend or
+reduce \MF's capacity. They may have different values in \.{INIMF} and
+in production versions of \MF.
+@.INIMF@>
+@^system dependencies@>
+
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \MF's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|}
+@!max_internal=100; {maximum number of internal quantities}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!screen_width=768; {number of pixels in each row of screen display}
+@!screen_depth=1024; {number of pixels in each column of screen display}
+@!stack_size=30; {maximum number of simultaneous input sources}
+@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MF's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MF's own strings, which is currently about 22000}
+@!move_size=5000; {space for storing moves in a single octant}
+@!max_wiggle=300; {number of autorounded points per cycle}
+@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='MFbases:MF.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.MFbases@>
+@!path_size=300; {maximum number of knots between breakpoints of a path}
+@!bistack_size=785; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=5000; {maximum number of ligature/kern steps, must be
+ at least 255 and at most 32510}
+@!max_kerns=500; {maximum number of distinct kern amounts}
+@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
+
+@ Like the preceding parameters, the following quantities can be changed
+at compile time to extend or reduce \MF's capacity. But if they are changed,
+it is necessary to rerun the initialization program \.{INIMF}
+@.INIMF@>
+to generate new tables for the production \MF\ program.
+One can't simply make helter-skelter changes to the following constants,
+since certain rather complex initialization
+numbers are computed from them. They are defined here using
+\.{WEB} macros, instead of being put into \PASCAL's |const| list, in order to
+emphasize this distinction.
+
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF};
+ must be substantially larger than |mem_min|
+ and not greater than |mem_max|}
+@d hash_size=2100 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d max_in_open=6 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=150 {maximum number of simultaneous macro parameters}
+@^system dependencies@>
+
+@ In case somebody has inadvertently made bad settings of the ``constants,''
+\MF\ checks them using a global variable called |bad|.
+
+This is the first of many sections of \MF\ where global variables are
+defined.
+
+@<Glob...@>=
+@!bad:integer; {is some ``constant'' wrong?}
+
+@ Later on we will say `\ignorespaces|if mem_max>=max_halfword then bad:=10|',
+or something similar. (We can't do that until |max_halfword| has been defined.)
+
+@<Check the ``constant'' values for consistency@>=
+bad:=0;
+if (half_error_line<30)or(half_error_line>error_line-15) then bad:=1;
+if max_print_line<60 then bad:=2;
+if gf_buf_size mod 8<>0 then bad:=3;
+if mem_min+1100>mem_top then bad:=4;
+if hash_prime>hash_size then bad:=5;
+if header_size mod 4 <> 0 then bad:=6;
+if(lig_table_size<255)or(lig_table_size>32510)then bad:=7;
+
+@ Labels are given symbolic names by the following definitions, so that
+occasional |goto| statements will be meaningful. We insert the label
+`|exit|' just before the `\ignorespaces|end|\unskip' of a procedure in
+which we have used the `|return|' statement defined below; the label
+`|restart|' is occasionally used at the very beginning of a procedure; and
+the label `|reswitch|' is occasionally used just prior to a |case|
+statement in which some cases change the conditions and we wish to branch
+to the newly applicable case. Loops that are set up with the |loop|
+construction defined below are commonly exited by going to `|done|' or to
+`|found|' or to `|not_found|', and they are sometimes repeated by going to
+`|continue|'. If two or more parts of a subroutine start differently but
+end up the same, the shared code may be gathered together at
+`|common_ending|'.
+
+Incidentally, this program never declares a label that isn't actually used,
+because some fussy \PASCAL\ compilers will complain about redundant labels.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d done1=31 {like |done|, when there is more than one loop}
+@d done2=32 {for exiting the second loop in a long block}
+@d done3=33 {for exiting the third loop in a very long block}
+@d done4=34 {for exiting the fourth loop in an extremely long block}
+@d done5=35 {for exiting the fifth loop in an immense block}
+@d done6=36 {for exiting the sixth loop in a block}
+@d found=40 {go here when you've found it}
+@d found1=41 {like |found|, when there's more than one per routine}
+@d found2=42 {like |found|, when there's more than two per routine}
+@d not_found=45 {go here when you've found nothing}
+@d common_ending=50 {go here when you want to merge with another branch}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d negate(#) == #:=-# {change the sign of a variable}
+@d double(#) == #:=#+# {multiply a variable by two}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@f loop == xclause
+ {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil {\.{WEB} will henceforth say |return| instead of \\{return}}
+
+@* \[2] The character set.
+In order to make \MF\ readily portable to a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+code that includes standard ASCII, the ``American Standard Code for
+Information Interchange.'' This conversion is done immediately when each
+character is read in. Conversely, characters are converted from ASCII to
+the user's external representation just before they are output to a
+text file.
+@^ASCII code@>
+
+Such an internal code is relevant to users of \MF\ only with respect to
+the \&{char} and \&{ASCII} operations, and the comparison of strings.
+
+@ Characters of text that have been converted to \MF's internal form
+are said to be of type |ASCII_code|, which is a subrange of the integers.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, especially in a program for font design;
+so the present specification of \MF\ has been written under the assumption
+that the \PASCAL\ compiler and run-time system permit the use of text files
+with more than 64 distinguishable characters. More precisely, we assume that
+the character set contains at least the letters and symbols associated
+with ASCII codes @'40 through @'176; all of these characters are now
+available on most computer terminals.
+
+Since we are dealing with more characters than were present in the first
+\PASCAL\ compilers, we have to decide what to call the associated data
+type. Some \PASCAL s use the original name |char| for the
+characters in text files, even though there now are more than 64 such
+characters, while other \PASCAL s consider |char| to be a 64-element
+subrange of a larger data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters that are converted to and
+from |ASCII_code| when they are input and output. We shall also assume
+that |text_char| consists of the elements |chr(first_text_char)| through
+|chr(last_text_char)|, inclusive. The following definitions should be
+adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Local variables for init...@>=
+@!i:integer;
+
+@ The \MF\ processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Glob...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ Since we are assuming that our \PASCAL\ system is able to read and
+write the visible characters of standard ASCII (although not
+necessarily using the ASCII codes to represent them), the following
+assignment statements initialize the standard part of the |xchr| array
+properly, without needing any system-dependent changes. On the other
+hand, it is possible to implement \MF\ with less complete character
+sets, and in such cases it will be necessary to change something here.
+@^system dependencies@>
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+
+@ The ASCII code is ``standard'' only to a certain extent, since many
+computer installations have found it advantageous to have ready access
+to more than 94 printing characters. If \MF\ is being used
+on a garden-variety \PASCAL\ for which only standard ASCII
+codes will appear in the input and output files, it doesn't really matter
+what codes are specified in |xchr[0..@'37]|, but the safest policy is to
+blank everything out by using the code shown below.
+
+However, other settings of |xchr| will make \MF\ more friendly on
+computers that have an extended character set, so that users can type things
+like `\.^^Z' instead of `\.{<>}'.
+People with extended character sets can
+assign codes arbitrarily, giving an |xchr| equivalent to whatever
+characters the users of \MF\ are allowed to have in their input files.
+Appropriate changes to \MF's |char_class| table should then be made.
+(Unlike \TeX, each installation of \MF\ has a fixed assignment of category
+codes, called the |char_class|.) Such changes make portability of programs
+more difficult, so they should be introduced cautiously if at all.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
+where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
+|j| or more; hence, standard ASCII code numbers will be used instead of
+codes below @'40 in case there is a coincidence.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'177;
+for i:=@'200 to @'377 do xord[xchr[i]]:=i;
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+
+@* \[3] Input and output.
+The bane of portability is the fact that different operating systems treat
+input and output quite differently, perhaps because computer scientists
+have not given sufficient attention to this problem. People have felt somehow
+that input and output are not part of ``real'' programming. Well, it is true
+that some kinds of programming are more fun than others. With existing
+input/output conventions being so diverse and so messy, the only sources of
+joy in such parts of the code are the rare occasions when one can find a
+way to make the program a little less bad than it might have been. We have
+two choices, either to attack I/O now and get it over with, or to postpone
+I/O until near the end. Neither prospect is very attractive, so let's
+get it over with.
+
+The basic operations we need to do are (1)~inputting and outputting of
+text, to or from a file or the user's terminal; (2)~inputting and
+outputting of eight-bit bytes, to or from a file; (3)~instructing the
+operating system to initiate (``open'') or to terminate (``close'') input or
+output from a specified file; (4)~testing whether the end of an input
+file has been reached; (5)~display of bits on the user's screen.
+The bit-display operation will be discussed in a later section; we shall
+deal here only with more traditional kinds of I/O.
+
+\MF\ needs to deal with two kinds of files.
+We shall use the term |alpha_file| for a file that contains textual data,
+and the term |byte_file| for a file that contains eight-bit binary information.
+These two types turn out to be the same on many computers, but
+sometimes there is a significant distinction, so we shall be careful to
+distinguish between them. Standard protocols for transferring
+such files from computer to computer, via high-speed networks, are
+now becoming available to more and more communities of users.
+
+The program actually makes use also of a third kind of file, called a
+|word_file|, when dumping and reloading base information for its own
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ Most of what we need to do with respect to input and output can be handled
+by the I/O facilities that are standard in \PASCAL, i.e., the routines
+called |get|, |put|, |eof|, and so on. But
+standard \PASCAL\ does not allow file variables to be associated with file
+names that are determined at run time, so it cannot be used to implement
+\MF; some sort of extension to \PASCAL's ordinary |reset| and |rewrite|
+is crucial for our purposes. We shall assume that |name_of_file| is a variable
+of an appropriate type such that the \PASCAL\ run-time system being used to
+implement \MF\ can open a file whose external name is specified by
+|name_of_file|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@!name_length:0..file_name_size;@/{this many characters are actually
+ relevant in |name_of_file| (the rest are blank)}
+
+@ The \ph\ compiler with which the present version of \MF\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `\ignorespaces|packed
+array[@t\<\\{any}>@>] of text_char|', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\MF\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\MF's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var @!f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var @!f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_out(var @!f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var @!f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var @!f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+@p procedure a_close(var @!f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var @!f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var @!f:word_file); {close a word file}
+begin close(f);
+end;
+
+@ Binary input and output are done with \PASCAL's ordinary |get| and |put|
+procedures, so we don't have to make any other special arrangements for
+binary~I/O. Text output is also easy to do with standard \PASCAL\ routines.
+The treatment of text input is more difficult, however, because
+of the necessary translation to |ASCII_code| values.
+\MF's conventions should be efficient, and they should
+blend nicely with the user's operating environment.
+
+@ Input from text files is read one line at a time, using a routine called
+|input_ln|. This function is defined in terms of global variables called
+|buffer|, |first|, and |last| that will be described in detail later; for
+now, it suffices for us to know that |buffer| is an array of |ASCII_code|
+values, and that |first| and |last| are indices into this array
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@!first:0..buf_size; {the first unused position in |buffer|}
+@!last:0..buf_size; {end of the line just input to |buffer|}
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+
+@ The |input_ln| function brings the next line of input from the specified
+field into available positions of the buffer array and returns the value
+|true|, unless the file has already been entirely read, in which case it
+returns |false| and sets |last:=first|. In general, the |ASCII_code|
+numbers that represent the next line of the file are input into
+|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the
+global variable |last| is set equal to |first| plus the length of the
+line. Trailing blanks are removed from the line; thus, either |last=first|
+(in which case the line was entirely blank) or |buffer[last-1]<>" "|.
+@^inner loop@>
+
+An overflow error is given, however, if the normal actions of |input_ln|
+would make |last>=buf_size|; this is done so that other parts of \MF\
+can safely look at the contents of |buffer[last+1]| without overstepping
+the bounds of the |buffer| array. Upon entry to |input_ln|, the condition
+|first<buf_size| will always hold, so that there is always room for an
+``empty'' line.
+
+The variable |max_buf_stack|, which is used to keep track of how large
+the |buf_size| parameter must be to accommodate the present job, is
+also kept up to date by |input_ln|.
+
+If the |bypass_eoln| parameter is |true|, |input_ln| will do a |get|
+before looking at the first character of the line; this skips over
+an |eoln| that was in |f^|. The procedure does not do a |get| when it
+reaches the end of the line; therefore it can be used to acquire input
+from the user's terminal as well as from ordinary text files.
+
+Standard \PASCAL\ says that a file should have |eoln| immediately
+before |eof|, but \MF\ needs only a weaker restriction: If |eof|
+occurs in the middle of a line, the system function |eoln| should return
+a |true| result (even though |f^| will be undefined).
+
+@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+
+@ The user's terminal acts essentially like other files of text, except
+that it is used both for input and for output. When the terminal is
+considered an input file, the file variable is called |term_in|, and when it
+is considered an output file the file variable is |term_out|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+
+@ Sometimes it is necessary to synchronize the input/output mixture that
+happens on the user's terminal, and three system-dependent
+procedures are used for this
+purpose. The first of these, |update_terminal|, is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+The second, |clear_terminal|, is called when we wish to cancel any
+input that the user may have typed ahead (since we are about to
+issue an unexpected error message). The third, |wake_up_terminal|,
+is supposed to revive the terminal if the user has disabled it by
+some instruction to the operating system. The following macros show how
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+
+@ We need a special routine to read the first line of \MF\ input from
+the user's terminal. This line is different because it is read before we
+have opened the transcript file; there is sort of a ``chicken and
+egg'' problem here. If the user types `\.{input cmr10}' on the first
+line, or if some macro invoked by that line does such an \.{input},
+the transcript file will be named `\.{cmr10.log}'; but if no \.{input}
+commands are performed during the first line of terminal input, the transcript
+file will acquire its default name `\.{mfput.log}'. (The transcript file
+will not contain error messages generated by the first line before the
+first \.{input} command.)
+@.mfput@>
+
+The first line is even more special if we are lucky enough to have an operating
+system that treats \MF\ differently from a run-of-the-mill \PASCAL\ object
+program. It's nice to let the user start running a \MF\ job by typing
+a command line like `\.{MF cmr10}'; in such a case, \MF\ will operate
+as if the first line of input were `\.{cmr10}', i.e., the first line will
+consist of the remainder of the command line, after the part that invoked \MF.
+
+The first line is special also because it may be read before \MF\ has
+input a base file. In such cases, normal error messages cannot yet
+be given. The following code uses concepts that will be explained later.
+(If the \PASCAL\ compiler does not support non-local |@!goto|, the
+@^system dependencies@>
+statement `|goto final_end|' should be replaced by something that
+quietly terminates the program.)
+
+@<Report overflow of the input buffer, and abort@>=
+if base_ident=0 then
+ begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+ end
+else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:METAFONT capacity exceeded buffer size}{\quad buffer size@>
+ end
+
+@ Different systems have different ways to get started. But regardless of
+what conventions are adopted, the routine that initializes the terminal
+should satisfy the following specifications:
+
+\yskip\textindent{1)}It should open file |term_in| for input from the
+ terminal. (The file |term_out| will already be open for output to the
+ terminal.)
+
+\textindent{2)}If the user has given a command line, this line should be
+ considered the first line of terminal input. Otherwise the
+ user should be prompted with `\.{**}', and the first line of input
+ should be whatever is typed in response.
+
+\textindent{3)}The first line of input, which might or might not be a
+ command line, should appear in locations |first| to |last-1| of the
+ |buffer| array.
+
+\textindent{4)}The global variable |loc| should be set so that the
+ character to be read next by \MF\ is in |buffer[loc]|. This
+ character should not be blank, and we should have |loc<last|.
+
+\yskip\noindent(It may be necessary to prompt the user several times
+before a non-blank line comes in. The prompt is `\.{**}' instead of the
+later `\.*' because the meaning is slightly different: `\.{input}' need
+not be typed immediately after~`\.{**}'.)
+
+@d loc==cur_input.loc_field {location of first unread character in |buffer|}
+
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+
+@* \[4] String handling.
+Symbolic token names and diagnostic messages are variable-length strings
+of eight-bit characters. Since \PASCAL\ does not have a well-developed string
+mechanism, \MF\ does all of its string processing by homegrown methods.
+
+Elaborate facilities for dynamic strings are not needed, so all of the
+necessary operations can be handled with a simple data structure.
+The array |str_pool| contains all of the (eight-bit) ASCII codes in all
+of the strings, and the array |str_start| contains indices of the starting
+points of each string. Strings are referred to by integer numbers, so that
+string number |s| comprises the characters |str_pool[j]| for
+|str_start[s]<=j<str_start[s+1]|. Additional integer variables
+|pool_ptr| and |str_ptr| indicate the number of entries used so far
+in |str_pool| and |str_start|, respectively; locations
+|str_pool[pool_ptr]| and |str_start[str_ptr]| are
+ready for the next string to be allocated.
+
+String numbers 0 to 255 are reserved for strings that correspond to single
+ASCII characters. This is in accordance with the conventions of \.{WEB},
+@.WEB@>
+which converts single-character strings into the ASCII code number of the
+single character involved, while it converts other strings into integers
+and builds a string pool file. Thus, when the string constant \.{"."} appears
+in the program below, \.{WEB} converts it into the integer 46, which is the
+ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"}
+into some integer greater than~255. String number 46 will presumably be the
+single character `\..'\thinspace; but some ASCII codes have no standard visible
+representation, and \MF\ may need to be able to print an arbitrary
+ASCII character, so the first 256 strings are used to specify exactly what
+should be printed for each of the 256 possibilities.
+
+Elements of the |str_pool| array must be ASCII codes that can actually be
+printed; i.e., they must have an |xchr| equivalent in the local
+character set. (This restriction applies only to preloaded strings,
+not to those generated dynamically by the user.)
+
+Some \PASCAL\ compilers won't pack integers into a single byte unless the
+integers lie in the range |-128..127|. To accommodate such systems
+we access the string pool only via macros that can easily be redefined.
+
+@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
+@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..255; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@!pool_ptr : pool_pointer; {first unused position in |str_pool|}
+@!str_ptr : str_number; {number of the current string being created}
+@!init_pool_ptr : pool_pointer; {the starting value of |pool_ptr|}
+@!init_str_ptr : str_number; {the starting value of |str_ptr|}
+@!max_pool_ptr : pool_pointer; {the maximum so far of |pool_ptr|}
+@!max_str_ptr : str_number; {the maximum so far of |str_ptr|}
+
+@ Several of the elementary string operations are performed using \.{WEB}
+macros instead of \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a string.
+@.WEB@>
+
+@d length(#)==(str_start[#+1]-str_start[#]) {the number of characters
+ in string number \#}
+
+@ The length of the current string is called |cur_length|:
+
+@d cur_length == (pool_ptr - str_start[str_ptr])
+
+@ Strings are created by appending character codes to |str_pool|.
+The |append_char| macro, defined here, does not check to see if the
+value of |pool_ptr| has gotten too high; this test is supposed to be
+made before |append_char| is used.
+
+To test if there is room to append |l| more characters to |str_pool|,
+we shall write |str_room(l)|, which aborts \MF\ and gives an
+apologetic error message if there isn't enough room.
+
+@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
+begin str_pool[pool_ptr]:=si(#); incr(pool_ptr);
+end
+@d str_room(#) == {make sure that the pool hasn't overflowed}
+ begin if pool_ptr+# > max_pool_ptr then
+ begin if pool_ptr+# > pool_size then
+ overflow("pool size",pool_size-init_pool_ptr);
+@:METAFONT capacity exceeded pool size}{\quad pool size@>
+ max_pool_ptr:=pool_ptr+#;
+ end;
+ end
+
+@ \MF's string expressions are implemented in a brute-force way: Every
+new string or substring that is needed is simply copied into the string pool.
+
+Such a scheme can be justified because string expressions aren't a big
+deal in \MF\ applications; strings rarely need to be saved from one
+statement to the next. But it would waste space needlessly if we didn't
+try to reclaim the space of strings that are going to be used only once.
+
+Therefore a simple reference count mechanism is provided: If there are
+@^reference counts@>
+no references to a certain string from elsewhere in the program, and
+if there are no references to any strings created subsequent to it,
+then the string space will be reclaimed.
+
+The number of references to string number |s| will be |str_ref[s]|. The
+special value |str_ref[s]=max_str_ref=127| is used to denote an unknown
+positive number of references; such strings will never be recycled. If
+a string is ever referred to more than 126 times, simultaneously, we
+put it in this category. Hence a single byte suffices to store each |str_ref|.
+
+@d max_str_ref=127 {``infinite'' number of references}
+@d add_str_ref(#)==begin if str_ref[#]<max_str_ref then incr(str_ref[#]);
+ end
+
+@<Glob...@>=
+@!str_ref:array[str_number] of 0..max_str_ref;
+
+@ Here's what we do when a string reference disappears:
+
+@d delete_str_ref(#)== begin if str_ref[#]<max_str_ref then
+ if str_ref[#]>1 then decr(str_ref[#])@+else flush_string(#);
+ end
+
+@<Declare the procedure called |flush_string|@>=
+procedure flush_string(@!s:str_number);
+begin if s<str_ptr-1 then str_ref[s]:=0
+else repeat decr(str_ptr);
+ until str_ref[str_ptr-1]<>0;
+pool_ptr:=str_start[str_ptr];
+end;
+
+@ Once a sequence of characters has been appended to |str_pool|, it
+officially becomes a string when the function |make_string| is called.
+This function returns the identification number of the new string as its
+value.
+
+@p function make_string : str_number; {current string enters the pool}
+begin if str_ptr=max_str_ptr then
+ begin if str_ptr=max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:METAFONT capacity exceeded number of strings}{\quad number of strings@>
+ incr(max_str_ptr);
+ end;
+str_ref[str_ptr]:=1; incr(str_ptr); str_start[str_ptr]:=pool_ptr;
+make_string:=str_ptr-1;
+end;
+
+@ The following subroutine compares string |s| with another string of the
+same length that appears in |buffer| starting at position |k|;
+the result is |true| if and only if the strings are equal.
+
+@p function str_eq_buf(@!s:str_number;@!k:integer):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var @!j: pool_pointer; {running index}
+@!result: boolean; {result of comparison}
+begin j:=str_start[s];
+while j<str_start[s+1] do
+ begin if so(str_pool[j])<>buffer[k] then
+ begin result:=false; goto not_found;
+ end;
+ incr(j); incr(k);
+ end;
+result:=true;
+not_found: str_eq_buf:=result;
+end;
+
+@ Here is a similar routine, but it compares two strings in the string pool,
+and it does not assume that they have the same length. If the first string
+is lexicographically greater than, less than, or equal to the second,
+the result is respectively positive, negative, or zero.
+
+@p function str_vs_str(@!s,@!t:str_number):integer;
+ {test equality of strings}
+label exit;
+var @!j,@!k: pool_pointer; {running indices}
+@!ls,@!lt:integer; {lengths}
+@!l:integer; {length remaining to test}
+begin ls:=length(s); lt:=length(t);
+if ls<=lt then l:=ls@+else l:=lt;
+j:=str_start[s]; k:=str_start[t];
+while l>0 do
+ begin if str_pool[j]<>str_pool[k] then
+ begin str_vs_str:=str_pool[j]-str_pool[k]; return;
+ end;
+ incr(j); incr(k); decr(l);
+ end;
+str_vs_str:=ls-lt;
+exit:end;
+
+@ The initial values of |str_pool|, |str_start|, |pool_ptr|,
+and |str_ptr| are computed by the \.{INIMF} program, based in part
+on the information that \.{WEB} has output while processing \MF.
+@.INIMF@>
+@^string pool@>
+
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+ but returns |false| if something goes wrong}
+label done,exit;
+var @!k,@!l:0..255; {small indices or counters}
+@!m,@!n:text_char; {characters input from |pool_file|}
+@!g:str_number; {garbage}
+@!a:integer; {accumulator for check sum}
+@!c:boolean; {check sum has been checked}
+begin pool_ptr:=0; str_ptr:=0; max_pool_ptr:=0; max_str_ptr:=0; str_start[0]:=0;
+@<Make the first 256 strings@>;
+@<Read the other strings from the \.{MF.POOL} file and return |true|,
+ or give an error message and return |false|@>;
+exit:end;
+tini
+
+@ @d app_lc_hex(#)==l:=#;
+ if l<10 then append_char(l+"0")@+else append_char(l-10+"a")
+
+@<Make the first 256...@>=
+for k:=0 to 255 do
+ begin if (@<Character |k| cannot be printed@>) then
+ begin append_char("^"); append_char("^");
+ if k<@'100 then append_char(k+@'100)
+ else if k<@'200 then append_char(k-@'100)
+ else begin app_lc_hex(k div 16); app_lc_hex(k mod 16);
+ end;
+ end
+ else append_char(k);
+ g:=make_string; str_ref[g]:=max_str_ref;
+ end
+
+@ The first 128 strings will contain 95 standard ASCII characters, and the
+other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
+unless a system-dependent change is made here. Installations that have
+an extended character set, where for example |xchr[@'32]=@t\.{\'^^Z\'}@>|,
+would like string @'32 to be the single character @'32 instead of the
+three characters @'136, @'136, @'132 (\.{\^\^Z}). On the other hand,
+even people with an extended character set will want to represent string
+@'15 by \.{\^\^M}, since @'15 is ASCII's ``carriage return'' code; the idea is
+to produce visible strings instead of tabs or line-feeds or carriage-returns
+or bell-rings or characters that are treated anomalously in text files.
+
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+The boolean expression defined here should be |true| unless \MF\ internal
+code number~|k| corresponds to a non-troublesome visible symbol in the
+local character set.
+If character |k| cannot be printed, and |k<@'200|, then character |k+@'100| or
+|k-@'100| must be printable; moreover, ASCII codes |[@'60..@'71, @'141..@'146]|
+must be printable.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Character |k| cannot be printed@>=
+ (k<" ")or(k>"~")
+
+@ When the \.{WEB} system program called \.{TANGLE} processes the \.{MF.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{MF.PAS} and also a string pool file called \.{MF.POOL}. The \.{INIMF}
+@.WEB@>@.INIMF@>
+program reads the latter file, where each string appears as a two-digit decimal
+length followed by the string itself, and the information is recorded in
+\MF's string memory.
+
+@<Glob...@>=
+@!init @!pool_file:alpha_file; {the string-pool file output by \.{TANGLE}}
+tini
+
+@ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#);
+ a_close(pool_file); get_strings_started:=false; return;
+ end
+@<Read the other strings...@>=
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+ begin c:=false;
+ repeat @<Read one string, but return |false| if the
+ string memory space is getting too tight for comfort@>;
+ until c;
+ a_close(pool_file); get_strings_started:=true;
+ end
+else bad_pool('! I can''t read MF.POOL.')
+@.I can't read MF.POOL@>
+
+@ @<Read one string...@>=
+begin if eof(pool_file) then bad_pool('! MF.POOL has no check sum.');
+@.MF.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+if m='*' then @<Check the pool check sum@>
+else begin if (xord[m]<"0")or(xord[m]>"9")or@|
+ (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! MF.POOL line doesn''t begin with two digits.');
+@.MF.POOL line doesn't...@>
+ l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(xord[m]);
+ end;
+ read_ln(pool_file); g:=make_string; str_ref[g]:=max_str_ref;
+ end;
+end
+
+@ The \.{WEB} operation \.{@@\$} denotes the value that should be at the
+end of this \.{MF.POOL} file; any other value means that the wrong pool
+file has been loaded.
+@^check sum@>
+
+@<Check the pool check sum@>=
+begin a:=0; k:=1;
+loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! MF.POOL check sum doesn''t have nine digits.');
+@.MF.POOL check sum...@>
+ a:=10*a+xord[n]-"0";
+ if k=9 then goto done;
+ incr(k); read(pool_file,n);
+ end;
+done: if a<>@$ then bad_pool('! MF.POOL doesn''t match; TANGLE me again.');
+@.MF.POOL doesn't match@>
+c:=true;
+end
+
+@* \[5] On-line and off-line printing.
+Messages that are sent to a user's terminal and to the transcript-log file
+are produced by several `|print|' procedures. These procedures will
+direct their output to a variety of places, based on the setting of
+the global variable |selector|, which has the following possible
+values:
+
+\yskip
+\hang |term_and_log|, the normal setting, prints on the terminal and on the
+ transcript file.
+
+\hang |log_only|, prints only on the transcript file.
+
+\hang |term_only|, prints only on the terminal.
+
+\hang |no_print|, doesn't print at all. This is used only in rare cases
+ before the transcript file is open.
+
+\hang |pseudo|, puts output into a cyclic buffer that is used
+ by the |show_context| routine; when we get to that routine we shall discuss
+ the reasoning behind this curious mode.
+
+\hang |new_string|, appends the output to the current string in the
+ string pool.
+
+\yskip
+\noindent The symbolic names `|term_and_log|', etc., have been assigned
+numeric codes that satisfy the convenient relations |no_print+1=term_only|,
+|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|.
+
+Three additional global variables, |tally| and |term_offset| and
+|file_offset|, record the number of characters that have been printed
+since they were most recently cleared to zero. We use |tally| to record
+the length of (possibly very long) stretches of printing; |term_offset|
+and |file_offset|, on the other hand, keep track of how many characters
+have appeared so far on the current line that has been output to the
+terminal or to the transcript file, respectively.
+
+@d no_print=0 {|selector| setting that makes data disappear}
+@d term_only=1 {printing is destined for the terminal only}
+@d log_only=2 {printing is destined for the transcript file only}
+@d term_and_log=3 {normal |selector| setting}
+@d pseudo=4 {special |selector| setting for |show_context|}
+@d new_string=5 {printing is deflected to the string pool}
+@d max_selector=5 {highest selector setting}
+
+@<Glob...@>=
+@!log_file : alpha_file; {transcript of \MF\ session}
+@!selector : 0..max_selector; {where to print a message}
+@!dig : array[0..22] of 0..15; {digits in a number being output}
+@!tally : integer; {the number of characters recently printed}
+@!term_offset : 0..max_print_line;
+ {the number of characters on the current terminal line}
+@!file_offset : 0..max_print_line;
+ {the number of characters on the current file line}
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+ pseudoprinting}
+@!trick_count: integer; {threshold for pseudoprinting, explained later}
+@!first_count: integer; {another variable for pseudoprinting}
+
+@ @<Initialize the output routines@>=
+selector:=term_only; tally:=0; term_offset:=0; file_offset:=0;
+
+@ Macro abbreviations for output to the terminal and to the log file are
+defined here for convenience. Some systems need special conventions
+for terminal output, and it is possible to adhere to those conventions
+by changing |wterm|, |wterm_ln|, and |wterm_cr| here.
+@^system dependencies@>
+
+@d wterm(#)==write(term_out,#)
+@d wterm_ln(#)==write_ln(term_out,#)
+@d wterm_cr==write_ln(term_out)
+@d wlog(#)==write(log_file,#)
+@d wlog_ln(#)==write_ln(log_file,#)
+@d wlog_cr==write_ln(log_file)
+
+@ To end a line of text output, we call |print_ln|.
+
+@<Basic print...@>=
+procedure print_ln; {prints an end-of-line}
+begin case selector of
+term_and_log: begin wterm_cr; wlog_cr;
+ term_offset:=0; file_offset:=0;
+ end;
+log_only: begin wlog_cr; file_offset:=0;
+ end;
+term_only: begin wterm_cr; term_offset:=0;
+ end;
+no_print,pseudo,new_string: do_nothing;
+end; {there are no other cases}
+end; {note that |tally| is not affected}
+
+@ The |print_char| procedure sends one character to the desired destination,
+using the |xchr| array to map it into an external character compatible with
+|input_ln|. All printing comes through |print_ln| or |print_char|.
+
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+begin case selector of
+term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin wlog(xchr[s]); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin wterm(xchr[s]); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+end; {there are no other cases}
+incr(tally);
+end;
+
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \MF\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+var @!j:pool_pointer; {current character code position}
+begin if (s<0)or(s>=str_ptr) then s:="???"; {this can't happen}
+@.???@>
+if (s<256)and(selector>pseudo) then print_char(s)
+else begin j:=str_start[s];
+ while j<str_start[s+1] do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+ end;
+end;
+
+@ Sometimes it's necessary to print a string whose characters
+may not be visible ASCII codes. In that case |slow_print| is used.
+
+@<Basic print...@>=
+procedure slow_print(@!s:integer); {prints string |s|}
+var @!j:pool_pointer; {current character code position}
+begin if (s<0)or(s>=str_ptr) then s:="???"; {this can't happen}
+@.???@>
+if (s<256)and(selector>pseudo) then print_char(s)
+else begin j:=str_start[s];
+ while j<str_start[s+1] do
+ begin print(so(str_pool[j])); incr(j);
+ end;
+ end;
+end;
+
+@ Here is the very first thing that \MF\ prints: a headline that identifies
+the version number and base name. The |term_offset| variable is temporarily
+incorrect, but the discrepancy is not serious since we assume that the banner
+and base identifier together will occupy at most |max_print_line|
+character positions.
+
+@<Initialize the output...@>=
+wterm(banner);
+if base_ident=0 then wterm_ln(' (no base preloaded)')
+else begin slow_print(base_ident); print_ln;
+ end;
+update_terminal;
+
+@ The procedure |print_nl| is like |print|, but it makes sure that the
+string appears at the beginning of a new line.
+
+@<Basic print...@>=
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+ ((file_offset>0)and(selector>=log_only)) then print_ln;
+print(s);
+end;
+
+@ An array of digits in the range |0..9| is printed by |print_the_digs|.
+
+@<Basic print...@>=
+procedure print_the_digs(@!k:eight_bits);
+ {prints |dig[k-1]|$\,\ldots\,$|dig[0]|}
+begin while k>0 do
+ begin decr(k); print_char("0"+dig[k]);
+ end;
+end;
+
+@ The following procedure, which prints out the decimal representation of a
+given integer |n|, has been written carefully so that it works properly
+if |n=0| or if |(-n)| would cause overflow. It does not apply |mod| or |div|
+to negative arguments, since such operations are not implemented consistently
+by all \PASCAL\ compilers.
+
+@<Basic print...@>=
+procedure print_int(@!n:integer); {prints an integer in decimal form}
+var k:0..23; {index to current digit; we assume that $|n|<10^{23}$}
+@!m:integer; {used to negate |n| in possibly dangerous cases}
+begin k:=0;
+if n<0 then
+ begin print_char("-");
+ if n>-100000000 then negate(n)
+ else begin m:=-1-n; n:=m div 10; m:=(m mod 10)+1; k:=1;
+ if m<10 then dig[0]:=m
+ else begin dig[0]:=0; incr(n);
+ end;
+ end;
+ end;
+repeat dig[k]:=n mod 10; n:=n div 10; incr(k);
+until n=0;
+print_the_digs(k);
+end;
+
+@ \MF\ also makes use of a trivial procedure to print two digits. The
+following subroutine is usually called with a parameter in the range |0<=n<=99|.
+
+@p procedure print_dd(@!n:integer); {prints two least significant digits}
+begin n:=abs(n) mod 100; print_char("0"+(n div 10));
+print_char("0"+(n mod 10));
+end;
+
+@ Here is a procedure that asks the user to type a line of input,
+assuming that the |selector| setting is either |term_only| or |term_and_log|.
+The input is placed into locations |first| through |last-1| of the
+|buffer| array, and echoed on the transcript file if appropriate.
+
+This procedure is never called when |interaction<scroll_mode|.
+
+@d prompt_input(#)==begin wake_up_terminal; print(#); term_input;
+ end {prints a string and gets a line of input}
+
+@p procedure term_input; {gets a line from the terminal}
+var @!k:0..buf_size; {index into |buffer|}
+begin update_terminal; {now the user sees the prompt for sure}
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@.End of file on the terminal@>
+term_offset:=0; {the user's line ended with \<\rm return>}
+decr(selector); {prepare to echo the input}
+if last<>first then for k:=first to last-1 do print(buffer[k]);
+print_ln; buffer[last]:="%"; incr(selector); {restore previous status}
+end;
+
+@* \[6] Reporting errors.
+When something anomalous is detected, \MF\ typically does something like this:
+$$\vbox{\halign{#\hfil\cr
+|print_err("Something anomalous has been detected");|\cr
+|help3("This is the first line of my offer to help.")|\cr
+|("This is the second line. I'm trying to")|\cr
+|("explain the best way for you to proceed.");|\cr
+|error;|\cr}}$$
+A two-line help message would be given using |help2|, etc.; these informal
+helps should use simple vocabulary that complements the words used in the
+official error message that was printed. (Outside the U.S.A., the help
+messages should preferably be translated into the local vernacular. Each
+line of help is at most 60 characters long, in the present implementation,
+so that |max_print_line| will not be exceeded.)
+
+The |print_err| procedure supplies a `\.!' before the official message,
+and makes sure that the terminal is awake if a stop is going to occur.
+The |error| procedure supplies a `\..' after the official message, then it
+shows the location of the error; and if |interaction=error_stop_mode|,
+it also enters into a dialog with the user, during which time the help
+message may be printed.
+@^system dependencies@>
+
+@ The global variable |interaction| has four settings, representing increasing
+amounts of user interaction:
+
+@d batch_mode=0 {omits all stops and omits terminal output}
+@d nonstop_mode=1 {omits all stops}
+@d scroll_mode=2 {omits error stops}
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal;
+ print_nl("! "); print(#);
+@.!\relax@>
+ end
+
+@<Glob...@>=
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+
+@ @<Set init...@>=interaction:=error_stop_mode;
+
+@ \MF\ is careful not to call |error| when the print |selector| setting
+might be unusual. The only possible values of |selector| at the time of
+error messages are
+
+\yskip\hang|no_print| (when |interaction=batch_mode|
+ and |log_file| not yet open);
+
+\hang|term_only| (when |interaction>batch_mode| and |log_file| not yet open);
+
+\hang|log_only| (when |interaction=batch_mode| and |log_file| is open);
+
+\hang|term_and_log| (when |interaction>batch_mode| and |log_file| is open).
+
+@<Initialize the print |selector| based on |interaction|@>=
+if interaction=batch_mode then selector:=no_print@+else selector:=term_only
+
+@ A global variable |deletions_allowed| is set |false| if the |get_next|
+routine is active when |error| is called; this ensures that |get_next|
+will never be called recursively.
+@^recursion@>
+
+The global variable |history| records the worst level of error that
+has been detected. It has four possible values: |spotless|, |warning_issued|,
+|error_message_issued|, and |fatal_error_stop|.
+
+Another global variable, |error_count|, is increased by one when an
+|error| occurs without an interactive dialog, and it is reset to zero at
+the end of every statement. If |error_count| reaches 100, \MF\ decides
+that there is no point in continuing further.
+
+@d spotless=0 {|history| value when nothing has been amiss yet}
+@d warning_issued=1 {|history| value when |begin_diagnostic| has been called}
+@d error_message_issued=2 {|history| value when |error| has been called}
+@d fatal_error_stop=3 {|history| value when termination was premature}
+
+@<Glob...@>=
+@!deletions_allowed:boolean; {is it safe for |error| to call |get_next|?}
+@!history:spotless..fatal_error_stop; {has the source input been clean so far?}
+@!error_count:-1..100; {the number of scrolled errors since the
+ last statement ended}
+
+@ The value of |history| is initially |fatal_error_stop|, but it will
+be changed to |spotless| if \MF\ survives the initialization process.
+
+@<Set init...@>=
+deletions_allowed:=true; error_count:=0; {|history| is initialized elsewhere}
+
+@ Since errors can be detected almost anywhere in \MF, we want to declare the
+error procedures near the beginning of the program. But the error procedures
+in turn use some other procedures, which need to be declared |forward|
+before we get to |error| itself.
+
+It is possible for |error| to be called recursively if some error arises
+when |get_next| is being used to delete a token, and/or if some fatal error
+occurs while \MF\ is trying to fix a non-fatal one. But such recursion
+@^recursion@>
+is never more than two levels deep.
+
+@<Error handling...@>=
+procedure@?normalize_selector; forward;@t\2@>@/
+procedure@?get_next; forward;@t\2@>@/
+procedure@?term_input; forward;@t\2@>@/
+procedure@?show_context; forward;@t\2@>@/
+procedure@?begin_file_reading; forward;@t\2@>@/
+procedure@?open_log_file; forward;@t\2@>@/
+procedure@?close_files_and_terminate; forward;@t\2@>@/
+procedure@?clear_for_error_prompt; forward;@t\2@>@/
+@t\4\hskip-\fontdimen2\font@>@;@+@!debug@+procedure@?debug_help;
+ forward;@;@+gubed@;@/
+@t\4@>@<Declare the procedure called |flush_string|@>
+
+@ Individual lines of help are recorded in the array |help_line|, which
+contains entries in positions |0..(help_ptr-1)|. They should be printed
+in reverse order, i.e., with |help_line[0]| appearing last.
+
+@d hlp1(#)==help_line[0]:=#;@+end
+@d hlp2(#)==help_line[1]:=#; hlp1
+@d hlp3(#)==help_line[2]:=#; hlp2
+@d hlp4(#)==help_line[3]:=#; hlp3
+@d hlp5(#)==help_line[4]:=#; hlp4
+@d hlp6(#)==help_line[5]:=#; hlp5
+@d help0==help_ptr:=0 {sometimes there might be no help}
+@d help1==@+begin help_ptr:=1; hlp1 {use this with one help line}
+@d help2==@+begin help_ptr:=2; hlp2 {use this with two help lines}
+@d help3==@+begin help_ptr:=3; hlp3 {use this with three help lines}
+@d help4==@+begin help_ptr:=4; hlp4 {use this with four help lines}
+@d help5==@+begin help_ptr:=5; hlp5 {use this with five help lines}
+@d help6==@+begin help_ptr:=6; hlp6 {use this with six help lines}
+
+@<Glob...@>=
+@!help_line:array[0..5] of str_number; {helps for the next |error|}
+@!help_ptr:0..6; {the number of help lines present}
+@!use_err_help:boolean; {should the |err_help| string be shown?}
+@!err_help:str_number; {a string set up by \&{errhelp}}
+
+@ @<Set init...@>=
+help_ptr:=0; use_err_help:=false; err_help:=0;
+
+@ The |jump_out| procedure just cuts across all active procedure levels and
+goes to |end_of_MF|. This is the only nontrivial |@!goto| statement in the
+whole program. It is used when there is no recovery from a particular error.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the body of |jump_out| should simply be
+`|close_files_and_terminate|;\thinspace' followed by a call on some system
+procedure that quietly terminates the program.
+
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_MF;
+end;
+
+@ Here now is the general |error| routine.
+
+@<Error hand...@>=
+procedure error; {completes the job of error reporting}
+label continue,exit;
+var @!c:ASCII_code; {what the user types}
+@!s1,@!s2,@!s3:integer; {used to save global variables when deleting tokens}
+@!j:pool_pointer; {character position being printed}
+begin if history<error_message_issued then history:=error_message_issued;
+print_char("."); show_context;
+if interaction=error_stop_mode then @<Get user's advice and |return|@>;
+incr(error_count);
+if error_count=100 then
+ begin print_nl("(That makes 100 errors; please try again.)");
+@.That makes 100 errors...@>
+ history:=fatal_error_stop; jump_out;
+ end;
+@<Put help message on the transcript file@>;
+exit:end;
+
+@ @<Get user's advice...@>=
+loop@+begin continue: clear_for_error_prompt; prompt_input("? ");
+@.?\relax@>
+ if last=first then return;
+ c:=buffer[first];
+ if c>="a" then c:=c+"A"-"a"; {convert to uppercase}
+ @<Interpret code |c| and |return| if done@>;
+ end
+
+@ It is desirable to provide an `\.E' option here that gives the user
+an easy way to return from \MF\ to the system editor, with the offending
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+
+@<Interpret code |c| and |return| if done@>=
+case c of
+"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then
+ @<Delete |c-"0"| tokens and |goto continue|@>;
+@t\4\4@>@;@+@!debug "D":begin debug_help;goto continue;@+end;@+gubed@/
+"E": if file_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ slow_print(input_stack[file_ptr].name_field);
+ print(" at line "); print_int(line);@/
+ interaction:=scroll_mode; jump_out;
+ end;
+"H": @<Print the help information and |goto continue|@>;
+"I":@<Introduce new material from the terminal and |return|@>;
+"Q","R","S":@<Change the interaction level and |return|@>;
+"X":begin interaction:=scroll_mode; jump_out;
+ end;
+othercases do_nothing
+endcases;@/
+@<Print the menu of available options@>
+
+@ @<Print the menu...@>=
+begin print("Type <return> to proceed, S to scroll future error messages,");@/
+@.Type <return> to proceed...@>
+print_nl("R to run without stopping, Q to run quietly,");@/
+print_nl("I to insert something, ");
+if file_ptr>0 then print("E to edit your file,");
+if deletions_allowed then
+ print_nl("1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
+print_nl("H for help, X to quit.");
+end
+
+@ Here the author of \MF\ apologizes for making use of the numerical
+relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings
+|batch_mode|, |nonstop_mode|, |scroll_mode|.
+@^Knuth, Donald Ervin@>
+
+@<Change the interaction...@>=
+begin error_count:=0; interaction:=batch_mode+c-"Q";
+print("OK, entering ");
+case c of
+"Q":begin print("batchmode"); decr(selector);
+ end;
+"R":print("nonstopmode");
+"S":print("scrollmode");
+end; {there are no other cases}
+print("..."); print_ln; update_terminal; return;
+end
+
+@ When the following code is executed, |buffer[(first+1)..(last-1)]| may
+contain the material inserted by the user; otherwise another prompt will
+be given. In order to understand this part of the program fully, you need
+to be familiar with \MF's input stacks.
+
+@<Introduce new material...@>=
+begin begin_file_reading; {enter a new syntactic level for terminal input}
+if last>first+1 then
+ begin loc:=first+1; buffer[first]:=" ";
+ end
+else begin prompt_input("insert>"); loc:=first;
+@.insert>@>
+ end;
+first:=last+1; cur_input.limit_field:=last; return;
+end
+
+@ We allow deletion of up to 99 tokens at a time.
+
+@<Delete |c-"0"| tokens...@>=
+begin s1:=cur_cmd; s2:=cur_mod; s3:=cur_sym; OK_to_interrupt:=false;
+if (last>first+1) and (buffer[first+1]>="0")and(buffer[first+1]<="9") then
+ c:=c*10+buffer[first+1]-"0"*11
+else c:=c-"0";
+while c>0 do
+ begin get_next; {one-level recursive call of |error| is possible}
+ @<Decrease the string reference count, if the current token is a string@>;
+ decr(c);
+ end;
+cur_cmd:=s1; cur_mod:=s2; cur_sym:=s3; OK_to_interrupt:=true;
+help2("I have just deleted some text, as you asked.")@/
+("You can now delete more, or insert, or whatever.");
+show_context; goto continue;
+end
+
+@ @<Print the help info...@>=
+begin if use_err_help then
+ begin @<Print the string |err_help|, possibly on several lines@>;
+ use_err_help:=false;
+ end
+else begin if help_ptr=0 then
+ help2("Sorry, I don't know how to help in this situation.")@/
+ @t\kern1em@>("Maybe you should try asking a human?");
+ repeat decr(help_ptr); print(help_line[help_ptr]); print_ln;
+ until help_ptr=0;
+ end;
+help4("Sorry, I already gave what help I could...")@/
+ ("Maybe you should try asking a human?")@/
+ ("An error might have occurred before I noticed any problems.")@/
+ ("``If all else fails, read the instructions.''");@/
+goto continue;
+end
+
+@ @<Print the string |err_help|, possibly on several lines@>=
+j:=str_start[err_help];
+while j<str_start[err_help+1] do
+ begin if str_pool[j]<>si("%") then print(so(str_pool[j]))
+ else if j+1=str_start[err_help+1] then print_ln
+ else if str_pool[j+1]<>si("%") then print_ln
+ else begin incr(j); print_char("%");
+ end;
+ incr(j);
+ end
+
+@ @<Put help message on the transcript file@>=
+if interaction>batch_mode then decr(selector); {avoid terminal output}
+if use_err_help then
+ begin print_nl("");
+ @<Print the string |err_help|, possibly on several lines@>;
+ end
+else while help_ptr>0 do
+ begin decr(help_ptr); print_nl(help_line[help_ptr]);
+ end;
+print_ln;
+if interaction>batch_mode then incr(selector); {re-enable terminal output}
+print_ln
+
+@ In anomalous cases, the print selector might be in an unknown state;
+the following subroutine is called to fix things just enough to keep
+running a bit longer.
+
+@p procedure normalize_selector;
+begin if log_opened then selector:=term_and_log
+else selector:=term_only;
+if job_name=0 then open_log_file;
+if interaction=batch_mode then decr(selector);
+end;
+
+@ The following procedure prints \MF's last words before dying.
+
+@d succumb==begin if interaction=error_stop_mode then
+ interaction:=scroll_mode; {no more interaction}
+ if log_opened then error;
+ @!debug if interaction>batch_mode then debug_help;@;@+gubed@;@/
+ history:=fatal_error_stop; jump_out; {irrecoverable error}
+ end
+
+@<Error hand...@>=
+procedure fatal_error(@!s:str_number); {prints |s|, and that's it}
+begin normalize_selector;@/
+print_err("Emergency stop"); help1(s); succumb;
+@.Emergency stop@>
+end;
+
+@ Here is the most dreaded error message.
+
+@<Error hand...@>=
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("METAFONT capacity exceeded, sorry [");
+@.METAFONT capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+ ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+
+@ The program might sometime run completely amok, at which point there is
+no choice but to stop. If no previous error has been detected, that's bad
+news; a message is printed that is really intended for the \MF\
+maintenance person instead of the user (unless the user has been
+particularly diabolical). The index entries for `this can't happen' may
+help to pinpoint the problem.
+@^dry rot@>
+
+@<Error hand...@>=
+procedure confusion(@!s:str_number);
+ {consistency check violated; |s| tells where}
+begin normalize_selector;
+if history<error_message_issued then
+ begin print_err("This can't happen ("); print(s); print_char(")");
+@.This can't happen@>
+ help1("I'm broken. Please show this to someone who can fix can fix");
+ end
+else begin print_err("I can't go on meeting you like this");
+@.I can't go on...@>
+ help2("One of your faux pas seems to have wounded me deeply...")@/
+ ("in fact, I'm barely conscious. Please fix it and try again.");
+ end;
+succumb;
+end;
+
+@ Users occasionally want to interrupt \MF\ while it's running.
+If the \PASCAL\ runtime system allows this, one can implement
+a routine that sets the global variable |interrupt| to some nonzero value
+when such an interrupt is signalled. Otherwise there is probably at least
+a way to make |interrupt| nonzero using the \PASCAL\ debugger.
+@^system dependencies@>
+@^debugging@>
+
+@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
+ end
+
+@<Global...@>=
+@!interrupt:integer; {should \MF\ pause for instructions?}
+@!OK_to_interrupt:boolean; {should interrupts be observed?}
+
+@ @<Set init...@>=
+interrupt:=0; OK_to_interrupt:=true;
+
+@ When an interrupt has been detected, the program goes into its
+highest interaction level and lets the user have the full flexibility of
+the |error| routine. \MF\ checks for interrupts only at times when it is
+safe to do this.
+
+@p procedure pause_for_instructions;
+begin if OK_to_interrupt then
+ begin interaction:=error_stop_mode;
+ if (selector=log_only)or(selector=no_print) then
+ incr(selector);
+ print_err("Interruption");
+@.Interruption@>
+ help3("You rang?")@/
+ ("Try to insert some instructions for me (e.g.,`I show x'),")@/
+ ("unless you just want to quit by typing `X'.");
+ deletions_allowed:=false; error; deletions_allowed:=true;
+ interrupt:=0;
+ end;
+end;
+
+@ Many of \MF's error messages state that a missing token has been
+inserted behind the scenes. We can save string space and program space
+by putting this common code into a subroutine.
+
+@p procedure missing_err(@!s:str_number);
+begin print_err("Missing `"); print(s); print("' has been inserted");
+@.Missing...inserted@>
+end;
+
+@* \[7] Arithmetic with scaled numbers.
+The principal computations performed by \MF\ are done entirely in terms of
+integers less than $2^{31}$ in magnitude; thus, the arithmetic specified in this
+program can be carried out in exactly the same way on a wide variety of
+computers, including some small ones.
+@^small computers@>
+
+But \PASCAL\ does not define the @!|div|
+operation in the case of negative dividends; for example, the result of
+|(-2*n-1) div 2| is |-(n+1)| on some computers and |-n| on others.
+There are two principal types of arithmetic: ``translation-preserving,''
+in which the identity |(a+q*b)div b=(a div b)+q| is valid; and
+``negation-preserving,'' in which |(-a)div b=-(a div b)|. This leads to
+two \MF s, which can produce different results, although the differences
+should be negligible when the language is being used properly.
+The \TeX\ processor has been defined carefully so that both varieties
+of arithmetic will produce identical output, but it would be too
+inefficient to constrain \MF\ in a similar way.
+
+@d el_gordo == @'17777777777 {$2^{31}-1$, the largest value that \MF\ likes}
+
+@ One of \MF's most common operations is the calculation of
+$\lfloor{a+b\over2}\rfloor$,
+the midpoint of two given integers |a| and~|b|. The only decent way to do
+this in \PASCAL\ is to write `|(a+b) div 2|'; but on most machines it is
+far more efficient to calculate `|(a+b)| right shifted one bit'.
+
+Therefore the midpoint operation will always be denoted by `|half(a+b)|'
+in this program. If \MF\ is being implemented with languages that permit
+binary shifting, the |half| macro should be changed to make this operation
+as efficient as possible.
+
+@d half(#)==(#) div 2
+
+@ A single computation might use several subroutine calls, and it is
+desirable to avoid producing multiple error messages in case of arithmetic
+overflow. So the routines below set the global variable |arith_error| to |true|
+instead of reporting errors directly to the user.
+
+@<Glob...@>=
+@!arith_error:boolean; {has arithmetic overflow occurred recently?}
+
+@ @<Set init...@>=
+arith_error:=false;
+
+@ At crucial points the program will say |check_arith|, to test if
+an arithmetic error has been detected.
+
+@d check_arith==begin if arith_error then clear_arith;@+end
+
+@p procedure clear_arith;
+begin print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+help4("Uh, oh. A little while ago one of the quantities that I was")@/
+ ("computing got too large, so I'm afraid your answers will be")@/
+ ("somewhat askew. You'll probably have to adopt different")@/
+ ("tactics next time. But I shall try to carry on anyway.");
+error; arith_error:=false;
+end;
+
+@ Addition is not always checked to make sure that it doesn't overflow,
+but in places where overflow isn't too unlikely the |slow_add| routine
+is used.
+
+@p function slow_add(@!x,@!y:integer):integer;
+begin if x>=0 then
+ if y<=el_gordo-x then slow_add:=x+y
+ else begin arith_error:=true; slow_add:=el_gordo;
+ end
+else if -y<=el_gordo+x then slow_add:=x+y
+ else begin arith_error:=true; slow_add:=-el_gordo;
+ end;
+end;
+
+@ Fixed-point arithmetic is done on {\sl scaled integers\/} that are multiples
+of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit
+positions from the right end of a binary computer word.
+
+@d quarter_unit == @'40000 {$2^{14}$, represents 0.250000}
+@d half_unit == @'100000 {$2^{15}$, represents 0.50000}
+@d three_quarter_unit == @'140000 {$3\cdot2^{14}$, represents 0.75000}
+@d unity == @'200000 {$2^{16}$, represents 1.00000}
+@d two == @'400000 {$2^{17}$, represents 2.00000}
+@d three == @'600000 {$2^{17}+2^{16}$, represents 3.00000}
+
+@<Types...@>=
+@!scaled = integer; {this type is used for scaled integers}
+@!small_number=0..63; {this type is self-explanatory}
+
+@ The following function is used to create a scaled integer from a given decimal
+fraction $(.d_0d_1\ldots d_{k-1})$, where |0<=k<=17|. The digit $d_i$ is
+given in |dig[i]|, and the calculation produces a correctly rounded result.
+
+@p function round_decimals(@!k:small_number) : scaled;
+ {converts a decimal fraction}
+var @!a:integer; {the accumulator}
+begin a:=0;
+while k>0 do
+ begin decr(k); a:=(a+dig[k]*two) div 10;
+ end;
+round_decimals:=half(a+1);
+end;
+
+@ Conversely, here is a procedure analogous to |print_int|. If the output
+of this procedure is subsequently read by \MF\ and converted by the
+|round_decimals| routine above, it turns out that the original value will
+be reproduced exactly. A decimal point is printed only if the value is
+not an integer. If there is more than one way to print the result with
+the optimum number of digits following the decimal point, the closest
+possible value is given.
+
+The invariant relation in the \&{repeat} loop is that a sequence of
+decimal digits yet to be printed will yield the original number if and only if
+they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$.
+We can stop if and only if $f=0$ satisfies this condition; the loop will
+terminate before $s$ can possibly become zero.
+
+@<Basic printing...@>=
+procedure print_scaled(@!s:scaled); {prints scaled real, rounded to five
+ digits}
+var @!delta:scaled; {amount of allowable inaccuracy}
+begin if s<0 then
+ begin print_char("-"); negate(s); {print the sign, if negative}
+ end;
+print_int(s div unity); {print the integer part}
+s:=10*(s mod unity)+5;
+if s<>5 then
+ begin delta:=10; print_char(".");
+ repeat if delta>unity then
+ s:=s+@'100000-(delta div 2); {round the final digit}
+ print_char("0"+(s div unity)); s:=10*(s mod unity); delta:=delta*10;
+ until s<=delta;
+ end;
+end;
+
+@ We often want to print two scaled quantities in parentheses,
+separated by a comma.
+
+@<Basic printing...@>=
+procedure print_two(@!x,@!y:scaled); {prints `|(x,y)|'}
+begin print_char("("); print_scaled(x); print_char(","); print_scaled(y);
+print_char(")");
+end;
+
+@ The |scaled| quantities in \MF\ programs are generally supposed to be
+less than $2^{12}$ in absolute value, so \MF\ does much of its internal
+arithmetic with 28~significant bits of precision. A |fraction| denotes
+a scaled integer whose binary point is assumed to be 28 bit positions
+from the right.
+
+@d fraction_half==@'1000000000 {$2^{27}$, represents 0.50000000}
+@d fraction_one==@'2000000000 {$2^{28}$, represents 1.00000000}
+@d fraction_two==@'4000000000 {$2^{29}$, represents 2.00000000}
+@d fraction_three==@'6000000000 {$3\cdot2^{28}$, represents 3.00000000}
+@d fraction_four==@'10000000000 {$2^{30}$, represents 4.00000000}
+
+@<Types...@>=
+@!fraction=integer; {this type is used for scaled fractions}
+
+@ In fact, the two sorts of scaling discussed above aren't quite
+sufficient; \MF\ has yet another, used internally to keep track of angles
+in units of $2^{-20}$ degrees.
+
+@d forty_five_deg==@'264000000 {$45\cdot2^{20}$, represents $45^\circ$}
+@d ninety_deg==@'550000000 {$90\cdot2^{20}$, represents $90^\circ$}
+@d one_eighty_deg==@'1320000000 {$180\cdot2^{20}$, represents $180^\circ$}
+@d three_sixty_deg==@'2640000000 {$360\cdot2^{20}$, represents $360^\circ$}
+
+@<Types...@>=
+@!angle=integer; {this type is used for scaled angles}
+
+@ The |make_fraction| routine produces the |fraction| equivalent of
+|p/q|, given integers |p| and~|q|; it computes the integer
+$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are
+positive. If |p| and |q| are both of the same scaled type |t|,
+the ``type relation'' |make_fraction(t,t)=fraction| is valid;
+and it's also possible to use the subroutine ``backwards,'' using
+the relation |make_fraction(t,fraction)=t| between scaled types.
+
+If the result would have magnitude $2^{31}$ or more, |make_fraction|
+sets |arith_error:=true|. Most of \MF's internal computations have
+been designed to avoid this sort of error.
+
+Notice that if 64-bit integer arithmetic were available,
+we could simply compute |(@t$(2^{29}$@>*p+q)div (2*q)|.
+But when we are restricted to \PASCAL's 32-bit arithmetic we
+must either resort to multiple-precision maneuvering
+or use a simple but slow iteration. The multiple-precision technique
+would be about three times faster than the code adopted here, but it
+would be comparatively long and tricky, involving about sixteen
+additional multiplications and divisions.
+
+This operation is part of \MF's ``inner loop''; indeed, it will
+consume nearly 10\pct! of the running time (exclusive of input and output)
+if the code below is left unchanged. A machine-dependent recoding
+will therefore make \MF\ run faster. The present implementation
+is highly portable, but slow; it avoids multiplication and division
+except in the initial stage. System wizards should be careful to
+replace it with a routine that is guaranteed to produce identical
+results in all cases.
+@^system dependencies@>
+
+As noted below, a few more routines should also be replaced by machine-dependent
+code, for efficiency. But when a procedure is not part of the ``inner loop,''
+such changes aren't advisable; simplicity and robustness are
+preferable to trickery, unless the cost is too high.
+@^inner loop@>
+
+@p function make_fraction(@!p,@!q:integer):fraction;
+var @!f:integer; {the fraction bits, with a leading 1 bit}
+@!n:integer; {the integer part of $\vert p/q\vert$}
+@!negative:boolean; {should the result be negated?}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin if p>=0 then negative:=false
+else begin negate(p); negative:=true;
+ end;
+if q<=0 then
+ begin debug if q=0 then confusion("/");@;@+gubed@;@/
+@:this can't happen /}{\quad \./@>
+ negate(q); negative:=not negative;
+ end;
+n:=p div q; p:=p mod q;
+if n>=8 then
+ begin arith_error:=true;
+ if negative then make_fraction:=-el_gordo@+else make_fraction:=el_gordo;
+ end
+else begin n:=(n-1)*fraction_one;
+ @<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>;
+ if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n;
+ end;
+end;
+
+@ The |repeat| loop here preserves the following invariant relations
+between |f|, |p|, and~|q|:
+(i)~|0<=p<q|; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and
+$p_0$ is the original value of~$p$.
+
+Notice that the computation specifies
+|(p-q)+p| instead of |(p+p)-q|, because the latter could overflow.
+Let us hope that optimizing compilers do not miss this point; a
+special variable |be_careful| is used to emphasize the necessary
+order of computation. Optimizing compilers should keep |be_careful|
+in a register, not store it in memory.
+@^inner loop@>
+
+@<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>=
+f:=1;
+repeat be_careful:=p-q; p:=be_careful+p;
+if p>=0 then f:=f+f+1
+else begin double(f); p:=p+q;
+ end;
+until f>=fraction_one;
+be_careful:=p-q;
+if be_careful+p>=0 then incr(f)
+
+@ The dual of |make_fraction| is |take_fraction|, which multiplies a
+given integer~|q| by a fraction~|f|. When the operands are positive, it
+computes $p=\lfloor qf/2^{28}+{1\over2}\rfloor$, a symmetric function
+of |q| and~|f|.
+
+This routine is even more ``inner loopy'' than |make_fraction|;
+the present implementation consumes almost 20\pct! of \MF's computation
+time during typical jobs, so a machine-language or 64-bit
+substitute is advisable.
+@^inner loop@> @^system dependencies@>
+
+@p function take_fraction(@!q:integer;@!f:fraction):integer;
+var @!p:integer; {the fraction so far}
+@!negative:boolean; {should the result be negated?}
+@!n:integer; {additional multiple of $q$}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin @<Reduce to the case that |f>=0| and |q>0|@>;
+if f<fraction_one then n:=0
+else begin n:=f div fraction_one; f:=f mod fraction_one;
+ if q<=el_gordo div n then n:=n*q
+ else begin arith_error:=true; n:=el_gordo;
+ end;
+ end;
+f:=f+fraction_one;
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>;
+be_careful:=n-el_gordo;
+if be_careful+p>0 then
+ begin arith_error:=true; n:=el_gordo-p;
+ end;
+if negative then take_fraction:=-(n+p)
+else take_fraction:=n+p;
+end;
+
+@ @<Reduce to the case that |f>=0| and |q>0|@>=
+if f>=0 then negative:=false
+else begin negate(f); negative:=true;
+ end;
+if q<0 then
+ begin negate(q); negative:=not negative;
+ end;
+
+@ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor
+=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and
+$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$.
+@^inner loop@>
+
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>=
+p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$}
+if q<fraction_four then
+ repeat if odd(f) then p:=half(p+q)@+else p:=half(p);
+ f:=half(f);
+ until f=1
+else repeat if odd(f) then p:=p+half(q-p)@+else p:=half(p);
+ f:=half(f);
+ until f=1
+
+
+@ When we want to multiply something by a |scaled| quantity, we use a scheme
+analogous to |take_fraction| but with a different scaling.
+Given positive operands, |take_scaled|
+computes the quantity $p=\lfloor qf/2^{16}+{1\over2}\rfloor$.
+
+Once again it is a good idea to use 64-bit arithmetic if
+possible; otherwise |take_scaled| will use more than 2\pct! of the running time
+when the Computer Modern fonts are being generated.
+@^inner loop@>
+
+@p function take_scaled(@!q:integer;@!f:scaled):integer;
+var @!p:integer; {the fraction so far}
+@!negative:boolean; {should the result be negated?}
+@!n:integer; {additional multiple of $q$}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin @<Reduce to the case that |f>=0| and |q>0|@>;
+if f<unity then n:=0
+else begin n:=f div unity; f:=f mod unity;
+ if q<=el_gordo div n then n:=n*q
+ else begin arith_error:=true; n:=el_gordo;
+ end;
+ end;
+f:=f+unity;
+@<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>;
+be_careful:=n-el_gordo;
+if be_careful+p>0 then
+ begin arith_error:=true; n:=el_gordo-p;
+ end;
+if negative then take_scaled:=-(n+p)
+else take_scaled:=n+p;
+end;
+
+@ @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>=
+p:=half_unit; {that's $2^{15}$; the invariants hold now with $k=16$}
+@^inner loop@>
+if q<fraction_four then
+ repeat if odd(f) then p:=half(p+q)@+else p:=half(p);
+ f:=half(f);
+ until f=1
+else repeat if odd(f) then p:=p+half(q-p)@+else p:=half(p);
+ f:=half(f);
+ until f=1
+
+@ For completeness, there's also |make_scaled|, which computes a
+quotient as a |scaled| number instead of as a |fraction|.
+In other words, the result is $\lfloor2^{16}p/q+{1\over2}\rfloor$, if the
+operands are positive. \ (This procedure is not used especially often,
+so it is not part of \MF's inner loop.)
+
+@p function make_scaled(@!p,@!q:integer):scaled;
+var @!f:integer; {the fraction bits, with a leading 1 bit}
+@!n:integer; {the integer part of $\vert p/q\vert$}
+@!negative:boolean; {should the result be negated?}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin if p>=0 then negative:=false
+else begin negate(p); negative:=true;
+ end;
+if q<=0 then
+ begin debug if q=0 then confusion("/");@+gubed@;@/
+@:this can't happen /}{\quad \./@>
+ negate(q); negative:=not negative;
+ end;
+n:=p div q; p:=p mod q;
+if n>=@'100000 then
+ begin arith_error:=true;
+ if negative then make_scaled:=-el_gordo@+else make_scaled:=el_gordo;
+ end
+else begin n:=(n-1)*unity;
+ @<Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$@>;
+ if negative then make_scaled:=-(f+n)@+else make_scaled:=f+n;
+ end;
+end;
+
+@ @<Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$@>=
+f:=1;
+repeat be_careful:=p-q; p:=be_careful+p;
+if p>=0 then f:=f+f+1
+else begin double(f); p:=p+q;
+ end;
+until f>=unity;
+be_careful:=p-q;
+if be_careful+p>=0 then incr(f)
+
+@ Here is a typical example of how the routines above can be used.
+It computes the function
+$${1\over3\tau}f(\theta,\phi)=
+{\tau^{-1}\bigl(2+\sqrt2\,(\sin\theta-{1\over16}\sin\phi)
+ (\sin\phi-{1\over16}\sin\theta)(\cos\theta-\cos\phi)\bigr)\over
+3\,\bigl(1+{1\over2}(\sqrt5-1)\cos\theta+{1\over2}(3-\sqrt5\,)\cos\phi\bigr)},$$
+where $\tau$ is a |scaled| ``tension'' parameter. This is \MF's magic
+fudge factor for placing the first control point of a curve that starts
+at an angle $\theta$ and ends at an angle $\phi$ from the straight path.
+(Actually, if the stated quantity exceeds 4, \MF\ reduces it to~4.)
+
+The trigonometric quantity to be multiplied by $\sqrt2$ is less than $\sqrt2$.
+(It's a sum of eight terms whose absolute values can be bounded using
+relations such as $\sin\theta\cos\theta\L{1\over2}$.) Thus the numerator
+is positive; and since the tension $\tau$ is constrained to be at least
+$3\over4$, the numerator is less than $16\over3$. The denominator is
+nonnegative and at most~6. Hence the fixed-point calculations below
+are guaranteed to stay within the bounds of a 32-bit computer word.
+
+The angles $\theta$ and $\phi$ are given implicitly in terms of |fraction|
+arguments |st|, |ct|, |sf|, and |cf|, representing $\sin\theta$, $\cos\theta$,
+$\sin\phi$, and $\cos\phi$, respectively.
+
+@p function velocity(@!st,@!ct,@!sf,@!cf:fraction;@!t:scaled):fraction;
+var @!acc,@!num,@!denom:integer; {registers for intermediate calculations}
+begin acc:=take_fraction(st-(sf div 16), sf-(st div 16));
+acc:=take_fraction(acc,ct-cf);
+num:=fraction_two+take_fraction(acc,379625062);
+ {$2^{28}\sqrt2\approx379625062.497$}
+denom:=fraction_three+take_fraction(ct,497706707)+take_fraction(cf,307599661);
+ {$3\cdot2^{27}\cdot(\sqrt5-1)\approx497706706.78$ and
+ $3\cdot2^{27}\cdot(3-\sqrt5\,)\approx307599661.22$}
+if t<>unity then num:=make_scaled(num,t);
+ {|make_scaled(fraction,scaled)=fraction|}
+if num div 4>=denom then velocity:=fraction_four
+else velocity:=make_fraction(num,denom);
+end;
+
+@ The following somewhat different subroutine tests rigorously if $ab$ is
+greater than, equal to, or less than~$cd$,
+given integers $(a,b,c,d)$. In most cases a quick decision is reached.
+The result is $+1$, 0, or~$-1$ in the three respective cases.
+
+@d return_sign(#)==begin ab_vs_cd:=#; return;
+ end
+
+@p function ab_vs_cd(@!a,b,c,d:integer):integer;
+label exit;
+var @!q,@!r:integer; {temporary registers}
+begin @<Reduce to the case that |a,c>=0|, |b,d>0|@>;
+loop@+ begin q := a div d; r := c div b;
+ if q<>r then
+ if q>r then return_sign(1)@+else return_sign(-1);
+ q := a mod d; r := c mod b;
+ if r=0 then
+ if q=0 then return_sign(0)@+else return_sign(1);
+ if q=0 then return_sign(-1);
+ a:=b; b:=q; c:=d; d:=r;
+ end; {now |a>d>0| and |c>b>0|}
+exit:end;
+
+@ @<Reduce to the case that |a...@>=
+if a<0 then
+ begin negate(a); negate(b);
+ end;
+if c<0 then
+ begin negate(c); negate(d);
+ end;
+if d<=0 then
+ begin if b>=0 then
+ if ((a=0)or(b=0))and((c=0)or(d=0)) then return_sign(0)
+ else return_sign(1);
+ if d=0 then
+ if a=0 then return_sign(0)@+else return_sign(-1);
+ q:=a; a:=c; c:=q; q:=-b; b:=-d; d:=q;
+ end
+else if b<=0 then
+ begin if b<0 then if a>0 then return_sign(-1);
+ if c=0 then return_sign(0) else return_sign(-1);
+ end
+
+@ We conclude this set of elementary routines with some simple rounding
+and truncation operations that are coded in a machine-independent fashion.
+The routines are slightly complicated because we want them to work
+without overflow whenever $-2^{31}\L x<2^{31}$.
+
+@p function floor_scaled(@!x:scaled):scaled;
+ {$2^{16}\lfloor x/2^{16}\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=0 then floor_scaled:=x-(x mod unity)
+else begin be_careful:=x+1;
+ floor_scaled:=x+((-be_careful) mod unity)+1-unity;
+ end;
+end;
+@#
+function floor_unscaled(@!x:scaled):integer;
+ {$\lfloor x/2^{16}\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=0 then floor_unscaled:=x div unity
+else begin be_careful:=x+1; floor_unscaled:=-(1+((-be_careful) div unity));
+ end;
+end;
+@#
+function round_unscaled(@!x:scaled):integer;
+ {$\lfloor x/2^{16}+.5\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=half_unit then round_unscaled:=1+((x-half_unit) div unity)
+else if x>=-half_unit then round_unscaled:=0
+else begin be_careful:=x+1;
+ round_unscaled:=-(1+((-be_careful-half_unit) div unity));
+ end;
+end;
+@#
+function round_fraction(@!x:fraction):scaled;
+ {$\lfloor x/2^{12}+.5\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=2048 then round_fraction:=1+((x-2048) div 4096)
+else if x>=-2048 then round_fraction:=0
+else begin be_careful:=x+1;
+ round_fraction:=-(1+((-be_careful-2048) div 4096));
+ end;
+end;
+
+@* \[8] Algebraic and transcendental functions.
+\MF\ computes all of the necessary special functions from scratch, without
+relying on |real| arithmetic or system subroutines for sines, cosines, etc.
+
+@ To get the square root of a |scaled| number |x|, we want to calculate
+$s=\lfloor 2^8\!\sqrt x +{1\over2}\rfloor$. If $x>0$, this is the unique
+integer such that $2^{16}x-s\L s^2<2^{16}x+s$. The following subroutine
+determines $s$ by an iterative method that maintains the invariant
+relations $x=2^{46-2k}x_0\bmod 2^{30}$, $0<y=\lfloor 2^{16-2k}x_0\rfloor
+-s^2+s\L q=2s$, where $x_0$ is the initial value of $x$. The value of~$y$
+might, however, be zero at the start of the first iteration.
+
+@p function square_rt(@!x:scaled):scaled;
+var @!k:small_number; {iteration control counter}
+@!y,@!q:integer; {registers for intermediate calculations}
+begin if x<=0 then @<Handle square root of zero or negative argument@>
+else begin k:=23; q:=2;
+ while x<fraction_two do {i.e., |while x<@t$2^{29}$@>|\unskip}
+ begin decr(k); x:=x+x+x+x;
+ end;
+ if x<fraction_four then y:=0
+ else begin x:=x-fraction_four; y:=1;
+ end;
+ repeat @<Decrease |k| by 1, maintaining the invariant
+ relations between |x|, |y|, and~|q|@>;
+ until k=0;
+ square_rt:=half(q);
+ end;
+end;
+
+@ @<Handle square root of zero...@>=
+begin if x<0 then
+ begin print_err("Square root of ");
+@.Square root...replaced by 0@>
+ print_scaled(x); print(" has been replaced by 0");
+ help2("Since I don't take square roots of negative numbers,")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+ error;
+ end;
+square_rt:=0;
+end
+
+@ @<Decrease |k| by 1, maintaining...@>=
+double(x); double(y);
+if x>=fraction_four then {note that |fraction_four=@t$2^{30}$@>|}
+ begin x:=x-fraction_four; incr(y);
+ end;
+double(x); y:=y+y-q; double(q);
+if x>=fraction_four then
+ begin x:=x-fraction_four; incr(y);
+ end;
+if y>q then
+ begin y:=y-q; q:=q+2;
+ end
+else if y<=0 then
+ begin q:=q-2; y:=y+q;
+ end;
+decr(k)
+
+@ Pythagorean addition $\psqrt{a^2+b^2}$ is implemented by an elegant
+iterative scheme due to Cleve Moler and Donald Morrison [{\sl IBM Journal
+@^Moler, Cleve Barry@>
+@^Morrison, Donald Ross@>
+of Research and Development\/ \bf27} (1983), 577--581]. It modifies |a| and~|b|
+in such a way that their Pythagorean sum remains invariant, while the
+smaller argument decreases.
+
+@p function pyth_add(@!a,@!b:integer):integer;
+label done;
+var @!r:fraction; {register used to transform |a| and |b|}
+@!big:boolean; {is the result dangerously near $2^{31}$?}
+begin a:=abs(a); b:=abs(b);
+if a<b then
+ begin r:=b; b:=a; a:=r;
+ end; {now |0<=b<=a|}
+if b>0 then
+ begin if a<fraction_two then big:=false
+ else begin a:=a div 4; b:=b div 4; big:=true;
+ end; {we reduced the precision to avoid arithmetic overflow}
+ @<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>;
+ if big then
+ if a<fraction_two then a:=a+a+a+a
+ else begin arith_error:=true; a:=el_gordo;
+ end;
+ end;
+pyth_add:=a;
+end;
+
+@ The key idea here is to reflect the vector $(a,b)$ about the
+line through $(a,b/2)$.
+
+@<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>=
+loop@+ begin r:=make_fraction(b,a);
+ r:=take_fraction(r,r); {now $r\approx b^2/a^2$}
+ if r=0 then goto done;
+ r:=make_fraction(r,fraction_four+r);
+ a:=a+take_fraction(a+a,r); b:=take_fraction(b,r);
+ end;
+done:
+
+@ Here is a similar algorithm for $\psqrt{a^2-b^2}$.
+It converges slowly when $b$ is near $a$, but otherwise it works fine.
+
+@p function pyth_sub(@!a,@!b:integer):integer;
+label done;
+var @!r:fraction; {register used to transform |a| and |b|}
+@!big:boolean; {is the input dangerously near $2^{31}$?}
+begin a:=abs(a); b:=abs(b);
+if a<=b then @<Handle erroneous |pyth_sub| and set |a:=0|@>
+else begin if a<fraction_four then big:=false
+ else begin a:=half(a); b:=half(b); big:=true;
+ end;
+ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>;
+ if big then a:=a+a;
+ end;
+pyth_sub:=a;
+end;
+
+@ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>=
+loop@+ begin r:=make_fraction(b,a);
+ r:=take_fraction(r,r); {now $r\approx b^2/a^2$}
+ if r=0 then goto done;
+ r:=make_fraction(r,fraction_four-r);
+ a:=a-take_fraction(a+a,r); b:=take_fraction(b,r);
+ end;
+done:
+
+@ @<Handle erroneous |pyth_sub| and set |a:=0|@>=
+begin if a<b then
+ begin print_err("Pythagorean subtraction "); print_scaled(a);
+ print("+-+"); print_scaled(b); print(" has been replaced by 0");
+@.Pythagorean...@>
+ help2("Since I don't take square roots of negative numbers,")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+ error;
+ end;
+a:=0;
+end
+
+@ The subroutines for logarithm and exponential involve two tables.
+The first is simple: |two_to_the[k]| equals $2^k$. The second involves
+a bit more calculation, which the author claims to have done correctly:
+|spec_log[k]| is $2^{27}$ times $\ln\bigl(1/(1-2^{-k})\bigr)=
+2^{-k}+{1\over2}2^{-2k}+{1\over3}2^{-3k}+\cdots\,$, rounded to the
+nearest integer.
+
+@<Glob...@>=
+@!two_to_the:array[0..30] of integer; {powers of two}
+@!spec_log:array[1..28] of integer; {special logarithms}
+
+@ @<Local variables for initialization@>=
+@!k:integer; {all-purpose loop index}
+
+@ @<Set init...@>=
+two_to_the[0]:=1;
+for k:=1 to 30 do two_to_the[k]:=2*two_to_the[k-1];
+spec_log[1]:=93032640;
+spec_log[2]:=38612034;
+spec_log[3]:=17922280;
+spec_log[4]:=8662214;
+spec_log[5]:=4261238;
+spec_log[6]:=2113709;
+spec_log[7]:=1052693;
+spec_log[8]:=525315;
+spec_log[9]:=262400;
+spec_log[10]:=131136;
+spec_log[11]:=65552;
+spec_log[12]:=32772;
+spec_log[13]:=16385;
+for k:=14 to 27 do spec_log[k]:=two_to_the[27-k];
+spec_log[28]:=1;
+
+@ Here is the routine that calculates $2^8$ times the natural logarithm
+of a |scaled| quantity; it is an integer approximation to $2^{24}\ln(x/2^{16})$,
+when |x| is a given positive integer.
+
+The method is based on exercise 1.2.2--25 in {\sl The Art of Computer
+Programming\/}: During the main iteration we have $1\L 2^{-30}x<1/(1-2^{1-k})$,
+and the logarithm of $2^{30}x$ remains to be added to an accumulator
+register called~$y$. Three auxiliary bits of accuracy are retained in~$y$
+during the calculation, and sixteen auxiliary bits to extend |y| are
+kept in~|z| during the initial argument reduction. (We add
+$100\cdot2^{16}=6553600$ to~|z| and subtract 100 from~|y| so that |z| will
+not become negative; also, the actual amount subtracted from~|y| is~96,
+not~100, because we want to add~4 for rounding before the final division by~8.)
+
+@p function m_log(@!x:scaled):scaled;
+var @!y,@!z:integer; {auxiliary registers}
+@!k:integer; {iteration counter}
+begin if x<=0 then @<Handle non-positive logarithm@>
+else begin y:=1302456956+4-100; {$14\times2^{27}\ln2\approx1302456956.421063$}
+ z:=27595+6553600; {and $2^{16}\times .421063\approx 27595$}
+ while x<fraction_four do
+ begin double(x); y:=y-93032639; z:=z-48782;
+ end; {$2^{27}\ln2\approx 93032639.74436163$
+ and $2^{16}\times.74436163\approx 48782$}
+ y:=y+(z div unity); k:=2;
+ while x>fraction_four+4 do
+ @<Increase |k| until |x| can be multiplied by a
+ factor of $2^{-k}$, and adjust $y$ accordingly@>;
+ m_log:=y div 8;
+ end;
+end;
+
+@ @<Increase |k| until |x| can...@>=
+begin z:=((x-1) div two_to_the[k])+1; {$z=\lceil x/2^k\rceil$}
+while x<fraction_four+z do
+ begin z:=half(z+1); k:=k+1;
+ end;
+y:=y+spec_log[k]; x:=x-z;
+end
+
+@ @<Handle non-positive logarithm@>=
+begin print_err("Logarithm of ");
+@.Logarithm...replaced by 0@>
+print_scaled(x); print(" has been replaced by 0");
+help2("Since I don't take logs of non-positive numbers,")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+error; m_log:=0;
+end
+
+@ Conversely, the exponential routine calculates $\exp(x/2^8)$,
+when |x| is |scaled|. The result is an integer approximation to
+$2^{16}\exp(x/2^{24})$, when |x| is regarded as an integer.
+
+@p function m_exp(@!x:scaled):scaled;
+var @!k:small_number; {loop control index}
+@!y,@!z:integer; {auxiliary registers}
+begin if x>174436200 then
+ {$2^{24}\ln((2^{31}-1)/2^{16})\approx 174436199.51$}
+ begin arith_error:=true; m_exp:=el_gordo;
+ end
+else if x<-197694359 then m_exp:=0
+ {$2^{24}\ln(2^{-1}/2^{16})\approx-197694359.45$}
+else begin if x<=0 then
+ begin z:=-8*x; y:=@'4000000; {$y=2^{20}$}
+ end
+ else begin if x<=127919879 then z:=1023359037-8*x
+ {$2^{27}\ln((2^{31}-1)/2^{20})\approx 1023359037.125$}
+ else z:=8*(174436200-x); {|z| is always nonnegative}
+ y:=el_gordo;
+ end;
+ @<Multiply |y| by $\exp(-z/2^{27})$@>;
+ if x<=127919879 then m_exp:=(y+8) div 16@+else m_exp:=y;
+ end;
+end;
+
+@ The idea here is that subtracting |spec_log[k]| from |z| corresponds
+to multiplying |y| by $1-2^{-k}$.
+
+A subtle point (which had to be checked) was that if $x=127919879$, the
+value of~|y| will decrease so that |y+8| doesn't overflow. In fact,
+$z$ will be 5 in this case, and |y| will decrease by~64 when |k=25|
+and by~16 when |k=27|.
+
+@<Multiply |y| by...@>=
+k:=1;
+while z>0 do
+ begin while z>=spec_log[k] do
+ begin z:=z-spec_log[k];
+ y:=y-1-((y-two_to_the[k-1]) div two_to_the[k]);
+ end;
+ incr(k);
+ end
+
+@ The trigonometric subroutines use an auxiliary table such that
+|spec_atan[k]| contains an approximation to the |angle| whose tangent
+is~$1/2^k$.
+
+@<Glob...@>=
+@!spec_atan:array[1..26] of angle; {$\arctan2^{-k}$ times $2^{20}\cdot180/\pi$}
+
+@ @<Set init...@>=
+spec_atan[1]:=27855475;
+spec_atan[2]:=14718068;
+spec_atan[3]:=7471121;
+spec_atan[4]:=3750058;
+spec_atan[5]:=1876857;
+spec_atan[6]:=938658;
+spec_atan[7]:=469357;
+spec_atan[8]:=234682;
+spec_atan[9]:=117342;
+spec_atan[10]:=58671;
+spec_atan[11]:=29335;
+spec_atan[12]:=14668;
+spec_atan[13]:=7334;
+spec_atan[14]:=3667;
+spec_atan[15]:=1833;
+spec_atan[16]:=917;
+spec_atan[17]:=458;
+spec_atan[18]:=229;
+spec_atan[19]:=115;
+spec_atan[20]:=57;
+spec_atan[21]:=29;
+spec_atan[22]:=14;
+spec_atan[23]:=7;
+spec_atan[24]:=4;
+spec_atan[25]:=2;
+spec_atan[26]:=1;
+
+@ Given integers |x| and |y|, not both zero, the |n_arg| function
+returns the |angle| whose tangent points in the direction $(x,y)$.
+This subroutine first determines the correct octant, then solves the
+problem for |0<=y<=x|, then converts the result appropriately to
+return an answer in the range |-one_eighty_deg<=@t$\theta$@><=one_eighty_deg|.
+(The answer is |+one_eighty_deg| if |y=0| and |x<0|, but an answer of
+|-one_eighty_deg| is possible if, for example, |y=-1| and $x=-2^{30}$.)
+
+The octants are represented in a ``Gray code,'' since that turns out
+to be computationally simplest.
+
+@d negate_x=1
+@d negate_y=2
+@d switch_x_and_y=4
+@d first_octant=1
+@d second_octant=first_octant+switch_x_and_y
+@d third_octant=first_octant+switch_x_and_y+negate_x
+@d fourth_octant=first_octant+negate_x
+@d fifth_octant=first_octant+negate_x+negate_y
+@d sixth_octant=first_octant+switch_x_and_y+negate_x+negate_y
+@d seventh_octant=first_octant+switch_x_and_y+negate_y
+@d eighth_octant=first_octant+negate_y
+
+@p function n_arg(@!x,@!y:integer):angle;
+var @!z:angle; {auxiliary register}
+@!t:integer; {temporary storage}
+@!k:small_number; {loop counter}
+@!octant:first_octant..sixth_octant; {octant code}
+begin if x>=0 then octant:=first_octant
+else begin negate(x); octant:=first_octant+negate_x;
+ end;
+if y<0 then
+ begin negate(y); octant:=octant+negate_y;
+ end;
+if x<y then
+ begin t:=y; y:=x; x:=t; octant:=octant+switch_x_and_y;
+ end;
+if x=0 then @<Handle undefined arg@>
+else begin @<Set variable |z| to the arg of $(x,y)$@>;
+ @<Return an appropriate answer based on |z| and |octant|@>;
+ end;
+end;
+
+@ @<Handle undefined arg@>=
+begin print_err("angle(0,0) is taken as zero");
+@.angle(0,0)...zero@>
+help2("The `angle' between two identical points is undefined.")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+error; n_arg:=0;
+end
+
+@ @<Return an appropriate answer...@>=
+case octant of
+first_octant:n_arg:=z;
+second_octant:n_arg:=ninety_deg-z;
+third_octant:n_arg:=ninety_deg+z;
+fourth_octant:n_arg:=one_eighty_deg-z;
+fifth_octant:n_arg:=z-one_eighty_deg;
+sixth_octant:n_arg:=-z-ninety_deg;
+seventh_octant:n_arg:=z-ninety_deg;
+eighth_octant:n_arg:=-z;
+end {there are no other cases}
+
+@ At this point we have |x>=y>=0|, and |x>0|. The numbers are scaled up
+or down until $2^{28}\L x<2^{29}$, so that accurate fixed-point calculations
+will be made.
+
+@<Set variable |z| to the arg...@>=
+while x>=fraction_two do
+ begin x:=half(x); y:=half(y);
+ end;
+z:=0;
+if y>0 then
+ begin while x<fraction_one do
+ begin double(x); double(y);
+ end;
+ @<Increase |z| to the arg of $(x,y)$@>;
+ end
+
+@ During the calculations of this section, variables |x| and~|y|
+represent actual coordinates $(x,2^{-k}y)$. We will maintain the
+condition |x>=y|, so that the tangent will be at most $2^{-k}$.
+If $x<2y$, the tangent is greater than $2^{-k-1}$. The transformation
+$(a,b)\mapsto(a+b\tan\phi,b-a\tan\phi)$ replaces $(a,b)$ by
+coordinates whose angle has decreased by~$\phi$; in the special case
+$a=x$, $b=2^{-k}y$, and $\tan\phi=2^{-k-1}$, this operation reduces
+to the particularly simple iteration shown here. [Cf.~John E. Meggitt,
+@^Meggitt, John E.@>
+{\sl IBM Journal of Research and Development\/ \bf6} (1962), 210--226.]
+
+The initial value of |x| will be multiplied by at most
+$(1+{1\over2})(1+{1\over8})(1+{1\over32})\cdots\approx 1.7584$; hence
+there is no chance of integer overflow.
+
+@<Increase |z|...@>=
+k:=0;
+repeat double(y); incr(k);
+if y>x then
+ begin z:=z+spec_atan[k]; t:=x; x:=x+(y div two_to_the[k+k]); y:=y-t;
+ end;
+until k=15;
+repeat double(y); incr(k);
+if y>x then
+ begin z:=z+spec_atan[k]; y:=y-x;
+ end;
+until k=26
+
+@ Conversely, the |n_sin_cos| routine takes an |angle| and produces the sine
+and cosine of that angle. The results of this routine are
+stored in global integer variables |n_sin| and |n_cos|.
+
+@<Glob...@>=
+@!n_sin,@!n_cos:fraction; {results computed by |n_sin_cos|}
+
+@ Given an integer |z| that is $2^{20}$ times an angle $\theta$ in degrees,
+the purpose of |n_sin_cos(z)| is to set
+|x=@t$r\cos\theta$@>| and |y=@t$r\sin\theta$@>| (approximately),
+for some rather large number~|r|. The maximum of |x| and |y|
+will be between $2^{28}$ and $2^{30}$, so that there will be hardly
+any loss of accuracy. Then |x| and~|y| are divided by~|r|.
+
+@p procedure n_sin_cos(@!z:angle); {computes a multiple of the sine and cosine}
+var @!k:small_number; {loop control variable}
+@!q:0..7; {specifies the quadrant}
+@!r:fraction; {magnitude of |(x,y)|}
+@!x,@!y,@!t:integer; {temporary registers}
+begin while z<0 do z:=z+three_sixty_deg;
+z:=z mod three_sixty_deg; {now |0<=z<three_sixty_deg|}
+q:=z div forty_five_deg; z:=z mod forty_five_deg;
+x:=fraction_one; y:=x;
+if not odd(q) then z:=forty_five_deg-z;
+@<Subtract angle |z| from |(x,y)|@>;
+@<Convert |(x,y)| to the octant determined by~|q|@>;
+r:=pyth_add(x,y); n_cos:=make_fraction(x,r); n_sin:=make_fraction(y,r);
+end;
+
+@ In this case the octants are numbered sequentially.
+
+@<Convert |(x,...@>=
+case q of
+0:do_nothing;
+1:begin t:=x; x:=y; y:=t;
+ end;
+2:begin t:=x; x:=-y; y:=t;
+ end;
+3:negate(x);
+4:begin negate(x); negate(y);
+ end;
+5:begin t:=x; x:=-y; y:=-t;
+ end;
+6:begin t:=x; x:=y; y:=-t;
+ end;
+7:negate(y);
+end {there are no other cases}
+
+@ The main iteration of |n_sin_cos| is similar to that of |n_arg| but
+applied in reverse. The values of |spec_atan[k]| decrease slowly enough
+that this loop is guaranteed to terminate before the (nonexistent) value
+|spec_atan[27]| would be required.
+
+@<Subtract angle |z|...@>=
+k:=1;
+while z>0 do
+ begin if z>=spec_atan[k] then
+ begin z:=z-spec_atan[k]; t:=x;@/
+ x:=t+y div two_to_the[k];
+ y:=y-t div two_to_the[k];
+ end;
+ incr(k);
+ end;
+if y<0 then y:=0 {this precaution may never be needed}
+
+@ And now let's complete our collection of numeric utility routines
+by considering random number generation.
+\MF\ generates pseudo-random numbers with the additive scheme recommended
+in Section 3.6 of {\sl The Art of Computer Programming}; however, the
+results are random fractions between 0 and |fraction_one-1|, inclusive.
+
+There's an auxiliary array |randoms| that contains 55 pseudo-random
+fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-24})\bmod 2^{28}$,
+we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
+The global variable |j_random| tells which element has most recently
+been consumed.
+
+@<Glob...@>=
+@!randoms:array[0..54] of fraction; {the last 55 random values generated}
+@!j_random:0..54; {the number of unused |randoms|}
+
+@ To consume a random fraction, the program below will say `|next_random|'
+and then it will fetch |randoms[j_random]|. The |next_random| macro
+actually accesses the numbers backwards; blocks of 55~$x$'s are
+essentially being ``flipped.'' But that doesn't make them less random.
+
+@d next_random==if j_random=0 then new_randoms
+ else decr(j_random)
+
+@p procedure new_randoms;
+var @!k:0..54; {index into |randoms|}
+@!x:fraction; {accumulator}
+begin for k:=0 to 23 do
+ begin x:=randoms[k]-randoms[k+31];
+ if x<0 then x:=x+fraction_one;
+ randoms[k]:=x;
+ end;
+for k:=24 to 54 do
+ begin x:=randoms[k]-randoms[k-24];
+ if x<0 then x:=x+fraction_one;
+ randoms[k]:=x;
+ end;
+j_random:=54;
+end;
+
+@ To initialize the |randoms| table, we call the following routine.
+
+@p procedure init_randoms(@!seed:scaled);
+var @!j,@!jj,@!k:fraction; {more or less random integers}
+@!i:0..54; {index into |randoms|}
+begin j:=abs(seed);
+while j>=fraction_one do j:=half(j);
+k:=1;
+for i:=0 to 54 do
+ begin jj:=k; k:=j-k; j:=jj;
+ if k<0 then k:=k+fraction_one;
+ randoms[(i*21)mod 55]:=j;
+ end;
+new_randoms; new_randoms; new_randoms; {``warm up'' the array}
+end;
+
+@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x|
+or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
+
+Note that the call of |take_fraction| will produce the values 0 and~|x|
+with about half the probability that it will produce any other particular
+values between 0 and~|x|, because it rounds its answers.
+
+@p function unif_rand(@!x:scaled):scaled;
+var @!y:scaled; {trial value}
+begin next_random; y:=take_fraction(abs(x),randoms[j_random]);
+if y=abs(x) then unif_rand:=0
+else if x>0 then unif_rand:=y
+else unif_rand:=-y;
+end;
+
+@ Finally, a normal deviate with mean zero and unit standard deviation
+can readily be obtained with the ratio method (Algorithm 3.4.1R in
+{\sl The Art of Computer Programming\/}).
+
+@p function norm_rand:scaled;
+var @!x,@!u,@!l:integer; {what the book would call $2^{16}X$, $2^{28}U$,
+ and $-2^{24}\ln U$}
+begin repeat
+ repeat next_random;
+ x:=take_fraction(112429,randoms[j_random]-fraction_half);
+ {$2^{16}\sqrt{8/e}\approx 112428.82793$}
+ next_random; u:=randoms[j_random];
+ until abs(x)<u;
+x:=make_fraction(x,u);
+l:=139548960-m_log(u); {$2^{24}\cdot12\ln2\approx139548959.6165$}
+until ab_vs_cd(1024,l,x,x)>=0;
+norm_rand:=x;
+end;
+
+@* \[9] Packed data.
+In order to make efficient use of storage space, \MF\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a small number of fields that are one half or one
+quarter of the size used for storing integers.
+
+If |x| is a variable of type |memory_word|, it contains up to four
+fields that can be referred to as follows:
+$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr
+|x|&.|int|&(an |integer|)\cr
+|x|&.|sc|\qquad&(a |scaled| integer)\cr
+|x.hh.lh|, |x.hh|&.|rh|&(two halfword fields)\cr
+|x.hh.b0|, |x.hh.b1|, |x.hh|&.|rh|&(two quarterword fields, one halfword
+ field)\cr
+|x.qqqq.b0|, |x.qqqq.b1|, |x.qqqq|&.|b2|, |x.qqqq.b3|\hskip-100pt
+ &\qquad\qquad\qquad(four quarterword fields)\cr}}$$
+This is somewhat cumbersome to write, and not very readable either, but
+macros will be used to make the notation shorter and more transparent.
+The \PASCAL\ code below gives a formal definition of |memory_word| and
+its subsidiary types, using packed variant records. \MF\ makes no
+assumptions about the relative positions of the fields within a word.
+
+Since we are assuming 32-bit integers, a halfword must contain at least
+16 bits, and a quarterword must contain at least 8 bits.
+@^system dependencies@>
+But it doesn't hurt to have more bits; for example, with enough 36-bit
+words you might be able to have |mem_max| as large as 262142.
+
+N.B.: Valuable memory space will be dreadfully wasted unless \MF\ is compiled
+by a \PASCAL\ that packs all of the |memory_word| variants into
+the space of a single integer. Some \PASCAL\ compilers will pack an
+integer whose subrange is `|0..255|' into an eight-bit field, but others
+insist on allocating space for an additional sign bit; on such systems you
+can get 256 values into a quarterword only if the subrange is `|-128..127|'.
+
+The present implementation tries to accommodate as many variations as possible,
+so it makes few assumptions. If integers having the subrange
+`|min_quarterword..max_quarterword|' can be packed into a quarterword,
+and if integers having the subrange `|min_halfword..max_halfword|'
+can be packed into a halfword, everything should work satisfactorily.
+
+It is usually most efficient to have |min_quarterword=min_halfword=0|,
+so one should try to achieve this unless it causes a severe problem.
+The values defined here are recommended for most 32-bit computers.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+
+@ Here are the inequalities that the quarterword and halfword values
+must satisfy (or rather, the inequalities that they mustn't satisfy):
+
+@<Check the ``constant''...@>=
+init if mem_max<>mem_top then bad:=10;@+tini@;@/
+if mem_max<mem_top then bad:=10;
+if (min_quarterword>0)or(max_quarterword<127) then bad:=11;
+if (min_halfword>0)or(max_halfword<32767) then bad:=12;
+if (min_quarterword<min_halfword)or@|
+ (max_quarterword>max_halfword) then bad:=13;
+if (mem_min<min_halfword)or(mem_max>=max_halfword) then bad:=14;
+if max_strings>max_halfword then bad:=15;
+if buf_size>max_halfword then bad:=16;
+if (max_quarterword-min_quarterword<255)or@|
+ (max_halfword-min_halfword<65535) then bad:=17;
+
+@ The operation of subtracting |min_halfword| occurs rather frequently in
+\MF, so it is convenient to abbreviate this operation by using the macro
+|ho| defined here. \MF\ will run faster with respect to compilers that
+don't optimize the expression `|x-0|', if this macro is simplified in the
+obvious way when |min_halfword=0|. Similarly, |qi| and |qo| are used for
+input to and output from quarterwords.
+@^system dependencies@>
+
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@d qo(#)==#-min_quarterword {to read eight bits from a quarterword}
+@d qi(#)==#+min_quarterword {to store eight bits in a quarterword}
+
+@ The reader should study the following definitions closely:
+@^system dependencies@>
+
+@d sc==int {|scaled| data is equivalent to |integer|}
+
+@<Types...@>=
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!three_choices = 1..3; {used when there are three variants in a record}
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case three_choices of
+ 1: (@!int:integer);
+ 2: (@!hh:two_halves);
+ 3: (@!qqqq:four_quarters);
+ end;
+@!word_file = file of memory_word;
+
+@ When debugging, we may want to print a |memory_word| without knowing
+what type it is; so we print it in all modes.
+@^dirty \PASCAL@>@^debugging@>
+
+@p @!debug procedure print_word(@!w:memory_word);
+ {prints |w| in all ways}
+begin print_int(w.int); print_char(" ");@/
+print_scaled(w.sc); print_char(" "); print_scaled(w.sc div @'10000); print_ln;@/
+print_int(w.hh.lh); print_char("="); print_int(w.hh.b0); print_char(":");
+print_int(w.hh.b1); print_char(";"); print_int(w.hh.rh); print_char(" ");@/
+print_int(w.qqqq.b0); print_char(":"); print_int(w.qqqq.b1); print_char(":");
+print_int(w.qqqq.b2); print_char(":"); print_int(w.qqqq.b3);
+end;
+gubed
+
+@* \[10] Dynamic memory allocation.
+The \MF\ system does nearly all of its own memory allocation, so that it
+can readily be transported into environments that do not have automatic
+facilities for strings, garbage collection, etc., and so that it can be in
+control of what error messages the user receives. The dynamic storage
+requirements of \MF\ are handled by providing a large array |mem| in
+which consecutive blocks of words are used as nodes by the \MF\ routines.
+
+Pointer variables are indices into this array, or into another array
+called |eqtb| that will be explained later. A pointer variable might
+also be a special flag that lies outside the bounds of |mem|, so we
+allow pointers to assume any |halfword| value. The minimum memory
+index represents a null pointer.
+
+@d pointer==halfword {a flag or a location in |mem| or |eqtb|}
+@d null==mem_min {the null pointer}
+
+@ The |mem| array is divided into two regions that are allocated separately,
+but the dividing line between these two regions is not fixed; they grow
+together until finding their ``natural'' size in a particular job.
+Locations less than or equal to |lo_mem_max| are used for storing
+variable-length records consisting of two or more words each. This region
+is maintained using an algorithm similar to the one described in exercise
+2.5--19 of {\sl The Art of Computer Programming}. However, no size field
+appears in the allocated nodes; the program is responsible for knowing the
+relevant size when a node is freed. Locations greater than or equal to
+|hi_mem_min| are used for storing one-word records; a conventional
+\.{AVAIL} stack is used for allocation in this region.
+
+Locations of |mem| between |mem_min| and |mem_top| may be dumped as part
+of preloaded format files, by the \.{INIMF} preprocessor.
+@.INIMF@>
+Production versions of \MF\ may extend the memory at the top end in order to
+provide more space; these locations, between |mem_top| and |mem_max|,
+are always used for single-word nodes.
+
+The key pointers that govern |mem| allocation have a prescribed order:
+$$\hbox{|null=mem_min<lo_mem_max<hi_mem_min<mem_top<=mem_end<=mem_max|.}$$
+
+@<Glob...@>=
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@!lo_mem_max : pointer; {the largest location of variable-size memory in use}
+@!hi_mem_min : pointer; {the smallest location of one-word memory in use}
+
+@ Users who wish to study the memory requirements of specific applications can
+use optional special features that keep track of current and
+maximum memory usage. When code between the delimiters |@!stat| $\ldots$
+|tats| is not ``commented out,'' \MF\ will run a bit slower but it will
+report these statistics when |tracing_stats| is positive.
+
+@<Glob...@>=
+@!var_used, @!dyn_used : integer; {how much memory is in use}
+
+@ Let's consider the one-word memory region first, since it's the
+simplest. The pointer variable |mem_end| holds the highest-numbered location
+of |mem| that has ever been used. The free locations of |mem| that
+occur between |hi_mem_min| and |mem_end|, inclusive, are of type
+|two_halves|, and we write |info(p)| and |link(p)| for the |lh|
+and |rh| fields of |mem[p]| when it is of this type. The single-word
+free locations form a linked list
+$$|avail|,\;\hbox{|link(avail)|},\;\hbox{|link(link(avail))|},\;\ldots$$
+terminated by |null|.
+
+@d link(#) == mem[#].hh.rh {the |link| field of a memory word}
+@d info(#) == mem[#].hh.lh {the |info| field of a memory word}
+
+@<Glob...@>=
+@!avail : pointer; {head of the list of available one-word nodes}
+@!mem_end : pointer; {the last one-word node used in |mem|}
+
+@ If one-word memory is exhausted, it might mean that the user has forgotten
+a token like `\&{enddef}' or `\&{endfor}'. We will define some procedures
+later that try to help pinpoint the trouble.
+
+@p @t\4@>@<Declare the procedure called |show_token_list|@>@;
+@t\4@>@<Declare the procedure called |runaway|@>
+
+@ The function |get_avail| returns a pointer to a new one-word node whose
+|link| field is null. However, \MF\ will halt if there is no more room left.
+@^inner loop@>
+
+@p function get_avail : pointer; {single-word node allocation}
+var @!p:pointer; {the new node being got}
+begin p:=avail; {get top location in the |avail| stack}
+if p<>null then avail:=link(avail) {and pop it off}
+else if mem_end<mem_max then {or go into virgin territory}
+ begin incr(mem_end); p:=mem_end;
+ end
+else begin decr(hi_mem_min); p:=hi_mem_min;
+ if hi_mem_min<=lo_mem_max then
+ begin runaway; {if memory is exhausted, display possible runaway text}
+ overflow("main memory size",mem_max+1-mem_min);
+ {quit; all one-word nodes are busy}
+@:METAFONT capacity exceeded main memory size}{\quad main memory size@>
+ end;
+ end;
+link(p):=null; {provide an oft-desired initialization of the new node}
+@!stat incr(dyn_used);@+tats@;{maintain statistics}
+get_avail:=p;
+end;
+
+@ Conversely, a one-word node is recycled by calling |free_avail|.
+
+@d free_avail(#)== {single-word node liberation}
+ begin link(#):=avail; avail:=#;
+ @!stat decr(dyn_used);@+tats@/
+ end
+
+@ There's also a |fast_get_avail| routine, which saves the procedure-call
+overhead at the expense of extra programming. This macro is used in
+the places that would otherwise account for the most calls of |get_avail|.
+@^inner loop@>
+
+@d fast_get_avail(#)==@t@>@;@/
+ begin #:=avail; {avoid |get_avail| if possible, to save time}
+ if #=null then #:=get_avail
+ else begin avail:=link(#); link(#):=null;
+ @!stat incr(dyn_used);@+tats@/
+ end;
+ end
+
+@ The available-space list that keeps track of the variable-size portion
+of |mem| is a nonempty, doubly-linked circular list of empty nodes,
+pointed to by the roving pointer |rover|.
+
+Each empty node has size 2 or more; the first word contains the special
+value |max_halfword| in its |link| field and the size in its |info| field;
+the second word contains the two pointers for double linking.
+
+Each nonempty node also has size 2 or more. Its first word is of type
+|two_halves|\kern-1pt, and its |link| field is never equal to |max_halfword|.
+Otherwise there is complete flexibility with respect to the contents
+of its other fields and its other words.
+
+(We require |mem_max<max_halfword| because terrible things can happen
+when |max_halfword| appears in the |link| field of a nonempty node.)
+
+@d empty_flag == max_halfword {the |link| of an empty variable-size node}
+@d is_empty(#) == (link(#)=empty_flag) {tests for empty node}
+@d node_size == info {the size field in empty variable-size nodes}
+@d llink(#) == info(#+1) {left link in doubly-linked list of empty nodes}
+@d rlink(#) == link(#+1) {right link in doubly-linked list of empty nodes}
+
+@<Glob...@>=
+@!rover : pointer; {points to some node in the list of empties}
+
+@ A call to |get_node| with argument |s| returns a pointer to a new node
+of size~|s|, which must be 2~or more. The |link| field of the first word
+of this new node is set to null. An overflow stop occurs if no suitable
+space exists.
+
+If |get_node| is called with $s=2^{30}$, it simply merges adjacent free
+areas and returns the value |max_halfword|.
+
+@p function get_node(@!s:integer):pointer; {variable-size node allocation}
+label found,exit,restart;
+var @!p:pointer; {the node currently under inspection}
+@!q:pointer; {the node physically after node |p|}
+@!r:integer; {the newly allocated node, or a candidate for this honor}
+@!t,@!tt:integer; {temporary registers}
+@^inner loop@>
+begin restart: p:=rover; {start at some free node in the ring}
+repeat @<Try to allocate within node |p| and its physical successors,
+ and |goto found| if allocation was possible@>;
+p:=rlink(p); {move to the next node in the ring}
+until p=rover; {repeat until the whole list has been traversed}
+if s=@'10000000000 then
+ begin get_node:=max_halfword; return;
+ end;
+if lo_mem_max+2<hi_mem_min then if lo_mem_max+2<=mem_min+max_halfword then
+ @<Grow more variable-size memory and |goto restart|@>;
+overflow("main memory size",mem_max+1-mem_min);
+ {sorry, nothing satisfactory is left}
+@:METAFONT capacity exceeded main memory size}{\quad main memory size@>
+found: link(r):=null; {this node is now nonempty}
+@!stat var_used:=var_used+s; {maintain usage statistics}
+tats@;@/
+get_node:=r;
+exit:end;
+
+@ The lower part of |mem| grows by 1000 words at a time, unless
+we are very close to going under. When it grows, we simply link
+a new node into the available-space list. This method of controlled
+growth helps to keep the |mem| usage consecutive when \MF\ is
+implemented on ``virtual memory'' systems.
+@^virtual memory@>
+
+@<Grow more variable-size memory and |goto restart|@>=
+begin if hi_mem_min-lo_mem_max>=1998 then t:=lo_mem_max+1000
+else t:=lo_mem_max+1+(hi_mem_min-lo_mem_max) div 2;
+ {|lo_mem_max+2<=t<hi_mem_min|}
+if t>mem_min+max_halfword then t:=mem_min+max_halfword;
+p:=llink(rover); q:=lo_mem_max; rlink(p):=q; llink(rover):=q;@/
+rlink(q):=rover; llink(q):=p; link(q):=empty_flag; node_size(q):=t-lo_mem_max;@/
+lo_mem_max:=t; link(lo_mem_max):=null; info(lo_mem_max):=null;
+rover:=q; goto restart;
+end
+
+@ @<Try to allocate...@>=
+q:=p+node_size(p); {find the physical successor}
+while is_empty(q) do {merge node |p| with node |q|}
+ begin t:=rlink(q); tt:=llink(q);
+@^inner loop@>
+ if q=rover then rover:=t;
+ llink(t):=tt; rlink(tt):=t;@/
+ q:=q+node_size(q);
+ end;
+r:=q-s;
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+if r=p then if rlink(p)<>p then
+ @<Allocate entire node |p| and |goto found|@>;
+node_size(p):=q-p {reset the size in case it grew}
+
+@ @<Allocate from the top...@>=
+begin node_size(p):=r-p; {store the remaining size}
+rover:=p; {start searching here next time}
+goto found;
+end
+
+@ Here we delete node |p| from the ring, and let |rover| rove around.
+
+@<Allocate entire...@>=
+begin rover:=rlink(p); t:=llink(p);
+llink(rover):=t; rlink(t):=rover;
+goto found;
+end
+
+@ Conversely, when some variable-size node |p| of size |s| is no longer needed,
+the operation |free_node(p,s)| will make its words available, by inserting
+|p| as a new empty node just before where |rover| now points.
+
+@p procedure free_node(@!p:pointer; @!s:halfword); {variable-size node
+ liberation}
+var @!q:pointer; {|llink(rover)|}
+begin node_size(p):=s; link(p):=empty_flag;
+@^inner loop@>
+q:=llink(rover); llink(p):=q; rlink(p):=rover; {set both links}
+llink(rover):=p; rlink(q):=p; {insert |p| into the ring}
+@!stat var_used:=var_used-s;@+tats@;{maintain statistics}
+end;
+
+@ Just before \.{INIMF} writes out the memory, it sorts the doubly linked
+available space list. The list is probably very short at such times, so a
+simple insertion sort is used. The smallest available location will be
+pointed to by |rover|, the next-smallest by |rlink(rover)|, etc.
+
+@p @!init procedure sort_avail; {sorts the available variable-size nodes
+ by location}
+var @!p,@!q,@!r: pointer; {indices into |mem|}
+@!old_rover:pointer; {initial |rover| setting}
+begin p:=get_node(@'10000000000); {merge adjacent free areas}
+p:=rlink(rover); rlink(rover):=max_halfword; old_rover:=rover;
+while p<>old_rover do @<Sort |p| into the list starting at |rover|
+ and advance |p| to |rlink(p)|@>;
+p:=rover;
+while rlink(p)<>max_halfword do
+ begin llink(rlink(p)):=p; p:=rlink(p);
+ end;
+rlink(p):=rover; llink(rover):=p;
+end;
+tini
+
+@ The following |while| loop is guaranteed to
+terminate, since the list that starts at
+|rover| ends with |max_halfword| during the sorting procedure.
+
+@<Sort |p|...@>=
+if p<rover then
+ begin q:=p; p:=rlink(q); rlink(q):=rover; rover:=q;
+ end
+else begin q:=rover;
+ while rlink(q)<p do q:=rlink(q);
+ r:=rlink(p); rlink(p):=rlink(q); rlink(q):=p; p:=r;
+ end
+
+@* \[11] Memory layout.
+Some areas of |mem| are dedicated to fixed usage, since static allocation is
+more efficient than dynamic allocation when we can get away with it. For
+example, locations |mem_min| to |mem_min+2| are always used to store the
+specification for null pen coordinates that are `$(0,0)$'. The
+following macro definitions accomplish the static allocation by giving
+symbolic names to the fixed positions. Static variable-size nodes appear
+in locations |mem_min| through |lo_mem_stat_max|, and static single-word nodes
+appear in locations |hi_mem_stat_min| through |mem_top|, inclusive.
+
+@d null_coords==mem_min {specification for pen offsets of $(0,0)$}
+@d null_pen==null_coords+3 {we will define |coord_node_size=3|}
+@d dep_head==null_pen+10 {and |pen_node_size=10|}
+@d zero_val==dep_head+2 {two words for a permanently zero value}
+@d temp_val==zero_val+2 {two words for a temporary value node}
+@d end_attr==temp_val {we use |end_attr+2| only}
+@d inf_val==end_attr+2 {and |inf_val+1| only}
+@d bad_vardef==inf_val+2 {two words for \&{vardef} error recovery}
+@d lo_mem_stat_max==bad_vardef+1 {largest statically
+ allocated word in the variable-size |mem|}
+@#
+@d sentinel==mem_top {end of sorted lists}
+@d temp_head==mem_top-1 {head of a temporary list of some kind}
+@d hold_head==mem_top-2 {head of a temporary list of another kind}
+@d hi_mem_stat_min==mem_top-2 {smallest statically allocated word in
+ the one-word |mem|}
+
+@ The following code gets the dynamic part of |mem| off to a good start,
+when \MF\ is initializing itself the slow way.
+
+@<Initialize table entries (done by \.{INIMF} only)@>=
+@^data structure assumptions@>
+rover:=lo_mem_stat_max+1; {initialize the dynamic memory}
+link(rover):=empty_flag;
+node_size(rover):=1000; {which is a 1000-word available node}
+llink(rover):=rover; rlink(rover):=rover;@/
+lo_mem_max:=rover+1000; link(lo_mem_max):=null; info(lo_mem_max):=null;@/
+for k:=hi_mem_stat_min to mem_top do
+ mem[k]:=mem[lo_mem_max]; {clear list heads}
+avail:=null; mem_end:=mem_top;
+hi_mem_min:=hi_mem_stat_min; {initialize the one-word memory}
+var_used:=lo_mem_stat_max+1-mem_min; dyn_used:=mem_top+1-hi_mem_min;
+ {initialize statistics}
+
+@ The procedure |flush_list(p)| frees an entire linked list of one-word
+nodes that starts at a given position, until coming to |sentinel| or a
+pointer that is not in the one-word region. Another procedure,
+|flush_node_list|, frees an entire linked list of one-word and two-word
+nodes, until coming to a |null| pointer.
+@^inner loop@>
+
+@p procedure flush_list(@!p:pointer); {makes list of single-word nodes
+ available}
+label done;
+var @!q,@!r:pointer; {list traversers}
+begin if p>=hi_mem_min then if p<>sentinel then
+ begin r:=p;
+ repeat q:=r; r:=link(r); @!stat decr(dyn_used);@+tats@/
+ if r<hi_mem_min then goto done;
+ until r=sentinel;
+ done: {now |q| is the last node on the list}
+ link(q):=avail; avail:=p;
+ end;
+end;
+@#
+procedure flush_node_list(@!p:pointer);
+var @!q:pointer; {the node being recycled}
+begin while p<>null do
+ begin q:=p; p:=link(p);
+ if q<hi_mem_min then free_node(q,2)@+else free_avail(q);
+ end;
+end;
+
+@ If \MF\ is extended improperly, the |mem| array might get screwed up.
+For example, some pointers might be wrong, or some ``dead'' nodes might not
+have been freed when the last reference to them disappeared. Procedures
+|check_mem| and |search_mem| are available to help diagnose such
+problems. These procedures make use of two arrays called |free| and
+|was_free| that are present only if \MF's debugging routines have
+been included. (You may want to decrease the size of |mem| while you
+@^debugging@>
+are debugging.)
+
+@<Glob...@>=
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip1em@>@!was_free: packed array [mem_min..mem_max] of boolean;
+ {previously free cells}
+@t\hskip1em@>@!was_mem_end,@!was_lo_max,@!was_hi_min: pointer;
+ {previous |mem_end|, |lo_mem_max|, and |hi_mem_min|}
+@t\hskip1em@>@!panicking:boolean; {do we want to check memory constantly?}
+gubed
+
+@ @<Set initial...@>=
+@!debug was_mem_end:=mem_min; {indicate that everything was previously free}
+was_lo_max:=mem_min; was_hi_min:=mem_max;
+panicking:=false;
+gubed
+
+@ Procedure |check_mem| makes sure that the available space lists of
+|mem| are well formed, and it optionally prints out all locations
+that are reserved now but were free the last time this procedure was called.
+
+@p @!debug procedure check_mem(@!print_locs : boolean);
+label done1,done2; {loop exits}
+var @!p,@!q,@!r:pointer; {current locations of interest in |mem|}
+@!clobbered:boolean; {is something amiss?}
+begin for p:=mem_min to lo_mem_max do free[p]:=false; {you can probably
+ do this faster}
+for p:=hi_mem_min to mem_end do free[p]:=false; {ditto}
+@<Check single-word |avail| list@>;
+@<Check variable-size |avail| list@>;
+@<Check flags of unavailable nodes@>;
+@<Check the list of linear dependencies@>;
+if print_locs then @<Print newly busy locations@>;
+for p:=mem_min to lo_mem_max do was_free[p]:=free[p];
+for p:=hi_mem_min to mem_end do was_free[p]:=free[p];
+ {|was_free:=free| might be faster}
+was_mem_end:=mem_end; was_lo_max:=lo_mem_max; was_hi_min:=hi_mem_min;
+end;
+gubed
+
+@ @<Check single-word...@>=
+p:=avail; q:=null; clobbered:=false;
+while p<>null do
+ begin if (p>mem_end)or(p<hi_mem_min) then clobbered:=true
+ else if free[p] then clobbered:=true;
+ if clobbered then
+ begin print_nl("AVAIL list clobbered at ");
+@.AVAIL list clobbered...@>
+ print_int(q); goto done1;
+ end;
+ free[p]:=true; q:=p; p:=link(q);
+ end;
+done1:
+
+@ @<Check variable-size...@>=
+p:=rover; q:=null; clobbered:=false;
+repeat if (p>=lo_mem_max)or(p<mem_min) then clobbered:=true
+ else if (rlink(p)>=lo_mem_max)or(rlink(p)<mem_min) then clobbered:=true
+ else if not(is_empty(p))or(node_size(p)<2)or@|
+ (p+node_size(p)>lo_mem_max)or@| (llink(rlink(p))<>p) then clobbered:=true;
+ if clobbered then
+ begin print_nl("Double-AVAIL list clobbered at ");
+@.Double-AVAIL list clobbered...@>
+ print_int(q); goto done2;
+ end;
+for q:=p to p+node_size(p)-1 do {mark all locations free}
+ begin if free[q] then
+ begin print_nl("Doubly free location at ");
+@.Doubly free location...@>
+ print_int(q); goto done2;
+ end;
+ free[q]:=true;
+ end;
+q:=p; p:=rlink(p);
+until p=rover;
+done2:
+
+@ @<Check flags...@>=
+p:=mem_min;
+while p<=lo_mem_max do {node |p| should not be empty}
+ begin if is_empty(p) then
+ begin print_nl("Bad flag at "); print_int(p);
+@.Bad flag...@>
+ end;
+ while (p<=lo_mem_max) and not free[p] do incr(p);
+ while (p<=lo_mem_max) and free[p] do incr(p);
+ end
+
+@ @<Print newly busy...@>=
+begin print_nl("New busy locs:");
+@.New busy locs@>
+for p:=mem_min to lo_mem_max do
+ if not free[p] and ((p>was_lo_max) or was_free[p]) then
+ begin print_char(" "); print_int(p);
+ end;
+for p:=hi_mem_min to mem_end do
+ if not free[p] and
+ ((p<was_hi_min) or (p>was_mem_end) or was_free[p]) then
+ begin print_char(" "); print_int(p);
+ end;
+end
+
+@ The |search_mem| procedure attempts to answer the question ``Who points
+to node~|p|?'' In doing so, it fetches |link| and |info| fields of |mem|
+that might not be of type |two_halves|. Strictly speaking, this is
+@^dirty \PASCAL@>
+undefined in \PASCAL, and it can lead to ``false drops'' (words that seem to
+point to |p| purely by coincidence). But for debugging purposes, we want
+to rule out the places that do {\sl not\/} point to |p|, so a few false
+drops are tolerable.
+
+@p @!debug procedure search_mem(@!p:pointer); {look for pointers to |p|}
+var @!q:integer; {current position being searched}
+begin for q:=mem_min to lo_mem_max do
+ begin if link(q)=p then
+ begin print_nl("LINK("); print_int(q); print_char(")");
+ end;
+ if info(q)=p then
+ begin print_nl("INFO("); print_int(q); print_char(")");
+ end;
+ end;
+for q:=hi_mem_min to mem_end do
+ begin if link(q)=p then
+ begin print_nl("LINK("); print_int(q); print_char(")");
+ end;
+ if info(q)=p then
+ begin print_nl("INFO("); print_int(q); print_char(")");
+ end;
+ end;
+@<Search |eqtb| for equivalents equal to |p|@>;
+end;
+gubed
+
+@* \[12] The command codes.
+Before we can go much further, we need to define symbolic names for the internal
+code numbers that represent the various commands obeyed by \MF. These codes
+are somewhat arbitrary, but not completely so. For example,
+some codes have been made adjacent so that |case| statements in the
+program need not consider cases that are widely spaced, or so that |case|
+statements can be replaced by |if| statements. A command can begin an
+expression if and only if its code lies between |min_primary_command| and
+|max_primary_command|, inclusive. The first token of a statement that doesn't
+begin with an expression has a command code between |min_command| and
+|max_statement_command|, inclusive. The ordering of the highest-numbered
+commands (|comma<semicolon<end_group<stop|) is crucial for the parsing
+and error-recovery methods of this program.
+
+At any rate, here is the list, for future reference.
+
+@d if_test=1 {conditional text (\&{if})}
+@d fi_or_else=2 {delimiters for conditionals (\&{elseif}, \&{else}, \&{fi}}
+@d input=3 {input a source file (\&{input}, \&{endinput})}
+@d iteration=4 {iterate (\&{for}, \&{forsuffixes}, \&{forever}, \&{endfor})}
+@d repeat_loop=5 {special command substituted for \&{endfor}}
+@d exit_test=6 {premature exit from a loop (\&{exitif})}
+@d relax=7 {do nothing (\.{\char`\\})}
+@d scan_tokens=8 {put a string into the input buffer}
+@d expand_after=9 {look ahead one token}
+@d defined_macro=10 {a macro defined by the user}
+@d min_command=defined_macro+1
+@d display_command=11 {online graphic output (\&{display})}
+@d save_command=12 {save a list of tokens (\&{save})}
+@d interim_command=13 {save an internal quantity (\&{interim})}
+@d let_command=14 {redefine a symbolic token (\&{let})}
+@d new_internal=15 {define a new internal quantity (\&{newinternal})}
+@d macro_def=16 {define a macro (\&{def}, \&{vardef}, etc.)}
+@d ship_out_command=17 {output a character (\&{shipout})}
+@d add_to_command=18 {add to edges (\&{addto})}
+@d cull_command=19 {cull and normalize edges (\&{cull})}
+@d tfm_command=20 {command for font metric info (\&{ligtable}, etc.)}
+@d protection_command=21 {set protection flag (\&{outer}, \&{inner})}
+@d show_command=22 {diagnostic output (\&{show}, \&{showvariable}, etc.)}
+@d mode_command=23 {set interaction level (\&{batchmode}, etc.)}
+@d random_seed=24 {initialize random number generator (\&{randomseed})}
+@d message_command=25 {communicate to user (\&{message}, \&{errmessage})}
+@d every_job_command=26 {designate a starting token (\&{everyjob})}
+@d delimiters=27 {define a pair of delimiters (\&{delimiters})}
+@d open_window=28 {define a window on the screen (\&{openwindow})}
+@d special_command=29 {output special info (\&{special}, \&{numspecial})}
+@d type_name=30 {declare a type (\&{numeric}, \&{pair}, etc.}
+@d max_statement_command=type_name
+@d min_primary_command=type_name
+@d left_delimiter=31 {the left delimiter of a matching pair}
+@d begin_group=32 {beginning of a group (\&{begingroup})}
+@d nullary=33 {an operator without arguments (e.g., \&{normaldeviate})}
+@d unary=34 {an operator with one argument (e.g., \&{sqrt})}
+@d str_op=35 {convert a suffix to a string (\&{str})}
+@d cycle=36 {close a cyclic path (\&{cycle})}
+@d primary_binary=37 {binary operation taking `\&{of}' (e.g., \&{point})}
+@d capsule_token=38 {a value that has been put into a token list}
+@d string_token=39 {a string constant (e.g., |"hello"|)}
+@d internal_quantity=40 {internal numeric parameter (e.g., \&{pausing})}
+@d min_suffix_token=internal_quantity
+@d tag_token=41 {a symbolic token without a primitive meaning}
+@d numeric_token=42 {a numeric constant (e.g., \.{3.14159})}
+@d max_suffix_token=numeric_token
+@d plus_or_minus=43 {either `\.+' or `\.-'}
+@d max_primary_command=plus_or_minus {should also be |numeric_token+1|}
+@d min_tertiary_command=plus_or_minus
+@d tertiary_secondary_macro=44 {a macro defined by \&{secondarydef}}
+@d tertiary_binary=45 {an operator at the tertiary level (e.g., `\.{++}')}
+@d max_tertiary_command=tertiary_binary
+@d left_brace=46 {the operator `\.{\char`\{}'}
+@d min_expression_command=left_brace
+@d path_join=47 {the operator `\.{..}'}
+@d ampersand=48 {the operator `\.\&'}
+@d expression_tertiary_macro=49 {a macro defined by \&{tertiarydef}}
+@d expression_binary=50 {an operator at the expression level (e.g., `\.<')}
+@d equals=51 {the operator `\.='}
+@d max_expression_command=equals
+@d and_command=52 {the operator `\&{and}'}
+@d min_secondary_command=and_command
+@d secondary_primary_macro=53 {a macro defined by \&{primarydef}}
+@d slash=54 {the operator `\./'}
+@d secondary_binary=55 {an operator at the binary level (e.g., \&{shifted})}
+@d max_secondary_command=secondary_binary
+@d param_type=56 {type of parameter (\&{primary}, \&{expr}, \&{suffix}, etc.)}
+@d controls=57 {specify control points explicitly (\&{controls})}
+@d tension=58 {specify tension between knots (\&{tension})}
+@d at_least=59 {bounded tension value (\&{atleast})}
+@d curl_command=60 {specify curl at an end knot (\&{curl})}
+@d macro_special=61 {special macro operators (\&{quote}, \.{\#\AT!}, etc.)}
+@d right_delimiter=62 {the right delimiter of a matching pair}
+@d left_bracket=63 {the operator `\.['}
+@d right_bracket=64 {the operator `\.]'}
+@d right_brace=65 {the operator `\.{\char`\}}'}
+@d with_option=66 {option for filling (\&{withpen}, \&{withweight})}
+@d cull_op=67 {the operator `\&{keeping}' or `\&{dropping}'}
+@d thing_to_add=68
+ {variant of \&{addto} (\&{contour}, \&{doublepath}, \&{also})}
+@d of_token=69 {the operator `\&{of}'}
+@d from_token=70 {the operator `\&{from}'}
+@d to_token=71 {the operator `\&{to}'}
+@d at_token=72 {the operator `\&{at}'}
+@d in_window=73 {the operator `\&{inwindow}'}
+@d step_token=74 {the operator `\&{step}'}
+@d until_token=75 {the operator `\&{until}'}
+@d lig_kern_token=76
+ {the operators `\&{kern}' and `\.{=:}' and `\.{=:\char'174}, etc.}
+@d assignment=77 {the operator `\.{:=}'}
+@d skip_to=78 {the operation `\&{skipto}'}
+@d bchar_label=79 {the operator `\.{\char'174\char'174:}'}
+@d double_colon=80 {the operator `\.{::}'}
+@d colon=81 {the operator `\.:'}
+@#
+@d comma=82 {the operator `\.,', must be |colon+1|}
+@d end_of_statement==cur_cmd>comma
+@d semicolon=83 {the operator `\.;', must be |comma+1|}
+@d end_group=84 {end a group (\&{endgroup}), must be |semicolon+1|}
+@d stop=85 {end a job (\&{end}, \&{dump}), must be |end_group+1|}
+@d max_command_code=stop
+@d outer_tag=max_command_code+1 {protection code added to command code}
+
+@<Types...@>=
+@!command_code=1..max_command_code;
+
+@ Variables and capsules in \MF\ have a variety of ``types,''
+distinguished by the following code numbers:
+
+@d undefined=0 {no type has been declared}
+@d unknown_tag=1 {this constant is added to certain type codes below}
+@d vacuous=1 {no expression was present}
+@d boolean_type=2 {\&{boolean} with a known value}
+@d unknown_boolean=boolean_type+unknown_tag
+@d string_type=4 {\&{string} with a known value}
+@d unknown_string=string_type+unknown_tag
+@d pen_type=6 {\&{pen} with a known value}
+@d unknown_pen=pen_type+unknown_tag
+@d future_pen=8 {subexpression that will become a \&{pen} at a higher level}
+@d path_type=9 {\&{path} with a known value}
+@d unknown_path=path_type+unknown_tag
+@d picture_type=11 {\&{picture} with a known value}
+@d unknown_picture=picture_type+unknown_tag
+@d transform_type=13 {\&{transform} variable or capsule}
+@d pair_type=14 {\&{pair} variable or capsule}
+@d numeric_type=15 {variable that has been declared \&{numeric} but not used}
+@d known=16 {\&{numeric} with a known value}
+@d dependent=17 {a linear combination with |fraction| coefficients}
+@d proto_dependent=18 {a linear combination with |scaled| coefficients}
+@d independent=19 {\&{numeric} with unknown value}
+@d token_list=20 {variable name or suffix argument or text argument}
+@d structured=21 {variable with subscripts and attributes}
+@d unsuffixed_macro=22 {variable defined with \&{vardef} but no \.{\AT!\#}}
+@d suffixed_macro=23 {variable defined with \&{vardef} and \.{\AT!\#}}
+@#
+@d unknown_types==unknown_boolean,unknown_string,
+ unknown_pen,unknown_picture,unknown_path
+
+@<Basic printing procedures@>=
+procedure print_type(@!t:small_number);
+begin case t of
+vacuous:print("vacuous");
+boolean_type:print("boolean");
+unknown_boolean:print("unknown boolean");
+string_type:print("string");
+unknown_string:print("unknown string");
+pen_type:print("pen");
+unknown_pen:print("unknown pen");
+future_pen:print("future pen");
+path_type:print("path");
+unknown_path:print("unknown path");
+picture_type:print("picture");
+unknown_picture:print("unknown picture");
+transform_type:print("transform");
+pair_type:print("pair");
+known:print("known numeric");
+dependent:print("dependent");
+proto_dependent:print("proto-dependent");
+numeric_type:print("numeric");
+independent:print("independent");
+token_list:print("token list");
+structured:print("structured");
+unsuffixed_macro:print("unsuffixed macro");
+suffixed_macro:print("suffixed macro");
+othercases print("undefined")
+endcases;
+end;
+
+@ Values inside \MF\ are stored in two-word nodes that have a |name_type|
+as well as a |type|. The possibilities for |name_type| are defined
+here; they will be explained in more detail later.
+
+@d root=0 {|name_type| at the top level of a variable}
+@d saved_root=1 {same, when the variable has been saved}
+@d structured_root=2 {|name_type| where a |structured| branch occurs}
+@d subscr=3 {|name_type| in a subscript node}
+@d attr=4 {|name_type| in an attribute node}
+@d x_part_sector=5 {|name_type| in the \&{xpart} of a node}
+@d y_part_sector=6 {|name_type| in the \&{ypart} of a node}
+@d xx_part_sector=7 {|name_type| in the \&{xxpart} of a node}
+@d xy_part_sector=8 {|name_type| in the \&{xypart} of a node}
+@d yx_part_sector=9 {|name_type| in the \&{yxpart} of a node}
+@d yy_part_sector=10 {|name_type| in the \&{yypart} of a node}
+@d capsule=11 {|name_type| in stashed-away subexpressions}
+@d token=12 {|name_type| in a numeric token or string token}
+
+@ Primitive operations that produce values have a secondary identification
+code in addition to their command code; it's something like genera and species.
+For example, `\.*' has the command code |primary_binary|, and its
+secondary identification is |times|. The secondary codes start at 30 so that
+they don't overlap with the type codes; some type codes (e.g., |string_type|)
+are used as operators as well as type identifications.
+
+@d true_code=30 {operation code for \.{true}}
+@d false_code=31 {operation code for \.{false}}
+@d null_picture_code=32 {operation code for \.{nullpicture}}
+@d null_pen_code=33 {operation code for \.{nullpen}}
+@d job_name_op=34 {operation code for \.{jobname}}
+@d read_string_op=35 {operation code for \.{readstring}}
+@d pen_circle=36 {operation code for \.{pencircle}}
+@d normal_deviate=37 {operation code for \.{normaldeviate}}
+@d odd_op=38 {operation code for \.{odd}}
+@d known_op=39 {operation code for \.{known}}
+@d unknown_op=40 {operation code for \.{unknown}}
+@d not_op=41 {operation code for \.{not}}
+@d decimal=42 {operation code for \.{decimal}}
+@d reverse=43 {operation code for \.{reverse}}
+@d make_path_op=44 {operation code for \.{makepath}}
+@d make_pen_op=45 {operation code for \.{makepen}}
+@d total_weight_op=46 {operation code for \.{totalweight}}
+@d oct_op=47 {operation code for \.{oct}}
+@d hex_op=48 {operation code for \.{hex}}
+@d ASCII_op=49 {operation code for \.{ASCII}}
+@d char_op=50 {operation code for \.{char}}
+@d length_op=51 {operation code for \.{length}}
+@d turning_op=52 {operation code for \.{turningnumber}}
+@d x_part=53 {operation code for \.{xpart}}
+@d y_part=54 {operation code for \.{ypart}}
+@d xx_part=55 {operation code for \.{xxpart}}
+@d xy_part=56 {operation code for \.{xypart}}
+@d yx_part=57 {operation code for \.{yxpart}}
+@d yy_part=58 {operation code for \.{yypart}}
+@d sqrt_op=59 {operation code for \.{sqrt}}
+@d m_exp_op=60 {operation code for \.{mexp}}
+@d m_log_op=61 {operation code for \.{mlog}}
+@d sin_d_op=62 {operation code for \.{sind}}
+@d cos_d_op=63 {operation code for \.{cosd}}
+@d floor_op=64 {operation code for \.{floor}}
+@d uniform_deviate=65 {operation code for \.{uniformdeviate}}
+@d char_exists_op=66 {operation code for \.{charexists}}
+@d angle_op=67 {operation code for \.{angle}}
+@d cycle_op=68 {operation code for \.{cycle}}
+@d plus=69 {operation code for \.+}
+@d minus=70 {operation code for \.-}
+@d times=71 {operation code for \.*}
+@d over=72 {operation code for \./}
+@d pythag_add=73 {operation code for \.{++}}
+@d pythag_sub=74 {operation code for \.{+-+}}
+@d or_op=75 {operation code for \.{or}}
+@d and_op=76 {operation code for \.{and}}
+@d less_than=77 {operation code for \.<}
+@d less_or_equal=78 {operation code for \.{<=}}
+@d greater_than=79 {operation code for \.>}
+@d greater_or_equal=80 {operation code for \.{>=}}
+@d equal_to=81 {operation code for \.=}
+@d unequal_to=82 {operation code for \.{<>}}
+@d concatenate=83 {operation code for \.\&}
+@d rotated_by=84 {operation code for \.{rotated}}
+@d slanted_by=85 {operation code for \.{slanted}}
+@d scaled_by=86 {operation code for \.{scaled}}
+@d shifted_by=87 {operation code for \.{shifted}}
+@d transformed_by=88 {operation code for \.{transformed}}
+@d x_scaled=89 {operation code for \.{xscaled}}
+@d y_scaled=90 {operation code for \.{yscaled}}
+@d z_scaled=91 {operation code for \.{zscaled}}
+@d intersect=92 {operation code for \.{intersectiontimes}}
+@d double_dot=93 {operation code for improper \.{..}}
+@d substring_of=94 {operation code for \.{substring}}
+@d min_of=substring_of
+@d subpath_of=95 {operation code for \.{subpath}}
+@d direction_time_of=96 {operation code for \.{directiontime}}
+@d point_of=97 {operation code for \.{point}}
+@d precontrol_of=98 {operation code for \.{precontrol}}
+@d postcontrol_of=99 {operation code for \.{postcontrol}}
+@d pen_offset_of=100 {operation code for \.{penoffset}}
+
+@p procedure print_op(@!c:quarterword);
+begin if c<=numeric_type then print_type(c)
+else case c of
+true_code:print("true");
+false_code:print("false");
+null_picture_code:print("nullpicture");
+null_pen_code:print("nullpen");
+job_name_op:print("jobname");
+read_string_op:print("readstring");
+pen_circle:print("pencircle");
+normal_deviate:print("normaldeviate");
+odd_op:print("odd");
+known_op:print("known");
+unknown_op:print("unknown");
+not_op:print("not");
+decimal:print("decimal");
+reverse:print("reverse");
+make_path_op:print("makepath");
+make_pen_op:print("makepen");
+total_weight_op:print("totalweight");
+oct_op:print("oct");
+hex_op:print("hex");
+ASCII_op:print("ASCII");
+char_op:print("char");
+length_op:print("length");
+turning_op:print("turningnumber");
+x_part:print("xpart");
+y_part:print("ypart");
+xx_part:print("xxpart");
+xy_part:print("xypart");
+yx_part:print("yxpart");
+yy_part:print("yypart");
+sqrt_op:print("sqrt");
+m_exp_op:print("mexp");
+m_log_op:print("mlog");
+sin_d_op:print("sind");
+cos_d_op:print("cosd");
+floor_op:print("floor");
+uniform_deviate:print("uniformdeviate");
+char_exists_op:print("charexists");
+angle_op:print("angle");
+cycle_op:print("cycle");
+plus:print_char("+");
+minus:print_char("-");
+times:print_char("*");
+over:print_char("/");
+pythag_add:print("++");
+pythag_sub:print("+-+");
+or_op:print("or");
+and_op:print("and");
+less_than:print_char("<");
+less_or_equal:print("<=");
+greater_than:print_char(">");
+greater_or_equal:print(">=");
+equal_to:print_char("=");
+unequal_to:print("<>");
+concatenate:print("&");
+rotated_by:print("rotated");
+slanted_by:print("slanted");
+scaled_by:print("scaled");
+shifted_by:print("shifted");
+transformed_by:print("transformed");
+x_scaled:print("xscaled");
+y_scaled:print("yscaled");
+z_scaled:print("zscaled");
+intersect:print("intersectiontimes");
+substring_of:print("substring");
+subpath_of:print("subpath");
+direction_time_of:print("directiontime");
+point_of:print("point");
+precontrol_of:print("precontrol");
+postcontrol_of:print("postcontrol");
+pen_offset_of:print("penoffset");
+othercases print("..")
+endcases;
+end;
+
+@ \MF\ also has a bunch of internal parameters that a user might want to
+fuss with. Every such parameter has an identifying code number, defined here.
+
+@d tracing_titles=1 {show titles online when they appear}
+@d tracing_equations=2 {show each variable when it becomes known}
+@d tracing_capsules=3 {show capsules too}
+@d tracing_choices=4 {show the control points chosen for paths}
+@d tracing_specs=5 {show subdivision of paths into octants before digitizing}
+@d tracing_pens=6 {show details of pens that are made}
+@d tracing_commands=7 {show commands and operations before they are performed}
+@d tracing_restores=8 {show when a variable or internal is restored}
+@d tracing_macros=9 {show macros before they are expanded}
+@d tracing_edges=10 {show digitized edges as they are computed}
+@d tracing_output=11 {show digitized edges as they are output}
+@d tracing_stats=12 {show memory usage at end of job}
+@d tracing_online=13 {show long diagnostics on terminal and in the log file}
+@d year=14 {the current year (e.g., 1984)}
+@d month=15 {the current month (e.g, 3 $\equiv$ March)}
+@d day=16 {the current day of the month}
+@d time=17 {the number of minutes past midnight when this job started}
+@d char_code=18 {the number of the next character to be output}
+@d char_ext=19 {the extension code of the next character to be output}
+@d char_wd=20 {the width of the next character to be output}
+@d char_ht=21 {the height of the next character to be output}
+@d char_dp=22 {the depth of the next character to be output}
+@d char_ic=23 {the italic correction of the next character to be output}
+@d char_dx=24 {the device's $x$ movement for the next character, in pixels}
+@d char_dy=25 {the device's $y$ movement for the next character, in pixels}
+@d design_size=26 {the unit of measure used for |char_wd..char_ic|, in points}
+@d hppp=27 {the number of horizontal pixels per point}
+@d vppp=28 {the number of vertical pixels per point}
+@d x_offset=29 {horizontal displacement of shipped-out characters}
+@d y_offset=30 {vertical displacement of shipped-out characters}
+@d pausing=31 {positive to display lines on the terminal before they are read}
+@d showstopping=32 {positive to stop after each \&{show} command}
+@d fontmaking=33 {positive if font metric output is to be produced}
+@d proofing=34 {positive for proof mode, negative to suppress output}
+@d smoothing=35 {positive if moves are to be ``smoothed''}
+@d autorounding=36 {controls path modification to ``good'' points}
+@d granularity=37 {autorounding uses this pixel size}
+@d fillin=38 {extra darkness of diagonal lines}
+@d turning_check=39 {controls reorientation of clockwise paths}
+@d warning_check=40 {controls error message when variable value is large}
+@d boundary_char=41 {the right boundary character for ligatures}
+@d max_given_internal=41
+
+@<Glob...@>=
+@!internal:array[1..max_internal] of scaled;
+ {the values of internal quantities}
+@!int_name:array[1..max_internal] of str_number;
+ {their names}
+@!int_ptr:max_given_internal..max_internal;
+ {the maximum internal quantity defined so far}
+
+@ @<Set init...@>=
+for k:=1 to max_given_internal do internal[k]:=0;
+int_ptr:=max_given_internal;
+
+@ The symbolic names for internal quantities are put into \MF's hash table
+by using a routine called |primitive|, which will be defined later. Let us
+enter them now, so that we don't have to list all those names again
+anywhere else.
+
+@<Put each of \MF's primitives into the hash table@>=
+primitive("tracingtitles",internal_quantity,tracing_titles);@/
+@!@:tracingtitles_}{\&{tracingtitles} primitive@>
+primitive("tracingequations",internal_quantity,tracing_equations);@/
+@!@:tracing_equations_}{\&{tracingequations} primitive@>
+primitive("tracingcapsules",internal_quantity,tracing_capsules);@/
+@!@:tracing_capsules_}{\&{tracingcapsules} primitive@>
+primitive("tracingchoices",internal_quantity,tracing_choices);@/
+@!@:tracing_choices_}{\&{tracingchoices} primitive@>
+primitive("tracingspecs",internal_quantity,tracing_specs);@/
+@!@:tracing_specs_}{\&{tracingspecs} primitive@>
+primitive("tracingpens",internal_quantity,tracing_pens);@/
+@!@:tracing_pens_}{\&{tracingpens} primitive@>
+primitive("tracingcommands",internal_quantity,tracing_commands);@/
+@!@:tracing_commands_}{\&{tracingcommands} primitive@>
+primitive("tracingrestores",internal_quantity,tracing_restores);@/
+@!@:tracing_restores_}{\&{tracingrestores} primitive@>
+primitive("tracingmacros",internal_quantity,tracing_macros);@/
+@!@:tracing_macros_}{\&{tracingmacros} primitive@>
+primitive("tracingedges",internal_quantity,tracing_edges);@/
+@!@:tracing_edges_}{\&{tracingedges} primitive@>
+primitive("tracingoutput",internal_quantity,tracing_output);@/
+@!@:tracing_output_}{\&{tracingoutput} primitive@>
+primitive("tracingstats",internal_quantity,tracing_stats);@/
+@!@:tracing_stats_}{\&{tracingstats} primitive@>
+primitive("tracingonline",internal_quantity,tracing_online);@/
+@!@:tracing_online_}{\&{tracingonline} primitive@>
+primitive("year",internal_quantity,year);@/
+@!@:year_}{\&{year} primitive@>
+primitive("month",internal_quantity,month);@/
+@!@:month_}{\&{month} primitive@>
+primitive("day",internal_quantity,day);@/
+@!@:day_}{\&{day} primitive@>
+primitive("time",internal_quantity,time);@/
+@!@:time_}{\&{time} primitive@>
+primitive("charcode",internal_quantity,char_code);@/
+@!@:char_code_}{\&{charcode} primitive@>
+primitive("charext",internal_quantity,char_ext);@/
+@!@:char_ext_}{\&{charext} primitive@>
+primitive("charwd",internal_quantity,char_wd);@/
+@!@:char_wd_}{\&{charwd} primitive@>
+primitive("charht",internal_quantity,char_ht);@/
+@!@:char_ht_}{\&{charht} primitive@>
+primitive("chardp",internal_quantity,char_dp);@/
+@!@:char_dp_}{\&{chardp} primitive@>
+primitive("charic",internal_quantity,char_ic);@/
+@!@:char_ic_}{\&{charic} primitive@>
+primitive("chardx",internal_quantity,char_dx);@/
+@!@:char_dx_}{\&{chardx} primitive@>
+primitive("chardy",internal_quantity,char_dy);@/
+@!@:char_dy_}{\&{chardy} primitive@>
+primitive("designsize",internal_quantity,design_size);@/
+@!@:design_size_}{\&{designsize} primitive@>
+primitive("hppp",internal_quantity,hppp);@/
+@!@:hppp_}{\&{hppp} primitive@>
+primitive("vppp",internal_quantity,vppp);@/
+@!@:vppp_}{\&{vppp} primitive@>
+primitive("xoffset",internal_quantity,x_offset);@/
+@!@:x_offset_}{\&{xoffset} primitive@>
+primitive("yoffset",internal_quantity,y_offset);@/
+@!@:y_offset_}{\&{yoffset} primitive@>
+primitive("pausing",internal_quantity,pausing);@/
+@!@:pausing_}{\&{pausing} primitive@>
+primitive("showstopping",internal_quantity,showstopping);@/
+@!@:showstopping_}{\&{showstopping} primitive@>
+primitive("fontmaking",internal_quantity,fontmaking);@/
+@!@:fontmaking_}{\&{fontmaking} primitive@>
+primitive("proofing",internal_quantity,proofing);@/
+@!@:proofing_}{\&{proofing} primitive@>
+primitive("smoothing",internal_quantity,smoothing);@/
+@!@:smoothing_}{\&{smoothing} primitive@>
+primitive("autorounding",internal_quantity,autorounding);@/
+@!@:autorounding_}{\&{autorounding} primitive@>
+primitive("granularity",internal_quantity,granularity);@/
+@!@:granularity_}{\&{granularity} primitive@>
+primitive("fillin",internal_quantity,fillin);@/
+@!@:fillin_}{\&{fillin} primitive@>
+primitive("turningcheck",internal_quantity,turning_check);@/
+@!@:turning_check_}{\&{turningcheck} primitive@>
+primitive("warningcheck",internal_quantity,warning_check);@/
+@!@:warning_check_}{\&{warningcheck} primitive@>
+primitive("boundarychar",internal_quantity,boundary_char);@/
+@!@:boundary_char_}{\&{boundarychar} primitive@>
+
+@ Well, we do have to list the names one more time, for use in symbolic
+printouts.
+
+@<Initialize table...@>=
+int_name[tracing_titles]:="tracingtitles";
+int_name[tracing_equations]:="tracingequations";
+int_name[tracing_capsules]:="tracingcapsules";
+int_name[tracing_choices]:="tracingchoices";
+int_name[tracing_specs]:="tracingspecs";
+int_name[tracing_pens]:="tracingpens";
+int_name[tracing_commands]:="tracingcommands";
+int_name[tracing_restores]:="tracingrestores";
+int_name[tracing_macros]:="tracingmacros";
+int_name[tracing_edges]:="tracingedges";
+int_name[tracing_output]:="tracingoutput";
+int_name[tracing_stats]:="tracingstats";
+int_name[tracing_online]:="tracingonline";
+int_name[year]:="year";
+int_name[month]:="month";
+int_name[day]:="day";
+int_name[time]:="time";
+int_name[char_code]:="charcode";
+int_name[char_ext]:="charext";
+int_name[char_wd]:="charwd";
+int_name[char_ht]:="charht";
+int_name[char_dp]:="chardp";
+int_name[char_ic]:="charic";
+int_name[char_dx]:="chardx";
+int_name[char_dy]:="chardy";
+int_name[design_size]:="designsize";
+int_name[hppp]:="hppp";
+int_name[vppp]:="vppp";
+int_name[x_offset]:="xoffset";
+int_name[y_offset]:="yoffset";
+int_name[pausing]:="pausing";
+int_name[showstopping]:="showstopping";
+int_name[fontmaking]:="fontmaking";
+int_name[proofing]:="proofing";
+int_name[smoothing]:="smoothing";
+int_name[autorounding]:="autorounding";
+int_name[granularity]:="granularity";
+int_name[fillin]:="fillin";
+int_name[turning_check]:="turningcheck";
+int_name[warning_check]:="warningcheck";
+int_name[boundary_char]:="boundarychar";
+
+@ The following procedure, which is called just before \MF\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+Note that the values are |scaled| integers. Hence \MF\ can no longer
+be used after the year 32767.
+
+@p procedure fix_date_and_time;
+begin internal[time]:=12*60*unity; {minutes since midnight}
+internal[day]:=4*unity; {fourth day of the month}
+internal[month]:=7*unity; {seventh month of the year}
+internal[year]:=1776*unity; {Anno Domini}
+end;
+
+@ \MF\ is occasionally supposed to print diagnostic information that
+goes only into the transcript file, unless |tracing_online| is positive.
+Now that we have defined |tracing_online| we can define
+two routines that adjust the destination of print commands:
+
+@<Basic printing...@>=
+procedure begin_diagnostic; {prepare to do some tracing}
+begin old_setting:=selector;
+if(internal[tracing_online]<=0)and(selector=term_and_log) then
+ begin decr(selector);
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+@#
+procedure end_diagnostic(@!blank_line:boolean);
+ {restore proper conditions after tracing}
+begin print_nl("");
+if blank_line then print_ln;
+selector:=old_setting;
+end;
+
+@ Of course we had better declare another global variable, if the previous
+routines are going to work.
+
+@<Glob...@>=
+@!old_setting:0..max_selector;
+
+@ We will occasionally use |begin_diagnostic| in connection with line-number
+printing, as follows. (The parameter |s| is typically |"Path"| or
+|"Cycle spec"|, etc.)
+
+@<Basic printing...@>=
+procedure print_diagnostic(@!s,@!t:str_number;@!nuline:boolean);
+begin begin_diagnostic;
+if nuline then print_nl(s)@+else print(s);
+print(" at line "); print_int(line);
+print(t); print_char(":");
+end;
+
+@ The 256 |ASCII_code| characters are grouped into classes by means of
+the |char_class| table. Individual class numbers have no semantic
+or syntactic significance, except in a few instances defined here.
+There's also |max_class|, which can be used as a basis for additional
+class numbers in nonstandard extensions of \MF.
+
+@d digit_class=0 {the class number of \.{0123456789}}
+@d period_class=1 {the class number of `\..'}
+@d space_class=2 {the class number of spaces and nonstandard characters}
+@d percent_class=3 {the class number of `\.\%'}
+@d string_class=4 {the class number of `\."'}
+@d right_paren_class=8 {the class number of `\.)'}
+@d isolated_classes==5,6,7,8 {characters that make length-one tokens only}
+@d letter_class=9 {letters and the underline character}
+@d left_bracket_class=17 {`\.['}
+@d right_bracket_class=18 {`\.]'}
+@d invalid_class=20 {bad character in the input}
+@d max_class=20 {the largest class number}
+
+@<Glob...@>=
+@!char_class:array[ASCII_code] of 0..max_class; {the class numbers}
+
+@ If changes are made to accommodate non-ASCII character sets, they should
+follow the guidelines in Appendix~C of {\sl The {\logos METAFONT\/}book}.
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+@^system dependencies@>
+
+@<Set init...@>=
+for k:="0" to "9" do char_class[k]:=digit_class;
+char_class["."]:=period_class;
+char_class[" "]:=space_class;
+char_class["%"]:=percent_class;
+char_class[""""]:=string_class;@/
+char_class[","]:=5;
+char_class[";"]:=6;
+char_class["("]:=7;
+char_class[")"]:=right_paren_class;
+for k:="A" to "Z" do char_class[k]:=letter_class;
+for k:="a" to "z" do char_class[k]:=letter_class;
+char_class["_"]:=letter_class;@/
+char_class["<"]:=10;
+char_class["="]:=10;
+char_class[">"]:=10;
+char_class[":"]:=10;
+char_class["|"]:=10;@/
+char_class["`"]:=11;
+char_class["'"]:=11;@/
+char_class["+"]:=12;
+char_class["-"]:=12;@/
+char_class["/"]:=13;
+char_class["*"]:=13;
+char_class["\"]:=13;@/
+char_class["!"]:=14;
+char_class["?"]:=14;@/
+char_class["#"]:=15;
+char_class["&"]:=15;
+char_class["@@"]:=15;
+char_class["$"]:=15;@/
+char_class["^"]:=16;
+char_class["~"]:=16;@/
+char_class["["]:=left_bracket_class;
+char_class["]"]:=right_bracket_class;@/
+char_class["{"]:=19;
+char_class["}"]:=19;@/
+for k:=0 to " "-1 do char_class[k]:=invalid_class;
+for k:=127 to 255 do char_class[k]:=invalid_class;
+
+@* \[13] The hash table.
+Symbolic tokens are stored and retrieved by means of a fairly standard hash
+table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C
+in {\sl The Art of Computer Programming\/}). Once a symbolic token enters the
+table, it is never removed.
+
+The actual sequence of characters forming a symbolic token is
+stored in the |str_pool| array together with all the other strings. An
+auxiliary array |hash| consists of items with two halfword fields per
+word. The first of these, called |next(p)|, points to the next identifier
+belonging to the same coalesced list as the identifier corresponding to~|p|;
+and the other, called |text(p)|, points to the |str_start| entry for
+|p|'s identifier. If position~|p| of the hash table is empty, we have
+|text(p)=0|; if position |p| is either empty or the end of a coalesced
+hash list, we have |next(p)=0|.
+
+An auxiliary pointer variable called |hash_used| is maintained in such a
+way that all locations |p>=hash_used| are nonempty. The global variable
+|st_count| tells how many symbolic tokens have been defined, if statistics
+are being kept.
+
+The first 256 locations of |hash| are reserved for symbols of length one.
+
+There's a parallel array called |eqtb| that contains the current equivalent
+values of each symbolic token. The entries of this array consist of
+two halfwords called |eq_type| (a command code) and |equiv| (a secondary
+piece of information that qualifies the |eq_type|).
+
+@d next(#) == hash[#].lh {link for coalesced lists}
+@d text(#) == hash[#].rh {string number for symbolic token name}
+@d eq_type(#) == eqtb[#].lh {the current ``meaning'' of a symbolic token}
+@d equiv(#) == eqtb[#].rh {parametric part of a token's meaning}
+@d hash_base=257 {hashing actually starts here}
+@d hash_is_full == (hash_used=hash_base) {are all positions occupied?}
+
+@<Glob...@>=
+@!hash_used:pointer; {allocation pointer for |hash|}
+@!st_count:integer; {total number of known identifiers}
+
+@ Certain entries in the hash table are ``frozen'' and not redefinable,
+since they are used in error recovery.
+
+@d hash_top==hash_base+hash_size {the first location of the frozen area}
+@d frozen_inaccessible==hash_top {|hash| location to protect the frozen area}
+@d frozen_repeat_loop==hash_top+1 {|hash| location of a loop-repeat token}
+@d frozen_right_delimiter==hash_top+2 {|hash| location of a permanent `\.)'}
+@d frozen_left_bracket==hash_top+3 {|hash| location of a permanent `\.['}
+@d frozen_slash==hash_top+4 {|hash| location of a permanent `\./'}
+@d frozen_colon==hash_top+5 {|hash| location of a permanent `\.:'}
+@d frozen_semicolon==hash_top+6 {|hash| location of a permanent `\.;'}
+@d frozen_end_for==hash_top+7 {|hash| location of a permanent \&{endfor}}
+@d frozen_end_def==hash_top+8 {|hash| location of a permanent \&{enddef}}
+@d frozen_fi==hash_top+9 {|hash| location of a permanent \&{fi}}
+@d frozen_end_group==hash_top+10
+ {|hash| location of a permanent `\.{endgroup}'}
+@d frozen_bad_vardef==hash_top+11 {|hash| location of `\.{a bad variable}'}
+@d frozen_undefined==hash_top+12 {|hash| location that never gets defined}
+@d hash_end==hash_top+12 {the actual size of the |hash| and |eqtb| arrays}
+
+@<Glob...@>=
+@!hash: array[1..hash_end] of two_halves; {the hash table}
+@!eqtb: array[1..hash_end] of two_halves; {the equivalents}
+
+@ @<Set init...@>=
+next(1):=0; text(1):=0; eq_type(1):=tag_token; equiv(1):=null;
+for k:=2 to hash_end do
+ begin hash[k]:=hash[1]; eqtb[k]:=eqtb[1];
+ end;
+
+@ @<Initialize table entries...@>=
+hash_used:=frozen_inaccessible; {nothing is used}
+st_count:=0;@/
+text(frozen_bad_vardef):="a bad variable";
+text(frozen_fi):="fi";
+text(frozen_end_group):="endgroup";
+text(frozen_end_def):="enddef";
+text(frozen_end_for):="endfor";@/
+text(frozen_semicolon):=";";
+text(frozen_colon):=":";
+text(frozen_slash):="/";
+text(frozen_left_bracket):="[";
+text(frozen_right_delimiter):=")";@/
+text(frozen_inaccessible):=" INACCESSIBLE";@/
+eq_type(frozen_right_delimiter):=right_delimiter;
+
+@ @<Check the ``constant'' values...@>=
+if hash_end+max_internal>max_halfword then bad:=21;
+
+@ Here is the subroutine that searches the hash table for an identifier
+that matches a given string of length~|l| appearing in |buffer[j..
+(j+l-1)]|. If the identifier is not found, it is inserted; hence it
+will always be found, and the corresponding hash table address
+will be returned.
+
+@p function id_lookup(@!j,@!l:integer):pointer; {search the hash table}
+label found; {go here when you've found it}
+var @!h:integer; {hash code}
+@!p:pointer; {index in |hash| array}
+@!k:pointer; {index in |buffer| array}
+begin if l=1 then @<Treat special case of length 1 and |goto found|@>;
+@<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+ begin if text(p)>0 then if length(text(p))=l then
+ if str_eq_buf(text(p),j) then goto found;
+ if next(p)=0 then
+ @<Insert a new symbolic token after |p|, then
+ make |p| point to it and |goto found|@>;
+ p:=next(p);
+ end;
+found: id_lookup:=p;
+end;
+
+@ @<Treat special case of length 1...@>=
+begin p:=buffer[j]+1; text(p):=p-1; goto found;
+end
+
+@ @<Insert a new symbolic...@>=
+begin if text(p)>0 then
+ begin repeat if hash_is_full then
+ overflow("hash size",hash_size);
+@:METAFONT capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until text(hash_used)=0; {search for an empty location in |hash|}
+ next(p):=hash_used; p:=hash_used;
+ end;
+str_room(l);
+for k:=j to j+l-1 do append_char(buffer[k]);
+text(p):=make_string; str_ref[text(p)]:=max_str_ref;
+@!stat incr(st_count);@+tats@;@/
+goto found;
+end
+
+@ The value of |hash_prime| should be roughly 85\pct! of |hash_size|, and it
+should be a prime number. The theory of hashing tells us to expect fewer
+than two table probes, on the average, when the search is successful.
+[See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983), 231--258.]
+@^Vitter, Jeffrey Scott@>
+
+@<Compute the hash code |h|@>=
+h:=buffer[j];
+for k:=j+1 to j+l-1 do
+ begin h:=h+h+buffer[k];
+ while h>=hash_prime do h:=h-hash_prime;
+ end
+
+@ @<Search |eqtb| for equivalents equal to |p|@>=
+for q:=1 to hash_end do
+ begin if equiv(q)=p then
+ begin print_nl("EQUIV("); print_int(q); print_char(")");
+ end;
+ end
+
+@ We need to put \MF's ``primitive'' symbolic tokens into the hash
+table, together with their command code (which will be the |eq_type|)
+and an operand (which will be the |equiv|). The |primitive| procedure
+does this, in a way that no \MF\ user can. The global value |cur_sym|
+contains the new |eqtb| pointer after |primitive| has acted.
+
+@p @!init procedure primitive(@!s:str_number;@!c:halfword;@!o:halfword);
+var @!k:pool_pointer; {index into |str_pool|}
+@!j:small_number; {index into |buffer|}
+@!l:small_number; {length of the string}
+begin k:=str_start[s]; l:=str_start[s+1]-k;
+ {we will move |s| into the (empty) |buffer|}
+for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+cur_sym:=id_lookup(0,l);@/
+if s>=256 then {we don't want to have the string twice}
+ begin flush_string(str_ptr-1); text(cur_sym):=s;
+ end;
+eq_type(cur_sym):=c; equiv(cur_sym):=o;
+end;
+tini
+
+@ Many of \MF's primitives need no |equiv|, since they are identifiable
+by their |eq_type| alone. These primitives are loaded into the hash table
+as follows:
+
+@<Put each of \MF's primitives into the hash table@>=
+primitive("..",path_join,0);@/
+@!@:.._}{\.{..} primitive@>
+primitive("[",left_bracket,0); eqtb[frozen_left_bracket]:=eqtb[cur_sym];@/
+@!@:[ }{\.{[} primitive@>
+primitive("]",right_bracket,0);@/
+@!@:] }{\.{]} primitive@>
+primitive("}",right_brace,0);@/
+@!@:]]}{\.{\char`\}} primitive@>
+primitive("{",left_brace,0);@/
+@!@:][}{\.{\char`\{} primitive@>
+primitive(":",colon,0); eqtb[frozen_colon]:=eqtb[cur_sym];@/
+@!@:: }{\.{:} primitive@>
+primitive("::",double_colon,0);@/
+@!@::: }{\.{::} primitive@>
+primitive("||:",bchar_label,0);@/
+@!@:::: }{\.{\char'174\char'174:} primitive@>
+primitive(":=",assignment,0);@/
+@!@::=_}{\.{:=} primitive@>
+primitive(",",comma,0);@/
+@!@:, }{\., primitive@>
+primitive(";",semicolon,0); eqtb[frozen_semicolon]:=eqtb[cur_sym];@/
+@!@:; }{\.; primitive@>
+primitive("\",relax,0);@/
+@!@:]]\\}{\.{\char`\\} primitive@>
+@#
+primitive("addto",add_to_command,0);@/
+@!@:add_to_}{\&{addto} primitive@>
+primitive("at",at_token,0);@/
+@!@:at_}{\&{at} primitive@>
+primitive("atleast",at_least,0);@/
+@!@:at_least_}{\&{atleast} primitive@>
+primitive("begingroup",begin_group,0); bg_loc:=cur_sym;@/
+@!@:begin_group_}{\&{begingroup} primitive@>
+primitive("controls",controls,0);@/
+@!@:controls_}{\&{controls} primitive@>
+primitive("cull",cull_command,0);@/
+@!@:cull_}{\&{cull} primitive@>
+primitive("curl",curl_command,0);@/
+@!@:curl_}{\&{curl} primitive@>
+primitive("delimiters",delimiters,0);@/
+@!@:delimiters_}{\&{delimiters} primitive@>
+primitive("display",display_command,0);@/
+@!@:display_}{\&{display} primitive@>
+primitive("endgroup",end_group,0);
+ eqtb[frozen_end_group]:=eqtb[cur_sym]; eg_loc:=cur_sym;@/
+@!@:endgroup_}{\&{endgroup} primitive@>
+primitive("everyjob",every_job_command,0);@/
+@!@:every_job_}{\&{everyjob} primitive@>
+primitive("exitif",exit_test,0);@/
+@!@:exit_if_}{\&{exitif} primitive@>
+primitive("expandafter",expand_after,0);@/
+@!@:expand_after_}{\&{expandafter} primitive@>
+primitive("from",from_token,0);@/
+@!@:from_}{\&{from} primitive@>
+primitive("inwindow",in_window,0);@/
+@!@:in_window_}{\&{inwindow} primitive@>
+primitive("interim",interim_command,0);@/
+@!@:interim_}{\&{interim} primitive@>
+primitive("let",let_command,0);@/
+@!@:let_}{\&{let} primitive@>
+primitive("newinternal",new_internal,0);@/
+@!@:new_internal_}{\&{newinternal} primitive@>
+primitive("of",of_token,0);@/
+@!@:of_}{\&{of} primitive@>
+primitive("openwindow",open_window,0);@/
+@!@:open_window_}{\&{openwindow} primitive@>
+primitive("randomseed",random_seed,0);@/
+@!@:random_seed_}{\&{randomseed} primitive@>
+primitive("save",save_command,0);@/
+@!@:save_}{\&{save} primitive@>
+primitive("scantokens",scan_tokens,0);@/
+@!@:scan_tokens_}{\&{scantokens} primitive@>
+primitive("shipout",ship_out_command,0);@/
+@!@:ship_out_}{\&{shipout} primitive@>
+primitive("skipto",skip_to,0);@/
+@!@:skip_to_}{\&{skipto} primitive@>
+primitive("step",step_token,0);@/
+@!@:step_}{\&{step} primitive@>
+primitive("str",str_op,0);@/
+@!@:str_}{\&{str} primitive@>
+primitive("tension",tension,0);@/
+@!@:tension_}{\&{tension} primitive@>
+primitive("to",to_token,0);@/
+@!@:to_}{\&{to} primitive@>
+primitive("until",until_token,0);@/
+@!@:until_}{\&{until} primitive@>
+
+@ Each primitive has a corresponding inverse, so that it is possible to
+display the cryptic numeric contents of |eqtb| in symbolic form.
+Every call of |primitive| in this program is therefore accompanied by some
+straightforward code that forms part of the |print_cmd_mod| routine
+explained below.
+
+@<Cases of |print_cmd_mod| for symbolic printing of primitives@>=
+add_to_command:print("addto");
+assignment:print(":=");
+at_least:print("atleast");
+at_token:print("at");
+bchar_label:print("||:");
+begin_group:print("begingroup");
+colon:print(":");
+comma:print(",");
+controls:print("controls");
+cull_command:print("cull");
+curl_command:print("curl");
+delimiters:print("delimiters");
+display_command:print("display");
+double_colon:print("::");
+end_group:print("endgroup");
+every_job_command:print("everyjob");
+exit_test:print("exitif");
+expand_after:print("expandafter");
+from_token:print("from");
+in_window:print("inwindow");
+interim_command:print("interim");
+left_brace:print("{");
+left_bracket:print("[");
+let_command:print("let");
+new_internal:print("newinternal");
+of_token:print("of");
+open_window:print("openwindow");
+path_join:print("..");
+random_seed:print("randomseed");
+relax:print_char("\");
+right_brace:print("}");
+right_bracket:print("]");
+save_command:print("save");
+scan_tokens:print("scantokens");
+semicolon:print(";");
+ship_out_command:print("shipout");
+skip_to:print("skipto");
+step_token:print("step");
+str_op:print("str");
+tension:print("tension");
+to_token:print("to");
+until_token:print("until");
+
+@ We will deal with the other primitives later, at some point in the program
+where their |eq_type| and |equiv| values are more meaningful. For example,
+the primitives for macro definitions will be loaded when we consider the
+routines that define macros.
+It is easy to find where each particular
+primitive was treated by looking in the index at the end; for example, the
+section where |"def"| entered |eqtb| is listed under `\&{def} primitive'.
+
+@* \[14] Token lists.
+A \MF\ token is either symbolic or numeric or a string, or it denotes
+a macro parameter or capsule; so there are five corresponding ways to encode it
+@^token@>
+internally: (1)~A symbolic token whose hash code is~|p|
+is represented by the number |p|, in the |info| field of a single-word
+node in~|mem|. (2)~A numeric token whose |scaled| value is~|v| is
+represented in a two-word node of~|mem|; the |type| field is |known|,
+the |name_type| field is |token|, and the |value| field holds~|v|.
+The fact that this token appears in a two-word node rather than a
+one-word node is, of course, clear from the node address.
+(3)~A string token is also represented in a two-word node; the |type|
+field is |string_type|, the |name_type| field is |token|, and the
+|value| field holds the corresponding |str_number|. (4)~Capsules have
+|name_type=capsule|, and their |type| and |value| fields represent
+arbitrary values (in ways to be explained later). (5)~Macro parameters
+are like symbolic tokens in that they appear in |info| fields of
+one-word nodes. The $k$th parameter is represented by |expr_base+k| if it
+is of type \&{expr}, or by |suffix_base+k| if it is of type \&{suffix}, or
+by |text_base+k| if it is of type \&{text}. (Here |0<=k<param_size|.)
+Actual values of these parameters are kept in a separate stack, as we will
+see later. The constants |expr_base|, |suffix_base|, and |text_base| are,
+of course, chosen so that there will be no confusion between symbolic
+tokens and parameters of various types.
+
+It turns out that |value(null)=0|, because |null=null_coords|;
+we will make use of this coincidence later.
+
+Incidentally, while we're speaking of coincidences, we might note that
+the `\\{type}' field of a node has nothing to do with ``type'' in a
+printer's sense. It's curious that the same word is used in such different ways.
+
+@d type(#) == mem[#].hh.b0 {identifies what kind of value this is}
+@d name_type(#) == mem[#].hh.b1 {a clue to the name of this value}
+@d token_node_size=2 {the number of words in a large token node}
+@d value_loc(#)==#+1 {the word that contains the |value| field}
+@d value(#)==mem[value_loc(#)].int {the value stored in a large token node}
+@d expr_base==hash_end+1 {code for the zeroth \&{expr} parameter}
+@d suffix_base==expr_base+param_size {code for the zeroth \&{suffix} parameter}
+@d text_base==suffix_base+param_size {code for the zeroth \&{text} parameter}
+
+@<Check the ``constant''...@>=
+if text_base+param_size>max_halfword then bad:=22;
+
+@ A numeric token is created by the following trivial routine.
+
+@p function new_num_tok(@!v:scaled):pointer;
+var @!p:pointer; {the new node}
+begin p:=get_node(token_node_size); value(p):=v;
+type(p):=known; name_type(p):=token; new_num_tok:=p;
+end;
+
+@ A token list is a singly linked list of nodes in |mem|, where
+each node contains a token and a link. Here's a subroutine that gets rid
+of a token list when it is no longer needed.
+
+@p procedure@?token_recycle; forward;@t\2@>@;@/
+procedure flush_token_list(@!p:pointer);
+var @!q:pointer; {the node being recycled}
+begin while p<>null do
+ begin q:=p; p:=link(p);
+ if q>=hi_mem_min then free_avail(q)
+ else begin case type(q) of
+ vacuous,boolean_type,known:do_nothing;
+ string_type:delete_str_ref(value(q));
+ unknown_types,pen_type,path_type,future_pen,picture_type,
+ pair_type,transform_type,dependent,proto_dependent,independent:
+ begin g_pointer:=q; token_recycle;
+ end;
+ othercases confusion("token")
+@:this can't happen token}{\quad token@>
+ endcases;@/
+ free_node(q,token_node_size);
+ end;
+ end;
+end;
+
+@ The procedure |show_token_list|, which prints a symbolic form of
+the token list that starts at a given node |p|, illustrates these
+conventions. The token list being displayed should not begin with a reference
+count. However, the procedure is intended to be fairly robust, so that if the
+memory links are awry or if |p| is not really a pointer to a token list,
+almost nothing catastrophic can happen.
+
+An additional parameter |q| is also given; this parameter is either null
+or it points to a node in the token list where a certain magic computation
+takes place that will be explained later. (Basically, |q| is non-null when
+we are printing the two-line context information at the time of an error
+message; |q| marks the place corresponding to where the second line
+should begin.)
+
+The generation will stop, and `\.{\char`\ ETC.}' will be printed, if the length
+of printing exceeds a given limit~|l|; the length of printing upon entry is
+assumed to be a given amount called |null_tally|. (Note that
+|show_token_list| sometimes uses itself recursively to print
+variable names within a capsule.)
+@^recursion@>
+
+Unusual entries are printed in the form of all-caps tokens
+preceded by a space, e.g., `\.{\char`\ BAD}'.
+
+@<Declare the procedure called |show_token_list|@>=
+procedure@?print_capsule; forward; @t\2@>@;@/
+procedure show_token_list(@!p,@!q:integer;@!l,@!null_tally:integer);
+label exit;
+var @!class,@!c:small_number; {the |char_class| of previous and new tokens}
+@!r,@!v:integer; {temporary registers}
+begin class:=percent_class;
+tally:=null_tally;
+while (p<>null) and (tally<l) do
+ begin if p=q then @<Do magic computation@>;
+ @<Display token |p| and set |c| to its class;
+ but |return| if there are problems@>;
+ class:=c; p:=link(p);
+ end;
+if p<>null then print(" ETC.");
+@.ETC@>
+exit:
+end;
+
+@ @<Display token |p| and set |c| to its class...@>=
+c:=letter_class; {the default}
+if (p<mem_min)or(p>mem_end) then
+ begin print(" CLOBBERED"); return;
+@.CLOBBERED@>
+ end;
+if p<hi_mem_min then @<Display two-word token@>
+else begin r:=info(p);
+ if r>=expr_base then @<Display a parameter token@>
+ else if r<1 then
+ if r=0 then @<Display a collective subscript@>
+ else print(" IMPOSSIBLE")
+@.IMPOSSIBLE@>
+ else begin r:=text(r);
+ if (r<0)or(r>=str_ptr) then print(" NONEXISTENT")
+@.NONEXISTENT@>
+ else @<Print string |r| as a symbolic token
+ and set |c| to its class@>;
+ end;
+ end
+
+@ @<Display two-word token@>=
+if name_type(p)=token then
+ if type(p)=known then @<Display a numeric token@>
+ else if type(p)<>string_type then print(" BAD")
+@.BAD@>
+ else begin print_char(""""); slow_print(value(p)); print_char("""");
+ c:=string_class;
+ end
+else if (name_type(p)<>capsule)or(type(p)<vacuous)or(type(p)>independent) then
+ print(" BAD")
+else begin g_pointer:=p; print_capsule; c:=right_paren_class;
+ end
+
+@ @<Display a numeric token@>=
+begin if class=digit_class then print_char(" ");
+v:=value(p);
+if v<0 then
+ begin if class=left_bracket_class then print_char(" ");
+ print_char("["); print_scaled(v); print_char("]");
+ c:=right_bracket_class;
+ end
+else begin print_scaled(v); c:=digit_class;
+ end;
+end
+
+@ Strictly speaking, a genuine token will never have |info(p)=0|.
+But we will see later (in the |print_variable_name| routine) that
+it is convenient to let |info(p)=0| stand for `\.{[]}'.
+
+@<Display a collective subscript@>=
+begin if class=left_bracket_class then print_char(" ");
+print("[]"); c:=right_bracket_class;
+end
+
+@ @<Display a parameter token@>=
+begin if r<suffix_base then
+ begin print("(EXPR"); r:=r-(expr_base);
+@.EXPR@>
+ end
+else if r<text_base then
+ begin print("(SUFFIX"); r:=r-(suffix_base);
+@.SUFFIX@>
+ end
+else begin print("(TEXT"); r:=r-(text_base);
+@.TEXT@>
+ end;
+print_int(r); print_char(")"); c:=right_paren_class;
+end
+
+@ @<Print string |r| as a symbolic token...@>=
+begin c:=char_class[so(str_pool[str_start[r]])];
+if c=class then
+ case c of
+ letter_class:print_char(".");
+ isolated_classes:do_nothing;
+ othercases print_char(" ")
+ endcases;
+slow_print(r);
+end
+
+@ The following procedures have been declared |forward| with no parameters,
+because the author dislikes \PASCAL's convention about |forward| procedures
+with parameters. It was necessary to do something, because |show_token_list|
+is recursive (although the recursion is limited to one level), and because
+|flush_token_list| is syntactically (but not semantically) recursive.
+@^recursion@>
+
+@<Declare miscellaneous procedures that were declared |forward|@>=
+procedure print_capsule;
+begin print_char("("); print_exp(g_pointer,0); print_char(")");
+end;
+@#
+procedure token_recycle;
+begin recycle_value(g_pointer);
+end;
+
+@ @<Glob...@>=
+@!g_pointer:pointer; {(global) parameter to the |forward| procedures}
+
+@ Macro definitions are kept in \MF's memory in the form of token lists
+that have a few extra one-word nodes at the beginning.
+
+The first node contains a reference count that is used to tell when the
+list is no longer needed. To emphasize the fact that a reference count is
+present, we shall refer to the |info| field of this special node as the
+|ref_count| field.
+@^reference counts@>
+
+The next node or nodes after the reference count serve to describe the
+formal parameters. They either contain a code word that specifies all
+of the parameters, or they contain zero or more parameter tokens followed
+by the code `|general_macro|'.
+
+@d ref_count==info {reference count preceding a macro definition or pen header}
+@d add_mac_ref(#)==incr(ref_count(#)) {make a new reference to a macro list}
+@d general_macro=0 {preface to a macro defined with a parameter list}
+@d primary_macro=1 {preface to a macro with a \&{primary} parameter}
+@d secondary_macro=2 {preface to a macro with a \&{secondary} parameter}
+@d tertiary_macro=3 {preface to a macro with a \&{tertiary} parameter}
+@d expr_macro=4 {preface to a macro with an undelimited \&{expr} parameter}
+@d of_macro=5 {preface to a macro with
+ undelimited `\&{expr} |x| \&{of}~|y|' parameters}
+@d suffix_macro=6 {preface to a macro with an undelimited \&{suffix} parameter}
+@d text_macro=7 {preface to a macro with an undelimited \&{text} parameter}
+
+@p procedure delete_mac_ref(@!p:pointer);
+ {|p| points to the reference count of a macro list that is
+ losing one reference}
+begin if ref_count(p)=null then flush_token_list(p)
+else decr(ref_count(p));
+end;
+
+@ The following subroutine displays a macro, given a pointer to its
+reference count.
+
+@p @t\4@>@<Declare the procedure called |print_cmd_mod|@>@;
+procedure show_macro(@!p:pointer;@!q,@!l:integer);
+label exit;
+var @!r:pointer; {temporary storage}
+begin p:=link(p); {bypass the reference count}
+while info(p)>text_macro do
+ begin r:=link(p); link(p):=null;
+ show_token_list(p,null,l,0); link(p):=r; p:=r;
+ if l>0 then l:=l-tally@+else return;
+ end; {control printing of `\.{ETC.}'}
+@.ETC@>
+tally:=0;
+case info(p) of
+general_macro:print("->");
+@.->@>
+primary_macro,secondary_macro,tertiary_macro:begin print_char("<");
+ print_cmd_mod(param_type,info(p)); print(">->");
+ end;
+expr_macro:print("<expr>->");
+of_macro:print("<expr>of<primary>->");
+suffix_macro:print("<suffix>->");
+text_macro:print("<text>->");
+end; {there are no other cases}
+show_token_list(link(p),q,l-tally,0);
+exit:end;
+
+@* \[15] Data structures for variables.
+The variables of \MF\ programs can be simple, like `\.x', or they can
+combine the structural properties of arrays and records, like `\.{x20a.b}'.
+A \MF\ user assigns a type to a variable like \.{x20a.b} by saying, for
+example, `\.{boolean} \.{x20a.b}'. It's time for us to study how such
+things are represented inside of the computer.
+
+Each variable value occupies two consecutive words, either in a two-word
+node called a value node, or as a two-word subfield of a larger node. One
+of those two words is called the |value| field; it is an integer,
+containing either a |scaled| numeric value or the representation of some
+other type of quantity. (It might also be subdivided into halfwords, in
+which case it is referred to by other names instead of |value|.) The other
+word is broken into subfields called |type|, |name_type|, and |link|. The
+|type| field is a quarterword that specifies the variable's type, and
+|name_type| is a quarterword from which \MF\ can reconstruct the
+variable's name (sometimes by using the |link| field as well). Thus, only
+1.25 words are actually devoted to the value itself; the other
+three-quarters of a word are overhead, but they aren't wasted because they
+allow \MF\ to deal with sparse arrays and to provide meaningful diagnostics.
+
+In this section we shall be concerned only with the structural aspects of
+variables, not their values. Later parts of the program will change the
+|type| and |value| fields, but we shall treat those fields as black boxes
+whose contents should not be touched.
+
+However, if the |type| field is |structured|, there is no |value| field,
+and the second word is broken into two pointer fields called |attr_head|
+and |subscr_head|. Those fields point to additional nodes that
+contain structural information, as we shall see.
+
+@d subscr_head_loc(#) == #+1 {where |value|, |subscr_head|, and |attr_head| are}
+@d attr_head(#) == info(subscr_head_loc(#)) {pointer to attribute info}
+@d subscr_head(#) == link(subscr_head_loc(#)) {pointer to subscript info}
+@d value_node_size=2 {the number of words in a value node}
+
+@ An attribute node is three words long. Two of these words contain |type|
+and |value| fields as described above, and the third word contains
+additional information: There is an |attr_loc| field, which contains the
+hash address of the token that names this attribute; and there's also a
+|parent| field, which points to the value node of |structured| type at the
+next higher level (i.e., at the level to which this attribute is
+subsidiary). The |name_type| in an attribute node is `|attr|'. The
+|link| field points to the next attribute with the same parent; these are
+arranged in increasing order, so that |attr_loc(link(p))>attr_loc(p)|. The
+final attribute node links to the constant |end_attr|, whose |attr_loc|
+field is greater than any legal hash address. The |attr_head| in the
+parent points to a node whose |name_type| is |structured_root|; this
+node represents the null attribute, i.e., the variable that is relevant
+when no attributes are attached to the parent. The |attr_head| node is either
+a value node, a subscript node, or an attribute node, depending on what
+the parent would be if it were not structured; but the subscript and
+attribute fields are ignored, so it effectively contains only the data of
+a value node. The |link| field in this special node points to an attribute
+node whose |attr_loc| field is zero; the latter node represents a collective
+subscript `\.{[]}' attached to the parent, and its |link| field points to
+the first non-special attribute node (or to |end_attr| if there are none).
+
+A subscript node likewise occupies three words, with |type| and |value| fields
+plus extra information; its |name_type| is |subscr|. In this case the
+third word is called the |subscript| field, which is a |scaled| integer.
+The |link| field points to the subscript node with the next larger
+subscript, if any; otherwise the |link| points to the attribute node
+for collective subscripts at this level. We have seen that the latter node
+contains an upward pointer, so that the parent can be deduced.
+
+The |name_type| in a parent-less value node is |root|, and the |link|
+is the hash address of the token that names this value.
+
+In other words, variables have a hierarchical structure that includes
+enough threads running around so that the program is able to move easily
+between siblings, parents, and children. An example should be helpful:
+(The reader is advised to draw a picture while reading the following
+description, since that will help to firm up the ideas.)
+Suppose that `\.x' and `\.{x.a}' and `\.{x[]b}' and `\.{x5}'
+and `\.{x20b}' have been mentioned in a user's program, where
+\.{x[]b} has been declared to be of \&{boolean} type. Let |h(x)|, |h(a)|,
+and |h(b)| be the hash addresses of \.x, \.a, and~\.b. Then
+|eq_type(h(x))=tag_token| and |equiv(h(x))=p|, where |p|~is a two-word value
+node with |name_type(p)=root| and |link(p)=h(x)|. We have |type(p)=structured|,
+|attr_head(p)=q|, and |subscr_head(p)=r|, where |q| points to a value
+node and |r| to a subscript node. (Are you still following this? Use
+a pencil to draw a diagram.) The lone variable `\.x' is represented by
+|type(q)| and |value(q)|; furthermore
+|name_type(q)=structured_root| and |link(q)=q1|, where |q1| points
+to an attribute node representing `\.{x[]}'. Thus |name_type(q1)=attr|,
+|attr_loc(q1)=collective_subscript=0|, |parent(q1)=p|,
+|type(q1)=structured|, |attr_head(q1)=qq|, and |subscr_head(q1)=qq1|;
+|qq| is a value node with |type(qq)=numeric_type| (assuming that \.{x5} is
+numeric, because |qq| represents `\.{x[]}' with no further attributes),
+|name_type(qq)=structured_root|, and
+|link(qq)=qq1|. (Now pay attention to the next part.) Node |qq1| is
+an attribute node representing `\.{x[][]}', which has never yet
+occurred; its |type| field is |undefined|, and its |value| field is
+undefined. We have |name_type(qq1)=attr|, |attr_loc(qq1)=collective_subscript|,
+|parent(qq1)=q1|, and |link(qq1)=qq2|. Since |qq2| represents
+`\.{x[]b}', |type(qq2)=unknown_boolean|; also |attr_loc(qq2)=h(b)|,
+|parent(qq2)=q1|, |name_type(qq2)=attr|, |link(qq2)=end_attr|.
+(Maybe colored lines will help untangle your picture.)
+ Node |r| is a subscript node with |type| and |value|
+representing `\.{x5}'; |name_type(r)=subscr|, |subscript(r)=5.0|,
+and |link(r)=r1| is another subscript node. To complete the picture,
+see if you can guess what |link(r1)| is; give up? It's~|q1|.
+Furthermore |subscript(r1)=20.0|, |name_type(r1)=subscr|,
+|type(r1)=structured|, |attr_head(r1)=qqq|, |subscr_head(r1)=qqq1|,
+and we finish things off with three more nodes
+|qqq|, |qqq1|, and |qqq2| hung onto~|r1|. (Perhaps you should start again
+with a larger sheet of paper.) The value of variable \.{x20b}
+appears in node~|qqq2|, as you can well imagine.
+
+If the example in the previous paragraph doesn't make things crystal
+clear, a glance at some of the simpler subroutines below will reveal how
+things work out in practice.
+
+The only really unusual thing about these conventions is the use of
+collective subscript attributes. The idea is to avoid repeating a lot of
+type information when many elements of an array are identical macros
+(for which distinct values need not be stored) or when they don't have
+all of the possible attributes. Branches of the structure below collective
+subscript attributes do not carry actual values except for macro identifiers;
+branches of the structure below subscript nodes do not carry significant
+information in their collective subscript attributes.
+
+@d attr_loc_loc(#)==#+2 {where the |attr_loc| and |parent| fields are}
+@d attr_loc(#)==info(attr_loc_loc(#)) {hash address of this attribute}
+@d parent(#)==link(attr_loc_loc(#)) {pointer to |structured| variable}
+@d subscript_loc(#)==#+2 {where the |subscript| field lives}
+@d subscript(#)==mem[subscript_loc(#)].sc {subscript of this variable}
+@d attr_node_size=3 {the number of words in an attribute node}
+@d subscr_node_size=3 {the number of words in a subscript node}
+@d collective_subscript=0 {code for the attribute `\.{[]}'}
+
+@<Initialize table...@>=
+attr_loc(end_attr):=hash_end+1; parent(end_attr):=null;
+
+@ Variables of type \&{pair} will have values that point to four-word
+nodes containing two numeric values. The first of these values has
+|name_type=x_part_sector| and the second has |name_type=y_part_sector|;
+the |link| in the first points back to the node whose |value| points
+to this four-word node.
+
+Variables of type \&{transform} are similar, but in this case their
+|value| points to a 12-word node containing six values, identified by
+|x_part_sector|, |y_part_sector|, |xx_part_sector|, |xy_part_sector|,
+|yx_part_sector|, and |yy_part_sector|.
+
+When an entire structured variable is saved, the |root| indication
+is temporarily replaced by |saved_root|.
+
+Some variables have no name; they just are used for temporary storage
+while expressions are being evaluated. We call them {\sl capsules}.
+
+@d x_part_loc(#)==# {where the \&{xpart} is found in a pair or transform node}
+@d y_part_loc(#)==#+2 {where the \&{ypart} is found in a pair or transform node}
+@d xx_part_loc(#)==#+4 {where the \&{xxpart} is found in a transform node}
+@d xy_part_loc(#)==#+6 {where the \&{xypart} is found in a transform node}
+@d yx_part_loc(#)==#+8 {where the \&{yxpart} is found in a transform node}
+@d yy_part_loc(#)==#+10 {where the \&{yypart} is found in a transform node}
+@#
+@d pair_node_size=4 {the number of words in a pair node}
+@d transform_node_size=12 {the number of words in a transform node}
+
+@<Glob...@>=
+@!big_node_size:array[transform_type..pair_type] of small_number;
+
+@ The |big_node_size| array simply contains two constants that \MF\
+occasionally needs to know.
+
+@<Set init...@>=
+big_node_size[transform_type]:=transform_node_size;
+big_node_size[pair_type]:=pair_node_size;
+
+@ If |type(p)=pair_type| or |transform_type| and if |value(p)=null|, the
+procedure call |init_big_node(p)| will allocate a pair or transform node
+for~|p|. The individual parts of such nodes are initially of type
+|independent|.
+
+@p procedure init_big_node(@!p:pointer);
+var @!q:pointer; {the new node}
+@!s:small_number; {its size}
+begin s:=big_node_size[type(p)]; q:=get_node(s);
+repeat s:=s-2; @<Make variable |q+s| newly independent@>;
+name_type(q+s):=half(s)+x_part_sector; link(q+s):=null;
+until s=0;
+link(q):=p; value(p):=q;
+end;
+
+@ The |id_transform| function creates a capsule for the
+identity transformation.
+
+@p function id_transform:pointer;
+var @!p,@!q,@!r:pointer; {list manipulation registers}
+begin p:=get_node(value_node_size); type(p):=transform_type;
+name_type(p):=capsule; value(p):=null; init_big_node(p); q:=value(p);
+r:=q+transform_node_size;
+repeat r:=r-2;
+type(r):=known; value(r):=0;
+until r=q;
+value(xx_part_loc(q)):=unity; value(yy_part_loc(q)):=unity;
+id_transform:=p;
+end;
+
+@ Tokens are of type |tag_token| when they first appear, but they point
+to |null| until they are first used as the root of a variable.
+The following subroutine establishes the root node on such grand occasions.
+
+@p procedure new_root(@!x:pointer);
+var @!p:pointer; {the new node}
+begin p:=get_node(value_node_size); type(p):=undefined; name_type(p):=root;
+link(p):=x; equiv(x):=p;
+end;
+
+@ These conventions for variable representation are illustrated by the
+|print_variable_name| routine, which displays the full name of a
+variable given only a pointer to its two-word value packet.
+
+@p procedure print_variable_name(@!p:pointer);
+label found,exit;
+var @!q:pointer; {a token list that will name the variable's suffix}
+@!r:pointer; {temporary for token list creation}
+begin while name_type(p)>=x_part_sector do
+ @<Preface the output with a part specifier; |return| in the
+ case of a capsule@>;
+q:=null;
+while name_type(p)>saved_root do
+ @<Ascend one level, pushing a token onto list |q|
+ and replacing |p| by its parent@>;
+r:=get_avail; info(r):=link(p); link(r):=q;
+if name_type(p)=saved_root then print("(SAVED)");
+@.SAVED@>
+show_token_list(r,null,el_gordo,tally); flush_token_list(r);
+exit:end;
+
+@ @<Ascend one level, pushing a token onto list |q|...@>=
+begin if name_type(p)=subscr then
+ begin r:=new_num_tok(subscript(p));
+ repeat p:=link(p);
+ until name_type(p)=attr;
+ end
+else if name_type(p)=structured_root then
+ begin p:=link(p); goto found;
+ end
+else begin if name_type(p)<>attr then confusion("var");
+@:this can't happen var}{\quad var@>
+ r:=get_avail; info(r):=attr_loc(p);
+ end;
+link(r):=q; q:=r;
+found: p:=parent(p);
+end
+
+@ @<Preface the output with a part specifier...@>=
+begin case name_type(p) of
+x_part_sector: print_char("x");
+y_part_sector: print_char("y");
+xx_part_sector: print("xx");
+xy_part_sector: print("xy");
+yx_part_sector: print("yx");
+yy_part_sector: print("yy");
+capsule: begin print("%CAPSULE"); print_int(p-null); return;
+@.CAPSULE@>
+ end;
+end; {there are no other cases}
+print("part "); p:=link(p-2*(name_type(p)-x_part_sector));
+end
+
+@ The |interesting| function returns |true| if a given variable is not
+in a capsule, or if the user wants to trace capsules.
+
+@p function interesting(@!p:pointer):boolean;
+var @!t:small_number; {a |name_type|}
+begin if internal[tracing_capsules]>0 then interesting:=true
+else begin t:=name_type(p);
+ if t>=x_part_sector then if t<>capsule then
+ t:=name_type(link(p-2*(t-x_part_sector)));
+ interesting:=(t<>capsule);
+ end;
+end;
+
+@ Now here is a subroutine that converts an unstructured type into an
+equivalent structured type, by inserting a |structured| node that is
+capable of growing. This operation is done only when |name_type(p)=root|,
+|subscr|, or |attr|.
+
+The procedure returns a pointer to the new node that has taken node~|p|'s
+place in the structure. Node~|p| itself does not move, nor are its
+|value| or |type| fields changed in any way.
+
+@p function new_structure(@!p:pointer):pointer;
+var @!q,@!r:pointer; {list manipulation registers}
+begin case name_type(p) of
+root: begin q:=link(p); r:=get_node(value_node_size); equiv(q):=r;
+ end;
+subscr: @<Link a new subscript node |r| in place of node |p|@>;
+attr: @<Link a new attribute node |r| in place of node |p|@>;
+othercases confusion("struct")
+@:this can't happen struct}{\quad struct@>
+endcases;@/
+link(r):=link(p); type(r):=structured; name_type(r):=name_type(p);
+attr_head(r):=p; name_type(p):=structured_root;@/
+q:=get_node(attr_node_size); link(p):=q; subscr_head(r):=q;
+parent(q):=r; type(q):=undefined; name_type(q):=attr; link(q):=end_attr;
+attr_loc(q):=collective_subscript; new_structure:=r;
+end;
+
+@ @<Link a new subscript node |r| in place of node |p|@>=
+begin q:=p;
+repeat q:=link(q);
+until name_type(q)=attr;
+q:=parent(q); r:=subscr_head_loc(q); {|link(r)=subscr_head(q)|}
+repeat q:=r; r:=link(r);
+until r=p;
+r:=get_node(subscr_node_size);
+link(q):=r; subscript(r):=subscript(p);
+end
+
+@ If the attribute is |collective_subscript|, there are two pointers to
+node~|p|, so we must change both of them.
+
+@<Link a new attribute node |r| in place of node |p|@>=
+begin q:=parent(p); r:=attr_head(q);
+repeat q:=r; r:=link(r);
+until r=p;
+r:=get_node(attr_node_size); link(q):=r;@/
+mem[attr_loc_loc(r)]:=mem[attr_loc_loc(p)]; {copy |attr_loc| and |parent|}
+if attr_loc(p)=collective_subscript then
+ begin q:=subscr_head_loc(parent(p));
+ while link(q)<>p do q:=link(q);
+ link(q):=r;
+ end;
+end
+
+@ The |find_variable| routine is given a pointer~|t| to a nonempty token
+list of suffixes; it returns a pointer to the corresponding two-word
+value. For example, if |t| points to token \.x followed by a numeric
+token containing the value~7, |find_variable| finds where the value of
+\.{x7} is stored in memory. This may seem a simple task, and it
+usually is, except when \.{x7} has never been referenced before.
+Indeed, \.x may never have even been subscripted before; complexities
+arise with respect to updating the collective subscript information.
+
+If a macro type is detected anywhere along path~|t|, or if the first
+item on |t| isn't a |tag_token|, the value |null| is returned.
+Otherwise |p| will be a non-null pointer to a node such that
+|undefined<type(p)<structured|.
+
+@d abort_find==begin find_variable:=null; return;@+end
+
+@p function find_variable(@!t:pointer):pointer;
+label exit;
+var @!p,@!q,@!r,@!s:pointer; {nodes in the ``value'' line}
+@!pp,@!qq,@!rr,@!ss:pointer; {nodes in the ``collective'' line}
+@!n:integer; {subscript or attribute}
+@!save_word:memory_word; {temporary storage for a word of |mem|}
+@^inner loop@>
+begin p:=info(t); t:=link(t);
+if eq_type(p) mod outer_tag<>tag_token then abort_find;
+if equiv(p)=null then new_root(p);
+p:=equiv(p); pp:=p;
+while t<>null do
+ begin @<Make sure that both nodes |p| and |pp| are of |structured| type@>;
+ if t<hi_mem_min then
+ @<Descend one level for the subscript |value(t)|@>
+ else @<Descend one level for the attribute |info(t)|@>;
+ t:=link(t);
+ end;
+if type(pp)>=structured then
+ if type(pp)=structured then pp:=attr_head(pp)@+else abort_find;
+if type(p)=structured then p:=attr_head(p);
+if type(p)=undefined then
+ begin if type(pp)=undefined then
+ begin type(pp):=numeric_type; value(pp):=null;
+ end;
+ type(p):=type(pp); value(p):=null;
+ end;
+find_variable:=p;
+exit:end;
+
+@ Although |pp| and |p| begin together, they diverge when a subscript occurs;
+|pp|~stays in the collective line while |p|~goes through actual subscript
+values.
+
+@<Make sure that both nodes |p| and |pp|...@>=
+if type(pp)<>structured then
+ begin if type(pp)>structured then abort_find;
+ ss:=new_structure(pp);
+ if p=pp then p:=ss;
+ pp:=ss;
+ end; {now |type(pp)=structured|}
+if type(p)<>structured then {it cannot be |>structured|}
+ p:=new_structure(p) {now |type(p)=structured|}
+
+@ We want this part of the program to be reasonably fast, in case there are
+@^inner loop@>
+lots of subscripts at the same level of the data structure. Therefore
+we store an ``infinite'' value in the word that appears at the end of the
+subscript list, even though that word isn't part of a subscript node.
+
+@<Descend one level for the subscript |value(t)|@>=
+begin n:=value(t);
+pp:=link(attr_head(pp)); {now |attr_loc(pp)=collective_subscript|}
+q:=link(attr_head(p)); save_word:=mem[subscript_loc(q)];
+subscript(q):=el_gordo; s:=subscr_head_loc(p); {|link(s)=subscr_head(p)|}
+repeat r:=s; s:=link(s);
+until n<=subscript(s);
+if n=subscript(s) then p:=s
+else begin p:=get_node(subscr_node_size); link(r):=p; link(p):=s;
+ subscript(p):=n; name_type(p):=subscr; type(p):=undefined;
+ end;
+mem[subscript_loc(q)]:=save_word;
+end
+
+@ @<Descend one level for the attribute |info(t)|@>=
+begin n:=info(t);
+ss:=attr_head(pp);
+repeat rr:=ss; ss:=link(ss);
+until n<=attr_loc(ss);
+if n<attr_loc(ss) then
+ begin qq:=get_node(attr_node_size); link(rr):=qq; link(qq):=ss;
+ attr_loc(qq):=n; name_type(qq):=attr; type(qq):=undefined;
+ parent(qq):=pp; ss:=qq;
+ end;
+if p=pp then
+ begin p:=ss; pp:=ss;
+ end
+else begin pp:=ss; s:=attr_head(p);
+ repeat r:=s; s:=link(s);
+ until n<=attr_loc(s);
+ if n=attr_loc(s) then p:=s
+ else begin q:=get_node(attr_node_size); link(r):=q; link(q):=s;
+ attr_loc(q):=n; name_type(q):=attr; type(q):=undefined;
+ parent(q):=p; p:=q;
+ end;
+ end;
+end
+
+@ Variables lose their former values when they appear in a type declaration,
+or when they are defined to be macros or \&{let} equal to something else.
+A subroutine will be defined later that recycles the storage associated
+with any particular |type| or |value|; our goal now is to study a higher
+level process called |flush_variable|, which selectively frees parts of a
+variable structure.
+
+This routine has some complexity because of examples such as
+`\hbox{\tt numeric x[]a[]b}',
+which recycles all variables of the form \.{x[i]a[j]b} (and no others), while
+`\hbox{\tt vardef x[]a[]=...}'
+discards all variables of the form \.{x[i]a[j]} followed by an arbitrary
+suffix, except for the collective node \.{x[]a[]} itself. The obvious way
+to handle such examples is to use recursion; so that's what we~do.
+@^recursion@>
+
+Parameter |p| points to the root information of the variable;
+parameter |t| points to a list of one-word nodes that represent
+suffixes, with |info=collective_subscript| for subscripts.
+
+@p @t\4@>@<Declare subroutines for printing expressions@>@;@/
+@t\4@>@<Declare basic dependency-list subroutines@>@;
+@t\4@>@<Declare the recycling subroutines@>@;
+@t\4@>@<Declare the procedure called |flush_cur_exp|@>@;
+@t\4@>@<Declare the procedure called |flush_below_variable|@>@;
+procedure flush_variable(@!p,@!t:pointer;@!discard_suffixes:boolean);
+label exit;
+var @!q,@!r:pointer; {list manipulation}
+@!n:halfword; {attribute to match}
+begin while t<>null do
+ begin if type(p)<>structured then return;
+ n:=info(t); t:=link(t);
+ if n=collective_subscript then
+ begin r:=subscr_head_loc(p); q:=link(r); {|q=subscr_head(p)|}
+ while name_type(q)=subscr do
+ begin flush_variable(q,t,discard_suffixes);
+ if t=null then
+ if type(q)=structured then r:=q
+ else begin link(r):=link(q); free_node(q,subscr_node_size);
+ end
+ else r:=q;
+ q:=link(r);
+ end;
+ end;
+ p:=attr_head(p);
+ repeat r:=p; p:=link(p);
+ until attr_loc(p)>=n;
+ if attr_loc(p)<>n then return;
+ end;
+if discard_suffixes then flush_below_variable(p)
+else begin if type(p)=structured then p:=attr_head(p);
+ recycle_value(p);
+ end;
+exit:end;
+
+@ The next procedure is simpler; it wipes out everything but |p| itself,
+which becomes undefined.
+
+@<Declare the procedure called |flush_below_variable|@>=
+procedure flush_below_variable(@!p:pointer);
+var @!q,@!r:pointer; {list manipulation registers}
+begin if type(p)<>structured then
+ recycle_value(p) {this sets |type(p)=undefined|}
+else begin q:=subscr_head(p);
+ while name_type(q)=subscr do
+ begin flush_below_variable(q); r:=q; q:=link(q);
+ free_node(r,subscr_node_size);
+ end;
+ r:=attr_head(p); q:=link(r); recycle_value(r);
+ if name_type(p)<=saved_root then free_node(r,value_node_size)
+ else free_node(r,subscr_node_size);
+ {we assume that |subscr_node_size=attr_node_size|}
+ repeat flush_below_variable(q); r:=q; q:=link(q); free_node(r,attr_node_size);
+ until q=end_attr;
+ type(p):=undefined;
+ end;
+end;
+
+@ Just before assigning a new value to a variable, we will recycle the
+old value and make the old value undefined. The |und_type| routine
+determines what type of undefined value should be given, based on
+the current type before recycling.
+
+@p function und_type(@!p:pointer):small_number;
+begin case type(p) of
+undefined,vacuous:und_type:=undefined;
+boolean_type,unknown_boolean:und_type:=unknown_boolean;
+string_type,unknown_string:und_type:=unknown_string;
+pen_type,unknown_pen,future_pen:und_type:=unknown_pen;
+path_type,unknown_path:und_type:=unknown_path;
+picture_type,unknown_picture:und_type:=unknown_picture;
+transform_type,pair_type,numeric_type:und_type:=type(p);
+known,dependent,proto_dependent,independent:und_type:=numeric_type;
+end; {there are no other cases}
+end;
+
+@ The |clear_symbol| routine is used when we want to redefine the equivalent
+of a symbolic token. It must remove any variable structure or macro
+definition that is currently attached to that symbol. If the |saving|
+parameter is true, a subsidiary structure is saved instead of destroyed.
+
+@p procedure clear_symbol(@!p:pointer;@!saving:boolean);
+var @!q:pointer; {|equiv(p)|}
+begin q:=equiv(p);
+case eq_type(p) mod outer_tag of
+defined_macro,secondary_primary_macro,tertiary_secondary_macro,
+ expression_tertiary_macro: if not saving then delete_mac_ref(q);
+tag_token:if q<>null then
+ if saving then name_type(q):=saved_root
+ else begin flush_below_variable(q); free_node(q,value_node_size);
+ end;
+othercases do_nothing
+endcases;@/
+eqtb[p]:=eqtb[frozen_undefined];
+end;
+
+@* \[16] Saving and restoring equivalents.
+The nested structure provided by \&{begingroup} and \&{endgroup}
+allows |eqtb| entries to be saved and restored, so that temporary changes
+can be made without difficulty. When the user requests a current value to
+be saved, \MF\ puts that value into its ``save stack.'' An appearance of
+\&{endgroup} ultimately causes the old values to be removed from the save
+stack and put back in their former places.
+
+The save stack is a linked list containing three kinds of entries,
+distinguished by their |info| fields. If |p| points to a saved item,
+then
+
+\smallskip\hang
+|info(p)=0| stands for a group boundary; each \&{begingroup} contributes
+such an item to the save stack and each \&{endgroup} cuts back the stack
+until the most recent such entry has been removed.
+
+\smallskip\hang
+|info(p)=q|, where |1<=q<=hash_end|, means that |mem[p+1]| holds the former
+contents of |eqtb[q]|. Such save stack entries are generated by \&{save}
+commands or suitable \&{interim} commands.
+
+\smallskip\hang
+|info(p)=hash_end+q|, where |q>0|, means that |value(p)| is a |scaled|
+integer to be restored to internal parameter number~|q|. Such entries
+are generated by \&{interim} commands.
+
+\smallskip\noindent
+The global variable |save_ptr| points to the top item on the save stack.
+
+@d save_node_size=2 {number of words per non-boundary save-stack node}
+@d saved_equiv(#)==mem[#+1].hh {where an |eqtb| entry gets saved}
+@d save_boundary_item(#)==begin #:=get_avail; info(#):=0;
+ link(#):=save_ptr; save_ptr:=#;
+ end
+
+@<Glob...@>=@!save_ptr:pointer; {the most recently saved item}
+
+@ @<Set init...@>=save_ptr:=null;
+
+@ The |save_variable| routine is given a hash address |q|; it salts this
+address in the save stack, together with its current equivalent,
+then makes token~|q| behave as though it were brand new.
+
+Nothing is stacked when |save_ptr=null|, however; there's no way to remove
+things from the stack when the program is not inside a group, so there's
+no point in wasting the space.
+
+@p procedure save_variable(@!q:pointer);
+var @!p:pointer; {temporary register}
+begin if save_ptr<>null then
+ begin p:=get_node(save_node_size); info(p):=q; link(p):=save_ptr;
+ saved_equiv(p):=eqtb[q]; save_ptr:=p;
+ end;
+clear_symbol(q,(save_ptr<>null));
+end;
+
+@ Similarly, |save_internal| is given the location |q| of an internal
+quantity like |tracing_pens|. It creates a save stack entry of the
+third kind.
+
+@p procedure save_internal(@!q:halfword);
+var @!p:pointer; {new item for the save stack}
+begin if save_ptr<>null then
+ begin p:=get_node(save_node_size); info(p):=hash_end+q;
+ link(p):=save_ptr; value(p):=internal[q]; save_ptr:=p;
+ end;
+end;
+
+@ At the end of a group, the |unsave| routine restores all of the saved
+equivalents in reverse order. This routine will be called only when there
+is at least one boundary item on the save stack.
+
+@p procedure unsave;
+var @!q:pointer; {index to saved item}
+@!p:pointer; {temporary register}
+begin while info(save_ptr)<>0 do
+ begin q:=info(save_ptr);
+ if q>hash_end then
+ begin if internal[tracing_restores]>0 then
+ begin begin_diagnostic; print_nl("{restoring ");
+ slow_print(int_name[q-(hash_end)]); print_char("=");
+ print_scaled(value(save_ptr)); print_char("}");
+ end_diagnostic(false);
+ end;
+ internal[q-(hash_end)]:=value(save_ptr);
+ end
+ else begin if internal[tracing_restores]>0 then
+ begin begin_diagnostic; print_nl("{restoring ");
+ slow_print(text(q)); print_char("}");
+ end_diagnostic(false);
+ end;
+ clear_symbol(q,false);
+ eqtb[q]:=saved_equiv(save_ptr);
+ if eq_type(q) mod outer_tag=tag_token then
+ begin p:=equiv(q);
+ if p<>null then name_type(p):=root;
+ end;
+ end;
+ p:=link(save_ptr); free_node(save_ptr,save_node_size); save_ptr:=p;
+ end;
+p:=link(save_ptr); free_avail(save_ptr); save_ptr:=p;
+end;
+
+@* \[17] Data structures for paths.
+When a \MF\ user specifies a path, \MF\ will create a list of knots
+and control points for the associated cubic spline curves. If the
+knots are $z_0$, $z_1$, \dots, $z_n$, there are control points
+$z_k^+$ and $z_{k+1}^-$ such that the cubic splines between knots
+$z_k$ and $z_{k+1}$ are defined by B\'ezier's formula
+@:Bezier}{B\'ezier, Pierre Etienne@>
+$$\eqalign{z(t)&=B(z_k,z_k^+,z_{k+1}^-,z_{k+1};t)\cr
+&=(1-t)^3z_k+3(1-t)^2tz_k^++3(1-t)t^2z_{k+1}^-+t^3z_{k+1}\cr}$$
+for |0<=t<=1|.
+
+There is a 7-word node for each knot $z_k$, containing one word of
+control information and six words for the |x| and |y| coordinates
+of $z_k^-$ and $z_k$ and~$z_k^+$. The control information appears
+in the |left_type| and |right_type| fields, which each occupy
+a quarter of the first word in the node; they specify properties
+of the curve as it enters and leaves the knot. There's also a
+halfword |link| field, which points to the following knot.
+
+If the path is a closed contour, knots 0 and |n| are identical;
+i.e., the |link| in knot |n-1| points to knot~0. But if the path
+is not closed, the |left_type| of knot~0 and the |right_type| of knot~|n|
+are equal to |endpoint|. In the latter case the |link| in knot~|n| points
+to knot~0, and the control points $z_0^-$ and $z_n^+$ are not used.
+
+@d left_type(#) == mem[#].hh.b0 {characterizes the path entering this knot}
+@d right_type(#) == mem[#].hh.b1 {characterizes the path leaving this knot}
+@d endpoint=0 {|left_type| at path beginning and |right_type| at path end}
+@d x_coord(#) == mem[#+1].sc {the |x| coordinate of this knot}
+@d y_coord(#) == mem[#+2].sc {the |y| coordinate of this knot}
+@d left_x(#) == mem[#+3].sc {the |x| coordinate of previous control point}
+@d left_y(#) == mem[#+4].sc {the |y| coordinate of previous control point}
+@d right_x(#) == mem[#+5].sc {the |x| coordinate of next control point}
+@d right_y(#) == mem[#+6].sc {the |y| coordinate of next control point}
+@d knot_node_size=7 {number of words in a knot node}
+
+@ Before the B\'ezier control points have been calculated, the memory
+space they will ultimately occupy is taken up by information that can be
+used to compute them. There are four cases:
+
+\yskip
+\textindent{$\bullet$} If |right_type=open|, the curve should leave
+the knot in the same direction it entered; \MF\ will figure out a
+suitable direction.
+
+\yskip
+\textindent{$\bullet$} If |right_type=curl|, the curve should leave the
+knot in a direction depending on the angle at which it enters the next
+knot and on the curl parameter stored in |right_curl|.
+
+\yskip
+\textindent{$\bullet$} If |right_type=given|, the curve should leave the
+knot in a nonzero direction stored as an |angle| in |right_given|.
+
+\yskip
+\textindent{$\bullet$} If |right_type=explicit|, the B\'ezier control
+point for leaving this knot has already been computed; it is in the
+|right_x| and |right_y| fields.
+
+\yskip\noindent
+The rules for |left_type| are similar, but they refer to the curve entering
+the knot, and to \\{left} fields instead of \\{right} fields.
+
+Non-|explicit| control points will be chosen based on ``tension'' parameters
+in the |left_tension| and |right_tension| fields. The
+`\&{atleast}' option is represented by negative tension values.
+@!@:at_least_}{\&{atleast} primitive@>
+
+For example, the \MF\ path specification
+$$\.{z0..z1..tension atleast 1..\{curl 2\}z2..z3\{-1,-2\}..tension
+ 3 and 4..p},$$
+where \.p is the path `\.{z4..controls z45 and z54..z5}', will be represented
+by the six knots
+\def\lodash{\hbox to 1.1em{\thinspace\hrulefill\thinspace}}
+$$\vbox{\halign{#\hfil&&\qquad#\hfil\cr
+|left_type|&\\{left} info&|x_coord,y_coord|&|right_type|&\\{right} info\cr
+\noalign{\yskip}
+|endpoint|&\lodash$,\,$\lodash&$x_0,y_0$&|curl|&$1.0,1.0$\cr
+|open|&\lodash$,1.0$&$x_1,y_1$&|open|&\lodash$,-1.0$\cr
+|curl|&$2.0,-1.0$&$x_2,y_2$&|curl|&$2.0,1.0$\cr
+|given|&$d,1.0$&$x_3,y_3$&|given|&$d,3.0$\cr
+|open|&\lodash$,4.0$&$x_4,y_4$&|explicit|&$x_{45},y_{45}$\cr
+|explicit|&$x_{54},y_{54}$&$x_5,y_5$&|endpoint|&\lodash$,\,$\lodash\cr}}$$
+Here |d| is the |angle| obtained by calling |n_arg(-unity,-two)|.
+Of course, this example is more complicated than anything a normal user
+would ever write.
+
+These types must satisfy certain restrictions because of the form of \MF's
+path syntax:
+(i)~|open| type never appears in the same node together with |endpoint|,
+|given|, or |curl|.
+(ii)~The |right_type| of a node is |explicit| if and only if the
+|left_type| of the following node is |explicit|.
+(iii)~|endpoint| types occur only at the ends, as mentioned above.
+
+@d left_curl==left_x {curl information when entering this knot}
+@d left_given==left_x {given direction when entering this knot}
+@d left_tension==left_y {tension information when entering this knot}
+@d right_curl==right_x {curl information when leaving this knot}
+@d right_given==right_x {given direction when leaving this knot}
+@d right_tension==right_y {tension information when leaving this knot}
+@d explicit=1 {|left_type| or |right_type| when control points are known}
+@d given=2 {|left_type| or |right_type| when a direction is given}
+@d curl=3 {|left_type| or |right_type| when a curl is desired}
+@d open=4 {|left_type| or |right_type| when \MF\ should choose the direction}
+
+@ Here is a diagnostic routine that prints a given knot list
+in symbolic form. It illustrates the conventions discussed above,
+and checks for anomalies that might arise while \MF\ is being debugged.
+
+@<Declare subroutines for printing expressions@>=
+procedure print_path(@!h:pointer;@!s:str_number;@!nuline:boolean);
+label done,done1;
+var @!p,@!q:pointer; {for list traversal}
+begin print_diagnostic("Path",s,nuline); print_ln;
+@.Path at line...@>
+p:=h;
+repeat q:=link(p);
+if (p=null)or(q=null) then
+ begin print_nl("???"); goto done; {this won't happen}
+@.???@>
+ end;
+@<Print information for adjacent knots |p| and |q|@>;
+p:=q;
+if (p<>h)or(left_type(h)<>endpoint) then
+ @<Print two dots, followed by |given| or |curl| if present@>;
+until p=h;
+if left_type(h)<>endpoint then print("cycle");
+done:end_diagnostic(true);
+end;
+
+@ @<Print information for adjacent knots...@>=
+print_two(x_coord(p),y_coord(p));
+case right_type(p) of
+endpoint: begin if left_type(p)=open then print("{open?}"); {can't happen}
+@.open?@>
+ if (left_type(q)<>endpoint)or(q<>h) then q:=null; {force an error}
+ goto done1;
+ end;
+explicit: @<Print control points between |p| and |q|, then |goto done1|@>;
+open: @<Print information for a curve that begins |open|@>;
+curl,given: @<Print information for a curve that begins |curl| or |given|@>;
+othercases print("???") {can't happen}
+@.???@>
+endcases;@/
+if left_type(q)<=explicit then print("..control?") {can't happen}
+@.control?@>
+else if (right_tension(p)<>unity)or(left_tension(q)<>unity) then
+ @<Print tension between |p| and |q|@>;
+done1:
+
+@ Since |n_sin_cos| produces |fraction| results, which we will print as if they
+were |scaled|, the magnitude of a |given| direction vector will be~4096.
+
+@<Print two dots...@>=
+begin print_nl(" ..");
+if left_type(p)=given then
+ begin n_sin_cos(left_given(p)); print_char("{");
+ print_scaled(n_cos); print_char(",");
+ print_scaled(n_sin); print_char("}");
+ end
+else if left_type(p)=curl then
+ begin print("{curl "); print_scaled(left_curl(p)); print_char("}");
+ end;
+end
+
+@ @<Print tension between |p| and |q|@>=
+begin print("..tension ");
+if right_tension(p)<0 then print("atleast");
+print_scaled(abs(right_tension(p)));
+if right_tension(p)<>left_tension(q) then
+ begin print(" and ");
+ if left_tension(q)<0 then print("atleast");
+ print_scaled(abs(left_tension(q)));
+ end;
+end
+
+@ @<Print control points between |p| and |q|, then |goto done1|@>=
+begin print("..controls "); print_two(right_x(p),right_y(p)); print(" and ");
+if left_type(q)<>explicit then print("??") {can't happen}
+@.??@>
+else print_two(left_x(q),left_y(q));
+goto done1;
+end
+
+@ @<Print information for a curve that begins |open|@>=
+if (left_type(p)<>explicit)and(left_type(p)<>open) then
+ print("{open?}") {can't happen}
+@.open?@>
+
+@ A curl of 1 is shown explicitly, so that the user sees clearly that
+\MF's default curl is present.
+
+The code here uses the fact that |left_curl==left_given| and
+|right_curl==right_given|.
+
+@<Print information for a curve that begins |curl|...@>=
+begin if left_type(p)=open then print("??"); {can't happen}
+@.??@>
+if right_type(p)=curl then
+ begin print("{curl "); print_scaled(right_curl(p));
+ end
+else begin n_sin_cos(right_given(p)); print_char("{");
+ print_scaled(n_cos); print_char(","); print_scaled(n_sin);
+ end;
+print_char("}");
+end
+
+@ If we want to duplicate a knot node, we can say |copy_knot|:
+
+@p function copy_knot(@!p:pointer):pointer;
+var @!q:pointer; {the copy}
+@!k:0..knot_node_size-1; {runs through the words of a knot node}
+begin q:=get_node(knot_node_size);
+for k:=0 to knot_node_size-1 do mem[q+k]:=mem[p+k];
+copy_knot:=q;
+end;
+
+@ The |copy_path| routine makes a clone of a given path.
+
+@p function copy_path(@!p:pointer):pointer;
+label exit;
+var @!q,@!pp,@!qq:pointer; {for list manipulation}
+begin q:=get_node(knot_node_size); {this will correspond to |p|}
+qq:=q; pp:=p;
+loop@+ begin left_type(qq):=left_type(pp);
+ right_type(qq):=right_type(pp);@/
+ x_coord(qq):=x_coord(pp); y_coord(qq):=y_coord(pp);@/
+ left_x(qq):=left_x(pp); left_y(qq):=left_y(pp);@/
+ right_x(qq):=right_x(pp); right_y(qq):=right_y(pp);@/
+ if link(pp)=p then
+ begin link(qq):=q; copy_path:=q; return;
+ end;
+ link(qq):=get_node(knot_node_size); qq:=link(qq); pp:=link(pp);
+ end;
+exit:end;
+
+@ Similarly, there's a way to copy the {\sl reverse\/} of a path. This procedure
+returns a pointer to the first node of the copy, if the path is a cycle,
+but to the final node of a non-cyclic copy. The global
+variable |path_tail| will point to the final node of the original path;
+this trick makes it easier to implement `\&{doublepath}'.
+
+All node types are assumed to be |endpoint| or |explicit| only.
+
+@p function htap_ypoc(@!p:pointer):pointer;
+label exit;
+var @!q,@!pp,@!qq,@!rr:pointer; {for list manipulation}
+begin q:=get_node(knot_node_size); {this will correspond to |p|}
+qq:=q; pp:=p;
+loop@+ begin right_type(qq):=left_type(pp); left_type(qq):=right_type(pp);@/
+ x_coord(qq):=x_coord(pp); y_coord(qq):=y_coord(pp);@/
+ right_x(qq):=left_x(pp); right_y(qq):=left_y(pp);@/
+ left_x(qq):=right_x(pp); left_y(qq):=right_y(pp);@/
+ if link(pp)=p then
+ begin link(q):=qq; path_tail:=pp; htap_ypoc:=q; return;
+ end;
+ rr:=get_node(knot_node_size); link(rr):=qq; qq:=rr; pp:=link(pp);
+ end;
+exit:end;
+
+@ @<Glob...@>=
+@!path_tail:pointer; {the node that links to the beginning of a path}
+
+@ When a cyclic list of knot nodes is no longer needed, it can be recycled by
+calling the following subroutine.
+
+@<Declare the recycling subroutines@>=
+procedure toss_knot_list(@!p:pointer);
+var @!q:pointer; {the node being freed}
+@!r:pointer; {the next node}
+begin q:=p;
+repeat r:=link(q); free_node(q,knot_node_size); q:=r;
+until q=p;
+end;
+
+@* \[18] Choosing control points.
+Now we must actually delve into one of \MF's more difficult routines,
+the |make_choices| procedure that chooses angles and control points for
+the splines of a curve when the user has not specified them explicitly.
+The parameter to |make_choices| points to a list of knots and
+path information, as described above.
+
+A path decomposes into independent segments at ``breakpoint'' knots,
+which are knots whose left and right angles are both prespecified in
+some way (i.e., their |left_type| and |right_type| aren't both open).
+
+@p @t\4@>@<Declare the procedure called |solve_choices|@>@;
+procedure make_choices(@!knots:pointer);
+label done;
+var @!h:pointer; {the first breakpoint}
+@!p,@!q:pointer; {consecutive breakpoints being processed}
+@<Other local variables for |make_choices|@>@;
+begin check_arith; {make sure that |arith_error=false|}
+if internal[tracing_choices]>0 then
+ print_path(knots,", before choices",true);
+@<If consecutive knots are equal, join them explicitly@>;
+@<Find the first breakpoint, |h|, on the path;
+ insert an artificial breakpoint if the path is an unbroken cycle@>;
+p:=h;
+repeat @<Fill in the control points between |p| and the next breakpoint,
+ then advance |p| to that breakpoint@>;
+until p=h;
+if internal[tracing_choices]>0 then
+ print_path(knots,", after choices",true);
+if arith_error then @<Report an unexpected problem during the choice-making@>;
+end;
+
+@ @<Report an unexpected problem during the choice...@>=
+begin print_err("Some number got too big");
+@.Some number got too big@>
+help2("The path that I just computed is out of range.")@/
+ ("So it will probably look funny. Proceed, for a laugh.");
+put_get_error; arith_error:=false;
+end
+
+@ Two knots in a row with the same coordinates will always be joined
+by an explicit ``curve'' whose control points are identical with the
+knots.
+
+@<If consecutive knots are equal, join them explicitly@>=
+p:=knots;
+repeat q:=link(p);
+if x_coord(p)=x_coord(q) then if y_coord(p)=y_coord(q) then
+ if right_type(p)>explicit then
+ begin right_type(p):=explicit;
+ if left_type(p)=open then
+ begin left_type(p):=curl; left_curl(p):=unity;
+ end;
+ left_type(q):=explicit;
+ if right_type(q)=open then
+ begin right_type(q):=curl; right_curl(q):=unity;
+ end;
+ right_x(p):=x_coord(p); left_x(q):=x_coord(p);@/
+ right_y(p):=y_coord(p); left_y(q):=y_coord(p);
+ end;
+p:=q;
+until p=knots
+
+@ If there are no breakpoints, it is necessary to compute the direction
+angles around an entire cycle. In this case the |left_type| of the first
+node is temporarily changed to |end_cycle|.
+
+@d end_cycle=open+1
+
+@<Find the first breakpoint, |h|, on the path...@>=
+h:=knots;
+loop@+ begin if left_type(h)<>open then goto done;
+ if right_type(h)<>open then goto done;
+ h:=link(h);
+ if h=knots then
+ begin left_type(h):=end_cycle; goto done;
+ end;
+ end;
+done:
+
+@ If |right_type(p)<given| and |q=link(p)|, we must have
+|right_type(p)=left_type(q)=explicit| or |endpoint|.
+
+@<Fill in the control points between |p| and the next breakpoint...@>=
+q:=link(p);
+if right_type(p)>=given then
+ begin while (left_type(q)=open)and(right_type(q)=open) do q:=link(q);
+ @<Fill in the control information between
+ consecutive breakpoints |p| and |q|@>;
+ end;
+p:=q
+
+@ Before we can go further into the way choices are made, we need to
+consider the underlying theory. The basic ideas implemented in |make_choices|
+are due to John Hobby, who introduced the notion of ``mock curvature''
+@^Hobby, John Douglas@>
+at a knot. Angles are chosen so that they preserve mock curvature when
+a knot is passed, and this has been found to produce excellent results.
+
+It is convenient to introduce some notations that simplify the necessary
+formulas. Let $d_{k,k+1}=\vert z\k-z_k\vert$ be the (nonzero) distance
+between knots |k| and |k+1|; and let
+$${z\k-z_k\over z_k-z_{k-1}}={d_{k,k+1}\over d_{k-1,k}}e^{i\psi_k}$$
+so that a polygonal line from $z_{k-1}$ to $z_k$ to $z\k$ turns left
+through an angle of~$\psi_k$. We assume that $\vert\psi_k\vert\L180^\circ$.
+The control points for the spline from $z_k$ to $z\k$ will be denoted by
+$$\eqalign{z_k^+&=z_k+
+ \textstyle{1\over3}\rho_k e^{i\theta_k}(z\k-z_k),\cr
+ z\k^-&=z\k-
+ \textstyle{1\over3}\sigma\k e^{-i\phi\k}(z\k-z_k),\cr}$$
+where $\rho_k$ and $\sigma\k$ are nonnegative ``velocity ratios'' at the
+beginning and end of the curve, while $\theta_k$ and $\phi\k$ are the
+corresponding ``offset angles.'' These angles satisfy the condition
+$$\theta_k+\phi_k+\psi_k=0,\eqno(*)$$
+whenever the curve leaves an intermediate knot~|k| in the direction that
+it enters.
+
+@ Let $\alpha_k$ and $\beta\k$ be the reciprocals of the ``tension'' of
+the curve at its beginning and ending points. This means that
+$\rho_k=\alpha_k f(\theta_k,\phi\k)$ and $\sigma\k=\beta\k f(\phi\k,\theta_k)$,
+where $f(\theta,\phi)$ is \MF's standard velocity function defined in
+the |velocity| subroutine. The cubic spline $B(z_k^{\phantom+},z_k^+,
+z\k^-,z\k^{\phantom+};t)$
+has curvature
+@^curvature@>
+$${2\sigma\k\sin(\theta_k+\phi\k)-6\sin\theta_k\over\rho_k^2d_{k,k+1}}
+\qquad{\rm and}\qquad
+{2\rho_k\sin(\theta_k+\phi\k)-6\sin\phi\k\over\sigma\k^2d_{k,k+1}}$$
+at |t=0| and |t=1|, respectively. The mock curvature is the linear
+@^mock curvature@>
+approximation to this true curvature that arises in the limit for
+small $\theta_k$ and~$\phi\k$, if second-order terms are discarded.
+The standard velocity function satisfies
+$$f(\theta,\phi)=1+O(\theta^2+\theta\phi+\phi^2);$$
+hence the mock curvatures are respectively
+$${2\beta\k(\theta_k+\phi\k)-6\theta_k\over\alpha_k^2d_{k,k+1}}
+\qquad{\rm and}\qquad
+{2\alpha_k(\theta_k+\phi\k)-6\phi\k\over\beta\k^2d_{k,k+1}}.\eqno(**)$$
+
+@ The turning angles $\psi_k$ are given, and equation $(*)$ above
+determines $\phi_k$ when $\theta_k$ is known, so the task of
+angle selection is essentially to choose appropriate values for each
+$\theta_k$. When equation~$(*)$ is used to eliminate $\phi$~variables
+from $(**)$, we obtain a system of linear equations of the form
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+where
+$$A_k={\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
+\qquad B_k={3-\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
+\qquad C_k={3-\beta\k\over\alpha_k^2d_{k,k+1}},
+\qquad D_k={\beta\k\over\alpha_k^2d_{k,k+1}}.$$
+The tensions are always $3\over4$ or more, hence each $\alpha$ and~$\beta$
+will be at most $4\over3$. It follows that $B_k\G{5\over4}A_k$ and
+$C_k\G{5\over4}D_k$; hence the equations are diagonally dominant;
+hence they have a unique solution. Moreover, in most cases the tensions
+are equal to~1, so that $B_k=2A_k$ and $C_k=2D_k$. This makes the
+solution numerically stable, and there is an exponential damping
+effect: The data at knot $k\pm j$ affects the angle at knot~$k$ by
+a factor of~$O(2^{-j})$.
+
+@ However, we still must consider the angles at the starting and ending
+knots of a non-cyclic path. These angles might be given explicitly, or
+they might be specified implicitly in terms of an amount of ``curl.''
+
+Let's assume that angles need to be determined for a non-cyclic path
+starting at $z_0$ and ending at~$z_n$. Then equations of the form
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta_{k+1}=R_k$$
+have been given for $0<k<n$, and it will be convenient to introduce
+equations of the same form for $k=0$ and $k=n$, where
+$$A_0=B_0=C_n=D_n=0.$$
+If $\theta_0$ is supposed to have a given value $E_0$, we simply
+define $C_0=0$, $D_0=0$, and $R_0=E_0$. Otherwise a curl
+parameter, $\gamma_0$, has been specified at~$z_0$; this means
+that the mock curvature at $z_0$ should be $\gamma_0$ times the
+mock curvature at $z_1$; i.e.,
+$${2\beta_1(\theta_0+\phi_1)-6\theta_0\over\alpha_0^2d_{01}}
+=\gamma_0{2\alpha_0(\theta_0+\phi_1)-6\phi_1\over\beta_1^2d_{01}}.$$
+This equation simplifies to
+$$(\alpha_0\chi_0+3-\beta_1)\theta_0+
+ \bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\theta_1=
+ -\bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\psi_1,$$
+where $\chi_0=\alpha_0^2\gamma_0/\beta_1^2$; so we can set $C_0=
+\chi_0\alpha_0+3-\beta_1$, $D_0=(3-\alpha_0)\chi_0+\beta_1$, $R_0=-D_0\psi_1$.
+It can be shown that $C_0>0$ and $C_0B_1-A_1D_0>0$ when $\gamma_0\G0$,
+hence the linear equations remain nonsingular.
+
+Similar considerations apply at the right end, when the final angle $\phi_n$
+may or may not need to be determined. It is convenient to let $\psi_n=0$,
+hence $\theta_n=-\phi_n$. We either have an explicit equation $\theta_n=E_n$,
+or we have
+$$\bigl((3-\beta_n)\chi_n+\alpha_{n-1}\bigr)\theta_{n-1}+
+(\beta_n\chi_n+3-\alpha_{n-1})\theta_n=0,\qquad
+ \chi_n={\beta_n^2\gamma_n\over\alpha_{n-1}^2}.$$
+
+When |make_choices| chooses angles, it must compute the coefficients of
+these linear equations, then solve the equations. To compute the coefficients,
+it is necessary to compute arctangents of the given turning angles~$\psi_k$.
+When the equations are solved, the chosen directions $\theta_k$ are put
+back into the form of control points by essentially computing sines and
+cosines.
+
+@ OK, we are ready to make the hard choices of |make_choices|.
+Most of the work is relegated to an auxiliary procedure
+called |solve_choices|, which has been introduced to keep
+|make_choices| from being extremely long.
+
+@<Fill in the control information between...@>=
+@<Calculate the turning angles $\psi_k$ and the distances $d_{k,k+1}$;
+ set $n$ to the length of the path@>;
+@<Remove |open| types at the breakpoints@>;
+solve_choices(p,q,n)
+
+@ It's convenient to precompute quantities that will be needed several
+times later. The values of |delta_x[k]| and |delta_y[k]| will be the
+coordinates of $z\k-z_k$, and the magnitude of this vector will be
+|delta[k]=@t$d_{k,k+1}$@>|. The path angle $\psi_k$ between $z_k-z_{k-1}$
+and $z\k-z_k$ will be stored in |psi[k]|.
+
+@<Glob...@>=
+@!delta_x,@!delta_y,@!delta:array[0..path_size] of scaled; {knot differences}
+@!psi:array[1..path_size] of angle; {turning angles}
+
+@ @<Other local variables for |make_choices|@>=
+@!k,@!n:0..path_size; {current and final knot numbers}
+@!s,@!t:pointer; {registers for list traversal}
+@!delx,@!dely:scaled; {directions where |open| meets |explicit|}
+@!sine,@!cosine:fraction; {trig functions of various angles}
+
+@ @<Calculate the turning angles...@>=
+k:=0; s:=p; n:=path_size;
+repeat t:=link(s);
+delta_x[k]:=x_coord(t)-x_coord(s);
+delta_y[k]:=y_coord(t)-y_coord(s);
+delta[k]:=pyth_add(delta_x[k],delta_y[k]);
+if k>0 then
+ begin sine:=make_fraction(delta_y[k-1],delta[k-1]);
+ cosine:=make_fraction(delta_x[k-1],delta[k-1]);
+ psi[k]:=n_arg(take_fraction(delta_x[k],cosine)+
+ take_fraction(delta_y[k],sine),
+ take_fraction(delta_y[k],cosine)-
+ take_fraction(delta_x[k],sine));
+ end;
+@:METAFONT capacity exceeded path size}{\quad path size@>
+incr(k); s:=t;
+if k=path_size then overflow("path size",path_size);
+if s=q then n:=k;
+until (k>=n)and(left_type(s)<>end_cycle);
+if k=n then psi[n]:=0@+else psi[k]:=psi[1]
+
+@ When we get to this point of the code, |right_type(p)| is either
+|given| or |curl| or |open|. If it is |open|, we must have
+|left_type(p)=end_cycle| or |left_type(p)=explicit|. In the latter
+case, the |open| type is converted to |given|; however, if the
+velocity coming into this knot is zero, the |open| type is
+converted to a |curl|, since we don't know the incoming direction.
+
+Similarly, |left_type(q)| is either |given| or |curl| or |open| or
+|end_cycle|. The |open| possibility is reduced either to |given| or to |curl|.
+
+@<Remove |open| types at the breakpoints@>=
+if left_type(q)=open then
+ begin delx:=right_x(q)-x_coord(q); dely:=right_y(q)-y_coord(q);
+ if (delx=0)and(dely=0) then
+ begin left_type(q):=curl; left_curl(q):=unity;
+ end
+ else begin left_type(q):=given; left_given(q):=n_arg(delx,dely);
+ end;
+ end;
+if (right_type(p)=open)and(left_type(p)=explicit) then
+ begin delx:=x_coord(p)-left_x(p); dely:=y_coord(p)-left_y(p);
+ if (delx=0)and(dely=0) then
+ begin right_type(p):=curl; right_curl(p):=unity;
+ end
+ else begin right_type(p):=given; right_given(p):=n_arg(delx,dely);
+ end;
+ end
+
+@ Linear equations need to be solved whenever |n>1|; and also when |n=1|
+and exactly one of the breakpoints involves a curl. The simplest case occurs
+when |n=1| and there is a curl at both breakpoints; then we simply draw
+a straight line.
+
+But before coding up the simple cases, we might as well face the general case,
+since we must deal with it sooner or later, and since the general case
+is likely to give some insight into the way simple cases can be handled best.
+
+When there is no cycle, the linear equations to be solved form a tri-diagonal
+system, and we can apply the standard technique of Gaussian elimination
+to convert that system to a sequence of equations of the form
+$$\theta_0+u_0\theta_1=v_0,\quad
+\theta_1+u_1\theta_2=v_1,\quad\ldots,\quad
+\theta_{n-1}+u_{n-1}\theta_n=v_{n-1},\quad
+\theta_n=v_n.$$
+It is possible to do this diagonalization while generating the equations.
+Once $\theta_n$ is known, it is easy to determine $\theta_{n-1}$, \dots,
+$\theta_1$, $\theta_0$; thus, the equations will be solved.
+
+The procedure is slightly more complex when there is a cycle, but the
+basic idea will be nearly the same. In the cyclic case the right-hand
+sides will be $v_k+w_k\theta_0$ instead of simply $v_k$, and we will start
+the process off with $u_0=v_0=0$, $w_0=1$. The final equation will be not
+$\theta_n=v_n$ but $\theta_n+u_n\theta_1=v_n+w_n\theta_0$; an appropriate
+ending routine will take account of the fact that $\theta_n=\theta_0$ and
+eliminate the $w$'s from the system, after which the solution can be
+obtained as before.
+
+When $u_k$, $v_k$, and $w_k$ are being computed, the three pointer
+variables |r|, |s|,~|t| will point respectively to knots |k-1|, |k|,
+and~|k+1|. The $u$'s and $w$'s are scaled by $2^{28}$, i.e., they are
+of type |fraction|; the $\theta$'s and $v$'s are of type |angle|.
+
+@<Glob...@>=
+@!theta:array[0..path_size] of angle; {values of $\theta_k$}
+@!uu:array[0..path_size] of fraction; {values of $u_k$}
+@!vv:array[0..path_size] of angle; {values of $v_k$}
+@!ww:array[0..path_size] of fraction; {values of $w_k$}
+
+@ Our immediate problem is to get the ball rolling by setting up the
+first equation or by realizing that no equations are needed, and to fit
+this initialization into a framework suitable for the overall computation.
+
+@<Declare the procedure called |solve_choices|@>=
+@t\4@>@<Declare subroutines needed by |solve_choices|@>@;
+procedure solve_choices(@!p,@!q:pointer;@!n:halfword);
+label found,exit;
+var @!k:0..path_size; {current knot number}
+@!r,@!s,@!t:pointer; {registers for list traversal}
+@<Other local variables for |solve_choices|@>@;
+begin k:=0; s:=p;
+loop@+ begin t:=link(s);
+ if k=0 then @<Get the linear equations started; or |return|
+ with the control points in place, if linear equations
+ needn't be solved@>
+ else case left_type(s) of
+ end_cycle,open:@<Set up equation to match mock curvatures
+ at $z_k$; then |goto found| with $\theta_n$
+ adjusted to equal $\theta_0$, if a cycle has ended@>;
+ curl:@<Set up equation for a curl at $\theta_n$
+ and |goto found|@>;
+ given:@<Calculate the given value of $\theta_n$
+ and |goto found|@>;
+ end; {there are no other cases}
+ r:=s; s:=t; incr(k);
+ end;
+found:@<Finish choosing angles and assigning control points@>;
+exit:end;
+
+@ On the first time through the loop, we have |k=0| and |r| is not yet
+defined. The first linear equation, if any, will have $A_0=B_0=0$.
+
+@<Get the linear equations started...@>=
+case right_type(s) of
+given: if left_type(t)=given then @<Reduce to simple case of two givens
+ and |return|@>
+ else @<Set up the equation for a given value of $\theta_0$@>;
+curl: if left_type(t)=curl then @<Reduce to simple case of straight line
+ and |return|@>
+ else @<Set up the equation for a curl at $\theta_0$@>;
+open: begin uu[0]:=0; vv[0]:=0; ww[0]:=fraction_one;
+ end; {this begins a cycle}
+end {there are no other cases}
+
+@ The general equation that specifies equality of mock curvature at $z_k$ is
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+as derived above. We want to combine this with the already-derived equation
+$\theta_{k-1}+u_{k-1}\theta_k=v_{k-1}+w_{k-1}\theta_0$ in order to obtain
+a new equation
+$\theta_k+u_k\theta\k=v_k+w_k\theta_0$. This can be done by dividing the
+equation
+$$(B_k-u_{k-1}A_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k-A_kv_{k-1}
+ -A_kw_{k-1}\theta_0$$
+by $B_k-u_{k-1}A_k+C_k$. The trick is to do this carefully with
+fixed-point arithmetic, avoiding the chance of overflow while retaining
+suitable precision.
+
+The calculations will be performed in several registers that
+provide temporary storage for intermediate quantities.
+
+@<Other local variables for |solve_choices|@>=
+@!aa,@!bb,@!cc,@!ff,@!acc:fraction; {temporary registers}
+@!dd,@!ee:scaled; {likewise, but |scaled|}
+@!lt,@!rt:scaled; {tension values}
+
+@ @<Set up equation to match mock curvatures...@>=
+begin @<Calculate the values $\\{aa}=A_k/B_k$, $\\{bb}=D_k/C_k$,
+ $\\{dd}=(3-\alpha_{k-1})d_{k,k+1}$, $\\{ee}=(3-\beta\k)d_{k-1,k}$,
+ and $\\{cc}=(B_k-u_{k-1}A_k)/B_k$@>;
+@<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>;
+uu[k]:=take_fraction(ff,bb);
+@<Calculate the values of $v_k$ and $w_k$@>;
+if left_type(s)=end_cycle then
+ @<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>;
+end
+
+@ Since tension values are never less than 3/4, the values |aa| and
+|bb| computed here are never more than 4/5.
+
+@<Calculate the values $\\{aa}=...@>=
+if abs(right_tension(r))=unity then
+ begin aa:=fraction_half; dd:=2*delta[k];
+ end
+else begin aa:=make_fraction(unity,3*abs(right_tension(r))-unity);
+ dd:=take_fraction(delta[k],
+ fraction_three-make_fraction(unity,abs(right_tension(r))));
+ end;
+if abs(left_tension(t))=unity then
+ begin bb:=fraction_half; ee:=2*delta[k-1];
+ end
+else begin bb:=make_fraction(unity,3*abs(left_tension(t))-unity);
+ ee:=take_fraction(delta[k-1],
+ fraction_three-make_fraction(unity,abs(left_tension(t))));
+ end;
+cc:=fraction_one-take_fraction(uu[k-1],aa)
+
+@ The ratio to be calculated in this step can be written in the form
+$$\beta_k^2\cdot\\{ee}\over\beta_k^2\cdot\\{ee}+\alpha_k^2\cdot
+ \\{cc}\cdot\\{dd},$$
+because of the quantities just calculated. The values of |dd| and |ee|
+will not be needed after this step has been performed.
+
+@<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>=
+dd:=take_fraction(dd,cc); lt:=abs(left_tension(s)); rt:=abs(right_tension(s));
+if lt<>rt then {$\beta_k^{-1}\ne\alpha_k^{-1}$}
+ if lt<rt then
+ begin ff:=make_fraction(lt,rt);
+ ff:=take_fraction(ff,ff); {$\alpha_k^2/\beta_k^2$}
+ dd:=take_fraction(dd,ff);
+ end
+ else begin ff:=make_fraction(rt,lt);
+ ff:=take_fraction(ff,ff); {$\beta_k^2/\alpha_k^2$}
+ ee:=take_fraction(ee,ff);
+ end;
+ff:=make_fraction(ee,ee+dd)
+
+@ The value of $u_{k-1}$ will be |<=1| except when $k=1$ and the previous
+equation was specified by a curl. In that case we must use a special
+method of computation to prevent overflow.
+
+Fortunately, the calculations turn out to be even simpler in this ``hard''
+case. The curl equation makes $w_0=0$ and $v_0=-u_0\psi_1$, hence
+$-B_1\psi_1-A_1v_0=-(B_1-u_0A_1)\psi_1=-\\{cc}\cdot B_1\psi_1$.
+
+@<Calculate the values of $v_k$ and $w_k$@>=
+acc:=-take_fraction(psi[k+1],uu[k]);
+if right_type(r)=curl then
+ begin ww[k]:=0;
+ vv[k]:=acc-take_fraction(psi[1],fraction_one-ff);
+ end
+else begin ff:=make_fraction(fraction_one-ff,cc); {this is
+ $B_k/(C_k+B_k-u_{k-1}A_k)<5$}
+ acc:=acc-take_fraction(psi[k],ff);
+ ff:=take_fraction(ff,aa); {this is $A_k/(C_k+B_k-u_{k-1}A_k)$}
+ vv[k]:=acc-take_fraction(vv[k-1],ff);
+ if ww[k-1]=0 then ww[k]:=0
+ else ww[k]:=-take_fraction(ww[k-1],ff);
+ end
+
+@ When a complete cycle has been traversed, we have $\theta_k+u_k\theta\k=
+v_k+w_k\theta_0$, for |1<=k<=n|. We would like to determine the value of
+$\theta_n$ and reduce the system to the form $\theta_k+u_k\theta\k=v_k$
+for |0<=k<n|, so that the cyclic case can be finished up just as if there
+were no cycle.
+
+The idea in the following code is to observe that
+$$\eqalign{\theta_n&=v_n+w_n\theta_0-u_n\theta_1=\cdots\cr
+&=v_n+w_n\theta_0-u_n\bigl(v_1+w_1\theta_0-u_1(v_2+\cdots
+ -u_{n-2}(v_{n-1}+w_{n-1}\theta_0-u_{n-1}\theta_0)\ldots{})\bigr),\cr}$$
+so we can solve for $\theta_n=\theta_0$.
+
+@<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>=
+begin aa:=0; bb:=fraction_one; {we have |k=n|}
+repeat decr(k);
+if k=0 then k:=n;
+aa:=vv[k]-take_fraction(aa,uu[k]);
+bb:=ww[k]-take_fraction(bb,uu[k]);
+until k=n; {now $\theta_n=\\{aa}+\\{bb}\cdot\theta_n$}
+aa:=make_fraction(aa,fraction_one-bb);
+theta[n]:=aa; vv[0]:=aa;
+for k:=1 to n-1 do vv[k]:=vv[k]+take_fraction(aa,ww[k]);
+goto found;
+end
+
+@ @d reduce_angle(#)==if abs(#)>one_eighty_deg then
+ if #>0 then #:=#-three_sixty_deg@+else #:=#+three_sixty_deg
+
+@<Calculate the given value of $\theta_n$...@>=
+begin theta[n]:=left_given(s)-n_arg(delta_x[n-1],delta_y[n-1]);
+reduce_angle(theta[n]);
+goto found;
+end
+
+@ @<Set up the equation for a given value of $\theta_0$@>=
+begin vv[0]:=right_given(s)-n_arg(delta_x[0],delta_y[0]);
+reduce_angle(vv[0]);
+uu[0]:=0; ww[0]:=0;
+end
+
+@ @<Set up the equation for a curl at $\theta_0$@>=
+begin cc:=right_curl(s); lt:=abs(left_tension(t)); rt:=abs(right_tension(s));
+if (rt=unity)and(lt=unity) then
+ uu[0]:=make_fraction(cc+cc+unity,cc+two)
+else uu[0]:=curl_ratio(cc,rt,lt);
+vv[0]:=-take_fraction(psi[1],uu[0]); ww[0]:=0;
+end
+
+@ @<Set up equation for a curl at $\theta_n$...@>=
+begin cc:=left_curl(s); lt:=abs(left_tension(s)); rt:=abs(right_tension(r));
+if (rt=unity)and(lt=unity) then
+ ff:=make_fraction(cc+cc+unity,cc+two)
+else ff:=curl_ratio(cc,lt,rt);
+theta[n]:=-make_fraction(take_fraction(vv[n-1],ff),
+ fraction_one-take_fraction(ff,uu[n-1]));
+goto found;
+end
+
+@ The |curl_ratio| subroutine has three arguments, which our previous notation
+encourages us to call $\gamma$, $\alpha^{-1}$, and $\beta^{-1}$. It is
+a somewhat tedious program to calculate
+$${(3-\alpha)\alpha^2\gamma+\beta^3\over
+ \alpha^3\gamma+(3-\beta)\beta^2},$$
+with the result reduced to 4 if it exceeds 4. (This reduction of curl
+is necessary only if the curl and tension are both large.)
+The values of $\alpha$ and $\beta$ will be at most~4/3.
+
+@<Declare subroutines needed by |solve_choices|@>=
+function curl_ratio(@!gamma,@!a_tension,@!b_tension:scaled):fraction;
+var @!alpha,@!beta,@!num,@!denom,@!ff:fraction; {registers}
+begin alpha:=make_fraction(unity,a_tension);
+beta:=make_fraction(unity,b_tension);@/
+if alpha<=beta then
+ begin ff:=make_fraction(alpha,beta); ff:=take_fraction(ff,ff);
+ gamma:=take_fraction(gamma,ff);@/
+ beta:=beta div @'10000; {convert |fraction| to |scaled|}
+ denom:=take_fraction(gamma,alpha)+three-beta;
+ num:=take_fraction(gamma,fraction_three-alpha)+beta;
+ end
+else begin ff:=make_fraction(beta,alpha); ff:=take_fraction(ff,ff);
+ beta:=take_fraction(beta,ff) div @'10000; {convert |fraction| to |scaled|}
+ denom:=take_fraction(gamma,alpha)+(ff div 1365)-beta;
+ {$1365\approx 2^{12}/3$}
+ num:=take_fraction(gamma,fraction_three-alpha)+beta;
+ end;
+if num>=denom+denom+denom+denom then curl_ratio:=fraction_four
+else curl_ratio:=make_fraction(num,denom);
+end;
+
+@ We're in the home stretch now.
+
+@<Finish choosing angles and assigning control points@>=
+for k:=n-1 downto 0 do theta[k]:=vv[k]-take_fraction(theta[k+1],uu[k]);
+s:=p; k:=0;
+repeat t:=link(s);@/
+n_sin_cos(theta[k]); st:=n_sin; ct:=n_cos;@/
+n_sin_cos(-psi[k+1]-theta[k+1]); sf:=n_sin; cf:=n_cos;@/
+set_controls(s,t,k);@/
+incr(k); s:=t;
+until k=n
+
+@ The |set_controls| routine actually puts the control points into
+a pair of consecutive nodes |p| and~|q|. Global variables are used to
+record the values of $\sin\theta$, $\cos\theta$, $\sin\phi$, and
+$\cos\phi$ needed in this calculation.
+
+@<Glob...@>=
+@!st,@!ct,@!sf,@!cf:fraction; {sines and cosines}
+
+@ @<Declare subroutines needed by |solve_choices|@>=
+procedure set_controls(@!p,@!q:pointer;@!k:integer);
+var @!rr,@!ss:fraction; {velocities, divided by thrice the tension}
+@!lt,@!rt:scaled; {tensions}
+@!sine:fraction; {$\sin(\theta+\phi)$}
+begin lt:=abs(left_tension(q)); rt:=abs(right_tension(p));
+rr:=velocity(st,ct,sf,cf,rt);
+ss:=velocity(sf,cf,st,ct,lt);
+if (right_tension(p)<0)or(left_tension(q)<0) then @<Decrease the velocities,
+ if necessary, to stay inside the bounding triangle@>;
+right_x(p):=x_coord(p)+take_fraction(
+ take_fraction(delta_x[k],ct)-take_fraction(delta_y[k],st),rr);
+right_y(p):=y_coord(p)+take_fraction(
+ take_fraction(delta_y[k],ct)+take_fraction(delta_x[k],st),rr);
+left_x(q):=x_coord(q)-take_fraction(
+ take_fraction(delta_x[k],cf)+take_fraction(delta_y[k],sf),ss);
+left_y(q):=y_coord(q)-take_fraction(
+ take_fraction(delta_y[k],cf)-take_fraction(delta_x[k],sf),ss);
+right_type(p):=explicit; left_type(q):=explicit;
+end;
+
+@ The boundedness conditions $\\{rr}\L\sin\phi\,/\sin(\theta+\phi)$ and
+$\\{ss}\L\sin\theta\,/\sin(\theta+\phi)$ are to be enforced if $\sin\theta$,
+$\sin\phi$, and $\sin(\theta+\phi)$ all have the same sign. Otherwise
+there is no ``bounding triangle.''
+@!@:at_least_}{\&{atleast} primitive@>
+
+@<Decrease the velocities, if necessary...@>=
+if((st>=0)and(sf>=0))or((st<=0)and(sf<=0)) then
+ begin sine:=take_fraction(abs(st),cf)+take_fraction(abs(sf),ct);
+ if sine>0 then
+ begin sine:=take_fraction(sine,fraction_one+unity); {safety factor}
+ if right_tension(p)<0 then
+ if ab_vs_cd(abs(sf),fraction_one,rr,sine)<0 then
+ rr:=make_fraction(abs(sf),sine);
+ if left_tension(q)<0 then
+ if ab_vs_cd(abs(st),fraction_one,ss,sine)<0 then
+ ss:=make_fraction(abs(st),sine);
+ end;
+ end
+
+@ Only the simple cases remain to be handled.
+
+@<Reduce to simple case of two givens and |return|@>=
+begin aa:=n_arg(delta_x[0],delta_y[0]);@/
+n_sin_cos(right_given(p)-aa); ct:=n_cos; st:=n_sin;@/
+n_sin_cos(left_given(q)-aa); cf:=n_cos; sf:=-n_sin;@/
+set_controls(p,q,0); return;
+end
+
+@ @<Reduce to simple case of straight line and |return|@>=
+begin right_type(p):=explicit; left_type(q):=explicit;
+lt:=abs(left_tension(q)); rt:=abs(right_tension(p));
+if rt=unity then
+ begin if delta_x[0]>=0 then right_x(p):=x_coord(p)+((delta_x[0]+1) div 3)
+ else right_x(p):=x_coord(p)+((delta_x[0]-1) div 3);
+ if delta_y[0]>=0 then right_y(p):=y_coord(p)+((delta_y[0]+1) div 3)
+ else right_y(p):=y_coord(p)+((delta_y[0]-1) div 3);
+ end
+else begin ff:=make_fraction(unity,3*rt); {$\alpha/3$}
+ right_x(p):=x_coord(p)+take_fraction(delta_x[0],ff);
+ right_y(p):=y_coord(p)+take_fraction(delta_y[0],ff);
+ end;
+if lt=unity then
+ begin if delta_x[0]>=0 then left_x(q):=x_coord(q)-((delta_x[0]+1) div 3)
+ else left_x(q):=x_coord(q)-((delta_x[0]-1) div 3);
+ if delta_y[0]>=0 then left_y(q):=y_coord(q)-((delta_y[0]+1) div 3)
+ else left_y(q):=y_coord(q)-((delta_y[0]-1) div 3);
+ end
+else begin ff:=make_fraction(unity,3*lt); {$\beta/3$}
+ left_x(q):=x_coord(q)-take_fraction(delta_x[0],ff);
+ left_y(q):=y_coord(q)-take_fraction(delta_y[0],ff);
+ end;
+return;
+end
+
+@* \[19] Generating discrete moves.
+The purpose of the next part of \MF\ is to compute discrete approximations
+to curves described as parametric polynomial functions $z(t)$.
+We shall start with the low level first, because an efficient ``engine''
+is needed to support the high-level constructions.
+
+Most of the subroutines are based on variations of a single theme,
+namely the idea of {\sl bisection}. Given a Bernshte{\u\i}n polynomial
+@^Bernshte{\u\i}n, Serge{\u\i} Natanovich@>
+$$B(z_0,z_1,\ldots,z_n;t)=\sum_k{n\choose k}t^k(1-t)^{n-k}z_k,$$
+we can conveniently bisect its range as follows:
+
+\smallskip
+\textindent{1)} Let $z_k^{(0)}=z_k$, for |0<=k<=n|.
+
+\smallskip
+\textindent{2)} Let $z_k^{(j+1)}={1\over2}(z_k^{(j)}+z\k^{(j)})$, for
+|0<=k<n-j|, for |0<=j<n|.
+
+\smallskip\noindent
+Then
+$$B(z_0,z_1,\ldots,z_n;t)=B(z_0^{(0)},z_0^{(1)},\ldots,z_0^{(n)};2t)
+ =B(z_0^{(n)},z_1^{(n-1)},\ldots,z_n^{(0)};2t-1).$$
+This formula gives us the coefficients of polynomials to use over the ranges
+$0\L t\L{1\over2}$ and ${1\over2}\L t\L1$.
+
+In our applications it will usually be possible to work indirectly with
+numbers that allow us to deduce relevant properties of the polynomials
+without actually computing the polynomial values. We will deal with
+coefficients $Z_k=2^l(z_k-z_{k-1})$ for |1<=k<=n|, instead of
+the actual numbers $z_0$, $z_1$, \dots,~$z_n$, and the value of~|l| will
+increase by~1 at each bisection step. This technique reduces the
+amount of calculation needed for bisection and also increases the
+accuracy of evaluation (since one bit of precision is gained at each
+bisection). Indeed, the bisection process now becomes one level shorter:
+
+\smallskip
+\textindent{$1'$)} Let $Z_k^{(1)}=Z_k$, for |1<=k<=n|.
+
+\smallskip
+\textindent{$2'$)} Let $Z_k^{(j+1)}={1\over2}(Z_k^{(j)}+Z\k^{(j)})$, for
+|1<=k<=n-j|, for |1<=j<n|.
+
+\smallskip\noindent
+The relevant coefficients $(Z'_1,\ldots,Z'_n)$ and $(Z''_1,\ldots,Z''_n)$
+for the two subintervals after bisection are respectively
+$(Z_1^{(1)},Z_1^{(2)},\ldots,Z_1^{(n)})$ and
+$(Z_1^{(n)},Z_2^{(n-1)},\ldots,Z_n^{(1)})$.
+And the values of $z_0$ appropriate for the bisected interval are $z'_0=z_0$
+and $z''_0=z_0+(Z_1+Z_2+\cdots+Z_n)/2^{l+1}$.
+
+Step $2'$ involves division by~2, which introduces computational errors
+of at most $1\over2$ at each step; thus after $l$~levels of bisection the
+integers $Z_k$ will differ from their true values by at most $(n-1)l/2$.
+This error rate is quite acceptable, considering that we have $l$~more
+bits of precision in the $Z$'s by comparison with the~$z$'s. Note also
+that the $Z$'s remain bounded; there's no danger of integer overflow, even
+though we have the identity $Z_k=2^l(z_k-z_{k-1})$ for arbitrarily large~$l$.
+
+In fact, we can show not only that the $Z$'s remain bounded, but also that
+they become nearly equal, since they are control points for a polynomial
+of one less degree. If $\vert Z\k-Z_k\vert\L M$ initially, it is possible
+to prove that $\vert Z\k-Z_k\vert\L\lceil M/2^l\rceil$ after $l$~levels
+of bisection, even in the presence of rounding errors. Here's the
+proof [cf.~Lane and Riesenfeld, {\sl IEEE Trans.\ on Pattern Analysis
+@^Lane, Jeffrey Michael@>
+@^Riesenfeld, Richard Franklin@>
+and Machine Intelligence\/ \bf PAMI-2} (1980), 35--46]: Assuming that
+$\vert Z\k-Z_k\vert\L M$ before bisection, we want to prove that
+$\vert Z\k-Z_k\vert\L\lceil M/2\rceil$ afterward. First we show that
+$\vert Z\k^{(j)}-Z_k^{(j)}\vert\L M$ for all $j$ and~$k$, by induction
+on~$j$; this follows from the fact that
+$$\bigl\vert\\{half}(a+b)-\\{half}(b+c)\bigr\vert\L
+ \max\bigl(\vert a-b\vert,\vert b-c\vert\bigr)$$
+holds for both of the rounding rules $\\{half}(x)=\lfloor x/2\rfloor$
+and $\\{half}(x)={\rm sign}(x)\lfloor\vert x/2\vert\rfloor$.
+(If $\vert a-b\vert$ and $\vert b-c\vert$ are equal, then
+$a+b$ and $b+c$ are both even or both odd. The rounding errors either
+cancel or round the numbers toward each other; hence
+$$\eqalign{\bigl\vert\\{half}(a+b)-\\{half}(b+c)\bigr\vert
+&\L\textstyle\bigl\vert{1\over2}(a+b)-{1\over2}(b+c)\bigr\vert\cr
+&=\textstyle\bigl\vert{1\over2}(a-b)+{1\over2}(b-c)\bigr\vert
+\L\max\bigl(\vert a-b\vert,\vert b-c\vert\bigr),\cr}$$
+as required. A simpler argument applies if $\vert a-b\vert$ and
+$\vert b-c\vert$ are unequal.) Now it is easy to see that
+$\vert Z_1^{(j+1)}-Z_1^{(j)}\vert\L\bigl\lfloor{1\over2}
+\vert Z_2^{(j)}-Z_1^{(j)}\vert+{1\over2}\bigr\rfloor
+\L\bigl\lfloor{1\over2}(M+1)\bigr\rfloor=\lceil M/2\rceil$.
+
+Another interesting fact about bisection is the identity
+$$Z_1'+\cdots+Z_n'+Z_1''+\cdots+Z_n''=2(Z_1+\cdots+Z_n+E),$$
+where $E$ is the sum of the rounding errors in all of the halving
+operations ($\vert E\vert\L n(n-1)/4$).
+
+@ We will later reduce the problem of digitizing a complex cubic
+$z(t)=B(z_0,z_1,z_2,z_3;t)$ to the following simpler problem:
+Given two real cubics
+$x(t)=B(x_0,x_1,x_2,x_3;t)$
+and $y(t)=B(y_0,y_1,y_2,y_3;t)$ that are monotone nondecreasing,
+determine the set of integer points
+$$P=\bigl\{\bigl(\lfloor x(t)\rfloor,\lfloor y(t)\rfloor\bigr)
+\bigm\vert 0\L t\L 1\bigr\}.$$
+Well, the problem isn't actually quite so clean as this; when the path
+goes very near an integer point $(a,b)$, computational errors may
+make us think that $P$ contains $(a-1,b)$ while in reality it should
+contain $(a,b-1)$. Furthermore, if the path goes {\sl exactly\/}
+through the integer points $(a-1,b-1)$ and
+$(a,b)$, we will want $P$ to contain one
+of the two points $(a-1,b)$ or $(a,b-1)$, so that $P$ can be described
+entirely by ``rook moves'' upwards or to the right; no diagonal
+moves from $(a-1,b-1)$ to~$(a,b)$ will be allowed.
+
+Thus, the set $P$ we wish to compute will merely be an approximation
+to the set described in the formula above. It will consist of
+$\lfloor x(1)\rfloor-\lfloor x(0)\rfloor$ rightward moves and
+$\lfloor y(1)\rfloor-\lfloor y(0)\rfloor$ upward moves, intermixed
+in some order. Our job will be to figure out a suitable order.
+
+The following recursive strategy suggests itself, when we recall that
+$x(0)=x_0$, $x(1)=x_3$, $y(0)=y_0$, and $y(1)=y_3$:
+
+\smallskip
+If $\lfloor x_0\rfloor=\lfloor x_3\rfloor$ then take
+$\lfloor y_3\rfloor-\lfloor y_0\rfloor$ steps up.
+
+Otherwise if $\lfloor y_0\rfloor=\lfloor y_3\rfloor$ then take
+$\lfloor x_3\rfloor-\lfloor x_0\rfloor$ steps to the right.
+
+Otherwise bisect the current cubics and repeat the process on both halves.
+
+\yskip\noindent
+This intuitively appealing formulation does not quite solve the problem,
+because it may never terminate. For example, it's not hard to see that
+no steps will {\sl ever\/} be taken if $(x_0,x_1,x_2,x_3)=(y_0,y_1,y_2,y_3)$!
+However, we can surmount this difficulty with a bit of care; so let's
+proceed to flesh out the algorithm as stated, before worrying about
+such details.
+
+The bisect-and-double strategy discussed above suggests that we represent
+$(x_0,x_1,x_2,x_3)$ by $(X_1,X_2,X_3)$, where $X_k=2^l(x_k-x_{k-1})$
+for some~$l$. Initially $l=16$, since the $x$'s are |scaled|.
+In order to deal with other aspects of the algorithm we will want to
+maintain also the quantities $m=\lfloor x_3\rfloor-\lfloor x_0\rfloor$
+and $R=2^l(x_0\bmod 1)$. Similarly,
+$(y_0,y_1,y_2,y_3)$ will be represented by $(Y_1,Y_2,Y_3)$,
+$n=\lfloor y_3\rfloor-\lfloor y_0\rfloor$,
+and $S=2^l(y_0\bmod 1)$. The algorithm now takes the following form:
+
+\smallskip
+If $m=0$ then take $n$ steps up.
+
+Otherwise if $n=0$ then take $m$ steps to the right.
+
+Otherwise bisect the current cubics and repeat the process on both halves.
+
+\smallskip\noindent
+The bisection process for $(X_1,X_2,X_3,m,R,l)$ reduces, in essence,
+to the following formulas:
+$$\vbox{\halign{$#\hfil$\cr
+X_2'=\\{half}(X_1+X_2),\quad
+X_2''=\\{half}(X_2+X_3),\quad
+X_3'=\\{half}(X_2'+X_2''),\cr
+X_1'=X_1,\quad
+X_1''=X_3',\quad
+X_3''=X_3,\cr
+R'=2R,\quad
+T=X_1'+X_2'+X_3'+R',\quad
+R''=T\bmod 2^{l+1},\cr
+m'=\lfloor T/2^{l+1}\rfloor,\quad
+m''=m-m'.\cr}}$$
+
+@ When $m=n=1$, the computation can be speeded up because we simply
+need to decide between two alternatives, (up,\thinspace right)
+versus (right,\thinspace up). There appears to be no simple, direct
+way to make the correct decision by looking at the values of
+$(X_1,X_2,X_3,R)$ and
+$(Y_1,Y_2,Y_3,S)$; but we can streamline the bisection process, and
+we can use the fact that only one of the two descendants needs to
+be examined after each bisection. Furthermore, we observed earlier
+that after several levels of bisection the $X$'s and $Y$'s will be nearly
+equal; so we will be justified in assuming that the curve is essentially a
+straight line. (This, incidentally, solves the problem of infinite
+recursion mentioned earlier.)
+
+It is possible to show that
+$$m=\bigl\lfloor(X_1+X_2+X_3+R+E)\,/\,2^l\bigr\rfloor,$$
+where $E$ is an accumulated rounding error that is at most
+$3\cdot(2^{l-16}-1)$ in absolute value. We will make sure that
+the $X$'s are less than $2^{28}$; hence when $l=30$ we must
+have |m<=1|. This proves that the special case $m=n=1$ is
+bound to be reached by the time $l=30$. Furthermore $l=30$ is
+a suitable time to make the straight line approximation,
+if the recursion hasn't already died out, because the maximum
+difference between $X$'s will then be $<2^{14}$; this corresponds
+to an error of $<1$ with respect to the original scaling.
+(Stating this another way, each bisection makes the curve two bits
+closer to a straight line, hence 14 bisections are sufficient for
+28-bit accuracy.)
+
+In the case of a straight line, the curve goes first right, then up,
+if and only if $(T-2^l)(2^l-S)>(U-2^l)(2^l-R)$, where
+$T=X_1+X_2+X_3+R$ and $U=Y_1+Y_2+Y_3+S$. For the actual curve
+essentially runs from $(R/2^l,S/2^l)$ to $(T/2^l,U/2^l)$, and
+we are testing whether or not $(1,1)$ is above the straight
+line connecting these two points. (This formula assumes that $(1,1)$
+is not exactly on the line.)
+
+@ We have glossed over the problem of tie-breaking in ambiguous
+cases when the cubic curve passes exactly through integer points.
+\MF\ finesses this problem by assuming that coordinates
+$(x,y)$ actually stand for slightly perturbed values $(x+\xi,y+\eta)$,
+where $\xi$ and~$\eta$ are infinitesimals whose signs will determine
+what to do when $x$ and/or~$y$ are exact integers. The quantities
+$\lfloor x\rfloor$ and~$\lfloor y\rfloor$ in the formulas above
+should actually read $\lfloor x+\xi\rfloor$ and $\lfloor y+\eta\rfloor$.
+
+If $x$ is a |scaled| value, we have $\lfloor x+\xi\rfloor=\lfloor x\rfloor$
+if $\xi>0$, and $\lfloor x+\xi\rfloor=\lfloor x-2^{-16}\rfloor$ if
+$\xi<0$. It is convenient to represent $\xi$ by the integer |xi_corr|,
+defined to be 0~if $\xi>0$ and 1~if $\xi<0$; then, for example, the
+integer $\lfloor x+\xi\rfloor$ can be computed as
+|floor_unscaled(x-xi_corr)|. Similarly, $\eta$ is conveniently
+represented by~|eta_corr|.
+
+In our applications the sign of $\xi-\eta$ will always be the same as
+the sign of $\xi$. Therefore it turns out that the rule for straight
+lines, as stated above, should be modified as follows in the case of
+ties: The line goes first right, then up, if and only if
+$(T-2^l)(2^l-S)+\xi>(U-2^l)(2^l-R)$. And this relation holds iff
+$|ab_vs_cd|(T-2^l,2^l-S,U-2^l,2^l-R)-|xi_corr|\ge0$.
+
+These conventions for rounding are symmetrical, in the sense that the
+digitized moves obtained from $(x_0,x_1,x_2,x_3,y_0,y_1,y_2,y_3,\xi,\eta)$
+will be exactly complementary to the moves that would be obtained from
+$(-x_3,-x_2,-x_1,-x_0,-y_3,-y_2,-y_1,-y_0,-\xi,-\eta)$, if arithmetic
+is exact. However, truncation errors in the bisection process might
+upset the symmetry. We can restore much of the lost symmetry by adding
+|xi_corr| or |eta_corr| when halving the data.
+
+@ One further possibility needs to be mentioned: The algorithm
+will be applied only to cubic polynomials $B(x_0,x_1,x_2,x_3;t)$ that
+are nondecreasing as $t$~varies from 0 to~1; this condition turns
+out to hold if and only if $x_0\L x_1$, $x_2\L x_3$, and either
+$x_1\L x_2$ or $(x_1-x_2)^2\L(x_1-x_0)(x_3-x_2)$. If bisection were
+carried out with perfect accuracy, these relations would remain
+invariant. But rounding errors can creep in, hence the bisection
+algorithm can produce non-monotonic subproblems from monotonic
+initial conditions. This leads to the potential danger that $m$ or~$n$
+could become negative in the algorithm described above.
+
+For example, if we start with $(x_1-x_0,x_2-x_1,x_3-x_2)=
+(X_1,X_2,X_3)=(7,-16,58)$, the corresponding polynomial is
+monotonic, because $16^2<7\cdot39$. But the bisection algorithm
+produces the left descendant $(7,-5,3)$, which is nonmonotonic;
+its right descendant is~$(0,-1,3)$.
+
+\def\xt{{\tilde x}}
+Fortunately we can prove that such rounding errors will never cause
+the algorithm to make a tragic mistake. At every stage we are working
+with numbers corresponding to a cubic polynomial $B(\xt_0,
+\xt_1,\xt_2,\xt_3)$ that approximates some
+monotonic polynomial $B(x_0,x_1,x_2,x_3)$. The accumulated errors are
+controlled so that $\vert x_k-\xt_k\vert<\epsilon=3\cdot2^{-16}$.
+If bisection is done at some stage of the recursion, we have
+$m=\lfloor\xt_3\rfloor-\lfloor\xt_0\rfloor>0$, and the algorithm
+computes a bisection value $\bar x$ such that $m'=\lfloor\bar x\rfloor-
+\lfloor\xt_0\rfloor$
+and $m''=\lfloor\xt_3\rfloor-\lfloor\bar x\rfloor$. We want to prove
+that neither $m'$ nor $m''$ can be negative. Since $\bar x$ is an
+approximation to a value in the interval $[x_0,x_3]$, we have
+$\bar x>x_0-\epsilon$ and $\bar x<x_3+\epsilon$, hence $\bar x>
+\xt_0-2\epsilon$ and $\bar x<\xt_3+2\epsilon$.
+If $m'$ is negative we must have $\xt_0\bmod 1<2\epsilon$;
+if $m''$ is negative we must have $\xt_3\bmod 1>1-2\epsilon$.
+In either case the condition $\lfloor\xt_3\rfloor-\lfloor\xt_0\rfloor>0$
+implies that $\xt_3-\xt_0>1-2\epsilon$, hence $x_3-x_0>1-4\epsilon$.
+But it can be shown that if $B(x_0,x_1,x_2,x_3;t)$ is a monotonic
+cubic, then $B(x_0,x_1,x_2,x_3;{1\over2})$ is always between
+$.14[x_0,x_3]$ and $.86[x_0,x_3]$; and it is impossible for $\bar x$
+to be within~$\epsilon$ of such a number. Contradiction!
+(The constant .14 is actually $(7-\sqrt{28}\,)/12$; the worst case
+occurs for polynomials like $B(0,28-4\sqrt{28},14-5\sqrt{28},42;t)$.)
+
+@ OK, now that a long theoretical preamble has justified the
+bisection-and-doubling algorithm, we are ready to proceed with
+its actual coding. But we still haven't discussed the
+form of the output.
+
+For reasons to be discussed later, we shall find it convenient to
+record the output as follows: Moving one step up is represented by
+appending a `1' to a list; moving one step right is represented by
+adding unity to the element at the end of the list. Thus, for example,
+the net effect of ``(up, right, right, up, right)'' is to append
+$(3,2)$.
+
+The list is kept in a global array called |move|. Before starting the
+algorithm, \MF\ should check that $\\{move\_ptr}+\lfloor y_3\rfloor
+-\lfloor y_0\rfloor\L\\{move\_size}$, so that the list won't exceed
+the bounds of this array.
+
+@<Glob...@>=
+@!move:array[0..move_size] of integer; {the recorded moves}
+@!move_ptr:0..move_size; {the number of items in the |move| list}
+
+@ When bisection occurs, we ``push'' the subproblem corresponding
+to the right-hand subinterval onto the |bisect_stack| while
+we continue to work on the left-hand subinterval. Thus, the |bisect_stack|
+will hold $(X_1,X_2,X_3,R,m,Y_1,Y_2,Y_3,S,n,l)$ values for
+subproblems yet to be tackled.
+
+At most 15 subproblems will be on the stack at once (namely, for
+$l=15$,~16, \dots,~29); but the stack is bigger than this, because
+it is used also for more complicated bisection algorithms.
+
+@d stack_x1==bisect_stack[bisect_ptr] {stacked value of $X_1$}
+@d stack_x2==bisect_stack[bisect_ptr+1] {stacked value of $X_2$}
+@d stack_x3==bisect_stack[bisect_ptr+2] {stacked value of $X_3$}
+@d stack_r==bisect_stack[bisect_ptr+3] {stacked value of $R$}
+@d stack_m==bisect_stack[bisect_ptr+4] {stacked value of $m$}
+@d stack_y1==bisect_stack[bisect_ptr+5] {stacked value of $Y_1$}
+@d stack_y2==bisect_stack[bisect_ptr+6] {stacked value of $Y_2$}
+@d stack_y3==bisect_stack[bisect_ptr+7] {stacked value of $Y_3$}
+@d stack_s==bisect_stack[bisect_ptr+8] {stacked value of $S$}
+@d stack_n==bisect_stack[bisect_ptr+9] {stacked value of $n$}
+@d stack_l==bisect_stack[bisect_ptr+10] {stacked value of $l$}
+@d move_increment=11 {number of items pushed by |make_moves|}
+
+@<Glob...@>=
+@!bisect_stack:array[0..bistack_size] of integer;
+@!bisect_ptr:0..bistack_size;
+
+@ @<Check the ``constant'' values...@>=
+if 15*move_increment>bistack_size then bad:=31;
+
+@ The |make_moves| subroutine is given |scaled| values $(x_0,x_1,x_2,x_3)$
+and $(y_0,y_1,y_2,y_3)$ that represent monotone-nondecreasing polynomials;
+it makes $\lfloor x_3+\xi\rfloor-\lfloor x_0+\xi\rfloor$ rightward moves
+and $\lfloor y_3+\eta\rfloor-\lfloor y_0+\eta\rfloor$ upward moves, as
+explained earlier. (Here $\lfloor x+\xi\rfloor$ actually stands for
+$\lfloor x/2^{16}-|xi_corr|\rfloor$, if $x$ is regarded as an integer
+without scaling.) The unscaled integers $x_k$ and~$y_k$ should be less
+than $2^{28}$ in magnitude.
+
+It is assumed that $|move_ptr| + \lfloor y_3+\eta\rfloor -
+\lfloor y_0+\eta\rfloor < |move_size|$ when this procedure is called,
+so that the capacity of the |move| array will not be exceeded.
+
+The variables |r| and |s| in this procedure stand respectively for
+$R-|xi_corr|$ and $S-|eta_corr|$ in the theory discussed above.
+
+@p procedure make_moves(@!xx0,@!xx1,@!xx2,@!xx3,@!yy0,@!yy1,@!yy2,@!yy3:
+ scaled;@!xi_corr,@!eta_corr:small_number);
+label continue, done, exit;
+var @!x1,@!x2,@!x3,@!m,@!r,@!y1,@!y2,@!y3,@!n,@!s,@!l:integer;
+ {bisection variables explained above}
+@!q,@!t,@!u,@!x2a,@!x3a,@!y2a,@!y3a:integer; {additional temporary registers}
+begin if (xx3<xx0)or(yy3<yy0) then confusion("m");
+@:this can't happen m}{\quad m@>
+l:=16; bisect_ptr:=0;@/
+x1:=xx1-xx0; x2:=xx2-xx1; x3:=xx3-xx2;
+if xx0>=xi_corr then r:=(xx0-xi_corr) mod unity
+else r:=unity-1-((-xx0+xi_corr-1) mod unity);
+m:=(xx3-xx0+r) div unity;@/
+y1:=yy1-yy0; y2:=yy2-yy1; y3:=yy3-yy2;
+if yy0>=eta_corr then s:=(yy0-eta_corr) mod unity
+else s:=unity-1-((-yy0+eta_corr-1) mod unity);
+n:=(yy3-yy0+s) div unity;@/
+if (xx3-xx0>=fraction_one)or(yy3-yy0>=fraction_one) then
+ @<Divide the variables by two, to avoid overflow problems@>;
+loop@+ begin continue:@<Make moves for current subinterval;
+ if bisection is necessary, push the second subinterval
+ onto the stack, and |goto continue| in order to handle
+ the first subinterval@>;
+ if bisect_ptr=0 then return;
+ @<Remove a subproblem for |make_moves| from the stack@>;
+ end;
+exit: end;
+
+@ @<Remove a subproblem for |make_moves| from the stack@>=
+bisect_ptr:=bisect_ptr-move_increment;@/
+x1:=stack_x1; x2:=stack_x2; x3:=stack_x3; r:=stack_r; m:=stack_m;@/
+y1:=stack_y1; y2:=stack_y2; y3:=stack_y3; s:=stack_s; n:=stack_n;@/
+l:=stack_l
+
+@ Our variables |(x1,x2,x3)| correspond to $(X_1,X_2,X_3)$ in the notation
+of the theory developed above. We need to keep them less than $2^{28}$
+in order to avoid integer overflow in weird circumstances.
+For example, data like $x_0=-2^{28}+2^{16}-1$ and $x_1=x_2=x_3=2^{28}-1$
+would otherwise be problematical. Hence this part of the code is
+needed, if only to thwart malicious users.
+
+@<Divide the variables by two, to avoid overflow problems@>=
+begin x1:=half(x1+xi_corr); x2:=half(x2+xi_corr); x3:=half(x3+xi_corr);
+r:=half(r+xi_corr);@/
+y1:=half(y1+eta_corr); y2:=half(y2+eta_corr); y3:=half(y3+eta_corr);
+s:=half(s+eta_corr);@/
+l:=15;
+end
+
+@ @<Make moves...@>=
+if m=0 then @<Move upward |n| steps@>
+else if n=0 then @<Move to the right |m| steps@>
+else if m+n=2 then @<Make one move of each kind@>
+else begin incr(l); stack_l:=l;@/
+ stack_x3:=x3; stack_x2:=half(x2+x3+xi_corr); x2:=half(x1+x2+xi_corr);
+ x3:=half(x2+stack_x2+xi_corr); stack_x1:=x3;@/
+ r:=r+r+xi_corr; t:=x1+x2+x3+r;@/
+ q:=t div two_to_the[l]; stack_r:=t mod two_to_the[l];@/
+ stack_m:=m-q; m:=q;@/
+ stack_y3:=y3; stack_y2:=half(y2+y3+eta_corr); y2:=half(y1+y2+eta_corr);
+ y3:=half(y2+stack_y2+eta_corr); stack_y1:=y3;@/
+ s:=s+s+eta_corr; u:=y1+y2+y3+s;@/
+ q:=u div two_to_the[l]; stack_s:=u mod two_to_the[l];@/
+ stack_n:=n-q; n:=q;@/
+ bisect_ptr:=bisect_ptr+move_increment; goto continue;
+ end
+
+@ @<Move upward |n| steps@>=
+while n>0 do
+ begin incr(move_ptr); move[move_ptr]:=1; decr(n);
+ end
+
+@ @<Move to the right |m| steps@>=
+move[move_ptr]:=move[move_ptr]+m
+
+@ @<Make one move of each kind@>=
+begin r:=two_to_the[l]-r; s:=two_to_the[l]-s;@/
+while l<30 do
+ begin x3a:=x3; x2a:=half(x2+x3+xi_corr); x2:=half(x1+x2+xi_corr);
+ x3:=half(x2+x2a+xi_corr);
+ t:=x1+x2+x3; r:=r+r-xi_corr;@/
+ y3a:=y3; y2a:=half(y2+y3+eta_corr); y2:=half(y1+y2+eta_corr);
+ y3:=half(y2+y2a+eta_corr);
+ u:=y1+y2+y3; s:=s+s-eta_corr;@/
+ if t<r then if u<s then @<Switch to the right subinterval@>
+ else begin @<Move up then right@>; goto done;
+ end
+ else if u<s then
+ begin @<Move right then up@>; goto done;
+ end;
+ incr(l);
+ end;
+r:=r-xi_corr; s:=s-eta_corr;
+if ab_vs_cd(x1+x2+x3,s,y1+y2+y3,r)-xi_corr>=0 then @<Move right then up@>
+ else @<Move up then right@>;
+done:
+end
+
+@ @<Switch to the right subinterval@>=
+begin x1:=x3; x2:=x2a; x3:=x3a; r:=r-t;
+y1:=y3; y2:=y2a; y3:=y3a; s:=s-u;
+end
+
+@ @<Move right then up@>=
+begin incr(move[move_ptr]); incr(move_ptr); move[move_ptr]:=1;
+end
+
+@ @<Move up then right@>=
+begin incr(move_ptr); move[move_ptr]:=2;
+end
+
+@ After |make_moves| has acted, possibly for several curves that move toward
+the same octant, a ``smoothing'' operation might be done on the |move| array.
+This removes optical glitches that can arise even when the curve has been
+digitized without rounding errors.
+
+The smoothing process replaces the integers $a_0\ldots a_n$ in
+|move[b..t]| by ``smoothed'' integers $a_0'\ldots a_n'$ defined as
+follows:
+$$a_k'=a_k+\delta\k-\delta_k;\qquad
+\delta_k=\cases{+1,&if $1<k<n$ and $a_{k-2}\G a_{k-1}\ll a_k\G a\k$;\cr
+-1,&if $1<k<n$ and $a_{k-2}\L a_{k-1}\gg a_k\L a\k$;\cr
+0,&otherwise.\cr}$$
+Here $a\ll b$ means that $a\L b-2$, and $a\gg b$ means that $a\G b+2$.
+
+The smoothing operation is symmetric in the sense that, if $a_0\ldots a_n$
+smoothes to $a_0'\ldots a_n'$, then the reverse sequence $a_n\ldots a_0$
+smoothes to $a_n'\ldots a_0'$; also the complementary sequence
+$(m-a_0)\ldots(m-a_n)$ smoothes to $(m-a_0')\ldots(m-a_n')$.
+We have $a_0'+\cdots+a_n'=a_0+\cdots+a_n$ because $\delta_0=\delta_{n+1}=0$.
+
+@p procedure smooth_moves(@!b,@!t:integer);
+var@!k:1..move_size; {index into |move|}
+@!a,@!aa,@!aaa:integer; {original values of |move[k],move[k-1],move[k-2]|}
+begin if t-b>=3 then
+ begin k:=b+2; aa:=move[k-1]; aaa:=move[k-2];
+ repeat a:=move[k];
+ if abs(a-aa)>1 then
+ @<Increase and decrease |move[k-1]| and |move[k]| by $\delta_k$@>;
+ incr(k); aaa:=aa; aa:=a;
+ until k=t;
+ end;
+end;
+
+@ @<Increase and decrease |move[k-1]| and |move[k]| by $\delta_k$@>=
+if a>aa then
+ begin if aaa>=aa then if a>=move[k+1] then
+ begin incr(move[k-1]); move[k]:=a-1;
+ end;
+ end
+else begin if aaa<=aa then if a<=move[k+1] then
+ begin decr(move[k-1]); move[k]:=a+1;
+ end;
+ end
+
+@* \[20] Edge structures.
+Now we come to \MF's internal scheme for representing what the user can
+actually ``see,'' the edges between pixels. Each pixel has an integer
+weight, obtained by summing the weights on all edges to its left. \MF\
+represents only the nonzero edge weights, since most of the edges are
+weightless; in this way, the data storage requirements grow only linearly
+with respect to the number of pixels per point, even though two-dimensional
+data is being represented. (Well, the actual dependence on the underlying
+resolution is order $n\log n$, but the the $\log n$ factor is buried in our
+implicit restriction on the maximum raster size.) The sum of all edge
+weights in each row should be zero.
+
+The data structure for edge weights must be compact and flexible,
+yet it should support efficient updating and display operations. We
+want to be able to have many different edge structures in memory at
+once, and we want the computer to be able to translate them, reflect them,
+and/or merge them together with relative ease.
+
+\MF's solution to this problem requires one single-word node per
+nonzero edge weight, plus one two-word node for each row in a contiguous
+set of rows. There's also a header node that provides global information
+about the entire structure.
+
+@ Let's consider the edge-weight nodes first. The |info| field of such
+nodes contains both an $m$~value and a weight~$w$, in the form
+$8m+w+c$, where $c$ is a constant that depends on data found in the header.
+We shall consider $c$ in detail later; for now, it's best just to think
+of it as a way to compensate for the fact that $m$ and~$w$ can be negative,
+together with the fact that an |info| field must have a value between
+|min_halfword| and |max_halfword|. The $m$ value is an unscaled $x$~coordinate,
+so it satisfies $\vert m\vert<
+4096$; the $w$ value is always in the range $1\L\vert w\vert\L3$. We can
+unpack the data in the |info| field by fetching |ho(info(p))=
+info(p)-min_halfword| and dividing this nonnegative number by~8;
+the constant~$c$ will be chosen so that the remainder of this division
+is $4+w$. Thus, for example, a remainder of~3 will correspond to
+the edge weight $w=-1$.
+
+Every row of an edge structure contains two lists of such edge-weight
+nodes, called the |sorted| and |unsorted| lists, linked together by their
+|link| fields in the normal way. The difference between them is that we
+always have |info(p)<=info(link(p))| in the |sorted| list, but there's no
+such restriction on the elements of the |unsorted| list. The reason for
+this distinction is that it would take unnecessarily long to maintain
+edge-weight lists in sorted order while they're being updated; but when we
+need to process an entire row from left to right in order of the
+$m$~values, it's fairly easy and quick to sort a short list of unsorted
+elements and to merge them into place among their sorted cohorts.
+Furthermore, the fact that the |unsorted| list is empty can sometimes be
+used to good advantage, because it allows us to conclude that a particular
+row has not changed since the last time we sorted it.
+
+The final |link| of the |sorted| list will be |sentinel|, which points to
+a special one-word node whose |info| field is essentially infinite; this
+facilitates the sorting and merging operations. The final |link| of the
+|unsorted| list will be either |null| or |void|, where |void=null+1|
+is used to avoid redisplaying data that has not changed:
+A |void| value is stored at the head of the
+unsorted list whenever the corresponding row has been displayed.
+
+@d zero_w=4
+@d void==null+1
+
+@<Initialize table entries...@>=
+info(sentinel):=max_halfword; {|link(sentinel)=null|}
+
+@ The rows themselves are represented by row-header nodes that
+contain four link fields. Two of these four, |sorted| and |unsorted|,
+point to the first items of the edge-weight lists just mentioned.
+The other two, |link| and |knil|, point to the headers of the two
+adjacent rows. If |p| points to the header for row number~|n|, then
+|link(p)| points up to the header for row~|n+1|, and |knil(p)| points
+down to the header for row~|n-1|. This double linking makes it
+convenient to move through consecutive rows either upward or downward;
+as usual, we have |link(knil(p))=knil(link(p))=p| for all row headers~|p|.
+
+The row associated with a given value of |n| contains weights for
+edges that run between the lattice points |(m,n)| and |(m,n+1)|.
+
+@d knil==info {inverse of the |link| field, in a doubly linked list}
+@d sorted_loc(#)==#+1 {where the |sorted| link field resides}
+@d sorted(#)==link(sorted_loc(#)) {beginning of the list of sorted edge weights}
+@d unsorted(#)==info(#+1) {beginning of the list of unsorted edge weights}
+@d row_node_size=2 {number of words in a row header node}
+
+@ The main header node |h| for an edge structure has |link| and |knil|
+fields that link it above the topmost row and below the bottommost row.
+It also has fields called |m_min|, |m_max|, |n_min|, and |n_max| that
+bound the current extent of the edge data: All |m| values in edge-weight
+nodes should lie between |m_min(h)-4096| and |m_max(h)-4096|, inclusive.
+Furthermore the topmost row header, pointed to by |knil(h)|,
+is for row number |n_max(h)-4096|; the bottommost row header, pointed to by
+|link(h)|, is for row number |n_min(h)-4096|.
+
+The offset constant |c| that's used in all of the edge-weight data is
+represented implicitly in |m_offset(h)|; its actual value is
+$$\hbox{|c=min_halfword+zero_w+8*m_offset(h)|.}$$
+Notice that it's possible to shift an entire edge structure by an
+amount $(\Delta m,\Delta n)$ by adding $\Delta n$ to |n_min(h)| and |n_max(h)|,
+adding $\Delta m$ to |m_min(h)| and |m_max(h)|, and subtracting
+$\Delta m$ from |m_offset(h)|;
+none of the other edge data needs to be modified. Initially the |m_offset|
+field is~4096, but it will change if the user requests such a shift.
+The contents of these five fields should always be positive and less than
+8192; |n_max| should, in fact, be less than 8191. Furthermore
+|m_min+m_offset-4096| and |m_max+m_offset-4096| must also lie strictly
+between 0 and 8192, so that the |info| fields of edge-weight nodes will
+fit in a halfword.
+
+The header node of an edge structure also contains two somewhat unusual
+fields that are called |last_window(h)| and |last_window_time(h)|. When this
+structure is displayed in window~|k| of the user's screen, after that
+window has been updated |t| times, \MF\ sets |last_window(h):=k| and
+|last_window_time(h):=t|; it also sets |unsorted(p):=void| for all row
+headers~|p|, after merging any existing unsorted weights with the sorted
+ones. A subsequent display in the same window will be able to avoid
+redisplaying rows whose |unsorted| list is still |void|, if the window
+hasn't been used for something else in the meantime.
+
+A pointer to the row header of row |n_pos(h)-4096| is provided in
+|n_rover(h)|. Most of the algorithms that update an edge structure
+are able to get by without random row references; they usually
+access rows that are neighbors of each other or of the current |n_pos| row.
+Exception: If |link(h)=h| (so that the edge structure contains
+no rows), we have |n_rover(h)=h|, and |n_pos(h)| is irrelevant.
+
+@d zero_field=4096 {amount added to coordinates to make them positive}
+@d n_min(#)==info(#+1) {minimum row number present, plus |zero_field|}
+@d n_max(#)==link(#+1) {maximum row number present, plus |zero_field|}
+@d m_min(#)==info(#+2) {minimum column number present, plus |zero_field|}
+@d m_max(#)==link(#+2) {maximum column number present, plus |zero_field|}
+@d m_offset(#)==info(#+3) {translation of $m$ data in edge-weight nodes}
+@d last_window(#)==link(#+3) {the last display went into this window}
+@d last_window_time(#)==mem[#+4].int {after this many window updates}
+@d n_pos(#)==info(#+5) {the row currently in |n_rover|, plus |zero_field|}
+@d n_rover(#)==link(#+5) {a row recently referenced}
+@d edge_header_size=6 {number of words in an edge-structure header}
+@d valid_range(#)==(abs(#-4096)<4096) {is |#| strictly between 0 and 8192?}
+@d empty_edges(#)==link(#)=# {are there no rows in this edge header?}
+
+@p procedure init_edges(@!h:pointer); {initialize an edge header to null values}
+begin knil(h):=h; link(h):=h;@/
+n_min(h):=zero_field+4095; n_max(h):=zero_field-4095;
+m_min(h):=zero_field+4095; m_max(h):=zero_field-4095;
+m_offset(h):=zero_field;@/
+last_window(h):=0; last_window_time(h):=0;@/
+n_rover(h):=h; n_pos(h):=0;@/
+end;
+
+@ When a lot of work is being done on a particular edge structure, we plant
+a pointer to its main header in the global variable |cur_edges|.
+This saves us from having to pass this pointer as a parameter over and
+over again between subroutines.
+
+Similarly, |cur_wt| is a global weight that is being used by several
+procedures at once.
+
+@<Glob...@>=
+@!cur_edges:pointer; {the edge structure of current interest}
+@!cur_wt:integer; {the edge weight of current interest}
+
+@ The |fix_offset| routine goes through all the edge-weight nodes of
+|cur_edges| and adds a constant to their |info| fields, so that
+|m_offset(cur_edges)| can be brought back to |zero_field|. (This
+is necessary only in unusual cases when the offset has gotten too
+large or too small.)
+
+@p procedure fix_offset;
+var @!p,@!q:pointer; {list traversers}
+@!delta:integer; {the amount of change}
+begin delta:=8*(m_offset(cur_edges)-zero_field);
+m_offset(cur_edges):=zero_field;
+q:=link(cur_edges);
+while q<>cur_edges do
+ begin p:=sorted(q);
+ while p<>sentinel do
+ begin info(p):=info(p)-delta; p:=link(p);
+ end;
+ p:=unsorted(q);
+ while p>void do
+ begin info(p):=info(p)-delta; p:=link(p);
+ end;
+ q:=link(q);
+ end;
+end;
+
+@ The |edge_prep| routine makes the |cur_edges| structure ready to
+accept new data whose coordinates satisfy |ml<=m<=mr| and |nl<=n<=nr-1|,
+assuming that |-4096<ml<=mr<4096| and |-4096<nl<=nr<4096|. It makes
+appropriate adjustments to |m_min|, |m_max|, |n_min|, and |n_max|,
+adding new empty rows if necessary.
+
+@p procedure edge_prep(@!ml,@!mr,@!nl,@!nr:integer);
+var @!delta:halfword; {amount of change}
+@!p,@!q:pointer; {for list manipulation}
+begin ml:=ml+zero_field; mr:=mr+zero_field;
+nl:=nl+zero_field; nr:=nr-1+zero_field;@/
+if ml<m_min(cur_edges) then m_min(cur_edges):=ml;
+if mr>m_max(cur_edges) then m_max(cur_edges):=mr;
+if not valid_range(m_min(cur_edges)+m_offset(cur_edges)-zero_field) or@|
+ not valid_range(m_max(cur_edges)+m_offset(cur_edges)-zero_field) then
+ fix_offset;
+if empty_edges(cur_edges) then {there are no rows}
+ begin n_min(cur_edges):=nr+1; n_max(cur_edges):=nr;
+ end;
+if nl<n_min(cur_edges) then
+ @<Insert exactly |n_min(cur_edges)-nl| empty rows at the bottom@>;
+if nr>n_max(cur_edges) then
+ @<Insert exactly |nr-n_max(cur_edges)| empty rows at the top@>;
+end;
+
+@ @<Insert exactly |n_min(cur_edges)-nl| empty rows at the bottom@>=
+begin delta:=n_min(cur_edges)-nl; n_min(cur_edges):=nl;
+p:=link(cur_edges);
+repeat q:=get_node(row_node_size); sorted(q):=sentinel; unsorted(q):=void;
+knil(p):=q; link(q):=p; p:=q; decr(delta);
+until delta=0;
+knil(p):=cur_edges; link(cur_edges):=p;
+if n_rover(cur_edges)=cur_edges then n_pos(cur_edges):=nl-1;
+end
+
+@ @<Insert exactly |nr-n_max(cur_edges)| empty rows at the top@>=
+begin delta:=nr-n_max(cur_edges); n_max(cur_edges):=nr;
+p:=knil(cur_edges);
+repeat q:=get_node(row_node_size); sorted(q):=sentinel; unsorted(q):=void;
+link(p):=q; knil(q):=p; p:=q; decr(delta);
+until delta=0;
+link(p):=cur_edges; knil(cur_edges):=p;
+if n_rover(cur_edges)=cur_edges then n_pos(cur_edges):=nr+1;
+end
+
+@ The |print_edges| subroutine gives a symbolic rendition of an edge
+structure, for use in `\&{show}' commands. A rather terse output
+format has been chosen since edge structures can grow quite large.
+
+@<Declare subroutines for printing expressions@>=
+@t\4@>@<Declare the procedure called |print_weight|@>@;@/
+procedure print_edges(@!s:str_number;@!nuline:boolean;@!x_off,@!y_off:integer);
+var @!p,@!q,@!r:pointer; {for list traversal}
+@!n:integer; {row number}
+begin print_diagnostic("Edge structure",s,nuline);
+p:=knil(cur_edges); n:=n_max(cur_edges)-zero_field;
+while p<>cur_edges do
+ begin q:=unsorted(p); r:=sorted(p);
+ if(q>void)or(r<>sentinel) then
+ begin print_nl("row "); print_int(n+y_off); print_char(":");
+ while q>void do
+ begin print_weight(q,x_off); q:=link(q);
+ end;
+ print(" |");
+ while r<>sentinel do
+ begin print_weight(r,x_off); r:=link(r);
+ end;
+ end;
+ p:=knil(p); decr(n);
+ end;
+end_diagnostic(true);
+end;
+
+@ @<Declare the procedure called |print_weight|@>=
+procedure print_weight(@!q:pointer;@!x_off:integer);
+var @!w,@!m:integer; {unpacked weight and coordinate}
+@!d:integer; {temporary data register}
+begin d:=ho(info(q)); w:=d mod 8; m:=(d div 8)-m_offset(cur_edges);
+if file_offset>max_print_line-9 then print_nl(" ")
+else print_char(" ");
+print_int(m+x_off);
+while w>zero_w do
+ begin print_char("+"); decr(w);
+ end;
+while w<zero_w do
+ begin print_char("-"); incr(w);
+ end;
+end;
+
+@ Here's a trivial subroutine that copies an edge structure. (Let's hope
+that the given structure isn't too gigantic.)
+
+@p function copy_edges(@!h:pointer):pointer;
+var @!p,@!r:pointer; {variables that traverse the given structure}
+@!hh,@!pp,@!qq,@!rr,@!ss:pointer; {variables that traverse the new structure}
+begin hh:=get_node(edge_header_size);
+mem[hh+1]:=mem[h+1]; mem[hh+2]:=mem[h+2];
+mem[hh+3]:=mem[h+3]; mem[hh+4]:=mem[h+4]; {we've now copied |n_min|, |n_max|,
+ |m_min|, |m_max|, |m_offset|, |last_window|, and |last_window_time|}
+n_pos(hh):=n_max(hh)+1;n_rover(hh):=hh;@/
+p:=link(h); qq:=hh;
+while p<>h do
+ begin pp:=get_node(row_node_size); link(qq):=pp; knil(pp):=qq;
+ @<Copy both |sorted| and |unsorted| lists of |p| to |pp|@>;
+ p:=link(p); qq:=pp;
+ end;
+link(qq):=hh; knil(hh):=qq;
+copy_edges:=hh;
+end;
+
+@ @<Copy both |sorted| and |unsorted|...@>=
+r:=sorted(p); rr:=sorted_loc(pp); {|link(rr)=sorted(pp)|}
+while r<>sentinel do
+ begin ss:=get_avail; link(rr):=ss; rr:=ss; info(rr):=info(r);@/
+ r:=link(r);
+ end;
+link(rr):=sentinel;@/
+r:=unsorted(p); rr:=temp_head;
+while r>void do
+ begin ss:=get_avail; link(rr):=ss; rr:=ss; info(rr):=info(r);@/
+ r:=link(r);
+ end;
+link(rr):=r; unsorted(pp):=link(temp_head)
+
+@ Another trivial routine flips |cur_edges| about the |x|-axis
+(i.e., negates all the |y| coordinates), assuming that at least
+one row is present.
+
+@p procedure y_reflect_edges;
+var @!p,@!q,@!r:pointer; {list manipulation registers}
+begin p:=n_min(cur_edges);
+n_min(cur_edges):=zero_field+zero_field-1-n_max(cur_edges);
+n_max(cur_edges):=zero_field+zero_field-1-p;
+n_pos(cur_edges):=zero_field+zero_field-1-n_pos(cur_edges);@/
+p:=link(cur_edges); q:=cur_edges; {we assume that |p<>q|}
+repeat r:=link(p); link(p):=q; knil(q):=p; q:=p; p:=r;
+until q=cur_edges;
+last_window_time(cur_edges):=0;
+end;
+
+@ It's somewhat more difficult, yet not too hard, to reflect about the |y|-axis.
+
+@p procedure x_reflect_edges;
+var @!p,@!q,@!r,@!s:pointer; {list manipulation registers}
+@!m:integer; {|info| fields will be reflected with respect to this number}
+begin p:=m_min(cur_edges);
+m_min(cur_edges):=zero_field+zero_field-m_max(cur_edges);
+m_max(cur_edges):=zero_field+zero_field-p;
+m:=(zero_field+m_offset(cur_edges))*8+zero_w+min_halfword+zero_w+min_halfword;
+m_offset(cur_edges):=zero_field;
+p:=link(cur_edges);
+repeat @<Reflect the edge-and-weight data in |sorted(p)|@>;
+@<Reflect the edge-and-weight data in |unsorted(p)|@>;
+p:=link(p);
+until p=cur_edges;
+last_window_time(cur_edges):=0;
+end;
+
+@ We want to change the sign of the weight as we change the sign of the
+|x|~coordinate. Fortunately, it's easier to do this than to negate
+one without the other.
+
+@<Reflect the edge-and-weight data in |unsorted(p)|@>=
+q:=unsorted(p);
+while q>void do
+ begin info(q):=m-info(q); q:=link(q);
+ end
+
+@ Reversing the order of a linked list is best thought of as the process of
+popping nodes off one stack and pushing them on another. In this case we
+pop from stack~|q| and push to stack~|r|.
+
+@<Reflect the edge-and-weight data in |sorted(p)|@>=
+q:=sorted(p); r:=sentinel;
+while q<>sentinel do
+ begin s:=link(q); link(q):=r; r:=q; info(r):=m-info(q); q:=s;
+ end;
+sorted(p):=r
+
+@ Now let's multiply all the $y$~coordinates of a nonempty edge structure
+by a small integer $s>1$:
+
+@p procedure y_scale_edges(@!s:integer);
+var @!p,@!q,@!pp,@!r,@!rr,@!ss:pointer; {list manipulation registers}
+@!t:integer; {replication counter}
+begin if (s*(n_max(cur_edges)+1-zero_field)>=4096) or@|
+ (s*(n_min(cur_edges)-zero_field)<=-4096) then
+ begin print_err("Scaled picture would be too big");
+@.Scaled picture...big@>
+ help3("I can't yscale the picture as requested---it would")@/
+ ("make some coordinates too large or too small.")@/
+ ("Proceed, and I'll omit the transformation.");
+ put_get_error;
+ end
+else begin n_max(cur_edges):=s*(n_max(cur_edges)+1-zero_field)-1+zero_field;
+ n_min(cur_edges):=s*(n_min(cur_edges)-zero_field)+zero_field;
+ @<Replicate every row exactly $s$ times@>;
+ last_window_time(cur_edges):=0;
+ end;
+end;
+
+@ @<Replicate...@>=
+p:=cur_edges;
+repeat q:=p; p:=link(p);
+for t:=2 to s do
+ begin pp:=get_node(row_node_size); link(q):=pp; knil(p):=pp;
+ link(pp):=p; knil(pp):=q; q:=pp;
+ @<Copy both |sorted| and |unsorted|...@>;
+ end;
+until link(p)=cur_edges
+
+@ Scaling the $x$~coordinates is, of course, our next task.
+
+@p procedure x_scale_edges(@!s:integer);
+var @!p,@!q:pointer; {list manipulation registers}
+@!t:0..65535; {unpacked |info| field}
+@!w:0..7; {unpacked weight}
+@!delta:integer; {amount added to scaled |info|}
+begin if (s*(m_max(cur_edges)-zero_field)>=4096) or@|
+ (s*(m_min(cur_edges)-zero_field)<=-4096) then
+ begin print_err("Scaled picture would be too big");
+@.Scaled picture...big@>
+ help3("I can't xscale the picture as requested---it would")@/
+ ("make some coordinates too large or too small.")@/
+ ("Proceed, and I'll omit the transformation.");
+ put_get_error;
+ end
+else if (m_max(cur_edges)<>zero_field)or(m_min(cur_edges)<>zero_field) then
+ begin m_max(cur_edges):=s*(m_max(cur_edges)-zero_field)+zero_field;
+ m_min(cur_edges):=s*(m_min(cur_edges)-zero_field)+zero_field;
+ delta:=8*(zero_field-s*m_offset(cur_edges))+min_halfword;
+ m_offset(cur_edges):=zero_field;@/
+ @<Scale the $x$~coordinates of each row by $s$@>;
+ last_window_time(cur_edges):=0;
+ end;
+end;
+
+@ The multiplications cannot overflow because we know that |s<4096|.
+
+@<Scale the $x$~coordinates of each row by $s$@>=
+q:=link(cur_edges);
+repeat p:=sorted(q);
+while p<>sentinel do
+ begin t:=ho(info(p)); w:=t mod 8; info(p):=(t-w)*s+w+delta; p:=link(p);
+ end;
+p:=unsorted(q);
+while p>void do
+ begin t:=ho(info(p)); w:=t mod 8; info(p):=(t-w)*s+w+delta; p:=link(p);
+ end;
+q:=link(q);
+until q=cur_edges
+
+@ Here is a routine that changes the signs of all the weights, without
+changing anything else.
+
+@p procedure negate_edges(@!h:pointer);
+label done;
+var @!p,@!q,@!r,@!s,@!t,@!u:pointer; {structure traversers}
+begin p:=link(h);
+while p<>h do
+ begin q:=unsorted(p);
+ while q>void do
+ begin info(q):=8-2*((ho(info(q))) mod 8)+info(q); q:=link(q);
+ end;
+ q:=sorted(p);
+ if q<>sentinel then
+ begin repeat info(q):=8-2*((ho(info(q))) mod 8)+info(q); q:=link(q);
+ until q=sentinel;
+ @<Put the list |sorted(p)| back into sort@>;
+ end;
+ p:=link(p);
+ end;
+last_window_time(h):=0;
+end;
+
+@ \MF\ would work even if the code in this section were omitted, because
+a list of edge-and-weight data that is sorted only by
+|m| but not~|w| turns out to be good enough for correct operation.
+However, the author decided not to make the program even trickier than
+it is already, since |negate_edges| isn't needed very often.
+The simpler-to-state condition, ``keep the |sorted| list fully sorted,''
+is therefore being preserved at the cost of extra computation.
+
+@<Put the list |sorted(p)|...@>=
+u:=sorted_loc(p); q:=link(u); r:=q; s:=link(r); {|q=sorted(p)|}
+loop@+ if info(s)>info(r) then
+ begin link(u):=q;
+ if s=sentinel then goto done;
+ u:=r; q:=s; r:=q; s:=link(r);
+ end
+ else begin t:=s; s:=link(t); link(t):=q; q:=t;
+ end;
+done: link(r):=sentinel
+
+@ The |unsorted| edges of a row are merged into the |sorted| ones by
+a subroutine called |sort_edges|. It uses simple insertion sort,
+followed by a merge, because the unsorted list is supposedly quite short.
+However, the unsorted list is assumed to be nonempty.
+
+@p procedure sort_edges(@!h:pointer); {|h| is a row header}
+label done;
+var @!k:halfword; {key register that we compare to |info(q)|}
+@!p,@!q,@!r,@!s:pointer;
+begin r:=unsorted(h); unsorted(h):=null;
+p:=link(r); link(r):=sentinel; link(temp_head):=r;
+while p>void do {sort node |p| into the list that starts at |temp_head|}
+ begin k:=info(p); q:=temp_head;
+ repeat r:=q; q:=link(r);
+ until k<=info(q);
+ link(r):=p; r:=link(p); link(p):=q; p:=r;
+ end;
+@<Merge the |temp_head| list into |sorted(h)|@>;
+end;
+
+@ In this step we use the fact that |sorted(h)=link(sorted_loc(h))|.
+
+@<Merge the |temp_head| list into |sorted(h)|@>=
+begin r:=sorted_loc(h); q:=link(r); p:=link(temp_head);
+loop@+ begin k:=info(p);
+ while k>info(q) do
+ begin r:=q; q:=link(r);
+ end;
+ link(r):=p; s:=link(p); link(p):=q;
+ if s=sentinel then goto done;
+ r:=p; p:=s;
+ end;
+done:end
+
+@ The |cull_edges| procedure ``optimizes'' an edge structure by making all
+the pixel weights either |w_out| or~|w_in|. The weight will be~|w_in| after the
+operation if and only if it was in the closed interval |[w_lo,w_hi]|
+before, where |w_lo<=w_hi|. Either |w_out| or |w_in| is zero, while the other is
+$\pm1$, $\pm2$, or $\pm3$. The parameters will be such that zero-weight
+pixels will remain of weight zero. (This is fortunate,
+because there are infinitely many of them.)
+
+The procedure also computes the tightest possible bounds on the resulting
+data, by updating |m_min|, |m_max|, |n_min|, and~|n_max|.
+
+@p procedure cull_edges(@!w_lo,@!w_hi,@!w_out,@!w_in:integer);
+label done;
+var @!p,@!q,@!r,@!s:pointer; {for list manipulation}
+@!w:integer; {new weight after culling}
+@!d:integer; {data register for unpacking}
+@!m:integer; {the previous column number, including |m_offset|}
+@!mm:integer; {the next column number, including |m_offset|}
+@!ww:integer; {accumulated weight before culling}
+@!prev_w:integer; {value of |w| before column |m|}
+@!n,@!min_n,@!max_n:pointer; {current and extreme row numbers}
+@!min_d,@!max_d:pointer; {extremes of the new edge-and-weight data}
+begin min_d:=max_halfword; max_d:=min_halfword;
+min_n:=max_halfword; max_n:=min_halfword;@/
+p:=link(cur_edges); n:=n_min(cur_edges);
+while p<>cur_edges do
+ begin if unsorted(p)>void then sort_edges(p);
+ if sorted(p)<>sentinel then
+ @<Cull superfluous edge-weight entries from |sorted(p)|@>;
+ p:=link(p); incr(n);
+ end;
+@<Delete empty rows at the top and/or bottom;
+ update the boundary values in the header@>;
+last_window_time(cur_edges):=0;
+end;
+
+@ The entire |sorted| list is returned to available memory in this step;
+a new list is built starting (temporarily) at |temp_head|.
+Since several edges can occur at the same column, we need to be looking
+ahead of where the actual culling takes place. This means that it's
+slightly tricky to get the iteration started and stopped.
+
+@<Cull superfluous...@>=
+begin r:=temp_head; q:=sorted(p); ww:=0; m:=1000000; prev_w:=0;
+loop@+ begin if q=sentinel then mm:=1000000
+ else begin d:=ho(info(q)); mm:=d div 8; ww:=ww+(d mod 8)-zero_w;
+ end;
+ if mm>m then
+ begin @<Insert an edge-weight for edge |m|, if the new pixel
+ weight has changed@>;
+ if q=sentinel then goto done;
+ end;
+ m:=mm;
+ if ww>=w_lo then if ww<=w_hi then w:=w_in
+ else w:=w_out
+ else w:=w_out;
+ s:=link(q); free_avail(q); q:=s;
+ end;
+done: link(r):=sentinel; sorted(p):=link(temp_head);
+if r<>temp_head then @<Update the max/min amounts@>;
+end
+
+@ @<Insert an edge-weight for edge |m|, if...@>=
+if w<>prev_w then
+ begin s:=get_avail; link(r):=s;
+ info(s):=8*m+min_halfword+zero_w+w-prev_w;
+ r:=s; prev_w:=w;
+ end
+
+@ @<Update the max/min amounts@>=
+begin if min_n=max_halfword then min_n:=n;
+max_n:=n;
+if min_d>info(link(temp_head)) then min_d:=info(link(temp_head));
+if max_d<info(r) then max_d:=info(r);
+end
+
+@ @<Delete empty rows at the top and/or bottom...@>=
+if min_n>max_n then @<Delete all the row headers@>
+else begin n:=n_min(cur_edges); n_min(cur_edges):=min_n;
+ while min_n>n do
+ begin p:=link(cur_edges); link(cur_edges):=link(p);
+ knil(link(p)):=cur_edges;
+ free_node(p,row_node_size); incr(n);
+ end;
+ n:=n_max(cur_edges); n_max(cur_edges):=max_n;
+ n_pos(cur_edges):=max_n+1; n_rover(cur_edges):=cur_edges;
+ while max_n<n do
+ begin p:=knil(cur_edges); knil(cur_edges):=knil(p);
+ link(knil(p)):=cur_edges;
+ free_node(p,row_node_size); decr(n);
+ end;
+ m_min(cur_edges):=((ho(min_d)) div 8)-m_offset(cur_edges)+zero_field;
+ m_max(cur_edges):=((ho(max_d)) div 8)-m_offset(cur_edges)+zero_field;
+ end
+
+@ We get here if the edges have been entirely culled away.
+
+@<Delete all the row headers@>=
+begin p:=link(cur_edges);
+while p<>cur_edges do
+ begin q:=link(p); free_node(p,row_node_size); p:=q;
+ end;
+init_edges(cur_edges);
+end
+
+
+@ The last and most difficult routine for transforming an edge structure---and
+the most interesting one!---is |xy_swap_edges|, which interchanges the
+r\^^Doles of rows and columns. Its task can be viewed as the job of
+creating an edge structure that contains only horizontal edges, linked
+together in columns, given an edge structure that contains only
+vertical edges linked together in rows; we must do this without changing
+the implied pixel weights.
+
+Given any two adjacent rows of an edge structure, it is not difficult to
+determine the horizontal edges that lie ``between'' them: We simply look
+for vertically adjacent pixels that have different weight, and insert
+a horizontal edge containing the difference in weights. Every horizontal
+edge determined in this way should be put into an appropriate linked
+list. Since random access to these linked lists is desirable, we use
+the |move| array to hold the list heads. If we work through the given
+edge structure from top to bottom, the constructed lists will not need
+to be sorted, since they will already be in order.
+
+The following algorithm makes use of some ideas suggested by John Hobby.
+@^Hobby, John Douglas@>
+It assumes that the edge structure is non-null, i.e., that |link(cur_edges)
+<>cur_edges|, hence |m_max(cur_edges)>=m_min(cur_edges)|.
+
+@p procedure xy_swap_edges; {interchange |x| and |y| in |cur_edges|}
+label done;
+var @!m_magic,@!n_magic:integer; {special values that account for offsets}
+@!p,@!q,@!r,@!s:pointer; {pointers that traverse the given structure}
+@<Other local variables for |xy_swap_edges|@>@;
+begin @<Initialize the array of new edge list heads@>;
+@<Insert blank rows at the top and bottom, and set |p| to the new top row@>;
+@<Compute the magic offset values@>;
+repeat q:=knil(p);@+if unsorted(q)>void then sort_edges(q);
+@<Insert the horizontal edges defined by adjacent rows |p,q|,
+ and destroy row~|p|@>;
+p:=q; n_magic:=n_magic-8;
+until knil(p)=cur_edges;
+free_node(p,row_node_size); {now all original rows have been recycled}
+@<Adjust the header to reflect the new edges@>;
+end;
+
+@ Here we don't bother to keep the |link| entries up to date, since the
+procedure looks only at the |knil| fields as it destroys the former
+edge structure.
+
+@<Insert blank rows at the top and bottom...@>=
+p:=get_node(row_node_size); sorted(p):=sentinel; unsorted(p):=null;@/
+knil(p):=cur_edges; knil(link(cur_edges)):=p; {the new bottom row}
+p:=get_node(row_node_size); sorted(p):=sentinel;
+knil(p):=knil(cur_edges); {the new top row}
+
+@ The new lists will become |sorted| lists later, so we initialize
+empty lists to |sentinel|.
+
+@<Initialize the array of new edge list heads@>=
+m_spread:=m_max(cur_edges)-m_min(cur_edges); {this is |>=0| by assumption}
+if m_spread>move_size then overflow("move table size",move_size);
+@:METAFONT capacity exceeded move table size}{\quad move table size@>
+for j:=0 to m_spread do move[j]:=sentinel
+
+@ @<Other local variables for |xy_swap_edges|@>=
+@!m_spread:integer; {the difference between |m_max| and |m_min|}
+@!j,@!jj:0..move_size; {indices into |move|}
+@!m,@!mm:integer; {|m| values at vertical edges}
+@!pd,@!rd:integer; {data fields from edge-and-weight nodes}
+@!pm,@!rm:integer; {|m| values from edge-and-weight nodes}
+@!w:integer; {the difference in accumulated weight}
+@!ww:integer; {as much of |w| that can be stored in a single node}
+@!dw:integer; {an increment to be added to |w|}
+
+@ At the point where we test |w<>0|, variable |w| contains
+the accumulated weight from edges already passed in
+row~|p| minus the accumulated weight from edges already passed in row~|q|.
+
+@<Insert the horizontal edges defined by adjacent rows |p,q|...@>=
+r:=sorted(p); free_node(p,row_node_size); p:=r;@/
+pd:=ho(info(p)); pm:=pd div 8;@/
+r:=sorted(q); rd:=ho(info(r)); rm:=rd div 8; w:=0;
+loop@+ begin if pm<rm then mm:=pm@+else mm:=rm;
+ if w<>0 then
+ @<Insert horizontal edges of weight |w| between |m| and~|mm|@>;
+ if pd<rd then
+ begin dw:=(pd mod 8)-zero_w;
+ @<Advance pointer |p| to the next vertical edge,
+ after destroying the previous one@>;
+ end
+ else begin if r=sentinel then goto done; {|rd=pd=ho(max_halfword)|}
+ dw:=-((rd mod 8)-zero_w);
+ @<Advance pointer |r| to the next vertical edge@>;
+ end;
+ m:=mm; w:=w+dw;
+ end;
+done:
+
+@ @<Advance pointer |r| to the next vertical edge@>=
+r:=link(r); rd:=ho(info(r)); rm:=rd div 8
+
+@ @<Advance pointer |p| to the next vertical edge...@>=
+s:=link(p); free_avail(p); p:=s; pd:=ho(info(p)); pm:=pd div 8
+
+@ Certain ``magic'' values are needed to make the following code work,
+because of the various offsets in our data structure. For now, let's not
+worry about their precise values; we shall compute |m_magic| and |n_magic|
+later, after we see what the code looks like.
+
+@ @<Insert horizontal edges of weight |w| between |m| and~|mm|@>=
+if m<>mm then
+ begin if mm-m_magic>=move_size then confusion("xy");
+@:this can't happen xy}{\quad xy@>
+ extras:=(abs(w)-1) div 3;
+ if extras>0 then
+ begin if w>0 then xw:=+3@+else xw:=-3;
+ ww:=w-extras*xw;
+ end
+ else ww:=w;
+ repeat j:=m-m_magic;
+ for k:=1 to extras do
+ begin s:=get_avail; info(s):=n_magic+xw;
+ link(s):=move[j]; move[j]:=s;
+ end;
+ s:=get_avail; info(s):=n_magic+ww;
+ link(s):=move[j]; move[j]:=s;@/
+ incr(m);
+ until m=mm;
+ end
+
+@ @<Other local variables for |xy...@>=
+@!extras:integer; {the number of additional nodes to make weights |>3|}
+@!xw:-3..3; {the additional weight in extra nodes}
+@!k:integer; {loop counter for inserting extra nodes}
+
+@ At the beginning of this step, |move[m_spread]=sentinel|, because no
+horizontal edges will extend to the right of column |m_max(cur_edges)|.
+
+@<Adjust the header to reflect the new edges@>=
+move[m_spread]:=0; j:=0;
+while move[j]=sentinel do incr(j);
+if j=m_spread then init_edges(cur_edges) {all edge weights are zero}
+else begin mm:=m_min(cur_edges);
+ m_min(cur_edges):=n_min(cur_edges);
+ m_max(cur_edges):=n_max(cur_edges)+1;
+ m_offset(cur_edges):=zero_field;
+ jj:=m_spread-1;
+ while move[jj]=sentinel do decr(jj);
+ n_min(cur_edges):=j+mm; n_max(cur_edges):=jj+mm; q:=cur_edges;
+ repeat p:=get_node(row_node_size); link(q):=p; knil(p):=q;
+ sorted(p):=move[j]; unsorted(p):=null; incr(j); q:=p;
+ until j>jj;
+ link(q):=cur_edges; knil(cur_edges):=q;
+ n_pos(cur_edges):=n_max(cur_edges)+1; n_rover(cur_edges):=cur_edges;
+ last_window_time(cur_edges):=0;
+ end;
+
+@ The values of |m_magic| and |n_magic| can be worked out by trying the
+code above on a small example; if they work correctly in simple cases,
+they should work in general.
+
+@<Compute the magic offset values@>=
+m_magic:=m_min(cur_edges)+m_offset(cur_edges)-zero_field;
+n_magic:=8*n_max(cur_edges)+8+zero_w+min_halfword
+
+@ Now let's look at the subroutine that merges the edges from a given
+edge structure into |cur_edges|. The given edge structure loses all its
+edges.
+
+@p procedure merge_edges(@!h:pointer);
+label done;
+var @!p,@!q,@!r,@!pp,@!qq,@!rr:pointer; {list manipulation registers}
+@!n:integer; {row number}
+@!k:halfword; {key register that we compare to |info(q)|}
+@!delta:integer; {change to the edge/weight data}
+begin if link(h)<>h then
+ begin if (m_min(h)<m_min(cur_edges))or(m_max(h)>m_max(cur_edges))or@|
+ (n_min(h)<n_min(cur_edges))or(n_max(h)>n_max(cur_edges)) then
+ edge_prep(m_min(h)-zero_field,m_max(h)-zero_field,
+ n_min(h)-zero_field,n_max(h)-zero_field+1);
+ if m_offset(h)<>m_offset(cur_edges) then
+ @<Adjust the data of |h| to account for a difference of offsets@>;
+ n:=n_min(cur_edges); p:=link(cur_edges); pp:=link(h);
+ while n<n_min(h) do
+ begin incr(n); p:=link(p);
+ end;
+ repeat @<Merge row |pp| into row |p|@>;
+ pp:=link(pp); p:=link(p);
+ until pp=h;
+ end;
+end;
+
+@ @<Adjust the data of |h| to account for a difference of offsets@>=
+begin pp:=link(h); delta:=8*(m_offset(cur_edges)-m_offset(h));
+repeat qq:=sorted(pp);
+while qq<>sentinel do
+ begin info(qq):=info(qq)+delta; qq:=link(qq);
+ end;
+qq:=unsorted(pp);
+while qq>void do
+ begin info(qq):=info(qq)+delta; qq:=link(qq);
+ end;
+pp:=link(pp);
+until pp=h;
+end
+
+@ The |sorted| and |unsorted| lists are merged separately. After this
+step, row~|pp| will have no edges remaining, since they will all have
+been merged into row~|p|.
+
+@<Merge row |pp|...@>=
+qq:=unsorted(pp);
+if qq>void then
+ if unsorted(p)<=void then unsorted(p):=qq
+ else begin while link(qq)>void do qq:=link(qq);
+ link(qq):=unsorted(p); unsorted(p):=unsorted(pp);
+ end;
+unsorted(pp):=null; qq:=sorted(pp);
+if qq<>sentinel then
+ begin if unsorted(p)=void then unsorted(p):=null;
+ sorted(pp):=sentinel; r:=sorted_loc(p); q:=link(r); {|q=sorted(p)|}
+ if q=sentinel then sorted(p):=qq
+ else loop@+begin k:=info(qq);
+ while k>info(q) do
+ begin r:=q; q:=link(r);
+ end;
+ link(r):=qq; rr:=link(qq); link(qq):=q;
+ if rr=sentinel then goto done;
+ r:=qq; qq:=rr;
+ end;
+ end;
+done:
+
+@ The |total_weight| routine computes the total of all pixel weights
+in a given edge structure. It's not difficult to prove that this is
+the sum of $(-w)$ times $x$ taken over all edges,
+where $w$ and~$x$ are the weight and $x$~coordinates stored in an edge.
+It's not necessary to worry that this quantity will overflow the
+size of an |integer| register, because it will be less than~$2^{31}$
+unless the edge structure has more than 174,762 edges. However, we had
+better not try to compute it as a |scaled| integer, because a total
+weight of almost $12\times 2^{12}$ can be produced by only four edges.
+
+@p function total_weight(@!h:pointer):integer; {|h| is an edge header}
+var @!p,@!q:pointer; {variables that traverse the given structure}
+@!n:integer; {accumulated total so far}
+@!m:0..65535; {packed $x$ and $w$ values, including offsets}
+begin n:=0; p:=link(h);
+while p<>h do
+ begin q:=sorted(p);
+ while q<>sentinel do
+ @<Add the contribution of node |q| to the total weight,
+ and set |q:=link(q)|@>;
+ q:=unsorted(p);
+ while q>void do
+ @<Add the contribution of node |q| to the total weight,
+ and set |q:=link(q)|@>;
+ p:=link(p);
+ end;
+total_weight:=n;
+end;
+
+@ It's not necessary to add the offsets to the $x$ coordinates, because
+an entire edge structure can be shifted without affecting its total weight.
+Similarly, we don't need to subtract |zero_field|.
+
+@<Add the contribution of node |q| to the total weight...@>=
+begin m:=ho(info(q)); n:=n-((m mod 8)-zero_w)*(m div 8);
+q:=link(q);
+end
+
+@ So far we've done lots of things to edge structures assuming that
+edges are actually present, but we haven't seen how edges get created
+in the first place. Let's turn now to the problem of generating new edges.
+
+\MF\ will display new edges as they are being computed, if |tracing_edges|
+is positive. In order to keep such data reasonably compact, only the
+points at which the path makes a $90^\circ$ or $180^\circ$ turn are listed.
+
+The tracing algorithm must remember some past history in order to suppress
+unnecessary data. Three variables |trace_x|, |trace_y|, and |trace_yy|
+provide this history: The last coordinates printed were |(trace_x,trace_y)|,
+and the previous edge traced ended at |(trace_x,trace_yy)|. Before anything
+at all has been traced, |trace_x=-4096|.
+
+@<Glob...@>=
+@!trace_x:integer; {$x$~coordinate most recently shown in a trace}
+@!trace_y:integer; {$y$~coordinate most recently shown in a trace}
+@!trace_yy:integer; {$y$~coordinate most recently encountered}
+
+@ Edge tracing is initiated by the |begin_edge_tracing| routine,
+continued by the |trace_a_corner| routine, and terminated by the
+|end_edge_tracing| routine.
+
+@p procedure begin_edge_tracing;
+begin print_diagnostic("Tracing edges","",true);
+print(" (weight "); print_int(cur_wt); print_char(")"); trace_x:=-4096;
+end;
+@#
+procedure trace_a_corner;
+begin if file_offset>max_print_line-13 then print_nl("");
+print_char("("); print_int(trace_x); print_char(","); print_int(trace_yy);
+print_char(")"); trace_y:=trace_yy;
+end;
+@#
+procedure end_edge_tracing;
+begin if trace_x=-4096 then print_nl("(No new edges added.)")
+@.No new edges added@>
+else begin trace_a_corner; print_char(".");
+ end;
+end_diagnostic(true);
+end;
+
+@ Just after a new edge weight has been put into the |info| field of
+node~|r|, in row~|n|, the following routine continues an ongoing trace.
+
+@p procedure trace_new_edge(@!r:pointer;@!n:integer);
+var @!d:integer; {temporary data register}
+@!w:-3..3; {weight associated with an edge transition}
+@!m,@!n0,@!n1:integer; {column and row numbers}
+begin d:=ho(info(r)); w:=(d mod 8)-zero_w; m:=(d div 8)-m_offset(cur_edges);
+if w=cur_wt then
+ begin n0:=n+1; n1:=n;
+ end
+else begin n0:=n; n1:=n+1;
+ end; {the edges run from |(m,n0)| to |(m,n1)|}
+if m<>trace_x then
+ begin if trace_x=-4096 then
+ begin print_nl(""); trace_yy:=n0;
+ end
+ else if trace_yy<>n0 then print_char("?") {shouldn't happen}
+ else trace_a_corner;
+ trace_x:=m; trace_a_corner;
+ end
+else begin if n0<>trace_yy then print_char("!"); {shouldn't happen}
+ if ((n0<n1)and(trace_y>trace_yy))or((n0>n1)and(trace_y<trace_yy)) then
+ trace_a_corner;
+ end;
+trace_yy:=n1;
+end;
+
+@ One way to put new edge weights into an edge structure is to use the
+following routine, which simply draws a straight line from |(x0,y0)| to
+|(x1,y1)|. More precisely, it introduces weights for the edges of the
+discrete path $\bigl(\lfloor t[x_0,x_1]+{1\over2}+\epsilon\rfloor,
+\lfloor t[y_0,y_1]+{1\over2}+\epsilon\delta\rfloor\bigr)$,
+as $t$ varies from 0 to~1, where $\epsilon$ and $\delta$ are extremely small
+positive numbers.
+
+The structure header is assumed to be |cur_edges|; downward edge weights
+will be |cur_wt|, while upward ones will be |-cur_wt|.
+
+Of course, this subroutine will be called only in connection with others
+that eventually draw a complete cycle, so that the sum of the edge weights
+in each row will be zero whenever the row is displayed.
+
+@p procedure line_edges(@!x0,@!y0,@!x1,@!y1:scaled);
+label done,done1;
+var @!m0,@!n0,@!m1,@!n1:integer; {rounded and unscaled coordinates}
+@!delx,@!dely:scaled; {the coordinate differences of the line}
+@!yt:scaled; {smallest |y| coordinate that rounds the same as |y0|}
+@!tx:scaled; {tentative change in |x|}
+@!p,@!r:pointer; {list manipulation registers}
+@!base:integer; {amount added to edge-and-weight data}
+@!n:integer; {current row number}
+begin n0:=round_unscaled(y0);
+n1:=round_unscaled(y1);
+if n0<>n1 then
+ begin m0:=round_unscaled(x0); m1:=round_unscaled(x1);
+ delx:=x1-x0; dely:=y1-y0;
+ yt:=n0*unity-half_unit; y0:=y0-yt; y1:=y1-yt;
+ if n0<n1 then @<Insert upward edges for a line@>
+ else @<Insert downward edges for a line@>;
+ n_rover(cur_edges):=p; n_pos(cur_edges):=n+zero_field;
+ end;
+end;
+
+@ Here we are careful to cancel any effect of rounding error.
+
+@<Insert upward edges for a line@>=
+begin base:=8*m_offset(cur_edges)+min_halfword+zero_w-cur_wt;
+if m0<=m1 then edge_prep(m0,m1,n0,n1)@+else edge_prep(m1,m0,n0,n1);
+@<Move to row |n0|, pointed to by |p|@>;
+y0:=unity-y0;
+loop@+ begin r:=get_avail; link(r):=unsorted(p); unsorted(p):=r;@/
+ tx:=take_fraction(delx,make_fraction(y0,dely));
+ if ab_vs_cd(delx,y0,dely,tx)<0 then decr(tx);
+ {now $|tx|=\lfloor|y0|\cdot|delx|/|dely|\rfloor$}
+ info(r):=8*round_unscaled(x0+tx)+base;@/
+ y1:=y1-unity;
+ if internal[tracing_edges]>0 then trace_new_edge(r,n);
+ if y1<unity then goto done;
+ p:=link(p); y0:=y0+unity; incr(n);
+ end;
+done: end
+
+@ @<Insert downward edges for a line@>=
+begin base:=8*m_offset(cur_edges)+min_halfword+zero_w+cur_wt;
+if m0<=m1 then edge_prep(m0,m1,n1,n0)@+else edge_prep(m1,m0,n1,n0);
+decr(n0); @<Move to row |n0|, pointed to by |p|@>;
+loop@+ begin r:=get_avail; link(r):=unsorted(p); unsorted(p):=r;@/
+ tx:=take_fraction(delx,make_fraction(y0,dely));
+ if ab_vs_cd(delx,y0,dely,tx)<0 then incr(tx);
+ {now $|tx|=\lceil|y0|\cdot|delx|/|dely|\rceil$, since |dely<0|}
+ info(r):=8*round_unscaled(x0-tx)+base;@/
+ y1:=y1+unity;
+ if internal[tracing_edges]>0 then trace_new_edge(r,n);
+ if y1>=0 then goto done1;
+ p:=knil(p); y0:=y0+unity; decr(n);
+ end;
+done1: end
+
+@ @<Move to row |n0|, pointed to by |p|@>=
+n:=n_pos(cur_edges)-zero_field; p:=n_rover(cur_edges);
+if n<>n0 then
+ if n<n0 then
+ repeat incr(n); p:=link(p);
+ until n=n0
+ else repeat decr(n); p:=knil(p);
+ until n=n0
+
+@ \MF\ inserts most of its edges into edge structures via the
+|move_to_edges| subroutine, which uses the data stored in the |move| array
+to specify a sequence of ``rook moves.'' The starting point |(m0,n0)|
+and finishing point |(m1,n1)| of these moves, as seen from the standpoint
+of the first octant, are supplied as parameters; the moves should, however,
+be rotated into a given octant. (We're going to study octant
+transformations in great detail later; the reader may wish to come back to
+this part of the program after mastering the mysteries of octants.)
+
+The rook moves themselves are defined as follows, from a |first_octant|
+point of view: ``Go right |move[k]| steps, then go up one, for |0<=k<n1-n0|;
+then go right |move[n1-n0]| steps and stop.'' The sum of |move[k]|
+for |0<=k<=n1-n0| will be equal to |m1-m0|.
+
+As in the |line_edges| routine, we use |+cur_wt| as the weight of
+all downward edges and |-cur_wt| as the weight of all upward edges,
+after the moves have been rotated to the proper octant direction.
+
+There are two main cases to consider: \\{fast\_case} is for moves that
+travel in the direction of octants 1, 4, 5, and~8, while \\{slow\_case}
+is for moves that travel toward octants 2, 3, 6, and~7. The latter directions
+are comparatively cumbersome because they generate more upward or downward
+edges; a curve that travels horizontally doesn't produce any edges at all,
+but a curve that travels vertically touches lots of rows.
+
+@d fast_case_up=60 {for octants 1 and 4}
+@d fast_case_down=61 {for octants 5 and 8}
+@d slow_case_up=62 {for octants 2 and 3}
+@d slow_case_down=63 {for octants 6 and 7}
+
+@p procedure move_to_edges(@!m0,@!n0,@!m1,@!n1:integer);
+label fast_case_up,fast_case_down,slow_case_up,slow_case_down,done;
+var @!delta:0..move_size; {extent of |move| data}
+@!k:0..move_size; {index into |move|}
+@!p,@!r:pointer; {list manipulation registers}
+@!dx:integer; {change in edge-weight |info| when |x| changes by 1}
+@!edge_and_weight:integer; {|info| to insert}
+@!j:integer; {number of consecutive vertical moves}
+@!n:integer; {the current row pointed to by |p|}
+debug @!sum:integer;@+gubed@;@/
+begin delta:=n1-n0;
+debug sum:=move[0]; for k:=1 to delta do sum:=sum+abs(move[k]);
+if sum<>m1-m0 then confusion("0");@+gubed@;@/
+@:this can't happen 0}{\quad 0@>
+@<Prepare for and switch to the appropriate case, based on |octant|@>;
+fast_case_up:@<Add edges for first or fourth octants, then |goto done|@>;
+fast_case_down:@<Add edges for fifth or eighth octants, then |goto done|@>;
+slow_case_up:@<Add edges for second or third octants, then |goto done|@>;
+slow_case_down:@<Add edges for sixth or seventh octants, then |goto done|@>;
+done: n_pos(cur_edges):=n+zero_field; n_rover(cur_edges):=p;
+end;
+
+@ The current octant code appears in a global variable. If, for example,
+we have |octant=third_octant|, it means that a curve traveling in a north to
+north-westerly direction has been rotated for the purposes of internal
+calculations so that the |move| data travels in an east to north-easterly
+direction. We want to unrotate as we update the edge structure.
+
+@<Glob...@>=
+@!octant:first_octant..sixth_octant; {the current octant of interest}
+
+@ @<Prepare for and switch to the appropriate case, based on |octant|@>=
+case octant of
+first_octant:begin dx:=8; edge_prep(m0,m1,n0,n1); goto fast_case_up;
+ end;
+second_octant:begin dx:=8; edge_prep(n0,n1,m0,m1); goto slow_case_up;
+ end;
+third_octant:begin dx:=-8; edge_prep(-n1,-n0,m0,m1); negate(n0);
+ goto slow_case_up;
+ end;
+fourth_octant:begin dx:=-8; edge_prep(-m1,-m0,n0,n1); negate(m0);
+ goto fast_case_up;
+ end;
+fifth_octant:begin dx:=-8; edge_prep(-m1,-m0,-n1,-n0); negate(m0);
+ goto fast_case_down;
+ end;
+sixth_octant:begin dx:=-8; edge_prep(-n1,-n0,-m1,-m0); negate(n0);
+ goto slow_case_down;
+ end;
+seventh_octant:begin dx:=8; edge_prep(n0,n1,-m1,-m0); goto slow_case_down;
+ end;
+eighth_octant:begin dx:=8; edge_prep(m0,m1,-n1,-n0); goto fast_case_down;
+ end;
+end; {there are only eight octants}
+
+@ @<Add edges for first or fourth octants, then |goto done|@>=
+@<Move to row |n0|, pointed to by |p|@>;
+if delta>0 then
+ begin k:=0;
+ edge_and_weight:=8*(m0+m_offset(cur_edges))+min_halfword+zero_w-cur_wt;
+ repeat edge_and_weight:=edge_and_weight+dx*move[k];
+ fast_get_avail(r); link(r):=unsorted(p); info(r):=edge_and_weight;
+ if internal[tracing_edges]>0 then trace_new_edge(r,n);
+ unsorted(p):=r; p:=link(p); incr(k); incr(n);
+ until k=delta;
+ end;
+goto done
+
+@ @<Add edges for fifth or eighth octants, then |goto done|@>=
+n0:=-n0-1; @<Move to row |n0|, pointed to by |p|@>;
+if delta>0 then
+ begin k:=0;
+ edge_and_weight:=8*(m0+m_offset(cur_edges))+min_halfword+zero_w+cur_wt;
+ repeat edge_and_weight:=edge_and_weight+dx*move[k];
+ fast_get_avail(r); link(r):=unsorted(p); info(r):=edge_and_weight;
+ if internal[tracing_edges]>0 then trace_new_edge(r,n);
+ unsorted(p):=r; p:=knil(p); incr(k); decr(n);
+ until k=delta;
+ end;
+goto done
+
+@ @<Add edges for second or third octants, then |goto done|@>=
+edge_and_weight:=8*(n0+m_offset(cur_edges))+min_halfword+zero_w-cur_wt;
+n0:=m0; k:=0; @<Move to row |n0|, pointed to by |p|@>;
+repeat j:=move[k];
+while j>0 do
+ begin fast_get_avail(r); link(r):=unsorted(p); info(r):=edge_and_weight;
+ if internal[tracing_edges]>0 then trace_new_edge(r,n);
+ unsorted(p):=r; p:=link(p); decr(j); incr(n);
+ end;
+edge_and_weight:=edge_and_weight+dx; incr(k);
+until k>delta;
+goto done
+
+@ @<Add edges for sixth or seventh octants, then |goto done|@>=
+edge_and_weight:=8*(n0+m_offset(cur_edges))+min_halfword+zero_w+cur_wt;
+n0:=-m0-1; k:=0; @<Move to row |n0|, pointed to by |p|@>;
+repeat j:=move[k];
+while j>0 do
+ begin fast_get_avail(r); link(r):=unsorted(p); info(r):=edge_and_weight;
+ if internal[tracing_edges]>0 then trace_new_edge(r,n);
+ unsorted(p):=r; p:=knil(p); decr(j); decr(n);
+ end;
+edge_and_weight:=edge_and_weight+dx; incr(k);
+until k>delta;
+goto done
+
+@ All the hard work of building an edge structure is undone by the following
+subroutine.
+
+@<Declare the recycling subroutines@>=
+procedure toss_edges(@!h:pointer);
+var @!p,@!q:pointer; {for list manipulation}
+begin q:=link(h);
+while q<>h do
+ begin flush_list(sorted(q));
+ if unsorted(q)>void then flush_list(unsorted(q));
+ p:=q; q:=link(q); free_node(p,row_node_size);
+ end;
+free_node(h,edge_header_size);
+end;
+
+@* \[21] Subdivision into octants.
+When \MF\ digitizes a path, it reduces the problem to the special
+case of paths that travel in ``first octant'' directions; i.e.,
+each cubic $z(t)=\bigl(x(t),y(t)\bigr)$ being digitized will have the property
+that $0\L y'(t)\L x'(t)$. This assumption makes digitizing simpler
+and faster than if the direction of motion has to be tested repeatedly.
+
+When $z(t)$ is cubic, $x'(t)$ and $y'(t)$ are quadratic, hence the four
+polynomials $x'(t)$, $y'(t)$, $x'(t)-y'(t)$, and $x'(t)+y'(t)$ cross
+through~0 at most twice each. If we subdivide the given cubic at these
+places, we get at most nine subintervals in each of which
+$x'(t)$, $y'(t)$, $x'(t)-y'(t)$, and $x'(t)+y'(t)$ all have a constant
+sign. The curve can be transformed in each of these subintervals so that
+it travels entirely in first octant directions, if we reflect $x\swap-x$,
+$y\swap-y$, and/or $x\swap y$ as necessary. (Incidentally, it can be
+shown that a cubic such that $x'(t)=16(2t-1)^2+2(2t-1)-1$ and
+$y'(t)=8(2t-1)^2+4(2t-1)$ does indeed split into nine subintervals.)
+
+@ The transformation that rotates coordinates, so that first octant motion
+can be assumed, is defined by the |skew| subroutine, which sets global
+variables |cur_x| and |cur_y| to the values that are appropriate in a
+given octant. (Octants are encoded as they were in the |n_arg| subroutine.)
+
+This transformation is ``skewed'' by replacing |(x,y)| by |(x-y,y)|,
+once first octant motion has been established. It turns out that
+skewed coordinates are somewhat better to work with when curves are
+actually digitized.
+
+@d set_two_end(#)==cur_y:=#;@+end
+@d set_two(#)==begin cur_x:=#; set_two_end
+
+@p procedure skew(@!x,@!y:scaled;@!octant:small_number);
+begin case octant of
+first_octant: set_two(x-y)(y);
+second_octant: set_two(y-x)(x);
+third_octant: set_two(y+x)(-x);
+fourth_octant: set_two(-x-y)(y);
+fifth_octant: set_two(-x+y)(-y);
+sixth_octant: set_two(-y+x)(-x);
+seventh_octant: set_two(-y-x)(x);
+eighth_octant: set_two(x+y)(-y);
+end; {there are no other cases}
+end;
+
+@ Conversely, the following subroutine sets |cur_x| and
+|cur_y| to the original coordinate values of a point, given an octant
+code and the point's coordinates |(x,y)| after they have been mapped into
+the first octant and skewed.
+
+@<Declare subroutines for printing expressions@>=
+procedure unskew(@!x,@!y:scaled;@!octant:small_number);
+begin case octant of
+first_octant: set_two(x+y)(y);
+second_octant: set_two(y)(x+y);
+third_octant: set_two(-y)(x+y);
+fourth_octant: set_two(-x-y)(y);
+fifth_octant: set_two(-x-y)(-y);
+sixth_octant: set_two(-y)(-x-y);
+seventh_octant: set_two(y)(-x-y);
+eighth_octant: set_two(x+y)(-y);
+end; {there are no other cases}
+end;
+
+@ @<Glob...@>=
+@!cur_x,@!cur_y:scaled;
+ {outputs of |rotate|, |unrotate|, and a few other routines}
+
+@ The conversion to skewed and rotated coordinates takes place in
+stages, and at one point in the transformation we will have negated the
+$x$ and/or $y$ coordinates so as to make curves travel in the first
+{\sl quadrant}. At this point the relevant ``octant'' code will be
+either |first_octant| (when no transformation has been done),
+or |fourth_octant=first_octant+negate_x| (when $x$ has been negated),
+or |fifth_octant=first_octant+negate_x+negate_y| (when both have been
+negated), or |eighth_octant=first_octant+negate_y| (when $y$ has been
+negated). The |abnegate| routine is sometimes needed to convert
+from one of these transformations to another.
+
+@p procedure abnegate(@!x,@!y:scaled;
+ @!octant_before,@!octant_after:small_number);
+begin if odd(octant_before)=odd(octant_after) then cur_x:=x
+ else cur_x:=-x;
+if (octant_before>negate_y)=(octant_after>negate_y) then cur_y:=y
+ else cur_y:=-y;
+end;
+
+@ Now here's a subroutine that's handy for subdivision: Given a
+quadratic polynomial $B(a,b,c;t)$, the |crossing_point| function
+returns the unique |fraction| value |t| between 0 and~1 at which
+$B(a,b,c;t)$ changes from positive to negative, or returns
+|t=fraction_one+1| if no such value exists. If |a<0| (so that $B(a,b,c;t)$
+is already negative at |t=0|), |crossing_point| returns the value zero.
+
+@d no_crossing==begin crossing_point:=fraction_one+1; return;
+ end
+@d one_crossing==begin crossing_point:=fraction_one; return;
+ end
+@d zero_crossing==begin crossing_point:=0; return;
+ end
+
+@p function crossing_point(@!a,@!b,@!c:integer):fraction;
+label exit;
+var @!d:integer; {recursive counter}
+@!x,@!xx,@!x0,@!x1,@!x2:integer; {temporary registers for bisection}
+begin if a<0 then zero_crossing;
+if c>=0 then
+ begin if b>=0 then
+ if c>0 then no_crossing
+ else if (a=0)and(b=0) then no_crossing
+ else one_crossing;
+ if a=0 then zero_crossing;
+ end
+else if a=0 then if b<=0 then zero_crossing;
+@<Use bisection to find the crossing point, if one exists@>;
+exit:end;
+
+@ The general bisection method is quite simple when $n=2$, hence
+|crossing_point| does not take much time. At each stage in the
+recursion we have a subinterval defined by |l| and~|j| such that
+$B(a,b,c;2^{-l}(j+t))=B(x_0,x_1,x_2;t)$, and we want to ``zero in'' on
+the subinterval where $x_0\G0$ and $\min(x_1,x_2)<0$.
+
+It is convenient for purposes of calculation to combine the values
+of |l| and~|j| in a single variable $d=2^l+j$, because the operation
+of bisection then corresponds simply to doubling $d$ and possibly
+adding~1. Furthermore it proves to be convenient to modify
+our previous conventions for bisection slightly, maintaining the
+variables $X_0=2^lx_0$, $X_1=2^l(x_0-x_1)$, and $X_2=2^l(x_1-x_2)$.
+With these variables the conditions $x_0\ge0$ and $\min(x_1,x_2)<0$ are
+equivalent to $\max(X_1,X_1+X_2)>X_0\ge0$.
+
+The following code maintains the invariant relations
+$0\L|x0|<\max(|x1|,|x1|+|x2|)$,
+$\vert|x1|\vert<2^{30}$, $\vert|x2|\vert<2^{30}$;
+it has been constructed in such a way that no arithmetic overflow
+will occur if the inputs satisfy
+$a<2^{30}$, $\vert a-b\vert<2^{30}$, and $\vert b-c\vert<2^{30}$.
+
+@<Use bisection to find the crossing point...@>=
+d:=1; x0:=a; x1:=a-b; x2:=b-c;
+repeat x:=half(x1+x2);
+if x1-x0>x0 then
+ begin x2:=x; double(x0); double(d);
+ end
+else begin xx:=x1+x-x0;
+ if xx>x0 then
+ begin x2:=x; double(x0); double(d);
+ end
+ else begin x0:=x0-xx;
+ if x<=x0 then if x+x2<=x0 then no_crossing;
+ x1:=x; d:=d+d+1;
+ end;
+ end;
+until d>=fraction_one;
+crossing_point:=d-fraction_one
+
+@ Octant subdivision is applied only to cycles, i.e., to closed paths.
+A ``cycle spec'' is a data structure that contains specifications of
+@!@^cycle spec@>
+cubic curves and octant mappings for the cycle that has been subdivided
+into segments belonging to single octants. It is composed entirely of
+knot nodes, similar to those in the representation of paths; but the
+|explicit| type indications have been replaced by positive numbers
+that give further information. Additional |endpoint| data is also
+inserted at the octant boundaries.
+
+Recall that a cubic polynomial is represented by four control points
+that appear in adjacent nodes |p| and~|q| of a knot list. The |x|~coordinates
+are |x_coord(p)|, |right_x(p)|, |left_x(q)|, and |x_coord(q)|; the
+|y|~coordinates are similar. We shall call this ``the cubic following~|p|''
+or ``the cubic between |p| and~|q|'' or ``the cubic preceding~|q|.''
+
+Cycle specs are circular lists of cubic curves mixed with octant
+boundaries. Like cubics, the octant boundaries are represented in
+consecutive knot nodes |p| and~|q|. In such cases |right_type(p)=
+left_type(q)=endpoint|, and the fields |right_x(p)|, |right_y(p)|,
+|left_x(q)|, and |left_y(q)| are replaced by other fields called
+|right_octant(p)|, |right_transition(p)|, |left_octant(q)|, and
+|left_transition(q)|, respectively. For example, when the curve direction
+moves from the third octant to the fourth octant, the boundary nodes say
+|right_octant(p)=third_octant|, |left_octant(q)=fourth_octant|,
+and |right_transition(p)=left_transition(q)=diagonal|. A |diagonal|
+transition occurs when moving between octants 1~\AM~2, 3~\AM~4, 5~\AM~6, or
+7~\AM~8; an |axis| transition occurs when moving between octants 8~\AM~1,
+2~\AM~3, 4~\AM~5, 6~\AM~7. (Such transition information is redundant
+but convenient.) Fields |x_coord(p)| and |y_coord(p)| will contain
+coordinates of the transition point after rotation from third octant
+to first octant; i.e., if the true coordinates are $(x,y)$, the
+coordinates $(y,-x)$ will appear in node~|p|. Similarly, a fourth-octant
+transformation will have been applied after the transition, so
+we will have |x_coord(q)=@t$-x$@>| and |y_coord(q)=y|.
+
+The cubic between |p| and |q| will contain positive numbers in the
+fields |right_type(p)| and |left_type(q)|; this makes cubics
+distinguishable from octant boundaries, because |endpoint=0|.
+The value of |right_type(p)| will be the current octant code,
+during the time that cycle specs are being constructed; it will
+refer later to a pen offset position, if the envelope of a cycle is
+being computed. A cubic that comes from some subinterval of the $k$th
+step in the original cyclic path will have |left_type(q)=k|.
+
+@d right_octant==right_x {the octant code before a transition}
+@d left_octant==left_x {the octant after a transition}
+@d right_transition==right_y {the type of transition}
+@d left_transition==left_y {ditto, either |axis| or |diagonal|}
+@d axis=0 {a transition across the $x'$- or $y'$-axis}
+@d diagonal=1 {a transition where $y'=\pm x'$}
+
+@ Here's a routine that prints a cycle spec in symbolic form, so that it
+is possible to see what subdivision has been made. The point coordinates
+are converted back from \MF's internal ``rotated'' form to the external
+``true'' form. The global variable~|cur_spec| should point to a knot just
+after the beginning of an octant boundary, i.e., such that
+|left_type(cur_spec)=endpoint|.
+
+@d print_two_true(#)==unskew(#,octant); print_two(cur_x,cur_y)
+
+@p procedure print_spec(@!s:str_number);
+label not_found,done;
+var @!p,@!q:pointer; {for list traversal}
+@!octant:small_number; {the current octant code}
+begin print_diagnostic("Cycle spec",s,true);
+@.Cycle spec at line...@>
+p:=cur_spec; octant:=left_octant(p); print_ln;
+print_two_true(x_coord(cur_spec),y_coord(cur_spec));
+print(" % beginning in octant `");
+loop@+ begin print(octant_dir[octant]); print_char("'");
+ loop@+ begin q:=link(p);
+ if right_type(p)=endpoint then goto not_found;
+ @<Print the cubic between |p| and |q|@>;
+ p:=q;
+ end;
+not_found: if q=cur_spec then goto done;
+ p:=q; octant:=left_octant(p); print_nl("% entering octant `");
+ end;
+@.entering the nth octant@>
+done: print_nl(" & cycle"); end_diagnostic(true);
+end;
+
+@ Symbolic octant direction names are kept in the |octant_dir| array.
+
+@<Glob...@>=
+@!octant_dir:array[first_octant..sixth_octant] of str_number;
+
+@ @<Set init...@>=
+octant_dir[first_octant]:="ENE";
+octant_dir[second_octant]:="NNE";
+octant_dir[third_octant]:="NNW";
+octant_dir[fourth_octant]:="WNW";
+octant_dir[fifth_octant]:="WSW";
+octant_dir[sixth_octant]:="SSW";
+octant_dir[seventh_octant]:="SSE";
+octant_dir[eighth_octant]:="ESE";
+
+@ @<Print the cubic between...@>=
+begin print_nl(" ..controls ");
+print_two_true(right_x(p),right_y(p));
+print(" and ");
+print_two_true(left_x(q),left_y(q));
+print_nl(" ..");
+print_two_true(x_coord(q),y_coord(q));
+print(" % segment "); print_int(left_type(q)-1);
+end
+
+@ A much more compact version of a spec is printed to help users identify
+``strange paths.''
+
+@p procedure print_strange(@!s:str_number);
+var @!p:pointer; {for list traversal}
+@!f:pointer; {starting point in the cycle}
+@!q:pointer; {octant boundary to be printed}
+@!t:integer; {segment number, plus 1}
+begin if interaction=error_stop_mode then wake_up_terminal;
+print_nl(">");
+@.>\relax@>
+@<Find the starting point, |f|@>;
+@<Determine the octant boundary |q| that precedes |f|@>;
+t:=0;
+repeat if left_type(p)<>endpoint then
+ begin if left_type(p)<>t then
+ begin t:=left_type(p); print_char(" "); print_int(t-1);
+ end;
+ if q<>null then
+ begin @<Print the turns, if any, that start at |q|, and advance |q|@>;
+ print_char(" "); print(octant_dir[left_octant(q)]); q:=null;
+ end;
+ end
+else if q=null then q:=p;
+p:=link(p);
+until p=f;
+print_char(" "); print_int(left_type(p)-1);
+if q<>null then @<Print the turns...@>;
+print_err(s);
+end;
+
+@ If the segment numbers on the cycle are $t_1$, $t_2$, \dots, $t_m$,
+we have $t_{k-1}\L t_k$ except for at most one value of~$k$. If there are
+no exceptions, $f$ will point to $t_1$; otherwise it will point to the
+exceptional~$t_k$.
+
+There is at least one segment number (i.e., we always have $m>0$), because
+|print_strange| is never called upon to display an entirely ``dead'' cycle.
+
+@<Find the starting point, |f|@>=
+p:=cur_spec; t:=max_quarterword+1;
+repeat p:=link(p);
+if left_type(p)<>endpoint then
+ begin if left_type(p)<t then f:=p;
+ t:=left_type(p);
+ end;
+until p=cur_spec
+
+@ @<Determine the octant boundary...@>=
+p:=cur_spec; q:=p;
+repeat p:=link(p);
+if left_type(p)=endpoint then q:=p;
+until p=f
+
+@ When two octant boundaries are adjacent, the path is simply changing direction
+without moving. Such octant directions are shown in parentheses.
+
+@<Print the turns...@>=
+if left_type(link(q))=endpoint then
+ begin print(" ("); print(octant_dir[left_octant(q)]); q:=link(q);
+ while left_type(link(q))=endpoint do
+ begin print_char(" "); print(octant_dir[left_octant(q)]); q:=link(q);
+ end;
+ print_char(")");
+ end
+
+@ The |make_spec| routine is what subdivides paths into octants:
+Given a pointer |cur_spec| to a cyclic path, |make_spec| mungs the path data
+and returns a pointer to the corresponding cyclic spec.
+All ``dead'' cubics (i.e., cubics that don't move at all from
+their starting points) will have been removed from the result.
+@!@^dead cubics@>
+
+The idea of |make_spec| is fairly simple: Each cubic is first
+subdivided, if necessary, into pieces belonging to single octants;
+then the octant boundaries are inserted. But some of the details of
+this transformation are not quite obvious.
+
+If |autorounding>0|, the path will be adjusted so that critical tangent
+directions occur at ``good'' points with respect to the pen called |cur_pen|.
+
+The resulting spec will have all |x| and |y| coordinates at most
+$2^{28}-|half_unit|-1-|safety_margin|$ in absolute value. The pointer
+that is returned will start some octant, as required by |print_spec|.
+
+@p @t\4@>@<Declare subroutines needed by |make_spec|@>@;
+function make_spec(@!h:pointer;
+ @!safety_margin:scaled;@!tracing:integer):pointer;
+ {converts a path to a cycle spec}
+label continue,done;
+var @!p,@!q,@!r,@!s:pointer; {for traversing the lists}
+@!k:integer; {serial number of path segment, or octant code}
+@!chopped:integer; {positive if data truncated,
+ negative if data dangerously large}
+@<Other local variables for |make_spec|@>@;
+begin cur_spec:=h;
+if tracing>0 then
+ print_path(cur_spec,", before subdivision into octants",true);
+max_allowed:=fraction_one-half_unit-1-safety_margin;
+@<Truncate the values of all coordinates that exceed |max_allowed|, and stamp
+ segment numbers in each |left_type| field@>;
+quadrant_subdivide; {subdivide each cubic into pieces belonging to quadrants}
+if (internal[autorounding]>0)and(chopped=0) then xy_round;
+octant_subdivide; {complete the subdivision}
+if (internal[autorounding]>unity)and(chopped=0) then diag_round;
+@<Remove dead cubics@>;
+@<Insert octant boundaries and compute the turning number@>;
+while left_type(cur_spec)<>endpoint do cur_spec:=link(cur_spec);
+if tracing>0 then
+ if (internal[autorounding]<=0)or(chopped<>0) then
+ print_spec(", after subdivision")
+ else if internal[autorounding]>unity then
+ print_spec(", after subdivision and double autorounding")
+ else print_spec(", after subdivision and autorounding");
+make_spec:=cur_spec;
+end;
+
+@ The |make_spec| routine has an interesting side effect, namely to set
+the global variable |turning_number| to the number of times the tangent
+vector of the given cyclic path winds around the origin.
+
+Another global variable |cur_spec| points to the specification as it is
+being made, since several subroutines must go to work on it.
+
+And there are two global variables that affect the rounding
+decisions, as we'll see later; they are called |cur_pen| and |cur_path_type|.
+The latter will be |double_path_code| if |make_spec| is being
+applied to a double path.
+
+@d double_path_code=0 {command modifier for `\&{doublepath}'}
+@d contour_code=1 {command modifier for `\&{contour}'}
+@d also_code=2 {command modifier for `\&{also}'}
+
+@<Glob...@>=
+@!cur_spec:pointer; {the principal output of |make_spec|}
+@!turning_number:integer; {another output of |make_spec|}
+@!cur_pen:pointer; {an implicit input of |make_spec|, used in autorounding}
+@!cur_path_type:double_path_code..contour_code; {likewise}
+@!max_allowed:scaled; {coordinates must be at most this big}
+
+@ First we do a simple preprocessing step. The segment numbers inserted
+here will propagate to all descendants of cubics that are split into
+subintervals. These numbers must be nonzero, but otherwise they are
+present merely for diagnostic purposes. The cubic from |p| to~|q|
+that represents ``time interval'' |(t-1)..t| usually has |right_type(q)=t|,
+except when |t| is too large to be stored in a quarterword.
+
+@d procrustes(#)==@+if abs(#)>=dmax then
+ if abs(#)>max_allowed then
+ begin chopped:=1;
+ if #>0 then #:=max_allowed@+else #:=-max_allowed;
+ end
+ else if chopped=0 then chopped:=-1
+
+@<Truncate the values of all coordinates that exceed...@>=
+p:=cur_spec; k:=1; chopped:=0; dmax:=max_allowed/2;
+repeat procrustes(left_x(p)); procrustes(left_y(p));
+procrustes(x_coord(p)); procrustes(y_coord(p));
+procrustes(right_x(p)); procrustes(right_y(p));@/
+p:=link(p); left_type(p):=k;
+if k<max_quarterword then incr(k)@+else k:=1;
+until p=cur_spec;
+if chopped>0 then
+ begin print_err("Curve out of range");
+@.Curve out of range@>
+ help4("At least one of the coordinates in the path I'm about to")@/
+ ("digitize was really huge (potentially bigger than 4095).")@/
+ ("So I've cut it back to the maximum size.")@/
+ ("The results will probably be pretty wild.");
+ put_get_error;
+ end
+
+@ We may need to get rid of constant ``dead'' cubics that clutter up
+the data structure and interfere with autorounding.
+
+@<Declare subroutines needed by |make_spec|@>=
+procedure remove_cubic(@!p:pointer); {removes the cubic following~|p|}
+var @!q:pointer; {the node that disappears}
+begin q:=link(p); right_type(p):=right_type(q); link(p):=link(q);@/
+x_coord(p):=x_coord(q); y_coord(p):=y_coord(q);@/
+right_x(p):=right_x(q); right_y(p):=right_y(q);@/
+free_node(q,knot_node_size);
+end;
+
+@ The subdivision process proceeds by first swapping $x\swap-x$, if
+necessary, to ensure that $x'\G0$; then swapping $y\swap-y$, if necessary,
+to ensure that $y'\G0$; and finally swapping $x\swap y$, if necessary,
+to ensure that $x'\G y'$.
+
+Recall that the octant codes have been defined in such a way that, for
+example, |third_octant=first_octant+negate_x+switch_x_and_y|. The program
+uses the fact that |negate_x<negate_y<switch_x_and_y| to handle ``double
+negation'': If |c| is an octant code that possibly involves |negate_x|
+and/or |negate_y|, but not |switch_x_and_y|, then negating~|y| changes~|c|
+either to |c+negate_y| or |c-negate_y|, depending on whether
+|c<=negate_y| or |c>negate_y|. Octant codes are always greater than zero.
+
+The first step is to subdivide on |x| and |y| only, so that horizontal
+and vertical autorounding can be done before we compare $x'$ to $y'$.
+
+@<Declare subroutines needed by |make_spec|@>=
+@t\4@>@<Declare the procedure called |split_cubic|@>@;
+procedure quadrant_subdivide;
+label continue,exit;
+var @!p,@!q,@!r,@!s,@!pp,@!qq:pointer; {for traversing the lists}
+@!first_x,@!first_y:scaled; {unnegated coordinates of node |cur_spec|}
+@!del1,@!del2,@!del3,@!del,@!dmax:scaled; {proportional to the control
+ points of a quadratic derived from a cubic}
+@!t:fraction; {where a quadratic crosses zero}
+@!dest_x,@!dest_y:scaled; {final values of |x| and |y| in the current cubic}
+@!constant_x:boolean; {is |x| constant between |p| and |q|?}
+begin p:=cur_spec; first_x:=x_coord(cur_spec); first_y:=y_coord(cur_spec);
+repeat continue: q:=link(p);
+@<Subdivide the cubic between |p| and |q| so that the results travel
+ toward the right halfplane@>;
+@<Subdivide all cubics between |p| and |q| so that the results travel
+ toward the first quadrant; but |return| or |goto continue| if the
+ cubic from |p| to |q| was dead@>;
+p:=q;
+until p=cur_spec;
+exit:end;
+
+@ All three subdivision processes are similar, so it's possible to
+get the general idea by studying the first one (which is the simplest).
+The calculation makes use of the fact that the derivatives of
+Bernshte{\u\i}n polynomials satisfy
+$B'(z_0,z_1,\ldots,z_n;t)=nB(z_1-z_0,\ldots,z_n-z_{n-1};t)$.
+
+When this routine begins, |right_type(p)| is |explicit|; we should
+set |right_type(p):=first_octant|. However, no assignment is made,
+because |explicit=first_octant|. The author apologizes for using
+such trickery here; it is really hard to do redundant computations
+just for the sake of purity.
+
+@<Subdivide the cubic between |p| and |q| so that the results travel
+ toward the right halfplane...@>=
+if q=cur_spec then
+ begin dest_x:=first_x; dest_y:=first_y;
+ end
+else begin dest_x:=x_coord(q); dest_y:=y_coord(q);
+ end;
+del1:=right_x(p)-x_coord(p); del2:=left_x(q)-right_x(p);
+del3:=dest_x-left_x(q);
+@<Scale up |del1|, |del2|, and |del3| for greater accuracy;
+ also set |del| to the first nonzero element of |(del1,del2,del3)|@>;
+if del=0 then constant_x:=true
+else begin constant_x:=false;
+ if del<0 then @<Complement the |x| coordinates of the
+ cubic between |p| and~|q|@>;
+ t:=crossing_point(del1,del2,del3);
+ if t<fraction_one then
+ @<Subdivide the cubic with respect to $x'$, possibly twice@>;
+ end
+
+@ If |del1=del2=del3=0|, it's impossible to obey the title of this
+section. We just set |del=0| in that case.
+@^inner loop@>
+
+@<Scale up |del1|, |del2|, and |del3| for greater accuracy...@>=
+if del1<>0 then del:=del1
+else if del2<>0 then del:=del2
+else del:=del3;
+if del<>0 then
+ begin dmax:=abs(del1);
+ if abs(del2)>dmax then dmax:=abs(del2);
+ if abs(del3)>dmax then dmax:=abs(del3);
+ while dmax<fraction_half do
+ begin double(dmax); double(del1); double(del2); double(del3);
+ end;
+ end
+
+@ During the subdivision phases of |make_spec|, the |x_coord| and |y_coord|
+fields of node~|q| are not transformed to agree with the octant
+stated in |right_type(p)|; they remain consistent with |right_type(q)|.
+But |left_x(q)| and |left_y(q)| are governed by |right_type(p)|.
+
+@<Complement the |x| coordinates...@>=
+begin negate(x_coord(p)); negate(right_x(p));
+negate(left_x(q));@/
+negate(del1); negate(del2); negate(del3);@/
+negate(dest_x);
+right_type(p):=first_octant+negate_x;
+end
+
+@ When a cubic is split at a |fraction| value |t|, we obtain two cubics
+whose B\'ezier control points are obtained by a generalization of the
+bisection process: The formula
+`$z_k^{(j+1)}={1\over2}(z_k^{(j)}+z\k^{(j)})$' becomes
+`$z_k^{(j+1)}=t[z_k^{(j)},z\k^{(j)}]$'.
+
+It is convenient to define a \.{WEB} macro |t_of_the_way| such that
+|t_of_the_way(a)(b)| expands to |a-(a-b)*t|, i.e., to |t[a,b]|.
+
+If |0<=t<=1|, the quantity |t[a,b]| is always between |a| and~|b|, even in
+the presence of rounding errors. Our subroutines
+also obey the identity |t[a,b]+t[b,a]=a+b|.
+
+@d t_of_the_way_end(#)==#,t@=)@>
+@d t_of_the_way(#)==#-take_fraction@=(@>#-t_of_the_way_end
+
+@<Declare the procedure called |split_cubic|@>=
+procedure split_cubic(@!p:pointer;@!t:fraction;
+ @!xq,@!yq:scaled); {splits the cubic after |p|}
+var @!v:scaled; {an intermediate value}
+@!q,@!r:pointer; {for list manipulation}
+begin q:=link(p); r:=get_node(knot_node_size); link(p):=r; link(r):=q;@/
+left_type(r):=left_type(q); right_type(r):=right_type(p);@#
+v:=t_of_the_way(right_x(p))(left_x(q));
+right_x(p):=t_of_the_way(x_coord(p))(right_x(p));
+left_x(q):=t_of_the_way(left_x(q))(xq);
+left_x(r):=t_of_the_way(right_x(p))(v);
+right_x(r):=t_of_the_way(v)(left_x(q));
+x_coord(r):=t_of_the_way(left_x(r))(right_x(r));@#
+v:=t_of_the_way(right_y(p))(left_y(q));
+right_y(p):=t_of_the_way(y_coord(p))(right_y(p));
+left_y(q):=t_of_the_way(left_y(q))(yq);
+left_y(r):=t_of_the_way(right_y(p))(v);
+right_y(r):=t_of_the_way(v)(left_y(q));
+y_coord(r):=t_of_the_way(left_y(r))(right_y(r));
+end;
+
+@ Since $x'(t)$ is a quadratic equation, it can cross through zero
+at~most twice. When it does cross zero, we make doubly sure that the
+derivative is really zero at the splitting point, in case rounding errors
+have caused the split cubic to have an apparently nonzero derivative.
+We also make sure that the split cubic is monotonic.
+
+@<Subdivide the cubic with respect to $x'$, possibly twice@>=
+begin split_cubic(p,t,dest_x,dest_y); r:=link(p);
+if right_type(r)>negate_x then right_type(r):=first_octant
+else right_type(r):=first_octant+negate_x;
+if x_coord(r)<x_coord(p) then x_coord(r):=x_coord(p);
+left_x(r):=x_coord(r);
+if right_x(p)>x_coord(r) then right_x(p):=x_coord(r);
+ {we always have |x_coord(p)<=right_x(p)|}
+negate(x_coord(r)); right_x(r):=x_coord(r);
+negate(left_x(q)); negate(dest_x);@/
+del2:=t_of_the_way(del2)(del3);
+ {now |0,del2,del3| represent $x'$ on the remaining interval}
+if del2>0 then del2:=0;
+t:=crossing_point(0,-del2,-del3);
+if t<fraction_one then @<Subdivide the cubic a second time
+ with respect to $x'$@>
+else begin if x_coord(r)>dest_x then
+ begin x_coord(r):=dest_x; left_x(r):=-x_coord(r); right_x(r):=x_coord(r);
+ end;
+ if left_x(q)>dest_x then left_x(q):=dest_x
+ else if left_x(q)<x_coord(r) then left_x(q):=x_coord(r);
+ end;
+end
+
+@ @<Subdivide the cubic a second time with respect to $x'$@>=
+begin split_cubic(r,t,dest_x,dest_y); s:=link(r);
+if x_coord(s)<dest_x then x_coord(s):=dest_x;
+if x_coord(s)<x_coord(r) then x_coord(s):=x_coord(r);
+right_type(s):=right_type(p);
+left_x(s):=x_coord(s); {now |x_coord(r)=right_x(r)<=left_x(s)|}
+if left_x(q)<dest_x then left_x(q):=-dest_x
+else if left_x(q)>x_coord(s) then left_x(q):=-x_coord(s)
+else negate(left_x(q));
+negate(x_coord(s)); right_x(s):=x_coord(s);
+end
+
+@ The process of subdivision with respect to $y'$ is like that with respect
+to~$x'$, with the slight additional complication that two or three cubics
+might now appear between |p| and~|q|.
+
+@<Subdivide all cubics between |p| and |q| so that the results travel
+ toward the first quadrant...@>=
+pp:=p;
+repeat qq:=link(pp);
+abnegate(x_coord(qq),y_coord(qq),right_type(qq),right_type(pp));
+dest_x:=cur_x; dest_y:=cur_y;@/
+del1:=right_y(pp)-y_coord(pp); del2:=left_y(qq)-right_y(pp);
+del3:=dest_y-left_y(qq);
+@<Scale up |del1|, |del2|, and |del3| for greater accuracy;
+ also set |del| to the first nonzero element of |(del1,del2,del3)|@>;
+if del<>0 then {they weren't all zero}
+ begin if del<0 then @<Complement the |y| coordinates of the
+ cubic between |pp| and~|qq|@>;
+ t:=crossing_point(del1,del2,del3);
+ if t<fraction_one then
+ @<Subdivide the cubic with respect to $y'$, possibly twice@>;
+ end
+else @<Do any special actions needed when |y| is constant;
+ |return| or |goto continue| if a dead cubic from |p| to |q| is removed@>;
+pp:=qq;
+until pp=q;
+if constant_x then @<Correct the octant code in segments with decreasing |y|@>
+
+@ @<Complement the |y| coordinates...@>=
+begin negate(y_coord(pp)); negate(right_y(pp));
+negate(left_y(qq));@/
+negate(del1); negate(del2); negate(del3);@/
+negate(dest_y);
+right_type(pp):=right_type(pp)+negate_y;
+end
+
+@ @<Subdivide the cubic with respect to $y'$, possibly twice@>=
+begin split_cubic(pp,t,dest_x,dest_y); r:=link(pp);
+if right_type(r)>negate_y then right_type(r):=right_type(r)-negate_y
+else right_type(r):=right_type(r)+negate_y;
+if y_coord(r)<y_coord(pp) then y_coord(r):=y_coord(pp);
+left_y(r):=y_coord(r);
+if right_y(pp)>y_coord(r) then right_y(pp):=y_coord(r);
+ {we always have |y_coord(pp)<=right_y(pp)|}
+negate(y_coord(r)); right_y(r):=y_coord(r);
+negate(left_y(qq)); negate(dest_y);@/
+if x_coord(r)<x_coord(pp) then x_coord(r):=x_coord(pp)
+else if x_coord(r)>dest_x then x_coord(r):=dest_x;
+if left_x(r)>x_coord(r) then
+ begin left_x(r):=x_coord(r);
+ if right_x(pp)>x_coord(r) then right_x(pp):=x_coord(r);
+ end;
+if right_x(r)<x_coord(r) then
+ begin right_x(r):=x_coord(r);
+ if left_x(qq)<x_coord(r) then left_x(qq):=x_coord(r);
+ end;
+del2:=t_of_the_way(del2)(del3);
+ {now |0,del2,del3| represent $y'$ on the remaining interval}
+if del2>0 then del2:=0;
+t:=crossing_point(0,-del2,-del3);
+if t<fraction_one then @<Subdivide the cubic a second time
+ with respect to $y'$@>
+else begin if y_coord(r)>dest_y then
+ begin y_coord(r):=dest_y; left_y(r):=-y_coord(r); right_y(r):=y_coord(r);
+ end;
+ if left_y(qq)>dest_y then left_y(qq):=dest_y
+ else if left_y(qq)<y_coord(r) then left_y(qq):=y_coord(r);
+ end;
+end
+
+@ @<Subdivide the cubic a second time with respect to $y'$@>=
+begin split_cubic(r,t,dest_x,dest_y); s:=link(r);@/
+if y_coord(s)<dest_y then y_coord(s):=dest_y;
+if y_coord(s)<y_coord(r) then y_coord(s):=y_coord(r);
+right_type(s):=right_type(pp);
+left_y(s):=y_coord(s); {now |y_coord(r)=right_y(r)<=left_y(s)|}
+if left_y(qq)<dest_y then left_y(qq):=-dest_y
+else if left_y(qq)>y_coord(s) then left_y(qq):=-y_coord(s)
+else negate(left_y(qq));
+negate(y_coord(s)); right_y(s):=y_coord(s);
+if x_coord(s)<x_coord(r) then x_coord(s):=x_coord(r)
+else if x_coord(s)>dest_x then x_coord(s):=dest_x;
+if left_x(s)>x_coord(s) then
+ begin left_x(s):=x_coord(s);
+ if right_x(r)>x_coord(s) then right_x(r):=x_coord(s);
+ end;
+if right_x(s)<x_coord(s) then
+ begin right_x(s):=x_coord(s);
+ if left_x(qq)<x_coord(s) then left_x(qq):=x_coord(s);
+ end;
+end
+
+@ If the cubic is constant in $y$ and increasing in $x$, we have classified
+it as traveling in the first octant. If the cubic is constant
+in~$y$ and decreasing in~$x$, it is desirable to classify it as traveling
+in the fifth octant (not the fourth), because autorounding will be consistent
+with respect to doublepaths only if the octant number changes by four when
+the path is reversed. Therefore we negate the $y$~coordinates
+when they are constant but the curve is decreasing in~$x$; this gives
+the desired result except in pathological paths.
+
+If the cubic is ``dead,'' i.e., constant in both |x| and |y|, we remove
+it unless it is the only cubic in the entire path. We |goto continue|
+if it wasn't the final cubic, so that the test |p=cur_spec| does not
+falsely imply that all cubics have been processed.
+
+@<Do any special actions needed when |y| is constant...@>=
+if constant_x then {|p=pp|, |q=qq|, and the cubic is dead}
+ begin if q<>p then
+ begin remove_cubic(p); {remove the dead cycle and recycle node |q|}
+ if cur_spec<>q then goto continue
+ else begin cur_spec:=p; return;
+ end; {the final cubic was dead and is gone}
+ end;
+ end
+else if not odd(right_type(pp)) then {the $x$ coordinates were negated}
+ @<Complement the |y| coordinates...@>
+
+@ A similar correction to octant codes deserves to be made when |x| is
+constant and |y| is decreasing.
+
+@<Correct the octant code in segments with decreasing |y|@>=
+begin pp:=p;
+repeat qq:=link(pp);
+if right_type(pp)>negate_y then {the $y$ coordinates were negated}
+ begin right_type(pp):=right_type(pp)+negate_x;
+ negate(x_coord(pp)); negate(right_x(pp)); negate(left_x(qq));
+ end;
+pp:=qq;
+until pp=q;
+end
+
+@ Finally, the process of subdividing to make $x'\G y'$ is like the other
+two subdivisions, with a few new twists. We skew the coordinates at this time.
+
+@<Declare subroutines needed by |make_spec|@>=
+procedure octant_subdivide;
+var @!p,@!q,@!r,@!s:pointer; {for traversing the lists}
+@!del1,@!del2,@!del3,@!del,@!dmax:scaled; {proportional to the control
+ points of a quadratic derived from a cubic}
+@!t:fraction; {where a quadratic crosses zero}
+@!dest_x,@!dest_y:scaled; {final values of |x| and |y| in the current cubic}
+begin p:=cur_spec;
+repeat q:=link(p);@/
+x_coord(p):=x_coord(p)-y_coord(p);
+right_x(p):=right_x(p)-right_y(p);
+left_x(q):=left_x(q)-left_y(q);@/
+@<Subdivide the cubic between |p| and |q| so that the results travel
+ toward the first octant@>;
+p:=q;
+until p=cur_spec;
+end;
+
+@ @<Subdivide the cubic between |p| and |q| so that the results travel
+ toward the first octant@>=
+@<Set up the variables |(del1,del2,del3)| to represent $x'-y'$@>;
+@<Scale up |del1|, |del2|, and |del3| for greater accuracy;
+ also set |del| to the first nonzero element of |(del1,del2,del3)|@>;
+if del<>0 then {they weren't all zero}
+ begin if del<0 then @<Swap the |x| and |y| coordinates of the
+ cubic between |p| and~|q|@>;
+ t:=crossing_point(del1,del2,del3);
+ if t<fraction_one then
+ @<Subdivide the cubic with respect to $x'-y'$, possibly twice@>;
+ end
+
+@ @<Set up the variables |(del1,del2,del3)| to represent $x'-y'$@>=
+if q=cur_spec then
+ begin unskew(x_coord(q),y_coord(q),right_type(q));
+ skew(cur_x,cur_y,right_type(p)); dest_x:=cur_x; dest_y:=cur_y;
+ end
+else begin abnegate(x_coord(q),y_coord(q),right_type(q),right_type(p));
+ dest_x:=cur_x-cur_y; dest_y:=cur_y;
+ end;
+del1:=right_x(p)-x_coord(p); del2:=left_x(q)-right_x(p);
+del3:=dest_x-left_x(q)
+
+@ The swapping here doesn't simply interchange |x| and |y| values,
+because the coordinates are skewed. It turns out that this is easier
+than ordinary swapping, because it can be done in two assignment statements
+rather than three.
+
+@ @<Swap the |x| and |y| coordinates...@>=
+begin y_coord(p):=x_coord(p)+y_coord(p); negate(x_coord(p));@/
+right_y(p):=right_x(p)+right_y(p); negate(right_x(p));@/
+left_y(q):=left_x(q)+left_y(q); negate(left_x(q));@/
+negate(del1); negate(del2); negate(del3);@/
+dest_y:=dest_x+dest_y; negate(dest_x);@/
+right_type(p):=right_type(p)+switch_x_and_y;
+end
+
+@ A somewhat tedious case analysis is carried out here to make sure that
+nasty rounding errors don't destroy our assumptions of monotonicity.
+
+@<Subdivide the cubic with respect to $x'-y'$, possibly twice@>=
+begin split_cubic(p,t,dest_x,dest_y); r:=link(p);
+if right_type(r)>switch_x_and_y then right_type(r):=right_type(r)-switch_x_and_y
+else right_type(r):=right_type(r)+switch_x_and_y;
+if y_coord(r)<y_coord(p) then y_coord(r):=y_coord(p)
+else if y_coord(r)>dest_y then y_coord(r):=dest_y;
+if x_coord(p)+y_coord(r)>dest_x+dest_y then
+ y_coord(r):=dest_x+dest_y-x_coord(p);
+if left_y(r)>y_coord(r) then
+ begin left_y(r):=y_coord(r);
+ if right_y(p)>y_coord(r) then right_y(p):=y_coord(r);
+ end;
+if right_y(r)<y_coord(r) then
+ begin right_y(r):=y_coord(r);
+ if left_y(q)<y_coord(r) then left_y(q):=y_coord(r);
+ end;
+if x_coord(r)<x_coord(p) then x_coord(r):=x_coord(p)
+else if x_coord(r)+y_coord(r)>dest_x+dest_y then
+ x_coord(r):=dest_x+dest_y-y_coord(r);
+left_x(r):=x_coord(r);
+if right_x(p)>x_coord(r) then right_x(p):=x_coord(r);
+ {we always have |x_coord(p)<=right_x(p)|}
+y_coord(r):=y_coord(r)+x_coord(r); right_y(r):=right_y(r)+x_coord(r);@/
+negate(x_coord(r)); right_x(r):=x_coord(r);@/
+left_y(q):=left_y(q)+left_x(q); negate(left_x(q));@/
+dest_y:=dest_y+dest_x; negate(dest_x);
+if right_y(r)<y_coord(r) then
+ begin right_y(r):=y_coord(r);
+ if left_y(q)<y_coord(r) then left_y(q):=y_coord(r);
+ end;
+del2:=t_of_the_way(del2)(del3);
+ {now |0,del2,del3| represent $x'-y'$ on the remaining interval}
+if del2>0 then del2:=0;
+t:=crossing_point(0,-del2,-del3);
+if t<fraction_one then
+ @<Subdivide the cubic a second time with respect to $x'-y'$@>
+else begin if x_coord(r)>dest_x then
+ begin x_coord(r):=dest_x; left_x(r):=-x_coord(r); right_x(r):=x_coord(r);
+ end;
+ if left_x(q)>dest_x then left_x(q):=dest_x
+ else if left_x(q)<x_coord(r) then left_x(q):=x_coord(r);
+ end;
+end
+
+@ @<Subdivide the cubic a second time with respect to $x'-y'$@>=
+begin split_cubic(r,t,dest_x,dest_y); s:=link(r);@/
+if y_coord(s)<y_coord(r) then y_coord(s):=y_coord(r)
+else if y_coord(s)>dest_y then y_coord(s):=dest_y;
+if x_coord(r)+y_coord(s)>dest_x+dest_y then
+ y_coord(s):=dest_x+dest_y-x_coord(r);
+if left_y(s)>y_coord(s) then
+ begin left_y(s):=y_coord(s);
+ if right_y(r)>y_coord(s) then right_y(r):=y_coord(s);
+ end;
+if right_y(s)<y_coord(s) then
+ begin right_y(s):=y_coord(s);
+ if left_y(q)<y_coord(s) then left_y(q):=y_coord(s);
+ end;
+if x_coord(s)+y_coord(s)>dest_x+dest_y then x_coord(s):=dest_x+dest_y-y_coord(s)
+else begin if x_coord(s)<dest_x then x_coord(s):=dest_x;
+ if x_coord(s)<x_coord(r) then x_coord(s):=x_coord(r);
+ end;
+right_type(s):=right_type(p);
+left_x(s):=x_coord(s); {now |x_coord(r)=right_x(r)<=left_x(s)|}
+if left_x(q)<dest_x then
+ begin left_y(q):=left_y(q)+dest_x; left_x(q):=-dest_x;@+end
+else if left_x(q)>x_coord(s) then
+ begin left_y(q):=left_y(q)+x_coord(s); left_x(q):=-x_coord(s);@+end
+else begin left_y(q):=left_y(q)+left_x(q); negate(left_x(q));@+end;
+y_coord(s):=y_coord(s)+x_coord(s); right_y(s):=right_y(s)+x_coord(s);@/
+negate(x_coord(s)); right_x(s):=x_coord(s);@/
+if right_y(s)<y_coord(s) then
+ begin right_y(s):=y_coord(s);
+ if left_y(q)<y_coord(s) then left_y(q):=y_coord(s);
+ end;
+end
+
+@ It's time now to consider ``autorounding,'' which tries to make horizontal,
+vertical, and diagonal tangents occur at places that will produce appropriate
+images after the curve is digitized.
+
+The first job is to fix things so that |x(t)| is an integer multiple of the
+current ``granularity'' when the derivative $x'(t)$ crosses through zero.
+The given cyclic path contains regions where $x'(t)\G0$ and regions
+where $x'(t)\L0$. The |quadrant_subdivide| routine is called into action
+before any of the path coordinates have been skewed, but some of them
+may have been negated. In regions where $x'(t)\G0$ we have |right_type=
+first_octant| or |right_type=eighth_octant|; in regions where $x'(t)\L0$,
+we have |right_type=fifth_octant| or |right_type=fourth_octant|.
+
+Within any such region the transformed $x$ values increase monotonically
+from, say, $x_0$ to~$x_1$. We want to modify things by applying a linear
+transformation to all $x$ coordinates in the region, after which
+the $x$ values will increase monotonically from round$(x_0)$ to round$(x_1)$.
+
+This rounding scheme sounds quite simple, and it usually is. But several
+complications can arise that might make the task more difficult. In the
+first place, autorounding is inappropriate at cusps where $x'$ jumps
+discontinuously past zero without ever being zero. In the second place,
+the current pen might be unsymmetric in such a way that $x$ coordinates
+should round differently when $x'$ becomes positive than when it becomes
+negative. These considerations imply that round$(x_0)$ might be greater
+than round$(x_1)$, even though $x_0\L x_1$; in such cases we do not want
+to carry out the linear transformation. Furthermore, it's possible to have
+round$(x_1)-\hbox{round} (x_0)$ positive but much greater than $x_1-x_0$;
+then the transformation might distort the curve drastically, and again we
+want to avoid it. Finally, the rounded points must be consistent between
+adjacent regions, hence we can't transform one region without knowing
+about its neighbors.
+
+To handle all these complications, we must first look at the whole
+cycle and choose rounded $x$ values that are ``safe.'' The following
+procedure does this: Given $m$~values $(b_0,b_1,\ldots,b_{m-1})$ before
+rounding and $m$~corresponding values $(a_0,a_1,\ldots,a_{m-1})$ that would
+be desirable after rounding, the |make_safe| routine sets $a$'s to $b$'s
+if necessary so that $0\L(a\k-a_k)/(b\k-b_k)\L2$ afterwards. It is
+symmetric under cyclic permutation, reversal, and/or negation of the inputs.
+(Instead of |a|, |b|, and~|m|, the program uses the names |after|,
+|before|, and |cur_rounding_ptr|.)
+
+@<Declare subroutines needed by |make_spec|@>=
+procedure make_safe;
+var @!k:0..max_wiggle; {runs through the list of inputs}
+@!all_safe:boolean; {does everything look OK so far?}
+@!next_a:scaled; {|after[k]| before it might have changed}
+@!delta_a,@!delta_b:scaled; {|after[k+1]-after[k]| and |before[k+1]-before[k]|}
+begin before[cur_rounding_ptr]:=before[0]; {wrap around}
+node_to_round[cur_rounding_ptr]:=node_to_round[0];
+repeat after[cur_rounding_ptr]:=after[0]; all_safe:=true; next_a:=after[0];
+for k:=0 to cur_rounding_ptr-1 do
+ begin delta_b:=before[k+1]-before[k];
+ if delta_b>=0 then delta_a:=after[k+1]-next_a
+ else delta_a:=next_a-after[k+1];
+ next_a:=after[k+1];
+ if (delta_a<0)or(delta_a>abs(delta_b+delta_b)) then
+ begin all_safe:=false; after[k]:=before[k];
+ if k=cur_rounding_ptr-1 then after[0]:=before[0]
+ else after[k+1]:=before[k+1];
+ end;
+ end;
+until all_safe;
+end;
+
+@ The global arrays used by |make_safe| are accompanied by an array of
+pointers into the current knot list.
+
+@<Glob...@>=
+@!before,@!after:array[0..max_wiggle] of scaled; {data for |make_safe|}
+@!node_to_round:array[0..max_wiggle] of pointer; {reference back to the path}
+@!cur_rounding_ptr:0..max_wiggle; {how many are being used}
+@!max_rounding_ptr:0..max_wiggle; {how many have been used}
+
+@ @<Set init...@>=
+max_rounding_ptr:=0;
+
+@ New entries go into the tables via the |before_and_after| routine:
+
+@<Declare subroutines needed by |make_spec|@>=
+procedure before_and_after(@!b,@!a:scaled;@!p:pointer);
+begin if cur_rounding_ptr=max_rounding_ptr then
+ if max_rounding_ptr<max_wiggle then incr(max_rounding_ptr)
+ else overflow("rounding table size",max_wiggle);
+@:METAFONT capacity exceeded rounding table size}{\quad rounding table size@>
+after[cur_rounding_ptr]:=a; before[cur_rounding_ptr]:=b;
+node_to_round[cur_rounding_ptr]:=p; incr(cur_rounding_ptr);
+end;
+
+@ A global variable called |cur_gran| is used instead of |internal[
+granularity]|, because we want to work with a number that's guaranteed to
+be positive.
+
+@<Glob...@>=
+@!cur_gran:scaled; {the current granularity (which normally is |unity|)}
+
+@ The |good_val| function computes a number |a| that's as close as
+possible to~|b|, with the property that |a+o| is a multiple of
+|cur_gran|.
+
+If we assume that |cur_gran| is even (since it will in fact be a multiple
+of |unity| in all reasonable applications), we have the identity
+|good_val(-b-1,-o)=-good_val(b,o)|.
+
+@<Declare subroutines needed by |make_spec|@>=
+function good_val(@!b,@!o:scaled):scaled;
+var @!a:scaled; {accumulator}
+begin a:=b+o;
+if a>=0 then a:=a-(a mod cur_gran)-o
+else a:=a+((-(a+1)) mod cur_gran)-cur_gran+1-o;
+if b-a<a+cur_gran-b then good_val:=a
+else good_val:=a+cur_gran;
+end;
+
+@ When we're rounding a doublepath, we might need to compromise between
+two opposing tendencies, if the pen thickness is not a multiple of the
+granularity. The following ``compromise'' adjustment, suggested by
+John Hobby, finds the best way out of the dilemma. (Only the value
+@^Hobby, John Douglas@>
+modulo |cur_gran| is relevant in our applications, so the result turns
+out to be essentially symmetric in |u| and~|v|.)
+
+@<Declare subroutines needed by |make_spec|@>=
+function compromise(@!u,@!v:scaled):scaled;
+begin compromise:=half(good_val(u+u,-u-v));
+end;
+
+@ Here, then, is the procedure that rounds $x$ coordinates as described;
+it does the same for $y$ coordinates too, independently.
+
+@<Declare subroutines needed by |make_spec|@>=
+procedure xy_round;
+var @!p,@!q:pointer; {list manipulation registers}
+@!b,@!a:scaled; {before and after values}
+@!pen_edge:scaled; {offset that governs rounding}
+@!alpha:fraction; {coefficient of linear transformation}
+begin cur_gran:=abs(internal[granularity]);
+if cur_gran=0 then cur_gran:=unity;
+p:=cur_spec; cur_rounding_ptr:=0;
+repeat q:=link(p);
+@<If node |q| is a transition point for |x| coordinates,
+ compute and save its before-and-after coordinates@>;
+p:=q;
+until p=cur_spec;
+if cur_rounding_ptr>0 then @<Transform the |x| coordinates@>;
+p:=cur_spec; cur_rounding_ptr:=0;
+repeat q:=link(p);
+@<If node |q| is a transition point for |y| coordinates,
+ compute and save its before-and-after coordinates@>;
+p:=q;
+until p=cur_spec;
+if cur_rounding_ptr>0 then @<Transform the |y| coordinates@>;
+end;
+
+@ When |x| has been negated, the |octant| codes are even. We allow
+for an error of up to .01 pixel (i.e., 655 |scaled| units) in the
+derivative calculations at transition nodes.
+
+@<If node |q| is a transition point for |x| coordinates...@>=
+if odd(right_type(p))<>odd(right_type(q)) then
+ begin if odd(right_type(q)) then b:=x_coord(q)@+else b:=-x_coord(q);
+ if (abs(x_coord(q)-right_x(q))<655)or@|
+ (abs(x_coord(q)+left_x(q))<655) then
+ @<Compute before-and-after |x| values based on the current pen@>
+ else a:=b;
+ if abs(a)>max_allowed then
+ if a>0 then a:=max_allowed@+else a:=-max_allowed;
+ before_and_after(b,a,q);
+ end
+
+@ When we study the data representation for pens, we'll learn that the
+|x|~coordinate of the current pen's west edge is
+$$\hbox{|y_coord(link(cur_pen+seventh_octant))|},$$
+and that there are similar ways to address other important offsets.
+An ``|east_west_edge|'' is computed as a compromise between east and
+west, for use in doublepaths, in case the two edges have conflicting
+tendencies.
+
+@d north_edge(#)==y_coord(link(#+fourth_octant))
+@d south_edge(#)==y_coord(link(#+first_octant))
+@d east_edge(#)==y_coord(link(#+second_octant))
+@d west_edge(#)==y_coord(link(#+seventh_octant))
+@d north_south_edge(#)==mem[#+10].int {compromise between north and south}
+@d east_west_edge(#)==mem[#+11].int {compromise between east and west}
+@d NE_SW_edge(#)==mem[#+12].int {compromise between northeast and southwest}
+@d NW_SE_edge(#)==mem[#+13].int {compromise between northwest and southeast}
+
+@<Compute before-and-after |x| values based on the current pen@>=
+begin if cur_pen=null_pen then pen_edge:=0
+else if cur_path_type=double_path_code then
+ pen_edge:=compromise(east_edge(cur_pen),west_edge(cur_pen))
+else if odd(right_type(q)) then pen_edge:=west_edge(cur_pen)
+else pen_edge:=east_edge(cur_pen);
+a:=good_val(b,pen_edge);
+end
+
+@ The monotone transformation computed here with fixed-point arithmetic is
+guaranteed to take consecutive |before| values $(b,b')$ into consecutive
+|after| values $(a,a')$, even in the presence of rounding errors,
+as long as $\vert b-b'\vert<2^{28}$.
+
+@<Transform the |x| coordinates@>=
+begin make_safe;
+repeat decr(cur_rounding_ptr);
+if (after[cur_rounding_ptr]<>before[cur_rounding_ptr])or@|
+ (after[cur_rounding_ptr+1]<>before[cur_rounding_ptr+1]) then
+ begin p:=node_to_round[cur_rounding_ptr];
+ if odd(right_type(p)) then
+ begin b:=before[cur_rounding_ptr]; a:=after[cur_rounding_ptr];
+ end
+ else begin b:=-before[cur_rounding_ptr]; a:=-after[cur_rounding_ptr];
+ end;
+ if before[cur_rounding_ptr]=before[cur_rounding_ptr+1] then
+ alpha:=fraction_one
+ else alpha:=make_fraction(after[cur_rounding_ptr+1]-after[cur_rounding_ptr],@|
+ before[cur_rounding_ptr+1]-before[cur_rounding_ptr]);
+ repeat x_coord(p):=take_fraction(alpha,x_coord(p)-b)+a;
+ right_x(p):=take_fraction(alpha,right_x(p)-b)+a;
+ p:=link(p); left_x(p):=take_fraction(alpha,left_x(p)-b)+a;
+ until p=node_to_round[cur_rounding_ptr+1];
+ end;
+until cur_rounding_ptr=0;
+end
+
+@ When |y| has been negated, the |octant| codes are |>negate_y|. Otherwise
+these routines are essentially identical to the routines for |x| coordinates
+that we have just seen.
+
+@<If node |q| is a transition point for |y| coordinates...@>=
+if (right_type(p)>negate_y)<>(right_type(q)>negate_y) then
+ begin if right_type(q)<=negate_y then b:=y_coord(q)@+else b:=-y_coord(q);
+ if (abs(y_coord(q)-right_y(q))<655)or@|
+ (abs(y_coord(q)+left_y(q))<655) then
+ @<Compute before-and-after |y| values based on the current pen@>
+ else a:=b;
+ if abs(a)>max_allowed then
+ if a>0 then a:=max_allowed@+else a:=-max_allowed;
+ before_and_after(b,a,q);
+ end
+
+@ @<Compute before-and-after |y| values based on the current pen@>=
+begin if cur_pen=null_pen then pen_edge:=0
+else if cur_path_type=double_path_code then
+ pen_edge:=compromise(north_edge(cur_pen),south_edge(cur_pen))
+else if right_type(q)<=negate_y then pen_edge:=south_edge(cur_pen)
+else pen_edge:=north_edge(cur_pen);
+a:=good_val(b,pen_edge);
+end
+
+@ @<Transform the |y| coordinates@>=
+begin make_safe;
+repeat decr(cur_rounding_ptr);
+if (after[cur_rounding_ptr]<>before[cur_rounding_ptr])or@|
+ (after[cur_rounding_ptr+1]<>before[cur_rounding_ptr+1]) then
+ begin p:=node_to_round[cur_rounding_ptr];
+ if right_type(p)<=negate_y then
+ begin b:=before[cur_rounding_ptr]; a:=after[cur_rounding_ptr];
+ end
+ else begin b:=-before[cur_rounding_ptr]; a:=-after[cur_rounding_ptr];
+ end;
+ if before[cur_rounding_ptr]=before[cur_rounding_ptr+1] then
+ alpha:=fraction_one
+ else alpha:=make_fraction(after[cur_rounding_ptr+1]-after[cur_rounding_ptr],@|
+ before[cur_rounding_ptr+1]-before[cur_rounding_ptr]);
+ repeat y_coord(p):=take_fraction(alpha,y_coord(p)-b)+a;
+ right_y(p):=take_fraction(alpha,right_y(p)-b)+a;
+ p:=link(p); left_y(p):=take_fraction(alpha,left_y(p)-b)+a;
+ until p=node_to_round[cur_rounding_ptr+1];
+ end;
+until cur_rounding_ptr=0;
+end
+
+@ Rounding at diagonal tangents takes place after the subdivision into
+octants is complete, hence after the coordinates have been skewed.
+The details are somewhat tricky, because we want to round to points
+whose skewed coordinates are halfway between integer multiples of
+the granularity. Furthermore, both coordinates change when they are
+rounded; this means we need a generalization of the |make_safe| routine,
+ensuring safety in both |x| and |y|.
+
+In spite of these extra complications, we can take comfort in the fact
+that the basic structure of the routine is the same as before.
+
+@<Declare subroutines needed by |make_spec|@>=
+procedure diag_round;
+var @!p,@!q,@!pp:pointer; {list manipulation registers}
+@!b,@!a,@!bb,@!aa,@!d,@!c,@!dd,@!cc:scaled; {before and after values}
+@!pen_edge:scaled; {offset that governs rounding}
+@!alpha,@!beta:fraction; {coefficients of linear transformation}
+@!next_a:scaled; {|after[k]| before it might have changed}
+@!all_safe:boolean; {does everything look OK so far?}
+@!k:0..max_wiggle; {runs through before-and-after values}
+@!first_x,@!first_y:scaled; {coordinates before rounding}
+begin p:=cur_spec; cur_rounding_ptr:=0;
+repeat q:=link(p);
+@<If node |q| is a transition point between octants,
+ compute and save its before-and-after coordinates@>;
+p:=q;
+until p=cur_spec;
+if cur_rounding_ptr>0 then @<Transform the skewed coordinates@>;
+end;
+
+@ We negate the skewed |x| coordinates in the before-and-after table when
+the octant code is greater than |switch_x_and_y|.
+
+@<If node |q| is a transition point between octants...@>=
+if right_type(p)<>right_type(q) then
+ begin if right_type(q)>switch_x_and_y then b:=-x_coord(q)
+ else b:=x_coord(q);
+ if abs(right_type(q)-right_type(p))=switch_x_and_y then
+ if (abs(x_coord(q)-right_x(q))<655)or(abs(x_coord(q)+left_x(q))<655) then
+ @<Compute a good coordinate at a diagonal transition@>
+ else a:=b
+ else a:=b;
+ before_and_after(b,a,q);
+ end
+
+@ In octants whose code number is even, $x$~has been
+negated; we want to round ambiguous cases downward instead of upward,
+so that the rounding will be consistent with octants whose code
+number is odd. This downward bias can be achieved by
+subtracting~1 from the first argument of |good_val|.
+
+@d diag_offset(#)==x_coord(knil(link(cur_pen+#)))
+
+@<Compute a good coordinate at a diagonal transition@>=
+begin if cur_pen=null_pen then pen_edge:=0
+else if cur_path_type=double_path_code then @<Compute a compromise |pen_edge|@>
+else if right_type(q)<=switch_x_and_y then pen_edge:=diag_offset(right_type(q))
+else pen_edge:=-diag_offset(right_type(q));
+if odd(right_type(q)) then a:=good_val(b,pen_edge+half(cur_gran))
+else a:=good_val(b-1,pen_edge+half(cur_gran));
+end
+
+@ (It seems a shame to compute these compromise offsets repeatedly. The
+author would have stored them directly in the pen data structure, if the
+granularity had been constant.)
+
+@<Compute a compromise...@>=
+case right_type(q) of
+first_octant,second_octant:pen_edge:=compromise(diag_offset(first_octant),@|
+ -diag_offset(fifth_octant));
+fifth_octant,sixth_octant:pen_edge:=-compromise(diag_offset(first_octant),@|
+ -diag_offset(fifth_octant));
+third_octant,fourth_octant:pen_edge:=compromise(diag_offset(fourth_octant),@|
+ -diag_offset(eighth_octant));
+seventh_octant,eighth_octant:pen_edge:=-compromise(diag_offset(fourth_octant),@|
+ -diag_offset(eighth_octant));
+end {there are no other cases}
+
+@ @<Transform the skewed coordinates@>=
+begin p:=node_to_round[0]; first_x:=x_coord(p); first_y:=y_coord(p);
+@<Make sure that all the diagonal roundings are safe@>;
+for k:=0 to cur_rounding_ptr-1 do
+ begin a:=after[k]; b:=before[k];
+ aa:=after[k+1]; bb:=before[k+1];
+ if (a<>b)or(aa<>bb) then
+ begin p:=node_to_round[k]; pp:=node_to_round[k+1];
+ @<Determine the before-and-after values of both coordinates@>;
+ if b=bb then alpha:=fraction_one
+ else alpha:=make_fraction(aa-a,bb-b);
+ if d=dd then beta:=fraction_one
+ else beta:=make_fraction(cc-c,dd-d);
+ repeat x_coord(p):=take_fraction(alpha,x_coord(p)-b)+a;
+ y_coord(p):=take_fraction(beta,y_coord(p)-d)+c;
+ right_x(p):=take_fraction(alpha,right_x(p)-b)+a;
+ right_y(p):=take_fraction(beta,right_y(p)-d)+c;
+ p:=link(p); left_x(p):=take_fraction(alpha,left_x(p)-b)+a;
+ left_y(p):=take_fraction(beta,left_y(p)-d)+c;
+ until p=pp;
+ end;
+ end;
+end
+
+@ In node |p|, the coordinates |(b,d)| will be rounded to |(a,c)|;
+in node |pp|, the coordinates |(bb,dd)| will be rounded to |(aa,cc)|.
+(We transform the values from node |pp| so that they agree with the
+conventions of node |p|.)
+
+If |aa<>bb|, we know that |abs(right_type(p)-right_type(pp))=switch_x_and_y|.
+
+@<Determine the before-and-after values of both coordinates@>=
+if aa=bb then
+ begin if pp=node_to_round[0] then
+ unskew(first_x,first_y,right_type(pp))
+ else unskew(x_coord(pp),y_coord(pp),right_type(pp));
+ skew(cur_x,cur_y,right_type(p));
+ bb:=cur_x; aa:=bb; dd:=cur_y; cc:=dd;
+ if right_type(p)>switch_x_and_y then
+ begin b:=-b; a:=-a;
+ end;
+ end
+else begin if right_type(p)>switch_x_and_y then
+ begin bb:=-bb; aa:=-aa; b:=-b; a:=-a;
+ end;
+ if pp=node_to_round[0] then dd:=first_y-bb@+else dd:=y_coord(pp)-bb;
+ if odd(aa-bb) then
+ if right_type(p)>switch_x_and_y then cc:=dd-half(aa-bb+1)
+ else cc:=dd-half(aa-bb-1)
+ else cc:=dd-half(aa-bb);
+ end;
+d:=y_coord(p);
+if odd(a-b) then
+ if right_type(p)>switch_x_and_y then c:=d-half(a-b-1)
+ else c:=d-half(a-b+1)
+else c:=d-half(a-b)
+
+@ @<Make sure that all the diagonal roundings are safe@>=
+before[cur_rounding_ptr]:=before[0]; {cf.~|make_safe|}
+node_to_round[cur_rounding_ptr]:=node_to_round[0];
+repeat after[cur_rounding_ptr]:=after[0]; all_safe:=true; next_a:=after[0];
+for k:=0 to cur_rounding_ptr-1 do
+ begin a:=next_a; b:=before[k]; next_a:=after[k+1];
+ aa:=next_a; bb:=before[k+1];
+ if (a<>b)or(aa<>bb) then
+ begin p:=node_to_round[k]; pp:=node_to_round[k+1];
+ @<Determine the before-and-after values of both coordinates@>;
+ if (aa<a)or(cc<c)or(aa-a>2*(bb-b))or(cc-c>2*(dd-d)) then
+ begin all_safe:=false; after[k]:=before[k];
+ if k=cur_rounding_ptr-1 then after[0]:=before[0]
+ else after[k+1]:=before[k+1];
+ end;
+ end;
+ end;
+until all_safe
+
+@ Here we get rid of ``dead'' cubics, i.e., polynomials that don't move at
+all when |t|~changes, since the subdivision process might have introduced
+such things. If the cycle reduces to a single point, however, we are left
+with a single dead cubic that will not be removed until later.
+
+@<Remove dead cubics@>=
+p:=cur_spec;
+repeat continue: q:=link(p);
+if p<>q then
+ begin if x_coord(p)=right_x(p) then
+ if y_coord(p)=right_y(p) then
+ if x_coord(p)=left_x(q) then
+ if y_coord(p)=left_y(q) then
+ begin unskew(x_coord(q),y_coord(q),right_type(q));
+ skew(cur_x,cur_y,right_type(p));
+ if x_coord(p)=cur_x then if y_coord(p)=cur_y then
+ begin remove_cubic(p); {remove the cubic following |p|}
+ if q<>cur_spec then goto continue;
+ cur_spec:=p; q:=p;
+ end;
+ end;
+ end;
+p:=q;
+until p=cur_spec;
+
+@ Finally we come to the last steps of |make_spec|, when boundary nodes
+are inserted between cubics that move in different octants. The main
+complication remaining arises from consecutive cubics whose octants
+are not adjacent; we should insert more than one octant boundary
+at such sharp turns, so that the envelope-forming routine will work.
+
+For this purpose, conversion tables between numeric and Gray codes for
+octants are desirable.
+
+@<Glob...@>=
+@!octant_number:array[first_octant..sixth_octant] of 1..8;
+@!octant_code:array[1..8] of first_octant..sixth_octant;
+
+@ @<Set init...@>=
+octant_code[1]:=first_octant;
+octant_code[2]:=second_octant;
+octant_code[3]:=third_octant;
+octant_code[4]:=fourth_octant;
+octant_code[5]:=fifth_octant;
+octant_code[6]:=sixth_octant;
+octant_code[7]:=seventh_octant;
+octant_code[8]:=eighth_octant;
+for k:=1 to 8 do octant_number[octant_code[k]]:=k;
+
+@ The main loop for boundary insertion deals with three consecutive
+nodes |p,q,r|.
+
+@<Insert octant boundaries and compute the turning number@>=
+turning_number:=0;
+p:=cur_spec; q:=link(p);
+repeat r:=link(q);
+if (right_type(p)<>right_type(q))or(q=r) then
+ @<Insert one or more octant boundary nodes just before~|q|@>;
+p:=q; q:=r;
+until p=cur_spec;
+
+@ The |new_boundary| subroutine comes in handy at this point. It inserts
+a new boundary node just after a given node |p|, using a given octant code
+to transform the new node's coordinates. The ``transition'' fields are
+not computed here.
+
+@<Declare subroutines needed by |make_spec|@>=
+procedure new_boundary(@!p:pointer;@!octant:small_number);
+var @!q,@!r:pointer; {for list manipulation}
+begin q:=link(p); {we assume that |right_type(q)<>endpoint|}
+r:=get_node(knot_node_size); link(r):=q; link(p):=r;
+left_type(r):=left_type(q); {but possibly |left_type(q)=endpoint|}
+left_x(r):=left_x(q); left_y(r):=left_y(q);
+right_type(r):=endpoint; left_type(q):=endpoint;
+right_octant(r):=octant; left_octant(q):=right_type(q);
+unskew(x_coord(q),y_coord(q),right_type(q));
+skew(cur_x,cur_y,octant); x_coord(r):=cur_x; y_coord(r):=cur_y;
+end;
+
+@ The case |q=r| occurs if and only if |p=q=r=cur_spec|, when we want to turn
+$360^\circ$ in eight steps and then remove a solitary dead cubic.
+The program below happens to work in that case, but the reader isn't
+expected to understand why.
+
+@<Insert one or more octant boundary nodes just before~|q|@>=
+begin new_boundary(p,right_type(p)); s:=link(p);
+o1:=octant_number[right_type(p)]; o2:=octant_number[right_type(q)];
+case o2-o1 of
+1,-7,7,-1: goto done;
+2,-6: clockwise:=false;
+3,-5,4,-4,5,-3: @<Decide whether or not to go clockwise@>;
+6,-2: clockwise:=true;
+0:clockwise:=rev_turns;
+end; {there are no other cases}
+@<Insert additional boundary nodes, then |goto done|@>;
+done: if q=r then
+ begin q:=link(q); r:=q; p:=s; link(s):=q; left_octant(q):=right_octant(q);
+ left_type(q):=endpoint; free_node(cur_spec,knot_node_size); cur_spec:=q;
+ end;
+@<Fix up the transition fields and adjust the turning number@>;
+end
+
+@ @<Other local variables for |make_spec|@>=
+@!o1,@!o2:small_number; {octant numbers}
+@!clockwise:boolean; {should we turn clockwise?}
+@!dx1,@!dy1,@!dx2,@!dy2:integer; {directions of travel at a cusp}
+@!dmax,@!del:integer; {temporary registers}
+
+@ A tricky question arises when a path jumps four octants. We want the
+direction of turning to be counterclockwise if the curve has changed
+direction by $180^\circ$, or by something so close to $180^\circ$ that
+the difference is probably due to rounding errors; otherwise we want to
+turn through an angle of less than $180^\circ$. This decision needs to
+be made even when a curve seems to have jumped only three octants, since
+a curve may approach direction $(-1,0)$ from the fourth octant, then
+it might leave from direction $(+1,0)$ into the first.
+
+The following code solves the problem by analyzing the incoming
+direction |(dx1,dy1)| and the outgoing direction |(dx2,dy2)|.
+
+@<Decide whether or not to go clockwise@>=
+begin @<Compute the incoming and outgoing directions@>;
+unskew(dx1,dy1,right_type(p)); del:=pyth_add(cur_x,cur_y);@/
+dx1:=make_fraction(cur_x,del); dy1:=make_fraction(cur_y,del);
+ {$\cos\theta_1$ and $\sin\theta_1$}
+unskew(dx2,dy2,right_type(q)); del:=pyth_add(cur_x,cur_y);@/
+dx2:=make_fraction(cur_x,del); dy2:=make_fraction(cur_y,del);
+ {$\cos\theta_2$ and $\sin\theta_2$}
+del:=take_fraction(dx1,dy2)-take_fraction(dx2,dy1); {$\sin(\theta_2-\theta_1)$}
+if del>4684844 then clockwise:=false
+else if del<-4684844 then clockwise:=true
+ {$2^{28}\cdot\sin 1^\circ\approx4684844.68$}
+else clockwise:=rev_turns;
+end
+
+@ Actually the turnarounds just computed will be clockwise,
+not counterclockwise, if
+the global variable |rev_turns| is |true|; it is usually |false|.
+
+@<Glob...@>=
+@!rev_turns:boolean; {should we make U-turns in the English manner?}
+
+@ @<Set init...@>=
+rev_turns:=false;
+
+@ @<Compute the incoming and outgoing directions@>=
+dx1:=x_coord(s)-left_x(s); dy1:=y_coord(s)-left_y(s);
+if dx1=0 then if dy1=0 then
+ begin dx1:=x_coord(s)-right_x(p); dy1:=y_coord(s)-right_y(p);
+ if dx1=0 then if dy1=0 then
+ begin dx1:=x_coord(s)-x_coord(p); dy1:=y_coord(s)-y_coord(p);
+ end; {and they {\sl can't} both be zero}
+ end;
+dmax:=abs(dx1);@+if abs(dy1)>dmax then dmax:=abs(dy1);
+while dmax<fraction_one do
+ begin double(dmax); double(dx1); double(dy1);
+ end;
+dx2:=right_x(q)-x_coord(q); dy2:=right_y(q)-y_coord(q);
+if dx2=0 then if dy2=0 then
+ begin dx2:=left_x(r)-x_coord(q); dy2:=left_y(r)-y_coord(q);
+ if dx2=0 then if dy2=0 then
+ begin if right_type(r)=endpoint then
+ begin cur_x:=x_coord(r); cur_y:=y_coord(r);
+ end
+ else begin unskew(x_coord(r),y_coord(r),right_type(r));
+ skew(cur_x,cur_y,right_type(q));
+ end;
+ dx2:=cur_x-x_coord(q); dy2:=cur_y-y_coord(q);
+ end; {and they {\sl can't} both be zero}
+ end;
+dmax:=abs(dx2);@+if abs(dy2)>dmax then dmax:=abs(dy2);
+while dmax<fraction_one do
+ begin double(dmax); double(dx2); double(dy2);
+ end
+
+@ @<Insert additional boundary nodes...@>=
+loop@+ begin if clockwise then
+ if o1=1 then o1:=8@+else decr(o1)
+ else if o1=8 then o1:=1@+else incr(o1);
+ if o1=o2 then goto done;
+ new_boundary(s,octant_code[o1]);
+ s:=link(s); left_octant(s):=right_octant(s);
+ end
+
+@ Now it remains to insert the redundant
+transition information into the |left_transition|
+and |right_transition| fields between adjacent octants, in the octant
+boundary nodes that have just been inserted between |link(p)| and~|q|.
+The turning number is easily computed from these transitions.
+
+@<Fix up the transition fields and adjust the turning number@>=
+p:=link(p);
+repeat s:=link(p);
+o1:=octant_number[right_octant(p)]; o2:=octant_number[left_octant(s)];
+if abs(o1-o2)=1 then
+ begin if o2<o1 then o2:=o1;
+ if odd(o2) then right_transition(p):=axis
+ else right_transition(p):=diagonal;
+ end
+else begin if o1=8 then incr(turning_number)@+else decr(turning_number);
+ right_transition(p):=axis;
+ end;
+left_transition(s):=right_transition(p);
+p:=s;
+until p=q
+
+@* \[22] Filling a contour.
+Given the low-level machinery for making moves and for transforming a
+cyclic path into a cycle spec, we're almost able to fill a digitized path.
+All we need is a high-level routine that walks through the cycle spec and
+controls the overall process.
+
+Our overall goal is to plot the integer points $\bigl(\round(x(t)),
+\round(y(t))\bigr)$ and to connect them by rook moves, assuming that
+$\round(x(t))$ and $\round(y(t))$ don't both jump simultaneously from
+one integer to another as $t$~varies; these rook moves will be the edge
+of the contour that will be filled. We have reduced this problem to the
+case of curves that travel in first octant directions, i.e., curves
+such that $0\L y'(t)\L x'(t)$, by transforming the original coordinates.
+
+\def\xtilde{{\tilde x}} \def\ytilde{{\tilde y}}
+Another transformation makes the problem still simpler. We shall say that
+we are working with {\sl biased coordinates\/} when $(x,y)$ has been
+replaced by $(\xtilde,\ytilde)=(x-y,y+{1\over2})$. When a curve travels
+in first octant directions, the corresponding curve with biased
+coordinates travels in first {\sl quadrant\/} directions; the latter
+condition is symmetric in $x$ and~$y$, so it has advantages for the
+design of algorithms. The |make_spec| routine gives us skewed coordinates
+$(x-y,y)$, hence we obtain biased coordinates by simply adding $1\over2$
+to the second component.
+
+The most important fact about biased coordinates is that we can determine the
+rounded unbiased path $\bigl(\round(x(t)),\round(y(t))\bigr)$ from the
+truncated biased path $\bigl(\lfloor\xtilde(t)\rfloor,\lfloor\ytilde(t)\rfloor
+\bigr)$ and information about the initial and final endpoints. If the
+unrounded and unbiased
+path begins at $(x_0,y_0)$ and ends at $(x_1,y_1)$, it's possible to
+prove (by induction on the length of truncated biased path) that the
+rounded unbiased path is obtained by the following construction:
+
+\yskip\textindent{1)} Start at $\bigl(\round(x_0),\round(y_0)\bigr)$.
+
+\yskip\textindent{2)} If $(x_0+{1\over2})\bmod1\G(y_0+{1\over2})\bmod1$,
+move one step right.
+
+\yskip\textindent{3)} Whenever the path
+$\bigl(\lfloor\xtilde(t)\rfloor,\lfloor\ytilde(t)\rfloor\bigr)$
+takes an upward step (i.e., when
+$\lfloor\xtilde(t+\epsilon)\rfloor=\lfloor\xtilde(t)\rfloor$ and
+$\lfloor\ytilde(t+\epsilon)\rfloor=\lfloor\ytilde(t)\rfloor+1$),
+move one step up and then one step right.
+
+\yskip\textindent{4)} Whenever the path
+$\bigl(\lfloor\xtilde(t)\rfloor,\lfloor\ytilde(t)\rfloor\bigr)$
+takes a rightward step (i.e., when
+$\lfloor\xtilde(t+\epsilon)\rfloor=\lfloor\xtilde(t)\rfloor+1$ and
+$\lfloor\ytilde(t+\epsilon)\rfloor=\lfloor\ytilde(t)\rfloor$),
+move one step right.
+
+\yskip\textindent{5)} Finally, if
+$(x_1+{1\over2})\bmod1\G(y_1+{1\over2})\bmod1$, move one step left (thereby
+cancelling the previous move, which was one step right). You will now be
+at the point $\bigl(\round(x_1),\round(y_1)\bigr)$.
+
+@ In order to validate the assumption that $\round(x(t))$ and $\round(y(t))$
+don't both jump simultaneously, we shall consider that a coordinate pair
+$(x,y)$ actually represents $(x+\epsilon,y+\epsilon\delta)$, where
+$\epsilon$ and $\delta$ are extremely small positive numbers---so small
+that their precise values never matter. This convention makes rounding
+unambiguous, since there is always a unique integer point nearest to any
+given scaled numbers~$(x,y)$.
+
+When coordinates are transformed so that \MF\ needs to work only in ``first
+octant'' directions, the transformations involve negating~$x$, negating~$y$,
+and/or interchanging $x$ with~$y$. Corresponding adjustments to the
+rounding conventions must be made so that consistent values will be
+obtained. For example, suppose that we're working with coordinates that
+have been transformed so that a third-octant curve travels in first-octant
+directions. The skewed coordinates $(x,y)$ in our data structure represent
+unskewed coordinates $(-y,x+y)$, which are actually $(-y+\epsilon,
+x+y+\epsilon\delta)$. We should therefore round as if our skewed coordinates
+were $(x+\epsilon+\epsilon\delta,y-\epsilon)$ instead of $(x,y)$. The following
+table shows how the skewed coordinates should be perturbed when rounding
+decisions are made:
+$$\vcenter{\halign{#\hfil&&\quad$#$\hfil&\hskip4em#\hfil\cr
+|first_octant|&(x+\epsilon-\epsilon\delta,y+\epsilon\delta)&
+ |fifth_octant|&(x-\epsilon+\epsilon\delta,y-\epsilon\delta)\cr
+|second_octant|&(x-\epsilon+\epsilon\delta,y+\epsilon)&
+ |sixth_octant|&(x+\epsilon-\epsilon\delta,y-\epsilon)\cr
+|third_octant|&(x+\epsilon+\epsilon\delta,y-\epsilon)&
+ |seventh_octant|&(x-\epsilon-\epsilon\delta,y+\epsilon)\cr
+|fourth_octant|&(x-\epsilon-\epsilon\delta,y+\epsilon\delta)&
+ |eighth_octant|&(x+\epsilon+\epsilon\delta,y-\epsilon\delta)\cr}}$$
+
+Four small arrays are set up so that the rounding operations will be
+fairly easy in any given octant.
+
+@<Glob...@>=
+@!y_corr,@!xy_corr,@!z_corr:array[first_octant..sixth_octant] of 0..1;
+@!x_corr:array[first_octant..sixth_octant] of -1..1;
+
+@ Here |xy_corr| is 1 if and only if the $x$ component of a skewed coordinate
+is to be decreased by an infinitesimal amount; |y_corr| is similar, but for
+the $y$ components. The other tables are set up so that the condition
+$$(x+y+|half_unit|)\bmod|unity|\G(y+|half_unit|)\bmod|unity|$$
+is properly perturbed to the condition
+$$(x+y+|half_unit|-|x_corr|-|y_corr|)\bmod|unity|\G
+ (y+|half_unit|-|y_corr|)\bmod|unity|+|z_corr|.$$
+
+@<Set init...@>=
+x_corr[first_octant]:=0; y_corr[first_octant]:=0;
+xy_corr[first_octant]:=0;@/
+x_corr[second_octant]:=0; y_corr[second_octant]:=0;
+xy_corr[second_octant]:=1;@/
+x_corr[third_octant]:=-1; y_corr[third_octant]:=1;
+xy_corr[third_octant]:=0;@/
+x_corr[fourth_octant]:=1; y_corr[fourth_octant]:=0;
+xy_corr[fourth_octant]:=1;@/
+x_corr[fifth_octant]:=0; y_corr[fifth_octant]:=1;
+xy_corr[fifth_octant]:=1;@/
+x_corr[sixth_octant]:=0; y_corr[sixth_octant]:=1;
+xy_corr[sixth_octant]:=0;@/
+x_corr[seventh_octant]:=1; y_corr[seventh_octant]:=0;
+xy_corr[seventh_octant]:=1;@/
+x_corr[eighth_octant]:=-1; y_corr[eighth_octant]:=1;
+xy_corr[eighth_octant]:=0;@/
+for k:=1 to 8 do z_corr[k]:=xy_corr[k]-x_corr[k];
+
+@ Here's a procedure that handles the details of rounding at the
+endpoints: Given skewed coordinates |(x,y)|, it sets |(m1,n1)|
+to the corresponding rounded lattice points, taking the current
+|octant| into account. Global variable |d1| is also set to 1 if
+$(x+y+{1\over2})\bmod1\G(y+{1\over2})\bmod1$.
+
+@p procedure end_round(@!x,@!y:scaled);
+begin y:=y+half_unit-y_corr[octant];
+x:=x+y-x_corr[octant];
+m1:=floor_unscaled(x); n1:=floor_unscaled(y);
+if x-unity*m1>=y-unity*n1+z_corr[octant] then d1:=1@+else d1:=0;
+end;
+
+@ The outputs |(m1,n1,d1)| of |end_round| will sometimes be moved
+to |(m0,n0,d0)|.
+
+@<Glob...@>=
+@!m0,@!n0,@!m1,@!n1:integer; {lattice point coordinates}
+@!d0,@!d1:0..1; {displacement corrections}
+
+@ We're ready now to fill the pixels enclosed by a given cycle spec~|h|;
+the knot list that represents the cycle is destroyed in the process.
+The edge structure that gets all the resulting data is |cur_edges|,
+and the edges are weighted by |cur_wt|.
+
+@p procedure fill_spec(@!h:pointer);
+var @!p,@!q,@!r,@!s:pointer; {for list traversal}
+begin if internal[tracing_edges]>0 then begin_edge_tracing;
+p:=h; {we assume that |left_type(h)=endpoint|}
+repeat octant:=left_octant(p);
+@<Set variable |q| to the node at the end of the current octant@>;
+if q<>p then
+ begin @<Determine the starting and ending
+ lattice points |(m0,n0)| and |(m1,n1)|@>;
+ @<Make the moves for the current octant@>;
+ move_to_edges(m0,n0,m1,n1);
+ end;
+p:=link(q);
+until p=h;
+toss_knot_list(h);
+if internal[tracing_edges]>0 then end_edge_tracing;
+end;
+
+@ @<Set variable |q| to the node at the end of the current octant@>=
+q:=p;
+while right_type(q)<>endpoint do q:=link(q)
+
+@ @<Determine the starting and ending lattice points |(m0,n0)| and |(m1,n1)|@>=
+end_round(x_coord(p),y_coord(p)); m0:=m1; n0:=n1; d0:=d1;@/
+end_round(x_coord(q),y_coord(q))
+
+@ Finally we perform the five-step process that was explained at
+the very beginning of this part of the program.
+
+@<Make the moves for the current octant@>=
+if n1-n0>=move_size then overflow("move table size",move_size);
+@:METAFONT capacity exceeded move table size}{\quad move table size@>
+move[0]:=d0; move_ptr:=0; r:=p;
+repeat s:=link(r);@/
+make_moves(x_coord(r),right_x(r),left_x(s),x_coord(s),@|
+ y_coord(r)+half_unit,right_y(r)+half_unit,left_y(s)+half_unit,
+ y_coord(s)+half_unit,@| xy_corr[octant],y_corr[octant]);
+r:=s;
+until r=q;
+move[move_ptr]:=move[move_ptr]-d1;
+if internal[smoothing]>0 then smooth_moves(0,move_ptr)
+
+@* \[23] Polygonal pens.
+The next few parts of the program deal with the additional complications
+associated with ``envelopes,'' leading up to an algorithm that fills a
+contour with respect to a pen whose boundary is a convex polygon. The
+mathematics underlying this algorithm is based on simple aspects of the
+theory of tracings developed by Leo Guibas, Lyle Ramshaw, and Jorge
+Stolfi [``A kinetic framework for computational geometry,''
+{\sl Proc.\ IEEE Symp.\ Foundations of Computer Science\/ \bf24} (1983),
+100--111].
+@^Guibas, Leonidas Ioannis@>
+@^Ramshaw, Lyle Harold@>
+@^Stolfi, Jorge@>
+
+If the vertices of the polygon are $w_0$, $w_1$, \dots, $w_{n-1}$, $w_n=w_0$,
+in counterclockwise order, the convexity condition requires that ``left
+turns'' are made at each vertex when a person proceeds from $w_0$ to
+$w_1$ to $\cdots$ to~$w_n$. The envelope is obtained if we offset a given
+curve $z(t)$ by $w_k$ when that curve is traveling in a direction
+$z'(t)$ lying between the directions $w_k-w_{k-1}$ and $w\k-w_k$.
+At times~$t$ when the curve direction $z'(t)$ increases past
+$w\k-w_k$, we temporarily stop plotting the offset curve and we insert
+a straight line from $z(t)+w_k$ to $z(t)+w\k$; notice that this straight
+line is tangent to the offset curve. Similarly, when the curve direction
+decreases past $w_k-w_{k-1}$, we stop plotting and insert a straight
+line from $z(t)+w_k$ to $z(t)+w_{k-1}$; the latter line is actually a
+``retrograde'' step, which won't be part of the final envelope under
+\MF's assumptions. The result of this construction is a continuous path
+that consists of alternating curves and straight line segments. The
+segments are usually so short, in practice, that they blend with the
+curves; after all, it's possible to represent any digitized path as
+a sequence of digitized straight lines.
+
+The nicest feature of this approach to envelopes is that it blends
+perfectly with the octant subdivision process we have already developed.
+The envelope travels in the same direction as the curve itself, as we
+plot it, and we need merely be careful what offset is being added.
+Retrograde motion presents a problem, but we will see that there is
+a decent way to handle it.
+
+@ We shall represent pens by maintaining eight lists of offsets,
+one for each octant direction. The offsets at the boundary points
+where a curve turns into a new octant will appear in the lists for
+both octants. This means that we can restrict consideration to
+segments of the original polygon whose directions aim in the first
+octant, as we have done in the simpler case when envelopes were not
+required.
+
+An example should help to clarify this situation: Consider the
+quadrilateral whose vertices are $w_0=(0,-1)$, $w_1=(3,-1)$,
+$w_2=(6,1)$, and $w_3=(1,2)$. A curve that travels in the first octant
+will be offset by $w_1$ or $w_2$, unless its slope drops to zero
+en route to the eighth octant; in the latter case we should switch to $w_0$ as
+we cross the octant boundary. Our list for the first octant will
+contain the three offsets $w_0$, $w_1$,~$w_2$. By convention we will
+duplicate a boundary offset if the angle between octants doesn't
+explicitly appear; in this case there is no explicit line of slope~1
+at the end of the list, so the full list is
+$$w_0\;w_1\;w_2\;w_2\;=\;(0,-1)\;(3,-1)\;(6,1)\;(6,1).$$
+With skewed coordinates $(u-v,v)$ instead of $(u,v)$ we obtain the list
+$$w_0\;w_1\;w_2\;w_2\;\mapsto\;(1,-1)\;(4,-1)\;(5,1)\;(5,1),$$
+which is what actually appears in the data structure. In the second
+octant there's only one offset; we list it three times (with coordinates
+interchanged, so as to make the second octant look like the first),
+and skew those coordinates, obtaining
+$$\tabskip\centering
+\halign to\hsize{$\hfil#\;\mapsto\;{}$\tabskip=0pt&
+ $#\hfil$&\quad in the #\hfil\tabskip\centering\cr
+w_2\;w_2\;w_2&(-5,6)\;(-5,6)\;(-5,6)\cr
+\noalign{\vskip\belowdisplayskip
+\vbox{\noindent\strut as the list of transformed and skewed offsets to use
+when curves that travel in the second octant. Similarly, we will have\strut}
+\vskip\abovedisplayskip}
+w_2\;w_2\;w_2&(7,-6)\;(7,-6)\;(7,-6)&third;\cr
+w_2\;w_2\;w_3\;w_3&(-7,1)\;(-7,1)\;(-3,2)\;(-3,2)&fourth;\cr
+w_3\;w_3\;w_3&(3,-2)\;(3,-2)\;(3,-2)&fifth;\cr
+w_3\;w_3\;w_0\;w_0&(-3,1)\;(-3,1)\;(1,0)\;(1,0)&sixth;\cr
+w_0\;w_0\;w_0&(1,0)\;(1,0)\;(1,0)&seventh;\cr
+w_0\;w_0\;w_0&(-1,1)\;(-1,1)\;(-1,1)&eighth.\cr}$$
+Notice that $w_1$ is considered here to be internal to the first octant;
+it's not part of the eighth. We could equally well have taken $w_0$ out
+of the first octant list and put it into the eighth; then the first octant
+list would have been
+$$w_1\;w_1\;w_2\;w_2\;\mapsto\;(4,-1)\;(4,-1)\;(5,1)\;(5,1)$$
+and the eighth octant list would have been
+$$w_0\;w_0\;w_1\;\mapsto\;(-1,1)\;(-1,1)\;(2,1).$$
+
+Actually, there's one more complication: The order of offsets is reversed
+in even-numbered octants, because the transformation of coordinates has
+reversed counterclockwise and clockwise orientations in those octants.
+The offsets in the fourth octant, for example, are really $w_3$, $w_3$,
+$w_2$,~$w_2$, not $w_2$, $w_2$, $w_3$,~$w_3$.
+
+@ In general, the list of offsets for an octant will have the form
+$$w_0\;\;w_1\;\;\ldots\;\;w_n\;\;w_{n+1}$$
+(if we renumber the subscripts in each list), where $w_0$ and $w_{n+1}$
+are offsets common to the neighboring lists. We'll often have $w_0=w_1$
+and/or $w_n=w_{n+1}$, but the other $w$'s will be distinct. Curves
+that travel between slope~0 and direction $w_2-w_1$ will use offset~$w_1$;
+curves that travel between directions $w_k-w_{k-1}$ and $w\k-w_k$ will
+use offset~$w_k$, for $1<k<n$; curves between direction $w_n-w_{n-1}$
+and slope~1 (actually slope~$\infty$ after skewing) will use offset~$w_n$.
+In even-numbered octants, the directions are actually $w_k-w\k$ instead
+of $w\k-w_k$, because the offsets have been listed in reverse order.
+
+Each offset $w_k$ is represented by skewed coordinates $(u_k-v_k,v_k)$,
+where $(u_k,v_k)$ is the representation of $w_k$ after it has been rotated
+into a first-octant disguise.
+
+@ The top-level data structure of a pen polygon is a 10-word node containing
+a reference count followed by pointers to the eight pen lists, followed
+by an indication of the pen's range of values.
+
+If |p|~points to such a node, and if the
+offset list for, say, the fourth octant has entries $w_0$, $w_1$, \dots,
+$w_n$,~$w_{n+1}$, then |info(p+fourth_octant)| will equal~$n$, and
+|link(p+fourth_octant)| will point to the offset node containing~$w_0$.
+Memory location |p+fourth_octant| is said to be the {\sl header\/} of
+the pen-offset list for the fourth octant. Since this is an even-numbered
+octant, $w_0$ is the offset that goes with the fifth octant, and
+$w_{n+1}$ goes with the third.
+
+The elements of the offset list themselves are doubly linked 3-word nodes,
+containing coordinates in their |x_coord| and |y_coord| fields.
+The two link fields are called |link| and |knil|; if |w|~points to
+the node for~$w_k$, then |link(w)| and |knil(w)| point respectively
+to the nodes for $w\k$ and~$w_{k-1}$. If |h| is the list header,
+|link(h)| points to the node for~$w_0$ and |knil(link(h))| to the
+node for~$w_{n+1}$.
+
+The tenth word of a pen header node contains the maximum absolute value of
+an $x$ or $y$ coordinate among all of the unskewed pen offsets.
+
+The |link| field of a pen header node should be |null| if and only if
+the pen has no offsets.
+
+@d pen_node_size=10
+@d coord_node_size=3
+@d max_offset(#)==mem[#+9].sc
+
+@ The |print_pen| subroutine illustrates these conventions by
+reconstructing the vertices of a polygon from \MF's complicated
+internal offset representation.
+
+@<Declare subroutines for printing expressions@>=
+procedure print_pen(@!p:pointer;@!s:str_number;@!nuline:boolean);
+var @!nothing_printed:boolean; {has there been any action yet?}
+@!k:1..8; {octant number}
+@!h:pointer; {offset list head}
+@!m,@!n:integer; {offset indices}
+@!w,@!ww:pointer; {pointers that traverse the offset list}
+begin print_diagnostic("Pen polygon",s,nuline);
+nothing_printed:=true; print_ln;
+for k:=1 to 8 do
+ begin octant:=octant_code[k]; h:=p+octant; n:=info(h); w:=link(h);
+ if not odd(k) then w:=knil(w); {in even octants, start at $w_{n+1}$}
+ for m:=1 to n+1 do
+ begin if odd(k) then ww:=link(w)@+else ww:=knil(w);
+ if (x_coord(ww)<>x_coord(w))or(y_coord(ww)<>y_coord(w)) then
+ @<Print the unskewed and unrotated coordinates of node |ww|@>;
+ w:=ww;
+ end;
+ end;
+if nothing_printed then
+ begin w:=link(p+first_octant); print_two(x_coord(w)+y_coord(w),y_coord(w));
+ end;
+print_nl(" .. cycle"); end_diagnostic(true);
+end;
+
+@ @<Print the unskewed and unrotated coordinates of node |ww|@>=
+begin if nothing_printed then nothing_printed:=false
+else print_nl(" .. ");
+print_two_true(x_coord(ww),y_coord(ww));
+end
+
+@ A null pen polygon, which has just one vertex $(0,0)$, is
+predeclared for error recovery. It doesn't need a proper
+reference count, because the |toss_pen| procedure below
+will never delete it from memory.
+
+@<Initialize table entries...@>=
+ref_count(null_pen):=null; link(null_pen):=null;@/
+info(null_pen+1):=1; link(null_pen+1):=null_coords;
+for k:=null_pen+2 to null_pen+8 do mem[k]:=mem[null_pen+1];
+max_offset(null_pen):=0;@/
+link(null_coords):=null_coords;
+knil(null_coords):=null_coords;@/
+x_coord(null_coords):=0;
+y_coord(null_coords):=0;
+
+@ Here's a trivial subroutine that inserts a copy of an offset
+on the |link| side of its clone in the doubly linked list.
+
+@p procedure dup_offset(@!w:pointer);
+var @!r:pointer; {the new node}
+begin r:=get_node(coord_node_size);
+x_coord(r):=x_coord(w);
+y_coord(r):=y_coord(w);
+link(r):=link(w); knil(link(w)):=r;
+knil(r):=w; link(w):=r;
+end;
+
+@ The following algorithm is somewhat more interesting: It converts a
+knot list for a cyclic path into a pen polygon, ignoring everything
+but the |x_coord|, |y_coord|, and |link| fields. If the given path
+vertices do not define a convex polygon, an error message is issued
+and the null pen is returned.
+
+@p function make_pen(@!h:pointer):pointer;
+label done,done1,not_found,found;
+var @!o,@!oo,@!k:small_number; {octant numbers---old, new, and current}
+@!p:pointer; {top-level node for the new pen}
+@!q,@!r,@!s,@!w,@!hh:pointer; {for list manipulation}
+@!n:integer; {offset counter}
+@!dx,@!dy:scaled; {polygon direction}
+@!mc:scaled; {the largest coordinate}
+begin @<Stamp all nodes with an octant code, compute the maximum offset,
+ and set |hh| to the node that begins the first octant;
+ |goto not_found| if there's a problem@>;
+if mc>=fraction_one-half_unit then goto not_found;
+p:=get_node(pen_node_size); q:=hh; max_offset(p):=mc; ref_count(p):=null;
+if link(q)<>q then link(p):=null+1;
+for k:=1 to 8 do @<Construct the offset list for the |k|th octant@>;
+goto found;
+not_found:p:=null_pen; @<Complain about a bad pen path@>;
+found: if internal[tracing_pens]>0 then print_pen(p," (newly created)",true);
+make_pen:=p;
+end;
+
+@ @<Complain about a bad pen path@>=
+if mc>=fraction_one-half_unit then
+ begin print_err("Pen too large");
+@.Pen too large@>
+ help2("The cycle you specified has a coordinate of 4095.5 or more.")@/
+ ("So I've replaced it by the trivial path `(0,0)..cycle'.");@/
+ end
+else begin print_err("Pen cycle must be convex");
+@.Pen cycle must be convex@>
+ help3("The cycle you specified either has consecutive equal points")@/
+ ("or turns right or turns through more than 360 degrees.")@/
+ ("So I've replaced it by the trivial path `(0,0)..cycle'.");@/
+ end;
+put_get_error
+
+@ There should be exactly one node whose octant number is less than its
+predecessor in the cycle; that is node~|hh|.
+
+The loop here will terminate in all cases, but the proof is somewhat tricky:
+If there are at least two distinct $y$~coordinates in the cycle, we will have
+|o>4| and |o<=4| at different points of the cycle. Otherwise there are
+at least two distinct $x$~coordinates, and we will have |o>2| somewhere,
+|o<=2| somewhere.
+
+@<Stamp all nodes...@>=
+q:=h; r:=link(q); mc:=abs(x_coord(h));
+if q=r then
+ begin hh:=h; right_type(h):=0; {this trick is explained below}
+ if mc<abs(y_coord(h)) then mc:=abs(y_coord(h));
+ end
+else begin o:=0; hh:=null;
+ loop@+ begin s:=link(r);
+ if mc<abs(x_coord(r)) then mc:=abs(x_coord(r));
+ if mc<abs(y_coord(r)) then mc:=abs(y_coord(r));
+ dx:=x_coord(r)-x_coord(q); dy:=y_coord(r)-y_coord(q);
+ if dx=0 then if dy=0 then goto not_found; {double point}
+ if ab_vs_cd(dx,y_coord(s)-y_coord(r),dy,x_coord(s)-x_coord(r))<0 then
+ goto not_found; {right turn}
+ @<Determine the octant code for direction |(dx,dy)|@>;
+ right_type(q):=octant; oo:=octant_number[octant];
+ if o>oo then
+ begin if hh<>null then goto not_found; {$>360^\circ$}
+ hh:=q;
+ end;
+ o:=oo;
+ if (q=h)and(hh<>null) then goto done;
+ q:=r; r:=s;
+ end;
+ done:end
+
+
+@ We want the octant for |(-dx,-dy)| to be
+exactly opposite the octant for |(dx,dy)|.
+
+@<Determine the octant code for direction |(dx,dy)|@>=
+if dx>0 then octant:=first_octant
+else if dx=0 then
+ if dy>0 then octant:=first_octant@+else octant:=first_octant+negate_x
+else begin negate(dx); octant:=first_octant+negate_x;
+ end;
+if dy<0 then
+ begin negate(dy); octant:=octant+negate_y;
+ end
+else if dy=0 then
+ if octant>first_octant then octant:=first_octant+negate_x+negate_y;
+if dx<dy then octant:=octant+switch_x_and_y
+
+@ Now |q| points to the node that the present octant shares with the previous
+octant, and |right_type(q)| is the octant code during which |q|~should advance.
+We have set |right_type(q)=0| in the special case that |q| should never advance
+(because the pen is degenerate).
+
+The number of offsets |n| must be smaller than |max_quarterword|, because
+the |fill_envelope| routine stores |n+1| in the |right_type| field
+of a knot node.
+
+@<Construct the offset list...@>=
+begin octant:=octant_code[k]; n:=0; h:=p+octant;
+loop@+ begin r:=get_node(coord_node_size);
+ skew(x_coord(q),y_coord(q),octant); x_coord(r):=cur_x; y_coord(r):=cur_y;
+ if n=0 then link(h):=r
+ else @<Link node |r| to the previous node@>;
+ w:=r;
+ if right_type(q)<>octant then goto done1;
+ q:=link(q); incr(n);
+ end;
+done1: @<Finish linking the offset nodes, and duplicate the
+ borderline offset nodes if necessary@>;
+if n>=max_quarterword then overflow("pen polygon size",max_quarterword);
+@:METAFONT capacity exceeded pen polygon size}{\quad pen polygon size@>
+info(h):=n;
+end
+
+@ Now |w| points to the node that was inserted most recently, and
+|k| is the current octant number.
+
+@<Link node |r| to the previous node@>=
+if odd(k) then
+ begin link(w):=r; knil(r):=w;
+ end
+else begin knil(w):=r; link(r):=w;
+ end
+
+@ We have inserted |n+1| nodes; it remains to duplicate the nodes at the
+ends, if slopes 0 and~$\infty$ aren't already represented. At the end of
+this section the total number of offset nodes should be |n+2|
+(since we call them $w_0$, $w_1$, \dots,~$w_{n+1}$).
+
+@<Finish linking the offset nodes, and duplicate...@>=
+r:=link(h);
+if odd(k) then
+ begin link(w):=r; knil(r):=w;
+ end
+else begin knil(w):=r; link(r):=w; link(h):=w; r:=w;
+ end;
+if (y_coord(r)<>y_coord(link(r)))or(n=0) then
+ begin dup_offset(r); incr(n);
+ end;
+r:=knil(r);
+if x_coord(r)<>x_coord(knil(r)) then dup_offset(r)
+else decr(n)
+
+@ Conversely, |make_path| goes back from a pen to a cyclic path that
+might have generated it. The structure of this subroutine is essentially
+the same as |print_pen|.
+
+@p @t\4@>@<Declare the function called |trivial_knot|@>@;
+function make_path(@!pen_head:pointer):pointer;
+var @!p:pointer; {the most recently copied knot}
+@!k:1..8; {octant number}
+@!h:pointer; {offset list head}
+@!m,@!n:integer; {offset indices}
+@!w,@!ww:pointer; {pointers that traverse the offset list}
+begin p:=temp_head;
+for k:=1 to 8 do
+ begin octant:=octant_code[k]; h:=pen_head+octant; n:=info(h); w:=link(h);
+ if not odd(k) then w:=knil(w); {in even octants, start at $w_{n+1}$}
+ for m:=1 to n+1 do
+ begin if odd(k) then ww:=link(w)@+else ww:=knil(w);
+ if (x_coord(ww)<>x_coord(w))or(y_coord(ww)<>y_coord(w)) then
+ @<Copy the unskewed and unrotated coordinates of node |ww|@>;
+ w:=ww;
+ end;
+ end;
+if p=temp_head then
+ begin w:=link(pen_head+first_octant);
+ p:=trivial_knot(x_coord(w)+y_coord(w),y_coord(w)); link(temp_head):=p;
+ end;
+link(p):=link(temp_head); make_path:=link(temp_head);
+end;
+
+@ @<Copy the unskewed and unrotated coordinates of node |ww|@>=
+begin unskew(x_coord(ww),y_coord(ww),octant);
+link(p):=trivial_knot(cur_x,cur_y); p:=link(p);
+end
+
+@ @<Declare the function called |trivial_knot|@>=
+function trivial_knot(@!x,@!y:scaled):pointer;
+var @!p:pointer; {a new knot for explicit coordinates |x| and |y|}
+begin p:=get_node(knot_node_size);
+left_type(p):=explicit; right_type(p):=explicit;@/
+x_coord(p):=x; left_x(p):=x; right_x(p):=x;@/
+y_coord(p):=y; left_y(p):=y; right_y(p):=y;@/
+trivial_knot:=p;
+end;
+
+@ That which can be created can be destroyed.
+
+@d add_pen_ref(#)==incr(ref_count(#))
+@d delete_pen_ref(#)==if ref_count(#)=null then toss_pen(#)
+ else decr(ref_count(#))
+
+@<Declare the recycling subroutines@>=
+procedure toss_pen(@!p:pointer);
+var @!k:1..8; {relative header locations}
+@!w,@!ww:pointer; {pointers to offset nodes}
+begin if p<>null_pen then
+ begin for k:=1 to 8 do
+ begin w:=link(p+k);
+ repeat ww:=link(w); free_node(w,coord_node_size); w:=ww;
+ until w=link(p+k);
+ end;
+ free_node(p,pen_node_size);
+ end;
+end;
+
+@ The |find_offset| procedure sets |(cur_x,cur_y)| to the offset associated
+with a given direction~|(x,y)| and a given pen~|p|. If |x=y=0|, the
+result is |(0,0)|. If two different offsets apply, one of them is
+chosen arbitrarily.
+
+@p procedure find_offset(@!x,@!y:scaled; @!p:pointer);
+label done,exit;
+var @!octant:first_octant..sixth_octant; {octant code for |(x,y)|}
+@!s:-1..+1; {sign of the octant}
+@!n:integer; {number of offsets remaining}
+@!h,@!w,@!ww:pointer; {list traversal registers}
+begin @<Compute the octant code; skew and rotate the coordinates |(x,y)|@>;
+if odd(octant_number[octant]) then s:=-1@+else s:=+1;
+h:=p+octant; w:=link(link(h)); ww:=link(w); n:=info(h);
+while n>1 do
+ begin if ab_vs_cd(x,y_coord(ww)-y_coord(w),@|
+ y,x_coord(ww)-x_coord(w))<>s then goto done;
+ w:=ww; ww:=link(w); decr(n);
+ end;
+done:unskew(x_coord(w),y_coord(w),octant);
+exit:end;
+
+@ @<Compute the octant code; skew and rotate the coordinates |(x,y)|@>=
+if x>0 then octant:=first_octant
+else if x=0 then
+ if y<=0 then
+ if y=0 then
+ begin cur_x:=0; cur_y:=0; return;
+ end
+ else octant:=first_octant+negate_x
+ else octant:=first_octant
+else begin x:=-x;
+ if y=0 then octant:=first_octant+negate_x+negate_y
+ else octant:=first_octant+negate_x;
+ end;
+if y<0 then
+ begin octant:=octant+negate_y; y:=-y;
+ end;
+if x>=y then x:=x-y
+else begin octant:=octant+switch_x_and_y; x:=y-x; y:=y-x;
+ end
+
+@* \[24] Filling an envelope.
+We are about to reach the culmination of \MF's digital plotting routines:
+Almost all of the previous algorithms will be brought to bear on \MF's
+most difficult task, which is to fill the envelope of a given cyclic path
+with respect to a given pen polygon.
+
+But we still must complete some of the preparatory work before taking such
+a big plunge.
+
+@ Given a pointer |c| to a nonempty list of cubics,
+and a pointer~|h| to the header information of a pen polygon segment,
+the |offset_prep| routine changes the list into cubics that are
+associated with particular pen offsets. Namely, the cubic between |p|
+and~|q| should be associated with the |k|th offset when |right_type(p)=k|.
+
+List |c| is actually part of a cycle spec, so it terminates at the
+first node whose |right_type| is |endpoint|. The cubics all have
+monotone-nondecreasing $x'(t)$ and $y'(t)$.
+
+@p @t\4@>@<Declare subroutines needed by |offset_prep|@>@;
+procedure offset_prep(@!c,@!h:pointer);
+label done,not_found;
+var @!n:halfword; {the number of pen offsets}
+@!p,@!q,@!r,@!lh,@!ww:pointer; {for list manipulation}
+@!k:halfword; {the current offset index}
+@!w:pointer; {a pointer to offset $w_k$}
+@<Other local variables for |offset_prep|@>@;
+begin p:=c; n:=info(h); lh:=link(h); {now |lh| points to $w_0$}
+while right_type(p)<>endpoint do
+ begin q:=link(p);
+ @<Split the cubic between |p| and |q|, if necessary, into cubics
+ associated with single offsets, after which |q| should
+ point to the end of the final such cubic@>;
+ @<Advance |p| to node |q|, removing any ``dead'' cubics that
+ might have been introduced by the splitting process@>;
+ end;
+end;
+
+@ @<Advance |p| to node |q|, removing any ``dead'' cubics...@>=
+repeat r:=link(p);
+if x_coord(p)=right_x(p) then if y_coord(p)=right_y(p) then
+ if x_coord(p)=left_x(r) then if y_coord(p)=left_y(r) then
+ if x_coord(p)=x_coord(r) then if y_coord(p)=y_coord(r) then
+ begin remove_cubic(p);
+ if r=q then q:=p;
+ r:=p;
+ end;
+p:=r;
+until p=q
+
+@ The splitting process uses a subroutine like |split_cubic|, but
+(for ``bulletproof'' operation) we check to make sure that the
+resulting (skewed) coordinates satisfy $\Delta x\G0$ and $\Delta y\G0$
+after splitting; |make_spec| has made sure that these relations hold
+before splitting. (This precaution is surely unnecessary, now that
+|make_spec| is so much more careful than it used to be. But who
+wants to take a chance? Maybe the hardware will fail or something.)
+
+@<Declare subroutines needed by |offset_prep|@>=
+procedure split_for_offset(@!p:pointer;@!t:fraction);
+var @!q:pointer; {the successor of |p|}
+@!r:pointer; {the new node}
+begin q:=link(p); split_cubic(p,t,x_coord(q),y_coord(q)); r:=link(p);
+if y_coord(r)<y_coord(p) then y_coord(r):=y_coord(p)
+else if y_coord(r)>y_coord(q) then y_coord(r):=y_coord(q);
+if x_coord(r)<x_coord(p) then x_coord(r):=x_coord(p)
+else if x_coord(r)>x_coord(q) then x_coord(r):=x_coord(q);
+end;
+
+@ If the pen polygon has |n| offsets, and if $w_k=(u_k,v_k)$ is the $k$th
+of these, the $k$th pen slope is defined by the formula
+$$s_k={v\k-v_k\over u\k-u_k},\qquad\hbox{for $0<k<n$}.$$
+In odd-numbered octants, the numerator and denominator of this fraction
+will be positive; in even-numbered octants they will both be negative.
+Furthermore we always have $0=s_0<s_1<\cdots<s_n=\infty$. The goal of
+|offset_prep| is to find an offset index~|k| to associate with
+each cubic, such that the slope $s(t)$ of the cubic satisfies
+$$s_{k-1}\le s(t)\le s_k\qquad\hbox{for $0\le t\le 1$.}\eqno(*)$$
+We may have to split a cubic into as many as $2n-1$ pieces before each
+piece corresponds to a unique offset.
+
+@<Split the cubic between |p| and |q|, if necessary, into cubics...@>=
+if n<=1 then right_type(p):=1 {this case is easy}
+else begin @<Prepare for derivative computations;
+ |goto not_found| if the current cubic is dead@>;
+ @<Find the initial slope, |dy/dx|@>;
+ if dx=0 then @<Handle the special case of infinite slope@>
+ else begin @<Find the index |k| such that $s_{k-1}\L\\{dy}/\\{dx}<s_k$@>;
+ @<Complete the offset splitting process@>;
+ end;
+not_found: end
+
+@ The slope of a cubic $B(z_0,z_1,z_2,z_3;t)=\bigl(x(t),y(t)\bigr)$ can be
+calculated from the quadratic polynomials
+${1\over3}x'(t)=B(x_1-x_0,x_2-x_1,x_3-x_2;t)$ and
+${1\over3}y'(t)=B(y_1-y_0,y_2-y_1,y_3-y_2;t)$.
+Since we may be calculating slopes from several cubics
+split from the current one, it is desirable to do these calculations
+without losing too much precision. ``Scaled up'' values of the
+derivatives, which will be less tainted by accumulated errors than
+derivatives found from the cubics themselves, are maintained in
+local variables |x0|, |x1|, and |x2|, representing $X_0=2^l(x_1-x_0)$,
+$X_1=2^l(x_2-x_1)$, and $X_2=2^l(x_3-x_2)$; similarly |y0|, |y1|, and~|y2|
+represent $Y_0=2^l(y_1-y_0)$, $Y_1=2^l(y_2-y_1)$, and $Y_2=2^l(y_3-y_2)$.
+To test whether the slope of the cubic is $\ge s$ or $\le s$, we will test
+the sign of the quadratic ${1\over3}2^l\bigl(y'(t)-sx'(t)\bigr)$ if $s\le1$,
+or ${1\over3}2^l\bigl(y'(t)/s-x'(t)\bigr)$ if $s>1$.
+
+@<Other local variables for |offset_prep|@>=
+@!x0,@!x1,@!x2,@!y0,@!y1,@!y2:integer; {representatives of derivatives}
+@!t0,@!t1,@!t2:integer; {coefficients of polynomial for slope testing}
+@!du,@!dv,@!dx,@!dy:integer; {for slopes of the pen and the curve}
+@!max_coef:integer; {used while scaling}
+@!x0a,@!x1a,@!x2a,@!y0a,@!y1a,@!y2a:integer; {intermediate values}
+@!t:fraction; {where the derivative passes through zero}
+@!s:fraction; {slope or reciprocal slope}
+
+@ @<Prepare for derivative computations...@>=
+x0:=right_x(p)-x_coord(p); {should be |>=0|}
+x2:=x_coord(q)-left_x(q); {likewise}
+x1:=left_x(q)-right_x(p); {but this might be negative}
+y0:=right_y(p)-y_coord(p); y2:=y_coord(q)-left_y(q);
+y1:=left_y(q)-right_y(p);
+max_coef:=abs(x0); {we take |abs| just to make sure}
+if abs(x1)>max_coef then max_coef:=abs(x1);
+if abs(x2)>max_coef then max_coef:=abs(x2);
+if abs(y0)>max_coef then max_coef:=abs(y0);
+if abs(y1)>max_coef then max_coef:=abs(y1);
+if abs(y2)>max_coef then max_coef:=abs(y2);
+if max_coef=0 then goto not_found;
+while max_coef<fraction_half do
+ begin double(max_coef);
+ double(x0); double(x1); double(x2);
+ double(y0); double(y1); double(y2);
+ end
+
+@ Let us first solve a special case of the problem: Suppose we
+know an index~$k$ such that either (i)~$s(t)\G s_{k-1}$ for all~$t$
+and $s(0)<s_k$, or (ii)~$s(t)\L s_k$ for all~$t$ and $s(0)>s_{k-1}$.
+Then, in a sense, we're halfway done, since one of the two inequalities
+in $(*)$ is satisfied, and the other couldn't be satisfied for
+any other value of~|k|.
+
+The |fin_offset_prep| subroutine solves the stated subproblem.
+It has a boolean parameter called |rising| that is |true| in
+case~(i), |false| in case~(ii). When |rising=false|, parameters
+|x0| through |y2| represent the negative of the derivative of
+the cubic following |p|; otherwise they represent the actual derivative.
+The |w| parameter should point to offset~$w_k$.
+
+@<Declare subroutines needed by |offset_prep|@>=
+procedure fin_offset_prep(@!p:pointer;@!k:halfword;@!w:pointer;
+ @!x0,@!x1,@!x2,@!y0,@!y1,@!y2:integer;@!rising:boolean;@!n:integer);
+label exit;
+var @!ww:pointer; {for list manipulation}
+@!du,@!dv:scaled; {for slope calculation}
+@!t0,@!t1,@!t2:integer; {test coefficients}
+@!t:fraction; {place where the derivative passes a critical slope}
+@!s:fraction; {slope or reciprocal slope}
+@!v:integer; {intermediate value for updating |x0..y2|}
+begin loop
+ begin right_type(p):=k;
+ if rising then
+ if k=n then return
+ else ww:=link(w) {a pointer to $w\k$}
+ else if k=1 then return
+ else ww:=knil(w); {a pointer to $w_{k-1}$}
+ @<Compute test coefficients |(t0,t1,t2)|
+ for $s(t)$ versus $s_k$ or $s_{k-1}$@>;
+ t:=crossing_point(t0,t1,t2);
+ if t>=fraction_one then return;
+ @<Split the cubic at $t$,
+ and split off another cubic if the derivative crosses back@>;
+ if rising then incr(k)@+else decr(k);
+ w:=ww;
+ end;
+exit:end;
+
+@ @<Compute test coefficients |(t0,t1,t2)| for $s(t)$ versus...@>=
+du:=x_coord(ww)-x_coord(w); dv:=y_coord(ww)-y_coord(w);
+if abs(du)>=abs(dv) then {$s_{k\pm1}\le1$}
+ begin s:=make_fraction(dv,du);
+ t0:=take_fraction(x0,s)-y0;
+ t1:=take_fraction(x1,s)-y1;
+ t2:=take_fraction(x2,s)-y2;
+ end
+else begin s:=make_fraction(du,dv);
+ t0:=x0-take_fraction(y0,s);
+ t1:=x1-take_fraction(y1,s);
+ t2:=x2-take_fraction(y2,s);
+ end
+
+@ The curve has crossed $s_k$ or $s_{k-1}$; its initial segment satisfies
+$(*)$, and it might cross again and return towards $s_k$, yielding another
+solution of $(*)$.
+
+@<Split the cubic at $t$, and split off another...@>=
+begin split_for_offset(p,t); right_type(p):=k; p:=link(p);@/
+v:=t_of_the_way(x0)(x1); x1:=t_of_the_way(x1)(x2);
+x0:=t_of_the_way(v)(x1);@/
+v:=t_of_the_way(y0)(y1); y1:=t_of_the_way(y1)(y2);
+y0:=t_of_the_way(v)(y1);@/
+t1:=t_of_the_way(t1)(t2);
+if t1>0 then t1:=0; {without rounding error, |t1| would be |<=0|}
+t:=crossing_point(0,-t1,-t2);
+if t<fraction_one then
+ begin split_for_offset(p,t); right_type(link(p)):=k;@/
+ v:=t_of_the_way(x1)(x2); x1:=t_of_the_way(x0)(x1);
+ x2:=t_of_the_way(x1)(v);@/
+ v:=t_of_the_way(y1)(y2); y1:=t_of_the_way(y0)(y1);
+ y2:=t_of_the_way(y1)(v);
+ end;
+end
+
+@ Now we must consider the general problem of |offset_prep|, when
+nothing is known about a given cubic. We start by finding its
+slope $s(0)$ in the vicinity of |t=0|.
+
+If $z'(t)=0$, the given cubic is numerically unstable, since the
+slope direction is probably being influenced primarily by rounding
+errors. A user who specifies such cuspy curves should expect to generate
+rather wild results. The present code tries its best to believe the
+existing data, as if no rounding errors were present.
+
+@ @<Find the initial slope, |dy/dx|@>=
+dx:=x0; dy:=y0;
+if dx=0 then if dy=0 then
+ begin dx:=x1; dy:=y1;
+ if dx=0 then if dy=0 then
+ begin dx:=x2; dy:=y2;
+ end;
+ end
+
+@ The next step is to bracket the initial slope between consecutive
+slopes of the pen polygon. The most important invariant relation in the
+following loop is that |dy/dx>=@t$s_{k-1}$@>|.
+
+@<Find the index |k| such that $s_{k-1}\L\\{dy}/\\{dx}<s_k$@>=
+k:=1; w:=link(lh);
+loop@+ begin if k=n then goto done;
+ ww:=link(w);
+ if ab_vs_cd(dy,abs(x_coord(ww)-x_coord(w)),@|
+ dx,abs(y_coord(ww)-y_coord(w)))>=0 then
+ begin incr(k); w:=ww;
+ end
+ else goto done;
+ end;
+done:
+
+@ Finally we want to reduce the general problem to situations that
+|fin_offset_prep| can handle. If |k=1|, we already are in the desired
+situation. Otherwise we can split the cubic into at most three parts
+with respect to $s_{k-1}$, and apply |fin_offset_prep| to each part.
+
+@<Complete the offset splitting process@>=
+if k=1 then t:=fraction_one+1
+else begin ww:=knil(w); @<Compute test coeff...@>;
+ t:=crossing_point(-t0,-t1,-t2);
+ end;
+if t>=fraction_one then fin_offset_prep(p,k,w,x0,x1,x2,y0,y1,y2,true,n)
+else begin split_for_offset(p,t); r:=link(p);@/
+ x1a:=t_of_the_way(x0)(x1); x1:=t_of_the_way(x1)(x2);
+ x2a:=t_of_the_way(x1a)(x1);@/
+ y1a:=t_of_the_way(y0)(y1); y1:=t_of_the_way(y1)(y2);
+ y2a:=t_of_the_way(y1a)(y1);@/
+ fin_offset_prep(p,k,w,x0,x1a,x2a,y0,y1a,y2a,true,n); x0:=x2a; y0:=y2a;
+ t1:=t_of_the_way(t1)(t2);
+ if t1<0 then t1:=0;
+ t:=crossing_point(0,t1,t2);
+ if t<fraction_one then
+ @<Split off another |rising| cubic for |fin_offset_prep|@>;
+ fin_offset_prep(r,k-1,ww,-x0,-x1,-x2,-y0,-y1,-y2,false,n);
+ end
+
+@ @<Split off another |rising| cubic for |fin_offset_prep|@>=
+begin split_for_offset(r,t);@/
+x1a:=t_of_the_way(x1)(x2); x1:=t_of_the_way(x0)(x1);
+x0a:=t_of_the_way(x1)(x1a);@/
+y1a:=t_of_the_way(y1)(y2); y1:=t_of_the_way(y0)(y1);
+y0a:=t_of_the_way(y1)(y1a);@/
+fin_offset_prep(link(r),k,w,x0a,x1a,x2,y0a,y1a,y2,true,n);
+x2:=x0a; y2:=y0a;
+end
+
+@ @<Handle the special case of infinite slope@>=
+fin_offset_prep(p,n,knil(knil(lh)),-x0,-x1,-x2,-y0,-y1,-y2,false,n)
+
+@ OK, it's time now for the biggie. The |fill_envelope| routine generalizes
+|fill_spec| to polygonal envelopes. Its outer structure is essentially the
+same as before, except that octants with no cubics do contribute to
+the envelope.
+
+@p @t\4@>@<Declare the procedure called |skew_line_edges|@>@;
+@t\4@>@<Declare the procedure called |dual_moves|@>@;
+procedure fill_envelope(@!spec_head:pointer);
+label done, done1;
+var @!p,@!q,@!r,@!s:pointer; {for list traversal}
+@!h:pointer; {head of pen offset list for current octant}
+@!www:pointer; {a pen offset of temporary interest}
+@<Other local variables for |fill_envelope|@>@;
+begin if internal[tracing_edges]>0 then begin_edge_tracing;
+p:=spec_head; {we assume that |left_type(spec_head)=endpoint|}
+repeat octant:=left_octant(p); h:=cur_pen+octant;
+@<Set variable |q| to the node at the end of the current octant@>;
+@<Determine the envelope's starting and ending
+ lattice points |(m0,n0)| and |(m1,n1)|@>;
+offset_prep(p,h); {this may clobber node~|q|, if it becomes ``dead''}
+@<Set variable |q| to the node at the end of the current octant@>;
+@<Make the envelope moves for the current octant and insert them
+ in the pixel data@>;
+p:=link(q);
+until p=spec_head;
+if internal[tracing_edges]>0 then end_edge_tracing;
+toss_knot_list(spec_head);
+end;
+
+@ In even-numbered octants we have reflected the coordinates an odd number
+of times, hence clockwise and counterclockwise are reversed; this means that
+the envelope is being formed in a ``dual'' manner. For the time being, let's
+concentrate on odd-numbered octants, since they're easier to understand.
+After we have coded the program for odd-numbered octants, the changes needed
+to dualize it will not be so mysterious.
+
+It is convenient to assume that we enter an odd-numbered octant with
+an |axis| transition (where the skewed slope is zero) and leave at a
+|diagonal| one (where the skewed slope is infinite). Then all of the
+offset points $z(t)+w(t)$ will lie in a rectangle whose lower left and
+upper right corners are the initial and final offset points. If this
+assumption doesn't hold we can implicitly change the curve so that it does.
+For example, if the entering transition is diagonal, we can draw a
+straight line from $z_0+w_{n+1}$ to $z_0+w_0$ and continue as if the
+curve were moving rightward. The effect of this on the envelope is simply
+to ``doubly color'' the region enveloped by a section of the pen that
+goes from $w_0$ to $w_1$ to $\cdots$ to $w_{n+1}$ to~$w_0$. The additional
+straight line at the beginning (and a similar one at the end, where it
+may be necessary to go from $z_1+w_{n+1}$ to $z_1+w_0$) can be drawn by
+the |line_edges| routine; we are thereby saved from the embarrassment that
+these lines travel backwards from the current octant direction.
+
+Once we have established the assumption that the curve goes from
+$z_0+w_0$ to $z_1+w_{n+1}$, any further retrograde moves that might
+occur within the octant can be essentially ignored; we merely need to
+keep track of the rightmost edge in each row, in order to compute
+the envelope.
+
+Envelope moves consist of offset cubics intermixed with straight line
+segments. We record them in a separate |env_move| array, which is
+something like |move| but it keeps track of the rightmost position of the
+envelope in each row.
+
+@<Glob...@>=
+@!env_move:array[0..move_size] of integer;
+
+@ @<Determine the envelope's starting and ending...@>=
+w:=link(h);@+if left_transition(p)=diagonal then w:=knil(w);
+@!stat if internal[tracing_edges]>unity then
+ @<Print a line of diagnostic info to introduce this octant@>;
+tats@;@/
+ww:=link(h); www:=ww; {starting and ending offsets}
+if odd(octant_number[octant]) then www:=knil(www)@+else ww:=knil(ww);
+if w<>ww then skew_line_edges(p,w,ww);
+end_round(x_coord(p)+x_coord(ww),y_coord(p)+y_coord(ww));
+m0:=m1; n0:=n1; d0:=d1;@/
+end_round(x_coord(q)+x_coord(www),y_coord(q)+y_coord(www));
+if n1-n0>=move_size then overflow("move table size",move_size)
+@:METAFONT capacity exceeded move table size}{\quad move table size@>
+
+@ @<Print a line of diagnostic info to introduce this octant@>=
+begin print_nl("@@ Octant "); print(octant_dir[octant]);
+@:]]]\AT!_Octant}{\.{\AT! Octant...}@>
+print(" ("); print_int(info(h)); print(" offset");
+if info(h)<>1 then print_char("s");
+print("), from ");
+print_two_true(x_coord(p)+x_coord(w),y_coord(p)+y_coord(w));
+ww:=link(h);@+if right_transition(q)=diagonal then ww:=knil(ww);
+print(" to ");
+print_two_true(x_coord(q)+x_coord(ww),y_coord(q)+y_coord(ww));
+end
+
+@ A slight variation of the |line_edges| procedure comes in handy
+when we must draw the retrograde lines for nonstandard entry and exit
+conditions.
+
+@<Declare the procedure called |skew_line_edges|@>=
+procedure skew_line_edges(@!p,@!w,@!ww:pointer);
+var @!x0,@!y0,@!x1,@!y1:scaled; {from and to}
+begin if (x_coord(w)<>x_coord(ww))or(y_coord(w)<>y_coord(ww)) then
+ begin x0:=x_coord(p)+x_coord(w); y0:=y_coord(p)+y_coord(w);@/
+ x1:=x_coord(p)+x_coord(ww); y1:=y_coord(p)+y_coord(ww);@/
+ unskew(x0,y0,octant); {unskew and unrotate the coordinates}
+ x0:=cur_x; y0:=cur_y;@/
+ unskew(x1,y1,octant);@/
+ @!stat if internal[tracing_edges]>unity then
+ begin print_nl("@@ retrograde line from ");
+@:]]]\AT!_retro_}{\.{\AT! retrograde line...}@>
+ @.retrograde line...@>
+ print_two(x0,y0); print(" to "); print_two(cur_x,cur_y); print_nl("");
+ end;@+tats@;@/
+ line_edges(x0,y0,cur_x,cur_y); {then draw a straight line}
+ end;
+end;
+
+@ The envelope calculations require more local variables than we needed
+in the simpler case of |fill_spec|. At critical points in the computation,
+|w| will point to offset $w_k$; |m| and |n| will record the current
+lattice positions. The values of |move_ptr| after the initial and before
+the final offset adjustments are stored in |smooth_bot| and |smooth_top|,
+respectively.
+
+@<Other local variables for |fill_envelope|@>=
+@!m,@!n:integer; {current lattice position}
+@!mm0,@!mm1:integer; {skewed equivalents of |m0| and |m1|}
+@!k:integer; {current offset number}
+@!w,@!ww:pointer; {pointers to the current offset and its neighbor}
+@!smooth_bot,@!smooth_top:0..move_size; {boundaries of smoothing}
+@!xx,@!yy,@!xp,@!yp,@!delx,@!dely,@!tx,@!ty:scaled;
+ {registers for coordinate calculations}
+
+@ @<Make the envelope moves for the current octant...@>=
+if odd(octant_number[octant]) then
+ begin @<Initialize for ordinary envelope moves@>;
+ r:=p; right_type(q):=info(h)+1;
+ loop@+ begin if r=q then smooth_top:=move_ptr;
+ while right_type(r)<>k do
+ @<Insert a line segment to approach the correct offset@>;
+ if r=p then smooth_bot:=move_ptr;
+ if r=q then goto done;
+ move[move_ptr]:=1; n:=move_ptr; s:=link(r);@/
+ make_moves(x_coord(r)+x_coord(w),right_x(r)+x_coord(w),
+ left_x(s)+x_coord(w),x_coord(s)+x_coord(w),@|
+ y_coord(r)+y_coord(w)+half_unit,right_y(r)+y_coord(w)+half_unit,
+ left_y(s)+y_coord(w)+half_unit,y_coord(s)+y_coord(w)+half_unit,@|
+ xy_corr[octant],y_corr[octant]);@/
+ @<Transfer moves from the |move| array to |env_move|@>;
+ r:=s;
+ end;
+done: @<Insert the new envelope moves in the pixel data@>;
+ end
+else dual_moves(h,p,q);
+right_type(q):=endpoint
+
+@ @<Initialize for ordinary envelope moves@>=
+k:=0; w:=link(h); ww:=knil(w);
+mm0:=floor_unscaled(x_coord(p)+x_coord(w)-xy_corr[octant]);
+mm1:=floor_unscaled(x_coord(q)+x_coord(ww)-xy_corr[octant]);
+for n:=0 to n1-n0 do env_move[n]:=mm0;
+env_move[n1-n0]:=mm1; move_ptr:=0; m:=mm0
+
+@ At this point |n| holds the value of |move_ptr| that was current
+when |make_moves| began to record its moves.
+
+@<Transfer moves from the |move| array to |env_move|@>=
+repeat m:=m+move[n]-1;
+if m>env_move[n] then env_move[n]:=m;
+incr(n);
+until n>move_ptr
+
+@ Retrograde lines (when |k| decreases) do not need to be recorded in
+|env_move| because their edges are not the furthest right in any row.
+
+@<Insert a line segment to approach the correct offset@>=
+begin xx:=x_coord(r)+x_coord(w); yy:=y_coord(r)+y_coord(w)+half_unit;
+@!stat if internal[tracing_edges]>unity then
+ begin print_nl("@@ transition line "); print_int(k); print(", from ");
+@:]]]\AT!_trans_}{\.{\AT! transition line...}@>
+@.transition line...@>
+ print_two_true(xx,yy-half_unit);
+ end;@+tats@;@/
+if right_type(r)>k then
+ begin incr(k); w:=link(w);
+ xp:=x_coord(r)+x_coord(w); yp:=y_coord(r)+y_coord(w)+half_unit;
+ if yp<>yy then
+ @<Record a line segment from |(xx,yy)| to |(xp,yp)| in |env_move|@>;
+ end
+else begin decr(k); w:=knil(w);
+ xp:=x_coord(r)+x_coord(w); yp:=y_coord(r)+y_coord(w)+half_unit;
+ end;
+stat if internal[tracing_edges]>unity then
+ begin print(" to ");
+ print_two_true(xp,yp-half_unit);
+ print_nl("");
+ end;@+tats@;@/
+m:=floor_unscaled(xp-xy_corr[octant]);
+move_ptr:=floor_unscaled(yp-y_corr[octant])-n0;
+if m>env_move[move_ptr] then env_move[move_ptr]:=m;
+end
+
+@ In this step we have |xp>=xx| and |yp>=yy|.
+
+@<Record a line segment from |(xx,yy)| to |(xp,yp)| in |env_move|@>=
+begin ty:=floor_scaled(yy-y_corr[octant]); dely:=yp-yy; yy:=yy-ty;
+ty:=yp-y_corr[octant]-ty;
+if ty>=unity then
+ begin delx:=xp-xx; yy:=unity-yy;
+ loop@+ begin tx:=take_fraction(delx,make_fraction(yy,dely));
+ if ab_vs_cd(tx,dely,delx,yy)+xy_corr[octant]>0 then decr(tx);
+ m:=floor_unscaled(xx+tx);
+ if m>env_move[move_ptr] then env_move[move_ptr]:=m;
+ ty:=ty-unity;
+ if ty<unity then goto done1;
+ yy:=yy+unity; incr(move_ptr);
+ end;
+ done1:end;
+end
+
+@ @<Insert the new envelope moves in the pixel data@>=
+debug if (m<>mm1)or(move_ptr<>n1-n0) then confusion("1");@+gubed@;@/
+move[0]:=d0+env_move[0]-mm0;
+for n:=1 to move_ptr do
+ move[n]:=env_move[n]-env_move[n-1]+1;
+move[move_ptr]:=move[move_ptr]-d1;
+if internal[smoothing]>0 then smooth_moves(smooth_bot,smooth_top);
+move_to_edges(m0,n0,m1,n1);
+if right_transition(q)=axis then
+ begin w:=link(h); skew_line_edges(q,knil(w),w);
+ end
+
+@ We've done it all in the odd-octant case; the only thing remaining
+is to repeat the same ideas, upside down and/or backwards.
+
+The following code has been split off as a subprocedure of |fill_envelope|,
+because some \PASCAL\ compilers cannot handle procedures as large as
+|fill_envelope| would otherwise be.
+
+@<Declare the procedure called |dual_moves|@>=
+procedure dual_moves(@!h,@!p,@!q:pointer);
+label done,done1;
+var @!r,@!s:pointer; {for list traversal}
+@<Other local variables for |fill_envelope|@>@;
+begin @<Initialize for dual envelope moves@>;
+r:=p; {recall that |right_type(q)=endpoint=0| now}
+loop@+ begin if r=q then smooth_top:=move_ptr;
+ while right_type(r)<>k do
+ @<Insert a line segment dually to approach the correct offset@>;
+ if r=p then smooth_bot:=move_ptr;
+ if r=q then goto done;
+ move[move_ptr]:=1; n:=move_ptr; s:=link(r);@/
+ make_moves(x_coord(r)+x_coord(w),right_x(r)+x_coord(w),
+ left_x(s)+x_coord(w),x_coord(s)+x_coord(w),@|
+ y_coord(r)+y_coord(w)+half_unit,right_y(r)+y_coord(w)+half_unit,
+ left_y(s)+y_coord(w)+half_unit,y_coord(s)+y_coord(w)+half_unit,@|
+ xy_corr[octant],y_corr[octant]);
+ @<Transfer moves dually from the |move| array to |env_move|@>;
+ r:=s;
+ end;
+done:@<Insert the new envelope moves dually in the pixel data@>;
+end;
+
+@ In the dual case the normal situation is to arrive with a |diagonal|
+transition and to leave at the |axis|. The leftmost edge in each row
+is relevant instead of the rightmost one.
+
+@<Initialize for dual envelope moves@>=
+k:=info(h)+1; ww:=link(h); w:=knil(ww);@/
+mm0:=floor_unscaled(x_coord(p)+x_coord(w)-xy_corr[octant]);
+mm1:=floor_unscaled(x_coord(q)+x_coord(ww)-xy_corr[octant]);
+for n:=1 to n1-n0+1 do env_move[n]:=mm1;
+env_move[0]:=mm0; move_ptr:=0; m:=mm0
+
+@ @<Transfer moves dually from the |move| array to |env_move|@>=
+repeat if m<env_move[n] then env_move[n]:=m;
+m:=m+move[n]-1;
+incr(n);
+until n>move_ptr
+
+@ Dual retrograde lines occur when |k| increases; the edges of such lines
+are not the furthest left in any row.
+
+@<Insert a line segment dually to approach the correct offset@>=
+begin xx:=x_coord(r)+x_coord(w); yy:=y_coord(r)+y_coord(w)+half_unit;
+@!stat if internal[tracing_edges]>unity then
+ begin print_nl("@@ transition line "); print_int(k); print(", from ");
+@:]]]\AT!_trans_}{\.{\AT! transition line...}@>
+@.transition line...@>
+ print_two_true(xx,yy-half_unit);
+ end;@+tats@;@/
+if right_type(r)<k then
+ begin decr(k); w:=knil(w);
+ xp:=x_coord(r)+x_coord(w); yp:=y_coord(r)+y_coord(w)+half_unit;
+ if yp<>yy then
+ @<Record a line segment from |(xx,yy)| to |(xp,yp)| dually in |env_move|@>;
+ end
+else begin incr(k); w:=link(w);
+ xp:=x_coord(r)+x_coord(w); yp:=y_coord(r)+y_coord(w)+half_unit;
+ end;
+stat if internal[tracing_edges]>unity then
+ begin print(" to ");
+ print_two_true(xp,yp-half_unit);
+ print_nl("");
+ end;@+tats@;@/
+m:=floor_unscaled(xp-xy_corr[octant]);
+move_ptr:=floor_unscaled(yp-y_corr[octant])-n0;
+if m<env_move[move_ptr] then env_move[move_ptr]:=m;
+end
+
+@ Again, |xp>=xx| and |yp>=yy|; but this time we are interested in the {\sl
+smallest\/} |m| that belongs to a given |move_ptr| position, instead of
+the largest~|m|.
+
+@<Record a line segment from |(xx,yy)| to |(xp,yp)| dually in |env_move|@>=
+begin ty:=floor_scaled(yy-y_corr[octant]); dely:=yp-yy; yy:=yy-ty;
+ty:=yp-y_corr[octant]-ty;
+if ty>=unity then
+ begin delx:=xp-xx; yy:=unity-yy;
+ loop@+ begin if m<env_move[move_ptr] then env_move[move_ptr]:=m;
+ tx:=take_fraction(delx,make_fraction(yy,dely));
+ if ab_vs_cd(tx,dely,delx,yy)+xy_corr[octant]>0 then decr(tx);
+ m:=floor_unscaled(xx+tx);
+ ty:=ty-unity; incr(move_ptr);
+ if ty<unity then goto done1;
+ yy:=yy+unity;
+ end;
+done1: if m<env_move[move_ptr] then env_move[move_ptr]:=m;
+ end;
+end
+
+@ Since |env_move| contains minimum values instead of maximum values, the
+finishing-up process is slightly different in the dual case.
+
+@<Insert the new envelope moves dually in the pixel data@>=
+debug if (m<>mm1)or(move_ptr<>n1-n0) then confusion("2");@+gubed@;@/
+move[0]:=d0+env_move[1]-mm0;
+for n:=1 to move_ptr do
+ move[n]:=env_move[n+1]-env_move[n]+1;
+move[move_ptr]:=move[move_ptr]-d1;
+if internal[smoothing]>0 then smooth_moves(smooth_bot,smooth_top);
+move_to_edges(m0,n0,m1,n1);
+if right_transition(q)=diagonal then
+ begin w:=link(h); skew_line_edges(q,w,knil(w));
+ end
+
+@* \[25] Elliptical pens.
+To get the envelope of a cyclic path with respect to an ellipse, \MF\
+calculates the envelope with respect to a polygonal approximation to
+the ellipse, using an approach due to John Hobby (Ph.D. thesis,
+Stanford University, 1985).
+@^Hobby, John Douglas@>
+This has two important advantages over trying to obtain the ``exact''
+envelope:
+
+\yskip\textindent{1)}It gives better results, because the polygon has been
+designed to counteract problems that arise from digitization; the
+polygon includes sub-pixel corrections to an exact ellipse that make
+the results essentially independent of where the path falls on the raster.
+For example, the exact envelope with respect to a pen of diameter~1
+blackens a pixel if and only if the path intersects a circle of diameter~1
+inscribed in that pixel; the resulting pattern has ``blots'' when the path
+is travelling diagonally in unfortunate raster positions. A much better
+result is obtained when pixels are blackened only when the path intersects
+an inscribed {\sl diamond\/} of diameter~1. Such a diamond is precisely
+the polygon that \MF\ uses in the special case of a circle whose diameter is~1.
+
+\yskip\textindent{2)}Polygonal envelopes of cubic splines are cubic
+splines, hence it isn't necessary to introduce completely different
+routines. By contrast, exact envelopes of cubic splines with respect
+to circles are complicated curves, more difficult to plot than cubics.
+
+@ Hobby's construction involves some interesting number theory.
+If $u$ and~$v$ are relatively prime integers, we divide the
+set of integer points $(m,n)$ into equivalence classes by saying
+that $(m,n)$ belongs to class $um+vn$. Then any two integer points
+that lie on a line of slope $-u/v$ belong to the same class, because
+such points have the form $(m+tv,n-tu)$. Neighboring lines of slope $-u/v$
+that go through integer points are separated by distance $1/\psqrt{u^2+v^2}$
+from each other, and these lines are perpendicular to lines of slope~$v/u$.
+If we start at the origin and travel a distance $k/\psqrt{u^2+v^2}$ in
+direction $(u,v)$, we reach the line of slope~$-u/v$ whose points
+belong to class~$k$.
+
+For example, let $u=2$ and $v=3$. Then the points $(0,0)$, $(3,-2)$,
+$\ldots$ belong to class~0; the points $(-1,1)$, $(2,-1)$, $\ldots$ belong
+to class~1; and the distance between these two lines is $1/\sqrt{13}$.
+The point $(2,3)$ itself belongs to class~13, hence its distance from
+the origin is $13/\sqrt{13}=\sqrt{13}$ (which we already knew).
+
+Suppose we wish to plot envelopes with respect to polygons with
+integer vertices. Then the best polygon for curves that travel in
+direction $(v,-u)$ will contain the points of class~$k$ such that
+$k/\psqrt{u^2+v^2}$ is as close as possible to~$d$, where $d$ is the
+maximum distance of the given ellipse from the line $ux+vy=0$.
+
+The |fillin| correction assumes that a diagonal line has an
+apparent thickness $$2f\cdot\min(\vert u\vert,\vert v\vert)/\psqrt{u^2+v^2}$$
+greater than would be obtained with truly square pixels. (If a
+white pixel at an exterior corner is assumed to have apparent
+darkness $f_1$ and a black pixel at an interior corner is assumed
+to have apparent darkness $1-f_2$, then $f=f_1-f_2$ is the |fillin|
+parameter.) Under this assumption we want to choose $k$ so that
+$\bigl(k+2f\cdot\min(\vert u\vert,\vert v\vert)\bigr)\big/\psqrt{u^2+v^2}$
+is as close as possible to $d$.
+
+Integer coordinates for the vertices work nicely because the thickness of
+the envelope at any given slope is independent of the position of the
+path with respect to the raster. It turns out, in fact, that the same
+property holds for polygons whose vertices have coordinates that are
+integer multiples of~$1\over2$, because ellipses are symmetric about
+the origin. It's convenient to double all dimensions and require the
+resulting polygon to have vertices with integer coordinates. For example,
+to get a circle of {\sl diameter}~$r$, we shall compute integer
+coordinates for a circle of {\sl radius}~$r$. The circle of radius~$r$
+will want to be represented by a polygon that contains the boundary
+points $(0,\pm r)$ and~$(\pm r,0)$; later we will divide everything
+by~2 and get a polygon with $(0,\pm{1\over2}r)$ and $(\pm{1\over2}r,0)$
+on its boundary.
+
+@ In practice the important slopes are those having small values of
+$u$ and~$v$; these make regular patterns in which our eyes quickly
+spot irregularities. For example, horizontal and vertical lines
+(when $u=0$ and $\vert v\vert=1$, or $\vert u\vert=1$ and $v=0$)
+are the most important; diagonal lines (when $\vert u\vert=\vert v\vert=1$)
+are next; and then come lines with slope $\pm2$ or $\pm1/2$.
+
+The nicest way to generate all rational directions having small
+numerators and denominators is to generalize the Stern-Brocot tree
+[cf.~{\sl Concrete Mathematics}, section 4.5]
+@^Brocot, Achille@>
+@^Stern, Moritz Abraham@>
+to a ``Stern-Brocot wreath'' as follows: Begin with four nodes
+arranged in a circle, containing the respective directions
+$(u,v)=(1,0)$, $(0,1)$, $(-1,0)$, and~$(0,-1)$. Then between pairs of
+consecutive terms $(u,v)$ and $(u',v')$ of the wreath, insert the
+direction $(u+u',v+v')$; continue doing this until some stopping
+criterion is fulfilled.
+
+It is not difficult to verify that, regardless of the stopping
+criterion, consecutive directions $(u,v)$ and $(u',v')$ of this
+wreath will always satisfy the relation $uv'-u'v=1$. Such pairs
+of directions have a nice property with respect to the equivalence
+classes described above. Let $l$ be a line of equivalent integer points
+$(m+tv,n-tu)$ with respect to~$(u,v)$, and let $l'$ be a line of
+equivalent integer points $(m'+tv',n'-tu')$ with respect to~$(u',v')$.
+Then $l$ and~$l'$ intersect in an integer point $(m'',n'')$, because
+the determinant of the linear equations for intersection is $uv'-u'v=1$.
+Notice that the class number of $(m'',n'')$ with respect to $(u+u',v+v')$
+is the sum of its class numbers with respect to $(u,v)$ and~$(u',v')$.
+Moreover, consecutive points on~$l$ and~$l'$ belong to classes that
+differ by exactly~1 with respect to $(u+u',v+v')$.
+
+This leads to a nice algorithm in which we construct a polygon having
+``correct'' class numbers for as many small-integer directions $(u,v)$
+as possible: Assuming that lines $l$ and~$l'$ contain points of the
+correct class for $(u,v)$ and~$(u',v')$, respectively, we determine
+the intersection $(m'',n'')$ and compute its class with respect to
+$(u+u',v+v')$. If the class is too large to be the best approximation,
+we move back the proper number of steps from $(m'',n'')$ toward smaller
+class numbers on both $l$ and~$l'$, unless this requires moving to points
+that are no longer in the polygon; in this we arrive at two points that
+determine a line~$l''$ having the appropriate class. The process continues
+recursively, until it cannot proceed without removing the last remaining
+point from the class for $(u,v)$ or the class for $(u',v')$.
+
+@ The |make_ellipse| subroutine produces a pointer to a cyclic path
+whose vertices define a polygon suitable for envelopes. The control
+points on this path will be ignored; in fact, the fields in knot nodes
+that are usually reserved for control points are occupied by other
+data that helps |make_ellipse| compute the desired polygon.
+
+Parameters |major_axis| and |minor_axis| define the axes of the ellipse;
+and parameter |theta| is an angle by which the ellipse is rotated
+counterclockwise. If |theta=0|, the ellipse has the equation
+$(x/a)^2+(y/b)^2=1$, where |a=major_axis/2| and |b=minor_axis/2|.
+In general, the points of the ellipse are generated in the complex plane
+by the formula $e^{i\theta}(a\cos t+ib\sin t)$, as $t$~ranges over all
+angles. Notice that if |major_axis=minor_axis=d|, we obtain a circle
+of diameter~|d|, regardless of the value of |theta|.
+
+The method sketched above is used to produce the elliptical polygon,
+except that the main work is done only in the halfplane obtained from
+the three starting directions $(0,-1)$, $(1,0)$,~$(0,1)$. Since the ellipse
+has circular symmetry, we use the fact that the last half of the polygon
+is simply the negative of the first half. Furthermore, we need to compute only
+one quarter of the polygon if the ellipse has axis symmetry.
+
+@p function make_ellipse(@!major_axis,@!minor_axis:scaled;
+ @!theta:angle):pointer;
+label done,done1,found;
+var @!p,@!q,@!r,@!s:pointer; {for list manipulation}
+@!h:pointer; {head of the constructed knot list}
+@!alpha,@!beta,@!gamma,@!delta:integer; {special points}
+@!c,@!d:integer; {class numbers}
+@!u,@!v:integer; {directions}
+@!symmetric:boolean; {should the result be symmetric about the axes?}
+begin @<Initialize the ellipse data structure by beginning with
+ directions $(0,-1)$, $(1,0)$, $(0,1)$@>;
+@<Interpolate new vertices in the ellipse data structure until
+ improvement is impossible@>;
+if symmetric then
+ @<Complete the half ellipse by reflecting the quarter already computed@>;
+@<Complete the ellipse by copying the negative of the half already computed@>;
+make_ellipse:=h;
+end;
+
+@ A special data structure is used only with |make_ellipse|: The
+|right_x|, |left_x|, |right_y|, and |left_y| fields of knot nodes
+are renamed |right_u|, |left_v|, |right_class|, and |left_length|,
+in order to store information that simplifies the necessary computations.
+
+If |p| and |q| are consecutive knots in this data structure, the
+|x_coord| and |y_coord| fields of |p| and~|q| contain current vertices
+of the polygon; their values are integer multiples
+of |half_unit|. Both of these vertices belong to equivalence class
+|right_class(p)| with respect to the direction
+$\bigl($|right_u(p),left_v(q)|$\bigr)$. The number of points of this class
+on the line from vertex~|p| to vertex~|q| is |1+left_length(q)|.
+In particular, |left_length(q)=0| means that |x_coord(p)=x_coord(q)|
+and |y_coord(p)=y_coord(q)|; such duplicate vertices will be
+discarded during the course of the algorithm.
+
+The contents of |right_u(p)| and |left_v(q)| are integer multiples
+of |half_unit|, just like the coordinate fields. Hence, for example,
+the point $\bigl($|x_coord(p)-left_v(q),y_coord(p)+right_u(q)|$\bigr)$
+also belongs to class number |right_class(p)|. This point is one
+step closer to the vertex in node~|q|; it equals that vertex
+if and only if |left_length(q)=1|.
+
+The |left_type| and |right_type| fields are not used, but |link|
+has its normal meaning.
+
+To start the process, we create four nodes for the three directions
+$(0,-1)$, $(1,0)$, and $(0,1)$. The corresponding vertices are
+$(-\alpha,-\beta)$, $(\gamma,-\beta)$, $(\gamma,\beta)$, and
+$(\alpha,\beta)$, where $(\alpha,\beta)$ is a half-integer approximation
+to where the ellipse rises highest above the $x$-axis, and where
+$\gamma$ is a half-integer approximation to the maximum $x$~coordinate
+of the ellipse. The fourth of these nodes is not actually calculated
+if the ellipse has axis symmetry.
+
+@d right_u==right_x {|u| value for a pen edge}
+@d left_v==left_x {|v| value for a pen edge}
+@d right_class==right_y {equivalence class number of a pen edge}
+@d left_length==left_y {length of a pen edge}
+
+@<Initialize the ellipse data structure...@>=
+@<Calculate integers $\alpha$, $\beta$, $\gamma$ for the vertex
+ coordinates@>;
+p:=get_node(knot_node_size); q:=get_node(knot_node_size);
+r:=get_node(knot_node_size);
+if symmetric then s:=null@+else s:=get_node(knot_node_size);
+h:=p; link(p):=q; link(q):=r; link(r):=s; {|s=null| or |link(s)=null|}
+@<Revise the values of $\alpha$, $\beta$, $\gamma$, if necessary,
+ so that degenerate lines of length zero will not be obtained@>;
+x_coord(p):=-alpha*half_unit;
+y_coord(p):=-beta*half_unit;
+x_coord(q):=gamma*half_unit;@/
+y_coord(q):=y_coord(p); x_coord(r):=x_coord(q);@/
+right_u(p):=0; left_v(q):=-half_unit;@/
+right_u(q):=half_unit; left_v(r):=0;@/
+right_u(r):=0;
+right_class(p):=beta; right_class(q):=gamma; right_class(r):=beta;@/
+left_length(q):=gamma+alpha;
+if symmetric then
+ begin y_coord(r):=0; left_length(r):=beta;
+ end
+else begin y_coord(r):=-y_coord(p); left_length(r):=beta+beta;@/
+ x_coord(s):=-x_coord(p); y_coord(s):=y_coord(r);@/
+ left_v(s):=half_unit; left_length(s):=gamma-alpha;
+ end
+
+@ One of the important invariants of the pen data structure is that
+the points are distinct. We may need to correct the pen specification
+in order to avoid this. (The result of \&{pencircle} will always be at
+least one pixel wide and one pixel tall, although \&{makepen} is
+capable of producing smaller pens.)
+
+@<Revise the values of $\alpha$, $\beta$, $\gamma$, if necessary...@>=
+if beta=0 then beta:=1;
+if gamma=0 then gamma:=1;
+if gamma<=abs(alpha) then
+ if alpha>0 then alpha:=gamma-1
+ else alpha:=1-gamma
+
+@ If $a$ and $b$ are the semi-major and semi-minor axes,
+the given ellipse rises highest above the $y$-axis at the point
+$\bigl((a^2-b^2)\sin\theta\cos\theta/\rho\bigr)+i\rho$, where
+$\rho=\sqrt{(a\sin\theta)^2+(b\cos\theta)^2}$. It reaches
+furthest to the right of~the $x$-axis at the point
+$\sigma+i(a^2-b^2)\sin\theta\cos\theta/\sigma$, where
+$\sigma=\sqrt{(a\cos\theta)^2+(b\sin\theta)^2}$.
+
+@<Calculate integers $\alpha$, $\beta$, $\gamma$...@>=
+if (major_axis=minor_axis)or(theta mod ninety_deg=0) then
+ begin symmetric:=true; alpha:=0;
+ if odd(theta div ninety_deg) then
+ begin beta:=major_axis; gamma:=minor_axis;
+ n_sin:=fraction_one; n_cos:=0; {|n_sin| and |n_cos| are used later}
+ end
+ else begin beta:=minor_axis; gamma:=major_axis;
+ end; {|n_sin| and |n_cos| aren't needed in this case}
+ end
+else begin symmetric:=false;
+ n_sin_cos(theta); {set up $|n_sin|=\sin\theta$ and $|n_cos|=\cos\theta$}
+ gamma:=take_fraction(major_axis,n_sin);
+ delta:=take_fraction(minor_axis,n_cos);
+ beta:=pyth_add(gamma,delta);
+ alpha:=take_fraction(take_fraction(major_axis,
+ make_fraction(gamma,beta)),n_cos)@|
+ -take_fraction(take_fraction(minor_axis,
+ make_fraction(delta,beta)),n_sin);
+ alpha:=(alpha+half_unit) div unity;
+ gamma:=pyth_add(take_fraction(major_axis,n_cos),
+ take_fraction(minor_axis,n_sin));
+ end;
+beta:=(beta+half_unit) div unity;
+gamma:=(gamma+half_unit) div unity
+
+@ Now |p|, |q|, and |r| march through the list, always representing
+three consecutive vertices and two consecutive slope directions.
+When a new slope is interpolated, we back up slightly, until
+further refinement is impossible; then we march forward again.
+The somewhat magical operations performed in this part of the
+algorithm are justified by the theory sketched earlier.
+Complications arise only from the need to keep zero-length lines
+out of the final data structure.
+
+@<Interpolate new vertices in the ellipse data structure...@>=
+loop@+ begin u:=right_u(p)+right_u(q); v:=left_v(q)+left_v(r);
+ c:=right_class(p)+right_class(q);@/
+ @<Compute the distance |d| from class~0 to the edge of the ellipse
+ in direction |(u,v)|, times $\psqrt{u^2+v^2}$,
+ rounded to the nearest integer@>;
+ delta:=c-d; {we want to move |delta| steps back
+ from the intersection vertex~|q|}
+ if delta>0 then
+ begin if delta>left_length(r) then delta:=left_length(r);
+ if delta>=left_length(q) then
+ @<Remove the line from |p| to |q|,
+ and adjust vertex~|q| to introduce a new line@>
+ else @<Insert a new line for direction |(u,v)| between |p| and~|q|@>;
+ end
+ else p:=q;
+ @<Move to the next remaining triple |(p,q,r)|, removing and skipping past
+ zero-length lines that might be present; |goto done| if all
+ triples have been processed@>;
+ end;
+done:
+
+@ The appearance of a zero-length line means that we should advance |p|
+past it. We must not try to straddle a missing direction, because the
+algorithm works only on consecutive pairs of directions.
+
+@<Move to the next remaining triple |(p,q,r)|...@>=
+loop@+ begin q:=link(p);
+ if q=null then goto done;
+ if left_length(q)=0 then
+ begin link(p):=link(q); right_class(p):=right_class(q);
+ right_u(p):=right_u(q); free_node(q,knot_node_size);
+ end
+ else begin r:=link(q);
+ if r=null then goto done;
+ if left_length(r)=0 then
+ begin link(p):=r; free_node(q,knot_node_size); p:=r;
+ end
+ else goto found;
+ end;
+ end;
+found:
+
+@ The `\&{div} 8' near the end of this step comes from
+the fact that |delta| is scaled by~$2^{15}$ and $d$~by~$2^{16}$,
+while |take_fraction| removes a scale factor of~$2^{28}$.
+We also make sure that $d\G\max(\vert u\vert,\vert v\vert)$, so that
+the pen will always include a circular pen of diameter~1 as a subset;
+then it won't be possible to get disconnected path envelopes.
+
+@<Compute the distance |d| from class~0 to the edge of the ellipse...@>=
+delta:=pyth_add(u,v);
+if major_axis=minor_axis then d:=major_axis {circles are easy}
+else begin if theta=0 then
+ begin alpha:=u; beta:=v;
+ end
+ else begin alpha:=take_fraction(u,n_cos)+take_fraction(v,n_sin);
+ beta:=take_fraction(v,n_cos)-take_fraction(u,n_sin);
+ end;
+ alpha:=make_fraction(alpha,delta);
+ beta:=make_fraction(beta,delta);
+ d:=pyth_add(take_fraction(major_axis,alpha),
+ take_fraction(minor_axis,beta));
+ end;
+alpha:=abs(u); beta:=abs(v);
+if alpha<beta then
+ begin alpha:=abs(v); beta:=abs(u);
+ end; {now $\alpha=\max(\vert u\vert,\vert v\vert)$,
+ $\beta=\min(\vert u\vert,\vert v\vert)$}
+if internal[fillin]<>0 then
+ d:=d-take_fraction(internal[fillin],make_fraction(beta+beta,delta));
+d:=take_fraction((d+4) div 8,delta); alpha:=alpha div half_unit;
+if d<alpha then d:=alpha
+
+@ At this point there's a line of length |<=delta| from vertex~|p|
+to vertex~|q|, orthogonal to direction $\bigl($|right_u(p),left_v(q)|$\bigr)$;
+and there's a line of length |>=delta| from vertex~|q| to
+to vertex~|r|, orthogonal to direction $\bigl($|right_u(q),left_v(r)|$\bigr)$.
+The best line to direction $(u,v)$ should replace the line from
+|p| to~|q|; this new line will have the same length as the old.
+
+@<Remove the line from |p| to |q|...@>=
+begin delta:=left_length(q);@/
+right_class(p):=c-delta; right_u(p):=u; left_v(q):=v;@/
+x_coord(q):=x_coord(q)-delta*left_v(r);
+y_coord(q):=y_coord(q)+delta*right_u(q);@/
+left_length(r):=left_length(r)-delta;
+end
+
+@ Here is the main case, now that we have dealt with the exception:
+We insert a new line of length |delta| for direction |(u,v)|, decreasing
+each of the adjacent lines by |delta| steps.
+
+@<Insert a new line for direction |(u,v)| between |p| and~|q|@>=
+begin s:=get_node(knot_node_size); link(p):=s; link(s):=q;@/
+x_coord(s):=x_coord(q)+delta*left_v(q);
+y_coord(s):=y_coord(q)-delta*right_u(p);@/
+x_coord(q):=x_coord(q)-delta*left_v(r);
+y_coord(q):=y_coord(q)+delta*right_u(q);@/
+left_v(s):=left_v(q); right_u(s):=u; left_v(q):=v;@/
+right_class(s):=c-delta;@/
+left_length(s):=left_length(q)-delta; left_length(q):=delta;
+left_length(r):=left_length(r)-delta;
+end
+
+@ Only the coordinates need to be copied, not the class numbers and other stuff.
+
+@<Complete the half ellipse...@>=
+begin s:=null; q:=h;
+loop@+ begin r:=get_node(knot_node_size); link(r):=s; s:=r;@/
+ x_coord(s):=x_coord(q); y_coord(s):=-y_coord(q);
+ if q=p then goto done1;
+ q:=link(q);
+ if y_coord(q)=0 then goto done1;
+ end;
+done1: link(p):=s; beta:=-y_coord(h);
+while y_coord(p)<>beta do p:=link(p);
+q:=link(p);
+end
+
+@ Now we use a somewhat tricky fact: The pointer |q| will be null if and
+only if the line for the final direction $(0,1)$ has been removed. If
+that line still survives, it should be combined with a possibly
+surviving line in the initial direction $(0,-1)$.
+
+@<Complete the ellipse by copying...@>=
+if q<>null then
+ begin if right_u(h)=0 then
+ begin p:=h; h:=link(h); free_node(p,knot_node_size);@/
+ x_coord(q):=-x_coord(h);
+ end;
+ p:=q;
+ end
+else q:=p;
+r:=link(h); {now |p=q|, |x_coord(p)=-x_coord(h)|, |y_coord(p)=-y_coord(h)|}
+repeat s:=get_node(knot_node_size); link(p):=s; p:=s;@/
+x_coord(p):=-x_coord(r); y_coord(p):=-y_coord(r); r:=link(r);
+until r=q;
+link(p):=h
+
+@* \[26] Direction and intersection times.
+A path of length $n$ is defined parametrically by functions $x(t)$ and
+$y(t)$, for |0<=t<=n|; we can regard $t$ as the ``time'' at which the path
+reaches the point $\bigl(x(t),y(t)\bigr)$. In this section of the program
+we shall consider operations that determine special times associated with
+given paths: the first time that a path travels in a given direction, and
+a pair of times at which two paths cross each other.
+
+@ Let's start with the easier task. The function |find_direction_time| is
+given a direction |(x,y)| and a path starting at~|h|. If the path never
+travels in direction |(x,y)|, the direction time will be~|-1|; otherwise
+it will be nonnegative.
+
+Certain anomalous cases can arise: If |(x,y)=(0,0)|, so that the given
+direction is undefined, the direction time will be~0. If $\bigl(x'(t),
+y'(t)\bigr)=(0,0)$, so that the path direction is undefined, it will be
+assumed to match any given direction at time~|t|.
+
+The routine solves this problem in nondegenerate cases by rotating the path
+and the given direction so that |(x,y)=(1,0)|; i.e., the main task will be
+to find when a given path first travels ``due east.''
+
+@p function find_direction_time(@!x,@!y:scaled;@!h:pointer):scaled;
+label exit,found,not_found,done;
+var @!max:scaled; {$\max\bigl(\vert x\vert,\vert y\vert\bigr)$}
+@!p,@!q:pointer; {for list traversal}
+@!n:scaled; {the direction time at knot |p|}
+@!tt:scaled; {the direction time within a cubic}
+@<Other local variables for |find_direction_time|@>@;
+begin @<Normalize the given direction for better accuracy;
+ but |return| with zero result if it's zero@>;
+n:=0; p:=h;
+loop@+ begin if right_type(p)=endpoint then goto not_found;
+ q:=link(p);
+ @<Rotate the cubic between |p| and |q|; then
+ |goto found| if the rotated cubic travels due east at some time |tt|;
+ but |goto not_found| if an entire cyclic path has been traversed@>;
+ p:=q; n:=n+unity;
+ end;
+not_found: find_direction_time:=-unity; return;
+found: find_direction_time:=n+tt;
+exit:end;
+
+@ @<Normalize the given direction for better accuracy...@>=
+if abs(x)<abs(y) then
+ begin x:=make_fraction(x,abs(y));
+ if y>0 then y:=fraction_one@+else y:=-fraction_one;
+ end
+else if x=0 then
+ begin find_direction_time:=0; return;
+ end
+else begin y:=make_fraction(y,abs(x));
+ if x>0 then x:=fraction_one@+else x:=-fraction_one;
+ end
+
+@ Since we're interested in the tangent directions, we work with the
+derivative $${\textstyle1\over3}B'(x_0,x_1,x_2,x_3;t)=
+B(x_1-x_0,x_2-x_1,x_3-x_2;t)$$ instead of
+$B(x_0,x_1,x_2,x_3;t)$ itself. The derived coefficients are also scaled up
+in order to achieve better accuracy.
+
+The given path may turn abruptly at a knot, and it might pass the critical
+tangent direction at such a time. Therefore we remember the direction |phi|
+in which the previous rotated cubic was traveling. (The value of |phi| will be
+undefined on the first cubic, i.e., when |n=0|.)
+
+@<Rotate the cubic between |p| and |q|; then...@>=
+tt:=0;
+@<Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples of the control
+ points of the rotated derivatives@>;
+if y1=0 then if x1>=0 then goto found;
+if n>0 then
+ begin @<Exit to |found| if an eastward direction occurs at knot |p|@>;
+ if p=h then goto not_found;
+ end;
+if (x3<>0)or(y3<>0) then phi:=n_arg(x3,y3);
+@<Exit to |found| if the curve whose derivatives are specified by
+ |x1,x2,x3,y1,y2,y3| travels eastward at some time~|tt|@>
+
+@ @<Other local variables for |find_direction_time|@>=
+@!x1,@!x2,@!x3,@!y1,@!y2,@!y3:scaled; {multiples of rotated derivatives}
+@!theta,@!phi:angle; {angles of exit and entry at a knot}
+@!t:fraction; {temp storage}
+
+@ @<Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples...@>=
+x1:=right_x(p)-x_coord(p); x2:=left_x(q)-right_x(p);
+x3:=x_coord(q)-left_x(q);@/
+y1:=right_y(p)-y_coord(p); y2:=left_y(q)-right_y(p);
+y3:=y_coord(q)-left_y(q);@/
+max:=abs(x1);
+if abs(x2)>max then max:=abs(x2);
+if abs(x3)>max then max:=abs(x3);
+if abs(y1)>max then max:=abs(y1);
+if abs(y2)>max then max:=abs(y2);
+if abs(y3)>max then max:=abs(y3);
+if max=0 then goto found;
+while max<fraction_half do
+ begin double(max); double(x1); double(x2); double(x3);
+ double(y1); double(y2); double(y3);
+ end;
+t:=x1; x1:=take_fraction(x1,x)+take_fraction(y1,y);
+y1:=take_fraction(y1,x)-take_fraction(t,y);@/
+t:=x2; x2:=take_fraction(x2,x)+take_fraction(y2,y);
+y2:=take_fraction(y2,x)-take_fraction(t,y);@/
+t:=x3; x3:=take_fraction(x3,x)+take_fraction(y3,y);
+y3:=take_fraction(y3,x)-take_fraction(t,y)
+
+@ @<Exit to |found| if an eastward direction occurs at knot |p|@>=
+theta:=n_arg(x1,y1);
+if theta>=0 then if phi<=0 then if phi>=theta-one_eighty_deg then goto found;
+if theta<=0 then if phi>=0 then if phi<=theta+one_eighty_deg then goto found
+
+@ In this step we want to use the |crossing_point| routine to find the
+roots of the quadratic equation $B(y_1,y_2,y_3;t)=0$.
+Several complications arise: If the quadratic equation has a double root,
+the curve never crosses zero, and |crossing_point| will find nothing;
+this case occurs iff $y_1y_3=y_2^2$ and $y_1y_2<0$. If the quadratic
+equation has simple roots, or only one root, we may have to negate it
+so that $B(y_1,y_2,y_3;t)$ crosses from positive to negative at its first root.
+And finally, we need to do special things if $B(y_1,y_2,y_3;t)$ is
+identically zero.
+
+@ @<Exit to |found| if the curve whose derivatives are specified by...@>=
+if x1<0 then if x2<0 then if x3<0 then goto done;
+if ab_vs_cd(y1,y3,y2,y2)=0 then
+ @<Handle the test for eastward directions when $y_1y_3=y_2^2$;
+ either |goto found| or |goto done|@>;
+if y1<=0 then
+ if y1<0 then
+ begin y1:=-y1; y2:=-y2; y3:=-y3;
+ end
+ else if y2>0 then
+ begin y2:=-y2; y3:=-y3;
+ end;
+@<Check the places where $B(y_1,y_2,y_3;t)=0$ to see if
+ $B(x_1,x_2,x_3;t)\ge0$@>;
+done:
+
+@ The quadratic polynomial $B(y_1,y_2,y_3;t)$ begins |>=0| and has at most
+two roots, because we know that it isn't identically zero.
+
+It must be admitted that the |crossing_point| routine is not perfectly accurate;
+rounding errors might cause it to find a root when $y_1y_3>y_2^2$, or to
+miss the roots when $y_1y_3<y_2^2$. The rotation process is itself
+subject to rounding errors. Yet this code optimistically tries to
+do the right thing.
+
+@d we_found_it==begin tt:=(t+@'4000) div @'10000; goto found;
+ end
+
+@<Check the places where $B(y_1,y_2,y_3;t)=0$...@>=
+t:=crossing_point(y1,y2,y3);
+if t>fraction_one then goto done;
+y2:=t_of_the_way(y2)(y3);
+x1:=t_of_the_way(x1)(x2);
+x2:=t_of_the_way(x2)(x3);
+x1:=t_of_the_way(x1)(x2);
+if x1>=0 then we_found_it;
+if y2>0 then y2:=0;
+tt:=t; t:=crossing_point(0,-y2,-y3);
+if t>fraction_one then goto done;
+x1:=t_of_the_way(x1)(x2);
+x2:=t_of_the_way(x2)(x3);
+if t_of_the_way(x1)(x2)>=0 then
+ begin t:=t_of_the_way(tt)(fraction_one); we_found_it;
+ end
+
+@ @<Handle the test for eastward directions when $y_1y_3=y_2^2$;
+ either |goto found| or |goto done|@>=
+begin if ab_vs_cd(y1,y2,0,0)<0 then
+ begin t:=make_fraction(y1,y1-y2);
+ x1:=t_of_the_way(x1)(x2);
+ x2:=t_of_the_way(x2)(x3);
+ if t_of_the_way(x1)(x2)>=0 then we_found_it;
+ end
+else if y3=0 then
+ if y1=0 then
+ @<Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0|@>
+ else if x3>=0 then
+ begin tt:=unity; goto found;
+ end;
+goto done;
+end
+
+@ At this point we know that the derivative of |y(t)| is identically zero,
+and that |x1<0|; but either |x2>=0| or |x3>=0|, so there's some hope of
+traveling east.
+
+@<Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0|...@>=
+begin t:=crossing_point(-x1,-x2,-x3);
+if t<=fraction_one then we_found_it;
+if ab_vs_cd(x1,x3,x2,x2)<=0 then
+ begin t:=make_fraction(x1,x1-x2); we_found_it;
+ end;
+end
+
+@ The intersection of two cubics can be found by an interesting variant
+of the general bisection scheme described in the introduction to |make_moves|.\
+Given $w(t)=B(w_0,w_1,w_2,w_3;t)$ and $z(t)=B(z_0,z_1,z_2,z_3;t)$,
+we wish to find a pair of times $(t_1,t_2)$ such that $w(t_1)=z(t_2)$,
+if an intersection exists. First we find the smallest rectangle that
+encloses the points $\{w_0,w_1,w_2,w_3\}$ and check that it overlaps
+the smallest rectangle that encloses
+$\{z_0,z_1,z_2,z_3\}$; if not, the cubics certainly don't intersect.
+But if the rectangles do overlap, we bisect the intervals, getting
+new cubics $w'$ and~$w''$, $z'$~and~$z''$; the intersection routine first
+tries for an intersection between $w'$ and~$z'$, then (if unsuccessful)
+between $w'$ and~$z''$, then (if still unsuccessful) between $w''$ and~$z'$,
+finally (if thrice unsuccessful) between $w''$ and~$z''$. After $l$~successful
+levels of bisection we will have determined the intersection times $t_1$
+and~$t_2$ to $l$~bits of accuracy.
+
+\def\submin{_{\rm min}} \def\submax{_{\rm max}}
+As before, it is better to work with the numbers $W_k=2^l(w_k-w_{k-1})$
+and $Z_k=2^l(z_k-z_{k-1})$ rather than the coefficients $w_k$ and $z_k$
+themselves. We also need one other quantity, $\Delta=2^l(w_0-z_0)$,
+to determine when the enclosing rectangles overlap. Here's why:
+The $x$~coordinates of~$w(t)$ are between $u\submin$ and $u\submax$,
+and the $x$~coordinates of~$z(t)$ are between $x\submin$ and $x\submax$,
+if we write $w_k=(u_k,v_k)$ and $z_k=(x_k,y_k)$ and $u\submin=
+\min(u_0,u_1,u_2,u_3)$, etc. These intervals of $x$~coordinates
+overlap if and only if $u\submin\L x\submax$ and
+$x\submin\L u\submax$. Letting
+$$U\submin=\min(0,U_1,U_1+U_2,U_1+U_2+U_3),\;
+ U\submax=\max(0,U_1,U_1+U_2,U_1+U_2+U_3),$$
+we have $u\submin=2^lu_0+U\submin$, etc.; the condition for overlap
+reduces to
+$$X\submin-U\submax\L 2^l(u_0-x_0)\L X\submax-U\submin.$$
+Thus we want to maintain the quantity $2^l(u_0-x_0)$; similarly,
+the quantity $2^l(v_0-y_0)$ accounts for the $y$~coordinates. The
+coordinates of $\Delta=2^l(w_0-z_0)$ must stay bounded as $l$ increases,
+because of the overlap condition; i.e., we know that $X\submin$,
+$X\submax$, and their relatives are bounded, hence $X\submax-
+U\submin$ and $X\submin-U\submax$ are bounded.
+
+@ Incidentally, if the given cubics intersect more than once, the process
+just sketched will not necessarily find the lexicographically smallest pair
+$(t_1,t_2)$. The solution actually obtained will be smallest in ``shuffled
+order''; i.e., if $t_1=(.a_1a_2\ldots a_{16})_2$ and
+$t_2=(.b_1b_2\ldots b_{16})_2$, then we will minimize
+$a_1b_1a_2b_2\ldots a_{16}b_{16}$, not
+$a_1a_2\ldots a_{16}b_1b_2\ldots b_{16}$.
+Shuffled order agrees with lexicographic order if all pairs of solutions
+$(t_1,t_2)$ and $(t_1',t_2')$ have the property that $t_1<t_1'$ iff
+$t_2<t_2'$; but in general, lexicographic order can be quite different,
+and the bisection algorithm would be substantially less efficient if it were
+constrained by lexicographic order.
+
+For example, suppose that an overlap has been found for $l=3$ and
+$(t_1,t_2)= (.101,.011)$ in binary, but that no overlap is produced by
+either of the alternatives $(.1010,.0110)$, $(.1010,.0111)$ at level~4.
+Then there is probably an intersection in one of the subintervals
+$(.1011,.011x)$; but lexicographic order would require us to explore
+$(.1010,.1xxx)$ and $(.1011,.00xx)$ and $(.1011,.010x)$ first. We wouldn't
+want to store all of the subdivision data for the second path, so the
+subdivisions would have to be regenerated many times. Such inefficiencies
+would be associated with every `1' in the binary representation of~$t_1$.
+
+@ The subdivision process introduces rounding errors, hence we need to
+make a more liberal test for overlap. It is not hard to show that the
+computed values of $U_i$ differ from the truth by at most~$l$, on
+level~$l$, hence $U\submin$ and $U\submax$ will be at most $3l$ in error.
+If $\beta$ is an upper bound on the absolute error in the computed
+components of $\Delta=(|delx|,|dely|)$ on level~$l$, we will replace
+the test `$X\submin-U\submax\L|delx|$' by the more liberal test
+`$X\submin-U\submax\L|delx|+|tol|$', where $|tol|=6l+\beta$.
+
+More accuracy is obtained if we try the algorithm first with |tol=0|;
+the more liberal tolerance is used only if an exact approach fails.
+It is convenient to do this double-take by letting `3' in the preceding
+paragraph be a parameter, which is first 0, then 3.
+
+@<Glob...@>=
+@!tol_step:0..6; {either 0 or 3, usually}
+
+@ We shall use an explicit stack to implement the recursive bisection
+method described above. In fact, the |bisect_stack| array is available for
+this purpose. It will contain numerous 5-word packets like
+$(U_1,U_2,U_3,U\submin,U\submax)$, as well as 20-word packets comprising
+the 5-word packets for $U$, $V$, $X$, and~$Y$.
+
+The following macros define the allocation of stack positions to
+the quantities needed for bisection-intersection.
+
+@d stack_1(#)==bisect_stack[#] {$U_1$, $V_1$, $X_1$, or $Y_1$}
+@d stack_2(#)==bisect_stack[#+1] {$U_2$, $V_2$, $X_2$, or $Y_2$}
+@d stack_3(#)==bisect_stack[#+2] {$U_3$, $V_3$, $X_3$, or $Y_3$}
+@d stack_min(#)==bisect_stack[#+3]
+ {$U\submin$, $V\submin$, $X\submin$, or $Y\submin$}
+@d stack_max(#)==bisect_stack[#+4]
+ {$U\submax$, $V\submax$, $X\submax$, or $Y\submax$}
+@d int_packets=20 {number of words to represent $U_k$, $V_k$, $X_k$, and $Y_k$}
+@#
+@d u_packet(#)==#-5
+@d v_packet(#)==#-10
+@d x_packet(#)==#-15
+@d y_packet(#)==#-20
+@d l_packets==bisect_ptr-int_packets
+@d r_packets==bisect_ptr
+@d ul_packet==u_packet(l_packets) {base of $U'_k$ variables}
+@d vl_packet==v_packet(l_packets) {base of $V'_k$ variables}
+@d xl_packet==x_packet(l_packets) {base of $X'_k$ variables}
+@d yl_packet==y_packet(l_packets) {base of $Y'_k$ variables}
+@d ur_packet==u_packet(r_packets) {base of $U''_k$ variables}
+@d vr_packet==v_packet(r_packets) {base of $V''_k$ variables}
+@d xr_packet==x_packet(r_packets) {base of $X''_k$ variables}
+@d yr_packet==y_packet(r_packets) {base of $Y''_k$ variables}
+@#
+@d u1l==stack_1(ul_packet) {$U'_1$}
+@d u2l==stack_2(ul_packet) {$U'_2$}
+@d u3l==stack_3(ul_packet) {$U'_3$}
+@d v1l==stack_1(vl_packet) {$V'_1$}
+@d v2l==stack_2(vl_packet) {$V'_2$}
+@d v3l==stack_3(vl_packet) {$V'_3$}
+@d x1l==stack_1(xl_packet) {$X'_1$}
+@d x2l==stack_2(xl_packet) {$X'_2$}
+@d x3l==stack_3(xl_packet) {$X'_3$}
+@d y1l==stack_1(yl_packet) {$Y'_1$}
+@d y2l==stack_2(yl_packet) {$Y'_2$}
+@d y3l==stack_3(yl_packet) {$Y'_3$}
+@d u1r==stack_1(ur_packet) {$U''_1$}
+@d u2r==stack_2(ur_packet) {$U''_2$}
+@d u3r==stack_3(ur_packet) {$U''_3$}
+@d v1r==stack_1(vr_packet) {$V''_1$}
+@d v2r==stack_2(vr_packet) {$V''_2$}
+@d v3r==stack_3(vr_packet) {$V''_3$}
+@d x1r==stack_1(xr_packet) {$X''_1$}
+@d x2r==stack_2(xr_packet) {$X''_2$}
+@d x3r==stack_3(xr_packet) {$X''_3$}
+@d y1r==stack_1(yr_packet) {$Y''_1$}
+@d y2r==stack_2(yr_packet) {$Y''_2$}
+@d y3r==stack_3(yr_packet) {$Y''_3$}
+@#
+@d stack_dx==bisect_stack[bisect_ptr] {stacked value of |delx|}
+@d stack_dy==bisect_stack[bisect_ptr+1] {stacked value of |dely|}
+@d stack_tol==bisect_stack[bisect_ptr+2] {stacked value of |tol|}
+@d stack_uv==bisect_stack[bisect_ptr+3] {stacked value of |uv|}
+@d stack_xy==bisect_stack[bisect_ptr+4] {stacked value of |xy|}
+@d int_increment=int_packets+int_packets+5 {number of stack words per level}
+
+@<Check the ``constant''...@>=
+if int_packets+17*int_increment>bistack_size then bad:=32;
+
+@ Computation of the min and max is a tedious but fairly fast sequence of
+instructions; exactly four comparisons are made in each branch.
+
+@d set_min_max(#)==
+ if stack_1(#)<0 then
+ if stack_3(#)>=0 then
+ begin if stack_2(#)<0 then stack_min(#):=stack_1(#)+stack_2(#)
+ else stack_min(#):=stack_1(#);
+ stack_max(#):=stack_1(#)+stack_2(#)+stack_3(#);
+ if stack_max(#)<0 then stack_max(#):=0;
+ end
+ else begin stack_min(#):=stack_1(#)+stack_2(#)+stack_3(#);
+ if stack_min(#)>stack_1(#) then stack_min(#):=stack_1(#);
+ stack_max(#):=stack_1(#)+stack_2(#);
+ if stack_max(#)<0 then stack_max(#):=0;
+ end
+ else if stack_3(#)<=0 then
+ begin if stack_2(#)>0 then stack_max(#):=stack_1(#)+stack_2(#)
+ else stack_max(#):=stack_1(#);
+ stack_min(#):=stack_1(#)+stack_2(#)+stack_3(#);
+ if stack_min(#)>0 then stack_min(#):=0;
+ end
+ else begin stack_max(#):=stack_1(#)+stack_2(#)+stack_3(#);
+ if stack_max(#)<stack_1(#) then stack_max(#):=stack_1(#);
+ stack_min(#):=stack_1(#)+stack_2(#);
+ if stack_min(#)>0 then stack_min(#):=0;
+ end
+
+@ It's convenient to keep the current values of $l$, $t_1$, and $t_2$ in
+the integer form $2^l+2^lt_1$ and $2^l+2^lt_2$. The |cubic_intersection|
+routine uses global variables |cur_t| and |cur_tt| for this purpose;
+after successful completion, |cur_t| and |cur_tt| will contain |unity|
+plus the |scaled| values of $t_1$ and~$t_2$.
+
+The values of |cur_t| and |cur_tt| will be set to zero if |cubic_intersection|
+finds no intersection. The routine gives up and gives an approximate answer
+if it has backtracked
+more than 5000 times (otherwise there are cases where several minutes
+of fruitless computation would be possible).
+
+@d max_patience=5000
+
+@<Glob...@>=
+@!cur_t,@!cur_tt:integer; {controls and results of |cubic_intersection|}
+@!time_to_go:integer; {this many backtracks before giving up}
+@!max_t:integer; {maximum of $2^{l+1}$ so far achieved}
+
+@ The given cubics $B(w_0,w_1,w_2,w_3;t)$ and
+$B(z_0,z_1,z_2,z_3;t)$ are specified in adjacent knot nodes |(p,link(p))|
+and |(pp,link(pp))|, respectively.
+
+@p procedure cubic_intersection(@!p,@!pp:pointer);
+label continue, not_found, exit;
+var @!q,@!qq:pointer; {|link(p)|, |link(pp)|}
+begin time_to_go:=max_patience; max_t:=2;
+@<Initialize for intersections at level zero@>;
+loop@+ begin continue:
+ if delx-tol<=stack_max(x_packet(xy))-stack_min(u_packet(uv)) then
+ if delx+tol>=stack_min(x_packet(xy))-stack_max(u_packet(uv)) then
+ if dely-tol<=stack_max(y_packet(xy))-stack_min(v_packet(uv)) then
+ if dely+tol>=stack_min(y_packet(xy))-stack_max(v_packet(uv)) then
+ begin if cur_t>=max_t then
+ begin if max_t=two then {we've done 17 bisections}
+ begin cur_t:=half(cur_t+1); cur_tt:=half(cur_tt+1); return;
+ end;
+ double(max_t); appr_t:=cur_t; appr_tt:=cur_tt;
+ end;
+ @<Subdivide for a new level of intersection@>;
+ goto continue;
+ end;
+ if time_to_go>0 then decr(time_to_go)
+ else begin while appr_t<unity do
+ begin double(appr_t); double(appr_tt);
+ end;
+ cur_t:=appr_t; cur_tt:=appr_tt; return;
+ end;
+ @<Advance to the next pair |(cur_t,cur_tt)|@>;
+ end;
+exit:end;
+
+@ The following variables are global, although they are used only by
+|cubic_intersection|, because it is necessary on some machines to
+split |cubic_intersection| up into two procedures.
+
+@<Glob...@>=
+@!delx,@!dely:integer; {the components of $\Delta=2^l(w_0-z_0)$}
+@!tol:integer; {bound on the uncertainly in the overlap test}
+@!uv,@!xy:0..bistack_size; {pointers to the current packets of interest}
+@!three_l:integer; {|tol_step| times the bisection level}
+@!appr_t,@!appr_tt:integer; {best approximations known to the answers}
+
+@ We shall assume that the coordinates are sufficiently non-extreme that
+integer overflow will not occur.
+
+@<Initialize for intersections at level zero@>=
+q:=link(p); qq:=link(pp); bisect_ptr:=int_packets;@/
+u1r:=right_x(p)-x_coord(p); u2r:=left_x(q)-right_x(p);
+u3r:=x_coord(q)-left_x(q); set_min_max(ur_packet);@/
+v1r:=right_y(p)-y_coord(p); v2r:=left_y(q)-right_y(p);
+v3r:=y_coord(q)-left_y(q); set_min_max(vr_packet);@/
+x1r:=right_x(pp)-x_coord(pp); x2r:=left_x(qq)-right_x(pp);
+x3r:=x_coord(qq)-left_x(qq); set_min_max(xr_packet);@/
+y1r:=right_y(pp)-y_coord(pp); y2r:=left_y(qq)-right_y(pp);
+y3r:=y_coord(qq)-left_y(qq); set_min_max(yr_packet);@/
+delx:=x_coord(p)-x_coord(pp); dely:=y_coord(p)-y_coord(pp);@/
+tol:=0; uv:=r_packets; xy:=r_packets; three_l:=0; cur_t:=1; cur_tt:=1
+
+@ @<Subdivide for a new level of intersection@>=
+stack_dx:=delx; stack_dy:=dely; stack_tol:=tol; stack_uv:=uv; stack_xy:=xy;
+bisect_ptr:=bisect_ptr+int_increment;@/
+double(cur_t); double(cur_tt);@/
+u1l:=stack_1(u_packet(uv)); u3r:=stack_3(u_packet(uv));
+u2l:=half(u1l+stack_2(u_packet(uv)));
+u2r:=half(u3r+stack_2(u_packet(uv)));
+u3l:=half(u2l+u2r); u1r:=u3l;
+set_min_max(ul_packet); set_min_max(ur_packet);@/
+v1l:=stack_1(v_packet(uv)); v3r:=stack_3(v_packet(uv));
+v2l:=half(v1l+stack_2(v_packet(uv)));
+v2r:=half(v3r+stack_2(v_packet(uv)));
+v3l:=half(v2l+v2r); v1r:=v3l;
+set_min_max(vl_packet); set_min_max(vr_packet);@/
+x1l:=stack_1(x_packet(xy)); x3r:=stack_3(x_packet(xy));
+x2l:=half(x1l+stack_2(x_packet(xy)));
+x2r:=half(x3r+stack_2(x_packet(xy)));
+x3l:=half(x2l+x2r); x1r:=x3l;
+set_min_max(xl_packet); set_min_max(xr_packet);@/
+y1l:=stack_1(y_packet(xy)); y3r:=stack_3(y_packet(xy));
+y2l:=half(y1l+stack_2(y_packet(xy)));
+y2r:=half(y3r+stack_2(y_packet(xy)));
+y3l:=half(y2l+y2r); y1r:=y3l;
+set_min_max(yl_packet); set_min_max(yr_packet);@/
+uv:=l_packets; xy:=l_packets;
+double(delx); double(dely);@/
+tol:=tol-three_l+tol_step; double(tol); three_l:=three_l+tol_step
+
+@ @<Advance to the next pair |(cur_t,cur_tt)|@>=
+not_found: if odd(cur_tt) then
+ if odd(cur_t) then @<Descend to the previous level and |goto not_found|@>
+ else begin incr(cur_t);
+ delx:=delx+stack_1(u_packet(uv))+stack_2(u_packet(uv))
+ +stack_3(u_packet(uv));
+ dely:=dely+stack_1(v_packet(uv))+stack_2(v_packet(uv))
+ +stack_3(v_packet(uv));
+ uv:=uv+int_packets; {switch from |l_packet| to |r_packet|}
+ decr(cur_tt); xy:=xy-int_packets; {switch from |r_packet| to |l_packet|}
+ delx:=delx+stack_1(x_packet(xy))+stack_2(x_packet(xy))
+ +stack_3(x_packet(xy));
+ dely:=dely+stack_1(y_packet(xy))+stack_2(y_packet(xy))
+ +stack_3(y_packet(xy));
+ end
+else begin incr(cur_tt); tol:=tol+three_l;
+ delx:=delx-stack_1(x_packet(xy))-stack_2(x_packet(xy))
+ -stack_3(x_packet(xy));
+ dely:=dely-stack_1(y_packet(xy))-stack_2(y_packet(xy))
+ -stack_3(y_packet(xy));
+ xy:=xy+int_packets; {switch from |l_packet| to |r_packet|}
+ end
+
+@ @<Descend to the previous level...@>=
+begin cur_t:=half(cur_t); cur_tt:=half(cur_tt);
+if cur_t=0 then return;
+bisect_ptr:=bisect_ptr-int_increment; three_l:=three_l-tol_step;
+delx:=stack_dx; dely:=stack_dy; tol:=stack_tol; uv:=stack_uv; xy:=stack_xy;@/
+goto not_found;
+end
+
+@ The |path_intersection| procedure is much simpler.
+It invokes |cubic_intersection| in lexicographic order until finding a
+pair of cubics that intersect. The final intersection times are placed in
+|cur_t| and~|cur_tt|.
+
+@p procedure path_intersection(@!h,@!hh:pointer);
+label exit;
+var @!p,@!pp:pointer; {link registers that traverse the given paths}
+@!n,@!nn:integer; {integer parts of intersection times, minus |unity|}
+begin @<Change one-point paths into dead cycles@>;
+tol_step:=0;
+repeat n:=-unity; p:=h;
+ repeat if right_type(p)<>endpoint then
+ begin nn:=-unity; pp:=hh;
+ repeat if right_type(pp)<>endpoint then
+ begin cubic_intersection(p,pp);
+ if cur_t>0 then
+ begin cur_t:=cur_t+n; cur_tt:=cur_tt+nn; return;
+ end;
+ end;
+ nn:=nn+unity; pp:=link(pp);
+ until pp=hh;
+ end;
+ n:=n+unity; p:=link(p);
+ until p=h;
+tol_step:=tol_step+3;
+until tol_step>3;
+cur_t:=-unity; cur_tt:=-unity;
+exit:end;
+
+@ @<Change one-point paths...@>=
+if right_type(h)=endpoint then
+ begin right_x(h):=x_coord(h); left_x(h):=x_coord(h);
+ right_y(h):=y_coord(h); left_y(h):=y_coord(h); right_type(h):=explicit;
+ end;
+if right_type(hh)=endpoint then
+ begin right_x(hh):=x_coord(hh); left_x(hh):=x_coord(hh);
+ right_y(hh):=y_coord(hh); left_y(hh):=y_coord(hh); right_type(hh):=explicit;
+ end;
+
+@* \[27] Online graphic output.
+\MF\ displays images on the user's screen by means of a few primitive
+operations that are defined below. These operations have deliberately been
+kept simple so that they can be implemented without great difficulty on a
+wide variety of machines. Since \PASCAL\ has no traditional standards for
+graphic output, some system-dependent code needs to be written in order to
+support this aspect of \MF; but the necessary routines are usually quite
+easy to write.
+@^system dependencies@>
+
+In fact, there are exactly four such routines:
+
+\yskip\hang
+|init_screen| does whatever initialization is necessary to
+support the other operations; it is a boolean function that returns
+|false| if graphic output cannot be supported (e.g., if the other three
+routines have not been written, or if the user doesn't have the
+right kind of terminal).
+
+\yskip\hang
+|blank_rectangle| updates a buffer area in memory so that
+all pixels in a specified rectangle will be set to the background color.
+
+\yskip\hang
+|paint_row| assigns values to specified pixels in a row of
+the buffer just mentioned, based on ``transition'' indices explained below.
+
+\yskip\hang
+|update_screen| displays the current screen buffer; the
+effects of |blank_rectangle| and |paint_row| commands may or may not
+become visible until the next |update_screen| operation is performed.
+(Thus, |update_screen| is analogous to |update_terminal|.)
+
+\yskip\noindent
+The \PASCAL\ code here is a minimum version of |init_screen| and
+|update_screen|, usable on \MF\ installations that don't
+support screen output. If |init_screen| is changed to return |true|
+instead of |false|, the other routines will simply log the fact
+that they have been called; they won't really display anything.
+The standard test routines for \MF\ use this log information to check
+that \MF\ is working properly, but the |wlog| instructions should be
+removed from production versions of \MF.
+
+@p function init_screen:boolean;
+begin init_screen:=false;
+end;
+@#
+procedure update_screen; {will be called only if |init_screen| returns |true|}
+begin @!init wlog_ln('Calling UPDATESCREEN');@+tini {for testing only}
+end;
+
+@ The user's screen is assumed to be a rectangular area, |screen_width|
+pixels wide and |screen_depth| pixels deep. The pixel in the upper left
+corner is said to be in column~0 of row~0; the pixel in the lower right
+corner is said to be in column |screen_width-1| of row |screen_depth-1|.
+Notice that row numbers increase from top to bottom, contrary to \MF's
+other coordinates.
+
+Each pixel is assumed to have two states, referred to in this documentation
+as |black| and |white|. The background color is called |white| and the
+other color is called |black|; but any two distinct pixel values
+can actually be used. For example, the author developed \MF\ on a
+system for which |white| was black and |black| was bright green.
+
+@d white=0 {background pixels}
+@d black=1 {visible pixels}
+
+@<Types...@>=
+@!screen_row=0..screen_depth; {a row number on the screen}
+@!screen_col=0..screen_width; {a column number on the screen}
+@!trans_spec=array[screen_col] of screen_col; {a transition spec, see below}
+@!pixel_color=white..black; {specifies one of the two pixel values}
+
+@ We'll illustrate the |blank_rectangle| and |paint_row| operations by
+pretending to declare a screen buffer called |screen_pixel|. This code
+is actually commented out, but it does specify the intended effects.
+
+@<Glob...@>=
+@{@!screen_pixel:array[screen_row,screen_col] of pixel_color;@+@}
+
+@ The |blank_rectangle| routine simply whitens all pixels that lie in
+columns |left_col| through |right_col-1|, inclusive, of rows
+|top_row| through |bot_row-1|, inclusive, given four parameters that satisfy
+the relations
+$$\hbox{|0<=left_col<=right_col<=screen_width|,\quad
+ |0<=top_row<=bot_row<=screen_depth|.}$$
+If |left_col=right_col| or |top_row=bot_row|, nothing happens.
+
+The commented-out code in the following procedure is for illustrative
+purposes only.
+@^system dependencies@>
+
+@p procedure blank_rectangle(@!left_col,@!right_col:screen_col;
+ @!top_row,@!bot_row:screen_row);
+var @!r:screen_row;
+@!c:screen_col;
+begin @{@+for r:=top_row to bot_row-1 do
+ for c:=left_col to right_col-1 do
+ screen_pixel[r,c]:=white;@+@}@/
+@!init wlog_cr; {this will be done only after |init_screen=true|}
+wlog_ln('Calling BLANKRECTANGLE(',left_col:1,',',
+ right_col:1,',',top_row:1,',',bot_row:1,')');@+tini
+end;
+
+@ The real work of screen display is done by |paint_row|. But it's not
+hard work, because the operation affects only
+one of the screen rows, and it affects only a contiguous set of columns
+in that row. There are four parameters: |r|~(the row),
+|b|~(the initial color),
+|a|~(the array of transition specifications),
+and |n|~(the number of transitions). The elements of~|a| will satisfy
+$$0\L a[0]<a[1]<\cdots<a[n]\L |screen_width|;$$
+the value of |r| will satisfy |0<=r<screen_depth|; and |n| will be positive.
+
+The general idea is to paint blocks of pixels in alternate colors;
+the precise details are best conveyed by means of a \PASCAL\
+program (see the commented-out code below).
+@^system dependencies@>
+
+@p procedure paint_row(@!r:screen_row;@!b:pixel_color;var @!a:trans_spec;
+ @!n:screen_col);
+var @!k:screen_col; {an index into |a|}
+@!c:screen_col; {an index into |screen_pixel|}
+begin @{ k:=0; c:=a[0];
+repeat incr(k);
+ repeat screen_pixel[r,c]:=b; incr(c);
+ until c=a[k];
+ b:=black-b; {$|black|\swap|white|$}
+ until k=n;@+@}@/
+@!init wlog('Calling PAINTROW(',r:1,',',b:1,';');
+ {this is done only after |init_screen=true|}
+for k:=0 to n do
+ begin wlog(a[k]:1); if k<>n then wlog(',');
+ end;
+wlog_ln(')');@+tini
+end;
+
+@ The remainder of \MF's screen routines are system-independent calls
+on the four primitives just defined.
+
+First we have a global boolean variable that tells if |init_screen|
+has been called, and another one that tells if |init_screen| has
+given a |true| response.
+
+@<Glob...@>=
+@!screen_started:boolean; {have the screen primitives been initialized?}
+@!screen_OK:boolean; {is it legitimate to call |blank_rectangle|,
+ |paint_row|, and |update_screen|?}
+
+@ @d start_screen==begin if not screen_started then
+ begin screen_OK:=init_screen; screen_started:=true;
+ end;
+ end
+
+@<Set init...@>=
+screen_started:=false; screen_OK:=false;
+
+@ \MF\ provides the user with 16 ``window'' areas on the screen, in each
+of which it is possible to produce independent displays.
+
+It should be noted that \MF's windows aren't really independent
+``clickable'' entities in the sense of multi-window graphic workstations;
+\MF\ simply maps them into subsets of a single screen image that is
+controlled by |init_screen|, |blank_rectangle|, |paint_row|, and
+|update_screen| as described above. Implementations of \MF\ on a
+multi-window workstation probably therefore make use of only two
+windows in the other sense: one for the terminal output and another
+for the screen with \MF's 16 areas. Henceforth we shall
+use the term window only in \MF's sense.
+
+@<Types...@>=
+@!window_number=0..15;
+
+@ A user doesn't have to use any of the 16 windows. But when a window is
+``opened,'' it is allocated to a specific rectangular portion of the screen
+and to a specific rectangle with respect to \MF's coordinates. The relevant
+data is stored in global arrays |window_open|, |left_col|, |right_col|,
+|top_row|, |bot_row|, |m_window|, and |n_window|.
+
+The |window_open| array is boolean, and its significance is obvious. The
+|left_col|, \dots, |bot_row| arrays contain screen coordinates that
+can be used to blank the entire window with |blank_rectangle|. And the
+other two arrays just mentioned handle the conversion between
+actual coordinates and screen coordinates: \MF's pixel in column~$m$
+of row~$n$ will appear in screen column |m_window+m| and in screen row
+|n_window-n|, provided that these lie inside the boundaries of the window.
+
+Another array |window_time| holds the number of times this window has
+been updated.
+
+@<Glob...@>=
+@!window_open:array[window_number] of boolean;
+ {has this window been opened?}
+@!left_col:array[window_number] of screen_col;
+ {leftmost column position on screen}
+@!right_col:array[window_number] of screen_col;
+ {rightmost column position, plus~1}
+@!top_row:array[window_number] of screen_row;
+ {topmost row position on screen}
+@!bot_row:array[window_number] of screen_row;
+ {bottommost row position, plus~1}
+@!m_window:array[window_number] of integer;
+ {offset between user and screen columns}
+@!n_window:array[window_number] of integer;
+ {offset between user and screen rows}
+@!window_time:array[window_number] of integer;
+ {it has been updated this often}
+
+@ @<Set init...@>=
+for k:=0 to 15 do
+ begin window_open[k]:=false; window_time[k]:=0;
+ end;
+
+@ Opening a window isn't like opening a file, because you can open it
+as often as you like, and you never have to close it again. The idea is
+simply to define special points on the current screen display.
+
+Overlapping window specifications may cause complex effects that can
+be understood only by scrutinizing \MF's display algorithms; thus it
+has been left undefined in the \MF\ user manual, although the behavior
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+is in fact predictable.
+
+Here is a subroutine that implements the command `\&{openwindow}~|k|
+\&{from}~$(\\{r0},\\{c0})$ \&{to}~$(\\{r1},\\{c1})$ \&{at}~$(x,y)$'.
+
+@p procedure open_a_window(@!k:window_number;@!r0,@!c0,@!r1,@!c1:scaled;
+ @!x,@!y:scaled);
+var @!m,@!n:integer; {pixel coordinates}
+begin @<Adjust the coordinates |(r0,c0)| and |(r1,c1)| so that
+ they lie in the proper range@>;
+window_open[k]:=true; incr(window_time[k]);@/
+left_col[k]:=c0; right_col[k]:=c1; top_row[k]:=r0; bot_row[k]:=r1;@/
+@<Compute the offsets between screen coordinates and actual coordinates@>;
+start_screen;
+if screen_OK then
+ begin blank_rectangle(c0,c1,r0,r1); update_screen;
+ end;
+end;
+
+@ A window whose coordinates don't fit the existing screen size will be
+truncated until they do.
+
+@<Adjust the coordinates |(r0,c0)| and |(r1,c1)|...@>=
+if r0<0 then r0:=0@+else r0:=round_unscaled(r0);
+r1:=round_unscaled(r1);
+if r1>screen_depth then r1:=screen_depth;
+if r1<r0 then
+ if r0>screen_depth then r0:=r1@+else r1:=r0;
+if c0<0 then c0:=0@+else c0:=round_unscaled(c0);
+c1:=round_unscaled(c1);
+if c1>screen_width then c1:=screen_width;
+if c1<c0 then
+ if c0>screen_width then c0:=c1@+else c1:=c0
+
+@ Three sets of coordinates are rampant, and they must be kept straight!
+(i)~\MF's main coordinates refer to the edges between pixels. (ii)~\MF's
+pixel coordinates (within edge structures) say that the pixel bounded by
+$(m,n)$, $(m,n+1)$, $(m+1,n)$, and~$(m+1,n+1)$ is in pixel row number~$n$
+and pixel column number~$m$. (iii)~Screen coordinates, on the other hand,
+have rows numbered in increasing order from top to bottom, as mentioned
+above.
+@^coordinates, explained@>
+
+The program here first computes integers $m$ and $n$ such that
+pixel column~$m$ of pixel row~$n$ will be at the upper left corner
+of the window. Hence pixel column |m-c0| of pixel row |n+r0|
+will be at the upper left corner of the screen.
+
+@<Compute the offsets between screen coordinates and actual coordinates@>=
+m:=round_unscaled(x); n:=round_unscaled(y)-1;@/
+m_window[k]:=c0-m; n_window[k]:=r0+n
+
+@ Now here comes \MF's most complicated operation related to window
+display: Given the number~|k| of an open window, the pixels of positive
+weight in |cur_edges| will be shown as |black| in the window; all other
+pixels will be shown as |white|.
+
+@p procedure disp_edges(@!k:window_number);
+label done,found;
+var @!p,@!q:pointer; {for list manipulation}
+@!already_there:boolean; {is a previous incarnation in the window?}
+@!r:integer; {row number}
+@<Other local variables for |disp_edges|@>@;
+begin if screen_OK then
+ if left_col[k]<right_col[k] then if top_row[k]<bot_row[k] then
+ begin already_there:=false;
+ if last_window(cur_edges)=k then
+ if last_window_time(cur_edges)=window_time[k] then
+ already_there:=true;
+ if not already_there then
+ blank_rectangle(left_col[k],right_col[k],top_row[k],bot_row[k]);
+ @<Initialize for the display computations@>;
+ p:=link(cur_edges); r:=n_window[k]-(n_min(cur_edges)-zero_field);
+ while (p<>cur_edges)and(r>=top_row[k]) do
+ begin if r<bot_row[k] then
+ @<Display the pixels of edge row |p| in screen row |r|@>;
+ p:=link(p); decr(r);
+ end;
+ update_screen;
+ incr(window_time[k]);
+ last_window(cur_edges):=k; last_window_time(cur_edges):=window_time[k];
+ end;
+end;
+
+@ Since it takes some work to display a row, we try to avoid recomputation
+whenever we can.
+
+@<Display the pixels of edge row |p| in screen row |r|@>=
+begin if unsorted(p)>void then sort_edges(p)
+else if unsorted(p)=void then if already_there then goto done;
+unsorted(p):=void; {this time we'll paint, but maybe not next time}
+@<Set up the parameters needed for |paint_row|;
+ but |goto done| if no painting is needed after all@>;
+paint_row(r,b,row_transition,n);
+done: end
+
+@ The transition-specification parameter to |paint_row| is always the same
+array.
+
+@<Glob...@>=
+@!row_transition:trans_spec; {an array of |black|/|white| transitions}
+
+@ The job remaining is to go through the list |sorted(p)|, unpacking the
+|info| fields into |m| and weight, then making |black| the pixels whose
+accumulated weight~|w| is positive.
+
+@<Other local variables for |disp_edges|@>=
+@!n:screen_col; {the highest active index in |row_transition|}
+@!w,@!ww:integer; {old and new accumulated weights}
+@!b:pixel_color; {status of first pixel in the row transitions}
+@!m,@!mm:integer; {old and new screen column positions}
+@!d:integer; {edge-and-weight without |min_halfword| compensation}
+@!m_adjustment:integer; {conversion between edge and screen coordinates}
+@!right_edge:integer; {largest edge-and-weight that could affect the window}
+@!min_col:screen_col; {the smallest screen column number in the window}
+
+@ Some precomputed constants make the display calculations faster.
+
+@<Initialize for the display computations@>=
+m_adjustment:=m_window[k]-m_offset(cur_edges);@/
+right_edge:=8*(right_col[k]-m_adjustment);@/
+min_col:=left_col[k]
+
+@ @<Set up the parameters needed for |paint_row|...@>=
+n:=0; ww:=0; m:=-1; w:=0;
+q:=sorted(p); row_transition[0]:=min_col;
+loop@+ begin if q=sentinel then d:=right_edge
+ else d:=ho(info(q));
+ mm:=(d div 8)+m_adjustment;
+ if mm<>m then
+ begin @<Record a possible transition in column |m|@>;
+ m:=mm; w:=ww;
+ end;
+ if d>=right_edge then goto found;
+ ww:=ww+(d mod 8)-zero_w;
+ q:=link(q);
+ end;
+found:@<Wind up the |paint_row| parameter calculation by inserting the
+ final transition; |goto done| if no painting is needed@>;
+
+@ Now |m| is a screen column |<right_col[k]|.
+
+@<Record a possible transition in column |m|@>=
+if w<=0 then
+ begin if ww>0 then if m>min_col then
+ begin if n=0 then
+ if already_there then
+ begin b:=white; incr(n);
+ end
+ else b:=black
+ else incr(n);
+ row_transition[n]:=m;
+ end;
+ end
+else if ww<=0 then if m>min_col then
+ begin if n=0 then b:=black;
+ incr(n); row_transition[n]:=m;
+ end
+
+@ If the entire row is |white| in the window area, we can omit painting it
+when |already_there| is false, since it has already been blanked out in
+that case.
+
+When the following code is invoked, |row_transition[n]| will be
+strictly less than |right_col[k]|.
+
+@<Wind up the |paint_row|...@>=
+if already_there or(ww>0) then
+ begin if n=0 then
+ if ww>0 then b:=black
+ else b:=white;
+ incr(n); row_transition[n]:=right_col[k];
+ end
+else if n=0 then goto done
+
+@* \[28] Dynamic linear equations.
+\MF\ users define variables implicitly by stating equations that should be
+satisfied; the computer is supposed to be smart enough to solve those equations.
+And indeed, the computer tries valiantly to do so, by distinguishing five
+different types of numeric values:
+
+\smallskip\hang
+|type(p)=known| is the nice case, when |value(p)| is the |scaled| value
+of the variable whose address is~|p|.
+
+\smallskip\hang
+|type(p)=dependent| means that |value(p)| is not present, but |dep_list(p)|
+points to a {\sl dependency list\/} that expresses the value of variable~|p|
+as a |scaled| number plus a sum of independent variables with |fraction|
+coefficients.
+
+\smallskip\hang
+|type(p)=independent| means that |value(p)=64s+m|, where |s>0| is a ``serial
+number'' reflecting the time this variable was first used in an equation;
+also |0<=m<64|, and each dependent variable
+that refers to this one is actually referring to the future value of
+this variable times~$2^m$. (Usually |m=0|, but higher degrees of
+scaling are sometimes needed to keep the coefficients in dependency lists
+from getting too large. The value of~|m| will always be even.)
+
+\smallskip\hang
+|type(p)=numeric_type| means that variable |p| hasn't appeared in an
+equation before, but it has been explicitly declared to be numeric.
+
+\smallskip\hang
+|type(p)=undefined| means that variable |p| hasn't appeared before.
+
+\smallskip\noindent
+We have actually discussed these five types in the reverse order of their
+history during a computation: Once |known|, a variable never again
+becomes |dependent|; once |dependent|, it almost never again becomes
+|independent|; once |independent|, it never again becomes |numeric_type|;
+and once |numeric_type|, it never again becomes |undefined| (except
+of course when the user specifically decides to scrap the old value
+and start again). A backward step may, however, take place: Sometimes
+a |dependent| variable becomes |independent| again, when one of the
+independent variables it depends on is reverting to |undefined|.
+
+@d s_scale=64 {the serial numbers are multiplied by this factor}
+@d new_indep(#)== {create a new independent variable}
+ begin type(#):=independent; serial_no:=serial_no+s_scale;
+ value(#):=serial_no;
+ end
+
+@<Glob...@>=
+@!serial_no:integer; {the most recent serial number, times |s_scale|}
+
+@ @<Make variable |q+s| newly independent@>=new_indep(q+s)
+
+@ But how are dependency lists represented? It's simple: The linear combination
+$\alpha_1v_1+\cdots+\alpha_kv_k+\beta$ appears in |k+1| value nodes. If
+|q=dep_list(p)| points to this list, and if |k>0|, then |value(q)=
+@t$\alpha_1$@>| (which is a |fraction|); |info(q)| points to the location
+of $v_1$; and |link(p)| points to the dependency list
+$\alpha_2v_2+\cdots+\alpha_kv_k+\beta$. On the other hand if |k=0|,
+then |value(q)=@t$\beta$@>| (which is |scaled|) and |info(q)=null|.
+The independent variables $v_1$, \dots,~$v_k$ have been sorted so that
+they appear in decreasing order of their |value| fields (i.e., of
+their serial numbers). \ (It is convenient to use decreasing order,
+since |value(null)=0|. If the independent variables were not sorted by
+serial number but by some other criterion, such as their location in |mem|,
+the equation-solving mechanism would be too system-dependent, because
+the ordering can affect the computed results.)
+
+The |link| field in the node that contains the constant term $\beta$ is
+called the {\sl final link\/} of the dependency list. \MF\ maintains
+a doubly-linked master list of all dependency lists, in terms of a permanently
+allocated node
+in |mem| called |dep_head|. If there are no dependencies, we have
+|link(dep_head)=dep_head| and |prev_dep(dep_head)=dep_head|;
+otherwise |link(dep_head)| points to the first dependent variable, say~|p|,
+and |prev_dep(p)=dep_head|. We have |type(p)=dependent|, and |dep_list(p)|
+points to its dependency list. If the final link of that dependency list
+occurs in location~|q|, then |link(q)| points to the next dependent
+variable (say~|r|); and we have |prev_dep(r)=q|, etc.
+
+@d dep_list(#)==link(value_loc(#))
+ {half of the |value| field in a |dependent| variable}
+@d prev_dep(#)==info(value_loc(#))
+ {the other half; makes a doubly linked list}
+@d dep_node_size=2 {the number of words per dependency node}
+
+@<Initialize table entries...@>= serial_no:=0;
+link(dep_head):=dep_head; prev_dep(dep_head):=dep_head;
+info(dep_head):=null; dep_list(dep_head):=null;
+
+@ Actually the description above contains a little white lie. There's
+another kind of variable called |proto_dependent|, which is
+just like a |dependent| one except that the $\alpha$ coefficients
+in its dependency list are |scaled| instead of being fractions.
+Proto-dependency lists are mixed with dependency lists in the
+nodes reachable from |dep_head|.
+
+@ Here is a procedure that prints a dependency list in symbolic form.
+The second parameter should be either |dependent| or |proto_dependent|,
+to indicate the scaling of the coefficients.
+
+@<Declare subroutines for printing expressions@>=
+procedure print_dependency(@!p:pointer;@!t:small_number);
+label exit;
+var @!v:integer; {a coefficient}
+@!pp,@!q:pointer; {for list manipulation}
+begin pp:=p;
+loop@+ begin v:=abs(value(p)); q:=info(p);
+ if q=null then {the constant term}
+ begin if (v<>0)or(p=pp) then
+ begin if value(p)>0 then if p<>pp then print_char("+");
+ print_scaled(value(p));
+ end;
+ return;
+ end;
+ @<Print the coefficient, unless it's $\pm1.0$@>;
+ if type(q)<>independent then confusion("dep");
+@:this can't happen dep}{\quad dep@>
+ print_variable_name(q); v:=value(q) mod s_scale;
+ while v>0 do
+ begin print("*4"); v:=v-2;
+ end;
+ p:=link(p);
+ end;
+exit:end;
+
+@ @<Print the coefficient, unless it's $\pm1.0$@>=
+if value(p)<0 then print_char("-")
+else if p<>pp then print_char("+");
+if t=dependent then v:=round_fraction(v);
+if v<>unity then print_scaled(v)
+
+@ The maximum absolute value of a coefficient in a given dependency list
+is returned by the following simple function.
+
+@p function max_coef(@!p:pointer):fraction;
+var @!x:fraction; {the maximum so far}
+begin x:=0;
+while info(p)<>null do
+ begin if abs(value(p))>x then x:=abs(value(p));
+ p:=link(p);
+ end;
+max_coef:=x;
+end;
+
+@ One of the main operations needed on dependency lists is to add a multiple
+of one list to the other; we call this |p_plus_fq|, where |p| and~|q| point
+to dependency lists and |f| is a fraction.
+
+If the coefficient of any independent variable becomes |coef_bound| or
+more, in absolute value, this procedure changes the type of that variable
+to `|independent_needing_fix|', and sets the global variable |fix_needed|
+to~|true|. The value of $|coef_bound|=\mu$ is chosen so that
+$\mu^2+\mu<8$; this means that the numbers we deal with won't
+get too large. (Instead of the ``optimum'' $\mu=(\sqrt{33}-1)/2\approx
+2.3723$, the safer value 7/3 is taken as the threshold.)
+
+The changes mentioned in the preceding paragraph are actually done only if
+the global variable |watch_coefs| is |true|. But it usually is; in fact,
+it is |false| only when \MF\ is making a dependency list that will soon
+be equated to zero.
+
+Several procedures that act on dependency lists, including |p_plus_fq|,
+set the global variable |dep_final| to the final (constant term) node of
+the dependency list that they produce.
+
+@d coef_bound==@'4525252525 {|fraction| approximation to 7/3}
+@d independent_needing_fix=0
+
+@<Glob...@>=
+@!fix_needed:boolean; {does at least one |independent| variable need scaling?}
+@!watch_coefs:boolean; {should we scale coefficients that exceed |coef_bound|?}
+@!dep_final:pointer; {location of the constant term and final link}
+
+@ @<Set init...@>=
+fix_needed:=false; watch_coefs:=true;
+
+@ The |p_plus_fq| procedure has a fourth parameter, |t|, that should be
+set to |proto_dependent| if |p| is a proto-dependency list. In this
+case |f| will be |scaled|, not a |fraction|. Similarly, the fifth parameter~|tt|
+should be |proto_dependent| if |q| is a proto-dependency list.
+
+List |q| is unchanged by the operation; but list |p| is totally destroyed.
+
+The final link of the dependency list or proto-dependency list returned
+by |p_plus_fq| is the same as the original final link of~|p|. Indeed, the
+constant term of the result will be located in the same |mem| location
+as the original constant term of~|p|.
+
+Coefficients of the result are assumed to be zero if they are less than
+a certain threshold. This compensates for inevitable rounding errors,
+and tends to make more variables `|known|'. The threshold is approximately
+$10^{-5}$ in the case of normal dependency lists, $10^{-4}$ for
+proto-dependencies.
+
+@d fraction_threshold=2685 {a |fraction| coefficient less than this is zeroed}
+@d half_fraction_threshold=1342 {half of |fraction_threshold|}
+@d scaled_threshold=8 {a |scaled| coefficient less than this is zeroed}
+@d half_scaled_threshold=4 {half of |scaled_threshold|}
+
+@<Declare basic dependency-list subroutines@>=
+function p_plus_fq(@!p:pointer;@!f:integer;@!q:pointer;
+ @!t,@!tt:small_number):pointer;
+label done;
+var @!pp,@!qq:pointer; {|info(p)| and |info(q)|, respectively}
+@!r,@!s:pointer; {for list manipulation}
+@!threshold:integer; {defines a neighborhood of zero}
+@!v:integer; {temporary register}
+begin if t=dependent then threshold:=fraction_threshold
+else threshold:=scaled_threshold;
+r:=temp_head; pp:=info(p); qq:=info(q);
+loop@+ if pp=qq then
+ if pp=null then goto done
+ else @<Contribute a term from |p|, plus |f| times the
+ corresponding term from |q|@>
+ else if value(pp)<value(qq) then
+ @<Contribute a term from |q|, multiplied by~|f|@>
+ else begin link(r):=p; r:=p; p:=link(p); pp:=info(p);
+ end;
+done: if t=dependent then
+ value(p):=slow_add(value(p),take_fraction(value(q),f))
+else value(p):=slow_add(value(p),take_scaled(value(q),f));
+link(r):=p; dep_final:=p; p_plus_fq:=link(temp_head);
+end;
+
+@ @<Contribute a term from |p|, plus |f|...@>=
+begin if tt=dependent then v:=value(p)+take_fraction(f,value(q))
+else v:=value(p)+take_scaled(f,value(q));
+value(p):=v; s:=p; p:=link(p);
+if abs(v)<threshold then free_node(s,dep_node_size)
+else begin if abs(v)>=coef_bound then if watch_coefs then
+ begin type(qq):=independent_needing_fix; fix_needed:=true;
+ end;
+ link(r):=s; r:=s;
+ end;
+pp:=info(p); q:=link(q); qq:=info(q);
+end
+
+@ @<Contribute a term from |q|, multiplied by~|f|@>=
+begin if tt=dependent then v:=take_fraction(f,value(q))
+else v:=take_scaled(f,value(q));
+if abs(v)>half(threshold) then
+ begin s:=get_node(dep_node_size); info(s):=qq; value(s):=v;
+ if abs(v)>=coef_bound then if watch_coefs then
+ begin type(qq):=independent_needing_fix; fix_needed:=true;
+ end;
+ link(r):=s; r:=s;
+ end;
+q:=link(q); qq:=info(q);
+end
+
+@ It is convenient to have another subroutine for the special case
+of |p_plus_fq| when |f=1.0|. In this routine lists |p| and |q| are
+both of the same type~|t| (either |dependent| or |proto_dependent|).
+
+@p function p_plus_q(@!p:pointer;@!q:pointer;@!t:small_number):pointer;
+label done;
+var @!pp,@!qq:pointer; {|info(p)| and |info(q)|, respectively}
+@!r,@!s:pointer; {for list manipulation}
+@!threshold:integer; {defines a neighborhood of zero}
+@!v:integer; {temporary register}
+begin if t=dependent then threshold:=fraction_threshold
+else threshold:=scaled_threshold;
+r:=temp_head; pp:=info(p); qq:=info(q);
+loop@+ if pp=qq then
+ if pp=null then goto done
+ else @<Contribute a term from |p|, plus the
+ corresponding term from |q|@>
+ else if value(pp)<value(qq) then
+ begin s:=get_node(dep_node_size); info(s):=qq; value(s):=value(q);
+ q:=link(q); qq:=info(q); link(r):=s; r:=s;
+ end
+ else begin link(r):=p; r:=p; p:=link(p); pp:=info(p);
+ end;
+done: value(p):=slow_add(value(p),value(q));
+link(r):=p; dep_final:=p; p_plus_q:=link(temp_head);
+end;
+
+@ @<Contribute a term from |p|, plus the...@>=
+begin v:=value(p)+value(q);
+value(p):=v; s:=p; p:=link(p); pp:=info(p);
+if abs(v)<threshold then free_node(s,dep_node_size)
+else begin if abs(v)>=coef_bound then if watch_coefs then
+ begin type(qq):=independent_needing_fix; fix_needed:=true;
+ end;
+ link(r):=s; r:=s;
+ end;
+q:=link(q); qq:=info(q);
+end
+
+@ A somewhat simpler routine will multiply a dependency list
+by a given constant~|v|. The constant is either a |fraction| less than
+|fraction_one|, or it is |scaled|. In the latter case we might be forced to
+convert a dependency list to a proto-dependency list.
+Parameters |t0| and |t1| are the list types before and after;
+they should agree unless |t0=dependent| and |t1=proto_dependent|
+and |v_is_scaled=true|.
+
+@p function p_times_v(@!p:pointer;@!v:integer;
+ @!t0,@!t1:small_number;@!v_is_scaled:boolean):pointer;
+var @!r,@!s:pointer; {for list manipulation}
+@!w:integer; {tentative coefficient}
+@!threshold:integer;
+@!scaling_down:boolean;
+begin if t0<>t1 then scaling_down:=true@+else scaling_down:=not v_is_scaled;
+if t1=dependent then threshold:=half_fraction_threshold
+else threshold:=half_scaled_threshold;
+r:=temp_head;
+while info(p)<>null do
+ begin if scaling_down then w:=take_fraction(v,value(p))
+ else w:=take_scaled(v,value(p));
+ if abs(w)<=threshold then
+ begin s:=link(p); free_node(p,dep_node_size); p:=s;
+ end
+ else begin if abs(w)>=coef_bound then
+ begin fix_needed:=true; type(info(p)):=independent_needing_fix;
+ end;
+ link(r):=p; r:=p; value(p):=w; p:=link(p);
+ end;
+ end;
+link(r):=p;
+if v_is_scaled then value(p):=take_scaled(value(p),v)
+else value(p):=take_fraction(value(p),v);
+p_times_v:=link(temp_head);
+end;
+
+@ Similarly, we sometimes need to divide a dependency list
+by a given |scaled| constant.
+
+@<Declare basic dependency-list subroutines@>=
+function p_over_v(@!p:pointer;@!v:scaled;
+ @!t0,@!t1:small_number):pointer;
+var @!r,@!s:pointer; {for list manipulation}
+@!w:integer; {tentative coefficient}
+@!threshold:integer;
+@!scaling_down:boolean;
+begin if t0<>t1 then scaling_down:=true@+else scaling_down:=false;
+if t1=dependent then threshold:=half_fraction_threshold
+else threshold:=half_scaled_threshold;
+r:=temp_head;
+while info(p)<>null do
+ begin if scaling_down then
+ if abs(v)<@'2000000 then w:=make_scaled(value(p),v*@'10000)
+ else w:=make_scaled(round_fraction(value(p)),v)
+ else w:=make_scaled(value(p),v);
+ if abs(w)<=threshold then
+ begin s:=link(p); free_node(p,dep_node_size); p:=s;
+ end
+ else begin if abs(w)>=coef_bound then
+ begin fix_needed:=true; type(info(p)):=independent_needing_fix;
+ end;
+ link(r):=p; r:=p; value(p):=w; p:=link(p);
+ end;
+ end;
+link(r):=p; value(p):=make_scaled(value(p),v);
+p_over_v:=link(temp_head);
+end;
+
+@ Here's another utility routine for dependency lists. When an independent
+variable becomes dependent, we want to remove it from all existing
+dependencies. The |p_with_x_becoming_q| function computes the
+dependency list of~|p| after variable~|x| has been replaced by~|q|.
+
+This procedure has basically the same calling conventions as |p_plus_fq|:
+List~|q| is unchanged; list~|p| is destroyed; the constant node and the
+final link are inherited from~|p|; and the fourth parameter tells whether
+or not |p| is |proto_dependent|. However, the global variable |dep_final|
+is not altered if |x| does not occur in list~|p|.
+
+@p function p_with_x_becoming_q(@!p,@!x,@!q:pointer;@!t:small_number):pointer;
+var @!r,@!s:pointer; {for list manipulation}
+@!v:integer; {coefficient of |x|}
+@!sx:integer; {serial number of |x|}
+begin s:=p; r:=temp_head; sx:=value(x);
+while value(info(s))>sx do
+ begin r:=s; s:=link(s);
+ end;
+if info(s)<>x then p_with_x_becoming_q:=p
+else begin link(temp_head):=p; link(r):=link(s); v:=value(s);
+ free_node(s,dep_node_size);
+ p_with_x_becoming_q:=p_plus_fq(link(temp_head),v,q,t,dependent);
+ end;
+end;
+
+@ Here's a simple procedure that reports an error when a variable
+has just received a known value that's out of the required range.
+
+@<Declare basic dependency-list subroutines@>=
+procedure val_too_big(@!x:scaled);
+begin if internal[warning_check]>0 then
+ begin print_err("Value is too large ("); print_scaled(x); print_char(")");
+@.Value is too large@>
+ help4("The equation I just processed has given some variable")@/
+ ("a value of 4096 or more. Continue and I'll try to cope")@/
+ ("with that big value; but it might be dangerous.")@/
+ ("(Set warningcheck:=0 to suppress this message.)");
+ error;
+ end;
+end;
+
+@ When a dependent variable becomes known, the following routine
+removes its dependency list. Here |p| points to the variable, and
+|q| points to the dependency list (which is one node long).
+
+@<Declare basic dependency-list subroutines@>=
+procedure make_known(@!p,@!q:pointer);
+var @!t:dependent..proto_dependent; {the previous type}
+begin prev_dep(link(q)):=prev_dep(p);
+link(prev_dep(p)):=link(q); t:=type(p);
+type(p):=known; value(p):=value(q); free_node(q,dep_node_size);
+if abs(value(p))>=fraction_one then val_too_big(value(p));
+if internal[tracing_equations]>0 then if interesting(p) then
+ begin begin_diagnostic; print_nl("#### ");
+@:]]]\#\#\#\#_}{\.{\#\#\#\#}@>
+ print_variable_name(p); print_char("="); print_scaled(value(p));
+ end_diagnostic(false);
+ end;
+if cur_exp=p then if cur_type=t then
+ begin cur_type:=known; cur_exp:=value(p);
+ free_node(p,value_node_size);
+ end;
+end;
+
+@ The |fix_dependencies| routine is called into action when |fix_needed|
+has been triggered. The program keeps a list~|s| of independent variables
+whose coefficients must be divided by~4.
+
+In unusual cases, this fixup process might reduce one or more coefficients
+to zero, so that a variable will become known more or less by default.
+
+@<Declare basic dependency-list subroutines@>=
+procedure fix_dependencies;
+label done;
+var @!p,@!q,@!r,@!s,@!t:pointer; {list manipulation registers}
+@!x:pointer; {an independent variable}
+begin r:=link(dep_head); s:=null;
+while r<>dep_head do
+ begin t:=r;
+ @<Run through the dependency list for variable |t|, fixing
+ all nodes, and ending with final link~|q|@>;
+ r:=link(q);
+ if q=dep_list(t) then make_known(t,q);
+ end;
+while s<>null do
+ begin p:=link(s); x:=info(s); free_avail(s); s:=p;
+ type(x):=independent; value(x):=value(x)+2;
+ end;
+fix_needed:=false;
+end;
+
+@ @d independent_being_fixed=1 {this variable already appears in |s|}
+
+@<Run through the dependency list for variable |t|...@>=
+r:=value_loc(t); {|link(r)=dep_list(t)|}
+loop@+ begin q:=link(r); x:=info(q);
+ if x=null then goto done;
+ if type(x)<=independent_being_fixed then
+ begin if type(x)<independent_being_fixed then
+ begin p:=get_avail; link(p):=s; s:=p;
+ info(s):=x; type(x):=independent_being_fixed;
+ end;
+ value(q):=value(q) div 4;
+ if value(q)=0 then
+ begin link(r):=link(q); free_node(q,dep_node_size); q:=r;
+ end;
+ end;
+ r:=q;
+ end;
+done:
+
+@ The |new_dep| routine installs a dependency list~|p| into the value node~|q|,
+linking it into the list of all known dependencies. We assume that
+|dep_final| points to the final node of list~|p|.
+
+@p procedure new_dep(@!q,@!p:pointer);
+var @!r:pointer; {what used to be the first dependency}
+begin dep_list(q):=p; prev_dep(q):=dep_head;
+r:=link(dep_head); link(dep_final):=r; prev_dep(r):=dep_final;
+link(dep_head):=q;
+end;
+
+@ Here is one of the ways a dependency list gets started.
+The |const_dependency| routine produces a list that has nothing but
+a constant term.
+
+@p function const_dependency(@!v:scaled):pointer;
+begin dep_final:=get_node(dep_node_size);
+value(dep_final):=v; info(dep_final):=null;
+const_dependency:=dep_final;
+end;
+
+@ And here's a more interesting way to start a dependency list from scratch:
+The parameter to |single_dependency| is the location of an
+independent variable~|x|, and the result is the simple dependency list
+`|x+0|'.
+
+In the unlikely event that the given independent variable has been doubled so
+often that we can't refer to it with a nonzero coefficient,
+|single_dependency| returns the simple list `0'. This case can be
+recognized by testing that the returned list pointer is equal to
+|dep_final|.
+
+@p function single_dependency(@!p:pointer):pointer;
+var @!q:pointer; {the new dependency list}
+@!m:integer; {the number of doublings}
+begin m:=value(p) mod s_scale;
+if m>28 then single_dependency:=const_dependency(0)
+else begin q:=get_node(dep_node_size);
+ value(q):=two_to_the[28-m]; info(q):=p;@/
+ link(q):=const_dependency(0); single_dependency:=q;
+ end;
+end;
+
+@ We sometimes need to make an exact copy of a dependency list.
+
+@p function copy_dep_list(@!p:pointer):pointer;
+label done;
+var @!q:pointer; {the new dependency list}
+begin q:=get_node(dep_node_size); dep_final:=q;
+loop@+ begin info(dep_final):=info(p); value(dep_final):=value(p);
+ if info(dep_final)=null then goto done;
+ link(dep_final):=get_node(dep_node_size);
+ dep_final:=link(dep_final); p:=link(p);
+ end;
+done:copy_dep_list:=q;
+end;
+
+@ But how do variables normally become known? Ah, now we get to the heart of the
+equation-solving mechanism. The |linear_eq| procedure is given a |dependent|
+or |proto_dependent| list,~|p|, in which at least one independent variable
+appears. It equates this list to zero, by choosing an independent variable
+with the largest coefficient and making it dependent on the others. The
+newly dependent variable is eliminated from all current dependencies,
+thereby possibly making other dependent variables known.
+
+The given list |p| is, of course, totally destroyed by all this processing.
+
+@p procedure linear_eq(@!p:pointer;@!t:small_number);
+var @!q,@!r,@!s:pointer; {for link manipulation}
+@!x:pointer; {the variable that loses its independence}
+@!n:integer; {the number of times |x| had been halved}
+@!v:integer; {the coefficient of |x| in list |p|}
+@!prev_r:pointer; {lags one step behind |r|}
+@!final_node:pointer; {the constant term of the new dependency list}
+@!w:integer; {a tentative coefficient}
+begin @<Find a node |q| in list |p| whose coefficient |v| is largest@>;
+x:=info(q); n:=value(x) mod s_scale;@/
+@<Divide list |p| by |-v|, removing node |q|@>;
+if internal[tracing_equations]>0 then @<Display the new dependency@>;
+@<Simplify all existing dependencies by substituting for |x|@>;
+@<Change variable |x| from |independent| to |dependent| or |known|@>;
+if fix_needed then fix_dependencies;
+end;
+
+@ @<Find a node |q| in list |p| whose coefficient |v| is largest@>=
+q:=p; r:=link(p); v:=value(q);
+while info(r)<>null do
+ begin if abs(value(r))>abs(v) then
+ begin q:=r; v:=value(r);
+ end;
+ r:=link(r);
+ end
+
+@ Here we want to change the coefficients from |scaled| to |fraction|,
+except in the constant term. In the common case of a trivial equation
+like `\.{x=3.14}', we will have |v=-fraction_one|, |q=p|, and |t=dependent|.
+
+@<Divide list |p| by |-v|, removing node |q|@>=
+s:=temp_head; link(s):=p; r:=p;
+repeat if r=q then
+ begin link(s):=link(r); free_node(r,dep_node_size);
+ end
+else begin w:=make_fraction(value(r),v);
+ if abs(w)<=half_fraction_threshold then
+ begin link(s):=link(r); free_node(r,dep_node_size);
+ end
+ else begin value(r):=-w; s:=r;
+ end;
+ end;
+r:=link(s);
+until info(r)=null;
+if t=proto_dependent then value(r):=-make_scaled(value(r),v)
+else if v<>-fraction_one then value(r):=-make_fraction(value(r),v);
+final_node:=r; p:=link(temp_head)
+
+@ @<Display the new dependency@>=
+if interesting(x) then
+ begin begin_diagnostic; print_nl("## "); print_variable_name(x);
+@:]]]\#\#_}{\.{\#\#}@>
+ w:=n;
+ while w>0 do
+ begin print("*4"); w:=w-2;
+ end;
+ print_char("="); print_dependency(p,dependent); end_diagnostic(false);
+ end
+
+@ @<Simplify all existing dependencies by substituting for |x|@>=
+prev_r:=dep_head; r:=link(dep_head);
+while r<>dep_head do
+ begin s:=dep_list(r); q:=p_with_x_becoming_q(s,x,p,type(r));
+ if info(q)=null then make_known(r,q)
+ else begin dep_list(r):=q;
+ repeat q:=link(q);
+ until info(q)=null;
+ prev_r:=q;
+ end;
+ r:=link(prev_r);
+ end
+
+@ @<Change variable |x| from |independent| to |dependent| or |known|@>=
+if n>0 then @<Divide list |p| by $2^n$@>;
+if info(p)=null then
+ begin type(x):=known;
+ value(x):=value(p);
+ if abs(value(x))>=fraction_one then val_too_big(value(x));
+ free_node(p,dep_node_size);
+ if cur_exp=x then if cur_type=independent then
+ begin cur_exp:=value(x); cur_type:=known;
+ free_node(x,value_node_size);
+ end;
+ end
+else begin type(x):=dependent; dep_final:=final_node; new_dep(x,p);
+ if cur_exp=x then if cur_type=independent then cur_type:=dependent;
+ end
+
+@ @<Divide list |p| by $2^n$@>=
+begin s:=temp_head; link(temp_head):=p; r:=p;
+repeat if n>30 then w:=0
+else w:=value(r) div two_to_the[n];
+if (abs(w)<=half_fraction_threshold)and(info(r)<>null) then
+ begin link(s):=link(r);
+ free_node(r,dep_node_size);
+ end
+else begin value(r):=w; s:=r;
+ end;
+r:=link(s);
+until info(s)=null;
+p:=link(temp_head);
+end
+
+@ The |check_mem| procedure, which is used only when \MF\ is being
+debugged, makes sure that the current dependency lists are well formed.
+
+@<Check the list of linear dependencies@>=
+q:=dep_head; p:=link(q);
+while p<>dep_head do
+ begin if prev_dep(p)<>q then
+ begin print_nl("Bad PREVDEP at "); print_int(p);
+@.Bad PREVDEP...@>
+ end;
+ p:=dep_list(p); r:=inf_val;
+ repeat if value(info(p))>=value(r) then
+ begin print_nl("Out of order at "); print_int(p);
+@.Out of order...@>
+ end;
+ r:=info(p); q:=p; p:=link(q);
+ until r=null;
+ end
+
+@* \[29] Dynamic nonlinear equations.
+Variables of numeric type are maintained by the general scheme of
+independent, dependent, and known values that we have just studied;
+and the components of pair and transform variables are handled in the
+same way. But \MF\ also has five other types of values: \&{boolean},
+\&{string}, \&{pen}, \&{path}, and \&{picture}; what about them?
+
+Equations are allowed between nonlinear quantities, but only in a
+simple form. Two variables that haven't yet been assigned values are
+either equal to each other, or they're not.
+
+Before a boolean variable has received a value, its type is |unknown_boolean|;
+similarly, there are variables whose type is |unknown_string|, |unknown_pen|,
+|unknown_path|, and |unknown_picture|. In such cases the value is either
+|null| (which means that no other variables are equivalent to this one), or
+it points to another variable of the same undefined type. The pointers in the
+latter case form a cycle of nodes, which we shall call a ``ring.''
+Rings of undefined variables may include capsules, which arise as
+intermediate results within expressions or as \&{expr} parameters to macros.
+
+When one member of a ring receives a value, the same value is given to
+all the other members. In the case of paths and pictures, this implies
+making separate copies of a potentially large data structure; users should
+restrain their enthusiasm for such generality, unless they have lots and
+lots of memory space.
+
+@ The following procedure is called when a capsule node is being
+added to a ring (e.g., when an unknown variable is mentioned in an expression).
+
+@p function new_ring_entry(@!p:pointer):pointer;
+var q:pointer; {the new capsule node}
+begin q:=get_node(value_node_size); name_type(q):=capsule;
+type(q):=type(p);
+if value(p)=null then value(q):=p@+else value(q):=value(p);
+value(p):=q;
+new_ring_entry:=q;
+end;
+
+@ Conversely, we might delete a capsule or a variable before it becomes known.
+The following procedure simply detaches a quantity from its ring,
+without recycling the storage.
+
+@<Declare the recycling subroutines@>=
+procedure ring_delete(@!p:pointer);
+var @!q:pointer;
+begin q:=value(p);
+if q<>null then if q<>p then
+ begin while value(q)<>p do q:=value(q);
+ value(q):=value(p);
+ end;
+end;
+
+@ Eventually there might be an equation that assigns values to all of the
+variables in a ring. The |nonlinear_eq| subroutine does the necessary
+propagation of values.
+
+If the parameter |flush_p| is |true|, node |p| itself needn't receive a
+value; it will soon be recycled.
+
+@p procedure nonlinear_eq(@!v:integer;@!p:pointer;@!flush_p:boolean);
+var @!t:small_number; {the type of ring |p|}
+@!q,@!r:pointer; {link manipulation registers}
+begin t:=type(p)-unknown_tag; q:=value(p);
+if flush_p then type(p):=vacuous@+else p:=q;
+repeat r:=value(q); type(q):=t;
+case t of
+boolean_type: value(q):=v;
+string_type: begin value(q):=v; add_str_ref(v);
+ end;
+pen_type: begin value(q):=v; add_pen_ref(v);
+ end;
+path_type: value(q):=copy_path(v);
+picture_type: value(q):=copy_edges(v);
+end; {there ain't no more cases}
+q:=r;
+until q=p;
+end;
+
+@ If two members of rings are equated, and if they have the same type,
+the |ring_merge| procedure is called on to make them equivalent.
+
+@p procedure ring_merge(@!p,@!q:pointer);
+label exit;
+var @!r:pointer; {traverses one list}
+begin r:=value(p);
+while r<>p do
+ begin if r=q then
+ begin @<Exclaim about a redundant equation@>;
+ return;
+ end;
+ r:=value(r);
+ end;
+r:=value(p); value(p):=value(q); value(q):=r;
+exit:end;
+
+@ @<Exclaim about a redundant equation@>=
+begin print_err("Redundant equation");@/
+@.Redundant equation@>
+help2("I already knew that this equation was true.")@/
+ ("But perhaps no harm has been done; let's continue.");@/
+put_get_error;
+end
+
+@* \[30] Introduction to the syntactic routines.
+Let's pause a moment now and try to look at the Big Picture.
+The \MF\ program consists of three main parts: syntactic routines,
+semantic routines, and output routines. The chief purpose of the
+syntactic routines is to deliver the user's input to the semantic routines,
+while parsing expressions and locating operators and operands. The
+semantic routines act as an interpreter responding to these operators,
+which may be regarded as commands. And the output routines are
+periodically called on to produce compact font descriptions that can be
+used for typesetting or for making interim proof drawings. We have
+discussed the basic data structures and many of the details of semantic
+operations, so we are good and ready to plunge into the part of \MF\ that
+actually controls the activities.
+
+Our current goal is to come to grips with the |get_next| procedure,
+which is the keystone of \MF's input mechanism. Each call of |get_next|
+sets the value of three variables |cur_cmd|, |cur_mod|, and |cur_sym|,
+representing the next input token.
+$$\vbox{\halign{#\hfil\cr
+ \hbox{|cur_cmd| denotes a command code from the long list of codes
+ given earlier;}\cr
+ \hbox{|cur_mod| denotes a modifier of the command code;}\cr
+ \hbox{|cur_sym| is the hash address of the symbolic token that was
+ just scanned,}\cr
+ \hbox{\qquad or zero in the case of a numeric or string
+ or capsule token.}\cr}}$$
+Underlying this external behavior of |get_next| is all the machinery
+necessary to convert from character files to tokens. At a given time we
+may be only partially finished with the reading of several files (for
+which \&{input} was specified), and partially finished with the expansion
+of some user-defined macros and/or some macro parameters, and partially
+finished reading some text that the user has inserted online,
+and so on. When reading a character file, the characters must be
+converted to tokens; comments and blank spaces must
+be removed, numeric and string tokens must be evaluated.
+
+To handle these situations, which might all be present simultaneously,
+\MF\ uses various stacks that hold information about the incomplete
+activities, and there is a finite state control for each level of the
+input mechanism. These stacks record the current state of an implicitly
+recursive process, but the |get_next| procedure is not recursive.
+
+@<Glob...@>=
+@!cur_cmd: eight_bits; {current command set by |get_next|}
+@!cur_mod: integer; {operand of current command}
+@!cur_sym: halfword; {hash address of current symbol}
+
+@ The |print_cmd_mod| routine prints a symbolic interpretation of a
+command code and its modifier.
+It consists of a rather tedious sequence of print
+commands, and most of it is essentially an inverse to the |primitive|
+routine that enters a \MF\ primitive into |hash| and |eqtb|. Therefore almost
+all of this procedure appears elsewhere in the program, together with the
+corresponding |primitive| calls.
+
+@<Declare the procedure called |print_cmd_mod|@>=
+procedure print_cmd_mod(@!c,@!m:integer);
+begin case c of
+@t\4@>@<Cases of |print_cmd_mod| for symbolic printing of primitives@>@/
+othercases print("[unknown command code!]")
+endcases;
+end;
+
+@ Here is a procedure that displays a given command in braces, in the
+user's transcript file.
+
+@d show_cur_cmd_mod==show_cmd_mod(cur_cmd,cur_mod)
+
+@p procedure show_cmd_mod(@!c,@!m:integer);
+begin begin_diagnostic; print_nl("{");
+print_cmd_mod(c,m); print_char("}");
+end_diagnostic(false);
+end;
+
+@* \[31] Input stacks and states.
+The state of \MF's input mechanism appears in the input stack, whose
+entries are records with five fields, called |index|, |start|, |loc|,
+|limit|, and |name|. The top element of this stack is maintained in a
+global variable for which no subscripting needs to be done; the other
+elements of the stack appear in an array. Hence the stack is declared thus:
+
+@<Types...@>=
+@!in_state_record = record
+ @!index_field: quarterword;
+ @!start_field,@!loc_field, @!limit_field, @!name_field: halfword;
+ end;
+
+@ @<Glob...@>=
+@!input_stack : array[0..stack_size] of in_state_record;
+@!input_ptr : 0..stack_size; {first unused location of |input_stack|}
+@!max_in_stack: 0..stack_size; {largest value of |input_ptr| when pushing}
+@!cur_input : in_state_record; {the ``top'' input state}
+
+@ We've already defined the special variable |@!loc==cur_input.loc_field|
+in our discussion of basic input-output routines. The other components of
+|cur_input| are defined in the same way:
+
+@d index==cur_input.index_field {reference for buffer information}
+@d start==cur_input.start_field {starting position in |buffer|}
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d name==cur_input.name_field {name of the current file}
+
+@ Let's look more closely now at the five control variables
+(|index|,~|start|,~|loc|,~|limit|,~|name|),
+assuming that \MF\ is reading a line of characters that have been input
+from some file or from the user's terminal. There is an array called
+|buffer| that acts as a stack of all lines of characters that are
+currently being read from files, including all lines on subsidiary
+levels of the input stack that are not yet completed. \MF\ will return to
+the other lines when it is finished with the present input file.
+
+(Incidentally, on a machine with byte-oriented addressing, it would be
+appropriate to combine |buffer| with the |str_pool| array,
+letting the buffer entries grow downward from the top of the string pool
+and checking that these two tables don't bump into each other.)
+
+The line we are currently working on begins in position |start| of the
+buffer; the next character we are about to read is |buffer[loc]|; and
+|limit| is the location of the last character present. We always have
+|loc<=limit|. For convenience, |buffer[limit]| has been set to |"%"|, so
+that the end of a line is easily sensed.
+
+The |name| variable is a string number that designates the name of
+the current file, if we are reading a text file. It is 0 if we
+are reading from the terminal for normal input, or 1 if we are executing a
+\&{readstring} command, or 2 if we are reading a string that was
+moved into the buffer by \&{scantokens}.
+
+@ Additional information about the current line is available via the
+|index| variable, which counts how many lines of characters are present
+in the buffer below the current level. We have |index=0| when reading
+from the terminal and prompting the user for each line; then if the user types,
+e.g., `\.{input font}', we will have |index=1| while reading
+the file \.{font.mf}. However, it does not follow that |index| is the
+same as the input stack pointer, since many of the levels on the input
+stack may come from token lists.
+
+The global variable |in_open| is equal to the |index|
+value of the highest non-token-list level. Thus, the number of partially read
+lines in the buffer is |in_open+1|, and we have |in_open=index|
+when we are not reading a token list.
+
+If we are not currently reading from the terminal,
+we are reading from the file variable |input_file[index]|. We use
+the notation |terminal_input| as a convenient abbreviation for |name=0|,
+and |cur_file| as an abbreviation for |input_file[index]|.
+
+The global variable |line| contains the line number in the topmost
+open file, for use in error messages. If we are not reading from
+the terminal, |line_stack[index]| holds the line number for the
+enclosing level, so that |line| can be restored when the current
+file has been read.
+
+If more information about the input state is needed, it can be
+included in small arrays like those shown here. For example,
+the current page or segment number in the input file might be
+put into a variable |@!page|, maintained for enclosing levels in
+`\ignorespaces|@!page_stack:array[1..max_in_open] of integer|\unskip'
+by analogy with |line_stack|.
+@^system dependencies@>
+
+@d terminal_input==(name=0) {are we reading from the terminal?}
+@d cur_file==input_file[index] {the current |alpha_file| variable}
+
+@<Glob...@>=
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : array[1..max_in_open] of alpha_file;
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+
+@ However, all this discussion about input state really applies only to the
+case that we are inputting from a file. There is another important case,
+namely when we are currently getting input from a token list. In this case
+|index>max_in_open|, and the conventions about the other state variables
+are different:
+
+\yskip\hang|loc| is a pointer to the current node in the token list, i.e.,
+the node that will be read next. If |loc=null|, the token list has been
+fully read.
+
+\yskip\hang|start| points to the first node of the token list; this node
+may or may not contain a reference count, depending on the type of token
+list involved.
+
+\yskip\hang|token_type|, which takes the place of |index| in the
+discussion above, is a code number that explains what kind of token list
+is being scanned.
+
+\yskip\hang|name| points to the |eqtb| address of the control sequence
+being expanded, if the current token list is a macro not defined by
+\&{vardef}. Macros defined by \&{vardef} have |name=null|; their name
+can be deduced by looking at their first two parameters.
+
+\yskip\hang|param_start|, which takes the place of |limit|, tells where
+the parameters of the current macro or loop text begin in the |param_stack|.
+
+\yskip\noindent The |token_type| can take several values, depending on
+where the current token list came from:
+
+\yskip
+\indent|forever_text|, if the token list being scanned is the body of
+a \&{forever} loop;
+
+\indent|loop_text|, if the token list being scanned is the body of
+a \&{for} or \&{forsuffixes} loop;
+
+\indent|parameter|, if a \&{text} or \&{suffix} parameter is being scanned;
+
+\indent|backed_up|, if the token list being scanned has been inserted as
+`to be read again'.
+
+\indent|inserted|, if the token list being scanned has been inserted as
+part of error recovery;
+
+\indent|macro|, if the expansion of a user-defined symbolic token is being
+scanned.
+
+\yskip\noindent
+The token list begins with a reference count if and only if |token_type=
+macro|.
+@^reference counts@>
+
+@d token_type==index {type of current token list}
+@d token_state==(index>max_in_open) {are we scanning a token list?}
+@d file_state==(index<=max_in_open) {are we scanning a file line?}
+@d param_start==limit {base of macro parameters in |param_stack|}
+@d forever_text=max_in_open+1 {|token_type| code for loop texts}
+@d loop_text=max_in_open+2 {|token_type| code for loop texts}
+@d parameter=max_in_open+3 {|token_type| code for parameter texts}
+@d backed_up=max_in_open+4 {|token_type| code for texts to be reread}
+@d inserted=max_in_open+5 {|token_type| code for inserted texts}
+@d macro=max_in_open+6 {|token_type| code for macro replacement texts}
+
+@ The |param_stack| is an auxiliary array used to hold pointers to the token
+lists for parameters at the current level and subsidiary levels of input.
+This stack grows at a different rate from the others.
+
+@<Glob...@>=
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+@!param_ptr:0..param_size; {first unused entry in |param_stack|}
+@!max_param_stack:integer;
+ {largest value of |param_ptr|}
+
+@ Thus, the ``current input state'' can be very complicated indeed; there
+can be many levels and each level can arise in a variety of ways. The
+|show_context| procedure, which is used by \MF's error-reporting routine to
+print out the current input state on all levels down to the most recent
+line of characters from an input file, illustrates most of these conventions.
+The global variable |file_ptr| contains the lowest level that was
+displayed by this procedure.
+
+@<Glob...@>=
+@!file_ptr:0..stack_size; {shallowest level shown by |show_context|}
+
+@ The status at each level is indicated by printing two lines, where the first
+line indicates what was read so far and the second line shows what remains
+to be read. The context is cropped, if necessary, so that the first line
+contains at most |half_error_line| characters, and the second contains
+at most |error_line|. Non-current input levels whose |token_type| is
+`|backed_up|' are shown only if they have not been fully read.
+
+@p procedure show_context; {prints where the scanner is}
+label done;
+var @!old_setting:0..max_selector; {saved |selector| setting}
+@<Local variables for formatting calculations@>@/
+begin file_ptr:=input_ptr; input_stack[file_ptr]:=cur_input;
+ {store current state}
+loop@+begin cur_input:=input_stack[file_ptr]; {enter into the context}
+ @<Display the current context@>;
+ if file_state then
+ if (name>2) or (file_ptr=0) then goto done;
+ decr(file_ptr);
+ end;
+done: cur_input:=input_stack[input_ptr]; {restore original state}
+end;
+
+@ @<Display the current context@>=
+if (file_ptr=input_ptr) or file_state or
+ (token_type<>backed_up) or (loc<>null) then
+ {we omit backed-up token lists that have already been read}
+ begin tally:=0; {get ready to count characters}
+ old_setting:=selector;
+ if file_state then
+ begin @<Print location of current line@>;
+ @<Pseudoprint the line@>;
+ end
+ else begin @<Print type of token list@>;
+ @<Pseudoprint the token list@>;
+ end;
+ selector:=old_setting; {stop pseudoprinting}
+ @<Print two lines using the tricky pseudoprinted information@>;
+ end
+
+@ This routine should be changed, if necessary, to give the best possible
+indication of where the current line resides in the input file.
+For example, on some systems it is best to print both a page and line number.
+@^system dependencies@>
+
+@<Print location of current line@>=
+if name<=1 then
+ if terminal_input and(file_ptr=0) then print_nl("<*>")
+ else print_nl("<insert>")
+else if name=2 then print_nl("<scantokens>")
+else begin print_nl("l."); print_int(line);
+ end;
+print_char(" ")
+
+@ @<Print type of token list@>=
+case token_type of
+forever_text: print_nl("<forever> ");
+loop_text: @<Print the current loop value@>;
+parameter: print_nl("<argument> ");
+backed_up: if loc=null then print_nl("<recently read> ")
+ else print_nl("<to be read again> ");
+inserted: print_nl("<inserted text> ");
+macro: begin print_ln;
+ if name<>null then slow_print(text(name))
+ else @<Print the name of a \&{vardef}'d macro@>;
+ print("->");
+ end;
+othercases print_nl("?") {this should never happen}
+@.?\relax@>
+endcases
+
+@ The parameter that corresponds to a loop text is either a token list
+(in the case of \&{forsuffixes}) or a ``capsule'' (in the case of \&{for}).
+We'll discuss capsules later; for now, all we need to know is that
+the |link| field in a capsule parameter is |void| and that
+|print_exp(p,0)| displays the value of capsule~|p| in abbreviated form.
+
+@<Print the current loop value@>=
+begin print_nl("<for("); p:=param_stack[param_start];
+if p<>null then
+ if link(p)=void then print_exp(p,0) {we're in a \&{for} loop}
+ else show_token_list(p,null,20,tally);
+print(")> ");
+end
+
+@ The first two parameters of a macro defined by \&{vardef} will be token
+lists representing the macro's prefix and ``at point.'' By putting these
+together, we get the macro's full name.
+
+@<Print the name of a \&{vardef}'d macro@>=
+begin p:=param_stack[param_start];
+if p=null then show_token_list(param_stack[param_start+1],null,20,tally)
+else begin q:=p;
+ while link(q)<>null do q:=link(q);
+ link(q):=param_stack[param_start+1];
+ show_token_list(p,null,20,tally);
+ link(q):=null;
+ end;
+end
+
+@ Now it is necessary to explain a little trick. We don't want to store a long
+string that corresponds to a token list, because that string might take up
+lots of memory; and we are printing during a time when an error message is
+being given, so we dare not do anything that might overflow one of \MF's
+tables. So `pseudoprinting' is the answer: We enter a mode of printing
+that stores characters into a buffer of length |error_line|, where character
+$k+1$ is placed into \hbox{|trick_buf[k mod error_line]|} if
+|k<trick_count|, otherwise character |k| is dropped. Initially we set
+|tally:=0| and |trick_count:=1000000|; then when we reach the
+point where transition from line 1 to line 2 should occur, we
+set |first_count:=tally| and |trick_count:=@tmax@>(error_line,
+tally+1+error_line-half_error_line)|. At the end of the
+pseudoprinting, the values of |first_count|, |tally|, and
+|trick_count| give us all the information we need to print the two lines,
+and all of the necessary text is in |trick_buf|.
+
+Namely, let |l| be the length of the descriptive information that appears
+on the first line. The length of the context information gathered for that
+line is |k=first_count|, and the length of the context information
+gathered for line~2 is $m=\min(|tally|, |trick_count|)-k$. If |l+k<=h|,
+where |h=half_error_line|, we print |trick_buf[0..k-1]| after the
+descriptive information on line~1, and set |n:=l+k|; here |n| is the
+length of line~1. If $l+k>h$, some cropping is necessary, so we set |n:=h|
+and print `\.{...}' followed by
+$$\hbox{|trick_buf[(l+k-h+3)..k-1]|,}$$
+where subscripts of |trick_buf| are circular modulo |error_line|. The
+second line consists of |n|~spaces followed by |trick_buf[k..(k+m-1)]|,
+unless |n+m>error_line|; in the latter case, further cropping is done.
+This is easier to program than to explain.
+
+@<Local variables for formatting...@>=
+@!i:0..buf_size; {index into |buffer|}
+@!l:integer; {length of descriptive information on line 1}
+@!m:integer; {context information gathered for line 2}
+@!n:0..error_line; {length of line 1}
+@!p: integer; {starting or ending place in |trick_buf|}
+@!q: integer; {temporary index}
+
+@ The following code tells the print routines to gather
+the desired information.
+
+@d begin_pseudoprint==
+ begin l:=tally; tally:=0; selector:=pseudo;
+ trick_count:=1000000;
+ end
+@d set_trick_count==
+ begin first_count:=tally;
+ trick_count:=tally+1+error_line-half_error_line;
+ if trick_count<error_line then trick_count:=error_line;
+ end
+
+@ And the following code uses the information after it has been gathered.
+
+@<Print two lines using the tricky pseudoprinted information@>=
+if trick_count=1000000 then set_trick_count;
+ {|set_trick_count| must be performed}
+if tally<trick_count then m:=tally-first_count
+else m:=trick_count-first_count; {context on line 2}
+if l+first_count<=half_error_line then
+ begin p:=0; n:=l+first_count;
+ end
+else begin print("..."); p:=l+first_count-half_error_line+3;
+ n:=half_error_line;
+ end;
+for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]);
+print_ln;
+for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2}
+if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3);
+for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]);
+if m+n>error_line then print("...")
+
+@ But the trick is distracting us from our current goal, which is to
+understand the input state. So let's concentrate on the data structures that
+are being pseudoprinted as we finish up the |show_context| procedure.
+
+@<Pseudoprint the line@>=
+begin_pseudoprint;
+if limit>0 then for i:=start to limit-1 do
+ begin if i=loc then set_trick_count;
+ print(buffer[i]);
+ end
+
+@ @<Pseudoprint the token list@>=
+begin_pseudoprint;
+if token_type<>macro then show_token_list(start,loc,100000,0)
+else show_macro(start,loc,100000)
+
+@ Here is the missing piece of |show_token_list| that is activated when the
+token beginning line~2 is about to be shown:
+
+@<Do magic computation@>=set_trick_count
+
+@* \[32] Maintaining the input stacks.
+The following subroutines change the input status in commonly needed ways.
+
+First comes |push_input|, which stores the current state and creates a
+new level (having, initially, the same properties as the old).
+
+@d push_input==@t@> {enter a new input level, save the old}
+ begin if input_ptr>max_in_stack then
+ begin max_in_stack:=input_ptr;
+ if input_ptr=stack_size then overflow("input stack size",stack_size);
+@:METAFONT capacity exceeded input stack size}{\quad input stack size@>
+ end;
+ input_stack[input_ptr]:=cur_input; {stack the record}
+ incr(input_ptr);
+ end
+
+@ And of course what goes up must come down.
+
+@d pop_input==@t@> {leave an input level, re-enter the old}
+ begin decr(input_ptr); cur_input:=input_stack[input_ptr];
+ end
+
+@ Here is a procedure that starts a new level of token-list input, given
+a token list |p| and its type |t|. If |t=macro|, the calling routine should
+set |name|, reset~|loc|, and increase the macro's reference count.
+
+@d back_list(#)==begin_token_list(#,backed_up) {backs up a simple token list}
+
+@p procedure begin_token_list(@!p:pointer;@!t:quarterword);
+begin push_input; start:=p; token_type:=t;
+param_start:=param_ptr; loc:=p;
+end;
+
+@ When a token list has been fully scanned, the following computations
+should be done as we leave that level of input.
+@^inner loop@>
+
+@p procedure end_token_list; {leave a token-list input level}
+label done;
+var @!p:pointer; {temporary register}
+begin if token_type>=backed_up then {token list to be deleted}
+ if token_type<=inserted then
+ begin flush_token_list(start); goto done;
+ end
+ else delete_mac_ref(start); {update reference count}
+while param_ptr>param_start do {parameters must be flushed}
+ begin decr(param_ptr);
+ p:=param_stack[param_ptr];
+ if p<>null then
+ if link(p)=void then {it's an \&{expr} parameter}
+ begin recycle_value(p); free_node(p,value_node_size);
+ end
+ else flush_token_list(p); {it's a \&{suffix} or \&{text} parameter}
+ end;
+done: pop_input; check_interrupt;
+end;
+
+@ The contents of |cur_cmd,cur_mod,cur_sym| are placed into an equivalent
+token by the |cur_tok| routine.
+@^inner loop@>
+
+@p @t\4@>@<Declare the procedure called |make_exp_copy|@>@;@/
+function cur_tok:pointer;
+var @!p:pointer; {a new token node}
+@!save_type:small_number; {|cur_type| to be restored}
+@!save_exp:integer; {|cur_exp| to be restored}
+begin if cur_sym=0 then
+ if cur_cmd=capsule_token then
+ begin save_type:=cur_type; save_exp:=cur_exp;
+ make_exp_copy(cur_mod); p:=stash_cur_exp; link(p):=null;
+ cur_type:=save_type; cur_exp:=save_exp;
+ end
+ else begin p:=get_node(token_node_size);
+ value(p):=cur_mod; name_type(p):=token;
+ if cur_cmd=numeric_token then type(p):=known
+ else type(p):=string_type;
+ end
+else begin fast_get_avail(p); info(p):=cur_sym;
+ end;
+cur_tok:=p;
+end;
+
+@ Sometimes \MF\ has read too far and wants to ``unscan'' what it has
+seen. The |back_input| procedure takes care of this by putting the token
+just scanned back into the input stream, ready to be read again.
+If |cur_sym<>0|, the values of |cur_cmd| and |cur_mod| are irrelevant.
+
+@p procedure back_input; {undoes one token of input}
+var @!p:pointer; {a token list of length one}
+begin p:=cur_tok;
+while token_state and(loc=null) do end_token_list; {conserve stack space}
+back_list(p);
+end;
+
+@ The |back_error| routine is used when we want to restore or replace an
+offending token just before issuing an error message. We disable interrupts
+during the call of |back_input| so that the help message won't be lost.
+
+@p procedure back_error; {back up one token and call |error|}
+begin OK_to_interrupt:=false; back_input; OK_to_interrupt:=true; error;
+end;
+@#
+procedure ins_error; {back up one inserted token and call |error|}
+begin OK_to_interrupt:=false; back_input; token_type:=inserted;
+OK_to_interrupt:=true; error;
+end;
+
+@ The |begin_file_reading| procedure starts a new level of input for lines
+of characters to be read from a file, or as an insertion from the
+terminal. It does not take care of opening the file, nor does it set |loc|
+or |limit| or |line|.
+@^system dependencies@>
+
+@p procedure begin_file_reading;
+begin if in_open=max_in_open then overflow("text input levels",max_in_open);
+@:METAFONT capacity exceeded text input levels}{\quad text input levels@>
+if first=buf_size then overflow("buffer size",buf_size);
+@:METAFONT capacity exceeded buffer size}{\quad buffer size@>
+incr(in_open); push_input; index:=in_open;
+line_stack[index]:=line; start:=first;
+name:=0; {|terminal_input| is now |true|}
+end;
+
+@ Conversely, the variables must be downdated when such a level of input
+is finished:
+
+@p procedure end_file_reading;
+begin first:=start; line:=line_stack[index];
+if index<>in_open then confusion("endinput");
+@:this can't happen endinput}{\quad endinput@>
+if name>2 then a_close(cur_file); {forget it}
+pop_input; decr(in_open);
+end;
+
+@ In order to keep the stack from overflowing during a long sequence of
+inserted `\.{show}' commands, the following routine removes completed
+error-inserted lines from memory.
+
+@p procedure clear_for_error_prompt;
+begin while file_state and terminal_input and@|
+ (input_ptr>0)and(loc=limit) do end_file_reading;
+print_ln; clear_terminal;
+end;
+
+@ To get \MF's whole input mechanism going, we perform the following
+actions.
+
+@<Initialize the input routines@>=
+begin input_ptr:=0; max_in_stack:=0;
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+param_ptr:=0; max_param_stack:=0;
+first:=1;
+start:=1; index:=0; line:=0; name:=0;
+force_eof:=false;
+if not init_terminal then goto final_end;
+limit:=last; first:=last+1; {|init_terminal| has set |loc| and |last|}
+end;
+
+@* \[33] Getting the next token.
+The heart of \MF's input mechanism is the |get_next| procedure, which
+we shall develop in the next few sections of the program. Perhaps we
+shouldn't actually call it the ``heart,'' however; it really acts as \MF's
+eyes and mouth, reading the source files and gobbling them up. And it also
+helps \MF\ to regurgitate stored token lists that are to be processed again.
+
+The main duty of |get_next| is to input one token and to set |cur_cmd|
+and |cur_mod| to that token's command code and modifier. Furthermore, if
+the input token is a symbolic token, that token's |hash| address
+is stored in |cur_sym|; otherwise |cur_sym| is set to zero.
+
+Underlying this simple description is a certain amount of complexity
+because of all the cases that need to be handled.
+However, the inner loop of |get_next| is reasonably short and fast.
+
+@ Before getting into |get_next|, we need to consider a mechanism by which
+\MF\ helps keep errors from propagating too far. Whenever the program goes
+into a mode where it keeps calling |get_next| repeatedly until a certain
+condition is met, it sets |scanner_status| to some value other than |normal|.
+Then if an input file ends, or if an `\&{outer}' symbol appears,
+an appropriate error recovery will be possible.
+
+The global variable |warning_info| helps in this error recovery by providing
+additional information. For example, |warning_info| might indicate the
+name of a macro whose replacement text is being scanned.
+
+@d normal=0 {|scanner_status| at ``quiet times''}
+@d skipping=1 {|scanner_status| when false conditional text is being skipped}
+@d flushing=2 {|scanner_status| when junk after a statement is being ignored}
+@d absorbing=3 {|scanner_status| when a \&{text} parameter is being scanned}
+@d var_defining=4 {|scanner_status| when a \&{vardef} is being scanned}
+@d op_defining=5 {|scanner_status| when a macro \&{def} is being scanned}
+@d loop_defining=6 {|scanner_status| when a \&{for} loop is being scanned}
+
+@<Glob...@>=
+@!scanner_status:normal..loop_defining; {are we scanning at high speed?}
+@!warning_info:integer; {if so, what else do we need to know,
+ in case an error occurs?}
+
+@ @<Initialize the input routines@>=
+scanner_status:=normal;
+
+@ The following subroutine
+is called when an `\&{outer}' symbolic token has been scanned or
+when the end of a file has been reached. These two cases are distinguished
+by |cur_sym|, which is zero at the end of a file.
+
+@p function check_outer_validity:boolean;
+var @!p:pointer; {points to inserted token list}
+begin if scanner_status=normal then check_outer_validity:=true
+else begin deletions_allowed:=false;
+ @<Back up an outer symbolic token so that it can be reread@>;
+ if scanner_status>skipping then
+ @<Tell the user what has run away and try to recover@>
+ else begin print_err("Incomplete if; all text was ignored after line ");
+@.Incomplete if...@>
+ print_int(warning_info);@/
+ help3("A forbidden `outer' token occurred in skipped text.")@/
+ ("This kind of error happens when you say `if...' and forget")@/
+ ("the matching `fi'. I've inserted a `fi'; this might work.");
+ if cur_sym=0 then help_line[2]:=@|
+ "The file ended while I was skipping conditional text.";
+ cur_sym:=frozen_fi; ins_error;
+ end;
+ deletions_allowed:=true; check_outer_validity:=false;
+ end;
+end;
+
+@ @<Back up an outer symbolic token so that it can be reread@>=
+if cur_sym<>0 then
+ begin p:=get_avail; info(p):=cur_sym;
+ back_list(p); {prepare to read the symbolic token again}
+ end
+
+@ @<Tell the user what has run away...@>=
+begin runaway; {print the definition-so-far}
+if cur_sym=0 then print_err("File ended")
+@.File ended while scanning...@>
+else begin print_err("Forbidden token found");
+@.Forbidden token found...@>
+ end;
+print(" while scanning ");
+help4("I suspect you have forgotten an `enddef',")@/
+("causing me to read past where you wanted me to stop.")@/
+("I'll try to recover; but if the error is serious,")@/
+("you'd better type `E' or `X' now and fix your file.");@/
+case scanner_status of
+@t\4@>@<Complete the error message,
+ and set |cur_sym| to a token that might help recover from the error@>@;
+end; {there are no other cases}
+ins_error;
+end
+
+@ As we consider various kinds of errors, it is also appropriate to
+change the first line of the help message just given; |help_line[3]|
+points to the string that might be changed.
+
+@<Complete the error message,...@>=
+flushing: begin print("to the end of the statement");
+ help_line[3]:="A previous error seems to have propagated,";
+ cur_sym:=frozen_semicolon;
+ end;
+absorbing: begin print("a text argument");
+ help_line[3]:="It seems that a right delimiter was left out,";
+ if warning_info=0 then cur_sym:=frozen_end_group
+ else begin cur_sym:=frozen_right_delimiter;
+ equiv(frozen_right_delimiter):=warning_info;
+ end;
+ end;
+var_defining, op_defining: begin print("the definition of ");
+ if scanner_status=op_defining then slow_print(text(warning_info))
+ else print_variable_name(warning_info);
+ cur_sym:=frozen_end_def;
+ end;
+loop_defining: begin print("the text of a "); slow_print(text(warning_info));
+ print(" loop");
+ help_line[3]:="I suspect you have forgotten an `endfor',";
+ cur_sym:=frozen_end_for;
+ end;
+
+@ The |runaway| procedure displays the first part of the text that occurred
+when \MF\ began its special |scanner_status|, if that text has been saved.
+
+@<Declare the procedure called |runaway|@>=
+procedure runaway;
+begin if scanner_status>flushing then
+ begin print_nl("Runaway ");
+ case scanner_status of
+ absorbing: print("text?");
+ var_defining,op_defining: print("definition?");
+ loop_defining: print("loop?");
+ end; {there are no other cases}
+ print_ln; show_token_list(link(hold_head),null,error_line-10,0);
+ end;
+end;
+
+@ We need to mention a procedure that may be called by |get_next|.
+
+@p procedure@?firm_up_the_line; forward;
+
+@ And now we're ready to take the plunge into |get_next| itself.
+
+@d switch=25 {a label in |get_next|}
+@d start_numeric_token=85 {another}
+@d start_decimal_token=86 {and another}
+@d fin_numeric_token=87
+ {and still another, although |goto| is considered harmful}
+
+@p procedure get_next; {sets |cur_cmd|, |cur_mod|, |cur_sym| to next token}
+@^inner loop@>
+label restart, {go here to get the next input token}
+ exit, {go here when the next input token has been got}
+ found, {go here when the end of a symbolic token has been found}
+ switch, {go here to branch on the class of an input character}
+ start_numeric_token,start_decimal_token,fin_numeric_token,done;
+ {go here at crucial stages when scanning a number}
+var @!k:0..buf_size; {an index into |buffer|}
+@!c:ASCII_code; {the current character in the buffer}
+@!class:ASCII_code; {its class number}
+@!n,@!f:integer; {registers for decimal-to-binary conversion}
+begin restart: cur_sym:=0;
+if file_state then
+@<Input from external file; |goto restart| if no input found,
+ or |return| if a non-symbolic token is found@>
+else @<Input from token list; |goto restart| if end of list or
+ if a parameter needs to be expanded,
+ or |return| if a non-symbolic token is found@>;
+@<Finish getting the symbolic token in |cur_sym|;
+ |goto restart| if it is illegal@>;
+exit:end;
+
+@ When a symbolic token is declared to be `\&{outer}', its command code
+is increased by |outer_tag|.
+@^inner loop@>
+
+@<Finish getting the symbolic token in |cur_sym|...@>=
+cur_cmd:=eq_type(cur_sym); cur_mod:=equiv(cur_sym);
+if cur_cmd>=outer_tag then
+ if check_outer_validity then cur_cmd:=cur_cmd-outer_tag
+ else goto restart
+
+@ A percent sign appears in |buffer[limit]|; this makes it unnecessary
+to have a special test for end-of-line.
+@^inner loop@>
+
+@<Input from external file;...@>=
+begin switch: c:=buffer[loc]; incr(loc); class:=char_class[c];
+case class of
+digit_class: goto start_numeric_token;
+period_class: begin class:=char_class[buffer[loc]];
+ if class>period_class then goto switch
+ else if class<period_class then {|class=digit_class|}
+ begin n:=0; goto start_decimal_token;
+ end;
+@:. }{\..\ token@>
+ end;
+space_class: goto switch;
+percent_class: begin @<Move to next line of file,
+ or |goto restart| if there is no next line@>;
+ check_interrupt;
+ goto switch;
+ end;
+string_class: @<Get a string token and |return|@>;
+isolated_classes: begin k:=loc-1; goto found;
+ end;
+invalid_class: @<Decry the invalid character and |goto restart|@>;
+othercases do_nothing {letters, etc.}
+endcases;@/
+k:=loc-1;
+while char_class[buffer[loc]]=class do incr(loc);
+goto found;
+start_numeric_token:@<Get the integer part |n| of a numeric token;
+ set |f:=0| and |goto fin_numeric_token| if there is no decimal point@>;
+start_decimal_token:@<Get the fraction part |f| of a numeric token@>;
+fin_numeric_token:@<Pack the numeric and fraction parts of a numeric token
+ and |return|@>;
+found: cur_sym:=id_lookup(k,loc-k);
+end
+
+@ We go to |restart| instead of to |switch|, because |state| might equal
+|token_list| after the error has been dealt with
+(cf.\ |clear_for_error_prompt|).
+
+@<Decry the invalid...@>=
+begin print_err("Text line contains an invalid character");
+@.Text line contains...@>
+help2("A funny symbol that I can't read has just been input.")@/
+("Continue, and I'll forget that it ever happened.");@/
+deletions_allowed:=false; error; deletions_allowed:=true;
+goto restart;
+end
+
+@ @<Get a string token and |return|@>=
+begin if buffer[loc]="""" then cur_mod:=""
+else begin k:=loc; buffer[limit+1]:="""";
+ repeat incr(loc);
+ until buffer[loc]="""";
+ if loc>limit then @<Decry the missing string delimiter and |goto restart|@>;
+ if (loc=k+1) and (length(buffer[k])=1) then cur_mod:=buffer[k]
+ else begin str_room(loc-k);
+ repeat append_char(buffer[k]); incr(k);
+ until k=loc;
+ cur_mod:=make_string;
+ end;
+ end;
+incr(loc); cur_cmd:=string_token; return;
+end
+
+@ We go to |restart| after this error message, not to |switch|,
+because the |clear_for_error_prompt| routine might have reinstated
+|token_state| after |error| has finished.
+
+@<Decry the missing string delimiter and |goto restart|@>=
+begin loc:=limit; {the next character to be read on this line will be |"%"|}
+print_err("Incomplete string token has been flushed");
+@.Incomplete string token...@>
+help3("Strings should finish on the same line as they began.")@/
+ ("I've deleted the partial string; you might want to")@/
+ ("insert another by typing, e.g., `I""new string""'.");@/
+deletions_allowed:=false; error; deletions_allowed:=true; goto restart;
+end
+
+@ @<Get the integer part |n| of a numeric token...@>=
+n:=c-"0";
+while char_class[buffer[loc]]=digit_class do
+ begin if n<4096 then n:=10*n+buffer[loc]-"0";
+ incr(loc);
+ end;
+if buffer[loc]="." then if char_class[buffer[loc+1]]=digit_class then goto done;
+f:=0; goto fin_numeric_token;
+done: incr(loc)
+
+@ @<Get the fraction part |f| of a numeric token@>=
+k:=0;
+repeat if k<17 then {digits for |k>=17| cannot affect the result}
+ begin dig[k]:=buffer[loc]-"0"; incr(k);
+ end;
+incr(loc);
+until char_class[buffer[loc]]<>digit_class;
+f:=round_decimals(k);
+if f=unity then
+ begin incr(n); f:=0;
+ end
+
+@ @<Pack the numeric and fraction parts of a numeric token and |return|@>=
+if n<4096 then cur_mod:=n*unity+f
+else begin print_err("Enormous number has been reduced");
+@.Enormous number...@>
+ help2("I can't handle numbers bigger than about 4095.99998;")@/
+ ("so I've changed your constant to that maximum amount.");@/
+ deletions_allowed:=false; error; deletions_allowed:=true;
+ cur_mod:=@'1777777777;
+ end;
+cur_cmd:=numeric_token; return
+
+@ Let's consider now what happens when |get_next| is looking at a token list.
+@^inner loop@>
+
+@<Input from token list;...@>=
+if loc>=hi_mem_min then {one-word token}
+ begin cur_sym:=info(loc); loc:=link(loc); {move to next}
+ if cur_sym>=expr_base then
+ if cur_sym>=suffix_base then
+ @<Insert a suffix or text parameter and |goto restart|@>
+ else begin cur_cmd:=capsule_token;
+ cur_mod:=param_stack[param_start+cur_sym-(expr_base)];
+ cur_sym:=0; return;
+ end;
+ end
+else if loc>null then
+ @<Get a stored numeric or string or capsule token and |return|@>
+else begin {we are done with this token list}
+ end_token_list; goto restart; {resume previous level}
+ end
+
+@ @<Insert a suffix or text parameter...@>=
+begin if cur_sym>=text_base then cur_sym:=cur_sym-param_size;
+ {|param_size=text_base-suffix_base|}
+begin_token_list(param_stack[param_start+cur_sym-(suffix_base)],parameter);
+goto restart;
+end
+
+@ @<Get a stored numeric or string or capsule token...@>=
+begin if name_type(loc)=token then
+ begin cur_mod:=value(loc);
+ if type(loc)=known then cur_cmd:=numeric_token
+ else begin cur_cmd:=string_token; add_str_ref(cur_mod);
+ end;
+ end
+else begin cur_mod:=loc; cur_cmd:=capsule_token;
+ end;
+loc:=link(loc); return;
+end
+
+@ All of the easy branches of |get_next| have now been taken care of.
+There is one more branch.
+
+@<Move to next line of file, or |goto restart|...@>=
+if name>2 then @<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>
+else begin if input_ptr>0 then
+ {text was inserted during error recovery or by \&{scantokens}}
+ begin end_file_reading; goto restart; {resume previous level}
+ end;
+ if selector<log_only then open_log_file;
+ if interaction>nonstop_mode then
+ begin if limit=start then {previous line was empty}
+ print_nl("(Please type a command or say `end')");
+@.Please type...@>
+ print_ln; first:=start;
+ prompt_input("*"); {input on-line into |buffer|}
+@.*\relax@>
+ limit:=last; buffer[limit]:="%";
+ first:=limit+1; loc:=start;
+ end
+ else fatal_error("*** (job aborted, no legal end found)");
+@.job aborted@>
+ {nonstop mode, which is intended for overnight batch processing,
+ never waits for on-line input}
+ end
+
+@ The global variable |force_eof| is normally |false|; it is set |true|
+by an \&{endinput} command.
+
+@<Glob...@>=
+@!force_eof:boolean; {should the next \&{input} be aborted early?}
+
+@ @<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>=
+begin incr(line); first:=start;
+if not force_eof then
+ begin if input_ln(cur_file,true) then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else force_eof:=true;
+ end;
+if force_eof then
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ force_eof:=false;
+ end_file_reading; {resume previous level}
+ if check_outer_validity then goto restart@+else goto restart;
+ end;
+buffer[limit]:="%"; first:=limit+1; loc:=start; {ready to read}
+end
+
+@ If the user has set the |pausing| parameter to some positive value,
+and if nonstop mode has not been selected, each line of input is displayed
+on the terminal and the transcript file, followed by `\.{=>}'.
+\MF\ waits for a response. If the response is null (i.e., if nothing is
+typed except perhaps a few blank spaces), the original
+line is accepted as it stands; otherwise the line typed is
+used instead of the line in the file.
+
+@p procedure firm_up_the_line;
+var @!k:0..buf_size; {an index into |buffer|}
+begin limit:=last;
+if internal[pausing]>0 then if interaction>nonstop_mode then
+ begin wake_up_terminal; print_ln;
+ if start<limit then for k:=start to limit-1 do print(buffer[k]);
+ first:=limit; prompt_input("=>"); {wait for user response}
+@.=>@>
+ if last>first then
+ begin for k:=first to last-1 do {move line down in buffer}
+ buffer[k+start-first]:=buffer[k];
+ limit:=start+last-first;
+ end;
+ end;
+end;
+
+@* \[34] Scanning macro definitions.
+\MF\ has a variety of ways to tuck tokens away into token lists for later
+use: Macros can be defined with \&{def}, \&{vardef}, \&{primarydef}, etc.;
+repeatable code can be defined with \&{for}, \&{forever}, \&{forsuffixes}.
+All such operations are handled by the routines in this part of the program.
+
+The modifier part of each command code is zero for the ``ending delimiters''
+like \&{enddef} and \&{endfor}.
+
+@d start_def=1 {command modifier for \&{def}}
+@d var_def=2 {command modifier for \&{vardef}}
+@d end_def=0 {command modifier for \&{enddef}}
+@d start_forever=1 {command modifier for \&{forever}}
+@d end_for=0 {command modifier for \&{endfor}}
+
+@<Put each...@>=
+primitive("def",macro_def,start_def);@/
+@!@:def_}{\&{def} primitive@>
+primitive("vardef",macro_def,var_def);@/
+@!@:var_def_}{\&{vardef} primitive@>
+primitive("primarydef",macro_def,secondary_primary_macro);@/
+@!@:primary_def_}{\&{primarydef} primitive@>
+primitive("secondarydef",macro_def,tertiary_secondary_macro);@/
+@!@:secondary_def_}{\&{secondarydef} primitive@>
+primitive("tertiarydef",macro_def,expression_tertiary_macro);@/
+@!@:tertiary_def_}{\&{tertiarydef} primitive@>
+primitive("enddef",macro_def,end_def); eqtb[frozen_end_def]:=eqtb[cur_sym];@/
+@!@:end_def_}{\&{enddef} primitive@>
+@#
+primitive("for",iteration,expr_base);@/
+@!@:for_}{\&{for} primitive@>
+primitive("forsuffixes",iteration,suffix_base);@/
+@!@:for_suffixes_}{\&{forsuffixes} primitive@>
+primitive("forever",iteration,start_forever);@/
+@!@:forever_}{\&{forever} primitive@>
+primitive("endfor",iteration,end_for); eqtb[frozen_end_for]:=eqtb[cur_sym];@/
+@!@:end_for_}{\&{endfor} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+macro_def:if m<=var_def then
+ if m=start_def then print("def")
+ else if m<start_def then print("enddef")
+ else print("vardef")
+ else if m=secondary_primary_macro then print("primarydef")
+ else if m=tertiary_secondary_macro then print("secondarydef")
+ else print("tertiarydef");
+iteration: if m<=start_forever then
+ if m=start_forever then print("forever")@+else print("endfor")
+ else if m=expr_base then print("for")@+else print("forsuffixes");
+
+@ Different macro-absorbing operations have different syntaxes, but they
+also have a lot in common. There is a list of special symbols that are to
+be replaced by parameter tokens; there is a special command code that
+ends the definition; the quotation conventions are identical. Therefore
+it makes sense to have most of the work done by a single subroutine. That
+subroutine is called |scan_toks|.
+
+The first parameter to |scan_toks| is the command code that will
+terminate scanning (either |macro_def|, |loop_repeat|, or |iteration|).
+
+The second parameter, |subst_list|, points to a (possibly empty) list
+of two-word nodes whose |info| and |value| fields specify symbol tokens
+before and after replacement. The list will be returned to free storage
+by |scan_toks|.
+
+The third parameter is simply appended to the token list that is built.
+And the final parameter tells how many of the special operations
+\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#} are to be replaced by suffix parameters.
+When such parameters are present, they are called \.{(SUFFIX0)},
+\.{(SUFFIX1)}, and \.{(SUFFIX2)}.
+
+@p function scan_toks(@!terminator:command_code;
+ @!subst_list,@!tail_end:pointer;@!suffix_count:small_number):pointer;
+label done,found;
+var @!p:pointer; {tail of the token list being built}
+@!q:pointer; {temporary for link management}
+@!balance:integer; {left delimiters minus right delimiters}
+begin p:=hold_head; balance:=1; link(hold_head):=null;
+loop@+ begin get_next;
+ if cur_sym>0 then
+ begin @<Substitute for |cur_sym|, if it's on the |subst_list|@>;
+ if cur_cmd=terminator then
+ @<Adjust the balance; |goto done| if it's zero@>
+ else if cur_cmd=macro_special then
+ @<Handle quoted symbols, \.{\#\AT!}, \.{\AT!}, or \.{\AT!\#}@>;
+ end;
+ link(p):=cur_tok; p:=link(p);
+ end;
+done: link(p):=tail_end; flush_node_list(subst_list);
+scan_toks:=link(hold_head);
+end;
+
+@ @<Substitute for |cur_sym|...@>=
+begin q:=subst_list;
+while q<>null do
+ begin if info(q)=cur_sym then
+ begin cur_sym:=value(q); cur_cmd:=relax; goto found;
+ end;
+ q:=link(q);
+ end;
+found:end
+
+@ @<Adjust the balance; |goto done| if it's zero@>=
+if cur_mod>0 then incr(balance)
+else begin decr(balance);
+ if balance=0 then goto done;
+ end
+
+@ Four commands are intended to be used only within macro texts: \&{quote},
+\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#}. They are variants of a single command
+code called |macro_special|.
+
+@d quote=0 {|macro_special| modifier for \&{quote}}
+@d macro_prefix=1 {|macro_special| modifier for \.{\#\AT!}}
+@d macro_at=2 {|macro_special| modifier for \.{\AT!}}
+@d macro_suffix=3 {|macro_special| modifier for \.{\AT!\#}}
+
+@<Put each...@>=
+primitive("quote",macro_special,quote);@/
+@!@:quote_}{\&{quote} primitive@>
+primitive("#@@",macro_special,macro_prefix);@/
+@!@:]]]\#\AT!_}{\.{\#\AT!} primitive@>
+primitive("@@",macro_special,macro_at);@/
+@!@:]]]\AT!_}{\.{\AT!} primitive@>
+primitive("@@#",macro_special,macro_suffix);@/
+@!@:]]]\AT!\#_}{\.{\AT!\#} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+macro_special: case m of
+ macro_prefix: print("#@@");
+ macro_at: print_char("@@");
+ macro_suffix: print("@@#");
+ othercases print("quote")
+ endcases;
+
+@ @<Handle quoted...@>=
+begin if cur_mod=quote then get_next
+else if cur_mod<=suffix_count then cur_sym:=suffix_base-1+cur_mod;
+end
+
+@ Here is a routine that's used whenever a token will be redefined. If
+the user's token is unredefinable, the `|frozen_inaccessible|' token is
+substituted; the latter is redefinable but essentially impossible to use,
+hence \MF's tables won't get fouled up.
+
+@p procedure get_symbol; {sets |cur_sym| to a safe symbol}
+label restart;
+begin restart: get_next;
+if (cur_sym=0)or(cur_sym>frozen_inaccessible) then
+ begin print_err("Missing symbolic token inserted");
+@.Missing symbolic token...@>
+ help3("Sorry: You can't redefine a number, string, or expr.")@/
+ ("I've inserted an inaccessible symbol so that your")@/
+ ("definition will be completed without mixing me up too badly.");
+ if cur_sym>0 then
+ help_line[2]:="Sorry: You can't redefine my error-recovery tokens."
+ else if cur_cmd=string_token then delete_str_ref(cur_mod);
+ cur_sym:=frozen_inaccessible; ins_error; goto restart;
+ end;
+end;
+
+@ Before we actually redefine a symbolic token, we need to clear away its
+former value, if it was a variable. The following stronger version of
+|get_symbol| does that.
+
+@p procedure get_clear_symbol;
+begin get_symbol; clear_symbol(cur_sym,false);
+end;
+
+@ Here's another little subroutine; it checks that an equals sign
+or assignment sign comes along at the proper place in a macro definition.
+
+@p procedure check_equals;
+begin if cur_cmd<>equals then if cur_cmd<>assignment then
+ begin missing_err("=");@/
+@.Missing `='@>
+ help5("The next thing in this `def' should have been `=',")@/
+ ("because I've already looked at the definition heading.")@/
+ ("But don't worry; I'll pretend that an equals sign")@/
+ ("was present. Everything from here to `enddef'")@/
+ ("will be the replacement text of this macro.");
+ back_error;
+ end;
+end;
+
+@ A \&{primarydef}, \&{secondarydef}, or \&{tertiarydef} is rather easily
+handled now that we have |scan_toks|. In this case there are
+two parameters, which will be \.{EXPR0} and \.{EXPR1} (i.e.,
+|expr_base| and |expr_base+1|).
+
+@p procedure make_op_def;
+var @!m:command_code; {the type of definition}
+@!p,@!q,@!r:pointer; {for list manipulation}
+begin m:=cur_mod;@/
+get_symbol; q:=get_node(token_node_size);
+info(q):=cur_sym; value(q):=expr_base;@/
+get_clear_symbol; warning_info:=cur_sym;@/
+get_symbol; p:=get_node(token_node_size);
+info(p):=cur_sym; value(p):=expr_base+1; link(p):=q;@/
+get_next; check_equals;@/
+scanner_status:=op_defining; q:=get_avail; ref_count(q):=null;
+r:=get_avail; link(q):=r; info(r):=general_macro;
+link(r):=scan_toks(macro_def,p,null,0);
+scanner_status:=normal; eq_type(warning_info):=m;
+equiv(warning_info):=q; get_x_next;
+end;
+
+@ Parameters to macros are introduced by the keywords \&{expr},
+\&{suffix}, \&{text}, \&{primary}, \&{secondary}, and \&{tertiary}.
+
+@<Put each...@>=
+primitive("expr",param_type,expr_base);@/
+@!@:expr_}{\&{expr} primitive@>
+primitive("suffix",param_type,suffix_base);@/
+@!@:suffix_}{\&{suffix} primitive@>
+primitive("text",param_type,text_base);@/
+@!@:text_}{\&{text} primitive@>
+primitive("primary",param_type,primary_macro);@/
+@!@:primary_}{\&{primary} primitive@>
+primitive("secondary",param_type,secondary_macro);@/
+@!@:secondary_}{\&{secondary} primitive@>
+primitive("tertiary",param_type,tertiary_macro);@/
+@!@:tertiary_}{\&{tertiary} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+param_type:if m>=expr_base then
+ if m=expr_base then print("expr")
+ else if m=suffix_base then print("suffix")
+ else print("text")
+ else if m<secondary_macro then print("primary")
+ else if m=secondary_macro then print("secondary")
+ else print("tertiary");
+
+@ Let's turn next to the more complex processing associated with \&{def}
+and \&{vardef}. When the following procedure is called, |cur_mod|
+should be either |start_def| or |var_def|.
+
+@p @t\4@>@<Declare the procedure called |check_delimiter|@>@;
+@t\4@>@<Declare the function called |scan_declared_variable|@>@;
+procedure scan_def;
+var @!m:start_def..var_def; {the type of definition}
+@!n:0..3; {the number of special suffix parameters}
+@!k:0..param_size; {the total number of parameters}
+@!c:general_macro..text_macro; {the kind of macro we're defining}
+@!r:pointer; {parameter-substitution list}
+@!q:pointer; {tail of the macro token list}
+@!p:pointer; {temporary storage}
+@!base:halfword; {|expr_base|, |suffix_base|, or |text_base|}
+@!l_delim,@!r_delim:pointer; {matching delimiters}
+begin m:=cur_mod; c:=general_macro; link(hold_head):=null;@/
+q:=get_avail; ref_count(q):=null; r:=null;@/
+@<Scan the token or variable to be defined;
+ set |n|, |scanner_status|, and |warning_info|@>;
+k:=n;
+if cur_cmd=left_delimiter then
+ @<Absorb delimited parameters, putting them into lists |q| and |r|@>;
+if cur_cmd=param_type then
+ @<Absorb undelimited parameters, putting them into list |r|@>;
+check_equals;
+p:=get_avail; info(p):=c; link(q):=p;
+@<Attach the replacement text to the tail of node |p|@>;
+scanner_status:=normal; get_x_next;
+end;
+
+@ We don't put `|frozen_end_group|' into the replacement text of
+a \&{vardef}, because the user may want to redefine `\.{endgroup}'.
+
+@<Attach the replacement text to the tail of node |p|@>=
+if m=start_def then link(p):=scan_toks(macro_def,r,null,n)
+else begin q:=get_avail; info(q):=bg_loc; link(p):=q;
+ p:=get_avail; info(p):=eg_loc;
+ link(q):=scan_toks(macro_def,r,p,n);
+ end;
+if warning_info=bad_vardef then flush_token_list(value(bad_vardef))
+
+@ @<Glob...@>=
+@!bg_loc,@!eg_loc:1..hash_end;
+ {hash addresses of `\.{begingroup}' and `\.{endgroup}'}
+
+@ @<Scan the token or variable to be defined;...@>=
+if m=start_def then
+ begin get_clear_symbol; warning_info:=cur_sym; get_next;
+ scanner_status:=op_defining; n:=0;
+ eq_type(warning_info):=defined_macro; equiv(warning_info):=q;
+ end
+else begin p:=scan_declared_variable;
+ flush_variable(equiv(info(p)),link(p),true);
+ warning_info:=find_variable(p); flush_list(p);
+ if warning_info=null then @<Change to `\.{a bad variable}'@>;
+ scanner_status:=var_defining; n:=2;
+ if cur_cmd=macro_special then if cur_mod=macro_suffix then {\.{\AT!\#}}
+ begin n:=3; get_next;
+ end;
+ type(warning_info):=unsuffixed_macro-2+n; value(warning_info):=q;
+ end {|suffixed_macro=unsuffixed_macro+1|}
+
+@ @<Change to `\.{a bad variable}'@>=
+begin print_err("This variable already starts with a macro");
+@.This variable already...@>
+help2("After `vardef a' you can't say `vardef a.b'.")@/
+ ("So I'll have to discard this definition.");
+error; warning_info:=bad_vardef;
+end
+
+@ @<Initialize table entries...@>=
+name_type(bad_vardef):=root; link(bad_vardef):=frozen_bad_vardef;
+equiv(frozen_bad_vardef):=bad_vardef; eq_type(frozen_bad_vardef):=tag_token;
+
+@ @<Absorb delimited parameters, putting them into lists |q| and |r|@>=
+repeat l_delim:=cur_sym; r_delim:=cur_mod; get_next;
+if (cur_cmd=param_type)and(cur_mod>=expr_base) then base:=cur_mod
+else begin print_err("Missing parameter type; `expr' will be assumed");
+@.Missing parameter type@>
+ help1("You should've had `expr' or `suffix' or `text' here.");
+ back_error; base:=expr_base;
+ end;
+@<Absorb parameter tokens for type |base|@>;
+check_delimiter(l_delim,r_delim);
+get_next;
+until cur_cmd<>left_delimiter
+
+@ @<Absorb parameter tokens for type |base|@>=
+repeat link(q):=get_avail; q:=link(q); info(q):=base+k;@/
+get_symbol; p:=get_node(token_node_size); value(p):=base+k; info(p):=cur_sym;
+if k=param_size then overflow("parameter stack size",param_size);
+@:METAFONT capacity exceeded parameter stack size}{\quad parameter stack size@>
+incr(k); link(p):=r; r:=p; get_next;
+until cur_cmd<>comma
+
+@ @<Absorb undelimited parameters, putting them into list |r|@>=
+begin p:=get_node(token_node_size);
+if cur_mod<expr_base then
+ begin c:=cur_mod; value(p):=expr_base+k;
+ end
+else begin value(p):=cur_mod+k;
+ if cur_mod=expr_base then c:=expr_macro
+ else if cur_mod=suffix_base then c:=suffix_macro
+ else c:=text_macro;
+ end;
+if k=param_size then overflow("parameter stack size",param_size);
+incr(k); get_symbol; info(p):=cur_sym; link(p):=r; r:=p; get_next;
+if c=expr_macro then if cur_cmd=of_token then
+ begin c:=of_macro; p:=get_node(token_node_size);
+ if k=param_size then overflow("parameter stack size",param_size);
+ value(p):=expr_base+k; get_symbol; info(p):=cur_sym;
+ link(p):=r; r:=p; get_next;
+ end;
+end
+
+@* \[35] Expanding the next token.
+Only a few command codes |<min_command| can possibly be returned by
+|get_next|; in increasing order, they are
+|if_test|, |fi_or_else|, |input|, |iteration|, |repeat_loop|,
+|exit_test|, |relax|, |scan_tokens|, |expand_after|, and |defined_macro|.
+
+\MF\ usually gets the next token of input by saying |get_x_next|. This is
+like |get_next| except that it keeps getting more tokens until
+finding |cur_cmd>=min_command|. In other words, |get_x_next| expands
+macros and removes conditionals or iterations or input instructions that
+might be present.
+
+It follows that |get_x_next| might invoke itself recursively. In fact,
+there is massive recursion, since macro expansion can involve the
+scanning of arbitrarily complex expressions, which in turn involve
+macro expansion and conditionals, etc.
+@^recursion@>
+
+Therefore it's necessary to declare a whole bunch of |forward|
+procedures at this point, and to insert some other procedures
+that will be invoked by |get_x_next|.
+
+@p procedure@?scan_primary; forward;@t\2@>
+procedure@?scan_secondary; forward;@t\2@>
+procedure@?scan_tertiary; forward;@t\2@>
+procedure@?scan_expression; forward;@t\2@>
+procedure@?scan_suffix; forward;@t\2@>@/
+@t\4@>@<Declare the procedure called |macro_call|@>@;@/
+procedure@?get_boolean; forward;@t\2@>
+procedure@?pass_text; forward;@t\2@>
+procedure@?conditional; forward;@t\2@>
+procedure@?start_input; forward;@t\2@>
+procedure@?begin_iteration; forward;@t\2@>
+procedure@?resume_iteration; forward;@t\2@>
+procedure@?stop_iteration; forward;@t\2@>
+
+@ An auxiliary subroutine called |expand| is used by |get_x_next|
+when it has to do exotic expansion commands.
+
+@p procedure expand;
+var @!p:pointer; {for list manipulation}
+@!k:integer; {something that we hope is |<=buf_size|}
+@!j:pool_pointer; {index into |str_pool|}
+begin if internal[tracing_commands]>unity then if cur_cmd<>defined_macro then
+ show_cur_cmd_mod;
+case cur_cmd of
+if_test:conditional; {this procedure is discussed in Part 36 below}
+fi_or_else:@<Terminate the current conditional and skip to \&{fi}@>;
+input:@<Initiate or terminate input from a file@>;
+iteration:if cur_mod=end_for then
+ @<Scold the user for having an extra \&{endfor}@>
+ else begin_iteration; {this procedure is discussed in Part 37 below}
+repeat_loop: @<Repeat a loop@>;
+exit_test: @<Exit a loop if the proper time has come@>;
+relax: do_nothing;
+expand_after: @<Expand the token after the next token@>;
+scan_tokens: @<Put a string into the input buffer@>;
+defined_macro:macro_call(cur_mod,null,cur_sym);
+end; {there are no other cases}
+end;
+
+@ @<Scold the user...@>=
+begin print_err("Extra `endfor'");
+@.Extra `endfor'@>
+help2("I'm not currently working on a for loop,")@/
+ ("so I had better not try to end anything.");@/
+error;
+end
+
+@ The processing of \&{input} involves the |start_input| subroutine,
+which will be declared later; the processing of \&{endinput} is trivial.
+
+@<Put each...@>=
+primitive("input",input,0);@/
+@!@:input_}{\&{input} primitive@>
+primitive("endinput",input,1);@/
+@!@:end_input_}{\&{endinput} primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+input: if m=0 then print("input")@+else print("endinput");
+
+@ @<Initiate or terminate input...@>=
+if cur_mod>0 then force_eof:=true
+else start_input
+
+@ We'll discuss the complicated parts of loop operations later. For now
+it suffices to know that there's a global variable called |loop_ptr|
+that will be |null| if no loop is in progress.
+
+@<Repeat a loop@>=
+begin while token_state and(loc=null) do end_token_list; {conserve stack space}
+if loop_ptr=null then
+ begin print_err("Lost loop");
+@.Lost loop@>
+ help2("I'm confused; after exiting from a loop, I still seem")@/
+ ("to want to repeat it. I'll try to forget the problem.");@/
+ error;
+ end
+else resume_iteration; {this procedure is in Part 37 below}
+end
+
+@ @<Exit a loop if the proper time has come@>=
+begin get_boolean;
+if internal[tracing_commands]>unity then show_cmd_mod(nullary,cur_exp);
+if cur_exp=true_code then
+ if loop_ptr=null then
+ begin print_err("No loop is in progress");
+@.No loop is in progress@>
+ help1("Why say `exitif' when there's nothing to exit from?");
+ if cur_cmd=semicolon then error@+else back_error;
+ end
+ else @<Exit prematurely from an iteration@>
+else if cur_cmd<>semicolon then
+ begin missing_err(";");@/
+@.Missing `;'@>
+ help2("After `exitif <boolean exp>' I expect to see a semicolon.")@/
+ ("I shall pretend that one was there."); back_error;
+ end;
+end
+
+@ Here we use the fact that |forever_text| is the only |token_type| that
+is less than |loop_text|.
+
+@<Exit prematurely...@>=
+begin p:=null;
+repeat if file_state then end_file_reading
+else begin if token_type<=loop_text then p:=start;
+ end_token_list;
+ end;
+until p<>null;
+if p<>info(loop_ptr) then fatal_error("*** (loop confusion)");
+@.loop confusion@>
+stop_iteration; {this procedure is in Part 37 below}
+end
+
+@ @<Expand the token after the next token@>=
+begin get_next;
+p:=cur_tok; get_next;
+if cur_cmd<min_command then expand else back_input;
+back_list(p);
+end
+
+@ @<Put a string into the input buffer@>=
+begin get_x_next; scan_primary;
+if cur_type<>string_type then
+ begin disp_err(null,"Not a string");
+@.Not a string@>
+ help2("I'm going to flush this expression, since")@/
+ ("scantokens should be followed by a known string.");
+ put_get_flush_error(0);
+ end
+else begin back_input;
+ if length(cur_exp)>0 then @<Pretend we're reading a new one-line file@>;
+ end;
+end
+
+@ @<Pretend we're reading a new one-line file@>=
+begin begin_file_reading; name:=2;
+k:=first+length(cur_exp);
+if k>=max_buf_stack then
+ begin if k>=buf_size then
+ begin max_buf_stack:=buf_size;
+ overflow("buffer size",buf_size);
+@:METAFONT capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ max_buf_stack:=k+1;
+ end;
+j:=str_start[cur_exp]; limit:=k;
+while first<limit do
+ begin buffer[first]:=so(str_pool[j]); incr(j); incr(first);
+ end;
+buffer[limit]:="%"; first:=limit+1; loc:=start; flush_cur_exp(0);
+end
+
+@ Here finally is |get_x_next|.
+
+The expression scanning routines to be considered later
+communicate via the global quantities |cur_type| and |cur_exp|;
+we must be very careful to save and restore these quantities while
+macros are being expanded.
+@^inner loop@>
+
+@p procedure get_x_next;
+var @!save_exp:pointer; {a capsule to save |cur_type| and |cur_exp|}
+begin get_next;
+if cur_cmd<min_command then
+ begin save_exp:=stash_cur_exp;
+ repeat if cur_cmd=defined_macro then macro_call(cur_mod,null,cur_sym)
+ else expand;
+ get_next;
+ until cur_cmd>=min_command;
+ unstash_cur_exp(save_exp); {that restores |cur_type| and |cur_exp|}
+ end;
+end;
+
+@ Now let's consider the |macro_call| procedure, which is used to start up
+all user-defined macros. Since the arguments to a macro might be expressions,
+|macro_call| is recursive.
+@^recursion@>
+
+The first parameter to |macro_call| points to the reference count of the
+token list that defines the macro. The second parameter contains any
+arguments that have already been parsed (see below). The third parameter
+points to the symbolic token that names the macro. If the third parameter
+is |null|, the macro was defined by \&{vardef}, so its name can be
+reconstructed from the prefix and ``at'' arguments found within the
+second parameter.
+
+What is this second parameter? It's simply a linked list of one-word items,
+whose |info| fields point to the arguments. In other words, if |arg_list=null|,
+no arguments have been scanned yet; otherwise |info(arg_list)| points to
+the first scanned argument, and |link(arg_list)| points to the list of
+further arguments (if any).
+
+Arguments of type \&{expr} are so-called capsules, which we will
+discuss later when we concentrate on expressions; they can be
+recognized easily because their |link| field is |void|. Arguments of type
+\&{suffix} and \&{text} are token lists without reference counts.
+
+@ After argument scanning is complete, the arguments are moved to the
+|param_stack|. (They can't be put on that stack any sooner, because
+the stack is growing and shrinking in unpredictable ways as more arguments
+are being acquired.) Then the macro body is fed to the scanner; i.e.,
+the replacement text of the macro is placed at the top of the \MF's
+input stack, so that |get_next| will proceed to read it next.
+
+@<Declare the procedure called |macro_call|@>=
+@t\4@>@<Declare the procedure called |print_macro_name|@>@;
+@t\4@>@<Declare the procedure called |print_arg|@>@;
+@t\4@>@<Declare the procedure called |scan_text_arg|@>@;
+procedure macro_call(@!def_ref,@!arg_list,@!macro_name:pointer);
+ {invokes a user-defined control sequence}
+label found;
+var @!r:pointer; {current node in the macro's token list}
+@!p,@!q:pointer; {for list manipulation}
+@!n:integer; {the number of arguments}
+@!l_delim,@!r_delim:pointer; {a delimiter pair}
+@!tail:pointer; {tail of the argument list}
+begin r:=link(def_ref); add_mac_ref(def_ref);
+if arg_list=null then n:=0
+else @<Determine the number |n| of arguments already supplied,
+ and set |tail| to the tail of |arg_list|@>;
+if internal[tracing_macros]>0 then
+ @<Show the text of the macro being expanded, and the existing arguments@>;
+@<Scan the remaining arguments, if any; set |r| to the first token
+ of the replacement text@>;
+@<Feed the arguments and replacement text to the scanner@>;
+end;
+
+@ @<Show the text of the macro...@>=
+begin begin_diagnostic; print_ln; print_macro_name(arg_list,macro_name);
+if n=3 then print("@@#"); {indicate a suffixed macro}
+show_macro(def_ref,null,100000);
+if arg_list<>null then
+ begin n:=0; p:=arg_list;
+ repeat q:=info(p);
+ print_arg(q,n,0);
+ incr(n); p:=link(p);
+ until p=null;
+ end;
+end_diagnostic(false);
+end
+
+@ @<Declare the procedure called |print_macro_name|@>=
+procedure print_macro_name(@!a,@!n:pointer);
+var @!p,@!q:pointer; {they traverse the first part of |a|}
+begin if n<>null then slow_print(text(n))
+else begin p:=info(a);
+ if p=null then slow_print(text(info(info(link(a)))))
+ else begin q:=p;
+ while link(q)<>null do q:=link(q);
+ link(q):=info(link(a));
+ show_token_list(p,null,1000,0);
+ link(q):=null;
+ end;
+ end;
+end;
+
+@ @<Declare the procedure called |print_arg|@>=
+procedure print_arg(@!q:pointer;@!n:integer;@!b:pointer);
+begin if link(q)=void then print_nl("(EXPR")
+else if (b<text_base)and(b<>text_macro) then print_nl("(SUFFIX")
+else print_nl("(TEXT");
+print_int(n); print(")<-");
+if link(q)=void then print_exp(q,1)
+else show_token_list(q,null,1000,0);
+end;
+
+@ @<Determine the number |n| of arguments already supplied...@>=
+begin n:=1; tail:=arg_list;
+while link(tail)<>null do
+ begin incr(n); tail:=link(tail);
+ end;
+end
+
+@ @<Scan the remaining arguments, if any; set |r|...@>=
+cur_cmd:=comma+1; {anything |<>comma| will do}
+while info(r)>=expr_base do
+ begin @<Scan the delimited argument represented by |info(r)|@>;
+ r:=link(r);
+ end;
+if cur_cmd=comma then
+ begin print_err("Too many arguments to ");
+@.Too many arguments...@>
+ print_macro_name(arg_list,macro_name); print_char(";");
+ print_nl(" Missing `"); slow_print(text(r_delim));
+@.Missing `)'...@>
+ print("' has been inserted");
+ help3("I'm going to assume that the comma I just read was a")@/
+ ("right delimiter, and then I'll begin expanding the macro.")@/
+ ("You might want to delete some tokens before continuing.");
+ error;
+ end;
+if info(r)<>general_macro then @<Scan undelimited argument(s)@>;
+r:=link(r)
+
+@ At this point, the reader will find it advisable to review the explanation
+of token list format that was presented earlier, paying special attention to
+the conventions that apply only at the beginning of a macro's token list.
+
+On the other hand, the reader will have to take the expression-parsing
+aspects of the following program on faith; we will explain |cur_type|
+and |cur_exp| later. (Several things in this program depend on each other,
+and it's necessary to jump into the circle somewhere.)
+
+@<Scan the delimited argument represented by |info(r)|@>=
+if cur_cmd<>comma then
+ begin get_x_next;
+ if cur_cmd<>left_delimiter then
+ begin print_err("Missing argument to ");
+@.Missing argument...@>
+ print_macro_name(arg_list,macro_name);
+ help3("That macro has more parameters than you thought.")@/
+ ("I'll continue by pretending that each missing argument")@/
+ ("is either zero or null.");
+ if info(r)>=suffix_base then
+ begin cur_exp:=null; cur_type:=token_list;
+ end
+ else begin cur_exp:=0; cur_type:=known;
+ end;
+ back_error; cur_cmd:=right_delimiter; goto found;
+ end;
+ l_delim:=cur_sym; r_delim:=cur_mod;
+ end;
+@<Scan the argument represented by |info(r)|@>;
+if cur_cmd<>comma then @<Check that the proper right delimiter was present@>;
+found: @<Append the current expression to |arg_list|@>
+
+@ @<Check that the proper right delim...@>=
+if (cur_cmd<>right_delimiter)or(cur_mod<>l_delim) then
+ if info(link(r))>=expr_base then
+ begin missing_err(",");
+@.Missing `,'@>
+ help3("I've finished reading a macro argument and am about to")@/
+ ("read another; the arguments weren't delimited correctly.")@/
+ ("You might want to delete some tokens before continuing.");
+ back_error; cur_cmd:=comma;
+ end
+ else begin missing_err(text(r_delim));
+@.Missing `)'@>
+ help2("I've gotten to the end of the macro parameter list.")@/
+ ("You might want to delete some tokens before continuing.");
+ back_error;
+ end
+
+@ A \&{suffix} or \&{text} parameter will be have been scanned as
+a token list pointed to by |cur_exp|, in which case we will have
+|cur_type=token_list|.
+
+@<Append the current expression to |arg_list|@>=
+begin p:=get_avail;
+if cur_type=token_list then info(p):=cur_exp
+else info(p):=stash_cur_exp;
+if internal[tracing_macros]>0 then
+ begin begin_diagnostic; print_arg(info(p),n,info(r)); end_diagnostic(false);
+ end;
+if arg_list=null then arg_list:=p
+else link(tail):=p;
+tail:=p; incr(n);
+end
+
+@ @<Scan the argument represented by |info(r)|@>=
+if info(r)>=text_base then scan_text_arg(l_delim,r_delim)
+else begin get_x_next;
+ if info(r)>=suffix_base then scan_suffix
+ else scan_expression;
+ end
+
+@ The parameters to |scan_text_arg| are either a pair of delimiters
+or zero; the latter case is for undelimited text arguments, which
+end with the first semicolon or \&{endgroup} or \&{end} that is not
+contained in a group.
+
+@<Declare the procedure called |scan_text_arg|@>=
+procedure scan_text_arg(@!l_delim,@!r_delim:pointer);
+label done;
+var @!balance:integer; {excess of |l_delim| over |r_delim|}
+@!p:pointer; {list tail}
+begin warning_info:=l_delim; scanner_status:=absorbing;
+p:=hold_head; balance:=1; link(hold_head):=null;
+loop@+ begin get_next;
+ if l_delim=0 then @<Adjust the balance for an undelimited argument;
+ |goto done| if done@>
+ else @<Adjust the balance for a delimited argument;
+ |goto done| if done@>;
+ link(p):=cur_tok; p:=link(p);
+ end;
+done: cur_exp:=link(hold_head); cur_type:=token_list;
+scanner_status:=normal;
+end;
+
+@ @<Adjust the balance for a delimited argument...@>=
+begin if cur_cmd=right_delimiter then
+ begin if cur_mod=l_delim then
+ begin decr(balance);
+ if balance=0 then goto done;
+ end;
+ end
+else if cur_cmd=left_delimiter then if cur_mod=r_delim then incr(balance);
+end
+
+@ @<Adjust the balance for an undelimited...@>=
+begin if end_of_statement then {|cur_cmd=semicolon|, |end_group|, or |stop|}
+ begin if balance=1 then goto done
+ else if cur_cmd=end_group then decr(balance);
+ end
+else if cur_cmd=begin_group then incr(balance);
+end
+
+@ @<Scan undelimited argument(s)@>=
+begin if info(r)<text_macro then
+ begin get_x_next;
+ if info(r)<>suffix_macro then
+ if (cur_cmd=equals)or(cur_cmd=assignment) then get_x_next;
+ end;
+case info(r) of
+primary_macro:scan_primary;
+secondary_macro:scan_secondary;
+tertiary_macro:scan_tertiary;
+expr_macro:scan_expression;
+of_macro:@<Scan an expression followed by `\&{of} $\langle$primary$\rangle$'@>;
+suffix_macro:@<Scan a suffix with optional delimiters@>;
+text_macro:scan_text_arg(0,0);
+end; {there are no other cases}
+back_input; @<Append the current expression to |arg_list|@>;
+end
+
+@ @<Scan an expression followed by `\&{of} $\langle$primary$\rangle$'@>=
+begin scan_expression; p:=get_avail; info(p):=stash_cur_exp;
+if internal[tracing_macros]>0 then
+ begin begin_diagnostic; print_arg(info(p),n,0); end_diagnostic(false);
+ end;
+if arg_list=null then arg_list:=p@+else link(tail):=p;
+tail:=p;incr(n);
+if cur_cmd<>of_token then
+ begin missing_err("of"); print(" for ");
+@.Missing `of'@>
+ print_macro_name(arg_list,macro_name);
+ help1("I've got the first argument; will look now for the other.");
+ back_error;
+ end;
+get_x_next; scan_primary;
+end
+
+@ @<Scan a suffix with optional delimiters@>=
+begin if cur_cmd<>left_delimiter then l_delim:=null
+else begin l_delim:=cur_sym; r_delim:=cur_mod; get_x_next;
+ end;
+scan_suffix;
+if l_delim<>null then
+ begin if(cur_cmd<>right_delimiter)or(cur_mod<>l_delim) then
+ begin missing_err(text(r_delim));
+@.Missing `)'@>
+ help2("I've gotten to the end of the macro parameter list.")@/
+ ("You might want to delete some tokens before continuing.");
+ back_error;
+ end;
+ get_x_next;
+ end;
+end
+
+@ Before we put a new token list on the input stack, it is wise to clean off
+all token lists that have recently been depleted. Then a user macro that ends
+with a call to itself will not require unbounded stack space.
+
+@<Feed the arguments and replacement text to the scanner@>=
+while token_state and(loc=null) do end_token_list; {conserve stack space}
+if param_ptr+n>max_param_stack then
+ begin max_param_stack:=param_ptr+n;
+ if max_param_stack>param_size then
+ overflow("parameter stack size",param_size);
+@:METAFONT capacity exceeded parameter stack size}{\quad parameter stack size@>
+ end;
+begin_token_list(def_ref,macro); name:=macro_name; loc:=r;
+if n>0 then
+ begin p:=arg_list;
+ repeat param_stack[param_ptr]:=info(p); incr(param_ptr); p:=link(p);
+ until p=null;
+ flush_list(arg_list);
+ end
+
+@ It's sometimes necessary to put a single argument onto |param_stack|.
+The |stack_argument| subroutine does this.
+
+@p procedure stack_argument(@!p:pointer);
+begin if param_ptr=max_param_stack then
+ begin incr(max_param_stack);
+ if max_param_stack>param_size then
+ overflow("parameter stack size",param_size);
+@:METAFONT capacity exceeded parameter stack size}{\quad parameter stack size@>
+ end;
+param_stack[param_ptr]:=p; incr(param_ptr);
+end;
+
+@* \[36] Conditional processing.
+Let's consider now the way \&{if} commands are handled.
+
+Conditions can be inside conditions, and this nesting has a stack
+that is independent of other stacks.
+Four global variables represent the top of the condition stack:
+|cond_ptr| points to pushed-down entries, if~any; |cur_if| tells whether
+we are processing \&{if} or \&{elseif}; |if_limit| specifies
+the largest code of a |fi_or_else| command that is syntactically legal;
+and |if_line| is the line number at which the current conditional began.
+
+If no conditions are currently in progress, the condition stack has the
+special state |cond_ptr=null|, |if_limit=normal|, |cur_if=0|, |if_line=0|.
+Otherwise |cond_ptr| points to a two-word node; the |type|, |name_type|, and
+|link| fields of the first word contain |if_limit|, |cur_if|, and
+|cond_ptr| at the next level, and the second word contains the
+corresponding |if_line|.
+
+@d if_node_size=2 {number of words in stack entry for conditionals}
+@d if_line_field(#)==mem[#+1].int
+@d if_code=1 {code for \&{if} being evaluated}
+@d fi_code=2 {code for \&{fi}}
+@d else_code=3 {code for \&{else}}
+@d else_if_code=4 {code for \&{elseif}}
+
+@<Glob...@>=
+@!cond_ptr:pointer; {top of the condition stack}
+@!if_limit:normal..else_if_code; {upper bound on |fi_or_else| codes}
+@!cur_if:small_number; {type of conditional being worked on}
+@!if_line:integer; {line where that conditional began}
+
+@ @<Set init...@>=
+cond_ptr:=null; if_limit:=normal; cur_if:=0; if_line:=0;
+
+@ @<Put each...@>=
+primitive("if",if_test,if_code);@/
+@!@:if_}{\&{if} primitive@>
+primitive("fi",fi_or_else,fi_code); eqtb[frozen_fi]:=eqtb[cur_sym];@/
+@!@:fi_}{\&{fi} primitive@>
+primitive("else",fi_or_else,else_code);@/
+@!@:else_}{\&{else} primitive@>
+primitive("elseif",fi_or_else,else_if_code);@/
+@!@:else_if_}{\&{elseif} primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+if_test,fi_or_else: case m of
+ if_code:print("if");
+ fi_code:print("fi");
+ else_code:print("else");
+ othercases print("elseif")
+ endcases;
+
+@ Here is a procedure that ignores text until coming to an \&{elseif},
+\&{else}, or \&{fi} at level zero of $\&{if}\ldots\&{fi}$
+nesting. After it has acted, |cur_mod| will indicate the token that
+was found.
+
+\MF's smallest two command codes are |if_test| and |fi_or_else|; this
+makes the skipping process a bit simpler.
+
+@p procedure pass_text;
+label done;
+var l:integer;
+begin scanner_status:=skipping; l:=0; warning_info:=line;
+loop@+ begin get_next;
+ if cur_cmd<=fi_or_else then
+ if cur_cmd<fi_or_else then incr(l)
+ else begin if l=0 then goto done;
+ if cur_mod=fi_code then decr(l);
+ end
+ else @<Decrease the string reference count,
+ if the current token is a string@>;
+ end;
+done: scanner_status:=normal;
+end;
+
+@ @<Decrease the string reference count...@>=
+if cur_cmd=string_token then delete_str_ref(cur_mod)
+
+@ When we begin to process a new \&{if}, we set |if_limit:=if_code|; then
+if \&{elseif} or \&{else} or \&{fi} occurs before the current \&{if}
+condition has been evaluated, a colon will be inserted.
+A construction like `\.{if fi}' would otherwise get \MF\ confused.
+
+@<Push the condition stack@>=
+begin p:=get_node(if_node_size); link(p):=cond_ptr; type(p):=if_limit;
+name_type(p):=cur_if; if_line_field(p):=if_line;
+cond_ptr:=p; if_limit:=if_code; if_line:=line; cur_if:=if_code;
+end
+
+@ @<Pop the condition stack@>=
+begin p:=cond_ptr; if_line:=if_line_field(p);
+cur_if:=name_type(p); if_limit:=type(p); cond_ptr:=link(p);
+free_node(p,if_node_size);
+end
+
+@ Here's a procedure that changes the |if_limit| code corresponding to
+a given value of |cond_ptr|.
+
+@p procedure change_if_limit(@!l:small_number;@!p:pointer);
+label exit;
+var q:pointer;
+begin if p=cond_ptr then if_limit:=l {that's the easy case}
+else begin q:=cond_ptr;
+ loop@+ begin if q=null then confusion("if");
+@:this can't happen if}{\quad if@>
+ if link(q)=p then
+ begin type(q):=l; return;
+ end;
+ q:=link(q);
+ end;
+ end;
+exit:end;
+
+@ The user is supposed to put colons into the proper parts of conditional
+statements. Therefore, \MF\ has to check for their presence.
+
+@p procedure check_colon;
+begin if cur_cmd<>colon then
+ begin missing_err(":");@/
+@.Missing `:'@>
+ help2("There should've been a colon after the condition.")@/
+ ("I shall pretend that one was there.");@;
+ back_error;
+ end;
+end;
+
+@ A condition is started when the |get_x_next| procedure encounters
+an |if_test| command; in that case |get_x_next| calls |conditional|,
+which is a recursive procedure.
+@^recursion@>
+
+@p procedure conditional;
+label exit,done,reswitch,found;
+var @!save_cond_ptr:pointer; {|cond_ptr| corresponding to this conditional}
+@!new_if_limit:fi_code..else_if_code; {future value of |if_limit|}
+@!p:pointer; {temporary register}
+begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
+reswitch: get_boolean; new_if_limit:=else_if_code;
+if internal[tracing_commands]>unity then
+ @<Display the boolean value of |cur_exp|@>;
+found: check_colon;
+if cur_exp=true_code then
+ begin change_if_limit(new_if_limit,save_cond_ptr);
+ return; {wait for \&{elseif}, \&{else}, or \&{fi}}
+ end;
+@<Skip to \&{elseif} or \&{else} or \&{fi}, then |goto done|@>;
+done: cur_if:=cur_mod; if_line:=line;
+if cur_mod=fi_code then @<Pop the condition stack@>
+else if cur_mod=else_if_code then goto reswitch
+else begin cur_exp:=true_code; new_if_limit:=fi_code; get_x_next; goto found;
+ end;
+exit:end;
+
+@ In a construction like `\&{if} \&{if} \&{true}: $0=1$: \\{foo}
+\&{else}: \\{bar} \&{fi}', the first \&{else}
+that we come to after learning that the \&{if} is false is not the
+\&{else} we're looking for. Hence the following curious logic is needed.
+
+@<Skip to \&{elseif}...@>=
+loop@+ begin pass_text;
+ if cond_ptr=save_cond_ptr then goto done
+ else if cur_mod=fi_code then @<Pop the condition stack@>;
+ end
+
+
+@ @<Display the boolean value...@>=
+begin begin_diagnostic;
+if cur_exp=true_code then print("{true}")@+else print("{false}");
+end_diagnostic(false);
+end
+
+@ The processing of conditionals is complete except for the following
+code, which is actually part of |get_x_next|. It comes into play when
+\&{elseif}, \&{else}, or \&{fi} is scanned.
+
+@<Terminate the current conditional and skip to \&{fi}@>=
+if cur_mod>if_limit then
+ if if_limit=if_code then {condition not yet evaluated}
+ begin missing_err(":");
+@.Missing `:'@>
+ back_input; cur_sym:=frozen_colon; ins_error;
+ end
+ else begin print_err("Extra "); print_cmd_mod(fi_or_else,cur_mod);
+@.Extra else@>
+@.Extra elseif@>
+@.Extra fi@>
+ help1("I'm ignoring this; it doesn't match any if.");
+ error;
+ end
+else begin while cur_mod<>fi_code do pass_text; {skip to \&{fi}}
+ @<Pop the condition stack@>;
+ end
+
+@* \[37] Iterations.
+To bring our treatment of |get_x_next| to a close, we need to consider what
+\MF\ does when it sees \&{for}, \&{forsuffixes}, and \&{forever}.
+
+There's a global variable |loop_ptr| that keeps track of the \&{for} loops
+that are currently active. If |loop_ptr=null|, no loops are in progress;
+otherwise |info(loop_ptr)| points to the iterative text of the current
+(innermost) loop, and |link(loop_ptr)| points to the data for any other
+loops that enclose the current one.
+
+A loop-control node also has two other fields, called |loop_type| and
+|loop_list|, whose contents depend on the type of loop:
+
+\yskip\indent|loop_type(loop_ptr)=null| means that |loop_list(loop_ptr)|
+points to a list of one-word nodes whose |info| fields point to the
+remaining argument values of a suffix list and expression list.
+
+\yskip\indent|loop_type(loop_ptr)=void| means that the current loop is
+`\&{forever}'.
+
+\yskip\indent|loop_type(loop_ptr)=p>void| means that |value(p)|,
+|step_size(p)|, and |final_value(p)| contain the data for an arithmetic
+progression.
+
+\yskip\noindent In the latter case, |p| points to a ``progression node''
+whose first word is not used. (No value could be stored there because the
+link field of words in the dynamic memory area cannot be arbitrary.)
+
+@d loop_list_loc(#)==#+1 {where the |loop_list| field resides}
+@d loop_type(#)==info(loop_list_loc(#)) {the type of \&{for} loop}
+@d loop_list(#)==link(loop_list_loc(#)) {the remaining list elements}
+@d loop_node_size=2 {the number of words in a loop control node}
+@d progression_node_size=4 {the number of words in a progression node}
+@d step_size(#)==mem[#+2].sc {the step size in an arithmetic progression}
+@d final_value(#)==mem[#+3].sc {the final value in an arithmetic progression}
+
+@<Glob...@>=
+@!loop_ptr:pointer; {top of the loop-control-node stack}
+
+@ @<Set init...@>=
+loop_ptr:=null;
+
+@ If the expressions that define an arithmetic progression in
+a \&{for} loop don't have known numeric values, the |bad_for|
+subroutine screams at the user.
+
+@p procedure bad_for(@!s:str_number);
+begin disp_err(null,"Improper "); {show the bad expression above the message}
+@.Improper...replaced by 0@>
+print(s); print(" has been replaced by 0");
+help4("When you say `for x=a step b until c',")@/
+ ("the initial value `a' and the step size `b'")@/
+ ("and the final value `c' must have known numeric values.")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+put_get_flush_error(0);
+end;
+
+@ Here's what \MF\ does when \&{for}, \&{forsuffixes}, or \&{forever}
+has just been scanned. (This code requires slight familiarity with
+expression-parsing routines that we have not yet discussed; but it seems
+to belong in the present part of the program, even though the author
+didn't write it until later. The reader may wish to come back to it.)
+
+@p procedure begin_iteration;
+label continue,done,found;
+var @!m:halfword; {|expr_base| (\&{for}) or |suffix_base| (\&{forsuffixes})}
+@!n:halfword; {hash address of the current symbol}
+@!p,@!q,@!s,@!pp:pointer; {link manipulation registers}
+begin m:=cur_mod; n:=cur_sym; s:=get_node(loop_node_size);
+if m=start_forever then
+ begin loop_type(s):=void; p:=null; get_x_next; goto found;
+ end;
+get_symbol; p:=get_node(token_node_size); info(p):=cur_sym; value(p):=m;@/
+get_x_next;
+if (cur_cmd<>equals)and(cur_cmd<>assignment) then
+ begin missing_err("=");@/
+@.Missing `='@>
+ help3("The next thing in this loop should have been `=' or `:='.")@/
+ ("But don't worry; I'll pretend that an equals sign")@/
+ ("was present, and I'll look for the values next.");@/
+ back_error;
+ end;
+@<Scan the values to be used in the loop@>;
+found:@<Check for the presence of a colon@>;
+@<Scan the loop text and put it on the loop control stack@>;
+resume_iteration;
+end;
+
+@ @<Check for the presence of a colon@>=
+if cur_cmd<>colon then
+ begin missing_err(":");@/
+@.Missing `:'@>
+ help3("The next thing in this loop should have been a `:'.")@/
+ ("So I'll pretend that a colon was present;")@/
+ ("everything from here to `endfor' will be iterated.");
+ back_error;
+ end
+
+@ We append a special |frozen_repeat_loop| token in place of the
+`\&{endfor}' at the end of the loop. This will come through \MF's scanner
+at the proper time to cause the loop to be repeated.
+
+(If the user tries some shenanigan like `\&{for} $\ldots$ \&{let} \&{endfor}',
+he will be foiled by the |get_symbol| routine, which keeps frozen
+tokens unchanged. Furthermore the |frozen_repeat_loop| is an \&{outer}
+token, so it won't be lost accidentally.)
+
+@ @<Scan the loop text...@>=
+q:=get_avail; info(q):=frozen_repeat_loop;
+scanner_status:=loop_defining; warning_info:=n;
+info(s):=scan_toks(iteration,p,q,0); scanner_status:=normal;@/
+link(s):=loop_ptr; loop_ptr:=s
+
+@ @<Initialize table...@>=
+eq_type(frozen_repeat_loop):=repeat_loop+outer_tag;
+text(frozen_repeat_loop):=" ENDFOR";
+
+@ The loop text is inserted into \MF's scanning apparatus by the
+|resume_iteration| routine.
+
+@p procedure resume_iteration;
+label not_found,exit;
+var @!p,@!q:pointer; {link registers}
+begin p:=loop_type(loop_ptr);
+if p>void then {|p| points to a progression node}
+ begin cur_exp:=value(p);
+ if @<The arithmetic progression has ended@> then goto not_found;
+ cur_type:=known; q:=stash_cur_exp; {make |q| an \&{expr} argument}
+ value(p):=cur_exp+step_size(p); {set |value(p)| for the next iteration}
+ end
+else if p<void then
+ begin p:=loop_list(loop_ptr);
+ if p=null then goto not_found;
+ loop_list(loop_ptr):=link(p); q:=info(p); free_avail(p);
+ end
+else begin begin_token_list(info(loop_ptr),forever_text); return;
+ end;
+begin_token_list(info(loop_ptr),loop_text);
+stack_argument(q);
+if internal[tracing_commands]>unity then @<Trace the start of a loop@>;
+return;
+not_found:stop_iteration;
+exit:end;
+
+@ @<The arithmetic progression has ended@>=
+((step_size(p)>0)and(cur_exp>final_value(p)))or@|
+ ((step_size(p)<0)and(cur_exp<final_value(p)))
+
+@ @<Trace the start of a loop@>=
+begin begin_diagnostic; print_nl("{loop value=");
+@.loop value=n@>
+if (q<>null)and(link(q)=void) then print_exp(q,1)
+else show_token_list(q,null,50,0);
+print_char("}"); end_diagnostic(false);
+end
+
+@ A level of loop control disappears when |resume_iteration| has decided
+not to resume, or when an \&{exitif} construction has removed the loop text
+from the input stack.
+
+@p procedure stop_iteration;
+var @!p,@!q:pointer; {the usual}
+begin p:=loop_type(loop_ptr);
+if p>void then free_node(p,progression_node_size)
+else if p<void then
+ begin q:=loop_list(loop_ptr);
+ while q<>null do
+ begin p:=info(q);
+ if p<>null then
+ if link(p)=void then {it's an \&{expr} parameter}
+ begin recycle_value(p); free_node(p,value_node_size);
+ end
+ else flush_token_list(p); {it's a \&{suffix} or \&{text} parameter}
+ p:=q; q:=link(q); free_avail(p);
+ end;
+ end;
+p:=loop_ptr; loop_ptr:=link(p); flush_token_list(info(p));
+free_node(p,loop_node_size);
+end;
+
+@ Now that we know all about loop control, we can finish up
+the missing portion of |begin_iteration| and we'll be done.
+
+The following code is performed after the `\.=' has been scanned in
+a \&{for} construction (if |m=expr_base|) or a \&{forsuffixes} construction
+(if |m=suffix_base|).
+
+@<Scan the values to be used in the loop@>=
+loop_type(s):=null; q:=loop_list_loc(s); link(q):=null; {|link(q)=loop_list(s)|}
+repeat get_x_next;
+if m<>expr_base then scan_suffix
+else begin if cur_cmd>=colon then if cur_cmd<=comma then goto continue;
+ scan_expression;
+ if cur_cmd=step_token then if q=loop_list_loc(s) then
+ @<Prepare for step-until construction and |goto done|@>;
+ cur_exp:=stash_cur_exp;
+ end;
+link(q):=get_avail; q:=link(q); info(q):=cur_exp; cur_type:=vacuous;
+continue: until cur_cmd<>comma;
+done:
+
+@ @<Prepare for step-until construction and |goto done|@>=
+begin if cur_type<>known then bad_for("initial value");
+pp:=get_node(progression_node_size); value(pp):=cur_exp;@/
+get_x_next; scan_expression;
+if cur_type<>known then bad_for("step size");
+step_size(pp):=cur_exp;
+if cur_cmd<>until_token then
+ begin missing_err("until");@/
+@.Missing `until'@>
+ help2("I assume you meant to say `until' after `step'.")@/
+ ("So I'll look for the final value and colon next.");
+ back_error;
+ end;
+get_x_next; scan_expression;
+if cur_type<>known then bad_for("final value");
+final_value(pp):=cur_exp; loop_type(s):=pp; goto done;
+end
+
+@* \[38] File names.
+It's time now to fret about file names. Besides the fact that different
+operating systems treat files in different ways, we must cope with the
+fact that completely different naming conventions are used by different
+groups of people. The following programs show what is required for one
+particular operating system; similar routines for other systems are not
+difficult to devise.
+@^system dependencies@>
+
+\MF\ assumes that a file name has three parts: the name proper; its
+``extension''; and a ``file area'' where it is found in an external file
+system. The extension of an input file is assumed to be
+`\.{.mf}' unless otherwise specified; it is `\.{.log}' on the
+transcript file that records each run of \MF; it is `\.{.tfm}' on the font
+metric files that describe characters in the fonts \MF\ creates; it is
+`\.{.gf}' on the output files that specify generic font information; and it
+is `\.{.base}' on the base files written by \.{INIMF} to initialize \MF.
+The file area can be arbitrary on input files, but files are usually
+output to the user's current area. If an input file cannot be
+found on the specified area, \MF\ will look for it on a special system
+area; this special area is intended for commonly used input files.
+
+Simple uses of \MF\ refer only to file names that have no explicit
+extension or area. For example, a person usually says `\.{input} \.{cmr10}'
+instead of `\.{input} \.{cmr10.new}'. Simple file
+names are best, because they make the \MF\ source files portable;
+whenever a file name consists entirely of letters and digits, it should be
+treated in the same way by all implementations of \MF. However, users
+need the ability to refer to other files in their environment, especially
+when responding to error messages concerning unopenable files; therefore
+we want to let them use the syntax that appears in their favorite
+operating system.
+
+@ \MF\ uses the same conventions that have proved to be satisfactory for
+\TeX. In order to isolate the system-dependent aspects of file names, the
+@^system dependencies@>
+system-independent parts of \MF\ are expressed in terms
+of three system-dependent
+procedures called |begin_name|, |more_name|, and |end_name|. In
+essence, if the user-specified characters of the file name are $c_1\ldots c_n$,
+the system-independent driver program does the operations
+$$|begin_name|;\,|more_name|(c_1);\,\ldots\,;|more_name|(c_n);
+\,|end_name|.$$
+These three procedures communicate with each other via global variables.
+Afterwards the file name will appear in the string pool as three strings
+called |cur_name|\penalty10000\hskip-.05em,
+|cur_area|, and |cur_ext|; the latter two are null (i.e.,
+|""|), unless they were explicitly specified by the user.
+
+Actually the situation is slightly more complicated, because \MF\ needs
+to know when the file name ends. The |more_name| routine is a function
+(with side effects) that returns |true| on the calls |more_name|$(c_1)$,
+\dots, |more_name|$(c_{n-1})$. The final call |more_name|$(c_n)$
+returns |false|; or, it returns |true| and $c_n$ is the last character
+on the current input line. In other words,
+|more_name| is supposed to return |true| unless it is sure that the
+file name has been completely scanned; and |end_name| is supposed to be able
+to finish the assembly of |cur_name|, |cur_area|, and |cur_ext| regardless of
+whether $|more_name|(c_n)$ returned |true| or |false|.
+
+@<Glob...@>=
+@!cur_name:str_number; {name of file just scanned}
+@!cur_area:str_number; {file area just scanned, or \.{""}}
+@!cur_ext:str_number; {file extension just scanned, or \.{""}}
+
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters:
+
+@<Glob...@>=
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+
+@ Input files that can't be found in the user's area may appear in a standard
+system area called |MF_area|.
+This system area name will, of course, vary from place to place.
+@^system dependencies@>
+
+@d MF_area=="MFinputs:"
+@.MFinputs@>
+
+@ Here now is the first of the system-dependent routines for file name scanning.
+@^system dependencies@>
+
+@p procedure begin_name;
+begin area_delimiter:=0; ext_delimiter:=0;
+end;
+
+@ And here's the second.
+@^system dependencies@>
+
+@p function more_name(@!c:ASCII_code):boolean;
+begin if c=" " then more_name:=false
+else begin if (c=">")or(c=":") then
+ begin area_delimiter:=pool_ptr; ext_delimiter:=0;
+ end
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr;
+ str_room(1); append_char(c); {contribute |c| to the current string}
+ more_name:=true;
+ end;
+end;
+
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+begin if str_ptr+3>max_str_ptr then
+ begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:METAFONT capacity exceeded number of strings}{\quad number of strings@>
+ max_str_ptr:=str_ptr+3;
+ end;
+if area_delimiter=0 then cur_area:=""
+else begin cur_area:=str_ptr; incr(str_ptr);
+ str_start[str_ptr]:=area_delimiter+1;
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr; incr(str_ptr);
+ str_start[str_ptr]:=ext_delimiter; cur_ext:=make_string;
+ end;
+end;
+
+@ Conversely, here is a routine that takes three strings and prints a file
+name that might have produced them. (The routine is system dependent, because
+some operating systems put the file area last instead of first.)
+@^system dependencies@>
+
+@<Basic printing...@>=
+procedure print_file_name(@!n,@!a,@!e:integer);
+begin slow_print(a); slow_print(n); slow_print(e);
+end;
+
+@ Another system-dependent routine is needed to convert three internal
+\MF\ strings
+to the |name_of_file| value that is used to open files. The present code
+allows both lowercase and uppercase letters in the file name.
+@^system dependencies@>
+
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var @!k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[n] to str_start[n+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[e] to str_start[e+1]-1 do append_to_name(so(str_pool[j]));
+if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+end;
+
+@ A messier routine is also needed, since base file names must be scanned
+before \MF's string mechanism has been initialized. We shall use the
+global variable |MF_base_default| to supply the text for default system areas
+and extensions related to base files.
+@^system dependencies@>
+
+@d base_default_length=18 {length of the |MF_base_default| string}
+@d base_area_length=8 {length of its area part}
+@d base_ext_length=5 {length of its `\.{.base}' part}
+@d base_extension=".base" {the extension, as a \.{WEB} constant}
+
+@<Glob...@>=
+@!MF_base_default:packed array[1..base_default_length] of char;
+
+@ @<Set init...@>=
+MF_base_default:='MFbases:plain.base';
+@.MFbases@>
+@.plain@>
+@^system dependencies@>
+
+@ @<Check the ``constant'' values for consistency@>=
+if base_default_length>file_name_size then bad:=41;
+
+@ Here is the messy routine that was just mentioned. It sets |name_of_file|
+from the first |n| characters of |MF_base_default|, followed by
+|buffer[a..b]|, followed by the last |base_ext_length| characters of
+|MF_base_default|.
+
+We dare not give error messages here, since \MF\ calls this routine before
+the |error| routine is ready to roll. Instead, we simply drop excess characters,
+since the error will be detected in another way when a strange file name
+isn't found.
+@^system dependencies@>
+
+@p procedure pack_buffered_name(@!n:small_number;@!a,@!b:integer);
+var @!k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:integer; {index into |buffer| or |MF_base_default|}
+begin if n+b-a+1+base_ext_length>file_name_size then
+ b:=a+file_name_size-n-1-base_ext_length;
+k:=0;
+for j:=1 to n do append_to_name(xord[MF_base_default[j]]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=base_default_length-base_ext_length+1 to base_default_length do
+ append_to_name(xord[MF_base_default[j]]);
+if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+end;
+
+@ Here is the only place we use |pack_buffered_name|. This part of the program
+becomes active when a ``virgin'' \MF\ is trying to get going, just after
+the preliminary initialization, or when the user is substituting another
+base file by typing `\.\&' after the initial `\.{**}' prompt. The buffer
+contains the first line of input in |buffer[loc..(last-1)]|, where
+|loc<last| and |buffer[loc]<>" "|.
+
+@<Declare the function called |open_base_file|@>=
+function open_base_file:boolean;
+label found,exit;
+var @!j:0..buf_size; {the first space after the file name}
+begin j:=loc;
+if buffer[loc]="&" then
+ begin incr(loc); j:=loc; buffer[last]:=" ";
+ while buffer[j]<>" " do incr(j);
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(base_file) then goto found;
+ pack_buffered_name(base_area_length,loc,j-1);
+ {now try the system base file area}
+ if w_open_in(base_file) then goto found;
+ wake_up_terminal;
+ wterm_ln('Sorry, I can''t find that base;',' will try PLAIN.');
+@.Sorry, I can't find...@>
+ update_terminal;
+ end;
+ {now pull out all the stops: try for the system \.{plain} file}
+pack_buffered_name(base_default_length-base_ext_length,1,0);
+if not w_open_in(base_file) then
+ begin wake_up_terminal;
+ wterm_ln('I can''t find the PLAIN base file!');
+@.I can't find PLAIN...@>
+@.plain@>
+ open_base_file:=false; return;
+ end;
+found:loc:=j; open_base_file:=true;
+exit:end;
+
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine,
+which simply makes a \MF\ string from the value of |name_of_file|, should
+ideally be changed to deduce the full name of file~|f|, which is the file
+most recently opened, if it is possible to do this in a \PASCAL\ program.
+@^system dependencies@>
+
+This routine might be called after string memory has overflowed, hence
+we dare not use `|str_room|'.
+
+@p function make_name_string:str_number;
+var @!k:1..file_name_size; {index into |name_of_file|}
+begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then
+ make_name_string:="?"
+else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+ make_name_string:=make_string;
+ end;
+end;
+function a_make_name_string(var @!f:alpha_file):str_number;
+begin a_make_name_string:=make_name_string;
+end;
+function b_make_name_string(var @!f:byte_file):str_number;
+begin b_make_name_string:=make_name_string;
+end;
+function w_make_name_string(var @!f:word_file):str_number;
+begin w_make_name_string:=make_name_string;
+end;
+
+@ Now let's consider the ``driver''
+routines by which \MF\ deals with file names
+in a system-independent manner. First comes a procedure that looks for a
+file name in the input by taking the information from the input buffer.
+(We can't use |get_next|, because the conversion to tokens would
+destroy necessary information.)
+
+This procedure doesn't allow semicolons or percent signs to be part of
+file names, because of other conventions of \MF. The manual doesn't
+use semicolons or percents immediately after file names, but some users
+no doubt will find it natural to do so; therefore system-dependent
+changes to allow such characters in file names should probably
+be made with reluctance, and only when an entire file name that
+includes special characters is ``quoted'' somehow.
+@^system dependencies@>
+
+@p procedure scan_file_name;
+label done;
+begin begin_name;
+while buffer[loc]=" " do incr(loc);
+loop@+begin if (buffer[loc]=";")or(buffer[loc]="%") then goto done;
+ if not more_name(buffer[loc]) then goto done;
+ incr(loc);
+ end;
+done: end_name;
+end;
+
+@ The global variable |job_name| contains the file name that was first
+\&{input} by the user. This name is extended by `\.{.log}' and `\.{.gf}' and
+`\.{.base}' and `\.{.tfm}' in the names of \MF's output files.
+
+@<Glob...@>=
+@!job_name:str_number; {principal file name}
+@!log_opened:boolean; {has the transcript file been opened?}
+@!log_name:str_number; {full name of the log file}
+
+@ Initially |job_name=0|; it becomes nonzero as soon as the true name is known.
+We have |job_name=0| if and only if the `\.{log}' file has not been opened,
+except of course for a short time just after |job_name| has become nonzero.
+
+@<Initialize the output...@>=job_name:=0; log_opened:=false;
+
+@ Here is a routine that manufactures the output file names, assuming that
+|job_name<>0|. It ignores and changes the current settings of |cur_area|
+and |cur_ext|.
+
+@d pack_cur_name==pack_file_name(cur_name,cur_area,cur_ext)
+
+@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".gf"|,
+ |".tfm"|, or |base_extension|}
+begin cur_area:=""; cur_ext:=s;
+cur_name:=job_name; pack_cur_name;
+end;
+
+@ Actually the main output file extension is usually something like
+|".300gf"| instead of just |".gf"|; the additional number indicates the
+resolution in pixels per inch, based on the setting of |hppp| when
+the file is opened.
+
+@<Glob...@>=
+@!gf_ext:str_number; {default extension for the output file}
+
+@ If some trouble arises when \MF\ tries to open a file, the following
+routine calls upon the user to supply another file name. Parameter~|s|
+is used in the error message to identify the type of file; parameter~|e|
+is the default extension if none is given. Upon exit from the routine,
+variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are
+ready for another attempt at file opening.
+
+@p procedure prompt_file_name(@!s,@!e:str_number);
+label done;
+var @!k:0..buf_size; {index into |buffer|}
+begin if interaction=scroll_mode then wake_up_terminal;
+if s="input file name" then print_err("I can't find file `")
+@.I can't find file x@>
+else print_err("I can't write on file `");
+@.I can't write on file x@>
+print_file_name(cur_name,cur_area,cur_ext); print("'.");
+if e=".mf" then show_context;
+print_nl("Please type another "); print(s);
+@.Please type...@>
+if interaction<scroll_mode then
+ fatal_error("*** (job aborted, file error in nonstop mode)");
+@.job aborted, file error...@>
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+pack_cur_name;
+end;
+
+@ @<Scan file name in the buffer@>=
+begin begin_name; k:=first;
+while (buffer[k]=" ")and(k<last) do incr(k);
+loop@+ begin if k=last then goto done;
+ if not more_name(buffer[k]) then goto done;
+ incr(k);
+ end;
+done:end_name;
+end
+
+@ The |open_log_file| routine is used to open the transcript file and to help
+it catch up to what has previously been printed on the terminal.
+
+@p procedure open_log_file;
+var @!old_setting:0..max_selector; {previous |selector| setting}
+@!k:0..buf_size; {index into |months| and |buffer|}
+@!l:0..buf_size; {end of first input line}
+@!m:integer; {the current month}
+@!months:packed array [1..36] of char; {abbreviations of month names}
+begin old_setting:=selector;
+if job_name=0 then job_name:="mfput";
+@.mfput@>
+pack_job_name(".log");
+while not a_open_out(log_file) do @<Try to get a different log file name@>;
+log_name:=a_make_name_string(log_file);
+selector:=log_only; log_opened:=true;
+@<Print the banner line, including the date and time@>;
+input_stack[input_ptr]:=cur_input; {make sure bottom level is in memory}
+print_nl("**");
+@.**@>
+l:=input_stack[0].limit_field-1; {last position of first line}
+for k:=1 to l do print(buffer[k]);
+print_ln; {now the transcript file contains the first line of input}
+selector:=old_setting+2; {|log_only| or |term_and_log|}
+end;
+
+@ Sometimes |open_log_file| is called at awkward moments when \MF\ is
+unable to print error messages or even to |show_context|.
+The |prompt_file_name| routine can result in a |fatal_error|, but the |error|
+routine will not be invoked because |log_opened| will be false.
+
+The normal idea of |batch_mode| is that nothing at all should be written
+on the terminal. However, in the unusual case that
+no log file could be opened, we make an exception and allow
+an explanatory message to be seen.
+
+Incidentally, the program always refers to the log file as a `\.{transcript
+file}', because some systems cannot use the extension `\.{.log}' for
+this file.
+
+@<Try to get a different log file name@>=
+begin selector:=term_only;
+prompt_file_name("transcript file name",".log");
+end
+
+@ @<Print the banner...@>=
+begin wlog(banner);
+slow_print(base_ident); print(" ");
+print_int(round_unscaled(internal[day])); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+m:=round_unscaled(internal[month]);
+for k:=3*m-2 to 3*m do wlog(months[k]);
+print_char(" "); print_int(round_unscaled(internal[year])); print_char(" ");
+m:=round_unscaled(internal[time]);
+print_dd(m div 60); print_char(":"); print_dd(m mod 60);
+end
+
+@ Here's an example of how these file-name-parsing routines work in practice.
+We shall use the macro |set_output_file_name| when it is time to
+crank up the output file.
+
+@d set_output_file_name==
+ begin if job_name=0 then open_log_file;
+ pack_job_name(gf_ext);
+ while not b_open_out(gf_file) do
+ prompt_file_name("file name for output",gf_ext);
+ output_file_name:=b_make_name_string(gf_file);
+ end
+
+@<Glob...@>=
+@!gf_file: byte_file; {the generic font output goes here}
+@!output_file_name: str_number; {full name of the output file}
+
+@ @<Initialize the output...@>=output_file_name:=0;
+
+@ Let's turn now to the procedure that is used to initiate file reading
+when an `\.{input}' command is being processed.
+
+@p procedure start_input; {\MF\ will \.{input} something}
+label done;
+begin @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>;
+if cur_ext="" then cur_ext:=".mf";
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,MF_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+ end_file_reading; {remove the level that didn't work}
+ prompt_file_name("input file name",".mf");
+ end;
+done: name:=a_make_name_string(cur_file); str_ref[cur_name]:=max_str_ref;
+if job_name=0 then
+ begin job_name:=cur_name; open_log_file;
+ end; {|open_log_file| doesn't |show_context|, so |limit|
+ and |loc| needn't be set to meaningful values yet}
+if term_offset+length(name)>max_print_line-2 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("("); incr(open_parens); slow_print(name); update_terminal;
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string(name); name:=cur_name;
+ end;
+@<Read the first line of the new file@>;
+end;
+
+@ Here we have to remember to tell the |input_ln| routine not to
+start with a |get|. If the file is empty, it is considered to
+contain a single blank line.
+@^system dependencies@>
+
+@<Read the first line...@>=
+begin line:=1;
+if input_ln(cur_file,false) then do_nothing;
+firm_up_the_line;
+buffer[limit]:="%"; first:=limit+1; loc:=start;
+end
+
+@ @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>=
+while token_state and(loc=null) do end_token_list;
+if token_state then
+ begin print_err("File names can't appear within macros");
+@.File names can't...@>
+ help3("Sorry...I've converted what follows to tokens,")@/
+ ("possibly garbaging the name you gave.")@/
+ ("Please delete the tokens and insert the name again.");@/
+ error;
+ end;
+if file_state then scan_file_name
+else begin cur_name:=""; cur_ext:=""; cur_area:="";
+ end
+
+@* \[39] Introduction to the parsing routines.
+We come now to the central nervous system that sparks many of \MF's activities.
+By evaluating expressions, from their primary constituents to ever larger
+subexpressions, \MF\ builds the structures that ultimately define fonts of type.
+
+Four mutually recursive subroutines are involved in this process: We call them
+$$\hbox{|scan_primary|, |scan_secondary|, |scan_tertiary|,
+and |scan_expression|.}$$
+@^recursion@>
+Each of them is parameterless and begins with the first token to be scanned
+already represented in |cur_cmd|, |cur_mod|, and |cur_sym|. After execution,
+the value of the primary or secondary or tertiary or expression that was
+found will appear in the global variables |cur_type| and |cur_exp|. The
+token following the expression will be represented in |cur_cmd|, |cur_mod|,
+and |cur_sym|.
+
+Technically speaking, the parsing algorithms are ``LL(1),'' more or less;
+backup mechanisms have been added in order to provide reasonable error
+recovery.
+
+@<Glob...@>=
+@!cur_type:small_number; {the type of the expression just found}
+@!cur_exp:integer; {the value of the expression just found}
+
+@ @<Set init...@>=
+cur_exp:=0;
+
+@ Many different kinds of expressions are possible, so it is wise to have
+precise descriptions of what |cur_type| and |cur_exp| mean in all cases:
+
+\smallskip\hang
+|cur_type=vacuous| means that this expression didn't turn out to have a
+value at all, because it arose from a \&{begingroup}$\,\ldots\,$\&{endgroup}
+construction in which there was no expression before the \&{endgroup}.
+In this case |cur_exp| has some irrelevant value.
+
+\smallskip\hang
+|cur_type=boolean_type| means that |cur_exp| is either |true_code|
+or |false_code|.
+
+\smallskip\hang
+|cur_type=unknown_boolean| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined boolean variable.
+
+\smallskip\hang
+|cur_type=string_type| means that |cur_exp| is a string number (i.e., an
+integer in the range |0<=cur_exp<str_ptr|). That string's reference count
+includes this particular reference.
+
+\smallskip\hang
+|cur_type=unknown_string| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined string variable.
+
+\smallskip\hang
+|cur_type=pen_type| means that |cur_exp| points to a pen header node. This
+node contains a reference count, which takes account of this particular
+reference.
+
+\smallskip\hang
+|cur_type=unknown_pen| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined pen variable.
+
+\smallskip\hang
+|cur_type=future_pen| means that |cur_exp| points to a knot list that
+should eventually be made into a pen. Nobody else points to this particular
+knot list. The |future_pen| option occurs only as an output of |scan_primary|
+and |scan_secondary|, not as an output of |scan_tertiary| or |scan_expression|.
+
+\smallskip\hang
+|cur_type=path_type| means that |cur_exp| points to a the first node of
+a path; nobody else points to this particular path. The control points of
+the path will have been chosen.
+
+\smallskip\hang
+|cur_type=unknown_path| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined path variable.
+
+\smallskip\hang
+|cur_type=picture_type| means that |cur_exp| points to an edges header node.
+Nobody else points to this particular set of edges.
+
+\smallskip\hang
+|cur_type=unknown_picture| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined picture variable.
+
+\smallskip\hang
+|cur_type=transform_type| means that |cur_exp| points to a |transform_type|
+capsule node. The |value| part of this capsule
+points to a transform node that contains six numeric values,
+each of which is |independent|, |dependent|, |proto_dependent|, or |known|.
+
+\smallskip\hang
+|cur_type=pair_type| means that |cur_exp| points to a capsule
+node whose type is |pair_type|. The |value| part of this capsule
+points to a pair node that contains two numeric values,
+each of which is |independent|, |dependent|, |proto_dependent|, or |known|.
+
+\smallskip\hang
+|cur_type=known| means that |cur_exp| is a |scaled| value.
+
+\smallskip\hang
+|cur_type=dependent| means that |cur_exp| points to a capsule node whose type
+is |dependent|. The |dep_list| field in this capsule points to the associated
+dependency list.
+
+\smallskip\hang
+|cur_type=proto_dependent| means that |cur_exp| points to a |proto_dependent|
+capsule node . The |dep_list| field in this capsule
+points to the associated dependency list.
+
+\smallskip\hang
+|cur_type=independent| means that |cur_exp| points to a capsule node
+whose type is |independent|. This somewhat unusual case can arise, for
+example, in the expression
+`$x+\&{begingroup}\penalty0\,\&{string}\,x; 0\,\&{endgroup}$'.
+
+\smallskip\hang
+|cur_type=token_list| means that |cur_exp| points to a linked list of
+tokens. This case arises only on the left-hand side of an assignment
+(`\.{:=}') operation, under very special circumstances.
+
+\smallskip\noindent
+The possible settings of |cur_type| have been listed here in increasing
+numerical order. Notice that |cur_type| will never be |numeric_type| or
+|suffixed_macro| or |unsuffixed_macro|, although variables of those types
+are allowed. Conversely, \MF\ has no variables of type |vacuous| or
+|token_list|.
+
+@ Capsules are two-word nodes that have a similar meaning
+to |cur_type| and |cur_exp|. Such nodes have |name_type=capsule|
+and |link<=void|; and their |type| field is one of the possibilities for
+|cur_type| listed above.
+
+The |value| field of a capsule is, in most cases, the value that
+corresponds to its |type|, as |cur_exp| corresponds to |cur_type|.
+However, when |cur_exp| would point to a capsule,
+no extra layer of indirection is present; the |value|
+field is what would have been called |value(cur_exp)| if it had not been
+encapsulated. Furthermore, if the type is |dependent| or
+|proto_dependent|, the |value| field of a capsule is replaced by
+|dep_list| and |prev_dep| fields, since dependency lists in capsules are
+always part of the general |dep_list| structure.
+
+The |get_x_next| routine is careful not to change the values of |cur_type|
+and |cur_exp| when it gets an expanded token. However, |get_x_next| might
+call a macro, which might parse an expression, which might execute lots of
+commands in a group; hence it's possible that |cur_type| might change
+from, say, |unknown_boolean| to |boolean_type|, or from |dependent| to
+|known| or |independent|, during the time |get_x_next| is called. The
+programs below are careful to stash sensitive intermediate results in
+capsules, so that \MF's generality doesn't cause trouble.
+
+Here's a procedure that illustrates these conventions. It takes
+the contents of $(|cur_type|\kern-.3pt,|cur_exp|\kern-.3pt)$
+and stashes them away in a
+capsule. It is not used when |cur_type=token_list|.
+After the operation, |cur_type=vacuous|; hence there is no need to
+copy path lists or to update reference counts, etc.
+
+The special link |void| is put on the capsule returned by
+|stash_cur_exp|, because this procedure is used to store macro parameters
+that must be easily distinguishable from token lists.
+
+@<Declare the stashing/unstashing routines@>=
+function stash_cur_exp:pointer;
+var @!p:pointer; {the capsule that will be returned}
+begin case cur_type of
+unknown_types,transform_type,pair_type,dependent,proto_dependent,
+ independent:p:=cur_exp;
+othercases begin p:=get_node(value_node_size); name_type(p):=capsule;
+ type(p):=cur_type; value(p):=cur_exp;
+ end
+endcases;@/
+cur_type:=vacuous; link(p):=void; stash_cur_exp:=p;
+end;
+
+@ The inverse of |stash_cur_exp| is the following procedure, which
+deletes an unnecessary capsule and puts its contents into |cur_type|
+and |cur_exp|.
+
+The program steps of \MF\ can be divided into two categories: those in
+which |cur_type| and |cur_exp| are ``alive'' and those in which they are
+``dead,'' in the sense that |cur_type| and |cur_exp| contain relevant
+information or not. It's important not to ignore them when they're alive,
+and it's important not to pay attention to them when they're dead.
+
+There's also an intermediate category: If |cur_type=vacuous|, then
+|cur_exp| is irrelevant, hence we can proceed without caring if |cur_type|
+and |cur_exp| are alive or dead. In such cases we say that |cur_type|
+and |cur_exp| are {\sl dormant}. It is permissible to call |get_x_next|
+only when they are alive or dormant.
+
+The \\{stash} procedure above assumes that |cur_type| and |cur_exp|
+are alive or dormant. The \\{unstash} procedure assumes that they are
+dead or dormant; it resuscitates them.
+
+@<Declare the stashing/unstashing...@>=
+procedure unstash_cur_exp(@!p:pointer);
+begin cur_type:=type(p);
+case cur_type of
+unknown_types,transform_type,pair_type,dependent,proto_dependent,
+ independent: cur_exp:=p;
+othercases begin cur_exp:=value(p);
+ free_node(p,value_node_size);
+ end
+endcases;@/
+end;
+
+@ The following procedure prints the values of expressions in an
+abbreviated format. If its first parameter |p| is null, the value of
+|(cur_type,cur_exp)| is displayed; otherwise |p| should be a capsule
+containing the desired value. The second parameter controls the amount of
+output. If it is~0, dependency lists will be abbreviated to
+`\.{linearform}' unless they consist of a single term. If it is greater
+than~1, complicated structures (pens, pictures, and paths) will be displayed
+in full.
+
+@<Declare subroutines for printing expressions@>=
+@t\4@>@<Declare the procedure called |print_dp|@>@;
+@t\4@>@<Declare the stashing/unstashing routines@>@;
+procedure print_exp(@!p:pointer;@!verbosity:small_number);
+var @!restore_cur_exp:boolean; {should |cur_exp| be restored?}
+@!t:small_number; {the type of the expression}
+@!v:integer; {the value of the expression}
+@!q:pointer; {a big node being displayed}
+begin if p<>null then restore_cur_exp:=false
+else begin p:=stash_cur_exp; restore_cur_exp:=true;
+ end;
+t:=type(p);
+if t<dependent then v:=value(p)@+else if t<independent then v:=dep_list(p);
+@<Print an abbreviated value of |v| with format depending on |t|@>;
+if restore_cur_exp then unstash_cur_exp(p);
+end;
+
+@ @<Print an abbreviated value of |v| with format depending on |t|@>=
+case t of
+vacuous:print("vacuous");
+boolean_type:if v=true_code then print("true")@+else print("false");
+unknown_types,numeric_type:@<Display a variable
+ that's been declared but not defined@>;
+string_type:begin print_char(""""); slow_print(v); print_char("""");
+ end;
+pen_type,future_pen,path_type,picture_type:@<Display a complex type@>;
+transform_type,pair_type:if v=null then print_type(t)
+ else @<Display a big node@>;
+known:print_scaled(v);
+dependent,proto_dependent:print_dp(t,v,verbosity);
+independent:print_variable_name(p);
+othercases confusion("exp")
+@:this can't happen exp}{\quad exp@>
+endcases
+
+@ @<Display a big node@>=
+begin print_char("("); q:=v+big_node_size[t];
+repeat if type(v)=known then print_scaled(value(v))
+else if type(v)=independent then print_variable_name(v)
+else print_dp(type(v),dep_list(v),verbosity);
+v:=v+2;
+if v<>q then print_char(",");
+until v=q;
+print_char(")");
+end
+
+@ Values of type \&{picture}, \&{path}, and \&{pen} are displayed verbosely
+in the log file only, unless the user has given a positive value to
+\\{tracingonline}.
+
+@<Display a complex type@>=
+if verbosity<=1 then print_type(t)
+else begin if selector=term_and_log then
+ if internal[tracing_online]<=0 then
+ begin selector:=term_only;
+ print_type(t); print(" (see the transcript file)");
+ selector:=term_and_log;
+ end;
+ case t of
+ pen_type:print_pen(v,"",false);
+ future_pen:print_path(v," (future pen)",false);
+ path_type:print_path(v,"",false);
+ picture_type:begin cur_edges:=v; print_edges("",false,0,0);
+ end;
+ end; {there are no other cases}
+ end
+
+@ @<Declare the procedure called |print_dp|@>=
+procedure print_dp(@!t:small_number;@!p:pointer;@!verbosity:small_number);
+var @!q:pointer; {the node following |p|}
+begin q:=link(p);
+if (info(q)=null) or (verbosity>0) then print_dependency(p,t)
+else print("linearform");
+end;
+
+@ The displayed name of a variable in a ring will not be a capsule unless
+the ring consists entirely of capsules.
+
+@<Display a variable that's been declared but not defined@>=
+begin print_type(t);
+if v<>null then
+ begin print_char(" ");
+ while (name_type(v)=capsule) and (v<>p) do v:=value(v);
+ print_variable_name(v);
+ end;
+end
+
+@ When errors are detected during parsing, it is often helpful to
+display an expression just above the error message, using |exp_err|
+or |disp_err| instead of |print_err|.
+
+@d exp_err(#)==disp_err(null,#) {displays the current expression}
+
+@<Declare subroutines for printing expressions@>=
+procedure disp_err(@!p:pointer;@!s:str_number);
+begin if interaction=error_stop_mode then wake_up_terminal;
+print_nl(">> ");
+@.>>@>
+print_exp(p,1); {``medium verbose'' printing of the expression}
+if s<>"" then
+ begin print_nl("! "); print(s);
+@.!\relax@>
+ end;
+end;
+
+@ If |cur_type| and |cur_exp| contain relevant information that should
+be recycled, we will use the following procedure, which changes |cur_type|
+to |known| and stores a given value in |cur_exp|. We can think of |cur_type|
+and |cur_exp| as either alive or dormant after this has been done,
+because |cur_exp| will not contain a pointer value.
+
+@<Declare the procedure called |flush_cur_exp|@>=
+procedure flush_cur_exp(@!v:scaled);
+begin case cur_type of
+unknown_types,transform_type,pair_type,@|dependent,proto_dependent,independent:
+ begin recycle_value(cur_exp); free_node(cur_exp,value_node_size);
+ end;
+pen_type: delete_pen_ref(cur_exp);
+string_type:delete_str_ref(cur_exp);
+future_pen,path_type: toss_knot_list(cur_exp);
+picture_type:toss_edges(cur_exp);
+othercases do_nothing
+endcases;@/
+cur_type:=known; cur_exp:=v;
+end;
+
+@ There's a much more general procedure that is capable of releasing
+the storage associated with any two-word value packet.
+
+@<Declare the recycling subroutines@>=
+procedure recycle_value(@!p:pointer);
+label done;
+var @!t:small_number; {a type code}
+@!v:integer; {a value}
+@!vv:integer; {another value}
+@!q,@!r,@!s,@!pp:pointer; {link manipulation registers}
+begin t:=type(p);
+if t<dependent then v:=value(p);
+case t of
+undefined,vacuous,boolean_type,known,numeric_type:do_nothing;
+unknown_types:ring_delete(p);
+string_type:delete_str_ref(v);
+pen_type:delete_pen_ref(v);
+path_type,future_pen:toss_knot_list(v);
+picture_type:toss_edges(v);
+pair_type,transform_type:@<Recycle a big node@>;
+dependent,proto_dependent:@<Recycle a dependency list@>;
+independent:@<Recycle an independent variable@>;
+token_list,structured:confusion("recycle");
+@:this can't happen recycle}{\quad recycle@>
+unsuffixed_macro,suffixed_macro:delete_mac_ref(value(p));
+end; {there are no other cases}
+type(p):=undefined;
+end;
+
+@ @<Recycle a big node@>=
+if v<>null then
+ begin q:=v+big_node_size[t];
+ repeat q:=q-2; recycle_value(q);
+ until q=v;
+ free_node(v,big_node_size[t]);
+ end
+
+@ @<Recycle a dependency list@>=
+begin q:=dep_list(p);
+while info(q)<>null do q:=link(q);
+link(prev_dep(p)):=link(q);
+prev_dep(link(q)):=prev_dep(p);
+link(q):=null; flush_node_list(dep_list(p));
+end
+
+@ When an independent variable disappears, it simply fades away, unless
+something depends on it. In the latter case, a dependent variable whose
+coefficient of dependence is maximal will take its place.
+The relevant algorithm is due to Ignacio~A. Zabala, who implemented it
+as part of his Ph.D. thesis (Stanford University, December 1982).
+@^Zabala Salelles, Ignacio Andres@>
+
+For example, suppose that variable $x$ is being recycled, and that the
+only variables depending on~$x$ are $y=2x+a$ and $z=x+b$. In this case
+we want to make $y$ independent and $z=.5y-.5a+b$; no other variables
+will depend on~$y$. If $\\{tracingequations}>0$ in this situation,
+we will print `\.{\#\#\# -2x=-y+a}'.
+
+There's a slight complication, however: An independent variable $x$
+can occur both in dependency lists and in proto-dependency lists.
+This makes it necessary to be careful when deciding which coefficient
+is maximal.
+
+Furthermore, this complication is not so slight when
+a proto-dependent variable is chosen to become independent. For example,
+suppose that $y=2x+100a$ is proto-dependent while $z=x+b$ is dependent;
+then we must change $z=.5y-50a+b$ to a proto-dependency, because of the
+large coefficient `50'.
+
+In order to deal with these complications without wasting too much time,
+we shall link together the occurrences of~$x$ among all the linear
+dependencies, maintaining separate lists for the dependent and
+proto-dependent cases.
+
+@<Recycle an independent variable@>=
+begin max_c[dependent]:=0; max_c[proto_dependent]:=0;@/
+max_link[dependent]:=null; max_link[proto_dependent]:=null;@/
+q:=link(dep_head);
+while q<>dep_head do
+ begin s:=value_loc(q); {now |link(s)=dep_list(q)|}
+ loop@+ begin r:=link(s);
+ if info(r)=null then goto done;
+ if info(r)<>p then s:=r
+ else begin t:=type(q); link(s):=link(r); info(r):=q;
+ if abs(value(r))>max_c[t] then
+ @<Record a new maximum coefficient of type |t|@>
+ else begin link(r):=max_link[t]; max_link[t]:=r;
+ end;
+ end;
+ end;
+done: q:=link(r);
+ end;
+if (max_c[dependent]>0)or(max_c[proto_dependent]>0) then
+ @<Choose a dependent variable to take the place of the disappearing
+ independent variable, and change all remaining dependencies
+ accordingly@>;
+end
+
+@ The code for independency removal makes use of three two-word arrays.
+
+@<Glob...@>=
+@!max_c:array[dependent..proto_dependent] of integer;
+ {max coefficient magnitude}
+@!max_ptr:array[dependent..proto_dependent] of pointer;
+ {where |p| occurs with |max_c|}
+@!max_link:array[dependent..proto_dependent] of pointer;
+ {other occurrences of |p|}
+
+@ @<Record a new maximum coefficient...@>=
+begin if max_c[t]>0 then
+ begin link(max_ptr[t]):=max_link[t]; max_link[t]:=max_ptr[t];
+ end;
+max_c[t]:=abs(value(r)); max_ptr[t]:=r;
+end
+
+@ @<Choose a dependent...@>=
+begin if (max_c[dependent] div @'10000 >=
+ max_c[proto_dependent]) then
+ t:=dependent
+else t:=proto_dependent;
+@<Determine the dependency list |s| to substitute for the independent
+ variable~|p|@>;
+t:=dependent+proto_dependent-t; {complement |t|}
+if max_c[t]>0 then {we need to pick up an unchosen dependency}
+ begin link(max_ptr[t]):=max_link[t]; max_link[t]:=max_ptr[t];
+ end;
+if t<>dependent then @<Substitute new dependencies in place of |p|@>
+else @<Substitute new proto-dependencies in place of |p|@>;
+flush_node_list(s);
+if fix_needed then fix_dependencies;
+check_arith;
+end
+
+@ Let |s=max_ptr[t]|. At this point we have $|value|(s)=\pm|max_c|[t]$,
+and |info(s)| points to the dependent variable~|pp| of type~|t| from
+whose dependency list we have removed node~|s|. We must reinsert
+node~|s| into the dependency list, with coefficient $-1.0$, and with
+|pp| as the new independent variable. Since |pp| will have a larger serial
+number than any other variable, we can put node |s| at the head of the
+list.
+
+@<Determine the dep...@>=
+s:=max_ptr[t]; pp:=info(s); v:=value(s);
+if t=dependent then value(s):=-fraction_one@+else value(s):=-unity;
+r:=dep_list(pp); link(s):=r;
+while info(r)<>null do r:=link(r);
+q:=link(r); link(r):=null;
+prev_dep(q):=prev_dep(pp); link(prev_dep(pp)):=q;
+new_indep(pp);
+if cur_exp=pp then if cur_type=t then cur_type:=independent;
+if internal[tracing_equations]>0 then @<Show the transformed dependency@>
+
+@ Now $(-v)$ times the formerly independent variable~|p| is being replaced
+by the dependency list~|s|.
+
+@<Show the transformed...@>=
+if interesting(p) then
+ begin begin_diagnostic; print_nl("### ");
+@:]]]\#\#\#_}{\.{\#\#\#}@>
+ if v>0 then print_char("-");
+ if t=dependent then vv:=round_fraction(max_c[dependent])
+ else vv:=max_c[proto_dependent];
+ if vv<>unity then print_scaled(vv);
+ print_variable_name(p);
+ while value(p) mod s_scale>0 do
+ begin print("*4"); value(p):=value(p)-2;
+ end;
+ if t=dependent then print_char("=")@+else print(" = ");
+ print_dependency(s,t);
+ end_diagnostic(false);
+ end
+
+@ Finally, there are dependent and proto-dependent variables whose
+dependency lists must be brought up to date.
+
+@<Substitute new dependencies...@>=
+for t:=dependent to proto_dependent do
+ begin r:=max_link[t];
+ while r<>null do
+ begin q:=info(r);
+ dep_list(q):=p_plus_fq(dep_list(q),@|
+ make_fraction(value(r),-v),s,t,dependent);
+ if dep_list(q)=dep_final then make_known(q,dep_final);
+ q:=r; r:=link(r); free_node(q,dep_node_size);
+ end;
+ end
+
+@ @<Substitute new proto...@>=
+for t:=dependent to proto_dependent do
+ begin r:=max_link[t];
+ while r<>null do
+ begin q:=info(r);
+ if t=dependent then {for safety's sake, we change |q| to |proto_dependent|}
+ begin if cur_exp=q then if cur_type=dependent then
+ cur_type:=proto_dependent;
+ dep_list(q):=p_over_v(dep_list(q),unity,dependent,proto_dependent);
+ type(q):=proto_dependent; value(r):=round_fraction(value(r));
+ end;
+ dep_list(q):=p_plus_fq(dep_list(q),@|
+ make_scaled(value(r),-v),s,proto_dependent,proto_dependent);
+ if dep_list(q)=dep_final then make_known(q,dep_final);
+ q:=r; r:=link(r); free_node(q,dep_node_size);
+ end;
+ end
+
+@ Here are some routines that provide handy combinations of actions
+that are often needed during error recovery. For example,
+`|flush_error|' flushes the current expression, replaces it by
+a given value, and calls |error|.
+
+Errors often are detected after an extra token has already been scanned.
+The `\\{put\_get}' routines put that token back before calling |error|;
+then they get it back again. (Or perhaps they get another token, if
+the user has changed things.)
+
+@<Declare the procedure called |flush_cur_exp|@>=
+procedure flush_error(@!v:scaled);@+begin error; flush_cur_exp(v);@+end;
+@#
+procedure@?back_error; forward;@t\2@>@/
+procedure@?get_x_next; forward;@t\2@>@/
+@#
+procedure put_get_error;@+begin back_error; get_x_next;@+end;
+@#
+procedure put_get_flush_error(@!v:scaled);@+begin put_get_error;
+ flush_cur_exp(v);@+end;
+
+@ A global variable called |var_flag| is set to a special command code
+just before \MF\ calls |scan_expression|, if the expression should be
+treated as a variable when this command code immediately follows. For
+example, |var_flag| is set to |assignment| at the beginning of a
+statement, because we want to know the {\sl location\/} of a variable at
+the left of `\.{:=}', not the {\sl value\/} of that variable.
+
+The |scan_expression| subroutine calls |scan_tertiary|,
+which calls |scan_secondary|, which calls |scan_primary|, which sets
+|var_flag:=0|. In this way each of the scanning routines ``knows''
+when it has been called with a special |var_flag|, but |var_flag| is
+usually zero.
+
+A variable preceding a command that equals |var_flag| is converted to a
+token list rather than a value. Furthermore, an `\.{=}' sign following an
+expression with |var_flag=assignment| is not considered to be a relation
+that produces boolean expressions.
+
+
+@<Glob...@>=
+@!var_flag:0..max_command_code; {command that wants a variable}
+
+@ @<Set init...@>=
+var_flag:=0;
+
+@* \[40] Parsing primary expressions.
+The first parsing routine, |scan_primary|, is also the most complicated one,
+since it involves so many different cases. But each case---with one
+exception---is fairly simple by itself.
+
+When |scan_primary| begins, the first token of the primary to be scanned
+should already appear in |cur_cmd|, |cur_mod|, and |cur_sym|. The values
+of |cur_type| and |cur_exp| should be either dead or dormant, as explained
+earlier. If |cur_cmd| is not between |min_primary_command| and
+|max_primary_command|, inclusive, a syntax error will be signalled.
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_primary;
+label restart, done, done1, done2;
+var @!p,@!q,@!r:pointer; {for list manipulation}
+@!c:quarterword; {a primitive operation code}
+@!my_var_flag:0..max_command_code; {initial value of |my_var_flag|}
+@!l_delim,@!r_delim:pointer; {hash addresses of a delimiter pair}
+@<Other local variables for |scan_primary|@>@;
+begin my_var_flag:=var_flag; var_flag:=0;
+restart:check_arith;
+@<Supply diagnostic information, if requested@>;
+case cur_cmd of
+left_delimiter:@<Scan a delimited primary@>;
+begin_group:@<Scan a grouped primary@>;
+string_token:@<Scan a string constant@>;
+numeric_token:@<Scan a primary that starts with a numeric token@>;
+nullary:@<Scan a nullary operation@>;
+unary,type_name,cycle,plus_or_minus:@<Scan a unary operation@>;
+primary_binary:@<Scan a binary operation with `\&{of}' between its operands@>;
+str_op:@<Convert a suffix to a string@>;
+internal_quantity:@<Scan an internal numeric quantity@>;
+capsule_token:make_exp_copy(cur_mod);
+tag_token:@<Scan a variable primary;
+ |goto restart| if it turns out to be a macro@>;
+othercases begin bad_exp("A primary"); goto restart;
+@.A primary expression...@>
+ end
+endcases;@/
+get_x_next; {the routines |goto done| if they don't want this}
+done: if cur_cmd=left_bracket then
+ if cur_type>=known then @<Scan a mediation construction@>;
+end;
+
+@ Errors at the beginning of expressions are flagged by |bad_exp|.
+
+@p procedure bad_exp(@!s:str_number);
+var save_flag:0..max_command_code;
+begin print_err(s); print(" expression can't begin with `");
+print_cmd_mod(cur_cmd,cur_mod); print_char("'");
+help4("I'm afraid I need some sort of value in order to continue,")@/
+ ("so I've tentatively inserted `0'. You may want to")@/
+ ("delete this zero and insert something else;")@/
+ ("see Chapter 27 of The METAFONTbook for an example.");
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+back_input; cur_sym:=0; cur_cmd:=numeric_token; cur_mod:=0; ins_error;@/
+save_flag:=var_flag; var_flag:=0; get_x_next;
+var_flag:=save_flag;
+end;
+
+@ @<Supply diagnostic information, if requested@>=
+debug if panicking then check_mem(false);@+gubed@;@/
+if interrupt<>0 then if OK_to_interrupt then
+ begin back_input; check_interrupt; get_x_next;
+ end
+
+@ @<Scan a delimited primary@>=
+begin l_delim:=cur_sym; r_delim:=cur_mod; get_x_next; scan_expression;
+if (cur_cmd=comma) and (cur_type>=known) then
+ @<Scan the second of a pair of numerics@>
+else check_delimiter(l_delim,r_delim);
+end
+
+@ The |stash_in| subroutine puts the current (numeric) expression into a field
+within a ``big node.''
+
+@p procedure stash_in(@!p:pointer);
+var @!q:pointer; {temporary register}
+begin type(p):=cur_type;
+if cur_type=known then value(p):=cur_exp
+else begin if cur_type=independent then
+ @<Stash an independent |cur_exp| into a big node@>
+ else begin mem[value_loc(p)]:=mem[value_loc(cur_exp)];
+ {|dep_list(p):=dep_list(cur_exp)| and |prev_dep(p):=prev_dep(cur_exp)|}
+ link(prev_dep(p)):=p;
+ end;
+ free_node(cur_exp,value_node_size);
+ end;
+cur_type:=vacuous;
+end;
+
+@ In rare cases the current expression can become |independent|. There
+may be many dependency lists pointing to such an independent capsule,
+so we can't simply move it into place within a big node. Instead,
+we copy it, then recycle it.
+
+@ @<Stash an independent |cur_exp|...@>=
+begin q:=single_dependency(cur_exp);
+if q=dep_final then
+ begin type(p):=known; value(p):=0; free_node(q,dep_node_size);
+ end
+else begin type(p):=dependent; new_dep(p,q);
+ end;
+recycle_value(cur_exp);
+end
+
+@ @<Scan the second of a pair of numerics@>=
+begin p:=get_node(value_node_size); type(p):=pair_type; name_type(p):=capsule;
+init_big_node(p); q:=value(p); stash_in(x_part_loc(q));@/
+get_x_next; scan_expression;
+if cur_type<known then
+ begin exp_err("Nonnumeric ypart has been replaced by 0");
+@.Nonnumeric...replaced by 0@>
+ help4("I thought you were giving me a pair `(x,y)'; but")@/
+ ("after finding a nice xpart `x' I found a ypart `y'")@/
+ ("that isn't of numeric type. So I've changed y to zero.")@/
+ ("(The y that I didn't like appears above the error message.)");
+ put_get_flush_error(0);
+ end;
+stash_in(y_part_loc(q));
+check_delimiter(l_delim,r_delim);
+cur_type:=pair_type; cur_exp:=p;
+end
+
+@ The local variable |group_line| keeps track of the line
+where a \&{begingroup} command occurred; this will be useful
+in an error message if the group doesn't actually end.
+
+@<Other local variables for |scan_primary|@>=
+@!group_line:integer; {where a group began}
+
+@ @<Scan a grouped primary@>=
+begin group_line:=line;
+if internal[tracing_commands]>0 then show_cur_cmd_mod;
+save_boundary_item(p);
+repeat do_statement; {ends with |cur_cmd>=semicolon|}
+until cur_cmd<>semicolon;
+if cur_cmd<>end_group then
+ begin print_err("A group begun on line ");
+@.A group...never ended@>
+ print_int(group_line);
+ print(" never ended");
+ help2("I saw a `begingroup' back there that hasn't been matched")@/
+ ("by `endgroup'. So I've inserted `endgroup' now.");
+ back_error; cur_cmd:=end_group;
+ end;
+unsave; {this might change |cur_type|, if independent variables are recycled}
+if internal[tracing_commands]>0 then show_cur_cmd_mod;
+end
+
+@ @<Scan a string constant@>=
+begin cur_type:=string_type; cur_exp:=cur_mod;
+end
+
+@ Later we'll come to procedures that perform actual operations like
+addition, square root, and so on; our purpose now is to do the parsing.
+But we might as well mention those future procedures now, so that the
+suspense won't be too bad:
+
+\smallskip
+|do_nullary(c)| does primitive operations that have no operands (e.g.,
+`\&{true}' or `\&{pencircle}');
+
+\smallskip
+|do_unary(c)| applies a primitive operation to the current expression;
+
+\smallskip
+|do_binary(p,c)| applies a primitive operation to the capsule~|p|
+and the current expression.
+
+@<Scan a nullary operation@>=do_nullary(cur_mod)
+
+@ @<Scan a unary operation@>=
+begin c:=cur_mod; get_x_next; scan_primary; do_unary(c); goto done;
+end
+
+@ A numeric token might be a primary by itself, or it might be the
+numerator of a fraction composed solely of numeric tokens, or it might
+multiply the primary that follows (provided that the primary doesn't begin
+with a plus sign or a minus sign). The code here uses the facts that
+|max_primary_command=plus_or_minus| and
+|max_primary_command-1=numeric_token|. If a fraction is found that is less
+than unity, we try to retain higher precision when we use it in scalar
+multiplication.
+
+@<Other local variables for |scan_primary|@>=
+@!num,@!denom:scaled; {for primaries that are fractions, like `1/2'}
+
+@ @<Scan a primary that starts with a numeric token@>=
+begin cur_exp:=cur_mod; cur_type:=known; get_x_next;
+if cur_cmd<>slash then
+ begin num:=0; denom:=0;
+ end
+else begin get_x_next;
+ if cur_cmd<>numeric_token then
+ begin back_input;
+ cur_cmd:=slash; cur_mod:=over; cur_sym:=frozen_slash;
+ goto done;
+ end;
+ num:=cur_exp; denom:=cur_mod;
+ if denom=0 then @<Protest division by zero@>
+ else cur_exp:=make_scaled(num,denom);
+ check_arith; get_x_next;
+ end;
+if cur_cmd>=min_primary_command then
+ if cur_cmd<numeric_token then {in particular, |cur_cmd<>plus_or_minus|}
+ begin p:=stash_cur_exp; scan_primary;
+ if (abs(num)>=abs(denom))or(cur_type<pair_type) then do_binary(p,times)
+ else begin frac_mult(num,denom);
+ free_node(p,value_node_size);
+ end;
+ end;
+goto done;
+end
+
+@ @<Protest division...@>=
+begin print_err("Division by zero");
+@.Division by zero@>
+help1("I'll pretend that you meant to divide by 1."); error;
+end
+
+@ @<Scan a binary operation with `\&{of}' between its operands@>=
+begin c:=cur_mod; get_x_next; scan_expression;
+if cur_cmd<>of_token then
+ begin missing_err("of"); print(" for "); print_cmd_mod(primary_binary,c);
+@.Missing `of'@>
+ help1("I've got the first argument; will look now for the other.");
+ back_error;
+ end;
+p:=stash_cur_exp; get_x_next; scan_primary; do_binary(p,c); goto done;
+end
+
+@ @<Convert a suffix to a string@>=
+begin get_x_next; scan_suffix; old_setting:=selector; selector:=new_string;
+show_token_list(cur_exp,null,100000,0); flush_token_list(cur_exp);
+cur_exp:=make_string; selector:=old_setting; cur_type:=string_type;
+goto done;
+end
+
+@ If an internal quantity appears all by itself on the left of an
+assignment, we return a token list of length one, containing the address
+of the internal quantity plus |hash_end|. (This accords with the conventions
+of the save stack, as described earlier.)
+
+@<Scan an internal...@>=
+begin q:=cur_mod;
+if my_var_flag=assignment then
+ begin get_x_next;
+ if cur_cmd=assignment then
+ begin cur_exp:=get_avail;
+ info(cur_exp):=q+hash_end; cur_type:=token_list; goto done;
+ end;
+ back_input;
+ end;
+cur_type:=known; cur_exp:=internal[q];
+end
+
+@ The most difficult part of |scan_primary| has been saved for last, since
+it was necessary to build up some confidence first. We can now face the task
+of scanning a variable.
+
+As we scan a variable, we build a token list containing the relevant
+names and subscript values, simultaneously following along in the
+``collective'' structure to see if we are actually dealing with a macro
+instead of a value.
+
+The local variables |pre_head| and |post_head| will point to the beginning
+of the prefix and suffix lists; |tail| will point to the end of the list
+that is currently growing.
+
+Another local variable, |tt|, contains partial information about the
+declared type of the variable-so-far. If |tt>=unsuffixed_macro|, the
+relation |tt=type(q)| will always hold. If |tt=undefined|, the routine
+doesn't bother to update its information about type. And if
+|undefined<tt<unsuffixed_macro|, the precise value of |tt| isn't critical.
+
+@ @<Other local variables for |scan_primary|@>=
+@!pre_head,@!post_head,@!tail:pointer;
+ {prefix and suffix list variables}
+@!tt:small_number; {approximation to the type of the variable-so-far}
+@!t:pointer; {a token}
+@!macro_ref:pointer; {reference count for a suffixed macro}
+
+@ @<Scan a variable primary...@>=
+begin fast_get_avail(pre_head); tail:=pre_head; post_head:=null; tt:=vacuous;
+loop@+ begin t:=cur_tok; link(tail):=t;
+ if tt<>undefined then
+ begin @<Find the approximate type |tt| and corresponding~|q|@>;
+ if tt>=unsuffixed_macro then
+ @<Either begin an unsuffixed macro call or
+ prepare for a suffixed one@>;
+ end;
+ get_x_next; tail:=t;
+ if cur_cmd=left_bracket then
+ @<Scan for a subscript; replace |cur_cmd| by |numeric_token| if found@>;
+ if cur_cmd>max_suffix_token then goto done1;
+ if cur_cmd<min_suffix_token then goto done1;
+ end; {now |cur_cmd| is |internal_quantity|, |tag_token|, or |numeric_token|}
+done1:@<Handle unusual cases that masquerade as variables, and |goto restart|
+ or |goto done| if appropriate;
+ otherwise make a copy of the variable and |goto done|@>;
+end
+
+@ @<Either begin an unsuffixed macro call or...@>=
+begin link(tail):=null;
+if tt>unsuffixed_macro then {|tt=suffixed_macro|}
+ begin post_head:=get_avail; tail:=post_head; link(tail):=t;@/
+ tt:=undefined; macro_ref:=value(q); add_mac_ref(macro_ref);
+ end
+else @<Set up unsuffixed macro call and |goto restart|@>;
+end
+
+@ @<Scan for a subscript; replace |cur_cmd| by |numeric_token| if found@>=
+begin get_x_next; scan_expression;
+if cur_cmd<>right_bracket then
+ @<Put the left bracket and the expression back to be rescanned@>
+else begin if cur_type<>known then bad_subscript;
+ cur_cmd:=numeric_token; cur_mod:=cur_exp; cur_sym:=0;
+ end;
+end
+
+@ The left bracket that we thought was introducing a subscript might have
+actually been the left bracket in a mediation construction like `\.{x[a,b]}'.
+So we don't issue an error message at this point; but we do want to back up
+so as to avoid any embarrassment about our incorrect assumption.
+
+@<Put the left bracket and the expression back to be rescanned@>=
+begin back_input; {that was the token following the current expression}
+back_expr; cur_cmd:=left_bracket; cur_mod:=0; cur_sym:=frozen_left_bracket;
+end
+
+@ Here's a routine that puts the current expression back to be read again.
+
+@p procedure back_expr;
+var @!p:pointer; {capsule token}
+begin p:=stash_cur_exp; link(p):=null; back_list(p);
+end;
+
+@ Unknown subscripts lead to the following error message.
+
+@p procedure bad_subscript;
+begin exp_err("Improper subscript has been replaced by zero");
+@.Improper subscript...@>
+help3("A bracketed subscript must have a known numeric value;")@/
+ ("unfortunately, what I found was the value that appears just")@/
+ ("above this error message. So I'll try a zero subscript.");
+flush_error(0);
+end;
+
+@ Every time we call |get_x_next|, there's a chance that the variable we've
+been looking at will disappear. Thus, we cannot safely keep |q| pointing
+into the variable structure; we need to start searching from the root each time.
+
+@<Find the approximate type |tt| and corresponding~|q|@>=
+@^inner loop@>
+begin p:=link(pre_head); q:=info(p); tt:=undefined;
+if eq_type(q) mod outer_tag=tag_token then
+ begin q:=equiv(q);
+ if q=null then goto done2;
+ loop@+ begin p:=link(p);
+ if p=null then
+ begin tt:=type(q); goto done2;
+ end;
+ if type(q)<>structured then goto done2;
+ q:=link(attr_head(q)); {the |collective_subscript| attribute}
+ if p>=hi_mem_min then {it's not a subscript}
+ begin repeat q:=link(q);
+ until attr_loc(q)>=info(p);
+ if attr_loc(q)>info(p) then goto done2;
+ end;
+ end;
+ end;
+done2:end
+
+@ How do things stand now? Well, we have scanned an entire variable name,
+including possible subscripts and/or attributes; |cur_cmd|, |cur_mod|, and
+|cur_sym| represent the token that follows. If |post_head=null|, a
+token list for this variable name starts at |link(pre_head)|, with all
+subscripts evaluated. But if |post_head<>null|, the variable turned out
+to be a suffixed macro; |pre_head| is the head of the prefix list, while
+|post_head| is the head of a token list containing both `\.{\AT!}' and
+the suffix.
+
+Our immediate problem is to see if this variable still exists. (Variable
+structures can change drastically whenever we call |get_x_next|; users
+aren't supposed to do this, but the fact that it is possible means that
+we must be cautious.)
+
+The following procedure prints an error message when a variable
+unexpectedly disappears. Its help message isn't quite right for
+our present purposes, but we'll be able to fix that up.
+
+@p procedure obliterated(@!q:pointer);
+begin print_err("Variable "); show_token_list(q,null,1000,0);
+print(" has been obliterated");
+@.Variable...obliterated@>
+help5("It seems you did a nasty thing---probably by accident,")@/
+ ("but nevertheless you nearly hornswoggled me...")@/
+ ("While I was evaluating the right-hand side of this")@/
+ ("command, something happened, and the left-hand side")@/
+ ("is no longer a variable! So I won't change anything.");
+end;
+
+@ If the variable does exist, we also need to check
+for a few other special cases before deciding that a plain old ordinary
+variable has, indeed, been scanned.
+
+@<Handle unusual cases that masquerade as variables...@>=
+if post_head<>null then @<Set up suffixed macro call and |goto restart|@>;
+q:=link(pre_head); free_avail(pre_head);
+if cur_cmd=my_var_flag then
+ begin cur_type:=token_list; cur_exp:=q; goto done;
+ end;
+p:=find_variable(q);
+if p<>null then make_exp_copy(p)
+else begin obliterated(q);@/
+ help_line[2]:="While I was evaluating the suffix of this variable,";
+ help_line[1]:="something was redefined, and it's no longer a variable!";
+ help_line[0]:="In order to get back on my feet, I've inserted `0' instead.";
+ put_get_flush_error(0);
+ end;
+flush_node_list(q); goto done
+
+@ The only complication associated with macro calling is that the prefix
+and ``at'' parameters must be packaged in an appropriate list of lists.
+
+@<Set up unsuffixed macro call and |goto restart|@>=
+begin p:=get_avail; info(pre_head):=link(pre_head); link(pre_head):=p;
+info(p):=t; macro_call(value(q),pre_head,null); get_x_next; goto restart;
+end
+
+@ If the ``variable'' that turned out to be a suffixed macro no longer exists,
+we don't care, because we have reserved a pointer (|macro_ref|) to its
+token list.
+
+@<Set up suffixed macro call and |goto restart|@>=
+begin back_input; p:=get_avail; q:=link(post_head);
+info(pre_head):=link(pre_head); link(pre_head):=post_head;
+info(post_head):=q; link(post_head):=p; info(p):=link(q); link(q):=null;
+macro_call(macro_ref,pre_head,null); decr(ref_count(macro_ref));
+get_x_next; goto restart;
+end
+
+@ Our remaining job is simply to make a copy of the value that has been
+found. Some cases are harder than others, but complexity arises solely
+because of the multiplicity of possible cases.
+
+@<Declare the procedure called |make_exp_copy|@>=
+@t\4@>@<Declare subroutines needed by |make_exp_copy|@>@;
+procedure make_exp_copy(@!p:pointer);
+label restart;
+var @!q,@!r,@!t:pointer; {registers for list manipulation}
+begin restart: cur_type:=type(p);
+case cur_type of
+vacuous,boolean_type,known:cur_exp:=value(p);
+unknown_types:cur_exp:=new_ring_entry(p);
+string_type:begin cur_exp:=value(p); add_str_ref(cur_exp);
+ end;
+pen_type:begin cur_exp:=value(p); add_pen_ref(cur_exp);
+ end;
+picture_type:cur_exp:=copy_edges(value(p));
+path_type,future_pen:cur_exp:=copy_path(value(p));
+transform_type,pair_type:@<Copy the big node |p|@>;
+dependent,proto_dependent:encapsulate(copy_dep_list(dep_list(p)));
+numeric_type:begin new_indep(p); goto restart;
+ end;
+independent: begin q:=single_dependency(p);
+ if q=dep_final then
+ begin cur_type:=known; cur_exp:=0; free_node(q,value_node_size);
+ end
+ else begin cur_type:=dependent; encapsulate(q);
+ end;
+ end;
+othercases confusion("copy")
+@:this can't happen copy}{\quad copy@>
+endcases;
+end;
+
+@ The |encapsulate| subroutine assumes that |dep_final| is the
+tail of dependency list~|p|.
+
+@<Declare subroutines needed by |make_exp_copy|@>=
+procedure encapsulate(@!p:pointer);
+begin cur_exp:=get_node(value_node_size); type(cur_exp):=cur_type;
+name_type(cur_exp):=capsule; new_dep(cur_exp,p);
+end;
+
+@ The most tedious case arises when the user refers to a
+\&{pair} or \&{transform} variable; we must copy several fields,
+each of which can be |independent|, |dependent|, |proto_dependent|,
+or |known|.
+
+@<Copy the big node |p|@>=
+begin if value(p)=null then init_big_node(p);
+t:=get_node(value_node_size); name_type(t):=capsule; type(t):=cur_type;
+init_big_node(t);@/
+q:=value(p)+big_node_size[cur_type]; r:=value(t)+big_node_size[cur_type];
+repeat q:=q-2; r:=r-2; install(r,q);
+until q=value(p);
+cur_exp:=t;
+end
+
+@ The |install| procedure copies a numeric field~|q| into field~|r| of
+a big node that will be part of a capsule.
+
+@<Declare subroutines needed by |make_exp_copy|@>=
+procedure install(@!r,@!q:pointer);
+var p:pointer; {temporary register}
+begin if type(q)=known then
+ begin value(r):=value(q); type(r):=known;
+ end
+else if type(q)=independent then
+ begin p:=single_dependency(q);
+ if p=dep_final then
+ begin type(r):=known; value(r):=0; free_node(p,value_node_size);
+ end
+ else begin type(r):=dependent; new_dep(r,p);
+ end;
+ end
+ else begin type(r):=type(q); new_dep(r,copy_dep_list(dep_list(q)));
+ end;
+end;
+
+@ Expressions of the form `\.{a[b,c]}' are converted into
+`\.{b+a*(c-b)}', without checking the types of \.b~or~\.c,
+provided that \.a is numeric.
+
+@<Scan a mediation...@>=
+begin p:=stash_cur_exp; get_x_next; scan_expression;
+if cur_cmd<>comma then
+ begin @<Put the left bracket and the expression back...@>;
+ unstash_cur_exp(p);
+ end
+else begin q:=stash_cur_exp; get_x_next; scan_expression;
+ if cur_cmd<>right_bracket then
+ begin missing_err("]");@/
+@.Missing `]'@>
+ help3("I've scanned an expression of the form `a[b,c',")@/
+ ("so a right bracket should have come next.")@/
+ ("I shall pretend that one was there.");@/
+ back_error;
+ end;
+ r:=stash_cur_exp; make_exp_copy(q);@/
+ do_binary(r,minus); do_binary(p,times); do_binary(q,plus); get_x_next;
+ end;
+end
+
+@ Here is a comparatively simple routine that is used to scan the
+\&{suffix} parameters of a macro.
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_suffix;
+label done;
+var @!h,@!t:pointer; {head and tail of the list being built}
+@!p:pointer; {temporary register}
+begin h:=get_avail; t:=h;
+loop@+ begin if cur_cmd=left_bracket then
+ @<Scan a bracketed subscript and set |cur_cmd:=numeric_token|@>;
+ if cur_cmd=numeric_token then p:=new_num_tok(cur_mod)
+ else if (cur_cmd=tag_token)or(cur_cmd=internal_quantity) then
+ begin p:=get_avail; info(p):=cur_sym;
+ end
+ else goto done;
+ link(t):=p; t:=p; get_x_next;
+ end;
+done: cur_exp:=link(h); free_avail(h); cur_type:=token_list;
+end;
+
+@ @<Scan a bracketed subscript and set |cur_cmd:=numeric_token|@>=
+begin get_x_next; scan_expression;
+if cur_type<>known then bad_subscript;
+if cur_cmd<>right_bracket then
+ begin missing_err("]");@/
+@.Missing `]'@>
+ help3("I've seen a `[' and a subscript value, in a suffix,")@/
+ ("so a right bracket should have come next.")@/
+ ("I shall pretend that one was there.");@/
+ back_error;
+ end;
+cur_cmd:=numeric_token; cur_mod:=cur_exp;
+end
+
+@* \[41] Parsing secondary and higher expressions.
+After the intricacies of |scan_primary|\kern-1pt,
+the |scan_secondary| routine is
+refreshingly simple. It's not trivial, but the operations are relatively
+straightforward; the main difficulty is, again, that expressions and data
+structures might change drastically every time we call |get_x_next|, so a
+cautious approach is mandatory. For example, a macro defined by
+\&{primarydef} might have disappeared by the time its second argument has
+been scanned; we solve this by increasing the reference count of its token
+list, so that the macro can be called even after it has been clobbered.
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_secondary;
+label restart,continue;
+var @!p:pointer; {for list manipulation}
+@!c,@!d:halfword; {operation codes or modifiers}
+@!mac_name:pointer; {token defined with \&{primarydef}}
+begin restart:if(cur_cmd<min_primary_command)or@|
+ (cur_cmd>max_primary_command) then
+ bad_exp("A secondary");
+@.A secondary expression...@>
+scan_primary;
+continue: if cur_cmd<=max_secondary_command then
+ if cur_cmd>=min_secondary_command then
+ begin p:=stash_cur_exp; c:=cur_mod; d:=cur_cmd;
+ if d=secondary_primary_macro then
+ begin mac_name:=cur_sym; add_mac_ref(c);
+ end;
+ get_x_next; scan_primary;
+ if d<>secondary_primary_macro then do_binary(p,c)
+ else begin back_input; binary_mac(p,c,mac_name);
+ decr(ref_count(c)); get_x_next; goto restart;
+ end;
+ goto continue;
+ end;
+end;
+
+@ The following procedure calls a macro that has two parameters,
+|p| and |cur_exp|.
+
+@p procedure binary_mac(@!p,@!c,@!n:pointer);
+var @!q,@!r:pointer; {nodes in the parameter list}
+begin q:=get_avail; r:=get_avail; link(q):=r;@/
+info(q):=p; info(r):=stash_cur_exp;@/
+macro_call(c,q,n);
+end;
+
+@ The next procedure, |scan_tertiary|, is pretty much the same deal.
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_tertiary;
+label restart,continue;
+var @!p:pointer; {for list manipulation}
+@!c,@!d:halfword; {operation codes or modifiers}
+@!mac_name:pointer; {token defined with \&{secondarydef}}
+begin restart:if(cur_cmd<min_primary_command)or@|
+ (cur_cmd>max_primary_command) then
+ bad_exp("A tertiary");
+@.A tertiary expression...@>
+scan_secondary;
+if cur_type=future_pen then materialize_pen;
+continue: if cur_cmd<=max_tertiary_command then
+ if cur_cmd>=min_tertiary_command then
+ begin p:=stash_cur_exp; c:=cur_mod; d:=cur_cmd;
+ if d=tertiary_secondary_macro then
+ begin mac_name:=cur_sym; add_mac_ref(c);
+ end;
+ get_x_next; scan_secondary;
+ if d<>tertiary_secondary_macro then do_binary(p,c)
+ else begin back_input; binary_mac(p,c,mac_name);
+ decr(ref_count(c)); get_x_next; goto restart;
+ end;
+ goto continue;
+ end;
+end;
+
+@ A |future_pen| becomes a full-fledged pen here.
+
+@p procedure materialize_pen;
+label common_ending;
+var @!a_minus_b,@!a_plus_b,@!major_axis,@!minor_axis:scaled; {ellipse variables}
+@!theta:angle; {amount by which the ellipse has been rotated}
+@!p:pointer; {path traverser}
+@!q:pointer; {the knot list to be made into a pen}
+begin q:=cur_exp;
+if left_type(q)=endpoint then
+ begin print_err("Pen path must be a cycle");
+@.Pen path must be a cycle@>
+ help2("I can't make a pen from the given path.")@/
+ ("So I've replaced it by the trivial path `(0,0)..cycle'.");
+ put_get_error; cur_exp:=null_pen; goto common_ending;
+ end
+else if left_type(q)=open then
+ @<Change node |q| to a path for an elliptical pen@>;
+cur_exp:=make_pen(q);
+common_ending: toss_knot_list(q); cur_type:=pen_type;
+end;
+
+@ We placed the three points $(0,0)$, $(1,0)$, $(0,1)$ into a \&{pencircle},
+and they have now been transformed to $(u,v)$, $(A+u,B+v)$, $(C+u,D+v)$;
+this gives us enough information to deduce the transformation
+$(x,y)\mapsto(Ax+Cy+u,Bx+Dy+v)$.
+
+Given ($A,B,C,D)$ we can always find $(a,b,\theta,\phi)$ such that
+$$\eqalign{A&=a\cos\phi\cos\theta-b\sin\phi\sin\theta;\cr
+B&=a\cos\phi\sin\theta+b\sin\phi\cos\theta;\cr
+C&=-a\sin\phi\cos\theta-b\cos\phi\sin\theta;\cr
+D&=-a\sin\phi\sin\theta+b\cos\phi\cos\theta.\cr}$$
+In this notation, the unit circle $(\cos t,\sin t)$ is transformed into
+$$\bigl(a\cos(\phi+t)\cos\theta-b\sin(\phi+t)\sin\theta,\;
+a\cos(\phi+t)\sin\theta+b\sin(\phi+t)\cos\theta\bigr)\;+\;(u,v),$$
+which is an ellipse with semi-axes~$(a,b)$, rotated by~$\theta$ and
+shifted by~$(u,v)$. To solve the stated equations, we note that it is
+necessary and sufficient to solve
+$$\eqalign{A-D&=(a-b)\cos(\theta-\phi),\cr
+B+C&=(a-b)\sin(\theta-\phi),\cr}
+\qquad
+\eqalign{A+D&=(a+b)\cos(\theta+\phi),\cr
+B-C&=(a+b)\sin(\theta+\phi);\cr}$$
+and it is easy to find $a-b$, $a+b$, $\theta-\phi$, and $\theta+\phi$
+from these formulas.
+
+The code below uses |(txx,tyx,txy,tyy,tx,ty)| to stand for
+$(A,B,C,D,u,v)$.
+
+@<Change node |q|...@>=
+begin tx:=x_coord(q); ty:=y_coord(q);
+txx:=left_x(q)-tx; tyx:=left_y(q)-ty;
+txy:=right_x(q)-tx; tyy:=right_y(q)-ty;
+a_minus_b:=pyth_add(txx-tyy,tyx+txy); a_plus_b:=pyth_add(txx+tyy,tyx-txy);
+major_axis:=half(a_minus_b+a_plus_b); minor_axis:=half(abs(a_plus_b-a_minus_b));
+if major_axis=minor_axis then theta:=0 {circle}
+else theta:=half(n_arg(txx-tyy,tyx+txy)+n_arg(txx+tyy,tyx-txy));
+free_node(q,knot_node_size);
+q:=make_ellipse(major_axis,minor_axis,theta);
+if (tx<>0)or(ty<>0) then @<Shift the coordinates of path |q|@>;
+end
+
+@ @<Shift the coordinates of path |q|@>=
+begin p:=q;
+repeat x_coord(p):=x_coord(p)+tx; y_coord(p):=y_coord(p)+ty; p:=link(p);
+until p=q;
+end
+
+@ Finally we reach the deepest level in our quartet of parsing routines.
+This one is much like the others; but it has an extra complication from
+paths, which materialize here.
+
+@d continue_path=25 {a label inside of |scan_expression|}
+@d finish_path=26 {another}
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_expression;
+label restart,done,continue,continue_path,finish_path,exit;
+var @!p,@!q,@!r,@!pp,@!qq:pointer; {for list manipulation}
+@!c,@!d:halfword; {operation codes or modifiers}
+@!my_var_flag:0..max_command_code; {initial value of |var_flag|}
+@!mac_name:pointer; {token defined with \&{tertiarydef}}
+@!cycle_hit:boolean; {did a path expression just end with `\&{cycle}'?}
+@!x,@!y:scaled; {explicit coordinates or tension at a path join}
+@!t:endpoint..open; {knot type following a path join}
+begin my_var_flag:=var_flag;
+restart:if(cur_cmd<min_primary_command)or@|
+ (cur_cmd>max_primary_command) then
+ bad_exp("An");
+@.An expression...@>
+scan_tertiary;
+continue: if cur_cmd<=max_expression_command then
+ if cur_cmd>=min_expression_command then
+ if (cur_cmd<>equals)or(my_var_flag<>assignment) then
+ begin p:=stash_cur_exp; c:=cur_mod; d:=cur_cmd;
+ if d=expression_tertiary_macro then
+ begin mac_name:=cur_sym; add_mac_ref(c);
+ end;
+ if (d<ampersand)or((d=ampersand)and@|
+ ((type(p)=pair_type)or(type(p)=path_type))) then
+ @<Scan a path construction operation;
+ but |return| if |p| has the wrong type@>
+ else begin get_x_next; scan_tertiary;
+ if d<>expression_tertiary_macro then do_binary(p,c)
+ else begin back_input; binary_mac(p,c,mac_name);
+ decr(ref_count(c)); get_x_next; goto restart;
+ end;
+ end;
+ goto continue;
+ end;
+exit:end;
+
+@ The reader should review the data structure conventions for paths before
+hoping to understand the next part of this code.
+
+@<Scan a path construction operation...@>=
+begin cycle_hit:=false;
+@<Convert the left operand, |p|, into a partial path ending at~|q|;
+ but |return| if |p| doesn't have a suitable type@>;
+continue_path: @<Determine the path join parameters;
+ but |goto finish_path| if there's only a direction specifier@>;
+if cur_cmd=cycle then @<Get ready to close a cycle@>
+else begin scan_tertiary;
+ @<Convert the right operand, |cur_exp|,
+ into a partial path from |pp| to~|qq|@>;
+ end;
+@<Join the partial paths and reset |p| and |q| to the head and tail
+ of the result@>;
+if cur_cmd>=min_expression_command then
+ if cur_cmd<=ampersand then if not cycle_hit then goto continue_path;
+finish_path:
+@<Choose control points for the path and put the result into |cur_exp|@>;
+end
+
+@ @<Convert the left operand, |p|, into a partial path ending at~|q|...@>=
+begin unstash_cur_exp(p);
+if cur_type=pair_type then p:=new_knot
+else if cur_type=path_type then p:=cur_exp
+else return;
+q:=p;
+while link(q)<>p do q:=link(q);
+if left_type(p)<>endpoint then {open up a cycle}
+ begin r:=copy_knot(p); link(q):=r; q:=r;
+ end;
+left_type(p):=open; right_type(q):=open;
+end
+
+@ A pair of numeric values is changed into a knot node for a one-point path
+when \MF\ discovers that the pair is part of a path.
+
+@p@t\4@>@<Declare the procedure called |known_pair|@>@;
+function new_knot:pointer; {convert a pair to a knot with two endpoints}
+var @!q:pointer; {the new node}
+begin q:=get_node(knot_node_size); left_type(q):=endpoint;
+right_type(q):=endpoint; link(q):=q;@/
+known_pair; x_coord(q):=cur_x; y_coord(q):=cur_y;
+new_knot:=q;
+end;
+
+@ The |known_pair| subroutine sets |cur_x| and |cur_y| to the components
+of the current expression, assuming that the current expression is a
+pair of known numerics. Unknown components are zeroed, and the
+current expression is flushed.
+
+@<Declare the procedure called |known_pair|@>=
+procedure known_pair;
+var @!p:pointer; {the pair node}
+begin if cur_type<>pair_type then
+ begin exp_err("Undefined coordinates have been replaced by (0,0)");
+@.Undefined coordinates...@>
+ help5("I need x and y numbers for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+ ("you might want to type `I ???' now.)");
+ put_get_flush_error(0); cur_x:=0; cur_y:=0;
+ end
+else begin p:=value(cur_exp);
+ @<Make sure that both |x| and |y| parts of |p| are known;
+ copy them into |cur_x| and |cur_y|@>;
+ flush_cur_exp(0);
+ end;
+end;
+
+@ @<Make sure that both |x| and |y| parts of |p| are known...@>=
+if type(x_part_loc(p))=known then cur_x:=value(x_part_loc(p))
+else begin disp_err(x_part_loc(p),
+ "Undefined x coordinate has been replaced by 0");
+@.Undefined coordinates...@>
+ help5("I need a `known' x value for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+ ("you might want to type `I ???' now.)");
+ put_get_error; recycle_value(x_part_loc(p)); cur_x:=0;
+ end;
+if type(y_part_loc(p))=known then cur_y:=value(y_part_loc(p))
+else begin disp_err(y_part_loc(p),
+ "Undefined y coordinate has been replaced by 0");
+ help5("I need a `known' y value for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+ ("you might want to type `I ???' now.)");
+ put_get_error; recycle_value(y_part_loc(p)); cur_y:=0;
+ end
+
+@ At this point |cur_cmd| is either |ampersand|, |left_brace|, or |path_join|.
+
+@<Determine the path join parameters...@>=
+if cur_cmd=left_brace then
+ @<Put the pre-join direction information into node |q|@>;
+d:=cur_cmd;
+if d=path_join then @<Determine the tension and/or control points@>
+else if d<>ampersand then goto finish_path;
+get_x_next;
+if cur_cmd=left_brace then
+ @<Put the post-join direction information into |x| and |t|@>
+else if right_type(q)<>explicit then
+ begin t:=open; x:=0;
+ end
+
+@ The |scan_direction| subroutine looks at the directional information
+that is enclosed in braces, and also scans ahead to the following character.
+A type code is returned, either |open| (if the direction was $(0,0)$),
+or |curl| (if the direction was a curl of known value |cur_exp|), or
+|given| (if the direction is given by the |angle| value that now
+appears in |cur_exp|).
+
+There's nothing difficult about this subroutine, but the program is rather
+lengthy because a variety of potential errors need to be nipped in the bud.
+
+@p function scan_direction:small_number;
+var @!t:given..open; {the type of information found}
+@!x:scaled; {an |x| coordinate}
+begin get_x_next;
+if cur_cmd=curl_command then @<Scan a curl specification@>
+else @<Scan a given direction@>;
+if cur_cmd<>right_brace then
+ begin missing_err("}");@/
+@.Missing `\char`\}'@>
+ help3("I've scanned a direction spec for part of a path,")@/
+ ("so a right brace should have come next.")@/
+ ("I shall pretend that one was there.");@/
+ back_error;
+ end;
+get_x_next; scan_direction:=t;
+end;
+
+@ @<Scan a curl specification@>=
+begin get_x_next; scan_expression;
+if (cur_type<>known)or(cur_exp<0) then
+ begin exp_err("Improper curl has been replaced by 1");
+@.Improper curl@>
+ help1("A curl must be a known, nonnegative number.");
+ put_get_flush_error(unity);
+ end;
+t:=curl;
+end
+
+@ @<Scan a given direction@>=
+begin scan_expression;
+if cur_type>pair_type then @<Get given directions separated by commas@>
+else known_pair;
+if (cur_x=0)and(cur_y=0) then t:=open
+else begin t:=given; cur_exp:=n_arg(cur_x,cur_y);
+ end;
+end
+
+@ @<Get given directions separated by commas@>=
+begin if cur_type<>known then
+ begin exp_err("Undefined x coordinate has been replaced by 0");
+@.Undefined coordinates...@>
+ help5("I need a `known' x value for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+ ("you might want to type `I ???' now.)");
+ put_get_flush_error(0);
+ end;
+x:=cur_exp;
+if cur_cmd<>comma then
+ begin missing_err(",");@/
+@.Missing `,'@>
+ help2("I've got the x coordinate of a path direction;")@/
+ ("will look for the y coordinate next.");
+ back_error;
+ end;
+get_x_next; scan_expression;
+if cur_type<>known then
+ begin exp_err("Undefined y coordinate has been replaced by 0");
+ help5("I need a `known' y value for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+ ("you might want to type `I ???' now.)");
+ put_get_flush_error(0);
+ end;
+cur_y:=cur_exp; cur_x:=x;
+end
+
+@ At this point |right_type(q)| is usually |open|, but it may have been
+set to some other value by a previous splicing operation. We must maintain
+the value of |right_type(q)| in unusual cases such as
+`\.{..z1\{z2\}\&\{z3\}z1\{0,0\}..}'.
+
+@<Put the pre-join...@>=
+begin t:=scan_direction;
+if t<>open then
+ begin right_type(q):=t; right_given(q):=cur_exp;
+ if left_type(q)=open then
+ begin left_type(q):=t; left_given(q):=cur_exp;
+ end; {note that |left_given(q)=left_curl(q)|}
+ end;
+end
+
+@ Since |left_tension| and |left_y| share the same position in knot nodes,
+and since |left_given| is similarly equivalent to |left_x|, we use
+|x| and |y| to hold the given direction and tension information when
+there are no explicit control points.
+
+@<Put the post-join...@>=
+begin t:=scan_direction;
+if right_type(q)<>explicit then x:=cur_exp
+else t:=explicit; {the direction information is superfluous}
+end
+
+@ @<Determine the tension and/or...@>=
+begin get_x_next;
+if cur_cmd=tension then @<Set explicit tensions@>
+else if cur_cmd=controls then @<Set explicit control points@>
+else begin right_tension(q):=unity; y:=unity; back_input; {default tension}
+ goto done;
+ end;
+if cur_cmd<>path_join then
+ begin missing_err("..");@/
+@.Missing `..'@>
+ help1("A path join command should end with two dots.");
+ back_error;
+ end;
+done:end
+
+@ @<Set explicit tensions@>=
+begin get_x_next; y:=cur_cmd;
+if cur_cmd=at_least then get_x_next;
+scan_primary;
+@<Make sure that the current expression is a valid tension setting@>;
+if y=at_least then negate(cur_exp);
+right_tension(q):=cur_exp;
+if cur_cmd=and_command then
+ begin get_x_next; y:=cur_cmd;
+ if cur_cmd=at_least then get_x_next;
+ scan_primary;
+ @<Make sure that the current expression is a valid tension setting@>;
+ if y=at_least then negate(cur_exp);
+ end;
+y:=cur_exp;
+end
+
+@ @d min_tension==three_quarter_unit
+
+@<Make sure that the current expression is a valid tension setting@>=
+if (cur_type<>known)or(cur_exp<min_tension) then
+ begin exp_err("Improper tension has been set to 1");
+@.Improper tension@>
+ help1("The expression above should have been a number >=3/4.");
+ put_get_flush_error(unity);
+ end
+
+@ @<Set explicit control points@>=
+begin right_type(q):=explicit; t:=explicit; get_x_next; scan_primary;@/
+known_pair; right_x(q):=cur_x; right_y(q):=cur_y;
+if cur_cmd<>and_command then
+ begin x:=right_x(q); y:=right_y(q);
+ end
+else begin get_x_next; scan_primary;@/
+ known_pair; x:=cur_x; y:=cur_y;
+ end;
+end
+
+@ @<Convert the right operand, |cur_exp|, into a partial path...@>=
+begin if cur_type<>path_type then pp:=new_knot
+else pp:=cur_exp;
+qq:=pp;
+while link(qq)<>pp do qq:=link(qq);
+if left_type(pp)<>endpoint then {open up a cycle}
+ begin r:=copy_knot(pp); link(qq):=r; qq:=r;
+ end;
+left_type(pp):=open; right_type(qq):=open;
+end
+
+@ If a person tries to define an entire path by saying `\.{(x,y)\&cycle}',
+we silently change the specification to `\.{(x,y)..cycle}', since a cycle
+shouldn't have length zero.
+
+@<Get ready to close a cycle@>=
+begin cycle_hit:=true; get_x_next; pp:=p; qq:=p;
+if d=ampersand then if p=q then
+ begin d:=path_join; right_tension(q):=unity; y:=unity;
+ end;
+end
+
+@ @<Join the partial paths and reset |p| and |q|...@>=
+begin if d=ampersand then
+ if (x_coord(q)<>x_coord(pp))or(y_coord(q)<>y_coord(pp)) then
+ begin print_err("Paths don't touch; `&' will be changed to `..'");
+@.Paths don't touch@>
+ help3("When you join paths `p&q', the ending point of p")@/
+ ("must be exactly equal to the starting point of q.")@/
+ ("So I'm going to pretend that you said `p..q' instead.");
+ put_get_error; d:=path_join; right_tension(q):=unity; y:=unity;
+ end;
+@<Plug an opening in |right_type(pp)|, if possible@>;
+if d=ampersand then @<Splice independent paths together@>
+else begin @<Plug an opening in |right_type(q)|, if possible@>;
+ link(q):=pp; left_y(pp):=y;
+ if t<>open then
+ begin left_x(pp):=x; left_type(pp):=t;
+ end;
+ end;
+q:=qq;
+end
+
+@ @<Plug an opening in |right_type(q)|...@>=
+if right_type(q)=open then
+ if (left_type(q)=curl)or(left_type(q)=given) then
+ begin right_type(q):=left_type(q); right_given(q):=left_given(q);
+ end
+
+@ @<Plug an opening in |right_type(pp)|...@>=
+if right_type(pp)=open then
+ if (t=curl)or(t=given) then
+ begin right_type(pp):=t; right_given(pp):=x;
+ end
+
+@ @<Splice independent paths together@>=
+begin if left_type(q)=open then if right_type(q)=open then
+ begin left_type(q):=curl; left_curl(q):=unity;
+ end;
+if right_type(pp)=open then if t=open then
+ begin right_type(pp):=curl; right_curl(pp):=unity;
+ end;
+right_type(q):=right_type(pp); link(q):=link(pp);@/
+right_x(q):=right_x(pp); right_y(q):=right_y(pp);
+free_node(pp,knot_node_size);
+if qq=pp then qq:=q;
+end
+
+@ @<Choose control points for the path...@>=
+if cycle_hit then
+ begin if d=ampersand then p:=q;
+ end
+else begin left_type(p):=endpoint;
+ if right_type(p)=open then
+ begin right_type(p):=curl; right_curl(p):=unity;
+ end;
+ right_type(q):=endpoint;
+ if left_type(q)=open then
+ begin left_type(q):=curl; left_curl(q):=unity;
+ end;
+ link(q):=p;
+ end;
+make_choices(p);
+cur_type:=path_type; cur_exp:=p
+
+@ Finally, we sometimes need to scan an expression whose value is
+supposed to be either |true_code| or |false_code|.
+
+@<Declare the basic parsing subroutines@>=
+procedure get_boolean;
+begin get_x_next; scan_expression;
+if cur_type<>boolean_type then
+ begin exp_err("Undefined condition will be treated as `false'");
+@.Undefined condition...@>
+ help2("The expression shown above should have had a definite")@/
+ ("true-or-false value. I'm changing it to `false'.");@/
+ put_get_flush_error(false_code); cur_type:=boolean_type;
+ end;
+end;
+
+@* \[42] Doing the operations.
+The purpose of parsing is primarily to permit people to avoid piles of
+parentheses. But the real work is done after the structure of an expression
+has been recognized; that's when new expressions are generated. We
+turn now to the guts of \MF, which handles individual operators that
+have come through the parsing mechanism.
+
+We'll start with the easy ones that take no operands, then work our way
+up to operators with one and ultimately two arguments. In other words,
+we will write the three procedures |do_nullary|, |do_unary|, and |do_binary|
+that are invoked periodically by the expression scanners.
+
+First let's make sure that all of the primitive operators are in the
+hash table. Although |scan_primary| and its relatives made use of the
+\\{cmd} code for these operators, the \\{do} routines base everything
+on the \\{mod} code. For example, |do_binary| doesn't care whether the
+operation it performs is a |primary_binary| or |secondary_binary|, etc.
+
+@<Put each...@>=
+primitive("true",nullary,true_code);@/
+@!@:true_}{\&{true} primitive@>
+primitive("false",nullary,false_code);@/
+@!@:false_}{\&{false} primitive@>
+primitive("nullpicture",nullary,null_picture_code);@/
+@!@:null_picture_}{\&{nullpicture} primitive@>
+primitive("nullpen",nullary,null_pen_code);@/
+@!@:null_pen_}{\&{nullpen} primitive@>
+primitive("jobname",nullary,job_name_op);@/
+@!@:job_name_}{\&{jobname} primitive@>
+primitive("readstring",nullary,read_string_op);@/
+@!@:read_string_}{\&{readstring} primitive@>
+primitive("pencircle",nullary,pen_circle);@/
+@!@:pen_circle_}{\&{pencircle} primitive@>
+primitive("normaldeviate",nullary,normal_deviate);@/
+@!@:normal_deviate_}{\&{normaldeviate} primitive@>
+primitive("odd",unary,odd_op);@/
+@!@:odd_}{\&{odd} primitive@>
+primitive("known",unary,known_op);@/
+@!@:known_}{\&{known} primitive@>
+primitive("unknown",unary,unknown_op);@/
+@!@:unknown_}{\&{unknown} primitive@>
+primitive("not",unary,not_op);@/
+@!@:not_}{\&{not} primitive@>
+primitive("decimal",unary,decimal);@/
+@!@:decimal_}{\&{decimal} primitive@>
+primitive("reverse",unary,reverse);@/
+@!@:reverse_}{\&{reverse} primitive@>
+primitive("makepath",unary,make_path_op);@/
+@!@:make_path_}{\&{makepath} primitive@>
+primitive("makepen",unary,make_pen_op);@/
+@!@:make_pen_}{\&{makepen} primitive@>
+primitive("totalweight",unary,total_weight_op);@/
+@!@:total_weight_}{\&{totalweight} primitive@>
+primitive("oct",unary,oct_op);@/
+@!@:oct_}{\&{oct} primitive@>
+primitive("hex",unary,hex_op);@/
+@!@:hex_}{\&{hex} primitive@>
+primitive("ASCII",unary,ASCII_op);@/
+@!@:ASCII_}{\&{ASCII} primitive@>
+primitive("char",unary,char_op);@/
+@!@:char_}{\&{char} primitive@>
+primitive("length",unary,length_op);@/
+@!@:length_}{\&{length} primitive@>
+primitive("turningnumber",unary,turning_op);@/
+@!@:turning_number_}{\&{turningnumber} primitive@>
+primitive("xpart",unary,x_part);@/
+@!@:x_part_}{\&{xpart} primitive@>
+primitive("ypart",unary,y_part);@/
+@!@:y_part_}{\&{ypart} primitive@>
+primitive("xxpart",unary,xx_part);@/
+@!@:xx_part_}{\&{xxpart} primitive@>
+primitive("xypart",unary,xy_part);@/
+@!@:xy_part_}{\&{xypart} primitive@>
+primitive("yxpart",unary,yx_part);@/
+@!@:yx_part_}{\&{yxpart} primitive@>
+primitive("yypart",unary,yy_part);@/
+@!@:yy_part_}{\&{yypart} primitive@>
+primitive("sqrt",unary,sqrt_op);@/
+@!@:sqrt_}{\&{sqrt} primitive@>
+primitive("mexp",unary,m_exp_op);@/
+@!@:m_exp_}{\&{mexp} primitive@>
+primitive("mlog",unary,m_log_op);@/
+@!@:m_log_}{\&{mlog} primitive@>
+primitive("sind",unary,sin_d_op);@/
+@!@:sin_d_}{\&{sind} primitive@>
+primitive("cosd",unary,cos_d_op);@/
+@!@:cos_d_}{\&{cosd} primitive@>
+primitive("floor",unary,floor_op);@/
+@!@:floor_}{\&{floor} primitive@>
+primitive("uniformdeviate",unary,uniform_deviate);@/
+@!@:uniform_deviate_}{\&{uniformdeviate} primitive@>
+primitive("charexists",unary,char_exists_op);@/
+@!@:char_exists_}{\&{charexists} primitive@>
+primitive("angle",unary,angle_op);@/
+@!@:angle_}{\&{angle} primitive@>
+primitive("cycle",cycle,cycle_op);@/
+@!@:cycle_}{\&{cycle} primitive@>
+primitive("+",plus_or_minus,plus);@/
+@!@:+ }{\.{+} primitive@>
+primitive("-",plus_or_minus,minus);@/
+@!@:- }{\.{-} primitive@>
+primitive("*",secondary_binary,times);@/
+@!@:* }{\.{*} primitive@>
+primitive("/",slash,over); eqtb[frozen_slash]:=eqtb[cur_sym];@/
+@!@:/ }{\.{/} primitive@>
+primitive("++",tertiary_binary,pythag_add);@/
+@!@:++_}{\.{++} primitive@>
+primitive("+-+",tertiary_binary,pythag_sub);@/
+@!@:+-+_}{\.{+-+} primitive@>
+primitive("and",and_command,and_op);@/
+@!@:and_}{\&{and} primitive@>
+primitive("or",tertiary_binary,or_op);@/
+@!@:or_}{\&{or} primitive@>
+primitive("<",expression_binary,less_than);@/
+@!@:< }{\.{<} primitive@>
+primitive("<=",expression_binary,less_or_equal);@/
+@!@:<=_}{\.{<=} primitive@>
+primitive(">",expression_binary,greater_than);@/
+@!@:> }{\.{>} primitive@>
+primitive(">=",expression_binary,greater_or_equal);@/
+@!@:>=_}{\.{>=} primitive@>
+primitive("=",equals,equal_to);@/
+@!@:= }{\.{=} primitive@>
+primitive("<>",expression_binary,unequal_to);@/
+@!@:<>_}{\.{<>} primitive@>
+primitive("substring",primary_binary,substring_of);@/
+@!@:substring_}{\&{substring} primitive@>
+primitive("subpath",primary_binary,subpath_of);@/
+@!@:subpath_}{\&{subpath} primitive@>
+primitive("directiontime",primary_binary,direction_time_of);@/
+@!@:direction_time_}{\&{directiontime} primitive@>
+primitive("point",primary_binary,point_of);@/
+@!@:point_}{\&{point} primitive@>
+primitive("precontrol",primary_binary,precontrol_of);@/
+@!@:precontrol_}{\&{precontrol} primitive@>
+primitive("postcontrol",primary_binary,postcontrol_of);@/
+@!@:postcontrol_}{\&{postcontrol} primitive@>
+primitive("penoffset",primary_binary,pen_offset_of);@/
+@!@:pen_offset_}{\&{penoffset} primitive@>
+primitive("&",ampersand,concatenate);@/
+@!@:!!!}{\.{\&} primitive@>
+primitive("rotated",secondary_binary,rotated_by);@/
+@!@:rotated_}{\&{rotated} primitive@>
+primitive("slanted",secondary_binary,slanted_by);@/
+@!@:slanted_}{\&{slanted} primitive@>
+primitive("scaled",secondary_binary,scaled_by);@/
+@!@:scaled_}{\&{scaled} primitive@>
+primitive("shifted",secondary_binary,shifted_by);@/
+@!@:shifted_}{\&{shifted} primitive@>
+primitive("transformed",secondary_binary,transformed_by);@/
+@!@:transformed_}{\&{transformed} primitive@>
+primitive("xscaled",secondary_binary,x_scaled);@/
+@!@:x_scaled_}{\&{xscaled} primitive@>
+primitive("yscaled",secondary_binary,y_scaled);@/
+@!@:y_scaled_}{\&{yscaled} primitive@>
+primitive("zscaled",secondary_binary,z_scaled);@/
+@!@:z_scaled_}{\&{zscaled} primitive@>
+primitive("intersectiontimes",tertiary_binary,intersect);@/
+@!@:intersection_times_}{\&{intersectiontimes} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+nullary,unary,primary_binary,secondary_binary,tertiary_binary,
+ expression_binary,cycle,plus_or_minus,slash,ampersand,equals,and_command:
+ print_op(m);
+
+@ OK, let's look at the simplest \\{do} procedure first.
+
+@p procedure do_nullary(@!c:quarterword);
+var @!k:integer; {all-purpose loop index}
+begin check_arith;
+if internal[tracing_commands]>two then
+ show_cmd_mod(nullary,c);
+case c of
+true_code,false_code:begin cur_type:=boolean_type; cur_exp:=c;
+ end;
+null_picture_code:begin cur_type:=picture_type;
+ cur_exp:=get_node(edge_header_size); init_edges(cur_exp);
+ end;
+null_pen_code:begin cur_type:=pen_type; cur_exp:=null_pen;
+ end;
+normal_deviate:begin cur_type:=known; cur_exp:=norm_rand;
+ end;
+pen_circle:@<Make a special knot node for \&{pencircle}@>;
+job_name_op: begin if job_name=0 then open_log_file;
+ cur_type:=string_type; cur_exp:=job_name;
+ end;
+read_string_op:@<Read a string from the terminal@>;
+end; {there are no other cases}
+check_arith;
+end;
+
+@ @<Make a special knot node for \&{pencircle}@>=
+begin cur_type:=future_pen; cur_exp:=get_node(knot_node_size);
+left_type(cur_exp):=open; right_type(cur_exp):=open;
+link(cur_exp):=cur_exp;@/
+x_coord(cur_exp):=0; y_coord(cur_exp):=0;@/
+left_x(cur_exp):=unity; left_y(cur_exp):=0;@/
+right_x(cur_exp):=0; right_y(cur_exp):=unity;@/
+end
+
+@ @<Read a string...@>=
+begin if interaction<=nonstop_mode then
+ fatal_error("*** (cannot readstring in nonstop modes)");
+begin_file_reading; name:=1; prompt_input("");
+str_room(last-start);
+for k:=start to last-1 do append_char(buffer[k]);
+end_file_reading; cur_type:=string_type; cur_exp:=make_string;
+end
+
+@ Things get a bit more interesting when there's an operand. The
+operand to |do_unary| appears in |cur_type| and |cur_exp|.
+
+@p @t\4@>@<Declare unary action procedures@>@;
+procedure do_unary(@!c:quarterword);
+var @!p,@!q:pointer; {for list manipulation}
+@!x:integer; {a temporary register}
+begin check_arith;
+if internal[tracing_commands]>two then
+ @<Trace the current unary operation@>;
+case c of
+plus:if cur_type<pair_type then
+ if cur_type<>picture_type then bad_unary(plus);
+minus:@<Negate the current expression@>;
+@t\4@>@<Additional cases of unary operators@>@;
+end; {there are no other cases}
+check_arith;
+end;
+
+@ The |nice_pair| function returns |true| if both components of a pair
+are known.
+
+@<Declare unary action procedures@>=
+function nice_pair(@!p:integer;@!t:quarterword):boolean;
+label exit;
+begin if t=pair_type then
+ begin p:=value(p);
+ if type(x_part_loc(p))=known then
+ if type(y_part_loc(p))=known then
+ begin nice_pair:=true; return;
+ end;
+ end;
+nice_pair:=false;
+exit:end;
+
+@ @<Declare unary action...@>=
+procedure print_known_or_unknown_type(@!t:small_number;@!v:integer);
+begin print_char("(");
+if t<dependent then
+ if t<>pair_type then print_type(t)
+ else if nice_pair(v,pair_type) then print("pair")
+ else print("unknown pair")
+else print("unknown numeric");
+print_char(")");
+end;
+
+@ @<Declare unary action...@>=
+procedure bad_unary(@!c:quarterword);
+begin exp_err("Not implemented: "); print_op(c);
+@.Not implemented...@>
+print_known_or_unknown_type(cur_type,cur_exp);
+help3("I'm afraid I don't know how to apply that operation to that")@/
+ ("particular type. Continue, and I'll simply return the")@/
+ ("argument (shown above) as the result of the operation.");
+put_get_error;
+end;
+
+@ @<Trace the current unary operation@>=
+begin begin_diagnostic; print_nl("{"); print_op(c); print_char("(");@/
+print_exp(null,0); {show the operand, but not verbosely}
+print(")}"); end_diagnostic(false);
+end
+
+@ Negation is easy except when the current expression
+is of type |independent|, or when it is a pair with one or more
+|independent| components.
+
+It is tempting to argue that the negative of an independent variable
+is an independent variable, hence we don't have to do anything when
+negating it. The fallacy is that other dependent variables pointing
+to the current expression must change the sign of their
+coefficients if we make no change to the current expression.
+
+Instead, we work around the problem by copying the current expression
+and recycling it afterwards (cf.~the |stash_in| routine).
+
+@<Negate the current expression@>=
+case cur_type of
+pair_type,independent: begin q:=cur_exp; make_exp_copy(q);
+ if cur_type=dependent then negate_dep_list(dep_list(cur_exp))
+ else if cur_type=pair_type then
+ begin p:=value(cur_exp);
+ if type(x_part_loc(p))=known then negate(value(x_part_loc(p)))
+ else negate_dep_list(dep_list(x_part_loc(p)));
+ if type(y_part_loc(p))=known then negate(value(y_part_loc(p)))
+ else negate_dep_list(dep_list(y_part_loc(p)));
+ end; {if |cur_type=known| then |cur_exp=0|}
+ recycle_value(q); free_node(q,value_node_size);
+ end;
+dependent,proto_dependent:negate_dep_list(dep_list(cur_exp));
+known:negate(cur_exp);
+picture_type:negate_edges(cur_exp);
+othercases bad_unary(minus)
+endcases
+
+@ @<Declare unary action...@>=
+procedure negate_dep_list(@!p:pointer);
+label exit;
+begin loop@+begin negate(value(p));
+ if info(p)=null then return;
+ p:=link(p);
+ end;
+exit:end;
+
+@ @<Additional cases of unary operators@>=
+not_op: if cur_type<>boolean_type then bad_unary(not_op)
+ else cur_exp:=true_code+false_code-cur_exp;
+
+@ @d three_sixty_units==23592960 {that's |360*unity|}
+@d boolean_reset(#)==if # then cur_exp:=true_code@+else cur_exp:=false_code
+
+@<Additional cases of unary operators@>=
+sqrt_op,m_exp_op,m_log_op,sin_d_op,cos_d_op,floor_op,
+ uniform_deviate,odd_op,char_exists_op:@t@>@;@/
+ if cur_type<>known then bad_unary(c)
+ else case c of
+ sqrt_op:cur_exp:=square_rt(cur_exp);
+ m_exp_op:cur_exp:=m_exp(cur_exp);
+ m_log_op:cur_exp:=m_log(cur_exp);
+ sin_d_op,cos_d_op:begin n_sin_cos((cur_exp mod three_sixty_units)*16);
+ if c=sin_d_op then cur_exp:=round_fraction(n_sin)
+ else cur_exp:=round_fraction(n_cos);
+ end;
+ floor_op:cur_exp:=floor_scaled(cur_exp);
+ uniform_deviate:cur_exp:=unif_rand(cur_exp);
+ odd_op: begin boolean_reset(odd(round_unscaled(cur_exp)));
+ cur_type:=boolean_type;
+ end;
+ char_exists_op:@<Determine if a character has been shipped out@>;
+ end; {there are no other cases}
+
+@ @<Additional cases of unary operators@>=
+angle_op:if nice_pair(cur_exp,cur_type) then
+ begin p:=value(cur_exp);
+ x:=n_arg(value(x_part_loc(p)),value(y_part_loc(p)));
+ if x>=0 then flush_cur_exp((x+8)div 16)
+ else flush_cur_exp(-((-x+8)div 16));
+ end
+ else bad_unary(angle_op);
+
+@ If the current expression is a pair, but the context wants it to
+be a path, we call |pair_to_path|.
+
+@<Declare unary action...@>=
+procedure pair_to_path;
+begin cur_exp:=new_knot; cur_type:=path_type;
+end;
+
+@ @<Additional cases of unary operators@>=
+x_part,y_part:if (cur_type<=pair_type)and(cur_type>=transform_type) then
+ take_part(c)
+ else bad_unary(c);
+xx_part,xy_part,yx_part,yy_part: if cur_type=transform_type then take_part(c)
+ else bad_unary(c);
+
+@ In the following procedure, |cur_exp| points to a capsule, which points to
+a big node. We want to delete all but one part of the big node.
+
+@<Declare unary action...@>=
+procedure take_part(@!c:quarterword);
+var @!p:pointer; {the big node}
+begin p:=value(cur_exp); value(temp_val):=p; type(temp_val):=cur_type;
+link(p):=temp_val; free_node(cur_exp,value_node_size);
+make_exp_copy(p+2*(c-x_part));
+recycle_value(temp_val);
+end;
+
+@ @<Initialize table entries...@>=
+name_type(temp_val):=capsule;
+
+@ @<Additional cases of unary...@>=
+char_op: if cur_type<>known then bad_unary(char_op)
+ else begin cur_exp:=round_unscaled(cur_exp) mod 256; cur_type:=string_type;
+ if cur_exp<0 then cur_exp:=cur_exp+256;
+ if length(cur_exp)<>1 then
+ begin str_room(1); append_char(cur_exp); cur_exp:=make_string;
+ end;
+ end;
+decimal: if cur_type<>known then bad_unary(decimal)
+ else begin old_setting:=selector; selector:=new_string;
+ print_scaled(cur_exp); cur_exp:=make_string;
+ selector:=old_setting; cur_type:=string_type;
+ end;
+oct_op,hex_op,ASCII_op: if cur_type<>string_type then bad_unary(c)
+ else str_to_num(c);
+
+@ @<Declare unary action...@>=
+procedure str_to_num(@!c:quarterword); {converts a string to a number}
+var @!n:integer; {accumulator}
+@!m:ASCII_code; {current character}
+@!k:pool_pointer; {index into |str_pool|}
+@!b:8..16; {radix of conversion}
+@!bad_char:boolean; {did the string contain an invalid digit?}
+begin if c=ASCII_op then
+ if length(cur_exp)=0 then n:=-1
+ else n:=so(str_pool[str_start[cur_exp]])
+else begin if c=oct_op then b:=8@+else b:=16;
+ n:=0; bad_char:=false;
+ for k:=str_start[cur_exp] to str_start[cur_exp+1]-1 do
+ begin m:=so(str_pool[k]);
+ if (m>="0")and(m<="9") then m:=m-"0"
+ else if (m>="A")and(m<="F") then m:=m-"A"+10
+ else if (m>="a")and(m<="f") then m:=m-"a"+10
+ else begin bad_char:=true; m:=0;
+ end;
+ if m>=b then
+ begin bad_char:=true; m:=0;
+ end;
+ if n<32768 div b then n:=n*b+m@+else n:=32767;
+ end;
+ @<Give error messages if |bad_char| or |n>=4096|@>;
+ end;
+flush_cur_exp(n*unity);
+end;
+
+@ @<Give error messages if |bad_char|...@>=
+if bad_char then
+ begin exp_err("String contains illegal digits");
+@.String contains illegal digits@>
+ if c=oct_op then
+ help1("I zeroed out characters that weren't in the range 0..7.")
+ else help1("I zeroed out characters that weren't hex digits.");
+ put_get_error;
+ end;
+if n>4095 then
+ begin print_err("Number too large ("); print_int(n); print_char(")");
+@.Number too large@>
+ help1("I have trouble with numbers greater than 4095; watch out.");
+ put_get_error;
+ end
+
+@ The length operation is somewhat unusual in that it applies to a variety
+of different types of operands.
+
+@<Additional cases of unary...@>=
+length_op: if cur_type=string_type then flush_cur_exp(length(cur_exp)*unity)
+ else if cur_type=path_type then flush_cur_exp(path_length)
+ else if cur_type=known then cur_exp:=abs(cur_exp)
+ else if nice_pair(cur_exp,cur_type) then
+ flush_cur_exp(pyth_add(value(x_part_loc(value(cur_exp))),@|
+ value(y_part_loc(value(cur_exp)))))
+ else bad_unary(c);
+
+@ @<Declare unary action...@>=
+function path_length:scaled; {computes the length of the current path}
+var @!n:scaled; {the path length so far}
+@!p:pointer; {traverser}
+begin p:=cur_exp;
+if left_type(p)=endpoint then n:=-unity@+else n:=0;
+repeat p:=link(p); n:=n+unity;
+until p=cur_exp;
+path_length:=n;
+end;
+
+@ The turning number is computed only with respect to null pens. A different
+pen might affect the turning number, in degenerate cases, because autorounding
+will produce a slightly different path, or because excessively large coordinates
+might be truncated.
+
+@<Additional cases of unary...@>=
+turning_op:if cur_type=pair_type then flush_cur_exp(0)
+ else if cur_type<>path_type then bad_unary(turning_op)
+ else if left_type(cur_exp)=endpoint then
+ flush_cur_exp(0) {not a cyclic path}
+ else begin cur_pen:=null_pen; cur_path_type:=contour_code;
+ cur_exp:=make_spec(cur_exp,
+ fraction_one-half_unit-1-el_gordo,0);
+ flush_cur_exp(turning_number*unity); {convert to |scaled|}
+ end;
+
+@ @d type_test_end== flush_cur_exp(true_code)
+ else flush_cur_exp(false_code);
+ cur_type:=boolean_type;
+ end
+@d type_range_end(#)==(cur_type<=#) then type_test_end
+@d type_range(#)==begin if (cur_type>=#) and type_range_end
+@d type_test(#)==begin if cur_type=# then type_test_end
+
+@<Additional cases of unary operators@>=
+boolean_type: type_range(boolean_type)(unknown_boolean);
+string_type: type_range(string_type)(unknown_string);
+pen_type: type_range(pen_type)(future_pen);
+path_type: type_range(path_type)(unknown_path);
+picture_type: type_range(picture_type)(unknown_picture);
+transform_type,pair_type: type_test(c);
+numeric_type: type_range(known)(independent);
+known_op,unknown_op: test_known(c);
+
+@ @<Declare unary action procedures@>=
+procedure test_known(@!c:quarterword);
+label done;
+var @!b:true_code..false_code; {is the current expression known?}
+@!p,@!q:pointer; {locations in a big node}
+begin b:=false_code;
+case cur_type of
+vacuous,boolean_type,string_type,pen_type,future_pen,path_type,picture_type,
+ known: b:=true_code;
+transform_type,pair_type:begin p:=value(cur_exp); q:=p+big_node_size[cur_type];
+ repeat q:=q-2;
+ if type(q)<>known then goto done;
+ until q=p;
+ b:=true_code;
+done: end;
+othercases do_nothing
+endcases;
+if c=known_op then flush_cur_exp(b)
+else flush_cur_exp(true_code+false_code-b);
+cur_type:=boolean_type;
+end;
+
+@ @<Additional cases of unary operators@>=
+cycle_op: begin if cur_type<>path_type then flush_cur_exp(false_code)
+ else if left_type(cur_exp)<>endpoint then flush_cur_exp(true_code)
+ else flush_cur_exp(false_code);
+ cur_type:=boolean_type;
+ end;
+
+@ @<Additional cases of unary operators@>=
+make_pen_op: begin if cur_type=pair_type then pair_to_path;
+ if cur_type=path_type then cur_type:=future_pen
+ else bad_unary(make_pen_op);
+ end;
+make_path_op: begin if cur_type=future_pen then materialize_pen;
+ if cur_type<>pen_type then bad_unary(make_path_op)
+ else begin flush_cur_exp(make_path(cur_exp)); cur_type:=path_type;
+ end;
+ end;
+total_weight_op: if cur_type<>picture_type then bad_unary(total_weight_op)
+ else flush_cur_exp(total_weight(cur_exp));
+reverse: if cur_type=path_type then
+ begin p:=htap_ypoc(cur_exp);
+ if right_type(p)=endpoint then p:=link(p);
+ toss_knot_list(cur_exp); cur_exp:=p;
+ end
+ else if cur_type=pair_type then pair_to_path
+ else bad_unary(reverse);
+
+@ Finally, we have the operations that combine a capsule~|p|
+with the current expression.
+
+@p @t\4@>@<Declare binary action procedures@>@;
+procedure do_binary(@!p:pointer;@!c:quarterword);
+label done,done1,exit;
+var @!q,@!r,@!rr:pointer; {for list manipulation}
+@!old_p,@!old_exp:pointer; {capsules to recycle}
+@!v:integer; {for numeric manipulation}
+begin check_arith;
+if internal[tracing_commands]>two then
+ @<Trace the current binary operation@>;
+@<Sidestep |independent| cases in capsule |p|@>;
+@<Sidestep |independent| cases in the current expression@>;
+case c of
+plus,minus:@<Add or subtract the current expression from |p|@>;
+@t\4@>@<Additional cases of binary operators@>@;
+end; {there are no other cases}
+recycle_value(p); free_node(p,value_node_size); {|return| to avoid this}
+exit:check_arith; @<Recycle any sidestepped |independent| capsules@>;
+end;
+
+@ @<Declare binary action...@>=
+procedure bad_binary(@!p:pointer;@!c:quarterword);
+begin disp_err(p,"");
+exp_err("Not implemented: ");
+@.Not implemented...@>
+if c>=min_of then print_op(c);
+print_known_or_unknown_type(type(p),p);
+if c>=min_of then print("of")@+else print_op(c);
+print_known_or_unknown_type(cur_type,cur_exp);@/
+help3("I'm afraid I don't know how to apply that operation to that")@/
+ ("combination of types. Continue, and I'll return the second")@/
+ ("argument (see above) as the result of the operation.");
+put_get_error;
+end;
+
+@ @<Trace the current binary operation@>=
+begin begin_diagnostic; print_nl("{(");
+print_exp(p,0); {show the operand, but not verbosely}
+print_char(")"); print_op(c); print_char("(");@/
+print_exp(null,0); print(")}"); end_diagnostic(false);
+end
+
+@ Several of the binary operations are potentially complicated by the
+fact that |independent| values can sneak into capsules. For example,
+we've seen an instance of this difficulty in the unary operation
+of negation. In order to reduce the number of cases that need to be
+handled, we first change the two operands (if necessary)
+to rid them of |independent| components. The original operands are
+put into capsules called |old_p| and |old_exp|, which will be
+recycled after the binary operation has been safely carried out.
+
+@<Recycle any sidestepped |independent| capsules@>=
+if old_p<>null then
+ begin recycle_value(old_p); free_node(old_p,value_node_size);
+ end;
+if old_exp<>null then
+ begin recycle_value(old_exp); free_node(old_exp,value_node_size);
+ end
+
+@ A big node is considered to be ``tarnished'' if it contains at least one
+independent component. We will define a simple function called `|tarnished|'
+that returns |null| if and only if its argument is not tarnished.
+
+@<Sidestep |independent| cases in capsule |p|@>=
+case type(p) of
+transform_type,pair_type: old_p:=tarnished(p);
+independent: old_p:=void;
+othercases old_p:=null
+endcases;
+if old_p<>null then
+ begin q:=stash_cur_exp; old_p:=p; make_exp_copy(old_p);
+ p:=stash_cur_exp; unstash_cur_exp(q);
+ end;
+
+@ @<Sidestep |independent| cases in the current expression@>=
+case cur_type of
+transform_type,pair_type:old_exp:=tarnished(cur_exp);
+independent:old_exp:=void;
+othercases old_exp:=null
+endcases;
+if old_exp<>null then
+ begin old_exp:=cur_exp; make_exp_copy(old_exp);
+ end
+
+@ @<Declare binary action...@>=
+function tarnished(@!p:pointer):pointer;
+label exit;
+var @!q:pointer; {beginning of the big node}
+@!r:pointer; {current position in the big node}
+begin q:=value(p); r:=q+big_node_size[type(p)];
+repeat r:=r-2;
+if type(r)=independent then
+ begin tarnished:=void; return;
+ end;
+until r=q;
+tarnished:=null;
+exit:end;
+
+@ @<Add or subtract the current expression from |p|@>=
+if (cur_type<pair_type)or(type(p)<pair_type) then
+ if (cur_type=picture_type)and(type(p)=picture_type) then
+ begin if c=minus then negate_edges(cur_exp);
+ cur_edges:=cur_exp; merge_edges(value(p));
+ end
+ else bad_binary(p,c)
+else if cur_type=pair_type then
+ if type(p)<>pair_type then bad_binary(p,c)
+ else begin q:=value(p); r:=value(cur_exp);
+ add_or_subtract(x_part_loc(q),x_part_loc(r),c);
+ add_or_subtract(y_part_loc(q),y_part_loc(r),c);
+ end
+ else if type(p)=pair_type then bad_binary(p,c)
+ else add_or_subtract(p,null,c)
+
+@ The first argument to |add_or_subtract| is the location of a value node
+in a capsule or pair node that will soon be recycled. The second argument
+is either a location within a pair or transform node of |cur_exp|,
+or it is null (which means that |cur_exp| itself should be the second
+argument). The third argument is either |plus| or |minus|.
+
+The sum or difference of the numeric quantities will replace the second
+operand. Arithmetic overflow may go undetected; users aren't supposed to
+be monkeying around with really big values.
+
+@<Declare binary action...@>=
+@t\4@>@<Declare the procedure called |dep_finish|@>@;
+procedure add_or_subtract(@!p,@!q:pointer;@!c:quarterword);
+label done,exit;
+var @!s,@!t:small_number; {operand types}
+@!r:pointer; {list traverser}
+@!v:integer; {second operand value}
+begin if q=null then
+ begin t:=cur_type;
+ if t<dependent then v:=cur_exp@+else v:=dep_list(cur_exp);
+ end
+else begin t:=type(q);
+ if t<dependent then v:=value(q)@+else v:=dep_list(q);
+ end;
+if t=known then
+ begin if c=minus then negate(v);
+ if type(p)=known then
+ begin v:=slow_add(value(p),v);
+ if q=null then cur_exp:=v@+else value(q):=v;
+ return;
+ end;
+ @<Add a known value to the constant term of |dep_list(p)|@>;
+ end
+else begin if c=minus then negate_dep_list(v);
+ @<Add operand |p| to the dependency list |v|@>;
+ end;
+exit:end;
+
+@ @<Add a known value to the constant term of |dep_list(p)|@>=
+r:=dep_list(p);
+while info(r)<>null do r:=link(r);
+value(r):=slow_add(value(r),v);
+if q=null then
+ begin q:=get_node(value_node_size); cur_exp:=q; cur_type:=type(p);
+ name_type(q):=capsule;
+ end;
+dep_list(q):=dep_list(p); type(q):=type(p);
+prev_dep(q):=prev_dep(p); link(prev_dep(p)):=q;
+type(p):=known; {this will keep the recycler from collecting non-garbage}
+
+@ We prefer |dependent| lists to |proto_dependent| ones, because it is
+nice to retain the extra accuracy of |fraction| coefficients.
+But we have to handle both kinds, and mixtures too.
+
+@<Add operand |p| to the dependency list |v|@>=
+if type(p)=known then
+ @<Add the known |value(p)| to the constant term of |v|@>
+else begin s:=type(p); r:=dep_list(p);
+ if t=dependent then
+ begin if s=dependent then
+ if max_coef(r)+max_coef(v)<coef_bound then
+ begin v:=p_plus_q(v,r,dependent); goto done;
+ end; {|fix_needed| will necessarily be false}
+ t:=proto_dependent; v:=p_over_v(v,unity,dependent,proto_dependent);
+ end;
+ if s=proto_dependent then v:=p_plus_q(v,r,proto_dependent)
+ else v:=p_plus_fq(v,unity,r,proto_dependent,dependent);
+ done: @<Output the answer, |v| (which might have become |known|)@>;
+ end
+
+@ @<Add the known |value(p)| to the constant term of |v|@>=
+begin while info(v)<>null do v:=link(v);
+value(v):=slow_add(value(p),value(v));
+end
+
+@ @<Output the answer, |v| (which might have become |known|)@>=
+if q<>null then dep_finish(v,q,t)
+else begin cur_type:=t; dep_finish(v,null,t);
+ end
+
+@ Here's the current situation: The dependency list |v| of type |t|
+should either be put into the current expression (if |q=null|) or
+into location |q| within a pair node (otherwise). The destination (|cur_exp|
+or |q|) formerly held a dependency list with the same
+final pointer as the list |v|.
+
+@<Declare the procedure called |dep_finish|@>=
+procedure dep_finish(@!v,@!q:pointer;@!t:small_number);
+var @!p:pointer; {the destination}
+@!vv:scaled; {the value, if it is |known|}
+begin if q=null then p:=cur_exp@+else p:=q;
+dep_list(p):=v; type(p):=t;
+if info(v)=null then
+ begin vv:=value(v);
+ if q=null then flush_cur_exp(vv)
+ else begin recycle_value(p); type(q):=known; value(q):=vv;
+ end;
+ end
+else if q=null then cur_type:=t;
+if fix_needed then fix_dependencies;
+end;
+
+@ Let's turn now to the six basic relations of comparison.
+
+@<Additional cases of binary operators@>=
+less_than,less_or_equal,greater_than,greater_or_equal,equal_to,unequal_to:
+ begin@t@>@;
+ if (cur_type>pair_type)and(type(p)>pair_type) then
+ add_or_subtract(p,null,minus) {|cur_exp:=(p)-cur_exp|}
+ else if cur_type<>type(p) then
+ begin bad_binary(p,c); goto done;
+ end
+ else if cur_type=string_type then
+ flush_cur_exp(str_vs_str(value(p),cur_exp))
+ else if (cur_type=unknown_string)or(cur_type=unknown_boolean) then
+ @<Check if unknowns have been equated@>
+ else if (cur_type=pair_type)or(cur_type=transform_type) then
+ @<Reduce comparison of big nodes to comparison of scalars@>
+ else if cur_type=boolean_type then flush_cur_exp(cur_exp-value(p))
+ else begin bad_binary(p,c); goto done;
+ end;
+ @<Compare the current expression with zero@>;
+done: end;
+
+@ @<Compare the current expression with zero@>=
+if cur_type<>known then
+ begin if cur_type<known then
+ begin disp_err(p,"");
+ help1("The quantities shown above have not been equated.")@/
+ end
+ else help2("Oh dear. I can't decide if the expression above is positive,")@/
+ ("negative, or zero. So this comparison test won't be `true'.");
+ exp_err("Unknown relation will be considered false");
+@.Unknown relation...@>
+ put_get_flush_error(false_code);
+ end
+else case c of
+ less_than: boolean_reset(cur_exp<0);
+ less_or_equal: boolean_reset(cur_exp<=0);
+ greater_than: boolean_reset(cur_exp>0);
+ greater_or_equal: boolean_reset(cur_exp>=0);
+ equal_to: boolean_reset(cur_exp=0);
+ unequal_to: boolean_reset(cur_exp<>0);
+ end; {there are no other cases}
+ cur_type:=boolean_type
+
+@ When two unknown strings are in the same ring, we know that they are
+equal. Otherwise, we don't know whether they are equal or not, so we
+make no change.
+
+@<Check if unknowns have been equated@>=
+begin q:=value(cur_exp);
+while (q<>cur_exp)and(q<>p) do q:=value(q);
+if q=p then flush_cur_exp(0);
+end
+
+@ @<Reduce comparison of big nodes to comparison of scalars@>=
+begin q:=value(p); r:=value(cur_exp);
+rr:=r+big_node_size[cur_type]-2;
+loop@+ begin add_or_subtract(q,r,minus);
+ if type(r)<>known then goto done1;
+ if value(r)<>0 then goto done1;
+ if r=rr then goto done1;
+ q:=q+2; r:=r+2;
+ end;
+done1:take_part(x_part+half(r-value(cur_exp)));
+end
+
+@ Here we use the sneaky fact that |and_op-false_code=or_op-true_code|.
+
+@<Additional cases of binary operators@>=
+and_op,or_op: if (type(p)<>boolean_type)or(cur_type<>boolean_type) then
+ bad_binary(p,c)
+ else if value(p)=c+false_code-and_op then cur_exp:=value(p);
+
+@ @<Additional cases of binary operators@>=
+times: if (cur_type<pair_type)or(type(p)<pair_type) then bad_binary(p,times)
+ else if (cur_type=known)or(type(p)=known) then
+ @<Multiply when at least one operand is known@>
+ else if (nice_pair(p,type(p))and(cur_type>pair_type))
+ or(nice_pair(cur_exp,cur_type)and(type(p)>pair_type)) then
+ begin hard_times(p); return;
+ end
+ else bad_binary(p,times);
+
+@ @<Multiply when at least one operand is known@>=
+begin if type(p)=known then
+ begin v:=value(p); free_node(p,value_node_size);
+ end
+else begin v:=cur_exp; unstash_cur_exp(p);
+ end;
+if cur_type=known then cur_exp:=take_scaled(cur_exp,v)
+else if cur_type=pair_type then
+ begin p:=value(cur_exp);
+ dep_mult(x_part_loc(p),v,true);
+ dep_mult(y_part_loc(p),v,true);
+ end
+else dep_mult(null,v,true);
+return;
+end
+
+@ @<Declare binary action...@>=
+procedure dep_mult(@!p:pointer;@!v:integer;@!v_is_scaled:boolean);
+label exit;
+var @!q:pointer; {the dependency list being multiplied by |v|}
+@!s,@!t:small_number; {its type, before and after}
+begin if p=null then q:=cur_exp
+else if type(p)<>known then q:=p
+else begin if v_is_scaled then value(p):=take_scaled(value(p),v)
+ else value(p):=take_fraction(value(p),v);
+ return;
+ end;
+t:=type(q); q:=dep_list(q); s:=t;
+if t=dependent then if v_is_scaled then
+ if ab_vs_cd(max_coef(q),abs(v),coef_bound-1,unity)>=0 then t:=proto_dependent;
+q:=p_times_v(q,v,s,t,v_is_scaled); dep_finish(q,p,t);
+exit:end;
+
+@ Here is a routine that is similar to |times|; but it is invoked only
+internally, when |v| is a |fraction| whose magnitude is at most~1,
+and when |cur_type>=pair_type|.
+
+@p procedure frac_mult(@!n,@!d:scaled); {multiplies |cur_exp| by |n/d|}
+var @!p:pointer; {a pair node}
+@!old_exp:pointer; {a capsule to recycle}
+@!v:fraction; {|n/d|}
+begin if internal[tracing_commands]>two then
+ @<Trace the fraction multiplication@>;
+case cur_type of
+transform_type,pair_type:old_exp:=tarnished(cur_exp);
+independent:old_exp:=void;
+othercases old_exp:=null
+endcases;
+if old_exp<>null then
+ begin old_exp:=cur_exp; make_exp_copy(old_exp);
+ end;
+v:=make_fraction(n,d);
+if cur_type=known then cur_exp:=take_fraction(cur_exp,v)
+else if cur_type=pair_type then
+ begin p:=value(cur_exp);
+ dep_mult(x_part_loc(p),v,false);
+ dep_mult(y_part_loc(p),v,false);
+ end
+else dep_mult(null,v,false);
+if old_exp<>null then
+ begin recycle_value(old_exp); free_node(old_exp,value_node_size);
+ end
+end;
+
+@ @<Trace the fraction multiplication@>=
+begin begin_diagnostic; print_nl("{("); print_scaled(n); print_char("/");
+print_scaled(d); print(")*("); print_exp(null,0); print(")}");
+end_diagnostic(false);
+end
+
+@ The |hard_times| routine multiplies a nice pair by a dependency list.
+
+@<Declare binary action procedures@>=
+procedure hard_times(@!p:pointer);
+var @!q:pointer; {a copy of the dependent variable |p|}
+@!r:pointer; {the big node for the nice pair}
+@!u,@!v:scaled; {the known values of the nice pair}
+begin if type(p)=pair_type then
+ begin q:=stash_cur_exp; unstash_cur_exp(p); p:=q;
+ end; {now |cur_type=pair_type|}
+r:=value(cur_exp); u:=value(x_part_loc(r)); v:=value(y_part_loc(r));
+@<Move the dependent variable |p| into both parts of the pair node |r|@>;
+dep_mult(x_part_loc(r),u,true); dep_mult(y_part_loc(r),v,true);
+end;
+
+@ @<Move the dependent variable |p|...@>=
+type(y_part_loc(r)):=type(p);
+new_dep(y_part_loc(r),copy_dep_list(dep_list(p)));@/
+type(x_part_loc(r)):=type(p);
+mem[value_loc(x_part_loc(r))]:=mem[value_loc(p)];
+link(prev_dep(p)):=x_part_loc(r);
+free_node(p,value_node_size)
+
+@ @<Additional cases of binary operators@>=
+over: if (cur_type<>known)or(type(p)<pair_type) then bad_binary(p,over)
+ else begin v:=cur_exp; unstash_cur_exp(p);
+ if v=0 then @<Squeal about division by zero@>
+ else begin if cur_type=known then cur_exp:=make_scaled(cur_exp,v)
+ else if cur_type=pair_type then
+ begin p:=value(cur_exp);
+ dep_div(x_part_loc(p),v);
+ dep_div(y_part_loc(p),v);
+ end
+ else dep_div(null,v);
+ end;
+ return;
+ end;
+
+@ @<Declare binary action...@>=
+procedure dep_div(@!p:pointer;@!v:scaled);
+label exit;
+var @!q:pointer; {the dependency list being divided by |v|}
+@!s,@!t:small_number; {its type, before and after}
+begin if p=null then q:=cur_exp
+else if type(p)<>known then q:=p
+else begin value(p):=make_scaled(value(p),v); return;
+ end;
+t:=type(q); q:=dep_list(q); s:=t;
+if t=dependent then
+ if ab_vs_cd(max_coef(q),unity,coef_bound-1,abs(v))>=0 then t:=proto_dependent;
+q:=p_over_v(q,v,s,t); dep_finish(q,p,t);
+exit:end;
+
+@ @<Squeal about division by zero@>=
+begin exp_err("Division by zero");
+@.Division by zero@>
+help2("You're trying to divide the quantity shown above the error")@/
+ ("message by zero. I'm going to divide it by one instead.");
+put_get_error;
+end
+
+@ @<Additional cases of binary operators@>=
+pythag_add,pythag_sub: if (cur_type=known)and(type(p)=known) then
+ if c=pythag_add then cur_exp:=pyth_add(value(p),cur_exp)
+ else cur_exp:=pyth_sub(value(p),cur_exp)
+ else bad_binary(p,c);
+
+@ The next few sections of the program deal with affine transformations
+of coordinate data.
+
+@<Additional cases of binary operators@>=
+rotated_by,slanted_by,scaled_by,shifted_by,transformed_by,
+ x_scaled,y_scaled,z_scaled: @t@>@;@/
+ if (type(p)=path_type)or(type(p)=future_pen)or(type(p)=pen_type) then
+ begin path_trans(p,c); return;
+ end
+ else if (type(p)=pair_type)or(type(p)=transform_type) then big_trans(p,c)
+ else if type(p)=picture_type then
+ begin edges_trans(p,c); return;
+ end
+ else bad_binary(p,c);
+
+@ Let |c| be one of the eight transform operators. The procedure call
+|set_up_trans(c)| first changes |cur_exp| to a transform that corresponds to
+|c| and the original value of |cur_exp|. (In particular, |cur_exp| doesn't
+change at all if |c=transformed_by|.)
+
+Then, if all components of the resulting transform are |known|, they are
+moved to the global variables |txx|, |txy|, |tyx|, |tyy|, |tx|, |ty|;
+and |cur_exp| is changed to the known value zero.
+
+@<Declare binary action...@>=
+procedure set_up_trans(@!c:quarterword);
+label done,exit;
+var @!p,@!q,@!r:pointer; {list manipulation registers}
+begin if (c<>transformed_by)or(cur_type<>transform_type) then
+ @<Put the current transform into |cur_exp|@>;
+@<If the current transform is entirely known, stash it in global variables;
+ otherwise |return|@>;
+exit:end;
+
+@ @<Glob...@>=
+@!txx,@!txy,@!tyx,@!tyy,@!tx,@!ty:scaled; {current transform coefficients}
+
+@ @<Put the current transform...@>=
+begin p:=stash_cur_exp; cur_exp:=id_transform; cur_type:=transform_type;
+q:=value(cur_exp);
+case c of
+@<For each of the eight cases, change the relevant fields of |cur_exp|
+ and |goto done|;
+ but do nothing if capsule |p| doesn't have the appropriate type@>@;
+end; {there are no other cases}
+disp_err(p,"Improper transformation argument");
+@.Improper transformation argument@>
+help3("The expression shown above has the wrong type,")@/
+ ("so I can't transform anything using it.")@/
+ ("Proceed, and I'll omit the transformation.");
+put_get_error;
+done: recycle_value(p); free_node(p,value_node_size);
+end
+
+@ @<If the current transform is entirely known, ...@>=
+q:=value(cur_exp); r:=q+transform_node_size;
+repeat r:=r-2;
+if type(r)<>known then return;
+until r=q;
+txx:=value(xx_part_loc(q));
+txy:=value(xy_part_loc(q));
+tyx:=value(yx_part_loc(q));
+tyy:=value(yy_part_loc(q));
+tx:=value(x_part_loc(q));
+ty:=value(y_part_loc(q));
+flush_cur_exp(0)
+
+@ @<For each of the eight cases...@>=
+rotated_by:if type(p)=known then
+ @<Install sines and cosines, then |goto done|@>;
+slanted_by:if type(p)>pair_type then
+ begin install(xy_part_loc(q),p); goto done;
+ end;
+scaled_by:if type(p)>pair_type then
+ begin install(xx_part_loc(q),p); install(yy_part_loc(q),p); goto done;
+ end;
+shifted_by:if type(p)=pair_type then
+ begin r:=value(p); install(x_part_loc(q),x_part_loc(r));
+ install(y_part_loc(q),y_part_loc(r)); goto done;
+ end;
+x_scaled:if type(p)>pair_type then
+ begin install(xx_part_loc(q),p); goto done;
+ end;
+y_scaled:if type(p)>pair_type then
+ begin install(yy_part_loc(q),p); goto done;
+ end;
+z_scaled:if type(p)=pair_type then
+ @<Install a complex multiplier, then |goto done|@>;
+transformed_by:do_nothing;
+
+@ @<Install sines and cosines, then |goto done|@>=
+begin n_sin_cos((value(p) mod three_sixty_units)*16);
+value(xx_part_loc(q)):=round_fraction(n_cos);
+value(yx_part_loc(q)):=round_fraction(n_sin);
+value(xy_part_loc(q)):=-value(yx_part_loc(q));
+value(yy_part_loc(q)):=value(xx_part_loc(q));
+goto done;
+end
+
+@ @<Install a complex multiplier, then |goto done|@>=
+begin r:=value(p);
+install(xx_part_loc(q),x_part_loc(r));
+install(yy_part_loc(q),x_part_loc(r));
+install(yx_part_loc(q),y_part_loc(r));
+if type(y_part_loc(r))=known then negate(value(y_part_loc(r)))
+else negate_dep_list(dep_list(y_part_loc(r)));
+install(xy_part_loc(q),y_part_loc(r));
+goto done;
+end
+
+@ Procedure |set_up_known_trans| is like |set_up_trans|, but it
+insists that the transformation be entirely known.
+
+@<Declare binary action...@>=
+procedure set_up_known_trans(@!c:quarterword);
+begin set_up_trans(c);
+if cur_type<>known then
+ begin exp_err("Transform components aren't all known");
+@.Transform components...@>
+ help3("I'm unable to apply a partially specified transformation")@/
+ ("except to a fully known pair or transform.")@/
+ ("Proceed, and I'll omit the transformation.");
+ put_get_flush_error(0);
+ txx:=unity; txy:=0; tyx:=0; tyy:=unity; tx:=0; ty:=0;
+ end;
+end;
+
+@ Here's a procedure that applies the transform |txx..ty| to a pair of
+coordinates in locations |p| and~|q|.
+
+@<Declare binary action...@>=
+procedure trans(@!p,@!q:pointer);
+var @!v:scaled; {the new |x| value}
+begin v:=take_scaled(mem[p].sc,txx)+take_scaled(mem[q].sc,txy)+tx;
+mem[q].sc:=take_scaled(mem[p].sc,tyx)+take_scaled(mem[q].sc,tyy)+ty;
+mem[p].sc:=v;
+end;
+
+@ The simplest transformation procedure applies a transform to all
+coordinates of a path. The |null_pen| remains unchanged if it isn't
+being shifted.
+
+@<Declare binary action...@>=
+procedure path_trans(@!p:pointer;@!c:quarterword);
+label exit;
+var @!q:pointer; {list traverser}
+begin set_up_known_trans(c); unstash_cur_exp(p);
+if cur_type=pen_type then
+ begin if max_offset(cur_exp)=0 then if tx=0 then if ty=0 then return;
+ flush_cur_exp(make_path(cur_exp)); cur_type:=future_pen;
+ end;
+q:=cur_exp;
+repeat if left_type(q)<>endpoint then
+ trans(q+3,q+4); {that's |left_x| and |left_y|}
+trans(q+1,q+2); {that's |x_coord| and |y_coord|}
+if right_type(q)<>endpoint then
+ trans(q+5,q+6); {that's |right_x| and |right_y|}
+q:=link(q);
+until q=cur_exp;
+exit:end;
+
+@ The next simplest transformation procedure applies to edges.
+It is simple primarily because \MF\ doesn't allow very general
+transformations to be made, and because the tricky subroutines
+for edge transformation have already been written.
+
+@<Declare binary action...@>=
+procedure edges_trans(@!p:pointer;@!c:quarterword);
+label exit;
+begin set_up_known_trans(c); unstash_cur_exp(p); cur_edges:=cur_exp;
+if empty_edges(cur_edges) then return; {the empty set is easy to transform}
+if txx=0 then if tyy=0 then
+ if txy mod unity=0 then if tyx mod unity=0 then
+ begin xy_swap_edges; txx:=txy; tyy:=tyx; txy:=0; tyx:=0;
+ if empty_edges(cur_edges) then return;
+ end;
+if txy=0 then if tyx=0 then
+ if txx mod unity=0 then if tyy mod unity=0 then
+ @<Scale the edges, shift them, and |return|@>;
+print_err("That transformation is too hard");
+@.That transformation...@>
+help3("I can apply complicated transformations to paths,")@/
+ ("but I can only do integer operations on pictures.")@/
+ ("Proceed, and I'll omit the transformation.");
+put_get_error;
+exit:end;
+
+@ @<Scale the edges, shift them, and |return|@>=
+begin if (txx=0)or(tyy=0) then
+ begin toss_edges(cur_edges);
+ cur_exp:=get_node(edge_header_size); init_edges(cur_exp);
+ end
+else begin if txx<0 then
+ begin x_reflect_edges; txx:=-txx;
+ end;
+ if tyy<0 then
+ begin y_reflect_edges; tyy:=-tyy;
+ end;
+ if txx<>unity then x_scale_edges(txx div unity);
+ if tyy<>unity then y_scale_edges(tyy div unity);
+ @<Shift the edges by |(tx,ty)|, rounded@>;
+ end;
+return;
+end
+
+@ @<Shift the edges...@>=
+tx:=round_unscaled(tx); ty:=round_unscaled(ty);
+if (m_min(cur_edges)+tx<=0)or(m_max(cur_edges)+tx>=8192)or@|
+ (n_min(cur_edges)+ty<=0)or(n_max(cur_edges)+ty>=8191)or@|
+ (abs(tx)>=4096)or(abs(ty)>=4096) then
+ begin print_err("Too far to shift");
+@.Too far to shift@>
+ help3("I can't shift the picture as requested---it would")@/
+ ("make some coordinates too large or too small.")@/
+ ("Proceed, and I'll omit the transformation.");
+ put_get_error;
+ end
+else begin if tx<>0 then
+ begin if not valid_range(m_offset(cur_edges)-tx) then fix_offset;
+ m_min(cur_edges):=m_min(cur_edges)+tx;
+ m_max(cur_edges):=m_max(cur_edges)+tx;
+ m_offset(cur_edges):=m_offset(cur_edges)-tx;
+ last_window_time(cur_edges):=0;
+ end;
+ if ty<>0 then
+ begin n_min(cur_edges):=n_min(cur_edges)+ty;
+ n_max(cur_edges):=n_max(cur_edges)+ty;
+ n_pos(cur_edges):=n_pos(cur_edges)+ty;
+ last_window_time(cur_edges):=0;
+ end;
+ end
+
+@ The hard cases of transformation occur when big nodes are involved,
+and when some of their components are unknown.
+
+@<Declare binary action...@>=
+@t\4@>@<Declare subroutines needed by |big_trans|@>@;
+procedure big_trans(@!p:pointer;@!c:quarterword);
+label exit;
+var @!q,@!r,@!pp,@!qq:pointer; {list manipulation registers}
+@!s:small_number; {size of a big node}
+begin s:=big_node_size[type(p)]; q:=value(p); r:=q+s;
+repeat r:=r-2;
+if type(r)<>known then @<Transform an unknown big node and |return|@>;
+until r=q;
+@<Transform a known big node@>;
+exit:end; {node |p| will now be recycled by |do_binary|}
+
+@ @<Transform an unknown big node and |return|@>=
+begin set_up_known_trans(c); make_exp_copy(p); r:=value(cur_exp);
+if cur_type=transform_type then
+ begin bilin1(yy_part_loc(r),tyy,xy_part_loc(q),tyx,0);
+ bilin1(yx_part_loc(r),tyy,xx_part_loc(q),tyx,0);
+ bilin1(xy_part_loc(r),txx,yy_part_loc(q),txy,0);
+ bilin1(xx_part_loc(r),txx,yx_part_loc(q),txy,0);
+ end;
+bilin1(y_part_loc(r),tyy,x_part_loc(q),tyx,ty);
+bilin1(x_part_loc(r),txx,y_part_loc(q),txy,tx);
+return;
+end
+
+@ Let |p| point to a two-word value field inside a big node of |cur_exp|,
+and let |q| point to a another value field. The |bilin1| procedure
+replaces |p| by $p\cdot t+q\cdot u+\delta$.
+
+@<Declare subroutines needed by |big_trans|@>=
+procedure bilin1(@!p:pointer;@!t:scaled;@!q:pointer;@!u,@!delta:scaled);
+var @!r:pointer; {list traverser}
+begin if t<>unity then dep_mult(p,t,true);
+if u<>0 then
+ if type(q)=known then delta:=delta+take_scaled(value(q),u)
+ else begin @<Ensure that |type(p)=proto_dependent|@>;
+ dep_list(p):=p_plus_fq(dep_list(p),u,dep_list(q),proto_dependent,type(q));
+ end;
+if type(p)=known then value(p):=value(p)+delta
+else begin r:=dep_list(p);
+ while info(r)<>null do r:=link(r);
+ delta:=value(r)+delta;
+ if r<>dep_list(p) then value(r):=delta
+ else begin recycle_value(p); type(p):=known; value(p):=delta;
+ end;
+ end;
+if fix_needed then fix_dependencies;
+end;
+
+@ @<Ensure that |type(p)=proto_dependent|@>=
+if type(p)<>proto_dependent then
+ begin if type(p)=known then new_dep(p,const_dependency(value(p)))
+ else dep_list(p):=p_times_v(dep_list(p),unity,dependent,proto_dependent,true);
+ type(p):=proto_dependent;
+ end
+
+@ @<Transform a known big node@>=
+set_up_trans(c);
+if cur_type=known then @<Transform known by known@>
+else begin pp:=stash_cur_exp; qq:=value(pp);
+ make_exp_copy(p); r:=value(cur_exp);
+ if cur_type=transform_type then
+ begin bilin2(yy_part_loc(r),yy_part_loc(qq),
+ value(xy_part_loc(q)),yx_part_loc(qq),null);
+ bilin2(yx_part_loc(r),yy_part_loc(qq),
+ value(xx_part_loc(q)),yx_part_loc(qq),null);
+ bilin2(xy_part_loc(r),xx_part_loc(qq),
+ value(yy_part_loc(q)),xy_part_loc(qq),null);
+ bilin2(xx_part_loc(r),xx_part_loc(qq),
+ value(yx_part_loc(q)),xy_part_loc(qq),null);
+ end;
+ bilin2(y_part_loc(r),yy_part_loc(qq),
+ value(x_part_loc(q)),yx_part_loc(qq),y_part_loc(qq));
+ bilin2(x_part_loc(r),xx_part_loc(qq),
+ value(y_part_loc(q)),xy_part_loc(qq),x_part_loc(qq));
+ recycle_value(pp); free_node(pp,value_node_size);
+ end;
+
+@ Let |p| be a |proto_dependent| value whose dependency list ends
+at |dep_final|. The following procedure adds |v| times another
+numeric quantity to~|p|.
+
+@<Declare subroutines needed by |big_trans|@>=
+procedure add_mult_dep(@!p:pointer;@!v:scaled;@!r:pointer);
+begin if type(r)=known then
+ value(dep_final):=value(dep_final)+take_scaled(value(r),v)
+else begin dep_list(p):=
+ p_plus_fq(dep_list(p),v,dep_list(r),proto_dependent,type(r));
+ if fix_needed then fix_dependencies;
+ end;
+end;
+
+@ The |bilin2| procedure is something like |bilin1|, but with known
+and unknown quantities reversed. Parameter |p| points to a value field
+within the big node for |cur_exp|; and |type(p)=known|. Parameters
+|t| and~|u| point to value fields elsewhere; so does parameter~|q|,
+unless it is |null| (which stands for zero). Location~|p| will be
+replaced by $p\cdot t+v\cdot u+q$.
+
+@<Declare subroutines needed by |big_trans|@>=
+procedure bilin2(@!p,@!t:pointer;@!v:scaled;@!u,@!q:pointer);
+var @!vv:scaled; {temporary storage for |value(p)|}
+begin vv:=value(p); type(p):=proto_dependent;
+new_dep(p,const_dependency(0)); {this sets |dep_final|}
+if vv<>0 then add_mult_dep(p,vv,t); {|dep_final| doesn't change}
+if v<>0 then add_mult_dep(p,v,u);
+if q<>null then add_mult_dep(p,unity,q);
+if dep_list(p)=dep_final then
+ begin vv:=value(dep_final); recycle_value(p);
+ type(p):=known; value(p):=vv;
+ end;
+end;
+
+@ @<Transform known by known@>=
+begin make_exp_copy(p); r:=value(cur_exp);
+if cur_type=transform_type then
+ begin bilin3(yy_part_loc(r),tyy,value(xy_part_loc(q)),tyx,0);
+ bilin3(yx_part_loc(r),tyy,value(xx_part_loc(q)),tyx,0);
+ bilin3(xy_part_loc(r),txx,value(yy_part_loc(q)),txy,0);
+ bilin3(xx_part_loc(r),txx,value(yx_part_loc(q)),txy,0);
+ end;
+bilin3(y_part_loc(r),tyy,value(x_part_loc(q)),tyx,ty);
+bilin3(x_part_loc(r),txx,value(y_part_loc(q)),txy,tx);
+end
+
+@ Finally, in |bilin3| everything is |known|.
+
+@<Declare subroutines needed by |big_trans|@>=
+procedure bilin3(@!p:pointer;@!t,@!v,@!u,@!delta:scaled);
+begin if t<>unity then delta:=delta+take_scaled(value(p),t)
+else delta:=delta+value(p);
+if u<>0 then value(p):=delta+take_scaled(v,u)
+else value(p):=delta;
+end;
+
+@ @<Additional cases of binary operators@>=
+concatenate: if (cur_type=string_type)and(type(p)=string_type) then cat(p)
+ else bad_binary(p,concatenate);
+substring_of: if nice_pair(p,type(p))and(cur_type=string_type) then
+ chop_string(value(p))
+ else bad_binary(p,substring_of);
+subpath_of: begin if cur_type=pair_type then pair_to_path;
+ if nice_pair(p,type(p))and(cur_type=path_type) then
+ chop_path(value(p))
+ else bad_binary(p,subpath_of);
+ end;
+
+@ @<Declare binary action...@>=
+procedure cat(@!p:pointer);
+var @!a,@!b:str_number; {the strings being concatenated}
+@!k:pool_pointer; {index into |str_pool|}
+begin a:=value(p); b:=cur_exp; str_room(length(a)+length(b));
+for k:=str_start[a] to str_start[a+1]-1 do append_char(so(str_pool[k]));
+for k:=str_start[b] to str_start[b+1]-1 do append_char(so(str_pool[k]));
+cur_exp:=make_string; delete_str_ref(b);
+end;
+
+@ @<Declare binary action...@>=
+procedure chop_string(@!p:pointer);
+var @!a,@!b:integer; {start and stop points}
+@!l:integer; {length of the original string}
+@!k:integer; {runs from |a| to |b|}
+@!s:str_number; {the original string}
+@!reversed:boolean; {was |a>b|?}
+begin a:=round_unscaled(value(x_part_loc(p)));
+b:=round_unscaled(value(y_part_loc(p)));
+if a<=b then reversed:=false
+else begin reversed:=true; k:=a; a:=b; b:=k;
+ end;
+s:=cur_exp; l:=length(s);
+if a<0 then
+ begin a:=0;
+ if b<0 then b:=0;
+ end;
+if b>l then
+ begin b:=l;
+ if a>l then a:=l;
+ end;
+str_room(b-a);
+if reversed then
+ for k:=str_start[s]+b-1 downto str_start[s]+a do append_char(so(str_pool[k]))
+else for k:=str_start[s]+a to str_start[s]+b-1 do append_char(so(str_pool[k]));
+cur_exp:=make_string; delete_str_ref(s);
+end;
+
+@ @<Declare binary action...@>=
+procedure chop_path(@!p:pointer);
+var @!q:pointer; {a knot in the original path}
+@!pp,@!qq,@!rr,@!ss:pointer; {link variables for copies of path nodes}
+@!a,@!b,@!k,@!l:scaled; {indices for chopping}
+@!reversed:boolean; {was |a>b|?}
+begin l:=path_length; a:=value(x_part_loc(p)); b:=value(y_part_loc(p));
+if a<=b then reversed:=false
+else begin reversed:=true; k:=a; a:=b; b:=k;
+ end;
+@<Dispense with the cases |a<0| and/or |b>l|@>;
+q:=cur_exp;
+while a>=unity do
+ begin q:=link(q); a:=a-unity; b:=b-unity;
+ end;
+if b=a then @<Construct a path from |pp| to |qq| of length zero@>
+else @<Construct a path from |pp| to |qq| of length $\lceil b\rceil$@>;
+left_type(pp):=endpoint; right_type(qq):=endpoint; link(qq):=pp;
+toss_knot_list(cur_exp);
+if reversed then
+ begin cur_exp:=link(htap_ypoc(pp)); toss_knot_list(pp);
+ end
+else cur_exp:=pp;
+end;
+
+@ @<Dispense with the cases |a<0| and/or |b>l|@>=
+if a<0 then
+ if left_type(cur_exp)=endpoint then
+ begin a:=0; if b<0 then b:=0;
+ end
+ else repeat a:=a+l; b:=b+l;
+ until a>=0; {a cycle always has length |l>0|}
+if b>l then if left_type(cur_exp)=endpoint then
+ begin b:=l; if a>l then a:=l;
+ end
+ else while a>=l do
+ begin a:=a-l; b:=b-l;
+ end
+
+@ @<Construct a path from |pp| to |qq| of length $\lceil b\rceil$@>=
+begin pp:=copy_knot(q); qq:=pp;
+repeat q:=link(q); rr:=qq; qq:=copy_knot(q); link(rr):=qq; b:=b-unity;
+until b<=0;
+if a>0 then
+ begin ss:=pp; pp:=link(pp);
+ split_cubic(ss,a*@'10000,x_coord(pp),y_coord(pp)); pp:=link(ss);
+ free_node(ss,knot_node_size);
+ if rr=ss then
+ begin b:=make_scaled(b,unity-a); rr:=pp;
+ end;
+ end;
+if b<0 then
+ begin split_cubic(rr,(b+unity)*@'10000,x_coord(qq),y_coord(qq));
+ free_node(qq,knot_node_size);
+ qq:=link(rr);
+ end;
+end
+
+@ @<Construct a path from |pp| to |qq| of length zero@>=
+begin if a>0 then
+ begin qq:=link(q);
+ split_cubic(q,a*@'10000,x_coord(qq),y_coord(qq)); q:=link(q);
+ end;
+pp:=copy_knot(q); qq:=pp;
+end
+
+@ The |pair_value| routine changes the current expression to a
+given ordered pair of values.
+
+@<Declare binary action...@>=
+procedure pair_value(@!x,@!y:scaled);
+var @!p:pointer; {a pair node}
+begin p:=get_node(value_node_size); flush_cur_exp(p); cur_type:=pair_type;
+type(p):=pair_type; name_type(p):=capsule; init_big_node(p);
+p:=value(p);@/
+type(x_part_loc(p)):=known; value(x_part_loc(p)):=x;@/
+type(y_part_loc(p)):=known; value(y_part_loc(p)):=y;@/
+end;
+
+@ @<Additional cases of binary operators@>=
+point_of,precontrol_of,postcontrol_of: begin if cur_type=pair_type then
+ pair_to_path;
+ if (cur_type=path_type)and(type(p)=known) then
+ find_point(value(p),c)
+ else bad_binary(p,c);
+ end;
+pen_offset_of: begin if cur_type=future_pen then materialize_pen;
+ if (cur_type=pen_type)and nice_pair(p,type(p)) then
+ set_up_offset(value(p))
+ else bad_binary(p,pen_offset_of);
+ end;
+direction_time_of: begin if cur_type=pair_type then pair_to_path;
+ if (cur_type=path_type)and nice_pair(p,type(p)) then
+ set_up_direction_time(value(p))
+ else bad_binary(p,direction_time_of);
+ end;
+
+@ @<Declare binary action...@>=
+procedure set_up_offset(@!p:pointer);
+begin find_offset(value(x_part_loc(p)),value(y_part_loc(p)),cur_exp);
+pair_value(cur_x,cur_y);
+end;
+@#
+procedure set_up_direction_time(@!p:pointer);
+begin flush_cur_exp(find_direction_time(value(x_part_loc(p)),
+ value(y_part_loc(p)),cur_exp));
+end;
+
+@ @<Declare binary action...@>=
+procedure find_point(@!v:scaled;@!c:quarterword);
+var @!p:pointer; {the path}
+@!n:scaled; {its length}
+@!q:pointer; {successor of |p|}
+begin p:=cur_exp;@/
+if left_type(p)=endpoint then n:=-unity@+else n:=0;
+repeat p:=link(p); n:=n+unity;
+until p=cur_exp;
+if n=0 then v:=0
+else if v<0 then
+ if left_type(p)=endpoint then v:=0
+ else v:=n-1-((-v-1) mod n)
+else if v>n then
+ if left_type(p)=endpoint then v:=n
+ else v:=v mod n;
+p:=cur_exp;
+while v>=unity do
+ begin p:=link(p); v:=v-unity;
+ end;
+if v<>0 then @<Insert a fractional node by splitting the cubic@>;
+@<Set the current expression to the desired path coordinates@>;
+end;
+
+@ @<Insert a fractional node...@>=
+begin q:=link(p); split_cubic(p,v*@'10000,x_coord(q),y_coord(q)); p:=link(p);
+end
+
+@ @<Set the current expression to the desired path coordinates...@>=
+case c of
+point_of: pair_value(x_coord(p),y_coord(p));
+precontrol_of: if left_type(p)=endpoint then pair_value(x_coord(p),y_coord(p))
+ else pair_value(left_x(p),left_y(p));
+postcontrol_of: if right_type(p)=endpoint then pair_value(x_coord(p),y_coord(p))
+ else pair_value(right_x(p),right_y(p));
+end {there are no other cases}
+
+@ @<Additional cases of bin...@>=
+intersect: begin if type(p)=pair_type then
+ begin q:=stash_cur_exp; unstash_cur_exp(p);
+ pair_to_path; p:=stash_cur_exp; unstash_cur_exp(q);
+ end;
+ if cur_type=pair_type then pair_to_path;
+ if (cur_type=path_type)and(type(p)=path_type) then
+ begin path_intersection(value(p),cur_exp);
+ pair_value(cur_t,cur_tt);
+ end
+ else bad_binary(p,intersect);
+ end;
+
+@* \[43] Statements and commands.
+The chief executive of \MF\ is the |do_statement| routine, which
+contains the master switch that causes all the various pieces of \MF\
+to do their things, in the right order.
+
+In a sense, this is the grand climax of the program: It applies all the
+tools that we have worked so hard to construct. In another sense, this is
+the messiest part of the program: It necessarily refers to other pieces
+of code all over the place, so that a person can't fully understand what is
+going on without paging back and forth to be reminded of conventions that
+are defined elsewhere. We are now at the hub of the web.
+
+The structure of |do_statement| itself is quite simple. The first token
+of the statement is fetched using |get_x_next|. If it can be the first
+token of an expression, we look for an equation, an assignment, or a
+title. Otherwise we use a \&{case} construction to branch at high speed to
+the appropriate routine for various and sundry other types of commands,
+each of which has an ``action procedure'' that does the necessary work.
+
+The program uses the fact that
+$$\hbox{|min_primary_command=max_statement_command=type_name|}$$
+to interpret a statement that starts with, e.g., `\&{string}',
+as a type declaration rather than a boolean expression.
+
+@p @t\4@>@<Declare generic font output procedures@>@;
+@t\4@>@<Declare action procedures for use by |do_statement|@>@;
+procedure do_statement; {governs \MF's activities}
+begin cur_type:=vacuous; get_x_next;
+if cur_cmd>max_primary_command then @<Worry about bad statement@>
+else if cur_cmd>max_statement_command then
+ @<Do an equation, assignment, title, or
+ `$\langle\,$expression$\,\rangle\,$\&{endgroup}'@>
+else @<Do a statement that doesn't begin with an expression@>;
+if cur_cmd<semicolon then
+ @<Flush unparsable junk that was found after the statement@>;
+error_count:=0;
+end;
+
+@ The only command codes |>max_primary_command| that can be present
+at the beginning of a statement are |semicolon| and higher; these
+occur when the statement is null.
+
+@<Worry about bad statement@>=
+begin if cur_cmd<semicolon then
+ begin print_err("A statement can't begin with `");
+@.A statement can't begin with x@>
+ print_cmd_mod(cur_cmd,cur_mod); print_char("'");
+ help5("I was looking for the beginning of a new statement.")@/
+ ("If you just proceed without changing anything, I'll ignore")@/
+ ("everything up to the next `;'. Please insert a semicolon")@/
+ ("now in front of anything that you don't want me to delete.")@/
+ ("(See Chapter 27 of The METAFONTbook for an example.)");@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+ back_error; get_x_next;
+ end;
+end
+
+@ The help message printed here says that everything is flushed up to
+a semicolon, but actually the commands |end_group| and |stop| will
+also terminate a statement.
+
+@<Flush unparsable junk that was found after the statement@>=
+begin print_err("Extra tokens will be flushed");
+@.Extra tokens will be flushed@>
+help6("I've just read as much of that statement as I could fathom,")@/
+("so a semicolon should have been next. It's very puzzling...")@/
+("but I'll try to get myself back together, by ignoring")@/
+("everything up to the next `;'. Please insert a semicolon")@/
+("now in front of anything that you don't want me to delete.")@/
+("(See Chapter 27 of The METAFONTbook for an example.)");@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+back_error; scanner_status:=flushing;
+repeat get_next;
+@<Decrease the string reference count...@>;
+until end_of_statement; {|cur_cmd=semicolon|, |end_group|, or |stop|}
+scanner_status:=normal;
+end
+
+@ If |do_statement| ends with |cur_cmd=end_group|, we should have
+|cur_type=vacuous| unless the statement was simply an expression;
+in the latter case, |cur_type| and |cur_exp| should represent that
+expression.
+
+@<Do a statement that doesn't...@>=
+begin if internal[tracing_commands]>0 then show_cur_cmd_mod;
+case cur_cmd of
+type_name:do_type_declaration;
+macro_def:if cur_mod>var_def then make_op_def
+ else if cur_mod>end_def then scan_def;
+@t\4@>@<Cases of |do_statement| that invoke particular commands@>@;
+end; {there are no other cases}
+cur_type:=vacuous;
+end
+
+@ The most important statements begin with expressions.
+
+@<Do an equation, assignment, title, or...@>=
+begin var_flag:=assignment; scan_expression;
+if cur_cmd<end_group then
+ begin if cur_cmd=equals then do_equation
+ else if cur_cmd=assignment then do_assignment
+ else if cur_type=string_type then @<Do a title@>
+ else if cur_type<>vacuous then
+ begin exp_err("Isolated expression");
+@.Isolated expression@>
+ help3("I couldn't find an `=' or `:=' after the")@/
+ ("expression that is shown above this error message,")@/
+ ("so I guess I'll just ignore it and carry on.");
+ put_get_error;
+ end;
+ flush_cur_exp(0); cur_type:=vacuous;
+ end;
+end
+
+@ @<Do a title@>=
+begin if internal[tracing_titles]>0 then
+ begin print_nl(""); slow_print(cur_exp); update_terminal;
+ end;
+if internal[proofing]>0 then
+ @<Send the current expression as a title to the output file@>;
+end
+
+@ Equations and assignments are performed by the pair of mutually recursive
+@^recursion@>
+routines |do_equation| and |do_assignment|. These routines are called when
+|cur_cmd=equals| and when |cur_cmd=assignment|, respectively; the left-hand
+side is in |cur_type| and |cur_exp|, while the right-hand side is yet
+to be scanned. After the routines are finished, |cur_type| and |cur_exp|
+will be equal to the right-hand side (which will normally be equal
+to the left-hand side).
+
+@<Declare action procedures for use by |do_statement|@>=
+@t\4@>@<Declare the procedure called |try_eq|@>@;
+@t\4@>@<Declare the procedure called |make_eq|@>@;
+procedure@?do_assignment; forward;@t\2@>@/
+procedure do_equation;
+var @!lhs:pointer; {capsule for the left-hand side}
+@!p:pointer; {temporary register}
+begin lhs:=stash_cur_exp; get_x_next; var_flag:=assignment; scan_expression;
+if cur_cmd=equals then do_equation
+else if cur_cmd=assignment then do_assignment;
+if internal[tracing_commands]>two then @<Trace the current equation@>;
+if cur_type=unknown_path then if type(lhs)=pair_type then
+ begin p:=stash_cur_exp; unstash_cur_exp(lhs); lhs:=p;
+ end; {in this case |make_eq| will change the pair to a path}
+make_eq(lhs); {equate |lhs| to |(cur_type,cur_exp)|}
+end;
+
+@ And |do_assignment| is similar to |do_expression|:
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_assignment;
+var @!lhs:pointer; {token list for the left-hand side}
+@!p:pointer; {where the left-hand value is stored}
+@!q:pointer; {temporary capsule for the right-hand value}
+begin if cur_type<>token_list then
+ begin exp_err("Improper `:=' will be changed to `='");
+@.Improper `:='@>
+ help2("I didn't find a variable name at the left of the `:=',")@/
+ ("so I'm going to pretend that you said `=' instead.");@/
+ error; do_equation;
+ end
+else begin lhs:=cur_exp; cur_type:=vacuous;@/
+ get_x_next; var_flag:=assignment; scan_expression;
+ if cur_cmd=equals then do_equation
+ else if cur_cmd=assignment then do_assignment;
+ if internal[tracing_commands]>two then @<Trace the current assignment@>;
+ if info(lhs)>hash_end then
+ @<Assign the current expression to an internal variable@>
+ else @<Assign the current expression to the variable |lhs|@>;
+ flush_node_list(lhs);
+ end;
+end;
+
+@ @<Trace the current equation@>=
+begin begin_diagnostic; print_nl("{("); print_exp(lhs,0);
+print(")=("); print_exp(null,0); print(")}"); end_diagnostic(false);
+end
+
+@ @<Trace the current assignment@>=
+begin begin_diagnostic; print_nl("{");
+if info(lhs)>hash_end then slow_print(int_name[info(lhs)-(hash_end)])
+else show_token_list(lhs,null,1000,0);
+print(":="); print_exp(null,0); print_char("}"); end_diagnostic(false);
+end
+
+@ @<Assign the current expression to an internal variable@>=
+if cur_type=known then internal[info(lhs)-(hash_end)]:=cur_exp
+else begin exp_err("Internal quantity `");
+@.Internal quantity...@>
+ slow_print(int_name[info(lhs)-(hash_end)]);
+ print("' must receive a known value");
+ help2("I can't set an internal quantity to anything but a known")@/
+ ("numeric value, so I'll have to ignore this assignment.");
+ put_get_error;
+ end
+
+@ @<Assign the current expression to the variable |lhs|@>=
+begin p:=find_variable(lhs);
+if p<>null then
+ begin q:=stash_cur_exp; cur_type:=und_type(p); recycle_value(p);
+ type(p):=cur_type; value(p):=null; make_exp_copy(p);
+ p:=stash_cur_exp; unstash_cur_exp(q); make_eq(p);
+ end
+else begin obliterated(lhs); put_get_error;
+ end;
+end
+
+
+@ And now we get to the nitty-gritty. The |make_eq| procedure is given
+a pointer to a capsule that is to be equated to the current expression.
+
+@<Declare the procedure called |make_eq|@>=
+procedure make_eq(@!lhs:pointer);
+label restart,done, not_found;
+var @!t:small_number; {type of the left-hand side}
+@!v:integer; {value of the left-hand side}
+@!p,@!q:pointer; {pointers inside of big nodes}
+begin restart: t:=type(lhs);
+if t<=pair_type then v:=value(lhs);
+case t of
+@t\4@>@<For each type |t|, make an equation and |goto done| unless |cur_type|
+ is incompatible with~|t|@>@;
+end; {all cases have been listed}
+@<Announce that the equation cannot be performed@>;
+done:check_arith; recycle_value(lhs); free_node(lhs,value_node_size);
+end;
+
+@ @<Announce that the equation cannot be performed@>=
+disp_err(lhs,""); exp_err("Equation cannot be performed (");
+@.Equation cannot be performed@>
+if type(lhs)<=pair_type then print_type(type(lhs))@+else print("numeric");
+print_char("=");
+if cur_type<=pair_type then print_type(cur_type)@+else print("numeric");
+print_char(")");@/
+help2("I'm sorry, but I don't know how to make such things equal.")@/
+ ("(See the two expressions just above the error message.)");
+put_get_error
+
+@ @<For each type |t|, make an equation and |goto done| unless...@>=
+boolean_type,string_type,pen_type,path_type,picture_type:
+ if cur_type=t+unknown_tag then
+ begin nonlinear_eq(v,cur_exp,false); goto done;
+ end
+ else if cur_type=t then
+ @<Report redundant or inconsistent equation and |goto done|@>;
+unknown_types:if cur_type=t-unknown_tag then
+ begin nonlinear_eq(cur_exp,lhs,true); goto done;
+ end
+ else if cur_type=t then
+ begin ring_merge(lhs,cur_exp); goto done;
+ end
+ else if cur_type=pair_type then if t=unknown_path then
+ begin pair_to_path; goto restart;
+ end;
+transform_type,pair_type:if cur_type=t then
+ @<Do multiple equations and |goto done|@>;
+known,dependent,proto_dependent,independent:if cur_type>=known then
+ begin try_eq(lhs,null); goto done;
+ end;
+vacuous:do_nothing;
+
+@ @<Report redundant or inconsistent equation and |goto done|@>=
+begin if cur_type<=string_type then
+ begin if cur_type=string_type then
+ begin if str_vs_str(v,cur_exp)<>0 then goto not_found;
+ end
+ else if v<>cur_exp then goto not_found;
+ @<Exclaim about a redundant equation@>; goto done;
+ end;
+print_err("Redundant or inconsistent equation");
+@.Redundant or inconsistent equation@>
+help2("An equation between already-known quantities can't help.")@/
+ ("But don't worry; continue and I'll just ignore it.");
+put_get_error; goto done;
+not_found: print_err("Inconsistent equation");
+@.Inconsistent equation@>
+help2("The equation I just read contradicts what was said before.")@/
+ ("But don't worry; continue and I'll just ignore it.");
+put_get_error; goto done;
+end
+
+@ @<Do multiple equations and |goto done|@>=
+begin p:=v+big_node_size[t]; q:=value(cur_exp)+big_node_size[t];
+repeat p:=p-2; q:=q-2; try_eq(p,q);
+until p=v;
+goto done;
+end
+
+@ The first argument to |try_eq| is the location of a value node
+in a capsule that will soon be recycled. The second argument is
+either a location within a pair or transform node pointed to by
+|cur_exp|, or it is |null| (which means that |cur_exp| itself
+serves as the second argument). The idea is to leave |cur_exp| unchanged,
+but to equate the two operands.
+
+@<Declare the procedure called |try_eq|@>=
+procedure try_eq(@!l,@!r:pointer);
+label done,done1;
+var @!p:pointer; {dependency list for right operand minus left operand}
+@!t:known..independent; {the type of list |p|}
+@!q:pointer; {the constant term of |p| is here}
+@!pp:pointer; {dependency list for right operand}
+@!tt:dependent..independent; {the type of list |pp|}
+@!copied:boolean; {have we copied a list that ought to be recycled?}
+begin @<Remove the left operand from its container, negate it, and
+ put it into dependency list~|p| with constant term~|q|@>;
+@<Add the right operand to list |p|@>;
+if info(p)=null then @<Deal with redundant or inconsistent equation@>
+else begin linear_eq(p,t);
+ if r=null then if cur_type<>known then if type(cur_exp)=known then
+ begin pp:=cur_exp; cur_exp:=value(cur_exp); cur_type:=known;
+ free_node(pp,value_node_size);
+ end;
+ end;
+end;
+
+@ @<Remove the left operand from its container, negate it, and...@>=
+t:=type(l);
+if t=known then
+ begin t:=dependent; p:=const_dependency(-value(l)); q:=p;
+ end
+else if t=independent then
+ begin t:=dependent; p:=single_dependency(l); negate(value(p));
+ q:=dep_final;
+ end
+else begin p:=dep_list(l); q:=p;
+ loop@+ begin negate(value(q));
+ if info(q)=null then goto done;
+ q:=link(q);
+ end;
+ done: link(prev_dep(l)):=link(q); prev_dep(link(q)):=prev_dep(l);
+ type(l):=known;
+ end
+
+@ @<Deal with redundant or inconsistent equation@>=
+begin if abs(value(p))>64 then {off by .001 or more}
+ begin print_err("Inconsistent equation");@/
+@.Inconsistent equation@>
+ print(" (off by "); print_scaled(value(p)); print_char(")");
+ help2("The equation I just read contradicts what was said before.")@/
+ ("But don't worry; continue and I'll just ignore it.");
+ put_get_error;
+ end
+else if r=null then @<Exclaim about a redundant equation@>;
+free_node(p,dep_node_size);
+end
+
+@ @<Add the right operand to list |p|@>=
+if r=null then
+ if cur_type=known then
+ begin value(q):=value(q)+cur_exp; goto done1;
+ end
+ else begin tt:=cur_type;
+ if tt=independent then pp:=single_dependency(cur_exp)
+ else pp:=dep_list(cur_exp);
+ end
+else if type(r)=known then
+ begin value(q):=value(q)+value(r); goto done1;
+ end
+ else begin tt:=type(r);
+ if tt=independent then pp:=single_dependency(r)
+ else pp:=dep_list(r);
+ end;
+if tt<>independent then copied:=false
+else begin copied:=true; tt:=dependent;
+ end;
+@<Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t|@>;
+if copied then flush_node_list(pp);
+done1:
+
+@ @<Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t|@>=
+watch_coefs:=false;
+if t=tt then p:=p_plus_q(p,pp,t)
+else if t=proto_dependent then
+ p:=p_plus_fq(p,unity,pp,proto_dependent,dependent)
+else begin q:=p;
+ while info(q)<>null do
+ begin value(q):=round_fraction(value(q)); q:=link(q);
+ end;
+ t:=proto_dependent; p:=p_plus_q(p,pp,t);
+ end;
+watch_coefs:=true;
+
+@ Our next goal is to process type declarations. For this purpose it's
+convenient to have a procedure that scans a $\langle\,$declared
+variable$\,\rangle$ and returns the corresponding token list. After the
+following procedure has acted, the token after the declared variable
+will have been scanned, so it will appear in |cur_cmd|, |cur_mod|,
+and~|cur_sym|.
+
+@<Declare the function called |scan_declared_variable|@>=
+function scan_declared_variable:pointer;
+label done;
+var @!x:pointer; {hash address of the variable's root}
+@!h,@!t:pointer; {head and tail of the token list to be returned}
+@!l:pointer; {hash address of left bracket}
+begin get_symbol; x:=cur_sym;
+if cur_cmd<>tag_token then clear_symbol(x,false);
+h:=get_avail; info(h):=x; t:=h;@/
+loop@+ begin get_x_next;
+ if cur_sym=0 then goto done;
+ if cur_cmd<>tag_token then if cur_cmd<>internal_quantity then
+ if cur_cmd=left_bracket then @<Descend past a collective subscript@>
+ else goto done;
+ link(t):=get_avail; t:=link(t); info(t):=cur_sym;
+ end;
+done: if eq_type(x)<>tag_token then clear_symbol(x,false);
+if equiv(x)=null then new_root(x);
+scan_declared_variable:=h;
+end;
+
+@ If the subscript isn't collective, we don't accept it as part of the
+declared variable.
+
+@<Descend past a collective subscript@>=
+begin l:=cur_sym; get_x_next;
+if cur_cmd<>right_bracket then
+ begin back_input; cur_sym:=l; cur_cmd:=left_bracket; goto done;
+ end
+else cur_sym:=collective_subscript;
+end
+
+@ Type declarations are introduced by the following primitive operations.
+
+@<Put each...@>=
+primitive("numeric",type_name,numeric_type);@/
+@!@:numeric_}{\&{numeric} primitive@>
+primitive("string",type_name,string_type);@/
+@!@:string_}{\&{string} primitive@>
+primitive("boolean",type_name,boolean_type);@/
+@!@:boolean_}{\&{boolean} primitive@>
+primitive("path",type_name,path_type);@/
+@!@:path_}{\&{path} primitive@>
+primitive("pen",type_name,pen_type);@/
+@!@:pen_}{\&{pen} primitive@>
+primitive("picture",type_name,picture_type);@/
+@!@:picture_}{\&{picture} primitive@>
+primitive("transform",type_name,transform_type);@/
+@!@:transform_}{\&{transform} primitive@>
+primitive("pair",type_name,pair_type);@/
+@!@:pair_}{\&{pair} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+type_name: print_type(m);
+
+@ Now we are ready to handle type declarations, assuming that a
+|type_name| has just been scanned.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_type_declaration;
+var @!t:small_number; {the type being declared}
+@!p:pointer; {token list for a declared variable}
+@!q:pointer; {value node for the variable}
+begin if cur_mod>=transform_type then t:=cur_mod@+else t:=cur_mod+unknown_tag;
+repeat p:=scan_declared_variable;
+flush_variable(equiv(info(p)),link(p),false);@/
+q:=find_variable(p);
+if q<>null then
+ begin type(q):=t; value(q):=null;
+ end
+else begin print_err("Declared variable conflicts with previous vardef");
+@.Declared variable conflicts...@>
+ help2("You can't use, e.g., `numeric foo[]' after `vardef foo'.")@/
+ ("Proceed, and I'll ignore the illegal redeclaration.");
+ put_get_error;
+ end;
+flush_list(p);
+if cur_cmd<comma then @<Flush spurious symbols after the declared variable@>;
+until end_of_statement;
+end;
+
+@ @<Flush spurious symbols after the declared variable@>=
+begin print_err("Illegal suffix of declared variable will be flushed");
+@.Illegal suffix...flushed@>
+help5("Variables in declarations must consist entirely of")@/
+ ("names and collective subscripts, e.g., `x[]a'.")@/
+ ("Are you trying to use a reserved word in a variable name?")@/
+ ("I'm going to discard the junk I found here,")@/
+ ("up to the next comma or the end of the declaration.");
+if cur_cmd=numeric_token then
+ help_line[2]:="Explicit subscripts like `x15a' aren't permitted.";
+put_get_error; scanner_status:=flushing;
+repeat get_next;
+@<Decrease the string reference count...@>;
+until cur_cmd>=comma; {either |end_of_statement| or |cur_cmd=comma|}
+scanner_status:=normal;
+end
+
+@ \MF's |main_control| procedure just calls |do_statement| repeatedly
+until coming to the end of the user's program.
+Each execution of |do_statement| concludes with
+|cur_cmd=semicolon|, |end_group|, or |stop|.
+
+@p procedure main_control;
+begin repeat do_statement;
+if cur_cmd=end_group then
+ begin print_err("Extra `endgroup'");
+@.Extra `endgroup'@>
+ help2("I'm not currently working on a `begingroup',")@/
+ ("so I had better not try to end anything.");
+ flush_error(0);
+ end;
+until cur_cmd=stop;
+end;
+
+@ @<Put each...@>=
+primitive("end",stop,0);@/
+@!@:end_}{\&{end} primitive@>
+primitive("dump",stop,1);@/
+@!@:dump_}{\&{dump} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+stop:if m=0 then print("end")@+else print("dump");
+
+@* \[44] Commands.
+Let's turn now to statements that are classified as ``commands'' because
+of their imperative nature. We'll begin with simple ones, so that it
+will be clear how to hook command processing into the |do_statement| routine;
+then we'll tackle the tougher commands.
+
+Here's one of the simplest:
+
+@<Cases of |do_statement|...@>=
+random_seed: do_random_seed;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_random_seed;
+begin get_x_next;
+if cur_cmd<>assignment then
+ begin missing_err(":=");
+@.Missing `:='@>
+ help1("Always say `randomseed:=<numeric expression>'.");
+ back_error;
+ end;
+get_x_next; scan_expression;
+if cur_type<>known then
+ begin exp_err("Unknown value will be ignored");
+@.Unknown value...ignored@>
+ help2("Your expression was too random for me to handle,")@/
+ ("so I won't change the random seed just now.");@/
+ put_get_flush_error(0);
+ end
+else @<Initialize the random seed to |cur_exp|@>;
+end;
+
+@ @<Initialize the random seed to |cur_exp|@>=
+begin init_randoms(cur_exp);
+if selector>=log_only then
+ begin old_setting:=selector; selector:=log_only;
+ print_nl("{randomseed:="); print_scaled(cur_exp); print_char("}");
+ print_nl(""); selector:=old_setting;
+ end;
+end
+
+@ And here's another simple one (somewhat different in flavor):
+
+@<Cases of |do_statement|...@>=
+mode_command: begin print_ln; interaction:=cur_mod;
+ @<Initialize the print |selector| based on |interaction|@>;
+ if log_opened then selector:=selector+2;
+ get_x_next;
+ end;
+
+@ @<Put each...@>=
+primitive("batchmode",mode_command,batch_mode);
+@!@:batch_mode_}{\&{batchmode} primitive@>
+primitive("nonstopmode",mode_command,nonstop_mode);
+@!@:nonstop_mode_}{\&{nonstopmode} primitive@>
+primitive("scrollmode",mode_command,scroll_mode);
+@!@:scroll_mode_}{\&{scrollmode} primitive@>
+primitive("errorstopmode",mode_command,error_stop_mode);
+@!@:error_stop_mode_}{\&{errorstopmode} primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+mode_command: case m of
+ batch_mode: print("batchmode");
+ nonstop_mode: print("nonstopmode");
+ scroll_mode: print("scrollmode");
+ othercases print("errorstopmode")
+ endcases;
+
+@ The `\&{inner}' and `\&{outer}' commands are only slightly harder.
+
+@<Cases of |do_statement|...@>=
+protection_command: do_protection;
+
+@ @<Put each...@>=
+primitive("inner",protection_command,0);@/
+@!@:inner_}{\&{inner} primitive@>
+primitive("outer",protection_command,1);@/
+@!@:outer_}{\&{outer} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+protection_command: if m=0 then print("inner")@+else print("outer");
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_protection;
+var @!m:0..1; {0 to unprotect, 1 to protect}
+@!t:halfword; {the |eq_type| before we change it}
+begin m:=cur_mod;
+repeat get_symbol; t:=eq_type(cur_sym);
+ if m=0 then
+ begin if t>=outer_tag then eq_type(cur_sym):=t-outer_tag;
+ end
+ else if t<outer_tag then eq_type(cur_sym):=t+outer_tag;
+ get_x_next;
+until cur_cmd<>comma;
+end;
+
+@ \MF\ never defines the tokens `\.(' and `\.)' to be primitives, but
+plain \MF\ begins with the declaration `\&{delimiters} \.{()}'. Such a
+declaration assigns the command code |left_delimiter| to `\.{(}' and
+|right_delimiter| to `\.{)}'; the |equiv| of each delimiter is the
+hash address of its mate.
+
+@<Cases of |do_statement|...@>=
+delimiters: def_delims;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure def_delims;
+var l_delim,r_delim:pointer; {the new delimiter pair}
+begin get_clear_symbol; l_delim:=cur_sym;@/
+get_clear_symbol; r_delim:=cur_sym;@/
+eq_type(l_delim):=left_delimiter; equiv(l_delim):=r_delim;@/
+eq_type(r_delim):=right_delimiter; equiv(r_delim):=l_delim;@/
+get_x_next;
+end;
+
+@ Here is a procedure that is called when \MF\ has reached a point
+where some right delimiter is mandatory.
+
+@<Declare the procedure called |check_delimiter|@>=
+procedure check_delimiter(@!l_delim,@!r_delim:pointer);
+label exit;
+begin if cur_cmd=right_delimiter then if cur_mod=l_delim then return;
+if cur_sym<>r_delim then
+ begin missing_err(text(r_delim));@/
+@.Missing `)'@>
+ help2("I found no right delimiter to match a left one. So I've")@/
+ ("put one in, behind the scenes; this may fix the problem.");
+ back_error;
+ end
+else begin print_err("The token `"); slow_print(text(r_delim));
+@.The token...delimiter@>
+ print("' is no longer a right delimiter");
+ help3("Strange: This token has lost its former meaning!")@/
+ ("I'll read it as a right delimiter this time;")@/
+ ("but watch out, I'll probably miss it later.");
+ error;
+ end;
+exit:end;
+
+@ The next four commands save or change the values associated with tokens.
+
+@<Cases of |do_statement|...@>=
+save_command: repeat get_symbol; save_variable(cur_sym); get_x_next;
+ until cur_cmd<>comma;
+interim_command: do_interim;
+let_command: do_let;
+new_internal: do_new_internal;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure@?do_statement; forward;@t\2@>@/
+procedure do_interim;
+begin get_x_next;
+if cur_cmd<>internal_quantity then
+ begin print_err("The token `");
+@.The token...quantity@>
+ if cur_sym=0 then print("(%CAPSULE)")
+ else slow_print(text(cur_sym));
+ print("' isn't an internal quantity");
+ help1("Something like `tracingonline' should follow `interim'.");
+ back_error;
+ end
+else begin save_internal(cur_mod); back_input;
+ end;
+do_statement;
+end;
+
+@ The following procedure is careful not to undefine the left-hand symbol
+too soon, lest commands like `{\tt let x=x}' have a surprising effect.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_let;
+var @!l:pointer; {hash location of the left-hand symbol}
+begin get_symbol; l:=cur_sym; get_x_next;
+if cur_cmd<>equals then if cur_cmd<>assignment then
+ begin missing_err("=");
+@.Missing `='@>
+ help3("You should have said `let symbol = something'.")@/
+ ("But don't worry; I'll pretend that an equals sign")@/
+ ("was present. The next token I read will be `something'.");
+ back_error;
+ end;
+get_symbol;
+case cur_cmd of
+defined_macro,secondary_primary_macro,tertiary_secondary_macro,
+ expression_tertiary_macro: add_mac_ref(cur_mod);
+othercases do_nothing
+endcases;@/
+clear_symbol(l,false); eq_type(l):=cur_cmd;
+if cur_cmd=tag_token then equiv(l):=null
+else equiv(l):=cur_mod;
+get_x_next;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_new_internal;
+begin repeat if int_ptr=max_internal then
+ overflow("number of internals",max_internal);
+@:METAFONT capacity exceeded number of int}{\quad number of internals@>
+get_clear_symbol; incr(int_ptr);
+eq_type(cur_sym):=internal_quantity; equiv(cur_sym):=int_ptr;
+int_name[int_ptr]:=text(cur_sym); internal[int_ptr]:=0;
+get_x_next;
+until cur_cmd<>comma;
+end;
+
+@ The various `\&{show}' commands are distinguished by modifier fields
+in the usual way.
+
+@d show_token_code=0 {show the meaning of a single token}
+@d show_stats_code=1 {show current memory and string usage}
+@d show_code=2 {show a list of expressions}
+@d show_var_code=3 {show a variable and its descendents}
+@d show_dependencies_code=4 {show dependent variables in terms of independents}
+
+@<Put each...@>=
+primitive("showtoken",show_command,show_token_code);@/
+@!@:show_token_}{\&{showtoken} primitive@>
+primitive("showstats",show_command,show_stats_code);@/
+@!@:show_stats_}{\&{showstats} primitive@>
+primitive("show",show_command,show_code);@/
+@!@:show_}{\&{show} primitive@>
+primitive("showvariable",show_command,show_var_code);@/
+@!@:show_var_}{\&{showvariable} primitive@>
+primitive("showdependencies",show_command,show_dependencies_code);@/
+@!@:show_dependencies_}{\&{showdependencies} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+show_command: case m of
+ show_token_code:print("showtoken");
+ show_stats_code:print("showstats");
+ show_code:print("show");
+ show_var_code:print("showvariable");
+ othercases print("showdependencies")
+ endcases;
+
+@ @<Cases of |do_statement|...@>=
+show_command:do_show_whatever;
+
+@ The value of |cur_mod| controls the |verbosity| in the |print_exp| routine:
+If it's |show_code|, complicated structures are abbreviated, otherwise
+they aren't.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_show;
+begin repeat get_x_next; scan_expression;
+print_nl(">> ");
+@.>>@>
+print_exp(null,2); flush_cur_exp(0);
+until cur_cmd<>comma;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure disp_token;
+begin print_nl("> ");
+@.>\relax@>
+if cur_sym=0 then @<Show a numeric or string or capsule token@>
+else begin slow_print(text(cur_sym)); print_char("=");
+ if eq_type(cur_sym)>=outer_tag then print("(outer) ");
+ print_cmd_mod(cur_cmd,cur_mod);
+ if cur_cmd=defined_macro then
+ begin print_ln; show_macro(cur_mod,null,100000);
+ end; {this avoids recursion between |show_macro| and |print_cmd_mod|}
+@^recursion@>
+ end;
+end;
+
+@ @<Show a numeric or string or capsule token@>=
+begin if cur_cmd=numeric_token then print_scaled(cur_mod)
+else if cur_cmd=capsule_token then
+ begin g_pointer:=cur_mod; print_capsule;
+ end
+else begin print_char(""""); slow_print(cur_mod); print_char("""");
+ delete_str_ref(cur_mod);
+ end;
+end
+
+@ The following cases of |print_cmd_mod| might arise in connection
+with |disp_token|, although they don't correspond to any
+primitive tokens.
+
+@<Cases of |print_cmd_...@>=
+left_delimiter,right_delimiter: begin if c=left_delimiter then print("lef")
+ else print("righ");
+ print("t delimiter that matches "); slow_print(text(m));
+ end;
+tag_token:if m=null then print("tag")@+else print("variable");
+defined_macro: print("macro:");
+secondary_primary_macro,tertiary_secondary_macro,expression_tertiary_macro:
+ begin print_cmd_mod(macro_def,c); print("'d macro:");
+ print_ln; show_token_list(link(link(m)),null,1000,0);
+ end;
+repeat_loop:print("[repeat the loop]");
+internal_quantity:slow_print(int_name[m]);
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_show_token;
+begin repeat get_next; disp_token;
+get_x_next;
+until cur_cmd<>comma;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_show_stats;
+begin print_nl("Memory usage ");
+@.Memory usage...@>
+@!stat print_int(var_used); print_char("&"); print_int(dyn_used);
+if false then@+tats@t@>@;@/
+print("unknown");
+print(" ("); print_int(hi_mem_min-lo_mem_max-1);
+print(" still untouched)"); print_ln;
+print_nl("String usage ");
+print_int(str_ptr-init_str_ptr); print_char("&");
+print_int(pool_ptr-init_pool_ptr);
+print(" (");
+print_int(max_strings-max_str_ptr); print_char("&");
+print_int(pool_size-max_pool_ptr); print(" still untouched)"); print_ln;
+get_x_next;
+end;
+
+@ Here's a recursive procedure that gives an abbreviated account
+of a variable, for use by |do_show_var|.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure disp_var(@!p:pointer);
+var @!q:pointer; {traverses attributes and subscripts}
+@!n:0..max_print_line; {amount of macro text to show}
+begin if type(p)=structured then @<Descend the structure@>
+else if type(p)>=unsuffixed_macro then @<Display a variable macro@>
+else if type(p)<>undefined then
+ begin print_nl(""); print_variable_name(p); print_char("=");
+ print_exp(p,0);
+ end;
+end;
+
+@ @<Descend the structure@>=
+begin q:=attr_head(p);
+repeat disp_var(q); q:=link(q);
+until q=end_attr;
+q:=subscr_head(p);
+while name_type(q)=subscr do
+ begin disp_var(q); q:=link(q);
+ end;
+end
+
+@ @<Display a variable macro@>=
+begin print_nl(""); print_variable_name(p);
+if type(p)>unsuffixed_macro then print("@@#"); {|suffixed_macro|}
+print("=macro:");
+if file_offset>=max_print_line-20 then n:=5
+else n:=max_print_line-file_offset-15;
+show_macro(value(p),null,n);
+end
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_show_var;
+label done;
+begin repeat get_next;
+if cur_sym>0 then if cur_sym<=hash_end then
+ if cur_cmd=tag_token then if cur_mod<>null then
+ begin disp_var(cur_mod); goto done;
+ end;
+disp_token;
+done:get_x_next;
+until cur_cmd<>comma;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_show_dependencies;
+var @!p:pointer; {link that runs through all dependencies}
+begin p:=link(dep_head);
+while p<>dep_head do
+ begin if interesting(p) then
+ begin print_nl(""); print_variable_name(p);
+ if type(p)=dependent then print_char("=")
+ else print(" = "); {extra spaces imply proto-dependency}
+ print_dependency(dep_list(p),type(p));
+ end;
+ p:=dep_list(p);
+ while info(p)<>null do p:=link(p);
+ p:=link(p);
+ end;
+get_x_next;
+end;
+
+@ Finally we are ready for the procedure that governs all of the
+show commands.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_show_whatever;
+begin if interaction=error_stop_mode then wake_up_terminal;
+case cur_mod of
+show_token_code:do_show_token;
+show_stats_code:do_show_stats;
+show_code:do_show;
+show_var_code:do_show_var;
+show_dependencies_code:do_show_dependencies;
+end; {there are no other cases}
+if internal[showstopping]>0 then
+ begin print_err("OK");
+@.OK@>
+ if interaction<error_stop_mode then
+ begin help0; decr(error_count);
+ end
+ else help1("This isn't an error message; I'm just showing something.");
+ if cur_cmd=semicolon then error@+else put_get_error;
+ end;
+end;
+
+@ The `\&{addto}' command needs the following additional primitives:
+
+@d drop_code=0 {command modifier for `\&{dropping}'}
+@d keep_code=1 {command modifier for `\&{keeping}'}
+
+@<Put each...@>=
+primitive("contour",thing_to_add,contour_code);@/
+@!@:contour_}{\&{contour} primitive@>
+primitive("doublepath",thing_to_add,double_path_code);@/
+@!@:double_path_}{\&{doublepath} primitive@>
+primitive("also",thing_to_add,also_code);@/
+@!@:also_}{\&{also} primitive@>
+primitive("withpen",with_option,pen_type);@/
+@!@:with_pen_}{\&{withpen} primitive@>
+primitive("withweight",with_option,known);@/
+@!@:with_weight_}{\&{withweight} primitive@>
+primitive("dropping",cull_op,drop_code);@/
+@!@:dropping_}{\&{dropping} primitive@>
+primitive("keeping",cull_op,keep_code);@/
+@!@:keeping_}{\&{keeping} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+thing_to_add:if m=contour_code then print("contour")
+ else if m=double_path_code then print("doublepath")
+ else print("also");
+with_option:if m=pen_type then print("withpen")
+ else print("withweight");
+cull_op:if m=drop_code then print("dropping")
+ else print("keeping");
+
+@ @<Declare action procedures for use by |do_statement|@>=
+function scan_with:boolean;
+var @!t:small_number; {|known| or |pen_type|}
+@!result:boolean; {the value to return}
+begin t:=cur_mod; cur_type:=vacuous; get_x_next; scan_expression;
+result:=false;
+if cur_type<>t then @<Complain about improper type@>
+else if cur_type=pen_type then result:=true
+else @<Check the tentative weight@>;
+scan_with:=result;
+end;
+
+@ @<Complain about improper type@>=
+begin exp_err("Improper type");
+@.Improper type@>
+help2("Next time say `withweight <known numeric expression>';")@/
+ ("I'll ignore the bad `with' clause and look for another.");
+if t=pen_type then
+ help_line[1]:="Next time say `withpen <known pen expression>';";
+put_get_flush_error(0);
+end
+
+@ @<Check the tentative weight@>=
+begin cur_exp:=round_unscaled(cur_exp);
+if (abs(cur_exp)<4)and(cur_exp<>0) then result:=true
+else begin print_err("Weight must be -3, -2, -1, +1, +2, or +3");
+@.Weight must be...@>
+ help1("I'll ignore the bad `with' clause and look for another.");
+ put_get_flush_error(0);
+ end;
+end
+
+@ One of the things we need to do when we've parsed an \&{addto} or
+similar command is set |cur_edges| to the header of a supposed \&{picture}
+variable, given a token list for that variable.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure find_edges_var(@!t:pointer);
+var @!p:pointer;
+begin p:=find_variable(t); cur_edges:=null;
+if p=null then
+ begin obliterated(t); put_get_error;
+ end
+else if type(p)<>picture_type then
+ begin print_err("Variable "); show_token_list(t,null,1000,0);
+@.Variable x is the wrong type@>
+ print(" is the wrong type ("); print_type(type(p)); print_char(")");
+ help2("I was looking for a ""known"" picture variable.")@/
+ ("So I'll not change anything just now."); put_get_error;
+ end
+else cur_edges:=value(p);
+flush_node_list(t);
+end;
+
+@ @<Cases of |do_statement|...@>=
+add_to_command: do_add_to;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_add_to;
+label done, not_found;
+var @!lhs,@!rhs:pointer; {variable on left, path on right}
+@!w:integer; {tentative weight}
+@!p:pointer; {list manipulation register}
+@!q:pointer; {beginning of second half of doubled path}
+@!add_to_type:double_path_code..also_code; {modifier of \&{addto}}
+begin get_x_next; var_flag:=thing_to_add; scan_primary;
+if cur_type<>token_list then
+ @<Abandon edges command because there's no variable@>
+else begin lhs:=cur_exp; add_to_type:=cur_mod;@/
+ cur_type:=vacuous; get_x_next; scan_expression;
+ if add_to_type=also_code then @<Augment some edges by others@>
+ else @<Get ready to fill a contour, and fill it@>;
+ end;
+end;
+
+@ @<Abandon edges command because there's no variable@>=
+begin exp_err("Not a suitable variable");
+@.Not a suitable variable@>
+help4("At this point I needed to see the name of a picture variable.")@/
+ ("(Or perhaps you have indeed presented me with one; I might")@/
+ ("have missed it, if it wasn't followed by the proper token.)")@/
+ ("So I'll not change anything just now.");
+put_get_flush_error(0);
+end
+
+@ @<Augment some edges by others@>=
+begin find_edges_var(lhs);
+if cur_edges=null then flush_cur_exp(0)
+else if cur_type<>picture_type then
+ begin exp_err("Improper `addto'");
+@.Improper `addto'@>
+ help2("This expression should have specified a known picture.")@/
+ ("So I'll not change anything just now."); put_get_flush_error(0);
+ end
+else begin merge_edges(cur_exp); flush_cur_exp(0);
+ end;
+end
+
+@ @<Get ready to fill a contour...@>=
+begin if cur_type=pair_type then pair_to_path;
+if cur_type<>path_type then
+ begin exp_err("Improper `addto'");
+@.Improper `addto'@>
+ help2("This expression should have been a known path.")@/
+ ("So I'll not change anything just now.");
+ put_get_flush_error(0); flush_token_list(lhs);
+ end
+else begin rhs:=cur_exp; w:=1; cur_pen:=null_pen;
+ while cur_cmd=with_option do
+ if scan_with then
+ if cur_type=known then w:=cur_exp
+ else @<Change the tentative pen@>;
+ @<Complete the contour filling operation@>;
+ delete_pen_ref(cur_pen);
+ end;
+end
+
+@ We could say `|add_pen_ref(cur_pen)|; |flush_cur_exp(0)|' after changing
+|cur_pen| here. But that would have no effect, because the current expression
+will not be flushed. Thus we save a bit of code (at the risk of being too
+tricky).
+
+@<Change the tentative pen@>=
+begin delete_pen_ref(cur_pen); cur_pen:=cur_exp;
+end
+
+@ @<Complete the contour filling...@>=
+find_edges_var(lhs);
+if cur_edges=null then toss_knot_list(rhs)
+else begin lhs:=null; cur_path_type:=add_to_type;
+ if left_type(rhs)=endpoint then
+ if cur_path_type=double_path_code then @<Double the path@>
+ else @<Complain about non-cycle and |goto not_found|@>
+ else if cur_path_type=double_path_code then lhs:=htap_ypoc(rhs);
+ cur_wt:=w; rhs:=make_spec(rhs,max_offset(cur_pen),internal[tracing_specs]);
+ @<Check the turning number@>;
+ if max_offset(cur_pen)=0 then fill_spec(rhs)
+ else fill_envelope(rhs);
+ if lhs<>null then
+ begin rev_turns:=true;
+ lhs:=make_spec(lhs,max_offset(cur_pen),internal[tracing_specs]);
+ rev_turns:=false;
+ if max_offset(cur_pen)=0 then fill_spec(lhs)
+ else fill_envelope(lhs);
+ end;
+not_found: end
+
+@ @<Double the path@>=
+if link(rhs)=rhs then @<Make a trivial one-point path cycle@>
+else begin p:=htap_ypoc(rhs); q:=link(p);@/
+ right_x(path_tail):=right_x(q); right_y(path_tail):=right_y(q);
+ right_type(path_tail):=right_type(q);
+ link(path_tail):=link(q); free_node(q,knot_node_size);@/
+ right_x(p):=right_x(rhs); right_y(p):=right_y(rhs);
+ right_type(p):=right_type(rhs);
+ link(p):=link(rhs); free_node(rhs,knot_node_size);@/
+ rhs:=p;
+ end
+
+@ @<Make a trivial one-point path cycle@>=
+begin right_x(rhs):=x_coord(rhs); right_y(rhs):=y_coord(rhs);
+left_x(rhs):=x_coord(rhs); left_y(rhs):=y_coord(rhs);
+left_type(rhs):=explicit; right_type(rhs):=explicit;
+end
+
+@ @<Complain about non-cycle...@>=
+begin print_err("Not a cycle");
+@.Not a cycle@>
+help2("That contour should have ended with `..cycle' or `&cycle'.")@/
+ ("So I'll not change anything just now."); put_get_error;
+toss_knot_list(rhs); goto not_found;
+end
+
+@ @<Check the turning number@>=
+if turning_number<=0 then
+ if cur_path_type<>double_path_code then if internal[turning_check]>0 then
+ if (turning_number<0)and(link(cur_pen)=null) then negate(cur_wt)
+ else begin if turning_number=0 then
+ if (internal[turning_check]<=unity)and(link(cur_pen)=null) then goto done
+ else print_strange("Strange path (turning number is zero)")
+@.Strange path...@>
+ else print_strange("Backwards path (turning number is negative)");
+@.Backwards path...@>
+ help3("The path doesn't have a counterclockwise orientation,")@/
+ ("so I'll probably have trouble drawing it.")@/
+ ("(See Chapter 27 of The METAFONTbook for more help.)");
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+ put_get_error;
+ end;
+done:
+
+@ @<Cases of |do_statement|...@>=
+ship_out_command: do_ship_out;
+display_command: do_display;
+open_window: do_open_window;
+cull_command: do_cull;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+@t\4@>@<Declare the function called |tfm_check|@>@;
+procedure do_ship_out;
+label exit;
+var @!c:integer; {the character code}
+begin get_x_next; var_flag:=semicolon; scan_expression;
+if cur_type<>token_list then
+ if cur_type=picture_type then cur_edges:=cur_exp
+ else begin @<Abandon edges command because there's no variable@>;
+ return;
+ end
+else begin find_edges_var(cur_exp); cur_type:=vacuous;
+ end;
+if cur_edges<>null then
+ begin c:=round_unscaled(internal[char_code]) mod 256;
+ if c<0 then c:=c+256;
+ @<Store the width information for character code~|c|@>;
+ if internal[proofing]>=0 then ship_out(c);
+ end;
+flush_cur_exp(0);
+exit:end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_display;
+label not_found,common_ending,exit;
+var @!e:pointer; {token list for a picture variable}
+begin get_x_next; var_flag:=in_window; scan_primary;
+if cur_type<>token_list then
+ @<Abandon edges command because there's no variable@>
+else begin e:=cur_exp; cur_type:=vacuous;
+ get_x_next; scan_expression;
+ if cur_type<>known then goto common_ending;
+ cur_exp:=round_unscaled(cur_exp);
+ if cur_exp<0 then goto not_found;
+ if cur_exp>15 then goto not_found;
+ if not window_open[cur_exp] then goto not_found;
+ find_edges_var(e);
+ if cur_edges<>null then disp_edges(cur_exp);
+ return;
+ not_found: cur_exp:=cur_exp*unity;
+ common_ending: exp_err("Bad window number");
+@.Bad window number@>
+ help1("It should be the number of an open window.");
+ put_get_flush_error(0); flush_token_list(e);
+ end;
+exit:end;
+
+@ The only thing difficult about `\&{openwindow}' is that the syntax
+allows the user to go astray in many ways. The following subroutine
+helps keep the necessary program reasonably short and sweet.
+
+@<Declare action procedures for use by |do_statement|@>=
+function get_pair(@!c:command_code):boolean;
+var @!p:pointer; {a pair of values that are known (we hope)}
+@!b:boolean; {did we find such a pair?}
+begin if cur_cmd<>c then get_pair:=false
+else begin get_x_next; scan_expression;
+ if nice_pair(cur_exp,cur_type) then
+ begin p:=value(cur_exp);
+ cur_x:=value(x_part_loc(p)); cur_y:=value(y_part_loc(p));
+ b:=true;
+ end
+ else b:=false;
+ flush_cur_exp(0); get_pair:=b;
+ end;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_open_window;
+label not_found,exit;
+var @!k:integer; {the window number in question}
+@!r0,@!c0,@!r1,@!c1:scaled; {window coordinates}
+begin get_x_next; scan_expression;
+if cur_type<>known then goto not_found;
+k:=round_unscaled(cur_exp);
+if k<0 then goto not_found;
+if k>15 then goto not_found;
+if not get_pair(from_token) then goto not_found;
+r0:=cur_x; c0:=cur_y;
+if not get_pair(to_token) then goto not_found;
+r1:=cur_x; c1:=cur_y;
+if not get_pair(at_token) then goto not_found;
+open_a_window(k,r0,c0,r1,c1,cur_x,cur_y); return;
+not_found:print_err("Improper `openwindow'");
+@.Improper `openwindow'@>
+help2("Say `openwindow k from (r0,c0) to (r1,c1) at (x,y)',")@/
+ ("where all quantities are known and k is between 0 and 15.");
+put_get_error;
+exit:end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_cull;
+label not_found,exit;
+var @!e:pointer; {token list for a picture variable}
+@!keeping:drop_code..keep_code; {modifier of |cull_op|}
+@!w,@!w_in,@!w_out:integer; {culling weights}
+begin w:=1;
+get_x_next; var_flag:=cull_op; scan_primary;
+if cur_type<>token_list then
+ @<Abandon edges command because there's no variable@>
+else begin e:=cur_exp; cur_type:=vacuous; keeping:=cur_mod;
+ if not get_pair(cull_op) then goto not_found;
+ while (cur_cmd=with_option)and(cur_mod=known) do
+ if scan_with then w:=cur_exp;
+ @<Set up the culling weights,
+ or |goto not_found| if the thresholds are bad@>;
+ find_edges_var(e);
+ if cur_edges<>null then
+ cull_edges(floor_unscaled(cur_x+unity-1),floor_unscaled(cur_y),w_out,w_in);
+ return;
+ not_found: print_err("Bad culling amounts");
+@.Bad culling amounts@>
+ help1("Always cull by known amounts that exclude 0.");
+ put_get_error; flush_token_list(e);
+ end;
+exit:end;
+
+@ @<Set up the culling weights, or |goto not_found| if the thresholds are bad@>=
+if cur_x>cur_y then goto not_found;
+if keeping=drop_code then
+ begin if (cur_x>0)or(cur_y<0) then goto not_found;
+ w_out:=w; w_in:=0;
+ end
+else begin if (cur_x<=0)and(cur_y>=0) then goto not_found;
+ w_out:=0; w_in:=w;
+ end
+
+@ The \&{everyjob} command simply assigns a nonzero value to the global variable
+|start_sym|.
+
+@<Cases of |do_statement|...@>=
+every_job_command: begin get_symbol; start_sym:=cur_sym; get_x_next;
+ end;
+
+@ @<Glob...@>=
+@!start_sym:halfword; {a symbolic token to insert at beginning of job}
+
+@ @<Set init...@>=
+start_sym:=0;
+
+@ Finally, we have only the ``message'' commands remaining.
+
+@d message_code=0
+@d err_message_code=1
+@d err_help_code=2
+
+@<Put each...@>=
+primitive("message",message_command,message_code);@/
+@!@:message_}{\&{message} primitive@>
+primitive("errmessage",message_command,err_message_code);@/
+@!@:err_message_}{\&{errmessage} primitive@>
+primitive("errhelp",message_command,err_help_code);@/
+@!@:err_help_}{\&{errhelp} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+message_command: if m<err_message_code then print("message")
+ else if m=err_message_code then print("errmessage")
+ else print("errhelp");
+
+@ @<Cases of |do_statement|...@>=
+message_command: do_message;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_message;
+var @!m:message_code..err_help_code; {the type of message}
+begin m:=cur_mod; get_x_next; scan_expression;
+if cur_type<>string_type then
+ begin exp_err("Not a string");
+@.Not a string@>
+ help1("A message should be a known string expression.");
+ put_get_error;
+ end
+else case m of
+ message_code:begin print_nl(""); slow_print(cur_exp);
+ end;
+ err_message_code:@<Print string |cur_exp| as an error message@>;
+ err_help_code:@<Save string |cur_exp| as the |err_help|@>;
+ end; {there are no other cases}
+flush_cur_exp(0);
+end;
+
+@ The global variable |err_help| is zero when the user has most recently
+given an empty help string, or if none has ever been given.
+
+@<Save string |cur_exp| as the |err_help|@>=
+begin if err_help<>0 then delete_str_ref(err_help);
+if length(cur_exp)=0 then err_help:=0
+else begin err_help:=cur_exp; add_str_ref(err_help);
+ end;
+end
+
+@ If \&{errmessage} occurs often in |scroll_mode|, without user-defined
+\&{errhelp}, we don't want to give a long help message each time. So we
+give a verbose explanation only once.
+
+@<Glob...@>=
+@!long_help_seen:boolean; {has the long \&{errmessage} help been used?}
+
+@ @<Set init...@>=long_help_seen:=false;
+
+@ @<Print string |cur_exp| as an error message@>=
+begin print_err(""); slow_print(cur_exp);
+if err_help<>0 then use_err_help:=true
+else if long_help_seen then help1("(That was another `errmessage'.)")
+else begin if interaction<error_stop_mode then long_help_seen:=true;
+ help4("This error message was generated by an `errmessage'")@/
+ ("command, so I can't give any explicit help.")@/
+ ("Pretend that you're Miss Marple: Examine all clues,")@/
+@^Marple, Jane@>
+ ("and deduce the truth by inspired guesses.");
+ end;
+put_get_error; use_err_help:=false;
+end
+
+@* \[45] Font metric data.
+\TeX\ gets its knowledge about fonts from font metric files, also called
+\.{TFM} files; the `\.T' in `\.{TFM}' stands for \TeX,
+but other programs know about them too. One of \MF's duties is to
+write \.{TFM} files so that the user's fonts can readily be
+applied to typesetting.
+@:TFM files}{\.{TFM} files@>
+@^font metric files@>
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of~4, we could
+also regard the file as a sequence of 32-bit words, but \MF\ uses the
+byte interpretation. The format of \.{TFM} files was designed by
+Lyle Ramshaw in 1980. The intent is to convey a lot of different kinds
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+@<Glob...@>=
+@!tfm_file:byte_file; {the font metric output goes here}
+@!metric_file_name: str_number; {full name of the font metric file}
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|lf|&length of the entire file, in words;\cr
+|lh|&length of the header data, in words;\cr
+|bc|&smallest character code in the font;\cr
+|ec|&largest character code in the font;\cr
+|nw|&number of words in the width table;\cr
+|nh|&number of words in the height table;\cr
+|nd|&number of words in the depth table;\cr
+|ni|&number of words in the italic correction table;\cr
+|nl|&number of words in the lig/kern table;\cr
+|nk|&number of words in the kern table;\cr
+|ne|&number of words in the extensible character table;\cr
+|np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+|ne<=256|, and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\tabskip\centering
+\halign to\displaywidth{\hfil\\{#}\tabskip=0pt&$\,:\,$\arr#\hfil
+ \tabskip\centering\cr
+header&|[0..lh-1]@t\\{stuff}@>|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but two of
+the |fix_word| values must lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+|header[0]| and |header[1]|, whose meaning is explained below. Additional
+header information of use to other software routines might also be
+included, and \MF\ will generate it if the \.{headerbyte} command occurs.
+For example, 16 more words of header information are in use at the Xerox
+Palo Alto Research Center; the first ten specify the character coding
+scheme used (e.g., `\.{XEROX TEXT}' or `\.{TEX MATHSY}'), the next five
+give the font family name (e.g., `\.{HELVETICA}' or `\.{CMSY}'), and the
+last gives the ``face byte.''
+
+\yskip\hang|header[0]| is a 32-bit check sum that \MF\ will copy into
+the \.{GF} output file. This helps ensure consistency between files,
+since \TeX\ records the check sums from the \.{TFM}'s it reads, and these
+should match the check sums on actual fonts that are used. The actual
+relation between this check sum and the rest of the \.{TFM} file is not
+important; the check sum is simply an identification number with the
+property that incompatible fonts almost always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of the
+font, in units of \TeX\ points. This number must be at least 1.0; it is
+fairly arbitrary, but usually the design size is 10.0 for a ``10 point''
+font, i.e., a font that was designed to look best at a 10-point size,
+whatever that really means. When a \TeX\ user asks for a font `\.{at}
+$\delta$ \.{pt}', the effect is to override the design size and replace it
+by $\delta$, and to multiply the $x$ and~$y$ coordinates of the points in
+the font image by a factor of $\delta$ divided by the design size. {\sl
+All other dimensions in the\/ \.{TFM} file are |fix_word|\kern-1pt\
+numbers in design-size units.} Thus, for example, the value of |param[6]|,
+which defines the \.{em} unit, is often the |fix_word| value $2^{20}=1.0$,
+since many fonts have a design size equal to one em. The other dimensions
+must be less than 16 design-size units in absolute value; thus,
+|header[1]| and |param[1]| are the only |fix_word| entries in the whole
+\.{TFM} file whose first byte might be something besides 0 or 255.
+
+@ Next comes the |char_info| array, which contains one |@!char_info_word|
+per character. Each word in this part of the file contains six fields
+packed into four bytes as follows.
+
+\yskip\hang first byte: |@!width_index| (8 bits)\par
+\hang second byte: |@!height_index| (4 bits) times 16, plus |@!depth_index|
+ (4~bits)\par
+\hang third byte: |@!italic_index| (6 bits) times 4, plus |@!tag|
+ (2~bits)\par
+\hang fourth byte: |@!remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is \\{width}|[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation $\\{width}[0]=\\{height}[0]=\\{depth}[0]=
+\\{italic}[0]=0$ should always hold, so that an index of zero implies a
+value of zero. The |width_index| should never be zero unless the
+character does not exist in the font, since a character is valid if and
+only if it lies between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\def\hangg#1 {\hang\hbox{#1 }}
+\yskip\hangg|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hangg|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at location |remainder| in the |lig_kern| array.\par
+\hangg|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain. The
+|remainder| field gives the character code of the next larger character.\par
+\hangg|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|@!exten[remainder]|.\par
+\yskip\noindent
+Characters with |tag=2| and |tag=3| are treated as characters with |tag=0|
+unless they are used in special circumstances in math formulas. For example,
+\TeX's \.{\\sum} operation looks for a |list_tag|, and the \.{\\left}
+operation looks for both |list_tag| and |ext_tag|.
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word in this array is a
+|@!lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+ step if the byte is 128 or more, otherwise the next step is obtained by
+ skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+ then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+ a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must satisfy
+the condition
+$$\hbox{|256*op_byte+remainder<nl|.}$$
+If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+command is performed.
+
+@d stop_flag=128+min_quarterword
+ {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128+min_quarterword {op code for a kern step}
+@d skip_byte(#)==lig_kern[#].b0
+@d next_char(#)==lig_kern[#].b1
+@d op_byte(#)==lig_kern[#].b2
+@d rem_byte(#)==lig_kern[#].b3
+
+@ Extensible characters are specified by an |@!extensible_recipe|, which
+consists of four bytes called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this
+order). These bytes are the character codes of individual pieces used to
+build up a large symbol. If |top|, |mid|, or |bot| are zero, they are not
+present in the built-up result. For example, an extensible vertical line is
+like an extensible bracket, except that the top and bottom pieces are missing.
+
+Let $T$, $M$, $B$, and $R$ denote the respective pieces, or an empty box
+if the piece isn't present. Then the extensible characters have the form
+$TR^kMR^kB$ from top to bottom, for some |k>=0|, unless $M$ is absent;
+in the latter case we can have $TR^kB$ for both even and odd values of~|k|.
+The width of the extensible character is the width of $R$; and the
+height-plus-depth is the sum of the individual height-plus-depths of the
+components used, since the pieces are butted together in a vertical list.
+
+@d ext_top(#)==exten[#].b0 {|top| piece in a recipe}
+@d ext_mid(#)==exten[#].b1 {|mid| piece in a recipe}
+@d ext_bot(#)==exten[#].b2 {|bot| piece in a recipe}
+@d ext_rep(#)==exten[#].b3 {|rep| piece in a recipe}
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it is the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character @'40 in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the size of one ex in the font; it is also
+the height of letters for which accents don't have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+\yskip\noindent
+If fewer than seven parameters are present, \TeX\ sets the missing parameters
+to zero.
+
+@d slant_code=1
+@d space_code=2
+@d space_stretch_code=3
+@d space_shrink_code=4
+@d x_height_code=5
+@d quad_code=6
+@d extra_space_code=7
+
+@ So that is what \.{TFM} files hold. One of \MF's duties is to output such
+information, and it does this all at once at the end of a job.
+In order to prepare for such frenetic activity, it squirrels away the
+necessary facts in various arrays as information becomes available.
+
+Character dimensions (\&{charwd}, \&{charht}, \&{chardp}, and \&{charic})
+are stored respectively in |tfm_width|, |tfm_height|, |tfm_depth|, and
+|tfm_ital_corr|. Other information about a character (e.g., about
+its ligatures or successors) is accessible via the |char_tag| and
+|char_remainder| arrays. Other information about the font as a whole
+is kept in additional arrays called |header_byte|, |lig_kern|,
+|kern|, |exten|, and |param|.
+
+@d undefined_label==lig_table_size {an undefined local label}
+
+@<Glob...@>=
+@!bc,@!ec:eight_bits; {smallest and largest character codes shipped out}
+@!tfm_width:array[eight_bits] of scaled; {\&{charwd} values}
+@!tfm_height:array[eight_bits] of scaled; {\&{charht} values}
+@!tfm_depth:array[eight_bits] of scaled; {\&{chardp} values}
+@!tfm_ital_corr:array[eight_bits] of scaled; {\&{charic} values}
+@!char_exists:array[eight_bits] of boolean; {has this code been shipped out?}
+@!char_tag:array[eight_bits] of no_tag..ext_tag; {|remainder| category}
+@!char_remainder:array[eight_bits] of 0..lig_table_size; {the |remainder| byte}
+@!header_byte:array[1..header_size] of -1..255;
+ {bytes of the \.{TFM} header, or $-1$ if unset}
+@!lig_kern:array[0..lig_table_size] of four_quarters; {the ligature/kern table}
+@!nl:0..32767-256; {the number of ligature/kern steps so far}
+@!kern:array[0..max_kerns] of scaled; {distinct kerning amounts}
+@!nk:0..max_kerns; {the number of distinct kerns so far}
+@!exten:array[eight_bits] of four_quarters; {extensible character recipes}
+@!ne:0..256; {the number of extensible characters so far}
+@!param:array[1..max_font_dimen] of scaled; {\&{fontinfo} parameters}
+@!np:0..max_font_dimen; {the largest \&{fontinfo} parameter specified so far}
+@!nw,@!nh,@!nd,@!ni:0..256; {sizes of \.{TFM} subtables}
+@!skip_table:array[eight_bits] of 0..lig_table_size; {local label status}
+@!lk_started:boolean; {has there been a lig/kern step in this command yet?}
+@!bchar:integer; {right boundary character}
+@!bch_label:0..lig_table_size; {left boundary starting location}
+@!ll,@!lll:0..lig_table_size; {registers used for lig/kern processing}
+@!label_loc:array[0..256] of -1..lig_table_size; {lig/kern starting addresses}
+@!label_char:array[1..256] of eight_bits; {characters for |label_loc|}
+@!label_ptr:0..256; {highest position occupied in |label_loc|}
+
+@ @<Set init...@>=
+for k:=0 to 255 do
+ begin tfm_width[k]:=0; tfm_height[k]:=0; tfm_depth[k]:=0; tfm_ital_corr[k]:=0;
+ char_exists[k]:=false; char_tag[k]:=no_tag; char_remainder[k]:=0;
+ skip_table[k]:=undefined_label;
+ end;
+for k:=1 to header_size do header_byte[k]:=-1;
+bc:=255; ec:=0; nl:=0; nk:=0; ne:=0; np:=0;@/
+internal[boundary_char]:=-unity;
+bch_label:=undefined_label;@/
+label_loc[0]:=-1; label_ptr:=0;
+
+@ @<Declare the function called |tfm_check|@>=
+function tfm_check(@!m:small_number):scaled;
+begin if abs(internal[m])>=fraction_half then
+ begin print_err("Enormous "); print(int_name[m]);
+@.Enormous charwd...@>
+@.Enormous chardp...@>
+@.Enormous charht...@>
+@.Enormous charic...@>
+@.Enormous designsize...@>
+ print(" has been reduced");
+ help1("Font metric dimensions must be less than 2048pt.");
+ put_get_error;
+ if internal[m]>0 then tfm_check:=fraction_half-1
+ else tfm_check:=1-fraction_half;
+ end
+else tfm_check:=internal[m];
+end;
+
+@ @<Store the width information for character code~|c|@>=
+if c<bc then bc:=c;
+if c>ec then ec:=c;
+char_exists[c]:=true;
+gf_dx[c]:=internal[char_dx]; gf_dy[c]:=internal[char_dy];
+tfm_width[c]:=tfm_check(char_wd);
+tfm_height[c]:=tfm_check(char_ht);
+tfm_depth[c]:=tfm_check(char_dp);
+tfm_ital_corr[c]:=tfm_check(char_ic)
+
+@ Now let's consider \MF's special \.{TFM}-oriented commands.
+
+@<Cases of |do_statement|...@>=
+tfm_command: do_tfm_command;
+
+@ @d char_list_code=0
+@d lig_table_code=1
+@d extensible_code=2
+@d header_byte_code=3
+@d font_dimen_code=4
+
+@<Put each...@>=
+primitive("charlist",tfm_command,char_list_code);@/
+@!@:char_list_}{\&{charlist} primitive@>
+primitive("ligtable",tfm_command,lig_table_code);@/
+@!@:lig_table_}{\&{ligtable} primitive@>
+primitive("extensible",tfm_command,extensible_code);@/
+@!@:extensible_}{\&{extensible} primitive@>
+primitive("headerbyte",tfm_command,header_byte_code);@/
+@!@:header_byte_}{\&{headerbyte} primitive@>
+primitive("fontdimen",tfm_command,font_dimen_code);@/
+@!@:font_dimen_}{\&{fontdimen} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+tfm_command: case m of
+ char_list_code:print("charlist");
+ lig_table_code:print("ligtable");
+ extensible_code:print("extensible");
+ header_byte_code:print("headerbyte");
+ othercases print("fontdimen")
+ endcases;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+function get_code:eight_bits; {scans a character code value}
+label found;
+var @!c:integer; {the code value found}
+begin get_x_next; scan_expression;
+if cur_type=known then
+ begin c:=round_unscaled(cur_exp);
+ if c>=0 then if c<256 then goto found;
+ end
+else if cur_type=string_type then if length(cur_exp)=1 then
+ begin c:=so(str_pool[str_start[cur_exp]]); goto found;
+ end;
+exp_err("Invalid code has been replaced by 0");
+@.Invalid code...@>
+help2("I was looking for a number between 0 and 255, or for a")@/
+ ("string of length 1. Didn't find it; will use 0 instead.");
+put_get_flush_error(0); c:=0;
+found: get_code:=c;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure set_tag(@!c:halfword;@!t:small_number;@!r:halfword);
+begin if char_tag[c]=no_tag then
+ begin char_tag[c]:=t; char_remainder[c]:=r;
+ if t=lig_tag then
+ begin incr(label_ptr); label_loc[label_ptr]:=r; label_char[label_ptr]:=c;
+ end;
+ end
+else @<Complain about a character tag conflict@>;
+end;
+
+@ @<Complain about a character tag conflict@>=
+begin print_err("Character ");
+if (c>" ")and(c<127) then print(c)
+else if c=256 then print("||")
+else begin print("code "); print_int(c);
+ end;
+print(" is already ");
+@.Character c is already...@>
+case char_tag[c] of
+lig_tag: print("in a ligtable");
+list_tag: print("in a charlist");
+ext_tag: print("extensible");
+end; {there are no other cases}
+help2("It's not legal to label a character more than once.")@/
+ ("So I'll not change anything just now.");
+put_get_error; end
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_tfm_command;
+label continue,done;
+var @!c,@!cc:0..256; {character codes}
+@!k:0..max_kerns; {index into the |kern| array}
+@!j:integer; {index into |header_byte| or |param|}
+begin case cur_mod of
+char_list_code: begin c:=get_code;
+ {we will store a list of character successors}
+ while cur_cmd=colon do
+ begin cc:=get_code; set_tag(c,list_tag,cc); c:=cc;
+ end;
+ end;
+lig_table_code: @<Store a list of ligature/kern steps@>;
+extensible_code: @<Define an extensible recipe@>;
+header_byte_code, font_dimen_code: begin c:=cur_mod; get_x_next;
+ scan_expression;
+ if (cur_type<>known)or(cur_exp<half_unit) then
+ begin exp_err("Improper location");
+@.Improper location@>
+ help2("I was looking for a known, positive number.")@/
+ ("For safety's sake I'll ignore the present command.");
+ put_get_error;
+ end
+ else begin j:=round_unscaled(cur_exp);
+ if cur_cmd<>colon then
+ begin missing_err(":");
+@.Missing `:'@>
+ help1("A colon should follow a headerbyte or fontinfo location.");
+ back_error;
+ end;
+ if c=header_byte_code then @<Store a list of header bytes@>
+ else @<Store a list of font dimensions@>;
+ end;
+ end;
+end; {there are no other cases}
+end;
+
+@ @<Store a list of ligature/kern steps@>=
+begin lk_started:=false;
+continue: get_x_next;
+if(cur_cmd=skip_to)and lk_started then
+ @<Process a |skip_to| command and |goto done|@>;
+if cur_cmd=bchar_label then
+ begin c:=256; cur_cmd:=colon;@+end
+else begin back_input; c:=get_code;@+end;
+if(cur_cmd=colon)or(cur_cmd=double_colon)then
+ @<Record a label in a lig/kern subprogram and |goto continue|@>;
+if cur_cmd=lig_kern_token then @<Compile a ligature/kern command@>
+else begin print_err("Illegal ligtable step");
+@.Illegal ligtable step@>
+ help1("I was looking for `=:' or `kern' here.");
+ back_error; next_char(nl):=qi(0); op_byte(nl):=qi(0); rem_byte(nl):=qi(0);@/
+ skip_byte(nl):=stop_flag+1; {this specifies an unconditional stop}
+ end;
+if nl=lig_table_size then overflow("ligtable size",lig_table_size);
+@:METAFONT capacity exceeded ligtable size}{\quad ligtable size@>
+incr(nl);
+if cur_cmd=comma then goto continue;
+if skip_byte(nl-1)<stop_flag then skip_byte(nl-1):=stop_flag;
+done:end
+
+@ @<Put each...@>=
+primitive("=:",lig_kern_token,0);
+@!@:=:_}{\.{=:} primitive@>
+primitive("=:|",lig_kern_token,1);
+@!@:=:/_}{\.{=:\char'174} primitive@>
+primitive("=:|>",lig_kern_token,5);
+@!@:=:/>_}{\.{=:\char'174>} primitive@>
+primitive("|=:",lig_kern_token,2);
+@!@:=:/_}{\.{\char'174=:} primitive@>
+primitive("|=:>",lig_kern_token,6);
+@!@:=:/>_}{\.{\char'174=:>} primitive@>
+primitive("|=:|",lig_kern_token,3);
+@!@:=:/_}{\.{\char'174=:\char'174} primitive@>
+primitive("|=:|>",lig_kern_token,7);
+@!@:=:/>_}{\.{\char'174=:\char'174>} primitive@>
+primitive("|=:|>>",lig_kern_token,11);
+@!@:=:/>_}{\.{\char'174=:\char'174>>} primitive@>
+primitive("kern",lig_kern_token,128);
+@!@:kern_}{\&{kern} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+lig_kern_token: case m of
+0:print("=:");
+1:print("=:|");
+2:print("|=:");
+3:print("|=:|");
+5:print("=:|>");
+6:print("|=:>");
+7:print("|=:|>");
+11:print("|=:|>>");
+othercases print("kern")
+endcases;
+
+@ Local labels are implemented by maintaining the |skip_table| array,
+where |skip_table[c]| is either |undefined_label| or the address of the
+most recent lig/kern instruction that skips to local label~|c|. In the
+latter case, the |skip_byte| in that instruction will (temporarily)
+be zero if there were no prior skips to this label, or it will be the
+distance to the prior skip.
+
+We may need to cancel skips that span more than 127 lig/kern steps.
+
+@d cancel_skips(#)==ll:=#;
+ repeat lll:=qo(skip_byte(ll)); skip_byte(ll):=stop_flag; ll:=ll-lll;
+ until lll=0
+@d skip_error(#)==begin print_err("Too far to skip");
+@.Too far to skip@>
+ help1("At most 127 lig/kern steps can separate skipto1 from 1::.");
+ error; cancel_skips(#);
+ end
+
+@<Process a |skip_to| command and |goto done|@>=
+begin c:=get_code;
+if nl-skip_table[c]>128 then {|skip_table[c]<<nl<=undefined_label|}
+ begin skip_error(skip_table[c]); skip_table[c]:=undefined_label;
+ end;
+if skip_table[c]=undefined_label then skip_byte(nl-1):=qi(0)
+else skip_byte(nl-1):=qi(nl-skip_table[c]-1);
+skip_table[c]:=nl-1; goto done;
+end
+
+@ @<Record a label in a lig/kern subprogram and |goto continue|@>=
+begin if cur_cmd=colon then
+ if c=256 then bch_label:=nl
+ else set_tag(c,lig_tag,nl)
+else if skip_table[c]<undefined_label then
+ begin ll:=skip_table[c]; skip_table[c]:=undefined_label;
+ repeat lll:=qo(skip_byte(ll));
+ if nl-ll>128 then
+ begin skip_error(ll); goto continue;
+ end;
+ skip_byte(ll):=qi(nl-ll-1); ll:=ll-lll;
+ until lll=0;
+ end;
+goto continue;
+end
+
+@ @<Compile a ligature/kern...@>=
+begin next_char(nl):=qi(c); skip_byte(nl):=qi(0);
+if cur_mod<128 then {ligature op}
+ begin op_byte(nl):=qi(cur_mod); rem_byte(nl):=qi(get_code);
+ end
+else begin get_x_next; scan_expression;
+ if cur_type<>known then
+ begin exp_err("Improper kern");
+@.Improper kern@>
+ help2("The amount of kern should be a known numeric value.")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+ put_get_flush_error(0);
+ end;
+ kern[nk]:=cur_exp;
+ k:=0;@+while kern[k]<>cur_exp do incr(k);
+ if k=nk then
+ begin if nk=max_kerns then overflow("kern",max_kerns);
+@:METAFONT capacity exceeded kern}{\quad kern@>
+ incr(nk);
+ end;
+ op_byte(nl):=kern_flag+(k div 256);
+ rem_byte(nl):=qi((k mod 256));
+ end;
+lk_started:=true;
+end
+
+@ @d missing_extensible_punctuation(#)==
+ begin missing_err(#);
+@.Missing `\char`\#'@>
+ help1("I'm processing `extensible c: t,m,b,r'."); back_error;
+ end
+
+@<Define an extensible recipe@>=
+begin if ne=256 then overflow("extensible",256);
+@:METAFONT capacity exceeded extensible}{\quad extensible@>
+c:=get_code; set_tag(c,ext_tag,ne);
+if cur_cmd<>colon then missing_extensible_punctuation(":");
+ext_top(ne):=qi(get_code);
+if cur_cmd<>comma then missing_extensible_punctuation(",");
+ext_mid(ne):=qi(get_code);
+if cur_cmd<>comma then missing_extensible_punctuation(",");
+ext_bot(ne):=qi(get_code);
+if cur_cmd<>comma then missing_extensible_punctuation(",");
+ext_rep(ne):=qi(get_code);
+incr(ne);
+end
+
+@ @<Store a list of header bytes@>=
+repeat if j>header_size then overflow("headerbyte",header_size);
+@:METAFONT capacity exceeded headerbyte}{\quad headerbyte@>
+header_byte[j]:=get_code; incr(j);
+until cur_cmd<>comma
+
+@ @<Store a list of font dimensions@>=
+repeat if j>max_font_dimen then overflow("fontdimen",max_font_dimen);
+@:METAFONT capacity exceeded fontdimen}{\quad fontdimen@>
+while j>np do
+ begin incr(np); param[np]:=0;
+ end;
+get_x_next; scan_expression;
+if cur_type<>known then
+ begin exp_err("Improper font parameter");
+@.Improper font parameter@>
+ help1("I'm zeroing this one. Proceed, with fingers crossed.");
+ put_get_flush_error(0);
+ end;
+param[j]:=cur_exp; incr(j);
+until cur_cmd<>comma
+
+@ OK: We've stored all the data that is needed for the \.{TFM} file.
+All that remains is to output it in the correct format.
+
+An interesting problem needs to be solved in this connection, because
+the \.{TFM} format allows at most 256~widths, 16~heights, 16~depths,
+and 64~italic corrections. If the data has more distinct values than
+this, we want to meet the necessary restrictions by perturbing the
+given values as little as possible.
+
+\MF\ solves this problem in two steps. First the values of a given
+kind (widths, heights, depths, or italic corrections) are sorted;
+then the list of sorted values is perturbed, if necessary.
+
+The sorting operation is facilitated by having a special node of
+essentially infinite |value| at the end of the current list.
+
+@<Initialize table entries...@>=
+value(inf_val):=fraction_four;
+
+@ Straight linear insertion is good enough for sorting, since the lists
+are usually not terribly long. As we work on the data, the current list
+will start at |link(temp_head)| and end at |inf_val|; the nodes in this
+list will be in increasing order of their |value| fields.
+
+Given such a list, the |sort_in| function takes a value and returns a pointer
+to where that value can be found in the list. The value is inserted in
+the proper place, if necessary.
+
+At the time we need to do these operations, most of \MF's work has been
+completed, so we will have plenty of memory to play with. The value nodes
+that are allocated for sorting will never be returned to free storage.
+
+@d clear_the_list==link(temp_head):=inf_val
+
+@p function sort_in(@!v:scaled):pointer;
+label found;
+var @!p,@!q,@!r:pointer; {list manipulation registers}
+begin p:=temp_head;
+loop@+ begin q:=link(p);
+ if v<=value(q) then goto found;
+ p:=q;
+ end;
+found: if v<value(q) then
+ begin r:=get_node(value_node_size); value(r):=v; link(r):=q; link(p):=r;
+ end;
+sort_in:=link(p);
+end;
+
+@ Now we come to the interesting part, where we reduce the list if necessary
+until it has the required size. The |min_cover| routine is basic to this
+process; it computes the minimum number~|m| such that the values of the
+current sorted list can be covered by |m|~intervals of width~|d|. It
+also sets the global value |perturbation| to the smallest value $d'>d$
+such that the covering found by this algorithm would be different.
+
+In particular, |min_cover(0)| returns the number of distinct values in the
+current list and sets |perturbation| to the minimum distance between
+adjacent values.
+
+@p function min_cover(@!d:scaled):integer;
+var @!p:pointer; {runs through the current list}
+@!l:scaled; {the least element covered by the current interval}
+@!m:integer; {lower bound on the size of the minimum cover}
+begin m:=0; p:=link(temp_head); perturbation:=el_gordo;
+while p<>inf_val do
+ begin incr(m); l:=value(p);
+ repeat p:=link(p);
+ until value(p)>l+d;
+ if value(p)-l<perturbation then perturbation:=value(p)-l;
+ end;
+min_cover:=m;
+end;
+
+@ @<Glob...@>=
+@!perturbation:scaled; {quantity related to \.{TFM} rounding}
+@!excess:integer; {the list is this much too long}
+
+@ The smallest |d| such that a given list can be covered with |m| intervals
+is determined by the |threshold| routine, which is sort of an inverse
+to |min_cover|. The idea is to increase the interval size rapidly until
+finding the range, then to go sequentially until the exact borderline has
+been discovered.
+
+@p function threshold(@!m:integer):scaled;
+var @!d:scaled; {lower bound on the smallest interval size}
+begin excess:=min_cover(0)-m;
+if excess<=0 then threshold:=0
+else begin repeat d:=perturbation;
+ until min_cover(d+d)<=m;
+ while min_cover(d)>m do d:=perturbation;
+ threshold:=d;
+ end;
+end;
+
+@ The |skimp| procedure reduces the current list to at most |m| entries,
+by changing values if necessary. It also sets |info(p):=k| if |value(p)|
+is the |k|th distinct value on the resulting list, and it sets
+|perturbation| to the maximum amount by which a |value| field has
+been changed. The size of the resulting list is returned as the
+value of |skimp|.
+
+@p function skimp(@!m:integer):integer;
+var @!d:scaled; {the size of intervals being coalesced}
+@!p,@!q,@!r:pointer; {list manipulation registers}
+@!l:scaled; {the least value in the current interval}
+@!v:scaled; {a compromise value}
+begin d:=threshold(m); perturbation:=0;
+q:=temp_head; m:=0; p:=link(temp_head);
+while p<>inf_val do
+ begin incr(m); l:=value(p); info(p):=m;
+ if value(link(p))<=l+d then
+ @<Replace an interval of values by its midpoint@>;
+ q:=p; p:=link(p);
+ end;
+skimp:=m;
+end;
+
+@ @<Replace an interval...@>=
+begin repeat p:=link(p); info(p):=m;
+decr(excess);@+if excess=0 then d:=0;
+until value(link(p))>l+d;
+v:=l+half(value(p)-l);
+if value(p)-v>perturbation then perturbation:=value(p)-v;
+r:=q;
+repeat r:=link(r); value(r):=v;
+until r=p;
+link(q):=p; {remove duplicate values from the current list}
+end
+
+@ A warning message is issued whenever something is perturbed by
+more than 1/16\thinspace pt.
+
+@p procedure tfm_warning(@!m:small_number);
+begin print_nl("(some "); print(int_name[m]);
+@.some charwds...@>
+@.some chardps...@>
+@.some charhts...@>
+@.some charics...@>
+print(" values had to be adjusted by as much as ");
+print_scaled(perturbation); print("pt)");
+end;
+
+@ Here's an example of how we use these routines.
+The width data needs to be perturbed only if there are 256 distinct
+widths, but \MF\ must check for this case even though it is
+highly unusual.
+
+An integer variable |k| will be defined when we use this code.
+The |dimen_head| array will contain pointers to the sorted
+lists of dimensions.
+
+@<Massage the \.{TFM} widths@>=
+clear_the_list;
+for k:=bc to ec do if char_exists[k] then
+ tfm_width[k]:=sort_in(tfm_width[k]);
+nw:=skimp(255)+1; dimen_head[1]:=link(temp_head);
+if perturbation>=@'10000 then tfm_warning(char_wd)
+
+@ @<Glob...@>=
+@!dimen_head:array[1..4] of pointer; {lists of \.{TFM} dimensions}
+
+@ Heights, depths, and italic corrections are different from widths
+not only because their list length is more severely restricted, but
+also because zero values do not need to be put into the lists.
+
+@<Massage the \.{TFM} heights, depths, and italic corrections@>=
+clear_the_list;
+for k:=bc to ec do if char_exists[k] then
+ if tfm_height[k]=0 then tfm_height[k]:=zero_val
+ else tfm_height[k]:=sort_in(tfm_height[k]);
+nh:=skimp(15)+1; dimen_head[2]:=link(temp_head);
+if perturbation>=@'10000 then tfm_warning(char_ht);
+clear_the_list;
+for k:=bc to ec do if char_exists[k] then
+ if tfm_depth[k]=0 then tfm_depth[k]:=zero_val
+ else tfm_depth[k]:=sort_in(tfm_depth[k]);
+nd:=skimp(15)+1; dimen_head[3]:=link(temp_head);
+if perturbation>=@'10000 then tfm_warning(char_dp);
+clear_the_list;
+for k:=bc to ec do if char_exists[k] then
+ if tfm_ital_corr[k]=0 then tfm_ital_corr[k]:=zero_val
+ else tfm_ital_corr[k]:=sort_in(tfm_ital_corr[k]);
+ni:=skimp(63)+1; dimen_head[4]:=link(temp_head);
+if perturbation>=@'10000 then tfm_warning(char_ic)
+
+@ @<Initialize table entries...@>=
+value(zero_val):=0; info(zero_val):=0;
+
+@ Bytes 5--8 of the header are set to the design size, unless the user has
+some crazy reason for specifying them differently.
+
+Error messages are not allowed at the time this procedure is called,
+so a warning is printed instead.
+
+The value of |max_tfm_dimen| is calculated so that
+$$\hbox{|make_scaled(16*max_tfm_dimen,internal[design_size])|}
+ < \\{three\_bytes}.$$
+
+@d three_bytes==@'100000000 {$2^{24}$}
+
+@p procedure fix_design_size;
+var @!d:scaled; {the design size}
+begin d:=internal[design_size];
+if (d<unity)or(d>=fraction_half) then
+ begin if d<>0 then
+ print_nl("(illegal design size has been changed to 128pt)");
+@.illegal design size...@>
+ d:=@'40000000; internal[design_size]:=d;
+ end;
+if header_byte[5]<0 then if header_byte[6]<0 then
+ if header_byte[7]<0 then if header_byte[8]<0 then
+ begin header_byte[5]:=d div @'4000000;
+ header_byte[6]:=(d div 4096) mod 256;
+ header_byte[7]:=(d div 16) mod 256;
+ header_byte[8]:=(d mod 16)*16;
+ end;
+max_tfm_dimen:=16*internal[design_size]-internal[design_size] div @'10000000;
+if max_tfm_dimen>=fraction_half then max_tfm_dimen:=fraction_half-1;
+end;
+
+@ The |dimen_out| procedure computes a |fix_word| relative to the
+design size. If the data was out of range, it is corrected and the
+global variable |tfm_changed| is increased by~one.
+
+@p function dimen_out(@!x:scaled):integer;
+begin if abs(x)>max_tfm_dimen then
+ begin incr(tfm_changed);
+ if x>0 then x:=three_bytes-1@+else x:=1-three_bytes;
+ end
+else x:=make_scaled(x*16,internal[design_size]);
+dimen_out:=x;
+end;
+
+@ @<Glob...@>=
+@!max_tfm_dimen:scaled; {bound on widths, heights, kerns, etc.}
+@!tfm_changed:integer; {the number of data entries that were out of bounds}
+
+@ If the user has not specified any of the first four header bytes,
+the |fix_check_sum| procedure replaces them by a ``check sum'' computed
+from the |tfm_width| data relative to the design size.
+@^check sum@>
+
+@p procedure fix_check_sum;
+label exit;
+var @!k:eight_bits; {runs through character codes}
+@!b1,@!b2,@!b3,@!b4:eight_bits; {bytes of the check sum}
+@!x:integer; {hash value used in check sum computation}
+begin if header_byte[1]<0 then if header_byte[2]<0 then
+ if header_byte[3]<0 then if header_byte[4]<0 then
+ begin @<Compute a check sum in |(b1,b2,b3,b4)|@>;
+ header_byte[1]:=b1; header_byte[2]:=b2;
+ header_byte[3]:=b3; header_byte[4]:=b4; return;
+ end;
+for k:=1 to 4 do if header_byte[k]<0 then header_byte[k]:=0;
+exit:end;
+
+@ @<Compute a check sum in |(b1,b2,b3,b4)|@>=
+b1:=bc; b2:=ec; b3:=bc; b4:=ec; tfm_changed:=0;
+for k:=bc to ec do if char_exists[k] then
+ begin x:=dimen_out(value(tfm_width[k]))+(k+4)*@'20000000; {this is positive}
+ b1:=(b1+b1+x) mod 255;
+ b2:=(b2+b2+x) mod 253;
+ b3:=(b3+b3+x) mod 251;
+ b4:=(b4+b4+x) mod 247;
+ end
+
+@ Finally we're ready to actually write the \.{TFM} information.
+Here are some utility routines for this purpose.
+
+@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|}
+
+@p procedure tfm_two(@!x:integer); {output two bytes to |tfm_file|}
+begin tfm_out(x div 256); tfm_out(x mod 256);
+end;
+@#
+procedure tfm_four(@!x:integer); {output four bytes to |tfm_file|}
+begin if x>=0 then tfm_out(x div three_bytes)
+else begin x:=x+@'10000000000; {use two's complement for negative values}
+ x:=x+@'10000000000;
+ tfm_out((x div three_bytes) + 128);
+ end;
+x:=x mod three_bytes; tfm_out(x div unity);
+x:=x mod unity; tfm_out(x div @'400);
+tfm_out(x mod @'400);
+end;
+@#
+procedure tfm_qqqq(@!x:four_quarters); {output four quarterwords to |tfm_file|}
+begin tfm_out(qo(x.b0)); tfm_out(qo(x.b1)); tfm_out(qo(x.b2));
+tfm_out(qo(x.b3));
+end;
+
+@ @<Finish the \.{TFM} file@>=
+if job_name=0 then open_log_file;
+pack_job_name(".tfm");
+while not b_open_out(tfm_file) do
+ prompt_file_name("file name for font metrics",".tfm");
+metric_file_name:=b_make_name_string(tfm_file);
+@<Output the subfile sizes and header bytes@>;
+@<Output the character information bytes, then
+ output the dimensions themselves@>;
+@<Output the ligature/kern program@>;
+@<Output the extensible character recipes and the font metric parameters@>;
+@!stat if internal[tracing_stats]>0 then
+ @<Log the subfile sizes of the \.{TFM} file@>;@;@+tats@/
+print_nl("Font metrics written on "); slow_print(metric_file_name);
+print_char(".");
+@.Font metrics written...@>
+b_close(tfm_file)
+
+@ Integer variables |lh|, |k|, and |lk_offset| will be defined when we use
+this code.
+
+@<Output the subfile sizes and header bytes@>=
+k:=header_size;
+while header_byte[k]<0 do decr(k);
+lh:=(k+3) div 4; {this is the number of header words}
+if bc>ec then bc:=1; {if there are no characters, |ec=0| and |bc=1|}
+@<Compute the ligature/kern program offset and implant the
+ left boundary label@>;
+tfm_two(6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+lk_offset+nk+ne+np);
+ {this is the total number of file words that will be output}
+tfm_two(lh); tfm_two(bc); tfm_two(ec); tfm_two(nw); tfm_two(nh);
+tfm_two(nd); tfm_two(ni); tfm_two(nl+lk_offset); tfm_two(nk); tfm_two(ne);
+tfm_two(np);
+for k:=1 to 4*lh do
+ begin if header_byte[k]<0 then header_byte[k]:=0;
+ tfm_out(header_byte[k]);
+ end
+
+@ @<Output the character information bytes...@>=
+for k:=bc to ec do
+ if not char_exists[k] then tfm_four(0)
+ else begin tfm_out(info(tfm_width[k])); {the width index}
+ tfm_out((info(tfm_height[k]))*16+info(tfm_depth[k]));
+ tfm_out((info(tfm_ital_corr[k]))*4+char_tag[k]);
+ tfm_out(char_remainder[k]);
+ end;
+tfm_changed:=0;
+for k:=1 to 4 do
+ begin tfm_four(0); p:=dimen_head[k];
+ while p<>inf_val do
+ begin tfm_four(dimen_out(value(p))); p:=link(p);
+ end;
+ end
+
+@ We need to output special instructions at the beginning of the
+|lig_kern| array in order to specify the right boundary character
+and/or to handle starting addresses that exceed 255. The |label_loc|
+and |label_char| arrays have been set up to record all the
+starting addresses; we have $-1=|label_loc|[0]<|label_loc|[1]\le\cdots
+\le|label_loc|[|label_ptr]|$.
+
+@<Compute the ligature/kern program offset...@>=
+bchar:=round_unscaled(internal[boundary_char]);
+if(bchar<0)or(bchar>255)then
+ begin bchar:=-1; lk_started:=false; lk_offset:=0;@+end
+else begin lk_started:=true; lk_offset:=1;@+end;
+@<Find the minimum |lk_offset| and adjust all remainders@>;
+if bch_label<undefined_label then
+ begin skip_byte(nl):=qi(255); next_char(nl):=qi(0);
+ op_byte(nl):=qi(((bch_label+lk_offset)div 256));
+ rem_byte(nl):=qi(((bch_label+lk_offset)mod 256));
+ incr(nl); {possibly |nl=lig_table_size+1|}
+ end
+
+@ @<Find the minimum |lk_offset|...@>=
+k:=label_ptr; {pointer to the largest unallocated label}
+if label_loc[k]+lk_offset>255 then
+ begin lk_offset:=0; lk_started:=false; {location 0 can do double duty}
+ repeat char_remainder[label_char[k]]:=lk_offset;
+ while label_loc[k-1]=label_loc[k] do
+ begin decr(k); char_remainder[label_char[k]]:=lk_offset;
+ end;
+ incr(lk_offset); decr(k);
+ until lk_offset+label_loc[k]<256;
+ {N.B.: |lk_offset=256| satisfies this when |k=0|}
+ end;
+if lk_offset>0 then
+ while k>0 do
+ begin char_remainder[label_char[k]]
+ :=char_remainder[label_char[k]]+lk_offset;
+ decr(k);
+ end
+
+@ @<Output the ligature/kern program@>=
+for k:=0 to 255 do if skip_table[k]<undefined_label then
+ begin print_nl("(local label "); print_int(k); print(":: was missing)");
+@.local label l:: was missing@>
+ cancel_skips(skip_table[k]);
+ end;
+if lk_started then {|lk_offset=1| for the special |bchar|}
+ begin tfm_out(255); tfm_out(bchar); tfm_two(0);
+ end
+else for k:=1 to lk_offset do {output the redirection specs}
+ begin ll:=label_loc[label_ptr];
+ if bchar<0 then
+ begin tfm_out(254); tfm_out(0);
+ end
+ else begin tfm_out(255); tfm_out(bchar);
+ end;
+ tfm_two(ll+lk_offset);
+ repeat decr(label_ptr);
+ until label_loc[label_ptr]<ll;
+ end;
+for k:=0 to nl-1 do tfm_qqqq(lig_kern[k]);
+for k:=0 to nk-1 do tfm_four(dimen_out(kern[k]))
+
+@ @<Output the extensible character recipes...@>=
+for k:=0 to ne-1 do tfm_qqqq(exten[k]);
+for k:=1 to np do
+ if k=1 then
+ if abs(param[1])<fraction_half then tfm_four(param[1]*16)
+ else begin incr(tfm_changed);
+ if param[1]>0 then tfm_four(el_gordo)
+ else tfm_four(-el_gordo);
+ end
+ else tfm_four(dimen_out(param[k]));
+if tfm_changed>0 then
+ begin if tfm_changed=1 then print_nl("(a font metric dimension")
+@.a font metric dimension...@>
+ else begin print_nl("("); print_int(tfm_changed);
+@.font metric dimensions...@>
+ print(" font metric dimensions");
+ end;
+ print(" had to be decreased)");
+ end
+
+@ @<Log the subfile sizes of the \.{TFM} file@>=
+begin wlog_ln(' ');
+if bch_label<undefined_label then decr(nl);
+wlog_ln('(You used ',nw:1,'w,',@| nh:1,'h,',@| nd:1,'d,',@| ni:1,'i,',@|
+ nl:1,'l,',@| nk:1,'k,',@| ne:1,'e,',@|
+ np:1,'p metric file positions');
+wlog_ln(' out of ',@| '256w,16h,16d,64i,',@|
+ lig_table_size:1,'l,',max_kerns:1,'k,256e,',@|
+ max_font_dimen:1,'p)');
+end
+
+@* \[46] Generic font file format.
+The most important output produced by a typical run of \MF\ is the
+``generic font'' (\.{GF}) file that specifies the bit patterns of the
+characters that have been drawn. The term {\sl generic\/} indicates that
+this file format doesn't match the conventions of any name-brand manufacturer;
+but it is easy to convert \.{GF} files to the special format required by
+almost all digital phototypesetting equipment. There's a strong analogy
+between the \.{DVI} files written by \TeX\ and the \.{GF} files written
+by \MF; and, in fact, the file formats have a lot in common.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`|boc|' (beginning of character) command has six parameters, each of
+which is four bytes long. Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a |boc| command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an |eoc| command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each |eoc| command is immediately followed by a
+|boc| command, or by a |post| command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+@ The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~|m|; and (b)~the current row number,~|n|. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to get extremely large, but the \.{GF} format tries to be more general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising the
+region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
+coordinates |(x,y)| satisfy |m<=x<=m+1| and |n<=y<=n+1|. Negative values of
+|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of |n| and~|y| correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides |m| and |n|, there's also a third aspect of the current
+state, namely the @!|paint_switch|, which is always either |black| or
+|white|. Each \\{paint} command advances |m| by a specified amount~|d|,
+and blackens the intervening pixels if |paint_switch=black|; then
+the |paint_switch| changes to the opposite state. \.{GF}'s commands are
+designed so that |m| will never decrease within a row, and |n| will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened.
+
+@ Here is a list of all the commands that may appear in a \.{GF} file. Each
+command is specified by its symbolic name (e.g., |boc|), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|d[2]|' means that parameter |d| is two bytes long.
+
+\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
+nothing but change the |paint_switch| from \\{black} to \\{white} or vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with |d=1| to~63, defined as follows: If
+|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
+in columns |m| through |m+d-1| inclusive. Then, in any case,
+complement the |paint_switch| and advance |m| by~|d|.
+
+\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
+value of~|d|; \MF\ uses it to paint when |64<=d<256|.
+
+\yskip\hang|@!paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
+as~65535.
+
+\yskip\hang|@!paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
+|max_n[4]|. Beginning of a character: Here |c| is the character code, and
+|p| points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer |p| is |-1| if there was no
+prior character with an equivalent code.) The values of registers |m| and |n|
+defined by the instructions that follow for this character must
+satisfy |min_m<=m<=max_m| and |min_n<=n<=max_n|. (The values of |max_m| and
+|min_n| need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
+initialize the bounds of an array. Then it sets |m:=min_m|, |n:=max_n|, and
+|paint_switch:=white|.
+
+\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
+Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
+and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)
+
+\yskip\hang|eoc| 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have |eoc| immediately following |boc|.
+
+\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=white|. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m:=min_m|, and set
+|paint_switch:=white|. This is a way to produce |d| all-white rows.
+
+\yskip\hang|@!skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
+as 65535.
+
+\yskip\hang|@!skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=black|. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
+|new_row_0|, but with |m:=min_m+1| through |min_m+164|, respectively.
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear within characters,
+in \.{GF} files generated by other
+processors. It is recommended that |x| be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang|@!xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
+ridiculously large; |k| mustn't be negative.
+
+\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
+it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang|@!no_op| 244. No operation, do nothing. Any number of |no_op|'s
+may occur between \.{GF} commands, but a |no_op| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
+This command will appear only in the postamble, which will be explained shortly.
+
+\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
+Same as |char_loc|, except that |dy| is assumed to be zero, and the value
+of~|dx| is taken to be |65536*dm|, where |0<=dm<256|.
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter |i| is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first |boc|.)
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}
+
+@ \MF\ refers to the following opcodes explicitly.
+
+@d paint_0=0 {beginning of the \\{paint} commands}
+@d paint1=64 {move right a given number of columns, then
+ black${}\swap{}$white}
+@d boc=67 {beginning of a character}
+@d boc1=68 {short form of |boc|}
+@d eoc=69 {end of a character}
+@d skip0=70 {skip no blank rows}
+@d skip1=71 {skip over blank rows}
+@d new_row_0=74 {move down one row and then right}
+@d max_new_row=164 {the largest \\{new\_row} command is |new_row_164|}
+@d xxx1=239 {for \&{special} strings}
+@d xxx3=241 {for long \&{special} strings}
+@d yyy=243 {for \&{numspecial} numbers}
+@d char_loc=245 {character locators in the postamble}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+
+@ The last character in a \.{GF} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
+ |@!min_m[4]| |@!max_m[4]| |@!min_n[4]| |@!max_n[4]|\cr
+ $\langle\,$character locators$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the byte following the final |eoc| in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The |ds| and |cs| parameters
+@^design size@> @^check sum@>
+give the design size and check sum, respectively, which are exactly the
+values put into the header of the \.{TFM} file that \MF\ produces (or
+would produce) on this run. Parameters |hppp| and |vppp| are the ratios of
+pixels per point, horizontally and vertically, expressed as |scaled| integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
+registers |m| and~|n| assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; |max_m| and |min_n| may, on the
+other hand, be tighter than the similar bounds in |boc| commands. For
+example, some character may have |min_n=-100| in its |boc|, but it might
+turn out that |n| never gets lower than |-50| in any character; then
+|min_n| can have any value |<=-50|. If there are no characters in the file,
+it's possible to have |min_m>max_m| and/or |min_n>max_n|.)
+
+@ Character locators are introduced by |char_loc| commands,
+which specify a character residue~|c|, character escapements (|dx,dy|),
+a character width~|w|, and a pointer~|p|
+to the beginning of that character. (If two or more characters have the
+same code~|c| modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+The character escapements (|dx,dy|) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of |scaled| pixels;
+i.e., |dx| is in horizontal pixel units times $2^{16}$, and |dy| is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, |dy|
+should be zero, but other document file formats allow nonzero vertical
+escapement.
+
+The character width~|w| duplicates the information in the \.{TFM} file; it
+is a |fix_word| value relative to the design size, and it should be
+independent of magnification.
+
+The backpointer |p| points to the character's |boc|, or to the first of
+a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
+immediately precede the |boc|, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about |p| applies also to the backpointers
+in |boc| commands, even though it wasn't explained in the description
+of~|boc|. @^backpointers@>
+
+Pointer |p| might be |-1| if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had |proofing<0| when the character was being shipped out,
+but then made |proofing>=0| in order to get a \.{GF} file.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the character locators, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~131, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating systems.
+But if \.{GF} files have to be processed under the restrictions of standard
+\PASCAL, one can simply read them from front to back. This will
+be adequate for most applications. However, the postamble-first approach
+would facilitate a program that merges two \.{GF} files, replacing data
+from one that is overridden by corresponding data in the other.
+
+@* \[47] Shipping characters out.
+The |ship_out| procedure, to be described below, is given a pointer to
+an edge structure. Its mission is to describe the the positive pixels
+in \.{GF} form, outputting a ``character'' to |gf_file|.
+
+Several global variables hold information about the font file as a whole:\
+|gf_min_m|, |gf_max_m|, |gf_min_n|, and |gf_max_n| are the minimum and
+maximum \.{GF} coordinates output so far; |gf_prev_ptr| is the byte number
+following the preamble or the last |eoc| command in the output;
+|total_chars| is the total number of characters (i.e., |boc..eoc| segments)
+shipped out. There's also an array, |char_ptr|, containing the starting
+positions of each character in the file, as required for the postamble. If
+character code~|c| has not yet been output, |char_ptr[c]=-1|.
+
+@<Glob...@>=
+@!gf_min_m,@!gf_max_m,@!gf_min_n,@!gf_max_n:integer; {bounding rectangle}
+@!gf_prev_ptr:integer; {where the present/next character started/starts}
+@!total_chars:integer; {the number of characters output so far}
+@!char_ptr:array[eight_bits] of integer; {where individual characters started}
+@!gf_dx,@!gf_dy:array[eight_bits] of integer; {device escapements}
+
+@ @<Set init...@>=
+gf_prev_ptr:=0; total_chars:=0;
+
+@ The \.{GF} bytes are output to a buffer instead of being sent
+byte-by-byte to |gf_file|, because this tends to save a lot of
+subroutine-call overhead. \MF\ uses the same conventions for |gf_file|
+as \TeX\ uses for its \\{dvi\_file}; hence if system-dependent
+changes are needed, they should probably be the same for both programs.
+
+The output buffer is divided into two parts of equal size; the bytes found
+in |gf_buf[0..half_buf-1]| constitute the first half, and those in
+|gf_buf[half_buf..gf_buf_size-1]| constitute the second. The global
+variable |gf_ptr| points to the position that will receive the next
+output byte. When |gf_ptr| reaches |gf_limit|, which is always equal
+to one of the two values |half_buf| or |gf_buf_size|, the half buffer that
+is about to be invaded next is sent to the output and |gf_limit| is
+changed to its other value. Thus, there is always at least a half buffer's
+worth of information present, except at the very beginning of the job.
+
+Bytes of the \.{GF} file are numbered sequentially starting with 0;
+the next byte to be generated will be number |gf_offset+gf_ptr|.
+
+@<Types...@>=
+@!gf_index=0..gf_buf_size; {an index into the output buffer}
+
+@ Some systems may find it more efficient to make |gf_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+
+@<Glob...@>=
+@!gf_buf:array[gf_index] of eight_bits; {buffer for \.{GF} output}
+@!half_buf:gf_index; {half of |gf_buf_size|}
+@!gf_limit:gf_index; {end of the current half buffer}
+@!gf_ptr:gf_index; {the next available buffer address}
+@!gf_offset:integer; {|gf_buf_size| times the number of times the
+ output buffer has been fully emptied}
+
+@ Initially the buffer is all in one piece; we will output half of it only
+after it first fills up.
+
+@<Set init...@>=
+half_buf:=gf_buf_size div 2; gf_limit:=gf_buf_size; gf_ptr:=0;
+gf_offset:=0;
+
+@ The actual output of |gf_buf[a..b]| to |gf_file| is performed by calling
+|write_gf(a,b)|. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_gf(a,b)| is called; therefore it is possible on
+many machines to use efficient methods to pack four bytes per word and to
+output an array of words with one system call.
+@^system dependencies@>
+
+@<Declare generic font output procedures@>=
+procedure write_gf(@!a,@!b:gf_index);
+var k:gf_index;
+begin for k:=a to b do write(gf_file,gf_buf[k]);
+end;
+
+@ To put a byte in the buffer without paying the cost of invoking a procedure
+each time, we use the macro |gf_out|.
+
+@d gf_out(#)==@+begin gf_buf[gf_ptr]:=#; incr(gf_ptr);
+ if gf_ptr=gf_limit then gf_swap;
+ end
+
+@<Declare generic font output procedures@>=
+procedure gf_swap; {outputs half of the buffer}
+begin if gf_limit=gf_buf_size then
+ begin write_gf(0,half_buf-1); gf_limit:=half_buf;
+ gf_offset:=gf_offset+gf_buf_size; gf_ptr:=0;
+ end
+else begin write_gf(half_buf,gf_buf_size-1); gf_limit:=gf_buf_size;
+ end;
+end;
+
+@ Here is how we clean out the buffer when \MF\ is all through; |gf_ptr|
+will be a multiple of~4.
+
+@<Empty the last bytes out of |gf_buf|@>=
+if gf_limit=half_buf then write_gf(half_buf,gf_buf_size-1);
+if gf_ptr>0 then write_gf(0,gf_ptr-1)
+
+@ The |gf_four| procedure outputs four bytes in two's complement notation,
+without risking arithmetic overflow.
+
+@<Declare generic font output procedures@>=
+procedure gf_four(@!x:integer);
+begin if x>=0 then gf_out(x div three_bytes)
+else begin x:=x+@'10000000000;
+ x:=x+@'10000000000;
+ gf_out((x div three_bytes) + 128);
+ end;
+x:=x mod three_bytes; gf_out(x div unity);
+x:=x mod unity; gf_out(x div @'400);
+gf_out(x mod @'400);
+end;
+
+@ Of course, it's even easier to output just two or three bytes.
+
+@<Declare generic font output procedures@>=
+procedure gf_two(@!x:integer);
+begin gf_out(x div @'400); gf_out(x mod @'400);
+end;
+@#
+procedure gf_three(@!x:integer);
+begin gf_out(x div unity); gf_out((x mod unity) div @'400);
+gf_out(x mod @'400);
+end;
+
+@ We need a simple routine to generate a \\{paint}
+command of the appropriate type.
+
+@<Declare generic font output procedures@>=
+procedure gf_paint(@!d:integer); {here |0<=d<65536|}
+begin if d<64 then gf_out(paint_0+d)
+else if d<256 then
+ begin gf_out(paint1); gf_out(d);
+ end
+else begin gf_out(paint1+1); gf_two(d);
+ end;
+end;
+
+@ And |gf_string| outputs one or two strings. If the first string number
+is nonzero, an \\{xxx} command is generated.
+
+@<Declare generic font output procedures@>=
+procedure gf_string(@!s,@!t:str_number);
+var @!k:pool_pointer;
+@!l:integer; {length of the strings to output}
+begin if s<>0 then
+ begin l:=length(s);
+ if t<>0 then l:=l+length(t);
+ if l<=255 then
+ begin gf_out(xxx1); gf_out(l);
+ end
+ else begin gf_out(xxx3); gf_three(l);
+ end;
+ for k:=str_start[s] to str_start[s+1]-1 do gf_out(so(str_pool[k]));
+ end;
+if t<>0 then for k:=str_start[t] to str_start[t+1]-1 do gf_out(so(str_pool[k]));
+end;
+
+@ The choice between |boc| commands is handled by |gf_boc|.
+
+@d one_byte(#)== #>=0 then if #<256
+
+@<Declare generic font output procedures@>=
+procedure gf_boc(@!min_m,@!max_m,@!min_n,@!max_n:integer);
+label exit;
+begin if min_m<gf_min_m then gf_min_m:=min_m;
+if max_n>gf_max_n then gf_max_n:=max_n;
+if boc_p=-1 then if one_byte(boc_c) then
+ if one_byte(max_m-min_m) then if one_byte(max_m) then
+ if one_byte(max_n-min_n) then if one_byte(max_n) then
+ begin gf_out(boc1); gf_out(boc_c);@/
+ gf_out(max_m-min_m); gf_out(max_m);
+ gf_out(max_n-min_n); gf_out(max_n); return;
+ end;
+gf_out(boc); gf_four(boc_c); gf_four(boc_p);@/
+gf_four(min_m); gf_four(max_m); gf_four(min_n); gf_four(max_n);
+exit: end;
+
+@ Two of the parameters to |gf_boc| are global.
+
+@<Glob...@>=
+@!boc_c,@!boc_p:integer; {parameters of the next |boc| command}
+
+@ Here is a routine that gets a \.{GF} file off to a good start.
+
+@d check_gf==@t@>@+if output_file_name=0 then init_gf
+
+@<Declare generic font output procedures@>=
+procedure init_gf;
+var @!k:eight_bits; {runs through all possible character codes}
+@!t:integer; {the time of this run}
+begin gf_min_m:=4096; gf_max_m:=-4096; gf_min_n:=4096; gf_max_n:=-4096;
+for k:=0 to 255 do char_ptr[k]:=-1;
+@<Determine the file extension, |gf_ext|@>;
+set_output_file_name;
+gf_out(pre); gf_out(gf_id_byte); {begin to output the preamble}
+old_setting:=selector; selector:=new_string; print(" METAFONT output ");
+print_int(round_unscaled(internal[year])); print_char(".");
+print_dd(round_unscaled(internal[month])); print_char(".");
+print_dd(round_unscaled(internal[day])); print_char(":");@/
+t:=round_unscaled(internal[time]);
+print_dd(t div 60); print_dd(t mod 60);@/
+selector:=old_setting; gf_out(cur_length);
+str_start[str_ptr+1]:=pool_ptr; gf_string(0,str_ptr);
+pool_ptr:=str_start[str_ptr]; {flush that string from memory}
+gf_prev_ptr:=gf_offset+gf_ptr;
+end;
+
+@ @<Determine the file extension...@>=
+if internal[hppp]<=0 then gf_ext:=".gf"
+else begin old_setting:=selector; selector:=new_string; print_char(".");
+ print_int(make_scaled(internal[hppp],59429463));
+ {$2^{32}/72.27\approx59429463.07$}
+ print("gf"); gf_ext:=make_string; selector:=old_setting;
+ end
+
+@ With those preliminaries out of the way, |ship_out| is not especially
+difficult.
+
+@<Declare generic font output procedures@>=
+procedure ship_out(@!c:eight_bits);
+label done;
+var @!f:integer; {current character extension}
+@!prev_m,@!m,@!mm:integer; {previous and current pixel column numbers}
+@!prev_n,@!n:integer; {previous and current pixel row numbers}
+@!p,@!q:pointer; {for list traversal}
+@!prev_w,@!w,@!ww:integer; {old and new weights}
+@!d:integer; {data from edge-weight node}
+@!delta:integer; {number of rows to skip}
+@!cur_min_m:integer; {starting column, relative to the current offset}
+@!x_off,@!y_off:integer; {offsets, rounded to integers}
+begin check_gf; f:=round_unscaled(internal[char_ext]);@/
+x_off:=round_unscaled(internal[x_offset]);
+y_off:=round_unscaled(internal[y_offset]);
+if term_offset>max_print_line-9 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("["); print_int(c);
+if f<>0 then
+ begin print_char("."); print_int(f);
+ end;
+update_terminal;
+boc_c:=256*f+c; boc_p:=char_ptr[c]; char_ptr[c]:=gf_prev_ptr;@/
+if internal[proofing]>0 then @<Send nonzero offsets to the output file@>;
+@<Output the character represented in |cur_edges|@>;
+gf_out(eoc); gf_prev_ptr:=gf_offset+gf_ptr; incr(total_chars);
+print_char("]"); update_terminal; {progress report}
+if internal[tracing_output]>0 then
+ print_edges(" (just shipped out)",true,x_off,y_off);
+end;
+
+@ @<Send nonzero offsets to the output file@>=
+begin if x_off<>0 then
+ begin gf_string("xoffset",0); gf_out(yyy); gf_four(x_off*unity);
+ end;
+if y_off<>0 then
+ begin gf_string("yoffset",0); gf_out(yyy); gf_four(y_off*unity);
+ end;
+end
+
+@ @<Output the character represented in |cur_edges|@>=
+prev_n:=4096; p:=knil(cur_edges); n:=n_max(cur_edges)-zero_field;
+while p<>cur_edges do
+ begin @<Output the pixels of edge row |p| to font row |n|@>;
+ p:=knil(p); decr(n);
+ end;
+if prev_n=4096 then @<Finish off an entirely blank character@>
+else if prev_n+y_off<gf_min_n then
+ gf_min_n:=prev_n+y_off
+
+@ @<Finish off an entirely blank...@>=
+begin gf_boc(0,0,0,0);
+if gf_max_m<0 then gf_max_m:=0;
+if gf_min_n>0 then gf_min_n:=0;
+end
+
+@ In this loop, |prev_w| represents the weight at column |prev_m|, which is
+the most recent column reflected in the output so far; |w| represents the
+weight at column~|m|, which is the most recent column in the edge data.
+Several edges might cancel at the same column position, so we need to
+look ahead to column~|mm| before actually outputting anything.
+
+@<Output the pixels of edge row |p| to font row |n|@>=
+if unsorted(p)>void then sort_edges(p);
+q:=sorted(p); w:=0; prev_m:=-fraction_one; {$|fraction_one|\approx\infty$}
+ww:=0; prev_w:=0; m:=prev_m;
+repeat if q=sentinel then mm:=fraction_one
+else begin d:=ho(info(q)); mm:=d div 8; ww:=ww+(d mod 8)-zero_w;
+ end;
+if mm<>m then
+ begin if prev_w<=0 then
+ begin if w>0 then @<Start black at $(m,n)$@>;
+ end
+ else if w<=0 then @<Stop black at $(m,n)$@>;
+ m:=mm;
+ end;
+w:=ww; q:=link(q);
+until mm=fraction_one;
+if w<>0 then {this should be impossible}
+ print_nl("(There's unbounded black in character shipped out!)");
+@.There's unbounded black...@>
+if prev_m-m_offset(cur_edges)+x_off>gf_max_m then
+ gf_max_m:=prev_m-m_offset(cur_edges)+x_off
+
+
+@ @<Start black at $(m,n)$@>=
+begin if prev_m=-fraction_one then @<Start a new row at $(m,n)$@>
+else gf_paint(m-prev_m);
+prev_m:=m; prev_w:=w;
+end
+
+@ @<Stop black at $(m,n)$@>=
+begin gf_paint(m-prev_m); prev_m:=m; prev_w:=w;
+end
+
+@ @<Start a new row at $(m,n)$@>=
+begin if prev_n=4096 then
+ begin gf_boc(m_min(cur_edges)+x_off-zero_field,
+ m_max(cur_edges)+x_off-zero_field,@|
+ n_min(cur_edges)+y_off-zero_field,n+y_off);
+ cur_min_m:=m_min(cur_edges)-zero_field+m_offset(cur_edges);
+ end
+else if prev_n>n+1 then @<Skip down |prev_n-n| rows@>
+else @<Skip to column $m$ in the next row and |goto done|, or skip zero rows@>;
+gf_paint(m-cur_min_m); {skip to column $m$, painting white}
+done:prev_n:=n;
+end
+
+@ @<Skip to column $m$ in the next row...@>=
+begin delta:=m-cur_min_m;
+if delta>max_new_row then gf_out(skip0)
+else begin gf_out(new_row_0+delta); goto done;
+ end;
+end
+
+@ @<Skip down...@>=
+begin delta:=prev_n-n-1;
+if delta<@'400 then
+ begin gf_out(skip1); gf_out(delta);
+ end
+else begin gf_out(skip1+1); gf_two(delta);
+ end;
+end
+
+@ Now that we've finished |ship_out|, let's look at the other commands
+by which a user can send things to the \.{GF} file.
+
+@<Cases of |do_statement|...@>=
+special_command: do_special;
+
+@ @<Put each...@>=
+primitive("special",special_command,string_type);@/
+@!@:special_}{\&{special} primitive@>
+primitive("numspecial",special_command,known);@/
+@!@:num_special_}{\&{numspecial} primitive@>
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_special;
+var @!m:small_number; {either |string_type| or |known|}
+begin m:=cur_mod; get_x_next; scan_expression;
+if internal[proofing]>=0 then
+ if cur_type<>m then @<Complain about improper special operation@>
+ else begin check_gf;
+ if m=string_type then gf_string(cur_exp,0)
+ else begin gf_out(yyy); gf_four(cur_exp);
+ end;
+ end;
+flush_cur_exp(0);
+end;
+
+@ @<Complain about improper special operation@>=
+begin exp_err("Unsuitable expression");
+@.Unsuitable expression@>
+help1("The expression shown above has the wrong type to be output.");
+put_get_error;
+end
+
+@ @<Send the current expression as a title to the output file@>=
+begin check_gf; gf_string("title ",cur_exp);
+end
+
+@ @<Cases of |print_cmd...@>=
+special_command:if m=known then print("numspecial")
+ else print("special");
+
+@ @<Determine if a character has been shipped out@>=
+begin cur_exp:=round_unscaled(cur_exp) mod 256;
+if cur_exp<0 then cur_exp:=cur_exp+256;
+boolean_reset(char_exists[cur_exp]); cur_type:=boolean_type;
+end
+
+@ At the end of the program we must finish things off by writing the postamble.
+The \.{TFM} information should have been computed first.
+
+An integer variable |k| and a |scaled| variable |x| will be declared for
+use by this routine.
+
+@<Finish the \.{GF} file@>=
+begin gf_out(post); {beginning of the postamble}
+gf_four(gf_prev_ptr); gf_prev_ptr:=gf_offset+gf_ptr-5; {|post| location}
+gf_four(internal[design_size]*16);
+for k:=1 to 4 do gf_out(header_byte[k]); {the check sum}
+gf_four(internal[hppp]);
+gf_four(internal[vppp]);@/
+gf_four(gf_min_m); gf_four(gf_max_m);
+gf_four(gf_min_n); gf_four(gf_max_n);
+for k:=0 to 255 do if char_exists[k] then
+ begin x:=gf_dx[k] div unity;
+ if (gf_dy[k]=0)and(x>=0)and(x<256)and(gf_dx[k]=x*unity) then
+ begin gf_out(char_loc+1); gf_out(k); gf_out(x);
+ end
+ else begin gf_out(char_loc); gf_out(k);
+ gf_four(gf_dx[k]); gf_four(gf_dy[k]);
+ end;
+ x:=value(tfm_width[k]);
+ if abs(x)>max_tfm_dimen then
+ if x>0 then x:=three_bytes-1@+else x:=1-three_bytes
+ else x:=make_scaled(x*16,internal[design_size]);
+ gf_four(x); gf_four(char_ptr[k]);
+ end;
+gf_out(post_post); gf_four(gf_prev_ptr); gf_out(gf_id_byte);@/
+k:=4+((gf_buf_size-gf_ptr) mod 4); {the number of 223's}
+while k>0 do
+ begin gf_out(223); decr(k);
+ end;
+@<Empty the last bytes out of |gf_buf|@>;
+print_nl("Output written on "); slow_print(output_file_name);
+@.Output written...@>
+print(" ("); print_int(total_chars); print(" character");
+if total_chars<>1 then print_char("s");
+print(", "); print_int(gf_offset+gf_ptr); print(" bytes).");
+b_close(gf_file);
+end
+
+@* \[48] Dumping and undumping the tables.
+After \.{INIMF} has seen a collection of macros, it
+can write all the necessary information on an auxiliary file so
+that production versions of \MF\ are able to initialize their
+memory at high speed. The present section of the program takes
+care of such output and input. We shall consider simultaneously
+the processes of storing and restoring,
+so that the inverse relation between them is clear.
+@.INIMF@>
+
+The global variable |base_ident| is a string that is printed right
+after the |banner| line when \MF\ is ready to start. For \.{INIMF} this
+string says simply `\.{(INIMF)}'; for other versions of \MF\ it says,
+for example, `\.{(preloaded base=plain 84.2.29)}', showing the year,
+month, and day that the base file was created. We have |base_ident=0|
+before \MF's tables are loaded.
+
+@<Glob...@>=
+@!base_ident:str_number;
+
+@ @<Set init...@>=
+base_ident:=0;
+
+@ @<Initialize table entries...@>=
+base_ident:=" (INIMF)";
+
+@ @<Declare act...@>=
+@!init procedure store_base_file;
+var @!k:integer; {all-purpose index}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!w: four_quarters; {four ASCII codes}
+begin @<Create the |base_ident|, open the base file,
+ and inform the user that dumping has begun@>;
+@<Dump constants for consistency check@>;
+@<Dump the string pool@>;
+@<Dump the dynamic memory@>;
+@<Dump the table of equivalents and the hash table@>;
+@<Dump a few more things and the closing check word@>;
+@<Close the base file@>;
+end;
+tini
+
+@ Corresponding to the procedure that dumps a base file, we also have a function
+that reads~one~in. The function returns |false| if the dumped base is
+incompatible with the present \MF\ table sizes, etc.
+
+@d off_base=6666 {go here if the base file is unacceptable}
+@d too_small(#)==begin wake_up_terminal;
+ wterm_ln('---! Must increase the ',#);
+@.Must increase the x@>
+ goto off_base;
+ end
+
+@p @t\4@>@<Declare the function called |open_base_file|@>@;
+function load_base_file:boolean;
+label off_base,exit;
+var @!k:integer; {all-purpose index}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something undumped}
+@!w: four_quarters; {four ASCII codes}
+begin @<Undump constants for consistency check@>;
+@<Undump the string pool@>;
+@<Undump the dynamic memory@>;
+@<Undump the table of equivalents and the hash table@>;
+@<Undump a few more things and the closing check word@>;
+load_base_file:=true; return; {it worked!}
+off_base: wake_up_terminal;
+ wterm_ln('(Fatal base file error; I''m stymied)');
+@.Fatal base file error@>
+load_base_file:=false;
+exit:end;
+
+@ Base files consist of |memory_word| items, and we use the following
+macros to dump words of different types:
+
+@d dump_wd(#)==begin base_file^:=#; put(base_file);@+end
+@d dump_int(#)==begin base_file^.int:=#; put(base_file);@+end
+@d dump_hh(#)==begin base_file^.hh:=#; put(base_file);@+end
+@d dump_qqqq(#)==begin base_file^.qqqq:=#; put(base_file);@+end
+
+@<Glob...@>=
+@!base_file:word_file; {for input or output of base information}
+
+@ The inverse macros are slightly more complicated, since we need to check
+the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
+read an integer value |x| that is supposed to be in the range |a<=x<=b|.
+
+@d undump_wd(#)==begin get(base_file); #:=base_file^;@+end
+@d undump_int(#)==begin get(base_file); #:=base_file^.int;@+end
+@d undump_hh(#)==begin get(base_file); #:=base_file^.hh;@+end
+@d undump_qqqq(#)==begin get(base_file); #:=base_file^.qqqq;@+end
+@d undump_end_end(#)==#:=x;@+end
+@d undump_end(#)==(x>#) then goto off_base@+else undump_end_end
+@d undump(#)==begin undump_int(x); if (x<#) or undump_end
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@d undump_size_end(#)==if x># then undump_size_end_end
+@d undump_size(#)==begin undump_int(x);
+ if x<# then goto off_base; undump_size_end
+
+@ The next few sections of the program should make it clear how we use the
+dump/undump macros.
+
+@<Dump constants for consistency check@>=
+dump_int(@$);@/
+dump_int(mem_min);@/
+dump_int(mem_top);@/
+dump_int(hash_size);@/
+dump_int(hash_prime);@/
+dump_int(max_in_open)
+
+@ Sections of a \.{WEB} program that are ``commented out'' still contribute
+strings to the string pool; therefore \.{INIMF} and \MF\ will have
+the same strings. (And it is, of course, a good thing that they do.)
+@.WEB@>
+@^string pool@>
+
+@<Undump constants for consistency check@>=
+x:=base_file^.int;
+if x<>@$ then goto off_base; {check that strings are the same}
+undump_int(x);
+if x<>mem_min then goto off_base;
+undump_int(x);
+if x<>mem_top then goto off_base;
+undump_int(x);
+if x<>hash_size then goto off_base;
+undump_int(x);
+if x<>hash_prime then goto off_base;
+undump_int(x);
+if x<>max_in_open then goto off_base
+
+@ @d dump_four_ASCII==
+ w.b0:=qi(so(str_pool[k])); w.b1:=qi(so(str_pool[k+1]));
+ w.b2:=qi(so(str_pool[k+2])); w.b3:=qi(so(str_pool[k+3]));
+ dump_qqqq(w)
+
+@<Dump the string pool@>=
+dump_int(pool_ptr);
+dump_int(str_ptr);
+for k:=0 to str_ptr do dump_int(str_start[k]);
+k:=0;
+while k+4<pool_ptr do
+ begin dump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; dump_four_ASCII;
+print_ln; print_int(str_ptr); print(" strings of total length ");
+print_int(pool_ptr)
+
+@ @d undump_four_ASCII==
+ undump_qqqq(w);
+ str_pool[k]:=si(qo(w.b0)); str_pool[k+1]:=si(qo(w.b1));
+ str_pool[k+2]:=si(qo(w.b2)); str_pool[k+3]:=si(qo(w.b3))
+
+@<Undump the string pool@>=
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings)('max strings')(str_ptr);
+for k:=0 to str_ptr do
+ begin undump(0)(pool_ptr)(str_start[k]); str_ref[k]:=max_str_ref;
+ end;
+k:=0;
+while k+4<pool_ptr do
+ begin undump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; undump_four_ASCII;
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;
+max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr
+
+@ By sorting the list of available spaces in the variable-size portion of
+|mem|, we are usually able to get by without having to dump very much
+of the dynamic memory.
+
+We recompute |var_used| and |dyn_used|, so that \.{INIMF} dumps valid
+information even when it has not been gathering statistics.
+
+@<Dump the dynamic memory@>=
+sort_avail; var_used:=0;
+dump_int(lo_mem_max); dump_int(rover);
+p:=mem_min; q:=rover; x:=0;
+repeat for k:=p to q+1 do dump_wd(mem[k]);
+x:=x+q+2-p; var_used:=var_used+q-p;
+p:=q+node_size(q); q:=rlink(q);
+until q=rover;
+var_used:=var_used+lo_mem_max-p; dyn_used:=mem_end+1-hi_mem_min;@/
+for k:=p to lo_mem_max do dump_wd(mem[k]);
+x:=x+lo_mem_max+1-p;
+dump_int(hi_mem_min); dump_int(avail);
+for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
+x:=x+mem_end+1-hi_mem_min;
+p:=avail;
+while p<>null do
+ begin decr(dyn_used); p:=link(p);
+ end;
+dump_int(var_used); dump_int(dyn_used);
+print_ln; print_int(x);
+print(" memory locations dumped; current usage is ");
+print_int(var_used); print_char("&"); print_int(dyn_used)
+
+@ @<Undump the dynamic memory@>=
+undump(lo_mem_stat_max+1000)(hi_mem_stat_min-1)(lo_mem_max);
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+p:=mem_min; q:=rover;
+repeat for k:=p to q+1 do undump_wd(mem[k]);
+p:=q+node_size(q);
+if (p>lo_mem_max)or((q>=rlink(q))and(rlink(q)<>rover)) then goto off_base;
+q:=rlink(q);
+until q=rover;
+for k:=p to lo_mem_max do undump_wd(mem[k]);
+undump(lo_mem_max+1)(hi_mem_stat_min)(hi_mem_min);
+undump(null)(mem_top)(avail); mem_end:=mem_top;
+for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
+undump_int(var_used); undump_int(dyn_used)
+
+@ A different scheme is used to compress the hash table, since its lower region
+is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output three
+words: |p|, |hash[p]|, and |eqtb[p]|. The hash table is, of course, densely
+packed for |p>=hash_used|, so the remaining entries are output in~a~block.
+
+@<Dump the table of equivalents and the hash table@>=
+dump_int(hash_used); st_count:=frozen_inaccessible-1-hash_used;
+for p:=1 to hash_used do if text(p)<>0 then
+ begin dump_int(p); dump_hh(hash[p]); dump_hh(eqtb[p]); incr(st_count);
+ end;
+for p:=hash_used+1 to hash_end do
+ begin dump_hh(hash[p]); dump_hh(eqtb[p]);
+ end;
+dump_int(st_count);@/
+print_ln; print_int(st_count); print(" symbolic tokens")
+
+@ @<Undump the table of equivalents and the hash table@>=
+undump(1)(frozen_inaccessible)(hash_used); p:=0;
+repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]); undump_hh(eqtb[p]);
+until p=hash_used;
+for p:=hash_used+1 to hash_end do
+ begin undump_hh(hash[p]); undump_hh(eqtb[p]);
+ end;
+undump_int(st_count)
+
+@ We have already printed a lot of statistics, so we set |tracing_stats:=0|
+to prevent them from appearing again.
+
+@<Dump a few more things and the closing check word@>=
+dump_int(int_ptr);
+for k:=1 to int_ptr do
+ begin dump_int(internal[k]); dump_int(int_name[k]);
+ end;
+dump_int(start_sym); dump_int(interaction); dump_int(base_ident);
+dump_int(bg_loc); dump_int(eg_loc); dump_int(serial_no); dump_int(69069);
+internal[tracing_stats]:=0
+
+@ @<Undump a few more things and the closing check word@>=
+undump(max_given_internal)(max_internal)(int_ptr);
+for k:=1 to int_ptr do
+ begin undump_int(internal[k]);
+ undump(0)(str_ptr)(int_name[k]);
+ end;
+undump(0)(frozen_inaccessible)(start_sym);
+undump(batch_mode)(error_stop_mode)(interaction);
+undump(0)(str_ptr)(base_ident);
+undump(1)(hash_end)(bg_loc);
+undump(1)(hash_end)(eg_loc);
+undump_int(serial_no);@/
+undump_int(x);@+if (x<>69069)or eof(base_file) then goto off_base
+
+@ @<Create the |base_ident|...@>=
+selector:=new_string;
+print(" (preloaded base="); print(job_name); print_char(" ");
+print_int(round_unscaled(internal[year])); print_char(".");
+print_int(round_unscaled(internal[month])); print_char(".");
+print_int(round_unscaled(internal[day])); print_char(")");
+if interaction=batch_mode then selector:=log_only
+else selector:=term_and_log;
+str_room(1); base_ident:=make_string; str_ref[base_ident]:=max_str_ref;@/
+pack_job_name(base_extension);
+while not w_open_out(base_file) do
+ prompt_file_name("base file name",base_extension);
+print_nl("Beginning to dump on file ");
+@.Beginning to dump...@>
+slow_print(w_make_name_string(base_file)); flush_string(str_ptr-1);
+print_nl(""); slow_print(base_ident)
+
+@ @<Close the base file@>=
+w_close(base_file)
+
+@* \[49] The main program.
+This is it: the part of \MF\ that executes all those procedures we have
+written.
+
+Well---almost. We haven't put the parsing subroutines into the
+program yet; and we'd better leave space for a few more routines that may
+have been forgotten.
+
+@p @<Declare the basic parsing subroutines@>@;
+@<Declare miscellaneous procedures that were declared |forward|@>@;
+@<Last-minute procedures@>
+
+@ We've noted that there are two versions of \MF84. One, called \.{INIMF},
+@.INIMF@>
+has to be run first; it initializes everything from scratch, without
+reading a base file, and it has the capability of dumping a base file.
+The other one is called `\.{VIRMF}'; it is a ``virgin'' program that needs
+@.VIRMF@>
+to input a base file in order to get started. \.{VIRMF} typically has
+a bit more memory capacity than \.{INIMF}, because it does not need the
+space consumed by the dumping/undumping routines and the numerous calls on
+|primitive|, etc.
+
+The \.{VIRMF} program cannot read a base file instantaneously, of course;
+the best implementations therefore allow for production versions of \MF\ that
+not only avoid the loading routine for \PASCAL\ object code, they also have
+a base file pre-loaded. This is impossible to do if we stick to standard
+\PASCAL; but there is a simple way to fool many systems into avoiding the
+initialization, as follows:\quad(1)~We declare a global integer variable
+called |ready_already|. The probability is negligible that this
+variable holds any particular value like 314159 when \.{VIRMF} is first
+loaded.\quad(2)~After we have read in a base file and initialized
+everything, we set |ready_already:=314159|.\quad(3)~Soon \.{VIRMF}
+will print `\.*', waiting for more input; and at this point we
+interrupt the program and save its core image in some form that the
+operating system can reload speedily.\quad(4)~When that core image is
+activated, the program starts again at the beginning; but now
+|ready_already=314159| and all the other global variables have
+their initial values too. The former chastity has vanished!
+
+In other words, if we allow ourselves to test the condition
+|ready_already=314159|, before |ready_already| has been
+assigned a value, we can avoid the lengthy initialization. Dirty tricks
+rarely pay off so handsomely.
+@^dirty \PASCAL@>
+@^system dependencies@>
+
+On systems that allow such preloading, the standard program called \.{MF}
+should be the one that has \.{plain} base preloaded, since that agrees
+with {\sl The {\logos METAFONT\/}book}. Other versions, e.g., \.{cmbase},
+should also be provided for commonly used bases.
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+@.cmbase@>
+@.plain@>
+
+@<Glob...@>=
+@!ready_already:integer; {a sacrifice of purity for economy}
+
+@ Now this is really it: \MF\ starts and ends here.
+
+The initial test involving |ready_already| should be deleted if the
+\PASCAL\ runtime system is smart enough to detect such a ``mistake.''
+@^system dependencies@>
+
+@p begin @!{|start_here|}
+history:=fatal_error_stop; {in case we quit during initialization}
+t_open_out; {open the terminal for output}
+if ready_already=314159 then goto start_of_MF;
+@<Check the ``constant'' values...@>@;
+if bad>0 then
+ begin wterm_ln('Ouch---my internal constants have been clobbered!',
+ '---case ',bad:1);
+@.Ouch...clobbered@>
+ goto final_end;
+ end;
+initialize; {set global variables to their starting values}
+@!init if not get_strings_started then goto final_end;
+init_tab; {initialize the tables}
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;@/
+max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+ready_already:=314159;
+start_of_MF: @<Initialize the output routines@>;
+@<Get the first line of input and prepare to start@>;
+history:=spotless; {ready to go!}
+if start_sym>0 then {insert the `\&{everyjob}' symbol}
+ begin cur_sym:=start_sym; back_input;
+ end;
+main_control; {come to life}
+final_cleanup; {prepare for death}
+end_of_MF: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+
+@ Here we do whatever is needed to complete \MF's job gracefully on the
+local operating system. The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+|str_room| or |make_string| at this time, because a call on |overflow|
+might lead to an infinite loop.
+@^system dependencies@>
+
+This program doesn't bother to close the input files that may still be open.
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+var @!k:integer; {all-purpose index}
+@!lh:integer; {the length of the \.{TFM} header, in words}
+@!lk_offset:0..256; {extra words inserted at beginning of |lig_kern| array}
+@!p:pointer; {runs through a list of \.{TFM} dimensions}
+@!x:scaled; {a |tfm_width| value being output to the \.{GF} file}
+begin
+@!stat if internal[tracing_stats]>0 then
+ @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{TFM} and \.{GF} files@>;
+if log_opened then
+ begin wlog_cr;
+ a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+@.Transcript written...@>
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+end;
+
+@ We want to finish the \.{GF} file if and only if it has already been started;
+this will be true if and only if |gf_prev_ptr| is positive.
+We want to produce a \.{TFM} file if and only if |fontmaking| is positive.
+The \.{TFM} widths must be computed if there's a \.{GF} file, even if
+there's going to be no \.{TFM}~file.
+
+We reclaim all of the variable-size memory at this point, so that
+there is no chance of another memory overflow after the memory capacity
+has already been exceeded.
+
+@<Finish the \.{TFM} and \.{GF} files@>=
+if (gf_prev_ptr>0)or(internal[fontmaking]>0) then
+ begin @<Make the dynamic memory into one big available node@>;
+ @<Massage the \.{TFM} widths@>;
+ fix_design_size; fix_check_sum;
+ if internal[fontmaking]>0 then
+ begin @<Massage the \.{TFM} heights, depths, and italic corrections@>;
+ internal[fontmaking]:=0; {avoid loop in case of fatal error}
+ @<Finish the \.{TFM} file@>;
+ end;
+ if gf_prev_ptr>0 then @<Finish the \.{GF} file@>;
+ end
+
+@ @<Make the dynamic memory into one big available node@>=
+rover:=lo_mem_stat_max+1; link(rover):=empty_flag; lo_mem_max:=hi_mem_min-1;
+if lo_mem_max-rover>max_halfword then lo_mem_max:=max_halfword+rover;
+node_size(rover):=lo_mem_max-rover; llink(rover):=rover; rlink(rover):=rover;
+link(lo_mem_max):=null; info(lo_mem_max):=null
+
+@ The present section goes directly to the log file instead of using
+|print| commands, because there's no need for these strings to take
+up |str_pool| memory when a non-{\bf stat} version of \MF\ is being used.
+
+@<Output statistics...@>=
+if log_opened then
+ begin wlog_ln(' ');
+ wlog_ln('Here is how much of METAFONT''s memory',' you used:');
+@.Here is how much...@>
+ wlog(' ',max_str_ptr-init_str_ptr:1,' string');
+ if max_str_ptr<>init_str_ptr+1 then wlog('s');
+ wlog_ln(' out of ', max_strings-init_str_ptr:1);@/
+ wlog_ln(' ',max_pool_ptr-init_pool_ptr:1,' string characters out of ',
+ pool_size-init_pool_ptr:1);@/
+ wlog_ln(' ',lo_mem_max-mem_min+mem_end-hi_mem_min+2:1,@|
+ ' words of memory out of ',mem_end+1-mem_min:1);@/
+ wlog_ln(' ',st_count:1,' symbolic tokens out of ',
+ hash_size:1);@/
+ wlog_ln(' ',max_in_stack:1,'i,',@|
+ int_ptr:1,'n,',@|
+ max_rounding_ptr:1,'r,',@|
+ max_param_stack:1,'p,',@|
+ max_buf_stack+1:1,'b stack positions out of ',@|
+ stack_size:1,'i,',
+ max_internal:1,'n,',
+ max_wiggle:1,'r,',
+ param_size:1,'p,',
+ buf_size:1,'b');
+ end
+
+@ We get to the |final_cleanup| routine when \&{end} or \&{dump} has
+been scanned.
+
+@<Last-minute...@>=
+procedure final_cleanup;
+label exit;
+var c:small_number; {0 for \&{end}, 1 for \&{dump}}
+begin c:=cur_mod;
+if job_name=0 then open_log_file;
+while input_ptr>0 do
+ if token_state then end_token_list@+else end_file_reading;
+while loop_ptr<>null do stop_iteration;
+while open_parens>0 do
+ begin print(" )"); decr(open_parens);
+ end;
+while cond_ptr<>null do
+ begin print_nl("(end occurred when ");@/
+@.end occurred...@>
+ print_cmd_mod(fi_or_else,cur_if);
+ {`\.{if}' or `\.{elseif}' or `\.{else}'}
+ if if_line<>0 then
+ begin print(" on line "); print_int(if_line);
+ end;
+ print(" was incomplete)");
+ if_line:=if_line_field(cond_ptr);
+ cur_if:=name_type(cond_ptr); loop_ptr:=cond_ptr;
+ cond_ptr:=link(cond_ptr); free_node(loop_ptr,if_node_size);
+ end;
+if history<>spotless then
+ if ((history=warning_issued)or(interaction<error_stop_mode)) then
+ if selector=term_and_log then
+ begin selector:=term_only;
+ print_nl("(see the transcript file for additional information)");
+@.see the transcript file...@>
+ selector:=term_and_log;
+ end;
+if c=1 then
+ begin @!init store_base_file; return;@+tini@/
+ print_nl("(dump is performed only by INIMF)"); return;
+@.dump...only by INIMF@>
+ end;
+exit:end;
+
+@ @<Last-minute...@>=
+@!init procedure init_prim; {initialize all the primitives}
+begin
+@<Put each...@>;
+end;
+@#
+procedure init_tab; {initialize other tables}
+var @!k:integer; {all-purpose index}
+begin @<Initialize table entries (done by \.{INIMF} only)@>@;
+end;
+tini
+
+@ When we begin the following code, \MF's tables may still contain garbage;
+the strings might not even be present. Thus we must proceed cautiously to get
+bootstrapped in.
+
+But when we finish this part of the program, \MF\ is ready to call on the
+|main_control| routine to do its work.
+
+@<Get the first line...@>=
+begin @<Initialize the input routines@>;
+if (base_ident=0)or(buffer[loc]="&") then
+ begin if base_ident<>0 then initialize; {erase preloaded base}
+ if not open_base_file then goto final_end;
+ if not load_base_file then
+ begin w_close(base_file); goto final_end;
+ end;
+ w_close(base_file);
+ while (loc<limit)and(buffer[loc]=" ") do incr(loc);
+ end;
+buffer[limit]:="%";@/
+fix_date_and_time; init_randoms((internal[time] div unity)+internal[day]);@/
+@<Initialize the print |selector|...@>;
+if loc<limit then if buffer[loc]<>"\" then start_input; {\&{input} assumed}
+end
+
+@* \[50] Debugging.
+Once \MF\ is working, you should be able to diagnose most errors with
+the \.{show} commands and other diagnostic features. But for the initial
+stages of debugging, and for the revelation of really deep mysteries, you
+can compile \MF\ with a few more aids, including the \PASCAL\ runtime
+checks and its debugger. An additional routine called |debug_help|
+will also come into play when you type `\.D' after an error message;
+|debug_help| also occurs just before a fatal error causes \MF\ to succumb.
+@^debugging@>
+@^system dependencies@>
+
+The interface to |debug_help| is primitive, but it is good enough when used
+with a \PASCAL\ debugger that allows you to set breakpoints and to read
+variables and change their values. After getting the prompt `\.{debug \#}', you
+type either a negative number (this exits |debug_help|), or zero (this
+goes to a location where you can set a breakpoint, thereby entering into
+dialog with the \PASCAL\ debugger), or a positive number |m| followed by
+an argument |n|. The meaning of |m| and |n| will be clear from the
+program below. (If |m=13|, there is an additional argument, |l|.)
+@.debug \#@>
+
+@d breakpoint=888 {place where a breakpoint is desirable}
+
+@<Last-minute...@>=
+@!debug procedure debug_help; {routine to display various things}
+label breakpoint,exit;
+var @!k,@!l,@!m,@!n:integer;
+begin loop begin wake_up_terminal;
+ print_nl("debug # (-1 to exit):"); update_terminal;
+@.debug \#@>
+ read(term_in,m);
+ if m<0 then return
+ else if m=0 then
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+ else begin read(term_in,n);
+ case m of
+ @t\4@>@<Numbered cases for |debug_help|@>@;
+ othercases print("?")
+ endcases;
+ end;
+ end;
+exit:end;
+gubed
+
+@ @<Numbered cases...@>=
+1: print_word(mem[n]); {display |mem[n]| in all forms}
+2: print_int(info(n));
+3: print_int(link(n));
+4: begin print_int(eq_type(n)); print_char(":"); print_int(equiv(n));
+ end;
+5: print_variable_name(n);
+6: print_int(internal[n]);
+7: do_show_dependencies;
+9: show_token_list(n,null,100000,0);
+10: slow_print(n);
+11: check_mem(n>0); {check wellformedness; print new busy locations if |n>0|}
+12: search_mem(n); {look for pointers to |n|}
+13: begin read(term_in,l); print_cmd_mod(n,l);
+ end;
+14: for k:=0 to n do print(buffer[k]);
+15: panicking:=not panicking;
+
+@* \[51] System-dependent changes.
+This section should be replaced, if necessary, by any special
+modifications of the program
+that are necessary to make \MF\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* \[52] Index.
+Here is where you can find all uses of each identifier in the program,
+with underlined entries pointing to where the identifier was defined.
+If the identifier is only one letter long, however, you get to see only
+the underlined entries. {\sl All references are to section numbers instead of
+page numbers.}
+
+This index also lists error messages and other aspects of the program
+that you might want to look up some day. For example, the entry
+for ``system dependencies'' lists all sections that should receive
+special attention from people who are installing \MF\ in a new
+operating environment. A list of various things that can't happen appears
+under ``this can't happen''.
+Approximately 25 sections are listed under ``inner loop''; these account
+for more than 60\pct! of \MF's running time, exclusive of input and output.
diff --git a/Build/source/texk/web2c/mft.ch b/Build/source/texk/web2c/mft.ch
new file mode 100644
index 00000000000..e56920717c0
--- /dev/null
+++ b/Build/source/texk/web2c/mft.ch
@@ -0,0 +1,1201 @@
+% mft.ch for C compilation with web2c.
+%
+% From Pierre Mackay's version for pc, which was in turn based on Howard
+% Trickey's and Pavel Curtis's change file for weave.
+% Support for MP included from a changefile by Wlodek Bzyl.
+% This file is in the public domain.
+
+@x [0] l.16 - WEAVE: use logo font to get the S
+\font\logo=manfnt % font used for the METAFONT logo
+@y
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MP{{\logo META}\-{\logo POST}}
+@z
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{MFT changes for C and METAPOST}
+@z
+
+@x [1]
+This program converts a \MF\ source file to a \TeX\ file. It was written
+@y
+This program converts a \MF\ or \MP\ source file to a \TeX\ file.
+It was written
+@z
+@x [1]
+@^Knuth, Donald Ervin@>
+been developed in January, 1980.
+@y
+@^Knuth, Donald Ervin@>
+been developed in January, 1980.
+@^Bzyl, Wlodek@>
+Changes for \MP\ by W.~Bzyl in July, 2001.
+@z
+
+% [3] No need for the final label in C.
+% AIX defines `class' in <math.h>, so let's take this opportunity to
+% define that away.
+@x
+@d end_of_MFT = 9999 {go here to wrap it up}
+@y
+@d class == class_var
+@z
+
+@x [3] No global labels.
+label end_of_MFT; {go here to finish}
+@y
+@z
+
+@x [3]
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values@>@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize;
+ var @<Local variables for initialization@>@/
+begin
+ kpse_set_program_name (argv[0], nil);
+ parse_arguments;
+ @<Set initial values@>;
+@z
+
+@x [8] Increase constants.
+@!max_bytes=10000; {the number of bytes in tokens; must be less than 65536}
+@!max_names=1000; {number of tokens}
+@y
+@!max_bytes=60000; {the number of bytes in tokens; must be less than 65536}
+@!max_names=6000; {number of tokens}
+@z
+@x
+@!buf_size=100; {maximum length of input line}
+@!line_length=80; {lines of \TeX\ output have at most this many characters,
+@y
+@!buf_size=3000; {maximum length of input line}
+@!line_length=79; {lines of \TeX\ output have at most this many characters,
+@z
+
+% [13] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [17] Allow any input character.
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+@y
+for i:=1 to @'37 do xchr[i]:=chr(i);
+for i:=@'177 to @'377 do xchr[i]:=chr(i);
+@z
+
+@x [20] Terminal I/O.
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@y
+@d term_out==stdout
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@z
+
+% [20] Remove term_out.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+@y
+@z
+
+@x [21] Don't initialize the terminal.
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{WEAVE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal.
+@^system dependencies@>
+
+@<Set init...@>=
+{nothing need be done}
+@z
+
+@x [22] `break' is `fflush'.
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == fflush(term_out) {empty the terminal output buffer}
+@z
+
+@x [24] Open input files.
+@ The following code opens the input files. Since these files were listed
+in the program header, we assume that the \PASCAL\ runtime system has
+already checked that suitable file names have been given; therefore no
+additional error checking needs to be done.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read the inputs}
+begin reset(mf_file); reset(change_file); reset(style_file);
+end;
+@y
+@ The following code opens the input files.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read inputs}
+begin
+ if metapost then
+ mf_file := kpse_open_file (cmdline (optind), kpse_mp_format)
+ else
+ mf_file := kpse_open_file (cmdline (optind), kpse_mf_format);
+ if change_name then begin
+ if metapost then
+ change_file := kpse_open_file (change_name, kpse_mp_format)
+ else
+ change_file := kpse_open_file (change_name, kpse_mf_format);
+ end;
+ style_file := kpse_open_file (style_name[0], kpse_mft_format);
+ i_style_name := 1;
+end;
+@z
+
+@x [26] Opening the .tex output file.
+rewrite(tex_file);
+@y
+rewrite (tex_file, tex_name);
+@z
+
+@x [28] Fix f^.
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+@y
+ begin buffer[limit]:=xord[getc(f)];
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do vgetc(f);
+@z
+
+@x [31] Fix jump_out.
+@ The |jump_out| procedure just cuts across all active procedure levels
+and jumps out of the program. This is the only non-local \&{goto} statement
+in \.{MFT}. It is used when no recovery from a particular error has
+been provided.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the code that appears at label |end_of_MFT| should be
+copied into the |jump_out| procedure, followed by a call to a system procedure
+that terminates the program.
+
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_MFT;
+end;
+@y
+@ The |jump_out| procedure cleans up, prints appropriate messages,
+and exits back to the operating system.
+
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin
+@t\4\4@>{here files should be closed if the operating system requires it}
+ @<Print the job |history|@>;
+ new_line;
+ if (history <> spotless) and (history <> harmless_message) then
+ uexit(1)
+ else
+ uexit(0);
+end;
+@z
+
+@x [47] -- allow for multiple style files
+@ @<Read from |style_file|...@>=
+begin incr(line);
+if not input_ln(style_file) then
+ begin styling:=false; line:=0;
+ end;
+end
+@y
+@ @<Read from |style_file|...@>=
+begin incr(line);
+if not input_ln(style_file) then begin
+ if i_style_name <> n_style_name then begin
+ xfclose(style_file,style_name[i_style_name-1]);
+ style_file := kpse_open_file (style_name[i_style_name], kpse_mft_format);
+ i_style_name := i_style_name + 1;
+ end
+ else begin
+ styling:=false;
+ end;
+ line:=0;
+ end;
+end
+@z
+
+% MFT incorrectly handles TeX code contained in groups:
+%
+% btex <TeX material> etex
+% verbatimtex <TeX material> etex
+%
+% Ulrik Vieth (using ideas of Andreas Scherer) developed a Unix
+% shell script which tries to correct errors made by MFT when
+% prettyprinting TeX material.
+% His script converts TeX material to a `TeXnical MFT comment',
+% which means that it is extracted and prettyprinted as string.
+% Unfortunately, his script assumes that these groups may not
+% extend across line breaks and there may be only one such
+% group per line, which is sometimes hard to obey and
+% makes prettyprinted code harder to read.
+% Moreover, any synonym for btex/verbatimtex/etex would not be
+% recognized. So, if we introduce a change in MFT's formatting
+% rules with
+% %%% btex my_btex
+% i.e. we instruct MFT to format token `my_btex' according the
+% current convention for `btex' token,
+% then this new convention would not be obeyed. It is so,
+% because the script has hardcoded btex/verbatimtex/etex names.
+
+@x [63]
+@d input_command=31 {internal code for tokens like `\.{input}'}
+@d special_tag=32 {internal code for tags that take at most one subscript}
+@d tag=33 {internal code for nonprimitive tokens}
+@y
+@d input_command=31 {internal code for tokens like `\.{input}'}
+@d btex_code=32 {begin \TeX\ material (\.{btex})}
+@d verbatim_code=33 {begin \TeX\ material (\.{verbatimtex})}
+@d etex_marker=34 {end \TeX\ material (\.{etex})}
+@d special_tag=35 {internal code for tags that take at most one subscript}
+@d tag=36 {internal code for nonprimitive tokens}
+@z
+
+% Now follows the simplest change -- although the bigest one.
+% The primitives of \MF\ and \MP\ are reshuffled into
+% three categories:
+% -- primitivies common for \MF\ and \MP
+% -- primitivies specific for \MF
+% -- primitivies specific for \MP
+
+@x [65]
+@ The intended use of the macros above might not be immediately obvious,
+but the riddle is answered by the following:
+
+@<Store all the primitives@>=
+id_loc:=18;@/
+pr2(".")(".")(path_join);@/
+pr1("[")(as_is);@/
+pr1("]")(as_is);@/
+pr1("}")(as_is);@/
+pr1("{")(as_is);@/
+pr1(":")(colon);@/
+pr2(":")(":")(colon);@/
+pr3("|")("|")(":")(colon);@/
+pr2(":")("=")(as_is);@/
+pr1(",")(as_is);@/
+pr1(";")(semicolon);@/
+pr1("\")(backslash);@/
+pr2("\")("\")(double_back);@/
+pr5("a")("d")("d")("t")("o")(command);@/
+pr2("a")("t")(bbinary);@/
+pr7("a")("t")("l")("e")("a")("s")("t")(op);@/
+pr10("b")("e")("g")("i")("n")("g")("r")("o")("u")("p")(command);
+pr8("c")("o")("n")("t")("r")("o")("l")("s")(op);@/
+pr4("c")("u")("l")("l")(command);@/
+pr4("c")("u")("r")("l")(op);@/
+pr10("d")("e")("l")("i")("m")("i")("t")("e")("r")("s")(command);@/
+pr7("d")("i")("s")("p")("l")("a")("y")(command);@/
+pr8("e")("n")("d")("g")("r")("o")("u")("p")(endit);@/
+pr8("e")("v")("e")("r")("y")("j")("o")("b")(command);@/
+pr6("e")("x")("i")("t")("i")("f")(command);@/
+pr11("e")("x")("p")("a")("n")("d")("a")("f")("t")("e")("r")(command);@/
+pr4("f")("r")("o")("m")(bbinary);@/
+pr8("i")("n")("w")("i")("n")("d")("o")("w")(bbinary);@/
+pr7("i")("n")("t")("e")("r")("i")("m")(command);@/
+pr3("l")("e")("t")(command);@/
+pr11("n")("e")("w")("i")("n")("t")("e")("r")("n")("a")("l")(command);@/
+pr2("o")("f")(command);@/
+pr10("o")("p")("e")("n")("w")("i")("n")("d")("o")("w")(command);@/
+pr10("r")("a")("n")("d")("o")("m")("s")("e")("e")("d")(command);@/
+pr4("s")("a")("v")("e")(command);@/
+pr10("s")("c")("a")("n")("t")("o")("k")("e")("n")("s")(command);@/
+pr7("s")("h")("i")("p")("o")("u")("t")(command);@/
+pr4("s")("t")("e")("p")(bbinary);@/
+pr3("s")("t")("r")(command);@/
+pr7("t")("e")("n")("s")("i")("o")("n")(op);@/
+pr2("t")("o")(bbinary);@/
+pr5("u")("n")("t")("i")("l")(bbinary);@/
+pr3("d")("e")("f")(command);@/
+pr6("v")("a")("r")("d")("e")("f")(command);@/
+
+@ (There are so many primitives, it's necessary to break this long
+initialization code up into pieces so as not to overflow \.{WEAVE}'s capacity.)
+
+@<Store all the primitives@>=
+pr10("p")("r")("i")("m")("a")("r")("y")("d")("e")("f")(command);@/
+pr12("s")("e")("c")("o")("n")("d")("a")("r")("y")("d")("e")("f")(command);@/
+pr11("t")("e")("r")("t")("i")("a")("r")("y")("d")("e")("f")(command);@/
+pr6("e")("n")("d")("d")("e")("f")(endit);@/
+pr3("f")("o")("r")(command);@/
+pr11("f")("o")("r")("s")("u")("f")("f")("i")("x")("e")("s")(command);@/
+pr7("f")("o")("r")("e")("v")("e")("r")(command);@/
+pr6("e")("n")("d")("f")("o")("r")(endit);@/
+pr5("q")("u")("o")("t")("e")(command);@/
+pr4("e")("x")("p")("r")(command);@/
+pr6("s")("u")("f")("f")("i")("x")(command);@/
+pr4("t")("e")("x")("t")(command);@/
+pr7("p")("r")("i")("m")("a")("r")("y")(command);@/
+pr9("s")("e")("c")("o")("n")("d")("a")("r")("y")(command);@/
+pr8("t")("e")("r")("t")("i")("a")("r")("y")(command);@/
+pr5("i")("n")("p")("u")("t")(input_command);@/
+pr8("e")("n")("d")("i")("n")("p")("u")("t")(bold);@/
+pr2("i")("f")(command);@/
+pr2("f")("i")(endit);@/
+pr4("e")("l")("s")("e")(command);@/
+pr6("e")("l")("s")("e")("i")("f")(command);@/
+pr4("t")("r")("u")("e")(bold);@/
+pr5("f")("a")("l")("s")("e")(bold);@/
+pr11("n")("u")("l")("l")("p")("i")("c")("t")("u")("r")("e")(bold);@/
+pr7("n")("u")("l")("l")("p")("e")("n")(bold);@/
+pr7("j")("o")("b")("n")("a")("m")("e")(bold);@/
+pr10("r")("e")("a")("d")("s")("t")("r")("i")("n")("g")(bold);@/
+pr9("p")("e")("n")("c")("i")("r")("c")("l")("e")(bold);@/
+pr4("g")("o")("o")("d")(special_tag);@/
+pr2("=")(":")(as_is);@/
+pr3("=")(":")("|")(as_is);@/
+pr4("=")(":")("|")(">")(as_is);@/
+pr3("|")("=")(":")(as_is);@/
+pr4("|")("=")(":")(">")(as_is);@/
+pr4("|")("=")(":")("|")(as_is);@/
+pr5("|")("=")(":")("|")(">")(as_is);@/
+pr6("|")("=")(":")("|")(">")(">")(as_is);@/
+pr4("k")("e")("r")("n")(binary);
+pr6("s")("k")("i")("p")("t")("o")(command);@/
+
+@ (Does anybody out there remember the commercials that went \.{LS-MFT}?)
+
+@<Store all the prim...@>=
+pr13("n")("o")("r")("m")("a")("l")("d")("e")("v")("i")("a")("t")("e")(op);@/
+pr3("o")("d")("d")(op);@/
+pr5("k")("n")("o")("w")("n")(op);@/
+pr7("u")("n")("k")("n")("o")("w")("n")(op);@/
+pr3("n")("o")("t")(op);@/
+pr7("d")("e")("c")("i")("m")("a")("l")(op);@/
+pr7("r")("e")("v")("e")("r")("s")("e")(op);@/
+pr8("m")("a")("k")("e")("p")("a")("t")("h")(op);@/
+pr7("m")("a")("k")("e")("p")("e")("n")(op);@/
+pr11("t")("o")("t")("a")("l")("w")("e")("i")("g")("h")("t")(op);@/
+pr3("o")("c")("t")(op);@/
+pr3("h")("e")("x")(op);@/
+pr5("A")("S")("C")("I")("I")(op);@/
+pr4("c")("h")("a")("r")(op);@/
+pr6("l")("e")("n")("g")("t")("h")(op);@/
+pr13("t")("u")("r")("n")("i")("n")("g")("n")("u")("m")("b")("e")("r")(op);@/
+pr5("x")("p")("a")("r")("t")(op);@/
+pr5("y")("p")("a")("r")("t")(op);@/
+pr6("x")("x")("p")("a")("r")("t")(op);@/
+pr6("x")("y")("p")("a")("r")("t")(op);@/
+pr6("y")("x")("p")("a")("r")("t")(op);@/
+pr6("y")("y")("p")("a")("r")("t")(op);@/
+pr4("s")("q")("r")("t")(op);@/
+pr4("m")("e")("x")("p")(op);@/
+pr4("m")("l")("o")("g")(op);@/
+pr4("s")("i")("n")("d")(op);@/
+pr4("c")("o")("s")("d")(op);@/
+pr5("f")("l")("o")("o")("r")(op);@/
+pr14("u")("n")("i")("f")("o")("r")("m")("d")("e")("v")("i")("a")("t")("e")(op);
+ @/
+pr10("c")("h")("a")("r")("e")("x")("i")("s")("t")("s")(op);@/
+pr5("a")("n")("g")("l")("e")(op);@/
+pr5("c")("y")("c")("l")("e")(op);@/
+
+@ (If you think this \.{WEB} code is ugly, you should see the Pascal code
+it produces.)
+
+@<Store all the primitives@>=
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("t")("i")("t")("l")("e")("s")(internal);@/
+pr16("t")("r")("a")("c")("i")("n")("g")
+ ("e")("q")("u")("a")("t")("i")("o")("n")("s")(internal);@/
+pr15("t")("r")("a")("c")("i")("n")("g")
+ ("c")("a")("p")("s")("u")("l")("e")("s")(internal);@/
+pr14("t")("r")("a")("c")("i")("n")("g")
+ ("c")("h")("o")("i")("c")("e")("s")(internal);@/
+pr12("t")("r")("a")("c")("i")("n")("g")
+ ("s")("p")("e")("c")("s")(internal);@/
+pr11("t")("r")("a")("c")("i")("n")("g")
+ ("p")("e")("n")("s")(internal);@/
+pr15("t")("r")("a")("c")("i")("n")("g")
+ ("c")("o")("m")("m")("a")("n")("d")("s")(internal);@/
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("m")("a")("c")("r")("o")("s")(internal);@/
+pr12("t")("r")("a")("c")("i")("n")("g")
+ ("e")("d")("g")("e")("s")(internal);@/
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("o")("u")("t")("p")("u")("t")(internal);@/
+pr12("t")("r")("a")("c")("i")("n")("g")
+ ("s")("t")("a")("t")("s")(internal);@/
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("o")("n")("l")("i")("n")("e")(internal);@/
+
+@ @<Store all the primitives@>=
+pr4("y")("e")("a")("r")(internal);@/
+pr5("m")("o")("n")("t")("h")(internal);@/
+pr3("d")("a")("y")(internal);@/
+pr4("t")("i")("m")("e")(internal);@/
+pr8("c")("h")("a")("r")("c")("o")("d")("e")(internal);@/
+pr7("c")("h")("a")("r")("f")("a")("m")(internal);@/
+pr6("c")("h")("a")("r")("w")("d")(internal);@/
+pr6("c")("h")("a")("r")("h")("t")(internal);@/
+pr6("c")("h")("a")("r")("d")("p")(internal);@/
+pr6("c")("h")("a")("r")("i")("c")(internal);@/
+pr6("c")("h")("a")("r")("d")("x")(internal);@/
+pr6("c")("h")("a")("r")("d")("y")(internal);@/
+pr10("d")("e")("s")("i")("g")("n")("s")("i")("z")("e")(internal);@/
+pr4("h")("p")("p")("p")(internal);@/
+pr4("v")("p")("p")("p")(internal);@/
+pr7("x")("o")("f")("f")("s")("e")("t")(internal);@/
+pr7("y")("o")("f")("f")("s")("e")("t")(internal);@/
+pr7("p")("a")("u")("s")("i")("n")("g")(internal);@/
+pr12("s")("h")("o")("w")
+ ("s")("t")("o")("p")("p")("i")("n")("g")(internal);@/
+pr10("f")("o")("n")("t")("m")("a")("k")("i")("n")("g")(internal);@/
+pr8("p")("r")("o")("o")("f")("i")("n")("g")(internal);@/
+pr9("s")("m")("o")("o")("t")("h")("i")("n")("g")(internal);@/
+pr12("a")("u")("t")("o")("r")("o")("u")("n")("d")("i")("n")("g")(internal);@/
+pr11("g")("r")("a")("n")("u")("l")("a")("r")("i")("t")("y")(internal);@/
+pr6("f")("i")("l")("l")("i")("n")(internal);@/
+pr12("t")("u")("r")("n")("i")("n")("g")("c")("h")("e")("c")("k")(internal);@/
+pr12("w")("a")("r")("n")("i")("n")("g")("c")("h")("e")("c")("k")(internal);@/
+pr12("b")("o")("u")("n")("d")("a")("r")("y")("c")("h")("a")("r")(internal);@/
+
+@ Still more.
+
+@<Store all the prim...@>=
+pr1("+")(abinary);@/
+pr1("-")(abinary);@/
+pr1("*")(abinary);@/
+pr1("/")(as_is);@/
+pr2("+")("+")(binary);@/
+pr3("+")("-")("+")(pyth_sub);@/
+pr3("a")("n")("d")(binary);@/
+pr2("o")("r")(binary);@/
+pr1("<")(as_is);@/
+pr2("<")("=")(less_or_equal);@/
+pr1(">")(as_is);@/
+pr2(">")("=")(greater_or_equal);@/
+pr1("=")(as_is);@/
+pr2("<")(">")(not_equal);@/
+pr9("s")("u")("b")("s")("t")("r")("i")("n")("g")(command);@/
+pr7("s")("u")("b")("p")("a")("t")("h")(command);@/
+pr13("d")("i")("r")("e")("c")("t")("i")("o")("n")@|
+ ("t")("i")("m")("e")(command);@/
+pr5("p")("o")("i")("n")("t")(command);@/
+pr10("p")("r")("e")("c")("o")("n")("t")("r")("o")("l")(command);@/
+pr11("p")("o")("s")("t")("c")("o")("n")("t")("r")("o")("l")(command);@/
+pr9("p")("e")("n")("o")("f")("f")("s")("e")("t")(command);@/
+pr1("&")(ampersand);@/
+pr7("r")("o")("t")("a")("t")("e")("d")(binary);@/
+pr7("s")("l")("a")("n")("t")("e")("d")(binary);@/
+pr6("s")("c")("a")("l")("e")("d")(binary);@/
+pr7("s")("h")("i")("f")("t")("e")("d")(binary);@/
+pr11("t")("r")("a")("n")("s")("f")("o")("r")("m")("e")("d")(binary);@/
+pr7("x")("s")("c")("a")("l")("e")("d")(binary);@/
+pr7("y")("s")("c")("a")("l")("e")("d")(binary);@/
+pr7("z")("s")("c")("a")("l")("e")("d")(binary);@/
+pr17("i")("n")("t")("e")("r")("s")("e")("c")("t")("i")("o")("n")@|
+ ("t")("i")("m")("e")("s")(binary);@/
+pr7("n")("u")("m")("e")("r")("i")("c")(type_name);@/
+pr6("s")("t")("r")("i")("n")("g")(type_name);@/
+pr7("b")("o")("o")("l")("e")("a")("n")(type_name);@/
+pr4("p")("a")("t")("h")(type_name);@/
+pr3("p")("e")("n")(type_name);@/
+pr7("p")("i")("c")("t")("u")("r")("e")(type_name);@/
+pr9("t")("r")("a")("n")("s")("f")("o")("r")("m")(type_name);@/
+pr4("p")("a")("i")("r")(type_name);@/
+
+@ At last we are done with the tedious initialization of primitives.
+
+@<Store all the prim...@>=
+pr3("e")("n")("d")(endit);@/
+pr4("d")("u")("m")("p")(endit);@/
+pr9("b")("a")("t")("c")("h")("m")("o")("d")("e")(bold);
+pr11("n")("o")("n")("s")("t")("o")("p")("m")("o")("d")("e")(bold);
+pr10("s")("c")("r")("o")("l")("l")("m")("o")("d")("e")(bold);
+pr13("e")("r")("r")("o")("r")("s")("t")("o")("p")@|
+ ("m")("o")("d")("e")(bold);
+pr5("i")("n")("n")("e")("r")(command);@/
+pr5("o")("u")("t")("e")("r")(command);@/
+pr9("s")("h")("o")("w")("t")("o")("k")("e")("n")(command);@/
+pr9("s")("h")("o")("w")("s")("t")("a")("t")("s")(bold);@/
+pr4("s")("h")("o")("w")(command);@/
+pr12("s")("h")("o")("w")("v")("a")("r")("i")("a")("b")("l")("e")(command);@/
+pr16("s")("h")("o")("w")@|
+ ("d")("e")("p")("e")("n")("d")("e")("n")("c")("i")("e")("s")(bold);@/
+pr7("c")("o")("n")("t")("o")("u")("r")(command);@/
+pr10("d")("o")("u")("b")("l")("e")("p")("a")("t")("h")(command);@/
+pr4("a")("l")("s")("o")(command);@/
+pr7("w")("i")("t")("h")("p")("e")("n")(command);@/
+pr10("w")("i")("t")("h")("w")("e")("i")("g")("h")("t")(command);@/
+pr8("d")("r")("o")("p")("p")("i")("n")("g")(command);@/
+pr7("k")("e")("e")("p")("i")("n")("g")(command);@/
+pr7("m")("e")("s")("s")("a")("g")("e")(command);@/
+pr10("e")("r")("r")("m")("e")("s")("s")("a")("g")("e")(command);@/
+pr7("e")("r")("r")("h")("e")("l")("p")(command);@/
+pr8("c")("h")("a")("r")("l")("i")("s")("t")(command);@/
+pr8("l")("i")("g")("t")("a")("b")("l")("e")(command);@/
+pr10("e")("x")("t")("e")("n")("s")("i")("b")("l")("e")(command);@/
+pr10("h")("e")("a")("d")("e")("r")("b")("y")("t")("e")(command);@/
+pr9("f")("o")("n")("t")("d")("i")("m")("e")("n")(command);@/
+pr7("s")("p")("e")("c")("i")("a")("l")(command);@/
+pr10("n")("u")("m")("s")("p")("e")("c")("i")("a")("l")(command);@/
+pr1("%")(comment);@/
+pr2("%")("%")(verbatim);@/
+pr3("%")("%")("%")(set_format);@/
+pr4("%")("%")("%")("%")(mft_comment);@/
+pr1("#")(sharp);@/
+@y
+@ We begin with primitives common to \MF\ and \MP.
+
+The intended use of the macros above might not be immediately obvious,
+but the riddle is answered by the following:
+
+@<Store all the primitives@>=
+id_loc:=18;@/
+pr2(".")(".")(path_join);@/
+pr1("[")(as_is);@/
+pr1("]")(as_is);@/
+pr1("}")(as_is);@/
+pr1("{")(as_is);@/
+pr1(":")(colon);@/
+pr2(":")(":")(colon);@/
+pr3("|")("|")(":")(colon);@/
+pr2(":")("=")(as_is);@/
+pr1(",")(as_is);@/
+pr1(";")(semicolon);@/
+pr1("\")(backslash);@/
+pr2("\")("\")(double_back);@/
+pr5("a")("d")("d")("t")("o")(command);@/
+pr2("a")("t")(bbinary);@/
+pr7("a")("t")("l")("e")("a")("s")("t")(op);@/
+pr10("b")("e")("g")("i")("n")("g")("r")("o")("u")("p")(command);
+pr8("c")("o")("n")("t")("r")("o")("l")("s")(op);@/
+pr4("c")("u")("l")("l")(command);@/
+pr4("c")("u")("r")("l")(op);@/
+pr10("d")("e")("l")("i")("m")("i")("t")("e")("r")("s")(command);@/
+pr8("e")("n")("d")("g")("r")("o")("u")("p")(endit);@/
+pr8("e")("v")("e")("r")("y")("j")("o")("b")(command);@/
+pr6("e")("x")("i")("t")("i")("f")(command);@/
+pr11("e")("x")("p")("a")("n")("d")("a")("f")("t")("e")("r")(command);@/
+pr4("f")("r")("o")("m")(bbinary);@/
+pr7("i")("n")("t")("e")("r")("i")("m")(command);@/
+pr3("l")("e")("t")(command);@/
+pr11("n")("e")("w")("i")("n")("t")("e")("r")("n")("a")("l")(command);@/
+pr2("o")("f")(command);@/
+pr10("r")("a")("n")("d")("o")("m")("s")("e")("e")("d")(command);@/
+pr4("s")("a")("v")("e")(command);@/
+pr10("s")("c")("a")("n")("t")("o")("k")("e")("n")("s")(command);@/
+pr7("s")("h")("i")("p")("o")("u")("t")(command);@/
+pr4("s")("t")("e")("p")(bbinary);@/
+pr3("s")("t")("r")(command);@/
+pr7("t")("e")("n")("s")("i")("o")("n")(op);@/
+pr2("t")("o")(bbinary);@/
+pr5("u")("n")("t")("i")("l")(bbinary);@/
+pr3("d")("e")("f")(command);@/
+pr6("v")("a")("r")("d")("e")("f")(command);@/
+
+@ (There are so many primitives, it's necessary to break this long
+initialization code up into pieces so as not to overflow \.{WEAVE}'s capacity.)
+
+@<Store all the primitives@>=
+pr10("p")("r")("i")("m")("a")("r")("y")("d")("e")("f")(command);@/
+pr12("s")("e")("c")("o")("n")("d")("a")("r")("y")("d")("e")("f")(command);@/
+pr11("t")("e")("r")("t")("i")("a")("r")("y")("d")("e")("f")(command);@/
+pr6("e")("n")("d")("d")("e")("f")(endit);@/
+pr3("f")("o")("r")(command);@/
+pr11("f")("o")("r")("s")("u")("f")("f")("i")("x")("e")("s")(command);@/
+pr7("f")("o")("r")("e")("v")("e")("r")(command);@/
+pr6("e")("n")("d")("f")("o")("r")(endit);@/
+pr5("q")("u")("o")("t")("e")(command);@/
+pr4("e")("x")("p")("r")(command);@/
+pr6("s")("u")("f")("f")("i")("x")(command);@/
+pr4("t")("e")("x")("t")(command);@/
+pr7("p")("r")("i")("m")("a")("r")("y")(command);@/
+pr9("s")("e")("c")("o")("n")("d")("a")("r")("y")(command);@/
+pr8("t")("e")("r")("t")("i")("a")("r")("y")(command);@/
+pr5("i")("n")("p")("u")("t")(input_command);@/
+pr8("e")("n")("d")("i")("n")("p")("u")("t")(bold);@/
+pr2("i")("f")(command);@/
+pr2("f")("i")(endit);@/
+pr4("e")("l")("s")("e")(command);@/
+pr6("e")("l")("s")("e")("i")("f")(command);@/
+pr4("t")("r")("u")("e")(bold);@/
+pr5("f")("a")("l")("s")("e")(bold);@/
+pr11("n")("u")("l")("l")("p")("i")("c")("t")("u")("r")("e")(bold);@/
+pr7("n")("u")("l")("l")("p")("e")("n")(bold);@/
+pr7("j")("o")("b")("n")("a")("m")("e")(bold);@/
+pr10("r")("e")("a")("d")("s")("t")("r")("i")("n")("g")(bold);@/
+pr9("p")("e")("n")("c")("i")("r")("c")("l")("e")(bold);@/
+pr2("=")(":")(as_is);@/
+pr3("=")(":")("|")(as_is);@/
+pr4("=")(":")("|")(">")(as_is);@/
+pr3("|")("=")(":")(as_is);@/
+pr4("|")("=")(":")(">")(as_is);@/
+pr4("|")("=")(":")("|")(as_is);@/
+pr5("|")("=")(":")("|")(">")(as_is);@/
+pr6("|")("=")(":")("|")(">")(">")(as_is);@/
+pr4("k")("e")("r")("n")(binary);
+pr6("s")("k")("i")("p")("t")("o")(command);@/
+
+@ (Does anybody out there remember the commercials that went \.{LS-MFT}?)
+
+@<Store all the prim...@>=
+pr13("n")("o")("r")("m")("a")("l")("d")("e")("v")("i")("a")("t")("e")(op);@/
+pr3("o")("d")("d")(op);@/
+pr5("k")("n")("o")("w")("n")(op);@/
+pr7("u")("n")("k")("n")("o")("w")("n")(op);@/
+pr3("n")("o")("t")(op);@/
+pr7("d")("e")("c")("i")("m")("a")("l")(op);@/
+pr7("r")("e")("v")("e")("r")("s")("e")(op);@/
+pr8("m")("a")("k")("e")("p")("a")("t")("h")(op);@/
+pr7("m")("a")("k")("e")("p")("e")("n")(op);@/
+pr3("o")("c")("t")(op);@/
+pr3("h")("e")("x")(op);@/
+pr5("A")("S")("C")("I")("I")(op);@/
+pr4("c")("h")("a")("r")(op);@/
+pr6("l")("e")("n")("g")("t")("h")(op);@/
+pr13("t")("u")("r")("n")("i")("n")("g")("n")("u")("m")("b")("e")("r")(op);@/
+pr5("x")("p")("a")("r")("t")(op);@/
+pr5("y")("p")("a")("r")("t")(op);@/
+pr6("x")("x")("p")("a")("r")("t")(op);@/
+pr6("x")("y")("p")("a")("r")("t")(op);@/
+pr6("y")("x")("p")("a")("r")("t")(op);@/
+pr6("y")("y")("p")("a")("r")("t")(op);@/
+pr4("s")("q")("r")("t")(op);@/
+pr4("m")("e")("x")("p")(op);@/
+pr4("m")("l")("o")("g")(op);@/
+pr4("s")("i")("n")("d")(op);@/
+pr4("c")("o")("s")("d")(op);@/
+pr5("f")("l")("o")("o")("r")(op);@/
+pr14("u")("n")("i")("f")("o")("r")("m")("d")("e")("v")("i")("a")("t")("e")(op);
+ @/
+pr10("c")("h")("a")("r")("e")("x")("i")("s")("t")("s")(op);@/
+pr5("a")("n")("g")("l")("e")(op);@/
+pr5("c")("y")("c")("l")("e")(op);@/
+
+@ (If you think this \.{WEB} code is ugly, you should see the Pascal code
+it produces.)
+
+@<Store all the primitives@>=
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("t")("i")("t")("l")("e")("s")(internal);@/
+pr16("t")("r")("a")("c")("i")("n")("g")
+ ("e")("q")("u")("a")("t")("i")("o")("n")("s")(internal);@/
+pr15("t")("r")("a")("c")("i")("n")("g")
+ ("c")("a")("p")("s")("u")("l")("e")("s")(internal);@/
+pr14("t")("r")("a")("c")("i")("n")("g")
+ ("c")("h")("o")("i")("c")("e")("s")(internal);@/
+pr12("t")("r")("a")("c")("i")("n")("g")
+ ("s")("p")("e")("c")("s")(internal);@/
+pr11("t")("r")("a")("c")("i")("n")("g")
+ ("p")("e")("n")("s")(internal);@/
+pr15("t")("r")("a")("c")("i")("n")("g")
+ ("c")("o")("m")("m")("a")("n")("d")("s")(internal);@/
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("m")("a")("c")("r")("o")("s")(internal);@/
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("o")("u")("t")("p")("u")("t")(internal);@/
+pr12("t")("r")("a")("c")("i")("n")("g")
+ ("s")("t")("a")("t")("s")(internal);@/
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("o")("n")("l")("i")("n")("e")(internal);@/
+
+@ @<Store all the primitives@>=
+pr4("y")("e")("a")("r")(internal);@/
+pr5("m")("o")("n")("t")("h")(internal);@/
+pr3("d")("a")("y")(internal);@/
+pr4("t")("i")("m")("e")(internal);@/
+pr8("c")("h")("a")("r")("c")("o")("d")("e")(internal);@/
+pr6("c")("h")("a")("r")("w")("d")(internal);@/
+pr6("c")("h")("a")("r")("h")("t")(internal);@/
+pr6("c")("h")("a")("r")("d")("p")(internal);@/
+pr6("c")("h")("a")("r")("i")("c")(internal);@/
+pr6("c")("h")("a")("r")("d")("x")(internal);@/
+pr6("c")("h")("a")("r")("d")("y")(internal);@/
+pr10("d")("e")("s")("i")("g")("n")("s")("i")("z")("e")(internal);@/
+pr7("x")("o")("f")("f")("s")("e")("t")(internal);@/
+pr7("y")("o")("f")("f")("s")("e")("t")(internal);@/
+pr7("p")("a")("u")("s")("i")("n")("g")(internal);@/
+pr12("s")("h")("o")("w")
+ ("s")("t")("o")("p")("p")("i")("n")("g")(internal);@/
+pr10("f")("o")("n")("t")("m")("a")("k")("i")("n")("g")(internal);@/
+pr8("p")("r")("o")("o")("f")("i")("n")("g")(internal);@/
+pr12("t")("u")("r")("n")("i")("n")("g")("c")("h")("e")("c")("k")(internal);@/
+pr12("w")("a")("r")("n")("i")("n")("g")("c")("h")("e")("c")("k")(internal);@/
+pr12("b")("o")("u")("n")("d")("a")("r")("y")("c")("h")("a")("r")(internal);@/
+
+@ Still more.
+
+@<Store all the prim...@>=
+pr1("+")(abinary);@/
+pr1("-")(abinary);@/
+pr1("*")(abinary);@/
+pr1("/")(as_is);@/
+pr2("+")("+")(binary);@/
+pr3("+")("-")("+")(pyth_sub);@/
+pr3("a")("n")("d")(binary);@/
+pr2("o")("r")(binary);@/
+pr1("<")(as_is);@/
+pr2("<")("=")(less_or_equal);@/
+pr1(">")(as_is);@/
+pr2(">")("=")(greater_or_equal);@/
+pr1("=")(as_is);@/
+pr2("<")(">")(not_equal);@/
+pr9("s")("u")("b")("s")("t")("r")("i")("n")("g")(command);@/
+pr7("s")("u")("b")("p")("a")("t")("h")(command);@/
+pr13("d")("i")("r")("e")("c")("t")("i")("o")("n")@|
+ ("t")("i")("m")("e")(command);@/
+pr5("p")("o")("i")("n")("t")(command);@/
+pr10("p")("r")("e")("c")("o")("n")("t")("r")("o")("l")(command);@/
+pr11("p")("o")("s")("t")("c")("o")("n")("t")("r")("o")("l")(command);@/
+pr9("p")("e")("n")("o")("f")("f")("s")("e")("t")(command);@/
+pr1("&")(ampersand);@/
+pr7("r")("o")("t")("a")("t")("e")("d")(binary);@/
+pr7("s")("l")("a")("n")("t")("e")("d")(binary);@/
+pr6("s")("c")("a")("l")("e")("d")(binary);@/
+pr7("s")("h")("i")("f")("t")("e")("d")(binary);@/
+pr11("t")("r")("a")("n")("s")("f")("o")("r")("m")("e")("d")(binary);@/
+pr7("x")("s")("c")("a")("l")("e")("d")(binary);@/
+pr7("y")("s")("c")("a")("l")("e")("d")(binary);@/
+pr7("z")("s")("c")("a")("l")("e")("d")(binary);@/
+pr17("i")("n")("t")("e")("r")("s")("e")("c")("t")("i")("o")("n")@|
+ ("t")("i")("m")("e")("s")(binary);@/
+pr7("n")("u")("m")("e")("r")("i")("c")(type_name);@/
+pr6("s")("t")("r")("i")("n")("g")(type_name);@/
+pr7("b")("o")("o")("l")("e")("a")("n")(type_name);@/
+pr4("p")("a")("t")("h")(type_name);@/
+pr3("p")("e")("n")(type_name);@/
+pr7("p")("i")("c")("t")("u")("r")("e")(type_name);@/
+pr9("t")("r")("a")("n")("s")("f")("o")("r")("m")(type_name);@/
+pr4("p")("a")("i")("r")(type_name);@/
+
+@ At last we are done with the tedious initialization of primitives.
+
+@<Store all the prim...@>=
+pr3("e")("n")("d")(endit);@/
+pr4("d")("u")("m")("p")(endit);@/
+pr9("b")("a")("t")("c")("h")("m")("o")("d")("e")(bold);
+pr11("n")("o")("n")("s")("t")("o")("p")("m")("o")("d")("e")(bold);
+pr10("s")("c")("r")("o")("l")("l")("m")("o")("d")("e")(bold);
+pr13("e")("r")("r")("o")("r")("s")("t")("o")("p")@|
+ ("m")("o")("d")("e")(bold);
+pr5("i")("n")("n")("e")("r")(command);@/
+pr5("o")("u")("t")("e")("r")(command);@/
+pr9("s")("h")("o")("w")("t")("o")("k")("e")("n")(command);@/
+pr9("s")("h")("o")("w")("s")("t")("a")("t")("s")(bold);@/
+pr4("s")("h")("o")("w")(command);@/
+pr12("s")("h")("o")("w")("v")("a")("r")("i")("a")("b")("l")("e")(command);@/
+pr16("s")("h")("o")("w")@|
+ ("d")("e")("p")("e")("n")("d")("e")("n")("c")("i")("e")("s")(bold);@/
+pr7("c")("o")("n")("t")("o")("u")("r")(command);@/
+pr10("d")("o")("u")("b")("l")("e")("p")("a")("t")("h")(command);@/
+pr4("a")("l")("s")("o")(command);@/
+pr7("w")("i")("t")("h")("p")("e")("n")(command);@/
+pr7("m")("e")("s")("s")("a")("g")("e")(command);@/
+pr10("e")("r")("r")("m")("e")("s")("s")("a")("g")("e")(command);@/
+pr7("e")("r")("r")("h")("e")("l")("p")(command);@/
+pr8("c")("h")("a")("r")("l")("i")("s")("t")(command);@/
+pr8("l")("i")("g")("t")("a")("b")("l")("e")(command);@/
+pr10("e")("x")("t")("e")("n")("s")("i")("b")("l")("e")(command);@/
+pr10("h")("e")("a")("d")("e")("r")("b")("y")("t")("e")(command);@/
+pr9("f")("o")("n")("t")("d")("i")("m")("e")("n")(command);@/
+pr7("s")("p")("e")("c")("i")("a")("l")(command);@/
+pr1("%")(comment);@/
+pr2("%")("%")(verbatim);@/
+pr3("%")("%")("%")(set_format);@/
+pr4("%")("%")("%")("%")(mft_comment);@/
+pr1("#")(sharp);@/
+pr4("g")("o")("o")("d")(special_tag);@/
+
+@ Store primitives specific for \MF.
+
+@<Store all the prim...@>=
+if not metapost then begin
+ pr12("a")("u")("t")("o")("r")("o")("u")("n")("d")("i")("n")("g")(internal);@/
+ pr7("c")("h")("a")("r")("f")("a")("m")(internal);@/
+ pr8("d")("r")("o")("p")("p")("i")("n")("g")(command);@/
+ pr7("d")("i")("s")("p")("l")("a")("y")(command);@/
+ pr6("f")("i")("l")("l")("i")("n")(internal);@/
+ pr11("g")("r")("a")("n")("u")("l")("a")("r")("i")("t")("y")(internal);@/
+ pr8("i")("n")("w")("i")("n")("d")("o")("w")(bbinary);@/
+ pr4("h")("p")("p")("p")(internal);@/
+ pr7("k")("e")("e")("p")("i")("n")("g")(command);@/
+ pr10("n")("u")("m")("s")("p")("e")("c")("i")("a")("l")(command);@/
+ pr10("o")("p")("e")("n")("w")("i")("n")("d")("o")("w")(command);@/
+ pr9("s")("m")("o")("o")("t")("h")("i")("n")("g")(internal);@/
+ pr4("v")("p")("p")("p")(internal);@/
+ pr11("t")("o")("t")("a")("l")("w")("e")("i")("g")("h")("t")(op);@/
+ pr12("t")("r")("a")("c")("i")("n")("g")("e")("d")("g")("e")("s")(internal);@/
+ pr10("w")("i")("t")("h")("w")("e")("i")("g")("h")("t")(command);@/
+end;
+
+@ Store primitives specific for \MP.
+
+@<Store all the prim...@>=
+if metapost then begin
+ pr9("a")("r")("c")("l")("e")("n")("g")("t")("h")(op);@/
+ pr7("a")("r")("c")("t")("i")("m")("e")(command);@/
+ pr8("b")("l")("u")("e")("p")("a")("r")("t")(op);@/
+ pr7("b")("o")("u")("n")("d")("e")("d")(op);@/
+ pr4("b")("t")("e")("x")(btex_code);@/
+ pr4("c")("l")("i")("p")(command);@/
+ pr7("c")("l")("i")("p")("p")("e")("d")(op);@/
+ pr9("c")("l")("o")("s")("e")("f")("r")("o")("m")(input_command);@/
+ pr5("c")("o")("l")("o")("r")(type_name);@/
+ pr6("d")("a")("s")("h")("e")("d")(command);@/
+ pr8("d")("a")("s")("h")("p")("a")("r")("t")(op);@/
+ pr4("e")("t")("e")("x")(etex_marker);@/
+ pr6("f")("i")("l")("l")("e")("d")(op);@/
+ pr8("f")("o")("n")("t")("p")("a")("r")("t")(op);@/
+ pr8("f")("o")("n")("t")("s")("i")("z")("e")(op);@/
+ pr9("g")("r")("e")("e")("n")("p")("a")("r")("t")(op);@/
+ pr6("i")("n")("f")("o")("n")("t")(binary);@/
+ pr8("l")("i")("n")("e")("j")("o")("i")("n")(internal);@/
+ pr7("l")("i")("n")("e")("c")("a")("p")(internal);@/
+ pr8("l")("l")("c")("o")("r")("n")("e")("r")(op);@/
+ pr8("l")("r")("c")("o")("r")("n")("e")("r")(op);@/
+ pr10("m")("i")("t")("e")("r")("l")("i")("m")("i")("t")(internal);@/
+ pr8("m")("p")("x")("b")("r")("e")("a")("k")(bold);@/
+ pr8("p")("a")("t")("h")("p")("a")("r")("t")(op);@/
+ pr7("p")("e")("n")("p")("a")("r")("t")(op);@/
+ pr9("p")("r")("o")("l")("o")("g")("u")("e")("s")(internal);@/
+ pr7("r")("e")("d")("p")("a")("r")("t")(op);@/
+ pr8("r")("e")("a")("d")("f")("r")("o")("m")(input_command);@/
+ pr9("s")("e")("t")("b")("o")("u")("n")("d")("s")(command);@/
+ pr7("s")("t")("r")("o")("k")("e")("d")(op);@/
+ pr8("t")("e")("x")("t")("p")("a")("r")("t")(op);@/
+ pr7("t")("e")("x")("t")("u")("a")("l")(op);@/
+ pr16("t")("r")("a")("c")("i")("n")("g")
+ ("l")("o")("s")("t")("c")("h")("a")("r")("s")(internal);@/
+ pr11("t")("r")("u")("e")("c")("o")("r")("n")("e")("r")("s")(internal);@/
+ pr8("u")("l")("c")("o")("r")("n")("e")("r")(op);@/
+ pr8("u")("r")("c")("o")("r")("n")("e")("r")(op);@/
+ pr11("v")("e")("r")("b")("a")("t")("i")("m")("t")("e")("x")(verbatim_code);@/
+ pr6("w")("i")("t")("h")("i")("n")(bbinary);@/
+ pr9("w")("i")("t")("h")("c")("o")("l")("o")("r")(command);@/
+ pr5("w")("r")("i")("t")("e")(command);@/
+end;
+@z
+
+% The code below follows ideas from the section 646 of `mp.web'.
+@x [75]
+two global variables, |cur_type| and |cur_tok|.
+@y
+two global variables, |cur_type| and |cur_tok|.
+
+The \&{btex}$\,\ldots\,$\&{etex} and \&{verbatimtex}$\,\ldots\,$\&{etex}
+features need to be implemented at a low level in the scanning
+process. This is implemented by changing the behavior of the
+scanner via |scanner_status| global variable.
+
+@d normal=0 {|scanner_status| at ``quiet times''}
+@d verbatimtex_flushing=1 {|scanner_status| when moving verbatim \TeX\ material}
+@d btex_flushing=2 {|scanner_status| when moving \TeX\ code}
+@z
+
+@x [75]
+@!prev_tok:integer; {previous value of |cur_tok|}
+@y
+@!prev_tok:integer; {previous value of |cur_tok|}
+@!scanner_status:normal..btex_flushing; {are we scanning at high speed?}
+@z
+
+@x [79] Allow any 8 bit character in input.
+for i:=0 to " "-1 do char_class[i]:=invalid_class;
+char_class[carriage_return]:=end_line_class;@/
+for i:=127 to 255 do char_class[i]:=invalid_class;
+@y
+for i:=0 to " "-1 do char_class[i]:=letter_class;
+for i:=127 to 255 do char_class[i]:=letter_class;
+char_class[carriage_return]:=end_line_class;
+char_class[@'11]:=space_class; {tab}
+char_class[@'14]:=space_class; {form feed}
+@z
+
+% When dealing with a TeX material we must copy spaces to output.
+@x [81]
+space_class:if start_of_line then emit(indentation)
+ else goto switch;
+@y
+space_class:if start_of_line or scanner_status>normal then emit(indentation)
+ else goto switch;
+@z
+
+% Set the default set of macros for \MP.
+@x [88]
+so that the first line of the output file will be `\.{\\input mftmac}'.
+@.\\input mftmac@>
+@.mftmac@>
+
+@<Set init...@>=
+out_ptr:=1; out_buf[1]:=" "; out_line:=1; write(tex_file,'\input mftmac');
+@y
+so that the first line of the output file will be `\.{\\input mftmac}'
+or `\.{\\input mptmac}' if a \MP\ file is converted.
+@.\\input mftmac@>
+@.mftmac@>
+@.\\input mptmac@>
+@.mptmac@>
+@<Set init...@>=
+out_ptr:=1; out_buf[1]:=" "; out_line:=1;
+if metapost then begin write(tex_file,'\input mptmac'); end
+else write(tex_file,'\input mftmac');
+@z
+
+@x [97]
+ string_token:@<Translate a string token@>;
+@y
+ string_token:@<Translate a string token@>;
+ verbatim_code,btex_code:@<Copy \TeX\ material@>;
+@z
+
+% Here an extra section is added.
+%
+% `btex' token is translated to `\mftbeginB' and
+% `verbatimtex' to `\mftbeginV'.
+% `etex' is translated to `\mftend'.
+% These \TeX\ macros are defined in \.{mptmac.tex}.
+@x [98]
+@ @<Do special actions at the start of a line@>=
+@y
+@ @<Copy \TeX\ material@>=
+ begin out4("\")("m")("f")("t"); out5("b")("e")("g")("i")("n");
+ if cur_type=verbatim_code then begin
+ out("V");
+ scanner_status:=verbatimtex_flushing;
+ end else if cur_type=btex_code then begin
+ out("B");
+ scanner_status:=btex_flushing;
+ end;
+ out("{"); out_name(cur_tok); out("}");
+ get_next;
+ while cur_type<>etex_marker do begin
+ if cur_type=indentation then begin out(" "); end
+ else if cur_type=end_of_line then begin
+ flush_buffer(out_ptr,false);
+ empty_buffer:=true;
+ end
+ else copy(id_first);
+ get_next;
+ end;
+ out4("\")("m")("f")("t"); out3("e")("n")("d");
+ out("{"); out_name(cur_tok); out("}");
+ if scanner_status=verbatimtex_flushing then out("$");
+ scanner_status:=normal;
+ end
+@ @<Do special actions at the start of a line@>=
+@z
+
+% [112] Print newline at end of run, exit based upon value of history,
+% and remove the end_of_MFT label.
+@x
+print_ln(banner); {print a ``banner line''}
+@y
+print (banner); {print a ``banner line''}
+print_ln (version_string);
+@z
+
+@x
+end_of_MFT:{here files should be closed if the operating system requires it}
+@<Print the job |history|@>;
+end.
+@y
+@<Print the job |history|@>;
+new_line;
+if (history <> spotless) and (history <> harmless_message)
+then uexit (1)
+else uexit (0);
+end.
+@z
+
+@x [114] System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{MFT} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+@y
+The user calls \.{MFT} with arguments on the command line. These are
+either filenames or flags (beginning with `\.-'). The following globals
+are for communicating the user's desires to the rest of the program. The
+various |name| variables contain strings with the full names of those
+files, as UNIX knows them.
+
+@d max_style_name = 32
+
+@<Globals...@>=
+@!change_name,@!tex_name:c_string;
+@!style_name:array[0..max_style_name-1] of c_string;
+@!n_style_name:c_int_type; {Number of values in |style_name| array.}
+@!i_style_name:c_int_type; {The next |style_name|.}
+@!metapost:c_int_type; {|true| for \MF, |false| for \MP}
+
+@ Look at the command line arguments and set the |name| variables accordingly.
+
+At least one file name must be present as the first argument: the \.{mf}
+file. It may have an extension, or it may omit it to get |'.mf'| added.
+If there is only one file name, the output file name is formed by
+replacing the \.{mf} file name extension by |'.tex'|. Thus, the command
+line \.{mf foo} implies the use of the \MF\ input file \.{foo.mf}
+and the output file \.{foo.tex}. If this style of command line, with
+only one argument, is used, the default style file, |plain.mft|, will be
+used to provide basic formatting.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 5; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+ @!suffix: c_string;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ n_style_name := 0;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('mft');
+
+ end else if argument_is ('help') then begin
+ usage_help (MFT_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.E. Knuth (MP changes by W. Bzyl)');
+
+ end else if argument_is ('change') then begin
+ change_name := extend_filename (optarg, 'ch');
+
+ end else if argument_is ('style') then begin
+ if (n_style_name = max_style_name) then begin
+ fatal_error ('Too many style files specified.');
+ usage ('mft');
+ end;
+ style_name[n_style_name] := extend_filename (optarg, 'mft');
+ n_style_name := n_style_name + 1;
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have exactly one remaining argument.}
+ if (optind + 1 <> argc) then begin
+ write_ln (stderr, 'mft: Need exactly one file argument.');
+ usage ('mft');
+ end;
+
+ suffix := find_suffix (cmdline (optind));
+ if suffix and (strcmp (suffix, 'mp') = 0) then begin
+ metapost := true;
+ tex_name := basename_change_suffix (cmdline (optind), '.mp', '.tex');
+ end else begin
+ tex_name := basename_change_suffix (cmdline (optind), '.mf', '.tex');
+ end;
+
+ if (n_style_name = 0) then begin
+ if metapost then
+ style_name[0] := 'mplain.mft'
+ else
+ style_name[0] := 'plain.mft';
+ n_style_name := 1;
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Here is the option to set a change file.
+@.-change@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'change';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Here is the option to set the style file.
+@.-style@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'style';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ The option to set a \MP\ file processing.
+
+@<Define the option...@> =
+long_options[current_option].name := 'metapost';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (metapost);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@ |metapost| defaults to false
+
+@<Initialize the option...@> =
+metapost:=false;
+
+@ An element with all zeros always ends the list of options.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/mft.rc b/Build/source/texk/web2c/mft.rc
new file mode 100644
index 00000000000..907e249c3c3
--- /dev/null
+++ b/Build/source/texk/web2c/mft.rc
@@ -0,0 +1,32 @@
+/* mft.rc: mft resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " MFT version 2.0"
+
+#define VER_INTERNALNAME_STR "MFT"
+#define VER_ORIGINALFILENAME_STR "mft.exe"
+
+#define VER_FILEDESCRIPTION_STR "Converts MF files To TeX Files"
+
+#include <texlive.version>
+
+/* mft.rc ends here */
diff --git a/Build/source/texk/web2c/mft.web b/Build/source/texk/web2c/mft.web
new file mode 100644
index 00000000000..18a949b1e95
--- /dev/null
+++ b/Build/source/texk/web2c/mft.web
@@ -0,0 +1,1980 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0.0 was more-or-less debugged on June 4, 1985.
+% Version 0.1 improved formatting of : and added \\ (June 15, 1985).
+% Version 0.2 improved formatting of good, fixed @@ bug (August 4, 1985).
+% Version 0.3 fixed minor bug in change_file move (August 30, 1985).
+% Version 0.4 fixed minor bug regarding empty comments (April 8, 1989).
+% Version 1.0 was tuned up for the METAFONTware report (April 16, 1989).
+% Version 1.1 ditto, with input handled by Hosek's idea (April 27, 1989).
+% Version 2 has the new primitives of METAFONT 2.0 (October 16, 1989).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=manfnt % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\pb{$\.|\ldots\.|$} % MF brackets (|...|)
+\def\v{\.{\char'174}} % vertical (|) in typewriter font
+\def\dleft{[\![} \def\dright{]\!]} % double brackets
+\mathchardef\RA="3221 % right arrow
+\mathchardef\BA="3224 % double arrow
+\def\({} % kludge for alphabetizing certain module names
+\chardef\V=`\| % vertical line in a string
+
+\def\title{MFT}
+\def\contentspagenumber{401}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont MFT} processor}
+ \vskip 15pt
+ \centerline{(Version 2.0, October 1989)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926, MCS-8300984, and
+ CCR-8610181,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.
+ `{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley
+ Publishing Company.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program converts a \MF\ source file to a \TeX\ file. It was written
+by D.~E. Knuth in June, 1985; a somewhat similar {\mc SAIL} program had
+@^Knuth, Donald Ervin@>
+been developed in January, 1980.
+
+The general idea is to input a file called, say, \.{foo.mf} and to produce an
+output file called, say, \.{foo.tex}. The latter file, when processed by \TeX,
+will yield a ``prettyprinted'' representation of the input file.
+@^user manual@>
+
+Line breaks in the input are carried over into the output; moreover,
+blank spaces at the beginning of a line are converted to quads of indentation
+in the output. Thus, the user has full control over the indentation and line
+breaks. Each line of input is translated independently of the others.
+
+A slight change to \MF's comment convention allows further control.
+Namely, `\.{\%\%}' indicates that the remainder of an input line should be
+copied verbatim to the output; this interrupts the translation and forces
+\.{MFT} to produce a certain result.
+
+Furthermore, `\.{\%\%\%} $\langle\,$token$_1\,\rangle\ldots
+\langle\,$token$_n\,\rangle$'
+introduces a change in \.{MFT}'s formatting rules; all tokens after the first
+will henceforth be translated according to the current conventions for
+$\langle\,$token$_1\,\rangle$. The tokens must be symbolic (i.e., not
+numeric or string tokens). For example, the input line
+$$\.{\%\%\% addto fill draw filldraw}$$
+says that the `\.{fill}', `\.{draw}', and `\.{filldraw}' operations of
+plain \MF\ should be formatted as the primitive token `\.{addto}', i.e.,
+in boldface type. (Without such reformatting commands, \.{MFT} would treat
+`\.{fill}' like an ordinary tag or variable name. In fact, you need
+a reformatting command even to get parentheses to act like delimiters!)
+
+\MF\ comments, which follow a single \.\% sign, should be valid \TeX\
+input. But \MF\ material can be included in \pb\ within a comment; this
+will be translated by \.{MFT} as if it were not in a comment. For example,
+a phrase like `\.{make} \.{\V x2r\V} \.{zero}' will be translated into
+`\.{make \$x\_\{2r\}\$ zero}'.
+
+The rules just stated apply to lines that contain one, two, or three \.\% signs
+in a row. Comments to \.{MFT} can follow `\.{\%\%\%\%}'.
+Five or more \.\% signs should not be used.
+
+Beside the normal input file, \.{MFT} also looks for a change file
+(e.g., `\.{foo.ch}'), which allows substitutions to be made in the
+translation. The change file follows the conventions of \.{WEB}, and
+it should be null if there are no changes. (Changes usually contain
+verbatim instructions to compensate for the fact that \.{MFT} cannot
+format everything in an optimum way.)
+
+There's also a third input file (e.g., `\.{plain.mft}'), which is
+input before the other two. This file normally contains the `\.{\%\%\%}'
+formatting commands that are necessary to tune \.{MFT} to a particular
+style of \MF\ code, so it is called the style file.
+
+The output of \.{MFT} should be accompanied by the macros in a small
+package called \.{mftmac.tex}.
+@.mftmac@>
+
+Caveat: This program is not as ``bulletproof'' as the other routines
+produced by Stanford's \TeX\ project. It takes care of a great deal of
+tedious formatting, but it can produce strange output, because \MF\ is
+an extremely general language. Users should proofread their output carefully.
+
+@ \.{MFT} uses a few features of the local \PASCAL\ compiler that may
+need to be changed in other installations:
+
+\yskip\item{1)} Case statements have a default.
+\item{2)} Input-output routines may need to be adapted for use with a particular
+character set and/or for printing messages on the user's terminal.
+
+\yskip\noindent
+These features are also present in the \PASCAL\ version of \TeX, where they
+are used in a similar (but more complex) way. System-dependent portions
+of \.{MFT} can be identified by looking at the entries for `system
+dependencies' in the index below.
+@!@^system dependencies@>
+
+The ``banner line'' defined here should be changed whenever \.{MFT}
+is modified.
+
+@d banner=='This is MFT, Version 2.0'
+
+@ The program begins with a fairly normal header, made up of pieces that
+@^system dependencies@>
+will mostly be filled in later. The \.{MF} input comes from files |mf_file|,
+|change_file|, and |style_file|; the \TeX\ output goes to file |tex_file|.
+
+If it is necessary to abort the job because of a fatal error, the program
+calls the `|jump_out|' procedure, which goes to the label |end_of_MFT|.
+
+@d end_of_MFT = 9999 {go here to wrap it up}
+
+@p @t\4@>@<Compiler directives@>@/
+program MFT(@!mf_file,@!change_file,@!style_file,@!tex_file);
+label end_of_MFT; {go here to finish}
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values@>@/
+ end;
+
+@ The \PASCAL\ compiler used to develop this system has ``compiler
+directives'' that can appear in comments whose first character is a dollar sign.
+In our case these directives tell the compiler to detect
+@^system dependencies@>
+things that are out of range.
+
+@<Compiler directives@>=
+@{@&$C+,A+,D-@} {range check, catch arithmetic overflow, no debug overhead}
+
+@ Labels are given symbolic names by the following definitions. We insert
+the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
+procedure in which we have used the `|return|' statement defined below;
+the label `|restart|' is occasionally used at the very beginning of a
+procedure; and the label `|reswitch|' is occasionally used just prior to
+a \&{case} statement in which some cases change the conditions and we wish to
+branch to the newly applicable case.
+Loops that are set up with the \&{loop} construction defined below are
+commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
+and they are sometimes repeated by going to `|continue|'.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=31 {go here when you've found it}
+@d not_found=32 {go here when you've found something else}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@f loop == xclause
+
+@ We assume that |case| statements may include a default case that applies
+if no matching label is found. Thus, we shall use constructions like
+@^system dependencies@>
+$$\vbox{\halign{#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the compiler
+used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
+and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
+`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
+and |endcases| should be changed to agree with local conventions.
+(Of course, if no default mechanism is available, the |case| statements of
+this program must be extended by listing all remaining cases.)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters are set big enough to handle the Computer
+Modern fonts, so they should be sufficient for most applications of \.{MFT}.
+
+@<Constants...@>=
+@!max_bytes=10000; {the number of bytes in tokens; must be less than 65536}
+@!max_names=1000; {number of tokens}
+@!hash_size=353; {should be prime}
+@!buf_size=100; {maximum length of input line}
+@!line_length=80; {lines of \TeX\ output have at most this many characters,
+ should be less than 256}
+
+@ A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d harmless_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+@#
+@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
+@d mark_error==history:=error_message
+@d mark_fatal==history:=fatal_message
+
+@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
+
+@ @<Set init...@>=history:=spotless;
+
+@* The character set.
+\.{MFT} works internally with ASCII codes, like all other programs
+associated with \TeX\ and \MF. The present section has been lifted
+almost verbatim from the \MF\ program.
+@^ASCII code@>
+
+@ Characters of text that have been converted to \MF's internal form
+are said to be of type |ASCII_code|, which is a subrange of the integers.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, especially in a program for font design;
+so the present specification of \.{MFT} has been written under the assumption
+that the \PASCAL\ compiler and run-time system permit the use of text files
+with more than 64 distinguishable characters. More precisely, we assume that
+the character set contains at least the letters and symbols associated
+with ASCII codes @'40 through @'176. If additional characters are present,
+\.{MFT} can be configured to work with them too.
+
+Since we are dealing with more characters than were present in the first
+\PASCAL\ compilers, we have to decide what to call the associated data
+type. Some \PASCAL s use the original name |char| for the
+characters in text files, even though there now are more than 64 such
+characters, while other \PASCAL s consider |char| to be a 64-element
+subrange of a larger data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters that are converted to and
+from |ASCII_code| when they are input and output. We shall also assume
+that |text_char| consists of the elements |chr(first_text_char)| through
+|chr(last_text_char)|, inclusive. The following definitions should be
+adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ @<Local variables for init...@>=
+@!i:0..255;
+
+@ The \.{MFT} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Glob...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ Since we are assuming that our \PASCAL\ system is able to read and write the
+visible characters of standard ASCII (although not necessarily using the
+ASCII codes to represent them), the following assignment statements initialize
+most of the |xchr| array properly, without needing any system-dependent
+changes. On the other hand, it is possible to implement \.{MFT} with
+less complete character sets, and in such cases it will be necessary to
+change something here.
+@^system dependencies@>
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+
+@ The ASCII code is ``standard'' only to a certain extent, since many
+computer installations have found it advantageous to have ready access
+to more than 94 printing characters. If \.{MFT} is being used
+on a garden-variety \PASCAL\ for which only standard ASCII
+codes will appear in the input and output files, it doesn't really matter
+what codes are specified in |xchr[0..@'37]|, but the safest policy is to
+blank everything out by using the code shown below.
+
+However, other settings of |xchr| will make \.{MFT} more friendly on
+computers that have an extended character set, so that users can type things
+like `\.^^Z' instead of `\.{<>}', and so that \.{MFT} can echo the
+page breaks found in its input. People with extended character sets can
+assign codes arbitrarily, giving an |xchr| equivalent to whatever
+characters the users of \.{MFT} are allowed to have in their input files.
+Appropriate changes to \.{MFT}'s |char_class| table should then be made.
+(Unlike \TeX, each installation of \MF\ has a fixed assignment of category
+codes, called the |char_class|.) Such changes make portability of programs
+more difficult, so they should be introduced cautiously if at all.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
+where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
+|j| or more; hence, standard ASCII code numbers will be used instead of
+codes below @'40 in case there is a coincidence.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'177;
+for i:=@'200 to @'377 do xord[xchr[i]]:=i;
+for i:=1 to @'176 do xord[xchr[i]]:=i;
+
+@* Input and output.
+The I/O conventions of this program are essentially identical to those
+of \.{WEAVE}. Therefore people who need to make modifications should be
+able to do so without too many headaches.
+
+@ Terminal output is done by writing on file |term_out|, which is assumed to
+consist of characters of type |text_char|:
+@^system dependencies@>
+
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
+@d new_line==write_ln(term_out) {start new line on the terminal}
+@d print_nl(#)== {print information starting on a new line}
+ begin new_line; print(#);
+ end
+
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{WEAVE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+
+@ The |update_terminal| procedure is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ The main input comes from |mf_file|; this input may be overridden
+by changes in |change_file|. (If |change_file| is empty, there are no changes.)
+Furthermore the |style_file| is input first; it is unchangeable.
+
+@<Globals...@>=
+@!mf_file:text_file; {primary input}
+@!change_file:text_file; {updates}
+@!style_file:text_file; {formatting bootstrap}
+
+@ The following code opens the input files. Since these files were listed
+in the program header, we assume that the \PASCAL\ runtime system has
+already checked that suitable file names have been given; therefore no
+additional error checking needs to be done.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read the inputs}
+begin reset(mf_file); reset(change_file); reset(style_file);
+end;
+
+@ The main output goes to |tex_file|.
+
+@<Globals...@>=
+@!tex_file: text_file;
+
+@ The following code opens |tex_file|.
+Since this file was listed in the program header, we assume that the
+\PASCAL\ runtime system has checked that a suitable external file name has
+been given.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(tex_file);
+
+@ Input goes into an array called |buffer|.
+
+@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code;
+
+@ The |input_ln| procedure brings the next line of input from the specified
+file into the |buffer| array and returns the value |true|, unless the file has
+already been entirely read, in which case it returns |false|. The conventions
+of \TeX\ are followed; i.e., |ASCII_code| numbers representing the next line
+of the file are input into |buffer[0]|, |buffer[1]|, \dots,
+|buffer[limit-1]|; trailing blanks are ignored;
+and the global variable |limit| is set to the length of the
+@^system dependencies@>
+line. The value of |limit| must be strictly less than |buf_size|.
+
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ if final_limit>limit then final_limit:=limit;
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+
+@* Reporting errors to the user.
+The command `|err_print('! Error message')|' will report a syntax error to
+the user, by printing the error message at the beginning of a new line and
+then giving an indication of where the error was spotted in the source file.
+Note that no period follows the error message, since the error routine
+will automatically supply a period.
+
+The actual error indications are provided by a procedure called |error|.
+
+@d err_print(#)==
+ begin new_line; print(#); error;
+ end
+
+@<Error handling...@>=
+procedure error; {prints `\..' and location of error message}
+var@!k,@!l: 0..buf_size; {indices into |buffer|}
+begin @<Print error location based on input buffer@>;
+update_terminal; mark_error;
+end;
+
+@ The error locations can be indicated by using the global variables
+|loc|, |line|, |styling|, and |changing|, which tell respectively the first
+unlooked-at position in |buffer|, the current line number, and whether or not
+the current line is from |style_file| or |change_file| or |mf_file|.
+This routine should be modified on systems whose standard text editor
+has special line-numbering conventions.
+@^system dependencies@>
+
+@<Print error location based on input buffer@>=
+begin if styling then print('. (style file ')
+else if changing then print('. (change file ')@+else print('. (');
+print_ln('l.', line:1, ')');
+if loc>=limit then l:=limit else l:=loc;
+for k:=1 to l do
+ print(xchr[buffer[k-1]]); {print the characters already read}
+new_line;
+for k:=1 to l do print(' '); {space out the next line}
+for k:=l+1 to limit do print(xchr[buffer[k-1]]); {print the part not yet read}
+end
+
+@ The |jump_out| procedure just cuts across all active procedure levels
+and jumps out of the program. This is the only non-local \&{goto} statement
+in \.{MFT}. It is used when no recovery from a particular error has
+been provided.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the code that appears at label |end_of_MFT| should be
+copied into the |jump_out| procedure, followed by a call to a system procedure
+that terminates the program.
+
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_MFT;
+end;
+
+@ Sometimes the program's behavior is far different from what it should be,
+and \.{MFT} prints an error message that is really for the \.{MFT}
+maintenance person, not the user. In such cases the program says
+|confusion('indication of where we are')|.
+
+@d confusion(#)==fatal_error('! This can''t happen (',#,')')
+@.This can't happen@>
+
+@ An overflow stop occurs if \.{MFT}'s tables aren't large enough.
+
+@d overflow(#)==fatal_error('! Sorry, ',#,' capacity exceeded')
+@.Sorry, x capacity exceeded@>
+
+@* Inserting the changes.
+Let's turn now to the low-level routine |get_line|
+that takes care of merging |change_file| into |mf_file|. The |get_line|
+procedure also updates the line numbers for error messages.
+(This routine was copied from \.{WEAVE}, but updated to include |styling|.)
+
+@<Globals...@>=
+@!line:integer; {the number of the current line in the current file}
+@!other_line:integer; {the number of the current line in the input file that
+ is not currently being read}
+@!temp_line:integer; {used when interchanging |line| with |other_line|}
+@!limit:0..buf_size; {the last character position occupied in the buffer}
+@!loc:0..buf_size; {the next character position to be read from the buffer}
+@!input_has_ended: boolean; {if |true|, there is no more input}
+@!changing: boolean; {if |true|, the current line is from |change_file|}
+@!styling: boolean; {if |true|, the current line is from |style_file|}
+
+@ As we change |changing| from |true| to |false| and back again, we must
+remember to swap the values of |line| and |other_line| so that the |err_print|
+routine will be sure to report the correct line number.
+
+@d change_changing==
+ changing := not changing;
+ temp_line:=other_line; other_line:=line; line:=temp_line
+ {|line @t$\null\BA\null$@> other_line|}
+
+@ When |changing| is |false|, the next line of |change_file| is kept in
+|change_buffer[0..change_limit]|, for purposes of comparison with the next
+line of |mf_file|. After the change file has been completely input, we
+set |change_limit:=0|, so that no further matches will be made.
+
+@<Globals...@>=
+@!change_buffer:array[0..buf_size] of ASCII_code;
+@!change_limit:0..buf_size; {the last position occupied in |change_buffer|}
+
+@ Here's a simple function that checks if the two buffers are different.
+
+@p function lines_dont_match:boolean;
+label exit;
+var k:0..buf_size; {index into the buffers}
+begin lines_dont_match:=true;
+if change_limit<>limit then return;
+if limit>0 then
+ for k:=0 to limit-1 do if change_buffer[k]<>buffer[k] then return;
+lines_dont_match:=false;
+exit: end;
+
+@ Procedure |prime_the_change_buffer| sets |change_buffer| in preparation
+for the next matching operation. Since blank lines in the change file are
+not used for matching, we have |(change_limit=0)and not changing| if and
+only if the change file is exhausted. This procedure is called only
+when |changing| is true; hence error messages will be reported correctly.
+
+@p procedure prime_the_change_buffer;
+label continue, done, exit;
+var k:0..buf_size; {index into the buffers}
+begin change_limit:=0; {this value will be used if the change file ends}
+@<Skip over comment lines in the change file; |return| if end of file@>;
+@<Skip to the next nonblank line; |return| if end of file@>;
+@<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>;
+exit: end;
+
+@ While looking for a line that begins with \.{@@x} in the change file,
+we allow lines that begin with \.{@@}, as long as they don't begin with
+\.{@@y} or \.{@@z} (which would probably indicate that the change file is
+fouled up).
+
+@<Skip over comment lines in the change file...@>=
+loop@+ begin incr(line);
+ if not input_ln(change_file) then return;
+ if limit<2 then goto continue;
+ if buffer[0]<>"@@" then goto continue;
+ if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if buffer[1]="x" then goto done;
+ if (buffer[1]="y")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@x?');
+@.Where is the match...@>
+ end;
+continue: end;
+done:
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+repeat incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended after @@x');
+@.Change file ended...@>
+ return;
+ end;
+until limit>0;
+
+@ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>=
+begin change_limit:=limit;
+if limit>0 then for k:=0 to limit-1 do change_buffer[k]:=buffer[k];
+end
+
+@ The following procedure is used to see if the next change entry should
+go into effect; it is called only when |changing| is false.
+The idea is to test whether or not the current
+contents of |buffer| matches the current contents of |change_buffer|.
+If not, there's nothing more to do; but if so, a change is called for:
+All of the text down to the \.{@@y} is supposed to match. An error
+message is issued if any discrepancy is found. Then the procedure
+prepares to read the next line from |change_file|.
+
+@p procedure check_change; {switches to |change_file| if the buffers match}
+label exit;
+var n:integer; {the number of discrepancies found}
+@!k:0..buf_size; {index into the buffers}
+begin if lines_dont_match then return;
+n:=0;
+loop@+ begin change_changing; {now it's |true|}
+ incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended before @@y');
+@.Change file ended...@>
+ change_limit:=0; change_changing; {|false| again}
+ return;
+ end;
+ @<If the current line starts with \.{@@y},
+ report any discrepancies and |return|@>;
+ @<Move |buffer| and |limit|...@>;
+ change_changing; {now it's |false|}
+ incr(line);
+ if not input_ln(mf_file) then
+ begin err_print('! MF file ended during a change');
+@.MF file ended...@>
+ input_has_ended:=true; return;
+ end;
+ if lines_dont_match then incr(n);
+ end;
+exit: end;
+
+@ @<If the current line starts with \.{@@y}...@>=
+if limit>1 then if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@y?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="y" then
+ begin if n>0 then
+ begin loc:=2; err_print('! Hmm... ',n:1,
+ ' of the preceding lines failed to match');
+@.Hmm... n of the preceding...@>
+ end;
+ return;
+ end;
+ end
+
+@ Here's what we do to get the input rolling.
+
+@<Initialize the input system@>=
+begin open_input; line:=0; other_line:=0;@/
+changing:=true; prime_the_change_buffer; change_changing;@/
+styling:=true; limit:=0; loc:=1; buffer[0]:=" "; input_has_ended:=false;
+end
+
+@ The |get_line| procedure is called when |loc>limit|; it puts the next
+line of merged input into the buffer and updates the other variables
+appropriately.
+
+@p procedure get_line; {inputs the next line}
+label restart;
+begin restart: if styling then
+ @<Read from |style_file| and maybe turn off |styling|@>;
+if not styling then
+ begin if changing then
+ @<Read from |change_file| and maybe turn off |changing|@>;
+ if not changing then
+ begin @<Read from |mf_file| and maybe turn on |changing|@>;
+ if changing then goto restart;
+ end;
+ end;
+end;
+
+@ @<Read from |mf_file|...@>=
+begin incr(line);
+if not input_ln(mf_file) then input_has_ended:=true
+else if limit=change_limit then
+ if buffer[0]=change_buffer[0] then
+ if change_limit>0 then check_change;
+end
+
+@ @<Read from |style_file|...@>=
+begin incr(line);
+if not input_ln(style_file) then
+ begin styling:=false; line:=0;
+ end;
+end
+
+@ @<Read from |change_file|...@>=
+begin incr(line);
+if not input_ln(change_file) then
+ begin err_print('! Change file ended without @@z');
+@.Change file ended...@>
+ buffer[0]:="@@"; buffer[1]:="z"; limit:=2;
+ end;
+if limit>1 then {check if the change has ended}
+ if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="y") then
+ begin loc:=2; err_print('! Where is the matching @@z?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="z" then
+ begin prime_the_change_buffer; change_changing;
+ end;
+ end;
+end
+
+@ At the end of the program, we will tell the user if the change file
+had a line that didn't match any relevant line in |mf_file|.
+
+@<Check that all changes have been read@>=
+if change_limit<>0 then {|changing| is false}
+ begin for loc:=0 to change_limit do buffer[loc]:=change_buffer[loc];
+ limit:=change_limit; changing:=true; line:=other_line; loc:=change_limit;
+ err_print('! Change file entry did not match');
+@.Change file entry did not match@>
+ end
+
+@* Data structures.
+\.{MFT} puts token names
+into the large |byte_mem| array, which is packed with eight-bit integers.
+Allocation is sequential, since names are never deleted.
+
+An auxiliary array |byte_start| is used as a directory for |byte_mem|;
+the |link| and |ilk| arrays give further information about names.
+These auxiliary arrays consist of sixteen-bit items.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!sixteen_bits=0..65535; {unsigned two-byte quantity}
+
+@ \.{MFT} has been designed to avoid the need for indices that are more
+than sixteen bits wide, so that it can be used on most computers.
+
+@<Globals...@>=
+@!byte_mem: packed array [0..max_bytes] of ASCII_code; {characters of names}
+@!byte_start: array [0..max_names] of sixteen_bits; {directory into |byte_mem|}
+@!link: array [0..max_names] of sixteen_bits; {hash table links}
+@!ilk: array [0..max_names] of sixteen_bits; {type codes}
+
+@ The names of tokens are found by computing a hash address |h| and
+then looking at strings of bytes signified by |hash[h]|, |link[hash[h]]|,
+|link[link[hash[h]]]|, \dots, until either finding the desired name
+or encountering a zero.
+
+A `|name_pointer|' variable, which signifies a name, is an index into
+|byte_start|. The actual sequence of characters in the name pointed to by
+|p| appears in positions |byte_start[p]| to |byte_start[p+1]-1|, inclusive,
+of |byte_mem|.
+
+We usually have |byte_start[name_ptr]=byte_ptr|, which is
+the starting position for the next name to be stored in |byte_mem|.
+
+@d length(#)==byte_start[#+1]-byte_start[#] {the length of a name}
+
+@<Types...@>=
+@!name_pointer=0..max_names; {identifies a name}
+
+@ @<Global...@>=
+@!name_ptr:name_pointer; {first unused position in |byte_start|}
+@!byte_ptr:0..max_bytes; {first unused position in |byte_mem|}
+
+@ @<Set init...@>=
+byte_start[0]:=0; byte_ptr:=0;
+byte_start[1]:=0; {this makes name 0 of length zero}
+name_ptr:=1;
+
+@ The hash table described above is updated by the |lookup| procedure,
+which finds a given name and returns a pointer to its index in
+|byte_start|. The token is supposed to match character by character.
+If it was not already present, it is inserted into the table.
+
+Because of the way \.{MFT}'s scanning mechanism works, it is most convenient
+to let |lookup| search for a token that is present in the |buffer|
+array. Two other global variables specify its position in the buffer: the
+first character is |buffer[id_first]|, and the last is |buffer[id_loc-1]|.
+
+@<Glob...@>=
+@!id_first:0..buf_size; {where the current token begins in the buffer}
+@!id_loc:0..buf_size; {just after the current token in the buffer}
+@#
+@!hash:array [0..hash_size] of sixteen_bits; {heads of hash lists}
+
+@ Initially all the hash lists are empty.
+
+@<Local variables for init...@>=
+@!h:0..hash_size; {index into hash-head array}
+
+@ @<Set init...@>=
+for h:=0 to hash_size-1 do hash[h]:=0;
+
+@ Here now is the main procedure for finding tokens.
+
+@p function lookup:name_pointer; {finds current token}
+label found;
+var i:0..buf_size; {index into |buffer|}
+@!h:0..hash_size; {hash code}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!l:0..buf_size; {length of the given token}
+@!p:name_pointer; {where the token is being sought}
+begin l:=id_loc-id_first; {compute the length}
+@<Compute the hash code |h|@>;
+@<Compute the name location |p|@>;
+if p=name_ptr then @<Enter a new name into the table at position |p|@>;
+lookup:=p;
+end;
+
+@ A simple hash code is used: If the sequence of
+ASCII codes is $c_1c_2\ldots c_m$, its hash value will be
+$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the hash...@>=
+h:=buffer[id_first]; i:=id_first+1;
+while i<id_loc do
+ begin h:=(h+h+buffer[i]) mod hash_size; incr(i);
+ end
+
+@ If the token is new, it will be placed in position |p=name_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the name location...@>=
+p:=hash[h];
+while p<>0 do
+ begin if length(p)=l then
+ @<Compare name |p| with current token,
+ |goto found| if equal@>;
+ p:=link[p];
+ end;
+p:=name_ptr; {the current token is new}
+link[p]:=hash[h]; hash[h]:=p; {insert |p| at beginning of hash list}
+found:
+
+@ @<Compare name |p|...@>=
+begin i:=id_first; k:=byte_start[p];
+while (i<id_loc)and(buffer[i]=byte_mem[k]) do
+ begin incr(i); incr(k);
+ end;
+if i=id_loc then goto found; {all characters agree}
+end
+
+@ When we begin the following segment of the program, |p=name_ptr|.
+
+@<Enter a new name...@>=
+begin if byte_ptr+l>max_bytes then overflow('byte memory');
+if name_ptr+1>max_names then overflow('name');
+i:=id_first; {get ready to move the token into |byte_mem|}
+while i<id_loc do
+ begin byte_mem[byte_ptr]:=buffer[i]; incr(byte_ptr); incr(i);
+ end;
+incr(name_ptr); byte_start[name_ptr]:=byte_ptr;
+@<Assign the default value to |ilk[p]|@>;
+end
+
+@* Initializing the primitive tokens.
+Each token read by \.{MFT} is recognized as belonging to one of the
+following ``types'':
+
+@d indentation=0 {internal code for space at beginning of a line}
+@d end_of_line=1 {internal code for hypothetical token at end of a line}
+@d end_of_file=2 {internal code for hypothetical token at end of the input}
+@d verbatim=3 {internal code for the token `\.{\%\%}'}
+@d set_format=4 {internal code for the token `\.{\%\%\%}'}
+@d mft_comment=5 {internal code for the token `\.{\%\%\%\%}'}
+@d min_action_type=6 {smallest code for tokens that produce ``real'' output}
+@d numeric_token=6 {internal code for tokens like `\.{3.14159}'}
+@d string_token=7 {internal code for tokens like `|"pie"|'}
+@d min_symbolic_token=8 {smallest internal code for a symbolic token}
+@d op=8 {internal code for tokens like `\.{sqrt}'}
+@d command=9 {internal code for tokens like `\.{addto}'}
+@d endit=10 {internal code for tokens like `\.{fi}'}
+@d binary=11 {internal code for tokens like `\.{and}'}
+@d abinary=12 {internal code for tokens like `\.{+}'}
+@d bbinary=13 {internal code for tokens like `\.{step}'}
+@d ampersand=14 {internal code for the token `\.{\char`\&}'}
+@d pyth_sub=15 {internal code for the token `\.{+-+}'}
+@d as_is=16 {internal code for tokens like `\.{]}'}
+@d bold=17 {internal code for tokens like `\.{nullpen}'}
+@d type_name=18 {internal code for tokens like `\.{numeric}'}
+@d path_join=19 {internal code for the token `\.{..}'}
+@d colon=20 {internal code for the token `\.:'}
+@d semicolon=21 {internal code for the token `\.;'}
+@d backslash=22 {internal code for the token `\.{\\}'}
+@d double_back=23 {internal code for the token `\.{\\\\}'}
+@d less_or_equal=24 {internal code for the token `\.{<=}'}
+@d greater_or_equal=25 {internal code for the token `\.{>=}'}
+@d not_equal=26 {internal code for the token `\.{<>}'}
+@d sharp=27 {internal code for the token `\.{\char`\#}'}
+@d comment=28 {internal code for the token `\.{\char`\%}'}
+@d recomment=29 {internal code used to resume a comment after `\pb'}
+@d min_suffix=30 {smallest code for symbolic tokens in suffixes}
+@d internal=30 {internal code for tokens like `\.{pausing}'}
+@d input_command=31 {internal code for tokens like `\.{input}'}
+@d special_tag=32 {internal code for tags that take at most one subscript}
+@d tag=33 {internal code for nonprimitive tokens}
+
+@<Assign the default value to |ilk[p]|@>=ilk[p]:=tag
+
+@ We have to get \MF's primitives into the hash table, and the
+simplest way to do this is to insert them every time \.{MFT} is run.
+
+A few macros permit us to do the initialization with a compact program.
+We use the fact that the longest primitive is \.{intersectiontimes},
+which is 17 letters long.
+
+@d spr17(#)==buffer[17]:=#;cur_tok:=lookup;ilk[cur_tok]:=
+@d spr16(#)==buffer[16]:=#;spr17
+@d spr15(#)==buffer[15]:=#;spr16
+@d spr14(#)==buffer[14]:=#;spr15
+@d spr13(#)==buffer[13]:=#;spr14
+@d spr12(#)==buffer[12]:=#;spr13
+@d spr11(#)==buffer[11]:=#;spr12
+@d spr10(#)==buffer[10]:=#;spr11
+@d spr9(#)==buffer[9]:=#;spr10
+@d spr8(#)==buffer[8]:=#;spr9
+@d spr7(#)==buffer[7]:=#;spr8
+@d spr6(#)==buffer[6]:=#;spr7
+@d spr5(#)==buffer[5]:=#;spr6
+@d spr4(#)==buffer[4]:=#;spr5
+@d spr3(#)==buffer[3]:=#;spr4
+@d spr2(#)==buffer[2]:=#;spr3
+@d spr1(#)==buffer[1]:=#;spr2
+@d pr1==id_first:=17; spr17
+@d pr2==id_first:=16; spr16
+@d pr3==id_first:=15; spr15
+@d pr4==id_first:=14; spr14
+@d pr5==id_first:=13; spr13
+@d pr6==id_first:=12; spr12
+@d pr7==id_first:=11; spr11
+@d pr8==id_first:=10; spr10
+@d pr9==id_first:=9; spr9
+@d pr10==id_first:=8; spr8
+@d pr11==id_first:=7; spr7
+@d pr12==id_first:=6; spr6
+@d pr13==id_first:=5; spr5
+@d pr14==id_first:=4; spr4
+@d pr15==id_first:=3; spr3
+@d pr16==id_first:=2; spr2
+@d pr17==id_first:=1; spr1
+
+@ The intended use of the macros above might not be immediately obvious,
+but the riddle is answered by the following:
+
+@<Store all the primitives@>=
+id_loc:=18;@/
+pr2(".")(".")(path_join);@/
+pr1("[")(as_is);@/
+pr1("]")(as_is);@/
+pr1("}")(as_is);@/
+pr1("{")(as_is);@/
+pr1(":")(colon);@/
+pr2(":")(":")(colon);@/
+pr3("|")("|")(":")(colon);@/
+pr2(":")("=")(as_is);@/
+pr1(",")(as_is);@/
+pr1(";")(semicolon);@/
+pr1("\")(backslash);@/
+pr2("\")("\")(double_back);@/
+pr5("a")("d")("d")("t")("o")(command);@/
+pr2("a")("t")(bbinary);@/
+pr7("a")("t")("l")("e")("a")("s")("t")(op);@/
+pr10("b")("e")("g")("i")("n")("g")("r")("o")("u")("p")(command);
+pr8("c")("o")("n")("t")("r")("o")("l")("s")(op);@/
+pr4("c")("u")("l")("l")(command);@/
+pr4("c")("u")("r")("l")(op);@/
+pr10("d")("e")("l")("i")("m")("i")("t")("e")("r")("s")(command);@/
+pr7("d")("i")("s")("p")("l")("a")("y")(command);@/
+pr8("e")("n")("d")("g")("r")("o")("u")("p")(endit);@/
+pr8("e")("v")("e")("r")("y")("j")("o")("b")(command);@/
+pr6("e")("x")("i")("t")("i")("f")(command);@/
+pr11("e")("x")("p")("a")("n")("d")("a")("f")("t")("e")("r")(command);@/
+pr4("f")("r")("o")("m")(bbinary);@/
+pr8("i")("n")("w")("i")("n")("d")("o")("w")(bbinary);@/
+pr7("i")("n")("t")("e")("r")("i")("m")(command);@/
+pr3("l")("e")("t")(command);@/
+pr11("n")("e")("w")("i")("n")("t")("e")("r")("n")("a")("l")(command);@/
+pr2("o")("f")(command);@/
+pr10("o")("p")("e")("n")("w")("i")("n")("d")("o")("w")(command);@/
+pr10("r")("a")("n")("d")("o")("m")("s")("e")("e")("d")(command);@/
+pr4("s")("a")("v")("e")(command);@/
+pr10("s")("c")("a")("n")("t")("o")("k")("e")("n")("s")(command);@/
+pr7("s")("h")("i")("p")("o")("u")("t")(command);@/
+pr4("s")("t")("e")("p")(bbinary);@/
+pr3("s")("t")("r")(command);@/
+pr7("t")("e")("n")("s")("i")("o")("n")(op);@/
+pr2("t")("o")(bbinary);@/
+pr5("u")("n")("t")("i")("l")(bbinary);@/
+pr3("d")("e")("f")(command);@/
+pr6("v")("a")("r")("d")("e")("f")(command);@/
+
+@ (There are so many primitives, it's necessary to break this long
+initialization code up into pieces so as not to overflow \.{WEAVE}'s capacity.)
+
+@<Store all the primitives@>=
+pr10("p")("r")("i")("m")("a")("r")("y")("d")("e")("f")(command);@/
+pr12("s")("e")("c")("o")("n")("d")("a")("r")("y")("d")("e")("f")(command);@/
+pr11("t")("e")("r")("t")("i")("a")("r")("y")("d")("e")("f")(command);@/
+pr6("e")("n")("d")("d")("e")("f")(endit);@/
+pr3("f")("o")("r")(command);@/
+pr11("f")("o")("r")("s")("u")("f")("f")("i")("x")("e")("s")(command);@/
+pr7("f")("o")("r")("e")("v")("e")("r")(command);@/
+pr6("e")("n")("d")("f")("o")("r")(endit);@/
+pr5("q")("u")("o")("t")("e")(command);@/
+pr4("e")("x")("p")("r")(command);@/
+pr6("s")("u")("f")("f")("i")("x")(command);@/
+pr4("t")("e")("x")("t")(command);@/
+pr7("p")("r")("i")("m")("a")("r")("y")(command);@/
+pr9("s")("e")("c")("o")("n")("d")("a")("r")("y")(command);@/
+pr8("t")("e")("r")("t")("i")("a")("r")("y")(command);@/
+pr5("i")("n")("p")("u")("t")(input_command);@/
+pr8("e")("n")("d")("i")("n")("p")("u")("t")(bold);@/
+pr2("i")("f")(command);@/
+pr2("f")("i")(endit);@/
+pr4("e")("l")("s")("e")(command);@/
+pr6("e")("l")("s")("e")("i")("f")(command);@/
+pr4("t")("r")("u")("e")(bold);@/
+pr5("f")("a")("l")("s")("e")(bold);@/
+pr11("n")("u")("l")("l")("p")("i")("c")("t")("u")("r")("e")(bold);@/
+pr7("n")("u")("l")("l")("p")("e")("n")(bold);@/
+pr7("j")("o")("b")("n")("a")("m")("e")(bold);@/
+pr10("r")("e")("a")("d")("s")("t")("r")("i")("n")("g")(bold);@/
+pr9("p")("e")("n")("c")("i")("r")("c")("l")("e")(bold);@/
+pr4("g")("o")("o")("d")(special_tag);@/
+pr2("=")(":")(as_is);@/
+pr3("=")(":")("|")(as_is);@/
+pr4("=")(":")("|")(">")(as_is);@/
+pr3("|")("=")(":")(as_is);@/
+pr4("|")("=")(":")(">")(as_is);@/
+pr4("|")("=")(":")("|")(as_is);@/
+pr5("|")("=")(":")("|")(">")(as_is);@/
+pr6("|")("=")(":")("|")(">")(">")(as_is);@/
+pr4("k")("e")("r")("n")(binary);
+pr6("s")("k")("i")("p")("t")("o")(command);@/
+
+@ (Does anybody out there remember the commercials that went \.{LS-MFT}?)
+
+@<Store all the prim...@>=
+pr13("n")("o")("r")("m")("a")("l")("d")("e")("v")("i")("a")("t")("e")(op);@/
+pr3("o")("d")("d")(op);@/
+pr5("k")("n")("o")("w")("n")(op);@/
+pr7("u")("n")("k")("n")("o")("w")("n")(op);@/
+pr3("n")("o")("t")(op);@/
+pr7("d")("e")("c")("i")("m")("a")("l")(op);@/
+pr7("r")("e")("v")("e")("r")("s")("e")(op);@/
+pr8("m")("a")("k")("e")("p")("a")("t")("h")(op);@/
+pr7("m")("a")("k")("e")("p")("e")("n")(op);@/
+pr11("t")("o")("t")("a")("l")("w")("e")("i")("g")("h")("t")(op);@/
+pr3("o")("c")("t")(op);@/
+pr3("h")("e")("x")(op);@/
+pr5("A")("S")("C")("I")("I")(op);@/
+pr4("c")("h")("a")("r")(op);@/
+pr6("l")("e")("n")("g")("t")("h")(op);@/
+pr13("t")("u")("r")("n")("i")("n")("g")("n")("u")("m")("b")("e")("r")(op);@/
+pr5("x")("p")("a")("r")("t")(op);@/
+pr5("y")("p")("a")("r")("t")(op);@/
+pr6("x")("x")("p")("a")("r")("t")(op);@/
+pr6("x")("y")("p")("a")("r")("t")(op);@/
+pr6("y")("x")("p")("a")("r")("t")(op);@/
+pr6("y")("y")("p")("a")("r")("t")(op);@/
+pr4("s")("q")("r")("t")(op);@/
+pr4("m")("e")("x")("p")(op);@/
+pr4("m")("l")("o")("g")(op);@/
+pr4("s")("i")("n")("d")(op);@/
+pr4("c")("o")("s")("d")(op);@/
+pr5("f")("l")("o")("o")("r")(op);@/
+pr14("u")("n")("i")("f")("o")("r")("m")("d")("e")("v")("i")("a")("t")("e")(op);
+ @/
+pr10("c")("h")("a")("r")("e")("x")("i")("s")("t")("s")(op);@/
+pr5("a")("n")("g")("l")("e")(op);@/
+pr5("c")("y")("c")("l")("e")(op);@/
+
+@ (If you think this \.{WEB} code is ugly, you should see the Pascal code
+it produces.)
+
+@<Store all the primitives@>=
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("t")("i")("t")("l")("e")("s")(internal);@/
+pr16("t")("r")("a")("c")("i")("n")("g")
+ ("e")("q")("u")("a")("t")("i")("o")("n")("s")(internal);@/
+pr15("t")("r")("a")("c")("i")("n")("g")
+ ("c")("a")("p")("s")("u")("l")("e")("s")(internal);@/
+pr14("t")("r")("a")("c")("i")("n")("g")
+ ("c")("h")("o")("i")("c")("e")("s")(internal);@/
+pr12("t")("r")("a")("c")("i")("n")("g")
+ ("s")("p")("e")("c")("s")(internal);@/
+pr11("t")("r")("a")("c")("i")("n")("g")
+ ("p")("e")("n")("s")(internal);@/
+pr15("t")("r")("a")("c")("i")("n")("g")
+ ("c")("o")("m")("m")("a")("n")("d")("s")(internal);@/
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("m")("a")("c")("r")("o")("s")(internal);@/
+pr12("t")("r")("a")("c")("i")("n")("g")
+ ("e")("d")("g")("e")("s")(internal);@/
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("o")("u")("t")("p")("u")("t")(internal);@/
+pr12("t")("r")("a")("c")("i")("n")("g")
+ ("s")("t")("a")("t")("s")(internal);@/
+pr13("t")("r")("a")("c")("i")("n")("g")
+ ("o")("n")("l")("i")("n")("e")(internal);@/
+
+@ @<Store all the primitives@>=
+pr4("y")("e")("a")("r")(internal);@/
+pr5("m")("o")("n")("t")("h")(internal);@/
+pr3("d")("a")("y")(internal);@/
+pr4("t")("i")("m")("e")(internal);@/
+pr8("c")("h")("a")("r")("c")("o")("d")("e")(internal);@/
+pr7("c")("h")("a")("r")("f")("a")("m")(internal);@/
+pr6("c")("h")("a")("r")("w")("d")(internal);@/
+pr6("c")("h")("a")("r")("h")("t")(internal);@/
+pr6("c")("h")("a")("r")("d")("p")(internal);@/
+pr6("c")("h")("a")("r")("i")("c")(internal);@/
+pr6("c")("h")("a")("r")("d")("x")(internal);@/
+pr6("c")("h")("a")("r")("d")("y")(internal);@/
+pr10("d")("e")("s")("i")("g")("n")("s")("i")("z")("e")(internal);@/
+pr4("h")("p")("p")("p")(internal);@/
+pr4("v")("p")("p")("p")(internal);@/
+pr7("x")("o")("f")("f")("s")("e")("t")(internal);@/
+pr7("y")("o")("f")("f")("s")("e")("t")(internal);@/
+pr7("p")("a")("u")("s")("i")("n")("g")(internal);@/
+pr12("s")("h")("o")("w")
+ ("s")("t")("o")("p")("p")("i")("n")("g")(internal);@/
+pr10("f")("o")("n")("t")("m")("a")("k")("i")("n")("g")(internal);@/
+pr8("p")("r")("o")("o")("f")("i")("n")("g")(internal);@/
+pr9("s")("m")("o")("o")("t")("h")("i")("n")("g")(internal);@/
+pr12("a")("u")("t")("o")("r")("o")("u")("n")("d")("i")("n")("g")(internal);@/
+pr11("g")("r")("a")("n")("u")("l")("a")("r")("i")("t")("y")(internal);@/
+pr6("f")("i")("l")("l")("i")("n")(internal);@/
+pr12("t")("u")("r")("n")("i")("n")("g")("c")("h")("e")("c")("k")(internal);@/
+pr12("w")("a")("r")("n")("i")("n")("g")("c")("h")("e")("c")("k")(internal);@/
+pr12("b")("o")("u")("n")("d")("a")("r")("y")("c")("h")("a")("r")(internal);@/
+
+@ Still more.
+
+@<Store all the prim...@>=
+pr1("+")(abinary);@/
+pr1("-")(abinary);@/
+pr1("*")(abinary);@/
+pr1("/")(as_is);@/
+pr2("+")("+")(binary);@/
+pr3("+")("-")("+")(pyth_sub);@/
+pr3("a")("n")("d")(binary);@/
+pr2("o")("r")(binary);@/
+pr1("<")(as_is);@/
+pr2("<")("=")(less_or_equal);@/
+pr1(">")(as_is);@/
+pr2(">")("=")(greater_or_equal);@/
+pr1("=")(as_is);@/
+pr2("<")(">")(not_equal);@/
+pr9("s")("u")("b")("s")("t")("r")("i")("n")("g")(command);@/
+pr7("s")("u")("b")("p")("a")("t")("h")(command);@/
+pr13("d")("i")("r")("e")("c")("t")("i")("o")("n")@|
+ ("t")("i")("m")("e")(command);@/
+pr5("p")("o")("i")("n")("t")(command);@/
+pr10("p")("r")("e")("c")("o")("n")("t")("r")("o")("l")(command);@/
+pr11("p")("o")("s")("t")("c")("o")("n")("t")("r")("o")("l")(command);@/
+pr9("p")("e")("n")("o")("f")("f")("s")("e")("t")(command);@/
+pr1("&")(ampersand);@/
+pr7("r")("o")("t")("a")("t")("e")("d")(binary);@/
+pr7("s")("l")("a")("n")("t")("e")("d")(binary);@/
+pr6("s")("c")("a")("l")("e")("d")(binary);@/
+pr7("s")("h")("i")("f")("t")("e")("d")(binary);@/
+pr11("t")("r")("a")("n")("s")("f")("o")("r")("m")("e")("d")(binary);@/
+pr7("x")("s")("c")("a")("l")("e")("d")(binary);@/
+pr7("y")("s")("c")("a")("l")("e")("d")(binary);@/
+pr7("z")("s")("c")("a")("l")("e")("d")(binary);@/
+pr17("i")("n")("t")("e")("r")("s")("e")("c")("t")("i")("o")("n")@|
+ ("t")("i")("m")("e")("s")(binary);@/
+pr7("n")("u")("m")("e")("r")("i")("c")(type_name);@/
+pr6("s")("t")("r")("i")("n")("g")(type_name);@/
+pr7("b")("o")("o")("l")("e")("a")("n")(type_name);@/
+pr4("p")("a")("t")("h")(type_name);@/
+pr3("p")("e")("n")(type_name);@/
+pr7("p")("i")("c")("t")("u")("r")("e")(type_name);@/
+pr9("t")("r")("a")("n")("s")("f")("o")("r")("m")(type_name);@/
+pr4("p")("a")("i")("r")(type_name);@/
+
+@ At last we are done with the tedious initialization of primitives.
+
+@<Store all the prim...@>=
+pr3("e")("n")("d")(endit);@/
+pr4("d")("u")("m")("p")(endit);@/
+pr9("b")("a")("t")("c")("h")("m")("o")("d")("e")(bold);
+pr11("n")("o")("n")("s")("t")("o")("p")("m")("o")("d")("e")(bold);
+pr10("s")("c")("r")("o")("l")("l")("m")("o")("d")("e")(bold);
+pr13("e")("r")("r")("o")("r")("s")("t")("o")("p")@|
+ ("m")("o")("d")("e")(bold);
+pr5("i")("n")("n")("e")("r")(command);@/
+pr5("o")("u")("t")("e")("r")(command);@/
+pr9("s")("h")("o")("w")("t")("o")("k")("e")("n")(command);@/
+pr9("s")("h")("o")("w")("s")("t")("a")("t")("s")(bold);@/
+pr4("s")("h")("o")("w")(command);@/
+pr12("s")("h")("o")("w")("v")("a")("r")("i")("a")("b")("l")("e")(command);@/
+pr16("s")("h")("o")("w")@|
+ ("d")("e")("p")("e")("n")("d")("e")("n")("c")("i")("e")("s")(bold);@/
+pr7("c")("o")("n")("t")("o")("u")("r")(command);@/
+pr10("d")("o")("u")("b")("l")("e")("p")("a")("t")("h")(command);@/
+pr4("a")("l")("s")("o")(command);@/
+pr7("w")("i")("t")("h")("p")("e")("n")(command);@/
+pr10("w")("i")("t")("h")("w")("e")("i")("g")("h")("t")(command);@/
+pr8("d")("r")("o")("p")("p")("i")("n")("g")(command);@/
+pr7("k")("e")("e")("p")("i")("n")("g")(command);@/
+pr7("m")("e")("s")("s")("a")("g")("e")(command);@/
+pr10("e")("r")("r")("m")("e")("s")("s")("a")("g")("e")(command);@/
+pr7("e")("r")("r")("h")("e")("l")("p")(command);@/
+pr8("c")("h")("a")("r")("l")("i")("s")("t")(command);@/
+pr8("l")("i")("g")("t")("a")("b")("l")("e")(command);@/
+pr10("e")("x")("t")("e")("n")("s")("i")("b")("l")("e")(command);@/
+pr10("h")("e")("a")("d")("e")("r")("b")("y")("t")("e")(command);@/
+pr9("f")("o")("n")("t")("d")("i")("m")("e")("n")(command);@/
+pr7("s")("p")("e")("c")("i")("a")("l")(command);@/
+pr10("n")("u")("m")("s")("p")("e")("c")("i")("a")("l")(command);@/
+pr1("%")(comment);@/
+pr2("%")("%")(verbatim);@/
+pr3("%")("%")("%")(set_format);@/
+pr4("%")("%")("%")("%")(mft_comment);@/
+pr1("#")(sharp);@/
+
+@ We also want to store a few other strings of characters that are
+used in \.{MFT}'s translation to \TeX\ code.
+
+@d ttr1(#)==byte_mem[byte_ptr-1]:=#; cur_tok:=name_ptr;
+ incr(name_ptr); byte_start[name_ptr]:=byte_ptr
+@d ttr2(#)==byte_mem[byte_ptr-2]:=#; ttr1
+@d ttr3(#)==byte_mem[byte_ptr-3]:=#; ttr2
+@d ttr4(#)==byte_mem[byte_ptr-4]:=#; ttr3
+@d ttr5(#)==byte_mem[byte_ptr-5]:=#; ttr4
+@d tr1==incr(byte_ptr); ttr1
+@d tr2==byte_ptr:=byte_ptr+2; ttr2
+@d tr3==byte_ptr:=byte_ptr+3; ttr3
+@d tr4==byte_ptr:=byte_ptr+4; ttr4
+@d tr5==byte_ptr:=byte_ptr+5; ttr5
+
+@<Glob...@>=
+@!translation:array[ASCII_code] of name_pointer;
+@!i:ASCII_code; {index into |translation|}
+
+@ @<Store all the translations@>=
+for i:=0 to 255 do translation[i]:=0;
+tr2("\")("$"); translation["$"]:=cur_tok;@/
+tr2("\")("#"); translation["#"]:=cur_tok;@/
+tr2("\")("&"); translation["&"]:=cur_tok;@/
+tr2("\")("{"); translation["{"]:=cur_tok;@/
+tr2("\")("}"); translation["}"]:=cur_tok;@/
+tr2("\")("_"); translation["_"]:=cur_tok;@/
+tr2("\")("%"); translation["%"]:=cur_tok;@/
+tr4("\")("B")("S")(" "); translation["\"]:=cur_tok;@/
+tr4("\")("H")("A")(" "); translation["^"]:=cur_tok;@/
+tr4("\")("T")("I")(" "); translation["~"]:=cur_tok;@/
+tr5("\")("a")("s")("t")(" "); translation["*"]:=cur_tok;@/
+tr4("\")("A")("M")(" "); tr_amp:=cur_tok;@/
+@.\\AM, etc@>
+tr4("\")("B")("L")(" "); tr_skip:=cur_tok;@/
+tr4("\")("S")("H")(" "); tr_sharp:=cur_tok;@/
+tr4("\")("P")("S")(" "); tr_ps:=cur_tok;@/
+tr4("\")("l")("e")(" "); tr_le:=cur_tok;@/
+tr4("\")("g")("e")(" "); tr_ge:=cur_tok;@/
+tr4("\")("n")("e")(" "); tr_ne:=cur_tok;@/
+tr5("\")("q")("u")("a")("d"); tr_quad:=cur_tok;@/
+
+@ @<Glob...@>=
+@!tr_le,@!tr_ge,@!tr_ne,@!tr_amp,@!tr_sharp,@!tr_skip,@!tr_ps,
+ @!tr_quad:name_pointer; {special translations}
+
+@* Inputting the next token.
+\.{MFT}'s lexical scanning routine is called |get_next|. This procedure
+inputs the next token of \MF\ input and puts its encoded meaning into
+two global variables, |cur_type| and |cur_tok|.
+
+@<Glob...@>=
+@!cur_type:eight_bits; {type of token just scanned}
+@!cur_tok:integer; {hash table or buffer location}
+@!prev_type:eight_bits; {previous value of |cur_type|}
+@!prev_tok:integer; {previous value of |cur_tok|}
+
+@ @<Set init...@>=
+cur_type:=end_of_line; cur_tok:=0;
+
+@ Two global state variables affect the behavior of |get_next|: A space
+will be considered significant when |start_of_line| is |true|,
+and the buffer will be considered devoid of information when |empty_buffer|
+is |true|.
+
+@<Glob...@>=
+@!start_of_line:boolean; {has the current line had nothing but spaces so far?}
+@!empty_buffer:boolean; {is it time to input a new line?}
+
+@ The 256 |ASCII_code| characters are grouped into classes by means of
+the |char_class| table. Individual class numbers have no semantic
+or syntactic significance, expect in a few instances defined here.
+There's also |max_class|, which can be used as a basis for additional
+class numbers in nonstandard extensions of \MF.
+
+@d digit_class=0 {the class number of \.{0123456789}}
+@d period_class=1 {the class number of `\..'}
+@d space_class=2 {the class number of spaces and nonstandard characters}
+@d percent_class=3 {the class number of `\.\%'}
+@d string_class=4 {the class number of `\."'}
+@d right_paren_class=8 {the class number of `\.)'}
+@d isolated_classes==5,6,7,8 {characters that make length-one tokens only}
+@d letter_class=9 {letters and the underline character}
+@d left_bracket_class=17 {`\.['}
+@d right_bracket_class=18 {`\.]'}
+@d invalid_class=20 {bad character in the input}
+@d end_line_class=21 {end of an input line (\.{MFT} only)}
+@d max_class=21 {the largest class number}
+
+@<Glob...@>=
+@!char_class:array[ASCII_code] of 0..max_class; {the class numbers}
+
+@ If changes are made to accommodate non-ASCII character sets, they should be
+essentially the same in \.{MFT} as in \MF. However, \.{MFT} has an additional
+class number, the |end_line_class|, which is used only for the special
+character |carriage_return| that is placed at the end of the input buffer.
+@^character set dependencies@>
+@^system dependencies@>
+
+@d carriage_return=@'15 {special code placed in |buffer[limit]|}
+
+@<Set init...@>=
+for i:="0" to "9" do char_class[i]:=digit_class;
+char_class["."]:=period_class;
+char_class[" "]:=space_class;
+char_class["%"]:=percent_class;
+char_class[""""]:=string_class;@/
+char_class[","]:=5;
+char_class[";"]:=6;
+char_class["("]:=7;
+char_class[")"]:=right_paren_class;
+for i:="A" to "Z" do char_class[i]:=letter_class;
+for i:="a" to "z" do char_class[i]:=letter_class;
+char_class["_"]:=letter_class;@/
+char_class["<"]:=10;
+char_class["="]:=10;
+char_class[">"]:=10;
+char_class[":"]:=10;
+char_class["|"]:=10;@/
+char_class["`"]:=11;
+char_class["'"]:=11;@/
+char_class["+"]:=12;
+char_class["-"]:=12;@/
+char_class["/"]:=13;
+char_class["*"]:=13;
+char_class["\"]:=13;@/
+char_class["!"]:=14;
+char_class["?"]:=14;@/
+char_class["#"]:=15;
+char_class["&"]:=15;
+char_class["@@"]:=15;
+char_class["$"]:=15;@/
+char_class["^"]:=16;
+char_class["~"]:=16;@/
+char_class["["]:=left_bracket_class;
+char_class["]"]:=right_bracket_class;@/
+char_class["{"]:=19;
+char_class["}"]:=19;@/
+for i:=0 to " "-1 do char_class[i]:=invalid_class;
+char_class[carriage_return]:=end_line_class;@/
+for i:=127 to 255 do char_class[i]:=invalid_class;
+
+@ And now we're ready to take the plunge into |get_next| itself.
+
+@d switch=25 {a label in |get_next|}
+@d pass_digits=85 {another}
+@d pass_fraction=86 {and still another, although |goto| is considered harmful}
+
+@p procedure get_next; {sets |cur_type| and |cur_tok| to next token}
+label switch,pass_digits,pass_fraction,done,found,exit;
+var @!c:ASCII_code; {the current character in the buffer}
+@!class:ASCII_code; {its class number}
+begin prev_type:=cur_type; prev_tok:=cur_tok;
+if empty_buffer then
+ @<Bring in a new line of input; |return| if the file has ended@>;
+switch: c:=buffer[loc]; id_first:=loc; incr(loc); class:=char_class[c];
+@<Branch on the |class|, scan the token; |return| directly if the
+ token is special, or |goto found| if it needs to be looked up@>;
+found:id_loc:=loc; cur_tok:=lookup; cur_type:=ilk[cur_tok];
+exit:end;
+
+@ @d emit(#)==@t@>@+begin cur_type:=#; cur_tok:=id_first; return;@+end
+
+@<Branch on the |class|...@>=
+case class of
+digit_class:goto pass_digits;
+period_class:begin class:=char_class[buffer[loc]];
+ if class>period_class then goto switch {ignore isolated `\..'}
+ else if class<period_class then goto pass_fraction; {|class=digit_class|}
+ end;
+space_class:if start_of_line then emit(indentation)
+ else goto switch;
+end_line_class: emit(end_of_line);
+string_class:@<Get a string token and |return|@>;
+isolated_classes: goto found;
+invalid_class:@<Decry the invalid character and |goto switch|@>;
+othercases do_nothing {letters, etc.}
+endcases;@/
+while char_class[buffer[loc]]=class do incr(loc);
+goto found;
+pass_digits: while char_class[buffer[loc]]=digit_class do incr(loc);
+if buffer[loc]<>"." then goto done;
+if char_class[buffer[loc+1]]<>digit_class then goto done;
+incr(loc);
+pass_fraction:repeat incr(loc);
+until char_class[buffer[loc]]<>digit_class;
+done:emit(numeric_token)
+
+@ @<Get a string token and |return|@>=
+loop@+begin if buffer[loc]="""" then
+ begin incr(loc); emit(string_token);
+ end;
+ if loc=limit then @<Decry the missing string delimiter and |goto switch|@>;
+ incr(loc);
+ end
+
+@ @<Decry the missing string delimiter and |goto switch|@>=
+begin err_print('! Incomplete string will be ignored'); goto switch;
+@.Incomplete string...@>
+end
+
+@ @<Decry the invalid character and |goto switch|@>=
+begin err_print('! Invalid character will be ignored'); goto switch;
+@.Invalid character...@>
+end
+
+@ @<Bring in a new line of input; |return| if the file has ended@>=
+begin get_line;
+if input_has_ended then emit(end_of_file);
+buffer[limit]:=carriage_return; loc:=0; start_of_line:=true;
+empty_buffer:=false;
+end
+
+@* Low-level output routines.
+The \TeX\ output is supposed to appear in lines at most |line_length|
+characters long, so we place it into an output buffer. During the output
+process, |out_line| will hold the current line number of the line about to
+be output.
+
+@<Glo...@>=
+@!out_buf:array[0..line_length] of ASCII_code; {assembled characters}
+@!out_ptr:0..line_length; {number of characters in |out_buf|}
+@!out_line: integer; {coordinates of next line to be output}
+
+@ The |flush_buffer| routine empties the buffer up to a given breakpoint,
+and moves any remaining characters to the beginning of the next line.
+If the |per_cent| parameter is |true|, a |"%"| is appended to the line
+that is being output; in this case the breakpoint |b| should be strictly
+less than |line_length|. If the |per_cent| parameter is |false|,
+trailing blanks are suppressed.
+The characters emptied from the buffer form a new line of output.
+
+@p procedure flush_buffer(@!b:eight_bits;@!per_cent:boolean);
+ {outputs |out_buf[1..b]|, where |b<=out_ptr|}
+label done;
+var j,@!k:0..line_length;
+begin j:=b;
+if not per_cent then {remove trailing blanks}
+ loop@+ begin if j=0 then goto done;
+ if out_buf[j]<>" " then goto done;
+ decr(j);
+ end;
+done: for k:=1 to j do write(tex_file,xchr[out_buf[k]]);
+if per_cent then write(tex_file,xchr["%"]);
+write_ln(tex_file); incr(out_line);
+if b<out_ptr then for k:=b+1 to out_ptr do out_buf[k-b]:=out_buf[k];
+out_ptr:=out_ptr-b;
+end;
+
+@ \.{MFT} calls |flush_buffer(out_ptr,false)| before it has input
+anything. We initialize the output variables
+so that the first line of the output file will be `\.{\\input mftmac}'.
+@.\\input mftmac@>
+@.mftmac@>
+
+@<Set init...@>=
+out_ptr:=1; out_buf[1]:=" "; out_line:=1; write(tex_file,'\input mftmac');
+
+@ When we wish to append the character |c| to the output buffer, we write
+`$|out|(c)$'; this will cause the buffer to be emptied if it was already
+full. Similarly, `$|out2|(c_1)(c_2)$' appends a pair of characters.
+A line break will occur at a space or after a single-nonletter
+\TeX\ control sequence.
+
+@d oot(#)==@;@/
+ if out_ptr=line_length then break_out;
+ incr(out_ptr); out_buf[out_ptr]:=#;
+@d oot1(#)==oot(#)@+end
+@d oot2(#)==oot(#)@,oot1
+@d oot3(#)==oot(#)@,oot2
+@d oot4(#)==oot(#)@,oot3
+@d oot5(#)==oot(#)@,oot4
+@d out==@+begin oot1
+@d out2==@+begin oot2
+@d out3==@+begin oot3
+@d out4==@+begin oot4
+@d out5==@+begin oot5
+
+@ The |break_out| routine is called just before the output buffer is about
+to overflow. To make this routine a little faster, we initialize position
+0 of the output buffer to `\.\\'; this character isn't really output.
+
+@<Set init...@>=
+out_buf[0]:="\";
+
+@ A long line is broken at a blank space or just before a backslash that isn't
+preceded by another backslash. In the latter case, a |"%"| is output at
+the break. (This policy has a known bug, in the rare situation that the
+backslash was in a string constant that's being output ``verbatim.'')
+
+@p procedure break_out; {finds a way to break the output line}
+label exit;
+var k:0..line_length; {index into |out_buf|}
+@!d:ASCII_code; {character from the buffer}
+begin k:=out_ptr;
+loop@+ begin if k=0 then
+ @<Print warning message, break the line, |return|@>;
+ d:=out_buf[k];
+ if d=" " then
+ begin flush_buffer(k,false); return;
+ end;
+ if (d="\")and(out_buf[k-1]<>"\") then {in this case |k>1|}
+ begin flush_buffer(k-1,true); return;
+ end;
+ decr(k);
+ end;
+exit:end;
+
+@ We get to this module only in unusual cases that the entire output line
+consists of a string of backslashes followed by a string of nonblank
+non-backslashes. In such cases it is almost always safe to break the
+line by putting a |"%"| just before the last character.
+
+@<Print warning message...@>=
+begin print_nl('! Line had to be broken (output l.',out_line:1);
+@.Line had to be broken@>
+print_ln('):');
+for k:=1 to out_ptr-1 do print(xchr[out_buf[k]]);
+new_line; mark_harmless;
+flush_buffer(out_ptr-1,true); return;
+end
+
+@ To output a string of bytes from |byte_mem|, we call |out_str|.
+
+@p procedure out_str(@!p:name_pointer); {outputs a string}
+var @!k:0..max_bytes; {index into |byte_mem|}
+begin for k:=byte_start[p] to byte_start[p+1]-1 do out(byte_mem[k]);
+end;
+
+@ The |out_name| subroutine is used to output a symbolic token.
+Unusual characters are translated into forms that won't screw up.
+
+@p procedure out_name(@!p:name_pointer); {outputs a name}
+var @!k:0..max_bytes; {index into |byte_mem|}
+@!t:name_pointer; {translation of character being output, if any}
+begin for k:=byte_start[p] to byte_start[p+1]-1 do
+ begin t:=translation[byte_mem[k]];
+ if t=0 then out(byte_mem[k])
+ else out_str(t);
+ end;
+end;
+
+@ We often want to output a name after calling a numeric macro
+(e.g., `\.{\\1\{foo\}}').
+
+@p procedure out_mac_and_name(@!n:ASCII_code; @!p:name_pointer);
+begin out("\"); out(n);
+if length(p)=1 then out_name(p)
+else begin out("{"); out_name(p); out("}");
+ end;
+end;
+
+@ Here's a routine that simply copies from the input buffer to the output
+buffer.
+
+@p procedure copy(@!first_loc:integer); {output |buffer[first_loc..loc-1]|}
+var @!k:0..buf_size; {|buffer| location being copied}
+begin for k:=first_loc to loc-1 do out(buffer[k]);
+end;
+
+@* Translation.
+The main work of \.{MFT} is accomplished by a routine that translates
+the tokens, one by one, with a limited amount of lookahead/lookbehind.
+Automata theorists might loosely call this a ``finite state transducer,''
+because the flow of control is comparatively simple.
+
+@p procedure do_the_translation;
+label restart,reswitch,done,exit;
+var @!k:0..buf_size; {looks ahead in the buffer}
+@!t:integer; {type that spreads to new tokens}
+begin restart:if out_ptr>0 then flush_buffer(out_ptr,false);
+empty_buffer:=true;
+loop@+ begin get_next;
+ if start_of_line then @<Do special actions at the start of a line@>;
+ reswitch:case cur_type of
+ numeric_token:@<Translate a numeric token or a fraction@>;
+ string_token:@<Translate a string token@>;
+ indentation:out_str(tr_quad);
+ end_of_line,mft_comment:@<Wind up a line of translation and |goto restart|,
+ or finish a \pb\ segment and |goto reswitch|@>;
+ end_of_file:return;
+@t\4@> @<Cases that translate primitive tokens@>@;
+ comment,recomment:@<Translate a comment and |goto restart|,
+ unless there's a \pb\ segment@>;
+ verbatim:@<Copy the rest of the current input line to the output,
+ then |goto restart|@>;
+ set_format:@<Change the translation format of tokens,
+ and |goto restart| or |reswitch|@>;
+ internal,special_tag,tag:@<Translate a tag and possible subscript@>;
+ end; {all cases have been listed}
+ end;
+exit:end;
+
+@ @<Do special actions at the start of a line@>=
+if cur_type>=min_action_type then
+ begin out("$"); start_of_line:=false;
+ case cur_type of
+ endit:out2("\")("!");
+@.\\!@>
+ binary,abinary,bbinary,ampersand,pyth_sub:out2("{")("}");
+@.\{\}@>
+ othercases do_nothing
+ endcases;
+ end
+else if cur_type=end_of_line then
+ begin out_str(tr_skip); goto restart;
+ end
+else if cur_type=mft_comment then goto restart
+
+@ Let's start with some of the easier translations, so that the harder
+ones will also be easy when we get to them. A string like |"cat"|
+comes out `\.{\\7"cat"}'.
+
+@<Translate a string token@>=
+begin out2("\")("7"); copy(cur_tok);
+@.\\7@>
+end
+
+@ Similarly, the translation of `\.{sqrt}' is `\.{\\1\{sqrt\}}'.
+
+@<Cases that translate primitive tokens@>=
+op: out_mac_and_name("1",cur_tok);
+@.\\1@>
+command: out_mac_and_name("2",cur_tok);
+@.\\2@>
+type_name: if prev_type=command then out_mac_and_name("1",cur_tok)
+ else out_mac_and_name("2",cur_tok);
+endit: out_mac_and_name("3",cur_tok);
+@.\\3@>
+bbinary: out_mac_and_name("4",cur_tok);
+@.\\4@>
+bold: out_mac_and_name("5",cur_tok);
+@.\\5@>
+binary: out_mac_and_name("6",cur_tok);
+@.\\6@>
+path_join: out_mac_and_name("8",cur_tok);
+@.\\8@>
+colon: out_mac_and_name("?",cur_tok);
+@.\\?@>
+
+@ Here are a few more easy cases.
+
+@<Cases that translate primitive tokens@>=
+as_is,sharp,abinary: out_name(cur_tok);
+double_back: out2("\")(";");
+@.\\;@>
+semicolon: begin out_name(cur_tok); get_next;
+ if cur_type<>end_of_line then if cur_type<>endit then out2("\")(" ");
+@.\\\char32@>
+ goto reswitch;
+ end;
+
+@ Some of the primitives have a fixed output (independent of |cur_tok|):
+
+@<Cases that translate primitive tokens@>=
+backslash:out_str(translation["\"]);
+pyth_sub:out_str(tr_ps);
+less_or_equal:out_str(tr_le);
+greater_or_equal:out_str(tr_ge);
+not_equal:out_str(tr_ne);
+ampersand:out_str(tr_amp);
+
+@ The remaining primitive is slightly special.
+
+@<Cases that translate primitive tokens@>=
+input_command: begin out_mac_and_name("2",cur_tok);
+ out5("\")("h")("b")("o")("x");
+ @<Scan the file name and output it in \.{typewriter type}@>;
+ end;
+
+@ File names have different formats on different computers, so we don't scan
+them with |get_next|. Here we use
+a rule that probably covers most cases satisfactorily: We ignore leading
+blanks, then consider the file name to consist of all subsequent characters
+up to the first blank, semicolon, comment, or end-of-line.
+(A |carriage_return| appears at the end of the line.)
+
+@<Scan the file name and output it in \.{typewriter type}@>=
+while buffer[loc]=" " do incr(loc);
+out5("{")("\")("t")("t")(" ");
+while (buffer[loc]<>" ")and(buffer[loc]<>"%")and(buffer[loc]<>";")
+ and(loc<limit) do
+ begin out(buffer[loc]); incr(loc);
+ end;
+out("}")
+
+@ @<Translate a numeric token or a fraction@>=
+if buffer[loc]="/" then
+ if char_class[buffer[loc+1]]=digit_class then {it's a fraction}
+ begin out5("\")("f")("r")("a")("c"); copy(cur_tok); get_next;
+@.\\frac@>
+ out2("/")("{"); get_next; copy(cur_tok); out("}");
+ end
+ else copy(cur_tok)
+else copy(cur_tok)
+
+@ @<Translate a tag and possible subscript@>=
+begin if length(cur_tok)=1 then out_name(cur_tok)
+else out_mac_and_name("\",cur_tok);
+@.\\\\@>
+get_next;
+if byte_mem[byte_start[prev_tok]]="'" then goto reswitch;
+case prev_type of
+internal:begin if (cur_type=numeric_token)or(cur_type>=min_suffix) then
+ out2("\")(",");
+@.\\,@>
+ goto reswitch;
+ end;
+special_tag:if cur_type<min_suffix then goto reswitch
+ else begin out("."); cur_type:=internal; goto reswitch;
+@..@>
+ end;
+tag:begin if cur_type=tag then if byte_mem[byte_start[cur_tok]]="'" then
+ goto reswitch; {a sequence of primes goes on the main line}
+ if (cur_type=numeric_token)or(cur_type>=min_suffix) then
+ @<Translate a subscript@>
+ else if cur_type=sharp then out_str(tr_sharp)
+ else goto reswitch;
+ end;
+end; {there are no other cases}
+end
+
+@ @<Translate a subscript@>=
+begin out2("_")("{");
+loop@+ begin if cur_type>=min_suffix then out_name(cur_tok)
+ else copy(cur_tok);
+ if prev_type=special_tag then
+ begin get_next; goto done;
+ end;
+ get_next;
+ if cur_type<min_suffix then if cur_type<>numeric_token then goto done;
+ if cur_type=prev_type then
+ if cur_type=numeric_token then out2("\")(",")
+@.\\,@>
+ else if char_class[byte_mem[byte_start[cur_tok]]]=@|
+ char_class[byte_mem[byte_start[prev_tok]]] then
+ if byte_mem[byte_start[prev_tok]]<>"." then out(".")
+ else out2("\")(",");
+ end;
+done: out("}"); goto reswitch;
+end
+
+@ The tricky thing about comments is that they might contain \pb.
+We scan ahead for this, and replace the second `\.{\char'174}'
+by a |carriage_return|.
+
+@<Translate a comment and |goto restart|...@>=
+begin if cur_type=comment then out2("\")("9");
+@.\\9@>
+id_first:=loc;
+while (loc<limit)and(buffer[loc]<>"|") do incr(loc);
+copy(id_first);
+if loc<limit then
+ begin start_of_line:=true; incr(loc); k:=loc;
+ while (k<limit)and(buffer[k]<>"|") do incr(k);
+ buffer[k]:=carriage_return;
+ end
+else begin if out_buf[out_ptr]="\" then out(" ");
+ out4("\")("p")("a")("r"); goto restart;
+@.\\par@>
+ end;
+end
+
+@ @<Copy the rest of the current input line to the output...@>=
+begin id_first:=loc; loc:=limit; copy(id_first);
+if out_ptr=0 then
+ begin out_ptr:=1; out_buf[1]:=" ";
+ end;
+goto restart;
+end
+
+@ @<Wind up a line of translation...@>=
+begin out("$");
+if (loc<limit)and(cur_type=end_of_line) then
+ begin cur_type:=recomment; goto reswitch;
+ end
+else begin out4("\")("p")("a")("r"); goto restart;
+@.\\par@>
+ end;
+end
+
+@ @<Change the translation format...@>=
+begin start_of_line:=false; get_next; t:=cur_type;
+while cur_type>=min_symbolic_token do
+ begin get_next;
+ if cur_type>=min_symbolic_token then ilk[cur_tok]:=t;
+ end;
+if cur_type<>end_of_line then if cur_type<>mft_comment then
+ begin err_print('! Only symbolic tokens should appear after %%%');
+@.Only symbolic tokens...@>
+ goto reswitch;
+ end;
+empty_buffer:=true; goto restart;
+end
+
+@* The main program.
+Let's put it all together now: \.{MFT} starts and ends here.
+@^system dependencies@>
+
+@p begin initialize; {beginning of the main program}
+print_ln(banner); {print a ``banner line''}
+@<Store all the primitives@>;
+@<Store all the translations@>;
+@<Initialize the input...@>;
+do_the_translation;
+@<Check that all changes have been read@>;
+end_of_MFT:{here files should be closed if the operating system requires it}
+@<Print the job |history|@>;
+end.
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_nl('(No errors were found.)');
+harmless_message: print_nl('(Did you see the warning message above?)');
+error_message: print_nl('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_nl('(That was a fatal error, my friend.)');
+end {there are no other cases}
+
+@* System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{MFT} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+
+@* Index.
diff --git a/Build/source/texk/web2c/mftalk.h b/Build/source/texk/web2c/mftalk.h
new file mode 100644
index 00000000000..0c0b8fe0603
--- /dev/null
+++ b/Build/source/texk/web2c/mftalk.h
@@ -0,0 +1,43 @@
+/* mftalk.h -- METAFONT server/client protocol (not as complex as
+ it sounds).
+
+ Copyright (C) 1994 Ralph Schleicher */
+
+/* This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of
+ the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef MFTALK_H
+#define MFTALK_H
+
+/* This is the server to client protocol:
+
+ 'r' [0|1] <left> <bottom> <right> <top> Fill rectangle.
+ 'l' [0|1] <col> <row> <num> <col> ... Draw a line.
+ 'f' Update screen.
+ ^D End of transmission.
+
+ And there is one client to server command:
+
+ ^F Acknowledgment. */
+
+#define MF_RECT ((int) 'r')
+#define MF_LINE ((int) 'l')
+#define MF_FLUSH ((int) 'f')
+#define MF_EXIT ((int) ('D' - 64))
+#define MF_ACK ((int) ('F' - 64))
+
+#define MF_WHITE 0
+#define MF_BLACK 1
+
+#endif /* !MFTALK_H */
diff --git a/Build/source/texk/web2c/mp-supp-w32.ch b/Build/source/texk/web2c/mp-supp-w32.ch
new file mode 100644
index 00000000000..4f1ab17377c
--- /dev/null
+++ b/Build/source/texk/web2c/mp-supp-w32.ch
@@ -0,0 +1,77 @@
+@x
+@!file_line_error_style_p:boolean; {file:line:error style messages.}
+@y
+@!file_line_error_style_p:boolean; {output file:line:error style errors.}
+@!halt_on_error_p:boolean; {stop at first error.}
+@!quoted_filename : boolean;
+@z
+
+@x
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+@y
+ ready_already:=0;
+ texmf_finish_job;
+ if (history <> spotless) and (history <> warning_issued) then
+@z
+
+@x
+else begin print_char("."); show_context end;
+@y
+else begin print_char("."); show_context end;
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+@z
+
+@x
+area_delimiter:=-1; ext_delimiter:=-1;
+end;
+@y
+area_delimiter:=-1; ext_delimiter:=-1;
+quoted_filename:=false;
+end;
+@z
+
+@x
+begin if stop_at_space and ((c=" ")or(c=tab)) then more_name:=false
+else begin if IS_DIR_SEP (c) then
+@y
+begin
+if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+end;
+if ((c=" ")or(c=tab)) and stop_at_space and (not quoted_filename) then more_name:=false
+else begin
+ if (c="*") then c:=" "
+ else if (c="?") then c:="~";
+ if IS_DIR_SEP (c) then
+@z
+
+@x
+@<Basic printing...@>=
+procedure print_file_name(@!n,@!a,@!e:integer);
+begin print(a); print(n); print(e);
+end;
+@y
+@d print_file_name==texmf_print_file_name
+@z
+
+@x
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+@x
+@p begin @!{|start_here|}
+@y
+@p begin @!{|start_here|}
+
+ texmf_start_job;
+@z
diff --git a/Build/source/texk/web2c/mp.ch b/Build/source/texk/web2c/mp.ch
new file mode 100644
index 00000000000..dd4a9ce9a49
--- /dev/null
+++ b/Build/source/texk/web2c/mp.ch
@@ -0,0 +1,2136 @@
+% $Id: mp.ch,v 1.50 2005/06/22 17:06:13 olaf Exp $
+% mp.ch for C compilation with web2c. Public domain.
+%
+% Derived from mf.ch and John Hobby's mp.ch (the change file for the C
+% version of mf).
+%
+% Numbers of the form [pp.nnn] refer to the corresponding part and
+% module number of mp.web as implementors who read this change file are
+% much better advised to use a current WEB listing of MetaPost.
+%
+% (more recent changes in ChangeLog)
+% Revision 0.62 Jan 4 '95 by John Hobby
+% (Changes that only affect the banner line are not listed here)
+%
+% Updated for web2c-6.1/kpathsea-2.6 Jan 29 '95 by Ulrik Vieth
+% according to the current version of mf.ch.
+%
+% - produce separate binaries for INIMP, VIRMF (no '-I' flag!)
+% - make a big version of MP by default (cf. TeX and METAFONT)
+% - allow any input characters (0..255) (cf. TeX and METAFONT)
+% - use web2c/kpathsea routines in file opening and searching
+%
+% Updated for Revision 0.63 Apr 12 '95 by Ulrik Vieth
+%
+% - fixed the parsing routines for ps_tab_file to be able to handle
+% comments and blank lines in dvipsk's version of psfonts.map.
+% - increased max_read_files to 30 to avoid running out of read files
+% when reading stops before reaching EOF. (Better solution: write
+% a 'closefrom' macro that reads to EOF, which causes file closing.)
+
+@x [0] WEAVE: print changes only.
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+@y
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+\let\maybe=\iffalse
+\def\title{\MP\ changes for C}
+\def\glob{13}\def\gglob{20, 25} % these are defined in module 1
+\font\mc=cmr9
+@z
+
+@x [1.7] Convert `debug..gubed' and `stat..tats' into #ifdefs.
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==ifdef('TEXMF_DEBUG')
+@d gubed==endif('TEXMF_DEBUG')
+@z
+
+@x
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@y
+@d stat==ifdef('STAT')
+@d tats==endif('STAT')
+@z
+
+@x [1.8] Same, for `init..tini'.
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y
+@d init==ifdef('INIMP')
+@d tini==endif('INIMP')
+@z
+
+% [1.11] Compile-time constants. Although we only change a few of
+% these, listing them all makes the patch file for a big MetaPost simpler.
+% 16K for BSD I/O; file_name_size is set from the system constant.
+@x
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \MP's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMP}, otherwise |>=mem_top|}
+@!max_internal=100; {maximum number of internal quantities}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!emergency_line_length=255;
+ {\ps\ output lines can be this long in unusual circumstances}
+@!stack_size=30; {maximum number of simultaneous input sources}
+@!max_read_files=4; {maximum number of simultaneously open \&{readfrom} files}
+@!max_strings=2500; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=9000; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MP's own error messages are stored}
+@!strings_vacant=1000; {the minimum number of strings that should be available}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MP's own strings, which is currently about 22000}
+@!font_max=50; {maximum font number for included text fonts}
+@!font_mem_size=10000; {number of words for \.{TFM} information for text fonts}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='MPlib:MP.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.MPlib@>
+@!ps_tab_name='MPlib:PSFONTS.MAP ';
+ {string of length |file_name_size|; locates font name translation table}
+@!path_size=300; {maximum number of knots between breakpoints of a path}
+@!bistack_size=785; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=5000; {maximum number of ligature/kern steps, must be
+ at least 255 and at most 32510}
+@!max_kerns=500; {maximum number of distinct kern amounts}
+@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
+@y
+@d file_name_size == maxint
+@d ssup_error_line = 255
+@d ssup_max_strings = 32767 {max value allowed by \.{TANGLE}}
+
+@<Constants...@>=
+@!max_internal=300; {maximum number of internal quantities}
+@!emergency_line_length=255;
+ {\ps\ output lines can be this long in unusual circumstances}
+@!stack_size=300; {maximum number of simultaneous input sources}
+@!max_read_files=30; {maximum number of simultaneously open \&{readfrom} files}
+@!strings_vacant=1000; {the minimum number of strings that should be available}
+@!font_max=50; {maximum font number for included text fonts}
+@!font_mem_size=10000; {number of words for \.{TFM} information for text fonts}
+@!pool_name=TEXMF_POOL_NAME;
+ {string of length |file_name_size|; tells where the string pool appears}
+@!engine_name=TEXMF_ENGINE_NAME; {the name of this engine}
+@.MPlib@>
+@!ps_tab_name='psfonts.map';
+ {string of length |file_name_size|; locates font name translation table}
+@!bistack_size=1500; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=15000; {maximum number of ligature/kern steps, must be
+ at least 255 and at most 32510}
+@!max_kerns=2500; {maximum number of distinct kern amounts}
+@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
+@#
+@!inf_main_memory = 3000;
+@!sup_main_memory = 8000000;
+
+@!inf_max_strings = 2500;
+@!sup_max_strings = ssup_max_strings;
+
+@!inf_buf_size = 500;
+@!sup_buf_size = 300000;
+
+@!inf_path_size = 1000;
+@!sup_path_size = 300000;
+
+@!inf_pool_size = 32000;
+@!sup_pool_size = 10000000;
+@!inf_pool_free = 1000;
+@!sup_pool_free = sup_pool_size;
+@!inf_string_vacancies = 8000;
+@!sup_string_vacancies = sup_pool_size - 23000;
+@z
+
+@x [1.12] Constants defined as WEB macros.
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMP};
+ must be substantially larger than |mem_min|
+ and not greater than |mem_max|}
+@d hash_size=2100 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d max_in_open=6 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=150 {maximum number of simultaneous macro parameters}
+@d max_write_files=4 {maximum number of simultaneously open \&{write} files}
+@y
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@d hash_size=9500 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=7919 {a prime number equal to about 85\pct! of |hash_size|}
+@d max_in_open=25 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=1500 {maximum number of simultaneous macro parameters}
+@d max_write_files=10 {maximum number of simultaneously open \&{write} files}
+@z
+
+@x [1.13] Global parameters that can be changed in texmf.cnf.
+@<Glob...@>=
+@!bad:integer; {is some ``constant'' wrong?}
+@y
+@<Glob...@>=
+@!bad:integer; {is some ``constant'' wrong?}
+@#
+@!init
+@!ini_version:boolean; {are we \.{INIMP}? Set in \.{lib/texmfmp.c}}
+@!dump_option:boolean; {was the dump name option used?}
+@!dump_line:boolean; {was a \.{\%\AM mem} line seen?}
+tini@/
+@#
+@!bound_default:integer; {temporary for setup}
+@!bound_name:^char; {temporary for setup}
+@#
+@!main_memory:integer; {total memory words allocated in initex}
+@!mem_top:integer; {largest index in the |mem| array dumped by \.{INIMP};
+ must be substantially larger than |mem_min|
+ and not greater than |mem_max|}
+@!extra_mem_top:integer; {|mem_max:=mem_top+extra_mem_top| except in \.{INIMP}}
+@!mem_max:integer; {greatest index in \MP's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMP}, otherwise |>=mem_top|}
+@!error_line:integer; {width of context lines on terminal error messages}
+@!half_error_line:integer; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line:integer; {width of longest text lines output;
+ should be at least 60}
+@!pool_size:integer; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MP's own strings, which is currently about 22000}
+@!string_vacancies:integer; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MP's own error messages are stored}
+@!buf_size:integer; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!path_size:integer; {maximum number of knots between breakpoints of a path}
+@!pool_free:integer;{minimum pool space free after format loaded}
+@!max_strings:integer; {maximum number of strings; must not exceed |max_halfword|}
+@!parse_first_line_p:c_int_type; {parse the first line for options}
+@!file_line_error_style_p:c_int_type; {file:line:error style messages.}
+@!eight_bit_p:c_int_type; {make all characters printable by default}
+@!halt_on_error_p:c_int_type; {stop at first error}
+@!quoted_filename:boolean; {current filename is quoted}
+@z
+
+@x [1.16] Use C macros for `incr' and `decr'.
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@y
+@z
+
+% [2.19] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [2.22] Allow any character as input.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+@y
+@^character set dependencies@>
+@^system dependencies@>
+
+@d tab = @'11 { ASCII horizontal tab }
+@d form_feed = @'14 { ASCII form feed }
+
+@<Set init...@>=
+{Initialize |xchr| to the identity mapping.}
+for i:=0 to @'37 do xchr[i]:=i;
+for i:=@'177 to @'377 do xchr[i]:=i;
+@z
+
+@x [2.23]
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+@y
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+{Set |xprn| for printable ASCII, unless |eight_bit_p| is set.}
+for i:=0 to 255 do xprn[i]:=(eight_bit_p or ((i>=" ")and(i<="~")));
+
+{The idea for this dynamic translation comes from the patch by
+ Libor Skarvada \.{<libor@@informatics.muni.cz>}
+ and Petr Sojka \.{<sojka@@informatics.muni.cz>}. I didn't use any of the
+ actual code, though, preferring a more general approach.}
+
+{This sets the |xchr|, |xord|, and |xprn| arrays. We overwrite the
+ |xchr| assignments from module 21, just in case someone wants to do strange
+ character translations. See the function definition in \.{texmfmp.c} for
+ more comments.}
+if translate_filename then read_tcx_file;
+@z
+
+% [3.25] Declare name_of_file as a C string. See comments in tex.ch for
+% why we change the element type to text_char.
+@x
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@y
+@!name_of_file:^text_char;
+@z
+
+@x [3.26] Do file opening in C.
+@ The \ph\ compiler with which the original version of \MF\ was prepared
+extends the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `\ignorespaces|packed
+array[@t\<\\{any}>@>] of text_char|', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\MP\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\MP's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var @!f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var @!f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var @!f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var @!f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var @!f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var @!f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@ All of the file opening functions are defined in C.
+@d no_file_path = -1
+@z
+
+@x [3.27] Do file closing in C.
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+@p procedure a_close(var @!f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var @!f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var @!f:word_file); {close a word file}
+begin close(f);
+end;
+@y
+@ And all the file closing routines as well.
+@z
+
+@x [3.29] l.888 - Array size of input buffer is determined at runtime.
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@y
+@!buffer:^ASCII_code; {lines of characters being read}
+@z
+
+@x [3.30] Do `input_ln' in C.
+Standard \PASCAL\ says that a file should have |eoln| immediately
+before |eof|, but \MP\ needs only a weaker restriction: If |eof|
+occurs in the middle of a line, the system function |eoln| should return
+a |true| result (even though |f^| will be undefined).
+
+@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+We define |input_ln| in C, for efficiency. Nevertheless we quote the module
+`Report overflow of the input buffer, and abort' here in order to make
+\.{WEAVE} happy.
+
+@p @{ @<Report overflow of the input buffer, and abort@> @}
+@z
+
+@x [3.31] `term_in' and `term_out' are standard input and output.
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+@y
+@d term_in==stdin {the terminal as an input file}
+@d term_out==stdout {the terminal as an output file}
+@z
+
+@x [3.32] We don't need to open the terminal files.
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+@y
+@ Here is how to open the terminal files. |t_open_out| does nothing.
+|t_open_in|, on the other hand, does the work of ``rescanning,'' or getting
+any command line arguments the user has provided. It's defined in C.
+
+@d t_open_out == {output already open for text output}
+@z
+
+@x [3.33] Flushing output.
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@y
+these operations can be specified with {\mc UNIX}. |update_terminal|
+does an |fflush| (via the macro |flush|). |clear_terminal| is redefined
+to do nothing, since the user should control the terminal.
+@^system dependencies@>
+
+@d update_terminal == fflush(term_out)
+@d clear_terminal == do_nothing
+@z
+
+@x [3.36] Reading the command line.
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+@y
+@ The following program does the required initialization.
+Iff anything has been specified on the command line, then |t_open_in|
+will return with |last > first|.
+@^system dependencies@>
+
+@p
+function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin
+ t_open_in;
+ if last > first then begin
+ loc := first;
+ while (loc < last) and (buffer[loc]=' ') do
+ incr(loc);
+ if loc < last then begin
+ init_terminal := true;
+ goto exit;
+ end;
+ end;
+ loop@+begin
+ wake_up_terminal; write(term_out, '**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then begin {this shouldn't happen}
+ write_ln(term_out);
+ write_ln(term_out, '! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false;
+ return;
+ end;
+
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do
+ incr(loc);
+
+ if loc<last then begin
+ init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out, 'Please type the name of your input file.');
+ end;
+exit:
+end;
+@z
+
+@x [4.38] Dynamically allocate pool arrays.
+@!str_pool:packed array[pool_pointer] of pool_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@!next_str : array[str_number] of str_number; {for linking strings in order}
+@y
+@!str_pool:^pool_ASCII_code; {the characters}
+@!str_start : ^pool_pointer; {the starting pointers}
+@!next_str : ^str_number; {for linking strings in order}
+@z
+
+@x [4.44] One more array.
+@!str_ref:array[str_number] of 0..max_str_ref;
+@y
+@!str_ref:^str_ref_type; {web2c only does |^identifier|}
+@z
+
+@x [4.64] l.1430 -- Do not hardwire printable ASCII.
+ (k<" ")or(k>"~")
+@y
+ not xprn[k]
+@z
+
+% [4.66] Open the pool file using a path, and can't do string
+% assignments directly. (`strcpy' and `strlen' work here because
+% `pool_name' is a constant string, and thus ends in a null and doesn't
+% start with a space.)
+@x
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+@y
+name_length := strlen (pool_name);
+name_of_file := xmalloc_array (ASCII_code, 1 + name_length);
+strcpy (stringcast(name_of_file+1), pool_name); {copy the string}
+if a_open_in (pool_file, kpse_mppool_format) then
+@z
+
+@x [4.66,67,68] Make `MP.POOL' lowercase in messages.
+else bad_pool('! I can''t read MP.POOL.')
+@y
+else bad_pool('! I can''t read ', pool_name, '; bad path?')
+@z
+@x
+begin if eof(pool_file) then bad_pool('! MP.POOL has no check sum.');
+@.MP.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+@y
+begin if eof(pool_file) then bad_pool('! ', pool_name, ' has no check sum.');
+@.MP.POOL has no check sum@>
+read(pool_file,m); read(pool_file,n); {read two digits of string length}
+@z
+@x
+ bad_pool('! MP.POOL line doesn''t begin with two digits.');
+@y
+ bad_pool('! ', pool_name, ' line doesn''t begin with two digits.');
+@z
+@x
+ bad_pool('! MP.POOL check sum doesn''t have nine digits.');
+@y
+ bad_pool('! ', pool_name, ' check sum doesn''t have nine digits.');
+@z
+@x
+done: if a<>@$ then bad_pool('! MP.POOL doesn''t match; TANGLE me again.');
+@y
+done: if a<>@$ then
+ bad_pool('! ', pool_name, ' doesn''t match; tangle me again (or fix the path).');
+@z
+
+@x [5.69] error_line is a variable, so can't be a subrange array bound
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+@y
+@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for
+@z
+
+@x [5.76] Print rest of banner, eliminate misleading `no preloaded'
+@ By popular demand, \MP\ prints the banner line only on the transcript file.
+Thus there is nothing special to be printed here.
+
+@<Initialize the output...@>=
+update_terminal;
+@y
+@ Here is the very first thing that \MP\ prints: a headline that identifies
+the version number and base name. The |term_offset| variable is temporarily
+incorrect, but the discrepancy is not serious since we assume that the banner
+and mem identifier together will occupy at most |max_print_line|
+character positions.
+
+@<Initialize the output...@>=
+wterm (banner);
+wterm (version_string);
+if mem_ident>0 then print(mem_ident); print_ln;
+if translate_filename then begin
+ wterm('(');
+ fputs(translate_filename, stdout);
+ wterm_ln(')');
+end;
+update_terminal;
+@z
+
+@x [6.83] l.1815 - Add unspecified_mode.
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@y
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d unspecified_mode=4 {extra value for command-line switch}
+@z
+
+@x [6.83] l.1825 - file:line:error style messages.
+ print_nl("! "); print(#);
+@y
+ if (file_line_error_style_p and not terminal_input) then
+ begin
+ print_nl ("");
+ print (full_source_filename_stack[in_open]);
+ print (":"); print_int (line); print (": ");
+ print (#);
+ end
+ else begin print_nl("! "); print(#) end;
+@z
+
+@x [6.83] l.1822 - Add interaction_option.
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@y
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@!interaction_option:batch_mode..unspecified_mode; {set from command line}
+@z
+
+@x [6.84] l.1824 - Allow override by command line switch.
+@ @<Set init...@>=interaction:=error_stop_mode;
+@y
+@ @<Set init...@>=if interaction_option=unspecified_mode then
+ interaction:=error_stop_mode
+else
+ interaction:=interaction_option;
+@z
+
+@x [6.90] Eliminate non-local goto.
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_MP;
+end;
+@y
+@d do_final_end==begin
+ update_terminal;
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+ uexit(1)
+ else
+ uexit(0);
+ end
+@<Error hand...@>=
+procedure jump_out;
+begin
+close_files_and_terminate;
+do_final_end;
+end;
+@z
+
+@x [6.92] l.1956 - halt on error?
+print_char("."); show_context;
+@y
+print_char("."); show_context;
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+@z
+
+@x [6.93] Handle the switch-to-editor option.
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@y
+line ready to be edited.
+We do this by calling the external procedure |call_edit| with a pointer to
+the filename, its length, and the line number.
+However, here we just set up the variables that will be used as arguments,
+since we don't want to do the switch-to-editor until after \MP\ has closed
+its files.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines have
+not been commented out.
+@^debugging@>
+@d edit_file==input_stack[file_ptr]
+@z
+@x
+"E": if file_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ print(input_stack[file_ptr].name_field);
+ print(" at line "); print_int(true_line);@/
+ interaction:=scroll_mode; jump_out;
+@y
+"E": if file_ptr>0 then
+ begin
+ edit_name_start:=str_start[edit_file.name_field];
+ edit_name_length:=length(edit_file.name_field);
+ edit_line:=true_line;
+ jump_out;
+@z
+
+@x [7.111] Do half and halfp in cpascal.h.
+@d half(#)==(#) div 2
+@d halfp(#)==(#) div 2
+@y
+@z
+
+@x [7.122-7.130] Optionally replace make_fraction etc. with external routines.
+@p function make_fraction(@!p,@!q:integer):fraction;
+@y
+In the C version, there are external routines that use double precision
+floating point to simulate functions such as |make_fraction|. This is carefully
+done to be virtually machine-independent and it gives up to 12 times speed-up
+on machines with hardware floating point. Since some machines do not have fast
+double-precision floating point, we provide a C preprocessor switch that allows
+selecting the standard versions given below.
+
+@p ifdef('FIXPT')@/
+function make_fraction(@!p,@!q:integer):fraction;
+@z
+@x
+ if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n;
+ end;
+end;
+@y
+ if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n;
+ end;
+end;@/
+endif('FIXPT')
+@z
+@x
+@p function take_fraction(@!q:integer;@!f:fraction):integer;
+@y
+@p ifdef('FIXPT')@/
+function take_fraction(@!q:integer;@!f:fraction):integer;
+@z
+@x
+else take_fraction:=n+p;
+end;
+@y
+else take_fraction:=n+p;
+end;@/
+endif('FIXPT')
+@z
+@x
+@p function take_scaled(@!q:integer;@!f:scaled):integer;
+@y
+@p ifdef('FIXPT')@/
+function take_scaled(@!q:integer;@!f:scaled):integer;
+@z
+@x
+else take_scaled:=n+p;
+end;
+@y
+else take_scaled:=n+p;
+end;@/
+endif('FIXPT')
+@z
+@x
+operands are positive. \ (This procedure is not used especially often,
+so it is not part of \MP's inner loop.)
+
+@p function make_scaled(@!p,@!q:integer):scaled;
+@y
+operands are positive. \ (This procedure is not used especially often,
+so it is not part of \MP's inner loop, but we might as well allow for
+an external C routine.)
+
+@p ifdef('FIXPT')@/
+function make_scaled(@!p,@!q:integer):scaled;
+@z
+@x
+ if negative then make_scaled:=-(f+n)@+else make_scaled:=f+n;
+ end;
+end;
+@y
+ if negative then make_scaled:=-(f+n)@+else make_scaled:=f+n;
+ end;
+end;@/
+endif('FIXPT')
+@z
+
+@x [7.134] Do floor_scaled, floor_unscaled, round_unscaled, round_fraction in C.
+@p function floor_scaled(@!x:scaled):scaled;
+ {$2^{16}\lfloor x/2^{16}\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=0 then floor_scaled:=x-(x mod unity)
+else begin be_careful:=x+1;
+ floor_scaled:=x+((-be_careful) mod unity)+1-unity;
+ end;
+end;
+@#
+function round_unscaled(@!x:scaled):integer;
+ {$\lfloor x/2^{16}+.5\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=half_unit then round_unscaled:=1+((x-half_unit) div unity)
+else if x>=-half_unit then round_unscaled:=0
+else begin be_careful:=x+1;
+ round_unscaled:=-(1+((-be_careful-half_unit) div unity));
+ end;
+end;
+@#
+function round_fraction(@!x:fraction):scaled;
+ {$\lfloor x/2^{12}+.5\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=2048 then round_fraction:=1+((x-2048) div 4096)
+else if x>=-2048 then round_fraction:=0
+else begin be_careful:=x+1;
+ round_fraction:=-(1+((-be_careful-2048) div 4096));
+ end;
+end;
+@y
+@z
+
+@x [9.168] Increase memory size.
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|}
+@z
+
+@x [9.170] Don't bother to subtract zero.
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@d qo(#)==#-min_quarterword {to read eight bits from a quarterword}
+@d qi(#)==#+min_quarterword {to store eight bits in a quarterword}
+@y
+@d ho(#)==#
+@d qo(#)==#
+@d qi(#)==#
+@z
+
+@x [9.171] memory_word is defined externally.
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case three_choices of
+ 1: (@!int:integer);
+ 2: (@!hh:two_halves);
+ 3: (@!qqqq:four_quarters);
+ end;
+@y
+@=#include "texmfmem.h";@>
+@z
+
+@x [9.174] mem is dynamically allocated.
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@y
+@!mem : ^memory_word; {the big dynamic storage area}
+@z
+
+@x [10.184] Fix an unsigned/signed problem in getnode.
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+@y
+if r>intcast(p+1) then @<Allocate from the top of node |p| and |goto found|@>;
+@z
+
+% [11.193] Change the word `free' so that it doesn't conflict with the
+% standard C library routine of the same name. Also change arrays that
+% use mem_max, since that's a variable now, effectively disabling the feature.
+@x
+are debugging.)
+
+@<Glob...@>=
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip1em@>@!was_free: packed array [mem_min..mem_max] of boolean;
+@y
+are debugging.)
+
+@d free==free_arr
+
+@<Glob...@>=
+@!debug @!free: packed array [0..1] of boolean; {free cells}
+@t\hskip1em@>@!was_free: packed array [0..1] of boolean;
+@z
+
+@x [11.197] Eliminate unsigned comparisons to zero.
+repeat if (p>=lo_mem_max)or(p<mem_min) then clobbered:=true
+ else if (rlink(p)>=lo_mem_max)or(rlink(p)<mem_min) then clobbered:=true
+@y
+repeat if (p>=lo_mem_max) then clobbered:=true
+ else if (rlink(p)>=lo_mem_max) then clobbered:=true
+@z
+
+@x [12.212] Do `fix_date_and_time' in C.
+@ The following procedure, which is called just before \MP\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+Note that the values are |scaled| integers. Hence \MP\ can no longer
+be used after the year 32767.
+
+@p procedure fix_date_and_time;
+begin internal[time]:=12*60*unity; {minutes since midnight}
+internal[day]:=4*unity; {fourth day of the month}
+internal[month]:=7*unity; {seventh month of the year}
+internal[year]:=1776*unity; {Anno Domini}
+end;
+@y
+@ The following procedure, which is called just before \MP\ initializes its
+input and output, establishes the initial values of the date and time.
+It is calls an externally defined |date_and_time|, even though it could
+be done from Pascal.
+The external procedure also sets up interrupt catching.
+@^system dependencies@>
+
+Note that the values are |scaled| integers. Hence \MP\ can no longer
+be used after the year 32767.
+
+@p procedure fix_date_and_time;
+begin
+ date_and_time(internal[time],internal[day],internal[month],internal[year]);
+ internal[time] := internal[time] * unity;
+ internal[day] := internal[day] * unity;
+ internal[month] := internal[month] * unity;
+ internal[year] := internal[year] * unity;
+end;
+@z
+
+@x Replace class with c_class to avoid C++ keyword.
+@d max_class=20 {the largest class number}
+@y
+@d max_class=20 {the largest class number}
+@d class==c_class
+@z
+
+@x [12.217] Allow tab and form feed as input.
+for k:=127 to 255 do char_class[k]:=invalid_class;
+@y
+for k:=127 to 255 do char_class[k]:=invalid_class;
+char_class[tab]:=space_class;
+char_class[form_feed]:=space_class;
+@z
+
+@x [18.300,301] l.6451 - Make path_size a configuration option.
+@!delta_x,@!delta_y,@!delta:array[0..path_size] of scaled; {knot differences}
+@!psi:array[1..path_size] of angle; {turning angles}
+
+@ @<Other local variables for |make_choices|@>=
+@!k,@!n:0..path_size; {current and final knot numbers}
+@y
+@!delta_x:^scaled; {knot differences}
+@!delta_y:^scaled; {knot differences}
+@!delta:^scaled; {knot differences}
+@!psi:^angle; {turning angles}
+
+@ @<Other local variables for |make_choices|@>=
+@!k,@!n:0..sup_path_size; {current and final knot numbers}
+@z
+
+@x [18.304] l.6544 - Make path_size a configuration option.
+@!theta:array[0..path_size] of angle; {values of $\theta_k$}
+@!uu:array[0..path_size] of fraction; {values of $u_k$}
+@!vv:array[0..path_size] of angle; {values of $v_k$}
+@!ww:array[0..path_size] of fraction; {values of $w_k$}
+
+@ Our immediate problem is to get the ball rolling by setting up the
+first equation or by realizing that no equations are needed, and to fit
+this initialization into a framework suitable for the overall computation.
+
+@<Declare the procedure called |solve_choices|@>=
+@t\4@>@<Declare subroutines needed by |solve_choices|@>@;
+procedure solve_choices(@!p,@!q:pointer;@!n:halfword);
+label found,exit;
+var @!k:0..path_size; {current knot number}
+@y
+@!theta:^angle; {values of $\theta_k$}
+@!uu:^fraction; {values of $u_k$}
+@!vv:^angle; {values of $v_k$}
+@!ww:^fraction; {values of $w_k$}
+
+@ Our immediate problem is to get the ball rolling by setting up the
+first equation or by realizing that no equations are needed, and to fit
+this initialization into a framework suitable for the overall computation.
+
+@<Declare the procedure called |solve_choices|@>=
+@t\4@>@<Declare subroutines needed by |solve_choices|@>@;
+procedure solve_choices(@!p,@!q:pointer;@!n:halfword);
+label found,exit;
+var @!k:0..sup_path_size; {current knot number}
+@z
+
+@x [27.585] l.11443 - data for file:line:error style.
+@!mpx_name : array[0..max_in_open] of halfword;
+@y
+@!mpx_name : array[0..max_in_open] of halfword;
+@!source_filename_stack : ^str_number;
+@!full_source_filename_stack : ^str_number;
+@z
+
+@x [35.745] area and extension rules.
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters. Note that these variables
+cannot be of type |pool_pointer| because a string pool compaction could occur
+while scanning a file name.
+
+@<Glob...@>=
+@!area_delimiter:integer;
+ {most recent `\.>' or `\.:' relative to |str_start[str_ptr]|}
+@!ext_delimiter:integer; {the relevant `\..', if any}
+@y
+@ The file names we shall deal with have the
+following structure: If the name contains `\./', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters. Note that these variables
+cannot be of type |pool_pointer| because a string pool compaction could occur
+while scanning a file name.
+
+@<Glob...@>=
+@!area_delimiter:integer; {most recent `\./' relative to |str_start[str_ptr]|}
+@!ext_delimiter:integer; {the relevant `\..', if any}
+@z
+
+@x [35.746] MP and MF area directories.
+@d MP_area=="MPinputs:"
+@.MPinputs@>
+@d MF_area=="MFinputs:"
+@.MFinputs@>
+@d MP_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+In C, the default paths are specified separately.
+@z
+
+@x [35.747] filenames: quoted
+area_delimiter:=-1; ext_delimiter:=-1;
+@y
+area_delimiter:=-1; ext_delimiter:=-1; quoted_filename:=false;
+@z
+
+@x [35.748] (more_name) Generalize directory separators.
+begin if c=" " then more_name:=false
+else begin if (c=">")or(c=":") then
+@y
+begin
+if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+ end
+else if ((c=" ")or(c=tab)) and stop_at_space and (not quoted_filename) then
+ more_name:=false
+else begin
+ if IS_DIR_SEP (c) then
+@z
+@x [still 35.748] Last (not first) . is extension.
+ else if (c=".")and(ext_delimiter<0) then
+@y
+ else if (c=".") then
+@z
+
+@x [35.749] (end_name) Quote name if necessary.
+procedure end_name;
+var a,@!n,@!e:pool_pointer; {length of area, name, and extension}
+begin e:=pool_ptr-str_start[str_ptr]; {total length}
+@y
+procedure end_name;
+var a,@!n,@!e:pool_pointer; {length of area, name, and extension}
+@!j,@!s,@!t:pool_pointer; {running indices}
+@!must_quote:boolean; {whether we need to quote a string}
+begin str_room(6); {room for quotes}
+if area_delimiter<>-1 then begin
+ {maybe quote |cur_area|}
+ must_quote:=false;
+ s:=str_start[str_ptr];
+ t:=str_start[str_ptr]+area_delimiter+1;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+ if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>-1 then ext_delimiter:=ext_delimiter+2;
+ area_delimiter:=area_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+ s:=str_start[str_ptr]+area_delimiter+1;
+ end
+else begin
+ s:=str_start[str_ptr];
+ end;
+{maybe quote |cur_name|}
+if ext_delimiter=-1 then t:=pool_ptr else t:=str_start[str_ptr]+ext_delimiter;
+must_quote:=false;
+j:=s;
+while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>-1 then ext_delimiter:=ext_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+if ext_delimiter<>-1 then begin
+ {maybe quote |cur_ext|}
+ s:=str_start[str_ptr]+ext_delimiter;
+ t:=pool_ptr;
+ must_quote:=false;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+ if must_quote then begin
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ pool_ptr:=pool_ptr+2;
+ end;
+ end;
+e:=pool_ptr-str_start[str_ptr]; {total length}
+@z
+
+@x [35.750] print_file_name
+begin print(a); print(n); print(e);
+@y
+var must_quote: boolean; {whether to quote the filename}
+@!j:pool_pointer; {index into |str_pool|}
+begin
+must_quote:=false;
+if a>0 then begin
+ j:=str_start[a];
+ while (not must_quote) and (j<>str_stop(a)) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if n>0 then begin
+ j:=str_start[n];
+ while (not must_quote) and (j<>str_stop(n)) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if e>0 then begin
+ j:=str_start[e];
+ while (not must_quote) and (j<>str_stop(e)) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if must_quote then print("""");
+if a>0 then
+ for j:=str_start[a] to str_stop(a)-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]));
+if n>0 then
+ for j:=str_start[n] to str_stop(n)-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]));
+if e>0 then
+ for j:=str_start[e] to str_stop(e)-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]));
+if must_quote then print("""");
+@z
+
+@x [35.751] macro used in pack_file_name
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+@x [35.751] (pack_file_name) malloc and null terminate name_of_file.
+for j:=str_start[a] to str_stop(a)-1 do append_to_name(so(str_pool[j]));
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file := xmalloc_array (ASCII_code, length(a)+length(n)+length(e)+1);
+for j:=str_start[a] to str_stop(a)-1 do append_to_name(so(str_pool[j]));
+@z
+@x
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length + 1] := 0;
+@z
+
+@x [35.752] default mem area is nonexistent
+@d mem_default_length=15 {length of the |MP_mem_default| string}
+@d mem_area_length=6 {length of its area part}
+@y
+@d mem_area_length=0 {no fixed area in C}
+@z
+
+@x [35.753] Where `plain.mem' is.
+@!MP_mem_default:packed array[1..mem_default_length] of char;
+
+@ @<Set init...@>=
+MP_mem_default:='MPlib:plain.mem';
+@.MPlib@>
+@.plain@>
+@^system dependencies@>
+@y
+@!mem_default_length: integer;
+@!MP_mem_default: ^char;
+@!troff_mode:boolean; {has the user requested \.{troff} mode?}
+
+@ We set the name of the default format file and the length of that name
+in \.{texmfmp.c}, since we want them to depend on the name of the
+program.
+@z
+
+@x [35.755] Change to pack_buffered_name as with pack_file_name.
+for j:=1 to n do append_to_name(xord[MP_mem_default[j]]);
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file := xmalloc_array (ASCII_code, n+(b-a+1)+mem_ext_length+1);
+for j:=1 to n do append_to_name(xord[MP_mem_default[j]]);
+@z
+% @x [35.755] Set program name to match format.
+% for j:=a to b do append_to_name(buffer[j]);
+% @y
+% for j:=a to b do append_to_name(buffer[j]);
+% name_of_file[k+1]:=0;
+% kpse_reset_program_name(name_of_file+1);{set search path to match format}
+% @z
+@x [35.755] Change to pack_buffered_name as with pack_file_name.
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length + 1] := 0;
+@z
+
+@x [35.756] Mem file opening: only try once, with path searching.
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(mem_file) then goto found;
+ pack_buffered_name(mem_area_length,loc,j-1);
+ {now try the system mem file area}
+ if w_open_in(mem_file) then goto found;
+@y
+ pack_buffered_name(0,loc,j-1);
+ if w_open_in(mem_file) then goto found;
+@z
+
+@x [still 35.756] Replace `PLAIN' in error messages with `default'.
+ wterm_ln('Sorry, I can''t find that mem file;',' will try PLAIN.');
+@y
+ wterm ('Sorry, I can''t find the mem file `');
+ fputs (stringcast(name_of_file + 1), stdout);
+ wterm ('''; will try `');
+ fputs (MP_mem_default + 1, stdout);
+ wterm_ln ('''.');
+@z
+@x
+ wterm_ln('I can''t find the PLAIN mem file!');
+@.I can't find PLAIN...@>
+@y
+ wterm ('I can''t find the mem file `');
+ fputs (MP_mem_default + 1, stdout);
+ wterm_ln ('''!');
+@.I can't find the mem...@>
+@z
+
+@x [35.758] Make scan_file_name ignore leading tabs as well as spaces.
+@p procedure scan_file_name;
+label done;
+begin begin_name;
+while buffer[loc]=" " do incr(loc);
+@y
+@p procedure scan_file_name;
+label done;
+begin begin_name;
+while (buffer[loc]=" ")or(buffer[loc]=tab) do incr(loc);
+@z
+
+@x [35.760] `logname' is declared in <unistd.h> on some systems.
+`\.{.mem}' and `\.{.tfm}' in order to make the names of \MP's output files.
+@y
+`\.{.mem}' and `\.{.tfm}' in order to make the names of \MP's output files.
+@d log_name == texmf_log_name
+@z
+
+@x [35.763] prompt_file_name: avoid empty filenames.
+var @!k:0..buf_size; {index into |buffer|}
+@y
+var @!k:0..buf_size; {index into |buffer|}
+@!saved_cur_name:str_number; {to catch empty terminal input}
+@z
+
+@x [35.763] prompt_file_name: avoid empty filenames.
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+@y
+saved_cur_name:=cur_name;
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+if length(cur_name)=0 then cur_name:=saved_cur_name;
+@z
+
+@x [35.764] <Scan file name...> needs similar leading tab treatment.
+@ @<Scan file name in the buffer@>=
+begin begin_name; k:=first;
+while (buffer[k]=" ")and(k<last) do incr(k);
+@y
+@ @<Scan file name in the buffer@>=
+begin begin_name; k:=first;
+while ((buffer[k]=" ")or(buffer[k]=tab))and(k<last) do incr(k);
+@z
+
+@x [35.765] Adjust for C string conventions.
+@!months:packed array [1..36] of char; {abbreviations of month names}
+@y
+@!months:^char;
+@z
+
+@x [35.765] Change name of recorder file.
+if job_name=0 then job_name:="mpout";
+pack_job_name(".log");
+@y
+if job_name=0 then job_name:=get_job_name("mpout");
+pack_job_name(".fls");
+recorder_change_filename(stringcast(name_of_file+1));
+pack_job_name(".log");
+@z
+
+@x [35.767]
+begin wlog(banner);
+print(mem_ident); print(" ");
+print_int(round_unscaled(internal[day])); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@y
+begin wlog(banner);
+wlog (version_string);
+print(mem_ident); print(" ");
+print_int(round_unscaled(internal[day])); print_char(" ");
+months := ' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@z
+
+@x [35.767] l.14341 - Print name of TCX, if given.
+end
+@y
+if translate_filename then begin
+ wlog_cr;
+ wlog('(');
+ fputs(translate_filename, log_file);
+ wlog(')');
+end;
+end
+@z
+
+@x [35.768] (try_extension) a_open_in of input file needs path specifier.
+begin pack_file_name(cur_name,cur_area,ext);
+in_name:=cur_name; in_area:=cur_area;
+if a_open_in(cur_file) then try_extension:=true
+else begin if str_vs_str(ext,".mf")=0 then in_area:=MF_area
+ else in_area:=MP_area;
+ pack_file_name(cur_name,in_area,ext);
+ try_extension:=a_open_in(cur_file);
+ end;
+@y
+{|cur_ext| will be \.{two} if the filename was \.{one.two}.}
+begin pack_file_name(cur_name,cur_area,cur_ext);
+in_name:=cur_name; in_area:=cur_area;
+{The extension is not relevant for determining whether we're allowed to
+ open the file.}
+if not open_in_name_ok(stringcast(name_of_file+1)) then try_extension:=false
+else if str_vs_str(ext,".mf")=0 then
+ try_extension:=a_open_in(cur_file, kpse_mf_format)
+else try_extension:=a_open_in(cur_file, kpse_mp_format);
+@z
+
+@x [35.770] We need another loop variable.
+@p procedure start_input; {\MP\ will \.{input} something}
+label done;
+@y
+@p procedure start_input; {\MP\ will \.{input} something}
+label done;
+var j:integer;
+@z
+
+@x [still 35.770] Kpathsea already tries with no extension.
+ if cur_ext="" then
+ if try_extension(".mp") then goto done
+ else if try_extension("") then goto done
+ else if try_extension(".mf") then goto done
+ else do_nothing
+ else if try_extension(cur_ext) then goto done;
+@y
+ if try_extension(".mp") then goto done
+ else if try_extension(".mf") then goto done
+ else do_nothing;
+@z
+
+@x [still 35.770] Allow jobname to be `one.two'.
+ begin job_name:=cur_name; str_ref[job_name]:=max_str_ref;
+@y
+ begin
+ j:=1;
+ begin_name;
+ stop_at_space:=false;
+ while (j<=name_length)and(more_name(name_of_file[j])) do
+ incr(j);
+ stop_at_space:=true;
+ end_name;
+ job_name:=get_job_name(cur_name);
+ str_ref[job_name] := max_str_ref;
+@z
+
+@x [35.771] Cannot return name to string pool, for the e option?
+flush_string(name); name:=cur_name; cur_name:=0
+@y
+@z
+
+@x [35.774] (copy_old_name) Allocate old_file_name dynamically.
+for j:=str_start[s] to str_stop(s)-1 do
+@y
+if old_file_name then libc_free (old_file_name);
+old_file_name := xmalloc_array (ASCII_code, length(s)+1);
+for j:=str_start[s] to str_stop(s)-1 do
+@z
+@x [still 35.774] Avoid blanking rest of nonexistent array.
+for k:=old_name_length+1 to file_name_size do @+old_file_name[k]:=' ';
+@y
+old_file_name[old_name_length + 1] := 0;
+@z
+
+@x [35.775] Declare old_file_name as a regular C string.
+@!old_file_name : packed array[1..file_name_size] of char;
+@y
+@!old_file_name : ^text_char;
+@z
+
+@x [35.776] [Unique to MP] Path selector for |a_open_in| of mpx file.
+if not a_open_in(cur_file) then
+ begin end_file_reading;
+@y
+if not a_open_in(cur_file,no_file_path) then
+ begin end_file_reading;
+@z
+
+@x [35.777] [Unique to MP] Invoke |makempx|.
+copy_old_name(name)
+{System-dependent code should be added here}
+@y
+copy_old_name (name);
+if not call_make_mpx (stringcast(old_file_name+1), stringcast(name_of_file+1))
+ then goto not_found
+@z
+
+@x [35.778] [Unique to MP] Fix help message for our implementation.
+ ("try running it manually through MPtoTeX, TeX, and DVItoMP");
+@y
+ ("try running it manually through MPto -tex, TeX, and DVItoMP.");
+@z
+
+@x [35.782] [Unique to MP] Path selector for |a_open_in| of readfrom file.
+if not a_open_in(rd_file[n]) then goto not_found;
+@y
+if not open_in_name_ok(stringcast(name_of_file+1))
+ or not a_open_in(rd_file[n],kpse_mp_format) then goto not_found;
+@z
+
+@x [35.783] The Amiga needs a different open_write_file.
+@ Open |wr_file[n]| using file name~|s| and update |wr_fname[n]|.
+
+@p procedure open_write_file(s:str_number; n:readf_index);
+begin str_scan_file(s);
+pack_cur_name;
+while not a_open_out(wr_file[n]) do
+ prompt_file_name("file name for write output","");
+wr_fname[n]:=s;
+add_str_ref(s);
+end;
+@y
+@ Open |wr_file[n]| using file name~|s| and update |wr_fname[n]|.
+The Amiga operating system does not permit write access to a file that is
+currently opened in read mode. To avoid disaster, we look for the file to
+be opened in the list of |read_from| files and close it if present.
+
+@d amiga==ifdef('AMIGA')
+@d agima==endif('AMIGA')
+@f amiga==begin
+@f agima==end
+
+@p procedure open_write_file(s:str_number; n:readf_index);
+amiga@;
+label done;
+var @!n0:readf_index; {Scratch variable}
+agima@;
+begin
+ str_scan_file(s);
+ pack_cur_name;
+amiga@;
+ for n0:=0 to read_files-1 do begin
+ if rd_fname[n0]<>0 then begin
+ if str_vs_str(s,rd_fname[n0])=0 then begin
+ a_close(rd_file[n0]);
+ delete_str_ref(rd_fname[n0]);
+ rd_fname[n0]:=0;
+ if n0=read_files-1 then read_files:=n0;
+ goto done;
+ end;
+ end;
+ end;
+done: do_nothing;
+agima@;
+while not open_out_name_ok(stringcast(name_of_file+1))
+ or not a_open_out(wr_file[n]) do
+ prompt_file_name("file name for write output","");
+wr_fname[n]:=s;
+add_str_ref(s);
+{If on first line of input, log file is not ready yet, so don't log.}
+if log_opened then begin
+ old_setting:=selector;
+ if (internal[tracing_online]<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ print_nl("write");
+ print_int(n);
+ print(" = `");
+ print_file_name(cur_name,cur_area,cur_ext);
+ print("'."); print_nl(""); print_ln;
+ selector:=old_setting;
+end;
+end;
+@z
+
+@x [41.1040] if batchmode, MakeTeX... scripts should be silent.
+mode_command: begin print_ln; interaction:=cur_mod;
+@y
+mode_command: begin print_ln; interaction:=cur_mod;
+if interaction = batch_mode
+then kpse_make_tex_discard_errors := 1
+else kpse_make_tex_discard_errors := 0;
+@z
+
+@x [42.1151] Fix `threshold' conflict with local variable name.
+@p function threshold(@!m:integer):scaled;
+var @!d:scaled; {lower bound on the smallest interval size}
+begin excess:=min_cover(0)-m;
+if excess<=0 then threshold:=0
+else begin repeat d:=perturbation;
+ until min_cover(d+d)<=m;
+ while min_cover(d)>m do d:=perturbation;
+ threshold:=d;
+ end;
+end;
+@y
+@p function compute_threshold(@!m:integer):scaled;
+var @!d:scaled; {lower bound on the smallest interval size}
+begin excess:=min_cover(0)-m;
+if excess<=0 then compute_threshold:=0
+else begin repeat d:=perturbation;
+ until min_cover(d+d)<=m;
+ while min_cover(d)>m do d:=perturbation;
+ compute_threshold:=d;
+ end;
+end;
+@z
+
+@x [42.1152] Change the call to the threshold function.
+begin d:=threshold(m); perturbation:=0;
+@y
+begin d:=compute_threshold(m); perturbation:=0;
+@z
+
+@x [45.1164] Writing the tfm file.
+@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|}
+
+@p procedure tfm_two(@!x:integer); {output two bytes to |tfm_file|}
+begin tfm_out(x div 256); tfm_out(x mod 256);
+end;
+@#
+procedure tfm_four(@!x:integer); {output four bytes to |tfm_file|}
+begin if x>=0 then tfm_out(x div three_bytes)
+else begin x:=x+@'10000000000; {use two's complement for negative values}
+ x:=x+@'10000000000;
+ tfm_out((x div three_bytes) + 128);
+ end;
+x:=x mod three_bytes; tfm_out(x div unity);
+x:=x mod unity; tfm_out(x div @'400);
+tfm_out(x mod @'400);
+end;
+@#
+procedure tfm_qqqq(@!x:four_quarters); {output four quarterwords to |tfm_file|}
+@y
+The default definitions don't work. Why not? So use C macros.
+
+@d tfm_out(#) == put_byte (#, tfm_file)
+@d tfm_two(#) == put_2_bytes (tfm_file, #)
+@d tfm_four(#) == put_4_bytes (tfm_file, #)
+
+@p procedure tfm_qqqq(@!x:four_quarters); {output four quarterwords to |tfm_file|}
+@z
+
+@x [42.1165] print_file_name
+print_nl("Font metrics written on "); print(metric_file_name); print_char(".");
+@y
+print_nl("Font metrics written on ");
+print_file_name(0,metric_file_name,0);
+print_char(".");
+@z
+
+% [43.1182] [See TeX module 564] Reading tfm files. As a special case,
+% whenever we open a tfm file for input, we read its first byte into
+% "tfm_temp" right away.
+@x
+@d tfget==get(tfm_infile)
+@d tfbyte==tfm_infile^
+@y
+@d tfget==tfm_temp:=getc(tfm_infile)
+@d tfbyte==tfm_temp
+@z
+
+% [43.1186] [See TeX module 575] We only want `eof' on the TFM file
+% to be true if we previously had EOF, not if we're at EOF now.
+% This is like `feof', and unlike our implementation of `eof' elsewhere.
+@x
+if eof(tfm_infile) then goto bad_tfm;
+@y
+if feof(tfm_infile) then goto bad_tfm;
+@z
+
+% [43.1188] [See TeX module 563] TFM file opening.
+@x
+if cur_area="" then cur_area:=MP_font_area;
+if cur_ext="" then cur_ext:=".tfm";
+pack_cur_name;
+@y
+if cur_ext="" then cur_ext:=".tfm";
+pack_cur_name;
+@z
+
+@x [43.1195] [Unique to MP] Path selector for |a_open_in| of ps_tab_file.
+begin name_of_file:=ps_tab_name;
+if a_open_in(ps_tab_file) then
+@y
+begin
+name_length := strlen (ps_tab_name);
+name_of_file := xmalloc_array (ASCII_code, name_length+1);
+strcpy (stringcast(name_of_file+1), ps_tab_name); {copy the string}
+if a_open_in(ps_tab_file, kpse_fontmap_format) then
+@z
+
+@x [43.1198] Allow blank lines and comment lines in |ps_tab_file|.
+@ @<Read at most |lmax| characters from |ps_tab_file| into string |s|...@>=
+str_room(lmax);
+j:=lmax;
+loop @+begin if eoln(ps_tab_file) then
+ fatal_error("The psfont map file is bad!");
+ read(ps_tab_file,c);
+ if c=' ' then goto done;
+@y
+@ If we encounter the end of line before we have started reading
+characters from |ps_tab_file|, we have found an entirely blank
+line and we skip over it. Otherwise, we abort if the line ends
+prematurely. If we encounter a comment character, we also skip
+over the line, since recent versions of \.{dvips} allow comments
+in the font map file.
+
+@<Read at most |lmax| characters from |ps_tab_file| into string |s|...@>=
+str_room(lmax);
+j:=lmax;
+loop @+begin if eoln(ps_tab_file) then
+ if j=lmax then begin flush_cur_string;
+ goto common_ending; {skip over blank line}
+ end
+ else fatal_error("The psfonts.map file is bad!");
+ read(ps_tab_file,c);
+ if ((c='%')or(c='*')or(c=';')or(c='#')) then begin flush_cur_string;
+ goto common_ending; {skip over comment line}
+ end;
+ if ((c=' ')or(c=tab)) then goto done;
+@z
+
+@x [43.1199] Allow tabs as field seperators in |ps_tab_file|.
+repeat if eoln(ps_tab_file) then fatal_error("The psfont map file is bad!");
+ read(ps_tab_file,c);
+until c<>' ';
+repeat decr(j);
+ if j<0 then fatal_error("The psfont map file is bad!");
+ append_char(xord[c]);
+ if eoln(ps_tab_file) then c:=' ' @+else read(ps_tab_file,c);
+until c=' ';
+@y
+repeat if eoln(ps_tab_file) then fatal_error("The psfonts.map file is bad!");
+ read(ps_tab_file,c);
+until ((c<>' ')and(c<>tab));
+repeat decr(j);
+ if j<0 then fatal_error("The psfonts.map file is bad!");
+ append_char(xord[c]);
+ if eoln(ps_tab_file) then c:=' ' @+else read(ps_tab_file,c);
+until ((c=' ')or(c=tab));
+@z
+
+@x [44.1208] l.21341 - i18n fix
+ print(" output file");
+ if total_shipped>1 then print_char("s");
+@y
+ print(" output ");
+ if total_shipped>1 then print("files")
+ else print("file");
+@z
+
+@x [44.1208] print_file_name
+ print(first_file_name);
+@y
+ print_file_name(0,first_file_name,0);
+@z
+@x [44.1208 print_file_name
+ print(last_file_name);
+@y
+ print_file_name(0,last_file_name,0);
+@z
+
+@x [45.1279] INI = VIR.
+mem_ident:=" (INIMP)";
+@y
+if ini_version then mem_ident:=" (INIMP)";
+@z
+
+@x [45.1280] Add base_engine.
+@!w: four_quarters; {four ASCII codes}
+@y
+@!w: four_quarters; {four ASCII codes}
+@!base_engine: ^text_char;
+@z
+
+@x [45.1281] Add base_engine.
+@!w: four_quarters; {four ASCII codes}
+@y
+@!w: four_quarters; {four ASCII codes}
+@!base_engine: ^text_char;
+@!dummy_xord: ASCII_code;
+@!dummy_xchr: text_char;
+@!dummy_xprn: ASCII_code;
+@z
+
+@x [45.1282] Reading and writing of `mem_file' done in C.
+@d dump_wd(#)==begin mem_file^:=#; put(mem_file);@+end
+@d dump_int(#)==begin mem_file^.int:=#; put(mem_file);@+end
+@d dump_hh(#)==begin mem_file^.hh:=#; put(mem_file);@+end
+@d dump_qqqq(#)==begin mem_file^.qqqq:=#; put(mem_file);@+end
+@y
+@z
+
+@x [45.1283]
+@d undump_wd(#)==begin get(mem_file); #:=mem_file^;@+end
+@d undump_int(#)==begin get(mem_file); #:=mem_file^.int;@+end
+@d undump_hh(#)==begin get(mem_file); #:=mem_file^.hh;@+end
+@d undump_qqqq(#)==begin get(mem_file); #:=mem_file^.qqqq;@+end
+@y
+@z
+
+@x [45.1284]
+dump_int(@$);@/
+@y
+dump_int(@"57324D50); {Web2C \MP's magic constant: "W2MP"}
+{Align engine to 4 bytes with one or more trailing NUL}
+x:=strlen(engine_name);
+base_engine:=xmalloc_array(text_char,x+4);
+strcpy(base_engine, engine_name);
+for k:=x to x+3 do base_engine[k]:=0;
+x:=x+4-(x mod 4);
+dump_int(x);dump_things(base_engine[0], x);
+libc_free(base_engine);@/
+dump_int(@$);@/
+@<Dump |xord|, |xchr|, and |xprn|@>;
+@z
+
+@x [45.1285] Avoid Pascal file convention.
+x:=mem_file^.int;
+if x<>@$ then goto off_base; {check that strings are the same}
+undump_int(x);
+if x<>mem_min then goto off_base;
+undump_int(x);
+if x<>mem_top then goto off_base;
+@y
+undump_int(x);
+if x<>@"57324D50 then goto off_base; {not a base file}
+undump_int(x);
+if (x<0) or (x>256) then goto off_base; {corrupted base file}
+base_engine:=xmalloc_array(text_char, x);
+undump_things(base_engine[0], x);
+base_engine[x-1]:=0; {force string termination, just in case}
+if strcmp(engine_name, base_engine) then
+ begin wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' was written by ', base_engine);
+ libc_free(base_engine);
+ goto off_base;
+end;
+libc_free(base_engine);
+undump_int(x);
+if x<>@$ then begin {check that strings are the same}
+ wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' doesn''t match ', pool_name);
+ goto off_base;
+end;
+@<Undump |xord|, |xchr|, and |xprn|@>;
+undump_int(x);
+if x<>mem_min then goto off_base;
+{Dynamic allocation \`a la \.{mf.ch}.}
+@+init
+if ini_version then begin
+ {We allocated these at start-up, but now we need to reallocate.}
+ libc_free (mem);
+ libc_free (str_ref);
+ libc_free (next_str);
+ libc_free (str_start);
+ libc_free (str_pool);
+end;
+@+tini
+undump_int(mem_top);
+if mem_max < mem_top then mem_max:=mem_top; {Use at least what we dumped.}
+if mem_min+1100>mem_top then goto off_base;
+mem_max := mem_top + extra_mem_top;
+mem:=xmalloc_array (memory_word, mem_max - mem_min + 1);
+@z
+
+@x [45.1287] String pool undumping is dynamic.
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings-1)('max strings')(max_str_ptr);
+@y
+undump_size(0)(sup_pool_size-pool_free)('string pool size')(pool_ptr);
+if pool_size < pool_ptr + pool_free then
+ pool_size := pool_ptr+pool_free;
+undump_size(0)(sup_max_strings)('max strings')(max_str_ptr);
+@/
+str_ref:=xmalloc_array (str_ref_type, max_strings);
+next_str:=xmalloc_array (str_number, max_strings);
+str_start:=xmalloc_array (pool_pointer, max_strings);
+str_pool:=xmalloc_array (pool_ASCII_code, pool_size);
+@z
+
+@x [45.1293] l.22667 - Allow command line to override dumped value.
+undump(batch_mode)(error_stop_mode)(interaction);
+@y
+undump(batch_mode)(error_stop_mode)(interaction);
+if interaction_option<>unspecified_mode then interaction:=interaction_option;
+@z
+
+@x [45.1293] eof is like feof here.
+undump_int(x);@+if (x<>69073)or eof(mem_file) then goto off_base
+@y
+undump_int(x);@+if (x<>69073)or feof(mem_file) then goto off_base
+@z
+
+@x [45.1294] Eliminate probably-wrong word `preloaded' from mem_idents.
+print(" (preloaded mem="); print(job_name); print_char(" ");
+print_int(round_unscaled(internal[year]) mod 100); print_char(".");
+@y
+print(" (mem="); print(job_name); print_char(" ");
+print_int(round_unscaled(internal[year])); print_char(".");
+@z
+
+@x [46.1298] Dynamic allocation.
+@p begin @!{|start_here|}
+@y
+@d const_chk(#) == begin if # < inf@&# then # := inf@&# else
+ if # > sup@&# then # := sup@&# end
+{|setup_bound_var| stuff duplicated in \.{tex.ch}.}
+@d setup_bound_var(#) == bound_default := #; setup_bound_var_end
+@d setup_bound_var_end(#) == bound_name := #; setup_bound_var_end_end
+@d setup_bound_var_end_end(#) ==
+ setup_bound_variable (address_of (#), bound_name, bound_default);
+
+@p begin @!{|start_here|}
+ {See comments in \.{tex.ch} for why the name has to be duplicated.}
+ setup_bound_var (250000)('main_memory')(main_memory);
+ {|memory_word|s for |mem| in \.{INIMP}}
+ setup_bound_var (0)('extra_mem_top')(extra_mem_top);
+ {increase high mem in \.{VIRMP}}
+ setup_bound_var (100000)('pool_size')(pool_size);
+ setup_bound_var (75000)('string_vacancies')(string_vacancies);
+ setup_bound_var (3000)('buf_size')(buf_size);
+ setup_bound_var (2000)('path_size')(path_size);
+ setup_bound_var (5000)('pool_free')(pool_free); {min pool avail after fmt}
+ setup_bound_var (15000)('max_strings')(max_strings);
+ setup_bound_var (79)('error_line')(error_line);
+ setup_bound_var (50)('half_error_line')(half_error_line);
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ if error_line > ssup_error_line then error_line := ssup_error_line;
+
+ const_chk (main_memory);
+@+init
+ if ini_version then
+ extra_mem_top := 0;
+@+tini
+ if extra_mem_top>sup_main_memory then extra_mem_top:=sup_main_memory;
+ mem_top := mem_min + main_memory - 1;
+ mem_max := mem_top;
+
+ const_chk (pool_size);
+ const_chk (string_vacancies);
+ const_chk (buf_size);
+ const_chk (path_size);
+ const_chk (pool_free);
+ const_chk (max_strings);
+
+ buffer:=xmalloc_array (ASCII_code, buf_size);
+ delta_x:=xmalloc_array (scaled, path_size);
+ delta_y:=xmalloc_array (scaled, path_size);
+ delta:=xmalloc_array (scaled, path_size);
+ psi:=xmalloc_array (angle, path_size);
+ theta:=xmalloc_array (angle, path_size);
+ uu:=xmalloc_array (fraction, path_size);
+ vv:=xmalloc_array (angle, path_size);
+ ww:=xmalloc_array (fraction, path_size);
+ source_filename_stack:=xmalloc_array (str_number, max_in_open);
+ full_source_filename_stack:=xmalloc_array (str_number, max_in_open);
+
+@+init
+if ini_version then begin
+ mem:=xmalloc_array (memory_word, mem_top - mem_min + 1);
+
+ str_ref:=xmalloc_array (str_ref_type, max_strings);
+ next_str:=xmalloc_array (str_number, max_strings);
+ str_start:=xmalloc_array (pool_pointer, max_strings);
+ str_pool:=xmalloc_array (pool_ASCII_code, pool_size);
+end;
+@+tini
+@z
+
+@x [46.1298] Only do get_strings_started etc. if ini.
+@!init if not get_strings_started then goto final_end;
+init_tab; {initialize the tables}
+init_prim; {call |primitive| for each primitive}
+init_str_use:=str_ptr; init_pool_ptr:=pool_ptr;@/
+max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr;
+fix_date_and_time;
+@y
+@!init if ini_version then begin
+if not get_strings_started then goto final_end;
+init_tab; {initialize the tables}
+init_prim; {call |primitive| for each primitive}
+init_str_use:=str_ptr; init_pool_ptr:=pool_ptr;@/
+max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr;
+fix_date_and_time;
+end;
+@z
+
+@x [46.1298] Set internal[prologues] in troff mode.
+history:=spotless; {ready to go!}
+@y
+history:=spotless; {ready to go!}
+if troff_mode then @+internal[prologues]:=unity;
+@z
+
+@x [46.1298] Call do_final_end.
+end_of_MP: close_files_and_terminate;
+final_end: ready_already:=0;
+@y
+close_files_and_terminate;
+final_end: do_final_end;
+@z
+
+@x [46.1299] Print new line before termination; maybe switch to editor.
+ print(log_name); print_char(".");
+ end;
+ end;
+@y
+ print_file_name(0,log_name,0); print_char(".");
+ end;
+ end;
+print_ln;
+if (edit_name_start<>0) and (interaction>batch_mode) then
+ call_edit(str_pool,edit_name_start,edit_name_length,edit_line);
+@z
+
+@x [46.1304] (final_cleanup) Only do dump if ini.
+ begin @!init store_mem_file; return;@+tini@/
+@y
+ begin @!init if ini_version then begin store_mem_file; return;end;@+tini@/
+@z
+
+@x [46.1306] l.22937 - Handle %&mem line
+if (mem_ident=0)or(buffer[loc]="&") then
+@y
+if (mem_ident=0)or(buffer[loc]="&")or dump_line then
+@z
+
+@x [46.1307] l.23004
+sys_random_seed := (internal[time] div unity)+internal[day];@/
+@y
+sys_random_seed := get_random_seed;@/
+@z
+
+@x [47.1307] Change read of integer.
+ read(term_in,m);
+ if m<0 then return
+ else if m=0 then
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+ else begin read(term_in,n);
+@y
+ m:=input_int (stdin);
+ if m<0 then return
+ else if m=0 then
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+ else begin n:=input_int (stdin);
+@z
+
+@x [47.1308]
+13: begin read(term_in,l); print_cmd_mod(n,l);
+@y
+13: begin l:=input_int (stdin); print_cmd_mod(n,l);
+@z
+
+@x [48.1309] Add editor-switch variable to globals.
+This section should be replaced, if necessary, by any special
+modification of the program
+that are necessary to make \MP\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Here are the variables used to hold ``switch-to-editor'' information.
+@^system dependencies@>
+
+@<Global...@>=
+@!edit_name_start: pool_pointer;
+@!edit_name_length,@!edit_line: integer;
+@!xprn: array[ASCII_code] of ASCII_code; {use \.{\^\^} notation?}
+@!stop_at_space: boolean; {whether |more_name| returns false for space}
+
+@ The |edit_name_start| will be set to point into |str_pool| somewhere after
+its beginning if \MP\ is supposed to switch to an editor on exit.
+
+@<Set init...@>=
+edit_name_start:=0;
+stop_at_space:=true;
+
+@ Dumping the |xord|, |xchr|, and |xprn| arrays. We dump these always
+in the format, so a TCX file loaded during format creation can set a
+default for users of the format.
+
+@<Dump |xord|, |xchr|, and |xprn|@>=
+dump_things(xord[0], 256);
+dump_things(xchr[0], 256);
+dump_things(xprn[0], 256);
+
+@ Undumping the |xord|, |xchr|, and |xprn| arrays. This code is more
+complicated, because we want to ensure that a TCX file specified on
+the command line will override whatever is in the format. Since the
+tcx file has already been loaded, that implies throwing away the data
+in the format. Also, if no |translate_filename| is given, but
+|eight_bit_p| is set we have to make all characters printable.
+
+@<Undump |xord|, |xchr|, and |xprn|@>=
+if translate_filename then begin
+ for k:=0 to 255 do undump_things(dummy_xord, 1);
+ for k:=0 to 255 do undump_things(dummy_xchr, 1);
+ for k:=0 to 255 do undump_things(dummy_xprn, 1);
+ end
+else begin
+ undump_things(xord[0], 256);
+ undump_things(xchr[0], 256);
+ undump_things(xprn[0], 256);
+ if eight_bit_p then
+ for k:=0 to 255 do
+ xprn[k]:=1;
+end;
+
+@ Web2c is deficient, and can only translate pointers to a type
+identifier, not a general type. Easier, if more annoying, to introduce
+this extra definition than to fix Web2c.
+
+@<Types...@> =
+@!str_ref_type = 0..max_str_ref;
+@z
diff --git a/Build/source/texk/web2c/mp.web b/Build/source/texk/web2c/mp.web
new file mode 100644
index 00000000000..93481bc1598
--- /dev/null
+++ b/Build/source/texk/web2c/mp.web
@@ -0,0 +1,23247 @@
+% $Id: mp.web,v 1.5 2005/06/22 17:06:28 olaf Exp $
+% MetaPost, by John Hobby. Public domain.
+
+% Much of this program was copied with permission from MF.web Version 1.9
+% It interprets a language very similar to D.E. Knuth's METAFONT, but with
+% changes designed to make it more suitable for PostScript output.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+% PostScript is a trademark of Adobe Systems Incorporated.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\def\PASCAL{Pascal}
+\def\ps{PostScript}
+\def\ph{\hbox{Pascal-H}}
+\def\psqrt#1{\sqrt{\mathstrut#1}}
+\def\k{_{k+1}}
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\font\tenlogo=logo10 % font used for the METAFONT logo
+\font\logos=logosl10
+\def\MF{{\tenlogo META}\-{\tenlogo FONT}}
+\def\MP{{\tenlogo META}\-{\tenlogo POST}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+\let\swap=\leftrightarrow
+\def\round{\mathop{\rm round}\nolimits}
+\mathchardef\vb="026A % synonym for `\|'
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+\outer\def\N#1. \[#2]#3.{\MN#1.\vfil\eject % begin starred section
+ \def\rhead{PART #2:\uppercase{#3}} % define running headline
+ \message{*\modno} % progress report
+ \edef\next{\write\cont{\Z{\?#2]#3}{\modno}{\the\pageno}}}\next
+ \ifon\startsection{\bf\ignorespaces#3.\quad}\ignorespaces}
+\let\?=\relax % we want to be able to \write a \?
+
+\def\title{MetaPost}
+\def\topofcontents{\hsize 5.5in
+ \vglue -30pt plus 1fil minus 1.5in
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+\pageno=3
+\def\glob{13} % this should be the section number of "<Global...>"
+\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
+
+@* \[1] Introduction.
+This is \MP, a graphics-language processor based on D. E. Knuth's \MF.
+The \PASCAL\ program that follows defines a standard version
+@:PASCAL}{\PASCAL@>
+of \MP\ that is designed to be highly portable so that identical output
+will be obtainable on a great variety of computers.
+
+The main purpose of the following program is to explain the algorithms of \MP\
+as clearly as possible. As a result, the program will not necessarily be very
+efficient when a particular \PASCAL\ compiler has translated it into a
+particular machine language. However, the program has been written so that it
+can be tuned to run efficiently in a wide variety of operating environments
+by making comparatively few changes. Such flexibility is possible because
+the documentation that follows is written in the \.{WEB} language, which is
+at a higher level than \PASCAL; the preprocessing step that converts \.{WEB}
+to \PASCAL\ is able to introduce most of the necessary refinements.
+Semi-automatic translation to other languages is also feasible, because the
+program below does not make extensive use of features that are peculiar to
+\PASCAL.
+
+A large piece of software like \MP\ has inherent complexity that cannot
+be reduced below a certain level of difficulty, although each individual
+part is fairly simple by itself. The \.{WEB} language is intended to make
+the algorithms as readable as possible, by reflecting the way the
+individual program pieces fit together and by providing the
+cross-references that connect different parts. Detailed comments about
+what is going on, and about why things were done in certain ways, have
+been liberally sprinkled throughout the program. These comments explain
+features of the implementation, but they rarely attempt to explain the
+\MP\ language itself, since the reader is supposed to be familiar with
+{\sl The {\logos METAFONT\/}book} as well as the manual
+@.WEB@>
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+{\sl A User's Manual for MetaPost}, Computing Science Technical Report 162,
+AT\AM T Bell Laboratories.
+
+@ The present implementation is a preliminary version, but the possibilities
+for new features are limited by the desire to remain as nearly compatible
+with \MF\ as possible.
+
+On the other hand, the \.{WEB} description can be extended without changing
+the core of the program, and it has been designed so that such
+extensions are not extremely difficult to make.
+The |banner| string defined here should be changed whenever \MP\
+undergoes any modifications, so that it will be clear which version of
+\MP\ might be the guilty party when a problem arises.
+@^extensions to \MP@>
+@^system dependencies@>
+
+@d banner=='This is MetaPost, Version 0.901' {printed when \MP\ starts}
+@d metapost_version=="0.901"
+
+@ Different \PASCAL s have slightly different conventions, and the present
+@!@:PASCAL H}{\ph@>
+program is expressed in a version of \PASCAL\ that D. E. Knuth used for \MF.
+Constructions that apply to
+this particular compiler, which we shall call \ph, should help the
+reader see how to make an appropriate interface for other systems
+if necessary. (\ph\ is Charles Hedrick's modification of a compiler
+@^Hedrick, Charles Locke@>
+for the DECsystem-10 that was originally developed at the University of
+Hamburg; cf.\ {\sl SOFTWARE---Practice \AM\ Experience \bf6} (1976),
+29--42. The \MP\ program below is intended to be adaptable, without
+extensive changes, to most other versions of \PASCAL\ and commonly used
+\PASCAL-to-C translators, so it does not fully
+@!@:C@>
+use the admirable features of \ph. Indeed, a conscious effort has been
+made here to avoid using several idiosyncratic features of standard
+\PASCAL\ itself, so that most of the code can be translated mechanically
+into other high-level languages. For example, the `\&{with}' and `\\{new}'
+features are not used, nor are pointer types, set types, or enumerated
+scalar types; there are no `\&{var}' parameters, except in the case of files;
+there are no tag fields on variant records; there are no |real| variables;
+no procedures are declared local to other procedures.)
+
+The portions of this program that involve system-dependent code, where
+changes might be necessary because of differences between \PASCAL\ compilers
+and/or differences between
+operating systems, can be identified by looking at the sections whose
+numbers are listed under `system dependencies' in the index. Furthermore,
+the index entries for `dirty \PASCAL' list all places where the restrictions
+of \PASCAL\ have not been followed perfectly, for one reason or another.
+@!@^system dependencies@>
+@!@^dirty \PASCAL@>
+
+@ The program begins with a normal \PASCAL\ program heading, whose
+components will be filled in later, using the conventions of \.{WEB}.
+@.WEB@>
+For example, the portion of the program called `\X\glob:Global
+variables\X' below will be replaced by a sequence of variable declarations
+that starts in $\section\glob$ of this documentation. In this way, we are able
+to define each individual global variable when we are prepared to
+understand what it means; we do not have to define all of the globals at
+once. Cross references in $\section\glob$, where it says ``See also
+sections \gglob, \dots,'' also make it possible to look at the set of
+all global variables, if desired. Similar remarks apply to the other
+portions of the program heading.
+
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \MP\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+
+@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:}
+@f mtype==type {`\&{mtype}' will be equivalent to `\&{type}'}
+@f type==true {but `|type|' will not be treated as a reserved word}
+
+@p @t\4@>@<Compiler directives@>@/
+program MP; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+mtype @<Types in the outer block@>@/
+var @<Global variables@>@/
+@#
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values of key variables@>@/
+ end;@#
+@t\4@>@<Basic printing procedures@>@/
+@t\4@>@<Error handling procedures@>@/
+
+@ The overall \MP\ program begins with the heading just shown, after which
+comes a bunch of procedure declarations and function declarations.
+Finally we will get to the main program, which begins with the
+comment `|start_here|'. If you want to skip down to the
+main program now, you can look up `|start_here|' in the index.
+But the author suggests that the best way to understand this program
+is to follow pretty much the order of \MP's components as they appear in the
+\.{WEB} description you are now reading, since the present ordering is
+intended to combine the advantages of the ``bottom up'' and ``top down''
+approaches to the problem of understanding a somewhat complicated system.
+
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_MP=1 {go here when \MP's variables are initialized}
+@d end_of_MP=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_MP@t\hskip-2pt@>, end_of_MP@t\hskip-2pt@>,@,final_end;
+ {key control points}
+
+@ Some of the code below is intended to be used only when diagnosing the
+strange behavior that sometimes occurs when \MP\ is being installed or
+when system wizards are fooling around with \MP\ without quite knowing
+what they are doing. Such code will not normally be compiled; it is
+delimited by the codewords `$|debug|\ldots|gubed|$', with apologies
+to people who wish to preserve the purity of English.
+
+Similarly, there is some conditional code delimited by
+`$|stat|\ldots|tats|$' that is intended for use when statistics are to be
+kept about \MP's memory usage.
+@^debugging@>
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@f stat==begin
+@f tats==end
+
+@ This program has two important variations: (1) There is a long and slow
+version called \.{INIMP}, which does the extra calculations needed to
+@.INIMP@>
+initialize \MP's internal tables; and (2)~there is a shorter and faster
+production version, which cuts the initialization to a bare minimum.
+Parts of the program that are needed in (1) but not in (2) are delimited by
+the codewords `$|init|\ldots|tini|$'.
+
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@f init==begin
+@f tini==end
+
+@ If the first character of a \PASCAL\ comment is a dollar sign,
+\ph\ treats the comment as a list of ``compiler directives'' that will
+affect the translation of this program into machine language. The
+directives shown below specify full checking and inclusion of the \PASCAL\
+debugger when \MP\ is being debugged, but they cause range checking and other
+redundant code to be eliminated when the production system is being generated.
+Arithmetic overflow will be detected in all cases.
+@^system dependencies@>
+@^Overflow in arithmetic@>
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ This \MP\ implementation conforms to the rules of the {\sl Pascal User
+@:PASCAL}{\PASCAL@>
+@^system dependencies@>
+Manual} published by Jensen and Wirth in 1975, except where system-dependent
+@^Wirth, Niklaus@>
+@^Jensen, Kathleen@>
+code is necessary to make a useful system program, and except in another
+respect where such conformity would unnecessarily obscure the meaning
+and clutter up the code: We assume that |case| statements may include a
+default case that applies if no matching label is found. Thus, we shall use
+constructions like
+$$\vbox{\halign{\ignorespaces#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the \ph\
+compiler allows `|others|:' as a default label, and other \PASCAL s allow
+syntaxes like `\&{else}' or `\&{otherwise}' or `\\{otherwise}:', etc. The
+definitions of |othercases| and |endcases| should be changed to agree with
+local conventions. Note that no semicolon appears before |endcases| in
+this program, so the definition of |endcases| should include a semicolon
+if the compiler wants one. (Of course, if no default mechanism is
+available, the |case| statements of \MP\ will have to be laboriously
+extended by listing all remaining cases. People who are stuck with such
+\PASCAL s have, in fact, done this, successfully but not happily!)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters can be changed at compile time to extend or
+reduce \MP's capacity. They may have different values in \.{INIMP} and
+in production versions of \MP.
+@.INIMP@>
+@^system dependencies@>
+
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \MP's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMP}, otherwise |>=mem_top|}
+@!max_internal=100; {maximum number of internal quantities}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!emergency_line_length=255;
+ {\ps\ output lines can be this long in unusual circumstances}
+@!stack_size=30; {maximum number of simultaneous input sources}
+@!max_read_files=4; {maximum number of simultaneously open \&{readfrom} files}
+@!max_strings=2500; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=9000; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MP's own error messages are stored}
+@!strings_vacant=1000; {the minimum number of strings that should be available}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MP's own strings, which is currently about 22000}
+@!font_max=50; {maximum font number for included text fonts}
+@!font_mem_size=10000; {number of words for \.{TFM} information for text fonts}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='MPlib:MP.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.MPlib@>
+@!ps_tab_name='MPlib:PSFONTS.MAP ';
+ {string of length |file_name_size|; locates font name translation table}
+@!path_size=300; {maximum number of knots between breakpoints of a path}
+@!bistack_size=785; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=5000; {maximum number of ligature/kern steps, must be
+ at least 255 and at most 32510}
+@!max_kerns=500; {maximum number of distinct kern amounts}
+@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
+
+@ Like the preceding parameters, the following quantities can be changed
+at compile time to extend or reduce \MP's capacity. But if they are changed,
+it is necessary to rerun the initialization program \.{INIMP}
+@.INIMP@>
+to generate new tables for the production \MP\ program.
+One can't simply make helter-skelter changes to the following constants,
+since certain rather complex initialization
+numbers are computed from them. They are defined here using
+\.{WEB} macros, instead of being put into \PASCAL's |const| list, in order to
+emphasize this distinction.
+
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMP};
+ must be substantially larger than |mem_min|
+ and not greater than |mem_max|}
+@d hash_size=2100 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d max_in_open=6 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=150 {maximum number of simultaneous macro parameters}
+@d max_write_files=4 {maximum number of simultaneously open \&{write} files}
+@^system dependencies@>
+
+@ In case somebody has inadvertently made bad settings of the ``constants,''
+\MP\ checks them using a global variable called |bad|.
+
+This is the first of many sections of \MP\ where global variables are
+defined.
+
+@<Glob...@>=
+@!bad:integer; {is some ``constant'' wrong?}
+
+@ Later on we will say `\ignorespaces|if mem_max>=max_halfword then bad:=10|',
+or something similar. (We can't do that until |max_halfword| has been defined.)
+
+@<Check the ``constant'' values for consistency@>=
+bad:=0;
+if (half_error_line<30)or(half_error_line>error_line-15) then bad:=1;
+if max_print_line<60 then bad:=2;
+if emergency_line_length<max_print_line then bad:=3;
+if mem_min+1100>mem_top then bad:=4;
+if hash_prime>hash_size then bad:=5;
+if header_size mod 4 <> 0 then bad:=6;
+if(lig_table_size<255)or(lig_table_size>32510)then bad:=7;
+
+@ Labels are given symbolic names by the following definitions, so that
+occasional |goto| statements will be meaningful. We insert the label
+`|exit|:' just before the `\ignorespaces|end|\unskip' of a procedure in
+which we have used the `|return|' statement defined below; the label
+`|restart|' is occasionally used at the very beginning of a procedure; and
+the label `|reswitch|' is occasionally used just prior to a |case|
+statement in which some cases change the conditions and we wish to branch
+to the newly applicable case. Loops that are set up with the |loop|
+construction defined below are commonly exited by going to `|done|' or to
+`|found|' or to `|not_found|', and they are sometimes repeated by going to
+`|continue|'. If two or more parts of a subroutine start differently but
+end up the same, the shared code may be gathered together at
+`|common_ending|'.
+
+Incidentally, this program never declares a label that isn't actually used,
+because some fussy \PASCAL\ compilers will complain about redundant labels.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d done1=31 {like |done|, when there is more than one loop}
+@d done2=32 {for exiting the second loop in a long block}
+@d done3=33 {for exiting the third loop in a very long block}
+@d done4=34 {for exiting the fourth loop in an extremely long block}
+@d done5=35 {for exiting the fifth loop in an immense block}
+@d done6=36 {for exiting the sixth loop in a block}
+@d found=40 {go here when you've found it}
+@d found1=41 {like |found|, when there's more than one per routine}
+@d found2=42 {like |found|, when there's more than two per routine}
+@d not_found=45 {go here when you've found nothing}
+@d common_ending=50 {go here when you want to merge with another branch}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d negate(#) == #:=-# {change the sign of a variable}
+@d double(#) == #:=#+# {multiply a variable by two}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@f loop == xclause
+ {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil {\.{WEB} will henceforth say |return| instead of \\{return}}
+
+@* \[2] The character set.
+In order to make \MP\ readily portable to a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+code that includes standard ASCII, the ``American Standard Code for
+Information Interchange.'' This conversion is done immediately when each
+character is read in. Conversely, characters are converted from ASCII to
+the user's external representation just before they are output to a
+text file.
+@^ASCII code@>
+
+Such an internal code is relevant to users of \MP\ only with respect to
+the \&{char} and \&{ASCII} operations, and the comparison of strings.
+
+@ Characters of text that have been converted to \MP's internal form
+are said to be of type |ASCII_code|, which is a subrange of the integers.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, especially in a program for font design;
+so the present specification of \MP\ has been written under the assumption
+that the \PASCAL\ compiler and run-time system permit the use of text files
+with more than 64 distinguishable characters. More precisely, we assume that
+the character set contains at least the letters and symbols associated
+with ASCII codes @'40 through @'176; all of these characters are now
+available on most computer terminals.
+
+Since we are dealing with more characters than were present in the first
+\PASCAL\ compilers, we have to decide what to call the associated data
+type. Some \PASCAL s use the original name |char| for the
+characters in text files, even though there now are more than 64 such
+characters, while other \PASCAL s consider |char| to be a 64-element
+subrange of a larger data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters that are converted to and
+from |ASCII_code| when they are input and output. We shall also assume
+that |text_char| consists of the elements |chr(first_text_char)| through
+|chr(last_text_char)|, inclusive. The following definitions should be
+adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Local variables for init...@>=
+@!i:integer;
+
+@ The \MP\ processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Glob...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ Since we are assuming that our \PASCAL\ system is able to read and
+write the visible characters of standard ASCII (although not
+necessarily using the ASCII codes to represent them), the following
+assignment statements initialize the standard part of the |xchr| array
+properly, without needing any system-dependent changes. On the other
+hand, it is possible to implement \MP\ with less complete character
+sets, and in such cases it will be necessary to change something here.
+@^system dependencies@>
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+
+@ The ASCII code is ``standard'' only to a certain extent, since many
+computer installations have found it advantageous to have ready access
+to more than 94 printing characters. If \MP\ is being used
+on a garden-variety \PASCAL\ for which only standard ASCII
+codes will appear in the input and output files, it doesn't really matter
+what codes are specified in |xchr[0..@'37]|, but the safest policy is to
+blank everything out by using the code shown below.
+
+However, other settings of |xchr| will make \MP\ more friendly on
+computers that have an extended character set, so that users can type things
+like `\.^^Z' instead of `\.{<>}'.
+People with extended character sets can
+assign codes arbitrarily, giving an |xchr| equivalent to whatever
+characters the users of \MP\ are allowed to have in their input files.
+Appropriate changes to \MP's |char_class| table should then be made.
+(Unlike \TeX, each installation of \MP\ has a fixed assignment of category
+codes, called the |char_class|.) Such changes make portability of programs
+more difficult, so they should be introduced cautiously if at all.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
+where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
+|j| or more; hence, standard ASCII code numbers will be used instead of
+codes below @'40 in case there is a coincidence.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'177;
+for i:=@'200 to @'377 do xord[xchr[i]]:=i;
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+
+@* \[3] Input and output.
+The bane of portability is the fact that different operating systems treat
+input and output quite differently, perhaps because computer scientists
+have not given sufficient attention to this problem. People have felt somehow
+that input and output are not part of ``real'' programming. Well, it is true
+that some kinds of programming are more fun than others. With existing
+input/output conventions being so diverse and so messy, the only sources of
+joy in such parts of the code are the rare occasions when one can find a
+way to make the program a little less bad than it might have been. We have
+two choices, either to attack I/O now and get it over with, or to postpone
+I/O until near the end. Neither prospect is very attractive, so let's
+get it over with.
+
+The basic operations we need to do are (1)~inputting and outputting of
+text, to or from a file or the user's terminal; (2)~inputting and
+outputting of eight-bit bytes, to or from a file; (3)~instructing the
+operating system to initiate (``open'') or to terminate (``close'') input or
+output from a specified file; (4)~testing whether the end of an input
+file has been reached; (5)~display of bits on the user's screen.
+The bit-display operation will be discussed in a later section; we shall
+deal here only with more traditional kinds of I/O.
+
+\MP\ needs to deal with two kinds of files.
+We shall use the term |alpha_file| for a file that contains textual data,
+and the term |byte_file| for a file that contains eight-bit binary information.
+These two types turn out to be the same on many computers, but
+sometimes there is a significant distinction, so we shall be careful to
+distinguish between them. Standard protocols for transferring
+such files from computer to computer, via high-speed networks, are
+now becoming available to more and more communities of users.
+
+The program actually makes use also of a third kind of file, called a
+|word_file|, when dumping and reloading mem information for its own
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ Most of what we need to do with respect to input and output can be handled
+by the I/O facilities that are standard in \PASCAL, i.e., the routines
+called |get|, |put|, |eof|, and so on. But
+standard \PASCAL\ does not allow file variables to be associated with file
+names that are determined at run time, so it cannot be used to implement
+\MP; some sort of extension to \PASCAL's ordinary |reset| and |rewrite|
+is crucial for our purposes. We shall assume that |name_of_file| is a variable
+of an appropriate type such that the \PASCAL\ run-time system being used to
+implement \MP\ can open a file whose external name is specified by
+|name_of_file|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@!name_length:0..file_name_size;@/{this many characters are actually
+ relevant in |name_of_file| (the rest are blank)}
+
+@ The \ph\ compiler with which the original version of \MF\ was prepared
+extends the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `\ignorespaces|packed
+array[@t\<\\{any}>@>] of text_char|', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\MP\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\MP's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var @!f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var @!f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var @!f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var @!f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var @!f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var @!f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+@p procedure a_close(var @!f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var @!f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var @!f:word_file); {close a word file}
+begin close(f);
+end;
+
+@ Binary input and output are done with \PASCAL's ordinary |get| and |put|
+procedures, so we don't have to make any other special arrangements for
+binary~I/O. Text output is also easy to do with standard \PASCAL\ routines.
+The treatment of text input is more difficult, however, because
+of the necessary translation to |ASCII_code| values.
+\MP's conventions should be efficient, and they should
+blend nicely with the user's operating environment.
+
+@ Input from text files is read one line at a time, using a routine called
+|input_ln|. This function is defined in terms of global variables called
+|buffer|, |first|, and |last| that will be described in detail later; for
+now, it suffices for us to know that |buffer| is an array of |ASCII_code|
+values, and that |first| and |last| are indices into this array
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@!first:0..buf_size; {the first unused position in |buffer|}
+@!last:0..buf_size; {end of the line just input to |buffer|}
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+
+@ The |input_ln| function brings the next line of input from the specified
+field into available positions of the buffer array and returns the value
+|true|, unless the file has already been entirely read, in which case it
+returns |false| and sets |last:=first|. In general, the |ASCII_code|
+numbers that represent the next line of the file are input into
+|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the
+global variable |last| is set equal to |first| plus the length of the
+line. Trailing blanks are removed from the line; thus, either |last=first|
+(in which case the line was entirely blank) or |buffer[last-1]<>" "|.
+@^inner loop@>
+
+An overflow error is given, however, if the normal actions of |input_ln|
+would make |last>=buf_size|; this is done so that other parts of \MP\
+can safely look at the contents of |buffer[last+1]| without overstepping
+the bounds of the |buffer| array. Upon entry to |input_ln|, the condition
+|first<buf_size| will always hold, so that there is always room for an
+``empty'' line.
+
+The variable |max_buf_stack|, which is used to keep track of how large
+the |buf_size| parameter must be to accommodate the present job, is
+also kept up to date by |input_ln|.
+
+If the |bypass_eoln| parameter is |true|, |input_ln| will do a |get|
+before looking at the first character of the line; this skips over
+an |eoln| that was in |f^|. The procedure does not do a |get| when it
+reaches the end of the line; therefore it can be used to acquire input
+from the user's terminal as well as from ordinary text files.
+
+Standard \PASCAL\ says that a file should have |eoln| immediately
+before |eof|, but \MP\ needs only a weaker restriction: If |eof|
+occurs in the middle of a line, the system function |eoln| should return
+a |true| result (even though |f^| will be undefined).
+
+@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+
+@ The user's terminal acts essentially like other files of text, except
+that it is used both for input and for output. When the terminal is
+considered an input file, the file variable is called |term_in|, and when it
+is considered an output file the file variable is |term_out|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+
+@ Sometimes it is necessary to synchronize the input/output mixture that
+happens on the user's terminal, and three system-dependent
+procedures are used for this
+purpose. The first of these, |update_terminal|, is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+The second, |clear_terminal|, is called when we wish to cancel any
+input that the user may have typed ahead (since we are about to
+issue an unexpected error message). The third, |wake_up_terminal|,
+is supposed to revive the terminal if the user has disabled it by
+some instruction to the operating system. The following macros show how
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+
+@ We need a special routine to read the first line of \MP\ input from
+the user's terminal. This line is different because it is read before we
+have opened the transcript file; there is sort of a ``chicken and
+egg'' problem here. If the user types `\.{input cmr10}' on the first
+line, or if some macro invoked by that line does such an \.{input},
+the transcript file will be named `\.{cmr10.log}'; but if no \.{input}
+commands are performed during the first line of terminal input, the transcript
+file will acquire its default name `\.{mpout.log}'. (The transcript file
+will not contain error messages generated by the first line before the
+first \.{input} command.)
+
+The first line is even more special if we are lucky enough to have an operating
+system that treats \MP\ differently from a run-of-the-mill \PASCAL\ object
+program. It's nice to let the user start running a \MP\ job by typing
+a command line like `\.{MP cmr10}'; in such a case, \MP\ will operate
+as if the first line of input were `\.{cmr10}', i.e., the first line will
+consist of the remainder of the command line, after the part that invoked \MP.
+
+The first line is special also because it may be read before \MP\ has
+input a mem file. In such cases, normal error messages cannot yet
+be given. The following code uses concepts that will be explained later.
+
+@<Report overflow of the input buffer, and abort@>=
+if mem_ident=0 then
+ begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+ end
+else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:MetaPost capacity exceeded buffer size}{\quad buffer size@>
+ end
+
+@ Different systems have different ways to get started. But regardless of
+what conventions are adopted, the routine that initializes the terminal
+should satisfy the following specifications:
+
+\yskip\textindent{1)}It should open file |term_in| for input from the
+ terminal. (The file |term_out| will already be open for output to the
+ terminal.)
+
+\textindent{2)}If the user has given a command line, this line should be
+ considered the first line of terminal input. Otherwise the
+ user should be prompted with `\.{**}', and the first line of input
+ should be whatever is typed in response.
+
+\textindent{3)}The first line of input, which might or might not be a
+ command line, should appear in locations |first| to |last-1| of the
+ |buffer| array.
+
+\textindent{4)}The global variable |loc| should be set so that the
+ character to be read next by \MP\ is in |buffer[loc]|. This
+ character should not be blank, and we should have |loc<last|.
+
+\yskip\noindent(It may be necessary to prompt the user several times
+before a non-blank line comes in. The prompt is `\.{**}' instead of the
+later `\.*' because the meaning is slightly different: `\.{input}' need
+not be typed immediately after~`\.{**}'.)
+
+@d loc==cur_input.loc_field {location of first unread character in |buffer|}
+
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+
+@* \[4] String handling.
+Symbolic token names and diagnostic messages are variable-length strings
+of eight-bit characters. Since \PASCAL\ does not have a well-developed string
+mechanism, \MP\ does all of its string processing by homegrown methods.
+
+\MP\ uses strings more extensively than \MF\ does, but the necessary
+operations can still be handled with a fairly simple data structure.
+The array |str_pool| contains all of the (eight-bit) ASCII codes in all
+of the strings, and the array |str_start| contains indices of the starting
+points of each string. Strings are referred to by integer numbers, so that
+string number |s| comprises the characters |str_pool[j]| for
+|str_start[s]<=j<str_start[ss]| where |ss=next_str[s]|. The string pool
+is allocated sequentially and |str_pool[pool_ptr]| is the next unused
+location. The first string number not currently in use is |str_ptr|
+and |next_str[str_ptr]| begins a list of free string numbers. String
+pool entries |str_start[str_ptr]| up to |pool_ptr| are reserved for a
+string currently being constructed.
+
+String numbers 0 to 255 are reserved for strings that correspond to single
+ASCII characters. This is in accordance with the conventions of \.{WEB},
+@.WEB@>
+which converts single-character strings into the ASCII code number of the
+single character involved, while it converts other strings into integers
+and builds a string pool file. Thus, when the string constant \.{"."} appears
+in the program below, \.{WEB} converts it into the integer 46, which is the
+ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"}
+into some integer greater than~255. String number 46 will presumably be the
+single character `\..'\thinspace; but some ASCII codes have no standard visible
+representation, and \MP\ may need to be able to print an arbitrary
+ASCII character, so the first 256 strings are used to specify exactly what
+should be printed for each of the 256 possibilities.
+
+Elements of the |str_pool| array must be ASCII codes that can actually be
+printed; i.e., they must have an |xchr| equivalent in the local
+character set. (This restriction applies only to preloaded strings,
+not to those generated dynamically by the user.)
+
+Some \PASCAL\ compilers won't pack integers into a single byte unless the
+integers lie in the range |-128..127|. To accommodate such systems
+we access the string pool via macros that can easily be redefined.
+When accessing character dimensions for the \&{infont} operator, an explicit
+offset is used to convert from |pool_ASCII_code| to |ASCII_code|.
+
+@d si(#) == # {convert from |ASCII_code| to |pool_ASCII_code|}
+@d so(#) == # {convert from |pool_ASCII_code| to |ASCII_code|}
+@d min_pool_ASCII=0 {added to an |ASCII_code| to make a |pool_ASCII_code|}
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!pool_ASCII_code = 0..255; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of pool_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@!next_str : array[str_number] of str_number; {for linking strings in order}
+@!pool_ptr : pool_pointer; {first unused position in |str_pool|}
+@!str_ptr : str_number; {number of the current string being created}
+@!init_pool_ptr : pool_pointer; {the starting value of |pool_ptr|}
+@!init_str_use : str_number; {the initial number of strings in use}
+@!max_pool_ptr : pool_pointer; {the maximum so far of |pool_ptr|}
+@!max_str_ptr : str_number; {the maximum so far of |str_ptr|}
+
+@ Except for |strs_used_up|, the following string statistics are only
+maintained when code between |stat| $\ldots$ |tats| delimiters is not
+commented out:
+
+@<Glob...@>=
+@!strs_used_up:integer; {strings in use or unused but not reclaimed}
+@!pool_in_use:integer; {total number of cells of |str_pool| actually in use}
+@!strs_in_use:integer; {total number of strings actually in use}
+@!max_pl_used:integer; {maximum |pool_in_use| so far}
+@!max_strs_used:integer; {maximum |strs_in_use| so far}
+
+@ Several of the elementary string operations are performed using \.{WEB}
+macros instead of \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a string.
+@.WEB@>
+
+@d str_stop(#)==str_start[next_str[#]] {one cell past the end of string
+ number \#}
+@d length(#)==(str_stop(#)-str_start[#]) {the number of characters in string \#}
+
+@ The length of the current string is called |cur_length|. If we decide that
+the current string is not needed, |flush_cur_string| resets |pool_ptr| so that
+|cur_length| becomes zero.
+
+@d cur_length == (pool_ptr - str_start[str_ptr])
+@d flush_cur_string == pool_ptr:=str_start[str_ptr]
+
+@ Strings are created by appending character codes to |str_pool|.
+The |append_char| macro, defined here, does not check to see if the
+value of |pool_ptr| has gotten too high; this test is supposed to be
+made before |append_char| is used.
+
+To test if there is room to append |l| more characters to |str_pool|,
+we shall write |str_room(l)|, which tries to make sure there is enough room
+by compacting the string pool if necessary. If this does not work,
+|do_compaction| aborts \MP\ and gives an apologetic error message.
+
+@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
+begin str_pool[pool_ptr]:=si(#); incr(pool_ptr);
+end
+@d str_room(#) == {make sure that the pool hasn't overflowed}
+ begin if pool_ptr+# > max_pool_ptr then
+ if pool_ptr+# > pool_size then do_compaction(#)
+ else max_pool_ptr:=pool_ptr+#;
+ end
+
+@ The following routine is similar to |str_room(1)| but it uses the
+argument |pool_size| to prevent |do_compaction| from aborting when
+string space is exhausted.
+
+@<Declare the procedure called |unit_str_room|@>=
+procedure unit_str_room;
+begin if pool_ptr>=pool_size then do_compaction(pool_size);
+if pool_ptr>=max_pool_ptr then max_pool_ptr:=pool_ptr+1;
+end;
+
+@ \MP's string expressions are implemented in a brute-force way: Every
+new string or substring that is needed is simply copied into the string pool.
+Space is eventually reclaimed by a procedure called |do_compaction| with
+the aid of a simple system system of reference counts.
+@^reference counts@>
+
+The number of references to string number |s| will be |str_ref[s]|. The
+special value |str_ref[s]=max_str_ref=127| is used to denote an unknown
+positive number of references; such strings will never be recycled. If
+a string is ever referred to more than 126 times, simultaneously, we
+put it in this category. Hence a single byte suffices to store each |str_ref|.
+
+@d max_str_ref=127 {``infinite'' number of references}
+@d add_str_ref(#)==begin if str_ref[#]<max_str_ref then incr(str_ref[#]);
+ end
+
+@<Glob...@>=
+@!str_ref:array[str_number] of 0..max_str_ref;
+
+@ Here's what we do when a string reference disappears:
+
+@d delete_str_ref(#)== begin if str_ref[#]<max_str_ref then
+ if str_ref[#]>1 then decr(str_ref[#])@+else flush_string(#);
+ end
+
+@<Declare the procedure called |flush_string|@>=
+procedure flush_string(@!s:str_number);
+begin stat pool_in_use:=pool_in_use-length(s);
+ decr(strs_in_use);
+ tats@;
+if next_str[s]<>str_ptr then str_ref[s]:=0
+else begin str_ptr:=s;
+ decr(strs_used_up);
+ end;
+pool_ptr:=str_start[str_ptr];
+end;
+
+@ Once a sequence of characters has been appended to |str_pool|, it
+officially becomes a string when the function |make_string| is called.
+This function returns the identification number of the new string as its
+value.
+
+When getting the next unused string number from the linked list, we pretend
+that
+$$ \hbox{|max_str_ptr+1|, |max_str_ptr+2|, $\ldots$, |max_strings|} $$
+are linked sequentially even though the |next_str| entries have not been
+initialized yet. We never allow |str_ptr| to reach |max_strings|;
+|do_compaction| is responsible for making sure of this.
+
+@p @t\4@>@<Declare the procedure called |do_compaction|@>@;
+@t\4@>@<Declare the procedure called |unit_str_room|@>@;
+function make_string : str_number; {current string enters the pool}
+label restart;
+var @!s:str_number; {the new string}
+begin restart: s:=str_ptr;
+str_ptr:=next_str[s];
+if str_ptr>max_str_ptr then
+ if str_ptr=max_strings then
+ begin str_ptr:=s;
+ do_compaction(0);
+ goto restart;
+ end
+ else begin debug if strs_used_up<>max_str_ptr then confusion("s");@+gubed@/
+@:this can't happen s}{\quad \.s@>
+ max_str_ptr:=str_ptr;
+ next_str[str_ptr]:=max_str_ptr+1;
+ end;
+str_ref[s]:=1;
+str_start[str_ptr]:=pool_ptr;
+incr(strs_used_up);
+stat incr(strs_in_use);
+ pool_in_use:=pool_in_use+length(s);
+ if pool_in_use>max_pl_used then max_pl_used:=pool_in_use;
+ if strs_in_use>max_strs_used then max_strs_used:=strs_in_use;
+tats@;
+make_string:=s;
+end;
+
+@ On rare occasions, we might decide after calling |make_string| that some
+characters should be removed from the end of the last string and transferred
+to the beginning of a string under construction. This basically a matter of
+resetting |str_start[str_ptr]|. It is not practical to ensure that the new
+value for this pointer is in range, so this procedure should be used carefully.
+
+@p procedure chop_last_string(@!p:pool_pointer);
+begin stat pool_in_use:=pool_in_use-(str_start[str_ptr]-p); @+tats;
+str_start[str_ptr]:=p;
+end;
+
+@ The most interesting string operation is string pool compaction. The idea
+is to recover unused space in the |str_pool| array by recopying the strings
+to close the gaps created when some strings become unused. All string
+numbers~$k$ where |str_ref[k]=0| are to be linked into the list of free string
+numbers after |str_ptr|. If this fails to free enough pool space we issue an
+|overflow| error unless |needed=pool_size|. Calling |do_compaction|
+with |needed=pool_size| supresses all overflow tests.
+
+The compaction process starts with |last_fixed_str| because all lower numbered
+strings are permanently allocated with |max_str_ref| in their |str_ref| entries.
+
+@<Glob...@>=
+@!last_fixed_str:str_number; {last permanently allocated string}
+@!fixed_str_use:str_number; {number of permanently allocated strings}
+
+@ @<Declare the procedure called |do_compaction|@>=
+procedure do_compaction(@!needed:pool_pointer);
+label done;
+var @!str_use:str_number; {a count of strings in use}
+@!r,@!s,@!t:str_number; {strings being manipulated}
+@!p,@!q:pool_pointer; {destination and source for copying string characters}
+begin @<Advance |last_fixed_str| as far as possible and set |str_use|@>;
+r:=last_fixed_str;
+s:=next_str[r];
+p:=str_start[s];
+while s<>str_ptr do
+ begin while str_ref[s]=0 do
+ @<Advance |s| and add the old |s| to the list of free string numbers;
+ then |goto done| if |s=str_ptr|@>;
+ r:=s; s:=next_str[s];
+ incr(str_use);
+ @<Move string |r| back so that |str_start[r]=p|; make |p| the location
+ after the end of the string@>;
+ end;
+done: @<Move the current string back so that it starts at |p|@>;
+if needed<pool_size then
+ @<Make sure that there is room for another string with |needed| characters@>;
+stat @<Account for the compaction and make sure the statistics agree with the
+ global versions@>;
+tats@;
+strs_used_up:=str_use;
+end;
+
+@ @<Advance |last_fixed_str| as far as possible and set |str_use|@>=
+t:=next_str[last_fixed_str];
+while (str_ref[t]=max_str_ref)and(t<>str_ptr) do
+ begin incr(fixed_str_use);
+ last_fixed_str:=t;
+ t:=next_str[t];
+ end;
+str_use:=fixed_str_use
+
+@ Because of the way |flush_string| has been written, it should never be
+necessary to |goto done| here. The extra line of code seems worthwhile to
+preserve the generality of |do_compaction|.
+
+@<Advance |s| and add the old |s| to the list of free string numbers;...@>=
+begin t:=s;
+s:=next_str[s];
+next_str[r]:=s;
+next_str[t]:=next_str[str_ptr];
+next_str[str_ptr]:=t;
+if s=str_ptr then goto done;
+end
+
+@ The string currently starts at |str_start[r]| and ends just before
+|str_start[s]|. We don't change |str_start[s]| because it might be needed
+to locate the next string.
+
+@<Move string |r| back so that |str_start[r]=p|; make |p| the location...@>=
+q:=str_start[r];
+str_start[r]:=p;
+while q<str_start[s] do
+ begin str_pool[p]:=str_pool[q];
+ incr(p); incr(q);
+ end
+
+@ Pointers |str_start[str_ptr]| and |pool_ptr| have not been updated. When
+we do this, anything between them should be moved.
+
+@ @<Move the current string back so that it starts at |p|@>=
+q:=str_start[str_ptr];
+str_start[str_ptr]:=p;
+while q<pool_ptr do
+ begin str_pool[p]:=str_pool[q];
+ incr(p); incr(q);
+ end;
+pool_ptr:=p
+
+@ We must remember that |str_ptr| is not allowed to reach |max_strings|.
+
+@<Make sure that there is room for another string with |needed| char...@>=
+begin if str_use>=max_strings-1 then
+ begin str_overflowed:=true;
+ overflow("number of strings", max_strings-1-init_str_use);
+@:MetaPost capacity exceeded number of strings}{\quad number of strings@>
+ end;
+if pool_ptr+needed>max_pool_ptr then
+ if pool_ptr+needed>pool_size then
+ begin str_overflowed:=true;
+ overflow("pool size", pool_size-init_pool_ptr);
+@:MetaPost capacity exceeded pool size}{\quad pool size@>
+ end
+ else max_pool_ptr:=pool_ptr+needed;
+end
+
+@ Routines that can be called after string overflow need a way of checking
+whether it is safe to use |str_room|, |make_string|, or |do_compaction|.
+
+@<Glob...@>=
+@!str_overflowed:boolean; {is \MP\ aborting due to pool size of number of
+ strings?}
+
+@ @<Account for the compaction and make sure the statistics agree with...@>=
+if (str_start[str_ptr]<>pool_in_use)or(str_use<>strs_in_use) then
+ confusion("string");
+@:this can't happen string}{\quad string@>
+incr(pact_count);
+pact_chars:=pact_chars+pool_ptr-str_stop(last_fixed_str);
+pact_strs:=pact_strs+str_use-fixed_str_use;
+debug s:=str_ptr; t:=str_use;
+ while s<=max_str_ptr do
+ begin if t>max_str_ptr then confusion("""");
+ incr(t); s:=next_str[s];
+ end;
+ if t<=max_str_ptr then confusion("""");
+gubed
+
+@ A few more global variables are needed to keep track of statistics when
+|stat| $\ldots$ |tats| blocks are not commented out.
+
+@<Glob...@>=
+@!pact_count:integer; {number of string pool compactions so far}
+@!pact_chars:integer; {total number of characters moved during compactions}
+@!pact_strs:integer; {total number of strings moved during compactions}
+
+@ @<Initialize compaction statistics@>=
+pact_count:=0;
+pact_chars:=0;
+pact_strs:=0@;
+
+@ The following subroutine compares string |s| with another string of the
+same length that appears in |buffer| starting at position |k|;
+the result is |true| if and only if the strings are equal.
+
+@p function str_eq_buf(@!s:str_number;@!k:integer):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var @!j: pool_pointer; {running index}
+@!result: boolean; {result of comparison}
+begin j:=str_start[s];
+while j<str_stop(s) do
+ begin if so(str_pool[j])<>buffer[k] then
+ begin result:=false; goto not_found;
+ end;
+ incr(j); incr(k);
+ end;
+result:=true;
+not_found: str_eq_buf:=result;
+end;
+
+@ Here is a similar routine, but it compares two strings in the string pool,
+and it does not assume that they have the same length. If the first string
+is lexicographically greater than, less than, or equal to the second,
+the result is respectively positive, negative, or zero.
+
+@p function str_vs_str(@!s,@!t:str_number):integer;
+ {test equality of strings}
+label exit;
+var @!j,@!k: pool_pointer; {running indices}
+@!ls,@!lt:integer; {lengths}
+@!l:integer; {length remaining to test}
+begin ls:=length(s); lt:=length(t);
+if ls<=lt then l:=ls@+else l:=lt;
+j:=str_start[s]; k:=str_start[t];
+while l>0 do
+ begin if str_pool[j]<>str_pool[k] then
+ begin str_vs_str:=str_pool[j]-str_pool[k]; return;
+ end;
+ incr(j); incr(k); decr(l);
+ end;
+str_vs_str:=ls-lt;
+exit:end;
+
+@ The initial values of |str_pool|, |str_start|, |pool_ptr|,
+and |str_ptr| are computed by the \.{INIMP} program, based in part
+on the information that \.{WEB} has output while processing \MP.
+@.INIMP@>
+@^string pool@>
+
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+ but returns |false| if something goes wrong}
+label done,exit;
+var @!k,@!l:0..255; {small indices or counters}
+@!m,@!n:text_char; {characters input from |pool_file|}
+@!g:str_number; {garbage}
+@!a:integer; {accumulator for check sum}
+@!c:boolean; {check sum has been checked}
+begin pool_ptr:=0; str_ptr:=0; max_pool_ptr:=0; max_str_ptr:=0;
+str_start[0]:=0;
+next_str[0]:=1;
+str_overflowed:=false;
+stat pool_in_use:=0; strs_in_use:=0;
+ max_pl_used:=0; max_strs_used:=0;
+ @<Initialize compaction statistics@>;
+tats@;
+strs_used_up:=0;
+@<Make the first 256 strings@>;
+@<Read the other strings from the \.{MP.POOL} file and return |true|,
+ or give an error message and return |false|@>;
+last_fixed_str:=str_ptr-1;
+fixed_str_use:=str_ptr;
+exit:end;
+tini
+
+@ The first 256 strings will consist of a single character only.
+
+@<Make the first 256...@>=
+for k:=0 to 255 do
+ begin append_char(k);
+ g:=make_string; str_ref[g]:=max_str_ref;
+ end;
+
+@ The first 128 strings will contain 95 standard ASCII characters, and the
+other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
+unless a system-dependent change is made here. Installations that have
+an extended character set, where for example |xchr[@'32]=@t\.{\'^^Z\'}@>|,
+would like string @'32 to be printed as the single character @'32 instead
+of the three characters @'136, @'136, @'132 (\.{\^\^Z}). On the other hand,
+even people with an extended character set will want to represent string
+@'15 by \.{\^\^M}, since @'15 is ASCII's ``carriage return'' code; the idea is
+to produce visible strings instead of tabs or line-feeds or carriage-returns
+or bell-rings or characters that are treated anomalously in text files.
+
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+The boolean expression defined here should be |true| unless \MP\ internal
+code number~|k| corresponds to a non-troublesome visible symbol in the
+local character set.
+If character |k| cannot be printed, and |k<@'200|, then character |k+@'100| or
+|k-@'100| must be printable; moreover, ASCII codes |[@'60..@'71, @'141..@'146]|
+must be printable.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Character |k| cannot be printed@>=
+ (k<" ")or(k>"~")
+
+@ When the \.{WEB} system program called \.{TANGLE} processes the \.{MP.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{MP.PAS} and also a string pool file called \.{MP.POOL}. The \.{INIMP}
+@.WEB@>@.INIMP@>
+program reads the latter file, where each string appears as a two-digit decimal
+length followed by the string itself, and the information is recorded in
+\MP's string memory.
+
+@<Glob...@>=
+@!init @!pool_file:alpha_file; {the string-pool file output by \.{TANGLE}}
+tini
+
+@ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#);
+ a_close(pool_file); get_strings_started:=false; return;
+ end
+@<Read the other strings...@>=
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+ begin c:=false;
+ repeat @<Read one string, but return |false| if the
+ string memory space is getting too tight for comfort@>;
+ until c;
+ a_close(pool_file); get_strings_started:=true;
+ end
+else bad_pool('! I can''t read MP.POOL.')
+@.I can't read MP.POOL@>
+
+@ @<Read one string...@>=
+begin if eof(pool_file) then bad_pool('! MP.POOL has no check sum.');
+@.MP.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+if m='*' then @<Check the pool check sum@>
+else begin if (xord[m]<"0")or(xord[m]>"9")or@|
+ (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! MP.POOL line doesn''t begin with two digits.');
+@.MP.POOL line doesn't...@>
+ l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ if str_ptr+strings_vacant>=max_strings then
+ bad_pool('! You have to increase MAXSTRINGS.');
+@.You have to increase MAXSTRINGS@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(xord[m]);
+ end;
+ read_ln(pool_file); g:=make_string; str_ref[g]:=max_str_ref;
+ end;
+end
+
+@ The \.{WEB} operation \.{@@\$} denotes the value that should be at the
+end of this \.{MP.POOL} file; any other value means that the wrong pool
+file has been loaded.
+@^check sum@>
+
+@<Check the pool check sum@>=
+begin a:=0; k:=1;
+loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! MP.POOL check sum doesn''t have nine digits.');
+@.MP.POOL check sum...@>
+ a:=10*a+xord[n]-"0";
+ if k=9 then goto done;
+ incr(k); read(pool_file,n);
+ end;
+done: if a<>@$ then bad_pool('! MP.POOL doesn''t match; TANGLE me again.');
+@.MP.POOL doesn't match@>
+c:=true;
+end
+
+@* \[5] On-line and off-line printing.
+Messages that are sent to a user's terminal and to the transcript-log file
+are produced by several `|print|' procedures. These procedures will
+direct their output to a variety of places, based on the setting of
+the global variable |selector|, which has the following possible
+values:
+
+\yskip
+\hang |term_and_log|, the normal setting, prints on the terminal and on the
+ transcript file.
+
+\hang |log_only|, prints only on the transcript file.
+
+\hang |term_only|, prints only on the terminal.
+
+\hang |no_print|, doesn't print at all. This is used only in rare cases
+ before the transcript file is open.
+
+\hang |ps_file_only| prints only on the \ps\ output file.
+
+\hang |pseudo|, puts output into a cyclic buffer that is used
+ by the |show_context| routine; when we get to that routine we shall discuss
+ the reasoning behind this curious mode.
+
+\hang |new_string|, appends the output to the current string in the
+ string pool.
+
+\hang |0..max_write_files-1| prints on one of the files used for the \&{write}
+@:write_}{\&{write} primitive@>
+ command.
+
+\yskip
+\noindent The symbolic names `|term_and_log|', etc., have been assigned
+numeric codes that satisfy the convenient relations |no_print+1=term_only|,
+|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|. These
+relations are not used when |selector| could be |pseudo|, |new_string|,
+or |ps_file_only|. We need not check for unprintable characters when
+|selector<pseudo|.
+
+Four additional global variables, |tally|, |term_offset|, |file_offset|,
+and |ps_offset| record the number of characters that have been printed
+since they were most recently cleared to zero. We use |tally| to record
+the length of (possibly very long) stretches of printing; |term_offset|,
+|file_offset|, and |ps_offset|, on the other hand, keep track of how many
+characters have appeared so far on the current line that has been output
+to the terminal, the transcript file, or the \ps\ output file, respectively.
+
+@d new_string=max_write_files {printing is deflected to the string pool}
+@d ps_file_only=new_string+1 {printing goes to the \ps\ output file}
+@d pseudo=new_string+2 {special |selector| setting for |show_context|}
+@d no_print=new_string+3 {|selector| setting that makes data disappear}
+@d term_only=new_string+4 {printing is destined for the terminal only}
+@d log_only=new_string+5 {printing is destined for the transcript file only}
+@d term_and_log=new_string+6 {normal |selector| setting}
+@d max_selector=term_and_log {highest selector setting}
+
+@<Glob...@>=
+@!log_file : alpha_file; {transcript of \MP\ session}
+@!ps_file: alpha_file; {the generic font output goes here}
+@!selector : 0..max_selector; {where to print a message}
+@!dig : array[0..22] of 0..15; {digits in a number being output}
+@!tally : integer; {the number of characters recently printed}
+@!term_offset : 0..max_print_line;
+ {the number of characters on the current terminal line}
+@!file_offset : 0..max_print_line;
+ {the number of characters on the current file line}
+@!ps_offset : integer;
+ {the number of characters on the current \ps\ file line}
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+ pseudoprinting}
+@!trick_count: integer; {threshold for pseudoprinting, explained later}
+@!first_count: integer; {another variable for pseudoprinting}
+
+@ @<Initialize the output routines@>=
+selector:=term_only; tally:=0; term_offset:=0; file_offset:=0; ps_offset:=0;
+
+@ Macro abbreviations for output to the terminal and to the log file are
+defined here for convenience. Some systems need special conventions
+for terminal output, and it is possible to adhere to those conventions
+by changing |wterm|, |wterm_ln|, and |wterm_cr| here.
+@^system dependencies@>
+
+@d wterm(#)==write(term_out,#)
+@d wterm_ln(#)==write_ln(term_out,#)
+@d wterm_cr==write_ln(term_out)
+@d wlog(#)==write(log_file,#)
+@d wlog_ln(#)==write_ln(log_file,#)
+@d wlog_cr==write_ln(log_file)
+@d wps(#)==write(ps_file,#)
+@d wps_ln(#)==write_ln(ps_file,#)
+@d wps_cr==write_ln(ps_file)
+
+@ To end a line of text output, we call |print_ln|. Cases |0..max_write_files|
+use an array |wr_file| that will be declared later.
+
+@<Basic print...@>=
+procedure print_ln; {prints an end-of-line}
+begin case selector of
+term_and_log: begin wterm_cr; wlog_cr;
+ term_offset:=0; file_offset:=0;
+ end;
+log_only: begin wlog_cr; file_offset:=0;
+ end;
+term_only: begin wterm_cr; term_offset:=0;
+ end;
+ps_file_only: begin wps_cr; ps_offset:=0;
+ end;
+no_print,pseudo,new_string: do_nothing;
+othercases write_ln(wr_file[selector])
+endcases;
+end; {note that |tally| is not affected}
+
+@ The |print_visible_char| procedure sends one character to the desired
+destination, using the |xchr| array to map it into an external character
+compatible with |input_ln|. (It assumes that it is always called with
+a visible ASCII character.) All printing comes through |print_ln| or
+|print_char|, which ultimately calls |print_visible_char|, hence these
+routines are the ones that limit lines to at most |max_print_line| characters.
+But we must make an exception for the \ps\ output file since it is not safe
+to cut up lines arbitrarily in \ps.
+
+Procedure |unit_str_room| needs to be declared |forward| here because it calls
+|do_compaction| and |do_compaction| can call the error routines. Actually,
+|unit_str_room| avoids |overflow| errors but it can call |confusion|.
+
+@<Basic printing...@>=
+procedure@?unit_str_room; forward;@t\2@>@/
+procedure print_visible_char(@!s:ASCII_code); {prints a single character}
+label done;
+begin case selector of
+term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin wlog(xchr[s]); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin wterm(xchr[s]); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+ps_file_only: begin wps(xchr[s]); incr(ps_offset);
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr>=max_pool_ptr then
+ begin unit_str_room;
+ if pool_ptr>=pool_size then goto done;
+ {drop characters if string space is full}
+ end;
+ append_char(s);
+ end;
+othercases write(wr_file[selector],xchr[s])
+endcases;
+done:incr(tally);
+end;
+
+@ The |print_char| procedure sends one character to the desired destination.
+File names and string expressions might contain |ASCII_code| values that
+can't be printed using |print_visible_char|. These characters will be
+printed in three- or four-symbol form like `\.{\^\^A}' or `\.{\^\^e4}'.
+(This procedure assumes that it is safe to bypass all checks for unprintable
+characters when |selector| is in the range |0..max_write_files-1| or when
+|selector=ps_file_only|. In the former case the user might want to write
+unprintable characters, and in the latter case the \ps\ printing routines
+check their arguments themselves before calling |print_char| or |print|.)
+
+@d print_lc_hex(#)==l:=#;
+ if l<10 then print_visible_char(l+"0")@+else print_visible_char(l-10+"a")
+
+@<Basic printing...@>=
+procedure print_char(@!k:ASCII_code); {prints a single character}
+var l:0..255; {small index or counter}
+begin if selector<pseudo then print_visible_char(k)
+else if @<Character |k| cannot be printed@> then
+ begin print_visible_char("^"); print_visible_char("^");
+ if k<@'100 then print_visible_char(k+@'100)
+ else if k<@'200 then print_visible_char(k-@'100)
+ else begin print_lc_hex(k div 16); print_lc_hex(k mod 16);
+ end;
+ end
+else print_visible_char(k);
+end;
+
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \MP\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+var @!j:pool_pointer; {current character code position}
+begin if (s<0)or(s>max_str_ptr) then s:="???"; {this can't happen}
+@.???@>
+j:=str_start[s];
+while j<str_stop(s) do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+end;
+
+@ By popular demand, \MP\ prints the banner line only on the transcript file.
+Thus there is nothing special to be printed here.
+
+@<Initialize the output...@>=
+update_terminal;
+
+@ The procedure |print_nl| is like |print|, but it makes sure that the
+string appears at the beginning of a new line.
+
+@<Basic print...@>=
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin case selector of
+term_and_log: if (term_offset>0)or(file_offset>0) then print_ln;
+log_only: if file_offset>0 then print_ln;
+term_only: if term_offset>0 then print_ln;
+ps_file_only: if ps_offset>0 then print_ln;
+no_print,pseudo,new_string: do_nothing;
+end; {there are no other cases}
+print(s);
+end;
+
+@ An array of digits in the range |0..9| is printed by |print_the_digs|.
+
+@<Basic print...@>=
+procedure print_the_digs(@!k:eight_bits);
+ {prints |dig[k-1]|$\,\ldots\,$|dig[0]|}
+begin while k>0 do
+ begin decr(k); print_char("0"+dig[k]);
+ end;
+end;
+
+@ The following procedure, which prints out the decimal representation of a
+given integer |n|, has been written carefully so that it works properly
+if |n=0| or if |(-n)| would cause overflow. It does not apply |mod| or |div|
+to negative arguments, since such operations are not implemented consistently
+by all \PASCAL\ compilers.
+
+@<Basic print...@>=
+procedure print_int(@!n:integer); {prints an integer in decimal form}
+var k:0..23; {index to current digit; we assume that $|n|<10^{23}$}
+@!m:integer; {used to negate |n| in possibly dangerous cases}
+begin k:=0;
+if n<0 then
+ begin print_char("-");
+ if n>-100000000 then negate(n)
+ else begin m:=-1-n; n:=m div 10; m:=(m mod 10)+1; k:=1;
+ if m<10 then dig[0]:=m
+ else begin dig[0]:=0; incr(n);
+ end;
+ end;
+ end;
+repeat dig[k]:=n mod 10; n:=n div 10; incr(k);
+until n=0;
+print_the_digs(k);
+end;
+
+@ \MP\ also makes use of a trivial procedure to print two digits. The
+following subroutine is usually called with a parameter in the range |0<=n<=99|.
+
+@p procedure print_dd(@!n:integer); {prints two least significant digits}
+begin n:=abs(n) mod 100; print_char("0"+(n div 10));
+print_char("0"+(n mod 10));
+end;
+
+@ Here is a procedure that asks the user to type a line of input,
+assuming that the |selector| setting is either |term_only| or |term_and_log|.
+The input is placed into locations |first| through |last-1| of the
+|buffer| array, and echoed on the transcript file if appropriate.
+
+This procedure is never called when |interaction<scroll_mode|.
+
+@d prompt_input(#)==begin wake_up_terminal; print(#); term_input;
+ end {prints a string and gets a line of input}
+
+@p procedure term_input; {gets a line from the terminal}
+var @!k:0..buf_size; {index into |buffer|}
+begin update_terminal; {Now the user sees the prompt for sure}
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@.End of file on the terminal@>
+term_offset:=0; {the user's line ended with \<\rm return>}
+decr(selector); {prepare to echo the input}
+if last<>first then for k:=first to last-1 do print(buffer[k]);
+print_ln; buffer[last]:="%"; incr(selector); {restore previous status}
+end;
+
+@* \[6] Reporting errors.
+When something anomalous is detected, \MP\ typically does something like this:
+$$\vbox{\halign{#\hfil\cr
+|print_err("Something anomalous has been detected");|\cr
+|help3("This is the first line of my offer to help.")|\cr
+|("This is the second line. I'm trying to")|\cr
+|("explain the best way for you to proceed.");|\cr
+|error;|\cr}}$$
+A two-line help message would be given using |help2|, etc.; these informal
+helps should use simple vocabulary that complements the words used in the
+official error message that was printed. (Outside the U.S.A., the help
+messages should preferably be translated into the local vernacular. Each
+line of help is at most 60 characters long, in the present implementation,
+so that |max_print_line| will not be exceeded.)
+
+The |print_err| procedure supplies a `\.!' before the official message,
+and makes sure that the terminal is awake if a stop is going to occur.
+The |error| procedure supplies a `\..' after the official message, then it
+shows the location of the error; and if |interaction=error_stop_mode|,
+it also enters into a dialog with the user, during which time the help
+message may be printed.
+@^system dependencies@>
+
+@ The global variable |interaction| has four settings, representing increasing
+amounts of user interaction:
+
+@d batch_mode=0 {omits all stops and omits terminal output}
+@d nonstop_mode=1 {omits all stops}
+@d scroll_mode=2 {omits error stops}
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal;
+ print_nl("! "); print(#);
+@.!\relax@>
+ end
+
+@<Glob...@>=
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+
+@ @<Set init...@>=interaction:=error_stop_mode;
+
+@ \MP\ is careful not to call |error| when the print |selector| setting
+might be unusual. The only possible values of |selector| at the time of
+error messages are
+
+\yskip\hang|no_print| (when |interaction=batch_mode|
+ and |log_file| not yet open);
+
+\hang|term_only| (when |interaction>batch_mode| and |log_file| not yet open);
+
+\hang|log_only| (when |interaction=batch_mode| and |log_file| is open);
+
+\hang|term_and_log| (when |interaction>batch_mode| and |log_file| is open).
+
+@<Initialize the print |selector| based on |interaction|@>=
+if interaction=batch_mode then selector:=no_print@+else selector:=term_only
+
+@ A global variable |deletions_allowed| is set |false| if the |get_next|
+routine is active when |error| is called; this ensures that |get_next|
+will never be called recursively.
+@^recursion@>
+
+The global variable |history| records the worst level of error that
+has been detected. It has four possible values: |spotless|, |warning_issued|,
+|error_message_issued|, and |fatal_error_stop|.
+
+Another global variable, |error_count|, is increased by one when an
+|error| occurs without an interactive dialog, and it is reset to zero at
+the end of every statement. If |error_count| reaches 100, \MP\ decides
+that there is no point in continuing further.
+
+@d spotless=0 {|history| value when nothing has been amiss yet}
+@d warning_issued=1 {|history| value when |begin_diagnostic| has been called}
+@d error_message_issued=2 {|history| value when |error| has been called}
+@d fatal_error_stop=3 {|history| value when termination was premature}
+
+@<Glob...@>=
+@!deletions_allowed:boolean; {is it safe for |error| to call |get_next|?}
+@!history:spotless..fatal_error_stop; {has the source input been clean so far?}
+@!error_count:-1..100; {the number of scrolled errors since the
+ last statement ended}
+
+@ The value of |history| is initially |fatal_error_stop|, but it will
+be changed to |spotless| if \MP\ survives the initialization process.
+
+@<Set init...@>=
+deletions_allowed:=true; error_count:=0; {|history| is initialized elsewhere}
+
+@ Since errors can be detected almost anywhere in \MP, we want to declare the
+error procedures near the beginning of the program. But the error procedures
+in turn use some other procedures, which need to be declared |forward|
+before we get to |error| itself.
+
+It is possible for |error| to be called recursively if some error arises
+when |get_next| is being used to delete a token, and/or if some fatal error
+occurs while \MP\ is trying to fix a non-fatal one. But such recursion
+@^recursion@>
+is never more than two levels deep.
+
+@<Error handling...@>=
+procedure@?normalize_selector; forward;@t\2@>@/
+procedure@?get_next; forward;@t\2@>@/
+procedure@?term_input; forward;@t\2@>@/
+procedure@?show_context; forward;@t\2@>@/
+procedure@?begin_file_reading; forward;@t\2@>@/
+procedure@?open_log_file; forward;@t\2@>@/
+procedure@?close_files_and_terminate; forward;@t\2@>@/
+procedure@?clear_for_error_prompt; forward;@t\2@>@/
+@t\4\hskip-\fontdimen2\font@>@;@+@!debug@+procedure@?debug_help;
+ forward;@;@+gubed@;@/
+@t\4@>@<Declare the procedure called |flush_string|@>
+
+@ Individual lines of help are recorded in the array |help_line|, which
+contains entries in positions |0..(help_ptr-1)|. They should be printed
+in reverse order, i.e., with |help_line[0]| appearing last.
+
+@d hlp1(#)==help_line[0]:=#;@+end
+@d hlp2(#)==help_line[1]:=#; hlp1
+@d hlp3(#)==help_line[2]:=#; hlp2
+@d hlp4(#)==help_line[3]:=#; hlp3
+@d hlp5(#)==help_line[4]:=#; hlp4
+@d hlp6(#)==help_line[5]:=#; hlp5
+@d help0==help_ptr:=0 {sometimes there might be no help}
+@d help1==@+begin help_ptr:=1; hlp1 {use this with one help line}
+@d help2==@+begin help_ptr:=2; hlp2 {use this with two help lines}
+@d help3==@+begin help_ptr:=3; hlp3 {use this with three help lines}
+@d help4==@+begin help_ptr:=4; hlp4 {use this with four help lines}
+@d help5==@+begin help_ptr:=5; hlp5 {use this with five help lines}
+@d help6==@+begin help_ptr:=6; hlp6 {use this with six help lines}
+
+@<Glob...@>=
+@!help_line:array[0..5] of str_number; {helps for the next |error|}
+@!help_ptr:0..6; {the number of help lines present}
+@!use_err_help:boolean; {should the |err_help| string be shown?}
+@!err_help:str_number; {a string set up by \&{errhelp}}
+
+@ @<Set init...@>=
+help_ptr:=0; use_err_help:=false; err_help:=0;
+
+@ The |jump_out| procedure just cuts across all active procedure levels and
+goes to |end_of_MP|. This is the only nonlocal |@!goto| statement in the
+whole program. It is used when there is no recovery from a particular error.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the body of |jump_out| should simply be
+`|close_files_and_terminate|;\thinspace' followed by a call on some system
+procedure that quietly terminates the program.
+
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_MP;
+end;
+
+@ Here now is the general |error| routine.
+
+@<Error hand...@>=
+procedure error; {completes the job of error reporting}
+label continue,exit;
+var @!c:ASCII_code; {what the user types}
+@!s1,@!s2,@!s3:integer; {used to save global variables when deleting tokens}
+@!j:pool_pointer; {character position being printed}
+begin if history<error_message_issued then history:=error_message_issued;
+print_char("."); show_context;
+if interaction=error_stop_mode then @<Get user's advice and |return|@>;
+incr(error_count);
+if error_count=100 then
+ begin print_nl("(That makes 100 errors; please try again.)");
+@.That makes 100 errors...@>
+ history:=fatal_error_stop; jump_out;
+ end;
+@<Put help message on the transcript file@>;
+exit:end;
+
+@ @<Get user's advice...@>=
+loop@+begin continue: clear_for_error_prompt; prompt_input("? ");
+@.?\relax@>
+ if last=first then return;
+ c:=buffer[first];
+ if c>="a" then c:=c+"A"-"a"; {convert to uppercase}
+ @<Interpret code |c| and |return| if done@>;
+ end
+
+@ It is desirable to provide an `\.E' option here that gives the user
+an easy way to return from \MP\ to the system editor, with the offending
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+
+@<Interpret code |c| and |return| if done@>=
+case c of
+"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then
+ @<Delete |c-"0"| tokens and |goto continue|@>;
+@t\4\4@>@;@+@!debug "D":begin debug_help;goto continue;@+end;@+gubed@/
+"E": if file_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ print(input_stack[file_ptr].name_field);
+ print(" at line "); print_int(true_line);@/
+ interaction:=scroll_mode; jump_out;
+ end;
+"H": @<Print the help information and |goto continue|@>;
+"I":@<Introduce new material from the terminal and |return|@>;
+"Q","R","S":@<Change the interaction level and |return|@>;
+"X":begin interaction:=scroll_mode; jump_out;
+ end;
+othercases do_nothing
+endcases;@/
+@<Print the menu of available options@>
+
+@ @<Print the menu...@>=
+begin print("Type <return> to proceed, S to scroll future error messages,");@/
+@.Type <return> to proceed...@>
+print_nl("R to run without stopping, Q to run quietly,");@/
+print_nl("I to insert something, ");
+if file_ptr>0 then print("E to edit your file,");
+if deletions_allowed then
+ print_nl("1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
+print_nl("H for help, X to quit.");
+end
+
+@ Here the author of \MP\ apologizes for making use of the numerical
+relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings
+|batch_mode|, |nonstop_mode|, |scroll_mode|.
+@^Knuth, Donald Ervin@>
+
+@<Change the interaction...@>=
+begin error_count:=0; interaction:=batch_mode+c-"Q";
+print("OK, entering ");
+case c of
+"Q":begin print("batchmode"); decr(selector);
+ end;
+"R":print("nonstopmode");
+"S":print("scrollmode");
+end; {there are no other cases}
+print("..."); print_ln; update_terminal; return;
+end
+
+@ When the following code is executed, |buffer[(first+1)..(last-1)]| may
+contain the material inserted by the user; otherwise another prompt will
+be given. In order to understand this part of the program fully, you need
+to be familiar with \MP's input stacks.
+
+@<Introduce new material...@>=
+begin begin_file_reading; {enter a new syntactic level for terminal input}
+if last>first+1 then
+ begin loc:=first+1; buffer[first]:=" ";
+ end
+else begin prompt_input("insert>"); loc:=first;
+@.insert>@>
+ end;
+first:=last+1; cur_input.limit_field:=last; return;
+end
+
+@ We allow deletion of up to 99 tokens at a time.
+
+@<Delete |c-"0"| tokens...@>=
+begin s1:=cur_cmd; s2:=cur_mod; s3:=cur_sym; OK_to_interrupt:=false;
+if (last>first+1) and (buffer[first+1]>="0")and(buffer[first+1]<="9") then
+ c:=c*10+buffer[first+1]-"0"*11
+else c:=c-"0";
+while c>0 do
+ begin get_next; {one-level recursive call of |error| is possible}
+ @<Decrease the string reference count, if the current token is a string@>;
+ decr(c);
+ end;
+cur_cmd:=s1; cur_mod:=s2; cur_sym:=s3; OK_to_interrupt:=true;
+help2("I have just deleted some text, as you asked.")@/
+("You can now delete more, or insert, or whatever.");
+show_context; goto continue;
+end
+
+@ @<Print the help info...@>=
+begin if use_err_help then
+ begin @<Print the string |err_help|, possibly on several lines@>;
+ use_err_help:=false;
+ end
+else begin if help_ptr=0 then
+ help2("Sorry, I don't know how to help in this situation.")@/
+ @t\kern1em@>("Maybe you should try asking a human?");
+ repeat decr(help_ptr); print(help_line[help_ptr]); print_ln;
+ until help_ptr=0;
+ end;
+help4("Sorry, I already gave what help I could...")@/
+ ("Maybe you should try asking a human?")@/
+ ("An error might have occurred before I noticed any problems.")@/
+ ("``If all else fails, read the instructions.''");@/
+goto continue;
+end
+
+@ @<Print the string |err_help|, possibly on several lines@>=
+j:=str_start[err_help];
+while j<str_stop(err_help) do
+ begin if str_pool[j]<>si("%") then print(so(str_pool[j]))
+ else if j+1=str_stop(err_help) then print_ln
+ else if str_pool[j+1]<>si("%") then print_ln
+ else begin incr(j); print_char("%");
+ end;
+ incr(j);
+ end
+
+@ @<Put help message on the transcript file@>=
+if interaction>batch_mode then decr(selector); {avoid terminal output}
+if use_err_help then
+ begin print_nl("");
+ @<Print the string |err_help|, possibly on several lines@>;
+ end
+else while help_ptr>0 do
+ begin decr(help_ptr); print_nl(help_line[help_ptr]);
+ end;
+print_ln;
+if interaction>batch_mode then incr(selector); {re-enable terminal output}
+print_ln
+
+@ In anomalous cases, the print selector might be in an unknown state;
+the following subroutine is called to fix things just enough to keep
+running a bit longer.
+
+@p procedure normalize_selector;
+begin if log_opened then selector:=term_and_log
+else selector:=term_only;
+if job_name=0 then open_log_file;
+if interaction=batch_mode then decr(selector);
+end;
+
+@ The following procedure prints \MP's last words before dying.
+
+@d succumb==begin if interaction=error_stop_mode then
+ interaction:=scroll_mode; {no more interaction}
+ if log_opened then error;
+ @!debug if interaction>batch_mode then debug_help;@;@+gubed@;@/
+ history:=fatal_error_stop; jump_out; {irrecoverable error}
+ end
+
+@<Error hand...@>=
+procedure fatal_error(@!s:str_number); {prints |s|, and that's it}
+begin normalize_selector;@/
+print_err("Emergency stop"); help1(s); succumb;
+@.Emergency stop@>
+end;
+
+@ Here is the most dreaded error message.
+
+@<Error hand...@>=
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("MetaPost capacity exceeded, sorry [");
+@.MetaPost capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+ ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+
+@ The program might sometime run completely amok, at which point there is
+no choice but to stop. If no previous error has been detected, that's bad
+news; a message is printed that is really intended for the \MP\
+maintenance person instead of the user (unless the user has been
+particularly diabolical). The index entries for `this can't happen' may
+help to pinpoint the problem.
+@^dry rot@>
+
+@<Error hand...@>=
+procedure confusion(@!s:str_number);
+ {consistency check violated; |s| tells where}
+begin normalize_selector;
+if history<error_message_issued then
+ begin print_err("This can't happen ("); print(s); print_char(")");
+@.This can't happen@>
+ help1("I'm broken. Please show this to someone who can fix can fix");
+ end
+else begin print_err("I can't go on meeting you like this");
+@.I can't go on...@>
+ help2("One of your faux pas seems to have wounded me deeply...")@/
+ ("in fact, I'm barely conscious. Please fix it and try again.");
+ end;
+succumb;
+end;
+
+@ Users occasionally want to interrupt \MP\ while it's running.
+If the \PASCAL\ runtime system allows this, one can implement
+a routine that sets the global variable |interrupt| to some nonzero value
+when such an interrupt is signaled. Otherwise there is probably at least
+a way to make |interrupt| nonzero using the \PASCAL\ debugger.
+@^system dependencies@>
+@^debugging@>
+
+@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
+ end
+
+@<Global...@>=
+@!interrupt:integer; {should \MP\ pause for instructions?}
+@!OK_to_interrupt:boolean; {should interrupts be observed?}
+
+@ @<Set init...@>=
+interrupt:=0; OK_to_interrupt:=true;
+
+@ When an interrupt has been detected, the program goes into its
+highest interaction level and lets the user have the full flexibility of
+the |error| routine. \MP\ checks for interrupts only at times when it is
+safe to do this.
+
+@p procedure pause_for_instructions;
+begin if OK_to_interrupt then
+ begin interaction:=error_stop_mode;
+ if (selector=log_only)or(selector=no_print) then
+ incr(selector);
+ print_err("Interruption");
+@.Interruption@>
+ help3("You rang?")@/
+ ("Try to insert some instructions for me (e.g.,`I show x'),")@/
+ ("unless you just want to quit by typing `X'.");
+ deletions_allowed:=false; error; deletions_allowed:=true;
+ interrupt:=0;
+ end;
+end;
+
+@ Many of \MP's error messages state that a missing token has been
+inserted behind the scenes. We can save string space and program space
+by putting this common code into a subroutine.
+
+@p procedure missing_err(@!s:str_number);
+begin print_err("Missing `"); print(s); print("' has been inserted");
+@.Missing...inserted@>
+end;
+
+@* \[7] Arithmetic with scaled numbers.
+The principal computations performed by \MP\ are done entirely in terms of
+integers less than $2^{31}$ in magnitude; thus, the arithmetic specified in this
+program can be carried out in exactly the same way on a wide variety of
+computers, including some small ones.
+@^small computers@>
+
+But \PASCAL\ does not define the @!|div|
+operation in the case of negative dividends; for example, the result of
+|(-2*n-1) div 2| is |-(n+1)| on some computers and |-n| on others.
+There are two principal types of arithmetic: ``translation-preserving,''
+in which the identity |(a+q*b)div b=(a div b)+q| is valid; and
+``negation-preserving,'' in which |(-a)div b=-(a div b)|. This leads to
+two \MP s, which can produce different results, although the differences
+should be negligible when the language is being used properly.
+The \TeX\ processor has been defined carefully so that both varieties
+of arithmetic will produce identical output, but it would be too
+inefficient to constrain \MP\ in a similar way.
+
+@d el_gordo == @'17777777777 {$2^{31}-1$, the largest value that \MP\ likes}
+
+@ One of \MP's most common operations is the calculation of
+$\lfloor{a+b\over2}\rfloor$,
+the midpoint of two given integers |a| and~|b|. The only decent way to do
+this in \PASCAL\ is to write `|(a+b) div 2|'; but on most machines it is
+far more efficient to calculate `|(a+b)| right shifted one bit'.
+
+Therefore the midpoint operation will always be denoted by `|half(a+b)|'
+in this program. If \MP\ is being implemented with languages that permit
+binary shifting, the |half| macro should be changed to make this operation
+as efficient as possible. Since some languages have shift operators that can
+only be trusted to work on positive numbers, there is also a macro |halfp|
+that is used only when the quantity being halved is known to be positive
+or zero.
+
+@d half(#)==(#) div 2
+@d halfp(#)==(#) div 2
+
+@ A single computation might use several subroutine calls, and it is
+desirable to avoid producing multiple error messages in case of arithmetic
+overflow. So the routines below set the global variable |arith_error| to |true|
+instead of reporting errors directly to the user.
+
+@<Glob...@>=
+@!arith_error:boolean; {has arithmetic overflow occurred recently?}
+
+@ @<Set init...@>=
+arith_error:=false;
+
+@ At crucial points the program will say |check_arith|, to test if
+an arithmetic error has been detected.
+
+@d check_arith==begin if arith_error then clear_arith;@+end
+
+@p procedure clear_arith;
+begin print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+help4("Uh, oh. A little while ago one of the quantities that I was")@/
+ ("computing got too large, so I'm afraid your answers will be")@/
+ ("somewhat askew. You'll probably have to adopt different")@/
+ ("tactics next time. But I shall try to carry on anyway.");
+error; arith_error:=false;
+end;
+
+@ Addition is not always checked to make sure that it doesn't overflow,
+but in places where overflow isn't too unlikely the |slow_add| routine
+is used.
+
+@p function slow_add(@!x,@!y:integer):integer;
+begin if x>=0 then
+ if y<=el_gordo-x then slow_add:=x+y
+ else begin arith_error:=true; slow_add:=el_gordo;
+ end
+else if -y<=el_gordo+x then slow_add:=x+y
+ else begin arith_error:=true; slow_add:=-el_gordo;
+ end;
+end;
+
+@ Fixed-point arithmetic is done on {\sl scaled integers\/} that are multiples
+of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit
+positions from the right end of a binary computer word.
+
+@d quarter_unit == @'40000 {$2^{14}$, represents 0.250000}
+@d half_unit == @'100000 {$2^{15}$, represents 0.50000}
+@d three_quarter_unit == @'140000 {$3\cdot2^{14}$, represents 0.75000}
+@d unity == @'200000 {$2^{16}$, represents 1.00000}
+@d two == @'400000 {$2^{17}$, represents 2.00000}
+@d three == @'600000 {$2^{17}+2^{16}$, represents 3.00000}
+
+@<Types...@>=
+@!scaled = integer; {this type is used for scaled integers}
+@!small_number=0..63; {this type is self-explanatory}
+
+@ The following function is used to create a scaled integer from a given decimal
+fraction $(.d_0d_1\ldots d_{k-1})$, where |0<=k<=17|. The digit $d_i$ is
+given in |dig[i]|, and the calculation produces a correctly rounded result.
+
+@p function round_decimals(@!k:small_number) : scaled;
+ {converts a decimal fraction}
+var @!a:integer; {the accumulator}
+begin a:=0;
+while k>0 do
+ begin decr(k); a:=(a+dig[k]*two) div 10;
+ end;
+round_decimals:=halfp(a+1);
+end;
+
+@ Conversely, here is a procedure analogous to |print_int|. If the output
+of this procedure is subsequently read by \MP\ and converted by the
+|round_decimals| routine above, it turns out that the original value will
+be reproduced exactly. A decimal point is printed only if the value is
+not an integer. If there is more than one way to print the result with
+the optimum number of digits following the decimal point, the closest
+possible value is given.
+
+The invariant relation in the \&{repeat} loop is that a sequence of
+decimal digits yet to be printed will yield the original number if and only if
+they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$.
+We can stop if and only if $f=0$ satisfies this condition; the loop will
+terminate before $s$ can possibly become zero.
+
+@<Basic printing...@>=
+procedure print_scaled(@!s:scaled); {prints scaled real, rounded to five
+ digits}
+var @!delta:scaled; {amount of allowable inaccuracy}
+begin if s<0 then
+ begin print_char("-"); negate(s); {print the sign, if negative}
+ end;
+print_int(s div unity); {print the integer part}
+s:=10*(s mod unity)+5;
+if s<>5 then
+ begin delta:=10; print_char(".");
+ repeat if delta>unity then
+ s:=s+@'100000-(delta div 2); {round the final digit}
+ print_char("0"+(s div unity)); s:=10*(s mod unity); delta:=delta*10;
+ until s<=delta;
+ end;
+end;
+
+@ We often want to print two scaled quantities in parentheses,
+separated by a comma.
+
+@<Basic printing...@>=
+procedure print_two(@!x,@!y:scaled); {prints `|(x,y)|'}
+begin print_char("("); print_scaled(x); print_char(","); print_scaled(y);
+print_char(")");
+end;
+
+@ The |scaled| quantities in \MP\ programs are generally supposed to be
+less than $2^{12}$ in absolute value, so \MP\ does much of its internal
+arithmetic with 28~significant bits of precision. A |fraction| denotes
+a scaled integer whose binary point is assumed to be 28 bit positions
+from the right.
+
+@d fraction_half==@'1000000000 {$2^{27}$, represents 0.50000000}
+@d fraction_one==@'2000000000 {$2^{28}$, represents 1.00000000}
+@d fraction_two==@'4000000000 {$2^{29}$, represents 2.00000000}
+@d fraction_three==@'6000000000 {$3\cdot2^{28}$, represents 3.00000000}
+@d fraction_four==@'10000000000 {$2^{30}$, represents 4.00000000}
+
+@<Types...@>=
+@!fraction=integer; {this type is used for scaled fractions}
+
+@ In fact, the two sorts of scaling discussed above aren't quite
+sufficient; \MP\ has yet another, used internally to keep track of angles
+in units of $2^{-20}$ degrees.
+
+@d forty_five_deg==@'264000000 {$45\cdot2^{20}$, represents $45^\circ$}
+@d ninety_deg==@'550000000 {$90\cdot2^{20}$, represents $90^\circ$}
+@d one_eighty_deg==@'1320000000 {$180\cdot2^{20}$, represents $180^\circ$}
+@d three_sixty_deg==@'2640000000 {$360\cdot2^{20}$, represents $360^\circ$}
+
+@<Types...@>=
+@!angle=integer; {this type is used for scaled angles}
+
+@ The |make_fraction| routine produces the |fraction| equivalent of
+|p/q|, given integers |p| and~|q|; it computes the integer
+$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are
+positive. If |p| and |q| are both of the same scaled type |t|,
+the ``type relation'' |make_fraction(t,t)=fraction| is valid;
+and it's also possible to use the subroutine ``backwards,'' using
+the relation |make_fraction(t,fraction)=t| between scaled types.
+
+If the result would have magnitude $2^{31}$ or more, |make_fraction|
+sets |arith_error:=true|. Most of \MP's internal computations have
+been designed to avoid this sort of error.
+
+If this subroutine were programmed in assembly language on a typical
+machine, we could simply compute |(@t$2^{28}$@>*p)div q|, since a
+double-precision product can often be input to a fixed-point division
+instruction. But when we are restricted to \PASCAL\ arithmetic it
+is necessary either to resort to multiple-precision maneuvering
+or to use a simple but slow iteration. The multiple-precision technique
+would be about three times faster than the code adopted here, but it
+would be comparatively long and tricky, involving about sixteen
+additional multiplications and divisions.
+
+This operation is part of \MP's ``inner loop''; indeed, it will
+consume nearly 10\pct! of the running time (exclusive of input and output)
+if the code below is left unchanged. A machine-dependent recoding
+will therefore make \MP\ run faster. The present implementation
+is highly portable, but slow; it avoids multiplication and division
+except in the initial stage. System wizards should be careful to
+replace it with a routine that is guaranteed to produce identical
+results in all cases.
+@^system dependencies@>
+
+As noted below, a few more routines should also be replaced by machine-dependent
+code, for efficiency. But when a procedure is not part of the ``inner loop,''
+such changes aren't advisable; simplicity and robustness are
+preferable to trickery, unless the cost is too high.
+@^inner loop@>
+
+@p function make_fraction(@!p,@!q:integer):fraction;
+var @!f:integer; {the fraction bits, with a leading 1 bit}
+@!n:integer; {the integer part of $\vert p/q\vert$}
+@!negative:boolean; {should the result be negated?}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin if p>=0 then negative:=false
+else begin negate(p); negative:=true;
+ end;
+if q<=0 then
+ begin debug if q=0 then confusion("/");@;@+gubed@;@/
+@:this can't happen /}{\quad \./@>
+ negate(q); negative:=not negative;
+ end;
+n:=p div q; p:=p mod q;
+if n>=8 then
+ begin arith_error:=true;
+ if negative then make_fraction:=-el_gordo@+else make_fraction:=el_gordo;
+ end
+else begin n:=(n-1)*fraction_one;
+ @<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>;
+ if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n;
+ end;
+end;
+
+@ The |repeat| loop here preserves the following invariant relations
+between |f|, |p|, and~|q|:
+(i)~|0<=p<q|; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and
+$p_0$ is the original value of~$p$.
+
+Notice that the computation specifies
+|(p-q)+p| instead of |(p+p)-q|, because the latter could overflow.
+Let us hope that optimizing compilers do not miss this point; a
+special variable |be_careful| is used to emphasize the necessary
+order of computation. Optimizing compilers should keep |be_careful|
+in a register, not store it in memory.
+@^inner loop@>
+
+@<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>=
+f:=1;
+repeat be_careful:=p-q; p:=be_careful+p;
+if p>=0 then f:=f+f+1
+else begin double(f); p:=p+q;
+ end;
+until f>=fraction_one;
+be_careful:=p-q;
+if be_careful+p>=0 then incr(f)
+
+@ The dual of |make_fraction| is |take_fraction|, which multiplies a
+given integer~|q| by a fraction~|f|. When the operands are positive, it
+computes $p=\lfloor qf/2^{28}+{1\over2}\rfloor$, a symmetric function
+of |q| and~|f|.
+
+This routine is even more ``inner loopy'' than |make_fraction|;
+the present implementation consumes almost 20\pct! of \MP's computation
+time during typical jobs, so a machine-language substitute is advisable.
+@^inner loop@> @^system dependencies@>
+
+@p function take_fraction(@!q:integer;@!f:fraction):integer;
+var @!p:integer; {the fraction so far}
+@!negative:boolean; {should the result be negated?}
+@!n:integer; {additional multiple of $q$}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin @<Reduce to the case that |f>=0| and |q>0|@>;
+if f<fraction_one then n:=0
+else begin n:=f div fraction_one; f:=f mod fraction_one;
+ if q<=el_gordo div n then n:=n*q
+ else begin arith_error:=true; n:=el_gordo;
+ end;
+ end;
+f:=f+fraction_one;
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>;
+be_careful:=n-el_gordo;
+if be_careful+p>0 then
+ begin arith_error:=true; n:=el_gordo-p;
+ end;
+if negative then take_fraction:=-(n+p)
+else take_fraction:=n+p;
+end;
+
+@ @<Reduce to the case that |f>=0| and |q>0|@>=
+if f>=0 then negative:=false
+else begin negate(f); negative:=true;
+ end;
+if q<0 then
+ begin negate(q); negative:=not negative;
+ end;
+
+@ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor
+=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and
+$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$.
+@^inner loop@>
+
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>=
+p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$}
+if q<fraction_four then
+ repeat if odd(f) then p:=halfp(p+q)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+else repeat if odd(f) then p:=p+halfp(q-p)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+
+
+@ When we want to multiply something by a |scaled| quantity, we use a scheme
+analogous to |take_fraction| but with a different scaling.
+Given positive operands, |take_scaled|
+computes the quantity $p=\lfloor qf/2^{16}+{1\over2}\rfloor$.
+
+Once again it is a good idea to use a machine-language replacement if
+possible; otherwise |take_scaled| will use more than 2\pct! of the running time
+when the Computer Modern fonts are being generated.
+@^inner loop@>
+
+@p function take_scaled(@!q:integer;@!f:scaled):integer;
+var @!p:integer; {the fraction so far}
+@!negative:boolean; {should the result be negated?}
+@!n:integer; {additional multiple of $q$}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin @<Reduce to the case that |f>=0| and |q>0|@>;
+if f<unity then n:=0
+else begin n:=f div unity; f:=f mod unity;
+ if q<=el_gordo div n then n:=n*q
+ else begin arith_error:=true; n:=el_gordo;
+ end;
+ end;
+f:=f+unity;
+@<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>;
+be_careful:=n-el_gordo;
+if be_careful+p>0 then
+ begin arith_error:=true; n:=el_gordo-p;
+ end;
+if negative then take_scaled:=-(n+p)
+else take_scaled:=n+p;
+end;
+
+@ @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>=
+p:=half_unit; {that's $2^{15}$; the invariants hold now with $k=16$}
+@^inner loop@>
+if q<fraction_four then
+ repeat if odd(f) then p:=halfp(p+q)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+else repeat if odd(f) then p:=p+halfp(q-p)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+
+@ For completeness, there's also |make_scaled|, which computes a
+quotient as a |scaled| number instead of as a |fraction|.
+In other words, the result is $\lfloor2^{16}p/q+{1\over2}\rfloor$, if the
+operands are positive. \ (This procedure is not used especially often,
+so it is not part of \MP's inner loop.)
+
+@p function make_scaled(@!p,@!q:integer):scaled;
+var @!f:integer; {the fraction bits, with a leading 1 bit}
+@!n:integer; {the integer part of $\vert p/q\vert$}
+@!negative:boolean; {should the result be negated?}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin if p>=0 then negative:=false
+else begin negate(p); negative:=true;
+ end;
+if q<=0 then
+ begin debug if q=0 then confusion("/");@+gubed@;@/
+@:this can't happen /}{\quad \./@>
+ negate(q); negative:=not negative;
+ end;
+n:=p div q; p:=p mod q;
+if n>=@'100000 then
+ begin arith_error:=true;
+ if negative then make_scaled:=-el_gordo@+else make_scaled:=el_gordo;
+ end
+else begin n:=(n-1)*unity;
+ @<Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$@>;
+ if negative then make_scaled:=-(f+n)@+else make_scaled:=f+n;
+ end;
+end;
+
+@ @<Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$@>=
+f:=1;
+repeat be_careful:=p-q; p:=be_careful+p;
+if p>=0 then f:=f+f+1
+else begin double(f); p:=p+q;
+ end;
+until f>=unity;
+be_careful:=p-q;
+if be_careful+p>=0 then incr(f)
+
+@ Here is a typical example of how the routines above can be used.
+It computes the function
+$${1\over3\tau}f(\theta,\phi)=
+{\tau^{-1}\bigl(2+\sqrt2\,(\sin\theta-{1\over16}\sin\phi)
+ (\sin\phi-{1\over16}\sin\theta)(\cos\theta-\cos\phi)\bigr)\over
+3\,\bigl(1+{1\over2}(\sqrt5-1)\cos\theta+{1\over2}(3-\sqrt5\,)\cos\phi\bigr)},$$
+where $\tau$ is a |scaled| ``tension'' parameter. This is \MP's magic
+fudge factor for placing the first control point of a curve that starts
+at an angle $\theta$ and ends at an angle $\phi$ from the straight path.
+(Actually, if the stated quantity exceeds 4, \MP\ reduces it to~4.)
+
+The trigonometric quantity to be multiplied by $\sqrt2$ is less than $\sqrt2$.
+(It's a sum of eight terms whose absolute values can be bounded using
+relations such as $\sin\theta\cos\theta\L{1\over2}$.) Thus the numerator
+is positive; and since the tension $\tau$ is constrained to be at least
+$3\over4$, the numerator is less than $16\over3$. The denominator is
+nonnegative and at most~6. Hence the fixed-point calculations below
+are guaranteed to stay within the bounds of a 32-bit computer word.
+
+The angles $\theta$ and $\phi$ are given implicitly in terms of |fraction|
+arguments |st|, |ct|, |sf|, and |cf|, representing $\sin\theta$, $\cos\theta$,
+$\sin\phi$, and $\cos\phi$, respectively.
+
+@p function velocity(@!st,@!ct,@!sf,@!cf:fraction;@!t:scaled):fraction;
+var @!acc,@!num,@!denom:integer; {registers for intermediate calculations}
+begin acc:=take_fraction(st-(sf div 16), sf-(st div 16));
+acc:=take_fraction(acc,ct-cf);
+num:=fraction_two+take_fraction(acc,379625062);
+ {$2^{28}\sqrt2\approx379625062.497$}
+denom:=fraction_three+take_fraction(ct,497706707)+take_fraction(cf,307599661);
+ {$3\cdot2^{27}\cdot(\sqrt5-1)\approx497706706.78$ and
+ $3\cdot2^{27}\cdot(3-\sqrt5\,)\approx307599661.22$}
+if t<>unity then num:=make_scaled(num,t);
+ {|make_scaled(fraction,scaled)=fraction|}
+if num div 4>=denom then velocity:=fraction_four
+else velocity:=make_fraction(num,denom);
+end;
+
+@ The following somewhat different subroutine tests rigorously if $ab$ is
+greater than, equal to, or less than~$cd$,
+given integers $(a,b,c,d)$. In most cases a quick decision is reached.
+The result is $+1$, 0, or~$-1$ in the three respective cases.
+
+@d return_sign(#)==begin ab_vs_cd:=#; return;
+ end
+
+@p function ab_vs_cd(@!a,b,c,d:integer):integer;
+label exit;
+var @!q,@!r:integer; {temporary registers}
+begin @<Reduce to the case that |a,c>=0|, |b,d>0|@>;
+loop@+ begin q := a div d; r := c div b;
+ if q<>r then
+ if q>r then return_sign(1)@+else return_sign(-1);
+ q := a mod d; r := c mod b;
+ if r=0 then
+ if q=0 then return_sign(0)@+else return_sign(1);
+ if q=0 then return_sign(-1);
+ a:=b; b:=q; c:=d; d:=r;
+ end; {now |a>d>0| and |c>b>0|}
+exit:end;
+
+@ @<Reduce to the case that |a...@>=
+if a<0 then
+ begin negate(a); negate(b);
+ end;
+if c<0 then
+ begin negate(c); negate(d);
+ end;
+if d<=0 then
+ begin if b>=0 then
+ if ((a=0)or(b=0))and((c=0)or(d=0)) then return_sign(0)
+ else return_sign(1);
+ if d=0 then
+ if a=0 then return_sign(0)@+else return_sign(-1);
+ q:=a; a:=c; c:=q; q:=-b; b:=-d; d:=q;
+ end
+else if b<=0 then
+ begin if b<0 then if a>0 then return_sign(-1);
+ if c=0 then return_sign(0) else return_sign(-1);
+ end
+
+@ We conclude this set of elementary routines with some simple rounding
+and truncation operations that are coded in a machine-independent fashion.
+The routines are slightly complicated because we want them to work
+without overflow whenever $-2^{31}\L x<2^{31}$.
+
+@p function floor_scaled(@!x:scaled):scaled;
+ {$2^{16}\lfloor x/2^{16}\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=0 then floor_scaled:=x-(x mod unity)
+else begin be_careful:=x+1;
+ floor_scaled:=x+((-be_careful) mod unity)+1-unity;
+ end;
+end;
+@#
+function round_unscaled(@!x:scaled):integer;
+ {$\lfloor x/2^{16}+.5\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=half_unit then round_unscaled:=1+((x-half_unit) div unity)
+else if x>=-half_unit then round_unscaled:=0
+else begin be_careful:=x+1;
+ round_unscaled:=-(1+((-be_careful-half_unit) div unity));
+ end;
+end;
+@#
+function round_fraction(@!x:fraction):scaled;
+ {$\lfloor x/2^{12}+.5\rfloor$}
+var @!be_careful:integer; {temporary register}
+begin if x>=2048 then round_fraction:=1+((x-2048) div 4096)
+else if x>=-2048 then round_fraction:=0
+else begin be_careful:=x+1;
+ round_fraction:=-(1+((-be_careful-2048) div 4096));
+ end;
+end;
+
+@* \[8] Algebraic and transcendental functions.
+\MP\ computes all of the necessary special functions from scratch, without
+relying on |real| arithmetic or system subroutines for sines, cosines, etc.
+
+@ To get the square root of a |scaled| number |x|, we want to calculate
+$s=\lfloor 2^8\!\sqrt x +{1\over2}\rfloor$. If $x>0$, this is the unique
+integer such that $2^{16}x-s\L s^2<2^{16}x+s$. The following subroutine
+determines $s$ by an iterative method that maintains the invariant
+relations $x=2^{46-2k}x_0\bmod 2^{30}$, $0<y=\lfloor 2^{16-2k}x_0\rfloor
+-s^2+s\L q=2s$, where $x_0$ is the initial value of $x$. The value of~$y$
+might, however, be zero at the start of the first iteration.
+
+@p function square_rt(@!x:scaled):scaled;
+var @!k:small_number; {iteration control counter}
+@!y,@!q:integer; {registers for intermediate calculations}
+begin if x<=0 then @<Handle square root of zero or negative argument@>
+else begin k:=23; q:=2;
+ while x<fraction_two do {i.e., |while x<@t$2^{29}$@>|\unskip}
+ begin decr(k); x:=x+x+x+x;
+ end;
+ if x<fraction_four then y:=0
+ else begin x:=x-fraction_four; y:=1;
+ end;
+ repeat @<Decrease |k| by 1, maintaining the invariant
+ relations between |x|, |y|, and~|q|@>;
+ until k=0;
+ square_rt:=halfp(q);
+ end;
+end;
+
+@ @<Handle square root of zero...@>=
+begin if x<0 then
+ begin print_err("Square root of ");
+@.Square root...replaced by 0@>
+ print_scaled(x); print(" has been replaced by 0");
+ help2("Since I don't take square roots of negative numbers,")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+ error;
+ end;
+square_rt:=0;
+end
+
+@ @<Decrease |k| by 1, maintaining...@>=
+double(x); double(y);
+if x>=fraction_four then {note that |fraction_four=@t$2^{30}$@>|}
+ begin x:=x-fraction_four; incr(y);
+ end;
+double(x); y:=y+y-q; double(q);
+if x>=fraction_four then
+ begin x:=x-fraction_four; incr(y);
+ end;
+if y>q then
+ begin y:=y-q; q:=q+2;
+ end
+else if y<=0 then
+ begin q:=q-2; y:=y+q;
+ end;
+decr(k)
+
+@ Pythagorean addition $\psqrt{a^2+b^2}$ is implemented by an elegant
+iterative scheme due to Cleve Moler and Donald Morrison [{\sl IBM Journal
+@^Moler, Cleve Barry@>
+@^Morrison, Donald Ross@>
+of Research and Development\/ \bf27} (1983), 577--581]. It modifies |a| and~|b|
+in such a way that their Pythagorean sum remains invariant, while the
+smaller argument decreases.
+
+@p function pyth_add(@!a,@!b:integer):integer;
+label done;
+var @!r:fraction; {register used to transform |a| and |b|}
+@!big:boolean; {is the result dangerously near $2^{31}$?}
+begin a:=abs(a); b:=abs(b);
+if a<b then
+ begin r:=b; b:=a; a:=r;
+ end; {now |0<=b<=a|}
+if b>0 then
+ begin if a<fraction_two then big:=false
+ else begin a:=a div 4; b:=b div 4; big:=true;
+ end; {we reduced the precision to avoid arithmetic overflow}
+ @<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>;
+ if big then
+ if a<fraction_two then a:=a+a+a+a
+ else begin arith_error:=true; a:=el_gordo;
+ end;
+ end;
+pyth_add:=a;
+end;
+
+@ The key idea here is to reflect the vector $(a,b)$ about the
+line through $(a,b/2)$.
+
+@<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>=
+loop@+ begin r:=make_fraction(b,a);
+ r:=take_fraction(r,r); {now $r\approx b^2/a^2$}
+ if r=0 then goto done;
+ r:=make_fraction(r,fraction_four+r);
+ a:=a+take_fraction(a+a,r); b:=take_fraction(b,r);
+ end;
+done:
+
+@ Here is a similar algorithm for $\psqrt{a^2-b^2}$.
+It converges slowly when $b$ is near $a$, but otherwise it works fine.
+
+@p function pyth_sub(@!a,@!b:integer):integer;
+label done;
+var @!r:fraction; {register used to transform |a| and |b|}
+@!big:boolean; {is the input dangerously near $2^{31}$?}
+begin a:=abs(a); b:=abs(b);
+if a<=b then @<Handle erroneous |pyth_sub| and set |a:=0|@>
+else begin if a<fraction_four then big:=false
+ else begin a:=halfp(a); b:=halfp(b); big:=true;
+ end;
+ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>;
+ if big then a:=a+a;
+ end;
+pyth_sub:=a;
+end;
+
+@ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>=
+loop@+ begin r:=make_fraction(b,a);
+ r:=take_fraction(r,r); {now $r\approx b^2/a^2$}
+ if r=0 then goto done;
+ r:=make_fraction(r,fraction_four-r);
+ a:=a-take_fraction(a+a,r); b:=take_fraction(b,r);
+ end;
+done:
+
+@ @<Handle erroneous |pyth_sub| and set |a:=0|@>=
+begin if a<b then
+ begin print_err("Pythagorean subtraction "); print_scaled(a);
+ print("+-+"); print_scaled(b); print(" has been replaced by 0");
+@.Pythagorean...@>
+ help2("Since I don't take square roots of negative numbers,")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+ error;
+ end;
+a:=0;
+end
+
+@ The subroutines for logarithm and exponential involve two tables.
+The first is simple: |two_to_the[k]| equals $2^k$. The second involves
+a bit more calculation, which the author claims to have done correctly:
+|spec_log[k]| is $2^{27}$ times $\ln\bigl(1/(1-2^{-k})\bigr)=
+2^{-k}+{1\over2}2^{-2k}+{1\over3}2^{-3k}+\cdots\,$, rounded to the
+nearest integer.
+
+@<Glob...@>=
+@!two_to_the:array[0..30] of integer; {powers of two}
+@!spec_log:array[1..28] of integer; {special logarithms}
+
+@ @<Local variables for initialization@>=
+@!k:integer; {all-purpose loop index}
+
+@ @<Set init...@>=
+two_to_the[0]:=1;
+for k:=1 to 30 do two_to_the[k]:=2*two_to_the[k-1];
+spec_log[1]:=93032640;
+spec_log[2]:=38612034;
+spec_log[3]:=17922280;
+spec_log[4]:=8662214;
+spec_log[5]:=4261238;
+spec_log[6]:=2113709;
+spec_log[7]:=1052693;
+spec_log[8]:=525315;
+spec_log[9]:=262400;
+spec_log[10]:=131136;
+spec_log[11]:=65552;
+spec_log[12]:=32772;
+spec_log[13]:=16385;
+for k:=14 to 27 do spec_log[k]:=two_to_the[27-k];
+spec_log[28]:=1;
+
+@ Here is the routine that calculates $2^8$ times the natural logarithm
+of a |scaled| quantity; it is an integer approximation to $2^{24}\ln(x/2^{16})$,
+when |x| is a given positive integer.
+
+The method is based on exercise 1.2.2--25 in {\sl The Art of Computer
+Programming\/}: During the main iteration we have $1\L 2^{-30}x<1/(1-2^{1-k})$,
+and the logarithm of $2^{30}x$ remains to be added to an accumulator
+register called~$y$. Three auxiliary bits of accuracy are retained in~$y$
+during the calculation, and sixteen auxiliary bits to extend |y| are
+kept in~|z| during the initial argument reduction. (We add
+$100\cdot2^{16}=6553600$ to~|z| and subtract 100 from~|y| so that |z| will
+not become negative; also, the actual amount subtracted from~|y| is~96,
+not~100, because we want to add~4 for rounding before the final division by~8.)
+
+@p function m_log(@!x:scaled):scaled;
+var @!y,@!z:integer; {auxiliary registers}
+@!k:integer; {iteration counter}
+begin if x<=0 then @<Handle non-positive logarithm@>
+else begin y:=1302456956+4-100; {$14\times2^{27}\ln2\approx1302456956.421063$}
+ z:=27595+6553600; {and $2^{16}\times .421063\approx 27595$}
+ while x<fraction_four do
+ begin double(x); y:=y-93032639; z:=z-48782;
+ end; {$2^{27}\ln2\approx 93032639.74436163$
+ and $2^{16}\times.74436163\approx 48782$}
+ y:=y+(z div unity); k:=2;
+ while x>fraction_four+4 do
+ @<Increase |k| until |x| can be multiplied by a
+ factor of $2^{-k}$, and adjust $y$ accordingly@>;
+ m_log:=y div 8;
+ end;
+end;
+
+@ @<Increase |k| until |x| can...@>=
+begin z:=((x-1) div two_to_the[k])+1; {$z=\lceil x/2^k\rceil$}
+while x<fraction_four+z do
+ begin z:=halfp(z+1); k:=k+1;
+ end;
+y:=y+spec_log[k]; x:=x-z;
+end
+
+@ @<Handle non-positive logarithm@>=
+begin print_err("Logarithm of ");
+@.Logarithm...replaced by 0@>
+print_scaled(x); print(" has been replaced by 0");
+help2("Since I don't take logs of non-positive numbers,")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+error; m_log:=0;
+end
+
+@ Conversely, the exponential routine calculates $\exp(x/2^8)$,
+when |x| is |scaled|. The result is an integer approximation to
+$2^{16}\exp(x/2^{24})$, when |x| is regarded as an integer.
+
+@p function m_exp(@!x:scaled):scaled;
+var @!k:small_number; {loop control index}
+@!y,@!z:integer; {auxiliary registers}
+begin if x>174436200 then
+ {$2^{24}\ln((2^{31}-1)/2^{16})\approx 174436199.51$}
+ begin arith_error:=true; m_exp:=el_gordo;
+ end
+else if x<-197694359 then m_exp:=0
+ {$2^{24}\ln(2^{-1}/2^{16})\approx-197694359.45$}
+else begin if x<=0 then
+ begin z:=-8*x; y:=@'4000000; {$y=2^{20}$}
+ end
+ else begin if x<=127919879 then z:=1023359037-8*x
+ {$2^{27}\ln((2^{31}-1)/2^{20})\approx 1023359037.125$}
+ else z:=8*(174436200-x); {|z| is always nonnegative}
+ y:=el_gordo;
+ end;
+ @<Multiply |y| by $\exp(-z/2^{27})$@>;
+ if x<=127919879 then m_exp:=(y+8) div 16@+else m_exp:=y;
+ end;
+end;
+
+@ The idea here is that subtracting |spec_log[k]| from |z| corresponds
+to multiplying |y| by $1-2^{-k}$.
+
+A subtle point (which had to be checked) was that if $x=127919879$, the
+value of~|y| will decrease so that |y+8| doesn't overflow. In fact,
+$z$ will be 5 in this case, and |y| will decrease by~64 when |k=25|
+and by~16 when |k=27|.
+
+@<Multiply |y| by...@>=
+k:=1;
+while z>0 do
+ begin while z>=spec_log[k] do
+ begin z:=z-spec_log[k];
+ y:=y-1-((y-two_to_the[k-1]) div two_to_the[k]);
+ end;
+ incr(k);
+ end
+
+@ The trigonometric subroutines use an auxiliary table such that
+|spec_atan[k]| contains an approximation to the |angle| whose tangent
+is~$1/2^k$.
+
+@<Glob...@>=
+@!spec_atan:array[1..26] of angle; {$\arctan2^{-k}$ times $2^{20}\cdot180/\pi$}
+
+@ @<Set init...@>=
+spec_atan[1]:=27855475;
+spec_atan[2]:=14718068;
+spec_atan[3]:=7471121;
+spec_atan[4]:=3750058;
+spec_atan[5]:=1876857;
+spec_atan[6]:=938658;
+spec_atan[7]:=469357;
+spec_atan[8]:=234682;
+spec_atan[9]:=117342;
+spec_atan[10]:=58671;
+spec_atan[11]:=29335;
+spec_atan[12]:=14668;
+spec_atan[13]:=7334;
+spec_atan[14]:=3667;
+spec_atan[15]:=1833;
+spec_atan[16]:=917;
+spec_atan[17]:=458;
+spec_atan[18]:=229;
+spec_atan[19]:=115;
+spec_atan[20]:=57;
+spec_atan[21]:=29;
+spec_atan[22]:=14;
+spec_atan[23]:=7;
+spec_atan[24]:=4;
+spec_atan[25]:=2;
+spec_atan[26]:=1;
+
+@ Given integers |x| and |y|, not both zero, the |n_arg| function
+returns the |angle| whose tangent points in the direction $(x,y)$.
+This subroutine first determines the correct octant, then solves the
+problem for |0<=y<=x|, then converts the result appropriately to
+return an answer in the range |-one_eighty_deg<=@t$\theta$@><=one_eighty_deg|.
+(The answer is |+one_eighty_deg| if |y=0| and |x<0|, but an answer of
+|-one_eighty_deg| is possible if, for example, |y=-1| and $x=-2^{30}$.)
+
+The octants are represented in a ``Gray code,'' since that turns out
+to be computationally simplest.
+
+@d negate_x=1
+@d negate_y=2
+@d switch_x_and_y=4
+@d first_octant=1
+@d second_octant=first_octant+switch_x_and_y
+@d third_octant=first_octant+switch_x_and_y+negate_x
+@d fourth_octant=first_octant+negate_x
+@d fifth_octant=first_octant+negate_x+negate_y
+@d sixth_octant=first_octant+switch_x_and_y+negate_x+negate_y
+@d seventh_octant=first_octant+switch_x_and_y+negate_y
+@d eighth_octant=first_octant+negate_y
+
+@p function n_arg(@!x,@!y:integer):angle;
+var @!z:angle; {auxiliary register}
+@!t:integer; {temporary storage}
+@!k:small_number; {loop counter}
+@!octant:first_octant..sixth_octant; {octant code}
+begin if x>=0 then octant:=first_octant
+else begin negate(x); octant:=first_octant+negate_x;
+ end;
+if y<0 then
+ begin negate(y); octant:=octant+negate_y;
+ end;
+if x<y then
+ begin t:=y; y:=x; x:=t; octant:=octant+switch_x_and_y;
+ end;
+if x=0 then @<Handle undefined arg@>
+else begin @<Set variable |z| to the arg of $(x,y)$@>;
+ @<Return an appropriate answer based on |z| and |octant|@>;
+ end;
+end;
+
+@ @<Handle undefined arg@>=
+begin print_err("angle(0,0) is taken as zero");
+@.angle(0,0)...zero@>
+help2("The `angle' between two identical points is undefined.")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+error; n_arg:=0;
+end
+
+@ @<Return an appropriate answer...@>=
+case octant of
+first_octant:n_arg:=z;
+second_octant:n_arg:=ninety_deg-z;
+third_octant:n_arg:=ninety_deg+z;
+fourth_octant:n_arg:=one_eighty_deg-z;
+fifth_octant:n_arg:=z-one_eighty_deg;
+sixth_octant:n_arg:=-z-ninety_deg;
+seventh_octant:n_arg:=z-ninety_deg;
+eighth_octant:n_arg:=-z;
+end {there are no other cases}
+
+@ At this point we have |x>=y>=0|, and |x>0|. The numbers are scaled up
+or down until $2^{28}\L x<2^{29}$, so that accurate fixed-point calculations
+will be made.
+
+@<Set variable |z| to the arg...@>=
+while x>=fraction_two do
+ begin x:=halfp(x); y:=halfp(y);
+ end;
+z:=0;
+if y>0 then
+ begin while x<fraction_one do
+ begin double(x); double(y);
+ end;
+ @<Increase |z| to the arg of $(x,y)$@>;
+ end
+
+@ During the calculations of this section, variables |x| and~|y|
+represent actual coordinates $(x,2^{-k}y)$. We will maintain the
+condition |x>=y|, so that the tangent will be at most $2^{-k}$.
+If $x<2y$, the tangent is greater than $2^{-k-1}$. The transformation
+$(a,b)\mapsto(a+b\tan\phi,b-a\tan\phi)$ replaces $(a,b)$ by
+coordinates whose angle has decreased by~$\phi$; in the special case
+$a=x$, $b=2^{-k}y$, and $\tan\phi=2^{-k-1}$, this operation reduces
+to the particularly simple iteration shown here. [Cf.~John E. Meggitt,
+@^Meggitt, John E.@>
+{\sl IBM Journal of Research and Development\/ \bf6} (1962), 210--226.]
+
+The initial value of |x| will be multiplied by at most
+$(1+{1\over2})(1+{1\over8})(1+{1\over32})\cdots\approx 1.7584$; hence
+there is no chance of integer overflow.
+
+@<Increase |z|...@>=
+k:=0;
+repeat double(y); incr(k);
+if y>x then
+ begin z:=z+spec_atan[k]; t:=x; x:=x+(y div two_to_the[k+k]); y:=y-t;
+ end;
+until k=15;
+repeat double(y); incr(k);
+if y>x then
+ begin z:=z+spec_atan[k]; y:=y-x;
+ end;
+until k=26
+
+@ Conversely, the |n_sin_cos| routine takes an |angle| and produces the sine
+and cosine of that angle. The results of this routine are
+stored in global integer variables |n_sin| and |n_cos|.
+
+@<Glob...@>=
+@!n_sin,@!n_cos:fraction; {results computed by |n_sin_cos|}
+
+@ Given an integer |z| that is $2^{20}$ times an angle $\theta$ in degrees,
+the purpose of |n_sin_cos(z)| is to set
+|x=@t$r\cos\theta$@>| and |y=@t$r\sin\theta$@>| (approximately),
+for some rather large number~|r|. The maximum of |x| and |y|
+will be between $2^{28}$ and $2^{30}$, so that there will be hardly
+any loss of accuracy. Then |x| and~|y| are divided by~|r|.
+
+@p procedure n_sin_cos(@!z:angle); {computes a multiple of the sine and cosine}
+var @!k:small_number; {loop control variable}
+@!q:0..7; {specifies the quadrant}
+@!r:fraction; {magnitude of |(x,y)|}
+@!x,@!y,@!t:integer; {temporary registers}
+begin while z<0 do z:=z+three_sixty_deg;
+z:=z mod three_sixty_deg; {now |0<=z<three_sixty_deg|}
+q:=z div forty_five_deg; z:=z mod forty_five_deg;
+x:=fraction_one; y:=x;
+if not odd(q) then z:=forty_five_deg-z;
+@<Subtract angle |z| from |(x,y)|@>;
+@<Convert |(x,y)| to the octant determined by~|q|@>;
+r:=pyth_add(x,y); n_cos:=make_fraction(x,r); n_sin:=make_fraction(y,r);
+end;
+
+@ In this case the octants are numbered sequentially.
+
+@<Convert |(x,...@>=
+case q of
+0:do_nothing;
+1:begin t:=x; x:=y; y:=t;
+ end;
+2:begin t:=x; x:=-y; y:=t;
+ end;
+3:negate(x);
+4:begin negate(x); negate(y);
+ end;
+5:begin t:=x; x:=-y; y:=-t;
+ end;
+6:begin t:=x; x:=y; y:=-t;
+ end;
+7:negate(y);
+end {there are no other cases}
+
+@ The main iteration of |n_sin_cos| is similar to that of |n_arg| but
+applied in reverse. The values of |spec_atan[k]| decrease slowly enough
+that this loop is guaranteed to terminate before the (nonexistent) value
+|spec_atan[27]| would be required.
+
+@<Subtract angle |z|...@>=
+k:=1;
+while z>0 do
+ begin if z>=spec_atan[k] then
+ begin z:=z-spec_atan[k]; t:=x;@/
+ x:=t+y div two_to_the[k];
+ y:=y-t div two_to_the[k];
+ end;
+ incr(k);
+ end;
+if y<0 then y:=0 {this precaution may never be needed}
+
+@ And now let's complete our collection of numeric utility routines
+by considering random number generation.
+\MP\ generates pseudo-random numbers with the additive scheme recommended
+in Section 3.6 of {\sl The Art of Computer Programming}; however, the
+results are random fractions between 0 and |fraction_one-1|, inclusive.
+
+There's an auxiliary array |randoms| that contains 55 pseudo-random
+fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod 2^{28}$,
+we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
+The global variable |j_random| tells which element has most recently
+been consumed.
+The global variable |sys_random_seed| was introduced in version 0.9,
+for the sole reason of stressing the fact that the initial value of the
+random seed is system-dependant. The pascal code below will initialize
+this variable to |(internal[time] div unity)+internal[day]|, but this is
+not good enough on modern fast machines that are capable of running
+multiple MetaPost processes within the same second.
+@^system dependencies@>
+
+@<Glob...@>=
+@!randoms:array[0..54] of fraction; {the last 55 random values generated}
+@!j_random:0..54; {the number of unused |randoms|}
+@!sys_random_seed:scaled; {the default random seed}
+
+@ To consume a random fraction, the program below will say `|next_random|'
+and then it will fetch |randoms[j_random]|.
+
+@d next_random==if j_random=0 then new_randoms
+ else decr(j_random)
+
+@p procedure new_randoms;
+var @!k:0..54; {index into |randoms|}
+@!x:fraction; {accumulator}
+begin for k:=0 to 23 do
+ begin x:=randoms[k]-randoms[k+31];
+ if x<0 then x:=x+fraction_one;
+ randoms[k]:=x;
+ end;
+for k:=24 to 54 do
+ begin x:=randoms[k]-randoms[k-24];
+ if x<0 then x:=x+fraction_one;
+ randoms[k]:=x;
+ end;
+j_random:=54;
+end;
+
+@ To initialize the |randoms| table, we call the following routine.
+
+@p procedure init_randoms(@!seed:scaled);
+var @!j,@!jj,@!k:fraction; {more or less random integers}
+@!i:0..54; {index into |randoms|}
+begin j:=abs(seed);
+while j>=fraction_one do j:=halfp(j);
+k:=1;
+for i:=0 to 54 do
+ begin jj:=k; k:=j-k; j:=jj;
+ if k<0 then k:=k+fraction_one;
+ randoms[(i*21)mod 55]:=j;
+ end;
+new_randoms; new_randoms; new_randoms; {``warm up'' the array}
+end;
+
+@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x|
+or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
+
+Note that the call of |take_fraction| will produce the values 0 and~|x|
+with about half the probability that it will produce any other particular
+values between 0 and~|x|, because it rounds its answers.
+
+@p function unif_rand(@!x:scaled):scaled;
+var @!y:scaled; {trial value}
+begin next_random; y:=take_fraction(abs(x),randoms[j_random]);
+if y=abs(x) then unif_rand:=0
+else if x>0 then unif_rand:=y
+else unif_rand:=-y;
+end;
+
+@ Finally, a normal deviate with mean zero and unit standard deviation
+can readily be obtained with the ratio method (Algorithm 3.4.1R in
+{\sl The Art of Computer Programming\/}).
+
+@p function norm_rand:scaled;
+var @!x,@!u,@!l:integer; {what the book would call $2^{16}X$, $2^{28}U$,
+ and $-2^{24}\ln U$}
+begin repeat
+ repeat next_random;
+ x:=take_fraction(112429,randoms[j_random]-fraction_half);
+ {$2^{16}\sqrt{8/e}\approx 112428.82793$}
+ next_random; u:=randoms[j_random];
+ until abs(x)<u;
+x:=make_fraction(x,u);
+l:=139548960-m_log(u); {$2^{24}\cdot12\ln2\approx139548959.6165$}
+until ab_vs_cd(1024,l,x,x)>=0;
+norm_rand:=x;
+end;
+
+@* \[9] Packed data.
+In order to make efficient use of storage space, \MP\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a small number of fields that are one half or one
+quarter of the size used for storing integers.
+
+If |x| is a variable of type |memory_word|, it contains up to four
+fields that can be referred to as follows:
+$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr
+|x|&.|int|&(an |integer|)\cr
+|x|&.|sc|\qquad&(a |scaled| integer)\cr
+|x.hh.lh|, |x.hh|&.|rh|&(two halfword fields)\cr
+|x.hh.b0|, |x.hh.b1|, |x.hh|&.|rh|&(two quarterword fields, one halfword
+ field)\cr
+|x.qqqq.b0|, |x.qqqq.b1|, |x.qqqq|&.|b2|, |x.qqqq.b3|\hskip-100pt
+ &\qquad\qquad\qquad(four quarterword fields)\cr}}$$
+This is somewhat cumbersome to write, and not very readable either, but
+macros will be used to make the notation shorter and more transparent.
+The \PASCAL\ code below gives a formal definition of |memory_word| and
+its subsidiary types, using packed variant records. \MP\ makes no
+assumptions about the relative positions of the fields within a word.
+
+Since we are assuming 32-bit integers, a halfword must contain at least
+16 bits, and a quarterword must contain at least 8 bits.
+@^system dependencies@>
+But it doesn't hurt to have more bits; for example, with enough 36-bit
+words you might be able to have |mem_max| as large as 262142.
+
+N.B.: Valuable memory space will be dreadfully wasted unless \MP\ is compiled
+by a \PASCAL\ that packs all of the |memory_word| variants into
+the space of a single integer. Some \PASCAL\ compilers will pack an
+integer whose subrange is `|0..255|' into an eight-bit field, but others
+insist on allocating space for an additional sign bit; on such systems you
+can get 256 values into a quarterword only if the subrange is `|-128..127|'.
+
+The present implementation tries to accommodate as many variations as possible,
+so it makes few assumptions. If integers having the subrange
+`|min_quarterword..max_quarterword|' can be packed into a quarterword,
+and if integers having the subrange `|min_halfword..max_halfword|'
+can be packed into a halfword, everything should work satisfactorily.
+
+It is usually most efficient to have |min_quarterword=min_halfword=0|,
+so one should try to achieve this unless it causes a severe problem.
+The values defined here are recommended for most 32-bit computers.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+
+@ Here are the inequalities that the quarterword and halfword values
+must satisfy (or rather, the inequalities that they mustn't satisfy):
+
+@<Check the ``constant''...@>=
+init if mem_max<>mem_top then bad:=8;@+tini@;@/
+if mem_max<mem_top then bad:=8;
+if (min_quarterword>0)or(max_quarterword<127) then bad:=9;
+if (min_halfword>0)or(max_halfword<32767) then bad:=10;
+if (min_quarterword<min_halfword)or@|
+ (max_quarterword>max_halfword) then bad:=11;
+if (mem_min<min_halfword)or(mem_max>=max_halfword) then bad:=12;
+if max_strings>max_halfword then bad:=13;
+if buf_size>max_halfword then bad:=14;
+if font_max>max_halfword then bad:=15;
+if (max_quarterword-min_quarterword<255)or@|
+ (max_halfword-min_halfword<65535) then bad:=16;
+
+@ The operation of subtracting |min_halfword| occurs rather frequently in
+\MP, so it is convenient to abbreviate this operation by using the macro
+|ho| defined here. \MP\ will run faster with respect to compilers that
+don't optimize the expression `|x-0|', if this macro is simplified in the
+obvious way when |min_halfword=0|. Similarly, |qi| and |qo| are used for
+input to and output from quarterwords.
+@^system dependencies@>
+
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@d qo(#)==#-min_quarterword {to read eight bits from a quarterword}
+@d qi(#)==#+min_quarterword {to store eight bits in a quarterword}
+
+@ The reader should study the following definitions closely:
+@^system dependencies@>
+
+@d sc==int {|scaled| data is equivalent to |integer|}
+
+@<Types...@>=
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!three_choices = 1..3; {used when there are three variants in a record}
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case three_choices of
+ 1: (@!int:integer);
+ 2: (@!hh:two_halves);
+ 3: (@!qqqq:four_quarters);
+ end;
+@!word_file = file of memory_word;
+
+@ When debugging, we may want to print a |memory_word| without knowing
+what type it is; so we print it in all modes.
+@^dirty \PASCAL@>@^debugging@>
+
+@p @!debug procedure print_word(@!w:memory_word);
+ {prints |w| in all ways}
+begin print_int(w.int); print_char(" ");@/
+print_scaled(w.sc); print_char(" "); print_scaled(w.sc div @'10000); print_ln;@/
+print_int(w.hh.lh); print_char("="); print_int(w.hh.b0); print_char(":");
+print_int(w.hh.b1); print_char(";"); print_int(w.hh.rh); print_char(" ");@/
+print_int(w.qqqq.b0); print_char(":"); print_int(w.qqqq.b1); print_char(":");
+print_int(w.qqqq.b2); print_char(":"); print_int(w.qqqq.b3);
+end;
+gubed
+
+@* \[10] Dynamic memory allocation.
+The \MP\ system does nearly all of its own memory allocation, so that it
+can readily be transported into environments that do not have automatic
+facilities for strings, garbage collection, etc., and so that it can be in
+control of what error messages the user receives. The dynamic storage
+requirements of \MP\ are handled by providing a large array |mem| in
+which consecutive blocks of words are used as nodes by the \MP\ routines.
+
+Pointer variables are indices into this array, or into another array
+called |eqtb| that will be explained later. A pointer variable might
+also be a special flag that lies outside the bounds of |mem|, so we
+allow pointers to assume any |halfword| value. The minimum memory
+index represents a null pointer.
+
+@d pointer==halfword {a flag or a location in |mem| or |eqtb|}
+@d null==mem_min {the null pointer}
+
+@ The |mem| array is divided into two regions that are allocated separately,
+but the dividing line between these two regions is not fixed; they grow
+together until finding their ``natural'' size in a particular job.
+Locations less than or equal to |lo_mem_max| are used for storing
+variable-length records consisting of two or more words each. This region
+is maintained using an algorithm similar to the one described in exercise
+2.5--19 of {\sl The Art of Computer Programming}. However, no size field
+appears in the allocated nodes; the program is responsible for knowing the
+relevant size when a node is freed. Locations greater than or equal to
+|hi_mem_min| are used for storing one-word records; a conventional
+\.{AVAIL} stack is used for allocation in this region.
+
+Locations of |mem| between |mem_min| and |mem_top| may be dumped as part
+of preloaded format files, by the \.{INIMP} preprocessor.
+@.INIMP@>
+Production versions of \MP\ may extend the memory at the top end in order to
+provide more space; these locations, between |mem_top| and |mem_max|,
+are always used for single-word nodes.
+
+The key pointers that govern |mem| allocation have a prescribed order:
+$$\hbox{|null=mem_min<lo_mem_max<hi_mem_min<mem_top<=mem_end<=mem_max|.}$$
+
+@<Glob...@>=
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@!lo_mem_max : pointer; {the largest location of variable-size memory in use}
+@!hi_mem_min : pointer; {the smallest location of one-word memory in use}
+
+@ Users who wish to study the memory requirements of particular applications can
+can use optional special features that keep track of current and
+maximum memory usage. When code between the delimiters |@!stat| $\ldots$
+|tats| is not ``commented out,'' \MP\ will run a bit slower but it will
+report these statistics when |tracing_stats| is positive.
+
+@<Glob...@>=
+@!var_used, @!dyn_used : integer; {how much memory is in use}
+
+@ Let's consider the one-word memory region first, since it's the
+simplest. The pointer variable |mem_end| holds the highest-numbered location
+of |mem| that has ever been used. The free locations of |mem| that
+occur between |hi_mem_min| and |mem_end|, inclusive, are of type
+|two_halves|, and we write |info(p)| and |link(p)| for the |lh|
+and |rh| fields of |mem[p]| when it is of this type. The single-word
+free locations form a linked list
+$$|avail|,\;\hbox{|link(avail)|},\;\hbox{|link(link(avail))|},\;\ldots$$
+terminated by |null|.
+
+@d link(#) == mem[#].hh.rh {the |link| field of a memory word}
+@d info(#) == mem[#].hh.lh {the |info| field of a memory word}
+
+@<Glob...@>=
+@!avail : pointer; {head of the list of available one-word nodes}
+@!mem_end : pointer; {the last one-word node used in |mem|}
+
+@ If one-word memory is exhausted, it might mean that the user has forgotten
+a token like `\&{enddef}' or `\&{endfor}'. We will define some procedures
+later that try to help pinpoint the trouble.
+
+@p @t\4@>@<Declare the procedure called |show_token_list|@>@;
+@t\4@>@<Declare the procedure called |runaway|@>
+
+@ The function |get_avail| returns a pointer to a new one-word node whose
+|link| field is null. However, \MP\ will halt if there is no more room left.
+@^inner loop@>
+
+@p function get_avail : pointer; {single-word node allocation}
+var @!p:pointer; {the new node being got}
+begin p:=avail; {get top location in the |avail| stack}
+if p<>null then avail:=link(avail) {and pop it off}
+else if mem_end<mem_max then {or go into virgin territory}
+ begin incr(mem_end); p:=mem_end;
+ end
+else begin decr(hi_mem_min); p:=hi_mem_min;
+ if hi_mem_min<=lo_mem_max then
+ begin runaway; {if memory is exhausted, display possible runaway text}
+ overflow("main memory size",mem_max+1-mem_min);
+ {quit; all one-word nodes are busy}
+@:MetaPost capacity exceeded main memory size}{\quad main memory size@>
+ end;
+ end;
+link(p):=null; {provide an oft-desired initialization of the new node}
+@!stat incr(dyn_used);@+tats@;{maintain statistics}
+get_avail:=p;
+end;
+
+@ Conversely, a one-word node is recycled by calling |free_avail|.
+
+@d free_avail(#)== {single-word node liberation}
+ begin link(#):=avail; avail:=#;
+ @!stat decr(dyn_used);@+tats@/
+ end
+
+@ There's also a |fast_get_avail| routine, which saves the procedure-call
+overhead at the expense of extra programming. This macro is used in
+the places that would otherwise account for the most calls of |get_avail|.
+@^inner loop@>
+
+@d fast_get_avail(#)==@t@>@;@/
+ begin #:=avail; {avoid |get_avail| if possible, to save time}
+ if #=null then #:=get_avail
+ else begin avail:=link(#); link(#):=null;
+ @!stat incr(dyn_used);@+tats@/
+ end;
+ end
+
+@ The available-space list that keeps track of the variable-size portion
+of |mem| is a nonempty, doubly-linked circular list of empty nodes,
+pointed to by the roving pointer |rover|.
+
+Each empty node has size 2 or more; the first word contains the special
+value |max_halfword| in its |link| field and the size in its |info| field;
+the second word contains the two pointers for double linking.
+
+Each nonempty node also has size 2 or more. Its first word is of type
+|two_halves|\kern-1pt, and its |link| field is never equal to |max_halfword|.
+Otherwise there is complete flexibility with respect to the contents
+of its other fields and its other words.
+
+(We require |mem_max<max_halfword| because terrible things can happen
+when |max_halfword| appears in the |link| field of a nonempty node.)
+
+@d empty_flag == max_halfword {the |link| of an empty variable-size node}
+@d is_empty(#) == (link(#)=empty_flag) {tests for empty node}
+@d node_size == info {the size field in empty variable-size nodes}
+@d llink(#) == info(#+1) {left link in doubly-linked list of empty nodes}
+@d rlink(#) == link(#+1) {right link in doubly-linked list of empty nodes}
+
+@<Glob...@>=
+@!rover : pointer; {points to some node in the list of empties}
+
+@ A call to |get_node| with argument |s| returns a pointer to a new node
+of size~|s|, which must be 2~or more. The |link| field of the first word
+of this new node is set to null. An overflow stop occurs if no suitable
+space exists.
+
+If |get_node| is called with $s=2^{30}$, it simply merges adjacent free
+areas and returns the value |max_halfword|.
+
+@p function get_node(@!s:integer):pointer; {variable-size node allocation}
+label found,exit,restart;
+var @!p:pointer; {the node currently under inspection}
+@!q:pointer; {the node physically after node |p|}
+@!r:integer; {the newly allocated node, or a candidate for this honor}
+@!t,@!tt:integer; {temporary registers}
+@^inner loop@>
+begin restart: p:=rover; {start at some free node in the ring}
+repeat @<Try to allocate within node |p| and its physical successors,
+ and |goto found| if allocation was possible@>;
+p:=rlink(p); {move to the next node in the ring}
+until p=rover; {repeat until the whole list has been traversed}
+if s=@'10000000000 then
+ begin get_node:=max_halfword; return;
+ end;
+if lo_mem_max+2<hi_mem_min then if lo_mem_max+2<=mem_min+max_halfword then
+ @<Grow more variable-size memory and |goto restart|@>;
+overflow("main memory size",mem_max+1-mem_min);
+ {sorry, nothing satisfactory is left}
+@:MetaPost capacity exceeded main memory size}{\quad main memory size@>
+found: link(r):=null; {this node is now nonempty}
+@!stat var_used:=var_used+s; {maintain usage statistics}
+tats@;@/
+get_node:=r;
+exit:end;
+
+@ The lower part of |mem| grows by 1000 words at a time, unless
+we are very close to going under. When it grows, we simply link
+a new node into the available-space list. This method of controlled
+growth helps to keep the |mem| usage consecutive when \MP\ is
+implemented on ``virtual memory'' systems.
+@^virtual memory@>
+
+@<Grow more variable-size memory and |goto restart|@>=
+begin if hi_mem_min-lo_mem_max>=1998 then t:=lo_mem_max+1000
+else t:=lo_mem_max+1+(hi_mem_min-lo_mem_max) div 2;
+ {|lo_mem_max+2<=t<hi_mem_min|}
+if t>mem_min+max_halfword then t:=mem_min+max_halfword;
+p:=llink(rover); q:=lo_mem_max; rlink(p):=q; llink(rover):=q;@/
+rlink(q):=rover; llink(q):=p; link(q):=empty_flag; node_size(q):=t-lo_mem_max;@/
+lo_mem_max:=t; link(lo_mem_max):=null; info(lo_mem_max):=null;
+rover:=q; goto restart;
+end
+
+@ @<Try to allocate...@>=
+q:=p+node_size(p); {find the physical successor}
+while is_empty(q) do {merge node |p| with node |q|}
+ begin t:=rlink(q); tt:=llink(q);
+@^inner loop@>
+ if q=rover then rover:=t;
+ llink(t):=tt; rlink(tt):=t;@/
+ q:=q+node_size(q);
+ end;
+r:=q-s;
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+if r=p then if rlink(p)<>p then
+ @<Allocate entire node |p| and |goto found|@>;
+node_size(p):=q-p {reset the size in case it grew}
+
+@ @<Allocate from the top...@>=
+begin node_size(p):=r-p; {store the remaining size}
+rover:=p; {start searching here next time}
+goto found;
+end
+
+@ Here we delete node |p| from the ring, and let |rover| rove around.
+
+@<Allocate entire...@>=
+begin rover:=rlink(p); t:=llink(p);
+llink(rover):=t; rlink(t):=rover;
+goto found;
+end
+
+@ Conversely, when some variable-size node |p| of size |s| is no longer needed,
+the operation |free_node(p,s)| will make its words available, by inserting
+|p| as a new empty node just before where |rover| now points.
+
+@p procedure free_node(@!p:pointer; @!s:halfword); {variable-size node
+ liberation}
+var @!q:pointer; {|llink(rover)|}
+begin node_size(p):=s; link(p):=empty_flag;
+@^inner loop@>
+q:=llink(rover); llink(p):=q; rlink(p):=rover; {set both links}
+llink(rover):=p; rlink(q):=p; {insert |p| into the ring}
+@!stat var_used:=var_used-s;@+tats@;{maintain statistics}
+end;
+
+@ Just before \.{INIMP} writes out the memory, it sorts the doubly linked
+available space list. The list is probably very short at such times, so a
+simple insertion sort is used. The smallest available location will be
+pointed to by |rover|, the next-smallest by |rlink(rover)|, etc.
+
+@p @!init procedure sort_avail; {sorts the available variable-size nodes
+ by location}
+var @!p,@!q,@!r: pointer; {indices into |mem|}
+@!old_rover:pointer; {initial |rover| setting}
+begin p:=get_node(@'10000000000); {merge adjacent free areas}
+p:=rlink(rover); rlink(rover):=max_halfword; old_rover:=rover;
+while p<>old_rover do @<Sort |p| into the list starting at |rover|
+ and advance |p| to |rlink(p)|@>;
+p:=rover;
+while rlink(p)<>max_halfword do
+ begin llink(rlink(p)):=p; p:=rlink(p);
+ end;
+rlink(p):=rover; llink(rover):=p;
+end;
+tini
+
+@ The following |while| loop is guaranteed to
+terminate, since the list that starts at
+|rover| ends with |max_halfword| during the sorting procedure.
+
+@<Sort |p|...@>=
+if p<rover then
+ begin q:=p; p:=rlink(q); rlink(q):=rover; rover:=q;
+ end
+else begin q:=rover;
+ while rlink(q)<p do q:=rlink(q);
+ r:=rlink(p); rlink(p):=rlink(q); rlink(q):=p; p:=r;
+ end
+
+@* \[11] Memory layout.
+Some areas of |mem| are dedicated to fixed usage, since static allocation is
+more efficient than dynamic allocation when we can get away with it. For
+example, locations |mem_min| to |mem_min+1| are always used to store a
+two-word dummy token whose second word is zero.
+The following macro definitions accomplish the static allocation by giving
+symbolic names to the fixed positions. Static variable-size nodes appear
+in locations |mem_min| through |lo_mem_stat_max|, and static single-word nodes
+appear in locations |hi_mem_stat_min| through |mem_top|, inclusive.
+
+@d null_dash==mem_min+2 {the first two words are reserved for a null value}
+@d dep_head==null_dash+3 {we will define |dash_node_size=3|}
+@d zero_val==dep_head+2 {two words for a permanently zero value}
+@d temp_val==zero_val+2 {two words for a temporary value node}
+@d end_attr==temp_val {we use |end_attr+2| only}
+@d inf_val==end_attr+2 {and |inf_val+1| only}
+@d test_pen==inf_val+2
+ {nine words for a pen used when testing the turning number}
+@d bad_vardef==test_pen+9 {two words for \&{vardef} error recovery}
+@d lo_mem_stat_max==bad_vardef+1 {largest statically
+ allocated word in the variable-size |mem|}
+@#
+@d sentinel==mem_top {end of sorted lists}
+@d temp_head==mem_top-1 {head of a temporary list of some kind}
+@d hold_head==mem_top-2 {head of a temporary list of another kind}
+@d spec_head==mem_top-3 {head of a list of unprocessed \&{special} items}
+@d hi_mem_stat_min==mem_top-3 {smallest statically allocated word in
+ the one-word |mem|}
+
+@ The following code gets the dynamic part of |mem| off to a good start,
+when \MP\ is initializing itself the slow way.
+
+@<Initialize table entries (done by \.{INIMP} only)@>=
+@^data structure assumptions@>
+rover:=lo_mem_stat_max+1; {initialize the dynamic memory}
+link(rover):=empty_flag;
+node_size(rover):=1000; {which is a 1000-word available node}
+llink(rover):=rover; rlink(rover):=rover;@/
+lo_mem_max:=rover+1000; link(lo_mem_max):=null; info(lo_mem_max):=null;@/
+for k:=hi_mem_stat_min to mem_top do
+ mem[k]:=mem[lo_mem_max]; {clear list heads}
+avail:=null; mem_end:=mem_top;
+hi_mem_min:=hi_mem_stat_min; {initialize the one-word memory}
+var_used:=lo_mem_stat_max+1-mem_min; dyn_used:=mem_top+1-(hi_mem_stat_min);
+ {initialize statistics}
+@<Initialize a pen at |test_pen| so that it fits in nine words@>;
+
+@ The procedure |flush_list(p)| frees an entire linked list of one-word
+nodes that starts at a given position, until coming to |sentinel| or a
+pointer that is not in the one-word region. Another procedure,
+|flush_node_list|, frees an entire linked list of one-word and two-word
+nodes, until coming to a |null| pointer.
+@^inner loop@>
+
+@p procedure flush_list(@!p:pointer); {makes list of single-word nodes
+ available}
+label done;
+var @!q,@!r:pointer; {list traversers}
+begin if p>=hi_mem_min then if p<>sentinel then
+ begin r:=p;
+ repeat q:=r; r:=link(r); @!stat decr(dyn_used);@+tats@/
+ if r<hi_mem_min then goto done;
+ until r=sentinel;
+ done: {now |q| is the last node on the list}
+ link(q):=avail; avail:=p;
+ end;
+end;
+@#
+procedure flush_node_list(@!p:pointer);
+var @!q:pointer; {the node being recycled}
+begin while p<>null do
+ begin q:=p; p:=link(p);
+ if q<hi_mem_min then free_node(q,2)@+else free_avail(q);
+ end;
+end;
+
+@ If \MP\ is extended improperly, the |mem| array might get screwed up.
+For example, some pointers might be wrong, or some ``dead'' nodes might not
+have been freed when the last reference to them disappeared. Procedures
+|check_mem| and |search_mem| are available to help diagnose such
+problems. These procedures make use of two arrays called |free| and
+|was_free| that are present only if \MP's debugging routines have
+been included. (You may want to decrease the size of |mem| while you
+@^debugging@>
+are debugging.)
+
+@<Glob...@>=
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip1em@>@!was_free: packed array [mem_min..mem_max] of boolean;
+ {previously free cells}
+@t\hskip1em@>@!was_mem_end,@!was_lo_max,@!was_hi_min: pointer;
+ {previous |mem_end|, |lo_mem_max|,and |hi_mem_min|}
+@t\hskip1em@>@!panicking:boolean; {do we want to check memory constantly?}
+gubed
+
+@ @<Set initial...@>=
+@!debug was_mem_end:=mem_min; {indicate that everything was previously free}
+was_lo_max:=mem_min; was_hi_min:=mem_max;
+panicking:=false;
+gubed
+
+@ Procedure |check_mem| makes sure that the available space lists of
+|mem| are well formed, and it optionally prints out all locations
+that are reserved now but were free the last time this procedure was called.
+
+@p @!debug procedure check_mem(@!print_locs : boolean);
+label done1,done2,done3; {loop exits}
+var @!p,@!q,@!r:pointer; {current locations of interest in |mem|}
+@!clobbered:boolean; {is something amiss?}
+begin for p:=mem_min to lo_mem_max do free[p]:=false; {you can probably
+ do this faster}
+for p:=hi_mem_min to mem_end do free[p]:=false; {ditto}
+@<Check single-word |avail| list@>;
+@<Check variable-size |avail| list@>;
+@<Check flags of unavailable nodes@>;
+@<Check the list of linear dependencies@>;
+if print_locs then @<Print newly busy locations@>;
+for p:=mem_min to lo_mem_max do was_free[p]:=free[p];
+for p:=hi_mem_min to mem_end do was_free[p]:=free[p];
+ {|was_free:=free| might be faster}
+was_mem_end:=mem_end; was_lo_max:=lo_mem_max; was_hi_min:=hi_mem_min;
+end;
+gubed
+
+@ @<Check single-word...@>=
+p:=avail; q:=null; clobbered:=false;
+while p<>null do
+ begin if (p>mem_end)or(p<hi_mem_min) then clobbered:=true
+ else if free[p] then clobbered:=true;
+ if clobbered then
+ begin print_nl("AVAIL list clobbered at ");
+@.AVAIL list clobbered...@>
+ print_int(q); goto done1;
+ end;
+ free[p]:=true; q:=p; p:=link(q);
+ end;
+done1:
+
+@ @<Check variable-size...@>=
+p:=rover; q:=null; clobbered:=false;
+repeat if (p>=lo_mem_max)or(p<mem_min) then clobbered:=true
+ else if (rlink(p)>=lo_mem_max)or(rlink(p)<mem_min) then clobbered:=true
+ else if not(is_empty(p))or(node_size(p)<2)or@|
+ (p+node_size(p)>lo_mem_max)or@| (llink(rlink(p))<>p) then clobbered:=true;
+ if clobbered then
+ begin print_nl("Double-AVAIL list clobbered at ");
+@.Double-AVAIL list clobbered...@>
+ print_int(q); goto done2;
+ end;
+for q:=p to p+node_size(p)-1 do {mark all locations free}
+ begin if free[q] then
+ begin print_nl("Doubly free location at ");
+@.Doubly free location...@>
+ print_int(q); goto done2;
+ end;
+ free[q]:=true;
+ end;
+q:=p; p:=rlink(p);
+until p=rover;
+done2:
+
+@ @<Check flags...@>=
+p:=mem_min;
+while p<=lo_mem_max do {node |p| should not be empty}
+ begin if is_empty(p) then
+ begin print_nl("Bad flag at "); print_int(p);
+@.Bad flag...@>
+ end;
+ while (p<=lo_mem_max) and not free[p] do incr(p);
+ while (p<=lo_mem_max) and free[p] do incr(p);
+ end
+
+@ @<Print newly busy...@>=
+begin @<Do intialization required before printing new busy locations@>;
+print_nl("New busy locs:");
+@.New busy locs@>
+for p:=mem_min to lo_mem_max do
+ if not free[p] and ((p>was_lo_max) or was_free[p]) then
+ @<Indicate that |p| is a new busy location@>;
+for p:=hi_mem_min to mem_end do
+ if not free[p] and
+ ((p<was_hi_min) or (p>was_mem_end) or was_free[p]) then
+ @<Indicate that |p| is a new busy location@>;
+@<Finish printing new busy locations@>;
+end
+
+@ There might be many new busy locations so we are careful to print contiguous
+blocks compactly. During this operation |q| is the last new busy location and
+|r| is the start of the block containing |q|.
+
+@<Indicate that |p| is a new busy location@>=
+begin if p>q+1 then
+ begin if q>r then
+ begin print(".."); print_int(q);
+ end;
+ print_char(" "); print_int(p);
+ r:=p;
+ end;
+q:=p;
+end
+
+@ @<Do intialization required before printing new busy locations@>=
+q:=mem_max; r:=mem_max
+
+@ @<Finish printing new busy locations@>=
+if q>r then
+ begin print(".."); print_int(q);
+ end
+
+@ The |search_mem| procedure attempts to answer the question ``Who points
+to node~|p|?'' In doing so, it fetches |link| and |info| fields of |mem|
+that might not be of type |two_halves|. Strictly speaking, this is
+@^dirty \PASCAL@>
+undefined in \PASCAL, and it can lead to ``false drops'' (words that seem to
+point to |p| purely by coincidence). But for debugging purposes, we want
+to rule out the places that do {\sl not\/} point to |p|, so a few false
+drops are tolerable.
+
+@p @!debug procedure search_mem(@!p:pointer); {look for pointers to |p|}
+var @!q:integer; {current position being searched}
+begin for q:=mem_min to lo_mem_max do
+ begin if link(q)=p then
+ begin print_nl("LINK("); print_int(q); print_char(")");
+ end;
+ if info(q)=p then
+ begin print_nl("INFO("); print_int(q); print_char(")");
+ end;
+ end;
+for q:=hi_mem_min to mem_end do
+ begin if link(q)=p then
+ begin print_nl("LINK("); print_int(q); print_char(")");
+ end;
+ if info(q)=p then
+ begin print_nl("INFO("); print_int(q); print_char(")");
+ end;
+ end;
+@<Search |eqtb| for equivalents equal to |p|@>;
+end;
+gubed
+
+@* \[12] The command codes.
+Before we can go much further, we need to define symbolic names for the internal
+code numbers that represent the various commands obeyed by \MP. These codes
+are somewhat arbitrary, but not completely so. For example,
+some codes have been made adjacent so that |case| statements in the
+program need not consider cases that are widely spaced, or so that |case|
+statements can be replaced by |if| statements. A command can begin an
+expression if and only if its code lies between |min_primary_command| and
+|max_primary_command|, inclusive. The first token of a statement that doesn't
+begin with an expression has a command code between |min_command| and
+|max_statement_command|, inclusive. Anything less than |min_command| is
+eliminated during macro expansions, and anything no more than |max_pre_command|
+is eliminated when expanding \TeX\ material. Ranges such as
+|min_secondary_command..max_secondary_command| are used when parsing
+expressions, but the relative ordering within such a range is generally not
+critical.
+
+The ordering of the highest-numbered commands
+(|comma<semicolon<end_group<stop|) is crucial for the parsing and
+error-recovery methods of this program as is the ordering |if_test<fi_or_else|
+for the smallest two commands. The ordering is also important in the ranges
+|numeric_token..plus_or_minus| and |left_brace..ampersand|.
+
+At any rate, here is the list, for future reference.
+
+@d start_tex=1 {begin \TeX\ material (\&{btex}, \&{verbatimtex})}
+@d etex_marker=2 {end \TeX\ material (\&{etex})}
+@d mpx_break=3 {stop reading an \.{MPX} file (\&{mpxbreak})}
+@d max_pre_command=mpx_break
+@d if_test=4 {conditional text (\&{if})}
+@d fi_or_else=5 {delimiters for conditionals (\&{elseif}, \&{else}, \&{fi}}
+@d input=6 {input a source file (\&{input}, \&{endinput})}
+@d iteration=7 {iterate (\&{for}, \&{forsuffixes}, \&{forever}, \&{endfor})}
+@d repeat_loop=8 {special command substituted for \&{endfor}}
+@d exit_test=9 {premature exit from a loop (\&{exitif})}
+@d relax=10 {do nothing (\.{\char`\\})}
+@d scan_tokens=11 {put a string into the input buffer}
+@d expand_after=12 {look ahead one token}
+@d defined_macro=13 {a macro defined by the user}
+@d min_command=defined_macro+1
+@d save_command=14 {save a list of tokens (\&{save})}
+@d interim_command=15 {save an internal quantity (\&{interim})}
+@d let_command=16 {redefine a symbolic token (\&{let})}
+@d new_internal=17 {define a new internal quantity (\&{newinternal})}
+@d macro_def=18 {define a macro (\&{def}, \&{vardef}, etc.)}
+@d ship_out_command=19 {output a character (\&{shipout})}
+@d add_to_command=20 {add to edges (\&{addto})}
+@d bounds_command=21 {add bounding path to edges (\&{setbounds}, \&{clip})}
+@d tfm_command=22 {command for font metric info (\&{ligtable}, etc.)}
+@d protection_command=23 {set protection flag (\&{outer}, \&{inner})}
+@d show_command=24 {diagnostic output (\&{show}, \&{showvariable}, etc.)}
+@d mode_command=25 {set interaction level (\&{batchmode}, etc.)}
+@d random_seed=26 {initialize random number generator (\&{randomseed})}
+@d message_command=27 {communicate to user (\&{message}, \&{errmessage})}
+@d every_job_command=28 {designate a starting token (\&{everyjob})}
+@d delimiters=29 {define a pair of delimiters (\&{delimiters})}
+@d special_command=30 {output special info (\&{special})}
+@d write_command=31 {write text to a file (\&{write})}
+@d type_name=32 {declare a type (\&{numeric}, \&{pair}, etc.}
+@d max_statement_command=type_name
+@d min_primary_command=type_name
+@d left_delimiter=33 {the left delimiter of a matching pair}
+@d begin_group=34 {beginning of a group (\&{begingroup})}
+@d nullary=35 {an operator without arguments (e.g., \&{normaldeviate})}
+@d unary=36 {an operator with one argument (e.g., \&{sqrt})}
+@d str_op=37 {convert a suffix to a string (\&{str})}
+@d cycle=38 {close a cyclic path (\&{cycle})}
+@d primary_binary=39 {binary operation taking `\&{of}' (e.g., \&{point})}
+@d capsule_token=40 {a value that has been put into a token list}
+@d string_token=41 {a string constant (e.g., |"hello"|)}
+@d internal_quantity=42 {internal numeric parameter (e.g., \&{pausing})}
+@d min_suffix_token=internal_quantity
+@d tag_token=43 {a symbolic token without a primitive meaning}
+@d numeric_token=44 {a numeric constant (e.g., \.{3.14159})}
+@d max_suffix_token=numeric_token
+@d plus_or_minus=45 {either `\.+' or `\.-'}
+@d max_primary_command=plus_or_minus {should also be |numeric_token+1|}
+@d min_tertiary_command=plus_or_minus
+@d tertiary_secondary_macro=46 {a macro defined by \&{secondarydef}}
+@d tertiary_binary=47 {an operator at the tertiary level (e.g., `\.{++}')}
+@d max_tertiary_command=tertiary_binary
+@d left_brace=48 {the operator `\.{\char`\{}'}
+@d min_expression_command=left_brace
+@d path_join=49 {the operator `\.{..}'}
+@d ampersand=50 {the operator `\.\&'}
+@d expression_tertiary_macro=51 {a macro defined by \&{tertiarydef}}
+@d expression_binary=52 {an operator at the expression level (e.g., `\.<')}
+@d equals=53 {the operator `\.='}
+@d max_expression_command=equals
+@d and_command=54 {the operator `\&{and}'}
+@d min_secondary_command=and_command
+@d secondary_primary_macro=55 {a macro defined by \&{primarydef}}
+@d slash=56 {the operator `\./'}
+@d secondary_binary=57 {an operator at the binary level (e.g., \&{shifted})}
+@d max_secondary_command=secondary_binary
+@d param_type=58 {type of parameter (\&{primary}, \&{expr}, \&{suffix}, etc.)}
+@d controls=59 {specify control points explicitly (\&{controls})}
+@d tension=60 {specify tension between knots (\&{tension})}
+@d at_least=61 {bounded tension value (\&{atleast})}
+@d curl_command=62 {specify curl at an end knot (\&{curl})}
+@d macro_special=63 {special macro operators (\&{quote}, \.{\#\AT!}, etc.)}
+@d right_delimiter=64 {the right delimiter of a matching pair}
+@d left_bracket=65 {the operator `\.['}
+@d right_bracket=66 {the operator `\.]'}
+@d right_brace=67 {the operator `\.{\char`\}}'}
+@d with_option=68 {option for filling (\&{withpen}, \&{withweight}, etc.)}
+@d thing_to_add=69
+ {variant of \&{addto} (\&{contour}, \&{doublepath}, \&{also})}
+@d of_token=70 {the operator `\&{of}'}
+@d to_token=71 {the operator `\&{to}'}
+@d step_token=72 {the operator `\&{step}'}
+@d until_token=73 {the operator `\&{until}'}
+@d within_token=74 {the operator `\&{within}'}
+@d lig_kern_token=75
+ {the operators `\&{kern}' and `\.{=:}' and `\.{=:\char'174}, etc.}
+@d assignment=76 {the operator `\.{:=}'}
+@d skip_to=77 {the operation `\&{skipto}'}
+@d bchar_label=78 {the operator `\.{\char'174\char'174:}'}
+@d double_colon=79 {the operator `\.{::}'}
+@d colon=80 {the operator `\.:'}
+@#
+@d comma=81 {the operator `\.,', must be |colon+1|}
+@d end_of_statement==cur_cmd>comma
+@d semicolon=82 {the operator `\.;', must be |comma+1|}
+@d end_group=83 {end a group (\&{endgroup}), must be |semicolon+1|}
+@d stop=84 {end a job (\&{end}, \&{dump}), must be |end_group+1|}
+@d max_command_code=stop
+@d outer_tag=max_command_code+1 {protection code added to command code}
+
+@<Types...@>=
+@!command_code=1..max_command_code;
+
+@ Variables and capsules in \MP\ have a variety of ``types,''
+distinguished by the code numbers defined here. These numbers are also
+not completely arbitrary. Things that get expanded must have types
+|>independent|; a type remaining after expansion is numeric if and only if
+its code number is at least |numeric_type|; objects containing numeric
+parts must have types between |transform_type| and |pair_type|;
+all other types must be smaller than |transform_type|; and among the types
+that are not unknown or vacuous, the smallest two must be |boolean_type|
+and |string_type| in that order.
+
+@d undefined=0 {no type has been declared}
+@d unknown_tag=1 {this constant is added to certain type codes below}
+@d vacuous=1 {no expression was present}
+@d boolean_type=2 {\&{boolean} with a known value}
+@d unknown_boolean=boolean_type+unknown_tag
+@d string_type=4 {\&{string} with a known value}
+@d unknown_string=string_type+unknown_tag
+@d pen_type=6 {\&{pen} with a known value}
+@d unknown_pen=pen_type+unknown_tag
+@d path_type=8 {\&{path} with a known value}
+@d unknown_path=path_type+unknown_tag
+@d picture_type=10 {\&{picture} with a known value}
+@d unknown_picture=picture_type+unknown_tag
+@d transform_type=12 {\&{transform} variable or capsule}
+@d color_type=13 {\&{color} variable or capsule}
+@d pair_type=14 {\&{pair} variable or capsule}
+@d numeric_type=15 {variable that has been declared \&{numeric} but not used}
+@d known=16 {\&{numeric} with a known value}
+@d dependent=17 {a linear combination with |fraction| coefficients}
+@d proto_dependent=18 {a linear combination with |scaled| coefficients}
+@d independent=19 {\&{numeric} with unknown value}
+@d token_list=20 {variable name or suffix argument or text argument}
+@d structured=21 {variable with subscripts and attributes}
+@d unsuffixed_macro=22 {variable defined with \&{vardef} but no \.{\AT!\#}}
+@d suffixed_macro=23 {variable defined with \&{vardef} and \.{\AT!\#}}
+@#
+@d unknown_types==unknown_boolean,unknown_string,
+ unknown_pen,unknown_picture,unknown_path
+
+@<Basic printing procedures@>=
+procedure print_type(@!t:small_number);
+begin case t of
+vacuous:print("vacuous");
+boolean_type:print("boolean");
+unknown_boolean:print("unknown boolean");
+string_type:print("string");
+unknown_string:print("unknown string");
+pen_type:print("pen");
+unknown_pen:print("unknown pen");
+path_type:print("path");
+unknown_path:print("unknown path");
+picture_type:print("picture");
+unknown_picture:print("unknown picture");
+transform_type:print("transform");
+color_type:print("color");
+pair_type:print("pair");
+known:print("known numeric");
+dependent:print("dependent");
+proto_dependent:print("proto-dependent");
+numeric_type:print("numeric");
+independent:print("independent");
+token_list:print("token list");
+structured:print("structured");
+unsuffixed_macro:print("unsuffixed macro");
+suffixed_macro:print("suffixed macro");
+othercases print("undefined")
+endcases;
+end;
+
+@ Values inside \MP\ are stored in two-word nodes that have a |name_type|
+as well as a |type|. The possibilities for |name_type| are defined
+here; they will be explained in more detail later.
+
+@d root=0 {|name_type| at the top level of a variable}
+@d saved_root=1 {same, when the variable has been saved}
+@d structured_root=2 {|name_type| where a |structured| branch occurs}
+@d subscr=3 {|name_type| in a subscript node}
+@d attr=4 {|name_type| in an attribute node}
+@d x_part_sector=5 {|name_type| in the \&{xpart} of a node}
+@d y_part_sector=6 {|name_type| in the \&{ypart} of a node}
+@d xx_part_sector=7 {|name_type| in the \&{xxpart} of a node}
+@d xy_part_sector=8 {|name_type| in the \&{xypart} of a node}
+@d yx_part_sector=9 {|name_type| in the \&{yxpart} of a node}
+@d yy_part_sector=10 {|name_type| in the \&{yypart} of a node}
+@d red_part_sector=11 {|name_type| in the \&{redpart} of a node}
+@d green_part_sector=12 {|name_type| in the \&{greenpart} of a node}
+@d blue_part_sector=13 {|name_type| in the \&{bluepart} of a node}
+@d capsule=14 {|name_type| in stashed-away subexpressions}
+@d token=15 {|name_type| in a numeric token or string token}
+
+@ Primitive operations that produce values have a secondary identification
+code in addition to their command code; it's something like genera and species.
+For example, `\.*' has the command code |primary_binary|, and its
+secondary identification is |times|. The secondary codes start at 30 so that
+they don't overlap with the type codes; some type codes (e.g., |string_type|)
+are used as operators as well as type identifications. The relative values
+are not critical, except for |true_code..false_code|, |or_op..and_op|,
+and |filled_op..bounded_op|. The restrictions are that
+|and_op-false_code=or_op-true_code|, that the ordering of
+|x_part...blue_part| must match that of |x_part_sector..blue_part_sector|,
+and the ordering of |filled_op..bounded_op| must match that of the code
+values they test for.
+
+@d true_code=30 {operation code for \.{true}}
+@d false_code=31 {operation code for \.{false}}
+@d null_picture_code=32 {operation code for \.{nullpicture}}
+@d null_pen_code=33 {operation code for \.{nullpen}}
+@d job_name_op=34 {operation code for \.{jobname}}
+@d read_string_op=35 {operation code for \.{readstring}}
+@d pen_circle=36 {operation code for \.{pencircle}}
+@d normal_deviate=37 {operation code for \.{normaldeviate}}
+@d read_from_op=38 {operation code for \.{readfrom}}
+@d close_from_op=39 {operation code for \.{closefrom}}
+@d odd_op=40 {operation code for \.{odd}}
+@d known_op=41 {operation code for \.{known}}
+@d unknown_op=42 {operation code for \.{unknown}}
+@d not_op=43 {operation code for \.{not}}
+@d decimal=44 {operation code for \.{decimal}}
+@d reverse=45 {operation code for \.{reverse}}
+@d make_path_op=46 {operation code for \.{makepath}}
+@d make_pen_op=47 {operation code for \.{makepen}}
+@d oct_op=48 {operation code for \.{oct}}
+@d hex_op=49 {operation code for \.{hex}}
+@d ASCII_op=50 {operation code for \.{ASCII}}
+@d char_op=51 {operation code for \.{char}}
+@d length_op=52 {operation code for \.{length}}
+@d turning_op=53 {operation code for \.{turningnumber}}
+@d x_part=54 {operation code for \.{xpart}}
+@d y_part=55 {operation code for \.{ypart}}
+@d xx_part=56 {operation code for \.{xxpart}}
+@d xy_part=57 {operation code for \.{xypart}}
+@d yx_part=58 {operation code for \.{yxpart}}
+@d yy_part=59 {operation code for \.{yypart}}
+@d red_part=60 {operation code for \.{redpart}}
+@d green_part=61 {operation code for \.{greenpart}}
+@d blue_part=62 {operation code for \.{bluepart}}
+@d font_part=63 {operation code for \.{fontpart}}
+@d text_part=64 {operation code for \.{textpart}}
+@d path_part=65 {operation code for \.{pathpart}}
+@d pen_part=66 {operation code for \.{penpart}}
+@d dash_part=67 {operation code for \.{dashpart}}
+@d sqrt_op=68 {operation code for \.{sqrt}}
+@d m_exp_op=69 {operation code for \.{mexp}}
+@d m_log_op=70 {operation code for \.{mlog}}
+@d sin_d_op=71 {operation code for \.{sind}}
+@d cos_d_op=72 {operation code for \.{cosd}}
+@d floor_op=73 {operation code for \.{floor}}
+@d uniform_deviate=74 {operation code for \.{uniformdeviate}}
+@d char_exists_op=75 {operation code for \.{charexists}}
+@d font_size=76 {operation code for \.{fontsize}}
+@d ll_corner_op=77 {operation code for \.{llcorner}}
+@d lr_corner_op=78 {operation code for \.{lrcorner}}
+@d ul_corner_op=79 {operation code for \.{ulcorner}}
+@d ur_corner_op=80 {operation code for \.{urcorner}}
+@d arc_length=81 {operation code for \.{arclength}}
+@d angle_op=82 {operation code for \.{angle}}
+@d cycle_op=83 {operation code for \.{cycle}}
+@d filled_op=84 {operation code for \.{filled}}
+@d stroked_op=85 {operation code for \.{stroked}}
+@d textual_op=86 {operation code for \.{textual}}
+@d clipped_op=87 {operation code for \.{clipped}}
+@d bounded_op=88 {operation code for \.{bounded}}
+@d plus=89 {operation code for \.+}
+@d minus=90 {operation code for \.-}
+@d times=91 {operation code for \.*}
+@d over=92 {operation code for \./}
+@d pythag_add=93 {operation code for \.{++}}
+@d pythag_sub=94 {operation code for \.{+-+}}
+@d or_op=95 {operation code for \.{or}}
+@d and_op=96 {operation code for \.{and}}
+@d less_than=97 {operation code for \.<}
+@d less_or_equal=98 {operation code for \.{<=}}
+@d greater_than=99 {operation code for \.>}
+@d greater_or_equal=100 {operation code for \.{>=}}
+@d equal_to=101 {operation code for \.=}
+@d unequal_to=102 {operation code for \.{<>}}
+@d concatenate=103 {operation code for \.\&}
+@d rotated_by=104 {operation code for \.{rotated}}
+@d slanted_by=105 {operation code for \.{slanted}}
+@d scaled_by=106 {operation code for \.{scaled}}
+@d shifted_by=107 {operation code for \.{shifted}}
+@d transformed_by=108 {operation code for \.{transformed}}
+@d x_scaled=109 {operation code for \.{xscaled}}
+@d y_scaled=110 {operation code for \.{yscaled}}
+@d z_scaled=111 {operation code for \.{zscaled}}
+@d in_font=112 {operation code for \.{infont}}
+@d intersect=113 {operation code for \.{intersectiontimes}}
+@d double_dot=114 {operation code for improper \.{..}}
+@d substring_of=115 {operation code for \.{substring}}
+@d min_of=substring_of
+@d subpath_of=116 {operation code for \.{subpath}}
+@d direction_time_of=117 {operation code for \.{directiontime}}
+@d point_of=118 {operation code for \.{point}}
+@d precontrol_of=119 {operation code for \.{precontrol}}
+@d postcontrol_of=120 {operation code for \.{postcontrol}}
+@d pen_offset_of=121 {operation code for \.{penoffset}}
+@d arc_time_of=122 {operation code for \.{arctime}}
+@d mp_version=123 {operation code for \.{mpversion}}
+
+@p procedure print_op(@!c:quarterword);
+begin if c<=numeric_type then print_type(c)
+else case c of
+true_code:print("true");
+false_code:print("false");
+null_picture_code:print("nullpicture");
+null_pen_code:print("nullpen");
+job_name_op:print("jobname");
+read_string_op:print("readstring");
+pen_circle:print("pencircle");
+normal_deviate:print("normaldeviate");
+read_from_op:print("readfrom");
+close_from_op:print("closefrom");
+odd_op:print("odd");
+known_op:print("known");
+unknown_op:print("unknown");
+not_op:print("not");
+decimal:print("decimal");
+reverse:print("reverse");
+make_path_op:print("makepath");
+make_pen_op:print("makepen");
+oct_op:print("oct");
+hex_op:print("hex");
+ASCII_op:print("ASCII");
+char_op:print("char");
+length_op:print("length");
+turning_op:print("turningnumber");
+x_part:print("xpart");
+y_part:print("ypart");
+xx_part:print("xxpart");
+xy_part:print("xypart");
+yx_part:print("yxpart");
+yy_part:print("yypart");
+red_part:print("redpart");
+green_part:print("greenpart");
+blue_part:print("bluepart");
+font_part:print("fontpart");
+text_part:print("textpart");
+path_part:print("pathpart");
+pen_part:print("penpart");
+dash_part:print("dashpart");
+sqrt_op:print("sqrt");
+m_exp_op:print("mexp");
+m_log_op:print("mlog");
+sin_d_op:print("sind");
+cos_d_op:print("cosd");
+floor_op:print("floor");
+uniform_deviate:print("uniformdeviate");
+char_exists_op:print("charexists");
+font_size:print("fontsize");
+ll_corner_op:print("llcorner");
+lr_corner_op:print("lrcorner");
+ul_corner_op:print("ulcorner");
+ur_corner_op:print("urcorner");
+arc_length:print("arclength");
+angle_op:print("angle");
+cycle_op:print("cycle");
+filled_op:print("filled");
+stroked_op:print("stroked");
+textual_op:print("textual");
+clipped_op:print("clipped");
+bounded_op:print("bounded");
+plus:print_char("+");
+minus:print_char("-");
+times:print_char("*");
+over:print_char("/");
+pythag_add:print("++");
+pythag_sub:print("+-+");
+or_op:print("or");
+and_op:print("and");
+less_than:print_char("<");
+less_or_equal:print("<=");
+greater_than:print_char(">");
+greater_or_equal:print(">=");
+equal_to:print_char("=");
+unequal_to:print("<>");
+concatenate:print("&");
+rotated_by:print("rotated");
+slanted_by:print("slanted");
+scaled_by:print("scaled");
+shifted_by:print("shifted");
+transformed_by:print("transformed");
+x_scaled:print("xscaled");
+y_scaled:print("yscaled");
+z_scaled:print("zscaled");
+in_font:print("infont");
+intersect:print("intersectiontimes");
+substring_of:print("substring");
+subpath_of:print("subpath");
+direction_time_of:print("directiontime");
+point_of:print("point");
+precontrol_of:print("precontrol");
+postcontrol_of:print("postcontrol");
+pen_offset_of:print("penoffset");
+arc_time_of:print("arctime");
+mp_version:print("mpversion");
+othercases print("..")
+endcases;
+end;
+
+@ \MP\ also has a bunch of internal parameters that a user might want to
+fuss with. Every such parameter has an identifying code number, defined here.
+
+@d tracing_titles=1 {show titles online when they appear}
+@d tracing_equations=2 {show each variable when it becomes known}
+@d tracing_capsules=3 {show capsules too}
+@d tracing_choices=4 {show the control points chosen for paths}
+@d tracing_specs=5 {show path subdivision prior to filling with polygonal a pen}
+@d tracing_commands=6 {show commands and operations before they are performed}
+@d tracing_restores=7 {show when a variable or internal is restored}
+@d tracing_macros=8 {show macros before they are expanded}
+@d tracing_output=9 {show digitized edges as they are output}
+@d tracing_stats=10 {show memory usage at end of job}
+@d tracing_lost_chars=11 {show characters that aren't \&{infont}}
+@d tracing_online=12 {show long diagnostics on terminal and in the log file}
+@d year=13 {the current year (e.g., 1984)}
+@d month=14 {the current month (e.g, 3 $\equiv$ March)}
+@d day=15 {the current day of the month}
+@d time=16 {the number of minutes past midnight when this job started}
+@d char_code=17 {the number of the next character to be output}
+@d char_ext=18 {the extension code of the next character to be output}
+@d char_wd=19 {the width of the next character to be output}
+@d char_ht=20 {the height of the next character to be output}
+@d char_dp=21 {the depth of the next character to be output}
+@d char_ic=22 {the italic correction of the next character to be output}
+@d design_size=23 {the unit of measure used for |char_wd..char_ic|, in points}
+@d pausing=24 {positive to display lines on the terminal before they are read}
+@d showstopping=25 {positive to stop after each \&{show} command}
+@d fontmaking=26 {positive if font metric output is to be produced}
+@d linejoin=27 {as in \ps: 0 for mitered, 1 for round, 2 for beveled}
+@d linecap=28 {as in \ps: 0 for butt, 1 for round, 2 for square}
+@d miterlimit=29 {controls miter length as in \ps}
+@d warning_check=30 {controls error message when variable value is large}
+@d boundary_char=31 {the right boundary character for ligatures}
+@d prologues=32 {positive to output conforming PostScript using built-in fonts}
+@d true_corners=33 {positive to make \&{llcorner} etc. ignore \&{setbounds}}
+@d max_given_internal=33
+
+@<Glob...@>=
+@!internal:array[1..max_internal] of scaled;
+ {the values of internal quantities}
+@!int_name:array[1..max_internal] of str_number;
+ {their names}
+@!int_ptr:max_given_internal..max_internal;
+ {the maximum internal quantity defined so far}
+
+@ @<Set init...@>=
+for k:=1 to max_given_internal do internal[k]:=0;
+int_ptr:=max_given_internal;
+
+@ The symbolic names for internal quantities are put into \MP's hash table
+by using a routine called |primitive|, which will be defined later. Let us
+enter them now, so that we don't have to list all those names again
+anywhere else.
+
+@<Put each of \MP's primitives into the hash table@>=
+primitive("tracingtitles",internal_quantity,tracing_titles);@/
+@!@:tracingtitles_}{\&{tracingtitles} primitive@>
+primitive("tracingequations",internal_quantity,tracing_equations);@/
+@!@:tracing_equations_}{\&{tracingequations} primitive@>
+primitive("tracingcapsules",internal_quantity,tracing_capsules);@/
+@!@:tracing_capsules_}{\&{tracingcapsules} primitive@>
+primitive("tracingchoices",internal_quantity,tracing_choices);@/
+@!@:tracing_choices_}{\&{tracingchoices} primitive@>
+primitive("tracingspecs",internal_quantity,tracing_specs);@/
+@!@:tracing_specs_}{\&{tracingspecs} primitive@>
+primitive("tracingcommands",internal_quantity,tracing_commands);@/
+@!@:tracing_commands_}{\&{tracingcommands} primitive@>
+primitive("tracingrestores",internal_quantity,tracing_restores);@/
+@!@:tracing_restores_}{\&{tracingrestores} primitive@>
+primitive("tracingmacros",internal_quantity,tracing_macros);@/
+@!@:tracing_macros_}{\&{tracingmacros} primitive@>
+primitive("tracingoutput",internal_quantity,tracing_output);@/
+@!@:tracing_output_}{\&{tracingoutput} primitive@>
+primitive("tracingstats",internal_quantity,tracing_stats);@/
+@!@:tracing_stats_}{\&{tracingstats} primitive@>
+primitive("tracinglostchars",internal_quantity,tracing_lost_chars);@/
+@!@:tracing_lost_chars_}{\&{tracinglostchars} primitive@>
+primitive("tracingonline",internal_quantity,tracing_online);@/
+@!@:tracing_online_}{\&{tracingonline} primitive@>
+primitive("year",internal_quantity,year);@/
+@!@:year_}{\&{year} primitive@>
+primitive("month",internal_quantity,month);@/
+@!@:month_}{\&{month} primitive@>
+primitive("day",internal_quantity,day);@/
+@!@:day_}{\&{day} primitive@>
+primitive("time",internal_quantity,time);@/
+@!@:time_}{\&{time} primitive@>
+primitive("charcode",internal_quantity,char_code);@/
+@!@:char_code_}{\&{charcode} primitive@>
+primitive("charext",internal_quantity,char_ext);@/
+@!@:char_ext_}{\&{charext} primitive@>
+primitive("charwd",internal_quantity,char_wd);@/
+@!@:char_wd_}{\&{charwd} primitive@>
+primitive("charht",internal_quantity,char_ht);@/
+@!@:char_ht_}{\&{charht} primitive@>
+primitive("chardp",internal_quantity,char_dp);@/
+@!@:char_dp_}{\&{chardp} primitive@>
+primitive("charic",internal_quantity,char_ic);@/
+@!@:char_ic_}{\&{charic} primitive@>
+primitive("designsize",internal_quantity,design_size);@/
+@!@:design_size_}{\&{designsize} primitive@>
+primitive("pausing",internal_quantity,pausing);@/
+@!@:pausing_}{\&{pausing} primitive@>
+primitive("showstopping",internal_quantity,showstopping);@/
+@!@:showstopping_}{\&{showstopping} primitive@>
+primitive("fontmaking",internal_quantity,fontmaking);@/
+@!@:fontmaking_}{\&{fontmaking} primitive@>
+primitive("linejoin",internal_quantity,linejoin);@/
+@!@:linejoin_}{\&{linejoin} primitive@>
+primitive("linecap",internal_quantity,linecap);@/
+@!@:linecap_}{\&{linecap} primitive@>
+primitive("miterlimit",internal_quantity,miterlimit);@/
+@!@:miterlimit_}{\&{miterlimit} primitive@>
+primitive("warningcheck",internal_quantity,warning_check);@/
+@!@:warning_check_}{\&{warningcheck} primitive@>
+primitive("boundarychar",internal_quantity,boundary_char);@/
+@!@:boundary_char_}{\&{boundarychar} primitive@>
+primitive("prologues",internal_quantity,prologues);@/
+@!@:prologues_}{\&{prologues} primitive@>
+primitive("truecorners",internal_quantity,true_corners);@/
+@!@:true_corners_}{\&{truecorners} primitive@>
+
+@ Well, we do have to list the names one more time, for use in symbolic
+printouts.
+
+@<Initialize table...@>=
+int_name[tracing_titles]:="tracingtitles";
+int_name[tracing_equations]:="tracingequations";
+int_name[tracing_capsules]:="tracingcapsules";
+int_name[tracing_choices]:="tracingchoices";
+int_name[tracing_specs]:="tracingspecs";
+int_name[tracing_commands]:="tracingcommands";
+int_name[tracing_restores]:="tracingrestores";
+int_name[tracing_macros]:="tracingmacros";
+int_name[tracing_output]:="tracingoutput";
+int_name[tracing_stats]:="tracingstats";
+int_name[tracing_lost_chars]:="tracinglostchars";
+int_name[tracing_online]:="tracingonline";
+int_name[year]:="year";
+int_name[month]:="month";
+int_name[day]:="day";
+int_name[time]:="time";
+int_name[char_code]:="charcode";
+int_name[char_ext]:="charext";
+int_name[char_wd]:="charwd";
+int_name[char_ht]:="charht";
+int_name[char_dp]:="chardp";
+int_name[char_ic]:="charic";
+int_name[design_size]:="designsize";
+int_name[pausing]:="pausing";
+int_name[showstopping]:="showstopping";
+int_name[fontmaking]:="fontmaking";
+int_name[linejoin]:="linejoin";
+int_name[linecap]:="linecap";
+int_name[miterlimit]:="miterlimit";
+int_name[warning_check]:="warningcheck";
+int_name[boundary_char]:="boundarychar";
+int_name[prologues]:="prologues";
+int_name[true_corners]:="truecorners";
+
+@ The following procedure, which is called just before \MP\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+Note that the values are |scaled| integers. Hence \MP\ can no longer
+be used after the year 32767.
+
+@p procedure fix_date_and_time;
+begin internal[time]:=12*60*unity; {minutes since midnight}
+internal[day]:=4*unity; {fourth day of the month}
+internal[month]:=7*unity; {seventh month of the year}
+internal[year]:=1776*unity; {Anno Domini}
+end;
+
+@ \MP\ is occasionally supposed to print diagnostic information that
+goes only into the transcript file, unless |tracing_online| is positive.
+Now that we have defined |tracing_online| we can define
+two routines that adjust the destination of print commands:
+
+@<Basic printing...@>=
+@<Declare a function called |true_line|@>@;
+procedure begin_diagnostic; {prepare to do some tracing}
+begin old_setting:=selector;
+if selector=ps_file_only then selector:=non_ps_setting;
+if(internal[tracing_online]<=0)and(selector=term_and_log) then
+ begin decr(selector);
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+@#
+procedure end_diagnostic(@!blank_line:boolean);
+ {restore proper conditions after tracing}
+begin print_nl("");
+if blank_line then print_ln;
+selector:=old_setting;
+end;
+
+@ The global variable |non_ps_setting| is initialized when it is time to print
+on |ps_file|.
+
+@<Glob...@>=
+@!old_setting,@!non_ps_setting:0..max_selector;
+
+@ We will occasionally use |begin_diagnostic| in connection with line-number
+printing, as follows. (The parameter |s| is typically |"Path"| or
+|"Cycle spec"|, etc.)
+
+@<Basic printing...@>=
+procedure print_diagnostic(@!s,@!t:str_number;@!nuline:boolean);
+begin begin_diagnostic;
+if nuline then print_nl(s)@+else print(s);
+print(" at line "); print_int(true_line);
+print(t); print_char(":");
+end;
+
+@ The 256 |ASCII_code| characters are grouped into classes by means of
+the |char_class| table. Individual class numbers have no semantic
+or syntactic significance, except in a few instances defined here.
+There's also |max_class|, which can be used as a basis for additional
+class numbers in nonstandard extensions of \MP.
+
+@d digit_class=0 {the class number of \.{0123456789}}
+@d period_class=1 {the class number of `\..'}
+@d space_class=2 {the class number of spaces and nonstandard characters}
+@d percent_class=3 {the class number of `\.\%'}
+@d string_class=4 {the class number of `\."'}
+@d right_paren_class=8 {the class number of `\.)'}
+@d isolated_classes==5,6,7,8 {characters that make length-one tokens only}
+@d letter_class=9 {letters and the underline character}
+@d left_bracket_class=17 {`\.['}
+@d right_bracket_class=18 {`\.]'}
+@d invalid_class=20 {bad character in the input}
+@d max_class=20 {the largest class number}
+
+@<Glob...@>=
+@!char_class:array[ASCII_code] of 0..max_class; {the class numbers}
+
+@ If changes are made to accommodate non-ASCII character sets, they should
+follow the guidelines in Appendix~C of {\sl The {\logos METAFONT\/}book}.
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+@^system dependencies@>
+
+@<Set init...@>=
+for k:="0" to "9" do char_class[k]:=digit_class;
+char_class["."]:=period_class;
+char_class[" "]:=space_class;
+char_class["%"]:=percent_class;
+char_class[""""]:=string_class;@/
+char_class[","]:=5;
+char_class[";"]:=6;
+char_class["("]:=7;
+char_class[")"]:=right_paren_class;
+for k:="A" to "Z" do char_class[k]:=letter_class;
+for k:="a" to "z" do char_class[k]:=letter_class;
+char_class["_"]:=letter_class;@/
+char_class["<"]:=10;
+char_class["="]:=10;
+char_class[">"]:=10;
+char_class[":"]:=10;
+char_class["|"]:=10;@/
+char_class["`"]:=11;
+char_class["'"]:=11;@/
+char_class["+"]:=12;
+char_class["-"]:=12;@/
+char_class["/"]:=13;
+char_class["*"]:=13;
+char_class["\"]:=13;@/
+char_class["!"]:=14;
+char_class["?"]:=14;@/
+char_class["#"]:=15;
+char_class["&"]:=15;
+char_class["@@"]:=15;
+char_class["$"]:=15;@/
+char_class["^"]:=16;
+char_class["~"]:=16;@/
+char_class["["]:=left_bracket_class;
+char_class["]"]:=right_bracket_class;@/
+char_class["{"]:=19;
+char_class["}"]:=19;@/
+for k:=0 to " "-1 do char_class[k]:=invalid_class;
+for k:=127 to 255 do char_class[k]:=invalid_class;
+
+@* \[13] The hash table.
+Symbolic tokens are stored and retrieved by means of a fairly standard hash
+table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C
+in {\sl The Art of Computer Programming\/}). Once a symbolic token enters the
+table, it is never removed.
+
+The actual sequence of characters forming a symbolic token is
+stored in the |str_pool| array together with all the other strings. An
+auxiliary array |hash| consists of items with two halfword fields per
+word. The first of these, called |next(p)|, points to the next identifier
+belonging to the same coalesced list as the identifier corresponding to~|p|;
+and the other, called |text(p)|, points to the |str_start| entry for
+|p|'s identifier. If position~|p| of the hash table is empty, we have
+|text(p)=0|; if position |p| is either empty or the end of a coalesced
+hash list, we have |next(p)=0|.
+
+An auxiliary pointer variable called |hash_used| is maintained in such a
+way that all locations |p>=hash_used| are nonempty. The global variable
+|st_count| tells how many symbolic tokens have been defined, if statistics
+are being kept.
+
+The first 256 locations of |hash| are reserved for symbols of length one.
+
+There's a parallel array called |eqtb| that contains the current equivalent
+values of each symbolic token. The entries of this array consist of
+two halfwords called |eq_type| (a command code) and |equiv| (a secondary
+piece of information that qualifies the |eq_type|).
+
+@d next(#) == hash[#].lh {link for coalesced lists}
+@d text(#) == hash[#].rh {string number for symbolic token name}
+@d eq_type(#) == eqtb[#].lh {the current ``meaning'' of a symbolic token}
+@d equiv(#) == eqtb[#].rh {parametric part of a token's meaning}
+@d hash_base=257 {hashing actually starts here}
+@d hash_is_full == (hash_used=hash_base) {are all positions occupied?}
+
+@<Glob...@>=
+@!hash_used:pointer; {allocation pointer for |hash|}
+@!st_count:integer; {total number of known identifiers}
+
+@ Certain entries in the hash table are ``frozen'' and not redefinable,
+since they are used in error recovery.
+
+@d hash_top==hash_base+hash_size {the first location of the frozen area}
+@d frozen_inaccessible==hash_top {|hash| location to protect the frozen area}
+@d frozen_repeat_loop==hash_top+1 {|hash| location of a loop-repeat token}
+@d frozen_right_delimiter==hash_top+2 {|hash| location of a permanent `\.)'}
+@d frozen_left_bracket==hash_top+3 {|hash| location of a permanent `\.['}
+@d frozen_slash==hash_top+4 {|hash| location of a permanent `\./'}
+@d frozen_colon==hash_top+5 {|hash| location of a permanent `\.:'}
+@d frozen_semicolon==hash_top+6 {|hash| location of a permanent `\.;'}
+@d frozen_end_for==hash_top+7 {|hash| location of a permanent \&{endfor}}
+@d frozen_end_def==hash_top+8 {|hash| location of a permanent \&{enddef}}
+@d frozen_fi==hash_top+9 {|hash| location of a permanent \&{fi}}
+@d frozen_end_group==hash_top+10
+ {|hash| location of a permanent `\.{endgroup}'}
+@d frozen_etex==hash_top+11 {|hash| location of a permanent \&{etex}}
+@d frozen_mpx_break==hash_top+12 {|hash| location of a permanent \&{mpxbreak}}
+@d frozen_bad_vardef==hash_top+13 {|hash| location of `\.{a bad variable}'}
+@d frozen_undefined==hash_top+14 {|hash| location that never gets defined}
+@d hash_end==hash_top+14 {the actual size of the |hash| and |eqtb| arrays}
+
+@<Glob...@>=
+@!hash: array[1..hash_end] of two_halves; {the hash table}
+@!eqtb: array[1..hash_end] of two_halves; {the equivalents}
+
+@ @<Set init...@>=
+next(1):=0; text(1):=0; eq_type(1):=tag_token; equiv(1):=null;
+for k:=2 to hash_end do
+ begin hash[k]:=hash[1]; eqtb[k]:=eqtb[1];
+ end;
+
+@ @<Initialize table entries...@>=
+hash_used:=frozen_inaccessible; {nothing is used}
+st_count:=0;@/
+text(frozen_bad_vardef):="a bad variable";
+text(frozen_etex):="etex";
+text(frozen_mpx_break):="mpxbreak";
+text(frozen_fi):="fi";
+text(frozen_end_group):="endgroup";
+text(frozen_end_def):="enddef";
+text(frozen_end_for):="endfor";@/
+text(frozen_semicolon):=";";
+text(frozen_colon):=":";
+text(frozen_slash):="/";
+text(frozen_left_bracket):="[";
+text(frozen_right_delimiter):=")";@/
+text(frozen_inaccessible):=" INACCESSIBLE";@/
+eq_type(frozen_right_delimiter):=right_delimiter;
+
+@ @<Check the ``constant'' values...@>=
+if hash_end+max_internal>max_halfword then bad:=17;
+
+@ Here is the subroutine that searches the hash table for an identifier
+that matches a given string of length~|l| appearing in |buffer[j..
+(j+l-1)]|. If the identifier is not found, it is inserted; hence it
+will always be found, and the corresponding hash table address
+will be returned.
+
+@p function id_lookup(@!j,@!l:integer):pointer; {search the hash table}
+label found; {go here when you've found it}
+var @!h:integer; {hash code}
+@!p:pointer; {index in |hash| array}
+@!k:pointer; {index in |buffer| array}
+begin if l=1 then @<Treat special case of length 1 and |goto found|@>;
+@<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+ begin if text(p)>0 then if length(text(p))=l then
+ if str_eq_buf(text(p),j) then goto found;
+ if next(p)=0 then
+ @<Insert a new symbolic token after |p|, then
+ make |p| point to it and |goto found|@>;
+ p:=next(p);
+ end;
+found: id_lookup:=p;
+end;
+
+@ @<Treat special case of length 1...@>=
+begin p:=buffer[j]+1; text(p):=p-1; goto found;
+end
+
+@ @<Insert a new symbolic...@>=
+begin if text(p)>0 then
+ begin repeat if hash_is_full then
+ overflow("hash size",hash_size);
+@:MetaPost capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until text(hash_used)=0; {search for an empty location in |hash|}
+ next(p):=hash_used; p:=hash_used;
+ end;
+str_room(l);
+for k:=j to j+l-1 do append_char(buffer[k]);
+text(p):=make_string; str_ref[text(p)]:=max_str_ref;
+@!stat incr(st_count);@+tats@;@/
+goto found;
+end
+
+@ The value of |hash_prime| should be roughly 85\pct! of |hash_size|, and it
+should be a prime number. The theory of hashing tells us to expect fewer
+than two table probes, on the average, when the search is successful.
+[See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983), 231--258.]
+@^Vitter, Jeffrey Scott@>
+
+@<Compute the hash code |h|@>=
+h:=buffer[j];
+for k:=j+1 to j+l-1 do
+ begin h:=h+h+buffer[k];
+ while h>=hash_prime do h:=h-hash_prime;
+ end
+
+@ @<Search |eqtb| for equivalents equal to |p|@>=
+for q:=1 to hash_end do
+ begin if equiv(q)=p then
+ begin print_nl("EQUIV("); print_int(q); print_char(")");
+ end;
+ end
+
+@ We need to put \MP's ``primitive'' symbolic tokens into the hash
+table, together with their command code (which will be the |eq_type|)
+and an operand (which will be the |equiv|). The |primitive| procedure
+does this, in a way that no \MP\ user can. The global value |cur_sym|
+contains the new |eqtb| pointer after |primitive| has acted.
+
+@p @!init procedure primitive(@!s:str_number;@!c:halfword;@!o:halfword);
+var @!k:pool_pointer; {index into |str_pool|}
+@!j:small_number; {index into |buffer|}
+@!l:small_number; {length of the string}
+begin k:=str_start[s]; l:=str_stop(s)-k;
+ {we will move |s| into the (empty) |buffer|}
+for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+cur_sym:=id_lookup(0,l);@/
+if s>=256 then {we don't want to have the string twice}
+ begin flush_string(text(cur_sym)); text(cur_sym):=s;
+ end;
+eq_type(cur_sym):=c; equiv(cur_sym):=o;
+end;
+tini
+
+@ Many of \MP's primitives need no |equiv|, since they are identifiable
+by their |eq_type| alone. These primitives are loaded into the hash table
+as follows:
+
+@<Put each of \MP's primitives into the hash table@>=
+primitive("..",path_join,0);@/
+@!@:.._}{\.{..} primitive@>
+primitive("[",left_bracket,0); eqtb[frozen_left_bracket]:=eqtb[cur_sym];@/
+@!@:[ }{\.{[} primitive@>
+primitive("]",right_bracket,0);@/
+@!@:] }{\.{]} primitive@>
+primitive("}",right_brace,0);@/
+@!@:]]}{\.{\char`\}} primitive@>
+primitive("{",left_brace,0);@/
+@!@:][}{\.{\char`\{} primitive@>
+primitive(":",colon,0); eqtb[frozen_colon]:=eqtb[cur_sym];@/
+@!@:: }{\.{:} primitive@>
+primitive("::",double_colon,0);@/
+@!@::: }{\.{::} primitive@>
+primitive("||:",bchar_label,0);@/
+@!@:::: }{\.{\char'174\char'174:} primitive@>
+primitive(":=",assignment,0);@/
+@!@::=_}{\.{:=} primitive@>
+primitive(",",comma,0);@/
+@!@:, }{\., primitive@>
+primitive(";",semicolon,0); eqtb[frozen_semicolon]:=eqtb[cur_sym];@/
+@!@:; }{\.; primitive@>
+primitive("\",relax,0);@/
+@!@:]]\\}{\.{\char`\\} primitive@>
+@#
+primitive("addto",add_to_command,0);@/
+@!@:add_to_}{\&{addto} primitive@>
+primitive("atleast",at_least,0);@/
+@!@:at_least_}{\&{atleast} primitive@>
+primitive("begingroup",begin_group,0); bg_loc:=cur_sym;@/
+@!@:begin_group_}{\&{begingroup} primitive@>
+primitive("controls",controls,0);@/
+@!@:controls_}{\&{controls} primitive@>
+primitive("curl",curl_command,0);@/
+@!@:curl_}{\&{curl} primitive@>
+primitive("delimiters",delimiters,0);@/
+@!@:delimiters_}{\&{delimiters} primitive@>
+primitive("endgroup",end_group,0);
+ eqtb[frozen_end_group]:=eqtb[cur_sym]; eg_loc:=cur_sym;@/
+@!@:endgroup_}{\&{endgroup} primitive@>
+primitive("everyjob",every_job_command,0);@/
+@!@:every_job_}{\&{everyjob} primitive@>
+primitive("exitif",exit_test,0);@/
+@!@:exit_if_}{\&{exitif} primitive@>
+primitive("expandafter",expand_after,0);@/
+@!@:expand_after_}{\&{expandafter} primitive@>
+primitive("interim",interim_command,0);@/
+@!@:interim_}{\&{interim} primitive@>
+primitive("let",let_command,0);@/
+@!@:let_}{\&{let} primitive@>
+primitive("newinternal",new_internal,0);@/
+@!@:new_internal_}{\&{newinternal} primitive@>
+primitive("of",of_token,0);@/
+@!@:of_}{\&{of} primitive@>
+primitive("randomseed",random_seed,0);@/
+@!@:random_seed_}{\&{randomseed} primitive@>
+primitive("save",save_command,0);@/
+@!@:save_}{\&{save} primitive@>
+primitive("scantokens",scan_tokens,0);@/
+@!@:scan_tokens_}{\&{scantokens} primitive@>
+primitive("shipout",ship_out_command,0);@/
+@!@:ship_out_}{\&{shipout} primitive@>
+primitive("skipto",skip_to,0);@/
+@!@:skip_to_}{\&{skipto} primitive@>
+primitive("special",special_command,0);
+@!@:special}{\&{special} primitive@>
+primitive("step",step_token,0);@/
+@!@:step_}{\&{step} primitive@>
+primitive("str",str_op,0);@/
+@!@:str_}{\&{str} primitive@>
+primitive("tension",tension,0);@/
+@!@:tension_}{\&{tension} primitive@>
+primitive("to",to_token,0);@/
+@!@:to_}{\&{to} primitive@>
+primitive("until",until_token,0);@/
+@!@:until_}{\&{until} primitive@>
+primitive("within",within_token,0);@/
+@!@:within_}{\&{within} primitive@>
+primitive("write",write_command,0);@/
+@!@:write_}{\&{write} primitive@>
+
+@ Each primitive has a corresponding inverse, so that it is possible to
+display the cryptic numeric contents of |eqtb| in symbolic form.
+Every call of |primitive| in this program is therefore accompanied by some
+straightforward code that forms part of the |print_cmd_mod| routine
+explained below.
+
+@<Cases of |print_cmd_mod| for symbolic printing of primitives@>=
+add_to_command:print("addto");
+assignment:print(":=");
+at_least:print("atleast");
+bchar_label:print("||:");
+begin_group:print("begingroup");
+colon:print(":");
+comma:print(",");
+controls:print("controls");
+curl_command:print("curl");
+delimiters:print("delimiters");
+double_colon:print("::");
+end_group:print("endgroup");
+every_job_command:print("everyjob");
+exit_test:print("exitif");
+expand_after:print("expandafter");
+interim_command:print("interim");
+left_brace:print("{");
+left_bracket:print("[");
+let_command:print("let");
+new_internal:print("newinternal");
+of_token:print("of");
+path_join:print("..");
+random_seed:print("randomseed");
+relax:print_char("\");
+right_brace:print("}");
+right_bracket:print("]");
+save_command:print("save");
+scan_tokens:print("scantokens");
+semicolon:print(";");
+ship_out_command:print("shipout");
+skip_to:print("skipto");
+special_command: print("special");
+step_token:print("step");
+str_op:print("str");
+tension:print("tension");
+to_token:print("to");
+until_token:print("until");
+within_token:print("within");
+write_command:print("write");
+
+@ We will deal with the other primitives later, at some point in the program
+where their |eq_type| and |equiv| values are more meaningful. For example,
+the primitives for macro definitions will be loaded when we consider the
+routines that define macros.
+It is easy to find where each particular
+primitive was treated by looking in the index at the end; for example, the
+section where |"def"| entered |eqtb| is listed under `\&{def} primitive'.
+
+@* \[14] Token lists.
+A \MP\ token is either symbolic or numeric or a string, or it denotes
+a macro parameter or capsule; so there are five corresponding ways to encode it
+@^token@>
+internally: (1)~A symbolic token whose hash code is~|p|
+is represented by the number |p|, in the |info| field of a single-word
+node in~|mem|. (2)~A numeric token whose |scaled| value is~|v| is
+represented in a two-word node of~|mem|; the |type| field is |known|,
+the |name_type| field is |token|, and the |value| field holds~|v|.
+The fact that this token appears in a two-word node rather than a
+one-word node is, of course, clear from the node address.
+(3)~A string token is also represented in a two-word node; the |type|
+field is |string_type|, the |name_type| field is |token|, and the
+|value| field holds the corresponding |str_number|. (4)~Capsules have
+|name_type=capsule|, and their |type| and |value| fields represent
+arbitrary values (in ways to be explained later). (5)~Macro parameters
+are like symbolic tokens in that they appear in |info| fields of
+one-word nodes. The $k$th parameter is represented by |expr_base+k| if it
+is of type \&{expr}, or by |suffix_base+k| if it is of type \&{suffix}, or
+by |text_base+k| if it is of type \&{text}. (Here |0<=k<param_size|.)
+Actual values of these parameters are kept in a separate stack, as we will
+see later. The constants |expr_base|, |suffix_base|, and |text_base| are,
+of course, chosen so that there will be no confusion between symbolic
+tokens and parameters of various types.
+
+Note that
+the `\\{type}' field of a node has nothing to do with ``type'' in a
+printer's sense. It's curious that the same word is used in such different ways.
+
+@d type(#) == mem[#].hh.b0 {identifies what kind of value this is}
+@d name_type(#) == mem[#].hh.b1 {a clue to the name of this value}
+@d token_node_size=2 {the number of words in a large token node}
+@d value_loc(#)==#+1 {the word that contains the |value| field}
+@d value(#)==mem[value_loc(#)].int {the value stored in a large token node}
+@d expr_base==hash_end+1 {code for the zeroth \&{expr} parameter}
+@d suffix_base==expr_base+param_size {code for the zeroth \&{suffix} parameter}
+@d text_base==suffix_base+param_size {code for the zeroth \&{text} parameter}
+
+@<Check the ``constant''...@>=
+if text_base+param_size>max_halfword then bad:=18;
+
+@ We have set aside a two word node beginning at |null| so that we can have
+|value(null)=0|. We will make use of this coincidence later.
+
+@<Initialize table entries...@>=
+link(null):=null;
+value(null):=0;
+
+@ A numeric token is created by the following trivial routine.
+
+@p function new_num_tok(@!v:scaled):pointer;
+var @!p:pointer; {the new node}
+begin p:=get_node(token_node_size); value(p):=v;
+type(p):=known; name_type(p):=token; new_num_tok:=p;
+end;
+
+@ A token list is a singly linked list of nodes in |mem|, where
+each node contains a token and a link. Here's a subroutine that gets rid
+of a token list when it is no longer needed.
+
+@p procedure@?token_recycle; forward;@t\2@>@;@/
+procedure flush_token_list(@!p:pointer);
+var @!q:pointer; {the node being recycled}
+begin while p<>null do
+ begin q:=p; p:=link(p);
+ if q>=hi_mem_min then free_avail(q)
+ else begin case type(q) of
+ vacuous,boolean_type,known:do_nothing;
+ string_type:delete_str_ref(value(q));
+ unknown_types,pen_type,path_type,picture_type,pair_type,color_type,
+ transform_type,dependent,proto_dependent,independent:
+ begin g_pointer:=q; token_recycle;
+ end;
+ othercases confusion("token")
+@:this can't happen token}{\quad token@>
+ endcases;@/
+ free_node(q,token_node_size);
+ end;
+ end;
+end;
+
+@ The procedure |show_token_list|, which prints a symbolic form of
+the token list that starts at a given node |p|, illustrates these
+conventions. The token list being displayed should not begin with a reference
+count. However, the procedure is intended to be fairly robust, so that if the
+memory links are awry or if |p| is not really a pointer to a token list,
+almost nothing catastrophic can happen.
+
+An additional parameter |q| is also given; this parameter is either null
+or it points to a node in the token list where a certain magic computation
+takes place that will be explained later. (Basically, |q| is non-null when
+we are printing the two-line context information at the time of an error
+message; |q| marks the place corresponding to where the second line
+should begin.)
+
+The generation will stop, and `\.{\char`\ ETC.}' will be printed, if the length
+of printing exceeds a given limit~|l|; the length of printing upon entry is
+assumed to be a given amount called |null_tally|. (Note that
+|show_token_list| sometimes uses itself recursively to print
+variable names within a capsule.)
+@^recursion@>
+
+Unusual entries are printed in the form of all-caps tokens
+preceded by a space, e.g., `\.{\char`\ BAD}'.
+
+@<Declare the procedure called |show_token_list|@>=
+procedure@?print_capsule; forward; @t\2@>@;@/
+procedure show_token_list(@!p,@!q:integer;@!l,@!null_tally:integer);
+label exit;
+var @!class,@!c:small_number; {the |char_class| of previous and new tokens}
+@!r,@!v:integer; {temporary registers}
+begin class:=percent_class;
+tally:=null_tally;
+while (p<>null) and (tally<l) do
+ begin if p=q then @<Do magic computation@>;
+ @<Display token |p| and set |c| to its class;
+ but |return| if there are problems@>;
+ class:=c; p:=link(p);
+ end;
+if p<>null then print(" ETC.");
+@.ETC@>
+exit:
+end;
+
+@ @<Display token |p| and set |c| to its class...@>=
+c:=letter_class; {the default}
+if (p<mem_min)or(p>mem_end) then
+ begin print(" CLOBBERED"); return;
+@.CLOBBERED@>
+ end;
+if p<hi_mem_min then @<Display two-word token@>
+else begin r:=info(p);
+ if r>=expr_base then @<Display a parameter token@>
+ else if r<1 then
+ if r=0 then @<Display a collective subscript@>
+ else print(" IMPOSSIBLE")
+@.IMPOSSIBLE@>
+ else begin r:=text(r);
+ if (r<0)or(r>max_str_ptr) then print(" NONEXISTENT")
+@.NONEXISTENT@>
+ else @<Print string |r| as a symbolic token
+ and set |c| to its class@>;
+ end;
+ end
+
+@ @<Display two-word token@>=
+if name_type(p)=token then
+ if type(p)=known then @<Display a numeric token@>
+ else if type(p)<>string_type then print(" BAD")
+@.BAD@>
+ else begin print_char(""""); print(value(p)); print_char("""");
+ c:=string_class;
+ end
+else if (name_type(p)<>capsule)or(type(p)<vacuous)or(type(p)>independent) then
+ print(" BAD")
+else begin g_pointer:=p; print_capsule; c:=right_paren_class;
+ end
+
+@ @<Display a numeric token@>=
+begin if class=digit_class then print_char(" ");
+v:=value(p);
+if v<0 then
+ begin if class=left_bracket_class then print_char(" ");
+ print_char("["); print_scaled(v); print_char("]");
+ c:=right_bracket_class;
+ end
+else begin print_scaled(v); c:=digit_class;
+ end;
+end
+
+@ Strictly speaking, a genuine token will never have |info(p)=0|.
+But we will see later (in the |print_variable_name| routine) that
+it is convenient to let |info(p)=0| stand for `\.{[]}'.
+
+@<Display a collective subscript@>=
+begin if class=left_bracket_class then print_char(" ");
+print("[]"); c:=right_bracket_class;
+end
+
+@ @<Display a parameter token@>=
+begin if r<suffix_base then
+ begin print("(EXPR"); r:=r-(expr_base);
+@.EXPR@>
+ end
+else if r<text_base then
+ begin print("(SUFFIX"); r:=r-(suffix_base);
+@.SUFFIX@>
+ end
+else begin print("(TEXT"); r:=r-(text_base);
+@.TEXT@>
+ end;
+print_int(r); print_char(")"); c:=right_paren_class;
+end
+
+@ @<Print string |r| as a symbolic token...@>=
+begin c:=char_class[so(str_pool[str_start[r]])];
+if c=class then
+ case c of
+ letter_class:print_char(".");
+ isolated_classes:do_nothing;
+ othercases print_char(" ")
+ endcases;
+print(r);
+end
+
+@ The following procedures have been declared |forward| with no parameters,
+because the author dislikes \PASCAL's convention about |forward| procedures
+with parameters. It was necessary to do something, because |show_token_list|
+is recursive (although the recursion is limited to one level), and because
+|flush_token_list| is syntactically (but not semantically) recursive.
+@^recursion@>
+
+@<Declare miscellaneous procedures that were declared |forward|@>=
+procedure print_capsule;
+begin print_char("("); print_exp(g_pointer,0); print_char(")");
+end;
+@#
+procedure token_recycle;
+begin recycle_value(g_pointer);
+end;
+
+@ @<Glob...@>=
+@!g_pointer:pointer; {(global) parameter to the |forward| procedures}
+
+@ Macro definitions are kept in \MP's memory in the form of token lists
+that have a few extra one-word nodes at the beginning.
+
+The first node contains a reference count that is used to tell when the
+list is no longer needed. To emphasize the fact that a reference count is
+present, we shall refer to the |info| field of this special node as the
+|ref_count| field.
+@^reference counts@>
+
+The next node or nodes after the reference count serve to describe the
+formal parameters. They either contain a code word that specifies all
+of the parameters, or they contain zero or more parameter tokens followed
+by the code `|general_macro|'.
+
+@d ref_count==info
+ {reference count preceding a macro definition or picture header}
+@d add_mac_ref(#)==incr(ref_count(#)) {make a new reference to a macro list}
+@d general_macro=0 {preface to a macro defined with a parameter list}
+@d primary_macro=1 {preface to a macro with a \&{primary} parameter}
+@d secondary_macro=2 {preface to a macro with a \&{secondary} parameter}
+@d tertiary_macro=3 {preface to a macro with a \&{tertiary} parameter}
+@d expr_macro=4 {preface to a macro with an undelimited \&{expr} parameter}
+@d of_macro=5 {preface to a macro with
+ undelimited `\&{expr} |x| \&{of}~|y|' parameters}
+@d suffix_macro=6 {preface to a macro with an undelimited \&{suffix} parameter}
+@d text_macro=7 {preface to a macro with an undelimited \&{text} parameter}
+
+@p procedure delete_mac_ref(@!p:pointer);
+ {|p| points to the reference count of a macro list that is
+ losing one reference}
+begin if ref_count(p)=null then flush_token_list(p)
+else decr(ref_count(p));
+end;
+
+@ The following subroutine displays a macro, given a pointer to its
+reference count.
+
+@p @t\4@>@<Declare the procedure called |print_cmd_mod|@>@;
+procedure show_macro(@!p:pointer;@!q,@!l:integer);
+label exit;
+var @!r:pointer; {temporary storage}
+begin p:=link(p); {bypass the reference count}
+while info(p)>text_macro do
+ begin r:=link(p); link(p):=null;
+ show_token_list(p,null,l,0); link(p):=r; p:=r;
+ if l>0 then l:=l-tally@+else return;
+ end; {control printing of `\.{ETC.}'}
+@.ETC@>
+tally:=0;
+case info(p) of
+general_macro:print("->");
+@.->@>
+primary_macro,secondary_macro,tertiary_macro:begin print_char("<");
+ print_cmd_mod(param_type,info(p)); print(">->");
+ end;
+expr_macro:print("<expr>->");
+of_macro:print("<expr>of<primary>->");
+suffix_macro:print("<suffix>->");
+text_macro:print("<text>->");
+end; {there are no other cases}
+show_token_list(link(p),q,l-tally,0);
+exit:end;
+
+@* \[15] Data structures for variables.
+The variables of \MP\ programs can be simple, like `\.x', or they can
+combine the structural properties of arrays and records, like `\.{x20a.b}'.
+A \MP\ user assigns a type to a variable like \.{x20a.b} by saying, for
+example, `\.{boolean} \.{x20a.b}'. It's time for us to study how such
+things are represented inside of the computer.
+
+Each variable value occupies two consecutive words, either in a two-word
+node called a value node, or as a two-word subfield of a larger node. One
+of those two words is called the |value| field; it is an integer,
+containing either a |scaled| numeric value or the representation of some
+other type of quantity. (It might also be subdivided into halfwords, in
+which case it is referred to by other names instead of |value|.) The other
+word is broken into subfields called |type|, |name_type|, and |link|. The
+|type| field is a quarterword that specifies the variable's type, and
+|name_type| is a quarterword from which \MP\ can reconstruct the
+variable's name (sometimes by using the |link| field as well). Thus, only
+1.25 words are actually devoted to the value itself; the other
+three-quarters of a word are overhead, but they aren't wasted because they
+allow \MP\ to deal with sparse arrays and to provide meaningful diagnostics.
+
+In this section we shall be concerned only with the structural aspects of
+variables, not their values. Later parts of the program will change the
+|type| and |value| fields, but we shall treat those fields as black boxes
+whose contents should not be touched.
+
+However, if the |type| field is |structured|, there is no |value| field,
+and the second word is broken into two pointer fields called |attr_head|
+and |subscr_head|. Those fields point to additional nodes that
+contain structural information, as we shall see.
+
+@d subscr_head_loc(#) == #+1 {where |value|, |subscr_head| and |attr_head| are}
+@d attr_head(#) == info(subscr_head_loc(#)) {pointer to attribute info}
+@d subscr_head(#) == link(subscr_head_loc(#)) {pointer to subscript info}
+@d value_node_size=2 {the number of words in a value node}
+
+@ An attribute node is three words long. Two of these words contain |type|
+and |value| fields as described above, and the third word contains
+additional information: There is an |attr_loc| field, which contains the
+hash address of the token that names this attribute; and there's also a
+|parent| field, which points to the value node of |structured| type at the
+next higher level (i.e., at the level to which this attribute is
+subsidiary). The |name_type| in an attribute node is `|attr|'. The
+|link| field points to the next attribute with the same parent; these are
+arranged in increasing order, so that |attr_loc(link(p))>attr_loc(p)|. The
+final attribute node links to the constant |end_attr|, whose |attr_loc|
+field is greater than any legal hash address. The |attr_head| in the
+parent points to a node whose |name_type| is |structured_root|; this
+node represents the null attribute, i.e., the variable that is relevant
+when no attributes are attached to the parent. The |attr_head| node is either
+a value node, a subscript node, or an attribute node, depending on what
+the parent would be if it were not structured; but the subscript and
+attribute fields are ignored, so it effectively contains only the data of
+a value node. The |link| field in this special node points to an attribute
+node whose |attr_loc| field is zero; the latter node represents a collective
+subscript `\.{[]}' attached to the parent, and its |link| field points to
+the first non-special attribute node (or to |end_attr| if there are none).
+
+A subscript node likewise occupies three words, with |type| and |value| fields
+plus extra information; its |name_type| is |subscr|. In this case the
+third word is called the |subscript| field, which is a |scaled| integer.
+The |link| field points to the subscript node with the next larger
+subscript, if any; otherwise the |link| points to the attribute node
+for collective subscripts at this level. We have seen that the latter node
+contains an upward pointer, so that the parent can be deduced.
+
+The |name_type| in a parent-less value node is |root|, and the |link|
+is the hash address of the token that names this value.
+
+In other words, variables have a hierarchical structure that includes
+enough threads running around so that the program is able to move easily
+between siblings, parents, and children. An example should be helpful:
+(The reader is advised to draw a picture while reading the following
+description, since that will help to firm up the ideas.)
+Suppose that `\.x' and `\.{x.a}' and `\.{x[]b}' and `\.{x5}'
+and `\.{x20b}' have been mentioned in a user's program, where
+\.{x[]b} has been declared to be of \&{boolean} type. Let |h(x)|, |h(a)|,
+and |h(b)| be the hash addresses of \.x, \.a, and~\.b. Then
+|eq_type(h(x))=name| and |equiv(h(x))=p|, where |p|~is a two-word value
+node with |name_type(p)=root| and |link(p)=h(x)|. We have |type(p)=structured|,
+|attr_head(p)=q|, and |subscr_head(p)=r|, where |q| points to a value
+node and |r| to a subscript node. (Are you still following this? Use
+a pencil to draw a diagram.) The lone variable `\.x' is represented by
+|type(q)| and |value(q)|; furthermore
+|name_type(q)=structured_root| and |link(q)=q1|, where |q1| points
+to an attribute node representing `\.{x[]}'. Thus |name_type(q1)=attr|,
+|attr_loc(q1)=collective_subscript=0|, |parent(q1)=p|,
+|type(q1)=structured|, |attr_head(q1)=qq|, and |subscr_head(q1)=qq1|;
+|qq| is a value node with |type(qq)=numeric_type| (assuming that \.{x5} is
+numeric, because |qq| represents `\.{x[]}' with no further attributes),
+|name_type(qq)=structured_root|, and
+|link(qq)=qq1|. (Now pay attention to the next part.) Node |qq1| is
+an attribute node representing `\.{x[][]}', which has never yet
+occurred; its |type| field is |undefined|, and its |value| field is
+undefined. We have |name_type(qq1)=attr|, |attr_loc(qq1)=collective_subscript|,
+|parent(qq1)=q1|, and |link(qq1)=qq2|. Since |qq2| represents
+`\.{x[]b}', |type(qq2)=unknown_boolean|; also |attr_loc(qq2)=h(b)|,
+|parent(qq2)=q1|, |name_type(qq2)=attr|, |link(qq2)=end_attr|.
+(Maybe colored lines will help untangle your picture.)
+ Node |r| is a subscript node with |type| and |value|
+representing `\.{x5}'; |name_type(r)=subscr|, |subscript(r)=5.0|,
+and |link(r)=r1| is another subscript node. To complete the picture,
+see if you can guess what |link(r1)| is; give up? It's~|q1|.
+Furthermore |subscript(r1)=20.0|, |name_type(r1)=subscr|,
+|type(r1)=structured|, |attr_head(r1)=qqq|, |subscr_head(r1)=qqq1|,
+and we finish things off with three more nodes
+|qqq|, |qqq1|, and |qqq2| hung onto~|r1|. (Perhaps you should start again
+with a larger sheet of paper.) The value of variable \.{x20b}
+appears in node~|qqq2|, as you can well imagine.
+
+If the example in the previous paragraph doesn't make things crystal
+clear, a glance at some of the simpler subroutines below will reveal how
+things work out in practice.
+
+The only really unusual thing about these conventions is the use of
+collective subscript attributes. The idea is to avoid repeating a lot of
+type information when many elements of an array are identical macros
+(for which distinct values need not be stored) or when they don't have
+all of the possible attributes. Branches of the structure below collective
+subscript attributes do not carry actual values except for macro identifiers;
+branches of the structure below subscript nodes do not carry significant
+information in their collective subscript attributes.
+
+@d attr_loc_loc(#)==#+2 {where the |attr_loc| and |parent| fields are}
+@d attr_loc(#)==info(attr_loc_loc(#)) {hash address of this attribute}
+@d parent(#)==link(attr_loc_loc(#)) {pointer to |structured| variable}
+@d subscript_loc(#)==#+2 {where the |subscript| field lives}
+@d subscript(#)==mem[subscript_loc(#)].sc {subscript of this variable}
+@d attr_node_size=3 {the number of words in an attribute node}
+@d subscr_node_size=3 {the number of words in a subscript node}
+@d collective_subscript=0 {code for the attribute `\.{[]}'}
+
+@<Initialize table...@>=
+attr_loc(end_attr):=hash_end+1; parent(end_attr):=null;
+
+@ Variables of type \&{pair} will have values that point to four-word
+nodes containing two numeric values. The first of these values has
+|name_type=x_part_sector| and the second has |name_type=y_part_sector|;
+the |link| in the first points back to the node whose |value| points
+to this four-word node.
+
+Variables of type \&{transform} are similar, but in this case their
+|value| points to a 12-word node containing six values, identified by
+|x_part_sector|, |y_part_sector|, |xx_part_sector|, |xy_part_sector|,
+|yx_part_sector|, and |yy_part_sector|.
+Finally, variables of type \&{color} have three values in six words
+identified by |red_part_sector|, |green_part_sector|, and |blue_part_sector|.
+
+When an entire structured variable is saved, the |root| indication
+is temporarily replaced by |saved_root|.
+
+Some variables have no name; they just are used for temporary storage
+while expressions are being evaluated. We call them {\sl capsules}.
+
+@d x_part_loc(#)==# {where the \&{xpart} is found in a pair or transform node}
+@d y_part_loc(#)==#+2 {where the \&{ypart} is found in a pair or transform node}
+@d xx_part_loc(#)==#+4 {where the \&{xxpart} is found in a transform node}
+@d xy_part_loc(#)==#+6 {where the \&{xypart} is found in a transform node}
+@d yx_part_loc(#)==#+8 {where the \&{yxpart} is found in a transform node}
+@d yy_part_loc(#)==#+10 {where the \&{yypart} is found in a transform node}
+@d red_part_loc(#)==# {where the \&{redpart} is found in a color node}
+@d green_part_loc(#)==#+2 {where the \&{greenpart} is found in a color node}
+@d blue_part_loc(#)==#+4 {where the \&{bluepart} is found in a color node}
+@#
+@d pair_node_size=4 {the number of words in a pair node}
+@d transform_node_size=12 {the number of words in a transform node}
+@d color_node_size=6 {the number of words in a color node}
+
+@<Glob...@>=
+@!big_node_size:array[transform_type..pair_type] of small_number;
+@!sector0:array[transform_type..pair_type] of small_number;
+@!sector_offset:array[x_part_sector..blue_part_sector] of small_number;
+
+@ The |sector0| array gives for each big node type, |name_type| values
+for its first subfield; the |sector_offset| array gives for each
+|name_type| value, the offset from the first subfield in words;
+and the |big_node_size| array gives the size in words for each type of
+big node.
+
+@<Set init...@>=
+big_node_size[transform_type]:=transform_node_size;
+big_node_size[pair_type]:=pair_node_size;
+big_node_size[color_type]:=color_node_size;
+sector0[transform_type]:=x_part_sector;
+sector0[pair_type]:=x_part_sector;
+sector0[color_type]:=red_part_sector;
+for k:=x_part_sector to yy_part_sector do
+ sector_offset[k]:=2*(k-x_part_sector);
+for k:=red_part_sector to blue_part_sector do
+ sector_offset[k]:=2*(k-red_part_sector);
+
+@ If |type(p)=pair_type| or |transform_type| and if |value(p)=null|, the
+procedure call |init_big_node(p)| will allocate a pair or transform node
+for~|p|. The individual parts of such nodes are initially of type
+|independent|.
+
+@p procedure init_big_node(@!p:pointer);
+var @!q:pointer; {the new node}
+@!s:small_number; {its size}
+begin s:=big_node_size[type(p)]; q:=get_node(s);
+repeat s:=s-2; @<Make variable |q+s| newly independent@>;
+name_type(q+s):=halfp(s)+sector0[type(p)]; link(q+s):=null;
+until s=0;
+link(q):=p; value(p):=q;
+end;
+
+@ The |id_transform| function creates a capsule for the
+identity transformation.
+
+@p function id_transform:pointer;
+var @!p,@!q,@!r:pointer; {list manipulation registers}
+begin p:=get_node(value_node_size); type(p):=transform_type;
+name_type(p):=capsule; value(p):=null; init_big_node(p); q:=value(p);
+r:=q+transform_node_size;
+repeat r:=r-2;
+type(r):=known; value(r):=0;
+until r=q;
+value(xx_part_loc(q)):=unity; value(yy_part_loc(q)):=unity;
+id_transform:=p;
+end;
+
+@ Tokens are of type |tag_token| when they first appear, but they point
+to |null| until they are first used as the root of a variable.
+The following subroutine establishes the root node on such grand occasions.
+
+@p procedure new_root(@!x:pointer);
+var @!p:pointer; {the new node}
+begin p:=get_node(value_node_size); type(p):=undefined; name_type(p):=root;
+link(p):=x; equiv(x):=p;
+end;
+
+@ These conventions for variable representation are illustrated by the
+|print_variable_name| routine, which displays the full name of a
+variable given only a pointer to its two-word value packet.
+
+@p procedure print_variable_name(@!p:pointer);
+label found,exit;
+var @!q:pointer; {a token list that will name the variable's suffix}
+@!r:pointer; {temporary for token list creation}
+begin while name_type(p)>=x_part_sector do
+ @<Preface the output with a part specifier; |return| in the
+ case of a capsule@>;
+q:=null;
+while name_type(p)>saved_root do
+ @<Ascend one level, pushing a token onto list |q|
+ and replacing |p| by its parent@>;
+r:=get_avail; info(r):=link(p); link(r):=q;
+if name_type(p)=saved_root then print("(SAVED)");
+@.SAVED@>
+show_token_list(r,null,el_gordo,tally); flush_token_list(r);
+exit:end;
+
+@ @<Ascend one level, pushing a token onto list |q|...@>=
+begin if name_type(p)=subscr then
+ begin r:=new_num_tok(subscript(p));
+ repeat p:=link(p);
+ until name_type(p)=attr;
+ end
+else if name_type(p)=structured_root then
+ begin p:=link(p); goto found;
+ end
+else begin if name_type(p)<>attr then confusion("var");
+@:this can't happen var}{\quad var@>
+ r:=get_avail; info(r):=attr_loc(p);
+ end;
+link(r):=q; q:=r;
+found: p:=parent(p);
+end
+
+@ @<Preface the output with a part specifier...@>=
+begin case name_type(p) of
+x_part_sector: print_char("x");
+y_part_sector: print_char("y");
+xx_part_sector: print("xx");
+xy_part_sector: print("xy");
+yx_part_sector: print("yx");
+yy_part_sector: print("yy");
+red_part_sector: print("red");
+green_part_sector: print("green");
+blue_part_sector: print("blue");
+capsule: begin print("%CAPSULE"); print_int(p-null); return;
+@.CAPSULE@>
+ end;
+end; {there are no other cases}
+print("part "); p:=link(p-sector_offset[name_type(p)]);
+end
+
+@ The |interesting| function returns |true| if a given variable is not
+in a capsule, or if the user wants to trace capsules.
+
+@p function interesting(@!p:pointer):boolean;
+var @!t:small_number; {a |name_type|}
+begin if internal[tracing_capsules]>0 then interesting:=true
+else begin t:=name_type(p);
+ if t>=x_part_sector then if t<>capsule then
+ t:=name_type(link(p-sector_offset[t]));
+ interesting:=(t<>capsule);
+ end;
+end;
+
+@ Now here is a subroutine that converts an unstructured type into an
+equivalent structured type, by inserting a |structured| node that is
+capable of growing. This operation is done only when |name_type(p)=root|,
+|subscr|, or |attr|.
+
+The procedure returns a pointer to the new node that has taken node~|p|'s
+place in the structure. Node~|p| itself does not move, nor are its
+|value| or |type| fields changed in any way.
+
+@p function new_structure(@!p:pointer):pointer;
+var @!q,@!r:pointer; {list manipulation registers}
+begin case name_type(p) of
+root: begin q:=link(p); r:=get_node(value_node_size); equiv(q):=r;
+ end;
+subscr: @<Link a new subscript node |r| in place of node |p|@>;
+attr: @<Link a new attribute node |r| in place of node |p|@>;
+othercases confusion("struct")
+@:this can't happen struct}{\quad struct@>
+endcases;@/
+link(r):=link(p); type(r):=structured; name_type(r):=name_type(p);
+attr_head(r):=p; name_type(p):=structured_root;@/
+q:=get_node(attr_node_size); link(p):=q; subscr_head(r):=q;
+parent(q):=r; type(q):=undefined; name_type(q):=attr; link(q):=end_attr;
+attr_loc(q):=collective_subscript; new_structure:=r;
+end;
+
+@ @<Link a new subscript node |r| in place of node |p|@>=
+begin q:=p;
+repeat q:=link(q);
+until name_type(q)=attr;
+q:=parent(q); r:=subscr_head_loc(q); {|link(r)=subscr_head(q)|}
+repeat q:=r; r:=link(r);
+until r=p;
+r:=get_node(subscr_node_size);
+link(q):=r; subscript(r):=subscript(p);
+end
+
+@ If the attribute is |collective_subscript|, there are two pointers to
+node~|p|, so we must change both of them.
+
+@<Link a new attribute node |r| in place of node |p|@>=
+begin q:=parent(p); r:=attr_head(q);
+repeat q:=r; r:=link(r);
+until r=p;
+r:=get_node(attr_node_size); link(q):=r;@/
+mem[attr_loc_loc(r)]:=mem[attr_loc_loc(p)]; {copy |attr_loc| and |parent|}
+if attr_loc(p)=collective_subscript then
+ begin q:=subscr_head_loc(parent(p));
+ while link(q)<>p do q:=link(q);
+ link(q):=r;
+ end;
+end
+
+@ The |find_variable| routine is given a pointer~|t| to a nonempty token
+list of suffixes; it returns a pointer to the corresponding two-word
+value. For example, if |t| points to token \.x followed by a numeric
+token containing the value~7, |find_variable| finds where the value of
+\.{x7} is stored in memory. This may seem a simple task, and it
+usually is, except when \.{x7} has never been referenced before.
+Indeed, \.x may never have even been subscripted before; complexities
+arise with respect to updating the collective subscript information.
+
+If a macro type is detected anywhere along path~|t|, or if the first
+item on |t| isn't a |tag_token|, the value |null| is returned.
+Otherwise |p| will be a non-null pointer to a node such that
+|undefined<type(p)<structured|.
+
+@d abort_find==begin find_variable:=null; return;@+end
+
+@p function find_variable(@!t:pointer):pointer;
+label exit;
+var @!p,@!q,@!r,@!s:pointer; {nodes in the ``value'' line}
+@!pp,@!qq,@!rr,@!ss:pointer; {nodes in the ``collective'' line}
+@!n:integer; {subscript or attribute}
+@!save_word:memory_word; {temporary storage for a word of |mem|}
+@^inner loop@>
+begin p:=info(t); t:=link(t);
+if eq_type(p) mod outer_tag<>tag_token then abort_find;
+if equiv(p)=null then new_root(p);
+p:=equiv(p); pp:=p;
+while t<>null do
+ begin @<Make sure that both nodes |p| and |pp| are of |structured| type@>;
+ if t<hi_mem_min then
+ @<Descend one level for the subscript |value(t)|@>
+ else @<Descend one level for the attribute |info(t)|@>;
+ t:=link(t);
+ end;
+if type(pp)>=structured then
+ if type(pp)=structured then pp:=attr_head(pp)@+else abort_find;
+if type(p)=structured then p:=attr_head(p);
+if type(p)=undefined then
+ begin if type(pp)=undefined then
+ begin type(pp):=numeric_type; value(pp):=null;
+ end;
+ type(p):=type(pp); value(p):=null;
+ end;
+find_variable:=p;
+exit:end;
+
+@ Although |pp| and |p| begin together, they diverge when a subscript occurs;
+|pp|~stays in the collective line while |p|~goes through actual subscript
+values.
+
+@<Make sure that both nodes |p| and |pp|...@>=
+if type(pp)<>structured then
+ begin if type(pp)>structured then abort_find;
+ ss:=new_structure(pp);
+ if p=pp then p:=ss;
+ pp:=ss;
+ end; {now |type(pp)=structured|}
+if type(p)<>structured then {it cannot be |>structured|}
+ p:=new_structure(p) {now |type(p)=structured|}
+
+@ We want this part of the program to be reasonably fast, in case there are
+@^inner loop@>
+lots of subscripts at the same level of the data structure. Therefore
+we store an ``infinite'' value in the word that appears at the end of the
+subscript list, even though that word isn't part of a subscript node.
+
+@<Descend one level for the subscript |value(t)|@>=
+begin n:=value(t);
+pp:=link(attr_head(pp)); {now |attr_loc(pp)=collective_subscript|}
+q:=link(attr_head(p)); save_word:=mem[subscript_loc(q)];
+subscript(q):=el_gordo; s:=subscr_head_loc(p); {|link(s)=subscr_head(p)|}
+repeat r:=s; s:=link(s);
+until n<=subscript(s);
+if n=subscript(s) then p:=s
+else begin p:=get_node(subscr_node_size); link(r):=p; link(p):=s;
+ subscript(p):=n; name_type(p):=subscr; type(p):=undefined;
+ end;
+mem[subscript_loc(q)]:=save_word;
+end
+
+@ @<Descend one level for the attribute |info(t)|@>=
+begin n:=info(t);
+ss:=attr_head(pp);
+repeat rr:=ss; ss:=link(ss);
+until n<=attr_loc(ss);
+if n<attr_loc(ss) then
+ begin qq:=get_node(attr_node_size); link(rr):=qq; link(qq):=ss;
+ attr_loc(qq):=n; name_type(qq):=attr; type(qq):=undefined;
+ parent(qq):=pp; ss:=qq;
+ end;
+if p=pp then
+ begin p:=ss; pp:=ss;
+ end
+else begin pp:=ss; s:=attr_head(p);
+ repeat r:=s; s:=link(s);
+ until n<=attr_loc(s);
+ if n=attr_loc(s) then p:=s
+ else begin q:=get_node(attr_node_size); link(r):=q; link(q):=s;
+ attr_loc(q):=n; name_type(q):=attr; type(q):=undefined;
+ parent(q):=p; p:=q;
+ end;
+ end;
+end
+
+@ Variables lose their former values when they appear in a type declaration,
+or when they are defined to be macros or \&{let} equal to something else.
+A subroutine will be defined later that recycles the storage associated
+with any particular |type| or |value|; our goal now is to study a higher
+level process called |flush_variable|, which selectively frees parts of a
+variable structure.
+
+This routine has some complexity because of examples such as
+`\hbox{\tt numeric x[]a[]b}'
+which recycles all variables of the form \.{x[i]a[j]b} (and no others), while
+`\hbox{\tt vardef x[]a[]=...}'
+discards all variables of the form \.{x[i]a[j]} followed by an arbitrary
+suffix, except for the collective node \.{x[]a[]} itself. The obvious way
+to handle such examples is to use recursion; so that's what we~do.
+@^recursion@>
+
+Parameter |p| points to the root information of the variable;
+parameter |t| points to a list of one-word nodes that represent
+suffixes, with |info=collective_subscript| for subscripts.
+
+@p @t\4@>@<Declare subroutines for printing expressions@>@;@/
+@t\4@>@<Declare basic dependency-list subroutines@>@;
+@t\4@>@<Declare the recycling subroutines@>@;
+@t\4@>@<Declare the procedure called |flush_cur_exp|@>@;
+@t\4@>@<Declare the procedure called |flush_below_variable|@>@;
+procedure flush_variable(@!p,@!t:pointer;@!discard_suffixes:boolean);
+label exit;
+var @!q,@!r:pointer; {list manipulation}
+@!n:halfword; {attribute to match}
+begin while t<>null do
+ begin if type(p)<>structured then return;
+ n:=info(t); t:=link(t);
+ if n=collective_subscript then
+ begin r:=subscr_head_loc(p); q:=link(r); {|q=subscr_head(p)|}
+ while name_type(q)=subscr do
+ begin flush_variable(q,t,discard_suffixes);
+ if t=null then
+ if type(q)=structured then r:=q
+ else begin link(r):=link(q); free_node(q,subscr_node_size);
+ end
+ else r:=q;
+ q:=link(r);
+ end;
+ end;
+ p:=attr_head(p);
+ repeat r:=p; p:=link(p);
+ until attr_loc(p)>=n;
+ if attr_loc(p)<>n then return;
+ end;
+if discard_suffixes then flush_below_variable(p)
+else begin if type(p)=structured then p:=attr_head(p);
+ recycle_value(p);
+ end;
+exit:end;
+
+@ The next procedure is simpler; it wipes out everything but |p| itself,
+which becomes undefined.
+
+@<Declare the procedure called |flush_below_variable|@>=
+procedure flush_below_variable(@!p:pointer);
+var @!q,@!r:pointer; {list manipulation registers}
+begin if type(p)<>structured then
+ recycle_value(p) {this sets |type(p)=undefined|}
+else begin q:=subscr_head(p);
+ while name_type(q)=subscr do
+ begin flush_below_variable(q); r:=q; q:=link(q);
+ free_node(r,subscr_node_size);
+ end;
+ r:=attr_head(p); q:=link(r); recycle_value(r);
+ if name_type(p)<=saved_root then free_node(r,value_node_size)
+ else free_node(r,subscr_node_size);
+ {we assume that |subscr_node_size=attr_node_size|}
+ repeat flush_below_variable(q); r:=q; q:=link(q); free_node(r,attr_node_size);
+ until q=end_attr;
+ type(p):=undefined;
+ end;
+end;
+
+@ Just before assigning a new value to a variable, we will recycle the
+old value and make the old value undefined. The |und_type| routine
+determines what type of undefined value should be given, based on
+the current type before recycling.
+
+@p function und_type(@!p:pointer):small_number;
+begin case type(p) of
+undefined,vacuous:und_type:=undefined;
+boolean_type,unknown_boolean:und_type:=unknown_boolean;
+string_type,unknown_string:und_type:=unknown_string;
+pen_type,unknown_pen:und_type:=unknown_pen;
+path_type,unknown_path:und_type:=unknown_path;
+picture_type,unknown_picture:und_type:=unknown_picture;
+transform_type,color_type,pair_type,numeric_type:und_type:=type(p);
+known,dependent,proto_dependent,independent:und_type:=numeric_type;
+end; {there are no other cases}
+end;
+
+@ The |clear_symbol| routine is used when we want to redefine the equivalent
+of a symbolic token. It must remove any variable structure or macro
+definition that is currently attached to that symbol. If the |saving|
+parameter is true, a subsidiary structure is saved instead of destroyed.
+
+@p procedure clear_symbol(@!p:pointer;@!saving:boolean);
+var @!q:pointer; {|equiv(p)|}
+begin q:=equiv(p);
+case eq_type(p) mod outer_tag of
+defined_macro,secondary_primary_macro,tertiary_secondary_macro,
+ expression_tertiary_macro: if not saving then delete_mac_ref(q);
+tag_token:if q<>null then
+ if saving then name_type(q):=saved_root
+ else begin flush_below_variable(q); free_node(q,value_node_size);
+ end;
+othercases do_nothing
+endcases;@/
+eqtb[p]:=eqtb[frozen_undefined];
+end;
+
+@* \[16] Saving and restoring equivalents.
+The nested structure given by \&{begingroup} and \&{endgroup}
+allows |eqtb| entries to be saved and restored, so that temporary changes
+can be made without difficulty. When the user requests a current value to
+be saved, \MP\ puts that value into its ``save stack.'' An appearance of
+\&{endgroup} ultimately causes the old values to be removed from the save
+stack and put back in their former places.
+
+The save stack is a linked list containing three kinds of entries,
+distinguished by their |info| fields. If |p| points to a saved item,
+then
+
+\smallskip\hang
+|info(p)=0| stands for a group boundary; each \&{begingroup} contributes
+such an item to the save stack and each \&{endgroup} cuts back the stack
+until the most recent such entry has been removed.
+
+\smallskip\hang
+|info(p)=q|, where |1<=q<=hash_end|, means that |mem[p+1]| holds the former
+contents of |eqtb[q]|. Such save stack entries are generated by \&{save}
+commands or suitable \&{interim} commands.
+
+\smallskip\hang
+|info(p)=hash_end+q|, where |q>0|, means that |value(p)| is a |scaled|
+integer to be restored to internal parameter number~|q|. Such entries
+are generated by \&{interim} commands.
+
+\smallskip\noindent
+The global variable |save_ptr| points to the top item on the save stack.
+
+@d save_node_size=2 {number of words per non-boundary save-stack node}
+@d saved_equiv(#)==mem[#+1].hh {where an |eqtb| entry gets saved}
+@d save_boundary_item(#)==begin #:=get_avail; info(#):=0;
+ link(#):=save_ptr; save_ptr:=#;
+ end
+
+@<Glob...@>=@!save_ptr:pointer; {the most recently saved item}
+
+@ @<Set init...@>=save_ptr:=null;
+
+@ The |save_variable| routine is given a hash address |q|; it salts this
+address in the save stack, together with its current equivalent,
+then makes token~|q| behave as though it were brand new.
+
+Nothing is stacked when |save_ptr=null|, however; there's no way to remove
+things from the stack when the program is not inside a group, so there's
+no point in wasting the space.
+
+@p procedure save_variable(@!q:pointer);
+var @!p:pointer; {temporary register}
+begin if save_ptr<>null then
+ begin p:=get_node(save_node_size); info(p):=q; link(p):=save_ptr;
+ saved_equiv(p):=eqtb[q]; save_ptr:=p;
+ end;
+clear_symbol(q,(save_ptr<>null));
+end;
+
+@ Similarly, |save_internal| is given the location |q| of an internal
+quantity like |tracing_pens|. It creates a save stack entry of the
+third kind.
+
+@p procedure save_internal(@!q:halfword);
+var @!p:pointer; {new item for the save stack}
+begin if save_ptr<>null then
+ begin p:=get_node(save_node_size); info(p):=hash_end+q;
+ link(p):=save_ptr; value(p):=internal[q]; save_ptr:=p;
+ end;
+end;
+
+@ At the end of a group, the |unsave| routine restores all of the saved
+equivalents in reverse order. This routine will be called only when there
+is at least one boundary item on the save stack.
+
+@p procedure unsave;
+var @!q:pointer; {index to saved item}
+@!p:pointer; {temporary register}
+begin while info(save_ptr)<>0 do
+ begin q:=info(save_ptr);
+ if q>hash_end then
+ begin if internal[tracing_restores]>0 then
+ begin begin_diagnostic; print_nl("{restoring ");
+ print(int_name[q-(hash_end)]); print_char("=");
+ print_scaled(value(save_ptr)); print_char("}");
+ end_diagnostic(false);
+ end;
+ internal[q-(hash_end)]:=value(save_ptr);
+ end
+ else begin if internal[tracing_restores]>0 then
+ begin begin_diagnostic; print_nl("{restoring ");
+ print(text(q)); print_char("}");
+ end_diagnostic(false);
+ end;
+ clear_symbol(q,false);
+ eqtb[q]:=saved_equiv(save_ptr);
+ if eq_type(q) mod outer_tag=tag_token then
+ begin p:=equiv(q);
+ if p<>null then name_type(p):=root;
+ end;
+ end;
+ p:=link(save_ptr); free_node(save_ptr,save_node_size); save_ptr:=p;
+ end;
+p:=link(save_ptr); free_avail(save_ptr); save_ptr:=p;
+end;
+
+@* \[17] Data structures for paths.
+When a \MP\ user specifies a path, \MP\ will create a list of knots
+and control points for the associated cubic spline curves. If the
+knots are $z_0$, $z_1$, \dots, $z_n$, there are control points
+$z_k^+$ and $z_{k+1}^-$ such that the cubic splines between knots
+$z_k$ and $z_{k+1}$ are defined by B\'ezier's formula
+@:Bezier}{B\'ezier, Pierre Etienne@>
+$$\eqalign{z(t)&=B(z_k,z_k^+,z_{k+1}^-,z_{k+1};t)\cr
+&=(1-t)^3z_k+3(1-t)^2tz_k^++3(1-t)t^2z_{k+1}^-+t^3z_{k+1}\cr}$$
+for |0<=t<=1|.
+
+There is a 8-word node for each knot $z_k$, containing one word of
+control information and six words for the |x| and |y| coordinates of
+$z_k^-$ and $z_k$ and~$z_k^+$. The control information appears in the
+|left_type| and |right_type| fields, which each occupy a quarter of
+the first word in the node; they specify properties of the curve as it
+enters and leaves the knot. There's also a halfword |link| field,
+which points to the following knot, and a final supplementary word (of
+which only a quarter is used).
+
+If the path is a closed contour, knots 0 and |n| are identical;
+i.e., the |link| in knot |n-1| points to knot~0. But if the path
+is not closed, the |left_type| of knot~0 and the |right_type| of knot~|n|
+are equal to |endpoint|. In the latter case the |link| in knot~|n| points
+to knot~0, and the control points $z_0^-$ and $z_n^+$ are not used.
+
+@d left_type(#) == mem[#].hh.b0 {characterizes the path entering this knot}
+@d right_type(#) == mem[#].hh.b1 {characterizes the path leaving this knot}
+@d endpoint=0 {|left_type| at path beginning and |right_type| at path end}
+@d x_coord(#) == mem[#+1].sc {the |x| coordinate of this knot}
+@d y_coord(#) == mem[#+2].sc {the |y| coordinate of this knot}
+@d left_x(#) == mem[#+3].sc {the |x| coordinate of previous control point}
+@d left_y(#) == mem[#+4].sc {the |y| coordinate of previous control point}
+@d right_x(#) == mem[#+5].sc {the |x| coordinate of next control point}
+@d right_y(#) == mem[#+6].sc {the |y| coordinate of next control point}
+@d x_loc(#) == #+1 {where the |x| coordinate is stored in a knot}
+@d y_loc(#) == #+2 {where the |y| coordinate is stored in a knot}
+@d knot_coord(#) == mem[#].sc {|x| or |y| coordinate given |x_loc| or |y_loc|}
+@d left_coord(#) == mem[#+2].sc
+ {coordinate of previous control point given |x_loc| or |y_loc|}
+@d right_coord(#) == mem[#+4].sc
+ {coordinate of next control point given |x_loc| or |y_loc|}
+@d knot_node_size=8 {number of words in a knot node}
+
+@ Before the B\'ezier control points have been calculated, the memory
+space they will ultimately occupy is taken up by information that can be
+used to compute them. There are four cases:
+
+\yskip
+\textindent{$\bullet$} If |right_type=open|, the curve should leave
+the knot in the same direction it entered; \MP\ will figure out a
+suitable direction.
+
+\yskip
+\textindent{$\bullet$} If |right_type=curl|, the curve should leave the
+knot in a direction depending on the angle at which it enters the next
+knot and on the curl parameter stored in |right_curl|.
+
+\yskip
+\textindent{$\bullet$} If |right_type=given|, the curve should leave the
+knot in a nonzero direction stored as an |angle| in |right_given|.
+
+\yskip
+\textindent{$\bullet$} If |right_type=explicit|, the B\'ezier control
+point for leaving this knot has already been computed; it is in the
+|right_x| and |right_y| fields.
+
+\yskip\noindent
+The rules for |left_type| are similar, but they refer to the curve entering
+the knot, and to \\{left} fields instead of \\{right} fields.
+
+Non-|explicit| control points will be chosen based on ``tension'' parameters
+in the |left_tension| and |right_tension| fields. The
+`\&{atleast}' option is represented by negative tension values.
+@!@:at_least_}{\&{atleast} primitive@>
+
+For example, the \MP\ path specification
+$$\.{z0..z1..tension atleast 1..\{curl 2\}z2..z3\{-1,-2\}..tension
+ 3 and 4..p},$$
+where \.p is the path `\.{z4..controls z45 and z54..z5}', will be represented
+by the six knots
+\def\lodash{\hbox to 1.1em{\thinspace\hrulefill\thinspace}}
+$$\vbox{\halign{#\hfil&&\qquad#\hfil\cr
+|left_type|&\\{left} info&|x_coord,y_coord|&|right_type|&\\{right} info\cr
+\noalign{\yskip}
+|endpoint|&\lodash$,\,$\lodash&$x_0,y_0$&|curl|&$1.0,1.0$\cr
+|open|&\lodash$,1.0$&$x_1,y_1$&|open|&\lodash$,-1.0$\cr
+|curl|&$2.0,-1.0$&$x_2,y_2$&|curl|&$2.0,1.0$\cr
+|given|&$d,1.0$&$x_3,y_3$&|given|&$d,3.0$\cr
+|open|&\lodash$,4.0$&$x_4,y_4$&|explicit|&$x_{45},y_{45}$\cr
+|explicit|&$x_{54},y_{54}$&$x_5,y_5$&|endpoint|&\lodash$,\,$\lodash\cr}}$$
+Here |d| is the |angle| obtained by calling |n_arg(-unity,-two)|.
+Of course, this example is more complicated than anything a normal user
+would ever write.
+
+These types must satisfy certain restrictions because of the form of \MP's
+path syntax:
+(i)~|open| type never appears in the same node together with |endpoint|,
+|given|, or |curl|.
+(ii)~The |right_type| of a node is |explicit| if and only if the
+|left_type| of the following node is |explicit|.
+(iii)~|endpoint| types occur only at the ends, as mentioned above.
+
+@d left_curl==left_x {curl information when entering this knot}
+@d left_given==left_x {given direction when entering this knot}
+@d left_tension==left_y {tension information when entering this knot}
+@d right_curl==right_x {curl information when leaving this knot}
+@d right_given==right_x {given direction when leaving this knot}
+@d right_tension==right_y {tension information when leaving this knot}
+@d explicit=1 {|left_type| or |right_type| when control points are known}
+@d given=2 {|left_type| or |right_type| when a direction is given}
+@d curl=3 {|left_type| or |right_type| when a curl is desired}
+@d open=4 {|left_type| or |right_type| when \MP\ should choose the direction}
+
+@ Knots can be user-supplied, or they can be created by program code,
+like the |split_cubic| function, or |copy_path|. The distinction is
+needed for the cleanup routine that runs after |split_cubic|, because
+it should only delete knots it has previously inserted, and never
+anything that was user-supplied. In order to be able to differentiate
+one knot from another, we will set |originator(p):=metapost_user| when
+it appeared in the actual metapost program, and
+|originator(p):=program_code| in all other cases.
+
+@d originator(#) == mem[#+7].hh.b0 {the creator of this knot}
+@d program_code=0 {not created by a user}
+@d metapost_user=1 {created by a user}
+
+@ Here is a routine that prints a given knot list
+in symbolic form. It illustrates the conventions discussed above,
+and checks for anomalies that might arise while \MP\ is being debugged.
+
+@<Declare subroutines for printing expressions@>=
+procedure pr_path(@!h:pointer);
+label done,done1;
+var @!p,@!q:pointer; {for list traversal}
+begin p:=h;
+repeat q:=link(p);
+if (p=null)or(q=null) then
+ begin print_nl("???"); goto done; {this won't happen}
+@.???@>
+ end;
+@<Print information for adjacent knots |p| and |q|@>;
+p:=q;
+if (p<>h)or(left_type(h)<>endpoint) then
+ @<Print two dots, followed by |given| or |curl| if present@>;
+until p=h;
+if left_type(h)<>endpoint then print("cycle");
+done:end;
+
+@ @<Print information for adjacent knots...@>=
+print_two(x_coord(p),y_coord(p));
+case right_type(p) of
+endpoint: begin if left_type(p)=open then print("{open?}"); {can't happen}
+@.open?@>
+ if (left_type(q)<>endpoint)or(q<>h) then q:=null; {force an error}
+ goto done1;
+ end;
+explicit: @<Print control points between |p| and |q|, then |goto done1|@>;
+open: @<Print information for a curve that begins |open|@>;
+curl,given: @<Print information for a curve that begins |curl| or |given|@>;
+othercases print("???") {can't happen}
+@.???@>
+endcases;@/
+if left_type(q)<=explicit then print("..control?") {can't happen}
+@.control?@>
+else if (right_tension(p)<>unity)or(left_tension(q)<>unity) then
+ @<Print tension between |p| and |q|@>;
+done1:
+
+@ Since |n_sin_cos| produces |fraction| results, which we will print as if they
+were |scaled|, the magnitude of a |given| direction vector will be~4096.
+
+@<Print two dots...@>=
+begin print_nl(" ..");
+if left_type(p)=given then
+ begin n_sin_cos(left_given(p)); print_char("{");
+ print_scaled(n_cos); print_char(",");
+ print_scaled(n_sin); print_char("}");
+ end
+else if left_type(p)=curl then
+ begin print("{curl "); print_scaled(left_curl(p)); print_char("}");
+ end;
+end
+
+@ @<Print tension between |p| and |q|@>=
+begin print("..tension ");
+if right_tension(p)<0 then print("atleast");
+print_scaled(abs(right_tension(p)));
+if right_tension(p)<>left_tension(q) then
+ begin print(" and ");
+ if left_tension(q)<0 then print("atleast");
+ print_scaled(abs(left_tension(q)));
+ end;
+end
+
+@ @<Print control points between |p| and |q|, then |goto done1|@>=
+begin print("..controls "); print_two(right_x(p),right_y(p)); print(" and ");
+if left_type(q)<>explicit then print("??") {can't happen}
+@.??@>
+else print_two(left_x(q),left_y(q));
+goto done1;
+end
+
+@ @<Print information for a curve that begins |open|@>=
+if (left_type(p)<>explicit)and(left_type(p)<>open) then
+ print("{open?}") {can't happen}
+@.open?@>
+
+@ A curl of 1 is shown explicitly, so that the user sees clearly that
+\MP's default curl is present.
+
+The code here uses the fact that |left_curl==left_given| and
+|right_curl==right_given|.
+
+@<Print information for a curve that begins |curl|...@>=
+begin if left_type(p)=open then print("??"); {can't happen}
+@.??@>
+if right_type(p)=curl then
+ begin print("{curl "); print_scaled(right_curl(p));
+ end
+else begin n_sin_cos(right_given(p)); print_char("{");
+ print_scaled(n_cos); print_char(","); print_scaled(n_sin);
+ end;
+print_char("}");
+end
+
+@ It is convenient to have another version of |pr_path| that prints the path
+as a diagnostic message.
+
+@<Declare subroutines for printing expressions@>=
+procedure print_path(@!h:pointer;@!s:str_number;@!nuline:boolean);
+begin print_diagnostic("Path",s,nuline); print_ln;
+@.Path at line...@>
+pr_path(h);
+end_diagnostic(true);
+end;
+
+@ If we want to duplicate a knot node, we can say |copy_knot|:
+
+@p function copy_knot(@!p:pointer):pointer;
+var @!q:pointer; {the copy}
+@!k:0..knot_node_size-1; {runs through the words of a knot node}
+begin q:=get_node(knot_node_size);
+for k:=0 to knot_node_size-1 do mem[q+k]:=mem[p+k];
+originator(q):=originator(p);
+copy_knot:=q;
+end;
+
+@ The |copy_path| routine makes a clone of a given path.
+
+@p function copy_path(@!p:pointer):pointer;
+var @!q,@!pp,@!qq:pointer; {for list manipulation}
+begin q:=copy_knot(p);
+qq:=q; pp:=link(p);
+while pp<>p do
+ begin link(qq):=copy_knot(pp);@/
+ qq:=link(qq);
+ pp:=link(pp);
+ end;
+link(qq):=q;
+copy_path:=q;
+end;
+
+@ Similarly, there's a way to copy the {\sl reverse\/} of a path. This procedure
+returns a pointer to the first node of the copy, if the path is a cycle,
+but to the final node of a non-cyclic copy. The global
+variable |path_tail| will point to the final node of the original path;
+this trick makes it easier to implement `\&{doublepath}'.
+
+All node types are assumed to be |endpoint| or |explicit| only.
+
+@p function htap_ypoc(@!p:pointer):pointer;
+label exit;
+var @!q,@!pp,@!qq,@!rr:pointer; {for list manipulation}
+begin q:=get_node(knot_node_size); {this will correspond to |p|}
+qq:=q; pp:=p;
+loop@+ begin right_type(qq):=left_type(pp); left_type(qq):=right_type(pp);@/
+ x_coord(qq):=x_coord(pp); y_coord(qq):=y_coord(pp);@/
+ right_x(qq):=left_x(pp); right_y(qq):=left_y(pp);@/
+ left_x(qq):=right_x(pp); left_y(qq):=right_y(pp);@/
+ originator(qq):=originator(pp);@/
+ if link(pp)=p then
+ begin link(q):=qq; path_tail:=pp; htap_ypoc:=q; return;
+ end;
+ rr:=get_node(knot_node_size); link(rr):=qq; qq:=rr; pp:=link(pp);
+ end;
+exit:end;
+
+@ @<Glob...@>=
+@!path_tail:pointer; {the node that links to the beginning of a path}
+
+@ When a cyclic list of knot nodes is no longer needed, it can be recycled by
+calling the following subroutine.
+
+@<Declare the recycling subroutines@>=
+procedure toss_knot_list(@!p:pointer);
+var @!q:pointer; {the node being freed}
+@!r:pointer; {the next node}
+begin q:=p;
+repeat r:=link(q); free_node(q,knot_node_size); q:=r;
+until q=p;
+end;
+
+@* \[18] Choosing control points.
+Now we must actually delve into one of \MP's more difficult routines,
+the |make_choices| procedure that chooses angles and control points for
+the splines of a curve when the user has not specified them explicitly.
+The parameter to |make_choices| points to a list of knots and
+path information, as described above.
+
+A path decomposes into independent segments at ``breakpoint'' knots,
+which are knots whose left and right angles are both prespecified in
+some way (i.e., their |left_type| and |right_type| aren't both open).
+
+@p @t\4@>@<Declare the procedure called |solve_choices|@>@;
+procedure make_choices(@!knots:pointer);
+label done;
+var @!h:pointer; {the first breakpoint}
+@!p,@!q:pointer; {consecutive breakpoints being processed}
+@<Other local variables for |make_choices|@>@;
+begin check_arith; {make sure that |arith_error=false|}
+if internal[tracing_choices]>0 then
+ print_path(knots,", before choices",true);
+@<If consecutive knots are equal, join them explicitly@>;
+@<Find the first breakpoint, |h|, on the path;
+ insert an artificial breakpoint if the path is an unbroken cycle@>;
+p:=h;
+repeat @<Fill in the control points between |p| and the next breakpoint,
+ then advance |p| to that breakpoint@>;
+until p=h;
+if internal[tracing_choices]>0 then
+ print_path(knots,", after choices",true);
+if arith_error then @<Report an unexpected problem during the choice-making@>;
+end;
+
+@ @<Report an unexpected problem during the choice...@>=
+begin print_err("Some number got too big");
+@.Some number got too big@>
+help2("The path that I just computed is out of range.")@/
+ ("So it will probably look funny. Proceed, for a laugh.");
+put_get_error; arith_error:=false;
+end
+
+@ Two knots in a row with the same coordinates will always be joined
+by an explicit ``curve'' whose control points are identical with the
+knots.
+
+@<If consecutive knots are equal, join them explicitly@>=
+p:=knots;
+repeat q:=link(p);
+if x_coord(p)=x_coord(q) then if y_coord(p)=y_coord(q) then
+ if right_type(p)>explicit then
+ begin right_type(p):=explicit;
+ if left_type(p)=open then
+ begin left_type(p):=curl; left_curl(p):=unity;
+ end;
+ left_type(q):=explicit;
+ if right_type(q)=open then
+ begin right_type(q):=curl; right_curl(q):=unity;
+ end;
+ right_x(p):=x_coord(p); left_x(q):=x_coord(p);@/
+ right_y(p):=y_coord(p); left_y(q):=y_coord(p);
+ end;
+p:=q;
+until p=knots
+
+@ If there are no breakpoints, it is necessary to compute the direction
+angles around an entire cycle. In this case the |left_type| of the first
+node is temporarily changed to |end_cycle|.
+
+@d end_cycle=open+1
+
+@<Find the first breakpoint, |h|, on the path...@>=
+h:=knots;
+loop@+ begin if left_type(h)<>open then goto done;
+ if right_type(h)<>open then goto done;
+ h:=link(h);
+ if h=knots then
+ begin left_type(h):=end_cycle; goto done;
+ end;
+ end;
+done:
+
+@ If |right_type(p)<given| and |q=link(p)|, we must have
+|right_type(p)=left_type(q)=explicit| or |endpoint|.
+
+@<Fill in the control points between |p| and the next breakpoint...@>=
+q:=link(p);
+if right_type(p)>=given then
+ begin while (left_type(q)=open)and(right_type(q)=open) do q:=link(q);
+ @<Fill in the control information between
+ consecutive breakpoints |p| and |q|@>;
+ end
+else if right_type(p)=endpoint then
+ @<Give reasonable values for the unused control points between |p| and~|q|@>;
+p:=q
+
+@ This step makes it possible to transform an explicitly computed path without
+checking the |left_type| and |right_type| fields.
+
+@<Give reasonable values for the unused control points between |p| and~|q|@>=
+begin right_x(p):=x_coord(p); right_y(p):=y_coord(p);@/
+left_x(q):=x_coord(q); left_y(q):=y_coord(q);
+end
+
+@ Before we can go further into the way choices are made, we need to
+consider the underlying theory. The basic ideas implemented in |make_choices|
+are due to John Hobby, who introduced the notion of ``mock curvature''
+@^Hobby, John Douglas@>
+at a knot. Angles are chosen so that they preserve mock curvature when
+a knot is passed, and this has been found to produce excellent results.
+
+It is convenient to introduce some notations that simplify the necessary
+formulas. Let $d_{k,k+1}=\vert z\k-z_k\vert$ be the (nonzero) distance
+between knots |k| and |k+1|; and let
+$${z\k-z_k\over z_k-z_{k-1}}={d_{k,k+1}\over d_{k-1,k}}e^{i\psi_k}$$
+so that a polygonal line from $z_{k-1}$ to $z_k$ to $z\k$ turns left
+through an angle of~$\psi_k$. We assume that $\vert\psi_k\vert\L180^\circ$.
+The control points for the spline from $z_k$ to $z\k$ will be denoted by
+$$\eqalign{z_k^+&=z_k+
+ \textstyle{1\over3}\rho_k e^{i\theta_k}(z\k-z_k),\cr
+ z\k^-&=z\k-
+ \textstyle{1\over3}\sigma\k e^{-i\phi\k}(z\k-z_k),\cr}$$
+where $\rho_k$ and $\sigma\k$ are nonnegative ``velocity ratios'' at the
+beginning and end of the curve, while $\theta_k$ and $\phi\k$ are the
+corresponding ``offset angles.'' These angles satisfy the condition
+$$\theta_k+\phi_k+\psi_k=0,\eqno(*)$$
+whenever the curve leaves an intermediate knot~|k| in the direction that
+it enters.
+
+@ Let $\alpha_k$ and $\beta\k$ be the reciprocals of the ``tension'' of
+the curve at its beginning and ending points. This means that
+$\rho_k=\alpha_k f(\theta_k,\phi\k)$ and $\sigma\k=\beta\k f(\phi\k,\theta_k)$,
+where $f(\theta,\phi)$ is \MP's standard velocity function defined in
+the |velocity| subroutine. The cubic spline $B(z_k^{\phantom+},z_k^+,
+z\k^-,z\k^{\phantom+};t)$
+has curvature
+@^curvature@>
+$${2\sigma\k\sin(\theta_k+\phi\k)-6\sin\theta_k\over\rho_k^2d_{k,k+1}}
+\qquad{\rm and}\qquad
+{2\rho_k\sin(\theta_k+\phi\k)-6\sin\phi\k\over\sigma\k^2d_{k,k+1}}$$
+at |t=0| and |t=1|, respectively. The mock curvature is the linear
+@^mock curvature@>
+approximation to this true curvature that arises in the limit for
+small $\theta_k$ and~$\phi\k$, if second-order terms are discarded.
+The standard velocity function satisfies
+$$f(\theta,\phi)=1+O(\theta^2+\theta\phi+\phi^2);$$
+hence the mock curvatures are respectively
+$${2\beta\k(\theta_k+\phi\k)-6\theta_k\over\alpha_k^2d_{k,k+1}}
+\qquad{\rm and}\qquad
+{2\alpha_k(\theta_k+\phi\k)-6\phi\k\over\beta\k^2d_{k,k+1}}.\eqno(**)$$
+
+@ The turning angles $\psi_k$ are given, and equation $(*)$ above
+determines $\phi_k$ when $\theta_k$ is known, so the task of
+angle selection is essentially to choose appropriate values for each
+$\theta_k$. When equation~$(*)$ is used to eliminate $\phi$~variables
+from $(**)$, we obtain a system of linear equations of the form
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+where
+$$A_k={\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
+\qquad B_k={3-\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
+\qquad C_k={3-\beta\k\over\alpha_k^2d_{k,k+1}},
+\qquad D_k={\beta\k\over\alpha_k^2d_{k,k+1}}.$$
+The tensions are always $3\over4$ or more, hence each $\alpha$ and~$\beta$
+will be at most $4\over3$. It follows that $B_k\G{5\over4}A_k$ and
+$C_k\G{5\over4}D_k$; hence the equations are diagonally dominant;
+hence they have a unique solution. Moreover, in most cases the tensions
+are equal to~1, so that $B_k=2A_k$ and $C_k=2D_k$. This makes the
+solution numerically stable, and there is an exponential damping
+effect: The data at knot $k\pm j$ affects the angle at knot~$k$ by
+a factor of~$O(2^{-j})$.
+
+@ However, we still must consider the angles at the starting and ending
+knots of a non-cyclic path. These angles might be given explicitly, or
+they might be specified implicitly in terms of an amount of ``curl.''
+
+Let's assume that angles need to be determined for a non-cyclic path
+starting at $z_0$ and ending at~$z_n$. Then equations of the form
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta_{k+1}=R_k$$
+have been given for $0<k<n$, and it will be convenient to introduce
+equations of the same form for $k=0$ and $k=n$, where
+$$A_0=B_0=C_n=D_n=0.$$
+If $\theta_0$ is supposed to have a given value $E_0$, we simply
+define $C_0=0$, $D_0=0$, and $R_0=E_0$. Otherwise a curl
+parameter, $\gamma_0$, has been specified at~$z_0$; this means
+that the mock curvature at $z_0$ should be $\gamma_0$ times the
+mock curvature at $z_1$; i.e.,
+$${2\beta_1(\theta_0+\phi_1)-6\theta_0\over\alpha_0^2d_{01}}
+=\gamma_0{2\alpha_0(\theta_0+\phi_1)-6\phi_1\over\beta_1^2d_{01}}.$$
+This equation simplifies to
+$$(\alpha_0\chi_0+3-\beta_1)\theta_0+
+ \bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\theta_1=
+ -\bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\psi_1,$$
+where $\chi_0=\alpha_0^2\gamma_0/\beta_1^2$; so we can set $C_0=
+\chi_0\alpha_0+3-\beta_1$, $D_0=(3-\alpha_0)\chi_0+\beta_1$, $R_0=-D_0\psi_1$.
+It can be shown that $C_0>0$ and $C_0B_1-A_1D_0>0$ when $\gamma_0\G0$,
+hence the linear equations remain nonsingular.
+
+Similar considerations apply at the right end, when the final angle $\phi_n$
+may or may not need to be determined. It is convenient to let $\psi_n=0$,
+hence $\theta_n=-\phi_n$. We either have an explicit equation $\theta_n=E_n$,
+or we have
+$$\bigl((3-\beta_n)\chi_n+\alpha_{n-1}\bigr)\theta_{n-1}+
+(\beta_n\chi_n+3-\alpha_{n-1})\theta_n=0,\qquad
+ \chi_n={\beta_n^2\gamma_n\over\alpha_{n-1}^2}.$$
+
+When |make_choices| chooses angles, it must compute the coefficients of
+these linear equations, then solve the equations. To compute the coefficients,
+it is necessary to compute arctangents of the given turning angles~$\psi_k$.
+When the equations are solved, the chosen directions $\theta_k$ are put
+back into the form of control points by essentially computing sines and
+cosines.
+
+@ OK, we are ready to make the hard choices of |make_choices|.
+Most of the work is relegated to an auxiliary procedure
+called |solve_choices|, which has been introduced to keep
+|make_choices| from being extremely long.
+
+@<Fill in the control information between...@>=
+@<Calculate the turning angles $\psi_k$ and the distances $d_{k,k+1}$;
+ set $n$ to the length of the path@>;
+@<Remove |open| types at the breakpoints@>;
+solve_choices(p,q,n)
+
+@ It's convenient to precompute quantities that will be needed several
+times later. The values of |delta_x[k]| and |delta_y[k]| will be the
+coordinates of $z\k-z_k$, and the magnitude of this vector will be
+|delta[k]=@t$d_{k,k+1}$@>|. The path angle $\psi_k$ between $z_k-z_{k-1}$
+and $z\k-z_k$ will be stored in |psi[k]|.
+
+@<Glob...@>=
+@!delta_x,@!delta_y,@!delta:array[0..path_size] of scaled; {knot differences}
+@!psi:array[1..path_size] of angle; {turning angles}
+
+@ @<Other local variables for |make_choices|@>=
+@!k,@!n:0..path_size; {current and final knot numbers}
+@!s,@!t:pointer; {registers for list traversal}
+@!delx,@!dely:scaled; {directions where |open| meets |explicit|}
+@!sine,@!cosine:fraction; {trig functions of various angles}
+
+@ @<Calculate the turning angles...@>=
+k:=0; s:=p; n:=path_size;
+repeat t:=link(s);
+delta_x[k]:=x_coord(t)-x_coord(s);
+delta_y[k]:=y_coord(t)-y_coord(s);
+delta[k]:=pyth_add(delta_x[k],delta_y[k]);
+if k>0 then
+ begin sine:=make_fraction(delta_y[k-1],delta[k-1]);
+ cosine:=make_fraction(delta_x[k-1],delta[k-1]);
+ psi[k]:=n_arg(take_fraction(delta_x[k],cosine)+
+ take_fraction(delta_y[k],sine),
+ take_fraction(delta_y[k],cosine)-
+ take_fraction(delta_x[k],sine));
+ end;
+@:MetaPost capacity exceeded path size}{\quad path size@>
+incr(k); s:=t;
+if k=path_size then overflow("path size",path_size);
+if s=q then n:=k;
+until (k>=n)and(left_type(s)<>end_cycle);
+if k=n then psi[n]:=0@+else psi[k]:=psi[1]
+
+@ When we get to this point of the code, |right_type(p)| is either
+|given| or |curl| or |open|. If it is |open|, we must have
+|left_type(p)=end_cycle| or |left_type(p)=explicit|. In the latter
+case, the |open| type is converted to |given|; however, if the
+velocity coming into this knot is zero, the |open| type is
+converted to a |curl|, since we don't know the incoming direction.
+
+Similarly, |left_type(q)| is either |given| or |curl| or |open| or
+|end_cycle|. The |open| possibility is reduced either to |given| or to |curl|.
+
+@<Remove |open| types at the breakpoints@>=
+if left_type(q)=open then
+ begin delx:=right_x(q)-x_coord(q); dely:=right_y(q)-y_coord(q);
+ if (delx=0)and(dely=0) then
+ begin left_type(q):=curl; left_curl(q):=unity;
+ end
+ else begin left_type(q):=given; left_given(q):=n_arg(delx,dely);
+ end;
+ end;
+if (right_type(p)=open)and(left_type(p)=explicit) then
+ begin delx:=x_coord(p)-left_x(p); dely:=y_coord(p)-left_y(p);
+ if (delx=0)and(dely=0) then
+ begin right_type(p):=curl; right_curl(p):=unity;
+ end
+ else begin right_type(p):=given; right_given(p):=n_arg(delx,dely);
+ end;
+ end
+
+@ Linear equations need to be solved whenever |n>1|; and also when |n=1|
+and exactly one of the breakpoints involves a curl. The simplest case occurs
+when |n=1| and there is a curl at both breakpoints; then we simply draw
+a straight line.
+
+But before coding up the simple cases, we might as well face the general case,
+since we must deal with it sooner or later, and since the general case
+is likely to give some insight into the way simple cases can be handled best.
+
+When there is no cycle, the linear equations to be solved form a tridiagonal
+system, and we can apply the standard technique of Gaussian elimination
+to convert that system to a sequence of equations of the form
+$$\theta_0+u_0\theta_1=v_0,\quad
+\theta_1+u_1\theta_2=v_1,\quad\ldots,\quad
+\theta_{n-1}+u_{n-1}\theta_n=v_{n-1},\quad
+\theta_n=v_n.$$
+It is possible to do this diagonalization while generating the equations.
+Once $\theta_n$ is known, it is easy to determine $\theta_{n-1}$, \dots,
+$\theta_1$, $\theta_0$; thus, the equations will be solved.
+
+The procedure is slightly more complex when there is a cycle, but the
+basic idea will be nearly the same. In the cyclic case the right-hand
+sides will be $v_k+w_k\theta_0$ instead of simply $v_k$, and we will start
+the process off with $u_0=v_0=0$, $w_0=1$. The final equation will be not
+$\theta_n=v_n$ but $\theta_n+u_n\theta_1=v_n+w_n\theta_0$; an appropriate
+ending routine will take account of the fact that $\theta_n=\theta_0$ and
+eliminate the $w$'s from the system, after which the solution can be
+obtained as before.
+
+When $u_k$, $v_k$, and $w_k$ are being computed, the three pointer
+variables |r|, |s|,~|t| will point respectively to knots |k-1|, |k|,
+and~|k+1|. The $u$'s and $w$'s are scaled by $2^{28}$, i.e., they are
+of type |fraction|; the $\theta$'s and $v$'s are of type |angle|.
+
+@<Glob...@>=
+@!theta:array[0..path_size] of angle; {values of $\theta_k$}
+@!uu:array[0..path_size] of fraction; {values of $u_k$}
+@!vv:array[0..path_size] of angle; {values of $v_k$}
+@!ww:array[0..path_size] of fraction; {values of $w_k$}
+
+@ Our immediate problem is to get the ball rolling by setting up the
+first equation or by realizing that no equations are needed, and to fit
+this initialization into a framework suitable for the overall computation.
+
+@<Declare the procedure called |solve_choices|@>=
+@t\4@>@<Declare subroutines needed by |solve_choices|@>@;
+procedure solve_choices(@!p,@!q:pointer;@!n:halfword);
+label found,exit;
+var @!k:0..path_size; {current knot number}
+@!r,@!s,@!t:pointer; {registers for list traversal}
+@<Other local variables for |solve_choices|@>@;
+begin k:=0; s:=p;
+loop@+ begin t:=link(s);
+ if k=0 then @<Get the linear equations started; or |return|
+ with the control points in place, if linear equations
+ needn't be solved@>
+ else case left_type(s) of
+ end_cycle,open:@<Set up equation to match mock curvatures
+ at $z_k$; then |goto found| with $\theta_n$
+ adjusted to equal $\theta_0$, if a cycle has ended@>;
+ curl:@<Set up equation for a curl at $\theta_n$
+ and |goto found|@>;
+ given:@<Calculate the given value of $\theta_n$
+ and |goto found|@>;
+ end; {there are no other cases}
+ r:=s; s:=t; incr(k);
+ end;
+found:@<Finish choosing angles and assigning control points@>;
+exit:end;
+
+@ On the first time through the loop, we have |k=0| and |r| is not yet
+defined. The first linear equation, if any, will have $A_0=B_0=0$.
+
+@<Get the linear equations started...@>=
+case right_type(s) of
+given: if left_type(t)=given then @<Reduce to simple case of two givens
+ and |return|@>
+ else @<Set up the equation for a given value of $\theta_0$@>;
+curl: if left_type(t)=curl then @<Reduce to simple case of straight line
+ and |return|@>
+ else @<Set up the equation for a curl at $\theta_0$@>;
+open: begin uu[0]:=0; vv[0]:=0; ww[0]:=fraction_one;
+ end; {this begins a cycle}
+end {there are no other cases}
+
+@ The general equation that specifies equality of mock curvature at $z_k$ is
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+as derived above. We want to combine this with the already-derived equation
+$\theta_{k-1}+u_{k-1}\theta_k=v_{k-1}+w_{k-1}\theta_0$ in order to obtain
+a new equation
+$\theta_k+u_k\theta\k=v_k+w_k\theta_0$. This can be done by dividing the
+equation
+$$(B_k-u_{k-1}A_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k-A_kv_{k-1}
+ -A_kw_{k-1}\theta_0$$
+by $B_k-u_{k-1}A_k+C_k$. The trick is to do this carefully with
+fixed-point arithmetic, avoiding the chance of overflow while retaining
+suitable precision.
+
+The calculations will be performed in several registers that
+provide temporary storage for intermediate quantities.
+
+@<Other local variables for |solve_choices|@>=
+@!aa,@!bb,@!cc,@!ff,@!acc:fraction; {temporary registers}
+@!dd,@!ee:scaled; {likewise, but |scaled|}
+@!lt,@!rt:scaled; {tension values}
+
+@ @<Set up equation to match mock curvatures...@>=
+begin @<Calculate the values $\\{aa}=A_k/B_k$, $\\{bb}=D_k/C_k$,
+ $\\{dd}=(3-\alpha_{k-1})d_{k,k+1}$, $\\{ee}=(3-\beta\k)d_{k-1,k}$,
+ and $\\{cc}=(B_k-u_{k-1}A_k)/B_k$@>;
+@<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>;
+uu[k]:=take_fraction(ff,bb);
+@<Calculate the values of $v_k$ and $w_k$@>;
+if left_type(s)=end_cycle then
+ @<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>;
+end
+
+@ Since tension values are never less than 3/4, the values |aa| and
+|bb| computed here are never more than 4/5.
+
+@<Calculate the values $\\{aa}=...@>=
+if abs(right_tension(r))=unity then
+ begin aa:=fraction_half; dd:=2*delta[k];
+ end
+else begin aa:=make_fraction(unity,3*abs(right_tension(r))-unity);
+ dd:=take_fraction(delta[k],
+ fraction_three-make_fraction(unity,abs(right_tension(r))));
+ end;
+if abs(left_tension(t))=unity then
+ begin bb:=fraction_half; ee:=2*delta[k-1];
+ end
+else begin bb:=make_fraction(unity,3*abs(left_tension(t))-unity);
+ ee:=take_fraction(delta[k-1],
+ fraction_three-make_fraction(unity,abs(left_tension(t))));
+ end;
+cc:=fraction_one-take_fraction(uu[k-1],aa)
+
+@ The ratio to be calculated in this step can be written in the form
+$$\beta_k^2\cdot\\{ee}\over\beta_k^2\cdot\\{ee}+\alpha_k^2\cdot
+ \\{cc}\cdot\\{dd},$$
+because of the quantities just calculated. The values of |dd| and |ee|
+will not be needed after this step has been performed.
+
+@<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>=
+dd:=take_fraction(dd,cc); lt:=abs(left_tension(s)); rt:=abs(right_tension(s));
+if lt<>rt then {$\beta_k^{-1}\ne\alpha_k^{-1}$}
+ if lt<rt then
+ begin ff:=make_fraction(lt,rt);
+ ff:=take_fraction(ff,ff); {$\alpha_k^2/\beta_k^2$}
+ dd:=take_fraction(dd,ff);
+ end
+ else begin ff:=make_fraction(rt,lt);
+ ff:=take_fraction(ff,ff); {$\beta_k^2/\alpha_k^2$}
+ ee:=take_fraction(ee,ff);
+ end;
+ff:=make_fraction(ee,ee+dd)
+
+@ The value of $u_{k-1}$ will be |<=1| except when $k=1$ and the previous
+equation was specified by a curl. In that case we must use a special
+method of computation to prevent overflow.
+
+Fortunately, the calculations turn out to be even simpler in this ``hard''
+case. The curl equation makes $w_0=0$ and $v_0=-u_0\psi_1$, hence
+$-B_1\psi_1-A_1v_0=-(B_1-u_0A_1)\psi_1=-\\{cc}\cdot B_1\psi_1$.
+
+@<Calculate the values of $v_k$ and $w_k$@>=
+acc:=-take_fraction(psi[k+1],uu[k]);
+if right_type(r)=curl then
+ begin ww[k]:=0;
+ vv[k]:=acc-take_fraction(psi[1],fraction_one-ff);
+ end
+else begin ff:=make_fraction(fraction_one-ff,cc); {this is
+ $B_k/(C_k+B_k-u_{k-1}A_k)<5$}
+ acc:=acc-take_fraction(psi[k],ff);
+ ff:=take_fraction(ff,aa); {this is $A_k/(C_k+B_k-u_{k-1}A_k)$}
+ vv[k]:=acc-take_fraction(vv[k-1],ff);
+ if ww[k-1]=0 then ww[k]:=0
+ else ww[k]:=-take_fraction(ww[k-1],ff);
+ end
+
+@ When a complete cycle has been traversed, we have $\theta_k+u_k\theta\k=
+v_k+w_k\theta_0$, for |1<=k<=n|. We would like to determine the value of
+$\theta_n$ and reduce the system to the form $\theta_k+u_k\theta\k=v_k$
+for |0<=k<n|, so that the cyclic case can be finished up just as if there
+were no cycle.
+
+The idea in the following code is to observe that
+$$\eqalign{\theta_n&=v_n+w_n\theta_0-u_n\theta_1=\cdots\cr
+&=v_n+w_n\theta_0-u_n\bigl(v_1+w_1\theta_0-u_1(v_2+\cdots
+ -u_{n-2}(v_{n-1}+w_{n-1}\theta_0-u_{n-1}\theta_0))\bigr),\cr}$$
+so we can solve for $\theta_n=\theta_0$.
+
+@<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>=
+begin aa:=0; bb:=fraction_one; {we have |k=n|}
+repeat decr(k);
+if k=0 then k:=n;
+aa:=vv[k]-take_fraction(aa,uu[k]);
+bb:=ww[k]-take_fraction(bb,uu[k]);
+until k=n; {now $\theta_n=\\{aa}+\\{bb}\cdot\theta_n$}
+aa:=make_fraction(aa,fraction_one-bb);
+theta[n]:=aa; vv[0]:=aa;
+for k:=1 to n-1 do vv[k]:=vv[k]+take_fraction(aa,ww[k]);
+goto found;
+end
+
+@ @d reduce_angle(#)==if abs(#)>one_eighty_deg then
+ if #>0 then #:=#-three_sixty_deg@+else #:=#+three_sixty_deg
+
+@<Calculate the given value of $\theta_n$...@>=
+begin theta[n]:=left_given(s)-n_arg(delta_x[n-1],delta_y[n-1]);
+reduce_angle(theta[n]);
+goto found;
+end
+
+@ @<Set up the equation for a given value of $\theta_0$@>=
+begin vv[0]:=right_given(s)-n_arg(delta_x[0],delta_y[0]);
+reduce_angle(vv[0]);
+uu[0]:=0; ww[0]:=0;
+end
+
+@ @<Set up the equation for a curl at $\theta_0$@>=
+begin cc:=right_curl(s); lt:=abs(left_tension(t)); rt:=abs(right_tension(s));
+if (rt=unity)and(lt=unity) then
+ uu[0]:=make_fraction(cc+cc+unity,cc+two)
+else uu[0]:=curl_ratio(cc,rt,lt);
+vv[0]:=-take_fraction(psi[1],uu[0]); ww[0]:=0;
+end
+
+@ @<Set up equation for a curl at $\theta_n$...@>=
+begin cc:=left_curl(s); lt:=abs(left_tension(s)); rt:=abs(right_tension(r));
+if (rt=unity)and(lt=unity) then
+ ff:=make_fraction(cc+cc+unity,cc+two)
+else ff:=curl_ratio(cc,lt,rt);
+theta[n]:=-make_fraction(take_fraction(vv[n-1],ff),
+ fraction_one-take_fraction(ff,uu[n-1]));
+goto found;
+end
+
+@ The |curl_ratio| subroutine has three arguments, which our previous notation
+encourages us to call $\gamma$, $\alpha^{-1}$, and $\beta^{-1}$. It is
+a somewhat tedious program to calculate
+$${(3-\alpha)\alpha^2\gamma+\beta^3\over
+ \alpha^3\gamma+(3-\beta)\beta^2},$$
+with the result reduced to 4 if it exceeds 4. (This reduction of curl
+is necessary only if the curl and tension are both large.)
+The values of $\alpha$ and $\beta$ will be at most~4/3.
+
+@<Declare subroutines needed by |solve_choices|@>=
+function curl_ratio(@!gamma,@!a_tension,@!b_tension:scaled):fraction;
+var @!alpha,@!beta,@!num,@!denom,@!ff:fraction; {registers}
+begin alpha:=make_fraction(unity,a_tension);
+beta:=make_fraction(unity,b_tension);@/
+if alpha<=beta then
+ begin ff:=make_fraction(alpha,beta); ff:=take_fraction(ff,ff);
+ gamma:=take_fraction(gamma,ff);@/
+ beta:=beta div @'10000; {convert |fraction| to |scaled|}
+ denom:=take_fraction(gamma,alpha)+three-beta;
+ num:=take_fraction(gamma,fraction_three-alpha)+beta;
+ end
+else begin ff:=make_fraction(beta,alpha); ff:=take_fraction(ff,ff);
+ beta:=take_fraction(beta,ff) div @'10000; {convert |fraction| to |scaled|}
+ denom:=take_fraction(gamma,alpha)+(ff div 1365)-beta;
+ {$1365\approx 2^{12}/3$}
+ num:=take_fraction(gamma,fraction_three-alpha)+beta;
+ end;
+if num>=denom+denom+denom+denom then curl_ratio:=fraction_four
+else curl_ratio:=make_fraction(num,denom);
+end;
+
+@ We're in the home stretch now.
+
+@<Finish choosing angles and assigning control points@>=
+for k:=n-1 downto 0 do theta[k]:=vv[k]-take_fraction(theta[k+1],uu[k]);
+s:=p; k:=0;
+repeat t:=link(s);@/
+n_sin_cos(theta[k]); st:=n_sin; ct:=n_cos;@/
+n_sin_cos(-psi[k+1]-theta[k+1]); sf:=n_sin; cf:=n_cos;@/
+set_controls(s,t,k);@/
+incr(k); s:=t;
+until k=n
+
+@ The |set_controls| routine actually puts the control points into
+a pair of consecutive nodes |p| and~|q|. Global variables are used to
+record the values of $\sin\theta$, $\cos\theta$, $\sin\phi$, and
+$\cos\phi$ needed in this calculation.
+
+@<Glob...@>=
+@!st,@!ct,@!sf,@!cf:fraction; {sines and cosines}
+
+@ @<Declare subroutines needed by |solve_choices|@>=
+procedure set_controls(@!p,@!q:pointer;@!k:integer);
+var @!rr,@!ss:fraction; {velocities, divided by thrice the tension}
+@!lt,@!rt:scaled; {tensions}
+@!sine:fraction; {$\sin(\theta+\phi)$}
+begin lt:=abs(left_tension(q)); rt:=abs(right_tension(p));
+rr:=velocity(st,ct,sf,cf,rt);
+ss:=velocity(sf,cf,st,ct,lt);
+if (right_tension(p)<0)or(left_tension(q)<0) then @<Decrease the velocities,
+ if necessary, to stay inside the bounding triangle@>;
+right_x(p):=x_coord(p)+take_fraction(
+ take_fraction(delta_x[k],ct)-take_fraction(delta_y[k],st),rr);
+right_y(p):=y_coord(p)+take_fraction(
+ take_fraction(delta_y[k],ct)+take_fraction(delta_x[k],st),rr);
+left_x(q):=x_coord(q)-take_fraction(
+ take_fraction(delta_x[k],cf)+take_fraction(delta_y[k],sf),ss);
+left_y(q):=y_coord(q)-take_fraction(
+ take_fraction(delta_y[k],cf)-take_fraction(delta_x[k],sf),ss);
+right_type(p):=explicit; left_type(q):=explicit;
+end;
+
+@ The boundedness conditions $\\{rr}\L\sin\phi\,/\sin(\theta+\phi)$ and
+$\\{ss}\L\sin\theta\,/\sin(\theta+\phi)$ are to be enforced if $\sin\theta$,
+$\sin\phi$, and $\sin(\theta+\phi)$ all have the same sign. Otherwise
+there is no ``bounding triangle.''
+@!@:at_least_}{\&{atleast} primitive@>
+
+@<Decrease the velocities, if necessary...@>=
+if((st>=0)and(sf>=0))or((st<=0)and(sf<=0)) then
+ begin sine:=take_fraction(abs(st),cf)+take_fraction(abs(sf),ct);
+ if sine>0 then
+ begin sine:=take_fraction(sine,fraction_one+unity); {safety factor}
+ if right_tension(p)<0 then
+ if ab_vs_cd(abs(sf),fraction_one,rr,sine)<0 then
+ rr:=make_fraction(abs(sf),sine);
+ if left_tension(q)<0 then
+ if ab_vs_cd(abs(st),fraction_one,ss,sine)<0 then
+ ss:=make_fraction(abs(st),sine);
+ end;
+ end
+
+@ Only the simple cases remain to be handled.
+
+@<Reduce to simple case of two givens and |return|@>=
+begin aa:=n_arg(delta_x[0],delta_y[0]);@/
+n_sin_cos(right_given(p)-aa); ct:=n_cos; st:=n_sin;@/
+n_sin_cos(left_given(q)-aa); cf:=n_cos; sf:=-n_sin;@/
+set_controls(p,q,0); return;
+end
+
+@ @<Reduce to simple case of straight line and |return|@>=
+begin right_type(p):=explicit; left_type(q):=explicit;
+lt:=abs(left_tension(q)); rt:=abs(right_tension(p));
+if rt=unity then
+ begin if delta_x[0]>=0 then right_x(p):=x_coord(p)+((delta_x[0]+1) div 3)
+ else right_x(p):=x_coord(p)+((delta_x[0]-1) div 3);
+ if delta_y[0]>=0 then right_y(p):=y_coord(p)+((delta_y[0]+1) div 3)
+ else right_y(p):=y_coord(p)+((delta_y[0]-1) div 3);
+ end
+else begin ff:=make_fraction(unity,3*rt); {$\alpha/3$}
+ right_x(p):=x_coord(p)+take_fraction(delta_x[0],ff);
+ right_y(p):=y_coord(p)+take_fraction(delta_y[0],ff);
+ end;
+if lt=unity then
+ begin if delta_x[0]>=0 then left_x(q):=x_coord(q)-((delta_x[0]+1) div 3)
+ else left_x(q):=x_coord(q)-((delta_x[0]-1) div 3);
+ if delta_y[0]>=0 then left_y(q):=y_coord(q)-((delta_y[0]+1) div 3)
+ else left_y(q):=y_coord(q)-((delta_y[0]-1) div 3);
+ end
+else begin ff:=make_fraction(unity,3*lt); {$\beta/3$}
+ left_x(q):=x_coord(q)-take_fraction(delta_x[0],ff);
+ left_y(q):=y_coord(q)-take_fraction(delta_y[0],ff);
+ end;
+return;
+end
+
+@* \[19] Measuring paths.
+\MP's \&{llcorner}, \&{lrcorner}, \&{ulcorner}, and \&{urcorner} operators
+allow the user to measure the bounding box of anything that can go into a
+picture. It's easy to get rough bounds on the $x$ and $y$ extent of a path
+by just finding the bounding box of the knots and the control points. We
+need a more accurate version of the bounding box, but we can still use the
+easy estimate to save time by focusing on the interesting parts of the path.
+
+@ Computing an accurate bounding box involves a theme that will come up again
+and again. Given a Bernshte{\u\i}n polynomial
+@^Bernshte{\u\i}n, Serge{\u\i} Natanovich@>
+$$B(z_0,z_1,\ldots,z_n;t)=\sum_k{n\choose k}t^k(1-t)^{n-k}z_k,$$
+we can conveniently bisect its range as follows:
+
+\smallskip
+\textindent{1)} Let $z_k^{(0)}=z_k$, for |0<=k<=n|.
+
+\smallskip
+\textindent{2)} Let $z_k^{(j+1)}={1\over2}(z_k^{(j)}+z\k^{(j)})$, for
+|0<=k<n-j|, for |0<=j<n|.
+
+\smallskip\noindent
+Then
+$$B(z_0,z_1,\ldots,z_n;t)=B(z_0^{(0)},z_0^{(1)},\ldots,z_0^{(n)};2t)
+ =B(z_0^{(n)},z_1^{(n-1)},\ldots,z_n^{(0)};2t-1).$$
+This formula gives us the coefficients of polynomials to use over the ranges
+$0\L t\L{1\over2}$ and ${1\over2}\L t\L1$.
+
+@ Now here's a subroutine that's handy for all sorts of path computations:
+Given a quadratic polynomial $B(a,b,c;t)$, the |crossing_point| function
+returns the unique |fraction| value |t| between 0 and~1 at which
+$B(a,b,c;t)$ changes from positive to negative, or returns
+|t=fraction_one+1| if no such value exists. If |a<0| (so that $B(a,b,c;t)$
+is already negative at |t=0|), |crossing_point| returns the value zero.
+
+@d no_crossing==begin crossing_point:=fraction_one+1; return;
+ end
+@d one_crossing==begin crossing_point:=fraction_one; return;
+ end
+@d zero_crossing==begin crossing_point:=0; return;
+ end
+
+@p function crossing_point(@!a,@!b,@!c:integer):fraction;
+label exit;
+var @!d:integer; {recursive counter}
+@!x,@!xx,@!x0,@!x1,@!x2:integer; {temporary registers for bisection}
+begin if a<0 then zero_crossing;
+if c>=0 then
+ begin if b>=0 then
+ if c>0 then no_crossing
+ else if (a=0)and(b=0) then no_crossing
+ else one_crossing;
+ if a=0 then zero_crossing;
+ end
+else if a=0 then if b<=0 then zero_crossing;
+@<Use bisection to find the crossing point, if one exists@>;
+exit:end;
+
+@ The general bisection method is quite simple when $n=2$, hence
+|crossing_point| does not take much time. At each stage in the
+recursion we have a subinterval defined by |l| and~|j| such that
+$B(a,b,c;2^{-l}(j+t))=B(x_0,x_1,x_2;t)$, and we want to ``zero in'' on
+the subinterval where $x_0\G0$ and $\min(x_1,x_2)<0$.
+
+It is convenient for purposes of calculation to combine the values
+of |l| and~|j| in a single variable $d=2^l+j$, because the operation
+of bisection then corresponds simply to doubling $d$ and possibly
+adding~1. Furthermore it proves to be convenient to modify
+our previous conventions for bisection slightly, maintaining the
+variables $X_0=2^lx_0$, $X_1=2^l(x_0-x_1)$, and $X_2=2^l(x_1-x_2)$.
+With these variables the conditions $x_0\ge0$ and $\min(x_1,x_2)<0$ are
+equivalent to $\max(X_1,X_1+X_2)>X_0\ge0$.
+
+The following code maintains the invariant relations
+$0\L|x0|<\max(|x1|,|x1|+|x2|)$,
+$\vert|x1|\vert<2^{30}$, $\vert|x2|\vert<2^{30}$;
+it has been constructed in such a way that no arithmetic overflow
+will occur if the inputs satisfy
+$a<2^{30}$, $\vert a-b\vert<2^{30}$, and $\vert b-c\vert<2^{30}$.
+
+@<Use bisection to find the crossing point...@>=
+d:=1; x0:=a; x1:=a-b; x2:=b-c;
+repeat x:=half(x1+x2);
+if x1-x0>x0 then
+ begin x2:=x; double(x0); double(d);
+ end
+else begin xx:=x1+x-x0;
+ if xx>x0 then
+ begin x2:=x; double(x0); double(d);
+ end
+ else begin x0:=x0-xx;
+ if x<=x0 then if x+x2<=x0 then no_crossing;
+ x1:=x; d:=d+d+1;
+ end;
+ end;
+until d>=fraction_one;
+crossing_point:=d-fraction_one
+
+@ Here is a routine that computes the $x$ or $y$ coordinate of the point on
+a cubic corresponding to the |fraction| value~|t|.
+
+It is convenient to define a \.{WEB} macro |t_of_the_way| such that
+|t_of_the_way(a)(b)| expands to |a-(a-b)*t|, i.e., to |t[a,b]|.
+
+@d t_of_the_way_end(#)==#,t@=)@>
+@d t_of_the_way(#)==#-take_fraction@=(@>#-t_of_the_way_end
+
+@p function eval_cubic(@!p,@!q:pointer;t:fraction):scaled;
+var @!x1,@!x2,@!x3:scaled; {intermediate values}
+begin x1:=t_of_the_way(knot_coord(p))(right_coord(p));
+x2:=t_of_the_way(right_coord(p))(left_coord(q));
+x3:=t_of_the_way(left_coord(q))(knot_coord(q));@/
+x1:=t_of_the_way(x1)(x2);
+x2:=t_of_the_way(x2)(x3);
+eval_cubic:=t_of_the_way(x1)(x2);
+end;
+
+@ The actual bounding box information is stored in global variables.
+Since it is convenient to address the $x$ and $y$ information
+separately, we define arrays indexed by |x_code..y_code| and use
+macros to give them more convenient names.
+
+@d x_code=0 {index for |minx| and |maxx|}
+@d y_code=1 {index for |miny| and |maxy|}
+@d minx==bbmin[x_code]
+@d maxx==bbmax[x_code]
+@d miny==bbmin[y_code]
+@d maxy==bbmax[y_code]
+
+@<Glob...@>=
+@!bbmin,@!bbmax:array[x_code..y_code] of scaled;
+ {the result of procedures that compute bounding box information}
+
+@ Now we're ready for the key part of the bounding box computation.
+The |bound_cubic| procedure updates |bbmin[c]| and |bbmax[c]| based on
+$$B(\hbox{|knot_coord(p)|}, \hbox{|right_coord(p)|},
+ \hbox{|left_coord(q)|}, \hbox{|knot_coord(q)|};t)
+$$
+for $0<t\le1$. In other words, the procedure adjusts the bounds to
+accommodate |knot_coord(q)| and any extremes over the range $0<t<1$.
+The |c| parameter is |x_code| or |y_code|.
+
+@p procedure bound_cubic(@!p,@!q:pointer;c:small_number);
+var @!wavy:boolean; {whether we need to look for extremes}
+@!del1,@!del2,@!del3,@!del,@!dmax:scaled; {proportional to the control
+ points of a quadratic derived from a cubic}
+@!t,@!tt:fraction; {where a quadratic crosses zero}
+@!x:scaled; {a value that |bbmin[c]| and |bbmax[c]| must accommodate}
+begin x:=knot_coord(q);
+@<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>;
+@<Check the control points against the bounding box and set |wavy:=true|
+ if any of them lie outside@>;
+if wavy then
+ begin del1:=right_coord(p)-knot_coord(p);
+ del2:=left_coord(q)-right_coord(p);
+ del3:=knot_coord(q)-left_coord(q);
+ @<Scale up |del1|, |del2|, and |del3| for greater accuracy;
+ also set |del| to the first nonzero element of |(del1,del2,del3)|@>;
+ if del<0 then
+ begin negate(del1); negate(del2); negate(del3);
+ end;
+ t:=crossing_point(del1,del2,del3);
+ if t<fraction_one then
+ @<Test the extremes of the cubic against the bounding box@>;
+ end;
+end;
+
+@ @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>=
+if x<bbmin[c] then bbmin[c]:=x;
+if x>bbmax[c] then bbmax[c]:=x
+
+@ @<Check the control points against the bounding box and set...@>=
+wavy:=true;
+if bbmin[c]<=right_coord(p) then
+ if right_coord(p)<=bbmax[c] then
+ if bbmin[c]<=left_coord(q) then
+ if left_coord(q)<=bbmax[c] then
+ wavy:=false
+
+@ If |del1=del2=del3=0|, it's impossible to obey the title of this
+section. We just set |del=0| in that case.
+
+@<Scale up |del1|, |del2|, and |del3| for greater accuracy...@>=
+if del1<>0 then del:=del1
+else if del2<>0 then del:=del2
+else del:=del3;
+if del<>0 then
+ begin dmax:=abs(del1);
+ if abs(del2)>dmax then dmax:=abs(del2);
+ if abs(del3)>dmax then dmax:=abs(del3);
+ while dmax<fraction_half do
+ begin double(dmax); double(del1); double(del2); double(del3);
+ end;
+ end
+
+@ Since |crossing_point| has tried to choose |t| so that
+$B(|del1|,|del2|,|del3|;\tau)$ crosses zero at $\tau=|t|$ with negative
+slope, the value of |del2| computed below should not be positive.
+But rounding error could make it slightly positive in which case we
+must cut it to zero to avoid confusion.
+
+@<Test the extremes of the cubic against the bounding box@>=
+begin x:=eval_cubic(p,q,t);
+@<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>;
+del2:=t_of_the_way(del2)(del3);
+ {now |0,del2,del3| represent the derivative on the remaining interval}
+if del2>0 then del2:=0;
+tt:=crossing_point(0,-del2,-del3);
+if tt<fraction_one then
+ @<Test the second extreme against the bounding box@>;
+end
+
+@ @<Test the second extreme against the bounding box@>=
+begin x:=eval_cubic(p,q,t_of_the_way(tt)(fraction_one));
+@<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>;
+end
+
+@ Finding the bounding box of a path is basically a matter of applying
+|bound_cubic| twice for each pair of adjacent knots.
+
+@p procedure path_bbox(@!h:pointer);
+label exit;
+var @!p,@!q:pointer; {a pair of adjacent knots}
+begin minx:=x_coord(h); miny:=y_coord(h);
+maxx:=minx; maxy:=miny;@/
+p:=h;
+repeat if right_type(p)=endpoint then return;
+q:=link(p);@/
+bound_cubic(x_loc(p),x_loc(q),x_code);
+bound_cubic(y_loc(p),y_loc(q),y_code);
+p:=q;
+until p=h;
+exit:end;
+
+@ Another important way to measure a path is to find its arc length. This
+is best done by using the general bisection algorithm to subdivide the path
+until obtaining ``well behaved'' subpaths whose arc lengths can be approximated
+by simple means.
+
+Since the arc length is the integral with respect to time of the magnitude of
+the velocity, it is natural to use Simpson's rule for the approximation.
+@^Simpson's rule@>
+If $\dot B(t)$ is the spline velocity, Simpson's rule gives
+$$ \vb\dot B(0)\vb + 4\vb\dot B({1\over2})\vb + \vb\dot B(1)\vb \over 6 $$
+for the arc length of a path of length~1. For a cubic spline
+$B(z_0,z_1,z_2,z_3;t)$, the time derivative $\dot B(t)$ is
+$3B(dz_0,dz_1,dz_2;t)$, where $dz_i=z_{i+1}-z_i$. Hence the arc length
+approximation is
+$$ {\vb dz_0\vb \over 2} + 2\vb dz_{02}\vb + {\vb dz_2\vb \over 2}, $$
+where
+$$ dz_{02}={1\over2}\left({dz_0+dz_1\over 2}+{dz_1+dz_2\over 2}\right)$$
+is the result of the bisection algorithm.
+
+@ The remaining problem is how to decide when a subpath is ``well behaved.''
+This could be done via the theoretical error bound for Simpson's rule,
+@^Simpson's rule@>
+but this is impractical because it requires an estimate of the fourth
+derivative of the quantity being integrated. It is much easier to just perform
+a bisection step and see how much the arc length estimate changes. Since the
+error for Simpson's rule is proportional to the fourth power of the sample
+spacing, the remaining error is typically about $1\over16$ of the amount of
+the change. We say ``typically'' because the error has a pseudo-random behavior
+that could cause the two estimates to agree when each contain large errors.
+
+To protect against disasters such as undetected cusps, the bisection process
+should always continue until all the $dz_i$ vectors belong to a single
+$90^\circ$ sector. This ensures that no point on the spline can have velocity
+less than 70\% of the minimum of $\vb dz_0\vb$, $\vb dz_1\vb$ and $\vb dz_2\vb$.
+If such a spline happens to produce an erroneous arc length estimate that
+is little changed by bisection, the amount of the error is likely to be fairly
+small. We will try to arrange things so that freak accidents of this type do
+not destroy the inverse relationship between the \&{arclength} and
+\&{arctime} operations.
+@:arclength_}{\&{arclength} primitive@>
+@:arctime_}{\&{arctime} primitive@>
+
+@ The \&{arclength} and \&{arctime} operations are both based on a recursive
+@^recursion@>
+function that finds the arc length of a cubic spline given $dz_0$, $dz_1$,
+$dz_2$. This |arc_test| routine also takes an arc length goal |a_goal| and
+returns the time when the arc length reaches |a_goal| if there is such a time.
+Thus the return value is either an arc length less than |a_goal| or, if the
+arc length would be at least |a_goal|, it returns a time value decreased by
+|two|. This allows the caller to use the sign of the result to distinguish
+between arc lengths and time values. On certain types of overflow, it is
+possible for |a_goal| and the result of |arc_test| both to be |el_gordo|.
+Otherwise, the result is always less than |a_goal|.
+
+Rather than halving the control point coordinates on each recursive call to
+|arc_test|, it is better to keep them proportional to velocity on the original
+curve and halve the results instead. This means that recursive calls can
+potentially use larger error tolerances in their arc length estimates. How
+much larger depends on to what extent the errors behave as though they are
+independent of each other. To save computing time, we use optimistic assumptions
+and increase the tolerance by a factor of about $\sqrt2$ for each recursive
+call.
+
+In addition to the tolerance parameter, |arc_test| should also have parameters
+for ${1\over3}\vb\dot B(0)\vb$, ${2\over3}\vb\dot B({1\over2})\vb$, and
+${1\over3}\vb\dot B(1)\vb$. These quantities are relatively expensive to compute
+and they are needed in different instances of |arc_test|.
+
+@p @t\4@>@<Declare subroutines needed by |arc_test|@>@;
+function arc_test(@!dx0, @!dy0, @!dx1, @!dy1, @!dx2, @!dy2,
+ @!v0, @!v02, @!v2, @!a_goal, @!tol:scaled): scaled;
+label exit;
+var simple: boolean; {are the control points confined to a $90^\circ$ sector?}
+@!dx01, @!dy01, @!dx12, @!dy12, @!dx02, @!dy02: scaled; {bisection results}
+@!v002, @!v022: scaled;
+ {twice the velocity magnitudes at $t={1\over4}$ and $t={3\over4}$}
+@!arc: scaled; {best arc length estimate before recursion}
+@<Other local variables in |arc_test|@>@;
+begin @<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|,
+ |dx2|, |dy2|@>;
+@<Initialize |v002|, |v022|, and the arc length estimate |arc|; if it overflows
+ set |arc_test| and |return|@>;
+@<Test if the control points are confined to one quadrant or rotating them
+ $45^\circ$ would put them in one quadrant. Then set |simple| appropriately@>;
+if simple and (abs(arc-v02-halfp(v0+v2)) <= tol) then
+ if arc < a_goal then @+arc_test := arc
+ else @<Estimate when the arc length reaches |a_goal| and set |arc_test| to
+ that time minus |two|@>
+else @<Use one or two recursive calls to compute the |arc_test| function@>;
+exit:end;
+
+@ The |tol| value should by multiplied by $\sqrt 2$ before making recursive
+calls, but $1.5$ is an adequate approximation. It is best to avoid using
+|make_fraction| in this inner loop.
+@^inner loop@>
+
+@<Use one or two recursive calls to compute the |arc_test| function@>=
+begin @<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is as
+ large as possible@>;
+tol := tol + halfp(tol);
+a := arc_test(dx0,dy0, dx01,dy01, dx02,dy02, v0, v002, halfp(v02), a_new, tol);
+if a<0 then @+arc_test := -halfp(two-a)
+else begin @<Update |a_new| to reduce |a_new+a_aux| by |a|@>;
+ b := arc_test(dx02,dy02, dx12,dy12, dx2,dy2,
+ halfp(v02), v022, v2, a_new, tol);
+ if b<0 then @+arc_test := -halfp(-b) - half_unit
+ else arc_test := a + half(b-a);
+ end;
+end
+
+@ @<Other local variables in |arc_test|@>=
+@!a, @!b: scaled; {results of recursive calls}
+@!a_new, @!a_aux: scaled; {the sum of these gives the |a_goal|}
+
+@ @<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is...@>=
+a_aux := el_gordo - a_goal;
+if a_goal > a_aux then
+ begin a_aux := a_goal - a_aux;
+ a_new := el_gordo;
+ end
+else begin a_new := a_goal + a_goal;
+ a_aux := 0;
+ end
+
+@ There is no need to maintain |a_aux| at this point so we use it as a temporary
+to force the additions and subtractions to be done in an order that avoids
+overflow.
+
+@<Update |a_new| to reduce |a_new+a_aux| by |a|@>=
+if a > a_aux then
+ begin a_aux := a_aux - a;
+ a_new := a_new + a_aux;
+ end
+
+@ This code assumes all {\it dx} and {\it dy} variables have magnitude less than
+|fraction_four|. To simplify the rest of the |arc_test| routine, we strengthen
+this assumption by requiring the norm of each $({\it dx},{\it dy})$ pair to obey
+this bound. Note that recursive calls will maintain this invariant.
+
+@<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|,...@>=
+dx01 := half(dx0 + dx1);
+dx12 := half(dx1 + dx2);
+dx02 := half(dx01 + dx12);@/
+dy01 := half(dy0 + dy1);
+dy12 := half(dy1 + dy2);
+dy02 := half(dy01 + dy12)
+
+@ We should be careful to keep |arc<el_gordo| so that calling |arc_test| with
+|a_goal=el_gordo| is guaranteed to yield the arc length.
+
+@<Initialize |v002|, |v022|, and the arc length estimate |arc|;...@>=
+v002 := pyth_add(dx01+half(dx0+dx02), dy01+half(dy0+dy02));
+v022 := pyth_add(dx12+half(dx02+dx2), dy12+half(dy02+dy2));
+tmp := halfp(v02+2);
+arc1 := v002 + half(halfp(v0+tmp) - v002);
+arc := v022 + half(halfp(v2+tmp) - v022);
+if (arc < el_gordo-arc1) then @+arc := arc+arc1
+else begin arith_error := true;
+ if a_goal=el_gordo then @+arc_test := el_gordo
+ else arc_test := -two;
+ return;
+ end
+
+@ @<Other local variables in |arc_test|@>=
+tmp, tmp2: scaled; {all purpose temporary registers}
+arc1: scaled; {arc length estimate for the first half}
+
+@ @<Test if the control points are confined to one quadrant or rotating...@>=
+simple := (dx0>=0) and (dx1>=0) and (dx2>=0) or@|
+ (dx0<=0) and (dx1<=0) and (dx2<=0);
+if simple then
+ simple := (dy0>=0) and (dy1>=0) and (dy2>=0) or@|
+ (dy0<=0) and (dy1<=0) and (dy2<=0);
+if not simple then
+ begin simple := (dx0>=dy0) and (dx1>=dy1) and (dx2>=dy2) or@|
+ (dx0<=dy0) and (dx1<=dy1) and (dx2<=dy2);
+ if simple then
+ simple := (-dx0>=dy0) and (-dx1>=dy1) and (-dx2>=dy2) or@|
+ (-dx0<=dy0) and (-dx1<=dy1) and (-dx2<=dy2);
+ end
+
+@ Since Simpson's rule is based on approximating the integrand by a parabola,
+@^Simpson's rule@>
+it is appropriate to use the same approximation to decide when the integral
+reaches the intermediate value |a_goal|. At this point
+$$\eqalign{
+ {\vb\dot B(0)\vb\over 3} &= \hbox{|v0|}, \qquad
+ {\vb\dot B({1\over4})\vb\over 3} = {\hbox{|v002|}\over 2}, \qquad
+ {\vb\dot B({1\over2})\vb\over 3} = {\hbox{|v02|}\over 2}, \cr
+ {\vb\dot B({3\over4})\vb\over 3} &= {\hbox{|v022|}\over 2}, \qquad
+ {\vb\dot B(1)\vb\over 3} = \hbox{|v2|} \cr
+}
+$$
+and
+$$ {\vb\dot B(t)\vb\over 3} \approx
+ \cases{B\left(\hbox{|v0|},
+ \hbox{|v002|}-{1\over 2}\hbox{|v0|}-{1\over 4}\hbox{|v02|},
+ {1\over 2}\hbox{|v02|}; 2t \right)&
+ if $t\le{1\over 2}$\cr
+ B\left({1\over 2}\hbox{|v02|},
+ \hbox{|v022|}-{1\over 4}\hbox{|v02|}-{1\over 2}\hbox{|v2|},
+ \hbox{|v2|}; 2t-1 \right)&
+ if $t\ge{1\over 2}$.\cr}
+ \eqno (*)
+$$
+We can integrate $\vb\dot B(t)\vb$ by using
+$$\int 3B(a,b,c;\tau)\,dt =
+ {B(0,a,a+b,a+b+c;\tau) + {\rm constant} \over {d\tau\over dt}}.
+$$
+
+This construction allows us to find the time when the arc length reaches
+|a_goal| by solving a cubic equation of the form
+$$ B(0,a,a+b,a+b+c;\tau) = x, $$
+where $\tau$ is $2t$ or $2t+1$, $x$ is |a_goal| or |a_goal-arc1|, and $a$, $b$,
+and $c$ are the Bernshte{\u\i}n coefficients from $(*)$ divided by
+@^Bernshte{\u\i}n, Serge{\u\i} Natanovich@>
+$d\tau\over dt$. We shall define a function |solve_rising_cubic| that finds
+$\tau$ given $a$, $b$, $c$, and $x$.
+
+@<Estimate when the arc length reaches |a_goal| and set |arc_test| to...@>=
+begin tmp := (v02 + 2) div 4;
+if a_goal<=arc1 then
+ begin tmp2 := halfp(v0);
+ arc_test := halfp(solve_rising_cubic(tmp2, arc1-tmp2-tmp, tmp, a_goal))
+ - two;
+ end
+else begin tmp2 := halfp(v2);
+ arc_test := (half_unit - two) +@|
+ halfp(solve_rising_cubic(tmp, arc-arc1-tmp-tmp2, tmp2, a_goal-arc1));
+ end;
+end
+
+@ Here is the |solve_rising_cubic| routine that finds the time~$t$ when
+$$ B(0, a, a+b, a+b+c; t) = x. $$
+This routine is based on |crossing_point| but is simplified by the
+assumptions that $B(a,b,c;t)\ge0$ for $0\le t\le1$ and that |0<=x<=a+b+c|.
+If rounding error causes this condition to be violated slightly, we just ignore
+it and proceed with binary search. This finds a time when the function value
+reaches |x| and the slope is positive.
+
+@<Declare subroutines needed by |arc_test|@>=
+function solve_rising_cubic(@!a, @!b, @!c, @!x: scaled): scaled;
+var @!ab, @!bc, @!ac: scaled; {bisection results}
+@!t: integer; {$2^k+q$ where unscaled answer is in $[q2^{-k},(q+1)2^{-k})$}
+@!xx: integer; {temporary for updating |x|}
+begin if (a<0) or (c<0) then confusion("rising?");
+@:this can't happen rising?}{\quad rising?@>
+if x<=0 then solve_rising_cubic := 0
+else if x >= a+b+c then solve_rising_cubic := unity
+else begin t := 1;
+ @<Rescale if necessary to make sure |a|, |b|, and |c| are all less than
+ |el_gordo div 3|@>;
+ repeat double(t);
+ @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>;
+ xx := x - a - ab - ac;
+ if xx < -x then
+ begin double(x);
+ b:=ab; c:=ac;
+ end
+ else begin x := x + xx;
+ a:=ac; b:=bc;
+ t := t+1;
+ end;
+ until t >= unity;
+ solve_rising_cubic := t - unity;
+ end;
+end;
+
+@ @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>=
+ab := half(a+b);
+bc := half(b+c);
+ac := half(ab + bc)
+
+@ @d one_third_el_gordo==@'5252525252 {upper bound on |a|, |b|, and |c|}
+
+@<Rescale if necessary to make sure |a|, |b|, and |c| are all less than...@>=
+while (a>one_third_el_gordo) or@| (b>one_third_el_gordo)
+ or@| (c>one_third_el_gordo) do
+ begin a := halfp(a);
+ b := half(b);
+ c := halfp(c);
+ x := halfp(x);
+ end
+
+@ It is convenient to have a simpler interface to |arc_test| that requires no
+unnecessary arguments and ensures that each $({\it dx},{\it dy})$ pair has
+length less than |fraction_four|.
+
+@d arc_tol = 16 {quit when change in arc length estimate reaches this}
+
+@p function do_arc_test(@!dx0, @!dy0, @!dx1, @!dy1, @!dx2, @!dy2,
+ @!a_goal: scaled): scaled;
+var @!v0, @!v1, @!v2: scaled; {length of each $({\it dx},{\it dy})$ pair}
+@!v02: scaled; {twice the norm of the quadratic at $t={1\over2}$}
+begin v0 := pyth_add(dx0,dy0);
+v1 := pyth_add(dx1,dy1);
+v2 := pyth_add(dx2,dy2);
+if (v0>=fraction_four) or (v1>=fraction_four) or (v2>=fraction_four) then
+ begin arith_error := true;
+ if a_goal=el_gordo then @+do_arc_test := el_gordo
+ else do_arc_test := -two;
+ end
+else begin v02 := pyth_add(dx1+half(dx0+dx2), dy1+half(dy0+dy2));@/
+ do_arc_test := arc_test(dx0,dy0, dx1,dy1, dx2,dy2,@|
+ v0, v02, v2, a_goal, arc_tol);
+ end;
+end;
+
+@ Now it is easy to find the arc length of an entire path.
+
+@p function get_arc_length(@!h: pointer): scaled;
+label done;
+var @!p, @!q: pointer; {for traversing the path}
+@!a, @!a_tot: scaled; {current and total arc lengths}
+begin a_tot := 0;
+p := h;
+while right_type(p)<>endpoint do
+ begin q := link(p);
+ a := do_arc_test(right_x(p)-x_coord(p), right_y(p)-y_coord(p),@|
+ left_x(q)-right_x(p), left_y(q)-right_y(p),@|
+ x_coord(q)-left_x(q), y_coord(q)-left_y(q), el_gordo);
+ a_tot := slow_add(a, a_tot);
+ if q=h then goto done @+else p:=q;
+ end;
+done:check_arith;
+get_arc_length := a_tot;
+end;
+
+@ The inverse operation of finding the time on a path~|h| when the arc length
+reaches some value |arc0| can also be accomplished via |do_arc_test|. Some care
+is required to handle very large times or negative times on cyclic paths. For
+non-cyclic paths, |arc0| values that are negative or too large cause
+|get_arc_time| to return 0 or the length of path~|h|.
+
+If |arc0| is greater than the arc length of a cyclic path~|h|, the result is a
+time value greater than the length of the path. Since it could be much greater,
+we must be prepared to compute the arc length of path~|h| and divide this into
+|arc0| to find how many multiples of the length of path~|h| to add.
+
+@p function get_arc_time(@!h: pointer; @!arc0:scaled): scaled;
+label done;
+var @!p, @!q: pointer; {for traversing the path}
+@!t_tot: scaled; {accumulator for the result}
+@!t: scaled; {the result of |do_arc_test|}
+@!arc:scaled; {portion of |arc0| not used up so far}
+@!n: integer; {number of extra times to go around the cycle}
+begin if arc0<0 then @<Deal with a negative |arc0| value and |goto done|@>;
+if arc0=el_gordo then decr(arc0);
+t_tot := 0;
+arc := arc0;
+p := h;
+while (right_type(p)<>endpoint) and (arc>0) do
+ begin q := link(p);
+ t := do_arc_test(right_x(p)-x_coord(p), right_y(p)-y_coord(p),@|
+ left_x(q)-right_x(p), left_y(q)-right_y(p),@|
+ x_coord(q)-left_x(q), y_coord(q)-left_y(q), arc);
+ @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>;
+ if q=h then @<Update |t_tot| and |arc| to avoid going around the cyclic
+ path too many times but set |arith_error:=true| and |goto done| on
+ overflow@>;
+ p := q;
+ end;
+done: check_arith;
+get_arc_time := t_tot;
+end;
+
+@ @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>=
+if t<0 then
+ begin t_tot := t_tot + t + two;
+ arc := 0;
+ end
+else begin t_tot := t_tot + unity;
+ arc := arc - t;
+ end
+
+@ @<Deal with a negative |arc0| value and |goto done|@>=
+begin if left_type(h)=endpoint then t_tot:=0
+else begin p := htap_ypoc(h);
+ t_tot := -get_arc_time(p, -arc0);
+ toss_knot_list(p);
+ end;
+goto done;
+end
+
+@ @<Update |t_tot| and |arc| to avoid going around the cyclic...@>=
+if arc>0 then
+ begin n := arc div (arc0 - arc);
+ arc := arc - n*(arc0 - arc);
+ if t_tot > el_gordo div (n+1) then
+ begin arith_error := true;
+ t_tot := el_gordo;
+ goto done;
+ end;
+ t_tot := (n + 1)*t_tot;
+ end
+
+@* \[20] Data structures for pens.
+A Pen in \MP\ can be either elliptical or polygonal. Elliptical pens result
+in \ps\ \&{stroke} commands, while anything drawn with a polygonal pen is
+@:stroke}{\&{stroke} command@>
+converted into an area fill as described in the next part of this program.
+The mathematics behind this process is based on simple aspects of the theory
+of tracings developed by Leo Guibas, Lyle Ramshaw, and Jorge Stolfi
+[``A kinematic framework for computational geometry,'' Proc.\ IEEE Symp.\
+Foundations of Computer Science {\bf 24} (1983), 100--111].
+
+Polygonal pens are created from paths via \MP's \&{makepen} primitive.
+@:makepen_}{\&{makepen} primitive@>
+This path representation is almost sufficient for our purposes except that
+a pen path should always be a convex polygon with the vertices in
+counter-clockwise order.
+Since we will need to scan pen polygons both forward and backward, a pen
+should be represented as a doubly linked ring of knot nodes. There is
+room for the extra back pointer because we do not need the
+|left_type| or |right_type| fields. In fact, we don't need the |left_x|,
+|left_y|, |right_x|, or |right_y| fields either but we leave these alone
+so that certain procedures can operate on both pens and paths. In particular,
+pens can be copied using |copy_path| and recycled using |toss_knot_list|.
+
+@d knil==info
+ {this replaces the |left_type| and |right_type| fields in a pen knot}
+
+@ The |make_pen| procedure turns a path into a pen by initializing
+the |knil| pointers and making sure the knots form a convex polygon.
+Thus each cubic in the given path becomes a straight line and the control
+points are ignored. If the path is not cyclic, the ends are connected by a
+straight line.
+
+@d copy_pen(#)==make_pen(copy_path(#),false)
+
+@p @<Declare a function called |convex_hull|@>@;
+function make_pen(h:pointer;@!need_hull:boolean):pointer;
+var @!p,@!q:pointer; {two consecutive knots}
+begin q:=h;
+repeat p:=q; q:=link(q);
+knil(q):=p;
+until q=h;
+if need_hull then
+ begin h:=convex_hull(h);
+ @<Make sure |h| isn't confused with an elliptical pen@>;
+ end;
+make_pen:=h;
+end;
+
+@ The only information required about an elliptical pen is the overall
+transformation that has been applied to the original \&{pencircle}.
+@:pencircle_}{\&{pencircle} primitive@>
+Since it suffices to keep track of how the three points $(0,0)$, $(1,0)$,
+and $(0,1)$ are transformed, an elliptical pen can be stored in a single
+knot node and transformed as if it were a path.
+
+@d pen_is_elliptical(#)==(#=link(#))
+
+@p function get_pen_circle(@!diam:scaled):pointer;
+var @!h:pointer; {the knot node to return}
+begin h:=get_node(knot_node_size);
+link(h):=h; knil(h):=h;@/
+originator(h):=program_code;@/
+x_coord(h):=0; y_coord(h):=0;@/
+left_x(h):=diam; left_y(h):=0;@/
+right_x(h):=0; right_y(h):=diam;@/
+get_pen_circle:=h;
+end;
+
+@ If the polygon being returned by |make_pen| has only one vertex, it will
+be interpreted as an elliptical pen. This is no problem since a degenerate
+polygon can equally well be thought of as a degenerate ellipse. We need only
+initialize the |left_x|, |left_y|, |right_x|, and |right_y| fields.
+
+@<Make sure |h| isn't confused with an elliptical pen@>=
+if pen_is_elliptical(h) then
+ begin left_x(h):=x_coord(h); left_y(h):=y_coord(h);@/
+ right_x(h):=x_coord(h); right_y(h):=y_coord(h);
+ end
+
+@ We have to cheat a little here but most operations on pens only use
+the first three words in each knot node.
+@^data structure assumptions@>
+
+@<Initialize a pen at |test_pen| so that it fits in nine words@>=
+x_coord(test_pen):=-half_unit;
+y_coord(test_pen):=0;@/
+x_coord(test_pen+3):=half_unit;
+y_coord(test_pen+3):=0;@/
+x_coord(test_pen+6):=0;
+y_coord(test_pen+6):=unity;@/
+link(test_pen):=test_pen+3;
+link(test_pen+3):=test_pen+6;
+link(test_pen+6):=test_pen;
+knil(test_pen):=test_pen+6;
+knil(test_pen+3):=test_pen;
+knil(test_pen+6):=test_pen+3
+
+@ Printing a polygonal pen is very much like printing a path
+
+@<Declare subroutines for printing expressions@>=
+procedure pr_pen(@!h:pointer);
+label done;
+var @!p,@!q:pointer; {for list traversal}
+begin if pen_is_elliptical(h) then
+ @<Print the elliptical pen |h|@>
+else begin p:=h;
+ repeat print_two(x_coord(p),y_coord(p));
+ print_nl(" .. ");
+ @<Advance |p| making sure the links are OK and |return| if there is
+ a problem@>;
+ until p=h;
+ print("cycle");
+ end;
+done:end;
+
+@ @<Advance |p| making sure the links are OK and |return| if there is...@>=
+q:=link(p);
+if (q=null) or (knil(q)<>p) then
+ begin print_nl("???"); goto done; {this won't happen}
+@.???@>
+ end;
+p:=q
+
+@ @<Print the elliptical pen |h|@>=
+begin print("pencircle transformed (");
+print_scaled(x_coord(h));
+print_char(",");
+print_scaled(y_coord(h));@/
+print_char(",");
+print_scaled(left_x(h)-x_coord(h));
+print_char(",");
+print_scaled(right_x(h)-x_coord(h));
+print_char(",");
+print_scaled(left_y(h)-y_coord(h));@/
+print_char(",");
+print_scaled(right_y(h)-y_coord(h));@/
+print_char(")");
+end
+
+@ Here us another version of |pr_pen| that prints the pen as a diagnostic
+message.
+
+@<Declare subroutines for printing expressions@>=
+procedure print_pen(@!h:pointer;@!s:str_number;@!nuline:boolean);
+begin print_diagnostic("Pen",s,nuline); print_ln;
+@.Pen at line...@>
+pr_pen(h);
+end_diagnostic(true);
+end;
+
+@ Making a polygonal pen into a path involves restoring the |left_type| and
+|right_type| fields and setting the control points so as to make a polygonal
+path.
+
+@p procedure make_path(@!h:pointer);
+var @!p:pointer; {for traversing the knot list}
+@!k:small_number; {a loop counter}
+@<Other local variables in |make_path|@>@;
+begin if pen_is_elliptical(h) then
+ @<Make the elliptical pen |h| into a path@>
+else begin p:=h;
+ repeat left_type(p):=explicit;
+ right_type(p):=explicit;@/
+ @<copy the coordinates of knot |p| into its control points@>;@/
+ p:=link(p);
+ until p=h;
+ end;
+end;
+
+@ @<copy the coordinates of knot |p| into its control points@>=
+left_x(p):=x_coord(p);
+left_y(p):=y_coord(p);@/
+right_x(p):=x_coord(p);
+right_y(p):=y_coord(p)
+
+@ We need an eight knot path to get a good approximation to an ellipse.
+
+@<Make the elliptical pen |h| into a path@>=
+begin @<Extract the transformation parameters from the elliptical pen~|h|@>;
+p:=h;
+for k:=0 to 7 do
+ begin @<Initialize |p| as the |k|th knot of a circle of unit diameter,
+ transforming it appropriately@>;
+ if k=7 then link(p):=h @+else link(p):=get_node(knot_node_size);
+ p:=link(p);
+ end;
+end
+
+@ @<Extract the transformation parameters from the elliptical pen~|h|@>=
+center_x:=x_coord(h);
+center_y:=y_coord(h);@/
+width_x:=left_x(h)-center_x;
+width_y:=left_y(h)-center_y;@/
+height_x:=right_x(h)-center_x;
+height_y:=right_y(h)-center_y
+
+@ @<Other local variables in |make_path|@>=
+@!center_x,@!center_y:scaled; {translation parameters for an elliptical pen}
+@!width_x,@!width_y:scaled; {the effect of a unit change in $x$}
+@!height_x,@!height_y:scaled; {the effect of a unit change in $y$}
+@!dx,@!dy:scaled; {the vector from knot |p| to its right control point}
+@!kk:integer;
+ {|k| advanced $270^\circ$ around the ring (cf. $\sin\theta=\cos(\theta+270)$)}
+
+@ The only tricky thing here are the tables |half_cos| and |d_cos| used to
+find the point $k/8$ of the way around the circle and the direction vector
+to use there.
+
+@<Initialize |p| as the |k|th knot of a circle of unit diameter,...@>=
+kk:=(k+6)mod 8;@/
+x_coord(p):=center_x+take_fraction(half_cos[k],width_x)
+ +take_fraction(half_cos[kk],height_x);
+y_coord(p):=center_y+take_fraction(half_cos[k],width_y)
+ +take_fraction(half_cos[kk],height_y);
+dx:=-take_fraction(d_cos[kk],width_x)+take_fraction(d_cos[k],height_x);
+dy:=-take_fraction(d_cos[kk],width_y)+take_fraction(d_cos[k],height_y);
+right_x(p):=x_coord(p)+dx;
+right_y(p):=y_coord(p)+dy;@/
+left_x(p):=x_coord(p)-dx;
+left_y(p):=y_coord(p)-dy;@/
+left_type(p):=explicit;
+right_type(p):=explicit;
+originator(p):=program_code
+
+@ @<Glob...@>=
+half_cos:array[0..7] of fraction; {${1\over2}\cos(45k)$}
+d_cos:array[0..7] of fraction; {a magic constant times $\cos(45k)$}
+
+@ The magic constant for |d_cos| is the distance between $({1\over2},0)$ and
+$({1\over4}\sqrt2,{1\over4}\sqrt2)$ times the result of the |velocity|
+function for $\theta=\phi=22.5^\circ$. This comes out to be
+$$ d = {\sqrt{2-\sqrt2}\over 3+3\cos22.5^\circ}
+ \approx 0.132608244919772.
+$$
+
+@<Set init...@>=
+half_cos[0]:=fraction_half;
+half_cos[1]:=94906266; {$2^{26}\sqrt2\approx94906265.62$}
+half_cos[2]:=0;@/
+d_cos[0]:=35596755; {$2^{28}d\approx35596754.69$}
+d_cos[1]:=25170707; {$2^{27}\sqrt2\,d\approx25170706.63$}
+d_cos[2]:=0;
+for k:=3 to 4 do
+ begin half_cos[k]:=-half_cos[4-k];
+ d_cos[k]:=-d_cos[4-k];
+ end;
+for k:=5 to 7 do
+ begin half_cos[k]:=half_cos[8-k];
+ d_cos[k]:=d_cos[8-k];
+ end;
+
+@ The |convex_hull| function forces a pen polygon to be convex when it is
+returned by |make_pen| and after any subsequent transformation where rounding
+error might allow the convexity to be lost.
+The convex hull algorithm used here is described by F.~P. Preparata and
+M.~I. Shamos [{\sl Computational Geometry}, Springer-Verlag, 1985].
+
+@<Declare a function called |convex_hull|@>=
+@<Declare a procedure called |move_knot|@>@;
+function convex_hull(@!h:pointer):pointer; {Make a polygonal pen convex}
+label done1,done2,done3;
+var @!l,@!r:pointer; {the leftmost and rightmost knots}
+@!p,@!q:pointer; {knots being scanned}
+@!s:pointer; {the starting point for an upcoming scan}
+@!dx,@!dy:scaled; {a temporary pointer}
+begin if pen_is_elliptical(h) then convex_hull:=h
+else begin @<Set |l| to the leftmost knot in polygon~|h|@>;
+ @<Set |r| to the rightmost knot in polygon~|h|@>;
+ if l<>r then
+ begin s:=link(r);
+ @<Find any knots on the path from |l| to |r| above the |l|-|r| line and
+ move them past~|r|@>;
+ @<Find any knots on the path from |s| to |l| below the |l|-|r| line and
+ move them past~|l|@>;
+ @<Sort the path from |l| to |r| by increasing $x$@>;
+ @<Sort the path from |r| to |l| by decreasing $x$@>;
+ end;
+ if l<>link(l) then @<Do a Gramm scan and remove vertices where there
+ is no left turn@>;
+ convex_hull:=l;
+ end;
+end;
+
+@ All comparisons are done primarily on $x$ and secondarily on $y$.
+
+@<Set |l| to the leftmost knot in polygon~|h|@>=
+l:=h;
+p:=link(h);
+while p<>h do
+ begin if x_coord(p)<=x_coord(l) then
+ if (x_coord(p)<x_coord(l)) or (y_coord(p)<y_coord(l)) then
+ l:=p;
+ p:=link(p);
+ end
+
+@ @<Set |r| to the rightmost knot in polygon~|h|@>=
+r:=h;
+p:=link(h);
+while p<>h do
+ begin if x_coord(p)>=x_coord(r) then
+ if (x_coord(p)>x_coord(r)) or (y_coord(p)>y_coord(r)) then
+ r:=p;
+ p:=link(p);
+ end
+
+@ @<Find any knots on the path from |l| to |r| above the |l|-|r| line...@>=
+dx:=x_coord(r)-x_coord(l);
+dy:=y_coord(r)-y_coord(l);
+p:=link(l);
+while p<>r do
+ begin q:=link(p);
+ if ab_vs_cd(dx,y_coord(p)-y_coord(l),dy,x_coord(p)-x_coord(l))>0 then
+ move_knot(p,r);
+ p:=q;
+ end
+
+@ The |move_knot| procedure removes |p| from a doubly linked list and inserts
+it after |q|.
+
+@ @<Declare a procedure called |move_knot|@>=
+procedure move_knot(@!p,@!q:pointer);
+begin link(knil(p)):=link(p);
+knil(link(p)):=knil(p);@/
+knil(p):=q;
+link(p):=link(q);
+link(q):=p;
+knil(link(p)):=p;
+end;
+
+@ @<Find any knots on the path from |s| to |l| below the |l|-|r| line...@>=
+p:=s;
+while p<>l do
+ begin q:=link(p);
+ if ab_vs_cd(dx,y_coord(p)-y_coord(l),dy,x_coord(p)-x_coord(l))<0 then
+ move_knot(p,l);
+ p:=q;
+ end
+
+@ The list is likely to be in order already so we just do linear insertions.
+Secondary comparisons on $y$ ensure that the sort is consistent with the
+choice of |l| and |r|.
+
+@<Sort the path from |l| to |r| by increasing $x$@>=
+p:=link(l);
+while p<>r do
+ begin q:=knil(p);
+ while x_coord(q)>x_coord(p) do q:=knil(q);
+ while x_coord(q)=x_coord(p) do
+ if y_coord(q)>y_coord(p) then q:=knil(q) else goto done1;
+done1:
+ if q=knil(p) then p:=link(p)
+ else begin p:=link(p); move_knot(knil(p),q);
+ end;
+ end
+
+@ @<Sort the path from |r| to |l| by decreasing $x$@>=
+p:=link(r);
+while p<>l do
+ begin q:=knil(p);
+ while x_coord(q)<x_coord(p) do q:=knil(q);
+ while x_coord(q)=x_coord(p) do
+ if y_coord(q)<y_coord(p) then q:=knil(q) else goto done2;
+done2:
+ if q=knil(p) then p:=link(p)
+ else begin p:=link(p); move_knot(knil(p),q);
+ end;
+ end
+
+@ The condition involving |ab_vs_cd| tests if there is not a left turn
+at knot |q|. There usually will be a left turn so we streamline the case
+where the |then| clause is not executed.
+
+@<Do a Gramm scan and remove vertices where there...@>=
+begin p:=l; q:=link(l);
+loop @+begin dx:=x_coord(q)-x_coord(p);
+ dy:=y_coord(q)-y_coord(p);
+ p:=q; q:=link(q);
+ if p=l then goto done3;
+ if p<>r then
+ if ab_vs_cd(dx,y_coord(q)-y_coord(p),dy,x_coord(q)-x_coord(p))<=0 then
+ @<Remove knot |p| and back up |p| and |q| but don't go past |l|@>;
+ end;
+done3: do_nothing;
+end
+
+@ @<Remove knot |p| and back up |p| and |q| but don't go past |l|@>=
+begin s:=knil(p);
+free_node(p,knot_node_size);
+link(s):=q; knil(q):=s;
+if s=l then p:=s
+else begin p:=knil(s); q:=s;
+ end;
+end
+
+@ The |find_offset| procedure sets global variables |(cur_x,cur_y)| to the
+offset associated with the given direction |(x,y)|. If two different offsets
+apply, it chooses one of them.
+
+@p procedure find_offset(@!x,@!y:scaled;@!h:pointer);
+var @!p,@!q:pointer; {consecutive knots}
+@!wx,@!wy,@!hx,@!hy:scaled;
+ {the transformation matrix for an elliptical pen}
+@!xx,@!yy:fraction; {untransformed offset for an elliptical pen}
+@!d:fraction; {a temporary register}
+begin if pen_is_elliptical(h) then
+ @<Find the offset for |(x,y)| on the elliptical pen~|h|@>
+else begin q:=h;
+ repeat p:=q; q:=link(q);
+ until ab_vs_cd(x_coord(q)-x_coord(p),y, y_coord(q)-y_coord(p),x)>=0;
+ repeat p:=q; q:=link(q);
+ until ab_vs_cd(x_coord(q)-x_coord(p),y, y_coord(q)-y_coord(p),x)<=0;
+ cur_x:=x_coord(p);
+ cur_y:=y_coord(p);
+ end;
+end;
+
+@ @<Glob...@>=
+@!cur_x,@!cur_y:scaled; {all-purpose return value registers}
+
+@ @<Find the offset for |(x,y)| on the elliptical pen~|h|@>=
+if (x=0) and (y=0) then
+ begin cur_x:=x_coord(h); cur_y:=y_coord(h); @+end
+else begin @<Find the non-constant part of the transformation for |h|@>;
+ while (abs(x)<fraction_half) and (abs(y)<fraction_half) do
+ begin double(x); double(y); @+end;
+ @<Make |(xx,yy)| the offset on the untransformed \&{pencircle} for the
+ untransformed version of |(x,y)|@>;
+ cur_x:=x_coord(h)+take_fraction(xx,wx)+take_fraction(yy,hx);
+ cur_y:=y_coord(h)+take_fraction(xx,wy)+take_fraction(yy,hy);
+ end
+
+@ @<Find the non-constant part of the transformation for |h|@>=
+wx:=left_x(h)-x_coord(h);
+wy:=left_y(h)-y_coord(h);
+hx:=right_x(h)-x_coord(h);
+hy:=right_y(h)-y_coord(h)
+
+@ @<Make |(xx,yy)| the offset on the untransformed \&{pencircle} for the...@>=
+yy:=-(take_fraction(x,hy)+take_fraction(y,-hx));@/
+xx:=take_fraction(x,-wy)+take_fraction(y,wx);@/
+d:=pyth_add(xx,yy);@/
+if d>0 then
+ begin xx:=half(make_fraction(xx,d));
+ yy:=half(make_fraction(yy,d));
+ end
+
+@ Finding the bounding box of a pen is easy except if the pen is elliptical.
+But we can handle that case by just calling |find_offset| twice. The answer
+is stored in the global variables |minx|, |maxx|, |miny|, and |maxy|.
+
+@p procedure pen_bbox(@!h:pointer);
+var @!p:pointer; {for scanning the knot list}
+begin if pen_is_elliptical(h) then
+ @<Find the bounding box of an elliptical pen@>
+else begin minx:=x_coord(h); maxx:=minx;
+ miny:=y_coord(h); maxy:=miny;@/
+ p:=link(h);
+ while p<>h do
+ begin if x_coord(p)<minx then minx:=x_coord(p);
+ if y_coord(p)<miny then miny:=y_coord(p);
+ if x_coord(p)>maxx then maxx:=x_coord(p);
+ if y_coord(p)>maxy then maxy:=y_coord(p);
+ p:=link(p);
+ end;
+ end;
+end;
+
+@ @<Find the bounding box of an elliptical pen@>=
+begin find_offset(0,fraction_one,h);
+maxx:=cur_x;
+minx:=2*x_coord(h)-cur_x;@/
+find_offset(-fraction_one,0,h);
+maxy:=cur_y;
+miny:=2*y_coord(h)-cur_y;
+end
+
+@* \[21] Edge structures.
+Now we come to \MP's internal scheme for representing pictures.
+The representation is very different from \MF's edge structures
+because \MP\ pictures contain \ps\ graphics objects instead of pixel
+images. However, the basic idea is somewhat similar in that shapes
+are represented via their boundaries.
+
+The main purpose of edge structures is to keep track of graphical objects
+until it is time to translate them into \ps. Since \MP\ does not need to
+know anything about an edge structure other than how to translate it into
+\ps\ and how to find its bounding box, edge structures can be just linked
+lists of graphical objects. \MP\ has no easy way to determine whether
+two such objects overlap, but it suffices to draw the first one first and
+let the second one overwrite it if necessary.
+
+@ Let's consider the types of graphical objects one at a time.
+First of all, a filled contour is represented by a six-word node. The first
+word contains |type| and |link| fields, and the next four words contain a
+pointer to a cyclic path and the value to use for \ps' \&{currentrgbcolor}
+parameter. If a pen is used for filling |pen_p|, |ljoin_val| and |miterlim_val|
+give the relevant information.
+
+@d path_p(#)==link(#+1)
+ {a pointer to the path that needs filling}
+@d pen_p(#)==info(#+1)
+ {a pointer to the pen to fill or stroke with}
+@d obj_red_loc(#)==#+2 {the first of three locations for the color}
+@d red_val(#)==mem[#+2].sc
+ {the red component of the color in the range $0\ldots1$}
+@d green_val(#)==mem[#+3].sc
+ {the green component of the color in the range $0\ldots1$}
+@d blue_val(#)==mem[#+4].sc
+ {the blue component of the color in the range $0\ldots1$}
+@d ljoin_val(#)==name_type(#) {the value of \&{linejoin}}
+@:linejoin_}{\&{linejoin} primitive@>
+@d miterlim_val(#)==mem[#+5].sc {the value of \&{miterlimit}}
+@:miterlimit_}{\&{miterlimit} primitive@>
+@d obj_color_part(#)==mem[#+2-red_part].sc
+ {interpret an object pointer that has been offset by |red_part..blue_part|}
+@d fill_node_size=6
+@d fill_code=1
+
+@p function new_fill_node(@!p: pointer): pointer;
+ {make a fill node for cyclic path |p| and color black}
+var @!t:pointer; {the new node}
+begin t:=get_node(fill_node_size);
+ type(t):=fill_code;
+ path_p(t):=p;
+ pen_p(t):=null; {|null| means don't use a pen}
+ red_val(t):=0;
+ green_val(t):=0;
+ blue_val(t):=0;
+ @<Set the |ljoin_val| and |miterlim_val| fields in object |t|@>;
+ new_fill_node:=t;
+end;
+
+@ @<Set the |ljoin_val| and |miterlim_val| fields in object |t|@>=
+if internal[linejoin]>unity then ljoin_val(t):=2
+else if internal[linejoin]>0 then ljoin_val(t):=1
+else ljoin_val(t):=0;
+if internal[miterlimit]<unity then
+ miterlim_val(t):=unity
+else miterlim_val(t):=internal[miterlimit]
+
+@ A stroked path is represented by an eight-word node that is like a filled
+contour node except that it contains the current \&{linecap} value, a scale
+factor for the dash pattern, and a pointer that is non-null if the stroke
+is to be dashed. The purpose of the scale factor is to allow a picture to
+be transformed without touching the picture that |dash_p| points to.
+
+@d dash_p(#)==link(#+6)
+ {a pointer to the edge structure that gives the dash pattern}
+@d lcap_val(#)==type(#+6)
+ {the value of \&{linecap}}
+@:linecap_}{\&{linecap} primitive@>
+@d dash_scale(#)==mem[#+7].sc {dash lengths are scaled by this factor}
+@d stroked_node_size=8
+@d stroked_code=2
+
+@p function new_stroked_node(@!p:pointer): pointer;
+ {make a stroked node for path |p| with |pen_p(p)| temporarily |null|}
+var @!t:pointer; {the new node}
+begin t:=get_node(stroked_node_size);
+ type(t):=stroked_code;
+ path_p(t):=p; pen_p(t):=null;
+ dash_p(t):=null;
+ dash_scale(t):=unity;
+ red_val(t):=0;
+ green_val(t):=0;
+ blue_val(t):=0;
+ @<Set the |ljoin_val| and |miterlim_val| fields in object |t|@>;
+ if internal[linecap]>unity then lcap_val(t):=2
+ else if internal[linecap]>0 then lcap_val(t):=1
+ else lcap_val(t):=0;
+ new_stroked_node:=t;
+end;
+
+@ When a dashed line is computed in a transformed coordinate system, the dash
+lengths get scaled like the pen shape and we need to compensate for this. Since
+there is no unique scale factor for an arbitrary transformation, we use the
+the square root of the determinant. The properties of the determinant make it
+easier to maintain the |dash_scale|. The computation is fairly straight-forward
+except for the initialization of the scale factor |s|. The factor of 64 is
+needed because |square_rt| scales its result by $2^8$ while we need $2^{14}$
+to counteract the effect of |take_fraction|.
+
+@<Declare subroutines needed by |print_edges|@>=
+function sqrt_det(a,b,c,d:scaled):scaled;
+var @!maxabs:scaled; {$max(|a|,|b|,|c|,|d|)$}
+@!s:integer; {amount by which the result of |square_rt| needs to be scaled}
+begin @<Initialize |maxabs|@>;
+s:=64;
+while (maxabs<fraction_one) and (s>1) do
+ begin double(a); double(b); double(c); double(d);@/
+ double(maxabs); s:=halfp(s);
+ end;
+sqrt_det:=s*square_rt(abs(take_fraction(a,d)-take_fraction(b,c)));
+end;
+@#
+function get_pen_scale(p:pointer):scaled;
+begin get_pen_scale:=sqrt_det(
+ left_x(p)-x_coord(p), right_x(p)-x_coord(p),@/
+ left_y(p)-y_coord(p), right_y(p)-y_coord(p));
+end;
+
+@ @<Initialize |maxabs|@>=
+maxabs:=abs(a);
+if abs(b)>maxabs then maxabs:=abs(b);
+if abs(c)>maxabs then maxabs:=abs(c);
+if abs(d)>maxabs then maxabs:=abs(d)
+
+@ When a picture contains text, this is represented by a fourteen-word node
+where the color information and |type| and |link| fields are augmented by
+additional fields that describe the text and how it is transformed.
+The |path_p| and |pen_p| pointers are replaced by a number that identifies
+the font and a string number that gives the text to be displayed.
+The |width|, |height|, and |depth| fields
+give the dimensions of the text at its design size, and the remaining six
+words give a transformation to be applied to the text. The |new_text_node|
+function initializes everything to default values so that the text comes out
+black with its reference point at the origin.
+
+@d text_p(#)==link(#+1) {a string pointer for the text to display}
+@d font_n(#)==info(#+1) {the font number}
+@d width_val(#)==mem[#+5].sc {unscaled width of the text}
+@d height_val(#)==mem[#+6].sc {unscaled height of the text}
+@d depth_val(#)==mem[#+7].sc {unscaled depth of the text}
+@d text_tx_loc(#)==#+8
+ {the first of six locations for transformation parameters}
+@d tx_val(#)==mem[#+8].sc {$x$ shift amount}
+@d ty_val(#)==mem[#+9].sc {$y$ shift amount}
+@d txx_val(#)==mem[#+10].sc {|txx| transformation parameter}
+@d txy_val(#)==mem[#+11].sc {|txy| transformation parameter}
+@d tyx_val(#)==mem[#+12].sc {|tyx| transformation parameter}
+@d tyy_val(#)==mem[#+13].sc {|tyy| transformation parameter}
+@d text_trans_part(#)==mem[#+8-x_part].sc
+ {interpret a text node ponter that has been offset by |x_part..yy_part|}
+@d text_node_size=14
+@d text_code=3
+
+@p @<Declare text measuring subroutines@>@;
+function new_text_node(f,s:str_number):pointer;
+ {make a text node for font |f| and text string |s|}
+var @!t:pointer; {the new node}
+begin t:=get_node(text_node_size);
+ type(t):=text_code;
+ text_p(t):=s;
+ font_n(t):=find_font(f); {this identifies the font}
+ red_val(t):=0;
+ green_val(t):=0;
+ blue_val(t):=0;
+ tx_val(t):=0; ty_val(t):=0;
+ txx_val(t):=unity; txy_val(t):=0;
+ tyx_val(t):=0; tyy_val(t):=unity;
+ set_text_box(t); {this finds the bounding box}
+ new_text_node:=t;
+end;
+
+@ The last two types of graphical objects that can occur in an edge structure
+are clipping paths and \&{setbounds} paths. These are slightly more difficult
+@:set_bounds_}{\&{setbounds} primitive@>
+to implement because we must keep track of exactly what is being clipped or
+bounded when pictures get merged together. For this reason, each clipping or
+\&{setbounds} operation is represented by a pair of nodes: first comes a
+two-word node whose |path_p| gives the relevant path, then there is the list
+of objects to clip or bound followed by a two-word node whose second word is
+unused.
+
+Using at least two words for each graphical object node allows them all to be
+allocated and deallocated similarly with a global array |gr_object_size| to
+give the size in words for each object type.
+
+@d start_clip_size=2
+@d start_clip_code=4 {|type| of a node that starts clipping}
+@d start_bounds_size=2
+@d start_bounds_code=5 {|type| of a node that gives a \&{setbounds} path}
+@d stop_clip_size=2 {the second word is not used here}
+@d stop_clip_code=6 {|type| of a node that stops clipping}
+@d stop_bounds_size=2 {the second word is not used here}
+@d stop_bounds_code=7 {|type| of a node that stops \&{setbounds}}
+@#
+@d stop_type(#)==(#+2)
+ {matching |type| for |start_clip_code| or |start_bounds_code|}
+@d has_color(#)==(type(#)<start_clip_code)
+ {does a graphical object have color fields?}
+@d has_pen(#)==(type(#)<text_code)
+ {does a graphical object have a |pen_p| field?}
+@d is_start_or_stop(#)==(type(#)>=start_clip_code)
+@d is_stop(#)==(type(#)>=stop_clip_code)
+
+@p function new_bounds_node(@!p:pointer; c:small_number):pointer;
+ {make a node of type |c| where |p| is the clipping or \&{setbounds} path}
+var @!t:pointer; {the new node}
+begin t:=get_node(gr_object_size[c]);
+ type(t):=c;
+ path_p(t):=p;
+ new_bounds_node:=t;
+end;
+
+@ We need an array to keep track of the sizes of graphical objects.
+
+@<Glob...@>=
+gr_object_size: array[fill_code..stop_bounds_code] of small_number;
+
+@ @<Set init...@>=
+gr_object_size[fill_code]:=fill_node_size;
+gr_object_size[stroked_code]:=stroked_node_size;
+gr_object_size[text_code]:=text_node_size;
+gr_object_size[start_clip_code]:=start_clip_size;
+gr_object_size[stop_clip_code]:=stop_clip_size;
+gr_object_size[start_bounds_code]:=start_bounds_size;
+gr_object_size[stop_bounds_code]:=stop_bounds_size;
+
+@ All the essential information in an edge structure is encoded as a linked list
+of graphical objects as we have just seen, but it is helpful to add some
+redundant information. A single edge structure might be used as a dash pattern
+many times, and it would be nice to avoid scanning the same structure
+repeatedly. Thus, an edge structure known to be a suitable dash pattern
+has a header that gives a list of dashes in a sorted order designed for rapid
+translation into \ps.
+
+Each dash is represented by a three-word node containing the initial and final
+$x$~coordinates as well as the usual |link| field. The |link| fields points to
+the dash node with the next higher $x$-coordinates and the final link points
+to a special location called |null_dash|. (There should be no overlap between
+dashes). Since the $y$~coordinate of the dash pattern is needed to determine
+the period of repetition, this needs to be stored in the edge header along
+with a pointer to the list of dash nodes.
+
+@d start_x(#)==mem[#+1].sc {the starting $x$~coordinate in a dash node}
+@d stop_x(#)==mem[#+2].sc {the ending $x$~coordinate in a dash node}
+@d dash_node_size=3
+@d dash_list==link
+ {in an edge header this points to the first dash node}
+@d dash_y(#)==mem[#+1].sc {$y$ value for the dash list in an edge header}
+
+@ It is also convenient for an edge header to contain the bounding
+box information needed by the \&{llcorner} and \&{urcorner} operators
+so that this does not have to be recomputed unnecessarily. This is done by
+adding fields for the $x$~and $y$ extremes as well as a pointer that indicates
+how far the bounding box computation has gotten. Thus if the user asks for
+the bounding box and then adds some more text to the picture before asking
+for more bounding box information, the second computation need only look at
+the additional text.
+
+When the bounding box has not been computed, the |bblast| pointer points
+to a dummy link at the head of the graphical object list while the |minx_val|
+and |miny_val| fields contain |el_gordo| and the |maxx_val| and |maxy_val|
+fields contain |-el_gordo|.
+
+Since the bounding box of pictures containing objects of type
+|start_bounds_code| depends on the value of \&{truecorners}, the bounding box
+@:true_corners_}{\&{truecorners} primitive@>
+data might not be valid for all values of this parameter. Hence, the |bbtype|
+field is needed to keep track of this.
+
+@d minx_val(#)==mem[#+2].sc
+@d miny_val(#)==mem[#+3].sc
+@d maxx_val(#)==mem[#+4].sc
+@d maxy_val(#)==mem[#+5].sc
+@d bblast(#)==link(#+6) {last item considered in bounding box computation}
+@d bbtype(#)==info(#+6) {tells how bounding box data depends on \&{truecorners}}
+@d dummy_loc(#)==#+7 {where the object list begins in an edge header}
+@d no_bounds=0
+ {|bbtype| value when bounding box data is valid for all \&{truecorners} values}
+@d bounds_set=1
+ {|bbtype| value when bounding box data is for \&{truecorners}${}\le 0$}
+@d bounds_unset=2
+ {|bbtype| value when bounding box data is for \&{truecorners}${}>0$}
+
+@p procedure init_bbox(@!h:pointer);
+ {Initialize the bounding box information in edge structure |h|}
+begin bblast(h):=dummy_loc(h);
+bbtype(h):=no_bounds;
+minx_val(h):=el_gordo;
+miny_val(h):=el_gordo;
+maxx_val(h):=-el_gordo;
+maxy_val(h):=-el_gordo;
+end;
+
+@ The only other entries in an edge header are a reference count in the first
+word and a pointer to the tail of the object list in the last word.
+
+@d obj_tail(#)==info(#+7) {points to the last entry in the object list}
+@d edge_header_size=8
+
+@p procedure init_edges(@!h:pointer);
+ {initialize an edge header to null values}
+begin dash_list(h):=null_dash;
+obj_tail(h):=dummy_loc(h);
+link(dummy_loc(h)):=null;
+ref_count(h):=null;
+init_bbox(h);
+end;
+
+@ Here is how edge structures are deleted. The process can be recursive because
+of the need to dereference edge structures that are used as dash patterns.
+@^recursion@>
+
+@d add_edge_ref(#)==incr(ref_count(#))
+@d delete_edge_ref(#)==if ref_count(#)=null then toss_edges(#)
+ else decr(ref_count(#))
+
+@<Declare the recycling subroutines@>=
+@<Declare subroutines needed by |toss_edges|@>@;
+procedure toss_edges(@!h:pointer);
+var @!p,@!q:pointer; {pointers that scan the list being recycled}
+@!r:pointer; {an edge structure that object |p| refers to}
+begin flush_dash_list(h);
+q:=link(dummy_loc(h));
+while (q<>null) do
+ begin p:=q; q:=link(q);
+ r:=toss_gr_object(p);
+ if r<>null then delete_edge_ref(r);
+ end;
+free_node(h,edge_header_size);
+end;
+
+@ @<Declare subroutines needed by |toss_edges|@>=
+procedure flush_dash_list(h:pointer);
+var @!p,@!q:pointer; {pointers that scan the list being recycled}
+begin q:=dash_list(h);
+while q<>null_dash do
+ begin p:=q; q:=link(q);
+ free_node(p,dash_node_size);
+ end;
+dash_list(h):=null_dash;
+end;
+
+@ @<Declare subroutines needed by |toss_edges|@>=
+function toss_gr_object(@!p:pointer):pointer;
+ {returns an edge structure that needs to be dereferenced}
+var @!e:pointer; {the edge structure to return}
+begin e:=null;
+@<Prepare to recycle graphical object |p|@>;
+free_node(p,gr_object_size[type(p)]);@/
+toss_gr_object:=e;
+end;
+
+@ @<Prepare to recycle graphical object |p|@>=
+case type(p) of
+fill_code: begin toss_knot_list(path_p(p));
+ if pen_p(p)<>null then toss_knot_list(pen_p(p));
+ end;
+stroked_code: begin toss_knot_list(path_p(p));
+ if pen_p(p)<>null then toss_knot_list(pen_p(p));
+ e:=dash_p(p);
+ end;
+text_code: delete_str_ref(text_p(p));
+start_clip_code,start_bounds_code: toss_knot_list(path_p(p));
+stop_clip_code,stop_bounds_code: do_nothing;
+end; {there are no other cases}
+
+@ If we use |add_edge_ref| to ``copy'' edge structures, the real copying needs
+to be done before making a significant change to an edge structure. Much of
+the work is done in a separate routine |copy_objects| that copies a list of
+graphical objects into a new edge header.
+
+@p @<Declare a function called |copy_objects|@>@;
+function private_edges(h:pointer):pointer;
+ {make a private copy of the edge structure headed by |h|}
+var @!hh:pointer; {the edge header for the new copy}
+ @!p,@!pp: pointer; {pointers for copying the dash list}
+begin if ref_count(h)=null then private_edges:=h
+else begin decr(ref_count(h));
+ hh:=copy_objects(link(dummy_loc(h)),null);
+ @<Copy the dash list from |h| to |hh|@>;
+ @<Copy the bounding box information from |h| to |hh| and make |bblast(hh)|
+ point into the new object list@>;
+ private_edges:=hh;
+ end;
+end;
+
+@ Here we use the fact that |dash_list(hh)=link(hh)|.
+@^data structure assumptions@>
+
+@<Copy the dash list from |h| to |hh|@>=
+pp:=hh; p:=dash_list(h);
+while (p<>null_dash) do
+ begin link(pp):=get_node(dash_node_size);
+ pp:=link(pp);@/
+ start_x(pp):=start_x(p);
+ stop_x(pp):=stop_x(p);
+ p:=link(p);
+ end;
+link(pp):=null_dash;
+dash_y(hh):=dash_y(h)
+
+@ @<Copy the bounding box information from |h| to |hh|...@>=
+minx_val(hh):=minx_val(h);
+miny_val(hh):=miny_val(h);
+maxx_val(hh):=maxx_val(h);
+maxy_val(hh):=maxy_val(h);@/
+bbtype(hh):=bbtype(h);
+p:=dummy_loc(h); pp:=dummy_loc(hh);
+while(p<>bblast(h)) do
+ begin if p=null then confusion("bblast");
+@:this can't happen bblast}{\quad bblast@>
+ p:=link(p); pp:=link(pp);
+ end;
+bblast(hh):=pp
+
+@ Here is the promised routine for copying graphical objects into a new edge
+structure. It starts copying at object~|p| and stops just before object~|q|.
+If |q| is null, it copies the entire sublist headed at |p|. The resulting edge
+structure requires further initialization by |init_bbox|.
+
+@<Declare a function called |copy_objects|@>=
+function copy_objects(p, q:pointer):pointer;
+var @!hh: pointer; {the new edge header}
+ @!pp:pointer; {the last newly copied object}
+ @!k:small_number; {temporary register}
+begin hh:=get_node(edge_header_size);
+dash_list(hh):=null_dash;
+ref_count(hh):=null;@/
+pp:=dummy_loc(hh);
+while (p<>q) do
+ @<Make |link(pp)| point to a copy of object |p|, and update |p| and |pp|@>;
+obj_tail(hh):=pp;
+link(pp):=null;
+copy_objects:=hh;
+end;
+
+@ @<Make |link(pp)| point to a copy of object |p|, and update |p| and |pp|@>=
+begin k:=gr_object_size[type(p)];@/
+link(pp):=get_node(k);
+pp:=link(pp);
+while (k>0) do
+ begin decr(k); mem[pp+k]:=mem[p+k]; @+end;
+@<Fix anything in graphical object |pp| that should differ from the
+ corresponding field in |p|@>;
+p:=link(p);
+end
+
+@ @<Fix anything in graphical object |pp| that should differ from the...@>=
+case type(p) of
+start_clip_code,start_bounds_code: path_p(pp):=copy_path(path_p(p));
+fill_code: begin path_p(pp):=copy_path(path_p(p));
+ if pen_p(p)<>null then pen_p(pp):=copy_pen(pen_p(p));
+ end;
+stroked_code: begin path_p(pp):=copy_path(path_p(p));
+ pen_p(pp):=copy_pen(pen_p(p));
+ if dash_p(p)<>null then add_edge_ref(dash_p(pp));
+ end;
+text_code: add_str_ref(text_p(pp));
+stop_clip_code,stop_bounds_code: do_nothing;
+end {there are no other cases}
+
+@ Here is one way to find an acceptable value for the second argument to
+|copy_objects|. Given a non-null graphical object list, |skip_1component|
+skips past one picture component, where a ``picture component'' is a single
+graphical object, or a start bounds or start clip object and everything up
+through the matching stop bounds or stop clip object. The macro version avoids
+procedure call overhead and error handling: |skip_component(p)(e)| advances |p|
+unless |p| points to a stop bounds or stop clip node, in which case it executes
+|e| instead.
+
+@d skip_component(#)==if not is_start_or_stop(#) then #:=link(#)
+ else if not is_stop(#) then #:=skip_1component(#)
+ else skipc_end
+@d skipc_end(#)==#
+
+@p function skip_1component(p:pointer):pointer;
+var @!lev:integer; {current nesting level}
+begin lev:=0;
+repeat if is_start_or_stop(p) then
+ if is_stop(p) then decr(lev) @+else incr(lev);
+p:=link(p);
+until lev=0;
+skip_1component:=p;
+end;
+
+@ Here is a diagnostic routine for printing an edge structure in symbolic form.
+
+@<Declare subroutines for printing expressions@>=
+@<Declare subroutines needed by |print_edges|@>@;
+procedure print_edges(@!h:pointer;@!s:str_number;@!nuline:boolean);
+var @!p:pointer; {a graphical object to be printed}
+@!hh,@!pp:pointer; {temporary pointers}
+@!scf:scaled; {a scale factor for the dash pattern}
+@!ok_to_dash:boolean; {|false| for polygonal pen strokes}
+begin print_diagnostic("Edge structure",s,nuline);
+p:=dummy_loc(h);
+while link(p)<>null do
+ begin p:=link(p);
+ print_ln;
+ case type(p) of
+ @<Cases for printing graphical object node |p|@>@;
+ othercases begin print("[unknown object type!]");
+ end
+ endcases;@/
+ end;
+print_nl("End edges");
+if p<>obj_tail(h) then print("?");
+@.End edges?@>
+end_diagnostic(true);
+end;
+
+@ @<Cases for printing graphical object node |p|@>=
+fill_code: begin print("Filled contour ");
+ print_obj_color(p);
+ print_char(":"); print_ln;
+ pr_path(path_p(p)); print_ln;
+ if (pen_p(p)<>null) then
+ begin @<Print join type for graphical object |p|@>;
+ print(" with pen"); print_ln;
+ pr_pen(pen_p(p));
+ end;
+ end;
+
+@ @<Print join type for graphical object |p|@>=
+case ljoin_val(p) of
+0:begin print("mitered joins limited ");
+ print_scaled(miterlim_val(p));
+ end;
+1:print("round joins");
+2:print("beveled joins");
+othercases print("?? joins");
+@.??@>
+endcases
+
+@ For stroked nodes, we need to print |lcap_val(p)| as well.
+
+@<Print join and cap types for stroked node |p|@>=
+case lcap_val(p) of
+0:print("butt");
+1:print("round");
+2:print("square");
+othercases print("??")
+@.??@>
+endcases;
+print(" ends, ");
+@<Print join type for graphical object |p|@>
+
+@ Here is a routine that prints the color of a graphical object if it isn't
+black (the default color).
+
+@<Declare subroutines needed by |print_edges|@>=
+@<Declare a procedure called |print_compact_node|@>@;
+procedure print_obj_color(@!p:pointer);
+begin if (red_val(p)>0) or (green_val(p)>0) or (blue_val(p)>0) then
+ begin print("colored ");
+ print_compact_node(obj_red_loc(p),3);
+ end;
+end;
+
+@ We also need a procedure for printing consecutive scaled values as if they
+were a known big node.
+
+@<Declare a procedure called |print_compact_node|@>=
+procedure print_compact_node(@!p:pointer;k:small_number);
+var @!q:pointer; {last location to print}
+begin q:=p+k-1;
+print_char("(");
+while p<=q do
+ begin print_scaled(mem[p].sc);
+ if p<q then print_char(",");
+ incr(p);
+ end;
+print_char(")");
+end;
+
+@ @<Cases for printing graphical object node |p|@>=
+stroked_code: begin print("Filled pen stroke ");
+ print_obj_color(p);
+ print_char(":"); print_ln;
+ pr_path(path_p(p));
+ if dash_p(p)<>null then
+ begin print_nl("dashed (");
+ @<Finish printing the dash pattern that |p| refers to@>;
+ end;
+ print_ln;
+ @<Print join and cap types for stroked node |p|@>;
+ print(" with pen"); print_ln;
+ if pen_p(p)=null then print("???") {shouldn't happen}
+@.???@>
+ else pr_pen(pen_p(p));
+ end;
+
+@ Normally, the |dash_list| field in an edge header is set to |null_dash|
+when it is not known to define a suitable dash pattern. This is disallowed
+here because the |dash_p| field should never point to such an edge header.
+Note that memory is allocated for |start_x(null_dash)| and we are free to
+give it any convenient value.
+
+@<Finish printing the dash pattern that |p| refers to@>=
+ok_to_dash:=pen_is_elliptical(pen_p(p));
+if not ok_to_dash then scf:=unity
+else scf:=dash_scale(p);
+hh:=dash_p(p);
+pp:=dash_list(hh);
+if (pp=null_dash) or (dash_y(hh)<0) then print(" ??")
+else begin start_x(null_dash):=start_x(pp)+dash_y(hh);
+ while pp<>null_dash do
+ begin print("on ");
+ print_scaled(take_scaled(stop_x(pp)-start_x(pp),scf));
+ print(" off ");
+ print_scaled(take_scaled(start_x(link(pp))-stop_x(pp),scf));
+ pp := link(pp);
+ if pp<>null_dash then print_char(" ");
+ end;
+ print(") shifted ");
+ print_scaled(-take_scaled(dash_offset(hh),scf));
+ if not ok_to_dash or (dash_y(hh)=0) then print(" (this will be ignored)");
+ end
+
+@ @<Declare subroutines needed by |print_edges|@>=
+function dash_offset(h:pointer):scaled;
+var @!x:scaled; {the answer}
+begin if (dash_list(h)=null_dash) or (dash_y(h)<0) then confusion("dash0");
+@:this can't happen dash0}{\quad dash0@>
+if dash_y(h)=0 then x:=0
+else begin x:=-(start_x(dash_list(h)) mod dash_y(h));
+ if x<0 then x:=x+dash_y(h);
+ end;
+dash_offset:=x;
+end;
+
+@ @<Cases for printing graphical object node |p|@>=
+text_code: begin print_char(""""); print(text_p(p));
+ print(""" infont """); print(font_name[font_n(p)]);
+ print_char(""""); print_ln;
+ print_obj_color(p);
+ print("transformed ");
+ print_compact_node(text_tx_loc(p),6);
+end;
+
+@ @<Cases for printing graphical object node |p|@>=
+start_clip_code: begin print("clipping path:");
+ print_ln;
+ pr_path(path_p(p));
+ end;
+stop_clip_code: print("stop clipping");
+
+@ @<Cases for printing graphical object node |p|@>=
+start_bounds_code: begin print("setbounds path:");
+ print_ln;
+ pr_path(path_p(p));
+ end;
+stop_bounds_code: print("end of setbounds");
+
+@ To initialize the |dash_list| field in an edge header~|h|, we need a
+subroutine that scans an edge structure and tries to interpret it as a dash
+pattern. This can only be done when there are no filled regions or clipping
+paths and all the pen strokes have the same color. The first step is to let
+$y_0$ be the initial $y$~coordinate of the first pen stroke. Then we implicitly
+project all the pen stroke paths onto the line $y=y_0$ and require that there
+be no retracing. If the resulting paths cover a range of $x$~coordinates of
+length $\Delta x$, we set |dash_y(h)| to the length of the dash pattern by
+finding the maximum of $\Delta x$ and the absolute value of~$y_0$.
+
+@p @<Declare a procedure called |x_retrace_error|@>@;
+function make_dashes(h:pointer):pointer; {returns |h| or |null|}
+label exit, found, not_found;
+var @!p:pointer; {this scans the stroked nodes in the object list}
+@!y0:scaled; {the initial $y$ coordinate}
+@!p0:pointer; {if not |null| this points to the first stroked node}
+@!pp,@!qq,@!rr:pointer; {pointers into |path_p(p)|}
+@!d,@!dd:pointer; {pointers used to create the dash list}
+@<Other local variables in |make_dashes|@>@;
+begin if dash_list(h)<>null_dash then goto found;
+p0:=null;
+p:=link(dummy_loc(h));
+while p<>null do
+ begin if type(p)<>stroked_code then
+ @<Compain that the edge structure contains a node of the wrong type
+ and |goto not_found|@>;
+ pp:=path_p(p);
+ if p0=null then
+ begin p0:=p; y0:=y_coord(pp); @+end;
+ @<Make |d| point to a new dash node created from stroke |p| and path |pp|
+ or |goto not_found| if there is an error@>;
+ @<Insert |d| into the dash list and |goto not_found| if there is an error@>;
+ p:=link(p);
+ end;
+if dash_list(h)=null_dash then goto not_found; {No error message}
+@<Scan |dash_list(h)| and deal with any dashes that are themselves dashed@>;
+@<Set |dash_y(h)| and merge the first and last dashes if necessary@>;
+found:make_dashes:=h; return;
+not_found: @<Flush the dash list, recycle |h| and return |null|@>;
+exit:end;
+
+@ @<Compain that the edge structure contains a node of the wrong type...@>=
+begin print_err("Picture is too complicated to use as a dash pattern");
+help3("When you say `dashed p', picture p should not contain any")@/
+ ("text, filled regions, or clipping paths. This time it did")@/
+ ("so I'll just make it a solid line instead.");@/
+put_get_error;
+goto not_found;
+end
+
+@ A similar error occurs when monotonicity fails.
+
+@<Declare a procedure called |x_retrace_error|@>=
+procedure x_retrace_error;
+begin print_err("Picture is too complicated to use as a dash pattern");
+help3("When you say `dashed p', every path in p should be monotone")@/
+ ("in x and there must be no overlapping. This failed")@/
+ ("so I'll just make it a solid line instead.");
+put_get_error;
+end;
+
+@ We stash |p| in |info(d)| if |dash_p(p)<>0| so that subsequent processing can
+handle the case where the pen stroke |p| is itself dashed.
+
+@<Make |d| point to a new dash node created from stroke |p| and path...@>=
+@<Make sure |p| and |p0| are the same color and |goto not_found| if there is
+ an error@>;
+rr:=pp;
+if link(pp)<>pp then
+ repeat qq:=rr; rr:=link(rr);
+ @<Check for retracing between knots |qq| and |rr| and |goto not_found|
+ if there is a problem@>;
+ until right_type(rr)=endpoint;
+d:=get_node(dash_node_size);
+if dash_p(p)=0 then info(d):=0 @+else info(d):=p;
+if x_coord(pp)<x_coord(rr) then
+ begin start_x(d):=x_coord(pp);
+ stop_x(d):=x_coord(rr);
+ end
+else begin start_x(d):=x_coord(rr);
+ stop_x(d):=x_coord(pp);
+ end;
+
+@ We also need to check for the case where the segment from |qq| to |rr| is
+monotone in $x$ but is reversed relative to the path from |pp| to |qq|.
+
+@<Check for retracing between knots |qq| and |rr| and |goto not_found|...@>=
+x0:=x_coord(qq);
+x1:=right_x(qq);
+x2:=left_x(rr);
+x3:=x_coord(rr);
+if (x0>x1) or (x1>x2) or (x2>x3) then
+ if (x0<x1) or (x1<x2) or (x2<x3) then
+ if ab_vs_cd(x2-x1,x2-x1,x1-x0,x3-x2)>0 then
+ begin x_retrace_error; goto not_found;
+ end;
+if (x_coord(pp)>x0) or (x0>x3) then
+ if (x_coord(pp)<x0) or (x0<x3) then
+ begin x_retrace_error; goto not_found;
+ end
+
+@ @<Other local variables in |make_dashes|@>=
+@!x0,@!x1,@!x2,@!x3:scaled; {$x$ coordinates of the segment from |qq| to |rr|}
+
+@ @<Make sure |p| and |p0| are the same color and |goto not_found|...@>=
+if (red_val(p)<>red_val(p0)) or@|
+ (green_val(p)<>green_val(p0)) or (blue_val(p)<>blue_val(p0)) then
+ begin print_err("Picture is too complicated to use as a dash pattern");
+ help3("When you say `dashed p', everything in picture p should")@/
+ ("be the same color. I can't handle your color changes")@/
+ ("so I'll just make it a solid line instead.");@/
+ put_get_error;
+ goto not_found;
+ end
+
+@ @<Insert |d| into the dash list and |goto not_found| if there is an error@>=
+start_x(null_dash):=stop_x(d);
+dd:=h; {this makes |link(dd)=dash_list(h)|}
+while start_x(link(dd))<stop_x(d) do
+ dd:=link(dd);
+if dd<>h then
+ if (stop_x(dd)>start_x(d)) then
+ begin x_retrace_error; goto not_found; @+end;
+link(d):=link(dd);
+link(dd):=d
+
+@ @<Set |dash_y(h)| and merge the first and last dashes if necessary@>=
+d:=dash_list(h);
+while (link(d)<>null_dash) do
+ d:=link(d);
+dd:=dash_list(h);
+dash_y(h):=stop_x(d)-start_x(dd);
+if abs(y0)>dash_y(h) then
+ dash_y(h):=abs(y0)
+else if d<>dd then
+ begin dash_list(h):=link(dd);
+ stop_x(d):=stop_x(dd)+dash_y(h);
+ free_node(dd,dash_node_size);
+ end
+
+@ We get here when the argument is a null picture or when there is an error.
+Recovering from an error involves making |dash_list(h)| empty to indicate
+that |h| is not known to be a valid dash pattern. We also dereference |h|
+since it is not being used for the return value.
+
+@<Flush the dash list, recycle |h| and return |null|@>=
+flush_dash_list(h);
+delete_edge_ref(h);
+make_dashes:=null
+
+@ Having carefully saved the dashed stroked nodes in the
+corresponding dash nodes, we must be prepared to break up these dashes into
+smaller dashes.
+
+@<Scan |dash_list(h)| and deal with any dashes that are themselves dashed@>=
+d:=h; {now |link(d)=dash_list(h)|}
+while link(d)<>null_dash do
+ begin ds:=info(link(d));
+ if ds=null then d:=link(d)
+ else begin
+ hh:=dash_p(ds);
+ hsf:=dash_scale(ds);
+ if (hh=null) then confusion("dash1");
+@:this can't happen dash0}{\quad dash1@>
+ if dash_y(hh)=0 then d:=link(d)
+ else begin if dash_list(hh)=null then confusion("dash1");
+@:this can't happen dash0}{\quad dash1@>
+ @<Replace |link(d)| by a dashed version as determined by edge header
+ |hh| and scale factor |ds|@>;
+ end;
+ end;
+ end
+
+@ @<Other local variables in |make_dashes|@>=
+@!dln:pointer; {|link(d)|}
+@!hh:pointer; {an edge header that tells how to break up |dln|}
+@!hsf:scaled; {the dash pattern from |hh| gets scaled by this}
+@!ds:pointer; {the stroked node from which |hh| and |hsf| are derived}
+@!xoff:scaled; {added to $x$ values in |dash_list(hh)| to match |dln|}
+
+@ @<Replace |link(d)| by a dashed version as determined by edge header...@>=
+dln:=link(d);
+dd:=dash_list(hh);
+xoff:=start_x(dln)-take_scaled(hsf,start_x(dd))-
+ take_scaled(hsf,dash_offset(hh));
+start_x(null_dash):=take_scaled(hsf,start_x(dd))+take_scaled(hsf,dash_y(hh));
+stop_x(null_dash):=start_x(null_dash);
+@<Advance |dd| until finding the first dash that overlaps |dln| when
+ offset by |xoff|@>;
+while start_x(dln)<=stop_x(dln) do
+ begin @<If |dd| has `fallen off the end', back up to the beginning and fix
+ |xoff|@>;
+ @<Insert a dash between |d| and |dln| for the overlap with the offset version
+ of |dd|@>;
+ dd:=link(dd);
+ start_x(dln):=xoff+take_scaled(hsf,start_x(dd));
+ end;
+link(d):=link(dln);
+free_node(dln,dash_node_size)
+
+@ The name of this module is a bit of a lie because we actually just find the
+first |dd| where |take_scaled(hsf,stop_x(dd))| is large enough to make an
+overlap possible. It could be that the unoffset version of dash |dln| falls
+in the gap between |dd| and its predecessor.
+
+@<Advance |dd| until finding the first dash that overlaps |dln| when...@>=
+while xoff+take_scaled(hsf,stop_x(dd))<start_x(dln) do
+ dd:=link(dd)
+
+@ @<If |dd| has `fallen off the end', back up to the beginning and fix...@>=
+if dd=null_dash then
+ begin dd:=dash_list(hh);
+ xoff:=xoff+take_scaled(hsf,dash_y(hh));
+ end
+
+@ At this point we already know that
+|start_x(dln)<=xoff+take_scaled(hsf,stop_x(dd))|.
+
+@<Insert a dash between |d| and |dln| for the overlap with the offset...@>=
+if xoff+take_scaled(hsf,start_x(dd))<=stop_x(dln) then
+ begin link(d):=get_node(dash_node_size);
+ d:=link(d);
+ link(d):=dln;
+ if start_x(dln)>xoff+take_scaled(hsf,start_x(dd))
+ then start_x(d):=start_x(dln)
+ else start_x(d):=xoff+take_scaled(hsf,start_x(dd));
+ if stop_x(dln)<xoff+take_scaled(hsf,stop_x(dd)) then stop_x(d):=stop_x(dln)
+ else stop_x(d):=xoff+take_scaled(hsf,stop_x(dd));
+ end
+
+@ The next major task is to update the bounding box information in an edge
+header~|h|. This is done via a procedure |adjust_bbox| that enlarges an edge
+header's bounding box to accommodate the box computed by |path_bbox| or
+|pen_bbox|. (This is stored in global variables |minx|, |miny|, |maxx|, and
+|maxy|.)
+
+@p procedure adjust_bbox(h:pointer);
+begin if minx<minx_val(h) then minx_val(h):=minx;
+if miny<miny_val(h) then miny_val(h):=miny;
+if maxx>maxx_val(h) then maxx_val(h):=maxx;
+if maxy>maxy_val(h) then maxy_val(h):=maxy;
+end;
+
+@ Here is a special routine for updating the bounding box information in
+edge header~|h| to account for the squared-off ends of a non-cyclic path~|p|
+that is to be stroked with the pen~|pp|.
+
+@p procedure box_ends(@!p, @!pp, @!h:pointer);
+label exit;
+var @!q:pointer; {a knot node adjacent to knot |p|}
+@!dx,@!dy:fraction; {a unit vector in the direction out of the path at~|p|}
+@!d:scaled; {a factor for adjusting the length of |(dx,dy)|}
+@!z:scaled; {a coordinate being tested against the bounding box}
+@!xx,@!yy:scaled; {the extreme pen vertex in the |(dx,dy)| direction}
+@!i:integer; {a loop counter}
+begin if right_type(p)<>endpoint then
+ begin q:=link(p);
+ loop @+begin @<Make |(dx,dy)| the final direction for the path segment from
+ |q| to~|p|; set~|d|@>;
+ d:=pyth_add(dx,dy);
+ if d>0 then
+ begin @<Normalize the direction |(dx,dy)| and find the pen offset
+ |(xx,yy)|@>;
+ for i:=1 to 2 do
+ begin @<Use |(dx,dy)| to generate a vertex of the square end cap and
+ update the bounding box to accommodate it@>;@/
+ dx:=-dx; dy:=-dy;
+ end;
+ end;
+ if right_type(p)=endpoint then return
+ else @<Advance |p| to the end of the path and make |q| the previous knot@>;
+ end;
+ end;
+exit: ;
+end;
+
+@ @<Make |(dx,dy)| the final direction for the path segment from...@>=
+if q=link(p) then
+ begin dx:=x_coord(p)-right_x(p);
+ dy:=y_coord(p)-right_y(p);
+ if (dx=0)and(dy=0) then
+ begin dx:=x_coord(p)-left_x(q);
+ dy:=y_coord(p)-left_y(q);
+ end;
+ end
+else begin dx:=x_coord(p)-left_x(p);
+ dy:=y_coord(p)-left_y(p);
+ if (dx=0)and(dy=0) then
+ begin dx:=x_coord(p)-right_x(q);
+ dy:=y_coord(p)-right_y(q);
+ end;
+ end;
+dx:=x_coord(p)-x_coord(q);
+dy:=y_coord(p)-y_coord(q)
+
+@ @<Normalize the direction |(dx,dy)| and find the pen offset |(xx,yy)|@>=
+dx:=make_fraction(dx,d);
+dy:=make_fraction(dy,d);@/
+find_offset(-dy,dx,pp);
+xx:=cur_x; yy:=cur_y
+
+@ @<Use |(dx,dy)| to generate a vertex of the square end cap and...@>=
+find_offset(dx,dy,pp);
+d:=take_fraction(xx-cur_x,dx)+take_fraction(yy-cur_y,dy);
+if (d<0)and(i=1) or (d>0)and(i=2) then confusion("box_ends");
+@:this can't happen box ends}{\quad\\{box_ends}@>
+z:=x_coord(p)+cur_x+take_fraction(d,dx);
+if z<minx_val(h) then minx_val(h):=z;
+if z>maxx_val(h) then maxx_val(h):=z;
+z:=y_coord(p)+cur_y+take_fraction(d,dy);
+if z<miny_val(h) then miny_val(h):=z;
+if z>maxy_val(h) then maxy_val(h):=z
+
+@ @<Advance |p| to the end of the path and make |q| the previous knot@>=
+repeat q:=p;
+p:=link(p);
+until right_type(p)=endpoint
+
+@ The major difficulty in finding the bounding box of an edge structure is the
+effect of clipping paths. We treat them conservatively by only clipping to the
+clipping path's bounding box, but this still
+requires recursive calls to |set_bbox| in order to find the bounding box of
+@^recursion@>
+the objects to be clipped. Such calls are distinguished by the fact that the
+boolean parameter |top_level| is false.
+
+@p procedure set_bbox(@!h:pointer;top_level:boolean);
+label exit;
+var @!p:pointer; {a graphical object being considered}
+@!sminx,@!sminy,@!smaxx,@!smaxy:scaled;
+ {for saving the bounding box during recursive calls}
+@!x0,@!x1,@!y0,@!y1:scaled; {temporary registers}
+@!lev:integer; {nesting level for |start_bounds_code| nodes}
+begin @<Wipe out any existing bounding box information if |bbtype(h)| is
+ incompatible with |internal[true_corners]|@>;
+while link(bblast(h))<>null do
+ begin p:=link(bblast(h));
+ bblast(h):=p;
+ case type(p) of
+ stop_clip_code: if top_level then confusion("bbox") @+else return;
+@:this can't happen bbox}{\quad bbox@>
+ @<Other cases for updating the bounding box based on the type of object |p|@>@;
+ end; {all cases are enumerated above}
+ end;
+if not top_level then confusion("bbox");
+exit:end;
+
+@ @<Wipe out any existing bounding box information if |bbtype(h)| is...@>=
+case bbtype(h) of
+no_bounds: do_nothing;
+bounds_set: if internal[true_corners]>0 then init_bbox(h);
+bounds_unset: if internal[true_corners]<=0 then init_bbox(h);
+end {there are no other cases}
+
+@ @<Other cases for updating the bounding box...@>=
+fill_code: begin path_bbox(path_p(p));
+ if pen_p(p)<>null then
+ begin x0:=minx; y0:=miny;
+ x1:=maxx; y1:=maxy;
+ pen_bbox(pen_p(p));
+ minx:=minx+x0;
+ miny:=miny+y0;
+ maxx:=maxx+x1;
+ maxy:=maxy+y1;
+ end;
+ adjust_bbox(h);
+ end;
+
+@ @<Other cases for updating the bounding box...@>=
+start_bounds_code: if internal[true_corners]>0 then bbtype(h):=bounds_unset
+ else begin bbtype(h):=bounds_set;
+ path_bbox(path_p(p));
+ adjust_bbox(h);
+ @<Scan to the matching |stop_bounds_code| node and update |p| and
+ |bblast(h)|@>;
+ end;
+stop_bounds_code: if internal[true_corners]<=0 then confusion("bbox2");
+@:this can't happen bbox2}{\quad bbox2@>
+
+@ @<Scan to the matching |stop_bounds_code| node and update |p| and...@>=
+lev:=1;
+while lev<>0 do
+ begin if link(p)=null then confusion("bbox2");
+@:this can't happen bbox2}{\quad bbox2@>
+ p:=link(p);
+ if type(p)=start_bounds_code then incr(lev)
+ else if type(p)=stop_bounds_code then decr(lev);
+ end;
+bblast(h):=p
+
+@ It saves a lot of grief here to be slightly conservative and not account for
+omitted parts of dashed lines. We also don't worry about the material omitted
+when using butt end caps. The basic computation is for round end caps and
+|box_ends| augments it for square end caps.
+
+@<Other cases for updating the bounding box...@>=
+stroked_code: begin path_bbox(path_p(p));
+ x0:=minx; y0:=miny;
+ x1:=maxx; y1:=maxy;
+ pen_bbox(pen_p(p));
+ minx:=minx+x0;
+ miny:=miny+y0;
+ maxx:=maxx+x1;
+ maxy:=maxy+y1;
+ adjust_bbox(h);
+ if (left_type(path_p(p))=endpoint)and(lcap_val(p)=2) then
+ box_ends(path_p(p), pen_p(p), h);
+ end;
+
+@ The height width and depth information stored in a text node determines a
+rectangle that needs to be transformed according to the transformation
+parameters stored in the text node.
+
+@<Other cases for updating the bounding box...@>=
+text_code: begin x1:=take_scaled(txx_val(p),width_val(p));
+ y0:=take_scaled(txy_val(p),-depth_val(p));
+ y1:=take_scaled(txy_val(p),height_val(p));
+ minx:=tx_val(p);
+ maxx:=minx;
+ if y0<y1 then
+ begin minx:=minx+y0; maxx:=maxx+y1; @+end
+ else begin minx:=minx+y1; maxx:=maxx+y0; @+end;
+ if x1<0 then minx:=minx+x1 @+else maxx:=maxx+x1;
+ x1:=take_scaled(tyx_val(p),width_val(p));
+ y0:=take_scaled(tyy_val(p),-depth_val(p));
+ y1:=take_scaled(tyy_val(p),height_val(p));
+ miny:=ty_val(p);
+ maxy:=miny;
+ if y0<y1 then
+ begin miny:=miny+y0; maxy:=maxy+y1; @+end
+ else begin miny:=miny+y1; maxy:=maxy+y0; @+end;
+ if x1<0 then miny:=miny+x1 @+else maxy:=maxy+x1;
+ adjust_bbox(h);
+ end;
+
+@ This case involves a recursive call that advances |bblast(h)| to the node of
+type |stop_clip_code| that matches |p|.
+
+@<Other cases for updating the bounding box...@>=
+start_clip_code: begin path_bbox(path_p(p));@/
+ x0:=minx; y0:=miny;
+ x1:=maxx; y1:=maxy;@/
+ sminx:=minx_val(h); sminy:=miny_val(h);
+ smaxx:=maxx_val(h); smaxy:=maxy_val(h);@/
+ @<Reinitialize the bounding box in header |h| and call |set_bbox| recursively
+ starting at |link(p)|@>;
+ @<Clip the bounding box in |h| to the rectangle given by |x0|, |x1|,
+ |y0|, |y1|@>;
+ minx:=sminx; miny:=sminy;
+ maxx:=smaxx; maxy:=smaxy;
+ adjust_bbox(h);
+ end;
+
+@ @<Reinitialize the bounding box in header |h| and call |set_bbox|...@>=
+minx_val(h):=el_gordo;
+miny_val(h):=el_gordo;
+maxx_val(h):=-el_gordo;
+maxy_val(h):=-el_gordo;@/
+set_bbox(h,false)
+
+@ @<Clip the bounding box in |h| to the rectangle given by |x0|, |x1|,...@>=
+if minx_val(h)<x0 then minx_val(h):=x0;
+if miny_val(h)<y0 then miny_val(h):=y0;
+if maxx_val(h)>x1 then maxx_val(h):=x1;
+if maxy_val(h)>y1 then maxy_val(h):=y1
+
+@* \[22] Finding an envelope.
+When \MP\ has a path and a polygonal pen, it needs to express the desired
+shape in terms of things \ps\ can understand. The present task is to compute
+a new path that describes the region to be filled. It is convenient to
+define this as a two step process where the first step is determining what
+offset to use for each segment of the path.
+
+@ Given a pointer |c| to a cyclic path,
+and a pointer~|h| to the first knot of a pen polygon,
+the |offset_prep| routine changes the path into cubics that are
+associated with particular pen offsets. Thus if the cubic between |p|
+and~|q| is associated with the |k|th offset and the cubic between |q| and~|r|
+has offset |l| then |info(q)=zero_off+l-k|. (The constant |zero_off| is added
+to because |l-k| could be negative.)
+
+After overwriting the type information with offset differences, we no longer
+have a true path so we refer to the knot list returned by |offset_prep| as an
+``envelope spec.''
+@!@^envelope spec@>
+Since an envelope spec only determines relative changes in pen offsets,
+|offset_prep| sets a global variable |spec_offset| to the relative change from
+|h| to the first offset.
+
+@d zero_off=16384 {added to offset changes to make them positive}
+
+@<Glob...@>=
+spec_offset:integer; {number of pen edges between |h| and the initial offset}
+
+@ @p @t\4@>@<Declare subroutines needed by |offset_prep|@>@;
+function offset_prep(@!c,@!h:pointer):pointer;
+label not_found;
+var @!n:halfword; {the number of vertices in the pen polygon}
+@!p,@!q,@!r,@!w,@!ww:pointer; {for list manipulation}
+@!k_needed:integer; {amount to be added to |info(p)| when it is computed}
+@!w0:pointer; {a pointer to pen offset to use just before |p|}
+@!dxin,@!dyin:scaled; {the direction into knot |p|}
+@!turn_amt:integer; {change in pen offsets for the current cubic}
+@<Other local variables for |offset_prep|@>@;
+begin @<Initialize the pen size~|n|@>;
+@<Initialize the incoming direction and pen offset at |c|@>;
+p:=c; k_needed:=0;
+repeat q:=link(p);
+@<Split the cubic between |p| and |q|, if necessary, into cubics
+ associated with single offsets, after which |q| should
+ point to the end of the final such cubic@>;
+@<Advance |p| to node |q|, removing any ``dead'' cubics that
+ might have been introduced by the splitting process@>;
+until q=c;
+@<Fix the offset change in |info(c)| and set the return value of
+ |offset_prep|@>;
+end;
+
+@ We shall want to keep track of where certain knots on the cyclic path
+wind up in the envelope spec. It doesn't suffice just to keep pointers to
+knot nodes because some nodes are deleted while removing dead cubics. Thus
+|offset_prep| updates the following pointers
+
+@<Glob...@>=
+@!spec_p1,@!spec_p2:pointer; {pointers to distinguished knots}
+
+@ @<Set init...@>=
+spec_p1:=null; spec_p2:=null;
+
+@ @<Initialize the pen size~|n|@>=
+n:=0; p:=h;
+repeat incr(n);
+p:=link(p);
+until p=h
+
+@ Since the true incoming direction isn't known yet, we just pick a direction
+consistent with the pen offset~|h|. If this is wrong, it can be corrected
+later.
+
+@<Initialize the incoming direction and pen offset at |c|@>=
+dxin:=x_coord(link(h))-x_coord(knil(h));
+dyin:=y_coord(link(h))-y_coord(knil(h));
+if (dxin=0)and(dyin=0) then
+ begin dxin:=y_coord(knil(h))-y_coord(h);
+ dyin:=x_coord(h)-x_coord(knil(h));
+ end;
+w0:=h
+
+@ We must be careful not to remove the only cubic in a cycle.
+
+But we must also be careful for another reason. If the user-supplied
+path starts with a set of degenerate cubics, these should not be removed
+because at this point we cannot do so cleanly. The relevant bug is
+tracker id 267, bugs 52c, reported by Boguslav.
+
+@<Advance |p| to node |q|, removing any ``dead'' cubics...@>=
+repeat r:=link(p);
+if x_coord(p)=right_x(p) then if y_coord(p)=right_y(p) then
+ if x_coord(p)=left_x(r) then if y_coord(p)=left_y(r) then
+ if x_coord(p)=x_coord(r) then if y_coord(p)=y_coord(r) then
+ if r<>p then if ((r<>q) or (originator(r)<>metapost_user)) then
+ @<Remove the cubic following |p| and update the data structures
+ to merge |r| into |p|@>;
+p:=r;
+until p=q
+
+@ @<Remove the cubic following |p| and update the data structures...@>=
+begin k_needed:=info(p)-zero_off;
+if r=q then q:=p
+else begin info(p):=k_needed+info(r);
+ k_needed:=0;
+ end;
+if r=c then
+ begin info(p):=info(c); c:=p;
+ end;
+if r=spec_p1 then spec_p1:=p;
+if r=spec_p2 then spec_p2:=p;
+r:=p; remove_cubic(p);
+end
+
+@ Not setting the |info| field of the newly created knot allows the splitting
+routine to work for paths.
+
+@<Declare subroutines needed by |offset_prep|@>=
+procedure split_cubic(@!p:pointer;@!t:fraction); {splits the cubic after |p|}
+var @!v:scaled; {an intermediate value}
+@!q,@!r:pointer; {for list manipulation}
+begin q:=link(p); r:=get_node(knot_node_size); link(p):=r; link(r):=q;@/
+originator(r):=program_code;@/
+left_type(r):=explicit; right_type(r):=explicit;@#
+v:=t_of_the_way(right_x(p))(left_x(q));
+right_x(p):=t_of_the_way(x_coord(p))(right_x(p));
+left_x(q):=t_of_the_way(left_x(q))(x_coord(q));
+left_x(r):=t_of_the_way(right_x(p))(v);
+right_x(r):=t_of_the_way(v)(left_x(q));
+x_coord(r):=t_of_the_way(left_x(r))(right_x(r));@#
+v:=t_of_the_way(right_y(p))(left_y(q));
+right_y(p):=t_of_the_way(y_coord(p))(right_y(p));
+left_y(q):=t_of_the_way(left_y(q))(y_coord(q));
+left_y(r):=t_of_the_way(right_y(p))(v);
+right_y(r):=t_of_the_way(v)(left_y(q));
+y_coord(r):=t_of_the_way(left_y(r))(right_y(r));
+end;
+
+@ This does not set |info(p)| or |right_type(p)|.
+
+@<Declare subroutines needed by |offset_prep|@>=
+procedure remove_cubic(@!p:pointer); {removes the dead cubic following~|p|}
+var @!q:pointer; {the node that disappears}
+begin q:=link(p); link(p):=link(q);@/
+right_x(p):=right_x(q); right_y(p):=right_y(q);@/
+free_node(q,knot_node_size);
+end;
+
+@ Let $d\prec d'$ mean that the counter-clockwise angle from $d$ to~$d'$ is
+strictly between zero and $180^\circ$. Then we can define $d\preceq d'$ to
+mean that the angle could be zero or $180^\circ$. If $w_k=(u_k,v_k)$ is the
+$k$th pen offset, the $k$th pen edge direction is defined by the formula
+$$d_k=(u\k-u_k,\,v\k-v_k).$$
+When listed by increasing $k$, these directions occur in counter-clockwise
+order so that $d_k\preceq d\k$ for all~$k$.
+The goal of |offset_prep| is to find an offset index~|k| to associate with
+each cubic, such that the direction $d(t)$ of the cubic satisfies
+$$d_{k-1}\preceq d(t)\preceq d_k\qquad\hbox{for $0\le t\le 1$.}\eqno(*)$$
+We may have to split a cubic into many pieces before each
+piece corresponds to a unique offset.
+
+@<Split the cubic between |p| and |q|, if necessary, into cubics...@>=
+info(p):=zero_off+k_needed;
+k_needed:=0;@/
+@<Prepare for derivative computations;
+ |goto not_found| if the current cubic is dead@>;
+@<Find the initial direction |(dx,dy)|@>;
+@<Update |info(p)| and find the offset $w_k$ such that
+ $d_{k-1}\preceq(\\{dx},\\{dy})\prec d_k$; also advance |w0| for
+ the direction change at |p|@>;
+@<Find the final direction |(dxin,dyin)|@>;
+@<Decide on the net change in pen offsets and set |turn_amt|@>;
+@<Complete the offset splitting process@>;@/
+w0:=pen_walk(w0,turn_amt);
+not_found: do_nothing
+
+@ @<Declare subroutines needed by |offset_prep|@>=
+function pen_walk(@!w:pointer;@!k:integer):pointer;
+ {walk |k| steps around a pen from |w|}
+begin while k>0 do begin w:=link(w); decr(k); @+end;
+while k<0 do begin w:=knil(w); incr(k); @+end;
+pen_walk:=w;
+end;
+
+@ The direction of a cubic $B(z_0,z_1,z_2,z_3;t)=\bigl(x(t),y(t)\bigr)$ can be
+calculated from the quadratic polynomials
+${1\over3}x'(t)=B(x_1-x_0,x_2-x_1,x_3-x_2;t)$ and
+${1\over3}y'(t)=B(y_1-y_0,y_2-y_1,y_3-y_2;t)$.
+Since we may be calculating directions from several cubics
+split from the current one, it is desirable to do these calculations
+without losing too much precision. ``Scaled up'' values of the
+derivatives, which will be less tainted by accumulated errors than
+derivatives found from the cubics themselves, are maintained in
+local variables |x0|, |x1|, and |x2|, representing $X_0=2^l(x_1-x_0)$,
+$X_1=2^l(x_2-x_1)$, and $X_2=2^l(x_3-x_2)$; similarly |y0|, |y1|, and~|y2|
+represent $Y_0=2^l(y_1-y_0)$, $Y_1=2^l(y_2-y_1)$, and $Y_2=2^l(y_3-y_2)$.
+
+@<Other local variables for |offset_prep|@>=
+@!x0,@!x1,@!x2,@!y0,@!y1,@!y2:integer; {representatives of derivatives}
+@!t0,@!t1,@!t2:integer; {coefficients of polynomial for slope testing}
+@!du,@!dv,@!dx,@!dy:integer; {for directions of the pen and the curve}
+@!dx0,@!dy0:integer; {initial direction for the first cubic in the curve}
+@!max_coef:integer; {used while scaling}
+@!x0a,@!x1a,@!x2a,@!y0a,@!y1a,@!y2a:integer; {intermediate values}
+@!t:fraction; {where the derivative passes through zero}
+@!s:fraction; {a temporary value}
+
+@ @<Prepare for derivative computations...@>=
+x0:=right_x(p)-x_coord(p);
+x2:=x_coord(q)-left_x(q);
+x1:=left_x(q)-right_x(p);
+y0:=right_y(p)-y_coord(p); y2:=y_coord(q)-left_y(q);
+y1:=left_y(q)-right_y(p);
+max_coef:=abs(x0);
+if abs(x1)>max_coef then max_coef:=abs(x1);
+if abs(x2)>max_coef then max_coef:=abs(x2);
+if abs(y0)>max_coef then max_coef:=abs(y0);
+if abs(y1)>max_coef then max_coef:=abs(y1);
+if abs(y2)>max_coef then max_coef:=abs(y2);
+if max_coef=0 then goto not_found;
+while max_coef<fraction_half do
+ begin double(max_coef);
+ double(x0); double(x1); double(x2);
+ double(y0); double(y1); double(y2);
+ end
+
+@ Let us first solve a special case of the problem: Suppose we
+know an index~$k$ such that either (i)~$d(t)\succeq d_{k-1}$ for all~$t$
+and $d(0)\prec d_k$, or (ii)~$d(t)\preceq d_k$ for all~$t$ and
+$d(0)\succ d_{k-1}$.
+Then, in a sense, we're halfway done, since one of the two relations
+in $(*)$ is satisfied, and the other couldn't be satisfied for
+any other value of~|k|.
+
+Actually, the conditions can be relaxed somewhat since a relation such as
+$d(t)\succeq d_{k-1}$ restricts $d(t)$ to a half plane when all that really
+matters is whether $d(t)$ crosses the ray in the $d_{k-1}$ direction from
+the origin. The condition for case~(i) becomes $d_{k-1}\preceq d(0)\prec d_k$
+and $d(t)$ never crosses the $d_{k-1}$ ray in the clockwise direction.
+Case~(ii) is similar except $d(t)$ cannot cross the $d_k$ ray in the
+counterclockwise direction.
+
+The |fin_offset_prep| subroutine solves the stated subproblem.
+It has a parameter called |rise| that is |1| in
+case~(i), |-1| in case~(ii). Parameters |x0| through |y2| represent
+the derivative of the cubic following |p|.
+The |w| parameter should point to offset~$w_k$ and |info(p)| should already
+be set properly. The |turn_amt| parameter gives the absolute value of the
+overall net change in pen offsets.
+
+@<Declare subroutines needed by |offset_prep|@>=
+procedure fin_offset_prep(@!p:pointer;@!w:pointer;
+ @!x0,@!x1,@!x2,@!y0,@!y1,@!y2:integer;@!rise,@!turn_amt:integer);
+label exit;
+var @!ww:pointer; {for list manipulation}
+@!du,@!dv:scaled; {for slope calculation}
+@!t0,@!t1,@!t2:integer; {test coefficients}
+@!t:fraction; {place where the derivative passes a critical slope}
+@!s:fraction; {slope or reciprocal slope}
+@!v:integer; {intermediate value for updating |x0..y2|}
+@!q:pointer; {original |link(p)|}
+begin q:=link(p);
+loop @+begin if rise>0 then ww:=link(w) {a pointer to $w\k$}
+ else ww:=knil(w); {a pointer to $w_{k-1}$}
+ @<Compute test coefficients |(t0,t1,t2)|
+ for $d(t)$ versus $d_k$ or $d_{k-1}$@>;
+ t:=crossing_point(t0,t1,t2);
+ if t>=fraction_one then
+ if turn_amt>0 then t:=fraction_one @+else return;
+ @<Split the cubic at $t$,
+ and split off another cubic if the derivative crosses back@>;
+ w:=ww;
+ end;
+exit:end;
+
+@ We want $B(\\{t0},\\{t1},\\{t2};t)$ to be the dot product of $d(t)$ with a
+$-90^\circ$ rotation of the vector from |w| to |ww|. This makes the resulting
+function cross from positive to negative when $d_{k-1}\preceq d(t)\preceq d_k$
+begins to fail.
+
+@<Compute test coefficients |(t0,t1,t2)| for $d(t)$ versus...@>=
+du:=x_coord(ww)-x_coord(w); dv:=y_coord(ww)-y_coord(w);
+if abs(du)>=abs(dv) then
+ begin s:=make_fraction(dv,du);
+ t0:=take_fraction(x0,s)-y0;
+ t1:=take_fraction(x1,s)-y1;
+ t2:=take_fraction(x2,s)-y2;
+ if du<0 then begin negate(t0); negate(t1); negate(t2); @+end
+ end
+else begin s:=make_fraction(du,dv);
+ t0:=x0-take_fraction(y0,s);
+ t1:=x1-take_fraction(y1,s);
+ t2:=x2-take_fraction(y2,s);
+ if dv<0 then begin negate(t0); negate(t1); negate(t2); @+end
+ end;
+if t0<0 then t0:=0 {should be positive without rounding error}
+
+@ The curve has crossed $d_k$ or $d_{k-1}$; its initial segment satisfies
+$(*)$, and it might cross again, yielding another solution of $(*)$.
+
+@<Split the cubic at $t$, and split off another...@>=
+begin split_cubic(p,t); p:=link(p); info(p):=zero_off+rise;
+decr(turn_amt);@/
+v:=t_of_the_way(x0)(x1); x1:=t_of_the_way(x1)(x2);
+x0:=t_of_the_way(v)(x1);@/
+v:=t_of_the_way(y0)(y1); y1:=t_of_the_way(y1)(y2);
+y0:=t_of_the_way(v)(y1);@/
+if turn_amt<0 then
+ begin t1:=t_of_the_way(t1)(t2);
+ if t1>0 then t1:=0; {without rounding error, |t1| would be |<=0|}
+ t:=crossing_point(0,-t1,-t2);
+ if t>fraction_one then t:=fraction_one;
+ incr(turn_amt);
+ if (t=fraction_one)and(link(p)<>q) then
+ info(link(p)):=info(link(p))-rise
+ else begin split_cubic(p,t); info(link(p)):=zero_off-rise;@/
+ v:=t_of_the_way(x1)(x2); x1:=t_of_the_way(x0)(x1);
+ x2:=t_of_the_way(x1)(v);@/
+ v:=t_of_the_way(y1)(y2); y1:=t_of_the_way(y0)(y1);
+ y2:=t_of_the_way(y1)(v);@/
+ end;
+ end;
+end
+
+@ Now we must consider the general problem of |offset_prep|, when
+nothing is known about a given cubic. We start by finding its
+direction in the vicinity of |t=0|.
+
+If $z'(t)=0$, the given cubic is numerically unstable but |offset_prep|
+has not yet introduced any more numerical errors. Thus we can compute
+the true initial direction for the given cubic, even if it is almost
+degenerate.
+
+@<Find the initial direction |(dx,dy)|@>=
+dx:=x0; dy:=y0;
+if dx=0 then if dy=0 then
+ begin dx:=x1; dy:=y1;
+ if dx=0 then if dy=0 then
+ begin dx:=x2; dy:=y2;
+ end;
+ end;
+if p=c then begin dx0:=dx; dy0:=dy; @+end
+
+@ @<Find the final direction |(dxin,dyin)|@>=
+dxin:=x2; dyin:=y2;
+if dxin=0 then if dyin=0 then
+ begin dxin:=x1; dyin:=y1;
+ if dxin=0 then if dyin=0 then
+ begin dxin:=x0; dyin:=y0;
+ end;
+ end
+
+@ The next step is to bracket the initial direction between consecutive
+edges of the pen polygon. We must be careful to turn clockwise only if
+this makes the turn less than $180^\circ$. (A $180^\circ$ turn must be
+counter-clockwise in order to make \&{doublepath} envelopes come out
+@:double_path_}{\&{doublepath} primitive@>
+right.) This code depends on |w0| being the offset for |(dxin,dyin)|.
+
+@<Update |info(p)| and find the offset $w_k$ such that...@>=
+turn_amt:=get_turn_amt(w0, dx, dy, ab_vs_cd(dy,dxin,dx,dyin)>=0);
+w:=pen_walk(w0, turn_amt);
+w0:=w;
+info(p):=info(p)+turn_amt
+
+@ Decide how many pen offsets to go away from |w| in order to find the offset
+for |(dx,dy)|, going counterclockwise if |ccw| is |true|. This assumes that
+|w| is the offset for some direction $(x',y')$ from which the angle to |(dx,dy)|
+in the sense determined by |ccw| is less than or equal to $180^\circ$.
+
+If the pen polygon has only two edges, they could both be parallel
+to |(dx,dy)|. In this case, we must be careful to stop after crossing the first
+such edge in order to avoid an infinite loop.
+
+@<Declare subroutines needed by |offset_prep|@>=
+function get_turn_amt(@!w:pointer; @!dx,@!dy:scaled; ccw:boolean):integer;
+label done;
+var @!ww:pointer; {a neighbor of knot~|w|}
+@!s:integer; {turn amount so far}
+@!t:integer; {|ab_vs_cd| result}
+begin s:=0;
+if ccw then
+ begin ww:=link(w);
+ repeat t:=ab_vs_cd(dy,x_coord(ww)-x_coord(w),@| dx,y_coord(ww)-y_coord(w));
+ if t<0 then goto done;
+ incr(s);
+ w:=ww; ww:=link(ww);
+ until t<=0;
+ done: end
+else begin ww:=knil(w);
+ while ab_vs_cd(dy,x_coord(w)-x_coord(ww),@|
+ dx,y_coord(w)-y_coord(ww))<0 do
+ begin decr(s);
+ w:=ww; ww:=knil(ww);
+ end;
+ end;
+get_turn_amt:=s;
+end;
+
+@ When we're all done, the final offset is |w0| and the final curve direction
+is |(dxin,dyin)|. With this knowledge of the incoming direction at |c|, we
+can correct |info(c)| which was erroneously based on an incoming offset
+of~|h|.
+
+@d fix_by(#)==info(c):=info(c)+#
+
+@<Fix the offset change in |info(c)| and set the return value of...@>=
+spec_offset:=info(c)-zero_off;
+if link(c)=c then info(c):=zero_off+n
+else begin fix_by(k_needed);
+ while w0<>h do
+ begin fix_by(1); w0:=link(w0); @+end;
+ while info(c)<=zero_off-n do fix_by(n);
+ while info(c)>zero_off do fix_by(-n);
+ if (info(c)<>zero_off)and(ab_vs_cd(dy0,dxin,dx0,dyin)>=0) then fix_by(n);
+ end;
+offset_prep:=c
+
+@ Finally we want to reduce the general problem to situations that
+|fin_offset_prep| can handle. We split the cubic into at most three parts
+with respect to $d_{k-1}$, and apply |fin_offset_prep| to each part.
+
+@<Complete the offset splitting process@>=
+ww:=knil(w);
+@<Compute test coeff...@>;
+@<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set
+ |t:=fraction_one+1|@>;
+if t>fraction_one then
+ fin_offset_prep(p,w,x0,x1,x2,y0,y1,y2,1,turn_amt)
+else begin split_cubic(p,t); r:=link(p);@/
+ x1a:=t_of_the_way(x0)(x1); x1:=t_of_the_way(x1)(x2);
+ x2a:=t_of_the_way(x1a)(x1);@/
+ y1a:=t_of_the_way(y0)(y1); y1:=t_of_the_way(y1)(y2);
+ y2a:=t_of_the_way(y1a)(y1);@/
+ fin_offset_prep(p,w,x0,x1a,x2a,y0,y1a,y2a,1,0); x0:=x2a; y0:=y2a;
+ info(r):=zero_off-1;
+ if turn_amt>=0 then
+ begin t1:=t_of_the_way(t1)(t2);
+ if t1>0 then t1:=0;
+ t:=crossing_point(0,-t1,-t2);
+ if t>fraction_one then t:=fraction_one;
+ @<Split off another rising cubic for |fin_offset_prep|@>;
+ fin_offset_prep(r,ww,x0,x1,x2,y0,y1,y2,-1,0);
+ end
+ else fin_offset_prep(r,ww,x0,x1,x2,y0,y1,y2,-1,-1-turn_amt);
+ end
+
+@ @<Split off another rising cubic for |fin_offset_prep|@>=
+split_cubic(r,t); info(link(r)):=zero_off+1;@/
+x1a:=t_of_the_way(x1)(x2); x1:=t_of_the_way(x0)(x1);
+x0a:=t_of_the_way(x1)(x1a);@/
+y1a:=t_of_the_way(y1)(y2); y1:=t_of_the_way(y0)(y1);
+y0a:=t_of_the_way(y1)(y1a);@/
+fin_offset_prep(link(r),w,x0a,x1a,x2,y0a,y1a,y2,1,turn_amt);
+x2:=x0a; y2:=y0a
+
+@ At this point, the direction of the incoming pen edge is |(-du,-dv)|.
+When the component of $d(t)$ perpendicular to |(-du,-dv)| crosses zero, we
+need to decide whether the directions are parallel or antiparallel. We
+can test this by finding the dot product of $d(t)$ and |(-du,-dv)|, but this
+should be avoided when the value of |turn_amt| already determines the
+answer. If |t2<0|, there is one crossing and it is antiparallel only if
+|turn_amt>=0|. If |turn_amt<0|, there should always be at least one
+crossing and the first crossing cannot be antiparallel.
+
+@<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set...@>=
+t:=crossing_point(t0,t1,t2);
+if turn_amt>=0 then
+ if t2<0 then t:=fraction_one+1
+ else begin u0:=t_of_the_way(x0)(x1);
+ u1:=t_of_the_way(x1)(x2);
+ ss:=take_fraction(-du,t_of_the_way(u0)(u1));@/
+ v0:=t_of_the_way(y0)(y1);
+ v1:=t_of_the_way(y1)(y2);
+ ss:=ss+take_fraction(-dv,t_of_the_way(v0)(v1));@/
+ if ss<0 then t:=fraction_one+1;
+ end
+else if t>fraction_one then t:=fraction_one;
+
+@ @<Other local variables for |offset_prep|@>=
+@!u0,@!u1,@!v0,@!v1:integer; {intermediate values for $d(t)$ calculation}
+@!ss:integer; {the part of the dot product computed so far}
+@!d_sign:-1..1; {sign of overall change in direction for this cubic}
+
+@ If the cubic almost has a cusp, it is a numerically ill-conditioned
+problem to decide which way it loops around but that's OK as long we're
+consistent. To make \&{doublepath} envelopes work properly, reversing
+the path should always change the sign of |turn_amt|.
+
+@<Decide on the net change in pen offsets and set |turn_amt|@>=
+d_sign:=ab_vs_cd(dx,dyin, dxin,dy);
+if d_sign=0 then
+ if dx=0 then
+ if dy>0 then d_sign:=1 @+else d_sign:=-1
+ else if dx>0 then d_sign:=1 @+else d_sign:=-1;
+@<Make |ss| negative if and only if the total change in direction is
+ more than $180^\circ$@>;
+turn_amt:=get_turn_amt(w, dxin, dyin, d_sign>0);
+if ss<0 then turn_amt:=turn_amt-d_sign*n
+
+@ In order to be invariant under path reversal, the result of this computation
+should not change when |x0|, |y0|, $\ldots$ are all negated and |(x0,y0)| is
+then swapped with |(x2,y2)|. We make use of the identities
+|take_fraction(-a,-b)=take_fraction(a,b)| and
+|t_of_the_way(-a)(-b)=-(t_of_the_way(a)(b))|.
+
+@<Make |ss| negative if and only if the total change in direction is...@>=
+t0:=half(take_fraction(x0,y2))-half(take_fraction(x2,y0));@/
+t1:=half(take_fraction(x1,y0+y2))-half(take_fraction(y1,x0+x2));@/
+if t0=0 then t0:=d_sign; {path reversal always negates |d_sign|}
+if t0>0 then
+ begin t:=crossing_point(t0,t1,-t0);
+ u0:=t_of_the_way(x0)(x1);
+ u1:=t_of_the_way(x1)(x2);@/
+ v0:=t_of_the_way(y0)(y1);
+ v1:=t_of_the_way(y1)(y2);
+ end
+else begin t:=crossing_point(-t0,t1,t0);
+ u0:=t_of_the_way(x2)(x1);
+ u1:=t_of_the_way(x1)(x0);@/
+ v0:=t_of_the_way(y2)(y1);
+ v1:=t_of_the_way(y1)(y0);
+ end;
+ss:=take_fraction(x0+x2,t_of_the_way(u0)(u1))+@|
+ take_fraction(y0+y2,t_of_the_way(v0)(v1))
+
+@ Here's a routine that prints an envelope spec in symbolic form. It assumes
+that the |cur_pen| has not been walked around to the first offset.
+
+@p procedure print_spec(@!cur_spec,@!cur_pen:pointer;@!s:str_number);
+var @!p,@!q:pointer; {list traversal}
+@!w:pointer; {the current pen offset}
+begin print_diagnostic("Envelope spec",s,true);
+p:=cur_spec; w:=pen_walk(cur_pen,spec_offset);
+print_ln;@/
+print_two(x_coord(cur_spec),y_coord(cur_spec));
+print(" % beginning with offset ");
+print_two(x_coord(w),y_coord(w));
+repeat
+ repeat q:=link(p);
+ @<Print the cubic between |p| and |q|@>;
+ p:=q;
+ until (p=cur_spec) or (info(p)<>zero_off);
+ if info(p)<>zero_off then
+ @<Update |w| as indicated by |info(p)| and print an explanation@>;
+until p=cur_spec;
+print_nl(" & cycle");
+end_diagnostic(true);
+end;
+
+@ @<Update |w| as indicated by |info(p)| and print an explanation@>=
+begin w:=pen_walk(w,info(p)-zero_off);
+print(" % ");
+if info(p)>zero_off then print("counter");
+print("clockwise to offset ");
+print_two(x_coord(w),y_coord(w));
+end
+
+@ @<Print the cubic between |p| and |q|@>=
+begin print_nl(" ..controls ");
+print_two(right_x(p),right_y(p));
+print(" and ");
+print_two(left_x(q),left_y(q));
+print_nl(" ..");
+print_two(x_coord(q),y_coord(q));
+end
+
+@ Once we have an envelope spec, the remaining task to construct the actual
+envelope by offsetting each cubic as determined by the |info| fields in
+the knots. First we use |offset_prep| to convert the |c| into an envelope
+spec. Then we add the offsets so that |c| becomes a cyclic path that represents
+the envelope.
+
+The |ljoin| and |miterlim| parameters control the treatment of points where the
+pen offset changes, and |lcap| controls the endpoints of a \&{doublepath}.
+The endpoints are easily located because |c| is given in undoubled form
+and then doubled in this procedure. We use |spec_p1| and |spec_p2| to keep
+track of the endpoints and treat them like very sharp corners.
+Butt end caps are treated like beveled joins; round end caps are treated like
+round joins; and square end caps are achieved by setting |join_type:=3|.
+
+None of these parameters apply to inside joins where the convolution tracing
+has retrograde lines. In such cases we use a simple connect-the-endpoints
+approach that is achieved by setting |join_type:=2|.
+
+@p @t\4@>@<Declare a function called |insert_knot|@>@;
+function make_envelope(@!c,@!h:pointer;@!ljoin,@!lcap:small_number;
+ @!miterlim:scaled):pointer;
+label done;
+var @!p,@!q,@!r,@!q0:pointer; {for manipulating the path}
+@!join_type:0..3; {codes |0..3| for mitered, round, beveled, or square}
+@!w,@!w0:pointer; {the pen knot for the current offset}
+@!qx,@!qy:scaled; {unshifted coordinates of |q|}
+@!k,@!k0:halfword; {controls pen edge insertion}
+@<Other local variables for |make_envelope|@>@;
+begin spec_p1:=null; spec_p2:=null;
+if left_type(c)=endpoint then
+ @<Double the path |c|, and set |spec_p1| and |spec_p2|@>;
+@<Use |offset_prep| to compute the envelope spec then walk |h| around to
+ the initial offset@>;
+w:=h;
+p:=c;
+repeat q:=link(p); q0:=q;
+qx:=x_coord(q); qy:=y_coord(q);
+k:=info(q);@/
+k0:=k; w0:=w;
+if k<>zero_off then
+ @<Set |join_type| to indicate how to handle offset changes at~|q|@>;
+@<Add offset |w| to the cubic from |p| to |q|@>;
+while k<>zero_off do
+ begin @<Step |w| and move |k| one step closer to |zero_off|@>;
+ if (join_type=1)or(k=zero_off) then
+ q:=insert_knot(q,qx+x_coord(w),qy+y_coord(w));
+ end;
+if q<>link(p) then @<Set |p=link(p)| and add knots between |p| and |q| as
+ requred by |join_type|@>;
+p:=q;
+until q0=c;
+make_envelope:=c;
+end;
+
+@ @<Use |offset_prep| to compute the envelope spec then walk |h| around to...@>=
+c:=offset_prep(c,h);
+if internal[tracing_specs]>0 then print_spec(c,h,"");
+h:=pen_walk(h,spec_offset)
+
+@ Mitered and squared-off joins depend on path directions that are difficult to
+compute for degenerate cubics. The envelope spec computed by |offset_prep| can
+have degenerate cubics only if the entire cycle collapses to a single
+degenerate cubic. Setting |join_type:=2| in this case makes the computed
+envelope degenerate as well.
+
+@<Set |join_type| to indicate how to handle offset changes at~|q|@>=
+if k<zero_off then join_type:=2
+else begin if (q<>spec_p1)and(q<>spec_p2) then join_type:=ljoin
+ else if lcap=2 then join_type:=3
+ else join_type:=2-lcap;
+ if (join_type=0)or(join_type=3) then
+ begin @<Set the incoming and outgoing directions at |q|; in case of
+ degeneracy set |join_type:=2|@>;
+ if join_type=0 then
+ @<If |miterlim| is less than the secant of half the angle at |q|
+ then set |join_type:=2|@>;
+ end;
+ end
+
+@ @<If |miterlim| is less than the secant of half the angle at |q|...@>=
+begin tmp:=take_fraction(miterlim,fraction_half+@|
+ half(take_fraction(dxin,dxout)+take_fraction(dyin,dyout)));
+if tmp<unity then
+ if take_scaled(miterlim,tmp)<unity then join_type:=2;
+end
+
+@ @<Other local variables for |make_envelope|@>=
+@!dxin,@!dyin,@!dxout,@!dyout:fraction;
+ {directions at |q| when square or mitered}
+@!tmp:scaled; {a temporary value}
+
+@ The coordinates of |p| have already been shifted unless |p| is the first
+knot in which case they get shifted at the very end.
+
+@<Add offset |w| to the cubic from |p| to |q|@>=
+right_x(p):=right_x(p)+x_coord(w);
+right_y(p):=right_y(p)+y_coord(w);@/
+left_x(q):=left_x(q)+x_coord(w);
+left_y(q):=left_y(q)+y_coord(w);@/
+x_coord(q):=x_coord(q)+x_coord(w);
+y_coord(q):=y_coord(q)+y_coord(w);@/
+left_type(q):=explicit;
+right_type(q):=explicit
+
+@ @<Step |w| and move |k| one step closer to |zero_off|@>=
+if k>zero_off then
+ begin w:=link(w); decr(k); @+end
+else begin w:=knil(w); incr(k); @+end
+
+@ The cubic from |q| to the new knot at |(x,y)| becomes a line segment and
+the |right_x| and |right_y| fields of |r| are set from |q|. This is done in
+case the cubic containing these control points is ``yet to be examined.''
+
+@<Declare a function called |insert_knot|@>=
+function insert_knot(@!q:pointer;@!x,@!y:scaled):pointer;
+ {returns the inserted knot}
+var @!r:pointer; {the new knot}
+begin r:=get_node(knot_node_size);
+link(r):=link(q); link(q):=r;@/
+right_x(r):=right_x(q);
+right_y(r):=right_y(q);@/
+x_coord(r):=x;
+y_coord(r):=y;@/
+right_x(q):=x_coord(q);
+right_y(q):=y_coord(q);@/
+left_x(r):=x_coord(r);
+left_y(r):=y_coord(r);@/
+left_type(r):=explicit;
+right_type(r):=explicit;
+originator(r):=program_code;@/
+insert_knot:=r;
+end;
+
+@ After setting |p:=link(p)|, either |join_type=1| or |q=link(p)|.
+
+@<Set |p=link(p)| and add knots between |p| and |q| as...@>=
+begin p:=link(p);
+if (join_type=0)or(join_type=3) then
+ begin if join_type=0 then
+ @<Insert a new knot |r| between |p| and |q| as required for a mitered join@>
+ else @<Make |r| the last of two knots inserted between |p| and |q| to form a
+ squared join@>;
+ if r<>null then
+ begin right_x(r):=x_coord(r);
+ right_y(r):=y_coord(r);
+ end;
+ end;
+end
+
+@ For very small angles, adding a knot is unnecessary and would cause numerical
+problems, so we just set |r:=null| in that case.
+
+@<Insert a new knot |r| between |p| and |q| as required for a mitered join@>=
+begin det:=take_fraction(dyout,dxin)-take_fraction(dxout,dyin);
+if abs(det)<26844 then r:=null {sine $<10^{-4}$}
+else begin tmp:=take_fraction(x_coord(q)-x_coord(p),dyout)-@|
+ take_fraction(y_coord(q)-y_coord(p),dxout);
+ tmp:=make_fraction(tmp,det);
+ r:=insert_knot(p,x_coord(p)+take_fraction(tmp,dxin),@|
+ y_coord(p)+take_fraction(tmp,dyin));
+ end;
+end
+
+@ @<Other local variables for |make_envelope|@>=
+@!det:fraction; {a determinant used for mitered join calculations}
+
+@ @<Make |r| the last of two knots inserted between |p| and |q| to form a...@>=
+begin ht_x:=y_coord(w)-y_coord(w0);
+ht_y:=x_coord(w0)-x_coord(w);
+while (abs(ht_x)<fraction_half)and(abs(ht_y)<fraction_half) do
+ begin double(ht_x); double(ht_y);
+ end;
+@<Scan the pen polygon between |w0| and |w| and make |max_ht| the range dot
+ product with |(ht_x,ht_y)|@>;
+tmp:=make_fraction(max_ht,take_fraction(dxin,ht_x)+take_fraction(dyin,ht_y));
+r:=insert_knot(p,x_coord(p)+take_fraction(tmp,dxin),@|
+ y_coord(p)+take_fraction(tmp,dyin));
+tmp:=make_fraction(max_ht,take_fraction(dxout,ht_x)+take_fraction(dyout,ht_y));
+r:=insert_knot(r,x_coord(q)+take_fraction(tmp,dxout),@|
+ y_coord(q)+take_fraction(tmp,dyout));
+end
+
+@ @<Other local variables for |make_envelope|@>=
+@!ht_x,@!ht_y:fraction; {perpendicular to the segment from |p| to |q|}
+@!max_ht:scaled; {maximum height of the pen polygon above the |w0|-|w| line}
+@!kk:halfword; {keeps track of the pen vertices being scanned}
+@!ww:pointer; {the pen vertex being tested}
+
+@ The dot product of the vector from |w0| to |ww| with |(ht_x,ht_y)| ranges
+from zero to |max_ht|.
+
+@<Scan the pen polygon between |w0| and |w| and make |max_ht| the range...@>=
+max_ht:=0;
+kk:=zero_off;
+ww:=w;
+loop @+begin @<Step |ww| and move |kk| one step closer to |k0|@>;
+ if kk=k0 then goto done;
+ tmp:=take_fraction(x_coord(ww)-x_coord(w0),ht_x)+@|
+ take_fraction(y_coord(ww)-y_coord(w0),ht_y);
+ if tmp>max_ht then max_ht:=tmp;
+ end;
+done:do_nothing
+
+@ @<Step |ww| and move |kk| one step closer to |k0|@>=
+if kk>k0 then
+ begin ww:=link(ww); decr(kk); @+end
+else begin ww:=knil(ww); incr(kk); @+end
+
+@ @<Double the path |c|, and set |spec_p1| and |spec_p2|@>=
+begin spec_p1:=htap_ypoc(c);
+spec_p2:=path_tail;
+originator(spec_p1):=program_code;
+link(spec_p2):=link(spec_p1);
+link(spec_p1):=c;@/
+remove_cubic(spec_p1);
+c:=spec_p1;
+if c<>link(c) then begin
+originator(spec_p2):=program_code;
+remove_cubic(spec_p2);
+end
+else @<Make |c| look like a cycle of length one@>;
+end
+
+@ @<Make |c| look like a cycle of length one@>=
+begin left_type(c):=explicit; right_type(c):=explicit;
+left_x(c):=x_coord(c); left_y(c):=y_coord(c);
+right_x(c):=x_coord(c); right_y(c):=y_coord(c);
+end;
+
+@ In degenerate situations we might have to look at the knot preceding~|q|.
+That knot is |p| but if |p<>c|, its coordinates have already been offset by |w|.
+
+@<Set the incoming and outgoing directions at |q|; in case of...@>=
+dxin:=x_coord(q)-left_x(q);
+dyin:=y_coord(q)-left_y(q);
+if (dxin=0)and(dyin=0) then
+ begin dxin:=x_coord(q)-right_x(p);
+ dyin:=y_coord(q)-right_y(p);
+ if (dxin=0)and(dyin=0) then
+ begin dxin:=x_coord(q)-x_coord(p);
+ dyin:=y_coord(q)-y_coord(p);
+ if p<>c then {the coordinates of |p| have been offset by |w|}
+ begin dxin:=dxin+x_coord(w);
+ dyin:=dyin+y_coord(w);
+ end;
+ end;
+ end;
+tmp:=pyth_add(dxin,dyin);
+if tmp=0 then join_type:=2
+else begin dxin:=make_fraction(dxin,tmp);
+ dyin:=make_fraction(dyin,tmp);
+ @<Set the outgoing direction at |q|@>;
+ end
+
+@ If |q=c| then the coordinates of |r| and the control points between |q|
+and~|r| have already been offset by |h|.
+
+@<Set the outgoing direction at |q|@>=
+dxout:=right_x(q)-x_coord(q);
+dyout:=right_y(q)-y_coord(q);
+if (dxout=0)and(dyout=0) then
+ begin r:=link(q);
+ dxout:=left_x(r)-x_coord(q);
+ dyout:=left_y(r)-y_coord(q);
+ if (dxout=0)and(dyout=0) then
+ begin dxout:=x_coord(r)-x_coord(q);
+ dyout:=y_coord(r)-y_coord(q);
+ end;
+ end;
+if q=c then
+ begin dxout:=dxout-x_coord(h);
+ dyout:=dyout-y_coord(h);
+ end;
+tmp:=pyth_add(dxout,dyout);
+if tmp=0 then confusion("degenerate spec");
+@:this can't happen degerate spec}{\quad degenerate spec@>
+dxout:=make_fraction(dxout,tmp);
+dyout:=make_fraction(dyout,tmp)
+
+@* \[23] Direction and intersection times.
+A path of length $n$ is defined parametrically by functions $x(t)$ and
+$y(t)$, for |0<=t<=n|; we can regard $t$ as the ``time'' at which the path
+reaches the point $\bigl(x(t),y(t)\bigr)$. In this section of the program
+we shall consider operations that determine special times associated with
+given paths: the first time that a path travels in a given direction, and
+a pair of times at which two paths cross each other.
+
+@ Let's start with the easier task. The function |find_direction_time| is
+given a direction |(x,y)| and a path starting at~|h|. If the path never
+travels in direction |(x,y)|, the direction time will be~|-1|; otherwise
+it will be nonnegative.
+
+Certain anomalous cases can arise: If |(x,y)=(0,0)|, so that the given
+direction is undefined, the direction time will be~0. If $\bigl(x'(t),
+y'(t)\bigr)=(0,0)$, so that the path direction is undefined, it will be
+assumed to match any given direction at time~|t|.
+
+The routine solves this problem in nondegenerate cases by rotating the path
+and the given direction so that |(x,y)=(1,0)|; i.e., the main task will be
+to find when a given path first travels ``due east.''
+
+@p function find_direction_time(@!x,@!y:scaled;@!h:pointer):scaled;
+label exit,found,not_found,done;
+var @!max:scaled; {$\max\bigl(\vert x\vert,\vert y\vert\bigr)$}
+@!p,@!q:pointer; {for list traversal}
+@!n:scaled; {the direction time at knot |p|}
+@!tt:scaled; {the direction time within a cubic}
+@<Other local variables for |find_direction_time|@>@;
+begin @<Normalize the given direction for better accuracy;
+ but |return| with zero result if it's zero@>;
+n:=0; p:=h;
+loop@+ begin if right_type(p)=endpoint then goto not_found;
+ q:=link(p);
+ @<Rotate the cubic between |p| and |q|; then
+ |goto found| if the rotated cubic travels due east at some time |tt|;
+ but |goto not_found| if an entire cyclic path has been traversed@>;
+ p:=q; n:=n+unity;
+ end;
+not_found: find_direction_time:=-unity; return;
+found: find_direction_time:=n+tt;
+exit:end;
+
+@ @<Normalize the given direction for better accuracy...@>=
+if abs(x)<abs(y) then
+ begin x:=make_fraction(x,abs(y));
+ if y>0 then y:=fraction_one@+else y:=-fraction_one;
+ end
+else if x=0 then
+ begin find_direction_time:=0; return;
+ end
+else begin y:=make_fraction(y,abs(x));
+ if x>0 then x:=fraction_one@+else x:=-fraction_one;
+ end
+
+@ Since we're interested in the tangent directions, we work with the
+derivative $${\textstyle1\over3}B'(x_0,x_1,x_2,x_3;t)=
+B(x_1-x_0,x_2-x_1,x_3-x_2;t)$$ instead of
+$B(x_0,x_1,x_2,x_3;t)$ itself. The derived coefficients are also scaled up
+in order to achieve better accuracy.
+
+The given path may turn abruptly at a knot, and it might pass the critical
+tangent direction at such a time. Therefore we remember the direction |phi|
+in which the previous rotated cubic was traveling. (The value of |phi| will be
+undefined on the first cubic, i.e., when |n=0|.)
+
+@<Rotate the cubic between |p| and |q|; then...@>=
+tt:=0;
+@<Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples of the control
+ points of the rotated derivatives@>;
+if y1=0 then if x1>=0 then goto found;
+if n>0 then
+ begin @<Exit to |found| if an eastward direction occurs at knot |p|@>;
+ if p=h then goto not_found;
+ end;
+if (x3<>0)or(y3<>0) then phi:=n_arg(x3,y3);
+@<Exit to |found| if the curve whose derivatives are specified by
+ |x1,x2,x3,y1,y2,y3| travels eastward at some time~|tt|@>
+
+@ @<Other local variables for |find_direction_time|@>=
+@!x1,@!x2,@!x3,@!y1,@!y2,@!y3:scaled; {multiples of rotated derivatives}
+@!theta,@!phi:angle; {angles of exit and entry at a knot}
+@!t:fraction; {temp storage}
+
+@ @<Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples...@>=
+x1:=right_x(p)-x_coord(p); x2:=left_x(q)-right_x(p);
+x3:=x_coord(q)-left_x(q);@/
+y1:=right_y(p)-y_coord(p); y2:=left_y(q)-right_y(p);
+y3:=y_coord(q)-left_y(q);@/
+max:=abs(x1);
+if abs(x2)>max then max:=abs(x2);
+if abs(x3)>max then max:=abs(x3);
+if abs(y1)>max then max:=abs(y1);
+if abs(y2)>max then max:=abs(y2);
+if abs(y3)>max then max:=abs(y3);
+if max=0 then goto found;
+while max<fraction_half do
+ begin double(max); double(x1); double(x2); double(x3);
+ double(y1); double(y2); double(y3);
+ end;
+t:=x1; x1:=take_fraction(x1,x)+take_fraction(y1,y);
+y1:=take_fraction(y1,x)-take_fraction(t,y);@/
+t:=x2; x2:=take_fraction(x2,x)+take_fraction(y2,y);
+y2:=take_fraction(y2,x)-take_fraction(t,y);@/
+t:=x3; x3:=take_fraction(x3,x)+take_fraction(y3,y);
+y3:=take_fraction(y3,x)-take_fraction(t,y)
+
+@ @<Exit to |found| if an eastward direction occurs at knot |p|@>=
+theta:=n_arg(x1,y1);
+if theta>=0 then if phi<=0 then if phi>=theta-one_eighty_deg then goto found;
+if theta<=0 then if phi>=0 then if phi<=theta+one_eighty_deg then goto found
+
+@ In this step we want to use the |crossing_point| routine to find the
+roots of the quadratic equation $B(y_1,y_2,y_3;t)=0$.
+Several complications arise: If the quadratic equation has a double root,
+the curve never crosses zero, and |crossing_point| will find nothing;
+this case occurs iff $y_1y_3=y_2^2$ and $y_1y_2<0$. If the quadratic
+equation has simple roots, or only one root, we may have to negate it
+so that $B(y_1,y_2,y_3;t)$ crosses from positive to negative at its first root.
+And finally, we need to do special things if $B(y_1,y_2,y_3;t)$ is
+identically zero.
+
+@ @<Exit to |found| if the curve whose derivatives are specified by...@>=
+if x1<0 then if x2<0 then if x3<0 then goto done;
+if ab_vs_cd(y1,y3,y2,y2)=0 then
+ @<Handle the test for eastward directions when $y_1y_3=y_2^2$;
+ either |goto found| or |goto done|@>;
+if y1<=0 then
+ if y1<0 then
+ begin y1:=-y1; y2:=-y2; y3:=-y3;
+ end
+ else if y2>0 then
+ begin y2:=-y2; y3:=-y3;
+ end;
+@<Check the places where $B(y_1,y_2,y_3;t)=0$ to see if
+ $B(x_1,x_2,x_3;t)\ge0$@>;
+done:
+
+@ The quadratic polynomial $B(y_1,y_2,y_3;t)$ begins |>=0| and has at most
+two roots, because we know that it isn't identically zero.
+
+It must be admitted that the |crossing_point| routine is not perfectly accurate;
+rounding errors might cause it to find a root when $y_1y_3>y_2^2$, or to
+miss the roots when $y_1y_3<y_2^2$. The rotation process is itself
+subject to rounding errors. Yet this code optimistically tries to
+do the right thing.
+
+@d we_found_it==begin tt:=(t+@'4000) div @'10000; goto found;
+ end
+
+@<Check the places where $B(y_1,y_2,y_3;t)=0$...@>=
+t:=crossing_point(y1,y2,y3);
+if t>fraction_one then goto done;
+y2:=t_of_the_way(y2)(y3);
+x1:=t_of_the_way(x1)(x2);
+x2:=t_of_the_way(x2)(x3);
+x1:=t_of_the_way(x1)(x2);
+if x1>=0 then we_found_it;
+if y2>0 then y2:=0;
+tt:=t; t:=crossing_point(0,-y2,-y3);
+if t>fraction_one then goto done;
+x1:=t_of_the_way(x1)(x2);
+x2:=t_of_the_way(x2)(x3);
+if t_of_the_way(x1)(x2)>=0 then
+ begin t:=t_of_the_way(tt)(fraction_one); we_found_it;
+ end
+
+@ @<Handle the test for eastward directions when $y_1y_3=y_2^2$;
+ either |goto found| or |goto done|@>=
+begin if ab_vs_cd(y1,y2,0,0)<0 then
+ begin t:=make_fraction(y1,y1-y2);
+ x1:=t_of_the_way(x1)(x2);
+ x2:=t_of_the_way(x2)(x3);
+ if t_of_the_way(x1)(x2)>=0 then we_found_it;
+ end
+else if y3=0 then
+ if y1=0 then
+ @<Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0|@>
+ else if x3>=0 then
+ begin tt:=unity; goto found;
+ end;
+goto done;
+end
+
+@ At this point we know that the derivative of |y(t)| is identically zero,
+and that |x1<0|; but either |x2>=0| or |x3>=0|, so there's some hope of
+traveling east.
+
+@<Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0|...@>=
+begin t:=crossing_point(-x1,-x2,-x3);
+if t<=fraction_one then we_found_it;
+if ab_vs_cd(x1,x3,x2,x2)<=0 then
+ begin t:=make_fraction(x1,x1-x2); we_found_it;
+ end;
+end
+
+@ The intersection of two cubics can be found by an interesting variant
+of the general bisection scheme described in the introduction to
+|crossing_point|.\
+Given $w(t)=B(w_0,w_1,w_2,w_3;t)$ and $z(t)=B(z_0,z_1,z_2,z_3;t)$,
+we wish to find a pair of times $(t_1,t_2)$ such that $w(t_1)=z(t_2)$,
+if an intersection exists. First we find the smallest rectangle that
+encloses the points $\{w_0,w_1,w_2,w_3\}$ and check that it overlaps
+the smallest rectangle that encloses
+$\{z_0,z_1,z_2,z_3\}$; if not, the cubics certainly don't intersect.
+But if the rectangles do overlap, we bisect the intervals, getting
+new cubics $w'$ and~$w''$, $z'$~and~$z''$; the intersection routine first
+tries for an intersection between $w'$ and~$z'$, then (if unsuccessful)
+between $w'$ and~$z''$, then (if still unsuccessful) between $w''$ and~$z'$,
+finally (if thrice unsuccessful) between $w''$ and~$z''$. After $l$~successful
+levels of bisection we will have determined the intersection times $t_1$
+and~$t_2$ to $l$~bits of accuracy.
+
+\def\submin{_{\rm min}} \def\submax{_{\rm max}}
+As before, it is better to work with the numbers $W_k=2^l(w_k-w_{k-1})$
+and $Z_k=2^l(z_k-z_{k-1})$ rather than the coefficients $w_k$ and $z_k$
+themselves. We also need one other quantity, $\Delta=2^l(w_0-z_0)$,
+to determine when the enclosing rectangles overlap. Here's why:
+The $x$~coordinates of~$w(t)$ are between $u\submin$ and $u\submax$,
+and the $x$~coordinates of~$z(t)$ are between $x\submin$ and $x\submax$,
+if we write $w_k=(u_k,v_k)$ and $z_k=(x_k,y_k)$ and $u\submin=
+\min(u_0,u_1,u_2,u_3)$, etc. These intervals of $x$~coordinates
+overlap if and only if $u\submin\L x\submax$ and
+$x\submin\L u\submax$. Letting
+$$U\submin=\min(0,U_1,U_1+U_2,U_1+U_2+U_3),\;
+ U\submax=\max(0,U_1,U_1+U_2,U_1+U_2+U_3),$$
+we have $u\submin=2^lu_0+U\submin$, etc.; the condition for overlap
+reduces to
+$$X\submin-U\submax\L 2^l(u_0-x_0)\L X\submax-U\submin.$$
+Thus we want to maintain the quantity $2^l(u_0-x_0)$; similarly,
+the quantity $2^l(v_0-y_0)$ accounts for the $y$~coordinates. The
+coordinates of $\Delta=2^l(w_0-z_0)$ must stay bounded as $l$ increases,
+because of the overlap condition; i.e., we know that $X\submin$,
+$X\submax$, and their relatives are bounded, hence $X\submax-
+U\submin$ and $X\submin-U\submax$ are bounded.
+
+@ Incidentally, if the given cubics intersect more than once, the process
+just sketched will not necessarily find the lexicographically smallest pair
+$(t_1,t_2)$. The solution actually obtained will be smallest in ``shuffled
+order''; i.e., if $t_1=(.a_1a_2\ldots a_{16})_2$ and
+$t_2=(.b_1b_2\ldots b_{16})_2$, then we will minimize
+$a_1b_1a_2b_2\ldots a_{16}b_{16}$, not
+$a_1a_2\ldots a_{16}b_1b_2\ldots b_{16}$.
+Shuffled order agrees with lexicographic order if all pairs of solutions
+$(t_1,t_2)$ and $(t_1',t_2')$ have the property that $t_1<t_1'$ iff
+$t_2<t_2'$; but in general, lexicographic order can be quite different,
+and the bisection algorithm would be substantially less efficient if it were
+constrained by lexicographic order.
+
+For example, suppose that an overlap has been found for $l=3$ and
+$(t_1,t_2)= (.101,.011)$ in binary, but that no overlap is produced by
+either of the alternatives $(.1010,.0110)$, $(.1010,.0111)$ at level~4.
+Then there is probably an intersection in one of the subintervals
+$(.1011,.011x)$; but lexicographic order would require us to explore
+$(.1010,.1xxx)$ and $(.1011,.00xx)$ and $(.1011,.010x)$ first. We wouldn't
+want to store all of the subdivision data for the second path, so the
+subdivisions would have to be regenerated many times. Such inefficiencies
+would be associated with every `1' in the binary representation of~$t_1$.
+
+@ The subdivision process introduces rounding errors, hence we need to
+make a more liberal test for overlap. It is not hard to show that the
+computed values of $U_i$ differ from the truth by at most~$l$, on
+level~$l$, hence $U\submin$ and $U\submax$ will be at most $3l$ in error.
+If $\beta$ is an upper bound on the absolute error in the computed
+components of $\Delta=(|delx|,|dely|)$ on level~$l$, we will replace
+the test `$X\submin-U\submax\L|delx|$' by the more liberal test
+`$X\submin-U\submax\L|delx|+|tol|$', where $|tol|=6l+\beta$.
+
+More accuracy is obtained if we try the algorithm first with |tol=0|;
+the more liberal tolerance is used only if an exact approach fails.
+It is convenient to do this double-take by letting `3' in the preceding
+paragraph be a parameter, which is first 0, then 3.
+
+@<Glob...@>=
+@!tol_step:0..6; {either 0 or 3, usually}
+
+@ We shall use an explicit stack to implement the recursive bisection
+method described above. The |bisect_stack| array will contain numerous 5-word
+packets like $(U_1,U_2,U_3,U\submin,U\submax)$, as well as 20-word packets
+comprising the 5-word packets for $U$, $V$, $X$, and~$Y$.
+
+The following macros define the allocation of stack positions to
+the quantities needed for bisection-intersection.
+
+@d stack_1(#)==bisect_stack[#] {$U_1$, $V_1$, $X_1$, or $Y_1$}
+@d stack_2(#)==bisect_stack[#+1] {$U_2$, $V_2$, $X_2$, or $Y_2$}
+@d stack_3(#)==bisect_stack[#+2] {$U_3$, $V_3$, $X_3$, or $Y_3$}
+@d stack_min(#)==bisect_stack[#+3]
+ {$U\submin$, $V\submin$, $X\submin$, or $Y\submin$}
+@d stack_max(#)==bisect_stack[#+4]
+ {$U\submax$, $V\submax$, $X\submax$, or $Y\submax$}
+@d int_packets=20 {number of words to represent $U_k$, $V_k$, $X_k$, and $Y_k$}
+@#
+@d u_packet(#)==#-5
+@d v_packet(#)==#-10
+@d x_packet(#)==#-15
+@d y_packet(#)==#-20
+@d l_packets==bisect_ptr-int_packets
+@d r_packets==bisect_ptr
+@d ul_packet==u_packet(l_packets) {base of $U'_k$ variables}
+@d vl_packet==v_packet(l_packets) {base of $V'_k$ variables}
+@d xl_packet==x_packet(l_packets) {base of $X'_k$ variables}
+@d yl_packet==y_packet(l_packets) {base of $Y'_k$ variables}
+@d ur_packet==u_packet(r_packets) {base of $U''_k$ variables}
+@d vr_packet==v_packet(r_packets) {base of $V''_k$ variables}
+@d xr_packet==x_packet(r_packets) {base of $X''_k$ variables}
+@d yr_packet==y_packet(r_packets) {base of $Y''_k$ variables}
+@#
+@d u1l==stack_1(ul_packet) {$U'_1$}
+@d u2l==stack_2(ul_packet) {$U'_2$}
+@d u3l==stack_3(ul_packet) {$U'_3$}
+@d v1l==stack_1(vl_packet) {$V'_1$}
+@d v2l==stack_2(vl_packet) {$V'_2$}
+@d v3l==stack_3(vl_packet) {$V'_3$}
+@d x1l==stack_1(xl_packet) {$X'_1$}
+@d x2l==stack_2(xl_packet) {$X'_2$}
+@d x3l==stack_3(xl_packet) {$X'_3$}
+@d y1l==stack_1(yl_packet) {$Y'_1$}
+@d y2l==stack_2(yl_packet) {$Y'_2$}
+@d y3l==stack_3(yl_packet) {$Y'_3$}
+@d u1r==stack_1(ur_packet) {$U''_1$}
+@d u2r==stack_2(ur_packet) {$U''_2$}
+@d u3r==stack_3(ur_packet) {$U''_3$}
+@d v1r==stack_1(vr_packet) {$V''_1$}
+@d v2r==stack_2(vr_packet) {$V''_2$}
+@d v3r==stack_3(vr_packet) {$V''_3$}
+@d x1r==stack_1(xr_packet) {$X''_1$}
+@d x2r==stack_2(xr_packet) {$X''_2$}
+@d x3r==stack_3(xr_packet) {$X''_3$}
+@d y1r==stack_1(yr_packet) {$Y''_1$}
+@d y2r==stack_2(yr_packet) {$Y''_2$}
+@d y3r==stack_3(yr_packet) {$Y''_3$}
+@#
+@d stack_dx==bisect_stack[bisect_ptr] {stacked value of |delx|}
+@d stack_dy==bisect_stack[bisect_ptr+1] {stacked value of |dely|}
+@d stack_tol==bisect_stack[bisect_ptr+2] {stacked value of |tol|}
+@d stack_uv==bisect_stack[bisect_ptr+3] {stacked value of |uv|}
+@d stack_xy==bisect_stack[bisect_ptr+4] {stacked value of |xy|}
+@d int_increment=int_packets+int_packets+5 {number of stack words per level}
+
+@<Glob...@>=
+bisect_stack:array[0..bistack_size] of integer;
+bisect_ptr:0..bistack_size;
+
+@ @<Check the ``constant''...@>=
+if int_packets+17*int_increment>bistack_size then bad:=19;
+
+@ Computation of the min and max is a tedious but fairly fast sequence of
+instructions; exactly four comparisons are made in each branch.
+
+@d set_min_max(#)==
+ if stack_1(#)<0 then
+ if stack_3(#)>=0 then
+ begin if stack_2(#)<0 then stack_min(#):=stack_1(#)+stack_2(#)
+ else stack_min(#):=stack_1(#);
+ stack_max(#):=stack_1(#)+stack_2(#)+stack_3(#);
+ if stack_max(#)<0 then stack_max(#):=0;
+ end
+ else begin stack_min(#):=stack_1(#)+stack_2(#)+stack_3(#);
+ if stack_min(#)>stack_1(#) then stack_min(#):=stack_1(#);
+ stack_max(#):=stack_1(#)+stack_2(#);
+ if stack_max(#)<0 then stack_max(#):=0;
+ end
+ else if stack_3(#)<=0 then
+ begin if stack_2(#)>0 then stack_max(#):=stack_1(#)+stack_2(#)
+ else stack_max(#):=stack_1(#);
+ stack_min(#):=stack_1(#)+stack_2(#)+stack_3(#);
+ if stack_min(#)>0 then stack_min(#):=0;
+ end
+ else begin stack_max(#):=stack_1(#)+stack_2(#)+stack_3(#);
+ if stack_max(#)<stack_1(#) then stack_max(#):=stack_1(#);
+ stack_min(#):=stack_1(#)+stack_2(#);
+ if stack_min(#)>0 then stack_min(#):=0;
+ end
+
+@ It's convenient to keep the current values of $l$, $t_1$, and $t_2$ in
+the integer form $2^l+2^lt_1$ and $2^l+2^lt_2$. The |cubic_intersection|
+routine uses global variables |cur_t| and |cur_tt| for this purpose;
+after successful completion, |cur_t| and |cur_tt| will contain |unity|
+plus the |scaled| values of $t_1$ and~$t_2$.
+
+The values of |cur_t| and |cur_tt| will be set to zero if |cubic_intersection|
+finds no intersection. The routine gives up and gives an approximate answer
+if it has backtracked
+more than 5000 times (otherwise there are cases where several minutes
+of fruitless computation would be possible).
+
+@d max_patience=5000
+
+@<Glob...@>=
+@!cur_t,@!cur_tt:integer; {controls and results of |cubic_intersection|}
+@!time_to_go:integer; {this many backtracks before giving up}
+@!max_t:integer; {maximum of $2^{l+1}$ so far achieved}
+
+@ The given cubics $B(w_0,w_1,w_2,w_3;t)$ and
+$B(z_0,z_1,z_2,z_3;t)$ are specified in adjacent knot nodes |(p,link(p))|
+and |(pp,link(pp))|, respectively.
+
+@p procedure cubic_intersection(@!p,@!pp:pointer);
+label continue, not_found, exit;
+var @!q,@!qq:pointer; {|link(p)|, |link(pp)|}
+begin time_to_go:=max_patience; max_t:=2;
+@<Initialize for intersections at level zero@>;
+loop@+ begin continue:
+ if delx-tol<=stack_max(x_packet(xy))-stack_min(u_packet(uv)) then
+ if delx+tol>=stack_min(x_packet(xy))-stack_max(u_packet(uv)) then
+ if dely-tol<=stack_max(y_packet(xy))-stack_min(v_packet(uv)) then
+ if dely+tol>=stack_min(y_packet(xy))-stack_max(v_packet(uv)) then
+ begin if cur_t>=max_t then
+ begin if max_t=two then {we've done 17 bisections}
+ begin cur_t:=halfp(cur_t+1); cur_tt:=halfp(cur_tt+1); return;
+ end;
+ double(max_t); appr_t:=cur_t; appr_tt:=cur_tt;
+ end;
+ @<Subdivide for a new level of intersection@>;
+ goto continue;
+ end;
+ if time_to_go>0 then decr(time_to_go)
+ else begin while appr_t<unity do
+ begin double(appr_t); double(appr_tt);
+ end;
+ cur_t:=appr_t; cur_tt:=appr_tt; return;
+ end;
+ @<Advance to the next pair |(cur_t,cur_tt)|@>;
+ end;
+exit:end;
+
+@ The following variables are global, although they are used only by
+|cubic_intersection|, because it is necessary on some machines to
+split |cubic_intersection| up into two procedures.
+
+@<Glob...@>=
+@!delx,@!dely:integer; {the components of $\Delta=2^l(w_0-z_0)$}
+@!tol:integer; {bound on the uncertainly in the overlap test}
+@!uv,@!xy:0..bistack_size; {pointers to the current packets of interest}
+@!three_l:integer; {|tol_step| times the bisection level}
+@!appr_t,@!appr_tt:integer; {best approximations known to the answers}
+
+@ We shall assume that the coordinates are sufficiently non-extreme that
+integer overflow will not occur.
+
+@<Initialize for intersections at level zero@>=
+q:=link(p); qq:=link(pp); bisect_ptr:=int_packets;@/
+u1r:=right_x(p)-x_coord(p); u2r:=left_x(q)-right_x(p);
+u3r:=x_coord(q)-left_x(q); set_min_max(ur_packet);@/
+v1r:=right_y(p)-y_coord(p); v2r:=left_y(q)-right_y(p);
+v3r:=y_coord(q)-left_y(q); set_min_max(vr_packet);@/
+x1r:=right_x(pp)-x_coord(pp); x2r:=left_x(qq)-right_x(pp);
+x3r:=x_coord(qq)-left_x(qq); set_min_max(xr_packet);@/
+y1r:=right_y(pp)-y_coord(pp); y2r:=left_y(qq)-right_y(pp);
+y3r:=y_coord(qq)-left_y(qq); set_min_max(yr_packet);@/
+delx:=x_coord(p)-x_coord(pp); dely:=y_coord(p)-y_coord(pp);@/
+tol:=0; uv:=r_packets; xy:=r_packets; three_l:=0; cur_t:=1; cur_tt:=1
+
+@ @<Subdivide for a new level of intersection@>=
+stack_dx:=delx; stack_dy:=dely; stack_tol:=tol; stack_uv:=uv; stack_xy:=xy;
+bisect_ptr:=bisect_ptr+int_increment;@/
+double(cur_t); double(cur_tt);@/
+u1l:=stack_1(u_packet(uv)); u3r:=stack_3(u_packet(uv));
+u2l:=half(u1l+stack_2(u_packet(uv)));
+u2r:=half(u3r+stack_2(u_packet(uv)));
+u3l:=half(u2l+u2r); u1r:=u3l;
+set_min_max(ul_packet); set_min_max(ur_packet);@/
+v1l:=stack_1(v_packet(uv)); v3r:=stack_3(v_packet(uv));
+v2l:=half(v1l+stack_2(v_packet(uv)));
+v2r:=half(v3r+stack_2(v_packet(uv)));
+v3l:=half(v2l+v2r); v1r:=v3l;
+set_min_max(vl_packet); set_min_max(vr_packet);@/
+x1l:=stack_1(x_packet(xy)); x3r:=stack_3(x_packet(xy));
+x2l:=half(x1l+stack_2(x_packet(xy)));
+x2r:=half(x3r+stack_2(x_packet(xy)));
+x3l:=half(x2l+x2r); x1r:=x3l;
+set_min_max(xl_packet); set_min_max(xr_packet);@/
+y1l:=stack_1(y_packet(xy)); y3r:=stack_3(y_packet(xy));
+y2l:=half(y1l+stack_2(y_packet(xy)));
+y2r:=half(y3r+stack_2(y_packet(xy)));
+y3l:=half(y2l+y2r); y1r:=y3l;
+set_min_max(yl_packet); set_min_max(yr_packet);@/
+uv:=l_packets; xy:=l_packets;
+double(delx); double(dely);@/
+tol:=tol-three_l+tol_step; double(tol); three_l:=three_l+tol_step
+
+@ @<Advance to the next pair |(cur_t,cur_tt)|@>=
+not_found: if odd(cur_tt) then
+ if odd(cur_t) then @<Descend to the previous level and |goto not_found|@>
+ else begin incr(cur_t);
+ delx:=delx+stack_1(u_packet(uv))+stack_2(u_packet(uv))
+ +stack_3(u_packet(uv));
+ dely:=dely+stack_1(v_packet(uv))+stack_2(v_packet(uv))
+ +stack_3(v_packet(uv));
+ uv:=uv+int_packets; {switch from |l_packet| to |r_packet|}
+ decr(cur_tt); xy:=xy-int_packets; {switch from |r_packet| to |l_packet|}
+ delx:=delx+stack_1(x_packet(xy))+stack_2(x_packet(xy))
+ +stack_3(x_packet(xy));
+ dely:=dely+stack_1(y_packet(xy))+stack_2(y_packet(xy))
+ +stack_3(y_packet(xy));
+ end
+else begin incr(cur_tt); tol:=tol+three_l;
+ delx:=delx-stack_1(x_packet(xy))-stack_2(x_packet(xy))
+ -stack_3(x_packet(xy));
+ dely:=dely-stack_1(y_packet(xy))-stack_2(y_packet(xy))
+ -stack_3(y_packet(xy));
+ xy:=xy+int_packets; {switch from |l_packet| to |r_packet|}
+ end
+
+@ @<Descend to the previous level...@>=
+begin cur_t:=halfp(cur_t); cur_tt:=halfp(cur_tt);
+if cur_t=0 then return;
+bisect_ptr:=bisect_ptr-int_increment; three_l:=three_l-tol_step;
+delx:=stack_dx; dely:=stack_dy; tol:=stack_tol; uv:=stack_uv; xy:=stack_xy;@/
+goto not_found;
+end
+
+@ The |path_intersection| procedure is much simpler.
+It invokes |cubic_intersection| in lexicographic order until finding a
+pair of cubics that intersect. The final intersection times are placed in
+|cur_t| and~|cur_tt|.
+
+@p procedure path_intersection(@!h,@!hh:pointer);
+label exit;
+var @!p,@!pp:pointer; {link registers that traverse the given paths}
+@!n,@!nn:integer; {integer parts of intersection times, minus |unity|}
+begin @<Change one-point paths into dead cycles@>;
+tol_step:=0;
+repeat n:=-unity; p:=h;
+ repeat if right_type(p)<>endpoint then
+ begin nn:=-unity; pp:=hh;
+ repeat if right_type(pp)<>endpoint then
+ begin cubic_intersection(p,pp);
+ if cur_t>0 then
+ begin cur_t:=cur_t+n; cur_tt:=cur_tt+nn; return;
+ end;
+ end;
+ nn:=nn+unity; pp:=link(pp);
+ until pp=hh;
+ end;
+ n:=n+unity; p:=link(p);
+ until p=h;
+tol_step:=tol_step+3;
+until tol_step>3;
+cur_t:=-unity; cur_tt:=-unity;
+exit:end;
+
+@ @<Change one-point paths...@>=
+if right_type(h)=endpoint then
+ begin right_x(h):=x_coord(h); left_x(h):=x_coord(h);
+ right_y(h):=y_coord(h); left_y(h):=y_coord(h); right_type(h):=explicit;
+ end;
+if right_type(hh)=endpoint then
+ begin right_x(hh):=x_coord(hh); left_x(hh):=x_coord(hh);
+ right_y(hh):=y_coord(hh); left_y(hh):=y_coord(hh); right_type(hh):=explicit;
+ end;
+
+@* \[24] Dynamic linear equations.
+\MP\ users define variables implicitly by stating equations that should be
+satisfied; the computer is supposed to be smart enough to solve those equations.
+And indeed, the computer tries valiantly to do so, by distinguishing five
+different types of numeric values:
+
+\smallskip\hang
+|type(p)=known| is the nice case, when |value(p)| is the |scaled| value
+of the variable whose address is~|p|.
+
+\smallskip\hang
+|type(p)=dependent| means that |value(p)| is not present, but |dep_list(p)|
+points to a {\sl dependency list\/} that expresses the value of variable~|p|
+as a |scaled| number plus a sum of independent variables with |fraction|
+coefficients.
+
+\smallskip\hang
+|type(p)=independent| means that |value(p)=64s+m|, where |s>0| is a ``serial
+number'' reflecting the time this variable was first used in an equation;
+also |0<=m<64|, and each dependent variable
+that refers to this one is actually referring to the future value of
+this variable times~$2^m$. (Usually |m=0|, but higher degrees of
+scaling are sometimes needed to keep the coefficients in dependency lists
+from getting too large. The value of~|m| will always be even.)
+
+\smallskip\hang
+|type(p)=numeric_type| means that variable |p| hasn't appeared in an
+equation before, but it has been explicitly declared to be numeric.
+
+\smallskip\hang
+|type(p)=undefined| means that variable |p| hasn't appeared before.
+
+\smallskip\noindent
+We have actually discussed these five types in the reverse order of their
+history during a computation: Once |known|, a variable never again
+becomes |dependent|; once |dependent|, it almost never again becomes
+|independent|; once |independent|, it never again becomes |numeric_type|;
+and once |numeric_type|, it never again becomes |undefined| (except
+of course when the user specifically decides to scrap the old value
+and start again). A backward step may, however, take place: Sometimes
+a |dependent| variable becomes |independent| again, when one of the
+independent variables it depends on is reverting to |undefined|.
+
+
+The next patch detects overflow of independent-variable serial
+numbers. Diagnosed and patched by Thorsten Dahlheimer.
+
+@d s_scale=64 {the serial numbers are multiplied by this factor}
+@d max_indep_vars==@'177777777 {$2^{25}-1$}
+@d max_serial_no==@'17777777700 {|max_indep_vars*s_scale|}
+@d new_indep(#)== {create a new independent variable}
+ begin if serial_no=max_serial_no then
+ overflow("independent variables",max_indep_vars);
+ type(#):=independent; serial_no:=serial_no+s_scale;
+ value(#):=serial_no;
+ end
+
+@<Glob...@>=
+@!serial_no:integer; {the most recent serial number, times |s_scale|}
+
+@ @<Make variable |q+s| newly independent@>=new_indep(q+s)
+
+@ But how are dependency lists represented? It's simple: The linear combination
+$\alpha_1v_1+\cdots+\alpha_kv_k+\beta$ appears in |k+1| value nodes. If
+|q=dep_list(p)| points to this list, and if |k>0|, then |value(q)=
+@t$\alpha_1$@>| (which is a |fraction|); |info(q)| points to the location
+of $\alpha_1$; and |link(p)| points to the dependency list
+$\alpha_2v_2+\cdots+\alpha_kv_k+\beta$. On the other hand if |k=0|,
+then |value(q)=@t$\beta$@>| (which is |scaled|) and |info(q)=null|.
+The independent variables $v_1$, \dots,~$v_k$ have been sorted so that
+they appear in decreasing order of their |value| fields (i.e., of
+their serial numbers). \ (It is convenient to use decreasing order,
+since |value(null)=0|. If the independent variables were not sorted by
+serial number but by some other criterion, such as their location in |mem|,
+the equation-solving mechanism would be too system-dependent, because
+the ordering can affect the computed results.)
+
+The |link| field in the node that contains the constant term $\beta$ is
+called the {\sl final link\/} of the dependency list. \MP\ maintains
+a doubly-linked master list of all dependency lists, in terms of a permanently
+allocated node
+in |mem| called |dep_head|. If there are no dependencies, we have
+|link(dep_head)=dep_head| and |prev_dep(dep_head)=dep_head|;
+otherwise |link(dep_head)| points to the first dependent variable, say~|p|,
+and |prev_dep(p)=dep_head|. We have |type(p)=dependent|, and |dep_list(p)|
+points to its dependency list. If the final link of that dependency list
+occurs in location~|q|, then |link(q)| points to the next dependent
+variable (say~|r|); and we have |prev_dep(r)=q|, etc.
+
+@d dep_list(#)==link(value_loc(#))
+ {half of the |value| field in a |dependent| variable}
+@d prev_dep(#)==info(value_loc(#))
+ {the other half; makes a doubly linked list}
+@d dep_node_size=2 {the number of words per dependency node}
+
+@<Initialize table entries...@>= serial_no:=0;
+link(dep_head):=dep_head; prev_dep(dep_head):=dep_head;
+info(dep_head):=null; dep_list(dep_head):=null;
+
+@ Actually the description above contains a little white lie. There's
+another kind of variable called |proto_dependent|, which is
+just like a |dependent| one except that the $\alpha$ coefficients
+in its dependency list are |scaled| instead of being fractions.
+Proto-dependency lists are mixed with dependency lists in the
+nodes reachable from |dep_head|.
+
+@ Here is a procedure that prints a dependency list in symbolic form.
+The second parameter should be either |dependent| or |proto_dependent|,
+to indicate the scaling of the coefficients.
+
+@<Declare subroutines for printing expressions@>=
+procedure print_dependency(@!p:pointer;@!t:small_number);
+label exit;
+var @!v:integer; {a coefficient}
+@!pp,@!q:pointer; {for list manipulation}
+begin pp:=p;
+loop@+ begin v:=abs(value(p)); q:=info(p);
+ if q=null then {the constant term}
+ begin if (v<>0)or(p=pp) then
+ begin if value(p)>0 then if p<>pp then print_char("+");
+ print_scaled(value(p));
+ end;
+ return;
+ end;
+ @<Print the coefficient, unless it's $\pm1.0$@>;
+ if type(q)<>independent then confusion("dep");
+@:this can't happen dep}{\quad dep@>
+ print_variable_name(q); v:=value(q) mod s_scale;
+ while v>0 do
+ begin print("*4"); v:=v-2;
+ end;
+ p:=link(p);
+ end;
+exit:end;
+
+@ @<Print the coefficient, unless it's $\pm1.0$@>=
+if value(p)<0 then print_char("-")
+else if p<>pp then print_char("+");
+if t=dependent then v:=round_fraction(v);
+if v<>unity then print_scaled(v)
+
+@ The maximum absolute value of a coefficient in a given dependency list
+is returned by the following simple function.
+
+@p function max_coef(@!p:pointer):fraction;
+var @!x:fraction; {the maximum so far}
+begin x:=0;
+while info(p)<>null do
+ begin if abs(value(p))>x then x:=abs(value(p));
+ p:=link(p);
+ end;
+max_coef:=x;
+end;
+
+@ One of the main operations needed on dependency lists is to add a multiple
+of one list to the other; we call this |p_plus_fq|, where |p| and~|q| point
+to dependency lists and |f| is a fraction.
+
+If the coefficient of any independent variable becomes |coef_bound| or
+more, in absolute value, this procedure changes the type of that variable
+to `|independent_needing_fix|', and sets the global variable |fix_needed|
+to~|true|. The value of $|coef_bound|=\mu$ is chosen so that
+$\mu^2+\mu<8$; this means that the numbers we deal with won't
+get too large. (Instead of the ``optimum'' $\mu=(\sqrt{33}-1)/2\approx
+2.3723$, the safer value 7/3 is taken as the threshold.)
+
+The changes mentioned in the preceding paragraph are actually done only if
+the global variable |watch_coefs| is |true|. But it usually is; in fact,
+it is |false| only when \MP\ is making a dependency list that will soon
+be equated to zero.
+
+Several procedures that act on dependency lists, including |p_plus_fq|,
+set the global variable |dep_final| to the final (constant term) node of
+the dependency list that they produce.
+
+@d coef_bound==@'4525252525 {|fraction| approximation to 7/3}
+@d independent_needing_fix=0
+
+@<Glob...@>=
+@!fix_needed:boolean; {does at least one |independent| variable need scaling?}
+@!watch_coefs:boolean; {should we scale coefficients that exceed |coef_bound|?}
+@!dep_final:pointer; {location of the constant term and final link}
+
+@ @<Set init...@>=
+fix_needed:=false; watch_coefs:=true;
+
+@ The |p_plus_fq| procedure has a fourth parameter, |t|, that should be
+set to |proto_dependent| if |p| is a proto-dependency list. In this
+case |f| will be |scaled|, not a |fraction|. Similarly, the fifth parameter~|tt|
+should be |proto_dependent| if |q| is a proto-dependency list.
+
+List |q| is unchanged by the operation; but list |p| is totally destroyed.
+
+The final link of the dependency list or proto-dependency list returned
+by |p_plus_fq| is the same as the original final link of~|p|. Indeed, the
+constant term of the result will be located in the same |mem| location
+as the original constant term of~|p|.
+
+Coefficients of the result are assumed to be zero if they are less than
+a certain threshold. This compensates for inevitable rounding errors,
+and tends to make more variables `|known|'. The threshold is approximately
+$10^{-5}$ in the case of normal dependency lists, $10^{-4}$ for
+proto-dependencies.
+
+@d fraction_threshold=2685 {a |fraction| coefficient less than this is zeroed}
+@d half_fraction_threshold=1342 {half of |fraction_threshold|}
+@d scaled_threshold=8 {a |scaled| coefficient less than this is zeroed}
+@d half_scaled_threshold=4 {half of |scaled_threshold|}
+
+@<Declare basic dependency-list subroutines@>=
+function p_plus_fq(@!p:pointer;@!f:integer;@!q:pointer;
+ @!t,@!tt:small_number):pointer;
+label done;
+var @!pp,@!qq:pointer; {|info(p)| and |info(q)|, respectively}
+@!r,@!s:pointer; {for list manipulation}
+@!threshold:integer; {defines a neighborhood of zero}
+@!v:integer; {temporary register}
+begin if t=dependent then threshold:=fraction_threshold
+else threshold:=scaled_threshold;
+r:=temp_head; pp:=info(p); qq:=info(q);
+loop@+ if pp=qq then
+ if pp=null then goto done
+ else @<Contribute a term from |p|, plus |f| times the
+ corresponding term from |q|@>
+ else if value(pp)<value(qq) then
+ @<Contribute a term from |q|, multiplied by~|f|@>
+ else begin link(r):=p; r:=p; p:=link(p); pp:=info(p);
+ end;
+done: if t=dependent then
+ value(p):=slow_add(value(p),take_fraction(value(q),f))
+else value(p):=slow_add(value(p),take_scaled(value(q),f));
+link(r):=p; dep_final:=p; p_plus_fq:=link(temp_head);
+end;
+
+@ @<Contribute a term from |p|, plus |f|...@>=
+begin if tt=dependent then v:=value(p)+take_fraction(f,value(q))
+else v:=value(p)+take_scaled(f,value(q));
+value(p):=v; s:=p; p:=link(p);
+if abs(v)<threshold then free_node(s,dep_node_size)
+else begin if abs(v)>=coef_bound then if watch_coefs then
+ begin type(qq):=independent_needing_fix; fix_needed:=true;
+ end;
+ link(r):=s; r:=s;
+ end;
+pp:=info(p); q:=link(q); qq:=info(q);
+end
+
+@ @<Contribute a term from |q|, multiplied by~|f|@>=
+begin if tt=dependent then v:=take_fraction(f,value(q))
+else v:=take_scaled(f,value(q));
+if abs(v)>halfp(threshold) then
+ begin s:=get_node(dep_node_size); info(s):=qq; value(s):=v;
+ if abs(v)>=coef_bound then if watch_coefs then
+ begin type(qq):=independent_needing_fix; fix_needed:=true;
+ end;
+ link(r):=s; r:=s;
+ end;
+q:=link(q); qq:=info(q);
+end
+
+@ It is convenient to have another subroutine for the special case
+of |p_plus_fq| when |f=1.0|. In this routine lists |p| and |q| are
+both of the same type~|t| (either |dependent| or |proto_dependent|).
+
+@p function p_plus_q(@!p:pointer;@!q:pointer;@!t:small_number):pointer;
+label done;
+var @!pp,@!qq:pointer; {|info(p)| and |info(q)|, respectively}
+@!r,@!s:pointer; {for list manipulation}
+@!threshold:integer; {defines a neighborhood of zero}
+@!v:integer; {temporary register}
+begin if t=dependent then threshold:=fraction_threshold
+else threshold:=scaled_threshold;
+r:=temp_head; pp:=info(p); qq:=info(q);
+loop@+ if pp=qq then
+ if pp=null then goto done
+ else @<Contribute a term from |p|, plus the
+ corresponding term from |q|@>
+ else if value(pp)<value(qq) then
+ begin s:=get_node(dep_node_size); info(s):=qq; value(s):=value(q);
+ q:=link(q); qq:=info(q); link(r):=s; r:=s;
+ end
+ else begin link(r):=p; r:=p; p:=link(p); pp:=info(p);
+ end;
+done: value(p):=slow_add(value(p),value(q));
+link(r):=p; dep_final:=p; p_plus_q:=link(temp_head);
+end;
+
+@ @<Contribute a term from |p|, plus the...@>=
+begin v:=value(p)+value(q);
+value(p):=v; s:=p; p:=link(p); pp:=info(p);
+if abs(v)<threshold then free_node(s,dep_node_size)
+else begin if abs(v)>=coef_bound then if watch_coefs then
+ begin type(qq):=independent_needing_fix; fix_needed:=true;
+ end;
+ link(r):=s; r:=s;
+ end;
+q:=link(q); qq:=info(q);
+end
+
+@ A somewhat simpler routine will multiply a dependency list
+by a given constant~|v|. The constant is either a |fraction| less than
+|fraction_one|, or it is |scaled|. In the latter case we might be forced to
+convert a dependency list to a proto-dependency list.
+Parameters |t0| and |t1| are the list types before and after;
+they should agree unless |t0=dependent| and |t1=proto_dependent|
+and |v_is_scaled=true|.
+
+@p function p_times_v(@!p:pointer;@!v:integer;
+ @!t0,@!t1:small_number;@!v_is_scaled:boolean):pointer;
+var @!r,@!s:pointer; {for list manipulation}
+@!w:integer; {tentative coefficient}
+@!threshold:integer;
+@!scaling_down:boolean;
+begin if t0<>t1 then scaling_down:=true@+else scaling_down:=not v_is_scaled;
+if t1=dependent then threshold:=half_fraction_threshold
+else threshold:=half_scaled_threshold;
+r:=temp_head;
+while info(p)<>null do
+ begin if scaling_down then w:=take_fraction(v,value(p))
+ else w:=take_scaled(v,value(p));
+ if abs(w)<=threshold then
+ begin s:=link(p); free_node(p,dep_node_size); p:=s;
+ end
+ else begin if abs(w)>=coef_bound then
+ begin fix_needed:=true; type(info(p)):=independent_needing_fix;
+ end;
+ link(r):=p; r:=p; value(p):=w; p:=link(p);
+ end;
+ end;
+link(r):=p;
+if v_is_scaled then value(p):=take_scaled(value(p),v)
+else value(p):=take_fraction(value(p),v);
+p_times_v:=link(temp_head);
+end;
+
+@ Similarly, we sometimes need to divide a dependency list
+by a given |scaled| constant.
+
+@<Declare basic dependency-list subroutines@>=
+function p_over_v(@!p:pointer;@!v:scaled;
+ @!t0,@!t1:small_number):pointer;
+var @!r,@!s:pointer; {for list manipulation}
+@!w:integer; {tentative coefficient}
+@!threshold:integer;
+@!scaling_down:boolean;
+begin if t0<>t1 then scaling_down:=true@+else scaling_down:=false;
+if t1=dependent then threshold:=half_fraction_threshold
+else threshold:=half_scaled_threshold;
+r:=temp_head;
+while info(p)<>null do
+ begin if scaling_down then
+ if abs(v)<@'2000000 then w:=make_scaled(value(p),v*@'10000)
+ else w:=make_scaled(round_fraction(value(p)),v)
+ else w:=make_scaled(value(p),v);
+ if abs(w)<=threshold then
+ begin s:=link(p); free_node(p,dep_node_size); p:=s;
+ end
+ else begin if abs(w)>=coef_bound then
+ begin fix_needed:=true; type(info(p)):=independent_needing_fix;
+ end;
+ link(r):=p; r:=p; value(p):=w; p:=link(p);
+ end;
+ end;
+link(r):=p; value(p):=make_scaled(value(p),v);
+p_over_v:=link(temp_head);
+end;
+
+@ Here's another utility routine for dependency lists. When an independent
+variable becomes dependent, we want to remove it from all existing
+dependencies. The |p_with_x_becoming_q| function computes the
+dependency list of~|p| after variable~|x| has been replaced by~|q|.
+
+This procedure has basically the same calling conventions as |p_plus_fq|:
+List~|q| is unchanged; list~|p| is destroyed; the constant node and the
+final link are inherited from~|p|; and the fourth parameter tells whether
+or not |p| is |proto_dependent|. However, the global variable |dep_final|
+is not altered if |x| does not occur in list~|p|.
+
+@p function p_with_x_becoming_q(@!p,@!x,@!q:pointer;@!t:small_number):pointer;
+var @!r,@!s:pointer; {for list manipulation}
+@!v:integer; {coefficient of |x|}
+@!sx:integer; {serial number of |x|}
+begin s:=p; r:=temp_head; sx:=value(x);
+while value(info(s))>sx do
+ begin r:=s; s:=link(s);
+ end;
+if info(s)<>x then p_with_x_becoming_q:=p
+else begin link(temp_head):=p; link(r):=link(s); v:=value(s);
+ free_node(s,dep_node_size);
+ p_with_x_becoming_q:=p_plus_fq(link(temp_head),v,q,t,dependent);
+ end;
+end;
+
+@ Here's a simple procedure that reports an error when a variable
+has just received a known value that's out of the required range.
+
+@<Declare basic dependency-list subroutines@>=
+procedure val_too_big(@!x:scaled);
+begin if internal[warning_check]>0 then
+ begin print_err("Value is too large ("); print_scaled(x); print_char(")");
+@.Value is too large@>
+ help4("The equation I just processed has given some variable")@/
+ ("a value of 4096 or more. Continue and I'll try to cope")@/
+ ("with that big value; but it might be dangerous.")@/
+ ("(Set warningcheck:=0 to suppress this message.)");
+ error;
+ end;
+end;
+
+@ When a dependent variable becomes known, the following routine
+removes its dependency list. Here |p| points to the variable, and
+|q| points to the dependency list (which is one node long).
+
+@<Declare basic dependency-list subroutines@>=
+procedure make_known(@!p,@!q:pointer);
+var @!t:dependent..proto_dependent; {the previous type}
+begin prev_dep(link(q)):=prev_dep(p);
+link(prev_dep(p)):=link(q); t:=type(p);
+type(p):=known; value(p):=value(q); free_node(q,dep_node_size);
+if abs(value(p))>=fraction_one then val_too_big(value(p));
+if internal[tracing_equations]>0 then if interesting(p) then
+ begin begin_diagnostic; print_nl("#### ");
+@:]]]\#\#\#\#_}{\.{\#\#\#\#}@>
+ print_variable_name(p); print_char("="); print_scaled(value(p));
+ end_diagnostic(false);
+ end;
+if cur_exp=p then if cur_type=t then
+ begin cur_type:=known; cur_exp:=value(p);
+ free_node(p,value_node_size);
+ end;
+end;
+
+@ The |fix_dependencies| routine is called into action when |fix_needed|
+has been triggered. The program keeps a list~|s| of independent variables
+whose coefficients must be divided by~4.
+
+In unusual cases, this fixup process might reduce one or more coefficients
+to zero, so that a variable will become known more or less by default.
+
+@<Declare basic dependency-list subroutines@>=
+procedure fix_dependencies;
+label done;
+var @!p,@!q,@!r,@!s,@!t:pointer; {list manipulation registers}
+@!x:pointer; {an independent variable}
+begin r:=link(dep_head); s:=null;
+while r<>dep_head do
+ begin t:=r;
+ @<Run through the dependency list for variable |t|, fixing
+ all nodes, and ending with final link~|q|@>;
+ r:=link(q);
+ if q=dep_list(t) then make_known(t,q);
+ end;
+while s<>null do
+ begin p:=link(s); x:=info(s); free_avail(s); s:=p;
+ type(x):=independent; value(x):=value(x)+2;
+ end;
+fix_needed:=false;
+end;
+
+@ @d independent_being_fixed=1 {this variable already appears in |s|}
+
+@<Run through the dependency list for variable |t|...@>=
+r:=value_loc(t); {|link(r)=dep_list(t)|}
+loop@+ begin q:=link(r); x:=info(q);
+ if x=null then goto done;
+ if type(x)<=independent_being_fixed then
+ begin if type(x)<independent_being_fixed then
+ begin p:=get_avail; link(p):=s; s:=p;
+ info(s):=x; type(x):=independent_being_fixed;
+ end;
+ value(q):=value(q) div 4;
+ if value(q)=0 then
+ begin link(r):=link(q); free_node(q,dep_node_size); q:=r;
+ end;
+ end;
+ r:=q;
+ end;
+done:
+
+@ The |new_dep| routine installs a dependency list~|p| into the value node~|q|,
+linking it into the list of all known dependencies. We assume that
+|dep_final| points to the final node of list~|p|.
+
+@p procedure new_dep(@!q,@!p:pointer);
+var @!r:pointer; {what used to be the first dependency}
+begin dep_list(q):=p; prev_dep(q):=dep_head;
+r:=link(dep_head); link(dep_final):=r; prev_dep(r):=dep_final;
+link(dep_head):=q;
+end;
+
+@ Here is one of the ways a dependency list gets started.
+The |const_dependency| routine produces a list that has nothing but
+a constant term.
+
+@p function const_dependency(@!v:scaled):pointer;
+begin dep_final:=get_node(dep_node_size);
+value(dep_final):=v; info(dep_final):=null;
+const_dependency:=dep_final;
+end;
+
+@ And here's a more interesting way to start a dependency list from scratch:
+The parameter to |single_dependency| is the location of an
+independent variable~|x|, and the result is the simple dependency list
+`|x+0|'.
+
+In the unlikely event that the given independent variable has been doubled so
+often that we can't refer to it with a nonzero coefficient,
+|single_dependency| returns the simple list `0'. This case can be
+recognized by testing that the returned list pointer is equal to
+|dep_final|.
+
+@p function single_dependency(@!p:pointer):pointer;
+var @!q:pointer; {the new dependency list}
+@!m:integer; {the number of doublings}
+begin m:=value(p) mod s_scale;
+if m>28 then single_dependency:=const_dependency(0)
+else begin q:=get_node(dep_node_size);
+ value(q):=two_to_the[28-m]; info(q):=p;@/
+ link(q):=const_dependency(0); single_dependency:=q;
+ end;
+end;
+
+@ We sometimes need to make an exact copy of a dependency list.
+
+@p function copy_dep_list(@!p:pointer):pointer;
+label done;
+var @!q:pointer; {the new dependency list}
+begin q:=get_node(dep_node_size); dep_final:=q;
+loop@+ begin info(dep_final):=info(p); value(dep_final):=value(p);
+ if info(dep_final)=null then goto done;
+ link(dep_final):=get_node(dep_node_size);
+ dep_final:=link(dep_final); p:=link(p);
+ end;
+done:copy_dep_list:=q;
+end;
+
+@ But how do variables normally become known? Ah, now we get to the heart of the
+equation-solving mechanism. The |linear_eq| procedure is given a |dependent|
+or |proto_dependent| list,~|p|, in which at least one independent variable
+appears. It equates this list to zero, by choosing an independent variable
+with the largest coefficient and making it dependent on the others. The
+newly dependent variable is eliminated from all current dependencies,
+thereby possibly making other dependent variables known.
+
+The given list |p| is, of course, totally destroyed by all this processing.
+
+@p procedure linear_eq(@!p:pointer;@!t:small_number);
+var @!q,@!r,@!s:pointer; {for link manipulation}
+@!x:pointer; {the variable that loses its independence}
+@!n:integer; {the number of times |x| had been halved}
+@!v:integer; {the coefficient of |x| in list |p|}
+@!prev_r:pointer; {lags one step behind |r|}
+@!final_node:pointer; {the constant term of the new dependency list}
+@!w:integer; {a tentative coefficient}
+begin @<Find a node |q| in list |p| whose coefficient |v| is largest@>;
+x:=info(q); n:=value(x) mod s_scale;@/
+@<Divide list |p| by |-v|, removing node |q|@>;
+if internal[tracing_equations]>0 then @<Display the new dependency@>;
+@<Simplify all existing dependencies by substituting for |x|@>;
+@<Change variable |x| from |independent| to |dependent| or |known|@>;
+if fix_needed then fix_dependencies;
+end;
+
+@ @<Find a node |q| in list |p| whose coefficient |v| is largest@>=
+q:=p; r:=link(p); v:=value(q);
+while info(r)<>null do
+ begin if abs(value(r))>abs(v) then
+ begin q:=r; v:=value(r);
+ end;
+ r:=link(r);
+ end
+
+@ Here we want to change the coefficients from |scaled| to |fraction|,
+except in the constant term. In the common case of a trivial equation
+like `\.{x=3.14}', we will have |v=-fraction_one|, |q=p|, and |t=dependent|.
+
+@<Divide list |p| by |-v|, removing node |q|@>=
+s:=temp_head; link(s):=p; r:=p;
+repeat if r=q then
+ begin link(s):=link(r); free_node(r,dep_node_size);
+ end
+else begin w:=make_fraction(value(r),v);
+ if abs(w)<=half_fraction_threshold then
+ begin link(s):=link(r); free_node(r,dep_node_size);
+ end
+ else begin value(r):=-w; s:=r;
+ end;
+ end;
+r:=link(s);
+until info(r)=null;
+if t=proto_dependent then value(r):=-make_scaled(value(r),v)
+else if v<>-fraction_one then value(r):=-make_fraction(value(r),v);
+final_node:=r; p:=link(temp_head)
+
+@ @<Display the new dependency@>=
+if interesting(x) then
+ begin begin_diagnostic; print_nl("## "); print_variable_name(x);
+@:]]]\#\#_}{\.{\#\#}@>
+ w:=n;
+ while w>0 do
+ begin print("*4"); w:=w-2;
+ end;
+ print_char("="); print_dependency(p,dependent); end_diagnostic(false);
+ end
+
+@ @<Simplify all existing dependencies by substituting for |x|@>=
+prev_r:=dep_head; r:=link(dep_head);
+while r<>dep_head do
+ begin s:=dep_list(r); q:=p_with_x_becoming_q(s,x,p,type(r));
+ if info(q)=null then make_known(r,q)
+ else begin dep_list(r):=q;
+ repeat q:=link(q);
+ until info(q)=null;
+ prev_r:=q;
+ end;
+ r:=link(prev_r);
+ end
+
+@ @<Change variable |x| from |independent| to |dependent| or |known|@>=
+if n>0 then @<Divide list |p| by $2^n$@>;
+if info(p)=null then
+ begin type(x):=known;
+ value(x):=value(p);
+ if abs(value(x))>=fraction_one then val_too_big(value(x));
+ free_node(p,dep_node_size);
+ if cur_exp=x then if cur_type=independent then
+ begin cur_exp:=value(x); cur_type:=known;
+ free_node(x,value_node_size);
+ end;
+ end
+else begin type(x):=dependent; dep_final:=final_node; new_dep(x,p);
+ if cur_exp=x then if cur_type=independent then cur_type:=dependent;
+ end
+
+@ @<Divide list |p| by $2^n$@>=
+begin s:=temp_head; link(temp_head):=p; r:=p;
+repeat if n>30 then w:=0
+else w:=value(r) div two_to_the[n];
+if (abs(w)<=half_fraction_threshold)and(info(r)<>null) then
+ begin link(s):=link(r);
+ free_node(r,dep_node_size);
+ end
+else begin value(r):=w; s:=r;
+ end;
+r:=link(s);
+until info(s)=null;
+p:=link(temp_head);
+end
+
+@ The |check_mem| procedure, which is used only when \MP\ is being
+debugged, makes sure that the current dependency lists are well formed.
+
+@<Check the list of linear dependencies@>=
+q:=dep_head; p:=link(q);
+while p<>dep_head do
+ begin if prev_dep(p)<>q then
+ begin print_nl("Bad PREVDEP at "); print_int(p);
+@.Bad PREVDEP...@>
+ end;
+ p:=dep_list(p);
+ loop @+begin r:=info(p); q:=p; p:=link(q);
+ if r=null then goto done3;
+ if value(info(p))>=value(r) then
+ begin print_nl("Out of order at "); print_int(p);
+@.Out of order...@>
+ end;
+ end;
+done3: do_nothing;
+ end
+
+@* \[25] Dynamic nonlinear equations.
+Variables of numeric type are maintained by the general scheme of
+independent, dependent, and known values that we have just studied;
+and the components of pair and transform variables are handled in the
+same way. But \MP\ also has five other types of values: \&{boolean},
+\&{string}, \&{pen}, \&{path}, and \&{picture}; what about them?
+
+Equations are allowed between nonlinear quantities, but only in a
+simple form. Two variables that haven't yet been assigned values are
+either equal to each other, or they're not.
+
+Before a boolean variable has received a value, its type is |unknown_boolean|;
+similarly, there are variables whose type is |unknown_string|, |unknown_pen|,
+|unknown_path|, and |unknown_picture|. In such cases the value is either
+|null| (which means that no other variables are equivalent to this one), or
+it points to another variable of the same undefined type. The pointers in the
+latter case form a cycle of nodes, which we shall call a ``ring.''
+Rings of undefined variables may include capsules, which arise as
+intermediate results within expressions or as \&{expr} parameters to macros.
+
+When one member of a ring receives a value, the same value is given to
+all the other members. In the case of paths and pictures, this implies
+making separate copies of a potentially large data structure; users should
+restrain their enthusiasm for such generality, unless they have lots and
+lots of memory space.
+
+@ The following procedure is called when a capsule node is being
+added to a ring (e.g., when an unknown variable is mentioned in an expression).
+
+@p function new_ring_entry(@!p:pointer):pointer;
+var q:pointer; {the new capsule node}
+begin q:=get_node(value_node_size); name_type(q):=capsule;
+type(q):=type(p);
+if value(p)=null then value(q):=p@+else value(q):=value(p);
+value(p):=q;
+new_ring_entry:=q;
+end;
+
+@ Conversely, we might delete a capsule or a variable before it becomes known.
+The following procedure simply detaches a quantity from its ring,
+without recycling the storage.
+
+@<Declare the recycling subroutines@>=
+procedure ring_delete(@!p:pointer);
+var @!q:pointer;
+begin q:=value(p);
+if q<>null then if q<>p then
+ begin while value(q)<>p do q:=value(q);
+ value(q):=value(p);
+ end;
+end;
+
+@ Eventually there might be an equation that assigns values to all of the
+variables in a ring. The |nonlinear_eq| subroutine does the necessary
+propagation of values.
+
+If the parameter |flush_p| is |true|, node |p| itself needn't receive a
+value, it will soon be recycled.
+
+@p procedure nonlinear_eq(@!v:integer;@!p:pointer;@!flush_p:boolean);
+var @!t:small_number; {the type of ring |p|}
+@!q,@!r:pointer; {link manipulation registers}
+begin t:=type(p)-unknown_tag; q:=value(p);
+if flush_p then type(p):=vacuous@+else p:=q;
+repeat r:=value(q); type(q):=t;
+case t of
+boolean_type: value(q):=v;
+string_type: begin value(q):=v; add_str_ref(v);
+ end;
+pen_type: value(q):=copy_pen(v);
+path_type: value(q):=copy_path(v);
+picture_type: begin value(q):=v; add_edge_ref(v);
+ end;
+end; {there ain't no more cases}
+q:=r;
+until q=p;
+end;
+
+@ If two members of rings are equated, and if they have the same type,
+the |ring_merge| procedure is called on to make them equivalent.
+
+@p procedure ring_merge(@!p,@!q:pointer);
+label exit;
+var @!r:pointer; {traverses one list}
+begin r:=value(p);
+while r<>p do
+ begin if r=q then
+ begin @<Exclaim about a redundant equation@>;
+ return;
+ end;
+ r:=value(r);
+ end;
+r:=value(p); value(p):=value(q); value(q):=r;
+exit:end;
+
+@ @<Exclaim about a redundant equation@>=
+begin print_err("Redundant equation");@/
+@.Redundant equation@>
+help2("I already knew that this equation was true.")@/
+ ("But perhaps no harm has been done; let's continue.");@/
+put_get_error;
+end
+
+@* \[26] Introduction to the syntactic routines.
+Let's pause a moment now and try to look at the Big Picture.
+The \MP\ program consists of three main parts: syntactic routines,
+semantic routines, and output routines. The chief purpose of the
+syntactic routines is to deliver the user's input to the semantic routines,
+while parsing expressions and locating operators and operands. The
+semantic routines act as an interpreter responding to these operators,
+which may be regarded as commands. And the output routines are
+periodically called on to produce compact font descriptions that can be
+used for typesetting or for making interim proof drawings. We have
+discussed the basic data structures and many of the details of semantic
+operations, so we are good and ready to plunge into the part of \MP\ that
+actually controls the activities.
+
+Our current goal is to come to grips with the |get_next| procedure,
+which is the keystone of \MP's input mechanism. Each call of |get_next|
+sets the value of three variables |cur_cmd|, |cur_mod|, and |cur_sym|,
+representing the next input token.
+$$\vbox{\halign{#\hfil\cr
+ \hbox{|cur_cmd| denotes a command code from the long list of codes
+ given earlier;}\cr
+ \hbox{|cur_mod| denotes a modifier of the command code;}\cr
+ \hbox{|cur_sym| is the hash address of the symbolic token that was
+ just scanned,}\cr
+ \hbox{\qquad or zero in the case of a numeric or string
+ or capsule token.}\cr}}$$
+Underlying this external behavior of |get_next| is all the machinery
+necessary to convert from character files to tokens. At a given time we
+may be only partially finished with the reading of several files (for
+which \&{input} was specified), and partially finished with the expansion
+of some user-defined macros and/or some macro parameters, and partially
+finished reading some text that the user has inserted online,
+and so on. When reading a character file, the characters must be
+converted to tokens; comments and blank spaces must
+be removed, numeric and string tokens must be evaluated.
+
+To handle these situations, which might all be present simultaneously,
+\MP\ uses various stacks that hold information about the incomplete
+activities, and there is a finite state control for each level of the
+input mechanism. These stacks record the current state of an implicitly
+recursive process, but the |get_next| procedure is not recursive.
+
+@<Glob...@>=
+@!cur_cmd: eight_bits; {current command set by |get_next|}
+@!cur_mod: integer; {operand of current command}
+@!cur_sym: halfword; {hash address of current symbol}
+
+@ The |print_cmd_mod| routine prints a symbolic interpretation of a
+command code and its modifier.
+It consists of a rather tedious sequence of print
+commands, and most of it is essentially an inverse to the |primitive|
+routine that enters a \MP\ primitive into |hash| and |eqtb|. Therefore almost
+all of this procedure appears elsewhere in the program, together with the
+corresponding |primitive| calls.
+
+@<Declare the procedure called |print_cmd_mod|@>=
+procedure print_cmd_mod(@!c,@!m:integer);
+begin case c of
+@t\4@>@<Cases of |print_cmd_mod| for symbolic printing of primitives@>@/
+othercases print("[unknown command code!]")
+endcases;
+end;
+
+@ Here is a procedure that displays a given command in braces, in the
+user's transcript file.
+
+@d show_cur_cmd_mod==show_cmd_mod(cur_cmd,cur_mod)
+
+@p procedure show_cmd_mod(@!c,@!m:integer);
+begin begin_diagnostic; print_nl("{");
+print_cmd_mod(c,m); print_char("}");
+end_diagnostic(false);
+end;
+
+@* \[27] Input stacks and states.
+The state of \MP's input mechanism appears in the input stack, whose
+entries are records with five fields, called |index|, |start|, |loc|,
+|limit|, and |name|. The top element of this stack is maintained in a
+global variable for which no subscripting needs to be done; the other
+elements of the stack appear in an array. Hence the stack is declared thus:
+
+@<Types...@>=
+@!in_state_record = record
+ @!index_field: quarterword;
+ @!start_field,@!loc_field, @!limit_field, @!name_field: halfword;
+ end;
+
+@ @<Glob...@>=
+@!input_stack : array[0..stack_size] of in_state_record;
+@!input_ptr : 0..stack_size; {first unused location of |input_stack|}
+@!max_in_stack: 0..stack_size; {largest value of |input_ptr| when pushing}
+@!cur_input : in_state_record; {the ``top'' input state}
+
+@ We've already defined the special variable |@!loc==cur_input.loc_field|
+in our discussion of basic input-output routines. The other components of
+|cur_input| are defined in the same way:
+
+@d index==cur_input.index_field {reference for buffer information}
+@d start==cur_input.start_field {starting position in |buffer|}
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d name==cur_input.name_field {name of the current file}
+
+@ Let's look more closely now at the five control variables
+(|index|,~|start|,~|loc|,~|limit|,~|name|),
+assuming that \MP\ is reading a line of characters that have been input
+from some file or from the user's terminal. There is an array called
+|buffer| that acts as a stack of all lines of characters that are
+currently being read from files, including all lines on subsidiary
+levels of the input stack that are not yet completed. \MP\ will return to
+the other lines when it is finished with the present input file.
+
+(Incidentally, on a machine with byte-oriented addressing, it would be
+appropriate to combine |buffer| with the |str_pool| array,
+letting the buffer entries grow downward from the top of the string pool
+and checking that these two tables don't bump into each other.)
+
+The line we are currently working on begins in position |start| of the
+buffer; the next character we are about to read is |buffer[loc]|; and
+|limit| is the location of the last character present. We always have
+|loc<=limit|. For convenience, |buffer[limit]| has been set to |"%"|, so
+that the end of a line is easily sensed.
+
+The |name| variable is a string number that designates the name of
+the current file, if we are reading an ordinary text file. Special codes
+|is_term..max_spec_src| indicate other sources of input text.
+
+@d is_term=0 {|name| value when reading from the terminal for normal input}
+@d is_read=1 {|name| value when executing a \&{readstring} or \&{readfrom}}
+@d is_scantok=2 {|name| value when reading text generated by \&{scantokens}}
+@d max_spec_src=is_scantok
+
+@ Additional information about the current line is available via the
+|index| variable, which counts how many lines of characters are present
+in the buffer below the current level. We have |index=0| when reading
+from the terminal and prompting the user for each line; then if the user types,
+e.g., `\.{input figs}', we will have |index=1| while reading
+the file \.{figs.mp}. However, it does not follow that |index| is the
+same as the input stack pointer, since many of the levels on the input
+stack may come from token lists and some |index| values may correspond
+to \.{MPX} files that are not currently on the stack.
+
+The global variable |in_open| is equal to the highest |index| value counting
+\.{MPX} files but excluding token-list input levels. Thus, the number of
+partially read lines in the buffer is |in_open+1| and we have |in_open>=index|
+when we are not reading a token list.
+
+If we are not currently reading from the terminal,
+we are reading from the file variable |input_file[index]|. We use
+the notation |terminal_input| as a convenient abbreviation for |name=is_term|,
+and |cur_file| as an abbreviation for |input_file[index]|.
+
+When \MP\ is not reading from the terminal, the global variable |line| contains
+the line number in the current file, for use in error messages. More precisely,
+|line| is a macro for |line_stack[index]| and the |line_stack| array gives
+the line number for each file in the |input_file| array.
+
+When an \.{MPX} file is opened the file name is stored in the |mpx_name|
+array so that the name doesn't get lost when the file is temporarily removed
+from the input stack.
+Thus when |input_file[k]| is an \.{MPX} file, its name is |mpx_name[k]|
+and it contains translated \TeX\ pictures for |input_file[k-1]|.
+Since this is not an \.{MPX} file, we have
+$$ \hbox{|mpx_name[k-1]<=absent|}. $$
+This |name| field is set to |finished| when |input_file[k]| is completely
+read.
+
+If more information about the input state is needed, it can be
+included in small arrays like those shown here. For example,
+the current page or segment number in the input file might be put
+into a variable |@!page|, that is really a macro for the current entry
+in `\ignorespaces|@!page_stack:array[0..max_in_open] of integer|\unskip'
+by analogy with |line_stack|.
+@^system dependencies@>
+
+@d terminal_input==(name=is_term) {are we reading from the terminal?}
+@d cur_file==input_file[index] {the current |alpha_file| variable}
+@d line==line_stack[index] {current line number in the current source file}
+@d in_name==iname_stack[index] {a string used to construct \.{MPX} file names}
+@d in_area==iarea_stack[index] {another string for naming \.{MPX} files}
+@d absent=1 {|name_field| value for unused |mpx_in_stack| entries}
+@d mpx_reading==(mpx_name[index]>absent)
+ {when reading a file, is it an \.{MPX} file?}
+@d finished=0
+ {|name_field| value when the corresponding \.{MPX} file is finished}
+
+@<Glob...@>=
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : array[1..max_in_open] of alpha_file;
+@!line_stack : array[0..max_in_open] of integer; {the line number for each file}
+@!iname_stack : array[0..max_in_open] of str_number;
+ {used for naming \.{MPX} files}
+@!iarea_stack : array[0..max_in_open] of str_number;
+ {used for naming \.{MPX} files}
+@!mpx_name : array[0..max_in_open] of halfword;
+
+@ However, all this discussion about input state really applies only to the
+case that we are inputting from a file. There is another important case,
+namely when we are currently getting input from a token list. In this case
+|index>max_in_open|, and the conventions about the other state variables
+are different:
+
+\yskip\hang|loc| is a pointer to the current node in the token list, i.e.,
+the node that will be read next. If |loc=null|, the token list has been
+fully read.
+
+\yskip\hang|start| points to the first node of the token list; this node
+may or may not contain a reference count, depending on the type of token
+list involved.
+
+\yskip\hang|token_type|, which takes the place of |index| in the
+discussion above, is a code number that explains what kind of token list
+is being scanned.
+
+\yskip\hang|name| points to the |eqtb| address of the control sequence
+being expanded, if the current token list is a macro not defined by
+\&{vardef}. Macros defined by \&{vardef} have |name=null|; their name
+can be deduced by looking at their first two parameters.
+
+\yskip\hang|param_start|, which takes the place of |limit|, tells where
+the parameters of the current macro or loop text begin in the |param_stack|.
+
+\yskip\noindent The |token_type| can take several values, depending on
+where the current token list came from:
+
+\yskip
+\indent|forever_text|, if the token list being scanned is the body of
+a \&{forever} loop;
+
+\indent|loop_text|, if the token list being scanned is the body of
+a \&{for} or \&{forsuffixes} loop;
+
+\indent|parameter|, if a \&{text} or \&{suffix} parameter is being scanned;
+
+\indent|backed_up|, if the token list being scanned has been inserted as
+`to be read again'.
+
+\indent|inserted|, if the token list being scanned has been inserted as
+part of error recovery;
+
+\indent|macro|, if the expansion of a user-defined symbolic token is being
+scanned.
+
+\yskip\noindent
+The token list begins with a reference count if and only if |token_type=
+macro|.
+@^reference counts@>
+
+@d token_type==index {type of current token list}
+@d token_state==(index>max_in_open) {are we scanning a token list?}
+@d file_state==(index<=max_in_open) {are we scanning a file line?}
+@d param_start==limit {base of macro parameters in |param_stack|}
+@d forever_text=max_in_open+1 {|token_type| code for loop texts}
+@d loop_text=max_in_open+2 {|token_type| code for loop texts}
+@d parameter=max_in_open+3 {|token_type| code for parameter texts}
+@d backed_up=max_in_open+4 {|token_type| code for texts to be reread}
+@d inserted=max_in_open+5 {|token_type| code for inserted texts}
+@d macro=max_in_open+6 {|token_type| code for macro replacement texts}
+
+@ The |param_stack| is an auxiliary array used to hold pointers to the token
+lists for parameters at the current level and subsidiary levels of input.
+This stack grows at a different rate from the others.
+
+@<Glob...@>=
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+@!param_ptr:0..param_size; {first unused entry in |param_stack|}
+@!max_param_stack:integer;
+ {largest value of |param_ptr|}
+
+@ Notice that the |line| isn't valid when |token_state| is true because it
+depends on |index|. If we really need to know the line number for the
+topmost file in the index stack we use the following function. If a page
+number or other information is needed, this routine should be modified to
+compute it as well.
+@^system dependencies@>
+
+@<Declare a function called |true_line|@>=
+function true_line: integer;
+var @!k:0..stack_size; {an index into the input stack}
+begin if file_state and (name>max_spec_src) then true_line:=line
+else begin k:=input_ptr;
+ while (k>0)and(input_stack[k].index_field>max_in_open)or@|
+ (input_stack[k].name_field<=max_spec_src) do
+ decr(k);
+ true_line:=line_stack[k];
+ end;
+end;
+
+@ Thus, the ``current input state'' can be very complicated indeed; there
+can be many levels and each level can arise in a variety of ways. The
+|show_context| procedure, which is used by \MP's error-reporting routine to
+print out the current input state on all levels down to the most recent
+line of characters from an input file, illustrates most of these conventions.
+The global variable |file_ptr| contains the lowest level that was
+displayed by this procedure.
+
+@<Glob...@>=
+@!file_ptr:0..stack_size; {shallowest level shown by |show_context|}
+
+@ The status at each level is indicated by printing two lines, where the first
+line indicates what was read so far and the second line shows what remains
+to be read. The context is cropped, if necessary, so that the first line
+contains at most |half_error_line| characters, and the second contains
+at most |error_line|. Non-current input levels whose |token_type| is
+`|backed_up|' are shown only if they have not been fully read.
+
+@p procedure show_context; {prints where the scanner is}
+label done;
+var @!old_setting:0..max_selector; {saved |selector| setting}
+@<Local variables for formatting calculations@>@/
+begin file_ptr:=input_ptr; input_stack[file_ptr]:=cur_input;
+ {store current state}
+loop@+begin cur_input:=input_stack[file_ptr]; {enter into the context}
+ @<Display the current context@>;
+ if file_state then
+ if (name>max_spec_src) or (file_ptr=0) then goto done;
+ decr(file_ptr);
+ end;
+done: cur_input:=input_stack[input_ptr]; {restore original state}
+end;
+
+@ @<Display the current context@>=
+if (file_ptr=input_ptr) or file_state or
+ (token_type<>backed_up) or (loc<>null) then
+ {we omit backed-up token lists that have already been read}
+ begin tally:=0; {get ready to count characters}
+ old_setting:=selector;
+ if file_state then
+ begin @<Print location of current line@>;
+ @<Pseudoprint the line@>;
+ end
+ else begin @<Print type of token list@>;
+ @<Pseudoprint the token list@>;
+ end;
+ selector:=old_setting; {stop pseudoprinting}
+ @<Print two lines using the tricky pseudoprinted information@>;
+ end
+
+@ This routine should be changed, if necessary, to give the best possible
+indication of where the current line resides in the input file.
+For example, on some systems it is best to print both a page and line number.
+@^system dependencies@>
+
+@<Print location of current line@>=
+if name>max_spec_src then
+ begin print_nl("l."); print_int(true_line);
+ end
+else if terminal_input then
+ if file_ptr=0 then print_nl("<*>") @+else print_nl("<insert>")
+else if name=is_scantok then print_nl("<scantokens>")
+else print_nl("<read>");
+print_char(" ")
+
+@ @<Print type of token list@>=
+case token_type of
+forever_text: print_nl("<forever> ");
+loop_text: @<Print the current loop value@>;
+parameter: print_nl("<argument> ");
+backed_up: if loc=null then print_nl("<recently read> ")
+ else print_nl("<to be read again> ");
+inserted: print_nl("<inserted text> ");
+macro: begin print_ln;
+ if name<>null then print(text(name))
+ else @<Print the name of a \&{vardef}'d macro@>;
+ print("->");
+ end;
+othercases print_nl("?") {this should never happen}
+@.?\relax@>
+endcases
+
+@ The parameter that corresponds to a loop text is either a token list
+(in the case of \&{forsuffixes}) or a ``capsule'' (in the case of \&{for}).
+We'll discuss capsules later; for now, all we need to know is that
+the |link| field in a capsule parameter is |void| and that
+|print_exp(p,0)| displays the value of capsule~|p| in abbreviated form.
+
+@d void==null+1 {a null pointer different from |null|}
+
+@<Print the current loop value@>=
+begin print_nl("<for("); p:=param_stack[param_start];
+if p<>null then
+ if link(p)=void then print_exp(p,0) {we're in a \&{for} loop}
+ else show_token_list(p,null,20,tally);
+print(")> ");
+end
+
+@ The first two parameters of a macro defined by \&{vardef} will be token
+lists representing the macro's prefix and ``at point.'' By putting these
+together, we get the macro's full name.
+
+@<Print the name of a \&{vardef}'d macro@>=
+begin p:=param_stack[param_start];
+if p=null then show_token_list(param_stack[param_start+1],null,20,tally)
+else begin q:=p;
+ while link(q)<>null do q:=link(q);
+ link(q):=param_stack[param_start+1];
+ show_token_list(p,null,20,tally);
+ link(q):=null;
+ end;
+end
+
+@ Now it is necessary to explain a little trick. We don't want to store a long
+string that corresponds to a token list, because that string might take up
+lots of memory; and we are printing during a time when an error message is
+being given, so we dare not do anything that might overflow one of \MP's
+tables. So `pseudoprinting' is the answer: We enter a mode of printing
+that stores characters into a buffer of length |error_line|, where character
+$k+1$ is placed into \hbox{|trick_buf[k mod error_line]|} if
+|k<trick_count|, otherwise character |k| is dropped. Initially we set
+|tally:=0| and |trick_count:=1000000|; then when we reach the
+point where transition from line 1 to line 2 should occur, we
+set |first_count:=tally| and |trick_count:=@tmax@>(error_line,
+tally+1+error_line-half_error_line)|. At the end of the
+pseudoprinting, the values of |first_count|, |tally|, and
+|trick_count| give us all the information we need to print the two lines,
+and all of the necessary text is in |trick_buf|.
+
+Namely, let |l| be the length of the descriptive information that appears
+on the first line. The length of the context information gathered for that
+line is |k=first_count|, and the length of the context information
+gathered for line~2 is $m=\min(|tally|, |trick_count|)-k$. If |l+k<=h|,
+where |h=half_error_line|, we print |trick_buf[0..k-1]| after the
+descriptive information on line~1, and set |n:=l+k|; here |n| is the
+length of line~1. If $l+k>h$, some cropping is necessary, so we set |n:=h|
+and print `\.{...}' followed by
+$$\hbox{|trick_buf[(l+k-h+3)..k-1]|,}$$
+where subscripts of |trick_buf| are circular modulo |error_line|. The
+second line consists of |n|~spaces followed by |trick_buf[k..(k+m-1)]|,
+unless |n+m>error_line|; in the latter case, further cropping is done.
+This is easier to program than to explain.
+
+@<Local variables for formatting...@>=
+@!i:0..buf_size; {index into |buffer|}
+@!l:integer; {length of descriptive information on line 1}
+@!m:integer; {context information gathered for line 2}
+@!n:0..error_line; {length of line 1}
+@!p: integer; {starting or ending place in |trick_buf|}
+@!q: integer; {temporary index}
+
+@ The following code tells the print routines to gather
+the desired information.
+
+@d begin_pseudoprint==
+ begin l:=tally; tally:=0; selector:=pseudo;
+ trick_count:=1000000;
+ end
+@d set_trick_count==
+ begin first_count:=tally;
+ trick_count:=tally+1+error_line-half_error_line;
+ if trick_count<error_line then trick_count:=error_line;
+ end
+
+@ And the following code uses the information after it has been gathered.
+
+@<Print two lines using the tricky pseudoprinted information@>=
+if trick_count=1000000 then set_trick_count;
+ {|set_trick_count| must be performed}
+if tally<trick_count then m:=tally-first_count
+else m:=trick_count-first_count; {context on line 2}
+if l+first_count<=half_error_line then
+ begin p:=0; n:=l+first_count;
+ end
+else begin print("..."); p:=l+first_count-half_error_line+3;
+ n:=half_error_line;
+ end;
+for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]);
+print_ln;
+for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2}
+if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3);
+for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]);
+if m+n>error_line then print("...")
+
+@ But the trick is distracting us from our current goal, which is to
+understand the input state. So let's concentrate on the data structures that
+are being pseudoprinted as we finish up the |show_context| procedure.
+
+@<Pseudoprint the line@>=
+begin_pseudoprint;
+if limit>0 then for i:=start to limit-1 do
+ begin if i=loc then set_trick_count;
+ print(buffer[i]);
+ end
+
+@ @<Pseudoprint the token list@>=
+begin_pseudoprint;
+if token_type<>macro then show_token_list(start,loc,100000,0)
+else show_macro(start,loc,100000)
+
+@ Here is the missing piece of |show_token_list| that is activated when the
+token beginning line~2 is about to be shown:
+
+@<Do magic computation@>=set_trick_count
+
+@* \[28] Maintaining the input stacks.
+The following subroutines change the input status in commonly needed ways.
+
+First comes |push_input|, which stores the current state and creates a
+new level (having, initially, the same properties as the old).
+
+@d push_input==@t@> {enter a new input level, save the old}
+ begin if input_ptr>max_in_stack then
+ begin max_in_stack:=input_ptr;
+ if input_ptr=stack_size then overflow("input stack size",stack_size);
+@:MetaPost capacity exceeded input stack size}{\quad input stack size@>
+ end;
+ input_stack[input_ptr]:=cur_input; {stack the record}
+ incr(input_ptr);
+ end
+
+@ And of course what goes up must come down.
+
+@d pop_input==@t@> {leave an input level, re-enter the old}
+ begin decr(input_ptr); cur_input:=input_stack[input_ptr];
+ end
+
+@ Here is a procedure that starts a new level of token-list input, given
+a token list |p| and its type |t|. If |t=macro|, the calling routine should
+set |name|, reset~|loc|, and increase the macro's reference count.
+
+@d back_list(#)==begin_token_list(#,backed_up) {backs up a simple token list}
+
+@p procedure begin_token_list(@!p:pointer;@!t:quarterword);
+begin push_input; start:=p; token_type:=t;
+param_start:=param_ptr; loc:=p;
+end;
+
+@ When a token list has been fully scanned, the following computations
+should be done as we leave that level of input.
+@^inner loop@>
+
+@p procedure end_token_list; {leave a token-list input level}
+label done;
+var @!p:pointer; {temporary register}
+begin if token_type>=backed_up then {token list to be deleted}
+ if token_type<=inserted then
+ begin flush_token_list(start); goto done;
+ end
+ else delete_mac_ref(start); {update reference count}
+while param_ptr>param_start do {parameters must be flushed}
+ begin decr(param_ptr);
+ p:=param_stack[param_ptr];
+ if p<>null then
+ if link(p)=void then {it's an \&{expr} parameter}
+ begin recycle_value(p); free_node(p,value_node_size);
+ end
+ else flush_token_list(p); {it's a \&{suffix} or \&{text} parameter}
+ end;
+done: pop_input; check_interrupt;
+end;
+
+@ The contents of |cur_cmd,cur_mod,cur_sym| are placed into an equivalent
+token by the |cur_tok| routine.
+@^inner loop@>
+
+@p @t\4@>@<Declare the procedure called |make_exp_copy|@>@;@/
+function cur_tok:pointer;
+var @!p:pointer; {a new token node}
+@!save_type:small_number; {|cur_type| to be restored}
+@!save_exp:integer; {|cur_exp| to be restored}
+begin if cur_sym=0 then
+ if cur_cmd=capsule_token then
+ begin save_type:=cur_type; save_exp:=cur_exp;
+ make_exp_copy(cur_mod); p:=stash_cur_exp; link(p):=null;
+ cur_type:=save_type; cur_exp:=save_exp;
+ end
+ else begin p:=get_node(token_node_size);
+ value(p):=cur_mod; name_type(p):=token;
+ if cur_cmd=numeric_token then type(p):=known
+ else type(p):=string_type;
+ end
+else begin fast_get_avail(p); info(p):=cur_sym;
+ end;
+cur_tok:=p;
+end;
+
+@ Sometimes \MP\ has read too far and wants to ``unscan'' what it has
+seen. The |back_input| procedure takes care of this by putting the token
+just scanned back into the input stream, ready to be read again.
+If |cur_sym<>0|, the values of |cur_cmd| and |cur_mod| are irrelevant.
+
+@p procedure back_input; {undoes one token of input}
+var @!p:pointer; {a token list of length one}
+begin p:=cur_tok;
+while token_state and(loc=null) do end_token_list; {conserve stack space}
+back_list(p);
+end;
+
+@ The |back_error| routine is used when we want to restore or replace an
+offending token just before issuing an error message. We disable interrupts
+during the call of |back_input| so that the help message won't be lost.
+
+@p procedure back_error; {back up one token and call |error|}
+begin OK_to_interrupt:=false; back_input; OK_to_interrupt:=true; error;
+end;
+@#
+procedure ins_error; {back up one inserted token and call |error|}
+begin OK_to_interrupt:=false; back_input; token_type:=inserted;
+OK_to_interrupt:=true; error;
+end;
+
+@ The |begin_file_reading| procedure starts a new level of input for lines
+of characters to be read from a file, or as an insertion from the
+terminal. It does not take care of opening the file, nor does it set |loc|
+or |limit| or |line|.
+@^system dependencies@>
+
+@p procedure begin_file_reading;
+begin if in_open=max_in_open then overflow("text input levels",max_in_open);
+@:MetaPost capacity exceeded text input levels}{\quad text input levels@>
+if first=buf_size then overflow("buffer size",buf_size);
+@:MetaPost capacity exceeded buffer size}{\quad buffer size@>
+incr(in_open); push_input; index:=in_open;
+mpx_name[index]:=absent;
+start:=first;
+name:=is_term; {|terminal_input| is now |true|}
+end;
+
+@ Conversely, the variables must be downdated when such a level of input
+is finished. Any associated \.{MPX} file must also be closed and popped
+off the file stack.
+
+@p procedure end_file_reading;
+begin if in_open>index then
+ if (mpx_name[in_open]=absent)or(name<=max_spec_src) then confusion("endinput")
+@:this can't happen endinput}{\quad endinput@>
+ else begin a_close(input_file[in_open]); {close an \.{MPX} file}
+ delete_str_ref(mpx_name[in_open]);
+ decr(in_open);
+ end;
+first:=start;
+if index<>in_open then confusion("endinput");
+if name>max_spec_src then
+ begin a_close(cur_file);
+ delete_str_ref(name);
+ delete_str_ref(in_name); delete_str_ref(in_area);
+ end;
+pop_input; decr(in_open);
+end;
+
+@ Here is a function that tries to resume input from an \.{MPX} file already
+associated with the current input file. It returns |false| if this doesn't
+work.
+
+@p function begin_mpx_reading:boolean;
+begin if in_open<>index+1 then begin_mpx_reading:=false
+else begin if mpx_name[in_open]<=absent then confusion("mpx");
+@:this can't happen mpx}{\quad mpx@>
+ if first=buf_size then overflow("buffer size",buf_size);
+@:MetaPost capacity exceeded buffer size}{\quad buffer size@>
+ push_input; index:=in_open;
+ start:=first;
+ name:=mpx_name[in_open]; add_str_ref(name);
+ @<Put an empty line in the input buffer@>;
+ begin_mpx_reading:=true;
+ end;
+end;
+
+@ This procedure temporarily stops reading an \.{MPX} file.
+
+@p procedure end_mpx_reading;
+begin if in_open<>index then confusion("mpx");
+@:this can't happen mpx}{\quad mpx@>
+if loc<limit then
+ @<Complain that we are not at the end of a line in the \.{MPX} file@>;
+first:=start;
+pop_input;
+end;
+
+@ Here we enforce a restriction that simplifies the input stacks considerably.
+This should not inconvenience the user because \.{MPX} files are generated
+by an auxiliary program called \.{DVItoMP}.
+
+@ @<Complain that we are not at the end of a line in the \.{MPX} file@>=
+begin print_err("`mpxbreak' must be at the end of a line");
+help4("This file contains picture expressions for btex...etex")@/
+ ("blocks. Such files are normally generated automatically")@/
+ ("but this one seems to be messed up. I'm going to ignore")@/
+ ("the rest of this line.");@/
+error;
+end
+
+@ In order to keep the stack from overflowing during a long sequence of
+inserted `\.{show}' commands, the following routine removes completed
+error-inserted lines from memory.
+
+@p procedure clear_for_error_prompt;
+begin while file_state and terminal_input and@|
+ (input_ptr>0)and(loc=limit) do end_file_reading;
+print_ln; clear_terminal;
+end;
+
+@ To get \MP's whole input mechanism going, we perform the following
+actions.
+
+@<Initialize the input routines@>=
+begin input_ptr:=0; max_in_stack:=0;
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+param_ptr:=0; max_param_stack:=0;
+first:=1;
+start:=1; index:=0; line:=0; name:=is_term;
+mpx_name[0]:=absent;
+force_eof:=false;
+if not init_terminal then goto final_end;
+limit:=last; first:=last+1; {|init_terminal| has set |loc| and |last|}
+end;
+
+@* \[29] Getting the next token.
+The heart of \MP's input mechanism is the |get_next| procedure, which
+we shall develop in the next few sections of the program. Perhaps we
+shouldn't actually call it the ``heart,'' however; it really acts as \MP's
+eyes and mouth, reading the source files and gobbling them up. And it also
+helps \MP\ to regurgitate stored token lists that are to be processed again.
+
+The main duty of |get_next| is to input one token and to set |cur_cmd|
+and |cur_mod| to that token's command code and modifier. Furthermore, if
+the input token is a symbolic token, that token's |hash| address
+is stored in |cur_sym|; otherwise |cur_sym| is set to zero.
+
+Underlying this simple description is a certain amount of complexity
+because of all the cases that need to be handled.
+However, the inner loop of |get_next| is reasonably short and fast.
+
+@ Before getting into |get_next|, we need to consider a mechanism by which
+\MP\ helps keep errors from propagating too far. Whenever the program goes
+into a mode where it keeps calling |get_next| repeatedly until a certain
+condition is met, it sets |scanner_status| to some value other than |normal|.
+Then if an input file ends, or if an `\&{outer}' symbol appears,
+an appropriate error recovery will be possible.
+
+The global variable |warning_info| helps in this error recovery by providing
+additional information. For example, |warning_info| might indicate the
+name of a macro whose replacement text is being scanned.
+
+@d normal=0 {|scanner_status| at ``quiet times''}
+@d skipping=1 {|scanner_status| when false conditional text is being skipped}
+@d flushing=2 {|scanner_status| when junk after a statement is being ignored}
+@d absorbing=3 {|scanner_status| when a \&{text} parameter is being scanned}
+@d var_defining=4 {|scanner_status| when a \&{vardef} is being scanned}
+@d op_defining=5 {|scanner_status| when a macro \&{def} is being scanned}
+@d loop_defining=6 {|scanner_status| when a \&{for} loop is being scanned}
+@d tex_flushing=7 {|scanner_status| when skipping \TeX\ material}
+
+@<Glob...@>=
+@!scanner_status:normal..tex_flushing; {are we scanning at high speed?}
+@!warning_info:integer; {if so, what else do we need to know,
+ in case an error occurs?}
+
+@ @<Initialize the input routines@>=
+scanner_status:=normal;
+
+@ The following subroutine
+is called when an `\&{outer}' symbolic token has been scanned or
+when the end of a file has been reached. These two cases are distinguished
+by |cur_sym|, which is zero at the end of a file.
+
+@p function check_outer_validity:boolean;
+var @!p:pointer; {points to inserted token list}
+begin if scanner_status=normal then check_outer_validity:=true
+else if scanner_status=tex_flushing then
+ @<Check if the file has ended while flushing \TeX\ material and set the
+ result value for |check_outer_validity|@>
+else begin deletions_allowed:=false;
+ @<Back up an outer symbolic token so that it can be reread@>;
+ if scanner_status>skipping then
+ @<Tell the user what has run away and try to recover@>
+ else begin print_err("Incomplete if; all text was ignored after line ");
+@.Incomplete if...@>
+ print_int(warning_info);@/
+ help3("A forbidden `outer' token occurred in skipped text.")@/
+ ("This kind of error happens when you say `if...' and forget")@/
+ ("the matching `fi'. I've inserted a `fi'; this might work.");
+ if cur_sym=0 then help_line[2]:=@|
+ "The file ended while I was skipping conditional text.";
+ cur_sym:=frozen_fi; ins_error;
+ end;
+ deletions_allowed:=true; check_outer_validity:=false;
+ end;
+end;
+
+@ @<Check if the file has ended while flushing \TeX\ material and set...@>=
+if cur_sym<>0 then check_outer_validity:=true
+else begin deletions_allowed:=false;
+ print_err("TeX mode didn't end; all text was ignored after line ");
+ print_int(warning_info);
+ help2("The file ended while I was looking for the `etex' to")@/
+ ("finish this TeX material. I've inserted `etex' now.");@/
+ cur_sym := frozen_etex;
+ ins_error;@/
+ deletions_allowed:=true; check_outer_validity:=false;
+ end
+
+@ @<Back up an outer symbolic token so that it can be reread@>=
+if cur_sym<>0 then
+ begin p:=get_avail; info(p):=cur_sym;
+ back_list(p); {prepare to read the symbolic token again}
+ end
+
+@ @<Tell the user what has run away...@>=
+begin runaway; {print the definition-so-far}
+if cur_sym=0 then print_err("File ended")
+@.File ended while scanning...@>
+else begin print_err("Forbidden token found");
+@.Forbidden token found...@>
+ end;
+print(" while scanning ");
+help4("I suspect you have forgotten an `enddef',")@/
+("causing me to read past where you wanted me to stop.")@/
+("I'll try to recover; but if the error is serious,")@/
+("you'd better type `E' or `X' now and fix your file.");@/
+case scanner_status of
+@t\4@>@<Complete the error message,
+ and set |cur_sym| to a token that might help recover from the error@>@;
+end; {there are no other cases}
+ins_error;
+end
+
+@ As we consider various kinds of errors, it is also appropriate to
+change the first line of the help message just given; |help_line[3]|
+points to the string that might be changed.
+
+@<Complete the error message,...@>=
+flushing: begin print("to the end of the statement");
+ help_line[3]:="A previous error seems to have propagated,";
+ cur_sym:=frozen_semicolon;
+ end;
+absorbing: begin print("a text argument");
+ help_line[3]:="It seems that a right delimiter was left out,";
+ if warning_info=0 then cur_sym:=frozen_end_group
+ else begin cur_sym:=frozen_right_delimiter;
+ equiv(frozen_right_delimiter):=warning_info;
+ end;
+ end;
+var_defining, op_defining: begin print("the definition of ");
+ if scanner_status=op_defining then print(text(warning_info))
+ else print_variable_name(warning_info);
+ cur_sym:=frozen_end_def;
+ end;
+loop_defining: begin print("the text of a "); print(text(warning_info));
+ print(" loop");
+ help_line[3]:="I suspect you have forgotten an `endfor',";
+ cur_sym:=frozen_end_for;
+ end;
+
+@ The |runaway| procedure displays the first part of the text that occurred
+when \MP\ began its special |scanner_status|, if that text has been saved.
+
+@<Declare the procedure called |runaway|@>=
+procedure runaway;
+begin if scanner_status>flushing then
+ begin print_nl("Runaway ");
+ case scanner_status of
+ absorbing: print("text?");
+ var_defining,op_defining: print("definition?");
+ loop_defining: print("loop?");
+ end; {there are no other cases}
+ print_ln; show_token_list(link(hold_head),null,error_line-10,0);
+ end;
+end;
+
+@ We need to mention a procedure that may be called by |get_next|.
+
+@p procedure@?firm_up_the_line; forward;
+
+@ And now we're ready to take the plunge into |get_next| itself.
+Note that the behavior depends on the |scanner_status| because percent signs
+and double quotes need to be passed over when skipping TeX material.
+
+@d switch=25 {a label in |get_next|}
+@d start_numeric_token=85 {another}
+@d start_decimal_token=86 {and another}
+@d fin_numeric_token=87
+ {and still another, although |goto| is considered harmful}
+
+@p procedure get_next; {sets |cur_cmd|, |cur_mod|, |cur_sym| to next token}
+@^inner loop@>
+label restart, {go here to get the next input token}
+ exit, {go here when the next input token has been got}
+ common_ending, {go here to finish getting a symbolic token}
+ found, {go here when the end of a symbolic token has been found}
+ switch, {go here to branch on the class of an input character}
+ start_numeric_token,start_decimal_token,fin_numeric_token,done;
+ {go here at crucial stages when scanning a number}
+var @!k:0..buf_size; {an index into |buffer|}
+@!c:ASCII_code; {the current character in the buffer}
+@!class:ASCII_code; {its class number}
+@!n,@!f:integer; {registers for decimal-to-binary conversion}
+begin restart: cur_sym:=0;
+if file_state then
+@<Input from external file; |goto restart| if no input found,
+ or |return| if a non-symbolic token is found@>
+else @<Input from token list; |goto restart| if end of list or
+ if a parameter needs to be expanded,
+ or |return| if a non-symbolic token is found@>;
+common_ending: @<Finish getting the symbolic token in |cur_sym|;
+ |goto restart| if it is illegal@>;
+exit:end;
+
+@ When a symbolic token is declared to be `\&{outer}', its command code
+is increased by |outer_tag|.
+@^inner loop@>
+
+@<Finish getting the symbolic token in |cur_sym|...@>=
+cur_cmd:=eq_type(cur_sym); cur_mod:=equiv(cur_sym);
+if cur_cmd>=outer_tag then
+ if check_outer_validity then cur_cmd:=cur_cmd-outer_tag
+ else goto restart
+
+@ A percent sign appears in |buffer[limit]|; this makes it unnecessary
+to have a special test for end-of-line.
+@^inner loop@>
+
+@<Input from external file;...@>=
+begin switch: c:=buffer[loc]; incr(loc); class:=char_class[c];
+case class of
+digit_class: goto start_numeric_token;
+period_class: begin class:=char_class[buffer[loc]];
+ if class>period_class then goto switch
+ else if class<period_class then {|class=digit_class|}
+ begin n:=0; goto start_decimal_token;
+ end;
+@:. }{\..\ token@>
+ end;
+space_class: goto switch;
+percent_class: begin if scanner_status=tex_flushing then
+ if loc<limit then goto switch;
+ @<Move to next line of file, or |goto restart| if there is no next line@>;
+ check_interrupt;
+ goto switch;
+ end;
+string_class: if scanner_status=tex_flushing then goto switch
+ else @<Get a string token and |return|@>;
+isolated_classes: begin k:=loc-1; goto found;
+ end;
+invalid_class: if scanner_status=tex_flushing then goto switch
+ else @<Decry the invalid character and |goto restart|@>;
+othercases do_nothing {letters, etc.}
+endcases;@/
+k:=loc-1;
+while char_class[buffer[loc]]=class do incr(loc);
+goto found;
+start_numeric_token:@<Get the integer part |n| of a numeric token;
+ set |f:=0| and |goto fin_numeric_token| if there is no decimal point@>;
+start_decimal_token:@<Get the fraction part |f| of a numeric token@>;
+fin_numeric_token:@<Pack the numeric and fraction parts of a numeric token
+ and |return|@>;
+found: cur_sym:=id_lookup(k,loc-k);
+end
+
+@ We go to |restart| instead of to |switch|, because |state| might equal
+|token_list| after the error has been dealt with
+(cf.\ |clear_for_error_prompt|).
+
+@<Decry the invalid...@>=
+begin print_err("Text line contains an invalid character");
+@.Text line contains...@>
+help2("A funny symbol that I can't read has just been input.")@/
+("Continue, and I'll forget that it ever happened.");@/
+deletions_allowed:=false; error; deletions_allowed:=true;
+goto restart;
+end
+
+@ @<Get a string token and |return|@>=
+begin if buffer[loc]="""" then cur_mod:=""
+else begin k:=loc; buffer[limit+1]:="""";
+ repeat incr(loc);
+ until buffer[loc]="""";
+ if loc>limit then @<Decry the missing string delimiter and |goto restart|@>;
+ if loc=k+1 then cur_mod:=buffer[k]
+ else begin str_room(loc-k);
+ repeat append_char(buffer[k]); incr(k);
+ until k=loc;
+ cur_mod:=make_string;
+ end;
+ end;
+incr(loc); cur_cmd:=string_token; return;
+end
+
+@ We go to |restart| after this error message, not to |switch|,
+because the |clear_for_error_prompt| routine might have reinstated
+|token_state| after |error| has finished.
+
+@<Decry the missing string delimiter and |goto restart|@>=
+begin loc:=limit; {the next character to be read on this line will be |"%"|}
+print_err("Incomplete string token has been flushed");
+@.Incomplete string token...@>
+help3("Strings should finish on the same line as they began.")@/
+ ("I've deleted the partial string; you might want to")@/
+ ("insert another by typing, e.g., `I""new string""'.");@/
+deletions_allowed:=false; error; deletions_allowed:=true; goto restart;
+end
+
+@ @<Get the integer part |n| of a numeric token...@>=
+n:=c-"0";
+while char_class[buffer[loc]]=digit_class do
+ begin if n<32768 then n:=10*n+buffer[loc]-"0";
+ incr(loc);
+ end;
+if buffer[loc]="." then if char_class[buffer[loc+1]]=digit_class then goto done;
+f:=0; goto fin_numeric_token;
+done: incr(loc)
+
+@ @<Get the fraction part |f| of a numeric token@>=
+k:=0;
+repeat if k<17 then {digits for |k>=17| cannot affect the result}
+ begin dig[k]:=buffer[loc]-"0"; incr(k);
+ end;
+incr(loc);
+until char_class[buffer[loc]]<>digit_class;
+f:=round_decimals(k);
+if f=unity then
+ begin incr(n); f:=0;
+ end
+
+@ @<Pack the numeric and fraction parts of a numeric token and |return|@>=
+if n<32768 then @<Set |cur_mod:=n*unity+f| and check if it is uncomfortably
+ large@>
+else if scanner_status<>tex_flushing then
+ begin print_err("Enormous number has been reduced");
+@.Enormous number...@>
+ help2("I can't handle numbers bigger than 32767.99998;")@/
+ ("so I've changed your constant to that maximum amount.");@/
+ deletions_allowed:=false; error; deletions_allowed:=true;
+ cur_mod:=el_gordo;
+ end;
+cur_cmd:=numeric_token; return
+
+@ @<Set |cur_mod:=n*unity+f| and check if it is uncomfortably large@>=
+begin cur_mod:=n*unity+f;
+if cur_mod>=fraction_one then
+ if (internal[warning_check]>0) and (scanner_status<>tex_flushing) then
+ begin print_err("Number is too large (");
+ print_scaled(cur_mod);
+ print_char(")");
+ help3("It is at least 4096. Continue and I'll try to cope")@/
+ ("with that big value; but it might be dangerous.")@/
+ ("(Set warningcheck:=0 to suppress this message.)");
+ error;
+ end;
+end
+
+@ Let's consider now what happens when |get_next| is looking at a token list.
+@^inner loop@>
+
+@<Input from token list;...@>=
+if loc>=hi_mem_min then {one-word token}
+ begin cur_sym:=info(loc); loc:=link(loc); {move to next}
+ if cur_sym>=expr_base then
+ if cur_sym>=suffix_base then
+ @<Insert a suffix or text parameter and |goto restart|@>
+ else begin cur_cmd:=capsule_token;
+ cur_mod:=param_stack[param_start+cur_sym-(expr_base)];
+ cur_sym:=0; return;
+ end;
+ end
+else if loc>null then
+ @<Get a stored numeric or string or capsule token and |return|@>
+else begin {we are done with this token list}
+ end_token_list; goto restart; {resume previous level}
+ end
+
+@ @<Insert a suffix or text parameter...@>=
+begin if cur_sym>=text_base then cur_sym:=cur_sym-param_size;
+ {|param_size=text_base-suffix_base|}
+begin_token_list(param_stack[param_start+cur_sym-(suffix_base)],parameter);
+goto restart;
+end
+
+@ @<Get a stored numeric or string or capsule token...@>=
+begin if name_type(loc)=token then
+ begin cur_mod:=value(loc);
+ if type(loc)=known then cur_cmd:=numeric_token
+ else begin cur_cmd:=string_token; add_str_ref(cur_mod);
+ end;
+ end
+else begin cur_mod:=loc; cur_cmd:=capsule_token;
+ end;
+loc:=link(loc); return;
+end
+
+@ All of the easy branches of |get_next| have now been taken care of.
+There is one more branch.
+
+@<Move to next line of file, or |goto restart|...@>=
+if name>max_spec_src then @<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>
+else begin if input_ptr>0 then
+ {text was inserted during error recovery or by \&{scantokens}}
+ begin end_file_reading; goto restart; {resume previous level}
+ end;
+ if selector<log_only then open_log_file;
+ if interaction>nonstop_mode then
+ begin if limit=start then {previous line was empty}
+ print_nl("(Please type a command or say `end')");
+@.Please type...@>
+ print_ln; first:=start;
+ prompt_input("*"); {input on-line into |buffer|}
+@.*\relax@>
+ limit:=last; buffer[limit]:="%";
+ first:=limit+1; loc:=start;
+ end
+ else fatal_error("*** (job aborted, no legal end found)");
+@.job aborted@>
+ {nonstop mode, which is intended for overnight batch processing,
+ never waits for on-line input}
+ end
+
+@ The global variable |force_eof| is normally |false|; it is set |true|
+by an \&{endinput} command.
+
+@<Glob...@>=
+@!force_eof:boolean; {should the next \&{input} be aborted early?}
+
+@ We must decrement |loc| in order to leave the buffer in a valid state
+when an error condition causes us to |goto restart| without calling
+|end_file_reading|.
+
+@<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>=
+begin incr(line); first:=start;
+if not force_eof then
+ begin if input_ln(cur_file,true) then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else force_eof:=true;
+ end;
+if force_eof then
+ begin force_eof:=false;
+ decr(loc);
+ if mpx_reading then
+ @<Complain that the \.{MPX} file ended unexpectly; then set
+ |cur_sym:=frozen_mpx_break| and |goto comon_ending|@>
+ else begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ end_file_reading; {resume previous level}
+ if check_outer_validity then goto restart @+else goto restart;
+ end
+ end;
+buffer[limit]:="%"; first:=limit+1; loc:=start; {ready to read}
+end
+
+@ We should never actually come to the end of an \.{MPX} file because such
+files should have an \&{mpxbreak} after the translation of the last
+\&{btex}$\,\ldots\,$\&{etex} block.
+
+@<Complain that the \.{MPX} file ended unexpectly; then set...@>=
+begin mpx_name[index]:=finished;
+print_err("mpx file ended unexpectedly");
+help4("The file had too few picture expressions for btex...etex")@/
+ ("blocks. Such files are normally generated automatically")@/
+ ("but this one got messed up. You might want to insert a")@/
+ ("picture expression now.");@/
+deletions_allowed:=false; error; deletions_allowed:=true;
+cur_sym:=frozen_mpx_break; goto common_ending;
+end
+
+@ Sometimes we want to make it look as though we have just read a blank line
+without really doing so.
+
+@<Put an empty line in the input buffer@>=
+last:=first; limit:=last; {simulate |input_ln| and |firm_up_the_line|}
+buffer[limit]:="%"; first:=limit+1; loc:=start
+
+@ If the user has set the |pausing| parameter to some positive value,
+and if nonstop mode has not been selected, each line of input is displayed
+on the terminal and the transcript file, followed by `\.{=>}'.
+\MP\ waits for a response. If the response is null (i.e., if nothing is
+typed except perhaps a few blank spaces), the original
+line is accepted as it stands; otherwise the line typed is
+used instead of the line in the file.
+
+@p procedure firm_up_the_line;
+var @!k:0..buf_size; {an index into |buffer|}
+begin limit:=last;
+if internal[pausing]>0 then if interaction>nonstop_mode then
+ begin wake_up_terminal; print_ln;
+ if start<limit then for k:=start to limit-1 do print(buffer[k]);
+ first:=limit; prompt_input("=>"); {wait for user response}
+@.=>@>
+ if last>first then
+ begin for k:=first to last-1 do {move line down in buffer}
+ buffer[k+start-first]:=buffer[k];
+ limit:=start+last-first;
+ end;
+ end;
+end;
+
+@* \[30] Dealing with \TeX\ material.
+The \&{btex}$\,\ldots\,$\&{etex} and \&{verbatimtex}$\,\ldots\,$\&{etex}
+features need to be implemented at a low level in the scanning process
+so that \MP\ can stay in synch with the a preprocessor that treats
+blocks of \TeX\ material as they occur in the input file without trying
+to expand \MP\ macros. Thus we need a special version of |get_next|
+that does not expand macros and such but does handle \&{btex},
+\&{verbatimtex}, etc.
+
+The special version of |get_next| is called |get_t_next|. It works by flushing
+\&{btex}$\,\ldots\,$\&{etex} and \&{verbatimtex}\allowbreak
+$\,\ldots\,$\&{etex} blocks, switching to the \.{MPX} file when it sees
+\&{btex}, and switching back when it sees \&{mpxbreak}.
+
+@d btex_code=0
+@d verbatim_code=1
+
+@ @<Put each...@>=
+primitive("btex",start_tex,btex_code);@/
+@!@:btex_}{\&{btex} primitive@>
+primitive("verbatimtex",start_tex,verbatim_code);
+@!@:verbatimtex_}{\&{verbatimtex} primitive@>
+primitive("etex",etex_marker,0); eqtb[frozen_etex]:=eqtb[cur_sym];@/
+@!@:etex_}{\&{etex} primitive@>
+primitive("mpxbreak",mpx_break,0); eqtb[frozen_mpx_break]:=eqtb[cur_sym];@/
+@!@:mpx_break_}{\&{mpxbreak} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+start_tex: if m=btex_code then print("btex")
+ else print("verbatimtex");
+etex_marker: print("etex");
+mpx_break: print("mpxbreak");
+
+@ Actually, |get_t_next| is a macro that avoids procedure overhead except
+in the unusual case where \&{btex}, \&{verbatimtex}, \&{etex}, or \&{mpxbreak}
+is encountered.
+
+@d get_t_next==begin get_next;
+ if cur_cmd<=max_pre_command then t_next;
+ end
+@d TeX_flush=65 {go here to flush to the next ``\&{etex}''}
+
+@p procedure@?start_mpx_input; forward;@t\2@>
+procedure t_next;
+label TeX_flush, common_ending;
+var @!old_status:normal..loop_defining; {saves the |scanner_status|}
+@!old_info:integer; {saves the |warning_info|}
+begin while cur_cmd<=max_pre_command do
+ begin if cur_cmd=mpx_break then
+ if not file_state or (mpx_name[index]=absent) then
+ @<Complain about a misplaced \&{mpxbreak}@>
+ else begin end_mpx_reading; goto TeX_flush;
+ end
+ else if cur_cmd=start_tex then
+ if token_state or (name<=max_spec_src) then
+ @<Complain that we are not reading a file@>
+ else if mpx_reading then
+ @<Complain that \.{MPX} files cannot contain \TeX\ material@>
+ else if (cur_mod<>verbatim_code)and(mpx_name[index]<>finished) then
+ begin if not begin_mpx_reading then start_mpx_input;
+ end
+ else goto TeX_flush
+ else @<Complain about a misplaced \&{etex}@>;
+ goto common_ending;
+TeX_flush: @<Flush the \TeX\ material@>;
+common_ending: get_next;
+ end;
+end;
+
+@ We could be in the middle of an operation such as skipping false conditional
+text when \TeX\ material is encountered, so we must be careful to save the
+|scanner_status|.
+
+@<Flush the \TeX\ material@>=
+old_status:=scanner_status;
+old_info:=warning_info;
+scanner_status:=tex_flushing;
+warning_info:=line;
+repeat get_next;
+until cur_cmd=etex_marker;
+scanner_status:=old_status;
+warning_info:=old_info
+
+@ @<Complain that \.{MPX} files cannot contain \TeX\ material@>=
+begin print_err("An mpx file cannot contain btex or verbatimtex blocks");
+help4("This file contains picture expressions for btex...etex")@/
+ ("blocks. Such files are normally generated automatically")@/
+ ("but this one seems to be messed up. I'll just keep going")@/
+ ("and hope for the best.");@/
+error;
+end
+
+@ @<Complain that we are not reading a file@>=
+begin print_err("You can only use `btex' or `verbatimtex' in a file");
+help3("I'll have to ignore this preprocessor command because it")@/
+ ("only works when there is a file to preprocess. You might")@/
+ ("want to delete everything up to the next `etex`.");@/
+error;
+end
+
+@ @<Complain about a misplaced \&{mpxbreak}@>=
+begin print_err("Misplaced mpxbreak");
+help2("I'll ignore this preprocessor command because it")@/
+ ("doesn't belong here");@/
+error;
+end
+
+@ @<Complain about a misplaced \&{etex}@>=
+begin print_err("Extra etex will be ignored");
+help1("There is no btex or verbatimtex for this to match");@/
+error;
+end
+
+@* \[31] Scanning macro definitions.
+\MP\ has a variety of ways to tuck tokens away into token lists for later
+use: Macros can be defined with \&{def}, \&{vardef}, \&{primarydef}, etc.;
+repeatable code can be defined with \&{for}, \&{forever}, \&{forsuffixes}.
+All such operations are handled by the routines in this part of the program.
+
+The modifier part of each command code is zero for the ``ending delimiters''
+like \&{enddef} and \&{endfor}.
+
+@d start_def=1 {command modifier for \&{def}}
+@d var_def=2 {command modifier for \&{vardef}}
+@d end_def=0 {command modifier for \&{enddef}}
+@d start_forever=1 {command modifier for \&{forever}}
+@d end_for=0 {command modifier for \&{endfor}}
+
+@<Put each...@>=
+primitive("def",macro_def,start_def);@/
+@!@:def_}{\&{def} primitive@>
+primitive("vardef",macro_def,var_def);@/
+@!@:var_def_}{\&{vardef} primitive@>
+primitive("primarydef",macro_def,secondary_primary_macro);@/
+@!@:primary_def_}{\&{primarydef} primitive@>
+primitive("secondarydef",macro_def,tertiary_secondary_macro);@/
+@!@:secondary_def_}{\&{secondarydef} primitive@>
+primitive("tertiarydef",macro_def,expression_tertiary_macro);@/
+@!@:tertiary_def_}{\&{tertiarydef} primitive@>
+primitive("enddef",macro_def,end_def); eqtb[frozen_end_def]:=eqtb[cur_sym];@/
+@!@:end_def_}{\&{enddef} primitive@>
+@#
+primitive("for",iteration,expr_base);@/
+@!@:for_}{\&{for} primitive@>
+primitive("forsuffixes",iteration,suffix_base);@/
+@!@:for_suffixes_}{\&{forsuffixes} primitive@>
+primitive("forever",iteration,start_forever);@/
+@!@:forever_}{\&{forever} primitive@>
+primitive("endfor",iteration,end_for); eqtb[frozen_end_for]:=eqtb[cur_sym];@/
+@!@:end_for_}{\&{endfor} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+macro_def:if m<=var_def then
+ if m=start_def then print("def")
+ else if m<start_def then print("enddef")
+ else print("vardef")
+ else if m=secondary_primary_macro then print("primarydef")
+ else if m=tertiary_secondary_macro then print("secondarydef")
+ else print("tertiarydef");
+iteration: if m<=start_forever then
+ if m=start_forever then print("forever")@+else print("endfor")
+ else if m=expr_base then print("for")@+else print("forsuffixes");
+
+@ Different macro-absorbing operations have different syntaxes, but they
+also have a lot in common. There is a list of special symbols that are to
+be replaced by parameter tokens; there is a special command code that
+ends the definition; the quotation conventions are identical. Therefore
+it makes sense to have most of the work done by a single subroutine. That
+subroutine is called |scan_toks|.
+
+The first parameter to |scan_toks| is the command code that will
+terminate scanning (either |macro_def|, |loop_repeat|, or |iteration|).
+
+The second parameter, |subst_list|, points to a (possibly empty) list
+of two-word nodes whose |info| and |value| fields specify symbol tokens
+before and after replacement. The list will be returned to free storage
+by |scan_toks|.
+
+The third parameter is simply appended to the token list that is built.
+And the final parameter tells how many of the special operations
+\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#} are to be replaced by suffix parameters.
+When such parameters are present, they are called \.{(SUFFIX0)},
+\.{(SUFFIX1)}, and \.{(SUFFIX2)}.
+
+@p function scan_toks(@!terminator:command_code;
+ @!subst_list,@!tail_end:pointer;@!suffix_count:small_number):pointer;
+label done,found;
+var @!p:pointer; {tail of the token list being built}
+@!q:pointer; {temporary for link management}
+@!balance:integer; {left delimiters minus right delimiters}
+begin p:=hold_head; balance:=1; link(hold_head):=null;
+loop@+ begin get_t_next;
+ if cur_sym>0 then
+ begin @<Substitute for |cur_sym|, if it's on the |subst_list|@>;
+ if cur_cmd=terminator then
+ @<Adjust the balance; |goto done| if it's zero@>
+ else if cur_cmd=macro_special then
+ @<Handle quoted symbols, \.{\#\AT!}, \.{\AT!}, or \.{\AT!\#}@>;
+ end;
+ link(p):=cur_tok; p:=link(p);
+ end;
+done: link(p):=tail_end; flush_node_list(subst_list);
+scan_toks:=link(hold_head);
+end;
+
+@ @<Substitute for |cur_sym|...@>=
+begin q:=subst_list;
+while q<>null do
+ begin if info(q)=cur_sym then
+ begin cur_sym:=value(q); cur_cmd:=relax; goto found;
+ end;
+ q:=link(q);
+ end;
+found:end
+
+@ @<Adjust the balance; |goto done| if it's zero@>=
+if cur_mod>0 then incr(balance)
+else begin decr(balance);
+ if balance=0 then goto done;
+ end
+
+@ Four commands are intended to be used only within macro texts: \&{quote},
+\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#}. They are variants of a single command
+code called |macro_special|.
+
+@d quote=0 {|macro_special| modifier for \&{quote}}
+@d macro_prefix=1 {|macro_special| modifier for \.{\#\AT!}}
+@d macro_at=2 {|macro_special| modifier for \.{\AT!}}
+@d macro_suffix=3 {|macro_special| modifier for \.{\AT!\#}}
+
+@<Put each...@>=
+primitive("quote",macro_special,quote);@/
+@!@:quote_}{\&{quote} primitive@>
+primitive("#@@",macro_special,macro_prefix);@/
+@!@:]]]\#\AT!_}{\.{\#\AT!} primitive@>
+primitive("@@",macro_special,macro_at);@/
+@!@:]]]\AT!_}{\.{\AT!} primitive@>
+primitive("@@#",macro_special,macro_suffix);@/
+@!@:]]]\AT!\#_}{\.{\AT!\#} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+macro_special: case m of
+ macro_prefix: print("#@@");
+ macro_at: print_char("@@");
+ macro_suffix: print("@@#");
+ othercases print("quote")
+ endcases;
+
+@ @<Handle quoted...@>=
+begin if cur_mod=quote then get_t_next
+else if cur_mod<=suffix_count then cur_sym:=suffix_base-1+cur_mod;
+end
+
+@ Here is a routine that's used whenever a token will be redefined. If
+the user's token is unredefinable, the `|frozen_inaccessible|' token is
+substituted; the latter is redefinable but essentially impossible to use,
+hence \MP's tables won't get fouled up.
+
+@p procedure get_symbol; {sets |cur_sym| to a safe symbol}
+label restart;
+begin restart: get_t_next;
+if (cur_sym=0)or(cur_sym>frozen_inaccessible) then
+ begin print_err("Missing symbolic token inserted");
+@.Missing symbolic token...@>
+ help3("Sorry: You can't redefine a number, string, or expr.")@/
+ ("I've inserted an inaccessible symbol so that your")@/
+ ("definition will be completed without mixing me up too badly.");
+ if cur_sym>0 then
+ help_line[2]:="Sorry: You can't redefine my error-recovery tokens."
+ else if cur_cmd=string_token then delete_str_ref(cur_mod);
+ cur_sym:=frozen_inaccessible; ins_error; goto restart;
+ end;
+end;
+
+@ Before we actually redefine a symbolic token, we need to clear away its
+former value, if it was a variable. The following stronger version of
+|get_symbol| does that.
+
+@p procedure get_clear_symbol;
+begin get_symbol; clear_symbol(cur_sym,false);
+end;
+
+@ Here's another little subroutine; it checks that an equals sign
+or assignment sign comes along at the proper place in a macro definition.
+
+@p procedure check_equals;
+begin if cur_cmd<>equals then if cur_cmd<>assignment then
+ begin missing_err("=");@/
+@.Missing `='@>
+ help5("The next thing in this `def' should have been `=',")@/
+ ("because I've already looked at the definition heading.")@/
+ ("But don't worry; I'll pretend that an equals sign")@/
+ ("was present. Everything from here to `enddef'")@/
+ ("will be the replacement text of this macro.");
+ back_error;
+ end;
+end;
+
+@ A \&{primarydef}, \&{secondarydef}, or \&{tertiarydef} is rather easily
+handled now that we have |scan_toks|. In this case there are
+two parameters, which will be \.{EXPR0} and \.{EXPR1} (i.e.,
+|expr_base| and |expr_base+1|).
+
+@p procedure make_op_def;
+var @!m:command_code; {the type of definition}
+@!p,@!q,@!r:pointer; {for list manipulation}
+begin m:=cur_mod;@/
+get_symbol; q:=get_node(token_node_size);
+info(q):=cur_sym; value(q):=expr_base;@/
+get_clear_symbol; warning_info:=cur_sym;@/
+get_symbol; p:=get_node(token_node_size);
+info(p):=cur_sym; value(p):=expr_base+1; link(p):=q;@/
+get_t_next; check_equals;@/
+scanner_status:=op_defining; q:=get_avail; ref_count(q):=null;
+r:=get_avail; link(q):=r; info(r):=general_macro;
+link(r):=scan_toks(macro_def,p,null,0);
+scanner_status:=normal; eq_type(warning_info):=m;
+equiv(warning_info):=q; get_x_next;
+end;
+
+@ Parameters to macros are introduced by the keywords \&{expr},
+\&{suffix}, \&{text}, \&{primary}, \&{secondary}, and \&{tertiary}.
+
+@<Put each...@>=
+primitive("expr",param_type,expr_base);@/
+@!@:expr_}{\&{expr} primitive@>
+primitive("suffix",param_type,suffix_base);@/
+@!@:suffix_}{\&{suffix} primitive@>
+primitive("text",param_type,text_base);@/
+@!@:text_}{\&{text} primitive@>
+primitive("primary",param_type,primary_macro);@/
+@!@:primary_}{\&{primary} primitive@>
+primitive("secondary",param_type,secondary_macro);@/
+@!@:secondary_}{\&{secondary} primitive@>
+primitive("tertiary",param_type,tertiary_macro);@/
+@!@:tertiary_}{\&{tertiary} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+param_type:if m>=expr_base then
+ if m=expr_base then print("expr")
+ else if m=suffix_base then print("suffix")
+ else print("text")
+ else if m<secondary_macro then print("primary")
+ else if m=secondary_macro then print("secondary")
+ else print("tertiary");
+
+@ Let's turn next to the more complex processing associated with \&{def}
+and \&{vardef}. When the following procedure is called, |cur_mod|
+should be either |start_def| or |var_def|.
+
+@p @t\4@>@<Declare the procedure called |check_delimiter|@>@;
+@t\4@>@<Declare the function called |scan_declared_variable|@>@;
+procedure scan_def;
+var @!m:start_def..var_def; {the type of definition}
+@!n:0..3; {the number of special suffix parameters}
+@!k:0..param_size; {the total number of parameters}
+@!c:general_macro..text_macro; {the kind of macro we're defining}
+@!r:pointer; {parameter-substitution list}
+@!q:pointer; {tail of the macro token list}
+@!p:pointer; {temporary storage}
+@!base:halfword; {|expr_base|, |suffix_base|, or |text_base|}
+@!l_delim,@!r_delim:pointer; {matching delimiters}
+begin m:=cur_mod; c:=general_macro; link(hold_head):=null;@/
+q:=get_avail; ref_count(q):=null; r:=null;@/
+@<Scan the token or variable to be defined;
+ set |n|, |scanner_status|, and |warning_info|@>;
+k:=n;
+if cur_cmd=left_delimiter then
+ @<Absorb delimited parameters, putting them into lists |q| and |r|@>;
+if cur_cmd=param_type then
+ @<Absorb undelimited parameters, putting them into list |r|@>;
+check_equals;
+p:=get_avail; info(p):=c; link(q):=p;
+@<Attach the replacement text to the tail of node |p|@>;
+scanner_status:=normal; get_x_next;
+end;
+
+@ We don't put `|frozen_end_group|' into the replacement text of
+a \&{vardef}, because the user may want to redefine `\.{endgroup}'.
+
+@<Attach the replacement text to the tail of node |p|@>=
+if m=start_def then link(p):=scan_toks(macro_def,r,null,n)
+else begin q:=get_avail; info(q):=bg_loc; link(p):=q;
+ p:=get_avail; info(p):=eg_loc;
+ link(q):=scan_toks(macro_def,r,p,n);
+ end;
+if warning_info=bad_vardef then flush_token_list(value(bad_vardef))
+
+@ @<Glob...@>=
+@!bg_loc,@!eg_loc:1..hash_end;
+ {hash addresses of `\.{begingroup}' and `\.{endgroup}'}
+
+@ @<Scan the token or variable to be defined;...@>=
+if m=start_def then
+ begin get_clear_symbol; warning_info:=cur_sym; get_t_next;
+ scanner_status:=op_defining; n:=0;
+ eq_type(warning_info):=defined_macro; equiv(warning_info):=q;
+ end
+else begin p:=scan_declared_variable;
+ flush_variable(equiv(info(p)),link(p),true);
+ warning_info:=find_variable(p); flush_list(p);
+ if warning_info=null then @<Change to `\.{a bad variable}'@>;
+ scanner_status:=var_defining; n:=2;
+ if cur_cmd=macro_special then if cur_mod=macro_suffix then {\.{\AT!\#}}
+ begin n:=3; get_t_next;
+ end;
+ type(warning_info):=unsuffixed_macro-2+n; value(warning_info):=q;
+ end {|suffixed_macro=unsuffixed_macro+1|}
+
+@ @<Change to `\.{a bad variable}'@>=
+begin print_err("This variable already starts with a macro");
+@.This variable already...@>
+help2("After `vardef a' you can't say `vardef a.b'.")@/
+ ("So I'll have to discard this definition.");@/
+error; warning_info:=bad_vardef;
+end
+
+@ @<Initialize table entries...@>=
+name_type(bad_vardef):=root; link(bad_vardef):=frozen_bad_vardef;
+equiv(frozen_bad_vardef):=bad_vardef; eq_type(frozen_bad_vardef):=tag_token;
+
+@ @<Absorb delimited parameters, putting them into lists |q| and |r|@>=
+repeat l_delim:=cur_sym; r_delim:=cur_mod; get_t_next;
+if (cur_cmd=param_type)and(cur_mod>=expr_base) then base:=cur_mod
+else begin print_err("Missing parameter type; `expr' will be assumed");
+@.Missing parameter type@>
+ help1("You should've had `expr' or `suffix' or `text' here.");
+ back_error; base:=expr_base;
+ end;
+@<Absorb parameter tokens for type |base|@>;
+check_delimiter(l_delim,r_delim);
+get_t_next;
+until cur_cmd<>left_delimiter
+
+@ @<Absorb parameter tokens for type |base|@>=
+repeat link(q):=get_avail; q:=link(q); info(q):=base+k;@/
+get_symbol; p:=get_node(token_node_size); value(p):=base+k; info(p):=cur_sym;
+if k=param_size then overflow("parameter stack size",param_size);
+@:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@>
+incr(k); link(p):=r; r:=p; get_t_next;
+until cur_cmd<>comma
+
+@ @<Absorb undelimited parameters, putting them into list |r|@>=
+begin p:=get_node(token_node_size);
+if cur_mod<expr_base then
+ begin c:=cur_mod; value(p):=expr_base+k;
+ end
+else begin value(p):=cur_mod+k;
+ if cur_mod=expr_base then c:=expr_macro
+ else if cur_mod=suffix_base then c:=suffix_macro
+ else c:=text_macro;
+ end;
+if k=param_size then overflow("parameter stack size",param_size);
+incr(k); get_symbol; info(p):=cur_sym; link(p):=r; r:=p; get_t_next;
+if c=expr_macro then if cur_cmd=of_token then
+ begin c:=of_macro; p:=get_node(token_node_size);
+ if k=param_size then overflow("parameter stack size",param_size);
+ value(p):=expr_base+k; get_symbol; info(p):=cur_sym;
+ link(p):=r; r:=p; get_t_next;
+ end;
+end
+
+@* \[32] Expanding the next token.
+Only a few command codes |<min_command| can possibly be returned by
+|get_t_next|; in increasing order, they are
+|if_test|, |fi_or_else|, |input|, |iteration|, |repeat_loop|,
+|exit_test|, |relax|, |scan_tokens|, |expand_after|, and |defined_macro|.
+
+\MP\ usually gets the next token of input by saying |get_x_next|. This is
+like |get_t_next| except that it keeps getting more tokens until
+finding |cur_cmd>=min_command|. In other words, |get_x_next| expands
+macros and removes conditionals or iterations or input instructions that
+might be present.
+
+It follows that |get_x_next| might invoke itself recursively. In fact,
+there is massive recursion, since macro expansion can involve the
+scanning of arbitrarily complex expressions, which in turn involve
+macro expansion and conditionals, etc.
+@^recursion@>
+
+Therefore it's necessary to declare a whole bunch of |forward|
+procedures at this point, and to insert some other procedures
+that will be invoked by |get_x_next|.
+
+@p procedure@?scan_primary; forward;@t\2@>
+procedure@?scan_secondary; forward;@t\2@>
+procedure@?scan_tertiary; forward;@t\2@>
+procedure@?scan_expression; forward;@t\2@>
+procedure@?scan_suffix; forward;@t\2@>@/
+@t\4@>@<Declare the procedure called |macro_call|@>@;@/
+procedure@?get_boolean; forward;@t\2@>
+procedure@?pass_text; forward;@t\2@>
+procedure@?conditional; forward;@t\2@>
+procedure@?start_input; forward;@t\2@>
+procedure@?begin_iteration; forward;@t\2@>
+procedure@?resume_iteration; forward;@t\2@>
+procedure@?stop_iteration; forward;@t\2@>
+
+@ An auxiliary subroutine called |expand| is used by |get_x_next|
+when it has to do exotic expansion commands.
+
+@p procedure expand;
+var @!p:pointer; {for list manipulation}
+@!k:integer; {something that we hope is |<=buf_size|}
+@!j:pool_pointer; {index into |str_pool|}
+begin if internal[tracing_commands]>unity then if cur_cmd<>defined_macro then
+ show_cur_cmd_mod;
+case cur_cmd of
+if_test:conditional; {this procedure is discussed in Part 36 below}
+fi_or_else:@<Terminate the current conditional and skip to \&{fi}@>;
+input:@<Initiate or terminate input from a file@>;
+iteration:if cur_mod=end_for then
+ @<Scold the user for having an extra \&{endfor}@>
+ else begin_iteration; {this procedure is discussed in Part 37 below}
+repeat_loop: @<Repeat a loop@>;
+exit_test: @<Exit a loop if the proper time has come@>;
+relax: do_nothing;
+expand_after: @<Expand the token after the next token@>;
+scan_tokens: @<Put a string into the input buffer@>;
+defined_macro:macro_call(cur_mod,null,cur_sym);
+end; {there are no other cases}
+end;
+
+@ @<Scold the user...@>=
+begin print_err("Extra `endfor'");
+@.Extra `endfor'@>
+help2("I'm not currently working on a for loop,")@/
+ ("so I had better not try to end anything.");@/
+error;
+end
+
+@ The processing of \&{input} involves the |start_input| subroutine,
+which will be declared later; the processing of \&{endinput} is trivial.
+
+@<Put each...@>=
+primitive("input",input,0);@/
+@!@:input_}{\&{input} primitive@>
+primitive("endinput",input,1);@/
+@!@:end_input_}{\&{endinput} primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+input: if m=0 then print("input")@+else print("endinput");
+
+@ @<Initiate or terminate input...@>=
+if cur_mod>0 then force_eof:=true
+else start_input
+
+@ We'll discuss the complicated parts of loop operations later. For now
+it suffices to know that there's a global variable called |loop_ptr|
+that will be |null| if no loop is in progress.
+
+@<Repeat a loop@>=
+begin while token_state and(loc=null) do end_token_list; {conserve stack space}
+if loop_ptr=null then
+ begin print_err("Lost loop");
+@.Lost loop@>
+ help2("I'm confused; after exiting from a loop, I still seem")@/
+ ("to want to repeat it. I'll try to forget the problem.");@/
+ error;
+ end
+else resume_iteration; {this procedure is in Part 37 below}
+end
+
+@ @<Exit a loop if the proper time has come@>=
+begin get_boolean;
+if internal[tracing_commands]>unity then show_cmd_mod(nullary,cur_exp);
+if cur_exp=true_code then
+ if loop_ptr=null then
+ begin print_err("No loop is in progress");
+@.No loop is in progress@>
+ help1("Why say `exitif' when there's nothing to exit from?");
+ if cur_cmd=semicolon then error@+else back_error;
+ end
+ else @<Exit prematurely from an iteration@>
+else if cur_cmd<>semicolon then
+ begin missing_err(";");@/
+@.Missing `;'@>
+ help2("After `exitif <boolean exp>' I expect to see a semicolon.")@/
+ ("I shall pretend that one was there."); back_error;
+ end;
+end
+
+@ Here we use the fact that |forever_text| is the only |token_type| that
+is less than |loop_text|.
+
+@<Exit prematurely...@>=
+begin p:=null;
+repeat if file_state then end_file_reading
+else begin if token_type<=loop_text then p:=start;
+ end_token_list;
+ end;
+until p<>null;
+if p<>info(loop_ptr) then fatal_error("*** (loop confusion)");
+@.loop confusion@>
+stop_iteration; {this procedure is in Part 34 below}
+end
+
+@ @<Expand the token after the next token@>=
+begin get_t_next;
+p:=cur_tok; get_t_next;
+if cur_cmd<min_command then expand else back_input;
+back_list(p);
+end
+
+@ @<Put a string into the input buffer@>=
+begin get_x_next; scan_primary;
+if cur_type<>string_type then
+ begin disp_err(null,"Not a string");
+@.Not a string@>
+ help2("I'm going to flush this expression, since")@/
+ ("scantokens should be followed by a known string.");
+ put_get_flush_error(0);
+ end
+else begin back_input;
+ if length(cur_exp)>0 then @<Pretend we're reading a new one-line file@>;
+ end;
+end
+
+@ @<Pretend we're reading a new one-line file@>=
+begin begin_file_reading; name:=is_scantok;
+k:=first+length(cur_exp);
+if k>=max_buf_stack then
+ begin if k>=buf_size then
+ begin max_buf_stack:=buf_size;
+ overflow("buffer size",buf_size);
+@:MetaPost capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ max_buf_stack:=k+1;
+ end;
+j:=str_start[cur_exp]; limit:=k;
+while first<limit do
+ begin buffer[first]:=so(str_pool[j]); incr(j); incr(first);
+ end;
+buffer[limit]:="%"; first:=limit+1; loc:=start; flush_cur_exp(0);
+end
+
+@ Here finally is |get_x_next|.
+
+The expression scanning routines to be considered later
+communicate via the global quantities |cur_type| and |cur_exp|;
+we must be very careful to save and restore these quantities while
+macros are being expanded.
+@^inner loop@>
+
+@p procedure get_x_next;
+var @!save_exp:pointer; {a capsule to save |cur_type| and |cur_exp|}
+begin get_t_next;
+if cur_cmd<min_command then
+ begin save_exp:=stash_cur_exp;
+ repeat if cur_cmd=defined_macro then macro_call(cur_mod,null,cur_sym)
+ else expand;
+ get_t_next;
+ until cur_cmd>=min_command;
+ unstash_cur_exp(save_exp); {that restores |cur_type| and |cur_exp|}
+ end;
+end;
+
+@ Now let's consider the |macro_call| procedure, which is used to start up
+all user-defined macros. Since the arguments to a macro might be expressions,
+|macro_call| is recursive.
+@^recursion@>
+
+The first parameter to |macro_call| points to the reference count of the
+token list that defines the macro. The second parameter contains any
+arguments that have already been parsed (see below). The third parameter
+points to the symbolic token that names the macro. If the third parameter
+is |null|, the macro was defined by \&{vardef}, so its name can be
+reconstructed from the prefix and ``at'' arguments found within the
+second parameter.
+
+What is this second parameter? It's simply a linked list of one-word items,
+whose |info| fields point to the arguments. In other words, if |arg_list=null|,
+no arguments have been scanned yet; otherwise |info(arg_list)| points to
+the first scanned argument, and |link(arg_list)| points to the list of
+further arguments (if any).
+
+Arguments of type \&{expr} are so-called capsules, which we will
+discuss later when we concentrate on expressions; they can be
+recognized easily because their |link| field is |void|. Arguments of type
+\&{suffix} and \&{text} are token lists without reference counts.
+
+@ After argument scanning is complete, the arguments are moved to the
+|param_stack|. (They can't be put on that stack any sooner, because
+the stack is growing and shrinking in unpredictable ways as more arguments
+are being acquired.) Then the macro body is fed to the scanner; i.e.,
+the replacement text of the macro is placed at the top of the \MP's
+input stack, so that |get_t_next| will proceed to read it next.
+
+@<Declare the procedure called |macro_call|@>=
+@t\4@>@<Declare the procedure called |print_macro_name|@>@;
+@t\4@>@<Declare the procedure called |print_arg|@>@;
+@t\4@>@<Declare the procedure called |scan_text_arg|@>@;
+procedure macro_call(@!def_ref,@!arg_list,@!macro_name:pointer);
+ {invokes a user-defined control sequence}
+label found;
+var @!r:pointer; {current node in the macro's token list}
+@!p,@!q:pointer; {for list manipulation}
+@!n:integer; {the number of arguments}
+@!l_delim,@!r_delim:pointer; {a delimiter pair}
+@!tail:pointer; {tail of the argument list}
+begin r:=link(def_ref); add_mac_ref(def_ref);
+if arg_list=null then n:=0
+else @<Determine the number |n| of arguments already supplied,
+ and set |tail| to the tail of |arg_list|@>;
+if internal[tracing_macros]>0 then
+ @<Show the text of the macro being expanded, and the existing arguments@>;
+@<Scan the remaining arguments, if any; set |r| to the first token
+ of the replacement text@>;
+@<Feed the arguments and replacement text to the scanner@>;
+end;
+
+@ @<Show the text of the macro...@>=
+begin begin_diagnostic; print_ln; print_macro_name(arg_list,macro_name);
+if n=3 then print("@@#"); {indicate a suffixed macro}
+show_macro(def_ref,null,100000);
+if arg_list<>null then
+ begin n:=0; p:=arg_list;
+ repeat q:=info(p);
+ print_arg(q,n,0);
+ incr(n); p:=link(p);
+ until p=null;
+ end;
+end_diagnostic(false);
+end
+
+@ @<Declare the procedure called |print_macro_name|@>=
+procedure print_macro_name(@!a,@!n:pointer);
+var @!p,@!q:pointer; {they traverse the first part of |a|}
+begin if n<>null then print(text(n))
+else begin p:=info(a);
+ if p=null then print(text(info(info(link(a)))))
+ else begin q:=p;
+ while link(q)<>null do q:=link(q);
+ link(q):=info(link(a));
+ show_token_list(p,null,1000,0);
+ link(q):=null;
+ end;
+ end;
+end;
+
+@ @<Declare the procedure called |print_arg|@>=
+procedure print_arg(@!q:pointer;@!n:integer;@!b:pointer);
+begin if link(q)=void then print_nl("(EXPR")
+else if (b<text_base)and(b<>text_macro) then print_nl("(SUFFIX")
+else print_nl("(TEXT");
+print_int(n); print(")<-");
+if link(q)=void then print_exp(q,1)
+else show_token_list(q,null,1000,0);
+end;
+
+@ @<Determine the number |n| of arguments already supplied...@>=
+begin n:=1; tail:=arg_list;
+while link(tail)<>null do
+ begin incr(n); tail:=link(tail);
+ end;
+end
+
+@ @<Scan the remaining arguments, if any; set |r|...@>=
+cur_cmd:=comma+1; {anything |<>comma| will do}
+while info(r)>=expr_base do
+ begin @<Scan the delimited argument represented by |info(r)|@>;
+ r:=link(r);
+ end;
+if cur_cmd=comma then
+ begin print_err("Too many arguments to ");
+@.Too many arguments...@>
+ print_macro_name(arg_list,macro_name); print_char(";");
+ print_nl(" Missing `"); print(text(r_delim));
+@.Missing `)'...@>
+ print("' has been inserted");
+ help3("I'm going to assume that the comma I just read was a")@/
+ ("right delimiter, and then I'll begin expanding the macro.")@/
+ ("You might want to delete some tokens before continuing.");
+ error;
+ end;
+if info(r)<>general_macro then @<Scan undelimited argument(s)@>;
+r:=link(r)
+
+@ At this point, the reader will find it advisable to review the explanation
+of token list format that was presented earlier, paying special attention to
+the conventions that apply only at the beginning of a macro's token list.
+
+On the other hand, the reader will have to take the expression-parsing
+aspects of the following program on faith; we will explain |cur_type|
+and |cur_exp| later. (Several things in this program depend on each other,
+and it's necessary to jump into the circle somewhere.)
+
+@<Scan the delimited argument represented by |info(r)|@>=
+if cur_cmd<>comma then
+ begin get_x_next;
+ if cur_cmd<>left_delimiter then
+ begin print_err("Missing argument to ");
+@.Missing argument...@>
+ print_macro_name(arg_list,macro_name);
+ help3("That macro has more parameters than you thought.")@/
+ ("I'll continue by pretending that each missing argument")@/
+ ("is either zero or null.");
+ if info(r)>=suffix_base then
+ begin cur_exp:=null; cur_type:=token_list;
+ end
+ else begin cur_exp:=0; cur_type:=known;
+ end;
+ back_error; cur_cmd:=right_delimiter; goto found;
+ end;
+ l_delim:=cur_sym; r_delim:=cur_mod;
+ end;
+@<Scan the argument represented by |info(r)|@>;
+if cur_cmd<>comma then @<Check that the proper right delimiter was present@>;
+found: @<Append the current expression to |arg_list|@>
+
+@ @<Check that the proper right delim...@>=
+if (cur_cmd<>right_delimiter)or(cur_mod<>l_delim) then
+ if info(link(r))>=expr_base then
+ begin missing_err(",");
+@.Missing `,'@>
+ help3("I've finished reading a macro argument and am about to")@/
+ ("read another; the arguments weren't delimited correctly.")@/
+ ("You might want to delete some tokens before continuing.");
+ back_error; cur_cmd:=comma;
+ end
+ else begin missing_err(text(r_delim));
+@.Missing `)'@>
+ help2("I've gotten to the end of the macro parameter list.")@/
+ ("You might want to delete some tokens before continuing.");
+ back_error;
+ end
+
+@ A \&{suffix} or \&{text} parameter will be have been scanned as
+a token list pointed to by |cur_exp|, in which case we will have
+|cur_type=token_list|.
+
+@<Append the current expression to |arg_list|@>=
+begin p:=get_avail;
+if cur_type=token_list then info(p):=cur_exp
+else info(p):=stash_cur_exp;
+if internal[tracing_macros]>0 then
+ begin begin_diagnostic; print_arg(info(p),n,info(r)); end_diagnostic(false);
+ end;
+if arg_list=null then arg_list:=p
+else link(tail):=p;
+tail:=p; incr(n);
+end
+
+@ @<Scan the argument represented by |info(r)|@>=
+if info(r)>=text_base then scan_text_arg(l_delim,r_delim)
+else begin get_x_next;
+ if info(r)>=suffix_base then scan_suffix
+ else scan_expression;
+ end
+
+@ The parameters to |scan_text_arg| are either a pair of delimiters
+or zero; the latter case is for undelimited text arguments, which
+end with the first semicolon or \&{endgroup} or \&{end} that is not
+contained in a group.
+
+@<Declare the procedure called |scan_text_arg|@>=
+procedure scan_text_arg(@!l_delim,@!r_delim:pointer);
+label done;
+var @!balance:integer; {excess of |l_delim| over |r_delim|}
+@!p:pointer; {list tail}
+begin warning_info:=l_delim; scanner_status:=absorbing;
+p:=hold_head; balance:=1; link(hold_head):=null;
+loop@+ begin get_t_next;
+ if l_delim=0 then @<Adjust the balance for an undelimited argument;
+ |goto done| if done@>
+ else @<Adjust the balance for a delimited argument;
+ |goto done| if done@>;
+ link(p):=cur_tok; p:=link(p);
+ end;
+done: cur_exp:=link(hold_head); cur_type:=token_list;
+scanner_status:=normal;
+end;
+
+@ @<Adjust the balance for a delimited argument...@>=
+begin if cur_cmd=right_delimiter then
+ begin if cur_mod=l_delim then
+ begin decr(balance);
+ if balance=0 then goto done;
+ end;
+ end
+else if cur_cmd=left_delimiter then if cur_mod=r_delim then incr(balance);
+end
+
+@ @<Adjust the balance for an undelimited...@>=
+begin if end_of_statement then {|cur_cmd=semicolon|, |end_group|, or |stop|}
+ begin if balance=1 then goto done
+ else if cur_cmd=end_group then decr(balance);
+ end
+else if cur_cmd=begin_group then incr(balance);
+end
+
+@ @<Scan undelimited argument(s)@>=
+begin if info(r)<text_macro then
+ begin get_x_next;
+ if info(r)<>suffix_macro then
+ if (cur_cmd=equals)or(cur_cmd=assignment) then get_x_next;
+ end;
+case info(r) of
+primary_macro:scan_primary;
+secondary_macro:scan_secondary;
+tertiary_macro:scan_tertiary;
+expr_macro:scan_expression;
+of_macro:@<Scan an expression followed by `\&{of} $\langle$primary$\rangle$'@>;
+suffix_macro:@<Scan a suffix with optional delimiters@>;
+text_macro:scan_text_arg(0,0);
+end; {there are no other cases}
+back_input; @<Append the current expression to |arg_list|@>;
+end
+
+@ @<Scan an expression followed by `\&{of} $\langle$primary$\rangle$'@>=
+begin scan_expression; p:=get_avail; info(p):=stash_cur_exp;
+if internal[tracing_macros]>0 then
+ begin begin_diagnostic; print_arg(info(p),n,0); end_diagnostic(false);
+ end;
+if arg_list=null then arg_list:=p@+else link(tail):=p;
+tail:=p;incr(n);
+if cur_cmd<>of_token then
+ begin missing_err("of"); print(" for ");
+@.Missing `of'@>
+ print_macro_name(arg_list,macro_name);
+ help1("I've got the first argument; will look now for the other.");
+ back_error;
+ end;
+get_x_next; scan_primary;
+end
+
+@ @<Scan a suffix with optional delimiters@>=
+begin if cur_cmd<>left_delimiter then l_delim:=null
+else begin l_delim:=cur_sym; r_delim:=cur_mod; get_x_next;
+ end;
+scan_suffix;
+if l_delim<>null then
+ begin if(cur_cmd<>right_delimiter)or(cur_mod<>l_delim) then
+ begin missing_err(text(r_delim));
+@.Missing `)'@>
+ help2("I've gotten to the end of the macro parameter list.")@/
+ ("You might want to delete some tokens before continuing.");
+ back_error;
+ end;
+ get_x_next;
+ end;
+end
+
+@ Before we put a new token list on the input stack, it is wise to clean off
+all token lists that have recently been depleted. Then a user macro that ends
+with a call to itself will not require unbounded stack space.
+
+@<Feed the arguments and replacement text to the scanner@>=
+while token_state and(loc=null) do end_token_list; {conserve stack space}
+if param_ptr+n>max_param_stack then
+ begin max_param_stack:=param_ptr+n;
+ if max_param_stack>param_size then
+ overflow("parameter stack size",param_size);
+@:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@>
+ end;
+begin_token_list(def_ref,macro); name:=macro_name; loc:=r;
+if n>0 then
+ begin p:=arg_list;
+ repeat param_stack[param_ptr]:=info(p); incr(param_ptr); p:=link(p);
+ until p=null;
+ flush_list(arg_list);
+ end
+
+@ It's sometimes necessary to put a single argument onto |param_stack|.
+The |stack_argument| subroutine does this.
+
+@p procedure stack_argument(@!p:pointer);
+begin if param_ptr=max_param_stack then
+ begin incr(max_param_stack);
+ if max_param_stack>param_size then
+ overflow("parameter stack size",param_size);
+@:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@>
+ end;
+param_stack[param_ptr]:=p; incr(param_ptr);
+end;
+
+@* \[33] Conditional processing.
+Let's consider now the way \&{if} commands are handled.
+
+Conditions can be inside conditions, and this nesting has a stack
+that is independent of other stacks.
+Four global variables represent the top of the condition stack:
+|cond_ptr| points to pushed-down entries, if~any; |cur_if| tells whether
+we are processing \&{if} or \&{elseif}; |if_limit| specifies
+the largest code of a |fi_or_else| command that is syntactically legal;
+and |if_line| is the line number at which the current conditional began.
+
+If no conditions are currently in progress, the condition stack has the
+special state |cond_ptr=null|, |if_limit=normal|, |cur_if=0|, |if_line=0|.
+Otherwise |cond_ptr| points to a two-word node; the |type|, |name_type|, and
+|link| fields of the first word contain |if_limit|, |cur_if|, and
+|cond_ptr| at the next level, and the second word contains the
+corresponding |if_line|.
+
+@d if_node_size=2 {number of words in stack entry for conditionals}
+@d if_line_field(#)==mem[#+1].int
+@d if_code=1 {code for \&{if} being evaluated}
+@d fi_code=2 {code for \&{fi}}
+@d else_code=3 {code for \&{else}}
+@d else_if_code=4 {code for \&{elseif}}
+
+@<Glob...@>=
+@!cond_ptr:pointer; {top of the condition stack}
+@!if_limit:normal..else_if_code; {upper bound on |fi_or_else| codes}
+@!cur_if:small_number; {type of conditional being worked on}
+@!if_line:integer; {line where that conditional began}
+
+@ @<Set init...@>=
+cond_ptr:=null; if_limit:=normal; cur_if:=0; if_line:=0;
+
+@ @<Put each...@>=
+primitive("if",if_test,if_code);@/
+@!@:if_}{\&{if} primitive@>
+primitive("fi",fi_or_else,fi_code); eqtb[frozen_fi]:=eqtb[cur_sym];@/
+@!@:fi_}{\&{fi} primitive@>
+primitive("else",fi_or_else,else_code);@/
+@!@:else_}{\&{else} primitive@>
+primitive("elseif",fi_or_else,else_if_code);@/
+@!@:else_if_}{\&{elseif} primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+if_test,fi_or_else: case m of
+ if_code:print("if");
+ fi_code:print("fi");
+ else_code:print("else");
+ othercases print("elseif")
+ endcases;
+
+@ Here is a procedure that ignores text until coming to an \&{elseif},
+\&{else}, or \&{fi} at level zero of $\&{if}\ldots\&{fi}$
+nesting. After it has acted, |cur_mod| will indicate the token that
+was found.
+
+\MP's smallest two command codes are |if_test| and |fi_or_else|; this
+makes the skipping process a bit simpler.
+
+@p procedure pass_text;
+label done;
+var l:integer;
+begin scanner_status:=skipping; l:=0; warning_info:=true_line;
+loop@+ begin get_t_next;
+ if cur_cmd<=fi_or_else then
+ if cur_cmd<fi_or_else then incr(l)
+ else begin if l=0 then goto done;
+ if cur_mod=fi_code then decr(l);
+ end
+ else @<Decrease the string reference count,
+ if the current token is a string@>;
+ end;
+done: scanner_status:=normal;
+end;
+
+@ @<Decrease the string reference count...@>=
+if cur_cmd=string_token then delete_str_ref(cur_mod)
+
+@ When we begin to process a new \&{if}, we set |if_limit:=if_code|; then
+if \&{elseif} or \&{else} or \&{fi} occurs before the current \&{if}
+condition has been evaluated, a colon will be inserted.
+A construction like `\.{if fi}' would otherwise get \MP\ confused.
+
+@<Push the condition stack@>=
+begin p:=get_node(if_node_size); link(p):=cond_ptr; type(p):=if_limit;
+name_type(p):=cur_if; if_line_field(p):=if_line;
+cond_ptr:=p; if_limit:=if_code; if_line:=true_line; cur_if:=if_code;
+end
+
+@ @<Pop the condition stack@>=
+begin p:=cond_ptr; if_line:=if_line_field(p);
+cur_if:=name_type(p); if_limit:=type(p); cond_ptr:=link(p);
+free_node(p,if_node_size);
+end
+
+@ Here's a procedure that changes the |if_limit| code corresponding to
+a given value of |cond_ptr|.
+
+@p procedure change_if_limit(@!l:small_number;@!p:pointer);
+label exit;
+var q:pointer;
+begin if p=cond_ptr then if_limit:=l {that's the easy case}
+else begin q:=cond_ptr;
+ loop@+ begin if q=null then confusion("if");
+@:this can't happen if}{\quad if@>
+ if link(q)=p then
+ begin type(q):=l; return;
+ end;
+ q:=link(q);
+ end;
+ end;
+exit:end;
+
+@ The user is supposed to put colons into the proper parts of conditional
+statements. Therefore, \MP\ has to check for their presence.
+
+@p procedure check_colon;
+begin if cur_cmd<>colon then
+ begin missing_err(":");@/
+@.Missing `:'@>
+ help2("There should've been a colon after the condition.")@/
+ ("I shall pretend that one was there.");@;
+ back_error;
+ end;
+end;
+
+@ A condition is started when the |get_x_next| procedure encounters
+an |if_test| command; in that case |get_x_next| calls |conditional|,
+which is a recursive procedure.
+@^recursion@>
+
+@p procedure conditional;
+label exit,done,reswitch,found;
+var @!save_cond_ptr:pointer; {|cond_ptr| corresponding to this conditional}
+@!new_if_limit:fi_code..else_if_code; {future value of |if_limit|}
+@!p:pointer; {temporary register}
+begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
+reswitch: get_boolean; new_if_limit:=else_if_code;
+if internal[tracing_commands]>unity then
+ @<Display the boolean value of |cur_exp|@>;
+found: check_colon;
+if cur_exp=true_code then
+ begin change_if_limit(new_if_limit,save_cond_ptr);
+ return; {wait for \&{elseif}, \&{else}, or \&{fi}}
+ end;
+@<Skip to \&{elseif} or \&{else} or \&{fi}, then |goto done|@>;
+done: cur_if:=cur_mod; if_line:=true_line;
+if cur_mod=fi_code then @<Pop the condition stack@>
+else if cur_mod=else_if_code then goto reswitch
+else begin cur_exp:=true_code; new_if_limit:=fi_code; get_x_next; goto found;
+ end;
+exit:end;
+
+@ In a construction like `\&{if} \&{if} \&{true}: $0=1$: \\{foo}
+\&{else}: \\{bar} \&{fi}', the first \&{else}
+that we come to after learning that the \&{if} is false is not the
+\&{else} we're looking for. Hence the following curious logic is needed.
+
+@<Skip to \&{elseif}...@>=
+loop@+ begin pass_text;
+ if cond_ptr=save_cond_ptr then goto done
+ else if cur_mod=fi_code then @<Pop the condition stack@>;
+ end
+
+
+@ @<Display the boolean value...@>=
+begin begin_diagnostic;
+if cur_exp=true_code then print("{true}")@+else print("{false}");
+end_diagnostic(false);
+end
+
+@ The processing of conditionals is complete except for the following
+code, which is actually part of |get_x_next|. It comes into play when
+\&{elseif}, \&{else}, or \&{fi} is scanned.
+
+@<Terminate the current conditional and skip to \&{fi}@>=
+if cur_mod>if_limit then
+ if if_limit=if_code then {condition not yet evaluated}
+ begin missing_err(":");
+@.Missing `:'@>
+ back_input; cur_sym:=frozen_colon; ins_error;
+ end
+ else begin print_err("Extra "); print_cmd_mod(fi_or_else,cur_mod);
+@.Extra else@>
+@.Extra elseif@>
+@.Extra fi@>
+ help1("I'm ignoring this; it doesn't match any if.");
+ error;
+ end
+else begin while cur_mod<>fi_code do pass_text; {skip to \&{fi}}
+ @<Pop the condition stack@>;
+ end
+
+@* \[34] Iterations.
+To bring our treatment of |get_x_next| to a close, we need to consider what
+\MP\ does when it sees \&{for}, \&{forsuffixes}, and \&{forever}.
+
+There's a global variable |loop_ptr| that keeps track of the \&{for} loops
+that are currently active. If |loop_ptr=null|, no loops are in progress;
+otherwise |info(loop_ptr)| points to the iterative text of the current
+(innermost) loop, and |link(loop_ptr)| points to the data for any other
+loops that enclose the current one.
+
+A loop-control node also has two other fields, called |loop_type| and
+|loop_list|, whose contents depend on the type of loop:
+
+\yskip\indent|loop_type(loop_ptr)=null| means that |loop_list(loop_ptr)|
+points to a list of one-word nodes whose |info| fields point to the
+remaining argument values of a suffix list and expression list.
+
+\yskip\indent|loop_type(loop_ptr)=void| means that the current loop is
+`\&{forever}'.
+
+\yskip\indent|loop_type(loop_ptr)=progression_flag| means that
+|p=loop_list(loop_ptr)| points to a ``progression node'' and |value(p)|,
+|step_size(p)|, and |final_value(p)| contain the data for an arithmetic
+progression.
+
+\yskip\indent|loop_type(loop_ptr)=p>void| means that |p| points to an edge
+header and |loop_list(loop_ptr)| points into the graphical object list for
+that edge header.
+
+\yskip\noindent In the case of a progression node, the first word is not used
+because the link field of words in the dynamic memory area cannot be arbitrary.
+
+@d loop_list_loc(#)==#+1 {where the |loop_list| field resides}
+@d loop_type(#)==info(loop_list_loc(#)) {the type of \&{for} loop}
+@d loop_list(#)==link(loop_list_loc(#)) {the remaining list elements}
+@d loop_node_size=2 {the number of words in a loop control node}
+@d progression_node_size=4 {the number of words in a progression node}
+@d step_size(#)==mem[#+2].sc {the step size in an arithmetic progression}
+@d final_value(#)==mem[#+3].sc {the final value in an arithmetic progression}
+@d progression_flag==null+2
+ {|loop_type| value when |loop_list| points to a progression node}
+
+@<Glob...@>=
+@!loop_ptr:pointer; {top of the loop-control-node stack}
+
+@ @<Set init...@>=
+loop_ptr:=null;
+
+@ If the expressions that define an arithmetic progression in
+a \&{for} loop don't have known numeric values, the |bad_for|
+subroutine screams at the user.
+
+@p procedure bad_for(@!s:str_number);
+begin disp_err(null,"Improper "); {show the bad expression above the message}
+@.Improper...replaced by 0@>
+print(s); print(" has been replaced by 0");
+help4("When you say `for x=a step b until c',")@/
+ ("the initial value `a' and the step size `b'")@/
+ ("and the final value `c' must have known numeric values.")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+put_get_flush_error(0);
+end;
+
+@ Here's what \MP\ does when \&{for}, \&{forsuffixes}, or \&{forever}
+has just been scanned. (This code requires slight familiarity with
+expression-parsing routines that we have not yet discussed; but it seems
+to belong in the present part of the program, even though the original author
+didn't write it until later. The reader may wish to come back to it.)
+
+@p procedure begin_iteration;
+label continue,done;
+var @!m:halfword; {|expr_base| (\&{for}) or |suffix_base| (\&{forsuffixes})}
+@!n:halfword; {hash address of the current symbol}
+@!s:pointer; {the new loop-control node}
+@!p:pointer; {substitution list for |scan_toks|}
+@!q:pointer; {link manipulation register}
+@!pp:pointer; {a new progression node}
+begin m:=cur_mod; n:=cur_sym; s:=get_node(loop_node_size);
+if m=start_forever then
+ begin loop_type(s):=void; p:=null; get_x_next;
+ end
+else begin get_symbol; p:=get_node(token_node_size);
+ info(p):=cur_sym; value(p):=m;@/
+ get_x_next;
+ if cur_cmd=within_token then @<Set up a picture iteration@>
+ else begin @<Check for the |"="| or |":="| in a loop header@>;
+ @<Scan the values to be used in the loop@>;
+ end;
+ end;
+@<Check for the presence of a colon@>;
+@<Scan the loop text and put it on the loop control stack@>;
+resume_iteration;
+end;
+
+@ @<Check for the |"="| or |":="| in a loop header@>=
+if (cur_cmd<>equals)and(cur_cmd<>assignment) then
+ begin missing_err("=");@/
+@.Missing `='@>
+ help3("The next thing in this loop should have been `=' or `:='.")@/
+ ("But don't worry; I'll pretend that an equals sign")@/
+ ("was present, and I'll look for the values next.");@/
+ back_error;
+ end
+
+@ @<Check for the presence of a colon@>=
+if cur_cmd<>colon then
+ begin missing_err(":");@/
+@.Missing `:'@>
+ help3("The next thing in this loop should have been a `:'.")@/
+ ("So I'll pretend that a colon was present;")@/
+ ("everything from here to `endfor' will be iterated.");
+ back_error;
+ end
+
+@ We append a special |frozen_repeat_loop| token in place of the
+`\&{endfor}' at the end of the loop. This will come through \MP's scanner
+at the proper time to cause the loop to be repeated.
+
+(If the user tries some shenanigan like `\&{for} $\ldots$ \&{let} \&{endfor}',
+he will be foiled by the |get_symbol| routine, which keeps frozen
+tokens unchanged. Furthermore the |frozen_repeat_loop| is an \&{outer}
+token, so it won't be lost accidentally.)
+
+@ @<Scan the loop text...@>=
+q:=get_avail; info(q):=frozen_repeat_loop;
+scanner_status:=loop_defining; warning_info:=n;
+info(s):=scan_toks(iteration,p,q,0); scanner_status:=normal;@/
+link(s):=loop_ptr; loop_ptr:=s
+
+@ @<Initialize table...@>=
+eq_type(frozen_repeat_loop):=repeat_loop+outer_tag;
+text(frozen_repeat_loop):=" ENDFOR";
+
+@ The loop text is inserted into \MP's scanning apparatus by the
+|resume_iteration| routine.
+
+@p procedure resume_iteration;
+label not_found,exit;
+var @!p,@!q:pointer; {link registers}
+begin p:=loop_type(loop_ptr);
+if p=progression_flag then
+ begin p:=loop_list(loop_ptr); {now |p| points to a progression node}
+ cur_exp:=value(p);
+ if @<The arithmetic progression has ended@> then goto not_found;
+ cur_type:=known; q:=stash_cur_exp; {make |q| an \&{expr} argument}
+ value(p):=cur_exp+step_size(p); {set |value(p)| for the next iteration}
+ end
+else if p=null then
+ begin p:=loop_list(loop_ptr);
+ if p=null then goto not_found;
+ loop_list(loop_ptr):=link(p); q:=info(p); free_avail(p);
+ end
+else if p=void then
+ begin begin_token_list(info(loop_ptr),forever_text); return;
+ end
+else @<Make |q| a capsule containing the next picture component from
+ |loop_list(loop_ptr)| or |goto not_found|@>;
+begin_token_list(info(loop_ptr),loop_text);
+stack_argument(q);
+if internal[tracing_commands]>unity then @<Trace the start of a loop@>;
+return;
+not_found:stop_iteration;
+exit:end;
+
+@ @<The arithmetic progression has ended@>=
+((step_size(p)>0)and(cur_exp>final_value(p)))or@|
+ ((step_size(p)<0)and(cur_exp<final_value(p)))
+
+@ @<Trace the start of a loop@>=
+begin begin_diagnostic; print_nl("{loop value=");
+@.loop value=n@>
+if (q<>null)and(link(q)=void) then print_exp(q,1)
+else show_token_list(q,null,50,0);
+print_char("}"); end_diagnostic(false);
+end
+
+@ @<Make |q| a capsule containing the next picture component from...@>=
+begin q:=loop_list(loop_ptr);
+if q=null then goto not_found;
+skip_component(q)(goto not_found);
+cur_exp:=copy_objects(loop_list(loop_ptr),q);
+init_bbox(cur_exp);
+cur_type:=picture_type;@/
+loop_list(loop_ptr):=q;
+q:=stash_cur_exp;
+end
+
+@ A level of loop control disappears when |resume_iteration| has decided
+not to resume, or when an \&{exitif} construction has removed the loop text
+from the input stack.
+
+@p procedure stop_iteration;
+var @!p,@!q:pointer; {the usual}
+begin p:=loop_type(loop_ptr);
+if p=progression_flag then free_node(loop_list(loop_ptr),progression_node_size)
+else if p=null then
+ begin q:=loop_list(loop_ptr);
+ while q<>null do
+ begin p:=info(q);
+ if p<>null then
+ if link(p)=void then {it's an \&{expr} parameter}
+ begin recycle_value(p); free_node(p,value_node_size);
+ end
+ else flush_token_list(p); {it's a \&{suffix} or \&{text} parameter}
+ p:=q; q:=link(q); free_avail(p);
+ end;
+ end
+else if p>progression_flag then delete_edge_ref(p);
+p:=loop_ptr; loop_ptr:=link(p); flush_token_list(info(p));
+free_node(p,loop_node_size);
+end;
+
+@ Now that we know all about loop control, we can finish up
+the missing portion of |begin_iteration| and we'll be done.
+
+The following code is performed after the `\.=' has been scanned in
+a \&{for} construction (if |m=expr_base|) or a \&{forsuffixes} construction
+(if |m=suffix_base|).
+
+@<Scan the values to be used in the loop@>=
+loop_type(s):=null; q:=loop_list_loc(s); link(q):=null; {|link(q)=loop_list(s)|}
+repeat get_x_next;
+if m<>expr_base then scan_suffix
+else begin if cur_cmd>=colon then if cur_cmd<=comma then goto continue;
+ scan_expression;
+ if cur_cmd=step_token then if q=loop_list_loc(s) then
+ @<Prepare for step-until construction and |goto done|@>;
+ cur_exp:=stash_cur_exp;
+ end;
+link(q):=get_avail; q:=link(q); info(q):=cur_exp; cur_type:=vacuous;
+continue: until cur_cmd<>comma;
+done:
+
+@ @<Prepare for step-until construction and |goto done|@>=
+begin if cur_type<>known then bad_for("initial value");
+pp:=get_node(progression_node_size); value(pp):=cur_exp;@/
+get_x_next; scan_expression;
+if cur_type<>known then bad_for("step size");
+step_size(pp):=cur_exp;
+if cur_cmd<>until_token then
+ begin missing_err("until");@/
+@.Missing `until'@>
+ help2("I assume you meant to say `until' after `step'.")@/
+ ("So I'll look for the final value and colon next.");
+ back_error;
+ end;
+get_x_next; scan_expression;
+if cur_type<>known then bad_for("final value");
+final_value(pp):=cur_exp; loop_list(s):=pp;
+loop_type(s):=progression_flag; goto done;
+end
+
+@ The last case is when we have just seen ``\&{within}'', and we need to
+parse a picture expression and prepare to iterate over it.
+
+@<Set up a picture iteration@>=
+begin get_x_next;
+scan_expression;
+@<Make sure the current expression is a known picture@>;
+loop_type(s):=cur_exp; cur_type:=vacuous;@/
+q:=link(dummy_loc(cur_exp));
+if q<> null then
+ if is_start_or_stop(q) then
+ if skip_1component(q)=null then q:=link(q);
+loop_list(s):=q;
+end
+
+@ @<Make sure the current expression is a known picture@>=
+if cur_type<>picture_type then
+ begin
+ disp_err(null,"Improper iteration spec has been replaced by nullpicture");
+ help1("When you say `for x in p', p must be a known picture.");
+ put_get_flush_error(get_node(edge_header_size));
+ init_edges(cur_exp); cur_type:=picture_type;
+ end
+
+@* \[35] File names.
+It's time now to fret about file names. Besides the fact that different
+operating systems treat files in different ways, we must cope with the
+fact that completely different naming conventions are used by different
+groups of people. The following programs show what is required for one
+particular operating system; similar routines for other systems are not
+difficult to devise.
+@^system dependencies@>
+
+\MP\ assumes that a file name has three parts: the name proper; its
+``extension''; and a ``file area'' where it is found in an external file
+system. The extension of an input file is assumed to be
+`\.{.mp}' unless otherwise specified; it is `\.{.log}' on the
+transcript file that records each run of \MP; it is `\.{.tfm}' on the font
+metric files that describe characters in any fonts created by \MP; it is
+`\.{.ps}' or `.{\it nnn}' for some number {\it nnn} on the \ps\ output files;
+and it is `\.{.mem}' on the mem files written by \.{INIMP} to initialize \MP.
+The file area can be arbitrary on input files, but files are usually
+output to the user's current area. If an input file cannot be
+found on the specified area, \MP\ will look for it on a special system
+area; this special area is intended for commonly used input files.
+
+Simple uses of \MP\ refer only to file names that have no explicit
+extension or area. For example, a person usually says `\.{input} \.{cmr10}'
+instead of `\.{input} \.{cmr10.new}'. Simple file
+names are best, because they make the \MP\ source files portable;
+whenever a file name consists entirely of letters and digits, it should be
+treated in the same way by all implementations of \MP. However, users
+need the ability to refer to other files in their environment, especially
+when responding to error messages concerning unopenable files; therefore
+we want to let them use the syntax that appears in their favorite
+operating system.
+
+@ \MP\ uses the same conventions that have proved to be satisfactory for
+\TeX\ and \MF. In order to isolate the system-dependent aspects of file names,
+@^system dependencies@>
+the system-independent parts of \MP\ are expressed in terms
+of three system-dependent
+procedures called |begin_name|, |more_name|, and |end_name|. In
+essence, if the user-specified characters of the file name are $c_1\ldots c_n$,
+the system-independent driver program does the operations
+$$|begin_name|;\,|more_name|(c_1);\,\ldots\,;|more_name|(c_n);
+\,|end_name|.$$
+These three procedures communicate with each other via global variables.
+Afterwards the file name will appear in the string pool as three strings
+called |cur_name|\penalty10000\hskip-.05em,
+|cur_area|, and |cur_ext|; the latter two are null (i.e.,
+|""|), unless they were explicitly specified by the user.
+
+Actually the situation is slightly more complicated, because \MP\ needs
+to know when the file name ends. The |more_name| routine is a function
+(with side effects) that returns |true| on the calls |more_name|$(c_1)$,
+\dots, |more_name|$(c_{n-1})$. The final call |more_name|$(c_n)$
+returns |false|; or, it returns |true| and $c_n$ is the last character
+on the current input line. In other words,
+|more_name| is supposed to return |true| unless it is sure that the
+file name has been completely scanned; and |end_name| is supposed to be able
+to finish the assembly of |cur_name|, |cur_area|, and |cur_ext| regardless of
+whether $|more_name|(c_n)$ returned |true| or |false|.
+
+@<Glob...@>=
+@!cur_name:str_number; {name of file just scanned}
+@!cur_area:str_number; {file area just scanned, or \.{""}}
+@!cur_ext:str_number; {file extension just scanned, or \.{""}}
+
+@ It is easier to maintain reference counts if we assign initial values.
+
+@<Set init...@>=
+cur_name:=""; cur_area:=""; cur_ext:="";
+
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters. Note that these variables
+cannot be of type |pool_pointer| because a string pool compaction could occur
+while scanning a file name.
+
+@<Glob...@>=
+@!area_delimiter:integer;
+ {most recent `\.>' or `\.:' relative to |str_start[str_ptr]|}
+@!ext_delimiter:integer; {the relevant `\..', if any}
+
+@ Input files that can't be found in the user's area may appear in standard
+system areas called |MP_area| and |MF_area|. (The latter is used when the file
+extension is |".mf"|.) The standard system area for font metric files
+to be read is |MP_font_area|.
+This system area name will, of course, vary from place to place.
+@^system dependencies@>
+
+@d MP_area=="MPinputs:"
+@.MPinputs@>
+@d MF_area=="MFinputs:"
+@.MFinputs@>
+@d MP_font_area=="TeXfonts:"
+@.TeXfonts@>
+
+@ Here now is the first of the system-dependent routines for file name scanning.
+@^system dependencies@>
+
+@<Declare subroutines for parsing file names@>=
+procedure begin_name;
+begin delete_str_ref(cur_name); delete_str_ref(cur_area);
+delete_str_ref(cur_ext);@/
+area_delimiter:=-1; ext_delimiter:=-1;
+end;
+
+@ And here's the second.
+@^system dependencies@>
+
+@<Declare subroutines for parsing file names@>=
+function more_name(@!c:ASCII_code):boolean;
+begin if c=" " then more_name:=false
+else begin if (c=">")or(c=":") then
+ begin area_delimiter:=pool_ptr-str_start[str_ptr]; ext_delimiter:=-1;
+ end
+ else if (c=".")and(ext_delimiter<0) then
+ ext_delimiter:=pool_ptr-str_start[str_ptr];
+ str_room(1); append_char(c); {contribute |c| to the current string}
+ more_name:=true;
+ end;
+end;
+
+@ The third.
+@^system dependencies@>
+
+@<Declare subroutines for parsing file names@>=
+procedure end_name;
+var a,@!n,@!e:pool_pointer; {length of area, name, and extension}
+begin e:=pool_ptr-str_start[str_ptr]; {total length}
+if ext_delimiter<0 then ext_delimiter:=e;
+a:=area_delimiter+1; n:=ext_delimiter-a; e:=e-ext_delimiter;
+if a=0 then cur_area:=""
+else begin cur_area:=make_string;
+ chop_last_string(str_start[cur_area]+a);
+ end;
+if n=0 then cur_name:=""
+else begin cur_name:=make_string;
+ chop_last_string(str_start[cur_name]+n);
+ end;
+if e=0 then cur_ext:="" @+ else cur_ext:=make_string;
+end;
+
+@ Conversely, here is a routine that takes three strings and prints a file
+name that might have produced them. (The routine is system dependent, because
+some operating systems put the file area last instead of first.)
+@^system dependencies@>
+
+@<Basic printing...@>=
+procedure print_file_name(@!n,@!a,@!e:integer);
+begin print(a); print(n); print(e);
+end;
+
+@ Another system-dependent routine is needed to convert three internal
+\MP\ strings
+to the |name_of_file| value that is used to open files. The present code
+allows both lowercase and uppercase letters in the file name.
+@^system dependencies@>
+
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@<Declare subroutines for parsing file names@>=
+procedure pack_file_name(@!n,@!a,@!e:str_number);
+var @!k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start[a] to str_stop(a)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[n] to str_stop(n)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[e] to str_stop(e)-1 do append_to_name(so(str_pool[j]));
+if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+end;
+
+@ A messier routine is also needed, since mem file names must be scanned
+before \MP's string mechanism has been initialized. We shall use the
+global variable |MP_mem_default| to supply the text for default system areas
+and extensions related to mem files.
+@^system dependencies@>
+
+@d mem_default_length=15 {length of the |MP_mem_default| string}
+@d mem_area_length=6 {length of its area part}
+@d mem_ext_length=4 {length of its `\.{.mem}' part}
+@d mem_extension=".mem" {the extension, as a \.{WEB} constant}
+
+@<Glob...@>=
+@!MP_mem_default:packed array[1..mem_default_length] of char;
+
+@ @<Set init...@>=
+MP_mem_default:='MPlib:plain.mem';
+@.MPlib@>
+@.plain@>
+@^system dependencies@>
+
+@ @<Check the ``constant'' values for consistency@>=
+if mem_default_length>file_name_size then bad:=20;
+
+@ Here is the messy routine that was just mentioned. It sets |name_of_file|
+from the first |n| characters of |MP_mem_default|, followed by
+|buffer[a..b]|, followed by the last |mem_ext_length| characters of
+|MP_mem_default|.
+
+We dare not give error messages here, since \MP\ calls this routine before
+the |error| routine is ready to roll. Instead, we simply drop excess characters,
+since the error will be detected in another way when a strange file name
+isn't found.
+@^system dependencies@>
+
+@p procedure pack_buffered_name(@!n:small_number;@!a,@!b:integer);
+var @!k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:integer; {index into |buffer| or |MP_mem_default|}
+begin if n+b-a+1+mem_ext_length>file_name_size then
+ b:=a+file_name_size-n-1-mem_ext_length;
+k:=0;
+for j:=1 to n do append_to_name(xord[MP_mem_default[j]]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=mem_default_length-mem_ext_length+1 to mem_default_length do
+ append_to_name(xord[MP_mem_default[j]]);
+if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+end;
+
+@ Here is the only place we use |pack_buffered_name|. This part of the program
+becomes active when a ``virgin'' \MP\ is trying to get going, just after
+the preliminary initialization, or when the user is substituting another
+mem file by typing `\.\&' after the initial `\.{**}' prompt. The buffer
+contains the first line of input in |buffer[loc..(last-1)]|, where
+|loc<last| and |buffer[loc]<>" "|.
+
+@<Declare the function called |open_mem_file|@>=
+function open_mem_file:boolean;
+label found,exit;
+var @!j:0..buf_size; {the first space after the file name}
+begin j:=loc;
+if buffer[loc]="&" then
+ begin incr(loc); j:=loc; buffer[last]:=" ";
+ while buffer[j]<>" " do incr(j);
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(mem_file) then goto found;
+ pack_buffered_name(mem_area_length,loc,j-1);
+ {now try the system mem file area}
+ if w_open_in(mem_file) then goto found;
+ wake_up_terminal;
+ wterm_ln('Sorry, I can''t find that mem file;',' will try PLAIN.');
+@.Sorry, I can't find...@>
+ update_terminal;
+ end;
+ {now pull out all the stops: try for the system \.{plain} file}
+pack_buffered_name(mem_default_length-mem_ext_length,1,0);
+if not w_open_in(mem_file) then
+ begin wake_up_terminal;
+ wterm_ln('I can''t find the PLAIN mem file!');
+@.I can't find PLAIN...@>
+@.plain@>
+ open_mem_file:=false; return;
+ end;
+found:loc:=j; open_mem_file:=true;
+exit:end;
+
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine,
+which simply makes a \MP\ string from the value of |name_of_file|, should
+ideally be changed to deduce the full name of file~|f|, which is the file
+most recently opened, if it is possible to do this in a \PASCAL\ program.
+@^system dependencies@>
+
+This routine might be called after string memory has overflowed, hence
+we check for this before calling `|str_room|'.
+
+@p function make_name_string:str_number;
+var @!k:1..file_name_size; {index into |name_of_file|}
+begin if str_overflowed then
+ make_name_string:="?"
+else begin str_room(name_length);
+ for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+ make_name_string:=make_string;
+ end;
+end;
+function a_make_name_string(var @!f:alpha_file):str_number;
+begin a_make_name_string:=make_name_string;
+end;
+function b_make_name_string(var @!f:byte_file):str_number;
+begin b_make_name_string:=make_name_string;
+end;
+function w_make_name_string(var @!f:word_file):str_number;
+begin w_make_name_string:=make_name_string;
+end;
+
+@ Now let's consider the ``driver''
+routines by which \MP\ deals with file names
+in a system-independent manner. First comes a procedure that looks for a
+file name in the input by taking the information from the input buffer.
+(We can't use |get_next|, because the conversion to tokens would
+destroy necessary information.)
+
+This procedure doesn't allow semicolons or percent signs to be part of
+file names, because of other conventions of \MP.
+{\sl The {\logos METAFONT\/}book} doesn't
+use semicolons or percents immediately after file names, but some users
+no doubt will find it natural to do so; therefore system-dependent
+changes to allow such characters in file names should probably
+be made with reluctance, and only when an entire file name that
+includes special characters is ``quoted'' somehow.
+@^system dependencies@>
+
+@p procedure scan_file_name;
+label done;
+begin begin_name;
+while buffer[loc]=" " do incr(loc);
+loop@+begin if (buffer[loc]=";")or(buffer[loc]="%") then goto done;
+ if not more_name(buffer[loc]) then goto done;
+ incr(loc);
+ end;
+done: end_name;
+end;
+
+@ Here is another version that takes its input from a string.
+
+@<Declare subroutines for parsing file names@>=
+procedure str_scan_file(@!s:str_number);
+label done;
+var @!p,@!q:pool_pointer; {current position and stopping point}
+begin begin_name;
+p:=str_start[s]; q:=str_stop(s);
+while p<q do
+ begin if not more_name(so(str_pool[p])) then goto done;
+ incr(p);
+ end;
+done: end_name;
+end;
+
+@ The global variable |job_name| contains the file name that was first
+\&{input} by the user. This name is extended by `\.{.log}' and `\.{ps}' and
+`\.{.mem}' and `\.{.tfm}' in order to make the names of \MP's output files.
+
+@<Glob...@>=
+@!job_name:str_number; {principal file name}
+@!log_opened:boolean; {has the transcript file been opened?}
+@!log_name:str_number; {full name of the log file}
+
+@ Initially |job_name=0|; it becomes nonzero as soon as the true name is known.
+We have |job_name=0| if and only if the `\.{log}' file has not been opened,
+except of course for a short time just after |job_name| has become nonzero.
+
+@<Initialize the output...@>=job_name:=0; log_opened:=false;
+
+@ Here is a routine that manufactures the output file names, assuming that
+|job_name<>0|. It ignores and changes the current settings of |cur_area|
+and |cur_ext|.
+
+@d pack_cur_name==pack_file_name(cur_name,cur_area,cur_ext)
+
+@p procedure pack_job_name(@!s:str_number);
+ {|s = ".log"|, |".mem"|, |".ps"|, or .\\{nnn}}
+begin add_str_ref(s);
+delete_str_ref(cur_name); delete_str_ref(cur_area);
+delete_str_ref(cur_ext);@/
+cur_area:=""; cur_ext:=s;
+cur_name:=job_name; pack_cur_name;
+end;
+
+@ If some trouble arises when \MP\ tries to open a file, the following
+routine calls upon the user to supply another file name. Parameter~|s|
+is used in the error message to identify the type of file; parameter~|e|
+is the default extension if none is given. Upon exit from the routine,
+variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are
+ready for another attempt at file opening.
+
+@p procedure prompt_file_name(@!s,@!e:str_number);
+label done;
+var @!k:0..buf_size; {index into |buffer|}
+begin if interaction=scroll_mode then wake_up_terminal;
+if s="input file name" then print_err("I can't find file `")
+@.I can't find file x@>
+else print_err("I can't write on file `");
+@.I can't write on file x@>
+print_file_name(cur_name,cur_area,cur_ext); print("'.");
+if e="" then show_context;
+print_nl("Please type another "); print(s);
+@.Please type...@>
+if interaction<scroll_mode then
+ fatal_error("*** (job aborted, file error in nonstop mode)");
+@.job aborted, file error...@>
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+pack_cur_name;
+end;
+
+@ @<Scan file name in the buffer@>=
+begin begin_name; k:=first;
+while (buffer[k]=" ")and(k<last) do incr(k);
+loop@+ begin if k=last then goto done;
+ if not more_name(buffer[k]) then goto done;
+ incr(k);
+ end;
+done:end_name;
+end
+
+@ The |open_log_file| routine is used to open the transcript file and to help
+it catch up to what has previously been printed on the terminal.
+
+@p procedure open_log_file;
+var @!old_setting:0..max_selector; {previous |selector| setting}
+@!k:0..buf_size; {index into |months| and |buffer|}
+@!l:0..buf_size; {end of first input line}
+@!m:integer; {the current month}
+@!months:packed array [1..36] of char; {abbreviations of month names}
+begin old_setting:=selector;
+if job_name=0 then job_name:="mpout";
+pack_job_name(".log");
+while not a_open_out(log_file) do @<Try to get a different log file name@>;
+log_name:=a_make_name_string(log_file);
+selector:=log_only; log_opened:=true;
+@<Print the banner line, including the date and time@>;
+input_stack[input_ptr]:=cur_input; {make sure bottom level is in memory}
+print_nl("**");
+@.**@>
+l:=input_stack[0].limit_field-1; {last position of first line}
+for k:=1 to l do print(buffer[k]);
+print_ln; {now the transcript file contains the first line of input}
+selector:=old_setting+2; {|log_only| or |term_and_log|}
+end;
+
+@ Sometimes |open_log_file| is called at awkward moments when \MP\ is
+unable to print error messages or even to |show_context|.
+The |prompt_file_name| routine can result in a |fatal_error|, but the |error|
+routine will not be invoked because |log_opened| will be false.
+
+The normal idea of |batch_mode| is that nothing at all should be written
+on the terminal. However, in the unusual case that
+no log file could be opened, we make an exception and allow
+an explanatory message to be seen.
+
+Incidentally, the program always refers to the log file as a `\.{transcript
+file}', because some systems cannot use the extension `\.{.log}' for
+this file.
+
+@<Try to get a different log file name@>=
+begin selector:=term_only;
+prompt_file_name("transcript file name",".log");
+end
+
+@ @<Print the banner...@>=
+begin wlog(banner);
+print(mem_ident); print(" ");
+print_int(round_unscaled(internal[day])); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+m:=round_unscaled(internal[month]);
+for k:=3*m-2 to 3*m do wlog(months[k]);
+print_char(" "); print_int(round_unscaled(internal[year])); print_char(" ");
+m:=round_unscaled(internal[time]);
+print_dd(m div 60); print_char(":"); print_dd(m mod 60);
+end
+
+@ The |try_extension| function tries to open an input file determined by
+|cur_name|, |cur_area|, and the argument |ext|. It returns |false| if it
+can't find the file in |cur_area| or the appropriate system area.
+
+@p function try_extension(@!ext:str_number):boolean;
+begin pack_file_name(cur_name,cur_area,ext);
+in_name:=cur_name; in_area:=cur_area;
+if a_open_in(cur_file) then try_extension:=true
+else begin if str_vs_str(ext,".mf")=0 then in_area:=MF_area
+ else in_area:=MP_area;
+ pack_file_name(cur_name,in_area,ext);
+ try_extension:=a_open_in(cur_file);
+ end;
+end;
+
+@ After all calls to |try_extension|, we must make sure that we count references
+for |in_name| and |in_area| if they match |cur_name| and/or |cur_area|.
+
+@<Update the string reference counts for |in_name| and |in_area|@>=
+if in_name=cur_name then add_str_ref(cur_name);
+if in_area=cur_area then add_str_ref(cur_area)
+
+@ Let's turn now to the procedure that is used to initiate file reading
+when an `\.{input}' command is being processed.
+
+@p procedure start_input; {\MP\ will \.{input} something}
+label done;
+begin @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if cur_ext="" then
+ if try_extension(".mp") then goto done
+ else if try_extension("") then goto done
+ else if try_extension(".mf") then goto done
+ else do_nothing
+ else if try_extension(cur_ext) then goto done;
+ end_file_reading; {remove the level that didn't work}
+ prompt_file_name("input file name","");
+ end;
+done: name:=a_make_name_string(cur_file);
+@<Update the string reference counts for |in_name| and |in_area|@>;
+if job_name=0 then
+ begin job_name:=cur_name; str_ref[job_name]:=max_str_ref;
+ open_log_file;
+ end; {|open_log_file| doesn't |show_context|, so |limit|
+ and |loc| needn't be set to meaningful values yet}
+if term_offset+length(name)>max_print_line-2 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("("); incr(open_parens); print(name); update_terminal;
+@<Flush |name| and replace it with |cur_name| if it won't be needed@>;
+@<Read the first line of the new file@>;
+end;
+
+@ This code should be omitted if |a_make_name_string| returns something other
+than just a copy of its argument and the full file name is needed for opening
+\.{MPX} files or implementing the switch-to-editor option.
+@^system dependencies@>
+
+@<Flush |name| and replace it with |cur_name| if it won't be needed@>=
+flush_string(name); name:=cur_name; cur_name:=0
+
+@ Here we have to remember to tell the |input_ln| routine not to
+start with a |get|. If the file is empty, it is considered to
+contain a single blank line.
+@^system dependencies@>
+
+@<Read the first line...@>=
+begin line:=1;
+if input_ln(cur_file,false) then do_nothing;
+firm_up_the_line;
+buffer[limit]:="%"; first:=limit+1; loc:=start;
+end
+
+@ @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>=
+while token_state and(loc=null) do end_token_list;
+if token_state then
+ begin print_err("File names can't appear within macros");
+@.File names can't...@>
+ help3("Sorry...I've converted what follows to tokens,")@/
+ ("possibly garbaging the name you gave.")@/
+ ("Please delete the tokens and insert the name again.");@/
+ error;
+ end;
+if file_state then scan_file_name
+else begin cur_name:=""; cur_ext:=""; cur_area:="";
+ end
+
+@ Sometimes we need to deal with two file names at once. This procedure
+copies the given string into a special array for an old file name.
+
+@p procedure copy_old_name(s:str_number);
+var @!k:integer; {number of positions filled in |old_file_name|}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start[s] to str_stop(s)-1 do
+ begin incr(k);
+ if k<=file_name_size then old_file_name[k]:=xchr[so(str_pool[j])];
+ end;
+if k<=file_name_size then old_name_length:=k
+else old_name_length:=file_name_size;
+for k:=old_name_length+1 to file_name_size do @+old_file_name[k]:=' ';
+end;
+
+@ @<Glob...@>=
+@!old_file_name : packed array[1..file_name_size] of char;
+ {analogous to |name_of_file|}
+@!old_name_length : 0..file_name_size;
+ {this many relevant characters followed by blanks}
+
+@ The following simple routine starts reading the \.{MPX} file associated
+with the current input file.
+
+@p procedure start_mpx_input;
+label exit,not_found;
+var k:1..file_name_size;
+begin pack_file_name(in_name,in_area,".mpx");
+@<Try to make sure |name_of_file| refers to a valid \.{MPX} file and
+ |goto not_found| if there is a problem@>;
+begin_file_reading;
+if not a_open_in(cur_file) then
+ begin end_file_reading;
+ goto not_found;
+ end;
+name:=a_make_name_string(cur_file);
+mpx_name[index]:=name; add_str_ref(name);
+@<Read the first line of the new file@>;
+return;
+not_found: @<Explain that the \.{MPX} file can't be read and |succumb|@>;
+exit:end;
+
+@ This should ideally be changed to do whatever is necessary to create the
+\.{MPX} file given by |name_of_file| if it does not exist or if it is out
+of date. This requires invoking \.{MPtoTeX} on the |old_file_name| and passing
+the results through \TeX\ and \.{DVItoMP}. (It is possible to use a
+completely different typesetting program if suitable postprocessor is
+available to perform the function of \.{DVItoMP}.)
+@^system dependencies@>
+
+@<Try to make sure |name_of_file| refers to a valid \.{MPX} file and
+ |goto not_found| if there is a problem@>=
+copy_old_name(name)
+{System-dependent code should be added here}
+
+@ @<Explain that the \.{MPX} file can't be read and |succumb|@>=
+if interaction=error_stop_mode then wake_up_terminal;
+print_nl(">> ");
+for k:=1 to old_name_length do print(xord[old_file_name[k]]);
+print_nl(">> ");
+for k:=1 to name_length do print(xord[name_of_file[k]]);
+print_nl("! Unable to make mpx file");
+help4("The two files given above are one of your source files")@/
+ ("and an auxiliary file I need to read to find out what your")@/
+ ("btex..etex blocks mean. If you don't know why I had trouble,")@/
+ ("try running it manually through MPtoTeX, TeX, and DVItoMP");
+succumb;
+
+@ The last file-opening commands are for files accessed via the \&{readfrom}
+@:read_from_}{\&{readfrom} primitive@>
+operator and the \&{write} command. Such files are stored in separate arrays.
+@:write_}{\&{write} primitive@>
+
+@<Types in the outer block@>=
+readf_index = 0..max_read_files;
+write_index = 0..max_write_files;
+
+@ @<Glob...@>=
+rd_file:array [readf_index] of alpha_file; {\&{readfrom} files}
+rd_fname:array [readf_index] of str_number;
+ {corresponding file name or 0 if file not open}
+read_files:readf_index; {number of valid entries in the above arrays}
+wr_file:array [write_index] of alpha_file; {\&{write} files}
+wr_fname:array [write_index] of str_number;
+ {corresponding file name or 0 if file not open}
+write_files:write_index; {number of valid entries in the above arrays}
+
+@ @<Set init...@>=
+read_files:=0;
+write_files:=0;
+
+@ This routine starts reading the file named by string~|s| without setting
+|loc|, |limit|, or |name|. It returns |false| if the file is empty or cannot
+be opened. Otherwise it updates |rd_file[n]| and |rd_fname[n]|.
+
+@p function start_read_input(s:str_number; n:readf_index):boolean;
+label exit,not_found;
+begin str_scan_file(s);
+pack_cur_name;
+begin_file_reading;
+if not a_open_in(rd_file[n]) then goto not_found;
+if not input_ln(rd_file[n],false) then
+ begin a_close(rd_file[n]); goto not_found; end;
+rd_fname[n]:=s;
+add_str_ref(s);
+start_read_input:=true;
+return;
+not_found: end_file_reading;
+start_read_input:=false;
+exit:end;
+
+@ Open |wr_file[n]| using file name~|s| and update |wr_fname[n]|.
+
+@p procedure open_write_file(s:str_number; n:readf_index);
+begin str_scan_file(s);
+pack_cur_name;
+while not a_open_out(wr_file[n]) do
+ prompt_file_name("file name for write output","");
+wr_fname[n]:=s;
+add_str_ref(s);
+end;
+
+
+@* \[36] Introduction to the parsing routines.
+We come now to the central nervous system that sparks many of \MP's activities.
+By evaluating expressions, from their primary constituents to ever larger
+subexpressions, \MP\ builds the structures that ultimately define complete
+pictures or fonts of type.
+
+Four mutually recursive subroutines are involved in this process: We call them
+$$\hbox{|scan_primary|, |scan_secondary|, |scan_tertiary|,
+and |scan_expression|.}$$
+@^recursion@>
+Each of them is parameterless and begins with the first token to be scanned
+already represented in |cur_cmd|, |cur_mod|, and |cur_sym|. After execution,
+the value of the primary or secondary or tertiary or expression that was
+found will appear in the global variables |cur_type| and |cur_exp|. The
+token following the expression will be represented in |cur_cmd|, |cur_mod|,
+and |cur_sym|.
+
+Technically speaking, the parsing algorithms are ``LL(1),'' more or less;
+backup mechanisms have been added in order to provide reasonable error
+recovery.
+
+@<Glob...@>=
+@!cur_type:small_number; {the type of the expression just found}
+@!cur_exp:integer; {the value of the expression just found}
+
+@ @<Set init...@>=
+cur_exp:=0;
+
+@ Many different kinds of expressions are possible, so it is wise to have
+precise descriptions of what |cur_type| and |cur_exp| mean in all cases:
+
+\smallskip\hang
+|cur_type=vacuous| means that this expression didn't turn out to have a
+value at all, because it arose from a \&{begingroup}$\,\ldots\,$\&{endgroup}
+construction in which there was no expression before the \&{endgroup}.
+In this case |cur_exp| has some irrelevant value.
+
+\smallskip\hang
+|cur_type=boolean_type| means that |cur_exp| is either |true_code|
+or |false_code|.
+
+\smallskip\hang
+|cur_type=unknown_boolean| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined boolean variable.
+
+\smallskip\hang
+|cur_type=string_type| means that |cur_exp| is a string number (i.e., an
+integer in the range |0<=cur_exp<str_ptr|). That string's reference count
+includes this particular reference.
+
+\smallskip\hang
+|cur_type=unknown_string| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined string variable.
+
+\smallskip\hang
+|cur_type=pen_type| means that |cur_exp| points to a node in a pen. Nobody
+else points to any of the nodes in this pen. The pen may be polygonal or
+elliptical.
+
+\smallskip\hang
+|cur_type=unknown_pen| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined pen variable.
+
+\smallskip\hang
+|cur_type=path_type| means that |cur_exp| points to a the first node of
+a path; nobody else points to this particular path. The control points of
+the path will have been chosen.
+
+\smallskip\hang
+|cur_type=unknown_path| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined path variable.
+
+\smallskip\hang
+|cur_type=picture_type| means that |cur_exp| points to an edge header node.
+There may be other pointers to this particular set of edges. The header node
+contains a reference count that includes this particular reference.
+
+\smallskip\hang
+|cur_type=unknown_picture| means that |cur_exp| points to a capsule
+node that is in the ring of variables equivalent
+to at least one undefined picture variable.
+
+\smallskip\hang
+|cur_type=transform_type| means that |cur_exp| points to a |transform_type|
+capsule node. The |value| part of this capsule
+points to a transform node that contains six numeric values,
+each of which is |independent|, |dependent|, |proto_dependent|, or |known|.
+
+\smallskip\hang
+|cur_type=color_type| means that |cur_exp| points to a |color_type|
+capsule node. The |value| part of this capsule
+points to a color node that contains three numeric values,
+each of which is |independent|, |dependent|, |proto_dependent|, or |known|.
+
+\smallskip\hang
+|cur_type=pair_type| means that |cur_exp| points to a capsule
+node whose type is |pair_type|. The |value| part of this capsule
+points to a pair node that contains two numeric values,
+each of which is |independent|, |dependent|, |proto_dependent|, or |known|.
+
+\smallskip\hang
+|cur_type=known| means that |cur_exp| is a |scaled| value.
+
+\smallskip\hang
+|cur_type=dependent| means that |cur_exp| points to a capsule node whose type
+is |dependent|. The |dep_list| field in this capsule points to the associated
+dependency list.
+
+\smallskip\hang
+|cur_type=proto_dependent| means that |cur_exp| points to a |proto_dependent|
+capsule node. The |dep_list| field in this capsule
+points to the associated dependency list.
+
+\smallskip\hang
+|cur_type=independent| means that |cur_exp| points to a capsule node
+whose type is |independent|. This somewhat unusual case can arise, for
+example, in the expression
+`$x+\&{begingroup}\penalty0\,\&{string}\,x; 0\,\&{endgroup}$'.
+
+\smallskip\hang
+|cur_type=token_list| means that |cur_exp| points to a linked list of
+tokens. This case arises only on the left-hand side of an assignment
+(`\.{:=}') operation, under very special circumstances.
+
+\smallskip\noindent
+The possible settings of |cur_type| have been listed here in increasing
+numerical order. Notice that |cur_type| will never be |numeric_type| or
+|suffixed_macro| or |unsuffixed_macro|, although variables of those types
+are allowed. Conversely, \MP\ has no variables of type |vacuous| or
+|token_list|.
+
+@ Capsules are two-word nodes that have a similar meaning
+to |cur_type| and |cur_exp|. Such nodes have |name_type=capsule|
+and |link<=void|; and their |type| field is one of the possibilities for
+|cur_type| listed above.
+
+The |value| field of a capsule is, in most cases, the value that
+corresponds to its |type|, as |cur_exp| corresponds to |cur_type|.
+However, when |cur_exp| would point to a capsule,
+no extra layer of indirection is present; the |value|
+field is what would have been called |value(cur_exp)| if it had not been
+encapsulated. Furthermore, if the type is |dependent| or
+|proto_dependent|, the |value| field of a capsule is replaced by
+|dep_list| and |prev_dep| fields, since dependency lists in capsules are
+always part of the general |dep_list| structure.
+
+The |get_x_next| routine is careful not to change the values of |cur_type|
+and |cur_exp| when it gets an expanded token. However, |get_x_next| might
+call a macro, which might parse an expression, which might execute lots of
+commands in a group; hence it's possible that |cur_type| might change
+from, say, |unknown_boolean| to |boolean_type|, or from |dependent| to
+|known| or |independent|, during the time |get_x_next| is called. The
+programs below are careful to stash sensitive intermediate results in
+capsules, so that \MP's generality doesn't cause trouble.
+
+Here's a procedure that illustrates these conventions. It takes
+the contents of $(|cur_type|\kern-.3pt,|cur_exp|\kern-.3pt)$
+and stashes them away in a
+capsule. It is not used when |cur_type=token_list|.
+After the operation, |cur_type=vacuous|; hence there is no need to
+copy path lists or to update reference counts, etc.
+
+The special link |void| is put on the capsule returned by
+|stash_cur_exp|, because this procedure is used to store macro parameters
+that must be easily distinguishable from token lists.
+
+@<Declare the stashing/unstashing routines@>=
+function stash_cur_exp:pointer;
+var @!p:pointer; {the capsule that will be returned}
+begin case cur_type of
+unknown_types,transform_type,color_type,pair_type,dependent,proto_dependent,
+ independent:p:=cur_exp;
+othercases begin p:=get_node(value_node_size); name_type(p):=capsule;
+ type(p):=cur_type; value(p):=cur_exp;
+ end
+endcases;@/
+cur_type:=vacuous; link(p):=void; stash_cur_exp:=p;
+end;
+
+@ The inverse of |stash_cur_exp| is the following procedure, which
+deletes an unnecessary capsule and puts its contents into |cur_type|
+and |cur_exp|.
+
+The program steps of \MP\ can be divided into two categories: those in
+which |cur_type| and |cur_exp| are ``alive'' and those in which they are
+``dead,'' in the sense that |cur_type| and |cur_exp| contain relevant
+information or not. It's important not to ignore them when they're alive,
+and it's important not to pay attention to them when they're dead.
+
+There's also an intermediate category: If |cur_type=vacuous|, then
+|cur_exp| is irrelevant, hence we can proceed without caring if |cur_type|
+and |cur_exp| are alive or dead. In such cases we say that |cur_type|
+and |cur_exp| are {\sl dormant}. It is permissible to call |get_x_next|
+only when they are alive or dormant.
+
+The \\{stash} procedure above assumes that |cur_type| and |cur_exp|
+are alive or dormant. The \\{unstash} procedure assumes that they are
+dead or dormant; it resuscitates them.
+
+@<Declare the stashing/unstashing...@>=
+procedure unstash_cur_exp(@!p:pointer);
+begin cur_type:=type(p);
+case cur_type of
+unknown_types,transform_type,color_type,pair_type,dependent,proto_dependent,
+ independent: cur_exp:=p;
+othercases begin cur_exp:=value(p);
+ free_node(p,value_node_size);
+ end
+endcases;@/
+end;
+
+@ The following procedure prints the values of expressions in an
+abbreviated format. If its first parameter |p| is null, the value of
+|(cur_type,cur_exp)| is displayed; otherwise |p| should be a capsule
+containing the desired value. The second parameter controls the amount of
+output. If it is~0, dependency lists will be abbreviated to
+`\.{linearform}' unless they consist of a single term. If it is greater
+than~1, complicated structures (pens, pictures, and paths) will be displayed
+in full.
+
+@<Declare subroutines for printing expressions@>=
+@t\4@>@<Declare the procedure called |print_dp|@>@;
+@t\4@>@<Declare the stashing/unstashing routines@>@;
+procedure print_exp(@!p:pointer;@!verbosity:small_number);
+var @!restore_cur_exp:boolean; {should |cur_exp| be restored?}
+@!t:small_number; {the type of the expression}
+@!v:integer; {the value of the expression}
+@!q:pointer; {a big node being displayed}
+begin if p<>null then restore_cur_exp:=false
+else begin p:=stash_cur_exp; restore_cur_exp:=true;
+ end;
+t:=type(p);
+if t<dependent then v:=value(p)@+else if t<independent then v:=dep_list(p);
+@<Print an abbreviated value of |v| with format depending on |t|@>;
+if restore_cur_exp then unstash_cur_exp(p);
+end;
+
+@ @<Print an abbreviated value of |v| with format depending on |t|@>=
+case t of
+vacuous:print("vacuous");
+boolean_type:if v=true_code then print("true")@+else print("false");
+unknown_types,numeric_type:@<Display a variable
+ that's been declared but not defined@>;
+string_type:begin print_char(""""); print(v); print_char("""");
+ end;
+pen_type,path_type,picture_type:@<Display a complex type@>;
+transform_type,color_type,pair_type:if v=null then print_type(t)
+ else @<Display a big node@>;
+known:print_scaled(v);
+dependent,proto_dependent:print_dp(t,v,verbosity);
+independent:print_variable_name(p);
+othercases confusion("exp")
+@:this can't happen exp}{\quad exp@>
+endcases
+
+@ @<Display a big node@>=
+begin print_char("("); q:=v+big_node_size[t];
+repeat if type(v)=known then print_scaled(value(v))
+else if type(v)=independent then print_variable_name(v)
+else print_dp(type(v),dep_list(v),verbosity);
+v:=v+2;
+if v<>q then print_char(",");
+until v=q;
+print_char(")");
+end
+
+@ Values of type \&{picture}, \&{path}, and \&{pen} are displayed verbosely
+in the log file only, unless the user has given a positive value to
+\\{tracingonline}.
+
+@<Display a complex type@>=
+if verbosity<=1 then print_type(t)
+else begin if selector=term_and_log then
+ if internal[tracing_online]<=0 then
+ begin selector:=term_only;
+ print_type(t); print(" (see the transcript file)");
+ selector:=term_and_log;
+ end;
+ case t of
+ pen_type:print_pen(v,"",false);
+ path_type:print_path(v,"",false);
+ picture_type:print_edges(v,"",false);
+ end; {there are no other cases}
+ end
+
+@ @<Declare the procedure called |print_dp|@>=
+procedure print_dp(@!t:small_number;@!p:pointer;@!verbosity:small_number);
+var @!q:pointer; {the node following |p|}
+begin q:=link(p);
+if (info(q)=null) or (verbosity>0) then print_dependency(p,t)
+else print("linearform");
+end;
+
+@ The displayed name of a variable in a ring will not be a capsule unless
+the ring consists entirely of capsules.
+
+@<Display a variable that's been declared but not defined@>=
+begin print_type(t);
+if v<>null then
+ begin print_char(" ");
+ while (name_type(v)=capsule) and (v<>p) do v:=value(v);
+ print_variable_name(v);
+ end;
+end
+
+@ When errors are detected during parsing, it is often helpful to
+display an expression just above the error message, using |exp_err|
+or |disp_err| instead of |print_err|.
+
+@d exp_err(#)==disp_err(null,#) {displays the current expression}
+
+@<Declare subroutines for printing expressions@>=
+procedure disp_err(@!p:pointer;@!s:str_number);
+begin if interaction=error_stop_mode then wake_up_terminal;
+print_nl(">> ");
+@.>>@>
+print_exp(p,1); {``medium verbose'' printing of the expression}
+if s<>"" then
+ begin print_nl("! "); print(s);
+@.!\relax@>
+ end;
+end;
+
+@ If |cur_type| and |cur_exp| contain relevant information that should
+be recycled, we will use the following procedure, which changes |cur_type|
+to |known| and stores a given value in |cur_exp|. We can think of |cur_type|
+and |cur_exp| as either alive or dormant after this has been done,
+because |cur_exp| will not contain a pointer value.
+
+@<Declare the procedure called |flush_cur_exp|@>=
+procedure flush_cur_exp(@!v:scaled);
+begin case cur_type of
+unknown_types,transform_type,color_type,pair_type,@|
+ dependent,proto_dependent,independent:
+ begin recycle_value(cur_exp); free_node(cur_exp,value_node_size);
+ end;
+string_type:delete_str_ref(cur_exp);
+pen_type,path_type: toss_knot_list(cur_exp);
+picture_type:delete_edge_ref(cur_exp);
+othercases do_nothing
+endcases;@/
+cur_type:=known; cur_exp:=v;
+end;
+
+@ There's a much more general procedure that is capable of releasing
+the storage associated with any two-word value packet.
+
+@<Declare the recycling subroutines@>=
+procedure recycle_value(@!p:pointer);
+label done;
+var @!t:small_number; {a type code}
+@!v:integer; {a value}
+@!vv:integer; {another value}
+@!q,@!r,@!s,@!pp:pointer; {link manipulation registers}
+begin t:=type(p);
+if t<dependent then v:=value(p);
+case t of
+undefined,vacuous,boolean_type,known,numeric_type:do_nothing;
+unknown_types:ring_delete(p);
+string_type:delete_str_ref(v);
+path_type,pen_type:toss_knot_list(v);
+picture_type:delete_edge_ref(v);
+pair_type,color_type,transform_type:@<Recycle a big node@>;
+dependent,proto_dependent:@<Recycle a dependency list@>;
+independent:@<Recycle an independent variable@>;
+token_list,structured:confusion("recycle");
+@:this can't happen recycle}{\quad recycle@>
+unsuffixed_macro,suffixed_macro:delete_mac_ref(value(p));
+end; {there are no other cases}
+type(p):=undefined;
+end;
+
+@ @<Recycle a big node@>=
+if v<>null then
+ begin q:=v+big_node_size[t];
+ repeat q:=q-2; recycle_value(q);
+ until q=v;
+ free_node(v,big_node_size[t]);
+ end
+
+@ @<Recycle a dependency list@>=
+begin q:=dep_list(p);
+while info(q)<>null do q:=link(q);
+link(prev_dep(p)):=link(q);
+prev_dep(link(q)):=prev_dep(p);
+link(q):=null; flush_node_list(dep_list(p));
+end
+
+@ When an independent variable disappears, it simply fades away, unless
+something depends on it. In the latter case, a dependent variable whose
+coefficient of dependence is maximal will take its place.
+The relevant algorithm is due to Ignacio~A. Zabala, who implemented it
+as part of his Ph.D. thesis (Stanford University, December 1982).
+@^Zabala Salelles, Ignacio Andres@>
+
+For example, suppose that variable $x$ is being recycled, and that the
+only variables depending on~$x$ are $y=2x+a$ and $z=x+b$. In this case
+we want to make $y$ independent and $z=.5y-.5a+b$; no other variables
+will depend on~$y$. If $\\{tracingequations}>0$ in this situation,
+we will print `\.{\#\#\# -2x=-y+a}'.
+
+There's a slight complication, however: An independent variable $x$
+can occur both in dependency lists and in proto-dependency lists.
+This makes it necessary to be careful when deciding which coefficient
+is maximal.
+
+Furthermore, this complication is not so slight when
+a proto-dependent variable is chosen to become independent. For example,
+suppose that $y=2x+100a$ is proto-dependent while $z=x+b$ is dependent;
+then we must change $z=.5y-50a+b$ to a proto-dependency, because of the
+large coefficient `50'.
+
+In order to deal with these complications without wasting too much time,
+we shall link together the occurrences of~$x$ among all the linear
+dependencies, maintaining separate lists for the dependent and
+proto-dependent cases.
+
+@<Recycle an independent variable@>=
+begin max_c[dependent]:=0; max_c[proto_dependent]:=0;@/
+max_link[dependent]:=null; max_link[proto_dependent]:=null;@/
+q:=link(dep_head);
+while q<>dep_head do
+ begin s:=value_loc(q); {now |link(s)=dep_list(q)|}
+ loop@+ begin r:=link(s);
+ if info(r)=null then goto done;
+ if info(r)<>p then s:=r
+ else begin t:=type(q); link(s):=link(r); info(r):=q;
+ if abs(value(r))>max_c[t] then
+ @<Record a new maximum coefficient of type |t|@>
+ else begin link(r):=max_link[t]; max_link[t]:=r;
+ end;
+ end;
+ end;
+done: q:=link(r);
+ end;
+if (max_c[dependent]>0)or(max_c[proto_dependent]>0) then
+ @<Choose a dependent variable to take the place of the disappearing
+ independent variable, and change all remaining dependencies
+ accordingly@>;
+end
+
+@ The code for independency removal makes use of three two-word arrays.
+
+@<Glob...@>=
+@!max_c:array[dependent..proto_dependent] of integer;
+ {max coefficient magnitude}
+@!max_ptr:array[dependent..proto_dependent] of pointer;
+ {where |p| occurs with |max_c|}
+@!max_link:array[dependent..proto_dependent] of pointer;
+ {other occurrences of |p|}
+
+@ @<Record a new maximum coefficient...@>=
+begin if max_c[t]>0 then
+ begin link(max_ptr[t]):=max_link[t]; max_link[t]:=max_ptr[t];
+ end;
+max_c[t]:=abs(value(r)); max_ptr[t]:=r;
+end
+
+@ @<Choose a dependent...@>=
+begin if (max_c[dependent] div @'10000 >=
+ max_c[proto_dependent]) then
+ t:=dependent
+else t:=proto_dependent;
+@<Determine the dependency list |s| to substitute for the independent
+ variable~|p|@>;
+t:=dependent+proto_dependent-t; {complement |t|}
+if max_c[t]>0 then {we need to pick up an unchosen dependency}
+ begin link(max_ptr[t]):=max_link[t]; max_link[t]:=max_ptr[t];
+ end;
+if t<>dependent then @<Substitute new dependencies in place of |p|@>
+else @<Substitute new proto-dependencies in place of |p|@>;
+flush_node_list(s);
+if fix_needed then fix_dependencies;
+check_arith;
+end
+
+@ Let |s=max_ptr[t]|. At this point we have $|value|(s)=\pm|max_c|[t]$,
+and |info(s)| points to the dependent variable~|pp| of type~|t| from
+whose dependency list we have removed node~|s|. We must reinsert
+node~|s| into the dependency list, with coefficient $-1.0$, and with
+|pp| as the new independent variable. Since |pp| will have a larger serial
+number than any other variable, we can put node |s| at the head of the
+list.
+
+@<Determine the dep...@>=
+s:=max_ptr[t]; pp:=info(s); v:=value(s);
+if t=dependent then value(s):=-fraction_one@+else value(s):=-unity;
+r:=dep_list(pp); link(s):=r;
+while info(r)<>null do r:=link(r);
+q:=link(r); link(r):=null;
+prev_dep(q):=prev_dep(pp); link(prev_dep(pp)):=q;
+new_indep(pp);
+if cur_exp=pp then if cur_type=t then cur_type:=independent;
+if internal[tracing_equations]>0 then @<Show the transformed dependency@>
+
+@ Now $(-v)$ times the formerly independent variable~|p| is being replaced
+by the dependency list~|s|.
+
+@<Show the transformed...@>=
+if interesting(p) then
+ begin begin_diagnostic; print_nl("### ");
+@:]]]\#\#\#_}{\.{\#\#\#}@>
+ if v>0 then print_char("-");
+ if t=dependent then vv:=round_fraction(max_c[dependent])
+ else vv:=max_c[proto_dependent];
+ if vv<>unity then print_scaled(vv);
+ print_variable_name(p);
+ while value(p) mod s_scale>0 do
+ begin print("*4"); value(p):=value(p)-2;
+ end;
+ if t=dependent then print_char("=")@+else print(" = ");
+ print_dependency(s,t);
+ end_diagnostic(false);
+ end
+
+@ Finally, there are dependent and proto-dependent variables whose
+dependency lists must be brought up to date.
+
+@<Substitute new dependencies...@>=
+for t:=dependent to proto_dependent do
+ begin r:=max_link[t];
+ while r<>null do
+ begin q:=info(r);
+ dep_list(q):=p_plus_fq(dep_list(q),@|
+ make_fraction(value(r),-v),s,t,dependent);
+ if dep_list(q)=dep_final then make_known(q,dep_final);
+ q:=r; r:=link(r); free_node(q,dep_node_size);
+ end;
+ end
+
+@ @<Substitute new proto...@>=
+for t:=dependent to proto_dependent do
+ begin r:=max_link[t];
+ while r<>null do
+ begin q:=info(r);
+ if t=dependent then {for safety's sake, we change |q| to |proto_dependent|}
+ begin if cur_exp=q then if cur_type=dependent then
+ cur_type:=proto_dependent;
+ dep_list(q):=p_over_v(dep_list(q),unity,dependent,proto_dependent);
+ type(q):=proto_dependent; value(r):=round_fraction(value(r));
+ end;
+ dep_list(q):=p_plus_fq(dep_list(q),@|
+ make_scaled(value(r),-v),s,proto_dependent,proto_dependent);
+ if dep_list(q)=dep_final then make_known(q,dep_final);
+ q:=r; r:=link(r); free_node(q,dep_node_size);
+ end;
+ end
+
+@ Here are some routines that provide handy combinations of actions
+that are often needed during error recovery. For example,
+`|flush_error|' flushes the current expression, replaces it by
+a given value, and calls |error|.
+
+Errors often are detected after an extra token has already been scanned.
+The `\\{put\_get}' routines put that token back before calling |error|;
+then they get it back again. (Or perhaps they get another token, if
+the user has changed things.)
+
+@<Declare the procedure called |flush_cur_exp|@>=
+procedure flush_error(@!v:scaled);@+begin error; flush_cur_exp(v);@+end;
+@#
+procedure@?back_error; forward;@t\2@>@/
+procedure@?get_x_next; forward;@t\2@>@/
+@#
+procedure put_get_error;@+begin back_error; get_x_next;@+end;
+@#
+procedure put_get_flush_error(@!v:scaled);@+begin put_get_error;
+ flush_cur_exp(v);@+end;
+
+@ A global variable |var_flag| is set to a special command code
+just before \MP\ calls |scan_expression|, if the expression should be
+treated as a variable when this command code immediately follows. For
+example, |var_flag| is set to |assignment| at the beginning of a
+statement, because we want to know the {\sl location\/} of a variable at
+the left of `\.{:=}', not the {\sl value\/} of that variable.
+
+The |scan_expression| subroutine calls |scan_tertiary|,
+which calls |scan_secondary|, which calls |scan_primary|, which sets
+|var_flag:=0|. In this way each of the scanning routines ``knows''
+when it has been called with a special |var_flag|, but |var_flag| is
+usually zero.
+
+A variable preceding a command that equals |var_flag| is converted to a
+token list rather than a value. Furthermore, an `\.{=}' sign following an
+expression with |var_flag=assignment| is not considered to be a relation
+that produces boolean expressions.
+
+
+@<Glob...@>=
+@!var_flag:0..max_command_code; {command that wants a variable}
+
+@ @<Set init...@>=
+var_flag:=0;
+
+@* \[37] Parsing primary expressions.
+The first parsing routine, |scan_primary|, is also the most complicated one,
+since it involves so many different cases. But each case---with one
+exception---is fairly simple by itself.
+
+When |scan_primary| begins, the first token of the primary to be scanned
+should already appear in |cur_cmd|, |cur_mod|, and |cur_sym|. The values
+of |cur_type| and |cur_exp| should be either dead or dormant, as explained
+earlier. If |cur_cmd| is not between |min_primary_command| and
+|max_primary_command|, inclusive, a syntax error will be signaled.
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_primary;
+label restart, done, done1, done2;
+var @!p,@!q,@!r:pointer; {for list manipulation}
+@!c:quarterword; {a primitive operation code}
+@!my_var_flag:0..max_command_code; {initial value of |my_var_flag|}
+@!l_delim,@!r_delim:pointer; {hash addresses of a delimiter pair}
+@<Other local variables for |scan_primary|@>@;
+begin my_var_flag:=var_flag; var_flag:=0;
+restart:check_arith;
+@<Supply diagnostic information, if requested@>;
+case cur_cmd of
+left_delimiter:@<Scan a delimited primary@>;
+begin_group:@<Scan a grouped primary@>;
+string_token:@<Scan a string constant@>;
+numeric_token:@<Scan a primary that starts with a numeric token@>;
+nullary:@<Scan a nullary operation@>;
+unary,type_name,cycle,plus_or_minus:@<Scan a unary operation@>;
+primary_binary:@<Scan a binary operation with `\&{of}' between its operands@>;
+str_op:@<Convert a suffix to a string@>;
+internal_quantity:@<Scan an internal numeric quantity@>;
+capsule_token:make_exp_copy(cur_mod);
+tag_token:@<Scan a variable primary;
+ |goto restart| if it turns out to be a macro@>;
+othercases begin bad_exp("A primary"); goto restart;
+@.A primary expression...@>
+ end
+endcases;@/
+get_x_next; {the routines |goto done| if they don't want this}
+done: if cur_cmd=left_bracket then
+ if cur_type>=known then @<Scan a mediation construction@>;
+end;
+
+@ Errors at the beginning of expressions are flagged by |bad_exp|.
+
+@p procedure bad_exp(@!s:str_number);
+var save_flag:0..max_command_code;
+begin print_err(s); print(" expression can't begin with `");
+print_cmd_mod(cur_cmd,cur_mod); print_char("'");
+help4("I'm afraid I need some sort of value in order to continue,")@/
+ ("so I've tentatively inserted `0'. You may want to")@/
+ ("delete this zero and insert something else;")@/
+ ("see Chapter 27 of The METAFONTbook for an example.");
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+back_input; cur_sym:=0; cur_cmd:=numeric_token; cur_mod:=0; ins_error;@/
+save_flag:=var_flag; var_flag:=0; get_x_next;
+var_flag:=save_flag;
+end;
+
+@ @<Supply diagnostic information, if requested@>=
+debug if panicking then check_mem(false);@+gubed@;@/
+if interrupt<>0 then if OK_to_interrupt then
+ begin back_input; check_interrupt; get_x_next;
+ end
+
+@ @<Scan a delimited primary@>=
+begin l_delim:=cur_sym; r_delim:=cur_mod; get_x_next; scan_expression;
+if (cur_cmd=comma) and (cur_type>=known) then
+ @<Scan the rest of a pair or triplet of numerics@>
+else check_delimiter(l_delim,r_delim);
+end
+
+@ The |stash_in| subroutine puts the current (numeric) expression into a field
+within a ``big node.''
+
+@p procedure stash_in(@!p:pointer);
+var @!q:pointer; {temporary register}
+begin type(p):=cur_type;
+if cur_type=known then value(p):=cur_exp
+else begin if cur_type=independent then
+ @<Stash an independent |cur_exp| into a big node@>
+ else begin mem[value_loc(p)]:=mem[value_loc(cur_exp)];
+ {|dep_list(p):=dep_list(cur_exp)| and |prev_dep(p):=prev_dep(cur_exp)|}
+ link(prev_dep(p)):=p;
+ end;
+ free_node(cur_exp,value_node_size);
+ end;
+cur_type:=vacuous;
+end;
+
+@ In rare cases the current expression can become |independent|. There
+may be many dependency lists pointing to such an independent capsule,
+so we can't simply move it into place within a big node. Instead,
+we copy it, then recycle it.
+
+@ @<Stash an independent |cur_exp|...@>=
+begin q:=single_dependency(cur_exp);
+if q=dep_final then
+ begin type(p):=known; value(p):=0; free_node(q,dep_node_size);
+ end
+else begin type(p):=dependent; new_dep(p,q);
+ end;
+recycle_value(cur_exp);
+end
+
+@ This code uses the fact that |red_part_loc| and |green_part_loc|
+are synonymous with |x_part_loc| and |y_part_loc|.
+
+@<Scan the rest of a pair or triplet of numerics@>=
+begin p:=stash_cur_exp;
+get_x_next; scan_expression;
+@<Make sure the second part of a pair or color has a numeric type@>;
+q:=get_node(value_node_size); name_type(q):=capsule;
+if cur_cmd=comma then type(q):=color_type
+else type(q):=pair_type;
+init_big_node(q); r:=value(q);
+stash_in(y_part_loc(r));
+unstash_cur_exp(p);
+stash_in(x_part_loc(r));
+if cur_cmd=comma then @<Scan the last of a triplet of numerics@>;
+check_delimiter(l_delim,r_delim);
+cur_type:=type(q);
+cur_exp:=q;
+end
+
+@ @<Make sure the second part of a pair or color has a numeric type@>=
+if cur_type<known then
+ begin exp_err("Nonnumeric ypart has been replaced by 0");
+@.Nonnumeric...replaced by 0@>
+ help4("I've started to scan a pair `(a,b)' or a color `(a,b,c)';")@/
+ ("but after finding a nice `a' I found a `b' that isn't")@/
+ ("of numeric type. So I've changed that part to zero.")@/
+ ("(The b that I didn't like appears above the error message.)");
+ put_get_flush_error(0);
+ end
+
+@ @<Scan the last of a triplet of numerics@>=
+begin get_x_next; scan_expression;
+if cur_type<known then
+ begin exp_err("Nonnumeric bluepart has been replaced by 0");
+@.Nonnumeric...replaced by 0@>
+ help3("I've just scanned a color `(r,g,b)'; but the `b' isn't")@/
+ ("of numeric type. So I've changed that part to zero.")@/
+ ("(The b that I didn't like appears above the error message.)");@/
+ put_get_flush_error(0);
+ end;
+stash_in(blue_part_loc(r));
+end
+
+@ The local variable |group_line| keeps track of the line
+where a \&{begingroup} command occurred; this will be useful
+in an error message if the group doesn't actually end.
+
+@<Other local variables for |scan_primary|@>=
+@!group_line:integer; {where a group began}
+
+@ @<Scan a grouped primary@>=
+begin group_line:=true_line;
+if internal[tracing_commands]>0 then show_cur_cmd_mod;
+save_boundary_item(p);
+repeat do_statement; {ends with |cur_cmd>=semicolon|}
+until cur_cmd<>semicolon;
+if cur_cmd<>end_group then
+ begin print_err("A group begun on line ");
+@.A group...never ended@>
+ print_int(group_line);
+ print(" never ended");
+ help2("I saw a `begingroup' back there that hasn't been matched")@/
+ ("by `endgroup'. So I've inserted `endgroup' now.");
+ back_error; cur_cmd:=end_group;
+ end;
+unsave; {this might change |cur_type|, if independent variables are recycled}
+if internal[tracing_commands]>0 then show_cur_cmd_mod;
+end
+
+@ @<Scan a string constant@>=
+begin cur_type:=string_type; cur_exp:=cur_mod;
+end
+
+@ Later we'll come to procedures that perform actual operations like
+addition, square root, and so on; our purpose now is to do the parsing.
+But we might as well mention those future procedures now, so that the
+suspense won't be too bad:
+
+\smallskip
+|do_nullary(c)| does primitive operations that have no operands (e.g.,
+`\&{true}' or `\&{pencircle}');
+
+\smallskip
+|do_unary(c)| applies a primitive operation to the current expression;
+
+\smallskip
+|do_binary(p,c)| applies a primitive operation to the capsule~|p|
+and the current expression.
+
+@<Scan a nullary operation@>=do_nullary(cur_mod)
+
+@ @<Scan a unary operation@>=
+begin c:=cur_mod; get_x_next; scan_primary; do_unary(c); goto done;
+end
+
+@ A numeric token might be a primary by itself, or it might be the
+numerator of a fraction composed solely of numeric tokens, or it might
+multiply the primary that follows (provided that the primary doesn't begin
+with a plus sign or a minus sign). The code here uses the facts that
+|max_primary_command=plus_or_minus| and
+|max_primary_command-1=numeric_token|. If a fraction is found that is less
+than unity, we try to retain higher precision when we use it in scalar
+multiplication.
+
+@<Other local variables for |scan_primary|@>=
+@!num,@!denom:scaled; {for primaries that are fractions, like `1/2'}
+
+@ @<Scan a primary that starts with a numeric token@>=
+begin cur_exp:=cur_mod; cur_type:=known; get_x_next;
+if cur_cmd<>slash then
+ begin num:=0; denom:=0;
+ end
+else begin get_x_next;
+ if cur_cmd<>numeric_token then
+ begin back_input;
+ cur_cmd:=slash; cur_mod:=over; cur_sym:=frozen_slash;
+ goto done;
+ end;
+ num:=cur_exp; denom:=cur_mod;
+ if denom=0 then @<Protest division by zero@>
+ else cur_exp:=make_scaled(num,denom);
+ check_arith; get_x_next;
+ end;
+if cur_cmd>=min_primary_command then
+ if cur_cmd<numeric_token then {in particular, |cur_cmd<>plus_or_minus|}
+ begin p:=stash_cur_exp; scan_primary;
+ if (abs(num)>=abs(denom))or(cur_type<color_type) then do_binary(p,times)
+ else begin frac_mult(num,denom);
+ free_node(p,value_node_size);
+ end;
+ end;
+goto done;
+end
+
+@ @<Protest division...@>=
+begin print_err("Division by zero");
+@.Division by zero@>
+help1("I'll pretend that you meant to divide by 1."); error;
+end
+
+@ @<Scan a binary operation with `\&{of}' between its operands@>=
+begin c:=cur_mod; get_x_next; scan_expression;
+if cur_cmd<>of_token then
+ begin missing_err("of"); print(" for "); print_cmd_mod(primary_binary,c);
+@.Missing `of'@>
+ help1("I've got the first argument; will look now for the other.");
+ back_error;
+ end;
+p:=stash_cur_exp; get_x_next; scan_primary; do_binary(p,c); goto done;
+end
+
+@ @<Convert a suffix to a string@>=
+begin get_x_next; scan_suffix; old_setting:=selector; selector:=new_string;
+show_token_list(cur_exp,null,100000,0); flush_token_list(cur_exp);
+cur_exp:=make_string; selector:=old_setting; cur_type:=string_type;
+goto done;
+end
+
+@ If an internal quantity appears all by itself on the left of an
+assignment, we return a token list of length one, containing the address
+of the internal quantity plus |hash_end|. (This accords with the conventions
+of the save stack, as described earlier.)
+
+@<Scan an internal...@>=
+begin q:=cur_mod;
+if my_var_flag=assignment then
+ begin get_x_next;
+ if cur_cmd=assignment then
+ begin cur_exp:=get_avail;
+ info(cur_exp):=q+hash_end; cur_type:=token_list; goto done;
+ end;
+ back_input;
+ end;
+cur_type:=known; cur_exp:=internal[q];
+end
+
+@ The most difficult part of |scan_primary| has been saved for last, since
+it was necessary to build up some confidence first. We can now face the task
+of scanning a variable.
+
+As we scan a variable, we build a token list containing the relevant
+names and subscript values, simultaneously following along in the
+``collective'' structure to see if we are actually dealing with a macro
+instead of a value.
+
+The local variables |pre_head| and |post_head| will point to the beginning
+of the prefix and suffix lists; |tail| will point to the end of the list
+that is currently growing.
+
+Another local variable, |tt|, contains partial information about the
+declared type of the variable-so-far. If |tt>=unsuffixed_macro|, the
+relation |tt=type(q)| will always hold. If |tt=undefined|, the routine
+doesn't bother to update its information about type. And if
+|undefined<tt<unsuffixed_macro|, the precise value of |tt| isn't critical.
+
+@ @<Other local variables for |scan_primary|@>=
+@!pre_head,@!post_head,@!tail:pointer;
+ {prefix and suffix list variables}
+@!tt:small_number; {approximation to the type of the variable-so-far}
+@!t:pointer; {a token}
+@!macro_ref:pointer; {reference count for a suffixed macro}
+
+@ @<Scan a variable primary...@>=
+begin fast_get_avail(pre_head); tail:=pre_head; post_head:=null; tt:=vacuous;
+loop@+ begin t:=cur_tok; link(tail):=t;
+ if tt<>undefined then
+ begin @<Find the approximate type |tt| and corresponding~|q|@>;
+ if tt>=unsuffixed_macro then
+ @<Either begin an unsuffixed macro call or
+ prepare for a suffixed one@>;
+ end;
+ get_x_next; tail:=t;
+ if cur_cmd=left_bracket then
+ @<Scan for a subscript; replace |cur_cmd| by |numeric_token| if found@>;
+ if cur_cmd>max_suffix_token then goto done1;
+ if cur_cmd<min_suffix_token then goto done1;
+ end; {now |cur_cmd| is |internal_quantity|, |tag_token|, or |numeric_token|}
+done1:@<Handle unusual cases that masquerade as variables, and |goto restart|
+ or |goto done| if appropriate;
+ otherwise make a copy of the variable and |goto done|@>;
+end
+
+@ @<Either begin an unsuffixed macro call or...@>=
+begin link(tail):=null;
+if tt>unsuffixed_macro then {|tt=suffixed_macro|}
+ begin post_head:=get_avail; tail:=post_head; link(tail):=t;@/
+ tt:=undefined; macro_ref:=value(q); add_mac_ref(macro_ref);
+ end
+else @<Set up unsuffixed macro call and |goto restart|@>;
+end
+
+@ @<Scan for a subscript; replace |cur_cmd| by |numeric_token| if found@>=
+begin get_x_next; scan_expression;
+if cur_cmd<>right_bracket then
+ @<Put the left bracket and the expression back to be rescanned@>
+else begin if cur_type<>known then bad_subscript;
+ cur_cmd:=numeric_token; cur_mod:=cur_exp; cur_sym:=0;
+ end;
+end
+
+@ The left bracket that we thought was introducing a subscript might have
+actually been the left bracket in a mediation construction like `\.{x[a,b]}'.
+So we don't issue an error message at this point; but we do want to back up
+so as to avoid any embarrassment about our incorrect assumption.
+
+@<Put the left bracket and the expression back to be rescanned@>=
+begin back_input; {that was the token following the current expression}
+back_expr; cur_cmd:=left_bracket; cur_mod:=0; cur_sym:=frozen_left_bracket;
+end
+
+@ Here's a routine that puts the current expression back to be read again.
+
+@p procedure back_expr;
+var @!p:pointer; {capsule token}
+begin p:=stash_cur_exp; link(p):=null; back_list(p);
+end;
+
+@ Unknown subscripts lead to the following error message.
+
+@p procedure bad_subscript;
+begin exp_err("Improper subscript has been replaced by zero");
+@.Improper subscript...@>
+help3("A bracketed subscript must have a known numeric value;")@/
+ ("unfortunately, what I found was the value that appears just")@/
+ ("above this error message. So I'll try a zero subscript.");
+flush_error(0);
+end;
+
+@ Every time we call |get_x_next|, there's a chance that the variable we've
+been looking at will disappear. Thus, we cannot safely keep |q| pointing
+into the variable structure; we need to start searching from the root each time.
+
+@<Find the approximate type |tt| and corresponding~|q|@>=
+@^inner loop@>
+begin p:=link(pre_head); q:=info(p); tt:=undefined;
+if eq_type(q) mod outer_tag=tag_token then
+ begin q:=equiv(q);
+ if q=null then goto done2;
+ loop@+ begin p:=link(p);
+ if p=null then
+ begin tt:=type(q); goto done2;
+ end;
+ if type(q)<>structured then goto done2;
+ q:=link(attr_head(q)); {the |collective_subscript| attribute}
+ if p>=hi_mem_min then {it's not a subscript}
+ begin repeat q:=link(q);
+ until attr_loc(q)>=info(p);
+ if attr_loc(q)>info(p) then goto done2;
+ end;
+ end;
+ end;
+done2:end
+
+@ How do things stand now? Well, we have scanned an entire variable name,
+including possible subscripts and/or attributes; |cur_cmd|, |cur_mod|, and
+|cur_sym| represent the token that follows. If |post_head=null|, a
+token list for this variable name starts at |link(pre_head)|, with all
+subscripts evaluated. But if |post_head<>null|, the variable turned out
+to be a suffixed macro; |pre_head| is the head of the prefix list, while
+|post_head| is the head of a token list containing both `\.{\AT!}' and
+the suffix.
+
+Our immediate problem is to see if this variable still exists. (Variable
+structures can change drastically whenever we call |get_x_next|; users
+aren't supposed to do this, but the fact that it is possible means that
+we must be cautious.)
+
+The following procedure prints an error message when a variable
+unexpectedly disappears. Its help message isn't quite right for
+our present purposes, but we'll be able to fix that up.
+
+@p procedure obliterated(@!q:pointer);
+begin print_err("Variable "); show_token_list(q,null,1000,0);
+print(" has been obliterated");
+@.Variable...obliterated@>
+help5("It seems you did a nasty thing---probably by accident,")@/
+ ("but nevertheless you nearly hornswoggled me...")@/
+ ("While I was evaluating the right-hand side of this")@/
+ ("command, something happened, and the left-hand side")@/
+ ("is no longer a variable! So I won't change anything.");
+end;
+
+@ If the variable does exist, we also need to check
+for a few other special cases before deciding that a plain old ordinary
+variable has, indeed, been scanned.
+
+@<Handle unusual cases that masquerade as variables...@>=
+if post_head<>null then @<Set up suffixed macro call and |goto restart|@>;
+q:=link(pre_head); free_avail(pre_head);
+if cur_cmd=my_var_flag then
+ begin cur_type:=token_list; cur_exp:=q; goto done;
+ end;
+p:=find_variable(q);
+if p<>null then make_exp_copy(p)
+else begin obliterated(q);@/
+ help_line[2]:="While I was evaluating the suffix of this variable,";
+ help_line[1]:="something was redefined, and it's no longer a variable!";
+ help_line[0]:="In order to get back on my feet, I've inserted `0' instead.";
+ put_get_flush_error(0);
+ end;
+flush_node_list(q); goto done
+
+@ The only complication associated with macro calling is that the prefix
+and ``at'' parameters must be packaged in an appropriate list of lists.
+
+@<Set up unsuffixed macro call and |goto restart|@>=
+begin p:=get_avail; info(pre_head):=link(pre_head); link(pre_head):=p;
+info(p):=t; macro_call(value(q),pre_head,null); get_x_next; goto restart;
+end
+
+@ If the ``variable'' that turned out to be a suffixed macro no longer exists,
+we don't care, because we have reserved a pointer (|macro_ref|) to its
+token list.
+
+@<Set up suffixed macro call and |goto restart|@>=
+begin back_input; p:=get_avail; q:=link(post_head);
+info(pre_head):=link(pre_head); link(pre_head):=post_head;
+info(post_head):=q; link(post_head):=p; info(p):=link(q); link(q):=null;
+macro_call(macro_ref,pre_head,null); decr(ref_count(macro_ref));
+get_x_next; goto restart;
+end
+
+@ Our remaining job is simply to make a copy of the value that has been
+found. Some cases are harder than others, but complexity arises solely
+because of the multiplicity of possible cases.
+
+@<Declare the procedure called |make_exp_copy|@>=
+@t\4@>@<Declare subroutines needed by |make_exp_copy|@>@;
+procedure make_exp_copy(@!p:pointer);
+label restart;
+var @!q,@!r,@!t:pointer; {registers for list manipulation}
+begin restart: cur_type:=type(p);
+case cur_type of
+vacuous,boolean_type,known:cur_exp:=value(p);
+unknown_types:cur_exp:=new_ring_entry(p);
+string_type:begin cur_exp:=value(p); add_str_ref(cur_exp);
+ end;
+picture_type:begin cur_exp:=value(p);add_edge_ref(cur_exp);
+ end;
+pen_type:cur_exp:=copy_pen(value(p));
+path_type:cur_exp:=copy_path(value(p));
+transform_type,color_type,pair_type:@<Copy the big node |p|@>;
+dependent,proto_dependent:encapsulate(copy_dep_list(dep_list(p)));
+numeric_type:begin new_indep(p); goto restart;
+ end;
+independent: begin q:=single_dependency(p);
+ if q=dep_final then
+ begin cur_type:=known; cur_exp:=0; free_node(q,value_node_size);
+ end
+ else begin cur_type:=dependent; encapsulate(q);
+ end;
+ end;
+othercases confusion("copy")
+@:this can't happen copy}{\quad copy@>
+endcases;
+end;
+
+@ The |encapsulate| subroutine assumes that |dep_final| is the
+tail of dependency list~|p|.
+
+@<Declare subroutines needed by |make_exp_copy|@>=
+procedure encapsulate(@!p:pointer);
+begin cur_exp:=get_node(value_node_size); type(cur_exp):=cur_type;
+name_type(cur_exp):=capsule; new_dep(cur_exp,p);
+end;
+
+@ The most tedious case arises when the user refers to a
+\&{pair}, \&{color}, or \&{transform} variable; we must copy several fields,
+each of which can be |independent|, |dependent|, |proto_dependent|,
+or |known|.
+
+@<Copy the big node |p|@>=
+begin if value(p)=null then init_big_node(p);
+t:=get_node(value_node_size); name_type(t):=capsule; type(t):=cur_type;
+init_big_node(t);@/
+q:=value(p)+big_node_size[cur_type]; r:=value(t)+big_node_size[cur_type];
+repeat q:=q-2; r:=r-2; install(r,q);
+until q=value(p);
+cur_exp:=t;
+end
+
+@ The |install| procedure copies a numeric field~|q| into field~|r| of
+a big node that will be part of a capsule.
+
+@<Declare subroutines needed by |make_exp_copy|@>=
+procedure install(@!r,@!q:pointer);
+var p:pointer; {temporary register}
+begin if type(q)=known then
+ begin value(r):=value(q); type(r):=known;
+ end
+else if type(q)=independent then
+ begin p:=single_dependency(q);
+ if p=dep_final then
+ begin type(r):=known; value(r):=0; free_node(p,value_node_size);
+ end
+ else begin type(r):=dependent; new_dep(r,p);
+ end;
+ end
+ else begin type(r):=type(q); new_dep(r,copy_dep_list(dep_list(q)));
+ end;
+end;
+
+@ Expressions of the form `\.{a[b,c]}' are converted into
+`\.{b+a*(c-b)}', without checking the types of \.b~or~\.c,
+provided that \.a is numeric.
+
+@<Scan a mediation...@>=
+begin p:=stash_cur_exp; get_x_next; scan_expression;
+if cur_cmd<>comma then
+ begin @<Put the left bracket and the expression back...@>;
+ unstash_cur_exp(p);
+ end
+else begin q:=stash_cur_exp; get_x_next; scan_expression;
+ if cur_cmd<>right_bracket then
+ begin missing_err("]");@/
+@.Missing `]'@>
+ help3("I've scanned an expression of the form `a[b,c',")@/
+ ("so a right bracket should have come next.")@/
+ ("I shall pretend that one was there.");@/
+ back_error;
+ end;
+ r:=stash_cur_exp; make_exp_copy(q);@/
+ do_binary(r,minus); do_binary(p,times); do_binary(q,plus); get_x_next;
+ end;
+end
+
+@ Here is a comparatively simple routine that is used to scan the
+\&{suffix} parameters of a macro.
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_suffix;
+label done;
+var @!h,@!t:pointer; {head and tail of the list being built}
+@!p:pointer; {temporary register}
+begin h:=get_avail; t:=h;
+loop@+ begin if cur_cmd=left_bracket then
+ @<Scan a bracketed subscript and set |cur_cmd:=numeric_token|@>;
+ if cur_cmd=numeric_token then p:=new_num_tok(cur_mod)
+ else if (cur_cmd=tag_token)or(cur_cmd=internal_quantity) then
+ begin p:=get_avail; info(p):=cur_sym;
+ end
+ else goto done;
+ link(t):=p; t:=p; get_x_next;
+ end;
+done: cur_exp:=link(h); free_avail(h); cur_type:=token_list;
+end;
+
+@ @<Scan a bracketed subscript and set |cur_cmd:=numeric_token|@>=
+begin get_x_next; scan_expression;
+if cur_type<>known then bad_subscript;
+if cur_cmd<>right_bracket then
+ begin missing_err("]");@/
+@.Missing `]'@>
+ help3("I've seen a `[' and a subscript value, in a suffix,")@/
+ ("so a right bracket should have come next.")@/
+ ("I shall pretend that one was there.");@/
+ back_error;
+ end;
+cur_cmd:=numeric_token; cur_mod:=cur_exp;
+end
+
+@* \[38] Parsing secondary and higher expressions.
+After the intricacies of |scan_primary|\kern-1pt,
+the |scan_secondary| routine is
+refreshingly simple. It's not trivial, but the operations are relatively
+straightforward; the main difficulty is, again, that expressions and data
+structures might change drastically every time we call |get_x_next|, so a
+cautious approach is mandatory. For example, a macro defined by
+\&{primarydef} might have disappeared by the time its second argument has
+been scanned; we solve this by increasing the reference count of its token
+list, so that the macro can be called even after it has been clobbered.
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_secondary;
+label restart,continue;
+var @!p:pointer; {for list manipulation}
+@!c,@!d:halfword; {operation codes or modifiers}
+@!mac_name:pointer; {token defined with \&{primarydef}}
+begin restart:if(cur_cmd<min_primary_command)or@|
+ (cur_cmd>max_primary_command) then
+ bad_exp("A secondary");
+@.A secondary expression...@>
+scan_primary;
+continue: if cur_cmd<=max_secondary_command then
+ if cur_cmd>=min_secondary_command then
+ begin p:=stash_cur_exp; c:=cur_mod; d:=cur_cmd;
+ if d=secondary_primary_macro then
+ begin mac_name:=cur_sym; add_mac_ref(c);
+ end;
+ get_x_next; scan_primary;
+ if d<>secondary_primary_macro then do_binary(p,c)
+ else begin back_input; binary_mac(p,c,mac_name);
+ decr(ref_count(c)); get_x_next; goto restart;
+ end;
+ goto continue;
+ end;
+end;
+
+@ The following procedure calls a macro that has two parameters,
+|p| and |cur_exp|.
+
+@p procedure binary_mac(@!p,@!c,@!n:pointer);
+var @!q,@!r:pointer; {nodes in the parameter list}
+begin q:=get_avail; r:=get_avail; link(q):=r;@/
+info(q):=p; info(r):=stash_cur_exp;@/
+macro_call(c,q,n);
+end;
+
+@ The next procedure, |scan_tertiary|, is pretty much the same deal.
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_tertiary;
+label restart,continue;
+var @!p:pointer; {for list manipulation}
+@!c,@!d:halfword; {operation codes or modifiers}
+@!mac_name:pointer; {token defined with \&{secondarydef}}
+begin restart:if(cur_cmd<min_primary_command)or@|
+ (cur_cmd>max_primary_command) then
+ bad_exp("A tertiary");
+@.A tertiary expression...@>
+scan_secondary;
+continue: if cur_cmd<=max_tertiary_command then
+ if cur_cmd>=min_tertiary_command then
+ begin p:=stash_cur_exp; c:=cur_mod; d:=cur_cmd;
+ if d=tertiary_secondary_macro then
+ begin mac_name:=cur_sym; add_mac_ref(c);
+ end;
+ get_x_next; scan_secondary;
+ if d<>tertiary_secondary_macro then do_binary(p,c)
+ else begin back_input; binary_mac(p,c,mac_name);
+ decr(ref_count(c)); get_x_next; goto restart;
+ end;
+ goto continue;
+ end;
+end;
+
+@ Finally we reach the deepest level in our quartet of parsing routines.
+This one is much like the others; but it has an extra complication from
+paths, which materialize here.
+
+@d continue_path=25 {a label inside of |scan_expression|}
+@d finish_path=26 {another}
+
+@<Declare the basic parsing subroutines@>=
+procedure scan_expression;
+label restart,done,continue,continue_path,finish_path,exit;
+var @!p,@!q,@!r,@!pp,@!qq:pointer; {for list manipulation}
+@!c,@!d:halfword; {operation codes or modifiers}
+@!my_var_flag:0..max_command_code; {initial value of |var_flag|}
+@!mac_name:pointer; {token defined with \&{tertiarydef}}
+@!cycle_hit:boolean; {did a path expression just end with `\&{cycle}'?}
+@!x,@!y:scaled; {explicit coordinates or tension at a path join}
+@!t:endpoint..open; {knot type following a path join}
+begin my_var_flag:=var_flag;
+restart:if(cur_cmd<min_primary_command)or@|
+ (cur_cmd>max_primary_command) then
+ bad_exp("An");
+@.An expression...@>
+scan_tertiary;
+continue: if cur_cmd<=max_expression_command then
+ if cur_cmd>=min_expression_command then
+ if (cur_cmd<>equals)or(my_var_flag<>assignment) then
+ begin p:=stash_cur_exp; c:=cur_mod; d:=cur_cmd;
+ if d=expression_tertiary_macro then
+ begin mac_name:=cur_sym; add_mac_ref(c);
+ end;
+ if (d<ampersand)or((d=ampersand)and@|
+ ((type(p)=pair_type)or(type(p)=path_type))) then
+ @<Scan a path construction operation;
+ but |return| if |p| has the wrong type@>
+ else begin get_x_next; scan_tertiary;
+ if d<>expression_tertiary_macro then do_binary(p,c)
+ else begin back_input; binary_mac(p,c,mac_name);
+ decr(ref_count(c)); get_x_next; goto restart;
+ end;
+ end;
+ goto continue;
+ end;
+exit:end;
+
+@ The reader should review the data structure conventions for paths before
+hoping to understand the next part of this code.
+
+@<Scan a path construction operation...@>=
+begin cycle_hit:=false;
+@<Convert the left operand, |p|, into a partial path ending at~|q|;
+ but |return| if |p| doesn't have a suitable type@>;
+continue_path: @<Determine the path join parameters;
+ but |goto finish_path| if there's only a direction specifier@>;
+if cur_cmd=cycle then @<Get ready to close a cycle@>
+else begin scan_tertiary;
+ @<Convert the right operand, |cur_exp|,
+ into a partial path from |pp| to~|qq|@>;
+ end;
+@<Join the partial paths and reset |p| and |q| to the head and tail
+ of the result@>;
+if cur_cmd>=min_expression_command then
+ if cur_cmd<=ampersand then if not cycle_hit then goto continue_path;
+finish_path:
+@<Choose control points for the path and put the result into |cur_exp|@>;
+end
+
+@ @<Convert the left operand, |p|, into a partial path ending at~|q|...@>=
+begin unstash_cur_exp(p);
+if cur_type=pair_type then p:=new_knot
+else if cur_type=path_type then p:=cur_exp
+else return;
+q:=p;
+while link(q)<>p do q:=link(q);
+if left_type(p)<>endpoint then {open up a cycle}
+ begin r:=copy_knot(p); link(q):=r; q:=r;
+ end;
+left_type(p):=open; right_type(q):=open;
+end
+
+@ A pair of numeric values is changed into a knot node for a one-point path
+when \MP\ discovers that the pair is part of a path.
+
+@p@t\4@>@<Declare the procedure called |known_pair|@>@;
+function new_knot:pointer; {convert a pair to a knot with two endpoints}
+var @!q:pointer; {the new node}
+begin q:=get_node(knot_node_size); left_type(q):=endpoint;
+right_type(q):=endpoint; originator(q):=metapost_user; link(q):=q;@/
+known_pair; x_coord(q):=cur_x; y_coord(q):=cur_y;
+new_knot:=q;
+end;
+
+@ The |known_pair| subroutine sets |cur_x| and |cur_y| to the components
+of the current expression, assuming that the current expression is a
+pair of known numerics. Unknown components are zeroed, and the
+current expression is flushed.
+
+@<Declare the procedure called |known_pair|@>=
+procedure known_pair;
+var @!p:pointer; {the pair node}
+begin if cur_type<>pair_type then
+ begin exp_err("Undefined coordinates have been replaced by (0,0)");
+@.Undefined coordinates...@>
+ help5("I need x and y numbers for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+ ("you might want to type `I ???' now.)");
+ put_get_flush_error(0); cur_x:=0; cur_y:=0;
+ end
+else begin p:=value(cur_exp);
+ @<Make sure that both |x| and |y| parts of |p| are known;
+ copy them into |cur_x| and |cur_y|@>;
+ flush_cur_exp(0);
+ end;
+end;
+
+@ @<Make sure that both |x| and |y| parts of |p| are known...@>=
+if type(x_part_loc(p))=known then cur_x:=value(x_part_loc(p))
+else begin disp_err(x_part_loc(p),
+ "Undefined x coordinate has been replaced by 0");
+@.Undefined coordinates...@>
+ help5("I need a `known' x value for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+ ("you might want to type `I ???' now.)");
+ put_get_error; recycle_value(x_part_loc(p)); cur_x:=0;
+ end;
+if type(y_part_loc(p))=known then cur_y:=value(y_part_loc(p))
+else begin disp_err(y_part_loc(p),
+ "Undefined y coordinate has been replaced by 0");
+ help5("I need a `known' y value for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+ ("you might want to type `I ???' now.)");
+ put_get_error; recycle_value(y_part_loc(p)); cur_y:=0;
+ end
+
+@ At this point |cur_cmd| is either |ampersand|, |left_brace|, or |path_join|.
+
+@<Determine the path join parameters...@>=
+if cur_cmd=left_brace then
+ @<Put the pre-join direction information into node |q|@>;
+d:=cur_cmd;
+if d=path_join then @<Determine the tension and/or control points@>
+else if d<>ampersand then goto finish_path;
+get_x_next;
+if cur_cmd=left_brace then
+ @<Put the post-join direction information into |x| and |t|@>
+else if right_type(q)<>explicit then
+ begin t:=open; x:=0;
+ end
+
+@ The |scan_direction| subroutine looks at the directional information
+that is enclosed in braces, and also scans ahead to the following character.
+A type code is returned, either |open| (if the direction was $(0,0)$),
+or |curl| (if the direction was a curl of known value |cur_exp|), or
+|given| (if the direction is given by the |angle| value that now
+appears in |cur_exp|).
+
+There's nothing difficult about this subroutine, but the program is rather
+lengthy because a variety of potential errors need to be nipped in the bud.
+
+@p function scan_direction:small_number;
+var @!t:given..open; {the type of information found}
+@!x:scaled; {an |x| coordinate}
+begin get_x_next;
+if cur_cmd=curl_command then @<Scan a curl specification@>
+else @<Scan a given direction@>;
+if cur_cmd<>right_brace then
+ begin missing_err("}");@/
+@.Missing `\char`\}'@>
+ help3("I've scanned a direction spec for part of a path,")@/
+ ("so a right brace should have come next.")@/
+ ("I shall pretend that one was there.");@/
+ back_error;
+ end;
+get_x_next; scan_direction:=t;
+end;
+
+@ @<Scan a curl specification@>=
+begin get_x_next; scan_expression;
+if (cur_type<>known)or(cur_exp<0) then
+ begin exp_err("Improper curl has been replaced by 1");
+@.Improper curl@>
+ help1("A curl must be a known, nonnegative number.");
+ put_get_flush_error(unity);
+ end;
+t:=curl;
+end
+
+@ @<Scan a given direction@>=
+begin scan_expression;
+if cur_type>pair_type then @<Get given directions separated by commas@>
+else known_pair;
+if (cur_x=0)and(cur_y=0) then t:=open
+else begin t:=given; cur_exp:=n_arg(cur_x,cur_y);
+ end;
+end
+
+@ @<Get given directions separated by commas@>=
+begin if cur_type<>known then
+ begin exp_err("Undefined x coordinate has been replaced by 0");
+@.Undefined coordinates...@>
+ help5("I need a `known' x value for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+ ("you might want to type `I ???' now.)");
+ put_get_flush_error(0);
+ end;
+x:=cur_exp;
+if cur_cmd<>comma then
+ begin missing_err(",");@/
+@.Missing `,'@>
+ help2("I've got the x coordinate of a path direction;")@/
+ ("will look for the y coordinate next.");
+ back_error;
+ end;
+get_x_next; scan_expression;
+if cur_type<>known then
+ begin exp_err("Undefined y coordinate has been replaced by 0");
+ help5("I need a `known' y value for this part of the path.")@/
+ ("The value I found (see above) was no good;")@/
+ ("so I'll try to keep going by using zero instead.")@/
+ ("(Chapter 27 of The METAFONTbook explains that")@/
+ ("you might want to type `I ???' now.)");
+ put_get_flush_error(0);
+ end;
+cur_y:=cur_exp; cur_x:=x;
+end
+
+@ At this point |right_type(q)| is usually |open|, but it may have been
+set to some other value by a previous splicing operation. We must maintain
+the value of |right_type(q)| in unusual cases such as
+`\.{..z1\{z2\}\&\{z3\}z1\{0,0\}..}'.
+
+@<Put the pre-join...@>=
+begin t:=scan_direction;
+if t<>open then
+ begin right_type(q):=t; right_given(q):=cur_exp;
+ if left_type(q)=open then
+ begin left_type(q):=t; left_given(q):=cur_exp;
+ end; {note that |left_given(q)=left_curl(q)|}
+ end;
+end
+
+@ Since |left_tension| and |left_y| share the same position in knot nodes,
+and since |left_given| is similarly equivalent to |left_x|, we use
+|x| and |y| to hold the given direction and tension information when
+there are no explicit control points.
+
+@<Put the post-join...@>=
+begin t:=scan_direction;
+if right_type(q)<>explicit then x:=cur_exp
+else t:=explicit; {the direction information is superfluous}
+end
+
+@ @<Determine the tension and/or...@>=
+begin get_x_next;
+if cur_cmd=tension then @<Set explicit tensions@>
+else if cur_cmd=controls then @<Set explicit control points@>
+else begin right_tension(q):=unity; y:=unity; back_input; {default tension}
+ goto done;
+ end;
+if cur_cmd<>path_join then
+ begin missing_err("..");@/
+@.Missing `..'@>
+ help1("A path join command should end with two dots.");
+ back_error;
+ end;
+done:end
+
+@ @<Set explicit tensions@>=
+begin get_x_next; y:=cur_cmd;
+if cur_cmd=at_least then get_x_next;
+scan_primary;
+@<Make sure that the current expression is a valid tension setting@>;
+if y=at_least then negate(cur_exp);
+right_tension(q):=cur_exp;
+if cur_cmd=and_command then
+ begin get_x_next; y:=cur_cmd;
+ if cur_cmd=at_least then get_x_next;
+ scan_primary;
+ @<Make sure that the current expression is a valid tension setting@>;
+ if y=at_least then negate(cur_exp);
+ end;
+y:=cur_exp;
+end
+
+@ @d min_tension==three_quarter_unit
+
+@<Make sure that the current expression is a valid tension setting@>=
+if (cur_type<>known)or(cur_exp<min_tension) then
+ begin exp_err("Improper tension has been set to 1");
+@.Improper tension@>
+ help1("The expression above should have been a number >=3/4.");
+ put_get_flush_error(unity);
+ end
+
+@ @<Set explicit control points@>=
+begin right_type(q):=explicit; t:=explicit; get_x_next; scan_primary;@/
+known_pair; right_x(q):=cur_x; right_y(q):=cur_y;
+if cur_cmd<>and_command then
+ begin x:=right_x(q); y:=right_y(q);
+ end
+else begin get_x_next; scan_primary;@/
+ known_pair; x:=cur_x; y:=cur_y;
+ end;
+end
+
+@ @<Convert the right operand, |cur_exp|, into a partial path...@>=
+begin if cur_type<>path_type then pp:=new_knot
+else pp:=cur_exp;
+qq:=pp;
+while link(qq)<>pp do qq:=link(qq);
+if left_type(pp)<>endpoint then {open up a cycle}
+ begin r:=copy_knot(pp); link(qq):=r; qq:=r;
+ end;
+left_type(pp):=open; right_type(qq):=open;
+end
+
+@ If a person tries to define an entire path by saying `\.{(x,y)\&cycle}',
+we silently change the specification to `\.{(x,y)..cycle}', since a cycle
+shouldn't have length zero.
+
+@<Get ready to close a cycle@>=
+begin cycle_hit:=true; get_x_next; pp:=p; qq:=p;
+if d=ampersand then if p=q then
+ begin d:=path_join; right_tension(q):=unity; y:=unity;
+ end;
+end
+
+@ @<Join the partial paths and reset |p| and |q|...@>=
+begin if d=ampersand then
+ if (x_coord(q)<>x_coord(pp))or(y_coord(q)<>y_coord(pp)) then
+ begin print_err("Paths don't touch; `&' will be changed to `..'");
+@.Paths don't touch@>
+ help3("When you join paths `p&q', the ending point of p")@/
+ ("must be exactly equal to the starting point of q.")@/
+ ("So I'm going to pretend that you said `p..q' instead.");
+ put_get_error; d:=path_join; right_tension(q):=unity; y:=unity;
+ end;
+@<Plug an opening in |right_type(pp)|, if possible@>;
+if d=ampersand then @<Splice independent paths together@>
+else begin @<Plug an opening in |right_type(q)|, if possible@>;
+ link(q):=pp; left_y(pp):=y;
+ if t<>open then
+ begin left_x(pp):=x; left_type(pp):=t;
+ end;
+ end;
+q:=qq;
+end
+
+@ @<Plug an opening in |right_type(q)|...@>=
+if right_type(q)=open then
+ if (left_type(q)=curl)or(left_type(q)=given) then
+ begin right_type(q):=left_type(q); right_given(q):=left_given(q);
+ end
+
+@ @<Plug an opening in |right_type(pp)|...@>=
+if right_type(pp)=open then
+ if (t=curl)or(t=given) then
+ begin right_type(pp):=t; right_given(pp):=x;
+ end
+
+@ @<Splice independent paths together@>=
+begin if left_type(q)=open then if right_type(q)=open then
+ begin left_type(q):=curl; left_curl(q):=unity;
+ end;
+if right_type(pp)=open then if t=open then
+ begin right_type(pp):=curl; right_curl(pp):=unity;
+ end;
+right_type(q):=right_type(pp); link(q):=link(pp);@/
+right_x(q):=right_x(pp); right_y(q):=right_y(pp);
+free_node(pp,knot_node_size);
+if qq=pp then qq:=q;
+end
+
+@ @<Choose control points for the path...@>=
+if cycle_hit then
+ begin if d=ampersand then p:=q;
+ end
+else begin left_type(p):=endpoint;
+ if right_type(p)=open then
+ begin right_type(p):=curl; right_curl(p):=unity;
+ end;
+ right_type(q):=endpoint;
+ if left_type(q)=open then
+ begin left_type(q):=curl; left_curl(q):=unity;
+ end;
+ link(q):=p;
+ end;
+make_choices(p);
+cur_type:=path_type; cur_exp:=p
+
+@ Finally, we sometimes need to scan an expression whose value is
+supposed to be either |true_code| or |false_code|.
+
+@<Declare the basic parsing subroutines@>=
+procedure get_boolean;
+begin get_x_next; scan_expression;
+if cur_type<>boolean_type then
+ begin exp_err("Undefined condition will be treated as `false'");
+@.Undefined condition...@>
+ help2("The expression shown above should have had a definite")@/
+ ("true-or-false value. I'm changing it to `false'.");@/
+ put_get_flush_error(false_code); cur_type:=boolean_type;
+ end;
+end;
+
+@* \[39] Doing the operations.
+The purpose of parsing is primarily to permit people to avoid piles of
+parentheses. But the real work is done after the structure of an expression
+has been recognized; that's when new expressions are generated. We
+turn now to the guts of \MP, which handles individual operators that
+have come through the parsing mechanism.
+
+We'll start with the easy ones that take no operands, then work our way
+up to operators with one and ultimately two arguments. In other words,
+we will write the three procedures |do_nullary|, |do_unary|, and |do_binary|
+that are invoked periodically by the expression scanners.
+
+First let's make sure that all of the primitive operators are in the
+hash table. Although |scan_primary| and its relatives made use of the
+\\{cmd} code for these operators, the \\{do} routines base everything
+on the \\{mod} code. For example, |do_binary| doesn't care whether the
+operation it performs is a |primary_binary| or |secondary_binary|, etc.
+
+@<Put each...@>=
+primitive("true",nullary,true_code);@/
+@!@:true_}{\&{true} primitive@>
+primitive("false",nullary,false_code);@/
+@!@:false_}{\&{false} primitive@>
+primitive("nullpicture",nullary,null_picture_code);@/
+@!@:null_picture_}{\&{nullpicture} primitive@>
+primitive("nullpen",nullary,null_pen_code);@/
+@!@:null_pen_}{\&{nullpen} primitive@>
+primitive("jobname",nullary,job_name_op);@/
+@!@:job_name_}{\&{jobname} primitive@>
+primitive("readstring",nullary,read_string_op);@/
+@!@:read_string_}{\&{readstring} primitive@>
+primitive("pencircle",nullary,pen_circle);@/
+@!@:pen_circle_}{\&{pencircle} primitive@>
+primitive("normaldeviate",nullary,normal_deviate);@/
+@!@:normal_deviate_}{\&{normaldeviate} primitive@>
+primitive("readfrom",unary,read_from_op);@/
+@!@:read_from_}{\&{readfrom} primitive@>
+primitive("closefrom",unary,close_from_op);@/
+@!@:close_from_}{\&{closefrom} primitive@>
+primitive("odd",unary,odd_op);@/
+@!@:odd_}{\&{odd} primitive@>
+primitive("known",unary,known_op);@/
+@!@:known_}{\&{known} primitive@>
+primitive("unknown",unary,unknown_op);@/
+@!@:unknown_}{\&{unknown} primitive@>
+primitive("not",unary,not_op);@/
+@!@:not_}{\&{not} primitive@>
+primitive("decimal",unary,decimal);@/
+@!@:decimal_}{\&{decimal} primitive@>
+primitive("reverse",unary,reverse);@/
+@!@:reverse_}{\&{reverse} primitive@>
+primitive("makepath",unary,make_path_op);@/
+@!@:make_path_}{\&{makepath} primitive@>
+primitive("makepen",unary,make_pen_op);@/
+@!@:make_pen_}{\&{makepen} primitive@>
+primitive("oct",unary,oct_op);@/
+@!@:oct_}{\&{oct} primitive@>
+primitive("hex",unary,hex_op);@/
+@!@:hex_}{\&{hex} primitive@>
+primitive("ASCII",unary,ASCII_op);@/
+@!@:ASCII_}{\&{ASCII} primitive@>
+primitive("char",unary,char_op);@/
+@!@:char_}{\&{char} primitive@>
+primitive("length",unary,length_op);@/
+@!@:length_}{\&{length} primitive@>
+primitive("turningnumber",unary,turning_op);@/
+@!@:turning_number_}{\&{turningnumber} primitive@>
+primitive("xpart",unary,x_part);@/
+@!@:x_part_}{\&{xpart} primitive@>
+primitive("ypart",unary,y_part);@/
+@!@:y_part_}{\&{ypart} primitive@>
+primitive("xxpart",unary,xx_part);@/
+@!@:xx_part_}{\&{xxpart} primitive@>
+primitive("xypart",unary,xy_part);@/
+@!@:xy_part_}{\&{xypart} primitive@>
+primitive("yxpart",unary,yx_part);@/
+@!@:yx_part_}{\&{yxpart} primitive@>
+primitive("yypart",unary,yy_part);@/
+@!@:yy_part_}{\&{yypart} primitive@>
+primitive("redpart",unary,red_part);@/
+@!@:red_part_}{\&{redpart} primitive@>
+primitive("greenpart",unary,green_part);@/
+@!@:green_part_}{\&{greenpart} primitive@>
+primitive("bluepart",unary,blue_part);@/
+@!@:blue_part_}{\&{bluepart} primitive@>
+primitive("fontpart",unary,font_part);@/
+@!@:font_part_}{\&{fontpart} primitive@>
+primitive("textpart",unary,text_part);@/
+@!@:text_part_}{\&{textpart} primitive@>
+primitive("pathpart",unary,path_part);@/
+@!@:path_part_}{\&{pathpart} primitive@>
+primitive("penpart",unary,pen_part);@/
+@!@:pen_part_}{\&{penpart} primitive@>
+primitive("dashpart",unary,dash_part);@/
+@!@:dash_part_}{\&{dashpart} primitive@>
+primitive("sqrt",unary,sqrt_op);@/
+@!@:sqrt_}{\&{sqrt} primitive@>
+primitive("mexp",unary,m_exp_op);@/
+@!@:m_exp_}{\&{mexp} primitive@>
+primitive("mlog",unary,m_log_op);@/
+@!@:m_log_}{\&{mlog} primitive@>
+primitive("sind",unary,sin_d_op);@/
+@!@:sin_d_}{\&{sind} primitive@>
+primitive("cosd",unary,cos_d_op);@/
+@!@:cos_d_}{\&{cosd} primitive@>
+primitive("floor",unary,floor_op);@/
+@!@:floor_}{\&{floor} primitive@>
+primitive("uniformdeviate",unary,uniform_deviate);@/
+@!@:uniform_deviate_}{\&{uniformdeviate} primitive@>
+primitive("charexists",unary,char_exists_op);@/
+@!@:char_exists_}{\&{charexists} primitive@>
+primitive("fontsize",unary,font_size);@/
+@!@:font_size_}{\&{fontsize} primitive@>
+primitive("llcorner",unary,ll_corner_op);@/
+@!@:ll_corner_}{\&{llcorner} primitive@>
+primitive("lrcorner",unary,lr_corner_op);@/
+@!@:lr_corner_}{\&{lrcorner} primitive@>
+primitive("ulcorner",unary,ul_corner_op);@/
+@!@:ul_corner_}{\&{ulcorner} primitive@>
+primitive("urcorner",unary,ur_corner_op);@/
+@!@:ur_corner_}{\&{urcorner} primitive@>
+primitive("arclength",unary,arc_length);@/
+@!@:arc_length_}{\&{arclength} primitive@>
+primitive("angle",unary,angle_op);@/
+@!@:angle_}{\&{angle} primitive@>
+primitive("cycle",cycle,cycle_op);@/
+@!@:cycle_}{\&{cycle} primitive@>
+primitive("stroked",unary,stroked_op);@/
+@!@:stroked_}{\&{stroked} primitive@>
+primitive("filled",unary,filled_op);@/
+@!@:filled_}{\&{filled} primitive@>
+primitive("textual",unary,textual_op);@/
+@!@:textual_}{\&{textual} primitive@>
+primitive("clipped",unary,clipped_op);@/
+@!@:clipped_}{\&{clipped} primitive@>
+primitive("bounded",unary,bounded_op);@/
+@!@:bounded_}{\&{bounded} primitive@>
+primitive("+",plus_or_minus,plus);@/
+@!@:+ }{\.{+} primitive@>
+primitive("-",plus_or_minus,minus);@/
+@!@:- }{\.{-} primitive@>
+primitive("*",secondary_binary,times);@/
+@!@:* }{\.{*} primitive@>
+primitive("/",slash,over); eqtb[frozen_slash]:=eqtb[cur_sym];@/
+@!@:/ }{\.{/} primitive@>
+primitive("++",tertiary_binary,pythag_add);@/
+@!@:++_}{\.{++} primitive@>
+primitive("+-+",tertiary_binary,pythag_sub);@/
+@!@:+-+_}{\.{+-+} primitive@>
+primitive("or",tertiary_binary,or_op);@/
+@!@:or_}{\&{or} primitive@>
+primitive("and",and_command,and_op);@/
+@!@:and_}{\&{and} primitive@>
+primitive("<",expression_binary,less_than);@/
+@!@:< }{\.{<} primitive@>
+primitive("<=",expression_binary,less_or_equal);@/
+@!@:<=_}{\.{<=} primitive@>
+primitive(">",expression_binary,greater_than);@/
+@!@:> }{\.{>} primitive@>
+primitive(">=",expression_binary,greater_or_equal);@/
+@!@:>=_}{\.{>=} primitive@>
+primitive("=",equals,equal_to);@/
+@!@:= }{\.{=} primitive@>
+primitive("<>",expression_binary,unequal_to);@/
+@!@:<>_}{\.{<>} primitive@>
+primitive("substring",primary_binary,substring_of);@/
+@!@:substring_}{\&{substring} primitive@>
+primitive("subpath",primary_binary,subpath_of);@/
+@!@:subpath_}{\&{subpath} primitive@>
+primitive("directiontime",primary_binary,direction_time_of);@/
+@!@:direction_time_}{\&{directiontime} primitive@>
+primitive("point",primary_binary,point_of);@/
+@!@:point_}{\&{point} primitive@>
+primitive("precontrol",primary_binary,precontrol_of);@/
+@!@:precontrol_}{\&{precontrol} primitive@>
+primitive("postcontrol",primary_binary,postcontrol_of);@/
+@!@:postcontrol_}{\&{postcontrol} primitive@>
+primitive("penoffset",primary_binary,pen_offset_of);@/
+@!@:pen_offset_}{\&{penoffset} primitive@>
+primitive("arctime",primary_binary,arc_time_of);@/
+@!@:arc_time_of_}{\&{arctime} primitive@>
+primitive("mpversion",nullary,mp_version);@/
+@!@:mp_verison_}{\&{mpversion} primitive@>
+primitive("&",ampersand,concatenate);@/
+@!@:!!!}{\.{\&} primitive@>
+primitive("rotated",secondary_binary,rotated_by);@/
+@!@:rotated_}{\&{rotated} primitive@>
+primitive("slanted",secondary_binary,slanted_by);@/
+@!@:slanted_}{\&{slanted} primitive@>
+primitive("scaled",secondary_binary,scaled_by);@/
+@!@:scaled_}{\&{scaled} primitive@>
+primitive("shifted",secondary_binary,shifted_by);@/
+@!@:shifted_}{\&{shifted} primitive@>
+primitive("transformed",secondary_binary,transformed_by);@/
+@!@:transformed_}{\&{transformed} primitive@>
+primitive("xscaled",secondary_binary,x_scaled);@/
+@!@:x_scaled_}{\&{xscaled} primitive@>
+primitive("yscaled",secondary_binary,y_scaled);@/
+@!@:y_scaled_}{\&{yscaled} primitive@>
+primitive("zscaled",secondary_binary,z_scaled);@/
+@!@:z_scaled_}{\&{zscaled} primitive@>
+primitive("infont",secondary_binary,in_font);@/
+@!@:in_font_}{\&{infont} primitive@>
+primitive("intersectiontimes",tertiary_binary,intersect);@/
+@!@:intersection_times_}{\&{intersectiontimes} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+nullary,unary,primary_binary,secondary_binary,tertiary_binary,
+ expression_binary,cycle,plus_or_minus,slash,ampersand,equals,and_command:
+ print_op(m);
+
+@ OK, let's look at the simplest \\{do} procedure first.
+
+@p @t\4@>@<Declare nullary action procedure@>@;
+procedure do_nullary(@!c:quarterword);
+begin check_arith;
+if internal[tracing_commands]>two then
+ show_cmd_mod(nullary,c);
+case c of
+true_code,false_code:begin cur_type:=boolean_type; cur_exp:=c;
+ end;
+null_picture_code:begin cur_type:=picture_type;
+ cur_exp:=get_node(edge_header_size); init_edges(cur_exp);
+ end;
+null_pen_code:begin cur_type:=pen_type; cur_exp:=get_pen_circle(0);
+ end;
+normal_deviate:begin cur_type:=known; cur_exp:=norm_rand;
+ end;
+pen_circle:begin cur_type:=pen_type; cur_exp:=get_pen_circle(unity);
+ end;
+job_name_op: begin if job_name=0 then open_log_file;
+ cur_type:=string_type; cur_exp:=job_name;
+ end;
+mp_version: begin cur_type:=string_type; cur_exp:=metapost_version; end;
+read_string_op:@<Read a string from the terminal@>;
+end; {there are no other cases}
+check_arith;
+end;
+
+@ @<Read a string...@>=
+begin if interaction<=nonstop_mode then
+ fatal_error("*** (cannot readstring in nonstop modes)");
+begin_file_reading; name:=is_read;
+limit:=start; prompt_input("");
+finish_read;
+end
+
+@ @<Declare nullary action procedure@>=
+procedure finish_read; {copy |buffer| line to |cur_exp|}
+var @!k:pool_pointer;
+begin str_room(last-start);
+for k:=start to last-1 do append_char(buffer[k]);
+end_file_reading; cur_type:=string_type; cur_exp:=make_string;
+end;
+
+@ Things get a bit more interesting when there's an operand. The
+operand to |do_unary| appears in |cur_type| and |cur_exp|.
+
+@p @t\4@>@<Declare unary action procedures@>@;
+procedure do_unary(@!c:quarterword);
+var @!p,@!q,@!r:pointer; {for list manipulation}
+@!x:integer; {a temporary register}
+begin check_arith;
+if internal[tracing_commands]>two then
+ @<Trace the current unary operation@>;
+case c of
+plus:if cur_type<color_type then bad_unary(plus);
+minus:@<Negate the current expression@>;
+@t\4@>@<Additional cases of unary operators@>@;
+end; {there are no other cases}
+check_arith;
+end;
+
+@ The |nice_pair| function returns |true| if both components of a pair
+are known.
+
+@<Declare unary action procedures@>=
+function nice_pair(@!p:integer;@!t:quarterword):boolean;
+label exit;
+begin if t=pair_type then
+ begin p:=value(p);
+ if type(x_part_loc(p))=known then
+ if type(y_part_loc(p))=known then
+ begin nice_pair:=true; return;
+ end;
+ end;
+nice_pair:=false;
+exit:end;
+
+@ The |nice_color_or_pair| function is analogous except that it also accepts
+fully known colors.
+
+@<Declare unary action procedures@>=
+function nice_color_or_pair(@!p:integer;@!t:quarterword):boolean;
+label exit;
+var @!q,@!r:pointer; {for scanning the big node}
+begin if (t<>pair_type)and(t<>color_type) then
+ nice_color_or_pair:=false
+else begin q:=value(p);
+ r:=q+big_node_size[type(p)];
+ repeat r:=r-2;
+ if type(r)<>known then
+ begin nice_color_or_pair:=false; return;
+ end;
+ until r=q;
+ nice_color_or_pair:=true;
+ end;
+exit:end;
+
+@ @<Declare unary action...@>=
+procedure print_known_or_unknown_type(@!t:small_number;@!v:integer);
+begin print_char("(");
+if t>known then print("unknown numeric")
+else begin if (t=pair_type)or(t=color_type) then
+ if not nice_color_or_pair(v,t) then print("unknown ");
+ print_type(t);
+ end;
+print_char(")");
+end;
+
+@ @<Declare unary action...@>=
+procedure bad_unary(@!c:quarterword);
+begin exp_err("Not implemented: "); print_op(c);
+@.Not implemented...@>
+print_known_or_unknown_type(cur_type,cur_exp);
+help3("I'm afraid I don't know how to apply that operation to that")@/
+ ("particular type. Continue, and I'll simply return the")@/
+ ("argument (shown above) as the result of the operation.");
+put_get_error;
+end;
+
+@ @<Trace the current unary operation@>=
+begin begin_diagnostic; print_nl("{"); print_op(c); print_char("(");@/
+print_exp(null,0); {show the operand, but not verbosely}
+print(")}"); end_diagnostic(false);
+end
+
+@ Negation is easy except when the current expression
+is of type |independent|, or when it is a pair with one or more
+|independent| components.
+
+It is tempting to argue that the negative of an independent variable
+is an independent variable, hence we don't have to do anything when
+negating it. The fallacy is that other dependent variables pointing
+to the current expression must change the sign of their
+coefficients if we make no change to the current expression.
+
+Instead, we work around the problem by copying the current expression
+and recycling it afterwards (cf.~the |stash_in| routine).
+
+@<Negate the current expression@>=
+case cur_type of
+color_type,pair_type,independent: begin q:=cur_exp; make_exp_copy(q);
+ if cur_type=dependent then negate_dep_list(dep_list(cur_exp))
+ else if cur_type<=pair_type then {|color_type| or |pair_type|}
+ begin p:=value(cur_exp);
+ r:=p+big_node_size[cur_type];
+ repeat r:=r-2;
+ if type(r)=known then negate(value(r))
+ else negate_dep_list(dep_list(r));
+ until r=p;
+ end; {if |cur_type=known| then |cur_exp=0|}
+ recycle_value(q); free_node(q,value_node_size);
+ end;
+dependent,proto_dependent:negate_dep_list(dep_list(cur_exp));
+known:negate(cur_exp);
+othercases bad_unary(minus)
+endcases
+
+@ @<Declare unary action...@>=
+procedure negate_dep_list(@!p:pointer);
+label exit;
+begin loop@+begin negate(value(p));
+ if info(p)=null then return;
+ p:=link(p);
+ end;
+exit:end;
+
+@ @<Additional cases of unary operators@>=
+not_op: if cur_type<>boolean_type then bad_unary(not_op)
+ else cur_exp:=true_code+false_code-cur_exp;
+
+@ @d three_sixty_units==23592960 {that's |360*unity|}
+@d boolean_reset(#)==if # then cur_exp:=true_code@+else cur_exp:=false_code
+
+@<Additional cases of unary operators@>=
+sqrt_op,m_exp_op,m_log_op,sin_d_op,cos_d_op,floor_op,
+ uniform_deviate,odd_op,char_exists_op:@t@>@;@/
+ if cur_type<>known then bad_unary(c)
+ else case c of
+ sqrt_op:cur_exp:=square_rt(cur_exp);
+ m_exp_op:cur_exp:=m_exp(cur_exp);
+ m_log_op:cur_exp:=m_log(cur_exp);
+ sin_d_op,cos_d_op:begin n_sin_cos((cur_exp mod three_sixty_units)*16);
+ if c=sin_d_op then cur_exp:=round_fraction(n_sin)
+ else cur_exp:=round_fraction(n_cos);
+ end;
+ floor_op:cur_exp:=floor_scaled(cur_exp);
+ uniform_deviate:cur_exp:=unif_rand(cur_exp);
+ odd_op: begin boolean_reset(odd(round_unscaled(cur_exp)));
+ cur_type:=boolean_type;
+ end;
+ char_exists_op:@<Determine if a character has been shipped out@>;
+ end; {there are no other cases}
+
+@ @<Additional cases of unary operators@>=
+angle_op:if nice_pair(cur_exp,cur_type) then
+ begin p:=value(cur_exp);
+ x:=n_arg(value(x_part_loc(p)),value(y_part_loc(p)));
+ if x>=0 then flush_cur_exp((x+8)div 16)
+ else flush_cur_exp(-((-x+8)div 16));
+ end
+ else bad_unary(angle_op);
+
+@ If the current expression is a pair, but the context wants it to
+be a path, we call |pair_to_path|.
+
+@<Declare unary action...@>=
+procedure pair_to_path;
+begin cur_exp:=new_knot; cur_type:=path_type;
+end;
+
+@ @<Additional cases of unary operators@>=
+x_part,y_part:if (cur_type=pair_type)or(cur_type=transform_type) then
+ take_part(c)
+ else if cur_type=picture_type then take_pict_part(c)
+ else bad_unary(c);
+xx_part,xy_part,yx_part,yy_part: if cur_type=transform_type then take_part(c)
+ else if cur_type=picture_type then take_pict_part(c)
+ else bad_unary(c);
+red_part,green_part,blue_part: if cur_type=color_type then take_part(c)
+ else if cur_type=picture_type then take_pict_part(c)
+ else bad_unary(c);
+
+@ In the following procedure, |cur_exp| points to a capsule, which points to
+a big node. We want to delete all but one part of the big node.
+
+@<Declare unary action...@>=
+procedure take_part(@!c:quarterword);
+var @!p:pointer; {the big node}
+begin p:=value(cur_exp); value(temp_val):=p; type(temp_val):=cur_type;
+link(p):=temp_val; free_node(cur_exp,value_node_size);
+make_exp_copy(p+sector_offset[c+x_part_sector-x_part]);
+recycle_value(temp_val);
+end;
+
+@ @<Initialize table entries...@>=
+name_type(temp_val):=capsule;
+
+@ @<Additional cases of unary operators@>=
+font_part,text_part,path_part,pen_part,dash_part:
+ if cur_type=picture_type then take_pict_part(c)
+ else bad_unary(c);
+
+@ @<Declare unary action...@>=
+procedure@?scale_edges; forward;@t\2@>@;@/
+procedure take_pict_part(@!c:quarterword);
+label exit, not_found;
+var @!p:pointer; {first graphical object in |cur_exp|}
+begin p:=link(dummy_loc(cur_exp));
+if p<>null then
+ begin case c of
+ x_part,y_part,xx_part,xy_part,yx_part,yy_part:
+ if type(p)=text_code then flush_cur_exp(text_trans_part(p+c))
+ else goto not_found;
+ red_part,green_part,blue_part:
+ if has_color(p) then flush_cur_exp(obj_color_part(p+c))
+ else goto not_found;
+ @<Handle other cases in |take_pict_part| or |goto not_found|@>@;
+ end; {all cases have been enumerated}
+ return;
+ end;
+not_found:@<Convert the current expression to a null value appropriate
+ for |c|@>;
+exit:end;
+
+@ @<Handle other cases in |take_pict_part| or |goto not_found|@>=
+text_part: if type(p)<>text_code then goto not_found
+ else begin flush_cur_exp(text_p(p));
+ add_str_ref(cur_exp);
+ cur_type:=string_type;
+ end;
+font_part: if type(p)<>text_code then goto not_found
+ else begin flush_cur_exp(font_name[font_n(p)]);
+ add_str_ref(cur_exp);
+ cur_type:=string_type;
+ end;
+path_part:if type(p)=text_code then goto not_found
+ else if is_stop(p) then confusion("pict")
+@:this can't happen pict}{\quad pict@>
+ else begin flush_cur_exp(copy_path(path_p(p)));
+ cur_type:=path_type;
+ end;
+pen_part: if not has_pen(p) then goto not_found
+ else if pen_p(p)=null then goto not_found
+ else begin flush_cur_exp(copy_pen(pen_p(p)));
+ cur_type:=pen_type;
+ end;
+dash_part: if type(p)<>stroked_code then goto not_found
+ else if dash_p(p)=null then goto not_found
+ else begin add_edge_ref(dash_p(p));@/
+ se_sf:=dash_scale(p);
+ se_pic:=dash_p(p);
+ scale_edges;
+ flush_cur_exp(se_pic);
+ cur_type:=picture_type;
+ end;
+
+@ Since |scale_edges| had to be declared |forward|, it had to be declared as a
+parameterless procedure even though it really takes two arguments and updates
+one of them. Hence the following globals are needed.
+
+@<Global...@>=
+@!se_pic:pointer; {edge header used and updated by |scale_edges|}
+@!se_sf:scaled; {the scale factor argument to |scale_edges|}
+
+@ @<Convert the current expression to a null value appropriate...@>=
+case c of
+text_part,font_part: begin flush_cur_exp("");
+ cur_type:=string_type;
+ end;
+path_part: begin flush_cur_exp(get_node(knot_node_size));
+ left_type(cur_exp):=endpoint;
+ right_type(cur_exp):=endpoint;
+ link(cur_exp):=cur_exp;
+ x_coord(cur_exp):=0;
+ y_coord(cur_exp):=0;
+ originator(cur_exp):=metapost_user;
+ cur_type:=path_type;
+ end;
+pen_part: begin flush_cur_exp(get_pen_circle(0));
+ cur_type:=pen_type;
+ end;
+dash_part: begin flush_cur_exp(get_node(edge_header_size));
+ init_edges(cur_exp);
+ cur_type:=picture_type;
+ end;
+othercases flush_cur_exp(0)
+endcases
+
+@ @<Additional cases of unary...@>=
+char_op: if cur_type<>known then bad_unary(char_op)
+ else begin cur_exp:=round_unscaled(cur_exp) mod 256; cur_type:=string_type;
+ if cur_exp<0 then cur_exp:=cur_exp+256;
+ end;
+decimal: if cur_type<>known then bad_unary(decimal)
+ else begin old_setting:=selector; selector:=new_string;
+ print_scaled(cur_exp); cur_exp:=make_string;
+ selector:=old_setting; cur_type:=string_type;
+ end;
+oct_op,hex_op,ASCII_op: if cur_type<>string_type then bad_unary(c)
+ else str_to_num(c);
+font_size: if cur_type<>string_type then bad_unary(font_size)
+ else @<Find the design size of the font whose name is |cur_exp|@>;
+
+@ @<Declare unary action...@>=
+procedure str_to_num(@!c:quarterword); {converts a string to a number}
+var @!n:integer; {accumulator}
+@!m:ASCII_code; {current character}
+@!k:pool_pointer; {index into |str_pool|}
+@!b:8..16; {radix of conversion}
+@!bad_char:boolean; {did the string contain an invalid digit?}
+begin if c=ASCII_op then
+ if length(cur_exp)=0 then n:=-1
+ else n:=so(str_pool[str_start[cur_exp]])
+else begin if c=oct_op then b:=8@+else b:=16;
+ n:=0; bad_char:=false;
+ for k:=str_start[cur_exp] to str_stop(cur_exp)-1 do
+ begin m:=so(str_pool[k]);
+ if (m>="0")and(m<="9") then m:=m-"0"
+ else if (m>="A")and(m<="F") then m:=m-"A"+10
+ else if (m>="a")and(m<="f") then m:=m-"a"+10
+ else begin bad_char:=true; m:=0;
+ end;
+ if m>=b then
+ begin bad_char:=true; m:=0;
+ end;
+ if n<32768 div b then n:=n*b+m@+else n:=32767;
+ end;
+ @<Give error messages if |bad_char| or |n>=4096|@>;
+ end;
+flush_cur_exp(n*unity);
+end;
+
+@ @<Give error messages if |bad_char|...@>=
+if bad_char then
+ begin exp_err("String contains illegal digits");
+@.String contains illegal digits@>
+ if c=oct_op then
+ help1("I zeroed out characters that weren't in the range 0..7.")
+ else help1("I zeroed out characters that weren't hex digits.");
+ put_get_error;
+ end;
+if (n>4095) then
+ if internal[warning_check]>0 then
+ begin print_err("Number too large ("); print_int(n); print_char(")");
+@.Number too large@>
+ help2("I have trouble with numbers greater than 4095; watch out.")@/
+ ("(Set warningcheck:=0 to suppress this message.)");
+ put_get_error;
+ end
+
+@ The length operation is somewhat unusual in that it applies to a variety
+of different types of operands.
+
+@<Additional cases of unary...@>=
+length_op: case cur_type of
+ string_type: flush_cur_exp(length(cur_exp)*unity);
+ path_type: flush_cur_exp(path_length);
+ known: cur_exp:=abs(cur_exp);
+ picture_type: flush_cur_exp(pict_length);
+ othercases if nice_pair(cur_exp,cur_type) then
+ flush_cur_exp(pyth_add(value(x_part_loc(value(cur_exp))),@|
+ value(y_part_loc(value(cur_exp)))))
+ else bad_unary(c)
+ endcases;
+
+@ @<Declare unary action...@>=
+function path_length:scaled; {computes the length of the current path}
+var @!n:scaled; {the path length so far}
+@!p:pointer; {traverser}
+begin p:=cur_exp;
+if left_type(p)=endpoint then n:=-unity@+else n:=0;
+repeat p:=link(p); n:=n+unity;
+until p=cur_exp;
+path_length:=n;
+end;
+
+@ @<Declare unary action...@>=
+function pict_length:scaled; {counts interior components in picture |cur_exp|}
+label found;
+var @!n:scaled; {the count so far}
+@!p:pointer; {traverser}
+begin n:=0;
+p:=link(dummy_loc(cur_exp));
+if p<>null then
+ begin if is_start_or_stop(p) then
+ if skip_1component(p)=null then p:=link(p);
+ while p<>null do
+ begin skip_component(p)(goto found);
+ n:=n+unity;
+ end;
+ end;
+found:pict_length:=n;
+end;
+
+@ The turning number is computed only with respect to a triangular pen whose
+@:turning_number_}{\&{turningnumber} primitive@>
+vertices are $(0,1)$ and $(\pm{1\over2},0)$. The choice of pen isn't supposed
+to matter but rounding error could make a difference if the path has a cusp.
+
+@<Additional cases of unary...@>=
+turning_op:if cur_type=pair_type then flush_cur_exp(0)
+ else if cur_type<>path_type then bad_unary(turning_op)
+ else if left_type(cur_exp)=endpoint then
+ flush_cur_exp(0) {not a cyclic path}
+ else begin
+ flush_cur_exp(turn_cycles(cur_exp));
+ end;
+
+
+@ This code is based on Bogus\l{}av Jackowski's
+|emergency_turningnumber| macro, with some minor changes by Taco
+Hoekwater. The macro code looked more like this:
+{\obeylines
+vardef turning\_number primary p =
+~~save res, ang, turns;
+~~res := 0;
+~~if length p <= 2:
+~~~~if Angle ((point 0 of p) - (postcontrol 0 of p)) >= 0: 1 else: -1 fi
+~~else:
+~~~~for t = 0 upto length p-1 :
+~~~~~~angc := Angle ((point t+1 of p) - (point t of p))
+~~~~~~~~- Angle ((point t of p) - (point t-1 of p));
+~~~~~~if angc > 180: angc := angc - 360; fi;
+~~~~~~if angc < -180: angc := angc + 360; fi;
+~~~~~~res := res + angc;
+~~~~endfor;
+~~res/360
+~~fi
+enddef;}
+The general idea is to calculate only the sum of the angles of straight lines between
+the points, of a path, not worrying about cusps or self-intersections in the segments
+at all. If the segment is not well-behaved, the result is not necesarily correct. But
+the old code was not always correct either, and worse, it sometimes failed for well-behaved
+paths as well. All known bugs that were triggered by the original code no longer occur
+with this code, and it runs roughly 3 times as fast because the algorithm is much simpler.
+
+@ The macro |Angle()| returns the value of the |angle| primitive, or $0$ if the argument is
+|origin|. Converting that calling convention to web code gives the |an_angle| function.
+
+@<Declare unary action...@>=
+function an_angle (@!xpar,@!ypar:scaled):angle;
+begin
+ if (not ((xpar=0) and (ypar=0))) then
+ an_angle := n_arg(xpar,ypar)
+ else
+ an_angle := 0;
+end;
+
+
+@ It is possible to overflow the return value of the |turn_cycles|
+function when the path is sufficiently long and winding, but I am not
+going to bother testing for that. In any case, it would only return
+the looped result value, which is not a big problem.
+
+The macro code for the repeat loop was a bit nicer to look
+at than the pascal code, because it could use |point -1 of p|. In
+pascal, the fastest way to loop around the path is not to look
+backward once, but forward twice. These defines help hide the trick.
+
+@d p_to==link(link(p))
+@d p_here==link(p)
+@d p_from==p
+
+@<Declare unary action...@>=
+function turn_cycles (@!c:pointer):scaled;
+var @!res,ang:angle; { the angles of intermediate results }
+@!turns:scaled; { the turn counter }
+@!p:pointer; { for running around the path }
+begin res:=0; turns:= 0; p:=c;
+if ((link(p) = p) or (link(link(p)) = p)) then
+ if an_angle (x_coord(p) - right_x(p), y_coord(p) - right_y(p)) >= 0 then
+ turn_cycles := unity
+ else
+ turn_cycles := -unity
+else begin
+ repeat
+ ang := an_angle (x_coord(p_to) - x_coord(p_here), y_coord(p_to) - y_coord(p_here))
+ - an_angle (x_coord(p_here) - x_coord(p_from), y_coord(p_here) - y_coord(p_from));
+ reduce_angle(ang);
+ res := res + ang;
+ if res >= three_sixty_deg then begin
+ res := res - three_sixty_deg;
+ turns := turns + unity;
+ end;
+ if res <= -three_sixty_deg then begin
+ res := res + three_sixty_deg;
+ turns := turns - unity;
+ end;
+ p := link(p);
+ until p=c;
+ turn_cycles := turns;
+end;
+end;
+
+@ @<Declare unary action...@>=
+function count_turns(@!c:pointer):scaled;
+var @!p:pointer; {a knot in envelope spec |c|}
+@!t:integer; {total pen offset changes counted}
+begin t:=0; p:=c;
+repeat t:=t+info(p)-zero_off;
+p:=link(p);
+until p=c;
+count_turns:=(t div 3)*unity;
+end;
+
+@ @d type_test_end== flush_cur_exp(true_code)
+ else flush_cur_exp(false_code);
+ cur_type:=boolean_type;
+ end
+@d type_range_end(#)==(cur_type<=#) then type_test_end
+@d type_range(#)==begin if (cur_type>=#) and type_range_end
+@d type_test(#)==begin if cur_type=# then type_test_end
+
+@<Additional cases of unary operators@>=
+boolean_type: type_range(boolean_type)(unknown_boolean);
+string_type: type_range(string_type)(unknown_string);
+pen_type: type_range(pen_type)(unknown_pen);
+path_type: type_range(path_type)(unknown_path);
+picture_type: type_range(picture_type)(unknown_picture);
+transform_type,color_type,pair_type: type_test(c);
+numeric_type: type_range(known)(independent);
+known_op,unknown_op: test_known(c);
+
+@ @<Declare unary action procedures@>=
+procedure test_known(@!c:quarterword);
+label done;
+var @!b:true_code..false_code; {is the current expression known?}
+@!p,@!q:pointer; {locations in a big node}
+begin b:=false_code;
+case cur_type of
+vacuous,boolean_type,string_type,pen_type,path_type,picture_type,
+ known: b:=true_code;
+transform_type,color_type,pair_type:begin p:=value(cur_exp);
+ q:=p+big_node_size[cur_type];
+ repeat q:=q-2;
+ if type(q)<>known then goto done;
+ until q=p;
+ b:=true_code;
+done: end;
+othercases do_nothing
+endcases;
+if c=known_op then flush_cur_exp(b)
+else flush_cur_exp(true_code+false_code-b);
+cur_type:=boolean_type;
+end;
+
+@ @<Additional cases of unary operators@>=
+cycle_op: begin if cur_type<>path_type then flush_cur_exp(false_code)
+ else if left_type(cur_exp)<>endpoint then flush_cur_exp(true_code)
+ else flush_cur_exp(false_code);
+ cur_type:=boolean_type;
+ end;
+
+@ @<Additional cases of unary operators@>=
+arc_length: begin if cur_type=pair_type then pair_to_path;
+ if cur_type<>path_type then bad_unary(arc_length)
+ else flush_cur_exp(get_arc_length(cur_exp));
+ end;
+
+@ Here we use the fact that |c-filled_op+fill_code| is the desired graphical
+object |type|.
+@^data structure assumptions@>
+
+@<Additional cases of unary operators@>=
+filled_op,stroked_op,textual_op,clipped_op,bounded_op:
+ begin if cur_type<>picture_type then flush_cur_exp(false_code)
+ else if link(dummy_loc(cur_exp))=null then flush_cur_exp(false_code)
+ else if type(link(dummy_loc(cur_exp)))=c+fill_code-filled_op then
+ flush_cur_exp(true_code)
+ else flush_cur_exp(false_code);
+ cur_type:=boolean_type;
+ end;
+
+@ @<Additional cases of unary operators@>=
+make_pen_op: begin if cur_type=pair_type then pair_to_path;
+ if cur_type<>path_type then bad_unary(make_pen_op)
+ else begin cur_type:=pen_type;
+ cur_exp:=make_pen(cur_exp,true);
+ end;
+ end;
+make_path_op: if cur_type<>pen_type then bad_unary(make_path_op)
+ else begin cur_type:=path_type;
+ make_path(cur_exp);
+ end;
+reverse: if cur_type=path_type then
+ begin p:=htap_ypoc(cur_exp);
+ if right_type(p)=endpoint then p:=link(p);
+ toss_knot_list(cur_exp); cur_exp:=p;
+ end
+ else if cur_type=pair_type then pair_to_path
+ else bad_unary(reverse);
+
+@ The |pair_value| routine changes the current expression to a
+given ordered pair of values.
+
+@<Declare unary action procedures@>=
+procedure pair_value(@!x,@!y:scaled);
+var @!p:pointer; {a pair node}
+begin p:=get_node(value_node_size); flush_cur_exp(p); cur_type:=pair_type;
+type(p):=pair_type; name_type(p):=capsule; init_big_node(p);
+p:=value(p);@/
+type(x_part_loc(p)):=known; value(x_part_loc(p)):=x;@/
+type(y_part_loc(p)):=known; value(y_part_loc(p)):=y;@/
+end;
+
+@ @<Additional cases of unary operators@>=
+ll_corner_op: if not get_cur_bbox then bad_unary(ll_corner_op)
+ else pair_value(minx,miny);
+lr_corner_op: if not get_cur_bbox then bad_unary(lr_corner_op)
+ else pair_value(maxx,miny);
+ul_corner_op: if not get_cur_bbox then bad_unary(ul_corner_op)
+ else pair_value(minx,maxy);
+ur_corner_op: if not get_cur_bbox then bad_unary(ur_corner_op)
+ else pair_value(maxx,maxy);
+
+@ Here is a function that sets |minx|, |maxx|, |miny|, |maxy| to the bounding
+box of the current expression. The boolean result is |false| if the expression
+has the wrong type.
+
+@<Declare unary action procedures@>=
+function get_cur_bbox: boolean;
+label exit;
+begin case cur_type of
+picture_type: begin set_bbox(cur_exp,true);
+ if minx_val(cur_exp)>maxx_val(cur_exp) then
+ begin minx:=0; maxx:=0; miny:=0; maxy:=0;
+ end
+ else begin minx:=minx_val(cur_exp);
+ maxx:=maxx_val(cur_exp);
+ miny:=miny_val(cur_exp);
+ maxy:=maxy_val(cur_exp);
+ end;
+ end;
+path_type: path_bbox(cur_exp);
+pen_type: pen_bbox(cur_exp);
+othercases begin get_cur_bbox:=false;
+ return;
+ end
+endcases;@/
+get_cur_bbox:=true;
+exit:end;
+
+@ @<Additional cases of unary operators@>=
+read_from_op,close_from_op: if cur_type<>string_type then bad_unary(c)
+else do_read_or_close(c);
+
+@ Here is a routine that interprets |cur_exp| as a file name and tries to read
+a line from the file or to close the file.
+
+@d close_file=46 {go here when closing the file}
+
+@<Declare unary action procedures@>=
+procedure do_read_or_close(@!c:quarterword);
+label exit, continue, found, not_found, close_file;
+var @!n,@!n0:readf_index; {indices for searching |rd_fname|}
+begin @<Find the |n| where |rd_fname[n]=cur_exp|; if |cur_exp| must be inserted,
+ call |start_read_input| and |goto found| or |not_found|@>;
+begin_file_reading;
+name:=is_read;
+if input_ln(rd_file[n],true) then goto found;
+end_file_reading;
+not_found:@<Record the end of file and set |cur_exp| to a dummy value@>;
+return;
+close_file:flush_cur_exp(0); cur_type:=vacuous; return;
+found:flush_cur_exp(0);
+finish_read;
+exit:end;
+
+@ Free slots in the |rd_file| and |rd_fname| arrays are marked with 0's in
+|rd_fname|.
+
+@<Find the |n| where |rd_fname[n]=cur_exp|...@>=
+n:=read_files;
+n0:=read_files;
+repeat
+continue:if n>0 then decr(n)
+else if c=close_from_op then goto close_file
+else @<Insert |cur_exp| at index |n0|, then call |start_read_input| and
+ |goto found| or |not_found|@>;
+if rd_fname[n]=0 then
+ begin n0:=n; goto continue;
+ end;
+until str_vs_str(cur_exp,rd_fname[n])=0;
+if c=close_from_op then
+ begin a_close(rd_file[n]); goto not_found; end
+
+@ @<Insert |cur_exp| at index |n0|, then call |start_read_input| and...@>=
+begin if n0=read_files then
+ if read_files<max_read_files then incr(read_files)
+ else overflow("readfrom files",max_read_files);
+n:=n0;
+if start_read_input(cur_exp,n) then goto found @+else goto not_found;
+end
+
+@ @<Record the end of file and set |cur_exp| to a dummy value@>=
+delete_str_ref(rd_fname[n]);
+rd_fname[n]:=0;
+if n=read_files-1 then read_files:=n;
+if c=close_from_op then goto close_file;
+@<Make sure |eof_line| is initialized@>;
+flush_cur_exp(eof_line);
+cur_type:=string_type
+
+@ Since the |eof_line| string contains a non-printable character, it must be
+initialized at run time and stored in a global variable.
+
+@<Glob...@>=
+eof_line:str_number; {string denoting end-of-file or 0 if uninitialized}
+
+@ @<Set init...@>=
+eof_line:=0;
+
+@ @<Make sure |eof_line| is initialized@>=
+if eof_line=0 then
+ begin append_char(0);
+ eof_line:=make_string;
+ str_ref[eof_line]:=max_str_ref;
+ end
+
+@ Finally, we have the operations that combine a capsule~|p|
+with the current expression.
+
+@p @t\4@>@<Declare binary action procedures@>@;
+procedure do_binary(@!p:pointer;@!c:quarterword);
+label done,done1,exit;
+var @!q,@!r,@!rr:pointer; {for list manipulation}
+@!old_p,@!old_exp:pointer; {capsules to recycle}
+@!v:integer; {for numeric manipulation}
+begin check_arith;
+if internal[tracing_commands]>two then
+ @<Trace the current binary operation@>;
+@<Sidestep |independent| cases in capsule |p|@>;
+@<Sidestep |independent| cases in the current expression@>;
+case c of
+plus,minus:@<Add or subtract the current expression from |p|@>;
+@t\4@>@<Additional cases of binary operators@>@;
+end; {there are no other cases}
+recycle_value(p); free_node(p,value_node_size); {|return| to avoid this}
+exit:check_arith; @<Recycle any sidestepped |independent| capsules@>;
+end;
+
+@ @<Declare binary action...@>=
+procedure bad_binary(@!p:pointer;@!c:quarterword);
+begin disp_err(p,"");
+exp_err("Not implemented: ");
+@.Not implemented...@>
+if c>=min_of then print_op(c);
+print_known_or_unknown_type(type(p),p);
+if c>=min_of then print("of")@+else print_op(c);
+print_known_or_unknown_type(cur_type,cur_exp);@/
+help3("I'm afraid I don't know how to apply that operation to that")@/
+ ("combination of types. Continue, and I'll return the second")@/
+ ("argument (see above) as the result of the operation.");
+put_get_error;
+end;
+
+@ @<Trace the current binary operation@>=
+begin begin_diagnostic; print_nl("{(");
+print_exp(p,0); {show the operand, but not verbosely}
+print_char(")"); print_op(c); print_char("(");@/
+print_exp(null,0); print(")}"); end_diagnostic(false);
+end
+
+@ Several of the binary operations are potentially complicated by the
+fact that |independent| values can sneak into capsules. For example,
+we've seen an instance of this difficulty in the unary operation
+of negation. In order to reduce the number of cases that need to be
+handled, we first change the two operands (if necessary)
+to rid them of |independent| components. The original operands are
+put into capsules called |old_p| and |old_exp|, which will be
+recycled after the binary operation has been safely carried out.
+
+@<Recycle any sidestepped |independent| capsules@>=
+if old_p<>null then
+ begin recycle_value(old_p); free_node(old_p,value_node_size);
+ end;
+if old_exp<>null then
+ begin recycle_value(old_exp); free_node(old_exp,value_node_size);
+ end
+
+@ A big node is considered to be ``tarnished'' if it contains at least one
+independent component. We will define a simple function called `|tarnished|'
+that returns |null| if and only if its argument is not tarnished.
+
+@<Sidestep |independent| cases in capsule |p|@>=
+case type(p) of
+transform_type,color_type,pair_type: old_p:=tarnished(p);
+independent: old_p:=void;
+othercases old_p:=null
+endcases;
+if old_p<>null then
+ begin q:=stash_cur_exp; old_p:=p; make_exp_copy(old_p);
+ p:=stash_cur_exp; unstash_cur_exp(q);
+ end;
+
+@ @<Sidestep |independent| cases in the current expression@>=
+case cur_type of
+transform_type,color_type,pair_type:old_exp:=tarnished(cur_exp);
+independent:old_exp:=void;
+othercases old_exp:=null
+endcases;
+if old_exp<>null then
+ begin old_exp:=cur_exp; make_exp_copy(old_exp);
+ end
+
+@ @<Declare binary action...@>=
+function tarnished(@!p:pointer):pointer;
+label exit;
+var @!q:pointer; {beginning of the big node}
+@!r:pointer; {current position in the big node}
+begin q:=value(p); r:=q+big_node_size[type(p)];
+repeat r:=r-2;
+if type(r)=independent then
+ begin tarnished:=void; return;
+ end;
+until r=q;
+tarnished:=null;
+exit:end;
+
+@ @<Add or subtract the current expression from |p|@>=
+if (cur_type<color_type)or(type(p)<color_type) then bad_binary(p,c)
+else if (cur_type>pair_type)and(type(p)>pair_type) then
+ add_or_subtract(p,null,c)
+ else if cur_type<>type(p) then bad_binary(p,c)
+ else begin q:=value(p); r:=value(cur_exp);
+ rr:=r+big_node_size[cur_type];
+ while r<rr do
+ begin add_or_subtract(q,r,c);
+ q:=q+2; r:=r+2;
+ end;
+ end
+
+@ The first argument to |add_or_subtract| is the location of a value node
+in a capsule or pair node that will soon be recycled. The second argument
+is either a location within a pair or transform node of |cur_exp|,
+or it is null (which means that |cur_exp| itself should be the second
+argument). The third argument is either |plus| or |minus|.
+
+The sum or difference of the numeric quantities will replace the second
+operand. Arithmetic overflow may go undetected; users aren't supposed to
+be monkeying around with really big values.
+
+@<Declare binary action...@>=
+@t\4@>@<Declare the procedure called |dep_finish|@>@;
+procedure add_or_subtract(@!p,@!q:pointer;@!c:quarterword);
+label done,exit;
+var @!s,@!t:small_number; {operand types}
+@!r:pointer; {list traverser}
+@!v:integer; {second operand value}
+begin if q=null then
+ begin t:=cur_type;
+ if t<dependent then v:=cur_exp@+else v:=dep_list(cur_exp);
+ end
+else begin t:=type(q);
+ if t<dependent then v:=value(q)@+else v:=dep_list(q);
+ end;
+if t=known then
+ begin if c=minus then negate(v);
+ if type(p)=known then
+ begin v:=slow_add(value(p),v);
+ if q=null then cur_exp:=v@+else value(q):=v;
+ return;
+ end;
+ @<Add a known value to the constant term of |dep_list(p)|@>;
+ end
+else begin if c=minus then negate_dep_list(v);
+ @<Add operand |p| to the dependency list |v|@>;
+ end;
+exit:end;
+
+@ @<Add a known value to the constant term of |dep_list(p)|@>=
+r:=dep_list(p);
+while info(r)<>null do r:=link(r);
+value(r):=slow_add(value(r),v);
+if q=null then
+ begin q:=get_node(value_node_size); cur_exp:=q; cur_type:=type(p);
+ name_type(q):=capsule;
+ end;
+dep_list(q):=dep_list(p); type(q):=type(p);
+prev_dep(q):=prev_dep(p); link(prev_dep(p)):=q;
+type(p):=known; {this will keep the recycler from collecting non-garbage}
+
+@ We prefer |dependent| lists to |proto_dependent| ones, because it is
+nice to retain the extra accuracy of |fraction| coefficients.
+But we have to handle both kinds, and mixtures too.
+
+@<Add operand |p| to the dependency list |v|@>=
+if type(p)=known then
+ @<Add the known |value(p)| to the constant term of |v|@>
+else begin s:=type(p); r:=dep_list(p);
+ if t=dependent then
+ begin if s=dependent then
+ if max_coef(r)+max_coef(v)<coef_bound then
+ begin v:=p_plus_q(v,r,dependent); goto done;
+ end; {|fix_needed| will necessarily be false}
+ t:=proto_dependent; v:=p_over_v(v,unity,dependent,proto_dependent);
+ end;
+ if s=proto_dependent then v:=p_plus_q(v,r,proto_dependent)
+ else v:=p_plus_fq(v,unity,r,proto_dependent,dependent);
+ done: @<Output the answer, |v| (which might have become |known|)@>;
+ end
+
+@ @<Add the known |value(p)| to the constant term of |v|@>=
+begin while info(v)<>null do v:=link(v);
+value(v):=slow_add(value(p),value(v));
+end
+
+@ @<Output the answer, |v| (which might have become |known|)@>=
+if q<>null then dep_finish(v,q,t)
+else begin cur_type:=t; dep_finish(v,null,t);
+ end
+
+@ Here's the current situation: The dependency list |v| of type |t|
+should either be put into the current expression (if |q=null|) or
+into location |q| within a pair node (otherwise). The destination (|cur_exp|
+or |q|) formerly held a dependency list with the same
+final pointer as the list |v|.
+
+@<Declare the procedure called |dep_finish|@>=
+procedure dep_finish(@!v,@!q:pointer;@!t:small_number);
+var @!p:pointer; {the destination}
+@!vv:scaled; {the value, if it is |known|}
+begin if q=null then p:=cur_exp@+else p:=q;
+dep_list(p):=v; type(p):=t;
+if info(v)=null then
+ begin vv:=value(v);
+ if q=null then flush_cur_exp(vv)
+ else begin recycle_value(p); type(q):=known; value(q):=vv;
+ end;
+ end
+else if q=null then cur_type:=t;
+if fix_needed then fix_dependencies;
+end;
+
+@ Let's turn now to the six basic relations of comparison.
+
+@<Additional cases of binary operators@>=
+less_than,less_or_equal,greater_than,greater_or_equal,equal_to,unequal_to:
+ begin check_arith; {at this point |arith_error| should be |false|?}
+ if (cur_type>pair_type)and(type(p)>pair_type) then
+ add_or_subtract(p,null,minus) {|cur_exp:=(p)-cur_exp|}
+ else if cur_type<>type(p) then
+ begin bad_binary(p,c); goto done;
+ end
+ else if cur_type=string_type then
+ flush_cur_exp(str_vs_str(value(p),cur_exp))
+ else if (cur_type=unknown_string)or(cur_type=unknown_boolean) then
+ @<Check if unknowns have been equated@>
+ else if (cur_type<=pair_type)and(cur_type>=transform_type) then
+ @<Reduce comparison of big nodes to comparison of scalars@>
+ else if cur_type=boolean_type then flush_cur_exp(cur_exp-value(p))
+ else begin bad_binary(p,c); goto done;
+ end;
+ @<Compare the current expression with zero@>;
+done: arith_error:=false; {ignore overflow in comparisons}
+ end;
+
+@ @<Compare the current expression with zero@>=
+if cur_type<>known then
+ begin if cur_type<known then
+ begin disp_err(p,"");
+ help1("The quantities shown above have not been equated.")@/
+ end
+ else help2("Oh dear. I can't decide if the expression above is positive,")@/
+ ("negative, or zero. So this comparison test won't be `true'.");
+ exp_err("Unknown relation will be considered false");
+@.Unknown relation...@>
+ put_get_flush_error(false_code);
+ end
+else case c of
+ less_than: boolean_reset(cur_exp<0);
+ less_or_equal: boolean_reset(cur_exp<=0);
+ greater_than: boolean_reset(cur_exp>0);
+ greater_or_equal: boolean_reset(cur_exp>=0);
+ equal_to: boolean_reset(cur_exp=0);
+ unequal_to: boolean_reset(cur_exp<>0);
+ end; {there are no other cases}
+ cur_type:=boolean_type
+
+@ When two unknown strings are in the same ring, we know that they are
+equal. Otherwise, we don't know whether they are equal or not, so we
+make no change.
+
+@<Check if unknowns have been equated@>=
+begin q:=value(cur_exp);
+while (q<>cur_exp)and(q<>p) do q:=value(q);
+if q=p then flush_cur_exp(0);
+end
+
+@ @<Reduce comparison of big nodes to comparison of scalars@>=
+begin q:=value(p); r:=value(cur_exp);
+rr:=r+big_node_size[cur_type]-2;
+loop@+ begin add_or_subtract(q,r,minus);
+ if type(r)<>known then goto done1;
+ if value(r)<>0 then goto done1;
+ if r=rr then goto done1;
+ q:=q+2; r:=r+2;
+ end;
+done1:take_part(name_type(r)+x_part-x_part_sector);
+end
+
+@ Here we use the sneaky fact that |and_op-false_code=or_op-true_code|.
+
+@<Additional cases of binary operators@>=
+and_op,or_op: if (type(p)<>boolean_type)or(cur_type<>boolean_type) then
+ bad_binary(p,c)
+ else if value(p)=c+false_code-and_op then cur_exp:=value(p);
+
+@ @<Additional cases of binary operators@>=
+times: if (cur_type<color_type)or(type(p)<color_type) then bad_binary(p,times)
+ else if (cur_type=known)or(type(p)=known) then
+ @<Multiply when at least one operand is known@>
+ else if (nice_color_or_pair(p,type(p))and(cur_type>pair_type))
+ or(nice_color_or_pair(cur_exp,cur_type)and(type(p)>pair_type)) then
+ begin hard_times(p); return;
+ end
+ else bad_binary(p,times);
+
+@ @<Multiply when at least one operand is known@>=
+begin if type(p)=known then
+ begin v:=value(p); free_node(p,value_node_size);
+ end
+else begin v:=cur_exp; unstash_cur_exp(p);
+ end;
+if cur_type=known then cur_exp:=take_scaled(cur_exp,v)
+else if (cur_type=pair_type)or(cur_type=color_type) then
+ begin p:=value(cur_exp)+big_node_size[cur_type];
+ repeat p:=p-2;
+ dep_mult(p,v,true);
+ until p=value(cur_exp);
+ end
+else dep_mult(null,v,true);
+return;
+end
+
+@ @<Declare binary action...@>=
+procedure dep_mult(@!p:pointer;@!v:integer;@!v_is_scaled:boolean);
+label exit;
+var @!q:pointer; {the dependency list being multiplied by |v|}
+@!s,@!t:small_number; {its type, before and after}
+begin if p=null then q:=cur_exp
+else if type(p)<>known then q:=p
+else begin if v_is_scaled then value(p):=take_scaled(value(p),v)
+ else value(p):=take_fraction(value(p),v);
+ return;
+ end;
+t:=type(q); q:=dep_list(q); s:=t;
+if t=dependent then if v_is_scaled then
+ if ab_vs_cd(max_coef(q),abs(v),coef_bound-1,unity)>=0 then t:=proto_dependent;
+q:=p_times_v(q,v,s,t,v_is_scaled); dep_finish(q,p,t);
+exit:end;
+
+@ Here is a routine that is similar to |times|; but it is invoked only
+internally, when |v| is a |fraction| whose magnitude is at most~1,
+and when |cur_type>=color_type|.
+
+@p procedure frac_mult(@!n,@!d:scaled); {multiplies |cur_exp| by |n/d|}
+var @!p:pointer; {a pair node}
+@!old_exp:pointer; {a capsule to recycle}
+@!v:fraction; {|n/d|}
+begin if internal[tracing_commands]>two then
+ @<Trace the fraction multiplication@>;
+case cur_type of
+transform_type,color_type,pair_type:old_exp:=tarnished(cur_exp);
+independent:old_exp:=void;
+othercases old_exp:=null
+endcases;
+if old_exp<>null then
+ begin old_exp:=cur_exp; make_exp_copy(old_exp);
+ end;
+v:=make_fraction(n,d);
+if cur_type=known then cur_exp:=take_fraction(cur_exp,v)
+else if cur_type<=pair_type then
+ begin p:=value(cur_exp)+big_node_size[cur_type];
+ repeat p:=p-2;
+ dep_mult(p,v,false);
+ until p=value(cur_exp);
+ end
+else dep_mult(null,v,false);
+if old_exp<>null then
+ begin recycle_value(old_exp); free_node(old_exp,value_node_size);
+ end
+end;
+
+@ @<Trace the fraction multiplication@>=
+begin begin_diagnostic; print_nl("{("); print_scaled(n); print_char("/");
+print_scaled(d); print(")*("); print_exp(null,0); print(")}");
+end_diagnostic(false);
+end
+
+@ The |hard_times| routine multiplies a nice color or pair by a dependency list.
+
+@<Declare binary action procedures@>=
+procedure hard_times(@!p:pointer);
+label done;
+var @!q:pointer; {a copy of the dependent variable |p|}
+@!r:pointer; {a component of the big node for the nice color or pair}
+@!v:scaled; {the known value for |r|}
+begin if type(p)<=pair_type then
+ begin q:=stash_cur_exp; unstash_cur_exp(p); p:=q;
+ end; {now |cur_type=pair_type| or |cur_type=color_type|}
+r:=value(cur_exp)+big_node_size[cur_type];
+loop @+begin r:=r-2;
+ v:=value(r);
+ type(r):=type(p);
+ if r=value(cur_exp) then goto done;
+ new_dep(r,copy_dep_list(dep_list(p)));
+ dep_mult(r,v,true);
+ end;
+done:mem[value_loc(r)]:=mem[value_loc(p)];
+link(prev_dep(p)):=r;
+free_node(p,value_node_size);
+dep_mult(r,v,true);
+end;
+
+@ @<Additional cases of binary operators@>=
+over: if (cur_type<>known)or(type(p)<color_type) then bad_binary(p,over)
+ else begin v:=cur_exp; unstash_cur_exp(p);
+ if v=0 then @<Squeal about division by zero@>
+ else begin if cur_type=known then cur_exp:=make_scaled(cur_exp,v)
+ else if cur_type<=pair_type then
+ begin p:=value(cur_exp)+big_node_size[cur_type];
+ repeat p:=p-2;
+ dep_div(p,v);
+ until p=value(cur_exp);
+ end
+ else dep_div(null,v);
+ end;
+ return;
+ end;
+
+@ @<Declare binary action...@>=
+procedure dep_div(@!p:pointer;@!v:scaled);
+label exit;
+var @!q:pointer; {the dependency list being divided by |v|}
+@!s,@!t:small_number; {its type, before and after}
+begin if p=null then q:=cur_exp
+else if type(p)<>known then q:=p
+else begin value(p):=make_scaled(value(p),v); return;
+ end;
+t:=type(q); q:=dep_list(q); s:=t;
+if t=dependent then
+ if ab_vs_cd(max_coef(q),unity,coef_bound-1,abs(v))>=0 then t:=proto_dependent;
+q:=p_over_v(q,v,s,t); dep_finish(q,p,t);
+exit:end;
+
+@ @<Squeal about division by zero@>=
+begin exp_err("Division by zero");
+@.Division by zero@>
+help2("You're trying to divide the quantity shown above the error")@/
+ ("message by zero. I'm going to divide it by one instead.");
+put_get_error;
+end
+
+@ @<Additional cases of binary operators@>=
+pythag_add,pythag_sub: if (cur_type=known)and(type(p)=known) then
+ if c=pythag_add then cur_exp:=pyth_add(value(p),cur_exp)
+ else cur_exp:=pyth_sub(value(p),cur_exp)
+ else bad_binary(p,c);
+
+@ The next few sections of the program deal with affine transformations
+of coordinate data.
+
+@<Additional cases of binary operators@>=
+rotated_by,slanted_by,scaled_by,shifted_by,transformed_by,
+ x_scaled,y_scaled,z_scaled: @t@>@;@/
+ if type(p)=path_type then
+ begin path_trans(c)(p); return;
+ end
+ else if type(p)=pen_type then
+ begin pen_trans(c)(p);
+ cur_exp:=convex_hull(cur_exp); {rounding error could destroy convexity}
+ return;
+ end
+ else if (type(p)=pair_type)or(type(p)=transform_type) then big_trans(p,c)
+ else if type(p)=picture_type then
+ begin do_edges_trans(p,c); return;
+ end
+ else bad_binary(p,c);
+
+@ Let |c| be one of the eight transform operators. The procedure call
+|set_up_trans(c)| first changes |cur_exp| to a transform that corresponds to
+|c| and the original value of |cur_exp|. (In particular, |cur_exp| doesn't
+change at all if |c=transformed_by|.)
+
+Then, if all components of the resulting transform are |known|, they are
+moved to the global variables |txx|, |txy|, |tyx|, |tyy|, |tx|, |ty|;
+and |cur_exp| is changed to the known value zero.
+
+@<Declare binary action...@>=
+procedure set_up_trans(@!c:quarterword);
+label done,exit;
+var @!p,@!q,@!r:pointer; {list manipulation registers}
+begin if (c<>transformed_by)or(cur_type<>transform_type) then
+ @<Put the current transform into |cur_exp|@>;
+@<If the current transform is entirely known, stash it in global variables;
+ otherwise |return|@>;
+exit:end;
+
+@ @<Glob...@>=
+@!txx,@!txy,@!tyx,@!tyy,@!tx,@!ty:scaled; {current transform coefficients}
+
+@ @<Put the current transform...@>=
+begin p:=stash_cur_exp; cur_exp:=id_transform; cur_type:=transform_type;
+q:=value(cur_exp);
+case c of
+@<For each of the eight cases, change the relevant fields of |cur_exp|
+ and |goto done|;
+ but do nothing if capsule |p| doesn't have the appropriate type@>@;
+end; {there are no other cases}
+disp_err(p,"Improper transformation argument");
+@.Improper transformation argument@>
+help3("The expression shown above has the wrong type,")@/
+ ("so I can't transform anything using it.")@/
+ ("Proceed, and I'll omit the transformation.");
+put_get_error;
+done: recycle_value(p); free_node(p,value_node_size);
+end
+
+@ @<If the current transform is entirely known, ...@>=
+q:=value(cur_exp); r:=q+transform_node_size;
+repeat r:=r-2;
+if type(r)<>known then return;
+until r=q;
+txx:=value(xx_part_loc(q));
+txy:=value(xy_part_loc(q));
+tyx:=value(yx_part_loc(q));
+tyy:=value(yy_part_loc(q));
+tx:=value(x_part_loc(q));
+ty:=value(y_part_loc(q));
+flush_cur_exp(0)
+
+@ @<For each of the eight cases...@>=
+rotated_by:if type(p)=known then
+ @<Install sines and cosines, then |goto done|@>;
+slanted_by:if type(p)>pair_type then
+ begin install(xy_part_loc(q),p); goto done;
+ end;
+scaled_by:if type(p)>pair_type then
+ begin install(xx_part_loc(q),p); install(yy_part_loc(q),p); goto done;
+ end;
+shifted_by:if type(p)=pair_type then
+ begin r:=value(p); install(x_part_loc(q),x_part_loc(r));
+ install(y_part_loc(q),y_part_loc(r)); goto done;
+ end;
+x_scaled:if type(p)>pair_type then
+ begin install(xx_part_loc(q),p); goto done;
+ end;
+y_scaled:if type(p)>pair_type then
+ begin install(yy_part_loc(q),p); goto done;
+ end;
+z_scaled:if type(p)=pair_type then
+ @<Install a complex multiplier, then |goto done|@>;
+transformed_by:do_nothing;
+
+@ @<Install sines and cosines, then |goto done|@>=
+begin n_sin_cos((value(p) mod three_sixty_units)*16);
+value(xx_part_loc(q)):=round_fraction(n_cos);
+value(yx_part_loc(q)):=round_fraction(n_sin);
+value(xy_part_loc(q)):=-value(yx_part_loc(q));
+value(yy_part_loc(q)):=value(xx_part_loc(q));
+goto done;
+end
+
+@ @<Install a complex multiplier, then |goto done|@>=
+begin r:=value(p);
+install(xx_part_loc(q),x_part_loc(r));
+install(yy_part_loc(q),x_part_loc(r));
+install(yx_part_loc(q),y_part_loc(r));
+if type(y_part_loc(r))=known then negate(value(y_part_loc(r)))
+else negate_dep_list(dep_list(y_part_loc(r)));
+install(xy_part_loc(q),y_part_loc(r));
+goto done;
+end
+
+@ Procedure |set_up_known_trans| is like |set_up_trans|, but it
+insists that the transformation be entirely known.
+
+@<Declare binary action...@>=
+procedure set_up_known_trans(@!c:quarterword);
+begin set_up_trans(c);
+if cur_type<>known then
+ begin exp_err("Transform components aren't all known");
+@.Transform components...@>
+ help3("I'm unable to apply a partially specified transformation")@/
+ ("except to a fully known pair or transform.")@/
+ ("Proceed, and I'll omit the transformation.");
+ put_get_flush_error(0);
+ txx:=unity; txy:=0; tyx:=0; tyy:=unity; tx:=0; ty:=0;
+ end;
+end;
+
+@ Here's a procedure that applies the transform |txx..ty| to a pair of
+coordinates in locations |p| and~|q|.
+
+@<Declare binary action...@>=
+procedure trans(@!p,@!q:pointer);
+var @!v:scaled; {the new |x| value}
+begin v:=take_scaled(mem[p].sc,txx)+take_scaled(mem[q].sc,txy)+tx;
+mem[q].sc:=take_scaled(mem[p].sc,tyx)+take_scaled(mem[q].sc,tyy)+ty;
+mem[p].sc:=v;
+end;
+
+@ The simplest transformation procedure applies a transform to all
+coordinates of a path. The |path_trans(c)(p)| macro applies
+a transformation defined by |cur_exp| and the transform operator |c|
+to the path~|p|.
+
+@d path_trans(#)==begin set_up_known_trans(#); path_trans_end
+@d path_trans_end(#)==unstash_cur_exp(#); do_path_trans(cur_exp); end
+
+@<Declare binary action...@>=
+procedure do_path_trans(@!p:pointer);
+label exit;
+var @!q:pointer; {list traverser}
+begin q:=p;
+repeat
+if left_type(q)<>endpoint then trans(q+3,q+4); {that's |left_x| and |left_y|}
+trans(q+1,q+2); {that's |x_coord| and |y_coord|}
+if right_type(q)<>endpoint then trans(q+5,q+6); {that's |right_x| and |right_y|}
+@^data structure assumptions@>
+q:=link(q);
+until q=p;
+exit:end;
+
+@ Transforming a pen is very similar, except that there are no |left_type|
+and |right_type| fields.
+
+@d pen_trans(#)==begin set_up_known_trans(#); pen_trans_end
+@d pen_trans_end(#)==unstash_cur_exp(#); do_pen_trans(cur_exp); end
+
+@<Declare binary action...@>=
+procedure do_pen_trans(@!p:pointer);
+label exit;
+var @!q:pointer; {list traverser}
+begin if pen_is_elliptical(p) then
+ begin trans(p+3,p+4); {that's |left_x| and |left_y|}
+ trans(p+5,p+6); {that's |right_x| and |right_y|}
+ end;
+q:=p;
+repeat
+trans(q+1,q+2); {that's |x_coord| and |y_coord|}
+@^data structure assumptions@>
+q:=link(q);
+until q=p;
+exit:end;
+
+@ The next transformation procedure applies to edge structures. It will do
+any transformation, but the results may be substandard if the picture contains
+text that uses downloaded bitmap fonts. The binary action procedure is
+|do_edges_trans|, but we also need a function that just scales a picture.
+That routine is |scale_edges|. Both it and the underlying routine |edges_trans|
+should be thought of as procedures that update an edge structure |h|, except
+that they have to return a (possibly new) structure because of the need to call
+|private_edges|.
+
+@<Declare binary action...@>=
+function edges_trans(@!h:pointer):pointer;
+label done1;
+var @!q:pointer; {the object being transformed}
+@!r,@!s:pointer; {for list manipulation}
+@!sx,@!sy:scaled; {saved transformation parameters}
+@!sqdet:scaled; {square root of determinant for |dash_scale|}
+@!sgndet:integer; {sign of the determinant}
+@!v:scaled; {a temporary value}
+begin h:=private_edges(h);@/
+sqdet:=sqrt_det(txx,txy,tyx,tyy);
+sgndet:=ab_vs_cd(txx,tyy,txy,tyx);
+if dash_list(h)<>null_dash then
+ @<Try to transform the dash list of |h|@>;
+@<Make the bounding box of |h| unknown if it can't be updated properly
+ without scanning the whole structure@>;
+q:=link(dummy_loc(h));
+while q<>null do
+ begin @<Transform graphical object |q|@>;@/
+ q:=link(q);
+ end;
+edges_trans:=h;
+end;
+@#
+procedure do_edges_trans(@!p:pointer;@!c:quarterword);
+begin set_up_known_trans(c);
+value(p):=edges_trans(value(p));
+unstash_cur_exp(p);
+end;
+@#
+procedure scale_edges;
+begin txx:=se_sf; tyy:=se_sf;
+txy:=0; tyx:=0; tx:=0; ty:=0;
+se_pic:=edges_trans(se_pic);
+end;
+
+@ @<Try to transform the dash list of |h|@>=
+if (txy<>0)or(tyx<>0)or(ty<>0)or(abs(txx)<>abs(tyy)) then
+ flush_dash_list(h)
+else begin if txx<0 then @<Reverse the dash list of |h|@>;
+ @<Scale the dash list by |txx| and shift it by |tx|@>;
+ dash_y(h):=take_scaled(dash_y(h),abs(tyy));
+ end
+
+@ @<Reverse the dash list of |h|@>=
+begin r:=dash_list(h);
+dash_list(h):=null_dash;
+while r<>null_dash do
+ begin s:=r; r:=link(r);@/
+ v:=start_x(s); start_x(s):=stop_x(s); stop_x(s):=v;@/
+ link(s):=dash_list(h);
+ dash_list(h):=s;
+ end;
+end
+
+@ @<Scale the dash list by |txx| and shift it by |tx|@>=
+r:=dash_list(h);
+while r<>null_dash do
+ begin start_x(r):=take_scaled(start_x(r),txx)+tx;
+ stop_x(r):=take_scaled(stop_x(r),txx)+tx;@/
+ r:=link(r);
+ end
+
+@ @<Make the bounding box of |h| unknown if it can't be updated properly...@>=
+if (txx=0)and(tyy=0) then
+ @<Swap the $x$ and $y$ parameters in the bounding box of |h|@>
+else if (txy<>0)or(tyx<>0) then
+ begin init_bbox(h);
+ goto done1;
+ end;
+if minx_val(h)<=maxx_val(h) then
+ @<Scale the bounding box by |txx+txy| and |tyx+tyy|; then shift by
+ |(tx,ty)|@>;
+done1:
+
+@ @<Swap the $x$ and $y$ parameters in the bounding box of |h|@>=
+begin v:=minx_val(h); minx_val(h):=miny_val(h); miny_val(h):=v;@/
+v:=maxx_val(h); maxx_val(h):=maxy_val(h); maxy_val(h):=v;
+end
+
+@ The sum ``|txx+txy|'' is whichever of |txx| or |txy| is nonzero. The other
+sum is similar.
+
+@<Scale the bounding box by |txx+txy| and |tyx+tyy|; then shift...@>=
+begin minx_val(h):=take_scaled(minx_val(h),txx+txy)+tx;@/
+maxx_val(h):=take_scaled(maxx_val(h),txx+txy)+tx;@/
+miny_val(h):=take_scaled(miny_val(h),tyx+tyy)+ty;@/
+maxy_val(h):=take_scaled(maxy_val(h),tyx+tyy)+ty;@/
+if txx+txy<0 then
+ begin v:=minx_val(h); minx_val(h):=maxx_val(h); maxx_val(h):=v;
+ end;
+if tyx+tyy<0 then
+ begin v:=miny_val(h); miny_val(h):=maxy_val(h); maxy_val(h):=v;
+ end;
+end
+
+@ Now we ready for the main task of transforming the graphical objects in edge
+structure~|h|.
+
+@<Transform graphical object |q|@>=
+case type(q) of
+fill_code,stroked_code: begin
+ do_path_trans(path_p(q));
+ @<Transform |pen_p(q)|, making sure polygonal pens stay counter-clockwise@>;
+ end;
+start_clip_code,start_bounds_code: do_path_trans(path_p(q));
+text_code:begin r:=text_tx_loc(q);
+ @<Transform the compact transformation starting at |r|@>;
+ end;
+stop_clip_code,stop_bounds_code: do_nothing;
+end {there are no other cases}
+
+@ Note that the shift parameters |(tx,ty)| apply only to the path being stroked.
+The |dash_scale| has to be adjusted to scale the dash lengths in |dash_p(q)|
+since the \ps\ output procedures will try to compensate for the transformation
+we are applying to |pen_p(q)|. Since this compensation is based on the square
+root of the determinant, |sqdet| is the appropriate factor.
+
+@<Transform |pen_p(q)|, making sure...@>=
+if pen_p(q)<>null then
+ begin sx:=tx; sy:=ty;
+ tx:=0; ty:=0;@/
+ do_pen_trans(pen_p(q));
+ if ((type(q)=stroked_code)and(dash_p(q)<>null)) then
+ dash_scale(q):=take_scaled(dash_scale(q),sqdet);
+ if not pen_is_elliptical(pen_p(q)) then
+ if sgndet<0 then
+ pen_p(q):=make_pen(copy_path(pen_p(q)),true); {this unreverses the pen}
+ tx:=sx; ty:=sy;
+ end
+
+@ This uses the fact that transformations are stored in the order
+|(tx,ty,txx,txy,tyx,tyy)|.
+@^data structure assumptions@>
+
+@<Transform the compact transformation starting at |r|@>=
+trans(r,r+1);
+sx:=tx; sy:=ty;
+tx:=0; ty:=0;
+trans(r+2,r+4);
+trans(r+3,r+5);
+tx:=sx; ty:=sy
+
+@ The hard cases of transformation occur when big nodes are involved,
+and when some of their components are unknown.
+
+@<Declare binary action...@>=
+@t\4@>@<Declare subroutines needed by |big_trans|@>@;
+procedure big_trans(@!p:pointer;@!c:quarterword);
+label exit;
+var @!q,@!r,@!pp,@!qq:pointer; {list manipulation registers}
+@!s:small_number; {size of a big node}
+begin s:=big_node_size[type(p)]; q:=value(p); r:=q+s;
+repeat r:=r-2;
+if type(r)<>known then @<Transform an unknown big node and |return|@>;
+until r=q;
+@<Transform a known big node@>;
+exit:end; {node |p| will now be recycled by |do_binary|}
+
+@ @<Transform an unknown big node and |return|@>=
+begin set_up_known_trans(c); make_exp_copy(p); r:=value(cur_exp);
+if cur_type=transform_type then
+ begin bilin1(yy_part_loc(r),tyy,xy_part_loc(q),tyx,0);
+ bilin1(yx_part_loc(r),tyy,xx_part_loc(q),tyx,0);
+ bilin1(xy_part_loc(r),txx,yy_part_loc(q),txy,0);
+ bilin1(xx_part_loc(r),txx,yx_part_loc(q),txy,0);
+ end;
+bilin1(y_part_loc(r),tyy,x_part_loc(q),tyx,ty);
+bilin1(x_part_loc(r),txx,y_part_loc(q),txy,tx);
+return;
+end
+
+@ Let |p| point to a two-word value field inside a big node of |cur_exp|,
+and let |q| point to a another value field. The |bilin1| procedure
+replaces |p| by $p\cdot t+q\cdot u+\delta$.
+
+@<Declare subroutines needed by |big_trans|@>=
+procedure bilin1(@!p:pointer;@!t:scaled;@!q:pointer;@!u,@!delta:scaled);
+var @!r:pointer; {list traverser}
+begin if t<>unity then dep_mult(p,t,true);
+if u<>0 then
+ if type(q)=known then delta:=delta+take_scaled(value(q),u)
+ else begin @<Ensure that |type(p)=proto_dependent|@>;
+ dep_list(p):=p_plus_fq(dep_list(p),u,dep_list(q),proto_dependent,type(q));
+ end;
+if type(p)=known then value(p):=value(p)+delta
+else begin r:=dep_list(p);
+ while info(r)<>null do r:=link(r);
+ delta:=value(r)+delta;
+ if r<>dep_list(p) then value(r):=delta
+ else begin recycle_value(p); type(p):=known; value(p):=delta;
+ end;
+ end;
+if fix_needed then fix_dependencies;
+end;
+
+@ @<Ensure that |type(p)=proto_dependent|@>=
+if type(p)<>proto_dependent then
+ begin if type(p)=known then new_dep(p,const_dependency(value(p)))
+ else dep_list(p):=p_times_v(dep_list(p),unity,dependent,proto_dependent,true);
+ type(p):=proto_dependent;
+ end
+
+@ @<Transform a known big node@>=
+set_up_trans(c);
+if cur_type=known then @<Transform known by known@>
+else begin pp:=stash_cur_exp; qq:=value(pp);
+ make_exp_copy(p); r:=value(cur_exp);
+ if cur_type=transform_type then
+ begin bilin2(yy_part_loc(r),yy_part_loc(qq),
+ value(xy_part_loc(q)),yx_part_loc(qq),null);
+ bilin2(yx_part_loc(r),yy_part_loc(qq),
+ value(xx_part_loc(q)),yx_part_loc(qq),null);
+ bilin2(xy_part_loc(r),xx_part_loc(qq),
+ value(yy_part_loc(q)),xy_part_loc(qq),null);
+ bilin2(xx_part_loc(r),xx_part_loc(qq),
+ value(yx_part_loc(q)),xy_part_loc(qq),null);
+ end;
+ bilin2(y_part_loc(r),yy_part_loc(qq),
+ value(x_part_loc(q)),yx_part_loc(qq),y_part_loc(qq));
+ bilin2(x_part_loc(r),xx_part_loc(qq),
+ value(y_part_loc(q)),xy_part_loc(qq),x_part_loc(qq));
+ recycle_value(pp); free_node(pp,value_node_size);
+ end;
+
+@ Let |p| be a |proto_dependent| value whose dependency list ends
+at |dep_final|. The following procedure adds |v| times another
+numeric quantity to~|p|.
+
+@<Declare subroutines needed by |big_trans|@>=
+procedure add_mult_dep(@!p:pointer;@!v:scaled;@!r:pointer);
+begin if type(r)=known then
+ value(dep_final):=value(dep_final)+take_scaled(value(r),v)
+else begin dep_list(p):=
+ p_plus_fq(dep_list(p),v,dep_list(r),proto_dependent,type(r));
+ if fix_needed then fix_dependencies;
+ end;
+end;
+
+@ The |bilin2| procedure is something like |bilin1|, but with known
+and unknown quantities reversed. Parameter |p| points to a value field
+within the big node for |cur_exp|; and |type(p)=known|. Parameters
+|t| and~|u| point to value fields elsewhere; so does parameter~|q|,
+unless it is |null| (which stands for zero). Location~|p| will be
+replaced by $p\cdot t+v\cdot u+q$.
+
+@<Declare subroutines needed by |big_trans|@>=
+procedure bilin2(@!p,@!t:pointer;@!v:scaled;@!u,@!q:pointer);
+var @!vv:scaled; {temporary storage for |value(p)|}
+begin vv:=value(p); type(p):=proto_dependent;
+new_dep(p,const_dependency(0)); {this sets |dep_final|}
+if vv<>0 then add_mult_dep(p,vv,t); {|dep_final| doesn't change}
+if v<>0 then add_mult_dep(p,v,u);
+if q<>null then add_mult_dep(p,unity,q);
+if dep_list(p)=dep_final then
+ begin vv:=value(dep_final); recycle_value(p);
+ type(p):=known; value(p):=vv;
+ end;
+end;
+
+@ @<Transform known by known@>=
+begin make_exp_copy(p); r:=value(cur_exp);
+if cur_type=transform_type then
+ begin bilin3(yy_part_loc(r),tyy,value(xy_part_loc(q)),tyx,0);
+ bilin3(yx_part_loc(r),tyy,value(xx_part_loc(q)),tyx,0);
+ bilin3(xy_part_loc(r),txx,value(yy_part_loc(q)),txy,0);
+ bilin3(xx_part_loc(r),txx,value(yx_part_loc(q)),txy,0);
+ end;
+bilin3(y_part_loc(r),tyy,value(x_part_loc(q)),tyx,ty);
+bilin3(x_part_loc(r),txx,value(y_part_loc(q)),txy,tx);
+end
+
+@ Finally, in |bilin3| everything is |known|.
+
+@<Declare subroutines needed by |big_trans|@>=
+procedure bilin3(@!p:pointer;@!t,@!v,@!u,@!delta:scaled);
+begin if t<>unity then delta:=delta+take_scaled(value(p),t)
+else delta:=delta+value(p);
+if u<>0 then value(p):=delta+take_scaled(v,u)
+else value(p):=delta;
+end;
+
+@ @<Additional cases of binary operators@>=
+concatenate: if (cur_type=string_type)and(type(p)=string_type) then cat(p)
+ else bad_binary(p,concatenate);
+substring_of: if nice_pair(p,type(p))and(cur_type=string_type) then
+ chop_string(value(p))
+ else bad_binary(p,substring_of);
+subpath_of: begin if cur_type=pair_type then pair_to_path;
+ if nice_pair(p,type(p))and(cur_type=path_type) then
+ chop_path(value(p))
+ else bad_binary(p,subpath_of);
+ end;
+
+@ @<Declare binary action...@>=
+procedure cat(@!p:pointer);
+var @!a,@!b:str_number; {the strings being concatenated}
+@!k:pool_pointer; {index into |str_pool|}
+begin a:=value(p); b:=cur_exp; str_room(length(a)+length(b));
+for k:=str_start[a] to str_stop(a)-1 do append_char(so(str_pool[k]));
+for k:=str_start[b] to str_stop(b)-1 do append_char(so(str_pool[k]));
+cur_exp:=make_string; delete_str_ref(b);
+end;
+
+@ @<Declare binary action...@>=
+procedure chop_string(@!p:pointer);
+var @!a,@!b:integer; {start and stop points}
+@!l:integer; {length of the original string}
+@!k:integer; {runs from |a| to |b|}
+@!s:str_number; {the original string}
+@!reversed:boolean; {was |a>b|?}
+begin a:=round_unscaled(value(x_part_loc(p)));
+b:=round_unscaled(value(y_part_loc(p)));
+if a<=b then reversed:=false
+else begin reversed:=true; k:=a; a:=b; b:=k;
+ end;
+s:=cur_exp; l:=length(s);
+if a<0 then
+ begin a:=0;
+ if b<0 then b:=0;
+ end;
+if b>l then
+ begin b:=l;
+ if a>l then a:=l;
+ end;
+str_room(b-a);
+if reversed then
+ for k:=str_start[s]+b-1 downto str_start[s]+a do append_char(so(str_pool[k]))
+else for k:=str_start[s]+a to str_start[s]+b-1 do append_char(so(str_pool[k]));
+cur_exp:=make_string; delete_str_ref(s);
+end;
+
+@ @<Declare binary action...@>=
+procedure chop_path(@!p:pointer);
+var @!q:pointer; {a knot in the original path}
+@!pp,@!qq,@!rr,@!ss:pointer; {link variables for copies of path nodes}
+@!a,@!b,@!k,@!l:scaled; {indices for chopping}
+@!reversed:boolean; {was |a>b|?}
+begin l:=path_length; a:=value(x_part_loc(p)); b:=value(y_part_loc(p));
+if a<=b then reversed:=false
+else begin reversed:=true; k:=a; a:=b; b:=k;
+ end;
+@<Dispense with the cases |a<0| and/or |b>l|@>;
+q:=cur_exp;
+while a>=unity do
+ begin q:=link(q); a:=a-unity; b:=b-unity;
+ end;
+if b=a then @<Construct a path from |pp| to |qq| of length zero@>
+else @<Construct a path from |pp| to |qq| of length $\lceil b\rceil$@>;
+left_type(pp):=endpoint; right_type(qq):=endpoint; link(qq):=pp;
+toss_knot_list(cur_exp);
+if reversed then
+ begin cur_exp:=link(htap_ypoc(pp)); toss_knot_list(pp);
+ end
+else cur_exp:=pp;
+end;
+
+@ @<Dispense with the cases |a<0| and/or |b>l|@>=
+if a<0 then
+ if left_type(cur_exp)=endpoint then
+ begin a:=0; if b<0 then b:=0;
+ end
+ else repeat a:=a+l; b:=b+l;
+ until a>=0; {a cycle always has length |l>0|}
+if b>l then if left_type(cur_exp)=endpoint then
+ begin b:=l; if a>l then a:=l;
+ end
+ else while a>=l do
+ begin a:=a-l; b:=b-l;
+ end
+
+@ @<Construct a path from |pp| to |qq| of length $\lceil b\rceil$@>=
+begin pp:=copy_knot(q); qq:=pp;
+repeat q:=link(q); rr:=qq; qq:=copy_knot(q); link(rr):=qq; b:=b-unity;
+until b<=0;
+if a>0 then
+ begin ss:=pp; pp:=link(pp);
+ split_cubic(ss,a*@'10000); pp:=link(ss);
+ free_node(ss,knot_node_size);
+ if rr=ss then
+ begin b:=make_scaled(b,unity-a); rr:=pp;
+ end;
+ end;
+if b<0 then
+ begin split_cubic(rr,(b+unity)*@'10000);
+ free_node(qq,knot_node_size);
+ qq:=link(rr);
+ end;
+end
+
+@ @<Construct a path from |pp| to |qq| of length zero@>=
+begin if a>0 then
+ begin split_cubic(q,a*@'10000); q:=link(q);
+ end;
+pp:=copy_knot(q); qq:=pp;
+end
+
+@ @<Additional cases of binary operators@>=
+point_of,precontrol_of,postcontrol_of: begin if cur_type=pair_type then
+ pair_to_path;
+ if (cur_type=path_type)and(type(p)=known) then
+ find_point(value(p),c)
+ else bad_binary(p,c);
+ end;
+pen_offset_of: if (cur_type=pen_type)and nice_pair(p,type(p)) then
+ set_up_offset(value(p))
+ else bad_binary(p,pen_offset_of);
+direction_time_of: begin if cur_type=pair_type then pair_to_path;
+ if (cur_type=path_type)and nice_pair(p,type(p)) then
+ set_up_direction_time(value(p))
+ else bad_binary(p,direction_time_of);
+ end;
+
+@ @<Declare binary action...@>=
+procedure set_up_offset(@!p:pointer);
+begin find_offset(value(x_part_loc(p)),value(y_part_loc(p)),cur_exp);
+pair_value(cur_x,cur_y);
+end;
+@#
+procedure set_up_direction_time(@!p:pointer);
+begin flush_cur_exp(find_direction_time(value(x_part_loc(p)),
+ value(y_part_loc(p)),cur_exp));
+end;
+
+@ @<Declare binary action...@>=
+procedure find_point(@!v:scaled;@!c:quarterword);
+var @!p:pointer; {the path}
+@!n:scaled; {its length}
+begin p:=cur_exp;@/
+if left_type(p)=endpoint then n:=-unity@+else n:=0;
+repeat p:=link(p); n:=n+unity;
+until p=cur_exp;
+if n=0 then v:=0
+else if v<0 then
+ if left_type(p)=endpoint then v:=0
+ else v:=n-1-((-v-1) mod n)
+else if v>n then
+ if left_type(p)=endpoint then v:=n
+ else v:=v mod n;
+p:=cur_exp;
+while v>=unity do
+ begin p:=link(p); v:=v-unity;
+ end;
+if v<>0 then @<Insert a fractional node by splitting the cubic@>;
+@<Set the current expression to the desired path coordinates@>;
+end;
+
+@ @<Insert a fractional node...@>=
+begin split_cubic(p,v*@'10000); p:=link(p);
+end
+
+@ @<Set the current expression to the desired path coordinates...@>=
+case c of
+point_of: pair_value(x_coord(p),y_coord(p));
+precontrol_of: if left_type(p)=endpoint then pair_value(x_coord(p),y_coord(p))
+ else pair_value(left_x(p),left_y(p));
+postcontrol_of: if right_type(p)=endpoint then pair_value(x_coord(p),y_coord(p))
+ else pair_value(right_x(p),right_y(p));
+end {there are no other cases}
+
+@ @<Additional cases of binary operators@>=
+arc_time_of: begin if cur_type=pair_type then
+ pair_to_path;
+ if (cur_type=path_type)and(type(p)=known) then
+ flush_cur_exp(get_arc_time(cur_exp,value(p)))
+ else bad_binary(p,c);
+ end;
+
+@ @<Additional cases of bin...@>=
+intersect: begin if type(p)=pair_type then
+ begin q:=stash_cur_exp; unstash_cur_exp(p);
+ pair_to_path; p:=stash_cur_exp; unstash_cur_exp(q);
+ end;
+ if cur_type=pair_type then pair_to_path;
+ if (cur_type=path_type)and(type(p)=path_type) then
+ begin path_intersection(value(p),cur_exp);
+ pair_value(cur_t,cur_tt);
+ end
+ else bad_binary(p,intersect);
+ end;
+
+@ @<Additional cases of bin...@>=
+in_font:if (cur_type<>string_type)or(type(p)<>string_type)
+ then bad_binary(p,in_font)
+ else begin do_infont(p); return;
+ end;
+
+@ Function |new_text_node| owns the reference count for its second argument
+(the text string) but not its first (the font name).
+
+@<Declare binary action...@>=
+procedure do_infont(@!p:pointer);
+var @!q:pointer;
+begin q:=get_node(edge_header_size);
+init_edges(q);
+link(obj_tail(q)):=new_text_node(cur_exp,value(p));
+obj_tail(q):=link(obj_tail(q));
+free_node(p,value_node_size);@/
+flush_cur_exp(q);
+cur_type:=picture_type;
+end;
+
+@* \[40] Statements and commands.
+The chief executive of \MP\ is the |do_statement| routine, which
+contains the master switch that causes all the various pieces of \MP\
+to do their things, in the right order.
+
+In a sense, this is the grand climax of the program: It applies all the
+tools that we have worked so hard to construct. In another sense, this is
+the messiest part of the program: It necessarily refers to other pieces
+of code all over the place, so that a person can't fully understand what is
+going on without paging back and forth to be reminded of conventions that
+are defined elsewhere. We are now at the hub of the web.
+
+The structure of |do_statement| itself is quite simple. The first token
+of the statement is fetched using |get_x_next|. If it can be the first
+token of an expression, we look for an equation, an assignment, or a
+title. Otherwise we use a \&{case} construction to branch at high speed to
+the appropriate routine for various and sundry other types of commands,
+each of which has an ``action procedure'' that does the necessary work.
+
+The program uses the fact that
+$$\hbox{|min_primary_command=max_statement_command=type_name|}$$
+to interpret a statement that starts with, e.g., `\&{string}',
+as a type declaration rather than a boolean expression.
+
+@p @<Declare action procedures for use by |do_statement|@>@;
+procedure do_statement; {governs \MP's activities}
+begin cur_type:=vacuous; get_x_next;
+if cur_cmd>max_primary_command then @<Worry about bad statement@>
+else if cur_cmd>max_statement_command then
+ @<Do an equation, assignment, title, or
+ `$\langle\,$expression$\,\rangle\,$\&{endgroup}'@>
+else @<Do a statement that doesn't begin with an expression@>;
+if cur_cmd<semicolon then
+ @<Flush unparsable junk that was found after the statement@>;
+error_count:=0;
+end;
+
+@ The only command codes |>max_primary_command| that can be present
+at the beginning of a statement are |semicolon| and higher; these
+occur when the statement is null.
+
+@<Worry about bad statement@>=
+begin if cur_cmd<semicolon then
+ begin print_err("A statement can't begin with `");
+@.A statement can't begin with x@>
+ print_cmd_mod(cur_cmd,cur_mod); print_char("'");
+ help5("I was looking for the beginning of a new statement.")@/
+ ("If you just proceed without changing anything, I'll ignore")@/
+ ("everything up to the next `;'. Please insert a semicolon")@/
+ ("now in front of anything that you don't want me to delete.")@/
+ ("(See Chapter 27 of The METAFONTbook for an example.)");@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+ back_error; get_x_next;
+ end;
+end
+
+@ The help message printed here says that everything is flushed up to
+a semicolon, but actually the commands |end_group| and |stop| will
+also terminate a statement.
+
+@<Flush unparsable junk that was found after the statement@>=
+begin print_err("Extra tokens will be flushed");
+@.Extra tokens will be flushed@>
+help6("I've just read as much of that statement as I could fathom,")@/
+("so a semicolon should have been next. It's very puzzling...")@/
+("but I'll try to get myself back together, by ignoring")@/
+("everything up to the next `;'. Please insert a semicolon")@/
+("now in front of anything that you don't want me to delete.")@/
+("(See Chapter 27 of The METAFONTbook for an example.)");@/
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+back_error; scanner_status:=flushing;
+repeat get_t_next;
+@<Decrease the string reference count...@>;
+until end_of_statement; {|cur_cmd=semicolon|, |end_group|, or |stop|}
+scanner_status:=normal;
+end
+
+@ If |do_statement| ends with |cur_cmd=end_group|, we should have
+|cur_type=vacuous| unless the statement was simply an expression;
+in the latter case, |cur_type| and |cur_exp| should represent that
+expression.
+
+@<Do a statement that doesn't...@>=
+begin if internal[tracing_commands]>0 then show_cur_cmd_mod;
+case cur_cmd of
+type_name:do_type_declaration;
+macro_def:if cur_mod>var_def then make_op_def
+ else if cur_mod>end_def then scan_def;
+@t\4@>@<Cases of |do_statement| that invoke particular commands@>@;
+end; {there are no other cases}
+cur_type:=vacuous;
+end
+
+@ The most important statements begin with expressions.
+
+@<Do an equation, assignment, title, or...@>=
+begin var_flag:=assignment; scan_expression;
+if cur_cmd<end_group then
+ begin if cur_cmd=equals then do_equation
+ else if cur_cmd=assignment then do_assignment
+ else if cur_type=string_type then @<Do a title@>
+ else if cur_type<>vacuous then
+ begin exp_err("Isolated expression");
+@.Isolated expression@>
+ help3("I couldn't find an `=' or `:=' after the")@/
+ ("expression that is shown above this error message,")@/
+ ("so I guess I'll just ignore it and carry on.");
+ put_get_error;
+ end;
+ flush_cur_exp(0); cur_type:=vacuous;
+ end;
+end
+
+@ @<Do a title@>=
+begin if internal[tracing_titles]>0 then
+ begin print_nl(""); print(cur_exp); update_terminal;
+ end;
+end
+
+@ Equations and assignments are performed by the pair of mutually recursive
+@^recursion@>
+routines |do_equation| and |do_assignment|. These routines are called when
+|cur_cmd=equals| and when |cur_cmd=assignment|, respectively; the left-hand
+side is in |cur_type| and |cur_exp|, while the right-hand side is yet
+to be scanned. After the routines are finished, |cur_type| and |cur_exp|
+will be equal to the right-hand side (which will normally be equal
+to the left-hand side).
+
+@<Declare action procedures for use by |do_statement|@>=
+@t\4@>@<Declare the procedure called |try_eq|@>@;
+@t\4@>@<Declare the procedure called |make_eq|@>@;
+procedure@?do_assignment; forward;@t\2@>@/
+procedure do_equation;
+var @!lhs:pointer; {capsule for the left-hand side}
+@!p:pointer; {temporary register}
+begin lhs:=stash_cur_exp; get_x_next; var_flag:=assignment; scan_expression;
+if cur_cmd=equals then do_equation
+else if cur_cmd=assignment then do_assignment;
+if internal[tracing_commands]>two then @<Trace the current equation@>;
+if cur_type=unknown_path then if type(lhs)=pair_type then
+ begin p:=stash_cur_exp; unstash_cur_exp(lhs); lhs:=p;
+ end; {in this case |make_eq| will change the pair to a path}
+make_eq(lhs); {equate |lhs| to |(cur_type,cur_exp)|}
+end;
+
+@ And |do_assignment| is similar to |do_expression|:
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_assignment;
+var @!lhs:pointer; {token list for the left-hand side}
+@!p:pointer; {where the left-hand value is stored}
+@!q:pointer; {temporary capsule for the right-hand value}
+begin if cur_type<>token_list then
+ begin exp_err("Improper `:=' will be changed to `='");
+@.Improper `:='@>
+ help2("I didn't find a variable name at the left of the `:=',")@/
+ ("so I'm going to pretend that you said `=' instead.");@/
+ error; do_equation;
+ end
+else begin lhs:=cur_exp; cur_type:=vacuous;@/
+ get_x_next; var_flag:=assignment; scan_expression;
+ if cur_cmd=equals then do_equation
+ else if cur_cmd=assignment then do_assignment;
+ if internal[tracing_commands]>two then @<Trace the current assignment@>;
+ if info(lhs)>hash_end then
+ @<Assign the current expression to an internal variable@>
+ else @<Assign the current expression to the variable |lhs|@>;
+ flush_node_list(lhs);
+ end;
+end;
+
+@ @<Trace the current equation@>=
+begin begin_diagnostic; print_nl("{("); print_exp(lhs,0);
+print(")=("); print_exp(null,0); print(")}"); end_diagnostic(false);
+end
+
+@ @<Trace the current assignment@>=
+begin begin_diagnostic; print_nl("{");
+if info(lhs)>hash_end then print(int_name[info(lhs)-(hash_end)])
+else show_token_list(lhs,null,1000,0);
+print(":="); print_exp(null,0); print_char("}"); end_diagnostic(false);
+end
+
+@ @<Assign the current expression to an internal variable@>=
+if cur_type=known then internal[info(lhs)-(hash_end)]:=cur_exp
+else begin exp_err("Internal quantity `");
+@.Internal quantity...@>
+ print(int_name[info(lhs)-(hash_end)]);
+ print("' must receive a known value");
+ help2("I can't set an internal quantity to anything but a known")@/
+ ("numeric value, so I'll have to ignore this assignment.");
+ put_get_error;
+ end
+
+@ @<Assign the current expression to the variable |lhs|@>=
+begin p:=find_variable(lhs);
+if p<>null then
+ begin q:=stash_cur_exp; cur_type:=und_type(p); recycle_value(p);
+ type(p):=cur_type; value(p):=null; make_exp_copy(p);
+ p:=stash_cur_exp; unstash_cur_exp(q); make_eq(p);
+ end
+else begin obliterated(lhs); put_get_error;
+ end;
+end
+
+
+@ And now we get to the nitty-gritty. The |make_eq| procedure is given
+a pointer to a capsule that is to be equated to the current expression.
+
+@<Declare the procedure called |make_eq|@>=
+procedure make_eq(@!lhs:pointer);
+label restart,done, not_found;
+var @!t:small_number; {type of the left-hand side}
+@!v:integer; {value of the left-hand side}
+@!p,@!q:pointer; {pointers inside of big nodes}
+begin restart: t:=type(lhs);
+if t<=pair_type then v:=value(lhs);
+case t of
+@t\4@>@<For each type |t|, make an equation and |goto done| unless |cur_type|
+ is incompatible with~|t|@>@;
+end; {all cases have been listed}
+@<Announce that the equation cannot be performed@>;
+done:check_arith; recycle_value(lhs); free_node(lhs,value_node_size);
+end;
+
+@ @<Announce that the equation cannot be performed@>=
+disp_err(lhs,""); exp_err("Equation cannot be performed (");
+@.Equation cannot be performed@>
+if type(lhs)<=pair_type then print_type(type(lhs))@+else print("numeric");
+print_char("=");
+if cur_type<=pair_type then print_type(cur_type)@+else print("numeric");
+print_char(")");@/
+help2("I'm sorry, but I don't know how to make such things equal.")@/
+ ("(See the two expressions just above the error message.)");
+put_get_error
+
+@ @<For each type |t|, make an equation and |goto done| unless...@>=
+boolean_type,string_type,pen_type,path_type,picture_type:
+ if cur_type=t+unknown_tag then
+ begin nonlinear_eq(v,cur_exp,false); goto done;
+ end
+ else if cur_type=t then
+ @<Report redundant or inconsistent equation and |goto done|@>;
+unknown_types:if cur_type=t-unknown_tag then
+ begin nonlinear_eq(cur_exp,lhs,true); goto done;
+ end
+ else if cur_type=t then
+ begin ring_merge(lhs,cur_exp); goto done;
+ end
+ else if cur_type=pair_type then if t=unknown_path then
+ begin pair_to_path; goto restart;
+ end;
+transform_type,color_type,pair_type:if cur_type=t then
+ @<Do multiple equations and |goto done|@>;
+known,dependent,proto_dependent,independent:if cur_type>=known then
+ begin try_eq(lhs,null); goto done;
+ end;
+vacuous:do_nothing;
+
+@ @<Report redundant or inconsistent equation and |goto done|@>=
+begin if cur_type<=string_type then
+ begin if cur_type=string_type then
+ begin if str_vs_str(v,cur_exp)<>0 then goto not_found;
+ end
+ else if v<>cur_exp then goto not_found;
+ @<Exclaim about a redundant equation@>; goto done;
+ end;
+print_err("Redundant or inconsistent equation");
+@.Redundant or inconsistent equation@>
+help2("An equation between already-known quantities can't help.")@/
+ ("But don't worry; continue and I'll just ignore it.");
+put_get_error; goto done;
+not_found: print_err("Inconsistent equation");
+@.Inconsistent equation@>
+help2("The equation I just read contradicts what was said before.")@/
+ ("But don't worry; continue and I'll just ignore it.");
+put_get_error; goto done;
+end
+
+@ @<Do multiple equations and |goto done|@>=
+begin p:=v+big_node_size[t]; q:=value(cur_exp)+big_node_size[t];
+repeat p:=p-2; q:=q-2; try_eq(p,q);
+until p=v;
+goto done;
+end
+
+@ The first argument to |try_eq| is the location of a value node
+in a capsule that will soon be recycled. The second argument is
+either a location within a pair or transform node pointed to by
+|cur_exp|, or it is |null| (which means that |cur_exp| itself
+serves as the second argument). The idea is to leave |cur_exp| unchanged,
+but to equate the two operands.
+
+@<Declare the procedure called |try_eq|@>=
+procedure try_eq(@!l,@!r:pointer);
+label done,done1;
+var @!p:pointer; {dependency list for right operand minus left operand}
+@!t:known..independent; {the type of list |p|}
+@!q:pointer; {the constant term of |p| is here}
+@!pp:pointer; {dependency list for right operand}
+@!tt:dependent..independent; {the type of list |pp|}
+@!copied:boolean; {have we copied a list that ought to be recycled?}
+begin @<Remove the left operand from its container, negate it, and
+ put it into dependency list~|p| with constant term~|q|@>;
+@<Add the right operand to list |p|@>;
+if info(p)=null then @<Deal with redundant or inconsistent equation@>
+else begin linear_eq(p,t);
+ if r=null then if cur_type<>known then if type(cur_exp)=known then
+ begin pp:=cur_exp; cur_exp:=value(cur_exp); cur_type:=known;
+ free_node(pp,value_node_size);
+ end;
+ end;
+end;
+
+@ @<Remove the left operand from its container, negate it, and...@>=
+t:=type(l);
+if t=known then
+ begin t:=dependent; p:=const_dependency(-value(l)); q:=p;
+ end
+else if t=independent then
+ begin t:=dependent; p:=single_dependency(l); negate(value(p));
+ q:=dep_final;
+ end
+else begin p:=dep_list(l); q:=p;
+ loop@+ begin negate(value(q));
+ if info(q)=null then goto done;
+ q:=link(q);
+ end;
+ done: link(prev_dep(l)):=link(q); prev_dep(link(q)):=prev_dep(l);
+ type(l):=known;
+ end
+
+@ @<Deal with redundant or inconsistent equation@>=
+begin if abs(value(p))>64 then {off by .001 or more}
+ begin print_err("Inconsistent equation");@/
+@.Inconsistent equation@>
+ print(" (off by "); print_scaled(value(p)); print_char(")");
+ help2("The equation I just read contradicts what was said before.")@/
+ ("But don't worry; continue and I'll just ignore it.");
+ put_get_error;
+ end
+else if r=null then @<Exclaim about a redundant equation@>;
+free_node(p,dep_node_size);
+end
+
+@ @<Add the right operand to list |p|@>=
+if r=null then
+ if cur_type=known then
+ begin value(q):=value(q)+cur_exp; goto done1;
+ end
+ else begin tt:=cur_type;
+ if tt=independent then pp:=single_dependency(cur_exp)
+ else pp:=dep_list(cur_exp);
+ end
+else if type(r)=known then
+ begin value(q):=value(q)+value(r); goto done1;
+ end
+ else begin tt:=type(r);
+ if tt=independent then pp:=single_dependency(r)
+ else pp:=dep_list(r);
+ end;
+if tt<>independent then copied:=false
+else begin copied:=true; tt:=dependent;
+ end;
+@<Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t|@>;
+if copied then flush_node_list(pp);
+done1:
+
+@ @<Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t|@>=
+watch_coefs:=false;
+if t=tt then p:=p_plus_q(p,pp,t)
+else if t=proto_dependent then
+ p:=p_plus_fq(p,unity,pp,proto_dependent,dependent)
+else begin q:=p;
+ while info(q)<>null do
+ begin value(q):=round_fraction(value(q)); q:=link(q);
+ end;
+ t:=proto_dependent; p:=p_plus_q(p,pp,t);
+ end;
+watch_coefs:=true;
+
+@ Our next goal is to process type declarations. For this purpose it's
+convenient to have a procedure that scans a $\langle\,$declared
+variable$\,\rangle$ and returns the corresponding token list. After the
+following procedure has acted, the token after the declared variable
+will have been scanned, so it will appear in |cur_cmd|, |cur_mod|,
+and~|cur_sym|.
+
+@<Declare the function called |scan_declared_variable|@>=
+function scan_declared_variable:pointer;
+label done;
+var @!x:pointer; {hash address of the variable's root}
+@!h,@!t:pointer; {head and tail of the token list to be returned}
+@!l:pointer; {hash address of left bracket}
+begin get_symbol; x:=cur_sym;
+if cur_cmd<>tag_token then clear_symbol(x,false);
+h:=get_avail; info(h):=x; t:=h;@/
+loop@+ begin get_x_next;
+ if cur_sym=0 then goto done;
+ if cur_cmd<>tag_token then if cur_cmd<>internal_quantity then
+ if cur_cmd=left_bracket then @<Descend past a collective subscript@>
+ else goto done;
+ link(t):=get_avail; t:=link(t); info(t):=cur_sym;
+ end;
+done: if eq_type(x)<>tag_token then clear_symbol(x,false);
+if equiv(x)=null then new_root(x);
+scan_declared_variable:=h;
+end;
+
+@ If the subscript isn't collective, we don't accept it as part of the
+declared variable.
+
+@<Descend past a collective subscript@>=
+begin l:=cur_sym; get_x_next;
+if cur_cmd<>right_bracket then
+ begin back_input; cur_sym:=l; cur_cmd:=left_bracket; goto done;
+ end
+else cur_sym:=collective_subscript;
+end
+
+@ Type declarations are introduced by the following primitive operations.
+
+@<Put each...@>=
+primitive("numeric",type_name,numeric_type);@/
+@!@:numeric_}{\&{numeric} primitive@>
+primitive("string",type_name,string_type);@/
+@!@:string_}{\&{string} primitive@>
+primitive("boolean",type_name,boolean_type);@/
+@!@:boolean_}{\&{boolean} primitive@>
+primitive("path",type_name,path_type);@/
+@!@:path_}{\&{path} primitive@>
+primitive("pen",type_name,pen_type);@/
+@!@:pen_}{\&{pen} primitive@>
+primitive("picture",type_name,picture_type);@/
+@!@:picture_}{\&{picture} primitive@>
+primitive("transform",type_name,transform_type);@/
+@!@:transform_}{\&{transform} primitive@>
+primitive("color",type_name,color_type);@/
+@!@:color_}{\&{color} primitive@>
+primitive("pair",type_name,pair_type);@/
+@!@:pair_}{\&{pair} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+type_name: print_type(m);
+
+@ Now we are ready to handle type declarations, assuming that a
+|type_name| has just been scanned.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_type_declaration;
+var @!t:small_number; {the type being declared}
+@!p:pointer; {token list for a declared variable}
+@!q:pointer; {value node for the variable}
+begin if cur_mod>=transform_type then t:=cur_mod@+else t:=cur_mod+unknown_tag;
+repeat p:=scan_declared_variable;
+flush_variable(equiv(info(p)),link(p),false);@/
+q:=find_variable(p);
+if q<>null then
+ begin type(q):=t; value(q):=null;
+ end
+else begin print_err("Declared variable conflicts with previous vardef");
+@.Declared variable conflicts...@>
+ help2("You can't use, e.g., `numeric foo[]' after `vardef foo'.")@/
+ ("Proceed, and I'll ignore the illegal redeclaration.");
+ put_get_error;
+ end;
+flush_list(p);
+if cur_cmd<comma then @<Flush spurious symbols after the declared variable@>;
+until end_of_statement;
+end;
+
+@ @<Flush spurious symbols after the declared variable@>=
+begin print_err("Illegal suffix of declared variable will be flushed");
+@.Illegal suffix...flushed@>
+help5("Variables in declarations must consist entirely of")@/
+ ("names and collective subscripts, e.g., `x[]a'.")@/
+ ("Are you trying to use a reserved word in a variable name?")@/
+ ("I'm going to discard the junk I found here,")@/
+ ("up to the next comma or the end of the declaration.");
+if cur_cmd=numeric_token then
+ help_line[2]:="Explicit subscripts like `x15a' aren't permitted.";
+put_get_error; scanner_status:=flushing;
+repeat get_t_next;
+@<Decrease the string reference count...@>;
+until cur_cmd>=comma; {either |end_of_statement| or |cur_cmd=comma|}
+scanner_status:=normal;
+end
+
+@ \MP's |main_control| procedure just calls |do_statement| repeatedly
+until coming to the end of the user's program.
+Each execution of |do_statement| concludes with
+|cur_cmd=semicolon|, |end_group|, or |stop|.
+
+@p procedure main_control;
+begin repeat do_statement;
+if cur_cmd=end_group then
+ begin print_err("Extra `endgroup'");
+@.Extra `endgroup'@>
+ help2("I'm not currently working on a `begingroup',")@/
+ ("so I had better not try to end anything.");
+ flush_error(0);
+ end;
+until cur_cmd=stop;
+end;
+
+@ @<Put each...@>=
+primitive("end",stop,0);@/
+@!@:end_}{\&{end} primitive@>
+primitive("dump",stop,1);@/
+@!@:dump_}{\&{dump} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+stop:if m=0 then print("end")@+else print("dump");
+
+@* \[41] Commands.
+Let's turn now to statements that are classified as ``commands'' because
+of their imperative nature. We'll begin with simple ones, so that it
+will be clear how to hook command processing into the |do_statement| routine;
+then we'll tackle the tougher commands.
+
+Here's one of the simplest:
+
+@<Cases of |do_statement|...@>=
+random_seed: do_random_seed;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_random_seed;
+begin get_x_next;
+if cur_cmd<>assignment then
+ begin missing_err(":=");
+@.Missing `:='@>
+ help1("Always say `randomseed:=<numeric expression>'.");
+ back_error;
+ end;
+get_x_next; scan_expression;
+if cur_type<>known then
+ begin exp_err("Unknown value will be ignored");
+@.Unknown value...ignored@>
+ help2("Your expression was too random for me to handle,")@/
+ ("so I won't change the random seed just now.");@/
+ put_get_flush_error(0);
+ end
+else @<Initialize the random seed to |cur_exp|@>;
+end;
+
+@ @<Initialize the random seed to |cur_exp|@>=
+begin init_randoms(cur_exp);
+if selector>=log_only then
+ begin old_setting:=selector; selector:=log_only;
+ print_nl("{randomseed:="); print_scaled(cur_exp); print_char("}");
+ print_nl(""); selector:=old_setting;
+ end;
+end
+
+@ And here's another simple one (somewhat different in flavor):
+
+@<Cases of |do_statement|...@>=
+mode_command: begin print_ln; interaction:=cur_mod;
+ @<Initialize the print |selector| based on |interaction|@>;
+ if log_opened then selector:=selector+2;
+ get_x_next;
+ end;
+
+@ @<Put each...@>=
+primitive("batchmode",mode_command,batch_mode);
+@!@:batch_mode_}{\&{batchmode} primitive@>
+primitive("nonstopmode",mode_command,nonstop_mode);
+@!@:nonstop_mode_}{\&{nonstopmode} primitive@>
+primitive("scrollmode",mode_command,scroll_mode);
+@!@:scroll_mode_}{\&{scrollmode} primitive@>
+primitive("errorstopmode",mode_command,error_stop_mode);
+@!@:error_stop_mode_}{\&{errorstopmode} primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+mode_command: case m of
+ batch_mode: print("batchmode");
+ nonstop_mode: print("nonstopmode");
+ scroll_mode: print("scrollmode");
+ othercases print("errorstopmode")
+ endcases;
+
+@ The `\&{inner}' and `\&{outer}' commands are only slightly harder.
+
+@<Cases of |do_statement|...@>=
+protection_command: do_protection;
+
+@ @<Put each...@>=
+primitive("inner",protection_command,0);@/
+@!@:inner_}{\&{inner} primitive@>
+primitive("outer",protection_command,1);@/
+@!@:outer_}{\&{outer} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+protection_command: if m=0 then print("inner")@+else print("outer");
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_protection;
+var @!m:0..1; {0 to unprotect, 1 to protect}
+@!t:halfword; {the |eq_type| before we change it}
+begin m:=cur_mod;
+repeat get_symbol; t:=eq_type(cur_sym);
+ if m=0 then
+ begin if t>=outer_tag then eq_type(cur_sym):=t-outer_tag;
+ end
+ else if t<outer_tag then eq_type(cur_sym):=t+outer_tag;
+ get_x_next;
+until cur_cmd<>comma;
+end;
+
+@ \MP\ never defines the tokens `\.(' and `\.)' to be primitives, but
+plain \MP\ begins with the declaration `\&{delimiters} \.{()}'. Such a
+declaration assigns the command code |left_delimiter| to `\.{(}' and
+|right_delimiter| to `\.{)}'; the |equiv| of each delimiter is the
+hash address of its mate.
+
+@<Cases of |do_statement|...@>=
+delimiters: def_delims;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure def_delims;
+var l_delim,r_delim:pointer; {the new delimiter pair}
+begin get_clear_symbol; l_delim:=cur_sym;@/
+get_clear_symbol; r_delim:=cur_sym;@/
+eq_type(l_delim):=left_delimiter; equiv(l_delim):=r_delim;@/
+eq_type(r_delim):=right_delimiter; equiv(r_delim):=l_delim;@/
+get_x_next;
+end;
+
+@ Here is a procedure that is called when \MP\ has reached a point
+where some right delimiter is mandatory.
+
+@<Declare the procedure called |check_delimiter|@>=
+procedure check_delimiter(@!l_delim,@!r_delim:pointer);
+label exit;
+begin if cur_cmd=right_delimiter then if cur_mod=l_delim then return;
+if cur_sym<>r_delim then
+ begin missing_err(text(r_delim));@/
+@.Missing `)'@>
+ help2("I found no right delimiter to match a left one. So I've")@/
+ ("put one in, behind the scenes; this may fix the problem.");
+ back_error;
+ end
+else begin print_err("The token `"); print(text(r_delim));
+@.The token...delimiter@>
+ print("' is no longer a right delimiter");
+ help3("Strange: This token has lost its former meaning!")@/
+ ("I'll read it as a right delimiter this time;")@/
+ ("but watch out, I'll probably miss it later.");
+ error;
+ end;
+exit:end;
+
+@ The next four commands save or change the values associated with tokens.
+
+@<Cases of |do_statement|...@>=
+save_command: repeat get_symbol; save_variable(cur_sym); get_x_next;
+ until cur_cmd<>comma;
+interim_command: do_interim;
+let_command: do_let;
+new_internal: do_new_internal;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure@?do_statement; forward;@t\2@>@/
+procedure do_interim;
+begin get_x_next;
+if cur_cmd<>internal_quantity then
+ begin print_err("The token `");
+@.The token...quantity@>
+ if cur_sym=0 then print("(%CAPSULE)")
+ else print(text(cur_sym));
+ print("' isn't an internal quantity");
+ help1("Something like `tracingonline' should follow `interim'.");
+ back_error;
+ end
+else begin save_internal(cur_mod); back_input;
+ end;
+do_statement;
+end;
+
+@ The following procedure is careful not to undefine the left-hand symbol
+too soon, lest commands like `{\tt let x=x}' have a surprising effect.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_let;
+var @!l:pointer; {hash location of the left-hand symbol}
+begin get_symbol; l:=cur_sym; get_x_next;
+if cur_cmd<>equals then if cur_cmd<>assignment then
+ begin missing_err("=");
+@.Missing `='@>
+ help3("You should have said `let symbol = something'.")@/
+ ("But don't worry; I'll pretend that an equals sign")@/
+ ("was present. The next token I read will be `something'.");
+ back_error;
+ end;
+get_symbol;
+case cur_cmd of
+defined_macro,secondary_primary_macro,tertiary_secondary_macro,
+ expression_tertiary_macro: add_mac_ref(cur_mod);
+othercases do_nothing
+endcases;@/
+clear_symbol(l,false); eq_type(l):=cur_cmd;
+if cur_cmd=tag_token then equiv(l):=null
+else equiv(l):=cur_mod;
+get_x_next;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_new_internal;
+begin repeat if int_ptr=max_internal then
+ overflow("number of internals",max_internal);
+@:MetaPost capacity exceeded number of int}{\quad number of internals@>
+get_clear_symbol; incr(int_ptr);
+eq_type(cur_sym):=internal_quantity; equiv(cur_sym):=int_ptr;
+int_name[int_ptr]:=text(cur_sym); internal[int_ptr]:=0;
+get_x_next;
+until cur_cmd<>comma;
+end;
+
+@ The various `\&{show}' commands are distinguished by modifier fields
+in the usual way.
+
+@d show_token_code=0 {show the meaning of a single token}
+@d show_stats_code=1 {show current memory and string usage}
+@d show_code=2 {show a list of expressions}
+@d show_var_code=3 {show a variable and its descendents}
+@d show_dependencies_code=4 {show dependent variables in terms of independents}
+
+@<Put each...@>=
+primitive("showtoken",show_command,show_token_code);@/
+@!@:show_token_}{\&{showtoken} primitive@>
+primitive("showstats",show_command,show_stats_code);@/
+@!@:show_stats_}{\&{showstats} primitive@>
+primitive("show",show_command,show_code);@/
+@!@:show_}{\&{show} primitive@>
+primitive("showvariable",show_command,show_var_code);@/
+@!@:show_var_}{\&{showvariable} primitive@>
+primitive("showdependencies",show_command,show_dependencies_code);@/
+@!@:show_dependencies_}{\&{showdependencies} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+show_command: case m of
+ show_token_code:print("showtoken");
+ show_stats_code:print("showstats");
+ show_code:print("show");
+ show_var_code:print("showvariable");
+ othercases print("showdependencies")
+ endcases;
+
+@ @<Cases of |do_statement|...@>=
+show_command:do_show_whatever;
+
+@ The value of |cur_mod| controls the |verbosity| in the |print_exp| routine:
+if it's |show_code|, complicated structures are abbreviated, otherwise
+they aren't.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_show;
+begin repeat get_x_next; scan_expression;
+print_nl(">> ");
+@.>>@>
+print_exp(null,2); flush_cur_exp(0);
+until cur_cmd<>comma;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure disp_token;
+begin print_nl("> ");
+@.>\relax@>
+if cur_sym=0 then @<Show a numeric or string or capsule token@>
+else begin print(text(cur_sym)); print_char("=");
+ if eq_type(cur_sym)>=outer_tag then print("(outer) ");
+ print_cmd_mod(cur_cmd,cur_mod);
+ if cur_cmd=defined_macro then
+ begin print_ln; show_macro(cur_mod,null,100000);
+ end; {this avoids recursion between |show_macro| and |print_cmd_mod|}
+@^recursion@>
+ end;
+end;
+
+@ @<Show a numeric or string or capsule token@>=
+begin if cur_cmd=numeric_token then print_scaled(cur_mod)
+else if cur_cmd=capsule_token then
+ begin g_pointer:=cur_mod; print_capsule;
+ end
+else begin print_char(""""); print(cur_mod); print_char("""");
+ delete_str_ref(cur_mod);
+ end;
+end
+
+@ The following cases of |print_cmd_mod| might arise in connection
+with |disp_token|, although they don't correspond to any
+primitive tokens.
+
+@<Cases of |print_cmd_...@>=
+left_delimiter,right_delimiter: begin if c=left_delimiter then print("lef")
+ else print("righ");
+ print("t delimiter that matches "); print(text(m));
+ end;
+tag_token:if m=null then print("tag")@+else print("variable");
+defined_macro: print("macro:");
+secondary_primary_macro,tertiary_secondary_macro,expression_tertiary_macro:
+ begin print_cmd_mod(macro_def,c); print("'d macro:");
+ print_ln; show_token_list(link(link(m)),null,1000,0);
+ end;
+repeat_loop:print("[repeat the loop]");
+internal_quantity:print(int_name[m]);
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_show_token;
+begin repeat get_t_next; disp_token;
+get_x_next;
+until cur_cmd<>comma;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_show_stats;
+begin print_nl("Memory usage ");
+@.Memory usage...@>
+@!stat print_int(var_used); print_char("&"); print_int(dyn_used);
+if false then@+tats@t@>@;@/
+print("unknown");
+print(" ("); print_int(hi_mem_min-lo_mem_max-1);
+print(" still untouched)"); print_ln;
+print_nl("String usage ");
+stat print_int(strs_in_use-init_str_use);
+print_char("&"); print_int(pool_in_use-init_pool_ptr);
+if false then@+tats@t@>@;@/
+print("unknown");
+print(" (");
+print_int(max_strings-1-strs_used_up); print_char("&");
+print_int(pool_size-pool_ptr); print(" now untouched)"); print_ln;
+get_x_next;
+end;
+
+@ Here's a recursive procedure that gives an abbreviated account
+of a variable, for use by |do_show_var|.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure disp_var(@!p:pointer);
+var @!q:pointer; {traverses attributes and subscripts}
+@!n:0..max_print_line; {amount of macro text to show}
+begin if type(p)=structured then @<Descend the structure@>
+else if type(p)>=unsuffixed_macro then @<Display a variable macro@>
+else if type(p)<>undefined then
+ begin print_nl(""); print_variable_name(p); print_char("=");
+ print_exp(p,0);
+ end;
+end;
+
+@ @<Descend the structure@>=
+begin q:=attr_head(p);
+repeat disp_var(q); q:=link(q);
+until q=end_attr;
+q:=subscr_head(p);
+while name_type(q)=subscr do
+ begin disp_var(q); q:=link(q);
+ end;
+end
+
+@ @<Display a variable macro@>=
+begin print_nl(""); print_variable_name(p);
+if type(p)>unsuffixed_macro then print("@@#"); {|suffixed_macro|}
+print("=macro:");
+if file_offset>=max_print_line-20 then n:=5
+else n:=max_print_line-file_offset-15;
+show_macro(value(p),null,n);
+end
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_show_var;
+label done;
+begin repeat get_t_next;
+if cur_sym>0 then if cur_sym<=hash_end then
+ if cur_cmd=tag_token then if cur_mod<>null then
+ begin disp_var(cur_mod); goto done;
+ end;
+disp_token;
+done:get_x_next;
+until cur_cmd<>comma;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_show_dependencies;
+var @!p:pointer; {link that runs through all dependencies}
+begin p:=link(dep_head);
+while p<>dep_head do
+ begin if interesting(p) then
+ begin print_nl(""); print_variable_name(p);
+ if type(p)=dependent then print_char("=")
+ else print(" = "); {extra spaces imply proto-dependency}
+ print_dependency(dep_list(p),type(p));
+ end;
+ p:=dep_list(p);
+ while info(p)<>null do p:=link(p);
+ p:=link(p);
+ end;
+get_x_next;
+end;
+
+@ Finally we are ready for the procedure that governs all of the
+show commands.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_show_whatever;
+begin if interaction=error_stop_mode then wake_up_terminal;
+case cur_mod of
+show_token_code:do_show_token;
+show_stats_code:do_show_stats;
+show_code:do_show;
+show_var_code:do_show_var;
+show_dependencies_code:do_show_dependencies;
+end; {there are no other cases}
+if internal[showstopping]>0 then
+ begin print_err("OK");
+@.OK@>
+ if interaction<error_stop_mode then
+ begin help0; decr(error_count);
+ end
+ else help1("This isn't an error message; I'm just showing something.");
+ if cur_cmd=semicolon then error@+else put_get_error;
+ end;
+end;
+
+@ The `\&{addto}' command needs the following additional primitives:
+
+@d double_path_code=0 {command modifier for `\&{doublepath}'}
+@d contour_code=1 {command modifier for `\&{contour}'}
+@d also_code=2 {command modifier for `\&{also}'}
+
+@<Put each...@>=
+primitive("doublepath",thing_to_add,double_path_code);@/
+@!@:double_path_}{\&{doublepath} primitive@>
+primitive("contour",thing_to_add,contour_code);@/
+@!@:contour_}{\&{contour} primitive@>
+primitive("also",thing_to_add,also_code);@/
+@!@:also_}{\&{also} primitive@>
+primitive("withpen",with_option,pen_type);@/
+@!@:with_pen_}{\&{withpen} primitive@>
+primitive("dashed",with_option,picture_type);@/
+@!@:dashed_}{\&{dashed} primitive@>
+primitive("withcolor",with_option,color_type);@/
+@!@:with_color_}{\&{withcolor} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+thing_to_add:if m=contour_code then print("contour")
+ else if m=double_path_code then print("doublepath")
+ else print("also");
+with_option:if m=pen_type then print("withpen")
+ else if m=color_type then print("withcolor")
+ else print("dashed");
+
+@ The |scan_with_list| procedure parses a $\langle$with list$\rangle$ and
+updates the list of graphical objects starting at |p|. Each $\langle$with
+clause$\rangle$ updates all graphical objects whose |type| is compatible.
+Other objects are ignored.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure scan_with_list(@!p:pointer);
+label done, done1, done2;
+var @!t:small_number; {|cur_mod| of the |with_option| (should match |cur_type|)}
+@!q:pointer; {for list manipulation}
+@!cp,@!pp,@!dp:pointer;
+ {objects being updated; |void| initially; |null| to suppress update}
+begin cp:=void; pp:=void; dp:=void;
+while cur_cmd=with_option do
+ begin t:=cur_mod; get_x_next; scan_expression;
+ if cur_type<>t then @<Complain about improper type@>
+ else if t=color_type then
+ begin if cp=void then @<Make |cp| a colored object in object list~|p|@>;
+ if cp<>null then
+ @<Transfer a color from the current expression to object~|cp|@>;
+ flush_cur_exp(0);
+ end
+ else if t=pen_type then
+ begin if pp=void then @<Make |pp| an object in list~|p| that needs
+ a pen@>;
+ if pp<>null then
+ begin if pen_p(pp)<>null then toss_knot_list(pen_p(pp));
+ pen_p(pp):=cur_exp; cur_type:=vacuous;
+ end;
+ end
+ else begin if dp=void then @<Make |dp| a stroked node in list~|p|@>;
+ if dp<>null then
+ begin if dash_p(dp)<>null then delete_edge_ref(dash_p(dp));
+ dash_p(dp):=make_dashes(cur_exp);
+ dash_scale(dp):=unity;
+ cur_type:=vacuous;
+ end;
+ end;
+ end;
+ @<Copy the information from objects |cp|, |pp|, and |dp| into the rest
+ of the list@>;
+end;
+
+@ @<Complain about improper type@>=
+begin exp_err("Improper type");
+@.Improper type@>
+help2("Next time say `withpen <known pen expression>';")@/
+ ("I'll ignore the bad `with' clause and look for another.");
+if t=picture_type then
+ help_line[1]:="Next time say `dashed <known picture expression>';"
+else if t=color_type then
+ help_line[1]:="Next time say `withcolor <known color expression>';";
+put_get_flush_error(0);
+end
+
+@ Forcing the color to be between |0| and |unity| here guarantees that no
+picture will ever contain a color outside the legal range for \ps\ graphics.
+
+@<Transfer a color from the current expression to object~|cp|@>=
+begin q:=value(cur_exp);
+red_val(cp):=value(red_part_loc(q));
+green_val(cp):=value(green_part_loc(q));
+blue_val(cp):=value(blue_part_loc(q));@/
+if red_val(cp)<0 then red_val(cp):=0;
+if green_val(cp)<0 then green_val(cp):=0;
+if blue_val(cp)<0 then blue_val(cp):=0;
+if red_val(cp)>unity then red_val(cp):=unity;
+if green_val(cp)>unity then green_val(cp):=unity;
+if blue_val(cp)>unity then blue_val(cp):=unity;
+end
+
+@ @<Make |cp| a colored object in object list~|p|@>=
+begin cp:=p;
+while cp<>null do
+ begin if has_color(cp) then goto done;
+ cp:=link(cp);
+ end;
+done:do_nothing;
+end
+
+@ @<Make |pp| an object in list~|p| that needs a pen@>=
+begin pp:=p;
+while pp<>null do
+ begin if has_pen(pp) then goto done1;
+ pp:=link(pp);
+ end;
+done1:do_nothing;
+end
+
+@ @<Make |dp| a stroked node in list~|p|@>=
+begin dp:=p;
+while dp<>null do
+ begin if type(dp)=stroked_code then goto done2;
+ dp:=link(dp);
+ end;
+done2:do_nothing;
+end
+
+@ @<Copy the information from objects |cp|, |pp|, and |dp| into...@>=
+if cp>void then @<Copy |cp|'s color into the colored objects linked to~|cp|@>;
+if pp>void then
+ @<Copy |pen_p(pp)| into stroked and filled nodes linked to |pp|@>;
+if dp>void then @<Make stroked nodes linked to |dp| refer to |dash_p(dp)|@>
+
+@ @<Copy |cp|'s color into the colored objects linked to~|cp|@>=
+begin q:=link(cp);
+while q<>null do
+ begin if has_color(q) then
+ begin red_val(q):=red_val(cp);
+ green_val(q):=green_val(cp);
+ blue_val(q):=blue_val(cp);@/
+ end;
+ q:=link(q);
+ end;
+end
+
+@ @<Copy |pen_p(pp)| into stroked and filled nodes linked to |pp|@>=
+begin q:=link(pp);
+while q<>null do
+ begin if has_pen(q) then
+ begin if pen_p(q)<>null then toss_knot_list(pen_p(q));
+ pen_p(q):=copy_pen(pen_p(pp));
+ end;
+ q:=link(q);
+ end;
+end
+
+@ @<Make stroked nodes linked to |dp| refer to |dash_p(dp)|@>=
+begin q:=link(dp);
+while q<>null do
+ begin if type(q)=stroked_code then
+ begin if dash_p(q)<>null then delete_edge_ref(dash_p(q));
+ dash_p(q):=dash_p(dp);
+ dash_scale(q):=unity;
+ if dash_p(q)<>null then add_edge_ref(dash_p(q));
+ end;
+ q:=link(q);
+ end;
+end
+
+@ One of the things we need to do when we've parsed an \&{addto} or
+similar command is find the header of a supposed \&{picture} variable, given
+a token list for that variable. Since the edge structure is about to be
+updated, we use |private_edges| to make sure that this is possible.
+
+@<Declare action procedures for use by |do_statement|@>=
+function find_edges_var(@!t:pointer):pointer;
+var @!p:pointer;
+@!cur_edges:pointer; {the return value}
+begin p:=find_variable(t); cur_edges:=null;
+if p=null then
+ begin obliterated(t); put_get_error;
+ end
+else if type(p)<>picture_type then
+ begin print_err("Variable "); show_token_list(t,null,1000,0);
+@.Variable x is the wrong type@>
+ print(" is the wrong type ("); print_type(type(p)); print_char(")");
+ help2("I was looking for a ""known"" picture variable.")@/
+ ("So I'll not change anything just now."); put_get_error;
+ end
+else begin value(p):=private_edges(value(p));
+ cur_edges:=value(p);
+ end;
+flush_node_list(t);
+find_edges_var:=cur_edges;
+end;
+
+@ @<Cases of |do_statement|...@>=
+add_to_command: do_add_to;
+bounds_command:do_bounds;
+
+@ @<Put each...@>=
+primitive("clip",bounds_command,start_clip_code);@/
+@!@:clip_}{\&{clip} primitive@>
+primitive("setbounds",bounds_command,start_bounds_code);@/
+@!@:set_bounds_}{\&{setbounds} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+bounds_command: if m=start_clip_code then print("clip")
+ else print("setbounds");
+
+@ The following function parses the beginning of an \&{addto} or \&{clip}
+command: it expects a variable name followed by a token with |cur_cmd=sep|
+and then an expression. The function returns the token list for the variable
+and stores the command modifier for the separator token in the global variable
+|last_add_type|. We must be careful because this variable might get overwritten
+any time we call |get_x_next|.
+
+@<Glob...@>=
+@!last_add_type:quarterword;
+ {command modifier that identifies the last \&{addto} command}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+function start_draw_cmd(@!sep:quarterword):pointer;
+var @!lhv:pointer; {variable to add to left}
+@!add_type:quarterword; {value to be returned in |last_add_type|}
+begin lhv:=null;@/
+get_x_next; var_flag:=sep; scan_primary;
+if cur_type<>token_list then
+ @<Abandon edges command because there's no variable@>
+else begin lhv:=cur_exp; add_type:=cur_mod;@/
+ cur_type:=vacuous; get_x_next; scan_expression;
+ end;
+last_add_type:=add_type;
+start_draw_cmd:=lhv;
+end;
+
+@ @<Abandon edges command because there's no variable@>=
+begin exp_err("Not a suitable variable");
+@.Not a suitable variable@>
+help4("At this point I needed to see the name of a picture variable.")@/
+ ("(Or perhaps you have indeed presented me with one; I might")@/
+ ("have missed it, if it wasn't followed by the proper token.)")@/
+ ("So I'll not change anything just now.");
+put_get_flush_error(0);
+end
+
+@ Here is an example of how to use |start_draw_cmd|.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_bounds;
+var @!lhv,@!lhe:pointer; {variable on left, the corresponding edge structure}
+@!p:pointer; {for list manipulation}
+@!m:integer; {initial value of |cur_mod|}
+begin m:=cur_mod;
+lhv:=start_draw_cmd(to_token);@/
+if lhv<>null then
+ begin lhe:=find_edges_var(lhv);
+ if lhe=null then flush_cur_exp(0)
+ else if cur_type<>path_type then
+ begin exp_err("Improper `clip'");
+@.Improper `addto'@>
+ help2("This expression should have specified a known path.")@/
+ ("So I'll not change anything just now."); put_get_flush_error(0);
+ end
+ else if left_type(cur_exp)=endpoint then @<Complain about a non-cycle@>
+ else @<Make |cur_exp| into a \&{setbounds} or clipping path and add
+ it to |lhe|@>;
+ end;
+end;
+
+@ @<Complain about a non-cycle@>=
+begin print_err("Not a cycle");
+@.Not a cycle@>
+help2("That contour should have ended with `..cycle' or `&cycle'.")@/
+ ("So I'll not change anything just now."); put_get_error;
+end
+
+@ @<Make |cur_exp| into a \&{setbounds} or clipping path and add...@>=
+begin p:=new_bounds_node(cur_exp,m);
+link(p):=link(dummy_loc(lhe));
+link(dummy_loc(lhe)):=p;@/
+if obj_tail(lhe)=dummy_loc(lhe) then obj_tail(lhe):=p;
+p:=get_node(gr_object_size[stop_type(m)]);
+type(p):=stop_type(m);
+link(obj_tail(lhe)):=p;
+obj_tail(lhe):=p;@/
+init_bbox(lhe);
+end
+
+@ The |do_add_to| procedure is a little like |do_clip| but there are a lot more
+cases to deal with.
+
+@<Declare action procedures for use by |do_statement|@>=
+procedure do_add_to;
+var @!lhv,@!lhe:pointer; {variable on left, the corresponding edge structure}
+@!p:pointer; {the graphical object or list for |scan_with_list| to update}
+@!e:pointer; {an edge structure to be merged}
+@!add_type:quarterword; {|also_code|, |contour_code|, or |double_path_code|}
+begin lhv:=start_draw_cmd(thing_to_add); add_type:=last_add_type;@/
+if lhv<>null then
+ begin if add_type=also_code then
+ @<Make sure the current expression is a suitable picture and set |e| and |p|
+ appropriately@>
+ else @<Create a graphical object |p| based on |add_type| and the current
+ expression@>;
+ scan_with_list(p);
+ @<Use |p|, |e|, and |add_type| to augment |lhv| as requested@>;
+ end;
+end;
+
+@ Setting |p:=null| causes the $\langle$with list$\rangle$ to be ignored;
+setting |e:=null| prevents anything from being added to |lhe|.
+
+@ @<Make sure the current expression is a suitable picture and set |e|...@>=
+begin p:=null; e:=null;
+if cur_type<>picture_type then
+ begin exp_err("Improper `addto'");
+@.Improper `addto'@>
+ help2("This expression should have specified a known picture.")@/
+ ("So I'll not change anything just now."); put_get_flush_error(0);
+ end
+else begin e:=private_edges(cur_exp); cur_type:=vacuous;
+ p:=link(dummy_loc(e));
+ end;
+end
+
+@ In this case |add_type<>also_code| so setting |p:=null| suppresses future
+attempts to add to the edge structure.
+
+@<Create a graphical object |p| based on |add_type| and the current...@>=
+begin e:=null; p:=null;
+if cur_type=pair_type then pair_to_path;
+if cur_type<>path_type then
+ begin exp_err("Improper `addto'");
+@.Improper `addto'@>
+ help2("This expression should have specified a known path.")@/
+ ("So I'll not change anything just now."); put_get_flush_error(0);
+ end
+else if add_type=contour_code then
+ if left_type(cur_exp)=endpoint then
+ @<Complain about a non-cycle@>
+ else begin p:=new_fill_node(cur_exp);
+ cur_type:=vacuous;
+ end
+ else begin p:=new_stroked_node(cur_exp);
+ cur_type:=vacuous;
+ end;
+end
+
+@ @<Use |p|, |e|, and |add_type| to augment |lhv| as requested@>=
+lhe:=find_edges_var(lhv);
+if lhe=null then
+ begin if (e=null)and(p<>null) then e:=toss_gr_object(p);
+ if e<>null then delete_edge_ref(e);
+ end
+else if add_type=also_code then
+ if e<>null then @<Merge |e| into |lhe| and delete |e|@>
+ else do_nothing
+else if p<>null then
+ begin link(obj_tail(lhe)):=p;
+ obj_tail(lhe):=p;
+ if add_type=double_path_code then
+ if pen_p(p)=null then pen_p(p):=get_pen_circle(0);
+ end
+
+@ @<Merge |e| into |lhe| and delete |e|@>=
+begin if link(dummy_loc(e))<>null then
+ begin link(obj_tail(lhe)):=link(dummy_loc(e));
+ obj_tail(lhe):=obj_tail(e);@/
+ obj_tail(e):=dummy_loc(e);
+ link(dummy_loc(e)):=null;
+ flush_dash_list(lhe);
+ end;
+toss_edges(e);
+end
+
+@ @<Cases of |do_statement|...@>=
+ship_out_command: do_ship_out;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+@t\4@>@<Declare the function called |tfm_check|@>@;
+@t\4@>@<Declare the \ps\ output procedures@>@;
+procedure do_ship_out;
+var @!c:integer; {the character code}
+begin get_x_next; scan_expression;
+if cur_type<>picture_type then
+ @<Complain that it's not a known picture@>
+else begin c:=round_unscaled(internal[char_code]) mod 256;
+ if c<0 then c:=c+256;
+ @<Store the width information for character code~|c|@>;@/
+ ship_out(cur_exp);
+ flush_cur_exp(0);
+ end;
+end;
+
+@ @<Complain that it's not a known picture@>=
+begin exp_err("Not a known picture");
+help1("I can only output known pictures.");
+put_get_flush_error(0);
+end
+
+@ The \&{everyjob} command simply assigns a nonzero value to the global variable
+|start_sym|.
+
+@<Cases of |do_statement|...@>=
+every_job_command: begin get_symbol; start_sym:=cur_sym; get_x_next;
+ end;
+
+@ @<Glob...@>=
+@!start_sym:halfword; {a symbolic token to insert at beginning of job}
+
+@ @<Set init...@>=
+start_sym:=0;
+
+@ Finally, we have only the ``message'' commands remaining.
+
+@d message_code=0
+@d err_message_code=1
+@d err_help_code=2
+
+@<Put each...@>=
+primitive("message",message_command,message_code);@/
+@!@:message_}{\&{message} primitive@>
+primitive("errmessage",message_command,err_message_code);@/
+@!@:err_message_}{\&{errmessage} primitive@>
+primitive("errhelp",message_command,err_help_code);@/
+@!@:err_help_}{\&{errhelp} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+message_command: if m<err_message_code then print("message")
+ else if m=err_message_code then print("errmessage")
+ else print("errhelp");
+
+@ @<Cases of |do_statement|...@>=
+message_command: do_message;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+@<Declare a procedure called |no_string_err|@>@;
+procedure do_message;
+var @!m:message_code..err_help_code; {the type of message}
+begin m:=cur_mod; get_x_next; scan_expression;
+if cur_type<>string_type then
+ no_string_err("A message should be a known string expression.")
+else case m of
+ message_code:begin print_nl(""); print(cur_exp);
+ end;
+ err_message_code:@<Print string |cur_exp| as an error message@>;
+ err_help_code:@<Save string |cur_exp| as the |err_help|@>;
+ end; {there are no other cases}
+flush_cur_exp(0);
+end;
+
+@ @<Declare a procedure called |no_string_err|@>=
+procedure no_string_err(s:str_number);
+begin exp_err("Not a string");
+@.Not a string@>
+help1(s);
+put_get_error;
+end;
+
+@ The global variable |err_help| is zero when the user has most recently
+given an empty help string, or if none has ever been given.
+
+@<Save string |cur_exp| as the |err_help|@>=
+begin if err_help<>0 then delete_str_ref(err_help);
+if length(cur_exp)=0 then err_help:=0
+else begin err_help:=cur_exp; add_str_ref(err_help);
+ end;
+end
+
+@ If \&{errmessage} occurs often in |scroll_mode|, without user-defined
+\&{errhelp}, we don't want to give a long help message each time. So we
+give a verbose explanation only once.
+
+@<Glob...@>=
+@!long_help_seen:boolean; {has the long \.{\\errmessage} help been used?}
+
+@ @<Set init...@>=long_help_seen:=false;
+
+@ @<Print string |cur_exp| as an error message@>=
+begin print_err(""); print(cur_exp);
+if err_help<>0 then use_err_help:=true
+else if long_help_seen then help1("(That was another `errmessage'.)")
+else begin if interaction<error_stop_mode then long_help_seen:=true;
+ help4("This error message was generated by an `errmessage'")@/
+ ("command, so I can't give any explicit help.")@/
+ ("Pretend that you're Miss Marple: Examine all clues,")@/
+@^Marple, Jane@>
+ ("and deduce the truth by inspired guesses.");
+ end;
+put_get_error; use_err_help:=false;
+end
+
+@ @<Cases of |do_statement|...@>=
+write_command: do_write;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_write;
+label continue;
+var @!t:str_number; {the line of text to be written}
+ @!n,@!n0:write_index; {for searching |wr_fname| and |wr_file| arrays}
+ @!old_setting:0..max_selector; {for saving |selector| during output}
+begin get_x_next;
+scan_expression;
+if cur_type<>string_type then
+ no_string_err("The text to be written should be a known string expression")
+else if cur_cmd<>to_token then
+ begin print_err("Missing `to' clause");
+ help1("A write command should end with `to <filename>'");
+ put_get_error;
+ end
+else begin t:=cur_exp; cur_type:=vacuous;
+ get_x_next;
+ scan_expression;
+ if cur_type<>string_type then
+ no_string_err("I can't write to that file name. It isn't a known string")
+ else @<Write |t| to the file named by |cur_exp|@>;
+ delete_str_ref(t);
+ end;
+flush_cur_exp(0);
+end;
+
+@ @<Write |t| to the file named by |cur_exp|@>=
+begin @<Find |n| where |wr_fname[n]=cur_exp| and call |open_write_file| if
+ |cur_exp| must be inserted@>;
+@<Make sure |eof_line| is initialized@>;
+if str_vs_str(t,eof_line)=0 then
+ @<Record the end of file on |wr_file[n]|@>
+else begin old_setting:=selector;
+ selector:=n;
+ print(t); print_ln;
+ selector := old_setting;
+ end;
+end
+
+@ @<Find |n| where |wr_fname[n]=cur_exp| and call |open_write_file| if...@>=
+n:=write_files;
+n0:=write_files;
+repeat
+continue:if n=0 then
+ @<Insert |cur_exp| at index |n0| and call |open_write_file|@>
+else begin decr(n);
+ if wr_fname[n]=0 then
+ begin n0:=n; goto continue;
+ end;
+ end;
+until str_vs_str(cur_exp,wr_fname[n])=0
+
+@ @<Insert |cur_exp| at index |n0| and call |open_write_file|@>=
+begin if n0=write_files then
+ if write_files<max_write_files then incr(write_files)
+ else overflow("write files",max_write_files);
+n:=n0;
+open_write_file(cur_exp,n);
+end
+
+@ @<Record the end of file on |wr_file[n]|@>=
+begin a_close(wr_file[n]);
+delete_str_ref(wr_fname[n]);
+wr_fname[n]:=0;
+if n=write_files-1 then write_files:=n;
+end
+
+
+@* \[42] Writing font metric data.
+\TeX\ gets its knowledge about fonts from font metric files, also called
+\.{TFM} files; the `\.T' in `\.{TFM}' stands for \TeX,
+but other programs know about them too. One of \MP's duties is to
+write \.{TFM} files so that the user's fonts can readily be
+applied to typesetting.
+@:TFM files}{\.{TFM} files@>
+@^font metric files@>
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of~4, we could
+also regard the file as a sequence of 32-bit words, but \MP\ uses the
+byte interpretation. The format of \.{TFM} files was designed by
+Lyle Ramshaw in 1980. The intent is to convey a lot of different kinds
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+@<Glob...@>=
+@!tfm_file:byte_file; {the font metric output goes here}
+@!metric_file_name: str_number; {full name of the font metric file}
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|lf|&length of the entire file, in words;\cr
+|lh|&length of the header data, in words;\cr
+|bc|&smallest character code in the font;\cr
+|ec|&largest character code in the font;\cr
+|nw|&number of words in the width table;\cr
+|nh|&number of words in the height table;\cr
+|nd|&number of words in the depth table;\cr
+|ni|&number of words in the italic correction table;\cr
+|nl|&number of words in the lig/kern table;\cr
+|nk|&number of words in the kern table;\cr
+|ne|&number of words in the extensible character table;\cr
+|np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+|ne<=256|, and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\tabskip\centering
+\halign to\displaywidth{\hfil\\{#}\tabskip=0pt&$\,:\,$\arr#\hfil
+ \tabskip\centering\cr
+header&|[0..lh-1]@t\\{stuff}@>|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but two of
+the |fix_word| values must lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+|header[0]| and |header[1]|, whose meaning is explained below. Additional
+header information of use to other software routines might also be
+included, and \MP\ will generate it if the \.{headerbyte} command occurs.
+For example, 16 more words of header information are in use at the Xerox
+Palo Alto Research Center; the first ten specify the character coding
+scheme used (e.g., `\.{XEROX TEXT}' or `\.{TEX MATHSY}'), the next five
+give the font family name (e.g., `\.{HELVETICA}' or `\.{CMSY}'), and the
+last gives the ``face byte.''
+
+\yskip\hang|header[0]| is a 32-bit check sum that \MP\ will copy into
+the \.{GF} output file. This helps ensure consistency between files,
+since \TeX\ records the check sums from the \.{TFM}'s it reads, and these
+should match the check sums on actual fonts that are used. The actual
+relation between this check sum and the rest of the \.{TFM} file is not
+important; the check sum is simply an identification number with the
+property that incompatible fonts almost always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of the
+font, in units of \TeX\ points. This number must be at least 1.0; it is
+fairly arbitrary, but usually the design size is 10.0 for a ``10 point''
+font, i.e., a font that was designed to look best at a 10-point size,
+whatever that really means. When a \TeX\ user asks for a font `\.{at}
+$\delta$ \.{pt}', the effect is to override the design size and replace it
+by $\delta$, and to multiply the $x$ and~$y$ coordinates of the points in
+the font image by a factor of $\delta$ divided by the design size. {\sl
+All other dimensions in the\/ \.{TFM} file are |fix_word|\kern-1pt\
+numbers in design-size units.} Thus, for example, the value of |param[6]|,
+which defines the \.{em} unit, is often the |fix_word| value $2^{20}=1.0$,
+since many fonts have a design size equal to one em. The other dimensions
+must be less than 16 design-size units in absolute value; thus,
+|header[1]| and |param[1]| are the only |fix_word| entries in the whole
+\.{TFM} file whose first byte might be something besides 0 or 255.
+
+@ Next comes the |char_info| array, which contains one |@!char_info_word|
+per character. Each word in this part of the file contains six fields
+packed into four bytes as follows.
+
+\yskip\hang first byte: |@!width_index| (8 bits)\par
+\hang second byte: |@!height_index| (4 bits) times 16, plus |@!depth_index|
+ (4~bits)\par
+\hang third byte: |@!italic_index| (6 bits) times 4, plus |@!tag|
+ (2~bits)\par
+\hang fourth byte: |@!remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is \\{width}|[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation $\\{width}[0]=\\{height}[0]=\\{depth}[0]=
+\\{italic}[0]=0$ should always hold, so that an index of zero implies a
+value of zero. The |width_index| should never be zero unless the
+character does not exist in the font, since a character is valid if and
+only if it lies between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at location |remainder| in the |lig_kern| array.\par
+\hang|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain. The
+|remainder| field gives the character code of the next larger character.\par
+\hang|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|@!exten[remainder]|.\par
+\yskip\noindent
+Characters with |tag=2| and |tag=3| are treated as characters with |tag=0|
+unless they are used in special circumstances in math formulas. For example,
+\TeX's \.{\\sum} operation looks for a |list_tag|, and the \.{\\left}
+operation looks for both |list_tag| and |ext_tag|.
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word in this array is a
+|@!lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+ step if the byte is 128 or more, otherwise the next step is obtained by
+ skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+ then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+ a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must satisfy
+the condition
+$$\hbox{|256*op_byte+remainder<nl|.}$$
+If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+command is performed.
+
+@d stop_flag=128+min_quarterword
+ {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128+min_quarterword {op code for a kern step}
+@d skip_byte(#)==lig_kern[#].b0
+@d next_char(#)==lig_kern[#].b1
+@d op_byte(#)==lig_kern[#].b2
+@d rem_byte(#)==lig_kern[#].b3
+
+@ Extensible characters are specified by an |@!extensible_recipe|, which
+consists of four bytes called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this
+order). These bytes are the character codes of individual pieces used to
+build up a large symbol. If |top|, |mid|, or |bot| are zero, they are not
+present in the built-up result. For example, an extensible vertical line is
+like an extensible bracket, except that the top and bottom pieces are missing.
+
+Let $T$, $M$, $B$, and $R$ denote the respective pieces, or an empty box
+if the piece isn't present. Then the extensible characters have the form
+$TR^kMR^kB$ from top to bottom, for some |k>=0|, unless $M$ is absent;
+in the latter case we can have $TR^kB$ for both even and odd values of~|k|.
+The width of the extensible character is the width of $R$; and the
+height-plus-depth is the sum of the individual height-plus-depths of the
+components used, since the pieces are butted together in a vertical list.
+
+@d ext_top(#)==exten[#].b0 {|top| piece in a recipe}
+@d ext_mid(#)==exten[#].b1 {|mid| piece in a recipe}
+@d ext_bot(#)==exten[#].b2 {|bot| piece in a recipe}
+@d ext_rep(#)==exten[#].b3 {|rep| piece in a recipe}
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it is the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character @'40 in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the size of one ex in the font; it is also
+the height of letters for which accents don't have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+\yskip\noindent
+If fewer than seven parameters are present, \TeX\ sets the missing parameters
+to zero.
+
+@d slant_code=1
+@d space_code=2
+@d space_stretch_code=3
+@d space_shrink_code=4
+@d x_height_code=5
+@d quad_code=6
+@d extra_space_code=7
+
+@ So that is what \.{TFM} files hold. One of \MP's duties is to output such
+information, and it does this all at once at the end of a job.
+In order to prepare for such frenetic activity, it squirrels away the
+necessary facts in various arrays as information becomes available.
+
+Character dimensions (\&{charwd}, \&{charht}, \&{chardp}, and \&{charic})
+are stored respectively in |tfm_width|, |tfm_height|, |tfm_depth|, and
+|tfm_ital_corr|. Other information about a character (e.g., about
+its ligatures or successors) is accessible via the |char_tag| and
+|char_remainder| arrays. Other information about the font as a whole
+is kept in additional arrays called |header_byte|, |lig_kern|,
+|kern|, |exten|, and |param|.
+
+@d undefined_label==lig_table_size {an undefined local label}
+
+@<Glob...@>=
+@!bc,@!ec:eight_bits; {smallest and largest character codes shipped out}
+@!tfm_width:array[eight_bits] of scaled; {\&{charwd} values}
+@!tfm_height:array[eight_bits] of scaled; {\&{charht} values}
+@!tfm_depth:array[eight_bits] of scaled; {\&{chardp} values}
+@!tfm_ital_corr:array[eight_bits] of scaled; {\&{charic} values}
+@!char_exists:array[eight_bits] of boolean; {has this code been shipped out?}
+@!char_tag:array[eight_bits] of no_tag..ext_tag; {|remainder| category}
+@!char_remainder:array[eight_bits] of 0..lig_table_size; {the |remainder| byte}
+@!header_byte:array[1..header_size] of -1..255;
+ {bytes of the \.{TFM} header, or $-1$ if unset}
+@!lig_kern:array[0..lig_table_size] of four_quarters; {the ligature/kern table}
+@!nl:0..32767-256; {the number of ligature/kern steps so far}
+@!kern:array[0..max_kerns] of scaled; {distinct kerning amounts}
+@!nk:0..max_kerns; {the number of distinct kerns so far}
+@!exten:array[eight_bits] of four_quarters; {extensible character recipes}
+@!ne:0..256; {the number of extensible characters so far}
+@!param:array[1..max_font_dimen] of scaled; {\&{fontinfo} parameters}
+@!np:0..max_font_dimen; {the largest \&{fontinfo} parameter specified so far}
+@!nw,@!nh,@!nd,@!ni:0..256; {sizes of \.{TFM} subtables}
+@!skip_table:array[eight_bits] of 0..lig_table_size; {local label status}
+@!lk_started:boolean; {has there been a lig/kern step in this command yet?}
+@!bchar:integer; {right boundary character}
+@!bch_label:0..lig_table_size; {left boundary starting location}
+@!ll,@!lll:0..lig_table_size; {registers used for lig/kern processing}
+@!label_loc:array[0..256] of -1..lig_table_size; {lig/kern starting addresses}
+@!label_char:array[1..256] of eight_bits; {characters for |label_loc|}
+@!label_ptr:0..256; {highest position occupied in |label_loc|}
+
+@ @<Set init...@>=
+for k:=0 to 255 do
+ begin tfm_width[k]:=0; tfm_height[k]:=0; tfm_depth[k]:=0; tfm_ital_corr[k]:=0;
+ char_exists[k]:=false; char_tag[k]:=no_tag; char_remainder[k]:=0;
+ skip_table[k]:=undefined_label;
+ end;
+for k:=1 to header_size do header_byte[k]:=-1;
+bc:=255; ec:=0; nl:=0; nk:=0; ne:=0; np:=0;@/
+internal[boundary_char]:=-unity;
+bch_label:=undefined_label;@/
+label_loc[0]:=-1; label_ptr:=0;
+
+@ @<Declare the function called |tfm_check|@>=
+function tfm_check(@!m:small_number):scaled;
+begin if abs(internal[m])>=fraction_half then
+ begin print_err("Enormous "); print(int_name[m]);
+@.Enormous charwd...@>
+@.Enormous chardp...@>
+@.Enormous charht...@>
+@.Enormous charic...@>
+@.Enormous designsize...@>
+ print(" has been reduced");
+ help1("Font metric dimensions must be less than 2048pt.");
+ put_get_error;
+ if internal[m]>0 then tfm_check:=fraction_half-1
+ else tfm_check:=1-fraction_half;
+ end
+else tfm_check:=internal[m];
+end;
+
+@ @<Store the width information for character code~|c|@>=
+if c<bc then bc:=c;
+if c>ec then ec:=c;
+char_exists[c]:=true;
+tfm_width[c]:=tfm_check(char_wd);
+tfm_height[c]:=tfm_check(char_ht);
+tfm_depth[c]:=tfm_check(char_dp);
+tfm_ital_corr[c]:=tfm_check(char_ic)
+
+@ Now let's consider \MP's special \.{TFM}-oriented commands.
+
+@<Cases of |do_statement|...@>=
+tfm_command: do_tfm_command;
+
+@ @d char_list_code=0
+@d lig_table_code=1
+@d extensible_code=2
+@d header_byte_code=3
+@d font_dimen_code=4
+
+@<Put each...@>=
+primitive("charlist",tfm_command,char_list_code);@/
+@!@:char_list_}{\&{charlist} primitive@>
+primitive("ligtable",tfm_command,lig_table_code);@/
+@!@:lig_table_}{\&{ligtable} primitive@>
+primitive("extensible",tfm_command,extensible_code);@/
+@!@:extensible_}{\&{extensible} primitive@>
+primitive("headerbyte",tfm_command,header_byte_code);@/
+@!@:header_byte_}{\&{headerbyte} primitive@>
+primitive("fontdimen",tfm_command,font_dimen_code);@/
+@!@:font_dimen_}{\&{fontdimen} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+tfm_command: case m of
+ char_list_code:print("charlist");
+ lig_table_code:print("ligtable");
+ extensible_code:print("extensible");
+ header_byte_code:print("headerbyte");
+ othercases print("fontdimen")
+ endcases;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+function get_code:eight_bits; {scans a character code value}
+label found;
+var @!c:integer; {the code value found}
+begin get_x_next; scan_expression;
+if cur_type=known then
+ begin c:=round_unscaled(cur_exp);
+ if c>=0 then if c<256 then goto found;
+ end
+else if cur_type=string_type then if length(cur_exp)=1 then
+ begin c:=so(str_pool[str_start[cur_exp]]); goto found;
+ end;
+exp_err("Invalid code has been replaced by 0");
+@.Invalid code...@>
+help2("I was looking for a number between 0 and 255, or for a")@/
+ ("string of length 1. Didn't find it; will use 0 instead.");
+put_get_flush_error(0); c:=0;
+found: get_code:=c;
+end;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure set_tag(@!c:halfword;@!t:small_number;@!r:halfword);
+begin if char_tag[c]=no_tag then
+ begin char_tag[c]:=t; char_remainder[c]:=r;
+ if t=lig_tag then
+ begin incr(label_ptr); label_loc[label_ptr]:=r; label_char[label_ptr]:=c;
+ end;
+ end
+else @<Complain about a character tag conflict@>;
+end;
+
+@ @<Complain about a character tag conflict@>=
+begin print_err("Character ");
+if (c>" ")and(c<127) then print(c)
+else if c=256 then print("||")
+else begin print("code "); print_int(c);
+ end;
+print(" is already ");
+@.Character c is already...@>
+case char_tag[c] of
+lig_tag: print("in a ligtable");
+list_tag: print("in a charlist");
+ext_tag: print("extensible");
+end; {there are no other cases}
+help2("It's not legal to label a character more than once.")@/
+ ("So I'll not change anything just now.");
+put_get_error; end
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_tfm_command;
+label continue,done;
+var @!c,@!cc:0..256; {character codes}
+@!k:0..max_kerns; {index into the |kern| array}
+@!j:integer; {index into |header_byte| or |param|}
+begin case cur_mod of
+char_list_code: begin c:=get_code;
+ {we will store a list of character successors}
+ while cur_cmd=colon do
+ begin cc:=get_code; set_tag(c,list_tag,cc); c:=cc;
+ end;
+ end;
+lig_table_code: @<Store a list of ligature/kern steps@>;
+extensible_code: @<Define an extensible recipe@>;
+header_byte_code, font_dimen_code: begin c:=cur_mod; get_x_next;
+ scan_expression;
+ if (cur_type<>known)or(cur_exp<half_unit) then
+ begin exp_err("Improper location");
+@.Improper location@>
+ help2("I was looking for a known, positive number.")@/
+ ("For safety's sake I'll ignore the present command.");
+ put_get_error;
+ end
+ else begin j:=round_unscaled(cur_exp);
+ if cur_cmd<>colon then
+ begin missing_err(":");
+@.Missing `:'@>
+ help1("A colon should follow a headerbyte or fontinfo location.");
+ back_error;
+ end;
+ if c=header_byte_code then @<Store a list of header bytes@>
+ else @<Store a list of font dimensions@>;
+ end;
+ end;
+end; {there are no other cases}
+end;
+
+@ @<Store a list of ligature/kern steps@>=
+begin lk_started:=false;
+continue: get_x_next;
+if(cur_cmd=skip_to)and lk_started then
+ @<Process a |skip_to| command and |goto done|@>;
+if cur_cmd=bchar_label then
+ begin c:=256; cur_cmd:=colon;@+end
+else begin back_input; c:=get_code;@+end;
+if(cur_cmd=colon)or(cur_cmd=double_colon)then
+ @<Record a label in a lig/kern subprogram and |goto continue|@>;
+if cur_cmd=lig_kern_token then @<Compile a ligature/kern command@>
+else begin print_err("Illegal ligtable step");
+@.Illegal ligtable step@>
+ help1("I was looking for `=:' or `kern' here.");
+ back_error; next_char(nl):=qi(0); op_byte(nl):=qi(0); rem_byte(nl):=qi(0);@/
+ skip_byte(nl):=stop_flag+1; {this specifies an unconditional stop}
+ end;
+if nl=lig_table_size then overflow("ligtable size",lig_table_size);
+@:MetaPost capacity exceeded ligtable size}{\quad ligtable size@>
+incr(nl);
+if cur_cmd=comma then goto continue;
+if skip_byte(nl-1)<stop_flag then skip_byte(nl-1):=stop_flag;
+done:end
+
+@ @<Put each...@>=
+primitive("=:",lig_kern_token,0);
+@!@:=:_}{\.{=:} primitive@>
+primitive("=:|",lig_kern_token,1);
+@!@:=:/_}{\.{=:\char'174} primitive@>
+primitive("=:|>",lig_kern_token,5);
+@!@:=:/>_}{\.{=:\char'174>} primitive@>
+primitive("|=:",lig_kern_token,2);
+@!@:=:/_}{\.{\char'174=:} primitive@>
+primitive("|=:>",lig_kern_token,6);
+@!@:=:/>_}{\.{\char'174=:>} primitive@>
+primitive("|=:|",lig_kern_token,3);
+@!@:=:/_}{\.{\char'174=:\char'174} primitive@>
+primitive("|=:|>",lig_kern_token,7);
+@!@:=:/>_}{\.{\char'174=:\char'174>} primitive@>
+primitive("|=:|>>",lig_kern_token,11);
+@!@:=:/>_}{\.{\char'174=:\char'174>>} primitive@>
+primitive("kern",lig_kern_token,128);
+@!@:kern_}{\&{kern} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+lig_kern_token: case m of
+0:print("=:");
+1:print("=:|");
+2:print("|=:");
+3:print("|=:|");
+5:print("=:|>");
+6:print("|=:>");
+7:print("|=:|>");
+11:print("|=:|>>");
+othercases print("kern")
+endcases;
+
+@ Local labels are implemented by maintaining the |skip_table| array,
+where |skip_table[c]| is either |undefined_label| or the address of the
+most recent lig/kern instruction that skips to local label~|c|. In the
+latter case, the |skip_byte| in that instruction will (temporarily)
+be zero if there were no prior skips to this label, or it will be the
+distance to the prior skip.
+
+We may need to cancel skips that span more than 127 lig/kern steps.
+
+@d cancel_skips(#)==ll:=#;
+ repeat lll:=qo(skip_byte(ll)); skip_byte(ll):=stop_flag; ll:=ll-lll;
+ until lll=0
+@d skip_error(#)==begin print_err("Too far to skip");
+@.Too far to skip@>
+ help1("At most 127 lig/kern steps can separate skipto1 from 1::.");
+ error; cancel_skips(#);
+ end
+
+@<Process a |skip_to| command and |goto done|@>=
+begin c:=get_code;
+if nl-skip_table[c]>128 then {|skip_table[c]<<nl<=undefined_label|}
+ begin skip_error(skip_table[c]); skip_table[c]:=undefined_label;
+ end;
+if skip_table[c]=undefined_label then skip_byte(nl-1):=qi(0)
+else skip_byte(nl-1):=qi(nl-skip_table[c]-1);
+skip_table[c]:=nl-1; goto done;
+end
+
+@ @<Record a label in a lig/kern subprogram and |goto continue|@>=
+begin if cur_cmd=colon then
+ if c=256 then bch_label:=nl
+ else set_tag(c,lig_tag,nl)
+else if skip_table[c]<undefined_label then
+ begin ll:=skip_table[c]; skip_table[c]:=undefined_label;
+ repeat lll:=qo(skip_byte(ll));
+ if nl-ll>128 then
+ begin skip_error(ll); goto continue;
+ end;
+ skip_byte(ll):=qi(nl-ll-1); ll:=ll-lll;
+ until lll=0;
+ end;
+goto continue;
+end
+
+@ @<Compile a ligature/kern...@>=
+begin next_char(nl):=qi(c); skip_byte(nl):=qi(0);
+if cur_mod<128 then {ligature op}
+ begin op_byte(nl):=qi(cur_mod); rem_byte(nl):=qi(get_code);
+ end
+else begin get_x_next; scan_expression;
+ if cur_type<>known then
+ begin exp_err("Improper kern");
+@.Improper kern@>
+ help2("The amount of kern should be a known numeric value.")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+ put_get_flush_error(0);
+ end;
+ kern[nk]:=cur_exp;
+ k:=0;@+while kern[k]<>cur_exp do incr(k);
+ if k=nk then
+ begin if nk=max_kerns then overflow("kern",max_kerns);
+@:MetaPost capacity exceeded kern}{\quad kern@>
+ incr(nk);
+ end;
+ op_byte(nl):=kern_flag+(k div 256);
+ rem_byte(nl):=qi((k mod 256));
+ end;
+lk_started:=true;
+end
+
+@ @d missing_extensible_punctuation(#)==
+ begin missing_err(#);
+@.Missing `\char`\#'@>
+ help1("I'm processing `extensible c: t,m,b,r'."); back_error;
+ end
+
+@<Define an extensible recipe@>=
+begin if ne=256 then overflow("extensible",256);
+@:MetaPost capacity exceeded extensible}{\quad extensible@>
+c:=get_code; set_tag(c,ext_tag,ne);
+if cur_cmd<>colon then missing_extensible_punctuation(":");
+ext_top(ne):=qi(get_code);
+if cur_cmd<>comma then missing_extensible_punctuation(",");
+ext_mid(ne):=qi(get_code);
+if cur_cmd<>comma then missing_extensible_punctuation(",");
+ext_bot(ne):=qi(get_code);
+if cur_cmd<>comma then missing_extensible_punctuation(",");
+ext_rep(ne):=qi(get_code);
+incr(ne);
+end
+
+@ @<Store a list of header bytes@>=
+repeat if j>header_size then overflow("headerbyte",header_size);
+@:MetaPost capacity exceeded headerbyte}{\quad headerbyte@>
+header_byte[j]:=get_code; incr(j);
+until cur_cmd<>comma
+
+@ @<Store a list of font dimensions@>=
+repeat if j>max_font_dimen then overflow("fontdimen",max_font_dimen);
+@:MetaPost capacity exceeded fontdimen}{\quad fontdimen@>
+while j>np do
+ begin incr(np); param[np]:=0;
+ end;
+get_x_next; scan_expression;
+if cur_type<>known then
+ begin exp_err("Improper font parameter");
+@.Improper font parameter@>
+ help1("I'm zeroing this one. Proceed, with fingers crossed.");
+ put_get_flush_error(0);
+ end;
+param[j]:=cur_exp; incr(j);
+until cur_cmd<>comma
+
+@ OK: We've stored all the data that is needed for the \.{TFM} file.
+All that remains is to output it in the correct format.
+
+An interesting problem needs to be solved in this connection, because
+the \.{TFM} format allows at most 256~widths, 16~heights, 16~depths,
+and 64~italic corrections. If the data has more distinct values than
+this, we want to meet the necessary restrictions by perturbing the
+given values as little as possible.
+
+\MP\ solves this problem in two steps. First the values of a given
+kind (widths, heights, depths, or italic corrections) are sorted;
+then the list of sorted values is perturbed, if necessary.
+
+The sorting operation is facilitated by having a special node of
+essentially infinite |value| at the end of the current list.
+
+@<Initialize table entries...@>=
+value(inf_val):=fraction_four;
+
+@ Straight linear insertion is good enough for sorting, since the lists
+are usually not terribly long. As we work on the data, the current list
+will start at |link(temp_head)| and end at |inf_val|; the nodes in this
+list will be in increasing order of their |value| fields.
+
+Given such a list, the |sort_in| function takes a value and returns a pointer
+to where that value can be found in the list. The value is inserted in
+the proper place, if necessary.
+
+At the time we need to do these operations, most of \MP's work has been
+completed, so we will have plenty of memory to play with. The value nodes
+that are allocated for sorting will never be returned to free storage.
+
+@d clear_the_list==link(temp_head):=inf_val
+
+@p function sort_in(@!v:scaled):pointer;
+label found;
+var @!p,@!q,@!r:pointer; {list manipulation registers}
+begin p:=temp_head;
+loop@+ begin q:=link(p);
+ if v<=value(q) then goto found;
+ p:=q;
+ end;
+found: if v<value(q) then
+ begin r:=get_node(value_node_size); value(r):=v; link(r):=q; link(p):=r;
+ end;
+sort_in:=link(p);
+end;
+
+@ Now we come to the interesting part, where we reduce the list if necessary
+until it has the required size. The |min_cover| routine is basic to this
+process; it computes the minimum number~|m| such that the values of the
+current sorted list can be covered by |m|~intervals of width~|d|. It
+also sets the global value |perturbation| to the smallest value $d'>d$
+such that the covering found by this algorithm would be different.
+
+In particular, |min_cover(0)| returns the number of distinct values in the
+current list and sets |perturbation| to the minimum distance between
+adjacent values.
+
+@p function min_cover(@!d:scaled):integer;
+var @!p:pointer; {runs through the current list}
+@!l:scaled; {the least element covered by the current interval}
+@!m:integer; {lower bound on the size of the minimum cover}
+begin m:=0; p:=link(temp_head); perturbation:=el_gordo;
+while p<>inf_val do
+ begin incr(m); l:=value(p);
+ repeat p:=link(p);
+ until value(p)>l+d;
+ if value(p)-l<perturbation then perturbation:=value(p)-l;
+ end;
+min_cover:=m;
+end;
+
+@ @<Glob...@>=
+@!perturbation:scaled; {quantity related to \.{TFM} rounding}
+@!excess:integer; {the list is this much too long}
+
+@ The smallest |d| such that a given list can be covered with |m| intervals
+is determined by the |threshold| routine, which is sort of an inverse
+to |min_cover|. The idea is to increase the interval size rapidly until
+finding the range, then to go sequentially until the exact borderline has
+been discovered.
+
+@p function threshold(@!m:integer):scaled;
+var @!d:scaled; {lower bound on the smallest interval size}
+begin excess:=min_cover(0)-m;
+if excess<=0 then threshold:=0
+else begin repeat d:=perturbation;
+ until min_cover(d+d)<=m;
+ while min_cover(d)>m do d:=perturbation;
+ threshold:=d;
+ end;
+end;
+
+@ The |skimp| procedure reduces the current list to at most |m| entries,
+by changing values if necessary. It also sets |info(p):=k| if |value(p)|
+is the |k|th distinct value on the resulting list, and it sets
+|perturbation| to the maximum amount by which a |value| field has
+been changed. The size of the resulting list is returned as the
+value of |skimp|.
+
+@p function skimp(@!m:integer):integer;
+var @!d:scaled; {the size of intervals being coalesced}
+@!p,@!q,@!r:pointer; {list manipulation registers}
+@!l:scaled; {the least value in the current interval}
+@!v:scaled; {a compromise value}
+begin d:=threshold(m); perturbation:=0;
+q:=temp_head; m:=0; p:=link(temp_head);
+while p<>inf_val do
+ begin incr(m); l:=value(p); info(p):=m;
+ if value(link(p))<=l+d then
+ @<Replace an interval of values by its midpoint@>;
+ q:=p; p:=link(p);
+ end;
+skimp:=m;
+end;
+
+@ @<Replace an interval...@>=
+begin repeat p:=link(p); info(p):=m;
+decr(excess);@+if excess=0 then d:=0;
+until value(link(p))>l+d;
+v:=l+halfp(value(p)-l);
+if value(p)-v>perturbation then perturbation:=value(p)-v;
+r:=q;
+repeat r:=link(r); value(r):=v;
+until r=p;
+link(q):=p; {remove duplicate values from the current list}
+end
+
+@ A warning message is issued whenever something is perturbed by
+more than 1/16\thinspace pt.
+
+@p procedure tfm_warning(@!m:small_number);
+begin print_nl("(some "); print(int_name[m]);
+@.some charwds...@>
+@.some chardps...@>
+@.some charhts...@>
+@.some charics...@>
+print(" values had to be adjusted by as much as ");
+print_scaled(perturbation); print("pt)");
+end;
+
+@ Here's an example of how we use these routines.
+The width data needs to be perturbed only if there are 256 distinct
+widths, but \MP\ must check for this case even though it is
+highly unusual.
+
+An integer variable |k| will be defined when we use this code.
+The |dimen_head| array will contain pointers to the sorted
+lists of dimensions.
+
+@<Massage the \.{TFM} widths@>=
+clear_the_list;
+for k:=bc to ec do if char_exists[k] then
+ tfm_width[k]:=sort_in(tfm_width[k]);
+nw:=skimp(255)+1; dimen_head[1]:=link(temp_head);
+if perturbation>=@'10000 then tfm_warning(char_wd)
+
+@ @<Glob...@>=
+@!dimen_head:array[1..4] of pointer; {lists of \.{TFM} dimensions}
+
+@ Heights, depths, and italic corrections are different from widths
+not only because their list length is more severely restricted, but
+also because zero values do not need to be put into the lists.
+
+@<Massage the \.{TFM} heights, depths, and italic corrections@>=
+clear_the_list;
+for k:=bc to ec do if char_exists[k] then
+ if tfm_height[k]=0 then tfm_height[k]:=zero_val
+ else tfm_height[k]:=sort_in(tfm_height[k]);
+nh:=skimp(15)+1; dimen_head[2]:=link(temp_head);
+if perturbation>=@'10000 then tfm_warning(char_ht);
+clear_the_list;
+for k:=bc to ec do if char_exists[k] then
+ if tfm_depth[k]=0 then tfm_depth[k]:=zero_val
+ else tfm_depth[k]:=sort_in(tfm_depth[k]);
+nd:=skimp(15)+1; dimen_head[3]:=link(temp_head);
+if perturbation>=@'10000 then tfm_warning(char_dp);
+clear_the_list;
+for k:=bc to ec do if char_exists[k] then
+ if tfm_ital_corr[k]=0 then tfm_ital_corr[k]:=zero_val
+ else tfm_ital_corr[k]:=sort_in(tfm_ital_corr[k]);
+ni:=skimp(63)+1; dimen_head[4]:=link(temp_head);
+if perturbation>=@'10000 then tfm_warning(char_ic)
+
+@ @<Initialize table entries...@>=
+value(zero_val):=0; info(zero_val):=0;
+
+@ Bytes 5--8 of the header are set to the design size, unless the user has
+some crazy reason for specifying them differently.
+
+Error messages are not allowed at the time this procedure is called,
+so a warning is printed instead.
+
+The value of |max_tfm_dimen| is calculated so that
+$$\hbox{|make_scaled(16*max_tfm_dimen,internal[design_size])|}
+ < \\{three\_bytes}.$$
+
+@d three_bytes==@'100000000 {$2^{24}$}
+
+@p procedure fix_design_size;
+var @!d:scaled; {the design size}
+begin d:=internal[design_size];
+if (d<unity)or(d>=fraction_half) then
+ begin if d<>0 then
+ print_nl("(illegal design size has been changed to 128pt)");
+@.illegal design size...@>
+ d:=@'40000000; internal[design_size]:=d;
+ end;
+if header_byte[5]<0 then if header_byte[6]<0 then
+ if header_byte[7]<0 then if header_byte[8]<0 then
+ begin header_byte[5]:=d div @'4000000;
+ header_byte[6]:=(d div 4096) mod 256;
+ header_byte[7]:=(d div 16) mod 256;
+ header_byte[8]:=(d mod 16)*16;
+ end;
+max_tfm_dimen:=16*internal[design_size]-internal[design_size] div @'10000000;
+if max_tfm_dimen>=fraction_half then max_tfm_dimen:=fraction_half-1;
+end;
+
+@ The |dimen_out| procedure computes a |fix_word| relative to the
+design size. If the data was out of range, it is corrected and the
+global variable |tfm_changed| is increased by~one.
+
+@p function dimen_out(@!x:scaled):integer;
+begin if abs(x)>max_tfm_dimen then
+ begin incr(tfm_changed);
+ if x>0 then x:=three_bytes-1@+else x:=1-three_bytes;
+ end
+else x:=make_scaled(x*16,internal[design_size]);
+dimen_out:=x;
+end;
+
+@ @<Glob...@>=
+@!max_tfm_dimen:scaled; {bound on widths, heights, kerns, etc.}
+@!tfm_changed:integer; {the number of data entries that were out of bounds}
+
+@ If the user has not specified any of the first four header bytes,
+the |fix_check_sum| procedure replaces them by a ``check sum'' computed
+from the |tfm_width| data relative to the design size.
+@^check sum@>
+
+@p procedure fix_check_sum;
+label exit;
+var @!k:eight_bits; {runs through character codes}
+@!b1,@!b2,@!b3,@!b4:eight_bits; {bytes of the check sum}
+@!x:integer; {hash value used in check sum computation}
+begin if header_byte[1]<0 then if header_byte[2]<0 then
+ if header_byte[3]<0 then if header_byte[4]<0 then
+ begin @<Compute a check sum in |(b1,b2,b3,b4)|@>;
+ header_byte[1]:=b1; header_byte[2]:=b2;
+ header_byte[3]:=b3; header_byte[4]:=b4; return;
+ end;
+for k:=1 to 4 do if header_byte[k]<0 then header_byte[k]:=0;
+exit:end;
+
+@ @<Compute a check sum in |(b1,b2,b3,b4)|@>=
+b1:=bc; b2:=ec; b3:=bc; b4:=ec; tfm_changed:=0;
+for k:=bc to ec do if char_exists[k] then
+ begin x:=dimen_out(value(tfm_width[k]))+(k+4)*@'20000000; {this is positive}
+ b1:=(b1+b1+x) mod 255;
+ b2:=(b2+b2+x) mod 253;
+ b3:=(b3+b3+x) mod 251;
+ b4:=(b4+b4+x) mod 247;
+ end
+
+@ Finally we're ready to actually write the \.{TFM} information.
+Here are some utility routines for this purpose.
+
+@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|}
+
+@p procedure tfm_two(@!x:integer); {output two bytes to |tfm_file|}
+begin tfm_out(x div 256); tfm_out(x mod 256);
+end;
+@#
+procedure tfm_four(@!x:integer); {output four bytes to |tfm_file|}
+begin if x>=0 then tfm_out(x div three_bytes)
+else begin x:=x+@'10000000000; {use two's complement for negative values}
+ x:=x+@'10000000000;
+ tfm_out((x div three_bytes) + 128);
+ end;
+x:=x mod three_bytes; tfm_out(x div unity);
+x:=x mod unity; tfm_out(x div @'400);
+tfm_out(x mod @'400);
+end;
+@#
+procedure tfm_qqqq(@!x:four_quarters); {output four quarterwords to |tfm_file|}
+begin tfm_out(qo(x.b0)); tfm_out(qo(x.b1)); tfm_out(qo(x.b2));
+tfm_out(qo(x.b3));
+end;
+
+@ @<Finish the \.{TFM} file@>=
+if job_name=0 then open_log_file;
+pack_job_name(".tfm");
+while not b_open_out(tfm_file) do
+ prompt_file_name("file name for font metrics",".tfm");
+metric_file_name:=b_make_name_string(tfm_file);
+@<Output the subfile sizes and header bytes@>;
+@<Output the character information bytes, then
+ output the dimensions themselves@>;
+@<Output the ligature/kern program@>;
+@<Output the extensible character recipes and the font metric parameters@>;
+@!stat if internal[tracing_stats]>0 then
+ @<Log the subfile sizes of the \.{TFM} file@>;@;@+tats@/
+print_nl("Font metrics written on "); print(metric_file_name); print_char(".");
+@.Font metrics written...@>
+b_close(tfm_file)
+
+@ Integer variables |lh|, |k|, and |lk_offset| will be defined when we use
+this code.
+
+@<Output the subfile sizes and header bytes@>=
+k:=header_size;
+while header_byte[k]<0 do decr(k);
+lh:=(k+3) div 4; {this is the number of header words}
+if bc>ec then bc:=1; {if there are no characters, |ec=0| and |bc=1|}
+@<Compute the ligature/kern program offset and implant the
+ left boundary label@>;
+tfm_two(6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+lk_offset+nk+ne+np);
+ {this is the total number of file words that will be output}
+tfm_two(lh); tfm_two(bc); tfm_two(ec); tfm_two(nw); tfm_two(nh);
+tfm_two(nd); tfm_two(ni); tfm_two(nl+lk_offset); tfm_two(nk); tfm_two(ne);
+tfm_two(np);
+for k:=1 to 4*lh do
+ begin if header_byte[k]<0 then header_byte[k]:=0;
+ tfm_out(header_byte[k]);
+ end
+
+@ @<Output the character information bytes...@>=
+for k:=bc to ec do
+ if not char_exists[k] then tfm_four(0)
+ else begin tfm_out(info(tfm_width[k])); {the width index}
+ tfm_out((info(tfm_height[k]))*16+info(tfm_depth[k]));
+ tfm_out((info(tfm_ital_corr[k]))*4+char_tag[k]);
+ tfm_out(char_remainder[k]);
+ end;
+tfm_changed:=0;
+for k:=1 to 4 do
+ begin tfm_four(0); p:=dimen_head[k];
+ while p<>inf_val do
+ begin tfm_four(dimen_out(value(p))); p:=link(p);
+ end;
+ end
+
+@ We need to output special instructions at the beginning of the
+|lig_kern| array in order to specify the right boundary character
+and/or to handle starting addresses that exceed 255. The |label_loc|
+and |label_char| arrays have been set up to record all the
+starting addresses; we have $-1=|label_loc|[0]<|label_loc|[1]\le\cdots
+\le|label_loc|[|label_ptr]|$.
+
+@<Compute the ligature/kern program offset...@>=
+bchar:=round_unscaled(internal[boundary_char]);
+if(bchar<0)or(bchar>255)then
+ begin bchar:=-1; lk_started:=false; lk_offset:=0;@+end
+else begin lk_started:=true; lk_offset:=1;@+end;
+@<Find the minimum |lk_offset| and adjust all remainders@>;
+if bch_label<undefined_label then
+ begin skip_byte(nl):=qi(255); next_char(nl):=qi(0);
+ op_byte(nl):=qi(((bch_label+lk_offset)div 256));
+ rem_byte(nl):=qi(((bch_label+lk_offset)mod 256));
+ incr(nl); {possibly |nl=lig_table_size+1|}
+ end
+
+@ @<Find the minimum |lk_offset|...@>=
+k:=label_ptr; {pointer to the largest unallocated label}
+if label_loc[k]+lk_offset>255 then
+ begin lk_offset:=0; lk_started:=false; {location 0 can do double duty}
+ repeat char_remainder[label_char[k]]:=lk_offset;
+ while label_loc[k-1]=label_loc[k] do
+ begin decr(k); char_remainder[label_char[k]]:=lk_offset;
+ end;
+ incr(lk_offset); decr(k);
+ until lk_offset+label_loc[k]<256;
+ {N.B.: |lk_offset=256| satisfies this when |k=0|}
+ end;
+if lk_offset>0 then
+ while k>0 do
+ begin char_remainder[label_char[k]]
+ :=char_remainder[label_char[k]]+lk_offset;
+ decr(k);
+ end
+
+@ @<Output the ligature/kern program@>=
+for k:=0 to 255 do if skip_table[k]<undefined_label then
+ begin print_nl("(local label "); print_int(k); print(":: was missing)");
+@.local label l:: was missing@>
+ cancel_skips(skip_table[k]);
+ end;
+if lk_started then {|lk_offset=1| for the special |bchar|}
+ begin tfm_out(255); tfm_out(bchar); tfm_two(0);
+ end
+else for k:=1 to lk_offset do {output the redirection specs}
+ begin ll:=label_loc[label_ptr];
+ if bchar<0 then
+ begin tfm_out(254); tfm_out(0);
+ end
+ else begin tfm_out(255); tfm_out(bchar);
+ end;
+ tfm_two(ll+lk_offset);
+ repeat decr(label_ptr);
+ until label_loc[label_ptr]<ll;
+ end;
+for k:=0 to nl-1 do tfm_qqqq(lig_kern[k]);
+for k:=0 to nk-1 do tfm_four(dimen_out(kern[k]))
+
+@ @<Output the extensible character recipes...@>=
+for k:=0 to ne-1 do tfm_qqqq(exten[k]);
+for k:=1 to np do
+ if k=1 then
+ if abs(param[1])<fraction_half then tfm_four(param[1]*16)
+ else begin incr(tfm_changed);
+ if param[1]>0 then tfm_four(el_gordo)
+ else tfm_four(-el_gordo);
+ end
+ else tfm_four(dimen_out(param[k]));
+if tfm_changed>0 then
+ begin if tfm_changed=1 then print_nl("(a font metric dimension")
+@.a font metric dimension...@>
+ else begin print_nl("("); print_int(tfm_changed);
+@.font metric dimensions...@>
+ print(" font metric dimensions");
+ end;
+ print(" had to be decreased)");
+ end
+
+@ @<Log the subfile sizes of the \.{TFM} file@>=
+begin wlog_ln(' ');
+if bch_label<undefined_label then decr(nl);
+wlog_ln('(You used ',nw:1,'w,',@| nh:1,'h,',@| nd:1,'d,',@| ni:1,'i,',@|
+ nl:1,'l,',@| nk:1,'k,',@| ne:1,'e,',@|
+ np:1,'p metric file positions');
+wlog_ln(' out of ',@| '256w,16h,16d,64i,',@|
+ lig_table_size:1,'l,',max_kerns:1,'k,256e,',@|
+ max_font_dimen:1,'p)');
+end
+
+@* \[43] Reading font metric data.
+
+\MP\ isn't a typesetting program but it does need to find the bounding box
+of a sequence of typeset characters. Thus it needs to read \.{TFM} files as
+well as write them.
+
+@<Glob...@>=
+tfm_infile:byte_file;
+
+@ All the width, height, and depth information is stored in an array called
+|font_info|. This array is allocated sequentially and each font is stored
+as a series of |char_info| words followed by the width, height, and depth
+tables. Since |font_name| entries are permanent, their |str_ref| values are
+set to |max_str_ref|.
+
+@<Types...@>=
+font_number=0..font_max;
+
+@ @<Glob...@>=
+font_info:array[0..font_mem_size] of memory_word;
+ {height, width, and depth data}
+next_fmem:0..font_mem_size; {next unused entry in |font_info|}
+last_fnum:font_number; {last font number used so far}
+font_dsize:array[font_number] of scaled;
+ {16 times the ``design'' size in \ps\ points}
+font_name:array[font_number] of str_number;
+ {name as specified in the \&{infont} command}
+font_ps_name:array[font_number] of str_number;
+ {PostScript name for use when |internal[prologues]>0|}
+last_ps_fnum:font_number; {last valid |font_ps_name| index}
+font_bc,font_ec:array[font_number] of eight_bits;
+ {first and last character code}
+
+@ The |font_info| array is indexed via a group directory arrays.
+For example, the |char_info| data for character~|c| in font~|f| will be
+in |font_info[char_base[f]+c].qqqq|.
+
+@<Glob...@>=
+char_base:array[font_number] of 0..font_mem_size;
+ {base address for |char_info|}
+width_base:array[font_number] of 0..font_mem_size;
+ {index for zeroth character width}
+height_base:array[font_number] of 0..font_mem_size;
+ {index for zeroth character height}
+depth_base:array[font_number] of 0..font_mem_size;
+ {index for zeroth character depth}
+
+@ A |null_font| containing no characters is useful for error recovery. Its
+|font_name| entry starts out empty but is reset each time an erroneous font is
+found. This helps to cut down on the number of duplicate error messages without
+wasting a lot of space.
+
+@d null_font=0 {the |font_number| for an empty font}
+
+@<Initialize table...@>=
+font_dsize[null_font]:=0;
+font_name[null_font]:="";
+font_ps_name[null_font]:="";
+font_bc[null_font]:=1;
+font_ec[null_font]:=0;@/
+char_base[null_font]:=0;
+width_base[null_font]:=0;
+height_base[null_font]:=0;
+depth_base[null_font]:=0;@/
+next_fmem:=0;
+last_fnum:=null_font;
+last_ps_fnum:=null_font;
+
+@ Each |char_info| word is of type |four_quarters|. The |b0| field contains
+|min_quarter_word| plus the |width index|; the |b1| field contains the height
+index; the |b2| fields contains the depth index, and the |b3| field used only
+for temporary storage. (It is used to keep track of which characters occur in
+an edge structure that is being shipped out.)
+The corresponding words in the width, height, and depth tables are stored as
+|scaled| values in units of \ps\ points.
+
+With the macros below, the |char_info| word for character~|c| in font~|f| is
+|char_info(f)(c)| and the width is
+$$\hbox{|char_width(f)(char_info(f)(c)).sc|.}$$
+
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_info[char_base[#]+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_info[width_base[#]+char_width_end
+@d char_height_end(#)==#.b1].sc
+@d char_height(#)==font_info[height_base[#]+char_height_end
+@d char_depth_end(#)==#.b2].sc
+@d char_depth(#)==font_info[depth_base[#]+char_depth_end
+@d ichar_exists(#)==(#.b0>min_quarterword)
+
+@ The |font_ps_name| for a built-in font should be what PostScript expects.
+A preliminary name is obtained here from the \.{TFM} name as given in the
+|fname| argument. This gets updated later from an external table if necessary.
+
+@d bad_tfm=11 {go here if the \.{TFM} file is bad}
+
+@<Declare text measuring subroutines@>=
+@<Declare subroutines for parsing file names@>@;
+function read_font_info(fname:str_number):font_number;
+label bad_tfm,done;
+var @!file_opened:boolean; {has |tfm_infile| been opened?}
+@!n:font_number; {the number to return}
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd:halfword; {subfile size parameters}
+@!whd_size:integer; {words needed for heights, widths, and depths}
+@!i,@!ii:0..font_mem_size; {|font_info| indices}
+@!jj:0..font_mem_size; {counts bytes to be ignored}
+@!z:scaled; {used to compute the design size}
+@!d:fraction;
+ {height, width, or depth as a fraction of design size times $2^{-8}$}
+@!h_and_d:eight_bits; {height and depth indices being unpacked}
+begin n:=null_font;
+@<Open |tfm_infile| for input@>;
+@<Read data from |tfm_infile|; if there is no room, say so and |goto done|;
+ otherwise |goto bad_tfm| or |goto done| as appropriate@>;
+bad_tfm:@<Complain that the \.{TFM} file is bad@>;
+done:if file_opened then b_close(tfm_infile);
+if n<>null_font then
+ begin font_ps_name[n]:=fname;
+ font_name[n]:=fname;
+ str_ref[fname]:=max_str_ref;
+ end;
+read_font_info:=n;
+end;
+
+@ \MP\ doesn't bother to check the entire \.{TFM} file for errors or explain
+precisely what is wrong if it does find a problem. Programs called \.{TFtoPL}
+@.TFtoPL@> @.PLtoTF@>
+and \.{PLtoTF} can be used to debug \.{TFM} files.
+
+@<Complain that the \.{TFM} file is bad@>=
+print_err("Font ");
+print(fname);
+if file_opened then print(" not usable: TFM file is bad")
+else print(" not usable: TFM file not found");
+help3("I wasn't able to read the size data for this font so this")@/
+ ("`infont' operation won't produce anything. If the font name")@/
+ ("is right, you might ask an expert to make a TFM file");
+if file_opened then
+ help_line[0]:="is right, try asking an expert to fix the TFM file";
+error
+
+@ @<Read data from |tfm_infile|; if there is no room, say so...@>=
+@<Read the \.{TFM} size fields@>;
+@<Use the size fields to allocate space in |font_info|@>;
+@<Read the \.{TFM} header@>;
+@<Read the character data and the width, height, and depth tables and
+ |goto done|@>
+
+@ A bad \.{TFM} file can be shorter than it claims to be. The code given here
+might try to read past the end of the file if this happens. Changes will be
+needed if it causes a system error to refer to |tfm_infile^| or call
+|get_tfm_infile| when |eof(tfm_infile)| is true. For example, the definition
+@^system dependencies@>
+of |tfget| could be changed to
+``|begin get(tfm_infile); if eof(tfm_infile) then goto bad_tfm; end|.''
+
+@d tfget==get(tfm_infile)
+@d tfbyte==tfm_infile^
+@d read_two(#)==begin #:=tfbyte;
+ if #>127 then goto bad_tfm;
+ tfget; #:=#*@'400+tfbyte;
+ end
+@d tf_ignore(#)==for jj:=# downto 1 do tfget
+
+@<Read the \.{TFM} size fields@>=
+read_two(lf);
+tfget; read_two(lh);
+tfget; read_two(bc);
+tfget; read_two(ec);
+if (bc>1+ec)or(ec>255) then goto bad_tfm;
+tfget; read_two(nw);
+tfget; read_two(nh);
+tfget; read_two(nd);
+whd_size:=(ec+1-bc)+nw+nh+nd;
+if lf<6+lh+whd_size then goto bad_tfm;
+tf_ignore(10)
+
+@ Offsets are added to |char_base[n]| and |width_base[n]| so that is not
+necessary to apply the |so| and |qo| macros when looking up the width of a
+character in the string pool. In order to ensure nonnegative |char_base|
+values when |bc>0|, it may be necessary to reserve a few unused |font_info|
+elements.
+
+@<Use the size fields to allocate space in |font_info|@>=
+if next_fmem<bc+min_pool_ASCII then next_fmem:=bc+min_pool_ASCII;
+ {ensure nonnegative |char_base|}
+if (last_fnum=font_max)or(next_fmem+whd_size>=font_mem_size) then
+ @<Explain that there isn't enough space and |goto done|@>;
+incr(last_fnum);
+n:=last_fnum;
+font_bc[n]:=bc;
+font_ec[n]:=ec;
+char_base[n]:=next_fmem-bc-min_pool_ASCII;
+width_base[n]:=next_fmem+ec-bc+1-min_quarterword;
+height_base[n]:=width_base[n]+min_quarterword+nw;
+depth_base[n]:=height_base[n]+nh;
+next_fmem:=next_fmem+whd_size;
+
+@ @<Explain that there isn't enough space and |goto done|@>=
+begin print_err("Font ");
+print(fname);
+print(" not usable: Not enough space");
+help3("This `infont' operation won't produce anything because I")@/
+ ("don't have enough room to store the character-size data for")@/
+ ("the font. You may have to ask a wizard to enlarge me.");
+error;
+goto done;
+end
+
+@ @<Read the \.{TFM} header@>=
+if lh<2 then goto bad_tfm;
+tf_ignore(4);
+tfget; read_two(z);
+tfget; z:=z*@'400+tfbyte;
+tfget; z:=z*@'400+tfbyte; {now |z| is 16 times the design size}
+font_dsize[n]:=take_fraction(z,267432584);
+ {times ${72\over72.27}2^{28}$ to convert from \TeX\ points}
+tf_ignore(4*(lh-2))
+
+@ @<Read the character data and the width, height, and depth tables...@>=
+ii:=width_base[n]+min_quarterword;
+i:=char_base[n]+min_pool_ASCII+bc;
+while i<ii do
+ begin tfget; font_info[i].qqqq.b0:=qi(tfbyte);@/
+ tfget; h_and_d:=tfbyte;
+ font_info[i].qqqq.b1:=h_and_d div 16;
+ font_info[i].qqqq.b2:=h_and_d mod 16;@/
+ tfget; tfget;
+ incr(i);
+ end;
+while i<next_fmem do
+ @<Read a four byte dimension, scale it by the design size, store it in
+ |font_info[i]|, and increment |i|@>;
+if eof(tfm_infile) then goto bad_tfm;
+goto done
+
+@ The raw dimension read into |d| should have magnitude at most $2^{24}$ when
+interpreted as an integer, and this includes a scale factor of $2^{20}$. Thus
+we can multiply it by sixteen and think of it as a |fraction| that has been
+divided by sixteen. This cancels the extra scale factor contained in
+|font_dsize[n|.
+
+@<Read a four byte dimension, scale it by the design size, store it in...@>=
+begin tfget; d:=tfbyte;
+if d>=@'200 then d:=d-@'400;
+tfget; d:=d*@'400+tfbyte;@/
+tfget; d:=d*@'400+tfbyte;@/
+tfget; d:=d*@'400+tfbyte;@/
+font_info[i].sc:=take_fraction(d*16,font_dsize[n]);
+incr(i);
+end
+
+@ @<Open |tfm_infile| for input@>=
+file_opened:=false;
+str_scan_file(fname);
+if cur_area="" then cur_area:=MP_font_area;
+if cur_ext="" then cur_ext:=".tfm";
+pack_cur_name;
+if not b_open_in(tfm_infile) then goto bad_tfm;
+file_opened:=true
+
+@ When we have a font name and we don't know whether it has been loaded yet,
+we scan the |font_name| array before calling |read_font_info|.
+
+@<Declare text measuring subroutines@>=
+function find_font(@!f:str_number):font_number;
+label exit,found;
+var @!n:font_number;
+begin for n:=0 to last_fnum do
+ if str_vs_str(f,font_name[n])=0 then goto found;
+find_font:=read_font_info(f);
+return;
+found:find_font:=n;
+exit:end;
+
+@ One simple application of |find_font| is the implementation of the |font_size|
+operator that gets the design size for a given font name.
+
+@<Find the design size of the font whose name is |cur_exp|@>=
+flush_cur_exp((font_dsize[find_font(cur_exp)]+8) div 16)
+
+@ If we discover that the font doesn't have a requested character, we omit it
+from the bounding box computation and expect the \ps\ interpreter to drop it.
+This routine issues a warning message if the user has asked for it.
+
+@<Declare text measuring subroutines@>=
+procedure lost_warning(@!f:font_number;@!k:pool_pointer);
+begin if internal[tracing_lost_chars]>0 then
+ begin begin_diagnostic;
+ print_nl("Missing character: There is no ");
+@.Missing character@>
+ print(so(str_pool[k])); print(" in font ");
+ print(font_name[f]); print_char("!"); end_diagnostic(false);
+ end;
+end;
+
+@ The whole purpose of saving the height, width, and depth information is to be
+able to find the bounding box of an item of text in an edge structure. The
+|set_text_box| procedure takes a text node and adds this information.
+
+@<Declare text measuring subroutines@>=
+procedure set_text_box(@!p:pointer);
+var @!f:font_number; {|font_n(p)|}
+@!bc,@!ec:pool_ASCII_code; {range of valid characters for font |f|}
+@!k,kk:pool_pointer; {current character and character to stop at}
+@!cc:four_quarters; {the |char_info| for the current character}
+@!h,@!d:scaled; {dimensions of the current character}
+begin width_val(p):=0;
+height_val(p):=-el_gordo;
+depth_val(p):=-el_gordo;@/
+f:=font_n(p);
+bc:=si(font_bc[f]);
+ec:=si(font_ec[f]);@/
+kk:=str_stop(text_p(p));
+k:=str_start[text_p(p)];
+while k<kk do
+ @<Adjust |p|'s bounding box to contain |str_pool[k]|; advance |k|@>;
+@<Set the height and depth to zero if the bounding box is empty@>;
+end;
+
+@ @<Adjust |p|'s bounding box to contain |str_pool[k]|; advance |k|@>=
+begin if (str_pool[k]<bc)or(str_pool[k]>ec) then lost_warning(f,k)
+else begin cc:=char_info(f)(str_pool[k]);
+ if not ichar_exists(cc) then lost_warning(f,k)
+ else begin width_val(p):=width_val(p)+char_width(f)(cc);
+ h:=char_height(f)(cc);
+ d:=char_depth(f)(cc);
+ if h>height_val(p) then height_val(p):=h;
+ if d>depth_val(p) then depth_val(p):=d;
+ end;
+ end;
+incr(k);
+end
+
+@ Let's hope modern compilers do comparisons correctly when the difference would
+overflow.
+
+@<Set the height and depth to zero if the bounding box is empty@>=
+if height_val(p)<-depth_val(p) then
+ begin height_val(p):=0;
+ depth_val(p):=0;
+ end
+
+@ The file |ps_tab_file| gives a table of \TeX\ font names and corresponding
+PostScript names for fonts that do not have to be downloaded, i.e., fonts that
+can be used when |internal[prologues]>0|. Each line consists of a \TeX\ name,
+one or more spaces, a PostScript name, and possibly a space and some other junk.
+This routine reads the table, updates |font_ps_name| entries starting after
+|last_ps_fnum|, and sets |last_ps_fnum:=last_fnum|. If the file |ps_tab_file|
+is missing, we assume that the existing font names are OK and nothing needs to
+be done.
+
+@<Declare the \ps\ output procedures@>=
+procedure read_psname_table;
+label common_ending, done;
+var @!k:font_number; {font for possible name match}
+@!lmax:integer; {upper limit on length of name to match}
+@!j:integer; {characters left to read before string gets too long}
+@!c:text_char; {character being read from |ps_tab_file|}
+@!s:str_number; {possible font name to match}
+begin name_of_file:=ps_tab_name;
+if a_open_in(ps_tab_file) then
+ begin @<Set |lmax| to the maximum |font_name| length for fonts
+ |last_ps_fnum+1| through |last_fnum|@>;
+ while not eof(ps_tab_file) do
+ begin @<Read at most |lmax| characters from |ps_tab_file| into string |s|
+ but |goto common_ending| if there is trouble@>;
+ for k:=last_ps_fnum+1 to last_fnum do
+ if str_vs_str(s,font_name[k])=0 then
+ @<|flush_string(s)|, read in |font_ps_name[k]|, and
+ |goto common_ending|@>;
+ flush_string(s);
+common_ending:read_ln(ps_tab_file);
+ end;
+ last_ps_fnum:=last_fnum;
+ a_close(ps_tab_file);
+ end;
+end;
+
+@ @<Glob...@>=
+@!ps_tab_file:alpha_file; {file for font name translation table}
+
+@ @<Set |lmax| to the maximum |font_name| length for fonts...@>=
+lmax:=0;
+for k:=last_ps_fnum+1 to last_fnum do
+ if length(font_name[k])>lmax then lmax:=length(font_name[k])
+
+@ @<Read at most |lmax| characters from |ps_tab_file| into string |s|...@>=
+str_room(lmax);
+j:=lmax;
+loop @+begin if eoln(ps_tab_file) then
+ fatal_error("The psfont map file is bad!");
+ read(ps_tab_file,c);
+ if c=' ' then goto done;
+ decr(j);
+ if j>=0 then append_char(xord[c])
+ else begin flush_cur_string;
+ goto common_ending;
+ end;
+ end;
+done:s:=make_string
+
+@ PostScript font names should be at most 28 characters long but we allow 32
+just to be safe.
+
+@<|flush_string(s)|, read in |font_ps_name[k]|, and...@>=
+begin flush_string(s);
+j:=32;
+str_room(j);
+repeat if eoln(ps_tab_file) then fatal_error("The psfont map file is bad!");
+ read(ps_tab_file,c);
+until c<>' ';
+repeat decr(j);
+ if j<0 then fatal_error("The psfont map file is bad!");
+ append_char(xord[c]);
+ if eoln(ps_tab_file) then c:=' ' @+else read(ps_tab_file,c);
+until c=' ';
+delete_str_ref(font_ps_name[k]);
+font_ps_name[k]:=make_string;
+goto common_ending;
+end
+
+@* \[44] Shipping pictures out.
+The |ship_out| procedure, to be described below, is given a pointer to
+an edge structure. Its mission is to output a file containing the \ps\
+description of an edge structure.
+
+@ Each time an edge structure is shipped out we write a new \ps\ output
+file named according to the current \&{charcode}.
+@:char_code_}{\&{charcode} primitive@>
+
+@<Declare the \ps\ output procedures@>=
+procedure open_output_file;
+var @!c:integer; {\&{charcode} rounded to the nearest integer}
+@!old_setting:0..max_selector; {previous |selector| setting}
+@!s:str_number; {a file extension derived from |c|}
+begin if job_name=0 then open_log_file;
+c:=round_unscaled(internal[char_code]);
+if c<0 then s:=".ps"
+else @<Use |c| to compute the file extension |s|@>;
+pack_job_name(s);
+while not a_open_out(ps_file) do
+ prompt_file_name("file name for output",s);
+delete_str_ref(s);
+@<Store the true output file name if appropriate@>;
+@<Begin the progress report for the ouput of picture~|c|@>;
+end;
+
+@ The file extension created here could be up to five characters long in
+extreme cases so it may have to be shortened on some systems.
+@^system dependencies@>
+
+@<Use |c| to compute the file extension |s|@>=
+begin old_setting:=selector; selector:=new_string;
+print_char("."); print_int(c);
+s:=make_string;
+selector:=old_setting;
+end
+
+@ The user won't want to see all the output file names so we only save the
+first and last ones and a count of how many there were. For this purpose
+files are ordered primarily by \&{charcode} and secondarily by order of
+creation.
+@:char_code_}{\&{charcode} primitive@>
+
+@<Store the true output file name if appropriate@>=
+if (c<first_output_code)and(first_output_code>=0) then
+ begin first_output_code:=c;
+ delete_str_ref(first_file_name);
+ first_file_name:=a_make_name_string(ps_file);
+ end;
+if c>=last_output_code then
+ begin last_output_code:=c;
+ delete_str_ref(last_file_name);
+ last_file_name:=a_make_name_string(ps_file);
+ end
+
+@ @<Glob...@>=
+@!first_file_name,@!last_file_name:str_number; {full file names}
+@!first_output_code,@!last_output_code:integer; {rounded \&{charcode} values}
+@:char_code_}{\&{charcode} primitive@>
+@!total_shipped:integer; {total number of |ship_out| operations completed}
+
+@ @<Set init...@>=
+first_file_name:="";
+last_file_name:="";@/
+first_output_code:=32768;
+last_output_code:=-32768;@/
+total_shipped:=0;
+
+@ @<Begin the progress report for the ouput of picture~|c|@>=
+if term_offset>max_print_line-6 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("[");
+if c>=0 then print_int(c)
+
+@ @<End progress report@>=
+print_char("]");
+update_terminal;
+incr(total_shipped)
+
+@ @<Explain what output files were written@>=
+if total_shipped>0 then
+ begin print_nl("");
+ print_int(total_shipped);
+ print(" output file");
+ if total_shipped>1 then print_char("s");
+ print(" written: ");
+ print(first_file_name);
+ if total_shipped>1 then
+ begin if 31+length(first_file_name)+length(last_file_name)>@|
+ max_print_line
+ then print_ln;
+ print(" .. ");
+ print(last_file_name);
+ end;
+ end
+
+@ We often need to print a pair of coordinates.
+
+@d ps_room(#)==if ps_offset+#>max_print_line then print_ln {optional line break}
+
+@<Declare the \ps\ output procedures@>=
+procedure ps_pair_out(@!x,@!y:scaled);
+begin ps_room(26);
+print_scaled(x); print_char(" ");
+print_scaled(y); print_char(" ")
+end;
+
+@ @<Declare the \ps\ output procedures@>=
+procedure ps_print(@!s:str_number);
+begin ps_room(length(s));
+print(s);
+end;
+
+@ The most important output procedure is the one that gives the \ps\ version of
+a \MP\ path.
+
+@<Declare the \ps\ output procedures@>=
+procedure ps_path_out(@!h:pointer);
+label exit;
+var @!p,@!q:pointer; {for scanning the path}
+@!d:scaled; {a temporary value}
+@!curved:boolean; {|true| unless the cubic is almost straight}
+begin ps_room(40);
+if need_newpath then print("newpath ");
+need_newpath:=true;
+ps_pair_out(x_coord(h),y_coord(h));
+print("moveto");@/
+p:=h;
+repeat if right_type(p)=endpoint then
+ begin if p=h then ps_print(" 0 0 rlineto");
+ return;
+ end;
+q:=link(p);
+@<Start a new line and print the \ps\ commands for the curve from
+ |p| to~|q|@>;
+p:=q;
+until p=h;
+ps_print(" closepath");
+exit:end;
+
+@ @<Glob...@>=
+need_newpath:boolean;
+ {will |ps_path_out| need to issue a \&{newpath} command next time}
+@:newpath_}{\&{newpath} command@>
+
+@ @<Start a new line and print the \ps\ commands for the curve from...@>=
+curved:=true;
+@<Set |curved:=false| if the cubic from |p| to |q| is almost straight@>;
+print_ln;
+if curved then
+ begin ps_pair_out(right_x(p),right_y(p));
+ ps_pair_out(left_x(q),left_y(q));
+ ps_pair_out(x_coord(q),y_coord(q));
+ ps_print("curveto");
+ end
+else if q<>h then
+ begin ps_pair_out(x_coord(q),y_coord(q));
+ ps_print("lineto");
+ end
+
+@ Two types of straight lines come up often in \MP\ paths:
+cubics with zero initial and final velocity as created by |make_path| or
+|make_envelope|, and cubics with control points uniformly spaced on a line
+as created by |make_choices|.
+
+@d bend_tolerance=131 {allow rounding error of $2\cdot10^{-3}$}
+
+@<Set |curved:=false| if the cubic from |p| to |q| is almost straight@>=
+if right_x(p)=x_coord(p) then
+ if right_y(p)=y_coord(p) then
+ if left_x(q)=x_coord(q) then
+ if left_y(q)=y_coord(q) then curved:=false;
+d:=left_x(q)-right_x(p);
+if abs(right_x(p)-x_coord(p)-d)<=bend_tolerance then
+ if abs(x_coord(q)-left_x(q)-d)<=bend_tolerance then
+ begin d:=left_y(q)-right_y(p);
+ if abs(right_y(p)-y_coord(p)-d)<=bend_tolerance then
+ if abs(y_coord(q)-left_y(q)-d)<=bend_tolerance then curved:=false;
+ end
+
+@ We need to keep track of several parameters from the \ps\ graphics state.
+@^graphics state@>
+This allows us to be sure that \ps\ has the correct values when they are
+needed without wasting time and space setting them unnecessarily.
+
+@<Glob...@>=
+@!gs_red,@!gs_green,@!gs_blue:scaled;
+ {color from the last \&{setrgbcolor} or \&{setgray} command}
+@:setrgbcolor}{\&{setrgbcolor} command@>
+@:setgray}{\&{setgray} command@>
+@!gs_ljoin,@!gs_lcap:quarterword;
+ {values from the last \&{setlinejoin} and \&{setlinecap} commands}
+@:setlinejoin}{\&{setlinejoin} command@>
+@:setlinecap}{\&{setlinecap} command@>
+@!gs_miterlim:scaled; {the value from the last \&{setmiterlimit} command}
+@:setmiterlimit}{\&{setmiterlimit} command@>
+@!gs_dash_p:pointer; {edge structure for last \&{setdash} command}
+@:setdash}{\&{setdash} command@>
+@!gs_dash_sc:scaled; {scale factor used with |gs_dash_p|}
+@!gs_width:scaled; {width setting or $-1$ if no \&{setlinewidth} command so far}
+@!gs_adj_wx:boolean; {what resolution-dependent adjustment applies to the width}
+@:setlinewidth}{\&{setlinewidth} command@>
+
+@ To avoid making undue assumptions about the initial graphics state, these
+parameters are given special values that are guaranteed not to match anything
+in the edge structure being shipped out. On the other hand, the initial color
+should be black so that the translation of an all-black picture will have no
+\&{setcolor} commands. (These would be undesirable in a font application.)
+Hence we use |c=0| when initializing the graphics state and we use |c<0|
+to recover from a situation where we have lost track of the graphics state.
+
+@<Declare the \ps\ output procedures@>=
+procedure unknown_graphics_state(c:scaled);
+begin gs_red:=c; gs_green:=c; gs_blue:=c;@/
+gs_ljoin:=3;
+gs_lcap:=3;
+gs_miterlim:=0;@/
+gs_dash_p:=void;
+gs_dash_sc:=0;
+gs_width:=-1;
+end;
+
+@ When it is time to output a graphical object, |fix_graphics_state| ensures
+that \ps's idea of the graphics state agrees with what is stored in the object.
+
+@<Declare the \ps\ output procedures@>=
+@<Declare subroutines needed by |fix_graphics_state|@>@;
+procedure fix_graphics_state(p:pointer);
+ {get ready to output graphical object |p|}
+var @!hh,@!pp:pointer; {for list manipulation}
+@!wx,@!wy,@!ww:scaled; {dimensions of pen bounding box}
+@!adj_wx:boolean; {whether pixel rounding should be based on |wx| or |wy|}
+@!tx,@!ty:integer; {temporaries for computing |adj_wx|}
+@!scf:scaled; {a scale factor for the dash pattern}
+begin if has_color(p) then
+ @<Make sure \ps\ will use the right color for object~|p|@>;
+if (type(p)=fill_code)or(type(p)=stroked_code) then
+ if pen_p(p)<>null then
+ if pen_is_elliptical(pen_p(p)) then
+ begin @<Generate \ps\ code that sets the stroke width to the
+ appropriate rounded value@>;
+ @<Make sure \ps\ will use the right dash pattern for |dash_p(p)|@>;
+ @<Decide whether the line cap parameter matters and set it if necessary@>;
+ @<Set the other numeric parameters as needed for object~|p|@>;
+ end;
+if ps_offset>0 then print_ln;
+end;
+
+@ @<Decide whether the line cap parameter matters and set it if necessary@>=
+if type(p)=stroked_code then
+ if (left_type(path_p(p))=endpoint)or(dash_p(p)<>null) then
+ if gs_lcap<>lcap_val(p) then
+ begin ps_room(13);
+ print_char(" ");
+ print_char("0"+lcap_val(p)); print(" setlinecap");
+ gs_lcap:=lcap_val(p);
+ end
+
+@ @<Set the other numeric parameters as needed for object~|p|@>=
+if gs_ljoin<>ljoin_val(p) then
+ begin ps_room(14);
+ print_char(" ");
+ print_char("0"+ljoin_val(p)); print(" setlinejoin");
+ gs_ljoin:=ljoin_val(p);
+ end;
+if gs_miterlim<>miterlim_val(p) then
+ begin ps_room(27);
+ print_char(" ");
+ print_scaled(miterlim_val(p)); print(" setmiterlimit");
+ gs_miterlim:=miterlim_val(p);
+ end
+
+@ @<Make sure \ps\ will use the right color for object~|p|@>=
+if (gs_red<>red_val(p))or(gs_green<>green_val(p))or@|
+ (gs_blue<>blue_val(p)) then
+ begin gs_red:=red_val(p);
+ gs_green:=green_val(p);
+ gs_blue:=blue_val(p);@/
+ if (gs_red=gs_green)and(gs_green=gs_blue) then
+ begin ps_room(16);
+ print_char(" ");
+ print_scaled(gs_red);
+ print(" setgray");
+ end
+ else begin ps_room(36);
+ print_char(" ");
+ print_scaled(gs_red); print_char(" ");
+ print_scaled(gs_green); print_char(" ");
+ print_scaled(gs_blue);
+ print(" setrgbcolor");
+ end;
+ end;
+
+@ In order to get consistent widths for horizontal and vertical pen strokes, we
+want \ps\ to use an integer number of pixels for the \&{setwidth} parameter.
+@:setwidth}{\&{setwidth}command@>
+We set |gs_width| to the ideal horizontal or vertical stroke width and then
+generate \ps\ code that computes the rounded value. For non-circular pens, the
+pen shape will be rescaled so that horizontal or vertical parts of the stroke
+have the computed width.
+
+Rounding the width to whole pixels is not likely to improve the appearance of
+diagonal or curved strokes, but we do it anyway for consistency. The
+\&{truncate} command generated here tends to make all the strokes a little
+@:truncate}{\&{truncate} command@>
+thinner, but this is appropriate for \ps's scan-conversion rules. Even with
+truncation, an ideal with of $w$~pixels gets mapped into $\lfloor w\rfloor+1$.
+It would be better to have $\lceil w\rceil$ but that is ridiculously expensive
+to compute in \ps.
+
+@<Generate \ps\ code that sets the stroke width...@>=
+@<Set |wx| and |wy| to the width and height of the bounding box for
+ |pen_p(p)|@>;
+@<Use |pen_p(p)| and |path_p(p)| to decide whether |wx| or |wy| is more
+ important and set |adj_wx| and |ww| accordingly@>;
+if (ww<>gs_width) or (adj_wx<>gs_adj_wx) then
+ begin if adj_wx then
+ begin ps_room(13);
+ print_char(" "); print_scaled(ww);
+ ps_print(" 0 dtransform exch truncate exch idtransform pop setlinewidth");
+ end
+ else begin ps_room(15);
+ print(" 0 "); print_scaled(ww);
+ ps_print(" dtransform truncate idtransform setlinewidth pop");
+ end;
+ gs_width := ww;
+ gs_adj_wx := adj_wx;
+ end
+
+@ @<Set |wx| and |wy| to the width and height of the bounding box for...@>=
+pp:=pen_p(p);
+if (right_x(pp)=x_coord(pp)) and (left_y(pp)=y_coord(pp)) then
+ begin wx := abs(left_x(pp) - x_coord(pp));
+ wy := abs(right_y(pp) - y_coord(pp));
+ end
+else begin
+ wx := pyth_add(left_x(pp)-x_coord(pp), right_x(pp)-x_coord(pp));
+ wy := pyth_add(left_y(pp)-y_coord(pp), right_y(pp)-y_coord(pp));
+ end
+
+@ The path is considered ``essentially horizontal'' if its range of
+$y$~coordinates is less than the $y$~range |wy| for the pen. ``Essentially
+vertical'' paths are detected similarly. This code ensures that no component
+of the pen transformation is more that |aspect_bound*(ww+1)|.
+
+@d aspect_bound=10 {``less important'' of |wx|, |wy| cannot exceed the other by
+ more than this factor}
+
+@<Use |pen_p(p)| and |path_p(p)| to decide whether |wx| or |wy| is more...@>=
+tx:=1; ty:=1;
+if coord_rangeOK(path_p(p), y_loc(0), wy) then tx:=aspect_bound
+else if coord_rangeOK(path_p(p), x_loc(0), wx) then ty:=aspect_bound;
+if wy div ty>=wx div tx then
+ begin ww:=wy; adj_wx:=false;
+ end
+else begin ww:=wx; adj_wx:=true;
+ end
+
+@ This routine quickly tests if path |h| is ``essentially horizontal'' or
+``essentially vertical,'' where |zoff| is |x_loc(0)| or |y_loc(0)| and |dz| is
+allowable range for $x$ or~$y$. We do not need and cannot afford a full
+bounding-box computation.
+
+@<Declare subroutines needed by |fix_graphics_state|@>=
+function coord_rangeOK(@!h:pointer; @!zoff:small_number; dz:scaled):boolean;
+label found, not_found, exit;
+var @!p:pointer; {for scanning the path form |h|}
+ @!zlo,@!zhi:scaled; {coordinate range so far}
+ @!z:scaled; {coordinate currently being tested}
+begin zlo:=knot_coord(h+zoff);
+zhi:=zlo;
+p:=h;
+while right_type(p)<>endpoint do
+ begin z:=right_coord(p+zoff);@/
+ @<Make |zlo..zhi| include |z| and |goto found| if |zhi-zlo>dz|@>;
+ p:=link(p);
+ z:=left_coord(p+zoff);@/
+ @<Make |zlo..zhi| include |z| and |goto found| if |zhi-zlo>dz|@>;
+ z:=knot_coord(p+zoff);@/
+ @<Make |zlo..zhi| include |z| and |goto found| if |zhi-zlo>dz|@>;
+ if p=h then goto not_found;
+ end;
+not_found:coord_rangeOK:=true;
+return;
+found:coord_rangeOK:=false;
+exit:end;
+
+@ @<Make |zlo..zhi| include |z| and |goto found| if |zhi-zlo>dz|@>=
+if z<zlo then zlo:=z
+else if z>zhi then zhi:=z;
+if zhi-zlo>dz then goto found
+
+@ Filling with an elliptical pen is implemented via a combination of \&{stroke}
+and \&{fill} commands and a nontrivial dash pattern would interfere with this.
+@:stroke}{\&{stroke} command@>
+@:fill}{\&{fill} command@>
+Note that we don't use |delete_edge_ref| because |gs_dash_p| is not counted as
+a reference.
+
+@<Make sure \ps\ will use the right dash pattern for |dash_p(p)|@>=
+if type(p)=fill_code then hh:=null
+else begin hh:=dash_p(p);
+ scf:=get_pen_scale(pen_p(p));
+ if scf=0 then
+ if gs_width=0 then scf:=dash_scale(p) @+else hh:=null
+ else begin scf:=make_scaled(gs_width,scf);
+ scf:=take_scaled(scf,dash_scale(p));
+ end;
+ end;
+if hh=null then
+ begin if gs_dash_p<>null then
+ begin ps_print(" [] 0 setdash");
+ gs_dash_p:=null;
+ end;
+ end
+else if (gs_dash_sc<>scf) or not same_dashes(gs_dash_p,hh) then
+ @<Set the dash pattern from |dash_list(hh)| scaled by |scf|@>
+
+@ Translating a dash list into \ps\ is very similar to printing it symbolically
+in |print_edges|. A dash pattern with |dash_y(hh)=0| has length zero and is
+ignored. The same fate applies in the bizarre case of a dash pattern that
+cannot be printed without overflow.
+
+@<Set the dash pattern from |dash_list(hh)| scaled by |scf|@>=
+begin gs_dash_p:=hh;
+gs_dash_sc:=scf;
+if (dash_y(hh)=0) or (abs(dash_y(hh)) div unity >= el_gordo div scf) then
+ ps_print(" [] 0 setdash")
+else begin pp:=dash_list(hh);
+ start_x(null_dash):=start_x(pp)+dash_y(hh);@/
+ ps_room(28);
+ print(" [");
+ while pp<>null_dash do
+ begin ps_pair_out(take_scaled(stop_x(pp)-start_x(pp),scf),@|
+ take_scaled(start_x(link(pp))-stop_x(pp),scf));
+ pp:=link(pp);
+ end;
+ ps_room(22);
+ print("] ");
+ print_scaled(take_scaled(dash_offset(hh),scf));
+ print(" setdash");
+ end;
+end
+
+@ @<Declare subroutines needed by |fix_graphics_state|@>=
+function same_dashes(@!h,@!hh:pointer):boolean;
+ {do |h| and |hh| represent the same dash pattern?}
+label done;
+var @!p,@!pp:pointer; {dash nodes being compared}
+begin if h=hh then same_dashes:=true
+else if (h<=void)or(hh<=void) then same_dashes:=false
+else if dash_y(h)<>dash_y(hh) then same_dashes:=false
+else @<Compare |dash_list(h)| and |dash_list(hh)|@>;
+end;
+
+@ @<Compare |dash_list(h)| and |dash_list(hh)|@>=
+begin p:=dash_list(h);
+pp:=dash_list(hh);
+while (p<>null_dash)and(pp<>null_dash) do
+ if (start_x(p)<>start_x(pp))or(stop_x(p)<>stop_x(pp)) then goto done
+ else begin p:=link(p);
+ pp:=link(pp);
+ end;
+done:same_dashes:=p=pp;
+end
+
+@ When stroking a path with an elliptical pen, it is necessary to transform
+the coordinate system so that a unit circular pen will have the desired shape.
+To keep this transformation local, we enclose it in a
+$$\&{gsave}\ldots\&{grestore}$$
+block. Any translation component must be applied to the path being stroked
+while the rest of the transformation must apply only to the pen.
+If |fill_also=true|, the path is to be filled as well as stroked so we must
+insert commands to do this after giving the path.
+
+@<Declare the \ps\ output procedures@>=
+procedure stroke_ellipse(@!h:pointer;@!fill_also:boolean);
+ {generate an elliptical pen stroke from object |h|}
+var @!txx,@!txy,@!tyx,@!tyy:scaled; {transformation parameters}
+@!p:pointer; {the pen to stroke with}
+@!d1,@!det:scaled; {for tweaking transformation parameters}
+@!s:integer; {also for tweaking transformation paramters}
+@!transformed:boolean; {keeps track of whether gsave/grestore are needed}
+begin transformed:=false;@/
+@<Use |pen_p(h)| to set the transformation parameters and give the initial
+ translation@>;
+@<Tweak the transformation parameters so the transformation is nonsingular@>;
+ps_path_out(path_p(h));@/
+if fill_also then print_nl("gsave fill grestore");
+@<Issue \ps\ commands to transform the coordinate system@>;
+ps_print(" stroke");
+if transformed then ps_print(" grestore");
+print_ln;
+end;
+
+@ @<Use |pen_p(h)| to set the transformation parameters and give the...@>=
+p:=pen_p(h);
+txx:=left_x(p);
+tyx:=left_y(p);@/
+txy:=right_x(p);
+tyy:=right_y(p);
+if (x_coord(p)<>0)or(y_coord(p)<>0) then
+ begin print_nl("gsave ");
+ ps_pair_out(x_coord(p),y_coord(p));
+ ps_print("translate ");@/
+ txx:=txx-x_coord(p);
+ tyx:=tyx-y_coord(p);@/
+ txy:=txy-x_coord(p);
+ tyy:=tyy-y_coord(p);
+ transformed:=true;
+ end
+else print_nl("");
+@<Adjust the transformation to account for |gs_width| and output the
+ initial \&{gsave} if |transformed| should be |true|@>
+
+@ @<Adjust the transformation to account for |gs_width| and output the...@>=
+if gs_width<>unity then
+ if gs_width=0 then
+ begin txx:=unity; tyy:=unity;
+ end
+ else begin txx:=make_scaled(txx,gs_width);
+ txy:=make_scaled(txy,gs_width);
+ tyx:=make_scaled(tyx,gs_width);
+ tyy:=make_scaled(tyy,gs_width);
+ end;
+if (txy<>0)or(tyx<>0)or(txx<>unity)or(tyy<>unity) then
+ if (not transformed) then
+ begin ps_print("gsave ");
+ transformed:=true;
+ end
+
+@ @<Issue \ps\ commands to transform the coordinate system@>=
+if (txy<>0)or(tyx<>0) then
+ begin print_ln;
+ print_char("[");
+ ps_pair_out(txx,tyx);
+ ps_pair_out(txy,tyy);@/
+ ps_print("0 0] concat");
+ end
+else if (txx<>unity)or(tyy<>unity) then
+ begin print_ln;
+ ps_pair_out(txx,tyy);
+ print("scale");
+ end
+
+@ The \ps\ interpreter will probably abort if it encounters a singular
+transformation matrix. The determinant must be large enough to ensure that
+the printed representation will be nonsingular. Since the printed
+representation is always within $2^{-17}$ of the internal |scaled| value, the
+total error is at most $4T_{\rm max}2^{-17}$, where $T_{\rm max}$ is a bound on
+the magnitudes of |txx/65536|, |txy/65536|, etc.
+
+The |aspect_bound*(gs_width+1)| bound on the components of the pen
+transformation allows $T_{\rm max}$ to be at most |2*aspect_bound|.
+
+@<Tweak the transformation parameters so the transformation is nonsingular@>=
+det:=take_scaled(txx,tyy) - take_scaled(txy,tyx);
+d1:=4*aspect_bound+1;
+if abs(det)<d1 then
+ begin if det>=0 then
+ begin d1:=d1-det; s:=1; @+end
+ else begin d1:=-d1-det; s:=-1; @+end;
+ d1:=d1*unity;
+ if abs(txx)+abs(tyy)>=abs(txy)+abs(tyy) then
+ if abs(txx)>abs(tyy) then tyy:=tyy+(d1+s*abs(txx)) div txx
+ else txx:=txx+(d1+s*abs(tyy)) div tyy
+ else if abs(txy)>abs(tyx) then tyx:=tyx+(d1+s*abs(txy)) div txy
+ else txy:=txy+(d1+s*abs(tyx)) div tyx;
+ end
+
+@ Here is a simple routine that just fills a cycle.
+
+@<Declare the \ps\ output procedures@>=
+procedure ps_fill_out(@!p:pointer); {fill cyclic path~|p|}
+begin ps_path_out(p);
+ps_print(" fill");
+print_ln;
+end;
+
+@ Given a cyclic path~|p| and a graphical object~|h|, the |do_outer_envelope|
+procedure fills the cycle generated by |make_envelope|. It need not do
+anything unless some region has positive winding number with respect to~|p|,
+but it does not seem worthwhile to for test this.
+
+@<Declare the \ps\ output procedures@>=
+procedure do_outer_envelope(@!p,@!h:pointer);
+begin p:=make_envelope(p, pen_p(h), ljoin_val(h), 0, miterlim_val(h));
+ps_fill_out(p);
+toss_knot_list(p);
+end;
+
+@ A text node may specify an arbitrary transformation but the usual case
+involves only shifting, scaling, and occasionally rotation. The purpose
+of |choose_scale| is to select a scale factor so that the remaining
+transformation is as ``nice'' as possible. The definition of ``nice''
+is somewhat arbitrary but shifting and $90^\circ$ rotation are especially
+nice because they work out well for bitmap fonts. The code here selects
+a scale factor equal to $1/\sqrt2$ times the Frobenius norm of the
+non-shifting part of the transformation matrix. It is careful to avoid
+additions that might cause undetected overflow.
+
+@<Declare the \ps\ output procedures@>=
+function choose_scale(@!p:pointer):scaled; {|p| should point to a text node}
+var @!a,@!b,@!c,@!d,@!ad,@!bc:scaled; {temporary values}
+begin a:=txx_val(p);
+b:=txy_val(p);
+c:=tyx_val(p);
+d:=tyy_val(p);@/
+if (a<0) then negate(a);
+if (b<0) then negate(b);
+if (c<0) then negate(c);
+if (d<0) then negate(d);
+ad:=half(a-d);
+bc:=half(b-c);@/
+choose_scale:=pyth_add(pyth_add(d+ad,ad), pyth_add(c+bc,bc));
+end;
+
+@ @<Declare the \ps\ output procedures@>=
+procedure ps_string_out(s:str_number);
+var @!i:pool_pointer; {current character code position}
+@!k:ASCII_code; {bits to be converted to octal}
+begin print("(");
+i:=str_start[s];
+while i<str_stop(s) do
+ begin if ps_offset+5>max_print_line then
+ begin print_char("\");
+ print_ln;
+ end;
+ k:=so(str_pool[i]);
+ if (@<Character |k| is not allowed in PostScript output@>) then
+ begin print_char("\");
+ print_char("0"+(k div 64));
+ print_char("0"+((k div 8) mod 8));
+ print_char("0"+(k mod 8));
+ end
+ else begin if (k="(")or(k=")")or(k="\") then print_char("\");
+ print_char(k);
+ end;
+ incr(i);
+ end;
+print(")");
+end;
+
+@ @<Declare the \ps\ output procedures@>=
+function is_ps_name(@!s:str_number):boolean;
+label not_found,exit;
+var @!i:pool_pointer; {current character code position}
+@!k:ASCII_code; {the character being checked}
+begin i:=str_start[s];
+while i<str_stop(s) do
+ begin k:=so(str_pool[i]);
+ if (k<=" ")or(k>"~") then goto not_found;
+ if (k="(")or(k=")")or(k="<")or(k=">")or@|
+ (k="{")or(k="}")or(k="/")or(k="%") then goto not_found;
+ incr(i);
+ end;
+is_ps_name:=true;
+return;
+not_found:is_ps_name:=false;
+exit:end;
+
+@ @<Declare the \ps\ output procedures@>=
+procedure ps_name_out(@!s:str_number;@!lit:boolean);
+begin ps_room(length(s)+2);
+print_char(" ");
+if is_ps_name(s) then
+ begin if lit then print_char("/");
+ print(s);
+ end
+ else begin ps_string_out(s);
+ if not lit then ps_print("cvx ");
+ ps_print("cvn");
+ end;
+end;
+
+@ We also need to keep track of which characters are used in text nodes
+in the edge structure that is being shipped out. This is done by procedures
+that use the left-over |b3| field in the |char_info| words; i.e.,
+|char_info(f)(c).b3| gives the status of character |c| in font |f|.
+
+@d unused=0
+@d used=1
+
+@ @<Declare the \ps\ output procedures@>=
+procedure unmark_font(@!f:font_number);
+var @!k:0..font_mem_size; {an index into |font_info|}
+begin for k:= char_base[f]+si(font_bc[f]) to char_base[f]+si(font_ec[f]) do
+ font_info[k].qqqq.b3:=unused;
+end;
+
+@ @<Declare the \ps\ output procedures@>=
+procedure mark_string_chars(@!f:font_number;@!s:str_number);
+var @!b:integer; {|char_base[f]|}
+@!bc,@!ec:pool_ASCII_code; {only characters between these bounds are marked}
+@!k:pool_pointer; {an index into string |s|}
+begin b:=char_base[f];
+bc:=si(font_bc[f]);
+ec:=si(font_ec[f]);@/
+k:=str_stop(s);
+while k>str_start[s] do
+ begin decr(k);
+ if (str_pool[k]>=bc)and(str_pool[k]<=ec) then
+ font_info[b+str_pool[k]].qqqq.b3:=used;
+ end
+end;
+
+@ @<Declare the \ps\ output procedures@>=
+procedure hex_digit_out(@!d:small_number);
+begin if d<10 then print_char(d+"0")
+else print_char(d+"a"-10);
+end;
+
+@ We output the marks as a hexadecimal bit string starting at |c| or
+|font_bc[f]|, whichever is greater. If the output has to be truncated
+to avoid exceeding |emergency_line_length| the return value says where to
+start scanning next time.
+
+@<Declare the \ps\ output procedures@>=
+function ps_marks_out(@!f:font_number;@!c:eight_bits):halfword;
+var @!bc,@!ec:eight_bits; {only encode characters between these bounds}
+@!lim:integer; {the maximum number of marks to encode before truncating}
+@!p:0..font_mem_size; {|font_info| index for the current character}
+@!d,@!b:0..15; {used to construct a hexadecimal digit}
+begin lim:=4*(emergency_line_length-ps_offset-4);
+bc:=font_bc[f];
+ec:=font_ec[f];
+if c>bc then bc:=c;
+@<Restrict the range |bc..ec| so that it contains no unused characters
+ at either end and has length at most |lim|@>;
+@<Print the initial label indicating that the bitmap starts at |bc|@>;
+@<Print a hexadecimal encoding of the marks for characters |bc..ec|@>;
+while (ec<font_ec[f])and(font_info[p].qqqq.b3=unused) do
+ begin incr(p); incr(ec);
+ end;
+ps_marks_out:=ec+1;
+end;
+
+@ We could save time by setting the return value before the loop that
+decrements |ec|, but there is no point in being so tricky.
+
+@<Restrict the range |bc..ec| so that it contains no unused characters...@>=
+p:=char_base[f]+si(bc);
+while (font_info[p].qqqq.b3=unused)and(bc<ec) do
+ begin incr(p); incr(bc);
+ end;
+if ec>=bc+lim then ec:=bc+lim-1;
+p:=char_base[f]+si(ec);
+while (font_info[p].qqqq.b3=unused)and(bc<ec) do
+ begin decr(p); decr(ec);
+ end;
+
+@ @<Print the initial label indicating that the bitmap starts at |bc|@>=
+print_char(" ");
+hex_digit_out(bc div 16);
+hex_digit_out(bc mod 16);
+print_char(":")
+
+@ @<Print a hexadecimal encoding of the marks for characters |bc..ec|@>=
+b:=8; d:=0;
+for p:=char_base[f]+si(bc) to char_base[f]+si(ec) do
+ begin if b=0 then
+ begin hex_digit_out(d);
+ d:=0; b:=8;
+ end;
+ if font_info[p].qqqq.b3<>unused then d:=d+b;
+ b:=halfp(b);
+ end;
+hex_digit_out(d)
+
+@ Here is a simple function that determines whether there are any marked
+characters in font~|f| with character code at least~|c|.
+
+@<Declare the \ps\ output procedures@>=
+function check_ps_marks(@!f:font_number; @!c:integer):boolean;
+label exit;
+var @!p:0..font_mem_size; {|font_info| index for the current character}
+begin for p:=char_base[f]+si(c) to char_base[f]+si(font_ec[f]) do
+ if font_info[p].qqqq.b3=used then
+ begin check_ps_marks:=true; return;
+ end;
+check_ps_marks:=false;
+exit: end;
+
+@ There may be many sizes of one font and we need to keep track of the
+characters used for each size. This is done by keeping a linked list of
+sizes for each font with a counter in each text node giving the appropriate
+position in the size list for its font.
+
+@d sc_factor(#)==mem[#+1].sc {the scale factor stored in a font size node}
+@d font_size_size=2 {size of a font size node}
+
+@<Glob...@>=
+font_sizes:array[font_number] of pointer;
+
+@ @d fscale_tolerance==65 {that's $.001\times2^{16}$}
+
+@<Declare the \ps\ output procedures@>=
+function size_index(@!f:font_number;@!s:scaled):quarterword;
+label found;
+var @!p,@!q:pointer; {the previous and current font size nodes}
+@!i:quarterword; {the size index for |q|}
+begin q:=font_sizes[f];
+i:=0;
+while q<>null do
+ begin if abs(s-sc_factor(q))<=fscale_tolerance then goto found
+ else begin p:=q; q:=link(q);
+ incr(i);
+ end;
+ if i=max_quarterword then
+ overflow("sizes per font",max_quarterword);
+@:MetaPost capacity exceeded sizes per font}{\quad sizes per font@>
+ end;
+q:=get_node(font_size_size);
+sc_factor(q):=s;
+if i=0 then font_sizes[f]:=q @+else link(p):=q;
+found:size_index:=i;
+end;
+
+@ @<Declare the \ps\ output procedures@>=
+function indexed_size(@!f:font_number;@!j:quarterword):scaled;
+var @!p:pointer; {a font size node}
+@!i:quarterword; {the size index for |p|}
+begin p:=font_sizes[f];
+i:=0;
+if p=null then confusion("size");
+while (i<>j) do
+ begin incr(i); p:=link(p);
+ if p=null then confusion("size");
+ end;
+indexed_size:=sc_factor(p);
+end;
+
+@ @<Declare the \ps\ output procedures@>=
+procedure clear_sizes;
+var @!f:font_number; {the font whose size list is being cleared}
+@!p:pointer; {current font size nodes}
+begin for f:=null_font+1 to last_fnum do
+ while font_sizes[f]<>null do
+ begin p:=font_sizes[f];
+ font_sizes[f]:=link(p);
+ free_node(p,font_size_size);
+ end;
+end;
+
+@ The \&{special} command saves up lines of text to be printed during the next
+|ship_out| operation. The saved items are stored as a list of capsule tokens.
+
+@<Glob...@>=
+@!last_pending:pointer; {the last token in a list of pending specials}
+
+@ @<Set init...@>=
+last_pending:=spec_head;
+
+@ @<Cases of |do_statement|...@>=
+special_command:do_special;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+procedure do_special;
+begin get_x_next; scan_expression;
+if cur_type<>string_type then @<Complain about improper special operation@>
+else begin link(last_pending):=stash_cur_exp;
+ last_pending:=link(last_pending);
+ link(last_pending):=null;
+ end;
+end;
+
+@ @<Complain about improper special operation@>=
+begin exp_err("Unsuitable expression");
+help1("Only known strings are allowed for output as specials.");
+put_get_error;
+end
+
+@ @<Print any pending specials@>=
+t:=link(spec_head);
+while t<>null do
+ begin if length(value(t))<=emergency_line_length then print(value(t))
+ else overflow("output line length",emergency_line_length);
+@:MetaPost capacity exceeded output line length}{\quad output line length@>
+ print_ln;
+ t:=link(t);
+ end;
+flush_token_list(link(spec_head));
+link(spec_head):=null;
+last_pending:=spec_head
+
+@ We are now ready for the main output procedure. Note that the |selector|
+setting is saved in a global variable so that |begin_diagnostic| can access it.
+
+@<Declare the \ps\ output procedures@>=
+procedure ship_out(@!h:pointer); {output edge structure |h|}
+label done,found;
+var @!p:pointer; {the current graphical object}
+@!q:pointer; {something that |p| points to}
+@!t:integer; {a temporary value}
+@!f,ff:font_number; {fonts used in a text node or as loop counters}
+@!ldf:font_number; {the last \.{DocumentFont} listed (otherwise |null_font|)}
+@!done_fonts:boolean; {have we finished listing the fonts in the header?}
+@!next_size:quarterword; {the size index for fonts being listed}
+@!cur_fsize:array[font_number] of pointer; {current positions in |font_sizes|}
+@!ds,@!scf:scaled; {design size and scale factor for a text node}
+@!transformed:boolean; {is the coordinate system being transformed?}
+begin open_output_file;
+if (internal[prologues]>0) and (last_ps_fnum<last_fnum) then
+ read_psname_table;
+non_ps_setting:=selector; selector:=ps_file_only;@/
+@<Print the initial comment and give the bounding box for edge structure~|h|@>;
+print("%%BeginProlog"); print_ln;
+if internal[prologues]>0 then @<Print the prologue@>;
+print("%%EndProlog");
+print_nl("%%Page: 1 1"); print_ln;
+@<Print any pending specials@>;
+unknown_graphics_state(0);
+need_newpath:=true;
+p:=link(dummy_loc(h));
+while p<>null do
+ begin fix_graphics_state(p);
+ case type(p) of
+ @<Cases for translating graphical object~|p| into \ps@>@;
+ start_bounds_code,stop_bounds_code: do_nothing;
+ end; {all cases are enumerated}
+ p:=link(p);
+ end;
+print("showpage"); print_ln;
+print("%%EOF"); print_ln;
+a_close(ps_file);
+selector:=non_ps_setting;
+if internal[prologues]<=0 then clear_sizes;
+@<End progress report@>;
+if internal[tracing_output]>0 then print_edges(h," (just shipped out)",true);
+end;
+
+@ These special comments described in the {\sl PostScript Language Reference
+Manual}, 2nd.~edition are understood by some \ps-reading programs.
+We can't normally output ``conforming'' \ps\ because
+the structuring conventions don't allow us to say ``Please make sure the
+following characters are downloaded and define the \.{fshow} macro to access
+them.''
+
+The exact bounding box is written out if |prologues<0|, although this
+is not standard \ps, since it allows \TeX\ to calculate the box dimensions
+accurately. (Overfull boxes are avoided if an illustration is made to
+match a given \.{\char`\\hsize}.)
+
+@<Print the initial comment and give the bounding box for edge...@>=
+print("%!PS");
+if internal[prologues]>0 then print("-Adobe-3.0 EPSF-3.0");
+print_nl("%%BoundingBox: ");
+set_bbox(h,true);
+if minx_val(h)>maxx_val(h) then print("0 0 0 0")
+else if internal[prologues]<0 then
+ begin ps_pair_out(minx_val(h),miny_val(h));
+ ps_pair_out(maxx_val(h),maxy_val(h));
+ end
+else begin ps_pair_out(floor_scaled(minx_val(h)),floor_scaled(miny_val(h)));
+ ps_pair_out(-floor_scaled(-maxx_val(h)),-floor_scaled(-maxy_val(h)));
+ end;
+print_nl("%%HiResBoundingBox: ");
+if minx_val(h)>maxx_val(h) then print("0 0 0 0")
+else begin
+ ps_pair_out(minx_val(h),miny_val(h));
+ ps_pair_out(maxx_val(h),maxy_val(h));
+ end;
+print_nl("%%Creator: MetaPost ");
+print(metapost_version);
+print_nl("%%CreationDate: ");
+print_int(round_unscaled(internal[year])); print_char(".");
+print_dd(round_unscaled(internal[month])); print_char(".");
+print_dd(round_unscaled(internal[day])); print_char(":");@/
+t:=round_unscaled(internal[time]);
+print_dd(t div 60); print_dd(t mod 60);@/
+print_nl("%%Pages: 1");@/
+@<List all the fonts and magnifications for edge structure~|h|@>;
+print_ln
+
+@ @<List all the fonts and magnifications for edge structure~|h|@>=
+@<Scan all the text nodes and set the |font_sizes| lists;
+ if |internal[prologues]<=0| list the sizes selected by |choose_scale|,
+ apply |unmark_font| to each font encountered, and call |mark_string|
+ whenever the size index is zero@>;
+if internal[prologues]>0 then
+ @<Give a \.{DocumentFonts} comment listing all fonts with non-null
+ |font_sizes| and eliminate duplicates@>
+else begin next_size:=0;
+ @<Make |cur_fsize| a copy of the |font_sizes| array@>;
+ repeat done_fonts:=true;
+ for f:=null_font+1 to last_fnum do
+ begin if cur_fsize[f]<>null then
+ @<Print the \.{\%*Font} comment for font |f| and advance |cur_fsize[f]|@>;
+ if cur_fsize[f]<>null then
+ begin unmark_font(f); done_fonts:=false; @+end;
+ end;
+ if not done_fonts then
+ @<Increment |next_size| and apply |mark_string_chars| to all text nodes with
+ that size index@>;
+ until done_fonts;
+ end
+
+@ @<Make |cur_fsize| a copy of the |font_sizes| array@>=
+for f:=null_font+1 to last_fnum do
+ cur_fsize[f]:=font_sizes[f]
+
+@ It's not a good idea to make any assumptions about the |font_ps_name| entries,
+so we carefully remove duplicates. There is no harm in using a slow, brute-force
+search.
+
+@<Give a \.{DocumentFonts} comment listing all fonts with non-null...@>=
+begin ldf:=null_font;
+for f:=null_font+1 to last_fnum do
+ if font_sizes[f]<>null then
+ begin if ldf=null_font then print_nl("%%DocumentFonts:");
+ for ff:=ldf downto null_font do
+ if font_sizes[ff]<>null then
+ if str_vs_str(font_ps_name[f],font_ps_name[ff])=0 then
+ goto found;
+ if ps_offset+1+length(font_ps_name[f])>max_print_line then
+ print_nl("%%+");
+ print_char(" ");
+ print(font_ps_name[f]);
+ ldf:=f;
+ found:
+ end;
+end
+
+@ @<Scan all the text nodes and set the |font_sizes| lists;...@>=
+for f:=null_font+1 to last_fnum do font_sizes[f]:=null;
+p:=link(dummy_loc(h));
+while p<>null do
+ begin if type(p)=text_code then
+ if font_n(p)<>null_font then
+ begin f:=font_n(p);
+ if internal[prologues]>0 then font_sizes[f]:=void
+ else begin if font_sizes[f]=null then unmark_font(f);
+ name_type(p):=size_index(f,choose_scale(p));
+ if name_type(p)=0 then
+ mark_string_chars(f,text_p(p));
+ end;
+ end;
+ p:=link(p);
+ end
+
+@ If the file name is so long that it can't be printed without exceeding
+|emergency_line_length| then there will be missing items in the \.{\%*Font:}
+line. We might have to repeat line in order to get the character usage
+information to fit within |emergency_line_length|.
+
+@<Print the \.{\%*Font} comment for font |f| and advance |cur_fsize[f]|@>=
+begin t:=0;
+while check_ps_marks(f,t) do
+ begin print_nl("%*Font: ");
+ if ps_offset+length(font_name[f])+12>emergency_line_length then
+ goto done;
+ print(font_name[f]);
+ print_char(" ");
+ ds:=(font_dsize[f] + 8) div 16;
+ print_scaled(take_scaled(ds,sc_factor(cur_fsize[f])));
+ if ps_offset+12>emergency_line_length then goto done;
+ print_char(" ");
+ print_scaled(ds);
+ if ps_offset+5>emergency_line_length then goto done;
+ t:=ps_marks_out(f,t);
+ end;
+done:
+cur_fsize[f]:=link(cur_fsize[f]);
+end
+
+@ @<Increment |next_size| and apply |mark_string_chars| to all text nodes...@>=
+begin incr(next_size);
+p:=link(dummy_loc(h));
+while p<>null do
+ begin if type(p)=text_code then
+ if font_n(p)<>null_font then
+ if name_type(p)=next_size then
+ mark_string_chars(font_n(p),text_p(p));
+ p:=link(p);
+ end;
+end
+
+@ The prologue defines \.{fshow} and corrects for the fact that \.{fshow}
+arguments use |font_name| instead of |font_ps_name|. Downloaded bitmap fonts
+might not have reasonable |font_ps_name| entries, but we just charge ahead
+anyway. The user should not make \&{prologues} positive if this will cause
+trouble.
+@:prologues_}{\&{prologues} primitive@>
+
+@<Print the prologue@>=
+begin if ldf<>null_font then
+ begin for f:=null_font+1 to last_fnum do
+ if font_sizes[f]<>null then
+ begin ps_name_out(font_name[f],true);
+ ps_name_out(font_ps_name[f],true);
+ ps_print(" def");
+ print_ln;
+ end;
+ print("/fshow {exch findfont exch scalefont setfont show}bind def");
+ print_ln;
+ end;
+end
+
+@ Since we do not have a stack for the graphics state, it is considered
+completely unknown after the \.{grestore} from a stop clip object. Procedure
+|unknown_graphics_state| needs a negative argument in this case.
+
+@<Cases for translating graphical object~|p| into \ps@>=
+start_clip_code:begin print_nl("gsave ");
+ ps_path_out(path_p(p));
+ ps_print(" clip");
+ print_ln;
+ end;
+stop_clip_code:begin print_nl("grestore");
+ print_ln;
+ unknown_graphics_state(-1);
+ end;
+
+@ @<Cases for translating graphical object~|p| into \ps@>=
+fill_code: if pen_p(p)=null then ps_fill_out(path_p(p))
+ else if pen_is_elliptical(pen_p(p)) then stroke_ellipse(p,true)
+ else begin do_outer_envelope(copy_path(path_p(p)), p);
+ do_outer_envelope(htap_ypoc(path_p(p)), p);
+ end;
+stroked_code: if pen_is_elliptical(pen_p(p)) then stroke_ellipse(p,false)
+ else begin q:=copy_path(path_p(p));
+ t:=lcap_val(p);
+ @<Break the cycle and set |t:=1| if path |q| is cyclic@>;
+ q:=make_envelope(q,pen_p(p),ljoin_val(p),t,miterlim_val(p));
+ ps_fill_out(q);
+ toss_knot_list(q);
+ end;
+
+@ The envelope of a cyclic path~|q| could be computed by calling
+|make_envelope| once for |q| and once for its reversal. We don't do this
+because it would fail color regions that are covered by the pen regardless
+of where it is placed on~|q|.
+
+@<Break the cycle and set |t:=1| if path |q| is cyclic@>=
+if left_type(q)<>endpoint then
+ begin left_type(insert_knot(q,x_coord(q),y_coord(q))):=endpoint;
+ right_type(q):=endpoint;
+ q:=link(q);
+ t:=1;
+ end
+
+@ @<Cases for translating graphical object~|p| into \ps@>=
+text_code: if (font_n(p)<>null_font) and (length(text_p(p))>0) then
+ begin if internal[prologues]>0 then
+ scf:=choose_scale(p)
+ else scf:=indexed_size(font_n(p), name_type(p));
+ @<Shift or transform as necessary before outputting text node~|p| at scale
+ factor~|scf|; set |transformed:=true| if the original transformation must
+ be restored@>;
+ ps_string_out(text_p(p));
+ ps_name_out(font_name[font_n(p)],false);
+ @<Print the size information and \ps\ commands for text node~|p|@>;
+ print_ln;
+ end;
+
+@ @<Print the size information and \ps\ commands for text node~|p|@>=
+ps_room(18);
+print_char(" ");
+ds:=(font_dsize[font_n(p)]+8) div 16;
+print_scaled(take_scaled(ds,scf));
+print(" fshow");
+if transformed then ps_print(" grestore")
+
+@ @<Shift or transform as necessary before outputting text node~|p| at...@>=
+transformed:=(txx_val(p)<>scf)or(tyy_val(p)<>scf)or@|
+ (txy_val(p)<>0)or(tyx_val(p)<>0);
+if transformed then
+ begin print("gsave [");
+ ps_pair_out(make_scaled(txx_val(p),scf),@|make_scaled(tyx_val(p),scf));
+ ps_pair_out(make_scaled(txy_val(p),scf),@|make_scaled(tyy_val(p),scf));
+ ps_pair_out(tx_val(p),ty_val(p));@/
+ ps_print("] concat 0 0 moveto");
+ end
+else begin ps_pair_out(tx_val(p),ty_val(p));
+ ps_print("moveto");
+ end;
+print_ln
+
+@ Now that we've finished |ship_out|, let's look at the other commands
+by which a user can send things to the \.{GF} file.
+
+@ @<Determine if a character has been shipped out@>=
+begin cur_exp:=round_unscaled(cur_exp) mod 256;
+if cur_exp<0 then cur_exp:=cur_exp+256;
+boolean_reset(char_exists[cur_exp]); cur_type:=boolean_type;
+end
+
+@* \[45] Dumping and undumping the tables.
+After \.{INIMP} has seen a collection of macros, it
+can write all the necessary information on an auxiliary file so
+that production versions of \MP\ are able to initialize their
+memory at high speed. The present section of the program takes
+care of such output and input. We shall consider simultaneously
+the processes of storing and restoring,
+so that the inverse relation between them is clear.
+@.INIMP@>
+
+The global variable |mem_ident| is a string that is printed right
+after the |banner| line when \MP\ is ready to start. For \.{INIMP} this
+string says simply `\.{(INIMP)}'; for other versions of \MP\ it says,
+for example, `\.{(preloaded mem=plain 90.4.14)}', showing the year,
+month, and day that the mem file was created. We have |mem_ident=0|
+before \MP's tables are loaded.
+
+@<Glob...@>=
+@!mem_ident:str_number;
+
+@ @<Set init...@>=
+mem_ident:=0;
+
+@ @<Initialize table entries...@>=
+mem_ident:=" (INIMP)";
+
+@ @<Declare act...@>=
+@!init procedure store_mem_file;
+label done;
+var @!k:integer; {all-purpose index}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!w: four_quarters; {four ASCII codes}
+@!s: str_number; {all-purpose string}
+begin @<Create the |mem_ident|, open the mem file,
+ and inform the user that dumping has begun@>;
+@<Dump constants for consistency check@>;
+@<Dump the string pool@>;
+@<Dump the dynamic memory@>;
+@<Dump the table of equivalents and the hash table@>;
+@<Dump a few more things and the closing check word@>;
+@<Close the mem file@>;
+end;
+tini
+
+@ Corresponding to the procedure that dumps a mem file, we also have a function
+that reads~one~in. The function returns |false| if the dumped mem is
+incompatible with the present \MP\ table sizes, etc.
+
+@d off_base=6666 {go here if the mem file is unacceptable}
+@d too_small(#)==begin wake_up_terminal;
+ wterm_ln('---! Must increase the ',#);
+@.Must increase the x@>
+ goto off_base;
+ end
+
+@p @t\4@>@<Declare the function called |open_mem_file|@>@;
+function load_mem_file:boolean;
+label done,off_base,exit;
+var @!k:integer; {all-purpose index}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something undumped}
+@!s: str_number; {some temporary string}
+@!w: four_quarters; {four ASCII codes}
+begin @<Undump constants for consistency check@>;
+@<Undump the string pool@>;
+@<Undump the dynamic memory@>;
+@<Undump the table of equivalents and the hash table@>;
+@<Undump a few more things and the closing check word@>;
+load_mem_file:=true; return; {it worked!}
+off_base: wake_up_terminal;
+ wterm_ln('(Fatal mem file error; I''m stymied)');
+@.Fatal mem file error@>
+load_mem_file:=false;
+exit:end;
+
+@ Mem files consist of |memory_word| items, and we use the following
+macros to dump words of different types:
+
+@d dump_wd(#)==begin mem_file^:=#; put(mem_file);@+end
+@d dump_int(#)==begin mem_file^.int:=#; put(mem_file);@+end
+@d dump_hh(#)==begin mem_file^.hh:=#; put(mem_file);@+end
+@d dump_qqqq(#)==begin mem_file^.qqqq:=#; put(mem_file);@+end
+
+@<Glob...@>=
+@!mem_file:word_file; {for input or output of mem information}
+
+@ The inverse macros are slightly more complicated, since we need to check
+the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
+read an integer value |x| that is supposed to be in the range |a<=x<=b|.
+
+@d undump_wd(#)==begin get(mem_file); #:=mem_file^;@+end
+@d undump_int(#)==begin get(mem_file); #:=mem_file^.int;@+end
+@d undump_hh(#)==begin get(mem_file); #:=mem_file^.hh;@+end
+@d undump_qqqq(#)==begin get(mem_file); #:=mem_file^.qqqq;@+end
+@d undump_end_end(#)==#:=x;@+end
+@d undump_end(#)==(x>#) then goto off_base@+else undump_end_end
+@d undump(#)==begin undump_int(x); if (x<#) or undump_end
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@d undump_size_end(#)==if x># then undump_size_end_end
+@d undump_size(#)==begin undump_int(x);
+ if x<# then goto off_base; undump_size_end
+
+@ The next few sections of the program should make it clear how we use the
+dump/undump macros.
+
+@<Dump constants for consistency check@>=
+dump_int(@$);@/
+dump_int(mem_min);@/
+dump_int(mem_top);@/
+dump_int(hash_size);@/
+dump_int(hash_prime);@/
+dump_int(max_in_open)
+
+@ Sections of a \.{WEB} program that are ``commented out'' still contribute
+strings to the string pool; therefore \.{INIMP} and \MP\ will have
+the same strings. (And it is, of course, a good thing that they do.)
+@.WEB@>
+@^string pool@>
+
+@<Undump constants for consistency check@>=
+x:=mem_file^.int;
+if x<>@$ then goto off_base; {check that strings are the same}
+undump_int(x);
+if x<>mem_min then goto off_base;
+undump_int(x);
+if x<>mem_top then goto off_base;
+undump_int(x);
+if x<>hash_size then goto off_base;
+undump_int(x);
+if x<>hash_prime then goto off_base;
+undump_int(x);
+if x<>max_in_open then goto off_base
+
+@ We do string pool compaction to avoid dumping unused strings.
+
+@d dump_four_ASCII==
+ w.b0:=qi(so(str_pool[k])); w.b1:=qi(so(str_pool[k+1]));
+ w.b2:=qi(so(str_pool[k+2])); w.b3:=qi(so(str_pool[k+3]));
+ dump_qqqq(w)
+
+@<Dump the string pool@>=
+do_compaction(pool_size);
+dump_int(pool_ptr);
+dump_int(max_str_ptr);
+dump_int(str_ptr);
+k:=0;
+while (next_str[k]=k+1) and (k<=max_str_ptr) do incr(k);
+dump_int(k);
+while k<=max_str_ptr do
+ begin dump_int(next_str[k]); incr(k);
+ end;
+k:=0;
+loop @+begin dump_int(str_start[k]);
+ if k=str_ptr then goto done else k:=next_str[k];
+ end;
+done:k:=0;
+while k+4<pool_ptr do
+ begin dump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; dump_four_ASCII;
+print_ln; print("at most "); print_int(max_str_ptr);
+print(" strings of total length ");
+print_int(pool_ptr)
+
+@ @d undump_four_ASCII==
+ undump_qqqq(w);
+ str_pool[k]:=si(qo(w.b0)); str_pool[k+1]:=si(qo(w.b1));
+ str_pool[k+2]:=si(qo(w.b2)); str_pool[k+3]:=si(qo(w.b3))
+
+@<Undump the string pool@>=
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings-1)('max strings')(max_str_ptr);
+undump(0)(max_str_ptr)(str_ptr);
+undump(0)(max_str_ptr+1)(s);
+for k:=0 to s-1 do next_str[k]:=k+1;
+for k:=s to max_str_ptr do undump(s+1)(max_str_ptr+1)(next_str[k]);
+fixed_str_use:=0;
+k:=0;
+loop @+begin undump(0)(pool_ptr)(str_start[k]);
+ if k=str_ptr then goto done;
+ str_ref[k]:=max_str_ref;
+ incr(fixed_str_use);
+ last_fixed_str:=k; k:=next_str[k];
+ end;
+done:k:=0;
+while k+4<pool_ptr do
+ begin undump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; undump_four_ASCII;
+init_str_use:=fixed_str_use; init_pool_ptr:=pool_ptr;
+max_pool_ptr:=pool_ptr;
+strs_used_up:=fixed_str_use;
+stat pool_in_use:=str_start[str_ptr]; strs_in_use:=fixed_str_use;
+ max_pl_used:=pool_in_use; max_strs_used:=strs_in_use;@/
+ pact_count:=0; pact_chars:=0; pact_strs:=0;
+tats
+
+@ By sorting the list of available spaces in the variable-size portion of
+|mem|, we are usually able to get by without having to dump very much
+of the dynamic memory.
+
+We recompute |var_used| and |dyn_used|, so that \.{INIMP} dumps valid
+information even when it has not been gathering statistics.
+
+@<Dump the dynamic memory@>=
+sort_avail; var_used:=0;
+dump_int(lo_mem_max); dump_int(rover);
+p:=mem_min; q:=rover; x:=0;
+repeat for k:=p to q+1 do dump_wd(mem[k]);
+x:=x+q+2-p; var_used:=var_used+q-p;
+p:=q+node_size(q); q:=rlink(q);
+until q=rover;
+var_used:=var_used+lo_mem_max-p; dyn_used:=mem_end+1-hi_mem_min;@/
+for k:=p to lo_mem_max do dump_wd(mem[k]);
+x:=x+lo_mem_max+1-p;
+dump_int(hi_mem_min); dump_int(avail);
+for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
+x:=x+mem_end+1-hi_mem_min;
+p:=avail;
+while p<>null do
+ begin decr(dyn_used); p:=link(p);
+ end;
+dump_int(var_used); dump_int(dyn_used);
+print_ln; print_int(x);
+print(" memory locations dumped; current usage is ");
+print_int(var_used); print_char("&"); print_int(dyn_used)
+
+@ @<Undump the dynamic memory@>=
+undump(lo_mem_stat_max+1000)(hi_mem_stat_min-1)(lo_mem_max);
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+p:=mem_min; q:=rover;
+repeat for k:=p to q+1 do undump_wd(mem[k]);
+p:=q+node_size(q);
+if (p>lo_mem_max)or((q>=rlink(q))and(rlink(q)<>rover)) then goto off_base;
+q:=rlink(q);
+until q=rover;
+for k:=p to lo_mem_max do undump_wd(mem[k]);
+undump(lo_mem_max+1)(hi_mem_stat_min)(hi_mem_min);
+undump(null)(mem_top)(avail); mem_end:=mem_top;
+for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
+undump_int(var_used); undump_int(dyn_used)
+
+@ A different scheme is used to compress the hash table, since its lower region
+is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output three
+words: |p|, |hash[p]|, and |eqtb[p]|. The hash table is, of course, densely
+packed for |p>=hash_used|, so the remaining entries are output in~a~block.
+
+@<Dump the table of equivalents and the hash table@>=
+dump_int(hash_used); st_count:=frozen_inaccessible-1-hash_used;
+for p:=1 to hash_used do if text(p)<>0 then
+ begin dump_int(p); dump_hh(hash[p]); dump_hh(eqtb[p]); incr(st_count);
+ end;
+for p:=hash_used+1 to hash_end do
+ begin dump_hh(hash[p]); dump_hh(eqtb[p]);
+ end;
+dump_int(st_count);@/
+print_ln; print_int(st_count); print(" symbolic tokens")
+
+@ @<Undump the table of equivalents and the hash table@>=
+undump(1)(frozen_inaccessible)(hash_used); p:=0;
+repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]); undump_hh(eqtb[p]);
+until p=hash_used;
+for p:=hash_used+1 to hash_end do
+ begin undump_hh(hash[p]); undump_hh(eqtb[p]);
+ end;
+undump_int(st_count)
+
+@ We have already printed a lot of statistics, so we set |tracing_stats:=0|
+to prevent them appearing again.
+
+@<Dump a few more things and the closing check word@>=
+dump_int(int_ptr);
+for k:=1 to int_ptr do
+ begin dump_int(internal[k]); dump_int(int_name[k]);
+ end;
+dump_int(start_sym); dump_int(interaction); dump_int(mem_ident);
+dump_int(bg_loc); dump_int(eg_loc); dump_int(serial_no); dump_int(69073);
+internal[tracing_stats]:=0
+
+@ @<Undump a few more things and the closing check word@>=
+undump(max_given_internal)(max_internal)(int_ptr);
+for k:=1 to int_ptr do
+ begin undump_int(internal[k]);
+ undump(0)(str_ptr)(int_name[k]);
+ end;
+undump(0)(frozen_inaccessible)(start_sym);
+undump(batch_mode)(error_stop_mode)(interaction);
+undump(0)(str_ptr)(mem_ident);
+undump(1)(hash_end)(bg_loc);
+undump(1)(hash_end)(eg_loc);
+undump_int(serial_no);@/
+undump_int(x);@+if (x<>69073)or eof(mem_file) then goto off_base
+
+@ @<Create the |mem_ident|...@>=
+selector:=new_string;
+print(" (preloaded mem="); print(job_name); print_char(" ");
+print_int(round_unscaled(internal[year]) mod 100); print_char(".");
+print_int(round_unscaled(internal[month])); print_char(".");
+print_int(round_unscaled(internal[day])); print_char(")");
+if interaction=batch_mode then selector:=log_only
+else selector:=term_and_log;
+str_room(1); mem_ident:=make_string; str_ref[mem_ident]:=max_str_ref;@/
+pack_job_name(mem_extension);
+while not w_open_out(mem_file) do
+ prompt_file_name("mem file name",mem_extension);
+print_nl("Beginning to dump on file ");
+@.Beginning to dump...@>
+s:=w_make_name_string(mem_file);
+print(s); flush_string(s);
+print_nl(mem_ident)
+
+@ @<Close the mem file@>=
+w_close(mem_file)
+
+@* \[46] The main program.
+This is it: the part of \MP\ that executes all those procedures we have
+written.
+
+Well---almost. We haven't put the parsing subroutines into the
+program yet; and we'd better leave space for a few more routines that may
+have been forgotten.
+
+@p @<Declare the basic parsing subroutines@>@;
+@<Declare miscellaneous procedures that were declared |forward|@>@;
+@<Last-minute procedures@>
+
+@ We've noted that there are two versions of \MP. One, called \.{INIMP},
+@.INIMP@>
+has to be run first; it initializes everything from scratch, without
+reading a mem file, and it has the capability of dumping a mem file.
+The other one is called `\.{VIRMP}'; it is a ``virgin'' program that needs
+@.VIRMP@>
+to input a mem file in order to get started. \.{VIRMP} typically has
+a bit more memory capacity than \.{INIMP}, because it does not need the
+space consumed by the dumping/undumping routines and the numerous calls on
+|primitive|, etc.
+
+The \.{VIRMP} program cannot read a mem file instantaneously, of course;
+the best implementations therefore allow for production versions of \MP\ that
+not only avoid the loading routine for \PASCAL\ object code, they also have
+a mem file pre-loaded. This is impossible to do if we stick to standard
+\PASCAL; but there is a simple way to fool many systems into avoiding the
+initialization, as follows:\quad(1)~We declare a global integer variable
+called |ready_already|. The probability is negligible that this
+variable holds any particular value like 314159 when \.{VIRMP} is first
+loaded.\quad(2)~After we have read in a mem file and initialized
+everything, we set |ready_already:=314159|.\quad(3)~Soon \.{VIRMP}
+will print `\.*', waiting for more input; and at this point we
+interrupt the program and save its core image in some form that the
+operating system can reload speedily.\quad(4)~When that core image is
+activated, the program starts again at the beginning; but now
+|ready_already=314159| and all the other global variables have
+their initial values too. The former chastity has vanished!
+
+In other words, if we allow ourselves to test the condition
+|ready_already=314159|, before |ready_already| has been
+assigned a value, we can avoid the lengthy initialization. Dirty tricks
+rarely pay off so handsomely.
+@^dirty \PASCAL@>
+@^system dependencies@>
+
+@<Glob...@>=
+@!ready_already:integer; {a sacrifice of purity for economy}
+
+@ Now this is really it: \MP\ starts and ends here.
+
+The initial test involving |ready_already| should be deleted if the
+\PASCAL\ runtime system is smart enough to detect such a ``mistake.''
+@^system dependencies@>
+
+@p begin @!{|start_here|}
+history:=fatal_error_stop; {in case we quit during initialization}
+t_open_out; {open the terminal for output}
+if ready_already=314159 then goto start_of_MP;
+@<Check the ``constant'' values...@>@;
+if bad>0 then
+ begin wterm_ln('Ouch---my internal constants have been clobbered!',
+ '---case ',bad:1);
+@.Ouch...clobbered@>
+ goto final_end;
+ end;
+initialize; {set global variables to their starting values}
+@!init if not get_strings_started then goto final_end;
+init_tab; {initialize the tables}
+init_prim; {call |primitive| for each primitive}
+init_str_use:=str_ptr; init_pool_ptr:=pool_ptr;@/
+max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr;
+fix_date_and_time;
+tini@/
+ready_already:=314159;
+start_of_MP: @<Initialize the output routines@>;
+@<Get the first line of input and prepare to start@>;
+history:=spotless; {ready to go!}
+if start_sym>0 then {insert the `\&{everyjob}' symbol}
+ begin cur_sym:=start_sym; back_input;
+ end;
+main_control; {come to life}
+final_cleanup; {prepare for death}
+end_of_MP: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+
+@ Here we do whatever is needed to complete \MP's job gracefully on the
+local operating system. The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+|str_room| or |make_string| at this time, because a call on |overflow|
+might lead to an infinite loop.
+@^system dependencies@>
+
+This program doesn't bother to close the input files that may still be open.
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+var @!k:integer; {all-purpose index}
+@!lh:integer; {the length of the \.{TFM} header, in words}
+@!lk_offset:0..256; {extra words inserted at beginning of |lig_kern| array}
+@!p:pointer; {runs through a list of \.{TFM} dimensions}
+begin @<Close all open files in the |rd_file| and |wr_file| arrays@>;
+@!stat if internal[tracing_stats]>0 then
+ @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Do all the finishing work on the \.{TFM} file@>;
+@<Explain what output files were written@>;
+if log_opened then
+ begin wlog_cr;
+ a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+@.Transcript written...@>
+ print(log_name); print_char(".");
+ end;
+ end;
+end;
+
+@ @<Close all open files in the |rd_file| and |wr_file| arrays@>=
+for k:=0 to read_files-1 do
+ if rd_fname[k]<>0 then a_close(rd_file[k]);
+for k:=0 to write_files-1 do
+ if wr_fname[k]<>0 then a_close(wr_file[k])
+
+@ We want to produce a \.{TFM} file if and only if |fontmaking| is positive.
+
+We reclaim all of the variable-size memory at this point, so that
+there is no chance of another memory overflow after the memory capacity
+has already been exceeded.
+
+@<Do all the finishing work on the \.{TFM} file@>=
+if internal[fontmaking]>0 then
+ begin @<Make the dynamic memory into one big available node@>;
+ @<Massage the \.{TFM} widths@>;
+ fix_design_size; fix_check_sum;
+ @<Massage the \.{TFM} heights, depths, and italic corrections@>;
+ internal[fontmaking]:=0; {avoid loop in case of fatal error}
+ @<Finish the \.{TFM} file@>;
+ end
+
+@ @<Make the dynamic memory into one big available node@>=
+rover:=lo_mem_stat_max+1; link(rover):=empty_flag; lo_mem_max:=hi_mem_min-1;
+if lo_mem_max-rover>max_halfword then lo_mem_max:=max_halfword+rover;
+node_size(rover):=lo_mem_max-rover; llink(rover):=rover; rlink(rover):=rover;
+link(lo_mem_max):=null; info(lo_mem_max):=null
+
+@ The present section goes directly to the log file instead of using
+|print| commands, because there's no need for these strings to take
+up |str_pool| memory when a non-{\bf stat} version of \MP\ is being used.
+
+@<Output statistics...@>=
+if log_opened then
+ begin wlog_ln(' ');
+ wlog_ln('Here is how much of MetaPost''s memory',' you used:');
+@.Here is how much...@>
+ wlog(' ',max_strs_used-init_str_use:1,' string');
+ if max_strs_used<>init_str_use+1 then wlog('s');
+ wlog_ln(' out of ', max_strings-1-init_str_use:1);@/
+ wlog_ln(' ',max_pl_used-init_pool_ptr:1,' string characters out of ',
+ pool_size-init_pool_ptr:1);@/
+ wlog_ln(' ',lo_mem_max-mem_min+mem_end-hi_mem_min+2:1,@|
+ ' words of memory out of ',mem_end+1-mem_min:1);@/
+ wlog_ln(' ',st_count:1,' symbolic tokens out of ',
+ hash_size:1);@/
+ wlog_ln(' ',max_in_stack:1,'i,',@|
+ int_ptr:1,'n,',@|
+ max_param_stack:1,'p,',@|
+ max_buf_stack+1:1,'b stack positions out of ',@|
+ stack_size:1,'i,',
+ max_internal:1,'n,',
+ param_size:1,'p,',
+ buf_size:1,'b');
+ wlog_ln(' ',pact_count:1,' string compactions (moved ',
+ pact_chars:1,' characters, ',
+ pact_strs:1,' strings)');
+ end
+
+@ We get to the |final_cleanup| routine when \&{end} or \&{dump} has
+been scanned.
+
+@<Last-minute...@>=
+procedure final_cleanup;
+label exit;
+var c:small_number; {0 for \&{end}, 1 for \&{dump}}
+begin c:=cur_mod;
+if job_name=0 then open_log_file;
+while input_ptr>0 do
+ if token_state then end_token_list@+else end_file_reading;
+while loop_ptr<>null do stop_iteration;
+while open_parens>0 do
+ begin print(" )"); decr(open_parens);
+ end;
+while cond_ptr<>null do
+ begin print_nl("(end occurred when ");@/
+@.end occurred...@>
+ print_cmd_mod(fi_or_else,cur_if);
+ {`\.{if}' or `\.{elseif}' or `\.{else}'}
+ if if_line<>0 then
+ begin print(" on line "); print_int(if_line);
+ end;
+ print(" was incomplete)");
+ if_line:=if_line_field(cond_ptr);
+ cur_if:=name_type(cond_ptr); cond_ptr:=link(cond_ptr);
+ end;
+if history<>spotless then
+ if ((history=warning_issued)or(interaction<error_stop_mode)) then
+ if selector=term_and_log then
+ begin selector:=term_only;
+ print_nl("(see the transcript file for additional information)");
+@.see the transcript file...@>
+ selector:=term_and_log;
+ end;
+if c=1 then
+ begin @!init store_mem_file; return;@+tini@/
+ print_nl("(dump is performed only by INIMP)"); return;
+@.dump...only by INIMP@>
+ end;
+exit:end;
+
+@ @<Last-minute...@>=
+@!init procedure init_prim; {initialize all the primitives}
+begin
+@<Put each...@>;
+end;
+@#
+procedure init_tab; {initialize other tables}
+var @!k:integer; {all-purpose index}
+begin @<Initialize table entries (done by \.{INIMP} only)@>@;
+end;
+tini
+
+@ When we begin the following code, \MP's tables may still contain garbage;
+the strings might not even be present. Thus we must proceed cautiously to get
+bootstrapped in.
+
+But when we finish this part of the program, \MP\ is ready to call on the
+|main_control| routine to do its work.
+
+@<Get the first line...@>=
+begin @<Initialize the input routines@>;
+if (mem_ident=0)or(buffer[loc]="&") then
+ begin if mem_ident<>0 then initialize; {erase preloaded mem}
+ if not open_mem_file then goto final_end;
+ if not load_mem_file then
+ begin w_close(mem_file); goto final_end;
+ end;
+ w_close(mem_file);
+ while (loc<limit)and(buffer[loc]=" ") do incr(loc);
+ end;
+buffer[limit]:="%";@/
+fix_date_and_time;@/
+sys_random_seed := (internal[time] div unity)+internal[day];@/
+init_randoms(sys_random_seed);@/
+@<Initialize the print |selector|...@>;
+if loc<limit then if buffer[loc]<>"\" then start_input; {\&{input} assumed}
+end
+
+@* \[47] Debugging.
+Once \MP\ is working, you should be able to diagnose most errors with
+the \.{show} commands and other diagnostic features. But for the initial
+stages of debugging, and for the revelation of really deep mysteries, you
+can compile \MP\ with a few more aids, including the \PASCAL\ runtime
+checks and its debugger. An additional routine called |debug_help|
+will also come into play when you type `\.D' after an error message;
+|debug_help| also occurs just before a fatal error causes \MP\ to succumb.
+@^debugging@>
+@^system dependencies@>
+
+The interface to |debug_help| is primitive, but it is good enough when used
+with a \PASCAL\ debugger that allows you to set breakpoints and to read
+variables and change their values. After getting the prompt `\.{debug \#}', you
+type either a negative number (this exits |debug_help|), or zero (this
+goes to a location where you can set a breakpoint, thereby entering into
+dialog with the \PASCAL\ debugger), or a positive number |m| followed by
+an argument |n|. The meaning of |m| and |n| will be clear from the
+program below. (If |m=13|, there is an additional argument, |l|.)
+@.debug \#@>
+
+@d breakpoint=888 {place where a breakpoint is desirable}
+
+@<Last-minute...@>=
+@!debug procedure debug_help; {routine to display various things}
+label breakpoint,exit;
+var @!k,@!l,@!m,@!n:integer;
+begin loop begin wake_up_terminal;
+ print_nl("debug # (-1 to exit):"); update_terminal;
+@.debug \#@>
+ read(term_in,m);
+ if m<0 then return
+ else if m=0 then
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+ else begin read(term_in,n);
+ case m of
+ @t\4@>@<Numbered cases for |debug_help|@>@;
+ othercases print("?")
+ endcases;
+ end;
+ end;
+exit:end;
+gubed
+
+@ @<Numbered cases...@>=
+1: print_word(mem[n]); {display |mem[n]| in all forms}
+2: print_int(info(n));
+3: print_int(link(n));
+4: begin print_int(eq_type(n)); print_char(":"); print_int(equiv(n));
+ end;
+5: print_variable_name(n);
+6: print_int(internal[n]);
+7: do_show_dependencies;
+9: show_token_list(n,null,100000,0);
+10: print(n);
+11: check_mem(n>0); {check wellformedness; print new busy locations if |n>0|}
+12: search_mem(n); {look for pointers to |n|}
+13: begin read(term_in,l); print_cmd_mod(n,l);
+ end;
+14: for k:=0 to n do print(buffer[k]);
+15: panicking:=not panicking;
+
+
+@ \MP\ used to have one single routine to print to both `write' files
+and the PostScript output. Web2c redefines ``Character |k| cannot be
+printed'', and that resulted in some bugs where 8-bit characters were
+written to the PostScript file (reported by Wlodek Bzyl).
+
+Also, Hans Hagen requested spaces to be output as "\\040" instead of
+a plain space, since that makes it easier to parse the result file
+for postprocessing.
+
+@<Character |k| is not allowed in PostScript output@>=
+ (k<=" ")or(k>"~")
+
+@* \[48] System-dependent changes.
+This section should be replaced, if necessary, by any special
+modification of the program
+that are necessary to make \MP\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* \[49] Index.
+Here is where you can find all uses of each identifier in the program,
+with underlined entries pointing to where the identifier was defined.
+If the identifier is only one letter long, however, you get to see only
+the underlined entries. {\sl All references are to section numbers instead of
+page numbers.}
+
+This index also lists error messages and other aspects of the program
+that you might want to look up some day. For example, the entry
+for ``system dependencies'' lists all sections that should receive
+special attention from people who are installing \MP\ in a new
+operating environment. A list of various things that can't happen appears
+under ``this can't happen''.
+Approximately 25 sections are listed under ``inner loop''; these account
+for more than 60\pct! of \MP's running time, exclusive of input and output.
diff --git a/Build/source/texk/web2c/mpost.rc b/Build/source/texk/web2c/mpost.rc
new file mode 100644
index 00000000000..432972c82b6
--- /dev/null
+++ b/Build/source/texk/web2c/mpost.rc
@@ -0,0 +1,40 @@
+/* mpost.rc: mpost resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " MetaPost 0.641"
+
+#define VER_INTERNALNAME_STR TEXLIVE_LIBRARYPREFIX_STR "mpost"
+#define VER_ORIGINALFILENAME_STR TEXLIVE_LIBRARYPREFIX_STR "mpost.dll"
+
+#define VER_FILEDESCRIPTION_STR "MetaPost DLL"
+
+#define VER_LEGALCOPYRIGHT_STR " Copyright 1990 - 1998 by AT&T Bell Laboratories"
+#define VER_COMPANYNAME_STR "AT&T Bell Laboratories"
+#define VER_LEGALTRADEMARKS_STR "TeX is a trademark of the American Mathematical Society.\r\n\
+ METAFONT is a trademark of Addison-Wesley Publishing Company.\r\n\
+PostScript is a trademark of Adobe Systems Incorporated."
+
+#define VER_FILETYPE VFT_DLL
+
+#include <texlive.version>
+
+/* mpost.rc ends here */
diff --git a/Build/source/texk/web2c/mpware/ChangeLog b/Build/source/texk/web2c/mpware/ChangeLog
new file mode 100644
index 00000000000..ef2bd1c7b8b
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/ChangeLog
@@ -0,0 +1,467 @@
+2005-08-28 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mpto.c: For for the tex_pretex1 text from Taco Hoekwater
+ <taco@elvenkind.com>.
+
+2005-08-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mpto.c: Update to 0.902.
+
+2005-06-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Replace ac_include with kpse_include. From Peter
+ Breitenlohner.
+
+2005-06-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mpto.c: Merge code from version 0.9.
+
+ * Makefile.in (mpto): mpto doesn't need to link with libraries any
+ more.
+
+ * makempx.in: Update to version 0.9.
+
+ * dmp.c: Update copyright notice to indicate dmp is in the public
+ domain. Change bug report address.
+
+ * README: Update to version from metapost 0.901.
+
+ * newer.c: Use HAVE_CONFIG_H to check whether we can use web2c's
+ c-auto.h and config.h headers. Use HAVE_ST_MTIM to check whether
+ we have the high-res timers in struct stat.
+
+2005-06-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * newer.c (main): Include web2c version in version output.
+
+ * Makefile.in (newer): Don't link in any libraries (we shouldn't
+ be needing any).
+
+ * newer.c: Extensive rewrite to make it handle multiple arguments.
+ Suggested by Reinhard Kotucha <reinhard.kotucha@web.de>.
+
+2004-12-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dmp.c [Hprime,MAXCHARS]: Larger values as there can be many more
+ than 256 chars in a font. Suggested by Michail Vidiassov
+ <master@iaas.msu.ru>.
+
+2004-07-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * makempx.in: Have TROFF use -Tps instead of -Tpost, as the former
+ is what GROFF uses.
+
+ * dmp.c: Changes to support groff (which is the most likely
+ candidate for being actually used these days).
+ (hash): Use unsigned char to calculate hash value.
+ (get_int_map): Variant of get_int() that will accept octal and hex
+ values.
+ (get_float_map): Variant of get_float() that actually just skips over
+ the (comma-separated) list.
+ (scan_desc_line): Use get_int_map() and get_float_map() where
+ relevant.
+ (set_string): Set a word, to implement groff's 't' directive.
+ (do_graphic): Ignore 'Fd'.
+ (do_x_cmd): Account for groff's scaling.
+ (do_page): Account for groff's scaling. Implement (or ignore)
+ additional groff commands 'F', 'm', 'u' (aborts), 't'.
+ (dmp_usage): Modify help text.
+ These changes were suggested by Michail Vidiassov
+ <master@iaas.msu.ru>.
+
+2004-07-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mpto.c (main): Second argument to usagehelp.
+
+2004-06-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * makempx.in: Since the trap statement is already quoted, the
+ quotes around $ERRLOG must be escaped. Found by Werner Lemberg
+ <wl@gnu.org>.
+
+2004-06-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * makempx.in: Add quotes in various places to support filenames
+ with spaces in them.
+
+2004-05-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * makempx.in: Forgot the filename in the sed command.
+
+ * makempx.in: If the mpxerr.tex begins with a %&-line, get the
+ name of the program to use from it. The default 'tex' has become
+ a problem now that 'latex' requires the 'etex' engine. Reported
+ by Lars Madsen <daleif@imf.au.dk>.
+
+2004-04-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * makempx.in: Tell eqn to format for 'post' terminal, just like
+ troff is told to do. The asusmption here is that when troff
+ supports -Tpost, eqn does as well. From Michail Vidiassov
+ <master@iaas.msu.ru>.
+
+ * mpto.c: According to CSTR #54 the ".lf" directive should be ".lf
+ %d %s", not ".lf line %d %s" as used in the original code. Found
+ by Michail Vidiassov <master@iaas.msu.ru>.
+
+2003-02-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: From klibtool to libtool. Based on patches from
+ Albert Chin-A-Young <china@thewrittenword.com>.
+
+ * makempx.in: We might as well be consistent in the use of '
+ versus ".
+
+2003-02-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * makempx.in: Add --parse-first-line to arguments of "default"
+ TeX.
+
+2002-11-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * newer.c [WIN32]: Don't include sys/types.h and sys/stat.h.
+
+2002-10-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (install-exec): Simplify. TeXlive merge.
+
+2001-12-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (install-exec): Now that we link mpto with kpathsea,
+ use klibtool to install it. From by Adrian Bunk <bunk@fs.tum.de>.
+
+2001-11-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * dmp.c: Changes to keep C++ compilers from choking.
+
+2001-11-18 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * newer.c: Changes to keep C++ compilers from choking.
+
+ * mpto.c: Changes to keep C++ compilers from choking. Make calls
+ to usage() conform to the new interface.
+
+ * dmp.c: Changes to keep C++ compilers from choking.
+
+2001-10-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (mpto): Now links with libkpathsea.
+
+ * mpto.c: Make buffer size obey buf_size texmf.cnf specification.
+ Add -tex=program option. Add protoypes.
+
+ * makempx.in: Add -tex=<program> option.
+
+2001-09-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * newer.c: Correct help text. From Oliver Moeller
+ <omoeller@csd.uu.se>.
+
+1999-03-15 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * newer.c [WIN32]: Patchlet from Fabrice.
+
+1999-02-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * newer.c (main): Remove __cdecl, from Fabrice.
+ [!WIN32]: Remove define of __cdecl, from Fabrice.
+
+ * mpto.c (main): Remove __cdecl, from Fabrice.
+ [!WIN32]: Remove define of __cdecl, from Fabrice.
+
+ * dmp.c (main): Remove __cdecl. From Fabrice.
+
+1999-01-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * newer.c (main): Add __cdecl, from Fabrice.
+
+ * mpto.c (main): Add __cdecl, by Fabrice.
+
+ * dmp.c (main): Add __cdecl, by Fabrice.
+ (dmp_usage): Import kpse_bug_address using KPSEDLL. From Fabrice.
+
+1999-01-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Rename kpathsea.make to kpathsea.mk.
+
+1999-01-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * makempx.in: Make makempx independent of compile-time BINDIR.
+ From Thomas.
+
+ * Makefile.in: Change of ../make/*.make to ../make/*.mk.
+
+1998-12-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mpto.c (getline): Change to handle all EOL conventions, not just
+ the native one.
+
+Mon Mar 23 19:18:12 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in (dmp, makempx): Correct dependencies. From Eli
+ Zaretskii.
+
+Thu Jan 29 16:11:25 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * dmp.c: Update for 0.64.
+
+Thu Dec 18 20:36:37 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * dmp.c (fsearch): Use binmode field.
+
+ * dmp.c (fsearch): Assume kpse_truetype_format and
+ kpse_type42_format are for binary files.
+
+Mon Dec 1 20:21:13 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * makempx.in: Use --interaction=batchmode instead of '\batchmode'.
+ Now TeX can look at the mpx$$.tex file to see if a %&format line
+ is present.
+
+Wed Nov 19 17:12:32 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * dmp.c (fsearch): Add kpse_tex-ps_header_format and
+ kpse_pict_format to the binary modes.
+
+Mon Oct 20 08:38:01 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * mpto.c, newer.c [WIN32]: Include string.h. From Fabrice Popineau.
+
+Sun Oct 19 11:00:35 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * makempx.in: Removed web2c maintainer's name.
+
+ * newer.c (main): Removed web2c maintainer's name. Use int main,
+ not void main.
+
+ * mpto.c (main): Removed web2c maintainer's name. Main returns
+ and int, not void.
+
+Fri Oct 17 14:07:21 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * dmp.c: Include the GROFF NOTES comments by Ulrik Vieth.
+
+Wed Oct 15 17:47:09 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * dmp.c (search): Select binary mode to open file for some
+ formats, just like kpse_file_open does. After Eli Zaretskii
+ <eliz@is.elta.co.il>.
+
+ * makempx.in: Fix message about `cat' failure. From Eli Zaretskii
+ <eliz@is.elta.co.il>.
+
+Fri Oct 3 11:54:56 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * mpto.c: Correct TROFF line directives (in the troff_pre*
+ variables).
+
+ * newer.c: Include stdlib.h. From Fabrice Popineau.
+ * mpto.c: Include stdlib.h (for exit).
+ * dmp.c: Add prototype for printversionandexit. After Fabrice
+ Popineau.
+
+Tue Sep 30 16:29:17 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Insert version string into makempx.
+ * makempx.in (mode): Modified to get version string from Makefile.
+
+ * newer.c, mpto.c: Modified to use version string from c-auto.h.
+
+ * mpto.c: suppress the printing of a comment if the first
+ *tex..etex block encountered is a verbatimtex..etex block.
+
+Thu Feb 13 16:18:39 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (install-exec): makempx is in the build directory,
+ not srcdir.
+ From: Andreas Schott <ays@rzg.mpg.de>.
+
+Mon Jan 20 17:30:44 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Version 7.0.
+
+Mon Dec 9 01:31:55 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * makempx.in: Use `basename $0` in usage and version messages
+ for consistency with other programs and scripts.
+
+ * makempx.in: Fix a confusion between TROFF_INERR and TROFF_OUTERR.
+
+ * makempx.in: Remove unfinished $MPXFILE if an error occurs rather
+ than leaving behind a broken version that might confuse $NEWER.
+
+ * newer.c, mpto.c, dmp.c: Reformat usage message for consistency.
+
+ * newer.c (main): Back out unnecessary usage() function again.
+ All cases of incorrect input were already caught before.
+
+ * mpto.c (main): Issue "Need exactly one file arg. Try --help"
+ message if called with no arguments.
+
+ * dmp.c (main): Issue "Need one or two file args. Try --help"
+ message if called with no arguments.
+ This makes it impossible to use dmp as a filter reading from
+ stdin, but it's more in line with the behavior of dvitomp.
+
+ * dmp.c (main): Exit after perror() if file opening failed.
+ This might have been the reason for some remaining seg faults.
+
+Tue Dec 3 18:06:46 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * makempx.in: Must use `eval $TROFF' to get the `eqn | troff'
+ pipeline to work as intended.
+
+Tue Dec 3 00:42:20 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * newer.c (main): Don't seg fault if no args.
+ * newer.c (usage): New separate routine.
+
+ * dmp.c (copy_spec_char): Fix call of fsearch().
+ Refer to DIR_SEP_STRING instead of hard-wired "/".
+
+Mon Nov 18 13:26:52 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makempx.in: Missing ` in --version. From Ulrik.
+
+Sun Nov 10 16:00:41 1996 Karl Berry <karl@cs.umb.edu>
+
+ * newer.c (main): Do not refer to dmp in the --version output.
+
+ * mpto.c (main): Don't seg fault if no args.
+ Do not refer to dmp in the --version output.
+ From Ulrik.
+
+Tue Oct 15 17:20:18 1996 Karl Berry <karl@cs.umb.edu>
+
+ * newer.c, mpto.c: Oops, can't use printversionandexit after all
+ without linking with kpathsea. Not worth it.
+ Just write out the notice.
+
+Tue Oct 8 16:46:17 1996 Karl Berry <karl@cs.umb.edu>
+
+ * *.c: Call printversionandexit for --version.
+ * makempx.in: Change --version output.
+
+Sat Sep 7 16:20:17 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makempx.in (PATH): Include MAKEMPX_BINDIR, not compile_bindir.
+
+ * dmp.c (dmp_usage): Include bug reporting address.
+ * mpto.c (usage): Likewise.
+ * newer.c (main): Likewise.
+ * makempx.in (usage): Likewise.
+
+Sat Aug 10 13:27:54 1996 Karl Berry <karl@cs.umb.edu>
+
+ * dmp.c: Oops, forgot to declare kpathsea_version_string.
+
+Sun Aug 4 15:39:42 1996 Karl Berry <karl@cs.umb.edu>
+
+ * dmp.c: Also print kpathsea_version_string if --version.
+ Give perror if open of argument files for reading/writing fail.
+
+ * Makefile.in (newer, mpto): Include $(proglib) for versionstring.
+
+Fri Jul 26 15:47:57 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Remove co.make.
+
+Sat Jun 8 13:15:01 1996 K. Berry <kb@cs.umb.edu>
+
+ * Makefile.in (newer, mpto): Use $(LIBS) $(XLOADLIBES) for these
+ standalone programs instead of $(LOADLIBES), a la squeeze
+ (dmp): Use $(kpathsea_link).
+
+Fri Apr 26 17:55:06 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makempx.in: Add mptexpre feature. From John Hobby.
+
+Sat Apr 20 17:44:39 1996 Karl Berry <karl@cs.umb.edu>
+
+ * newer.c (main): Recognize --help and --version.
+
+Tue Mar 26 17:37:13 1996 Karl Berry <karl@cs.umb.edu>
+
+ * dmp.c: Include c-ctype.h.
+
+Fri Dec 29 17:16:09 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: misc.make is now clean.make.
+
+Tue Dec 12 16:52:00 1995 Karl Berry <karl@cs.umb.edu>
+
+ * dmp.c: Correct --version output. From Ulrik.
+
+Thu Nov 16 16:23:53 1995 Karl Berry <karl@cs.umb.edu>
+
+ * dmp.c: Call kpse_set_progname. From Gregor Hoffleit.
+
+ * makempx.in: Use filename.tex if converting to TeX. From Ulrik.
+
+ * mpto.c (main): Check mpfile for the fopen failing, not mpname.
+ Implement a -E <errfile> option.
+ (usage): Have a -E option on the Amiga.
+ From Andreas Scherer.
+
+Sat Sep 30 15:56:47 1995 Karl Berry <karl@cs.umb.edu>
+
+ * makempx.in: Quote "$1" for unusual filenames.
+
+Tue Aug 22 14:13:52 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Include rdepend.make and depend.make.
+
+Mon Jul 31 15:45:12 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mpto.c (usage): Improve help message.
+
+ * dmp.c: Convert to use kpathsea.
+
+Sun Jul 30 11:10:10 1995 Karl Berry <karl@cs.umb.edu>
+
+ * makempx.in (mode): Merge troffmpx into this.
+
+Thu Apr 13 16:40:08 1995 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * makempx, troffmpx: replaced by templates makempx.in, troffmpx.in.
+ The actual shell scripts are produced by sed, replacing @BINDIR@
+ by the actual installation directory $(bindir), which is known to
+ the Makefile when invoked as a sub-make from the top-level Makefile.
+
+ * newer.c: include "c-auto.h" as a replacement for "site.h".
+
+ * mptotex.c, mptotr.c: no changes needed.
+
+ * dvitomp.ch: complete rewrite, incorporating material from
+ ../dviutil/dviutil.ch and the original dvitomp.ch.
+
+ * dmp.c: include "c-auto.h" as a replacement for "site.h".
+ Also include a special header file "dmp.h" containing MetaPost
+ specific stuff that isn't found in "c-auto.h". Use MPSUPPORT
+ instead of MPPOOL as the directory for troff support files.
+
+ * dmp.h.in: added new template file for "dmp.h". The actual header
+ file is produced by sed, repacing @TEXMF@ by the actual library
+ directory $(texmf), which is known to the Makefile when invoked
+ as a sub-make from the top-level Makefile.
+
+ * pathexp.c: include "c-auto.h" as a replacement for "site.h".
+ Use `#ifdef HAVE_DIRENT_H' and `#ifdef HAVE_STRING_H' instead
+ of `#ifdef BSD'. (There still remains one case of `#ifdef SYSV'
+ that needs to be checked.)
+
+Wed Apr 12 18:56:19 1995 Ulrik Vieth <vieth@macbeth>
+
+ * Makefile: discarded, will be regenerated from Makefile.in
+ during configure run.
+
+ * Makefile.in: complete rewrite, based on ../dviutil/Makefile.in.
+
+ * convert: discarded, using ../lib/convert instead.
+
+ * mpware.def: discarded, using ../lib/common.defines instead.
+
+ * mpware.h: discarded, using the web2c header files from ../lib.
+
+ * dvimpext.c: discarded, using routines from ../lib/lib.a instead.
+
diff --git a/Build/source/texk/web2c/mpware/Makefile.in b/Build/source/texk/web2c/mpware/Makefile.in
new file mode 100644
index 00000000000..c110088a1ba
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/Makefile.in
@@ -0,0 +1,62 @@
+# Makefile for the MetaPost support programs.
+
+kpse_include ../make/paths.mk
+kpse_include ../make/common.mk
+kpse_include ../make/programs.mk
+kpse_include kpathsea.mk
+
+proglib = ../lib/lib.a
+programs = dmp mpto newer makempx
+
+default: all
+all: $(programs)
+
+dmp: dmp.o $(kpathsea)
+ $(kpathsea_link) dmp.o $(LOADLIBES)
+mpto: mpto.o
+ $(kpathsea_link) mpto.o
+newer: newer.o
+ $(link_command) newer.o
+makempx: makempx.in Makefile.in
+ sed -e 's,@BINDIR@,$(bindir),g' -e 's,@web2cver@,@WEB2CVERSION@,g' \
+ <$(srcdir)/makempx.in >$@
+ -chmod a+x $@
+
+newer.o dmp.o: ../c-auto.h
+
+checkdir = $(srcdir)/../check
+check: mpto makempx newer dmp
+ makempx $(checkdir)/label.mp ../check/xlabel.mpx
+ ./mpto -tex $(checkdir)/testex.mp | diff $(checkdir)/testex.tex -
+ sed '16s/^%//' <$(checkdir)/testex.mp >testex1
+ -mpto -tex testex1 >/dev/null 2>testex2
+ sed '17s/^%//' <$(checkdir)/testex.mp >testex1
+ -mpto -tex testex1 >/dev/null 2>>testex2
+ sed '18s/^%//' <$(checkdir)/testex.mp >testex1
+ -mpto -tex testex1 >/dev/null 2>>testex2
+ sed '19s/^%//' <$(checkdir)/testex.mp >testex1
+ -mpto -tex testex1 >/dev/null 2>>testex2
+ sed '20s/^%//' <$(checkdir)/testex.mp >testex1
+ -mpto -tex testex1 >/dev/null 2>>testex2
+ diff $(checkdir)/testex.err testex2
+
+Makefile: Makefile.in ../config.status
+ cd .. && $(SHELL) config.status
+
+install: install-exec install-data
+install-exec: $(programs)
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(bindir) $(scriptdir)
+ $(INSTALL_PROGRAM) newer $(bindir)/newer
+ $(INSTALL_LIBTOOL_PROG) dmp $(bindir)
+ $(INSTALL_LIBTOOL_PROG) mpto $(bindir)
+ $(INSTALL_SCRIPT) makempx $(scriptdir)/makempx
+install-data:
+
+kpse_include ../make/tkpathsea.mk
+kpse_include ../make/clean.mk
+
+mostlyclean::
+ rm -f testex1 testex2
+
+kpse_include ../make/rdepend.mk
+kpse_include mpware/depend.mk
diff --git a/Build/source/texk/web2c/mpware/README b/Build/source/texk/web2c/mpware/README
new file mode 100644
index 00000000000..a7c792cda81
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/README
@@ -0,0 +1,6 @@
+$Id: README,v 1.2 2005/06/22 17:24:56 olaf Exp $
+
+Public domain, including the test files whose format precludes a
+standard license statement.
+
+This directory contains assorted utility routines for MetaPost.
diff --git a/Build/source/texk/web2c/mpware/depend.mak b/Build/source/texk/web2c/mpware/depend.mak
new file mode 100644
index 00000000000..505ca7646a1
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/depend.mak
@@ -0,0 +1,75 @@
+$(objdir)/dmp.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/tex-file.h \
+ $(kpathseadir)/c-ctype.h \
+ $(gnuw32dir)/oldnames.h \
+ $(kpathseadir)/c-pathch.h
+
+$(objdir)/newer.obj: \
+ ../c-auto.h \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/mpto.obj: \
+ ../c-auto.h \
+ ../cpascal.h \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h \
+ $(kpathseadir)/proginit.h \
+ $(kpathseadir)/tex-file.h \
+ ../help.h \
+ $(kpathseadir)/variable.h
+
diff --git a/Build/source/texk/web2c/mpware/depend.mk b/Build/source/texk/web2c/mpware/depend.mk
new file mode 100644
index 00000000000..9b8032410e3
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/depend.mk
@@ -0,0 +1,21 @@
+dmp.o: dmp.c ../config.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/tex-file.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/c-pathch.h
+mpto.o: mpto.c
+newer.o: newer.c ../c-auto.h ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
diff --git a/Build/source/texk/web2c/mpware/dmp.c b/Build/source/texk/web2c/mpware/dmp.c
new file mode 100644
index 00000000000..8682fce330c
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/dmp.c
@@ -0,0 +1,1326 @@
+/* $Id: dmp.c,v 1.17 2005/06/22 17:31:43 olaf Exp $
+ *
+ * Public domain.
+ *
+ * Previous versions of this file were copyright 1990 - 1995 by AT&T
+ * Bell Laboratories. It has since been put into the public domain.
+ *
+ * John Hobby wrote the original version, which has since been
+ * modified by several other people.
+ */
+
+/* This program reads device-independent troff output files,
+ and converts them into a symbolic form understood by MetaPost. Some
+ of the code was borrowed from DVItoMP. It understands all the D? graphics
+ functions that dpost does but it ignores `x X' device control functions
+ such as `x X SetColor:...', `x X BeginPath:', and `x X DrawPath:...'.
+
+ The output file is a sequence of MetaPost picture expressions, one for every
+ page in the input file. It makes no difference where the input file comes
+ from, but it is intended to process the result of running eqn and troff on
+ the output of MPtoTR. Such a file contains one page for every btex...etex
+ block in the original input. This program then creates a corresponding
+ sequence of MetaPost picture expressions for use as an auxiliary input file.
+ Since MetPost expects such files to have the extension .mpx, the output
+ is sometimes called an `mpx' file.
+
+ The |banner| string defined here should be changed whenever this program
+ gets modified.
+*/
+char *banner="% Written by DMP, Version 0.64"; /* first line of output */
+char *term_banner="This is DMP, Version 0.64";
+
+#include "config.h"
+#include <kpathsea/c-proto.h>
+#include <kpathsea/tex-file.h>
+#include <kpathsea/c-ctype.h>
+#include <kpathsea/c-pathch.h>
+#include <math.h>
+
+/* From ../cpascal.h */
+extern void printversionandexit P3H(const_string, const_string, const_string);
+
+#ifndef PI
+#define PI 3.14159265358979323846
+#endif
+
+#define POOLMAX 65000 /* total characters in all font and char names */
+#define FCOUNT 100 /* maximum number of fonts */
+#define SHIFTS 100 /* maximum number of characters with special shifts */
+#define line_length 79 /* maximum output line length (must be at least 60) */
+#define Hprime 2459 /* much bigger than max(chars/font,fonts/job) */
+#define MAXCHARS 2048 /* character codes fall in the range 0..MAXCHARS-1 */
+#define LLENGTH 1024 /* one more than maximum line length for troff output */
+
+#define is_specchar(c) (c<=2) /* does charcode c identify a special char? */
+#define LWscale 0.03 /* line width for graphics as a fraction of pointsize */
+#define YCORR 12.0 /* V coordinate of reference point in (big) points */
+
+char strpool[POOLMAX]; /* text for font names and char names */
+int poolsize = 0; /* chars used so far in strpool */
+
+char *texname[FCOUNT]; /* TeX names (null-terminated strings) */
+int font_num[FCOUNT]; /* external font numbers */
+float font_design_size[FCOUNT]; /* design size in TeX points */
+struct hcell *charcodes[FCOUNT];/* hash tables for translating char names */
+int next_specfnt[FCOUNT]; /* used to link special fonts together */
+float charwd[FCOUNT][MAXCHARS]; /* width/ptsize indexed [font num][char code] */
+int nfonts; /* no. of internal font nums (texname indices)*/
+int shiftchar[SHIFTS]; /* charcode of character to shift, else -1 */
+float shifth[SHIFTS],shiftv[SHIFTS]; /* shift vals/fontsize (y is upward) */
+int shiftptr = 0; /* number of entries in shift tables */
+int shiftbase[FCOUNT]; /* initial index into shifth,shiftv,shiftchar */
+int specfnt = FCOUNT; /* int. num. of first special font (or FCOUNT)*/
+int *specf_tail = &specfnt; /* tail of specfnt list (*specf_tail==FCOUNT) */
+FILE *trf; /* the input file (troff output) */
+FILE *mpxf; /* the output file */
+struct hcell *trfonts; /* hash tab for internal nums of troff fonts */
+float unit = 0.0; /* (big) points per troff unit (0 when unset)*/
+int h,v; /* current position in tr. units (v downward)*/
+float cursize; /* current type size in (big) points */
+int curfont; /* internal number for current font */
+float Xslant; /* degrees additional slant for all fonts */
+float Xheight; /* yscale fonts to this height if nonzero */
+char *dbname = "trfonts.map"; /* file for table of troff & TFM font names */
+char *adjname = "trchars.adj"; /* file for character shift amounts */
+#define tfmpath kpse_tfm_format
+#define dbpath kpse_mpsupport_format
+#define trpath kpse_troff_font_format
+int lnno = 0; /* line num. in troff output file (our input) */
+
+
+void quit P3C(char*,msg1,char*,msg2,char*,msg3)
+{
+ fprintf(stderr,"DMP abort at troff output line %d:\n%s%s%s\n",
+ lnno, msg1, msg2, msg3);
+ exit(1);
+}
+
+void warn P3C(char*,msg1,char*,msg2,char*,msg3)
+{
+ fprintf(stderr,"DMP warning at troff output line %d:\n%s%s%s\n",
+ lnno, msg1, msg2, msg3);
+}
+
+void add_to_pool P1C(char,c)
+{
+ if (poolsize==POOLMAX) quit("Need to increase POOLMAX","","");
+ else strpool[poolsize++] = c;
+}
+
+
+
+
+/**************************************************************
+ Hash tables
+***************************************************************/
+
+typedef struct hcell {
+ char* lab;
+ int datum;
+} Hcell;
+
+#define new_htab (Hcell*) calloc((unsigned)Hprime, (unsigned)sizeof(Hcell))
+
+
+int hash P1C(char*,s)
+{
+ register int r;
+ for(r=0; *s!=0; s++) {
+ /* GROFF - in font metrics file the character name may be 8bit
+ groff_font(5): Groff supports eight bit characters;
+ groff_out(5): Note that single characters can have the
+ eighth bit set, as can the names of fonts and special
+ characters.
+ */
+ r = (r<<1) + *(unsigned char*)s;
+ while (r>=Hprime) r-=Hprime;
+ }
+ return r;
+}
+
+
+/* Find or insert the given string in the hash table and return the address
+ of the datum.
+*/
+Hcell *failure; /* null unless last hfind failed (used below) */
+
+int *hfind P2C(char*,s,Hcell*,htab)
+{
+ register Hcell *p;
+ register int cnt = Hprime;
+ failure = (Hcell *) 0;
+ p = &htab[hash(s)];
+ do {
+ if (p->lab==NULL) {
+ failure = p;
+ if (s<&strpool[0] || s>=&strpool[POOLMAX]) {
+ p->lab = &strpool[poolsize];
+ do add_to_pool(*s); while (*s++!='\0');
+ } else p->lab = s;
+ return &p->datum;
+ }
+ if (strcmp(s, p->lab)==0) return &p->datum;
+ if (p==htab) p= &htab[Hprime-1];
+ else p--;
+ } while (--cnt >= 0);
+ quit("Need to increase Hprime","","");
+ return (int*)0; /* keep lint happy */
+}
+
+
+/* If the last hfind() failed, undo the insertion and return zero (FALSE).
+*/
+int hfound()
+{
+ if (failure==(Hcell *)0) return 1;
+ failure->lab = NULL;
+ return 0;
+}
+
+
+
+/**************************************************************
+ Search Paths
+***************************************************************/
+
+FILE *fsearch P3C(char*,nam, char*,ext, kpse_file_format_type,format)
+{
+ FILE *f = NULL;
+
+ string fname = kpse_find_file (nam, format, true);
+ const_string mode = kpse_format_info[format].binmode
+ ? FOPEN_RBIN_MODE
+ : FOPEN_R_MODE;
+ if (fname) {
+ f = xfopen (fname, mode);
+ }
+ if (f==NULL) quit("Cannot find ",nam,ext);
+ return f;
+}
+
+
+
+/**************************************************************
+ Scanning Numbers
+***************************************************************/
+
+/* The standard functions atoi(), atof(), and sscanf() provide ways of reading
+ numbers from strings but they give no indication of how much of the string
+ is consumed. These homemade versions don't parse scientific notation.
+*/
+char *arg_tail; /* char after the number just gotten; NULL on failure */
+
+
+int get_int P1C(char *,s)
+{
+ register int i, d, neg;
+ if (s==NULL) goto bad;
+ for (neg=0;; s++)
+ if (*s=='-') neg=!neg;
+ else if (*s!=' ' && *s!='\t') break;
+ if (i= *s-'0', 0>i||i>9) goto bad;
+ while (d= *++s-'0', 0<=d&&d<=9)
+ i = 10*i + d;
+ arg_tail = s;
+ return neg ? -i : i;
+bad:arg_tail = NULL;
+ return 0;
+}
+
+/* GROFF font description files use octal character codes
+ groff_font(5): The code can be any integer. If it starts with
+ a 0 it will be interpreted as octal; if it starts with 0x
+ or 0X it will be intepreted as hexadecimal.
+*/
+int get_int_map P1C(char *,s)
+{
+ register int i;
+ if (s==NULL) goto bad;
+ i=strtol(s,&arg_tail,0);
+ if (s==arg_tail) goto bad;
+ return i;
+bad:arg_tail = NULL;
+ return 0;
+}
+
+/* Troff output files contain few if any non-integers, but this program is
+ prepared to read floats whenever they seem reasonable; i.e., when the
+ number is not being used for character positioning. (For non-PostScript
+ applications h and v are usually in pixels and should be integers.)
+*/
+float get_float P1C(char *,s)
+{
+ register int d, neg, digits;
+ register float x, y;
+
+ digits = 0;
+ if (s!=NULL) {
+ for (neg=0;; s++)
+ if (*s=='-') neg=!neg;
+ else if (*s!=' ' && *s!='\t') break;
+ x = 0.0;
+ while (d= *s-'0', 0<=d&&d<=9) {
+ x = 10.0*x + d;
+ digits++; s++;
+ }
+ if (*s=='.') {
+ y = 1.0;
+ while (d= *++s-'0', 0<=d&&d<=9) {
+ y /= 10.0;
+ x += y*d;
+ digits++;
+ }
+ }
+ }
+ if (digits==0) {
+ arg_tail = NULL;
+ return 0.0;
+ }
+ arg_tail = s;
+ return neg ? -x : x;
+}
+
+/* GROFF font description files have metrics field
+ of comma-separated integers. Traditional troff
+ have a float in this position. The value is not
+ used anyway - thus just skip the value,
+ eat all non-space chars.
+*/
+float get_float_map P1C(char *,s)
+{
+ if (s!=NULL) {
+ while (isspace(*s))
+ s++;
+ while (!isspace(*s) && *s)
+ s++;
+ }
+ arg_tail = s;
+ return 0;
+}
+
+/**************************************************************
+ Reading Initialization Files
+***************************************************************/
+
+/* Read the database file, reserve internal font numbers and set
+ the texname[] entries. Each line in the database file contains
+ <troff-name>\t,PostScript-name>\t<TeX-name>
+ or just <troff-name>\t,PostScript-name> if the TeX name matches the
+ PostScript name. ("\t" means one or more tabs.)
+*/
+
+void read_fmap P1C(char*,dbase)
+{
+ FILE *fin;
+ int c; /* last character read */
+ char *nam; /* a font name being read */
+
+ nfonts = 0;
+ fin = fsearch(dbase,"",dbpath);
+ trfonts = new_htab;
+ while ((c=getc(fin))!=EOF) {
+ if (nfonts==FCOUNT) quit("Need to increase FCOUNT","","");
+ nam = &strpool[poolsize];
+ for (;c!='\t'; c=getc(fin)) add_to_pool(c);
+ add_to_pool(0);
+ *hfind(nam, trfonts) = nfonts;
+ texname[nfonts] = &strpool[poolsize];
+ do {
+ poolsize = texname[nfonts] - strpool;
+ do c=getc(fin); while (c=='\t');
+ for (;c!='\t' && c!='\n'; c=getc(fin))
+ add_to_pool(c);
+ add_to_pool(0);
+ } while (c=='\t');
+ font_num[nfonts] = -1; /* indicate font is not mounted */
+ nfonts++;
+ }
+ fclose(fin);
+}
+
+
+/* Some characters need their coordinates shifted in order to agree with
+ troff's view of the world. Logically, this information belongs in the
+ font description files but it actually resides in a PostScript prolog
+ that the troff output processor dpost reads. Since that file is in
+ PostScript and subject to change, we read the same information from
+ a small auxiliary file that gives shift amounts relative to the font
+ size with y upward.
+*/
+/* GROFF NOTE:
+ The PostScript prologue in GNU groff's font directory does not
+ contain any character shift information, so the following function
+ becomes redundant. Simply keeping an empty "trchars.adj" file
+ around will do fine without requiring any changes to this program.
+*/
+void read_char_adj P1C(char*,adjfile)
+{
+ FILE* fin;
+ char buf[200];
+ int i;
+
+ fin = fsearch(adjfile, "", dbpath);
+ for (i=0; i<nfonts; i++)
+ shiftbase[i] = 0;
+ while (fgets(buf,200,fin)!=NULL) {
+ if (shiftptr==SHIFTS-1) quit("Need to increase SHIFTS","","");
+ if (buf[0]!=' ' && buf[0]!='\t') {
+ for (i=0; buf[i]!='\0'; i++)
+ if (buf[i]=='\n') buf[i]='\0';
+ shiftchar[shiftptr++] = -1;
+ shiftbase[*hfind(buf,trfonts)] = shiftptr;
+ if (!hfound()) quit(adjfile," refers to unknown font ",buf);
+ } else {
+ shiftchar[shiftptr] = get_int(buf);
+ shifth[shiftptr] = get_float(arg_tail);
+ shiftv[shiftptr] = -get_float(arg_tail);
+ if (arg_tail==NULL) quit("Bad shift entry : \"",buf,"\"");
+ shiftptr++;
+ }
+ }
+ shiftchar[shiftptr++] = -1;
+ fclose(fin);
+}
+
+
+/**************************************************************
+ Reading Font Files
+***************************************************************/
+
+
+/* Read the TFM file for the font with internal number f, updating the
+ data structures appropriately. We get the character widths out of the
+ tfm file instead of the troff font description file because they don't
+ because the latter source reflects alterations made only by dpost (the
+ troff output driver that is bypassed when using MetaPost).
+*/
+void read_tfm P1C(int, f)
+{
+ FILE* tf;
+ long a = 0;
+ int sizes[5]; /* file & header lengths, bc, ec, words in wd table */
+ long wd[256]; /* the width table (font size relative, scaled 2^20) */
+ int i, j;
+ long wtmp; /* needed to a floating exception on certain machines */
+
+ tf = fsearch(texname[f], ".tfm", tfmpath);
+ for (i=0; i<5; i++) {
+ sizes[i] = getc(tf);
+ sizes[i] = (sizes[i]<<8) | (getc(tf) & 0377);
+ }
+ if (sizes[1]<2 || sizes[2]<0 || sizes[3]<sizes[2]-1 || sizes[3]>255
+ || sizes[0]<sizes[1]+sizes[3]-sizes[2]+sizes[4]+7)
+ quit("Bad tfm file: ",texname[f],".tfm");
+ for (i=2*5; i<28; i++)
+ (void) getc(tf);
+ for (i=0; i<4; i++)
+ a = (a<<8) | (long) (getc(tf) & 0377);
+ font_design_size[f] = ((float) a)/1048576.0;
+ fseek(tf, (long)(28+4*(sizes[1]+sizes[3]-sizes[2])), 0);
+ for (i=0; i<sizes[4]; i++) {
+ wd[i] = 0L;
+ for (j=0; j<4; j++)
+ wd[i] = (wd[i]<<8) | (long) (getc(tf) & 0377);
+ }
+ fseek(tf, (long)(24+4*sizes[1]), 0);
+ for (i=sizes[2]; i<=sizes[3]; i++) {
+ wtmp = wd[getc(tf) & 0377];
+ charwd[f][i] = ((double) wtmp)/1048576.0/unit;
+ for (j=3; --j>=0;) (void) getc(tf);
+ }
+ fclose(tf);
+}
+
+
+/* Given one line from the character description file for the font with
+ internal number f, save the appropriate data in the charcodes[f] table.
+ A return value of zero indicates a syntax error.
+*/
+/* GROFF NOTE:
+ GNU groff uses an extended font description file format documented
+ in groff_font(5). In order to allow parsing of groff's font files,
+ this function needs to be rewritten as follows:
+
+ 1. The `metrics' field parsed by "get_float(lin);" may include
+ a comma-separated list of up to six decimal integers rather
+ than just a single floating-point number.
+
+ 2. The `charcode' field parsed by "lastcode = get_int(arg_tail);"
+ may be given either in decimal, octal, or hexadecimal format.
+*/
+int scan_desc_line P2C(int,f, char*,lin)
+{
+ static int lastcode;
+ char *s;
+
+ s = &strpool[poolsize];
+ while (*lin!=' ' && *lin!='\t' && *lin!='\0')
+ add_to_pool(*lin++);
+ add_to_pool('\0');
+ while (*lin==' ' || *lin=='\t') lin++;
+ if (*lin=='"')
+ *hfind(s,charcodes[f]) = lastcode;
+ else {
+ (void) get_float_map(lin);
+ (void) get_int(arg_tail);
+ lastcode = get_int_map(arg_tail);
+ if (arg_tail==NULL) return 0;
+ *hfind(s,charcodes[f]) = lastcode;
+ if (lastcode<0 || lastcode>=MAXCHARS) return 0;
+ }
+ return 1;
+}
+
+/* Read the font description file for the font with the given troff name
+ and update the data structures. The result is the internal font number.
+*/
+int read_fontdesc P1C(char*,nam)
+{
+ char buf[200];
+ FILE* fin; /* input file */
+ int f; /* internal font number */
+
+ if (unit==0.0) quit("Resolution is not set soon enough","","");
+ f = *hfind(nam, trfonts);
+ if (!hfound())
+ quit("Font was not in map file","","");
+ fin = fsearch(nam, "", trpath);
+ for (;;) {
+ if (fgets(buf,200,fin)==NULL)
+ quit("Description file for ",nam," ends unexpectedly");
+ if (strncmp(buf,"special",7)==0) {
+ *specf_tail = f;
+ next_specfnt[f] = FCOUNT;
+ specf_tail = &next_specfnt[f];
+ } else if (strncmp(buf,"charset",7)==0)
+ break;
+ }
+ charcodes[f] = new_htab;
+ while (fgets(buf,200,fin)!=NULL)
+ if (scan_desc_line(f, buf) == 0)
+ quit(nam," has a bad line in its description file: ",buf);
+ fclose(fin);
+ return f;
+}
+
+
+
+/**************************************************************
+ Low Level Output Routines
+***************************************************************/
+
+/* One of the basic output operations is to write a \MP\ string expression for
+ a sequence of characters to be typeset. The main difficulties are that such
+ strings can contain arbitrary eight-bit bytes and there is no fixed limit on
+ the length of the string that needs to be produced. In extreme cases this
+ can lead to expressions such as
+ char7&char15\&char31&"?FWayzz"
+ &"zzaF"&char15&char3&char31
+ &"Nxzzzzzzzwvtsqo"
+
+ A global variable state keeps track of the output process.
+ When state=normal we have begun a quoted string and the next character
+ should be a printable character or a closing quote. When state=special
+ the last thing printed was a `char' construction or a closing quote
+ and an ampersand should come next. The starting condition state=initial
+ is a lot like state=special, except no ampersand is required.
+*/
+#define special 0 /* the state after printing a `char' expression */
+#define normal 1 /* the state value in a quoted string */
+#define initial 2 /* initial state */
+
+int state = initial;
+int print_col = 0; /* there are at most this many characters on the current line */
+
+
+/* To print a string on the MPX file, initialize print_col, ensure that
+ state=initial, and pass the characters one-at-a-time to print_char.
+*/
+void print_char P1C(char,cc)
+{
+ int printable; /* nonzero if it is safe to print c */
+ int l; /* number of chars in c or the `char' expression */
+ int c; /* equal to cc mod 256, but always positive */
+
+ c = cc&0377;
+ printable = isprint(c) && c<128; /* avoid high-bit-on Latin-1 chars */
+ if (printable) l=1;
+ else if (c<10) l=5;
+ else if (c<100) l=6;
+ else l=7;
+ if (print_col+l>line_length-2) {
+ if (state==normal) {
+ putc('"',mpxf);
+ state = special;
+ }
+ putc('\n',mpxf);
+ print_col = 0;
+ }
+ if (state==normal)
+ if (printable) putc(c,mpxf);
+ else {
+ fprintf(mpxf,"\"&char%d",c);
+ print_col += 2;
+ }
+ else {
+ if (state==special) {
+ putc('&',mpxf);
+ print_col++;
+ }
+ if (printable) {
+ fprintf(mpxf,"\"%c",c);
+ print_col++;
+ } else
+ fprintf(mpxf,"char%d",c);
+ }
+ print_col += l;
+ state = printable ? normal : special;
+}
+
+
+/* The end_char_string procedure gets the string ended properly and ensures
+ that there is room for |l| more characters on the output line.
+*/
+void end_char_string P1C(int, l)
+{
+ while (state>special) {
+ putc('"',mpxf);
+ print_col++;
+ state--;
+ }
+ if (print_col+l>line_length) {
+ putc('\n',mpxf);
+ print_col = 0;
+ }
+ state = initial; /* get ready to print the next string */
+}
+
+
+
+/**************************************************************
+ Page and Character Output
+***************************************************************/
+
+char font_used[FCOUNT]; /* nonzero for fonts used on this page */
+int fonts_used; /* nonzero if any font been used on this page */
+int graphics_used; /* nonzero if any graphics seen on this page */
+float str_h1,str_v; /* corrected start pos for current out string */
+float str_h2; /* where the current output string ends */
+int str_f; /* internal font num for cur. output string */
+float str_size; /* point size for this text string */
+
+
+/* Before using any fonts we need to define a MetaPost macro for typesetting
+ character strings.
+*/
+void prepare_font_use()
+{
+ int k;
+
+ for (k=0;k<nfonts;k++) font_used[k]=0;
+ fonts_used = 1;
+ fprintf(mpxf,"string n[];\n");
+ fprintf(mpxf,"vardef s(expr t,m,x,y) =\n");
+ fprintf(mpxf," addto p also t scaled(m*1.00375) shifted(x,y); enddef;\n");
+}
+
+
+/* Do what is necessary when the font with internal number f is used for the
+ first time on a page.
+*/
+void first_use P1C(int,f)
+{
+ font_used[f] = 1;
+ fprintf(mpxf, "n%d=\"%s\";\n", font_num[f], texname[f]);
+}
+
+
+/* Print any transformations required by the current Xslant and Xheight
+ settings.
+*/
+void slant_and_ht()
+{
+ int i = 0;
+
+ if (Xslant!=0.0) {
+ fprintf(mpxf," slanted%.5f",Xslant);
+ i++;
+ }
+ if (Xheight!=cursize && Xheight!=0.0 && cursize!=0.0) {
+ fprintf(mpxf," yscaled%.4f", Xheight/cursize);
+ i++;
+ }
+ if (i>0) fprintf(mpxf, "\n ");
+}
+
+
+/* We maintain the invariant that str_f is -1 when there is no output string
+ under construction.
+*/
+void finish_last_char()
+{
+ float m,x,y; /* font scale, MetaPost coords of reference point */
+
+ if (str_f>=0) {
+ m = str_size/font_design_size[str_f];
+ x = str_h1*unit;
+ y = YCORR-str_v*unit;
+ if (fabs(x)>=4096.0 || fabs(y)>=4096.0 || m>=4096.0 || m<0) {
+ warn("text out of range ignored","","");
+ end_char_string(67);
+ }
+ else end_char_string(47);
+ fprintf(mpxf,")infont n%d", font_num[str_f]);
+ slant_and_ht();
+ fprintf(mpxf,",%.5f,%.4f,%.4f);\n", m, x,y);
+ str_f = -1;
+ }
+}
+
+
+/* Output character number c in the font with internal number f.
+*/
+void set_num_char P2C(int,f,int,c)
+{
+ float hh, vv; /* corrected versions of h, v */
+ int i;
+
+ hh = h;
+ vv = v;
+ for (i=shiftbase[f]; shiftchar[i]>=0; i++)
+ if (shiftchar[i]==c) {
+ hh += (cursize/unit)*shifth[i];
+ vv += (cursize/unit)*shiftv[i];
+ break;
+ }
+ if (c==0) quit("attempt to typeset an invalid character","","");
+ if (hh-str_h2>=1.0 || str_h2-hh>=1.0 || vv-str_v>=1.0 || str_v-vv>=1.0
+ || f!=str_f || cursize!=str_size) {
+ if (str_f>=0) finish_last_char();
+ else if (!fonts_used)
+ prepare_font_use(); /* first font usage on this page */
+ if (!font_used[f])
+ first_use(f); /* first use of font f on this page */
+ fprintf(mpxf,"s((");
+ print_col = 3;
+ str_f=f; str_v=vv; str_h1=hh;
+ str_size = cursize;
+ }
+ print_char(c);
+ str_h2 = hh + cursize*charwd[f][c];
+}
+
+/* Output a string. */
+void set_string P1C(char*,cname)
+{
+ float hh; /* corrected version of h, current horisontal position */
+
+ if (!*cname) return;
+ hh = h;
+ set_num_char(curfont,*cname);
+ hh+= cursize*charwd[curfont][*cname];
+ while (*++cname){
+ print_char(*cname);
+ hh += cursize*charwd[curfont][*cname];
+ }
+ h = rint(hh);
+ finish_last_char();
+}
+
+/* The following initialization and clean-up is required.
+*/
+void start_picture()
+{
+ fonts_used = graphics_used = 0;
+ str_f = -1;
+ str_v = 0.0;
+ str_h2 = 0.0;
+ str_size = 0.0;
+ fprintf(mpxf,"begingroup save C,D,p,s,n; picture p; p=nullpicture;\n");
+}
+
+void stop_picture()
+{
+ if (str_f>=0) finish_last_char();
+ fprintf(mpxf,"p endgroup\n");
+}
+
+
+
+/**************************************************************
+ Special Characters
+***************************************************************/
+
+/* Given the troff name of a special character, this routine finds its
+ definition and copies it to the MPX file. It also finds the name of
+ the vardef macro, puts it in the string pool, and index where the
+ string starts. The name should be C.<something>.
+*/
+char specintro[] = "vardef "; /* MetaPost name follows this */
+#define speci 7 /* length of the above string */
+
+int copy_spec_char P1C(char*,cname)
+{
+ int k = 0; /* how much of specintro so far */
+ FILE *deff;
+ int c, s;
+
+ deff = fsearch(concat3("charlib",DIR_SEP_STRING,cname), "", dbpath);
+ while (k<speci) {
+ if ((c=getc(deff))==EOF)
+ quit("No vardef in ",concat3("charlib",DIR_SEP_STRING,cname),"");
+ putc(c, mpxf);
+ if (c==specintro[k]) k++; else k=0;
+ }
+ s = poolsize;
+ while ((c=getc(deff))!='(') {
+ if (c==EOF) quit("vardef in ",concat3("charlib",DIR_SEP_STRING,cname),
+ " has no arguments");
+ putc(c, mpxf);
+ add_to_pool(c);
+ }
+ putc(c, mpxf);
+ add_to_pool('\0');
+ while ((c=getc(deff))!=EOF)
+ putc(c, mpxf);
+ return s;
+}
+
+
+/* When given a character name instead of a number, we need to check if
+ it is a special character and download the definition if necessary.
+ If the character is not in the current font we have to search the special
+ fonts.
+*/
+Hcell *spec_tab = (Hcell*)0;
+
+void set_char P1C(char*,cname)
+{
+ int f, c, *flagp;
+
+ if (*cname==' '||*cname=='\t') return;
+ f = curfont;
+ c = *hfind(cname, charcodes[f]);
+ if (!hfound()) {
+ for (f=specfnt; f!=FCOUNT; f=next_specfnt[f]) {
+ c = *hfind(cname, charcodes[f]);
+ if (hfound()) goto out;
+ }
+ quit("There is no character ",cname,"");
+ }
+out:if (!is_specchar(c)) set_num_char(f,c);
+ else {
+ if (str_f>=0) finish_last_char();
+ if (!fonts_used) prepare_font_use();
+ if (!font_used[f]) first_use(f);
+ if (spec_tab==(Hcell*)0)
+ spec_tab = new_htab;
+ flagp = hfind(cname, spec_tab);
+ if (*flagp==0)
+ *flagp = copy_spec_char(cname); /* this won't be zero */
+ fprintf(mpxf, "s(%s(n%d)", &strpool[*flagp], font_num[f]);
+ slant_and_ht();
+ fprintf(mpxf, ",%.5f,%.4f,%.4f);\n",
+ cursize/font_design_size[f], h*unit, YCORR-v*unit);
+ }
+}
+
+
+
+/**************************************************************
+ Font Definitions
+***************************************************************/
+
+/* Mount the font with troff name nam at external font number n and read any
+ necessary font files.
+*/
+void do_font_def P2C(int,n, char*,nam)
+{
+ int f, k;
+
+ f = *hfind(nam, trfonts);
+ if (!hfound())
+ quit("Font ",nam," was not in map file");
+ if (font_design_size[f]==0) {
+ read_fontdesc(nam);
+ read_tfm(f);
+ }
+ for (k=0; k<nfonts; k++)
+ if (font_num[k]==n) font_num[k]= -1;
+ font_num[f] = n;
+}
+
+
+
+/**************************************************************
+ Time on `makepath pencircle'
+***************************************************************/
+
+#define Speed ((float) (PI/4.0))
+
+/* Given the control points of a cubic Bernstein polynomial, evaluate
+ it at t.
+*/
+float Beval P2C(float*,xx, float, t)
+{
+ float zz[4];
+ register int i, j;
+ for (i=0; i<=3; i++) zz[i]=xx[i];
+ for (i=3; i>0; i--)
+ for (j=0; j<i; j++)
+ zz[j] += t*(zz[j+1]-zz[j]);
+ return zz[0];
+}
+
+
+/* Find the direction angle at time t on the path `makepath pencircle'.
+ The tables below give the Bezier control points for MetaPost's cubic
+ approximation to the first octant of a unit circle.
+*/
+float xx[4] = {1.0, 1.0, 0.8946431597, 0.7071067812};
+float yy[4] = {0.0, 0.2652164899, 0.5195704026, 0.7071067812};
+
+float circangle P1C(float,t)
+{
+ float ti;
+
+ ti = floor(t);
+ t -= ti;
+ return (float) atan(Beval(yy,t)/Beval(xx,t)) + ti*Speed;
+}
+
+
+/* Find the spline parameter where `makepath pencircle' comes closest to
+ (cos(a)/2,sin(a)/2).
+*/
+float circtime P1C(float,a)
+{
+ int i;
+ float t;
+ t = a/Speed;
+ for (i=2; --i>=0;)
+ t += (a - circangle(t))/Speed;
+ return t;
+}
+
+
+
+/**************************************************************
+ Troff Graphics
+***************************************************************/
+
+float gx, gy; /* current point for graphics (init. (h,YCORR/unit-v) */
+
+void prepare_graphics()
+{
+ fprintf(mpxf,"vardef D(expr d)expr q =\n");
+ fprintf(mpxf," addto p doublepath q withpen pencircle scaled d; enddef;\n");
+ graphics_used = 1;
+}
+
+
+/* This function prints the current position (gx,gy). Then if it can read dh dv
+ from string s, it increments (gx,gy) and prints "--". By returning the rest
+ of the string s or NULL if nothing could be read from s, it provides the
+ argument for the next iteration.
+*/
+char *do_line P1C(char*,s)
+{
+ float dh, dv;
+
+ fprintf(mpxf, "(%.3f,%.3f)", gx*unit, gy*unit);
+ dh = get_float(s);
+ dv = get_float(arg_tail);
+ if (arg_tail==NULL) return NULL;
+ gx += dh;
+ gy -= dv;
+ fprintf(mpxf,"--\n");
+ return arg_tail;
+}
+
+
+/* Function spline_seg() reads two pairs of (dh,dv) increments and prints the
+ corresponding quadratic B-spline segment, leaving the ending point to be
+ printed next time. The return value is the string with the first (dh,dv)
+ pair lopped off. If only one pair of increments is found, we prepare to
+ terminate the iteration by printing last time's ending point and returning
+ NULL.
+*/
+char * spline_seg P1C(char*,s)
+{
+ float dh1, dv1, dh2, dv2;
+
+ dh1 = get_float(s);
+ dv1 = get_float(arg_tail);
+ if (arg_tail==NULL) quit("Missing spline increments","","");
+ s = arg_tail;
+ fprintf(mpxf, "(%.3f,%.3f)", (gx+.5*dh1)*unit, (gy-.5*dv1)*unit);
+ gx += dh1;
+ gy -= dv1;
+ dh2 = get_float(s);
+ dv2 = get_float(arg_tail);
+ if (arg_tail==NULL) return NULL;
+ fprintf(mpxf, "..\ncontrols (%.3f,%.3f) and (%.3f,%.3f)..\n",
+ (gx-dh1/6.0)*unit, (gy+dv1/6.0)*unit, (gx+dh2/6.0)*unit,
+ (gy-dv2/6.0)*unit);
+ return s;
+}
+
+
+/* Draw an ellipse with the given major and minor axes.
+*/
+void do_ellipse P2C(float,a, float,b)
+{
+ fprintf(mpxf, "makepath(pencircle xscaled %.3f\n yscaled %.3f",
+ a*unit, b*unit);
+ fprintf(mpxf, " shifted (%.3f,%.3f));\n", (gx+.5*a)*unit, gy*unit);
+ gx += a;
+}
+
+
+/* Draw a counter-clockwise arc centered at (cx,cy) with initial and final radii
+ (ax,ay) and (bx,by) respectively.
+*/
+void do_arc P6C(float,cx, float,cy, float,ax, float,ay, float,bx, float,by)
+{
+ float t1, t2;
+
+ t1 = circtime(atan2(ay, ax));
+ t2 = circtime(atan2(by, bx));
+ if (t2 < t1) t2 += 8.0;
+ fprintf(mpxf, "subpath (%.5f,%.5f) of\n", t1, t2);
+ fprintf(mpxf, " makepath(pencircle scaled %.3f shifted (%.3f,%.3f));\n",
+ 2.0*sqrt(ax*ax+ay*ay)*unit, cx*unit, cy*unit);
+ gx = cx + bx;
+ gy = cy + by;
+}
+
+
+
+/* string s is everything following the initial `D' in a troff graphics command.
+*/
+void do_graphic P1C(char*,s)
+{
+ float h1, v1, h2, v2;
+ finish_last_char();
+ /* GROFF uses Fd to set fill color for solid drawing objects to the
+ default, so just ignore that.
+ */
+ if (s[0] == 'F' && s[1] == 'd') return;
+ gx = (float) h;
+ gy = YCORR/unit - ((float) v);
+ if (!graphics_used) prepare_graphics();
+ fprintf(mpxf,"D(%.4f) ", LWscale*cursize);
+ switch (*s++) {
+ case 'c':
+ h1 = get_float(s);
+ if (arg_tail==NULL) quit("Bad argument in ",s-2,"");
+ do_ellipse(h1,h1);
+ break;
+ case 'e':
+ h1 = get_float(s);
+ v1 = get_float(arg_tail);
+ if (arg_tail==NULL) quit("Bad argument in ",s-2,"");
+ do_ellipse(h1,v1);
+ break;
+ case 'A':
+ fprintf(mpxf, "reverse ");
+ /* fall through */
+ case 'a':
+ h1 = get_float(s);
+ v1 = get_float(arg_tail);
+ h2 = get_float(arg_tail);
+ v2 = get_float(arg_tail);
+ if (arg_tail==NULL) quit("Bad argument in ",s-2,"");
+ do_arc(gx+h1, gy-v1, -h1, v1, h2, -v2);
+ break;
+ case 'l': case 'p':
+ while (s!=NULL)
+ s = do_line(s);
+ fprintf(mpxf, ";\n");
+ break;
+ case 'q':
+ do s = spline_seg(s); while (s!=NULL);
+ fprintf(mpxf, ";\n");
+ break;
+ case '~':
+ fprintf(mpxf, "(%.3f,%.3f)--", gx*unit, gy*unit);
+ do s = spline_seg(s); while (s!=NULL);
+ fprintf(mpxf, "--(%.3f,%.3f);\n", gx*unit, gy*unit);
+ break;
+ default:
+ quit("Unknown drawing function",s-2,"");
+ }
+ h = (int) floor(gx+.5);
+ v = (int) floor(YCORR/unit+.5-gy);
+}
+
+
+
+/**************************************************************
+ Interpreting Troff Output
+***************************************************************/
+
+void change_font P1C(int,f)
+{
+ for (curfont=0; curfont<nfonts; curfont++)
+ if (font_num[curfont]==f) return;
+ quit("Bad font setting","","");
+}
+
+
+/* String s0 is everything following the initial `x' in a troff device control
+ command. A zero result indicates a stop command.
+*/
+int do_x_cmd P1C(char *,s0)
+{
+ float x;
+ int n;
+ char *s;
+
+ s = s0;
+ while (*s==' ' || *s=='\t') s++;
+ switch (*s++) {
+ case 'r':
+ if (unit!=0.0) quit("Attempt to reset resolution","","");
+ while (*s!=' ' && *s!='\t') s++;
+ unit = get_float(s);
+ if (unit<=0.0) quit("Bad resolution: x",s0,"");
+ unit = 72.0/unit;
+ break;
+ case 'f':
+ while (*s!=' ' && *s!='\t') s++;
+ n = get_int(s);
+ if (arg_tail==NULL) quit("Bad font def: x",s0,"");
+ s = arg_tail;
+ while (*s==' ' || *s=='\t') s++;
+ do_font_def(n, s);
+ break;
+ case 's':
+ return 0;
+ case 'H':
+ while (*s!=' ' && *s!='\t') s++;
+ Xheight = get_float(s);
+ /* GROFF troff output is scaled
+ groff_out(5): The argument to the s command is in scaled
+ points (units of points/n, where n is the argument
+ to the sizescale command in the DESC file.) The
+ argument to the x Height command is also in scaled points.
+ sizescale for groff devps is 1000
+ */
+ if(unit != 0.0) Xheight *= unit;
+ else Xheight /= 1000.0;
+ if (Xheight==cursize) Xheight=0.0;
+ break;
+ case 'S':
+ while (*s!=' ' && *s!='\t') s++;
+ Xslant = get_float(s)*(PI/180.0);
+ x = cos(Xslant);
+ if (-1e-4<x && x<1e-4) quit("Excessive slant","","");
+ Xslant = sin(Xslant)/x;
+ break;
+ default:
+ /* do nothing */;
+ }
+ return 1;
+}
+
+
+/* This routine reads commands from the troff output file up to and including
+ the next `p' or `x s' command. It also calls set_num_char() and set_char()
+ to generate output when appropriate. A zero result indicates that there
+ are no more pages to do.
+*/
+/* GROFF NOTE:
+ GNU groff uses an extended device-independent output file format
+ documented in groff_out(5). In order to allow parsing of groff's
+ output files, this function either needs to be extended to support
+ the new command codes, or else the use of the "t" and "u" commands
+ must be disabled by removing the line "tcommand" from the DESC file
+ in the $(prefix)/lib/groff/devps directory.
+*/
+int do_page()
+{
+ char buf[LLENGTH];
+ char a, *c, *cc;
+
+ h = v = 0;
+ while (fgets(buf,LLENGTH,trf)!=NULL) {
+ for (c=buf; *c!='\n'; c++)
+ if (*c=='\0') quit("Need to increase LLENGTH","","");
+ *c = '\0';
+ lnno++;
+ c = buf;
+ while (*c!='\0') {
+ switch(*c) {
+ case ' ': case '\t': case 'w':
+ c++;
+ break;
+ case 's':
+ cursize = get_float(c+1);
+ /* GROFF troff output is scaled
+ groff_out(5): The argument to the s command is in scaled
+ points (units of points/n, where n is the argument
+ to the sizescale command in the DESC file.) The
+ argument to the x Height command is also in scaled
+ points.
+ sizescale for groff devps is 1000
+ */
+ if (unit != 0.0) cursize *= unit;
+ else cursize /= 1000.0;
+ goto iarg;
+ case 'f':
+ change_font(get_int(c+1));
+ goto iarg;
+ case 'c':
+ if (c[1]=='\0') quit("Bad c command in troff output","","");
+ cc = c+2;
+ goto set;
+ case 'C':
+ cc=c; do cc++; while (*cc!=' ' && *cc!='\t' && *cc!='\0');
+ goto set;
+ case 'N':
+ set_num_char(curfont, get_int(c+1));
+ goto iarg;
+ case 'H':
+ h = get_int(c+1);
+ goto iarg;
+ case 'V':
+ v = get_int(c+1);
+ goto iarg;
+ case 'h':
+ h += get_int(c+1);
+ goto iarg;
+ case 'v':
+ v += get_int(c+1);
+ goto iarg;
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ if (c[1]<'0' || c[1]>'9' || c[2]=='\0')
+ quit("Bad nnc command in troff output","","");
+ h += 10*(c[0]-'0') + c[1]-'0';
+ c++;
+ cc = c+2;
+ goto set;
+ case 'p':
+ return 1;
+ case 'n':
+ (void) get_int(c+1);
+ (void) get_int(arg_tail);
+ goto iarg;
+ case 'D':
+ do_graphic(c+1);
+ goto eoln;
+ case 'x':
+ if (!do_x_cmd(c+1)) return 0;
+ goto eoln;
+ case '#':
+ goto eoln;
+ case 'F':
+ /* GROFF uses this command to report filename */
+ goto eoln;
+ case 'm':
+ /* GROFF uses this command to control color */
+ goto eoln;
+ case 'u':
+ /* GROFF uses this command to output a word with additional
+ white space between characters, not implemented
+ */
+ quit("Bad command in troff output\n",
+ "change the DESC file for your GROFF PostScript device, ",
+ "remove tcommand");
+ case 't':
+ /* GROFF uses this command to output a word */
+ cc=c; do cc++; while (*cc!=' ' && *cc!='\t' && *cc!='\0');
+ a= *cc; *cc='\0';
+ set_string(++c);
+ c = cc;
+ *c = a;
+ continue;
+ default:
+ quit("Bad command in troff output","","");
+ }
+ continue;
+ set:a= *cc; *cc='\0';
+ set_char(++c);
+ c = cc;
+ *c = a;
+ continue;
+ iarg:c = arg_tail;
+ }
+ eoln:/* do nothing */;
+ }
+ return 0;
+}
+
+
+/**************************************************************
+ Main Program
+***************************************************************/
+
+void dmp_usage P2C(char*,name, int,status)
+{
+ extern KPSEDLL char *kpse_bug_address;
+ FILE *f = status == 0 ? stdout : stderr;
+ fputs ("Usage: dmp [OPTION]... DITROFFFILE [MPXFILE]\n\
+ Translate DITROFFFILE to the MetaPost MPXFILE or standard output.\n\
+\n\
+--help display this help and exit\n\
+--version output version information and exit\n", f);
+ putc ('\n', f);
+ fputs ("Email bug reports to metapost@tug.org.\n", f);
+ exit(status);
+}
+
+int main P2C(int, argc, char**, argv)
+{
+ int more;
+
+ trf = stdin;
+ mpxf = stdout;
+
+ kpse_set_progname (argv[0]);
+
+ if (argc == 1) {
+ fputs ("dmp: Need one or two file arguments.\n", stderr);
+ fputs ("Try `dmp --help' for more information.\n", stderr);
+ exit(1);
+ } else if (argc > 1 && strcmp (argv[1], "--help") == 0) {
+ dmp_usage (argv[0], 0);
+ } else if (argc > 1 && strcmp (argv[1], "--version") == 0) {
+ printversionandexit (term_banner,
+ "AT&T Bell Laboratories", "John Hobby");
+ }
+ if (argc>3) dmp_usage(argv[0], 1);
+ if (argc>1) {
+ trf = fopen(argv[1], "r");
+ if (trf==(FILE*)0) {
+ fprintf (stderr, "%s: ", argv[0]);
+ perror (argv[1]);
+ exit(1);
+ }
+ if (argc>2) {
+ mpxf = fopen(argv[2], "w");
+ if (mpxf==(FILE*)0) {
+ fprintf (stderr, "%s: ", argv[0]);
+ perror (argv[2]);
+ exit(1);
+ }
+ }
+ }
+ fprintf(mpxf, "%s\n", banner);
+ read_fmap(dbname);
+ read_char_adj(adjname);
+ if (do_page()) {
+ do {
+ h=0; v=0;
+ Xslant = Xheight = 0.0;
+ start_picture();
+ more = do_page();
+ stop_picture();
+ fprintf(mpxf,"mpxbreak\n");
+ } while (more);
+ }
+ return 0;
+}
diff --git a/Build/source/texk/web2c/mpware/dmp.rc b/Build/source/texk/web2c/mpware/dmp.rc
new file mode 100644
index 00000000000..d658e8905d3
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/dmp.rc
@@ -0,0 +1,34 @@
+/* dmp.rc: dmp resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " dmp 0.64"
+
+#define VER_INTERNALNAME_STR "dmp"
+#define VER_ORIGINALFILENAME_STR "dmp.exe"
+
+#define VER_LEGALCOPYRIGHT_STR " Copyright 1990 - 1995 by AT&T Bell Laboratories"
+
+#define VER_FILEDESCRIPTION_STR "Converts Troff device independent files Into METAPOST readable Files"
+
+#include <texlive.version>
+
+/* dmp.rc ends here */
diff --git a/Build/source/texk/web2c/mpware/makempx.in b/Build/source/texk/web2c/mpware/makempx.in
new file mode 100644
index 00000000000..8aaa9bac1dc
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/makempx.in
@@ -0,0 +1,181 @@
+#!/bin/sh
+# $Id: makempx.in,v 1.18 2005/06/22 17:33:26 olaf Exp $
+# Make an MPX file from the labels in a MetaPost source file,
+# using mpto and either dvitomp (TeX) or dmp (troff).
+# From John Hobby's original (though there's not much of it left by now).
+# Public domain.
+#
+#
+version=0.9
+
+: ${DMP=dmp}
+: ${DVITOMP=dvitomp}
+: ${MAKEMPX_BINDIR=`echo $0 | sed 's%/[^/]*$%%'`}
+: ${MPTEXPRE=mptexpre.tex}
+: ${MPTOTEX='mpto -tex'}
+: ${MPTOTR='mpto -troff'}
+: ${NEWER=newer}
+# This is oriented towards GNU roff: old value was
+# 'eqn -Tpost -d\$\$ | troff -Tpost'
+: ${TROFF='eqn -Tps -d\$\$ | troff -Tps'}
+
+# convert relative path to absolute in $MAKEMPX_BINDIR:
+case "$MAKEMPX_BINDIR" in
+ /*) ;;
+ *) MAKEMPX_BINDIR=`pwd`/$MAKEMPX_BINDIR;;
+esac
+
+PATH=$MAKEMPX_BINDIR:/bin:/usr/bin:$PATH
+
+# These names are documented in the MetaPost manual, so it's
+# unwise to change them.
+ERRLOG=mpxerr.log # file for an error log if necessary
+TEXERR=mpxerr.tex # file for erroneous TeX if any
+DVIERR=mpxerr.dvi # troublesome dvi file if any
+TROFF_INERR=mpxerr # file for erroneous troff input, if any
+TROFF_OUTERR=mpxerr.t # file for troublesome troff output, if any
+
+
+usage="Usage: $0 [-tex|-tex=<program>|-troff] MPFILE MPXFILE.
+ If MPXFILE is older than MPFILE, translate the labels from the MetaPost
+ input file MPFIle to low-level commands in MPXFILE, by running
+ $MPTOTEX, $TEX, and $DVITOMP
+ by default; or, if -troff is specified,
+ $MPTOTR, $TROFF, and $DMP.
+
+ The current directory is used for writing temporary files. Errors are
+ left in mpxerr.{tex,log,dvi}.
+
+ If the file named in \$MPTEXPRE (mptexpre.tex by default) exists, it is
+ prepended to the output in tex mode.
+
+Email bug reports to metapost@tug.org."
+
+
+mode=tex
+
+while test $# -gt 0; do
+ case "$1" in
+ -help|--help)
+ echo "$usage"; exit 0;;
+ -version|--version)
+ echo "`basename $0` $version"
+ echo "There is NO warranty. This script is public domain.
+Primary author: John Hobby."
+ exit 0;;
+ -troff|--troff) mode=troff;;
+ -tex|--tex) mode=tex;;
+ -tex=*|--tex=*) mode=tex; TEX=`echo "$1" | sed 's/^-*tex=//'`;;
+ -*)
+ echo "$0: Invalid option: $1." >&2
+ echo "Try \``basename $0` --help' for more information." >&2
+ exit 1;;
+ *)
+ if test -z "$MPFILE"; then
+ MPFILE=$1 # input file
+ elif test -z "$MPXFILE"; then
+ MPXFILE=$1 # output file
+ else
+ echo "$0: Extra argument $1." >&2
+ echo "Try \``basename $0` --help' for more information." >&2
+ exit 1
+ fi;;
+ esac
+ shift
+done
+
+if test -z "$MPFILE" || test -z "$MPXFILE"; then
+ echo "$0: Need exactly two file arguments." >&2
+ echo "Try \``basename $0` --help' for more information." >&2
+ exit 1
+fi
+
+trap "rm -f mpx$$.* \"$ERRLOG\"; exit 4" 1 2 3 15
+
+# If MPX file is up-to-date, do nothing.
+if $NEWER "$MPFILE" "$MPXFILE"; then
+
+ # Have to remake.
+ # Step 0: Check typesetter mode for consistency.
+ case "$mode" in
+ tex) MPTO="$MPTOTEX";;
+ troff) MPTO="$MPTOTR";;
+ *) echo "$0: Unknown typesetter mode: $mode" >&2
+ exit 1;;
+ esac
+
+ # Step 1: Extract typesetter source from MetaPost source.
+ if $MPTO "$MPFILE" >mpx$$.tex 2>"$ERRLOG"; then :;
+ # success
+ else
+ # failure
+ echo "$0: Command failed: $MPTO $MPFILE" >&2
+ cat "$ERRLOG" >&2
+ rm -f mpx$$.tex
+ exit 1
+ fi
+ if test "$mode" = troff; then
+ mv -f mpx$$.tex mpx$$.i
+ fi
+
+ # Step 2: Run typesetter.
+ if test "$mode" = tex; then
+ if test -r "$MPTEXPRE"; then
+ # Prepend user file.
+ cat "$MPTEXPRE" mpx$$.tex >mpx$$.tmp
+ mv mpx$$.tmp mpx$$.tex
+ fi
+
+ test -z "$TEX" && \
+ TEX=`sed -n '1s/%\&[ ]*\([^ ]*\).*$/\1 --parse-first-line/p;q' mpx$$.tex`
+ test -z "$TEX" && TEX='tex --parse-first-line'
+
+ if $TEX --interaction=batchmode mpx$$.tex </dev/null >/dev/null; then
+ WHATEVER_TO_MPX="$DVITOMP"
+ INFILE=mpx$$.dvi
+ INERROR=$DVIERR
+ else
+ # failure
+ mv -f mpx$$.tex "$TEXERR"
+ mv -f mpx$$.log "$ERRLOG"
+ echo "$0: Command failed: $TEX $TEXERR; see $ERRLOG" >&2
+ exit 2
+ fi
+ elif test "$mode" = troff; then
+ if cat mpx$$.i | eval $TROFF >mpx$$.t; then
+ # success, prepare for step 3.
+ WHATEVER_TO_MPX="$DMP"
+ INFILE=mpx$$.t
+ INERROR=$TROFF_OUTERR
+ else
+ # failure
+ mv -f mpx$$.i "$TROFF_INERR"
+ echo "$0: Command failed: cat $TROFF_INERR | $TROFF" >&2
+ rm -f mpx$$.t
+ exit 2
+ fi
+ else
+ echo "$0: Unknown typesetter mode: $mode; how did this happen?" >&2
+ exit 2
+ fi
+
+ # Step 3: Translate typesetter output to a MetaPost MPX.
+ if $WHATEVER_TO_MPX "$INFILE" "$MPXFILE" >"$ERRLOG"; then
+ : # success
+ else
+ # failure
+ mv -f "$INFILE" "$INERROR"
+ test $mode = troff && mv -f mpx$$.i "$TROFF_INERR"
+ echo "$0: Command failed: $WHATEVER_TO_MPX $INERROR $MPXFILE" >&2
+ # Better to remove $MPXFILE if something went wrong rather than
+ # leaving behind an unfinished or unusable version since $NEWER
+ # might think that all is fine if $MPXFILE exists.
+ rm -f "$MPXFILE"
+ cat "$ERRLOG" >&2
+ exit 3
+ fi
+
+ rm -f "$ERRLOG" mpx$$.*
+fi
+
+exit 0
diff --git a/Build/source/texk/web2c/mpware/mpto.c b/Build/source/texk/web2c/mpware/mpto.c
new file mode 100644
index 00000000000..0bc29fc259b
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/mpto.c
@@ -0,0 +1,365 @@
+/* $Id: mpto.c,v 1.21 2005/08/28 09:17:25 olaf Exp $
+ * Public domain.
+ *
+ * Previous versions of mpto were copyright 1990 - 1995 by AT&T Bell
+ * Laboratories. It has since been put into the public domain.
+ *
+ * John Hobby wrote the original version, which has since been
+ * extensively altered.
+ */
+
+/* mpto [-tex|-troff] MPFILE
+ *
+ * This program transforms a MetaPost input file into a TeX or troff input
+ * file by stripping out btex...etex and verbatimtex...etex sections.
+ * Leading and trailing spaces and tabs are removed from the extracted
+ * material and it is surrounded by the preceding and following strings
+ * defined immediately below. The input file should be given as argument 1
+ * and the resulting TeX or troff file is written on standard output.
+ *
+ * Changes incorporated from Web2c:
+ * - merged TeX and troff mode
+ * - support -E<errlog>, for AMIGA
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef WIN32
+#include <string.h>
+#endif
+
+
+/* MetaPost itself has a configurable max line length, but we can afford to
+ use smaller values than that */
+#define bufsize 1000
+
+char* tex_predoc = "";
+char* tex_postdoc = "\\end{document}\n";
+char* tex_pretex1 = "\\gdef\\mpxshipout{\\shipout\\hbox\\bgroup%\n"
+ " \\setbox0=\\hbox\\bgroup}%\n"
+ "\\gdef\\stopmpxshipout{\\egroup"
+ " \\dimen0=\\ht0 \\advance\\dimen0\\dp0\n"
+ " \\dimen1=\\ht0 \\dimen2=\\dp0\n"
+ " \\setbox0=\\hbox\\bgroup\n"
+ " \\box0\n"
+ " \\ifnum\\dimen0>0 \\vrule width1sp height\\dimen1 depth\\dimen2 \n"
+ " \\else \\vrule width1sp height1sp depth0sp\\relax\n"
+ " \\fi\\egroup\n"
+ " \\ht0=0pt \\dp0=0pt \\box0 \\egroup}\n"
+ "\\mpxshipout%% line %d %s\n";
+char* tex_pretex = "\\mpxshipout%% line %d %s\n";
+char* tex_posttex = "\\stopmpxshipout\n";
+char* tex_preverb1 = ""; /* if very first instance */
+char* tex_preverb = "%% line %d %s\n"; /* all other instances */
+char* tex_postverb = "%\n";
+
+/* According to CSTR #54 the ".lf" directive should be ".lf %d %s",
+ * not ".lf line %d %s" as used in the original code. This affects
+ * troff_pretex1, troff_pretex, troff_preverb1, troff_preverb.
+ */
+char* troff_predoc = ".po 0\n";
+char* troff_postdoc = "";
+char* troff_pretex1 = ".lf %d %s\n"; /* first instance */
+char* troff_pretex = ".bp\n.lf %d %s\n"; /* subsequent instances */
+char* troff_posttex = "\n";
+char* troff_preverb1 = ".lf %d %s\n";
+char* troff_preverb = ".lf %d %s\n";
+char* troff_postverb = "\n";
+
+char* predoc;
+char* postdoc;
+char* pretex1;
+char* pretex;
+char* posttex;
+char* preverb1;
+char* preverb;
+char* postverb;
+
+char *mpname;
+FILE *mpfile;
+int lnno = 0; /* current line number */
+int texcnt = 0; /* btex..etex blocks so far */
+int verbcnt = 0; /* verbatimtex..etex blocks so far */
+char *bb, *tt, *aa; /* start of before, token, and after strings */
+char buf[bufsize]; /* the input line */
+
+void
+err (char * msg)
+{
+ fprintf(stderr, "mpto: %s:%d: %s\n",mpname, lnno, msg);
+ exit(1);
+}
+
+void
+usage (char *progn)
+{
+ fprintf(stderr, "Try `%s --help' for more information\n", progn);
+ exit(1);
+}
+
+char *
+getline(void) /* returns NULL on EOF or error, otherwise buf */
+{
+ int c;
+ unsigned loc = 0;
+ while ((c = getc (mpfile)) != EOF && c != '\n' && c != '\r') {
+ buf[loc++] = c;
+ if (loc == bufsize)
+ err("Line is too long");
+ }
+ if (c == EOF) return NULL;
+ buf[loc] = 0;
+ if (c == '\r') {
+ c = getc(mpfile);
+ if (c != '\n') ungetc(c, mpfile);
+ }
+ lnno++;
+ return buf;
+}
+
+
+/* Return nonzero if a prefix of string s matches the null-terminated string t
+ * and the next character is not a letter of an underscore.
+ */
+int
+match_str (char *s, char *t)
+{
+ while (*t!=0) {
+ if (*s!=*t) return 0;
+ s++; t++;
+ }
+ switch (*s) {
+ case 'a': case 'c': case 'd': case 'f': case 'g': case 'h':
+ case 'i': case 'j': case 'k': case 'l': case 'm': case 'n':
+ case 'o': case 'p': case 'q': case 'r': case 's': case 't':
+ case 'u': case 'w': case 'x': case 'y': case 'z': case '_':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z': case 'b': case 'e': case 'v':
+ return 0;
+ default:
+ return 1;
+ }
+}
+
+
+/* This function tries to express s as the concatenation of three strings
+ * b, t, a, with the global pointers bb, tt, and aa set to the start of the
+ * corresponding strings. String t is either a quote mark, a percent sign,
+ * or an alphabetic token "btex", "etex", or "verbatimtex". (An alphabetic
+ * token is a maximal sequence of letters and underscores.) If there are
+ * several possible substrings t, we choose the leftmost one. If there is
+ * no such t, we set b=s and return 0.
+ */
+int
+getbta (char *s)
+{
+ int ok=1; /* zero if last character was a-z, A-Z, or _ */
+
+ bb = s;
+ for (tt=bb; *tt!=0; tt++)
+ switch (*tt) {
+ case '"': case '%':
+ aa = tt+1;
+ return 1;
+ case 'b':
+ if (ok && match_str(tt,"btex")) {
+ aa = tt+4;
+ return 1;
+ } else ok=0;
+ break;
+ case 'e':
+ if (ok && match_str(tt,"etex")) {
+ aa = tt+4;
+ return 1;
+ } else ok=0;
+ break;
+ case 'v':
+ if (ok && match_str(tt,"verbatimtex")) {
+ aa = tt+11;
+ return 1;
+ } else ok=0;
+ break;
+ case 'a': case 'c': case 'd': case 'f': case 'g': case 'h':
+ case 'i': case 'j': case 'k': case 'l': case 'm': case 'n':
+ case 'o': case 'p': case 'q': case 'r': case 's': case 't':
+ case 'u': case 'w': case 'x': case 'y': case 'z': case '_':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ ok = 0;
+ break;
+ default:
+ ok = 1;
+ }
+ aa = tt;
+ return 0;
+}
+
+
+void
+copytex(void)
+{
+ char *s; /* where a string to print stops */
+ char c;
+
+ while (*aa==' ' || *aa=='\t') aa++;
+ if (*aa==0)
+ if ((aa=getline())==NULL)
+ err("btex section does not end");
+ do { if (*aa==0)
+ if ((aa=getline())==NULL)
+ err("btex section does not end");
+ else printf("\n");
+ if (getbta(aa) && *tt=='e') {
+ s = tt-1;
+ while (s>=bb && (*s==' ' || *s=='\t'))
+ s--;
+ s++;
+ } else {
+ if (*tt=='b') err("btex in TeX mode");
+ if (*tt=='v') err("verbatimtex in TeX mode");
+ s = aa;
+ }
+ c = *s;
+ *s = 0;
+ printf("%s", bb);
+ *s = c;
+ } while (*tt!='e');
+}
+
+
+void
+do_line(void)
+{
+ aa = buf;
+ while (getbta(aa))
+ if (*tt=='%') break;
+ else if (*tt=='"') {
+ do if (!getbta(aa)) err("string does not end");
+ while (*tt!='"');
+ } else if (*tt=='b') {
+ if (texcnt++ ==0) printf(pretex1,lnno,mpname);
+ else printf(pretex,lnno,mpname);
+ copytex();
+ printf("%s",posttex);
+ } else if (*tt=='v') {
+ if (verbcnt++ ==0 && texcnt==0)
+ printf(preverb1,lnno,mpname);
+ else printf(preverb,lnno,mpname);
+ copytex();
+ printf("%s",postverb);
+ } else err("unmatched etex");
+}
+
+int
+main(int argc, char **argv)
+{
+ int mode;
+ if (argc == 1) {
+ fputs ("mpto: Need exactly one file argument.\n", stderr);
+ fputs ("Try `mpto --help' for more information.\n", stderr);
+ exit(1);
+ } else if (argc > 1 && (strcmp (argv[1], "--help") == 0
+ || strcmp (argv[1], "-help") == 0)) {
+ fputs ("Usage: mpto [-tex|-troff] MPFILE",stdout);
+#ifdef AMIGA
+ fputs (" [-E<errlog-file>]",stdout);
+#endif
+ fputs ("\n Strip btex..etex and verbatimtex...etex parts from MetaPost input\n\
+ file MPFILE, converting to either TeX or troff (TeX by default).\n\
+\n\
+--help display this help and exit\n\
+--version output version information and exit\n",stdout);
+ fputs ("\nEmail bug reports to metapost@tug.org.\n", stdout);
+ exit (0);
+ } else if (argc > 1 && (strcmp (argv[1], "--version") == 0
+ || strcmp (argv[1], "-version") == 0)) {
+ printf ("mpto 0.902\n\
+This program is in the public domain.\n\
+Primary author of mpto: John Hobby.\n");
+ exit (0);
+ } else if (argc == 2) {
+ mpname = argv[1];
+ mode = 0;
+#ifdef AMIGA
+ } else if (argc == 3) {
+ if (strcmp (argv[1], "-tex") == 0) {
+ mpname = argv[2];
+ mode = 0;
+ } else if (strcmp (argv[1], "-troff") == 0) {
+ mpname = argv[2];
+ mode = 1;
+ } else if (strncmp(argv[2], "-E", 2) || (argv[2]+2 == NULL)) {
+ usage(argv[0]);
+ } else {
+ mpname = argv[1];
+ freopen(argv[2]+2, "w", stderr);
+ }
+ } else if (argc == 4) {
+ if (strcmp (argv[1], "-tex") == 0) {
+ mode = 0;
+ } else if (strcmp (argv[1], "-troff") == 0) {
+ mode = 1;
+ } else {
+ usage(argv[0]);
+ }
+ if (strncmp(argv[3], "-E", 2) || (argv[3]+2 == NULL)) {
+ usage(argv[0]);
+ } else {
+ mpname = argv[2];
+ freopen(argv[3]+2, "w", stderr);
+ }
+#else /* not AMIGA */
+ } else if (argc == 3) {
+ if (strcmp (argv[1], "-tex") == 0) {
+ mode = 0;
+ } else if (strcmp (argv[1], "-troff") == 0) {
+ mode = 1;
+ } else {
+ usage (argv[0]);
+ }
+ mpname = argv[2];
+#endif /* not AMIGA */
+ } else {
+ usage(argv[0]);
+ }
+
+ mpfile = fopen(mpname, "r");
+ if (mpfile==NULL) {
+ fprintf (stderr, "%s: ", argv[0]);
+ perror (mpname);
+ exit (1);
+ }
+
+ /* This is far from elegant, but life is short. */
+ if (mode == 0) {
+ predoc = tex_predoc;
+ postdoc = tex_postdoc;
+ pretex1 = tex_pretex1;
+ pretex = tex_pretex;
+ posttex = tex_posttex;
+ preverb1 = tex_preverb1;
+ preverb = tex_preverb;
+ postverb = tex_postverb;
+ } else {
+ predoc = troff_predoc;
+ postdoc = troff_postdoc;
+ pretex1 = troff_pretex1;
+ pretex = troff_pretex;
+ posttex = troff_posttex;
+ preverb1 = troff_preverb1;
+ preverb = troff_preverb;
+ postverb = troff_postverb;
+ }
+ printf("%s",predoc);
+ while (getline()!=NULL)
+ do_line();
+ printf("%s",postdoc);
+ exit(0);
+}
diff --git a/Build/source/texk/web2c/mpware/mpto.rc b/Build/source/texk/web2c/mpware/mpto.rc
new file mode 100644
index 00000000000..831b2d588f4
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/mpto.rc
@@ -0,0 +1,34 @@
+/* mpto.rc: mpto resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " mpto 0.63"
+
+#define VER_INTERNALNAME_STR "mpto"
+#define VER_ORIGINALFILENAME_STR "mpto.exe"
+
+#define VER_FILEDESCRIPTION_STR "Converts MetaPost Files Into TeX Files\0"
+#define VER_LEGALCOPYRIGHT_STR " Copyright 1990 - 1995 by AT&T Bell Laboratories"
+#define VER_COMPANYNAME_STR "AT&T Bell Laboratories"
+
+#include <texlive.version>
+
+/* mpto.rc ends here */
diff --git a/Build/source/texk/web2c/mpware/newer.c b/Build/source/texk/web2c/mpware/newer.c
new file mode 100644
index 00000000000..69ab23aeb67
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/newer.c
@@ -0,0 +1,144 @@
+/* newer - true if any source file is newer than the target file.
+ *
+ * Public domain.
+ *
+ * This program used to be Copyright 1990 - 1995 by AT&T Bell Laboratories,
+ * and the original version was written by John Hobby. It has since been
+ * placed in the public domain.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "c-auto.h" /* In case we need, e.g., _POSIX_SOURCE */
+#include "config.h"
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+#ifndef WIN32
+#include <sys/types.h>
+#include <sys/stat.h>
+#endif
+
+/* Exit codes are 0 for success ("true") and 1 for failure ("false"). */
+#define exit_false 1
+#define exit_true 0
+
+/* We may have high-res timers in struct stat. If we do, use them. */
+#if HAVE_ST_MTIM
+#define NEWER(S,T) (S.st_mtim.tv_sec > T.st_mtim.tv_sec || \
+ (S.st_mtim.tv_sec == T.st_mtim.tv_sec && \
+ S.st_mtim.tv_nsec >= T.st_mtim.tv_nsec))
+#else
+#define NEWER(S,T) (S.st_mtime >= T.st_mtime)
+#endif
+
+int i;
+int verbose = 1;
+int missing_source = 0;
+int missing_target = 0;
+int result = exit_false;
+
+/*
+ * newer src1 [ src2 ... srcN ] target
+ *
+ * returns 0 if files `src1' ... `srcN' exist and
+ * at least one of them is not older than `target'
+ * or if `target' doesn't exist.
+ */
+
+int
+main(int argc, char **argv)
+{
+ struct stat source_stat, target_stat;
+
+ while ((argc > 1) && (argv[1][0] == '-')) {
+ if (strcmp(argv[1], "-v") == 0 ||
+ strcmp(argv[1], "-verbose") == 0 ||
+ strcmp(argv[1], "--verbose") == 0) {
+
+ verbose = 1;
+ argv++;
+ argc--;
+
+ } else if (strcmp(argv[1], "-q") == 0 ||
+ strcmp(argv[1], "-quiet") == 0 ||
+ strcmp(argv[1], "--quiet") == 0) {
+
+ verbose = 0;
+ argv++;
+ argc--;
+
+ } else if (strcmp(argv[1], "-help") == 0 ||
+ strcmp(argv[1], "--help") == 0) {
+
+ fputs("Usage: newer [OPTION] src1 [ src2 ... srcN ] target\n\
+ Exit successfully if `src1' ... `srcN' exist and at least\n\
+ one of them is not older than `target'.\n\
+ Also exit successfully if `target' doesn't exist.\n\
+\n\
+--help display this help and exit\n\
+--quiet do not print anything\n\
+--verbose list missing input files (default)\n\
+--version output version information and exit\n\n", stdout);
+ fputs ("Email bug reports to metapost@tug.org.\n", stdout);
+ exit(0);
+
+ } else if (strcmp(argv[1], "-version") == 0 ||
+ strcmp(argv[1], "--version") == 0) {
+
+ fputs("newer 0.901\n\
+This program is in the public domain.\n\
+Primary author of newer: John Hobby.\n", stdout);
+ exit(0);
+
+ } else {
+
+ fprintf(stderr, "newer: Unknown option \"%s\"\n", argv[1]);
+ fputs("Try `newer --help' for more information.\n", stderr);
+ exit(1);
+
+ }
+ }
+
+ /* do we have at least two arguments? */
+ if (argc < 3) {
+ fputs ("newer: Too few arguments.\n\
+Try `newer --help' for more information.\n", stderr);
+ exit(1);
+ }
+
+ /* check the target file */
+ if (stat(argv[argc-1], &target_stat) < 0) {
+ if (verbose) {
+ fprintf(stderr, "newer: target file `%s' doesn't exist.\n",
+ argv[argc-1]);
+ }
+ missing_target = 1;
+ }
+
+ /* check the source files */
+ for (i = 1; i < (argc-1); i++) {
+ if (stat(argv[i], &source_stat) < 0) {
+ if (verbose) {
+ fprintf (stderr, "newer: source file `%s' doesn't exist.\n",
+ argv[i]);
+ }
+ missing_source = 1;
+ } else if (!missing_target) {
+ if (NEWER(source_stat, target_stat)) {
+ result = exit_true;
+ }
+ }
+ }
+
+ /* Adjust result for cases when source or target is missing:
+ * missing source => exit_false
+ * missing target => exit_true
+ */
+ if (missing_source) {
+ result = exit_false;
+ } else if (missing_target) {
+ result = exit_true;
+ }
+
+ return result;
+}
diff --git a/Build/source/texk/web2c/mpware/win32.mak b/Build/source/texk/web2c/mpware/win32.mak
new file mode 100644
index 00000000000..64a6109575e
--- /dev/null
+++ b/Build/source/texk/web2c/mpware/win32.mak
@@ -0,0 +1,75 @@
+################################################################################
+#
+# Makefile : Web2C / mpware
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <03/02/21 11:53:59 popineau>
+#
+################################################################################
+root_srcdir = ..\..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+USE_KPATHSEA = 1
+USE_GNUW32 = 1
+
+!include <msvc/common.mak>
+
+DEFS = -I.. $(DEFS) -DHAVE_CONFIG_H
+proglib = ../lib/$(objdir)/lib.lib
+programs = $(objdir)\dmp.exe $(objdir)\mpto.exe $(objdir)\newer.exe
+
+default: all
+all: $(objdir) $(programs)
+
+$(objdir)\dmp.exe: $(objdir)\dmp.obj $(objdir)\dmp.res $(proglib) $(kpathsealib)
+ $(link) $(**) $(conlibs)
+$(objdir)\mpto.exe: $(objdir)\mpto.obj $(objdir)\mpto.res $(proglib) $(kpathsealib)
+ $(link) $(**) $(conlibs)
+$(objdir)\newer.exe: $(objdir)\newer.obj $(proglib) $(gnuw32lib)
+ $(link) $(**) $(conlibs)
+
+$(objdir)\newer.obj: newer.c
+ $(compile) -UKPSE_DLL newer.c
+
+checkdir = $(srcdir)\..\tests
+check: $(objdir)\mpto.exe $(objdir)\newer.exe $(objdir)\dmp.exe
+ pushd $(root_srcdir)\texk\contrib & $(make) $(objdir)\makempx.exe & popd
+ $(top_srcdir)\contrib\$(objdir)\makempx $(checkdir)/label.mp $(checkdir)/xlabel.mpx
+ .\$(objdir)\mpto -tex $(checkdir)/testex.mp | diff $(checkdir)/testex.tex -
+ $(sed) '16s/^%//' <$(checkdir)/testex.mp >testex1
+ -.\$(objdir)\mpto -tex testex1 >nul 2>testex2
+ $(sed) '17s/^%//' <$(checkdir)/testex.mp >testex1
+ -.\$(objdir)\mpto -tex testex1 >nul 2>>testex2
+ $(sed) '18s/^%//' <$(checkdir)/testex.mp >testex1
+ -.\$(objdir)\mpto -tex testex1 >nul 2>>testex2
+ $(sed) '19s/^%//' <$(checkdir)/testex.mp >testex1
+ -.\$(objdir)\mpto -tex testex1 >nul 2>>testex2
+ $(sed) '20s/^%//' <$(checkdir)/testex.mp >testex1
+ -.\$(objdir)\mpto -tex testex1 >nul 2>>testex2
+ $(diff) $(checkdir)/testex.err testex2
+
+#Makefile: Makefile.in ../config.status
+# (cd ..; sh config.status)
+
+!include <msvc/config.mak>
+!include <msvc/install.mak>
+
+install:: install-exec
+
+install-programs: install-exec
+
+!include <msvc/clean.mak>
+
+clean::
+ -@$(del) testex1 testex2
+
+!include <msvc/rdepend.mak>
+!include "./depend.mak"
+
+# Local Variables:
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/omega.rc b/Build/source/texk/web2c/omega.rc
new file mode 100644
index 00000000000..e9993373c3a
--- /dev/null
+++ b/Build/source/texk/web2c/omega.rc
@@ -0,0 +1,37 @@
+/* omega.rc: omega resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " Omega 3.14159--1.23.2"
+
+#define VER_INTERNALNAME_STR TEXLIVE_LIBRARYPREFIX_STR "omega"
+#define VER_ORIGINALFILENAME_STR TEXLIVE_LIBRARYPREFIX_STR "omega.dll"
+
+#define VER_FILEDESCRIPTION_STR "Omega DLL"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1994--2003 by John Plaice and Yannis Haralambous."
+#define VER_LEGALTRADEMARKS_STR "TeX is a trademark of the American Mathematical Society."
+
+#define VER_FILETYPE VFT_DLL
+
+#include <texlive.version>
+
+/* omega.rc ends here */
diff --git a/Build/source/texk/web2c/omegadir-1.15/README b/Build/source/texk/web2c/omegadir-1.15/README
new file mode 100644
index 00000000000..c8b8d0d048f
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/README
@@ -0,0 +1,12 @@
+This directory contains part of the Omega distribution, other parts
+are found in ../otps, and several files in the parent directory. You
+will also need odvips, the sources of which might be present in
+../../odvips.
+
+Omega is very much experimental software, and may prove hard or
+impossible to build on your system. At present, you need to install
+bison (the GNU version of yacc) and lex or flex to build otp2ocp from
+scratch. If you do not have these programs, you can try to use the
+y_tab.c-dist, y_tab.h-dist, and lex.yy.c-dist files to complete the
+build.
+
diff --git a/Build/source/texk/web2c/omegadir-1.15/com-supp-w32.ch b/Build/source/texk/web2c/omegadir-1.15/com-supp-w32.ch
new file mode 100644
index 00000000000..162cf594ec6
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/com-supp-w32.ch
@@ -0,0 +1,26 @@
+@x
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@y
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@!halt_on_error_p:boolean; {allow only on error.}
+@z
+
+@x
+ ready_already:=0;
+@y
+ ready_already:=0;
+ texmf_finish_job;
+@z
+
+@x
+print_char("."); show_context;
+@y
+if not file_line_error_style_p then begin
+ print_char("."); show_context
+end;
+
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+
+@z
diff --git a/Build/source/texk/web2c/omegadir-1.15/com16bit.ch b/Build/source/texk/web2c/omegadir-1.15/com16bit.ch
new file mode 100644
index 00000000000..8fec86a75b4
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/com16bit.ch
@@ -0,0 +1,2482 @@
+% com16bit.ch: Omega version of file tex.ch
+%
+% tex.ch for C compilation with web2c, derived from various other change files.
+% By Tim Morgan, UC Irvine ICS Department, and many others.
+%
+% (05/28/86) ETM Started with TeX 2.0
+% (06/03/87) ETM Brought up to TeX 2.2
+% (09/26/87) ETM Brought up to TeX 2.3
+% (10/01/87) ETM Brought up to TeX 2.5
+% (12/21/87) ETM Brought up to TeX 2.7
+% (01/14/88) ETM Brought up to TeX 2.9
+% (02/20/88) PAM Revised format and module numbers
+% (03/01/88) ETM Eliminated some unused variables and unnecesary tests
+% (05/09/88) ETM Added yet another casting bug fix
+% (06/21/88) ETM Brought up to TeX version 2.93
+% (12/11/88) ETM Brought up to TeX version 2.94
+% (01/12/89) PAM Brought up to TeX version 2.95
+% (02/14/89) ETM Brought up to TeX version 2.96
+% (03/10/89) ETM Brought up to TeX version 2.98
+% (07/06/89) ETM Brought up to TeX version 2.991
+% (11/30/89) KB To version 2.992 (8-bit).
+% (01/10/90) SR To version 2.993.
+% (03/27/90) KY To version 3.0.
+% (more recent changes in ChangeLog)
+%
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+%
+% The module numbers in this change file refer to TEX.WEB 3.141592 as
+% of March, 1995 (published as Donald E. Knuth, TeX: The Program,
+% Volume B of Computers & Typesetting).
+
+@x [0.0] l.83 - WEAVE: print changes only.
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+@y 83
+ \def\?##1]{\hbox{Changes to \hbox to 1em{\hfil##1}.\ }}
+ }
+\let\maybe=\iffalse
+@z
+
+@x
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@y
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@d banner_k=='This is Omegak, Version 3.141592--1.15' {printed when \TeX\ starts}
+@z
+
+@x [1.4] l.233 - program header
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \TeX\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+@y
+@z
+
+@x [1.4] l.243 - labels in outer block not needed
+program OMEGA; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+@y
+program OMEGA; {all file names are defined dynamically}
+@z
+
+@x [1.6] l.267 - labels in outer block not needed
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d end_of_TEX=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
+ {key control points}
+@y
+@ For Web2c, labels are not declared in the main program, but
+we still have to declare the symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d final_end=9999 {this label marks the ending of the program}
+@z
+
+% Here we change these WEB symbols, which are used much as #ifdef's
+% are in C, into something which will get translated into actual #ifdef's.
+@x [1.7] l.292 - debug..gubed, stat..tats
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==ifdef('TEXMF_DEBUG')
+@d gubed==endif('TEXMF_DEBUG')
+@z
+@x [1.7] l.297 - debug..gubed, stat..tats
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@y
+@d stat==ifdef('STAT')
+@d tats==endif('STAT')
+@z
+
+@x [1.8] l.312 - Same, for `init...tini'.
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y 312
+@d init==ifdef('INITEX')
+@d tini==endif('INITEX')
+@z
+
+@x [1.8] l.319 - init...tini is dynamic
+@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
+@y 318
+@!init
+if ini_version then
+ begin @<Initialize table entries (done by \.{INITEX} only)@>@;
+ end;
+@+tini
+@z
+
+@x [1.11] l.375 - Compile-time constants: most removed for dynamic allocation.
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@y
+@d file_name_size == maxint
+@d ssup_error_line = 255
+@d ssup_max_strings ==200000
+{Larger values may be used, but then the arrays consume much more memory.}
+@d ssup_trie_opcode == 65535
+@d ssup_trie_size == 4194303
+
+@d ssup_hyph_size == 65535 {Changing this requires changing (un)dumping!}
+@d iinf_hyphen_size == 610 {Must be not less than |hyph_prime|!}
+
+@<Constants...@>=
+@!mem_bot=0; {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+ {Use |mem_bot=0| for compilers which cannot decrement pointers.}
+@z
+
+@x
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TeXformats:OMEGA.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@y
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@!hash_offset=514; {smallest index in hash array, i.e., |hash_base| }
+ {Use |hash_offset=0| for compilers which cannot decrement pointers.}
+@!trie_op_size=15011; {space for ``opcodes'' in the hyphenation patterns;
+ best if relatively prime to 313, 361, and 1009.}
+@!neg_trie_op_size=-15011; {for lower |trie_op_hash| array bound;
+ must be equal to |-trie_op_size|.}
+@!min_trie_op=0; {first possible trie op code for any language}
+@!max_trie_op=ssup_trie_opcode; {largest possible trie opcode for any language}
+@!pool_name=TEX_POOL_NAME; {this is configurable, for the sake of ML-\TeX}
+ {string of length |file_name_size|; tells where the string pool appears}
+@#
+@!inf_main_memory = 2000000;
+@!sup_main_memory = 16000000;
+
+@!inf_trie_size = 80000;
+@!sup_trie_size = ssup_trie_size;
+
+@!inf_max_strings = 100000;
+@!sup_max_strings = ssup_max_strings;
+
+@!inf_strings_free = 100;
+@!sup_strings_free = sup_max_strings;
+
+@!inf_buf_size = 500;
+@!sup_buf_size = 200000;
+
+@!inf_nest_size = 40;
+@!sup_nest_size = 400;
+
+@!inf_max_in_open = 6;
+@!sup_max_in_open = 127;
+
+@!inf_param_size = 60;
+@!sup_param_size = 600;
+
+@!inf_save_size = 600;
+@!sup_save_size = 40000;
+
+@!inf_stack_size = 200;
+@!sup_stack_size = 3000;
+
+@!inf_dvi_buf_size = 800;
+@!sup_dvi_buf_size = 65536;
+
+@!inf_pool_size = 32000;
+@!sup_pool_size = 10000000;
+@!inf_pool_free = 1000;
+@!sup_pool_free = sup_pool_size;
+@!inf_string_vacancies = 8000;
+@!sup_string_vacancies = sup_pool_size - 23000;
+
+@!sup_hyph_size = ssup_hyph_size;
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@z
+
+@x [1.12] l.427 - Constants that are WEB numeric macros.
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions;
+ if you change this, you should also change |iinf_hyphen_size|.}
+@z
+
+@x [1.16] l.498 - Use C macros for `incr' and `decr'.
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@y
+@z
+
+% The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x [2.19] l.565 - data type text_char is 8-bit ASCII_code
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+% [3.26] name_of_file is no longer an array. And change the destination
+% type to text_char, which fixes:
+%
+% Date: 19 Sep 1994 10:38:24 +0200
+% From: thorinn@diku.dk (Lars Mathiesen)
+% When echoed to the screen and in the log, character codes
+% above '177 in file names are shown wrongly (typically as ^@).
+%
+@x [3.26] l.789 - name_of_file is no longer an array
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@y
+@!name_of_file:^char;
+@z
+
+@x [3.27] l.794 - Do file opening in C.
+@ The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `{\bf packed array
+$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\TeX\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\TeX's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@ All of the file opening functions are defined in C.
+@z
+
+@x [3.28] l.850 - Do file closing in C.
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+These procedures should not generate error messages if a file is
+being closed before it has been successfully opened.
+
+@p procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var f:word_file); {close a word file}
+begin close(f);
+end;
+@y
+@ And all the file closing routines as well.
+@z
+
+@x [3.30] l.888 - Array size of input buffer is determined at runtime.
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@y
+@!buffer:^ASCII_code; {lines of characters being read}
+@z
+
+@x [3.31] l.933 - Do `input_ln' in C.
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=f^; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+We define |input_ln| in C, for efficiency.
+@z
+
+% [3.32] `term_in' and `term_out' are standard input and output.
+% Declare the variables that used to be constants.
+@x [3.32] l.961 - `term_in' and `term_out' are standard input and output.
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+@y
+@d term_in==stdin {the terminal as an input file}
+@d term_out==stdout {the terminal as an output file}
+
+@<Glob...@>=
+@!init
+@!ini_version:boolean; {are we \.{INITEX}?}
+@!dump_option:boolean; {was the dump name option used?}
+@!dump_line:boolean; {was a \.{\%\AM format} line seen?}
+tini@/
+@#
+@!bound_default:integer; {temporary for setup}
+@!bound_name:^char; {temporary for setup}
+@#
+@!main_memory:integer; {total memory words allocated in initex}
+@!extra_mem_bot:integer; {|mem_min:=mem_bot-extra_mem_bot| except in \.{INITEX}}
+@!mem_min:integer; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!mem_top:integer; {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|,
+ equal to |mem_max| in \.{INITEX}, else not greater than |mem_max|}
+@!extra_mem_top:integer; {|mem_max:=mem_top+extra_mem_top| except in \.{INITEX}}
+@!mem_max:integer; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!error_line:integer; {width of context lines on terminal error messages}
+@!half_error_line:integer; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@!max_strings:integer; {maximum number of strings; must not exceed |max_halfword|}
+@!strings_free:integer; {strings available after format loaded}
+@!string_vacancies:integer; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size:integer; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!pool_free:integer;{pool space free after format loaded}
+@!hyph_size:integer; {maximun number of hyphen exceptions}
+@!trie_size:integer; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX. 50000 is
+ needed for English, German, and Portuguese.}
+@!buf_size:integer; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!stack_size:integer; {maximum number of simultaneous input sources}
+@!max_in_open:integer; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!param_size:integer; {maximum number of simultaneous macro parameters}
+@!nest_size:integer; {maximum number of semantic levels simultaneously active}
+@!save_size:integer; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@z
+
+@x [3.33] l.964 - We don't need to open terminal files.
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+@y
+@ Here is how to open the terminal files. |t_open_out| does nothing.
+|t_open_in|, on the other hand, does the work of ``rescanning,'' or getting
+any command line arguments the user has provided. It's defined in C.
+
+@d t_open_out == {output already open for text output}
+@z
+
+@x [3.34] l.982 - Flushing output to terminal files.
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@y
+these operations can be specified with {\mc UNIX}. |update_terminal|
+does an |fflush|. |clear_terminal| is redefined
+to do nothing, since the user should control the terminal.
+@^system dependencies@>
+
+@d update_terminal == fflush (term_out)
+@d clear_terminal == do_nothing
+@z
+
+@x [3.35] l.1017 - Do `input_ln' in C => section not needed.
+@<Report overflow of the input buffer, and abort@>=
+if format_ident=0 then
+ begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+ end
+else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+@y
+Routine is implemented in C, module is not needed.
+@z
+
+@x [3.37] l.1055 - |init_terminal|, reading the command line.
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+@y
+@ The following program does the required initialization.
+Iff anything has been specified on the command line, then |t_open_in|
+will return with |last > first|.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+if last > first then
+ begin loc := first;
+ while (loc < last) and (buffer[loc]=' ') do incr(loc);
+ if loc < last then
+ begin init_terminal := true; goto exit;
+ end;
+ end;
+@z
+
+@x [3.37] l.1068 - |init_terminal|, output missing newline.
+ write(term_out,'! End of file on the terminal... why?');
+@y
+ write_ln(term_out,'! End of file on the terminal... why?');
+@z
+
+@x [4.38] l.1126 - Array size for string pool is determined at runtime.
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@y
+@!pool_pointer = integer; {for variables that point into |str_pool|}
+@!str_number = 0..ssup_max_strings; {for variables that point into |str_start|}
+@z
+
+@x [4.39] l.1131 - Dynamically size pool arrays.
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start_ar : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@!str_pool: ^packed_ASCII_code; {the characters}
+@!str_start_ar : ^pool_pointer; {the starting pointers}
+@z
+
+@x [4.47] l.1237 - string recycling
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+@y
+@p @t\4@>@<Declare additional routines for string recycling@>@/
+
+@!init function get_strings_started:boolean; {initializes the string pool,
+@z
+
+% [4.51] Open the pool file using a path, and can't do string
+% assignments directly. (`strcpy' and `strlen' work here because
+% `pool_name' is a constant string, and thus ends in a null and doesn't
+% start with a space.)
+@x [4.51] l.1314 - Open the pool file.
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+@y
+name_length := strlen (pool_name);
+name_of_file := xmalloc_array (char, name_length + 1);
+strcpy (name_of_file+1, pool_name); {copy the string}
+if a_open_in (pool_file, kpse_texpool_format) then
+@z
+
+@x [4.51] l.1322 - Make `OMEGA.POOL' lowercase, and change how it's read.
+else bad_pool('! I can''t read OMEGA.POOL.')
+@y
+else bad_pool('! I can''t read omega.pool; bad path?')
+@z
+@x [4.52] l.1326 - Make `OMEGA.POOL' lowercase, and change how it's read.
+begin if eof(pool_file) then bad_pool('! OMEGA.POOL has no check sum.');
+@.OMEGA.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+@y
+begin if eof(pool_file) then bad_pool('! omega.pool has no check sum.');
+@.OMEGA.POOL has no check sum@>
+read(pool_file,m); read(pool_file,n); {read two digits of string length}
+@z
+@x [4.52] l.1332 - Make `OMEGA.POOL' lowercase, and change how it's read.
+ bad_pool('! OMEGA.POOL line doesn''t begin with two digits.');
+@y
+ bad_pool('! omega.pool line doesn''t begin with two digits.');
+@z
+@x [4.53] l.1354 - Make `OMEGA.POOL' lowercase, and change how it's read.
+ bad_pool('! OMEGA.POOL check sum doesn''t have nine digits.');
+@y
+ bad_pool('! omega.pool check sum doesn''t have nine digits.');
+@z
+@x [4.53] l.1360 - Make `OMEGA.POOL' lowercase, and change how it's read.
+done: if a<>@$ then bad_pool('! OMEGA.POOL doesn''t match; OTANGLE me again.');
+@y
+done: if a<>@$ then
+ bad_pool('! omega.pool doesn''t match; otangle me again (or fix the path).');
+@z
+
+@x [5.54] l.1422 - error_line
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+@y
+@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for
+@z
+
+@x [5.61] l.1556 - Print rest of banner, eliminate misleading `(no format preloaded)'.
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+@y
+wterm(banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+@z
+
+@x [6.73] l.1732 - Add unspecified_mode.
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@y
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d unspecified_mode=4 {extra value for command-line switch}
+@z
+
+@x [6.73] l.1738 - Add interaction_option.
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@y
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@!interaction_option:batch_mode..unspecified_mode; {set from command line}
+@z
+
+@x [6.74] l.1740 - Allow override by command line switch.
+@ @<Set init...@>=interaction:=error_stop_mode;
+@y
+@ @<Set init...@>=if interaction_option=unspecified_mode then
+ interaction:=error_stop_mode
+else
+ interaction:=interaction_option;
+@z
+
+% [6.81] Eliminate nonlocal goto, since C doesn't have them.
+% Plus, it's nicer just to do an exit with the appropriate status code
+% under Unix. We call it `uexit' because there's a WEB symbol called
+% `exit' already. We use a C macro to change `uexit' back to `exit'.
+@x [6.81] l.1852 - Eliminate nonlocal goto, since C doesn't have them.
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+@y
+@d do_final_end==begin
+ update_terminal;
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+ uexit(1)
+ else
+ uexit(0);
+ end
+
+@<Error hand...@>=
+procedure jump_out;
+begin
+close_files_and_terminate;
+do_final_end;
+end;
+@z
+
+@x [6.84] l.1888 - Implement the switch-to-editor option.
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@y
+line ready to be edited.
+We do this by calling the external procedure |call_edit| with a pointer to
+the filename, its length, and the line number.
+However, here we just set up the variables that will be used as arguments,
+since we don't want to do the switch-to-editor until after TeX has closed
+its files.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@d edit_file==input_stack[base_ptr]
+@z
+
+@x [6.84] l.1903 - Implement the switch-to-editor option.
+"E": if base_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ slow_print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+@y
+"E": if base_ptr>0 then
+ begin edit_name_start:=str_start(edit_file.name_field);
+ edit_name_length:=str_start(edit_file.name_field+1) -
+ str_start(edit_file.name_field);
+ edit_line:=line;
+ jump_out;
+@z
+
+% [7.104] `remainder' is a library routine on some systems, so change
+% its name to avoid conflicts.
+@x [7.104] l.2227 - avoid name conflicts with lib routine remainder()
+|remainder|, holds the remainder after a division.
+
+@<Glob...@>=
+@y
+|remainder|, holds the remainder after a division.
+
+@d remainder==tex_remainder
+
+@<Glob...@>=
+@z
+
+@x [7.109] l.2352 - Define glue_ratio in C.
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+@y
+@z
+
+@x [8.112] l.2435 - Efficiency.
+macros are simplified in the obvious way when |min_quarterword=0|.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+macros are simplified in the obvious way when |min_quarterword=0|.
+So they have been simplified here in the obvious way.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item from a quarterword}
+@d hi(#)==# {to put a sixteen-bit item into a halfword}
+@d ho(#)==# {to take a sixteen-bit item from a halfword}
+@z
+
+% [8.113] We've put the memory structure into the include file
+% `texmf.h', since it's too hard to translate automatically.
+@x [8.113] l.2453 - data structures for main memory
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case four_choices of
+ 1: (@!int:integer);
+ 2: (@!gr:glue_ratio);
+ 3: (@!hh:two_halves);
+ 4: (@!qqqq:four_quarters);
+ end;
+@y
+@!quarterword = min_quarterword..max_quarterword;
+@!halfword = min_halfword..max_halfword;
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@=#include "texmfmem.h";@>
+@=#include "omegamem.h";@>
+@z
+
+% [9.116] Change `mem' to `zmem', so we can define mem to be a register
+% pointer to the memory array for speed.
+@x [9.116] l.2545 - definition of main memory array
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@y
+@!yzmem : ^memory_word; {the big dynamic storage area}
+@!zmem : ^memory_word; {the big dynamic storage area}
+@z
+
+% [9.127] Fix casting problem in C.
+% There are several of these. They come from the rules C uses for
+% comparing signed and unsigned quantities. Just doing the comparison
+% can result in incorrect evaluation wrt the way Pascal would do it.
+@x [9.127] l.2739 - Fix casting problem in C.
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+@y 2738
+if r>intcast(p+1) then @<Allocate from the top of node |p| and |goto found|@>;
+@z
+
+% [11.165] Fix the word `free' so that it doesn't conflict with the
+% standard C library routine of the same name.
+@x [11.165] l.3364 - avoid conflict with lib function free()
+are debugging.)
+@y
+are debugging.)
+
+@d free==free_arr
+@z
+
+@x [11.165] l.3367 - dummy |free| and |was_free| arrays
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [mem_min..mem_max] of boolean;
+@y
+ {The debug memory arrays have not been mallocated yet.}
+@!debug @!free: packed array [0..9] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [0..9] of boolean;
+@z
+
+@x [12.174] l.3526 - Eliminate unsigned comparisons to zero.
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+@y
+ begin @<Print the font identifier for |font(p)|@>;
+@z
+
+@x [12.176] l.3563 - Eliminate unsigned comparisons to zero.
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+@y
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin @<Print the font identifier for |font(p)|@>;
+@z
+
+@x [12.186] l.3747 - Don't worry about strange floating point values.
+ if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
+ else if abs(g)>float_constant(20000) then
+@y 3747
+ { The Unix |pc| folks removed this restriction with a remark that
+ invalid bit patterns were vanishingly improbable, so we follow
+ their example without really understanding it.
+ |if abs(mem[p+glue_offset].int)<@'4000000 then print('?.?')|
+ |else| }
+ if fabs(g)>float_constant(20000) then
+@z
+
+
+@x [16.213] l.4321 - texarray
+@!nest:array[0..nest_size] of list_state_record;
+@y
+@!nest:^list_state_record;
+@z
+
+@x [16.215] l.4344 - remove mem[] reference from initialize.
+@<Start a new current page@>;
+@y
+@/{The following piece of code is a copy of module 991:}
+page_contents:=empty; page_tail:=page_head; {|link(page_head):=null;|}@/
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+page_depth:=0; page_max_depth:=0;
+@z
+
+@x [17.241] l.5219 - Do `fix_date_and_time' in C.
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+It calls a macro-defined |date_and_time| routine. |date_and_time|
+in turn is a C macro, which calls |get_date_and_time|, passing
+it the addresses of the day, month, etc., so they can be set by the
+routine. |get_date_and_time| also sets up interrupt catching if that
+is conditionally compiled in the C code.
+@^system dependencies@>
+
+@d fix_date_and_time==o_date_and_time(int_base+time_code,
+ int_base+day_code,
+ int_base+month_code,
+ int_base+year_code)
+@z
+
+@x [18.262] l.5584 - Remove more unsigned comparisons to zero.
+else if (newtext(p)<0)or(newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@y
+else if (newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@z
+
+@x [19.271] l.5872 - texarray
+@!save_stack : array[0..save_size] of memory_word;
+@y
+@!save_stack : ^memory_word;
+@z
+
+@x [22.301] l.6432 - texarray
+@!input_stack : array[0..stack_size] of in_state_record;
+@y
+@!input_stack : ^in_state_record;
+@z
+
+@x [22.304] l.6536 - texarray
+@!input_file : array[1..max_in_open] of alpha_file;
+@!input_file_mode : array[1..max_in_open] of halfword;
+@!input_file_translation : array[1..max_in_open] of halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+@y
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@z
+
+@x [22.308] l.6701 - texarray
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+@y
+@!param_stack: ^pointer;
+ {token list pointers for parameters}
+@z
+
+@x [23.331] l.7071 - init source file name stacks
+begin input_ptr:=0; max_in_stack:=0;
+@y
+begin input_ptr:=0; max_in_stack:=0;
+source_filename_stack[0]:=0;full_source_filename_stack[0]:=0;
+@z
+
+@x [29.513] l.9951 - Area and extension rules for filenames.
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@y
+@ The file names we shall deal with have the
+following structure: If the name contains `\./' or `\.:'
+(for Amiga only), the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the last
+`\..' to the end, otherwise the file extension is null.
+@z
+
+@x [29.513] l.9963 - Area and extension rules for filenames.
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+@y
+@!area_delimiter:pool_pointer; {the most recent `\./', if any}
+@!ext_delimiter:pool_pointer; {the most recent `\..', if any}
+@z
+
+@x [29.514] l.9973 - TeX area directories.
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+In C, the default paths are specified separately.
+@z
+
+@x [29.516] l.9994 - filenames: more_name
+ if (c=">")or(c=":") then
+@y
+ if IS_DIR_SEP(c) then
+@z
+
+@x [29.516] l.9997 - filenames: more_name
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
+@y
+ else if c="." then ext_delimiter:=cur_length;
+@z
+
+@x [29.517] l.10002 - end_name: string recycling
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+@y
+@ The third.
+@^system dependencies@>
+If a string is already in the string pool, the function
+|slow_make_string| does not create a new string but returns this string
+number, thus saving string space. Because of this new property of the
+returned string number it is not possible to apply |flush_string| to
+these strings.
+
+@p procedure end_name;
+var temp_str: str_number; {result of file name cache lookups}
+@!j: pool_pointer; {running index}
+@z
+
+@x [29.517] l.10011 - end_name: string recycling
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+@y
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ temp_str:=search_string(cur_area);
+ if temp_str>0 then
+ begin cur_area:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start(str_ptr+1) to pool_ptr-1 do
+ begin str_pool[j-area_delimiter]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-area_delimiter; {update |pool_ptr|}
+ end;
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=slow_make_string;
+@z
+
+@x [29.517] l.10016 - end_name: string recycling
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+@y
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+ decr(str_ptr); {undo extension string to look at name part}
+ temp_str:=search_string(cur_name);
+ if temp_str>0 then
+ begin cur_name:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start(str_ptr+1) to pool_ptr-1 do
+ begin str_pool[j-ext_delimiter+area_delimiter+1]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-ext_delimiter+area_delimiter+1; {update |pool_ptr|}
+ end;
+ cur_ext:=slow_make_string; {remake extension string}
+@z
+
+% [29.519] In pack_file_name, leave room for the extra null we append at
+% the end of a filename.
+@x [29.519] l.10047 - pack_file_name, leave room for the extra null
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file:= xmalloc_array(char, 1 + length(a) + length(n) + length(e));
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+@z
+
+@x [29.519] l.10051 - pack_file_name, append the extra null
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.520] l.10060 - filenames: default format.
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+@y
+Under {\mc UNIX} we don't give the area part, instead depending
+on the path searching that will happen during file opening. Also, the
+length will be set in the main program.
+
+@d format_area_length=0 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.oft}' part}
+@d format_extension=".oft" {the extension, as a \.{WEB} constant}
+@z
+
+@x [29.521] l.10066 - filenames: default format, where `plain.fmt' is.
+@!TEX_format_default:packed array[1..format_default_length] of char;
+
+@ @<Set init...@>=
+TEX_format_default:='TeXformats:plain.fmt';
+@y
+@!format_default_length: integer;
+@!TEX_format_default: ^char;
+
+@ We set the name of the default format file and the length of that name
+in C, instead of Pascal, since we want them to depend on the name of the
+program.
+@z
+
+@x [29.523] l.10095 - Change to pack_buffered_name as with pack_file_name.
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file := xmalloc_array (char, 1 + n + (b - a + 1) + format_ext_length);
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@z
+
+@x [29.523] l.10100 - Change to pack_buffered_name as with pack_file_name.
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.524] l.10118 - Format file opening: only try once, with path searching.
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(fmt_file) then goto found;
+ pack_buffered_name(format_area_length,loc,j-1);
+ {now try the system format file area}
+ if w_open_in(fmt_file) then goto found;
+@y
+ pack_buffered_name(0,loc,j-1); {Kpathsea does everything}
+ if w_open_in(fmt_file) then goto found;
+@z
+
+@x [29.524] l.10124 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
+@y
+ wterm ('Sorry, I can''t find the format `');
+ fputs (name_of_file + 1, stdout);
+ wterm ('''; will try `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''.');
+@z
+
+@x [29.524] l.10132 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('I can''t find the PLAIN format file!');
+@.I can't find PLAIN...@>
+@y
+ wterm ('I can''t find the format file `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''!');
+@.I can't find the format...@>
+@z
+
+@x [29.530] l.10239 - prompt_file_name: No default extension is TeX input file.
+if e=".tex" then show_context;
+@y
+if (e=".tex") or (e="") then show_context;
+@z
+
+@x [29.532] l.10263 - avoid conflict, `logname' in <unistd.h> on some systems.
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@y
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d log_name == texmf_log_name
+@z
+
+@x [29.534] l.10285 - Adjust for C string conventions.
+@!months:packed array [1..36] of char; {abbreviations of month names}
+@y
+@!months:^char;
+j:integer;
+@z
+
+@x [29.534] l. - Send the job_name to the file recorder.
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+@y
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+pack_job_name(".ofl");
+recorder_change_filename(stringcast(name_of_file+1));
+@z
+
+@x [29.536] l.10324 - Print rest of banner.
+begin wlog(banner);
+@y
+begin wlog(banner);
+wlog(version_string);
+@z
+
+@x [29.536] l.10327 - Adjust for C string conventions.
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@y
+months := ' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@z
+
+% [29.537] Use a path when calling a_open_in to do a \input; also, try
+% to open the file with and without the `.tex' extension, regardless of
+% whether the file already has an extension. This allows filenames like
+% `foo' and `foo.bar.tex', as well as `foo.tex' and `foo.bar'.
+@x [29.537] l.10338 - start_input
+begin scan_file_name; {set |cur_name| to desired file name}
+if cur_ext="" then cur_ext:=".tex";
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,TEX_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+@y
+var temp_str: str_number; k: integer;
+begin scan_file_name; {set |cur_name| to desired file name}
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ tex_input_type := 1; {Tell |open_input| we are \.{\\input}.}
+ {Kpathsea tries all the various ways to get the file.}
+ if open_in_name_ok(name_of_file+1)
+ and a_open_in(cur_file, kpse_tex_format) then
+ {At this point |name_of_file| contains the actual name found.
+ We extract the |cur_area|, |cur_name|, and |cur_ext| from it.}
+ begin k:=1;
+ name_in_progress:=true;
+ begin_name;
+ while (k<=name_length)and(more_name(name_of_file[k])) do
+ incr(k);
+ end_name;
+ name_in_progress:=false;
+ goto done;
+ end;
+@z
+
+@x [29.537] l.10348 - start_input: don't force ".tex" extension.
+ prompt_file_name("input file name",".tex");
+@y
+ prompt_file_name("input file name","");
+@z
+
+@x [29.537] l.10350 - start_input: string recycling
+done: name:=a_make_name_string(cur_file);
+@y
+done: name:=a_make_name_string(cur_file);
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@z
+
+@x [29.537] l.10352 - start_input: use different heuristic for initex.
+ begin job_name:=cur_name; open_log_file;
+@y
+ begin job_name:=get_job_name; open_log_file;
+@z
+
+@x [29.537] l.10359 - start_input: don't return filename to string pool.
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string; name:=cur_name;
+ end;
+@y
+@z
+
+@x [30.563] l.10943 - Don't use TEX_font_area.
+if aire="" then pack_file_name(nom,TEX_font_area,".ofm")
+else pack_file_name(nom,aire,".ofm");
+if not b_open_in(tfm_file) then abort;
+@y
+{|kpse_find_file| will append the |".ofm"| or |".tfm"|,
+ and avoid searching the disk before the font alias files as well.}
+pack_file_name(nom,aire,"");
+if not ofm_open_in(tfm_file) then abort;
+@z
+
+% [30.564] Reading the tfm file. As a special case, whenever we open a
+% tfm file, we read its first byte into `tfm_temp' right away. TeX
+% looks at `fbyte' before calling `fget', so it ends up seeing every
+% byte. This is Pascal-like I/O.
+@x [30.564] l.10956 - reading the tfm file, define fget & fbyte
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@y
+@d fget==tfm_temp:=getc(tfm_file)
+@d fbyte==tfm_temp
+@z
+
+% [32.575] We only want `eof' on the TFM file to be true if we
+% previously had EOF, not if we're at EOF now. This is like `feof', and
+% unlike our implementation of `eof' elsewhere.
+@x [32.575] l.11161 - Reading the tfm file, replace eof() by feof().
+if eof(tfm_file) then abort;
+@y
+if feof(tfm_file) then abort;
+@z
+
+@x [32.595] l.11860 - texarray
+@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:dvi_index; {half of |dvi_buf_size|}
+@!dvi_limit:dvi_index; {end of the current half buffer}
+@!dvi_ptr:dvi_index; {the next available buffer address}
+@y
+@!dvi_buf:^real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:integer; {half of |dvi_buf_size|}
+@!dvi_limit:integer; {end of the current half buffer}
+@!dvi_ptr:integer; {the next available buffer address}
+@z
+
+@x [32.597] l.11886 - write_dvi done in C.
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+In C, we use a macro to call |fwrite| or |write| directly, writing all
+the bytes in one shot. Much better even than writing four
+bytes at a time.
+@z
+
+@x [32.617] l.12261 - Use output_comment if the user set it. Assume it's short enough.
+ old_setting:=selector; selector:=new_string;
+@y
+if output_comment then
+ begin l:=strlen(output_comment); dvi_out(l);
+ for s:=0 to l-1 do dvi_out(output_comment[s]);
+ end
+else begin {the default code is unchanged}
+ old_setting:=selector; selector:=new_string;
+@z
+
+@x [32.617] l.12268 - Use output_comment if the user set it.
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+@y
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+end;
+@z
+
+% We output each portion of the page as we get to it, if we are using
+% IPC, so that the previewer (TeXView) can display it immediately. [SPM]
+@x [32.640] l.12690 - IPC
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+@y
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+ifdef ('IPC')
+if ipc_on>0 then
+ begin if dvi_limit=half_buf then
+ begin write_dvi(half_buf, dvi_buf_size-1);
+ flush_dvi;
+ dvi_gone:=dvi_gone+half_buf;
+ end;
+ if dvi_ptr>0 then
+ begin write_dvi(0, dvi_ptr-1);
+ flush_dvi;
+ dvi_offset:=dvi_offset+dvi_ptr; dvi_gone:=dvi_gone+dvi_ptr;
+ end;
+ dvi_ptr:=0; dvi_limit:=dvi_buf_size;
+ ipc_page(dvi_gone);
+ end;
+endif ('IPC');
+@z
+
+@x [32.642] l.12742 - Use dvi_offset instead of dvi_buf_size with IPC stuff.
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+@y
+ifdef ('IPC')
+ k:=7-((3+dvi_offset+dvi_ptr) mod 4); {the number of 223's}
+endif ('IPC')
+ifndef ('IPC')
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+endifn ('IPC')
+@z
+
+@x [38.859] l.16855 - Fix a casting/expression evaluation problem.
+if abs(fit_class-fitness(r))>1 then d:=d+adj_demerits;
+@y
+if abs(intcast(fit_class)-intcast(fitness(r)))>1 then d:=d+adj_demerits;
+@z
+
+@x [39.875] l.17170 - Another casting problem.
+ begin line_diff:=line_number(r)-best_line;
+@y
+ begin line_diff:=intcast(line_number(r))-intcast(best_line);
+@z
+
+@x [42.920] l.18068 - bigtrie: allow larger hyphenation tries.
+@!trie_pointer=0..trie_size; {an index into |trie|}
+@y
+@!trie_pointer=0..ssup_trie_size; {an index into |trie|}
+@z
+
+@x [42.921] l.18075 - bigtrie: allow larger hyphenation tries.
+@!trie:array[trie_pointer] of two_halves; {|trie_link|, |trie_char|, |trie_op|}
+@y
+{We will dynamically allocate this arrays.}
+@!trie:^two_halves; {|trie_link|}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18126 m.925
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+@y 18126
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+This is a clever scheme which saves the need for a hash link array.
+However, it is difficult to increase the size of the hyphen exception
+arrays. To make this easier, the ordered hash has been replaced by
+a simple hash, using an additional array |hyph_link|. The value
+|0| in |hyph_link[k]| means that there are no more entries corresponding
+to the specific hash chain. When |hyph_link[k]>0|, the next entry in
+the hash chain is |hyph_link[k]-1|. This value is used because the
+arrays start at |0|.
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18134 m.925
+@!hyph_pointer=0..hyph_size; {an index into the ordered hash table}
+@y 18134
+@!hyph_pointer=0..ssup_hyph_size; {index into hyphen exceptions hash table;
+ enlarging this requires changing (un)dump code}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18137 m.926
+@!hyph_word:array[hyph_pointer] of str_number; {exception words}
+@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions}
+@!hyph_count:hyph_pointer; {the number of words in the exception dictionary}
+@y 18139
+@!hyph_word: ^str_number; {exception words}
+@!hyph_list: ^pointer; {list of hyphen positions}
+@!hyph_link: ^hyph_pointer; {link array for hyphen exceptions hash table}
+@!hyph_count:integer; {the number of words in the exception dictionary}
+@!hyph_next:integer; {next free slot in hyphen exceptions hash table}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18145 m.928
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null;
+ end;
+hyph_count:=0;
+@y 18148
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null; hyph_link[z]:=0;
+ end;
+hyph_count:=0;
+hyph_next:=hyph_prime+1; if hyph_next>hyph_size then hyph_next:=hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18163 m.930
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_size;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+not_found: decr(hn)
+@y 18170
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_prime;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ h:=hyph_link[h]; if h=0 then goto not_found;
+ decr(h);
+ end;
+not_found: decr(hn)
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18172 m.931
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)<hn then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start(k);
+ repeat if so(str_pool[u])<hc[j] then goto not_found;
+ if so(str_pool[u])>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@y 18184
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start(k);
+ repeat
+ if so(str_pool[u])<>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@z
+
+% The GNU C compiler complains of unused variables.
+@x
+@!s,@!t:str_number; {strings being compared or stored}
+@y
+@!s:str_number; {strings being compared or stored}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18274 m.939
+ begin h:=(h+h+hc[j]) mod hyph_size;
+@y 18274
+ begin h:=(h+h+hc[j]) mod hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18281 m.940
+@ @<Insert the \(p)pair |(s,p)|...@>=
+if hyph_count=hyph_size then overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+hyph_word[h]:=s; hyph_list[h]:=p
+@y 18290
+@ @<Insert the \(p)pair |(s,p)|...@>=
+ if hyph_next <= hyph_prime then
+ while (hyph_next>0) and (hyph_word[hyph_next-1]>0) do decr(hyph_next);
+if (hyph_count=hyph_size)or(hyph_next=0) then
+ overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if hyph_link[h]=0 then
+ begin
+ hyph_link[h]:=hyph_next;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime;
+ if hyph_next > hyph_prime then incr(hyph_next);
+ end;
+ h:=hyph_link[h]-1;
+ end;
+
+found: hyph_word[h]:=s; hyph_list[h]:=p
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18292 m.941
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+k:=hyph_word[h];
+if length(k)<length(s) then goto found;
+if length(k)>length(s) then goto not_found;
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+found:q:=hyph_list[h]; hyph_list[h]:=p; p:=q;@/
+t:=hyph_word[h]; hyph_word[h]:=s; s:=t;
+not_found:
+@y 18303
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h];
+if length(k)<>length(s) then goto not_found;
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+{repeat hyphenation exception; flushing old data}
+flush_string; s:=hyph_word[h]; {avoid |slow_make_string|!}
+decr(hyph_count);
+{ We could also |flush_list(hyph_list[h]);|, but it interferes
+ with \.{trip.log}. }
+goto found;
+not_found:
+@z
+
+@x [43.943] l.18346 - web2c can't parse negative lower bounds in arrays. Sorry.
+@!init@! trie_op_hash:array[-trie_op_size..trie_op_size] of 0..trie_op_size;
+@y
+@!init@! trie_op_hash:array[neg_trie_op_size..trie_op_size] of 0..trie_op_size;
+@z
+
+@x [43.944] l.18365 - web2c can't parse negative lower bounds in arrays. Sorry
+var h:-trie_op_size..trie_op_size; {trial hash location}
+@y
+var h:neg_trie_op_size..trie_op_size; {trial hash location}
+@z
+
+@x [43.944] l.18370 - Another casting problem, and use |neg_trie_op_size|.
+begin h:=abs(n+313*d+361*v+1009*cur_lang) mod (trie_op_size+trie_op_size)
+ - trie_op_size;
+@y
+begin h:=abs(intcast(n)+313*intcast(d)+361*intcast(v)+1009*intcast(cur_lang))
+ mod (trie_op_size - neg_trie_op_size)
+ + neg_trie_op_size;
+@z
+
+@x [43.947] l.18438 - Dynamically allocate arrays, and a casting problem.
+@!init @!trie_c:packed array[trie_pointer] of ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:packed array[trie_pointer] of quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:packed array[trie_pointer] of trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:packed array[trie_pointer] of trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:packed array[trie_pointer] of trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@y
+@!init @!trie_c:^ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:^quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:^trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:^trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:^trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@z
+
+@x [43.948] l.18471 - Another casting problem.
+begin h:=abs(trie_c[p]+1009*trie_o[p]+@|
+ 2718*trie_l[p]+3142*trie_r[p]) mod trie_size;
+@y
+begin h:=abs(intcast(trie_c[p])+1009*intcast(trie_o[p])+@|
+ 2718*intcast(trie_l[p])+3142*intcast(trie_r[p])) mod trie_size;
+@z
+
+@x [43.590] l.18524 - Dynamically allocate & larger tries.
+@!init@!trie_taken:packed array[1..trie_size] of boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:array[ASCII_code] of trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@y
+@!init@!trie_taken: ^boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:^trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@z
+
+@x [43.951] l.18539 - Dynamically allocate.
+trie_not_ready:=true; trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+trie_not_ready:=true;
+@z
+
+%%
+%% We can rewrite the original code after "main_loop_move+2" upto the
+%% "tail_append(lig_stack)" in module 1036 as
+%%
+%
+% main_loop_move+2:
+% if font_bc[main_f]<=cur_chr then
+% if cur_chr<=font_ec[main_f] then
+% begin main_i:=char_info(main_f)(cur_l);
+% if char_exists(main_i) goto main_loop_move+3;
+% end;
+% char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+% main_loop_move+3:
+% tail_append(lig_stack) {|main_loop_lookahead| is next}
+%
+
+@x [49.1252] l.23230 - INI = VIR, so have to do runtime test.
+hyph_data: if cur_chr=1 then
+ begin @!init new_patterns; goto done;@;@+tini@/
+@y 23215
+hyph_data: if cur_chr=1 then
+ begin @!init if ini_version then
+ begin new_patterns; goto done; end; @;@+tini@/
+@z
+
+@x
+@!flushable_string:str_number; {string not yet referenced}
+@y
+@z
+
+% undo Knuth's change because
+% a) the string is already replaced in |scan_file_name| and therefore
+% b) the wrong string will get flushed!!!
+%
+@x [49.1260] l.23331 new_font: string recycling -- already done
+flushable_string:=str_ptr-1;
+@y
+@z
+
+% If you don't want to remove code with the following change,
+% please replace the former change by
+%
+% @x
+% flushable_string:=str_ptr-1;
+% @y
+% if cur_name=str_ptr-1 then
+% flushable_string:=str_ptr-1
+% else
+% flushable_string:=str_ptr; {number of a non-existing}
+% @z
+%
+% otherwise the wrong string will get removed by |flush_string|!!
+%
+@x [49.1260] l.23334 new_font: string recycling -- already done
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name(f);
+ end;
+ if s>0 then
+@y
+ begin if s>0 then
+@z
+
+@x [49.1265] if batchmode, mktex... scripts should be silent.
+interaction:=cur_chr;
+@y
+interaction:=cur_chr;
+if interaction = batch_mode
+then kpse_make_tex_discard_errors := 1
+else kpse_make_tex_discard_errors := 0;
+@z
+
+@x [49.1275] l.23441 - Same stuff as for \input, this time for \openin.
+ if cur_ext="" then cur_ext:=".tex";
+ pack_cur_name;
+ if a_open_in(read_file[n]) then read_open[n]:=just_open;
+@y
+ pack_cur_name;
+ tex_input_type:=0; {Tell |open_input| we are \.{\\openin}.}
+ if open_in_name_ok(name_of_file+1)
+ and a_open_in(read_file[n], kpse_tex_format) then
+ begin k:=1;
+ name_in_progress:=true;
+ begin_name;
+ while (k<=name_length)and(more_name(name_of_file[k])) do
+ incr(k);
+ end_name;
+ name_in_progress:=false;
+ read_open[n]:=just_open;
+ end;
+@z
+
+@x [50.1301] l.23679 - INI = VIR, so runtime test.
+format_ident:=" (INIOMEGA)";
+@y
+if ini_version then format_ident:=" (INIOMEGA)";
+@z
+
+% The GNU C compiler complains of unused variables.
+@x [50.1302] l.23690 - Eliminate now-unused variable `w' in `store_fmt_file'.
+var j,@!k,@!l:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!w: four_quarters; {four ASCII codes}
+@y
+var @!k:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@z
+
+@x [50.1303] l.23722 - Ditto, for `load_fmt_file'.
+@!w: four_quarters; {four ASCII codes}
+@y
+@z
+
+@x [50.1305] l.23751 - Do dumping and undumping of fmt files in C.
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+@y
+@z
+@x [1306]
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@y
+@z
+@x [still 1306] debug format file
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@y
+@d format_debug_end(#)==
+ write_ln (stderr, ' = ', #);
+ end;
+@d format_debug(#)==
+ if debug_format_file then begin
+ write (stderr, 'fmtdebug:', #);
+ format_debug_end
+@d undump_size_end_end(#)==
+ too_small(#)@+else format_debug (#)(x); undump_end_end
+@z
+
+@x [50,1307] l.23779 - texarray
+dump_int(@$);@/
+@y
+dump_int(@$);@/
+dump_int(max_halfword);@/
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23784 m.1307
+dump_int(hyph_size)
+@y 23784
+dump_int(hyph_prime)
+@z
+
+@x [50.1308] l.23793 - texarray
+x:=fmt_file^.int;
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+undump_int(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(x);
+if x<>mem_top then goto bad_fmt;
+@y
+@+init
+if ini_version then
+ begin libc_free(str_pool); libc_free(str_start_ar); libc_free(yzmem);
+ end;
+@+tini
+undump_int(x);
+format_debug('string pool checksum')(x);
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+undump_int(x);
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+
+undump_int(x); format_debug ('mem_bot')(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(mem_top); format_debug ('mem_top')(mem_top);
+if mem_bot+1100>mem_top then goto bad_fmt;
+
+
+head:=contrib_head; tail:=contrib_head;
+ page_tail:=page_head; {page initialization}
+
+mem_min := mem_bot - extra_mem_bot;
+mem_max := mem_top + extra_mem_top;
+
+yzmem:=xmalloc_array (memory_word, mem_max - mem_min);
+zmem := yzmem - mem_min; {this pointer arithmetic fails with some compilers}
+mem := zmem;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23804 m.1308
+if x<>hyph_size then goto bad_fmt
+@y 23804
+if x<>hyph_prime then goto bad_fmt
+@z
+
+% [1309] Make dumping/undumping more efficient by doing whole arrays at
+% a time, via fread/fwrite in texmfmp.c.
+@x [50.1309] l.23814 - Make dumping/undumping more efficient.
+for k:=too_big_char to str_ptr do dump_int(str_start(k));
+k:=0;
+while k+4<pool_ptr do
+ begin dump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; dump_four_ASCII;
+@y
+dump_things(str_start(too_big_char), str_ptr-too_big_char+1);
+dump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1310] l.23829 - Make dumping/undumping more efficient.
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings)('max strings')(str_ptr);
+for k:=too_big_char to str_ptr do undump(0)(pool_ptr)(str_start(k));
+k:=0;
+while k+4<pool_ptr do
+ begin undump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; undump_four_ASCII;
+@y
+undump_size(0)(sup_pool_size-pool_free)('string pool size')(pool_ptr);
+if pool_size<pool_ptr+pool_free then
+ pool_size:=pool_ptr+pool_free;
+undump_size(0)(sup_max_strings-strings_free)('sup strings')(str_ptr);@/
+if max_strings<str_ptr+strings_free then
+ max_strings:=str_ptr+strings_free;
+str_start_ar:=xmalloc_array(pool_pointer, max_strings-biggest_char);
+undump_things(str_start(too_big_char), str_ptr-too_big_char+1);
+str_pool:=xmalloc_array(packed_ASCII_code, pool_size);
+undump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1311] l.23850 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do dump_wd(mem[k]);
+@y
+repeat dump_things(mem[p], q+2-p);
+@z
+
+@x [50.1311] l.23855 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do dump_wd(mem[k]);
+@y
+dump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1311] l.23858 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
+@y
+dump_things(mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+@x [50.1312] l.23873 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do undump_wd(mem[k]);
+@y
+repeat undump_things(mem[p], q+2-p);
+@z
+
+@x [50.1312] l.23878 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do undump_wd(mem[k]);
+@y
+undump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1312] l.23888 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
+@y
+undump_things (mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24058 m.1324
+dump_int(hyph_count);
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k); dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@y 24061
+dump_int(hyph_count);
+if hyph_next <= hyph_prime then hyph_next:=hyph_size;
+dump_int(hyph_next);{minumum value of |hyphen_size| needed}
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k+65536*hyph_link[k]);
+ {assumes number of hyphen exceptions does not exceed 65535}
+ dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@z
+
+@x [50.1324] l.24066 - Make dumping/undumping more efficient - trie
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(max_hyph_char);
+dump_int(trie_op_ptr);
+for k:=1 to trie_op_ptr do
+ begin dump_int(hyf_distance[k]);
+ dump_int(hyf_num[k]);
+ dump_int(hyf_next[k]);
+ end;
+@y
+dump_things(trie[0],trie_max+1);
+dump_int(max_hyph_char);
+dump_int(trie_op_ptr);
+dump_things(hyf_distance[1], trie_op_ptr);
+dump_things(hyf_num[1], trie_op_ptr);
+dump_things(hyf_next[1], trie_op_ptr);
+@z
+
+@x [50.1325] l.24086 - Make dumping/undumping more efficient - trie
+@<Undump the hyphenation tables@>=
+@y
+{This is only used for the hyphenation tries below, and the size is
+ always |j+1|.}
+@d xmalloc_and_undump(#) ==
+ if not # then #:=xmalloc_array(two_halves, j+1);
+ undump_things(#[0], j+1);
+
+@<Undump the hyphenation tables@>=
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24087 m.1325
+undump(0)(hyph_size)(hyph_count);
+for k:=1 to hyph_count do
+ begin undump(0)(hyph_size)(j);
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+@y 24092
+undump_size(0)(hyph_size)('hyph_size')(hyph_count);
+undump_size(hyph_prime)(hyph_size)('hyph_size')(hyph_next);
+j:=0;
+for k:=1 to hyph_count do
+ begin undump_int(j); if j<0 then goto bad_fmt;
+ if j>65535 then
+ begin hyph_next:= j div 65536; j:=j - hyph_next * 65536; end
+ else hyph_next:=0;
+ if (j>=hyph_size)or(hyph_next>hyph_size) then goto bad_fmt;
+ hyph_link[j]:=hyph_next;
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+ {|j| is now the largest occupied location in |hyph_word|}
+ incr(j);
+ if j<hyph_prime then j:=hyph_prime;
+ hyph_next:=j;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime else
+ if hyph_next >= hyph_prime then incr(hyph_next);
+@z
+
+
+@x [50.1325] l.24094 - Make dumping/undumping more efficient - trie
+for k:=0 to j do undump_hh(trie[k]);
+undump_int(max_hyph_char);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+for k:=1 to j do
+ begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
+ undump(0)(63)(hyf_num[k]);
+ undump(min_quarterword)(max_quarterword)(hyf_next[k]);
+ end;
+@y
+{The first array has not been allocated yet unless we're \.{INITEX};
+ we do that precisely so we don't allocate more space than necessary.}
+xmalloc_and_undump(trie);
+undump_int(max_hyph_char);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+{I'm not sure we have such a strict limitation (64) on these values, so
+ let's leave them unchecked.}
+undump_things(hyf_distance[1], j);
+undump_things(hyf_num[1], j);
+undump_upper_check_things(max_quarterword, hyf_next[1], j);
+@z
+
+@x [50.1327] l.24117 - Allow command line to override dumped value.
+undump(batch_mode)(error_stop_mode)(interaction);
+@y
+undump(batch_mode)(error_stop_mode)(interaction);
+if interaction_option<>unspecified_mode then interaction:=interaction_option;
+@z
+
+% [50.1327] As with TFM files, `eof' here means `have we previously
+% encountered the end-of-file', not `are we at the end of the file'.
+@x [50.1327] l.24120 - dumping/undumping, replace eof() by feof()
+if (x<>69069)or eof(fmt_file) then goto bad_fmt
+@y
+if (x<>69069)or feof(fmt_file) then goto bad_fmt
+@z
+
+@x [50.1328] l.24124 - Eliminate probably wrong word `preloaded' from format_idents.
+print(" (preloaded format="); print(job_name); print_char(" ");
+@y
+print(" (format="); print(job_name); print_char(" ");
+@z
+
+@x [51.1332] l.24203 - make the main program a procedure, for eqtb hack.
+@p begin @!{|start_here|}
+@y
+@d const_chk(#)==begin if # < inf@&# then # := inf@&# else
+ if # > sup@&# then # := sup@&# end
+
+{|setup_bound_var| stuff duplicated in \.{mf.ch}.}
+@d setup_bound_var(#)==bound_default:=#; setup_bound_var_end
+@d setup_bound_var_end(#)==bound_name:=#; setup_bound_var_end_end
+@d setup_bound_var_end_end(#)==
+ setup_bound_variable(address_of(#), bound_name, bound_default);
+
+@p procedure main_body;
+begin @!{|start_here|}
+
+{Always start the file recorder?}
+ recorder_enabled:=true;
+
+{Bounds that may be set from the configuration file. We want the user to
+ be able to specify the names with underscores, but \.{TANGLE} removes
+ underscores, so we're stuck giving the names twice, once as a string,
+ once as the identifier. How ugly.}
+ setup_bound_var (1000000)('main_memory')(main_memory);
+ {|memory_word|s for |mem| in \.{INITEX}}
+ setup_bound_var (0)('extra_mem_top')(extra_mem_top);
+ {increase high mem in \.{VIRTEX}}
+ setup_bound_var (0)('extra_mem_bot')(extra_mem_bot);
+ {increase low mem in \.{VIRTEX}}
+ setup_bound_var (300000)('pool_size')(pool_size);
+ setup_bound_var (200000)('string_vacancies')(string_vacancies);
+ setup_bound_var (5000)('pool_free')(pool_free); {min pool avail after fmt}
+ setup_bound_var (100000)('max_strings')(max_strings);
+ setup_bound_var (100)('strings_free')(strings_free);
+ setup_bound_var (20000)('trie_size')(trie_size);
+ {if |ssup_trie_size| increases, recompile}
+ setup_bound_var (659)('hyph_size')(hyph_size);
+ setup_bound_var (20000)('buf_size')(buf_size);
+ setup_bound_var (50)('nest_size')(nest_size);
+ setup_bound_var (15)('max_in_open')(max_in_open);
+ setup_bound_var (60)('param_size')(param_size);
+ setup_bound_var (4000)('save_size')(save_size);
+ setup_bound_var (300)('stack_size')(stack_size);
+ setup_bound_var (16384)('dvi_buf_size')(dvi_buf_size);
+ setup_bound_var (79)('error_line')(error_line);
+ setup_bound_var (50)('half_error_line')(half_error_line);
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ const_chk (main_memory);
+@+init
+ if ini_version then begin
+ extra_mem_top := 0;
+ extra_mem_bot := 0;
+ end;
+@+tini
+ if extra_mem_bot>sup_main_memory then extra_mem_bot:=sup_main_memory;
+ if extra_mem_top>sup_main_memory then extra_mem_top:=sup_main_memory;
+ mem_top := mem_bot + main_memory;
+ mem_min := mem_bot;
+ mem_max := mem_top;
+
+ {Check other constants against their sup and inf.}
+ const_chk (trie_size);
+ const_chk (hyph_size);
+ const_chk (buf_size);
+ const_chk (nest_size);
+ const_chk (max_in_open);
+ const_chk (param_size);
+ const_chk (save_size);
+ const_chk (stack_size);
+ const_chk (dvi_buf_size);
+ const_chk (pool_size);
+ const_chk (string_vacancies);
+ const_chk (pool_free);
+ const_chk (max_strings);
+ const_chk (strings_free);
+ if error_line > ssup_error_line then error_line := ssup_error_line;
+
+ {array memory allocation}
+ buffer:=xmalloc_array (ASCII_code, buf_size);
+ nest:=xmalloc_array (list_state_record, nest_size);
+ save_stack:=xmalloc_array (memory_word, save_size);
+ input_stack:=xmalloc_array (in_state_record, stack_size);
+ input_file:=xmalloc_array (alpha_file, max_in_open);
+ input_file_mode:=xmalloc_array (halfword, max_in_open);
+ input_file_translation:=xmalloc_array (halfword, max_in_open);
+ line_stack:=xmalloc_array (integer, max_in_open);
+ param_stack:=xmalloc_array (halfword, param_size);
+ dvi_buf:=xmalloc_array (real_eight_bits, dvi_buf_size);
+ hyph_word:=xmalloc_array (str_number, hyph_size);
+ hyph_list:=xmalloc_array (halfword, hyph_size);
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+@+init
+if ini_version then begin
+ yzmem:=xmalloc_array (memory_word, mem_top - mem_bot);
+ zmem := yzmem - mem_bot; {Some compilers require |mem_bot=0|}
+
+ str_start_ar:=xmalloc_array (pool_pointer, max_strings-biggest_char);
+ str_pool:=xmalloc_array (packed_ASCII_code, pool_size);
+end;
+@+tini
+@z
+
+@x [51.1332] l.24215 - INI = VIR, so pool init needs runtime test
+@!init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+@y
+@+init if ini_version then
+ begin if not get_strings_started then goto final_end;
+ init_prim; {call |primitive| for each primitive}
+ init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+ end;
+@+tini@/
+@z
+
+@x [51.1332] l.24225 - main
+end_of_TEX: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+@y
+close_files_and_terminate;
+final_end: do_final_end;
+end {|main_body|};
+@z
+
+@x [51.1333] l.24254 - Print new line before termination; switch to editor if necessary.
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+@y
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+print_ln;
+if (edit_name_start<>0) and (interaction>batch_mode) then
+ call_edit(str_pool,edit_name_start,edit_name_length,edit_line);
+@z
+
+@x [51.1334] l. - Remove reference to fontmemsize
+ wlog_ln(', out of ',font_mem_size:1,' for ',font_max-font_base:1);@/
+@y
+@z
+
+@x [51.1335] l.24335 - Only do dump if ini.
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ store_fmt_file; return;@+tini@/
+@y
+ begin @!init if ini_version then
+ begin for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ store_fmt_file; return;
+ end;@+tini@/
+@z
+
+@x [51.1337] l.24361 - Handle %&format in all cases.
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+if (format_ident=0)or(buffer[loc]="&")or dump_line then
+@z
+
+@x [51.1337] l.24371 - Allocate hyphenation tries.
+fix_date_and_time;@/
+@y
+fix_date_and_time;@/
+
+@!init
+if trie_not_ready then begin {initex without format loaded}
+ trie:=xmalloc_array (two_halves, trie_size);
+
+ trie_c:=xmalloc_array (ASCII_code, trie_size);
+ trie_o:=xmalloc_array (quarterword, trie_size);
+ trie_l:=xmalloc_array (trie_pointer, trie_size);
+ trie_r:=xmalloc_array (trie_pointer, trie_size);
+ trie_hash:=xmalloc_array (trie_pointer, trie_size);
+ trie_taken:=xmalloc_array (boolean, trie_size);
+ trie_min:=xmalloc_array (trie_pointer, too_big_char);
+
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+ end;
+ tini@/
+
+@z
+
+% [52.1338] Core-dump in debugging mode on 0 input. Under Unix, it's
+% not possible to portably switch into the debugger while a program is
+% running. The best approximation is to do a core dump, then run the
+% debugger on it later.
+@x [52.1338] l.24411 - Core-dump in debugging mode on 0 input.
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+@y
+ dump_core {do something to cause a core dump}
+@z
+
+% The GNU C compiler complains of unused variables.
+@x
+procedure do_extension;
+var i,@!j,@!k:integer; {all-purpose integers}
+@!p,@!q,@!r:pointer; {all-purpose pointers}
+@y
+procedure do_extension;
+var @!k:integer; {all-purpose integers}
+@!p:pointer; {all-purpose pointers}
+@z
+
+% [53.1350] (new_write_whatsit) Allow 18 as a \write stream. We never
+% refer to an actual file, though, so we don't need to change the
+% write_file or write_open arrays. We provide for disabling this at
+% runtime, for paranoids.
+@x [53.1350] l.24609 - system: Allow 18 as a \write stream.
+ else if cur_val>15 then cur_val:=16;
+@y
+ else if (cur_val>15) and (cur_val <> 18) then cur_val:=16;
+@z
+
+@x [53.1370] l.24770 - system: (write_out) \write18{foo} => system(foo).
+begin @<Expand macros in the token list
+@y
+@!d:integer; {number of characters in incomplete current string}
+@!clobbered:boolean; {system string is ok?}
+begin @<Expand macros in the token list
+@z
+
+@x [53.1370] l.24773 - system: (write_out) \write18{foo} => system(foo).
+if write_open[j] then selector:=j
+@y
+if shell_enabled_p and (j=18) then
+ begin selector := new_string;
+ end
+else if write_open[j] then selector:=j
+@z
+
+% Then call system(3) on that string.
+@x [53.1370] l.24779 - system: (write_out) \write18{foo} => system(foo).
+flush_list(def_ref); selector:=old_setting;
+@y
+flush_list(def_ref);
+if j=18 then
+ begin if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ print_nl("system(");
+ for d:=0 to cur_length-1 do
+ begin {|print| gives up if passed |str_ptr|, so do it by hand.}
+ print(so(str_pool[str_start(str_ptr)+d])); {N.B.: not |print_char|}
+ end;
+ print(")...");
+ if shell_enabled_p then
+ begin str_room(1); append_char(0); {Append a null byte to the expansion.}
+ clobbered:=false;
+ for d:=0 to cur_length-1 do {Convert to external character set.}
+ begin str_pool[str_start(str_ptr)+d]:=xchr[str_pool[str_start(str_ptr)+d]];
+ if (str_pool[str_start(str_ptr)+d]=null_code)
+ and (d<cur_length-1) then clobbered:=true;
+ {minimal checking: NUL not allowed in argument string of |system|()}
+ end;
+ if clobbered then print("clobbered")
+ else begin {We have the string; run system(3). We don't have anything
+ reasonable to do with the return status, unfortunately discard it.}
+ for d:=0 to cur_length-1 do {Convert to external character set.}
+ begin
+ outside_string_array[d]:=xchr[str_pool[str_start(str_ptr)+d]];
+ end;
+ outside_string_array[cur_length]:=null_code;
+ system(outside_string_array);
+ print("executed");
+ end;
+ pool_ptr:=str_start(str_ptr); {erase the string}
+ end
+ else begin print("disabled");
+ end;
+ print_char("."); print_nl(""); print_ln;
+end;
+selector:=old_setting;
+@z
+
+@x [53.1373] Need new local.
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+@y
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+ @!old_setting:0..max_selector;
+@z
+
+@x [53.1374] Disallow certain \openout filenames, and log results.
+ while not a_open_out(write_file[j]) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+@y
+ while not a_open_out(write_file[j])
+ or not open_out_name_ok(name_of_file+1) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+ {If on first line of input, log file is not ready yet, so don't log.}
+ if log_opened then begin
+ old_setting:=selector;
+ if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ print_nl("\openout");
+ print_int(j);
+ print(" = `");
+ print_file_name(cur_name,cur_area,cur_ext);
+ print("'."); print_nl(""); print_ln;
+ selector:=old_setting;
+ end;
+@z
+
+@x [54.1376] l.24903 - Add editor-switch variables to globals.
+@* \[54] System-dependent changes.
+@y
+@* \[54/web2c] System-dependent changes for Web2c.
+Here are extra variables for Web2c. (This numbering of the
+system-dependent section allows easy integration of Web2c and e-\TeX, etc.)
+@^<system dependencies@>
+
+@<Glob...@>=
+@!edit_name_start: pool_pointer; {where the filename to switch to starts}
+@!edit_name_length,@!edit_line: integer; {what line to start editing at}
+@!ipc_on: integer; {level of IPC action, 0 for none [default]}
+
+@ The |edit_name_start| will be set to point into |str_pool| somewhere after
+its beginning if \TeX\ is supposed to switch to an editor on exit.
+
+@<Set init...@>=
+edit_name_start:=0;
+
+@ These are used when we regenerate the representation of the first 256
+strings.
+
+@<Global...@> =
+@!save_str_ptr: str_number;
+@!save_pool_ptr: pool_pointer;
+@!shell_enabled_p: boolean;
+@!output_comment: ^char;
+@!k,l: 0..65535; {used by `Make the first 256 strings', etc.}
+
+@ When debugging a macro package, it can be useful to see the exact
+control sequence names in the format file. For example, if ten new
+csnames appear, it's nice to know what they are, to help pinpoint where
+they came from. (This isn't a truly ``basic'' printing procedure, but
+that's a convenient module in which to put it.)
+
+@<Basic printing procedures@> =
+procedure print_csnames (hstart:integer; hfinish:integer);
+var c,h:integer;
+begin
+ write_ln(stderr, 'fmtdebug:csnames from ', hstart, ' to ', hfinish, ':');
+ for h := hstart to hfinish do begin
+ if newtext(h) > 0 then begin {if have anything at this position}
+ for c := str_start(newtext(h)) to str_start(newtext(h) + 1) - 1
+ do begin
+ put_byte(str_pool[c], stderr); {print the characters}
+ end;
+ write_ln(stderr, '|');
+ end;
+ end;
+end;
+
+@ Are we printing extra info as we read the format file?
+
+@<Glob...@> =
+@!debug_format_file: boolean;
+
+
+@* \[54/web2c-string] The string recycling routines. \TeX{} uses 2
+upto 4 {\it new\/} strings when scanning a filename in an \.{\\input},
+\.{\\openin}, or \.{\\openout} operation. These strings are normally
+lost because the reference to them are not saved after finishing the
+operation. |search_string| searches through the string pool for the
+given string and returns either 0 or the found string number.
+
+@<Declare additional routines for string recycling@>=
+function search_string(@!search:str_number):str_number;
+label found;
+var result: str_number;
+@!s: str_number; {running index}
+@!len: integer; {length of searched string}
+begin result:=0; len:=length(search);
+if len=0 then {trivial case}
+ begin result:=""; goto found;
+ end
+else begin s:=search-1; {start search with newest string below |s|; |search>1|!}
+ while s>65535 do {first 65536 strings depend on implementation!!}
+ begin if length(s)=len then
+ if str_eq_str(s,search) then
+ begin result:=s; goto found;
+ end;
+ decr(s);
+ end;
+ end;
+found:search_string:=result;
+end;
+
+@ The following routine is a variant of |make_string|. It searches
+the whole string pool for a string equal to the string currently built
+and returns a found string. Otherwise a new string is created and
+returned. Be cautious, you can not apply |flush_string| to a replaced
+string!
+
+@<Declare additional routines for string recycling@>=
+function slow_make_string : str_number;
+label exit;
+var s: str_number; {result of |search_string|}
+@!t: str_number; {new string}
+begin t:=make_string; s:=search_string(t);
+if s>0 then
+ begin flush_string; slow_make_string:=s; return;
+ end;
+slow_make_string:=t;
+exit:end;
+
+
+@* \[54] System-dependent changes.
+@z
diff --git a/Build/source/texk/web2c/omegadir-1.15/comchar.ch b/Build/source/texk/web2c/omegadir-1.15/comchar.ch
new file mode 100644
index 00000000000..2f83aa2ab8a
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comchar.ch
@@ -0,0 +1,20 @@
+% comchar.ch: Local adaptations for file omchar.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir-1.15/comdir.ch b/Build/source/texk/web2c/omegadir-1.15/comdir.ch
new file mode 100644
index 00000000000..cf41e790053
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comdir.ch
@@ -0,0 +1,20 @@
+% comdir.ch: Local adaptations for file omdir.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir-1.15/comfi.ch b/Build/source/texk/web2c/omegadir-1.15/comfi.ch
new file mode 100644
index 00000000000..3d5b2487ca5
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comfi.ch
@@ -0,0 +1,20 @@
+% comfi.ch: Local adapatations for file omfi.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir-1.15/comfilter.ch b/Build/source/texk/web2c/omegadir-1.15/comfilter.ch
new file mode 100644
index 00000000000..70dcb9a9bde
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comfilter.ch
@@ -0,0 +1,123 @@
+% comfilter.ch: Local adaptations for file omfilter.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x
+@!inf_ocp_list_size = 1000;
+@y
+@!inf_ocp_list_size = 1000;
+@!sup_ocp_buf_size = 1000000;
+@!inf_ocp_buf_size = 1000;
+@!sup_ocp_stack_size = 1000000;
+@!inf_ocp_stack_size = 1000;
+@z
+%---------------------------------------
+@x
+@!ocp_list_size:integer;
+@y
+@!ocp_list_size:integer;
+@!ocp_buf_size:integer;
+@!ocp_stack_size:integer;
+@z
+%---------------------------------------
+@x
+for k:=0 to active_max_ptr-1 do dump_wd(active_info[k]);
+print_ln; print_int(active_max_ptr); print(" words of active ocps");
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+for k:=0 to active_max_ptr-1 do undump_wd(active_info[k]);
+@y
+dump_things(active_info[0], active_max_ptr);
+print_ln; print_int(active_max_ptr); print(" words of active ocps");
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+undump_things(active_info[0], active_max_ptr);
+@z
+%---------------------------------------
+@x
+ setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+@y
+ setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+ setup_bound_var(1000)('ocp_buf_size')(ocp_buf_size);
+ setup_bound_var(1000)('ocp_stack_size')(ocp_stack_size);
+@z
+%---------------------------------------
+@x
+ ocp_list_list:=xmalloc_array (ocp_list_index, ocp_list_size);
+@y
+ ocp_list_list:=xmalloc_array (ocp_list_index, ocp_list_size);
+ otp_init_input_buf:=xmalloc_array (quarterword, ocp_buf_size);
+ otp_input_buf:=xmalloc_array (quarterword, ocp_buf_size);
+ otp_output_buf:=xmalloc_array (quarterword, ocp_buf_size);
+ otp_stack_buf:=xmalloc_array (quarterword, ocp_stack_size);
+ otp_calcs:=xmalloc_array (halfword, ocp_stack_size);
+ otp_states:=xmalloc_array (halfword, ocp_stack_size);
+@z
+%---------------------------------------
+@x
+@!otp_init_input_buf:array[0..20000] of quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:array[0..20000] of quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:array[0..20000] of quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:array[0..1000] of quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:array[0..1000] of halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:array[0..1000] of halfword;
+@y
+@!otp_init_input_buf:^quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:^quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:^quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:^quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:^halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:^halfword;
+@z
diff --git a/Build/source/texk/web2c/omegadir-1.15/comfont.ch b/Build/source/texk/web2c/omegadir-1.15/comfont.ch
new file mode 100644
index 00000000000..b5934f0589a
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comfont.ch
@@ -0,0 +1,20 @@
+% comfonts.ch: Local adaptations for file omfonts.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir-1.15/comocp.ch b/Build/source/texk/web2c/omegadir-1.15/comocp.ch
new file mode 100644
index 00000000000..27c052d70e7
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comocp.ch
@@ -0,0 +1,141 @@
+% comcop.ch: Local adaptations for file omocp.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@y
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@!sup_ocp_list_size = 1000000;
+@!inf_ocp_list_size = 1000;
+@z
+%---------------------------------------
+@x
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@y
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@!ocp_list_size:integer;
+@z
+%---------------------------------------
+@x
+if not b_open_in(ocp_file) then ocp_abort("opening file");
+@y
+if not ocp_open_in(ocp_file) then ocp_abort("opening file");
+@z
+%---------------------------------------
+@x
+@d ocpget==get(ocp_file)
+@d ocpbyte==ocp_file^
+@y
+@d ocpget==ocp_temp:=getc(ocp_file)
+@d ocpbyte==ocp_temp
+@z
+%---------------------------------------
+@x
+@!ocp_list_info:array[ocp_list_index] of memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
+@y
+@!ocp_list_info:^memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:^memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:^ocp_list_index;
+@z
+%---------------------------------------
+@x
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
+dump_int(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ dump_int(ocp_list_list[k]);
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
+@y
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+dump_things(ocp_list_info[0], ocp_listmem_ptr);
+dump_int(ocp_list_ptr);
+dump_things(ocp_list_list[null_ocp_list], ocp_list_ptr+1-null_ocp_list);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+dump_things(ocp_lstack_info[0], ocp_lstackmem_ptr)
+@z
+%---------------------------------------
+@x
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
+undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do
+ undump_int(ocp_list_list[k]);
+undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
+@y
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+undump_things(ocp_list_info[0], ocp_listmem_ptr);
+undump_size(0)(1000000)('ocp list max')(ocp_list_ptr);
+undump_things(ocp_list_list[null_ocp_list], ocp_list_ptr+1-null_ocp_list);
+undump_size(0)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+undump_things(ocp_lstack_info[0], ocp_lstackmem_ptr)
+@z
+%---------------------------------------
+@x
+ setup_bound_var (79)('max_print_line')(max_print_line);
+@y
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+@z
+%---------------------------------------
+@x
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+@y
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+ ocp_list_info:=xmalloc_array (memory_word, ocp_list_size);
+ ocp_lstack_info:=xmalloc_array (memory_word, ocp_list_size);
+ ocp_list_list:=xmalloc_array (ocp_list_index, ocp_list_size);
+@z
diff --git a/Build/source/texk/web2c/omegadir-1.15/compar.ch b/Build/source/texk/web2c/omegadir-1.15/compar.ch
new file mode 100644
index 00000000000..42251993dd0
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/compar.ch
@@ -0,0 +1,20 @@
+% Local adaptations for file ompar.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir-1.15/comsrcspec.ch b/Build/source/texk/web2c/omegadir-1.15/comsrcspec.ch
new file mode 100644
index 00000000000..3c6ac66f60b
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comsrcspec.ch
@@ -0,0 +1,343 @@
+@x
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@y
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@!special_loc:pointer;
+@!special_token:halfword;
+
+@!parse_first_line_p:boolean; {parse the first line for options}
+
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@!halt_on_error_p:boolean; {allow only on error.}
+
+@!src_specials_p : boolean;
+@!insert_src_special_auto : boolean;
+@!insert_src_special_every_par : boolean;
+@!insert_src_special_every_parend : boolean;
+@!insert_src_special_every_cr : boolean;
+@!insert_src_special_every_math : boolean;
+@!insert_src_special_every_hbox : boolean;
+@!insert_src_special_every_vbox : boolean;
+@!insert_src_special_every_display : boolean;
+
+procedure print_file_line_style_line_and_file; forward;
+@z
+
+@x
+wterm(banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+@y
+if src_specials_p or file_line_error_style_p or parse_first_line_p then
+ wterm(banner_k)
+else
+ wterm(banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+if shell_enabled_p then begin
+ wterm_ln(' \write18 enabled.')
+end;
+if src_specials_p then begin
+ wterm_ln(' Source specials enabled.')
+end;
+if file_line_error_style_p then begin
+ wterm_ln(' file:line:error style messages enabled.')
+end;
+if parse_first_line_p then begin
+ wterm_ln(' %&-line parsing enabled.')
+end;
+@z
+
+@x
+ print_nl("! "); print(#);
+@y
+ if (file_line_error_style_p and not terminal_input) then
+ begin
+ print_file_line_style_line_and_file;
+ print (#);
+ end
+ else begin print_nl("! "); print(#) end;
+@z
+
+@x
+print_char("."); show_context;
+@y
+if not file_line_error_style_p then begin
+ print_char("."); show_context
+end;
+
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+
+@z
+@x
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@y
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@!source_filename_stack : ^str_number;
+@!full_source_filename_stack : ^str_number;
+@z
+
+@x
+begin wlog(banner);
+wlog(version_string);
+@y
+begin if src_specials_p or file_line_error_style_p or parse_first_line_p
+then
+ wlog(banner_k)
+else
+ wlog(banner);
+wlog(version_string);
+if shell_enabled_p then begin
+ wlog_cr;
+ wlog('\write18 enabled.')
+end;
+if src_specials_p then begin
+ wlog_cr;
+ wlog(' Source specials enabled.')
+end;
+if file_line_error_style_p then begin
+ wlog_cr;
+ wlog(' file:line:error style messages enabled.')
+end;
+if parse_first_line_p then begin
+ wlog_cr;
+ wlog(' %&-line parsing enabled.');
+end;
+@z
+
+%% ** 537 ******************************************************************
+
+@x
+done: name:=a_make_name_string(cur_file);
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@y
+done: name:=a_make_name_string(cur_file);
+source_filename_stack[in_open]:=name;
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@z
+
+%%@x
+%%if term_offset+length(name)>max_print_line-2 then print_ln
+%%else if (term_offset>0)or(file_offset>0) then print_char(" ");
+%%print_char("("); incr(open_parens); slow_print(name); update_terminal;
+%%@y
+%%if term_offset+length(full_source_filename_stack[in_open])>max_print_line-2 then print_ln
+%%else if (term_offset>0)or(file_offset>0) then print_char(" ");
+%%print_char("("); incr(open_parens); slow_print(full_source_filename_stack[in_open]); update_terminal;
+%%@z
+
+%% ** 774 ******************************************************************
+
+ @x
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @y
+if (insert_src_special_every_cr and head<>tail) then insert_src_special;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @z
+
+%% ** 799 ******************************************************************
+
+ @x
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @y
+if (insert_src_special_every_cr) then insert_src_special;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @z
+
+%% ** 1034 ******************************************************************
+
+@x
+@<Append character |cur_chr|...@>=
+adjust_space_factor;@/
+@y
+@<Append character |cur_chr|...@>=
+if ((head=tail) and (mode>0)) then begin
+ if (insert_src_special_auto) then append_src_special;
+end;
+adjust_space_factor;@/
+@z
+
+%% ** 1083 ******************************************************************
+
+ @x
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ @y
+ if (insert_src_special_every_vbox) then insert_src_special;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ @z
+
+ @x
+ if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+ @y
+ if (insert_src_special_every_hbox) then insert_src_special;
+ if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+ @z
+
+%% ** 1091 ******************************************************************
+% Disabled, prevents merge with web2c's tex.ch.
+ @x
+ if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+ @y
+ if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ if (insert_src_special_every_par) then insert_src_special;@+
+ end;
+ @z
+
+%% ** 1096 ******************************************************************
+
+ @x fixme: etex conflict
+ else line_break(widow_penalty);
+ @y
+ else begin
+ if (insert_src_special_every_parend) then insert_src_special;
+ line_break(widow_penalty);
+ end;
+ @z
+
+%% ** 1139 ******************************************************************
+
+@x
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+if (insert_src_special_every_math) then insert_src_special;
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+
+%% ** 1145 ******************************************************************
+
+ @x
+if every_display<>null then begin_token_list(every_display,every_display_text);
+ @y
+if (insert_src_special_every_display) then append_src_special;
+if every_display<>null then begin_token_list(every_display,every_display_text);
+ @z
+
+%% ** 1167 ******************************************************************
+
+@x
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@y
+ if (insert_src_special_every_vbox) then insert_src_special;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@z
+
+%% ** 1313 ******************************************************************
+
+@x
+dump_int(par_loc); dump_int(write_loc);@/
+@y
+dump_int(par_loc); dump_int(write_loc); dump_int(special_loc);@/
+@z
+
+%% ** 1314 ******************************************************************
+
+@x
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+@y
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+undump(hash_base)(frozen_control_sequence)(special_loc);
+special_token:=cs_token_flag+special_loc;@/
+@z
+
+@x
+ line_stack:=xmalloc_array (integer, max_in_open);
+@y
+ line_stack:=xmalloc_array (integer, max_in_open);
+ source_filename_stack:=xmalloc_array (str_number, max_in_open);
+ full_source_filename_stack:=xmalloc_array (str_number, max_in_open);
+@z
+
+%% ** 1344 ******************************************************************
+
+@x
+primitive("special",extension,special_node);@/
+@y
+primitive("special",extension,special_node);@/
+special_loc:=cur_val; special_token:=cs_token_flag+special_loc;@/
+@z
+
+%% ** 1379 ******************************************************************
+
+@x
+@* \[55] Index.
+@y
+
+@ @<Declare action procedures for use by |main_control|@>=
+
+procedure insert_src_special;
+var toklist, p, q : pointer;
+begin
+ if (source_filename_stack[in_open] > 0 and is_new_source (source_filename_stack[in_open], line)) then begin
+ toklist := get_avail;
+ p := toklist;
+ info(p) := special_token;
+ link(p) := get_avail; p := link(p);
+ info(p) := left_brace_token+"{";
+ q := str_toks (make_src_special (source_filename_stack[in_open], line));
+ link(p) := link(temp_head);
+ p := q;
+ link(p) := get_avail; p := link(p);
+ info(p) := right_brace_token+"}";
+ ins_list (toklist);
+ remember_source_info (source_filename_stack[in_open], line);
+ end;
+end;
+
+procedure append_src_special;
+var p, q : pointer;
+begin
+ if (source_filename_stack[in_open] > 0 and is_new_source (source_filename_stack[in_open], line)) then begin
+ new_whatsit (special_node, write_node_size);
+ write_stream(tail) := null;
+ def_ref := get_avail;
+ token_ref_count(def_ref) := null;
+ q := str_toks (make_src_special (source_filename_stack[in_open], line));
+ link(def_ref) := link(temp_head);
+ write_tokens(tail) := def_ref;
+ remember_source_info (source_filename_stack[in_open], line);
+ end;
+end;
+
+procedure print_file_line_style_line_and_file;
+begin
+ print_nl ("");
+ print (full_source_filename_stack[in_open]);
+ print (":"); print_int (line); print (": ");
+end;
+
+@* \[55] Index.
+@z
+
diff --git a/Build/source/texk/web2c/omegadir-1.15/comstr.ch b/Build/source/texk/web2c/omegadir-1.15/comstr.ch
new file mode 100644
index 00000000000..636874bd68d
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comstr.ch
@@ -0,0 +1,20 @@
+% comstr.ch: Local adaptations for file omstr.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir-1.15/comtrans.ch b/Build/source/texk/web2c/omegadir-1.15/comtrans.ch
new file mode 100644
index 00000000000..e954fd14fd5
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comtrans.ch
@@ -0,0 +1,20 @@
+% comtrans.ch: Local adaptations for file omtrans.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir-1.15/comw32.ch b/Build/source/texk/web2c/omegadir-1.15/comw32.ch
new file mode 100644
index 00000000000..12afcb2d09e
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comw32.ch
@@ -0,0 +1,77 @@
+@x
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@y
+@!file_line_error_style_p:boolean; {format error messages as file:line:error}
+@!halt_on_error_p:boolean; {stop at first error.}
+@!quoted_filename : boolean;
+@z
+
+@x l:1927
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+@y
+ ready_already:=0;
+ texmf_finish_job;
+ if (history <> spotless) and (history <> warning_issued) then
+@z
+
+@x l:10101
+begin area_delimiter:=0; ext_delimiter:=0;
+@y
+begin area_delimiter:=0; ext_delimiter:=0;
+quoted_filename:=false;
+@z
+
+@x l:10111
+begin if c=" " then more_name:=false
+else begin str_room(1); append_char(c); {contribute |c| to the current string}
+@y
+begin
+if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+end;
+if (c=" ") and (not quoted_filename) then more_name:=false
+else begin
+ if (c="*") then c:=" "
+ else if (c="?") then c:="~";
+ str_room(1); append_char(c); {contribute |c| to the current string}
+@z
+
+@x l:10175
+begin slow_print(a); slow_print(n); slow_print(e);
+@y
+begin texmf_print_filename (a, n, e);
+@z
+
+@x l:10184
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+@x l:13060
+ print_nl("Output written on "); slow_print(output_file_name);
+@y
+ print_nl("Output written on "); texmf_print_filename(0, output_file_name, 0);
+@z
+
+@x
+begin @!{|start_here|}
+@y
+begin @!{|start_here|}
+
+ texmf_start_job;
+@z
+
+@x l:24891
+ slow_print(log_name); print_char(".");
+ end;
+@y
+ texmf_print_filename(0, log_name, 0); print_char(".");
+ end;
+@z
diff --git a/Build/source/texk/web2c/omegadir-1.15/comxml.ch b/Build/source/texk/web2c/omegadir-1.15/comxml.ch
new file mode 100644
index 00000000000..8767e9376ae
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/comxml.ch
@@ -0,0 +1,20 @@
+% comxml.ch: Local adaptations for file omxml.ch
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir-1.15/om16bit.ch b/Build/source/texk/web2c/omegadir-1.15/om16bit.ch
new file mode 100644
index 00000000000..12d8b49d023
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/om16bit.ch
@@ -0,0 +1,2635 @@
+% om16bit.ch: Basic changes to TeX data structures allowing all
+% 8-bit entities to become 32-bit entities, in particular
+% characters and glyphs.
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+@x limbo l.1 - Omega
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+@y
+% This program is copyright
+% (C) 1994--2000 by John Plaice and Yannis Haralambous.
+% It is designed to be a change file for D. E. Knuth's TeX version 3.141592.
+%
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+@z
+%---------------------------------------
+@x limbo l.80
+\def\title{\TeX82}
+@y
+\def\title{$\Omega$ (OMEGA)}
+@z
+%---------------------------------------
+@x [1] m.1 l.90 - Omega
+This is \TeX, a document compiler intended to produce typesetting of high
+quality.
+The \PASCAL\ program that follows is the definition of \TeX82, a standard
+@:PASCAL}{\PASCAL@>
+@!@:TeX82}{\TeX82@>
+@y
+This is $\Omega$, a document compiler intended to simplify high-quality
+typesetting for many of the world's languages. It is an extension
+of D. E. Knuth's \TeX, which was designed essentially for the
+typesetting of languages using the Latin alphabet.
+
+The $\Omega$ system loosens many of the restrictions imposed by~\TeX:
+register numbers are no longer limited to 8~bits; fonts may have more
+than 256~characters; more than 256~fonts may be used; etc. In addition,
+$\Omega$ allows much more complex ligature mechanisms between characters,
+thereby simplifying the typesetting of alphabets that have preserved
+their calligraphic traditions.
+
+The \PASCAL\ program that follows is a modification of the definition of \TeX82,
+a standard @:PASCAL}{\PASCAL@> @!@:TeX82}{\TeX82@>
+@z
+%---------------------------------------
+@x [1] m.1 l.97 - Omega
+will be obtainable on a great variety of computers.
+
+@y
+will be obtainable on a great variety of computers.
+
+As little as possible is changed in this document. This means that
+unless the contrary is explicitly stated, references to \TeX\ in the
+documentation are equally applicable to~$\Omega$. References to `the
+author' in the documentation are to D. E. Knuth.
+
+@z
+%---------------------------------------
+@x [1] m.2 l.187 - Omega
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@y
+@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts}
+@z
+%---------------------------------------
+@x [1] m.4 l.243
+program TEX; {all file names are defined dynamically}
+@y
+program OMEGA; {all file names are defined dynamically}
+@z
+%---------------------------------------
+@x [1] m.11 l.392 - Omega
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@y
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@z
+%---------------------------------------
+@x [1] m.11 l.412 - Omega
+@!pool_name='TeXformats:TEX.POOL ';
+@y
+@!pool_name='TeXformats:OMEGA.POOL ';
+@z
+%---------------------------------------
+@x [1] m.12 l.437 - Omega
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@d biggest_char=65535 {the largest allowed character number;
+ must be |<=max_quarterword|}
+@d too_big_char=65536 {|biggest_char+1|}
+@d special_char=65537 {|biggest_char+2|}
+@d number_chars=65536 {|biggest_char+1|}
+@d biggest_reg=65535 {the largest allowed register number;
+ must be |<=max_quarterword|}
+@d number_regs=65536 {|biggest_reg+1|}
+@d font_biggest=65535 {the real biggest font}
+@d number_fonts=font_biggest-font_base+2
+@d number_math_fonts=768
+@d math_font_biggest=767
+@d text_size=0 {size code for the largest size in a family}
+@d script_size=256 {size code for the medium size in a family}
+@d script_script_size=512 {size code for the smallest size in a family}
+@d biggest_lang=255
+@d too_big_lang=256
+@z
+%---------------------------------------
+@x [8] m.110 l.2355 - Omega
+In order to make efficient use of storage space, \TeX\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a (signed) |glue_ratio|, or a small number of
+fields that are one half or one quarter of the size used for storing
+integers.
+
+@y
+In order to make efficient use of storage space, \TeX\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a (signed) |glue_ratio|, or a small number of
+fields that are one half or one quarter of the size used for storing
+integers.
+
+That is the description for \TeX. For $\Omega$, we are going to keep
+the same terminology, except that |quarterword| is going to refer to
+16~bits, and |halfword| is going to refer to 32~bits. So, in fact,
+a |memory_word| will take 64 bits, and, on a 64-bit machine, will run
+smaller than \TeX\ will!
+
+@z
+%---------------------------------------
+@x [8] m.110 l.2378 - Omega
+Since we are assuming 32-bit integers, a halfword must contain at least
+16 bits, and a quarterword must contain at least 8 bits.
+@^system dependencies@>
+But it doesn't hurt to have more bits; for example, with enough 36-bit
+words you might be able to have |mem_max| as large as 262142, which is
+eight times as much memory as anybody had during the first four years of
+\TeX's existence.
+
+N.B.: Valuable memory space will be dreadfully wasted unless \TeX\ is compiled
+by a \PASCAL\ that packs all of the |memory_word| variants into
+the space of a single integer. This means, for example, that |glue_ratio|
+words should be |short_real| instead of |real| on some computers. Some
+\PASCAL\ compilers will pack an integer whose subrange is `|0..255|' into
+an eight-bit field, but others insist on allocating space for an additional
+sign bit; on such systems you can get 256 values into a quarterword only
+if the subrange is `|-128..127|'.
+
+@y
+@z
+%---------------------------------------
+@x [8] m.110 l.2406 - Omega
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y
+@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|}
+@d min_halfword=0 {smallest allowable value in a |halfword|}
+@d max_halfword=@"3FFFFFFF {largest allowable value in a |halfword|}
+@z
+%---------------------------------------
+@x [8] m.111 l.2416 - Omega
+if (min_quarterword>0)or(max_quarterword<127) then bad:=11;
+if (min_halfword>0)or(max_halfword<32767) then bad:=12;
+@y
+if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11;
+if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12;
+@z
+%---------------------------------------
+@x [8] m.111 l.2423 - Omega
+if font_max>font_base+256 then bad:=16;
+@y
+if font_max>font_base+@"10000 then bad:=16;
+@z
+%---------------------------------------
+@x [8] m.111 l.2426 - Omega
+if max_quarterword-min_quarterword<255 then bad:=19;
+@y
+if max_quarterword-min_quarterword<@"FFFF then bad:=19;
+@z
+%---------------------------------------
+@x [10] m.134 l.2832 - Omega
+Note that the format of a |char_node| allows for up to 256 different
+fonts and up to 256 characters per font; but most implementations will
+probably limit the total number of fonts to fewer than 75 per job,
+and most fonts will stick to characters whose codes are
+less than 128 (since higher codes
+are more difficult to access on most keyboards).
+
+Extensions of \TeX\ intended for oriental languages will need even more
+than $256\times256$ possible characters, when we consider different sizes
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+and styles of type. It is suggested that Chinese and Japanese fonts be
+handled by representing such characters in two consecutive |char_node|
+entries: The first of these has |font=font_base|, and its |link| points
+to the second;
+the second identifies the font and the character dimensions.
+The saving feature about oriental characters is that most of them have
+the same box dimensions. The |character| field of the first |char_node|
+is a ``\\{charext}'' that distinguishes between graphic symbols whose
+dimensions are identical for typesetting purposes. (See the \MF\ manual.)
+Such an extension of \TeX\ would not be difficult; further details are
+left to the reader.
+@y
+Note that the format of a |char_node| allows for up to 65536 different
+fonts and up to 65536 characters per font.
+@z
+%---------------------------------------
+@x [15] m.208 l.4127 - Omega
+@d min_internal=68 {the smallest code that can follow \.{\\the}}
+@d char_given=68 {character code defined by \.{\\chardef}}
+@d math_given=69 {math code defined by \.{\\mathchardef}}
+@d last_item=70 {most recent item ( \.{\\lastpenalty},
+ \.{\\lastkern}, \.{\\lastskip} )}
+@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}}
+@y
+@d min_internal=end_cs_name+1 {the smallest code that can follow \.{\\the}}
+@d char_given=min_internal {character code defined by \.{\\chardef}}
+@d math_given=char_given+1 {math code defined by \.{\\mathchardef}}
+@d omath_given=math_given+1 {math code defined by \.{\\omathchardef}}
+@d last_item=omath_given+1 {most recent item ( \.{\\lastpenalty},
+ \.{\\lastkern}, \.{\\lastskip} )}
+@d max_non_prefixed_command=last_item
+ {largest command code that can't be \.{\\global}}
+@z
+%---------------------------------------
+@x [15] m.209 l.4138 - Omega
+@d toks_register=71 {token list register ( \.{\\toks} )}
+@d assign_toks=72 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
+@d assign_int=73 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
+@d assign_dimen=74 {user-defined length ( \.{\\hsize}, etc.~)}
+@d assign_glue=75 {user-defined glue ( \.{\\baselineskip}, etc.~)}
+@d assign_mu_glue=76 {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
+@d assign_font_dimen=77 {user-defined font dimension ( \.{\\fontdimen} )}
+@d assign_font_int=78 {user-defined font integer ( \.{\\hyphenchar},
+ \.{\\skewchar} )}
+@d set_aux=79 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
+@d set_prev_graf=80 {specify state info ( \.{\\prevgraf} )}
+@d set_page_dimen=81 {specify state info ( \.{\\pagegoal}, etc.~)}
+@d set_page_int=82 {specify state info ( \.{\\deadcycles},
+ \.{\\insertpenalties} )}
+@d set_box_dimen=83 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
+@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
+@d def_code=85 {define a character code ( \.{\\catcode}, etc.~)}
+@d def_family=86 {declare math fonts ( \.{\\textfont}, etc.~)}
+@d set_font=87 {set current font ( font identifiers )}
+@d def_font=88 {define a font file ( \.{\\font} )}
+@d register=89 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d max_internal=89 {the largest code that can follow \.{\\the}}
+@d advance=90 {advance a register or parameter ( \.{\\advance} )}
+@d multiply=91 {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=92 {divide a register or parameter ( \.{\\divide} )}
+@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=94 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
+@d def=97 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=98 {set a box ( \.{\\setbox} )}
+@d hyph_data=99 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d max_command=100 {the largest command code seen at |big_switch|}
+@y
+@d toks_register=max_non_prefixed_command+1
+ {token list register ( \.{\\toks} )}
+@d assign_toks=toks_register+1
+ {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
+@d assign_int=assign_toks+1
+ {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
+@d assign_dimen=assign_int+1
+ {user-defined length ( \.{\\hsize}, etc.~)}
+@d assign_glue=assign_dimen+1
+ {user-defined glue ( \.{\\baselineskip}, etc.~)}
+@d assign_mu_glue=assign_glue+1
+ {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
+@d assign_font_dimen=assign_mu_glue+1
+ {user-defined font dimension ( \.{\\fontdimen} )}
+@d assign_font_int=assign_font_dimen+1
+ {user-defined font integer ( \.{\\hyphenchar}, \.{\\skewchar} )}
+@d set_aux=assign_font_int+1
+ {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
+@d set_prev_graf=set_aux+1
+ {specify state info ( \.{\\prevgraf} )}
+@d set_page_dimen=set_prev_graf+1
+ {specify state info ( \.{\\pagegoal}, etc.~)}
+@d set_page_int=set_page_dimen+1
+ {specify state info ( \.{\\deadcycles},
+ \.{\\insertpenalties} )}
+@d set_box_dimen=set_page_int+1
+ {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
+@d set_shape=set_box_dimen+1
+ {specify fancy paragraph shape ( \.{\\parshape} )}
+@d def_code=set_shape+1
+ {define a character code ( \.{\\catcode}, etc.~)}
+@d def_family=def_code+1
+ {declare math fonts ( \.{\\textfont}, etc.~)}
+@d set_font=def_family+1
+ {set current font ( font identifiers )}
+@d def_font=set_font+1
+ {define a font file ( \.{\\font} )}
+@d register=def_font+1
+ {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d max_internal=register
+ {the largest code that can follow \.{\\the}}
+@d advance=max_internal+1
+ {advance a register or parameter ( \.{\\advance} )}
+@d multiply=advance+1
+ {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=multiply+1
+ {divide a register or parameter ( \.{\\divide} )}
+@d prefix=divide+1
+ {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=prefix+1
+ {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=let+1
+ {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@d read_to_cs=shorthand_def+1
+ {read into a control sequence ( \.{\\read} )}
+@d def=read_to_cs+1
+ {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=def+1
+ {set a box ( \.{\\setbox} )}
+@d hyph_data=set_box+1
+ {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=hyph_data+1
+ {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d max_command=set_interaction
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.220 l.4486 - Omega
+@d eq_level(#)==eq_level_field(eqtb[#]) {level of definition}
+@d eq_type(#)==eq_type_field(eqtb[#]) {command code for equivalent}
+@d equiv(#)==equiv_field(eqtb[#]) {equivalent value}
+@y
+@d eq_level(#)==new_eq_level(#) {level of definition}
+@d eq_type(#)==new_eq_type(#) {command code for equivalent}
+@d equiv(#)==new_equiv(#) {equivalent value}
+@d equiv1(#)==new_equiv1(#) {equivalent value}
+@z
+%---------------------------------------
+@x [17] m.222 l.4496 - Omega
+In the first region we have 256 equivalents for ``active characters'' that
+act as control sequences, followed by 256 equivalents for single-character
+control sequences.
+@y
+In the first region we have |number_chars| equivalents for ``active characters''
+that act as control sequences, followed by |number_chars| equivalents for
+single-character control sequences.
+@z
+%---------------------------------------
+@x [17] m.222 l.4507 - Omega
+@d single_base=active_base+256 {equivalents of one-character control sequences}
+@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}}
+@y
+@d single_base=active_base+number_chars
+ {equivalents of one-character control sequences}
+@d null_cs=single_base+number_chars {equivalent of \.{\\csname\\endcsname}}
+@z
+%---------------------------------------
+@x [17] m.222 l.4530 - Omega
+eq_type(undefined_control_sequence):=undefined_cs;
+equiv(undefined_control_sequence):=null;
+eq_level(undefined_control_sequence):=level_zero;
+for k:=active_base to undefined_control_sequence-1 do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+@y
+set_eq_type(undefined_control_sequence,undefined_cs);
+set_equiv(undefined_control_sequence,null);
+set_eq_level(undefined_control_sequence,level_zero);
+@z
+%---------------------------------------
+@x [17] m.224 l.4547 - Omega
+@ Region 3 of |eqtb| contains the 256 \.{\\skip} registers, as well as the
+glue parameters defined here. It is important that the ``muskip''
+parameters have larger numbers than the others.
+@y
+@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers,
+as well as the glue parameters defined here. It is important that the
+``muskip'' parameters have larger numbers than the others.
+@z
+%---------------------------------------
+@x [17] m.224 l.4572 - Omega
+@d skip_base=glue_base+glue_pars {table of 256 ``skip'' registers}
+@d mu_skip_base=skip_base+256 {table of 256 ``muskip'' registers}
+@d local_base=mu_skip_base+256 {beginning of region 4}
+@y
+@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers}
+@d mu_skip_base=skip_base+number_regs
+ {table of |number_regs| ``muskip'' registers}
+@d local_base=mu_skip_base+number_regs {beginning of region 4}
+@z
+%---------------------------------------
+@x [17] m.228 l.4685 - Omega
+equiv(glue_base):=zero_glue; eq_level(glue_base):=level_one;
+eq_type(glue_base):=glue_ref;
+for k:=glue_base+1 to local_base-1 do eqtb[k]:=eqtb[glue_base];
+@y
+set_equiv(glue_base,zero_glue); set_eq_level(glue_base,level_one);
+set_eq_type(glue_base,glue_ref);
+@z
+%---------------------------------------
+@x [17] m.230 l.4721 - Omega
+@d toks_base=local_base+10 {table of 256 token list registers}
+@d box_base=toks_base+256 {table of 256 box registers}
+@d cur_font_loc=box_base+256 {internal font number outside math mode}
+@d math_font_base=cur_font_loc+1 {table of 48 math font numbers}
+@d cat_code_base=math_font_base+48
+ {table of 256 command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings}
+@d uc_code_base=lc_code_base+256 {table of 256 uppercase mappings}
+@d sf_code_base=uc_code_base+256 {table of 256 spacefactor mappings}
+@d math_code_base=sf_code_base+256 {table of 256 math mode mappings}
+@d int_base=math_code_base+256 {beginning of region 5}
+@y
+@d toks_base=local_base+10 {table of |number_regs| token list registers}
+@d box_base=toks_base+number_regs {table of |number_regs| box registers}
+@d cur_font_loc=box_base+number_regs {internal font number outside math mode}
+@d math_font_base=cur_font_loc+1
+ {table of |number_math_fonts| math font numbers}
+@d cat_code_base=math_font_base+number_math_fonts
+ {table of |number_chars| command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+number_chars
+ {table of |number_chars| lowercase mappings}
+@d uc_code_base=lc_code_base+number_chars
+ {table of |number_chars| uppercase mappings}
+@d sf_code_base=uc_code_base+number_chars
+ {table of |number_chars| spacefactor mappings}
+@d math_code_base=sf_code_base+number_chars
+ {table of |number_chars| math mode mappings}
+@d int_base=math_code_base+number_chars {beginning of region 5}
+@z
+%---------------------------------------
+@x [17] m.232 l.4802 - Omega
+@d var_code==@'70000 {math code meaning ``use the current family''}
+
+@<Initialize table entries...@>=
+par_shape_ptr:=null; eq_type(par_shape_loc):=shape_ref;
+eq_level(par_shape_loc):=level_one;@/
+for k:=output_routine_loc to toks_base+255 do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+box(0):=null; eq_type(box_base):=box_ref; eq_level(box_base):=level_one;
+for k:=box_base+1 to box_base+255 do eqtb[k]:=eqtb[box_base];
+cur_font:=null_font; eq_type(cur_font_loc):=data;
+eq_level(cur_font_loc):=level_one;@/
+for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc];
+equiv(cat_code_base):=0; eq_type(cat_code_base):=data;
+eq_level(cat_code_base):=level_one;@/
+for k:=cat_code_base+1 to int_base-1 do eqtb[k]:=eqtb[cat_code_base];
+for k:=0 to 255 do
+ begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000;
+ end;
+cat_code(carriage_return):=car_ret; cat_code(" "):=spacer;
+cat_code("\"):=escape; cat_code("%"):=comment;
+cat_code(invalid_code):=invalid_char; cat_code(null_code):=ignore;
+for k:="0" to "9" do math_code(k):=hi(k+var_code);
+for k:="A" to "Z" do
+ begin cat_code(k):=letter; cat_code(k+"a"-"A"):=letter;@/
+ math_code(k):=hi(k+var_code+@"100);
+ math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/
+ lc_code(k):=k+"a"-"A"; lc_code(k+"a"-"A"):=k+"a"-"A";@/
+ uc_code(k):=k; uc_code(k+"a"-"A"):=k;@/
+ sf_code(k):=999;
+ end;
+@y
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+
+@<Initialize table entries...@>=
+set_equiv(par_shape_loc,null); set_eq_type(par_shape_loc,shape_ref);
+set_eq_level(par_shape_loc,level_one);@/
+set_equiv(cat_code_base+carriage_return,car_ret);
+set_equiv(cat_code_base+" ",spacer);
+set_equiv(cat_code_base+"\",escape);
+set_equiv(cat_code_base+"%",comment);
+set_equiv(cat_code_base+invalid_code,invalid_char);
+set_equiv(cat_code_base+null_code,ignore);
+for k:="0" to "9" do set_equiv(math_code_base+k,hi(k+var_code));
+for k:="A" to "Z" do
+ begin set_equiv(cat_code_base+k,letter);
+ set_equiv(cat_code_base+k+"a"-"A",letter);@/
+ set_equiv(math_code_base+k,hi(k+var_code+@"10000));
+ set_equiv(math_code_base+k+"a"-"A",hi(k+"a"-"A"+var_code+@"10000));@/
+ set_equiv(lc_code_base+k,k+"a"-"A");
+ set_equiv(lc_code_base+k+"a"-"A",k+"a"-"A");@/
+ set_equiv(uc_code_base+k,k);
+ set_equiv(uc_code_base+k+"a"-"A",k);@/
+ set_equiv(sf_code_base+k,999);
+ end;
+@z
+%---------------------------------------
+@x [17] m.234 l.4857 - Omega
+@ @<Show the font identifier in |eqtb[n]|@>=
+begin if n=cur_font_loc then print("current font")
+else if n<math_font_base+16 then
+ begin print_esc("textfont"); print_int(n-math_font_base);
+ end
+else if n<math_font_base+32 then
+ begin print_esc("scriptfont"); print_int(n-math_font_base-16);
+ end
+else begin print_esc("scriptscriptfont"); print_int(n-math_font_base-32);
+ end;
+print_char("=");@/
+print_esc(hash[font_id_base+equiv(n)].rh);
+ {that's |font_id_text(equiv(n))|}
+@y
+@ @<Show the font identifier in |eqtb[n]|@>=
+begin if n=cur_font_loc then print("current font")
+else if n<math_font_base+script_size then
+ begin print_esc("textfont"); print_int(n-math_font_base);
+ end
+else if n<math_font_base+script_script_size then
+ begin print_esc("scriptfont"); print_int(n-math_font_base-script_size);
+ end
+else begin print_esc("scriptscriptfont");
+ print_int(n-math_font_base-script_script_size);
+ end;
+print_char("=");@/
+print_esc(newtext(font_id_base+equiv(n)));
+ {that's |font_id_text(equiv(n))|}
+@z
+%---------------------------------------
+@x [17] m.236 l.4955 - Omega
+@d count_base=int_base+int_pars {256 user \.{\\count} registers}
+@d del_code_base=count_base+256 {256 delimiter code mappings}
+@d dimen_base=del_code_base+256 {beginning of region 6}
+@#
+@d del_code(#)==eqtb[del_code_base+#].int
+@d count(#)==eqtb[count_base+#].int
+@d int_par(#)==eqtb[int_base+#].int {an integer parameter}
+@y
+@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers}
+@d del_code_base=count_base+number_regs {|number_chars| delimiter code mappings}
+@d dimen_base=del_code_base+number_chars {beginning of region 6}
+@#
+@d del_code0(#)==new_equiv(del_code_base+#)
+@d del_code1(#)==new_equiv1(del_code_base+#)
+@d count(#)==new_eqtb_int(count_base+#)
+@d int_par(#)==new_eqtb_int(int_base+#) {an integer parameter}
+@z
+%---------------------------------------
+@x [17] m.240 l.5213 - Omega
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
+escape_char:="\"; end_line_char:=carriage_return;
+for k:=0 to 255 do del_code(k):=-1;
+del_code("."):=0; {this null delimiter is used in error recovery}
+@y
+set_new_eqtb_int(int_base+mag_code,1000);
+set_new_eqtb_int(int_base+tolerance_code,10000);
+set_new_eqtb_int(int_base+hang_after_code,1);
+set_new_eqtb_int(int_base+max_dead_cycles_code,25);
+set_new_eqtb_int(int_base+escape_char_code,"\");
+set_new_eqtb_int(int_base+end_line_char_code,carriage_return);
+set_equiv(del_code_base+".",0);
+set_equiv1(del_code_base+".",0);
+ {this null delimiter is used in error recovery}
+
+@ @<Set newline character to -1@>=
+set_new_eqtb_int(int_base+new_line_char_code,-1)
+
+@ @<Set newline character to nl@>=
+set_new_eqtb_int(int_base+new_line_char_code,nl)
+
+@z
+%---------------------------------------
+@x [17] m.242 l.5240 - Omega
+print_char("="); print_int(eqtb[n].int);
+@y
+print_char("="); print_int(new_eqtb_int(n));
+@z
+%---------------------------------------
+@x [17] m.247 l.5273 - Omega
+here, and the 256 \.{\\dimen} registers.
+@y
+here, and the |number_regs| \.{\\dimen} registers.
+@z
+%---------------------------------------
+@x [17] m.247 l.5298 - Omega
+ {table of 256 user-defined \.{\\dimen} registers}
+@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|}
+@#
+@d dimen(#)==eqtb[scaled_base+#].sc
+@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity}
+@y
+ {table of |number_regs| user-defined \.{\\dimen} registers}
+@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|}
+@#
+@d dimen(#)==new_eqtb_sc(scaled_base+(#))
+@d dimen_par(#)==new_eqtb_sc(dimen_base+(#)) {a scaled quantity}
+@z
+%---------------------------------------
+@x [17] m.250 l.5405 - Omega
+for k:=dimen_base to eqtb_size do eqtb[k].sc:=0;
+@y
+
+@ @p function init_eqtb_entry (p:pointer):memory_word;
+var mw:memory_word;
+begin
+ { Regions 1 and 2 }
+ if (p>=active_base) and
+ (p<=undefined_control_sequence) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+ { Region 3 }
+ else if (p>=glue_base) and
+ (p<=local_base+1) then begin
+ equiv_field(mw):=zero_glue;
+ eq_type_field(mw):=glue_ref;
+ eq_level_field(mw):=level_one;
+ end
+ { Region 4 }
+ else if (p>=par_shape_loc) and
+ (p<=toks_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+ else if (p>=box_base) and
+ (p<=box_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=box_ref;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=cur_font_loc) and
+ (p<=math_font_base+math_font_biggest) then begin
+ equiv_field(mw):=null_font;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=cat_code_base) and
+ (p<=cat_code_base+biggest_char) then begin
+ equiv_field(mw):=other_char;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=lc_code_base) and
+ (p<=uc_code_base+biggest_char) then begin
+ equiv_field(mw):=0;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=sf_code_base) and
+ (p<=sf_code_base+biggest_char) then begin
+ equiv_field(mw):=1000;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=math_code_base) and
+ (p<=math_code_base+biggest_char) then begin
+ equiv_field(mw):=hi(p-math_code_base);
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ { Region 5 }
+ else if (p>=int_base) and (p<=del_code_base-1) then begin
+ setintzero(mw,0);
+ setintone(mw,0);
+ end
+ else if (p>=del_code_base) and (p<=del_code_base+biggest_char) then begin
+ setintzero(mw,-1);
+ setintone(mw,-1);
+ end
+ { Region 6 }
+ else if (p>=dimen_base) and (p<=eqtb_size) then begin
+ setintzero(mw,0);
+ setintone(mw,0);
+ end
+ else begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end;
+ init_eqtb_entry:=mw;
+end;
+
+@z
+%---------------------------------------
+@x [17] m.251 l.5411 - Omega
+print_char("="); print_scaled(eqtb[n].sc); print("pt");
+@y
+print_char("="); print_scaled(new_eqtb_sc(n)); print("pt");
+@z
+%---------------------------------------
+@x [17] m.254 l.5435 - Omega
+@ The last two regions of |eqtb| have fullword values instead of the
+three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary,
+but \TeX\ needs to store the |eq_level| information in another array
+called |xeq_level|.
+
+@<Glob...@>=
+@!eqtb:array[active_base..eqtb_size] of memory_word;
+@!xeq_level:array[int_base..eqtb_size] of quarterword;
+@y
+@ The last two regions of |eqtb| have fullword values instead of the
+three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary,
+but \TeX\ needs to store the |eq_level| information in another array
+called |xeq_level|.
+
+@d xeq_level(#) == new_xeq_level(eqtb_size+eqtb_size+#)
+@d set_xeq_level(#) == set_new_eqtb_int(eqtb_size+eqtb_size+#)
+@z
+%---------------------------------------
+@x [17] m.255 l.5439 - Omega
+for k:=int_base to eqtb_size do xeq_level[k]:=level_one;
+@y
+@z
+%---------------------------------------
+@x [17] m.255 l.5446 - Omega
+for q:=active_base to box_base+255 do
+@y
+for q:=active_base to box_base+biggest_reg do
+@z
+%---------------------------------------
+@x [18] m.256 l.5477 - Omega
+@d next(#) == hash[#].lh {link for coalesced lists}
+@d text(#) == hash[#].rh {string number for control sequence name}
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name}
+
+@<Glob...@>=
+@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
+ {the hash table}
+@y
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@d newtext(#) == new_hash_text(eqtb_size+#)
+@d newnext(#) == new_hash_next(eqtb_size+#)
+@d settext(#) == set_hash_text(eqtb_size+#)
+@d setnext(#) == set_hash_next(eqtb_size+#)
+
+@<Glob...@>=
+@z
+%---------------------------------------
+@x [18] m.257 l.5491 - Omega
+next(hash_base):=0; text(hash_base):=0;
+for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base];
+@y
+@z
+%---------------------------------------
+@x [18] m.258 l.5497 - Omega
+hash_used:=frozen_control_sequence; {nothing is used}
+cs_count:=0;
+eq_type(frozen_dont_expand):=dont_expand;
+text(frozen_dont_expand):="notexpanded:";
+@y
+hash_used:=frozen_control_sequence; {nothing is used}
+cs_count:=0;
+set_eq_type(frozen_dont_expand,dont_expand);
+settext(frozen_dont_expand,"notexpanded:");
+@z
+%---------------------------------------
+@x [18] m.259 l.5514 - Omega
+@!k:pointer; {index in |buffer| array}
+begin @<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+begin if text(p)>0 then if length(text(p))=l then
+ if str_eq_buf(text(p),j) then goto found;
+ if next(p)=0 then
+ begin if no_new_control_sequence then
+ p:=undefined_control_sequence
+ else @<Insert a new control sequence after |p|, then make
+ |p| point to it@>;
+ goto found;
+ end;
+ p:=next(p);
+ end;
+found: id_lookup:=p;
+@y
+@!k:pointer; {index in |buffer| array}
+@!newstring:integer;
+begin @<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+begin if newtext(p)>0 then if length(newtext(p))=l then
+ if str_eq_buf(newtext(p),j) then goto found;
+ if newnext(p)=0 then
+ begin if no_new_control_sequence then
+ p:=undefined_control_sequence
+ else @<Insert a new control sequence after |p|, then make
+ |p| point to it@>;
+ goto found;
+ end;
+ p:=newnext(p);
+ end;
+found: id_lookup:=p;
+@z
+%---------------------------------------
+@x [18] m.260 l.5532 - Omega
+begin if text(p)>0 then
+ begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until text(hash_used)=0; {search for an empty location in |hash|}
+ next(p):=hash_used; p:=hash_used;
+ end;
+str_room(l); d:=cur_length;
+while pool_ptr>str_start[str_ptr] do
+ begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr];
+ end; {move current string up to make room for another}
+for k:=j to j+l-1 do append_char(buffer[k]);
+text(p):=make_string; pool_ptr:=pool_ptr+d;
+@y
+begin if newtext(p)>0 then
+ begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until newtext(hash_used)=0; {search for an empty location in |hash|}
+ setnext(p,hash_used); p:=hash_used;
+ end;
+str_room(l); d:=cur_length;
+while pool_ptr>str_start[str_ptr] do
+ begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr];
+ end; {move current string up to make room for another}
+for k:=j to j+l-1 do append_char(buffer[k]);
+newstring:=make_string;
+settext(p,newstring); pool_ptr:=pool_ptr+d;
+@z
+%---------------------------------------
+@x [18] m.262 l.5584 - Omega
+else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@.NONEXISTENT@>
+else begin print_esc(text(p));
+@y
+else if (newtext(p)<0)or(newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@.NONEXISTENT@>
+else begin print_esc(newtext(p));
+@z
+%---------------------------------------
+@x [18] m.263 l.5601 - Omega
+else print_esc(text(p));
+@y
+else print_esc(newtext(p));
+@z
+%---------------------------------------
+@x [18] m.264 l.5610 - Omega
+@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
+var k:pool_pointer; {index into |str_pool|}
+@!j:small_number; {index into |buffer|}
+@!l:small_number; {length of the string}
+begin if s<256 then cur_val:=s+single_base
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+ flush_string; text(cur_val):=s; {we don't want to have the string twice}
+ end;
+eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o;
+@y
+@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
+var k:pool_pointer; {index into |str_pool|}
+@!j:small_number; {index into |buffer|}
+@!l:small_number; {length of the string}
+begin if s<=biggest_char then cur_val:=s+single_base
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+ flush_string; settext(cur_val,s); {we don't want to have the string twice}
+ end;
+set_eq_level(cur_val,level_one); set_eq_type(cur_val,c);
+set_equiv(cur_val,o);
+@z
+%---------------------------------------
+@x [18] m.265 l.5648 - Omega
+primitive("delimiter",delim_num,0);@/
+@!@:delimiter_}{\.{\\delimiter} primitive@>
+@y
+primitive("delimiter",delim_num,0);@/
+@!@:delimiter_}{\.{\\delimiter} primitive@>
+primitive("odelimiter",delim_num,1);@/
+@!@:delimiter_}{\.{\\odelimiter} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5656 - Omega
+text(frozen_end_group):="endgroup"; eqtb[frozen_end_group]:=eqtb[cur_val];@/
+@y
+settext(frozen_end_group,"endgroup");
+set_new_eqtb(frozen_end_group,new_eqtb(cur_val));@/
+@z
+%---------------------------------------
+@x [18] m.265 l.5673 - Omega
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("mathchar",math_char_num,0);@/
+@!@:math_char_}{\.{\\mathchar} primitive@>
+@y
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("mathchar",math_char_num,0);@/
+@!@:math_char_}{\.{\\mathchar} primitive@>
+primitive("omathaccent",math_accent,1);@/
+@!@:math_accent_}{\.{\\omathaccent} primitive@>
+primitive("omathchar",math_char_num,1);@/
+@!@:math_char_}{\.{\\omathchar} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5697 - Omega
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+@y
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+primitive("oradical",radical,1);@/
+@!@:radical_}{\.{\\oradical} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5701 - Omega
+primitive("relax",relax,256); {cf.\ |scan_file_name|}
+@!@:relax_}{\.{\\relax} primitive@>
+text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/
+@y
+primitive("relax",relax,too_big_char); {cf.\ |scan_file_name|}
+@!@:relax_}{\.{\\relax} primitive@>
+settext(frozen_relax,"relax");
+set_new_eqtb(frozen_relax,new_eqtb(cur_val));@/
+@z
+%---------------------------------------
+@x [19] m.276 l.5951 - Omega
+else begin save_stack[save_ptr]:=eqtb[p]; incr(save_ptr);
+@y
+else begin save_stack[save_ptr]:=new_eqtb(p); incr(save_ptr);
+@z
+%---------------------------------------
+@x [19] m.277 l.5967 - Omega
+begin if eq_level(p)=cur_level then eq_destroy(eqtb[p])
+else if cur_level>level_one then eq_save(p,eq_level(p));
+eq_level(p):=cur_level; eq_type(p):=t; equiv(p):=e;
+@y
+begin if eq_level(p)=cur_level then eq_destroy(new_eqtb(p))
+else if cur_level>level_one then eq_save(p,eq_level(p));
+set_eq_level(p,cur_level); set_eq_type(p,t); set_equiv(p,e);
+@z
+%---------------------------------------
+@x [19] m.278 l.5980 - Omega
+@p procedure eq_word_define(@!p:pointer;@!w:integer);
+begin if xeq_level[p]<>cur_level then
+ begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level;
+ end;
+eqtb[p].int:=w;
+end;
+@y
+@p procedure eq_word_define(@!p:pointer;@!w:integer);
+begin if xeq_level(p)<>cur_level then
+ begin eq_save(p,xeq_level(p)); set_xeq_level(p,cur_level);
+ end;
+set_new_eqtb_int(p,w);
+end;
+
+procedure del_eq_word_define(@!p:pointer;@!w,wone:integer);
+begin if xeq_level(p)<>cur_level then
+ begin eq_save(p,xeq_level(p)); set_xeq_level(p,cur_level);
+ end;
+set_equiv(p,w); set_equiv1(p,wone);
+end;
+
+@z
+%---------------------------------------
+@x [19] m.279 l.5990 - Omega
+begin eq_destroy(eqtb[p]);
+eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
+end;
+@#
+procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
+begin eqtb[p].int:=w; xeq_level[p]:=level_one;
+end;
+@y
+begin eq_destroy(new_eqtb(p));
+set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e);
+end;
+@#
+procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
+begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one);
+end;
+
+procedure del_geq_word_define(@!p:pointer;@!w,wone:integer);
+ {global |del_eq_word_define|}
+begin set_equiv(p,w); set_equiv1(p,wone); set_xeq_level(p,level_one);
+end;
+@z
+%---------------------------------------
+@x [19] m.282 l.6036 - Omega
+ else save_stack[save_ptr]:=eqtb[undefined_control_sequence];
+@y
+ else save_stack[save_ptr]:=new_eqtb(undefined_control_sequence);
+@z
+%---------------------------------------
+@x [19] m.283 l.6056 - Omega
+ else begin eq_destroy(eqtb[p]); {destroy the current value}
+ eqtb[p]:=save_stack[save_ptr]; {restore the saved value}
+ @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+ end
+else if xeq_level[p]<>level_one then
+ begin eqtb[p]:=save_stack[save_ptr]; xeq_level[p]:=l;
+@y
+ else begin eq_destroy(new_eqtb(p)); {destroy the current value}
+ set_new_eqtb(p,save_stack[save_ptr]); {restore the saved value}
+ @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+ end
+else if xeq_level(p)<>level_one then
+ begin set_new_eqtb(p,save_stack[save_ptr]); set_xeq_level(p,l);
+@z
+%---------------------------------------
+@x [20] m.289 l.6129 - Omega
+number $2^8m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{12}-1$@>| is larger than
+@y
+number $2^16m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{20}-1$@>| is larger than
+@z
+%---------------------------------------
+@x [20] m.289 l.6142 - Omega
+@d cs_token_flag==@'7777 {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~256, less~1}
+@d left_brace_token=@'0400 {$2^8\cdot|left_brace|$}
+@d left_brace_limit=@'1000 {$2^8\cdot(|left_brace|+1)$}
+@d right_brace_token=@'1000 {$2^8\cdot|right_brace|$}
+@d right_brace_limit=@'1400 {$2^8\cdot(|right_brace|+1)$}
+@d math_shift_token=@'1400 {$2^8\cdot|math_shift|$}
+@d tab_token=@'2000 {$2^8\cdot|tab_mark|$}
+@d out_param_token=@'2400 {$2^8\cdot|out_param|$}
+@d space_token=@'5040 {$2^8\cdot|spacer|+|" "|$}
+@d letter_token=@'5400 {$2^8\cdot|letter|$}
+@d other_token=@'6000 {$2^8\cdot|other_char|$}
+@d match_token=@'6400 {$2^8\cdot|match|$}
+@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
+@y
+@d cs_token_flag=@"FFFFF {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~65536, less~1}
+@d max_char_val=@"10000 {to separate char and command code}
+@d left_brace_token=@"10000 {$2^16\cdot|left_brace|$}
+@d left_brace_limit=@"20000 {$2^16\cdot(|left_brace|+1)$}
+@d right_brace_token=@"20000 {$2^16\cdot|right_brace|$}
+@d right_brace_limit=@"30000 {$2^16\cdot(|right_brace|+1)$}
+@d math_shift_token=@"30000 {$2^16\cdot|math_shift|$}
+@d tab_token=@"40000 {$2^16\cdot|tab_mark|$}
+@d out_param_token=@"50000 {$2^16\cdot|out_param|$}
+@d space_token=@"A0020 {$2^16\cdot|spacer|+|" "|$}
+@d letter_token=@"B0000 {$2^16\cdot|letter|$}
+@d other_token=@"C0000 {$2^16\cdot|other_char|$}
+@d match_token=@"D0000 {$2^16\cdot|match|$}
+@d end_match_token=@"E0000 {$2^16\cdot|end_match|$}
+@z
+%---------------------------------------
+@x [20] m.293 l.6256 - Omega
+else begin m:=info(p) div @'400; c:=info(p) mod @'400;
+@y
+else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val;
+@z
+%---------------------------------------
+@x [21] m.298 l.6375 - Omega
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@y
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@z
+%---------------------------------------
+@x [24] m.334 l.7110 - Omega
+primitive("par",par_end,256); {cf. |scan_file_name|}
+@y
+primitive("par",par_end,too_big_char); {cf. |scan_file_name|}
+@z
+%---------------------------------------
+@x [24] m.357 l.7462 - Omega
+ else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400;
+@y
+ else begin cur_cmd:=t div max_char_val; cur_chr:=t mod max_char_val;
+@z
+%---------------------------------------
+@x [24] m.358 l.7479 - Omega
+@d no_expand_flag=257 {this characterizes a special variant of |relax|}
+@y
+@d no_expand_flag=special_char {this characterizes a special variant of |relax|}
+@z
+%---------------------------------------
+@x [24] m.365 l.7606 - Omega
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+@z
+%---------------------------------------
+@x [25] m.374 l.7728 - Omega
+ begin eq_define(cur_cs,relax,256); {N.B.: The |save_stack| might change}
+@y
+ begin eq_define(cur_cs,relax,too_big_char);
+ {N.B.: The |save_stack| might change}
+@z
+%---------------------------------------
+@x [25] m.374 l.7750 - Omega
+ buffer[j]:=info(p) mod @'400; incr(j); p:=link(p);
+@y
+ buffer[j]:=info(p) mod max_char_val; incr(j); p:=link(p);
+@z
+%---------------------------------------
+@x [25] m.380 l.7812 - Omega
+done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+done: if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+@z
+%---------------------------------------
+@x [25] m.381 l.7824 - Omega
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+@z
+%---------------------------------------
+@x [25] m.391 l.7985 - Omega
+if (info(r)>match_token+255)or(info(r)<match_token) then s:=null
+@y
+if (info(r)>=end_match_token)or(info(r)<match_token) then s:=null
+@z
+%---------------------------------------
+@x [26] m.407 l.8161 - Omega
+@ The |scan_left_brace| routine is called when a left brace is supposed to be
+the next non-blank token. (The term ``left brace'' means, more precisely,
+a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |left_brace|.
+
+@p procedure scan_left_brace; {reads a mandatory |left_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>left_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A left brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
+ cur_chr:="{"; incr(align_state);
+ end;
+end;
+@y
+@ The |scan_left_brace| routine is called when a left brace is supposed to be
+the next non-blank token. (The term ``left brace'' means, more precisely,
+a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |left_brace|.
+
+@p procedure scan_left_brace; {reads a mandatory |left_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>left_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A left brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
+ cur_chr:="{"; incr(align_state);
+ end;
+end;
+
+@ The |scan_right_brace| routine is called when a right brace is supposed to be
+the next non-blank token. (The term ``right brace'' means, more precisely,
+a character whose catcode is |right_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |right_brace|.
+
+@p procedure scan_right_brace; {reads a mandatory |right_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>right_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A right brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=right_brace_token+"}"; cur_cmd:=right_brace;
+ cur_chr:="}"; incr(align_state);
+ end;
+end;
+@z
+%---------------------------------------
+@x [26] m.410 l.8293 - Omega
+@!cur_val:integer; {value returned by numeric scanners}
+@y
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@z
+%---------------------------------------
+@x [26] m.413 l.8335 - Omega
+assign_int: scanned_result(eqtb[m].int)(int_val);
+assign_dimen: scanned_result(eqtb[m].sc)(dimen_val);
+@y
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_dimen: scanned_result(new_eqtb_sc(m))(dimen_val);
+@z
+%---------------------------------------
+@x [26] m.413 l.8345 - Omega
+char_given,math_given: scanned_result(cur_chr)(int_val);
+@y
+char_given,math_given,omath_given: scanned_result(cur_chr)(int_val);
+@z
+%---------------------------------------
+@x [26] m.414 l.8356 - Omega
+@ @<Fetch a character code from some table@>=
+begin scan_char_num;
+if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val)
+else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else scanned_result(eqtb[m+cur_val].int)(int_val);
+@y
+@ @<Fetch a character code from some table@>=
+begin scan_char_num;
+if m=math_code_base then begin
+ cur_val1:=ho(math_code(cur_val));
+ if ((cur_val1 div @"1000000)>8) or
+ (((cur_val1 mod @"1000000) div @"10000)>15) or
+ ((cur_val1 mod @"10000)>255) then
+ begin print_err("Extended mathchar used as mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and ""7FFF.")@/
+ ("I changed this one to zero."); int_error(cur_val1); cur_val1:=0;
+ end;
+ cur_val1:=((cur_val1 div @"1000000)*@"1000) +
+ (((cur_val1 mod @"1000000) div @"10000)*@"100) +
+ (cur_val1 mod @"10000);
+ scanned_result(cur_val1)(int_val)
+ end
+else if m=(math_code_base+256) then
+ scanned_result(ho(math_code(cur_val)))(int_val)
+else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else scanned_result(new_eqtb_int(m+cur_val))(int_val);
+@z
+%---------------------------------------
+@x [26] m.433 l.8593 - Omega
+procedure scan_eight_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2("A register number must be between 0 and 255.")@/
+@y
+procedure scan_eight_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_reg) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2("A register number must be between 0 and 65535.")@/
+@z
+%---------------------------------------
+@x [26] m.434 l.8604 - Omega
+procedure scan_char_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad character code");
+@.Bad character code@>
+ help2("A character number must be between 0 and 255.")@/
+@y
+procedure scan_char_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_char) then
+ begin print_err("Bad character code");
+@.Bad character code@>
+ help2("A character number must be between 0 and 65535.")@/
+@z
+%---------------------------------------
+@x [26] m.435 l.8618 - Omega
+procedure scan_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>15) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@y
+procedure scan_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>15) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_big_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 255,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@z
+%---------------------------------------
+@x [26] m.436 l.8629 - Omega
+procedure scan_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@y
+procedure scan_real_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+cur_val := ((cur_val div @"1000) * @"1000000) +
+ (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+end;
+
+procedure scan_big_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@"7FFFFFF) then
+ begin print_err("Bad extended mathchar");
+@.Bad mathchar@>
+ help2("An extended mathchar number must be between 0 and ""7FFFFFF.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@z
+%---------------------------------------
+@x [26] m.437 l.8640 - Omega
+procedure scan_twenty_seven_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@y
+procedure scan_twenty_seven_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+cur_val1 := (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+cur_val := cur_val div @"1000;
+cur_val := ((cur_val div @"1000) * @"1000000) +
+ (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+end;
+
+procedure scan_fifty_one_bit_int;
+var iiii:integer;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter (first part) must be between 0 and 2^{27}-1.")
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+iiii:=cur_val;
+scan_int;
+if (cur_val<0)or(cur_val>@"FFFFFF) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+help2("A numeric delimiter (second part) must be between 0 and 2^{24}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+cur_val1:=cur_val;
+cur_val:=iiii;
+end;
+
+procedure scan_string_argument;
+var s:integer;
+begin
+scan_left_brace;
+get_x_token;
+while (cur_cmd<>right_brace) do
+ begin
+ if (cur_cmd=letter) or (cur_cmd=other_char) then begin
+ str_room(1); append_char(cur_chr);
+ end
+ else if (cur_cmd=spacer) then begin
+ str_room(1); append_char(" ");
+ end
+ else begin
+ print("Bad token appearing in string argument");
+ end;
+ get_x_token;
+ end;
+s:=make_string;
+if str_eq_str("mi",s) then s:="mi";
+if str_eq_str("mo",s) then s:="mo";
+if str_eq_str("mn",s) then s:="mn";
+cur_val:=s;
+end;
+@z
+%---------------------------------------
+@x [26] m.442 l.8720 - Omega
+if cur_val>255 then
+ begin print_err("Improper alphabetic constant");
+@y
+if cur_val>biggest_char then
+ begin print_err("Improper alphabetic constant");
+@z
+%---------------------------------------
+@x [27] m.468 l.9200 - Omega
+@d job_name_code=5 {command code for \.{\\jobname}}
+@y
+@d omega_code=5 {command code for \.{\\OmegaVersion}}
+@d job_name_code=6 {command code for \.{\\jobname}}
+@z
+%---------------------------------------
+@x [27] m.468 l.9200 - Omega
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+@y
+primitive("OmegaVersion",convert,omega_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+@z
+%---------------------------------------
+@x [27] m.469 l.9223 - Omega
+ othercases print_esc("jobname")
+@y
+ omega_code: print_esc("OmegaVersion");
+ othercases print_esc("jobname")
+@z
+%---------------------------------------
+@x [27] m.471 l.9248 - Omega
+job_name_code: if job_name=0 then open_log_file;
+@y
+omega_code:;
+job_name_code: if job_name=0 then open_log_file;
+@z
+%---------------------------------------
+@x [27] m.472 l.9258 - Omega
+job_name_code: print(job_name);
+@y
+omega_code: print("1.15");
+job_name_code: print(job_name);
+@z
+%---------------------------------------
+@x [28] m.491 l.9610 - Omega
+text(frozen_fi):="fi"; eqtb[frozen_fi]:=eqtb[cur_val];
+@y
+settext(frozen_fi,"fi"); set_new_eqtb(frozen_fi,new_eqtb(cur_val));
+@z
+%---------------------------------------
+@x [28] m.506 l.9802 - Omega
+if (cur_cmd>active_char)or(cur_chr>255) then {not a character}
+ begin m:=relax; n:=256;
+@y
+if (cur_cmd>active_char)or(cur_chr>biggest_char) then {not a character}
+ begin m:=relax; n:=too_big_char;
+@z
+%---------------------------------------
+@x [28] m.506 l.9808 - Omega
+if (cur_cmd>active_char)or(cur_chr>255) then
+ begin cur_cmd:=relax; cur_chr:=256;
+@y
+if (cur_cmd>active_char)or(cur_chr>biggest_char) then
+ begin cur_cmd:=relax; cur_chr:=too_big_char;
+@z
+%---------------------------------------
+@x [29] m.526 l.10178 - Omega
+loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character}
+@y
+loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then
+ {not a character}
+@z
+%---------------------------------------
+@x [37] m.780 l.15354 - Omega
+@d span_code=256 {distinct from any character}
+@d cr_code=257 {distinct from |span_code| and from any character}
+@y
+@d span_code=special_char {distinct from any character}
+@d cr_code=span_code+1 {distinct from |span_code| and from any character}
+@z
+%---------------------------------------
+@x [37] m.780 l.15364 - Omega
+text(frozen_cr):="cr"; eqtb[frozen_cr]:=eqtb[cur_val];@/
+primitive("crcr",car_ret,cr_cr_code);
+@!@:cr_cr_}{\.{\\crcr} primitive@>
+text(frozen_end_template):="endtemplate"; text(frozen_endv):="endtemplate";
+eq_type(frozen_endv):=endv; equiv(frozen_endv):=null_list;
+eq_level(frozen_endv):=level_one;@/
+eqtb[frozen_end_template]:=eqtb[frozen_endv];
+eq_type(frozen_end_template):=end_template;
+@y
+settext(frozen_cr,"cr");
+set_new_eqtb(frozen_cr,new_eqtb(cur_val));@/
+primitive("crcr",car_ret,cr_cr_code);
+@!@:cr_cr_}{\.{\\crcr} primitive@>
+settext(frozen_end_template,"endtemplate"); settext(frozen_endv,"endtemplate");
+set_eq_type(frozen_endv,endv); set_equiv(frozen_endv,null_list);
+set_eq_level(frozen_endv,level_one);@/
+set_new_eqtb(frozen_end_template,new_eqtb(frozen_endv));
+set_eq_type(frozen_end_template,end_template);
+@z
+%---------------------------------------
+@x [37] m.798 l.15651 - Omega
+if n>max_quarterword then confusion("256 spans"); {this can happen, but won't}
+@^system dependencies@>
+@:this can't happen 256 spans}{\quad 256 spans@>
+@y
+if n>max_quarterword then confusion("too many spans");
+ {this can happen, but won't}
+@^system dependencies@>
+@:this can't happen too many spans}{\quad too many spans@>
+@z
+%---------------------------------------
+@x [37] m.804 l.15794 - Omega
+ overfull_rule:=0; {prevent rule from being packaged}
+ p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save;
+@y
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,0);
+ {prevent rule from being packaged}
+ p:=hpack(preamble,saved(1),saved(0));
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,rule_save);
+@z
+%---------------------------------------
+@x [37] m.827 l.16255 - Omega
+check_shrinkage(left_skip); check_shrinkage(right_skip);@/
+@y
+if (shrink_order(left_skip)<>normal)and(shrink(left_skip)<>0) then
+ begin set_equiv(glue_base+left_skip_code,finite_shrink(left_skip));
+ end;
+if (shrink_order(right_skip)<>normal)and(shrink(right_skip)<>0) then
+ begin set_equiv(glue_base+right_skip_code,finite_shrink(right_skip));
+ end;
+@z
+%---------------------------------------
+@x [40] m.891 l.17434 - Omega
+$c_1$ will be treated as nonletters. The |hyphen_char| for that font
+must be between 0 and 255, otherwise hyphenation will not be attempted.
+@y
+$c_1$ will be treated as nonletters. The |hyphen_char| for that font must
+be between 0 and |biggest_char|, otherwise hyphenation will not be attempted.
+@z
+%---------------------------------------
+@x [40] m.892 l.17469 - Omega
+@!hc:array[0..65] of 0..256; {word to be hyphenated}
+@!hn:small_number; {the number of positions occupied in |hc|}
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@!hf:internal_font_number; {font number of the letters in |hc|}
+@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase}
+@!hyf_char:integer; {hyphen character of the relevant font}
+@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest}
+@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
+@!hyf_bchar:halfword; {boundary character after $c_n$}
+@y
+@!hc:array[0..65] of 0..too_big_char; {word to be hyphenated}
+@!hn:small_number; {the number of positions occupied in |hc|}
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@!hf:internal_font_number; {font number of the letters in |hc|}
+@!hu:array[0..63] of 0..too_big_char;
+ {like |hc|, before conversion to lowercase}
+@!hyf_char:integer; {hyphen character of the relevant font}
+@!cur_lang,@!init_cur_lang:0..biggest_lang;
+ {current hyphenation table of interest}
+@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
+@!hyf_bchar:halfword; {boundary character after $c_n$}
+@!max_hyph_char:integer;
+
+@ @<Set initial values of key variables@>=
+max_hyph_char:=too_big_lang;
+
+@z
+%---------------------------------------
+@x [40] m.893 l.17483 - Omega
+@!c:0..255; {character being considered for hyphenation}
+@y
+@!c:ASCII_code; {character being considered for hyphenation}
+@z
+%---------------------------------------
+@x [40] m.896 l.17534 - Omega
+if hyf_char>255 then goto done1;
+@y
+if hyf_char>biggest_char then goto done1;
+@z
+%---------------------------------------
+@x [40] m.897 l.17546 - Omega
+ if lc_code(c)=0 then goto done3;
+@y
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+@z
+%---------------------------------------
+@x [40] m.898 l.17572 - Omega
+ if lc_code(c)=0 then goto done3;
+@y
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+@z
+%---------------------------------------
+@x [41] m.903 l.17648 - Omega
+ begin hu[0]:=256; init_lig:=false;
+@y
+ begin hu[0]:=max_hyph_char; init_lig:=false;
+@z
+%---------------------------------------
+@x [41] m.903 l.17660 - Omega
+found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null;
+@y
+found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null;
+@z
+%---------------------------------------
+@x [41] m.905 l.17707 - Omega
+getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=256$,
+we consider $x_j$ to be an implicit left boundary character; in this
+case |j| must be strictly less than~|n|. There is a
+parameter |bchar|, which is either 256 or an implicit right boundary character
+@y
+getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=|max_hyph_char|$,
+we consider $x_j$ to be an implicit left boundary character; in this
+case |j| must be strictly less than~|n|. There is a
+parameter |bchar|, which is either |max_hyph_char|
+or an implicit right boundary character
+@z
+%---------------------------------------
+@x [41] m.916 l.17980 - Omega
+ begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256;
+@y
+ begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char;
+@z
+%---------------------------------------
+@x [42] m.921 l.18079 - Omega
+@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language}
+@y
+@!op_start:array[0..biggest_lang] of 0..trie_op_size;
+ {offset for current language}
+@z
+%---------------------------------------
+@x [42] m.923 l.18086 - Omega
+hyphenation algorithm is quite short. In the following code we set |hc[hn+2]|
+to the impossible value 256, in order to guarantee that |hc[hn+3]| will
+@y
+hyphenation algorithm is quite short. In the following code we set |hc[hn+2]| to
+the impossible value |max_hyph_char|, in order to guarantee that |hc[hn+3]| will
+@z
+%---------------------------------------
+@x [42] m.923 l.18095 - Omega
+hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters}
+@y
+hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters}
+@z
+%---------------------------------------
+@x [42] m.934 l.18206 - Omega
+@d set_cur_lang==if language<=0 then cur_lang:=0
+ else if language>255 then cur_lang:=0
+@y
+@d set_cur_lang==if language<=0 then cur_lang:=0
+ else if language>biggest_lang then cur_lang:=0
+@z
+%---------------------------------------
+@x [43] m.943 l.18348 - Omega
+@!trie_used:array[ASCII_code] of quarterword;
+ {largest opcode used so far for this language}
+@!trie_op_lang:array[1..trie_op_size] of ASCII_code;
+@y
+@!trie_used:array[0..biggest_lang] of quarterword;
+ {largest opcode used so far for this language}
+@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang;
+@z
+%---------------------------------------
+@x [43] m.945 l.18400 - Omega
+for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
+@y
+for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
+@z
+%---------------------------------------
+@x [43] m.946 l.18416 - Omega
+for k:=0 to 255 do trie_used[k]:=min_quarterword;
+@y
+for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;
+@z
+%---------------------------------------
+@x [43] m.947 l.18438 - Omega
+@!init @!trie_c:packed array[trie_pointer] of packed_ASCII_code;
+@y
+@!init @!trie_c:packed array[trie_pointer] of ASCII_code;
+@z
+%---------------------------------------
+@x [43] m.952 l.18551 - Omega
+for p:=0 to 255 do trie_min[p]:=p+1;
+@y
+for p:=0 to biggest_char do trie_min[p]:=p+1;
+@z
+%---------------------------------------
+@x [43] m.953 l.18569 - Omega
+@!ll:1..256; {upper limit of |trie_min| updating}
+@y
+@!ll:1..too_big_char; {upper limit of |trie_min| updating}
+@z
+%---------------------------------------
+@x [43] m.953 l.18573 - Omega
+ @<Ensure that |trie_max>=h+256|@>;
+@y
+ @<Ensure that |trie_max>=h+max_hyph_char|@>;
+@z
+%---------------------------------------
+@x [43] m.954 l.18582 - Omega
+@ By making sure that |trie_max| is at least |h+256|, we can be sure that
+|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
+never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
+
+@<Ensure that |trie_max>=h+256|@>=
+if trie_max<h+256 then
+ begin if trie_size<=h+256 then overflow("pattern memory",trie_size);
+@y
+@ By making sure that |trie_max| is at least |h+max_hyph_char|,
+we can be sure that
+|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
+never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
+
+@<Ensure that |trie_max>=h+max_hyph_char|@>=
+if trie_max<h+max_hyph_char then
+ begin if trie_size<=h+max_hyph_char then overflow("pattern memory",trie_size);
+@z
+%---------------------------------------
+@x [43] m.954 l.18592 - Omega
+ until trie_max=h+256;
+@y
+ until trie_max=h+max_hyph_char;
+@z
+%---------------------------------------
+@x [43] m.956 l.18607 - Omega
+if l<256 then
+ begin if z<256 then ll:=z @+else ll:=256;
+@y
+if l<max_hyph_char then
+ begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char;
+@z
+%---------------------------------------
+@x [43] m.958 l.18637 - Omega
+if trie_root=0 then {no patterns were given}
+ begin for r:=0 to 256 do trie[r]:=h;
+ trie_max:=256;
+@y
+if trie_root=0 then {no patterns were given}
+ begin for r:=0 to max_hyph_char do trie[r]:=h;
+ trie_max:=max_hyph_char;
+@z
+%---------------------------------------
+@x [43] m.962 l.18714 - Omega
+@ @<Append a new letter or a hyphen level@>=
+if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
+ begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter}
+ else begin cur_chr:=lc_code(cur_chr);
+ if cur_chr=0 then
+ begin print_err("Nonletter");
+@.Nonletter@>
+ help1("(See Appendix H.)"); error;
+ end;
+ end;
+@y
+@ @<Append a new letter or a hyphen level@>=
+if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
+ begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter}
+ else begin cur_chr:=lc_code(cur_chr);
+ if cur_chr=0 then
+ begin print_err("Nonletter");
+@.Nonletter@>
+ help1("(See Appendix H.)"); error;
+ end;
+ end;
+ if cur_chr>max_hyph_char then max_hyph_char:=cur_chr;
+@z
+%---------------------------------------
+@x [43] m.966 l. - Omega
+procedure init_trie;
+var @!p:trie_pointer; {pointer for initialization}
+@!j,@!k,@!t:integer; {all-purpose registers for initialization}
+@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
+@!h:two_halves; {template used to zero out |trie|'s holes}
+begin @<Get ready to compress the trie@>;
+@y
+procedure init_trie;
+var @!p:trie_pointer; {pointer for initialization}
+@!j,@!k,@!t:integer; {all-purpose registers for initialization}
+@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
+@!h:two_halves; {template used to zero out |trie|'s holes}
+begin
+incr(max_hyph_char);
+@<Get ready to compress the trie@>;
+@z
+%---------------------------------------
+@x [44] m.977 l.19008 - Omega
+if q=null then box(n):=null {the |eq_level| of the box stays the same}
+else box(n):=vpack(q,natural);
+@y
+if q=null then set_equiv(box_base+n,null)
+ {the |eq_level| of the box stays the same}
+else set_equiv(box_base+n,vpack(q,natural));
+@z
+%---------------------------------------
+@x [45] m.992 l.24928 - Omega
+flush_node_list(box(n)); box(n):=null;
+@y
+flush_node_list(box(n)); set_equiv(box_base+n,null);
+@z
+%---------------------------------------
+@x [45] m.994 l.19364 - Omega
+@!n:min_quarterword..255; {insertion box number}
+@y
+@!n:min_quarterword..biggest_reg; {insertion box number}
+@z
+%---------------------------------------
+@x [45] m.1012 l.19655 - Omega
+@!n:min_quarterword..255; {insertion box number}
+@y
+@!n:min_quarterword..biggest_reg; {insertion box number}
+@z
+%---------------------------------------
+@x [45] m.1014 l.19710 - Omega
+split_top_skip:=save_split_top_skip;
+@y
+set_equiv(glue_base+split_top_skip_code,save_split_top_skip);
+@z
+%---------------------------------------
+@x [45] m.1017 l.19753 - Omega
+save_vbadness:=vbadness; vbadness:=inf_bad;
+save_vfuzz:=vfuzz; vfuzz:=max_dimen; {inhibit error messages}
+box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth);
+vbadness:=save_vbadness; vfuzz:=save_vfuzz;
+@y
+save_vbadness:=vbadness;
+set_new_eqtb_int(int_base+vbadness_code,inf_bad);
+save_vfuzz:=vfuzz;
+set_new_eqtb_sc(dimen_base+vfuzz_code,max_dimen);
+ {inhibit error messages}
+set_equiv(box_base+255,
+ vpackage(link(page_head),best_size,exactly,page_max_depth));
+set_new_eqtb_int(int_base+vbadness_code,save_vbadness);
+set_new_eqtb_sc(dimen_base+vfuzz_code,save_vfuzz);
+@z
+%---------------------------------------
+@x [45] m.1018 l.19774 - Omega
+ if box(n)=null then box(n):=new_null_box;
+@y
+ if box(n)=null then set_equiv(box_base+n,new_null_box);
+@z
+%---------------------------------------
+@x [45] m.1021 l.19817 - Omega
+ split_top_skip:=split_top_ptr(p);
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+ if ins_ptr(p)<>null then
+ begin temp_ptr:=vpack(ins_ptr(p),natural);
+ height(p):=height(temp_ptr)+depth(temp_ptr);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+box(n):=vpack(temp_ptr,natural);
+@y
+ set_equiv(glue_base+split_top_skip_code,split_top_ptr(p));
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+ if ins_ptr(p)<>null then
+ begin temp_ptr:=vpack(ins_ptr(p),natural);
+ height(p):=height(temp_ptr)+depth(temp_ptr);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+set_equiv(box_base+n,vpack(temp_ptr,natural));
+@z
+%---------------------------------------
+@x [45] m.1023 l.19854 - Omega
+ship_out(box(255)); box(255):=null;
+@y
+ship_out(box(255)); set_equiv(box_base+255,null);
+@z
+%---------------------------------------
+@x [46] m.1046 l.20339 - Omega
+non_math(math_given), non_math(math_comp), non_math(delim_num),
+@y
+non_math(math_given), non_math(omath_given),
+non_math(math_comp), non_math(delim_num),
+@z
+%---------------------------------------
+@x [47] m.1071 l.20718 - Omega
+|box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}';
+codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox255}';
+code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513|
+through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}',
+@y
+|box_flag+biggest_reg| represent `\.{\\setbox0}' through
+`\.{\\setbox}|biggest_reg|'; codes |box_flag+biggest_reg+1| through
+|box_flag+2*biggest_reg| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox}|biggest_reg|'; code |box_flag+2*number_regs|
+represents `\.{\\shipout}'; and codes |box_flag+2*number_regs+1|
+through |box_flag+2*number_regs+3| represent `\.{\\leaders}', `\.{\\cleaders}',
+@z
+%---------------------------------------
+@x [47] m.1071 l.20732 - Omega
+@d ship_out_flag==box_flag+512 {context code for `\.{\\shipout}'}
+@d leader_flag==box_flag+513 {context code for `\.{\\leaders}'}
+@y
+@d ship_out_flag==box_flag+(number_regs+number_regs)
+ {context code for `\.{\\shipout}'}
+@d leader_flag==ship_out_flag+1 {context code for `\.{\\leaders}'}
+@z
+%---------------------------------------
+@x [47] m.1077 l.20853 - Omega
+if box_context<box_flag+256 then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-256+box_context,box_ref,cur_box)
+@y
+if box_context<box_flag+number_regs then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box)
+@z
+%---------------------------------------
+@x [47] m.1079 l.20888 - Omega
+ box(cur_val):=null; {the box becomes void, at the same level}
+@y
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+@z
+%---------------------------------------
+@x [47] m.1100 l.21156 - Omega
+ if saved(0)<255 then
+@y
+ if saved(0)<>255 then
+@z
+%---------------------------------------
+@x [47] m.1109 l.21265 - Omega
+@ The |un_hbox| and |un_vbox| commands unwrap one of the 256 current boxes.
+@y
+@ The |un_hbox| and |un_vbox| commands unwrap one of the current boxes.
+@z
+%---------------------------------------
+@x [47] m.1110 l.21287 - Omega
+else begin link(tail):=list_ptr(p); box(cur_val):=null;
+@y
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@z
+%---------------------------------------
+@x [47] m.1117 l.21342 - Omega
+ if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c);
+@y
+ if c>=0 then if c<=biggest_char then
+ pre_break(tail):=new_character(cur_font,c);
+@z
+%---------------------------------------
+@x [48] m.1151 l.21810 - Omega
+@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are
+broken down into subfields called |math_type| and either |info| or
+|(fam,character)|. The job of |scan_math| is to figure out what to place
+in one of these principal fields; it looks at the subformula that
+comes next in the input, and places an encoding of that subformula
+into a given word of |mem|.
+
+@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
+
+@<Declare act...@>=
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:case cur_cmd of
+letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
+ end;
+math_given: c:=cur_chr;
+delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod 256);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div 256) mod 16;
+exit:end;
+@y
+@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are
+broken down into subfields called |math_type| and either |info| or
+|(fam,character)|. The job of |scan_math| is to figure out what to place
+in one of these principal fields; it looks at the subformula that
+comes next in the input, and places an encoding of that subformula
+into a given word of |mem|.
+
+@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
+
+@<Declare act...@>=
+@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
+
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:
+case cur_cmd of
+letter,other_char,char_given: begin
+ c:=ho(math_code(cur_chr));
+ if c=@"8000000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin
+ if cur_chr=0 then scan_fifteen_bit_int
+ else scan_big_fifteen_bit_int;
+ c:=cur_val;
+ end;
+math_given: begin
+ c := ((cur_chr div @"1000) * @"1000000) +
+ (((cur_chr mod @"1000) div @"100) * @"10000) +
+ (cur_chr mod @"100);
+ end;
+omath_given: begin c:=cur_chr;
+ end;
+delim_num: begin
+ if cur_chr=0 then scan_twenty_seven_bit_int
+ else scan_fifty_one_bit_int;
+ c:=cur_val;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod @"10000);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div @"10000) mod @"100;
+exit:end;
+@z
+%---------------------------------------
+@x [48] m.1154 l.21860 - Omega
+mmode+letter,mmode+other_char,mmode+char_given:
+ set_math_char(ho(math_code(cur_chr)));
+mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
+ set_math_char(ho(math_code(cur_chr)));
+ end;
+mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val);
+ end;
+mmode+math_given: set_math_char(cur_chr);
+mmode+delim_num: begin scan_twenty_seven_bit_int;
+ set_math_char(cur_val div @'10000);
+@y
+mmode+letter,mmode+other_char,mmode+char_given:
+ set_math_char(ho(math_code(cur_chr)));
+mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
+ set_math_char(ho(math_code(cur_chr)));
+ end;
+mmode+math_char_num: begin
+ if cur_chr=0 then scan_fifteen_bit_int
+ else scan_big_fifteen_bit_int;
+ set_math_char(cur_val);
+ end;
+mmode+math_given: begin
+ set_math_char(((cur_chr div @"1000) * @"1000000) +
+ (((cur_chr mod @"1000) div @"100) * @"10000) +
+ (cur_chr mod @"100));
+ end;
+mmode+omath_given: begin
+ set_math_char(cur_chr);
+ end;
+mmode+delim_num: begin
+ if cur_chr=0 then scan_twenty_seven_bit_int
+ else scan_fifty_one_bit_int;
+ set_math_char(cur_val);
+@z
+%---------------------------------------
+@x [48] m.1155 l.21878 - Omega
+procedure set_math_char(@!c:integer);
+var p:pointer; {the new noad}
+begin if c>=@'100000 then
+ @<Treat |cur_chr|...@>
+else begin p:=new_noad; math_type(nucleus(p)):=math_char;
+ character(nucleus(p)):=qi(c mod 256);
+ fam(nucleus(p)):=(c div 256) mod 16;
+ if c>=var_code then
+ begin if fam_in_range then fam(nucleus(p)):=cur_fam;
+ type(p):=ord_noad;
+ end
+ else type(p):=ord_noad+(c div @'10000);
+ link(tail):=p; tail:=p;
+ end;
+end;
+@y
+procedure set_math_char(@!c:integer);
+var p,q,r:pointer; {the new noad}
+begin if c>=@"8000000 then
+ @<Treat |cur_chr|...@>
+else begin p:=new_noad; math_type(nucleus(p)):=math_char;
+ character(nucleus(p)):=qi(c mod @"10000);
+ fam(nucleus(p)):=(c div @"10000) mod @"100;
+ if c>=var_code then
+ begin if fam_in_range then fam(nucleus(p)):=cur_fam;
+ type(p):=ord_noad;
+ end
+ else type(p):=ord_noad+(c div @"1000000);
+ link(tail):=p; tail:=p;
+ end;
+end;
+@z
+%---------------------------------------
+@x [48] m.1160 l.21966 - Omega
+procedure scan_delimiter(@!p:pointer;@!r:boolean);
+begin if r then scan_twenty_seven_bit_int
+else begin @<Get the next non-blank non-relax...@>;
+ case cur_cmd of
+ letter,other_char: cur_val:=del_code(cur_chr);
+ delim_num: scan_twenty_seven_bit_int;
+ othercases cur_val:=-1
+ endcases;
+ end;
+if cur_val<0 then @<Report that an invalid delimiter code is being changed
+ to null; set~|cur_val:=0|@>;
+small_fam(p):=(cur_val div @'4000000) mod 16;
+small_char(p):=qi((cur_val div @'10000) mod 256);
+large_fam(p):=(cur_val div 256) mod 16;
+large_char(p):=qi(cur_val mod 256);
+@y
+procedure scan_delimiter(@!p:pointer;@!r:integer);
+begin if r=1 then scan_twenty_seven_bit_int
+else if r=2 then scan_fifty_one_bit_int
+else begin @<Get the next non-blank non-relax...@>;
+ case cur_cmd of
+ letter,other_char: begin
+ cur_val:=del_code0(cur_chr); cur_val1:=del_code1(cur_chr);
+ end;
+ delim_num: if cur_chr=0 then scan_twenty_seven_bit_int
+ else scan_fifty_one_bit_int;
+ othercases begin cur_val:=-1; cur_val1:=-1; end;
+ endcases;
+ end;
+if cur_val<0 then begin @<Report that an invalid delimiter code is being changed
+ to null; set~|cur_val:=0|@>;
+ cur_val1:=0;
+ end;
+small_fam(p):=(cur_val div @"10000) mod @"100;
+small_char(p):=qi(cur_val mod @"10000);
+large_fam(p):=(cur_val1 div @"10000) mod @"100;
+large_char(p):=qi(cur_val1 mod @"10000);
+@z
+%---------------------------------------
+@x [48] m.1163 l.22005 - Omega
+scan_delimiter(left_delimiter(tail),true); scan_math(nucleus(tail));
+@y
+scan_delimiter(left_delimiter(tail),cur_chr+1); scan_math(nucleus(tail));
+@z
+%---------------------------------------
+@x [48] m.1165 l.22012 - Omega
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+math_type(accent_chr(tail)):=math_char;
+scan_fifteen_bit_int;
+character(accent_chr(tail)):=qi(cur_val mod 256);
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
+scan_math(nucleus(tail));
+end;
+@y
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+math_type(accent_chr(tail)):=math_char;
+if cur_chr=0 then scan_fifteen_bit_int
+else scan_big_fifteen_bit_int;
+character(accent_chr(tail)):=qi(cur_val mod @"10000);
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div @"10000) mod @"100;
+scan_math(nucleus(tail));
+end;
+@z
+%---------------------------------------
+@x [48] m.1174 l.22085 - Omega
+@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
+@y
+@z
+%---------------------------------------
+@x [48] m.1188 l.22284 - Omega
+text(frozen_right):="right"; eqtb[frozen_right]:=eqtb[cur_val];
+@y
+settext(frozen_right,"right");
+set_new_eqtb(frozen_right,new_eqtb(cur_val));
+@z
+%---------------------------------------
+@x [49] m.1214 l.22700 - Omega
+@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
+@y
+@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
+@d del_word_define(#)==if global
+ then del_geq_word_define(#)@+else del_eq_word_define(#)
+@z
+%---------------------------------------
+@x [49] m.1216 l.22734 - Omega
+text(frozen_protection):="inaccessible";
+@y
+settext(frozen_protection,"inaccessible");
+@z
+%---------------------------------------
+@x [49] m.1222 l.22789 - Omega
+@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
+@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
+@d count_def_code=2 {|shorthand_def| for \.{\\countdef}}
+@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
+@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
+@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
+@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+
+@<Put each...@>=
+primitive("chardef",shorthand_def,char_def_code);@/
+@!@:char_def_}{\.{\\chardef} primitive@>
+primitive("mathchardef",shorthand_def,math_char_def_code);@/
+@!@:math_char_def_}{\.{\\mathchardef} primitive@>
+@y
+@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
+@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
+@d omath_char_def_code=2 {|shorthand_def| for \.{\\omathchardef}}
+@d count_def_code=3 {|shorthand_def| for \.{\\countdef}}
+@d dimen_def_code=4 {|shorthand_def| for \.{\\dimendef}}
+@d skip_def_code=5 {|shorthand_def| for \.{\\skipdef}}
+@d mu_skip_def_code=6 {|shorthand_def| for \.{\\muskipdef}}
+@d toks_def_code=7 {|shorthand_def| for \.{\\toksdef}}
+
+@<Put each...@>=
+primitive("chardef",shorthand_def,char_def_code);@/
+@!@:char_def_}{\.{\\chardef} primitive@>
+primitive("mathchardef",shorthand_def,math_char_def_code);@/
+@!@:math_char_def_}{\.{\\mathchardef} primitive@>
+primitive("omathchardef",shorthand_def,omath_char_def_code);@/
+@!@:math_char_def_}{\.{\\omathchardef} primitive@>
+@z
+%---------------------------------------
+@x [49] m.1224 l.22833 - Omega
+shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
+ scan_optional_equals;
+ case n of
+ char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
+ end;
+@y
+shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs;
+ define(p,relax,too_big_char); scan_optional_equals;
+ case n of
+ char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_real_fifteen_bit_int;
+ define(p,math_given,cur_val);
+ end;
+ omath_char_def_code: begin scan_big_fifteen_bit_int;
+ define(p,omath_given,cur_val);
+ end;
+@z
+%---------------------------------------
+@x [49] m.1230 l. - Omega
+primitive("mathcode",def_code,math_code_base);
+@!@:math_code_}{\.{\\mathcode} primitive@>
+primitive("lccode",def_code,lc_code_base);
+@!@:lc_code_}{\.{\\lccode} primitive@>
+primitive("uccode",def_code,uc_code_base);
+@!@:uc_code_}{\.{\\uccode} primitive@>
+primitive("sfcode",def_code,sf_code_base);
+@!@:sf_code_}{\.{\\sfcode} primitive@>
+primitive("delcode",def_code,del_code_base);
+@!@:del_code_}{\.{\\delcode} primitive@>
+@y
+primitive("mathcode",def_code,math_code_base);
+@!@:math_code_}{\.{\\mathcode} primitive@>
+primitive("omathcode",def_code,math_code_base+256);
+@!@:math_code_}{\.{\\omathcode} primitive@>
+primitive("lccode",def_code,lc_code_base);
+@!@:lc_code_}{\.{\\lccode} primitive@>
+primitive("uccode",def_code,uc_code_base);
+@!@:uc_code_}{\.{\\uccode} primitive@>
+primitive("sfcode",def_code,sf_code_base);
+@!@:sf_code_}{\.{\\sfcode} primitive@>
+primitive("delcode",def_code,del_code_base);
+@!@:del_code_}{\.{\\delcode} primitive@>
+primitive("odelcode",def_code,del_code_base+256);
+@!@:del_code_}{\.{\\odelcode} primitive@>
+@z
+%---------------------------------------
+@x [49] m.1232 l.22990 - Omega
+def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
+ p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+ if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
+ begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+ if p<del_code_base then print("), should be in the range 0..")
+ else print("), should be at most ");
+ print_int(n);
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val:=0;
+ end;
+ if p<math_code_base then define(p,data,cur_val)
+ else if p<del_code_base then define(p,data,hi(cur_val))
+ else word_define(p,cur_val);
+@y
+def_code: begin
+ if cur_chr=(del_code_base+256) then begin
+ p:=cur_chr-256; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int; cur_val1:=cur_val; scan_int; {backwards}
+ if (cur_val1>@"FFFFFF) or (cur_val>@"FFFFFF) then
+ begin print_err("Invalid code ("); print_int(cur_val1); print(" ");
+ print_int(cur_val);
+ print("), should be at most ""FFFFFF ""FFFFFF");
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val1:=0; cur_val:=0;
+ end;
+ del_word_define(p,cur_val1,cur_val);
+ end
+ else begin
+ @<Let |n| be the largest legal code value, based on |cur_chr|@>;
+ p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+ if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
+ begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+ if p<del_code_base then print("), should be in the range 0..")
+ else print("), should be at most ");
+ print_int(n);
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val:=0;
+ end;
+ if p<math_code_base then define(p,data,cur_val)
+ else if p<(math_code_base+256) then begin
+ if cur_val=@"8000 then cur_val:=@"8000000
+ else cur_val:=((cur_val div @"1000) * @"1000000) +
+ (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+ define(p,data,hi(cur_val));
+ end
+ else if p<del_code_base then define(p-256,data,hi(cur_val))
+ else begin
+ cur_val1:=cur_val div @"1000;
+ cur_val1:=(cur_val1 div @"100)*@"10000 + (cur_val1 mod @"100);
+ cur_val:=cur_val mod @"1000;
+ cur_val:=(cur_val div @"100)*@"10000 + (cur_val mod @"100);
+ del_word_define(p,cur_val1,cur_val);
+ end;
+ end;
+@z
+%---------------------------------------
+@x [49] m.1233 l.22990 - Omega
+if cur_chr=cat_code_base then n:=max_char_code
+else if cur_chr=math_code_base then n:=@'100000
+else if cur_chr=sf_code_base then n:=@'77777
+else if cur_chr=del_code_base then n:=@'77777777
+else n:=255
+@y
+if cur_chr=cat_code_base then n:=max_char_code
+else if cur_chr=math_code_base then n:=@'100000
+else if cur_chr=(math_code_base+256) then n:=@"8000000
+else if cur_chr=sf_code_base then n:=@'77777
+else if cur_chr=del_code_base then n:=@'77777777
+else n:=biggest_char
+@z
+%---------------------------------------
+@x [49] m.1234 l.22990 - Omega
+def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val;
+@y
+def_family: begin p:=cur_chr; scan_big_four_bit_int; p:=p+cur_val;
+@z
+%---------------------------------------
+@x [49] m.1238 l.23059 - Omega
+ if q=advance then cur_val:=cur_val+eqtb[l].int;
+@y
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@z
+%---------------------------------------
+@x [49] m.1240 l.23086 - Omega
+ if p=int_val then cur_val:=mult_integers(eqtb[l].int,cur_val)
+ else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0)
+ else cur_val:=x_over_n(eqtb[l].int,cur_val)
+@y
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+@z
+%---------------------------------------
+@x [49] m.1241 l.23109 - Omega
+ if global then n:=256+cur_val@+else n:=cur_val;
+@y
+ if global then n:=number_regs+cur_val@+else n:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1289 l.23546 - Omega
+|cs_token_flag+active_base| is a multiple of~256.
+@y
+|cs_token_flag+active_base| is a multiple of~|max_char_val|.
+@z
+%---------------------------------------
+@x [49] m.1289 l.23552 - Omega
+ begin c:=t mod 256;
+@y
+ begin c:=t mod max_char_val;
+@z
+%---------------------------------------
+@x [50] m.1313 l.23892 - Omega
+@<Dump regions 1 to 4 of |eqtb|@>;
+@<Dump regions 5 and 6 of |eqtb|@>;
+@y
+dump_eqtb_table;
+@z
+%---------------------------------------
+@x [50] m.1314 l.23904 - Omega
+@<Undump regions 1 to 6 of |eqtb|@>;
+@y
+undump_eqtb_table;
+@z
+%---------------------------------------
+@x [50] m.1315 l.23904 - Omega
+@ The table of equivalents usually contains repeated information, so we dump it
+in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the
+format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra
+copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$.
+
+@<Dump regions 1 to 4 of |eqtb|@>=
+k:=active_base;
+repeat j:=k;
+while j<int_base-1 do
+ begin if (equiv(j)=equiv(j+1))and(eq_type(j)=eq_type(j+1))and@|
+ (eq_level(j)=eq_level(j+1)) then goto found1;
+ incr(j);
+ end;
+l:=int_base; goto done1; {|j=int_base-1|}
+found1: incr(j); l:=j;
+while j<int_base-1 do
+ begin if (equiv(j)<>equiv(j+1))or(eq_type(j)<>eq_type(j+1))or@|
+ (eq_level(j)<>eq_level(j+1)) then goto done1;
+ incr(j);
+ end;
+done1:dump_int(l-k);
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+k:=j+1; dump_int(k-l);
+until k=int_base
+
+@ @<Dump regions 5 and 6 of |eqtb|@>=
+repeat j:=k;
+while j<eqtb_size do
+ begin if eqtb[j].int=eqtb[j+1].int then goto found2;
+ incr(j);
+ end;
+l:=eqtb_size+1; goto done2; {|j=eqtb_size|}
+found2: incr(j); l:=j;
+while j<eqtb_size do
+ begin if eqtb[j].int<>eqtb[j+1].int then goto done2;
+ incr(j);
+ end;
+done2:dump_int(l-k);
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+k:=j+1; dump_int(k-l);
+until k>eqtb_size
+
+@ @<Undump regions 1 to 6 of |eqtb|@>=
+k:=active_base;
+repeat undump_int(x);
+if (x<1)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do undump_wd(eqtb[j]);
+k:=k+x;
+undump_int(x);
+if (x<0)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do eqtb[j]:=eqtb[k-1];
+k:=k+x;
+until k>eqtb_size
+@y
+
+@z
+%---------------------------------------
+@x [50] m.1318 l.23967 - Omega
+@<Dump the hash table@>=
+dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used;
+for p:=hash_base to hash_used do if text(p)<>0 then
+ begin dump_int(p); dump_hh(hash[p]); incr(cs_count);
+ end;
+for p:=hash_used+1 to undefined_control_sequence-1 do dump_hh(hash[p]);
+dump_int(cs_count);@/
+print_ln; print_int(cs_count); print(" multiletter control sequences")
+@y
+@<Dump the hash table@>=
+dump_int(hash_used);
+@z
+%---------------------------------------
+@x [50] m.1319 l.23976 - Omega
+undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1;
+repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]);
+until p=hash_used;
+for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]);
+undump_int(cs_count)
+@y
+undump(hash_base)(frozen_control_sequence)(hash_used);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24066 - Omega
+for k:=0 to trie_max do dump_hh(trie[k]);
+@y
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(max_hyph_char);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24078 - Omega
+for k:=255 downto 0 do if trie_used[k]>min_quarterword then
+@y
+for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then
+@z
+%---------------------------------------
+@x [50] m.1325 l.24094 - Omega
+for k:=0 to j do undump_hh(trie[k]);
+@y
+for k:=0 to j do undump_hh(trie[k]);
+undump_int(max_hyph_char);
+@z
+%---------------------------------------
+@x [50] m.1325 l.24101 - Omega
+init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/
+k:=256;
+@y
+init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/
+k:=biggest_lang+1;
+@z
+%---------------------------------------
+@x [50] m.1326 l.24100 - Omega
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+tracing_stats:=0
+@y
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+set_new_eqtb_int(int_base+tracing_stats_code,0)
+@z
+%---------------------------------------
+@x [53] m.1341 l.24506 - Omega
+@d what_lang(#)==link(#+1) {language number, in the range |0..255|}
+@y
+@d what_lang(#)==link(#+1) {language number, in the range |0..biggest_lang|}
+@z
+%---------------------------------------
+@x [53] m.1370
+@!write_file:array[0..15] of alpha_file;
+@y
+@!outside_string_array: array[0..1000] of 0..255;
+@!write_file:array[0..15] of alpha_file;
+@z
+%---------------------------------------
+@x [53] m. l.24761 - Omega
+text(end_write):="endwrite"; eq_level(end_write):=level_one;
+eq_type(end_write):=outer_call; equiv(end_write):=null;
+@y
+settext(end_write,"endwrite"); set_eq_level(end_write,level_one);
+set_eq_type(end_write,outer_call); set_equiv(end_write,null);
+@z
+%---------------------------------------
+@x [53] m.1376 l.24878 - Omega
+else if language>255 then l:=0
+@y
+else if language>biggest_lang then l:=0
+@z
+%---------------------------------------
+@x [53] m.1377 l.24893 - Omega
+ else if cur_val>255 then clang:=0
+@y
+ else if cur_val>biggest_lang then clang:=0
+@z
+%---------------------------------------
+@x [54]
+This section should be replaced, if necessary, by any special
+modifications of the program
+that are necessary to make \TeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@y
+@* \[54] $\Omega$ changes.
+
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir-1.15/omchar.ch b/Build/source/texk/web2c/omegadir-1.15/omchar.ch
new file mode 100644
index 00000000000..9c18ce96750
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omchar.ch
@@ -0,0 +1,84 @@
+% omchar.ch: Primitives to access the components of font metric files.
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [26] m.416 l.8407 - Omega char dimensions
+primitive("dp",set_box_dimen,depth_offset);
+@!@:dp_}{\.{\\dp} primitive@>
+@y
+primitive("dp",set_box_dimen,depth_offset);
+@!@:dp_}{\.{\\dp} primitive@>
+primitive("charwd",set_box_dimen,(width_offset+3));
+@!@:charwd_}{\.{\\charwd} primitive@>
+primitive("charht",set_box_dimen,(height_offset+3));
+@!@:charht_}{\.{\\charht} primitive@>
+primitive("chardp",set_box_dimen,(depth_offset+3));
+@!@:chardp_}{\.{\\chardp} primitive@>
+primitive("charit",set_box_dimen,(depth_offset+4));
+@!@:charit_}{\.{\\charit} primitive@>
+@z
+%---------------------------------------
+@x [26] m.416 l.8425 - Omega char dimensions
+set_box_dimen: if chr_code=width_offset then print_esc("wd")
+else if chr_code=height_offset then print_esc("ht")
+else print_esc("dp");
+@y
+set_box_dimen: if chr_code=width_offset then print_esc("wd")
+else if chr_code=height_offset then print_esc("ht")
+else if chr_code=depth_offset then print_esc("dp")
+else if chr_code=(width_offset+3) then print_esc("charwd")
+else if chr_code=(height_offset+3) then print_esc("charht")
+else if chr_code=(depth_offset+3) then print_esc("chardp")
+else print_esc("charit");
+@z
+%---------------------------------------
+@x [26] m.419 l.8461 - Omega char dimensions
+begin scan_eight_bit_int;
+if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc;
+cur_val_level:=dimen_val;
+end
+@y
+if m<=3 then
+begin
+ scan_eight_bit_int;
+ if box(cur_val)=null then cur_val:=0 @+else
+ cur_val:=mem[box(cur_val)+m].sc;
+ cur_val_level:=dimen_val;
+end
+else
+begin
+ scan_char_num;
+ if m=(width_offset+3) then begin
+ cur_val:= char_width(main_f)(char_info(main_f)(cur_val))
+ end
+ else if m=(height_offset+3) then begin
+ cur_val:= char_height(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else if m=(depth_offset+3) then begin
+ cur_val:= char_depth(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else begin
+ cur_val:= char_italic(main_f)(char_info(main_f)(cur_val));
+ end;
+ cur_val_level:=dimen_val;
+end
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir-1.15/omdir.ch b/Build/source/texk/web2c/omegadir-1.15/omdir.ch
new file mode 100644
index 00000000000..4aa0a164ab2
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omdir.ch
@@ -0,0 +1,3050 @@
+% omdir.ch: Primitives to deal with multiple-direction text
+%
+% This file is part of the Omega projet, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%-------------------------
+@x [10] m.135
+@d hlist_node=0 {|type| of hlist nodes}
+@d box_node_size=7 {number of words to allocate for a box node}
+@d width_offset=1 {position of |width| field in a box node}
+@d depth_offset=2 {position of |depth| field in a box node}
+@d height_offset=3 {position of |height| field in a box node}
+@d width(#) == mem[#+width_offset].sc {width of the box, in sp}
+@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp}
+@d height(#) == mem[#+height_offset].sc {height of the box, in sp}
+@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp}
+@d list_offset=5 {position of |list_ptr| field in a box node}
+@d list_ptr(#) == link(#+list_offset) {beginning of the list inside the box}
+@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
+@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
+@d normal=0 {the most common case when several cases are named}
+@d stretching = 1 {glue setting applies to the stretch components}
+@d shrinking = 2 {glue setting applies to the shrink components}
+@d glue_offset = 6 {position of |glue_set| in a box node}
+@d glue_set(#) == mem[#+glue_offset].gr
+ {a word of type |glue_ratio| for glue setting}
+@y
+@d hlist_node=0 {|type| of hlist nodes}
+@d box_node_size=8 {number of words to allocate for a box node}
+@d width_offset=1 {position of |width| field in a box node}
+@d depth_offset=2 {position of |depth| field in a box node}
+@d height_offset=3 {position of |height| field in a box node}
+@d width(#) == mem[#+width_offset].sc {width of the box, in sp}
+@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp}
+@d height(#) == mem[#+height_offset].sc {height of the box, in sp}
+@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp}
+@d list_offset=5 {position of |list_ptr| field in a box node}
+@d list_ptr(#) == link(#+list_offset) {beginning of the list inside the box}
+@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
+@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
+@d normal=0 {the most common case when several cases are named}
+@d stretching = 1 {glue setting applies to the stretch components}
+@d shrinking = 2 {glue setting applies to the shrink components}
+@d glue_offset = 6 {position of |glue_set| in a box node}
+@d glue_set(#) == mem[#+glue_offset].gr
+ {a word of type |glue_ratio| for glue setting}
+@d dir_offset = 7 {position of |box_dir| in a box node}
+@d box_dir(#) == mem[#+dir_offset].int
+@z
+%-------------------------
+@x [10] m.136
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+new_null_box:=p;
+@y
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+box_dir(p):=text_direction;
+new_null_box:=p;
+@z
+%-------------------------
+@x [10] m.138
+@d rule_node=2 {|type| of rule nodes}
+@d rule_node_size=4 {number of words to allocate for a rule node}
+@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
+@d is_running(#) == (#=null_flag) {tests for a running dimension}
+@y
+@d rule_node=2 {|type| of rule nodes}
+@d rule_node_size=5 {number of words to allocate for a rule node}
+@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
+@d is_running(#) == (#=null_flag) {tests for a running dimension}
+@d rule_dir(#)==info(#+4)
+@z
+%-------------------------
+@x [10] m.139
+@p function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+new_rule:=p;
+end;
+@y
+@p function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+rule_dir(p):=-1;
+new_rule:=p;
+end;
+@z
+%-------------------------
+@x [10] m.176
+procedure print_rule_dimen(@!d:scaled); {prints dimension in rule node}
+begin if is_running(d) then print_char("*") else print_scaled(d);
+@.*\relax@>
+end;
+@y
+procedure print_rule_dimen(@!d:scaled); {prints dimension in rule node}
+begin if is_running(d) then print_char("*") else print_scaled(d);
+@.*\relax@>
+end;
+@#
+procedure print_dir(d:integer);
+begin
+print(dir_names[dir_primary[d]]);
+print(dir_names[dir_secondary[d]]);
+print(dir_names[dir_tertiary[d]]);
+end;
+@z
+%-------------------------
+@x [12] m.184
+@ @<Display box |p|@>=
+begin if type(p)=hlist_node then print_esc("h")
+else if type(p)=vlist_node then print_esc("v")
+else print_esc("unset");
+print("box("); print_scaled(height(p)); print_char("+");
+print_scaled(depth(p)); print(")x"); print_scaled(width(p));
+if type(p)=unset_node then
+ @<Display special fields of the unset node |p|@>
+else begin @<Display the value of |glue_set(p)|@>;
+ if shift_amount(p)<>0 then
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+ end;
+node_list_display(list_ptr(p)); {recursive call}
+end
+@y
+@ @<Display box |p|@>=
+begin if type(p)=hlist_node then print_esc("h")
+else if type(p)=vlist_node then print_esc("v")
+else print_esc("unset");
+print("box("); print_scaled(height(p)); print_char("+");
+print_scaled(depth(p)); print(")x"); print_scaled(width(p));
+if type(p)=unset_node then
+ @<Display special fields of the unset node |p|@>
+else begin @<Display the value of |glue_set(p)|@>;
+ if shift_amount(p)<>0 then
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+ print(", direction "); print_dir(box_dir(p));
+ end;
+node_list_display(list_ptr(p)); {recursive call}
+end
+@z
+%-------------------------
+@x [10] m.206
+hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size);
+ mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
+@y
+hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size);
+ mem[r+7]:=mem[p+7]; mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5];
+ {copy the last three words}
+@z
+%-------------------------
+@x [15] m.209
+@d max_internal=register
+ {the largest code that can follow \.{\\the}}
+@y
+@d assign_dir=register+1 {(\.{\\pagedir}, \.{\\textdir})}
+@d max_internal=assign_dir
+ {the largest code that can follow \.{\\the}}
+@z
+%-------------------------
+@x [16] m.212
+ @!aux_field: memory_word;
+@y
+ @!aux_field: memory_word;
+ @!dirs_field: halfword;
+ @!math_field: integer;
+@z
+%-------------------------
+@x [16] m.212
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@y
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@d dir_save==cur_list.dirs_field {dir stack when a paragraph is interrupted}
+@d dir_math_save==cur_list.math_field
+ {should begin/end dir nodes be placed around mathematics?}
+@z
+%-------------------------
+@x [16] m.215
+prev_graf:=0; shown_mode:=0;
+@y
+prev_graf:=0; shown_mode:=0;
+dir_save:=null; dir_math_save:=false;
+@z
+%-------------------------
+@x [16] m.216 l.4351
+@ @p @<LOCAL: Declare |make_local_par_node|@>;
+@y
+@ @p @<LOCAL: Declare |make_local_par_node|@>;
+
+@ @p @<DIR: Declare |new_dir|@>;
+@z
+%-------------------------
+@x [16] m.216
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+dir_save:=null; dir_math_save:=false;
+@z
+%-------------------------
+@x [16] m.217
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+@y
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+@z
+%-------------------------
+@x [17] m.236
+@d int_pars=58 {total number of integer parameters}
+@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers}
+@y
+@d no_local_dirs_code=58
+@d level_local_dir_code=59
+@d int_pars=61 {total number of integer parameters}
+@d dir_base=int_base+int_pars
+@d page_direction_code=0
+@d body_direction_code=1
+@d par_direction_code=2
+@d text_direction_code=3
+@d math_direction_code=4
+@d dir_pars=5
+@d count_base=dir_base+dir_pars {|number_regs| user \.{\\count} registers}
+@z
+%-------------------------
+@x [17] m.238
+@d no_local_whatsits==int_par(no_local_whatsits_code)
+@y
+@d no_local_whatsits==int_par(no_local_whatsits_code)
+@d no_local_dirs==int_par(no_local_dirs_code)
+@d level_local_dir==int_par(level_local_dir_code)
+@d dir_par(#)==new_eqtb_int(dir_base+#) {a direction parameter}
+@d page_direction==dir_par(page_direction_code)
+@d body_direction==dir_par(body_direction_code)
+@d par_direction==dir_par(par_direction_code)
+@d text_direction==dir_par(text_direction_code)
+@d math_direction==dir_par(math_direction_code)
+@z
+%-------------------------
+@x [17] m.240
+set_new_eqtb_int(int_base+end_line_char_code,carriage_return);
+@y
+set_new_eqtb_int(int_base+end_line_char_code,carriage_return);
+set_new_eqtb_int(int_base+level_local_dir_code,level_one);
+@z
+%-------------------------
+@x [17] m.247
+@d dimen_pars=21 {total number of dimension parameters}
+@y
+@d page_width_code=21
+@d page_height_code=22
+@d page_right_offset_code=23
+@d page_bottom_offset_code=24
+@d dimen_pars=25 {total number of dimension parameters}
+@z
+%-------------------------
+@x [17] m.247
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@y
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@d page_width==dimen_par(page_width_code)
+@d page_height==dimen_par(page_height_code)
+@d page_right_offset==dimen_par(page_right_offset_code)
+@d page_bottom_offset==dimen_par(page_bottom_offset_code)
+@z
+%-------------------------
+@x [26] m.410
+@d int_val=0 {integer values}
+@d dimen_val=1 {dimension values}
+@d glue_val=2 {glue specifications}
+@d mu_val=3 {math glue specifications}
+@d ident_val=4 {font identifier}
+@d tok_val=5 {token lists}
+
+@<Glob...@>=
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@!cur_val_level:int_val..tok_val; {the ``level'' of this value}
+@y
+@d int_val=0 {integer values}
+@d dimen_val=1 {dimension values}
+@d glue_val=2 {glue specifications}
+@d mu_val=3 {math glue specifications}
+@d dir_val=4 {directions}
+@d ident_val=5 {font identifier}
+@d tok_val=6 {token lists}
+
+@<Glob...@>=
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@!cur_val_level:int_val..dir_val; {the ``level'' of this value}
+@z
+%-------------------------
+@x [26] m.413
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+@y
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_dir: scanned_result(new_eqtb_int(m))(dir_val);
+@z
+%-------------------------
+@x [26] m.437
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_eight_bit_int;
+@y
+@
+@d dir_T=0
+@d dir_L=1
+@d dir_B=2
+@d dir_R=3
+@d dir_eq_end(#)==(#)
+@d dir_eq(#)==(#)=dir_eq_end
+@d dir_ne_end(#)==(#)
+@d dir_ne(#)==(#)<>dir_ne_end
+@d dir_opposite_end(#)==((#) mod 4)
+@d dir_opposite(#)==(((#)+2) mod 4)=dir_opposite_end
+@d dir_parallel_end(#)==((#) mod 2)
+@d dir_parallel(#)==((#) mod 2)=dir_parallel_end
+@d dir_orthogonal_end(#)==(# mod 2)
+@d dir_orthogonal(#)==((#) mod 2)<>dir_orthogonal_end
+@d dir_next_end(#)==((#) mod 4)
+@d dir_next(#)==(((#)+3) mod 4)=dir_next_end
+@d dir_prev_end(#)==((#) mod 4)
+@d dir_prev(#)==(((#)+1) mod 4)=dir_prev_end
+
+{box directions}
+@d dir_TL_=0
+@d dir_TR_=1
+@d dir_LT_=2
+@d dir_LB_=3
+@d dir_BL_=4
+@d dir_BR_=5
+@d dir_RT_=6
+@d dir_RB_=7
+
+{font directions}
+@d dir__LT= 0
+@d dir__LL= 1
+@d dir__LB= 2
+@d dir__LR= 3
+@d dir__RT= 4
+@d dir__RL= 5
+@d dir__RB= 6
+@d dir__RR= 7
+@d dir__TT= 8
+@d dir__TL= 9
+@d dir__TB=10
+@d dir__TR=11
+@d dir__BT=12
+@d dir__BL=13
+@d dir__BB=14
+@d dir__BR=15
+
+@d is_mirrored(#)==dir_opposite(dir_primary[#])(dir_tertiary[#])
+@d is_rotated(#)==dir_parallel(dir_secondary[#])(dir_tertiary[#])
+@d font_direction(#)==(# mod 16)
+@d box_direction(#)==(# div 4)
+
+@d scan_single_dir(#)==begin
+if scan_keyword("T") then #:=dir_T
+else if scan_keyword("L") then #:=dir_L
+else if scan_keyword("B") then #:=dir_B
+else if scan_keyword("R") then #:=dir_R
+else begin
+ print_err("Bad direction"); cur_val:=0;
+ goto exit;
+ end
+end
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_dir;
+var d1,d2,d3: integer;
+begin
+get_x_token;
+if cur_cmd=assign_dir then begin
+ cur_val:=new_eqtb_int(cur_chr);
+ goto exit;
+ end
+else back_input;
+scan_single_dir(d1);
+scan_single_dir(d2);
+if dir_parallel(d1)(d2) then begin
+ print_err("Bad direction"); cur_val:=0;
+ goto exit;
+ end;
+scan_single_dir(d3);
+cur_val:=d1*8+dir_rearrange[d2]*4+d3;
+exit:
+end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_eight_bit_int;
+@z
+%-------------------------
+@x [27] m.463
+@p function scan_rule_spec:pointer;
+label reswitch;
+var q:pointer; {the rule node being created}
+begin q:=new_rule; {|width|, |depth|, and |height| all equal |null_flag| now}
+if cur_cmd=vrule then width(q):=default_rule
+else begin height(q):=default_rule; depth(q):=0;
+ end;
+@y
+@p function scan_rule_spec:pointer;
+label reswitch;
+var q:pointer; {the rule node being created}
+begin q:=new_rule; {|width|, |depth|, and |height| all equal |null_flag| now}
+if cur_cmd=vrule then begin
+ width(q):=default_rule;
+ rule_dir(q):=body_direction;
+ end
+else begin
+ height(q):=default_rule; depth(q):=0;
+ rule_dir(q):=text_direction;
+end;
+@z
+%-------------------------
+@x [27] m.465
+ int_val:print_int(cur_val);
+@y
+ int_val:print_int(cur_val);
+ dir_val:print_dir(cur_val);
+@z
+%-------------------------
+@x [30] m.550
+@d offset_false_bchar=offset_bchar+1
+@d offset_ivalues_start=offset_false_bchar+1
+@y
+@d offset_false_bchar=offset_bchar+1
+@d offset_natural_dir=offset_false_bchar+1
+@d offset_ivalues_start=offset_natural_dir+1
+@z
+%-------------------------
+@x [30] m.550
+@d font_false_bchar(#)==font_info(#)(offset_false_bchar).int
+@y
+@d font_false_bchar(#)==font_info(#)(offset_false_bchar).int
+@d font_natural_dir(#)==font_info(#)(offset_natural_dir).int
+@z
+%-------------------------
+@x [30] m.560
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled;offset:quarterword):internal_font_number; {input a \.{TFM} file}
+@y
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled;offset:quarterword;natural_dir:integer):internal_font_number;
+ {input a \.{TFM} file}
+@z
+%-------------------------
+@x [30] m.560
+font_offset(f):=offset;
+@y
+font_offset(f):=offset;
+font_natural_dir(f):=natural_dir;
+@z
+%-------------------------
+@x [31] m.586
+@d set_rule=132 {typeset a rule and move right}
+@y
+@d set_rule=132 {typeset a rule and move right}
+@d put1==133 {typeset a character without moving}
+@z
+%-------------------------
+@x [31] m.586
+@d right1=143 {move right}
+@y
+@d right1==143 {move right}
+@d right4==146 {move right, 4 bytes}
+@z
+%-------------------------
+@x [31] m.586
+@d down1=157 {move down}
+@y
+@d down1=157 {move down}
+@d down4=160 {move down, 4 bytes}
+@z
+%-------------------------
+@x [32] m.607
+@p procedure movement(@!w:scaled;@!o:eight_bits);
+label exit,found,not_found,2,1;
+var mstate:small_number; {have we seen a |y| or |z|?}
+@!p,@!q:pointer; {current and top nodes on the stack}
+@!k:integer; {index into |dvi_buf|, modulo |dvi_buf_size|}
+begin q:=get_node(movement_node_size); {new node for the top of the stack}
+width(q):=w; location(q):=dvi_offset+dvi_ptr;
+if o=down1 then
+ begin link(q):=down_ptr; down_ptr:=q;
+ end
+else begin link(q):=right_ptr; right_ptr:=q;
+ end;
+@<Look at the other stack entries until deciding what sort of \.{DVI} command
+ to generate; |goto found| if node |p| is a ``hit''@>;
+@<Generate a |down| or |right| command for |w| and |return|@>;
+found: @<Generate a |y0| or |z0| command in order to reuse a previous
+ appearance of~|w|@>;
+exit:end;
+@y
+@d dvi_set(#)==oval:=#-font_offset(f); ocmd:=set1; out_cmd
+@d dvi_put(#)==oval:=#-font_offset(f); ocmd:=put1; out_cmd
+@d dvi_set_rule_end(#)==dvi_four(#)
+@d dvi_set_rule(#)==dvi_out(set_rule); dvi_four(#); dvi_set_rule_end
+@d dvi_put_rule_end(#)==dvi_four(#)
+@d dvi_put_rule(#)==dvi_out(put_rule); dvi_four(#); dvi_put_rule_end
+@d dvi_right(#)==dvi_out(right4); dvi_four(#);
+@d dvi_left(#)==dvi_out(right4); dvi_four(-#);
+@d dvi_down(#)==dvi_out(down4); dvi_four(#);
+@d dvi_up(#)==dvi_out(down4); dvi_four(-#);
+
+@p procedure movement(@!w:scaled;@!o:eight_bits);
+label exit,found,not_found,2,1;
+var mstate:small_number; {have we seen a |y| or |z|?}
+@!p,@!q:pointer; {current and top nodes on the stack}
+@!k:integer; {index into |dvi_buf|, modulo |dvi_buf_size|}
+begin
+case box_direction(dvi_direction) of
+ dir_TL_: begin
+ end;
+ dir_TR_: begin
+ if o=right1 then negate(w);
+ end;
+ dir_LT_: begin
+ if o=right1 then o:=down1
+ else o:=right1;
+ end;
+ dir_LB_: begin
+ if o=right1 then begin
+ o:=down1; negate(w);
+ end
+ else o:=right1;
+ end;
+ dir_BL_: begin
+ if o=down1 then negate(w);
+ end;
+ dir_BR_: begin
+ negate(w);
+ end;
+ dir_RT_: begin
+ if o=right1 then o:=down1
+ else begin o:=right1; negate(w);
+ end;
+ end;
+ dir_RB_: begin
+ if o=right1 then o:=down1 else o:=right1;
+ negate(w);
+ end;
+ end;
+if false then begin
+q:=get_node(movement_node_size); {new node for the top of the stack}
+width(q):=w; location(q):=dvi_offset+dvi_ptr;
+if o=down1 then
+ begin link(q):=down_ptr; down_ptr:=q;
+ end
+else begin link(q):=right_ptr; right_ptr:=q;
+ end;
+@<Look at the other stack entries until deciding what sort of \.{DVI} command
+ to generate; |goto found| if node |p| is a ``hit''@>;
+end;
+@<Generate a |down| or |right| command for |w| and |return|@>;
+found: @<Generate a |y0| or |z0| command in order to reuse a previous
+ appearance of~|w|@>;
+exit:end;
+@z
+%-------------------------
+@x [32] m.610
+info(q):=yz_OK;
+@y
+@z
+%-------------------------
+@x [32] m.617
+dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
+@y
+dvi_h:=0; dvi_v:=0; cur_h:=0; cur_v:=0; dvi_f:=null_font;
+@z
+%-------------------------
+@x [32] m.619
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+@y
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+c_wd,c_ht,c_dp: scaled;
+ {the real width, height and depth of the character}
+c_htdp: quarterword; {height-depth entry in |char_info|}
+c_info: four_quarters; {|char_info| entry}
+edge_v: scaled;
+effective_horizontal: scaled;
+basepoint_horizontal: scaled;
+basepoint_vertical: scaled;
+saving_h: scaled;
+saving_v: scaled;
+save_direction: integer;
+dir_tmp,dir_ptr:pointer;
+dvi_dir_h,dvi_dir_ptr,dvi_temp_ptr:integer;
+@z
+%-------------------------
+@x [32] m.619
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+@y
+save_direction:=dvi_direction;
+dvi_direction:=box_dir(this_box);
+@<DIR: Initialize |dir_ptr| for |ship_out|@>;
+saving_h:=dvi_h; saving_v:=dvi_v;
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+cur_h:=saving_h; cur_v:=saving_v;
+synch_h; synch_v;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+dvi_direction:=save_direction;
+@<DIR: Reset |dir_ptr|@>;
+@z
+%-------------------------
+@x [32] m.620
+ oval:=c-font_offset(f); ocmd:=set1; out_cmd;@/
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+@y
+ c_info:=char_info(f)(c);
+ c_htdp:=height_depth(c_info);
+ if is_rotated(dvi_direction) then begin
+ c_ht:=char_width(f)(c_info) div 2;
+ c_wd:=char_height(f)(c_htdp)+char_depth(f)(c_htdp);
+ end
+ else begin
+ c_ht:=char_height(f)(c_htdp);
+ c_dp:=char_depth(f)(c_htdp);
+ c_wd:=char_width(f)(c_info);
+ end;
+ cur_h:=cur_h+c_wd;
+ if (font_natural_dir(f)<>-1) then
+ case font_direction(dvi_direction) of
+ dir__LT,dir__LB: begin
+ dvi_set(c);
+ end;
+ dir__RT,dir__RB: begin
+ dvi_put(c);
+ dvi_left(c_wd);
+ end;
+ dir__TL,dir__TR: begin
+ dvi_put(c);
+ dvi_down(c_wd);
+ end;
+ dir__BL,dir__BR: begin
+ dvi_put(c);
+ dvi_up(c_wd);
+ end;
+ dir__LL,dir__LR: begin
+ dvi_put(c);
+ dvi_right(c_wd);
+ end;
+ dir__RL,dir__RR: begin
+ dvi_put(c);
+ dvi_left(c_wd);
+ end;
+ dir__TT,dir__TB: begin
+ dvi_put(c);
+ dvi_down(c_wd);
+ end;
+ dir__BT,dir__BB: begin
+ dvi_put(c);
+ dvi_up(c_wd);
+ end;
+ end
+ else
+ case font_direction(dvi_direction) of
+ dir__LT: begin
+ dvi_set(c);
+ end;
+ dir__LB: begin
+ dvi_down(c_ht);
+ dvi_set(c);
+ dvi_up(c_ht);
+ end;
+ dir__RT: begin
+ dvi_left(c_wd);
+ dvi_put(c);
+ end;
+ dir__RB: begin
+ dvi_left(c_wd);
+ dvi_down(c_ht);
+ dvi_put(c);
+ dvi_up(c_ht);
+ end;
+ dir__TL: begin
+ dvi_down(c_wd);
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ end;
+ dir__TR: begin
+ dvi_down(c_wd);
+ dvi_left(c_dp);
+ dvi_put(c);
+ dvi_right(c_dp);
+ end;
+ dir__BL: begin
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ dvi_up(c_wd);
+ end;
+ dir__BR: begin
+ dvi_left(c_dp);
+ dvi_put(c);
+ dvi_right(c_dp);
+ dvi_up(c_wd);
+ end;
+ dir__LL,dir__LR: begin
+ dvi_down(c_ht);
+ dvi_put(c);
+ dvi_up(c_ht);
+ dvi_right(c_wd);
+ end;
+ dir__RL,dir__RR: begin
+ dvi_left(c_wd);
+ dvi_down(c_ht);
+ dvi_put(c);
+ dvi_up(c_ht);
+ end;
+ dir__TT,dir__TB: begin
+ dvi_down(c_wd);
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ end;
+ dir__BT,dir__BB: begin
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ dvi_up(c_wd);
+ end;
+ end;
+@z
+%-------------------------
+@x [32] m.622
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+@y
+rule_node: begin
+ if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
+ then begin
+ rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ end
+ else begin
+ rule_ht:=width(p) div 2;
+ rule_dp:=width(p) div 2;
+ rule_wd:=height(p)+depth(p);
+ end;
+ goto fin_rule;
+ end;
+@z
+%-------------------------
+@x [32] m.623
+if list_ptr(p)=null then cur_h:=cur_h+width(p)
+else begin save_h:=dvi_h; save_v:=dvi_v;
+ cur_v:=base_line+shift_amount(p); {shift the box down}
+ temp_ptr:=p; edge:=cur_h;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge+width(p); cur_v:=base_line;
+ end
+@y
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
+ then begin
+ effective_horizontal:=width(p);
+ basepoint_vertical:=0;
+ if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(p)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ effective_horizontal:=height(p)+depth(p);
+ if not (is_mirrored(box_dir(p))) then
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(p)
+ else
+ basepoint_horizontal:=depth(p)
+ else
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=depth(p)
+ else
+ basepoint_horizontal:=height(p);
+ if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
+ basepoint_vertical:= -(width(p) div 2)
+ else
+ basepoint_vertical:= (width(p) div 2);
+ end;
+if not (is_mirrored(dvi_direction)) then
+ basepoint_vertical := basepoint_vertical + shift_amount(p)
+ {shift the box `down'}
+else
+ basepoint_vertical := basepoint_vertical - shift_amount(p);
+ {shift the box `up'}
+if list_ptr(p)=null then cur_h:=cur_h + effective_horizontal
+else begin
+ temp_ptr:=p; edge:=cur_h; cur_h:=cur_h + basepoint_horizontal;
+ edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+ synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge+effective_horizontal; cur_v:=base_line;
+ end
+end
+@z
+%-------------------------
+@x [32] m.624
+ dvi_out(set_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+@y
+ case font_direction(dvi_direction) of
+ dir__LT: begin
+ dvi_set_rule(rule_ht)(rule_wd);
+ end;
+ dir__LB: begin
+ dvi_down(rule_ht);
+ dvi_set_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__RT: begin
+ dvi_left(rule_wd);
+ dvi_put_rule(rule_ht)(rule_wd);
+ end;
+ dir__RB: begin
+ dvi_left(rule_wd);
+ dvi_down(rule_ht);
+ dvi_put_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__TL: begin
+ dvi_down(rule_wd);
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ end;
+ dir__TR: begin
+ dvi_down(rule_wd);
+ dvi_put_rule(rule_wd)(rule_ht);
+ end;
+ dir__BL: begin
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ dir__BR: begin
+ dvi_put_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ end;
+@z
+%-------------------------
+@x [32] m.626
+leader_wd:=width(leader_box);
+@y
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+ then leader_wd:=width(leader_box)
+else
+ leader_wd:=height(leader_box)+depth(leader_box);
+@z
+%-------------------------
+%@x [32] m.628
+%@<Output a leader box at |cur_h|, ...@>=
+%begin cur_v:=base_line+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/
+%synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+%outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+%if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+%doing_leaders:=outer_doing_leaders;
+%dvi_v:=save_v; dvi_h:=save_h; cur_v:=base_line;
+%cur_h:=save_h+leader_wd+lx;
+%end
+%@y
+%@<Output a leader box at |cur_h|, ...@>=
+%begin
+%if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+% then begin
+% basepoint_vertical:=0;
+% if dir_opposite(dir_secondary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+% basepoint_horizontal:=width(leader_box)
+% else
+% basepoint_horizontal:=0;
+% end
+%else begin
+% if not (is_mirrored(box_dir(leader_box))) then
+% if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+% basepoint_horizontal:=height(leader_box)
+% else
+% basepoint_horizontal:=depth(leader_box)
+% else
+% if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+% basepoint_horizontal:=depth(leader_box)
+% else
+% basepoint_horizontal:=height(leader_box);
+% if dir_eq(dir_secondary[box_dir(leader_box)])(dir_primary[dvi_direction]) then
+% basepoint_vertical:= -(width(leader_box) div 2)
+% else
+% basepoint_vertical:= (width(leader_box) div 2);
+% end;
+%if not (is_mirrored(dvi_direction)) then
+% basepoint_vertical := basepoint_vertical + shift_amount(p)
+% {shift the box `down'}
+%else
+% basepoint_vertical := basepoint_vertical - shift_amount(p);
+% {shift the box `up'}
+%temp_ptr:=leader_box;
+%edge:=cur_h; cur_h:=cur_h + basepoint_horizontal;
+%edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+%synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+%outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+%if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+%doing_leaders:=outer_doing_leaders;
+%dvi_h:=save_h; dvi_v:=save_v;
+%cur_h:=edge+leader_wd+lx; cur_v:=base_line;
+%end
+%@z
+%-------------------------
+@x [32] m.629
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box);
+top_edge:=cur_v;
+while p<>null do @<Output node |p| for |vlist_out| and move to the next node,
+ maintaining the condition |cur_h=left_edge|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+@y
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+@!save_direction: integer;
+@!effective_vertical: scaled;
+@!basepoint_horizontal: scaled;
+@!basepoint_vertical: scaled;
+@!edge_v: scaled;
+@!saving_v: scaled;
+@!saving_h: scaled;
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+saving_v:=dvi_v; saving_h:=dvi_h;
+save_direction:=dvi_direction;
+dvi_direction:=box_dir(this_box);
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box);
+top_edge:=cur_v;
+while p<>null do @<Output node |p| for |vlist_out| and move to the next node,
+ maintaining the condition |cur_h=left_edge|@>;
+cur_v:=saving_v; cur_h:=saving_h;
+synch_v; synch_h;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+dvi_direction:=save_direction;
+@z
+%-------------------------
+@x [32] m.631
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+@y
+rule_node: begin
+ if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
+ then begin
+ rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ end
+ else begin
+ rule_ht:=width(p) div 2;
+ rule_dp:=width(p) div 2;
+ rule_wd:=height(p)+depth(p);
+ end;
+ goto fin_rule;
+ end;
+@z
+%-------------------------
+@x [32] m.632
+@<Output a box in a vlist@>=
+if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
+else begin cur_v:=cur_v+height(p); synch_v;
+ save_h:=dvi_h; save_v:=dvi_v;
+ cur_h:=left_edge+shift_amount(p); {shift the box right}
+ temp_ptr:=p;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_v:=save_v+depth(p); cur_h:=left_edge;
+ end
+@y
+@<Output a box in a vlist@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
+ then begin
+ effective_vertical:=height(p)+depth(p);
+ if (type(p)=hlist_node) and (is_mirrored(box_dir(p))) then
+ basepoint_vertical:=depth(p)
+ else
+ basepoint_vertical:=height(p);
+ if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(p)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ effective_vertical:=width(p);
+ if not (is_mirrored(box_dir(p))) then
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(p)
+ else
+ basepoint_horizontal:=depth(p)
+ else
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=depth(p)
+ else
+ basepoint_horizontal:=height(p);
+ if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
+ basepoint_vertical:=0
+ else
+ basepoint_vertical:=width(p);
+ end;
+basepoint_horizontal := basepoint_horizontal + shift_amount(p);
+ {shift the box `right'}
+if list_ptr(p)=null then begin
+ cur_v:=cur_v+effective_vertical;
+ end
+else begin
+ synch_h; synch_v; edge_v:=cur_v;
+ cur_h:=left_edge + basepoint_horizontal;
+ cur_v:=cur_v + basepoint_vertical;
+ synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+ temp_ptr:=p;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=left_edge; cur_v:=edge_v + effective_vertical;
+ end
+end
+@z
+%-------------------------
+@x [32] m.633
+ dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+@y
+ case font_direction(dvi_direction) of
+ dir__LT: begin
+ dvi_put_rule(rule_ht)(rule_wd);
+ end;
+ dir__LB: begin
+ dvi_down(rule_ht);
+ dvi_put_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__RT: begin
+ dvi_left(rule_wd);
+ dvi_set_rule(rule_ht)(rule_wd);
+ end;
+ dir__RB: begin
+ dvi_down(rule_ht);
+ dvi_left(rule_wd);
+ dvi_set_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__TL: begin
+ dvi_down(rule_wd);
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ dir__TR: begin
+ dvi_down(rule_wd);
+ dvi_put_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ dir__BL: begin
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ end;
+ dir__BR: begin
+ dvi_put_rule(rule_wd)(rule_ht);
+ end;
+ end;
+@z
+%-------------------------
+@x [32] m.635
+leader_ht:=height(leader_box)+depth(leader_box);
+@y
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+ then leader_ht:=height(leader_box)+depth(leader_box)
+else
+ leader_ht:=width(leader_box);
+@z
+%-------------------------
+@x [32] m.637
+@<Output a leader box at |cur_v|, ...@>=
+begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/
+cur_v:=cur_v+height(leader_box); synch_v; save_v:=dvi_v;
+temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_v:=save_v; dvi_h:=save_h; cur_h:=left_edge;
+cur_v:=save_v-height(leader_box)+leader_ht+lx;
+end
+@y
+@<Output a leader box at |cur_v|, ...@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
+ then begin
+ effective_vertical:=height(p)+depth(p);
+ if (type(p)=hlist_node) and (is_mirrored(box_dir(p))) then
+ basepoint_vertical:=depth(p)
+ else
+ basepoint_vertical:=height(p);
+ if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(p)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ effective_vertical:=width(p);
+ if not (is_mirrored(box_dir(p))) then
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(p)
+ else
+ basepoint_horizontal:=depth(p)
+ else
+ if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=depth(p)
+ else
+ basepoint_horizontal:=height(p);
+ if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
+ basepoint_vertical:= width(p)
+ else
+ basepoint_vertical:= 0;
+ end;
+basepoint_horizontal := basepoint_horizontal + shift_amount(p);
+ {shift the box `right'}
+temp_ptr:=leader_box;
+cur_h:=left_edge + basepoint_horizontal;
+cur_v:=cur_v + basepoint_vertical;
+synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_h:=save_h; dvi_v:=save_v;
+cur_h:=left_edge; cur_v:=edge_v+leader_ht+lx;
+end
+@z
+%-------------------------
+@x [32] m.640
+cur_v:=height(p)+v_offset; temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+@y
+dvi_direction:=page_direction;
+case box_direction(dvi_direction) of
+dir_TL_,dir_LT_: begin
+ end;
+dir_TR_,dir_RT_: begin
+ dvi_right(page_right_offset);
+ end;
+dir_RB_,dir_BR_: begin
+ dvi_right(page_right_offset);
+ dvi_down(page_bottom_offset);
+ end;
+dir_BL_,dir_LB_: begin
+ dvi_down(page_bottom_offset);
+ end;
+end;
+cur_h:=h_offset;
+cur_v:=height(p)+v_offset;
+case box_direction(dvi_direction) of
+dir_TL_: begin
+ dvi_down(cur_v);
+ dvi_right(cur_h);
+ end;
+dir_TR_: begin
+ dvi_down(cur_v);
+ dvi_right(-cur_h);
+ end;
+dir_LT_: begin
+ dvi_right(cur_v);
+ dvi_down(cur_h);
+ end;
+dir_LB_: begin
+ dvi_right(cur_v);
+ dvi_down(-cur_h);
+ end;
+dir_BL_: begin
+ dvi_down(-cur_v);
+ dvi_right(cur_h);
+ end;
+dir_BR_: begin
+ dvi_down(-cur_v);
+ dvi_right(-cur_h);
+ end;
+dir_RT_: begin
+ dvi_right(-cur_v);
+ dvi_down(cur_h);
+ end;
+dir_RB_: begin
+ dvi_right(-cur_v);
+ dvi_down(-cur_h);
+ end;
+end;
+dvi_h:=cur_h;
+dvi_v:=cur_v;
+temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+@z
+%-------------------------
+@x [33] m.644
+@d exactly=0 {a box dimension is pre-specified}
+@d additional=1 {a box dimension is increased from the natural one}
+@d natural==0,additional {shorthand for parameters to |hpack| and |vpack|}
+@y
+@d exactly=0 {a box dimension is pre-specified}
+@d additional=1 {a box dimension is increased from the natural one}
+@d natural==0,additional {shorthand for parameters to |hpack| and |vpack|}
+
+@<Glob...@>=
+pack_direction:integer;
+spec_direction:integer;
+
+@z
+%-------------------------
+@x [33] m.645
+@p procedure scan_spec(@!c:group_code;@!three_codes:boolean);
+ {scans a box specification and left brace}
+label found;
+var @!s:integer; {temporarily saved value}
+@!spec_code:exactly..additional;
+begin if three_codes then s:=saved(0);
+if scan_keyword("to") then spec_code:=exactly
+@.to@>
+else if scan_keyword("spread") then spec_code:=additional
+@.spread@>
+else begin spec_code:=additional; cur_val:=0;
+ goto found;
+ end;
+scan_normal_dimen;
+found: if three_codes then
+ begin saved(0):=s; incr(save_ptr);
+ end;
+saved(0):=spec_code; saved(1):=cur_val; save_ptr:=save_ptr+2;
+new_save_level(c); scan_left_brace;
+end;
+@y
+@p procedure scan_spec(@!c:group_code;@!three_codes:boolean);
+ {scans a box specification and left brace}
+label found;
+var @!s:integer; {temporarily saved value}
+@!spec_code:exactly..additional;
+begin if three_codes then s:=saved(0);
+if (c<>align_group) and (c<>vcenter_group) then begin
+ if scan_keyword("dir") then begin
+ scan_dir; spec_direction:=cur_val;
+ end;
+ end;
+if scan_keyword("to") then spec_code:=exactly
+@.to@>
+else if scan_keyword("spread") then spec_code:=additional
+@.spread@>
+else begin spec_code:=additional; cur_val:=0;
+ goto found;
+ end;
+scan_normal_dimen;
+found: if three_codes then
+ begin saved(0):=s; incr(save_ptr);
+ end;
+saved(0):=spec_code; saved(1):=cur_val;
+if (c<>align_group) and (c<>vcenter_group) then begin
+ saved(2):=spec_direction;
+ @<DIR: Adjust |text_dir_ptr| for |scan_spec|@>;
+ save_ptr:=save_ptr+4;
+ new_save_level(c); scan_left_brace;
+ eq_word_define(dir_base+body_direction_code,spec_direction);
+ eq_word_define(dir_base+par_direction_code,spec_direction);
+ eq_word_define(dir_base+text_direction_code,spec_direction);
+ eq_word_define(int_base+level_local_dir_code,cur_level);
+ end
+else begin
+ save_ptr:=save_ptr+2;
+ new_save_level(c); scan_left_brace;
+ end;
+spec_direction:=-1;
+end;
+@z
+%-------------------------
+@x [33] m.649
+@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+label reswitch, common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!q:pointer; {trails behind |p|}
+@!h,@!d,@!x:scaled; {height, depth, and natural width}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+@!f:internal_font_number; {the font in a |char_node|}
+@!i:four_quarters; {font information about a |char_node|}
+@!hd:eight_bits; {height and depth indices for a character}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+@y
+@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+label reswitch, common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!q:pointer; {trails behind |p|}
+@!h,@!d,@!x:scaled; {height, depth, and natural width}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+@!f:internal_font_number; {the font in a |char_node|}
+@!i:four_quarters; {font information about a |char_node|}
+@!hd:eight_bits; {height and depth indices for a character}
+@!dir_tmp,@!dir_ptr:pointer; {for managing the direction stack}
+@!hpack_dir:integer; {the current direction}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+if pack_direction=-1 then
+ box_dir(r):=text_direction
+else begin
+ box_dir(r):=pack_direction; pack_direction:=-1;
+ end;
+hpack_dir:=box_dir(r);
+@<DIR: Initialize |dir_ptr| for |hpack|@>;
+@z
+%-------------------------
+@x [33] m.649
+exit: hpack:=r;
+@y
+exit:
+@<DIR: Reset |dir_ptr|@>;
+hpack:=r;
+@z
+%-------------------------
+@x [33] m.653
+@<Incorporate box dimensions into the dimensions of the hbox...@>=
+begin x:=x+width(p);
+if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+if height(p)-s>h then h:=height(p)-s;
+if depth(p)+s>d then d:=depth(p)+s;
+end
+@y
+@<Incorporate box dimensions into the dimensions of the hbox...@>=
+begin
+if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
+ if dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[hpack_dir]) then begin
+ x:=x+height(p)+depth(p);
+ s:=shift_amount(p);
+ if (width(p) div 2)-s>h then h:=(width(p) div 2)-s;
+ if (width(p) div 2)+s>d then d:=(width(p) div 2)+s;
+ end
+ else if (type(p)=hlist_node) and (is_mirrored(hpack_dir)) then begin
+ x:=x+width(p);
+ s:=shift_amount(p);
+ if depth(p)-s>h then h:=depth(p)-s;
+ if height(p)+s>d then d:=height(p)+s;
+ end
+ else begin
+ x:=x+width(p);
+ s:=shift_amount(p);
+ if height(p)-s>h then h:=height(p)-s;
+ if depth(p)+s>d then d:=depth(p)+s;
+ end
+ end
+else begin
+ x:=x+width(p);
+ if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+ if height(p)-s>h then h:=height(p)-s;
+ if depth(p)+s>d then d:=depth(p)+s;
+ end;
+end
+@z
+%-------------------------
+@x [33] m.654
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+x:=x+char_width(f)(i);@/
+s:=char_height(f)(hd);@+if s>h then h:=s;
+s:=char_depth(f)(hd);@+if s>d then d:=s;
+p:=link(p);
+end
+@y
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+if is_rotated(hpack_dir) then begin
+ x:=x+char_height(f)(hd)+char_depth(f)(hd);@/
+ s:=char_width(f)(i) div 2;@+if s>h then h:=s;
+ s:=char_width(f)(i) div 2;@+if s>d then d:=s;
+ end
+else if dir_opposite(dir_tertiary[hpack_dir])(dir_tertiary[box_dir(r)])
+ then begin
+ x:=x+char_width(f)(i);@/
+ s:=char_depth(f)(hd);@+if s>h then h:=s;
+ s:=char_height(f)(hd);@+if s>d then d:=s;
+ end
+else begin
+ x:=x+char_width(f)(i);@/
+ s:=char_height(f)(hd);@+if s>h then h:=s;
+ s:=char_depth(f)(hd);@+if s>d then d:=s;
+ end;
+p:=link(p);
+end
+@z
+%-------------------------
+@x [33] m.666
+@ @<Report an overfull hbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
+ begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
+ begin while link(q)<>null do q:=link(q);
+ link(q):=new_rule;
+ width(link(q)):=overfull_rule;
+ end;
+@y
+@ @<Report an overfull hbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
+ begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
+ begin while link(q)<>null do q:=link(q);
+ link(q):=new_rule; rule_dir(q):=box_dir(r);
+ width(link(q)):=overfull_rule;
+ end;
+@z
+%-------------------------
+@x [33] m.668
+@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled):
+ pointer;
+label common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!w,@!d,@!x:scaled; {width, depth, and natural height}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
+@y
+@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled):
+ pointer;
+label common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!w,@!d,@!x:scaled; {width, depth, and natural height}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
+if pack_direction=-1 then
+ box_dir(r):=body_direction
+else begin
+ box_dir(r):=pack_direction; pack_direction:=-1;
+ end;
+@z
+%-------------------------
+@x [33] m.670
+@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
+begin x:=x+d+height(p); d:=depth(p);
+if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+if width(p)+s>w then w:=width(p)+s;
+end
+@y
+@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
+begin
+if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
+ if dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[box_dir(r)]) then begin
+ x:=x+d+(width(p) div 2); d:=width(p) div 2;
+ s:=shift_amount(p);
+ if depth(p)+height(p)+s>w then w:=depth(p)+height(p)+s;
+ end
+ else if (type(p)=hlist_node) and (is_mirrored(box_dir(p))) then begin
+ x:=x+d+depth(p); d:=height(p);
+ s:=shift_amount(p);
+ if width(p)+s>w then w:=width(p)+s;
+ end
+ else begin
+ x:=x+d+height(p); d:=depth(p);
+ s:=shift_amount(p);
+ if width(p)+s>w then w:=width(p)+s;
+ end
+ end
+else
+ begin x:=x+d+height(p); d:=depth(p);
+ if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+ if width(p)+s>w then w:=width(p)+s;
+ end;
+end
+@z
+%-------------------------
+@x [33] m.679
+ begin d:=width(baseline_skip)-prev_depth-height(b);
+ if d<line_skip_limit then p:=new_param_glue(line_skip_code)
+ else begin p:=new_skip_param(baseline_skip_code);
+ width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
+ end;
+ link(tail):=p; tail:=p;
+ end;
+link(tail):=b; tail:=b; prev_depth:=depth(b);
+@y
+ begin
+ if (type(b)=hlist_node) and (is_mirrored(box_dir(b))) then
+ d:=width(baseline_skip)-prev_depth-depth(b)
+ else
+ d:=width(baseline_skip)-prev_depth-height(b);
+ if d<line_skip_limit then p:=new_param_glue(line_skip_code)
+ else begin p:=new_skip_param(baseline_skip_code);
+ width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
+ end;
+ link(tail):=p; tail:=p;
+ end;
+link(tail):=b; tail:=b;
+if (type(b)=hlist_node) and (is_mirrored(box_dir(b))) then
+ prev_depth:=height(b)
+else
+ prev_depth:=depth(b);
+@z
+%-------------------------
+@x [35] m.704
+@p function fraction_rule(@!t:scaled):pointer;
+ {construct the bar for a fraction}
+var p:pointer; {the new node}
+begin p:=new_rule; height(p):=t; depth(p):=0; fraction_rule:=p;
+end;
+@y
+@p function fraction_rule(@!t:scaled):pointer;
+ {construct the bar for a fraction}
+var p:pointer; {the new node}
+begin p:=new_rule; rule_dir(p):=math_direction;
+height(p):=t; depth(p):=0; fraction_rule:=p;
+end;
+@z
+%-------------------------
+@x [35] m.705
+@p function overbar(@!b:pointer;@!k,@!t:scaled):pointer;
+var p,@!q:pointer; {nodes being constructed}
+begin p:=new_kern(k); link(p):=b; q:=fraction_rule(t); link(q):=p;
+p:=new_kern(t); link(p):=q; overbar:=vpack(p,natural);
+end;
+@y
+@p function overbar(@!b:pointer;@!k,@!t:scaled):pointer;
+var p,@!q:pointer; {nodes being constructed}
+begin p:=new_kern(k); link(p):=b; q:=fraction_rule(t); link(q):=p;
+p:=new_kern(t); link(p):=q;
+pack_direction:=math_direction; overbar:=vpack(p,natural);
+end;
+@z
+%-------------------------
+@x [36] m.735
+procedure make_under(@!q:pointer);
+var p,@!x,@!y: pointer; {temporary registers for box construction}
+@!delta:scaled; {overall height plus depth}
+begin x:=clean_box(nucleus(q),cur_style);
+p:=new_kern(3*default_rule_thickness); link(x):=p;
+link(p):=fraction_rule(default_rule_thickness);
+y:=vpack(x,natural);
+delta:=height(y)+depth(y)+default_rule_thickness;
+height(y):=height(x); depth(y):=delta-height(y);
+info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+end;
+@y
+procedure make_under(@!q:pointer);
+var p,@!x,@!y: pointer; {temporary registers for box construction}
+@!delta:scaled; {overall height plus depth}
+begin x:=clean_box(nucleus(q),cur_style);
+p:=new_kern(3*default_rule_thickness); link(x):=p;
+link(p):=fraction_rule(default_rule_thickness);
+pack_direction:=math_direction; y:=vpack(x,natural);
+delta:=height(y)+depth(y)+default_rule_thickness;
+height(y):=height(x); depth(y):=delta-height(y);
+info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+end;
+@z
+%-------------------------
+@x [36] m.738
+ y:=vpack(y,natural); width(y):=width(x);
+@y
+ pack_direction:=math_direction;
+ y:=vpack(y,natural); width(y):=width(x);
+@z
+%-------------------------
+@x [36] m.759
+x:=vpack(x,natural); shift_amount(x):=shift_down;
+@y
+pack_direction:=math_direction;
+x:=vpack(x,natural); shift_amount(x):=shift_down;
+@z
+%-------------------------
+@x [38] m.814
+@!internal_right_box_width:integer; {running \.{\\localrightbox} width}
+@!temp_no_whatsits:integer; {used when closing group}
+
+@ @<Set init...@>=
+@y
+@!internal_right_box_width:integer; {running \.{\\localrightbox} width}
+@!paragraph_dir:integer; {main direction of paragraph}
+@!line_break_dir:integer; {current direction within paragraph}
+@!break_c_htdp:quarterword; {height-depth entry in |char_info|}
+@!temp_no_whatsits:integer; {used when closing group}
+@!temp_no_dirs:integer; {used when closing group}
+@!temporary_dir:integer;
+@!dir_ptr,@!dir_tmp,@!dir_rover:pointer;
+
+@ @<Set init...@>=
+temp_no_whatsits:=0; temp_no_dirs:=0; temporary_dir:=0;
+dir_ptr:=null; dir_tmp:=null; dir_rover:=null;
+@z
+%-------------------------
+@x [39] m.816
+link(tail):=new_param_glue(par_fill_skip_code);
+@y
+final_par_glue:=new_param_glue(par_fill_skip_code);
+link(tail):=final_par_glue;
+@z
+%-------------------------
+@x [38] m.816
+init_cur_lang:=prev_graf mod @'200000;
+init_l_hyf:=prev_graf div @'20000000;
+init_r_hyf:=(prev_graf div @'200000) mod @'100;
+@y
+init_cur_lang:=prev_graf mod @'200000;
+init_l_hyf:=prev_graf div @'20000000;
+init_r_hyf:=(prev_graf div @'200000) mod @'100;
+paragraph_dir:=local_par_dir(link(head));
+line_break_dir:=paragraph_dir;
+@<DIR: Initialize |dir_ptr| for |line_break|@>;
+@z
+%-------------------------
+@x [39] m.821
+@!pass_number:halfword; {the number of passive nodes allocated on this pass}
+@y
+@!pass_number:halfword; {the number of passive nodes allocated on this pass}
+@!final_par_glue:pointer;
+@z
+%-------------------------
+@x [38] m.841
+@<Subtract the width of node |v|...@>=
+if is_char_node(v) then
+ begin f:=font(v);
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+else case type(v) of
+ ligature_node: begin f:=font(lig_char(v));@/
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]-width(v);
+@y
+@<Subtract the width of node |v|...@>=
+if is_char_node(v) then
+ begin f:=font(v);
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(v)));
+ break_width[1]:=break_width[1]-char_height(f)(break_c_htdp)
+ -char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+else case type(v) of
+ ligature_node: begin f:=font(lig_char(v));@/
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(v))));
+ break_width[1]:=break_width[1]-char_height(f)(break_c_htdp)
+ -char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(v)])(dir_primary[line_break_dir]))
+ then break_width[1]:=break_width[1]-width(v)
+ else
+ break_width[1]:=break_width[1]-(depth(v)+height(v));
+ rule_node,kern_node:
+ break_width[1]:=break_width[1]-width(v);
+@z
+%-------------------------
+@x [38] m.842
+@ @<Add the width of node |s| to |b...@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]+width(s);
+@y
+@ @<Add the width of node |s| to |b...@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(s)));
+ break_width[1]:=break_width[1]+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(s))));
+ break_width[1]:=break_width[1]+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(s)])(dir_primary[line_break_dir]))
+ then break_width[1]:=break_width[1]+width(s)
+ else
+ break_width[1]:=break_width[1]+(depth(s)+height(s));
+ rule_node,kern_node:
+ break_width[1]:=break_width[1]+width(s);
+@z
+%-------------------------
+@x [38] m.844
+passive_right_box_width(q):=internal_right_box_width;
+@y
+passive_right_box_width(q):=internal_right_box_width;
+@z
+%-------------------------
+@x [38] m.866
+hlist_node,vlist_node,rule_node: act_width:=act_width+width(cur_p);
+@y
+hlist_node,vlist_node:
+if not (dir_orthogonal(dir_primary[box_dir(cur_p)])(dir_primary[line_break_dir]))
+then act_width:=act_width+width(cur_p)
+else act_width:=act_width+(depth(cur_p)+height(cur_p));
+rule_node: act_width:=act_width+width(cur_p);
+@z
+%-------------------------
+@x [38] m.866
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+@y
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(cur_p))));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+@z
+%-------------------------
+@x [38] m.867
+act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+@y
+if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(cur_p)));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+else
+ act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+@z
+%-------------------------
+@x [38] m.870
+@ @<Add the width of node |s| to |disc_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ disc_width:=disc_width+width(s);
+@y
+@ @<Add the width of node |s| to |disc_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(s)));
+ disc_width:=disc_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(s))));
+ disc_width:=disc_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(s)])(dir_primary[line_break_dir]))
+ then disc_width:=disc_width+width(s)
+ else disc_width:=disc_width+(depth(s)+height(s));
+ rule_node,kern_node:
+ disc_width:=disc_width+width(s);
+@z
+%-------------------------
+@x [38] m.871
+@ @<Add the width of node |s| to |act_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ act_width:=act_width+width(s);
+@y
+@ @<Add the width of node |s| to |act_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(s)));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ if is_rotated(line_break_dir) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(s))));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(s)])(dir_primary[line_break_dir]))
+ then act_width:=act_width+width(s)
+ else act_width:=act_width+(depth(s)+height(s));
+ rule_node,kern_node:
+ act_width:=act_width+width(s);
+@z
+%-------------------------
+@x [39] m.877
+@ The total number of lines that will be set by |post_line_break|
+is |best_line-prev_graf-1|. The last breakpoint is specified by
+|break_node(best_bet)|, and this passive node points to the other breakpoints
+via the |prev_break| links. The finishing-up phase starts by linking the
+relevant passive nodes in forward order, changing |prev_break| to
+|next_break|. (The |next_break| fields actually reside in the same memory
+space as the |prev_break| fields did, but we give them a new name because
+of their new significance.) Then the lines are justified, one by one.
+
+@d next_break==prev_break {new name for |prev_break| after links are reversed}
+
+@<Declare subprocedures for |line_break|@>=
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@!disc_break:boolean; {was the current break at a discretionary node?}
+@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
+@!cur_width:scaled; {width of line number |cur_line|}
+@!cur_indent:scaled; {left margin of line number |cur_line|}
+@!t:quarterword; {used for replacement counts in discretionary nodes}
+@!pen:integer; {use when calculating penalties between lines}
+@!cur_line: halfword; {the current line number being justified}
+begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+ first breakpoint@>;
+cur_line:=prev_graf+1;
+repeat @<Justify the line ending at breakpoint |cur_p|, and append it to the
+ current vertical list, together with associated penalties and other
+ insertions@>;
+incr(cur_line); cur_p:=next_break(cur_p);
+if cur_p<>null then if not post_disc_break then
+ @<Prune unwanted nodes at the beginning of the next line@>;
+until cur_p=null;
+if (cur_line<>best_line)or(link(temp_head)<>null) then
+ confusion("line breaking");
+@:this can't happen line breaking}{\quad line breaking@>
+prev_graf:=best_line-1;
+end;
+@y
+@ The total number of lines that will be set by |post_line_break|
+is |best_line-prev_graf-1|. The last breakpoint is specified by
+|break_node(best_bet)|, and this passive node points to the other breakpoints
+via the |prev_break| links. The finishing-up phase starts by linking the
+relevant passive nodes in forward order, changing |prev_break| to
+|next_break|. (The |next_break| fields actually reside in the same memory
+space as the |prev_break| fields did, but we give them a new name because
+of their new significance.) Then the lines are justified, one by one.
+
+The |post_line_break| must also keep an dir stack, so that it can
+output end direction instructions at the ends of lines
+and begin direction instructions at the beginnings of lines.
+
+@d next_break==prev_break {new name for |prev_break| after links are reversed}
+
+@<Declare subprocedures for |line_break|@>=
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@!disc_break:boolean; {was the current break at a discretionary node?}
+@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
+@!cur_width:scaled; {width of line number |cur_line|}
+@!cur_indent:scaled; {left margin of line number |cur_line|}
+@!t:quarterword; {used for replacement counts in discretionary nodes}
+@!pen:integer; {use when calculating penalties between lines}
+@!cur_line: halfword; {the current line number being justified}
+begin dir_ptr:=dir_save;
+@<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+ first breakpoint@>;
+cur_line:=prev_graf+1;
+repeat @<Justify the line ending at breakpoint |cur_p|, and append it to the
+ current vertical list, together with associated penalties and other
+ insertions@>;
+incr(cur_line); cur_p:=next_break(cur_p);
+if cur_p<>null then if not post_disc_break then
+ @<Prune unwanted nodes at the beginning of the next line@>;
+until cur_p=null;
+if (cur_line<>best_line)or(link(temp_head)<>null) then
+ confusion("line breaking");
+@:this can't happen line breaking}{\quad line breaking@>
+prev_graf:=best_line-1; dir_save:=dir_ptr;
+end;
+@z
+%-------------------------
+@x [39] m.880
+@<Justify the line ending at breakpoint |cur_p|, and append it...@>=
+@<Modify the end of the line to reflect the nature of the break and to include
+ \.{\\rightskip}; also set the proper value of |disc_break|@>;
+@<Put the \(l)\.{\\leftskip} glue at the left and detach this line@>;
+@y
+@<Justify the line ending at breakpoint |cur_p|, and append it...@>=
+@<DIR: Insert dir nodes at the beginning of the current line@>;
+@<DIR: Adjust the dir stack based on dir nodes in this line@>;
+@<Modify the end of the line to reflect the nature of the break and to include
+ \.{\\rightskip}; also set the proper value of |disc_break|@>;
+@<Put the \(l)\.{\\leftskip} glue at the left and detach this line@>;
+@z
+%-------------------------
+@x [39] m.881
+ if passive_right_box(cur_p)<>null then begin
+ r:=temp_head;
+ while link(r)<>q do r:=link(r);
+ s:=copy_node_list(passive_right_box(cur_p));
+ link(r):=s;
+ link(s):=q;
+ end;
+ delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+@y
+ if passive_right_box(cur_p)<>null then begin
+ r:=temp_head;
+ while link(r)<>q do r:=link(r);
+ @<DIR: Insert dir nodes at the end of the current line@>;
+ s:=copy_node_list(passive_right_box(cur_p));
+ link(r):=s;
+ link(s):=q;
+ end
+ else begin
+ r:=temp_head;
+ while link(r)<>q do r:=link(r);
+ @<DIR: Insert dir nodes at the end of the current line@>;
+ end;
+ delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+r:=q;
+@<DIR: Insert dir nodes at the end of the current line@>;
+@z
+%-------------------------
+@x [39] m.888
+append_to_vlist(just_box);
+if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+adjust_tail:=null
+@y
+append_to_vlist(just_box);
+if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+adjust_tail:=null
+@z
+%-------------------------
+@x [39] m.888
+adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly);
+@y
+adjust_tail:=adjust_head;
+pack_direction:=paragraph_dir;
+just_box:=hpack(q,cur_width,exactly);
+@z
+%-------------------------
+@x [44] m.977
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+ {extracts a page of height |h| from box |n|}
+label exit,done;
+var v:pointer; {the box to be split}
+p:pointer; {runs through the vlist}
+q:pointer; {points to where the break occurs}
+begin v:=box(n);
+if split_first_mark<>null then
+ begin delete_token_ref(split_first_mark); split_first_mark:=null;
+ delete_token_ref(split_bot_mark); split_bot_mark:=null;
+ end;
+@<Dispense with trivial cases of void or bad boxes@>;
+q:=vert_break(list_ptr(v),h,split_max_depth);
+@<Look at all the marks in nodes before the break, and set the final
+ link to |null| at the break@>;
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+@y
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+ {extracts a page of height |h| from box |n|}
+label exit,done;
+var v:pointer; {the box to be split}
+vdir:integer; {the direction of the box to be split}
+p:pointer; {runs through the vlist}
+q:pointer; {points to where the break occurs}
+begin v:=box(n); vdir:=box_dir(v);
+if split_first_mark<>null then
+ begin delete_token_ref(split_first_mark); split_first_mark:=null;
+ delete_token_ref(split_bot_mark); split_bot_mark:=null;
+ end;
+@<Dispense with trivial cases of void or bad boxes@>;
+q:=vert_break(list_ptr(v),h,split_max_depth);
+@<Look at all the marks in nodes before the break, and set the final
+ link to |null| at the break@>;
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+pack_direction:=vdir;
+@z
+%-------------------------
+@x [45] m.1001
+if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+else width(temp_ptr):=0;
+@y
+if (type(p)=hlist_node) and (is_mirrored(body_direction)) then begin
+ if width(temp_ptr)>depth(p) then width(temp_ptr):=width(temp_ptr)-depth(p)
+ else width(temp_ptr):=0;
+ end
+else begin
+ if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+ else width(temp_ptr):=0;
+ end;
+@z
+%-------------------------
+@x [45] m.1002
+begin page_total:=page_total+page_depth+height(p);
+page_depth:=depth(p);
+@y
+begin
+if (type(p)=hlist_node) and (is_mirrored(body_direction)) then begin
+ page_total:=page_total+page_depth+depth(p);
+ page_depth:=height(p);
+ end
+else begin
+ page_total:=page_total+page_depth+height(p);
+ page_depth:=depth(p);
+ end;
+@z
+%-------------------------
+@x [45] m.1017
+set_equiv(box_base+255,
+ vpackage(link(page_head),best_size,exactly,page_max_depth));
+@y
+pack_direction:=body_direction;
+set_equiv(box_base+255,
+ vpackage(link(page_head),best_size,exactly,page_max_depth));
+@z
+%-------------------------
+@x [45] m.1021
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+@y
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+pack_direction:=body_direction;
+@z
+%-------------------------
+@x [47] m.1063
+non_math(left_brace): begin
+ new_save_level(simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ end;
+any_mode(begin_group): begin
+ new_save_level(semi_simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ end;
+any_mode(end_group):
+ if cur_group=semi_simple_group then begin
+ temp_no_whatsits:=no_local_whatsits;
+ unsave;
+ if temp_no_whatsits<>0 then
+ if abs(mode)=hmode then @<LOCAL: Add local paragraph node@>;
+ end
+ else off_save;
+@y
+non_math(left_brace): begin
+ new_save_level(simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ eq_word_define(int_base+no_local_dirs_code,0);
+ end;
+any_mode(begin_group): begin
+ new_save_level(semi_simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ eq_word_define(int_base+no_local_dirs_code,0);
+ end;
+any_mode(end_group):
+ if cur_group=semi_simple_group then begin
+ temp_no_whatsits:=no_local_whatsits;
+ temp_no_dirs:=no_local_dirs;
+ temporary_dir:=text_direction;
+ if dir_level(text_dir_ptr)=cur_level then
+ @<DIR: Remove from |text_dir_ptr|@>;
+ unsave;
+ if abs(mode)=hmode then begin
+ if temp_no_dirs<>0 then begin
+ @<DIR: Add local dir node@>;
+ dir_dir(tail):=temporary_dir-64;
+ end;
+ if temp_no_whatsits<>0 then
+ @<LOCAL: Add local paragraph node@>;
+ end
+ end
+ else off_save;
+@z
+%-------------------------
+@x [47] m.1068
+simple_group: begin
+ temp_no_whatsits:=no_local_whatsits;
+ unsave;
+ if temp_no_whatsits<>0 then
+ if abs(mode)=hmode then @<LOCAL: Add local paragraph node@>;
+ end;
+@y
+simple_group: begin
+ temp_no_whatsits:=no_local_whatsits;
+ temp_no_dirs:=no_local_dirs;
+ temporary_dir:=text_direction;
+ if dir_level(text_dir_ptr)=cur_level then
+ @<DIR: Remove from |text_dir_ptr|@>;
+ unsave;
+ if abs(mode)=hmode then begin
+ if temp_no_dirs<>0 then begin
+ @<DIR: Add local dir node@>;
+ dir_dir(tail):=temporary_dir-64;
+ end;
+ if temp_no_whatsits<>0 then
+ @<LOCAL: Add local paragraph node@>;
+ end
+ end;
+@z
+%-------------------------
+@x [47] m.1083
+begin k:=cur_chr-vtop_code; saved(0):=box_context;
+if k=hmode then
+ if (box_context<box_flag)and(abs(mode)=vmode) then
+ scan_spec(adjusted_hbox_group,true)
+ else scan_spec(hbox_group,true)
+else begin if k=vmode then scan_spec(vbox_group,true)
+ else begin scan_spec(vtop_group,true); k:=vmode;
+ end;
+ normal_paragraph;
+ end;
+push_nest; mode:=-k;
+@y
+begin k:=cur_chr-vtop_code; saved(0):=box_context;
+case abs(mode) of
+vmode: spec_direction:=body_direction;
+hmode: spec_direction:=text_direction;
+mmode: spec_direction:=math_direction;
+end;
+if k=hmode then
+ if (box_context<box_flag)and(abs(mode)=vmode) then
+ scan_spec(adjusted_hbox_group,true)
+ else scan_spec(hbox_group,true)
+else begin if k=vmode then scan_spec(vbox_group,true)
+ else begin scan_spec(vtop_group,true); k:=vmode;
+ end;
+ normal_paragraph;
+ end;
+push_nest; mode:=-k;
+@z
+%-------------------------
+@x [47] m.1086
+procedure package(@!c:small_number);
+var h:scaled; {height of box}
+@!p:pointer; {first node in a box}
+@!d:scaled; {max depth}
+begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3;
+if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
+else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
+ if c=vtop_code then @<Readjust the height and depth of |cur_box|,
+ for \.{\\vtop}@>;
+ end;
+pop_nest; box_end(saved(0));
+end;
+@y
+procedure package(@!c:small_number);
+var h:scaled; {height of box}
+@!p:pointer; {first node in a box}
+@!d:scaled; {max depth}
+begin d:=box_max_depth; unsave; save_ptr:=save_ptr-5;
+pack_direction:=saved(3);
+if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
+else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
+ if c=vtop_code then @<Readjust the height and depth of |cur_box|,
+ for \.{\\vtop}@>;
+ end;
+if saved(4)<>null then
+ @<DIR: Adjust back |text_dir_ptr| for |scan_spec|@>;
+pop_nest; box_end(saved(0));
+end;
+@z
+%-------------------------
+@x [47] m.1091
+procedure new_graf(@!indented:boolean);
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ tail:=new_null_box; link(link(head)):=tail; width(tail):=par_indent;@+
+ end;
+@y
+procedure new_graf(@!indented:boolean);
+var p,q,dir_graf_tmp:pointer;
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+q:=tail;
+dir_rover:=text_dir_ptr;
+while dir_rover<>null do
+ begin
+ if (link(dir_rover)<>null) or (dir_dir(dir_rover)<>par_direction) then
+ begin
+ dir_graf_tmp:=new_dir(dir_dir(dir_rover));
+ link(dir_graf_tmp):=link(q); link(q):=dir_graf_tmp;
+ end;
+ dir_rover:=link(dir_rover);
+ end;
+q:=head;
+while link(q)<>null do q:=link(q);
+tail:=q;
+@z
+%-------------------------
+@x [47] m.1096
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+ else line_break(widow_penalty);
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@y
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+ else line_break(widow_penalty);
+ if dir_save<>null then
+ begin flush_node_list(dir_save); dir_save:=null;
+ end;
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@z
+%-------------------------
+@x [48] m.1136
+procedure push_math(@!c:group_code);
+begin push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
+end;
+@y
+procedure push_math(@!c:group_code);
+begin
+if math_direction<>text_direction then dir_math_save:=true;
+push_nest; mode:=-mmode; incompleat_noad:=null;
+@<DIR: |new_save_level| math@>;
+end;
+@z
+%-------------------------
+@x [48] m.1174
+begin unsave; p:=fin_mlist(null);
+@y
+begin @<DIR: |unsave| math@>; p:=fin_mlist(null);
+@z
+%-------------------------
+@x [48] m.1186
+math_group: begin unsave; decr(save_ptr);@/
+@y
+math_group: begin @<DIR: |unsave| math@>; decr(save_ptr);@/
+@z
+%-------------------------
+@x [48] m.1191
+ else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
+@y
+ else begin p:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+@z
+%-------------------------
+@x [48] m.1194
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ unsave; decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+@y
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ @<DIR: |unsave| math@>;
+ decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+@z
+%-------------------------
+@x [48] m.1196
+@<Finish math in text@>=
+begin tail_append(new_math(math_surround,before));
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+tail_append(new_math(math_surround,after));
+space_factor:=1000; unsave;
+end
+@y
+@<Finish math in text@> =
+begin tail_append(new_math(math_surround,before));
+if dir_math_save then
+ @<Append a begin direction to the tail of the current list@>;
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+if dir_math_save then
+ @<Append an end direction to the tail of the current list@>;
+dir_math_save:=false;
+tail_append(new_math(math_surround,after));
+space_factor:=1000;
+@<DIR: |unsave| math@>;
+end
+@z
+%-------------------------
+@x [48] m.1200
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+unsave; prev_graf:=prev_graf+3;
+@y
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+@<DIR: |unsave| math@>;
+prev_graf:=prev_graf+3;
+@z
+%-------------------------
+@x [49] m.1210
+any_mode(assign_int),
+@y
+any_mode(assign_int),
+any_mode(assign_dir),
+@z
+%-------------------------
+@x [49] m.1228
+assign_dimen: begin p:=cur_chr; scan_optional_equals;
+ scan_normal_dimen; word_define(p,cur_val);
+ end;
+@y
+assign_dir: begin
+ @<DIR: Assign direction codes@>
+ end;
+assign_dimen: begin p:=cur_chr; scan_optional_equals;
+ scan_normal_dimen; word_define(p,cur_val);
+ end;
+@z
+%-------------------------
+@x [49] m.1257
+@!flushable_string:str_number; {string not yet referenced}
+@y
+@!natural_dir:integer;{the natural direction of the font}
+@!flushable_string:str_number; {string not yet referenced}
+@z
+%-------------------------
+@x [49] m.1257
+if scan_keyword("offset") then begin
+ scan_int;
+ offset:=cur_val;
+ if (cur_val<0) then begin
+ print_err("Illegal offset has been changed to 0");
+ help1("The offset must be bigger than 0."); int_error(cur_val);
+ offset:=0;
+ end
+ end
+else offset:=0;
+name_in_progress:=false;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s,offset);
+@y
+if scan_keyword("offset") then begin
+ scan_int;
+ offset:=cur_val;
+ if (cur_val<0) then begin
+ print_err("Illegal offset has been changed to 0");
+ help1("The offset must be bigger than 0."); int_error(cur_val);
+ offset:=0;
+ end
+ end
+else offset:=0;
+if scan_keyword("naturaldir") then begin
+ scan_dir;
+ natural_dir:=cur_val;
+ end
+else natural_dir:=-1;
+name_in_progress:=false;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s,offset,natural_dir);
+@z
+%-------------------------
+@x [51] m.1337
+if (loc<limit)and(cat_code(buffer[loc])<>escape) then start_input;
+ {\.{\\input} assumed}
+@y
+if (loc<limit)and(cat_code(buffer[loc])<>escape) then start_input;
+ {\.{\\input} assumed}
+@<DIR: Initialize |text_dir_ptr|@>;
+@z
+%-------------------------
+@x [53] m.1341
+@d language_node=4 {|subtype| in whatsits that change the current language}
+@y
+@d language_node=4 {|subtype| in whatsits that change the current language}
+@d dir_node_size=4 {number of words in change direction node}
+@d dir_dir(#)==info(#+1) {keep the direction to be taken}
+@d dir_level(#)==link(#+1) {the save level at which the direction was defined}
+@d dir_dvi_ptr(#)==info(#+2) {for reflecting dvi output}
+@d dir_dvi_h(#)==info(#+3) {for reflecting dvi output}
+@z
+%-------------------------
+@x [53] m.1342
+@!write_open:array[0..17] of boolean;
+@y
+@!write_open:array[0..17] of boolean;
+@!neg_wd:scaled;
+@!pos_wd:scaled;
+@!neg_ht:scaled;
+@!dvi_direction:integer;
+@!dir_primary:array[0..31] of 0..31;
+@!dir_secondary:array[0..31] of 0..31;
+@!dir_tertiary:array[0..31] of 0..31;
+@!dir_rearrange:array[0..3] of 0..31;
+@!dir_names:array[0..3] of str_number;
+@!text_dir_ptr:pointer;
+@!text_dir_tmp:pointer;
+@z
+%-------------------------
+@x [53] m.1343
+for k:=0 to 17 do write_open[k]:=false;
+@y
+for k:=0 to 17 do write_open[k]:=false;
+set_new_eqtb_int(dir_base+page_direction_code,0);
+set_new_eqtb_int(dir_base+body_direction_code,0);
+set_new_eqtb_int(dir_base+par_direction_code,0);
+set_new_eqtb_int(dir_base+text_direction_code,0);
+set_new_eqtb_int(dir_base+math_direction_code,0);
+pack_direction:=-1;
+{
+set_new_eqtb_sc(dimen_base+page_height_code,55380984); {29.7cm}
+set_new_eqtb_sc(dimen_base+page_width_code,39158276); {21cm}
+}
+set_new_eqtb_sc(dimen_base+page_height_code,15961652); {for talk}
+set_new_eqtb_sc(dimen_base+page_width_code,23718717); {for talk}
+set_new_eqtb_sc(dimen_base+page_bottom_offset_code,page_height-9472573);
+ {-2 inches}
+set_new_eqtb_sc(dimen_base+page_right_offset_code,page_width-9472573);
+ {-2 inches}
+for k:= 0 to 7 do begin
+ dir_primary [k ]:=dir_T;
+ dir_primary [k+ 8]:=dir_L;
+ dir_primary [k+16]:=dir_B;
+ dir_primary [k+24]:=dir_R;
+ end;
+for k:= 0 to 3 do begin
+ dir_secondary[k ]:=dir_L;
+ dir_secondary[k+ 4]:=dir_R;
+ dir_secondary[k+ 8]:=dir_T;
+ dir_secondary[k+12]:=dir_B;
+
+ dir_secondary[k+16]:=dir_L;
+ dir_secondary[k+20]:=dir_R;
+ dir_secondary[k+24]:=dir_T;
+ dir_secondary[k+28]:=dir_B;
+ end;
+for k:=0 to 7 do begin
+ dir_tertiary[k*4 ]:=dir_T;
+ dir_tertiary[k*4+1]:=dir_L;
+ dir_tertiary[k*4+2]:=dir_B;
+ dir_tertiary[k*4+3]:=dir_R;
+ end;
+dir_rearrange[0]:=0;
+dir_rearrange[1]:=0;
+dir_rearrange[2]:=1;
+dir_rearrange[3]:=1;
+dir_names[0]:="T";
+dir_names[1]:="L";
+dir_names[2]:="B";
+dir_names[3]:="R";
+@z
+%-------------------------
+@x [53] m.1344
+@d local_par_node=6 {|subtype| in whatsits for local paragraph node}
+@y
+@d local_par_node=6 {|subtype| in whatsits for local paragraph node}
+@d dir_node=7 {|subtype| in whatsits for change direction node}
+@z
+%-------------------------
+@x [53] m.1344
+primitive("localinterlinepenalty",assign_int,local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,local_broken_penalty_code);@/
+@y
+primitive("localinterlinepenalty",assign_int,local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,local_broken_penalty_code);@/
+primitive("pagedir",assign_dir,dir_base+page_direction_code);@/
+primitive("bodydir",assign_dir,dir_base+body_direction_code);@/
+primitive("pardir",assign_dir,dir_base+par_direction_code);@/
+primitive("textdir",assign_dir,dir_base+text_direction_code);@/
+primitive("mathdir",assign_dir,dir_base+math_direction_code);@/
+primitive("pageheight",assign_dimen,dimen_base+page_height_code);@/
+primitive("pagewidth",assign_dimen,dimen_base+page_width_code);@/
+{
+primitive("pagerightoffset",assign_dimen,dimen_base+page_right_offset_code);@/
+primitive("pagebottomoffset",assign_dimen,dimen_base+page_bottom_offset_code);@/
+}
+@z
+%-------------------------
+@x [53] m.1346
+ set_language_code:print_esc("setlanguage");
+ othercases print("[unknown extension!]")
+ endcases;
+@y
+ set_language_code:print_esc("setlanguage");
+ othercases print("[unknown extension!]")
+ endcases;
+@z
+%-------------------------
+@x [53] m.1348
+set_language_code:@<Implement \.{\\setlanguage}@>;
+@y
+set_language_code:@<Implement \.{\\setlanguage}@>;
+@z
+%-------------------------
+@x [53] m.1356
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+@y
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+dir_node:
+ if dir_dir(p)<0 then begin
+ print_esc("enddir"); print(" "); print_dir(dir_dir(p)+64);
+ end
+ else begin
+ print_esc("begindir"); print(" "); print_dir(dir_dir(p));
+ end;
+@z
+%-------------------------
+@x [53] m.1357
+close_node,language_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+@y
+close_node,language_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+dir_node: begin r:=get_node(dir_node_size);
+ words:=small_node_size;
+ end;
+@z
+%-------------------------
+@x [53] m.1358
+close_node,language_node: free_node(p,small_node_size);
+@y
+close_node,language_node: free_node(p,small_node_size);
+dir_node: free_node(p,dir_node_size);
+@z
+%-------------------------
+@x [53] m.1360
+@ @<Incorporate a whatsit node into an hbox@>=do_nothing
+@y
+@ @<Incorporate a whatsit node into an hbox@>=
+begin
+if subtype(p)=dir_node then
+ begin
+ @<DIR: Adjust the dir stack for the |hpack| routine@>;
+ end;
+end
+@z
+%-------------------------
+@x [53] m.1362
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p) else @<LOCAL: Advance past a |local_paragraph| node@>
+@y
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p) else @<LOCAL: Advance past a |local_paragraph| node@>
+else @<DIR: Adjust the dir stack for the |line_break| routine@>
+@z
+%-------------------------
+@x [53] m.1366
+@ @<Output the whatsit node |p| in an hlist@>=
+out_what(p)
+@y
+@ @<Output the whatsit node |p| in an hlist@>=
+if subtype(p)<>dir_node then out_what(p)
+else @<Output a reflection instruction if the direction has changed@>
+@z
+%-------------------------
+@x
+@d local_par_size==7
+@y
+@d local_par_dir(#)==mem[#+7].int
+@d local_par_size==8
+@z
+%-------------------------
+@x
+make_local_par_node:=p;
+@y
+local_par_dir(p):=par_direction;
+make_local_par_node:=p;
+@z
+%-------------------------
+@x
+@ @<LOCAL: local paragraph node@>=
+((type(q)=whatsit_node) and (subtype(q)=local_par_node))
+
+@y
+@ @<LOCAL: local paragraph node@>=
+((type(q)=whatsit_node) and (subtype(q)=local_par_node))
+
+@ @<DIR: Assign direction codes@>=
+case cur_chr of
+dir_base+page_direction_code: begin
+ if its_all_over then begin
+ scan_dir;
+ eq_word_define(dir_base+page_direction_code,cur_val);
+ end;
+ end;
+dir_base+body_direction_code: begin
+ if its_all_over then begin
+ scan_dir;
+ eq_word_define(dir_base+body_direction_code,cur_val);
+ end;
+ end;
+dir_base+par_direction_code: begin
+ scan_dir;
+ eq_word_define(dir_base+par_direction_code,cur_val);
+ end;
+dir_base+text_direction_code: begin scan_dir;
+ if (no_local_dirs>0) and (abs(mode)=hmode) then begin
+ @<DIR: Add local dir node@>;
+ dir_dir(tail):=dir_dir(tail)-64;
+ end;
+ if dir_level(text_dir_ptr)=cur_level then
+ @<DIR: Remove from |text_dir_ptr|@>;
+ eq_word_define(dir_base+text_direction_code,cur_val);
+ @<DIR: Add to |text_dir_ptr|@>;
+ if abs(mode)=hmode then
+ begin
+ @<DIR: Add local dir node@>;
+ dir_level(tail):=cur_level;
+ end;
+ eq_word_define(int_base+no_local_dirs_code,no_local_dirs+1);
+ eq_word_define(int_base+level_local_dir_code,cur_level);
+ end;
+dir_base+math_direction_code: begin scan_dir;
+ eq_word_define(dir_base+math_direction_code,cur_val);
+ end;
+end;
+
+@
+@d push_dir(#)==
+begin dir_tmp:=new_dir(#);
+link(dir_tmp):=dir_ptr; dir_ptr:=dir_tmp;
+dir_ptr:=dir_tmp;
+end
+
+@d push_dir_node(#)==
+begin dir_tmp:=get_node(dir_node_size);
+type(dir_tmp):=whatsit_node; subtype(dir_tmp):=dir_node;
+dir_dir(dir_tmp):=dir_dir(#);
+dir_level(dir_tmp):=dir_level(#);
+dir_dvi_h(dir_tmp):=dir_dvi_h(#);
+dir_dvi_ptr(dir_tmp):=dir_dvi_ptr(#);
+link(dir_tmp):=dir_ptr; dir_ptr:=dir_tmp;
+end
+
+@d pop_dir_node==
+begin dir_tmp:=dir_ptr;
+dir_ptr:=link(dir_tmp);
+free_node(dir_tmp,dir_node_size);
+end
+
+@ @<DIR: Declare |new_dir|@>=
+function new_dir(s:small_number): pointer;
+var p:pointer; {the new node}
+begin p:=get_node(dir_node_size); type(p):=whatsit_node;
+subtype(p):=dir_node; dir_dir(p):=s;
+dir_dvi_h(p):=0; dir_dvi_ptr(p):=-1;
+dir_level(p):=cur_level; new_dir:=p;
+end
+
+@ @<Append a begin direction to the tail of the current list@>=
+tail_append(new_dir(math_direction))
+
+@ @<Append an end direction to the tail of the current list@>=
+tail_append(new_dir(math_direction-64))
+
+@ @<DIR: Add local dir node@>=
+tail_append(new_dir(text_direction))
+
+@ @<DIR: Adjust the dir stack for the |line_break| routine@>=
+if subtype(cur_p)=dir_node then
+begin
+if dir_dir(cur_p)>=0 then begin
+ line_break_dir:=dir_dir(cur_p);
+ push_dir_node(cur_p);
+ end
+else begin
+ pop_dir_node;
+ line_break_dir:=dir_dir(dir_ptr);
+ end
+end
+
+@ @<DIR: Adjust the dir stack for the |hpack| routine@>=
+begin
+if dir_dir(p)>=0 then begin
+ hpack_dir:=dir_dir(p);
+ push_dir_node(p);
+ end
+else begin
+ pop_dir_node;
+ hpack_dir:=dir_dir(dir_ptr);
+ end
+end
+
+@ @<DIR: Insert dir nodes at the beginning of the current line@>=
+begin
+dir_rover:=dir_ptr;
+while dir_rover<>null do
+ begin
+ dir_tmp:=new_dir(dir_dir(dir_rover)); link(dir_tmp):=link(temp_head);
+ link(temp_head):=dir_tmp; dir_rover:=link(dir_rover);
+ end
+end
+
+@ @<DIR: Adjust the dir stack based on dir nodes in this line@>=
+begin flush_node_list(dir_ptr); dir_ptr:=null;
+q:=link(temp_head);
+while q<>cur_break(cur_p) do
+ begin if not is_char_node(q) then
+ if type(q)=whatsit_node then
+ if subtype(q)=dir_node then begin
+ if dir_dir(q)>=0 then begin
+ push_dir_node(q)
+ end
+ else if dir_ptr<>null then
+ if dir_dir(dir_ptr)=(dir_dir(q)+64) then begin
+ pop_dir_node;
+ end;
+ end;
+ q:=link(q);
+ end
+end
+
+@ @<DIR: Insert dir nodes at the end of the current line@>=
+if dir_ptr<>null then
+ begin
+ if link(r)=q then begin
+ dir_rover:=dir_ptr;
+ while dir_rover<>null do
+ begin
+ dir_tmp:=new_dir(dir_dir(dir_rover)-64);
+ link(dir_tmp):=q;
+ link(r):=dir_tmp;
+ r:=dir_tmp;
+ dir_rover:=link(dir_rover);
+ end;
+ end
+ else if r=final_par_glue then begin
+ s:=temp_head;
+ while link(s)<>r do
+ s:=link(s);
+ dir_rover:=dir_ptr;
+ while dir_rover<>null do
+ begin
+ dir_tmp:=new_dir(dir_dir(dir_rover)-64);
+ link(dir_tmp):=q;
+ link(s):=dir_tmp;
+ s:=dir_tmp;
+ dir_rover:=link(dir_rover);
+ end;
+ end
+ else begin
+ dir_rover:=dir_ptr;
+ s:=link(q);
+ while dir_rover<>null do
+ begin
+ dir_tmp:=new_dir(dir_dir(dir_rover)-64);
+ link(dir_tmp):=s;
+ link(q):=dir_tmp;
+ q:=dir_tmp;
+ dir_rover:=link(dir_rover);
+ end;
+ r:=q;
+ end
+ end
+
+@ @<DIR: Reset |dir_ptr|@>=
+begin
+ while dir_ptr<>null do
+ pop_dir_node
+end
+
+@ @<DIR: |unsave| math@>=
+begin
+unsave;
+decr(save_ptr);
+flush_node_list(text_dir_ptr);
+text_dir_ptr:=saved(0);
+end
+
+@ @<DIR: |new_save_level| math@>=
+begin
+saved(0):=text_dir_ptr;
+text_dir_ptr:=new_dir(math_direction);
+incr(save_ptr);
+new_save_level(c);
+eq_word_define(dir_base+body_direction_code,math_direction);
+eq_word_define(dir_base+par_direction_code,math_direction);
+eq_word_define(dir_base+text_direction_code,math_direction);
+eq_word_define(int_base+level_local_dir_code,cur_level);
+end
+
+@ @<DIR: Adjust |text_dir_ptr| for |scan_spec|@>=
+begin
+if spec_direction<>-1 then begin
+ saved(3):=text_dir_ptr;
+ text_dir_ptr:=new_dir(spec_direction);
+ end
+else saved(3):=null;
+end
+
+@ @<DIR: Adjust back |text_dir_ptr| for |scan_spec|@>=
+begin
+flush_node_list(text_dir_ptr);
+text_dir_ptr:=saved(4);
+end
+
+@ @<DIR: Add to |text_dir_ptr|@>=
+begin
+text_dir_tmp:=new_dir(text_direction);
+link(text_dir_tmp):=text_dir_ptr;
+text_dir_ptr:=text_dir_tmp;
+end
+
+@ @<DIR: Remove from |text_dir_ptr|@>=
+begin
+text_dir_tmp:=link(text_dir_ptr);
+free_node(text_dir_ptr,dir_node_size);
+text_dir_ptr:=text_dir_tmp;
+end
+
+@ @<DIR: Initialize |text_dir_ptr|@>=
+begin
+text_dir_ptr:=new_dir(0);
+end
+
+@ @<DIR: Initialize |dir_ptr| for |ship_out|@>=
+begin dir_ptr:=null; push_dir(dvi_direction);
+dir_dvi_ptr(dir_ptr):=dvi_ptr;
+end
+
+@ @<DIR: Initialize |dir_ptr| for |hpack|@>=
+begin dir_ptr:=null; push_dir(hpack_dir) end
+
+@ @<DIR: Initialize |dir_ptr| for |line_break|@>=
+begin dir_ptr:=null; push_dir(paragraph_dir); end
+
+@ @<Output a reflection instruction if the direction has changed@>=
+begin
+if dir_dir(p)>=0 then
+ begin synch_h; synch_v;
+ push_dir_node(p);
+ if dir_opposite(dir_secondary[dir_dir(dir_ptr)])(dir_secondary[dvi_direction])
+ then begin
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=2) then
+ dvi_out(down4)
+ else
+ dvi_out(right4);
+ dir_dvi_ptr(dir_ptr):=dvi_ptr;
+ dir_dvi_h(dir_ptr):=dvi_h;
+ dvi_four(0);
+ cur_h:=0; dvi_h:=0;
+ end
+ else begin
+ dir_dvi_ptr(dir_ptr):=dvi_ptr;
+ dir_dvi_h(dir_ptr):=dvi_h;
+ end;
+ dvi_direction:=dir_dir(dir_ptr);
+ end
+else begin
+ dvi_dir_h:=dir_dvi_h(dir_ptr);
+ dvi_dir_ptr:=dir_dvi_ptr(dir_ptr);
+ pop_dir_node;
+ synch_h; synch_v;
+ dvi_direction:=dir_dir(dir_ptr);
+ if dir_opposite(dir_secondary[dir_dir(p)+64])(dir_secondary[dvi_direction])
+ then begin
+ dvi_temp_ptr:=dvi_ptr;
+ dvi_ptr:=dvi_dir_ptr;
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=1) then
+ dvi_four(dvi_h)
+ else
+ dvi_four(-dvi_h);
+ dvi_ptr:=dvi_temp_ptr;
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=2) then
+ dvi_out(down4)
+ else
+ dvi_out(right4);
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=1) then
+ dvi_four(dvi_h)
+ else
+ dvi_four(-dvi_h);
+ end;
+ cur_h:=dvi_dir_h+dvi_h; dvi_h:=cur_h;
+ end
+end
+@z
diff --git a/Build/source/texk/web2c/omegadir-1.15/omega.c b/Build/source/texk/web2c/omegadir-1.15/omega.c
new file mode 100644
index 00000000000..5ab18251ba7
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omega.c
@@ -0,0 +1,480 @@
+/* omega.c: C routines to support the Omega Pascal Web distribution
+
+This file is part of the Omega project, which
+is based on the web2c distribution of TeX.
+
+Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#define EXTERN extern
+#include "omegad.h"
+
+void
+btestin(void)
+{
+ string fname =
+ kpse_find_file (nameoffile + 1, kpse_program_binary_format, true);
+
+ if (fname) {
+ libcfree(nameoffile);
+ nameoffile = xmalloc(2+strlen(fname));
+ namelength = strlen(fname);
+ strcpy(nameoffile+1, fname);
+ }
+ else {
+ libcfree(nameoffile);
+ nameoffile = xmalloc(2);
+ namelength = 0;
+ nameoffile[0] = 0;
+ nameoffile[1] = 0;
+ }
+}
+
+int
+getfilemode P2C(FILE *, f, int, def)
+{
+ int c,m;
+ if ((def==0)||(feof(f))) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0x5c) {
+ if (feof(f)) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0) m=4;
+ else m=1;
+ ungetc(c,f);
+ c=0x5c;
+ }
+ }
+ else if (c==0x25) {
+ if (feof(f)) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0) m=4;
+ else m=1;
+ ungetc(c,f);
+ c=0x25;
+ }
+ }
+ else if (c==0xe0) m=2;
+ else if (c==0x6c) m=2;
+ else if (c==0) {
+ if (feof(f)) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0x5c) m=3;
+ else if (c==0x25) m=3;
+ else m=def;
+ ungetc(c,f);
+ c=0;
+ }
+ }
+ else m=def;
+ ungetc(c,f);
+ }
+ return m;
+}
+
+int
+getc_two_LE P1C(FILE *, f)
+{
+ register int i,j;
+ i = getc(f);
+ if (i==EOF) { return i; }
+ j = getc(f);
+ if (j==EOF) { return j; }
+ return ((j<<8)|i);
+}
+
+void
+ungetc_two_LE P2C(int, c, FILE *, f)
+{
+ ungetc((c>>8), f);
+ ungetc((c&0377), f);
+}
+
+int
+getc_two P1C(FILE *, f)
+{
+ register int i,j;
+ i = getc(f);
+ if (i==EOF) { return i; }
+ j = getc(f);
+ if (j==EOF) { return j; }
+ return ((i<<8)|j);
+}
+
+void
+ungetc_two P2C(int, c, FILE *, f)
+{
+ ungetc((c&0377), f);
+ ungetc((c>>8), f);
+}
+
+extern boolean zpnewinputln ();
+
+boolean
+newinputln P4C(FILE *,f, halfword,themode, halfword,translation, boolean,bypass)
+{
+ return zpnewinputln((alphafile)f,
+ (halfword)themode,
+ (halfword)translation,
+ (boolean) bypass);
+}
+
+boolean
+new_input_line P2C(FILE *, f, halfword, themode)
+{
+ register int i=EOF;
+
+ last = first;
+ otpinputend = 0;
+
+ if (themode==1) {
+ while ((otpinputend < ocpbufsize) && ((i = getc (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc(f); if (i != '\n') ungetc(i,f);
+ }
+ } else if (themode==2) {
+ while ((otpinputend < ocpbufsize) && ((i = getc (f)) != EOF) &&
+ (i != 0x25))
+ otpinputbuf[++otpinputend] = i;
+ } else if (themode==3) {
+ while ((otpinputend < ocpbufsize) && ((i = getc_two (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc_two(f); if (i != '\n') ungetc_two(i,f);
+ }
+ } else /* themode==4 */ {
+ while ((otpinputend < ocpbufsize) && ((i = getc_two_LE (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc_two_LE(f); if (i != '\n') ungetc_two_LE(i,f);
+ }
+ }
+
+ if (i == EOF && otpinputend == 0)
+ return false;
+
+ /* We didn't get the whole line because our buffer was too small.
+*/
+ if (i != EOF && (((themode!=2) && (i != '\n')) || ((themode==2) && (i != 0x25))))
+ {
+ (void) fprintf (stderr,
+ "! Unable to read an entire line---ocp_buf_size=%ld.\n",ocpbufsize);
+ (void) fprintf (stderr, "Please increase ocp_buf_size in texmf.cnf.\n");
+ uexit (1);
+ }
+
+ return true;
+}
+
+extern memoryword ziniteqtbentry () ;
+
+hashword hashtable[HASHTABLESIZE];
+
+void
+inithhashtable P1H(void)
+{
+ int i;
+ for (i=0; i<HASHTABLESIZE; i++) {
+ hashtable[i].p = -1;
+ }
+
+}
+
+hashword *
+createeqtbpos P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return runner;
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return runner;
+ }
+ runner->p = p;
+ runner->mw = ziniteqtbentry(p);
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return runner;
+}
+
+memoryword *
+createeqtbptr P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return (&(runner->mw));
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return (&(runner->mw));
+ }
+ runner->p = p;
+ runner->mw = ziniteqtbentry(p);
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return (&(runner->mw));
+}
+
+hashword *
+createxeqlevel P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return runner;
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return runner;
+ }
+ runner->p = p;
+ runner->mw.cint = 1;
+ runner->mw.cint1 = 0;
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return runner;
+}
+
+hashword *
+createhashpos P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return runner;
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return runner;
+ }
+ runner->p = p;
+ runner->mw.cint = 0;
+ runner->mw.cint1 = 0;
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return runner;
+}
+
+void
+dumphhashtable P1H(void)
+{
+ int i;
+ hashword *runner;
+ for (i=0; i<HASHTABLESIZE; i++) {
+ runner=&(hashtable[i]);
+ if (runner->p != -1) {
+ dumpint(-i);
+ while (runner->p != -1) {
+ dumpint(runner->p);
+ dumpwd(runner->mw);
+ runner=runner->ptr;
+ }
+ }
+ }
+ dumpint(-HASHTABLESIZE);
+}
+
+void
+undumphhashtable P1H(void)
+{
+ int i,j;
+ hashword *runner;
+ j=0;
+ undumpint(i);
+ while (j<HASHTABLESIZE) {
+ i = (-i);
+ while (j<i) {
+ hashtable[j].p = -1;
+ j++;
+ }
+ if (i<HASHTABLESIZE) {
+ runner = &(hashtable[j]);
+ undumpint(i);
+ while (i>=0) {
+ runner->p = i;
+ undumpwd(runner->mw);
+ undumpint(i);
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ runner = runner->ptr;
+ }
+ runner->p = -1;
+ j++;
+ }
+ }
+}
+
+void
+odateandtime P4C(int,timecode, int,daycode, int,monthcode, int,yearcode)
+{
+ integer tc,dc,mc,yc;
+ dateandtime(tc,dc,mc,yc);
+ setneweqtbint(timecode,tc);
+ setneweqtbint(daycode,dc);
+ setneweqtbint(monthcode,mc);
+ setneweqtbint(yearcode,yc);
+}
+
+memoryword **fonttables;
+static int font_entries = 0;
+
+void
+allocatefonttable P2C(int, font_number, int, font_size)
+{
+ int i;
+ if (font_entries==0) {
+ fonttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ font_entries=256;
+ } else if ((font_number==256)&&(font_entries==256)) {
+ fonttables = xrealloc(fonttables, 65536);
+ font_entries=65536;
+ }
+ fonttables[font_number] =
+ (memoryword *) xmalloc((font_size+1)*sizeof(memoryword));
+ fonttables[font_number][0].cint = font_size;
+ fonttables[font_number][0].cint1 = 0;
+ for (i=1; i<=font_size; i++) {
+ fonttables[font_number][i].cint = 0;
+ fonttables[font_number][i].cint1 = 0;
+ }
+}
+
+void
+dumpfonttable P2C(int, font_number, int, words)
+{
+ fonttables[font_number][0].cint=words;
+ dumpthings(fonttables[font_number][0], fonttables[font_number][0].cint+1);
+}
+
+void
+undumpfonttable(font_number)
+int font_number;
+{
+ memoryword sizeword;
+ if (font_entries==0) {
+ fonttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ font_entries=256;
+ } else if ((font_number==256)&&(font_entries==256)) {
+ fonttables = xrealloc(fonttables, 65536);
+ font_entries=65536;
+ }
+
+ undumpthings(sizeword,1);
+ fonttables[font_number] =
+ (memoryword *) xmalloc((sizeword.cint+1)*sizeof(memoryword));
+ fonttables[font_number][0].cint = sizeword.cint;
+ undumpthings(fonttables[font_number][1], sizeword.cint);
+}
+
+memoryword **fontsorttables;
+static int fontsort_entries = 0;
+
+void
+allocatefontsorttable P2C(int, fontsort_number, int, fontsort_size)
+{
+ int i;
+ if (fontsort_entries==0) {
+ fontsorttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ fontsort_entries=256;
+ } else if ((fontsort_number==256)&&(fontsort_entries==256)) {
+ fontsorttables = xrealloc(fontsorttables, 65536);
+ fontsort_entries=65536;
+ }
+ fontsorttables[fontsort_number] =
+ (memoryword *) xmalloc((fontsort_size+1)*sizeof(memoryword));
+ fontsorttables[fontsort_number][0].cint = fontsort_size;
+ fontsorttables[fontsort_number][0].cint1 = 0;
+ for (i=1; i<=fontsort_size; i++) {
+ fontsorttables[fontsort_number][i].cint = 0;
+ fontsorttables[fontsort_number][i].cint1 = 0;
+ }
+}
+
+void
+dumpfontsorttable P2C(int, fontsort_number, int, words)
+{
+ fontsorttables[fontsort_number][0].cint=words;
+ dumpthings(fontsorttables[fontsort_number][0],
+ fontsorttables[fontsort_number][0].cint+1);
+}
+
+void
+undumpfontsorttable(fontsort_number)
+int fontsort_number;
+{
+ memoryword sizeword;
+ if (fontsort_entries==0) {
+ fontsorttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ fontsort_entries=256;
+ } else if ((fontsort_number==256)&&(fontsort_entries==256)) {
+ fontsorttables = xrealloc(fontsorttables, 65536);
+ fontsort_entries=65536;
+ }
+
+ undumpthings(sizeword,1);
+ fontsorttables[fontsort_number] =
+ (memoryword *) xmalloc((sizeword.cint+1)*sizeof(memoryword));
+ fontsorttables[fontsort_number][0].cint = sizeword.cint;
+ undumpthings(fontsorttables[fontsort_number][1], sizeword.cint);
+}
+
+int **ocptables;
+static int ocp_entries = 0;
+
+void
+allocateocptable P2C(int, ocp_number, int, ocp_size)
+{
+ int i;
+ if (ocp_entries==0) {
+ ocptables = (int **) xmalloc(256*sizeof(int**));
+ ocp_entries=256;
+ } else if ((ocp_number==256)&&(ocp_entries==256)) {
+ ocptables = xrealloc(ocptables, 65536);
+ ocp_entries=65536;
+ }
+ ocptables[ocp_number] =
+ (int *) xmalloc((1+ocp_size)*sizeof(int));
+ ocptables[ocp_number][0] = ocp_size;
+ for (i=1; i<=ocp_size; i++) {
+ ocptables[ocp_number][i] = 0;
+ }
+}
+
+void
+dumpocptable P1C(int, ocp_number)
+{
+ dumpthings(ocptables[ocp_number][0], ocptables[ocp_number][0]+1);
+}
+
+void
+undumpocptable P1C(int, ocp_number)
+{
+ int sizeword;
+ if (ocp_entries==0) {
+ ocptables = (int **) xmalloc(256*sizeof(int**));
+ ocp_entries=256;
+ } else if ((ocp_number==256)&&(ocp_entries==256)) {
+ ocptables = xrealloc(ocptables, 65536);
+ ocp_entries=65536;
+ }
+ undumpthings(sizeword,1);
+ ocptables[ocp_number] =
+ (int *) xmalloc((1+sizeword)*sizeof(int));
+ ocptables[ocp_number][0] = sizeword;
+ undumpthings(ocptables[ocp_number][1], sizeword);
+}
diff --git a/Build/source/texk/web2c/omegadir-1.15/omega.defines b/Build/source/texk/web2c/omegadir-1.15/omega.defines
new file mode 100644
index 00000000000..2a7ef420b77
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omega.defines
@@ -0,0 +1,73 @@
+{ omega.defines: Web declarations of Omega
+
+This file is part of the Omega project, which
+is based on the web2c distribution of TeX.
+
+Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+}
+
+@define function newinputln ();
+@define function getfilemode ();
+@define function newinputline ();
+@define function neweqtb ();
+@define function neweqtbint ();
+@define function neweqtbsc ();
+@define function newequiv ();
+@define function newequiv1 ();
+@define function neweqlevel ();
+@define function neweqtype ();
+
+@define function newhashnext ();
+@define function newhashtext ();
+@define function newxeqlevel ();
+
+@define procedure odateandtime ();
+@define procedure allocatefonttable ();
+@define procedure dumpfonttable ();
+@define procedure undumpfonttable ();
+@define procedure allocatefontsorttable ();
+@define procedure dumpfontsorttable ();
+@define procedure undumpfontsorttable ();
+@define procedure allocateocptable ();
+@define procedure dumpocptable ();
+@define procedure undumpocptable ();
+@define procedure initeqtbtable;
+@define procedure dumpeqtbtable;
+@define procedure undumpeqtbtable;
+@define procedure setneweqtb ();
+@define procedure setneweqtbint ();
+@define procedure setneweqtbsc ();
+@define procedure setequiv ();
+@define procedure setequiv1 ();
+@define procedure seteqtype ();
+@define procedure seteqlevel ();
+@define procedure btestin ;
+@define procedure runexternalocp ();
+
+@define procedure sethashnext ();
+@define procedure sethashtext ();
+@define procedure setintzero ();
+@define procedure setintone ();
+
+@define var fonttables;
+@define var fontsorttables;
+@define var ocptables;
+
+@define var ocptemp;
+
+{ end of omega.defines }
diff --git a/Build/source/texk/web2c/omegadir-1.15/omega.mak b/Build/source/texk/web2c/omegadir-1.15/omega.mak
new file mode 100644
index 00000000000..ffe7142ec58
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omega.mak
@@ -0,0 +1,272 @@
+################################################################################
+#
+# Makefile : Omega, web2c win32.mak makefile fragment to build Omega
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/03/15 12:23:15 popineau>
+#
+################################################################################
+
+Makefile: $(win32make_srcdir)/omega.mak
+
+omegadir = omegadir-1.15
+
+omegafonts_programs = omegafonts\$(objdir)\omfonts.exe
+otps_programs = otps\$(objdir)\otp2ocp.exe otps\$(objdir)\outocp.exe
+omegafonts = omegafonts
+otps = otps
+
+odvicopy = $(objdir)\odvicopy.exe
+odvitype = $(objdir)\odvitype.exe
+otangle = $(objdir)\otangle.exe
+omegaware_c = odvicopy.c odvitype.c otangle.c
+omegaware_programs = $(otangle) $(odvicopy) $(odvitype)
+
+omega_programs = $(otangle) $(odvicopy) $(odvitype) \
+ $(otps_programs) $(omegafonts_programs)
+
+# Omegaware
+
+$(objdir)\odvicopy.exe: $(objdir)\odvicopy.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+
+odvicopy.c odvicopy.h: $(web2c_common) $(web2c_programs) odvicopy.p
+ $(web2c) odvicopy
+odvicopy.p: omegaware\odvicopy.web omegaware\odvicopy.ch
+ .\$(objdir)\tangle omegaware\odvicopy.web omegaware\odvicopy.ch
+check: odvicopy-check
+odvicopy-check: $(objdir)\odvicopy.exe
+# ./odvicopy $(srcdir)/tests/story tests/xstory.dvi
+## Redirect stderr so the terminal output will end up in the log file.
+# (TFMFONTS=$(srcdir)/tests: ./odvicopy <$(srcdir)/tests/pplr.dvi \
+# >tests/xpplr.dvi) 2>&1
+clean:: odvicopy-clean
+odvicopy-clean:
+# $(LIBTOOL) --mode=clean $(RM) odvicopy
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\odvicopy.obj odvicopy.c odvicopy.h odvicopy.p) do $(del) %%i $(redir_stderr) \
+ )
+# rm -f tests/xstory.dvi tests/xpplr.dvi
+
+$(objdir)\odvitype.exe: $(objdir)\odvitype.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+
+odvitype.c odvitype.h: $(web2c_common) $(web2c_programs) odvitype.p
+ $(web2c) odvitype
+
+odvitype.p: $(objdir)\tangle.exe omegaware\odvitype.web omegaware\odvitype.ch
+ $(objdir)\tangle.exe omegaware\odvitype.web omegaware\odvitype.ch
+check: odvitype-check
+odvitype-check: $(objdir)\odvitype.exe
+# ./odvitype -show-opcodes $(srcdir)/tests/story >tests/xstory.dvityp
+# ./odvitype --p=\*.\*.2 $(srcdir)/tests/pagenum.dvi >tests/xpagenum.typ
+clean:: odvitype-clean
+odvitype-clean:
+# $(LIBTOOL) --mode=clean $(RM) odvitype
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\odvitype.obj odvitype.c odvitype.h odvitype.p) do $(del) %%i $(redir_stderr) \
+ )
+# -$(del) tests/xstory.dvityp tests/xpagenum.typ
+
+$(objdir)\otangle.exe: $(objdir)\otangle.obj $(objdir)\otangle.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+otangle.c otangle.h: $(web2c_common) $(web2c_programs) otangle.p
+ $(web2c) otangle
+otangle.p: $(objdir)\tangle.exe omegaware\otangle.web omegaware\otangle.ch
+ $(objdir)\tangle omegaware\otangle.web omegaware\otangle.ch
+check: otangle-check
+otangle-check: otangle
+# otangling omega is a good check already
+clean:: otangle-clean
+otangle-clean:
+# $(LIBTOOL) --mode=clean $(RM) otangle
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\otangle.obj otangle.c otangle.h otangle.p) do $(del) %%i $(redir_stderr) \
+ )
+#
+# Omega itself.
+
+# We build omega
+omega = $(objdir)\omega.exe
+!ifdef TEX_DLL
+omega = $(omega) $(objdir)\$(library_prefix)omega.dll
+!endif
+
+omega_programs = $(omega) $(omega_programs)
+
+# The C sources.
+omega_c = omega.c
+omega_o = $(objdir)\omega.obj $(objdir)\omegafirst.obj $(objdir)\omegabis.obj
+
+# Linking
+!ifdef TEX_DLL
+$(ojbdir)\$(library_prefix)omega.exp: $(objdir)\$(library_prefix)omega.lib
+
+$(objdir)\$(library_prefix)omega.lib: $(omega_o)
+ $(archive) /DEF $(omega_o)
+
+$(objdir)\$(library_prefix)omega.dll: $(omega_o) $(objdir)\$(library_prefix)omega.exp $(objdir)\omega.res $(omegalibsdep) $(kpathsealib) $(proglib)
+ $(link_dll) $(**) $(conlibs)
+
+$(objdir)\omega.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)omega.lib $(proglib)
+ $(link) $(**) $(socketslib) $(conlibs)
+!else
+$(objdir)\omega.exe: $(omega_o) $(objdir)\win32main.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(socketlibs) $(conlibs)
+!endif
+
+
+# The C files
+$(omega_c) omegacoerce.h omegad.h: omega.p $(web2c_texmf)
+ $(web2c) omega
+# Additional C files, just copy them.
+omegafirst.c: $(omegadir)\omega.c
+ -$(del) $@
+ @$(copy) $(srcdir)\$(omegadir)\omega.c $@ $(redir_stdout)
+omegabis.c: $(omegadir)\omegabis.c
+ -$(del) $@
+ @$(copy) $(srcdir)\$(omegadir)\omegabis.c $@ $(redir_stdout)
+omegamem.h: $(omegadir)\omegamem.h
+ -$(del) $@
+ @$(copy) $(srcdir)\$(omegadir)\omegamem.h $@ $(redir_stdout)
+
+# The Pascal file
+omega.p omega.pool: $(objdir)\otangle.exe omega.web omega.ch
+ $(objdir)\otangle omega.web omega.ch
+
+# Generation of the web and ch files.
+omega_files = \
+# $(omegadir)\omnode.ch \
+ $(omegadir)\om16bit.ch \
+ $(omegadir)\omstr.ch \
+ $(omegadir)\omfont.ch \
+ $(omegadir)\omchar.ch \
+ $(omegadir)\omfi.ch \
+ $(omegadir)\ompar.ch \
+ $(omegadir)\omocp.ch \
+ $(omegadir)\omfilter.ch \
+ $(omegadir)\omtrans.ch \
+ $(omegadir)\omdir.ch \
+# $(omegadir)\omxml.ch
+
+omega_changefiles = \
+# $(omegadir)\comnode.ch \
+ $(omegadir)\com16bit.ch \
+ $(omegadir)\comstr.ch \
+ $(omegadir)\comfont.ch \
+ $(omegadir)\comchar.ch \
+ $(omegadir)\comfi.ch \
+ $(omegadir)\compar.ch \
+ $(omegadir)\comocp.ch \
+ $(omegadir)\comfilter.ch \
+ $(omegadir)\comtrans.ch \
+ $(omegadir)\comdir.ch \
+# $(omegadir)\comxml.ch \
+ $(omegadir)\comsrcspec.ch \
+ $(omegadir)\comw32.ch
+
+omega.web: .\$(objdir)\tie.exe tex.web $(omega_files) # $(omegadir)\omega.mak
+ .\$(objdir)\tie -m omega.web tex.web $(omega_files)
+
+omega.ch: .\$(objdir)\tie.exe omega.web $(omega_changefiles) # $(omegadir)\omega.mak
+ .\$(objdir)\tie -c omega.ch omega.web $(omega_changefiles)
+
+# Check: right now all we do is build the format.
+check: omega-check
+omega-check: omega omega.oft
+# Cleaning up from building omega
+clean:: omega-clean
+omega-clean:
+# $(LIBTOOL) --mode=clean $(RM) omega
+ -@echo $(verbose) & ( \
+ for %%i in ($(omega_o) $(omega_c) omegaextra.c omegacoerce.h omegad.h \
+ omegafirst.c omegabis.c omegamem.h \
+ omega.p omega.pool omega.web omega.ch) do $(del) %%i $(redir_stderr) \
+ )
+#
+# Dumps.
+all_ofmts = omega.oft $(ofmts)
+
+dumps: ofmts
+ofmts: $(all_ofmts)
+
+omega.oft: $(omega)
+ $(dumpenv) $(make) progname=omega files="omega.tex" prereq-check
+ $(dumpenv) .\$(objdir)\omega.exe --progname=omega --jobname=omega --ini "\input omega.tex \dump" < nul
+
+lambda.oft: $(omega)
+ $(dumpenv) $(make) progname=lambda files="lambda.tex" prereq-check
+ $(dumpenv) .\$(objdir)\omega.exe --progname=lambda --jobname=lambda --ini "\input lambda.tex" < nul
+
+#
+# Some additional programs for Omega: the programs themselves are named
+# in the variable otps_programs, defined above.
+otps\$(objdir)\otp2ocp.exe otps\$(objdir)\outocp.exe:
+ -@echo $(verbose) & ( \
+ pushd otps & $(make) all & popd \
+ )
+omegafonts\$(objdir)\omfonts.exe:
+ -@echo $(verbose) & ( \
+ pushd omegafonts & $(make) all & popd \
+ )
+#
+# Installation.
+install-omega: install-omega-exec install-omega-data
+install-omega-exec: install-omega-links
+# install-omega-data: install-omega-dumps
+install-omega-dumps: install-omega-fmts
+
+# The actual binary executables and pool files.
+install-programs: install-omega-programs
+install-omega-programs: $(omega_programs) $(bindir)
+ -@echo $(verbose) & ( \
+ for %p in ($(eomega)) do copy %%p $(bindir) \
+ )
+ -@echo $(verbose) & ( \
+ pushd otps & $(make) install-programs & popd \
+ )
+ -@echo $(verbose) & ( \
+ pushd omegafonts & $(make) install-programs & popd \
+ )
+
+install-links: install-omega-links
+install-omega-links: install-omega-programs
+ -@echo $(verbose) & ( \
+ pushd omegafonts & $(make) install-links & popd \
+ )
+# -@echo $(verbose) & ( \
+# pushd $(bindir) & \
+# $(del) .\iniomega.exe .\viromega.exe & \
+# $(lnexe) .\omega.exe $(bindir)\iniomega.exe & \
+# $(lnexe) .\omega.exe $(bindir)\viromega.exe & \
+# popd \
+# ) $(redir_stdout)
+ -@echo $(verbose) & ( \
+ if not "$(ofmts)"=="" \
+ for %%i in ($(ofmts)) do \
+ pushd $(bindir) & \
+ $(del) .\%%~ni.exe & \
+ $(lnexe) .\omega.exe $(bindir)\%%~ni.exe & \
+ popd \
+ ) $(redir_stdout)
+
+# Always do plain.*, so examples from the TeXbook (etc.) will work.
+install-fmts: install-omega-fmts
+install-omega-fmts: ofmts $(fmtdir)
+ -@echo $(verbose) & ( \
+ if not "$(all_ofmts)"=="" \
+ for %%f in ($(all_ofmts)) do \
+ $(copy) %%f $(fmtdir)\%%f $(redir_stdout) \
+ )
+
+# Auxiliary files.
+install-data:: install-omega-data
+install-omega-data: $(texpooldir)
+ @$(copy) omega.pool $(texpooldir)\omega.pool $(redir_stdout) $(redir_stdout)
+
+# end of omega.mak
+#
+# Local variables:
+# page-delimiter: "^# \f"
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/omegadir-1.15/omega.mk b/Build/source/texk/web2c/omegadir-1.15/omega.mk
new file mode 100644
index 00000000000..224c8f4876f
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omega.mk
@@ -0,0 +1,173 @@
+# Makefile fragment for Omega and web2c. --infovore@xs4all.nl. Public domain.
+# This fragment contains the parts of the makefile that are most likely to
+# differ between releases of Omega.
+
+Makefile: $(srcdir)/omegadir/omega.mk
+
+omegaware_programs = otangle odvicopy odvitype
+
+omega_programs = $(omega) $(otangle) $(odvicopy) $(odvitype) \
+ $(otps_programs) $(omegafonts_programs)
+
+# The C sources.
+omega_c = omegaini.c omega0.c omega1.c omega2.c omega3.c
+omegaware_c = odvicopy.c odvitype.c otangle.c
+omega_o = omegaini.o omega0.o omega1.o omega2.o omega3.o \
+ omegaextra.o omega.o omegabis.o
+
+# Generation of the web and ch files.
+odvicopy.web: omegaware/odvicopy.web
+ rm -f $@
+ $(LN) $(srcdir)/omegaware/odvicopy.web $@
+odvicopy.ch: omegaware/odvicopy.ch
+ rm -f $@
+ $(LN) $(srcdir)/omegaware/odvicopy.ch $@
+odvitype.web: omegaware/odvitype.web
+ rm -f $@
+ $(LN) $(srcdir)/omegaware/odvitype.web $@
+odvitype.ch: omegaware/odvitype.ch
+ rm -f $@
+ $(LN) $(srcdir)/omegaware/odvitype.ch $@
+omega.web: tie tex.web
+omega.web: omegadir/om16bit.ch
+omega.web: omegadir/omstr.ch
+omega.web: omegadir/omfont.ch
+omega.web: omegadir/omchar.ch
+omega.web: omegadir/omfi.ch
+omega.web: omegadir/ompar.ch
+omega.web: omegadir/omocp.ch
+omega.web: omegadir/omfilter.ch
+omega.web: omegadir/omtrans.ch
+omega.web: omegadir/omdir.ch
+omega.web: omegadir/omxml.ch
+ ./tie -m omega.web $(srcdir)/tex.web \
+ $(srcdir)/omegadir/om16bit.ch \
+ $(srcdir)/omegadir/omstr.ch \
+ $(srcdir)/omegadir/omfont.ch \
+ $(srcdir)/omegadir/omchar.ch \
+ $(srcdir)/omegadir/omfi.ch \
+ $(srcdir)/omegadir/ompar.ch \
+ $(srcdir)/omegadir/omocp.ch \
+ $(srcdir)/omegadir/omfilter.ch \
+ $(srcdir)/omegadir/omtrans.ch \
+ $(srcdir)/omegadir/omdir.ch \
+ $(srcdir)/omegadir/omxml.ch
+omega.ch: tie omega.web
+omega.ch: omegadir/com16bit.ch
+omega.ch: omegadir/comstr.ch
+omega.ch: omegadir/comfont.ch
+omega.ch: omegadir/comchar.ch
+omega.ch: omegadir/comfi.ch
+omega.ch: omegadir/compar.ch
+omega.ch: omegadir/comocp.ch
+omega.ch: omegadir/comfilter.ch
+omega.ch: omegadir/comtrans.ch
+omega.ch: omegadir/comdir.ch
+omega.ch: omegadir/comxml.ch
+omega.ch: omegadir/comsrcspec.ch
+ ./tie -c omega.ch omega.web \
+ $(srcdir)/omegadir/com16bit.ch \
+ $(srcdir)/omegadir/comstr.ch \
+ $(srcdir)/omegadir/comfont.ch \
+ $(srcdir)/omegadir/comchar.ch \
+ $(srcdir)/omegadir/comfi.ch \
+ $(srcdir)/omegadir/compar.ch \
+ $(srcdir)/omegadir/comocp.ch \
+ $(srcdir)/omegadir/comfilter.ch \
+ $(srcdir)/omegadir/comtrans.ch \
+ $(srcdir)/omegadir/comdir.ch \
+ $(srcdir)/omegadir/comxml.ch \
+ $(srcdir)/omegadir/comsrcspec.ch
+otangle.web: omegaware/otangle.web
+ rm -f $@
+ $(LN) $(srcdir)/omegaware/otangle.web $@
+otangle.ch: omegaware/otangle.ch
+ rm -f $@
+ $(LN) $(srcdir)/omegaware/otangle.ch $@
+
+# Bootstrapping otangle requires making it with itself.
+otangle: otangle.o
+ $(kpathsea_link) otangle.o $(LOADLIBES)
+ $(MAKE) $(common_makeargs) otangleboot.p
+# otangle.p is a special case, since it is needed to compile itself. We
+# convert and compile the (distributed) otangleboot.p to make a otangle
+# which we use to make the other programs.
+otangle.p: otangleboot otangle.web otangle.ch
+ $(shared_env) ./otangleboot otangle.web otangle.ch
+
+otangleboot: otangleboot.o
+ $(kpathsea_link) otangleboot.o $(LOADLIBES)
+otangleboot.c otangleboot.h: stamp-otangle $(web2c_programs) $(web2c_aux)
+ $(web2c) otangleboot
+# omegaware/otangleboot.p is in the distribution.
+stamp-otangle: omegaware/otangleboot.p
+ rm -f otangleboot.p
+ $(LN) $(srcdir)/omegaware/otangleboot.p otangleboot.p
+ date >stamp-otangle
+# This is not run unless otangle.web or otangle.ch is changed.
+otangleboot.p: omegaware/otangle.web omegaware/otangle.ch
+ $(shared_env) ./otangle otangle.web otangle.ch
+ test -d omegaware || mkdir omegaware
+ mv otangle.p omegaware/otangleboot.p
+ rm -f otangleboot.p
+ $(LN) omegaware/otangleboot.p otangleboot.p
+ date >stamp-otangle
+ $(MAKE) $(common_makeargs) otangle
+
+# Three additional files
+omega.c: omegadir/omega.c
+ rm -f $@
+ $(LN) $(srcdir)/omegadir/omega.c $@
+omegabis.c: omegadir/omegabis.c
+ rm -f $@
+ $(LN) $(srcdir)/omegadir/omegabis.c $@
+omegamem.h: omegadir/omegamem.h
+ rm -f $@
+ $(LN) $(srcdir)/omegadir/omegamem.h $@
+
+# Some additional programs for Omega: the programs themselves are named
+# in the variable otps_programs, defined above.
+otps/otp2ocp:
+ cd otps && $(MAKE) $(common_makeargs) otp2ocp
+otps/outocp:
+ cd otps && $(MAKE) $(common_makeargs) outocp
+omegafonts/omfonts:
+ cd omegafonts && $(MAKE) $(common_makeargs) omfonts
+
+install-omega: install-omega-exec install-omega-data
+install-omega-exec:: install-omega-links
+install-omega-data:: install-omega-dumps
+
+# The actual binary executables and pool files.
+install-omega-programs: $(omega_programs)
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(bindir)
+ for p in omega; do $(INSTALL_LIBTOOL_PROG) $(bindir) $$p; done
+ cd otps && $(MAKE) $(install_makeargs) install-programs
+ cd omegafonts && $(MAKE) $(install_makeargs) install-programs
+
+# The links to {mf,mp,tex} for each format and for {ini,vir}{mf,mp,tex},
+# plus the equivalents for e-TeX, Omega, pdfTeX, and pdfeTeX.
+install-omega-links: install-omega-programs
+ cd omegafonts && $(MAKE) $(install_makeargs) install-links
+ cd $(bindir) && (rm -f iniomega viromega; \
+ $(LN) omega iniomega; $(LN) omega viromega)
+# The ugly "" avoids a syntax error in case the lists are empty.
+ test -z "$(ofmts)" || \
+ for f in ""$(ofmts); do base=`basename $$f .fmt`; \
+ (cd $(bindir) && (rm -f $$base; $(LN) omega $$base)); done
+
+# Always do plain.*, so examples from the TeXbook (etc.) will work.
+install-omega-dumps: install-omega-fmts
+install-omega-fmts: ofmts
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(fmtdir)
+ test -z "$(all_ofmts)" || \
+ for f in ""$(all_ofmts); \
+ do $(INSTALL_DATA) $$f $(fmtdir)/$$f; done
+
+# Auxiliary files.
+install-omega-data::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(texpooldir)
+ $(INSTALL_DATA) omega.pool $(texpooldir)/omega.pool
+ $(INSTALL_DATA) $(srcdir)/tiedir/tie.1 $(mandir)/tie.$(manext)
+
+# end of omega.mk
diff --git a/Build/source/texk/web2c/omegadir-1.15/omega.version b/Build/source/texk/web2c/omegadir-1.15/omega.version
new file mode 100644
index 00000000000..d40acaaea09
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omega.version
@@ -0,0 +1 @@
+1.15
diff --git a/Build/source/texk/web2c/omegadir-1.15/omegabis.c b/Build/source/texk/web2c/omegadir-1.15/omegabis.c
new file mode 100644
index 00000000000..1b790d4970e
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omegabis.c
@@ -0,0 +1,298 @@
+/* omegabis.c: C routines to support external OCPs
+
+This file is part of the Omega project, which
+is based on the web2c distribution of TeX.
+
+Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#define EXTERN extern
+#include <stdlib.h>
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+#include "omegad.h"
+#undef read
+
+#if 1
+
+void
+runexternalocp P1C(string, external_ocp_name)
+{
+ char *in_file_name;
+ char *out_file_name;
+ FILE *in_file;
+ FILE *out_file;
+ char command_line[400];
+ int i;
+ unsigned c;
+ int c_in;
+#ifdef WIN32
+ char *tempenv;
+
+#define null_string(s) ((s == NULL) || (*s == '\0'))
+
+ tempenv = getenv("TMPDIR");
+ if (null_string(tempenv))
+ tempenv = getenv("TEMP");
+ if (null_string(tempenv))
+ tempenv = getenv("TMP");
+ if (null_string(tempenv))
+ tempenv = "c:/tmp"; /* "/tmp" is not good if we are on a CD-ROM */
+ in_file_name = concat(tempenv, "/__omega__in__XXXXXX");
+ mktemp(in_file_name);
+#else
+ in_file_name = strdup("/tmp/__omega__in__XXXXXX");
+ mkstemp(in_file_name);
+#endif /* WIN32 */
+
+ in_file = fopen(in_file_name, FOPEN_WBIN_MODE);
+
+ for (i=1; i<=otpinputend; i++) {
+ c = otpinputbuf[i];
+ if (c>0xffff) {
+ fprintf(stderr, "Omega does not currently support 31-bit chars\n");
+ exit(1);
+ }
+ if (c>0x4000000) {
+ fputc(0xfc | ((c>>30) & 0x1), in_file);
+ fputc(0x80 | ((c>>24) & 0x3f), in_file);
+ fputc(0x80 | ((c>>18) & 0x3f), in_file);
+ fputc(0x80 | ((c>>12) & 0x3f), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c>0x200000) {
+ fputc(0xf8 | ((c>>24) & 0x3), in_file);
+ fputc(0x80 | ((c>>18) & 0x3f), in_file);
+ fputc(0x80 | ((c>>12) & 0x3f), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c>0x10000) {
+ fputc(0xf0 | ((c>>18) & 0x7), in_file);
+ fputc(0x80 | ((c>>12) & 0x3f), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c>0x800) {
+ fputc(0xe0 | ((c>>12) & 0xf), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c>0x80) {
+ fputc(0xc0 | ((c>>6) & 0x1f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else {
+ fputc(c & 0x7f, in_file);
+ }
+ }
+ fclose(in_file);
+
+#define advance_cin if ((c_in = fgetc(out_file)) == -1) { \
+ fprintf(stderr, "File contains bad char\n"); \
+ goto end_of_while; \
+ }
+
+#ifdef WIN32
+ out_file_name = concat(tempenv, "/__omega__out__XXXXXX");
+ mktemp(out_file_name);
+#else
+ out_file_name = strdup("/tmp/__omega__out__XXXXXX");
+ mkstemp(out_file_name);
+#endif
+
+ sprintf(command_line, "%s <%s >%s\n",
+ external_ocp_name+1, in_file_name, out_file_name);
+ system(command_line);
+ out_file = fopen(out_file_name, FOPEN_RBIN_MODE);
+ otpoutputend = 0;
+ otpoutputbuf[otpoutputend] = 0;
+ while ((c_in = fgetc(out_file)) != -1) {
+ if (c_in>=0xfc) {
+ c = (c_in & 0x1) << 30;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 24;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 18;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 12;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else if (c_in>=0xf8) {
+ c = (c_in & 0x3) << 24;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 18;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 12;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else if (c_in>=0xf0) {
+ c = (c_in & 0x7) << 18;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 12;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else if (c_in>=0xe0) {
+ c = (c_in & 0xf) << 12;
+ {advance_cin}
+ c |= (c_in & 0x3f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else if (c_in>=0x80) {
+ c = (c_in & 0x1f) << 6;
+ {advance_cin}
+ c |= c_in & 0x3f;
+ } else {
+ c = c_in & 0x7f;
+ }
+ otpoutputbuf[++otpoutputend] = c;
+ }
+
+end_of_while:
+ remove(in_file_name);
+ remove(out_file_name);
+}
+
+#else
+
+void
+runexternalocp P1C(string, external_ocp_name)
+{
+ int outpipes[2], inpipes[2];
+ char *outbuf;
+ char *inbuf;
+ int n;
+ int chars_read_in, chars_to_go_out;
+ int myerrno;
+
+#ifdef WIN32
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+ HANDLE hIn, hOut, hPipeIn, hPipeOut;
+ SECURITY_ATTRIBUTES sa = { sizeof(SECURITY_ATTRIBUTES), NULL, TRUE };
+ DWORD ret = 0;
+
+ /* Make pipes to send data from the parent to the child. The parent
+ writes to outpipes[0], and the child reads from outpipes[1]. */
+ _pipe (outpipes, 0, _O_BINARY);
+ /* Make pipes to send data from the child to the parent. The child
+ writes to inpipes[0], and the parent reads from inpipes[1]. */
+ _pipe (inpipes, 0, _O_BINARY);
+
+ ZeroMemory( &si, sizeof(STARTUPINFO) );
+ si.cb = sizeof(STARTUPINFO);
+ si.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
+ si.wShowWindow = SW_SHOW;
+ si.hStdInput = _get_osfhandle(outpipes[0]);
+ si.hStdOutput = _get_osfhandle(inpipes[1]);
+ si.hStdError = _get_osfhandle(_fileno(stderr));
+
+ /* Close unnecessary pipes. */
+ close (outpipes[1]);
+ close (inpipes[0]);
+
+ if (CreateProcess(external_ocp_name+1,
+ NULL, /* Use lpApplicationName */
+ NULL,
+ NULL,
+ TRUE, /* bInheritHandles */
+ 0,
+ NULL,
+ NULL,
+ &si,
+ &pi) == 0) {
+ fprintf(stderr, "Failed to create process for %s (Error %d).\n", external_ocp_name+1, GetLastError());
+ return;
+ }
+
+#else /* ! WIN32 */
+
+ /* Make pipes to send data from the parent to the child. The parent
+ writes to outpipes[0], and the child reads from outpipes[1]. */
+ pipe (outpipes);
+ /* Make pipes to send data from the child to the parent. The child
+ writes to inpipes[0], and the parent reads from inpipes[1]. */
+ pipe (inpipes);
+
+ /* For a child process. */
+ if (fork () == 0)
+ {
+ /* This part is executed by the child process. It translates
+ lower case letters to upper case. */
+
+ char *prog = external_ocp_name+1;
+ char *args[] = {external_ocp_name+1, NULL};
+
+ /* Close unnecessary pipes. They are for the parent. */
+ close (outpipes[1]);
+ close (inpipes[0]);
+
+ /* Connect pipes to stdin and stdout. */
+ dup2 (outpipes[0], 0);
+ dup2 (inpipes[1], 1);
+
+ /* Overlays a new process image on an old process. */
+ execv (prog, args);
+
+ /* We should never reach here. */
+ }
+ else
+ {
+ /* Close unnecessary pipes. They are for the child. */
+ close (outpipes[0]);
+ close (inpipes[1]);
+
+#endif /* WIN32 */
+
+/* Here is the interesting part */
+ outbuf = ((char *) otpinputbuf)+2;
+ inbuf = ((char *) otpoutputbuf)+2;
+ chars_to_go_out = 2*otpinputend;
+ chars_read_in = 0;
+ while ((n = write (outpipes[1], outbuf, chars_to_go_out))>0) {
+fprintf(stderr, "Wrote (1) %d characters\n", n);
+ outbuf+=n;
+ chars_to_go_out-=n;
+ if (chars_to_go_out==0) goto done_writing;
+/*
+ n = read (inpipes[0], inbuf, 1024);
+fprintf(stderr, "Read (1) %d characters\n", n);
+ inbuf+=n;
+ chars_read_in+=n;
+*/
+ }
+fprintf(stderr, "Wrote (2) %d characters\n", n);
+
+done_writing:
+ close (outpipes[1]);
+ while ((n = read (inpipes[0], inbuf, 1024)) > 0) {
+fprintf(stderr, "Read (2) %d characters\n", n);
+ inbuf+=n;
+ chars_read_in+=n;
+ }
+fprintf(stderr, "Read (3) %d characters\n", n);
+ otpoutputend = chars_read_in / 2;
+
+ close (inpipes[0]);
+#ifndef WIN32
+ }
+#endif
+}
+
+#endif
diff --git a/Build/source/texk/web2c/omegadir-1.15/omegaextra.h b/Build/source/texk/web2c/omegadir-1.15/omegaextra.h
new file mode 100644
index 00000000000..cf0863a7426
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omegaextra.h
@@ -0,0 +1,32 @@
+/* omegaextra.h: banner etc. for Omega.
+
+ This is included by Omega, from ../omegaextra.c
+ (generated from ../lib/texmfmp.c).
+
+Copyright (C) 1994--2000 John Plaice and Yannis Haralambous
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#define BANNER "This is Omega, Version 3.14159-1.15"
+#define COPYRIGHT_HOLDER "J. Plaice and Y. Haralambous"
+#define AUTHOR NULL
+#define PROGRAM_HELP OMEGAHELP
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "oft"
+#define DUMP_EXT ".oft"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "iniomega"
+#define VIR_PROGRAM "viromega"
diff --git a/Build/source/texk/web2c/omegadir-1.15/omegamem.h b/Build/source/texk/web2c/omegadir-1.15/omegamem.h
new file mode 100644
index 00000000000..f218c7e8a5a
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omegamem.h
@@ -0,0 +1,129 @@
+/* omegamem.h: C declarations for types and accessing routines in omega.c
+
+This file is part of the Omega project, which
+is based on the web2c distribution of TeX.
+
+Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+
+extern boolean new_input_line ();
+extern boolean newinputln ();
+extern int getc_two ();
+extern int getfilemode ();
+extern void ungetc_two ();
+extern int ocptemp;
+
+#define newinputline(stream, mode, flag) new_input_line (stream, mode)
+
+extern memoryword **fonttables;
+extern memoryword **fontsorttables;
+extern int **ocptables;
+
+typedef struct hashw
+{
+ integer p;
+ struct hashw *ptr;
+ memoryword mw;
+} hashword;
+
+extern hashword hashtable[];
+extern hashword *createhashpos();
+extern hashword *createeqtbpos();
+extern hashword *createxeqlevel();
+extern void inithhashtable();
+extern void dumphhashtable();
+extern void undumphhashtable();
+extern void allocatefonttable();
+extern void dumpfonttable();
+extern void undumpfonttable();
+extern void allocatefontsorttable();
+extern void dumpfontsorttable();
+extern void undumpfontsorttable();
+extern void allocateocptable();
+extern void dumpocptable();
+extern void undumpocptable();
+extern void odateandtime();
+extern void btestin();
+extern void runexternalocp();
+
+#define initeqtbtable() inithhashtable();
+#define dumpeqtbtable() dumphhashtable();
+#define undumpeqtbtable() undumphhashtable();
+
+#define HASHTABLESIZE 23123
+#define neweqtb(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw) : \
+ (createeqtbpos(a)->mw))
+#define neweqtbint(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint) : \
+ (createeqtbpos(a)->mw.cint))
+#define neweqtbsc(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint) : \
+ (createeqtbpos(a)->mw.cint))
+#define newequiv(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.rh) : \
+ (createeqtbpos(a)->mw.hh.rh))
+#define newequiv1(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint1) : \
+ (createeqtbpos(a)->mw.cint1))
+#define neweqlevel(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b1) : \
+ (createeqtbpos(a)->mw.hh.b1))
+#define neweqtype(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b0) : \
+ (createeqtbpos(a)->mw.hh.b0))
+#define setneweqtb(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw=v) : \
+ (createeqtbpos(a)->mw=v))
+#define setneweqtbint(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint=v) : \
+ (createeqtbpos(a)->mw.cint=v))
+#define setneweqtbsc(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint=v) : \
+ (createeqtbpos(a)->mw.cint=v))
+#define setequiv(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.rh=v) : \
+ (createeqtbpos(a)->mw.hh.rh=v))
+#define setequiv1(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint1=v) : \
+ (createeqtbpos(a)->mw.cint1=v))
+#define seteqlevel(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b1=v) : \
+ (createeqtbpos(a)->mw.hh.b1=v))
+#define seteqtype(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b0=v) : \
+ (createeqtbpos(a)->mw.hh.b0=v))
+
+#define newhashnext(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.LH) : \
+ (createhashpos(a)->mw.hh.v.LH))
+#define newhashtext(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.RH) : \
+ (createhashpos(a)->mw.hh.v.RH))
+#define sethashnext(a,d) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.LH=d) : \
+ (createhashpos(a)->mw.hh.v.LH=d))
+#define sethashtext(a,d) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.RH=d) : \
+ (createhashpos(a)->mw.hh.v.RH=d))
+
+#define newxeqlevel(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint) : \
+ (createxeqlevel(a)->mw.cint))
+
+#define setintzero(w,a) ((w).cint=(a))
+#define setintone(w,a) ((w).cint1=(a))
diff --git a/Build/source/texk/web2c/omegadir-1.15/omfi.ch b/Build/source/texk/web2c/omegadir-1.15/omfi.ch
new file mode 100644
index 00000000000..3c61add97b7
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omfi.ch
@@ -0,0 +1,246 @@
+% omfi.ch: Primitives for extra level of infinity.
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [10] m.135 l.2878 - Omega fi order of infinity
+specifies the order of infinity to which glue setting applies (|normal|,
+|fil|, |fill|, or |filll|). The |subtype| field is not used.
+@y
+specifies the order of infinity to which glue setting applies (|normal|,
+|sfi|, |fil|, |fill|, or |filll|). The |subtype| field is not used.
+@z
+%---------------------------------------
+@x [10] m.150 l.3136 - Omega fi order of infinity
+orders of infinity (|normal|, |fil|, |fill|, or |filll|)
+@y
+orders of infinity (|normal|, |sfi|, |fil|, |fill|, or |filll|)
+@z
+%---------------------------------------
+@x [10] m.150 l.3145 - Omega fi order of infinity
+@d fil=1 {first-order infinity}
+@d fill=2 {second-order infinity}
+@d filll=3 {third-order infinity}
+@y
+@d sfi=1 {first-order infinity}
+@d fil=2 {second-order infinity}
+@d fill=3 {third-order infinity}
+@d filll=4 {fourth-order infinity}
+@z
+%---------------------------------------
+@x [10] m.150 l.3150 - Omega fi order of infinity
+@!glue_ord=normal..filll; {infinity to the 0, 1, 2, or 3 power}
+@y
+@!glue_ord=normal..filll; {infinity to the 0, 1, 2, 3, or 4 power}
+@z
+%---------------------------------------
+@x [11] m.162 l.3296 - Omega fi order of infinity
+@d fil_glue==zero_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
+@y
+@d sfi_glue==zero_glue+glue_spec_size {\.{0pt plus 1fi minus 0pt}}
+@d fil_glue==sfi_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
+@z
+%---------------------------------------
+@x [11] m.164 l.3296 - Omega fi order of infinity
+stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
+@y
+stretch(sfi_glue):=unity; stretch_order(sfi_glue):=sfi;@/
+stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
+@z
+%---------------------------------------
+@x [12] m.177 l.3591 - Omega fi order of infinity
+ begin print("fil");
+ while order>fil do
+@y
+ begin print("fi");
+ while order>sfi do
+@z
+%---------------------------------------
+@x [26] m.454 l.8924 - Omega fi order of infinity
+if scan_keyword("fil") then
+@.fil@>
+ begin cur_order:=fil;
+@y
+if scan_keyword("fi") then
+@.fil@>
+ begin cur_order:=sfi;
+@z
+%---------------------------------------
+@x [33] m.650 l.12877 - Omega fi order of infinity
+total_stretch[fil]:=0; total_shrink[fil]:=0;
+@y
+total_stretch[sfi]:=0; total_shrink[sfi]:=0;
+total_stretch[fil]:=0; total_shrink[fil]:=0;
+@z
+%---------------------------------------
+@x [33] m.659 l.12996 - Omega fi order of infinity
+else if total_stretch[fil]<>0 then o:=fil
+@y
+else if total_stretch[fil]<>0 then o:=fil
+else if total_stretch[sfi]<>0 then o:=sfi
+@z
+%---------------------------------------
+@x [33] m.665 l.13061 - Omega fi order of infinity
+else if total_shrink[fil]<>0 then o:=fil
+@y
+else if total_shrink[fil]<>0 then o:=fil
+else if total_shrink[sfi]<>0 then o:=sfi
+@z
+%---------------------------------------
+@x [38] m.822 l.16135 - Omega fi order of infinity
+contains six scaled numbers, since it must record the net change in glue
+stretchability with respect to all orders of infinity. The natural width
+difference appears in |mem[q+1].sc|; the stretch differences in units of
+pt, fil, fill, and filll appear in |mem[q+2..q+5].sc|; and the shrink difference
+appears in |mem[q+6].sc|. The |subtype| field of a delta node is not used.
+
+@d delta_node_size=7 {number of words in a delta node}
+@y
+contains seven scaled numbers, since it must record the net change in glue
+stretchability with respect to all orders of infinity. The natural width
+difference appears in |mem[q+1].sc|; the stretch differences in units of
+pt, sfi, fil, fill, and filll appear in |mem[q+2..q+6].sc|; and the shrink
+difference appears in |mem[q+7].sc|. The |subtype| field of a delta node
+is not used.
+
+@d delta_node_size=8 {number of words in a delta node}
+@z
+%---------------------------------------
+@x [38] m.823 l.16144 - Omega fi order of infinity
+@ As the algorithm runs, it maintains a set of six delta-like registers
+for the length of the line following the first active breakpoint to the
+current position in the given hlist. When it makes a pass through the
+active list, it also maintains a similar set of six registers for the
+@y
+@ As the algorithm runs, it maintains a set of seven delta-like registers
+for the length of the line following the first active breakpoint to the
+current position in the given hlist. When it makes a pass through the
+active list, it also maintains a similar set of seven registers for the
+@z
+%---------------------------------------
+@x [38] m.823 l.16154 - Omega fi order of infinity
+k:=1 to 6 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
+want to do this without the overhead of |for| loops. The |do_all_six|
+macro makes such six-tuples convenient.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6)
+
+@<Glo...@>=
+@!active_width:array[1..6] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..6] of scaled; {distance from current active node}
+@!background:array[1..6] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..6] of scaled; {length being computed after current break}
+@y
+k:=1 to 7 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
+want to do this without the overhead of |for| loops. The |do_all_six|
+macro makes such six-tuples convenient.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6);#(7)
+
+@<Glo...@>=
+@!active_width:array[1..7] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..7] of scaled; {distance from current active node}
+@!background:array[1..7] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..7] of scaled; {length being computed after current break}
+@z
+%---------------------------------------
+@x [38] m.827 l.16242 - Omega fi order of infinity
+background[2]:=0; background[3]:=0; background[4]:=0; background[5]:=0;@/
+@y
+background[2]:=0; background[3]:=0; background[4]:=0; background[5]:=0;@/
+background[6]:=0;@/
+@z
+%---------------------------------------
+@x [38] m.827 l.16260 - Omega fi order of infinity
+background[6]:=shrink(q)+shrink(r);
+@y
+background[7]:=shrink(q)+shrink(r);
+@z
+%---------------------------------------
+@x [38] m.838 l.16470 - Omega fi order of infinity
+break_width[6]:=break_width[6]-shrink(v);
+@y
+break_width[7]:=break_width[7]-shrink(v);
+@z
+%---------------------------------------
+@x [38] m.852 l.16713 - Omega fi order of infinity
+subarray |cur_active_width[2..5]|, in units of points, fil, fill, and filll.
+@y
+subarray |cur_active_width[2..6]|, in units of points, sfi, fil, fill and filll.
+@z
+%---------------------------------------
+@x [38] m.852 l.16722 - Omega fi order of infinity
+if (cur_active_width[3]<>0)or(cur_active_width[4]<>0)or@|
+ (cur_active_width[5]<>0) then
+@y
+if (cur_active_width[3]<>0)or(cur_active_width[4]<>0)or@|
+ (cur_active_width[5]<>0)or(cur_active_width[6]<>0) then
+@z
+%---------------------------------------
+@x [38] m.853 l.16738 - Omega fi order of infinity
+we can shrink the line from |r| to |cur_p| by at most |cur_active_width[6]|.
+
+@<Set the value of |b| to the badness for shrinking...@>=
+begin if -shortfall>cur_active_width[6] then b:=inf_bad+1
+else b:=badness(-shortfall,cur_active_width[6]);
+@y
+we can shrink the line from |r| to |cur_p| by at most |cur_active_width[7]|.
+
+@<Set the value of |b| to the badness for shrinking...@>=
+begin if -shortfall>cur_active_width[7] then b:=inf_bad+1
+else b:=badness(-shortfall,cur_active_width[7]);
+@z
+%---------------------------------------
+@x [39] m.868 l.17054 - Omega fi order of infinity
+active_width[6]:=active_width[6]+shrink(q)
+@y
+active_width[7]:=active_width[7]+shrink(q)
+@z
+%---------------------------------------
+@x [44] m.975 l.18932 - Omega fi order of infinity
+ if (active_height[3]<>0) or (active_height[4]<>0) or
+ (active_height[5]<>0) then b:=0
+ else b:=badness(h-cur_height,active_height[2])
+else if cur_height-h>active_height[6] then b:=awful_bad
+else b:=badness(cur_height-h,active_height[6])
+@y
+ if (active_height[3]<>0) or (active_height[4]<>0) or
+ (active_height[5]<>0) or (active_height[6]<>0) then b:=0
+ else b:=badness(h-cur_height,active_height[2])
+else if cur_height-h>active_height[7] then b:=awful_bad
+else b:=badness(cur_height-h,active_height[7])
+@z
+%---------------------------------------
+@x [44] m.976 l.18947 - Omega fi order of infinity
+ active_height[6]:=active_height[6]+shrink(q);
+@y
+ active_height[7]:=active_height[7]+shrink(q);
+@z
+%---------------------------------------
+@x [48] m.1201 l.22454 - Omega fi order of infinity
+ (total_shrink[fil]<>0)or(total_shrink[fill]<>0)or
+ (total_shrink[filll]<>0)) then
+@y
+ (total_shrink[sfi]<>0)or(total_shrink[fil]<>0)or
+ (total_shrink[fill]<>0)or(total_shrink[filll]<>0)) then
+@z
+
diff --git a/Build/source/texk/web2c/omegadir-1.15/omfilter.ch b/Build/source/texk/web2c/omegadir-1.15/omfilter.ch
new file mode 100644
index 00000000000..13c883667a6
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omfilter.ch
@@ -0,0 +1,924 @@
+% omfilter.ch: Running OCP programs
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.412 - Omega Filtering
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@y
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@!active_mem_size=2000; {number of words of |active_info| for active ocps}
+@z
+%---------------------------------------
+@x [5] - Omega Translation
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("Omega capacity exceeded, sorry [");
+@.TeX capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+ ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+@y
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("Omega capacity exceeded, sorry [");
+@.TeX capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+ ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+
+procedure overflow_ocp_buf_size;
+begin
+overflow("ocp_buf_size",ocp_buf_size);
+end;
+
+procedure overflow_ocp_stack_size;
+begin
+overflow("ocp_stack_size",ocp_stack_size);
+end;
+@z
+%---------------------------------------
+@x [22] m.300 l.6425 - Omega Filtering
+@!in_state_record = record
+ @!state_field, @!index_field: quarterword;
+ @!start_field,@!loc_field, @!limit_field, @!name_field: halfword;
+ end;
+@y
+@!in_state_record = record
+ @!state_field, @!index_field: quarterword;
+ @!start_field,@!loc_field, @!limit_field, @!name_field,
+ @!ocp_lstack_field: halfword; {used for omega translation processes}
+ @!ocp_no_field: halfword; {used for omega translation processes}
+ end;
+@z
+%---------------------------------------
+@x [22] m.300 l.6444 - Omega Filtering
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d name==cur_input.name_field {name of the current file}
+@y
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d name==cur_input.name_field {name of the current file}
+@d current_ocp_lstack==cur_input.ocp_lstack_field {name of the current ocp}
+@d current_ocp_no==cur_input.ocp_no_field {name of the current ocp}
+@z
+%---------------------------------------
+@x [22] m.312 l.6766 - Omega Filtering
+ if state<>token_list then
+ begin @<Print location of current line@>;
+ @<Pseudoprint the line@>;
+@y
+ if current_ocp_lstack>0 then
+ begin print_nl("OCP stack "); print_scaled(current_ocp_lstack);
+ print(" entry "); print_int(current_ocp_no); print(":");
+ @<Pseudoprint the line@>;
+ end
+ else if state<>token_list then
+ begin @<Print location of current line@>;
+ @<Pseudoprint the line@>;
+@z
+%---------------------------------------
+@x [23] m.331 l.7069 - Omega Filtering
+state:=new_line; start:=1; index:=0; line:=0; name:=0;
+@y
+state:=new_line; start:=1; index:=0; line:=0; name:=0;
+current_ocp_lstack:=0; current_ocp_no:=0;
+@z
+%---------------------------------------
+@x [24] m.343 l.7248 - Omega Filtering
+else begin state:=new_line;@/
+ @<Move to next line of file,
+@y
+else begin
+ if current_ocp_lstack>0 then
+ begin
+ pop_input; goto restart;
+ end;
+ state:=new_line;
+ @<Move to next line of file,
+@z
+%---------------------------------------
+@x [30] m.582 l.11283 - Omega Filtering
+char_warning(f,c);
+new_character:=null;
+exit:end;
+@y
+char_warning(f,c);
+new_character:=null;
+exit:end;
+
+@
+@<Types...@>=
+@!active_index=0..active_mem_size;
+
+@
+@d active_ocp(#)==active_info[#].hh.b0
+@d active_counter(#)==active_info[#].hh.b1
+@d active_lstack_no(#)==active_info[#+1].sc
+
+@<Glob...@>=
+@!active_info:array[active_index] of memory_word;
+@!active_min_ptr:active_index; {first unused word of |active_info|}
+@!active_max_ptr:active_index; {last unused word of |active_info|}
+@!active_real:active_index;
+@!holding:array[active_index] of ocp_list_index;
+
+@
+@<Initialize table...@>=
+active_min_ptr:=0;
+active_real:=0;
+
+@
+@p
+function is_last_ocp(llstack_no:scaled; counter:integer):integer;
+begin
+active_min_ptr:=equiv(ocp_active_min_ptr_base);
+active_max_ptr:=equiv(ocp_active_max_ptr_base);
+active_real:=active_min_ptr;
+while (active_real < active_max_ptr) and
+ (active_lstack_no(active_real) < llstack_no) do begin
+ active_real:=active_real+2;
+ end;
+while (active_real < active_max_ptr) and
+ (active_lstack_no(active_real) = llstack_no) and
+ (active_counter(active_real) <= counter) do begin
+ active_real:=active_real+2;
+ end;
+is_last_ocp := (active_real=active_max_ptr);
+end;
+
+procedure print_active_ocps;
+var i:integer;
+begin
+print_nl("Active ocps: [");
+i:=active_min_ptr;
+while i<active_max_ptr do begin
+ print("(");
+ print_scaled(active_lstack_no(i));
+ print(",");
+ print_int(active_counter(i));
+ print(",");
+ print_esc(ocp_id_text(active_ocp(i)));
+ print(")");
+ if i<>(active_max_ptr-2) then print(",");
+ i:=i+2;
+ end;
+print("]");
+end;
+
+procedure add_ocp_stack(min_index:integer; min_value:scaled);
+var p:ocp_lstack_index;
+ llstack_no:scaled;
+ counter:integer;
+begin
+p:=ocp_list_lstack(holding[min_index]);
+llstack_no:=ocp_list_lstack_no(holding[min_index]);
+counter:=0;
+while not (is_null_ocp_lstack(p)) do begin
+ active_ocp(active_max_ptr):=ocp_lstack_ocp(p);
+ active_counter(active_max_ptr):=counter;
+ active_lstack_no(active_max_ptr):=llstack_no;
+ p:=ocp_lstack_lnext(p);
+ active_max_ptr:=active_max_ptr+2;
+ incr(counter); {no overflow problem}
+ end;
+end;
+
+procedure active_compile;
+var i:integer;
+ min_index:integer;
+ min_stack_ocp:scaled;
+ old_min:scaled;
+ max_active:integer;
+ stack_value:scaled;
+begin
+active_min_ptr:=active_max_ptr;
+min_stack_ocp:=ocp_maxint;
+max_active:=equiv(ocp_active_number_base)-1;
+for i:=max_active downto 0 do begin
+ holding[i]:=ocp_list_list[equiv(ocp_active_base+i)];
+ stack_value:=ocp_list_lstack_no(holding[i]);
+ if stack_value<min_stack_ocp then begin
+ min_index:=i;
+ min_stack_ocp:=stack_value;
+ end;
+ end;
+while min_stack_ocp<ocp_maxint do begin
+ add_ocp_stack(min_index, min_stack_ocp);
+ old_min:=min_stack_ocp;
+ min_stack_ocp:=ocp_maxint;
+ for i:=max_active downto 0 do begin
+ stack_value:=ocp_list_lstack_no(holding[i]);
+ while old_min=stack_value do begin
+ holding[i]:=ocp_list_lnext(holding[i]);
+ stack_value:=ocp_list_lstack_no(holding[i]);
+ end;
+ if stack_value<min_stack_ocp then begin
+ min_index:=i;
+ min_stack_ocp:=stack_value;
+ end;
+ end;
+ end;
+end;
+
+@z
+%---------------------------------------
+@x [46] m.1030 l.19984 - Omega Filtering
+main_loop:@<Append character |cur_chr| and the following characters (if~any)
+ to the current hlist in the current font; |goto reswitch| when
+ a non-character has been fetched@>;
+@y
+main_loop:
+if is_last_ocp(current_ocp_lstack,current_ocp_no) then begin
+ @<Append character |cur_chr| and the following characters (if~any)
+ to the current hlist in the current font; |goto reswitch| when
+ a non-character has been fetched@>;
+ end
+else begin
+ @<Create a buffer with character |cur_chr| and the following
+ characters (if~any) and then apply the current active OCP filter
+ to this buffer@>;
+ end;
+@z
+%---------------------------------------
+@x [50] m.1302 l.23862 - Omega Filtering
+@<Dump the font information@>;
+@y
+@<Dump the font information@>;
+@<Dump the active ocp information@>;
+@z
+%---------------------------------------
+@x [50] m.1303 l.23711 - Omega Filtering
+@<Undump the font information@>;
+@y
+@<Undump the font information@>;
+@<Undump the active ocp information@>;
+@z
+%---------------------------------------
+@x [50] m.1323 l.24907 - Omega Filtering
+begin undump_font_table(k);@/
+end
+@y
+begin undump_font_table(k);@/
+end
+
+@ @<Dump the active ocp information@>=
+dump_int(active_min_ptr);
+dump_int(active_max_ptr);
+for k:=0 to active_max_ptr-1 do dump_wd(active_info[k]);
+print_ln; print_int(active_max_ptr); print(" words of active ocps");
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+for k:=0 to active_max_ptr-1 do undump_wd(active_info[k]);
+
+@z
+%---------------------------------------
+@x [54] m.1379 l.24883 - Omega Filtering
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+@y
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+
+@
+@<Types...@>=
+
+@ Here are all the instructions in our mini-assembler.
+@d otp_right_output=1
+@d otp_right_num=2
+@d otp_right_char=3
+@d otp_right_lchar=4
+@d otp_right_some=5
+
+@d otp_pback_output=6
+@d otp_pback_num=7
+@d otp_pback_char=8
+@d otp_pback_lchar=9
+@d otp_pback_some=10
+
+@d otp_add=11
+@d otp_sub=12
+@d otp_mult=13
+@d otp_div=14
+@d otp_mod=15
+@d otp_lookup=16
+@d otp_push_num=17
+@d otp_push_char=18
+@d otp_push_lchar=19
+
+@d otp_state_change=20
+@d otp_state_push=21
+@d otp_state_pop=22
+
+@d otp_left_start=23
+@d otp_left_return=24
+@d otp_left_backup=25
+
+@d otp_goto=26
+@d otp_goto_ne=27
+@d otp_goto_eq=28
+@d otp_goto_lt=29
+@d otp_goto_le=30
+@d otp_goto_gt=31
+@d otp_goto_ge=32
+@d otp_goto_no_advance=33
+@d otp_goto_beg=34
+@d otp_goto_end=35
+
+@d otp_stop=36
+
+@
+@<Glob...@>=
+@!otp_init_input_start:halfword;
+@!otp_init_input_last:halfword;
+@!otp_init_input_end:halfword;
+@!otp_i:halfword;
+@!otp_init_input_buf:array[0..20000] of quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:array[0..20000] of quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:array[0..20000] of quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:array[0..1000] of quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:array[0..1000] of halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:array[0..1000] of halfword;
+
+@!otp_input_char:halfword;
+@!otp_calculated_char:halfword;
+@!otp_no_input_chars:halfword;
+
+@!otp_instruction:halfword;
+@!otp_instr:halfword;
+@!otp_arg:halfword;
+@!otp_first_arg:halfword;
+@!otp_second_arg:halfword;
+
+@!otp_input_ocp:halfword;
+@!otp_counter:halfword;
+
+@!otp_finished:boolean;
+@!otp_ext_str:integer;
+@!otp_ext_str_arg:integer;
+@!otp_ext_i:integer;
+
+@
+@<Initialize table...@>=
+
+@
+@<Create a buffer with character |cur_chr| and the following
+ characters (if~any) and then apply the current active OCP filter
+ to this buffer@>=
+begin
+@<Read in the buffer for treatment@>;
+@<Apply the OCP to the input buffer@>;
+@<Place the output buffer back on the stream@>;
+goto big_switch;
+end;
+
+@
+@<Read in the buffer for treatment@>=
+begin
+otp_init_input_end:=0;
+while (cur_cmd=letter) or (cur_cmd=other_char) or
+ (cur_cmd=char_given) or (cur_cmd=spacer) do begin
+ incr(otp_init_input_end);
+ if otp_init_input_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_init_input_buf[otp_init_input_end]:=cur_chr;
+ get_token;
+ if (cur_cmd<>letter) and (cur_cmd<>other_char) and
+ (cur_cmd<>char_given) then begin
+ x_token;
+ if (cur_cmd=char_num) then begin
+ scan_char_num; cur_cmd:=other_char; cur_chr:=cur_val;
+ end;
+ end;
+ end;
+back_input;
+otp_input_end:=otp_init_input_end;
+for otp_i:=0 to otp_init_input_end do begin
+ otp_input_buf[otp_i]:=otp_init_input_buf[otp_i];
+ end;
+end
+
+@
+@<Apply the OCP to the input buffer@>=
+begin
+otp_input_ocp:=active_ocp(active_real);
+if otp_input_ocp=0 then begin
+ print_nl("Null ocp being used: all input lost");
+ otp_output_end:=0;
+ end
+else if ocp_external(otp_input_ocp)=0 then begin
+ otp_input_start:=0;
+ otp_input_last:=0;
+ otp_stack_used:=0;
+ otp_stack_last:=0;
+ otp_stack_new:=0;
+ otp_output_end:=0;
+ otp_pc:=0;
+ otp_finished:=false;
+ otp_calc_ptr:=0;
+ otp_calcs[otp_calc_ptr]:=0;
+ otp_state_ptr:=0;
+ otp_states[otp_state_ptr]:=0;
+ while not otp_finished do
+ @<Run the OTP program@>;
+ end
+else begin
+ k:=0;
+ if name_of_file then libc_free (name_of_file);
+ otp_ext_str:=ocp_external(otp_input_ocp);
+ otp_ext_str_arg:=ocp_external_arg(otp_input_ocp);
+ name_of_file := xmalloc (4 + length(otp_ext_str) + length(otp_ext_str_arg));
+ for otp_ext_i:=str_start(otp_ext_str) to
+ str_start(otp_ext_str)+length(otp_ext_str)-1 do
+ append_to_name(str_pool[otp_ext_i]);
+ append_to_name(" ");
+ for otp_ext_i:=str_start(otp_ext_str_arg) to
+ str_start(otp_ext_str_arg)+length(otp_ext_str_arg)-1 do
+ append_to_name(str_pool[otp_ext_i]);
+ name_of_file[length(otp_ext_str)+length(otp_ext_str_arg)+2]:=0;
+ run_external_ocp(name_of_file);
+ end
+end
+
+@
+@<Place the output buffer back on the stream@>=
+begin
+if (first+otp_output_end)>=ocp_buf_size then
+ overflow_ocp_buf_size;
+push_input;
+current_ocp_lstack:=active_lstack_no(active_real);
+current_ocp_no:=active_counter(active_real);
+state:=mid_line;
+start:=first;
+last:=start;
+loc:=start;
+for otp_counter:=1 to otp_output_end do begin
+ buffer[last]:=otp_output_buf[otp_counter];
+ incr(last); {no overflow problem}
+ end;
+limit:=last-1;
+first:=last;
+end
+
+@
+@d otp_cur_state==otp_states[otp_state_ptr]
+@d otp_set_instruction==begin
+if otp_pc>=ocp_state_no(otp_input_ocp)(otp_cur_state) then begin
+ print_err("bad OCP program -- PC not valid");
+ succumb;
+ end;
+otp_instruction:=ocp_state_entry(otp_input_ocp)(otp_cur_state)(otp_pc);
+otp_instr:=otp_instruction div @"1000000;
+otp_arg:=otp_instruction mod @"1000000;
+end
+
+@<Run the OTP program@>=
+begin
+otp_set_instruction;
+case otp_instr of
+ @<Run the |otp_right| instructions@>;
+ @<Run the |otp_pback| instructions@>;
+ @<Run the arithmetic instructions@>;
+ @<Run the |otp_state| instructions@>;
+ @<Run the |otp_left| instructions@>;
+ @<Run the |otp_goto| instructions@>;
+ @<Run the |otp_stop| instruction@>;
+ othercases begin
+ print_err("bad OCP program -- unknown instruction");
+ succumb;
+ end
+ endcases;
+end
+
+@
+
+@d otp_check_char(#)==
+if (1>#) or (#>otp_no_input_chars) then begin
+ print_err("right hand side of OCP expression is bad");
+ succumb;
+ end
+
+@d otp_get_char(#)==begin
+otp_check_char(#);
+if #>otp_stack_last then begin
+ otp_calculated_char:=otp_input_buf[otp_input_start+#-otp_stack_last];
+ end
+else begin
+ otp_calculated_char:=otp_stack_buf[#];
+ end;
+end
+
+@d decr(#)==#:=#-1
+
+@<Run the |otp_right| instructions@>=
+ otp_right_output: begin
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calcs[otp_calc_ptr];
+ decr(otp_calc_ptr);
+ incr(otp_pc);
+ end;
+ otp_right_num: begin
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_arg;
+ incr(otp_pc);
+ end;
+ otp_right_char: begin
+ otp_get_char(otp_arg);
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_right_lchar: begin
+ otp_get_char(otp_no_input_chars-otp_arg);
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_right_some: begin
+ otp_first_arg:=otp_arg+1;
+ incr(otp_pc);
+ otp_set_instruction;
+ otp_second_arg:=otp_no_input_chars-otp_arg;
+ for otp_counter:=otp_first_arg to otp_second_arg do begin
+ otp_get_char(otp_counter);
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calculated_char;
+ end;
+ incr(otp_pc);
+ end
+
+@
+@<Run the |otp_pback| instructions@>=
+ otp_pback_output: begin
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calcs[otp_calc_ptr];
+ decr(otp_calc_ptr);
+ incr(otp_pc);
+ end;
+ otp_pback_num: begin
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_arg;
+ incr(otp_pc);
+ end;
+ otp_pback_char: begin
+ otp_get_char(otp_arg);
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_pback_lchar: begin
+ otp_get_char(otp_no_input_chars-otp_arg);
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_pback_some: begin
+ otp_first_arg:=otp_arg+1;
+ incr(otp_pc);
+ otp_set_instruction;
+ otp_second_arg:=otp_no_input_chars-otp_arg;
+ for otp_counter:=otp_first_arg to otp_second_arg do begin
+ otp_get_char(otp_counter);
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+ end;
+ incr(otp_pc);
+ end
+
+@
+@<Run the arithmetic instructions@>=
+ otp_add: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] + otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_sub: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] - otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_mult: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] * otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_div: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] div otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_mod: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] mod otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_lookup: begin
+ if otp_calcs[otp_calc_ptr]>=
+ ocp_table_no(otp_input_ocp)(otp_calcs[otp_calc_ptr-1]) then begin
+ print_err("bad OCP program -- table index not valid");
+ succumb;
+ end;
+ otp_calcs[otp_calc_ptr-1]:=
+ ocp_table_entry(otp_input_ocp)(otp_calcs[otp_calc_ptr-1])
+ (otp_calcs[otp_calc_ptr]);
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_push_num: begin
+ incr(otp_calc_ptr);
+ if otp_calc_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_calcs[otp_calc_ptr]:=otp_arg;
+ incr(otp_pc);
+ end;
+ otp_push_char: begin
+ otp_get_char(otp_arg);
+ incr(otp_calc_ptr);
+ if otp_calc_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_calcs[otp_calc_ptr]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_push_lchar: begin
+ otp_get_char(otp_no_input_chars-otp_arg);
+ incr(otp_calc_ptr);
+ if otp_calc_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_calcs[otp_calc_ptr]:=otp_calculated_char;
+ incr(otp_pc);
+ end
+
+@
+@<Run the |otp_state| instructions@>=
+ otp_state_change: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ otp_states[otp_state_ptr]:=otp_arg;
+ otp_pc:=0;
+ end;
+ otp_state_push: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ incr(otp_state_ptr);
+ if otp_state_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_states[otp_state_ptr]:=otp_arg;
+ otp_pc:=0;
+ end;
+ otp_state_pop: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ if otp_state_ptr>0 then decr(otp_state_ptr);
+ otp_pc:=0;
+ end
+
+@
+@<Run the |otp_left| instructions@>=
+ otp_left_start: begin
+ otp_input_start:=otp_input_last;
+ otp_input_last:=otp_input_start;
+ otp_stack_used:=0;
+ if (otp_stack_last=0) and (otp_input_last>=otp_input_end) then
+ otp_finished:=true
+ else if (otp_stack_used < otp_stack_last) then begin
+ incr(otp_stack_used); {no overflow problem}
+ otp_input_char:=otp_stack_buf[otp_stack_used];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end
+ else begin
+ incr(otp_input_last); {no overflow problem}
+ otp_input_char:=otp_input_buf[otp_input_last];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end;
+ end;
+ otp_left_return: begin
+ otp_input_last:=otp_input_start;
+ otp_stack_used:=0;
+ if (otp_stack_used < otp_stack_last) then begin
+ incr(otp_stack_used); {no overflow problem}
+ otp_input_char:=otp_stack_buf[otp_stack_used];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end
+ else begin
+ incr(otp_input_last); {no overflow problem}
+ otp_input_char:=otp_input_buf[otp_input_last];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end;
+ end;
+ otp_left_backup: begin
+ if otp_input_start < otp_input_last then begin
+ decr(otp_input_last); otp_input_char:=otp_input_buf[otp_input_last];
+ end
+ else begin
+ decr(otp_stack_used); otp_input_char:=otp_stack_buf[otp_stack_used];
+ end;
+ decr(otp_no_input_chars);
+ incr(otp_pc);
+ end
+
+@
+@<Run the |otp_goto| instructions@>=
+ otp_goto: begin
+ otp_pc:=otp_arg;
+ end;
+ otp_goto_ne: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char <> otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_eq: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char = otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_lt: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char < otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_le: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char <= otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_gt: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char > otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_ge: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char >= otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_no_advance: begin
+ if (otp_stack_used < otp_stack_last) then begin
+ incr(otp_stack_used); {no overflow problem}
+ otp_input_char:=otp_stack_buf[otp_stack_used];
+ incr(otp_no_input_chars); {no overflow problem}
+ incr(otp_pc);
+ end
+ else if otp_input_last>=otp_input_end then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_input_last); {no overflow problem}
+ otp_input_char:=otp_input_buf[otp_input_last];
+ incr(otp_no_input_chars); {no overflow problem}
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_beg: begin
+ if otp_input_last=0 then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_end: begin
+ if otp_input_last>=otp_input_end then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end
+
+@
+@<Run the |otp_stop| instruction@>=
+ otp_stop: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ otp_pc:=0;
+ end
+
+@z
diff --git a/Build/source/texk/web2c/omegadir-1.15/omfont.ch b/Build/source/texk/web2c/omegadir-1.15/omfont.ch
new file mode 100644
index 00000000000..a176f346ccd
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omfont.ch
@@ -0,0 +1,2373 @@
+% omfont.ch: Reading and storing font metric information
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%%---------------------------------------
+@x [15] m.208 l.
+@d min_internal=end_cs_name+1 {the smallest code that can follow \.{\\the}}
+@y
+@d char_ghost=end_cs_name+1
+ {\.{\\ghostleft}, \.{\\ghostright} character for kerning}
+@d min_internal=char_ghost+1 {the smallest code that can follow \.{\\the}}
+@z
+%---------------------------------------
+@x [17] m.222 l.4530 - Omega
+ {begins table of 257 permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+257 {dummy location}
+@y
+ {begins table of |number_fonts| permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+number_fonts
+ {dummy location}
+@z
+%---------------------------------------
+@x [18] m.265 l.5648 - Omega
+primitive("insert",insert,0);@/
+@!@:insert_}{\.{\\insert} primitive@>
+@y
+primitive("insert",insert,0);@/
+@!@:insert_}{\.{\\insert} primitive@>
+primitive("leftghost",char_ghost,0);@/
+@!@:leftghost_}{\.{\\leftghost} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5648 - Omega
+primitive("setbox",set_box,0);@/
+@!@:set_box_}{\.{\\setbox} primitive@>
+@y
+primitive("rightghost",char_ghost,1);@/
+@!@:rightghost_}{\.{\\rightghost} primitive@>
+primitive("setbox",set_box,0);@/
+@!@:set_box_}{\.{\\setbox} primitive@>
+@z
+%---------------------------------------
+@x [18] m.266 l.5648 - Omega
+char_num: print_esc("char");
+@y
+char_num: print_esc("char");
+char_ghost: if cur_chr=0 then print_esc("leftghost")
+ else print_esc("rightghost");
+@z
+%---------------------------------------
+@x [26] m.425 l.8524 - font parameters
+begin find_font_dimen(false); font_info[fmem_ptr].sc:=0;
+scanned_result(font_info[cur_val].sc)(dimen_val);
+@y
+begin find_font_dimen(false);
+font_info(dimen_font)(font_file_size(dimen_font)).sc:=0;
+scanned_result(font_info(dimen_font)(cur_val).sc)(dimen_val);
+@z
+%---------------------------------------
+@x [26] m.426 l.8530 - font parameters
+if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+else scanned_result(skew_char[cur_val])(int_val);
+@y
+if m=0 then scanned_result(hyphen_char(cur_val))(int_val)
+else scanned_result(skew_char(cur_val))(int_val);
+@z
+%---------------------------------------
+@x [27] m.472 l.9258 - font parameters
+font_name_code: begin print(font_name[cur_val]);
+ if font_size[cur_val]<>font_dsize[cur_val] then
+ begin print(" at "); print_scaled(font_size[cur_val]);
+@y
+font_name_code: begin print(font_name(cur_val));
+ if font_size(cur_val)<>font_dsize(cur_val) then
+ begin print(" at "); print_scaled(font_size(cur_val));
+@z
+%---------------------------------------
+@x [30] m.539 l.10392 - Omega
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+@y
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+$\Omega$ is capable of reading not only \.{TFM} files, but also
+\.{OFM} files, which can describe fonts with up to 65536 characters
+and with huge lig/kern tables. These fonts will often be virtual
+fonts built up from real fonts with 256 characters, but $\Omega$
+is not aware of this.
+
+The documentation below describes \.{TFM} files, with slight additions
+to show where \.{OFM} files differ.
+
+@z
+%---------------------------------------
+@x [30] m.540 l.10417 - Omega
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+@y
+Note that a \.{TFM} font may contain as many as 256 characters
+(if |bc=0| and |ec=255|), and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+The first 52 bytes (13 words) of an \.{OFM} file contains thirteen
+32-bit integers that give the lengths of the various subsequent
+portions of the file. The first word is 0 (future versions of
+\.{OFM} files could have different values; what is important is that
+the first two bytes be 0 to differentiate \.{TFM} and \.{OFM} files).
+The next twelve integers are as above, all nonegative and less
+than~$2^{31}$. We must have |bc-1<=ec<=65535|, and
+$$\hbox{|lf=13+lh+2*(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that an \.{OFM} font may contain as many as 65536 characters
+(if |bc=0| and |ec=65535|), and as few as 0 characters (if |bc=ec+1|).
+
+@z
+%---------------------------------------
+@x [30] m.543 l.10492 - Omega
+per character. Each word in this part of the file contains six fields
+@y
+per character. Each word in this part of a \.{TFM} file contains six fields
+@z
+%---------------------------------------
+@x [30] m.543 l.10506 - Omega
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+@y
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+For \.{OFM} files, two words (eight bytes) are used.
+The arrangement is as follows.
+
+\yskip\hang first and second bytes: |@!width_index| (16 bits)\par
+\hang third byte: |@!height_index| (8 bits)\par
+\hang fourth byte: |@!depth_index| (8~bits)\par
+\hang fifth and sixth bytes:
+|@!italic_index| (14 bits) times 4, plus |@!tag| (2~bits)\par
+\hang seventh and eighth bytes: |@!remainder| (16 bits)\par
+\yskip\noindent
+Therefore the \.{OFM} format imposes a limit of 256 different heights,
+256 different depths, and 16384 different italic corrections.
+
+@z
+%---------------------------------------
+@x [30] m.545 l.10547 - Omega
+that explains what to do for special letter pairs. Each word in this array is a
+|@!lig_kern_command| of four bytes.
+@y
+that explains what to do for special letter pairs. Each word in this array,
+in a \.{TFM} file, is a |@!lig_kern_command| of four bytes.
+@z
+%---------------------------------------
+@x [30] m.545 l.10557 - Omega
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+@y
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In an \.{OFM} file, eight bytes are used, two bytes for each field.
+
+@z
+%---------------------------------------
+@x [30] m.545 l.10587 - Omega
+appear in a location |<=255|.
+@y
+appear in a location |<=255| in a \.{TFM} file, |<=65535| in an \.{OFM} file.
+@z
+%---------------------------------------
+@x [30] m.545 l.10599 - Omega
+@d skip_byte(#)==#.b0
+@d next_char(#)==#.b1
+@d op_byte(#)==#.b2
+@d rem_byte(#)==#.b3
+@y
+@d top_skip_byte(#)==(#.b0 div 256)
+@d skip_byte(#)==(#.b0 mod 256)
+@d next_char_end(#)==#.b1
+@d next_char(#)==font_offset(#)+next_char_end
+@d op_byte(#)==#.b2
+@d rem_byte(#)==#.b3
+@d rem_char_byte_end(#)==#.b3
+@d rem_char_byte(#)==font_offset(#)+rem_char_byte_end
+@d rem_top_byte(#)==(#.b3 div 256)
+@d rem_bot_byte(#)==(#.b3 mod 256)
+@z
+%---------------------------------------
+@x [30] m.546 l.10604 - Omega
+consists of four bytes called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this
+order). These bytes are the character codes of individual pieces used to
+@y
+consists of four bytes in a \.{TFM} file,
+called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this order).
+In an \.{OFM} file, each field takes two bytes, for eight in total.
+These bytes are the character codes of individual pieces used to
+@z
+%---------------------------------------
+@x [30] m.546 l.10618 - Omega
+@d ext_top(#)==#.b0 {|top| piece in a recipe}
+@d ext_mid(#)==#.b1 {|mid| piece in a recipe}
+@d ext_bot(#)==#.b2 {|bot| piece in a recipe}
+@d ext_rep(#)==#.b3 {|rep| piece in a recipe}
+@y
+@d ext_top_end(#)==#.b0 {|top| piece in a recipe}
+@d ext_top(#)==font_offset(#)+ext_top_end
+@d ext_mid_end(#)==#.b1 {|mid| piece in a recipe}
+@d ext_mid(#)==font_offset(#)+ext_mid_end
+@d ext_bot_end(#)==#.b2 {|bot| piece in a recipe}
+@d ext_bot(#)==font_offset(#)+ext_bot_end
+@d ext_rep_end(#)==#.b3 {|rep| piece in a recipe}
+@d ext_rep(#)==font_offset(#)+ext_rep_end
+@z
+%---------------------------------------
+@x [30] m.548 l.10674 - Omega
+@!font_index=0..font_mem_size; {index into |font_info|}
+@y
+@!font_index=integer; {index into |font_info|}
+@z
+%---------------------------------------
+@x [30] m.549 l.10678 - Omega
+@d non_char==qi(256) {a |halfword| code that can't match a real character}
+@y
+@d non_char==qi(too_big_char) {a code that can't match a real character}
+@z
+%---------------------------------------
+@x [30] m.549 l.10686 - Omega
+@!font_info:array[font_index] of memory_word;
+ {the big collection of font data}
+@!fmem_ptr:font_index; {first unused word of |font_info|}
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_check:array[internal_font_number] of four_quarters; {check sum}
+@!font_size:array[internal_font_number] of scaled; {``at'' size}
+@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
+@!font_params:array[internal_font_number] of font_index; {how many font
+ parameters are present}
+@!font_name:array[internal_font_number] of str_number; {name of the font}
+@!font_area:array[internal_font_number] of str_number; {area of the font}
+@!font_bc:array[internal_font_number] of eight_bits;
+ {beginning (smallest) character code}
+@!font_ec:array[internal_font_number] of eight_bits;
+ {ending (largest) character code}
+@!font_glue:array[internal_font_number] of pointer;
+ {glue specification for interword space, |null| if not allocated}
+@!font_used:array[internal_font_number] of boolean;
+ {has a character from this font actually appeared in the output?}
+@!hyphen_char:array[internal_font_number] of integer;
+ {current \.{\\hyphenchar} values}
+@!skew_char:array[internal_font_number] of integer;
+ {current \.{\\skewchar} values}
+@!bchar_label:array[internal_font_number] of font_index;
+ {start of |lig_kern| program for left boundary character,
+ |non_address| if there is none}
+@!font_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {right boundary character, |non_char| if there is none}
+@!font_false_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
+@y
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@z
+%---------------------------------------
+@x [30] m.550 l.10723 - Omega
+|font_info[char_base[f]+c].qqqq|; and if |w| is the |width_index|
+part of this word (the |b0| field), the width of the character is
+|font_info[width_base[f]+w].sc|. (These formulas assume that
+|min_quarterword| has already been added to |c| and to |w|, since \TeX\
+stores its quarterwords that way.)
+
+@<Glob...@>=
+@!char_base:array[internal_font_number] of integer;
+ {base addresses for |char_info|}
+@!width_base:array[internal_font_number] of integer;
+ {base addresses for widths}
+@!height_base:array[internal_font_number] of integer;
+ {base addresses for heights}
+@!depth_base:array[internal_font_number] of integer;
+ {base addresses for depths}
+@!italic_base:array[internal_font_number] of integer;
+ {base addresses for italic corrections}
+@!lig_kern_base:array[internal_font_number] of integer;
+ {base addresses for ligature/kerning programs}
+@!kern_base:array[internal_font_number] of integer;
+ {base addresses for kerns}
+@!exten_base:array[internal_font_number] of integer;
+ {base addresses for extensible recipes}
+@!param_base:array[internal_font_number] of integer;
+ {base addresses for font parameters}
+@y
+|font_info(f)(char_base(f)+c).qqqq|; and if |w| is the |width_index|
+part of this word (the |b0| field), the width of the character is
+|font_info(f)(width_base(f)+w).sc|. (These formulas assume that
+|min_quarterword| has already been added to |c| and to |w|, since \TeX\
+stores its quarterwords that way.)
+
+@d font_info_end(#)==#]
+@d font_info(#)==font_tables[#,font_info_end
+@d offset_file_size=0
+@d offset_check=1
+@d offset_offset=offset_check+4
+@d offset_size=offset_offset+1
+@d offset_dsize=offset_size+1
+@d offset_params=offset_dsize+1
+@d offset_name_sort=offset_params+1
+@d offset_name=offset_name_sort+1
+@d offset_area=offset_name+1
+@d offset_bc=offset_area+1
+@d offset_ec=offset_bc+1
+@d offset_glue=offset_ec+1
+@d offset_used=offset_glue+1
+@d offset_hyphen=offset_used+1
+@d offset_skew=offset_hyphen+1
+@d offset_bchar_label=offset_skew+1
+@d offset_bchar=offset_bchar_label+1
+@d offset_false_bchar=offset_bchar+1
+@d offset_ivalues_start=offset_false_bchar+1
+@d offset_fvalues_start=offset_ivalues_start+1
+@d offset_mvalues_start=offset_fvalues_start+1
+@d offset_rules_start=offset_mvalues_start+1
+@d offset_glues_start=offset_rules_start+1
+@d offset_penalties_start=offset_glues_start+1
+@d offset_ivalues_base=offset_penalties_start+1
+@d offset_fvalues_base=offset_ivalues_base+1
+@d offset_mvalues_base=offset_fvalues_base+1
+@d offset_rules_base=offset_mvalues_base+1
+@d offset_glues_base=offset_rules_base+1
+@d offset_penalties_base=offset_glues_base+1
+@d offset_char_base=offset_penalties_base+1
+@d offset_char_attr_base=offset_char_base+1
+@d offset_width_base=offset_char_attr_base+1
+@d offset_height_base=offset_width_base+1
+@d offset_depth_base=offset_height_base+1
+@d offset_italic_base=offset_depth_base+1
+@d offset_lig_kern_base=offset_italic_base+1
+@d offset_kern_base=offset_lig_kern_base+1
+@d offset_exten_base=offset_kern_base+1
+@d offset_param_base=offset_exten_base+1
+@d offset_charinfo_base=offset_param_base+1
+@d font_file_size(#)==font_info(#)(offset_file_size).int
+@d font_check_0(#)==font_info(#)(offset_check).int
+@d font_check_1(#)==font_info(#)(offset_check+1).int
+@d font_check_2(#)==font_info(#)(offset_check+2).int
+@d font_check_3(#)==font_info(#)(offset_check+3).int
+@d font_offset(#)==font_info(#)(offset_offset).int
+@d font_size(#)==font_info(#)(offset_size).int
+@d font_dsize(#)==font_info(#)(offset_dsize).int
+@d font_params(#)==font_info(#)(offset_params).int
+@d font_name_sort(#)==font_info(#)(offset_name_sort).int
+@d font_name(#)==font_info(#)(offset_name).int
+@d font_area(#)==font_info(#)(offset_area).int
+@d font_bc(#)==font_info(#)(offset_bc).int
+@d font_ec(#)==font_info(#)(offset_ec).int
+@d font_glue(#)==font_info(#)(offset_glue).int
+@d font_used(#)==font_info(#)(offset_used).int
+@d hyphen_char(#)==font_info(#)(offset_hyphen).int
+@d skew_char(#)==font_info(#)(offset_skew).int
+@d bchar_label(#)==font_info(#)(offset_bchar_label).int
+@d font_bchar(#)==font_info(#)(offset_bchar).int
+@d font_false_bchar(#)==font_info(#)(offset_false_bchar).int
+@d ivalues_start(#)==font_info(#)(offset_ivalues_start).int
+@d fvalues_start(#)==font_info(#)(offset_fvalues_start).int
+@d mvalues_start(#)==font_info(#)(offset_mvalues_start).int
+@d rules_start(#)==font_info(#)(offset_rules_start).int
+@d glues_start(#)==font_info(#)(offset_glues_start).int
+@d penalties_start(#)==font_info(#)(offset_penalties_start).int
+@d ivalues_base(#)==font_info(#)(offset_ivalues_base).int
+@d fvalues_base(#)==font_info(#)(offset_fvalues_base).int
+@d mvalues_base(#)==font_info(#)(offset_mvalues_base).int
+@d rules_base(#)==font_info(#)(offset_rules_base).int
+@d glues_base(#)==font_info(#)(offset_glues_base).int
+@d penalties_base(#)==font_info(#)(offset_penalties_base).int
+@d char_attr_base(#)==font_info(#)(offset_char_attr_base).int
+@d char_base(#)==font_info(#)(offset_char_base).int
+@d width_base(#)==font_info(#)(offset_width_base).int
+@d height_base(#)==font_info(#)(offset_height_base).int
+@d depth_base(#)==font_info(#)(offset_depth_base).int
+@d italic_base(#)==font_info(#)(offset_italic_base).int
+@d lig_kern_base(#)==font_info(#)(offset_lig_kern_base).int
+@d kern_base(#)==font_info(#)(offset_kern_base).int
+@d exten_base(#)==font_info(#)(offset_exten_base).int
+@d param_base(#)==font_info(#)(offset_param_base).int
+
+@<Glob...@>=
+@!dimen_font:integer;
+@z
+%---------------------------------------
+@x [30] m.551 l.10743 - Omega
+for k:=font_base to font_max do font_used[k]:=false;
+@y
+@z
+%---------------------------------------
+@x [30] m.552 l.10749 - Omega
+font_ptr:=null_font; fmem_ptr:=7;
+font_name[null_font]:="nullfont"; font_area[null_font]:="";
+hyphen_char[null_font]:="-"; skew_char[null_font]:=-1;
+bchar_label[null_font]:=non_address;
+font_bchar[null_font]:=non_char; font_false_bchar[null_font]:=non_char;
+font_bc[null_font]:=1; font_ec[null_font]:=0;
+font_size[null_font]:=0; font_dsize[null_font]:=0;
+char_base[null_font]:=0; width_base[null_font]:=0;
+height_base[null_font]:=0; depth_base[null_font]:=0;
+italic_base[null_font]:=0; lig_kern_base[null_font]:=0;
+kern_base[null_font]:=0; exten_base[null_font]:=0;
+font_glue[null_font]:=null; font_params[null_font]:=7;
+param_base[null_font]:=-1;
+for k:=0 to 6 do font_info[k].sc:=0;
+@y
+font_ptr:=null_font;
+allocate_font_table(null_font,offset_charinfo_base+108);
+font_file_size(null_font):=offset_charinfo_base+108;
+font_used(null_font):=false;
+font_name(null_font):="nullfont"; font_area(null_font):="";
+hyphen_char(null_font):="-"; skew_char(null_font):=-1;
+bchar_label(null_font):=non_address;
+font_bchar(null_font):=non_char; font_false_bchar(null_font):=non_char;
+font_bc(null_font):=1; font_ec(null_font):=0;
+font_size(null_font):=0; font_dsize(null_font):=0;
+char_base(null_font):=offset_charinfo_base;
+char_attr_base(null_font):=offset_charinfo_base;
+ivalues_start(null_font):=offset_charinfo_base;
+fvalues_start(null_font):=offset_charinfo_base;
+mvalues_start(null_font):=offset_charinfo_base;
+rules_start(null_font):=offset_charinfo_base;
+glues_start(null_font):=offset_charinfo_base;
+penalties_start(null_font):=offset_charinfo_base;
+ivalues_base(null_font):=offset_charinfo_base;
+fvalues_base(null_font):=offset_charinfo_base;
+mvalues_base(null_font):=offset_charinfo_base;
+rules_base(null_font):=offset_charinfo_base;
+glues_base(null_font):=offset_charinfo_base;
+penalties_base(null_font):=offset_charinfo_base;
+width_base(null_font):=offset_charinfo_base;
+height_base(null_font):=offset_charinfo_base;
+depth_base(null_font):=offset_charinfo_base;
+italic_base(null_font):=offset_charinfo_base;
+lig_kern_base(null_font):=offset_charinfo_base;
+kern_base(null_font):=offset_charinfo_base;
+exten_base(null_font):=offset_charinfo_base;
+font_glue(null_font):=null;
+font_params(null_font):=7;
+param_base(null_font):=offset_charinfo_base-1;
+font_offset(null_font):=0;
+for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
+@z
+%---------------------------------------
+@x [30] m.553 l.10767 - Omega
+text(frozen_null_font):="nullfont"; eqtb[frozen_null_font]:=eqtb[cur_val];
+@y
+settext(frozen_null_font,"nullfont");
+set_new_eqtb(frozen_null_font,new_eqtb(cur_val));
+@z
+%---------------------------------------
+@x [30] m.554 l.10771 - Omega
+$$\hbox{|font_info[width_base[f]+font_info[char_base[f]+c].qqqq.b0].sc|}$$
+@y
+$$\hbox{|font_info(f)(width_base(f)+font_info(f)(char_base(f)+c).qqqq.b0).sc|}$$
+@z
+%---------------------------------------
+@x [30] m.554 l.10785 - Omega
+|height_depth(q)| will be the 8-bit quantity
+$$b=|height_index|\times16+|depth_index|,$$ and if |b| is such a byte we
+@y
+|height_depth(q)| will be the 16-bit quantity
+$$b=|height_index|\times256+|depth_index|,$$ and if |b| is such a byte we
+@z
+%---------------------------------------
+@x [30] m.554 l.10798 - Omega
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_info[char_base[#]+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_info[width_base[#]+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 4].sc
+@d char_italic(#)==font_info[italic_base[#]+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 16].sc
+@d char_height(#)==font_info[height_base[#]+char_height_end
+@d char_depth_end(#)==(#) mod 16].sc
+@d char_depth(#)==font_info[depth_base[#]+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+@y
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_tables[#,char_base(#)-font_offset(#)+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_tables[#,width_base(#)+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 256].sc
+@d char_italic(#)==font_tables[#,italic_base(#)+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 256].sc
+@d char_height(#)==font_tables[#,height_base(#)+char_height_end
+@d char_depth_end(#)==(#) mod 256].sc
+@d char_depth(#)==font_tables[#,depth_base(#)+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+@z
+%---------------------------------------
+@x [30] m.557 l.10834 - Omega
+|i=font_info[lig_kern_start(f)(j)]| or |font_info[lig_kern_restart(f)(i)]|,
+depending on whether or not |skip_byte(i)<=stop_flag|.
+
+The constant |kern_base_offset| should be simplified, for \PASCAL\ compilers
+that do not do local optimization.
+@^system dependencies@>
+
+@d char_kern_end(#)==256*op_byte(#)+rem_byte(#)].sc
+@d char_kern(#)==font_info[kern_base[#]+char_kern_end
+@d kern_base_offset==256*(128+min_quarterword)
+@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program}
+@d lig_kern_restart_end(#)==256*op_byte(#)+rem_byte(#)+32768-kern_base_offset
+@d lig_kern_restart(#)==lig_kern_base[#]+lig_kern_restart_end
+@y
+|i=font_info(f)(lig_kern_start(f)(j))| or
+|font_info(f)(lig_kern_restart(f)(i))|,
+depending on whether or not |skip_byte(i)<=stop_flag|.
+
+The constant |kern_base_offset| should be simplified, for \PASCAL\ compilers
+that do not do local optimization.
+@^system dependencies@>
+
+@d char_kern_end(#)==256*op_byte(#)+rem_byte(#)].sc
+@d char_kern(#)==font_tables[#,kern_base(#)+char_kern_end
+@d kern_base_offset==256*(128+min_quarterword)
+@d lig_kern_start(#)==lig_kern_base(#)+rem_byte {beginning of lig/kern program}
+@d lig_kern_restart_end(#)==256*op_byte(#)+rem_byte(#)+32768-kern_base_offset
+@d lig_kern_restart(#)==lig_kern_base(#)+lig_kern_restart_end
+
+@d attr_zero_char_ivalue_end(#)==#].int].int
+@d attr_zero_char_ivalue(#)==
+ font_tables[#,font_tables[#,char_attr_base(#)+attr_zero_char_ivalue_end
+@d attr_zero_ivalue_end(#)==#].int
+@d attr_zero_ivalue(#)==font_tables[#,ivalues_base(#)+attr_zero_ivalue_end
+@d attr_zero_penalty_end(#)==#].int
+@d attr_zero_penalty(#)==font_tables[#,penalties_base(#)+attr_zero_penalty_end
+@d attr_zero_kern_end(#)==#].int
+@d attr_zero_kern(#)==font_tables[#,mvalues_base(#)+attr_zero_kern_end
+
+@z
+%---------------------------------------
+@x [30] m.558 l.10843 - Omega
+@d param_end(#)==param_base[#]].sc
+@d param(#)==font_info[#+param_end
+@d slant==param(slant_code) {slant to the right, per unit distance upward}
+@d space==param(space_code) {normal space between words}
+@d space_stretch==param(space_stretch_code) {stretch between words}
+@d space_shrink==param(space_shrink_code) {shrink between words}
+@d x_height==param(x_height_code) {one ex}
+@d quad==param(quad_code) {one em}
+@d extra_space==param(extra_space_code) {additional space at end of sentence}
+@y
+@d slant(#)==font_info(#)(param_base(#)+slant_code).sc
+ {slant to the right, per unit distance upward}
+@d space(#)==font_info(#)(param_base(#)+space_code).sc
+ {normal space between words}
+@d space_stretch(#)==font_info(#)(param_base(#)+space_stretch_code).sc
+ {stretch between words}
+@d space_shrink(#)==font_info(#)(param_base(#)+space_shrink_code).sc
+ {shrink between words}
+@d x_height(#)==font_info(#)(param_base(#)+x_height_code).sc
+ {one ex}
+@d quad(#)==font_info(#)(param_base(#)+quad_code).sc
+ {one em}
+@d extra_space(#)==font_info(#)(param_base(#)+extra_space_code).sc
+ {additional space at end of sentence}
+@z
+%---------------------------------------
+@x [30] m.560 l.10876 - Omega
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled):internal_font_number; {input a \.{TFM} file}
+@y
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled;offset:quarterword):internal_font_number; {input a \.{TFM} file}
+@z
+%---------------------------------------
+@x [30] m.560 l.10882 - Omega
+ {sizes of subfiles}
+@!f:internal_font_number; {the new font's number}
+@!g:internal_font_number; {the number to return}
+@!a,@!b,@!c,@!d:eight_bits; {byte variables}
+@y
+@!font_dir:halfword;
+ {sizes of subfiles}
+@!f:internal_font_number; {the new font's number}
+@!g:internal_font_number; {the number to return}
+@!a,@!b,@!c,@!d:integer; {byte variables}
+@!i,@!k_param,@!param,@!font_counter:integer; {counters}
+@!font_level,@!header_length:integer;
+@!nco,@!ncw,@!npc,@!nlw,@!neew:integer;
+@!nki,@!nwi,@!nkf,@!nwf,@!nkm,@!nwm:integer;
+@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp:integer;
+@!table_size:array [0..31] of integer;
+@!bytes_per_entry,@!extra_char_bytes:integer;
+@!repeat_no,@!table_counter:integer;
+@z
+%---------------------------------------
+@x [30] m.560 l.10888 - Omega
+@!bchar:0..256; {right boundary character, or 256}
+@y
+@!bchar:0..too_big_char; {right boundary character, or |too_big_char|}
+@!first_two:integer;
+@z
+%---------------------------------------
+@x [30] m.563 l.10943 - Omega
+if file_opened then print(" not loadable: Bad metric (TFM) file")
+else print(" not loadable: Metric (TFM) file not found");
+@y
+if file_opened then print(" not loadable: Bad metric (TFM/OFM) file")
+else print(" not loadable: Metric (TFM/OFM) file not found");
+@z
+%---------------------------------------
+@x [30] m.563 l.10943 - Omega
+if aire="" then pack_file_name(nom,TEX_font_area,".tfm")
+else pack_file_name(nom,aire,".tfm");
+if not b_open_in(tfm_file) then abort;
+@y
+if aire="" then pack_file_name(nom,TEX_font_area,".ofm")
+else pack_file_name(nom,aire,".ofm");
+if not b_open_in(tfm_file) then abort;
+@z
+%---------------------------------------
+@x [30] m.564 l.10962 - Omega
+@d store_four_quarters(#)==begin fget; a:=fbyte; qw.b0:=qi(a);
+ fget; b:=fbyte; qw.b1:=qi(b);
+ fget; c:=fbyte; qw.b2:=qi(c);
+ fget; d:=fbyte; qw.b3:=qi(d);
+ #:=qw;
+ end
+@y
+@d read_sixteen_unsigned(#)==begin #:=fbyte;
+ fget; #:=#*@'400+fbyte;
+ end
+@d read_thirtytwo(#)==begin #:=fbyte;
+ if #>127 then abort;
+ fget; #:=#*@'400+fbyte;
+ fget; #:=#*@'400+fbyte;
+ fget; #:=#*@'400+fbyte;
+ end
+@d store_four_bytes(#)==begin fget; a:=fbyte; qw.b0:=a;
+ fget; b:=fbyte; qw.b1:=b;
+ fget; c:=fbyte; qw.b2:=c;
+ fget; d:=fbyte; qw.b3:=d;
+ #:=qw;
+ end
+@d store_char_info(#)==begin if (font_level<>-1) then
+ begin fget; read_sixteen_unsigned(a); qw.b0:=a;
+ fget; read_sixteen_unsigned(b); qw.b1:=b;
+ fget; read_sixteen_unsigned(c); qw.b2:=c;
+ fget; read_sixteen_unsigned(d); qw.b3:=d;
+ #:=qw
+ end
+else
+ begin fget; a:=fbyte; qw.b0:=a;
+ fget; b:=fbyte; b:=((b div 16)*256)+(b mod 16); qw.b1:=b;
+ fget; c:=fbyte; c:=((c div 4)*256)+(c mod 4); qw.b2:=c;
+ fget; d:=fbyte; qw.b3:=d;
+ #:=qw
+ end
+end
+@d store_four_quarters(#)==begin if (font_level<>-1) then
+ begin fget; read_sixteen_unsigned(a); qw.b0:=a;
+ fget; read_sixteen_unsigned(b); qw.b1:=b;
+ fget; read_sixteen_unsigned(c); qw.b2:=c;
+ fget; read_sixteen_unsigned(d); qw.b3:=d;
+ #:=qw
+ end
+else
+ begin fget; a:=fbyte; qw.b0:=a;
+ fget; b:=fbyte; qw.b1:=b;
+ fget; c:=fbyte; qw.b2:=c;
+ fget; d:=fbyte; qw.b3:=d;
+ #:=qw
+ end
+end
+@z
+%---------------------------------------
+@x [30] m.565 l.10970 - Omega
+begin read_sixteen(lf);
+fget; read_sixteen(lh);
+fget; read_sixteen(bc);
+fget; read_sixteen(ec);
+if (bc>ec+1)or(ec>255) then abort;
+if bc>255 then {|bc=256| and |ec=255|}
+ begin bc:=1; ec:=0;
+ end;
+fget; read_sixteen(nw);
+fget; read_sixteen(nh);
+fget; read_sixteen(nd);
+fget; read_sixteen(ni);
+fget; read_sixteen(nl);
+fget; read_sixteen(nk);
+fget; read_sixteen(ne);
+fget; read_sixteen(np);
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort;
+end
+@y
+nco:=0; ncw:=0; npc:=0;
+nki:=0; nwi:=0; nkf:=0; nwf:=0; nkm:=0; nwm:=0;
+nkr:=0; nwr:=0; nkg:=0; nwg:=0; nkp:=0; nwp:=0;
+read_sixteen(first_two);
+if first_two<>0 then begin
+ font_level:=-1;
+ lf:=first_two;
+ fget; read_sixteen(lh);
+ fget; read_sixteen(bc);
+ fget; read_sixteen(ec);
+ if (bc>ec+1)or(ec>255) then abort;
+ if bc>255 then {|bc=256| and |ec=255|}
+ begin bc:=1; ec:=0;
+ end;
+ fget; read_sixteen(nw);
+ fget; read_sixteen(nh);
+ fget; read_sixteen(nd);
+ fget; read_sixteen(ni);
+ fget; read_sixteen(nl);
+ fget; read_sixteen(nk);
+ fget; read_sixteen(ne);
+ fget; read_sixteen(np);
+ header_length:=6;
+ ncw:=(ec-bc+1);
+ nlw:=nl;
+ neew:=ne;
+ end
+else begin
+ fget; read_sixteen(font_level);
+ if (font_level<>0) and (font_level<>1) then abort;
+ fget; read_thirtytwo(lf);
+ fget; read_thirtytwo(lh);
+ fget; read_thirtytwo(bc);
+ fget; read_thirtytwo(ec);
+ if (bc>ec+1)or(ec>biggest_char) then abort;
+ if bc>65535 then {|bc=65536| and |ec=65535|}
+ begin bc:=1; ec:=0;
+ end;
+ fget; read_thirtytwo(nw);
+ fget; read_thirtytwo(nh);
+ fget; read_thirtytwo(nd);
+ fget; read_thirtytwo(ni);
+ fget; read_thirtytwo(nl);
+ fget; read_thirtytwo(nk);
+ fget; read_thirtytwo(ne);
+ fget; read_thirtytwo(np);
+ fget; read_thirtytwo(font_dir);
+ nlw:=2*nl;
+ neew:=2*ne;
+ if font_level=0 then begin
+ header_length:=14;
+ ncw:=2*(ec-bc+1);
+ end
+ else begin
+ header_length:=29;
+ fget; read_thirtytwo(nco);
+ fget; read_thirtytwo(ncw);
+ fget; read_thirtytwo(npc);
+ fget; read_thirtytwo(nki); {Kinds of font ivalues}
+ fget; read_thirtytwo(nwi); {Words of font ivalues}
+ fget; read_thirtytwo(nkf); {Kinds of font fvalues}
+ fget; read_thirtytwo(nwf); {Words of font fvalues}
+ fget; read_thirtytwo(nkm); {Kinds of font mvalues}
+ fget; read_thirtytwo(nwm); {Words of font mvalues}
+ fget; read_thirtytwo(nkr); {Kinds of font rules}
+ fget; read_thirtytwo(nwr); {Words of font rules}
+ fget; read_thirtytwo(nkg); {Kinds of font glues}
+ fget; read_thirtytwo(nwg); {Words of font glues}
+ fget; read_thirtytwo(nkp); {Kinds of font penalties}
+ fget; read_thirtytwo(nwp); {Words of font penalties}
+ end
+ end;
+if lf<>(header_length+lh+ncw+nw+nh+nd+ni+nlw+nk+neew+np+
+ nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp) then abort;
+@z
+%---------------------------------------
+@x [30] m.566 l.10996 - Omega
+lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
+if np<7 then lf:=lf+7-np; {at least seven parameters will appear}
+if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then
+ @<Apologize for not loading the font, |goto done|@>;
+f:=font_ptr+1;
+char_base[f]:=fmem_ptr-bc;
+width_base[f]:=char_base[f]+ec+1;
+height_base[f]:=width_base[f]+nw;
+depth_base[f]:=height_base[f]+nh;
+italic_base[f]:=depth_base[f]+nd;
+lig_kern_base[f]:=italic_base[f]+ni;
+kern_base[f]:=lig_kern_base[f]+nl-kern_base_offset;
+exten_base[f]:=kern_base[f]+kern_base_offset+nk;
+param_base[f]:=exten_base[f]+ne
+@y
+case font_level of
+-1: lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
+ 0: lf:=lf-14-lh-(ec-bc+1)-nl-ne;
+ {some of the sections contain pairs of
+ words that become single |memory_word|s}
+ 1: lf:=lf-29-lh-ncw+(1+npc)*(ec-bc+1)-nl-ne;
+ {We explode the characters}
+end;
+if np<7 then lf:=lf+7-np; {at least seven parameters will appear}
+if (font_ptr=font_max) then
+ @<Apologize for not loading the font, |goto done|@>;
+f:=font_ptr+1;
+allocate_font_table(f,offset_charinfo_base+lf+100);
+ {leave room for 100 extra parameters -- potential bug}
+font_file_size(f):=offset_charinfo_base+lf+100;
+font_used(f):=false;
+font_offset(f):=offset;
+char_base(f):=offset_charinfo_base-bc;
+char_attr_base(f):=char_base(f)+ec+1;
+ivalues_start(f):=char_attr_base(f)+npc*(ec-bc+1);
+fvalues_start(f):=ivalues_start(f)+nki;
+mvalues_start(f):=fvalues_start(f)+nkf;
+rules_start(f):=mvalues_start(f)+nkm;
+glues_start(f):=rules_start(f)+nkr;
+penalties_start(f):=glues_start(f)+nkg;
+ivalues_base(f):=penalties_start(f)+nkp;
+fvalues_base(f):=ivalues_base(f)+nwi;
+mvalues_base(f):=fvalues_base(f)+nwf;
+rules_base(f):=mvalues_base(f)+nwm;
+glues_base(f):=rules_base(f)+nwr;
+penalties_base(f):=glues_base(f)+nwg;
+width_base(f):=penalties_base(f)+nwp;
+height_base(f):=width_base(f)+nw;
+depth_base(f):=height_base(f)+nh;
+italic_base(f):=depth_base(f)+nd;
+lig_kern_base(f):=italic_base(f)+ni;
+kern_base(f):=lig_kern_base(f)+nl-kern_base_offset;
+exten_base(f):=kern_base(f)+kern_base_offset+nk;
+param_base(f):=exten_base(f)+ne;
+@z
+%---------------------------------------
+@x [30] m.568 l.11026 - Omega
+store_four_quarters(font_check[f]);
+@y
+fget; font_check_0(f):=fbyte;
+fget; font_check_1(f):=fbyte;
+fget; font_check_2(f):=fbyte;
+fget; font_check_3(f):=fbyte;
+@z
+%---------------------------------------
+@x [30] m.568 l.11033 - Omega
+font_dsize[f]:=z;
+if s<>-1000 then
+ if s>=0 then z:=s
+ else z:=xn_over_d(z,-s,1000);
+font_size[f]:=z;
+@y
+font_dsize(f):=z;
+if s<>-1000 then
+ if s>=0 then z:=s
+ else z:=xn_over_d(z,-s,1000);
+font_size(f):=z;
+@z
+%---------------------------------------
+@x [30] m.569 l.11041 - Omega
+for k:=fmem_ptr to width_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if (a>=nw)or(b div @'20>=nh)or(b mod @'20>=nd)or
+ (c div 4>=ni) then abort;
+ case c mod 4 of
+ lig_tag: if d>=nl then abort;
+ ext_tag: if d>=ne then abort;
+ list_tag: @<Check for charlist cycle@>;
+ othercases do_nothing {|no_tag|}
+ endcases;
+ end
+@y
+if font_level=1 then begin
+ i:=0;
+ k:=ivalues_start(f);
+ font_counter:=ivalues_base(f);
+ while k<fvalues_start(f) do {IVALUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<mvalues_start(f) do {FVALUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<rules_start(f) do {MVALUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<glues_start(f) do {RULE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param*3;
+ table_size[i]:=3;
+ incr(i); incr(k);
+ end;
+ while k<penalties_start(f) do {GLUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param*4;
+ table_size[i]:=4;
+ incr(i); incr(k);
+ end;
+ while k<ivalues_base(f) do {PENALTY starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param*1;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<fvalues_base(f) do {IVALUE entries}
+ begin
+ read_thirtytwo(font_info(f)(k).int);
+ incr(k);
+ end;
+ while k<mvalues_base(f) do {FVALUE entries}
+ begin
+ read_thirtytwo(font_info(f)(k).sc);
+ incr(k);
+ end;
+ while k<rules_base(f) do {MVALUE entries}
+ begin
+ read_thirtytwo(font_info(f)(k).int);
+ incr(k);
+ end;
+ while k<glues_base(f) do {RULE entries}
+ begin
+ store_scaled(font_info(f)(k).sc);
+ store_scaled(font_info(f)(k+1).sc);
+ store_scaled(font_info(f)(k+2).sc);
+ k:=k+3;
+ end;
+ while k<penalties_base(f) do {GLUE entries}
+ begin
+ fget; read_sixteen(font_info(f)(k).hh.lhfield);
+ fget; read_sixteen(font_info(f)(k).hh.rh);
+ store_scaled(font_info(f)(k+1).sc);
+ store_scaled(font_info(f)(k+2).sc);
+ store_scaled(font_info(f)(k+3).sc);
+ k:=k+4;
+ end;
+ while k<offset_charinfo_base do {PENALTY entries}
+ begin
+ read_thirtytwo(font_info(f)(k).int);
+ incr(k);
+ end;
+ end;
+k:=char_base(f)+bc;
+k_param:=char_attr_base(f);
+bytes_per_entry:=(12 + 2*npc) div 4 * 4;
+extra_char_bytes:=bytes_per_entry - (10 + 2*npc);
+while k<char_attr_base(f) do begin
+ store_char_info(font_info(f)(k).qqqq);
+ if (a>=nw)or((b div @"100)>=nh)or((b mod @"100)>=nd)or
+ ((c div @"100)>=ni) then abort;
+ case c mod 4 of
+ lig_tag: if d>=nl then abort;
+ ext_tag: if d>=ne then abort;
+ list_tag: @<Check for charlist cycle@>;
+ othercases do_nothing {|no_tag|}
+ endcases;
+ incr(k);
+ if font_level=1 then begin
+ fget; read_sixteen_unsigned(repeat_no);
+ for i:=0 to npc-1 do begin
+ fget; read_sixteen(param);
+ font_info(f)(k_param).int :=
+ font_info(f)(ivalues_start(f)+i).int + param*table_size[i];
+ incr(k_param);
+ end;
+ for i:=1 to extra_char_bytes do fget;
+ for i:=1 to repeat_no do begin
+ font_info(f)(k):=font_info(f)(k-1);
+ incr(k);
+ for table_counter:=0 to npc-1 do begin
+ font_info(f)(k_param).int := font_info(f)(k_param-npc).int;
+ incr(k_param);
+ end;
+ end;
+ end;
+ end
+@z
+%---------------------------------------
+@x [30] m.570 l.11059 - Omega
+@d current_character_being_worked_on==k+bc-fmem_ptr
+@y
+@d current_character_being_worked_on==k-char_base(f)
+@z
+%---------------------------------------
+@x [30] m.570 l.11065 - Omega
+ begin qw:=char_info(f)(d);
+ {N.B.: not |qi(d)|, since |char_base[f]| hasn't been adjusted yet}
+@y
+ begin qw:=char_info(f)(d);
+ {N.B.: not |qi(d)|, since |char_base(f)| hasn't been adjusted yet}
+@z
+%---------------------------------------
+@x [30] m.571 l.11098 - Omega
+for k:=width_base[f] to lig_kern_base[f]-1 do
+ store_scaled(font_info[k].sc);
+if font_info[width_base[f]].sc<>0 then abort; {\\{width}[0] must be zero}
+if font_info[height_base[f]].sc<>0 then abort; {\\{height}[0] must be zero}
+if font_info[depth_base[f]].sc<>0 then abort; {\\{depth}[0] must be zero}
+if font_info[italic_base[f]].sc<>0 then abort; {\\{italic}[0] must be zero}
+@y
+for k:=width_base(f) to lig_kern_base(f)-1 do
+ store_scaled(font_info(f)(k).sc);
+if font_info(f)(width_base(f)).sc<>0 then abort; {\\{width}[0] must be zero}
+if font_info(f)(height_base(f)).sc<>0 then abort; {\\{height}[0] must be zero}
+if font_info(f)(depth_base(f)).sc<>0 then abort; {\\{depth}[0] must be zero}
+if font_info(f)(italic_base(f)).sc<>0 then abort; {\\{italic}[0] must be zero}
+@z
+%---------------------------------------
+@x [30] m.573 l.11114 - Omega
+@ @d check_existence(#)==@t@>@;@/
+ begin check_byte_range(#);
+ qw:=char_info(f)(#); {N.B.: not |qi(#)|}
+ if not char_exists(qw) then abort;
+ end
+
+@<Read ligature/kern program@>=
+bch_label:=@'77777; bchar:=256;
+if nl>0 then
+ begin for k:=lig_kern_base[f] to kern_base[f]+kern_base_offset-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if a>128 then
+ begin if 256*c+d>=nl then abort;
+ if a=255 then if k=lig_kern_base[f] then bchar:=b;
+ end
+ else begin if b<>bchar then check_existence(b);
+ if c<128 then check_existence(d) {check ligature}
+ else if 256*(c-128)+d>=nk then abort; {check kern}
+ if a<128 then if k-lig_kern_base[f]+a+1>=nl then abort;
+ end;
+ end;
+ if a=255 then bch_label:=256*c+d;
+ end;
+for k:=kern_base[f]+kern_base_offset to exten_base[f]-1 do
+ store_scaled(font_info[k].sc);
+@y
+@ @d check_existence(#)==@t@>@;@/
+ begin check_byte_range(#);
+ qw:=char_info(f)(#+font_offset(f)); {N.B.: not |qi(#)|}
+ if not char_exists(qw) then abort;
+ end
+
+@<Read ligature/kern program@>=
+bch_label:=nl {infinity}; bchar:=too_big_char;
+if nl>0 then
+ begin for k:=lig_kern_base(f) to kern_base(f)+kern_base_offset-1 do
+ begin store_four_quarters(font_info(f)(k).qqqq);
+ if a>128 then
+ begin if 256*c+d>=nl then abort;
+ if a=255 then if k=lig_kern_base(f) then bchar:=b;
+ end
+ else begin if b<>bchar then check_existence(b);
+ if c<128 then check_existence(d) {check ligature}
+ else if 256*(c-128)+d>=nk then abort; {check kern}
+ if a<128 then if k-lig_kern_base(f)+a+1>=nl then abort;
+ end;
+ end;
+ if a=255 then bch_label:=256*c+d;
+ end;
+for k:=kern_base(f)+kern_base_offset to exten_base(f)-1 do
+ store_scaled(font_info(f)(k).sc);
+@z
+%---------------------------------------
+@x [30] m.574 l.11141 - Omega
+for k:=exten_base[f] to param_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+@y
+for k:=exten_base(f) to param_base(f)-1 do
+ begin store_four_quarters(font_info(f)(k).qqqq);
+@z
+%---------------------------------------
+@x [30] m.575 l.11157 - Omega
+ fget; font_info[param_base[f]].sc:=
+ (sw*@'20)+(fbyte div@'20);
+ end
+ else store_scaled(font_info[param_base[f]+k-1].sc);
+if eof(tfm_file) then abort;
+for k:=np+1 to 7 do font_info[param_base[f]+k-1].sc:=0;
+@y
+ fget; font_info(f)(param_base(f)).sc:=
+ (sw*@'20)+(fbyte div@'20);
+ end
+ else store_scaled(font_info(f)(param_base(f)+k-1).sc);
+if eof(tfm_file) then abort;
+for k:=np+1 to 7 do font_info(f)(param_base(f)+k-1).sc:=0;
+@z
+%---------------------------------------
+@x [30] m.576 l.11169 - Omega
+@d adjust(#)==#[f]:=qo(#[f])
+ {correct for the excess |min_quarterword| that was added}
+
+@<Make final adjustments...@>=
+if np>=7 then font_params[f]:=np@+else font_params[f]:=7;
+hyphen_char[f]:=default_hyphen_char; skew_char[f]:=default_skew_char;
+if bch_label<nl then bchar_label[f]:=bch_label+lig_kern_base[f]
+else bchar_label[f]:=non_address;
+font_bchar[f]:=qi(bchar);
+font_false_bchar[f]:=qi(bchar);
+if bchar<=ec then if bchar>=bc then
+ begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+ if char_exists(qw) then font_false_bchar[f]:=non_char;
+ end;
+font_name[f]:=nom;
+font_area[f]:=aire;
+font_bc[f]:=bc; font_ec[f]:=ec; font_glue[f]:=null;
+adjust(char_base); adjust(width_base); adjust(lig_kern_base);
+adjust(kern_base); adjust(exten_base);
+decr(param_base[f]);
+fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; goto done
+@y
+@d adjust(#)==#(f):=qo(#(f))
+ {correct for the excess |min_quarterword| that was added}
+
+@<Make final adjustments...@>=
+if np>=7 then font_params(f):=np@+else font_params(f):=7;
+font_offset(f):=offset;
+hyphen_char(f):=default_hyphen_char+offset;
+skew_char(f):=default_skew_char+offset;
+bchar:=bchar+offset;
+if bch_label<nl then bchar_label(f):=bch_label+lig_kern_base(f)
+else bchar_label(f):=non_address;
+font_bchar(f):=qi(bchar);
+font_false_bchar(f):=qi(bchar);
+if bchar<=ec then if bchar>=bc then
+ begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+ if char_exists(qw) then font_false_bchar(f):=non_char;
+ end;
+font_name(f):=nom;
+font_area(f):=aire;
+font_bc(f):=bc; font_ec(f):=ec; font_glue(f):=null;
+font_bc(f):=bc+offset; font_ec(f):=ec+offset; font_glue(f):=null;
+adjust(char_base); adjust(width_base); adjust(lig_kern_base);
+adjust(kern_base); adjust(exten_base);
+decr(param_base(f));
+font_ptr:=f; g:=f; goto done
+@z
+%---------------------------------------
+@x [30] m.577 l.11202 - Omega
+ begin m:=cur_chr; scan_four_bit_int; f:=equiv(m+cur_val);
+@y
+ begin m:=cur_chr; scan_big_four_bit_int; f:=equiv(m+cur_val);
+@z
+%---------------------------------------
+@x [30] m.578 l.11223 - Omega
+if n<=0 then cur_val:=fmem_ptr
+else begin if writing and(n<=space_shrink_code)and@|
+ (n>=space_code)and(font_glue[f]<>null) then
+ begin delete_glue_ref(font_glue[f]);
+ font_glue[f]:=null;
+ end;
+ if n>font_params[f] then
+ if f<font_ptr then cur_val:=fmem_ptr
+ else @<Increase the number of parameters in the last font@>
+ else cur_val:=n+param_base[f];
+ end;
+@<Issue an error message if |cur_val=fmem_ptr|@>;
+end;
+@y
+dimen_font:=f;
+if n<=0 then cur_val:=font_file_size(f)
+else begin if writing and(n<=space_shrink_code)and@|
+ (n>=space_code)and(font_glue(f)<>null) then
+ begin delete_glue_ref(font_glue(f));
+ font_glue(f):=null;
+ end;
+ if n>font_params(f) then
+ if f<font_ptr then cur_val:=font_file_size(f)
+ else @<Increase the number of parameters in the last font@>
+ else cur_val:=n+param_base(f);
+ end;
+@<Issue an error message if |cur_val=font_file_size(f)|@>;
+end;
+@z
+%---------------------------------------
+@x [30] m.579 l.11240 - Omega
+@ @<Issue an error message if |cur_val=fmem_ptr|@>=
+if cur_val=fmem_ptr then
+ begin print_err("Font "); print_esc(font_id_text(f));
+ print(" has only "); print_int(font_params[f]);
+ print(" fontdimen parameters");
+@.Font x has only...@>
+ help2("To increase the number of font parameters, you must")@/
+ ("use \fontdimen immediately after the \font is loaded.");
+ error;
+ end
+@y
+@ @<Issue an error message if |cur_val=font_file_size(f)|@>=
+if cur_val=font_file_size(f) then
+ begin print_err("Font "); print_esc(font_id_text(f));
+ print(" has only "); print_int(font_params(f));
+ print(" fontdimen parameters");
+@.Font x has only...@>
+ help2("To increase the number of font parameters, you must")@/
+ ("use \fontdimen immediately after the \font is loaded.");
+ error;
+ end
+@z
+%---------------------------------------
+@x [30] m.580 l.11252 - font parameters
+@ @<Increase the number of parameters...@>=
+begin repeat if fmem_ptr=font_mem_size then
+ overflow("font memory",font_mem_size);
+@:TeX capacity exceeded font memory}{\quad font memory@>
+font_info[fmem_ptr].sc:=0; incr(fmem_ptr); incr(font_params[f]);
+until n=font_params[f];
+cur_val:=fmem_ptr-1; {this equals |param_base[f]+font_params[f]|}
+@y
+@ @<Increase the number of parameters...@>=
+begin if n+font_params(f)>font_file_size(f) then
+ begin print_nl("Out of font parameter space"); succumb; end;
+repeat
+font_info(f)(param_base(f)+font_params(f)).sc:=0; incr(font_params(f));
+until n=font_params(f);
+cur_val:=param_base(f)+font_params(f);
+@z
+%---------------------------------------
+@x [30] m.581 l.11268 - font parameters
+ slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
+@y
+ slow_print(font_name(f)); print_char("!"); end_diagnostic(false);
+@z
+%---------------------------------------
+@x [30] m.582 l.11276 - font parameters
+begin if font_bc[f]<=c then if font_ec[f]>=c then
+@y
+begin if font_bc(f)<=c then if font_ec(f)>=c then
+@z
+%---------------------------------------
+@x [32] m.592 l.11820 - Omega
+@!c,@!f:quarterword; {character and font in current |char_node|}
+@y
+@!c,@!f:quarterword; {character and font in current |char_node|}
+@!oval,@!ocmd:integer; {used by |out_cmd| for generating
+ |set|, |fnt| and |fnt_def| commands}
+@z
+%---------------------------------------
+@x [32] m.602 l.11939 - Omega
+@ Here's a procedure that outputs a font definition. Since \TeX82 uses at
+most 256 different fonts per job, |fnt_def1| is always used as the command code.
+@y
+@ Here's a procedure that outputs a font definition. $\Omega$ allows
+more than 256 different fonts per job, so the right font definition
+command must be selected.
+
+@d Incr_Decr(#) == #
+@d Incr(#) == #:=#+Incr_Decr {increase a variable}
+@d Decr(#) == #:=#-Incr_Decr {decrease a variable}
+
+@d dvi_debug_out(#)==begin
+dvi_out(#);
+end
+
+@d out_cmd ==
+begin
+if (oval<@"100)and(oval>=0) then begin
+ if (ocmd<>set1)or(oval>127) then
+ if (ocmd=fnt1)and(oval<64) then Incr(oval)(fnt_num_0) @+ else dvi_debug_out(ocmd);
+ end
+else
+ begin if (oval<@"10000)and(oval>=0) then dvi_debug_out(ocmd+1) @+ else @;
+ begin if (oval<@"1000000)and(oval>=0) then dvi_debug_out(ocmd+2) @+ else @;
+ begin dvi_debug_out(ocmd+3);
+ if oval>=0 then dvi_debug_out(oval div @"1000000)
+ else begin Incr(oval)(@"40000000); Incr(oval)(@"40000000);
+ dvi_debug_out((oval div @"1000000) + 128); oval:=oval mod @"1000000;
+ end;
+ dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
+ end;
+ dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
+ end;
+ dvi_debug_out(oval div @"100); oval:=oval mod @"100;
+ end;
+dvi_debug_out(oval)
+end
+
+@z
+%---------------------------------------
+@x [32] m.602 l.11944 - Omega
+begin dvi_out(fnt_def1);
+dvi_out(f-font_base-1);@/
+dvi_out(qo(font_check[f].b0));
+dvi_out(qo(font_check[f].b1));
+dvi_out(qo(font_check[f].b2));
+dvi_out(qo(font_check[f].b3));@/
+dvi_four(font_size[f]);
+dvi_four(font_dsize[f]);@/
+dvi_out(length(font_area[f]));
+dvi_out(length(font_name[f]));
+@y
+begin
+oval:=f-font_base-1; ocmd:= fnt_def1; out_cmd;@/
+dvi_out(qo(font_check_0(f)));
+dvi_out(qo(font_check_1(f)));
+dvi_out(qo(font_check_2(f)));
+dvi_out(qo(font_check_3(f)));@/
+dvi_four(font_size(f));
+dvi_four(font_dsize(f));@/
+dvi_out(length(font_area(f)));
+dvi_out(length(font_name(f)));
+@z
+%---------------------------------------
+@x [32] m.603 l.11958 - Omega
+for k:=str_start[font_area[f]] to str_start[font_area[f]+1]-1 do
+ dvi_out(so(str_pool[k]));
+for k:=str_start[font_name[f]] to str_start[font_name[f]+1]-1 do
+ dvi_out(so(str_pool[k]))
+@y
+for k:=str_start(font_area(f)) to str_start(font_area(f)+1)-1 do
+ dvi_out(so(str_pool[k]));
+for k:=str_start(font_name(f)) to str_start(font_name(f)+1)-1 do
+ dvi_out(so(str_pool[k]))
+@z
+%---------------------------------------
+@x [32] m.620 l.12334 - Omega
+ if c>=qi(128) then dvi_out(set1);
+ dvi_out(qo(c));@/
+@y
+ oval:=c-font_offset(f); ocmd:=set1; out_cmd;@/
+@z
+%---------------------------------------
+@x [32] m.621 l.12345 - Omega
+begin if not font_used[f] then
+ begin dvi_font_def(f); font_used[f]:=true;
+ end;
+if f<=64+font_base then dvi_out(f-font_base-1+fnt_num_0)
+else begin dvi_out(fnt1); dvi_out(f-font_base-1);
+ end;
+@y
+begin if not font_used(f) then
+ begin dvi_font_def(f); font_used(f):=true;
+ end;
+oval:=f-font_base-1; ocmd:=fnt1; out_cmd;@/
+@z
+%---------------------------------------
+@x [32] m.643 l.12757 - Omega
+ begin if font_used[font_ptr] then dvi_font_def(font_ptr);
+@y
+ begin if font_used(font_ptr) then dvi_font_def(font_ptr);
+@z
+%---------------------------------------
+@x [35] m.699 l.13742 - Omega
+@d text_size=0 {size code for the largest size in a family}
+@d script_size=16 {size code for the medium size in a family}
+@d script_script_size=32 {size code for the smallest size in a family}
+@y
+@z
+%---------------------------------------
+@x [35] m.700 l.13762 - Omega
+@d mathsy_end(#)==fam_fnt(2+#)]].sc
+@d mathsy(#)==font_info[#+param_base[mathsy_end
+@y
+@d mathsy_end(#)==sc
+@d mathsy(#)==font_info(fam_fnt(2+cur_size))(#+param_base(fam_fnt(2+cur_size))).mathsy_end
+@z
+%---------------------------------------
+@x [35] m.701 l.13789 - Omega
+@d mathex(#)==font_info[#+param_base[fam_fnt(3+cur_size)]].sc
+@y
+@d mathex(#)==font_info(fam_fnt(3+cur_size))(#+param_base(fam_fnt(3+cur_size))).sc
+@z
+%---------------------------------------
+@x [35] m.703 l.13813 - Omega
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
+begin if cur_style<script_style then cur_size:=text_size
+else cur_size:=16*((cur_style-text_style) div 2);
+cur_mu:=x_over_n(math_quad(cur_size),18);
+end
+@y
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
+begin if cur_style<script_style then cur_size:=text_size
+else cur_size:=script_size*((cur_style-text_style) div 2);
+cur_mu:=x_over_n(math_quad(cur_size),18);
+end
+@z
+%---------------------------------------
+@x [35] m.706 l.13855 - Omega
+function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer;
+label found,continue;
+var b:pointer; {the box that will be constructed}
+@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
+@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
+@!m,@!n: integer; {the number of extensible pieces}
+@!u: scaled; {height-plus-depth of a tentative character}
+@!w: scaled; {largest height-plus-depth so far}
+@!q: four_quarters; {character info}
+@!hd: eight_bits; {height-depth byte}
+@!r: four_quarters; {extensible pieces}
+@!z: small_number; {runs through font family members}
+@y
+function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer;
+label found,continue;
+var b:pointer; {the box that will be constructed}
+@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
+@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
+@!m,@!n: integer; {the number of extensible pieces}
+@!u: scaled; {height-plus-depth of a tentative character}
+@!w: scaled; {largest height-plus-depth so far}
+@!q: four_quarters; {character info}
+@!hd: eight_bits; {height-depth byte}
+@!r: four_quarters; {extensible pieces}
+@!z: integer; {runs through font family members}
+@z
+%---------------------------------------
+@x [35] m.706 l.13881 - Omega
+shift_amount(b):=half(height(b)-depth(b)) - axis_height(s);
+@y
+z:=cur_size; cur_size:=s;
+shift_amount(b):=half(height(b)-depth(b)) - axis_height(cur_size);
+cur_size:=z;
+@z
+%---------------------------------------
+@x [35] m.707 l.13889 - Omega
+@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
+if (z<>0)or(x<>min_quarterword) then
+ begin z:=z+s+16;
+ repeat z:=z-16; g:=fam_fnt(z);
+ if g<>null_font then
+ @<Look at the list of characters starting with |x| in
+ font |g|; set |f| and |c| whenever
+ a better character is found; |goto found| as soon as a
+ large enough variant is encountered@>;
+ until z<16;
+ end
+@y
+@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
+if (z<>0)or(x<>min_quarterword) then
+ begin z:=z+s+script_size;
+ repeat z:=z-script_size; g:=fam_fnt(z);
+ if g<>null_font then
+ @<Look at the list of characters starting with |x| in
+ font |g|; set |f| and |c| whenever
+ a better character is found; |goto found| as soon as a
+ large enough variant is encountered@>;
+ until z<script_size;
+ end
+@z
+%---------------------------------------
+@x [35] m.708 l.13903 - Omega
+if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
+@y
+if (qo(y)>=font_bc(g))and(qo(y)<=font_ec(g)) then
+@z
+%---------------------------------------
+@x [35] m.713 l.13974 - Omega
+r:=font_info[exten_base[f]+rem_byte(q)].qqqq;@/
+@<Compute the minimum suitable height, |w|, and the corresponding
+ number of extension steps, |n|; also set |width(b)|@>;
+c:=ext_bot(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+c:=ext_rep(r);
+for m:=1 to n do stack_into_box(b,f,c);
+c:=ext_mid(r);
+if c<>min_quarterword then
+ begin stack_into_box(b,f,c); c:=ext_rep(r);
+ for m:=1 to n do stack_into_box(b,f,c);
+ end;
+c:=ext_top(r);
+@y
+r:=font_info(f)(exten_base(f)+rem_byte(q)).qqqq;@/
+@<Compute the minimum suitable height, |w|, and the corresponding
+ number of extension steps, |n|; also set |width(b)|@>;
+c:=ext_bot(f)(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+c:=ext_rep(f)(r);
+for m:=1 to n do stack_into_box(b,f,c);
+c:=ext_mid(f)(r);
+if c<>min_quarterword then
+ begin stack_into_box(b,f,c); c:=ext_rep(f)(r);
+ for m:=1 to n do stack_into_box(b,f,c);
+ end;
+c:=ext_top(f)(r);
+@z
+%---------------------------------------
+@x [35] m.714 l.13997 - Omega
+c:=ext_rep(r); u:=height_plus_depth(f,c);
+w:=0; q:=char_info(f)(c); width(b):=char_width(f)(q)+char_italic(f)(q);@/
+c:=ext_bot(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_mid(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_top(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+n:=0;
+if u>0 then while w<v do
+ begin w:=w+u; incr(n);
+ if ext_mid(r)<>min_quarterword then w:=w+u;
+ end
+@y
+c:=ext_rep(f)(r); u:=height_plus_depth(f,c);
+w:=0; q:=char_info(f)(c); width(b):=char_width(f)(q)+char_italic(f)(q);@/
+c:=ext_bot(f)(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_mid(f)(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_top(f)(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+n:=0;
+if u>0 then while w<v do
+ begin w:=w+u; incr(n);
+ if (ext_mid(f)(r))<>min_quarterword then w:=w+u;
+ end
+@z
+%---------------------------------------
+@x [36] m.719 l.14107 - Omega
+@!cur_style:small_number; {style code at current place in the list}
+@!cur_size:small_number; {size code corresponding to |cur_style|}
+@y
+@!cur_style:integer; {style code at current place in the list}
+@!cur_size:integer; {size code corresponding to |cur_style|}
+@z
+%---------------------------------------
+@x [36] m.720 l.14122 - Omega
+function clean_box(@!p:pointer;@!s:small_number):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:small_number; {|cur_style| to be restored}
+@y
+function clean_box(@!p:pointer;@!s:integer):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:integer; {|cur_style| to be restored}
+@z
+%---------------------------------------
+@x [36] m.722 l.14172 - Omega
+else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
+@y
+else begin if (qo(cur_c)>=font_bc(cur_f))and(qo(cur_c)<=font_ec(cur_f)) then
+@z
+%---------------------------------------
+@x [36] m.726 l.14228 - Omega
+procedure mlist_to_hlist;
+label reswitch, check_dimensions, done_with_noad, done_with_node, delete_q,
+ done;
+var mlist:pointer; {beginning of the given list}
+@!penalties:boolean; {should penalty nodes be inserted?}
+@!style:small_number; {the given style}
+@!save_style:small_number; {holds |cur_style| during recursion}
+@!q:pointer; {runs through the mlist}
+@!r:pointer; {the most recent noad preceding |q|}
+@!r_type:small_number; {the |type| of noad |r|, or |op_noad| if |r=null|}
+@!t:small_number; {the effective |type| of noad |q| during the second pass}
+@!p,@!x,@!y,@!z: pointer; {temporary registers for list construction}
+@!pen:integer; {a penalty to be inserted}
+@!s:small_number; {the size of a noad to be deleted}
+@y
+procedure mlist_to_hlist;
+label reswitch, check_dimensions, done_with_noad, done_with_node, delete_q,
+ done;
+var mlist:pointer; {beginning of the given list}
+@!penalties:boolean; {should penalty nodes be inserted?}
+@!style:integer; {the given style}
+@!save_style:integer; {holds |cur_style| during recursion}
+@!q:pointer; {runs through the mlist}
+@!r:pointer; {the most recent noad preceding |q|}
+@!r_type:integer; {the |type| of noad |r|, or |op_noad| if |r=null|}
+@!t:integer; {the effective |type| of noad |q| during the second pass}
+@!p,@!x,@!y,@!z: pointer; {temporary registers for list construction}
+@!pen:integer; {a penalty to be inserted}
+@!s:integer; {the size of a noad to be deleted}
+@z
+%---------------------------------------
+@x [36] m.741 l.14495 - Omega
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin if qo(next_char(cur_i))=skew_char[cur_f] then
+ begin if op_byte(cur_i)>=kern_flag then
+ if skip_byte(cur_i)<=stop_flag then s:=char_kern(cur_f)(cur_i);
+ goto done1;
+ end;
+ if skip_byte(cur_i)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+ end;
+ end;
+ end;
+done1:
+@y
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_i:=font_info(cur_f)(a).qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info(cur_f)(a).qqqq;
+ end;
+ loop@+ begin if qo((next_char(cur_f)(cur_i)))=skew_char(cur_f) then
+ begin if op_byte(cur_i)>=kern_flag then
+ if skip_byte(cur_i)<=stop_flag then s:=char_kern(cur_f)(cur_i);
+ goto done1;
+ end;
+ if skip_byte(cur_i)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info(cur_f)(a).qqqq;
+ end;
+ end;
+ end;
+done1:
+@z
+%---------------------------------------
+@x [36] m.752 l.14722 - Omega
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach
+ the kern after~|q|; or if it is a ligature with |cur_c|, combine
+ noads |q| and~|p| appropriately; then |return| if the cursor has
+ moved past a noad, or |goto restart|@>;
+ if skip_byte(cur_i)>=stop_flag then return;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+@y
+ cur_i:=font_info(cur_f)(a).qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info(cur_f)(a).qqqq;
+ end;
+ loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach
+ the kern after~|q|; or if it is a ligature with |cur_c|, combine
+ noads |q| and~|p| appropriately; then |return| if the cursor has
+ moved past a noad, or |goto restart|@>;
+ if skip_byte(cur_i)>=stop_flag then return;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info(cur_f)(a).qqqq;
+@z
+%---------------------------------------
+@x [36] m.753 l.14751 - Omega
+if next_char(cur_i)=cur_c then if skip_byte(cur_i)<=stop_flag then
+@y
+if (next_char(cur_f)(cur_i))=cur_c then if skip_byte(cur_i)<=stop_flag then
+@z
+%---------------------------------------
+@x [36] m.756 l.14833 - Omega
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:small_number; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural);
+ if cur_style<script_style then t:=script_size@+else t:=script_script_size;
+ shift_up:=height(z)-sup_drop(t);
+ shift_down:=depth(z)+sub_drop(t);
+@y
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:integer; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural);
+ t:=cur_size;
+ if cur_style<script_style
+ then cur_size:=script_size@+else cur_size:=script_script_size;
+ shift_up:=height(z)-sup_drop(cur_size);
+ shift_down:=depth(z)+sub_drop(cur_size);
+ cur_size:=t;
+@z
+%---------------------------------------
+@x [36] m.762 l.14967 - Omega
+function make_left_right(@!q:pointer;@!style:small_number;
+ @!max_d,@!max_h:scaled):small_number;
+var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
+begin if style<script_style then cur_size:=text_size
+else cur_size:=16*((style-text_style) div 2);
+@y
+function make_left_right(@!q:pointer;@!style:integer;
+ @!max_d,@!max_h:scaled):integer;
+var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
+begin if style<script_style then cur_size:=text_size
+else cur_size:=script_size*((style-text_style) div 2);
+@z
+%---------------------------------------
+@x [40] m.896 l.17534 - Omega
+done2: hyf_char:=hyphen_char[hf];
+@y
+done2: hyf_char:=hyphen_char(hf);
+@z
+%---------------------------------------
+@x [40] m.897 l.17555 - Omega
+ hyf_bchar:=font_bchar[hf];
+@y
+ hyf_bchar:=font_bchar(hf);
+@z
+%---------------------------------------
+@x [40] m.898 l.17578 - Omega
+if odd(subtype(s)) then hyf_bchar:=font_bchar[hf]@+else hyf_bchar:=non_char;
+@y
+if odd(subtype(s)) then hyf_bchar:=font_bchar(hf)@+else hyf_bchar:=non_char;
+@z
+%---------------------------------------
+@x [41] m.909 l.17800 - Omega
+ begin k:=bchar_label[hf];
+ if k=non_address then goto done@+else q:=font_info[k].qqqq;
+ end
+else begin q:=char_info(hf)(cur_l);
+ if char_tag(q)<>lig_tag then goto done;
+ k:=lig_kern_start(hf)(q); q:=font_info[k].qqqq;
+ if skip_byte(q)>stop_flag then
+ begin k:=lig_kern_restart(hf)(q); q:=font_info[k].qqqq;
+@y
+ begin k:=bchar_label(hf);
+ if k=non_address then goto done@+else q:=font_info(hf)(k).qqqq;
+ end
+else begin q:=char_info(hf)(cur_l);
+ if char_tag(q)<>lig_tag then goto done;
+ k:=lig_kern_start(hf)(q); q:=font_info(hf)(k).qqqq;
+ if skip_byte(q)>stop_flag then
+ begin k:=lig_kern_restart(hf)(q); q:=font_info(hf)(k).qqqq;
+@z
+%---------------------------------------
+@x [41] m.909 l.17811 - Omega
+loop@+begin if next_char(q)=test_char then if skip_byte(q)<=stop_flag then
+@y
+loop@+begin if (next_char(hf)(q))=test_char then if skip_byte(q)<=stop_flag then
+@z
+%---------------------------------------
+@x [41] m.909 l.17829 - Omega
+ k:=k+qo(skip_byte(q))+1; q:=font_info[k].qqqq;
+@y
+ k:=k+qo(skip_byte(q))+1; q:=font_info(hf)(k).qqqq;
+@z
+%---------------------------------------
+@x [41] m.915 l.17963 - Omega
+ begin l:=reconstitute(l,i,font_bchar[hf],non_char)+1;
+@y
+ begin l:=reconstitute(l,i,font_bchar(hf),non_char)+1;
+@z
+%---------------------------------------
+@x [41] m.916 l.17980 - Omega
+if bchar_label[hf]<>non_address then {put left boundary at beginning of new line}
+@y
+if bchar_label(hf)<>non_address then {put left boundary at beginning of new line}
+@z
+%---------------------------------------
+@x [46] m.1030 l.19987 - Omega
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+@y
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+hmode+char_ghost: begin t:=cur_chr; get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then begin
+ if t=0 then new_left_ghost:=true
+ else new_right_ghost:=true;
+ end;
+ goto reswitch;
+ end;
+@z
+%---------------------------------------
+@x [46] m.1032 l.20030 - Omega
+ |font_bchar[cur_font]|,&otherwise;\cr}$$
+except when |character(lig_stack)=font_false_bchar[cur_font]|.
+@y
+ |font_bchar(cur_font)|,&otherwise;\cr}$$
+except when |character(lig_stack)=font_false_bchar(cur_font)|.
+@z
+%---------------------------------------
+@x [46] m.1032
+@!cancel_boundary:boolean; {should the left boundary be ignored?}
+@!ins_disc:boolean; {should we insert a discretionary node?}
+@y
+@!cancel_boundary:boolean; {should the left boundary be ignored?}
+@!left_ghost:boolean; {character left of cursor is a left ghost}
+@!right_ghost:boolean; {character left of cursor is a right ghost}
+@!new_left_ghost:boolean; {character right of cursor is a left ghost}
+@!new_right_ghost:boolean; {character right of cursor is a right ghost}
+@!ins_disc:boolean; {should we insert a discretionary node?}
+@!k_glue:integer;
+@!font_glue_spec:pointer;
+@z
+%---------------------------------------
+@x [46] m.1033
+ligature_present:=false; cancel_boundary:=false; lft_hit:=false; rt_hit:=false;
+@y
+ligature_present:=false; cancel_boundary:=false; lft_hit:=false; rt_hit:=false;
+left_ghost:=false; right_ghost:=false;
+new_left_ghost:=false; new_right_ghost:=false;
+@z
+%---------------------------------------
+@x [46] m.1034 l.20075 - Omega
+adjust_space_factor;@/
+main_f:=cur_font;
+bchar:=font_bchar[main_f]; false_bchar:=font_false_bchar[main_f];
+if mode>0 then if language<>clang then fix_language;
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+character(lig_stack):=cur_l;@/
+cur_q:=tail;
+if cancel_boundary then
+ begin cancel_boundary:=false; main_k:=non_address;
+ end
+else main_k:=bchar_label[main_f];
+if main_k=non_address then goto main_loop_move+2; {no left boundary processing}
+cur_r:=cur_l; cur_l:=non_char;
+goto main_lig_loop+1; {begin with cursor after left boundary}
+@y
+adjust_space_factor;@/
+main_f:=cur_font;
+bchar:=font_bchar(main_f); false_bchar:=font_false_bchar(main_f);
+if mode>0 then if language<>clang then fix_language;
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+character(lig_stack):=cur_l;@/
+cur_q:=tail;
+if cancel_boundary then
+ begin cancel_boundary:=false; main_k:=non_address;
+ left_ghost:=new_left_ghost; right_ghost:=new_right_ghost;
+ new_left_ghost:=false; new_right_ghost:=false;
+ end
+else main_k:=bchar_label(main_f);
+if main_k=non_address then goto main_loop_move+2; {no left boundary processing}
+cur_r:=cur_l; cur_l:=non_char;
+if not new_right_ghost then
+ goto main_lig_loop+1; {begin with cursor after left boundary}
+@z
+%---------------------------------------
+@x [46] m.1035 l.20122 - Omega
+ begin if character(tail)=qi(hyphen_char[main_f]) then if link(cur_q)>null then
+@y
+ begin if character(tail)=qi(hyphen_char(main_f)) then if link(cur_q)>null then
+@z
+%---------------------------------------
+@x [46] m.1036 l.20135 - Omega
+if lig_stack=null then goto reswitch;
+cur_q:=tail; cur_l:=character(lig_stack);
+main_loop_move+1:if not is_char_node(lig_stack) then goto main_loop_move_lig;
+main_loop_move+2:if(cur_chr<font_bc[main_f])or(cur_chr>font_ec[main_f]) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+main_i:=char_info(main_f)(cur_l);
+if not char_exists(main_i) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+tail_append(lig_stack) {|main_loop_lookahead| is next}
+@y
+if lig_stack=null then goto reswitch;
+cur_q:=tail; cur_l:=character(lig_stack);
+main_loop_move+1:if not is_char_node(lig_stack) then goto main_loop_move_lig;
+main_loop_move+2:
+left_ghost:=new_left_ghost; right_ghost:=new_right_ghost;
+new_left_ghost:=false; new_right_ghost:=false;
+if(cur_chr<font_bc(main_f))or(cur_chr>font_ec(main_f)) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+main_i:=char_info(main_f)(cur_l);
+if not char_exists(main_i) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+if not (left_ghost or right_ghost) then
+ tail_append(lig_stack) {|main_loop_lookahead| is next}
+@z
+%---------------------------------------
+@x [46] m.1038 l.20177 - Omega
+if cur_cmd=no_boundary then bchar:=non_char;
+@y
+if cur_cmd=char_ghost then begin t:=cur_chr; get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then begin
+ if t=0 then new_left_ghost:=true
+ else new_right_ghost:=true;
+ back_input;
+ goto main_loop_lookahead;
+ end;
+ end;
+if cur_cmd=no_boundary then bchar:=non_char;
+@z
+%---------------------------------------
+@x [46] m.1039 l.20193 - Omega
+@<If there's a ligature/kern command...@>=
+if char_tag(main_i)<>lig_tag then goto main_loop_wrapup;
+main_k:=lig_kern_start(main_f)(main_i); main_j:=font_info[main_k].qqqq;
+if skip_byte(main_j)<=stop_flag then goto main_lig_loop+2;
+main_k:=lig_kern_restart(main_f)(main_j);
+main_lig_loop+1:main_j:=font_info[main_k].qqqq;
+main_lig_loop+2:if next_char(main_j)=cur_r then
+ if skip_byte(main_j)<=stop_flag then
+ @<Do ligature or kern command, returning to |main_lig_loop|
+ or |main_loop_wrapup| or |main_loop_move|@>;
+if skip_byte(main_j)=qi(0) then incr(main_k)
+else begin if skip_byte(main_j)>=stop_flag then goto main_loop_wrapup;
+ main_k:=main_k+qo(skip_byte(main_j))+1;
+ end;
+goto main_lig_loop+1
+@y
+@<If there's a ligature/kern command...@>=
+if new_right_ghost or left_ghost then goto main_loop_wrapup;
+if char_tag(main_i)<>lig_tag then goto main_loop_wrapup;
+main_k:=lig_kern_start(main_f)(main_i);
+main_j:=font_info(main_f)(main_k).qqqq;
+if skip_byte(main_j)<=stop_flag then goto main_lig_loop+2;
+main_k:=lig_kern_restart(main_f)(main_j);
+main_lig_loop+1: main_j:=font_info(main_f)(main_k).qqqq;
+main_lig_loop+2:if top_skip_byte(main_j)=0 then begin
+ if next_char(main_f)(main_j)=cur_r then
+ if skip_byte(main_j)<=stop_flag then
+ @<Do ligature or kern command, returning to |main_lig_loop|
+ or |main_loop_wrapup| or |main_loop_move|@>;
+ end
+ else begin
+ if (font_bc(main_f)<=cur_r) then
+ if (font_ec(main_f)>=cur_r) then
+ if (char_exists(char_info(main_f)(cur_r))) then
+ if cur_r<>bchar then
+ if next_char(main_f)(main_j)=
+ attr_zero_char_ivalue(main_f)(cur_r) then
+ @<Do glue or penalty command@>;
+ end;
+if skip_byte(main_j)=qi(0) then incr(main_k)
+else begin if skip_byte(main_j)>=stop_flag then goto main_loop_wrapup;
+ main_k:=main_k+qo(skip_byte(main_j))+1;
+ end;
+goto main_lig_loop+1
+
+@ There are currently three commands. Command 17 will add a penalty
+node between the two characters. Command 18 will add a glue
+node between the two characters. Command 19 will add a penalty node,
+then a glue node between the two characters. Command 20
+will add a kern nore between the two characters.
+
+@<Do glue or penalty command@>=
+begin
+if new_left_ghost or right_ghost then goto main_loop_wrapup;
+case op_byte(main_j) of
+ qi(20): begin wrapup(rt_hit);
+ tail_append(new_kern(attr_zero_kern(main_f)(rem_byte(main_j))));
+ end;
+ qi(18): begin wrapup(rt_hit);
+ k_glue:=glues_base(main_f) + (rem_byte(main_j)*4);
+ font_glue_spec:=new_spec(zero_glue);
+ width(font_glue_spec):= font_info(main_f)(k_glue+1).sc;
+ stretch(font_glue_spec):=font_info(main_f)(k_glue+2).sc;
+ shrink(font_glue_spec):=font_info(main_f)(k_glue+3).sc;
+ tail_append(new_glue(font_glue_spec));
+ end;
+ qi(19): begin wrapup(rt_hit);
+ tail_append(new_penalty(attr_zero_penalty(main_f)(rem_top_byte(main_j))));
+ k_glue:=glues_base(main_f) + (rem_bot_byte(main_j)*4);
+ font_glue_spec:=new_spec(zero_glue);
+ width(font_glue_spec):= font_info(main_f)(k_glue+1).sc;
+ stretch(font_glue_spec):=font_info(main_f)(k_glue+2).sc;
+ shrink(font_glue_spec):=font_info(main_f)(k_glue+3).sc;
+ tail_append(new_glue(font_glue_spec));
+ end;
+ qi(17): begin wrapup(rt_hit);
+ tail_append(new_penalty(attr_zero_penalty(main_f)(rem_byte(main_j))));
+ end;
+ end;
+goto main_loop_move;
+end
+@z
+%---------------------------------------
+@x [46] m.1040 l.20219 - Omega
+begin if op_byte(main_j)>=kern_flag then
+ begin wrapup(rt_hit);
+ tail_append(new_kern(char_kern(main_f)(main_j))); goto main_loop_move;
+ end;
+if cur_l=non_char then lft_hit:=true
+else if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(main_j) of
+qi(1),qi(5):begin cur_l:=rem_byte(main_j); {\.{=:\?}, \.{=:\?>}}
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_byte(main_j); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack=null then {right boundary character is being consumed}
+ begin lig_stack:=new_lig_item(cur_r); bchar:=non_char;
+ end
+ else if is_char_node(lig_stack) then {|link(lig_stack)=null|}
+ begin main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ lig_ptr(lig_stack):=main_p;
+ end
+ else character(lig_stack):=cur_r;
+ end;
+qi(3):begin cur_r:=rem_byte(main_j); {\.{\?=:\?}}
+ main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ link(lig_stack):=main_p;
+ end;
+qi(7),qi(11):begin wrapup(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=tail; cur_l:=rem_byte(main_j);
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_byte(main_j); ligature_present:=true; {\.{=:}}
+ if lig_stack=null then goto main_loop_wrapup
+ else goto main_loop_move+1;
+ end
+endcases;
+if op_byte(main_j)>qi(4) then
+ if op_byte(main_j)<>qi(7) then goto main_loop_wrapup;
+if cur_l<non_char then goto main_lig_loop;
+main_k:=bchar_label[main_f]; goto main_lig_loop+1;
+end
+@y
+begin if op_byte(main_j)>=kern_flag then
+ begin wrapup(rt_hit);
+ tail_append(new_kern(char_kern(main_f)(main_j)));
+ if new_left_ghost or right_ghost then begin
+ subtype(tail):=explicit;
+ end;
+ goto main_loop_move;
+ end;
+if new_left_ghost or right_ghost then goto main_loop_wrapup;
+if cur_l=non_char then lft_hit:=true
+else if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(main_j) of
+qi(1),qi(5):begin cur_l:=rem_char_byte(main_f)(main_j); {\.{=:\?}, \.{=:\?>}}
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_char_byte(main_f)(main_j); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack=null then {right boundary character is being consumed}
+ begin lig_stack:=new_lig_item(cur_r); bchar:=non_char;
+ end
+ else if is_char_node(lig_stack) then {|link(lig_stack)=null|}
+ begin main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ lig_ptr(lig_stack):=main_p;
+ end
+ else character(lig_stack):=cur_r;
+ end;
+qi(3):begin cur_r:=rem_char_byte(main_f)(main_j); {\.{\?=:\?}}
+ main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ link(lig_stack):=main_p;
+ end;
+qi(7),qi(11):begin wrapup(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=tail; cur_l:=rem_char_byte(main_f)(main_j);
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_char_byte(main_f)(main_j);
+ ligature_present:=true; {\.{=:}}
+ if lig_stack=null then goto main_loop_wrapup
+ else goto main_loop_move+1;
+ end
+endcases;
+if op_byte(main_j)>qi(4) then
+ if op_byte(main_j)<>qi(7) then goto main_loop_wrapup;
+if cur_l<non_char then goto main_lig_loop;
+main_k:=bchar_label(main_f); goto main_lig_loop+1;
+end
+@z
+%---------------------------------------
+@x [46] m.1042 l.20285 - Omega
+begin main_p:=font_glue[cur_font];
+if main_p=null then
+ begin main_p:=new_spec(zero_glue); main_k:=param_base[cur_font]+space_code;
+ width(main_p):=font_info[main_k].sc; {that's |space(cur_font)|}
+ stretch(main_p):=font_info[main_k+1].sc; {and |space_stretch(cur_font)|}
+ shrink(main_p):=font_info[main_k+2].sc; {and |space_shrink(cur_font)|}
+ font_glue[cur_font]:=main_p;
+@y
+begin main_p:=font_glue(cur_font);
+if main_p=null then
+ begin main_p:=new_spec(zero_glue); main_k:=param_base(cur_font)+space_code;
+ width(main_p):=font_info(cur_font)(main_k).sc; {that's |space(cur_font)|}
+ stretch(main_p):=font_info(cur_font)(main_k+1).sc;
+ {and |space_stretch(cur_font)|}
+ shrink(main_p):=font_info(cur_font)(main_k+2).sc;
+ {and |space_shrink(cur_font)|}
+ font_glue(cur_font):=main_p;
+@z
+%---------------------------------------
+@x [47] m.1090
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+@y
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+vmode+char_ghost,
+@z
+%---------------------------------------
+@x [48] m.1117 l.21343 - Omega
+ begin c:=hyphen_char[cur_font];
+@y
+ begin c:=hyphen_char(cur_font);
+@z
+%---------------------------------------
+@x [49] m.1195 l.22361 - Omega
+if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@|
+ (font_params[fam_fnt(2+script_size)]<total_mathsy_params)or@|
+ (font_params[fam_fnt(2+script_script_size)]<total_mathsy_params) then
+ begin print_err("Math formula deleted: Insufficient symbol fonts");@/
+@.Math formula deleted...@>
+ help3("Sorry, but I can't typeset math unless \textfont 2")@/
+ ("and \scriptfont 2 and \scriptscriptfont 2 have all")@/
+ ("the \fontdimen values needed in math symbol fonts.");
+ error; flush_math; danger:=true;
+ end
+else if (font_params[fam_fnt(3+text_size)]<total_mathex_params)or@|
+ (font_params[fam_fnt(3+script_size)]<total_mathex_params)or@|
+ (font_params[fam_fnt(3+script_script_size)]<total_mathex_params) then
+@y
+if (font_params(fam_fnt(2+text_size))<total_mathsy_params)or@|
+ (font_params(fam_fnt(2+script_size))<total_mathsy_params)or@|
+ (font_params(fam_fnt(2+script_script_size))<total_mathsy_params) then
+ begin print_err("Math formula deleted: Insufficient symbol fonts");@/
+@.Math formula deleted...@>
+ help3("Sorry, but I can't typeset math unless \textfont 2")@/
+ ("and \scriptfont 2 and \scriptscriptfont 2 have all")@/
+ ("the \fontdimen values needed in math symbol fonts.");
+ error; flush_math; danger:=true;
+ end
+else if (font_params(fam_fnt(3+text_size))<total_mathex_params)or@|
+ (font_params(fam_fnt(3+script_size))<total_mathex_params)or@|
+ (font_params(fam_fnt(3+script_script_size))<total_mathex_params) then
+@z
+%---------------------------------------
+@x [49] m.1253 l.23250 - Omega
+assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen; font_info[k].sc:=cur_val;
+ end;
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
+@y
+assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen;
+ font_info(dimen_font)(k).sc:=cur_val;
+ end;
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char(f):=cur_val@+else skew_char(f):=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1257 l.23269 - Omega
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+@y
+@!offset:integer;
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+@z
+%---------------------------------------
+@x [49] m.1257 l.23290 - Omega
+@<Scan the font size specification@>;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s);
+common_ending: equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
+@y
+@<Scan the font size specification@>;
+name_in_progress:=true;
+if scan_keyword("offset") then begin
+ scan_int;
+ offset:=cur_val;
+ if (cur_val<0) then begin
+ print_err("Illegal offset has been changed to 0");
+ help1("The offset must be bigger than 0."); int_error(cur_val);
+ offset:=0;
+ end
+ end
+else offset:=0;
+name_in_progress:=false;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s,offset);
+common_ending: set_equiv(u,f);
+set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t);
+@z
+%---------------------------------------
+@x [49] m.1260 l.23333 - Omega
+for f:=font_base+1 to font_ptr do
+ if str_eq_str(font_name[f],cur_name)and str_eq_str(font_area[f],cur_area) then
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name[f];
+ end;
+ if s>0 then
+ begin if s=font_size[f] then goto common_ending;
+ end
+ else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
+ goto common_ending;
+ end
+@y
+for f:=font_base+1 to font_ptr do begin
+ if str_eq_str(font_name(f),cur_name) and
+ str_eq_str(font_area(f),cur_area) then
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name(f);
+ end;
+ if s>0 then
+ begin if s=font_size(f) then goto common_ending;
+ end
+ else if font_size(f)=xn_over_d(font_dsize(f),-s,1000) then
+ goto common_ending;
+ end
+ end
+@z
+%---------------------------------------
+@x [49] m.1261 l.23345 - Omega
+set_font:begin print("select font "); slow_print(font_name[chr_code]);
+ if font_size[chr_code]<>font_dsize[chr_code] then
+ begin print(" at "); print_scaled(font_size[chr_code]);
+@y
+set_font:begin print("select font "); slow_print(font_name(chr_code));
+ if font_size(chr_code)<>font_dsize(chr_code) then
+ begin print(" at "); print_scaled(font_size(chr_code));
+@z
+%---------------------------------------
+@x [50] m.1320 l.23983 - Omega
+@ @<Dump the font information@>=
+dump_int(fmem_ptr);
+for k:=0 to fmem_ptr-1 do dump_wd(font_info[k]);
+dump_int(font_ptr);
+for k:=null_font to font_ptr do
+ @<Dump the array info for internal font number |k|@>;
+print_ln; print_int(fmem_ptr-7); print(" words of font info for ");
+print_int(font_ptr-font_base); print(" preloaded font");
+if font_ptr<>font_base+1 then print_char("s")
+@y
+@ @<Dump the font information@>=
+dump_int(font_ptr);
+for k:=null_font to font_ptr do
+ @<Dump the array info for internal font number |k|@>;
+print_ln; print_int(font_ptr-font_base); print(" preloaded font");
+if font_ptr<>font_base+1 then print_char("s")
+@z
+%---------------------------------------
+@x [50] m.1321 l.23993 - Omega
+@ @<Undump the font information@>=
+undump_size(7)(font_mem_size)('font mem size')(fmem_ptr);
+for k:=0 to fmem_ptr-1 do undump_wd(font_info[k]);
+undump_size(font_base)(font_max)('font max')(font_ptr);
+for k:=null_font to font_ptr do
+ @<Undump the array info for internal font number |k|@>
+@y
+@ @<Undump the font information@>=
+undump_size(font_base)(font_max)('font max')(font_ptr);
+for k:=null_font to font_ptr do
+ @<Undump the array info for internal font number |k|@>
+@z
+%---------------------------------------
+@x [50] m.1322 l.24000 - Omega
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_qqqq(font_check[k]);
+dump_int(font_size[k]);
+dump_int(font_dsize[k]);
+dump_int(font_params[k]);@/
+dump_int(hyphen_char[k]);
+dump_int(skew_char[k]);@/
+dump_int(font_name[k]);
+dump_int(font_area[k]);@/
+dump_int(font_bc[k]);
+dump_int(font_ec[k]);@/
+dump_int(char_base[k]);
+dump_int(width_base[k]);
+dump_int(height_base[k]);@/
+dump_int(depth_base[k]);
+dump_int(italic_base[k]);
+dump_int(lig_kern_base[k]);@/
+dump_int(kern_base[k]);
+dump_int(exten_base[k]);
+dump_int(param_base[k]);@/
+dump_int(font_glue[k]);@/
+dump_int(bchar_label[k]);
+dump_int(font_bchar[k]);
+dump_int(font_false_bchar[k]);@/
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(font_name[k],font_area[k],"");
+if font_size[k]<>font_dsize[k] then
+ begin print(" at "); print_scaled(font_size[k]); print("pt");
+ end;
+end
+@y
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_font_table(k,param_base(k)+font_params(k)+1);
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(font_name(k),font_area(k),"");
+if font_size(k)<>font_dsize(k) then
+ begin print(" at "); print_scaled(font_size(k)); print("pt");
+ end;
+end
+@z
+%---------------------------------------
+@x [50] m.1323 l.24031 - Omega
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_qqqq(font_check[k]);@/
+undump_int(font_size[k]);
+undump_int(font_dsize[k]);
+undump(min_halfword)(max_halfword)(font_params[k]);@/
+undump_int(hyphen_char[k]);
+undump_int(skew_char[k]);@/
+undump(0)(str_ptr)(font_name[k]);
+undump(0)(str_ptr)(font_area[k]);@/
+undump(0)(255)(font_bc[k]);
+undump(0)(255)(font_ec[k]);@/
+undump_int(char_base[k]);
+undump_int(width_base[k]);
+undump_int(height_base[k]);@/
+undump_int(depth_base[k]);
+undump_int(italic_base[k]);
+undump_int(lig_kern_base[k]);@/
+undump_int(kern_base[k]);
+undump_int(exten_base[k]);
+undump_int(param_base[k]);@/
+undump(min_halfword)(lo_mem_max)(font_glue[k]);@/
+undump(0)(fmem_ptr-1)(bchar_label[k]);
+undump(min_quarterword)(non_char)(font_bchar[k]);
+undump(min_quarterword)(non_char)(font_false_bchar[k]);
+end
+@y
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_font_table(k);@/
+end
+@z
+%---------------------------------------
+@x [51] m.1334 l.24277 - Omega
+ wlog(' ',fmem_ptr:1,' words of font info for ',
+ font_ptr-font_base:1,' font');
+ if font_ptr<>font_base+1 then wlog('s');
+@y
+ wlog(font_ptr-font_base:1,' font');
+ if font_ptr<>font_base+1 then wlog('s');
+@z
+%---------------------------------------
+@x [52] m.1339 l.24429 - Omega
+4: print_word(eqtb[n]);
+5: print_word(font_info[n]);
+@y
+4: print_word(new_eqtb(n));
+5: ;
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir-1.15/omocp.ch b/Build/source/texk/web2c/omegadir-1.15/omocp.ch
new file mode 100644
index 00000000000..039903327fb
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omocp.ch
@@ -0,0 +1,1068 @@
+% omocp.ch: Reading an OCP file
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.412 - Omega OCP
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@y
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@!ocp_maxint=@"10000000;
+@z
+%---------------------------------------
+@x [1] m.12 l.436 - Omega OCP
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@d ocp_base=0 {smallest internal ocp number; must not be less
+ than |min_quarterword|}
+@d ocp_biggest=65535 {the real biggest ocp}
+@d number_ocps=ocp_biggest-ocp_base+1
+@d ocp_list_base=0 {smallest internal ocp list number; must not be less
+ than |min_quarterword|}
+@d ocp_list_biggest=65535 {the real biggest ocp list}
+@d number_ocp_lists=ocp_list_biggest-ocp_list_base+1
+@d max_active_ocp_lists=65536
+@z
+%---------------------------------------
+@x [15] m.209 l.4170 - Omega OCP
+@d max_command=set_interaction
+ {the largest command code seen at |big_switch|}
+@y
+@d set_ocp=set_interaction+1
+ {Place a translation process in the stream}
+@d def_ocp=set_ocp+1
+ {Define and load a translation process}
+@d set_ocp_list=def_ocp+1
+ {Place a list of OCPs in the stream}
+@d def_ocp_list=set_ocp_list+1
+ {Define a list of OCPs}
+@d clear_ocp_lists=def_ocp_list+1
+ {Remove all active OCP lists}
+@d push_ocp_list=clear_ocp_lists+1
+ {Add to the sequence of active OCP lists}
+@d pop_ocp_list=push_ocp_list+1
+ {Remove from the sequence of active OCP lists}
+@d ocp_list_op=pop_ocp_list+1
+ {Operations for building a list of OCPs}
+@d ocp_trace_level=ocp_list_op+1
+ {Tracing of active OCPs, either 0 or 1}
+@d max_command=ocp_trace_level
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.222 l.4523 - Omega OCP
+@d font_id_base=frozen_null_font-font_base
+ {begins table of |number_fonts| permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+number_fonts
+@y
+@d font_id_base=frozen_null_font-font_base
+ {begins table of |number_fonts| permanent font identifiers}
+@d frozen_null_ocp=frozen_null_font+number_fonts
+ {permanent `\.{\\nullocp}'}
+@d ocp_id_base=frozen_null_ocp-ocp_base
+ {begins table of |number_ocps| permanent ocp identifiers}
+@d frozen_null_ocp_list=frozen_null_ocp+number_ocps
+ {permanent `\.{\\nullocplist}'}
+@d ocp_list_id_base=frozen_null_ocp_list-ocp_list_base
+ {begins table of |number_ocp_lists| permanent ocp list identifiers}
+@d undefined_control_sequence=frozen_null_ocp_list+number_ocp_lists
+@z
+%---------------------------------------
+@x
+@d toks_base=local_base+10 {table of |number_regs| token list registers}
+@y
+@d ocp_trace_level_base=local_base+10
+@d ocp_active_number_base=ocp_trace_level_base+1
+@d ocp_active_min_ptr_base = ocp_active_number_base+1
+@d ocp_active_max_ptr_base = ocp_active_min_ptr_base+1
+@d ocp_active_base = ocp_active_max_ptr_base+1
+@d toks_base=ocp_active_base+max_active_ocp_lists
+ {table of |number_regs| token list registers}
+@z
+%---------------------------------------
+@x [17] m.232 l.4799 - Omega OCP
+@d null_font==font_base
+@y
+@d null_font==font_base
+@d null_ocp==ocp_base
+@d null_ocp_list==ocp_list_base
+@z
+%---------------------------------------
+@x [18] m.256 l.5479 - Omega OCP
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@y
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@d ocp_id_text(#) == newtext(ocp_id_base+#) {a frozen ocp identifier's name}
+@d ocp_list_id_text(#) == newtext(ocp_list_id_base+#)
+ {a frozen ocp list identifier's name}
+@z
+%---------------------------------------
+@x [26] m.409 l.8254 - Omega OCP
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@y
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@t\4\4@>@<Declare procedures that scan ocp-related stuff@>
+@z
+%---------------------------------------
+@x [29] m.514 l.9968 - Omega OCP
+|TEX_font_area|. These system area names will, of course, vary from place
+to place.
+@y
+|TEX_font_area|. $\Omega$'s compiled translation process files whose areas
+are not given explicitly are assumed to appear in a standard system area
+called |OMEGA_ocp_area|. These system area names will, of course, vary
+from place to place.
+@z
+%---------------------------------------
+@x [29] m.514 l.9974 - Omega OCP
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@d OMEGA_ocp_area=="OmegaOCPs:"
+@.OmegaOCPs@>
+@z
+%---------------------------------------
+@x [30] m.582 l.10379 - Omega OCP
+@* \[30] Font metric data.
+@y
+@* \[30] Font metric data and OCPs.
+@z
+%---------------------------------------
+@x [30] m.??? l.10928 - Omega OCP
+@ @<Read and check...@>=
+@y
+@ @<Read and check the font data...@>=
+@z
+%---------------------------------------
+@x [30] m.??? l.11010 - Omega OCP
+@ @<Apologize for not loading...@>=
+@y
+@ @<Apologize for not loading the font...@>=
+@z
+%---------------------------------------
+@x [30] m.582 l.11283 - Omega OCP
+char_warning(f,c);
+new_character:=null;
+exit:end;
+@y
+char_warning(f,c);
+new_character:=null;
+exit:end;
+
+@ Here we begin the \.{OCP} file handling.
+
+@<Glob...@>=
+@!ocp_file:byte_file;
+
+@ So that is what \.{OCP} files hold.
+
+When the user defines \.{\\ocp\\f}, say, \TeX\ assigns an internal number
+to the user's ocp~\.{\\f}. Adding this number to |ocp_id_base| gives the
+|eqtb| location of a ``frozen'' control sequence that will always select
+the ocp.
+
+@<Types...@>=
+@!internal_ocp_number=ocp_base..ocp_biggest;
+@!ocp_index=integer;
+
+@ Here now is the array of ocp arrays.
+
+@<Glob...@>=
+@!ocp_ptr:internal_ocp_number; {largest internal ocp number in use}
+
+@ Besides the arrays just enumerated, we have two directory arrays that
+make it easy to get at the individual entries in |ocp_info|.
+The beginning of the info for the |j|-th state in the |i|-th ocp is at
+location |ocp_info[ocp_state_base[i]+j]| and the |k|-th entry is in
+location |ocp_info[ocp_info[ocp_state_base[i]+j]+k]|.
+(These formulas assume that |min_quarterword| has already been
+added to |i|, |j| and |k|, since $\Omega$ stores its quarterwords that way.)
+
+@d ocp_info_end(#)==#]
+@d ocp_info(#)==ocp_tables[#,ocp_info_end
+@d offset_ocp_file_size=0
+@d offset_ocp_name=1
+@d offset_ocp_area=offset_ocp_name+1
+@d offset_ocp_external=offset_ocp_area+1
+@d offset_ocp_external_arg=offset_ocp_external+1
+@d offset_ocp_input=offset_ocp_external_arg+1
+@d offset_ocp_output=offset_ocp_input+1
+@d offset_ocp_no_tables=offset_ocp_output+1
+@d offset_ocp_no_states=offset_ocp_no_tables+1
+@d offset_ocp_table_base=offset_ocp_no_states+1
+@d offset_ocp_state_base=offset_ocp_table_base+1
+@d offset_ocp_info=offset_ocp_state_base+1
+@d ocp_file_size(#)==ocp_info(#)(offset_ocp_file_size)
+@d ocp_name(#)==ocp_info(#)(offset_ocp_name)
+@d ocp_area(#)==ocp_info(#)(offset_ocp_area)
+@d ocp_external(#)==ocp_info(#)(offset_ocp_external)
+@d ocp_external_arg(#)==ocp_info(#)(offset_ocp_external_arg)
+@d ocp_input(#)==ocp_info(#)(offset_ocp_input)
+@d ocp_output(#)==ocp_info(#)(offset_ocp_output)
+@d ocp_no_tables(#)==ocp_info(#)(offset_ocp_no_tables)
+@d ocp_no_states(#)==ocp_info(#)(offset_ocp_no_states)
+@d ocp_table_base(#)==ocp_info(#)(offset_ocp_table_base)
+@d ocp_state_base(#)==ocp_info(#)(offset_ocp_state_base)
+
+@ $\Omega$ always knows at least one ocp, namely the null ocp.
+It does nothing.
+
+@<Initialize table...@>=
+ocp_ptr:=null_ocp;
+allocate_ocp_table(null_ocp,17);
+ocp_file_size(null_ocp):=17;
+ocp_name(null_ocp):="nullocp"; ocp_area(null_ocp):="";
+ocp_external(null_ocp):=0; ocp_external_arg(null_ocp):=0;
+ocp_input(null_ocp):=1; ocp_output(null_ocp):=1;
+ocp_no_tables(null_ocp):=0;
+ocp_no_states(null_ocp):=1;
+ocp_table_base(f):=offset_ocp_info;
+ocp_state_base(f):=offset_ocp_info;
+ocp_info(null_ocp)(offset_ocp_info) := offset_ocp_info+2; {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+1) := offset_ocp_info+5; {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+2) := 23; {|OTP_LEFT_START|}
+ocp_info(null_ocp)(offset_ocp_info+3) := 3; {|OTP_RIGHT_CHAR|}
+ocp_info(null_ocp)(offset_ocp_info+4) := 36; {|OTP_STOP|}
+
+
+@ @<Put each...@>=
+primitive("nullocp", set_ocp, null_ocp);
+settext(frozen_null_ocp,"nullocp");
+set_new_eqtb(frozen_null_ocp,new_eqtb(cur_val));
+geq_define(ocp_active_number_base, data, 0);
+geq_define(ocp_active_min_ptr_base, data, 0);
+geq_define(ocp_active_max_ptr_base, data, 0);
+
+@ Of course we want to define macros that suppress the detail of how ocp
+information is actually packed, so that we don't have to write things like
+$$\hbox{|ocp_info[k+ocp_info[j+ocp_state_base[i]]]|}$$
+too often. The \.{WEB} definitions here make |ocp_state_entry(i)(j)(k)|
+(|ocp_table_entry(i)(j)(k)|) the |k|-th word in the |j|-th state (table)
+of the |i|-th ocp.
+@^inner loop@>
+
+@d ocp_state_end(#)==#]
+@d ocp_state_one(#)==#*2]+ocp_state_end
+@d ocp_state_entry(#)==ocp_tables[#,ocp_tables[#,ocp_state_base(#)+ocp_state_one
+
+@d ocp_state_no_end(#)==#*2+1]
+@d ocp_state_no(#)==ocp_tables[#,ocp_state_base(#)+ocp_state_no_end
+
+@d ocp_table_end(#)==#]
+@d ocp_table_one(#)==#*2]+ocp_table_end
+@d ocp_table_entry(#)==ocp_tables[#,ocp_tables[#,ocp_table_base(#)+ocp_table_one
+
+@d ocp_table_no_end(#)==#*2+1]
+@d ocp_table_no(#)==ocp_tables[#,ocp_table_base(#)+ocp_table_no_end
+
+@ $\Omega$ checks the information of a \.{OCP} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. The somewhat tedious subroutine that does this
+is called |read_ocp_info|. It has three parameters: the user ocp
+identifier~|u|, and the file name and area strings |nom| and |aire|.
+
+The subroutine opens and closes a global file variable called |ocp_file|.
+It returns the value of the internal ocp number that was just loaded.
+If an error is detected, an error message is issued and no ocp
+information is stored; |null_ocp| is returned in this case.
+
+@d bad_ocp=11 {label for |read_ocp_info|}
+@d ocp_abort(#)==begin print("OCP file error (");
+ print(#); print(")"); print_ln; goto bad_ocp end
+ {do this when the \.{OCP} data is wrong}
+
+@p function read_ocp_info(@!u:pointer;@!nom,@!aire,@!ext:str_number;
+ @!external_ocp:boolean)
+ :internal_ocp_number; {input a \.{OCP} file}
+label done,bad_ocp,not_found;
+var
+@!file_opened:boolean; {was |ocp_file| successfully opened?}
+@!f:internal_ocp_number; {the new ocp's number}
+@!g:internal_ocp_number; {the number to return}
+@!ocpword:integer;
+@!ocpmem_run_ptr:ocp_index;
+@!ocp_length,real_ocp_length:integer; {length of ocp file}
+@!previous_address:ocp_index;
+@!temp_ocp_input:integer;
+@!temp_ocp_output:integer;
+@!temp_ocp_no_tables:integer;
+@!temp_ocp_no_states:integer;
+@!i,new_offset,room_for_tables,room_for_states:integer;
+begin g:=null_ocp;@/
+@<Read and check the ocp data; |ocp_abort| if the \.{OCP} file is
+ malformed; if there's no room for this ocp, say so and |goto
+ done|; otherwise |incr(ocp_ptr)| and |goto done|@>;
+bad_ocp: @<Report that the ocp won't be loaded@>;
+done: if file_opened then b_close(ocp_file);
+ocp_name(f):=nom; ocp_area(f):=aire;
+read_ocp_info:=g;
+end;
+
+@ $\Omega$ does not give precise details about why it
+rejects a particular \.{OCP} file.
+
+@d start_ocp_error_message==print_err("Translation process ");
+ sprint_cs(u); print_char("="); print_file_name(nom,aire,"");
+
+@<Report that the ocp won't be loaded@>=
+start_ocp_error_message;
+@.Translation process x=xx not loadable...@>
+if file_opened then print(" not loadable: Bad ocp file")
+else print(" not loadable: ocp file not found");
+help2("I wasn't able to read the data for this ocp,")@/
+("so I will ignore the ocp specification.");
+error
+
+@ @<Read and check the ocp data...@>=
+if external_ocp then
+ @<Check |ocp_file| exists@>
+else begin
+ @<Open |ocp_file| for input@>;
+ @<Read the {\.{OCP}} file@>;
+ end;
+
+@ @<Check |ocp_file| exists@>=
+begin
+file_opened:=false;
+pack_file_name(nom,aire,ext);
+b_test_in;
+if name_length=0 then ocp_abort("opening file");
+f :=ocp_ptr+1;
+allocate_ocp_table(f,13);
+ocp_file_size(f):=13;
+for i:=1 to name_length do begin
+ append_char(name_of_file[i]);
+ end;
+ocp_external(f):=make_string;
+scan_string_argument;
+ocp_external_arg(f):=cur_val;
+ocp_name(f):=""; ocp_area(f):="";
+ocp_state_base(f):=0; ocp_table_base(f):=0;
+ocp_input(f):=1; ocp_output(f):=1;
+ocp_info(f)(offset_ocp_info):=0;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ @<Open |ocp_file| for input@>=
+file_opened:=false;
+pack_file_name(nom,aire,".ocp");
+if not b_open_in(ocp_file) then ocp_abort("opening file");
+file_opened:=true
+
+@ Note: A malformed \.{OCP} file might be shorter than it claims to be;
+thus |eof(ocp_file)| might be true when |read_ocp_info| refers to
+|ocp_file^| or when it says |get(ocp_file)|. If such circumstances
+cause system error messages, you will have to defeat them somehow,
+for example by defining |ocpget| to be `\ignorespaces|begin get(ocp_file);|
+|if eof(ocp_file) then ocp_abort; end|\unskip'.
+@^system dependencies@>
+
+@d add_to_ocp_info(#)==begin ocp_tables[f,ocpmem_run_ptr]:=#;
+ incr(ocpmem_run_ptr);
+ end
+@d ocpget==get(ocp_file)
+@d ocpbyte==ocp_file^
+@d ocp_read(#)==begin ocpword:=ocpbyte;
+ if ocpword>127 then ocp_abort("checking first octet");
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ #:=ocpword;
+ end
+@d ocp_read_all(#)==begin ocpget; ocp_read(#); end
+@d ocp_read_info==begin ocp_read_all(ocpword);
+ add_to_ocp_info(ocpword);
+ end
+
+@ @<Read the {\.{OCP}} file@>=
+begin
+f :=ocp_ptr+1;
+ocpmem_run_ptr:=offset_ocp_info;
+ocp_read(ocp_length);
+real_ocp_length:=ocp_length-7;
+ocp_read_all(temp_ocp_input);
+ocp_read_all(temp_ocp_output);
+ocp_read_all(temp_ocp_no_tables);
+ocp_read_all(room_for_tables);
+ocp_read_all(temp_ocp_no_states);
+ocp_read_all(room_for_states);
+if real_ocp_length <>
+ (temp_ocp_no_tables + room_for_tables +
+ temp_ocp_no_states + room_for_states) then
+ ocp_abort("checking size");
+real_ocp_length:=real_ocp_length+12+
+ temp_ocp_no_states+temp_ocp_no_tables;
+allocate_ocp_table(f,real_ocp_length);
+ocp_external(f):=0;
+ocp_external_arg(f):=0;
+ocp_file_size(f):=real_ocp_length;
+ocp_input(f):=temp_ocp_input;
+ocp_output(f):=temp_ocp_output;
+ocp_no_tables(f):=temp_ocp_no_tables;
+ocp_no_states(f):=temp_ocp_no_states;
+ocp_table_base(f):=ocpmem_run_ptr;
+if ocp_no_tables(f) <> 0 then begin
+ previous_address:=ocpmem_run_ptr+2*(ocp_no_tables(f));
+ for i:=1 to ocp_no_tables(f) do begin
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address:=previous_address+new_offset;
+ end
+ end;
+if room_for_tables <> 0 then begin
+ for i:=1 to room_for_tables do begin
+ ocp_read_info;
+ end
+ end;
+ocp_state_base(f):=ocpmem_run_ptr;
+if ocp_no_states(f) <> 0 then begin
+ previous_address:=ocpmem_run_ptr+2*(ocp_no_states(f));
+ for i:=1 to ocp_no_states(f) do begin
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address:=previous_address+new_offset;
+ end;
+ end;
+if room_for_states <> 0 then begin
+ for i:=1 to room_for_states do begin
+ ocp_read_info;
+ end
+ end;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ Before we forget about the format of these tables, let's deal with
+$\Omega$'s basic scanning routine related to ocp information.
+
+@<Declare procedures that scan ocp-related stuff@>=
+procedure scan_ocp_ident;
+var f:internal_ocp_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp then f:=cur_chr
+else begin print_err("Missing ocp identifier");
+@.Missing ocp identifier@>
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \ocp.");
+ back_error; f:=null_ocp;
+ end;
+cur_val:=f;
+end;
+
+
+@ Here we begin the \.{OCP} list handling.
+
+
+@<Types...@>=
+@!internal_ocp_list_number=ocp_list_base..ocp_list_biggest;
+@!ocp_list_index=integer; {index into |ocp_list_info|}
+@!ocp_lstack_index=integer; {index into |ocp_lstack_info|}
+
+@ Here now is the array of ocp arrays.
+@d ocp_list_lnext(#)==ocp_list_info[#].hh.b0
+@d ocp_list_lstack(#)==ocp_list_info[#].hh.b1
+@d ocp_list_lstack_no(#)==ocp_list_info[#+1].sc
+@d ocp_lstack_lnext(#)==ocp_lstack_info[#].hh.b0
+@d ocp_lstack_ocp(#)==ocp_lstack_info[#].hh.b1
+@d make_null_ocp_list==make_ocp_list_node(0,ocp_maxint,0)
+@d is_null_ocp_list(#)==ocp_list_lstack_no(#)=ocp_maxint
+@d make_null_ocp_lstack==0
+@d is_null_ocp_lstack(#)==#=0
+@d add_before_op=1
+@d add_after_op=2
+@d remove_before_op=3
+@d remove_after_op=4
+
+@<Glob...@>=
+@!ocp_list_info:array[ocp_list_index] of memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
+
+@
+@<Initialize table...@>=
+ocp_listmem_ptr:=2;
+ocp_list_lstack(0):=0;
+ocp_list_lstack_no(0):=ocp_maxint;
+ocp_list_lnext(0):=0;
+ocp_list_ptr:=null_ocp_list;
+ocp_list_list[null_ocp_list]:=0;
+ocp_lstackmem_ptr:=1;
+
+@ $\Omega$ always knows at least one ocp list, namely the null ocp list.
+
+@ @<Put each...@>=
+primitive("nullocplist", set_ocp_list, null_ocp_list);
+settext(frozen_null_ocp_list,"nullocplist");
+set_new_eqtb(frozen_null_ocp_list,new_eqtb(cur_val));
+
+@ @p function make_ocp_list_node(llstack:ocp_lstack_index;
+ llstack_no:scaled;
+ llnext:ocp_list_index):ocp_list_index;
+var p:ocp_list_index;
+begin
+p:=ocp_listmem_run_ptr;
+ocp_list_lstack(p):=llstack;
+ocp_list_lstack_no(p):=llstack_no;
+ocp_list_lnext(p):=llnext;
+ocp_listmem_run_ptr:=ocp_listmem_run_ptr+2;
+make_ocp_list_node:=p;
+end;
+
+function make_ocp_lstack_node(locp:internal_ocp_number;
+ llnext:ocp_lstack_index) : ocp_lstack_index;
+var p:ocp_lstack_index;
+begin
+p:=ocp_lstackmem_run_ptr;
+ocp_lstack_ocp(p):=locp;
+ocp_lstack_lnext(p):=llnext;
+incr(ocp_lstackmem_run_ptr);
+make_ocp_lstack_node:=p;
+end;
+
+function copy_ocp_lstack(llstack:ocp_lstack_index):ocp_lstack_index;
+var result:ocp_lstack_index;
+begin
+if is_null_ocp_lstack(llstack) then
+ result:=make_null_ocp_lstack
+else
+ result:=make_ocp_lstack_node(ocp_lstack_ocp(llstack),
+ copy_ocp_lstack(ocp_lstack_lnext(llstack)));
+copy_ocp_lstack:=result;
+end;
+
+function copy_ocp_list(list:ocp_list_index):ocp_list_index;
+var result:ocp_list_index;
+begin
+if is_null_ocp_list(list) then
+ result:=make_null_ocp_list
+else
+ result:=make_ocp_list_node(copy_ocp_lstack(ocp_list_lstack(list)),
+ ocp_list_lstack_no(list),
+ copy_ocp_list(ocp_list_lnext(list)));
+copy_ocp_list:=result;
+end;
+
+function ocp_ensure_lstack(list:ocp_list_index; llstack_no:scaled):
+ ocp_list_index;
+var p:ocp_list_index;
+ q:ocp_list_index;
+begin
+p:=list;
+if is_null_ocp_list(p) then begin
+ ocp_list_lstack_no(p) := llstack_no;
+ ocp_list_lnext(p) := make_null_ocp_list;
+ end
+else if ocp_list_lstack_no(p) > llstack_no then begin
+ ocp_list_lnext(p):=
+ make_ocp_list_node(ocp_list_lstack(p),
+ ocp_list_lstack_no(p),
+ ocp_list_lnext(p));
+ ocp_list_lstack(p):=0;
+ ocp_list_lstack_no(p):=llstack_no;
+ end
+else begin
+ q:=ocp_list_lnext(p);
+ while (not (is_null_ocp_list(q))) and
+ ocp_list_lstack_no(q) <= llstack_no do begin
+ p:=q; q:=ocp_list_lnext(q);
+ end;
+ if ocp_list_lstack_no(p) < llstack_no then begin
+ ocp_list_lnext(p) := make_ocp_list_node(0, llstack_no, q);
+ p := ocp_list_lnext(p);
+ end;
+ end;
+ocp_ensure_lstack := p;
+end;
+
+procedure ocp_apply_add(list_entry:ocp_list_index;
+ lbefore:boolean;
+ locp:internal_ocp_number);
+var p:ocp_lstack_index;
+ q:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if lbefore or (p=0) then begin
+ ocp_list_lstack(list_entry) := make_ocp_lstack_node(locp, p);
+ end
+else begin
+ q:=ocp_lstack_lnext(p);
+ while q<>0 do begin
+ p:=q; q:=ocp_lstack_lnext(q);
+ end;
+ ocp_lstack_lnext(p):=make_ocp_lstack_node(locp, null);
+ end;
+end;
+
+procedure ocp_apply_remove(list_entry:ocp_list_index;
+ lbefore:boolean);
+var p:ocp_lstack_index;
+ q:ocp_lstack_index;
+ r:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if p=0 then begin
+ print_err("warning: stack entry already empty"); print_ln
+ end
+else begin
+ q := ocp_lstack_lnext(p);
+ if lbefore or (q=0) then
+ ocp_list_lstack(list_entry) := q
+ else begin
+ r:=ocp_lstack_lnext(q);
+ while r <> 0 do begin
+ p:=q; q:=r; r:=ocp_lstack_lnext(r);
+ end;
+ ocp_lstack_lnext(p) := null;
+ end
+ end;
+end;
+
+procedure scan_scaled; {sets |cur_val| to a scaled value}
+label done, done1, done2, found, not_found, attach_fraction;
+var negative:boolean; {should the answer be negated?}
+@!f:integer; {numerator of a fraction whose denominator is $2^{16}$}
+@!k,@!kk:small_number; {number of digits in a decimal fraction}
+@!p,@!q:pointer; {top of decimal digit stack}
+begin f:=0; arith_error:=false; negative:=false;
+@<Get the next non-blank non-sign...@>;
+back_input;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if cur_tok<>point_token then scan_int
+else begin radix:=10; cur_val:=0;
+ end;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>;
+if cur_val<0 then {in this case |f=0|}
+ begin negative := not negative; negate(cur_val);
+ end;
+if cur_val>@'40000 then arith_error:=true
+else cur_val := cur_val*unity +f;
+if arith_error or(abs(cur_val)>=@'10000000000) then
+begin print_err("Stack number too large");
+end;
+if negative then negate(cur_val);
+end;
+
+procedure print_ocp_lstack(lstack_entry:ocp_lstack_index);
+var p:ocp_lstack_index;
+begin
+p:=lstack_entry;
+while (p<>0) do begin
+ print_esc(ocp_id_text(ocp_lstack_ocp(p)));
+ p:=ocp_lstack_lnext(p);
+ if (p<>0) then print(",");
+ end;
+end;
+
+procedure print_ocp_list(list_entry:ocp_list_index);
+var p:ocp_list_index;
+begin
+print("["); p:=list_entry;
+while not (is_null_ocp_list(p)) do begin
+ print("(");
+ print_scaled(ocp_list_lstack_no(p));
+ print(" : ");
+ print_ocp_lstack(ocp_list_lstack(p));
+ print(")");
+ p:=ocp_list_lnext(p);
+ if not (is_null_ocp_list(p)) then print(", ");
+ end;
+print("]");
+end;
+
+function scan_ocp_list: ocp_list_index;
+var llstack_no:scaled;
+ lop:quarterword;
+ lstack_entry:ocp_list_index;
+ other_list:ocp_list_index;
+ ocp_ident:internal_ocp_number;
+ result:ocp_list_index;
+begin
+get_r_token;
+if cur_cmd = set_ocp_list then
+ result := copy_ocp_list(ocp_list_list[cur_chr])
+else if cur_cmd <> ocp_list_op then begin
+ print_err("Bad ocp list specification");
+@.Bad ocp list specification@>
+ help1("I was looking for a ocp list specification.");
+ result := make_null_ocp_list;
+ end
+else begin
+ lop:=cur_chr;
+ scan_scaled; llstack_no:=cur_val;
+ if (llstack_no<=0) or (llstack_no>=ocp_maxint) then begin
+ print_err("Stack numbers must be between 0 and 4096 (exclusive)");
+ result := make_null_ocp_list;
+ end
+ else begin
+ if lop <= add_after_op then begin
+ scan_ocp_ident; ocp_ident:=cur_val;
+ end;
+ other_list:=scan_ocp_list;
+ lstack_entry:=ocp_ensure_lstack(other_list, llstack_no);
+ if lop <= add_after_op then
+ ocp_apply_add(lstack_entry, (lop=add_before_op), ocp_ident)
+ else
+ ocp_apply_remove(lstack_entry, (lop=remove_before_op));
+ result:=other_list;
+ end;
+ end;
+scan_ocp_list:=result;
+end;
+
+function read_ocp_list: internal_ocp_list_number;
+var f:internal_ocp_list_number;
+ g:internal_ocp_list_number;
+begin
+g:=null_ocp_list;
+f:=ocp_list_ptr+1;
+ocp_listmem_run_ptr:=ocp_listmem_ptr;
+ocp_lstackmem_run_ptr:=ocp_lstackmem_ptr;
+ocp_list_list[f]:=scan_ocp_list;
+ocp_list_ptr:=f;
+ocp_listmem_ptr:=ocp_listmem_run_ptr;
+ocp_lstackmem_ptr:=ocp_lstackmem_run_ptr;
+g:=f;
+read_ocp_list:=g;
+end;
+
+procedure scan_ocp_list_ident;
+var f:internal_ocp_list_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp_list then f:=cur_chr
+else begin print_err("Missing ocp list identifier");
+@.Missing ocp list identifier@>
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \ocplist.");
+ back_error; f:=null_ocp_list;
+ end;
+cur_val:=f;
+end;
+
+
+@z
+%---------------------------------------
+@x [49] m.1210 l.22629 - Omega OCP
+any_mode(set_interaction):prefixed_command;
+@y
+any_mode(set_interaction),
+any_mode(set_ocp),
+any_mode(def_ocp),
+any_mode(set_ocp_list),
+any_mode(def_ocp_list),
+any_mode(clear_ocp_lists),
+any_mode(push_ocp_list),
+any_mode(pop_ocp_list),
+any_mode(ocp_list_op),
+any_mode(ocp_trace_level) : prefixed_command;
+@z
+%---------------------------------------
+@x [50] m.1302 l.23682 - Omega OCP
+@<Dump the font information@>;
+@y
+@<Dump the font information@>;
+@<Dump the ocp information@>;
+@<Dump the ocp list information@>;
+@z
+%---------------------------------------
+@x [50] m.1303 l.23711 - Omega OCP
+@<Undump the font information@>;
+@y
+@<Undump the font information@>;
+@<Undump the ocp information@>;
+@<Undump the ocp list information@>;
+@z
+%---------------------------------------
+@x [50] m.1323 l.24907 - Omega OCP
+begin undump_font_table(k);@/
+end
+@y
+begin undump_font_table(k);@/
+end
+
+@ @<Dump the ocp information@>=
+dump_int(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+ @<Dump the array info for internal ocp number |k|@>;
+print_ln; print_int(ocp_ptr-ocp_base); print(" preloaded ocp");
+if ocp_ptr<>ocp_base+1 then print_char("s")
+
+@ @<Undump the ocp information@>=
+undump_size(ocp_base)(ocp_biggest)('ocp max')(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+ @<Undump the array info for internal ocp number |k|@>
+
+@ @<Dump the array info for internal ocp number |k|@>=
+begin dump_ocp_table(k);
+print_nl("\ocp"); print_esc(ocp_id_text(k)); print_char("=");
+print_file_name(ocp_name(k),ocp_area(k),"");
+end
+
+@ @<Undump the array info for internal ocp number |k|@>=
+begin undump_ocp_table(k);
+end
+
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
+dump_int(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ dump_int(ocp_list_list[k]);
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
+
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
+undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do
+ undump_int(ocp_list_list[k]);
+undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
+
+@z
+%---------------------------------------
+@x
+@* \[54] $\Omega$ changes.
+
+@y
+@* \[54] $\Omega$ changes.
+
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+
+@ @<Put each...@>=
+primitive("ocp", def_ocp, 0);
+primitive("externalocp", def_ocp, 1);
+primitive("ocplist", def_ocp_list, 0);
+primitive("pushocplist", push_ocp_list, 0);
+primitive("popocplist", pop_ocp_list, 0);
+primitive("clearocplists", clear_ocp_lists, 0);
+primitive("addbeforeocplist", ocp_list_op, add_before_op);
+primitive("addafterocplist", ocp_list_op, add_after_op);
+primitive("removebeforeocplist", ocp_list_op, remove_before_op);
+primitive("removeafterocplist", ocp_list_op, remove_after_op);
+primitive("ocptracelevel", ocp_trace_level, 0);
+set_equiv(ocp_trace_level_base,0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_ocp: begin
+ print("select ocp ");
+ slow_print(ocp_name(chr_code));
+ end;
+def_ocp: if cur_chr=0 then print_esc("ocp")
+ else print_esc("externalocp");
+set_ocp_list: print("select ocp list ");
+def_ocp_list: print_esc("ocplist");
+push_ocp_list: print_esc("pushocplist");
+pop_ocp_list: print_esc("popocplist");
+clear_ocp_lists: print_esc("clearocplists");
+ocp_list_op:
+ if chr_code=add_before_op then print_esc("addbeforeocplist")
+ else if chr_code=add_after_op then print_esc("addafterocplist")
+ else if chr_code=remove_before_op then print_esc("removebeforeocplist")
+ else {|chr_code|=|remove_after_op|} print_esc("removeafterocplist");
+ocp_trace_level: print_esc("ocptracelevel");
+
+@ @<Assignments@>=
+set_ocp: begin
+ print_err("To use ocps, use the "); print_esc("pushocplist");
+ print(" primitive");print_ln
+ end;
+def_ocp: new_ocp(a);
+set_ocp_list: begin
+ print_err("To use ocp lists, use the ");
+ print_esc("pushocplist"); print(" primitive");print_ln
+ end;
+def_ocp_list: new_ocp_list(a);
+push_ocp_list: do_push_ocp_list(a);
+pop_ocp_list: do_pop_ocp_list(a);
+clear_ocp_lists: do_clear_ocp_lists(a);
+ocp_list_op: begin
+ print_err("To build ocp lists, use the ");
+ print_esc("ocplist"); print(" primitive"); print_ln
+ end;
+ocp_trace_level: begin scan_optional_equals; scan_int;
+ if cur_val<>0 then cur_val:=1;
+ define(ocp_trace_level_base, data, cur_val);
+ end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp(@!a:small_number);
+label common_ending;
+var u:pointer; {user's ocp identifier}
+@!f:internal_ocp_number; {runs through existing ocps}
+@!t:str_number; {name for the frozen ocp identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+@!flushable_string:str_number; {string not yet referenced}
+@!external_ocp:boolean; {external binary file}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the ocp name}
+@.texput@>
+if cur_chr=1 then external_ocp:=true
+else external_ocp:=false;
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+else if u>=single_base then
+ if u=null_cs then t:="OCP"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("OCP"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_ocp,null_ocp); scan_optional_equals; scan_file_name;
+@<If this ocp has already been loaded, set |f| to the internal
+ ocp number and |goto common_ending|@>;
+f:=read_ocp_info(u,cur_name,cur_area,cur_ext,external_ocp);
+common_ending:
+set_equiv(u,f); set_new_eqtb(ocp_id_base+f,new_eqtb(u));
+settext(ocp_id_base+f,t);
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl(""); print_esc("ocp"); print_esc(t); print("="); print(cur_name);
+ end;
+end;
+
+@ When the user gives a new identifier to a ocp that was previously loaded,
+the new name becomes the ocp identifier of record. OCP names `\.{xyz}' and
+`\.{XYZ}' are considered to be different.
+
+@<If this ocp has already been loaded...@>=
+flushable_string:=str_ptr-1;
+for f:=ocp_base+1 to ocp_ptr do
+ if str_eq_str(ocp_name(f),cur_name)and str_eq_str(ocp_area(f),cur_area) then
+ begin
+ if cur_name=flushable_string then begin
+ flush_string; cur_name:=ocp_name(f);
+ end;
+ goto common_ending
+ end
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp_list(@!a:small_number);
+var u:pointer; {user's ocp list identifier}
+@!f:internal_ocp_list_number; {runs through existing ocp lists}
+@!t:str_number; {name for the frozen ocp list identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the ocp list name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+else if u>=single_base then
+ if u=null_cs then t:="OCPLIST"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("OCPLIST"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_ocp_list,null_ocp_list); scan_optional_equals;
+f:=read_ocp_list;
+ set_equiv(u,f); set_new_eqtb(ocp_list_id_base+f,new_eqtb(u));
+ settext(ocp_list_id_base+f,t);
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl(""); print_esc("ocplist"); print_esc(t); print("=");
+ print_ocp_list(ocp_list_list[f]);
+ end;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_push_ocp_list(@!a:small_number);
+var ocp_list_no:halfword;
+ old_number:halfword;
+ i:integer;
+begin
+scan_ocp_list_ident; ocp_list_no:=cur_val;
+old_number:=equiv(ocp_active_number_base);
+define(ocp_active_base+old_number, data, ocp_list_no);
+define(ocp_active_number_base, data, (old_number+1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl("New active ocp list: {");
+ for i:=old_number downto 0 do begin
+ print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+ print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+ if i<>0 then print(",");
+ end;
+ print("}");
+ end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_pop_ocp_list(@!a:small_number);
+var old_number:halfword;
+ i:integer;
+begin
+old_number:=equiv(ocp_active_number_base);
+if old_number=0 then begin
+ print_err("No active ocp lists to be popped");
+ end
+else
+ define(ocp_active_number_base, data, (old_number-1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl("New active ocp list: {");
+ for i:=(old_number-2) downto 0 do begin
+ print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+ print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+ if i<>0 then print(",");
+ end;
+ print("}");
+ end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_clear_ocp_lists(@!a:small_number);
+begin
+define(ocp_active_number_base, data, 0);
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir-1.15/ompar.ch b/Build/source/texk/web2c/omegadir-1.15/ompar.ch
new file mode 100644
index 00000000000..401f4f5f2a8
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/ompar.ch
@@ -0,0 +1,862 @@
+% ompar.ch: Local paragraph information
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%-------------------------
+@x [15] m.208 l.4170
+@d min_internal=char_ghost+1 {the smallest code that can follow \.{\\the}}
+@y
+@d assign_local_box=char_ghost+1
+ {box for guillemets \.{\\localleftbox} or \.{\\localrightbox}}
+@d min_internal=assign_local_box+1 {the smallest code that can follow \.{\\the}}
+@z
+%-------------------------
+@x [16] m.212 l.4306
+ @!aux_field: memory_word;
+@y
+ @!aux_field: memory_word;
+ @!local_par_field: pointer;
+ @!local_par_bool_field: boolean;
+@z
+%-------------------------
+@x [16] m.213 l.4318
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@y
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@d local_par==cur_list.local_par_field
+ {pointer to whatsit for local stuff}
+@d local_par_bool==cur_list.local_par_bool_field
+ {has local stuff been changed in this group?}
+@z
+%-------------------------
+@x [16] m.215 l.4344
+prev_graf:=0; shown_mode:=0;
+@y
+prev_graf:=0; shown_mode:=0;
+local_par:=null; local_par_bool:=false;
+@z
+%-------------------------
+@x [16] m.216 l.4351
+@ When \TeX's work on one level is interrupted, the state is saved by
+calling |push_nest|. This routine changes |head| and |tail| so that
+a new (empty) list is begun; it does not change |mode| or |aux|.
+
+@p procedure push_nest; {enter a new semantic level, save the old}
+begin if nest_ptr>max_nest_stack then
+ begin max_nest_stack:=nest_ptr;
+ if nest_ptr=nest_size then overflow("semantic nest size",nest_size);
+@:TeX capacity exceeded semantic nest size}{\quad semantic nest size@>
+ end;
+nest[nest_ptr]:=cur_list; {stack the record}
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+@ @p @<LOCAL: Declare |make_local_par_node|@>;
+
+@ When \TeX's work on one level is interrupted, the state is saved by
+calling |push_nest|. This routine changes |head| and |tail| so that
+a new (empty) list is begun; it does not change |mode| or |aux|.
+
+@p procedure push_nest; {enter a new semantic level, save the old}
+begin if nest_ptr>max_nest_stack then
+ begin max_nest_stack:=nest_ptr;
+ if nest_ptr=nest_size then overflow("semantic nest size",nest_size);
+@:TeX capacity exceeded semantic nest size}{\quad semantic nest size@>
+ end;
+nest[nest_ptr]:=cur_list; {stack the record}
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+local_par:=make_local_par_node; local_par_bool:=false;
+@z
+%-------------------------
+@x [16] m.217 l.4366
+begin free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+@y
+begin
+if local_par<>null then begin
+ if local_par_bool then begin end {tail_append(local_par)}
+ else free_node(local_par,local_par_size);
+ end;
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+@z
+%-------------------------
+@x [17] m.230 l.4860
+@d box_base=toks_base+number_regs {table of |number_regs| box registers}
+@y
+@d local_left_box_base=toks_base+number_regs
+@d local_right_box_base=local_left_box_base+1
+@d box_base=local_right_box_base+1 {table of |number_regs| box registers}
+@z
+%-------------------------
+@x [17] m.230 l.4888
+@d box(#)==equiv(box_base+#)
+@y
+@d local_left_box==equiv(local_left_box_base)
+@d local_right_box==equiv(local_right_box_base)
+@d box(#)==equiv(box_base+#)
+@z
+%-------------------------
+@x [17] m.236 l.4954
+@d int_pars=55 {total number of integer parameters}
+@y
+@d local_inter_line_penalty_code=55 {local \.{\\interlinepenalty}}
+@d local_broken_penalty_code=56 {local \.{\\brokenpenalty}}
+@d no_local_whatsits_code=57 {counts local whatsits}
+@d int_pars=58 {total number of integer parameters}
+@z
+%-------------------------
+@x [17] m.236 l.5011
+@d new_line_char==int_par(new_line_char_code)
+@y
+@d new_line_char==int_par(new_line_char_code)
+@d local_inter_line_penalty==int_par(local_inter_line_penalty_code)
+@d local_broken_penalty==int_par(local_broken_penalty_code)
+@d no_local_whatsits==int_par(no_local_whatsits_code)
+@z
+%-------------------------
+@x [19] m.269 l.5860
+@d max_group_code=16
+@y
+@d local_box_group=17 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=17
+@z
+%-------------------------
+@x [38] m.814 l.15994
+@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
+@y
+@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
+@!internal_pen_inter:integer; {running \.{\\localinterlinepenalty}}
+@!internal_pen_broken:integer; {running \.{\\localbrokenpenalty}}
+@!internal_left_box:pointer; {running \.{\\localleftbox}}
+@!internal_left_box_width:integer; {running \.{\\localleftbox} width}
+@!init_internal_left_box:pointer; {running \.{\\localleftbox}}
+@!init_internal_left_box_width:integer; {running \.{\\localleftbox} width}
+@!internal_right_box:pointer; {running \.{\\localrightbox}}
+@!internal_right_box_width:integer; {running \.{\\localrightbox} width}
+@!temp_no_whatsits:integer; {used when closing group}
+
+@ @<Set init...@>=
+temp_no_whatsits:=0;
+@z
+%-------------------------
+@x [38] m.815 l.16002
+procedure line_break(@!final_widow_penalty:integer);
+label done,done1,done2,done3,done4,done5,continue;
+var @<Local variables for line breaking@>@;
+@y
+function get_natural_width(first_ptr:pointer):scaled;
+label reswitch, common_ending, exit;
+var
+@!p:pointer;
+@!x:scaled; {height, depth, and natural width}
+@!g:pointer; {points to a glue specification}
+@!f:internal_font_number; {the font in a |char_node|}
+@!i:four_quarters; {font information about a |char_node|}
+begin
+x:=0;
+p:=first_ptr;
+while p<>null do begin
+ while is_char_node(p) do begin
+ f:=font(p); i:=char_info(f)(character(p));
+ x:=x+char_width(f)(i);
+ p:=link(p);
+ end;
+ if p<>null then
+ begin case type(p) of
+ hlist_node,vlist_node,rule_node,unset_node:
+ x:=x+width(p);
+ ins_node,mark_node,adjust_node: do_nothing;
+ whatsit_node: do_nothing;
+ glue_node: begin
+ g:=glue_ptr(p); x:=x+width(g);
+ end;
+ kern_node,math_node: x:=x+width(p);
+ ligature_node: begin
+ f:=font(p); i:=char_info(f)(character(lig_char(p)));
+ x:=x+char_width(f)(i);
+ end;
+ othercases do_nothing
+ endcases;
+ p:=link(p);
+ end;
+ end;
+get_natural_width:=x;
+end;
+
+procedure line_break(@!final_widow_penalty:integer);
+label done,done1,done2,done3,done4,done5,continue;
+var new_hsize: scaled;
+@<Local variables for line breaking@>@;
+@z
+%-------------------------
+@x [38] m.821 l.16110
+@ The passive node for a given breakpoint contains only four fields:
+
+\yskip\hang|link| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+\yskip\hang|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+\yskip\hang|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+\yskip\hang|serial| is equal to |n| if this passive node is the |n|th
+one created during the current pass. (This field is used only when
+printing out detailed statistics about the line-breaking calculations.)
+
+\yskip\noindent
+There is a global variable called |passive| that points to the most
+recently created passive node. Another global variable, |printed_node|,
+is used to help print out the paragraph when detailed information about
+the line-breaking computation is being displayed.
+
+@d passive_node_size=2 {number of words in passive nodes}
+@d cur_break==rlink {in passive node, points to position of this breakpoint}
+@d prev_break==llink {points to passive node that should precede this one}
+@d serial==info {serial number for symbolic identification}
+@y
+@ The passive node for a given breakpoint contains EIGHT fields:
+
+\yskip\hang|link| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+\yskip\hang|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+\yskip\hang|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+\yskip\hang|serial| is equal to |n| if this passive node is the |n|th
+one created during the current pass. (This field is used only when
+printing out detailed statistics about the line-breaking calculations.)
+
+\yskip\hang|passive_pen_inter| holds the current \.{\\localinterlinepenalty}
+
+\yskip\hang|passive_pen_broken| holds the current \.{\\localbrokenpenalty}
+
+\yskip\noindent
+There is a global variable called |passive| that points to the most
+recently created passive node. Another global variable, |printed_node|,
+is used to help print out the paragraph when detailed information about
+the line-breaking computation is being displayed.
+
+@d passive_node_size=10 {number of words in passive nodes}
+@d cur_break==rlink {in passive node, points to position of this breakpoint}
+@d prev_break==llink {points to passive node that should precede this one}
+@d serial==info {serial number for symbolic identification}
+@d passive_pen_inter(#)==mem[#+2].int
+@d passive_pen_broken(#)==mem[#+3].int
+@d passive_left_box(#)==mem[#+4].int
+@d passive_left_box_width(#)==mem[#+5].int
+@d passive_last_left_box(#)==mem[#+6].int
+@d passive_last_left_box_width(#)==mem[#+7].int
+@d passive_right_box(#)==mem[#+8].int
+@d passive_right_box_width(#)==mem[#+9].int
+@z
+%-------------------------
+@x [38] m.835 l.16407
+@<If a line number class...@>=
+begin l:=line_number(r);
+if l>old_l then
+ begin {now we are no longer in the inner loop}
+@y
+@<If a line number class...@>=
+begin l:=line_number(r);
+if l>old_l then
+ begin {now we are no longer in the inner loop}
+@z
+%-------------------------
+@x [38] m.844 l.16595
+@<Insert a new active node from |best_place[fit_class]| to |cur_p|@>=
+begin q:=get_node(passive_node_size);
+link(q):=passive; passive:=q; cur_break(q):=cur_p;
+@!stat incr(pass_number); serial(q):=pass_number;@+tats@;@/
+prev_break(q):=best_place[fit_class];@/
+@y
+@<Insert a new active node from |best_place[fit_class]| to |cur_p|@>=
+begin q:=get_node(passive_node_size);
+link(q):=passive; passive:=q; cur_break(q):=cur_p;
+@!stat incr(pass_number); serial(q):=pass_number;@+tats@;@/
+prev_break(q):=best_place[fit_class];@/
+{Here we keep track of the subparagraph penalties in the break nodes}
+passive_pen_inter(q):=internal_pen_inter;
+passive_pen_broken(q):=internal_pen_broken;
+passive_last_left_box(q):=internal_left_box;
+passive_last_left_box_width(q):=internal_left_box_width;
+if prev_break(q)<>null then begin
+ passive_left_box(q):=passive_last_left_box(prev_break(q));
+ passive_left_box_width(q):=passive_last_left_box_width(prev_break(q));
+ end
+else begin
+ passive_left_box(q):=init_internal_left_box;
+ passive_left_box_width(q):=init_internal_left_box_width;
+ end;
+passive_right_box(q):=internal_right_box;
+passive_right_box_width(q):=internal_right_box_width;
+@z
+%-------------------------
+@x [38] m.848 l.16595
+if par_shape_ptr=null then
+ if hang_indent=0 then
+ begin last_special_line:=0; second_width:=hsize;
+@y
+new_hsize := get_natural_width(link(temp_head)) div 7;
+if new_hsize>hsize then new_hsize:=hsize;
+if new_hsize<(hsize div 4) then new_hsize:=(hsize div 4);
+new_hsize := hsize;
+if par_shape_ptr=null then
+ if hang_indent=0 then
+ begin last_special_line:=0; second_width:=new_hsize;
+@z
+%-------------------------
+@x [38] m.849 l.16595
+ begin first_width:=hsize-abs(hang_indent);
+ if hang_indent>=0 then first_indent:=hang_indent
+ else first_indent:=0;
+ second_width:=hsize; second_indent:=0;
+ end
+else begin first_width:=hsize; first_indent:=0;
+@y
+ begin first_width:=new_hsize-abs(hang_indent);
+ if hang_indent>=0 then first_indent:=hang_indent
+ else first_indent:=0;
+ second_width:=new_hsize; second_indent:=0;
+ end
+else begin first_width:=new_hsize; first_indent:=0;
+@z
+%-------------------------
+@x [38] m.851 l.16706
+@<Consider the demerits for a line from |r| to |cur_p|...@>=
+begin artificial_demerits:=false;@/
+@^inner loop@>
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+@y
+@<Consider the demerits for a line from |r| to |cur_p|...@>=
+begin artificial_demerits:=false;@/
+@^inner loop@>
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+if break_node(r)=null then
+ shortfall:=shortfall-init_internal_left_box_width
+else shortfall:=shortfall-passive_last_left_box_width(break_node(r));
+shortfall:=shortfall-internal_right_box_width;
+@z
+%-------------------------
+@x [39] m.863 l.16932
+loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
+ if second_pass then @<Initialize for hyphenating a paragraph@>;
+ @<Create an active breakpoint representing the beginning of the paragraph@>;
+ cur_p:=link(temp_head); auto_breaking:=true;@/
+ prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
+@y
+loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
+ if second_pass then @<Initialize for hyphenating a paragraph@>;
+ @<Create an active breakpoint representing the beginning of the paragraph@>;
+ cur_p:=link(temp_head); auto_breaking:=true;@/
+ prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
+ @<LOCAL: Initialize with first |local_paragraph| node@>;
+@z
+%-------------------------
+@x [39] m.877 l.17206
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+@y
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+@z
+%-------------------------
+@x [39] m.879 l.17257
+ if non_discardable(q) then goto done1;
+ if type(q)=kern_node then if subtype(q)<>explicit then goto done1;
+@y
+ if @<LOCAL: local paragraph node@> then begin end
+ else begin
+ if non_discardable(q) then goto done1;
+ if type(q)=kern_node then if subtype(q)<>explicit then goto done1;
+ end;
+@z
+%-------------------------
+@x [39] m.881 l.17289
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+if q<>null then {|q| cannot be a |char_node|}
+ if type(q)=glue_node then
+ begin delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+@y
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+if q<>null then {|q| cannot be a |char_node|}
+ if type(q)=glue_node then begin
+ if passive_right_box(cur_p)<>null then begin
+ r:=temp_head;
+ while link(r)<>q do r:=link(r);
+ s:=copy_node_list(passive_right_box(cur_p));
+ link(r):=s;
+ link(s):=q;
+ end;
+ delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+if passive_right_box(cur_p)<>null then begin
+ r:=copy_node_list(passive_right_box(cur_p));
+ link(r):=link(q);
+ link(q):=r;
+ q:=r;
+ end;
+@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+@z
+%-------------------------
+@x [39] m.887 l.17352
+@<Put the \(l)\.{\\leftskip} glue at the left...@>=
+r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
+if left_skip<>zero_glue then
+ begin r:=new_param_glue(left_skip_code);
+ link(r):=q; q:=r;
+ end
+@y
+@<Put the \(l)\.{\\leftskip} glue at the left...@>=
+r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
+if passive_left_box(cur_p)<>null then begin
+ r:=copy_node_list(passive_left_box(cur_p));
+ s:=link(q);
+ link(r):=q;
+ q:=r;
+ if (cur_line=prev_graf+1) and (s<>null) then
+ if type(s)=hlist_node then
+ if list_ptr(s)=null then begin
+ q:=link(q);
+ link(r):=link(s);
+ link(s):=r;
+ end;
+ end;
+if left_skip<>zero_glue then
+ begin r:=new_param_glue(left_skip_code);
+ link(r):=q; q:=r;
+ end
+@z
+%-------------------------
+@x [39] m.890 l.17391
+@<Append a penalty node, if a nonzero penalty is appropriate@>=
+if cur_line+1<>best_line then
+ begin pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+ if disc_break then pen:=pen+broken_penalty;
+@y
+@<Append a penalty node, if a nonzero penalty is appropriate@>=
+if cur_line+1<>best_line then begin
+ if passive_pen_inter(cur_p)<>0 then
+ pen:=passive_pen_inter(cur_p)
+ else pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+ if disc_break then
+ if passive_pen_broken(cur_p)<>0 then
+ pen:=pen+passive_pen_broken(cur_p)
+ else pen:=pen+broken_penalty;
+@z
+%-------------------------
+@x [47] m.1063 l.20580
+non_math(left_brace): new_save_level(simple_group);
+any_mode(begin_group): new_save_level(semi_simple_group);
+any_mode(end_group): if cur_group=semi_simple_group then unsave
+ else off_save;
+@y
+non_math(left_brace): begin
+ new_save_level(simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ end;
+any_mode(begin_group): begin
+ new_save_level(semi_simple_group);
+ eq_word_define(int_base+no_local_whatsits_code,0);
+ end;
+any_mode(end_group):
+ if cur_group=semi_simple_group then begin
+ temp_no_whatsits:=no_local_whatsits;
+ unsave;
+ if temp_no_whatsits<>0 then
+ if abs(mode)=hmode then @<LOCAL: Add local paragraph node@>;
+ end
+ else off_save;
+@z
+%-------------------------
+@x [47] m.1068 l.20653
+procedure handle_right_brace;
+var p,@!q:pointer; {for short-term use}
+@!d:scaled; {holds |split_max_depth| in |insert_group|}
+@!f:integer; {holds |floating_penalty| in |insert_group|}
+begin case cur_group of
+simple_group: unsave;
+@y
+procedure handle_right_brace;
+var p,@!q:pointer; {for short-term use}
+@!d:scaled; {holds |split_max_depth| in |insert_group|}
+@!f:integer; {holds |floating_penalty| in |insert_group|}
+begin case cur_group of
+simple_group: begin
+ temp_no_whatsits:=no_local_whatsits;
+ unsave;
+ if temp_no_whatsits<>0 then
+ if abs(mode)=hmode then @<LOCAL: Add local paragraph node@>;
+ end;
+@z
+%-------------------------
+@x [47] m.1091 l.21055
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ end;
+@y
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ tail:=new_null_box; link(link(head)):=tail; width(tail):=par_indent;@+
+ end;
+@z
+%-------------------------
+@x [47] m.1096 l.21116
+procedure end_graf;
+begin if mode=hmode then
+ begin if head=tail then pop_nest {null paragraphs are ignored}
+@y
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+@z
+%-------------------------
+@x [47] m.1114 l.21322
+primitive("-",discretionary,1);
+@!@:Single-character primitives -}{\quad\.{\\-}@>
+primitive("discretionary",discretionary,0);
+@!@:discretionary_}{\.{\\discretionary} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+discretionary: if chr_code=1 then
+ print_esc("-")@+else print_esc("discretionary");
+
+@ @<Cases of |main_control| that build...@>=
+hmode+discretionary,mmode+discretionary: append_discretionary;
+@y
+primitive("-",discretionary,1);
+@!@:Single-character primitives -}{\quad\.{\\-}@>
+primitive("discretionary",discretionary,0);
+@!@:discretionary_}{\.{\\discretionary} primitive@>
+primitive("localleftbox",assign_local_box,0);
+@!@:assign_local_box}{\.{\\localleftbox} primitive@>
+primitive("localrightbox",assign_local_box,1);
+@!@:assign_local_box}{\.{\\localrightbox} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+discretionary: if chr_code=1 then
+ print_esc("-")@+else print_esc("discretionary");
+assign_local_box: if chr_code=0 then print_esc("localleftbox")
+ else print_esc("localrightbox");
+
+@ @<Cases of |main_control| that build...@>=
+hmode+discretionary,mmode+discretionary: append_discretionary;
+any_mode(assign_local_box): append_local_box(cur_chr);
+@z
+%-------------------------
+@x [47] m.1117 l.21338
+procedure append_discretionary;
+@y
+procedure append_local_box(kind:integer);
+begin
+incr(save_ptr); saved(-1):=kind; new_save_level(local_box_group);
+scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
+end;
+
+procedure append_discretionary;
+@z
+%-------------------------
+@x [47] m.1118 l.21355
+disc_group: build_discretionary;
+@y
+disc_group: build_discretionary;
+local_box_group: build_local_box;
+@z
+%-------------------------
+@x [47] m.1119 l.21358
+procedure build_discretionary;
+@y
+procedure build_local_box;
+var p:pointer;
+ kind:integer;
+begin
+unsave;
+kind:=saved(-1);
+decr(save_ptr);
+p:=link(head); pop_nest;
+p:=hpack(p,natural);
+if kind=0 then
+ eq_define(local_left_box_base,box_ref,p)
+else
+ eq_define(local_right_box_base,box_ref,p);
+if abs(mode)=hmode then
+ @<LOCAL: Add local paragraph node@>;
+eq_word_define(int_base+no_local_whatsits_code,no_local_whatsits+1);
+end;
+
+procedure build_discretionary;
+@z
+%-------------------------
+@x [47] m.1200 l.22453
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+unsave; prev_graf:=prev_graf+3;
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@y
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+unsave; prev_graf:=prev_graf+3;
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+@z
+%-------------------------
+@x [49] m.1228 l.22908
+assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
+ word_define(p,cur_val);
+@y
+assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
+ word_define(p,cur_val);
+{If we are defining subparagraph penalty levels while we are
+in hmode, then we put out a whatsit immediately, otherwise
+we leave it alone. This mechanism might not be sufficiently
+powerful, and some other algorithm, searching down the stack,
+might be necessary. Good first step.}
+ if (abs(mode)=hmode) and
+ ((p=(int_base+local_inter_line_penalty_code)) or
+ (p=(int_base+local_broken_penalty_code))) then begin
+ @<LOCAL: Add local paragraph node@>;
+ eq_word_define(int_base+no_local_whatsits_code,no_local_whatsits+1);
+ local_par_bool:=true;
+ end;
+@z
+%-------------------------
+@x [53] m.1344 l.24533
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@y
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@d local_par_node=6 {|subtype| in whatsits for local paragraph node}
+@z
+%-------------------------
+@x [53] m.1344 l.24546
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+@y
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+primitive("localinterlinepenalty",assign_int,local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,local_broken_penalty_code);@/
+@z
+%-------------------------
+@x [53] m.1356 l.24660
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+@y4
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+@<LOCAL: print out |local_paragraph| node@>;
+@z
+%-------------------------
+@x [53] m.1357 l.24685
+othercases confusion("ext2")
+@y
+local_par_node: begin r:=get_node(local_par_size);
+ words:=local_par_size;
+ end;
+othercases confusion("ext2")
+@z
+%-------------------------
+@x [53] m.1358 l.24696
+othercases confusion("ext3")
+@y
+local_par_node: free_node(p,local_par_size);
+othercases confusion("ext3")
+@z
+%-------------------------
+@x [53] m.1362 l.24711
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p)
+@y
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p) else @<LOCAL: Advance past a |local_paragraph| node@>
+@z
+%-------------------------
+@x [53] m.1373 l.24820
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+begin case subtype(p) of
+open_node,write_node,close_node:@<Do some work that has been queued up
+ for \.{\\write}@>;
+special_node:special_out(p);
+language_node:do_nothing;
+othercases confusion("ext4")
+@y
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+begin case subtype(p) of
+open_node,write_node,close_node:@<Do some work that has been queued up
+ for \.{\\write}@>;
+special_node:special_out(p);
+language_node:do_nothing;
+local_par_node:do_nothing;
+othercases confusion("ext4")
+@z
+%-------------------------
+@x [53] m.1378 l.24900
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+@y
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+
+@
+@d local_pen_inter(#)==mem[#+1].int {\.{\\localinterlinepenalty}}
+@d local_pen_broken(#)==mem[#+2].int {\.{\\localbrokenpenalty}}
+@d local_box_left(#)==mem[#+3].int {\.{\\localleftbox}}
+@d local_box_left_width(#)==mem[#+4].int
+@d local_box_right(#)==mem[#+5].int {\.{\\localleftbox}}
+@d local_box_right_width(#)==mem[#+6].int
+@d local_par_size==7
+
+@<LOCAL: Declare |make_local_par_node|@>=
+function make_local_par_node:pointer;
+{This function creates a |local_paragraph| node}
+var p:pointer;
+begin
+p:=get_node(local_par_size); type(p):=whatsit_node;
+subtype(p):=local_par_node; link(p):=null;
+local_pen_inter(p):=local_inter_line_penalty;
+local_pen_broken(p):=local_broken_penalty;
+if local_left_box=null then begin
+ local_box_left(p):=null;
+ local_box_left_width(p):=0;
+ end
+else begin
+ local_box_left(p):=copy_node_list(local_left_box);
+ local_box_left_width(p):=width(local_left_box);
+ end;
+if local_right_box=null then begin
+ local_box_right(p):=null;
+ local_box_right_width(p):=0;
+ end
+else begin
+ local_box_right(p):=copy_node_list(local_right_box);
+ local_box_right_width(p):=width(local_right_box);
+ end;
+make_local_par_node:=p;
+end
+
+@ @<LOCAL: Initialize with first |local_paragraph| node@>=
+if subtype(cur_p)=local_par_node then begin
+ internal_pen_inter:=local_pen_inter(cur_p);
+ internal_pen_broken:=local_pen_broken(cur_p);
+ init_internal_left_box:=local_box_left(cur_p);
+ init_internal_left_box_width:=local_box_left_width(cur_p);
+ internal_left_box:=init_internal_left_box;
+ internal_left_box_width:=init_internal_left_box_width;
+ internal_right_box:=local_box_right(cur_p);
+ internal_right_box_width:=local_box_right_width(cur_p);
+ end
+
+@ @<LOCAL: Advance past a |local_paragraph| node@>=
+if subtype(cur_p)=local_par_node then begin
+ internal_pen_inter:=local_pen_inter(cur_p);
+ internal_pen_broken:=local_pen_broken(cur_p);
+ internal_left_box:=local_box_left(cur_p);
+ internal_left_box_width:=local_box_left_width(cur_p);
+ internal_right_box:=local_box_right(cur_p);
+ internal_right_box_width:=local_box_right_width(cur_p);
+ end
+
+@ @<LOCAL: print out |local_paragraph| node@>=
+local_par_node: begin
+ print_esc("whatsit");
+ append_char(".");
+ print_ln; print_current_string;
+ print_esc("localinterlinepenalty"); print("=");
+ print_int(local_pen_inter(p));
+ print_ln; print_current_string;
+ print_esc("localbrokenpenalty"); print("=");
+ print_int(local_pen_broken(p));
+ print_ln; print_current_string;
+ print_esc("localleftbox");
+ if local_box_left(p)=null then print("=null")
+ else begin
+ append_char(".");
+ show_node_list(local_box_left(p));
+ decr(pool_ptr);
+ end;
+ print_ln; print_current_string;
+ print_esc("localrightbox");
+ if local_box_right(p)=null then print("=null")
+ else begin
+ append_char(".");
+ show_node_list(local_box_right(p));
+ decr(pool_ptr);
+ end;
+ decr(pool_ptr);
+ end
+
+@ @<LOCAL: Add local paragraph node@>=
+begin tail_append(make_local_par_node) end
+
+@ @<LOCAL: local paragraph node@>=
+((type(q)=whatsit_node) and (subtype(q)=local_par_node))
+
+@z
+%-------------------------
diff --git a/Build/source/texk/web2c/omegadir-1.15/omstr.ch b/Build/source/texk/web2c/omegadir-1.15/omstr.ch
new file mode 100644
index 00000000000..f23ca0c2933
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omstr.ch
@@ -0,0 +1,875 @@
+% omstr.ch: String manipulation
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [2] m.17 l.510 - Omega
+In order to make \TeX\ readily portable to a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+@y
+In order to make $\Omega$ readily portable to a wide variety of
+computers, all of its input text is converted to an internal 31-bit
+@z
+%---------------------------------------
+@x [2] m.18 l.537 - Omega
+@!ASCII_code=0..255; {eight-bit numbers}
+@y
+@!ASCII_code=0..biggest_char;
+@z
+%---------------------------------------
+@x [2] m.19 l.567 - Omega
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@y
+@d last_text_char=biggest_char
+ {ordinal number of the largest element of |text_char|}
+@z
+%---------------------------------------
+@x [2] m.20 l.577 - Omega
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+@y
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+@z
+%---------------------------------------
+@x [2] m.23 l.724 - Omega
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+@y
+for i:=0 to @'37 do xchr[i]:=chr(i);
+for i:=@'177 to @'377 do xchr[i]:=chr(i);
+init_eqtb_table;
+@z
+%---------------------------------------
+@x [2] m.24 l.734 - Omega
+for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
+for i:=@'200 to @'377 do xord[xchr[i]]:=i;
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+@y
+@z
+%---------------------------------------
+@x [3] m.25 l.772 - Omega
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+@!eight_bits=0..biggest_char; {unsigned two-byte quantity}
+@!real_eight_bits=0..255; {dvi output uses exactly 8 bits}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of real_eight_bits; {files that contain binary data}
+@z
+%---------------------------------------
+@x [3] m.31 l.947 - Omega
+ buffer[last]:=xord[f^]; get(f); incr(last);
+@y
+ buffer[last]:=f^; get(f); incr(last);
+@z
+%---------------------------------------
+@x [4] m.38 l.1099 - Omega
+String numbers 0 to 255 are reserved for strings that correspond to single
+ASCII characters. This is in accordance with the conventions of \.{WEB},
+@y
+String numbers 0 to |biggest_char| are reserved for strings that correspond to
+single ASCII characters. This is in accordance with the conventions of \.{WEB},
+@z
+%---------------------------------------
+@x [4] m.38 l.1109 - Omega
+ASCII character, so the first 256 strings are used to specify exactly what
+should be printed for each of the 256 possibilities.
+@y
+ASCII character, so the first |biggest_char+1| strings are used to specify
+exactly what should be printed for each of the |biggest_char+1| possibilities.
+@z
+%---------------------------------------
+@x [4] m.38-9 l.1122 - Omega
+@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
+@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..255; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
+@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
+@d str_start(#) == str_start_ar[#-too_big_char]
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..65535; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start_ar : array[str_number] of pool_pointer; {the starting pointers}
+@z
+%---------------------------------------
+@x [4] m.40 l.1145 - Omega
+@d length(#)==(str_start[#+1]-str_start[#]) {the number of characters
+ in string number \#}
+@y
+@p function length(s:str_number):integer;
+ {the number of characters in string number |s|}
+begin if (s>=@"10000) then length:=str_start(s+1)-str_start(s)
+else if (s>=@"20) and (s<@"7F) then length:=1
+else if (s<=@"7F) then length:=3
+else if (s<@"100) then length:=4
+else length:=8
+end;
+@z
+%---------------------------------------
+@x [4] m.41 l.1150 - Omega
+@d cur_length == (pool_ptr - str_start[str_ptr])
+@y
+@d cur_length == (pool_ptr - str_start(str_ptr))
+@z
+%---------------------------------------
+@x [4] m.43 l.1181 - Omega
+incr(str_ptr); str_start[str_ptr]:=pool_ptr;
+@y
+incr(str_ptr); str_start(str_ptr):=pool_ptr;
+@z
+%---------------------------------------
+@x [4] m.44 l.1187 - Omega
+@d flush_string==begin decr(str_ptr); pool_ptr:=str_start[str_ptr];
+@y
+@d flush_string==begin decr(str_ptr); pool_ptr:=str_start(str_ptr);
+@z
+%---------------------------------------
+@x [4] m.45 l.1201 - Omega
+begin j:=str_start[s];
+while j<str_start[s+1] do
+@y
+begin j:=str_start(s);
+while j<str_start(s+1) do
+@z
+%---------------------------------------
+@x [4] m.46 l.1222 - Omega
+@p function str_eq_str(@!s,@!t:str_number):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j,@!k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin result:=false;
+if length(s)<>length(t) then goto not_found;
+j:=str_start[s]; k:=str_start[t];
+while j<str_start[s+1] do
+ begin if str_pool[j]<>str_pool[k] then goto not_found;
+ incr(j); incr(k);
+ end;
+result:=true;
+not_found: str_eq_str:=result;
+end;
+@y
+@p function str_eq_str(@!s,@!t:str_number):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j,@!k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin result:=false;
+if length(s)<>length(t) then goto not_found;
+if (length(s)=1) then begin
+ if s<65536 then begin
+ if t<65536 then begin
+ if s<>t then goto not_found;
+ end
+ else begin
+ if s<>str_pool[str_start(t)] then goto not_found;
+ end;
+ end
+ else begin
+ if t<65536 then begin
+ if str_pool[str_start(s)]<>t then goto not_found;
+ end
+ else begin
+ if str_pool[str_start(s)]<>str_pool[str_start(t)] then
+ goto not_found;
+ end;
+ end;
+ end
+else begin
+ j:=str_start(s); k:=str_start(t);
+ while j<str_start(s+1) do
+ begin if str_pool[j]<>str_pool[k] then goto not_found;
+ incr(j); incr(k);
+ end;
+ end;
+result:=true;
+not_found: str_eq_str:=result;
+end;
+@z
+%---------------------------------------
+@x [4] m.47 l.1240 - Omega
+var k,@!l:0..255; {small indices or counters}
+@y
+var k,@!l:0..biggest_char; {small indices or counters}
+@z
+%---------------------------------------
+@x [4] m.47 l.1245 - Omega
+begin pool_ptr:=0; str_ptr:=0; str_start[0]:=0;
+@<Make the first 256 strings@>;
+@<Read the other strings from the \.{TEX.POOL} file and return |true|,
+@y
+begin pool_ptr:=0; str_ptr:=0; str_start_ar[0]:=0; str_start_ar[1]:=0;
+@<Make the first strings@>;
+@<Read the other strings from the \.{OMEGA.POOL} file and return |true|,
+@z
+%---------------------------------------
+% A hack is made for strings 256 through to 65535.
+% String 256 becomes "^^^^????". All the strings
+% from 256 to 65535 are made to point at this string,
+% which will never be printed: it's just a placeholder.
+
+@x [4] m.48 l.1255 - Omega
+@<Make the first 256...@>=
+for k:=0 to 255 do
+ begin if (@<Character |k| cannot be printed@>) then
+ begin append_char("^"); append_char("^");
+ if k<@'100 then append_char(k+@'100)
+ else if k<@'200 then append_char(k-@'100)
+ else begin app_lc_hex(k div 16); app_lc_hex(k mod 16);
+ end;
+ end
+ else append_char(k);
+ g:=make_string;
+ end
+@y
+@<Make the first ...@>=
+begin
+str_ptr:=too_big_char;
+end
+@z
+%---------------------------------------
+@x [4] m.49 l.1279 - Omega
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+@y
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+Unprintable characters of codes 256--|biggest_char| are, similarly, rendered
+\.{\^\^\^\^0100}--\.{\^\^\^\^ffff}.
+
+@z
+%---------------------------------------
+@x [4] m.49 l.1295 - Omega
+@<Character |k| cannot be printed@>=
+ (k<" ")or(k>"~")
+@y
+@z
+%---------------------------------------
+@x [4] m.50 l.1298 - Omega
+@ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{TEX.PAS} and also a string pool file called \.{TEX.POOL}. The \.{INITEX}
+@y
+@ When the \.{WEB} system program called \.{OTANGLE} processes the \.{OMEGA.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{OMEGA.PAS} and also a string pool file called \.{OMEGA.POOL}. The \.{INITEX}
+@z
+%---------------------------------------
+@x [4] m.51 l.1322 - Omega
+else bad_pool('! I can''t read TEX.POOL.')
+@.I can't read TEX.POOL@>
+@y
+else bad_pool('! I can''t read OMEGA.POOL.')
+@.I can't read OMEGA.POOL@>
+@z
+%---------------------------------------
+@x [4] m.52 l.1326 - Omega
+begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.');
+@.TEX.POOL has no check sum@>
+@y
+begin if eof(pool_file) then bad_pool('! OMEGA.POOL has no check sum.');
+@.OMEGA.POOL has no check sum@>
+@z
+%---------------------------------------
+@x [4] m.52 l.1332 - Omega
+else begin if (xord[m]<"0")or(xord[m]>"9")or@|
+ (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL line doesn''t begin with two digits.');
+@.TEX.POOL line doesn't...@>
+ l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(xord[m]);
+@y
+else begin if (m<"0")or(m>"9")or@|
+ (n<"0")or(n>"9") then
+ bad_pool('! OMEGA.POOL line doesn''t begin with two digits.');
+@.OMEGA.POOL line doesn't...@>
+ l:=m*10+n-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(m);
+@z
+%---------------------------------------
+@x [4] m.53 l.1347 - Omega
+end of this \.{TEX.POOL} file; any other value means that the wrong pool
+@y
+end of this \.{OMEGA.POOL} file; any other value means that the wrong pool
+@z
+%---------------------------------------
+@x [4] m.53 l.1354 - Omega
+loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL check sum doesn''t have nine digits.');
+@.TEX.POOL check sum...@>
+ a:=10*a+xord[n]-"0";
+@y
+loop@+ begin if (n<"0")or(n>"9") then
+ bad_pool('! OMEGA.POOL check sum doesn''t have nine digits.');
+@.OMEGA.POOL check sum...@>
+ a:=10*a+n-"0";
+@z
+%---------------------------------------
+@x [4] m.53 l.1360 - Omega
+done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.');
+@.TEX.POOL doesn't match@>
+@y
+done: if a<>@$ then bad_pool('! OMEGA.POOL doesn''t match; OTANGLE me again.');
+@.OMEGA.POOL doesn't match@>
+@z
+%---------------------------------------
+% When we print a string, we must make sure we do the appropriate
+% thing for strings 256 through to 65535. We must generate the
+% strings on the fly.
+
+@x [5] m.59 l.1496 - Omega
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<256 then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char; new_line_char:=-1;
+ {temporarily disable new-line character}
+ j:=str_start[s];
+ while j<str_start[s+1] do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+ new_line_char:=nl; return;
+ end;
+j:=str_start[s];
+while j<str_start[s+1] do
+@y
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@d print_lc_hex(#)==l:=#;
+ if l<10 then print_char(l+"0") else print_char(l-10+"a");
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+@!l:integer; {for printing 16-bit characters}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char;
+ @<Set newline character to -1@>;
+ if s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(s+@'100);
+ end
+ else if s<@"7F then
+ print_char(s)
+ else if s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(s-@'100);
+ end
+ else if s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end;
+ @<Set newline character to nl@>;
+ return;
+ end;
+j:=str_start(s);
+while j<str_start(s+1) do
+@z
+%---------------------------------------
+@x [5] m.60 l.1539 - Omega
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<256) then print(s)
+else begin j:=str_start[s];
+ while j<str_start[s+1] do
+@y
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<=biggest_char) then print(s)
+else begin j:=str_start(s);
+ while j<str_start(s+1) do
+@z
+%---------------------------------------
+@x [5] m.61 l.1556 - Omega
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+update_terminal;
+@y
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+wterm_ln('Copyright (c) 1994--2000 John Plaice and Yannis Haralambous');
+update_terminal;
+@z
+%---------------------------------------
+@x [5] m.63 l.1576 - Omega
+procedure print_esc(@!s:str_number); {prints escape character, then |s|}
+var c:integer; {the escape character code}
+begin @<Set variable |c| to the current escape character@>;
+if c>=0 then if c<256 then print(c);
+@y
+procedure print_esc(@!s:str_number); {prints escape character, then |s|}
+var c:integer; {the escape character code}
+begin @<Set variable |c| to the current escape character@>;
+if c>=0 then if c<=biggest_char then print(c);
+@z
+%---------------------------------------
+@x [5] m.69 l.1654 - Omega
+@p procedure print_roman_int(@!n:integer);
+label exit;
+var j,@!k: pool_pointer; {mysterious indices into |str_pool|}
+@!u,@!v: nonnegative_integer; {mysterious numbers}
+begin j:=str_start["m2d5c2l5x2v5i"]; v:=1000;
+@y
+@p procedure print_roman_int(@!n:integer);
+label exit;
+var j,@!k: pool_pointer; {mysterious indices into |str_pool|}
+@!u,@!v: nonnegative_integer; {mysterious numbers}
+begin j:=str_start("m2d5c2l5x2v5i"); v:=1000;
+@z
+%---------------------------------------
+@x [5] m.70 l.1674 - Omega
+@p procedure print_current_string; {prints a yet-unmade string}
+var j:pool_pointer; {points to current character code}
+begin j:=str_start[str_ptr];
+@y
+@p procedure print_current_string; {prints a yet-unmade string}
+var j:pool_pointer; {points to current character code}
+begin j:=str_start(str_ptr);
+@z
+%---------------------------------------
+@x [6] m.94 l.2052 - Omega
+print_err("TeX capacity exceeded, sorry [");
+@y
+print_err("Omega capacity exceeded, sorry [");
+@z
+%---------------------------------------
+@x [18] m.260 l.5532 - Omega
+while pool_ptr>str_start[str_ptr] do
+@y
+while pool_ptr>str_start(str_ptr) do
+@z
+%---------------------------------------
+@x [18] m.264 l.5610 - Omega
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+@y
+else begin k:=str_start(s); l:=str_start(s+1)-k;
+@z
+%---------------------------------------
+@x [24] m.341 l.7219 - Omega
+@!c,@!cc:ASCII_code; {constituents of a possible expanded code}
+@!d:2..3; {number of excess characters in an expanded code}
+@y
+@!c,@!cc,@!ccc,@!cccc:ASCII_code; {constituents of a possible expanded code}
+@!d:2..7; {number of excess characters in an expanded code}
+@z
+%---------------------------------------
+@x [24] m.352 l.7349 - Omega
+ else cur_chr:=16*cur_chr+cc-"a"+10
+@y
+ else cur_chr:=16*cur_chr+cc-"a"+10
+@d long_hex_to_cur_chr==
+ if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
+ if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
+ else cur_chr:=16*cur_chr+cc-"a"+10;
+ if ccc<="9" then cur_chr:=16*cur_chr+ccc-"0"
+ else cur_chr:=16*cur_chr+ccc-"a"+10;
+ if cccc<="9" then cur_chr:=16*cur_chr+cccc-"0"
+ else cur_chr:=16*cur_chr+cccc-"a"+10
+
+@z
+%---------------------------------------
+@x [24] m.352 l.7353 - Omega
+ begin c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
+@y
+ begin if (cur_chr=buffer[loc+1]) and (cur_chr=buffer[loc+2]) and
+ ((loc+6)<=limit) then
+ begin c:=buffer[loc+3]; cc:=buffer[loc+4];
+ ccc:=buffer[loc+5]; cccc:=buffer[loc+6];
+ if is_hex(c) and is_hex(cc) and is_hex(ccc) and is_hex(cccc) then
+ begin loc:=loc+7; long_hex_to_cur_chr; goto reswitch;
+ end;
+ end;
+ c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
+@z
+%---------------------------------------
+@x [24] m.355 l.7416 - Omega
+begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
+ begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
+ begin d:=2;
+ if is_hex(c) then @+if k+2<=limit then
+ begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
+ end;
+ if d>2 then
+ begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ end
+ else if c<@'100 then buffer[k-1]:=c+@'100
+ else buffer[k-1]:=c-@'100;
+ limit:=limit-d; first:=first-d;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end;
+ end;
+end
+
+@y
+begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
+ begin if (cur_chr=buffer[k+1]) and (cur_chr=buffer[k+2]) and
+ ((k+6)<=limit) then
+ begin c:=buffer[k+3]; cc:=buffer[k+4];
+ ccc:=buffer[k+5]; cccc:=buffer[k+6];
+ if is_hex(c) and is_hex(cc) and is_hex(ccc) and is_hex(cccc) then
+ begin d:=7; long_hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end
+ end
+ else begin
+ c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
+ begin
+ d:=2;
+ if is_hex(c) then @+if k+2<=limit then
+ begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
+ end;
+ if d>2 then
+ begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ end
+ else if c<@'100 then buffer[k-1]:=c+@'100
+ else buffer[k-1]:=c-@'100;
+ limit:=limit-d; first:=first-d;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end
+ end
+ end
+end
+@z
+%---------------------------------------
+@x [26] m.407 l.8216 - Omega
+begin p:=backup_head; link(p):=null; k:=str_start[s];
+while k<str_start[s+1] do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=so(str_pool[k]))or(cur_chr=so(str_pool[k])-"a"+"A")) then
+ begin store_new_token(cur_tok); incr(k);
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+@y
+begin p:=backup_head; link(p):=null;
+if s<too_big_char then begin
+ while true do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=s)or(cur_chr=s-"a"+"A")) then
+ begin store_new_token(cur_tok);
+ flush_list(link(backup_head)); scan_keyword:=true; return;
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+ end;
+k:=str_start(s);
+while k<str_start(s+1) do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=so(str_pool[k]))or(cur_chr=so(str_pool[k])-"a"+"A")) then
+ begin store_new_token(cur_tok); incr(k);
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+@z
+%---------------------------------------
+@x [29] m.517 l.10005 - Omega
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+if area_delimiter=0 then cur_area:=""
+else begin cur_area:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
+@y
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+if area_delimiter=0 then cur_area:=""
+else begin cur_area:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+@z
+%---------------------------------------
+@x [29] m.519 l.10039 - Omega
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[n] to str_start[n+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[e] to str_start[e+1]-1 do append_to_name(so(str_pool[j]));
+@y
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start(n) to str_start(n+1)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start(e) to str_start(e+1)-1 do append_to_name(so(str_pool[j]));
+@z
+%---------------------------------------
+@x [29] m.523 l.10095 - Omega
+for j:=1 to n do append_to_name(xord[TEX_format_default[j]]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=format_default_length-format_ext_length+1 to format_default_length do
+ append_to_name(xord[TEX_format_default[j]]);
+@y
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=format_default_length-format_ext_length+1 to format_default_length do
+ append_to_name(TEX_format_default[j]);
+@z
+%---------------------------------------
+@x [29] m.524 l.10155 - Omega
+else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+@y
+else begin for k:=1 to name_length do append_char(name_of_file[k]);
+@z
+%---------------------------------------
+@x [29] m.536 l.10324 - Omega
+begin wlog(banner);
+slow_print(format_ident); print(" ");
+print_int(day); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+for k:=3*month-2 to 3*month do wlog(months[k]);
+print_char(" "); print_int(year); print_char(" ");
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+end
+@y
+begin wlog(banner);
+slow_print(format_ident); print_nl("");
+print_int(day); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+for k:=3*month-2 to 3*month do wlog(months[k]);
+print_char(" "); print_int(year); print_char(" ");
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+print_nl("Copyright (c) 1994--2000 John Plaice and Yannis Haralambous");
+end
+@z
+%---------------------------------------
+@x [32] m.595 l.11860 - Omega
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@y
+@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
+@z
+%---------------------------------------
+@x [32] m.617 l.12262 - Omega
+ print(" TeX output "); print_int(year); print_char(".");
+@y
+ print("Omega output, Version 3.141592--1.15, ");
+ print_int(year); print_char(".");
+@z
+%---------------------------------------
+@x [32] m.617 l.12267 - Omega
+ for s:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[s]));
+ pool_ptr:=str_start[str_ptr]; {flush the current string}
+@y
+ for s:=str_start(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s]));
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+@z
+%---------------------------------------
+@x [36] m.765 l.15021 - Omega
+magic_offset:=str_start[math_spacing]-9*ord_noad
+@y
+magic_offset:=str_start(math_spacing)-9*ord_noad
+@z
+%---------------------------------------
+@x [42] m.931 l.18172 - Omega
+ begin j:=1; u:=str_start[k];
+@y
+ begin j:=1; u:=str_start(k);
+@z
+%---------------------------------------
+@x [42] m.940 l.18296 - Omega
+u:=str_start[k]; v:=str_start[s];
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start[k+1];
+@y
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+@z
+%---------------------------------------
+@x [49] m.1252 l.23232 - Omega
+ print_err("Patterns can be loaded only by INITEX");
+@y
+ print_err("Patterns can be loaded only by INIOMEGA");
+@z
+%---------------------------------------
+@x [50] m.1301 l.23682 - Omega
+format_ident:=" (INITEX)";
+@y
+format_ident:=" (INIOMEGA)";
+@z
+%---------------------------------------
+% We do not store any information for strings between 257 and 65535.
+
+@x [50] m.1309 l.23814 - Omega
+for k:=0 to str_ptr do dump_int(str_start[k]);
+@y
+for k:=too_big_char to str_ptr do dump_int(str_start(k));
+@z
+%---------------------------------------
+% We recreate the information for strings between 257 and 65535.
+
+@x [50] m.1310 l.23831 - Omega
+for k:=0 to str_ptr do undump(0)(pool_ptr)(str_start[k]);
+@y
+for k:=too_big_char to str_ptr do undump(0)(pool_ptr)(str_start(k));
+@z
+%---------------------------------------
+@x [51] m.1334 l.24266 - Omega
+ wlog_ln('Here is how much of TeX''s memory',' you used:');
+@y
+ wlog_ln('Here is how much of Omega''s memory',' you used:');
+@z
+%---------------------------------------
+@x [51] m.1335 l.24338 - Omega
+ print_nl("(\dump is performed only by INITEX)"); return;
+@:dump_}{\.{\\dump...only by INITEX}@>
+@y
+ print_nl("(\dump is performed only by INIOMEGA)"); return;
+@:dump_}{\.{\\dump...only by INIOMEGA}@>
+@z
+%---------------------------------------
+@x [53] m.1368 l.24747 - Omega
+for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
+pool_ptr:=str_start[str_ptr]; {erase the string}
+@y
+for k:=str_start(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k]));
+pool_ptr:=str_start(str_ptr); {erase the string}
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir-1.15/omtrans.ch b/Build/source/texk/web2c/omegadir-1.15/omtrans.ch
new file mode 100644
index 00000000000..fae0e52b7e6
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omtrans.ch
@@ -0,0 +1,782 @@
+% omtrans.ch: Characters sets for input and output
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [3] m.25 l.767 - Omega Translation
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+@y
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+
+@d no_mode=0
+@d onebyte_mode=1
+@d ebcdic_mode=2
+@d twobyte_mode=3
+@d twobyteLE_mode=4
+
+@d trans_input=0
+@d trans_output=1
+@d trans_default_input=2
+@d trans_default_output=3
+@d trans_no_input=4
+@d trans_no_output=5
+@d trans_no_default_input=6
+@d trans_no_default_output=7
+
+@d mode_input=0
+@d mode_output=1
+@d mode_default_input=2
+@d mode_default_output=3
+@d mode_no_input=4
+@d mode_no_output=5
+@d mode_no_default_input=6
+@d mode_no_default_output=7
+@z
+%---------------------------------------
+@x [3] m.30 l.890 - Omega Translation
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+@y
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+@!term_in_mode:halfword;
+@!term_in_translation:halfword;
+@z
+%---------------------------------------
+@x [3] m.37 l.1065 - Omega Translation
+ if not input_ln(term_in,true) then {this shouldn't happen}
+@y
+ if not new_input_ln(term_in,term_in_mode,term_in_translation,true)
+then {this shouldn't happen}
+@z
+%---------------------------------------
+@x [5] m.54 l. - Omega Translation
+@!log_file : alpha_file; {transcript of \TeX\ session}
+@y
+@!log_file : alpha_file; {transcript of \TeX\ session}
+@!term_out_mode:halfword;
+@!term_out_translation:halfword;
+@z
+%---------------------------------------
+@x [5] m.59 l. - Omega Translation
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+case selector of
+term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin wlog(xchr[s]); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin wterm(xchr[s]); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+othercases write(write_file[selector],xchr[s])
+endcases;@/
+incr(tally);
+exit:end;
+@y
+@d omega_write(#)==case term_out_mode of
+ no_mode: write(#,xchr[s]);
+ onebyte_mode,ebcdic_mode: write(#,xchr[s]);
+ twobyte_mode: begin write(#,xchr[s div @"100]);
+ write(#,xchr[s mod @"100]);
+ end;
+ twobyteLE_mode: begin write(#,xchr[s mod @"100]);
+ write(#,xchr[s div @"100]);
+ end;
+ end
+
+@d omega_file_write(#)==case write_file_mode[#] of
+ no_mode: write(write_file[#],xchr[s]);
+ onebyte_mode,ebcdic_mode: write(write_file[#],xchr[s]);
+ twobyte_mode: begin write(write_file[#],xchr[s div @"100]);
+ write(write_file[#],xchr[s mod @"100]);
+ end;
+ twobyteLE_mode: begin write(write_file[#],xchr[s mod @"100]);
+ write(write_file[#],xchr[s div @"100]);
+ end;
+ end
+
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+case selector of
+term_and_log: begin omega_write(term_out); omega_write(log_file);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin omega_write(log_file); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin omega_write(term_out); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+othercases omega_file_write(selector)
+endcases;@/
+incr(tally);
+exit:end;
+@z
+%---------------------------------------
+@x [5] m.59 l. - Omega Translation
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+@!l:integer; {for printing 16-bit characters}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char;
+ @<Set newline character to -1@>;
+ if s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(s+@'100);
+ end
+ else if s<@"7F then
+ print_char(s)
+ else if s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(s-@'100);
+ end
+ else if s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end;
+ @<Set newline character to nl@>;
+ return;
+ end;
+j:=str_start(s);
+while j<str_start(s+1) do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+exit:end;
+
+@ Control sequence names, file names, and strings constructed with
+\.{\\string} might contain |ASCII_code| values that can't
+be printed using |print_char|. Therefore we use |slow_print| for them:
+
+@<Basic print...@>=
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<=biggest_char) then print(s)
+else begin j:=str_start(s);
+ while j<str_start(s+1) do
+ begin print(so(str_pool[j])); incr(j);
+ end;
+ end;
+end;
+@y
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+@!l:integer; {for printing 16-bit characters}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char;
+ @<Set newline character to -1@>;
+ if s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(s+@'100);
+ end
+ else if s<@"7F then
+ print_char(s)
+ else if s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(s-@'100);
+ end
+ else if s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end;
+ @<Set newline character to nl@>;
+ return;
+ end;
+j:=str_start(s);
+while j<str_start(s+1) do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+exit:end;
+
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+ ((file_offset>0)and(selector>=log_only)) then print_ln;
+print(s);
+end;
+
+procedure overflow_ocp_buf_size; forward;
+procedure overflow_ocp_stack_size; forward;
+
+procedure omega_print(s:str_number);
+var new_s:str_number;
+ om_mode,om_translation:integer;
+ j:integer;
+begin
+om_mode:=no_mode;
+om_translation:=0;
+case selector of
+term_and_log,log_only,term_only: begin
+ om_mode:=term_out_mode;
+ if om_mode<>no_mode then om_translation:=term_out_translation;
+ end;
+no_print,pseudo,new_string: do_nothing;
+othercases begin
+ om_mode:=write_file_mode[selector];
+ if om_mode<>no_mode then om_translation:=write_file_translation[selector];
+ end
+endcases;
+
+if (om_mode=no_mode) or
+ ((om_mode=onebyte_mode) and (om_translation=0)) then
+ begin
+ j:=str_start(s);
+ while j<str_start(s+1) do begin
+ new_s:=so(str_pool[j]);
+ if new_s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(new_s+@'100);
+ end
+ else if new_s<@"7F then
+ print_char(new_s)
+ else if new_s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(new_s-@'100);
+ end
+ else if new_s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((new_s mod @"100) div @"10); print_lc_hex(new_s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(new_s div @"1000);
+ print_lc_hex((new_s mod @"1000) div @"100);
+ print_lc_hex((new_s mod @"100) div @"10);
+ print_lc_hex(new_s mod @"10);
+ end;
+ incr(j);
+ end;
+ end
+else begin
+ if om_translation=0 then begin
+ j:=str_start(s);
+ otp_counter:=1;
+ while j<str_start(s+1) do begin
+ otp_output_buf[otp_counter]:=so(str_pool[j]);
+ incr(otp_counter);
+ incr(j);
+ end;
+ otp_output_end:=otp_counter;
+ end
+ else begin
+ otp_input_start:=0;
+ otp_input_last:=0;
+ otp_stack_used:=0;
+ otp_stack_last:=0;
+ otp_stack_new:=0;
+ otp_output_end:=0;
+ otp_pc:=0;
+ otp_finished:=false;
+ otp_calc_ptr:=0;
+ otp_calcs[otp_calc_ptr]:=0;
+ otp_state_ptr:=0;
+ otp_states[otp_state_ptr]:=0;
+ otp_input_ocp:=om_translation;
+ j:=str_start(s);
+ otp_counter:=1;
+ while j<str_start(s+1) do begin
+ otp_input_buf[otp_counter]:=so(str_pool[j]);
+ incr(otp_counter);
+ incr(j);
+ end;
+ otp_input_end:=otp_counter;
+ while not otp_finished do
+ @<Run the OTP program@>;
+ end;
+ for otp_counter:=1 to (otp_output_end-1) do begin
+ new_s:=otp_output_buf[otp_counter];
+ if (om_mode<twobyte_mode) and (new_s>255) then
+ begin
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(new_s div @"1000);
+ print_lc_hex((new_s mod @"1000) div @"100);
+ print_lc_hex((new_s mod @"100) div @"10);
+ print_lc_hex(new_s mod @"10);
+ end
+ else
+ print_char(new_s);
+ end;
+ end;
+end;
+
+@ Control sequence names, file names, and strings constructed with
+\.{\\string} might contain |ASCII_code| values that can't
+be printed using |print_char|. Therefore we use |slow_print| for them:
+
+@<Basic print...@>=
+procedure slow_print(@!s:integer); {prints string |s|}
+begin if (s>=str_ptr) or (s<=biggest_char) then print(s)
+else omega_print(s);
+end;
+@z
+%---------------------------------------
+@x [5] - Omega Translation
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+ ((file_offset>0)and(selector>=log_only)) then print_ln;
+print(s);
+end;
+@y
+@z
+%---------------------------------------
+@x [5] m.71 l.1694 - Omega Translation
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@y
+if not new_input_ln(term_in,term_in_mode,term_in_translation,true)
+then fatal_error("End of file on the terminal!");
+@z
+%---------------------------------------
+@x [15] m.209 l.4170 - Omega Translation
+@d max_command=ocp_trace_level
+ {the largest command code seen at |big_switch|}
+@y
+@d char_trans=ocp_trace_level+1
+@d char_mode=char_trans+1
+@d max_command=char_mode
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.230 l.4722 - Omega Translation
+@d toks_base=ocp_active_base+max_active_ocp_lists
+ {table of |number_regs| token list registers}
+@y
+@d ocp_input_mode_base=ocp_active_base+max_active_ocp_lists
+@d ocp_input_onebyte_translation_base =ocp_input_mode_base+ 1
+@d ocp_input_ebcdic_translation_base =ocp_input_mode_base+ 2
+@d ocp_input_twobyte_translation_base =ocp_input_mode_base+ 3
+@d ocp_input_twobyteLE_translation_base =ocp_input_mode_base+ 4
+
+@d ocp_output_mode_base =ocp_input_mode_base+ 5
+@d ocp_output_onebyte_translation_base =ocp_input_mode_base+ 6
+@d ocp_output_ebcdic_translation_base =ocp_input_mode_base+ 7
+@d ocp_output_twobyte_translation_base =ocp_input_mode_base+ 8
+@d ocp_output_twobyteLE_translation_base =ocp_input_mode_base+ 9
+
+@d toks_base =ocp_input_mode_base+10
+@z
+%---------------------------------------
+@x [22] m.304 l.6535 - Omega Translation
+@!input_file : array[1..max_in_open] of alpha_file;
+@y
+@!input_file : array[1..max_in_open] of alpha_file;
+@!input_file_mode : array[1..max_in_open] of halfword;
+@!input_file_translation : array[1..max_in_open] of halfword;
+@z
+%---------------------------------------
+@x [23] m.331 l.7066 - Omega Translation
+param_ptr:=0; max_param_stack:=0;
+@y
+param_ptr:=0; max_param_stack:=0;
+geq_define(ocp_input_mode_base,data,1);
+term_in_mode:=equiv(ocp_input_mode_base);
+term_out_mode:=equiv(ocp_input_mode_base);
+if term_in_mode>0
+then term_in_translation:=
+ equiv(ocp_input_onebyte_translation_base+term_in_mode-1);
+if term_out_mode>0
+then term_out_translation:=
+ equiv(ocp_output_onebyte_translation_base+term_in_mode-1);
+@z
+%---------------------------------------
+@x [24] m.362 l.7066 - Omega Translation
+ begin if input_ln(cur_file,true) then {not end of file}
+@y
+ begin if new_input_ln(cur_file,input_file_mode[index],
+ input_file_translation[index],true) then {not end of file}
+@z
+%---------------------------------------
+@x [27] m.480 l.9411 - Omega Translation
+@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
+@y
+@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
+@!read_file_mode:array[0..15] of halfword;
+@!read_file_translation:array[0..15] of halfword;
+@z
+%---------------------------------------
+@x [27] m.485 l.9475 - Omega Translation
+@<Input the first line of |read_file[m]|@>=
+if input_ln(read_file[m],false) then read_open[m]:=normal
+else begin a_close(read_file[m]); read_open[m]:=closed;
+ end
+@y
+@<Input the first line of |read_file[m]|@>=
+begin read_file_mode[m]:=
+ get_file_mode(read_file[m], equiv(ocp_input_mode_base));
+if read_file_mode[m]>0
+then read_file_translation[m]:=
+ equiv(ocp_input_onebyte_translation_base+read_file_mode[m]-1);
+if new_input_ln(read_file[m],read_file_mode[m],
+ read_file_translation[m],false) then read_open[m]:=normal
+else begin a_close(read_file[m]); read_open[m]:=closed;
+ end
+end
+@z
+%---------------------------------------
+@x [27] m.486 l.9484 - Omega Translation
+begin if not input_ln(read_file[m],true) then
+ begin a_close(read_file[m]); read_open[m]:=closed;
+@y
+begin if not new_input_ln(read_file[m],
+read_file_mode[m],read_file_translation[m],true) then
+ begin a_close(read_file[m]); read_open[m]:=closed;
+@z
+%---------------------------------------
+@x [29] m.538 l.10371 - Omega Translation
+begin line:=1;
+if input_ln(cur_file,false) then do_nothing;
+@y
+begin line:=1;
+input_file_mode[index]:=
+ get_file_mode(cur_file, equiv(ocp_input_mode_base));
+if input_file_mode[index]>0
+then input_file_translation[index]:=
+ equiv(ocp_input_onebyte_translation_base+input_file_mode[index]-1);
+if new_input_ln(cur_file,input_file_mode[index],
+ input_file_translation[index],false) then do_nothing;
+@z
+%---------------------------------------
+@x [49] m.1210 l.22629 - Omega Translation
+any_mode(ocp_trace_level) : prefixed_command;
+@y
+any_mode(ocp_trace_level) : prefixed_command;
+any_mode(char_mode) : do_char_mode;
+any_mode(char_trans) : do_char_translation;
+@z
+%---------------------------------------
+@x [49] m.1343 l.24928 - Omega Translation
+@!write_file:array[0..15] of alpha_file;
+@y
+@!write_file:array[0..15] of alpha_file;
+@!write_file_mode:array[0..15] of halfword;
+@!write_file_translation:array[0..15] of halfword;
+@z
+%---------------------------------------
+@x
+@* \[54] $\Omega$ changes.
+
+@y
+@* \[54] $\Omega$ changes.
+
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Input Translation Processes.
+
+@ @<Put each...@>=
+primitive("InputTranslation", char_trans, trans_input);
+primitive("OutputTranslation", char_trans, trans_output);
+primitive("DefaultInputTranslation", char_trans, trans_default_input);
+primitive("DefaultOutputTranslation", char_trans, trans_default_output);
+primitive("noInputTranslation", char_trans, trans_no_input);
+primitive("noOutputTranslation", char_trans, trans_no_output);
+primitive("noDefaultInputTranslation", char_trans, trans_no_default_input);
+primitive("noDefaultOutputTranslation", char_trans, trans_no_default_output);
+primitive("InputMode", char_mode, mode_input);
+primitive("OutputMode", char_mode, mode_output);
+primitive("DefaultInputMode", char_mode, mode_default_input);
+primitive("DefaultOutputMode", char_mode, mode_default_output);
+primitive("noInputMode", char_mode, mode_no_input);
+primitive("noOutputMode", char_mode, mode_no_output);
+primitive("noDefaultInputMode", char_mode, mode_no_default_input);
+primitive("noDefaultOutputMode", char_mode, mode_no_default_output);
+
+geq_define(ocp_input_onebyte_translation_base, data, 0);
+geq_define(ocp_input_ebcdic_translation_base, data, 0);
+geq_define(ocp_input_twobyte_translation_base, data, 0);
+geq_define(ocp_input_twobyteLE_translation_base, data, 0);
+geq_define(ocp_input_mode_base, data, 0);
+
+geq_define(ocp_output_onebyte_translation_base, data, 0);
+geq_define(ocp_output_ebcdic_translation_base, data, 0);
+geq_define(ocp_output_twobyte_translation_base, data, 0);
+geq_define(ocp_output_twobyteLE_translation_base, data, 0);
+geq_define(ocp_output_mode_base, data, 0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+char_trans:
+ case chr_code of
+ trans_input: print_esc("InputTranslation");
+ trans_output: print_esc("OutputTranslation");
+ trans_default_input: print_esc("DefaultInputTranslation");
+ trans_default_output: print_esc("DefaultOutputTranslation");
+ trans_no_input: print_esc("noInputTranslation");
+ trans_no_output: print_esc("noOutputTranslation");
+ trans_no_default_input: print_esc("noDefaultInputTranslation");
+ trans_no_default_output: print_esc("noDefaultOutputTranslation");
+ end;
+char_mode:
+ case chr_code of
+ mode_input: print_esc("InputMode");
+ mode_output: print_esc("OutputMode");
+ mode_default_input: print_esc("DefaultInputMode");
+ mode_default_output: print_esc("DefaultOutputMode");
+ mode_no_input: print_esc("noInputMode");
+ mode_no_output: print_esc("noOutputMode");
+ mode_no_default_input: print_esc("noDefaultInputMode");
+ mode_no_default_output: print_esc("noDefaultOutputMode");
+ end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure scan_file_referrent;
+begin
+if scan_keyword("currentfile") then cur_val:=max_halfword
+else scan_int;
+end;
+
+procedure scan_mode;
+begin
+if scan_keyword("onebyte") then cur_val:=onebyte_mode
+else if scan_keyword("ebcdic") then cur_val:=ebcdic_mode
+else if scan_keyword("twobyte") then cur_val:=twobyte_mode
+else if scan_keyword("twobyteLE") then cur_val:=twobyteLE_mode
+else begin print_err("Invalid input mode"); cur_val:=0; end;
+end;
+
+procedure do_char_translation;
+var kind:halfword;
+ fileref:halfword;
+ moderef:halfword;
+ ocpref:halfword;
+begin
+fileref:=0;
+moderef:=0;
+ocpref:=0;
+kind:=cur_chr;
+if (kind mod 4) <= 1 then begin
+ scan_file_referrent;
+ fileref:=cur_val;
+ end
+else begin
+ scan_mode;
+ moderef:=cur_val;
+ end;
+if kind < 4 then begin
+ scan_ocp_ident;
+ ocpref:=cur_val;
+ end;
+case (kind mod 4) of
+ trans_input: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ read_file_translation[fileref]:=ocpref;
+ end
+ else if fileref<>max_halfword then begin
+ term_in_translation:=ocpref;
+ end
+ else begin
+ base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ while state = token_list do
+ begin
+ decr(base_ptr);
+ cur_input:=input_stack[base_ptr];
+ end;
+ if name>17 then input_file_translation[index]:=ocpref;
+ cur_input:=input_stack[input_ptr];
+ end;
+ end;
+ trans_output: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ write_file_translation[fileref]:=ocpref;
+ end
+ else begin
+ term_out_translation:=ocpref;
+ end;
+ end;
+ trans_default_input: begin
+ geq_define(ocp_input_mode_base+moderef,data,ocpref);
+ end;
+ trans_default_output: begin
+ geq_define(ocp_output_mode_base+moderef,data,ocpref);
+ end;
+ end;
+end;
+
+procedure do_char_mode;
+var kind:halfword;
+ fileref:halfword;
+ moderef:halfword;
+begin
+fileref:=0;
+moderef:=0;
+kind:=cur_chr;
+if (kind mod 4) <= 1 then begin
+ scan_file_referrent;
+ fileref:=cur_val;
+ end;
+if kind < 4 then begin
+ scan_mode;
+ moderef:=cur_val;
+ end;
+case (kind mod 4) of
+ trans_input: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ read_file_mode[fileref]:=moderef;
+ end
+ else if fileref<>max_halfword then begin
+ term_in_mode:=moderef;
+ end
+ else begin
+ base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ while state = token_list do
+ begin
+ decr(base_ptr);
+ cur_input:=input_stack[base_ptr];
+ end;
+ if name>17 then input_file_mode[index]:=moderef;
+ cur_input:=input_stack[input_ptr];
+ end;
+ end;
+ trans_output: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ write_file_mode[fileref]:=moderef;
+ end
+ else begin
+ term_out_mode:=moderef;
+ end;
+ end;
+ trans_default_input: begin
+ geq_define(ocp_input_mode_base,data,moderef);
+ end;
+ trans_default_output: begin
+ geq_define(ocp_output_mode_base,data,moderef);
+ end;
+ end;
+end;
+
+function p_new_input_ln(f:alpha_file;
+the_mode,translation:halfword;
+bypass_eoln:boolean):boolean;
+begin
+if (the_mode=no_mode) or ((the_mode=onebyte_mode) and (translation=0))
+then p_new_input_ln:=input_ln(f,bypass_eoln)
+else if not newinputline(f,the_mode,bypass_eoln)
+then p_new_input_ln:=false
+else if translation=0 then
+begin
+ if (first+otp_input_end)>=buf_size then overflow("buffer size", buf_size);
+ state:=new_line;
+ start:=first;
+ last:=start;
+ loc:=start;
+ for otp_counter:=1 to otp_input_end do
+ begin
+ buffer[last]:=otp_input_buf[otp_counter];
+ incr(last);
+ end;
+ while buffer[last-1]=' ' do decr(last);
+ limit:=last-1;
+ p_new_input_ln:=true
+end
+else
+begin
+ otp_input_start:=0;
+ otp_input_last:=0;
+ otp_stack_used:=0;
+ otp_stack_last:=0;
+ otp_stack_new:=0;
+ otp_output_end:=0;
+ otp_pc:=0;
+ otp_finished:=false;
+ otp_calc_ptr:=0;
+ otp_calcs[otp_calc_ptr]:=0;
+ otp_state_ptr:=0;
+ otp_states[otp_state_ptr]:=0;
+ otp_input_ocp:=translation;
+ while not otp_finished do
+ @<Run the OTP program@>;
+ if (first+otp_output_end)>=buf_size then overflow("buffer size", buf_size);
+ state:=new_line;
+ start:=first;
+ last:=start;
+ loc:=start;
+ for otp_counter:=1 to otp_output_end do
+ begin
+ buffer[last]:=otp_output_buf[otp_counter];
+ incr(last);
+ end;
+ while buffer[last-1]=' ' do decr(last);
+ limit:=last-1;
+ p_new_input_ln:=true
+end
+end;
+
+
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir-1.15/omxml.ch b/Build/source/texk/web2c/omegadir-1.15/omxml.ch
new file mode 100644
index 00000000000..4d47a3a55a0
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir-1.15/omxml.ch
@@ -0,0 +1,1975 @@
+% omxml.ch: Generate XML, MathML, HTML, etc.
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.392 - Omega
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@y
+@!font_sort_max=65535; {maximum internal font sort number}
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@z
+%---------------------------------------
+@x [1] m.12 l.437 - Omega
+@d number_fonts=font_biggest-font_base+2
+@y
+@d number_fonts=font_biggest-font_base+2
+@d font_sort_base=0
+@d font_sort_biggest=65535 {the biggest font sort}
+@d number_font_sorts=font_sort_biggest-font_sort_base+2
+@z
+%---------------------------------------
+@x [5] m.57 l.1446 - Omega
+othercases write_ln(write_file[selector])
+@y
+othercases if selector>max_selector then
+ write_ln(output_files[selector-max_selector])
+ else
+ write_ln(write_file[selector])
+@z
+%---------------------------------------
+@x [5] m.58 l.1465 - Omega
+othercases omega_file_write(selector)
+@y
+othercases if selector>max_selector then
+ write(output_files[selector-max_selector],xchr[s])
+ else
+ omega_file_write(selector)
+@z
+%---------------------------------------
+@x [10] m.160 l.3270 - Omega
+@ In fact, there are still more types coming. When we get to math formula
+processing we will see that a |style_node| has |type=14|; and a number
+of larger type codes will also be defined, for use in math mode only.
+@y
+@ In fact, there are still more types coming. When we get to math formula
+processing we will see that a |style_node| has |type=14|; and a number
+of larger type codes will also be defined, for use in math mode only.
+
+@d sgml_text_node=0
+@d sgml_math_node=1
+
+@d sgml_node=unset_node+1 {|type| for an SGML node}
+@d sgml_node_size=5
+@d sgml_tag(#)==mem[#+1].int
+@d sgml_attrs(#)==mem[#+2].int
+@d sgml_singleton(#)==info(#+3)
+@d sgml_info(#)==link(#+3)
+@d sgml_kind(#)==mem[#+4].int
+
+@d sgml_attr_node=unset_node+2 {|type| for an SGML attribute node}
+@d sgml_attr_node_size=4
+
+@d sgml_entity_node=unset_node+3 {|type| for an SGML entity node}
+@d sgml_entity_node_size=2
+@d sgml_entity_string(#)==mem[#+1].int
+
+@d biggest_ordinary_node=sgml_entity_node
+
+@p
+function new_sgml_node:pointer;
+var p:pointer;
+begin p:=get_node(sgml_node_size);
+type(p):=sgml_node;
+sgml_tag(p):=0;
+sgml_attrs(p):=0;
+sgml_info(p):=0;
+sgml_singleton(p):=0;
+sgml_kind(p):=0;
+new_sgml_node:=p;
+end;
+
+function new_sgml_attr_node:pointer;
+var p:pointer;
+begin p:=get_node(sgml_attr_node_size);
+type(p):=sgml_attr_node;
+sgml_tag(p):=0;
+sgml_attrs(p):=0;
+sgml_info(p):=0;
+sgml_singleton(p):=0;
+new_sgml_attr_node:=p;
+end;
+
+function new_sgml_entity_node:pointer;
+var p:pointer;
+begin p:=get_node(sgml_entity_node_size);
+type(p):=sgml_entity_node;
+sgml_entity_string(p):=0;
+new_sgml_entity_node:=p;
+end;
+@z
+%---------------------------------------
+@x [12] m.174 l.3520 - Omega
+@p procedure short_display(@!p:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+begin while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ print_ASCII(qo(character(p)));
+@y
+@p procedure short_display(@!p:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+ fsort:integer;
+begin while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ if not SGML_show_entities then
+ print_ASCII(qo(character(p)))
+ else begin
+ fsort:=font_name_sort(font(p));
+ if fsort<>0 then begin
+ if (font_sort_char_entity(fsort)(character(p))<>0) then
+ slow_print(font_sort_char_entity(fsort)(character(p)))
+ else
+ print_ASCII(qo(character(p)));
+ end
+ else
+ print_ASCII(qo(character(p)));
+ end;
+@z
+%---------------------------------------
+@x [12] m.176 l.3563 - Omega
+@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); print_ASCII(qo(character(p)));
+ end;
+end;
+@y
+@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+var fsort:integer;
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" ");
+ if not SGML_show_entities then
+ print_ASCII(qo(character(p)))
+ else begin
+ fsort:=font_name_sort(font(p));
+ if fsort<>0 then begin
+ if (font_sort_char_entity(fsort)(character(p))<>0) then
+ print(font_sort_char_entity(fsort)(character(p)))
+ else
+ print_ASCII(qo(character(p)));
+ end
+ else
+ print_ASCII(qo(character(p)));
+ end;
+ end;
+end;
+@z
+%---------------------------------------
+@x [13] m.202 l.3928 - Omega
+ adjust_node: flush_node_list(adjust_ptr(p));
+@y
+ adjust_node: flush_node_list(adjust_ptr(p));
+ sgml_node: begin
+ if sgml_tag(p)<>0 then flush_node_list(sgml_attrs(p));
+ free_node(p,sgml_node_size); goto done;
+ end;
+ sgml_attr_node: begin
+ free_node(p,sgml_attr_node_size); goto done;
+ end;
+ sgml_entity_node: begin
+ free_node(p,sgml_entity_node_size); goto done;
+ end;
+@z
+%---------------------------------------
+@x [15] m.209 l.4138 - Omega
+@d max_command=char_mode
+ {the largest command code seen at |big_switch|}
+@y
+@d set_show_sgml_entities=char_mode+1
+ {printing hex code or SGML-like entity during \.{\\showbox}}
+@d set_mml_mode=set_show_sgml_entities+1
+ {for entering or leaving MML mode ( \.{\\mmlmode}~)}
+@d mml_tag=set_mml_mode+1
+ {for various SGML tags}
+@d max_command=mml_tag
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+ @!pg_field,@!ml_field: integer;@+
+@y
+ @!pg_field,@!ml_field: integer;@+
+ @!sgml_field: integer;
+ @!sgml_attr_field: pointer;
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@y
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@d current_sgml_tag==cur_list.sgml_field {current SGML tag}
+@d current_sgml_attrs==cur_list.sgml_attr_field {current SGML tag}
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+prev_graf:=0; shown_mode:=0;
+@y
+prev_graf:=0; shown_mode:=0;
+current_sgml_tag:=0; current_sgml_attrs:=null;
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+current_sgml_tag:=0; current_sgml_attrs:=null;
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+@p procedure pop_nest; {leave a semantic level, re-enter the old}
+begin
+if local_par<>null then begin
+ if local_par_bool then begin end {tail_append(local_par)}
+ else free_node(local_par,local_par_size);
+ end;
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+end;
+@y
+@p procedure pop_nest; {leave a semantic level, re-enter the old}
+var attrs:pointer;
+ {p:pointer;}
+begin attrs:=null;
+if local_par<>null then begin
+ if local_par_bool then begin end {tail_append(local_par)}
+ else free_node(local_par,local_par_size);
+ end;
+{
+if current_sgml_attrs<>null then
+ if current_sgml_tag=null then
+ attrs:=current_sgml_attrs
+ else
+ free_avail(current_sgml_attrs);
+}
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+{
+if attrs<>null then begin
+ p:=attrs;
+ while link(p)<>null do
+ begin
+ p:=link(p);
+ end;
+ link(p):=current_sgml_attrs;
+ current_sgml_attrs:=attrs;
+ end;
+}
+end;
+@z
+%---------------------------------------
+@x [17] m.222 l.4525 - Omega
+@d frozen_null_ocp=frozen_null_font+number_fonts
+@y
+@d frozen_null_font_sort=frozen_null_font+number_font_sorts {permanent null sort}
+@d frozen_null_ocp=frozen_null_font_sort+number_font_sorts
+@z
+%---------------------------------------
+@x [17] m.232 l.4802 - Omega
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+@y
+@d null_font_sort==font_sort_base
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+@z
+%---------------------------------------
+@x [19] m.269 l.5859 - Omega
+@d math_left_group=16 {code for `\.{\\left...\\right}'}
+@d local_box_group=17 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=17
+@y
+@d math_left_group=16 {code for `\.{\\left...\\right}'}
+@d math_mml_group=17 {code for automatic `\.{\\left...\\right}'}
+@d text_mml_group=18 {code for `\.{\\text...}'}
+@d text_sgml_group=19 {code for SGML tags}
+@d font_entity_group=20
+@d empty_tag_group=21
+@d lone_tag_group=22
+@d local_box_group=23 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=23
+@z
+%---------------------------------------
+@x [29] m.532 l.10260 - Omega
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d ensure_dvi_open==if output_file_name=0 then
+ begin if job_name=0 then open_log_file;
+ pack_job_name(".dvi");
+ while not b_open_out(dvi_file) do
+ prompt_file_name("file name for output",".dvi");
+ output_file_name:=b_make_name_string(dvi_file);
+ end
+
+@<Glob...@>=
+@!dvi_file: byte_file; {the device-independent output goes here}
+@!output_file_name: str_number; {full name of the output file}
+@!log_name:str_number; {full name of the log file}
+@y
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d ensure_output_open_end(#)==while not b_open_out(#) do
+ prompt_file_name("file name for output",output_m_suffix);
+ output_m_name:=b_make_name_string(#);
+ end end
+
+@d ensure_output_open_middle(#)==output_m_name:=#; if #=0 then
+ begin if job_name=0 then open_log_file;
+ pack_job_name(output_m_suffix);
+ ensure_output_open_end
+
+@d ensure_output_open(#)==begin output_m_suffix:=#; ensure_output_open_middle
+
+@d ensure_dvi_open==begin
+ ensure_output_open(".dvi")(output_file_name)(dvi_file);
+ output_file_name:=output_m_name end
+
+@<Glob...@>=
+@!dvi_file: byte_file; {the device-independent output goes here}
+@!output_file_name: str_number; {full name of the dvi output file}
+@!output_m_suffix: str_number; {suffix for the current output file}
+@!output_m_name: str_number; {suffix for the current output file}
+@!output_file_names:array[1..10] of str_number;
+@!output_files:array[1..10] of byte_file;
+@!output_file_no:integer; {number of open output files}
+@!log_name:str_number; {full name of the log file}
+@z
+%---------------------------------------
+@x [29] m.533 l.10260 - Omega
+@ @<Initialize the output...@>=output_file_name:=0;
+@y
+@ @<Initialize the output...@>=output_file_name:=0;
+for output_file_no:=1 to 10 do output_file_names[output_file_no]:=0;
+output_file_no:=0;
+@z
+%---------------------------------------
+@x [30] m.549 l.10686 - Omega
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@y
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_sort_ptr:integer; {largest internal font sort number in use}
+@z
+%---------------------------------------
+@x [30] m.550 l.10723 - Omega
+@d param_base(#)==font_info(#)(offset_param_base).int
+@y
+@d param_base(#)==font_info(#)(offset_param_base).int
+
+@d font_sort_info_end(#)==#]
+@d font_sort_info(#)==font_sort_tables[#,font_sort_info_end
+@d font_sort_offset_file_size=0
+@d font_sort_offset_name=font_sort_offset_file_size+1
+@d font_sort_offset_bc=font_sort_offset_name+1
+@d font_sort_offset_ec=font_sort_offset_bc+1
+@d font_sort_offset_char_base=font_sort_offset_bc+1
+@d font_sort_file_size(#)==font_sort_info(#)(font_sort_offset_file_size).int
+@d font_sort_name(#)==font_sort_info(#)(font_sort_offset_name).int
+@d font_sort_bc(#)==font_sort_info(#)(font_sort_offset_bc).int
+@d font_sort_ec(#)==font_sort_info(#)(font_sort_offset_ec).int
+@d font_sort_char_base(#)==font_sort_info(#)(font_sort_offset_char_base).int
+@d font_sort_char_entity_end(#)==#*3].int
+@d font_sort_char_entity(#)==
+ font_sort_tables[#,font_sort_offset_char_base+font_sort_char_entity_end
+@d font_sort_char_tag_end(#)==#*3+1].int
+@d font_sort_char_tag(#)==
+ font_sort_tables[#,font_sort_offset_char_base+font_sort_char_tag_end
+@d font_sort_char_attr_end(#)==#*3+2].int
+@d font_sort_char_attr(#)==
+ font_sort_tables[#,font_sort_offset_char_base+font_sort_char_attr_end
+@z
+%---------------------------------------
+@x [30] m.550 l.10723 - Omega
+@!dimen_font:integer;
+@y
+@!dimen_font:integer;
+@!font_sorts:integer; {to run through font sorts}
+@!font_sort_c:integer; {character used to define font entities}
+@!font_sort_number:integer; {this particular font sort number}
+@z
+%---------------------------------------
+@x [30] m.552 l.10749 - Omega
+for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
+@y
+for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
+font_sort_ptr:=null_font_sort;
+allocate_font_sort_table(null_font_sort,font_sort_offset_char_base);
+font_sort_file_size(null_font_sort):=font_sort_offset_char_base;
+font_sort_name(null_font_sort):="nullfontsort";
+@z
+%---------------------------------------
+@x [32] m.638 l.12656 - Omega
+@<Ship box |p| out@>;
+@y
+if not MML_mode then begin @<Ship box |p| out@>; end;
+@z
+%---------------------------------------
+@x [34] m.682 l.13395 - Omega
+@d ord_noad=unset_node+3 {|type| of a noad classified Ord}
+@y
+@d ord_noad=biggest_ordinary_node+3 {|type| of a noad classified Ord}
+@z
+%---------------------------------------
+@x [34] m.688 l.13515 - Omega
+@d style_node=unset_node+1 {|type| of a style node}
+@y
+@d style_node=biggest_ordinary_node+1 {|type| of a style node}
+@z
+%---------------------------------------
+@x [34] m.688 l.13515 - Omega
+@d choice_node=unset_node+2 {|type| of a choice node}
+@y
+@d choice_node=biggest_ordinary_node+2 {|type| of a choice node}
+@z
+%---------------------------------------
+@x [46] m.1030
+hmode+spacer: if space_factor=1000 then goto append_normal_space
+ else app_space;
+hmode+ex_space,mmode+ex_space: goto append_normal_space;
+@y
+hmode+spacer:
+ if MML_mode then begin
+ make_sgml_entity(" ");
+ goto big_switch;
+ end
+ else if space_factor=1000 then goto append_normal_space
+ else app_space;
+hmode+ex_space,mmode+ex_space: goto append_normal_space;
+@z
+%---------------------------------------
+@x [47] m.1060 l.20533 - Omega
+procedure append_glue;
+var s:small_number; {modifier of skip command}
+begin s:=cur_chr;
+case s of
+fil_code: cur_val:=fil_glue;
+fill_code: cur_val:=fill_glue;
+ss_code: cur_val:=ss_glue;
+fil_neg_code: cur_val:=fil_neg_glue;
+skip_code: scan_glue(glue_val);
+mskip_code: scan_glue(mu_val);
+end; {now |cur_val| points to the glue specification}
+tail_append(new_glue(cur_val));
+if s>=skip_code then
+ begin decr(glue_ref_count(cur_val));
+ if s>skip_code then subtype(tail):=mu_glue;
+ end;
+end;
+@y
+procedure append_glue;
+var s:small_number; {modifier of skip command}
+begin s:=cur_chr;
+case s of
+fil_code: cur_val:=fil_glue;
+fill_code: cur_val:=fill_glue;
+ss_code: cur_val:=ss_glue;
+fil_neg_code: cur_val:=fil_neg_glue;
+skip_code: scan_glue(glue_val);
+mskip_code: scan_glue(mu_val);
+end; {now |cur_val| points to the glue specification}
+if (abs(mode)=mmode) and MML_mode then begin
+ end
+else begin
+ tail_append(new_glue(cur_val));
+ if s>=skip_code then
+ begin decr(glue_ref_count(cur_val));
+ if s>skip_code then subtype(tail):=mu_glue;
+ end;
+ end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1061 l.20339 - Omega
+procedure append_kern;
+var s:quarterword; {|subtype| of the kern node}
+begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
+tail_append(new_kern(cur_val)); subtype(tail):=s;
+end;
+@y
+procedure append_kern;
+var s:quarterword; {|subtype| of the kern node}
+begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
+if (abs(mode)=mmode) and MML_mode then begin
+ end
+else begin
+ tail_append(new_kern(cur_val)); subtype(tail):=s;
+ end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1073 l.20795 - Omega
+vmode+hmove,hmode+vmove,mmode+vmove: begin t:=cur_chr;
+ scan_normal_dimen;
+ if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
+ end;
+any_mode(leader_ship): scan_box(leader_flag-a_leaders+cur_chr);
+any_mode(make_box): begin_box(0);
+@y
+vmode+hmove,hmode+vmove,mmode+vmove: begin
+ if abs(mode)=mmode and MML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_cmd_chr(cur_cmd,cur_chr); print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end
+ else begin
+ t:=cur_chr; scan_normal_dimen;
+ if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
+ end;
+ end;
+any_mode(leader_ship): begin
+ if abs(mode)=mmode and MML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_cmd_chr(cur_cmd,cur_chr); print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end
+ else
+ scan_box(leader_flag-a_leaders+cur_chr);
+ end;
+any_mode(make_box): begin
+ if abs(mode)=mmode and MML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_cmd_chr(cur_cmd,cur_chr); print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end
+ else
+ begin_box(0);
+ end;
+@z
+%---------------------------------------
+@x [47] m. l.21055 - Omega
+procedure new_graf(@!indented:boolean);
+var p,q,dir_graf_tmp:pointer;
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+q:=tail;
+dir_rover:=text_dir_ptr;
+while dir_rover<>null do
+ begin
+ if (link(dir_rover)<>null) or (dir_dir(dir_rover)<>par_direction) then
+ begin
+ dir_graf_tmp:=new_dir(dir_dir(dir_rover));
+ link(dir_graf_tmp):=link(q); link(q):=dir_graf_tmp;
+ end;
+ dir_rover:=link(dir_rover);
+ end;
+q:=head;
+while link(q)<>null do q:=link(q);
+tail:=q;
+if every_par<>null then begin_token_list(every_par,every_par_text);
+if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
+end;
+@y
+procedure sgml_start_graf; forward;
+
+procedure new_graf(@!indented:boolean);
+var p,q,dir_graf_tmp:pointer;
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+{if MML_mode then begin
+ sgml_start_graf
+ end
+else} begin
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+q:=tail;
+dir_rover:=text_dir_ptr;
+while dir_rover<>null do
+ begin
+ if (link(dir_rover)<>null) or (dir_dir(dir_rover)<>par_direction) then
+ begin
+ dir_graf_tmp:=new_dir(dir_dir(dir_rover));
+ link(dir_graf_tmp):=link(q); link(q):=dir_graf_tmp;
+ end;
+ dir_rover:=link(dir_rover);
+ end;
+q:=head;
+while link(q)<>null do q:=link(q);
+tail:=q;
+if every_par<>null then begin_token_list(every_par,every_par_text);
+if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
+end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1100 l.21156 - Omega
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+ else line_break(widow_penalty);
+ if dir_save<>null then
+ begin flush_node_list(dir_save); dir_save:=null;
+ end;
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@y
+procedure sgml_end_graf; forward;
+
+procedure end_graf;
+begin if mode=hmode then
+ begin if (head=tail) or (link(head)=tail) then pop_nest
+ {null paragraphs are ignored, all contain a |local_paragraph| node}
+ {else if MML_mode then begin sgml_end_graf end}
+ else line_break(widow_penalty);
+ if dir_save<>null then
+ begin flush_node_list(dir_save); dir_save:=null;
+ end;
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1130 l.21562 - Omega
+vmode+halign,hmode+valign:init_align;
+mmode+halign: if privileged then
+ if cur_group=math_shift_group then init_align
+ else off_save;
+vmode+endv,hmode+endv: do_endv;
+@y
+vmode+halign,hmode+valign:init_align;
+mmode+halign: if MML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_esc("halign"); print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end
+ else begin
+ if privileged then
+ if cur_group=math_shift_group then init_align
+ else off_save;
+ end;
+vmode+endv,hmode+endv: do_endv;
+@z
+%---------------------------------------
+@x [48] m.1136 l.21605 - Omega
+@* \[48] Building math lists.
+The routines that \TeX\ uses to create mlists are similar to those we have
+just seen for the generation of hlists and vlists. But it is necessary to
+make ``noads'' as well as nodes, so the reader should review the
+discussion of math mode data structures before trying to make sense out of
+the following program.
+
+Here is a little routine that needs to be done whenever a subformula
+is about to be processed. The parameter is a code like |math_group|.
+
+@<Declare act...@>=
+procedure push_math(@!c:group_code);
+begin
+if math_direction<>text_direction then dir_math_save:=true;
+push_nest; mode:=-mmode; incompleat_noad:=null;
+@<DIR: |new_save_level| math@>;
+end;
+@y
+@* \[48] Building math lists.
+The routines that \TeX\ uses to create mlists are similar to those we have
+just seen for the generation of hlists and vlists. But it is necessary to
+make ``noads'' as well as nodes, so the reader should review the
+discussion of math mode data structures before trying to make sense out of
+the following program.
+
+Here is a little routine that needs to be done whenever a subformula
+is about to be processed. The parameter is a code like |math_group|.
+
+@<Glob...@>=
+@!MML_mode:boolean;
+@!SGML_show_entities:boolean;
+@!MML_level:integer;
+@!mml_file_no:integer; {the \.{MML} output file}
+@!mml_indent:integer;
+@!mml_depth_level:integer;
+@!mml_last_print_char:boolean;
+
+@ @<Set init...@>=
+MML_mode:=false;
+SGML_show_entities:=true;
+MML_level:=0;
+mml_indent:=0;
+mml_file_no:=0;
+mml_depth_level:=0;
+mml_last_print_char:=false;
+
+@
+
+@d sgml_out_pointer(#)==
+ case math_type(#(p)) of
+ math_char: begin
+ fetch(#(p));
+ fsort:=font_name_sort(cur_f);
+ if char_exists(cur_i) then begin
+ if (font_sort_char_tag(fsort)(cur_c)<>0) then begin
+ if not inside_mop then begin
+ for i:=1 to mml_indent do print(" ");
+ print("<"); print(font_sort_char_tag(fsort)(cur_c));
+ if (font_sort_char_attr(fsort)(cur_c)<>null) then begin
+ sgml_attrs_out(font_sort_char_attr(fsort)(cur_c));
+ end;
+ print("> ");
+ end;
+ if (font_sort_char_entity(fsort)(cur_c)<>0) then begin
+ print(font_sort_char_entity(fsort)(cur_c));
+ end;
+ if not inside_mop then begin
+ print(" </"); print(font_sort_char_tag(fsort)(cur_c));
+ print(">"); print(new_line_char);
+ back_at_bol:=true;
+ end;
+ end;
+ end;
+ end;
+ sub_mlist: begin
+ case type(p) of
+ op_noad,bin_noad,rel_noad,
+ open_noad,close_noad,punct_noad,inner_noad: begin
+ for i:=1 to mml_indent do print(" ");
+ print("<mo");
+ if (type(p)=op_noad) and (subtype(p)=limits) then begin
+ print(" limits=""true""");
+ end
+ else if (type(p)=op_noad) and (subtype(p)=no_limits) then begin
+ print(" limits=""false""");
+ end;
+ print("> ");
+ q:=p; cur_mlist:=info(#(p));
+ if link(cur_mlist)=null then
+ if type(cur_mlist)=sgml_node then
+ if str_eq_str(sgml_tag(cur_mlist),"mrow") then
+ cur_mlist:=sgml_info(cur_mlist);
+ sgml_out_mlist(false,false,true); p:=q;
+ print(" </mo>");
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ othercases begin
+ q:=p; cur_mlist:=info(#(p));
+ sgml_out_mlist(false,false,false); p:=q;
+ end
+ endcases;
+ end;
+ othercases begin
+ for i:=1 to mml_indent do print(" ");
+ print("<merror> Unrecognized math stuff </merror>");
+ print(new_line_char);
+ end
+ endcases;
+
+@<Declare act...@>=
+procedure push_math(@!c:group_code);
+begin
+if math_direction<>text_direction then dir_math_save:=true;
+push_nest; mode:=-mmode; incompleat_noad:=null;
+@<DIR: |new_save_level| math@>;
+end;
+
+function sgml_out_on_one_line(p:pointer):boolean;
+begin
+if (sgml_tag(p)="mi") or (sgml_tag(p)="mo") or (sgml_tag(p)="mn") then
+ sgml_out_on_one_line:=true
+else sgml_out_on_one_line:=false;
+end;
+
+procedure sgml_attrs_out(p:pointer);
+var q:pointer;
+begin
+q:=p;
+while q<>null do begin
+ print(" ");
+ print(sgml_tag(q)); print("=""");
+ print(sgml_attrs(q)); print("""");
+ q:=link(q);
+ end;
+end;
+
+procedure sgml_out_mlist(break_line,inside_text,inside_mop:boolean);
+var p,q:pointer;
+ old_selector:integer;
+ i,fsort:integer;
+ back_at_bol:boolean;
+ first_inside_text:boolean;
+begin
+old_selector:=selector;
+selector:=max_selector+mml_file_no;
+p:=cur_mlist;
+back_at_bol:=false;
+first_inside_text:=inside_text;
+while p<>null do begin
+ if is_char_node(p) then begin
+ fsort:=font_name_sort(font(p));
+ if (font_sort_char_entity(fsort)(character(p))<>0) then begin
+ if back_at_bol then
+ for i:=1 to mml_indent do print(" ");
+ print(font_sort_char_entity(fsort)(character(p)));
+ back_at_bol:=false;
+ mml_last_print_char:=true;
+ first_inside_text:=false;
+ end;
+ end
+ else begin
+ case type(p) of
+ hlist_node,vlist_node,rule_node,
+ ins_node,mark_node,adjust_node: do_nothing;
+ ligature_node: begin
+ fsort:=font_name_sort(font(lig_char(p)));
+ if (font_sort_char_entity(fsort)(character(lig_char(p)))<>0) then begin
+ if back_at_bol then
+ for i:=1 to mml_indent do print(" ");
+ print(font_sort_char_entity(fsort)(character(lig_char(p))));
+ back_at_bol:=false;
+ end;
+ mml_last_print_char:=false;
+ first_inside_text:=false;
+ end;
+ disc_node,whatsit_node,math_node,glue_node,
+ kern_node,penalty_node,unset_node: do_nothing;
+ sgml_node: begin
+ if sgml_tag(p)=0 then begin
+ print(sgml_attrs(p));
+ end
+ else if sgml_singleton(p)>=1 then begin
+ if not (first_inside_text) then begin
+ if inside_text then print(new_line_char);
+ for i:=1 to mml_indent do print(" ");
+ end;
+ print("<"); print(sgml_tag(p));
+ sgml_attrs_out(sgml_attrs(p));
+ if sgml_singleton(p)=1 then print("/");
+ print(">");
+ print(new_line_char);
+ back_at_bol:=true;
+ end
+ else begin
+ if not (first_inside_text) then begin
+ if inside_text and not(back_at_bol) then print(new_line_char);
+ for i:=1 to mml_indent do print(" ");
+ end;
+ print("<"); print(sgml_tag(p));
+ sgml_attrs_out(sgml_attrs(p)); print(">");
+ if sgml_out_on_one_line(p) then
+ print(" ")
+ else begin mml_indent:=mml_indent+1;
+ print(new_line_char);
+ end;
+ cur_mlist:=sgml_info(p);
+ if cur_mlist<>null then begin
+ if (sgml_kind(p)=sgml_text_node) or
+ (sgml_tag(p)="mtext") then begin
+ for i:=1 to mml_indent do print(" ");
+ sgml_out_mlist(false,true,false);
+ if mml_last_print_char then print(new_line_char);
+ end
+ else sgml_out_mlist(false,false,false);
+ end;
+ if sgml_out_on_one_line(p) then
+ print(" ")
+ else begin
+ mml_indent:=mml_indent-1;
+ for i:=1 to mml_indent do print(" ");
+ end;
+ print("</"); print(sgml_tag(p)); print(">");
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ mml_last_print_char:=false;
+ first_inside_text:=false;
+ end;
+ sgml_entity_node:
+ if not(first_inside_text and
+ (str_eq_str(sgml_entity_string(p)," "))) then begin
+ if back_at_bol then
+ for i:=1 to mml_indent do print(" ");
+ print(sgml_entity_string(p));
+ first_inside_text:=false;
+ mml_last_print_char:=true;
+ back_at_bol:=false;
+ if break_line then begin
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ end;
+ fraction_noad: begin
+ for i:=1 to mml_indent do print(" ");
+ print("<mfrac> Arguments </mfrac>"); print(new_line_char);
+ back_at_bol:=true;
+ mml_last_print_char:=false;
+ first_inside_text:=false;
+ end;
+ othercases begin
+ if (info(subscr(p))<>null) or
+ (info(supscr(p))<>null) then begin
+ if inside_text then print(new_line_char);
+ for i:=1 to mml_indent do print(" ");
+ print("<m");
+ if info(subscr(p))<>empty then print("sub");
+ if info(supscr(p))<>empty then print("sup");
+ print(">");
+ mml_indent:=mml_indent+1;
+ print(new_line_char);
+ end;
+ sgml_out_pointer(nucleus);
+ if (info(subscr(p))<>null) or
+ (info(supscr(p))<>null) then begin
+ if info(subscr(p))<>null then begin
+ sgml_out_pointer(subscr);
+ end;
+ if info(supscr(p))<>null then begin
+ sgml_out_pointer(supscr);
+ end;
+ mml_indent:=mml_indent-1;
+ for i:=1 to mml_indent do print(" ");
+ print("</m");
+ if info(subscr(p))<>null then print("sub");
+ if info(supscr(p))<>null then print("sup");
+ print(">");
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ mml_last_print_char:=false;
+ first_inside_text:=false;
+ end;
+ endcases;
+ end;
+ p:=link(p);
+ end;
+selector:=old_selector;
+end;
+
+procedure make_sgml_entity(s:str_number);
+begin
+link(tail):=new_sgml_entity_node;
+tail:=link(tail);
+sgml_entity_string(tail):=s;
+end;
+
+procedure scan_font_entity;
+var cv1,cv2,cv3,cv4:integer;
+begin
+scan_string_argument; cv1:=cur_val;
+scan_left_brace; scan_int; cv2:=cur_val; scan_right_brace;
+scan_string_argument; cv3:=cur_val;
+scan_string_argument; cv4:=cur_val;
+save_ptr:=save_ptr+4;
+saved(-1):=cv1; saved(-2):=cv2; saved(-3):=cv3; saved(-4):=cv4;
+new_save_level(font_entity_group); scan_left_brace; push_nest;
+end;
+
+procedure scan_empty_tag;
+begin
+scan_string_argument;
+link(tail):=new_sgml_node;
+tail:=link(tail);
+sgml_tag(tail):=cur_val;
+sgml_kind(tail):=sgml_math_node;
+sgml_singleton(tail):=1;
+incr(save_ptr); saved(-1):=tail;
+new_save_level(empty_tag_group); scan_left_brace; push_nest;
+end;
+
+procedure scan_lone_tag;
+begin
+scan_string_argument;
+link(tail):=new_sgml_node;
+tail:=link(tail);
+sgml_tag(tail):=cur_val;
+sgml_kind(tail):=sgml_math_node;
+sgml_singleton(tail):=2;
+incr(save_ptr); saved(-1):=tail;
+new_save_level(lone_tag_group); scan_left_brace; push_nest;
+end;
+
+procedure sgml_startmathtag(s:str_number);
+begin
+push_math(math_group); current_sgml_tag:=s;
+end;
+
+
+procedure sgml_starttexttag(s:str_number);
+begin
+push_nest; new_save_level(text_sgml_group);
+current_sgml_tag:=s;
+mode:=-hmode;
+end;
+
+
+procedure sgml_attribute(s,s1:str_number);
+var p:pointer;
+begin
+p:=new_sgml_attr_node;
+sgml_tag(p):=s;
+sgml_attrs(p):=s1;
+sgml_singleton(p):=0;
+link(p):=current_sgml_attrs;
+current_sgml_attrs:=p;
+end;
+
+procedure sgml_endtexttag(s:str_number);
+var q:pointer;
+begin
+if not str_eq_str(s,current_sgml_tag) then begin
+ print_err("Tags do not match: ");
+ print(current_sgml_tag); print(","); print(s);
+ print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end;
+q:=new_sgml_node;
+sgml_tag(q):=s;
+sgml_kind(q):=sgml_text_node;
+sgml_info(q):=link(head);
+sgml_attrs(q):=current_sgml_attrs;
+pop_nest;
+unsave;
+if mode=vmode then begin
+ ensure_mml_open;
+ cur_mlist:=q;
+ sgml_out_mlist(false,false,false);
+ end
+else begin
+ link(tail):=q;
+ tail:=q;
+ end;
+end;
+
+procedure sgml_write(s:str_number);
+var old_selector:integer;
+begin
+ensure_mml_open;
+old_selector:=selector;
+selector:=max_selector+mml_file_no;
+print(s);
+selector:=old_selector;
+end;
+
+procedure sgml_endmathtag(s:str_number);
+var q:pointer;
+begin
+if not str_eq_str(s,current_sgml_tag) then begin
+ print_err("Tags do not match: ");
+ print(current_sgml_tag); print(","); print(s);
+ print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end;
+q:=new_sgml_node;
+sgml_tag(q):=s;
+sgml_kind(q):=sgml_math_node;
+if s<>"mtext" then sgml_attrs(q):=current_sgml_attrs;
+sgml_info(q):=link(head);
+if current_sgml_attrs=null then
+ if (link(head)<>null) then
+ if (str_eq_str(s,"mtr") or str_eq_str(s,"mtd")) and
+ (link(link(head))=null) then begin
+ q:=sgml_info(q);
+ end;
+pop_nest;
+@<DIR: |unsave| math@>;
+link(tail):=q;
+tail:=q;
+end;
+
+procedure sgml_start_graf;
+begin
+sgml_starttexttag("par")
+end;
+
+procedure sgml_end_graf;
+begin
+sgml_endtexttag("par")
+end;
+
+@ Entering or leaving MML mode
+by using the routine called |primitive|, defined below. Let us enter them
+now, so that we don't have to list all those parameter names anywhere else.
+
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("showSGMLentities",set_show_sgml_entities,1);
+primitive("noshowSGMLentities",set_show_sgml_entities,0);
+primitive("MMLmode",set_mml_mode,1);
+@!@:MML_mode_}{\.{\\MMLmode} primitive@>
+primitive("noMMLmode",set_mml_mode,0);
+@!@:noMML_mode_}{\.{\\noMMLmode} primitive@>
+primitive("SGMLstartmathtag",mml_tag,0);
+primitive("SGMLendmathtag",mml_tag,1);
+primitive("SGMLstarttexttag",mml_tag,2);
+primitive("SGMLendtexttag",mml_tag,3);
+primitive("SGMLattribute",mml_tag,4);
+primitive("MMLstarttext",mml_tag,5);
+primitive("MMLendtext",mml_tag,6);
+
+primitive("SGMLampersand",other_char,"&");
+primitive("SGMLbackslash",other_char,"\");
+primitive("SGMLcarret",other_char,"^");
+primitive("SGMLdollar",other_char,"$");
+primitive("SGMLhash",other_char,"#");
+primitive("SGMLleftbrace",other_char,"{");
+primitive("SGMLpercent",other_char,"%");
+primitive("SGMLrightbrace",other_char,"}");
+primitive("SGMLunderscore",other_char,"_");
+
+primitive("SGMLentity",mml_tag,7);
+primitive("SGMLemptytag",mml_tag,8);
+primitive("SGMLlonetag",mml_tag,9);
+primitive("SGMLFontEntity",mml_tag,10);
+primitive("SGMLwrite",mml_tag,11);
+primitive("SGMLwriteln",mml_tag,12);
+
+@ @<Cases of |main_control| that build boxes and lists@>=
+mmode+set_mml_mode: report_illegal_case;
+non_math(set_mml_mode):
+ if cur_chr=0 then MML_mode:=false else MML_mode:=true;
+any_mode(set_show_sgml_entities):
+ if cur_chr=0 then SGML_show_entities:=false
+ else SGML_show_entities:=true;
+any_mode(mml_tag): begin
+ case cur_chr of
+ 0: begin scan_string_argument; sgml_startmathtag(cur_val); end;
+ 1: begin scan_string_argument; sgml_endmathtag(cur_val); end;
+ 2: begin scan_string_argument; sgml_starttexttag(cur_val); end;
+ 3: begin scan_string_argument; sgml_endtexttag(cur_val); end;
+ 4: begin scan_string_argument; cur_val1:=cur_val;
+ scan_string_argument; sgml_attribute(cur_val1,cur_val); end;
+ 5: begin
+ push_nest; new_save_level(text_mml_group);
+ current_sgml_tag:="mtext"; mode:=-hmode;
+ end;
+ 6: begin sgml_endtexttag("mtext"); end;
+ 7: begin scan_string_argument; make_sgml_entity(cur_val); end;
+ 8: begin scan_empty_tag; end;
+ 9: begin scan_lone_tag; end;
+ 10: begin scan_font_entity; end;
+ 11: begin scan_string_argument; sgml_write(cur_val); end;
+ 12: begin sgml_write(new_line_char); end;
+ end;
+ end;
+
+@ The following code opens \.{MML} output file if neccesary.
+@p procedure ensure_mml_open;
+begin
+ if mml_file_no=0 then begin
+ incr(output_file_no);
+ mml_file_no:=output_file_no;
+ ensure_output_open(".mml")
+ (output_file_names[mml_file_no])
+ (output_files[mml_file_no]);
+ output_file_names[mml_file_no]:=output_m_name;
+ end;
+end;
+
+@ @<Declare act...@>=
+
+@z
+%---------------------------------------
+@x [48] m.1137 l.21620 - Omega
+@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
+|math_shift| character) is scanned. We must check to see whether this
+`\.\$' is immediately followed by another, in case display math mode is
+called for.
+
+@<Cases of |main_control| that build...@>=
+hmode+math_shift:init_math;
+@y
+@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
+|math_shift| character) is scanned. We must check to see whether this
+`\.\$' is immediately followed by another, in case display math mode is
+called for.
+
+@<Cases of |main_control| that build...@>=
+hmode+math_shift: begin
+ if MML_mode then begin
+ ensure_mml_open;
+ incr(MML_level);
+ end;
+ init_math;
+ end;
+
+@z
+%---------------------------------------
+@x [48] m.1139 l.21648 - Omega
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+current_sgml_tag:="mrow";
+sgml_attribute("displaystyle","false");
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+%---------------------------------------
+@x [48] m.1145 l.21703 - Omega
+if every_display<>null then begin_token_list(every_display,every_display_text);
+@y
+current_sgml_tag:="mrow";
+sgml_attribute("displaystyle","true");
+if every_display<>null then begin_token_list(every_display,every_display_text);
+@z
+%---------------------------------------
+@x [48] m.1155 l.21878 - Omega
+ else type(p):=ord_noad+(c div @"1000000);
+ link(tail):=p; tail:=p;
+@y
+ else type(p):=ord_noad+(c div @"1000000);
+ if not MML_mode then
+ tail_append(p)
+ else if (c div @"1000000)=4 then begin
+ saved(0):=p;
+ incr(save_ptr);
+ push_math(math_mml_group);
+ end
+ else if (cur_group=math_mml_group) and
+ ((c div @"1000000)=5) then begin
+ {unsave;}
+ @<DIR: |unsave| math@>;
+ decr(save_ptr);
+ q:=saved(0);
+ r:=fin_mlist(null);
+ push_math(math_group);
+ tail_append(q); tail_append(r); tail_append(p);
+ {unsave;}
+ @<DIR: |unsave| math@>;
+ p:=fin_mlist(null);
+ tail_append(p);
+ end
+ else tail_append(p);
+@z
+%---------------------------------------
+@x [48] m.1176--1177 l.22109 - Omega
+procedure sub_sup;
+var t:small_number; {type of previous sub/superscript}
+@!p:pointer; {field to be filled by |scan_math|}
+begin t:=empty; p:=null;
+if tail<>head then if scripts_allowed(tail) then
+ begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+ t:=math_type(p);
+ end;
+if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
+scan_math(p);
+end;
+@y
+procedure sub_sup;
+var t:small_number; {type of previous sub/superscript}
+@!p,q,r:pointer; {field to be filled by |scan_math|}
+begin t:=empty; p:=null;
+if tail<>head then begin
+ if MML_mode then
+ if type(tail)=sgml_node then begin
+ q:=head;
+ while link(q)<>tail do q:=link(q);
+ r:=new_noad;
+ info(nucleus(r)):=tail;
+ math_type(nucleus(r)):=sub_mlist;
+ link(q):=r;
+ tail:=r;
+ end;
+ if scripts_allowed(tail) then
+ begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+ t:=math_type(p);
+ end;
+ end;
+if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
+scan_math(p);
+end;
+@z
+%---------------------------------------
+@x [48] m.1181 l.22199 - Omega
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+if incompleat_noad<>null then
+ @<Ignore the fraction operation and complain about this ambiguous case@>
+else begin incompleat_noad:=get_node(fraction_noad_size);
+ type(incompleat_noad):=fraction_noad;
+ subtype(incompleat_noad):=normal;
+ math_type(numerator(incompleat_noad)):=sub_mlist;
+ info(numerator(incompleat_noad)):=link(head);
+ mem[denominator(incompleat_noad)].hh:=empty_field;
+ mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
+ mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
+ link(head):=null; tail:=head;
+ @<Use code |c| to distinguish between generalized fractions@>;
+ end;
+end;
+@y
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+if incompleat_noad<>null then
+ @<Ignore the fraction operation and complain about this ambiguous case@>
+else begin incompleat_noad:=get_node(fraction_noad_size);
+ type(incompleat_noad):=fraction_noad;
+ subtype(incompleat_noad):=normal;
+ math_type(numerator(incompleat_noad)):=sub_mlist;
+ info(numerator(incompleat_noad)):=link(head);
+ mem[denominator(incompleat_noad)].hh:=empty_field;
+ if MML_mode then begin
+ mem[left_delimiter(incompleat_noad)].int:=0;
+ mem[right_delimiter(incompleat_noad)].int:=0;@/
+ end
+ else begin
+ mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
+ mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
+ end;
+ link(head):=null; tail:=head;
+ @<Use code |c| to distinguish between generalized fractions@>;
+ end;
+end;
+@z
+%---------------------------------------
+@x [48] m.1182 l.22199 - Omega
+ begin scan_delimiter(left_delimiter(incompleat_noad),false);
+ scan_delimiter(right_delimiter(incompleat_noad),false);
+@y
+ begin if MML_mode then begin
+ mem[left_delimiter(incompleat_noad)].int:=new_noad;
+ scan_math(nucleus(mem[left_delimiter(incompleat_noad)].int));
+ mem[right_delimiter(incompleat_noad)].int:=new_noad;
+ scan_math(nucleus(mem[right_delimiter(incompleat_noad)].int));
+ end
+ else begin
+ scan_delimiter(left_delimiter(incompleat_noad),0);
+ scan_delimiter(right_delimiter(incompleat_noad),0);
+ end;
+@z
+%---------------------------------------
+@x [48] m.1183 l.22212 - Omega
+ begin scan_delimiter(garbage,false); scan_delimiter(garbage,false);
+@y
+ begin if MML_mode then begin
+ scan_math(garbage); scan_math(garbage);
+ end
+ else begin
+ scan_delimiter(garbage,0); scan_delimiter(garbage,0);
+ end;
+@z
+%---------------------------------------
+@x [48] m.1184 l.22230 - Omega
+function fin_mlist(@!p:pointer):pointer;
+var q:pointer; {the mlist to return}
+begin if incompleat_noad<>null then @<Compleat the incompleat noad@>
+else begin link(tail):=p; q:=link(head);
+ end;
+pop_nest; fin_mlist:=q;
+end;
+@y
+function fin_mlist(@!p:pointer):pointer;
+var q,q1,q2:pointer; {the mlist to return}
+ tag:integer;
+begin if incompleat_noad<>null then @<Compleat the incompleat noad@>
+else begin link(tail):=p; q:=link(head);
+ end;
+if current_sgml_tag=0 then
+ tag:="mrow"
+else tag:=current_sgml_tag;
+pop_nest;
+if MML_mode then
+ if q<>null then
+ if link(q)<>null then begin
+ q1:=new_sgml_node;
+ sgml_tag(q1):=tag;
+ sgml_info(q1):=q;
+ sgml_kind(q1):=sgml_math_node;
+ fin_mlist:=q1
+ end
+ else fin_mlist:=q
+ else fin_mlist:=q
+else
+ fin_mlist:=q;
+end;
+@z
+%---------------------------------------
+@x [48] m.1185 l.22256 - Omega
+@ @<Compleat...@>=
+begin math_type(denominator(incompleat_noad)):=sub_mlist;
+info(denominator(incompleat_noad)):=link(head);
+if p=null then q:=incompleat_noad
+else begin q:=info(numerator(incompleat_noad));
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+ end;
+end
+@y
+@ @<Compleat...@>=
+begin math_type(denominator(incompleat_noad)):=sub_mlist;
+info(denominator(incompleat_noad)):=link(head);
+if p=null then
+ if not MML_mode then
+ q:=incompleat_noad
+ else begin
+ if link(info(numerator(incompleat_noad)))<>null then begin
+ q1:=new_sgml_node;
+ sgml_tag(q1):="mrow";
+ sgml_kind(q1):=sgml_math_node;
+ sgml_info(q1):=info(numerator(incompleat_noad));
+ end
+ else q1:=info(numerator(incompleat_noad));
+ if link(info(denominator(incompleat_noad)))<>null then begin
+ q2:=new_sgml_node;
+ sgml_tag(q2):="mrow";
+ sgml_kind(q2):=sgml_math_node;
+ sgml_info(q2):=info(denominator(incompleat_noad));
+ end
+ else q2:=info(denominator(incompleat_noad));
+ q:=new_sgml_node;
+ sgml_tag(q):="mfrac";
+ sgml_kind(q):=sgml_math_node;
+ sgml_info(q):=q1;
+ link(q1):=q2;
+ current_sgml_attrs:=null;
+ if thickness(incompleat_noad)<>default_code then
+ if thickness(incompleat_noad)=0 then
+ sgml_attribute("linethickness","0ex")
+ else if thickness(incompleat_noad)<default_rule_thickness then
+ sgml_attribute("linethickness","thin")
+ else if thickness(incompleat_noad)>default_rule_thickness then
+ sgml_attribute("linethickness","thick");
+ sgml_attrs(q):=current_sgml_attrs;
+ if (mem[left_delimiter(incompleat_noad)].int<>0) or
+ (mem[right_delimiter(incompleat_noad)].int<>0) then begin
+ q1:=q;
+ q:=new_sgml_node;
+ sgml_tag(q):="mrow";
+ sgml_kind(q):=sgml_math_node;
+ sgml_info(q):=mem[left_delimiter(incompleat_noad)].int;
+ link(mem[left_delimiter(incompleat_noad)].int):=q1;
+ link(q1):=mem[right_delimiter(incompleat_noad)].int;
+ end
+ end
+else begin q:=info(numerator(incompleat_noad));
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+ end;
+end
+@z
+%---------------------------------------
+@x [48] m.1186 l.22256 - Omega
+math_group: begin @<DIR: |unsave| math@>; decr(save_ptr);@/
+ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
+ if p<>null then if link(p)=null then
+ if type(p)=ord_noad then
+ begin if math_type(subscr(p))=empty then
+ if math_type(supscr(p))=empty then
+ begin mem[saved(0)].hh:=mem[nucleus(p)].hh;
+ free_node(p,noad_size);
+ end;
+ end
+ else if type(p)=accent_noad then if saved(0)=nucleus(tail) then
+ if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>;
+ end;
+@y
+text_mml_group: begin
+ unsave; decr(save_ptr);
+ p:=saved(0);
+ sgml_info(p):=link(head);
+ pop_nest;
+ tail_append(p);
+ end;
+text_sgml_group: begin
+ print_err("Expecting closing tag </");
+ print(current_sgml_tag); print(">.");
+ print_ln;
+ print_nl("The MathML translator cannot continue");
+ succumb;
+ end;
+math_mml_group: begin
+ @<DIR: |unsave| math@>;
+ decr(save_ptr);
+ link(saved(0)):=link(head);
+ p:=saved(0);
+ pop_nest;
+ if type(p)=sgml_node then
+ if str_eq_str(sgml_tag(p),"mrow") then
+ if sgml_attrs(p)=null then begin
+ if link(sgml_info(p))=null then
+ p:=sgml_info(p);
+ end;
+ tail_append(p);
+ back_input;
+ end;
+math_group: begin @<DIR: |unsave| math@>; decr(save_ptr);@/
+ if MML_mode then
+ math_type(saved(0)):=sub_mlist
+ else
+ math_type(saved(0)):=sub_mlist;
+ p:=fin_mlist(null); info(saved(0)):=p;
+ if p<>null then if link(p)=null then
+ if type(p)=ord_noad then
+ begin if math_type(subscr(p))=empty then
+ if math_type(supscr(p))=empty then
+ begin mem[saved(0)].hh:=mem[nucleus(p)].hh;
+ free_node(p,noad_size);
+ end;
+ end
+ else if type(p)=accent_noad then if saved(0)=nucleus(tail) then
+ if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>;
+ end;
+font_entity_group: begin
+ unsave;
+ font_sort_number:=font_sort_ptr+1;
+ for font_sorts:=font_sort_base+1 to font_sort_ptr do
+ if str_eq_str(font_sort_name(font_sorts),saved(-1)) then begin
+ font_sort_number:=font_sorts;
+ break;
+ end;
+ font_sort_c:=saved(-2);
+ font_sort_char_entity(font_sort_number)(font_sort_c):=saved(-3);
+ font_sort_char_tag(font_sort_number)(font_sort_c):=saved(-4);
+ font_sort_char_attr(font_sort_number)(font_sort_c):=current_sgml_attrs;
+ current_sgml_attrs:=null;
+ save_ptr:=save_ptr-4; pop_nest;
+ end;
+empty_tag_group: begin
+ unsave; sgml_attrs(saved(-1)):=current_sgml_attrs;
+ decr(save_ptr); pop_nest;
+ end;
+lone_tag_group: begin
+ unsave; sgml_attrs(saved(-1)):=current_sgml_attrs;
+ decr(save_ptr); pop_nest;
+ end;
+@z
+%---------------------------------------
+@x [48] m.1191 l.22301 - Omega
+procedure math_left_right;
+var t:small_number; {|left_noad| or |right_noad|}
+@!p:pointer; {new noad}
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+ @<Try to recover from mismatched \.{\\right}@>
+else begin p:=new_noad; type(p):=t;
+ scan_delimiter(delimiter(p),false);
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+ tail_append(new_noad); type(tail):=inner_noad;
+ math_type(nucleus(tail)):=sub_mlist;
+ info(nucleus(tail)):=p;
+ end;
+ end;
+end;
+@y
+procedure math_left_right;
+var t:small_number; {|left_noad| or |right_noad|}
+@!p,q,r:pointer; {new noad}
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+ @<Try to recover from mismatched \.{\\right}@>
+else begin p:=new_noad;
+ if MML_mode then begin
+ scan_math(nucleus(p));
+ if t=left_noad then begin
+ saved(0):=p; incr(save_ptr);
+ push_math(math_left_group);
+ end
+ else begin
+ {unsave;}
+ @<DIR: |unsave| math@>;
+ decr(save_ptr);
+ q:=saved(0); r:=fin_mlist(null);
+ push_math(math_group);
+ tail_append(q); tail_append(r);
+ tail_append(p);
+ {unsave;}
+ @<DIR: |unsave| math@>;
+ p:=fin_mlist(null);
+ tail_append(p);
+ end
+ end
+ else begin
+ type(p):=t;
+ scan_delimiter(delimiter(p),false);
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p);
+ @<DIR: |unsave| math@>; {end of |math_left_group|}
+ tail_append(new_noad); type(tail):=inner_noad;
+ math_type(nucleus(tail)):=sub_mlist;
+ info(nucleus(tail)):=p;
+ end;
+ end;
+ end;
+end;
+@z
+%---------------------------------------
+@x [48] m.1192 l.22284 - Omega
+begin if cur_group=math_shift_group then
+ begin scan_delimiter(garbage,false);
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ error;
+ end
+else off_save;
+end
+@y
+begin if cur_group=math_shift_group then
+ begin if MML_mode then scan_math(garbage)
+ else scan_delimiter(garbage,0);
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ error;
+ end
+else off_save;
+end
+@z
+%---------------------------------------
+@x [48] m.1193 l.22327 - Omega
+mmode+math_shift: if cur_group=math_shift_group then after_math
+ else off_save;
+@y
+mmode+math_shift: if cur_group=math_mml_group then after_mml
+ else if cur_group=math_shift_group then after_math
+ else off_save;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22284 - Omega
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ @<DIR: |unsave| math@>;
+ decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+ danger:=false;
+ @<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+ m:=mode; p:=fin_mlist(null);
+ end
+else a:=null;
+if m<0 then @<Finish math in text@>
+else begin if a=null then @<Check that another \.\$ follows@>;
+ @<Finish displayed math@>;
+ end;
+end;
+@y
+procedure after_mml;
+var p:pointer;
+begin
+@<DIR: |unsave| math@>;
+decr(save_ptr);
+link(saved(0)):=link(head);
+p:=saved(0);
+pop_nest;
+tail_append(p);
+back_input;
+end;
+
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if MML_mode then decr(MML_level);
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ if MML_mode then begin
+ sgml_out_mlist(true,false,false)
+ end
+ else begin
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ end;
+ @<DIR: |unsave| math@>;
+ decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+ danger:=false;
+ @<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+ m:=mode; p:=fin_mlist(null);
+ end
+else a:=null;
+if m<0 then @<Finish math in text@>
+else begin if a=null then @<Check that another \.\$ follows@>;
+ @<Finish displayed math@>;
+ end;
+end;
+@z
+%---------------------------------------
+@x [49] m.1196 l.22388 - Omega
+@<Finish math in text@> =
+begin tail_append(new_math(math_surround,before));
+if dir_math_save then
+ @<Append a begin direction to the tail of the current list@>;
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+if dir_math_save then
+ @<Append an end direction to the tail of the current list@>;
+dir_math_save:=false;
+tail_append(new_math(math_surround,after));
+space_factor:=1000;
+@<DIR: |unsave| math@>;
+end
+@y
+@<Finish math in text@>=
+begin
+if not MML_mode then begin
+ tail_append(new_math(math_surround,before));
+ if dir_math_save then
+ @<Append a begin direction to the tail of the current list@>;
+ end;
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0);
+if MML_mode then begin
+{
+ if MML_level=0 then sgml_out_mlist(true,false,false)
+ else tail_append(cur_mlist);
+}
+ sgml_starttexttag("inlinemath");
+ sgml_starttexttag("math");
+ tail_append(cur_mlist);
+ sgml_endtexttag("math");
+ sgml_endtexttag("inlinemath");
+ end
+else begin
+ mlist_to_hlist;
+ link(tail):=link(temp_head);
+ while link(tail)<>null do tail:=link(tail);
+ if dir_math_save then
+ @<Append an end direction to the tail of the current list@>;
+ dir_math_save:=false;
+ tail_append(new_math(math_surround,after));
+ end;
+space_factor:=1000;
+@<DIR: |unsave| math@>;
+end
+@z
+%---------------------------------------
+@x [49] m.1197 l.22430 - Omega
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+mlist_to_hlist; p:=link(temp_head);@/
+adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b);
+t:=adjust_tail; adjust_tail:=null;@/
+w:=width(b); z:=display_width; s:=display_indent;
+if (a=null)or danger then
+ begin e:=0; q:=0;
+ end
+else begin e:=width(a); q:=e+math_quad(text_size);
+ end;
+if w+q>z then
+ @<Squeeze the equation as much as possible; if there is an equation
+ number that should go on a separate line by itself,
+ set~|e:=0|@>;
+@<Determine the displacement, |d|, of the left edge of the equation, with
+ respect to the line size |z|, assuming that |l=false|@>;
+@<Append the glue or equation number preceding the display@>;
+@<Append the display and perhaps also the equation number@>;
+@<Append the glue or equation number following the display@>;
+resume_after_display
+@y
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+if MML_mode then begin
+{
+ if MML_level=0 then sgml_out_mlist(true,false,false)
+ else tail_append(cur_mlist);
+}
+ sgml_starttexttag("displaymath");
+ sgml_starttexttag("math");
+ tail_append(cur_mlist);
+ sgml_endtexttag("math");
+ sgml_endtexttag("displaymath");
+ end
+else begin
+ mlist_to_hlist; p:=link(temp_head);@/
+ adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b);
+ t:=adjust_tail; adjust_tail:=null;@/
+ w:=width(b); z:=display_width; s:=display_indent;
+ if (a=null)or danger then
+ begin e:=0; q:=0;
+ end
+ else begin e:=width(a); q:=e+math_quad(text_size);
+ end;
+ if w+q>z then
+ @<Squeeze the equation as much as possible; if there is an equation
+ number that should go on a separate line by itself,
+ set~|e:=0|@>;
+ @<Determine the displacement, |d|, of the left edge of the equation, with
+ respect to the line size |z|, assuming that |l=false|@>;
+ @<Append the glue or equation number preceding the display@>;
+ @<Append the display and perhaps also the equation number@>;
+ @<Append the glue or equation number following the display@>;
+ end;
+resume_after_display
+@z
+%---------------------------------------
+@x [49] m.1257 l.23269 - Omega
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+@y
+@!flushable_string:str_number; {string not yet referenced}
+@!cur_font_sort_name:str_number; {the name without the digits at the end}
+@!new_length:integer; {length of font name, to become font sort name}
+@!last_character:integer; {last character in font name}
+@!i:integer; {to run through characters of name}
+@!this_is_a_new_font:boolean;
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+this_is_a_new_font:=false;
+@z
+%---------------------------------------
+@x [49] m.1257 l.23290 - Omega
+common_ending: set_equiv(u,f);
+set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t);
+@y
+this_is_a_new_font:=true;
+common_ending: set_equiv(u,f);
+set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t);
+if this_is_a_new_font then
+ begin
+ if cur_name>=@"10000 then begin
+ new_length:=length(cur_name);
+ last_character:=str_pool[str_start(cur_name)+new_length-1];
+ while (last_character>="0") and (last_character<="9") do begin
+ decr(new_length);
+ last_character:=str_pool[str_start(cur_name)+new_length-1];
+ end;
+ for i:=1 to new_length do begin
+ append_char(str_pool[str_start(cur_name)+i-1]);
+ end;
+ cur_font_sort_name:=make_string;
+ font_sort_number:=font_sort_ptr+1;
+ for font_sorts:=font_sort_base+1 to font_sort_ptr do
+ if str_eq_str(font_sort_name(font_sorts),cur_font_sort_name) then begin
+ font_sort_number:=font_sorts;
+ break;
+ end;
+ font_name_sort(f):=font_sort_number;
+ if font_sort_number=(font_sort_ptr+1) then begin
+ incr(font_sort_ptr);
+ allocate_font_sort_table
+ (font_sort_ptr,
+ font_sort_offset_char_base+3*(font_ec(f)-font_bc(f)+1));
+ font_sort_file_size(font_sort_ptr):=
+ font_sort_offset_char_base+3*(font_ec(f)-font_bc(f)+1);
+ font_sort_name(font_sort_ptr):=cur_font_sort_name;
+ font_sort_ec(font_sort_ptr):=font_ec(f);
+ font_sort_bc(font_sort_ptr):=font_bc(f);
+ cur_name:=cur_font_sort_name;
+ cur_ext:=".onm";
+ pack_cur_name;
+ begin_file_reading;
+ if a_open_in(cur_file,kpse_tex_format) then begin
+ name:=a_make_name_string(cur_file);
+ print_ln; print("("); print(name);
+ @<Read the first line of the new file@>;
+ end
+ else end_file_reading;
+ end;
+ end;
+ end;
+@z
+%---------------------------------------
+@x [50] m.1320 l.23983 - Omega
+@ @<Dump the font information@>=
+@y
+@ @<Dump the font information@>=
+dump_int(font_sort_ptr);
+for k:=null_font_sort to font_sort_ptr do
+ dump_font_sort_table(k,font_sort_file_size(k));
+@z
+%---------------------------------------
+@x [50] m.1321 l.23993 - Omega
+@ @<Undump the font information@>=
+@y
+@ @<Undump the font information@>=
+undump_size(font_base)(font_max)('font sort max')(font_sort_ptr);
+for k:=null_font_sort to font_sort_ptr do
+ undump_font_sort_table(k);
+@z
+%---------------------------------------
+@x [51] m.1333 l.24244 - Omega
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+@y
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal;
+if not MML_mode then begin @<Finish the \.{DVI} file@>; end;
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir/README b/Build/source/texk/web2c/omegadir/README
new file mode 100644
index 00000000000..c8b8d0d048f
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/README
@@ -0,0 +1,12 @@
+This directory contains part of the Omega distribution, other parts
+are found in ../otps, and several files in the parent directory. You
+will also need odvips, the sources of which might be present in
+../../odvips.
+
+Omega is very much experimental software, and may prove hard or
+impossible to build on your system. At present, you need to install
+bison (the GNU version of yacc) and lex or flex to build otp2ocp from
+scratch. If you do not have these programs, you can try to use the
+y_tab.c-dist, y_tab.h-dist, and lex.yy.c-dist files to complete the
+build.
+
diff --git a/Build/source/texk/web2c/omegadir/com-supp-w32.ch b/Build/source/texk/web2c/omegadir/com-supp-w32.ch
new file mode 100644
index 00000000000..162cf594ec6
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/com-supp-w32.ch
@@ -0,0 +1,26 @@
+@x
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@y
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@!halt_on_error_p:boolean; {allow only on error.}
+@z
+
+@x
+ ready_already:=0;
+@y
+ ready_already:=0;
+ texmf_finish_job;
+@z
+
+@x
+print_char("."); show_context;
+@y
+if not file_line_error_style_p then begin
+ print_char("."); show_context
+end;
+
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+
+@z
diff --git a/Build/source/texk/web2c/omegadir/com16bit.ch b/Build/source/texk/web2c/omegadir/com16bit.ch
new file mode 100644
index 00000000000..5f47b02eff1
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/com16bit.ch
@@ -0,0 +1,2749 @@
+% com16bit.ch: Omega version of file tex.ch
+%
+% tex.ch for C compilation with web2c, derived from various other change files.
+% By Tim Morgan, UC Irvine ICS Department, and many others.
+%
+% (05/28/86) ETM Started with TeX 2.0
+% (06/03/87) ETM Brought up to TeX 2.2
+% (09/26/87) ETM Brought up to TeX 2.3
+% (10/01/87) ETM Brought up to TeX 2.5
+% (12/21/87) ETM Brought up to TeX 2.7
+% (01/14/88) ETM Brought up to TeX 2.9
+% (02/20/88) PAM Revised format and module numbers
+% (03/01/88) ETM Eliminated some unused variables and unnecesary tests
+% (05/09/88) ETM Added yet another casting bug fix
+% (06/21/88) ETM Brought up to TeX version 2.93
+% (12/11/88) ETM Brought up to TeX version 2.94
+% (01/12/89) PAM Brought up to TeX version 2.95
+% (02/14/89) ETM Brought up to TeX version 2.96
+% (03/10/89) ETM Brought up to TeX version 2.98
+% (07/06/89) ETM Brought up to TeX version 2.991
+% (11/30/89) KB To version 2.992 (8-bit).
+% (01/10/90) SR To version 2.993.
+% (03/27/90) KY To version 3.0.
+% (more recent changes in ChangeLog)
+%
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+%
+% The module numbers in this change file refer to TEX.WEB 3.141592 as
+% of March, 1995 (published as Donald E. Knuth, TeX: The Program,
+% Volume B of Computers & Typesetting).
+
+@x [0.0] l.83 - WEAVE: print changes only.
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+@y 83
+ \def\?##1]{\hbox{Changes to \hbox to 1em{\hfil##1}.\ }}
+ }
+\let\maybe=\iffalse
+@z
+
+@x
+@d banner=='This is Omega, Version 3.141592-1.23.2.3' {printed when \TeX\ starts}
+@y
+@d banner=='This is Omega, Version 3.141592-1.23.2.3' {printed when \TeX\ starts}
+@d banner_k=='This is Omegak, Version 3.141592-1.23.2.3' {printed when \TeX\ starts}
+@z
+
+@x [1.4] l.233 - program header
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \TeX\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+@y
+@z
+
+@x [1.4] l.243 - labels in outer block not needed
+program OMEGA; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+@y
+program OMEGA; {all file names are defined dynamically}
+@z
+
+@x [1.6] l.267 - labels in outer block not needed
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d end_of_TEX=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
+ {key control points}
+@y
+@ For Web2c, labels are not declared in the main program, but
+we still have to declare the symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d final_end=9999 {this label marks the ending of the program}
+@z
+
+% Here we change these WEB symbols, which are used much as #ifdef's
+% are in C, into something which will get translated into actual #ifdef's.
+@x [1.7] l.292 - debug..gubed, stat..tats
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==ifdef('TEXMF_DEBUG')
+@d gubed==endif('TEXMF_DEBUG')
+@z
+@x [1.7] l.297 - debug..gubed, stat..tats
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@y
+@d stat==ifdef('STAT')
+@d tats==endif('STAT')
+@z
+
+@x [1.8] l.312 - Same, for `init...tini'.
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y 312
+@d init==ifdef('INITEX')
+@d tini==endif('INITEX')
+@z
+
+@x [1.8] l.319 - init...tini is dynamic
+@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
+@y 318
+@!init
+if ini_version then
+ begin @<Initialize table entries (done by \.{INITEX} only)@>@;
+ end;
+@+tini
+@z
+
+@x [1.11] l.375 - Compile-time constants: most removed for dynamic allocation.
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@y
+@d file_name_size == maxint
+@d ssup_error_line = 255
+@d ssup_max_strings ==200000
+{Larger values may be used, but then the arrays consume much more memory.}
+@d ssup_trie_opcode == 65535
+@d ssup_trie_size == @"3FFFFF
+
+@d ssup_hyph_size == 65535 {Changing this requires changing (un)dumping!}
+@d iinf_hyphen_size == 610 {Must be not less than |hyph_prime|!}
+
+@<Constants...@>=
+@!mem_bot=0; {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+ {Use |mem_bot=0| for compilers which cannot decrement pointers.}
+@z
+
+@x
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TeXformats:OMEGA.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@y
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@!hash_offset=514; {smallest index in hash array, i.e., |hash_base| }
+ {Use |hash_offset=0| for compilers which cannot decrement pointers.}
+@!trie_op_size=15011; {space for ``opcodes'' in the hyphenation patterns;
+ best if relatively prime to 313, 361, and 1009.}
+@!neg_trie_op_size=-15011; {for lower |trie_op_hash| array bound;
+ must be equal to |-trie_op_size|.}
+@!min_trie_op=0; {first possible trie op code for any language}
+@!max_trie_op=ssup_trie_opcode; {largest possible trie opcode for any language}
+@!pool_name=TEXMF_POOL_NAME; {this is configurable, for the sake of ML-\TeX}
+ {string of length |file_name_size|; tells where the string pool appears}
+@!engine_name=TEXMF_ENGINE_NAME; {the name of this engine}
+@#
+@!inf_main_memory = 2000000;
+@!sup_main_memory = 16000000;
+
+@!inf_trie_size = 80000;
+@!sup_trie_size = ssup_trie_size;
+
+@!inf_max_strings = 100000;
+@!sup_max_strings = ssup_max_strings;
+
+@!inf_strings_free = 100;
+@!sup_strings_free = sup_max_strings;
+
+@!inf_buf_size = 500;
+@!sup_buf_size = 200000;
+
+@!inf_nest_size = 40;
+@!sup_nest_size = 400;
+
+@!inf_max_in_open = 6;
+@!sup_max_in_open = 127;
+
+@!inf_param_size = 60;
+@!sup_param_size = 600;
+
+@!inf_save_size = 600;
+@!sup_save_size = 40000;
+
+@!inf_stack_size = 200;
+@!sup_stack_size = 3000;
+
+@!inf_dvi_buf_size = 800;
+@!sup_dvi_buf_size = 65536;
+
+@!inf_pool_size = 32000;
+@!sup_pool_size = 10000000;
+@!inf_pool_free = 1000;
+@!sup_pool_free = sup_pool_size;
+@!inf_string_vacancies = 8000;
+@!sup_string_vacancies = sup_pool_size - 23000;
+
+@!sup_hyph_size = ssup_hyph_size;
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@z
+
+@x [1.12] l.427 - Constants that are WEB numeric macros.
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions;
+ if you change this, you should also change |iinf_hyphen_size|.}
+@z
+
+@x [1.16] l.498 - Use C macros for `incr' and `decr'.
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@y
+@z
+
+% The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x [2.19] l.565 - data type text_char is 8-bit ASCII_code
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+% [3.26] name_of_file is no longer an array. And change the destination
+% type to text_char, which fixes:
+%
+% Date: 19 Sep 1994 10:38:24 +0200
+% From: thorinn@diku.dk (Lars Mathiesen)
+% When echoed to the screen and in the log, character codes
+% above '177 in file names are shown wrongly (typically as ^@).
+%
+@x [3.26] l.789 - name_of_file is no longer an array
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@y
+@!name_of_file:^char;
+@z
+
+@x [3.27] l.794 - Do file opening in C.
+@ The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `{\bf packed array
+$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\TeX\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\TeX's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@ All of the file opening functions are defined in C.
+@z
+
+@x [3.28] l.850 - Do file closing in C.
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+These procedures should not generate error messages if a file is
+being closed before it has been successfully opened.
+
+@p procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var f:word_file); {close a word file}
+begin close(f);
+end;
+@y
+@ And all the file closing routines as well.
+@z
+
+@x [3.30] l.888 - Array size of input buffer is determined at runtime.
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@y
+@!buffer:^ASCII_code; {lines of characters being read}
+@z
+
+@x [3.31] l.933 - Do `input_ln' in C.
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=f^; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+We define |input_ln| in C, for efficiency.
+@z
+
+% [3.32] `term_in' and `term_out' are standard input and output.
+% Declare the variables that used to be constants.
+@x [3.32] l.961 - `term_in' and `term_out' are standard input and output.
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+@y
+@d term_in==stdin {the terminal as an input file}
+@d term_out==stdout {the terminal as an output file}
+
+@<Glob...@>=
+@!init
+@!ini_version:boolean; {are we \.{INITEX}?}
+@!dump_option:boolean; {was the dump name option used?}
+@!dump_line:boolean; {was a \.{\%\AM format} line seen?}
+tini@/
+@#
+@!bound_default:integer; {temporary for setup}
+@!bound_name:^char; {temporary for setup}
+@#
+@!main_memory:integer; {total memory words allocated in initex}
+@!extra_mem_bot:integer; {|mem_min:=mem_bot-extra_mem_bot| except in \.{INITEX}}
+@!mem_min:integer; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!mem_top:integer; {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|,
+ equal to |mem_max| in \.{INITEX}, else not greater than |mem_max|}
+@!extra_mem_top:integer; {|mem_max:=mem_top+extra_mem_top| except in \.{INITEX}}
+@!mem_max:integer; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!error_line:integer; {width of context lines on terminal error messages}
+@!half_error_line:integer; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@!max_strings:integer; {maximum number of strings; must not exceed |max_halfword|}
+@!strings_free:integer; {strings available after format loaded}
+@!string_vacancies:integer; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size:integer; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!pool_free:integer;{pool space free after format loaded}
+@!hyph_size:integer; {maximun number of hyphen exceptions}
+@!trie_size:integer; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX. 50000 is
+ needed for English, German, and Portuguese.}
+@!buf_size:integer; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!stack_size:integer; {maximum number of simultaneous input sources}
+@!max_in_open:integer; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!param_size:integer; {maximum number of simultaneous macro parameters}
+@!nest_size:integer; {maximum number of semantic levels simultaneously active}
+@!save_size:integer; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@!quoted_filename:boolean; {current filename is quoted}
+@z
+
+@x [3.33] l.964 - We don't need to open terminal files.
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+@y
+@ Here is how to open the terminal files. |t_open_out| does nothing.
+|t_open_in|, on the other hand, does the work of ``rescanning,'' or getting
+any command line arguments the user has provided. It's defined in C.
+
+@d t_open_out == {output already open for text output}
+@z
+
+@x [3.34] l.982 - Flushing output to terminal files.
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@y
+these operations can be specified with {\mc UNIX}. |update_terminal|
+does an |fflush|. |clear_terminal| is redefined
+to do nothing, since the user should control the terminal.
+@^system dependencies@>
+
+@d update_terminal == fflush (term_out)
+@d clear_terminal == do_nothing
+@z
+
+@x [3.35] l.1017 - Do `input_ln' in C => section not needed.
+@<Report overflow of the input buffer, and abort@>=
+if format_ident=0 then
+ begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+ end
+else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+@y
+Routine is implemented in C, module is not needed.
+@z
+
+@x [3.37] l.1055 - |init_terminal|, reading the command line.
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+@y
+@ The following program does the required initialization.
+Iff anything has been specified on the command line, then |t_open_in|
+will return with |last > first|.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+if last > first then
+ begin loc := first;
+ while (loc < last) and (buffer[loc]=' ') do incr(loc);
+ if loc < last then
+ begin init_terminal := true; goto exit;
+ end;
+ end;
+@z
+
+@x [3.37] l.1068 - |init_terminal|, output missing newline.
+ write(term_out,'! End of file on the terminal... why?');
+@y
+ write_ln(term_out,'! End of file on the terminal... why?');
+@z
+
+@x [4.38] l.1126 - Array size for string pool is determined at runtime.
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@y
+@!pool_pointer = integer; {for variables that point into |str_pool|}
+@!str_number = 0..ssup_max_strings; {for variables that point into |str_start|}
+@z
+
+@x [4.39] l.1131 - Dynamically size pool arrays.
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start_ar : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@!str_pool: ^packed_ASCII_code; {the characters}
+@!str_start_ar : ^pool_pointer; {the starting pointers}
+@z
+
+@x [4.47] l.1237 - string recycling
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+@y
+@p @t\4@>@<Declare additional routines for string recycling@>@/
+
+@!init function get_strings_started:boolean; {initializes the string pool,
+@z
+
+% [4.51] Open the pool file using a path, and can't do string
+% assignments directly. (`strcpy' and `strlen' work here because
+% `pool_name' is a constant string, and thus ends in a null and doesn't
+% start with a space.)
+@x [4.51] l.1314 - Open the pool file.
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+@y
+name_length := strlen (pool_name);
+
+name_of_file := xmalloc_array (char, 1 + name_length);
+strcpy (name_of_file+1, pool_name); {copy the string}
+if a_open_in (pool_file, kpse_texpool_format) then
+@z
+
+@x [4.51] l.1322 - Make `OMEGA.POOL' lowercase, and change how it's read.
+else bad_pool('! I can''t read OMEGA.POOL.')
+@y
+else bad_pool('! I can''t read omega.pool; bad path?')
+@z
+@x [4.52] l.1326 - Make `OMEGA.POOL' lowercase, and change how it's read.
+begin if eof(pool_file) then bad_pool('! OMEGA.POOL has no check sum.');
+@.OMEGA.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+@y
+begin if eof(pool_file) then bad_pool('! omega.pool has no check sum.');
+@.OMEGA.POOL has no check sum@>
+read(pool_file,m); read(pool_file,n); {read two digits of string length}
+@z
+@x [4.52] l.1332 - Make `OMEGA.POOL' lowercase, and change how it's read.
+ bad_pool('! OMEGA.POOL line doesn''t begin with two digits.');
+@y
+ bad_pool('! omega.pool line doesn''t begin with two digits.');
+@z
+@x [4.53] l.1354 - Make `OMEGA.POOL' lowercase, and change how it's read.
+ bad_pool('! OMEGA.POOL check sum doesn''t have nine digits.');
+@y
+ bad_pool('! omega.pool check sum doesn''t have nine digits.');
+@z
+@x [4.53] l.1360 - Make `OMEGA.POOL' lowercase, and change how it's read.
+done: if a<>@$ then bad_pool('! OMEGA.POOL doesn''t match; OTANGLE me again.');
+@y
+done: if a<>@$ then
+ bad_pool('! omega.pool doesn''t match; otangle me again (or fix the path).');
+@z
+
+@x [5.54] l.1422 - error_line
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+@y
+@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for
+@z
+
+@x [5.61] l.1556 - Print rest of banner, eliminate misleading `(no format preloaded)'.
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+@y
+wterm(banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+@z
+
+@x [6.73] l.1732 - Add unspecified_mode.
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@y
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d unspecified_mode=4 {extra value for command-line switch}
+@z
+
+@x [6.73] l.1738 - Add interaction_option.
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@y
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@!interaction_option:batch_mode..unspecified_mode; {set from command line}
+@z
+
+@x [6.74] l.1740 - Allow override by command line switch.
+@ @<Set init...@>=interaction:=error_stop_mode;
+@y
+@ @<Set init...@>=if interaction_option=unspecified_mode then
+ interaction:=error_stop_mode
+else
+ interaction:=interaction_option;
+@z
+
+% [6.81] Eliminate nonlocal goto, since C doesn't have them.
+% Plus, it's nicer just to do an exit with the appropriate status code
+% under Unix. We call it `uexit' because there's a WEB symbol called
+% `exit' already. We use a C macro to change `uexit' back to `exit'.
+@x [6.81] l.1852 - Eliminate nonlocal goto, since C doesn't have them.
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+@y
+@d do_final_end==begin
+ update_terminal;
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+ uexit(1)
+ else
+ uexit(0);
+ end
+
+@<Error hand...@>=
+procedure jump_out;
+begin
+close_files_and_terminate;
+do_final_end;
+end;
+@z
+
+@x [6.84] l.1888 - Implement the switch-to-editor option.
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@y
+line ready to be edited.
+We do this by calling the external procedure |call_edit| with a pointer to
+the filename, its length, and the line number.
+However, here we just set up the variables that will be used as arguments,
+since we don't want to do the switch-to-editor until after TeX has closed
+its files.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@d edit_file==input_stack[base_ptr]
+@z
+
+@x [6.84] l.1903 - Implement the switch-to-editor option.
+"E": if base_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ slow_print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+@y
+"E": if base_ptr>0 then
+ begin edit_name_start:=str_start(edit_file.name_field);
+ edit_name_length:=str_start(edit_file.name_field+1) -
+ str_start(edit_file.name_field);
+ edit_line:=line;
+ jump_out;
+@z
+
+% [7.104] `remainder' is a library routine on some systems, so change
+% its name to avoid conflicts.
+@x [7.104] l.2227 - avoid name conflicts with lib routine remainder()
+|remainder|, holds the remainder after a division.
+
+@<Glob...@>=
+@y
+|remainder|, holds the remainder after a division.
+
+@d remainder==tex_remainder
+
+@<Glob...@>=
+@z
+
+@x [7.109] l.2352 - Define glue_ratio in C.
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+@y
+@z
+
+@x [8.112] l.2435 - Efficiency.
+macros are simplified in the obvious way when |min_quarterword=0|.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+macros are simplified in the obvious way when |min_quarterword=0|.
+So they have been simplified here in the obvious way.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item from a quarterword}
+@d hi(#)==# {to put a sixteen-bit item into a halfword}
+@d ho(#)==# {to take a sixteen-bit item from a halfword}
+@z
+
+% [8.113] We've put the memory structure into the include file
+% `texmf.h', since it's too hard to translate automatically.
+@x [8.113] l.2453 - data structures for main memory
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case four_choices of
+ 1: (@!int:integer);
+ 2: (@!gr:glue_ratio);
+ 3: (@!hh:two_halves);
+ 4: (@!qqqq:four_quarters);
+ end;
+@y
+@!quarterword = min_quarterword..max_quarterword;
+@!halfword = min_halfword..max_halfword;
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@=#include "texmfmem.h";@>
+@=#include "omegamem.h";@>
+@z
+
+% [9.116] Change `mem' to `zmem', so we can define mem to be a register
+% pointer to the memory array for speed.
+@x [9.116] l.2545 - definition of main memory array
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@y
+@!yzmem : ^memory_word; {the big dynamic storage area}
+@!zmem : ^memory_word; {the big dynamic storage area}
+@z
+
+% [9.127] Fix casting problem in C.
+% There are several of these. They come from the rules C uses for
+% comparing signed and unsigned quantities. Just doing the comparison
+% can result in incorrect evaluation wrt the way Pascal would do it.
+@x [9.127] l.2739 - Fix casting problem in C.
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+@y 2738
+if r>intcast(p+1) then @<Allocate from the top of node |p| and |goto found|@>;
+@z
+
+% [11.165] Fix the word `free' so that it doesn't conflict with the
+% standard C library routine of the same name.
+@x [11.165] l.3364 - avoid conflict with lib function free()
+are debugging.)
+@y
+are debugging.)
+
+@d free==free_arr
+@z
+
+@x [11.165] l.3367 - dummy |free| and |was_free| arrays
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [mem_min..mem_max] of boolean;
+@y
+ {The debug memory arrays have not been mallocated yet.}
+@!debug @!free: packed array [0..9] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [0..9] of boolean;
+@z
+
+@x [12.174] l.3526 - Eliminate unsigned comparisons to zero.
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+@y
+ begin @<Print the font identifier for |font(p)|@>;
+@z
+
+@x [12.176] l.3563 - Eliminate unsigned comparisons to zero.
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+@y
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin @<Print the font identifier for |font(p)|@>;
+@z
+
+@x [12.186] l.3747 - Don't worry about strange floating point values.
+ if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
+ else if abs(g)>float_constant(20000) then
+@y 3747
+ { The Unix |pc| folks removed this restriction with a remark that
+ invalid bit patterns were vanishingly improbable, so we follow
+ their example without really understanding it.
+ |if abs(mem[p+glue_offset].int)<@'4000000 then print('?.?')|
+ |else| }
+ if fabs(g)>float_constant(20000) then
+@z
+
+
+@x [16.213] l.4321 - texarray
+@!nest:array[0..nest_size] of list_state_record;
+@y
+@!nest:^list_state_record;
+@z
+
+@x [16.215] l.4344 - remove mem[] reference from initialize.
+@<Start a new current page@>;
+@y
+@/{The following piece of code is a copy of module 991:}
+page_contents:=empty; page_tail:=page_head; {|link(page_head):=null;|}@/
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+page_depth:=0; page_max_depth:=0;
+@z
+
+@x [17.241] l.5219 - Do `fix_date_and_time' in C.
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+It calls a macro-defined |date_and_time| routine. |date_and_time|
+in turn is a C macro, which calls |get_date_and_time|, passing
+it the addresses of the day, month, etc., so they can be set by the
+routine. |get_date_and_time| also sets up interrupt catching if that
+is conditionally compiled in the C code.
+@^system dependencies@>
+
+@d fix_date_and_time==o_date_and_time(int_base+time_code,
+ int_base+day_code,
+ int_base+month_code,
+ int_base+year_code)
+@z
+
+@x [18.262] l.5584 - Remove more unsigned comparisons to zero.
+else if (newtext(p)<0)or(newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@y
+else if (newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@z
+
+@x [19.271] l.5872 - texarray
+@!save_stack : array[0..save_size] of memory_word;
+@y
+@!save_stack : ^memory_word;
+@z
+
+@x [22.301] l.6432 - texarray
+@!input_stack : array[0..stack_size] of in_state_record;
+@y
+@!input_stack : ^in_state_record;
+@z
+
+@x [22.304] l.6536 - texarray
+@!input_file : array[1..max_in_open] of alpha_file;
+@!input_file_mode : array[1..max_in_open] of halfword;
+@!input_file_translation : array[1..max_in_open] of halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+@!line_numbers : array[1..max_in_open] of integer;
+@!file_names : array[1..max_in_open] of integer;
+@y
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@!line_numbers : ^integer;
+@!file_names : ^integer;
+@z
+
+@x [22.308] l.6701 - texarray
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+@y
+@!param_stack: ^pointer;
+ {token list pointers for parameters}
+@z
+
+@x [23.328] l.7043 - keep top of source_filename_stack initialized
+incr(in_open); push_input; index:=in_open;
+@y
+incr(in_open); push_input; index:=in_open;
+source_filename_stack[index]:=0;full_source_filename_stack[index]:=0;
+@z
+
+@x [23.331] l.7071 - init source file name stacks
+begin input_ptr:=0; max_in_stack:=0;
+@y
+begin input_ptr:=0; max_in_stack:=0;
+source_filename_stack[0]:=0;full_source_filename_stack[0]:=0;
+@z
+
+@x [28.501] l.9747 - \eof18
+if_eof_code: begin scan_four_bit_int; b:=(read_open[cur_val]=closed);
+ end;
+@y
+if_eof_code: begin scan_four_bit_int_or_18;
+ if cur_val=18 then b:=not shell_enabled_p
+ else b:=(read_open[cur_val]=closed);
+ end;
+@z
+
+@x [29.513] l.9951 - Area and extension rules for filenames.
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@y
+@ The file names we shall deal with have the
+following structure: If the name contains `\./' or `\.:'
+(for Amiga only), the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the last
+`\..' to the end, otherwise the file extension is null.
+@z
+
+@x [29.513] l.9963 - Area and extension rules for filenames.
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+@y
+@!area_delimiter:pool_pointer; {the most recent `\./', if any}
+@!ext_delimiter:pool_pointer; {the most recent `\..', if any}
+@z
+
+@x [29.514] l.9973 - TeX area directories.
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+In C, the default paths are specified separately.
+@z
+
+@x [29.515] l.9995 - filenames: quoted
+begin area_delimiter:=0; ext_delimiter:=0;
+@y
+begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false;
+@z
+
+@x [29.516] l.9992 - filenames: more_name
+begin if c=" " then more_name:=false
+@y
+begin if (c=" ") and stop_at_space and (not quoted_filename) then
+ more_name:=false
+else if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+ end
+@z
+
+@x [29.516] l.9994 - filenames: more_name
+ if (c=">")or(c=":") then
+@y
+ if IS_DIR_SEP(c) then
+@z
+
+@x [29.516] l.9997 - filenames: more_name
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
+@y
+ else if c="." then ext_delimiter:=cur_length;
+@z
+
+@x [29.517] l.10002 - end_name: string recycling
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+@y
+@ The third.
+@^system dependencies@>
+If a string is already in the string pool, the function
+|slow_make_string| does not create a new string but returns this string
+number, thus saving string space. Because of this new property of the
+returned string number it is not possible to apply |flush_string| to
+these strings.
+
+@p procedure end_name;
+var temp_str: str_number; {result of file name cache lookups}
+@!j,@!s,@!t: pool_pointer; {running indices}
+@!must_quote:boolean; {whether we need to quote a string}
+@z
+
+@x [29.517] l.10022 - end_name: spaces in filenames
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+@y
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+str_room(6); {Room for quotes, if needed.}
+{add quotes if needed}
+if area_delimiter<>0 then begin
+ {maybe quote |cur_area|}
+ must_quote:=false;
+ s:=str_start(str_ptr);
+ t:=str_start(str_ptr)+area_delimiter;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+ if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+ area_delimiter:=area_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+ end;
+{maybe quote |cur_name|}
+s:=str_start(str_ptr)+area_delimiter;
+if ext_delimiter=0 then t:=pool_ptr else t:=str_start(str_ptr)+ext_delimiter-1;
+must_quote:=false;
+j:=s;
+while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+if ext_delimiter<>0 then begin
+ {maybe quote |cur_ext|}
+ s:=str_start(str_ptr)+ext_delimiter-1;
+ t:=pool_ptr;
+ must_quote:=false;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+ if must_quote then begin
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ pool_ptr:=pool_ptr+2;
+ end;
+ end;
+@z
+
+@x [29.517] l.10011 - end_name: string recycling
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+@y
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ temp_str:=search_string(cur_area);
+ if temp_str>0 then
+ begin cur_area:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start(str_ptr+1) to pool_ptr-1 do
+ begin str_pool[j-area_delimiter]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-area_delimiter; {update |pool_ptr|}
+ end;
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=slow_make_string;
+@z
+
+@x [29.517] l.10016 - end_name: string recycling
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+@y
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+ decr(str_ptr); {undo extension string to look at name part}
+ temp_str:=search_string(cur_name);
+ if temp_str>0 then
+ begin cur_name:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start(str_ptr+1) to pool_ptr-1 do
+ begin str_pool[j-ext_delimiter+area_delimiter+1]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-ext_delimiter+area_delimiter+1; {update |pool_ptr|}
+ end;
+ cur_ext:=slow_make_string; {remake extension string}
+@z
+
+@x [29.518] l.10042 - print_file_name: quote if spaces in names.
+begin slow_print(a); slow_print(n); slow_print(e);
+@y
+var must_quote: boolean; {whether to quote the filename}
+@!j:pool_pointer; {index into |str_pool|}
+begin
+must_quote:=false;
+if a<>0 then begin
+ j:=str_start(a);
+ while (not must_quote) and (j<>str_start(a+1)) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if n<>0 then begin
+ j:=str_start(n);
+ while (not must_quote) and (j<>str_start(n+1)) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if e<>0 then begin
+ j:=str_start(e);
+ while (not must_quote) and (j<>str_start(e+1)) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+{FIXME: Alternative is to assume that any filename that has to be quoted has
+ at least one quoted component...if we pick this, a number of insertions
+ of |print_file_name| should go away.
+|must_quote|:=((|a|<>0)and(|str_pool|[|str_start|(|a|)]=""""))or
+ ((|n|<>0)and(|str_pool|[|str_start|(|n|)]=""""))or
+ ((|e|<>0)and(|str_pool|[|str_start|(|e|)]=""""));}
+if must_quote then print_char("""");
+if a<>0 then
+ for j:=str_start(a) to str_start(a+1)-1 do
+ if so(str_pool[j])<>"""" then
+ print_char(so(str_pool[j]));
+if n<>0 then
+ for j:=str_start(n) to str_start(n+1)-1 do
+ if so(str_pool[j])<>"""" then
+ print_char(so(str_pool[j]));
+if e<>0 then
+ for j:=str_start(e) to str_start(e+1)-1 do
+ if so(str_pool[j])<>"""" then
+ print_char(so(str_pool[j]));
+if must_quote then print_char("""");
+@z
+
+@x [29.519] l.10051 - have append_to_name skip quotes.
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+% [29.519] In pack_file_name, leave room for the extra null we append at
+% the end of a filename.
+@x [29.519] l.10047 - pack_file_name, leave room for the extra null
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file:= xmalloc_array(char, 1 + length(a) + length(n) + length(e));
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+@z
+
+@x [29.519] l.10051 - pack_file_name, append the extra null
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.520] l.10060 - filenames: default format.
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+@y
+Under {\mc UNIX} we don't give the area part, instead depending
+on the path searching that will happen during file opening. Also, the
+length will be set in the main program.
+
+@d format_area_length=0 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+@z
+
+@x [29.521] l.10066 - filenames: default format, where `plain.fmt' is.
+@!TEX_format_default:packed array[1..format_default_length] of char;
+
+@ @<Set init...@>=
+TEX_format_default:='TeXformats:plain.fmt';
+@y
+@!format_default_length: integer;
+@!TEX_format_default: ^char;
+
+@ We set the name of the default format file and the length of that name
+in C, instead of Pascal, since we want them to depend on the name of the
+program.
+@z
+
+@x [29.523] l.10095 - Change to pack_buffered_name as with pack_file_name.
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file := xmalloc_array (char, 1 + n + (b - a + 1) + format_ext_length);
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@z
+
+@x [29.523] l.10100 - Change to pack_buffered_name as with pack_file_name.
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.524] l.10118 - Format file opening: only try once, with path searching.
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(fmt_file) then goto found;
+ pack_buffered_name(format_area_length,loc,j-1);
+ {now try the system format file area}
+ if w_open_in(fmt_file) then goto found;
+@y
+ pack_buffered_name(0,loc,j-1); {Kpathsea does everything}
+ if w_open_in(fmt_file) then goto found;
+@z
+
+@x [29.524] l.10124 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
+@y
+ wterm ('Sorry, I can''t find the format `');
+ fputs (name_of_file + 1, stdout);
+ wterm ('''; will try `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''.');
+@z
+
+@x [29.524] l.10132 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('I can''t find the PLAIN format file!');
+@.I can't find PLAIN...@>
+@y
+ wterm ('I can''t find the format file `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''!');
+@.I can't find the format...@>
+@z
+
+@x [29.525] l.10163 - make_name_string
+ make_name_string:=make_string;
+ end;
+@y
+ make_name_string:=make_string;
+ end;
+ {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to
+ match the contents of |name_of_file|.}
+ k:=1;
+ name_in_progress:=true;
+ begin_name;
+ stop_at_space:=false;
+ while (k<=name_length)and(more_name(name_of_file[k])) do
+ incr(k);
+ stop_at_space:=true;
+ end_name;
+ name_in_progress:=false;
+@z
+
+@x [29.526] l.10194 - stop scanning file name if we're at end-of-line.
+ if not more_name(cur_chr) then goto done;
+@y
+ {If |cur_chr| is a space and we're not scanning a token list, check
+ whether we're at the end of the buffer. Otherwise we end up adding
+ spurious spaces to file names in some cases.}
+ if (cur_chr=" ") and (state<>token_list) and (loc>limit) then goto done;
+ if not more_name(cur_chr) then goto done;
+@z
+
+@x [29.530] l.10245 - prompt_file_name: prevent empty filenames.
+var k:0..buf_size; {index into |buffer|}
+@y
+var k:0..buf_size; {index into |buffer|}
+@!saved_cur_name:str_number; {to catch empty terminal input}
+@z
+
+@x [29.530] l.10252 - prompt_file_name: No default extension is TeX input file.
+if e=".tex" then show_context;
+@y
+if (e=".tex") or (e="") then show_context;
+@z
+
+@x [29.530] l.10258 - prompt_file_name: prevent empty filenames.
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+@y
+saved_cur_name:=cur_name;
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+if length(cur_name)=0 then cur_name:=saved_cur_name;
+@z
+
+@x [29.532] l.10263 - avoid conflict, `logname' in <unistd.h> on some systems.
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@y
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d log_name == texmf_log_name
+@z
+
+@x [29.534] l.10285 - Adjust for C string conventions.
+@!months:packed array [1..36] of char; {abbreviations of month names}
+@y
+@!months:^char;
+j:integer;
+@z
+
+@x [29.534] l. - Send the job_name to the file recorder.
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+@y
+begin old_setting:=selector;
+if job_name=0 then job_name:=get_job_name("texput");
+pack_job_name(".ofl");
+recorder_change_filename(stringcast(name_of_file+1));
+@z
+
+@x [29.536] l.10324 - Print rest of banner.
+begin wlog(banner);
+@y
+begin wlog(banner);
+wlog(version_string);
+@z
+
+@x [29.536] l.10327 - Adjust for C string conventions.
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@y
+months := ' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@z
+
+% [29.537] Use a path when calling a_open_in to do a \input; also, try
+% to open the file with and without the `.tex' extension, regardless of
+% whether the file already has an extension. This allows filenames like
+% `foo' and `foo.bar.tex', as well as `foo.tex' and `foo.bar'.
+@x [29.537] l.10338 - start_input
+begin scan_file_name; {set |cur_name| to desired file name}
+if cur_ext="" then cur_ext:=".tex";
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,TEX_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+@y
+var temp_str: str_number; k: integer;
+begin scan_file_name; {set |cur_name| to desired file name}
+pack_cur_name;
+loop@+begin
+ begin_file_reading; {set up |cur_file| and new level of input}
+ tex_input_type := 1; {Tell |open_input| we are \.{\\input}.}
+ {Kpathsea tries all the various ways to get the file.}
+ if open_in_name_ok(name_of_file+1)
+ and a_open_in(cur_file, kpse_tex_format) then
+ goto done;
+@z
+
+@x [29.537] l.10348 - start_input: don't force ".tex" extension.
+ prompt_file_name("input file name",".tex");
+@y
+ prompt_file_name("input file name","");
+@z
+
+@x [29.537] l.10350 - start_input: string recycling
+done: name:=a_make_name_string(cur_file);
+@y
+done: name:=a_make_name_string(cur_file);
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@z
+
+@x [29.537] l.10352 - start_input: use different heuristic for initex.
+ begin job_name:=cur_name; open_log_file;
+@y
+ begin job_name:=get_job_name(cur_name); open_log_file;
+@z
+
+@x [29.537] l.10359 - start_input: don't return filename to string pool.
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string; name:=cur_name;
+ end;
+@y
+@z
+
+@x [30.563] l.10943 - Don't use TEX_font_area.
+if aire="" then pack_file_name(nom,TEX_font_area,".ofm")
+else pack_file_name(nom,aire,".ofm");
+if not b_open_in(tfm_file) then abort;
+@y
+{|kpse_find_file| will append the |".ofm"| or |".tfm"|,
+ and avoid searching the disk before the font alias files as well.}
+pack_file_name(nom,aire,"");
+if not ofm_open_in(tfm_file) then abort;
+@z
+
+% [30.564] Reading the tfm file. As a special case, whenever we open a
+% tfm file, we read its first byte into `tfm_temp' right away. TeX
+% looks at `fbyte' before calling `fget', so it ends up seeing every
+% byte. This is Pascal-like I/O.
+@x [30.564] l.10956 - reading the tfm file, define fget & fbyte
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@y
+@d fget==tfm_temp:=getc(tfm_file)
+@d fbyte==tfm_temp
+@z
+
+% [32.575] We only want `eof' on the TFM file to be true if we
+% previously had EOF, not if we're at EOF now. This is like `feof', and
+% unlike our implementation of `eof' elsewhere.
+@x [32.575] l.11161 - Reading the tfm file, replace eof() by feof().
+if eof(tfm_file) then abort;
+@y
+if feof(tfm_file) then abort;
+@z
+
+@x [32.595] l.11860 - texarray
+@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:dvi_index; {half of |dvi_buf_size|}
+@!dvi_limit:dvi_index; {end of the current half buffer}
+@!dvi_ptr:dvi_index; {the next available buffer address}
+@y
+@!dvi_buf:^real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:integer; {half of |dvi_buf_size|}
+@!dvi_limit:integer; {end of the current half buffer}
+@!dvi_ptr:integer; {the next available buffer address}
+@z
+
+@x [32.597] l.11886 - write_dvi done in C.
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+In C, we use a macro to call |fwrite| or |write| directly, writing all
+the bytes in one shot. Much better even than writing four
+bytes at a time.
+@z
+
+@x [32.617] l.12261 - Use output_comment if the user set it. Assume it's short enough.
+ old_setting:=selector; selector:=new_string;
+@y
+if output_comment then
+ begin l:=strlen(output_comment); dvi_out(l);
+ for s:=0 to l-1 do dvi_out(output_comment[s]);
+ end
+else begin {the default code is unchanged}
+ old_setting:=selector; selector:=new_string;
+@z
+
+@x [32.617] l.12268 - Use output_comment if the user set it.
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+@y
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+end;
+@z
+
+% We output each portion of the page as we get to it, if we are using
+% IPC, so that the previewer (TeXView) can display it immediately. [SPM]
+@x [32.640] l.12690 - IPC
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+@y
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+ifdef ('IPC')
+if ipc_on>0 then
+ begin if dvi_limit=half_buf then
+ begin write_dvi(half_buf, dvi_buf_size-1);
+ flush_dvi;
+ dvi_gone:=dvi_gone+half_buf;
+ end;
+ if dvi_ptr>0 then
+ begin write_dvi(0, dvi_ptr-1);
+ flush_dvi;
+ dvi_offset:=dvi_offset+dvi_ptr; dvi_gone:=dvi_gone+dvi_ptr;
+ end;
+ dvi_ptr:=0; dvi_limit:=dvi_buf_size;
+ ipc_page(dvi_gone);
+ end;
+endif ('IPC');
+@z
+
+@x [32.642] l.12742 - Use dvi_offset instead of dvi_buf_size with IPC stuff.
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+@y
+ifdef ('IPC')
+ k:=7-((3+dvi_offset+dvi_ptr) mod 4); {the number of 223's}
+endif ('IPC')
+ifndef ('IPC')
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+endifn ('IPC')
+@z
+
+@x [32.642] l.12773 - use print_file_name
+ print_nl("Output written on "); slow_print(output_file_name);
+@y
+ print_nl("Output written on "); print_file_name(0, output_file_name, 0);
+@z
+
+@x [38.859] l.16855 - Fix a casting/expression evaluation problem.
+if abs(fit_class-fitness(r))>1 then d:=d+adj_demerits;
+@y
+if abs(intcast(fit_class)-intcast(fitness(r)))>1 then d:=d+adj_demerits;
+@z
+
+@x [39.875] l.17170 - Another casting problem.
+ begin line_diff:=line_number(r)-best_line;
+@y
+ begin line_diff:=intcast(line_number(r))-intcast(best_line);
+@z
+
+@x [42.920] l.18068 - bigtrie: allow larger hyphenation tries.
+@!trie_pointer=0..trie_size; {an index into |trie|}
+@y
+@!trie_pointer=0..ssup_trie_size; {an index into |trie|}
+@z
+
+@x [42.921] l.18075 - bigtrie: allow larger hyphenation tries.
+@!trie:array[trie_pointer] of two_halves; {|trie_link|, |trie_char|, |trie_op|}
+@y
+{We will dynamically allocate this arrays.}
+@!trie:^two_halves; {|trie_link|}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18126 m.925
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+@y 18126
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+This is a clever scheme which saves the need for a hash link array.
+However, it is difficult to increase the size of the hyphen exception
+arrays. To make this easier, the ordered hash has been replaced by
+a simple hash, using an additional array |hyph_link|. The value
+|0| in |hyph_link[k]| means that there are no more entries corresponding
+to the specific hash chain. When |hyph_link[k]>0|, the next entry in
+the hash chain is |hyph_link[k]-1|. This value is used because the
+arrays start at |0|.
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18134 m.925
+@!hyph_pointer=0..hyph_size; {an index into the ordered hash table}
+@y 18134
+@!hyph_pointer=0..ssup_hyph_size; {index into hyphen exceptions hash table;
+ enlarging this requires changing (un)dump code}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18137 m.926
+@!hyph_word:array[hyph_pointer] of str_number; {exception words}
+@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions}
+@!hyph_count:hyph_pointer; {the number of words in the exception dictionary}
+@y 18139
+@!hyph_word: ^str_number; {exception words}
+@!hyph_list: ^pointer; {list of hyphen positions}
+@!hyph_link: ^hyph_pointer; {link array for hyphen exceptions hash table}
+@!hyph_count:integer; {the number of words in the exception dictionary}
+@!hyph_next:integer; {next free slot in hyphen exceptions hash table}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18145 m.928
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null;
+ end;
+hyph_count:=0;
+@y 18148
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null; hyph_link[z]:=0;
+ end;
+hyph_count:=0;
+hyph_next:=hyph_prime+1; if hyph_next>hyph_size then hyph_next:=hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18163 m.930
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_size;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+not_found: decr(hn)
+@y 18170
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_prime;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ h:=hyph_link[h]; if h=0 then goto not_found;
+ decr(h);
+ end;
+not_found: decr(hn)
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18172 m.931
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)<hn then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start(k);
+ repeat if so(str_pool[u])<hc[j] then goto not_found;
+ if so(str_pool[u])>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@y 18184
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start(k);
+ repeat
+ if so(str_pool[u])<>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@z
+
+% The GNU C compiler complains of unused variables.
+@x
+@!s,@!t:str_number; {strings being compared or stored}
+@y
+@!s:str_number; {strings being compared or stored}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18274 m.939
+ begin h:=(h+h+hc[j]) mod hyph_size;
+@y 18274
+ begin h:=(h+h+hc[j]) mod hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18281 m.940
+@ @<Insert the \(p)pair |(s,p)|...@>=
+if hyph_count=hyph_size then overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+hyph_word[h]:=s; hyph_list[h]:=p
+@y 18290
+@ @<Insert the \(p)pair |(s,p)|...@>=
+ if hyph_next <= hyph_prime then
+ while (hyph_next>0) and (hyph_word[hyph_next-1]>0) do decr(hyph_next);
+if (hyph_count=hyph_size)or(hyph_next=0) then
+ overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if hyph_link[h]=0 then
+ begin
+ hyph_link[h]:=hyph_next;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime;
+ if hyph_next > hyph_prime then incr(hyph_next);
+ end;
+ h:=hyph_link[h]-1;
+ end;
+
+found: hyph_word[h]:=s; hyph_list[h]:=p
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18292 m.941
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+k:=hyph_word[h];
+if length(k)<length(s) then goto found;
+if length(k)>length(s) then goto not_found;
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+found:q:=hyph_list[h]; hyph_list[h]:=p; p:=q;@/
+t:=hyph_word[h]; hyph_word[h]:=s; s:=t;
+not_found:
+@y 18303
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h];
+if length(k)<>length(s) then goto not_found;
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+{repeat hyphenation exception; flushing old data}
+flush_string; s:=hyph_word[h]; {avoid |slow_make_string|!}
+decr(hyph_count);
+{ We could also |flush_list(hyph_list[h]);|, but it interferes
+ with \.{trip.log}. }
+goto found;
+not_found:
+@z
+
+@x [43.943] l.18346 - web2c can't parse negative lower bounds in arrays. Sorry.
+@!init@! trie_op_hash:array[-trie_op_size..trie_op_size] of 0..trie_op_size;
+@y
+@!init@! trie_op_hash:array[neg_trie_op_size..trie_op_size] of 0..trie_op_size;
+@z
+
+@x [43.944] l.18365 - web2c can't parse negative lower bounds in arrays. Sorry
+var h:-trie_op_size..trie_op_size; {trial hash location}
+@y
+var h:neg_trie_op_size..trie_op_size; {trial hash location}
+@z
+
+@x [43.944] l.18370 - Another casting problem, and use |neg_trie_op_size|.
+begin h:=abs(n+313*d+361*v+1009*cur_lang) mod (trie_op_size+trie_op_size)
+ - trie_op_size;
+@y
+begin h:=abs(intcast(n)+313*intcast(d)+361*intcast(v)+1009*intcast(cur_lang))
+ mod (trie_op_size - neg_trie_op_size)
+ + neg_trie_op_size;
+@z
+
+@x [43.947] l.18438 - Dynamically allocate arrays, and a casting problem.
+@!init @!trie_c:packed array[trie_pointer] of ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:packed array[trie_pointer] of quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:packed array[trie_pointer] of trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:packed array[trie_pointer] of trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:packed array[trie_pointer] of trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@y
+@!init @!trie_c:^ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:^quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:^trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:^trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:^trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@z
+
+@x [43.948] l.18471 - Another casting problem.
+begin h:=abs(trie_c[p]+1009*trie_o[p]+@|
+ 2718*trie_l[p]+3142*trie_r[p]) mod trie_size;
+@y
+begin h:=abs(intcast(trie_c[p])+1009*intcast(trie_o[p])+@|
+ 2718*intcast(trie_l[p])+3142*intcast(trie_r[p])) mod trie_size;
+@z
+
+@x [43.590] l.18524 - Dynamically allocate & larger tries.
+@!init@!trie_taken:packed array[1..trie_size] of boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:array[ASCII_code] of trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@y
+@!init@!trie_taken: ^boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:^trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@z
+
+@x [43.951] l.18539 - Dynamically allocate.
+trie_not_ready:=true; trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+trie_not_ready:=true;
+@z
+
+%%
+%% We can rewrite the original code after "main_loop_move+2" upto the
+%% "tail_append(lig_stack)" in module 1036 as
+%%
+%
+% main_loop_move+2:
+% if font_bc[main_f]<=cur_chr then
+% if cur_chr<=font_ec[main_f] then
+% begin main_i:=char_info(main_f)(cur_l);
+% if char_exists(main_i) goto main_loop_move+3;
+% end;
+% char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+% main_loop_move+3:
+% tail_append(lig_stack) {|main_loop_lookahead| is next}
+%
+
+@x [49.1252] l.23230 - INI = VIR, so have to do runtime test.
+hyph_data: if cur_chr=1 then
+ begin @!init new_patterns; goto done;@;@+tini@/
+@y 23215
+hyph_data: if cur_chr=1 then
+ begin @!init if ini_version then
+ begin new_patterns; goto done; end; @;@+tini@/
+@z
+
+@x
+@!flushable_string:str_number; {string not yet referenced}
+@y
+@z
+
+% undo Knuth's change because
+% a) the string is already replaced in |scan_file_name| and therefore
+% b) the wrong string will get flushed!!!
+%
+@x [49.1260] l.23331 new_font: string recycling -- already done
+flushable_string:=str_ptr-1;
+@y
+@z
+
+% If you don't want to remove code with the following change,
+% please replace the former change by
+%
+% @x
+% flushable_string:=str_ptr-1;
+% @y
+% if cur_name=str_ptr-1 then
+% flushable_string:=str_ptr-1
+% else
+% flushable_string:=str_ptr; {number of a non-existing}
+% @z
+%
+% otherwise the wrong string will get removed by |flush_string|!!
+%
+@x [49.1260] l.23334 new_font: string recycling -- already done
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name(f);
+ end;
+ if s>0 then
+@y
+ begin if s>0 then
+@z
+
+@x [49.1265] if batchmode, mktex... scripts should be silent.
+interaction:=cur_chr;
+@y
+interaction:=cur_chr;
+if interaction = batch_mode
+then kpse_make_tex_discard_errors := 1
+else kpse_make_tex_discard_errors := 0;
+@z
+
+@x [49.1275] l.23441 - Same stuff as for \input, this time for \openin.
+ if cur_ext="" then cur_ext:=".tex";
+ pack_cur_name;
+ if a_open_in(read_file[n]) then read_open[n]:=just_open;
+@y
+ pack_cur_name;
+ tex_input_type:=0; {Tell |open_input| we are \.{\\openin}.}
+ if open_in_name_ok(name_of_file+1)
+ and a_open_in(read_file[n], kpse_tex_format) then
+ read_open[n]:=just_open;
+@z
+
+@x [50.1301] l.23679 - INI = VIR, so runtime test.
+format_ident:=" (INIOMEGA)";
+@y
+if ini_version then format_ident:=" (INIOMEGA)";
+@z
+
+% The GNU C compiler complains of unused variables.
+@x [50.1302] l.23690 - Eliminate now-unused variable `w' in `store_fmt_file'.
+var j,@!k,@!l:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!w: four_quarters; {four ASCII codes}
+@y
+var @!k:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!format_engine: ^char;
+@z
+
+@x [50.1303] l.23722 - Ditto, for `load_fmt_file'.
+@!w: four_quarters; {four ASCII codes}
+@y
+@!format_engine: ^char;
+@z
+
+@x [50.1305] l.23751 - Do dumping and undumping of fmt files in C.
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+@y
+@z
+@x [1306]
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@y
+@z
+@x [still 1306] debug format file
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@y
+@d format_debug_end(#)==
+ write_ln (stderr, ' = ', #);
+ end;
+@d format_debug(#)==
+ if debug_format_file then begin
+ write (stderr, 'fmtdebug:', #);
+ format_debug_end
+@d undump_size_end_end(#)==
+ too_small(#)@+else format_debug (#)(x); undump_end_end
+@z
+
+@x [50,1307] l.23779 - texarray
+dump_int(@$);@/
+@y
+dump_int(@"57325458); {Web2C \TeX's magic constant: "W2TX"}
+{Align engine to 4 bytes with one or more trailing NUL}
+x:=strlen(engine_name);
+format_engine:=xmalloc_array(char,x+4);
+strcpy(format_engine, engine_name);
+for k:=x to x+3 do format_engine[k]:=0;
+x:=x+4-(x mod 4);
+dump_int(x);dump_things(format_engine[0], x);
+libc_free(format_engine);@/
+dump_int(@$);@/
+dump_int(max_halfword);@/
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23784 m.1307
+dump_int(hyph_size)
+@y 23784
+dump_int(hyph_prime)
+@z
+
+@x [50.1308] l.23793 - texarray
+x:=fmt_file^.int;
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+undump_int(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(x);
+if x<>mem_top then goto bad_fmt;
+@y
+@+init
+if ini_version then
+ begin libc_free(str_pool); libc_free(str_start_ar); libc_free(yzmem);
+ end;
+@+tini
+undump_int(x);
+format_debug('format magic number')(x);
+if x<>@"57325458 then goto bad_fmt; {not a format file}
+undump_int(x);
+format_debug('engine name size')(x);
+if (x<0) or (x>256) then goto bad_fmt; {corrupted format file}
+format_engine:=xmalloc_array(char, x);
+undump_things(format_engine[0], x);
+format_engine[x-1]:=0; {force string termination, just in case}
+if strcmp(engine_name, format_engine) then
+ begin wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' was written by ', format_engine);
+ libc_free(format_engine);
+ goto bad_fmt;
+end;
+libc_free(format_engine);
+undump_int(x);
+format_debug('string pool checksum')(x);
+if x<>@$ then begin {check that strings are the same}
+ wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' doesn''t match ', pool_name);
+ goto bad_fmt;
+end;
+undump_int(x);
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+
+undump_int(x); format_debug ('mem_bot')(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(mem_top); format_debug ('mem_top')(mem_top);
+if mem_bot+1100>mem_top then goto bad_fmt;
+
+
+head:=contrib_head; tail:=contrib_head;
+ page_tail:=page_head; {page initialization}
+
+mem_min := mem_bot - extra_mem_bot;
+mem_max := mem_top + extra_mem_top;
+
+yzmem:=xmalloc_array (memory_word, mem_max - mem_min + 1);
+zmem := yzmem - mem_min; {this pointer arithmetic fails with some compilers}
+mem := zmem;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23804 m.1308
+if x<>hyph_size then goto bad_fmt
+@y 23804
+if x<>hyph_prime then goto bad_fmt
+@z
+
+% [1309] Make dumping/undumping more efficient by doing whole arrays at
+% a time, via fread/fwrite in texmfmp.c.
+@x [50.1309] l.23814 - Make dumping/undumping more efficient.
+for k:=too_big_char to str_ptr do dump_int(str_start(k));
+k:=0;
+while k+4<pool_ptr do
+ begin dump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; dump_four_ASCII;
+@y
+dump_things(str_start(too_big_char), str_ptr-too_big_char+1);
+dump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1310] l.23829 - Make dumping/undumping more efficient.
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings)('max strings')(str_ptr);
+for k:=too_big_char to str_ptr do undump(0)(pool_ptr)(str_start(k));
+k:=0;
+while k+4<pool_ptr do
+ begin undump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; undump_four_ASCII;
+@y
+undump_size(0)(sup_pool_size-pool_free)('string pool size')(pool_ptr);
+if pool_size<pool_ptr+pool_free then
+ pool_size:=pool_ptr+pool_free;
+undump_size(0)(sup_max_strings-strings_free)('sup strings')(str_ptr);@/
+if max_strings<str_ptr+strings_free then
+ max_strings:=str_ptr+strings_free;
+str_start_ar:=xmalloc_array(pool_pointer, max_strings-biggest_char);
+undump_things(str_start(too_big_char), str_ptr-too_big_char+1);
+str_pool:=xmalloc_array(packed_ASCII_code, pool_size);
+undump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1311] l.23850 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do dump_wd(mem[k]);
+@y
+repeat dump_things(mem[p], q+2-p);
+@z
+
+@x [50.1311] l.23855 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do dump_wd(mem[k]);
+@y
+dump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1311] l.23858 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
+@y
+dump_things(mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+@x [50.1312] l.23873 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do undump_wd(mem[k]);
+@y
+repeat undump_things(mem[p], q+2-p);
+@z
+
+@x [50.1312] l.23878 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do undump_wd(mem[k]);
+@y
+undump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1312] l.23888 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
+@y
+undump_things (mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24058 m.1324
+dump_int(hyph_count);
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k); dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@y 24061
+dump_int(hyph_count);
+if hyph_next <= hyph_prime then hyph_next:=hyph_size;
+dump_int(hyph_next);{minumum value of |hyphen_size| needed}
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k+65536*hyph_link[k]);
+ {assumes number of hyphen exceptions does not exceed 65535}
+ dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@z
+
+@x [50.1324] l.24066 - Make dumping/undumping more efficient - trie
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(max_hyph_char);
+dump_int(trie_op_ptr);
+for k:=1 to trie_op_ptr do
+ begin dump_int(hyf_distance[k]);
+ dump_int(hyf_num[k]);
+ dump_int(hyf_next[k]);
+ end;
+@y
+dump_things(trie[0],trie_max+1);
+dump_int(max_hyph_char);
+dump_int(trie_op_ptr);
+dump_things(hyf_distance[1], trie_op_ptr);
+dump_things(hyf_num[1], trie_op_ptr);
+dump_things(hyf_next[1], trie_op_ptr);
+@z
+
+@x [50.1325] l.24086 - Make dumping/undumping more efficient - trie
+@<Undump the hyphenation tables@>=
+@y
+{This is only used for the hyphenation tries below, and the size is
+ always |j+1|.}
+@d xmalloc_and_undump(#) ==
+ if not # then #:=xmalloc_array(two_halves, j+1);
+ undump_things(#[0], j+1);
+
+@<Undump the hyphenation tables@>=
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24087 m.1325
+undump(0)(hyph_size)(hyph_count);
+for k:=1 to hyph_count do
+ begin undump(0)(hyph_size)(j);
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+@y 24092
+undump_size(0)(hyph_size)('hyph_size')(hyph_count);
+undump_size(hyph_prime)(hyph_size)('hyph_size')(hyph_next);
+j:=0;
+for k:=1 to hyph_count do
+ begin undump_int(j); if j<0 then goto bad_fmt;
+ if j>65535 then
+ begin hyph_next:= j div 65536; j:=j - hyph_next * 65536; end
+ else hyph_next:=0;
+ if (j>=hyph_size)or(hyph_next>hyph_size) then goto bad_fmt;
+ hyph_link[j]:=hyph_next;
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+ {|j| is now the largest occupied location in |hyph_word|}
+ incr(j);
+ if j<hyph_prime then j:=hyph_prime;
+ hyph_next:=j;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime else
+ if hyph_next >= hyph_prime then incr(hyph_next);
+@z
+
+
+@x [50.1325] l.24094 - Make dumping/undumping more efficient - trie
+for k:=0 to j do undump_hh(trie[k]);
+undump_int(max_hyph_char);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+for k:=1 to j do
+ begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
+ undump(0)(63)(hyf_num[k]);
+ undump(min_quarterword)(max_quarterword)(hyf_next[k]);
+ end;
+@y
+{The first array has not been allocated yet unless we're \.{INITEX};
+ we do that precisely so we don't allocate more space than necessary.}
+xmalloc_and_undump(trie);
+undump_int(max_hyph_char);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+{I'm not sure we have such a strict limitation (64) on these values, so
+ let's leave them unchecked.}
+undump_things(hyf_distance[1], j);
+undump_things(hyf_num[1], j);
+undump_upper_check_things(max_quarterword, hyf_next[1], j);
+@z
+
+@x [50.1327] l.24117 - Allow command line to override dumped value.
+undump(batch_mode)(error_stop_mode)(interaction);
+@y
+undump(batch_mode)(error_stop_mode)(interaction);
+if interaction_option<>unspecified_mode then interaction:=interaction_option;
+@z
+
+% [50.1327] As with TFM files, `eof' here means `have we previously
+% encountered the end-of-file', not `are we at the end of the file'.
+@x [50.1327] l.24120 - dumping/undumping, replace eof() by feof()
+if (x<>69069)or eof(fmt_file) then goto bad_fmt
+@y
+if (x<>69069)or feof(fmt_file) then goto bad_fmt
+@z
+
+@x [50.1328] l.24124 - Eliminate probably wrong word `preloaded' from format_idents.
+print(" (preloaded format="); print(job_name); print_char(" ");
+@y
+print(" (format="); print(job_name); print_char(" ");
+@z
+
+@x [51.1332] l.24203 - make the main program a procedure, for eqtb hack.
+@p begin @!{|start_here|}
+@y
+@d const_chk(#)==begin if # < inf@&# then # := inf@&# else
+ if # > sup@&# then # := sup@&# end
+
+{|setup_bound_var| stuff duplicated in \.{mf.ch}.}
+@d setup_bound_var(#)==bound_default:=#; setup_bound_var_end
+@d setup_bound_var_end(#)==bound_name:=#; setup_bound_var_end_end
+@d setup_bound_var_end_end(#)==
+ setup_bound_variable(address_of(#), bound_name, bound_default);
+
+@p procedure main_body;
+begin @!{|start_here|}
+
+{Always start the file recorder?}
+ {recorder_enabled:=true;}
+
+{Bounds that may be set from the configuration file. We want the user to
+ be able to specify the names with underscores, but \.{TANGLE} removes
+ underscores, so we're stuck giving the names twice, once as a string,
+ once as the identifier. How ugly.}
+ setup_bound_var (1000000)('main_memory')(main_memory);
+ {|memory_word|s for |mem| in \.{INITEX}}
+ setup_bound_var (0)('extra_mem_top')(extra_mem_top);
+ {increase high mem in \.{VIRTEX}}
+ setup_bound_var (0)('extra_mem_bot')(extra_mem_bot);
+ {increase low mem in \.{VIRTEX}}
+ setup_bound_var (300000)('pool_size')(pool_size);
+ setup_bound_var (200000)('string_vacancies')(string_vacancies);
+ setup_bound_var (5000)('pool_free')(pool_free); {min pool avail after fmt}
+ setup_bound_var (100000)('max_strings')(max_strings);
+ setup_bound_var (100)('strings_free')(strings_free);
+ setup_bound_var (20000)('trie_size')(trie_size);
+ {if |ssup_trie_size| increases, recompile}
+ setup_bound_var (659)('hyph_size')(hyph_size);
+ setup_bound_var (20000)('buf_size')(buf_size);
+ setup_bound_var (50)('nest_size')(nest_size);
+ setup_bound_var (15)('max_in_open')(max_in_open);
+ setup_bound_var (60)('param_size')(param_size);
+ setup_bound_var (4000)('save_size')(save_size);
+ setup_bound_var (300)('stack_size')(stack_size);
+ setup_bound_var (16384)('dvi_buf_size')(dvi_buf_size);
+ setup_bound_var (79)('error_line')(error_line);
+ setup_bound_var (50)('half_error_line')(half_error_line);
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ const_chk (main_memory);
+@+init
+ if ini_version then begin
+ extra_mem_top := 0;
+ extra_mem_bot := 0;
+ end;
+@+tini
+ if extra_mem_bot>sup_main_memory then extra_mem_bot:=sup_main_memory;
+ if extra_mem_top>sup_main_memory then extra_mem_top:=sup_main_memory;
+ {|mem_top| is an index, |main_memory| a size}
+ mem_top := mem_bot + main_memory -1;
+ mem_min := mem_bot;
+ mem_max := mem_top;
+
+ {Check other constants against their sup and inf.}
+ const_chk (trie_size);
+ const_chk (hyph_size);
+ const_chk (buf_size);
+ const_chk (nest_size);
+ const_chk (max_in_open);
+ const_chk (param_size);
+ const_chk (save_size);
+ const_chk (stack_size);
+ const_chk (dvi_buf_size);
+ const_chk (pool_size);
+ const_chk (string_vacancies);
+ const_chk (pool_free);
+ const_chk (max_strings);
+ const_chk (strings_free);
+ if error_line > ssup_error_line then error_line := ssup_error_line;
+
+ {array memory allocation}
+ buffer:=xmalloc_array (ASCII_code, buf_size);
+ nest:=xmalloc_array (list_state_record, nest_size);
+ save_stack:=xmalloc_array (memory_word, save_size);
+ input_stack:=xmalloc_array (in_state_record, stack_size);
+ input_file:=xmalloc_array (alpha_file, max_in_open);
+ input_file_mode:=xmalloc_array (halfword, max_in_open);
+ input_file_translation:=xmalloc_array (halfword, max_in_open);
+ line_stack:=xmalloc_array (integer, max_in_open);
+ line_numbers:=xmalloc_array (integer, max_in_open);
+ file_names:=xmalloc_array (integer, max_in_open);
+ param_stack:=xmalloc_array (halfword, param_size);
+ dvi_buf:=xmalloc_array (real_eight_bits, dvi_buf_size);
+ hyph_word:=xmalloc_array (str_number, hyph_size);
+ hyph_list:=xmalloc_array (halfword, hyph_size);
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+@+init
+if ini_version then begin
+ yzmem:=xmalloc_array (memory_word, mem_top - mem_bot + 1);
+ zmem := yzmem - mem_bot; {Some compilers require |mem_bot=0|}
+
+ str_start_ar:=xmalloc_array (pool_pointer, max_strings-biggest_char);
+ str_pool:=xmalloc_array (packed_ASCII_code, pool_size);
+end;
+@+tini
+@z
+
+@x [51.1332] l.24215 - INI = VIR, so pool init needs runtime test
+@!init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+@y
+@+init if ini_version then
+ begin if not get_strings_started then goto final_end;
+ init_prim; {call |primitive| for each primitive}
+ init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+ end;
+@+tini@/
+@z
+
+@x [51.1332] l.24225 - main
+end_of_TEX: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+@y
+close_files_and_terminate;
+final_end: do_final_end;
+end {|main_body|};
+@z
+
+@x [51.1333] l.24254 - Print new line before termination; switch to editor if necessary.
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+@y
+ print_file_name(0, log_name, 0); print_char(".");
+ end;
+ end;
+print_ln;
+if (edit_name_start<>0) and (interaction>batch_mode) then
+ call_edit(str_pool,edit_name_start,edit_name_length,edit_line);
+@z
+
+@x [51.1334] l. - Remove reference to fontmemsize
+ wlog_ln(', out of ',font_mem_size:1,' for ',font_max-font_base:1);@/
+@y
+@z
+
+@x [51.1335] l.24335 - Only do dump if ini.
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ store_fmt_file; return;@+tini@/
+@y
+ begin @!init if ini_version then
+ begin for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ store_fmt_file; return;
+ end;@+tini@/
+@z
+
+@x [51.1337] l.24361 - Handle %&format in all cases.
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+if (format_ident=0)or(buffer[loc]="&")or dump_line then
+@z
+
+@x [51.1337] l.24371 - Allocate hyphenation tries.
+fix_date_and_time;@/
+@y
+fix_date_and_time;@/
+
+@!init
+if trie_not_ready then begin {initex without format loaded}
+ trie:=xmalloc_array (two_halves, trie_size);
+
+ trie_c:=xmalloc_array (ASCII_code, trie_size);
+ trie_o:=xmalloc_array (quarterword, trie_size);
+ trie_l:=xmalloc_array (trie_pointer, trie_size);
+ trie_r:=xmalloc_array (trie_pointer, trie_size);
+ trie_hash:=xmalloc_array (trie_pointer, trie_size);
+ trie_taken:=xmalloc_array (boolean, trie_size);
+ trie_min:=xmalloc_array (trie_pointer, too_big_char);
+
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+ end;
+ tini@/
+
+@z
+
+% [52.1338] Core-dump in debugging mode on 0 input. Under Unix, it's
+% not possible to portably switch into the debugger while a program is
+% running. The best approximation is to do a core dump, then run the
+% debugger on it later.
+@x [52.1338] l.24411 - Core-dump in debugging mode on 0 input.
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+@y
+ dump_core {do something to cause a core dump}
+@z
+
+% The GNU C compiler complains of unused variables.
+@x
+procedure do_extension;
+var i,@!j,@!k:integer; {all-purpose integers}
+@!p,@!q,@!r:pointer; {all-purpose pointers}
+@y
+procedure do_extension;
+var @!k:integer; {all-purpose integers}
+@!p:pointer; {all-purpose pointers}
+@z
+
+% [53.1350] (new_write_whatsit) Allow 18 as a \write stream. We never
+% refer to an actual file, though, so we don't need to change the
+% write_file or write_open arrays. We provide for disabling this at
+% runtime, for paranoids.
+@x [53.1350] l.24609 - system: Allow 18 as a \write stream.
+ else if cur_val>15 then cur_val:=16;
+@y
+ else if (cur_val>15) and (cur_val <> 18) then cur_val:=16;
+@z
+
+@x [53.1370] l.24770 - system: (write_out) \write18{foo} => system(foo).
+begin @<Expand macros in the token list
+@y
+@!d:integer; {number of characters in incomplete current string}
+@!clobbered:boolean; {system string is ok?}
+begin @<Expand macros in the token list
+@z
+
+@x [53.1370] l.24773 - system: (write_out) \write18{foo} => system(foo).
+if write_open[j] then selector:=j
+@y
+if j=18 then selector := new_string
+else if write_open[j] then selector:=j
+@z
+
+% Then call system(3) on that string.
+@x [53.1370] l.24779 - system: (write_out) \write18{foo} => system(foo).
+flush_list(def_ref); selector:=old_setting;
+@y
+flush_list(def_ref);
+if j=18 then
+ begin if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ {If the log file isn't open yet, we can only send output to the terminal.
+ Calling |open_log_file| from here seems to result in bad data in the log.}
+ if not log_opened then selector:=term_only;
+ print_nl("system(");
+ for d:=0 to cur_length-1 do
+ begin {|print| gives up if passed |str_ptr|, so do it by hand.}
+ print(so(str_pool[str_start(str_ptr)+d])); {N.B.: not |print_char|}
+ end;
+ print(")...");
+ if shell_enabled_p then
+ begin str_room(1); append_char(0); {Append a null byte to the expansion.}
+ clobbered:=false;
+ for d:=0 to cur_length-1 do {Convert to external character set.}
+ begin str_pool[str_start(str_ptr)+d]:=xchr[str_pool[str_start(str_ptr)+d]];
+ if (str_pool[str_start(str_ptr)+d]=null_code)
+ and (d<cur_length-1) then clobbered:=true;
+ {minimal checking: NUL not allowed in argument string of |system|()}
+ end;
+ if clobbered then print("clobbered")
+ else begin {We have the string; run system(3). We don't have anything
+ reasonable to do with the return status, unfortunately discard it.}
+ for d:=0 to cur_length-1 do {Convert to external character set.}
+ begin
+ outside_string_array[d]:=xchr[str_pool[str_start(str_ptr)+d]];
+ end;
+ outside_string_array[cur_length]:=null_code;
+ system(stringcast(outside_string_array));
+ print("executed");
+ end;
+ end
+ else begin print("disabled");
+ end;
+ print_char("."); print_nl(""); print_ln;
+ pool_ptr:=str_start(str_ptr); {erase the string}
+end;
+selector:=old_setting;
+@z
+
+@x [53.1373] Need new local.
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+@y
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+ @!old_setting:0..max_selector;
+@z
+
+@x [53.1374] Disallow certain \openout filenames, and log results.
+ while not a_open_out(write_file[j]) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+@y
+ while not a_open_out(write_file[j])
+ or not open_out_name_ok(name_of_file+1) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+ {If on first line of input, log file is not ready yet, so don't log.}
+ if log_opened then begin
+ old_setting:=selector;
+ if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ print_nl("\openout");
+ print_int(j);
+ print(" = `");
+ print_file_name(cur_name,cur_area,cur_ext);
+ print("'."); print_nl(""); print_ln;
+ selector:=old_setting;
+ end;
+@z
+
+@x [54.1376] l.24903 - Add editor-switch variables to globals.
+@* \[54] System-dependent changes.
+@y
+@* \[54/web2c] System-dependent changes for Web2c.
+Here are extra variables for Web2c. (This numbering of the
+system-dependent section allows easy integration of Web2c and e-\TeX, etc.)
+@^<system dependencies@>
+
+@<Glob...@>=
+@!edit_name_start: pool_pointer; {where the filename to switch to starts}
+@!edit_name_length,@!edit_line: integer; {what line to start editing at}
+@!ipc_on: c_int_type; {level of IPC action, 0 for none [default]}
+@!stop_at_space: boolean; {whether |more_name| returns false for space}
+
+@ The |edit_name_start| will be set to point into |str_pool| somewhere after
+its beginning if \TeX\ is supposed to switch to an editor on exit.
+
+@<Set init...@>=
+edit_name_start:=0;
+stop_at_space:=true;
+
+@ These are used when we regenerate the representation of the first 256
+strings.
+
+@<Global...@> =
+@!save_str_ptr: str_number;
+@!save_pool_ptr: pool_pointer;
+@!shell_enabled_p: c_int_type;
+@!output_comment: ^char;
+@!k,l: 0..65535; {used by `Make the first 256 strings', etc.}
+
+@ When debugging a macro package, it can be useful to see the exact
+control sequence names in the format file. For example, if ten new
+csnames appear, it's nice to know what they are, to help pinpoint where
+they came from. (This isn't a truly ``basic'' printing procedure, but
+that's a convenient module in which to put it.)
+
+@<Basic printing procedures@> =
+procedure print_csnames (hstart:integer; hfinish:integer);
+var c,h:integer;
+begin
+ write_ln(stderr, 'fmtdebug:csnames from ', hstart, ' to ', hfinish, ':');
+ for h := hstart to hfinish do begin
+ if newtext(h) > 0 then begin {if have anything at this position}
+ for c := str_start(newtext(h)) to str_start(newtext(h) + 1) - 1
+ do begin
+ put_byte(str_pool[c], stderr); {print the characters}
+ end;
+ write_ln(stderr, '|');
+ end;
+ end;
+end;
+
+@ Are we printing extra info as we read the format file?
+
+@<Glob...@> =
+@!debug_format_file: boolean;
+
+
+@ A helper for printing file:line:error style messages. Look for a
+filename in |full_source_filename_stack|, and if we fail to find
+one fall back on the non-file:line:error style.
+
+@<Basic print...@>=
+procedure print_file_line;
+var level: 0..max_in_open;
+begin
+ level:=in_open;
+ while (level>0) and (full_source_filename_stack[level]=0) do
+ decr(level);
+ if level=0 then
+ print_nl("! ")
+ else begin
+ print_nl (""); print (full_source_filename_stack[level]); print (":");
+ if level=in_open then print_int (line)
+ else print_int (line_stack[index+1-(in_open-level)]);
+ print (": ");
+ end;
+end;
+
+@ To be able to determine whether \.{\\write18} is enabled from within
+\TeX\ we also implement \.{\\eof18}. We sort of cheat by having an
+additional route |scan_four_bit_int_or_18| which is the same as
+|scan_four_bit_int| except it also accepts the value 18.
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_four_bit_int_or_18;
+begin scan_int;
+if (cur_val<0)or((cur_val>15)and(cur_val<>18)) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@* \[54/web2c-string] The string recycling routines. \TeX{} uses 2
+upto 4 {\it new\/} strings when scanning a filename in an \.{\\input},
+\.{\\openin}, or \.{\\openout} operation. These strings are normally
+lost because the reference to them are not saved after finishing the
+operation. |search_string| searches through the string pool for the
+given string and returns either 0 or the found string number.
+
+@<Declare additional routines for string recycling@>=
+function search_string(@!search:str_number):str_number;
+label found;
+var result: str_number;
+@!s: str_number; {running index}
+@!len: integer; {length of searched string}
+begin result:=0; len:=length(search);
+if len=0 then {trivial case}
+ begin result:=""; goto found;
+ end
+else begin s:=search-1; {start search with newest string below |s|; |search>1|!}
+ while s>65535 do {first 65536 strings depend on implementation!!}
+ begin if length(s)=len then
+ if str_eq_str(s,search) then
+ begin result:=s; goto found;
+ end;
+ decr(s);
+ end;
+ end;
+found:search_string:=result;
+end;
+
+@ The following routine is a variant of |make_string|. It searches
+the whole string pool for a string equal to the string currently built
+and returns a found string. Otherwise a new string is created and
+returned. Be cautious, you can not apply |flush_string| to a replaced
+string!
+
+@<Declare additional routines for string recycling@>=
+function slow_make_string : str_number;
+label exit;
+var s: str_number; {result of |search_string|}
+@!t: str_number; {new string}
+begin t:=make_string; s:=search_string(t);
+if s>0 then
+ begin flush_string; slow_make_string:=s; return;
+ end;
+slow_make_string:=t;
+exit:end;
+
+
+@* \[54] System-dependent changes.
+@z
diff --git a/Build/source/texk/web2c/omegadir/comchar.ch b/Build/source/texk/web2c/omegadir/comchar.ch
new file mode 100644
index 00000000000..e9453955180
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comchar.ch
@@ -0,0 +1,20 @@
+% comchar.ch: Local adaptations for file omchar.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/comdir.ch b/Build/source/texk/web2c/omegadir/comdir.ch
new file mode 100644
index 00000000000..b82a1016fd3
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comdir.ch
@@ -0,0 +1,20 @@
+% comdir.ch: Local adaptations for file omdir.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/comfi.ch b/Build/source/texk/web2c/omegadir/comfi.ch
new file mode 100644
index 00000000000..bb554766295
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comfi.ch
@@ -0,0 +1,20 @@
+% comfi.ch: Local adapatations for file omfi.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/comfilter.ch b/Build/source/texk/web2c/omegadir/comfilter.ch
new file mode 100644
index 00000000000..64499611753
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comfilter.ch
@@ -0,0 +1,123 @@
+% comfilter.ch: Local adaptations for file omfilter.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x
+@!inf_ocp_list_size = 1000;
+@y
+@!inf_ocp_list_size = 1000;
+@!sup_ocp_buf_size = 1000000;
+@!inf_ocp_buf_size = 1000;
+@!sup_ocp_stack_size = 1000000;
+@!inf_ocp_stack_size = 1000;
+@z
+%---------------------------------------
+@x
+@!ocp_list_size:integer;
+@y
+@!ocp_list_size:integer;
+@!ocp_buf_size:integer;
+@!ocp_stack_size:integer;
+@z
+%---------------------------------------
+@x
+for k:=0 to active_max_ptr-1 do dump_wd(active_info[k]);
+print_ln; print_int(active_max_ptr); print(" words of active ocps");
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+for k:=0 to active_max_ptr-1 do undump_wd(active_info[k]);
+@y
+dump_things(active_info[0], active_max_ptr);
+print_ln; print_int(active_max_ptr); print(" words of active ocps");
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+undump_things(active_info[0], active_max_ptr);
+@z
+%---------------------------------------
+@x
+ setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+@y
+ setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+ setup_bound_var(1000)('ocp_buf_size')(ocp_buf_size);
+ setup_bound_var(1000)('ocp_stack_size')(ocp_stack_size);
+@z
+%---------------------------------------
+@x
+ ocp_list_list:=xmalloc_array (ocp_list_index, ocp_list_size);
+@y
+ ocp_list_list:=xmalloc_array (ocp_list_index, ocp_list_size);
+ otp_init_input_buf:=xmalloc_array (quarterword, ocp_buf_size);
+ otp_input_buf:=xmalloc_array (quarterword, ocp_buf_size);
+ otp_output_buf:=xmalloc_array (quarterword, ocp_buf_size);
+ otp_stack_buf:=xmalloc_array (quarterword, ocp_stack_size);
+ otp_calcs:=xmalloc_array (halfword, ocp_stack_size);
+ otp_states:=xmalloc_array (halfword, ocp_stack_size);
+@z
+%---------------------------------------
+@x
+@!otp_init_input_buf:array[0..20000] of quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:array[0..20000] of quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:array[0..20000] of quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:array[0..1000] of quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:array[0..1000] of halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:array[0..1000] of halfword;
+@y
+@!otp_init_input_buf:^quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:^quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:^quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:^quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:^halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:^halfword;
+@z
diff --git a/Build/source/texk/web2c/omegadir/comfont.ch b/Build/source/texk/web2c/omegadir/comfont.ch
new file mode 100644
index 00000000000..7d490e54985
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comfont.ch
@@ -0,0 +1,20 @@
+% comfonts.ch: Local adaptations for file omfonts.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/comnode.ch b/Build/source/texk/web2c/omegadir/comnode.ch
new file mode 100644
index 00000000000..9e2faf5f55b
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comnode.ch
@@ -0,0 +1,20 @@
+% comnode.ch: Local adaptations for file omnode.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/comocp.ch b/Build/source/texk/web2c/omegadir/comocp.ch
new file mode 100644
index 00000000000..0c7056cd610
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comocp.ch
@@ -0,0 +1,141 @@
+% comcop.ch: Local adaptations for file omocp.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@y
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@!sup_ocp_list_size = 1000000;
+@!inf_ocp_list_size = 1000;
+@z
+%---------------------------------------
+@x
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@y
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@!ocp_list_size:integer;
+@z
+%---------------------------------------
+@x
+if not b_open_in(ocp_file) then ocp_abort("opening file");
+@y
+if not ocp_open_in(ocp_file) then ocp_abort("opening file");
+@z
+%---------------------------------------
+@x
+@d ocpget==get(ocp_file)
+@d ocpbyte==ocp_file^
+@y
+@d ocpget==ocp_temp:=getc(ocp_file)
+@d ocpbyte==ocp_temp
+@z
+%---------------------------------------
+@x
+@!ocp_list_info:array[ocp_list_index] of memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
+@y
+@!ocp_list_info:^memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:^memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:^ocp_list_index;
+@z
+%---------------------------------------
+@x
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
+dump_int(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ dump_int(ocp_list_list[k]);
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
+@y
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+dump_things(ocp_list_info[0], ocp_listmem_ptr);
+dump_int(ocp_list_ptr);
+dump_things(ocp_list_list[null_ocp_list], ocp_list_ptr+1-null_ocp_list);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+dump_things(ocp_lstack_info[0], ocp_lstackmem_ptr)
+@z
+%---------------------------------------
+@x
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
+undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do
+ undump_int(ocp_list_list[k]);
+undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
+@y
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+undump_things(ocp_list_info[0], ocp_listmem_ptr);
+undump_size(0)(1000000)('ocp list max')(ocp_list_ptr);
+undump_things(ocp_list_list[null_ocp_list], ocp_list_ptr+1-null_ocp_list);
+undump_size(0)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+undump_things(ocp_lstack_info[0], ocp_lstackmem_ptr)
+@z
+%---------------------------------------
+@x
+ setup_bound_var (79)('max_print_line')(max_print_line);
+@y
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+@z
+%---------------------------------------
+@x
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+@y
+ hyph_link:=xmalloc_array (hyph_pointer, hyph_size);
+ ocp_list_info:=xmalloc_array (memory_word, ocp_list_size);
+ ocp_lstack_info:=xmalloc_array (memory_word, ocp_list_size);
+ ocp_list_list:=xmalloc_array (ocp_list_index, ocp_list_size);
+@z
diff --git a/Build/source/texk/web2c/omegadir/compar.ch b/Build/source/texk/web2c/omegadir/compar.ch
new file mode 100644
index 00000000000..ac5baddf9b4
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/compar.ch
@@ -0,0 +1,20 @@
+% Local adaptations for file ompar.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/comsrcspec.ch b/Build/source/texk/web2c/omegadir/comsrcspec.ch
new file mode 100644
index 00000000000..d8e73ad4c7c
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comsrcspec.ch
@@ -0,0 +1,345 @@
+@x
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@!quoted_filename:boolean; {current filename is quoted}
+@y
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@!quoted_filename:boolean; {current filename is quoted}
+@!special_loc:pointer;
+@!special_token:halfword;
+
+@!parse_first_line_p:c_int_type; {parse the first line for options}
+@!file_line_error_style_p:c_int_type; {format messages as file:line:error}
+@!halt_on_error_p:boolean; {stop at first error}
+
+@!src_specials_p : boolean;
+@!insert_src_special_auto : boolean;
+@!insert_src_special_every_par : boolean;
+@!insert_src_special_every_parend : boolean;
+@!insert_src_special_every_cr : boolean;
+@!insert_src_special_every_math : boolean;
+@!insert_src_special_every_hbox : boolean;
+@!insert_src_special_every_vbox : boolean;
+@!insert_src_special_every_display : boolean;
+@z
+
+@x
+wterm(banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+@y
+if src_specials_p or file_line_error_style_p or parse_first_line_p then
+ wterm(banner_k)
+else
+ wterm(banner);
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+if shell_enabled_p then begin
+ wterm_ln(' \write18 enabled.')
+end;
+if src_specials_p then begin
+ wterm_ln(' Source specials enabled.')
+end;
+if file_line_error_style_p then begin
+ wterm_ln(' file:line:error style messages enabled.')
+end;
+if parse_first_line_p then begin
+ wterm_ln(' %&-line parsing enabled.')
+end;
+@z
+
+@x
+ print_nl("! "); print(#);
+@y
+ if file_line_error_style_p then print_file_line
+ else print_nl("! ");
+ print(#);
+@z
+
+@x
+print_char("."); show_context;
+@y
+print_char("."); show_context;
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+@z
+
+@x
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@y
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : ^alpha_file;
+@!input_file_mode : ^halfword;
+@!input_file_translation : ^halfword;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@!source_filename_stack : ^str_number;
+@!full_source_filename_stack : ^str_number;
+@z
+
+@x
+begin wlog(banner);
+wlog(version_string);
+@y
+begin if src_specials_p or file_line_error_style_p or parse_first_line_p
+then
+ wlog(banner_k)
+else
+ wlog(banner);
+wlog(version_string);
+if shell_enabled_p then begin
+ wlog_cr;
+ wlog('\write18 enabled.')
+end;
+if src_specials_p then begin
+ wlog_cr;
+ wlog(' Source specials enabled.')
+end;
+if file_line_error_style_p then begin
+ wlog_cr;
+ wlog(' file:line:error style messages enabled.')
+end;
+if parse_first_line_p then begin
+ wlog_cr;
+ wlog(' %&-line parsing enabled.');
+end;
+@z
+
+%% ** 537 ******************************************************************
+
+@x
+done: name:=a_make_name_string(cur_file);
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@y
+done: name:=a_make_name_string(cur_file);
+source_filename_stack[in_open]:=name;
+full_source_filename_stack[in_open]:=make_full_name_string;
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@z
+
+%%@x
+%%if term_offset+length(name)>max_print_line-2 then print_ln
+%%else if (term_offset>0)or(file_offset>0) then print_char(" ");
+%%print_char("("); incr(open_parens); slow_print(name); update_terminal;
+%%@y
+%%if term_offset+length(full_source_filename_stack[in_open])>max_print_line-2 then print_ln
+%%else if (term_offset>0)or(file_offset>0) then print_char(" ");
+%%print_char("("); incr(open_parens); slow_print(full_source_filename_stack[in_open]); update_terminal;
+%%@z
+
+%% ** 774 ******************************************************************
+
+ @x
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @y
+if (insert_src_special_every_cr and head<>tail) then insert_src_special;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @z
+
+%% ** 799 ******************************************************************
+
+ @x
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @y
+if (insert_src_special_every_cr) then insert_src_special;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @z
+
+%% ** 1034 ******************************************************************
+
+@x
+@<Append character |cur_chr|...@>=
+adjust_space_factor;@/
+@y
+@<Append character |cur_chr|...@>=
+if ((head=tail) and (mode>0)) then begin
+ if (insert_src_special_auto) then append_src_special;
+end;
+adjust_space_factor;@/
+@z
+
+%% ** 1083 ******************************************************************
+
+ @x
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ @y
+ if (insert_src_special_every_vbox) then insert_src_special;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ @z
+
+ @x
+ if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+ @y
+ if (insert_src_special_every_hbox) then insert_src_special;
+ if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+ @z
+
+%% ** 1091 ******************************************************************
+% Disabled, prevents merge with web2c's tex.ch.
+ @x
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ end;
+ @y
+if indented then begin
+ p:=new_null_box; box_dir(p):=par_direction;
+ width(p):=par_indent;@+
+ tail_append(p);
+ if (insert_src_special_every_par) then insert_src_special;@+
+ end;
+ @z
+
+%% insert source special at par because this is disabled above
+@x
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ box_dir(tail):=info(par_dir_stack);
+ change_dir(tail,info(par_dir_stack));
+ end;
+@y
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ box_dir(tail):=info(par_dir_stack);
+ change_dir(tail,info(par_dir_stack));
+ if (insert_src_special_every_par) then insert_src_special;@+
+ end;
+@z
+
+%% ** 1096 ******************************************************************
+
+ @x fixme: etex conflict
+ else line_break(widow_penalty);
+ @y
+ else begin
+ if (insert_src_special_every_parend) then insert_src_special;
+ line_break(widow_penalty);
+ end;
+ @z
+
+%% ** 1139 ******************************************************************
+
+@x
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+if (insert_src_special_every_math) then insert_src_special;
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+
+%% ** 1145 ******************************************************************
+
+ @x
+if every_display<>null then begin_token_list(every_display,every_display_text);
+ @y
+if (insert_src_special_every_display) then append_src_special;
+if every_display<>null then begin_token_list(every_display,every_display_text);
+ @z
+
+%% ** 1167 ******************************************************************
+
+@x
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@y
+ if (insert_src_special_every_vbox) then insert_src_special;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@z
+
+%% ** 1313 ******************************************************************
+
+@x
+dump_int(par_loc); dump_int(write_loc);@/
+@y
+dump_int(par_loc); dump_int(write_loc); dump_int(special_loc);@/
+@z
+
+%% ** 1314 ******************************************************************
+
+@x
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+@y
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+undump(hash_base)(frozen_control_sequence)(special_loc);
+special_token:=cs_token_flag+special_loc;@/
+@z
+
+@x
+ line_stack:=xmalloc_array (integer, max_in_open);
+@y
+ line_stack:=xmalloc_array (integer, max_in_open);
+ source_filename_stack:=xmalloc_array (str_number, max_in_open);
+ full_source_filename_stack:=xmalloc_array (str_number, max_in_open);
+@z
+
+%% ** 1344 ******************************************************************
+
+@x
+primitive("special",extension,special_node);@/
+@y
+primitive("special",extension,special_node);@/
+special_loc:=cur_val; special_token:=cs_token_flag+special_loc;@/
+@z
+
+%% ** 1379 ******************************************************************
+
+@x
+@* \[55] Index.
+@y
+
+@ @<Declare action procedures for use by |main_control|@>=
+
+procedure insert_src_special;
+var toklist, p, q : pointer;
+begin
+ if (source_filename_stack[in_open] > 0 and is_new_source (source_filename_stack[in_open], line)) then begin
+ toklist := get_avail;
+ p := toklist;
+ info(p) := special_token;
+ link(p) := get_avail; p := link(p);
+ info(p) := left_brace_token+"{";
+ q := str_toks (make_src_special (source_filename_stack[in_open], line));
+ link(p) := link(temp_head);
+ p := q;
+ link(p) := get_avail; p := link(p);
+ info(p) := right_brace_token+"}";
+ ins_list (toklist);
+ remember_source_info (source_filename_stack[in_open], line);
+ end;
+end;
+
+procedure append_src_special;
+var p, q : pointer;
+begin
+ if (source_filename_stack[in_open] > 0 and is_new_source (source_filename_stack[in_open], line)) then begin
+ new_whatsit (special_node, write_node_size);
+ write_stream(tail) := null;
+ def_ref := get_avail;
+ token_ref_count(def_ref) := null;
+ q := str_toks (make_src_special (source_filename_stack[in_open], line));
+ link(def_ref) := link(temp_head);
+ write_tokens(tail) := def_ref;
+ remember_source_info (source_filename_stack[in_open], line);
+ end;
+end;
+
+@* \[55] Index.
+@z
diff --git a/Build/source/texk/web2c/omegadir/comstr.ch b/Build/source/texk/web2c/omegadir/comstr.ch
new file mode 100644
index 00000000000..95c089816b5
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comstr.ch
@@ -0,0 +1,20 @@
+% comstr.ch: Local adaptations for file omstr.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/comtrans.ch b/Build/source/texk/web2c/omegadir/comtrans.ch
new file mode 100644
index 00000000000..5f03ceac5f4
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comtrans.ch
@@ -0,0 +1,20 @@
+% comtrans.ch: Local adaptations for file omtrans.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/comw32.ch b/Build/source/texk/web2c/omegadir/comw32.ch
new file mode 100644
index 00000000000..12afcb2d09e
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comw32.ch
@@ -0,0 +1,77 @@
+@x
+@!file_line_error_style_p:boolean; {output error messages with a C style. }
+@y
+@!file_line_error_style_p:boolean; {format error messages as file:line:error}
+@!halt_on_error_p:boolean; {stop at first error.}
+@!quoted_filename : boolean;
+@z
+
+@x l:1927
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+@y
+ ready_already:=0;
+ texmf_finish_job;
+ if (history <> spotless) and (history <> warning_issued) then
+@z
+
+@x l:10101
+begin area_delimiter:=0; ext_delimiter:=0;
+@y
+begin area_delimiter:=0; ext_delimiter:=0;
+quoted_filename:=false;
+@z
+
+@x l:10111
+begin if c=" " then more_name:=false
+else begin str_room(1); append_char(c); {contribute |c| to the current string}
+@y
+begin
+if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+end;
+if (c=" ") and (not quoted_filename) then more_name:=false
+else begin
+ if (c="*") then c:=" "
+ else if (c="?") then c:="~";
+ str_room(1); append_char(c); {contribute |c| to the current string}
+@z
+
+@x l:10175
+begin slow_print(a); slow_print(n); slow_print(e);
+@y
+begin texmf_print_filename (a, n, e);
+@z
+
+@x l:10184
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+@x l:13060
+ print_nl("Output written on "); slow_print(output_file_name);
+@y
+ print_nl("Output written on "); texmf_print_filename(0, output_file_name, 0);
+@z
+
+@x
+begin @!{|start_here|}
+@y
+begin @!{|start_here|}
+
+ texmf_start_job;
+@z
+
+@x l:24891
+ slow_print(log_name); print_char(".");
+ end;
+@y
+ texmf_print_filename(0, log_name, 0); print_char(".");
+ end;
+@z
diff --git a/Build/source/texk/web2c/omegadir/comxml.ch b/Build/source/texk/web2c/omegadir/comxml.ch
new file mode 100644
index 00000000000..6c68ae40e33
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/comxml.ch
@@ -0,0 +1,20 @@
+% comxml.ch: Local adaptations for file omxml.ch
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/om16bit.ch b/Build/source/texk/web2c/omegadir/om16bit.ch
new file mode 100644
index 00000000000..7a1035185f7
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/om16bit.ch
@@ -0,0 +1,2828 @@
+% om16bit.ch: Basic changes to TeX data structures allowing all
+% 8-bit entities to become 32-bit entities, in particular
+% characters and glyphs.
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+@x limbo l.1 - Omega
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+@y
+% This program is copyright
+% (C) 1994--2000 by John Plaice and Yannis Haralambous.
+% It is designed to be a change file for D. E. Knuth's TeX version 3.141592.
+%
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+@z
+%---------------------------------------
+@x limbo l.80
+\def\title{\TeX82}
+@y
+\def\title{$\Omega$ (OMEGA)}
+@z
+%---------------------------------------
+@x [1] m.1 l.90 - Omega
+This is \TeX, a document compiler intended to produce typesetting of high
+quality.
+The \PASCAL\ program that follows is the definition of \TeX82, a standard
+@:PASCAL}{\PASCAL@>
+@!@:TeX82}{\TeX82@>
+@y
+This is $\Omega$, a document compiler intended to simplify high-quality
+typesetting for many of the world's languages. It is an extension
+of D. E. Knuth's \TeX, which was designed essentially for the
+typesetting of languages using the Latin alphabet.
+
+The $\Omega$ system loosens many of the restrictions imposed by~\TeX:
+register numbers are no longer limited to 8~bits; fonts may have more
+than 256~characters; more than 256~fonts may be used; etc. In addition,
+$\Omega$ allows much more complex ligature mechanisms between characters,
+thereby simplifying the typesetting of alphabets that have preserved
+their calligraphic traditions.
+
+The \PASCAL\ program that follows is a modification of the definition of \TeX82,
+a standard @:PASCAL}{\PASCAL@> @!@:TeX82}{\TeX82@>
+@z
+%---------------------------------------
+@x [1] m.1 l.97 - Omega
+will be obtainable on a great variety of computers.
+
+@y
+will be obtainable on a great variety of computers.
+
+As little as possible is changed in this document. This means that
+unless the contrary is explicitly stated, references to \TeX\ in the
+documentation are equally applicable to~$\Omega$. References to `the
+author' in the documentation are to D. E. Knuth.
+
+@z
+%---------------------------------------
+@x [1] m.2 l.187 - Omega
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@y
+@d banner=='This is Omega, Version 3.141592-1.23.2.3' {printed when \TeX\ starts}
+@z
+%---------------------------------------
+@x [1] m.4 l.243
+program TEX; {all file names are defined dynamically}
+@y
+program OMEGA; {all file names are defined dynamically}
+@z
+%---------------------------------------
+@x [1] m.11 l.392 - Omega
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@y
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@z
+%---------------------------------------
+@x [1] m.11 l.412 - Omega
+@!pool_name='TeXformats:TEX.POOL ';
+@y
+@!pool_name='TeXformats:OMEGA.POOL ';
+@z
+%---------------------------------------
+@x [1] m.12 l.437 - Omega
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@d biggest_char=65535 {the largest allowed character number;
+ must be |<=max_quarterword|}
+@d too_big_char=65536 {|biggest_char+1|}
+@d special_char=65537 {|biggest_char+2|}
+@d number_chars=65536 {|biggest_char+1|}
+@d biggest_reg=65535 {the largest allowed register number;
+ must be |<=max_quarterword|}
+@d number_regs=65536 {|biggest_reg+1|}
+@d font_biggest=65535 {the real biggest font}
+@d number_fonts=font_biggest-font_base+2
+@d number_math_fonts=768
+@d math_font_biggest=767
+@d text_size=0 {size code for the largest size in a family}
+@d script_size=256 {size code for the medium size in a family}
+@d script_script_size=512 {size code for the smallest size in a family}
+@d biggest_lang=255
+@d too_big_lang=256
+@z
+%---------------------------------------
+@x [8] m.110 l.2355 - Omega
+In order to make efficient use of storage space, \TeX\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a (signed) |glue_ratio|, or a small number of
+fields that are one half or one quarter of the size used for storing
+integers.
+
+@y
+In order to make efficient use of storage space, \TeX\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a (signed) |glue_ratio|, or a small number of
+fields that are one half or one quarter of the size used for storing
+integers.
+
+That is the description for \TeX. For $\Omega$, we are going to keep
+the same terminology, except that |quarterword| is going to refer to
+16~bits, and |halfword| is going to refer to 32~bits. So, in fact,
+a |memory_word| will take 64 bits, and, on a 64-bit machine, will run
+smaller than \TeX\ will!
+
+@z
+%---------------------------------------
+@x [8] m.110 l.2378 - Omega
+Since we are assuming 32-bit integers, a halfword must contain at least
+16 bits, and a quarterword must contain at least 8 bits.
+@^system dependencies@>
+But it doesn't hurt to have more bits; for example, with enough 36-bit
+words you might be able to have |mem_max| as large as 262142, which is
+eight times as much memory as anybody had during the first four years of
+\TeX's existence.
+
+N.B.: Valuable memory space will be dreadfully wasted unless \TeX\ is compiled
+by a \PASCAL\ that packs all of the |memory_word| variants into
+the space of a single integer. This means, for example, that |glue_ratio|
+words should be |short_real| instead of |real| on some computers. Some
+\PASCAL\ compilers will pack an integer whose subrange is `|0..255|' into
+an eight-bit field, but others insist on allocating space for an additional
+sign bit; on such systems you can get 256 values into a quarterword only
+if the subrange is `|-128..127|'.
+
+@y
+@z
+%---------------------------------------
+@x [8] m.110 l.2406 - Omega
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y
+@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|}
+@d min_halfword=0 {smallest allowable value in a |halfword|}
+@d max_halfword=@"3FFFFFFF {largest allowable value in a |halfword|}
+@z
+%---------------------------------------
+@x [8] m.111 l.2416 - Omega
+if (min_quarterword>0)or(max_quarterword<127) then bad:=11;
+if (min_halfword>0)or(max_halfword<32767) then bad:=12;
+@y
+if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11;
+if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12;
+@z
+%---------------------------------------
+@x [8] m.111 l.2423 - Omega
+if font_max>font_base+256 then bad:=16;
+@y
+if font_max>font_base+@"10000 then bad:=16;
+@z
+%---------------------------------------
+@x [8] m.111 l.2426 - Omega
+if max_quarterword-min_quarterword<255 then bad:=19;
+@y
+if max_quarterword-min_quarterword<@"FFFF then bad:=19;
+@z
+%---------------------------------------
+@x [9] m.120 - Omega
+@ The function |get_avail| returns a pointer to a new one-word node whose
+|link| field is null. However, \TeX\ will halt if there is no more room left.
+@^inner loop@>
+
+If the available-space list is empty, i.e., if |avail=null|,
+we try first to increase |mem_end|. If that cannot be done, i.e., if
+|mem_end=mem_max|, we try to decrease |hi_mem_min|. If that cannot be
+done, i.e., if |hi_mem_min=lo_mem_max+1|, we have to quit.
+
+@p function get_avail : pointer; {single-word node allocation}
+var p:pointer; {the new node being got}
+begin p:=avail; {get top location in the |avail| stack}
+if p<>null then avail:=link(avail) {and pop it off}
+else if mem_end<mem_max then {or go into virgin territory}
+ begin incr(mem_end); p:=mem_end;
+ end
+else begin decr(hi_mem_min); p:=hi_mem_min;
+ if hi_mem_min<=lo_mem_max then
+ begin runaway; {if memory is exhausted, display possible runaway text}
+ overflow("main memory size",mem_max+1-mem_min);
+ {quit; all one-word nodes are busy}
+@:TeX capacity exceeded main memory size}{\quad main memory size@>
+ end;
+ end;
+link(p):=null; {provide an oft-desired initialization of the new node}
+@!stat incr(dyn_used);@+tats@;{maintain statistics}
+get_avail:=p;
+end;
+@y
+@ The function |get_avail| returns a pointer to a new one-word node whose
+|link| field is null. However, \TeX\ will halt if there is no more room left.
+@^inner loop@>
+
+If the available-space list is empty, i.e., if |avail=null|,
+we try first to increase |mem_end|. If that cannot be done, i.e., if
+|mem_end=mem_max|, we try to decrease |hi_mem_min|. If that cannot be
+done, i.e., if |hi_mem_min=lo_mem_max+1|, we have to quit.
+
+For Omega, we actually return a pointer to the first word,
+rather than the zeroth word.
+
+@p function get_avail : pointer; {single-word node allocation}
+var p:pointer; {the new node being got}
+begin p:=avail; {get top location in the |avail| stack}
+if p<>null then avail:=link(avail) {and pop it off}
+else if (mem_end+1)<mem_max then {or go into virgin territory}
+ begin mem_end:=mem_end+2; p:=mem_end;
+ link(p):=null; info(p):=null; incr(p);
+ end
+else begin hi_mem_min:=hi_mem_min-2; p:=hi_mem_min;
+ if hi_mem_min<=lo_mem_max then
+ begin runaway; {if memory is exhausted, display possible runaway text}
+ overflow("main memory size",mem_max+1-mem_min);
+ {quit; all one-word nodes are busy}
+@:TeX capacity exceeded main memory size}{\quad main memory size@>
+ end;
+ end;
+link(p):=null; {provide an oft-desired initialization of the new node}
+@!stat incr(dyn_used);@+tats@;{maintain statistics}
+get_avail:=p;
+end;
+@z
+%---------------------------------------
+@x [9] m.121 - Omega
+@d free_avail(#)== {single-word node liberation}
+ begin link(#):=avail; avail:=#;
+ @!stat decr(dyn_used);@+tats@/
+ end
+@y
+@d free_avail(#)== {single-word node liberation}
+ begin link(#):=avail; avail:=#;
+ link(#-1):=null; info(#-1):=null;
+ @!stat decr(dyn_used);@+tats@/
+ end
+@z
+%---------------------------------------
+@x [9] m.120 - Omega
+@d fast_get_avail(#)==@t@>@;@/
+ begin #:=avail; {avoid |get_avail| if possible, to save time}
+ if #=null then #:=get_avail
+ else begin avail:=link(#); link(#):=null;
+ @!stat incr(dyn_used);@+tats@/
+ end;
+ end
+@y
+@d fast_get_avail(#)==@t@>@;@/
+ begin #:=avail; {avoid |get_avail| if possible, to save time}
+ if #=null then #:=get_avail
+ else begin avail:=link(#); link(#):=null;
+ link(#-1):=null; info(#-1):=null;
+ @!stat incr(dyn_used);@+tats@/
+ end;
+ end
+@z
+%---------------------------------------
+@x [10] m.125
+@ A call to |get_node| with argument |s| returns a pointer to a new node
+of size~|s|, which must be 2~or more. The |link| field of the first word
+of this new node is set to null. An overflow stop occurs if no suitable
+space exists.
+
+If |get_node| is called with $s=2^{30}$, it simply merges adjacent free
+areas and returns the value |max_halfword|.
+
+@p function get_node(@!s:integer):pointer; {variable-size node allocation}
+label found,exit,restart;
+var p:pointer; {the node currently under inspection}
+@!q:pointer; {the node physically after node |p|}
+@!r:integer; {the newly allocated node, or a candidate for this honor}
+@!t:integer; {temporary register}
+begin restart: p:=rover; {start at some free node in the ring}
+repeat @<Try to allocate within node |p| and its physical successors,
+ and |goto found| if allocation was possible@>;
+@^inner loop@>
+p:=rlink(p); {move to the next node in the ring}
+until p=rover; {repeat until the whole list has been traversed}
+if s=@'10000000000 then
+ begin get_node:=max_halfword; return;
+ end;
+if lo_mem_max+2<hi_mem_min then if lo_mem_max+2<=mem_bot+max_halfword then
+ @<Grow more variable-size memory and |goto restart|@>;
+overflow("main memory size",mem_max+1-mem_min);
+ {sorry, nothing satisfactory is left}
+@:TeX capacity exceeded main memory size}{\quad main memory size@>
+found: link(r):=null; {this node is now nonempty}
+@!stat var_used:=var_used+s; {maintain usage statistics}
+tats@;@/
+get_node:=r;
+exit:end;
+@y
+@ A call to |get_node| with argument |s| returns a pointer to a new node
+of size~|s|, which must be 2~or more. The |link| field of the first word
+of this new node is set to null. An overflow stop occurs if no suitable
+space exists.
+
+If |get_node| is called with $s=2^{30}$, it simply merges adjacent free
+areas and returns the value |max_halfword|.
+
+@p function get_node(@!s:integer):pointer; {variable-size node allocation}
+label found,exit,restart;
+var p:pointer; {the node currently under inspection}
+@!q:pointer; {the node physically after node |p|}
+@!r:integer; {the newly allocated node, or a candidate for this honor}
+@!t:integer; {temporary register}
+begin
+if s<>@'10000000000 then incr(s);
+restart: p:=rover; {start at some free node in the ring}
+repeat @<Try to allocate within node |p| and its physical successors,
+ and |goto found| if allocation was possible@>;
+@^inner loop@>
+p:=rlink(p); {move to the next node in the ring}
+until p=rover; {repeat until the whole list has been traversed}
+if s=@'10000000000 then
+ begin get_node:=max_halfword; return;
+ end;
+if lo_mem_max+2<hi_mem_min then if lo_mem_max+2<=mem_bot+max_halfword then
+ @<Grow more variable-size memory and |goto restart|@>;
+overflow("main memory size",mem_max+1-mem_min);
+ {sorry, nothing satisfactory is left}
+@:TeX capacity exceeded main memory size}{\quad main memory size@>
+found: incr(r); link(r):=null; {this node is now nonempty}
+@!stat var_used:=var_used+s; {maintain usage statistics}
+tats@;@/
+link(r-1):=null; info(r-1):=null;
+get_node:=r;
+exit:end;
+@z
+%---------------------------------------
+@x [10] m.130
+@p procedure free_node(@!p:pointer; @!s:halfword); {variable-size node
+ liberation}
+var q:pointer; {|llink(rover)|}
+begin node_size(p):=s; link(p):=empty_flag;
+q:=llink(rover); llink(p):=q; rlink(p):=rover; {set both links}
+llink(rover):=p; rlink(q):=p; {insert |p| into the ring}
+@!stat var_used:=var_used-s;@+tats@;{maintain statistics}
+end;
+@y
+@p procedure free_node(@!p:pointer; @!s:halfword); {variable-size node
+ liberation}
+var q:pointer; {|llink(rover)|}
+begin
+decr(p); incr(s);
+link(p):=null; info(p):=null;
+node_size(p):=s; link(p):=empty_flag;
+q:=llink(rover); llink(p):=q; rlink(p):=rover; {set both links}
+llink(rover):=p; rlink(q):=p; {insert |p| into the ring}
+@!stat var_used:=var_used-s;@+tats@;{maintain statistics}
+end;
+@z
+%---------------------------------------
+@x [10] m.134 l.2832 - Omega
+Note that the format of a |char_node| allows for up to 256 different
+fonts and up to 256 characters per font; but most implementations will
+probably limit the total number of fonts to fewer than 75 per job,
+and most fonts will stick to characters whose codes are
+less than 128 (since higher codes
+are more difficult to access on most keyboards).
+
+Extensions of \TeX\ intended for oriental languages will need even more
+than $256\times256$ possible characters, when we consider different sizes
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+and styles of type. It is suggested that Chinese and Japanese fonts be
+handled by representing such characters in two consecutive |char_node|
+entries: The first of these has |font=font_base|, and its |link| points
+to the second;
+the second identifies the font and the character dimensions.
+The saving feature about oriental characters is that most of them have
+the same box dimensions. The |character| field of the first |char_node|
+is a ``\\{charext}'' that distinguishes between graphic symbols whose
+dimensions are identical for typesetting purposes. (See the \MF\ manual.)
+Such an extension of \TeX\ would not be difficult; further details are
+left to the reader.
+@y
+Note that the format of a |char_node| allows for up to 65536 different
+fonts and up to 65536 characters per font.
+@z
+%---------------------------------------
+@x [15] m.208 l.4127 - Omega
+@d min_internal=68 {the smallest code that can follow \.{\\the}}
+@d char_given=68 {character code defined by \.{\\chardef}}
+@d math_given=69 {math code defined by \.{\\mathchardef}}
+@d last_item=70 {most recent item ( \.{\\lastpenalty},
+ \.{\\lastkern}, \.{\\lastskip} )}
+@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}}
+@y
+@d min_internal=end_cs_name+1 {the smallest code that can follow \.{\\the}}
+@d char_given=min_internal {character code defined by \.{\\chardef}}
+@d math_given=char_given+1 {math code defined by \.{\\mathchardef}}
+@d omath_given=math_given+1 {math code defined by \.{\\omathchardef}}
+@d last_item=omath_given+1 {most recent item ( \.{\\lastpenalty},
+ \.{\\lastkern}, \.{\\lastskip} )}
+@d max_non_prefixed_command=last_item
+ {largest command code that can't be \.{\\global}}
+@z
+%---------------------------------------
+@x [15] m.209 l.4138 - Omega
+@d toks_register=71 {token list register ( \.{\\toks} )}
+@d assign_toks=72 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
+@d assign_int=73 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
+@d assign_dimen=74 {user-defined length ( \.{\\hsize}, etc.~)}
+@d assign_glue=75 {user-defined glue ( \.{\\baselineskip}, etc.~)}
+@d assign_mu_glue=76 {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
+@d assign_font_dimen=77 {user-defined font dimension ( \.{\\fontdimen} )}
+@d assign_font_int=78 {user-defined font integer ( \.{\\hyphenchar},
+ \.{\\skewchar} )}
+@d set_aux=79 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
+@d set_prev_graf=80 {specify state info ( \.{\\prevgraf} )}
+@d set_page_dimen=81 {specify state info ( \.{\\pagegoal}, etc.~)}
+@d set_page_int=82 {specify state info ( \.{\\deadcycles},
+ \.{\\insertpenalties} )}
+@d set_box_dimen=83 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
+@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
+@d def_code=85 {define a character code ( \.{\\catcode}, etc.~)}
+@d def_family=86 {declare math fonts ( \.{\\textfont}, etc.~)}
+@d set_font=87 {set current font ( font identifiers )}
+@d def_font=88 {define a font file ( \.{\\font} )}
+@d register=89 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d max_internal=89 {the largest code that can follow \.{\\the}}
+@d advance=90 {advance a register or parameter ( \.{\\advance} )}
+@d multiply=91 {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=92 {divide a register or parameter ( \.{\\divide} )}
+@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=94 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
+@d def=97 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=98 {set a box ( \.{\\setbox} )}
+@d hyph_data=99 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d max_command=100 {the largest command code seen at |big_switch|}
+@y
+@d toks_register=max_non_prefixed_command+1
+ {token list register ( \.{\\toks} )}
+@d assign_toks=toks_register+1
+ {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
+@d assign_int=assign_toks+1
+ {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
+@d assign_dimen=assign_int+1
+ {user-defined length ( \.{\\hsize}, etc.~)}
+@d assign_glue=assign_dimen+1
+ {user-defined glue ( \.{\\baselineskip}, etc.~)}
+@d assign_mu_glue=assign_glue+1
+ {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
+@d assign_font_dimen=assign_mu_glue+1
+ {user-defined font dimension ( \.{\\fontdimen} )}
+@d assign_font_int=assign_font_dimen+1
+ {user-defined font integer ( \.{\\hyphenchar}, \.{\\skewchar} )}
+@d set_aux=assign_font_int+1
+ {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
+@d set_prev_graf=set_aux+1
+ {specify state info ( \.{\\prevgraf} )}
+@d set_page_dimen=set_prev_graf+1
+ {specify state info ( \.{\\pagegoal}, etc.~)}
+@d set_page_int=set_page_dimen+1
+ {specify state info ( \.{\\deadcycles},
+ \.{\\insertpenalties} )}
+@d set_box_dimen=set_page_int+1
+ {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
+@d set_shape=set_box_dimen+1
+ {specify fancy paragraph shape ( \.{\\parshape} )}
+@d def_code=set_shape+1
+ {define a character code ( \.{\\catcode}, etc.~)}
+@d def_family=def_code+1
+ {declare math fonts ( \.{\\textfont}, etc.~)}
+@d set_font=def_family+1
+ {set current font ( font identifiers )}
+@d def_font=set_font+1
+ {define a font file ( \.{\\font} )}
+@d register=def_font+1
+ {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d max_internal=register
+ {the largest code that can follow \.{\\the}}
+@d advance=max_internal+1
+ {advance a register or parameter ( \.{\\advance} )}
+@d multiply=advance+1
+ {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=multiply+1
+ {divide a register or parameter ( \.{\\divide} )}
+@d prefix=divide+1
+ {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=prefix+1
+ {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=let+1
+ {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@d read_to_cs=shorthand_def+1
+ {read into a control sequence ( \.{\\read} )}
+@d def=read_to_cs+1
+ {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=def+1
+ {set a box ( \.{\\setbox} )}
+@d hyph_data=set_box+1
+ {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=hyph_data+1
+ {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d max_command=set_interaction
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.220 l.4486 - Omega
+@d eq_level(#)==eq_level_field(eqtb[#]) {level of definition}
+@d eq_type(#)==eq_type_field(eqtb[#]) {command code for equivalent}
+@d equiv(#)==equiv_field(eqtb[#]) {equivalent value}
+@y
+@d eq_level(#)==new_eq_level(#) {level of definition}
+@d eq_type(#)==new_eq_type(#) {command code for equivalent}
+@d equiv(#)==new_equiv(#) {equivalent value}
+@d equiv1(#)==new_equiv1(#) {equivalent value}
+@z
+%---------------------------------------
+@x [17] m.222 l.4496 - Omega
+In the first region we have 256 equivalents for ``active characters'' that
+act as control sequences, followed by 256 equivalents for single-character
+control sequences.
+@y
+In the first region we have |number_chars| equivalents for ``active characters''
+that act as control sequences, followed by |number_chars| equivalents for
+single-character control sequences.
+@z
+%---------------------------------------
+@x [17] m.222 l.4507 - Omega
+@d single_base=active_base+256 {equivalents of one-character control sequences}
+@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}}
+@y
+@d single_base=active_base+number_chars
+ {equivalents of one-character control sequences}
+@d null_cs=single_base+number_chars {equivalent of \.{\\csname\\endcsname}}
+@z
+%---------------------------------------
+@x [17] m.222 l.4530 - Omega
+eq_type(undefined_control_sequence):=undefined_cs;
+equiv(undefined_control_sequence):=null;
+eq_level(undefined_control_sequence):=level_zero;
+for k:=active_base to undefined_control_sequence-1 do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+@y
+set_eq_type(undefined_control_sequence,undefined_cs);
+set_equiv(undefined_control_sequence,null);
+set_eq_level(undefined_control_sequence,level_zero);
+@z
+%---------------------------------------
+@x [17] m.224 l.4547 - Omega
+@ Region 3 of |eqtb| contains the 256 \.{\\skip} registers, as well as the
+glue parameters defined here. It is important that the ``muskip''
+parameters have larger numbers than the others.
+@y
+@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers,
+as well as the glue parameters defined here. It is important that the
+``muskip'' parameters have larger numbers than the others.
+@z
+%---------------------------------------
+@x [17] m.224 l.4572 - Omega
+@d skip_base=glue_base+glue_pars {table of 256 ``skip'' registers}
+@d mu_skip_base=skip_base+256 {table of 256 ``muskip'' registers}
+@d local_base=mu_skip_base+256 {beginning of region 4}
+@y
+@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers}
+@d mu_skip_base=skip_base+number_regs
+ {table of |number_regs| ``muskip'' registers}
+@d local_base=mu_skip_base+number_regs {beginning of region 4}
+@z
+%---------------------------------------
+@x [17] m.228 l.4685 - Omega
+equiv(glue_base):=zero_glue; eq_level(glue_base):=level_one;
+eq_type(glue_base):=glue_ref;
+for k:=glue_base+1 to local_base-1 do eqtb[k]:=eqtb[glue_base];
+@y
+set_equiv(glue_base,zero_glue); set_eq_level(glue_base,level_one);
+set_eq_type(glue_base,glue_ref);
+@z
+%---------------------------------------
+@x [17] m.230 l.4721 - Omega
+@d toks_base=local_base+10 {table of 256 token list registers}
+@d box_base=toks_base+256 {table of 256 box registers}
+@d cur_font_loc=box_base+256 {internal font number outside math mode}
+@d math_font_base=cur_font_loc+1 {table of 48 math font numbers}
+@d cat_code_base=math_font_base+48
+ {table of 256 command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings}
+@d uc_code_base=lc_code_base+256 {table of 256 uppercase mappings}
+@d sf_code_base=uc_code_base+256 {table of 256 spacefactor mappings}
+@d math_code_base=sf_code_base+256 {table of 256 math mode mappings}
+@d int_base=math_code_base+256 {beginning of region 5}
+@y
+@d toks_base=local_base+10 {table of |number_regs| token list registers}
+@d box_base=toks_base+number_regs {table of |number_regs| box registers}
+@d cur_font_loc=box_base+number_regs {internal font number outside math mode}
+@d math_font_base=cur_font_loc+1
+ {table of |number_math_fonts| math font numbers}
+@d cat_code_base=math_font_base+number_math_fonts
+ {table of |number_chars| command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+number_chars
+ {table of |number_chars| lowercase mappings}
+@d uc_code_base=lc_code_base+number_chars
+ {table of |number_chars| uppercase mappings}
+@d sf_code_base=uc_code_base+number_chars
+ {table of |number_chars| spacefactor mappings}
+@d math_code_base=sf_code_base+number_chars
+ {table of |number_chars| math mode mappings}
+@d int_base=math_code_base+number_chars {beginning of region 5}
+@z
+%---------------------------------------
+@x [17] m.232 l.4802 - Omega
+@d var_code==@'70000 {math code meaning ``use the current family''}
+
+@<Initialize table entries...@>=
+par_shape_ptr:=null; eq_type(par_shape_loc):=shape_ref;
+eq_level(par_shape_loc):=level_one;@/
+for k:=output_routine_loc to toks_base+255 do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+box(0):=null; eq_type(box_base):=box_ref; eq_level(box_base):=level_one;
+for k:=box_base+1 to box_base+255 do eqtb[k]:=eqtb[box_base];
+cur_font:=null_font; eq_type(cur_font_loc):=data;
+eq_level(cur_font_loc):=level_one;@/
+for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc];
+equiv(cat_code_base):=0; eq_type(cat_code_base):=data;
+eq_level(cat_code_base):=level_one;@/
+for k:=cat_code_base+1 to int_base-1 do eqtb[k]:=eqtb[cat_code_base];
+for k:=0 to 255 do
+ begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000;
+ end;
+cat_code(carriage_return):=car_ret; cat_code(" "):=spacer;
+cat_code("\"):=escape; cat_code("%"):=comment;
+cat_code(invalid_code):=invalid_char; cat_code(null_code):=ignore;
+for k:="0" to "9" do math_code(k):=hi(k+var_code);
+for k:="A" to "Z" do
+ begin cat_code(k):=letter; cat_code(k+"a"-"A"):=letter;@/
+ math_code(k):=hi(k+var_code+@"100);
+ math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/
+ lc_code(k):=k+"a"-"A"; lc_code(k+"a"-"A"):=k+"a"-"A";@/
+ uc_code(k):=k; uc_code(k+"a"-"A"):=k;@/
+ sf_code(k):=999;
+ end;
+@y
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+
+@<Initialize table entries...@>=
+set_equiv(par_shape_loc,null); set_eq_type(par_shape_loc,shape_ref);
+set_eq_level(par_shape_loc,level_one);@/
+set_equiv(cat_code_base+carriage_return,car_ret);
+set_equiv(cat_code_base+" ",spacer);
+set_equiv(cat_code_base+"\",escape);
+set_equiv(cat_code_base+"%",comment);
+set_equiv(cat_code_base+invalid_code,invalid_char);
+set_equiv(cat_code_base+null_code,ignore);
+for k:="0" to "9" do set_equiv(math_code_base+k,hi(k+var_code));
+for k:="A" to "Z" do
+ begin set_equiv(cat_code_base+k,letter);
+ set_equiv(cat_code_base+k+"a"-"A",letter);@/
+ set_equiv(math_code_base+k,hi(k+var_code+@"10000));
+ set_equiv(math_code_base+k+"a"-"A",hi(k+"a"-"A"+var_code+@"10000));@/
+ set_equiv(lc_code_base+k,k+"a"-"A");
+ set_equiv(lc_code_base+k+"a"-"A",k+"a"-"A");@/
+ set_equiv(uc_code_base+k,k);
+ set_equiv(uc_code_base+k+"a"-"A",k);@/
+ set_equiv(sf_code_base+k,999);
+ end;
+@z
+%---------------------------------------
+@x [17] m.234 l.4857 - Omega
+@ @<Show the font identifier in |eqtb[n]|@>=
+begin if n=cur_font_loc then print("current font")
+else if n<math_font_base+16 then
+ begin print_esc("textfont"); print_int(n-math_font_base);
+ end
+else if n<math_font_base+32 then
+ begin print_esc("scriptfont"); print_int(n-math_font_base-16);
+ end
+else begin print_esc("scriptscriptfont"); print_int(n-math_font_base-32);
+ end;
+print_char("=");@/
+print_esc(hash[font_id_base+equiv(n)].rh);
+ {that's |font_id_text(equiv(n))|}
+@y
+@ @<Show the font identifier in |eqtb[n]|@>=
+begin if n=cur_font_loc then print("current font")
+else if n<math_font_base+script_size then
+ begin print_esc("textfont"); print_int(n-math_font_base);
+ end
+else if n<math_font_base+script_script_size then
+ begin print_esc("scriptfont"); print_int(n-math_font_base-script_size);
+ end
+else begin print_esc("scriptscriptfont");
+ print_int(n-math_font_base-script_script_size);
+ end;
+print_char("=");@/
+print_esc(newtext(font_id_base+equiv(n)));
+ {that's |font_id_text(equiv(n))|}
+@z
+%---------------------------------------
+@x [17] m.236 l.4955 - Omega
+@d count_base=int_base+int_pars {256 user \.{\\count} registers}
+@d del_code_base=count_base+256 {256 delimiter code mappings}
+@d dimen_base=del_code_base+256 {beginning of region 6}
+@#
+@d del_code(#)==eqtb[del_code_base+#].int
+@d count(#)==eqtb[count_base+#].int
+@d int_par(#)==eqtb[int_base+#].int {an integer parameter}
+@y
+@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers}
+@d del_code_base=count_base+number_regs {|number_chars| delimiter code mappings}
+@d dimen_base=del_code_base+number_chars {beginning of region 6}
+@#
+@d del_code0(#)==new_equiv(del_code_base+#)
+@d del_code1(#)==new_equiv1(del_code_base+#)
+@d count(#)==new_eqtb_int(count_base+#)
+@d int_par(#)==new_eqtb_int(int_base+#) {an integer parameter}
+@z
+%---------------------------------------
+@x [17] m.240 l.5213 - Omega
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
+escape_char:="\"; end_line_char:=carriage_return;
+for k:=0 to 255 do del_code(k):=-1;
+del_code("."):=0; {this null delimiter is used in error recovery}
+@y
+set_new_eqtb_int(int_base+mag_code,1000);
+set_new_eqtb_int(int_base+tolerance_code,10000);
+set_new_eqtb_int(int_base+hang_after_code,1);
+set_new_eqtb_int(int_base+max_dead_cycles_code,25);
+set_new_eqtb_int(int_base+escape_char_code,"\");
+set_new_eqtb_int(int_base+end_line_char_code,carriage_return);
+set_equiv(del_code_base+".",0);
+set_equiv1(del_code_base+".",0);
+ {this null delimiter is used in error recovery}
+
+@ @<Set newline character to -1@>=
+set_new_eqtb_int(int_base+new_line_char_code,-1)
+
+@ @<Set newline character to nl@>=
+set_new_eqtb_int(int_base+new_line_char_code,nl)
+
+@z
+%---------------------------------------
+@x [17] m.242 l.5240 - Omega
+print_char("="); print_int(eqtb[n].int);
+@y
+print_char("="); print_int(new_eqtb_int(n));
+@z
+%---------------------------------------
+@x [17] m.247 l.5273 - Omega
+here, and the 256 \.{\\dimen} registers.
+@y
+here, and the |number_regs| \.{\\dimen} registers.
+@z
+%---------------------------------------
+@x [17] m.247 l.5298 - Omega
+ {table of 256 user-defined \.{\\dimen} registers}
+@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|}
+@#
+@d dimen(#)==eqtb[scaled_base+#].sc
+@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity}
+@y
+ {table of |number_regs| user-defined \.{\\dimen} registers}
+@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|}
+@#
+@d dimen(#)==new_eqtb_sc(scaled_base+(#))
+@d dimen_par(#)==new_eqtb_sc(dimen_base+(#)) {a scaled quantity}
+@z
+%---------------------------------------
+@x [17] m.250 l.5405 - Omega
+for k:=dimen_base to eqtb_size do eqtb[k].sc:=0;
+@y
+
+@ @p function init_eqtb_entry (p:pointer):memory_word;
+var mw:memory_word;
+begin
+ { Regions 1 and 2 }
+ if (p>=active_base) and
+ (p<=undefined_control_sequence) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+ { Region 3 }
+ else if (p>=glue_base) and
+ (p<=local_base+1) then begin
+ equiv_field(mw):=zero_glue;
+ eq_type_field(mw):=glue_ref;
+ eq_level_field(mw):=level_one;
+ end
+ { Region 4 }
+ else if (p>=par_shape_loc) and
+ (p<=toks_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end
+ else if (p>=box_base) and
+ (p<=box_base+biggest_reg) then begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=box_ref;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=cur_font_loc) and
+ (p<=math_font_base+math_font_biggest) then begin
+ equiv_field(mw):=null_font;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=cat_code_base) and
+ (p<=cat_code_base+biggest_char) then begin
+ equiv_field(mw):=other_char;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=lc_code_base) and
+ (p<=uc_code_base+biggest_char) then begin
+ equiv_field(mw):=0;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=sf_code_base) and
+ (p<=sf_code_base+biggest_char) then begin
+ equiv_field(mw):=1000;
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ else if (p>=math_code_base) and
+ (p<=math_code_base+biggest_char) then begin
+ equiv_field(mw):=hi(p-math_code_base);
+ eq_type_field(mw):=data;
+ eq_level_field(mw):=level_one;
+ end
+ { Region 5 }
+ else if (p>=int_base) and (p<=del_code_base-1) then begin
+ setintzero(mw,0);
+ setintone(mw,0);
+ end
+ else if (p>=del_code_base) and (p<=del_code_base+biggest_char) then begin
+ setintzero(mw,-1);
+ setintone(mw,-1);
+ end
+ { Region 6 }
+ else if (p>=dimen_base) and (p<=eqtb_size) then begin
+ setintzero(mw,0);
+ setintone(mw,0);
+ end
+ else begin
+ equiv_field(mw):=null;
+ eq_type_field(mw):=undefined_cs;
+ eq_level_field(mw):=level_zero;
+ end;
+ init_eqtb_entry:=mw;
+end;
+
+@z
+%---------------------------------------
+@x [17] m.251 l.5411 - Omega
+print_char("="); print_scaled(eqtb[n].sc); print("pt");
+@y
+print_char("="); print_scaled(new_eqtb_sc(n)); print("pt");
+@z
+%---------------------------------------
+@x [17] m.254 l.5435 - Omega
+@ The last two regions of |eqtb| have fullword values instead of the
+three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary,
+but \TeX\ needs to store the |eq_level| information in another array
+called |xeq_level|.
+
+@<Glob...@>=
+@!eqtb:array[active_base..eqtb_size] of memory_word;
+@!xeq_level:array[int_base..eqtb_size] of quarterword;
+@y
+@ The last two regions of |eqtb| have fullword values instead of the
+three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary,
+but \TeX\ needs to store the |eq_level| information in another array
+called |xeq_level|.
+
+@d xeq_level(#) == new_xeq_level(eqtb_size+eqtb_size+#)
+@d set_xeq_level(#) == set_new_eqtb_int(eqtb_size+eqtb_size+#)
+@z
+%---------------------------------------
+@x [17] m.255 l.5439 - Omega
+for k:=int_base to eqtb_size do xeq_level[k]:=level_one;
+@y
+@z
+%---------------------------------------
+@x [17] m.255 l.5446 - Omega
+for q:=active_base to box_base+255 do
+@y
+for q:=active_base to box_base+biggest_reg do
+@z
+%---------------------------------------
+@x [18] m.256 l.5477 - Omega
+@d next(#) == hash[#].lh {link for coalesced lists}
+@d text(#) == hash[#].rh {string number for control sequence name}
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name}
+
+@<Glob...@>=
+@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
+ {the hash table}
+@y
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@d newtext(#) == new_hash_text(eqtb_size+#)
+@d newnext(#) == new_hash_next(eqtb_size+#)
+@d settext(#) == set_hash_text(eqtb_size+#)
+@d setnext(#) == set_hash_next(eqtb_size+#)
+
+@<Glob...@>=
+@z
+%---------------------------------------
+@x [18] m.257 l.5491 - Omega
+next(hash_base):=0; text(hash_base):=0;
+for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base];
+@y
+@z
+%---------------------------------------
+@x [18] m.258 l.5497 - Omega
+hash_used:=frozen_control_sequence; {nothing is used}
+cs_count:=0;
+eq_type(frozen_dont_expand):=dont_expand;
+text(frozen_dont_expand):="notexpanded:";
+@y
+hash_used:=frozen_control_sequence; {nothing is used}
+cs_count:=0;
+set_eq_type(frozen_dont_expand,dont_expand);
+settext(frozen_dont_expand,"notexpanded:");
+@z
+%---------------------------------------
+@x [18] m.259 l.5514 - Omega
+@!k:pointer; {index in |buffer| array}
+begin @<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+begin if text(p)>0 then if length(text(p))=l then
+ if str_eq_buf(text(p),j) then goto found;
+ if next(p)=0 then
+ begin if no_new_control_sequence then
+ p:=undefined_control_sequence
+ else @<Insert a new control sequence after |p|, then make
+ |p| point to it@>;
+ goto found;
+ end;
+ p:=next(p);
+ end;
+found: id_lookup:=p;
+@y
+@!k:pointer; {index in |buffer| array}
+@!newstring:integer;
+begin @<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+begin if newtext(p)>0 then if length(newtext(p))=l then
+ if str_eq_buf(newtext(p),j) then goto found;
+ if newnext(p)=0 then
+ begin if no_new_control_sequence then
+ p:=undefined_control_sequence
+ else @<Insert a new control sequence after |p|, then make
+ |p| point to it@>;
+ goto found;
+ end;
+ p:=newnext(p);
+ end;
+found: id_lookup:=p;
+@z
+%---------------------------------------
+@x [18] m.260 l.5532 - Omega
+begin if text(p)>0 then
+ begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until text(hash_used)=0; {search for an empty location in |hash|}
+ next(p):=hash_used; p:=hash_used;
+ end;
+str_room(l); d:=cur_length;
+while pool_ptr>str_start[str_ptr] do
+ begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr];
+ end; {move current string up to make room for another}
+for k:=j to j+l-1 do append_char(buffer[k]);
+text(p):=make_string; pool_ptr:=pool_ptr+d;
+@y
+begin if newtext(p)>0 then
+ begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until newtext(hash_used)=0; {search for an empty location in |hash|}
+ setnext(p,hash_used); p:=hash_used;
+ end;
+str_room(l); d:=cur_length;
+while pool_ptr>str_start[str_ptr] do
+ begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr];
+ end; {move current string up to make room for another}
+for k:=j to j+l-1 do append_char(buffer[k]);
+newstring:=make_string;
+settext(p,newstring); pool_ptr:=pool_ptr+d;
+@z
+%---------------------------------------
+@x [18] m.262 l.5584 - Omega
+else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@.NONEXISTENT@>
+else begin print_esc(text(p));
+@y
+else if (newtext(p)<0)or(newtext(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@.NONEXISTENT@>
+else begin print_esc(newtext(p));
+@z
+%---------------------------------------
+@x [18] m.263 l.5601 - Omega
+else print_esc(text(p));
+@y
+else print_esc(newtext(p));
+@z
+%---------------------------------------
+@x [18] m.264 l.5610 - Omega
+@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
+var k:pool_pointer; {index into |str_pool|}
+@!j:small_number; {index into |buffer|}
+@!l:small_number; {length of the string}
+begin if s<256 then cur_val:=s+single_base
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+ flush_string; text(cur_val):=s; {we don't want to have the string twice}
+ end;
+eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o;
+@y
+@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
+var k:pool_pointer; {index into |str_pool|}
+@!j:small_number; {index into |buffer|}
+@!l:small_number; {length of the string}
+begin if s<=biggest_char then cur_val:=s+single_base
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+ flush_string; settext(cur_val,s); {we don't want to have the string twice}
+ end;
+set_eq_level(cur_val,level_one); set_eq_type(cur_val,c);
+set_equiv(cur_val,o);
+@z
+%---------------------------------------
+@x [18] m.265 l.5648 - Omega
+primitive("delimiter",delim_num,0);@/
+@!@:delimiter_}{\.{\\delimiter} primitive@>
+@y
+primitive("delimiter",delim_num,0);@/
+@!@:delimiter_}{\.{\\delimiter} primitive@>
+primitive("odelimiter",delim_num,1);@/
+@!@:delimiter_}{\.{\\odelimiter} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5656 - Omega
+text(frozen_end_group):="endgroup"; eqtb[frozen_end_group]:=eqtb[cur_val];@/
+@y
+settext(frozen_end_group,"endgroup");
+set_new_eqtb(frozen_end_group,new_eqtb(cur_val));@/
+@z
+%---------------------------------------
+@x [18] m.265 l.5673 - Omega
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("mathchar",math_char_num,0);@/
+@!@:math_char_}{\.{\\mathchar} primitive@>
+@y
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("mathchar",math_char_num,0);@/
+@!@:math_char_}{\.{\\mathchar} primitive@>
+primitive("omathaccent",math_accent,1);@/
+@!@:math_accent_}{\.{\\omathaccent} primitive@>
+primitive("omathchar",math_char_num,1);@/
+@!@:math_char_}{\.{\\omathchar} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5697 - Omega
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+@y
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+primitive("oradical",radical,1);@/
+@!@:radical_}{\.{\\oradical} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5701 - Omega
+primitive("relax",relax,256); {cf.\ |scan_file_name|}
+@!@:relax_}{\.{\\relax} primitive@>
+text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/
+@y
+primitive("relax",relax,too_big_char); {cf.\ |scan_file_name|}
+@!@:relax_}{\.{\\relax} primitive@>
+settext(frozen_relax,"relax");
+set_new_eqtb(frozen_relax,new_eqtb(cur_val));@/
+@z
+%---------------------------------------
+@x [19] m.276 l.5951 - Omega
+else begin save_stack[save_ptr]:=eqtb[p]; incr(save_ptr);
+@y
+else begin save_stack[save_ptr]:=new_eqtb(p); incr(save_ptr);
+@z
+%---------------------------------------
+@x [19] m.277 l.5967 - Omega
+begin if eq_level(p)=cur_level then eq_destroy(eqtb[p])
+else if cur_level>level_one then eq_save(p,eq_level(p));
+eq_level(p):=cur_level; eq_type(p):=t; equiv(p):=e;
+@y
+begin if eq_level(p)=cur_level then eq_destroy(new_eqtb(p))
+else if cur_level>level_one then eq_save(p,eq_level(p));
+set_eq_level(p,cur_level); set_eq_type(p,t); set_equiv(p,e);
+@z
+%---------------------------------------
+@x [19] m.278 l.5980 - Omega
+@p procedure eq_word_define(@!p:pointer;@!w:integer);
+begin if xeq_level[p]<>cur_level then
+ begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level;
+ end;
+eqtb[p].int:=w;
+end;
+@y
+@p procedure eq_word_define(@!p:pointer;@!w:integer);
+begin if xeq_level(p)<>cur_level then
+ begin eq_save(p,xeq_level(p)); set_xeq_level(p,cur_level);
+ end;
+set_new_eqtb_int(p,w);
+end;
+
+procedure del_eq_word_define(@!p:pointer;@!w,wone:integer);
+begin if xeq_level(p)<>cur_level then
+ begin eq_save(p,xeq_level(p)); set_xeq_level(p,cur_level);
+ end;
+set_equiv(p,w); set_equiv1(p,wone);
+end;
+
+@z
+%---------------------------------------
+@x [19] m.279 l.5990 - Omega
+begin eq_destroy(eqtb[p]);
+eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
+end;
+@#
+procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
+begin eqtb[p].int:=w; xeq_level[p]:=level_one;
+end;
+@y
+begin eq_destroy(new_eqtb(p));
+set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e);
+end;
+@#
+procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
+begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one);
+end;
+
+procedure del_geq_word_define(@!p:pointer;@!w,wone:integer);
+ {global |del_eq_word_define|}
+begin set_equiv(p,w); set_equiv1(p,wone); set_xeq_level(p,level_one);
+end;
+@z
+%---------------------------------------
+@x [19] m.282 l.6036 - Omega
+ else save_stack[save_ptr]:=eqtb[undefined_control_sequence];
+@y
+ else save_stack[save_ptr]:=new_eqtb(undefined_control_sequence);
+@z
+%---------------------------------------
+@x [19] m.283 l.6056 - Omega
+ else begin eq_destroy(eqtb[p]); {destroy the current value}
+ eqtb[p]:=save_stack[save_ptr]; {restore the saved value}
+ @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+ end
+else if xeq_level[p]<>level_one then
+ begin eqtb[p]:=save_stack[save_ptr]; xeq_level[p]:=l;
+@y
+ else begin eq_destroy(new_eqtb(p)); {destroy the current value}
+ set_new_eqtb(p,save_stack[save_ptr]); {restore the saved value}
+ @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+ end
+else if xeq_level(p)<>level_one then
+ begin set_new_eqtb(p,save_stack[save_ptr]); set_xeq_level(p,l);
+@z
+%---------------------------------------
+@x [20] m.289 l.6129 - Omega
+number $2^8m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{12}-1$@>| is larger than
+@y
+number $2^16m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{20}-1$@>| is larger than
+@z
+%---------------------------------------
+@x [20] m.289 l.6142 - Omega
+@d cs_token_flag==@'7777 {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~256, less~1}
+@d left_brace_token=@'0400 {$2^8\cdot|left_brace|$}
+@d left_brace_limit=@'1000 {$2^8\cdot(|left_brace|+1)$}
+@d right_brace_token=@'1000 {$2^8\cdot|right_brace|$}
+@d right_brace_limit=@'1400 {$2^8\cdot(|right_brace|+1)$}
+@d math_shift_token=@'1400 {$2^8\cdot|math_shift|$}
+@d tab_token=@'2000 {$2^8\cdot|tab_mark|$}
+@d out_param_token=@'2400 {$2^8\cdot|out_param|$}
+@d space_token=@'5040 {$2^8\cdot|spacer|+|" "|$}
+@d letter_token=@'5400 {$2^8\cdot|letter|$}
+@d other_token=@'6000 {$2^8\cdot|other_char|$}
+@d match_token=@'6400 {$2^8\cdot|match|$}
+@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
+@y
+@d cs_token_flag=@"FFFFF {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~65536, less~1}
+@d max_char_val=@"10000 {to separate char and command code}
+@d left_brace_token=@"10000 {$2^16\cdot|left_brace|$}
+@d left_brace_limit=@"20000 {$2^16\cdot(|left_brace|+1)$}
+@d right_brace_token=@"20000 {$2^16\cdot|right_brace|$}
+@d right_brace_limit=@"30000 {$2^16\cdot(|right_brace|+1)$}
+@d math_shift_token=@"30000 {$2^16\cdot|math_shift|$}
+@d tab_token=@"40000 {$2^16\cdot|tab_mark|$}
+@d out_param_token=@"50000 {$2^16\cdot|out_param|$}
+@d space_token=@"A0020 {$2^16\cdot|spacer|+|" "|$}
+@d letter_token=@"B0000 {$2^16\cdot|letter|$}
+@d other_token=@"C0000 {$2^16\cdot|other_char|$}
+@d match_token=@"D0000 {$2^16\cdot|match|$}
+@d end_match_token=@"E0000 {$2^16\cdot|end_match|$}
+@z
+%---------------------------------------
+@x [20] m.293 l.6256 - Omega
+else begin m:=info(p) div @'400; c:=info(p) mod @'400;
+@y
+else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val;
+@z
+%---------------------------------------
+@x [21] m.298 l.6375 - Omega
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@y
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+@z
+%---------------------------------------
+@x [24] m.334 l.7110 - Omega
+primitive("par",par_end,256); {cf. |scan_file_name|}
+@y
+primitive("par",par_end,too_big_char); {cf. |scan_file_name|}
+@z
+%---------------------------------------
+@x [24] m.357 l.7462 - Omega
+ else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400;
+@y
+ else begin cur_cmd:=t div max_char_val; cur_chr:=t mod max_char_val;
+@z
+%---------------------------------------
+@x [24] m.358 l.7479 - Omega
+@d no_expand_flag=257 {this characterizes a special variant of |relax|}
+@y
+@d no_expand_flag=special_char {this characterizes a special variant of |relax|}
+@z
+%---------------------------------------
+@x [24] m.365 l.7606 - Omega
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+@z
+%---------------------------------------
+@x [25] m.374 l.7728 - Omega
+ begin eq_define(cur_cs,relax,256); {N.B.: The |save_stack| might change}
+@y
+ begin eq_define(cur_cs,relax,too_big_char);
+ {N.B.: The |save_stack| might change}
+@z
+%---------------------------------------
+@x [25] m.374 l.7750 - Omega
+ buffer[j]:=info(p) mod @'400; incr(j); p:=link(p);
+@y
+ buffer[j]:=info(p) mod max_char_val; incr(j); p:=link(p);
+@z
+%---------------------------------------
+@x [25] m.380 l.7812 - Omega
+done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+done: if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+@z
+%---------------------------------------
+@x [25] m.381 l.7824 - Omega
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+@z
+%---------------------------------------
+@x [25] m.391 l.7985 - Omega
+if (info(r)>match_token+255)or(info(r)<match_token) then s:=null
+@y
+if (info(r)>=end_match_token)or(info(r)<match_token) then s:=null
+@z
+%---------------------------------------
+@x [26] m.407 l.8161 - Omega
+@ The |scan_left_brace| routine is called when a left brace is supposed to be
+the next non-blank token. (The term ``left brace'' means, more precisely,
+a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |left_brace|.
+
+@p procedure scan_left_brace; {reads a mandatory |left_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>left_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A left brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
+ cur_chr:="{"; incr(align_state);
+ end;
+end;
+@y
+@ The |scan_left_brace| routine is called when a left brace is supposed to be
+the next non-blank token. (The term ``left brace'' means, more precisely,
+a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |left_brace|.
+
+@p procedure scan_left_brace; {reads a mandatory |left_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>left_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A left brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
+ cur_chr:="{"; incr(align_state);
+ end;
+end;
+
+@ The |scan_right_brace| routine is called when a right brace is supposed to be
+the next non-blank token. (The term ``right brace'' means, more precisely,
+a character whose catcode is |right_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |right_brace|.
+
+@p procedure scan_right_brace; {reads a mandatory |right_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>right_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A right brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=right_brace_token+"}"; cur_cmd:=right_brace;
+ cur_chr:="}"; incr(align_state);
+ end;
+end;
+@z
+%---------------------------------------
+@x [26] m.410 l.8293 - Omega
+@!cur_val:integer; {value returned by numeric scanners}
+@y
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@!cur_val2:integer; {will be used in omxml.ch; this is cheating}
+@z
+%---------------------------------------
+@x [26] m.413 l.8335 - Omega
+assign_int: scanned_result(eqtb[m].int)(int_val);
+assign_dimen: scanned_result(eqtb[m].sc)(dimen_val);
+@y
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_dimen: scanned_result(new_eqtb_sc(m))(dimen_val);
+@z
+%---------------------------------------
+@x [26] m.413 l.8345 - Omega
+char_given,math_given: scanned_result(cur_chr)(int_val);
+@y
+char_given,math_given,omath_given: scanned_result(cur_chr)(int_val);
+@z
+%---------------------------------------
+@x [26] m.414 l.8356 - Omega
+@ @<Fetch a character code from some table@>=
+begin scan_char_num;
+if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val)
+else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else scanned_result(eqtb[m+cur_val].int)(int_val);
+@y
+@ @<Fetch a character code from some table@>=
+begin scan_char_num;
+if m=math_code_base then begin
+ cur_val1:=ho(math_code(cur_val));
+ if ((cur_val1 div @"1000000)>8) or
+ (((cur_val1 mod @"1000000) div @"10000)>15) or
+ ((cur_val1 mod @"10000)>255) then
+ begin print_err("Extended mathchar used as mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and ""7FFF.")@/
+ ("I changed this one to zero."); int_error(cur_val1); cur_val1:=0;
+ end;
+ cur_val1:=((cur_val1 div @"1000000)*@"1000) +
+ (((cur_val1 mod @"1000000) div @"10000)*@"100) +
+ (cur_val1 mod @"10000);
+ scanned_result(cur_val1)(int_val)
+ end
+else if m=(math_code_base+256) then
+ scanned_result(ho(math_code(cur_val)))(int_val)
+else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else scanned_result(new_eqtb_int(m+cur_val))(int_val);
+@z
+%---------------------------------------
+@x [26] m.433 l.8593 - Omega
+procedure scan_eight_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2("A register number must be between 0 and 255.")@/
+@y
+procedure scan_eight_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_reg) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2("A register number must be between 0 and 65535.")@/
+@z
+%---------------------------------------
+@x [26] m.434 l.8604 - Omega
+procedure scan_char_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad character code");
+@.Bad character code@>
+ help2("A character number must be between 0 and 255.")@/
+@y
+procedure scan_char_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_char) then
+ begin print_err("Bad character code");
+@.Bad character code@>
+ help2("A character number must be between 0 and 65535.")@/
+@z
+%---------------------------------------
+@x [26] m.435 l.8618 - Omega
+procedure scan_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>15) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@y
+procedure scan_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>15) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_big_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 255,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@z
+%---------------------------------------
+@x [26] m.436 l.8629 - Omega
+procedure scan_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@y
+procedure scan_real_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+cur_val := ((cur_val div @"1000) * @"1000000) +
+ (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+end;
+
+procedure scan_big_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@"7FFFFFF) then
+ begin print_err("Bad extended mathchar");
+@.Bad mathchar@>
+ help2("An extended mathchar number must be between 0 and ""7FFFFFF.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@z
+%---------------------------------------
+@x [26] m.437 l.8640 - Omega
+procedure scan_twenty_seven_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+@y
+procedure scan_twenty_seven_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+cur_val1 := (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+cur_val := cur_val div @"1000;
+cur_val := ((cur_val div @"1000) * @"1000000) +
+ (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+end;
+
+procedure scan_fifty_one_bit_int;
+var iiii:integer;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter (first part) must be between 0 and 2^{27}-1.")
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+iiii:=cur_val;
+scan_int;
+if (cur_val<0)or(cur_val>@"FFFFFF) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+help2("A numeric delimiter (second part) must be between 0 and 2^{24}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+cur_val1:=cur_val;
+cur_val:=iiii;
+end;
+
+procedure scan_string_argument;
+var s:integer;
+begin
+scan_left_brace;
+get_x_token;
+while (cur_cmd<>right_brace) do
+ begin
+ if (cur_cmd=letter) or (cur_cmd=other_char) then begin
+ str_room(1); append_char(cur_chr);
+ end
+ else if (cur_cmd=spacer) then begin
+ str_room(1); append_char(" ");
+ end
+ else begin
+ print_nl("Bad token appearing in string argument");
+ end;
+ get_x_token;
+ end;
+s:=make_string;
+if str_eq_str("mi",s) then s:="mi";
+if str_eq_str("mo",s) then s:="mo";
+if str_eq_str("mn",s) then s:="mn";
+cur_val:=s;
+end;
+@z
+%---------------------------------------
+@x [26] m.442 l.8720 - Omega
+if cur_val>255 then
+ begin print_err("Improper alphabetic constant");
+@y
+if cur_val>biggest_char then
+ begin print_err("Improper alphabetic constant");
+@z
+%---------------------------------------
+@x [27] m.468 l.9200 - Omega
+@d job_name_code=5 {command code for \.{\\jobname}}
+@y
+@d omega_code=5 {command code for \.{\\OmegaVersion}}
+@d job_name_code=6 {command code for \.{\\jobname}}
+@z
+%---------------------------------------
+@x [27] m.468 l.9200 - Omega
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+@y
+primitive("OmegaVersion",convert,omega_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+@z
+%---------------------------------------
+@x [27] m.469 l.9223 - Omega
+ othercases print_esc("jobname")
+@y
+ omega_code: print_esc("OmegaVersion");
+ othercases print_esc("jobname")
+@z
+%---------------------------------------
+@x [27] m.471 l.9248 - Omega
+job_name_code: if job_name=0 then open_log_file;
+@y
+omega_code:;
+job_name_code: if job_name=0 then open_log_file;
+@z
+%---------------------------------------
+@x [27] m.472 l.9258 - Omega
+job_name_code: print(job_name);
+@y
+omega_code: print("1.23.2.3");
+job_name_code: print(job_name);
+@z
+%---------------------------------------
+@x [28] m.491 l.9610 - Omega
+text(frozen_fi):="fi"; eqtb[frozen_fi]:=eqtb[cur_val];
+@y
+settext(frozen_fi,"fi"); set_new_eqtb(frozen_fi,new_eqtb(cur_val));
+@z
+%---------------------------------------
+@x [28] m.506 l.9802 - Omega
+if (cur_cmd>active_char)or(cur_chr>255) then {not a character}
+ begin m:=relax; n:=256;
+@y
+if (cur_cmd>active_char)or(cur_chr>biggest_char) then {not a character}
+ begin m:=relax; n:=too_big_char;
+@z
+%---------------------------------------
+@x [28] m.506 l.9808 - Omega
+if (cur_cmd>active_char)or(cur_chr>255) then
+ begin cur_cmd:=relax; cur_chr:=256;
+@y
+if (cur_cmd>active_char)or(cur_chr>biggest_char) then
+ begin cur_cmd:=relax; cur_chr:=too_big_char;
+@z
+%---------------------------------------
+@x [29] m.526 l.10178 - Omega
+loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character}
+@y
+loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then
+ {not a character}
+@z
+%---------------------------------------
+@x [37] m.780 l.15354 - Omega
+@d span_code=256 {distinct from any character}
+@d cr_code=257 {distinct from |span_code| and from any character}
+@y
+@d span_code=special_char {distinct from any character}
+@d cr_code=span_code+1 {distinct from |span_code| and from any character}
+@z
+%---------------------------------------
+@x [37] m.780 l.15364 - Omega
+text(frozen_cr):="cr"; eqtb[frozen_cr]:=eqtb[cur_val];@/
+primitive("crcr",car_ret,cr_cr_code);
+@!@:cr_cr_}{\.{\\crcr} primitive@>
+text(frozen_end_template):="endtemplate"; text(frozen_endv):="endtemplate";
+eq_type(frozen_endv):=endv; equiv(frozen_endv):=null_list;
+eq_level(frozen_endv):=level_one;@/
+eqtb[frozen_end_template]:=eqtb[frozen_endv];
+eq_type(frozen_end_template):=end_template;
+@y
+settext(frozen_cr,"cr");
+set_new_eqtb(frozen_cr,new_eqtb(cur_val));@/
+primitive("crcr",car_ret,cr_cr_code);
+@!@:cr_cr_}{\.{\\crcr} primitive@>
+settext(frozen_end_template,"endtemplate"); settext(frozen_endv,"endtemplate");
+set_eq_type(frozen_endv,endv); set_equiv(frozen_endv,null_list);
+set_eq_level(frozen_endv,level_one);@/
+set_new_eqtb(frozen_end_template,new_eqtb(frozen_endv));
+set_eq_type(frozen_end_template,end_template);
+@z
+%---------------------------------------
+@x [37] m.798 l.15651 - Omega
+if n>max_quarterword then confusion("256 spans"); {this can happen, but won't}
+@^system dependencies@>
+@:this can't happen 256 spans}{\quad 256 spans@>
+@y
+if n>max_quarterword then confusion("too many spans");
+ {this can happen, but won't}
+@^system dependencies@>
+@:this can't happen too many spans}{\quad too many spans@>
+@z
+%---------------------------------------
+@x [37] m.804 l.15794 - Omega
+ overfull_rule:=0; {prevent rule from being packaged}
+ p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save;
+@y
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,0);
+ {prevent rule from being packaged}
+ p:=hpack(preamble,saved(1),saved(0));
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,rule_save);
+@z
+%---------------------------------------
+@x [37] m.827 l.16255 - Omega
+check_shrinkage(left_skip); check_shrinkage(right_skip);@/
+@y
+if (shrink_order(left_skip)<>normal)and(shrink(left_skip)<>0) then
+ begin set_equiv(glue_base+left_skip_code,finite_shrink(left_skip));
+ end;
+if (shrink_order(right_skip)<>normal)and(shrink(right_skip)<>0) then
+ begin set_equiv(glue_base+right_skip_code,finite_shrink(right_skip));
+ end;
+@z
+%---------------------------------------
+@x [40] m.891 l.17434 - Omega
+$c_1$ will be treated as nonletters. The |hyphen_char| for that font
+must be between 0 and 255, otherwise hyphenation will not be attempted.
+@y
+$c_1$ will be treated as nonletters. The |hyphen_char| for that font must
+be between 0 and |biggest_char|, otherwise hyphenation will not be attempted.
+@z
+%---------------------------------------
+@x [40] m.892 l.17469 - Omega
+@!hc:array[0..65] of 0..256; {word to be hyphenated}
+@!hn:small_number; {the number of positions occupied in |hc|}
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@!hf:internal_font_number; {font number of the letters in |hc|}
+@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase}
+@!hyf_char:integer; {hyphen character of the relevant font}
+@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest}
+@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
+@!hyf_bchar:halfword; {boundary character after $c_n$}
+@y
+@!hc:array[0..65] of 0..too_big_char; {word to be hyphenated}
+@!hn:small_number; {the number of positions occupied in |hc|}
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@!hf:internal_font_number; {font number of the letters in |hc|}
+@!hu:array[0..63] of 0..too_big_char;
+ {like |hc|, before conversion to lowercase}
+@!hyf_char:integer; {hyphen character of the relevant font}
+@!cur_lang,@!init_cur_lang:0..biggest_lang;
+ {current hyphenation table of interest}
+@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
+@!hyf_bchar:halfword; {boundary character after $c_n$}
+@!max_hyph_char:integer;
+
+@ @<Set initial values of key variables@>=
+max_hyph_char:=too_big_lang;
+
+@z
+%---------------------------------------
+@x [40] m.893 l.17483 - Omega
+@!c:0..255; {character being considered for hyphenation}
+@y
+@!c:ASCII_code; {character being considered for hyphenation}
+@z
+%---------------------------------------
+@x [40] m.896 l.17534 - Omega
+if hyf_char>255 then goto done1;
+@y
+if hyf_char>biggest_char then goto done1;
+@z
+%---------------------------------------
+@x [40] m.897 l.17546 - Omega
+ if lc_code(c)=0 then goto done3;
+@y
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+@z
+%---------------------------------------
+@x [40] m.898 l.17572 - Omega
+ if lc_code(c)=0 then goto done3;
+@y
+ if lc_code(c)=0 then goto done3;
+ if lc_code(c)>max_hyph_char then goto done3;
+@z
+%---------------------------------------
+@x [41] m.903 l.17648 - Omega
+ begin hu[0]:=256; init_lig:=false;
+@y
+ begin hu[0]:=max_hyph_char; init_lig:=false;
+@z
+%---------------------------------------
+@x [41] m.903 l.17660 - Omega
+found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null;
+@y
+found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null;
+@z
+%---------------------------------------
+@x [41] m.905 l.17707 - Omega
+getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=256$,
+we consider $x_j$ to be an implicit left boundary character; in this
+case |j| must be strictly less than~|n|. There is a
+parameter |bchar|, which is either 256 or an implicit right boundary character
+@y
+getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=|max_hyph_char|$,
+we consider $x_j$ to be an implicit left boundary character; in this
+case |j| must be strictly less than~|n|. There is a
+parameter |bchar|, which is either |max_hyph_char|
+or an implicit right boundary character
+@z
+%---------------------------------------
+@x [41] m.916 l.17980 - Omega
+ begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256;
+@y
+ begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char;
+@z
+%---------------------------------------
+@x [42] m.921 l.18079 - Omega
+@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language}
+@y
+@!op_start:array[0..biggest_lang] of 0..trie_op_size;
+ {offset for current language}
+@z
+%---------------------------------------
+@x [42] m.923 l.18086 - Omega
+hyphenation algorithm is quite short. In the following code we set |hc[hn+2]|
+to the impossible value 256, in order to guarantee that |hc[hn+3]| will
+@y
+hyphenation algorithm is quite short. In the following code we set |hc[hn+2]| to
+the impossible value |max_hyph_char|, in order to guarantee that |hc[hn+3]| will
+@z
+%---------------------------------------
+@x [42] m.923 l.18095 - Omega
+hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters}
+@y
+hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters}
+@z
+%---------------------------------------
+@x [42] m.934 l.18206 - Omega
+@d set_cur_lang==if language<=0 then cur_lang:=0
+ else if language>255 then cur_lang:=0
+@y
+@d set_cur_lang==if language<=0 then cur_lang:=0
+ else if language>biggest_lang then cur_lang:=0
+@z
+%---------------------------------------
+@x [43] m.943 l.18348 - Omega
+@!trie_used:array[ASCII_code] of quarterword;
+ {largest opcode used so far for this language}
+@!trie_op_lang:array[1..trie_op_size] of ASCII_code;
+@y
+@!trie_used:array[0..biggest_lang] of quarterword;
+ {largest opcode used so far for this language}
+@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang;
+@z
+%---------------------------------------
+@x [43] m.945 l.18400 - Omega
+for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
+@y
+for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
+@z
+%---------------------------------------
+@x [43] m.946 l.18416 - Omega
+for k:=0 to 255 do trie_used[k]:=min_quarterword;
+@y
+for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;
+@z
+%---------------------------------------
+@x [43] m.947 l.18438 - Omega
+@!init @!trie_c:packed array[trie_pointer] of packed_ASCII_code;
+@y
+@!init @!trie_c:packed array[trie_pointer] of ASCII_code;
+@z
+%---------------------------------------
+@x [43] m.952 l.18551 - Omega
+for p:=0 to 255 do trie_min[p]:=p+1;
+@y
+for p:=0 to biggest_char do trie_min[p]:=p+1;
+@z
+%---------------------------------------
+@x [43] m.953 l.18569 - Omega
+@!ll:1..256; {upper limit of |trie_min| updating}
+@y
+@!ll:1..too_big_char; {upper limit of |trie_min| updating}
+@z
+%---------------------------------------
+@x [43] m.953 l.18573 - Omega
+ @<Ensure that |trie_max>=h+256|@>;
+@y
+ @<Ensure that |trie_max>=h+max_hyph_char|@>;
+@z
+%---------------------------------------
+@x [43] m.954 l.18582 - Omega
+@ By making sure that |trie_max| is at least |h+256|, we can be sure that
+|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
+never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
+
+@<Ensure that |trie_max>=h+256|@>=
+if trie_max<h+256 then
+ begin if trie_size<=h+256 then overflow("pattern memory",trie_size);
+@y
+@ By making sure that |trie_max| is at least |h+max_hyph_char|,
+we can be sure that
+|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
+never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
+
+@<Ensure that |trie_max>=h+max_hyph_char|@>=
+if trie_max<h+max_hyph_char then
+ begin if trie_size<=h+max_hyph_char then overflow("pattern memory",trie_size);
+@z
+%---------------------------------------
+@x [43] m.954 l.18592 - Omega
+ until trie_max=h+256;
+@y
+ until trie_max=h+max_hyph_char;
+@z
+%---------------------------------------
+@x [43] m.956 l.18607 - Omega
+if l<256 then
+ begin if z<256 then ll:=z @+else ll:=256;
+@y
+if l<max_hyph_char then
+ begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char;
+@z
+%---------------------------------------
+@x [43] m.958 l.18637 - Omega
+if trie_root=0 then {no patterns were given}
+ begin for r:=0 to 256 do trie[r]:=h;
+ trie_max:=256;
+@y
+if trie_root=0 then {no patterns were given}
+ begin for r:=0 to max_hyph_char do trie[r]:=h;
+ trie_max:=max_hyph_char;
+@z
+%---------------------------------------
+@x [43] m.962 l.18714 - Omega
+@ @<Append a new letter or a hyphen level@>=
+if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
+ begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter}
+ else begin cur_chr:=lc_code(cur_chr);
+ if cur_chr=0 then
+ begin print_err("Nonletter");
+@.Nonletter@>
+ help1("(See Appendix H.)"); error;
+ end;
+ end;
+@y
+@ @<Append a new letter or a hyphen level@>=
+if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
+ begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter}
+ else begin cur_chr:=lc_code(cur_chr);
+ if cur_chr=0 then
+ begin print_err("Nonletter");
+@.Nonletter@>
+ help1("(See Appendix H.)"); error;
+ end;
+ end;
+ if cur_chr>max_hyph_char then max_hyph_char:=cur_chr;
+@z
+%---------------------------------------
+@x [43] m.966 l. - Omega
+procedure init_trie;
+var @!p:trie_pointer; {pointer for initialization}
+@!j,@!k,@!t:integer; {all-purpose registers for initialization}
+@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
+@!h:two_halves; {template used to zero out |trie|'s holes}
+begin @<Get ready to compress the trie@>;
+@y
+procedure init_trie;
+var @!p:trie_pointer; {pointer for initialization}
+@!j,@!k,@!t:integer; {all-purpose registers for initialization}
+@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
+@!h:two_halves; {template used to zero out |trie|'s holes}
+begin
+incr(max_hyph_char);
+@<Get ready to compress the trie@>;
+@z
+%---------------------------------------
+@x [44] m.977 l.19008 - Omega
+if q=null then box(n):=null {the |eq_level| of the box stays the same}
+else box(n):=vpack(q,natural);
+@y
+if q=null then set_equiv(box_base+n,null)
+ {the |eq_level| of the box stays the same}
+else set_equiv(box_base+n,vpack(q,natural));
+@z
+%---------------------------------------
+@x [45] m.992 l.24928 - Omega
+flush_node_list(box(n)); box(n):=null;
+@y
+flush_node_list(box(n)); set_equiv(box_base+n,null);
+@z
+%---------------------------------------
+@x [45] m.994 l.19364 - Omega
+@!n:min_quarterword..255; {insertion box number}
+@y
+@!n:min_quarterword..biggest_reg; {insertion box number}
+@z
+%---------------------------------------
+@x [45] m.1012 l.19655 - Omega
+@!n:min_quarterword..255; {insertion box number}
+@y
+@!n:min_quarterword..biggest_reg; {insertion box number}
+@z
+%---------------------------------------
+@x [45] m.1014 l.19710 - Omega
+split_top_skip:=save_split_top_skip;
+@y
+set_equiv(glue_base+split_top_skip_code,save_split_top_skip);
+@z
+%---------------------------------------
+@x [45] m.1017 l.19753 - Omega
+save_vbadness:=vbadness; vbadness:=inf_bad;
+save_vfuzz:=vfuzz; vfuzz:=max_dimen; {inhibit error messages}
+box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth);
+vbadness:=save_vbadness; vfuzz:=save_vfuzz;
+@y
+save_vbadness:=vbadness;
+set_new_eqtb_int(int_base+vbadness_code,inf_bad);
+save_vfuzz:=vfuzz;
+set_new_eqtb_sc(dimen_base+vfuzz_code,max_dimen);
+ {inhibit error messages}
+set_equiv(box_base+255,
+ vpackage(link(page_head),best_size,exactly,page_max_depth));
+set_new_eqtb_int(int_base+vbadness_code,save_vbadness);
+set_new_eqtb_sc(dimen_base+vfuzz_code,save_vfuzz);
+@z
+%---------------------------------------
+@x [45] m.1018 l.19774 - Omega
+ if box(n)=null then box(n):=new_null_box;
+@y
+ if box(n)=null then set_equiv(box_base+n,new_null_box);
+@z
+%---------------------------------------
+@x [45] m.1021 l.19817 - Omega
+ split_top_skip:=split_top_ptr(p);
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+ if ins_ptr(p)<>null then
+ begin temp_ptr:=vpack(ins_ptr(p),natural);
+ height(p):=height(temp_ptr)+depth(temp_ptr);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+box(n):=vpack(temp_ptr,natural);
+@y
+ set_equiv(glue_base+split_top_skip_code,split_top_ptr(p));
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+ if ins_ptr(p)<>null then
+ begin temp_ptr:=vpack(ins_ptr(p),natural);
+ height(p):=height(temp_ptr)+depth(temp_ptr);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+set_equiv(box_base+n,vpack(temp_ptr,natural));
+@z
+%---------------------------------------
+@x [45] m.1023 l.19854 - Omega
+ship_out(box(255)); box(255):=null;
+@y
+ship_out(box(255)); set_equiv(box_base+255,null);
+@z
+%---------------------------------------
+@x [46] m.1046 l.20339 - Omega
+non_math(math_given), non_math(math_comp), non_math(delim_num),
+@y
+non_math(math_given), non_math(omath_given),
+non_math(math_comp), non_math(delim_num),
+@z
+%---------------------------------------
+@x [47] m.1071 l.20718 - Omega
+|box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}';
+codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox255}';
+code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513|
+through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}',
+@y
+|box_flag+biggest_reg| represent `\.{\\setbox0}' through
+`\.{\\setbox}|biggest_reg|'; codes |box_flag+biggest_reg+1| through
+|box_flag+2*biggest_reg| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox}|biggest_reg|'; code |box_flag+2*number_regs|
+represents `\.{\\shipout}'; and codes |box_flag+2*number_regs+1|
+through |box_flag+2*number_regs+3| represent `\.{\\leaders}', `\.{\\cleaders}',
+@z
+%---------------------------------------
+@x [47] m.1071 l.20732 - Omega
+@d ship_out_flag==box_flag+512 {context code for `\.{\\shipout}'}
+@d leader_flag==box_flag+513 {context code for `\.{\\leaders}'}
+@y
+@d ship_out_flag==box_flag+(number_regs+number_regs)
+ {context code for `\.{\\shipout}'}
+@d leader_flag==ship_out_flag+1 {context code for `\.{\\leaders}'}
+@z
+%---------------------------------------
+@x [47] m.1077 l.20853 - Omega
+if box_context<box_flag+256 then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-256+box_context,box_ref,cur_box)
+@y
+if box_context<box_flag+number_regs then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box)
+@z
+%---------------------------------------
+@x [47] m.1079 l.20888 - Omega
+ box(cur_val):=null; {the box becomes void, at the same level}
+@y
+ set_equiv(box_base+cur_val,null);
+ {the box becomes void, at the same level}
+@z
+%---------------------------------------
+@x [47] m.1100 l.21156 - Omega
+ if saved(0)<255 then
+@y
+ if saved(0)<>255 then
+@z
+%---------------------------------------
+@x [47] m.1109 l.21265 - Omega
+@ The |un_hbox| and |un_vbox| commands unwrap one of the 256 current boxes.
+@y
+@ The |un_hbox| and |un_vbox| commands unwrap one of the current boxes.
+@z
+%---------------------------------------
+@x [47] m.1110 l.21287 - Omega
+else begin link(tail):=list_ptr(p); box(cur_val):=null;
+@y
+else begin link(tail):=list_ptr(p);
+set_equiv(box_base+cur_val,null);
+@z
+%---------------------------------------
+@x [47] m.1117 l.21342 - Omega
+ if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c);
+@y
+ if c>=0 then if c<=biggest_char then
+ pre_break(tail):=new_character(cur_font,c);
+@z
+%---------------------------------------
+@x [48] m.1151 l.21810 - Omega
+@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are
+broken down into subfields called |math_type| and either |info| or
+|(fam,character)|. The job of |scan_math| is to figure out what to place
+in one of these principal fields; it looks at the subformula that
+comes next in the input, and places an encoding of that subformula
+into a given word of |mem|.
+
+@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
+
+@<Declare act...@>=
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:case cur_cmd of
+letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
+ end;
+math_given: c:=cur_chr;
+delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod 256);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div 256) mod 16;
+exit:end;
+@y
+@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are
+broken down into subfields called |math_type| and either |info| or
+|(fam,character)|. The job of |scan_math| is to figure out what to place
+in one of these principal fields; it looks at the subformula that
+comes next in the input, and places an encoding of that subformula
+into a given word of |mem|.
+
+@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
+
+@<Declare act...@>=
+@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
+
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:
+case cur_cmd of
+letter,other_char,char_given: begin
+ c:=ho(math_code(cur_chr));
+ if c=@"8000000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin
+ if cur_chr=0 then scan_fifteen_bit_int
+ else scan_big_fifteen_bit_int;
+ c:=cur_val;
+ end;
+math_given: begin
+ c := ((cur_chr div @"1000) * @"1000000) +
+ (((cur_chr mod @"1000) div @"100) * @"10000) +
+ (cur_chr mod @"100);
+ end;
+omath_given: begin c:=cur_chr;
+ end;
+delim_num: begin
+ if cur_chr=0 then scan_twenty_seven_bit_int
+ else scan_fifty_one_bit_int;
+ c:=cur_val;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod @"10000);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div @"10000) mod @"100;
+exit:end;
+@z
+%---------------------------------------
+@x [48] m.1154 l.21860 - Omega
+mmode+letter,mmode+other_char,mmode+char_given:
+ set_math_char(ho(math_code(cur_chr)));
+mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
+ set_math_char(ho(math_code(cur_chr)));
+ end;
+mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val);
+ end;
+mmode+math_given: set_math_char(cur_chr);
+mmode+delim_num: begin scan_twenty_seven_bit_int;
+ set_math_char(cur_val div @'10000);
+@y
+mmode+letter,mmode+other_char,mmode+char_given:
+ set_math_char(ho(math_code(cur_chr)));
+mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
+ set_math_char(ho(math_code(cur_chr)));
+ end;
+mmode+math_char_num: begin
+ if cur_chr=0 then scan_fifteen_bit_int
+ else scan_big_fifteen_bit_int;
+ set_math_char(cur_val);
+ end;
+mmode+math_given: begin
+ set_math_char(((cur_chr div @"1000) * @"1000000) +
+ (((cur_chr mod @"1000) div @"100) * @"10000) +
+ (cur_chr mod @"100));
+ end;
+mmode+omath_given: begin
+ set_math_char(cur_chr);
+ end;
+mmode+delim_num: begin
+ if cur_chr=0 then scan_twenty_seven_bit_int
+ else scan_fifty_one_bit_int;
+ set_math_char(cur_val);
+@z
+%---------------------------------------
+@x [48] m.1155 l.21878 - Omega
+procedure set_math_char(@!c:integer);
+var p:pointer; {the new noad}
+begin if c>=@'100000 then
+ @<Treat |cur_chr|...@>
+else begin p:=new_noad; math_type(nucleus(p)):=math_char;
+ character(nucleus(p)):=qi(c mod 256);
+ fam(nucleus(p)):=(c div 256) mod 16;
+ if c>=var_code then
+ begin if fam_in_range then fam(nucleus(p)):=cur_fam;
+ type(p):=ord_noad;
+ end
+ else type(p):=ord_noad+(c div @'10000);
+ link(tail):=p; tail:=p;
+ end;
+end;
+@y
+procedure set_math_char(@!c:integer);
+var p,q,r:pointer; {the new noad}
+begin if c>=@"8000000 then
+ @<Treat |cur_chr|...@>
+else begin p:=new_noad; math_type(nucleus(p)):=math_char;
+ character(nucleus(p)):=qi(c mod @"10000);
+ fam(nucleus(p)):=(c div @"10000) mod @"100;
+ if c>=var_code then
+ begin if fam_in_range then fam(nucleus(p)):=cur_fam;
+ type(p):=ord_noad;
+ end
+ else type(p):=ord_noad+(c div @"1000000);
+ link(tail):=p; tail:=p;
+ end;
+end;
+@z
+%---------------------------------------
+@x [48] m.1160 l.21966 - Omega
+procedure scan_delimiter(@!p:pointer;@!r:boolean);
+begin if r then scan_twenty_seven_bit_int
+else begin @<Get the next non-blank non-relax...@>;
+ case cur_cmd of
+ letter,other_char: cur_val:=del_code(cur_chr);
+ delim_num: scan_twenty_seven_bit_int;
+ othercases cur_val:=-1
+ endcases;
+ end;
+if cur_val<0 then @<Report that an invalid delimiter code is being changed
+ to null; set~|cur_val:=0|@>;
+small_fam(p):=(cur_val div @'4000000) mod 16;
+small_char(p):=qi((cur_val div @'10000) mod 256);
+large_fam(p):=(cur_val div 256) mod 16;
+large_char(p):=qi(cur_val mod 256);
+@y
+procedure scan_delimiter(@!p:pointer;@!r:integer);
+begin if r=1 then scan_twenty_seven_bit_int
+else if r=2 then scan_fifty_one_bit_int
+else begin @<Get the next non-blank non-relax...@>;
+ case cur_cmd of
+ letter,other_char: begin
+ cur_val:=del_code0(cur_chr); cur_val1:=del_code1(cur_chr);
+ end;
+ delim_num: if cur_chr=0 then scan_twenty_seven_bit_int
+ else scan_fifty_one_bit_int;
+ othercases begin cur_val:=-1; cur_val1:=-1; end;
+ endcases;
+ end;
+if cur_val<0 then begin @<Report that an invalid delimiter code is being changed
+ to null; set~|cur_val:=0|@>;
+ cur_val1:=0;
+ end;
+small_fam(p):=(cur_val div @"10000) mod @"100;
+small_char(p):=qi(cur_val mod @"10000);
+large_fam(p):=(cur_val1 div @"10000) mod @"100;
+large_char(p):=qi(cur_val1 mod @"10000);
+@z
+%---------------------------------------
+@x [48] m.1163 l.22005 - Omega
+scan_delimiter(left_delimiter(tail),true); scan_math(nucleus(tail));
+@y
+scan_delimiter(left_delimiter(tail),cur_chr+1); scan_math(nucleus(tail));
+@z
+%---------------------------------------
+@x [48] m.1165 l.22012 - Omega
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+math_type(accent_chr(tail)):=math_char;
+scan_fifteen_bit_int;
+character(accent_chr(tail)):=qi(cur_val mod 256);
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
+scan_math(nucleus(tail));
+end;
+@y
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+math_type(accent_chr(tail)):=math_char;
+if cur_chr=0 then scan_fifteen_bit_int
+else scan_big_fifteen_bit_int;
+character(accent_chr(tail)):=qi(cur_val mod @"10000);
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div @"10000) mod @"100;
+scan_math(nucleus(tail));
+end;
+@z
+%---------------------------------------
+@x [48] m.1174 l.22085 - Omega
+@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
+@y
+@z
+%---------------------------------------
+@x [48] m.1188 l.22284 - Omega
+text(frozen_right):="right"; eqtb[frozen_right]:=eqtb[cur_val];
+@y
+settext(frozen_right,"right");
+set_new_eqtb(frozen_right,new_eqtb(cur_val));
+@z
+%---------------------------------------
+@x [49] m.1214 l.22700 - Omega
+@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
+@y
+@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
+@d del_word_define(#)==if global
+ then del_geq_word_define(#)@+else del_eq_word_define(#)
+@z
+%---------------------------------------
+@x [49] m.1216 l.22734 - Omega
+text(frozen_protection):="inaccessible";
+@y
+settext(frozen_protection,"inaccessible");
+@z
+%---------------------------------------
+@x [49] m.1222 l.22789 - Omega
+@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
+@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
+@d count_def_code=2 {|shorthand_def| for \.{\\countdef}}
+@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
+@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
+@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
+@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+
+@<Put each...@>=
+primitive("chardef",shorthand_def,char_def_code);@/
+@!@:char_def_}{\.{\\chardef} primitive@>
+primitive("mathchardef",shorthand_def,math_char_def_code);@/
+@!@:math_char_def_}{\.{\\mathchardef} primitive@>
+@y
+@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
+@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
+@d omath_char_def_code=2 {|shorthand_def| for \.{\\omathchardef}}
+@d count_def_code=3 {|shorthand_def| for \.{\\countdef}}
+@d dimen_def_code=4 {|shorthand_def| for \.{\\dimendef}}
+@d skip_def_code=5 {|shorthand_def| for \.{\\skipdef}}
+@d mu_skip_def_code=6 {|shorthand_def| for \.{\\muskipdef}}
+@d toks_def_code=7 {|shorthand_def| for \.{\\toksdef}}
+
+@<Put each...@>=
+primitive("chardef",shorthand_def,char_def_code);@/
+@!@:char_def_}{\.{\\chardef} primitive@>
+primitive("mathchardef",shorthand_def,math_char_def_code);@/
+@!@:math_char_def_}{\.{\\mathchardef} primitive@>
+primitive("omathchardef",shorthand_def,omath_char_def_code);@/
+@!@:math_char_def_}{\.{\\omathchardef} primitive@>
+@z
+%---------------------------------------
+@x [49] m.1224 l.22833 - Omega
+shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
+ scan_optional_equals;
+ case n of
+ char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
+ end;
+@y
+shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs;
+ define(p,relax,too_big_char); scan_optional_equals;
+ case n of
+ char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_real_fifteen_bit_int;
+ define(p,math_given,cur_val);
+ end;
+ omath_char_def_code: begin scan_big_fifteen_bit_int;
+ define(p,omath_given,cur_val);
+ end;
+@z
+%---------------------------------------
+@x [49] m.1230 l. - Omega
+primitive("mathcode",def_code,math_code_base);
+@!@:math_code_}{\.{\\mathcode} primitive@>
+primitive("lccode",def_code,lc_code_base);
+@!@:lc_code_}{\.{\\lccode} primitive@>
+primitive("uccode",def_code,uc_code_base);
+@!@:uc_code_}{\.{\\uccode} primitive@>
+primitive("sfcode",def_code,sf_code_base);
+@!@:sf_code_}{\.{\\sfcode} primitive@>
+primitive("delcode",def_code,del_code_base);
+@!@:del_code_}{\.{\\delcode} primitive@>
+@y
+primitive("mathcode",def_code,math_code_base);
+@!@:math_code_}{\.{\\mathcode} primitive@>
+primitive("omathcode",def_code,math_code_base+256);
+@!@:math_code_}{\.{\\omathcode} primitive@>
+primitive("lccode",def_code,lc_code_base);
+@!@:lc_code_}{\.{\\lccode} primitive@>
+primitive("uccode",def_code,uc_code_base);
+@!@:uc_code_}{\.{\\uccode} primitive@>
+primitive("sfcode",def_code,sf_code_base);
+@!@:sf_code_}{\.{\\sfcode} primitive@>
+primitive("delcode",def_code,del_code_base);
+@!@:del_code_}{\.{\\delcode} primitive@>
+primitive("odelcode",def_code,del_code_base+256);
+@!@:del_code_}{\.{\\odelcode} primitive@>
+@z
+%---------------------------------------
+@x [49] m.1232 l.22990 - Omega
+def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
+ p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+ if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
+ begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+ if p<del_code_base then print("), should be in the range 0..")
+ else print("), should be at most ");
+ print_int(n);
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val:=0;
+ end;
+ if p<math_code_base then define(p,data,cur_val)
+ else if p<del_code_base then define(p,data,hi(cur_val))
+ else word_define(p,cur_val);
+@y
+def_code: begin
+ if cur_chr=(del_code_base+256) then begin
+ p:=cur_chr-256; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int; cur_val1:=cur_val; scan_int; {backwards}
+ if (cur_val1>@"FFFFFF) or (cur_val>@"FFFFFF) then
+ begin print_err("Invalid code ("); print_int(cur_val1); print(" ");
+ print_int(cur_val);
+ print("), should be at most ""FFFFFF ""FFFFFF");
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val1:=0; cur_val:=0;
+ end;
+ del_word_define(p,cur_val1,cur_val);
+ end
+ else begin
+ @<Let |n| be the largest legal code value, based on |cur_chr|@>;
+ p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+ if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
+ begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+ if p<del_code_base then print("), should be in the range 0..")
+ else print("), should be at most ");
+ print_int(n);
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val:=0;
+ end;
+ if p<math_code_base then define(p,data,cur_val)
+ else if p<(math_code_base+256) then begin
+ if cur_val=@"8000 then cur_val:=@"8000000
+ else cur_val:=((cur_val div @"1000) * @"1000000) +
+ (((cur_val mod @"1000) div @"100) * @"10000) +
+ (cur_val mod @"100);
+ define(p,data,hi(cur_val));
+ end
+ else if p<del_code_base then define(p-256,data,hi(cur_val))
+ else begin
+ cur_val1:=cur_val div @"1000;
+ cur_val1:=(cur_val1 div @"100)*@"10000 + (cur_val1 mod @"100);
+ cur_val:=cur_val mod @"1000;
+ cur_val:=(cur_val div @"100)*@"10000 + (cur_val mod @"100);
+ del_word_define(p,cur_val1,cur_val);
+ end;
+ end;
+@z
+%---------------------------------------
+@x [49] m.1233 l.22990 - Omega
+if cur_chr=cat_code_base then n:=max_char_code
+else if cur_chr=math_code_base then n:=@'100000
+else if cur_chr=sf_code_base then n:=@'77777
+else if cur_chr=del_code_base then n:=@'77777777
+else n:=255
+@y
+if cur_chr=cat_code_base then n:=max_char_code
+else if cur_chr=math_code_base then n:=@'100000
+else if cur_chr=(math_code_base+256) then n:=@"8000000
+else if cur_chr=sf_code_base then n:=@'77777
+else if cur_chr=del_code_base then n:=@'77777777
+else n:=biggest_char
+@z
+%---------------------------------------
+@x [49] m.1234 l.22990 - Omega
+def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val;
+@y
+def_family: begin p:=cur_chr; scan_big_four_bit_int; p:=p+cur_val;
+@z
+%---------------------------------------
+@x [49] m.1238 l.23059 - Omega
+ if q=advance then cur_val:=cur_val+eqtb[l].int;
+@y
+ if q=advance then cur_val:=cur_val+new_eqtb_int(l);
+@z
+%---------------------------------------
+@x [49] m.1240 l.23086 - Omega
+ if p=int_val then cur_val:=mult_integers(eqtb[l].int,cur_val)
+ else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0)
+ else cur_val:=x_over_n(eqtb[l].int,cur_val)
+@y
+ if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val)
+ else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0)
+ else cur_val:=x_over_n(new_eqtb_int(l),cur_val)
+@z
+%---------------------------------------
+@x [49] m.1241 l.23109 - Omega
+ if global then n:=256+cur_val@+else n:=cur_val;
+@y
+ if global then n:=number_regs+cur_val@+else n:=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1289 l.23546 - Omega
+|cs_token_flag+active_base| is a multiple of~256.
+@y
+|cs_token_flag+active_base| is a multiple of~|max_char_val|.
+@z
+%---------------------------------------
+@x [49] m.1289 l.23552 - Omega
+ begin c:=t mod 256;
+@y
+ begin c:=t mod max_char_val;
+@z
+%---------------------------------------
+@x [50] m.1313 l.23892 - Omega
+@<Dump regions 1 to 4 of |eqtb|@>;
+@<Dump regions 5 and 6 of |eqtb|@>;
+@y
+dump_eqtb_table;
+@z
+%---------------------------------------
+@x [50] m.1314 l.23904 - Omega
+@<Undump regions 1 to 6 of |eqtb|@>;
+@y
+undump_eqtb_table;
+@z
+%---------------------------------------
+@x [50] m.1315 l.23904 - Omega
+@ The table of equivalents usually contains repeated information, so we dump it
+in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the
+format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra
+copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$.
+
+@<Dump regions 1 to 4 of |eqtb|@>=
+k:=active_base;
+repeat j:=k;
+while j<int_base-1 do
+ begin if (equiv(j)=equiv(j+1))and(eq_type(j)=eq_type(j+1))and@|
+ (eq_level(j)=eq_level(j+1)) then goto found1;
+ incr(j);
+ end;
+l:=int_base; goto done1; {|j=int_base-1|}
+found1: incr(j); l:=j;
+while j<int_base-1 do
+ begin if (equiv(j)<>equiv(j+1))or(eq_type(j)<>eq_type(j+1))or@|
+ (eq_level(j)<>eq_level(j+1)) then goto done1;
+ incr(j);
+ end;
+done1:dump_int(l-k);
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+k:=j+1; dump_int(k-l);
+until k=int_base
+
+@ @<Dump regions 5 and 6 of |eqtb|@>=
+repeat j:=k;
+while j<eqtb_size do
+ begin if eqtb[j].int=eqtb[j+1].int then goto found2;
+ incr(j);
+ end;
+l:=eqtb_size+1; goto done2; {|j=eqtb_size|}
+found2: incr(j); l:=j;
+while j<eqtb_size do
+ begin if eqtb[j].int<>eqtb[j+1].int then goto done2;
+ incr(j);
+ end;
+done2:dump_int(l-k);
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+k:=j+1; dump_int(k-l);
+until k>eqtb_size
+
+@ @<Undump regions 1 to 6 of |eqtb|@>=
+k:=active_base;
+repeat undump_int(x);
+if (x<1)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do undump_wd(eqtb[j]);
+k:=k+x;
+undump_int(x);
+if (x<0)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do eqtb[j]:=eqtb[k-1];
+k:=k+x;
+until k>eqtb_size
+@y
+
+@z
+%---------------------------------------
+@x [50] m.1318 l.23967 - Omega
+@<Dump the hash table@>=
+dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used;
+for p:=hash_base to hash_used do if text(p)<>0 then
+ begin dump_int(p); dump_hh(hash[p]); incr(cs_count);
+ end;
+for p:=hash_used+1 to undefined_control_sequence-1 do dump_hh(hash[p]);
+dump_int(cs_count);@/
+print_ln; print_int(cs_count); print(" multiletter control sequences")
+@y
+@<Dump the hash table@>=
+dump_int(hash_used);
+@z
+%---------------------------------------
+@x [50] m.1319 l.23976 - Omega
+undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1;
+repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]);
+until p=hash_used;
+for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]);
+undump_int(cs_count)
+@y
+undump(hash_base)(frozen_control_sequence)(hash_used);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24066 - Omega
+for k:=0 to trie_max do dump_hh(trie[k]);
+@y
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(max_hyph_char);
+@z
+%---------------------------------------
+@x [50] m.1324 l.24078 - Omega
+for k:=255 downto 0 do if trie_used[k]>min_quarterword then
+@y
+for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then
+@z
+%---------------------------------------
+@x [50] m.1325 l.24094 - Omega
+for k:=0 to j do undump_hh(trie[k]);
+@y
+for k:=0 to j do undump_hh(trie[k]);
+undump_int(max_hyph_char);
+@z
+%---------------------------------------
+@x [50] m.1325 l.24101 - Omega
+init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/
+k:=256;
+@y
+init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/
+k:=biggest_lang+1;
+@z
+%---------------------------------------
+@x [50] m.1326 l.24100 - Omega
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+tracing_stats:=0
+@y
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+set_new_eqtb_int(int_base+tracing_stats_code,0)
+@z
+%---------------------------------------
+@x [53] m.1341 l.24506 - Omega
+@d what_lang(#)==link(#+1) {language number, in the range |0..255|}
+@y
+@d what_lang(#)==link(#+1) {language number, in the range |0..biggest_lang|}
+@z
+%---------------------------------------
+@x [53] m.1370
+@!write_file:array[0..15] of alpha_file;
+@y
+@!outside_string_array: array[0..1000] of 0..255;
+@!write_file:array[0..15] of alpha_file;
+@z
+%---------------------------------------
+@x [53] m. l.24761 - Omega
+text(end_write):="endwrite"; eq_level(end_write):=level_one;
+eq_type(end_write):=outer_call; equiv(end_write):=null;
+@y
+settext(end_write,"endwrite"); set_eq_level(end_write,level_one);
+set_eq_type(end_write,outer_call); set_equiv(end_write,null);
+@z
+%---------------------------------------
+@x [53] m.1376 l.24878 - Omega
+else if language>255 then l:=0
+@y
+else if language>biggest_lang then l:=0
+@z
+%---------------------------------------
+@x [53] m.1377 l.24893 - Omega
+ else if cur_val>255 then clang:=0
+@y
+ else if cur_val>biggest_lang then clang:=0
+@z
+%---------------------------------------
+@x [54]
+This section should be replaced, if necessary, by any special
+modifications of the program
+that are necessary to make \TeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@y
+@* \[54] $\Omega$ changes.
+
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir/omchar.ch b/Build/source/texk/web2c/omegadir/omchar.ch
new file mode 100644
index 00000000000..bb2b8b19567
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omchar.ch
@@ -0,0 +1,84 @@
+% omchar.ch: Primitives to access the components of font metric files.
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [26] m.416 l.8407 - Omega char dimensions
+primitive("dp",set_box_dimen,depth_offset);
+@!@:dp_}{\.{\\dp} primitive@>
+@y
+primitive("dp",set_box_dimen,depth_offset);
+@!@:dp_}{\.{\\dp} primitive@>
+primitive("charwd",set_box_dimen,(width_offset+3));
+@!@:charwd_}{\.{\\charwd} primitive@>
+primitive("charht",set_box_dimen,(height_offset+3));
+@!@:charht_}{\.{\\charht} primitive@>
+primitive("chardp",set_box_dimen,(depth_offset+3));
+@!@:chardp_}{\.{\\chardp} primitive@>
+primitive("charit",set_box_dimen,(depth_offset+4));
+@!@:charit_}{\.{\\charit} primitive@>
+@z
+%---------------------------------------
+@x [26] m.416 l.8425 - Omega char dimensions
+set_box_dimen: if chr_code=width_offset then print_esc("wd")
+else if chr_code=height_offset then print_esc("ht")
+else print_esc("dp");
+@y
+set_box_dimen: if chr_code=width_offset then print_esc("wd")
+else if chr_code=height_offset then print_esc("ht")
+else if chr_code=depth_offset then print_esc("dp")
+else if chr_code=(width_offset+3) then print_esc("charwd")
+else if chr_code=(height_offset+3) then print_esc("charht")
+else if chr_code=(depth_offset+3) then print_esc("chardp")
+else print_esc("charit");
+@z
+%---------------------------------------
+@x [26] m.419 l.8461 - Omega char dimensions
+begin scan_eight_bit_int;
+if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc;
+cur_val_level:=dimen_val;
+end
+@y
+if m<=3 then
+begin
+ scan_eight_bit_int;
+ if box(cur_val)=null then cur_val:=0 @+else
+ cur_val:=mem[box(cur_val)+m].sc;
+ cur_val_level:=dimen_val;
+end
+else
+begin
+ scan_char_num;
+ if m=(width_offset+3) then begin
+ cur_val:= char_width(main_f)(char_info(main_f)(cur_val))
+ end
+ else if m=(height_offset+3) then begin
+ cur_val:= char_height(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else if m=(depth_offset+3) then begin
+ cur_val:= char_depth(main_f)(height_depth(char_info(main_f)(cur_val)))
+ end
+ else begin
+ cur_val:= char_italic(main_f)(char_info(main_f)(cur_val));
+ end;
+ cur_val_level:=dimen_val;
+end
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir/omdir.ch b/Build/source/texk/web2c/omegadir/omdir.ch
new file mode 100644
index 00000000000..4e94b79e68b
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omdir.ch
@@ -0,0 +1,4174 @@
+% omdir.ch: Primitives to deal with multiple-direction text
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%-------------------------
+@x [10] m.135
+@d hlist_node=0 {|type| of hlist nodes}
+@d box_node_size=7 {number of words to allocate for a box node}
+@d width_offset=1 {position of |width| field in a box node}
+@d depth_offset=2 {position of |depth| field in a box node}
+@d height_offset=3 {position of |height| field in a box node}
+@d width(#) == mem[#+width_offset].sc {width of the box, in sp}
+@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp}
+@d height(#) == mem[#+height_offset].sc {height of the box, in sp}
+@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp}
+@d list_offset=5 {position of |list_ptr| field in a box node}
+@d list_ptr(#) == link(#+list_offset) {beginning of the list inside the box}
+@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
+@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
+@d normal=0 {the most common case when several cases are named}
+@d stretching = 1 {glue setting applies to the stretch components}
+@d shrinking = 2 {glue setting applies to the shrink components}
+@d glue_offset = 6 {position of |glue_set| in a box node}
+@d glue_set(#) == mem[#+glue_offset].gr
+ {a word of type |glue_ratio| for glue setting}
+@y
+@d hlist_node=0 {|type| of hlist nodes}
+@d box_node_size=8 {number of words to allocate for a box node}
+@d width_offset=1 {position of |width| field in a box node}
+@d depth_offset=2 {position of |depth| field in a box node}
+@d height_offset=3 {position of |height| field in a box node}
+@d width(#) == mem[#+width_offset].sc {width of the box, in sp}
+@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp}
+@d height(#) == mem[#+height_offset].sc {height of the box, in sp}
+@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp}
+@d list_offset=5 {position of |list_ptr| field in a box node}
+@d list_ptr(#) == link(#+list_offset) {beginning of the list inside the box}
+@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
+@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
+@d normal=0 {the most common case when several cases are named}
+@d stretching = 1 {glue setting applies to the stretch components}
+@d shrinking = 2 {glue setting applies to the shrink components}
+@d glue_offset = 6 {position of |glue_set| in a box node}
+@d glue_set(#) == mem[#+glue_offset].gr
+ {a word of type |glue_ratio| for glue setting}
+@d dir_offset = 7 {position of |box_dir| in a box node}
+@d box_dir(#) == mem[#+dir_offset].int
+@z
+%-------------------------
+@x [10] m.136
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+@<LOCAL: Add info node pointer@>;
+new_null_box:=p;
+@y
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+@<LOCAL: Add info node pointer@>;
+box_dir(p):=text_direction;
+new_null_box:=p;
+@z
+%-------------------------
+@x [10] m.138
+@d rule_node=2 {|type| of rule nodes}
+@d rule_node_size=4 {number of words to allocate for a rule node}
+@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
+@d is_running(#) == (#=null_flag) {tests for a running dimension}
+@y
+@d rule_node=2 {|type| of rule nodes}
+@d rule_node_size=5 {number of words to allocate for a rule node}
+@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
+@d is_running(#) == (#=null_flag) {tests for a running dimension}
+@d rule_dir(#)==info(#+4)
+@z
+%-------------------------
+@x [10] m.139
+@p function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+@<LOCAL: Add info node pointer@>;
+new_rule:=p;
+end;
+@y
+@p function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+@<LOCAL: Add info node pointer@>;
+rule_dir(p):=-1;
+new_rule:=p;
+end;
+@z
+%-------------------------
+@x [10] m.160
+@d info_node=unset_node+2 {|type| to hold local information}
+
+@d ptr_info(#) == link(#-1) {pointer to the local info node}
+
+@d info_size=5
+@d info_ref_count(#) == link(#+1) {reference count to this node}
+@d info_pen_inter(#) == info(#+2) {\.{\\localinterlinepenalty}}
+@d info_pen_broken(#) == link(#+2) {\.{\\localbrokenpenalty}}
+@d info_left_box(#) == info(#+3) {\.{\\localleftbox}}
+@d info_right_box(#) == link(#+3) {\.{\\localrightbox}}
+@d info_file(#) == info(#+4) {file names and line numbers}
+@y
+@d dir_node=unset_node+2 {|type| to keep track of stacks of directions}
+
+@d dir_size=3
+@d dir_no(#) == info(#+1) {number of directions to keep track of}
+@d dir_ref_count(#) == link(#+1) {reference count to this node}
+
+@d dir_incr_ref_count(#)==begin
+ if (#)<>null then incr(dir_ref_count(#));
+ end
+@d dir_decr_ref_count(#)==begin
+ if (#)<>null then begin
+ decr(dir_ref_count(#));
+ if dir_ref_count(#) = 0 then begin
+ free_node(#,file_size+dir_no(#));
+ #:=null;
+ end;
+ end;
+ end
+
+@d info_node=unset_node+3 {|type| to hold local information}
+
+@d ptr_info(#) == link(#-1) {pointer to the local info node}
+
+@d info_size=5
+@d info_ref_count(#) == link(#+1) {reference count to this node}
+@d info_pen_inter(#) == info(#+2) {\.{\\localinterlinepenalty}}
+@d info_pen_broken(#) == link(#+2) {\.{\\localbrokenpenalty}}
+@d info_left_box(#) == info(#+3) {\.{\\localleftbox}}
+@d info_right_box(#) == link(#+3) {\.{\\localrightbox}}
+@d info_file(#) == info(#+4) {file names and line numbers}
+@d info_dir(#) == link(#+4) {direction}
+
+@d get_dir(#) == mem[info_dir(ptr_info(#))+
+ 2*dir_no(info_dir(ptr_info(#)))+1].int
+@z
+%-------------------------
+@x [10] m.160
+ free_node(#,info_size);
+@y
+ dir_decr_ref_count(info_dir(#));
+ info_dir(#):=null;
+ free_node(#,info_size);
+@z
+%-------------------------
+@x [10] m.176
+@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); print_ASCII(qo(character(p)));
+ end;
+end;
+@y
+@p procedure print_dir(d:integer);
+begin
+print(dir_names[dir_primary[d]]);
+print(dir_names[dir_secondary[d]]);
+print(dir_names[dir_tertiary[d]]);
+end;
+@#
+procedure print_dir_node(p:pointer);
+var i:integer;
+begin
+if dir_no(p)=1 then print(" dir=")
+else print(" dirs=");
+for i:=1 to dir_no(p) do begin
+ print_dir(mem[p+2*i+1].int);
+ if i<>dir_no(p) then print(",");
+ end;
+end;
+@#
+procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); print_ASCII(qo(character(p)));
+ end;
+end;
+@z
+%-------------------------
+@x [12] m.183
+@ @<Display node |p|@>=
+if is_char_node(p) then print_font_and_char(p)
+@y
+@ @<Display node |p|@>=
+if is_char_node(p) then begin print_font_and_char(p);
+ print_dir_node(info_dir(ptr_info(p)));
+ {print(" dir="); print_dir(get_dir(p));}
+ end
+@z
+%-------------------------
+@x [12] m.184
+@ @<Display box |p|@>=
+begin if type(p)=hlist_node then print_esc("h")
+else if type(p)=vlist_node then print_esc("v")
+else print_esc("unset");
+print("box("); print_scaled(height(p)); print_char("+");
+print_scaled(depth(p)); print(")x"); print_scaled(width(p));
+if type(p)=unset_node then
+ @<Display special fields of the unset node |p|@>
+else begin @<Display the value of |glue_set(p)|@>;
+ if shift_amount(p)<>0 then
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+ end;
+node_list_display(list_ptr(p)); {recursive call}
+end
+@y
+@ @<Display box |p|@>=
+begin if type(p)=hlist_node then print_esc("h")
+else if type(p)=vlist_node then print_esc("v")
+else print_esc("unset");
+print("box("); print_scaled(height(p)); print_char("+");
+print_scaled(depth(p)); print(")x"); print_scaled(width(p));
+if type(p)=unset_node then
+ @<Display special fields of the unset node |p|@>
+else begin @<Display the value of |glue_set(p)|@>;
+ if shift_amount(p)<>0 then
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+ print(", direction "); print_dir(box_dir(p));
+ end;
+node_list_display(list_ptr(p)); {recursive call}
+end
+@z
+%-------------------------
+@x [12] m.193
+@ @<Display ligature |p|@>=
+begin print_font_and_char(lig_char(p)); print(" (ligature ");
+@y
+@ @<Display ligature |p|@>=
+begin print_font_and_char(lig_char(p));
+print_dir_node(info_dir(ptr_info(p)));
+{print(" dir="); print_dir(get_dir(p));}
+print(" (ligature ");
+@z
+%-------------------------
+@x [13] m.202
+ info_node: begin
+ @<LOCAL: Delete info node@>;
+ goto done; end; {do not delete node at this time}
+@y
+ info_node: begin
+ @<LOCAL: Delete info node@>;
+ goto done; end; {do not delete node at this time}
+ dir_node: begin
+ @<LOCAL: Delete direction node@>;
+ goto done; end; {do not delete node at this time}
+@z
+%-------------------------
+@x [13] m.206
+hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size);
+ mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
+@y
+hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size);
+ mem[r+7]:=mem[p+7]; mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5];
+ {copy the last three words}
+@z
+%-------------------------
+@x [15] m.209
+@d max_internal=register
+ {the largest code that can follow \.{\\the}}
+@y
+@d assign_next_fake_math=register+1 {(\.{\\nextfakemath})}
+@d assign_box_dir=register+2 {(\.{\\boxdir})}
+@d assign_dir=register+3 {(\.{\\pagedir}, \.{\\textdir})}
+@d max_internal=assign_dir
+ {the largest code that can follow \.{\\the}}
+@z
+%-------------------------
+@x [17] m.230
+@d local_par_info_base=local_right_box_base+1
+@y
+@d local_dir_base=local_right_box_base+1
+@d local_par_info_base=local_dir_base+1
+@z
+%-------------------------
+@x [17] m.230
+@d local_par_info==equiv(local_par_info_base)
+@y
+@d local_dir==equiv(local_dir_base)
+@d local_par_info==equiv(local_par_info_base)
+@z
+%-------------------------
+@x [17] m.236
+@d int_pars=58 {total number of integer parameters}
+@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers}
+@y
+@d int_pars=58 {total number of integer parameters}
+@d dir_base=int_base+int_pars
+@d page_direction_code=0
+@d body_direction_code=1
+@d par_direction_code=2
+@d text_direction_code=3
+@d math_direction_code=4
+@d dir_pars=5
+@d count_base=dir_base+dir_pars {|number_regs| user \.{\\count} registers}
+@z
+%-------------------------
+@x [17] m.238
+@d local_broken_penalty==int_par(local_broken_penalty_code)
+@y
+@d local_broken_penalty==int_par(local_broken_penalty_code)
+@d dir_par(#)==new_eqtb_int(dir_base+#) {a direction parameter}
+@d page_direction==dir_par(page_direction_code)
+@d body_direction==dir_par(body_direction_code)
+@d par_direction==dir_par(par_direction_code)
+@d text_direction==dir_par(text_direction_code)
+@d math_direction==dir_par(math_direction_code)
+@z
+%-------------------------
+@x [17] m.247
+@d dimen_pars=21 {total number of dimension parameters}
+@y
+@d page_width_code=21
+@d page_height_code=22
+@d page_right_offset_code=23
+@d page_bottom_offset_code=24
+@d dimen_pars=25 {total number of dimension parameters}
+@z
+%-------------------------
+@x [17] m.247
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@y
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@d page_width==dimen_par(page_width_code)
+@d page_height==dimen_par(page_height_code)
+@d page_right_offset==dimen_par(page_right_offset_code)
+@d page_bottom_offset==dimen_par(page_bottom_offset_code)
+@z
+%-------------------------
+@x [26] m.410
+@d int_val=0 {integer values}
+@d dimen_val=1 {dimension values}
+@d glue_val=2 {glue specifications}
+@d mu_val=3 {math glue specifications}
+@d ident_val=4 {font identifier}
+@d tok_val=5 {token lists}
+
+@<Glob...@>=
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@!cur_val2:integer; {will be used in omxml.ch; this is cheating}
+@!cur_val_level:int_val..tok_val; {the ``level'' of this value}
+@y
+@d int_val=0 {integer values}
+@d dimen_val=1 {dimension values}
+@d glue_val=2 {glue specifications}
+@d mu_val=3 {math glue specifications}
+@d dir_val=4 {directions}
+@d ident_val=5 {font identifier}
+@d tok_val=6 {token lists}
+
+@<Glob...@>=
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@!cur_val2:integer; {will be used in omxml.ch; this is cheating}
+@!cur_val_level:int_val..dir_val; {the ``level'' of this value}
+@!tmp_dir_stack:pointer;
+@!par_dir_stack:pointer;
+@!math_dir_stack:pointer;
+@!align_dir_stack:pointer;
+@z
+%-------------------------
+@x [26] m.413
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+@y
+assign_int: scanned_result(new_eqtb_int(m))(int_val);
+assign_box_dir: begin
+ scan_eight_bit_int;
+ m:=cur_val;
+ if box(m)<>null then cur_val:=box_dir(box(m))
+ else cur_val:=0;
+ cur_val_level:=dir_val;
+ end;
+assign_dir: scanned_result(new_eqtb_int(m))(dir_val);
+@z
+%-------------------------
+@x [26] m.437
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_eight_bit_int;
+@y
+@
+@d dir_T=0
+@d dir_L=1
+@d dir_B=2
+@d dir_R=3
+@d dir_eq_end(#)==(#)
+@d dir_eq(#)==(#)=dir_eq_end
+@d dir_ne_end(#)==(#)
+@d dir_ne(#)==(#)<>dir_ne_end
+@d dir_opposite_end(#)==((#) mod 4)
+@d dir_opposite(#)==(((#)+2) mod 4)=dir_opposite_end
+@d dir_parallel_end(#)==((#) mod 2)
+@d dir_parallel(#)==((#) mod 2)=dir_parallel_end
+@d dir_orthogonal_end(#)==(# mod 2)
+@d dir_orthogonal(#)==((#) mod 2)<>dir_orthogonal_end
+@d dir_next_end(#)==((#) mod 4)
+@d dir_next(#)==(((#)+3) mod 4)=dir_next_end
+@d dir_prev_end(#)==((#) mod 4)
+@d dir_prev(#)==(((#)+1) mod 4)=dir_prev_end
+
+{box directions}
+@d dir_TL_=0
+@d dir_TR_=1
+@d dir_LT_=2
+@d dir_LB_=3
+@d dir_BL_=4
+@d dir_BR_=5
+@d dir_RT_=6
+@d dir_RB_=7
+
+{font directions}
+@d dir__LT= 0
+@d dir__LL= 1
+@d dir__LB= 2
+@d dir__LR= 3
+@d dir__RT= 4
+@d dir__RL= 5
+@d dir__RB= 6
+@d dir__RR= 7
+@d dir__TT= 8
+@d dir__TL= 9
+@d dir__TB=10
+@d dir__TR=11
+@d dir__BT=12
+@d dir__BL=13
+@d dir__BB=14
+@d dir__BR=15
+
+@d is_mirrored(#)==dir_opposite(dir_primary[#])(dir_tertiary[#])
+@d is_rotated(#)==dir_parallel(dir_secondary[#])(dir_tertiary[#])
+@d font_direction(#)==(# mod 16)
+@d box_direction(#)==(# div 4)
+
+@d scan_single_dir(#)==begin
+if scan_keyword("T") then #:=dir_T
+else if scan_keyword("L") then #:=dir_L
+else if scan_keyword("B") then #:=dir_B
+else if scan_keyword("R") then #:=dir_R
+else begin
+ print_err("Bad direction"); cur_val:=0;
+ goto exit;
+ end
+end
+
+@<Declare procedures that scan restricted classes of integers@>=
+@<DIR: Declare |change_dir|@>;
+procedure scan_dir;
+var d1,d2,d3: integer;
+begin
+get_x_token;
+if cur_cmd=assign_dir then begin
+ cur_val:=new_eqtb_int(cur_chr);
+ goto exit;
+ end
+else back_input;
+scan_single_dir(d1);
+scan_single_dir(d2);
+if dir_parallel(d1)(d2) then begin
+ print_err("Bad direction"); cur_val:=0;
+ goto exit;
+ end;
+scan_single_dir(d3);
+cur_val:=d1*8+dir_rearrange[d2]*4+d3;
+exit:
+end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_eight_bit_int;
+@z
+%-------------------------
+@x [27] m.463
+@p function scan_rule_spec:pointer;
+label reswitch;
+var q:pointer; {the rule node being created}
+begin q:=new_rule; {|width|, |depth|, and |height| all equal |null_flag| now}
+if cur_cmd=vrule then width(q):=default_rule
+else begin height(q):=default_rule; depth(q):=0;
+ end;
+@y
+@p function scan_rule_spec:pointer;
+label reswitch;
+var q:pointer; {the rule node being created}
+begin q:=new_rule; {|width|, |depth|, and |height| all equal |null_flag| now}
+if cur_cmd=vrule then begin
+ width(q):=default_rule;
+ rule_dir(q):=body_direction;
+ end
+else begin
+ height(q):=default_rule; depth(q):=0;
+ rule_dir(q):=text_direction;
+end;
+@z
+%-------------------------
+@x [27] m.465
+ int_val:print_int(cur_val);
+@y
+ int_val:print_int(cur_val);
+ dir_val:print_dir(cur_val);
+@z
+%-------------------------
+@x [30] m.550
+@d offset_false_bchar=offset_bchar+1
+@d offset_ivalues_start=offset_false_bchar+1
+@y
+@d offset_false_bchar=offset_bchar+1
+@d offset_natural_dir=offset_false_bchar+1
+@d offset_ivalues_start=offset_natural_dir+1
+@z
+%-------------------------
+@x [30] m.550
+@d font_false_bchar(#)==font_info(#)(offset_false_bchar).int
+@y
+@d font_false_bchar(#)==font_info(#)(offset_false_bchar).int
+@d font_natural_dir(#)==font_info(#)(offset_natural_dir).int
+@z
+%-------------------------
+@x [30] m.560
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled;offset:quarterword):internal_font_number; {input a \.{TFM} file}
+@y
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled;offset:quarterword;natural_dir:integer):internal_font_number;
+ {input a \.{TFM} file}
+@z
+%-------------------------
+@x [30] m.560
+font_offset(f):=offset;
+@y
+font_offset(f):=offset;
+font_natural_dir(f):=natural_dir;
+@z
+%-------------------------
+@x [31] m.586
+@d set_rule=132 {typeset a rule and move right}
+@y
+@d set_rule=132 {typeset a rule and move right}
+@d put1==133 {typeset a character without moving}
+@z
+%-------------------------
+@x [31] m.586
+@d right1=143 {move right}
+@y
+@d right1==143 {move right}
+@d right4==146 {move right, 4 bytes}
+@z
+%-------------------------
+@x [31] m.586
+@d down1=157 {move down}
+@y
+@d down1=157 {move down}
+@d down4=160 {move down, 4 bytes}
+@z
+%-------------------------
+@x [32] m.607
+@p procedure movement(@!w:scaled;@!o:eight_bits);
+label exit,found,not_found,2,1;
+var mstate:small_number; {have we seen a |y| or |z|?}
+@!p,@!q:pointer; {current and top nodes on the stack}
+@!k:integer; {index into |dvi_buf|, modulo |dvi_buf_size|}
+begin q:=get_node(movement_node_size); {new node for the top of the stack}
+width(q):=w; location(q):=dvi_offset+dvi_ptr;
+if o=down1 then
+ begin link(q):=down_ptr; down_ptr:=q;
+ end
+else begin link(q):=right_ptr; right_ptr:=q;
+ end;
+@<Look at the other stack entries until deciding what sort of \.{DVI} command
+ to generate; |goto found| if node |p| is a ``hit''@>;
+@<Generate a |down| or |right| command for |w| and |return|@>;
+found: @<Generate a |y0| or |z0| command in order to reuse a previous
+ appearance of~|w|@>;
+exit:end;
+@y
+@d dvi_set(#)==oval:=#-font_offset(f); ocmd:=set1; out_cmd
+@d dvi_put(#)==oval:=#-font_offset(f); ocmd:=put1; out_cmd
+@d dvi_set_rule_end(#)==dvi_four(#)
+@d dvi_set_rule(#)==dvi_out(set_rule); dvi_four(#); dvi_set_rule_end
+@d dvi_put_rule_end(#)==dvi_four(#)
+@d dvi_put_rule(#)==dvi_out(put_rule); dvi_four(#); dvi_put_rule_end
+@d dvi_right(#)==dvi_out(right4); dvi_four(#);
+@d dvi_left(#)==dvi_out(right4); dvi_four(-#);
+@d dvi_down(#)==dvi_out(down4); dvi_four(#);
+@d dvi_up(#)==dvi_out(down4); dvi_four(-#);
+
+@p procedure movement(@!w:scaled;@!o:eight_bits);
+label exit,found,not_found,2,1;
+var mstate:small_number; {have we seen a |y| or |z|?}
+@!p,@!q:pointer; {current and top nodes on the stack}
+@!k:integer; {index into |dvi_buf|, modulo |dvi_buf_size|}
+begin
+case box_direction(dvi_direction) of
+ dir_TL_: begin
+ end;
+ dir_TR_: begin
+ if o=right1 then negate(w);
+ end;
+ dir_LT_: begin
+ if o=right1 then o:=down1
+ else o:=right1;
+ end;
+ dir_LB_: begin
+ if o=right1 then begin
+ o:=down1; negate(w);
+ end
+ else o:=right1;
+ end;
+ dir_BL_: begin
+ if o=down1 then negate(w);
+ end;
+ dir_BR_: begin
+ negate(w);
+ end;
+ dir_RT_: begin
+ if o=right1 then o:=down1
+ else begin o:=right1; negate(w);
+ end;
+ end;
+ dir_RB_: begin
+ if o=right1 then o:=down1 else o:=right1;
+ negate(w);
+ end;
+ end;
+if false then begin
+q:=get_node(movement_node_size); {new node for the top of the stack}
+width(q):=w; location(q):=dvi_offset+dvi_ptr;
+if o=down1 then
+ begin link(q):=down_ptr; down_ptr:=q;
+ end
+else begin link(q):=right_ptr; right_ptr:=q;
+ end;
+@<Look at the other stack entries until deciding what sort of \.{DVI} command
+ to generate; |goto found| if node |p| is a ``hit''@>;
+end;
+@<Generate a |down| or |right| command for |w| and |return|@>;
+found: @<Generate a |y0| or |z0| command in order to reuse a previous
+ appearance of~|w|@>;
+exit:end;
+@z
+%-------------------------
+@x [32] m.610
+info(q):=yz_OK;
+@y
+@z
+%-------------------------
+@x [32] m.617
+dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
+@y
+dvi_h:=0; dvi_v:=0; cur_h:=0; cur_v:=0; dvi_f:=null_font;
+@z
+%-------------------------
+@x [32] m.619
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+@y
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+c_wd,c_ht,c_dp: scaled;
+ {the real width, height and depth of the character}
+c_htdp: quarterword; {height-depth entry in |char_info|}
+c_info: four_quarters; {|char_info| entry}
+edge_v: scaled;
+edge_h: scaled;
+effective_horizontal: scaled;
+basepoint_horizontal: scaled;
+basepoint_vertical: scaled;
+saving_h: scaled;
+saving_v: scaled;
+save_direction: integer;
+dir_tmp,dir_ptr: pointer;
+dvi_dir_h,dvi_dir_ptr,dvi_temp_ptr: integer;
+char_first: integer;
+cur_direction: integer;
+new_dir_node,prev_dir_node: pointer;
+i,d,dir_level,m: integer; {counters for the direction stuff}
+dir_found: boolean;
+@z
+%-------------------------
+@x [32] m.619
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+if char_specials>0 then begin
+ should_create_special:=true;
+ chars_since_last_special:=char_specials;
+ end
+else begin
+ should_create_special:=false;
+ chars_since_last_special:=-1000000;
+ end;
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+@y
+save_direction:=dvi_direction;
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+if dvi_direction<>box_dir(this_box) then begin
+ dvi_direction:=box_dir(this_box);
+ synch_v; synch_h;
+ saving_h:=dvi_h; saving_v:=dvi_v;
+ end;
+@<DIR: Initialize the text direction@>;
+if char_specials>0 then begin
+ should_create_special:=true;
+ chars_since_last_special:=char_specials;
+ end
+else begin
+ should_create_special:=false;
+ chars_since_last_special:=-1000000;
+ end;
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+@<DIR: Finalize the text direction@>;
+if dvi_direction<>save_direction then begin
+ dvi_direction:=save_direction;
+ synch_v; synch_h;
+ cur_h:=saving_h; cur_v:=saving_v;
+ end;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+@z
+%-------------------------
+@x [32] m.620
+@<Output node |p| for |hlist_out|...@>=
+reswitch: if is_char_node(p) then
+ begin synch_h; synch_v;
+ if should_create_special then begin
+ should_create_special:=false;
+ if chars_since_last_special>=char_specials then
+ if ptr_info(p)<>null then
+ if info_file(ptr_info(p))<>null then begin
+ @<LOCAL: Create special node@>;
+ chars_since_last_special:=0;
+ end;
+ end;
+ repeat f:=font(p); c:=character(p);
+ incr(chars_since_last_special);
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+ oval:=c-font_offset(f); ocmd:=set1; out_cmd;@/
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+ p:=link(p);
+ until not is_char_node(p);
+ dvi_h:=cur_h;
+ end
+else @<Output the non-|char_node| |p| for |hlist_out|
+ and move to the next node@>
+@y
+@<Output node |p| for |hlist_out|...@>=
+reswitch: if is_char_node(p) then
+ begin synch_h; synch_v;
+ if should_create_special then begin
+ should_create_special:=false;
+ if chars_since_last_special>=char_specials then
+ if ptr_info(p)<>null then
+ if info_file(ptr_info(p))<>null then begin
+ @<LOCAL: Create special node@>;
+ chars_since_last_special:=0;
+ end;
+ end;
+ repeat f:=font(p); c:=character(p);
+ incr(chars_since_last_special);
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+ c_info:=char_info(f)(c);
+ c_htdp:=height_depth(c_info);
+ if is_rotated(dvi_direction) then begin
+ c_ht:=char_width(f)(c_info) div 2;
+ c_wd:=char_height(f)(c_htdp)+char_depth(f)(c_htdp);
+ end
+ else begin
+ c_ht:=char_height(f)(c_htdp);
+ c_dp:=char_depth(f)(c_htdp);
+ c_wd:=char_width(f)(c_info);
+ end;
+ cur_h:=cur_h+c_wd;
+ if (font_natural_dir(f)<>-1) then
+ case font_direction(dvi_direction) of
+ dir__LT,dir__LB: begin
+ dvi_set(c);
+ end;
+ dir__RT,dir__RB: begin
+ dvi_put(c);
+ dvi_left(c_wd);
+ end;
+ dir__TL,dir__TR: begin
+ dvi_put(c);
+ dvi_down(c_wd);
+ end;
+ dir__BL,dir__BR: begin
+ dvi_put(c);
+ dvi_up(c_wd);
+ end;
+ dir__LL,dir__LR: begin
+ dvi_put(c);
+ dvi_right(c_wd);
+ end;
+ dir__RL,dir__RR: begin
+ dvi_put(c);
+ dvi_left(c_wd);
+ end;
+ dir__TT,dir__TB: begin
+ dvi_put(c);
+ dvi_down(c_wd);
+ end;
+ dir__BT,dir__BB: begin
+ dvi_put(c);
+ dvi_up(c_wd);
+ end;
+ end
+ else
+ case font_direction(dvi_direction) of
+ dir__LT: begin
+ dvi_set(c);
+ end;
+ dir__LB: begin
+ dvi_down(c_ht);
+ dvi_set(c);
+ dvi_up(c_ht);
+ end;
+ dir__RT: begin
+ dvi_left(c_wd);
+ dvi_put(c);
+ end;
+ dir__RB: begin
+ dvi_left(c_wd);
+ dvi_down(c_ht);
+ dvi_put(c);
+ dvi_up(c_ht);
+ end;
+ dir__TL: begin
+ dvi_down(c_wd);
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ end;
+ dir__TR: begin
+ dvi_down(c_wd);
+ dvi_left(c_dp);
+ dvi_put(c);
+ dvi_right(c_dp);
+ end;
+ dir__BL: begin
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ dvi_up(c_wd);
+ end;
+ dir__BR: begin
+ dvi_left(c_dp);
+ dvi_put(c);
+ dvi_right(c_dp);
+ dvi_up(c_wd);
+ end;
+ dir__LL,dir__LR: begin
+ dvi_down(c_ht);
+ dvi_put(c);
+ dvi_up(c_ht);
+ dvi_right(c_wd);
+ end;
+ dir__RL,dir__RR: begin
+ dvi_left(c_wd);
+ dvi_down(c_ht);
+ dvi_put(c);
+ dvi_up(c_ht);
+ end;
+ dir__TT,dir__TB: begin
+ dvi_down(c_wd);
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ end;
+ dir__BT,dir__BB: begin
+ dvi_left(c_ht);
+ dvi_put(c);
+ dvi_right(c_ht);
+ dvi_up(c_wd);
+ end;
+ end;
+ p:=link(p);
+ dvi_h:=cur_h;
+ @<DIR: Check if the text direction has changed@>;
+ until not is_char_node(p);
+ end
+else @<Output the non-|char_node| |p| for |hlist_out|
+ and move to the next node@>
+@z
+%-------------------------
+@x [32] m.622
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in an hlist@>;
+glue_node: @<Move right or output leaders@>;
+kern_node,math_node:cur_h:=cur_h+width(p);
+ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>;
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<Output a rule in an hlist@>;
+move_past: cur_h:=cur_h+rule_wd;
+next_p:
+if type(p)<>kern_node then should_create_special:=true;
+p:=link(p);
+end
+@y
+rule_node: begin
+ if rule_dir(p)=-1 then begin
+ print("Rule direction is not defined"); print_ln;
+ end;
+ if not (dir_orthogonal(dir_primary[rule_dir(p)])
+ (dir_primary[dvi_direction])) then begin
+ rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ end
+ else begin
+ rule_ht:=width(p) div 2;
+ rule_dp:=width(p) div 2;
+ rule_wd:=height(p)+depth(p);
+ end;
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in an hlist@>;
+glue_node: @<Move right or output leaders@>;
+kern_node,math_node:cur_h:=cur_h+width(p);
+ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>;
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<Output a rule in an hlist@>;
+move_past: cur_h:=cur_h+rule_wd;
+next_p:
+if type(p)<>kern_node then should_create_special:=true;
+p:=link(p);
+@<DIR: Check if the text direction has changed@>;
+end
+@z
+%-------------------------
+@x [32] m.623
+if list_ptr(p)=null then cur_h:=cur_h+width(p)
+else begin save_h:=dvi_h; save_v:=dvi_v;
+ cur_v:=base_line+shift_amount(p); {shift the box down}
+ temp_ptr:=p; edge:=cur_h;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge+width(p); cur_v:=base_line;
+ end
+@y
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])
+ (dir_primary[dvi_direction])) then begin
+ effective_horizontal:=width(p);
+ basepoint_vertical:=0;
+ if dir_opposite(dir_secondary[box_dir(p)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(p)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ effective_horizontal:=height(p)+depth(p);
+ if not (is_mirrored(box_dir(p))) then
+ if dir_eq(dir_primary[box_dir(p)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(p)
+ else
+ basepoint_horizontal:=depth(p)
+ else
+ if dir_eq(dir_primary[box_dir(p)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(p)
+ else
+ basepoint_horizontal:=depth(p);
+ if dir_eq(dir_secondary[box_dir(p)])
+ (dir_primary[dvi_direction]) then
+ basepoint_vertical:= -(width(p) div 2)
+ else
+ basepoint_vertical:= (width(p) div 2);
+ end;
+if not (is_mirrored(dvi_direction)) then
+ basepoint_vertical := basepoint_vertical + shift_amount(p)
+ {shift the box `down'}
+else
+ basepoint_vertical := basepoint_vertical - shift_amount(p);
+ {shift the box `up'}
+if list_ptr(p)=null then cur_h:=cur_h + effective_horizontal
+else begin
+ temp_ptr:=p; edge:=cur_h; cur_h:=cur_h + basepoint_horizontal;
+ edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+ {if dvi_direction<>box_dir(p) then begin}
+ synch_h; synch_v;
+ {end;}
+ save_h:=dvi_h; save_v:=dvi_v;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge+effective_horizontal; cur_v:=base_line;
+ end
+end
+@z
+%-------------------------
+@x [32] m.624
+ dvi_out(set_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+@y
+ case font_direction(dvi_direction) of
+ dir__LT: begin
+ dvi_set_rule(rule_ht)(rule_wd);
+ end;
+ dir__LB: begin
+ dvi_down(rule_ht);
+ dvi_set_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__RT: begin
+ dvi_left(rule_wd);
+ dvi_put_rule(rule_ht)(rule_wd);
+ end;
+ dir__RB: begin
+ dvi_left(rule_wd);
+ dvi_down(rule_ht);
+ dvi_put_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__TL: begin
+ dvi_down(rule_wd);
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ end;
+ dir__TR: begin
+ dvi_down(rule_wd);
+ dvi_put_rule(rule_wd)(rule_ht);
+ end;
+ dir__BL: begin
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ dir__BR: begin
+ dvi_put_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ end;
+@z
+%-------------------------
+@x [32] m.626
+leader_wd:=width(leader_box);
+@y
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])
+ (dir_primary[dvi_direction])) then
+ leader_wd:=width(leader_box)
+else
+ leader_wd:=height(leader_box)+depth(leader_box);
+@z
+%-------------------------
+@x [32] m.628
+@<Output a leader box at |cur_h|, ...@>=
+begin cur_v:=base_line+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/
+synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_v:=save_v; dvi_h:=save_h; cur_v:=base_line;
+cur_h:=save_h+leader_wd+lx;
+end
+@y
+@<Output a leader box at |cur_h|, ...@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])
+ (dir_primary[dvi_direction])) then begin
+ basepoint_vertical:=0;
+ if dir_opposite(dir_secondary[box_dir(leader_box)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(leader_box)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ if not (is_mirrored(box_dir(leader_box))) then
+ if dir_eq(dir_primary[box_dir(leader_box)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(leader_box)
+ else
+ basepoint_horizontal:=depth(leader_box)
+ else
+ if dir_eq(dir_primary[box_dir(leader_box)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=depth(leader_box)
+ else
+ basepoint_horizontal:=height(leader_box);
+ if dir_eq(dir_secondary[box_dir(leader_box)])
+ (dir_primary[dvi_direction]) then
+ basepoint_vertical:= -(width(leader_box) div 2)
+ else
+ basepoint_vertical:= (width(leader_box) div 2);
+ end;
+if not (is_mirrored(dvi_direction)) then
+ basepoint_vertical := basepoint_vertical + shift_amount(leader_box)
+ {shift the box `down'}
+else
+ basepoint_vertical := basepoint_vertical - shift_amount(leader_box);
+ {shift the box `up'}
+temp_ptr:=leader_box;
+synch_h; save_h:=dvi_h;
+cur_h:=cur_h + basepoint_horizontal;
+edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+synch_v; save_v:=dvi_v;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_v:=save_v; dvi_h:=save_h; cur_v:=base_line;
+cur_h:=save_h+leader_wd+lx;
+end
+@z
+%-------------------------
+@x [32] m.629
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box);
+top_edge:=cur_v;
+while p<>null do @<Output node |p| for |vlist_out| and move to the next node,
+ maintaining the condition |cur_h=left_edge|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+@y
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+@!save_direction: integer;
+@!effective_vertical: scaled;
+@!basepoint_horizontal: scaled;
+@!basepoint_vertical: scaled;
+@!edge_v: scaled;
+@!saving_v: scaled;
+@!saving_h: scaled;
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+saving_v:=dvi_v; saving_h:=dvi_h;
+save_direction:=dvi_direction;
+if dvi_direction<>box_dir(this_box) then begin
+ dvi_direction:=box_dir(this_box);
+ synch_v; synch_h;
+ saving_h:=dvi_h; saving_v:=dvi_v;
+ end;
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box);
+top_edge:=cur_v;
+while p<>null do @<Output node |p| for |vlist_out| and move to the next node,
+ maintaining the condition |cur_h=left_edge|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+if dvi_direction<>save_direction then begin
+ dvi_direction:=save_direction;
+ synch_v; synch_h;
+ cur_h:=saving_h; cur_v:=saving_v;
+ end;
+@z
+%-------------------------
+@x [32] m.631
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+@y
+rule_node: begin
+ if not (dir_orthogonal(dir_primary[rule_dir(p)])
+ (dir_primary[dvi_direction])) then begin
+ rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ end
+ else begin
+ rule_ht:=width(p) div 2;
+ rule_dp:=width(p) div 2;
+ rule_wd:=height(p)+depth(p);
+ end;
+ goto fin_rule;
+ end;
+@z
+%-------------------------
+@x [32] m.632
+@<Output a box in a vlist@>=
+if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
+else begin cur_v:=cur_v+height(p); synch_v;
+ save_h:=dvi_h; save_v:=dvi_v;
+ cur_h:=left_edge+shift_amount(p); {shift the box right}
+ temp_ptr:=p;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_v:=save_v+depth(p); cur_h:=left_edge;
+ end
+@y
+@<Output a box in a vlist@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])
+ (dir_primary[dvi_direction])) then begin
+ effective_vertical:=height(p)+depth(p);
+ if (is_mirrored(box_dir(p))) then
+ basepoint_vertical:=depth(p)
+ else
+ basepoint_vertical:=height(p);
+ if dir_opposite(dir_secondary[box_dir(p)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(p)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ effective_vertical:=width(p);
+ if not (is_mirrored(box_dir(p))) then
+ if dir_eq(dir_primary[box_dir(p)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(p)
+ else
+ basepoint_horizontal:=depth(p)
+ else
+ if dir_eq(dir_primary[box_dir(p)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(p)
+ else
+ basepoint_horizontal:=depth(p);
+ if dir_eq(dir_secondary[box_dir(p)])
+ (dir_primary[dvi_direction]) then
+ basepoint_vertical:=0
+ else
+ basepoint_vertical:=width(p);
+ end;
+basepoint_horizontal := basepoint_horizontal + shift_amount(p);
+ {shift the box `right'}
+if list_ptr(p)=null then begin
+ cur_v:=cur_v+effective_vertical;
+ end
+else begin
+ edge_v:=cur_v;
+ cur_h:=left_edge + basepoint_horizontal;
+ cur_v:=cur_v + basepoint_vertical;
+ if dvi_direction<>box_dir(p) then begin
+ synch_h;
+ end;
+ synch_v;
+ save_h:=dvi_h; save_v:=dvi_v;
+ temp_ptr:=p;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=left_edge; cur_v:=edge_v + effective_vertical;
+ end
+end
+@z
+%-------------------------
+@x [32] m.633
+ dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+@y
+ case font_direction(dvi_direction) of
+ dir__LT: begin
+ dvi_put_rule(rule_ht)(rule_wd);
+ end;
+ dir__LB: begin
+ dvi_down(rule_ht);
+ dvi_put_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__RT: begin
+ dvi_left(rule_wd);
+ dvi_set_rule(rule_ht)(rule_wd);
+ end;
+ dir__RB: begin
+ dvi_down(rule_ht);
+ dvi_left(rule_wd);
+ dvi_set_rule(rule_ht)(rule_wd);
+ dvi_up(rule_ht);
+ end;
+ dir__TL: begin
+ dvi_down(rule_wd);
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ dir__TR: begin
+ dvi_down(rule_wd);
+ dvi_put_rule(rule_wd)(rule_ht);
+ dvi_up(rule_wd);
+ end;
+ dir__BL: begin
+ dvi_left(rule_ht);
+ dvi_set_rule(rule_wd)(rule_ht);
+ end;
+ dir__BR: begin
+ dvi_put_rule(rule_wd)(rule_ht);
+ end;
+ end;
+@z
+%-------------------------
+@x [32] m.635
+leader_ht:=height(leader_box)+depth(leader_box);
+@y
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])
+ (dir_primary[dvi_direction])) then
+ leader_ht:=height(leader_box)+depth(leader_box)
+else
+ leader_ht:=width(leader_box);
+@z
+%-------------------------
+@x [32] m.637
+@<Output a leader box at |cur_v|, ...@>=
+begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/
+cur_v:=cur_v+height(leader_box); synch_v; save_v:=dvi_v;
+temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_v:=save_v; dvi_h:=save_h; cur_h:=left_edge;
+cur_v:=save_v-height(leader_box)+leader_ht+lx;
+end
+@y
+@<Output a leader box at |cur_v|, ...@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])
+ (dir_primary[dvi_direction])) then begin
+ effective_vertical:=height(leader_box)+depth(leader_box);
+ if (is_mirrored(box_dir(leader_box))) then
+ basepoint_vertical:=depth(leader_box)
+ else
+ basepoint_vertical:=height(leader_box);
+ if dir_opposite(dir_secondary[box_dir(leader_box)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=width(leader_box)
+ else
+ basepoint_horizontal:=0;
+ end
+else begin
+ effective_vertical:=width(leader_box);
+ if not (is_mirrored(box_dir(leader_box))) then
+ if dir_eq(dir_primary[box_dir(leader_box)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=height(leader_box)
+ else
+ basepoint_horizontal:=depth(leader_box)
+ else
+ if dir_eq(dir_primary[box_dir(leader_box)])
+ (dir_secondary[dvi_direction]) then
+ basepoint_horizontal:=depth(leader_box)
+ else
+ basepoint_horizontal:=height(leader_box);
+ if dir_eq(dir_secondary[box_dir(leader_box)])
+ (dir_primary[dvi_direction]) then
+ basepoint_vertical:= width(leader_box)
+ else
+ basepoint_vertical:= 0;
+ end;
+basepoint_horizontal := basepoint_horizontal + shift_amount(leader_box);
+ {shift the box `right'}
+temp_ptr:=leader_box;
+edge_v:=cur_v;
+cur_h:=left_edge + basepoint_horizontal;
+cur_v:=cur_v + basepoint_vertical;
+synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_h:=save_h; dvi_v:=save_v;
+cur_h:=left_edge; cur_v:=edge_v+leader_ht+lx;
+end
+@z
+%-------------------------
+@x [32] m.640
+cur_v:=height(p)+v_offset; temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+@y
+dvi_direction:=page_direction;
+case box_direction(dvi_direction) of
+dir_TL_,dir_LT_: begin
+ end;
+dir_TR_,dir_RT_: begin
+ dvi_right(page_right_offset);
+ end;
+dir_RB_,dir_BR_: begin
+ dvi_right(page_right_offset);
+ dvi_down(page_bottom_offset);
+ end;
+dir_BL_,dir_LB_: begin
+ dvi_down(page_bottom_offset);
+ end;
+end;
+cur_h:=h_offset;
+cur_v:=height(p)+v_offset;
+case box_direction(dvi_direction) of
+dir_TL_: begin
+ dvi_down(cur_v);
+ dvi_right(cur_h);
+ end;
+dir_TR_: begin
+ dvi_down(cur_v);
+ dvi_right(-cur_h);
+ end;
+dir_LT_: begin
+ dvi_right(cur_v);
+ dvi_down(cur_h);
+ end;
+dir_LB_: begin
+ dvi_right(cur_v);
+ dvi_down(-cur_h);
+ end;
+dir_BL_: begin
+ dvi_down(-cur_v);
+ dvi_right(cur_h);
+ end;
+dir_BR_: begin
+ dvi_down(-cur_v);
+ dvi_right(-cur_h);
+ end;
+dir_RT_: begin
+ dvi_right(-cur_v);
+ dvi_down(cur_h);
+ end;
+dir_RB_: begin
+ dvi_right(-cur_v);
+ dvi_down(-cur_h);
+ end;
+end;
+dvi_h:=cur_h;
+dvi_v:=cur_v;
+temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+@z
+%-------------------------
+@x [33] m.644
+@d exactly=0 {a box dimension is pre-specified}
+@d additional=1 {a box dimension is increased from the natural one}
+@d natural==0,additional {shorthand for parameters to |hpack| and |vpack|}
+@y
+@d exactly=0 {a box dimension is pre-specified}
+@d additional=1 {a box dimension is increased from the natural one}
+@d natural==0,additional {shorthand for parameters to |hpack| and |vpack|}
+
+@<Glob...@>=
+spec_direction:integer;
+
+@z
+%-------------------------
+@x [33] m.645
+procedure scan_spec(@!c:group_code;@!three_codes:boolean);
+ {scans a box specification and left brace}
+label found;
+var @!s:integer; {temporarily saved value}
+@!spec_code:exactly..additional;
+begin if three_codes then s:=saved(0);
+if scan_keyword("to") then spec_code:=exactly
+@.to@>
+else if scan_keyword("spread") then spec_code:=additional
+@.spread@>
+else begin spec_code:=additional; cur_val:=0;
+ goto found;
+ end;
+scan_normal_dimen;
+found: if three_codes then
+ begin saved(0):=s; incr(save_ptr);
+ end;
+saved(0):=spec_code; saved(1):=cur_val; save_ptr:=save_ptr+2;
+new_save_level(c); scan_left_brace;
+end;
+@y
+procedure scan_spec(@!c:group_code;@!four_codes:boolean);
+ {scans a box specification and left brace}
+label found;
+var @!s:integer; {temporarily saved value}
+@!spec_code:exactly..additional;
+begin if four_codes then s:=saved(0);
+if abs(mode)=mmode then
+ spec_direction:=math_direction
+else
+ spec_direction:=text_direction;
+if scan_keyword("dir") then begin
+ scan_dir; spec_direction:=cur_val;
+ end;
+if scan_keyword("to") then spec_code:=exactly
+@.to@>
+else if scan_keyword("spread") then spec_code:=additional
+@.spread@>
+else begin spec_code:=additional; cur_val:=0;
+ goto found;
+ end;
+scan_normal_dimen;
+found: if four_codes then
+ begin saved(0):=s; incr(save_ptr);
+ end;
+saved(0):=spec_code; saved(1):=cur_val;
+saved(2):=spec_direction;
+save_ptr:=save_ptr+3;
+new_save_level(c); scan_left_brace;
+eq_word_define(dir_base+text_direction_code,spec_direction);
+make_local_direction(spec_direction,true);
+end;
+@z
+%-------------------------
+@x [33] m.649
+@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+label reswitch, common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!q:pointer; {trails behind |p|}
+@!h,@!d,@!x:scaled; {height, depth, and natural width}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+@!f:internal_font_number; {the font in a |char_node|}
+@!i:four_quarters; {font information about a |char_node|}
+@!hd:eight_bits; {height and depth indices for a character}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+@y
+@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number;@!hpack_dir:integer):
+pointer;
+label reswitch, common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!q:pointer; {trails behind |p|}
+@!h,@!d,@!x:scaled; {height, depth, and natural width}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+@!f:internal_font_number; {the font in a |char_node|}
+@!i:four_quarters; {font information about a |char_node|}
+@!hd:eight_bits; {height and depth indices for a character}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+box_dir(r):=hpack_dir;
+if (hpack_dir<0) or (hpack_dir>31) then begin
+ print_ln; print("hpack_dir="); print_int(hpack_dir); print_ln;
+ end;
+ptr_info(r):=local_par_info;
+info_incr_ref_count(local_par_info);
+@z
+%-------------------------
+@x [33] m.649
+exit: hpack:=r;
+end;
+@y
+exit:
+{
+if is_mirrored(hpack_dir) then begin
+ hd:=depth(p); depth(p):=height(p); height(p):=hd;
+ end;
+}
+hpack:=r;
+end;
+@z
+%-------------------------
+@x [33] m.653
+@<Incorporate box dimensions into the dimensions of the hbox...@>=
+begin x:=x+width(p);
+if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+if height(p)-s>h then h:=height(p)-s;
+if depth(p)+s>d then d:=depth(p)+s;
+end
+@y
+@<Incorporate box dimensions into the dimensions of the hbox...@>=
+begin
+if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
+ if dir_orthogonal(dir_primary[hpack_dir])
+ (dir_primary[box_dir(p)]) then begin
+ x:=x+height(p)+depth(p);
+ s:=shift_amount(p);
+ if (width(p) div 2)-s>h then h:=(width(p) div 2)-s;
+ if (width(p) div 2)+s>d then d:=(width(p) div 2)+s;
+ end
+ else if dir_opposite(dir_primary[hpack_dir])
+ (dir_primary[box_dir(p)]) then begin
+ x:=x+width(p);
+ s:=shift_amount(p);
+ if depth(p)-s>h then h:=depth(p)-s;
+ if height(p)+s>d then d:=height(p)+s;
+ end
+ else begin
+ x:=x+width(p);
+ s:=shift_amount(p);
+ if height(p)-s>h then h:=height(p)-s;
+ if depth(p)+s>d then d:=depth(p)+s;
+ end
+ end
+else begin
+ x:=x+width(p);
+ if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+ if height(p)-s>h then h:=height(p)-s;
+ if depth(p)+s>d then d:=depth(p)+s;
+ end;
+end
+@z
+%-------------------------
+@x [33] m.654
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+x:=x+char_width(f)(i);@/
+s:=char_height(f)(hd);@+if s>h then h:=s;
+s:=char_depth(f)(hd);@+if s>d then d:=s;
+p:=link(p);
+end
+@y
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+if is_rotated(get_dir(p)) then begin
+ x:=x+char_height(f)(hd)+char_depth(f)(hd);@/
+ s:=char_width(f)(i) div 2;@+if s>h then h:=s;
+ s:=char_width(f)(i) div 2;@+if s>d then d:=s;
+ end
+else if dir_opposite(dir_tertiary[hpack_dir])
+ (dir_tertiary[get_dir(p)]) then begin
+ x:=x+char_width(f)(i);@/
+ s:=char_depth(f)(hd);@+if s>h then h:=s;
+ s:=char_height(f)(hd);@+if s>d then d:=s;
+ end
+else begin
+ x:=x+char_width(f)(i);@/
+ s:=char_height(f)(hd);@+if s>h then h:=s;
+ s:=char_depth(f)(hd);@+if s>d then d:=s;
+ end;
+p:=link(p);
+end
+@z
+%-------------------------
+@x [33] m.666
+@ @<Report an overfull hbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
+ begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
+ begin while link(q)<>null do q:=link(q);
+ link(q):=new_rule;
+ width(link(q)):=overfull_rule;
+ end;
+@y
+@ @<Report an overfull hbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
+ begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
+ begin while link(q)<>null do q:=link(q);
+ link(q):=new_rule; rule_dir(q):=box_dir(r);
+ width(link(q)):=overfull_rule;
+ end;
+@z
+%-------------------------
+@x [33] m.668
+@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled):
+ pointer;
+label common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!w,@!d,@!x:scaled; {width, depth, and natural height}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
+@y
+@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled;
+@!vpack_dir:integer):pointer;
+label common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!w,@!d,@!x:scaled; {width, depth, and natural height}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+@!dh:scaled;
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
+box_dir(r):=vpack_dir;
+if (vpack_dir<0) or (vpack_dir>31) then begin
+ print_ln; print("vpack_dir="); print_int(vpack_dir); print_ln;
+ end;
+ptr_info(r):=local_par_info;
+info_incr_ref_count(local_par_info);
+@z
+%-------------------------
+@x [33] m.668
+exit: vpackage:=r;
+end;
+@y
+exit:
+{
+if is_mirrored(vpack_dir) then begin
+ dh:=depth(r); depth(r):=height(r); height(r):=dh;
+ end;
+}
+vpackage:=r;
+end;
+@z
+%-------------------------
+@x [33] m.670
+@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
+begin x:=x+d+height(p); d:=depth(p);
+if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+if width(p)+s>w then w:=width(p)+s;
+end
+@y
+@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
+begin
+if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
+ if dir_orthogonal(dir_primary[vpack_dir])
+ (dir_primary[box_dir(p)]) then begin
+ x:=x+d+(width(p) div 2); d:=width(p) div 2;
+ s:=shift_amount(p);
+ if depth(p)+height(p)+s>w then w:=depth(p)+height(p)+s;
+ end
+ else if dir_opposite(dir_primary[vpack_dir])
+ (dir_primary[box_dir(p)]) then begin
+ x:=x+d+depth(p); d:=height(p);
+ s:=shift_amount(p);
+ if width(p)+s>w then w:=width(p)+s;
+ end
+ else begin
+ x:=x+d+height(p); d:=depth(p);
+ s:=shift_amount(p);
+ if width(p)+s>w then w:=width(p)+s;
+ end
+ end
+else
+ begin x:=x+d+height(p); d:=depth(p);
+ if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+ if width(p)+s>w then w:=width(p)+s;
+ end;
+end
+@z
+%-------------------------
+@x [33] m.679
+ begin d:=width(baseline_skip)-prev_depth-height(b);
+ if d<line_skip_limit then p:=new_param_glue(line_skip_code)
+ else begin p:=new_skip_param(baseline_skip_code);
+ width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
+ end;
+ link(tail):=p; tail:=p;
+ end;
+link(tail):=b; tail:=b; prev_depth:=depth(b);
+@y
+ begin
+ if (type(b)=hlist_node) and (is_mirrored(box_dir(b))) then
+ d:=width(baseline_skip)-prev_depth-depth(b)
+ else
+ d:=width(baseline_skip)-prev_depth-height(b);
+ if d<line_skip_limit then p:=new_param_glue(line_skip_code)
+ else begin p:=new_skip_param(baseline_skip_code);
+ width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
+ end;
+ link(tail):=p; tail:=p;
+ end;
+link(tail):=b; tail:=b;
+if (type(b)=hlist_node) and (is_mirrored(box_dir(b))) then
+ prev_depth:=height(b)
+else
+ prev_depth:=depth(b);
+@z
+%-------------------------
+@x [35] m.704
+@p function fraction_rule(@!t:scaled):pointer;
+ {construct the bar for a fraction}
+var p:pointer; {the new node}
+begin p:=new_rule; height(p):=t; depth(p):=0; fraction_rule:=p;
+end;
+@y
+@p function fraction_rule(@!t:scaled):pointer;
+ {construct the bar for a fraction}
+var p:pointer; {the new node}
+begin p:=new_rule; rule_dir(p):=info(math_dir_stack);
+height(p):=t; depth(p):=0; fraction_rule:=p;
+end;
+@z
+%-------------------------
+@x [35] m.705
+@p function overbar(@!b:pointer;@!k,@!t:scaled):pointer;
+var p,@!q:pointer; {nodes being constructed}
+begin p:=new_kern(k); link(p):=b; q:=fraction_rule(t); link(q):=p;
+p:=new_kern(t); link(p):=q; overbar:=vpack(p,natural);
+end;
+@y
+@p function overbar(@!b:pointer;@!k,@!t:scaled):pointer;
+var p,@!q:pointer; {nodes being constructed}
+begin p:=new_kern(k); link(p):=b; q:=fraction_rule(t); link(q):=p;
+p:=new_kern(t); link(p):=q;
+overbar:=vpackage(p,natural,max_dimen,info(math_dir_stack));
+end;
+@z
+%-------------------------
+@x [36] m.706
+else begin b:=new_null_box;
+@y
+else begin b:=new_null_box; box_dir(b):=info(math_dir_stack);
+@z
+%-------------------------
+@x [36] m.709
+function char_box(@!f:internal_font_number;@!c:quarterword):pointer;
+var q:four_quarters;
+@!hd:eight_bits; {|height_depth| byte}
+@!b,@!p:pointer; {the new box and its character node}
+begin q:=char_info(f)(c); hd:=height_depth(q);
+b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
+height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
+p:=get_avail; character(p):=c; font(p):=f; list_ptr(b):=p; char_box:=b;
+end;
+@y
+function char_box(@!f:internal_font_number;@!c:quarterword):pointer;
+var q:four_quarters;
+@!hd:eight_bits; {|height_depth| byte}
+@!b,@!p:pointer; {the new box and its character node}
+begin q:=char_info(f)(c); hd:=height_depth(q);
+b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
+box_dir(b):=info(math_dir_stack);
+height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
+p:=get_avail; character(p):=c; font(p):=f; list_ptr(b):=p;
+ptr_info(p):=local_par_info; info_incr_ref_count(local_par_info);
+char_box:=b;
+end;
+@z
+%-------------------------
+@x [36] m.713
+@ @<Construct an extensible...@>=
+begin b:=new_null_box;
+@y
+@ @<Construct an extensible...@>=
+begin b:=new_null_box;
+box_dir(b):=info(math_dir_stack);
+@z
+%-------------------------
+@x [36] m.715
+@p function rebox(@!b:pointer;@!w:scaled):pointer;
+var p:pointer; {temporary register for list manipulation}
+@!f:internal_font_number; {font in a one-character box}
+@!v:scaled; {width of a character without italic correction}
+begin if (width(b)<>w)and(list_ptr(b)<>null) then
+ begin if type(b)=vlist_node then b:=hpack(b,natural);
+ p:=list_ptr(b);
+ if (is_char_node(p))and(link(p)=null) then
+ begin f:=font(p); v:=char_width(f)(char_info(f)(character(p)));
+ if v<>width(b) then link(p):=new_kern(width(b)-v);
+ end;
+ free_node(b,box_node_size);
+ b:=new_glue(ss_glue); link(b):=p;
+ while link(p)<>null do p:=link(p);
+ link(p):=new_glue(ss_glue);
+ rebox:=hpack(b,w,exactly);
+ end
+else begin width(b):=w; rebox:=b;
+ end;
+end;
+@y
+@p function rebox(@!b:pointer;@!w:scaled):pointer;
+var p:pointer; {temporary register for list manipulation}
+@!f:internal_font_number; {font in a one-character box}
+@!v:scaled; {width of a character without italic correction}
+begin if (width(b)<>w)and(list_ptr(b)<>null) then
+ begin if type(b)=vlist_node then b:=hpack(b,natural,info(math_dir_stack));
+ p:=list_ptr(b);
+ if (is_char_node(p))and(link(p)=null) then
+ begin f:=font(p); v:=char_width(f)(char_info(f)(character(p)));
+ if v<>width(b) then link(p):=new_kern(width(b)-v);
+ end;
+ free_node(b,box_node_size);
+ b:=new_glue(ss_glue); link(b):=p;
+ while link(p)<>null do p:=link(p);
+ link(p):=new_glue(ss_glue);
+ rebox:=hpack(b,w,exactly,info(math_dir_stack));
+ end
+else begin width(b):=w; rebox:=b;
+ end;
+end;
+@z
+%-------------------------
+@x [36] m.720
+function clean_box(@!p:pointer;@!s:integer):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:integer; {|cur_style| to be restored}
+@!x:pointer; {box to be returned}
+@!r:pointer; {temporary pointer}
+begin case math_type(p) of
+math_char: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p];
+ end;
+sub_box: begin q:=info(p); goto found;
+ end;
+sub_mlist: cur_mlist:=info(p);
+othercases begin q:=new_null_box; goto found;
+ end
+endcases;@/
+save_style:=cur_style; cur_style:=s; mlist_penalties:=false;@/
+mlist_to_hlist; q:=link(temp_head); {recursive call}
+cur_style:=save_style; {restore the style}
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+found: if is_char_node(q)or(q=null) then x:=hpack(q,natural)
+ else if (link(q)=null)and(type(q)<=vlist_node)and(shift_amount(q)=0) then
+ x:=q {it's already clean}
+ else x:=hpack(q,natural);
+@<Simplify a trivial box@>;
+clean_box:=x;
+end;
+@y
+function clean_box(@!p:pointer;@!s:integer):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:integer; {|cur_style| to be restored}
+@!x:pointer; {box to be returned}
+@!r:pointer; {temporary pointer}
+begin case math_type(p) of
+math_char: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p];
+ end;
+sub_box: begin q:=info(p); goto found;
+ end;
+sub_mlist: cur_mlist:=info(p);
+othercases begin q:=new_null_box; box_dir(q):=info(math_dir_stack); goto found;
+ end
+endcases;@/
+save_style:=cur_style; cur_style:=s; mlist_penalties:=false;@/
+mlist_to_hlist; q:=link(temp_head); {recursive call}
+cur_style:=save_style; {restore the style}
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+found: if is_char_node(q)or(q=null) then
+ x:=hpack(q,natural,info(math_dir_stack))
+ else if (link(q)=null)and(type(q)<=vlist_node)and(shift_amount(q)=0) then
+ x:=q {it's already clean}
+ else x:=hpack(q,natural,info(math_dir_stack));
+@<Simplify a trivial box@>;
+clean_box:=x;
+end;
+@z
+%-------------------------
+@x [36] m.727
+@<Process node-or-noad...@>=
+begin @<Do first-pass processing based on |type(q)|; |goto done_with_noad|
+ if a noad has been fully processed, |goto check_dimensions| if it
+ has been translated into |new_hlist(q)|, or |goto done_with_node|
+ if a node has been fully processed@>;
+check_dimensions: z:=hpack(new_hlist(q),natural);
+if height(z)>max_h then max_h:=height(z);
+if depth(z)>max_d then max_d:=depth(z);
+free_node(z,box_node_size);
+done_with_noad: r:=q; r_type:=type(r);
+done_with_node: q:=link(q);
+end
+@y
+@<Process node-or-noad...@>=
+begin @<Do first-pass processing based on |type(q)|; |goto done_with_noad|
+ if a noad has been fully processed, |goto check_dimensions| if it
+ has been translated into |new_hlist(q)|, or |goto done_with_node|
+ if a node has been fully processed@>;
+check_dimensions: z:=hpack(new_hlist(q),natural,info(math_dir_stack));
+if height(z)>max_h then max_h:=height(z);
+if depth(z)>max_d then max_d:=depth(z);
+free_node(z,box_node_size);
+done_with_noad: r:=q; r_type:=type(r);
+done_with_node: q:=link(q);
+end
+@z
+%-------------------------
+@x [36] m.735
+procedure make_under(@!q:pointer);
+var p,@!x,@!y: pointer; {temporary registers for box construction}
+@!delta:scaled; {overall height plus depth}
+begin x:=clean_box(nucleus(q),cur_style);
+p:=new_kern(3*default_rule_thickness); link(x):=p;
+link(p):=fraction_rule(default_rule_thickness);
+y:=vpack(x,natural);
+delta:=height(y)+depth(y)+default_rule_thickness;
+height(y):=height(x); depth(y):=delta-height(y);
+info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+end;
+@y
+procedure make_under(@!q:pointer);
+var p,@!x,@!y: pointer; {temporary registers for box construction}
+@!delta:scaled; {overall height plus depth}
+begin x:=clean_box(nucleus(q),cur_style);
+p:=new_kern(3*default_rule_thickness); link(x):=p;
+link(p):=fraction_rule(default_rule_thickness);
+y:=vpackage(x,natural,max_dimen,info(math_dir_stack));
+delta:=height(y)+depth(y)+default_rule_thickness;
+height(y):=height(x); depth(y):=delta-height(y);
+info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+end;
+@z
+%-------------------------
+@x [36] m.737
+procedure make_radical(@!q:pointer);
+var x,@!y:pointer; {temporary registers for box construction}
+@!delta,@!clr:scaled; {dimensions involved in the calculation}
+begin x:=clean_box(nucleus(q),cramped_style(cur_style));
+if cur_style<text_style then {display style}
+ clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
+else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
+ end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
+ default_rule_thickness);
+delta:=depth(y)-(height(x)+depth(x)+clr);
+if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
+shift_amount(y):=-(height(x)+clr);
+link(y):=overbar(x,clr,height(y));
+info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box;
+end;
+@y
+procedure make_radical(@!q:pointer);
+var x,@!y:pointer; {temporary registers for box construction}
+@!delta,@!clr:scaled; {dimensions involved in the calculation}
+begin x:=clean_box(nucleus(q),cramped_style(cur_style));
+if cur_style<text_style then {display style}
+ clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
+else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
+ end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
+ default_rule_thickness);
+delta:=depth(y)-(height(x)+depth(x)+clr);
+if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
+shift_amount(y):=-(height(x)+clr);
+link(y):=overbar(x,clr,height(y));
+info(nucleus(q)):=hpack(y,natural,info(math_dir_stack));
+math_type(nucleus(q)):=sub_box;
+end;
+@z
+%-------------------------
+@x [36] m.738
+ y:=vpack(y,natural); width(y):=width(x);
+@y
+ y:=vpackage(y,natural,max_dimen,info(math_dir_stack)); width(y):=width(x);
+@z
+%-------------------------
+@x [36] m.747
+@ @<Construct a vlist box for the fraction...@>=
+v:=new_null_box; type(v):=vlist_node;
+@y
+@ @<Construct a vlist box for the fraction...@>=
+v:=new_null_box; box_dir(v):=info(math_dir_stack); type(v):=vlist_node;
+@z
+%-------------------------
+@x [36] m.748
+@ @<Put the \(f)fraction into a box with its delimiters...@>=
+if cur_style<text_style then delta:=delim1(cur_size)
+else delta:=delim2(cur_size);
+x:=var_delimiter(left_delimiter(q), cur_size, delta); link(x):=v;@/
+z:=var_delimiter(right_delimiter(q), cur_size, delta); link(v):=z;@/
+new_hlist(q):=hpack(x,natural)
+@y
+@ @<Put the \(f)fraction into a box with its delimiters...@>=
+if cur_style<text_style then delta:=delim1(cur_size)
+else delta:=delim2(cur_size);
+x:=var_delimiter(left_delimiter(q), cur_size, delta); link(x):=v;@/
+z:=var_delimiter(right_delimiter(q), cur_size, delta); link(v):=z;@/
+new_hlist(q):=hpack(x,natural,info(math_dir_stack))
+@z
+%-------------------------
+@x [36] m.750
+@<Construct a box with limits above and below it...@>=
+begin x:=clean_box(supscr(q),sup_style(cur_style));
+y:=clean_box(nucleus(q),cur_style);
+z:=clean_box(subscr(q),sub_style(cur_style));
+v:=new_null_box; type(v):=vlist_node; width(v):=width(y);
+@y
+@<Construct a box with limits above and below it...@>=
+begin x:=clean_box(supscr(q),sup_style(cur_style));
+y:=clean_box(nucleus(q),cur_style);
+z:=clean_box(subscr(q),sub_style(cur_style));
+v:=new_null_box; box_dir(v):=info(math_dir_stack);
+type(v):=vlist_node; width(v):=width(y);
+@z
+%-------------------------
+@x [36] m.754
+@<Convert \(n)|nucleus(q)| to an hlist and attach the sub/superscripts@>=
+case math_type(nucleus(q)) of
+math_char, math_text_char:
+ @<Create a character node |p| for |nucleus(q)|, possibly followed
+ by a kern node for the italic correction, and set |delta| to the
+ italic correction if a subscript is present@>;
+empty: p:=null;
+sub_box: p:=info(nucleus(q));
+sub_mlist: begin cur_mlist:=info(nucleus(q)); save_style:=cur_style;
+ mlist_penalties:=false; mlist_to_hlist; {recursive call}
+@^recursion@>
+ cur_style:=save_style; @<Set up the values...@>;
+ p:=hpack(link(temp_head),natural);
+ end;
+@y
+@<Convert \(n)|nucleus(q)| to an hlist and attach the sub/superscripts@>=
+case math_type(nucleus(q)) of
+math_char, math_text_char:
+ @<Create a character node |p| for |nucleus(q)|, possibly followed
+ by a kern node for the italic correction, and set |delta| to the
+ italic correction if a subscript is present@>;
+empty: p:=null;
+sub_box: p:=info(nucleus(q));
+sub_mlist: begin cur_mlist:=info(nucleus(q)); save_style:=cur_style;
+ mlist_penalties:=false; mlist_to_hlist; {recursive call}
+@^recursion@>
+ cur_style:=save_style; @<Set up the values...@>;
+ p:=hpack(link(temp_head),natural,info(math_dir_stack));
+ end;
+@z
+%-------------------------
+@x [36] m.756
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:integer; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural);
+@y
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:integer; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural,info(math_dir_stack));
+@z
+%-------------------------
+@x [36] m.759
+x:=vpack(x,natural); shift_amount(x):=shift_down;
+@y
+x:=vpackage(x,natural,max_dimen,info(math_dir_stack));
+shift_amount(x):=shift_down;
+@z
+%-------------------------
+@x [37] m.774
+procedure init_align;
+label done, done1, done2, continue;
+var save_cs_ptr:pointer; {|warning_index| value for error messages}
+@!p:pointer; {for short-term temporary use}
+begin save_cs_ptr:=cur_cs; {\.{\\halign} or \.{\\valign}, usually}
+push_alignment; align_state:=-1000000; {enter a new alignment level}
+@<Check for improper alignment in displayed math@>;
+push_nest; {enter a new semantic level}
+@<Change current mode to |-vmode| for \.{\\halign}, |-hmode| for \.{\\valign}@>;
+scan_spec(align_group,false);@/
+@<Scan the preamble and record it in the |preamble| list@>;
+new_save_level(align_group);
+@y
+procedure init_align;
+label done, done1, done2, continue;
+var save_cs_ptr:pointer; {|warning_index| value for error messages}
+@!p:pointer; {for short-term temporary use}
+begin save_cs_ptr:=cur_cs; {\.{\\halign} or \.{\\valign}, usually}
+push_alignment; align_state:=-1000000; {enter a new alignment level}
+@<Check for improper alignment in displayed math@>;
+push_nest; {enter a new semantic level}
+@<Change current mode to |-vmode| for \.{\\halign}, |-hmode| for \.{\\valign}@>;
+scan_spec(align_group,false);@/
+@<Scan the preamble and record it in the |preamble| list@>;
+new_save_level(align_group);
+tmp_dir_stack:=get_avail; info(tmp_dir_stack):=spec_direction;
+link(tmp_dir_stack):=align_dir_stack;
+align_dir_stack:=tmp_dir_stack;
+@z
+%-------------------------
+@x [37] m.779
+@ @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|...@>=
+@<Scan the template \<u_j>, putting the resulting token list in |hold_head|@>;
+link(cur_align):=new_null_box; cur_align:=link(cur_align); {a new alignrecord}
+info(cur_align):=end_span; width(cur_align):=null_flag;
+u_part(cur_align):=link(hold_head);
+@<Scan the template \<v_j>, putting the resulting token list in |hold_head|@>;
+v_part(cur_align):=link(hold_head)
+@y
+@ @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|...@>=
+@<Scan the template \<u_j>, putting the resulting token list in |hold_head|@>;
+link(cur_align):=new_null_box; cur_align:=link(cur_align); {a new alignrecord}
+box_dir(cur_align):=info(align_dir_stack);
+info(cur_align):=end_span; width(cur_align):=null_flag;
+u_part(cur_align):=link(hold_head);
+@<Scan the template \<v_j>, putting the resulting token list in |hold_head|@>;
+v_part(cur_align):=link(hold_head)
+@z
+%-------------------------
+@x [37] m.793
+@ @<Lengthen the preamble...@>=
+begin link(q):=new_null_box; p:=link(q); {a new alignrecord}
+info(p):=end_span; width(p):=null_flag; cur_loop:=link(cur_loop);
+@<Copy the templates from node |cur_loop| into node |p|@>;
+cur_loop:=link(cur_loop);
+link(p):=new_glue(glue_ptr(cur_loop));
+end
+@y
+@ @<Lengthen the preamble...@>=
+begin link(q):=new_null_box; p:=link(q); {a new alignrecord}
+box_dir(p):=info(align_dir_stack);
+info(p):=end_span; width(p):=null_flag; cur_loop:=link(cur_loop);
+@<Copy the templates from node |cur_loop| into node |p|@>;
+cur_loop:=link(cur_loop);
+link(p):=new_glue(glue_ptr(cur_loop));
+end
+@z
+%-------------------------
+@x [37] m.796
+@ @<Package an unset...@>=
+begin if mode=-hmode then
+ begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u);
+ cur_tail:=adjust_tail; adjust_tail:=null;
+ end
+else begin u:=vpackage(link(head),natural,0); w:=height(u);
+ end;
+@y
+@ @<Package an unset...@>=
+begin if mode=-hmode then
+ begin adjust_tail:=cur_tail;
+ u:=hpack(link(head),natural,info(align_dir_stack));
+ w:=width(u);
+ cur_tail:=adjust_tail; adjust_tail:=null;
+ end
+else begin u:=vpackage(link(head),natural,0,info(align_dir_stack));
+ w:=height(u);
+ end;
+@z
+%-------------------------
+@x [37] m.799
+@p procedure fin_row;
+var p:pointer; {the new unset box}
+begin if mode=-hmode then
+ begin p:=hpack(link(head),natural);
+ pop_nest; append_to_vlist(p);
+ if cur_head<>cur_tail then
+ begin link(tail):=link(cur_head); tail:=cur_tail;
+ end;
+ end
+else begin p:=vpack(link(head),natural); pop_nest;
+ link(tail):=p; tail:=p; space_factor:=1000;
+ end;
+@y
+@p procedure fin_row;
+var p:pointer; {the new unset box}
+begin if mode=-hmode then
+ begin p:=hpack(link(head),natural,info(align_dir_stack));
+ pop_nest; append_to_vlist(p);
+ if cur_head<>cur_tail then
+ begin link(tail):=link(cur_head); tail:=cur_tail;
+ end;
+ end
+else begin p:=vpackage(link(head),natural,max_dimen,info(align_dir_stack));
+ pop_nest; link(tail):=p; tail:=p; space_factor:=1000;
+ end;
+@z
+%-------------------------
+@x [37] m.800
+flush_node_list(p); pop_alignment;
+@<Insert the \(c)current list into its environment@>;
+@y
+flush_node_list(p); pop_alignment;
+tmp_dir_stack:=align_dir_stack;
+align_dir_stack:=link(align_dir_stack);
+free_avail(tmp_dir_stack);
+@<Insert the \(c)current list into its environment@>;
+@z
+%-------------------------
+@x [37] m.804
+@<Package the preamble list...@>=
+save_ptr:=save_ptr-2; pack_begin_line:=-mode_line;
+if mode=-vmode then
+ begin rule_save:=overfull_rule;
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,0);
+ {prevent rule from being packaged}
+ p:=hpack(preamble,saved(1),saved(0));
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,rule_save);
+ end
+else begin q:=link(preamble);
+ repeat height(q):=width(q); width(q):=0; q:=link(link(q));
+ until q=null;
+ p:=vpack(preamble,saved(1),saved(0));
+ q:=link(preamble);
+ repeat width(q):=height(q); height(q):=0; q:=link(link(q));
+ until q=null;
+ end;
+@y
+@<Package the preamble list...@>=
+save_ptr:=save_ptr-3; pack_begin_line:=-mode_line;
+if mode=-vmode then
+ begin rule_save:=overfull_rule;
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,0);
+ {prevent rule from being packaged}
+ p:=hpack(preamble,saved(1),saved(0),saved(2));
+ set_new_eqtb_sc(dimen_base+overfull_rule_code,rule_save);
+ end
+else begin q:=link(preamble);
+ repeat height(q):=width(q); width(q):=0; q:=link(link(q));
+ until q=null;
+ p:=vpackage(preamble,saved(1),saved(0),max_dimen,saved(2));
+ q:=link(preamble);
+ repeat width(q):=height(q); height(q):=0; q:=link(link(q));
+ until q=null;
+ end;
+@z
+%-------------------------
+@x [37] m.806
+@ @<Make the running dimensions in rule |q| extend...@>=
+begin if is_running(width(q)) then width(q):=width(p);
+if is_running(height(q)) then height(q):=height(p);
+if is_running(depth(q)) then depth(q):=depth(p);
+if o<>0 then
+ begin r:=link(q); link(q):=null; q:=hpack(q,natural);
+ shift_amount(q):=o; link(q):=r; link(s):=q;
+ end;
+end
+@y
+@ @<Make the running dimensions in rule |q| extend...@>=
+begin if is_running(width(q)) then width(q):=width(p);
+if is_running(height(q)) then height(q):=height(p);
+if is_running(depth(q)) then depth(q):=depth(p);
+if o<>0 then
+ begin r:=link(q); link(q):=null; q:=hpack(q,natural,info(align_dir_stack));
+ shift_amount(q):=o; link(q):=r; link(s):=q;
+ end;
+end
+@z
+%-------------------------
+@x [37] m.809
+@ @<Append tabskip glue and an empty box to list |u|...@>=
+s:=link(s); v:=glue_ptr(s); link(u):=new_glue(v); u:=link(u);
+subtype(u):=tab_skip_code+1; t:=t+width(v);
+if glue_sign(p)=stretching then
+ begin if stretch_order(v)=glue_order(p) then
+ t:=t+round(float(glue_set(p))*stretch(v));
+@^real multiplication@>
+ end
+else if glue_sign(p)=shrinking then
+ begin if shrink_order(v)=glue_order(p) then
+ t:=t-round(float(glue_set(p))*shrink(v));
+ end;
+s:=link(s); link(u):=new_null_box; u:=link(u); t:=t+width(s);
+if mode=-vmode then width(u):=width(s)@+else
+ begin type(u):=vlist_node; height(u):=width(s);
+ end
+@y
+@ @<Append tabskip glue and an empty box to list |u|...@>=
+s:=link(s); v:=glue_ptr(s); link(u):=new_glue(v); u:=link(u);
+subtype(u):=tab_skip_code+1; t:=t+width(v);
+if glue_sign(p)=stretching then
+ begin if stretch_order(v)=glue_order(p) then
+ t:=t+round(float(glue_set(p))*stretch(v));
+@^real multiplication@>
+ end
+else if glue_sign(p)=shrinking then
+ begin if shrink_order(v)=glue_order(p) then
+ t:=t-round(float(glue_set(p))*shrink(v));
+ end;
+s:=link(s); link(u):=new_null_box; u:=link(u);
+box_dir(u):=info(align_dir_stack);
+t:=t+width(s);
+if mode=-vmode then width(u):=width(s)@+else
+ begin type(u):=vlist_node; height(u):=width(s);
+ end
+@z
+%-------------------------
+@x [38] m.814
+@!init_local_par_info:pointer;
+@!last_local_par_info:pointer;
+@!current_file_node:pointer;
+
+@ @<Set initial...@>=
+@y
+@!init_local_par_info:pointer;
+@!last_local_par_info:pointer;
+@!current_file_node:pointer;
+@!break_c_htdp:quarterword; {height-depth entry in |char_info|}
+@!next_fake_math_flag:integer;
+@!line_break_dir:pointer;
+
+@ @<Set initial...@>=
+next_fake_math_flag:=0;
+@z
+%-------------------------
+@x [38] m.815
+@p@t\4@>@<Declare subprocedures for |line_break|@>
+procedure line_break(@!final_widow_penalty:integer);
+@y
+@p@t\4@>@<Declare subprocedures for |line_break|@>
+procedure line_break(@!final_widow_penalty:integer;@!break_dir:integer);
+@z
+%-------------------------
+@x [38] m.816
+link(tail):=new_param_glue(par_fill_skip_code);
+@y
+final_par_glue:=new_param_glue(par_fill_skip_code);
+link(tail):=final_par_glue;
+change_dir(final_par_glue,break_dir);
+line_break_dir:=break_dir;
+@z
+%-------------------------
+@x [38] m.816
+init_cur_lang:=prev_graf mod @'200000;
+init_l_hyf:=prev_graf div @'20000000;
+init_r_hyf:=(prev_graf div @'200000) mod @'100;
+@y
+init_cur_lang:=prev_graf mod @'200000;
+init_l_hyf:=prev_graf div @'20000000;
+init_r_hyf:=(prev_graf div @'200000) mod @'100;
+@z
+%-------------------------
+@x [39] m.821
+@!pass_number:halfword; {the number of passive nodes allocated on this pass}
+@y
+@!pass_number:halfword; {the number of passive nodes allocated on this pass}
+@!final_par_glue:pointer;
+@z
+%-------------------------
+@x [38] m.841
+@<Subtract the width of node |v|...@>=
+if is_char_node(v) then
+ begin f:=font(v);
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+else case type(v) of
+ ligature_node: begin f:=font(lig_char(v));@/
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]-width(v);
+@y
+@<Subtract the width of node |v|...@>=
+if is_char_node(v) then
+ begin f:=font(v);
+ if is_rotated(get_dir(v)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(v)));
+ break_width[1]:=break_width[1]-char_height(f)(break_c_htdp)
+ -char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+else case type(v) of
+ ligature_node: begin f:=font(lig_char(v));@/
+ if is_rotated(get_dir(v)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(v))));
+ break_width[1]:=break_width[1]-char_height(f)(break_c_htdp)
+ -char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(v)])
+ (dir_primary[line_break_dir])) then
+ break_width[1]:=break_width[1]-width(v)
+ else
+ break_width[1]:=break_width[1]-(depth(v)+height(v));
+ rule_node,kern_node:
+ break_width[1]:=break_width[1]-width(v);
+@z
+%-------------------------
+@x [38] m.842
+@ @<Add the width of node |s| to |b...@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]+width(s);
+@y
+@ @<Add the width of node |s| to |b...@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_rotated(get_dir(s)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(s)));
+ break_width[1]:=break_width[1]+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ if is_rotated(get_dir(s)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(s))));
+ break_width[1]:=break_width[1]+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(s)])
+ (dir_primary[line_break_dir])) then
+ break_width[1]:=break_width[1]+width(s)
+ else
+ break_width[1]:=break_width[1]+(depth(s)+height(s));
+ rule_node,kern_node:
+ break_width[1]:=break_width[1]+width(s);
+@z
+%-------------------------
+@x [38] m.866
+hlist_node,vlist_node,rule_node: act_width:=act_width+width(cur_p);
+@y
+hlist_node,vlist_node:
+if not (dir_orthogonal(dir_primary[box_dir(cur_p)])
+ (dir_primary[line_break_dir]))
+then act_width:=act_width+width(cur_p)
+else act_width:=act_width+(depth(cur_p)+height(cur_p));
+rule_node: act_width:=act_width+width(cur_p);
+@z
+%-------------------------
+@x [38] m.866
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+@y
+ if is_rotated(get_dir(cur_p)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(cur_p))));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(cur_p))));
+@z
+%-------------------------
+@x [38] m.867
+act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+@y
+if is_rotated(get_dir(cur_p)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(cur_p)));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+else
+ act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+@z
+%-------------------------
+@x [38] m.870
+@ @<Add the width of node |s| to |disc_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ disc_width:=disc_width+width(s);
+@y
+@ @<Add the width of node |s| to |disc_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_rotated(get_dir(s)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(s)));
+ disc_width:=disc_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ if is_rotated(get_dir(s)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(s))));
+ disc_width:=disc_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(s)])
+ (dir_primary[line_break_dir]))
+ then disc_width:=disc_width+width(s)
+ else disc_width:=disc_width+(depth(s)+height(s));
+ rule_node,kern_node:
+ disc_width:=disc_width+width(s);
+@z
+%-------------------------
+@x [38] m.871
+@ @<Add the width of node |s| to |act_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ act_width:=act_width+width(s);
+@y
+@ @<Add the width of node |s| to |act_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_rotated(get_dir(s)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(s)));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ if is_rotated(get_dir(s)) then begin
+ break_c_htdp:=height_depth(char_info(f)(character(lig_char(s))));
+ act_width:=act_width+char_height(f)(break_c_htdp)
+ +char_depth(f)(break_c_htdp);
+ end
+ else
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node:
+ if not (dir_orthogonal(dir_primary[box_dir(s)])
+ (dir_primary[line_break_dir]))
+ then act_width:=act_width+width(s)
+ else act_width:=act_width+(depth(s)+height(s));
+ rule_node,kern_node:
+ act_width:=act_width+width(s);
+@z
+%-------------------------
+@x [39] m.877
+@ The total number of lines that will be set by |post_line_break|
+is |best_line-prev_graf-1|. The last breakpoint is specified by
+|break_node(best_bet)|, and this passive node points to the other breakpoints
+via the |prev_break| links. The finishing-up phase starts by linking the
+relevant passive nodes in forward order, changing |prev_break| to
+|next_break|. (The |next_break| fields actually reside in the same memory
+space as the |prev_break| fields did, but we give them a new name because
+of their new significance.) Then the lines are justified, one by one.
+
+@d next_break==prev_break {new name for |prev_break| after links are reversed}
+
+@<Declare subprocedures for |line_break|@>=
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@!disc_break:boolean; {was the current break at a discretionary node?}
+@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
+@!cur_width:scaled; {width of line number |cur_line|}
+@!cur_indent:scaled; {left margin of line number |cur_line|}
+@!t:quarterword; {used for replacement counts in discretionary nodes}
+@!pen:integer; {use when calculating penalties between lines}
+@!cur_line: halfword; {the current line number being justified}
+begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+ first breakpoint@>;
+cur_line:=prev_graf+1;
+repeat @<Justify the line ending at breakpoint |cur_p|, and append it to the
+ current vertical list, together with associated penalties and other
+ insertions@>;
+incr(cur_line); cur_p:=next_break(cur_p);
+if cur_p<>null then if not post_disc_break then
+ @<Prune unwanted nodes at the beginning of the next line@>;
+until cur_p=null;
+if (cur_line<>best_line)or(link(temp_head)<>null) then
+ confusion("line breaking");
+@:this can't happen line breaking}{\quad line breaking@>
+prev_graf:=best_line-1;
+end;
+@y
+@ The total number of lines that will be set by |post_line_break|
+is |best_line-prev_graf-1|. The last breakpoint is specified by
+|break_node(best_bet)|, and this passive node points to the other breakpoints
+via the |prev_break| links. The finishing-up phase starts by linking the
+relevant passive nodes in forward order, changing |prev_break| to
+|next_break|. (The |next_break| fields actually reside in the same memory
+space as the |prev_break| fields did, but we give them a new name because
+of their new significance.) Then the lines are justified, one by one.
+
+The |post_line_break| must also keep an dir stack, so that it can
+output end direction instructions at the ends of lines
+and begin direction instructions at the beginnings of lines.
+
+@d next_break==prev_break {new name for |prev_break| after links are reversed}
+
+@<Declare subprocedures for |line_break|@>=
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@!disc_break:boolean; {was the current break at a discretionary node?}
+@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
+@!cur_width:scaled; {width of line number |cur_line|}
+@!cur_indent:scaled; {left margin of line number |cur_line|}
+@!t:quarterword; {used for replacement counts in discretionary nodes}
+@!pen:integer; {use when calculating penalties between lines}
+@!cur_line: halfword; {the current line number being justified}
+begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+ first breakpoint@>;
+cur_line:=prev_graf+1;
+repeat @<Justify the line ending at breakpoint |cur_p|, and append it to the
+ current vertical list, together with associated penalties and other
+ insertions@>;
+incr(cur_line); cur_p:=next_break(cur_p);
+if cur_p<>null then if not post_disc_break then
+ @<Prune unwanted nodes at the beginning of the next line@>;
+until cur_p=null;
+if (cur_line<>best_line)or(link(temp_head)<>null) then
+ confusion("line breaking");
+@:this can't happen line breaking}{\quad line breaking@>
+prev_graf:=best_line-1;
+end;
+@z
+%-------------------------
+@x [39] m.889
+adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly);
+@y
+adjust_tail:=adjust_head;
+just_box:=hpack(q,cur_width,exactly,line_break_dir);
+@z
+%-------------------------
+@x [40] m.892
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@y
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@!ha_local:pointer; {points to the local information for the first char node}
+@z
+%-------------------------
+@x [40] m.896
+@<Skip to node |ha|, or |goto done1|...@>=
+loop@+ begin if is_char_node(s) then
+ begin c:=qo(character(s)); hf:=font(s);
+ end
+ else if type(s)=ligature_node then
+ if lig_ptr(s)=null then goto continue
+ else begin q:=lig_ptr(s); c:=qo(character(q)); hf:=font(q);
+ end
+ else if (type(s)=kern_node)and(subtype(s)=normal) then goto continue
+ else if type(s)=whatsit_node then
+ begin @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
+ goto continue;
+ end
+ else goto done1;
+ if lc_code(c)<>0 then
+ if (lc_code(c)=c)or(uc_hyph>0) then goto done2
+ else goto done1;
+continue: prev_s:=s; s:=link(prev_s);
+ end;
+done2: hyf_char:=hyphen_char(hf);
+if hyf_char<0 then goto done1;
+if hyf_char>biggest_char then goto done1;
+ha:=prev_s
+@y
+@<Skip to node |ha|, or |goto done1|...@>=
+loop@+ begin if is_char_node(s) then
+ begin c:=qo(character(s)); hf:=font(s);
+ end
+ else if type(s)=ligature_node then
+ if lig_ptr(s)=null then goto continue
+ else begin q:=lig_ptr(s); c:=qo(character(q)); hf:=font(q);
+ end
+ else if (type(s)=kern_node)and(subtype(s)=normal) then goto continue
+ else if type(s)=whatsit_node then
+ begin @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
+ goto continue;
+ end
+ else goto done1;
+ if lc_code(c)<>0 then
+ if (lc_code(c)=c)or(uc_hyph>0) then goto done2
+ else goto done1;
+continue: prev_s:=s; s:=link(prev_s);
+ end;
+done2: hyf_char:=hyphen_char(hf);
+if hyf_char<0 then goto done1;
+if hyf_char>biggest_char then goto done1;
+ha:=prev_s;
+ha_local:=ptr_info(s)
+@z
+%-------------------------
+@x [40] m.908
+@ @d append_charnode_to_t(#)== begin link(t):=get_avail; t:=link(t);
+ font(t):=hf; character(t):=#;
+ end
+@y
+@ @d append_charnode_to_t(#)== begin link(t):=get_avail; t:=link(t);
+ ptr_info(t):=ha_local; info_incr_ref_count(ha_local);
+ font(t):=hf; character(t):=#;
+ end
+@z
+%-------------------------
+@x [40] m.910
+@ @d wrap_lig(#)==if ligature_present then
+ begin p:=new_ligature(hf,cur_l,link(cur_q));
+ if lft_hit then
+ begin subtype(p):=2; lft_hit:=false;
+ end;
+ if # then if lig_stack=null then
+ begin incr(subtype(p)); rt_hit:=false;
+ end;
+ link(cur_q):=p; t:=p; ligature_present:=false;
+ end
+@y
+@ @d wrap_lig(#)==if ligature_present then
+ begin p:=new_ligature(hf,cur_l,link(cur_q));
+ info_decr_ref_count(ptr_info(p));
+ ptr_info(p):=ha_local; info_incr_ref_count(ha_local);
+ if lft_hit then
+ begin subtype(p):=2; lft_hit:=false;
+ end;
+ if # then if lig_stack=null then
+ begin incr(subtype(p)); rt_hit:=false;
+ end;
+ link(cur_q):=p; t:=p; ligature_present:=false;
+ end
+@z
+%-------------------------
+@x [40] m.910
+wrap_lig(rt_hit);
+if w<>0 then
+ begin link(t):=new_kern(w); t:=link(t); w:=0;
+ end;
+@y
+wrap_lig(rt_hit);
+if w<>0 then
+ begin link(t):=new_kern(w); t:=link(t); w:=0;
+ info_decr_ref_count(ptr_info(t));
+ ptr_info(t):=ha_local; info_incr_ref_count(ha_local);
+ end;
+@z
+%-------------------------
+@x [40] m.911
+qi(2),qi(6):begin cur_r:=rem_byte(q); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack>null then character(lig_stack):=cur_r
+ else begin lig_stack:=new_lig_item(cur_r);
+ if j=n then bchar:=non_char
+ else begin p:=get_avail; lig_ptr(lig_stack):=p;
+ character(p):=qi(hu[j+1]); font(p):=hf;
+ end;
+ end;
+ end;
+qi(3):begin cur_r:=rem_byte(q); {\.{\?=:\?}}
+ p:=lig_stack; lig_stack:=new_lig_item(cur_r); link(lig_stack):=p;
+ end;
+@y
+qi(2),qi(6):begin cur_r:=rem_byte(q); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack>null then character(lig_stack):=cur_r
+ else begin lig_stack:=new_lig_item(cur_r);
+ info_decr_ref_count(ptr_info(lig_stack));
+ ptr_info(lig_stack):=ha_local; info_incr_ref_count(ha_local);
+ if j=n then bchar:=non_char
+ else begin p:=get_avail; lig_ptr(lig_stack):=p;
+ character(p):=qi(hu[j+1]); font(p):=hf;
+ ptr_info(p):=ha_local; info_incr_ref_count(ha_local);
+ end;
+ end;
+ end;
+qi(3):begin cur_r:=rem_byte(q); {\.{\?=:\?}}
+ p:=lig_stack; lig_stack:=new_lig_item(cur_r); link(lig_stack):=p;
+ info_decr_ref_count(ptr_info(lig_stack));
+ ptr_info(lig_stack):=ha_local; info_incr_ref_count(ha_local);
+ end;
+@z
+%-------------------------
+@x [40] m.914
+@<Create and append a discretionary node as an alternative...@>=
+repeat r:=get_node(small_node_size);
+link(r):=link(hold_head); type(r):=disc_node;
+@y
+@<Create and append a discretionary node as an alternative...@>=
+repeat r:=get_node(small_node_size);
+link(r):=link(hold_head); type(r):=disc_node;
+ptr_info(r):=ha_local; info_incr_ref_count(ha_local);
+@z
+%-------------------------
+@x [44] m.977
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+ {extracts a page of height |h| from box |n|}
+label exit,done;
+var v:pointer; {the box to be split}
+p:pointer; {runs through the vlist}
+q:pointer; {points to where the break occurs}
+begin v:=box(n);
+if split_first_mark<>null then
+ begin delete_token_ref(split_first_mark); split_first_mark:=null;
+ delete_token_ref(split_bot_mark); split_bot_mark:=null;
+ end;
+@<Dispense with trivial cases of void or bad boxes@>;
+q:=vert_break(list_ptr(v),h,split_max_depth);
+@<Look at all the marks in nodes before the break, and set the final
+ link to |null| at the break@>;
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+if q=null then set_equiv(box_base+n,null)
+ {the |eq_level| of the box stays the same}
+else set_equiv(box_base+n,vpack(q,natural));
+vsplit:=vpackage(p,h,exactly,split_max_depth);
+exit: end;
+@y
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+ {extracts a page of height |h| from box |n|}
+label exit,done;
+var v:pointer; {the box to be split}
+vdir:integer; {the direction of the box to be split}
+p:pointer; {runs through the vlist}
+q:pointer; {points to where the break occurs}
+begin v:=box(n); vdir:=box_dir(v);
+if split_first_mark<>null then
+ begin delete_token_ref(split_first_mark); split_first_mark:=null;
+ delete_token_ref(split_bot_mark); split_bot_mark:=null;
+ end;
+@<Dispense with trivial cases of void or bad boxes@>;
+q:=vert_break(list_ptr(v),h,split_max_depth);
+@<Look at all the marks in nodes before the break, and set the final
+ link to |null| at the break@>;
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+if q=null then set_equiv(box_base+n,null)
+ {the |eq_level| of the box stays the same}
+else set_equiv(box_base+n,vpackage(q,natural,max_dimen,vdir));
+vsplit:=vpackage(p,h,exactly,split_max_depth,vdir);
+exit: end;
+@z
+%-------------------------
+@x [45] m.1001
+if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+else width(temp_ptr):=0;
+@y
+if (type(p)=hlist_node) and (is_mirrored(body_direction)) then begin
+ if width(temp_ptr)>depth(p) then width(temp_ptr):=width(temp_ptr)-depth(p)
+ else width(temp_ptr):=0;
+ end
+else begin
+ if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+ else width(temp_ptr):=0;
+ end;
+@z
+%-------------------------
+@x [45] m.1002
+begin page_total:=page_total+page_depth+height(p);
+page_depth:=depth(p);
+@y
+begin
+if (type(p)=hlist_node) and (is_mirrored(body_direction)) then begin
+ page_total:=page_total+page_depth+depth(p);
+ page_depth:=height(p);
+ end
+else begin
+ page_total:=page_total+page_depth+height(p);
+ page_depth:=depth(p);
+ end;
+@z
+%-------------------------
+@x [45] m.1017
+set_equiv(box_base+255,
+ vpackage(link(page_head),best_size,exactly,page_max_depth));
+@y
+set_equiv(box_base+255,
+ vpackage(link(page_head),best_size,exactly,page_max_depth,body_direction));
+@z
+%-------------------------
+@x [45] m.1018
+@<Prepare all the boxes involved in insertions to act as queues@>=
+begin r:=link(page_ins_head);
+while r<>page_ins_head do
+ begin if best_ins_ptr(r)<>null then
+ begin n:=qo(subtype(r)); ensure_vbox(n);
+ if box(n)=null then set_equiv(box_base+n,new_null_box);
+@y
+@<Prepare all the boxes involved in insertions to act as queues@>=
+begin r:=link(page_ins_head);
+while r<>page_ins_head do
+ begin if best_ins_ptr(r)<>null then
+ begin n:=qo(subtype(r)); ensure_vbox(n);
+ if box(n)=null then set_equiv(box_base+n,new_null_box);
+ box_dir(box(n)):=body_direction;
+@z
+%-------------------------
+@x [45] m.1021
+@ @<Wrap up the box specified by node |r|, splitting node |p| if...@>=
+begin if type(r)=split_up then
+ if (broken_ins(r)=p)and(broken_ptr(r)<>null) then
+ begin while link(s)<>broken_ptr(r) do s:=link(s);
+ link(s):=null;
+ set_equiv(glue_base+split_top_skip_code,split_top_ptr(p));
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+ if ins_ptr(p)<>null then
+ begin temp_ptr:=vpack(ins_ptr(p),natural);
+ height(p):=height(temp_ptr)+depth(temp_ptr);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+set_equiv(box_base+n,vpack(temp_ptr,natural));
+@y
+@ @<Wrap up the box specified by node |r|, splitting node |p| if...@>=
+begin if type(r)=split_up then
+ if (broken_ins(r)=p)and(broken_ptr(r)<>null) then
+ begin while link(s)<>broken_ptr(r) do s:=link(s);
+ link(s):=null;
+ set_equiv(glue_base+split_top_skip_code,split_top_ptr(p));
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+ if ins_ptr(p)<>null then
+ begin temp_ptr:=vpackage(ins_ptr(p),natural,max_dimen,body_direction);
+ height(p):=height(temp_ptr)+depth(temp_ptr);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+set_equiv(box_base+n,vpackage(temp_ptr,natural,max_dimen,body_direction));
+@z
+%-------------------------
+@x [45] m.1054
+function its_all_over:boolean; {do this when \.{\\end} or \.{\\dump} occurs}
+label exit;
+begin if privileged then
+ begin if (page_head=page_tail)and(head=tail)and(dead_cycles=0) then
+ begin its_all_over:=true; return;
+ end;
+ back_input; {we will try to end again after ejecting residual material}
+ tail_append(new_null_box);
+@y
+function its_all_over:boolean; {do this when \.{\\end} or \.{\\dump} occurs}
+label exit;
+begin if privileged then
+ begin if (page_head=page_tail)and(head=tail)and(dead_cycles=0) then
+ begin its_all_over:=true; return;
+ end;
+ back_input; {we will try to end again after ejecting residual material}
+ tail_append(new_null_box); box_dir(tail):=info(par_dir_stack);
+@z
+%-------------------------
+@x [47] m.1071
+primitive("xleaders",leader_ship,x_leaders);
+@!@:x_leaders_}{\.{\\xleaders} primitive@>
+@y
+primitive("xleaders",leader_ship,x_leaders);
+@!@:x_leaders_}{\.{\\xleaders} primitive@>
+primitive("boxdir",assign_box_dir,0);
+@!@:box_dir}{\.{\\boxdir} primitive@>
+@z
+%-------------------------
+@x [47] m.1073
+any_mode(make_box): begin_box(0);
+@y
+any_mode(make_box): begin_box(0);
+any_mode(assign_box_dir): begin scan_eight_bit_int;
+ cur_box:=box(cur_val);
+ scan_optional_equals; scan_dir;
+ if cur_box<>null then box_dir(cur_box):=cur_val;
+ end;
+@z
+%-------------------------
+@x [47] m.1076
+@<Append box |cur_box| to the current...@>=
+begin if cur_box<>null then
+ begin shift_amount(cur_box):=box_context;
+ if abs(mode)=vmode then
+ begin append_to_vlist(cur_box);
+ if adjust_tail<>null then
+ begin if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+ adjust_tail:=null;
+ end;
+ if mode>0 then build_page;
+ end
+ else begin if abs(mode)=hmode then space_factor:=1000
+ else begin p:=new_noad;
+ math_type(nucleus(p)):=sub_box;
+ info(nucleus(p)):=cur_box; cur_box:=p;
+ end;
+ link(tail):=cur_box; tail:=cur_box;
+ end;
+ end;
+end
+@y
+@<Append box |cur_box| to the current...@>=
+begin if cur_box<>null then
+ begin shift_amount(cur_box):=box_context;
+ ptr_info(cur_box):=local_par_info;
+ info_incr_ref_count(local_par_info);
+ if abs(mode)=vmode then
+ begin append_to_vlist(cur_box);
+ if adjust_tail<>null then
+ begin if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+ adjust_tail:=null;
+ end;
+ if mode>0 then build_page;
+ end
+ else begin if abs(mode)=hmode then space_factor:=1000
+ else begin p:=new_noad;
+ math_type(nucleus(p)):=sub_box;
+ info(nucleus(p)):=cur_box; cur_box:=p;
+ end;
+ link(tail):=cur_box; tail:=cur_box;
+ end;
+ end;
+end
+@z
+%-------------------------
+@x [47] m.1083
+begin k:=cur_chr-vtop_code; saved(0):=box_context;
+if k=hmode then
+ if (box_context<box_flag)and(abs(mode)=vmode) then
+ scan_spec(adjusted_hbox_group,true)
+ else scan_spec(hbox_group,true)
+else begin if k=vmode then scan_spec(vbox_group,true)
+ else begin scan_spec(vtop_group,true); k:=vmode;
+ end;
+ normal_paragraph;
+ end;
+push_nest; mode:=-k;
+@y
+begin k:=cur_chr-vtop_code; saved(0):=box_context;
+case abs(mode) of
+vmode: spec_direction:=body_direction;
+hmode: spec_direction:=text_direction;
+mmode: spec_direction:=math_direction;
+end;
+if k=hmode then
+ if (box_context<box_flag)and(abs(mode)=vmode) then
+ scan_spec(adjusted_hbox_group,true)
+ else scan_spec(hbox_group,true)
+else begin if k=vmode then scan_spec(vbox_group,true)
+ else begin scan_spec(vtop_group,true); k:=vmode;
+ end;
+ normal_paragraph;
+ end;
+push_nest; mode:=-k;
+@z
+%-------------------------
+@x [47] m.1086
+procedure package(@!c:small_number);
+var h:scaled; {height of box}
+@!p:pointer; {first node in a box}
+@!d:scaled; {max depth}
+begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3;
+if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
+else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
+ if c=vtop_code then @<Readjust the height and depth of |cur_box|,
+ for \.{\\vtop}@>;
+ end;
+pop_nest; box_end(saved(0));
+end;
+@y
+procedure package(@!c:small_number);
+var h:scaled; {height of box}
+@!p:pointer; {first node in a box}
+@!d:scaled; {max depth}
+begin d:=box_max_depth; unsave; save_ptr:=save_ptr-4;
+if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1),saved(3))
+else begin cur_box:=vpackage(link(head),saved(2),saved(1),d,saved(3));
+ if c=vtop_code then @<Readjust the height and depth of |cur_box|,
+ for \.{\\vtop}@>;
+ end;
+pop_nest; box_end(saved(0));
+end;
+@z
+%-------------------------
+@x [47] m.1091
+procedure new_graf(@!indented:boolean);
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ end;
+@y
+procedure new_graf(@!indented:boolean);
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+tmp_dir_stack:=get_avail; info(tmp_dir_stack):=par_direction;
+link(tmp_dir_stack):=par_dir_stack;
+par_dir_stack:=tmp_dir_stack;
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ box_dir(tail):=info(par_dir_stack);
+ change_dir(tail,info(par_dir_stack));
+ end;
+@z
+%-------------------------
+@x [47] m.1093
+procedure indent_in_hmode;
+var p,@!q:pointer;
+begin if cur_chr>0 then {\.{\\indent}}
+ begin p:=new_null_box; width(p):=par_indent;
+@y
+procedure indent_in_hmode;
+var p,@!q:pointer;
+begin if cur_chr>0 then {\.{\\indent}}
+ begin p:=new_null_box; width(p):=par_indent;
+ box_dir(p):=info(par_dir_stack);
+ change_dir(p,info(par_dir_stack));
+@z
+%-------------------------
+@x [47] m.1096
+procedure end_graf;
+begin if mode=hmode then
+ begin if head=tail then pop_nest {null paragraphs are ignored}
+ else line_break(widow_penalty);
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@y
+procedure end_graf;
+begin if mode=hmode then
+ begin if head=tail then pop_nest {null paragraphs are ignored}
+ else line_break(widow_penalty,info(par_dir_stack));
+ tmp_dir_stack:=par_dir_stack;
+ par_dir_stack:=link(par_dir_stack);
+ free_avail(tmp_dir_stack);
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@z
+%-------------------------
+@x [48] m.1100
+insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q);
+ d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr);
+ {now |saved(0)| is the insertion number, or 255 for |vadjust|}
+ p:=vpack(link(head),natural); pop_nest;
+ if saved(0)<>255 then
+ begin tail_append(get_node(ins_node_size));
+ type(tail):=ins_node; subtype(tail):=qi(saved(0));
+ height(tail):=height(p)+depth(p); ins_ptr(tail):=list_ptr(p);
+ split_top_ptr(tail):=q; depth(tail):=d; float_cost(tail):=f;
+ end
+ else begin tail_append(get_node(small_node_size));
+ type(tail):=adjust_node;@/
+ subtype(tail):=0; {the |subtype| is not used}
+ adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q);
+ end;
+ free_node(p,box_node_size);
+ if nest_ptr=0 then build_page;
+ end;
+@y
+insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q);
+ d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr);
+ {now |saved(0)| is the insertion number, or 255 for |vadjust|}
+ p:=vpackage(link(head),natural,max_dimen,body_direction); pop_nest;
+ if saved(0)<>255 then
+ begin tail_append(get_node(ins_node_size));
+ type(tail):=ins_node; subtype(tail):=qi(saved(0));
+ height(tail):=height(p)+depth(p); ins_ptr(tail):=list_ptr(p);
+ split_top_ptr(tail):=q; depth(tail):=d; float_cost(tail):=f;
+ end
+ else begin tail_append(get_node(small_node_size));
+ type(tail):=adjust_node;@/
+ subtype(tail):=0; {the |subtype| is not used}
+ adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q);
+ end;
+ free_node(p,box_node_size);
+ if nest_ptr=0 then build_page;
+ end;
+@z
+%-------------------------
+@x [48] m.1119
+procedure build_local_box;
+var p:pointer;
+ kind:integer;
+begin
+unsave;
+kind:=saved(-1);
+decr(save_ptr);
+p:=link(head); pop_nest;
+p:=hpack(p,natural);
+@y
+procedure build_local_box;
+var p:pointer;
+ kind:integer;
+begin
+unsave;
+kind:=saved(-1);
+decr(save_ptr);
+p:=link(head); pop_nest;
+p:=hpack(p,natural,text_direction);
+@z
+%-------------------------
+@x [48] m.1125
+@<Append the accent with appropriate kerns...@>=
+begin t:=slant(f)/float_constant(65536);
+@^real division@>
+i:=char_info(f)(character(q));
+w:=char_width(f)(i); h:=char_height(f)(height_depth(i));
+if h<>x then {the accent must be shifted up or down}
+ begin p:=hpack(p,natural); shift_amount(p):=x-h;
+ end;
+@y
+@<Append the accent with appropriate kerns...@>=
+begin t:=slant(f)/float_constant(65536);
+@^real division@>
+i:=char_info(f)(character(q));
+w:=char_width(f)(i); h:=char_height(f)(height_depth(i));
+if h<>x then {the accent must be shifted up or down}
+ begin p:=hpack(p,natural,text_direction); shift_amount(p):=x-h;
+ end;
+@z
+%-------------------------
+@x [48] m.1136
+procedure push_math(@!c:group_code);
+begin push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
+end;
+@y
+procedure push_math(@!c:group_code);
+begin
+push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
+make_local_direction(info(math_dir_stack),true);
+end;
+@z
+%-------------------------
+@x [48] m.1138
+procedure init_math;
+label reswitch,found,not_found,done;
+var w:scaled; {new or partial |pre_display_size|}
+@!l:scaled; {new |display_width|}
+@!s:scaled; {new |display_indent|}
+@!p:pointer; {current node when calculating |pre_display_size|}
+@!q:pointer; {glue specification when calculating |pre_display_size|}
+@!f:internal_font_number; {font in current |char_node|}
+@!n:integer; {scope of paragraph shape specification}
+@!v:scaled; {|w| plus possible glue amount}
+@!d:scaled; {increment to |v|}
+begin get_token; {|get_x_token| would fail on \.{\\ifmmode}\thinspace!}
+@y
+procedure init_math;
+label reswitch,found,not_found,done;
+var w:scaled; {new or partial |pre_display_size|}
+@!l:scaled; {new |display_width|}
+@!s:scaled; {new |display_indent|}
+@!p:pointer; {current node when calculating |pre_display_size|}
+@!q:pointer; {glue specification when calculating |pre_display_size|}
+@!f:internal_font_number; {font in current |char_node|}
+@!n:integer; {scope of paragraph shape specification}
+@!v:scaled; {|w| plus possible glue amount}
+@!d:scaled; {increment to |v|}
+begin get_token; {|get_x_token| would fail on \.{\\ifmmode}\thinspace!}
+tmp_dir_stack:=get_avail;
+if next_fake_math_flag=0 then
+ info(tmp_dir_stack):=math_direction
+else begin
+ info(tmp_dir_stack):=text_direction;
+ next_fake_math_flag:=0;
+ end;
+link(tmp_dir_stack):=math_dir_stack;
+math_dir_stack:=tmp_dir_stack;
+@z
+%-------------------------
+@x [48] m.1145
+@<Go into display math mode@>=
+begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+ begin pop_nest; w:=-max_dimen;
+ end
+else begin line_break(display_widow_penalty);@/
+@y
+@<Go into display math mode@>=
+begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+ begin pop_nest; w:=-max_dimen;
+ end
+else begin line_break(display_widow_penalty,info(par_dir_stack));@/
+@z
+%-------------------------
+@x [48] m.1168
+vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-2;
+ p:=vpack(link(head),saved(1),saved(0)); pop_nest;
+ tail_append(new_noad); type(tail):=vcenter_noad;
+ math_type(nucleus(tail)):=sub_box; info(nucleus(tail)):=p;
+ end;
+@y
+vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-3;
+ p:=vpackage(link(head),saved(1),saved(0),max_dimen,saved(2)); pop_nest;
+ tail_append(new_noad); type(tail):=vcenter_noad;
+ math_type(nucleus(tail)):=sub_box; info(nucleus(tail)):=p;
+ end;
+@z
+%-------------------------
+@x [48] m.1174
+begin unsave; p:=fin_mlist(null);
+@y
+begin unsave; p:=fin_mlist(null);
+@z
+%-------------------------
+@x [48] m.1186
+math_group: begin unsave; decr(save_ptr);@/
+@y
+math_group: begin unsave; decr(save_ptr);@/
+@z
+%-------------------------
+@x [48] m.1191
+ else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
+@y
+ else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
+@z
+%-------------------------
+@x [48] m.1194
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ unsave; decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+@y
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural,info(math_dir_stack));
+ unsave; decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+@z
+%-------------------------
+@x [48] m.1196
+@<Finish math in text@>=
+begin tail_append(new_math(math_surround,before));
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+tail_append(new_math(math_surround,after));
+space_factor:=1000; unsave;
+end
+@y
+@<Finish math in text@> =
+begin tail_append(new_math(math_surround,before));
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+tail_append(new_math(math_surround,after));
+space_factor:=1000; unsave;
+tmp_dir_stack:=math_dir_stack;
+math_dir_stack:=link(math_dir_stack);
+free_avail(tmp_dir_stack);
+end
+@z
+%-------------------------
+@x [48] m.1199
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+mlist_to_hlist; p:=link(temp_head);@/
+adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b);
+t:=adjust_tail; adjust_tail:=null;@/
+w:=width(b); z:=display_width; s:=display_indent;
+@y
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+mlist_to_hlist; p:=link(temp_head);@/
+adjust_tail:=adjust_head; b:=hpack(p,natural,info(math_dir_stack));
+p:=list_ptr(b);
+t:=adjust_tail; adjust_tail:=null;@/
+w:=width(b); z:=display_width; s:=display_indent;
+@z
+%-------------------------
+@x [48] m.1200
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+unsave; prev_graf:=prev_graf+3;
+@y
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+unsave; prev_graf:=prev_graf+3;
+tmp_dir_stack:=math_dir_stack;
+math_dir_stack:=link(math_dir_stack);
+free_avail(tmp_dir_stack);
+@z
+%-------------------------
+@x [48] m.1201
+@<Squeeze the equation as much as possible...@>=
+begin if (e<>0)and((w-total_shrink[normal]+q<=z)or@|
+ (total_shrink[sfi]<>0)or(total_shrink[fil]<>0)or
+ (total_shrink[fill]<>0)or(total_shrink[filll]<>0)) then
+ begin free_node(b,box_node_size);
+ b:=hpack(p,z-q,exactly);
+ end
+else begin e:=0;
+ if w>z then
+ begin free_node(b,box_node_size);
+ b:=hpack(p,z,exactly);
+ end;
+ end;
+w:=width(b);
+end
+@y
+@<Squeeze the equation as much as possible...@>=
+begin if (e<>0)and((w-total_shrink[normal]+q<=z)or@|
+ (total_shrink[sfi]<>0)or(total_shrink[fil]<>0)or
+ (total_shrink[fill]<>0)or(total_shrink[filll]<>0)) then
+ begin free_node(b,box_node_size);
+ b:=hpack(p,z-q,exactly,info(math_dir_stack));
+ end
+else begin e:=0;
+ if w>z then
+ begin free_node(b,box_node_size);
+ b:=hpack(p,z,exactly,info(math_dir_stack));
+ end;
+ end;
+w:=width(b);
+end
+@z
+%-------------------------
+@x [49] m.1204
+@ @<Append the display and perhaps also the equation number@>=
+if e<>0 then
+ begin r:=new_kern(z-w-e-d);
+ if l then
+ begin link(a):=r; link(r):=b; b:=a; d:=0;
+ end
+ else begin link(b):=r; link(r):=a;
+ end;
+ b:=hpack(b,natural);
+ end;
+shift_amount(b):=s+d; append_to_vlist(b)
+@y
+@ @<Append the display and perhaps also the equation number@>=
+if e<>0 then
+ begin r:=new_kern(z-w-e-d);
+ if l then
+ begin link(a):=r; link(r):=b; b:=a; d:=0;
+ end
+ else begin link(b):=r; link(r):=a;
+ end;
+ b:=hpack(b,natural,info(math_dir_stack));
+ end;
+shift_amount(b):=s+d; append_to_vlist(b)
+@z
+%-------------------------
+@x [49] m.1210
+any_mode(assign_int),
+@y
+any_mode(assign_next_fake_math),
+any_mode(assign_int),
+any_mode(assign_dir),
+@z
+%-------------------------
+@x [49] m.1228
+assign_dimen: begin p:=cur_chr; scan_optional_equals;
+ scan_normal_dimen; word_define(p,cur_val);
+ end;
+@y
+assign_next_fake_math: next_fake_math_flag:=1;
+assign_dir: begin
+ @<DIR: Assign direction codes@>
+ end;
+assign_dimen: begin p:=cur_chr; scan_optional_equals;
+ scan_normal_dimen; word_define(p,cur_val);
+ end;
+@z
+%-------------------------
+@x [49] m.1257
+@!flushable_string:str_number; {string not yet referenced}
+@y
+@!natural_dir:integer;{the natural direction of the font}
+@!flushable_string:str_number; {string not yet referenced}
+@z
+%-------------------------
+@x [49] m.1257
+if scan_keyword("offset") then begin
+ scan_int;
+ offset:=cur_val;
+ if (cur_val<0) then begin
+ print_err("Illegal offset has been changed to 0");
+ help1("The offset must be bigger than 0."); int_error(cur_val);
+ offset:=0;
+ end
+ end
+else offset:=0;
+name_in_progress:=false;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s,offset);
+@y
+if scan_keyword("offset") then begin
+ scan_int;
+ offset:=cur_val;
+ if (cur_val<0) then begin
+ print_err("Illegal offset has been changed to 0");
+ help1("The offset must be bigger than 0."); int_error(cur_val);
+ offset:=0;
+ end
+ end
+else offset:=0;
+if scan_keyword("naturaldir") then begin
+ scan_dir;
+ natural_dir:=cur_val;
+ end
+else natural_dir:=-1;
+name_in_progress:=false;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s,offset,natural_dir);
+@z
+%-------------------------
+@x [51] m.1337
+if (loc<limit)and(cat_code(buffer[loc])<>escape) then start_input;
+ {\.{\\input} assumed}
+@y
+if (loc<limit)and(cat_code(buffer[loc])<>escape) then start_input;
+ {\.{\\input} assumed}
+@<DIR: Initialize direction stacks@>;
+@z
+%-------------------------
+@x [53] m.1341
+@d language_node=4 {|subtype| in whatsits that change the current language}
+@y
+@d language_node=4 {|subtype| in whatsits that change the current language}
+@d dir_node_size=4 {number of words in change direction node}
+@d dir_dir(#)==info(#+1) {keep the direction to be taken}
+@d dir_dvi_ptr(#)==link(#+1) {for reflecting dvi output}
+@d dir_dvi_h(#)==info(#+2) {for reflecting dvi output}
+@z
+%-------------------------
+@x [53] m.1342
+@!write_open:array[0..17] of boolean;
+@y
+@!write_open:array[0..17] of boolean;
+@!neg_wd:scaled;
+@!pos_wd:scaled;
+@!neg_ht:scaled;
+@!dvi_direction:integer;
+@!dir_primary:array[0..31] of 0..31;
+@!dir_secondary:array[0..31] of 0..31;
+@!dir_tertiary:array[0..31] of 0..31;
+@!dir_rearrange:array[0..3] of 0..31;
+@!dir_names:array[0..3] of str_number;
+@z
+%-------------------------
+@x [53] m.1343
+for k:=0 to 17 do write_open[k]:=false;
+@y
+for k:=0 to 17 do write_open[k]:=false;
+set_new_eqtb_int(dir_base+page_direction_code,0);
+set_new_eqtb_int(dir_base+body_direction_code,0);
+set_new_eqtb_int(dir_base+par_direction_code,0);
+set_new_eqtb_int(dir_base+text_direction_code,0);
+set_new_eqtb_int(dir_base+math_direction_code,0);
+set_new_eqtb_sc(dimen_base+page_height_code,55380984); {29.7cm}
+set_new_eqtb_sc(dimen_base+page_width_code,39158276); {21cm}
+set_new_eqtb_sc(dimen_base+page_bottom_offset_code,page_height-9472573);
+ {-2 inches}
+set_new_eqtb_sc(dimen_base+page_right_offset_code,page_width-9472573);
+ {-2 inches}
+for k:= 0 to 7 do begin
+ dir_primary [k ]:=dir_T;
+ dir_primary [k+ 8]:=dir_L;
+ dir_primary [k+16]:=dir_B;
+ dir_primary [k+24]:=dir_R;
+ end;
+for k:= 0 to 3 do begin
+ dir_secondary[k ]:=dir_L;
+ dir_secondary[k+ 4]:=dir_R;
+ dir_secondary[k+ 8]:=dir_T;
+ dir_secondary[k+12]:=dir_B;
+
+ dir_secondary[k+16]:=dir_L;
+ dir_secondary[k+20]:=dir_R;
+ dir_secondary[k+24]:=dir_T;
+ dir_secondary[k+28]:=dir_B;
+ end;
+for k:=0 to 7 do begin
+ dir_tertiary[k*4 ]:=dir_T;
+ dir_tertiary[k*4+1]:=dir_L;
+ dir_tertiary[k*4+2]:=dir_B;
+ dir_tertiary[k*4+3]:=dir_R;
+ end;
+dir_rearrange[0]:=0;
+dir_rearrange[1]:=0;
+dir_rearrange[2]:=1;
+dir_rearrange[3]:=1;
+dir_names[0]:="T";
+dir_names[1]:="L";
+dir_names[2]:="B";
+dir_names[3]:="R";
+@z
+%-------------------------
+@x [53] m.1344
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@y
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@d dir_whatsit_node=6 {|subtype| in whatsits for change direction node}
+@z
+%-------------------------
+@x [53] m.1344
+primitive("localinterlinepenalty",assign_int,
+ int_base+local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,
+ int_base+local_broken_penalty_code);@/
+@y
+primitive("localinterlinepenalty",assign_int,
+ int_base+local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,
+ int_base+local_broken_penalty_code);@/
+primitive("pagedir",assign_dir,dir_base+page_direction_code);@/
+primitive("bodydir",assign_dir,dir_base+body_direction_code);@/
+primitive("pardir",assign_dir,dir_base+par_direction_code);@/
+primitive("textdir",assign_dir,dir_base+text_direction_code);@/
+primitive("mathdir",assign_dir,dir_base+math_direction_code);@/
+primitive("pageheight",assign_dimen,dimen_base+page_height_code);@/
+primitive("pagewidth",assign_dimen,dimen_base+page_width_code);@/
+primitive("nextfakemath",assign_next_fake_math,0);@/
+{
+primitive("pagerightoffset",assign_dimen,dimen_base+page_right_offset_code);@/
+primitive("pagebottomoffset",assign_dimen,dimen_base+page_bottom_offset_code);@/
+}
+@z
+%-------------------------
+@x [53] m.1346
+ set_language_code:print_esc("setlanguage");
+ othercases print("[unknown extension!]")
+ endcases;
+@y
+ set_language_code:print_esc("setlanguage");
+ othercases print("[unknown extension!]")
+ endcases;
+@z
+%-------------------------
+@x [53] m.1348
+set_language_code:@<Implement \.{\\setlanguage}@>;
+@y
+set_language_code:@<Implement \.{\\setlanguage}@>;
+@z
+%-------------------------
+@x [53] m.1349
+procedure new_whatsit(@!s:small_number;@!w:small_number);
+var p:pointer; {the new node}
+begin p:=get_node(w); type(p):=whatsit_node; subtype(p):=s;
+link(tail):=p; tail:=p;
+end;
+@y
+procedure new_whatsit(@!s:small_number;@!w:small_number);
+var p:pointer; {the new node}
+begin p:=get_node(w); type(p):=whatsit_node; subtype(p):=s;
+@<LOCAL: Add info node pointer@>;
+link(tail):=p; tail:=p;
+end;
+@z
+%-------------------------
+@x [53] m.1356
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+@y
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+dir_whatsit_node:
+ if dir_dir(p)<0 then begin
+ print_esc("enddir"); print(" "); print_dir(dir_dir(p)+64);
+ end
+ else begin
+ print_esc("begindir"); print(" "); print_dir(dir_dir(p));
+ end;
+@z
+%-------------------------
+@x [53] m.1357
+close_node,language_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+@y
+close_node,language_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+dir_whatsit_node: begin r:=get_node(dir_node_size);
+ words:=small_node_size;
+ end;
+@z
+%-------------------------
+@x [53] m.1358
+close_node,language_node: free_node(p,small_node_size);
+@y
+close_node,language_node: free_node(p,small_node_size);
+dir_whatsit_node: free_node(p,dir_node_size);
+@z
+%-------------------------
+@x
+procedure make_info_node;
+{This function creates an |info_node|}
+var p:pointer;
+begin
+p:=get_node(info_size); type(p):=info_node;
+link(p):=null;
+info_ref_count(p):=1;
+info_pen_inter(p):=local_inter_line_penalty;
+info_pen_broken(p):=local_broken_penalty;
+if local_left_box=null then
+ info_left_box(p):=null
+else
+ info_left_box(p):=copy_node_list(local_left_box);
+if local_right_box=null then
+ info_right_box(p):=null
+else
+ info_right_box(p):=copy_node_list(local_right_box);
+if current_file_node=null then begin
+ info_file(p):=null;
+ end
+else begin
+ info_file(p):=current_file_node;
+ file_incr_ref_count(current_file_node);
+ end;
+eq_define(local_par_info_base,data,p);
+end;
+@y
+procedure init_local_direction; forward;
+procedure make_info_node;
+{This function creates an |info_node|}
+var p:pointer;
+begin
+if local_dir=null then init_local_direction
+else begin
+ p:=get_node(info_size); type(p):=info_node;
+ link(p):=null;
+ info_ref_count(p):=1;
+ info_pen_inter(p):=local_inter_line_penalty;
+ info_pen_broken(p):=local_broken_penalty;
+ if local_left_box=null then
+ info_left_box(p):=null
+ else
+ info_left_box(p):=copy_node_list(local_left_box);
+ if local_right_box=null then
+ info_right_box(p):=null
+ else
+ info_right_box(p):=copy_node_list(local_right_box);
+ if current_file_node=null then begin
+ info_file(p):=null;
+ end
+ else begin
+ info_file(p):=current_file_node;
+ file_incr_ref_count(current_file_node);
+ end;
+ info_dir(p):=local_dir;
+ dir_incr_ref_count(local_dir);
+ eq_define(local_par_info_base,data,p);
+ end;
+end;
+
+procedure init_local_direction;
+var new_ptr:pointer;
+ no_levels:integer;
+begin
+no_levels:=1;
+new_ptr:=get_node(dir_size+no_levels*2);
+type(new_ptr):=dir_node;
+dir_no(new_ptr):=no_levels;
+dir_ref_count(new_ptr):=1;
+mem[new_ptr+2*no_levels].int:=cur_level;
+mem[new_ptr+2*no_levels+1].int:=cur_val;
+eq_define(local_dir_base,data,new_ptr);
+make_info_node;
+end;
+
+procedure make_local_direction(new_val:integer;new_stack:boolean);
+var old_ptr,new_ptr:pointer;
+ i,no_levels:integer;
+begin
+old_ptr:=local_dir;
+if new_stack then
+ no_levels:=1
+else if mem[old_ptr+2*dir_no(old_ptr)].int=cur_level then
+ no_levels:=dir_no(old_ptr)
+else
+ no_levels:=dir_no(old_ptr)+1;
+new_ptr:=get_node(dir_size+no_levels*2);
+type(new_ptr):=dir_node;
+dir_no(new_ptr):=no_levels;
+dir_ref_count(new_ptr):=1;
+for i:=1 to no_levels-1 do begin
+ mem[new_ptr+2*i].int:=mem[old_ptr+2*i].int;
+ mem[new_ptr+2*i+1].int:=mem[old_ptr+2*i+1].int;
+ end;
+mem[new_ptr+2*no_levels].int:=cur_level;
+mem[new_ptr+2*no_levels+1].int:=new_val;
+eq_define(local_dir_base,data,new_ptr);
+make_info_node;
+end;
+@z
+%-------------------------
+@x
+@ @<LOCAL: Change file node@>=
+begin
+make_file_node;
+end
+
+@y
+@ @<LOCAL: Change file node@>=
+begin
+make_file_node;
+end
+
+@ @<LOCAL: Delete direction node@>=
+begin
+dir_decr_ref_count(p);
+end
+
+@ @<DIR: Initialize direction stacks@>=
+begin
+par_dir_stack:=null;
+math_dir_stack:=null;
+align_dir_stack:=null;
+init_local_direction;
+end
+
+@ @<DIR: Assign direction codes@>=
+case cur_chr of
+dir_base+page_direction_code: begin
+ if its_all_over then begin
+ scan_dir;
+ eq_word_define(dir_base+page_direction_code,cur_val);
+ end;
+ end;
+dir_base+body_direction_code: begin
+ if its_all_over then begin
+ scan_dir;
+ eq_word_define(dir_base+body_direction_code,cur_val);
+ end;
+ end;
+dir_base+par_direction_code: begin
+ scan_dir;
+ eq_word_define(dir_base+par_direction_code,cur_val);
+ end;
+dir_base+text_direction_code: begin scan_dir;
+ eq_word_define(dir_base+text_direction_code,cur_val);
+ make_local_direction(cur_val,false);
+ end;
+dir_base+math_direction_code: begin scan_dir;
+ eq_word_define(dir_base+math_direction_code,cur_val);
+ end;
+end;
+
+@
+@d push_dir_node(#)==
+begin dir_tmp:=get_node(dir_node_size);
+type(dir_tmp):=whatsit_node; subtype(dir_tmp):=dir_whatsit_node;
+dir_dir(dir_tmp):=#;
+link(dir_tmp):=dir_ptr; dir_ptr:=dir_tmp;
+end
+
+@d pop_dir_node==
+begin dir_tmp:=dir_ptr;
+dir_ptr:=link(dir_tmp);
+free_node(dir_tmp,dir_node_size);
+end
+
+@ @<DIR: Declare |change_dir|@>=
+procedure change_dir(p:pointer;dir:integer);
+var new_info:pointer;
+ old_info:pointer;
+ new_dir_node:pointer;
+begin
+old_info:=ptr_info(p);
+if old_info=null then confusion("changedir");
+new_info:=get_node(info_size); type(new_info):=info_node;
+link(new_info):=null;
+info_ref_count(new_info):=1;
+info_pen_inter(new_info):=info_pen_inter(old_info);
+info_pen_broken(new_info):=info_pen_broken(old_info);
+if info_left_box(old_info)=null then
+ info_left_box(new_info):=null
+else
+ info_left_box(new_info):=copy_node_list(info_left_box(old_info));
+if info_right_box(old_info)=null then
+ info_right_box(new_info):=null
+else
+ info_right_box(new_info):=copy_node_list(info_right_box(old_info));
+info_file(new_info):=info_file(old_info);
+file_incr_ref_count(info_file(old_info));
+new_dir_node:=get_node(dir_size+2);
+type(new_dir_node):=dir_node;
+dir_no(new_dir_node):=1;
+dir_ref_count(new_dir_node):=2; {core dump if we put 1; why?}
+mem[new_dir_node+2].int:=0;
+mem[new_dir_node+3].int:=dir;
+info_dir(new_info):=new_dir_node;
+ptr_info(p):=new_info;
+info_decr_ref_count(old_info);
+end
+
+@ @<DIR: Initialize the text direction@>=
+begin
+dir_ptr:=null;
+cur_direction:=dvi_direction;
+new_dir_node:=info_dir(ptr_info(p));
+for i:=1 to dir_no(new_dir_node) do
+ @<DIR: PUSH a new direction for mixed direction typesetting@>;
+prev_dir_node:=new_dir_node;
+end
+
+@ @<DIR: Finalize the text direction@>=
+begin
+for i:=dir_no(prev_dir_node) downto 1 do
+ @<DIR: POP a new direction for mixed direction typesetting@>;
+end
+
+@ @<DIR: Check if the text direction has changed@>=
+begin
+if p<>null then
+if ptr_info(p)<>null then
+if info_dir(ptr_info(p))<>null then begin
+ new_dir_node:=info_dir(ptr_info(p));
+ if new_dir_node<>prev_dir_node then begin
+ m:=dir_no(prev_dir_node);
+ if dir_no(new_dir_node)<m then m:=dir_no(new_dir_node);
+ i:=1; dir_level:=0; dir_found:=false;
+ while not dir_found do begin
+ if i>m then dir_found:=true
+ else if mem[prev_dir_node+2*i+1].int = mem[new_dir_node+2*i+1].int then
+ incr(dir_level)
+ else dir_found:=true;
+ incr(i);
+ end;
+ for i:=dir_no(prev_dir_node) downto dir_level+1 do
+ @<DIR: POP a new direction for mixed direction typesetting@>;
+ for i:=dir_level+1 to dir_no(new_dir_node) do
+ @<DIR: PUSH a new direction for mixed direction typesetting@>;
+ prev_dir_node:=new_dir_node;
+ end
+ end
+else begin print("No local node"); print_ln; end
+else begin print("No direction node"); print_ln; end
+end
+
+@ @<DIR: PUSH a new direction for mixed direction typesetting@>=begin
+ synch_h; synch_v;
+ d:=mem[new_dir_node+2*i+1].int;
+ if not((i=1) and (cur_direction=d)) then begin
+ push_dir_node(dvi_direction);
+ if dir_opposite(dir_secondary[d])(dir_secondary[dvi_direction]) then begin
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=2) then
+ dvi_out(down4)
+ else
+ dvi_out(right4);
+ dir_dvi_ptr(dir_ptr):=dvi_ptr;
+ dir_dvi_h(dir_ptr):=dvi_h;
+ dvi_four(0);
+ cur_h:=0; dvi_h:=0;
+ end
+ else begin
+ dir_dvi_ptr(dir_ptr):=dvi_ptr;
+ dir_dvi_h(dir_ptr):=dvi_h;
+ end;
+ append_string("om:");
+ append_string("startdir=");
+ append_char(dir_names[dir_primary[d]]);
+ append_char(dir_names[dir_secondary[d]]);
+ append_char(dir_names[dir_tertiary[d]]);
+ g:=make_string;
+ if length(g)<256 then
+ begin dvi_out(xxx1); dvi_out(length(g));
+ end
+ else begin dvi_out(xxx4); dvi_four(length(g));
+ end;
+ for newk:=str_start(g) to pool_ptr-1 do dvi_out(so(str_pool[newk]));
+ flush_string; {erase the string}
+ dvi_direction:=d;
+ end
+ end
+
+@ @<DIR: POP a new direction for mixed direction typesetting@>=begin
+ synch_h; synch_v;
+ d:=mem[prev_dir_node+2*i+1].int;
+ if not((i=1) and (cur_direction=d)) then begin
+ dvi_dir_h:=dir_dvi_h(dir_ptr);
+ dvi_dir_ptr:=dir_dvi_ptr(dir_ptr);
+ dvi_direction:=dir_dir(dir_ptr);
+ pop_dir_node;
+ if dir_opposite(dir_secondary[d])(dir_secondary[dvi_direction]) then begin
+ dvi_temp_ptr:=dvi_ptr;
+ dvi_ptr:=dvi_dir_ptr;
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=1) then
+ dvi_four(cur_h)
+ else
+ dvi_four(-cur_h);
+ dvi_ptr:=dvi_temp_ptr;
+ append_string("om:");
+ append_string("enddir=");
+ append_char(dir_names[dir_primary[d]]);
+ append_char(dir_names[dir_secondary[d]]);
+ append_char(dir_names[dir_tertiary[d]]);
+ g:=make_string;
+ if length(g)<256 then
+ begin dvi_out(xxx1); dvi_out(length(g));
+ end
+ else begin dvi_out(xxx4); dvi_four(length(g));
+ end;
+ for newk:=str_start(g) to pool_ptr-1 do dvi_out(so(str_pool[newk]));
+ flush_string; {erase the string}
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=2) then
+ dvi_out(down4)
+ else
+ dvi_out(right4);
+ if (dir_secondary[dvi_direction]=0) or
+ (dir_secondary[dvi_direction]=1) then
+ dvi_four(cur_h)
+ else
+ dvi_four(-cur_h);
+ cur_h:=dvi_dir_h+cur_h; dvi_h:=cur_h;
+ end
+ else begin
+ append_string("om:");
+ append_string("enddir=");
+ append_char(dir_names[dir_primary[d]]);
+ append_char(dir_names[dir_secondary[d]]);
+ append_char(dir_names[dir_tertiary[d]]);
+ g:=make_string;
+ if length(g)<256 then
+ begin dvi_out(xxx1); dvi_out(length(g));
+ end
+ else begin dvi_out(xxx4); dvi_four(length(g));
+ end;
+ for newk:=str_start(g) to pool_ptr-1 do dvi_out(so(str_pool[newk]));
+ flush_string; {erase the string}
+ end
+ end
+ end
+@z
diff --git a/Build/source/texk/web2c/omegadir/omega.c b/Build/source/texk/web2c/omegadir/omega.c
new file mode 100644
index 00000000000..e96b1444ec3
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omega.c
@@ -0,0 +1,624 @@
+/* omega.c: C routines to support the Omega Pascal Web distribution
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define EXTERN extern
+#include "omegad.h"
+
+void
+btestin(void)
+{
+ string fname =
+ kpse_find_file (nameoffile + 1, kpse_program_binary_format, true);
+
+ if (fname) {
+ libcfree(nameoffile);
+ nameoffile = (char *)xmalloc(2+strlen(fname));
+ namelength = strlen(fname);
+ strcpy(nameoffile+1, fname);
+ }
+ else {
+ libcfree(nameoffile);
+ nameoffile = (char *)xmalloc(2);
+ namelength = 0;
+ nameoffile[0] = 0;
+ nameoffile[1] = 0;
+ }
+}
+
+int
+getfilemode P2C(FILE *, f, int, def)
+{
+ int c,m;
+ if ((def==0)||(feof(f))) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0x5c) {
+ if (feof(f)) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0) m=4;
+ else m=1;
+ ungetc(c,f);
+ c=0x5c;
+ }
+ }
+ else if (c==0x25) {
+ if (feof(f)) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0) m=4;
+ else m=1;
+ ungetc(c,f);
+ c=0x25;
+ }
+ }
+ else if (c==0xe0) m=2;
+ else if (c==0x6c) m=2;
+ else if (c==0) {
+ if (feof(f)) m=0;
+ else {
+ c = getc(f);
+ if (c==EOF) m=0;
+ else if (c==0x5c) m=3;
+ else if (c==0x25) m=3;
+ else m=def;
+ ungetc(c,f);
+ c=0;
+ }
+ }
+ else m=def;
+ ungetc(c,f);
+ }
+ return m;
+}
+
+int
+getc_two_LE P1C(FILE *, f)
+{
+ register int i,j;
+ i = getc(f);
+ if (i==EOF) { return i; }
+ j = getc(f);
+ if (j==EOF) { return j; }
+ return ((j<<8)|i);
+}
+
+void
+ungetc_two_LE P2C(int, c, FILE *, f)
+{
+ ungetc((c>>8), f);
+ ungetc((c&0377), f);
+}
+
+int
+getc_two P1C(FILE *, f)
+{
+ register int i,j;
+ i = getc(f);
+ if (i==EOF) { return i; }
+ j = getc(f);
+ if (j==EOF) { return j; }
+ return ((i<<8)|j);
+}
+
+void
+ungetc_two P2C(int, c, FILE *, f)
+{
+ ungetc((c&0377), f);
+ ungetc((c>>8), f);
+}
+
+#define advance_cin if ((c_in = fgetc(f)) == EOF) return EOF
+
+int
+getc_UTF8 P1C(FILE *, f)
+{
+ register int c_in,c_out;
+
+ advance_cin;
+ if (c_in<0x80) {
+ c_out = c_in & 0x7f;
+ } else if (c_in<0xe0) {
+ c_out = (c_in & 0x1f) << 6;
+ advance_cin;
+ c_out |= c_in & 0x3f;
+ } else if (c_in<=0xf0) {
+ c_out = (c_in & 0xf) << 12;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c_out |= c_in & 0x3f;
+ } else if (c_in<0xf8) {
+ c_out = (c_in & 0x7) << 18;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 12;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c_out |= c_in & 0x3f;
+ } else if (c_in<0xfc) {
+ c_out = (c_in & 0x3) << 24;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 18;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 12;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c_out |= c_in & 0x3f;
+ } else { /* c>=0xfc */
+ c_out = (c_in & 0x1) << 30;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 24;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 18;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 12;
+ advance_cin;
+ c_out |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c_out |= c_in & 0x3f;
+ }
+ return c_out;
+}
+
+void
+ungetc_UTF8 P2C(int, c, FILE *, f)
+{
+ /* Still to be done */
+}
+
+#define advance_two_cin advance_cin; \
+ c_in_hi = c_in; \
+ advance_cin; \
+ c_in = (c_in_hi & 0xff) << 8
+
+int
+getc_UTF16 P1C(FILE *, f)
+{
+ register int c_in,c_in_hi,c_out;
+
+ advance_two_cin;
+ if ((c_in>=0xd800) && (c_in<=0xdbff)) {
+ c_out = (c_in - 0xd800) * 0x400;
+ advance_two_cin;
+ if ((c_in>=0xdc00) && (c_in<=0xdfff)) {
+ c_out += (c_in - 0xdc00) + 0x10000;
+ } else {
+ return 0xfffd;
+ }
+ } else {
+ c_out = c_in;
+ }
+ return c_out;
+}
+
+void
+ungetc_UTF16 P2C(int, c, FILE *, f)
+{
+ /* Still to be done */
+}
+
+#define advance_twoLE_cin advance_cin; \
+ c_in_lo = c_in; \
+ advance_cin; \
+ c_in = (c_in << 8) | (c_in_lo & 0xff)
+
+int
+getc_UTF16LE P1C(FILE *, f)
+{
+ register int c_in,c_in_lo,c_out;
+
+ advance_twoLE_cin;
+ if ((c_in>=0xd800) && (c_in<=0xdbff)) {
+ c_out = (c_in - 0xd800) * 0x400;
+ advance_twoLE_cin;
+ if ((c_in>=0xdc00) && (c_in<=0xdfff)) {
+ c_out += (c_in - 0xdc00) + 0x10000;
+ } else {
+ return 0xfffd;
+ }
+ } else {
+ c_out = c_in;
+ }
+ return c_out;
+}
+
+void
+ungetc_UTF16LE P2C(int, c, FILE *, f)
+{
+ /* Still to be done */
+}
+
+
+extern boolean zpnewinputln ();
+
+boolean
+newinputln P4C(FILE *,f, halfword,themode, halfword,translation, boolean,bypass)
+{
+ return zpnewinputln((alphafile)f,
+ (halfword)themode,
+ (halfword)translation,
+ (boolean) bypass);
+}
+
+boolean
+new_input_line P2C(FILE *, f, halfword, themode)
+{
+ register int i=EOF;
+
+ last = first;
+ otpinputend = 0;
+
+ if (themode==1) {
+ while ((otpinputend < ocpbufsize) && ((i = getc (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc(f); if (i != '\n') ungetc(i,f);
+ }
+ } else if (themode==2) {
+ while ((otpinputend < ocpbufsize) && ((i = getc (f)) != EOF) &&
+ (i != 0x25))
+ otpinputbuf[++otpinputend] = i;
+ } else if (themode==3) {
+ while ((otpinputend < ocpbufsize) && ((i = getc_two (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc_two(f); if (i != '\n') ungetc_two(i,f);
+ }
+ } else if (themode==4) {
+ while ((otpinputend < ocpbufsize) && ((i = getc_two_LE (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc_two_LE(f); if (i != '\n') ungetc_two_LE(i,f);
+ }
+ } else if (themode==5) {
+ while ((otpinputend < ocpbufsize) && ((i = getc_UTF8 (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc_UTF8(f); if (i != '\n') ungetc_UTF8(i,f);
+ }
+ } else if (themode==6) {
+ while ((otpinputend < ocpbufsize) && ((i = getc_UTF16 (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc_UTF16(f); if (i != '\n') ungetc_UTF16(i,f);
+ }
+ } else /* themode==7 */ {
+ while ((otpinputend < ocpbufsize) && ((i = getc_UTF16LE (f)) != EOF) &&
+ ((i != '\r') && (i != '\n')))
+ otpinputbuf[++otpinputend] = i;
+ if (i=='\r') {
+ i=getc_UTF16LE(f); if (i != '\n') ungetc_UTF16LE(i,f);
+ }
+ }
+
+ if (i == EOF && otpinputend == 0)
+ return false;
+
+ /* We didn't get the whole line because our buffer was too small.
+*/
+ if (i != EOF && (((themode!=2) && (i != '\n')) || ((themode==2) && (i != 0x25))))
+ {
+ (void) fprintf (stderr,
+ "! Unable to read an entire line---ocp_buf_size=%ld.\n",ocpbufsize);
+ (void) fprintf (stderr, "Please increase ocp_buf_size in texmf.cnf.\n");
+ uexit (1);
+ }
+
+ return true;
+}
+
+extern memoryword ziniteqtbentry () ;
+
+hashword hashtable[HASHTABLESIZE];
+
+void
+inithhashtable P1H(void)
+{
+ int i;
+ for (i=0; i<HASHTABLESIZE; i++) {
+ hashtable[i].p = -1;
+ }
+
+}
+
+hashword *
+createeqtbpos P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return runner;
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return runner;
+ }
+ runner->p = p;
+ runner->mw = ziniteqtbentry(p);
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return runner;
+}
+
+memoryword *
+createeqtbptr P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return (&(runner->mw));
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return (&(runner->mw));
+ }
+ runner->p = p;
+ runner->mw = ziniteqtbentry(p);
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return (&(runner->mw));
+}
+
+hashword *
+createxeqlevel P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return runner;
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return runner;
+ }
+ runner->p = p;
+ runner->mw.cint = 1;
+ runner->mw.cint1 = 0;
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return runner;
+}
+
+hashword *
+createhashpos P1C(int, p)
+{
+ hashword *runner= &(hashtable[p%HASHTABLESIZE]);
+ if (runner->p==p) return runner;
+ while (runner->p != -1) {
+ runner = runner->ptr;
+ if (runner->p == p) return runner;
+ }
+ runner->p = p;
+ runner->mw.cint = 0;
+ runner->mw.cint1 = 0;
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ (runner->ptr)->p = -1;
+ return runner;
+}
+
+void
+dumphhashtable P1H(void)
+{
+ int i;
+ hashword *runner;
+ for (i=0; i<HASHTABLESIZE; i++) {
+ runner=&(hashtable[i]);
+ if (runner->p != -1) {
+ dumpint(-i);
+ while (runner->p != -1) {
+ dumpint(runner->p);
+ dumpwd(runner->mw);
+ runner=runner->ptr;
+ }
+ }
+ }
+ dumpint(-HASHTABLESIZE);
+}
+
+void
+undumphhashtable P1H(void)
+{
+ int i,j;
+ hashword *runner;
+ j=0;
+ undumpint(i);
+ while (j<HASHTABLESIZE) {
+ i = (-i);
+ while (j<i) {
+ hashtable[j].p = -1;
+ j++;
+ }
+ if (i<HASHTABLESIZE) {
+ runner = &(hashtable[j]);
+ undumpint(i);
+ while (i>=0) {
+ runner->p = i;
+ undumpwd(runner->mw);
+ undumpint(i);
+ runner->ptr = (hashword *) xmalloc(sizeof(hashword));
+ runner = runner->ptr;
+ }
+ runner->p = -1;
+ j++;
+ }
+ }
+}
+
+void
+odateandtime P4C(int,timecode, int,daycode, int,monthcode, int,yearcode)
+{
+ integer tc,dc,mc,yc;
+ dateandtime(tc,dc,mc,yc);
+ setneweqtbint(timecode,tc);
+ setneweqtbint(daycode,dc);
+ setneweqtbint(monthcode,mc);
+ setneweqtbint(yearcode,yc);
+}
+
+memoryword **fonttables;
+static int font_entries = 0;
+
+void
+allocatefonttable P2C(int, font_number, int, font_size)
+{
+ int i;
+ if (font_entries==0) {
+ fonttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ font_entries=256;
+ } else if ((font_number==256)&&(font_entries==256)) {
+ fonttables = (memoryword **) xrealloc(fonttables, 65536);
+ font_entries=65536;
+ }
+ fonttables[font_number] =
+ (memoryword *) xmalloc((font_size+1)*sizeof(memoryword));
+ fonttables[font_number][0].cint = font_size;
+ fonttables[font_number][0].cint1 = 0;
+ for (i=1; i<=font_size; i++) {
+ fonttables[font_number][i].cint = 0;
+ fonttables[font_number][i].cint1 = 0;
+ }
+}
+
+void
+dumpfonttable P2C(int, font_number, int, words)
+{
+ fonttables[font_number][0].cint=words;
+ dumpthings(fonttables[font_number][0], fonttables[font_number][0].cint+1);
+}
+
+void
+undumpfonttable P1C(int, font_number)
+{
+ memoryword sizeword;
+ if (font_entries==0) {
+ fonttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ font_entries=256;
+ } else if ((font_number==256)&&(font_entries==256)) {
+ fonttables = (memoryword **) xrealloc(fonttables, 65536);
+ font_entries=65536;
+ }
+
+ undumpthings(sizeword,1);
+ fonttables[font_number] =
+ (memoryword *) xmalloc((sizeword.cint+1)*sizeof(memoryword));
+ fonttables[font_number][0].cint = sizeword.cint;
+ undumpthings(fonttables[font_number][1], sizeword.cint);
+}
+
+memoryword **fontsorttables;
+static int fontsort_entries = 0;
+
+void
+allocatefontsorttable P2C(int, fontsort_number, int, fontsort_size)
+{
+ int i;
+ if (fontsort_entries==0) {
+ fontsorttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ fontsort_entries=256;
+ } else if ((fontsort_number==256)&&(fontsort_entries==256)) {
+ fontsorttables = (memoryword **) xrealloc(fontsorttables, 65536);
+ fontsort_entries=65536;
+ }
+ fontsorttables[fontsort_number] =
+ (memoryword *) xmalloc((fontsort_size+1)*sizeof(memoryword));
+ fontsorttables[fontsort_number][0].cint = fontsort_size;
+ fontsorttables[fontsort_number][0].cint1 = 0;
+ for (i=1; i<=fontsort_size; i++) {
+ fontsorttables[fontsort_number][i].cint = 0;
+ fontsorttables[fontsort_number][i].cint1 = 0;
+ }
+}
+
+void
+dumpfontsorttable P2C(int, fontsort_number, int, words)
+{
+ fontsorttables[fontsort_number][0].cint=words;
+ dumpthings(fontsorttables[fontsort_number][0],
+ fontsorttables[fontsort_number][0].cint+1);
+}
+
+void
+undumpfontsorttable P1C(int, fontsort_number)
+{
+ memoryword sizeword;
+ if (fontsort_entries==0) {
+ fontsorttables = (memoryword **) xmalloc(256*sizeof(memoryword**));
+ fontsort_entries=256;
+ } else if ((fontsort_number==256)&&(fontsort_entries==256)) {
+ fontsorttables = (memoryword **) xrealloc(fontsorttables, 65536);
+ fontsort_entries=65536;
+ }
+
+ undumpthings(sizeword,1);
+ fontsorttables[fontsort_number] =
+ (memoryword *) xmalloc((sizeword.cint+1)*sizeof(memoryword));
+ fontsorttables[fontsort_number][0].cint = sizeword.cint;
+ undumpthings(fontsorttables[fontsort_number][1], sizeword.cint);
+}
+
+int **ocptables;
+static int ocp_entries = 0;
+
+void
+allocateocptable P2C(int, ocp_number, int, ocp_size)
+{
+ int i;
+ if (ocp_entries==0) {
+ ocptables = (int **) xmalloc(256*sizeof(int**));
+ ocp_entries=256;
+ } else if ((ocp_number==256)&&(ocp_entries==256)) {
+ ocptables = (int **) xrealloc(ocptables, 65536);
+ ocp_entries=65536;
+ }
+ ocptables[ocp_number] =
+ (int *) xmalloc((1+ocp_size)*sizeof(int));
+ ocptables[ocp_number][0] = ocp_size;
+ for (i=1; i<=ocp_size; i++) {
+ ocptables[ocp_number][i] = 0;
+ }
+}
+
+void
+dumpocptable P1C(int, ocp_number)
+{
+ dumpthings(ocptables[ocp_number][0], ocptables[ocp_number][0]+1);
+}
+
+void
+undumpocptable P1C(int, ocp_number)
+{
+ int sizeword;
+ if (ocp_entries==0) {
+ ocptables = (int **) xmalloc(256*sizeof(int**));
+ ocp_entries=256;
+ } else if ((ocp_number==256)&&(ocp_entries==256)) {
+ ocptables = (int **) xrealloc(ocptables, 65536);
+ ocp_entries=65536;
+ }
+ undumpthings(sizeword,1);
+ ocptables[ocp_number] =
+ (int *) xmalloc((1+sizeword)*sizeof(int));
+ ocptables[ocp_number][0] = sizeword;
+ undumpthings(ocptables[ocp_number][1], sizeword);
+}
diff --git a/Build/source/texk/web2c/omegadir/omega.defines b/Build/source/texk/web2c/omegadir/omega.defines
new file mode 100644
index 00000000000..e8cf7f8fdc2
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omega.defines
@@ -0,0 +1,74 @@
+{ omega.defines: Web declarations of Omega
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+}
+
+@define function newinputln ();
+@define function getfilemode ();
+@define function newinputline ();
+@define function neweqtb ();
+@define function neweqtbint ();
+@define function neweqtbsc ();
+@define function newequiv ();
+@define function newequiv1 ();
+@define function neweqlevel ();
+@define function neweqtype ();
+
+@define function newhashnext ();
+@define function newhashtext ();
+@define function newxeqlevel ();
+
+@define procedure odateandtime ();
+@define procedure allocatefonttable ();
+@define procedure dumpfonttable ();
+@define procedure undumpfonttable ();
+@define procedure allocatefontsorttable ();
+@define procedure dumpfontsorttable ();
+@define procedure undumpfontsorttable ();
+@define procedure allocateocptable ();
+@define procedure dumpocptable ();
+@define procedure undumpocptable ();
+@define procedure initeqtbtable;
+@define procedure dumpeqtbtable;
+@define procedure undumpeqtbtable;
+@define procedure setneweqtb ();
+@define procedure setneweqtbint ();
+@define procedure setneweqtbsc ();
+@define procedure setequiv ();
+@define procedure setequiv1 ();
+@define procedure seteqtype ();
+@define procedure seteqlevel ();
+@define procedure btestin ;
+@define procedure runexternalocp ();
+@define procedure changeomegafilename ();
+
+@define procedure sethashnext ();
+@define procedure sethashtext ();
+@define procedure setintzero ();
+@define procedure setintone ();
+
+@define var fonttables;
+@define var fontsorttables;
+@define var ocptables;
+
+@define var ocptemp;
+
+{ end of omega.defines }
diff --git a/Build/source/texk/web2c/omegadir/omega.mak b/Build/source/texk/web2c/omegadir/omega.mak
new file mode 100644
index 00000000000..619fe8393ea
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omega.mak
@@ -0,0 +1,270 @@
+################################################################################
+#
+# Makefile : Omega, web2c win32.mak makefile fragment to build Omega
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/03/20 16:40:28 popineau>
+#
+################################################################################
+
+Makefile: $(win32make_srcdir)/omega.mak
+
+omegafonts_programs = omegafonts\$(objdir)\omfonts.exe
+otps_programs = otps\$(objdir)\otp2ocp.exe otps\$(objdir)\outocp.exe
+omegafonts = omegafonts
+otps = otps
+
+odvicopy = $(objdir)\odvicopy.exe
+odvitype = $(objdir)\odvitype.exe
+otangle = $(objdir)\otangle.exe
+omegaware_c = odvicopy.c odvitype.c otangle.c
+omegaware_programs = $(otangle) $(odvicopy) $(odvitype)
+
+omega_programs = $(otangle) $(odvicopy) $(odvitype) \
+ $(otps_programs) $(omegafonts_programs)
+
+# Omegaware
+
+$(objdir)\odvicopy.exe: $(objdir)\odvicopy.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+
+odvicopy.c odvicopy.h: $(web2c_common) $(web2c_programs) odvicopy.p
+ $(web2c) odvicopy
+odvicopy.p: omegaware\odvicopy.web omegaware\odvicopy.ch
+ .\$(objdir)\tangle omegaware\odvicopy.web omegaware\odvicopy.ch
+check: odvicopy-check
+odvicopy-check: $(objdir)\odvicopy.exe
+# ./odvicopy $(srcdir)/tests/story tests/xstory.dvi
+## Redirect stderr so the terminal output will end up in the log file.
+# (TFMFONTS=$(srcdir)/tests: ./odvicopy <$(srcdir)/tests/pplr.dvi \
+# >tests/xpplr.dvi) 2>&1
+clean:: odvicopy-clean
+odvicopy-clean:
+# $(LIBTOOL) --mode=clean $(RM) odvicopy
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\odvicopy.obj odvicopy.c odvicopy.h odvicopy.p) do $(del) %%i $(redir_stderr) \
+ )
+# rm -f tests/xstory.dvi tests/xpplr.dvi
+
+$(objdir)\odvitype.exe: $(objdir)\odvitype.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+
+odvitype.c odvitype.h: $(web2c_common) $(web2c_programs) odvitype.p
+ $(web2c) odvitype
+
+odvitype.p: $(objdir)\tangle.exe omegaware\odvitype.web omegaware\odvitype.ch
+ $(objdir)\tangle.exe omegaware\odvitype.web omegaware\odvitype.ch
+check: odvitype-check
+odvitype-check: $(objdir)\odvitype.exe
+# ./odvitype -show-opcodes $(srcdir)/tests/story >tests/xstory.dvityp
+# ./odvitype --p=\*.\*.2 $(srcdir)/tests/pagenum.dvi >tests/xpagenum.typ
+clean:: odvitype-clean
+odvitype-clean:
+# $(LIBTOOL) --mode=clean $(RM) odvitype
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\odvitype.obj odvitype.c odvitype.h odvitype.p) do $(del) %%i $(redir_stderr) \
+ )
+# -$(del) tests/xstory.dvityp tests/xpagenum.typ
+
+$(objdir)\otangle.exe: $(objdir)\otangle.obj $(objdir)\otangle.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+otangle.c otangle.h: $(web2c_common) $(web2c_programs) otangle.p
+ $(web2c) otangle
+otangle.p: $(objdir)\tangle.exe omegaware\otangle.web omegaware\otangle.ch
+ $(objdir)\tangle omegaware\otangle.web omegaware\otangle.ch
+check: otangle-check
+otangle-check: otangle
+# otangling omega is a good check already
+clean:: otangle-clean
+otangle-clean:
+# $(LIBTOOL) --mode=clean $(RM) otangle
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\otangle.obj otangle.c otangle.h otangle.p) do $(del) %%i $(redir_stderr) \
+ )
+#
+# Omega itself.
+
+# We build omega
+omega = $(objdir)\omega.exe
+!ifdef TEX_DLL
+omega = $(omega) $(objdir)\$(library_prefix)omega.dll
+!endif
+
+omega_programs = $(omega) $(omega_programs)
+
+# The C sources.
+omega_c = omega.c
+omega_o = $(objdir)\omega.obj $(objdir)\omegafirst.obj $(objdir)\omegabis.obj
+
+# Linking
+!ifdef TEX_DLL
+$(ojbdir)\$(library_prefix)omega.exp: $(objdir)\$(library_prefix)omega.lib
+
+$(objdir)\$(library_prefix)omega.lib: $(omega_o)
+ $(archive) /DEF $(omega_o)
+
+$(objdir)\$(library_prefix)omega.dll: $(omega_o) $(objdir)\$(library_prefix)omega.exp $(objdir)\omega.res $(omegalibsdep) $(kpathsealib) $(proglib)
+ $(link_dll) $(**) $(conlibs)
+
+$(objdir)\omega.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)omega.lib $(proglib)
+ $(link) $(**) $(socketslib) $(conlibs)
+!else
+$(objdir)\omega.exe: $(omega_o) $(objdir)\win32main.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(socketlibs) $(conlibs)
+!endif
+
+
+# The C files
+$(omega_c) omegacoerce.h omegad.h: omega.p $(web2c_texmf)
+ $(web2c) omega
+# Additional C files, just copy them.
+omegafirst.c: omegadir\omega.c
+ -$(del) $@
+ @$(copy) $(srcdir)\omegadir\omega.c $@ $(redir_stdout)
+omegabis.c: omegadir\omegabis.c
+ -$(del) $@
+ @$(copy) $(srcdir)\omegadir\omegabis.c $@ $(redir_stdout)
+omegamem.h: omegadir\omegamem.h
+ -$(del) $@
+ @$(copy) $(srcdir)\omegadir\omegamem.h $@ $(redir_stdout)
+
+# The Pascal file
+omega.p omega.pool: $(objdir)\otangle.exe omega.web omega.ch
+ $(objdir)\otangle omega.web omega.ch
+
+# Generation of the web and ch files.
+omega_files = \
+ omegadir\omnode.ch \
+ omegadir\om16bit.ch \
+ omegadir\omstr.ch \
+ omegadir\omfont.ch \
+ omegadir\omchar.ch \
+ omegadir\omfi.ch \
+ omegadir\ompar.ch \
+ omegadir\omocp.ch \
+ omegadir\omfilter.ch \
+ omegadir\omtrans.ch \
+ omegadir\omdir.ch \
+ omegadir\omxml.ch
+
+omega_changefiles = \
+ omegadir\comnode.ch \
+ omegadir\com16bit.ch \
+ omegadir\comstr.ch \
+ omegadir\comfont.ch \
+ omegadir\comchar.ch \
+ omegadir\comfi.ch \
+ omegadir\compar.ch \
+ omegadir\comocp.ch \
+ omegadir\comfilter.ch \
+ omegadir\comtrans.ch \
+ omegadir\comdir.ch \
+ omegadir\comxml.ch \
+ omegadir\comsrcspec.ch \
+ omegadir\comw32.ch
+
+omega.web: .\$(objdir)\tie.exe tex.web $(omega_files) # omegadir\omega.mak
+ .\$(objdir)\tie -m omega.web tex.web $(omega_files)
+
+omega.ch: .\$(objdir)\tie.exe omega.web $(omega_changefiles) # omegadir\omega.mak
+ .\$(objdir)\tie -c omega.ch omega.web $(omega_changefiles)
+
+# Check: right now all we do is build the format.
+check: omega-check
+omega-check: omega omega.oft
+# Cleaning up from building omega
+clean:: omega-clean
+omega-clean:
+# $(LIBTOOL) --mode=clean $(RM) omega
+ -@echo $(verbose) & ( \
+ for %%i in ($(omega_o) $(omega_c) omegaextra.c omegacoerce.h omegad.h \
+ omegafirst.c omegabis.c omegamem.h \
+ omega.p omega.pool omega.web omega.ch) do $(del) %%i $(redir_stderr) \
+ )
+#
+# Dumps.
+# all_ofmts = omega.oft $(ofmts)
+
+# dumps: ofmts
+# ofmts: $(all_ofmts)
+
+# omega.oft: $(omega)
+# $(dumpenv) $(make) progname=omega files="omega.tex" prereq-check
+# $(dumpenv) .\$(objdir)\omega.exe --progname=omega --jobname=omega --ini "\input omega.tex \dump" < nul
+#
+# lambda.oft: $(omega)
+# $(dumpenv) $(make) progname=lambda files="lambda.tex" prereq-check
+# $(dumpenv) .\$(objdir)\omega.exe --progname=lambda --jobname=lambda --ini "\input lambda.tex" < nul
+
+#
+# Some additional programs for Omega: the programs themselves are named
+# in the variable otps_programs, defined above.
+otps\$(objdir)\otp2ocp.exe otps\$(objdir)\outocp.exe:
+ -@echo $(verbose) & ( \
+ pushd otps & $(make) all & popd \
+ )
+omegafonts\$(objdir)\omfonts.exe:
+ -@echo $(verbose) & ( \
+ pushd omegafonts & $(make) all & popd \
+ )
+#
+# Installation.
+install-omega: install-omega-exec install-omega-data
+install-omega-exec: install-omega-links
+# install-omega-data: install-omega-dumps
+install-omega-dumps: install-omega-fmts
+
+# The actual binary executables and pool files.
+install-programs: install-omega-programs
+install-omega-programs: $(omega_programs) $(bindir)
+ -@echo $(verbose) & ( \
+ for %p in ($(eomega)) do copy %%p $(bindir) \
+ )
+ -@echo $(verbose) & ( \
+ pushd otps & $(make) install-programs & popd \
+ )
+ -@echo $(verbose) & ( \
+ pushd omegafonts & $(make) install-programs & popd \
+ )
+
+# install-links: install-omega-links
+install-omega-links: install-omega-programs
+ -@echo $(verbose) & ( \
+ pushd omegafonts & $(make) install-links & popd \
+ )
+# -@echo $(verbose) & ( \
+# pushd $(bindir) & \
+# $(del) .\iniomega.exe .\viromega.exe & \
+# $(lnexe) .\omega.exe $(bindir)\iniomega.exe & \
+# $(lnexe) .\omega.exe $(bindir)\viromega.exe & \
+# popd \
+# ) $(redir_stdout)
+ -@echo $(verbose) & ( \
+ if not "$(ofmts)"=="" \
+ for %%i in ($(ofmts)) do \
+ pushd $(bindir) & \
+ $(del) .\%%~ni.exe & \
+ $(lnexe) .\omega.exe $(bindir)\%%~ni.exe & \
+ popd \
+ ) $(redir_stdout)
+
+# Always do plain.*, so examples from the TeXbook (etc.) will work.
+# install-fmts: install-omega-fmts
+install-omega-fmts: ofmts $(fmtdir)
+ -@echo $(verbose) & ( \
+ if not "$(all_ofmts)"=="" \
+ for %%f in ($(all_ofmts)) do \
+ $(copy) %%f $(fmtdir)\%%f $(redir_stdout) \
+ )
+
+# Auxiliary files.
+install-data:: install-omega-data
+install-omega-data: $(texpooldir)
+ @$(copy) omega.pool $(texpooldir)\omega.pool $(redir_stdout) $(redir_stdout)
+
+# end of omega.mak
+#
+# Local variables:
+# page-delimiter: "^# \f"
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/omegadir/omega.mk b/Build/source/texk/web2c/omegadir/omega.mk
new file mode 100644
index 00000000000..781564337c3
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omega.mk
@@ -0,0 +1,240 @@
+# Makefile fragment for Omega and web2c. --infovore@xs4all.nl. Public domain.
+# This fragment contains the parts of the makefile that are most likely to
+# differ between releases of Omega.
+
+Makefile: omegadir/omega.mk
+
+omegafonts_programs = omegafonts/omfonts
+otps_programs = otps/otp2ocp otps/outocp
+omegafonts = omegafonts
+otps = otps
+
+odvicopy = odvicopy
+odvitype = odvitype
+otangle = otangle
+omegaware_c = odvicopy.c odvitype.c otangle.c
+omegaware_programs = $(otangle) $(odvicopy) $(odvitype)
+
+omega_programs = $(omega) $(otangle) $(odvicopy) $(odvitype) \
+ $(otps_programs) $(omegafonts_programs)
+
+# The otangle used in the build is not be the otangle we build if we are
+# cross-compiling.
+OTANGLE = @OTANGLE@
+
+# Omegaware
+
+odvicopy: odvicopy.o
+ $(kpathsea_link) odvicopy.o $(LOADLIBES)
+odvicopy.c odvicopy.h: $(web2c_common) $(web2c_programs) odvicopy.p
+ $(web2c) odvicopy
+odvicopy.p: tangle omegaware/odvicopy.web omegaware/odvicopy.ch
+ WEBINPUTS=$(srcdir)/omegaware $(TANGLE) odvicopy odvicopy
+check: odvicopy-check
+odvicopy-check: odvicopy
+# ./odvicopy $(srcdir)/tests/story tests/xstory.dvi
+## Redirect stderr so the terminal output will end up in the log file.
+# (TFMFONTS=$(srcdir)/tests: ./odvicopy <$(srcdir)/tests/pplr.dvi \
+# >tests/xpplr.dvi) 2>&1
+clean:: odvicopy-clean
+odvicopy-clean:
+ $(LIBTOOL) --mode=clean $(RM) odvicopy
+ rm -f odvicopy.o odvicopy.c odvicopy.h odvicopy.p
+# rm -f tests/xstory.dvi tests/xpplr.dvi
+
+odvitype: odvitype.o
+ $(kpathsea_link) odvitype.o $(LOADLIBES)
+odvitype.c odvitype.h: $(web2c_common) $(web2c_programs) odvitype.p
+ $(web2c) odvitype
+odvitype.p: tangle omegaware/odvitype.web omegaware/odvitype.ch
+ WEBINPUTS=$(srcdir)/omegaware $(TANGLE) odvitype odvitype
+check: odvitype-check
+odvitype-check: odvitype
+# ./odvitype -show-opcodes $(srcdir)/tests/story >tests/xstory.dvityp
+# ./odvitype --p=\*.\*.2 $(srcdir)/tests/pagenum.dvi >tests/xpagenum.typ
+clean:: odvitype-clean
+odvitype-clean:
+ $(LIBTOOL) --mode=clean $(RM) odvitype
+ rm -f odvitype.o odvitype.c odvitype.h odvitype.p
+# rm -f tests/xstory.dvityp tests/xpagenum.typ
+
+otangle: otangle.o
+ $(kpathsea_link) otangle.o $(LOADLIBES)
+otangle.c otangle.h: $(web2c_common) $(web2c_programs) otangle.p
+ $(web2c) otangle
+otangle.p: tangle omegaware/otangle.web omegaware/otangle.ch
+ WEBINPUTS=$(srcdir)/omegaware $(TANGLE) otangle otangle
+check: otangle-check
+otangle-check: otangle
+# otangling omega is a good check already
+clean:: otangle-clean
+otangle-clean:
+ $(LIBTOOL) --mode=clean $(RM) otangle
+ rm -f otangle.o otangle.c otangle.h otangle.p
+
+#
+# Omega itself.
+
+# We build omega
+omega = @OMEGA@ omega
+
+# The C sources.
+omega_c = omegaini.c omega0.c omega1.c omega2.c omega3.c
+omega_o = omegaini.o omega0.o omega1.o omega2.o \
+ omegaextra.o omega.o omegabis.o \
+ omega3.o
+
+# Linking
+omega: $(omega_o)
+ $(kpathsea_link) $(omega_o) $(socketlibs) $(LOADLIBES)
+
+# The C files
+$(omega_c) omegacoerce.h omegad.h: omega.p $(web2c_texmf)
+ $(web2c) omega
+omegaextra.c: lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/omega/ $(srcdir)/lib/texmfmp.c >$@
+# Additional C files, just copy them.
+omega.c: omegadir/omega.c
+ -rm -f $@
+ cp $(srcdir)/omegadir/omega.c $@
+omegabis.c: omegadir/omegabis.c
+ -rm -f $@
+ cp $(srcdir)/omegadir/omegabis.c $@
+omegamem.h: omegadir/omegamem.h
+ -rm -f $@
+ cp $(srcdir)/omegadir/omegamem.h $@
+
+# The Pascal file
+omega.p omega.pool: otangle omega.web omega.ch
+ $(OTANGLE) omega.web omega.ch
+
+# Generation of the web and ch files.
+omega.web: tie tex.web omegadir/omega.mk
+omega.web: omegadir/omnode.ch
+omega.web: omegadir/om16bit.ch
+omega.web: omegadir/omstr.ch
+omega.web: omegadir/omfont.ch
+omega.web: omegadir/omchar.ch
+omega.web: omegadir/omfi.ch
+omega.web: omegadir/ompar.ch
+omega.web: omegadir/omocp.ch
+omega.web: omegadir/omfilter.ch
+omega.web: omegadir/omtrans.ch
+omega.web: omegadir/omdir.ch
+omega.web: omegadir/omxml.ch
+ $(TIE) -m omega.web $(srcdir)/tex.web \
+ $(srcdir)/omegadir/omnode.ch \
+ $(srcdir)/omegadir/om16bit.ch \
+ $(srcdir)/omegadir/omstr.ch \
+ $(srcdir)/omegadir/omfont.ch \
+ $(srcdir)/omegadir/omchar.ch \
+ $(srcdir)/omegadir/omfi.ch \
+ $(srcdir)/omegadir/ompar.ch \
+ $(srcdir)/omegadir/omocp.ch \
+ $(srcdir)/omegadir/omfilter.ch \
+ $(srcdir)/omegadir/omtrans.ch \
+ $(srcdir)/omegadir/omdir.ch \
+ $(srcdir)/omegadir/omxml.ch
+omega.ch: tie omega.web omegadir/omega.mk
+omega.ch: omegadir/comnode.ch
+omega.ch: omegadir/com16bit.ch
+omega.ch: omegadir/comstr.ch
+omega.ch: omegadir/comfont.ch
+omega.ch: omegadir/comchar.ch
+omega.ch: omegadir/comfi.ch
+omega.ch: omegadir/compar.ch
+omega.ch: omegadir/comocp.ch
+omega.ch: omegadir/comfilter.ch
+omega.ch: omegadir/comtrans.ch
+omega.ch: omegadir/comdir.ch
+omega.ch: omegadir/comxml.ch
+omega.ch: omegadir/comsrcspec.ch
+ $(TIE) -c omega.ch omega.web \
+ $(srcdir)/omegadir/comnode.ch \
+ $(srcdir)/omegadir/com16bit.ch \
+ $(srcdir)/omegadir/comstr.ch \
+ $(srcdir)/omegadir/comfont.ch \
+ $(srcdir)/omegadir/comchar.ch \
+ $(srcdir)/omegadir/comfi.ch \
+ $(srcdir)/omegadir/compar.ch \
+ $(srcdir)/omegadir/comocp.ch \
+ $(srcdir)/omegadir/comfilter.ch \
+ $(srcdir)/omegadir/comtrans.ch \
+ $(srcdir)/omegadir/comdir.ch \
+ $(srcdir)/omegadir/comxml.ch \
+ $(srcdir)/omegadir/comsrcspec.ch
+# Check: right now all we do is build the format.
+check: @OMEGA@ omega-check
+omega-check: omega omega.fmt
+# Cleaning up from building omega
+clean:: omega-clean
+omega-clean:
+ $(LIBTOOL) --mode=clean $(RM) omega
+ rm -f $(omega_c) omegaextra.c omegacoerce.h omegad.h
+ rm -f omega.c omegabis.c omegamem.h
+ rm -f omega.p omega.pool omega.web omega.ch
+
+#
+# Dumps.
+all_ofmts = @FMU@ omega.fmt $(ofmts)
+
+dumps: @OMEGA@ ofmts
+ofmts: $(all_ofmts)
+
+ofmtdir = $(web2cdir)/omega
+$(ofmtdir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(ofmtdir)
+
+omega.fmt: omega
+ $(dumpenv) $(MAKE) progname=omega files="omega.tex" prereq-check
+ $(dumpenv) ./omega --progname=omega --jobname=omega --ini \\input omega.tex \\dump </dev/null
+
+lambda.fmt: omega
+ $(dumpenv) $(MAKE) progname=lambda files="lambda.tex" prereq-check
+ $(dumpenv) ./omega --progname=lambda --jobname=lambda --ini \\input lambda.tex </dev/null
+
+
+#
+# Some additional programs for Omega: the programs themselves are named
+# in the variable otps_programs, defined above.
+otps/otp2ocp:
+ cd otps && $(MAKE) $(common_makeargs) otp2ocp
+otps/outocp:
+ cd otps && $(MAKE) $(common_makeargs) outocp
+omegafonts/omfonts:
+ cd omegafonts && $(MAKE) $(common_makeargs) omfonts
+#
+# Installation.
+install-omega: install-omega-exec install-omega-data
+install-omega-exec: install-omega-links
+install-omega-data: install-omega-pool @FMU@ install-omega-dumps
+install-omega-dumps: install-omega-fmts
+
+# The actual binary executables and pool files.
+install-programs: @OMEGA@ install-omega-programs
+install-omega-programs: $(omega_programs) $(bindir)
+ for p in omega; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+ cd otps && $(MAKE) $(install_makeargs) install-programs
+ cd omegafonts && $(MAKE) $(install_makeargs) install-programs
+
+install-links: @OMEGA@ install-omega-links
+install-omega-links: install-omega-programs
+ cd omegafonts && $(MAKE) $(install_makeargs) install-links
+ #cd $(bindir) && (rm -f iniomega viromega; \
+ # $(LN) omega iniomega; $(LN) omega viromega)
+
+# Always do plain.*, so examples from the TeXbook (etc.) will work.
+install-fmts: @OMEGA@ install-omega-fmts
+install-omega-fmts: ofmts $(ofmtdir)
+ ofmts="$(all_ofmts)"; \
+ for f in $$ofmts; do $(INSTALL_DATA) $$f $(ofmtdir)/$$f; done
+ ofmts="$(ofmts)"; \
+ for f in $$ofmts; do base=`basename $$f .fmt`; \
+ (cd $(bindir) && (rm -f $$base; $(LN) omega $$base)); done
+
+# Auxiliary files.
+install-data:: @OMEGA@ install-omega-data
+install-omega-pool: omega.pool $(texpooldir)
+ $(INSTALL_DATA) omega.pool $(texpooldir)/omega.pool
+
+# end of omega.mk
diff --git a/Build/source/texk/web2c/omegadir/omega.version b/Build/source/texk/web2c/omegadir/omega.version
new file mode 100644
index 00000000000..3dd98ba5c23
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omega.version
@@ -0,0 +1 @@
+1.23.2.3
diff --git a/Build/source/texk/web2c/omegadir/omegabis.c b/Build/source/texk/web2c/omegadir/omegabis.c
new file mode 100644
index 00000000000..c460f77148c
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omegabis.c
@@ -0,0 +1,339 @@
+/* omegabis.c: C routines to support external OCPs
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+Copyright (c) 2002 Behdad Esfahbod
+Copyright (c) 2002 Roozbeh Pournader
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+#define EXTERN extern
+#include <stdlib.h>
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+#ifndef WIN32
+#include <unistd.h>
+#endif /* not WIN32 */
+#include "omegad.h"
+
+#if 1
+
+void
+runexternalocp P1C(string, external_ocp_name)
+{
+ char *in_file_name;
+ char *out_file_name;
+ FILE *in_file;
+ FILE *out_file;
+ int in_file_fd;
+ int out_file_fd;
+ char command_line[400];
+ int i;
+ unsigned c;
+ int c_in;
+#ifdef WIN32
+ char *tempenv;
+
+#define null_string(s) ((s == NULL) || (*s == '\0'))
+
+ tempenv = getenv("TMPDIR");
+ if (null_string(tempenv))
+ tempenv = getenv("TEMP");
+ if (null_string(tempenv))
+ tempenv = getenv("TMP");
+ if (null_string(tempenv))
+ tempenv = "c:/tmp"; /* "/tmp" is not good if we are on a CD-ROM */
+ in_file_name = concat(tempenv, "/__omega__in__XXXXXX");
+ mktemp(in_file_name);
+ in_file = fopen(in_file_name, FOPEN_WBIN_MODE);
+#else
+
+#if HAVE_MKSTEMP
+ in_file_name = xstrdup("/tmp/__omega__in__XXXXXX");
+ in_file_fd = mkstemp(in_file_name);
+ in_file = fdopen(in_file_fd, FOPEN_WBIN_MODE);
+#else
+#if HAVE_MKTEMP
+ in_file_name = xstrdup("/tmp/__omega__in__XXXXXX");
+ mktemp(in_file_name);
+#else
+ in_file_name = xstrdup(tmpnam(NULL));
+#endif /* HAVE_MKTEMP */
+ in_file = fopen(in_file_name, FOPEN_WBIN_MODE);
+#endif /* HAVE_MKSTEMP */
+
+#endif /* WIN32 */
+
+ if (in_file == NULL)
+ fprintf(stderr, "omega: error opening file: %s\n", strerror(errno));
+
+ for (i=1; i<=otpinputend; i++) {
+ c = otpinputbuf[i];
+ if (c>0xffff) {
+ fprintf(stderr, "Omega does not currently support 31-bit chars\n");
+ exit(1);
+ }
+ if (c<0x80) {
+ fputc(c & 0x7f, in_file);
+ } else if (c<0x800) {
+ fputc(0xc0 | ((c>>6) & 0x1f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c<0x10000) {
+ fputc(0xe0 | ((c>>12) & 0xf), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c<0x200000) {
+ fputc(0xf0 | ((c>>18) & 0x7), in_file);
+ fputc(0x80 | ((c>>12) & 0x3f), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else if (c<0x4000000) {
+ fputc(0xf8 | ((c>>24) & 0x3), in_file);
+ fputc(0x80 | ((c>>18) & 0x3f), in_file);
+ fputc(0x80 | ((c>>12) & 0x3f), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ } else { /* c>=0x4000000 */
+ fputc(0xfc | ((c>>30) & 0x1), in_file);
+ fputc(0x80 | ((c>>24) & 0x3f), in_file);
+ fputc(0x80 | ((c>>18) & 0x3f), in_file);
+ fputc(0x80 | ((c>>12) & 0x3f), in_file);
+ fputc(0x80 | ((c>>6) & 0x3f), in_file);
+ fputc(0x80 | (c & 0x3f), in_file);
+ }
+ }
+ fclose(in_file);
+
+#define advance_cin do { if ((c_in = fgetc(out_file)) == -1) { \
+ fprintf(stderr, "File contains bad char\n"); \
+ goto end_of_while; \
+ } } while (0)
+
+#ifdef WIN32
+ out_file_name = concat(tempenv, "/__omega__out__XXXXXX");
+ mktemp(out_file_name);
+ out_file = fopen(out_file_name, FOPEN_RBIN_MODE);
+#else
+
+#if HAVE_MKSTEMP
+ out_file_name = xstrdup("/tmp/__omega__out__XXXXXX");
+ out_file_fd = mkstemp(out_file_name);
+ out_file = fdopen(out_file_fd, FOPEN_RBIN_MODE);
+#else
+#if HAVE_MKTEMP
+ out_file_name = xstrdup("/tmp/__omega__out__XXXXXX");
+ mktemp(out_file_name);
+#else
+ out_file_name = xstrdup(tmpnam(NULL));
+#endif /* HAVE_MKTEMP */
+ out_file = fopen(out_file_name, FOPEN_RBIN_MODE);
+#endif /* HAVE_MKSTEMP */
+
+#endif /* WIN32 */
+
+ if (out_file == NULL)
+ fprintf(stderr, "omega: error opening file: %s\n", strerror(errno));
+
+ sprintf(command_line, "%s <%s >%s\n",
+ external_ocp_name+1, in_file_name, out_file_name);
+ system(command_line);
+ otpoutputend = 0;
+ otpoutputbuf[otpoutputend] = 0;
+ while ((c_in = fgetc(out_file)) != -1) {
+ if (c_in<0x80) {
+ c = c_in & 0x7f;
+ } else if (c_in<0xe0) {
+ c = (c_in & 0x1f) << 6;
+ advance_cin;
+ c |= c_in & 0x3f;
+ } else if (c_in<=0xf0) {
+ c = (c_in & 0xf) << 12;
+ advance_cin;
+ c |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c |= c_in & 0x3f;
+ } else if (c_in<0xf8) {
+ c = (c_in & 0x7) << 18;
+ advance_cin;
+ c |= (c_in & 0x3f) << 12;
+ advance_cin;
+ c |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c |= c_in & 0x3f;
+ } else if (c_in<0xfc) {
+ c = (c_in & 0x3) << 24;
+ advance_cin;
+ c |= (c_in & 0x3f) << 18;
+ advance_cin;
+ c |= (c_in & 0x3f) << 12;
+ advance_cin;
+ c |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c |= c_in & 0x3f;
+ } else { /* c>=0xfc */
+ c = (c_in & 0x1) << 30;
+ advance_cin;
+ c |= (c_in & 0x3f) << 24;
+ advance_cin;
+ c |= (c_in & 0x3f) << 18;
+ advance_cin;
+ c |= (c_in & 0x3f) << 12;
+ advance_cin;
+ c |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c |= c_in & 0x3f;
+ }
+ otpoutputbuf[++otpoutputend] = c;
+ }
+end_of_while:
+ fclose(out_file);
+
+ remove(in_file_name);
+ remove(out_file_name);
+ free(in_file_name);
+ free(out_file_name);
+}
+
+#else
+
+void
+runexternalocp P1C(string, external_ocp_name)
+{
+ int outpipes[2], inpipes[2];
+ char *outbuf;
+ char *inbuf;
+ int n;
+ int chars_read_in, chars_to_go_out;
+ int myerrno;
+
+#ifdef WIN32
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+ HANDLE hIn, hOut, hPipeIn, hPipeOut;
+ SECURITY_ATTRIBUTES sa = { sizeof(SECURITY_ATTRIBUTES), NULL, TRUE };
+ DWORD ret = 0;
+
+ /* Make pipes to send data from the parent to the child. The parent
+ writes to outpipes[0], and the child reads from outpipes[1]. */
+ _pipe (outpipes, 0, _O_BINARY);
+ /* Make pipes to send data from the child to the parent. The child
+ writes to inpipes[0], and the parent reads from inpipes[1]. */
+ _pipe (inpipes, 0, _O_BINARY);
+
+ ZeroMemory( &si, sizeof(STARTUPINFO) );
+ si.cb = sizeof(STARTUPINFO);
+ si.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
+ si.wShowWindow = SW_SHOW;
+ si.hStdInput = _get_osfhandle(outpipes[0]);
+ si.hStdOutput = _get_osfhandle(inpipes[1]);
+ si.hStdError = _get_osfhandle(_fileno(stderr));
+
+ /* Close unnecessary pipes. */
+ close (outpipes[1]);
+ close (inpipes[0]);
+
+ if (CreateProcess(external_ocp_name+1,
+ NULL, /* Use lpApplicationName */
+ NULL,
+ NULL,
+ TRUE, /* bInheritHandles */
+ 0,
+ NULL,
+ NULL,
+ &si,
+ &pi) == 0) {
+ fprintf(stderr, "Failed to create process for %s (Error %d).\n", external_ocp_name+1, GetLastError());
+ return;
+ }
+
+#else /* ! WIN32 */
+
+ /* Make pipes to send data from the parent to the child. The parent
+ writes to outpipes[0], and the child reads from outpipes[1]. */
+ pipe (outpipes);
+ /* Make pipes to send data from the child to the parent. The child
+ writes to inpipes[0], and the parent reads from inpipes[1]. */
+ pipe (inpipes);
+
+ /* For a child process. */
+ if (fork () == 0)
+ {
+ /* This part is executed by the child process. It translates
+ lower case letters to upper case. */
+
+ char *prog = external_ocp_name+1;
+ char *args[] = {external_ocp_name+1, NULL};
+
+ /* Close unnecessary pipes. They are for the parent. */
+ close (outpipes[1]);
+ close (inpipes[0]);
+
+ /* Connect pipes to stdin and stdout. */
+ dup2 (outpipes[0], 0);
+ dup2 (inpipes[1], 1);
+
+ /* Overlays a new process image on an old process. */
+ execv (prog, args);
+
+ /* We should never reach here. */
+ }
+ else
+ {
+ /* Close unnecessary pipes. They are for the child. */
+ close (outpipes[0]);
+ close (inpipes[1]);
+
+#endif /* WIN32 */
+
+/* Here is the interesting part */
+ outbuf = ((char *) otpinputbuf)+2;
+ inbuf = ((char *) otpoutputbuf)+2;
+ chars_to_go_out = 2*otpinputend;
+ chars_read_in = 0;
+ while ((n = write (outpipes[1], outbuf, chars_to_go_out))>0) {
+fprintf(stderr, "Wrote (1) %d characters\n", n);
+ outbuf+=n;
+ chars_to_go_out-=n;
+ if (chars_to_go_out==0) goto done_writing;
+/*
+ n = read (inpipes[0], inbuf, 1024);
+fprintf(stderr, "Read (1) %d characters\n", n);
+ inbuf+=n;
+ chars_read_in+=n;
+*/
+ }
+fprintf(stderr, "Wrote (2) %d characters\n", n);
+
+done_writing:
+ close (outpipes[1]);
+ while ((n = read (inpipes[0], inbuf, 1024)) > 0) {
+fprintf(stderr, "Read (2) %d characters\n", n);
+ inbuf+=n;
+ chars_read_in+=n;
+ }
+fprintf(stderr, "Read (3) %d characters\n", n);
+ otpoutputend = chars_read_in / 2;
+
+ close (inpipes[0]);
+#ifndef WIN32
+ }
+#endif /* not WIN32 */
+}
+
+#endif
diff --git a/Build/source/texk/web2c/omegadir/omegaextra.h b/Build/source/texk/web2c/omegadir/omegaextra.h
new file mode 100644
index 00000000000..5ed66b83978
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omegaextra.h
@@ -0,0 +1,38 @@
+/* omegaextra.h: banner etc. for Omega.
+
+ This is included by Omega, from ../omegaextra.c
+ (generated from ../lib/texmfmp.c).
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define BANNER "This is Omega, Version 3.141592-1.23.2.3"
+#define COPYRIGHT_HOLDER "J. Plaice and Y. Haralambous"
+#define AUTHOR NULL
+#define PROGRAM_HELP OMEGAHELP
+#define BUG_ADDRESS "tex-k@mail.tug.org"
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "iniomega"
+#define VIR_PROGRAM "viromega"
diff --git a/Build/source/texk/web2c/omegadir/omegamem.h b/Build/source/texk/web2c/omegadir/omegamem.h
new file mode 100644
index 00000000000..9084d96147b
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omegamem.h
@@ -0,0 +1,145 @@
+/* omegamem.h: C declarations for types and accessing routines in omega.c
+
+This file is part of the Omega project, which
+is based on the web2c distribution of TeX.
+
+Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+
+/* argument(s) added to function, by team 18 */
+extern boolean new_input_line (FILE *, halfword);
+/* argument(s) added to function, by team 18 */
+extern boolean newinputln (FILE*, halfword, halfword, boolean);
+extern int getc_two ();
+/* argument(s) added to function, by team 18 */
+extern int getfilemode (FILE*, int);
+extern void ungetc_two ();
+extern int ocptemp;
+
+#define newinputline(stream, mode, flag) new_input_line (stream, mode)
+
+extern memoryword **fonttables;
+extern memoryword **fontsorttables;
+extern int **ocptables;
+
+typedef struct hashw
+{
+ integer p;
+ struct hashw *ptr;
+ memoryword mw;
+} hashword;
+
+extern hashword hashtable[];
+/* argument(s) added to function, by team 18 */
+extern hashword *createhashpos(int);
+/* argument(s) added to function, by team 18 */
+extern hashword *createeqtbpos(int);
+/* argument(s) added to function, by team 18 */
+extern hashword *createxeqlevel(int);
+extern void inithhashtable();
+extern void dumphhashtable();
+extern void undumphhashtable();
+/* argument(s) added to function, by team 18 */
+extern void allocatefonttable(int,int);
+/* argument(s) added to function, by team 18 */
+extern void dumpfonttable(int,int);
+/* argument(s) added to function, by team 18 */
+extern void undumpfonttable(int);
+/* argument(s) added to function, by team 18 */
+extern void allocatefontsorttable(int,int);
+/* argument(s) added to function, by team 18 */
+extern void dumpfontsorttable(int , int);
+/* argument(s) added to function, by team 18 */
+extern void undumpfontsorttable(int);
+/* argument(s) added to function, by team 18 */
+extern void allocateocptable(int,int);
+/* argument(s) added to function, by team 18 */
+extern void dumpocptable(int);
+/* argument(s) added to function, by team 18 */
+extern void undumpocptable(int);
+/* argument(s) added to function, by team 18 */
+extern void odateandtime(int, int, int, int );
+extern void btestin();
+extern void runexternalocp(char *);
+
+#define initeqtbtable() inithhashtable();
+#define dumpeqtbtable() dumphhashtable();
+#define undumpeqtbtable() undumphhashtable();
+
+#define HASHTABLESIZE 23123
+#define neweqtb(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw) : \
+ (createeqtbpos(a)->mw))
+#define neweqtbint(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint) : \
+ (createeqtbpos(a)->mw.cint))
+#define neweqtbsc(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint) : \
+ (createeqtbpos(a)->mw.cint))
+#define newequiv(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.rh) : \
+ (createeqtbpos(a)->mw.hh.rh))
+#define newequiv1(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint1) : \
+ (createeqtbpos(a)->mw.cint1))
+#define neweqlevel(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b1) : \
+ (createeqtbpos(a)->mw.hh.b1))
+#define neweqtype(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b0) : \
+ (createeqtbpos(a)->mw.hh.b0))
+#define setneweqtb(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw=v) : \
+ (createeqtbpos(a)->mw=v))
+#define setneweqtbint(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint=v) : \
+ (createeqtbpos(a)->mw.cint=v))
+#define setneweqtbsc(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint=v) : \
+ (createeqtbpos(a)->mw.cint=v))
+#define setequiv(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.rh=v) : \
+ (createeqtbpos(a)->mw.hh.rh=v))
+#define setequiv1(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint1=v) : \
+ (createeqtbpos(a)->mw.cint1=v))
+#define seteqlevel(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b1=v) : \
+ (createeqtbpos(a)->mw.hh.b1=v))
+#define seteqtype(a,v) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.b0=v) : \
+ (createeqtbpos(a)->mw.hh.b0=v))
+
+#define newhashnext(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.LH) : \
+ (createhashpos(a)->mw.hh.v.LH))
+#define newhashtext(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.RH) : \
+ (createhashpos(a)->mw.hh.v.RH))
+#define sethashnext(a,d) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.LH=d) : \
+ (createhashpos(a)->mw.hh.v.LH=d))
+#define sethashtext(a,d) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.hh.v.RH=d) : \
+ (createhashpos(a)->mw.hh.v.RH=d))
+
+#define newxeqlevel(a) (((a)==hashtable[(a)%HASHTABLESIZE].p) ? \
+ (hashtable[(a)%HASHTABLESIZE].mw.cint) : \
+ (createxeqlevel(a)->mw.cint))
+
+#define setintzero(w,a) ((w).cint=(a))
+#define setintone(w,a) ((w).cint1=(a))
diff --git a/Build/source/texk/web2c/omegadir/omfi.ch b/Build/source/texk/web2c/omegadir/omfi.ch
new file mode 100644
index 00000000000..9efd518937c
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omfi.ch
@@ -0,0 +1,246 @@
+% omfi.ch: Primitives for extra level of infinity.
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [10] m.135 l.2878 - Omega fi order of infinity
+specifies the order of infinity to which glue setting applies (|normal|,
+|fil|, |fill|, or |filll|). The |subtype| field is not used.
+@y
+specifies the order of infinity to which glue setting applies (|normal|,
+|sfi|, |fil|, |fill|, or |filll|). The |subtype| field is not used.
+@z
+%---------------------------------------
+@x [10] m.150 l.3136 - Omega fi order of infinity
+orders of infinity (|normal|, |fil|, |fill|, or |filll|)
+@y
+orders of infinity (|normal|, |sfi|, |fil|, |fill|, or |filll|)
+@z
+%---------------------------------------
+@x [10] m.150 l.3145 - Omega fi order of infinity
+@d fil=1 {first-order infinity}
+@d fill=2 {second-order infinity}
+@d filll=3 {third-order infinity}
+@y
+@d sfi=1 {first-order infinity}
+@d fil=2 {second-order infinity}
+@d fill=3 {third-order infinity}
+@d filll=4 {fourth-order infinity}
+@z
+%---------------------------------------
+@x [10] m.150 l.3150 - Omega fi order of infinity
+@!glue_ord=normal..filll; {infinity to the 0, 1, 2, or 3 power}
+@y
+@!glue_ord=normal..filll; {infinity to the 0, 1, 2, 3, or 4 power}
+@z
+%---------------------------------------
+@x [11] m.162 l.3296 - Omega fi order of infinity
+@d fil_glue==zero_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
+@y
+@d sfi_glue==zero_glue+glue_spec_size {\.{0pt plus 1fi minus 0pt}}
+@d fil_glue==sfi_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
+@z
+%---------------------------------------
+@x [11] m.164 l.3296 - Omega fi order of infinity
+stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
+@y
+stretch(sfi_glue):=unity; stretch_order(sfi_glue):=sfi;@/
+stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
+@z
+%---------------------------------------
+@x [12] m.177 l.3591 - Omega fi order of infinity
+ begin print("fil");
+ while order>fil do
+@y
+ begin print("fi");
+ while order>sfi do
+@z
+%---------------------------------------
+@x [26] m.454 l.8924 - Omega fi order of infinity
+if scan_keyword("fil") then
+@.fil@>
+ begin cur_order:=fil;
+@y
+if scan_keyword("fi") then
+@.fil@>
+ begin cur_order:=sfi;
+@z
+%---------------------------------------
+@x [33] m.650 l.12877 - Omega fi order of infinity
+total_stretch[fil]:=0; total_shrink[fil]:=0;
+@y
+total_stretch[sfi]:=0; total_shrink[sfi]:=0;
+total_stretch[fil]:=0; total_shrink[fil]:=0;
+@z
+%---------------------------------------
+@x [33] m.659 l.12996 - Omega fi order of infinity
+else if total_stretch[fil]<>0 then o:=fil
+@y
+else if total_stretch[fil]<>0 then o:=fil
+else if total_stretch[sfi]<>0 then o:=sfi
+@z
+%---------------------------------------
+@x [33] m.665 l.13061 - Omega fi order of infinity
+else if total_shrink[fil]<>0 then o:=fil
+@y
+else if total_shrink[fil]<>0 then o:=fil
+else if total_shrink[sfi]<>0 then o:=sfi
+@z
+%---------------------------------------
+@x [38] m.822 l.16135 - Omega fi order of infinity
+contains six scaled numbers, since it must record the net change in glue
+stretchability with respect to all orders of infinity. The natural width
+difference appears in |mem[q+1].sc|; the stretch differences in units of
+pt, fil, fill, and filll appear in |mem[q+2..q+5].sc|; and the shrink difference
+appears in |mem[q+6].sc|. The |subtype| field of a delta node is not used.
+
+@d delta_node_size=7 {number of words in a delta node}
+@y
+contains seven scaled numbers, since it must record the net change in glue
+stretchability with respect to all orders of infinity. The natural width
+difference appears in |mem[q+1].sc|; the stretch differences in units of
+pt, sfi, fil, fill, and filll appear in |mem[q+2..q+6].sc|; and the shrink
+difference appears in |mem[q+7].sc|. The |subtype| field of a delta node
+is not used.
+
+@d delta_node_size=8 {number of words in a delta node}
+@z
+%---------------------------------------
+@x [38] m.823 l.16144 - Omega fi order of infinity
+@ As the algorithm runs, it maintains a set of six delta-like registers
+for the length of the line following the first active breakpoint to the
+current position in the given hlist. When it makes a pass through the
+active list, it also maintains a similar set of six registers for the
+@y
+@ As the algorithm runs, it maintains a set of seven delta-like registers
+for the length of the line following the first active breakpoint to the
+current position in the given hlist. When it makes a pass through the
+active list, it also maintains a similar set of seven registers for the
+@z
+%---------------------------------------
+@x [38] m.823 l.16154 - Omega fi order of infinity
+k:=1 to 6 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
+want to do this without the overhead of |for| loops. The |do_all_six|
+macro makes such six-tuples convenient.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6)
+
+@<Glo...@>=
+@!active_width:array[1..6] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..6] of scaled; {distance from current active node}
+@!background:array[1..6] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..6] of scaled; {length being computed after current break}
+@y
+k:=1 to 7 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
+want to do this without the overhead of |for| loops. The |do_all_six|
+macro makes such six-tuples convenient.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6);#(7)
+
+@<Glo...@>=
+@!active_width:array[1..7] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..7] of scaled; {distance from current active node}
+@!background:array[1..7] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..7] of scaled; {length being computed after current break}
+@z
+%---------------------------------------
+@x [38] m.827 l.16242 - Omega fi order of infinity
+background[2]:=0; background[3]:=0; background[4]:=0; background[5]:=0;@/
+@y
+background[2]:=0; background[3]:=0; background[4]:=0; background[5]:=0;@/
+background[6]:=0;@/
+@z
+%---------------------------------------
+@x [38] m.827 l.16260 - Omega fi order of infinity
+background[6]:=shrink(q)+shrink(r);
+@y
+background[7]:=shrink(q)+shrink(r);
+@z
+%---------------------------------------
+@x [38] m.838 l.16470 - Omega fi order of infinity
+break_width[6]:=break_width[6]-shrink(v);
+@y
+break_width[7]:=break_width[7]-shrink(v);
+@z
+%---------------------------------------
+@x [38] m.852 l.16713 - Omega fi order of infinity
+subarray |cur_active_width[2..5]|, in units of points, fil, fill, and filll.
+@y
+subarray |cur_active_width[2..6]|, in units of points, sfi, fil, fill and filll.
+@z
+%---------------------------------------
+@x [38] m.852 l.16722 - Omega fi order of infinity
+if (cur_active_width[3]<>0)or(cur_active_width[4]<>0)or@|
+ (cur_active_width[5]<>0) then
+@y
+if (cur_active_width[3]<>0)or(cur_active_width[4]<>0)or@|
+ (cur_active_width[5]<>0)or(cur_active_width[6]<>0) then
+@z
+%---------------------------------------
+@x [38] m.853 l.16738 - Omega fi order of infinity
+we can shrink the line from |r| to |cur_p| by at most |cur_active_width[6]|.
+
+@<Set the value of |b| to the badness for shrinking...@>=
+begin if -shortfall>cur_active_width[6] then b:=inf_bad+1
+else b:=badness(-shortfall,cur_active_width[6]);
+@y
+we can shrink the line from |r| to |cur_p| by at most |cur_active_width[7]|.
+
+@<Set the value of |b| to the badness for shrinking...@>=
+begin if -shortfall>cur_active_width[7] then b:=inf_bad+1
+else b:=badness(-shortfall,cur_active_width[7]);
+@z
+%---------------------------------------
+@x [39] m.868 l.17054 - Omega fi order of infinity
+active_width[6]:=active_width[6]+shrink(q)
+@y
+active_width[7]:=active_width[7]+shrink(q)
+@z
+%---------------------------------------
+@x [44] m.975 l.18932 - Omega fi order of infinity
+ if (active_height[3]<>0) or (active_height[4]<>0) or
+ (active_height[5]<>0) then b:=0
+ else b:=badness(h-cur_height,active_height[2])
+else if cur_height-h>active_height[6] then b:=awful_bad
+else b:=badness(cur_height-h,active_height[6])
+@y
+ if (active_height[3]<>0) or (active_height[4]<>0) or
+ (active_height[5]<>0) or (active_height[6]<>0) then b:=0
+ else b:=badness(h-cur_height,active_height[2])
+else if cur_height-h>active_height[7] then b:=awful_bad
+else b:=badness(cur_height-h,active_height[7])
+@z
+%---------------------------------------
+@x [44] m.976 l.18947 - Omega fi order of infinity
+ active_height[6]:=active_height[6]+shrink(q);
+@y
+ active_height[7]:=active_height[7]+shrink(q);
+@z
+%---------------------------------------
+@x [48] m.1201 l.22454 - Omega fi order of infinity
+ (total_shrink[fil]<>0)or(total_shrink[fill]<>0)or
+ (total_shrink[filll]<>0)) then
+@y
+ (total_shrink[sfi]<>0)or(total_shrink[fil]<>0)or
+ (total_shrink[fill]<>0)or(total_shrink[filll]<>0)) then
+@z
+
diff --git a/Build/source/texk/web2c/omegadir/omfilter.ch b/Build/source/texk/web2c/omegadir/omfilter.ch
new file mode 100644
index 00000000000..7a739d66d51
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omfilter.ch
@@ -0,0 +1,925 @@
+% omfilter.ch: Running OCP programs
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.412 - Omega Filtering
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@y
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@!active_mem_size=2000; {number of words of |active_info| for active ocps}
+@z
+%---------------------------------------
+@x [5] - Omega Translation
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("Omega capacity exceeded, sorry [");
+@.TeX capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+ ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+@y
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("Omega capacity exceeded, sorry [");
+@.TeX capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+ ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+
+procedure overflow_ocp_buf_size;
+begin
+overflow("ocp_buf_size",ocp_buf_size);
+end;
+
+procedure overflow_ocp_stack_size;
+begin
+overflow("ocp_stack_size",ocp_stack_size);
+end;
+@z
+%---------------------------------------
+@x [22] m.300 l.6425 - Omega Filtering
+@!in_state_record = record
+ @!state_field, @!index_field: quarterword;
+ @!start_field,@!loc_field, @!limit_field, @!name_field: halfword;
+ end;
+@y
+@!in_state_record = record
+ @!state_field, @!index_field: quarterword;
+ @!start_field,@!loc_field, @!limit_field, @!name_field,
+ @!ocp_lstack_field: halfword; {used for omega translation processes}
+ @!ocp_no_field: halfword; {used for omega translation processes}
+ end;
+@z
+%---------------------------------------
+@x [22] m.300 l.6444 - Omega Filtering
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d name==cur_input.name_field {name of the current file}
+@y
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d name==cur_input.name_field {name of the current file}
+@d current_ocp_lstack==cur_input.ocp_lstack_field {name of the current ocp}
+@d current_ocp_no==cur_input.ocp_no_field {name of the current ocp}
+@z
+%---------------------------------------
+@x [22] m.312 l.6766 - Omega Filtering
+ if state<>token_list then
+ begin @<Print location of current line@>;
+ @<Pseudoprint the line@>;
+@y
+ if current_ocp_lstack>0 then
+ begin print_nl("OCP stack "); print_scaled(current_ocp_lstack);
+ print(" entry "); print_int(current_ocp_no); print(":");
+ @<Pseudoprint the line@>;
+ end
+ else if state<>token_list then
+ begin @<Print location of current line@>;
+ @<Pseudoprint the line@>;
+@z
+%---------------------------------------
+@x [23] m.331 l.7069 - Omega Filtering
+state:=new_line; start:=1; index:=0; line:=0; name:=0;
+@y
+state:=new_line; start:=1; index:=0; line:=0; name:=0;
+current_ocp_lstack:=0; current_ocp_no:=0;
+@z
+%---------------------------------------
+@x [24] m.343 l.7248 - Omega Filtering
+else begin state:=new_line;@/
+ @<Move to next line of file,
+@y
+else begin
+ if current_ocp_lstack>0 then
+ begin
+ pop_input; goto restart;
+ end;
+ state:=new_line;
+ @<Move to next line of file,
+@z
+%---------------------------------------
+@x [30] m.582 l.11283 - Omega Filtering
+char_warning(f,c);
+new_character:=null;
+exit:end;
+@y
+char_warning(f,c);
+new_character:=null;
+exit:end;
+
+@
+@<Types...@>=
+@!active_index=0..active_mem_size;
+
+@
+@d active_ocp(#)==active_info[#].hh.b0
+@d active_counter(#)==active_info[#].hh.b1
+@d active_lstack_no(#)==active_info[#+1].sc
+
+@<Glob...@>=
+@!active_info:array[active_index] of memory_word;
+@!active_min_ptr:active_index; {first unused word of |active_info|}
+@!active_max_ptr:active_index; {last unused word of |active_info|}
+@!active_real:active_index;
+@!holding:array[active_index] of ocp_list_index;
+
+@
+@<Initialize table...@>=
+active_min_ptr:=0;
+active_real:=0;
+
+@
+@p
+function is_last_ocp(llstack_no:scaled; counter:integer):integer;
+begin
+active_min_ptr:=equiv(ocp_active_min_ptr_base);
+active_max_ptr:=equiv(ocp_active_max_ptr_base);
+active_real:=active_min_ptr;
+while (active_real < active_max_ptr) and
+ (active_lstack_no(active_real) < llstack_no) do begin
+ active_real:=active_real+2;
+ end;
+while (active_real < active_max_ptr) and
+ (active_lstack_no(active_real) = llstack_no) and
+ (active_counter(active_real) <= counter) do begin
+ active_real:=active_real+2;
+ end;
+is_last_ocp := (active_real=active_max_ptr);
+end;
+
+procedure print_active_ocps;
+var i:integer;
+begin
+print_nl("Active ocps: [");
+i:=active_min_ptr;
+while i<active_max_ptr do begin
+ print("(");
+ print_scaled(active_lstack_no(i));
+ print(",");
+ print_int(active_counter(i));
+ print(",");
+ print_esc(ocp_id_text(active_ocp(i)));
+ print(")");
+ if i<>(active_max_ptr-2) then print(",");
+ i:=i+2;
+ end;
+print("]");
+end;
+
+procedure add_ocp_stack(min_index:integer; min_value:scaled);
+var p:ocp_lstack_index;
+ llstack_no:scaled;
+ counter:integer;
+begin
+p:=ocp_list_lstack(holding[min_index]);
+llstack_no:=ocp_list_lstack_no(holding[min_index]);
+counter:=0;
+while not (is_null_ocp_lstack(p)) do begin
+ active_ocp(active_max_ptr):=ocp_lstack_ocp(p);
+ active_counter(active_max_ptr):=counter;
+ active_lstack_no(active_max_ptr):=llstack_no;
+ p:=ocp_lstack_lnext(p);
+ active_max_ptr:=active_max_ptr+2;
+ incr(counter); {no overflow problem}
+ end;
+end;
+
+procedure active_compile;
+var i:integer;
+ min_index:integer;
+ min_stack_ocp:scaled;
+ old_min:scaled;
+ max_active:integer;
+ stack_value:scaled;
+begin
+active_min_ptr:=active_max_ptr;
+min_stack_ocp:=ocp_maxint;
+max_active:=equiv(ocp_active_number_base)-1;
+for i:=max_active downto 0 do begin
+ holding[i]:=ocp_list_list[equiv(ocp_active_base+i)];
+ stack_value:=ocp_list_lstack_no(holding[i]);
+ if stack_value<min_stack_ocp then begin
+ min_index:=i;
+ min_stack_ocp:=stack_value;
+ end;
+ end;
+while min_stack_ocp<ocp_maxint do begin
+ add_ocp_stack(min_index, min_stack_ocp);
+ old_min:=min_stack_ocp;
+ min_stack_ocp:=ocp_maxint;
+ for i:=max_active downto 0 do begin
+ stack_value:=ocp_list_lstack_no(holding[i]);
+ while old_min=stack_value do begin
+ holding[i]:=ocp_list_lnext(holding[i]);
+ stack_value:=ocp_list_lstack_no(holding[i]);
+ end;
+ if stack_value<min_stack_ocp then begin
+ min_index:=i;
+ min_stack_ocp:=stack_value;
+ end;
+ end;
+ end;
+end;
+
+@z
+%---------------------------------------
+@x [46] m.1030 l.19984 - Omega Filtering
+main_loop:@<Append character |cur_chr| and the following characters (if~any)
+ to the current hlist in the current font; |goto reswitch| when
+ a non-character has been fetched@>;
+@y
+main_loop:
+if is_last_ocp(current_ocp_lstack,current_ocp_no) then begin
+ @<Append character |cur_chr| and the following characters (if~any)
+ to the current hlist in the current font; |goto reswitch| when
+ a non-character has been fetched@>;
+ end
+else begin
+ @<Create a buffer with character |cur_chr| and the following
+ characters (if~any) and then apply the current active OCP filter
+ to this buffer@>;
+ end;
+@z
+%---------------------------------------
+@x [50] m.1302 l.23862 - Omega Filtering
+@<Dump the font information@>;
+@y
+@<Dump the font information@>;
+@<Dump the active ocp information@>;
+@z
+%---------------------------------------
+@x [50] m.1303 l.23711 - Omega Filtering
+@<Undump the font information@>;
+@y
+@<Undump the font information@>;
+@<Undump the active ocp information@>;
+@z
+%---------------------------------------
+@x [50] m.1323 l.24907 - Omega Filtering
+begin undump_font_table(k);@/
+end
+@y
+begin undump_font_table(k);@/
+end
+
+@ @<Dump the active ocp information@>=
+dump_int(active_min_ptr);
+dump_int(active_max_ptr);
+for k:=0 to active_max_ptr-1 do dump_wd(active_info[k]);
+print_ln; print_int(active_max_ptr); print(" words of active ocps");
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+for k:=0 to active_max_ptr-1 do undump_wd(active_info[k]);
+
+@z
+%---------------------------------------
+@x [54] m.1379 l.24883 - Omega Filtering
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+@y
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+
+@
+@<Types...@>=
+
+@ Here are all the instructions in our mini-assembler.
+@d otp_right_output=1
+@d otp_right_num=2
+@d otp_right_char=3
+@d otp_right_lchar=4
+@d otp_right_some=5
+
+@d otp_pback_output=6
+@d otp_pback_num=7
+@d otp_pback_char=8
+@d otp_pback_lchar=9
+@d otp_pback_some=10
+
+@d otp_add=11
+@d otp_sub=12
+@d otp_mult=13
+@d otp_div=14
+@d otp_mod=15
+@d otp_lookup=16
+@d otp_push_num=17
+@d otp_push_char=18
+@d otp_push_lchar=19
+
+@d otp_state_change=20
+@d otp_state_push=21
+@d otp_state_pop=22
+
+@d otp_left_start=23
+@d otp_left_return=24
+@d otp_left_backup=25
+
+@d otp_goto=26
+@d otp_goto_ne=27
+@d otp_goto_eq=28
+@d otp_goto_lt=29
+@d otp_goto_le=30
+@d otp_goto_gt=31
+@d otp_goto_ge=32
+@d otp_goto_no_advance=33
+@d otp_goto_beg=34
+@d otp_goto_end=35
+
+@d otp_stop=36
+
+@
+@<Glob...@>=
+@!otp_init_input_start:halfword;
+@!otp_init_input_last:halfword;
+@!otp_init_input_end:halfword;
+@!otp_i:halfword;
+@!otp_init_input_buf:array[0..20000] of quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:array[0..20000] of quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:array[0..20000] of quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:array[0..1000] of quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:array[0..1000] of halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:array[0..1000] of halfword;
+
+@!otp_input_char:halfword;
+@!otp_calculated_char:halfword;
+@!otp_no_input_chars:halfword;
+
+@!otp_instruction:halfword;
+@!otp_instr:halfword;
+@!otp_arg:halfword;
+@!otp_first_arg:halfword;
+@!otp_second_arg:halfword;
+
+@!otp_input_ocp:halfword;
+@!otp_counter:halfword;
+
+@!otp_finished:boolean;
+@!otp_ext_str:integer;
+@!otp_ext_str_arg:integer;
+@!otp_ext_i:integer;
+
+@
+@<Initialize table...@>=
+
+@
+@<Create a buffer with character |cur_chr| and the following
+ characters (if~any) and then apply the current active OCP filter
+ to this buffer@>=
+begin
+@<Read in the buffer for treatment@>;
+@<Apply the OCP to the input buffer@>;
+@<Place the output buffer back on the stream@>;
+goto big_switch;
+end;
+
+@
+@<Read in the buffer for treatment@>=
+begin
+otp_init_input_end:=0;
+while (cur_cmd=letter) or (cur_cmd=other_char) or
+ (cur_cmd=char_given) or (cur_cmd=spacer) do begin
+ incr(otp_init_input_end);
+ if otp_init_input_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_init_input_buf[otp_init_input_end]:=cur_chr;
+ get_token;
+ if (cur_cmd<>letter) and (cur_cmd<>other_char) and
+ (cur_cmd<>char_given) then begin
+ x_token;
+ if (cur_cmd=char_num) then begin
+ scan_char_num; cur_cmd:=other_char; cur_chr:=cur_val;
+ end;
+ end;
+ end;
+back_input;
+otp_input_end:=otp_init_input_end;
+for otp_i:=0 to otp_init_input_end do begin
+ otp_input_buf[otp_i]:=otp_init_input_buf[otp_i];
+ end;
+end
+
+@
+@<Apply the OCP to the input buffer@>=
+begin
+otp_input_ocp:=active_ocp(active_real);
+if otp_input_ocp=0 then begin
+ print_nl("Null ocp being used: all input lost");
+ otp_output_end:=0;
+ end
+else if ocp_external(otp_input_ocp)=0 then begin
+ otp_input_start:=0;
+ otp_input_last:=0;
+ otp_stack_used:=0;
+ otp_stack_last:=0;
+ otp_stack_new:=0;
+ otp_output_end:=0;
+ otp_pc:=0;
+ otp_finished:=false;
+ otp_calc_ptr:=0;
+ otp_calcs[otp_calc_ptr]:=0;
+ otp_state_ptr:=0;
+ otp_states[otp_state_ptr]:=0;
+ while not otp_finished do
+ @<Run the OTP program@>;
+ end
+else begin
+ k:=0;
+ if name_of_file then libc_free (name_of_file);
+ otp_ext_str:=ocp_external(otp_input_ocp);
+ otp_ext_str_arg:=ocp_external_arg(otp_input_ocp);
+ name_of_file :=
+ xmalloc_array (char, 3 + length(otp_ext_str) + length(otp_ext_str_arg));
+ for otp_ext_i:=str_start(otp_ext_str) to
+ str_start(otp_ext_str)+length(otp_ext_str)-1 do
+ append_to_name(str_pool[otp_ext_i]);
+ append_to_name(" ");
+ for otp_ext_i:=str_start(otp_ext_str_arg) to
+ str_start(otp_ext_str_arg)+length(otp_ext_str_arg)-1 do
+ append_to_name(str_pool[otp_ext_i]);
+ name_of_file[length(otp_ext_str)+length(otp_ext_str_arg)+2]:=0;
+ run_external_ocp(name_of_file);
+ end
+end
+
+@
+@<Place the output buffer back on the stream@>=
+begin
+if (first+otp_output_end)>=ocp_buf_size then
+ overflow_ocp_buf_size;
+push_input;
+current_ocp_lstack:=active_lstack_no(active_real);
+current_ocp_no:=active_counter(active_real);
+state:=mid_line;
+start:=first;
+last:=start;
+loc:=start;
+for otp_counter:=1 to otp_output_end do begin
+ buffer[last]:=otp_output_buf[otp_counter];
+ incr(last); {no overflow problem}
+ end;
+limit:=last-1;
+first:=last;
+end
+
+@
+@d otp_cur_state==otp_states[otp_state_ptr]
+@d otp_set_instruction==begin
+if otp_pc>=ocp_state_no(otp_input_ocp)(otp_cur_state) then begin
+ print_err("bad OCP program -- PC not valid");
+ succumb;
+ end;
+otp_instruction:=ocp_state_entry(otp_input_ocp)(otp_cur_state)(otp_pc);
+otp_instr:=otp_instruction div @"1000000;
+otp_arg:=otp_instruction mod @"1000000;
+end
+
+@<Run the OTP program@>=
+begin
+otp_set_instruction;
+case otp_instr of
+ @<Run the |otp_right| instructions@>;
+ @<Run the |otp_pback| instructions@>;
+ @<Run the arithmetic instructions@>;
+ @<Run the |otp_state| instructions@>;
+ @<Run the |otp_left| instructions@>;
+ @<Run the |otp_goto| instructions@>;
+ @<Run the |otp_stop| instruction@>;
+ othercases begin
+ print_err("bad OCP program -- unknown instruction");
+ succumb;
+ end
+ endcases;
+end
+
+@
+
+@d otp_check_char(#)==
+if (1>#) or (#>otp_no_input_chars) then begin
+ print_err("right hand side of OCP expression is bad");
+ succumb;
+ end
+
+@d otp_get_char(#)==begin
+otp_check_char(#);
+if #>otp_stack_last then begin
+ otp_calculated_char:=otp_input_buf[otp_input_start+#-otp_stack_last];
+ end
+else begin
+ otp_calculated_char:=otp_stack_buf[#];
+ end;
+end
+
+@d decr(#)==#:=#-1
+
+@<Run the |otp_right| instructions@>=
+ otp_right_output: begin
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calcs[otp_calc_ptr];
+ decr(otp_calc_ptr);
+ incr(otp_pc);
+ end;
+ otp_right_num: begin
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_arg;
+ incr(otp_pc);
+ end;
+ otp_right_char: begin
+ otp_get_char(otp_arg);
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_right_lchar: begin
+ otp_get_char(otp_no_input_chars-otp_arg);
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_right_some: begin
+ otp_first_arg:=otp_arg+1;
+ incr(otp_pc);
+ otp_set_instruction;
+ otp_second_arg:=otp_no_input_chars-otp_arg;
+ for otp_counter:=otp_first_arg to otp_second_arg do begin
+ otp_get_char(otp_counter);
+ incr(otp_output_end);
+ if otp_output_end >ocp_buf_size then
+ overflow_ocp_buf_size;
+ otp_output_buf[otp_output_end]:=otp_calculated_char;
+ end;
+ incr(otp_pc);
+ end
+
+@
+@<Run the |otp_pback| instructions@>=
+ otp_pback_output: begin
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calcs[otp_calc_ptr];
+ decr(otp_calc_ptr);
+ incr(otp_pc);
+ end;
+ otp_pback_num: begin
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_arg;
+ incr(otp_pc);
+ end;
+ otp_pback_char: begin
+ otp_get_char(otp_arg);
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_pback_lchar: begin
+ otp_get_char(otp_no_input_chars-otp_arg);
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_pback_some: begin
+ otp_first_arg:=otp_arg+1;
+ incr(otp_pc);
+ otp_set_instruction;
+ otp_second_arg:=otp_no_input_chars-otp_arg;
+ for otp_counter:=otp_first_arg to otp_second_arg do begin
+ otp_get_char(otp_counter);
+ incr(otp_stack_new);
+ if otp_stack_new >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+ end;
+ incr(otp_pc);
+ end
+
+@
+@<Run the arithmetic instructions@>=
+ otp_add: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] + otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_sub: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] - otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_mult: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] * otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_div: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] div otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_mod: begin
+ otp_calcs[otp_calc_ptr-1] :=
+ otp_calcs[otp_calc_ptr-1] mod otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_lookup: begin
+ if otp_calcs[otp_calc_ptr]>=
+ ocp_table_no(otp_input_ocp)(otp_calcs[otp_calc_ptr-1]) then begin
+ print_err("bad OCP program -- table index not valid");
+ succumb;
+ end;
+ otp_calcs[otp_calc_ptr-1]:=
+ ocp_table_entry(otp_input_ocp)(otp_calcs[otp_calc_ptr-1])
+ (otp_calcs[otp_calc_ptr]);
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ end;
+ otp_push_num: begin
+ incr(otp_calc_ptr);
+ if otp_calc_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_calcs[otp_calc_ptr]:=otp_arg;
+ incr(otp_pc);
+ end;
+ otp_push_char: begin
+ otp_get_char(otp_arg);
+ incr(otp_calc_ptr);
+ if otp_calc_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_calcs[otp_calc_ptr]:=otp_calculated_char;
+ incr(otp_pc);
+ end;
+ otp_push_lchar: begin
+ otp_get_char(otp_no_input_chars-otp_arg);
+ incr(otp_calc_ptr);
+ if otp_calc_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_calcs[otp_calc_ptr]:=otp_calculated_char;
+ incr(otp_pc);
+ end
+
+@
+@<Run the |otp_state| instructions@>=
+ otp_state_change: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ otp_states[otp_state_ptr]:=otp_arg;
+ otp_pc:=0;
+ end;
+ otp_state_push: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ incr(otp_state_ptr);
+ if otp_state_ptr >= ocp_stack_size then
+ overflow_ocp_stack_size;
+ otp_states[otp_state_ptr]:=otp_arg;
+ otp_pc:=0;
+ end;
+ otp_state_pop: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ if otp_state_ptr>0 then decr(otp_state_ptr);
+ otp_pc:=0;
+ end
+
+@
+@<Run the |otp_left| instructions@>=
+ otp_left_start: begin
+ otp_input_start:=otp_input_last;
+ otp_input_last:=otp_input_start;
+ otp_stack_used:=0;
+ if (otp_stack_last=0) and (otp_input_last>=otp_input_end) then
+ otp_finished:=true
+ else if (otp_stack_used < otp_stack_last) then begin
+ incr(otp_stack_used); {no overflow problem}
+ otp_input_char:=otp_stack_buf[otp_stack_used];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end
+ else begin
+ incr(otp_input_last); {no overflow problem}
+ otp_input_char:=otp_input_buf[otp_input_last];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end;
+ end;
+ otp_left_return: begin
+ otp_input_last:=otp_input_start;
+ otp_stack_used:=0;
+ if (otp_stack_used < otp_stack_last) then begin
+ incr(otp_stack_used); {no overflow problem}
+ otp_input_char:=otp_stack_buf[otp_stack_used];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end
+ else begin
+ incr(otp_input_last); {no overflow problem}
+ otp_input_char:=otp_input_buf[otp_input_last];
+ otp_no_input_chars:=1;
+ incr(otp_pc);
+ end;
+ end;
+ otp_left_backup: begin
+ if otp_input_start < otp_input_last then begin
+ decr(otp_input_last); otp_input_char:=otp_input_buf[otp_input_last];
+ end
+ else begin
+ decr(otp_stack_used); otp_input_char:=otp_stack_buf[otp_stack_used];
+ end;
+ decr(otp_no_input_chars);
+ incr(otp_pc);
+ end
+
+@
+@<Run the |otp_goto| instructions@>=
+ otp_goto: begin
+ otp_pc:=otp_arg;
+ end;
+ otp_goto_ne: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char <> otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_eq: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char = otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_lt: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char < otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_le: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char <= otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_gt: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char > otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_ge: begin
+ otp_first_arg:=otp_arg;
+ incr(otp_pc);
+ otp_set_instruction;
+ if otp_input_char >= otp_first_arg then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_no_advance: begin
+ if (otp_stack_used < otp_stack_last) then begin
+ incr(otp_stack_used); {no overflow problem}
+ otp_input_char:=otp_stack_buf[otp_stack_used];
+ incr(otp_no_input_chars); {no overflow problem}
+ incr(otp_pc);
+ end
+ else if otp_input_last>=otp_input_end then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_input_last); {no overflow problem}
+ otp_input_char:=otp_input_buf[otp_input_last];
+ incr(otp_no_input_chars); {no overflow problem}
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_beg: begin
+ if otp_input_last=0 then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end;
+ otp_goto_end: begin
+ if otp_input_last>=otp_input_end then begin
+ otp_pc:=otp_arg;
+ end
+ else begin
+ incr(otp_pc);
+ end;
+ end
+
+@
+@<Run the |otp_stop| instruction@>=
+ otp_stop: begin
+ otp_input_start:=otp_input_last;
+ for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+ otp_stack_buf[otp_counter] :=
+ otp_stack_buf[otp_counter+otp_stack_used];
+ end;
+ otp_stack_new:=otp_stack_new-otp_stack_used;
+ otp_stack_last:=otp_stack_new;
+ otp_stack_used:=0;
+ otp_pc:=0;
+ end
+
+@z
diff --git a/Build/source/texk/web2c/omegadir/omfont.ch b/Build/source/texk/web2c/omegadir/omfont.ch
new file mode 100644
index 00000000000..997bc21e5da
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omfont.ch
@@ -0,0 +1,2373 @@
+% omfont.ch: Reading and storing font metric information
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%%---------------------------------------
+@x [15] m.208 l.
+@d min_internal=end_cs_name+1 {the smallest code that can follow \.{\\the}}
+@y
+@d char_ghost=end_cs_name+1
+ {\.{\\ghostleft}, \.{\\ghostright} character for kerning}
+@d min_internal=char_ghost+1 {the smallest code that can follow \.{\\the}}
+@z
+%---------------------------------------
+@x [17] m.222 l.4530 - Omega
+ {begins table of 257 permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+257 {dummy location}
+@y
+ {begins table of |number_fonts| permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+number_fonts
+ {dummy location}
+@z
+%---------------------------------------
+@x [18] m.265 l.5648 - Omega
+primitive("insert",insert,0);@/
+@!@:insert_}{\.{\\insert} primitive@>
+@y
+primitive("insert",insert,0);@/
+@!@:insert_}{\.{\\insert} primitive@>
+primitive("leftghost",char_ghost,0);@/
+@!@:leftghost_}{\.{\\leftghost} primitive@>
+@z
+%---------------------------------------
+@x [18] m.265 l.5648 - Omega
+primitive("setbox",set_box,0);@/
+@!@:set_box_}{\.{\\setbox} primitive@>
+@y
+primitive("rightghost",char_ghost,1);@/
+@!@:rightghost_}{\.{\\rightghost} primitive@>
+primitive("setbox",set_box,0);@/
+@!@:set_box_}{\.{\\setbox} primitive@>
+@z
+%---------------------------------------
+@x [18] m.266 l.5648 - Omega
+char_num: print_esc("char");
+@y
+char_num: print_esc("char");
+char_ghost: if cur_chr=0 then print_esc("leftghost")
+ else print_esc("rightghost");
+@z
+%---------------------------------------
+@x [26] m.425 l.8524 - font parameters
+begin find_font_dimen(false); font_info[fmem_ptr].sc:=0;
+scanned_result(font_info[cur_val].sc)(dimen_val);
+@y
+begin find_font_dimen(false);
+font_info(dimen_font)(font_file_size(dimen_font)).sc:=0;
+scanned_result(font_info(dimen_font)(cur_val).sc)(dimen_val);
+@z
+%---------------------------------------
+@x [26] m.426 l.8530 - font parameters
+if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+else scanned_result(skew_char[cur_val])(int_val);
+@y
+if m=0 then scanned_result(hyphen_char(cur_val))(int_val)
+else scanned_result(skew_char(cur_val))(int_val);
+@z
+%---------------------------------------
+@x [27] m.472 l.9258 - font parameters
+font_name_code: begin print(font_name[cur_val]);
+ if font_size[cur_val]<>font_dsize[cur_val] then
+ begin print(" at "); print_scaled(font_size[cur_val]);
+@y
+font_name_code: begin print(font_name(cur_val));
+ if font_size(cur_val)<>font_dsize(cur_val) then
+ begin print(" at "); print_scaled(font_size(cur_val));
+@z
+%---------------------------------------
+@x [30] m.539 l.10392 - Omega
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+@y
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+$\Omega$ is capable of reading not only \.{TFM} files, but also
+\.{OFM} files, which can describe fonts with up to 65536 characters
+and with huge lig/kern tables. These fonts will often be virtual
+fonts built up from real fonts with 256 characters, but $\Omega$
+is not aware of this.
+
+The documentation below describes \.{TFM} files, with slight additions
+to show where \.{OFM} files differ.
+
+@z
+%---------------------------------------
+@x [30] m.540 l.10417 - Omega
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+@y
+Note that a \.{TFM} font may contain as many as 256 characters
+(if |bc=0| and |ec=255|), and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+The first 52 bytes (13 words) of an \.{OFM} file contains thirteen
+32-bit integers that give the lengths of the various subsequent
+portions of the file. The first word is 0 (future versions of
+\.{OFM} files could have different values; what is important is that
+the first two bytes be 0 to differentiate \.{TFM} and \.{OFM} files).
+The next twelve integers are as above, all nonegative and less
+than~$2^{31}$. We must have |bc-1<=ec<=65535|, and
+$$\hbox{|lf=13+lh+2*(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that an \.{OFM} font may contain as many as 65536 characters
+(if |bc=0| and |ec=65535|), and as few as 0 characters (if |bc=ec+1|).
+
+@z
+%---------------------------------------
+@x [30] m.543 l.10492 - Omega
+per character. Each word in this part of the file contains six fields
+@y
+per character. Each word in this part of a \.{TFM} file contains six fields
+@z
+%---------------------------------------
+@x [30] m.543 l.10506 - Omega
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+@y
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+For \.{OFM} files, two words (eight bytes) are used.
+The arrangement is as follows.
+
+\yskip\hang first and second bytes: |@!width_index| (16 bits)\par
+\hang third byte: |@!height_index| (8 bits)\par
+\hang fourth byte: |@!depth_index| (8~bits)\par
+\hang fifth and sixth bytes:
+|@!italic_index| (14 bits) times 4, plus |@!tag| (2~bits)\par
+\hang seventh and eighth bytes: |@!remainder| (16 bits)\par
+\yskip\noindent
+Therefore the \.{OFM} format imposes a limit of 256 different heights,
+256 different depths, and 16384 different italic corrections.
+
+@z
+%---------------------------------------
+@x [30] m.545 l.10547 - Omega
+that explains what to do for special letter pairs. Each word in this array is a
+|@!lig_kern_command| of four bytes.
+@y
+that explains what to do for special letter pairs. Each word in this array,
+in a \.{TFM} file, is a |@!lig_kern_command| of four bytes.
+@z
+%---------------------------------------
+@x [30] m.545 l.10557 - Omega
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+@y
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In an \.{OFM} file, eight bytes are used, two bytes for each field.
+
+@z
+%---------------------------------------
+@x [30] m.545 l.10587 - Omega
+appear in a location |<=255|.
+@y
+appear in a location |<=255| in a \.{TFM} file, |<=65535| in an \.{OFM} file.
+@z
+%---------------------------------------
+@x [30] m.545 l.10599 - Omega
+@d skip_byte(#)==#.b0
+@d next_char(#)==#.b1
+@d op_byte(#)==#.b2
+@d rem_byte(#)==#.b3
+@y
+@d top_skip_byte(#)==(#.b0 div 256)
+@d skip_byte(#)==(#.b0 mod 256)
+@d next_char_end(#)==#.b1
+@d next_char(#)==font_offset(#)+next_char_end
+@d op_byte(#)==#.b2
+@d rem_byte(#)==#.b3
+@d rem_char_byte_end(#)==#.b3
+@d rem_char_byte(#)==font_offset(#)+rem_char_byte_end
+@d rem_top_byte(#)==(#.b3 div 256)
+@d rem_bot_byte(#)==(#.b3 mod 256)
+@z
+%---------------------------------------
+@x [30] m.546 l.10604 - Omega
+consists of four bytes called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this
+order). These bytes are the character codes of individual pieces used to
+@y
+consists of four bytes in a \.{TFM} file,
+called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this order).
+In an \.{OFM} file, each field takes two bytes, for eight in total.
+These bytes are the character codes of individual pieces used to
+@z
+%---------------------------------------
+@x [30] m.546 l.10618 - Omega
+@d ext_top(#)==#.b0 {|top| piece in a recipe}
+@d ext_mid(#)==#.b1 {|mid| piece in a recipe}
+@d ext_bot(#)==#.b2 {|bot| piece in a recipe}
+@d ext_rep(#)==#.b3 {|rep| piece in a recipe}
+@y
+@d ext_top_end(#)==#.b0 {|top| piece in a recipe}
+@d ext_top(#)==font_offset(#)+ext_top_end
+@d ext_mid_end(#)==#.b1 {|mid| piece in a recipe}
+@d ext_mid(#)==font_offset(#)+ext_mid_end
+@d ext_bot_end(#)==#.b2 {|bot| piece in a recipe}
+@d ext_bot(#)==font_offset(#)+ext_bot_end
+@d ext_rep_end(#)==#.b3 {|rep| piece in a recipe}
+@d ext_rep(#)==font_offset(#)+ext_rep_end
+@z
+%---------------------------------------
+@x [30] m.548 l.10674 - Omega
+@!font_index=0..font_mem_size; {index into |font_info|}
+@y
+@!font_index=integer; {index into |font_info|}
+@z
+%---------------------------------------
+@x [30] m.549 l.10678 - Omega
+@d non_char==qi(256) {a |halfword| code that can't match a real character}
+@y
+@d non_char==qi(too_big_char) {a code that can't match a real character}
+@z
+%---------------------------------------
+@x [30] m.549 l.10686 - Omega
+@!font_info:array[font_index] of memory_word;
+ {the big collection of font data}
+@!fmem_ptr:font_index; {first unused word of |font_info|}
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_check:array[internal_font_number] of four_quarters; {check sum}
+@!font_size:array[internal_font_number] of scaled; {``at'' size}
+@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
+@!font_params:array[internal_font_number] of font_index; {how many font
+ parameters are present}
+@!font_name:array[internal_font_number] of str_number; {name of the font}
+@!font_area:array[internal_font_number] of str_number; {area of the font}
+@!font_bc:array[internal_font_number] of eight_bits;
+ {beginning (smallest) character code}
+@!font_ec:array[internal_font_number] of eight_bits;
+ {ending (largest) character code}
+@!font_glue:array[internal_font_number] of pointer;
+ {glue specification for interword space, |null| if not allocated}
+@!font_used:array[internal_font_number] of boolean;
+ {has a character from this font actually appeared in the output?}
+@!hyphen_char:array[internal_font_number] of integer;
+ {current \.{\\hyphenchar} values}
+@!skew_char:array[internal_font_number] of integer;
+ {current \.{\\skewchar} values}
+@!bchar_label:array[internal_font_number] of font_index;
+ {start of |lig_kern| program for left boundary character,
+ |non_address| if there is none}
+@!font_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {right boundary character, |non_char| if there is none}
+@!font_false_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
+@y
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@z
+%---------------------------------------
+@x [30] m.550 l.10723 - Omega
+|font_info[char_base[f]+c].qqqq|; and if |w| is the |width_index|
+part of this word (the |b0| field), the width of the character is
+|font_info[width_base[f]+w].sc|. (These formulas assume that
+|min_quarterword| has already been added to |c| and to |w|, since \TeX\
+stores its quarterwords that way.)
+
+@<Glob...@>=
+@!char_base:array[internal_font_number] of integer;
+ {base addresses for |char_info|}
+@!width_base:array[internal_font_number] of integer;
+ {base addresses for widths}
+@!height_base:array[internal_font_number] of integer;
+ {base addresses for heights}
+@!depth_base:array[internal_font_number] of integer;
+ {base addresses for depths}
+@!italic_base:array[internal_font_number] of integer;
+ {base addresses for italic corrections}
+@!lig_kern_base:array[internal_font_number] of integer;
+ {base addresses for ligature/kerning programs}
+@!kern_base:array[internal_font_number] of integer;
+ {base addresses for kerns}
+@!exten_base:array[internal_font_number] of integer;
+ {base addresses for extensible recipes}
+@!param_base:array[internal_font_number] of integer;
+ {base addresses for font parameters}
+@y
+|font_info(f)(char_base(f)+c).qqqq|; and if |w| is the |width_index|
+part of this word (the |b0| field), the width of the character is
+|font_info(f)(width_base(f)+w).sc|. (These formulas assume that
+|min_quarterword| has already been added to |c| and to |w|, since \TeX\
+stores its quarterwords that way.)
+
+@d font_info_end(#)==#]
+@d font_info(#)==font_tables[#,font_info_end
+@d offset_file_size=0
+@d offset_check=1
+@d offset_offset=offset_check+4
+@d offset_size=offset_offset+1
+@d offset_dsize=offset_size+1
+@d offset_params=offset_dsize+1
+@d offset_name_sort=offset_params+1
+@d offset_name=offset_name_sort+1
+@d offset_area=offset_name+1
+@d offset_bc=offset_area+1
+@d offset_ec=offset_bc+1
+@d offset_glue=offset_ec+1
+@d offset_used=offset_glue+1
+@d offset_hyphen=offset_used+1
+@d offset_skew=offset_hyphen+1
+@d offset_bchar_label=offset_skew+1
+@d offset_bchar=offset_bchar_label+1
+@d offset_false_bchar=offset_bchar+1
+@d offset_ivalues_start=offset_false_bchar+1
+@d offset_fvalues_start=offset_ivalues_start+1
+@d offset_mvalues_start=offset_fvalues_start+1
+@d offset_rules_start=offset_mvalues_start+1
+@d offset_glues_start=offset_rules_start+1
+@d offset_penalties_start=offset_glues_start+1
+@d offset_ivalues_base=offset_penalties_start+1
+@d offset_fvalues_base=offset_ivalues_base+1
+@d offset_mvalues_base=offset_fvalues_base+1
+@d offset_rules_base=offset_mvalues_base+1
+@d offset_glues_base=offset_rules_base+1
+@d offset_penalties_base=offset_glues_base+1
+@d offset_char_base=offset_penalties_base+1
+@d offset_char_attr_base=offset_char_base+1
+@d offset_width_base=offset_char_attr_base+1
+@d offset_height_base=offset_width_base+1
+@d offset_depth_base=offset_height_base+1
+@d offset_italic_base=offset_depth_base+1
+@d offset_lig_kern_base=offset_italic_base+1
+@d offset_kern_base=offset_lig_kern_base+1
+@d offset_exten_base=offset_kern_base+1
+@d offset_param_base=offset_exten_base+1
+@d offset_charinfo_base=offset_param_base+1
+@d font_file_size(#)==font_info(#)(offset_file_size).int
+@d font_check_0(#)==font_info(#)(offset_check).int
+@d font_check_1(#)==font_info(#)(offset_check+1).int
+@d font_check_2(#)==font_info(#)(offset_check+2).int
+@d font_check_3(#)==font_info(#)(offset_check+3).int
+@d font_offset(#)==font_info(#)(offset_offset).int
+@d font_size(#)==font_info(#)(offset_size).int
+@d font_dsize(#)==font_info(#)(offset_dsize).int
+@d font_params(#)==font_info(#)(offset_params).int
+@d font_name_sort(#)==font_info(#)(offset_name_sort).int
+@d font_name(#)==font_info(#)(offset_name).int
+@d font_area(#)==font_info(#)(offset_area).int
+@d font_bc(#)==font_info(#)(offset_bc).int
+@d font_ec(#)==font_info(#)(offset_ec).int
+@d font_glue(#)==font_info(#)(offset_glue).int
+@d font_used(#)==font_info(#)(offset_used).int
+@d hyphen_char(#)==font_info(#)(offset_hyphen).int
+@d skew_char(#)==font_info(#)(offset_skew).int
+@d bchar_label(#)==font_info(#)(offset_bchar_label).int
+@d font_bchar(#)==font_info(#)(offset_bchar).int
+@d font_false_bchar(#)==font_info(#)(offset_false_bchar).int
+@d ivalues_start(#)==font_info(#)(offset_ivalues_start).int
+@d fvalues_start(#)==font_info(#)(offset_fvalues_start).int
+@d mvalues_start(#)==font_info(#)(offset_mvalues_start).int
+@d rules_start(#)==font_info(#)(offset_rules_start).int
+@d glues_start(#)==font_info(#)(offset_glues_start).int
+@d penalties_start(#)==font_info(#)(offset_penalties_start).int
+@d ivalues_base(#)==font_info(#)(offset_ivalues_base).int
+@d fvalues_base(#)==font_info(#)(offset_fvalues_base).int
+@d mvalues_base(#)==font_info(#)(offset_mvalues_base).int
+@d rules_base(#)==font_info(#)(offset_rules_base).int
+@d glues_base(#)==font_info(#)(offset_glues_base).int
+@d penalties_base(#)==font_info(#)(offset_penalties_base).int
+@d char_attr_base(#)==font_info(#)(offset_char_attr_base).int
+@d char_base(#)==font_info(#)(offset_char_base).int
+@d width_base(#)==font_info(#)(offset_width_base).int
+@d height_base(#)==font_info(#)(offset_height_base).int
+@d depth_base(#)==font_info(#)(offset_depth_base).int
+@d italic_base(#)==font_info(#)(offset_italic_base).int
+@d lig_kern_base(#)==font_info(#)(offset_lig_kern_base).int
+@d kern_base(#)==font_info(#)(offset_kern_base).int
+@d exten_base(#)==font_info(#)(offset_exten_base).int
+@d param_base(#)==font_info(#)(offset_param_base).int
+
+@<Glob...@>=
+@!dimen_font:integer;
+@z
+%---------------------------------------
+@x [30] m.551 l.10743 - Omega
+for k:=font_base to font_max do font_used[k]:=false;
+@y
+@z
+%---------------------------------------
+@x [30] m.552 l.10749 - Omega
+font_ptr:=null_font; fmem_ptr:=7;
+font_name[null_font]:="nullfont"; font_area[null_font]:="";
+hyphen_char[null_font]:="-"; skew_char[null_font]:=-1;
+bchar_label[null_font]:=non_address;
+font_bchar[null_font]:=non_char; font_false_bchar[null_font]:=non_char;
+font_bc[null_font]:=1; font_ec[null_font]:=0;
+font_size[null_font]:=0; font_dsize[null_font]:=0;
+char_base[null_font]:=0; width_base[null_font]:=0;
+height_base[null_font]:=0; depth_base[null_font]:=0;
+italic_base[null_font]:=0; lig_kern_base[null_font]:=0;
+kern_base[null_font]:=0; exten_base[null_font]:=0;
+font_glue[null_font]:=null; font_params[null_font]:=7;
+param_base[null_font]:=-1;
+for k:=0 to 6 do font_info[k].sc:=0;
+@y
+font_ptr:=null_font;
+allocate_font_table(null_font,offset_charinfo_base+108);
+font_file_size(null_font):=offset_charinfo_base+108;
+font_used(null_font):=false;
+font_name(null_font):="nullfont"; font_area(null_font):="";
+hyphen_char(null_font):="-"; skew_char(null_font):=-1;
+bchar_label(null_font):=non_address;
+font_bchar(null_font):=non_char; font_false_bchar(null_font):=non_char;
+font_bc(null_font):=1; font_ec(null_font):=0;
+font_size(null_font):=0; font_dsize(null_font):=0;
+char_base(null_font):=offset_charinfo_base;
+char_attr_base(null_font):=offset_charinfo_base;
+ivalues_start(null_font):=offset_charinfo_base;
+fvalues_start(null_font):=offset_charinfo_base;
+mvalues_start(null_font):=offset_charinfo_base;
+rules_start(null_font):=offset_charinfo_base;
+glues_start(null_font):=offset_charinfo_base;
+penalties_start(null_font):=offset_charinfo_base;
+ivalues_base(null_font):=offset_charinfo_base;
+fvalues_base(null_font):=offset_charinfo_base;
+mvalues_base(null_font):=offset_charinfo_base;
+rules_base(null_font):=offset_charinfo_base;
+glues_base(null_font):=offset_charinfo_base;
+penalties_base(null_font):=offset_charinfo_base;
+width_base(null_font):=offset_charinfo_base;
+height_base(null_font):=offset_charinfo_base;
+depth_base(null_font):=offset_charinfo_base;
+italic_base(null_font):=offset_charinfo_base;
+lig_kern_base(null_font):=offset_charinfo_base;
+kern_base(null_font):=offset_charinfo_base;
+exten_base(null_font):=offset_charinfo_base;
+font_glue(null_font):=null;
+font_params(null_font):=7;
+param_base(null_font):=offset_charinfo_base-1;
+font_offset(null_font):=0;
+for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
+@z
+%---------------------------------------
+@x [30] m.553 l.10767 - Omega
+text(frozen_null_font):="nullfont"; eqtb[frozen_null_font]:=eqtb[cur_val];
+@y
+settext(frozen_null_font,"nullfont");
+set_new_eqtb(frozen_null_font,new_eqtb(cur_val));
+@z
+%---------------------------------------
+@x [30] m.554 l.10771 - Omega
+$$\hbox{|font_info[width_base[f]+font_info[char_base[f]+c].qqqq.b0].sc|}$$
+@y
+$$\hbox{|font_info(f)(width_base(f)+font_info(f)(char_base(f)+c).qqqq.b0).sc|}$$
+@z
+%---------------------------------------
+@x [30] m.554 l.10785 - Omega
+|height_depth(q)| will be the 8-bit quantity
+$$b=|height_index|\times16+|depth_index|,$$ and if |b| is such a byte we
+@y
+|height_depth(q)| will be the 16-bit quantity
+$$b=|height_index|\times256+|depth_index|,$$ and if |b| is such a byte we
+@z
+%---------------------------------------
+@x [30] m.554 l.10798 - Omega
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_info[char_base[#]+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_info[width_base[#]+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 4].sc
+@d char_italic(#)==font_info[italic_base[#]+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 16].sc
+@d char_height(#)==font_info[height_base[#]+char_height_end
+@d char_depth_end(#)==(#) mod 16].sc
+@d char_depth(#)==font_info[depth_base[#]+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+@y
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_tables[#,char_base(#)-font_offset(#)+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_tables[#,width_base(#)+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 256].sc
+@d char_italic(#)==font_tables[#,italic_base(#)+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 256].sc
+@d char_height(#)==font_tables[#,height_base(#)+char_height_end
+@d char_depth_end(#)==(#) mod 256].sc
+@d char_depth(#)==font_tables[#,depth_base(#)+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+@z
+%---------------------------------------
+@x [30] m.557 l.10834 - Omega
+|i=font_info[lig_kern_start(f)(j)]| or |font_info[lig_kern_restart(f)(i)]|,
+depending on whether or not |skip_byte(i)<=stop_flag|.
+
+The constant |kern_base_offset| should be simplified, for \PASCAL\ compilers
+that do not do local optimization.
+@^system dependencies@>
+
+@d char_kern_end(#)==256*op_byte(#)+rem_byte(#)].sc
+@d char_kern(#)==font_info[kern_base[#]+char_kern_end
+@d kern_base_offset==256*(128+min_quarterword)
+@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program}
+@d lig_kern_restart_end(#)==256*op_byte(#)+rem_byte(#)+32768-kern_base_offset
+@d lig_kern_restart(#)==lig_kern_base[#]+lig_kern_restart_end
+@y
+|i=font_info(f)(lig_kern_start(f)(j))| or
+|font_info(f)(lig_kern_restart(f)(i))|,
+depending on whether or not |skip_byte(i)<=stop_flag|.
+
+The constant |kern_base_offset| should be simplified, for \PASCAL\ compilers
+that do not do local optimization.
+@^system dependencies@>
+
+@d char_kern_end(#)==256*op_byte(#)+rem_byte(#)].sc
+@d char_kern(#)==font_tables[#,kern_base(#)+char_kern_end
+@d kern_base_offset==256*(128+min_quarterword)
+@d lig_kern_start(#)==lig_kern_base(#)+rem_byte {beginning of lig/kern program}
+@d lig_kern_restart_end(#)==256*op_byte(#)+rem_byte(#)+32768-kern_base_offset
+@d lig_kern_restart(#)==lig_kern_base(#)+lig_kern_restart_end
+
+@d attr_zero_char_ivalue_end(#)==#].int].int
+@d attr_zero_char_ivalue(#)==
+ font_tables[#,font_tables[#,char_attr_base(#)+attr_zero_char_ivalue_end
+@d attr_zero_ivalue_end(#)==#].int
+@d attr_zero_ivalue(#)==font_tables[#,ivalues_base(#)+attr_zero_ivalue_end
+@d attr_zero_penalty_end(#)==#].int
+@d attr_zero_penalty(#)==font_tables[#,penalties_base(#)+attr_zero_penalty_end
+@d attr_zero_kern_end(#)==#].int
+@d attr_zero_kern(#)==font_tables[#,mvalues_base(#)+attr_zero_kern_end
+
+@z
+%---------------------------------------
+@x [30] m.558 l.10843 - Omega
+@d param_end(#)==param_base[#]].sc
+@d param(#)==font_info[#+param_end
+@d slant==param(slant_code) {slant to the right, per unit distance upward}
+@d space==param(space_code) {normal space between words}
+@d space_stretch==param(space_stretch_code) {stretch between words}
+@d space_shrink==param(space_shrink_code) {shrink between words}
+@d x_height==param(x_height_code) {one ex}
+@d quad==param(quad_code) {one em}
+@d extra_space==param(extra_space_code) {additional space at end of sentence}
+@y
+@d slant(#)==font_info(#)(param_base(#)+slant_code).sc
+ {slant to the right, per unit distance upward}
+@d space(#)==font_info(#)(param_base(#)+space_code).sc
+ {normal space between words}
+@d space_stretch(#)==font_info(#)(param_base(#)+space_stretch_code).sc
+ {stretch between words}
+@d space_shrink(#)==font_info(#)(param_base(#)+space_shrink_code).sc
+ {shrink between words}
+@d x_height(#)==font_info(#)(param_base(#)+x_height_code).sc
+ {one ex}
+@d quad(#)==font_info(#)(param_base(#)+quad_code).sc
+ {one em}
+@d extra_space(#)==font_info(#)(param_base(#)+extra_space_code).sc
+ {additional space at end of sentence}
+@z
+%---------------------------------------
+@x [30] m.560 l.10876 - Omega
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled):internal_font_number; {input a \.{TFM} file}
+@y
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled;offset:quarterword):internal_font_number; {input a \.{TFM} file}
+@z
+%---------------------------------------
+@x [30] m.560 l.10882 - Omega
+ {sizes of subfiles}
+@!f:internal_font_number; {the new font's number}
+@!g:internal_font_number; {the number to return}
+@!a,@!b,@!c,@!d:eight_bits; {byte variables}
+@y
+@!font_dir:halfword;
+ {sizes of subfiles}
+@!f:internal_font_number; {the new font's number}
+@!g:internal_font_number; {the number to return}
+@!a,@!b,@!c,@!d:integer; {byte variables}
+@!i,@!k_param,@!param,@!font_counter:integer; {counters}
+@!font_level,@!header_length:integer;
+@!nco,@!ncw,@!npc,@!nlw,@!neew:integer;
+@!nki,@!nwi,@!nkf,@!nwf,@!nkm,@!nwm:integer;
+@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp:integer;
+@!table_size:array [0..31] of integer;
+@!bytes_per_entry,@!extra_char_bytes:integer;
+@!repeat_no,@!table_counter:integer;
+@z
+%---------------------------------------
+@x [30] m.560 l.10888 - Omega
+@!bchar:0..256; {right boundary character, or 256}
+@y
+@!bchar:0..too_big_char; {right boundary character, or |too_big_char|}
+@!first_two:integer;
+@z
+%---------------------------------------
+@x [30] m.563 l.10943 - Omega
+if file_opened then print(" not loadable: Bad metric (TFM) file")
+else print(" not loadable: Metric (TFM) file not found");
+@y
+if file_opened then print(" not loadable: Bad metric (TFM/OFM) file")
+else print(" not loadable: Metric (TFM/OFM) file not found");
+@z
+%---------------------------------------
+@x [30] m.563 l.10943 - Omega
+if aire="" then pack_file_name(nom,TEX_font_area,".tfm")
+else pack_file_name(nom,aire,".tfm");
+if not b_open_in(tfm_file) then abort;
+@y
+if aire="" then pack_file_name(nom,TEX_font_area,".ofm")
+else pack_file_name(nom,aire,".ofm");
+if not b_open_in(tfm_file) then abort;
+@z
+%---------------------------------------
+@x [30] m.564 l.10962 - Omega
+@d store_four_quarters(#)==begin fget; a:=fbyte; qw.b0:=qi(a);
+ fget; b:=fbyte; qw.b1:=qi(b);
+ fget; c:=fbyte; qw.b2:=qi(c);
+ fget; d:=fbyte; qw.b3:=qi(d);
+ #:=qw;
+ end
+@y
+@d read_sixteen_unsigned(#)==begin #:=fbyte;
+ fget; #:=#*@'400+fbyte;
+ end
+@d read_thirtytwo(#)==begin #:=fbyte;
+ if #>127 then abort;
+ fget; #:=#*@'400+fbyte;
+ fget; #:=#*@'400+fbyte;
+ fget; #:=#*@'400+fbyte;
+ end
+@d store_four_bytes(#)==begin fget; a:=fbyte; qw.b0:=a;
+ fget; b:=fbyte; qw.b1:=b;
+ fget; c:=fbyte; qw.b2:=c;
+ fget; d:=fbyte; qw.b3:=d;
+ #:=qw;
+ end
+@d store_char_info(#)==begin if (font_level<>-1) then
+ begin fget; read_sixteen_unsigned(a); qw.b0:=a;
+ fget; read_sixteen_unsigned(b); qw.b1:=b;
+ fget; read_sixteen_unsigned(c); qw.b2:=c;
+ fget; read_sixteen_unsigned(d); qw.b3:=d;
+ #:=qw
+ end
+else
+ begin fget; a:=fbyte; qw.b0:=a;
+ fget; b:=fbyte; b:=((b div 16)*256)+(b mod 16); qw.b1:=b;
+ fget; c:=fbyte; c:=((c div 4)*256)+(c mod 4); qw.b2:=c;
+ fget; d:=fbyte; qw.b3:=d;
+ #:=qw
+ end
+end
+@d store_four_quarters(#)==begin if (font_level<>-1) then
+ begin fget; read_sixteen_unsigned(a); qw.b0:=a;
+ fget; read_sixteen_unsigned(b); qw.b1:=b;
+ fget; read_sixteen_unsigned(c); qw.b2:=c;
+ fget; read_sixteen_unsigned(d); qw.b3:=d;
+ #:=qw
+ end
+else
+ begin fget; a:=fbyte; qw.b0:=a;
+ fget; b:=fbyte; qw.b1:=b;
+ fget; c:=fbyte; qw.b2:=c;
+ fget; d:=fbyte; qw.b3:=d;
+ #:=qw
+ end
+end
+@z
+%---------------------------------------
+@x [30] m.565 l.10970 - Omega
+begin read_sixteen(lf);
+fget; read_sixteen(lh);
+fget; read_sixteen(bc);
+fget; read_sixteen(ec);
+if (bc>ec+1)or(ec>255) then abort;
+if bc>255 then {|bc=256| and |ec=255|}
+ begin bc:=1; ec:=0;
+ end;
+fget; read_sixteen(nw);
+fget; read_sixteen(nh);
+fget; read_sixteen(nd);
+fget; read_sixteen(ni);
+fget; read_sixteen(nl);
+fget; read_sixteen(nk);
+fget; read_sixteen(ne);
+fget; read_sixteen(np);
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort;
+end
+@y
+nco:=0; ncw:=0; npc:=0;
+nki:=0; nwi:=0; nkf:=0; nwf:=0; nkm:=0; nwm:=0;
+nkr:=0; nwr:=0; nkg:=0; nwg:=0; nkp:=0; nwp:=0;
+read_sixteen(first_two);
+if first_two<>0 then begin
+ font_level:=-1;
+ lf:=first_two;
+ fget; read_sixteen(lh);
+ fget; read_sixteen(bc);
+ fget; read_sixteen(ec);
+ if (bc>ec+1)or(ec>255) then abort;
+ if bc>255 then {|bc=256| and |ec=255|}
+ begin bc:=1; ec:=0;
+ end;
+ fget; read_sixteen(nw);
+ fget; read_sixteen(nh);
+ fget; read_sixteen(nd);
+ fget; read_sixteen(ni);
+ fget; read_sixteen(nl);
+ fget; read_sixteen(nk);
+ fget; read_sixteen(ne);
+ fget; read_sixteen(np);
+ header_length:=6;
+ ncw:=(ec-bc+1);
+ nlw:=nl;
+ neew:=ne;
+ end
+else begin
+ fget; read_sixteen(font_level);
+ if (font_level<>0) and (font_level<>1) then abort;
+ fget; read_thirtytwo(lf);
+ fget; read_thirtytwo(lh);
+ fget; read_thirtytwo(bc);
+ fget; read_thirtytwo(ec);
+ if (bc>ec+1)or(ec>biggest_char) then abort;
+ if bc>65535 then {|bc=65536| and |ec=65535|}
+ begin bc:=1; ec:=0;
+ end;
+ fget; read_thirtytwo(nw);
+ fget; read_thirtytwo(nh);
+ fget; read_thirtytwo(nd);
+ fget; read_thirtytwo(ni);
+ fget; read_thirtytwo(nl);
+ fget; read_thirtytwo(nk);
+ fget; read_thirtytwo(ne);
+ fget; read_thirtytwo(np);
+ fget; read_thirtytwo(font_dir);
+ nlw:=2*nl;
+ neew:=2*ne;
+ if font_level=0 then begin
+ header_length:=14;
+ ncw:=2*(ec-bc+1);
+ end
+ else begin
+ header_length:=29;
+ fget; read_thirtytwo(nco);
+ fget; read_thirtytwo(ncw);
+ fget; read_thirtytwo(npc);
+ fget; read_thirtytwo(nki); {Kinds of font ivalues}
+ fget; read_thirtytwo(nwi); {Words of font ivalues}
+ fget; read_thirtytwo(nkf); {Kinds of font fvalues}
+ fget; read_thirtytwo(nwf); {Words of font fvalues}
+ fget; read_thirtytwo(nkm); {Kinds of font mvalues}
+ fget; read_thirtytwo(nwm); {Words of font mvalues}
+ fget; read_thirtytwo(nkr); {Kinds of font rules}
+ fget; read_thirtytwo(nwr); {Words of font rules}
+ fget; read_thirtytwo(nkg); {Kinds of font glues}
+ fget; read_thirtytwo(nwg); {Words of font glues}
+ fget; read_thirtytwo(nkp); {Kinds of font penalties}
+ fget; read_thirtytwo(nwp); {Words of font penalties}
+ end
+ end;
+if lf<>(header_length+lh+ncw+nw+nh+nd+ni+nlw+nk+neew+np+
+ nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp) then abort;
+@z
+%---------------------------------------
+@x [30] m.566 l.10996 - Omega
+lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
+if np<7 then lf:=lf+7-np; {at least seven parameters will appear}
+if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then
+ @<Apologize for not loading the font, |goto done|@>;
+f:=font_ptr+1;
+char_base[f]:=fmem_ptr-bc;
+width_base[f]:=char_base[f]+ec+1;
+height_base[f]:=width_base[f]+nw;
+depth_base[f]:=height_base[f]+nh;
+italic_base[f]:=depth_base[f]+nd;
+lig_kern_base[f]:=italic_base[f]+ni;
+kern_base[f]:=lig_kern_base[f]+nl-kern_base_offset;
+exten_base[f]:=kern_base[f]+kern_base_offset+nk;
+param_base[f]:=exten_base[f]+ne
+@y
+case font_level of
+-1: lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
+ 0: lf:=lf-14-lh-(ec-bc+1)-nl-ne;
+ {some of the sections contain pairs of
+ words that become single |memory_word|s}
+ 1: lf:=lf-29-lh-ncw+(1+npc)*(ec-bc+1)-nl-ne;
+ {We explode the characters}
+end;
+if np<7 then lf:=lf+7-np; {at least seven parameters will appear}
+if (font_ptr=font_max) then
+ @<Apologize for not loading the font, |goto done|@>;
+f:=font_ptr+1;
+allocate_font_table(f,offset_charinfo_base+lf+100);
+ {leave room for 100 extra parameters -- potential bug}
+font_file_size(f):=offset_charinfo_base+lf+100;
+font_used(f):=false;
+font_offset(f):=offset;
+char_base(f):=offset_charinfo_base-bc;
+char_attr_base(f):=char_base(f)+ec+1;
+ivalues_start(f):=char_attr_base(f)+npc*(ec-bc+1);
+fvalues_start(f):=ivalues_start(f)+nki;
+mvalues_start(f):=fvalues_start(f)+nkf;
+rules_start(f):=mvalues_start(f)+nkm;
+glues_start(f):=rules_start(f)+nkr;
+penalties_start(f):=glues_start(f)+nkg;
+ivalues_base(f):=penalties_start(f)+nkp;
+fvalues_base(f):=ivalues_base(f)+nwi;
+mvalues_base(f):=fvalues_base(f)+nwf;
+rules_base(f):=mvalues_base(f)+nwm;
+glues_base(f):=rules_base(f)+nwr;
+penalties_base(f):=glues_base(f)+nwg;
+width_base(f):=penalties_base(f)+nwp;
+height_base(f):=width_base(f)+nw;
+depth_base(f):=height_base(f)+nh;
+italic_base(f):=depth_base(f)+nd;
+lig_kern_base(f):=italic_base(f)+ni;
+kern_base(f):=lig_kern_base(f)+nl-kern_base_offset;
+exten_base(f):=kern_base(f)+kern_base_offset+nk;
+param_base(f):=exten_base(f)+ne;
+@z
+%---------------------------------------
+@x [30] m.568 l.11026 - Omega
+store_four_quarters(font_check[f]);
+@y
+fget; font_check_0(f):=fbyte;
+fget; font_check_1(f):=fbyte;
+fget; font_check_2(f):=fbyte;
+fget; font_check_3(f):=fbyte;
+@z
+%---------------------------------------
+@x [30] m.568 l.11033 - Omega
+font_dsize[f]:=z;
+if s<>-1000 then
+ if s>=0 then z:=s
+ else z:=xn_over_d(z,-s,1000);
+font_size[f]:=z;
+@y
+font_dsize(f):=z;
+if s<>-1000 then
+ if s>=0 then z:=s
+ else z:=xn_over_d(z,-s,1000);
+font_size(f):=z;
+@z
+%---------------------------------------
+@x [30] m.569 l.11041 - Omega
+for k:=fmem_ptr to width_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if (a>=nw)or(b div @'20>=nh)or(b mod @'20>=nd)or
+ (c div 4>=ni) then abort;
+ case c mod 4 of
+ lig_tag: if d>=nl then abort;
+ ext_tag: if d>=ne then abort;
+ list_tag: @<Check for charlist cycle@>;
+ othercases do_nothing {|no_tag|}
+ endcases;
+ end
+@y
+if font_level=1 then begin
+ i:=0;
+ k:=ivalues_start(f);
+ font_counter:=ivalues_base(f);
+ while k<fvalues_start(f) do {IVALUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<mvalues_start(f) do {FVALUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<rules_start(f) do {MVALUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<glues_start(f) do {RULE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param*3;
+ table_size[i]:=3;
+ incr(i); incr(k);
+ end;
+ while k<penalties_start(f) do {GLUE starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param*4;
+ table_size[i]:=4;
+ incr(i); incr(k);
+ end;
+ while k<ivalues_base(f) do {PENALTY starts}
+ begin
+ read_thirtytwo(param);
+ font_info(f)(k).int := font_counter;
+ font_counter:=font_counter+param*1;
+ table_size[i]:=1;
+ incr(i); incr(k);
+ end;
+ while k<fvalues_base(f) do {IVALUE entries}
+ begin
+ read_thirtytwo(font_info(f)(k).int);
+ incr(k);
+ end;
+ while k<mvalues_base(f) do {FVALUE entries}
+ begin
+ read_thirtytwo(font_info(f)(k).sc);
+ incr(k);
+ end;
+ while k<rules_base(f) do {MVALUE entries}
+ begin
+ read_thirtytwo(font_info(f)(k).int);
+ incr(k);
+ end;
+ while k<glues_base(f) do {RULE entries}
+ begin
+ store_scaled(font_info(f)(k).sc);
+ store_scaled(font_info(f)(k+1).sc);
+ store_scaled(font_info(f)(k+2).sc);
+ k:=k+3;
+ end;
+ while k<penalties_base(f) do {GLUE entries}
+ begin
+ fget; read_sixteen(font_info(f)(k).hh.lhfield);
+ fget; read_sixteen(font_info(f)(k).hh.rh);
+ store_scaled(font_info(f)(k+1).sc);
+ store_scaled(font_info(f)(k+2).sc);
+ store_scaled(font_info(f)(k+3).sc);
+ k:=k+4;
+ end;
+ while k<offset_charinfo_base do {PENALTY entries}
+ begin
+ read_thirtytwo(font_info(f)(k).int);
+ incr(k);
+ end;
+ end;
+k:=char_base(f)+bc;
+k_param:=char_attr_base(f);
+bytes_per_entry:=(12 + 2*npc) div 4 * 4;
+extra_char_bytes:=bytes_per_entry - (10 + 2*npc);
+while k<char_attr_base(f) do begin
+ store_char_info(font_info(f)(k).qqqq);
+ if (a>=nw)or((b div @"100)>=nh)or((b mod @"100)>=nd)or
+ ((c div @"100)>=ni) then abort;
+ case c mod 4 of
+ lig_tag: if d>=nl then abort;
+ ext_tag: if d>=ne then abort;
+ list_tag: @<Check for charlist cycle@>;
+ othercases do_nothing {|no_tag|}
+ endcases;
+ incr(k);
+ if font_level=1 then begin
+ fget; read_sixteen_unsigned(repeat_no);
+ for i:=0 to npc-1 do begin
+ fget; read_sixteen(param);
+ font_info(f)(k_param).int :=
+ font_info(f)(ivalues_start(f)+i).int + param*table_size[i];
+ incr(k_param);
+ end;
+ for i:=1 to extra_char_bytes do fget;
+ for i:=1 to repeat_no do begin
+ font_info(f)(k):=font_info(f)(k-1);
+ incr(k);
+ for table_counter:=0 to npc-1 do begin
+ font_info(f)(k_param).int := font_info(f)(k_param-npc).int;
+ incr(k_param);
+ end;
+ end;
+ end;
+ end
+@z
+%---------------------------------------
+@x [30] m.570 l.11059 - Omega
+@d current_character_being_worked_on==k+bc-fmem_ptr
+@y
+@d current_character_being_worked_on==k-char_base(f)
+@z
+%---------------------------------------
+@x [30] m.570 l.11065 - Omega
+ begin qw:=char_info(f)(d);
+ {N.B.: not |qi(d)|, since |char_base[f]| hasn't been adjusted yet}
+@y
+ begin qw:=char_info(f)(d);
+ {N.B.: not |qi(d)|, since |char_base(f)| hasn't been adjusted yet}
+@z
+%---------------------------------------
+@x [30] m.571 l.11098 - Omega
+for k:=width_base[f] to lig_kern_base[f]-1 do
+ store_scaled(font_info[k].sc);
+if font_info[width_base[f]].sc<>0 then abort; {\\{width}[0] must be zero}
+if font_info[height_base[f]].sc<>0 then abort; {\\{height}[0] must be zero}
+if font_info[depth_base[f]].sc<>0 then abort; {\\{depth}[0] must be zero}
+if font_info[italic_base[f]].sc<>0 then abort; {\\{italic}[0] must be zero}
+@y
+for k:=width_base(f) to lig_kern_base(f)-1 do
+ store_scaled(font_info(f)(k).sc);
+if font_info(f)(width_base(f)).sc<>0 then abort; {\\{width}[0] must be zero}
+if font_info(f)(height_base(f)).sc<>0 then abort; {\\{height}[0] must be zero}
+if font_info(f)(depth_base(f)).sc<>0 then abort; {\\{depth}[0] must be zero}
+if font_info(f)(italic_base(f)).sc<>0 then abort; {\\{italic}[0] must be zero}
+@z
+%---------------------------------------
+@x [30] m.573 l.11114 - Omega
+@ @d check_existence(#)==@t@>@;@/
+ begin check_byte_range(#);
+ qw:=char_info(f)(#); {N.B.: not |qi(#)|}
+ if not char_exists(qw) then abort;
+ end
+
+@<Read ligature/kern program@>=
+bch_label:=@'77777; bchar:=256;
+if nl>0 then
+ begin for k:=lig_kern_base[f] to kern_base[f]+kern_base_offset-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if a>128 then
+ begin if 256*c+d>=nl then abort;
+ if a=255 then if k=lig_kern_base[f] then bchar:=b;
+ end
+ else begin if b<>bchar then check_existence(b);
+ if c<128 then check_existence(d) {check ligature}
+ else if 256*(c-128)+d>=nk then abort; {check kern}
+ if a<128 then if k-lig_kern_base[f]+a+1>=nl then abort;
+ end;
+ end;
+ if a=255 then bch_label:=256*c+d;
+ end;
+for k:=kern_base[f]+kern_base_offset to exten_base[f]-1 do
+ store_scaled(font_info[k].sc);
+@y
+@ @d check_existence(#)==@t@>@;@/
+ begin check_byte_range(#);
+ qw:=char_info(f)(#+font_offset(f)); {N.B.: not |qi(#)|}
+ if not char_exists(qw) then abort;
+ end
+
+@<Read ligature/kern program@>=
+bch_label:=nl {infinity}; bchar:=too_big_char;
+if nl>0 then
+ begin for k:=lig_kern_base(f) to kern_base(f)+kern_base_offset-1 do
+ begin store_four_quarters(font_info(f)(k).qqqq);
+ if a>128 then
+ begin if 256*c+d>=nl then abort;
+ if a=255 then if k=lig_kern_base(f) then bchar:=b;
+ end
+ else begin if b<>bchar then check_existence(b);
+ if c<128 then check_existence(d) {check ligature}
+ else if 256*(c-128)+d>=nk then abort; {check kern}
+ if a<128 then if k-lig_kern_base(f)+a+1>=nl then abort;
+ end;
+ end;
+ if a=255 then bch_label:=256*c+d;
+ end;
+for k:=kern_base(f)+kern_base_offset to exten_base(f)-1 do
+ store_scaled(font_info(f)(k).sc);
+@z
+%---------------------------------------
+@x [30] m.574 l.11141 - Omega
+for k:=exten_base[f] to param_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+@y
+for k:=exten_base(f) to param_base(f)-1 do
+ begin store_four_quarters(font_info(f)(k).qqqq);
+@z
+%---------------------------------------
+@x [30] m.575 l.11157 - Omega
+ fget; font_info[param_base[f]].sc:=
+ (sw*@'20)+(fbyte div@'20);
+ end
+ else store_scaled(font_info[param_base[f]+k-1].sc);
+if eof(tfm_file) then abort;
+for k:=np+1 to 7 do font_info[param_base[f]+k-1].sc:=0;
+@y
+ fget; font_info(f)(param_base(f)).sc:=
+ (sw*@'20)+(fbyte div@'20);
+ end
+ else store_scaled(font_info(f)(param_base(f)+k-1).sc);
+if eof(tfm_file) then abort;
+for k:=np+1 to 7 do font_info(f)(param_base(f)+k-1).sc:=0;
+@z
+%---------------------------------------
+@x [30] m.576 l.11169 - Omega
+@d adjust(#)==#[f]:=qo(#[f])
+ {correct for the excess |min_quarterword| that was added}
+
+@<Make final adjustments...@>=
+if np>=7 then font_params[f]:=np@+else font_params[f]:=7;
+hyphen_char[f]:=default_hyphen_char; skew_char[f]:=default_skew_char;
+if bch_label<nl then bchar_label[f]:=bch_label+lig_kern_base[f]
+else bchar_label[f]:=non_address;
+font_bchar[f]:=qi(bchar);
+font_false_bchar[f]:=qi(bchar);
+if bchar<=ec then if bchar>=bc then
+ begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+ if char_exists(qw) then font_false_bchar[f]:=non_char;
+ end;
+font_name[f]:=nom;
+font_area[f]:=aire;
+font_bc[f]:=bc; font_ec[f]:=ec; font_glue[f]:=null;
+adjust(char_base); adjust(width_base); adjust(lig_kern_base);
+adjust(kern_base); adjust(exten_base);
+decr(param_base[f]);
+fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; goto done
+@y
+@d adjust(#)==#(f):=qo(#(f))
+ {correct for the excess |min_quarterword| that was added}
+
+@<Make final adjustments...@>=
+if np>=7 then font_params(f):=np@+else font_params(f):=7;
+font_offset(f):=offset;
+hyphen_char(f):=default_hyphen_char+offset;
+skew_char(f):=default_skew_char+offset;
+bchar:=bchar+offset;
+if bch_label<nl then bchar_label(f):=bch_label+lig_kern_base(f)
+else bchar_label(f):=non_address;
+font_bchar(f):=qi(bchar);
+font_false_bchar(f):=qi(bchar);
+if bchar<=ec then if bchar>=bc then
+ begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+ if char_exists(qw) then font_false_bchar(f):=non_char;
+ end;
+font_name(f):=nom;
+font_area(f):=aire;
+font_bc(f):=bc; font_ec(f):=ec; font_glue(f):=null;
+font_bc(f):=bc+offset; font_ec(f):=ec+offset; font_glue(f):=null;
+adjust(char_base); adjust(width_base); adjust(lig_kern_base);
+adjust(kern_base); adjust(exten_base);
+decr(param_base(f));
+font_ptr:=f; g:=f; goto done
+@z
+%---------------------------------------
+@x [30] m.577 l.11202 - Omega
+ begin m:=cur_chr; scan_four_bit_int; f:=equiv(m+cur_val);
+@y
+ begin m:=cur_chr; scan_big_four_bit_int; f:=equiv(m+cur_val);
+@z
+%---------------------------------------
+@x [30] m.578 l.11223 - Omega
+if n<=0 then cur_val:=fmem_ptr
+else begin if writing and(n<=space_shrink_code)and@|
+ (n>=space_code)and(font_glue[f]<>null) then
+ begin delete_glue_ref(font_glue[f]);
+ font_glue[f]:=null;
+ end;
+ if n>font_params[f] then
+ if f<font_ptr then cur_val:=fmem_ptr
+ else @<Increase the number of parameters in the last font@>
+ else cur_val:=n+param_base[f];
+ end;
+@<Issue an error message if |cur_val=fmem_ptr|@>;
+end;
+@y
+dimen_font:=f;
+if n<=0 then cur_val:=font_file_size(f)
+else begin if writing and(n<=space_shrink_code)and@|
+ (n>=space_code)and(font_glue(f)<>null) then
+ begin delete_glue_ref(font_glue(f));
+ font_glue(f):=null;
+ end;
+ if n>font_params(f) then
+ if f<font_ptr then cur_val:=font_file_size(f)
+ else @<Increase the number of parameters in the last font@>
+ else cur_val:=n+param_base(f);
+ end;
+@<Issue an error message if |cur_val=font_file_size(f)|@>;
+end;
+@z
+%---------------------------------------
+@x [30] m.579 l.11240 - Omega
+@ @<Issue an error message if |cur_val=fmem_ptr|@>=
+if cur_val=fmem_ptr then
+ begin print_err("Font "); print_esc(font_id_text(f));
+ print(" has only "); print_int(font_params[f]);
+ print(" fontdimen parameters");
+@.Font x has only...@>
+ help2("To increase the number of font parameters, you must")@/
+ ("use \fontdimen immediately after the \font is loaded.");
+ error;
+ end
+@y
+@ @<Issue an error message if |cur_val=font_file_size(f)|@>=
+if cur_val=font_file_size(f) then
+ begin print_err("Font "); print_esc(font_id_text(f));
+ print(" has only "); print_int(font_params(f));
+ print(" fontdimen parameters");
+@.Font x has only...@>
+ help2("To increase the number of font parameters, you must")@/
+ ("use \fontdimen immediately after the \font is loaded.");
+ error;
+ end
+@z
+%---------------------------------------
+@x [30] m.580 l.11252 - font parameters
+@ @<Increase the number of parameters...@>=
+begin repeat if fmem_ptr=font_mem_size then
+ overflow("font memory",font_mem_size);
+@:TeX capacity exceeded font memory}{\quad font memory@>
+font_info[fmem_ptr].sc:=0; incr(fmem_ptr); incr(font_params[f]);
+until n=font_params[f];
+cur_val:=fmem_ptr-1; {this equals |param_base[f]+font_params[f]|}
+@y
+@ @<Increase the number of parameters...@>=
+begin if n+font_params(f)>font_file_size(f) then
+ begin print_nl("Out of font parameter space"); succumb; end;
+repeat
+font_info(f)(param_base(f)+font_params(f)).sc:=0; incr(font_params(f));
+until n=font_params(f);
+cur_val:=param_base(f)+font_params(f);
+@z
+%---------------------------------------
+@x [30] m.581 l.11268 - font parameters
+ slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
+@y
+ slow_print(font_name(f)); print_char("!"); end_diagnostic(false);
+@z
+%---------------------------------------
+@x [30] m.582 l.11276 - font parameters
+begin if font_bc[f]<=c then if font_ec[f]>=c then
+@y
+begin if font_bc(f)<=c then if font_ec(f)>=c then
+@z
+%---------------------------------------
+@x [32] m.592 l.11820 - Omega
+@!c,@!f:quarterword; {character and font in current |char_node|}
+@y
+@!c,@!f:quarterword; {character and font in current |char_node|}
+@!oval,@!ocmd:integer; {used by |out_cmd| for generating
+ |set|, |fnt| and |fnt_def| commands}
+@z
+%---------------------------------------
+@x [32] m.602 l.11939 - Omega
+@ Here's a procedure that outputs a font definition. Since \TeX82 uses at
+most 256 different fonts per job, |fnt_def1| is always used as the command code.
+@y
+@ Here's a procedure that outputs a font definition. $\Omega$ allows
+more than 256 different fonts per job, so the right font definition
+command must be selected.
+
+@d Incr_Decr(#) == #
+@d Incr(#) == #:=#+Incr_Decr {increase a variable}
+@d Decr(#) == #:=#-Incr_Decr {decrease a variable}
+
+@d dvi_debug_out(#)==begin
+dvi_out(#);
+end
+
+@d out_cmd ==
+begin
+if (oval<@"100)and(oval>=0) then begin
+ if (ocmd<>set1)or(oval>127) then
+ if (ocmd=fnt1)and(oval<64) then Incr(oval)(fnt_num_0) @+ else dvi_debug_out(ocmd);
+ end
+else
+ begin if (oval<@"10000)and(oval>=0) then dvi_debug_out(ocmd+1) @+ else @;
+ begin if (oval<@"1000000)and(oval>=0) then dvi_debug_out(ocmd+2) @+ else @;
+ begin dvi_debug_out(ocmd+3);
+ if oval>=0 then dvi_debug_out(oval div @"1000000)
+ else begin Incr(oval)(@"40000000); Incr(oval)(@"40000000);
+ dvi_debug_out((oval div @"1000000) + 128); oval:=oval mod @"1000000;
+ end;
+ dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
+ end;
+ dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
+ end;
+ dvi_debug_out(oval div @"100); oval:=oval mod @"100;
+ end;
+dvi_debug_out(oval)
+end
+
+@z
+%---------------------------------------
+@x [32] m.602 l.11944 - Omega
+begin dvi_out(fnt_def1);
+dvi_out(f-font_base-1);@/
+dvi_out(qo(font_check[f].b0));
+dvi_out(qo(font_check[f].b1));
+dvi_out(qo(font_check[f].b2));
+dvi_out(qo(font_check[f].b3));@/
+dvi_four(font_size[f]);
+dvi_four(font_dsize[f]);@/
+dvi_out(length(font_area[f]));
+dvi_out(length(font_name[f]));
+@y
+begin
+oval:=f-font_base-1; ocmd:= fnt_def1; out_cmd;@/
+dvi_out(qo(font_check_0(f)));
+dvi_out(qo(font_check_1(f)));
+dvi_out(qo(font_check_2(f)));
+dvi_out(qo(font_check_3(f)));@/
+dvi_four(font_size(f));
+dvi_four(font_dsize(f));@/
+dvi_out(length(font_area(f)));
+dvi_out(length(font_name(f)));
+@z
+%---------------------------------------
+@x [32] m.603 l.11958 - Omega
+for k:=str_start[font_area[f]] to str_start[font_area[f]+1]-1 do
+ dvi_out(so(str_pool[k]));
+for k:=str_start[font_name[f]] to str_start[font_name[f]+1]-1 do
+ dvi_out(so(str_pool[k]))
+@y
+for k:=str_start(font_area(f)) to str_start(font_area(f)+1)-1 do
+ dvi_out(so(str_pool[k]));
+for k:=str_start(font_name(f)) to str_start(font_name(f)+1)-1 do
+ dvi_out(so(str_pool[k]))
+@z
+%---------------------------------------
+@x [32] m.620 l.12334 - Omega
+ if c>=qi(128) then dvi_out(set1);
+ dvi_out(qo(c));@/
+@y
+ oval:=c-font_offset(f); ocmd:=set1; out_cmd;@/
+@z
+%---------------------------------------
+@x [32] m.621 l.12345 - Omega
+begin if not font_used[f] then
+ begin dvi_font_def(f); font_used[f]:=true;
+ end;
+if f<=64+font_base then dvi_out(f-font_base-1+fnt_num_0)
+else begin dvi_out(fnt1); dvi_out(f-font_base-1);
+ end;
+@y
+begin if not font_used(f) then
+ begin dvi_font_def(f); font_used(f):=true;
+ end;
+oval:=f-font_base-1; ocmd:=fnt1; out_cmd;@/
+@z
+%---------------------------------------
+@x [32] m.643 l.12757 - Omega
+ begin if font_used[font_ptr] then dvi_font_def(font_ptr);
+@y
+ begin if font_used(font_ptr) then dvi_font_def(font_ptr);
+@z
+%---------------------------------------
+@x [35] m.699 l.13742 - Omega
+@d text_size=0 {size code for the largest size in a family}
+@d script_size=16 {size code for the medium size in a family}
+@d script_script_size=32 {size code for the smallest size in a family}
+@y
+@z
+%---------------------------------------
+@x [35] m.700 l.13762 - Omega
+@d mathsy_end(#)==fam_fnt(2+#)]].sc
+@d mathsy(#)==font_info[#+param_base[mathsy_end
+@y
+@d mathsy_end(#)==sc
+@d mathsy(#)==font_info(fam_fnt(2+cur_size))(#+param_base(fam_fnt(2+cur_size))).mathsy_end
+@z
+%---------------------------------------
+@x [35] m.701 l.13789 - Omega
+@d mathex(#)==font_info[#+param_base[fam_fnt(3+cur_size)]].sc
+@y
+@d mathex(#)==font_info(fam_fnt(3+cur_size))(#+param_base(fam_fnt(3+cur_size))).sc
+@z
+%---------------------------------------
+@x [35] m.703 l.13813 - Omega
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
+begin if cur_style<script_style then cur_size:=text_size
+else cur_size:=16*((cur_style-text_style) div 2);
+cur_mu:=x_over_n(math_quad(cur_size),18);
+end
+@y
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
+begin if cur_style<script_style then cur_size:=text_size
+else cur_size:=script_size*((cur_style-text_style) div 2);
+cur_mu:=x_over_n(math_quad(cur_size),18);
+end
+@z
+%---------------------------------------
+@x [35] m.706 l.13855 - Omega
+function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer;
+label found,continue;
+var b:pointer; {the box that will be constructed}
+@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
+@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
+@!m,@!n: integer; {the number of extensible pieces}
+@!u: scaled; {height-plus-depth of a tentative character}
+@!w: scaled; {largest height-plus-depth so far}
+@!q: four_quarters; {character info}
+@!hd: eight_bits; {height-depth byte}
+@!r: four_quarters; {extensible pieces}
+@!z: small_number; {runs through font family members}
+@y
+function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer;
+label found,continue;
+var b:pointer; {the box that will be constructed}
+@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
+@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
+@!m,@!n: integer; {the number of extensible pieces}
+@!u: scaled; {height-plus-depth of a tentative character}
+@!w: scaled; {largest height-plus-depth so far}
+@!q: four_quarters; {character info}
+@!hd: eight_bits; {height-depth byte}
+@!r: four_quarters; {extensible pieces}
+@!z: integer; {runs through font family members}
+@z
+%---------------------------------------
+@x [35] m.706 l.13881 - Omega
+shift_amount(b):=half(height(b)-depth(b)) - axis_height(s);
+@y
+z:=cur_size; cur_size:=s;
+shift_amount(b):=half(height(b)-depth(b)) - axis_height(cur_size);
+cur_size:=z;
+@z
+%---------------------------------------
+@x [35] m.707 l.13889 - Omega
+@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
+if (z<>0)or(x<>min_quarterword) then
+ begin z:=z+s+16;
+ repeat z:=z-16; g:=fam_fnt(z);
+ if g<>null_font then
+ @<Look at the list of characters starting with |x| in
+ font |g|; set |f| and |c| whenever
+ a better character is found; |goto found| as soon as a
+ large enough variant is encountered@>;
+ until z<16;
+ end
+@y
+@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
+if (z<>0)or(x<>min_quarterword) then
+ begin z:=z+s+script_size;
+ repeat z:=z-script_size; g:=fam_fnt(z);
+ if g<>null_font then
+ @<Look at the list of characters starting with |x| in
+ font |g|; set |f| and |c| whenever
+ a better character is found; |goto found| as soon as a
+ large enough variant is encountered@>;
+ until z<script_size;
+ end
+@z
+%---------------------------------------
+@x [35] m.708 l.13903 - Omega
+if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
+@y
+if (qo(y)>=font_bc(g))and(qo(y)<=font_ec(g)) then
+@z
+%---------------------------------------
+@x [35] m.713 l.13974 - Omega
+r:=font_info[exten_base[f]+rem_byte(q)].qqqq;@/
+@<Compute the minimum suitable height, |w|, and the corresponding
+ number of extension steps, |n|; also set |width(b)|@>;
+c:=ext_bot(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+c:=ext_rep(r);
+for m:=1 to n do stack_into_box(b,f,c);
+c:=ext_mid(r);
+if c<>min_quarterword then
+ begin stack_into_box(b,f,c); c:=ext_rep(r);
+ for m:=1 to n do stack_into_box(b,f,c);
+ end;
+c:=ext_top(r);
+@y
+r:=font_info(f)(exten_base(f)+rem_byte(q)).qqqq;@/
+@<Compute the minimum suitable height, |w|, and the corresponding
+ number of extension steps, |n|; also set |width(b)|@>;
+c:=ext_bot(f)(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+c:=ext_rep(f)(r);
+for m:=1 to n do stack_into_box(b,f,c);
+c:=ext_mid(f)(r);
+if c<>min_quarterword then
+ begin stack_into_box(b,f,c); c:=ext_rep(f)(r);
+ for m:=1 to n do stack_into_box(b,f,c);
+ end;
+c:=ext_top(f)(r);
+@z
+%---------------------------------------
+@x [35] m.714 l.13997 - Omega
+c:=ext_rep(r); u:=height_plus_depth(f,c);
+w:=0; q:=char_info(f)(c); width(b):=char_width(f)(q)+char_italic(f)(q);@/
+c:=ext_bot(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_mid(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_top(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+n:=0;
+if u>0 then while w<v do
+ begin w:=w+u; incr(n);
+ if ext_mid(r)<>min_quarterword then w:=w+u;
+ end
+@y
+c:=ext_rep(f)(r); u:=height_plus_depth(f,c);
+w:=0; q:=char_info(f)(c); width(b):=char_width(f)(q)+char_italic(f)(q);@/
+c:=ext_bot(f)(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_mid(f)(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_top(f)(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+n:=0;
+if u>0 then while w<v do
+ begin w:=w+u; incr(n);
+ if (ext_mid(f)(r))<>min_quarterword then w:=w+u;
+ end
+@z
+%---------------------------------------
+@x [36] m.719 l.14107 - Omega
+@!cur_style:small_number; {style code at current place in the list}
+@!cur_size:small_number; {size code corresponding to |cur_style|}
+@y
+@!cur_style:integer; {style code at current place in the list}
+@!cur_size:integer; {size code corresponding to |cur_style|}
+@z
+%---------------------------------------
+@x [36] m.720 l.14122 - Omega
+function clean_box(@!p:pointer;@!s:small_number):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:small_number; {|cur_style| to be restored}
+@y
+function clean_box(@!p:pointer;@!s:integer):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:integer; {|cur_style| to be restored}
+@z
+%---------------------------------------
+@x [36] m.722 l.14172 - Omega
+else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
+@y
+else begin if (qo(cur_c)>=font_bc(cur_f))and(qo(cur_c)<=font_ec(cur_f)) then
+@z
+%---------------------------------------
+@x [36] m.726 l.14228 - Omega
+procedure mlist_to_hlist;
+label reswitch, check_dimensions, done_with_noad, done_with_node, delete_q,
+ done;
+var mlist:pointer; {beginning of the given list}
+@!penalties:boolean; {should penalty nodes be inserted?}
+@!style:small_number; {the given style}
+@!save_style:small_number; {holds |cur_style| during recursion}
+@!q:pointer; {runs through the mlist}
+@!r:pointer; {the most recent noad preceding |q|}
+@!r_type:small_number; {the |type| of noad |r|, or |op_noad| if |r=null|}
+@!t:small_number; {the effective |type| of noad |q| during the second pass}
+@!p,@!x,@!y,@!z: pointer; {temporary registers for list construction}
+@!pen:integer; {a penalty to be inserted}
+@!s:small_number; {the size of a noad to be deleted}
+@y
+procedure mlist_to_hlist;
+label reswitch, check_dimensions, done_with_noad, done_with_node, delete_q,
+ done;
+var mlist:pointer; {beginning of the given list}
+@!penalties:boolean; {should penalty nodes be inserted?}
+@!style:integer; {the given style}
+@!save_style:integer; {holds |cur_style| during recursion}
+@!q:pointer; {runs through the mlist}
+@!r:pointer; {the most recent noad preceding |q|}
+@!r_type:integer; {the |type| of noad |r|, or |op_noad| if |r=null|}
+@!t:integer; {the effective |type| of noad |q| during the second pass}
+@!p,@!x,@!y,@!z: pointer; {temporary registers for list construction}
+@!pen:integer; {a penalty to be inserted}
+@!s:integer; {the size of a noad to be deleted}
+@z
+%---------------------------------------
+@x [36] m.741 l.14495 - Omega
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin if qo(next_char(cur_i))=skew_char[cur_f] then
+ begin if op_byte(cur_i)>=kern_flag then
+ if skip_byte(cur_i)<=stop_flag then s:=char_kern(cur_f)(cur_i);
+ goto done1;
+ end;
+ if skip_byte(cur_i)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+ end;
+ end;
+ end;
+done1:
+@y
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_i:=font_info(cur_f)(a).qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info(cur_f)(a).qqqq;
+ end;
+ loop@+ begin if qo((next_char(cur_f)(cur_i)))=skew_char(cur_f) then
+ begin if op_byte(cur_i)>=kern_flag then
+ if skip_byte(cur_i)<=stop_flag then s:=char_kern(cur_f)(cur_i);
+ goto done1;
+ end;
+ if skip_byte(cur_i)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info(cur_f)(a).qqqq;
+ end;
+ end;
+ end;
+done1:
+@z
+%---------------------------------------
+@x [36] m.752 l.14722 - Omega
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach
+ the kern after~|q|; or if it is a ligature with |cur_c|, combine
+ noads |q| and~|p| appropriately; then |return| if the cursor has
+ moved past a noad, or |goto restart|@>;
+ if skip_byte(cur_i)>=stop_flag then return;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+@y
+ cur_i:=font_info(cur_f)(a).qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info(cur_f)(a).qqqq;
+ end;
+ loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach
+ the kern after~|q|; or if it is a ligature with |cur_c|, combine
+ noads |q| and~|p| appropriately; then |return| if the cursor has
+ moved past a noad, or |goto restart|@>;
+ if skip_byte(cur_i)>=stop_flag then return;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info(cur_f)(a).qqqq;
+@z
+%---------------------------------------
+@x [36] m.753 l.14751 - Omega
+if next_char(cur_i)=cur_c then if skip_byte(cur_i)<=stop_flag then
+@y
+if (next_char(cur_f)(cur_i))=cur_c then if skip_byte(cur_i)<=stop_flag then
+@z
+%---------------------------------------
+@x [36] m.756 l.14833 - Omega
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:small_number; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural);
+ if cur_style<script_style then t:=script_size@+else t:=script_script_size;
+ shift_up:=height(z)-sup_drop(t);
+ shift_down:=depth(z)+sub_drop(t);
+@y
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:integer; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural);
+ t:=cur_size;
+ if cur_style<script_style
+ then cur_size:=script_size@+else cur_size:=script_script_size;
+ shift_up:=height(z)-sup_drop(cur_size);
+ shift_down:=depth(z)+sub_drop(cur_size);
+ cur_size:=t;
+@z
+%---------------------------------------
+@x [36] m.762 l.14967 - Omega
+function make_left_right(@!q:pointer;@!style:small_number;
+ @!max_d,@!max_h:scaled):small_number;
+var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
+begin if style<script_style then cur_size:=text_size
+else cur_size:=16*((style-text_style) div 2);
+@y
+function make_left_right(@!q:pointer;@!style:integer;
+ @!max_d,@!max_h:scaled):integer;
+var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
+begin if style<script_style then cur_size:=text_size
+else cur_size:=script_size*((style-text_style) div 2);
+@z
+%---------------------------------------
+@x [40] m.896 l.17534 - Omega
+done2: hyf_char:=hyphen_char[hf];
+@y
+done2: hyf_char:=hyphen_char(hf);
+@z
+%---------------------------------------
+@x [40] m.897 l.17555 - Omega
+ hyf_bchar:=font_bchar[hf];
+@y
+ hyf_bchar:=font_bchar(hf);
+@z
+%---------------------------------------
+@x [40] m.898 l.17578 - Omega
+if odd(subtype(s)) then hyf_bchar:=font_bchar[hf]@+else hyf_bchar:=non_char;
+@y
+if odd(subtype(s)) then hyf_bchar:=font_bchar(hf)@+else hyf_bchar:=non_char;
+@z
+%---------------------------------------
+@x [41] m.909 l.17800 - Omega
+ begin k:=bchar_label[hf];
+ if k=non_address then goto done@+else q:=font_info[k].qqqq;
+ end
+else begin q:=char_info(hf)(cur_l);
+ if char_tag(q)<>lig_tag then goto done;
+ k:=lig_kern_start(hf)(q); q:=font_info[k].qqqq;
+ if skip_byte(q)>stop_flag then
+ begin k:=lig_kern_restart(hf)(q); q:=font_info[k].qqqq;
+@y
+ begin k:=bchar_label(hf);
+ if k=non_address then goto done@+else q:=font_info(hf)(k).qqqq;
+ end
+else begin q:=char_info(hf)(cur_l);
+ if char_tag(q)<>lig_tag then goto done;
+ k:=lig_kern_start(hf)(q); q:=font_info(hf)(k).qqqq;
+ if skip_byte(q)>stop_flag then
+ begin k:=lig_kern_restart(hf)(q); q:=font_info(hf)(k).qqqq;
+@z
+%---------------------------------------
+@x [41] m.909 l.17811 - Omega
+loop@+begin if next_char(q)=test_char then if skip_byte(q)<=stop_flag then
+@y
+loop@+begin if (next_char(hf)(q))=test_char then if skip_byte(q)<=stop_flag then
+@z
+%---------------------------------------
+@x [41] m.909 l.17829 - Omega
+ k:=k+qo(skip_byte(q))+1; q:=font_info[k].qqqq;
+@y
+ k:=k+qo(skip_byte(q))+1; q:=font_info(hf)(k).qqqq;
+@z
+%---------------------------------------
+@x [41] m.915 l.17963 - Omega
+ begin l:=reconstitute(l,i,font_bchar[hf],non_char)+1;
+@y
+ begin l:=reconstitute(l,i,font_bchar(hf),non_char)+1;
+@z
+%---------------------------------------
+@x [41] m.916 l.17980 - Omega
+if bchar_label[hf]<>non_address then {put left boundary at beginning of new line}
+@y
+if bchar_label(hf)<>non_address then {put left boundary at beginning of new line}
+@z
+%---------------------------------------
+@x [46] m.1030 l.19987 - Omega
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+@y
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+hmode+char_ghost: begin t:=cur_chr; get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then begin
+ if t=0 then new_left_ghost:=true
+ else new_right_ghost:=true;
+ end;
+ goto reswitch;
+ end;
+@z
+%---------------------------------------
+@x [46] m.1032 l.20030 - Omega
+ |font_bchar[cur_font]|,&otherwise;\cr}$$
+except when |character(lig_stack)=font_false_bchar[cur_font]|.
+@y
+ |font_bchar(cur_font)|,&otherwise;\cr}$$
+except when |character(lig_stack)=font_false_bchar(cur_font)|.
+@z
+%---------------------------------------
+@x [46] m.1032
+@!cancel_boundary:boolean; {should the left boundary be ignored?}
+@!ins_disc:boolean; {should we insert a discretionary node?}
+@y
+@!cancel_boundary:boolean; {should the left boundary be ignored?}
+@!left_ghost:boolean; {character left of cursor is a left ghost}
+@!right_ghost:boolean; {character left of cursor is a right ghost}
+@!new_left_ghost:boolean; {character right of cursor is a left ghost}
+@!new_right_ghost:boolean; {character right of cursor is a right ghost}
+@!ins_disc:boolean; {should we insert a discretionary node?}
+@!k_glue:integer;
+@!font_glue_spec:pointer;
+@z
+%---------------------------------------
+@x [46] m.1033
+ligature_present:=false; cancel_boundary:=false; lft_hit:=false; rt_hit:=false;
+@y
+ligature_present:=false; cancel_boundary:=false; lft_hit:=false; rt_hit:=false;
+left_ghost:=false; right_ghost:=false;
+new_left_ghost:=false; new_right_ghost:=false;
+@z
+%---------------------------------------
+@x [46] m.1034 l.20075 - Omega
+adjust_space_factor;@/
+main_f:=cur_font;
+bchar:=font_bchar[main_f]; false_bchar:=font_false_bchar[main_f];
+if mode>0 then if language<>clang then fix_language;
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+character(lig_stack):=cur_l;@/
+cur_q:=tail;
+if cancel_boundary then
+ begin cancel_boundary:=false; main_k:=non_address;
+ end
+else main_k:=bchar_label[main_f];
+if main_k=non_address then goto main_loop_move+2; {no left boundary processing}
+cur_r:=cur_l; cur_l:=non_char;
+goto main_lig_loop+1; {begin with cursor after left boundary}
+@y
+adjust_space_factor;@/
+main_f:=cur_font;
+bchar:=font_bchar(main_f); false_bchar:=font_false_bchar(main_f);
+if mode>0 then if language<>clang then fix_language;
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+character(lig_stack):=cur_l;@/
+cur_q:=tail;
+if cancel_boundary then
+ begin cancel_boundary:=false; main_k:=non_address;
+ left_ghost:=new_left_ghost; right_ghost:=new_right_ghost;
+ new_left_ghost:=false; new_right_ghost:=false;
+ end
+else main_k:=bchar_label(main_f);
+if main_k=non_address then goto main_loop_move+2; {no left boundary processing}
+cur_r:=cur_l; cur_l:=non_char;
+if not new_right_ghost then
+ goto main_lig_loop+1; {begin with cursor after left boundary}
+@z
+%---------------------------------------
+@x [46] m.1035 l.20122 - Omega
+ begin if character(tail)=qi(hyphen_char[main_f]) then if link(cur_q)>null then
+@y
+ begin if character(tail)=qi(hyphen_char(main_f)) then if link(cur_q)>null then
+@z
+%---------------------------------------
+@x [46] m.1036 l.20135 - Omega
+if lig_stack=null then goto reswitch;
+cur_q:=tail; cur_l:=character(lig_stack);
+main_loop_move+1:if not is_char_node(lig_stack) then goto main_loop_move_lig;
+main_loop_move+2:if(cur_chr<font_bc[main_f])or(cur_chr>font_ec[main_f]) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+main_i:=char_info(main_f)(cur_l);
+if not char_exists(main_i) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+tail_append(lig_stack) {|main_loop_lookahead| is next}
+@y
+if lig_stack=null then goto reswitch;
+cur_q:=tail; cur_l:=character(lig_stack);
+main_loop_move+1:if not is_char_node(lig_stack) then goto main_loop_move_lig;
+main_loop_move+2:
+left_ghost:=new_left_ghost; right_ghost:=new_right_ghost;
+new_left_ghost:=false; new_right_ghost:=false;
+if(cur_chr<font_bc(main_f))or(cur_chr>font_ec(main_f)) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+main_i:=char_info(main_f)(cur_l);
+if not char_exists(main_i) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+if not (left_ghost or right_ghost) then
+ tail_append(lig_stack) {|main_loop_lookahead| is next}
+@z
+%---------------------------------------
+@x [46] m.1038 l.20177 - Omega
+if cur_cmd=no_boundary then bchar:=non_char;
+@y
+if cur_cmd=char_ghost then begin t:=cur_chr; get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then begin
+ if t=0 then new_left_ghost:=true
+ else new_right_ghost:=true;
+ back_input;
+ goto main_loop_lookahead;
+ end;
+ end;
+if cur_cmd=no_boundary then bchar:=non_char;
+@z
+%---------------------------------------
+@x [46] m.1039 l.20193 - Omega
+@<If there's a ligature/kern command...@>=
+if char_tag(main_i)<>lig_tag then goto main_loop_wrapup;
+main_k:=lig_kern_start(main_f)(main_i); main_j:=font_info[main_k].qqqq;
+if skip_byte(main_j)<=stop_flag then goto main_lig_loop+2;
+main_k:=lig_kern_restart(main_f)(main_j);
+main_lig_loop+1:main_j:=font_info[main_k].qqqq;
+main_lig_loop+2:if next_char(main_j)=cur_r then
+ if skip_byte(main_j)<=stop_flag then
+ @<Do ligature or kern command, returning to |main_lig_loop|
+ or |main_loop_wrapup| or |main_loop_move|@>;
+if skip_byte(main_j)=qi(0) then incr(main_k)
+else begin if skip_byte(main_j)>=stop_flag then goto main_loop_wrapup;
+ main_k:=main_k+qo(skip_byte(main_j))+1;
+ end;
+goto main_lig_loop+1
+@y
+@<If there's a ligature/kern command...@>=
+if new_right_ghost or left_ghost then goto main_loop_wrapup;
+if char_tag(main_i)<>lig_tag then goto main_loop_wrapup;
+main_k:=lig_kern_start(main_f)(main_i);
+main_j:=font_info(main_f)(main_k).qqqq;
+if skip_byte(main_j)<=stop_flag then goto main_lig_loop+2;
+main_k:=lig_kern_restart(main_f)(main_j);
+main_lig_loop+1: main_j:=font_info(main_f)(main_k).qqqq;
+main_lig_loop+2:if top_skip_byte(main_j)=0 then begin
+ if next_char(main_f)(main_j)=cur_r then
+ if skip_byte(main_j)<=stop_flag then
+ @<Do ligature or kern command, returning to |main_lig_loop|
+ or |main_loop_wrapup| or |main_loop_move|@>;
+ end
+ else begin
+ if (font_bc(main_f)<=cur_r) then
+ if (font_ec(main_f)>=cur_r) then
+ if (char_exists(char_info(main_f)(cur_r))) then
+ if cur_r<>bchar then
+ if next_char(main_f)(main_j)=
+ attr_zero_char_ivalue(main_f)(cur_r) then
+ @<Do glue or penalty command@>;
+ end;
+if skip_byte(main_j)=qi(0) then incr(main_k)
+else begin if skip_byte(main_j)>=stop_flag then goto main_loop_wrapup;
+ main_k:=main_k+qo(skip_byte(main_j))+1;
+ end;
+goto main_lig_loop+1
+
+@ There are currently three commands. Command 17 will add a penalty
+node between the two characters. Command 18 will add a glue
+node between the two characters. Command 19 will add a penalty node,
+then a glue node between the two characters. Command 20
+will add a kern nore between the two characters.
+
+@<Do glue or penalty command@>=
+begin
+if new_left_ghost or right_ghost then goto main_loop_wrapup;
+case op_byte(main_j) of
+ qi(20): begin wrapup(rt_hit);
+ tail_append(new_kern(attr_zero_kern(main_f)(rem_byte(main_j))));
+ end;
+ qi(18): begin wrapup(rt_hit);
+ k_glue:=glues_base(main_f) + (rem_byte(main_j)*4);
+ font_glue_spec:=new_spec(zero_glue);
+ width(font_glue_spec):= font_info(main_f)(k_glue+1).sc;
+ stretch(font_glue_spec):=font_info(main_f)(k_glue+2).sc;
+ shrink(font_glue_spec):=font_info(main_f)(k_glue+3).sc;
+ tail_append(new_glue(font_glue_spec));
+ end;
+ qi(19): begin wrapup(rt_hit);
+ tail_append(new_penalty(attr_zero_penalty(main_f)(rem_top_byte(main_j))));
+ k_glue:=glues_base(main_f) + (rem_bot_byte(main_j)*4);
+ font_glue_spec:=new_spec(zero_glue);
+ width(font_glue_spec):= font_info(main_f)(k_glue+1).sc;
+ stretch(font_glue_spec):=font_info(main_f)(k_glue+2).sc;
+ shrink(font_glue_spec):=font_info(main_f)(k_glue+3).sc;
+ tail_append(new_glue(font_glue_spec));
+ end;
+ qi(17): begin wrapup(rt_hit);
+ tail_append(new_penalty(attr_zero_penalty(main_f)(rem_byte(main_j))));
+ end;
+ end;
+goto main_loop_move;
+end
+@z
+%---------------------------------------
+@x [46] m.1040 l.20219 - Omega
+begin if op_byte(main_j)>=kern_flag then
+ begin wrapup(rt_hit);
+ tail_append(new_kern(char_kern(main_f)(main_j))); goto main_loop_move;
+ end;
+if cur_l=non_char then lft_hit:=true
+else if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(main_j) of
+qi(1),qi(5):begin cur_l:=rem_byte(main_j); {\.{=:\?}, \.{=:\?>}}
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_byte(main_j); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack=null then {right boundary character is being consumed}
+ begin lig_stack:=new_lig_item(cur_r); bchar:=non_char;
+ end
+ else if is_char_node(lig_stack) then {|link(lig_stack)=null|}
+ begin main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ lig_ptr(lig_stack):=main_p;
+ end
+ else character(lig_stack):=cur_r;
+ end;
+qi(3):begin cur_r:=rem_byte(main_j); {\.{\?=:\?}}
+ main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ link(lig_stack):=main_p;
+ end;
+qi(7),qi(11):begin wrapup(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=tail; cur_l:=rem_byte(main_j);
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_byte(main_j); ligature_present:=true; {\.{=:}}
+ if lig_stack=null then goto main_loop_wrapup
+ else goto main_loop_move+1;
+ end
+endcases;
+if op_byte(main_j)>qi(4) then
+ if op_byte(main_j)<>qi(7) then goto main_loop_wrapup;
+if cur_l<non_char then goto main_lig_loop;
+main_k:=bchar_label[main_f]; goto main_lig_loop+1;
+end
+@y
+begin if op_byte(main_j)>=kern_flag then
+ begin wrapup(rt_hit);
+ tail_append(new_kern(char_kern(main_f)(main_j)));
+ if new_left_ghost or right_ghost then begin
+ subtype(tail):=explicit;
+ end;
+ goto main_loop_move;
+ end;
+if new_left_ghost or right_ghost then goto main_loop_wrapup;
+if cur_l=non_char then lft_hit:=true
+else if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(main_j) of
+qi(1),qi(5):begin cur_l:=rem_char_byte(main_f)(main_j); {\.{=:\?}, \.{=:\?>}}
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_char_byte(main_f)(main_j); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack=null then {right boundary character is being consumed}
+ begin lig_stack:=new_lig_item(cur_r); bchar:=non_char;
+ end
+ else if is_char_node(lig_stack) then {|link(lig_stack)=null|}
+ begin main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ lig_ptr(lig_stack):=main_p;
+ end
+ else character(lig_stack):=cur_r;
+ end;
+qi(3):begin cur_r:=rem_char_byte(main_f)(main_j); {\.{\?=:\?}}
+ main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ link(lig_stack):=main_p;
+ end;
+qi(7),qi(11):begin wrapup(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=tail; cur_l:=rem_char_byte(main_f)(main_j);
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_char_byte(main_f)(main_j);
+ ligature_present:=true; {\.{=:}}
+ if lig_stack=null then goto main_loop_wrapup
+ else goto main_loop_move+1;
+ end
+endcases;
+if op_byte(main_j)>qi(4) then
+ if op_byte(main_j)<>qi(7) then goto main_loop_wrapup;
+if cur_l<non_char then goto main_lig_loop;
+main_k:=bchar_label(main_f); goto main_lig_loop+1;
+end
+@z
+%---------------------------------------
+@x [46] m.1042 l.20285 - Omega
+begin main_p:=font_glue[cur_font];
+if main_p=null then
+ begin main_p:=new_spec(zero_glue); main_k:=param_base[cur_font]+space_code;
+ width(main_p):=font_info[main_k].sc; {that's |space(cur_font)|}
+ stretch(main_p):=font_info[main_k+1].sc; {and |space_stretch(cur_font)|}
+ shrink(main_p):=font_info[main_k+2].sc; {and |space_shrink(cur_font)|}
+ font_glue[cur_font]:=main_p;
+@y
+begin main_p:=font_glue(cur_font);
+if main_p=null then
+ begin main_p:=new_spec(zero_glue); main_k:=param_base(cur_font)+space_code;
+ width(main_p):=font_info(cur_font)(main_k).sc; {that's |space(cur_font)|}
+ stretch(main_p):=font_info(cur_font)(main_k+1).sc;
+ {and |space_stretch(cur_font)|}
+ shrink(main_p):=font_info(cur_font)(main_k+2).sc;
+ {and |space_shrink(cur_font)|}
+ font_glue(cur_font):=main_p;
+@z
+%---------------------------------------
+@x [47] m.1090
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+@y
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+vmode+char_ghost,
+@z
+%---------------------------------------
+@x [48] m.1117 l.21343 - Omega
+ begin c:=hyphen_char[cur_font];
+@y
+ begin c:=hyphen_char(cur_font);
+@z
+%---------------------------------------
+@x [49] m.1195 l.22361 - Omega
+if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@|
+ (font_params[fam_fnt(2+script_size)]<total_mathsy_params)or@|
+ (font_params[fam_fnt(2+script_script_size)]<total_mathsy_params) then
+ begin print_err("Math formula deleted: Insufficient symbol fonts");@/
+@.Math formula deleted...@>
+ help3("Sorry, but I can't typeset math unless \textfont 2")@/
+ ("and \scriptfont 2 and \scriptscriptfont 2 have all")@/
+ ("the \fontdimen values needed in math symbol fonts.");
+ error; flush_math; danger:=true;
+ end
+else if (font_params[fam_fnt(3+text_size)]<total_mathex_params)or@|
+ (font_params[fam_fnt(3+script_size)]<total_mathex_params)or@|
+ (font_params[fam_fnt(3+script_script_size)]<total_mathex_params) then
+@y
+if (font_params(fam_fnt(2+text_size))<total_mathsy_params)or@|
+ (font_params(fam_fnt(2+script_size))<total_mathsy_params)or@|
+ (font_params(fam_fnt(2+script_script_size))<total_mathsy_params) then
+ begin print_err("Math formula deleted: Insufficient symbol fonts");@/
+@.Math formula deleted...@>
+ help3("Sorry, but I can't typeset math unless \textfont 2")@/
+ ("and \scriptfont 2 and \scriptscriptfont 2 have all")@/
+ ("the \fontdimen values needed in math symbol fonts.");
+ error; flush_math; danger:=true;
+ end
+else if (font_params(fam_fnt(3+text_size))<total_mathex_params)or@|
+ (font_params(fam_fnt(3+script_size))<total_mathex_params)or@|
+ (font_params(fam_fnt(3+script_script_size))<total_mathex_params) then
+@z
+%---------------------------------------
+@x [49] m.1253 l.23250 - Omega
+assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen; font_info[k].sc:=cur_val;
+ end;
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
+@y
+assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen;
+ font_info(dimen_font)(k).sc:=cur_val;
+ end;
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char(f):=cur_val@+else skew_char(f):=cur_val;
+@z
+%---------------------------------------
+@x [49] m.1257 l.23269 - Omega
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+@y
+@!offset:integer;
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+@z
+%---------------------------------------
+@x [49] m.1257 l.23290 - Omega
+@<Scan the font size specification@>;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s);
+common_ending: equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
+@y
+@<Scan the font size specification@>;
+name_in_progress:=true;
+if scan_keyword("offset") then begin
+ scan_int;
+ offset:=cur_val;
+ if (cur_val<0) then begin
+ print_err("Illegal offset has been changed to 0");
+ help1("The offset must be bigger than 0."); int_error(cur_val);
+ offset:=0;
+ end
+ end
+else offset:=0;
+name_in_progress:=false;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s,offset);
+common_ending: set_equiv(u,f);
+set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t);
+@z
+%---------------------------------------
+@x [49] m.1260 l.23333 - Omega
+for f:=font_base+1 to font_ptr do
+ if str_eq_str(font_name[f],cur_name)and str_eq_str(font_area[f],cur_area) then
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name[f];
+ end;
+ if s>0 then
+ begin if s=font_size[f] then goto common_ending;
+ end
+ else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
+ goto common_ending;
+ end
+@y
+for f:=font_base+1 to font_ptr do begin
+ if str_eq_str(font_name(f),cur_name) and
+ str_eq_str(font_area(f),cur_area) then
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name(f);
+ end;
+ if s>0 then
+ begin if s=font_size(f) then goto common_ending;
+ end
+ else if font_size(f)=xn_over_d(font_dsize(f),-s,1000) then
+ goto common_ending;
+ end
+ end
+@z
+%---------------------------------------
+@x [49] m.1261 l.23345 - Omega
+set_font:begin print("select font "); slow_print(font_name[chr_code]);
+ if font_size[chr_code]<>font_dsize[chr_code] then
+ begin print(" at "); print_scaled(font_size[chr_code]);
+@y
+set_font:begin print("select font "); slow_print(font_name(chr_code));
+ if font_size(chr_code)<>font_dsize(chr_code) then
+ begin print(" at "); print_scaled(font_size(chr_code));
+@z
+%---------------------------------------
+@x [50] m.1320 l.23983 - Omega
+@ @<Dump the font information@>=
+dump_int(fmem_ptr);
+for k:=0 to fmem_ptr-1 do dump_wd(font_info[k]);
+dump_int(font_ptr);
+for k:=null_font to font_ptr do
+ @<Dump the array info for internal font number |k|@>;
+print_ln; print_int(fmem_ptr-7); print(" words of font info for ");
+print_int(font_ptr-font_base); print(" preloaded font");
+if font_ptr<>font_base+1 then print_char("s")
+@y
+@ @<Dump the font information@>=
+dump_int(font_ptr);
+for k:=null_font to font_ptr do
+ @<Dump the array info for internal font number |k|@>;
+print_ln; print_int(font_ptr-font_base); print(" preloaded font");
+if font_ptr<>font_base+1 then print_char("s")
+@z
+%---------------------------------------
+@x [50] m.1321 l.23993 - Omega
+@ @<Undump the font information@>=
+undump_size(7)(font_mem_size)('font mem size')(fmem_ptr);
+for k:=0 to fmem_ptr-1 do undump_wd(font_info[k]);
+undump_size(font_base)(font_max)('font max')(font_ptr);
+for k:=null_font to font_ptr do
+ @<Undump the array info for internal font number |k|@>
+@y
+@ @<Undump the font information@>=
+undump_size(font_base)(font_max)('font max')(font_ptr);
+for k:=null_font to font_ptr do
+ @<Undump the array info for internal font number |k|@>
+@z
+%---------------------------------------
+@x [50] m.1322 l.24000 - Omega
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_qqqq(font_check[k]);
+dump_int(font_size[k]);
+dump_int(font_dsize[k]);
+dump_int(font_params[k]);@/
+dump_int(hyphen_char[k]);
+dump_int(skew_char[k]);@/
+dump_int(font_name[k]);
+dump_int(font_area[k]);@/
+dump_int(font_bc[k]);
+dump_int(font_ec[k]);@/
+dump_int(char_base[k]);
+dump_int(width_base[k]);
+dump_int(height_base[k]);@/
+dump_int(depth_base[k]);
+dump_int(italic_base[k]);
+dump_int(lig_kern_base[k]);@/
+dump_int(kern_base[k]);
+dump_int(exten_base[k]);
+dump_int(param_base[k]);@/
+dump_int(font_glue[k]);@/
+dump_int(bchar_label[k]);
+dump_int(font_bchar[k]);
+dump_int(font_false_bchar[k]);@/
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(font_name[k],font_area[k],"");
+if font_size[k]<>font_dsize[k] then
+ begin print(" at "); print_scaled(font_size[k]); print("pt");
+ end;
+end
+@y
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_font_table(k,param_base(k)+font_params(k)+1);
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(font_name(k),font_area(k),"");
+if font_size(k)<>font_dsize(k) then
+ begin print(" at "); print_scaled(font_size(k)); print("pt");
+ end;
+end
+@z
+%---------------------------------------
+@x [50] m.1323 l.24031 - Omega
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_qqqq(font_check[k]);@/
+undump_int(font_size[k]);
+undump_int(font_dsize[k]);
+undump(min_halfword)(max_halfword)(font_params[k]);@/
+undump_int(hyphen_char[k]);
+undump_int(skew_char[k]);@/
+undump(0)(str_ptr)(font_name[k]);
+undump(0)(str_ptr)(font_area[k]);@/
+undump(0)(255)(font_bc[k]);
+undump(0)(255)(font_ec[k]);@/
+undump_int(char_base[k]);
+undump_int(width_base[k]);
+undump_int(height_base[k]);@/
+undump_int(depth_base[k]);
+undump_int(italic_base[k]);
+undump_int(lig_kern_base[k]);@/
+undump_int(kern_base[k]);
+undump_int(exten_base[k]);
+undump_int(param_base[k]);@/
+undump(min_halfword)(lo_mem_max)(font_glue[k]);@/
+undump(0)(fmem_ptr-1)(bchar_label[k]);
+undump(min_quarterword)(non_char)(font_bchar[k]);
+undump(min_quarterword)(non_char)(font_false_bchar[k]);
+end
+@y
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_font_table(k);@/
+end
+@z
+%---------------------------------------
+@x [51] m.1334 l.24277 - Omega
+ wlog(' ',fmem_ptr:1,' words of font info for ',
+ font_ptr-font_base:1,' font');
+ if font_ptr<>font_base+1 then wlog('s');
+@y
+ wlog(font_ptr-font_base:1,' font');
+ if font_ptr<>font_base+1 then wlog('s');
+@z
+%---------------------------------------
+@x [52] m.1339 l.24429 - Omega
+4: print_word(eqtb[n]);
+5: print_word(font_info[n]);
+@y
+4: print_word(new_eqtb(n));
+5: ;
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir/omnode.ch b/Build/source/texk/web2c/omegadir/omnode.ch
new file mode 100644
index 00000000000..bcbdbf1b9c3
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omnode.ch
@@ -0,0 +1,20 @@
+% omnode.ch: C++ - friendly Node access functions,
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
diff --git a/Build/source/texk/web2c/omegadir/omocp.ch b/Build/source/texk/web2c/omegadir/omocp.ch
new file mode 100644
index 00000000000..a99cab4c100
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omocp.ch
@@ -0,0 +1,1068 @@
+% omocp.ch: Reading an OCP file
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.412 - Omega OCP
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@y
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@!ocp_maxint=@"10000000;
+@z
+%---------------------------------------
+@x [1] m.12 l.436 - Omega OCP
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@d ocp_base=0 {smallest internal ocp number; must not be less
+ than |min_quarterword|}
+@d ocp_biggest=65535 {the real biggest ocp}
+@d number_ocps=ocp_biggest-ocp_base+1
+@d ocp_list_base=0 {smallest internal ocp list number; must not be less
+ than |min_quarterword|}
+@d ocp_list_biggest=65535 {the real biggest ocp list}
+@d number_ocp_lists=ocp_list_biggest-ocp_list_base+1
+@d max_active_ocp_lists=65536
+@z
+%---------------------------------------
+@x [15] m.209 l.4170 - Omega OCP
+@d max_command=set_interaction
+ {the largest command code seen at |big_switch|}
+@y
+@d set_ocp=set_interaction+1
+ {Place a translation process in the stream}
+@d def_ocp=set_ocp+1
+ {Define and load a translation process}
+@d set_ocp_list=def_ocp+1
+ {Place a list of OCPs in the stream}
+@d def_ocp_list=set_ocp_list+1
+ {Define a list of OCPs}
+@d clear_ocp_lists=def_ocp_list+1
+ {Remove all active OCP lists}
+@d push_ocp_list=clear_ocp_lists+1
+ {Add to the sequence of active OCP lists}
+@d pop_ocp_list=push_ocp_list+1
+ {Remove from the sequence of active OCP lists}
+@d ocp_list_op=pop_ocp_list+1
+ {Operations for building a list of OCPs}
+@d ocp_trace_level=ocp_list_op+1
+ {Tracing of active OCPs, either 0 or 1}
+@d max_command=ocp_trace_level
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.222 l.4523 - Omega OCP
+@d font_id_base=frozen_null_font-font_base
+ {begins table of |number_fonts| permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+number_fonts
+@y
+@d font_id_base=frozen_null_font-font_base
+ {begins table of |number_fonts| permanent font identifiers}
+@d frozen_null_ocp=frozen_null_font+number_fonts
+ {permanent `\.{\\nullocp}'}
+@d ocp_id_base=frozen_null_ocp-ocp_base
+ {begins table of |number_ocps| permanent ocp identifiers}
+@d frozen_null_ocp_list=frozen_null_ocp+number_ocps
+ {permanent `\.{\\nullocplist}'}
+@d ocp_list_id_base=frozen_null_ocp_list-ocp_list_base
+ {begins table of |number_ocp_lists| permanent ocp list identifiers}
+@d undefined_control_sequence=frozen_null_ocp_list+number_ocp_lists
+@z
+%---------------------------------------
+@x
+@d toks_base=local_base+10 {table of |number_regs| token list registers}
+@y
+@d ocp_trace_level_base=local_base+10
+@d ocp_active_number_base=ocp_trace_level_base+1
+@d ocp_active_min_ptr_base = ocp_active_number_base+1
+@d ocp_active_max_ptr_base = ocp_active_min_ptr_base+1
+@d ocp_active_base = ocp_active_max_ptr_base+1
+@d toks_base=ocp_active_base+max_active_ocp_lists
+ {table of |number_regs| token list registers}
+@z
+%---------------------------------------
+@x [17] m.232 l.4799 - Omega OCP
+@d null_font==font_base
+@y
+@d null_font==font_base
+@d null_ocp==ocp_base
+@d null_ocp_list==ocp_list_base
+@z
+%---------------------------------------
+@x [18] m.256 l.5479 - Omega OCP
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@y
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@d ocp_id_text(#) == newtext(ocp_id_base+#) {a frozen ocp identifier's name}
+@d ocp_list_id_text(#) == newtext(ocp_list_id_base+#)
+ {a frozen ocp list identifier's name}
+@z
+%---------------------------------------
+@x [26] m.409 l.8254 - Omega OCP
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@y
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@t\4\4@>@<Declare procedures that scan ocp-related stuff@>
+@z
+%---------------------------------------
+@x [29] m.514 l.9968 - Omega OCP
+|TEX_font_area|. These system area names will, of course, vary from place
+to place.
+@y
+|TEX_font_area|. $\Omega$'s compiled translation process files whose areas
+are not given explicitly are assumed to appear in a standard system area
+called |OMEGA_ocp_area|. These system area names will, of course, vary
+from place to place.
+@z
+%---------------------------------------
+@x [29] m.514 l.9974 - Omega OCP
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@d OMEGA_ocp_area=="OmegaOCPs:"
+@.OmegaOCPs@>
+@z
+%---------------------------------------
+@x [30] m.582 l.10379 - Omega OCP
+@* \[30] Font metric data.
+@y
+@* \[30] Font metric data and OCPs.
+@z
+%---------------------------------------
+@x [30] m.??? l.10928 - Omega OCP
+@ @<Read and check...@>=
+@y
+@ @<Read and check the font data...@>=
+@z
+%---------------------------------------
+@x [30] m.??? l.11010 - Omega OCP
+@ @<Apologize for not loading...@>=
+@y
+@ @<Apologize for not loading the font...@>=
+@z
+%---------------------------------------
+@x [30] m.582 l.11283 - Omega OCP
+char_warning(f,c);
+new_character:=null;
+exit:end;
+@y
+char_warning(f,c);
+new_character:=null;
+exit:end;
+
+@ Here we begin the \.{OCP} file handling.
+
+@<Glob...@>=
+@!ocp_file:byte_file;
+
+@ So that is what \.{OCP} files hold.
+
+When the user defines \.{\\ocp\\f}, say, \TeX\ assigns an internal number
+to the user's ocp~\.{\\f}. Adding this number to |ocp_id_base| gives the
+|eqtb| location of a ``frozen'' control sequence that will always select
+the ocp.
+
+@<Types...@>=
+@!internal_ocp_number=ocp_base..ocp_biggest;
+@!ocp_index=integer;
+
+@ Here now is the array of ocp arrays.
+
+@<Glob...@>=
+@!ocp_ptr:internal_ocp_number; {largest internal ocp number in use}
+
+@ Besides the arrays just enumerated, we have two directory arrays that
+make it easy to get at the individual entries in |ocp_info|.
+The beginning of the info for the |j|-th state in the |i|-th ocp is at
+location |ocp_info[ocp_state_base[i]+j]| and the |k|-th entry is in
+location |ocp_info[ocp_info[ocp_state_base[i]+j]+k]|.
+(These formulas assume that |min_quarterword| has already been
+added to |i|, |j| and |k|, since $\Omega$ stores its quarterwords that way.)
+
+@d ocp_info_end(#)==#]
+@d ocp_info(#)==ocp_tables[#,ocp_info_end
+@d offset_ocp_file_size=0
+@d offset_ocp_name=1
+@d offset_ocp_area=offset_ocp_name+1
+@d offset_ocp_external=offset_ocp_area+1
+@d offset_ocp_external_arg=offset_ocp_external+1
+@d offset_ocp_input=offset_ocp_external_arg+1
+@d offset_ocp_output=offset_ocp_input+1
+@d offset_ocp_no_tables=offset_ocp_output+1
+@d offset_ocp_no_states=offset_ocp_no_tables+1
+@d offset_ocp_table_base=offset_ocp_no_states+1
+@d offset_ocp_state_base=offset_ocp_table_base+1
+@d offset_ocp_info=offset_ocp_state_base+1
+@d ocp_file_size(#)==ocp_info(#)(offset_ocp_file_size)
+@d ocp_name(#)==ocp_info(#)(offset_ocp_name)
+@d ocp_area(#)==ocp_info(#)(offset_ocp_area)
+@d ocp_external(#)==ocp_info(#)(offset_ocp_external)
+@d ocp_external_arg(#)==ocp_info(#)(offset_ocp_external_arg)
+@d ocp_input(#)==ocp_info(#)(offset_ocp_input)
+@d ocp_output(#)==ocp_info(#)(offset_ocp_output)
+@d ocp_no_tables(#)==ocp_info(#)(offset_ocp_no_tables)
+@d ocp_no_states(#)==ocp_info(#)(offset_ocp_no_states)
+@d ocp_table_base(#)==ocp_info(#)(offset_ocp_table_base)
+@d ocp_state_base(#)==ocp_info(#)(offset_ocp_state_base)
+
+@ $\Omega$ always knows at least one ocp, namely the null ocp.
+It does nothing.
+
+@<Initialize table...@>=
+ocp_ptr:=null_ocp;
+allocate_ocp_table(null_ocp,17);
+ocp_file_size(null_ocp):=17;
+ocp_name(null_ocp):="nullocp"; ocp_area(null_ocp):="";
+ocp_external(null_ocp):=0; ocp_external_arg(null_ocp):=0;
+ocp_input(null_ocp):=1; ocp_output(null_ocp):=1;
+ocp_no_tables(null_ocp):=0;
+ocp_no_states(null_ocp):=1;
+ocp_table_base(f):=offset_ocp_info;
+ocp_state_base(f):=offset_ocp_info;
+ocp_info(null_ocp)(offset_ocp_info) := offset_ocp_info+2; {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+1) := offset_ocp_info+5; {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+2) := 23; {|OTP_LEFT_START|}
+ocp_info(null_ocp)(offset_ocp_info+3) := 3; {|OTP_RIGHT_CHAR|}
+ocp_info(null_ocp)(offset_ocp_info+4) := 36; {|OTP_STOP|}
+
+
+@ @<Put each...@>=
+primitive("nullocp", set_ocp, null_ocp);
+settext(frozen_null_ocp,"nullocp");
+set_new_eqtb(frozen_null_ocp,new_eqtb(cur_val));
+geq_define(ocp_active_number_base, data, 0);
+geq_define(ocp_active_min_ptr_base, data, 0);
+geq_define(ocp_active_max_ptr_base, data, 0);
+
+@ Of course we want to define macros that suppress the detail of how ocp
+information is actually packed, so that we don't have to write things like
+$$\hbox{|ocp_info[k+ocp_info[j+ocp_state_base[i]]]|}$$
+too often. The \.{WEB} definitions here make |ocp_state_entry(i)(j)(k)|
+(|ocp_table_entry(i)(j)(k)|) the |k|-th word in the |j|-th state (table)
+of the |i|-th ocp.
+@^inner loop@>
+
+@d ocp_state_end(#)==#]
+@d ocp_state_one(#)==#*2]+ocp_state_end
+@d ocp_state_entry(#)==ocp_tables[#,ocp_tables[#,ocp_state_base(#)+ocp_state_one
+
+@d ocp_state_no_end(#)==#*2+1]
+@d ocp_state_no(#)==ocp_tables[#,ocp_state_base(#)+ocp_state_no_end
+
+@d ocp_table_end(#)==#]
+@d ocp_table_one(#)==#*2]+ocp_table_end
+@d ocp_table_entry(#)==ocp_tables[#,ocp_tables[#,ocp_table_base(#)+ocp_table_one
+
+@d ocp_table_no_end(#)==#*2+1]
+@d ocp_table_no(#)==ocp_tables[#,ocp_table_base(#)+ocp_table_no_end
+
+@ $\Omega$ checks the information of a \.{OCP} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. The somewhat tedious subroutine that does this
+is called |read_ocp_info|. It has three parameters: the user ocp
+identifier~|u|, and the file name and area strings |nom| and |aire|.
+
+The subroutine opens and closes a global file variable called |ocp_file|.
+It returns the value of the internal ocp number that was just loaded.
+If an error is detected, an error message is issued and no ocp
+information is stored; |null_ocp| is returned in this case.
+
+@d bad_ocp=11 {label for |read_ocp_info|}
+@d ocp_abort(#)==begin print("OCP file error (");
+ print(#); print(")"); print_ln; goto bad_ocp end
+ {do this when the \.{OCP} data is wrong}
+
+@p function read_ocp_info(@!u:pointer;@!nom,@!aire,@!ext:str_number;
+ @!external_ocp:boolean)
+ :internal_ocp_number; {input a \.{OCP} file}
+label done,bad_ocp,not_found;
+var
+@!file_opened:boolean; {was |ocp_file| successfully opened?}
+@!f:internal_ocp_number; {the new ocp's number}
+@!g:internal_ocp_number; {the number to return}
+@!ocpword:integer;
+@!ocpmem_run_ptr:ocp_index;
+@!ocp_length,real_ocp_length:integer; {length of ocp file}
+@!previous_address:ocp_index;
+@!temp_ocp_input:integer;
+@!temp_ocp_output:integer;
+@!temp_ocp_no_tables:integer;
+@!temp_ocp_no_states:integer;
+@!i,new_offset,room_for_tables,room_for_states:integer;
+begin g:=null_ocp;@/
+@<Read and check the ocp data; |ocp_abort| if the \.{OCP} file is
+ malformed; if there's no room for this ocp, say so and |goto
+ done|; otherwise |incr(ocp_ptr)| and |goto done|@>;
+bad_ocp: @<Report that the ocp won't be loaded@>;
+done: if file_opened then b_close(ocp_file);
+ocp_name(f):=nom; ocp_area(f):=aire;
+read_ocp_info:=g;
+end;
+
+@ $\Omega$ does not give precise details about why it
+rejects a particular \.{OCP} file.
+
+@d start_ocp_error_message==print_err("Translation process ");
+ sprint_cs(u); print_char("="); print_file_name(nom,aire,"");
+
+@<Report that the ocp won't be loaded@>=
+start_ocp_error_message;
+@.Translation process x=xx not loadable...@>
+if file_opened then print(" not loadable: Bad ocp file")
+else print(" not loadable: ocp file not found");
+help2("I wasn't able to read the data for this ocp,")@/
+("so I will ignore the ocp specification.");
+error
+
+@ @<Read and check the ocp data...@>=
+if external_ocp then
+ @<Check |ocp_file| exists@>
+else begin
+ @<Open |ocp_file| for input@>;
+ @<Read the {\.{OCP}} file@>;
+ end;
+
+@ @<Check |ocp_file| exists@>=
+begin
+file_opened:=false;
+pack_file_name(nom,aire,ext);
+b_test_in;
+if name_length=0 then ocp_abort("opening file");
+f :=ocp_ptr+1;
+allocate_ocp_table(f,13);
+ocp_file_size(f):=13;
+for i:=1 to name_length do begin
+ append_char(name_of_file[i]);
+ end;
+ocp_external(f):=make_string;
+scan_string_argument;
+ocp_external_arg(f):=cur_val;
+ocp_name(f):=""; ocp_area(f):="";
+ocp_state_base(f):=0; ocp_table_base(f):=0;
+ocp_input(f):=1; ocp_output(f):=1;
+ocp_info(f)(offset_ocp_info):=0;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ @<Open |ocp_file| for input@>=
+file_opened:=false;
+pack_file_name(nom,aire,".ocp");
+if not b_open_in(ocp_file) then ocp_abort("opening file");
+file_opened:=true
+
+@ Note: A malformed \.{OCP} file might be shorter than it claims to be;
+thus |eof(ocp_file)| might be true when |read_ocp_info| refers to
+|ocp_file^| or when it says |get(ocp_file)|. If such circumstances
+cause system error messages, you will have to defeat them somehow,
+for example by defining |ocpget| to be `\ignorespaces|begin get(ocp_file);|
+|if eof(ocp_file) then ocp_abort; end|\unskip'.
+@^system dependencies@>
+
+@d add_to_ocp_info(#)==begin ocp_tables[f,ocpmem_run_ptr]:=#;
+ incr(ocpmem_run_ptr);
+ end
+@d ocpget==get(ocp_file)
+@d ocpbyte==ocp_file^
+@d ocp_read(#)==begin ocpword:=ocpbyte;
+ if ocpword>127 then ocp_abort("checking first octet");
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ #:=ocpword;
+ end
+@d ocp_read_all(#)==begin ocpget; ocp_read(#); end
+@d ocp_read_info==begin ocp_read_all(ocpword);
+ add_to_ocp_info(ocpword);
+ end
+
+@ @<Read the {\.{OCP}} file@>=
+begin
+f :=ocp_ptr+1;
+ocpmem_run_ptr:=offset_ocp_info;
+ocp_read(ocp_length);
+real_ocp_length:=ocp_length-7;
+ocp_read_all(temp_ocp_input);
+ocp_read_all(temp_ocp_output);
+ocp_read_all(temp_ocp_no_tables);
+ocp_read_all(room_for_tables);
+ocp_read_all(temp_ocp_no_states);
+ocp_read_all(room_for_states);
+if real_ocp_length <>
+ (temp_ocp_no_tables + room_for_tables +
+ temp_ocp_no_states + room_for_states) then
+ ocp_abort("checking size");
+real_ocp_length:=real_ocp_length+12+
+ temp_ocp_no_states+temp_ocp_no_tables;
+allocate_ocp_table(f,real_ocp_length);
+ocp_external(f):=0;
+ocp_external_arg(f):=0;
+ocp_file_size(f):=real_ocp_length;
+ocp_input(f):=temp_ocp_input;
+ocp_output(f):=temp_ocp_output;
+ocp_no_tables(f):=temp_ocp_no_tables;
+ocp_no_states(f):=temp_ocp_no_states;
+ocp_table_base(f):=ocpmem_run_ptr;
+if ocp_no_tables(f) <> 0 then begin
+ previous_address:=ocpmem_run_ptr+2*(ocp_no_tables(f));
+ for i:=1 to ocp_no_tables(f) do begin
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address:=previous_address+new_offset;
+ end
+ end;
+if room_for_tables <> 0 then begin
+ for i:=1 to room_for_tables do begin
+ ocp_read_info;
+ end
+ end;
+ocp_state_base(f):=ocpmem_run_ptr;
+if ocp_no_states(f) <> 0 then begin
+ previous_address:=ocpmem_run_ptr+2*(ocp_no_states(f));
+ for i:=1 to ocp_no_states(f) do begin
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address:=previous_address+new_offset;
+ end;
+ end;
+if room_for_states <> 0 then begin
+ for i:=1 to room_for_states do begin
+ ocp_read_info;
+ end
+ end;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ Before we forget about the format of these tables, let's deal with
+$\Omega$'s basic scanning routine related to ocp information.
+
+@<Declare procedures that scan ocp-related stuff@>=
+procedure scan_ocp_ident;
+var f:internal_ocp_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp then f:=cur_chr
+else begin print_err("Missing ocp identifier");
+@.Missing ocp identifier@>
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \ocp.");
+ back_error; f:=null_ocp;
+ end;
+cur_val:=f;
+end;
+
+
+@ Here we begin the \.{OCP} list handling.
+
+
+@<Types...@>=
+@!internal_ocp_list_number=ocp_list_base..ocp_list_biggest;
+@!ocp_list_index=integer; {index into |ocp_list_info|}
+@!ocp_lstack_index=integer; {index into |ocp_lstack_info|}
+
+@ Here now is the array of ocp arrays.
+@d ocp_list_lnext(#)==ocp_list_info[#].hh.b0
+@d ocp_list_lstack(#)==ocp_list_info[#].hh.b1
+@d ocp_list_lstack_no(#)==ocp_list_info[#+1].sc
+@d ocp_lstack_lnext(#)==ocp_lstack_info[#].hh.b0
+@d ocp_lstack_ocp(#)==ocp_lstack_info[#].hh.b1
+@d make_null_ocp_list==make_ocp_list_node(0,ocp_maxint,0)
+@d is_null_ocp_list(#)==ocp_list_lstack_no(#)=ocp_maxint
+@d make_null_ocp_lstack==0
+@d is_null_ocp_lstack(#)==#=0
+@d add_before_op=1
+@d add_after_op=2
+@d remove_before_op=3
+@d remove_after_op=4
+
+@<Glob...@>=
+@!ocp_list_info:array[ocp_list_index] of memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
+
+@
+@<Initialize table...@>=
+ocp_listmem_ptr:=2;
+ocp_list_lstack(0):=0;
+ocp_list_lstack_no(0):=ocp_maxint;
+ocp_list_lnext(0):=0;
+ocp_list_ptr:=null_ocp_list;
+ocp_list_list[null_ocp_list]:=0;
+ocp_lstackmem_ptr:=1;
+
+@ $\Omega$ always knows at least one ocp list, namely the null ocp list.
+
+@ @<Put each...@>=
+primitive("nullocplist", set_ocp_list, null_ocp_list);
+settext(frozen_null_ocp_list,"nullocplist");
+set_new_eqtb(frozen_null_ocp_list,new_eqtb(cur_val));
+
+@ @p function make_ocp_list_node(llstack:ocp_lstack_index;
+ llstack_no:scaled;
+ llnext:ocp_list_index):ocp_list_index;
+var p:ocp_list_index;
+begin
+p:=ocp_listmem_run_ptr;
+ocp_list_lstack(p):=llstack;
+ocp_list_lstack_no(p):=llstack_no;
+ocp_list_lnext(p):=llnext;
+ocp_listmem_run_ptr:=ocp_listmem_run_ptr+2;
+make_ocp_list_node:=p;
+end;
+
+function make_ocp_lstack_node(locp:internal_ocp_number;
+ llnext:ocp_lstack_index) : ocp_lstack_index;
+var p:ocp_lstack_index;
+begin
+p:=ocp_lstackmem_run_ptr;
+ocp_lstack_ocp(p):=locp;
+ocp_lstack_lnext(p):=llnext;
+incr(ocp_lstackmem_run_ptr);
+make_ocp_lstack_node:=p;
+end;
+
+function copy_ocp_lstack(llstack:ocp_lstack_index):ocp_lstack_index;
+var result:ocp_lstack_index;
+begin
+if is_null_ocp_lstack(llstack) then
+ result:=make_null_ocp_lstack
+else
+ result:=make_ocp_lstack_node(ocp_lstack_ocp(llstack),
+ copy_ocp_lstack(ocp_lstack_lnext(llstack)));
+copy_ocp_lstack:=result;
+end;
+
+function copy_ocp_list(list:ocp_list_index):ocp_list_index;
+var result:ocp_list_index;
+begin
+if is_null_ocp_list(list) then
+ result:=make_null_ocp_list
+else
+ result:=make_ocp_list_node(copy_ocp_lstack(ocp_list_lstack(list)),
+ ocp_list_lstack_no(list),
+ copy_ocp_list(ocp_list_lnext(list)));
+copy_ocp_list:=result;
+end;
+
+function ocp_ensure_lstack(list:ocp_list_index; llstack_no:scaled):
+ ocp_list_index;
+var p:ocp_list_index;
+ q:ocp_list_index;
+begin
+p:=list;
+if is_null_ocp_list(p) then begin
+ ocp_list_lstack_no(p) := llstack_no;
+ ocp_list_lnext(p) := make_null_ocp_list;
+ end
+else if ocp_list_lstack_no(p) > llstack_no then begin
+ ocp_list_lnext(p):=
+ make_ocp_list_node(ocp_list_lstack(p),
+ ocp_list_lstack_no(p),
+ ocp_list_lnext(p));
+ ocp_list_lstack(p):=0;
+ ocp_list_lstack_no(p):=llstack_no;
+ end
+else begin
+ q:=ocp_list_lnext(p);
+ while (not (is_null_ocp_list(q))) and
+ ocp_list_lstack_no(q) <= llstack_no do begin
+ p:=q; q:=ocp_list_lnext(q);
+ end;
+ if ocp_list_lstack_no(p) < llstack_no then begin
+ ocp_list_lnext(p) := make_ocp_list_node(0, llstack_no, q);
+ p := ocp_list_lnext(p);
+ end;
+ end;
+ocp_ensure_lstack := p;
+end;
+
+procedure ocp_apply_add(list_entry:ocp_list_index;
+ lbefore:boolean;
+ locp:internal_ocp_number);
+var p:ocp_lstack_index;
+ q:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if lbefore or (p=0) then begin
+ ocp_list_lstack(list_entry) := make_ocp_lstack_node(locp, p);
+ end
+else begin
+ q:=ocp_lstack_lnext(p);
+ while q<>0 do begin
+ p:=q; q:=ocp_lstack_lnext(q);
+ end;
+ ocp_lstack_lnext(p):=make_ocp_lstack_node(locp, null);
+ end;
+end;
+
+procedure ocp_apply_remove(list_entry:ocp_list_index;
+ lbefore:boolean);
+var p:ocp_lstack_index;
+ q:ocp_lstack_index;
+ r:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if p=0 then begin
+ print_err("warning: stack entry already empty"); print_ln
+ end
+else begin
+ q := ocp_lstack_lnext(p);
+ if lbefore or (q=0) then
+ ocp_list_lstack(list_entry) := q
+ else begin
+ r:=ocp_lstack_lnext(q);
+ while r <> 0 do begin
+ p:=q; q:=r; r:=ocp_lstack_lnext(r);
+ end;
+ ocp_lstack_lnext(p) := null;
+ end
+ end;
+end;
+
+procedure scan_scaled; {sets |cur_val| to a scaled value}
+label done, done1, done2, found, not_found, attach_fraction;
+var negative:boolean; {should the answer be negated?}
+@!f:integer; {numerator of a fraction whose denominator is $2^{16}$}
+@!k,@!kk:small_number; {number of digits in a decimal fraction}
+@!p,@!q:pointer; {top of decimal digit stack}
+begin f:=0; arith_error:=false; negative:=false;
+@<Get the next non-blank non-sign...@>;
+back_input;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if cur_tok<>point_token then scan_int
+else begin radix:=10; cur_val:=0;
+ end;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>;
+if cur_val<0 then {in this case |f=0|}
+ begin negative := not negative; negate(cur_val);
+ end;
+if cur_val>@'40000 then arith_error:=true
+else cur_val := cur_val*unity +f;
+if arith_error or(abs(cur_val)>=@'10000000000) then
+begin print_err("Stack number too large");
+end;
+if negative then negate(cur_val);
+end;
+
+procedure print_ocp_lstack(lstack_entry:ocp_lstack_index);
+var p:ocp_lstack_index;
+begin
+p:=lstack_entry;
+while (p<>0) do begin
+ print_esc(ocp_id_text(ocp_lstack_ocp(p)));
+ p:=ocp_lstack_lnext(p);
+ if (p<>0) then print(",");
+ end;
+end;
+
+procedure print_ocp_list(list_entry:ocp_list_index);
+var p:ocp_list_index;
+begin
+print("["); p:=list_entry;
+while not (is_null_ocp_list(p)) do begin
+ print("(");
+ print_scaled(ocp_list_lstack_no(p));
+ print(" : ");
+ print_ocp_lstack(ocp_list_lstack(p));
+ print(")");
+ p:=ocp_list_lnext(p);
+ if not (is_null_ocp_list(p)) then print(", ");
+ end;
+print("]");
+end;
+
+function scan_ocp_list: ocp_list_index;
+var llstack_no:scaled;
+ lop:quarterword;
+ lstack_entry:ocp_list_index;
+ other_list:ocp_list_index;
+ ocp_ident:internal_ocp_number;
+ result:ocp_list_index;
+begin
+get_r_token;
+if cur_cmd = set_ocp_list then
+ result := copy_ocp_list(ocp_list_list[cur_chr])
+else if cur_cmd <> ocp_list_op then begin
+ print_err("Bad ocp list specification");
+@.Bad ocp list specification@>
+ help1("I was looking for a ocp list specification.");
+ result := make_null_ocp_list;
+ end
+else begin
+ lop:=cur_chr;
+ scan_scaled; llstack_no:=cur_val;
+ if (llstack_no<=0) or (llstack_no>=ocp_maxint) then begin
+ print_err("Stack numbers must be between 0 and 4096 (exclusive)");
+ result := make_null_ocp_list;
+ end
+ else begin
+ if lop <= add_after_op then begin
+ scan_ocp_ident; ocp_ident:=cur_val;
+ end;
+ other_list:=scan_ocp_list;
+ lstack_entry:=ocp_ensure_lstack(other_list, llstack_no);
+ if lop <= add_after_op then
+ ocp_apply_add(lstack_entry, (lop=add_before_op), ocp_ident)
+ else
+ ocp_apply_remove(lstack_entry, (lop=remove_before_op));
+ result:=other_list;
+ end;
+ end;
+scan_ocp_list:=result;
+end;
+
+function read_ocp_list: internal_ocp_list_number;
+var f:internal_ocp_list_number;
+ g:internal_ocp_list_number;
+begin
+g:=null_ocp_list;
+f:=ocp_list_ptr+1;
+ocp_listmem_run_ptr:=ocp_listmem_ptr;
+ocp_lstackmem_run_ptr:=ocp_lstackmem_ptr;
+ocp_list_list[f]:=scan_ocp_list;
+ocp_list_ptr:=f;
+ocp_listmem_ptr:=ocp_listmem_run_ptr;
+ocp_lstackmem_ptr:=ocp_lstackmem_run_ptr;
+g:=f;
+read_ocp_list:=g;
+end;
+
+procedure scan_ocp_list_ident;
+var f:internal_ocp_list_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp_list then f:=cur_chr
+else begin print_err("Missing ocp list identifier");
+@.Missing ocp list identifier@>
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \ocplist.");
+ back_error; f:=null_ocp_list;
+ end;
+cur_val:=f;
+end;
+
+
+@z
+%---------------------------------------
+@x [49] m.1210 l.22629 - Omega OCP
+any_mode(set_interaction):prefixed_command;
+@y
+any_mode(set_interaction),
+any_mode(set_ocp),
+any_mode(def_ocp),
+any_mode(set_ocp_list),
+any_mode(def_ocp_list),
+any_mode(clear_ocp_lists),
+any_mode(push_ocp_list),
+any_mode(pop_ocp_list),
+any_mode(ocp_list_op),
+any_mode(ocp_trace_level) : prefixed_command;
+@z
+%---------------------------------------
+@x [50] m.1302 l.23682 - Omega OCP
+@<Dump the font information@>;
+@y
+@<Dump the font information@>;
+@<Dump the ocp information@>;
+@<Dump the ocp list information@>;
+@z
+%---------------------------------------
+@x [50] m.1303 l.23711 - Omega OCP
+@<Undump the font information@>;
+@y
+@<Undump the font information@>;
+@<Undump the ocp information@>;
+@<Undump the ocp list information@>;
+@z
+%---------------------------------------
+@x [50] m.1323 l.24907 - Omega OCP
+begin undump_font_table(k);@/
+end
+@y
+begin undump_font_table(k);@/
+end
+
+@ @<Dump the ocp information@>=
+dump_int(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+ @<Dump the array info for internal ocp number |k|@>;
+print_ln; print_int(ocp_ptr-ocp_base); print(" preloaded ocp");
+if ocp_ptr<>ocp_base+1 then print_char("s")
+
+@ @<Undump the ocp information@>=
+undump_size(ocp_base)(ocp_biggest)('ocp max')(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+ @<Undump the array info for internal ocp number |k|@>
+
+@ @<Dump the array info for internal ocp number |k|@>=
+begin dump_ocp_table(k);
+print_nl("\ocp"); print_esc(ocp_id_text(k)); print_char("=");
+print_file_name(ocp_name(k),ocp_area(k),"");
+end
+
+@ @<Undump the array info for internal ocp number |k|@>=
+begin undump_ocp_table(k);
+end
+
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
+dump_int(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ dump_int(ocp_list_list[k]);
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
+
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
+undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do
+ undump_int(ocp_list_list[k]);
+undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
+
+@z
+%---------------------------------------
+@x
+@* \[54] $\Omega$ changes.
+
+@y
+@* \[54] $\Omega$ changes.
+
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+
+@ @<Put each...@>=
+primitive("ocp", def_ocp, 0);
+primitive("externalocp", def_ocp, 1);
+primitive("ocplist", def_ocp_list, 0);
+primitive("pushocplist", push_ocp_list, 0);
+primitive("popocplist", pop_ocp_list, 0);
+primitive("clearocplists", clear_ocp_lists, 0);
+primitive("addbeforeocplist", ocp_list_op, add_before_op);
+primitive("addafterocplist", ocp_list_op, add_after_op);
+primitive("removebeforeocplist", ocp_list_op, remove_before_op);
+primitive("removeafterocplist", ocp_list_op, remove_after_op);
+primitive("ocptracelevel", ocp_trace_level, 0);
+set_equiv(ocp_trace_level_base,0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_ocp: begin
+ print("select ocp ");
+ slow_print(ocp_name(chr_code));
+ end;
+def_ocp: if cur_chr=0 then print_esc("ocp")
+ else print_esc("externalocp");
+set_ocp_list: print("select ocp list ");
+def_ocp_list: print_esc("ocplist");
+push_ocp_list: print_esc("pushocplist");
+pop_ocp_list: print_esc("popocplist");
+clear_ocp_lists: print_esc("clearocplists");
+ocp_list_op:
+ if chr_code=add_before_op then print_esc("addbeforeocplist")
+ else if chr_code=add_after_op then print_esc("addafterocplist")
+ else if chr_code=remove_before_op then print_esc("removebeforeocplist")
+ else {|chr_code|=|remove_after_op|} print_esc("removeafterocplist");
+ocp_trace_level: print_esc("ocptracelevel");
+
+@ @<Assignments@>=
+set_ocp: begin
+ print_err("To use ocps, use the "); print_esc("pushocplist");
+ print(" primitive");print_ln
+ end;
+def_ocp: new_ocp(a);
+set_ocp_list: begin
+ print_err("To use ocp lists, use the ");
+ print_esc("pushocplist"); print(" primitive");print_ln
+ end;
+def_ocp_list: new_ocp_list(a);
+push_ocp_list: do_push_ocp_list(a);
+pop_ocp_list: do_pop_ocp_list(a);
+clear_ocp_lists: do_clear_ocp_lists(a);
+ocp_list_op: begin
+ print_err("To build ocp lists, use the ");
+ print_esc("ocplist"); print(" primitive"); print_ln
+ end;
+ocp_trace_level: begin scan_optional_equals; scan_int;
+ if cur_val<>0 then cur_val:=1;
+ define(ocp_trace_level_base, data, cur_val);
+ end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp(@!a:small_number);
+label common_ending;
+var u:pointer; {user's ocp identifier}
+@!f:internal_ocp_number; {runs through existing ocps}
+@!t:str_number; {name for the frozen ocp identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+@!flushable_string:str_number; {string not yet referenced}
+@!external_ocp:boolean; {external binary file}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the ocp name}
+@.texput@>
+if cur_chr=1 then external_ocp:=true
+else external_ocp:=false;
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+else if u>=single_base then
+ if u=null_cs then t:="OCP"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("OCP"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_ocp,null_ocp); scan_optional_equals; scan_file_name;
+@<If this ocp has already been loaded, set |f| to the internal
+ ocp number and |goto common_ending|@>;
+f:=read_ocp_info(u,cur_name,cur_area,cur_ext,external_ocp);
+common_ending:
+set_equiv(u,f); set_new_eqtb(ocp_id_base+f,new_eqtb(u));
+settext(ocp_id_base+f,t);
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl(""); print_esc("ocp"); print_esc(t); print("="); print(cur_name);
+ end;
+end;
+
+@ When the user gives a new identifier to a ocp that was previously loaded,
+the new name becomes the ocp identifier of record. OCP names `\.{xyz}' and
+`\.{XYZ}' are considered to be different.
+
+@<If this ocp has already been loaded...@>=
+flushable_string:=str_ptr-1;
+for f:=ocp_base+1 to ocp_ptr do
+ if str_eq_str(ocp_name(f),cur_name)and str_eq_str(ocp_area(f),cur_area) then
+ begin
+ if cur_name=flushable_string then begin
+ flush_string; cur_name:=ocp_name(f);
+ end;
+ goto common_ending
+ end
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp_list(@!a:small_number);
+var u:pointer; {user's ocp list identifier}
+@!f:internal_ocp_list_number; {runs through existing ocp lists}
+@!t:str_number; {name for the frozen ocp list identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the ocp list name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+else if u>=single_base then
+ if u=null_cs then t:="OCPLIST"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("OCPLIST"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_ocp_list,null_ocp_list); scan_optional_equals;
+f:=read_ocp_list;
+ set_equiv(u,f); set_new_eqtb(ocp_list_id_base+f,new_eqtb(u));
+ settext(ocp_list_id_base+f,t);
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl(""); print_esc("ocplist"); print_esc(t); print("=");
+ print_ocp_list(ocp_list_list[f]);
+ end;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_push_ocp_list(@!a:small_number);
+var ocp_list_no:halfword;
+ old_number:halfword;
+ i:integer;
+begin
+scan_ocp_list_ident; ocp_list_no:=cur_val;
+old_number:=equiv(ocp_active_number_base);
+define(ocp_active_base+old_number, data, ocp_list_no);
+define(ocp_active_number_base, data, (old_number+1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl("New active ocp list: {");
+ for i:=old_number downto 0 do begin
+ print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+ print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+ if i<>0 then print(",");
+ end;
+ print("}");
+ end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_pop_ocp_list(@!a:small_number);
+var old_number:halfword;
+ i:integer;
+begin
+old_number:=equiv(ocp_active_number_base);
+if old_number=0 then begin
+ print_err("No active ocp lists to be popped");
+ end
+else
+ define(ocp_active_number_base, data, (old_number-1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl("New active ocp list: {");
+ for i:=(old_number-2) downto 0 do begin
+ print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+ print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+ if i<>0 then print(",");
+ end;
+ print("}");
+ end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_clear_ocp_lists(@!a:small_number);
+begin
+define(ocp_active_number_base, data, 0);
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir/ompar.ch b/Build/source/texk/web2c/omegadir/ompar.ch
new file mode 100644
index 00000000000..26b421ac2be
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/ompar.ch
@@ -0,0 +1,1629 @@
+% ompar.ch: Local paragraph information
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%-------------------------
+@x [10] m.134
+@d is_char_node(#) == (#>=hi_mem_min)
+ {does the argument point to a |char_node|?}
+@d font == type {the font code in a |char_node|}
+@d character == subtype {the character code in a |char_node|}
+@y
+@d is_char_node(#) == (#>=hi_mem_min)
+ {does the argument point to a |char_node|?}
+@d font==type {the font code in a |char_node|}
+@d character==subtype {the character code in a |char_node|}
+@d file_col(#)==mem[#-1].hh.b1 {the column in which this character appeared}
+@z
+%-------------------------
+@x [10] m.136
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+new_null_box:=p;
+end;
+@y
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+@<LOCAL: Add info node pointer@>;
+new_null_box:=p;
+end;
+@z
+%-------------------------
+@x [10] m.139
+@p function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+new_rule:=p;
+end;
+@y
+@p function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+@<LOCAL: Add info node pointer@>;
+new_rule:=p;
+end;
+@z
+%-------------------------
+@x [10] m.144
+@p function new_ligature(@!f,@!c:quarterword; @!q:pointer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=ligature_node;
+font(lig_char(p)):=f; character(lig_char(p)):=c; lig_ptr(p):=q;
+subtype(p):=0; new_ligature:=p;
+end;
+@#
+function new_lig_item(@!c:quarterword):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); character(p):=c; lig_ptr(p):=null;
+new_lig_item:=p;
+end;
+@y
+@d add_file_col(#)==if state>0 then file_col(#):=loc-start
+ else file_col(#):=stack_col
+
+@p
+function stack_col:integer;
+label done;
+var i:integer;
+ col:integer;
+begin
+col:=0;
+i:=input_ptr;
+while (i>=0) do begin
+ if input_stack[i].state_field>0 then begin
+ col:=input_stack[i].loc_field-input_stack[i].start_field;
+ goto done;
+ end;
+ decr(i);
+ end;
+done: stack_col:=col;
+end;
+
+function new_ligature(@!f,@!c:quarterword; @!q:pointer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=ligature_node;
+font(lig_char(p)):=f; character(lig_char(p)):=c; lig_ptr(p):=q;
+@<LOCAL: Add info node pointer@>;
+add_file_col(p);
+subtype(p):=0; new_ligature:=p;
+end;
+@#
+function new_lig_item(@!c:quarterword):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); character(p):=c; lig_ptr(p):=null;
+@<LOCAL: Add info node pointer@>;
+new_lig_item:=p;
+end;
+@z
+%-------------------------
+@x [10] m.145
+@p function new_disc:pointer; {creates an empty |disc_node|}
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=disc_node;
+replace_count(p):=0; pre_break(p):=null; post_break(p):=null;
+new_disc:=p;
+end;
+@y
+@p function new_disc:pointer; {creates an empty |disc_node|}
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=disc_node;
+replace_count(p):=0; pre_break(p):=null; post_break(p):=null;
+@<LOCAL: Add info node pointer@>;
+new_disc:=p;
+end;
+@z
+%-------------------------
+@x [10] m.147
+@p function new_math(@!w:scaled;@!s:small_number):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=math_node;
+subtype(p):=s; width(p):=w; new_math:=p;
+end;
+@y
+@p function new_math(@!w:scaled;@!s:small_number):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=math_node;
+@<LOCAL: Add info node pointer@>;
+subtype(p):=s; width(p):=w; new_math:=p;
+end;
+@z
+%-------------------------
+@x [10] m.151
+@p function new_spec(@!p:pointer):pointer; {duplicates a glue specification}
+var q:pointer; {the new spec}
+begin q:=get_node(glue_spec_size);@/
+mem[q]:=mem[p]; glue_ref_count(q):=null;@/
+width(q):=width(p); stretch(q):=stretch(p); shrink(q):=shrink(p);
+new_spec:=q;
+end;
+@y
+@p function new_spec(@!p:pointer):pointer; {duplicates a glue specification}
+var q:pointer; {the new spec}
+begin q:=get_node(glue_spec_size);@/
+mem[q]:=mem[p]; glue_ref_count(q):=null;@/
+width(q):=width(p); stretch(q):=stretch(p); shrink(q):=shrink(p);
+new_spec:=q;
+end;
+@z
+%-------------------------
+@x [10] m.152
+@p function new_param_glue(@!n:small_number):pointer;
+var p:pointer; {the new node}
+@!q:pointer; {the glue specification}
+begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=n+1;
+leader_ptr(p):=null;@/
+q:=@<Current |mem| equivalent of glue parameter number |n|@>@t@>;
+glue_ptr(p):=q; incr(glue_ref_count(q));
+new_param_glue:=p;
+end;
+@y
+@p function new_param_glue(@!n:small_number):pointer;
+var p:pointer; {the new node}
+@!q:pointer; {the glue specification}
+begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=n+1;
+leader_ptr(p):=null;@/
+q:=@<Current |mem| equivalent of glue parameter number |n|@>@t@>;
+glue_ptr(p):=q; incr(glue_ref_count(q));
+@<LOCAL: Add info node pointer@>;
+new_param_glue:=p;
+end;
+@z
+%-------------------------
+@x [10] m.153
+@p function new_glue(@!q:pointer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=normal;
+leader_ptr(p):=null; glue_ptr(p):=q; incr(glue_ref_count(q));
+new_glue:=p;
+end;
+@y
+@p function new_glue(@!q:pointer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=normal;
+leader_ptr(p):=null; glue_ptr(p):=q; incr(glue_ref_count(q));
+@<LOCAL: Add info node pointer@>;
+new_glue:=p;
+end;
+@z
+%-------------------------
+@x [10] m.154
+@p function new_skip_param(@!n:small_number):pointer;
+var p:pointer; {the new node}
+begin temp_ptr:=new_spec(@<Current |mem| equivalent of glue parameter...@>);
+p:=new_glue(temp_ptr); glue_ref_count(temp_ptr):=null; subtype(p):=n+1;
+new_skip_param:=p;
+end;
+@y
+@p function new_skip_param(@!n:small_number):pointer;
+var p:pointer; {the new node}
+begin temp_ptr:=new_spec(@<Current |mem| equivalent of glue parameter...@>);
+p:=new_glue(temp_ptr); glue_ref_count(temp_ptr):=null; subtype(p):=n+1;
+@<LOCAL: Add info node pointer@>;
+new_skip_param:=p;
+end;
+@z
+%-------------------------
+@x [10] m.156
+@p function new_kern(@!w:scaled):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=kern_node;
+subtype(p):=normal;
+width(p):=w;
+new_kern:=p;
+end;
+@y
+@p function new_kern(@!w:scaled):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=kern_node;
+subtype(p):=normal;
+width(p):=w;
+@<LOCAL: Add info node pointer@>;
+new_kern:=p;
+end;
+@z
+%-------------------------
+@x [10] m.158
+@p function new_penalty(@!m:integer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=penalty_node;
+subtype(p):=0; {the |subtype| is not used}
+penalty(p):=m; new_penalty:=p;
+end;
+@y
+@p function new_penalty(@!m:integer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=penalty_node;
+subtype(p):=0; {the |subtype| is not used}
+@<LOCAL: Add info node pointer@>;
+penalty(p):=m; new_penalty:=p;
+end;
+@z
+%-------------------------
+@x [10] m.160 l.3270
+@ In fact, there are still more types coming. When we get to math formula
+processing we will see that a |style_node| has |type=14|; and a number
+of larger type codes will also be defined, for use in math mode only.
+@y
+@ In fact, there are still more types coming. When we get to math formula
+processing we will see that a |style_node| has |type=14|; and a number
+of larger type codes will also be defined, for use in math mode only.
+
+@d file_node=unset_node+1 {|type| to hold file names and line numbers}
+
+@d file_size=3
+@d file_no(#) == info(#+1) {number of open files}
+@d file_ref_count(#) == link(#+1) {reference count to this node}
+
+@d file_incr_ref_count(#)==begin
+ if (#)<>null then incr(file_ref_count(#));
+ end
+@d file_decr_ref_count(#)==begin
+ if (#)<>null then begin
+ decr(file_ref_count(#));
+ if file_ref_count(#) = 0 then begin
+ free_node(#,file_size+2*file_no(#));
+ end;
+ end;
+ end
+
+@d info_node=unset_node+2 {|type| to hold local information}
+
+@d ptr_info(#) == link(#-1) {pointer to the local info node}
+
+@d info_size=5
+@d info_ref_count(#) == link(#+1) {reference count to this node}
+@d info_pen_inter(#) == info(#+2) {\.{\\localinterlinepenalty}}
+@d info_pen_broken(#) == link(#+2) {\.{\\localbrokenpenalty}}
+@d info_left_box(#) == info(#+3) {\.{\\localleftbox}}
+@d info_right_box(#) == link(#+3) {\.{\\localrightbox}}
+@d info_file(#) == info(#+4) {file names and line numbers}
+
+@d info_incr_ref_count(#)==begin
+ if (#)<>null then incr(info_ref_count(#));
+ end
+@d info_decr_ref_count(#)==begin
+ if (#)<>null then begin
+ decr(info_ref_count(#));
+ if info_ref_count(#) = 0 then begin
+ if info_left_box(#)<>null then
+ flush_node_list(info_left_box(#));
+ if info_right_box(#)<>null then
+ flush_node_list(info_right_box(#));
+ if info_file(#)<>null then
+ file_decr_ref_count(info_file(#));
+ free_node(#,info_size);
+ #:=null;
+ end;
+ end;
+ end
+
+@d biggest_ordinary_node=info_node
+
+@z
+%-------------------------
+@x [10] m.162
+@d zero_glue==mem_bot {specification for \.{0pt plus 0pt minus 0pt}}
+@d sfi_glue==zero_glue+glue_spec_size {\.{0pt plus 1fi minus 0pt}}
+@d fil_glue==sfi_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
+@d fill_glue==fil_glue+glue_spec_size {\.{0pt plus 1fill minus 0pt}}
+@d ss_glue==fill_glue+glue_spec_size {\.{0pt plus 1fil minus 1fil}}
+@d fil_neg_glue==ss_glue+glue_spec_size {\.{0pt plus -1fil minus 0pt}}
+@d lo_mem_stat_max==fil_neg_glue+glue_spec_size-1 {largest statically
+ allocated word in the variable-size |mem|}
+@#
+@d page_ins_head==mem_top {list of insertion data for current page}
+@d contrib_head==mem_top-1 {vlist of items not yet on current page}
+@d page_head==mem_top-2 {vlist for current page}
+@d temp_head==mem_top-3 {head of a temporary list of some kind}
+@d hold_head==mem_top-4 {head of a temporary list of another kind}
+@d adjust_head==mem_top-5 {head of adjustment list returned by |hpack|}
+@d active==mem_top-7 {head of active list in |line_break|, needs two words}
+@d align_head==mem_top-8 {head of preamble list for alignments}
+@d end_span==mem_top-9 {tail of spanned-width lists}
+@d omit_template==mem_top-10 {a constant token list}
+@d null_list==mem_top-11 {permanently empty list}
+@d lig_trick==mem_top-12 {a ligature masquerading as a |char_node|}
+@d garbage==mem_top-12 {used for scrap information}
+@d backup_head==mem_top-13 {head of token list built by |scan_keyword|}
+@d hi_mem_stat_min==mem_top-13 {smallest statically allocated word in
+ the one-word |mem|}
+@d hi_mem_stat_usage=14 {the number of one-word nodes always present}
+@y
+@d zero_glue==mem_bot+1 {specification for \.{0pt plus 0pt minus 0pt}}
+@d sfi_glue==zero_glue+glue_spec_size+1 {\.{0pt plus 1fi minus 0pt}}
+@d fil_glue==sfi_glue+glue_spec_size+1 {\.{0pt plus 1fil minus 0pt}}
+@d fill_glue==fil_glue+glue_spec_size+1 {\.{0pt plus 1fill minus 0pt}}
+@d ss_glue==fill_glue+glue_spec_size+1 {\.{0pt plus 1fil minus 1fil}}
+@d fil_neg_glue==ss_glue+glue_spec_size+1 {\.{0pt plus -1fil minus 0pt}}
+@d lo_mem_stat_max==fil_neg_glue+glue_spec_size+1 {largest statically
+ allocated word in the variable-size |mem|}
+@#
+@d page_ins_head==mem_top {list of insertion data for current page}
+@d contrib_head==mem_top-2 {vlist of items not yet on current page}
+@d page_head==mem_top-4 {vlist for current page}
+@d temp_head==mem_top-6 {head of a temporary list of some kind}
+@d hold_head==mem_top-8 {head of a temporary list of another kind}
+@d adjust_head==mem_top-10 {head of adjustment list returned by |hpack|}
+@d active==mem_top-14 {head of active list in |line_break|, needs two words}
+@d align_head==mem_top-16 {head of preamble list for alignments}
+@d end_span==mem_top-18 {tail of spanned-width lists}
+@d omit_template==mem_top-20 {a constant token list}
+@d null_list==mem_top-22 {permanently empty list}
+@d lig_trick==mem_top-24 {a ligature masquerading as a |char_node|}
+@d garbage==mem_top-24 {used for scrap information}
+@d backup_head==mem_top-26 {head of token list built by |scan_keyword|}
+@d hi_mem_stat_min==mem_top-28 {smallest statically allocated word in
+ the one-word |mem|}
+@d hi_mem_stat_usage=14 {the number of one-word nodes always present}
+@z
+%-------------------------
+@x [13] m.202
+@p procedure flush_node_list(@!p:pointer); {erase list of nodes starting at |p|}
+label done; {go here when node |p| has been freed}
+var q:pointer; {successor to node |p|}
+begin while p<>null do
+@^inner loop@>
+ begin q:=link(p);
+@y
+@p procedure flush_node_list(@!p:pointer); {erase list of nodes starting at |p|}
+label done; {go here when node |p| has been freed}
+var q:pointer; {successor to node |p|}
+begin while p<>null do
+@^inner loop@>
+ begin q:=link(p); @<LOCAL: Remove info node pointer@>;
+@z
+%-------------------------
+@x [13] m.202
+ othercases confusion("flushing")
+@:this can't happen flushing}{\quad flushing@>
+ endcases;@/
+@y
+ info_node: begin
+ @<LOCAL: Delete info node@>;
+ goto done; end; {do not delete node at this time}
+ othercases confusion("flushing")
+@:this can't happen flushing}{\quad flushing@>
+ endcases;@/
+@z
+%-------------------------
+@x [15] m.205
+@ @<Make a copy of node |p|...@>=
+words:=1; {this setting occurs in more branches than any other}
+if is_char_node(p) then r:=get_avail
+else @<Case statement to copy different types and set |words| to the number
+ of initial words not yet copied@>;
+while words>0 do
+ begin decr(words); mem[r+words]:=mem[p+words];
+ end
+@y
+@ @<Make a copy of node |p|...@>=
+words:=1; {this setting occurs in more branches than any other}
+if is_char_node(p) then r:=get_avail
+else @<Case statement to copy different types and set |words| to the number
+ of initial words not yet copied@>;
+@<LOCAL: Copy info node pointer@>;
+file_col(r):=file_col(p);
+while words>0 do
+ begin decr(words); mem[r+words]:=mem[p+words];
+ end
+@z
+%-------------------------
+@x [15] m.208 l.4170
+@d min_internal=char_ghost+1 {the smallest code that can follow \.{\\the}}
+@y
+@d assign_local_box=char_ghost+1
+ {box for guillemets \.{\\localleftbox} or \.{\\localrightbox}}
+@d min_internal=assign_local_box+1 {the smallest code that can follow \.{\\the}}
+@z
+%-------------------------
+@x [17] m.230 l.4860
+@d box_base=toks_base+number_regs {table of |number_regs| box registers}
+@y
+@d local_left_box_base=toks_base+number_regs
+@d local_right_box_base=local_left_box_base+1
+@d local_par_info_base=local_right_box_base+1
+@d box_base=local_par_info_base+1 {table of |number_regs| box registers}
+@z
+%-------------------------
+@x [17] m.230 l.4888
+@d box(#)==equiv(box_base+#)
+@y
+@d local_left_box==equiv(local_left_box_base)
+@d local_right_box==equiv(local_right_box_base)
+@d local_par_info==equiv(local_par_info_base)
+@d box(#)==equiv(box_base+#)
+@z
+%-------------------------
+@x [17] m.236 l.4954
+@d int_pars=55 {total number of integer parameters}
+@y
+@d local_inter_line_penalty_code=55 {local \.{\\interlinepenalty}}
+@d local_broken_penalty_code=56 {local \.{\\brokenpenalty}}
+@d char_specials_code=57
+ {number of characters between column marker specials in dvi file}
+@d int_pars=58 {total number of integer parameters}
+@z
+%-------------------------
+@x [17] m.236 l.5011
+@d new_line_char==int_par(new_line_char_code)
+@y
+@d new_line_char==int_par(new_line_char_code)
+@d local_inter_line_penalty==int_par(local_inter_line_penalty_code)
+@d local_broken_penalty==int_par(local_broken_penalty_code)
+@d char_specials==int_par(char_specials_code)
+@z
+%-------------------------
+@x [19] m.269 l.5860
+@d max_group_code=16
+@y
+@d local_box_group=17 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=17
+@z
+%-------------------------
+@x [22] m.304
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+@y
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+@!line_numbers : array[1..max_in_open] of integer;
+@!file_names : array[1..max_in_open] of integer;
+@!no_of_files : integer; {number of currently open files}
+
+@ @<Set init...@>=
+no_of_files:=0;
+@z
+%-------------------------
+@x [23] m.327
+@p procedure begin_file_reading;
+begin if in_open=max_in_open then overflow("text input levels",max_in_open);
+@:TeX capacity exceeded text input levels}{\quad text input levels@>
+if first=buf_size then overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+incr(in_open); push_input; index:=in_open;
+line_stack[index]:=line; start:=first; state:=mid_line;
+name:=0; {|terminal_input| is now |true|}
+end;
+@y
+@p procedure begin_file_reading;
+begin if in_open=max_in_open then overflow("text input levels",max_in_open);
+@:TeX capacity exceeded text input levels}{\quad text input levels@>
+if first=buf_size then overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+incr(in_open); push_input; index:=in_open;
+line_stack[index]:=line; start:=first; state:=mid_line;
+name:=0; {|terminal_input| is now |true|}
+@<LOCAL: Change file node@>;
+end;
+@z
+%-------------------------
+@x [24] m.362
+@ @<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>=
+begin incr(line); first:=start;
+if not force_eof then
+ begin if input_ln(cur_file,true) then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else force_eof:=true;
+ end;
+if force_eof then
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ force_eof:=false;
+ end_file_reading; {resume previous level}
+ check_outer_validity; goto restart;
+ end;
+if end_line_char_inactive then decr(limit)
+else buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start; {ready to read}
+end
+@y
+@ @<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>=
+begin incr(line); first:=start;
+if not force_eof then
+ begin if input_ln(cur_file,true) then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else force_eof:=true;
+ end;
+if force_eof then
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ force_eof:=false;
+ end_file_reading; {resume previous level}
+ check_outer_validity;
+ if no_of_files>0 then decr(no_of_files);
+ @<LOCAL: Change file node@>;
+ goto restart;
+ end;
+if end_line_char_inactive then decr(limit)
+else buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start; {ready to read}
+line_numbers[no_of_files]:=line;
+@<LOCAL: Change file node@>;
+end
+@z
+%-------------------------
+@x [29] m.537
+done: name:=a_make_name_string(cur_file);
+if job_name=0 then
+ begin job_name:=cur_name; open_log_file;
+ end; {|open_log_file| doesn't |show_context|, so |limit|
+ and |loc| needn't be set to meaningful values yet}
+if term_offset+length(name)>max_print_line-2 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("("); incr(open_parens); slow_print(name); update_terminal;
+state:=new_line;
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string; name:=cur_name;
+ end;
+@<Read the first line of the new file@>;
+@y
+done: name:=a_make_name_string(cur_file);
+if job_name=0 then
+ begin job_name:=cur_name; open_log_file;
+ end; {|open_log_file| doesn't |show_context|, so |limit|
+ and |loc| needn't be set to meaningful values yet}
+if term_offset+length(name)>max_print_line-2 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("("); incr(open_parens); slow_print(name); update_terminal;
+state:=new_line;
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string; name:=cur_name;
+ end;
+incr(no_of_files);
+file_names[no_of_files]:=name; {keep track of file names for output specials}
+line_numbers[no_of_files]:=0; {keep track of file names for output specials}
+@<Read the first line of the new file@>;
+@z
+%-------------------------
+@x [29] m.538
+@<Read the first line...@>=
+begin line:=1;
+if input_ln(cur_file,false) then do_nothing;
+firm_up_the_line;
+if end_line_char_inactive then decr(limit)
+else buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start;
+end
+@y
+@<Read the first line...@>=
+begin line:=1;
+if input_ln(cur_file,false) then do_nothing;
+firm_up_the_line;
+if end_line_char_inactive then decr(limit)
+else buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start;
+line_numbers[no_of_files]:=1; {keep track of file names for output specials}
+@<LOCAL: Change file node@>;
+end
+@z
+%-------------------------
+@x [30] m.582
+@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
+label exit;
+var p:pointer; {newly allocated node}
+begin if font_bc(f)<=c then if font_ec(f)>=c then
+ if char_exists(char_info(f)(qi(c))) then
+ begin p:=get_avail; font(p):=f; character(p):=qi(c);
+ new_character:=p; return;
+ end;
+char_warning(f,c);
+new_character:=null;
+exit:end;
+@y
+@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
+label exit;
+var p:pointer; {newly allocated node}
+begin if font_bc(f)<=c then if font_ec(f)>=c then
+ if char_exists(char_info(f)(qi(c))) then
+ begin p:=get_avail; font(p):=f; character(p):=qi(c);
+ ptr_info(p):=local_par_info; info_incr_ref_count(local_par_info);
+ new_character:=p; return;
+ end;
+char_warning(f,c);
+new_character:=null;
+exit:end;
+@z
+%-------------------------
+@x [32] m.617
+@ @<Initialize variables as |ship_out| begins@>=
+dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
+ensure_dvi_open;
+if total_pages=0 then
+ begin dvi_out(pre); dvi_out(id_byte); {output the preamble}
+@^preamble of \.{DVI} file@>
+@y
+@ @<Initialize variables as |ship_out| begins@>=
+dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
+ensure_dvi_open;
+if total_pages=0 then
+ begin dvi_out(pre); dvi_out(id_byte); {output the preamble}
+@^preamble of \.{DVI} file@>
+ ptr_info(lig_trick):=null;
+@z
+%-------------------------
+@x [32] m.619
+@!p:pointer; {current position in the hlist}
+@y
+@!p:pointer; {current position in the hlist}
+@!fff:pointer; {current file position}
+@!ffi:integer; {for iterations}
+@!g:integer; {new string}
+@!newk:integer;
+@!should_create_special:boolean;
+@!chars_since_last_special:integer;
+@z
+%-------------------------
+@x [32] m.619
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+@y
+if char_specials>0 then begin
+ should_create_special:=true;
+ chars_since_last_special:=char_specials;
+ end
+else begin
+ should_create_special:=false;
+ chars_since_last_special:=-1000000;
+ end;
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+@z
+%-------------------------
+@x [32] m.620
+@<Output node |p| for |hlist_out|...@>=
+reswitch: if is_char_node(p) then
+ begin synch_h; synch_v;
+ repeat f:=font(p); c:=character(p);
+@y
+@<Output node |p| for |hlist_out|...@>=
+reswitch: if is_char_node(p) then
+ begin synch_h; synch_v;
+ if should_create_special then begin
+ should_create_special:=false;
+ if chars_since_last_special>=char_specials then
+ if ptr_info(p)<>null then
+ if info_file(ptr_info(p))<>null then begin
+ @<LOCAL: Create special node@>;
+ chars_since_last_special:=0;
+ end;
+ end;
+ repeat f:=font(p); c:=character(p);
+ incr(chars_since_last_special);
+@z
+%-------------------------
+@x [32] m.622
+move_past: cur_h:=cur_h+rule_wd;
+next_p:p:=link(p);
+end
+@y
+move_past: cur_h:=cur_h+rule_wd;
+next_p:
+if type(p)<>kern_node then should_create_special:=true;
+p:=link(p);
+end
+@z
+%-------------------------
+@x [33] m.645
+@p procedure scan_spec(@!c:group_code;@!three_codes:boolean);
+@y
+@p
+@<LOCAL: Declare |make_info_node|@>;
+procedure scan_spec(@!c:group_code;@!three_codes:boolean);
+@z
+%-------------------------
+@x [34] m.652
+@ @<Make node |p| look like a |char_node| and |goto reswitch|@>=
+begin mem[lig_trick]:=mem[lig_char(p)]; link(lig_trick):=link(p);
+p:=lig_trick; goto reswitch;
+end
+@y
+@ @<Make node |p| look like a |char_node| and |goto reswitch|@>=
+begin
+info_decr_ref_count(ptr_info(lig_trick));
+mem[lig_trick]:=mem[lig_char(p)];
+ptr_info(lig_trick):=ptr_info(p);
+info_incr_ref_count(ptr_info(p));
+file_col(lig_trick):=file_col(p);
+link(lig_trick):=link(p);
+p:=lig_trick; goto reswitch;
+end
+@z
+%-------------------------
+@x [34] m.682 l.13395 - Omega
+@d ord_noad=unset_node+3 {|type| of a noad classified Ord}
+@y
+@d ord_noad=biggest_ordinary_node+3 {|type| of a noad classified Ord}
+@z
+%-------------------------
+@x [34] m.686
+@p function new_noad:pointer;
+var p:pointer;
+begin p:=get_node(noad_size);
+type(p):=ord_noad; subtype(p):=normal;
+mem[nucleus(p)].hh:=empty_field;
+mem[subscr(p)].hh:=empty_field;
+mem[supscr(p)].hh:=empty_field;
+new_noad:=p;
+end;
+@y
+@p function new_noad:pointer;
+var p:pointer;
+begin p:=get_node(noad_size);
+type(p):=ord_noad; subtype(p):=normal;
+mem[nucleus(p)].hh:=empty_field;
+mem[subscr(p)].hh:=empty_field;
+mem[supscr(p)].hh:=empty_field;
+@<LOCAL: Add info node pointer@>;
+add_file_col(p);
+new_noad:=p;
+end;
+@z
+%---------------------------------------
+@x [34] m.688
+@d style_node=unset_node+1 {|type| of a style node}
+@y
+@d style_node=biggest_ordinary_node+1 {|type| of a style node}
+@z
+%---------------------------------------
+@x [34] m.688
+@p function new_style(@!s:small_number):pointer; {create a style node}
+var p:pointer; {the new node}
+begin p:=get_node(style_node_size); type(p):=style_node;
+subtype(p):=s; width(p):=0; depth(p):=0; {the |width| and |depth| are not used}
+new_style:=p;
+end;
+@y
+@p function new_style(@!s:small_number):pointer; {create a style node}
+var p:pointer; {the new node}
+begin p:=get_node(style_node_size); type(p):=style_node;
+subtype(p):=s; width(p):=0; depth(p):=0; {the |width| and |depth| are not used}
+@<LOCAL: Add info node pointer@>;
+add_file_col(p);
+new_style:=p;
+end;
+@z
+%---------------------------------------
+@x [34] m.689
+@d choice_node=unset_node+2 {|type| of a choice node}
+@y
+@d choice_node=biggest_ordinary_node+2 {|type| of a choice node}
+@z
+%---------------------------------------
+@x [34] m.689
+@p function new_choice:pointer; {create a choice node}
+var p:pointer; {the new node}
+begin p:=get_node(style_node_size); type(p):=choice_node;
+subtype(p):=0; {the |subtype| is not used}
+display_mlist(p):=null; text_mlist(p):=null; script_mlist(p):=null;
+script_script_mlist(p):=null;
+new_choice:=p;
+end;
+@y
+@p function new_choice:pointer; {create a choice node}
+var p:pointer; {the new node}
+begin p:=get_node(style_node_size); type(p):=choice_node;
+subtype(p):=0; {the |subtype| is not used}
+display_mlist(p):=null; text_mlist(p):=null; script_mlist(p):=null;
+script_script_mlist(p):=null;
+@<LOCAL: Add info node pointer@>;
+add_file_col(p);
+new_choice:=p;
+end;
+@z
+%---------------------------------------
+@x [36] m.755
+@ @<Create a character node |p| for |nucleus(q)|...@>=
+begin fetch(nucleus(q));
+if char_exists(cur_i) then
+ begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c));
+ if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then
+ delta:=0; {no italic correction in mid-word of text font}
+ if (math_type(subscr(q))=empty)and(delta<>0) then
+ begin link(p):=new_kern(delta); delta:=0;
+ end;
+ end
+else p:=null;
+end
+@y
+@ @<Create a character node |p| for |nucleus(q)|...@>=
+begin fetch(nucleus(q));
+if char_exists(cur_i) then
+ begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c));
+ info_decr_ref_count(ptr_info(p));
+ ptr_info(p):=ptr_info(q);
+ info_incr_ref_count(ptr_info(q));
+ file_col(p):=file_col(q);
+ if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then
+ delta:=0; {no italic correction in mid-word of text font}
+ if (math_type(subscr(q))=empty)and(delta<>0) then
+ begin link(p):=new_kern(delta); delta:=0;
+ end;
+ end
+else p:=null;
+end
+@z
+%---------------------------------------
+@x [38] m.814 l.15994
+@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
+@y
+@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
+@!init_local_par_info:pointer;
+@!last_local_par_info:pointer;
+@!current_file_node:pointer;
+
+@ @<Set initial...@>=
+init_local_par_info:=null;
+last_local_par_info:=null;
+current_file_node:=null;
+
+@z
+%-------------------------
+@x [38] m.821 l.16110
+@ The passive node for a given breakpoint contains only four fields:
+
+\yskip\hang|link| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+\yskip\hang|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+\yskip\hang|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+\yskip\hang|serial| is equal to |n| if this passive node is the |n|th
+one created during the current pass. (This field is used only when
+printing out detailed statistics about the line-breaking calculations.)
+
+\yskip\noindent
+There is a global variable called |passive| that points to the most
+recently created passive node. Another global variable, |printed_node|,
+is used to help print out the paragraph when detailed information about
+the line-breaking computation is being displayed.
+
+@d passive_node_size=2 {number of words in passive nodes}
+@d cur_break==rlink {in passive node, points to position of this breakpoint}
+@d prev_break==llink {points to passive node that should precede this one}
+@d serial==info {serial number for symbolic identification}
+@y
+@ The passive node for a given breakpoint contains EIGHT fields:
+
+\yskip\hang|link| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+\yskip\hang|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+\yskip\hang|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+\yskip\hang|serial| is equal to |n| if this passive node is the |n|th
+one created during the current pass. (This field is used only when
+printing out detailed statistics about the line-breaking calculations.)
+
+\yskip\hang|passive_pen_inter| holds the current \.{\\localinterlinepenalty}
+
+\yskip\hang|passive_pen_broken| holds the current \.{\\localbrokenpenalty}
+
+\yskip\noindent
+There is a global variable called |passive| that points to the most
+recently created passive node. Another global variable, |printed_node|,
+is used to help print out the paragraph when detailed information about
+the line-breaking computation is being displayed.
+
+@d passive_node_size=4 {number of words in passive nodes}
+@d cur_break==rlink {in passive node, points to position of this breakpoint}
+@d prev_break==llink {points to passive node that should precede this one}
+@d serial==info {serial number for symbolic identification}
+@d passive_local(#)==mem[#+2].int
+@d passive_prev_local(#)==mem[#+3].int
+@z
+%-------------------------
+@x [38] m.844 l.16595
+@<Insert a new active node from |best_place[fit_class]| to |cur_p|@>=
+begin q:=get_node(passive_node_size);
+link(q):=passive; passive:=q; cur_break(q):=cur_p;
+@!stat incr(pass_number); serial(q):=pass_number;@+tats@;@/
+prev_break(q):=best_place[fit_class];@/
+@y
+@<Insert a new active node from |best_place[fit_class]| to |cur_p|@>=
+begin q:=get_node(passive_node_size);
+link(q):=passive; passive:=q; cur_break(q):=cur_p;
+@!stat incr(pass_number); serial(q):=pass_number;@+tats@;@/
+prev_break(q):=best_place[fit_class];@/
+{Here we keep track of the subparagraph penalties in the break nodes}
+passive_local(q):=last_local_par_info;
+info_incr_ref_count(last_local_par_info);
+if prev_break(q)=null then
+ passive_prev_local(q):=init_local_par_info
+else
+ passive_prev_local(q):=passive_local(prev_break(q));
+info_incr_ref_count(passive_prev_local(q));
+@z
+%-------------------------
+@x [38] m.851 l.16706
+@<Consider the demerits for a line from |r| to |cur_p|...@>=
+begin artificial_demerits:=false;@/
+@^inner loop@>
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+@y
+@<Consider the demerits for a line from |r| to |cur_p|...@>=
+begin artificial_demerits:=false;@/
+@^inner loop@>
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+if break_node(r)=null then begin
+ if init_local_par_info<>null then
+ if info_left_box(init_local_par_info)<>null then
+ shortfall:=shortfall-width(info_left_box(init_local_par_info));
+ end
+else if passive_local(break_node(r))<>null then
+ if info_left_box(passive_local(break_node(r)))<>null then
+ shortfall:=shortfall-width(info_left_box(passive_local(break_node(r))));
+if last_local_par_info<>null then
+ if info_right_box(last_local_par_info)<>null then
+ shortfall:=shortfall-width(info_right_box(last_local_par_info));
+@z
+%-------------------------
+@x [39] m.863 l.16932
+loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
+ if second_pass then @<Initialize for hyphenating a paragraph@>;
+ @<Create an active breakpoint representing the beginning of the paragraph@>;
+ cur_p:=link(temp_head); auto_breaking:=true;@/
+ prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
+@y
+loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
+ if second_pass then @<Initialize for hyphenating a paragraph@>;
+ @<Create an active breakpoint representing the beginning of the paragraph@>;
+ cur_p:=link(temp_head); auto_breaking:=true;@/
+ prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
+ @<LOCAL: Initialize local paragraph information@>;
+@z
+%-------------------------
+@x [39] m.865
+@ @<Clean...@>=
+q:=link(active);
+while q<>last_active do
+ begin cur_p:=link(q);
+ if type(q)=delta_node then free_node(q,delta_node_size)
+ else free_node(q,active_node_size);
+ q:=cur_p;
+ end;
+q:=passive;
+while q<>null do
+ begin cur_p:=link(q);
+ free_node(q,passive_node_size);
+ q:=cur_p;
+ end
+@y
+@ @<Clean...@>=
+q:=link(active);
+while q<>last_active do
+ begin cur_p:=link(q);
+ if type(q)=delta_node then free_node(q,delta_node_size)
+ else free_node(q,active_node_size);
+ q:=cur_p;
+ end;
+q:=passive;
+while q<>null do
+ begin cur_p:=link(q);
+ info_decr_ref_count(passive_local(q));
+ info_decr_ref_count(passive_prev_local(q));
+ free_node(q,passive_node_size);
+ q:=cur_p;
+ end
+@z
+%-------------------------
+@x [39] m.866
+@<Call |try_break| if |cur_p| is a legal breakpoint...@>=
+begin if is_char_node(cur_p) then
+ @<Advance \(c)|cur_p| to the node following the present
+ string of characters@>;
+@y
+@<Call |try_break| if |cur_p| is a legal breakpoint...@>=
+begin
+@<LOCAL: Update local paragraph information@>;
+if is_char_node(cur_p) then
+ @<Advance \(c)|cur_p| to the node following the present
+ string of characters@>;
+@<LOCAL: Update local paragraph information@>;
+@z
+%-------------------------
+@x [39] m.881 l.17289
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+if q<>null then {|q| cannot be a |char_node|}
+ if type(q)=glue_node then
+ begin delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+@y
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+if q<>null then {|q| cannot be a |char_node|}
+ if type(q)=glue_node then begin
+ if passive_local(cur_p)<>null then
+ if info_right_box(passive_local(cur_p))<>null then begin
+ r:=temp_head;
+ while link(r)<>q do r:=link(r);
+ s:=copy_node_list(info_right_box(passive_local(cur_p)));
+ link(r):=s;
+ link(s):=q;
+ end;
+ delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+if passive_local(cur_p)<>null then
+ if info_right_box(passive_local(cur_p))<>null then begin
+ r:=copy_node_list(info_right_box(passive_local(cur_p)));
+ link(r):=link(q);
+ link(q):=r;
+ q:=r;
+ end;
+@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+@z
+%-------------------------
+@x [39] m.887 l.17352
+@<Put the \(l)\.{\\leftskip} glue at the left...@>=
+r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
+if left_skip<>zero_glue then
+ begin r:=new_param_glue(left_skip_code);
+ link(r):=q; q:=r;
+ end
+@y
+@<Put the \(l)\.{\\leftskip} glue at the left...@>=
+r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
+if passive_prev_local(cur_p)<>null then
+ if info_left_box(passive_prev_local(cur_p))<>null then begin
+ r:=copy_node_list(info_left_box(passive_prev_local(cur_p)));
+ s:=link(q);
+ link(r):=q;
+ q:=r;
+ {adjustment for the indent node}
+ if (cur_line=prev_graf+1) and (s<>null) then
+ if type(s)=hlist_node then
+ if list_ptr(s)=null then begin
+ q:=link(q);
+ link(r):=link(s);
+ link(s):=r;
+ end;
+ end;
+if left_skip<>zero_glue then
+ begin r:=new_param_glue(left_skip_code);
+ link(r):=q; q:=r;
+ end
+@z
+%-------------------------
+@x [39] m.890 l.17391
+@<Append a penalty node, if a nonzero penalty is appropriate@>=
+if cur_line+1<>best_line then
+ begin pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+ if disc_break then pen:=pen+broken_penalty;
+@y
+@<Append a penalty node, if a nonzero penalty is appropriate@>=
+if cur_line+1<>best_line then begin
+ if passive_local(cur_p)<>null then begin
+ if info_pen_inter(passive_local(cur_p))<>0 then
+ pen:=info_pen_inter(passive_local(cur_p))
+ else pen:=inter_line_penalty;
+ end
+ else pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+ if disc_break then
+ if passive_local(cur_p)<>null then begin
+ if info_pen_broken(passive_local(cur_p))<>0 then
+ pen:=pen+info_pen_broken(passive_local(cur_p))
+ else pen:=pen+broken_penalty;
+ end
+ else pen:=pen+broken_penalty;
+@z
+%-------------------------
+@x [46] m.1034
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+character(lig_stack):=cur_l;@/
+@y
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+ptr_info(lig_stack):=local_par_info; info_incr_ref_count(local_par_info);
+add_file_col(lig_stack);
+character(lig_stack):=cur_l;@/
+@z
+%-------------------------
+@x [46] m.1038
+fast_get_avail(lig_stack); font(lig_stack):=main_f;
+cur_r:=qi(cur_chr); character(lig_stack):=cur_r;
+@y
+fast_get_avail(lig_stack); font(lig_stack):=main_f;
+ptr_info(lig_stack):=local_par_info; info_incr_ref_count(local_par_info);
+add_file_col(lig_stack);
+cur_r:=qi(cur_chr); character(lig_stack):=cur_r;
+@z
+%-------------------------
+@x [47] m.1114 l.21322
+primitive("-",discretionary,1);
+@!@:Single-character primitives -}{\quad\.{\\-}@>
+primitive("discretionary",discretionary,0);
+@!@:discretionary_}{\.{\\discretionary} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+discretionary: if chr_code=1 then
+ print_esc("-")@+else print_esc("discretionary");
+
+@ @<Cases of |main_control| that build...@>=
+hmode+discretionary,mmode+discretionary: append_discretionary;
+@y
+primitive("-",discretionary,1);
+@!@:Single-character primitives -}{\quad\.{\\-}@>
+primitive("discretionary",discretionary,0);
+@!@:discretionary_}{\.{\\discretionary} primitive@>
+primitive("localleftbox",assign_local_box,0);
+@!@:assign_local_box}{\.{\\localleftbox} primitive@>
+primitive("localrightbox",assign_local_box,1);
+@!@:assign_local_box}{\.{\\localrightbox} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+discretionary: if chr_code=1 then
+ print_esc("-")@+else print_esc("discretionary");
+assign_local_box: if chr_code=0 then print_esc("localleftbox")
+ else print_esc("localrightbox");
+
+@ @<Cases of |main_control| that build...@>=
+hmode+discretionary,mmode+discretionary: append_discretionary;
+any_mode(assign_local_box): append_local_box(cur_chr);
+@z
+%-------------------------
+@x [47] m.1117 l.21338
+procedure append_discretionary;
+var c:integer; {hyphen character}
+begin tail_append(new_disc);
+if cur_chr=1 then
+ begin c:=hyphen_char(cur_font);
+ if c>=0 then if c<=biggest_char then
+ pre_break(tail):=new_character(cur_font,c);
+ end
+else begin incr(save_ptr); saved(-1):=0; new_save_level(disc_group);
+ scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
+ end;
+end;
+@y
+procedure append_local_box(kind:integer);
+begin
+incr(save_ptr); saved(-1):=kind; new_save_level(local_box_group);
+scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
+end;
+
+procedure append_discretionary;
+var c:integer; {hyphen character}
+begin tail_append(new_disc);
+if cur_chr=1 then
+ begin c:=hyphen_char(cur_font);
+ if c>=0 then if c<=biggest_char then begin
+ pre_break(tail):=new_character(cur_font,c);
+ info_decr_ref_count(ptr_info(pre_break(tail)));
+ ptr_info(pre_break(tail)):=local_par_info;
+ info_incr_ref_count(local_par_info);
+ add_file_col(pre_break(tail));
+ end
+ end
+else begin incr(save_ptr); saved(-1):=0; new_save_level(disc_group);
+ scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
+ end;
+end;
+@z
+%-------------------------
+@x [47] m.1118 l.21355
+disc_group: build_discretionary;
+@y
+disc_group: build_discretionary;
+local_box_group: build_local_box;
+@z
+%-------------------------
+@x [47] m.1119 l.21358
+procedure build_discretionary;
+@y
+procedure build_local_box;
+var p:pointer;
+ kind:integer;
+begin
+unsave;
+kind:=saved(-1);
+decr(save_ptr);
+p:=link(head); pop_nest;
+p:=hpack(p,natural);
+if kind=0 then
+ eq_define(local_left_box_base,box_ref,p)
+else
+ eq_define(local_right_box_base,box_ref,p);
+@<LOCAL: Change info node@>;
+end;
+
+procedure build_discretionary;
+@z
+%-------------------------
+@x [47] m.1123
+procedure make_accent;
+var s,@!t: real; {amount of slant}
+@!p,@!q,@!r:pointer; {character, box, and kern nodes}
+@!f:internal_font_number; {relevant font}
+@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above}
+@!i:four_quarters; {character information}
+begin scan_char_num; f:=cur_font; p:=new_character(f,cur_val);
+if p<>null then
+ begin x:=x_height(f); s:=slant(f)/float_constant(65536);
+@^real division@>
+ a:=char_width(f)(char_info(f)(character(p)));@/
+ do_assignments;@/
+ @<Create a character node |q| for the next character,
+ but set |q:=null| if problems arise@>;
+ if q<>null then @<Append the accent with appropriate kerns,
+ then set |p:=q|@>;
+ link(tail):=p; tail:=p; space_factor:=1000;
+ end;
+end;
+@y
+procedure make_accent;
+var s,@!t: real; {amount of slant}
+@!p,@!q,@!r:pointer; {character, box, and kern nodes}
+@!f:internal_font_number; {relevant font}
+@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above}
+@!i:four_quarters; {character information}
+begin scan_char_num; f:=cur_font; p:=new_character(f,cur_val);
+@<LOCAL: Add info node pointer@>;
+add_file_col(p);
+if p<>null then
+ begin x:=x_height(f); s:=slant(f)/float_constant(65536);
+@^real division@>
+ a:=char_width(f)(char_info(f)(character(p)));@/
+ do_assignments;@/
+ @<Create a character node |q| for the next character,
+ but set |q:=null| if problems arise@>;
+ if q<>null then @<Append the accent with appropriate kerns,
+ then set |p:=q|@>;
+ link(tail):=p; tail:=p; space_factor:=1000;
+ end;
+end;
+@z
+%-------------------------
+@x [47] m.1124
+@ @<Create a character node |q| for the next...@>=
+q:=null; f:=cur_font;
+if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
+ q:=new_character(f,cur_chr)
+else if cur_cmd=char_num then
+ begin scan_char_num; q:=new_character(f,cur_val);
+ end
+else back_input
+@y
+@ @<Create a character node |q| for the next...@>=
+q:=null; f:=cur_font;
+if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then begin
+ q:=new_character(f,cur_chr);
+ info_decr_ref_count(ptr_info(q));
+ ptr_info(q):=local_par_info;
+ info_incr_ref_count(local_par_info);
+ add_file_col(q);
+ end
+else if cur_cmd=char_num then
+ begin scan_char_num; q:=new_character(f,cur_val);
+ info_decr_ref_count(ptr_info(q));
+ ptr_info(q):=local_par_info;
+ info_incr_ref_count(local_par_info);
+ add_file_col(q);
+ end
+else back_input
+@z
+%-------------------------
+@x [49] m.1228 l.22908
+assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
+ word_define(p,cur_val);
+@y
+assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
+ word_define(p,cur_val);
+{If we are defining subparagraph penalty levels, then we
+ must change the local paragraph node.}
+ if ((p=(int_base+local_inter_line_penalty_code)) or
+ (p=(int_base+local_broken_penalty_code))) then
+ @<LOCAL: Change info node@>;
+@z
+%-------------------------
+@x [53] m.1344 l.24546
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+@y
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+primitive("localinterlinepenalty",assign_int,
+ int_base+local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,
+ int_base+local_broken_penalty_code);@/
+primitive("charspecials",assign_int,
+ int_base+char_specials_code);@/
+@z
+%-------------------------
+@x [53] m.1354
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+@y
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+ptr_info(tail):=local_par_info;
+info_incr_ref_count(local_par_info);
+add_file_col(tail);
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+@z
+%-------------------------
+@x [53] m.1368
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+procedure special_out(@!p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+@!k:pool_pointer; {index into |str_pool|}
+begin synch_h; synch_v;@/
+@y
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+procedure append_string(s:integer);
+var p:pointer;
+ i:integer;
+begin
+if (s<@"10000) then append_char(s)
+else begin
+ i:=str_start(s);
+ while i<str_start(s+1) do begin
+ append_char(str_pool[i]);
+ incr(i);
+ end;
+ end;
+end;
+
+procedure append_int(n:integer);
+var p:pointer;
+ k:integer;
+begin
+k:=0;
+repeat
+ dig[k] := n mod 10;
+ n := n div 10;
+ incr(k);
+until n=0;
+while k>0 do begin
+ decr(k);
+ append_char("0"+dig[k]);
+ end;
+end;
+
+procedure special_out(@!p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+@!k:pool_pointer; {index into |str_pool|}
+@!fff:pointer; {current file position}
+@!ffi:integer; {for iterations}
+@!g:integer; {new string}
+@!newk:integer;
+begin synch_h; synch_v;@/
+if ptr_info(p)<>null then
+ if info_file(ptr_info(p))<>null then
+ @<LOCAL: Create special node@>;
+@z
+%-------------------------
+@x [53] m.1378 l.24900
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+@y
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+
+@ @<LOCAL: Declare |make_info_node|@>=
+procedure make_info_node;
+{This function creates an |info_node|}
+var p:pointer;
+begin
+p:=get_node(info_size); type(p):=info_node;
+link(p):=null;
+info_ref_count(p):=1;
+info_pen_inter(p):=local_inter_line_penalty;
+info_pen_broken(p):=local_broken_penalty;
+if local_left_box=null then
+ info_left_box(p):=null
+else
+ info_left_box(p):=copy_node_list(local_left_box);
+if local_right_box=null then
+ info_right_box(p):=null
+else
+ info_right_box(p):=copy_node_list(local_right_box);
+if current_file_node=null then begin
+ info_file(p):=null;
+ end
+else begin
+ info_file(p):=current_file_node;
+ file_incr_ref_count(current_file_node);
+ end;
+eq_define(local_par_info_base,data,p);
+end;
+
+procedure make_file_node;
+var p:pointer;
+ i:integer;
+begin
+p:=get_node(file_size+2*no_of_files); type(p):=file_node;
+file_no(p):=no_of_files;
+file_ref_count(p):=1;
+for i := 1 to no_of_files do begin
+ mem[p+(i*2)].int := file_names[i];
+ mem[p+(i*2)+1].int := line_numbers[i];
+ end;
+file_decr_ref_count(current_file_node);
+current_file_node:=p;
+make_info_node;
+end
+
+@ @<LOCAL: Initialize local paragraph information@>=
+begin
+info_decr_ref_count(init_local_par_info);
+init_local_par_info:=ptr_info(cur_p);
+info_incr_ref_count(init_local_par_info);
+info_decr_ref_count(last_local_par_info);
+last_local_par_info:=ptr_info(cur_p);
+info_incr_ref_count(last_local_par_info);
+end
+
+@ @<LOCAL: Update local paragraph information@>=
+begin
+if last_local_par_info<>ptr_info(cur_p) then begin
+ info_decr_ref_count(last_local_par_info);
+ last_local_par_info:=ptr_info(cur_p);
+ info_incr_ref_count(last_local_par_info);
+ end;
+end
+
+@ @<LOCAL: print out |local_paragraph| node@>=
+info_node: begin
+ print_esc("info");
+ append_char(".");
+ print_ln; print_current_string;
+ print_esc("localinterlinepenalty"); print("=");
+ print_int(info_pen_inter(p));
+ print_ln; print_current_string;
+ print_esc("localbrokenpenalty"); print("=");
+ print_int(info_pen_broken(p));
+ print_ln; print_current_string;
+ print_esc("localleftbox");
+ if info_left_box(p)=null then print("=null")
+ else begin
+ append_char(".");
+ show_node_list(info_left_box(p));
+ decr(pool_ptr);
+ end;
+ print_ln; print_current_string;
+ print_esc("localrightbox");
+ if info_right_box(p)=null then print("=null")
+ else begin
+ append_char(".");
+ show_node_list(info_right_box(p));
+ decr(pool_ptr);
+ end;
+ decr(pool_ptr);
+ end
+
+@ @<LOCAL: Change file node@>=
+begin
+make_file_node;
+end
+
+@ @<LOCAL: Change info node@>=
+begin
+make_info_node;
+end
+
+@ @<LOCAL: Delete info node@>=
+begin
+info_decr_ref_count(p);
+end
+
+@ @<LOCAL: Add info node pointer@>=
+begin
+ptr_info(p):=local_par_info;
+info_incr_ref_count(local_par_info);
+end
+
+@ @<LOCAL: Copy info node pointer@>=
+begin
+ptr_info(r):=ptr_info(p);
+info_incr_ref_count(ptr_info(p));
+end
+
+@ @<LOCAL: Remove info node pointer@>=
+begin
+info_decr_ref_count(ptr_info(p));
+ptr_info(p):=null;
+end
+
+@ @<LOCAL: Create special node@>=
+begin
+fff:=info_file(ptr_info(p));
+append_string("om:");
+append_string("lines=");
+for ffi:=1 to file_no(fff) do begin
+ if mem[fff+ffi*2].int <> 0 then begin
+ append_char("""");
+ append_string(mem[fff+ffi*2].int);
+ append_char("""");
+ append_char(",");
+ append_int(mem[fff+ffi*2+1].int);
+ append_char(";");
+ end;
+ end;
+g:=make_string;
+if length(g)<256 then
+ begin dvi_out(xxx1); dvi_out(length(g));
+ end
+else begin dvi_out(xxx4); dvi_four(length(g));
+ end;
+for newk:=str_start(g) to pool_ptr-1 do dvi_out(so(str_pool[newk]));
+flush_string; {erase the string}
+append_string("om:");
+append_string("col=");
+append_int(file_col(p));
+append_char(";");
+g:=make_string;
+if length(g)<256 then
+ begin dvi_out(xxx1); dvi_out(length(g));
+ end
+else begin dvi_out(xxx4); dvi_four(length(g));
+ end;
+for newk:=str_start(g) to pool_ptr-1 do dvi_out(so(str_pool[newk]));
+flush_string; {erase the string}
+end
+
+@z
+%-------------------------
diff --git a/Build/source/texk/web2c/omegadir/omstr.ch b/Build/source/texk/web2c/omegadir/omstr.ch
new file mode 100644
index 00000000000..959454ce237
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omstr.ch
@@ -0,0 +1,875 @@
+% omstr.ch: String manipulation
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [2] m.17 l.510 - Omega
+In order to make \TeX\ readily portable to a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+@y
+In order to make $\Omega$ readily portable to a wide variety of
+computers, all of its input text is converted to an internal 31-bit
+@z
+%---------------------------------------
+@x [2] m.18 l.537 - Omega
+@!ASCII_code=0..255; {eight-bit numbers}
+@y
+@!ASCII_code=0..biggest_char;
+@z
+%---------------------------------------
+@x [2] m.19 l.567 - Omega
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@y
+@d last_text_char=biggest_char
+ {ordinal number of the largest element of |text_char|}
+@z
+%---------------------------------------
+@x [2] m.20 l.577 - Omega
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+@y
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+@z
+%---------------------------------------
+@x [2] m.23 l.724 - Omega
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+@y
+for i:=0 to @'37 do xchr[i]:=chr(i);
+for i:=@'177 to @'377 do xchr[i]:=chr(i);
+init_eqtb_table;
+@z
+%---------------------------------------
+@x [2] m.24 l.734 - Omega
+for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
+for i:=@'200 to @'377 do xord[xchr[i]]:=i;
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+@y
+@z
+%---------------------------------------
+@x [3] m.25 l.772 - Omega
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+@!eight_bits=0..biggest_char; {unsigned two-byte quantity}
+@!real_eight_bits=0..255; {dvi output uses exactly 8 bits}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of real_eight_bits; {files that contain binary data}
+@z
+%---------------------------------------
+@x [3] m.31 l.947 - Omega
+ buffer[last]:=xord[f^]; get(f); incr(last);
+@y
+ buffer[last]:=f^; get(f); incr(last);
+@z
+%---------------------------------------
+@x [4] m.38 l.1099 - Omega
+String numbers 0 to 255 are reserved for strings that correspond to single
+ASCII characters. This is in accordance with the conventions of \.{WEB},
+@y
+String numbers 0 to |biggest_char| are reserved for strings that correspond to
+single ASCII characters. This is in accordance with the conventions of \.{WEB},
+@z
+%---------------------------------------
+@x [4] m.38 l.1109 - Omega
+ASCII character, so the first 256 strings are used to specify exactly what
+should be printed for each of the 256 possibilities.
+@y
+ASCII character, so the first |biggest_char+1| strings are used to specify
+exactly what should be printed for each of the |biggest_char+1| possibilities.
+@z
+%---------------------------------------
+@x [4] m.38-9 l.1122 - Omega
+@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
+@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..255; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
+@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
+@d str_start(#) == str_start_ar[#-too_big_char]
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..65535; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start_ar : array[str_number] of pool_pointer; {the starting pointers}
+@z
+%---------------------------------------
+@x [4] m.40 l.1145 - Omega
+@d length(#)==(str_start[#+1]-str_start[#]) {the number of characters
+ in string number \#}
+@y
+@p function length(s:str_number):integer;
+ {the number of characters in string number |s|}
+begin if (s>=@"10000) then length:=str_start(s+1)-str_start(s)
+else if (s>=@"20) and (s<@"7F) then length:=1
+else if (s<=@"7F) then length:=3
+else if (s<@"100) then length:=4
+else length:=8
+end;
+@z
+%---------------------------------------
+@x [4] m.41 l.1150 - Omega
+@d cur_length == (pool_ptr - str_start[str_ptr])
+@y
+@d cur_length == (pool_ptr - str_start(str_ptr))
+@z
+%---------------------------------------
+@x [4] m.43 l.1181 - Omega
+incr(str_ptr); str_start[str_ptr]:=pool_ptr;
+@y
+incr(str_ptr); str_start(str_ptr):=pool_ptr;
+@z
+%---------------------------------------
+@x [4] m.44 l.1187 - Omega
+@d flush_string==begin decr(str_ptr); pool_ptr:=str_start[str_ptr];
+@y
+@d flush_string==begin decr(str_ptr); pool_ptr:=str_start(str_ptr);
+@z
+%---------------------------------------
+@x [4] m.45 l.1201 - Omega
+begin j:=str_start[s];
+while j<str_start[s+1] do
+@y
+begin j:=str_start(s);
+while j<str_start(s+1) do
+@z
+%---------------------------------------
+@x [4] m.46 l.1222 - Omega
+@p function str_eq_str(@!s,@!t:str_number):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j,@!k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin result:=false;
+if length(s)<>length(t) then goto not_found;
+j:=str_start[s]; k:=str_start[t];
+while j<str_start[s+1] do
+ begin if str_pool[j]<>str_pool[k] then goto not_found;
+ incr(j); incr(k);
+ end;
+result:=true;
+not_found: str_eq_str:=result;
+end;
+@y
+@p function str_eq_str(@!s,@!t:str_number):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j,@!k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin result:=false;
+if length(s)<>length(t) then goto not_found;
+if (length(s)=1) then begin
+ if s<65536 then begin
+ if t<65536 then begin
+ if s<>t then goto not_found;
+ end
+ else begin
+ if s<>str_pool[str_start(t)] then goto not_found;
+ end;
+ end
+ else begin
+ if t<65536 then begin
+ if str_pool[str_start(s)]<>t then goto not_found;
+ end
+ else begin
+ if str_pool[str_start(s)]<>str_pool[str_start(t)] then
+ goto not_found;
+ end;
+ end;
+ end
+else begin
+ j:=str_start(s); k:=str_start(t);
+ while j<str_start(s+1) do
+ begin if str_pool[j]<>str_pool[k] then goto not_found;
+ incr(j); incr(k);
+ end;
+ end;
+result:=true;
+not_found: str_eq_str:=result;
+end;
+@z
+%---------------------------------------
+@x [4] m.47 l.1240 - Omega
+var k,@!l:0..255; {small indices or counters}
+@y
+var k,@!l:0..biggest_char; {small indices or counters}
+@z
+%---------------------------------------
+@x [4] m.47 l.1245 - Omega
+begin pool_ptr:=0; str_ptr:=0; str_start[0]:=0;
+@<Make the first 256 strings@>;
+@<Read the other strings from the \.{TEX.POOL} file and return |true|,
+@y
+begin pool_ptr:=0; str_ptr:=0; str_start_ar[0]:=0; str_start_ar[1]:=0;
+@<Make the first strings@>;
+@<Read the other strings from the \.{OMEGA.POOL} file and return |true|,
+@z
+%---------------------------------------
+% A hack is made for strings 256 through to 65535.
+% String 256 becomes "^^^^????". All the strings
+% from 256 to 65535 are made to point at this string,
+% which will never be printed: it's just a placeholder.
+
+@x [4] m.48 l.1255 - Omega
+@<Make the first 256...@>=
+for k:=0 to 255 do
+ begin if (@<Character |k| cannot be printed@>) then
+ begin append_char("^"); append_char("^");
+ if k<@'100 then append_char(k+@'100)
+ else if k<@'200 then append_char(k-@'100)
+ else begin app_lc_hex(k div 16); app_lc_hex(k mod 16);
+ end;
+ end
+ else append_char(k);
+ g:=make_string;
+ end
+@y
+@<Make the first ...@>=
+begin
+str_ptr:=too_big_char;
+end
+@z
+%---------------------------------------
+@x [4] m.49 l.1279 - Omega
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+@y
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+Unprintable characters of codes 256--|biggest_char| are, similarly, rendered
+\.{\^\^\^\^0100}--\.{\^\^\^\^ffff}.
+
+@z
+%---------------------------------------
+@x [4] m.49 l.1295 - Omega
+@<Character |k| cannot be printed@>=
+ (k<" ")or(k>"~")
+@y
+@z
+%---------------------------------------
+@x [4] m.50 l.1298 - Omega
+@ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{TEX.PAS} and also a string pool file called \.{TEX.POOL}. The \.{INITEX}
+@y
+@ When the \.{WEB} system program called \.{OTANGLE} processes the \.{OMEGA.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{OMEGA.PAS} and also a string pool file called \.{OMEGA.POOL}. The \.{INITEX}
+@z
+%---------------------------------------
+@x [4] m.51 l.1322 - Omega
+else bad_pool('! I can''t read TEX.POOL.')
+@.I can't read TEX.POOL@>
+@y
+else bad_pool('! I can''t read OMEGA.POOL.')
+@.I can't read OMEGA.POOL@>
+@z
+%---------------------------------------
+@x [4] m.52 l.1326 - Omega
+begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.');
+@.TEX.POOL has no check sum@>
+@y
+begin if eof(pool_file) then bad_pool('! OMEGA.POOL has no check sum.');
+@.OMEGA.POOL has no check sum@>
+@z
+%---------------------------------------
+@x [4] m.52 l.1332 - Omega
+else begin if (xord[m]<"0")or(xord[m]>"9")or@|
+ (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL line doesn''t begin with two digits.');
+@.TEX.POOL line doesn't...@>
+ l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(xord[m]);
+@y
+else begin if (m<"0")or(m>"9")or@|
+ (n<"0")or(n>"9") then
+ bad_pool('! OMEGA.POOL line doesn''t begin with two digits.');
+@.OMEGA.POOL line doesn't...@>
+ l:=m*10+n-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(m);
+@z
+%---------------------------------------
+@x [4] m.53 l.1347 - Omega
+end of this \.{TEX.POOL} file; any other value means that the wrong pool
+@y
+end of this \.{OMEGA.POOL} file; any other value means that the wrong pool
+@z
+%---------------------------------------
+@x [4] m.53 l.1354 - Omega
+loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL check sum doesn''t have nine digits.');
+@.TEX.POOL check sum...@>
+ a:=10*a+xord[n]-"0";
+@y
+loop@+ begin if (n<"0")or(n>"9") then
+ bad_pool('! OMEGA.POOL check sum doesn''t have nine digits.');
+@.OMEGA.POOL check sum...@>
+ a:=10*a+n-"0";
+@z
+%---------------------------------------
+@x [4] m.53 l.1360 - Omega
+done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.');
+@.TEX.POOL doesn't match@>
+@y
+done: if a<>@$ then bad_pool('! OMEGA.POOL doesn''t match; OTANGLE me again.');
+@.OMEGA.POOL doesn't match@>
+@z
+%---------------------------------------
+% When we print a string, we must make sure we do the appropriate
+% thing for strings 256 through to 65535. We must generate the
+% strings on the fly.
+
+@x [5] m.59 l.1496 - Omega
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<256 then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char; new_line_char:=-1;
+ {temporarily disable new-line character}
+ j:=str_start[s];
+ while j<str_start[s+1] do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+ new_line_char:=nl; return;
+ end;
+j:=str_start[s];
+while j<str_start[s+1] do
+@y
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@d print_lc_hex(#)==l:=#;
+ if l<10 then print_char(l+"0") else print_char(l-10+"a");
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+@!l:integer; {for printing 16-bit characters}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char;
+ @<Set newline character to -1@>;
+ if s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(s+@'100);
+ end
+ else if s<@"7F then
+ print_char(s)
+ else if s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(s-@'100);
+ end
+ else if s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end;
+ @<Set newline character to nl@>;
+ return;
+ end;
+j:=str_start(s);
+while j<str_start(s+1) do
+@z
+%---------------------------------------
+@x [5] m.60 l.1539 - Omega
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<256) then print(s)
+else begin j:=str_start[s];
+ while j<str_start[s+1] do
+@y
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<=biggest_char) then print(s)
+else begin j:=str_start(s);
+ while j<str_start(s+1) do
+@z
+%---------------------------------------
+@x [5] m.61 l.1556 - Omega
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+update_terminal;
+@y
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+wterm_ln('Copyright (c) 1994--2000 John Plaice and Yannis Haralambous');
+update_terminal;
+@z
+%---------------------------------------
+@x [5] m.63 l.1576 - Omega
+procedure print_esc(@!s:str_number); {prints escape character, then |s|}
+var c:integer; {the escape character code}
+begin @<Set variable |c| to the current escape character@>;
+if c>=0 then if c<256 then print(c);
+@y
+procedure print_esc(@!s:str_number); {prints escape character, then |s|}
+var c:integer; {the escape character code}
+begin @<Set variable |c| to the current escape character@>;
+if c>=0 then if c<=biggest_char then print(c);
+@z
+%---------------------------------------
+@x [5] m.69 l.1654 - Omega
+@p procedure print_roman_int(@!n:integer);
+label exit;
+var j,@!k: pool_pointer; {mysterious indices into |str_pool|}
+@!u,@!v: nonnegative_integer; {mysterious numbers}
+begin j:=str_start["m2d5c2l5x2v5i"]; v:=1000;
+@y
+@p procedure print_roman_int(@!n:integer);
+label exit;
+var j,@!k: pool_pointer; {mysterious indices into |str_pool|}
+@!u,@!v: nonnegative_integer; {mysterious numbers}
+begin j:=str_start("m2d5c2l5x2v5i"); v:=1000;
+@z
+%---------------------------------------
+@x [5] m.70 l.1674 - Omega
+@p procedure print_current_string; {prints a yet-unmade string}
+var j:pool_pointer; {points to current character code}
+begin j:=str_start[str_ptr];
+@y
+@p procedure print_current_string; {prints a yet-unmade string}
+var j:pool_pointer; {points to current character code}
+begin j:=str_start(str_ptr);
+@z
+%---------------------------------------
+@x [6] m.94 l.2052 - Omega
+print_err("TeX capacity exceeded, sorry [");
+@y
+print_err("Omega capacity exceeded, sorry [");
+@z
+%---------------------------------------
+@x [18] m.260 l.5532 - Omega
+while pool_ptr>str_start[str_ptr] do
+@y
+while pool_ptr>str_start(str_ptr) do
+@z
+%---------------------------------------
+@x [18] m.264 l.5610 - Omega
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+@y
+else begin k:=str_start(s); l:=str_start(s+1)-k;
+@z
+%---------------------------------------
+@x [24] m.341 l.7219 - Omega
+@!c,@!cc:ASCII_code; {constituents of a possible expanded code}
+@!d:2..3; {number of excess characters in an expanded code}
+@y
+@!c,@!cc,@!ccc,@!cccc:ASCII_code; {constituents of a possible expanded code}
+@!d:2..7; {number of excess characters in an expanded code}
+@z
+%---------------------------------------
+@x [24] m.352 l.7349 - Omega
+ else cur_chr:=16*cur_chr+cc-"a"+10
+@y
+ else cur_chr:=16*cur_chr+cc-"a"+10
+@d long_hex_to_cur_chr==
+ if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
+ if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
+ else cur_chr:=16*cur_chr+cc-"a"+10;
+ if ccc<="9" then cur_chr:=16*cur_chr+ccc-"0"
+ else cur_chr:=16*cur_chr+ccc-"a"+10;
+ if cccc<="9" then cur_chr:=16*cur_chr+cccc-"0"
+ else cur_chr:=16*cur_chr+cccc-"a"+10
+
+@z
+%---------------------------------------
+@x [24] m.352 l.7353 - Omega
+ begin c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
+@y
+ begin if (cur_chr=buffer[loc+1]) and (cur_chr=buffer[loc+2]) and
+ ((loc+6)<=limit) then
+ begin c:=buffer[loc+3]; cc:=buffer[loc+4];
+ ccc:=buffer[loc+5]; cccc:=buffer[loc+6];
+ if is_hex(c) and is_hex(cc) and is_hex(ccc) and is_hex(cccc) then
+ begin loc:=loc+7; long_hex_to_cur_chr; goto reswitch;
+ end;
+ end;
+ c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
+@z
+%---------------------------------------
+@x [24] m.355 l.7416 - Omega
+begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
+ begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
+ begin d:=2;
+ if is_hex(c) then @+if k+2<=limit then
+ begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
+ end;
+ if d>2 then
+ begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ end
+ else if c<@'100 then buffer[k-1]:=c+@'100
+ else buffer[k-1]:=c-@'100;
+ limit:=limit-d; first:=first-d;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end;
+ end;
+end
+
+@y
+begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
+ begin if (cur_chr=buffer[k+1]) and (cur_chr=buffer[k+2]) and
+ ((k+6)<=limit) then
+ begin c:=buffer[k+3]; cc:=buffer[k+4];
+ ccc:=buffer[k+5]; cccc:=buffer[k+6];
+ if is_hex(c) and is_hex(cc) and is_hex(ccc) and is_hex(cccc) then
+ begin d:=7; long_hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end
+ end
+ else begin
+ c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
+ begin
+ d:=2;
+ if is_hex(c) then @+if k+2<=limit then
+ begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
+ end;
+ if d>2 then
+ begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ end
+ else if c<@'100 then buffer[k-1]:=c+@'100
+ else buffer[k-1]:=c-@'100;
+ limit:=limit-d; first:=first-d;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end
+ end
+ end
+end
+@z
+%---------------------------------------
+@x [26] m.407 l.8216 - Omega
+begin p:=backup_head; link(p):=null; k:=str_start[s];
+while k<str_start[s+1] do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=so(str_pool[k]))or(cur_chr=so(str_pool[k])-"a"+"A")) then
+ begin store_new_token(cur_tok); incr(k);
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+@y
+begin p:=backup_head; link(p):=null;
+if s<too_big_char then begin
+ while true do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=s)or(cur_chr=s-"a"+"A")) then
+ begin store_new_token(cur_tok);
+ flush_list(link(backup_head)); scan_keyword:=true; return;
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+ end;
+k:=str_start(s);
+while k<str_start(s+1) do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=so(str_pool[k]))or(cur_chr=so(str_pool[k])-"a"+"A")) then
+ begin store_new_token(cur_tok); incr(k);
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+@z
+%---------------------------------------
+@x [29] m.517 l.10005 - Omega
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+if area_delimiter=0 then cur_area:=""
+else begin cur_area:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
+@y
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+if area_delimiter=0 then cur_area:=""
+else begin cur_area:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr;
+ str_start(str_ptr+1):=str_start(str_ptr)+ext_delimiter-area_delimiter-1;
+@z
+%---------------------------------------
+@x [29] m.519 l.10039 - Omega
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[n] to str_start[n+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[e] to str_start[e+1]-1 do append_to_name(so(str_pool[j]));
+@y
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start(a) to str_start(a+1)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start(n) to str_start(n+1)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start(e) to str_start(e+1)-1 do append_to_name(so(str_pool[j]));
+@z
+%---------------------------------------
+@x [29] m.523 l.10095 - Omega
+for j:=1 to n do append_to_name(xord[TEX_format_default[j]]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=format_default_length-format_ext_length+1 to format_default_length do
+ append_to_name(xord[TEX_format_default[j]]);
+@y
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=format_default_length-format_ext_length+1 to format_default_length do
+ append_to_name(TEX_format_default[j]);
+@z
+%---------------------------------------
+@x [29] m.524 l.10155 - Omega
+else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+@y
+else begin for k:=1 to name_length do append_char(name_of_file[k]);
+@z
+%---------------------------------------
+@x [29] m.536 l.10324 - Omega
+begin wlog(banner);
+slow_print(format_ident); print(" ");
+print_int(day); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+for k:=3*month-2 to 3*month do wlog(months[k]);
+print_char(" "); print_int(year); print_char(" ");
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+end
+@y
+begin wlog(banner);
+slow_print(format_ident); print_nl("");
+print_int(day); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+for k:=3*month-2 to 3*month do wlog(months[k]);
+print_char(" "); print_int(year); print_char(" ");
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+print_nl("Copyright (c) 1994--2000 John Plaice and Yannis Haralambous");
+end
+@z
+%---------------------------------------
+@x [32] m.595 l.11860 - Omega
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@y
+@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
+@z
+%---------------------------------------
+@x [32] m.617 l.12262 - Omega
+ print(" TeX output "); print_int(year); print_char(".");
+@y
+ print("Omega output, Version 3.141592-1.23.2.3, ");
+ print_int(year); print_char(".");
+@z
+%---------------------------------------
+@x [32] m.617 l.12267 - Omega
+ for s:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[s]));
+ pool_ptr:=str_start[str_ptr]; {flush the current string}
+@y
+ for s:=str_start(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s]));
+ pool_ptr:=str_start(str_ptr); {flush the current string}
+@z
+%---------------------------------------
+@x [36] m.765 l.15021 - Omega
+magic_offset:=str_start[math_spacing]-9*ord_noad
+@y
+magic_offset:=str_start(math_spacing)-9*ord_noad
+@z
+%---------------------------------------
+@x [42] m.931 l.18172 - Omega
+ begin j:=1; u:=str_start[k];
+@y
+ begin j:=1; u:=str_start(k);
+@z
+%---------------------------------------
+@x [42] m.940 l.18296 - Omega
+u:=str_start[k]; v:=str_start[s];
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start[k+1];
+@y
+u:=str_start(k); v:=str_start(s);
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start(k+1);
+@z
+%---------------------------------------
+@x [49] m.1252 l.23232 - Omega
+ print_err("Patterns can be loaded only by INITEX");
+@y
+ print_err("Patterns can be loaded only by INIOMEGA");
+@z
+%---------------------------------------
+@x [50] m.1301 l.23682 - Omega
+format_ident:=" (INITEX)";
+@y
+format_ident:=" (INIOMEGA)";
+@z
+%---------------------------------------
+% We do not store any information for strings between 257 and 65535.
+
+@x [50] m.1309 l.23814 - Omega
+for k:=0 to str_ptr do dump_int(str_start[k]);
+@y
+for k:=too_big_char to str_ptr do dump_int(str_start(k));
+@z
+%---------------------------------------
+% We recreate the information for strings between 257 and 65535.
+
+@x [50] m.1310 l.23831 - Omega
+for k:=0 to str_ptr do undump(0)(pool_ptr)(str_start[k]);
+@y
+for k:=too_big_char to str_ptr do undump(0)(pool_ptr)(str_start(k));
+@z
+%---------------------------------------
+@x [51] m.1334 l.24266 - Omega
+ wlog_ln('Here is how much of TeX''s memory',' you used:');
+@y
+ wlog_ln('Here is how much of Omega''s memory',' you used:');
+@z
+%---------------------------------------
+@x [51] m.1335 l.24338 - Omega
+ print_nl("(\dump is performed only by INITEX)"); return;
+@:dump_}{\.{\\dump...only by INITEX}@>
+@y
+ print_nl("(\dump is performed only by INIOMEGA)"); return;
+@:dump_}{\.{\\dump...only by INIOMEGA}@>
+@z
+%---------------------------------------
+@x [53] m.1368 l.24747 - Omega
+for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
+pool_ptr:=str_start[str_ptr]; {erase the string}
+@y
+for k:=str_start(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k]));
+pool_ptr:=str_start(str_ptr); {erase the string}
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir/omtrans.ch b/Build/source/texk/web2c/omegadir/omtrans.ch
new file mode 100644
index 00000000000..7d62b23d6b2
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omtrans.ch
@@ -0,0 +1,822 @@
+% omtrans.ch: Characters sets for input and output
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [3] m.25 l.767 - Omega Translation
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+@y
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+
+@d no_mode=0
+@d onebyte_mode=1
+@d ebcdic_mode=2
+@d twobyte_mode=3
+@d twobyteLE_mode=4
+@d UTF8_mode=5
+@d UTF16_mode=6
+@d UTF16LE_mode=7
+
+@d trans_input=0
+@d trans_output=1
+@d trans_default_input=2
+@d trans_default_output=3
+@d trans_no_input=4
+@d trans_no_output=5
+@d trans_no_default_input=6
+@d trans_no_default_output=7
+
+@d mode_input=0
+@d mode_output=1
+@d mode_default_input=2
+@d mode_default_output=3
+@d mode_no_input=4
+@d mode_no_output=5
+@d mode_no_default_input=6
+@d mode_no_default_output=7
+@z
+%---------------------------------------
+@x [3] m.30 l.890 - Omega Translation
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+@y
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+@!term_in_mode:halfword;
+@!term_in_translation:halfword;
+@z
+%---------------------------------------
+@x [3] m.37 l.1065 - Omega Translation
+ if not input_ln(term_in,true) then {this shouldn't happen}
+@y
+ if not new_input_ln(term_in,term_in_mode,term_in_translation,true)
+then {this shouldn't happen}
+@z
+%---------------------------------------
+@x [5] m.54 l. - Omega Translation
+@!log_file : alpha_file; {transcript of \TeX\ session}
+@y
+@!log_file : alpha_file; {transcript of \TeX\ session}
+@!term_out_mode:halfword;
+@!term_out_translation:halfword;
+@z
+%---------------------------------------
+@x [5] m.59 l. - Omega Translation
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+case selector of
+term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin wlog(xchr[s]); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin wterm(xchr[s]); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+othercases write(write_file[selector],xchr[s])
+endcases;@/
+incr(tally);
+exit:end;
+@y
+@d omega_write(#)==case term_out_mode of
+ no_mode: write(#,xchr[s]);
+ onebyte_mode,ebcdic_mode: write(#,xchr[s]);
+ twobyte_mode: begin write(#,xchr[s div @"100]);
+ write(#,xchr[s mod @"100]);
+ end;
+ twobyteLE_mode: begin write(#,xchr[s mod @"100]);
+ write(#,xchr[s div @"100]);
+ end;
+ UTF8_mode: begin
+ if s<@"80 then write(#, xchr[s])
+ else if s<@"800 then begin
+ write(#, xchr[@"C0 + s div @"40]);
+ write(#, xchr[@"80 + s mod @"40]);
+ end
+ else begin
+ write(#, xchr[@"E0 + s div @"1000]);
+ write(#, xchr[@"80 + (s mod @"1000) div @"40]);
+ write(#, xchr[@"80 + (s mod @"1000) mod @"40]);
+ end
+ end;
+ UTF16_mode: begin
+ end;
+ UTF16LE_mode: begin
+ end;
+ end
+
+@d omega_file_write(#)==case write_file_mode[#] of
+ no_mode: write(write_file[#],xchr[s]);
+ onebyte_mode,ebcdic_mode: write(write_file[#],xchr[s]);
+ twobyte_mode: begin write(write_file[#],xchr[s div @"100]);
+ write(write_file[#],xchr[s mod @"100]);
+ end;
+ twobyteLE_mode: begin write(write_file[#],xchr[s mod @"100]);
+ write(write_file[#],xchr[s div @"100]);
+ end;
+ UTF8_mode: begin
+ end;
+ UTF16_mode: begin
+ end;
+ UTF16LE_mode: begin
+ end;
+ end
+
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+case selector of
+term_and_log: begin omega_write(term_out); omega_write(log_file);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin omega_write(log_file); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin omega_write(term_out); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+othercases omega_file_write(selector)
+endcases;@/
+incr(tally);
+exit:end;
+@z
+%---------------------------------------
+@x [5] m.59 l. - Omega Translation
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+@!l:integer; {for printing 16-bit characters}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char;
+ @<Set newline character to -1@>;
+ if s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(s+@'100);
+ end
+ else if s<@"7F then
+ print_char(s)
+ else if s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(s-@'100);
+ end
+ else if s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end;
+ @<Set newline character to nl@>;
+ return;
+ end;
+j:=str_start(s);
+while j<str_start(s+1) do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+exit:end;
+
+@ Control sequence names, file names, and strings constructed with
+\.{\\string} might contain |ASCII_code| values that can't
+be printed using |print_char|. Therefore we use |slow_print| for them:
+
+@<Basic print...@>=
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<=biggest_char) then print(s)
+else begin j:=str_start(s);
+ while j<str_start(s+1) do
+ begin print(so(str_pool[j])); incr(j);
+ end;
+ end;
+end;
+@y
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+@!l:integer; {for printing 16-bit characters}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char;
+ @<Set newline character to -1@>;
+ if s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(s+@'100);
+ end
+ else if s<@"7F then
+ print_char(s)
+ else if s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(s-@'100);
+ end
+ else if s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100);
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end;
+ @<Set newline character to nl@>;
+ return;
+ end;
+j:=str_start(s);
+while j<str_start(s+1) do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+exit:end;
+
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+ ((file_offset>0)and(selector>=log_only)) then print_ln;
+print(s);
+end;
+
+procedure overflow_ocp_buf_size; forward;
+procedure overflow_ocp_stack_size; forward;
+
+procedure omega_print(s:str_number);
+var new_s:str_number;
+ om_mode,om_translation:integer;
+ j:integer;
+begin
+om_mode:=no_mode;
+om_translation:=0;
+case selector of
+term_and_log,log_only,term_only: begin
+ om_mode:=term_out_mode;
+ if om_mode<>no_mode then om_translation:=term_out_translation;
+ end;
+no_print,pseudo,new_string: do_nothing;
+othercases begin
+ om_mode:=write_file_mode[selector];
+ if om_mode<>no_mode then om_translation:=write_file_translation[selector];
+ end
+endcases;
+
+if (om_mode=no_mode) or
+ ((om_mode=onebyte_mode) and (om_translation=0)) then
+ begin
+ j:=str_start(s);
+ while j<str_start(s+1) do begin
+ new_s:=so(str_pool[j]);
+ if new_s<@"20 then begin
+ print_char(@"5E); print_char(@"5E); print_char(new_s+@'100);
+ end
+ else if new_s<@"7F then
+ print_char(new_s)
+ else if new_s=@"7F then begin
+ print_char(@"5E); print_char(@"5E); print_char(new_s-@'100);
+ end
+ else if new_s<@"100 then begin
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex((new_s mod @"100) div @"10); print_lc_hex(new_s mod @"10);
+ end
+ else begin {Here is where we generate the strings on the fly.}
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(new_s div @"1000);
+ print_lc_hex((new_s mod @"1000) div @"100);
+ print_lc_hex((new_s mod @"100) div @"10);
+ print_lc_hex(new_s mod @"10);
+ end;
+ incr(j);
+ end;
+ end
+else begin
+ if om_translation=0 then begin
+ j:=str_start(s);
+ otp_counter:=1;
+ while j<str_start(s+1) do begin
+ otp_output_buf[otp_counter]:=so(str_pool[j]);
+ incr(otp_counter);
+ incr(j);
+ end;
+ otp_output_end:=otp_counter;
+ end
+ else begin
+ otp_input_start:=0;
+ otp_input_last:=0;
+ otp_stack_used:=0;
+ otp_stack_last:=0;
+ otp_stack_new:=0;
+ otp_output_end:=0;
+ otp_pc:=0;
+ otp_finished:=false;
+ otp_calc_ptr:=0;
+ otp_calcs[otp_calc_ptr]:=0;
+ otp_state_ptr:=0;
+ otp_states[otp_state_ptr]:=0;
+ otp_input_ocp:=om_translation;
+ j:=str_start(s);
+ otp_counter:=1;
+ while j<str_start(s+1) do begin
+ otp_input_buf[otp_counter]:=so(str_pool[j]);
+ incr(otp_counter);
+ incr(j);
+ end;
+ otp_input_end:=otp_counter;
+ while not otp_finished do
+ @<Run the OTP program@>;
+ end;
+ for otp_counter:=1 to (otp_output_end-1) do begin
+ new_s:=otp_output_buf[otp_counter];
+ if (om_mode<twobyte_mode) and (new_s>255) then
+ begin
+ print_char(@"5E); print_char(@"5E);
+ print_char(@"5E); print_char(@"5E);
+ print_lc_hex(new_s div @"1000);
+ print_lc_hex((new_s mod @"1000) div @"100);
+ print_lc_hex((new_s mod @"100) div @"10);
+ print_lc_hex(new_s mod @"10);
+ end
+ else
+ print_char(new_s);
+ end;
+ end;
+end;
+
+@ Control sequence names, file names, and strings constructed with
+\.{\\string} might contain |ASCII_code| values that can't
+be printed using |print_char|. Therefore we use |slow_print| for them:
+
+@<Basic print...@>=
+procedure slow_print(@!s:integer); {prints string |s|}
+begin if (s>=str_ptr) or (s<=biggest_char) then print(s)
+else omega_print(s);
+end;
+@z
+%---------------------------------------
+@x [5] - Omega Translation
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+ ((file_offset>0)and(selector>=log_only)) then print_ln;
+print(s);
+end;
+@y
+@z
+%---------------------------------------
+@x [5] m.71 l.1694 - Omega Translation
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@y
+if not new_input_ln(term_in,term_in_mode,term_in_translation,true)
+then fatal_error("End of file on the terminal!");
+@z
+%---------------------------------------
+@x [15] m.209 l.4170 - Omega Translation
+@d max_command=ocp_trace_level
+ {the largest command code seen at |big_switch|}
+@y
+@d char_trans=ocp_trace_level+1
+@d char_mode=char_trans+1
+@d max_command=char_mode
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.230 l.4722 - Omega Translation
+@d toks_base=ocp_active_base+max_active_ocp_lists
+ {table of |number_regs| token list registers}
+@y
+@d ocp_input_mode_base=ocp_active_base+max_active_ocp_lists
+@d ocp_input_onebyte_translation_base =ocp_input_mode_base+ 1
+@d ocp_input_ebcdic_translation_base =ocp_input_mode_base+ 2
+@d ocp_input_twobyte_translation_base =ocp_input_mode_base+ 3
+@d ocp_input_twobyteLE_translation_base =ocp_input_mode_base+ 4
+@d ocp_input_UTF8_translation_base =ocp_input_mode_base+ 5
+@d ocp_input_UTF16_translation_base =ocp_input_mode_base+ 6
+@d ocp_input_UTF16LE_translation_base =ocp_input_mode_base+ 7
+
+@d ocp_output_mode_base =ocp_input_mode_base+ 8
+@d ocp_output_onebyte_translation_base =ocp_input_mode_base+ 9
+@d ocp_output_ebcdic_translation_base =ocp_input_mode_base+ 10
+@d ocp_output_twobyte_translation_base =ocp_input_mode_base+ 11
+@d ocp_output_twobyteLE_translation_base =ocp_input_mode_base+ 12
+@d ocp_output_UTF8_translation_base =ocp_input_mode_base+ 13
+@d ocp_output_UTF16_translation_base =ocp_input_mode_base+ 14
+@d ocp_output_UTF16LE_translation_base =ocp_input_mode_base+ 15
+
+@d toks_base =ocp_input_mode_base+16
+@z
+%---------------------------------------
+@x [22] m.304 l.6535 - Omega Translation
+@!input_file : array[1..max_in_open] of alpha_file;
+@y
+@!input_file : array[1..max_in_open] of alpha_file;
+@!input_file_mode : array[1..max_in_open] of halfword;
+@!input_file_translation : array[1..max_in_open] of halfword;
+@z
+%---------------------------------------
+@x [23] m.331 l.7066 - Omega Translation
+param_ptr:=0; max_param_stack:=0;
+@y
+param_ptr:=0; max_param_stack:=0;
+geq_define(ocp_input_mode_base,data,1);
+term_in_mode:=equiv(ocp_input_mode_base);
+term_out_mode:=equiv(ocp_input_mode_base);
+if term_in_mode>0
+then term_in_translation:=
+ equiv(ocp_input_onebyte_translation_base+term_in_mode-1);
+if term_out_mode>0
+then term_out_translation:=
+ equiv(ocp_output_onebyte_translation_base+term_in_mode-1);
+@z
+%---------------------------------------
+@x [24] m.362 l.7066 - Omega Translation
+ begin if input_ln(cur_file,true) then {not end of file}
+@y
+ begin if new_input_ln(cur_file,input_file_mode[index],
+ input_file_translation[index],true) then {not end of file}
+@z
+%---------------------------------------
+@x [27] m.480 l.9411 - Omega Translation
+@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
+@y
+@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
+@!read_file_mode:array[0..15] of halfword;
+@!read_file_translation:array[0..15] of halfword;
+@z
+%---------------------------------------
+@x [27] m.485 l.9475 - Omega Translation
+@<Input the first line of |read_file[m]|@>=
+if input_ln(read_file[m],false) then read_open[m]:=normal
+else begin a_close(read_file[m]); read_open[m]:=closed;
+ end
+@y
+@<Input the first line of |read_file[m]|@>=
+begin read_file_mode[m]:=
+ get_file_mode(read_file[m], equiv(ocp_input_mode_base));
+if read_file_mode[m]>0
+then read_file_translation[m]:=
+ equiv(ocp_input_onebyte_translation_base+read_file_mode[m]-1);
+if new_input_ln(read_file[m],read_file_mode[m],
+ read_file_translation[m],false) then read_open[m]:=normal
+else begin a_close(read_file[m]); read_open[m]:=closed;
+ end
+end
+@z
+%---------------------------------------
+@x [27] m.486 l.9484 - Omega Translation
+begin if not input_ln(read_file[m],true) then
+ begin a_close(read_file[m]); read_open[m]:=closed;
+@y
+begin if not new_input_ln(read_file[m],
+read_file_mode[m],read_file_translation[m],true) then
+ begin a_close(read_file[m]); read_open[m]:=closed;
+@z
+%---------------------------------------
+@x [29] m.538 l.10371 - Omega Translation
+begin line:=1;
+if input_ln(cur_file,false) then do_nothing;
+@y
+begin line:=1;
+input_file_mode[index]:=
+ get_file_mode(cur_file, equiv(ocp_input_mode_base));
+if input_file_mode[index]>0
+then input_file_translation[index]:=
+ equiv(ocp_input_onebyte_translation_base+input_file_mode[index]-1);
+if new_input_ln(cur_file,input_file_mode[index],
+ input_file_translation[index],false) then do_nothing;
+@z
+%---------------------------------------
+@x [49] m.1210 l.22629 - Omega Translation
+any_mode(ocp_trace_level) : prefixed_command;
+@y
+any_mode(ocp_trace_level) : prefixed_command;
+any_mode(char_mode) : do_char_mode;
+any_mode(char_trans) : do_char_translation;
+@z
+%---------------------------------------
+@x [49] m.1343 l.24928 - Omega Translation
+@!write_file:array[0..15] of alpha_file;
+@y
+@!write_file:array[0..15] of alpha_file;
+@!write_file_mode:array[0..15] of halfword;
+@!write_file_translation:array[0..15] of halfword;
+@z
+%---------------------------------------
+@x
+@* \[54] $\Omega$ changes.
+
+@y
+@* \[54] $\Omega$ changes.
+
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Input Translation Processes.
+
+@ @<Put each...@>=
+primitive("InputTranslation", char_trans, trans_input);
+primitive("OutputTranslation", char_trans, trans_output);
+primitive("DefaultInputTranslation", char_trans, trans_default_input);
+primitive("DefaultOutputTranslation", char_trans, trans_default_output);
+primitive("noInputTranslation", char_trans, trans_no_input);
+primitive("noOutputTranslation", char_trans, trans_no_output);
+primitive("noDefaultInputTranslation", char_trans, trans_no_default_input);
+primitive("noDefaultOutputTranslation", char_trans, trans_no_default_output);
+primitive("InputMode", char_mode, mode_input);
+primitive("OutputMode", char_mode, mode_output);
+primitive("DefaultInputMode", char_mode, mode_default_input);
+primitive("DefaultOutputMode", char_mode, mode_default_output);
+primitive("noInputMode", char_mode, mode_no_input);
+primitive("noOutputMode", char_mode, mode_no_output);
+primitive("noDefaultInputMode", char_mode, mode_no_default_input);
+primitive("noDefaultOutputMode", char_mode, mode_no_default_output);
+
+geq_define(ocp_input_onebyte_translation_base, data, 0);
+geq_define(ocp_input_ebcdic_translation_base, data, 0);
+geq_define(ocp_input_twobyte_translation_base, data, 0);
+geq_define(ocp_input_twobyteLE_translation_base, data, 0);
+geq_define(ocp_input_UTF8_translation_base, data, 0);
+geq_define(ocp_input_UTF16_translation_base, data, 0);
+geq_define(ocp_input_UTF16LE_translation_base, data, 0);
+geq_define(ocp_input_mode_base, data, 0);
+
+geq_define(ocp_output_onebyte_translation_base, data, 0);
+geq_define(ocp_output_ebcdic_translation_base, data, 0);
+geq_define(ocp_output_twobyte_translation_base, data, 0);
+geq_define(ocp_output_twobyteLE_translation_base, data, 0);
+geq_define(ocp_output_UTF8_translation_base, data, 0);
+geq_define(ocp_output_UTF16_translation_base, data, 0);
+geq_define(ocp_output_UTF16LE_translation_base, data, 0);
+geq_define(ocp_output_mode_base, data, 0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+char_trans:
+ case chr_code of
+ trans_input: print_esc("InputTranslation");
+ trans_output: print_esc("OutputTranslation");
+ trans_default_input: print_esc("DefaultInputTranslation");
+ trans_default_output: print_esc("DefaultOutputTranslation");
+ trans_no_input: print_esc("noInputTranslation");
+ trans_no_output: print_esc("noOutputTranslation");
+ trans_no_default_input: print_esc("noDefaultInputTranslation");
+ trans_no_default_output: print_esc("noDefaultOutputTranslation");
+ end;
+char_mode:
+ case chr_code of
+ mode_input: print_esc("InputMode");
+ mode_output: print_esc("OutputMode");
+ mode_default_input: print_esc("DefaultInputMode");
+ mode_default_output: print_esc("DefaultOutputMode");
+ mode_no_input: print_esc("noInputMode");
+ mode_no_output: print_esc("noOutputMode");
+ mode_no_default_input: print_esc("noDefaultInputMode");
+ mode_no_default_output: print_esc("noDefaultOutputMode");
+ end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure scan_file_referrent;
+begin
+if scan_keyword("currentfile") then cur_val:=max_halfword
+else scan_int;
+end;
+
+procedure scan_mode;
+begin
+if scan_keyword("onebyte") then cur_val:=onebyte_mode
+else if scan_keyword("ebcdic") then cur_val:=ebcdic_mode
+else if scan_keyword("twobyteLE") then cur_val:=twobyteLE_mode
+else if scan_keyword("twobyte") then cur_val:=twobyte_mode
+else if scan_keyword("UTF8") then cur_val:=UTF8_mode
+else if scan_keyword("UTF16LE") then cur_val:=UTF16LE_mode
+else if scan_keyword("UTF16") then cur_val:=UTF16_mode
+else begin print_err("Invalid input mode"); cur_val:=0; end;
+end;
+
+procedure do_char_translation;
+var kind:halfword;
+ fileref:halfword;
+ moderef:halfword;
+ ocpref:halfword;
+begin
+fileref:=0;
+moderef:=0;
+ocpref:=0;
+kind:=cur_chr;
+if (kind mod 4) <= 1 then begin
+ scan_file_referrent;
+ fileref:=cur_val;
+ end
+else begin
+ scan_mode;
+ moderef:=cur_val;
+ end;
+if kind < 4 then begin
+ scan_ocp_ident;
+ ocpref:=cur_val;
+ end;
+case (kind mod 4) of
+ trans_input: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ read_file_translation[fileref]:=ocpref;
+ end
+ else if fileref<>max_halfword then begin
+ term_in_translation:=ocpref;
+ end
+ else begin
+ base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ while state = token_list do
+ begin
+ decr(base_ptr);
+ cur_input:=input_stack[base_ptr];
+ end;
+ if name>17 then input_file_translation[index]:=ocpref;
+ cur_input:=input_stack[input_ptr];
+ end;
+ end;
+ trans_output: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ write_file_translation[fileref]:=ocpref;
+ end
+ else begin
+ term_out_translation:=ocpref;
+ end;
+ end;
+ trans_default_input: begin
+ geq_define(ocp_input_mode_base+moderef,data,ocpref);
+ end;
+ trans_default_output: begin
+ geq_define(ocp_output_mode_base+moderef,data,ocpref);
+ end;
+ end;
+end;
+
+procedure do_char_mode;
+var kind:halfword;
+ fileref:halfword;
+ moderef:halfword;
+begin
+fileref:=0;
+moderef:=0;
+kind:=cur_chr;
+if (kind mod 4) <= 1 then begin
+ scan_file_referrent;
+ fileref:=cur_val;
+ end;
+if kind < 4 then begin
+ scan_mode;
+ moderef:=cur_val;
+ end;
+case (kind mod 4) of
+ trans_input: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ read_file_mode[fileref]:=moderef;
+ end
+ else if fileref<>max_halfword then begin
+ term_in_mode:=moderef;
+ end
+ else begin
+ base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ while state = token_list do
+ begin
+ decr(base_ptr);
+ cur_input:=input_stack[base_ptr];
+ end;
+ if name>17 then input_file_mode[index]:=moderef;
+ cur_input:=input_stack[input_ptr];
+ end;
+ end;
+ trans_output: begin
+ if (fileref>=0) and (fileref<=15) then begin
+ write_file_mode[fileref]:=moderef;
+ end
+ else begin
+ term_out_mode:=moderef;
+ end;
+ end;
+ trans_default_input: begin
+ geq_define(ocp_input_mode_base,data,moderef);
+ end;
+ trans_default_output: begin
+ geq_define(ocp_output_mode_base,data,moderef);
+ end;
+ end;
+end;
+
+function p_new_input_ln(f:alpha_file;
+the_mode,translation:halfword;
+bypass_eoln:boolean):boolean;
+begin
+if (the_mode=no_mode) or ((the_mode=onebyte_mode) and (translation=0))
+then p_new_input_ln:=input_ln(f,bypass_eoln)
+else if not newinputline(f,the_mode,bypass_eoln)
+then p_new_input_ln:=false
+else if translation=0 then
+begin
+ if (first+otp_input_end)>=buf_size then overflow("buffer size", buf_size);
+ state:=new_line;
+ start:=first;
+ last:=start;
+ loc:=start;
+ for otp_counter:=1 to otp_input_end do
+ begin
+ buffer[last]:=otp_input_buf[otp_counter];
+ incr(last);
+ end;
+ while buffer[last-1]=' ' do decr(last);
+ limit:=last-1;
+ p_new_input_ln:=true
+end
+else
+begin
+ otp_input_start:=0;
+ otp_input_last:=0;
+ otp_stack_used:=0;
+ otp_stack_last:=0;
+ otp_stack_new:=0;
+ otp_output_end:=0;
+ otp_pc:=0;
+ otp_finished:=false;
+ otp_calc_ptr:=0;
+ otp_calcs[otp_calc_ptr]:=0;
+ otp_state_ptr:=0;
+ otp_states[otp_state_ptr]:=0;
+ otp_input_ocp:=translation;
+ while not otp_finished do
+ @<Run the OTP program@>;
+ if (first+otp_output_end)>=buf_size then overflow("buffer size", buf_size);
+ state:=new_line;
+ start:=first;
+ last:=start;
+ loc:=start;
+ for otp_counter:=1 to otp_output_end do
+ begin
+ buffer[last]:=otp_output_buf[otp_counter];
+ incr(last);
+ end;
+ while buffer[last-1]=' ' do decr(last);
+ limit:=last-1;
+ p_new_input_ln:=true
+end
+end;
+
+
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegadir/omxml.ch b/Build/source/texk/web2c/omegadir/omxml.ch
new file mode 100644
index 00000000000..db743bc06ad
--- /dev/null
+++ b/Build/source/texk/web2c/omegadir/omxml.ch
@@ -0,0 +1,2099 @@
+% omxml.ch: Generate XML, MathML, HTML, etc.
+%
+% This file is part of Omega,
+% which is based on the web2c distribution of TeX,
+%
+% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+%
+% Omega is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% Omega is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with Omega; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.392 - Omega
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@y
+@!font_sort_max=65535; {maximum internal font sort number}
+@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
+@z
+%---------------------------------------
+@x [1] m.12 l.437 - Omega
+@d number_fonts=font_biggest-font_base+2
+@y
+@d number_fonts=font_biggest-font_base+2
+@d font_sort_base=0
+@d font_sort_biggest=65535 {the biggest font sort}
+@d number_font_sorts=font_sort_biggest-font_sort_base+2
+@z
+%---------------------------------------
+@x [5] m.57 l.1446 - Omega
+othercases write_ln(write_file[selector])
+@y
+othercases if selector>max_selector then
+ write_ln(output_files[selector-max_selector])
+ else
+ write_ln(write_file[selector])
+@z
+%---------------------------------------
+@x [5] m.58 l.1465 - Omega
+othercases omega_file_write(selector)
+@y
+othercases if selector>max_selector then
+ write(output_files[selector-max_selector],xchr[s])
+ else
+ omega_file_write(selector)
+@z
+%---------------------------------------
+@x [10] m.160 l.3270 - Omega
+@d biggest_ordinary_node=info_node
+@y
+
+@d sgml_text_node=0
+@d sgml_math_node=1
+@d sgml_vert_node=2
+
+@d sgml_node=info_node+1 {|type| for an SGML node}
+@d sgml_node_size=5
+@d sgml_tag(#)==mem[#+1].int
+@d sgml_attrs(#)==mem[#+2].int
+@d sgml_singleton(#)==info(#+3)
+@d sgml_info(#)==link(#+3)
+@d sgml_kind(#)==mem[#+4].int
+
+@d sgml_attr_node=info_node+2 {|type| for an SGML attribute node}
+@d sgml_attr_node_size=4
+
+@d sgml_entity_node=info_node+3 {|type| for an SGML entity node}
+@d sgml_entity_node_size=2
+@d sgml_entity_string(#)==mem[#+1].int
+
+@d biggest_ordinary_node=sgml_entity_node
+
+@p
+function new_sgml_node:pointer;
+var p:pointer;
+begin p:=get_node(sgml_node_size);
+type(p):=sgml_node;
+sgml_tag(p):=0;
+sgml_attrs(p):=0;
+sgml_info(p):=0;
+sgml_singleton(p):=0;
+sgml_kind(p):=0;
+new_sgml_node:=p;
+end;
+
+function new_sgml_attr_node:pointer;
+var p:pointer;
+begin p:=get_node(sgml_attr_node_size);
+type(p):=sgml_attr_node;
+sgml_tag(p):=0;
+sgml_attrs(p):=0;
+sgml_info(p):=0;
+sgml_singleton(p):=0;
+new_sgml_attr_node:=p;
+end;
+
+function new_sgml_entity_node:pointer;
+var p:pointer;
+begin p:=get_node(sgml_entity_node_size);
+type(p):=sgml_entity_node;
+sgml_entity_string(p):=0;
+new_sgml_entity_node:=p;
+end;
+@z
+%---------------------------------------
+@x [12] m.174 l.3520 - Omega
+@p procedure short_display(@!p:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+begin while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ print_ASCII(qo(character(p)));
+@y
+@p procedure short_display(@!p:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+ fsort:integer;
+begin while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ if not SGML_show_entities then
+ print_ASCII(qo(character(p)))
+ else begin
+ fsort:=font_name_sort(font(p));
+ if fsort<>0 then begin
+ if (font_sort_char_entity(fsort)(character(p))<>0) then
+ slow_print(font_sort_char_entity(fsort)(character(p)))
+ else
+ print_ASCII(qo(character(p)));
+ end
+ else
+ print_ASCII(qo(character(p)));
+ end;
+@z
+%---------------------------------------
+@x [12] m.176 l.3563 - Omega
+procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); print_ASCII(qo(character(p)));
+ end;
+end;
+@y
+procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+var fsort:integer;
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" ");
+ if not SGML_show_entities then
+ print_ASCII(qo(character(p)))
+ else begin
+ fsort:=font_name_sort(font(p));
+ if fsort<>0 then begin
+ if (font_sort_char_entity(fsort)(character(p))<>0) then
+ print(font_sort_char_entity(fsort)(character(p)))
+ else
+ print_ASCII(qo(character(p)));
+ end
+ else
+ print_ASCII(qo(character(p)));
+ end;
+ end;
+end;
+@z
+%---------------------------------------
+@x [13] m.202 l.3928 - Omega
+ adjust_node: flush_node_list(adjust_ptr(p));
+@y
+ adjust_node: flush_node_list(adjust_ptr(p));
+ sgml_node: begin
+ if sgml_tag(p)<>0 then flush_node_list(sgml_attrs(p));
+ free_node(p,sgml_node_size); goto done;
+ end;
+ sgml_attr_node: begin
+ free_node(p,sgml_attr_node_size); goto done;
+ end;
+ sgml_entity_node: begin
+ free_node(p,sgml_entity_node_size); goto done;
+ end;
+@z
+%---------------------------------------
+@x [15] m.209 l.4138 - Omega
+@d max_command=char_mode
+ {the largest command code seen at |big_switch|}
+@y
+@d set_show_sgml_entities=char_mode+1
+ {printing hex code or SGML-like entity during \.{\\showbox}}
+@d set_mml_mode=set_show_sgml_entities+1
+ {for entering or leaving MML mode ( \.{\\mmlmode}~)}
+@d sgml_command=set_mml_mode+1
+ {for various SGML tags}
+@d max_command=sgml_command
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+ @!pg_field,@!ml_field: integer;@+
+@y
+ @!pg_field,@!ml_field: integer;@+
+ @!sgml_field: integer;
+ @!sgml_attr_field: pointer;
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@y
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@d current_sgml_tag==cur_list.sgml_field {current SGML tag}
+@d current_sgml_attrs==cur_list.sgml_attr_field {current SGML tag}
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+prev_graf:=0; shown_mode:=0;
+@y
+prev_graf:=0; shown_mode:=0;
+current_sgml_tag:=0; current_sgml_attrs:=null;
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+@y
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+current_sgml_tag:=0; current_sgml_attrs:=null;
+@z
+%---------------------------------------
+@x [16] m.212--217 l.4303 - Omega
+@p procedure pop_nest; {leave a semantic level, re-enter the old}
+begin free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+end;
+@y
+@p procedure pop_nest; {leave a semantic level, re-enter the old}
+var attrs:pointer;
+ {p:pointer;}
+begin attrs:=null;
+{
+if current_sgml_attrs<>null then
+ if current_sgml_tag=null then
+ attrs:=current_sgml_attrs
+ else
+ free_avail(current_sgml_attrs);
+}
+free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+{
+if attrs<>null then begin
+ p:=attrs;
+ while link(p)<>null do
+ begin
+ p:=link(p);
+ end;
+ link(p):=current_sgml_attrs;
+ current_sgml_attrs:=attrs;
+ end;
+}
+end;
+@z
+%---------------------------------------
+@x [17] m.222 l.4525 - Omega
+@d frozen_null_ocp=frozen_null_font+number_fonts
+@y
+@d frozen_null_font_sort=frozen_null_font+number_font_sorts {permanent null sort}
+@d frozen_null_ocp=frozen_null_font_sort+number_font_sorts
+@z
+%---------------------------------------
+@x [17] m.232 l.4802 - Omega
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+@y
+@d null_font_sort==font_sort_base
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+@z
+%---------------------------------------
+@x [19] m.269 l.5859 - Omega
+@d math_left_group=16 {code for `\.{\\left...\\right}'}
+@d local_box_group=17 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=17
+@y
+@d math_left_group=16 {code for `\.{\\left...\\right}'}
+@d math_mml_group=17 {code for automatic `\.{\\left...\\right}'}
+@d text_mml_group=18 {code for `\.{\\text...}'}
+@d text_sgml_group=19 {code for horizontal SGML tags}
+@d vert_sgml_group=20 {code for vertical SGML tags}
+@d par_sgml_group=21 {code for paragraph SGML tags}
+@d font_entity_group=22
+@d empty_tag_group=23
+@d local_box_group=24 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=24
+@z
+%---------------------------------------
+@x [29] m.532 l.10260 - Omega
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d ensure_dvi_open==if output_file_name=0 then
+ begin if job_name=0 then open_log_file;
+ pack_job_name(".dvi");
+ while not b_open_out(dvi_file) do
+ prompt_file_name("file name for output",".dvi");
+ output_file_name:=b_make_name_string(dvi_file);
+ end
+
+@<Glob...@>=
+@!dvi_file: byte_file; {the device-independent output goes here}
+@!output_file_name: str_number; {full name of the output file}
+@!log_name:str_number; {full name of the log file}
+@y
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d ensure_output_open_end(#)==while not b_open_out(#) do
+ prompt_file_name("file name for output",output_m_suffix);
+ output_m_name:=b_make_name_string(#);
+ end end
+
+@d ensure_output_open_middle(#)==output_m_name:=#; if #=0 then
+ begin if job_name=0 then open_log_file;
+ pack_job_name(output_m_suffix);
+ ensure_output_open_end
+
+@d ensure_output_open(#)==begin output_m_suffix:=#; ensure_output_open_middle
+
+@d ensure_dvi_open==begin
+ ensure_output_open(".dvi")(output_file_name)(dvi_file);
+ output_file_name:=output_m_name end
+
+@<Glob...@>=
+@!dvi_file: byte_file; {the device-independent output goes here}
+@!output_file_name: str_number; {full name of the dvi output file}
+@!output_m_suffix: str_number; {suffix for the current output file}
+@!output_m_name: str_number; {suffix for the current output file}
+@!output_file_names:array[1..10] of str_number;
+@!output_files:array[1..10] of byte_file;
+@!output_file_no:integer; {number of open output files}
+@!log_name:str_number; {full name of the log file}
+@!sgml_file_suffix:str_number; {suffix for the output file}
+@!sgml_attribute_quote:str_number; {string for quoting attribute values}
+@!sgml_empty_tag_marker:str_number; {string for marking empty tags}
+@!sgml_paragraph_tag:str_number; {tag to designate paragraphs}
+@z
+%---------------------------------------
+@x [29] m.533 l.10260 - Omega
+@ @<Initialize the output...@>=output_file_name:=0;
+@y
+@ @<Initialize the output...@>=output_file_name:=0;
+for output_file_no:=1 to 10 do output_file_names[output_file_no]:=0;
+sgml_file_suffix:=".xml";
+sgml_attribute_quote:="""";
+sgml_empty_tag_marker:="/";
+output_file_no:=0;
+@z
+%---------------------------------------
+@x [30] m.549 l.10686 - Omega
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@y
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_sort_ptr:integer; {largest internal font sort number in use}
+@z
+%---------------------------------------
+@x [30] m.550 l.10723 - Omega
+@d param_base(#)==font_info(#)(offset_param_base).int
+@y
+@d param_base(#)==font_info(#)(offset_param_base).int
+
+@d font_sort_info_end(#)==#]
+@d font_sort_info(#)==font_sort_tables[#,font_sort_info_end
+@d font_sort_offset_file_size=0
+@d font_sort_offset_name=font_sort_offset_file_size+1
+@d font_sort_offset_bc=font_sort_offset_name+1
+@d font_sort_offset_ec=font_sort_offset_bc+1
+@d font_sort_offset_char_base=font_sort_offset_bc+1
+@d font_sort_file_size(#)==font_sort_info(#)(font_sort_offset_file_size).int
+@d font_sort_name(#)==font_sort_info(#)(font_sort_offset_name).int
+@d font_sort_bc(#)==font_sort_info(#)(font_sort_offset_bc).int
+@d font_sort_ec(#)==font_sort_info(#)(font_sort_offset_ec).int
+@d font_sort_char_base(#)==font_sort_info(#)(font_sort_offset_char_base).int
+@d font_sort_char_entity_end(#)==#*3].int
+@d font_sort_char_entity(#)==
+ font_sort_tables[#,font_sort_offset_char_base+font_sort_char_entity_end
+@d font_sort_char_tag_end(#)==#*3+1].int
+@d font_sort_char_tag(#)==
+ font_sort_tables[#,font_sort_offset_char_base+font_sort_char_tag_end
+@d font_sort_char_attr_end(#)==#*3+2].int
+@d font_sort_char_attr(#)==
+ font_sort_tables[#,font_sort_offset_char_base+font_sort_char_attr_end
+@z
+%---------------------------------------
+@x [30] m.550 l.10723 - Omega
+@!dimen_font:integer;
+@y
+@!dimen_font:integer;
+@!font_sorts:integer; {to run through font sorts}
+@!font_sort_c:integer; {character used to define font entities}
+@!font_sort_number:integer; {this particular font sort number}
+@z
+%---------------------------------------
+@x [30] m.552 l.10749 - Omega
+for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
+@y
+for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
+font_sort_ptr:=null_font_sort;
+allocate_font_sort_table(null_font_sort,font_sort_offset_char_base);
+font_sort_file_size(null_font_sort):=font_sort_offset_char_base;
+font_sort_name(null_font_sort):="nullfontsort";
+@z
+%---------------------------------------
+@x [32] m.638 l.12656 - Omega
+@<Ship box |p| out@>;
+@y
+if not SGML_mode then begin @<Ship box |p| out@>; end;
+@z
+%---------------------------------------
+@x [46] m.1030
+hmode+spacer: if space_factor=1000 then goto append_normal_space
+ else app_space;
+hmode+ex_space,mmode+ex_space: goto append_normal_space;
+@y
+hmode+spacer:
+ if SGML_mode then begin
+ make_sgml_entity(" ");
+ goto big_switch;
+ end
+ else if space_factor=1000 then goto append_normal_space
+ else app_space;
+hmode+ex_space,mmode+ex_space: goto append_normal_space;
+@z
+%---------------------------------------
+@x [47] m.1060 l.20533 - Omega
+procedure append_glue;
+var s:small_number; {modifier of skip command}
+begin s:=cur_chr;
+case s of
+fil_code: cur_val:=fil_glue;
+fill_code: cur_val:=fill_glue;
+ss_code: cur_val:=ss_glue;
+fil_neg_code: cur_val:=fil_neg_glue;
+skip_code: scan_glue(glue_val);
+mskip_code: scan_glue(mu_val);
+end; {now |cur_val| points to the glue specification}
+tail_append(new_glue(cur_val));
+if s>=skip_code then
+ begin decr(glue_ref_count(cur_val));
+ if s>skip_code then subtype(tail):=mu_glue;
+ end;
+end;
+@y
+procedure append_glue;
+var s:small_number; {modifier of skip command}
+begin s:=cur_chr;
+case s of
+fil_code: cur_val:=fil_glue;
+fill_code: cur_val:=fill_glue;
+ss_code: cur_val:=ss_glue;
+fil_neg_code: cur_val:=fil_neg_glue;
+skip_code: scan_glue(glue_val);
+mskip_code: scan_glue(mu_val);
+end; {now |cur_val| points to the glue specification}
+if (abs(mode)=mmode) and SGML_mode then begin
+ end
+else begin
+ tail_append(new_glue(cur_val));
+ if s>=skip_code then
+ begin decr(glue_ref_count(cur_val));
+ if s>skip_code then subtype(tail):=mu_glue;
+ end;
+ end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1061 l.20339 - Omega
+procedure append_kern;
+var s:quarterword; {|subtype| of the kern node}
+begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
+tail_append(new_kern(cur_val)); subtype(tail):=s;
+end;
+@y
+procedure append_kern;
+var s:quarterword; {|subtype| of the kern node}
+begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
+if (abs(mode)=mmode) and SGML_mode then begin
+ end
+else begin
+ tail_append(new_kern(cur_val)); subtype(tail):=s;
+ end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1073 l.20795 - Omega
+vmode+hmove,hmode+vmove,mmode+vmove: begin t:=cur_chr;
+ scan_normal_dimen;
+ if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
+ end;
+any_mode(leader_ship): scan_box(leader_flag-a_leaders+cur_chr);
+any_mode(make_box): begin_box(0);
+@y
+vmode+hmove,hmode+vmove,mmode+vmove: begin
+ if abs(mode)=mmode and SGML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_cmd_chr(cur_cmd,cur_chr); print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end
+ else begin
+ t:=cur_chr; scan_normal_dimen;
+ if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
+ end;
+ end;
+any_mode(leader_ship): begin
+ if abs(mode)=mmode and SGML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_cmd_chr(cur_cmd,cur_chr); print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end
+ else
+ scan_box(leader_flag-a_leaders+cur_chr);
+ end;
+any_mode(make_box): begin
+ if abs(mode)=mmode and SGML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_cmd_chr(cur_cmd,cur_chr); print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end
+ else
+ begin_box(0);
+ end;
+@z
+%---------------------------------------
+@x [47] m. l.21055 - Omega
+procedure new_graf(@!indented:boolean);
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+tmp_dir_stack:=get_avail; info(tmp_dir_stack):=par_direction;
+link(tmp_dir_stack):=par_dir_stack;
+par_dir_stack:=tmp_dir_stack;
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ box_dir(tail):=info(par_dir_stack);
+ change_dir(tail,info(par_dir_stack));
+ end;
+if every_par<>null then begin_token_list(every_par,every_par_text);
+if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
+end;
+@y
+procedure sgml_start_graf; forward;
+
+procedure new_graf(@!indented:boolean);
+begin prev_graf:=0;
+if SGML_mode then begin
+ sgml_start_graf
+ end
+else begin
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+tmp_dir_stack:=get_avail; info(tmp_dir_stack):=par_direction;
+link(tmp_dir_stack):=par_dir_stack;
+par_dir_stack:=tmp_dir_stack;
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ box_dir(tail):=info(par_dir_stack);
+ change_dir(tail,info(par_dir_stack));
+ end;
+if every_par<>null then begin_token_list(every_par,every_par_text);
+if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
+end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1100 l.21156 - Omega
+procedure end_graf;
+begin if mode=hmode then
+ begin if head=tail then pop_nest {null paragraphs are ignored}
+ else line_break(widow_penalty,info(par_dir_stack));
+ tmp_dir_stack:=par_dir_stack;
+ par_dir_stack:=link(par_dir_stack);
+ free_avail(tmp_dir_stack);
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@y
+procedure sgml_end_graf; forward;
+
+procedure end_graf;
+begin if mode=hmode then
+ begin if head=tail then pop_nest {null paragraphs are ignored}
+ else if SGML_mode then begin sgml_end_graf end
+ else line_break(widow_penalty,info(par_dir_stack));
+ tmp_dir_stack:=par_dir_stack;
+ par_dir_stack:=link(par_dir_stack);
+ free_avail(tmp_dir_stack);
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+@z
+%---------------------------------------
+@x [47] m.1130 l.21562 - Omega
+vmode+halign,hmode+valign:init_align;
+mmode+halign: if privileged then
+ if cur_group=math_shift_group then init_align
+ else off_save;
+vmode+endv,hmode+endv: do_endv;
+@y
+vmode+halign,hmode+valign:init_align;
+mmode+halign: if SGML_mode then begin
+ print_err("Unauthorized entry in math expression: ");
+ print_esc("halign"); print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end
+ else begin
+ if privileged then
+ if cur_group=math_shift_group then init_align
+ else off_save;
+ end;
+vmode+endv,hmode+endv: do_endv;
+@z
+%---------------------------------------
+@x [48] m.1136 l.21605 - Omega
+@* \[48] Building math lists.
+The routines that \TeX\ uses to create mlists are similar to those we have
+just seen for the generation of hlists and vlists. But it is necessary to
+make ``noads'' as well as nodes, so the reader should review the
+discussion of math mode data structures before trying to make sense out of
+the following program.
+
+Here is a little routine that needs to be done whenever a subformula
+is about to be processed. The parameter is a code like |math_group|.
+
+@<Declare act...@>=
+procedure push_math(@!c:group_code);
+begin
+push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
+make_local_direction(info(math_dir_stack),true);
+end;
+@y
+@* \[48] Building math lists.
+The routines that \TeX\ uses to create mlists are similar to those we have
+just seen for the generation of hlists and vlists. But it is necessary to
+make ``noads'' as well as nodes, so the reader should review the
+discussion of math mode data structures before trying to make sense out of
+the following program.
+
+Here is a little routine that needs to be done whenever a subformula
+is about to be processed. The parameter is a code like |math_group|.
+
+@<Glob...@>=
+@!SGML_mode:boolean;
+@!SGML_show_entities:boolean;
+@!MML_level:integer;
+@!mml_file_no:integer; {the \.{MML} output file}
+@!mml_indent:integer;
+@!mml_depth_level:integer;
+@!tmp_back_at_bol:boolean;
+
+@ @<Set init...@>=
+SGML_mode:=false;
+SGML_show_entities:=true;
+MML_level:=0;
+mml_indent:=0;
+mml_file_no:=0;
+mml_depth_level:=0;
+
+@
+
+@d sgml_out_pointer(#)==
+ case math_type(#(p)) of
+ math_char: begin
+ fetch(#(p));
+ fsort:=font_name_sort(cur_f);
+ if char_exists(cur_i) then begin
+ if (font_sort_char_tag(fsort)(cur_c)<>0) then begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ print("<"); print(font_sort_char_tag(fsort)(cur_c));
+ if (font_sort_char_attr(fsort)(cur_c)<>null) then begin
+ sgml_attrs_out(font_sort_char_attr(fsort)(cur_c));
+ end;
+ print(">");
+ if (font_sort_char_entity(fsort)(cur_c)<>0) then begin
+ print(font_sort_char_entity(fsort)(cur_c));
+ end;
+ print("</"); print(font_sort_char_tag(fsort)(cur_c));
+ print(">");
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ end;
+ end;
+ sub_mlist: begin
+ case type(p) of
+ op_noad,bin_noad,rel_noad,
+ open_noad,close_noad,punct_noad,inner_noad: begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ print("<mo");
+ if (type(p)=op_noad) and (subtype(p)=limits) then begin
+ print(" limits=""true""");
+ end
+ else if (type(p)=op_noad) and (subtype(p)=no_limits) then begin
+ print(" limits=""false""");
+ end;
+ print(">");
+ mml_indent:=mml_indent+1;
+ print(new_line_char);
+ back_at_bol:=true;
+ q:=p; cur_mlist:=info(#(p));
+ if link(cur_mlist)=null then
+ if type(cur_mlist)=sgml_node then
+ if str_eq_str(sgml_tag(cur_mlist),"mrow") then
+ cur_mlist:=sgml_info(cur_mlist);
+ back_at_bol:=sgml_out_mlist(false,back_at_bol,false); p:=q;
+ mml_indent:=mml_indent-1;
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ print("</mo>");
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ othercases begin
+ q:=p; cur_mlist:=info(#(p));
+ back_at_bol:=sgml_out_mlist(false,back_at_bol,false); p:=q;
+ end
+ endcases;
+ end;
+ othercases begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ print("<merror> Unrecognized math stuff </merror>");
+ print(new_line_char);
+ back_at_bol:=true;
+ end
+ endcases;
+
+@<Declare act...@>=
+procedure push_math(@!c:group_code);
+begin
+push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
+make_local_direction(info(math_dir_stack),true);
+end;
+
+function sgml_out_on_one_line(p:pointer):boolean;
+begin
+if (sgml_tag(p)="mi") or (sgml_tag(p)="mo") or (sgml_tag(p)="mn") then
+ sgml_out_on_one_line:=true
+else sgml_out_on_one_line:=false;
+end;
+
+procedure sgml_attrs_out(p:pointer);
+var q:pointer;
+begin
+q:=p;
+while q<>null do begin
+ print(" ");
+ print(sgml_tag(q)); print("=");
+ print(sgml_attribute_quote);
+ print(sgml_attrs(q));
+ print(sgml_attribute_quote);
+ q:=link(q);
+ end;
+end;
+
+function sgml_out_mlist(break_line,back_at_bol,inside_vert:boolean):boolean;
+var p,q:pointer;
+ old_selector:integer;
+ i,fsort:integer;
+ beg_of_vert:boolean;
+ doing_vert_node:boolean;
+ save_mml_indent:integer;
+begin
+if inside_vert then begin
+ if is_char_node(cur_mlist) then beg_of_vert:=false
+ else if type(cur_mlist)=sgml_entity_node then beg_of_vert:=true
+ else beg_of_vert:=false;
+ end
+else beg_of_vert:=false;
+old_selector:=selector;
+selector:=max_selector+mml_file_no;
+p:=cur_mlist;
+while p<>null do begin
+ if is_char_node(p) then begin
+ doing_vert_node:=false;
+ fsort:=font_name_sort(font(p));
+ if (font_sort_char_entity(fsort)(character(p))<>0) then begin
+ if back_at_bol then begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ end;
+ print(font_sort_char_entity(fsort)(character(p)));
+ end;
+ end
+ else begin
+ case type(p) of
+ hlist_node,vlist_node,rule_node,
+ ins_node,mark_node,adjust_node: do_nothing;
+ ligature_node: begin
+ doing_vert_node:=false;
+ fsort:=font_name_sort(font(lig_char(p)));
+ if (font_sort_char_entity(fsort)(character(lig_char(p)))<>0) then begin
+ if back_at_bol then begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ end;
+ print(font_sort_char_entity(fsort)(character(lig_char(p))));
+ end;
+ end;
+ disc_node,whatsit_node,math_node,glue_node,
+ kern_node,penalty_node,unset_node: do_nothing;
+ sgml_node: begin
+ doing_vert_node:=false;
+ if sgml_tag(p)=0 then begin
+ print(sgml_attrs(p));
+ end
+ else if sgml_singleton(p)>=1 then begin
+ if sgml_kind(p)<>sgml_text_node then begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ end;
+ print("<"); print(sgml_tag(p));
+ sgml_attrs_out(sgml_attrs(p));
+ if sgml_singleton(p)=1 then print(sgml_empty_tag_marker);
+ print(">");
+ if sgml_kind(p)<>sgml_text_node then begin
+ print(new_line_char); back_at_bol:=true;
+ end;
+ end
+ else begin
+ if sgml_kind(p)=sgml_vert_node then
+ doing_vert_node:=true;
+ if str_eq_str(sgml_tag(p),"math") then begin
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ if back_at_bol then begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ end;
+ print("<"); print(sgml_tag(p));
+ sgml_attrs_out(sgml_attrs(p)); print(">");
+ if (sgml_kind(p)<>sgml_text_node) and
+ (sgml_tag(p)<>"mtext") then begin
+ if not(sgml_out_on_one_line(p)) then begin
+ mml_indent:=mml_indent+1;
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ end;
+ cur_mlist:=sgml_info(p);
+ if cur_mlist<>null then begin
+ if (sgml_kind(p)=sgml_vert_node) then begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ end;
+ back_at_bol:=
+ sgml_out_mlist(false,back_at_bol,sgml_kind(p)=sgml_vert_node);
+ if (sgml_kind(p)=sgml_vert_node) then
+ if not back_at_bol then begin
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ end;
+ if (sgml_kind(p)<>sgml_text_node) and
+ (sgml_tag(p)<>"mtext") then begin
+ if not(sgml_out_on_one_line(p)) then begin
+ mml_indent:=mml_indent-1;
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ end;
+ end;
+ print("</"); print(sgml_tag(p)); print(">");
+ if sgml_kind(p)<>sgml_text_node then begin
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ if sgml_kind(p)=sgml_vert_node then
+ beg_of_vert:=true;
+ if str_eq_str(sgml_tag(p),"math") then begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ end;
+ end;
+ end;
+ sgml_entity_node: begin
+ if not(doing_vert_node and (sgml_entity_string(p)=" ")) then begin
+ print(sgml_entity_string(p));
+ doing_vert_node:=false;
+ beg_of_vert:=false;
+ back_at_bol:=false;
+ end;
+ end;
+ fraction_noad: begin
+ doing_vert_node:=false;
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ print("<mfrac>Arguments</mfrac>");
+ print(new_line_char); back_at_bol:=true;
+ end;
+ othercases begin
+ doing_vert_node:=false;
+ if (info(subscr(p))<>null) or
+ (info(supscr(p))<>null) then begin
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ print("<m");
+ if info(subscr(p))<>empty then print("sub");
+ if info(supscr(p))<>empty then print("sup");
+ print(">");
+ mml_indent:=mml_indent+1;
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ sgml_out_pointer(nucleus);
+ if (info(subscr(p))<>null) or
+ (info(supscr(p))<>null) then begin
+ if info(subscr(p))<>null then begin
+ sgml_out_pointer(subscr);
+ end;
+ if info(supscr(p))<>null then begin
+ sgml_out_pointer(supscr);
+ end;
+ mml_indent:=mml_indent-1;
+ for i:=1 to mml_indent do print(" ");
+ back_at_bol:=false;
+ print("</m");
+ if info(subscr(p))<>null then print("sub");
+ if info(supscr(p))<>null then print("sup");
+ print(">");
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ end;
+ endcases;
+ end;
+ p:=link(p);
+ if not(doing_vert_node) then
+ if p<>null then
+ if not(is_char_node(p)) then
+ if type(p)=sgml_node then
+ if sgml_kind(p)=sgml_vert_node then begin
+ print(new_line_char);
+ back_at_bol:=true;
+ end;
+ end;
+selector:=old_selector;
+sgml_out_mlist:=back_at_bol;
+end;
+
+procedure make_sgml_entity(s:str_number);
+begin
+link(tail):=new_sgml_entity_node;
+tail:=link(tail);
+sgml_entity_string(tail):=s;
+end;
+
+procedure scan_font_entity;
+var cv1,cv2,cv3,cv4:integer;
+begin
+scan_string_argument; cv1:=cur_val;
+scan_left_brace; scan_int; cv2:=cur_val; scan_right_brace;
+scan_string_argument; cv3:=cur_val;
+scan_string_argument; cv4:=cur_val;
+save_ptr:=save_ptr+4;
+saved(-1):=cv1; saved(-2):=cv2; saved(-3):=cv3; saved(-4):=cv4;
+new_save_level(font_entity_group); scan_left_brace; push_nest;
+end;
+
+procedure scan_empty_tag;
+begin
+scan_string_argument;
+link(tail):=new_sgml_node;
+tail:=link(tail);
+sgml_tag(tail):=cur_val;
+sgml_kind(tail):=sgml_text_node;
+sgml_singleton(tail):=1;
+incr(save_ptr); saved(-1):=tail;
+new_save_level(empty_tag_group); scan_left_brace; push_nest;
+end;
+
+procedure scan_math_empty_tag;
+begin
+scan_string_argument;
+link(tail):=new_sgml_node;
+tail:=link(tail);
+sgml_tag(tail):=cur_val;
+sgml_kind(tail):=sgml_math_node;
+sgml_singleton(tail):=1;
+incr(save_ptr); saved(-1):=tail;
+new_save_level(empty_tag_group); scan_left_brace; push_nest;
+end;
+
+procedure sgml_startmathtag(s:str_number);
+begin
+push_math(math_group); current_sgml_tag:=s;
+end;
+
+
+procedure sgml_startverttag(s:str_number);
+begin
+push_nest; new_save_level(vert_sgml_group);
+current_sgml_tag:=s;
+mode:=-hmode;
+end;
+
+procedure sgml_startpartag(s:str_number);
+begin
+push_nest; new_save_level(par_sgml_group);
+current_sgml_tag:=s;
+mode:=-hmode;
+end;
+
+procedure sgml_starttexttag(s:str_number);
+begin
+push_nest; new_save_level(text_sgml_group);
+current_sgml_tag:=s;
+mode:=-hmode;
+end;
+
+
+procedure sgml_tag_attribute(tag,s,s1:str_number);
+var p:pointer;
+ nest_level:integer;
+ found_tag:boolean;
+begin
+p:=new_sgml_attr_node;
+sgml_tag(p):=s;
+sgml_attrs(p):=s1;
+sgml_singleton(p):=0;
+if str_eq_str(tag,current_sgml_tag) then begin
+ link(p):=current_sgml_attrs;
+ current_sgml_attrs:=p;
+ end
+else begin
+ nest_level:= nest_ptr - 1;
+ found_tag:=false;
+ while (nest_level>0) and
+ (not str_eq_str(nest[nest_level].sgml_field,tag)) do
+ decr(nest_level);
+ if nest_level<>0 then begin
+ link(p):=nest[nest_level].sgml_attr_field;
+ nest[nest_level].sgml_attr_field:=p;
+ end
+ else begin
+ print("Tag not found in call to SGMLtagattribute"); print_ln;
+ end;
+ end;
+end;
+
+procedure sgml_attribute(s,s1:str_number);
+var p,q:pointer;
+begin
+p:=new_sgml_attr_node;
+sgml_tag(p):=s;
+sgml_attrs(p):=s1;
+sgml_singleton(p):=0;
+link(p):=null;
+if current_sgml_attrs=null then
+ current_sgml_attrs:=p
+else begin
+ q:=current_sgml_attrs;
+ while link(q)<>null do q:=link(q);
+ link(q):=p;
+ end;
+end;
+
+procedure sgml_endtexttag(s:str_number);
+var q:pointer;
+begin
+if not str_eq_str(s,current_sgml_tag) then begin
+ print_err("Tags do not match: ");
+ print(current_sgml_tag); print(","); print(s);
+ print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end;
+q:=new_sgml_node;
+sgml_tag(q):=s;
+sgml_kind(q):=sgml_text_node;
+sgml_info(q):=link(head);
+sgml_attrs(q):=current_sgml_attrs;
+pop_nest;
+unsave;
+if mode=vmode then begin
+ ensure_sgml_open;
+ cur_mlist:=q;
+ tmp_back_at_bol:=sgml_out_mlist(false,true,false);
+ end
+else begin
+ link(tail):=q;
+ tail:=q;
+ end;
+end;
+
+procedure sgml_endverttag(s:str_number);
+var q:pointer;
+begin
+if not str_eq_str(s,current_sgml_tag) then begin
+ print_err("Tags do not match: ");
+ print(current_sgml_tag); print(","); print(s);
+ print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end;
+q:=new_sgml_node;
+sgml_tag(q):=s;
+sgml_kind(q):=sgml_vert_node;
+sgml_info(q):=link(head);
+sgml_attrs(q):=current_sgml_attrs;
+pop_nest;
+unsave;
+if mode=vmode then begin
+ ensure_sgml_open;
+ cur_mlist:=q;
+ tmp_back_at_bol:=sgml_out_mlist(false,true,false);
+ end
+else begin
+ link(tail):=q;
+ tail:=q;
+ end;
+end;
+
+procedure sgml_endpartag(s:str_number);
+var q:pointer;
+begin
+if not str_eq_str(s,current_sgml_tag) then begin
+ print_err("Tags do not match: ");
+ print(current_sgml_tag); print(","); print(s);
+ print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end;
+q:=new_sgml_node;
+sgml_tag(q):=s;
+sgml_kind(q):=sgml_vert_node;
+sgml_info(q):=link(head);
+sgml_attrs(q):=current_sgml_attrs;
+pop_nest;
+unsave;
+if sgml_info(q)=null then begin
+ flush_node_list(q);
+ end
+else if mode=vmode then begin
+ ensure_sgml_open;
+ cur_mlist:=q;
+ tmp_back_at_bol:=sgml_out_mlist(false,true,false);
+ end
+else begin
+ link(tail):=q;
+ tail:=q;
+ end;
+end;
+
+procedure sgml_write(s:str_number);
+var old_selector:integer;
+begin
+ensure_sgml_open;
+old_selector:=selector;
+selector:=max_selector+mml_file_no;
+print(s);
+selector:=old_selector;
+end;
+
+procedure sgml_endmathtag(s:str_number);
+var q:pointer;
+begin
+if not str_eq_str(s,current_sgml_tag) then begin
+ print_err("Tags do not match: ");
+ print(current_sgml_tag); print(","); print(s);
+ print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end;
+q:=new_sgml_node;
+sgml_tag(q):=s;
+sgml_kind(q):=sgml_math_node;
+if s<>"mtext" then sgml_attrs(q):=current_sgml_attrs;
+sgml_info(q):=link(head);
+if current_sgml_attrs=null then
+ if (link(head)<>null) then
+ if (str_eq_str(s,"mtr") or str_eq_str(s,"mtd")) and
+ (link(link(head))=null) then begin
+ q:=sgml_info(q);
+ end;
+pop_nest;
+unsave;
+link(tail):=q;
+tail:=q;
+end;
+
+procedure sgml_start_graf;
+begin
+print("Executing sgml_start_graf"); print_ln;
+sgml_starttexttag(sgml_paragraph_tag);
+end;
+
+procedure sgml_end_graf;
+begin
+sgml_endtexttag(sgml_paragraph_tag);
+print("Executing sgml_end_graf"); print_ln;
+end;
+
+@ Entering or leaving MML mode
+by using the routine called |primitive|, defined below. Let us enter them
+now, so that we don't have to list all those parameter names anywhere else.
+
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("showSGMLentities",set_show_sgml_entities,1);
+primitive("noshowSGMLentities",set_show_sgml_entities,0);
+primitive("SGMLmode",set_mml_mode,1);
+@!@:SGML_mode_}{\.{\\SGMLmode} primitive@>
+primitive("noSGMLmode",set_mml_mode,0);
+@!@:noSGML_mode_}{\.{\\noSGMLmode} primitive@>
+primitive("SGMLstartmathtag",sgml_command,0);
+primitive("SGMLendmathtag",sgml_command,1);
+primitive("SGMLstarttexttag",sgml_command,2);
+primitive("SGMLendtexttag",sgml_command,3);
+primitive("SGMLattribute",sgml_command,4);
+primitive("MMLstarttext",sgml_command,5);
+primitive("MMLendtext",sgml_command,6);
+
+primitive("SGMLampersand",other_char,"&");
+primitive("SGMLbackslash",other_char,"\");
+primitive("SGMLcarret",other_char,"^");
+primitive("SGMLdollar",other_char,"$");
+primitive("SGMLhash",other_char,"#");
+primitive("SGMLleftbrace",other_char,"{");
+primitive("SGMLpercent",other_char,"%");
+primitive("SGMLrightbrace",other_char,"}");
+primitive("SGMLunderscore",other_char,"_");
+primitive("SGMLquote",other_char,"'");
+primitive("SGMLbackquote",other_char,"");
+primitive("SGMLdoublequote",other_char,"""");
+primitive("SGMLtilde",other_char,"~");
+primitive("SGMLexclamationmark",other_char,"!");
+primitive("SGMLquestionmark",other_char,"?");
+primitive("SGMLequals",other_char,"=");
+primitive("SGMLcolon",other_char,":");
+primitive("SGMLsemicolon",other_char,";");
+
+primitive("SGMLentity",sgml_command,7);
+primitive("SGMLemptytag",sgml_command,8);
+primitive("SGMLFontEntity",sgml_command,9);
+primitive("SGMLwrite",sgml_command,10);
+primitive("SGMLwriteln",sgml_command,11);
+primitive("SGMLfilesuffix",sgml_command,12);
+primitive("SGMLattributequote",sgml_command,13);
+primitive("SGMLemptytagmarker",sgml_command,14);
+primitive("SGMLtagattribute",sgml_command,15);
+primitive("SGMLstartverttag",sgml_command,16);
+primitive("SGMLendverttag",sgml_command,17);
+primitive("SGMLmathemptytag",sgml_command,18);
+primitive("SGMLstartpartag",sgml_command,19);
+primitive("SGMLendpartag",sgml_command,20);
+
+@ @<Cases of |main_control| that build boxes and lists@>=
+mmode+set_mml_mode: report_illegal_case;
+non_math(set_mml_mode):
+ if cur_chr=0 then SGML_mode:=false else SGML_mode:=true;
+any_mode(set_show_sgml_entities):
+ if cur_chr=0 then SGML_show_entities:=false
+ else SGML_show_entities:=true;
+any_mode(sgml_command): begin
+ case cur_chr of
+ 0: begin scan_string_argument; sgml_startmathtag(cur_val); end;
+ 1: begin scan_string_argument; sgml_endmathtag(cur_val); end;
+ 2: begin scan_string_argument; sgml_starttexttag(cur_val); end;
+ 3: begin scan_string_argument; sgml_endtexttag(cur_val); end;
+ 4: begin scan_string_argument; cur_val1:=cur_val;
+ scan_string_argument; sgml_attribute(cur_val1,cur_val); end;
+ 5: begin
+ push_nest; new_save_level(text_mml_group);
+ current_sgml_tag:="mtext"; mode:=-hmode;
+ end;
+ 6: begin sgml_endmathtag("mtext"); end;
+ 7: begin scan_string_argument; make_sgml_entity(cur_val); end;
+ 8: begin scan_empty_tag; end;
+ 9: begin scan_font_entity; end;
+ 10: begin scan_string_argument; sgml_write(cur_val); end;
+ 11: begin sgml_write(new_line_char); end;
+ 12: begin scan_string_argument; sgml_file_suffix:=cur_val; end;
+ 13: begin scan_string_argument; sgml_attribute_quote:=cur_val; end;
+ 14: begin scan_string_argument; sgml_empty_tag_marker:=cur_val; end;
+ 15: begin scan_string_argument; cur_val2:=cur_val;
+ scan_string_argument; cur_val1:=cur_val;
+ scan_string_argument;
+ sgml_tag_attribute(cur_val2,cur_val1,cur_val);
+ end;
+ 16: begin scan_string_argument; sgml_startverttag(cur_val); end;
+ 17: begin scan_string_argument; sgml_endverttag(cur_val); end;
+ 18: begin scan_math_empty_tag; end;
+ 19: begin scan_string_argument; sgml_startpartag(cur_val); end;
+ 20: begin scan_string_argument; sgml_endpartag(cur_val); end;
+ end;
+ end;
+
+@ The following code opens \.{MML} output file if neccesary.
+@p procedure ensure_sgml_open;
+begin
+ if mml_file_no=0 then begin
+ incr(output_file_no);
+ mml_file_no:=output_file_no;
+ ensure_output_open(sgml_file_suffix)
+ (output_file_names[mml_file_no])
+ (output_files[mml_file_no]);
+ output_file_names[mml_file_no]:=output_m_name;
+ end;
+end;
+
+@ @<Declare act...@>=
+
+@z
+%---------------------------------------
+@x [48] m.1137 l.21620 - Omega
+@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
+|math_shift| character) is scanned. We must check to see whether this
+`\.\$' is immediately followed by another, in case display math mode is
+called for.
+
+@<Cases of |main_control| that build...@>=
+hmode+math_shift:init_math;
+@y
+@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
+|math_shift| character) is scanned. We must check to see whether this
+`\.\$' is immediately followed by another, in case display math mode is
+called for.
+
+@<Cases of |main_control| that build...@>=
+hmode+math_shift: begin
+ if SGML_mode then begin
+ ensure_sgml_open;
+ incr(MML_level);
+ end;
+ init_math;
+ end;
+
+@z
+%---------------------------------------
+@x [48] m.1139 l.21648 - Omega
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+current_sgml_tag:="mrow";
+sgml_attribute("displaystyle","false");
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+%---------------------------------------
+@x [48] m.1145 l.21703 - Omega
+if every_display<>null then begin_token_list(every_display,every_display_text);
+@y
+current_sgml_tag:="mrow";
+sgml_attribute("displaystyle","true");
+if every_display<>null then begin_token_list(every_display,every_display_text);
+@z
+%---------------------------------------
+@x [48] m.1155 l.21878 - Omega
+ else type(p):=ord_noad+(c div @"1000000);
+ link(tail):=p; tail:=p;
+@y
+ else type(p):=ord_noad+(c div @"1000000);
+ if not SGML_mode then
+ tail_append(p)
+ else if (c div @"1000000)=4 then begin
+ saved(0):=p;
+ incr(save_ptr);
+ push_math(math_mml_group);
+ end
+ else if (cur_group=math_mml_group) and
+ ((c div @"1000000)=5) then begin
+ unsave;
+ decr(save_ptr);
+ q:=saved(0);
+ r:=fin_mlist(null);
+ push_math(math_group);
+ tail_append(q); tail_append(r); tail_append(p);
+ unsave;
+ p:=fin_mlist(null);
+ tail_append(p);
+ end
+ else tail_append(p);
+@z
+%---------------------------------------
+@x [48] m.1176--1177 l.22109 - Omega
+procedure sub_sup;
+var t:small_number; {type of previous sub/superscript}
+@!p:pointer; {field to be filled by |scan_math|}
+begin t:=empty; p:=null;
+if tail<>head then if scripts_allowed(tail) then
+ begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+ t:=math_type(p);
+ end;
+if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
+scan_math(p);
+end;
+@y
+procedure sub_sup;
+var t:small_number; {type of previous sub/superscript}
+@!p,q,r:pointer; {field to be filled by |scan_math|}
+begin t:=empty; p:=null;
+if tail<>head then begin
+ if SGML_mode then
+ if type(tail)=sgml_node then begin
+ q:=head;
+ while link(q)<>tail do q:=link(q);
+ r:=new_noad;
+ info(nucleus(r)):=tail;
+ math_type(nucleus(r)):=sub_mlist;
+ link(q):=r;
+ tail:=r;
+ end;
+ if scripts_allowed(tail) then
+ begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+ t:=math_type(p);
+ end;
+ end;
+if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
+scan_math(p);
+end;
+@z
+%---------------------------------------
+@x [48] m.1181 l.22199 - Omega
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+if incompleat_noad<>null then
+ @<Ignore the fraction operation and complain about this ambiguous case@>
+else begin incompleat_noad:=get_node(fraction_noad_size);
+ type(incompleat_noad):=fraction_noad;
+ subtype(incompleat_noad):=normal;
+ math_type(numerator(incompleat_noad)):=sub_mlist;
+ info(numerator(incompleat_noad)):=link(head);
+ mem[denominator(incompleat_noad)].hh:=empty_field;
+ mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
+ mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
+ link(head):=null; tail:=head;
+ @<Use code |c| to distinguish between generalized fractions@>;
+ end;
+end;
+@y
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+if incompleat_noad<>null then
+ @<Ignore the fraction operation and complain about this ambiguous case@>
+else begin incompleat_noad:=get_node(fraction_noad_size);
+ type(incompleat_noad):=fraction_noad;
+ subtype(incompleat_noad):=normal;
+ math_type(numerator(incompleat_noad)):=sub_mlist;
+ info(numerator(incompleat_noad)):=link(head);
+ mem[denominator(incompleat_noad)].hh:=empty_field;
+ if SGML_mode then begin
+ mem[left_delimiter(incompleat_noad)].int:=0;
+ mem[right_delimiter(incompleat_noad)].int:=0;@/
+ end
+ else begin
+ mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
+ mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
+ end;
+ link(head):=null; tail:=head;
+ @<Use code |c| to distinguish between generalized fractions@>;
+ end;
+end;
+@z
+%---------------------------------------
+@x [48] m.1182 l.22199 - Omega
+ begin scan_delimiter(left_delimiter(incompleat_noad),false);
+ scan_delimiter(right_delimiter(incompleat_noad),false);
+@y
+ begin if SGML_mode then begin
+ mem[left_delimiter(incompleat_noad)].int:=new_noad;
+ scan_math(nucleus(mem[left_delimiter(incompleat_noad)].int));
+ mem[right_delimiter(incompleat_noad)].int:=new_noad;
+ scan_math(nucleus(mem[right_delimiter(incompleat_noad)].int));
+ end
+ else begin
+ scan_delimiter(left_delimiter(incompleat_noad),0);
+ scan_delimiter(right_delimiter(incompleat_noad),0);
+ end;
+@z
+%---------------------------------------
+@x [48] m.1183 l.22212 - Omega
+ begin scan_delimiter(garbage,false); scan_delimiter(garbage,false);
+@y
+ begin if SGML_mode then begin
+ scan_math(garbage); scan_math(garbage);
+ end
+ else begin
+ scan_delimiter(garbage,0); scan_delimiter(garbage,0);
+ end;
+@z
+%---------------------------------------
+@x [48] m.1184 l.22230 - Omega
+function fin_mlist(@!p:pointer):pointer;
+var q:pointer; {the mlist to return}
+begin if incompleat_noad<>null then @<Compleat the incompleat noad@>
+else begin link(tail):=p; q:=link(head);
+ end;
+pop_nest; fin_mlist:=q;
+end;
+@y
+function fin_mlist(@!p:pointer):pointer;
+var q,q1,q2:pointer; {the mlist to return}
+ tag:integer;
+begin if incompleat_noad<>null then @<Compleat the incompleat noad@>
+else begin link(tail):=p; q:=link(head);
+ end;
+if current_sgml_tag=0 then
+ tag:="mrow"
+else tag:=current_sgml_tag;
+pop_nest;
+if SGML_mode then
+ if q<>null then
+ if link(q)<>null then begin
+ q1:=new_sgml_node;
+ sgml_tag(q1):=tag;
+ sgml_info(q1):=q;
+ sgml_kind(q1):=sgml_math_node;
+ fin_mlist:=q1
+ end
+ else fin_mlist:=q
+ else fin_mlist:=q
+else
+ fin_mlist:=q;
+end;
+@z
+%---------------------------------------
+@x [48] m.1185 l.22256 - Omega
+@ @<Compleat...@>=
+begin math_type(denominator(incompleat_noad)):=sub_mlist;
+info(denominator(incompleat_noad)):=link(head);
+if p=null then q:=incompleat_noad
+else begin q:=info(numerator(incompleat_noad));
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+ end;
+end
+@y
+@ @<Compleat...@>=
+begin math_type(denominator(incompleat_noad)):=sub_mlist;
+info(denominator(incompleat_noad)):=link(head);
+if p=null then
+ if not SGML_mode then
+ q:=incompleat_noad
+ else begin
+ if link(info(numerator(incompleat_noad)))<>null then begin
+ q1:=new_sgml_node;
+ sgml_tag(q1):="mrow";
+ sgml_kind(q1):=sgml_math_node;
+ sgml_info(q1):=info(numerator(incompleat_noad));
+ end
+ else q1:=info(numerator(incompleat_noad));
+ if link(info(denominator(incompleat_noad)))<>null then begin
+ q2:=new_sgml_node;
+ sgml_tag(q2):="mrow";
+ sgml_kind(q2):=sgml_math_node;
+ sgml_info(q2):=info(denominator(incompleat_noad));
+ end
+ else q2:=info(denominator(incompleat_noad));
+ q:=new_sgml_node;
+ sgml_tag(q):="mfrac";
+ sgml_kind(q):=sgml_math_node;
+ sgml_info(q):=q1;
+ link(q1):=q2;
+ current_sgml_attrs:=null;
+ if thickness(incompleat_noad)<>default_code then
+ if thickness(incompleat_noad)=0 then
+ sgml_attribute("linethickness","0ex")
+ else if thickness(incompleat_noad)<default_rule_thickness then
+ sgml_attribute("linethickness","thin")
+ else if thickness(incompleat_noad)>default_rule_thickness then
+ sgml_attribute("linethickness","thick");
+ sgml_attrs(q):=current_sgml_attrs;
+ if (mem[left_delimiter(incompleat_noad)].int<>0) or
+ (mem[right_delimiter(incompleat_noad)].int<>0) then begin
+ q1:=q;
+ q:=new_sgml_node;
+ sgml_tag(q):="mrow";
+ sgml_kind(q):=sgml_math_node;
+ sgml_info(q):=mem[left_delimiter(incompleat_noad)].int;
+ link(mem[left_delimiter(incompleat_noad)].int):=q1;
+ link(q1):=mem[right_delimiter(incompleat_noad)].int;
+ end
+ end
+else begin q:=info(numerator(incompleat_noad));
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+ end;
+end
+@z
+%---------------------------------------
+@x [48] m.1186 l.22256 - Omega
+math_group: begin unsave; decr(save_ptr);@/
+ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
+ if p<>null then if link(p)=null then
+ if type(p)=ord_noad then
+ begin if math_type(subscr(p))=empty then
+ if math_type(supscr(p))=empty then
+ begin mem[saved(0)].hh:=mem[nucleus(p)].hh;
+ free_node(p,noad_size);
+ end;
+ end
+ else if type(p)=accent_noad then if saved(0)=nucleus(tail) then
+ if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>;
+ end;
+@y
+text_mml_group: begin
+ unsave; decr(save_ptr);
+ p:=saved(0);
+ sgml_info(p):=link(head);
+ pop_nest;
+ tail_append(p);
+ end;
+text_sgml_group: begin
+ print_err("Expecting closing tag </");
+ print(current_sgml_tag); print(">.");
+ print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end;
+vert_sgml_group: begin
+ print_err("Expecting closing tag </");
+ print(current_sgml_tag); print(">.");
+ print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end;
+par_sgml_group: begin
+ print_err("Expecting closing tag </");
+ print(current_sgml_tag); print(">.");
+ print_ln;
+ print_nl("The SGML translator cannot continue");
+ succumb;
+ end;
+math_mml_group: begin
+ unsave;
+ decr(save_ptr);
+ link(saved(0)):=link(head);
+ p:=saved(0);
+ pop_nest;
+ if type(p)=sgml_node then
+ if str_eq_str(sgml_tag(p),"mrow") then
+ if sgml_attrs(p)=null then begin
+ if link(sgml_info(p))=null then
+ p:=sgml_info(p);
+ end;
+ tail_append(p);
+ back_input;
+ end;
+math_group: begin unsave; decr(save_ptr);@/
+ if SGML_mode then
+ math_type(saved(0)):=sub_mlist
+ else
+ math_type(saved(0)):=sub_mlist;
+ p:=fin_mlist(null); info(saved(0)):=p;
+ if p<>null then if link(p)=null then
+ if type(p)=ord_noad then
+ begin if math_type(subscr(p))=empty then
+ if math_type(supscr(p))=empty then
+ begin mem[saved(0)].hh:=mem[nucleus(p)].hh;
+ free_node(p,noad_size);
+ end;
+ end
+ else if type(p)=accent_noad then if saved(0)=nucleus(tail) then
+ if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>;
+ end;
+font_entity_group: begin
+ unsave;
+ font_sort_number:=font_sort_ptr+1;
+ for font_sorts:=font_sort_base+1 to font_sort_ptr do
+ if str_eq_str(font_sort_name(font_sorts),saved(-1)) then begin
+ font_sort_number:=font_sorts;
+ break;
+ end;
+ font_sort_c:=saved(-2);
+ font_sort_char_entity(font_sort_number)(font_sort_c):=saved(-3);
+ font_sort_char_tag(font_sort_number)(font_sort_c):=saved(-4);
+ font_sort_char_attr(font_sort_number)(font_sort_c):=current_sgml_attrs;
+ current_sgml_attrs:=null;
+ save_ptr:=save_ptr-4; pop_nest;
+ end;
+empty_tag_group: begin
+ unsave; sgml_attrs(saved(-1)):=current_sgml_attrs;
+ decr(save_ptr); pop_nest;
+ end;
+@z
+%---------------------------------------
+@x [48] m.1191 l.22301 - Omega
+procedure math_left_right;
+var t:small_number; {|left_noad| or |right_noad|}
+@!p:pointer; {new noad}
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+ @<Try to recover from mismatched \.{\\right}@>
+else begin p:=new_noad; type(p):=t;
+ scan_delimiter(delimiter(p),false);
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
+ tail_append(new_noad); type(tail):=inner_noad;
+ math_type(nucleus(tail)):=sub_mlist;
+ info(nucleus(tail)):=p;
+ end;
+ end;
+end;
+@y
+procedure math_left_right;
+var t:small_number; {|left_noad| or |right_noad|}
+@!p,q,r:pointer; {new noad}
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+ @<Try to recover from mismatched \.{\\right}@>
+else begin p:=new_noad;
+ if SGML_mode then begin
+ scan_math(nucleus(p));
+ if t=left_noad then begin
+ saved(0):=p; incr(save_ptr);
+ push_math(math_left_group);
+ end
+ else begin
+ unsave;
+ decr(save_ptr);
+ q:=saved(0); r:=fin_mlist(null);
+ push_math(math_group);
+ tail_append(q); tail_append(r);
+ tail_append(p);
+ unsave;
+ p:=fin_mlist(null);
+ tail_append(p);
+ end
+ end
+ else begin
+ type(p):=t;
+ scan_delimiter(delimiter(p),false);
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
+ tail_append(new_noad); type(tail):=inner_noad;
+ math_type(nucleus(tail)):=sub_mlist;
+ info(nucleus(tail)):=p;
+ end;
+ end;
+ end;
+end;
+@z
+%---------------------------------------
+@x [48] m.1192 l.22284 - Omega
+begin if cur_group=math_shift_group then
+ begin scan_delimiter(garbage,false);
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ error;
+ end
+else off_save;
+end
+@y
+begin if cur_group=math_shift_group then
+ begin if SGML_mode then scan_math(garbage)
+ else scan_delimiter(garbage,0);
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ error;
+ end
+else off_save;
+end
+@z
+%---------------------------------------
+@x [48] m.1193 l.22327 - Omega
+mmode+math_shift: if cur_group=math_shift_group then after_math
+ else off_save;
+@y
+mmode+math_shift: if cur_group=math_mml_group then after_mml
+ else if cur_group=math_shift_group then after_math
+ else off_save;
+@z
+%---------------------------------------
+@x [48] m.1194 l.22284 - Omega
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural,info(math_dir_stack));
+ unsave; decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+ danger:=false;
+ @<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+ m:=mode; p:=fin_mlist(null);
+ end
+else a:=null;
+if m<0 then @<Finish math in text@>
+else begin if a=null then @<Check that another \.\$ follows@>;
+ @<Finish displayed math@>;
+ end;
+end;
+@y
+procedure after_mml;
+var p:pointer;
+begin
+unsave;
+decr(save_ptr);
+link(saved(0)):=link(head);
+p:=saved(0);
+pop_nest;
+tail_append(p);
+back_input;
+end;
+
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if SGML_mode then decr(MML_level);
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ if SGML_mode then begin
+ tmp_back_at_bol:=sgml_out_mlist(true,true,false)
+ end
+ else begin
+ mlist_to_hlist; a:=hpack(link(temp_head),natural,info(math_dir_stack));
+ end;
+ unsave; decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+ danger:=false;
+ @<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+ m:=mode; p:=fin_mlist(null);
+ end
+else a:=null;
+if m<0 then @<Finish math in text@>
+else begin if a=null then @<Check that another \.\$ follows@>;
+ @<Finish displayed math@>;
+ end;
+end;
+@z
+%---------------------------------------
+@x [49] m.1196 l.22388 - Omega
+@<Finish math in text@> =
+begin tail_append(new_math(math_surround,before));
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+tail_append(new_math(math_surround,after));
+space_factor:=1000; unsave;
+tmp_dir_stack:=math_dir_stack;
+math_dir_stack:=link(math_dir_stack);
+free_avail(tmp_dir_stack);
+end
+@y
+@<Finish math in text@>=
+begin
+if not SGML_mode then begin
+ tail_append(new_math(math_surround,before));
+ end;
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0);
+if SGML_mode then begin
+{
+ if MML_level=0 then tmp_back_at_bol:=sgml_out_mlist(true,true,false)
+ else tail_append(cur_mlist);
+}
+ sgml_starttexttag("inlinemath");
+ sgml_startmathtag("math");
+ tail_append(cur_mlist);
+ sgml_endmathtag("math");
+ sgml_endtexttag("inlinemath");
+ end
+else begin
+ mlist_to_hlist;
+ link(tail):=link(temp_head);
+ while link(tail)<>null do tail:=link(tail);
+ tail_append(new_math(math_surround,after));
+ end;
+space_factor:=1000; unsave;
+tmp_dir_stack:=math_dir_stack;
+math_dir_stack:=link(math_dir_stack);
+free_avail(tmp_dir_stack);
+end
+@z
+%---------------------------------------
+@x [49] m.1197 l.22430 - Omega
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+mlist_to_hlist; p:=link(temp_head);@/
+adjust_tail:=adjust_head; b:=hpack(p,natural,info(math_dir_stack));
+p:=list_ptr(b);
+t:=adjust_tail; adjust_tail:=null;@/
+w:=width(b); z:=display_width; s:=display_indent;
+if (a=null)or danger then
+ begin e:=0; q:=0;
+ end
+else begin e:=width(a); q:=e+math_quad(text_size);
+ end;
+if w+q>z then
+ @<Squeeze the equation as much as possible; if there is an equation
+ number that should go on a separate line by itself,
+ set~|e:=0|@>;
+@<Determine the displacement, |d|, of the left edge of the equation, with
+ respect to the line size |z|, assuming that |l=false|@>;
+@<Append the glue or equation number preceding the display@>;
+@<Append the display and perhaps also the equation number@>;
+@<Append the glue or equation number following the display@>;
+resume_after_display
+@y
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+if SGML_mode then begin
+{
+ if MML_level=0 then tmp_back_at_bol:=sgml_out_mlist(true,true,false)
+ else tail_append(cur_mlist);
+}
+ sgml_starttexttag("displaymath");
+ sgml_startmathtag("math");
+ tail_append(cur_mlist);
+ sgml_endmathtag("math");
+ sgml_endtexttag("displaymath");
+ end
+else begin
+ mlist_to_hlist; p:=link(temp_head);@/
+ adjust_tail:=adjust_head; b:=hpack(p,natural,info(math_dir_stack));
+ p:=list_ptr(b);
+ t:=adjust_tail; adjust_tail:=null;@/
+ w:=width(b); z:=display_width; s:=display_indent;
+ if (a=null)or danger then
+ begin e:=0; q:=0;
+ end
+ else begin e:=width(a); q:=e+math_quad(text_size);
+ end;
+ if w+q>z then
+ @<Squeeze the equation as much as possible; if there is an equation
+ number that should go on a separate line by itself,
+ set~|e:=0|@>;
+ @<Determine the displacement, |d|, of the left edge of the equation, with
+ respect to the line size |z|, assuming that |l=false|@>;
+ @<Append the glue or equation number preceding the display@>;
+ @<Append the display and perhaps also the equation number@>;
+ @<Append the glue or equation number following the display@>;
+ end;
+resume_after_display
+@z
+%---------------------------------------
+@x [49] m.1257 l.23269 - Omega
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+@y
+@!flushable_string:str_number; {string not yet referenced}
+@!cur_font_sort_name:str_number; {the name without the digits at the end}
+@!new_length:integer; {length of font name, to become font sort name}
+@!last_character:integer; {last character in font name}
+@!i:integer; {to run through characters of name}
+@!this_is_a_new_font:boolean;
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+this_is_a_new_font:=false;
+@z
+%---------------------------------------
+@x [49] m.1257 l.23290 - Omega
+common_ending: set_equiv(u,f);
+set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t);
+@y
+this_is_a_new_font:=true;
+common_ending: set_equiv(u,f);
+set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t);
+if this_is_a_new_font then
+ begin
+ if cur_name>=@"10000 then begin
+ new_length:=length(cur_name);
+ last_character:=str_pool[str_start(cur_name)+new_length-1];
+ while (last_character>="0") and (last_character<="9") do begin
+ decr(new_length);
+ last_character:=str_pool[str_start(cur_name)+new_length-1];
+ end;
+ for i:=1 to new_length do begin
+ append_char(str_pool[str_start(cur_name)+i-1]);
+ end;
+ cur_font_sort_name:=make_string;
+ font_sort_number:=font_sort_ptr+1;
+ for font_sorts:=font_sort_base+1 to font_sort_ptr do
+ if str_eq_str(font_sort_name(font_sorts),cur_font_sort_name) then begin
+ font_sort_number:=font_sorts;
+ break;
+ end;
+ font_name_sort(f):=font_sort_number;
+ if font_sort_number=(font_sort_ptr+1) then begin
+ incr(font_sort_ptr);
+ allocate_font_sort_table
+ (font_sort_ptr,
+ font_sort_offset_char_base+3*(font_ec(f)-font_bc(f)+1));
+ font_sort_file_size(font_sort_ptr):=
+ font_sort_offset_char_base+3*(font_ec(f)-font_bc(f)+1);
+ font_sort_name(font_sort_ptr):=cur_font_sort_name;
+ font_sort_ec(font_sort_ptr):=font_ec(f);
+ font_sort_bc(font_sort_ptr):=font_bc(f);
+ cur_name:=cur_font_sort_name;
+ cur_ext:=".onm";
+ pack_cur_name;
+ begin_file_reading;
+ if a_open_in(cur_file,kpse_tex_format) then begin
+ name:=a_make_name_string(cur_file);
+ print_ln; print("("); print(name);
+ @<Read the first line of the new file@>;
+ end
+ else end_file_reading;
+ end;
+ end;
+ end;
+@z
+%---------------------------------------
+@x [50] m.1320 l.23983 - Omega
+@ @<Dump the font information@>=
+@y
+@ @<Dump the font information@>=
+dump_int(font_sort_ptr);
+for k:=null_font_sort to font_sort_ptr do
+ dump_font_sort_table(k,font_sort_file_size(k));
+@z
+%---------------------------------------
+@x [50] m.1321 l.23993 - Omega
+@ @<Undump the font information@>=
+@y
+@ @<Undump the font information@>=
+undump_size(font_base)(font_max)('font sort max')(font_sort_ptr);
+for k:=null_font_sort to font_sort_ptr do
+ undump_font_sort_table(k);
+@z
+%---------------------------------------
+@x [51] m.1333 l.24244 - Omega
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+@y
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal;
+if not SGML_mode then begin @<Finish the \.{DVI} file@>; end;
+@z
+%---------------------------------------
diff --git a/Build/source/texk/web2c/omegafonts/Makefile.in b/Build/source/texk/web2c/omegafonts/Makefile.in
new file mode 100644
index 00000000000..b2c64dc4634
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/Makefile.in
@@ -0,0 +1,72 @@
+# Makefile for TeX-project WEB sources to C conversion programs.
+
+# These get expanded from the parent directory, not this one.
+kpse_include ../make/common.mk
+kpse_include ../make/programs.mk
+kpse_include ../make/paths.mk
+kpse_include kpathsea.mk
+
+LEX = @LEX@
+#LEXLIB = @LEXLIB@
+LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@
+YACC = @YACC@
+
+proglib = ../lib/lib.a
+programs = omfonts
+linked_programs = ofm2opl opl2ofm ovf2ovp ovp2ovf
+scripts =
+
+omfonts_objects = omfonts.o y_tab.o $(LEX_OUTPUT_ROOT).o \
+ char_routines.o dimen_routines.o error_routines.o \
+ header_routines.o ligkern_routines.o list_routines.o \
+ out_routines.o param_routines.o print_routines.o \
+ font_routines.o extra_routines.o out_ofm.o \
+ parse_ofm.o
+h_files = char_routines.h dimen_routines.h error_routines.h \
+ font_routines.h header_routines.h ligkern_routines.h \
+ list_routines.h out_routines.h param_routines.h print_routines.h \
+ extra_routines.h manifests.h parser.h out_ofm.h dvi.h \
+ parse_ofm.h omfonts.h
+
+all: $(programs)
+$(omfonts_objects): Makefile
+omfonts: $(omfonts_objects)
+ $(kpathsea_link) $(omfonts_objects) $(LEXLIB) $(LOADLIBES)
+
+omfonts.o: omfonts.c y_tab.h
+y_tab.c y_tab.h: pl.y
+ $(YACC) -d -v $(srcdir)/pl.y
+ -test -f y.tab.c && mv -f y.tab.c y_tab.c
+ -test -f y.tab.h && mv -f y.tab.h y_tab.h
+$(LEX_OUTPUT_ROOT).o: parser.h
+$(LEX_OUTPUT_ROOT).c: pl.l
+ $(LEX) $(srcdir)/pl.l
+
+
+
+$(programs): $(proglib) $(kpathsea)
+
+$(omfonts_objects): $(h_files)
+
+install: install-exec
+install-exec:: install-links
+
+install-programs: $(programs)
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(bindir)
+ for p in $(programs); do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+
+install-links: install-programs
+ for f in ""$(linked_programs); do \
+ cd $(bindir) && (rm -f $$f; $(LN) omfonts $$f); done
+
+Makefile: Makefile.in ../config.status
+ cd .. && $(SHELL) config.status
+
+kpse_include ../make/tkpathsea.mk
+kpse_include ../make/clean.mk
+
+clean::
+ rm -f y_tab.c y_tab.h y.out* yacc.* $(LEX_OUTPUT_ROOT).c
+
+kpse_include ../make/rdepend.mk
+kpse_include omegafonts/depend.mk
diff --git a/Build/source/texk/web2c/omegafonts/char_routines.c b/Build/source/texk/web2c/omegafonts/char_routines.c
new file mode 100644
index 00000000000..169479235cc
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/char_routines.c
@@ -0,0 +1,901 @@
+/* char_routines.c: Data structures for character information
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "manifests.h"
+#include "list_routines.h"
+#include "char_routines.h"
+#include "print_routines.h"
+#include "out_routines.h"
+#include "error_routines.h"
+#include "ligkern_routines.h"
+#include "dimen_routines.h"
+#include "header_routines.h"
+#include "font_routines.h"
+#include "out_ofm.h"
+#include "omfonts.h"
+#include "dvi.h"
+
+#define PLANE 0x10000
+#define HALFPLANE 0x08000
+
+#define MAX_START_OFM 65535
+#define MAX_START_TFM 255
+
+/*
+ * Characters can range from 0x0 to 0x7fffffff (31 bits unsigned),
+ * which is a lot of characters. We would expect characters to either
+ * be bunched up in a given region, or else sparsely defined throughout
+ * the range. The data structure to hold them is an array of HALFPLANE
+ * arrays, each of which holds a full PLANE (0x10000) of characters.
+ *
+ * At all times, init_character ensures that planes[0] to planes[plane_max]
+ * are either NULL or allocated arrays of PLANE characters.
+ *
+ * For allocated array p, init_character also ensures that planes[p][0]
+ * to planes[p][char_max[p]] are either NULL or pointers to allocated
+ * char_entry values.
+ *
+ * init_character can be called when actually reading a CHARACTER definition
+ * or when the character is referenced in a charlist cycle, an extensible
+ * piece or in a ligature/kerning table. In the latter case, ensure_existence
+ * is called, and it sets the defined field of the character to be FALSE;
+ *
+ * init_character also sets current_character to the character entry;
+ *
+ */
+
+unsigned bc=0x7fffffff;
+unsigned ec=0x0;
+unsigned ne=0;
+
+char_entry **planes[HALFPLANE];
+unsigned char_max[HALFPLANE];
+unsigned plane_max = 0;
+
+char_entry *current_character = NULL;
+char_entry *current_secondary_character = NULL;
+
+queue exten_queue;
+four_pieces **exten_table = NULL;
+
+unsigned no_labels = 0;
+label_entry *label_table;
+int label_ptr, sort_ptr;
+int lk_offset;
+boolean extra_loc_needed;
+
+extern unsigned bchar;
+
+void
+init_planes(void)
+{
+ plane_max = 0;
+ planes[plane_max] = NULL;
+ char_max[plane_max] = 0;
+}
+
+void
+init_character(unsigned c, char_entry *ready_made)
+{
+ register unsigned i, index, plane;
+
+ if ((c<CHAR_MINIMUM) || (c>CHAR_MAXIMUM)) {
+ warning_1("CHARACTER index (H %X) not 31-bit unsigned integer; "
+ "ignored", c);
+ current_character = NULL;
+ return;
+ }
+ plane = c / PLANE;
+ index = c % PLANE;
+ for (i=plane_max+1; i<=plane; i++) {
+ planes[plane] = NULL;
+ }
+ if (planes[plane]==NULL) {
+ planes[plane] = (char_entry **)xmalloc(PLANE * sizeof(char_entry *));
+ char_max[plane] = 0;
+ planes[plane][0] = NULL;
+ }
+ for (i=char_max[plane]+1; i<=index; i++) {
+ planes[plane][i] = NULL;
+ }
+ if (plane>plane_max) plane_max = plane;
+ if (index>char_max[plane]) char_max[plane] = index;
+
+ if (planes[plane][index] != NULL) {
+ if (planes[plane][index]->defined == FALSE) {
+ current_character = planes[plane][index];
+ current_character->defined = TRUE;
+ return;
+ }
+ warning_1("CHARACTER index (H %X) previously defined; "
+ "old definition ignored", c);
+ free(current_character);
+ current_character = NULL;
+ }
+ if (ready_made != NULL) {
+ current_character = ready_made;
+ planes[plane][index] = current_character;
+ } else {
+ current_character = (char_entry *)xmalloc(sizeof(char_entry));
+ planes[plane][index] = current_character;
+ for (i=C_MIN; i<=C_MAX; i++) {
+ current_character->indices[i] = NULL;
+ current_character->index_indices[i] = 0;
+ }
+ current_character->c = c;
+ current_character->copies = 0;
+ current_character->remainder = 0;
+ current_character->tag = TAG_NONE;
+ current_character->defined = TRUE;
+ current_character->accent = ACC_NONE;
+ current_character->ovf_packet_length = 0;
+ current_character->ovf_packet = NULL;
+ cur_packet = NULL;
+ }
+}
+
+void
+copy_characters(unsigned c, unsigned copies)
+{
+ unsigned i=0;
+ unsigned plane, index;
+ char_entry *the_entry;
+
+ if ((c<CHAR_MINIMUM) || (c>CHAR_MAXIMUM)) {
+ warning_1("CHARACTER index (H %X) not 31-bit unsigned integer; "
+ "ignored", c);
+ current_character = NULL;
+ return;
+ }
+ plane = c / PLANE;
+ index = c % PLANE;
+ if (planes[plane]==NULL)
+ internal_error_1("copy_characters (plane %d)", plane);
+ the_entry = planes[plane][index];
+ if (the_entry==NULL)
+ internal_error_1("copy_characters (index %d)", index);
+ the_entry->copies = copies;
+ for (i=(c+1); i<=(c+copies); i++)
+ init_character(i, the_entry);
+}
+
+void
+ensure_existence(unsigned c)
+{
+ register unsigned index, plane;
+ plane = c / PLANE;
+ index = c % PLANE;
+
+ if ((planes[plane]==NULL) || (planes[plane][index]==NULL)) {
+ init_character(c, NULL);
+ planes[plane][index]->defined = FALSE;
+ }
+ current_secondary_character = planes[plane][index];
+}
+
+#define FOR_ALL_CHARACTERS(FOR_ALL_CHARACTERS_ACTION) \
+ for (plane = 0; plane <=plane_max; plane++) { \
+ if (planes[plane] != NULL) { \
+ for (index = 0; index <=char_max[plane]; index++) { \
+ entry = planes[plane][index]; \
+ c = plane*PLANE + index; \
+ if (entry != NULL) { \
+ FOR_ALL_CHARACTERS_ACTION \
+ } \
+ } \
+ } \
+ }
+
+#define FOR_ALL_EXISTING_CHARACTERS(FOR_ALL_EXISTING_CHARACTERS_ACTION) \
+ FOR_ALL_CHARACTERS( \
+ if (entry->defined == TRUE) { \
+ FOR_ALL_EXISTING_CHARACTERS_ACTION \
+ } \
+ )
+
+void
+output_ovf_chars(void)
+{
+ register unsigned index, plane, c, k;
+ char_entry *entry;
+ fix wd;
+
+ FOR_ALL_EXISTING_CHARACTERS(
+ wd = lval(entry->indices[C_WD]);
+ if (design_units != UNITY)
+ wd = zround(((double)wd) / ((double)design_units) * 1048576.0);
+ if ((entry->ovf_packet_length>241) ||
+ (wd < 0) || (wd >= 0x1000000) ||
+ (c < 0) || (c >255)) {
+ out_ovf(242); out_ovf_4(entry->ovf_packet_length);
+ out_ovf_4(c); out_ovf_4(wd);
+ } else {
+ out_ovf(entry->ovf_packet_length); out_ovf(c);
+ out_ovf((wd >>16) & 0xff); out_ovf((wd >>8) & 0xff);
+ out_ovf(wd & 0xff);
+ }
+ for (k=0; k<entry->ovf_packet_length; k++)
+ out_ovf(entry->ovf_packet[k]);
+ )
+}
+
+
+void
+check_existence_all_character_fields(void)
+{
+ register unsigned index, plane, c;
+ char_entry *entry;
+ unsigned *exten;
+ unsigned j;
+
+ FOR_ALL_EXISTING_CHARACTERS(
+ switch(entry->tag) {
+ case TAG_NONE: { break; }
+ case TAG_LIG: {
+ check_ligature_program(c, entry->remainder);
+ break;
+ }
+ case TAG_LIST:{
+ check_existence_and_safety(c, entry->remainder, NULL,
+ "%sCharacter (H %X) NEXTLARGER than (H %X) "
+ "has no CHARACTER spec");
+ break;
+ }
+ case TAG_EXT:{
+ exten = entry->extens;
+ for (j=E_MIN; j<=E_MAX; j++) {
+ if (exten[j]!=0)
+ check_existence_and_safety(c, exten[j],
+ extensible_pieces[j],
+ "%s piece (H %X) of character (H %X) "
+ "has no CHARACTER spec");
+ }
+ break;
+ }
+ }
+ )
+}
+
+void
+clear_ligature_entries(void)
+{
+ register unsigned index, plane, c;
+ char_entry *entry;
+
+ FOR_ALL_EXISTING_CHARACTERS(
+ if (entry->tag == TAG_LIG) {
+ entry->tag = TAG_NONE;
+ entry->remainder = 0;
+ }
+ )
+}
+
+void
+check_existence_and_safety(unsigned c, unsigned g, string extra, string fmt)
+{
+ char_entry *gentry = planes[g/PLANE][g%PLANE];
+
+ if ((g<CHAR_MINIMUM) || (g>CHAR_MAXIMUM))
+ internal_error_1("check_existence_and_safety (g=%d)", g);
+ gentry = planes[g/PLANE][g%PLANE];
+ if ((g>=128) && (c<128))
+ seven_bit_calculated = 0;
+ if ((gentry==NULL) || (gentry->defined == FALSE)) {
+ warning_s_2(fmt, extra, g, c);
+ current_character = gentry;
+ set_character_measure(C_WD, 0);
+ }
+}
+
+void
+doublecheck_existence(unsigned g, string extra, char*fmt)
+{
+ char_entry *gentry = planes[g/PLANE][g%PLANE];
+
+ if ((g<CHAR_MINIMUM) || (g>CHAR_MAXIMUM))
+ internal_error_1("doublecheck_existence (g=%d)", g);
+ gentry = planes[g/PLANE][g%PLANE];
+ if ((gentry==NULL) || (gentry->defined == FALSE)) {
+ warning_s_1(fmt, extra, g);
+ current_character = gentry;
+/*
+ set_character_measure(C_WD, 0);
+*/
+ }
+}
+
+extern string character_measures[];
+
+void
+print_characters(boolean read_ovf)
+{
+ register unsigned index, plane, c;
+ char_entry *entry;
+ four_pieces *exten;
+ four_entries *lentry;
+ unsigned j,k;
+
+ FOR_ALL_CHARACTERS(
+ if (entry->index_indices[C_WD] != 0) {
+ print_character(c);
+ for (k=C_MIN; k<C_MAX; k++) {
+ if (entry->index_indices[k] != 0) {
+ print_character_measure(k,
+ dimen_tables[k][entry->index_indices[k]]);
+ }
+ }
+ fflush(file_output);
+ switch (entry->tag) {
+ case TAG_NONE: { break; }
+ case TAG_LIG: {
+ left();
+ out("COMMENT"); out_ln();
+ lentry = lig_kern_table + entry->remainder;
+ if (lentry->entries[0] > STOP_FLAG) {
+ lentry = lig_kern_table +
+ (256*lentry->entries[2]+lentry->entries[3]);
+ }
+ do {
+ print_one_lig_kern_entry(lentry, FALSE);
+ if (lentry->entries[0] >= STOP_FLAG) {
+ lentry = lig_kern_table + nl;
+ } else {
+ lentry = lentry + 1 + lentry->entries[0];
+ }
+ } while (lentry < (lig_kern_table + nl));
+ right();
+ break;
+ }
+ case TAG_LIST: {
+ print_next_larger(entry->remainder);
+ break;
+ }
+ case TAG_EXT: {
+ print_var_character();
+ exten = exten_table[entry->remainder];
+ for (j=E_MIN; j<=E_MAX; j++) {
+ if (exten->pieces[j]!=0)
+ print_extensible_piece(j,exten->pieces[j]);
+ }
+ right();
+ break;
+ }
+ }
+ if ((read_ovf==TRUE) && (entry->ovf_packet_length>0)) {
+ print_map();
+ print_packet(entry->ovf_packet, entry->ovf_packet_length);
+ right();
+ }
+ right();
+ fflush(file_output);
+ }
+ )
+}
+
+unsigned stack_top = 0;
+int wstack[1000];
+int xstack[1000];
+int ystack[1000];
+int zstack[1000];
+
+void
+print_packet(unsigned char *packet_start, unsigned packet_length)
+{
+ unsigned cmd, arg;
+ fix fix_arg, fix_arg1;
+ unsigned char *packet = packet_start;
+ unsigned char *max_packet = packet+packet_length;
+
+ stack_top = 0;
+ wstack[stack_top] = xstack[stack_top] =
+ ystack[stack_top] = zstack[stack_top] = 0;
+ while (packet <max_packet) {
+ if (*packet <= DVI_SET_CHAR_127) {
+ arg = *packet; packet++;
+ print_set_char(arg);
+ } else if ((*packet >= DVI_FNT_NUM_0) && (*packet <= DVI_FNT_NUM_63)) {
+ arg = *packet - DVI_FNT_NUM_0; packet++;
+ print_select_font(arg);
+ } else switch(*packet) {
+ case DVI_SET_1: case DVI_SET_2: case DVI_SET_3: case DVI_SET_4:
+ cmd = *packet; packet++;
+ arg = ovf_get_arg(&packet, cmd - DVI_SET_1 + 1, FALSE);
+ print_set_char(arg);
+ break;
+ case DVI_NOP:
+ packet++;
+ break;
+ case DVI_PUSH:
+ cmd = DVI_PUSH; packet++; stack_top++;
+ wstack[stack_top] = wstack[stack_top-1];
+ xstack[stack_top] = xstack[stack_top-1];
+ ystack[stack_top] = ystack[stack_top-1];
+ zstack[stack_top] = zstack[stack_top-1];
+ print_push();
+ break;
+ case DVI_POP:
+ cmd = DVI_PUSH; packet++; stack_top--;
+ print_pop();
+ break;
+ case DVI_SET_RULE:
+ cmd = DVI_SET_RULE; packet++; fix_arg = ovf_get_arg(&packet, 4, TRUE);
+ fix_arg1 = ovf_get_arg(&packet, 4, TRUE);
+ print_set_rule(fix_arg, fix_arg1);
+ break;
+ case DVI_PUT_RULE:
+ cmd = DVI_PUT_RULE; packet++; fix_arg = ovf_get_arg(&packet, 4, TRUE);
+ fix_arg1 = ovf_get_arg(&packet, 4, TRUE);
+ print_put_rule(fix_arg, fix_arg1);
+ break;
+ case DVI_RIGHT_1: case DVI_RIGHT_2: case DVI_RIGHT_3: case DVI_RIGHT_4:
+ cmd = *packet; packet++;
+ fix_arg = ovf_get_arg(&packet, cmd - DVI_RIGHT_1 + 1, TRUE);
+ print_move(M_RIGHT, fix_arg);
+ break;
+ case DVI_DOWN_1: case DVI_DOWN_2: case DVI_DOWN_3: case DVI_DOWN_4:
+ cmd = *packet; packet++;
+ fix_arg = ovf_get_arg(&packet, cmd - DVI_DOWN_1 + 1, TRUE);
+ print_move(M_DOWN, fix_arg);
+ break;
+ case DVI_W_0:
+ cmd = DVI_W_0; packet++;
+ print_move(M_RIGHT, wstack[stack_top]);
+ break;
+ case DVI_W_1: case DVI_W_2: case DVI_W_3: case DVI_W_4:
+ cmd = *packet; packet++;
+ wstack[stack_top] = ovf_get_arg(&packet, cmd - DVI_W_1 + 1, TRUE);
+ print_move(M_RIGHT, wstack[stack_top]);
+ break;
+ case DVI_X_0:
+ cmd = DVI_X_0; packet++;
+ print_move(M_RIGHT, xstack[stack_top]);
+ break;
+ case DVI_X_1: case DVI_X_2: case DVI_X_3: case DVI_X_4:
+ cmd = *packet; packet++;
+ xstack[stack_top] = ovf_get_arg(&packet, cmd - DVI_X_1 + 1, TRUE);
+ print_move(M_RIGHT, xstack[stack_top]);
+ break;
+ case DVI_Y_0:
+ cmd = DVI_Y_0; packet++;
+ print_move(M_DOWN, ystack[stack_top]);
+ break;
+ case DVI_Y_1: case DVI_Y_2: case DVI_Y_3: case DVI_Y_4:
+ cmd = *packet; packet++;
+ ystack[stack_top] = ovf_get_arg(&packet, cmd - DVI_Y_1 + 1, TRUE);
+ print_move(M_DOWN, ystack[stack_top]);
+ break;
+ case DVI_Z_0:
+ cmd = DVI_Z_0; packet++;
+ print_move(M_DOWN, zstack[stack_top]);
+ break;
+ case DVI_Z_1: case DVI_Z_2: case DVI_Z_3: case DVI_Z_4:
+ cmd = *packet; packet++;
+ zstack[stack_top] = ovf_get_arg(&packet, cmd - DVI_Z_1 + 1, TRUE);
+ print_move(M_DOWN, zstack[stack_top]);
+ break;
+ case DVI_PUT_1: case DVI_PUT_2: case DVI_PUT_3: case DVI_PUT_4:
+ cmd = *packet; packet++;
+ fix_arg = ovf_get_arg(&packet, cmd - DVI_PUT_1 + 1, FALSE);
+ print_put_char(fix_arg);
+ break;
+ case DVI_XXX_1: case DVI_XXX_2: case DVI_XXX_3: case DVI_XXX_4:
+ cmd = *packet; packet++;
+ fix_arg = ovf_get_arg(&packet, cmd - DVI_XXX_1 + 1, FALSE);
+ break;
+ case DVI_FNT_1: case DVI_FNT_2: case DVI_FNT_3: case DVI_FNT_4:
+ cmd = *packet; packet++;
+ fix_arg = ovf_get_arg(&packet, cmd - DVI_FNT_1 + 1, FALSE);
+ print_select_font(fix_arg);
+ break;
+ default:
+ internal_error_1("Unrecognized DVI packet (%d)\n", *packet);
+ }
+ }
+ fflush(file_output);
+ fflush(stderr);
+}
+
+void
+check_char_tag(unsigned c)
+{
+ ensure_existence(c);
+}
+
+void
+set_char_tag(unsigned c, unsigned tag)
+{
+ ensure_existence(c);
+ planes[c/PLANE][c%PLANE]->tag = tag;
+}
+
+void
+set_char_remainder(unsigned c, unsigned remainder)
+{
+ ensure_existence(c);
+ planes[c/PLANE][c%PLANE]->remainder = remainder;
+}
+
+int
+get_char_remainder(unsigned c)
+{
+ ensure_existence(c);
+ return planes[c/PLANE][c%PLANE]->remainder;
+}
+
+void
+set_next_larger(unsigned larger)
+{
+ check_char_tag(current_character->c);
+ set_char_tag(current_character->c, TAG_LIST);
+ set_char_remainder(current_character->c, larger);
+}
+
+void
+init_var_character(void)
+{
+ four_pieces *entry = (four_pieces *) xmalloc(sizeof(four_pieces));
+ unsigned j;
+
+ check_char_tag(current_character->c);
+ set_char_tag(current_character->c, TAG_EXT);
+ append_to_queue(&exten_queue, entry);
+ for (j=E_MIN; j<=E_MAX; j++) {
+ entry->pieces[j] = 0;
+ }
+ set_char_remainder(current_character->c, ne);
+ current_character->extens = (unsigned int *)entry->pieces;
+ ne++;
+}
+
+void
+set_extensible_piece(unsigned piece, unsigned val)
+{
+ unsigned *exten = current_character->extens;
+
+ if ((piece < E_MIN) || (piece > E_MAX))
+ internal_error_1("set_extensible_piece (piece=%d)", piece);
+ if (exten[piece]!=0)
+ warning_0("value already defined");
+ exten[piece] = val;
+}
+
+void
+adjust_labels(boolean play_with_starts)
+{
+ unsigned plane, index;
+ unsigned c;
+ char_entry *entry;
+ int max_start = (ofm_level==OFM_TFM) ? MAX_START_TFM : MAX_START_OFM;
+
+ label_table = (label_entry *)xmalloc((no_labels+2)*sizeof(label_entry));
+ label_ptr = 0;
+ label_table[0].rr = -1; /* sentinel */
+ FOR_ALL_CHARACTERS(
+ if ((c>=bc) && (c<=ec) && (entry->tag == TAG_LIG)) {
+ sort_ptr = label_ptr; /* hole at position sort_ptr+1 */
+ while (label_table[sort_ptr].rr > (int)(entry->remainder)) {
+ label_table[sort_ptr+1] = label_table[sort_ptr];
+ sort_ptr--; /* move the hole */
+ }
+ label_table[sort_ptr+1].cc = c;
+ label_table[sort_ptr+1].rr = entry->remainder;
+ label_ptr++;
+ }
+ )
+ if (play_with_starts) {
+ if (bchar != CHAR_BOUNDARY) {
+ extra_loc_needed = TRUE; lk_offset = 1;
+ } else {
+ extra_loc_needed = FALSE; lk_offset = 0;
+ }
+ sort_ptr = label_ptr; /* the largest unallocated label */
+ if ((label_table[sort_ptr].rr + lk_offset) > max_start) {
+ lk_offset=0; extra_loc_needed=FALSE;
+ /* location 0 can do double duty */
+ do {
+ set_char_remainder(label_table[sort_ptr].cc, lk_offset);
+ while (label_table[sort_ptr-1].rr == label_table[sort_ptr].rr) {
+ sort_ptr--;
+ set_char_remainder(label_table[sort_ptr].cc, lk_offset);
+ }
+ lk_offset++; sort_ptr--;
+ } while ((lk_offset+label_table[sort_ptr].rr) > max_start);
+ /* N.B. lk_offset=MAX_START+1 satisfies this when sort_ptr=0 */
+ }
+ if (lk_offset>0) {
+ while (sort_ptr>0) {
+ set_char_remainder(label_table[sort_ptr].cc,
+ get_char_remainder(label_table[sort_ptr].cc)
+ +lk_offset);
+ sort_ptr--;
+ }
+ }
+ }
+}
+
+void
+print_labels(void)
+{
+ unsigned i;
+
+ if (label_ptr>0) {
+ left(); out("COMMENT"); out_ln();
+ for (i=1; i<=label_ptr; i++) {
+ left(); out("LABEL_ENTRY"); out(" ");
+ out_int(i,10); out(" ");
+ out_char(label_table[i].cc); out(" ");
+ out_int(label_table[i].rr, 10); right();
+ }
+ right();
+ }
+}
+
+void
+check_and_correct(void)
+{
+ build_kern_table();
+ build_dimen_tables();
+ build_exten_table();
+ check_ligature_ends_properly();
+ compute_ofm_character_info();
+ adjust_labels(TRUE);
+ check_existence_all_character_fields();
+ calculate_seven_bit_safe_flag();
+ check_ligature_infinite_loops();
+ check_charlist_infinite_loops();
+ doublecheck_ligatures();
+ doublecheck_extens();
+}
+
+void
+check_charlist_infinite_loops(void)
+{
+ unsigned plane, index;
+ unsigned c;
+ char_entry *entry;
+ unsigned g;
+
+ FOR_ALL_CHARACTERS(
+ if (entry->tag == TAG_LIST) {
+ g = entry->remainder;
+ while ((g < c) && (planes[g/PLANE][g%PLANE]->tag == TAG_LIST)) {
+ g = planes[g/PLANE][g%PLANE]->remainder;
+ }
+ if (g == c) {
+ entry->tag = TAG_NONE;
+ entry->remainder = 0;
+ warning_1("Cycle of NEXTLARGER characters "
+ "has been broken at ",c);
+ }
+ }
+ )
+}
+
+void
+build_exten_table(void)
+{
+ list L1 = exten_queue.front, L2;
+ unsigned i = 0;
+
+ exten_table = (four_pieces **) xmalloc(ne*sizeof(four_pieces *));
+ while (L1 != NULL) {
+ exten_table[i] = (four_pieces *)L1->contents;
+ L2 = L1->ptr;
+ free(L1); L1 = L2;
+ i++;
+ }
+}
+
+void
+retrieve_exten_table(unsigned char *table)
+{
+ unsigned i = 0, j;
+ four_pieces *entry;
+
+ exten_table = (four_pieces **) xmalloc(ne*sizeof(four_pieces *));
+ for (i=0; i<ne; i++) {
+ exten_table[i] = entry = (four_pieces *) xmalloc(sizeof(four_pieces));
+ for (j=E_MIN; j<=E_MAX; j++) {
+ if (ofm_level==OFM_TFM) {
+ entry->pieces[j] = table[4*i+j] & 0xff;
+ } else {
+ entry->pieces[j] =
+ ((table[8*i+j*2] & 0xff) << 8) |
+ (table[8*i+j*2+1] & 0xff);
+ }
+ }
+ }
+}
+
+void
+print_extens(void)
+{
+ unsigned i,j;
+
+ if (ne>0) {
+ left(); out("COMMENT"); out_ln();
+ for (i=0; i<ne; i++) {
+ left(); out("EXTEN_ENTRY");
+ out(" "); out_int(i,10); out_ln();
+ for (j=E_MIN; j<=E_MAX; j++) {
+ if (exten_table[i]->pieces[j] != 0)
+ print_extensible_piece(j,exten_table[i]->pieces[j]);
+ }
+ right();
+ }
+ right();
+ }
+}
+
+void
+doublecheck_extens(void)
+{
+ unsigned i,j;
+
+ if (ne>0) {
+ for (i=0; i<ne; i++) {
+ for (j=E_MIN; j<=E_MAX; j++) {
+ if (exten_table[i]->pieces[j] != 0)
+ doublecheck_existence(
+ exten_table[i]->pieces[j], extensible_pieces[j],
+ "Unused %s piece (H %X) refers to "
+ "nonexistent character");
+ }
+ }
+ }
+}
+
+void
+compute_ligkern_offset(void)
+{
+}
+
+void
+compute_character_info_size(void)
+{
+}
+
+void
+output_ofm_extensible(void)
+{
+ unsigned i,j;
+
+ for (i=0; i<ne; i++) {
+ for (j=E_MIN; j<=E_MAX; j++) {
+ if (exten_table[i]->pieces[j] != 0)
+ out_ofm_char(exten_table[i]->pieces[j]);
+ else out_ofm_char(0);
+ }
+ }
+}
+
+void
+compute_ofm_character_info(void)
+{
+ unsigned plane, index;
+ unsigned c;
+ char_entry *entry;
+
+ bc = 0x7fffffff; ec=0;
+ switch (ofm_level) {
+ case OFM_TFM: {
+ FOR_ALL_EXISTING_CHARACTERS(
+ if (c < bc) bc = c;
+ if (c > ec) ec = c;
+ )
+ break;
+ }
+ case OFM_LEVEL0: {
+ FOR_ALL_EXISTING_CHARACTERS(
+ if (c < bc) bc = c;
+ if (c > ec) ec = c;
+ )
+ break;
+ }
+/* Level 1 only uses plane 0. Take advantage of this fact. */
+ case OFM_LEVEL1: {
+ FOR_ALL_CHARACTERS(
+ if (c < bc) bc = c;
+ if (c > ec) ec = c;
+ )
+ break;
+ }
+ default: { internal_error_0("compute_ofm_character_info"); }
+ }
+}
+
+void
+output_ofm_character_info(void)
+{
+ unsigned plane, index;
+ unsigned c;
+ char_entry *entry;
+ unsigned wd, ht, dp, ic;
+
+ switch (ofm_level) {
+ case OFM_TFM: {
+ plane=0;
+ for (index = bc; index <=ec; index++) {
+ entry = planes[plane][index];
+ c = plane*PLANE + index;
+ if (entry == NULL) {
+ out_ofm_4(0);
+ } else {
+ if (entry->indices[C_WD] != NULL)
+ wd = entry->indices[C_WD]->index;
+ else wd = 0;
+ if (entry->indices[C_HT] != NULL)
+ ht = entry->indices[C_HT]->index;
+ else ht = 0;
+ if (entry->indices[C_DP] != NULL)
+ dp = entry->indices[C_DP]->index;
+ else dp = 0;
+ if (entry->indices[C_IC] != NULL)
+ ic = entry->indices[C_IC]->index;
+ else ic = 0;
+ out_ofm(wd);
+ out_ofm(ht*16 + dp);
+ out_ofm(ic*4 + entry->tag);
+ out_ofm(entry->remainder);
+ }
+ }
+ break;
+ }
+ case OFM_LEVEL0: {
+ plane=0;
+ for (index = bc; index <=ec; index++) {
+ entry = planes[plane][index];
+ c = plane*PLANE + index;
+ if (entry == NULL) {
+ out_ofm_4(0); out_ofm_4(0);
+ } else {
+ if (entry->indices[C_WD] != NULL)
+ wd = entry->indices[C_WD]->index;
+ else wd = 0;
+ if (entry->indices[C_HT] != NULL)
+ ht = entry->indices[C_HT]->index;
+ else ht = 0;
+ if (entry->indices[C_DP] != NULL)
+ dp = entry->indices[C_DP]->index;
+ else dp = 0;
+ if (entry->indices[C_IC] != NULL)
+ ic = entry->indices[C_IC]->index;
+ else ic = 0;
+ out_ofm_2(wd);
+ out_ofm(ht);
+ out_ofm(dp);
+ out_ofm(ic);
+ out_ofm(entry->tag);
+ out_ofm_2(entry->remainder);
+ }
+ }
+ break;
+ }
+ case OFM_LEVEL1: {
+ internal_error_0("OFM level 1 not currently supported");
+ break;
+ }
+ default: { internal_error_0("compute_ofm_character_info"); }
+ }
+}
diff --git a/Build/source/texk/web2c/omegafonts/char_routines.h b/Build/source/texk/web2c/omegafonts/char_routines.h
new file mode 100644
index 00000000000..bc8665f49eb
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/char_routines.h
@@ -0,0 +1,91 @@
+/* char_routines.h: Data structures for character information
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+typedef struct char_entry_struct {
+ in_list indices[C_MAX+1];
+ unsigned index_indices[C_MAX+1];
+ unsigned c;
+ unsigned copies;
+ unsigned tag;
+ unsigned remainder;
+ unsigned defined;
+ unsigned accent;
+ unsigned *extens;
+ unsigned ovf_packet_length;
+ unsigned char *ovf_packet;
+} char_entry;
+
+extern char_entry *current_character;
+extern char_entry *current_secondary_character;
+
+extern void print_characters(boolean);
+extern void init_character(unsigned, char_entry *);
+extern void copy_characters(unsigned, unsigned);
+extern void init_planes(void);
+
+extern void ensure_existence(unsigned);
+extern void check_char_tag(unsigned);
+extern void set_char_tag(unsigned,unsigned);
+extern void set_char_remainder(unsigned,unsigned);
+extern void set_next_larger(unsigned);
+extern void init_var_character(void);
+
+typedef struct label_entry_struct {
+ int rr;
+ int cc;
+} label_entry;
+
+extern unsigned no_labels;
+extern label_entry *label_table;
+extern int label_ptr, sort_ptr;
+extern int lk_offset;
+extern boolean extra_loc_needed;
+
+
+extern void check_and_correct(void);
+extern void finalize_dimension_lists(void);
+extern void check_existence_all_character_fields(void);
+extern void check_charlist_infinite_loops(void);
+
+extern void adjust_labels(boolean);
+extern void print_labels(void);
+extern void set_extensible_piece(unsigned,unsigned);
+extern void check_existence_and_safety(unsigned,unsigned,string,string);
+extern void clear_ligature_entries(void);
+extern void doublecheck_extens(void);
+extern void print_extens(void);
+extern void build_exten_table(void);
+extern void retrieve_exten_table(unsigned char *);
+extern void doublecheck_existence(unsigned, string,string);
+extern void output_ovf_chars(void);
+extern void print_packet(unsigned char *, unsigned);
+
+extern unsigned bc;
+extern unsigned ec;
+extern unsigned ne;
+
+extern void compute_ligkern_offset(void);
+extern void compute_character_info_size(void);
+extern void output_ofm_extensible(void);
+extern void compute_ofm_character_info(void);
+extern void output_ofm_character_info(void);
diff --git a/Build/source/texk/web2c/omegafonts/depend.mak b/Build/source/texk/web2c/omegafonts/depend.mak
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/depend.mak
diff --git a/Build/source/texk/web2c/omegafonts/dimen_routines.c b/Build/source/texk/web2c/omegafonts/dimen_routines.c
new file mode 100644
index 00000000000..a4f5a1360ab
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/dimen_routines.c
@@ -0,0 +1,324 @@
+/* dimen_routines.c: Data structures for holding widths, heights, etc.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "list_routines.h"
+#include "manifests.h"
+#include "header_routines.h"
+#include "dimen_routines.h"
+#include "char_routines.h"
+#include "out_routines.h"
+#include "error_routines.h"
+#include "out_ofm.h"
+#include "parse_ofm.h"
+#include "omfonts.h"
+
+int *measure_max_entries;
+int TFM_measure_max_entries[] =
+ {256,16,16,64, 0,0,0,0,
+ 0,0,0,0, 0,0,0,0,
+ 0,0,0,0, 0,0,0,0};
+int OFM0_measure_max_entries[] =
+ {65536,256,256,256, 0,0,0,0,
+ 0,0,0,0, 0,0,0,0,
+ 0,0,0,0, 0,0,0,0};
+int OFM2_measure_max_entries[] =
+ {256,256,256,256, 256,256,256,256,
+ 256,256,256,256, 256,256,256,0,
+ 256,256,256,256, 256,256,256,0};
+
+in_list measure_list[C_MAX+1];
+int measure_max[C_MAX+1];
+int *dimen_tables[C_MAX+1];
+unsigned char *measure_base[C_MAX+1];
+
+unsigned nw=0;
+unsigned nh=0;
+unsigned nd=0;
+unsigned ni=0;
+
+void
+init_measures(void)
+{
+ register int i;
+ for (i=C_MIN; i<=C_MAX; i++) {
+ measure_list[i] = in_list1(INFINITY, NULL);
+ measure_max[i] = 0;
+ }
+}
+
+void
+set_character_measure(int index, int val)
+{
+ in_list L1, L2, *the_list;
+
+ if ((index < C_MIN) || (index > C_MAX)) {
+ internal_error_1("set_character_measure (index=%d)", index);
+ return;
+ }
+ the_list = measure_list+index;
+ L1 = *the_list;
+ if (L1 == NULL) {
+ internal_error_0("set_character_measure (L1)");
+ } else {
+ L2 = L1->ptr;
+ while ((L2 != NULL) && (lval(L2) <= val)) {
+ L1 = L2;
+ L2 = L2->ptr;
+ }
+ if (val < lval(L1)) {
+ *the_list = in_list1(val, NULL);
+ (*the_list)->ptr = L1;
+ (*the_list)->actual = *the_list;
+ measure_max[index]++;
+ current_character->indices[index] = *the_list;
+ } else if (val == lval(L1)) {
+ current_character->indices[index] = L1;
+ } else {
+ L2 = in_list1(val, NULL);
+ L2->ptr = L1->ptr;
+ L2->actual = L2;
+ L1->ptr = L2;
+ measure_max[index]++;
+ current_character->indices[index] = L2;
+ }
+ }
+ /* print_measures(); */
+}
+
+void
+print_measures(void)
+{
+ in_list L;
+ register int i,j;
+
+ for (i=C_MIN; i<=C_MAX; i++) {
+ L = measure_list[i];
+ if (L!=NULL) {
+ j=0;
+ out_character_measure(i);
+ fprintf(stdout, ":\n");
+ while (L != NULL) {
+ fprintf(stdout, " %d: ", j++);
+ out_fix(lval(L));
+ fprintf(stdout, "\n");
+ L = L->ptr;
+ }
+ fprintf(stdout, "\n");
+ }
+ }
+ fprintf(stdout, "--------------------------------\n");
+}
+
+
+int next_d;
+int excess;
+int delta;
+
+int
+min_cover(int h, int d)
+{
+ in_list L = measure_list[h];
+ int m=0; /* the current size of the cover being generated */
+ int l; /* the least element covered by the current interval */
+
+ m = 0; next_d = INFINITY;
+ while (lval(L) != INFINITY) {
+ m++; l = lval(L);
+ while (lval(L->ptr) <= (l+d)) L = L->ptr;
+ L = L->ptr;
+ if ((lval(L) - l) < next_d) next_d = lval(L) - l;
+ }
+ return m;
+}
+
+/* finds best way to round */
+
+int
+shorten(int h, int m)
+{
+ int d=0; /* the current trial interval length */
+ int k; /* the size of a minimum cover */
+ int M = measure_max[h];
+
+ if (M>m) {
+ excess = M-m;
+ k = min_cover(h,0); d = next_d;
+ /* now the answer is at least d*/
+ /* first we ascend rapidly until finding the range */
+ do {
+ d = d+d; k = min_cover(h,d);
+ } while (k>m);
+ /* now we run through the feasible steps */
+ d = d/2; k=min_cover(h,d);
+ while (k>m) {
+ d = next_d; k = min_cover(h,d);
+ }
+ }
+ return d;
+}
+
+/* reduces and indexes a list */
+
+void
+set_indices(int h, int d)
+{
+ in_list L1; /* the current node of interest */
+ in_list L2; /* trails one step behind L1 */
+ int l; /* least value in the current interval */
+ int lprime; /* middle value for current interval */
+ int m; /* index number of nodes in the current interval */
+
+/* How to store the information for each character ? */
+ L1 = measure_list[h]; m = 0;
+ while (lval(L1) != INFINITY) {
+ L2 = L1;
+ m++; l = lval(L1);
+ L1->index = m;
+ while (lval(L1->ptr) <= (l+d)) {
+ L1 = L1->ptr; excess--;
+ if (excess==0) d = 0;
+ }
+ lprime = l + (lval(L1)-l) / 2;
+ lval(L1) = lprime;
+ while (L2 != L1) {
+ lval(L2) = lprime;
+ L2->actual = L1;
+ L2->index = m;
+ L2 = L2->ptr;
+ }
+ L1 = L1->ptr; L2 = L1;
+ }
+ measure_max[h] = m;
+}
+
+void
+build_dimen_tables(void)
+{
+ int delta;
+ in_list L1;
+ int i,j;
+
+ switch(ofm_level) {
+ case OFM_TFM:
+ measure_max_entries = TFM_measure_max_entries;
+ break;
+ case OFM_LEVEL0: case OFM_LEVEL1:
+ measure_max_entries = OFM0_measure_max_entries;
+ break;
+ default:
+ measure_max_entries = OFM2_measure_max_entries;
+ }
+ for (i=C_MIN; i<=C_MAX; i++) {
+ if (measure_max_entries[i] != 0) {
+ delta=shorten(i,measure_max_entries[i]);
+ set_indices(i,delta);
+ dimen_tables[i] = (int *) malloc((measure_max[i]+1)*sizeof(int));
+ L1 = measure_list[i];
+ j=0;
+ while (lval(L1) != INFINITY) {
+ L1 = L1->actual;
+ dimen_tables[i][j] = lval(L1);
+ L1 = L1->ptr;
+ j++;
+ }
+ }
+ }
+ nw = measure_max[C_WD];
+ nh = measure_max[C_HT];
+ nd = measure_max[C_DP];
+ ni = measure_max[C_IC];
+}
+
+void
+retrieve_dimen_tables(void)
+{
+ unsigned i, j;
+ unsigned char *k;
+
+ measure_max[C_WD] = nw;
+ measure_max[C_HT] = nh;
+ measure_max[C_DP] = nd;
+ measure_max[C_IC] = ni;
+ measure_base[C_WD] = ofm+width_base*4;
+ measure_base[C_HT] = ofm+height_base*4;
+ measure_base[C_DP] = ofm+depth_base*4;
+ measure_base[C_IC] = ofm+italic_base*4;
+ for (i=C_IC+1; i<=C_MAX; i++) {
+ measure_max[i] = 0;
+ dimen_tables[i] = NULL;
+ }
+ for (i=C_MIN; i<=C_MAX; i++) {
+ dimen_tables[i] = (int *) malloc((measure_max[i]+1)*sizeof(int));
+ for (j=0; j<measure_max[i]; j++) {
+ k = measure_base[i]+4*j;
+ dimen_tables[i][j] = (((*k)&0xff) << 24) |
+ (((*(k+1))&0xff) << 16) |
+ (((*(k+2))&0xff) << 8) |
+ ((*(k+3))&0xff);
+ }
+ }
+}
+
+void
+print_dimen_tables(void)
+{
+ int i, j;
+
+ for (i=C_MIN; i<=C_MAX; i++) {
+ if (measure_max[i] != 0) {
+ left(); out("COMMENT"); out_ln();
+ for (j=0; j<measure_max[i]; j++) {
+ left();
+ out_character_measure(i); out("_ENTRY");
+ out(" "); out_int(j,10);
+ out(" "); out_fix(dimen_tables[i][j]);
+ right();
+ }
+ right();
+ }
+ }
+}
+
+void
+set_accent(unsigned kind)
+{
+ if ((kind<ACC_TOP) || (kind>ACC_BOT)) {
+ warning_0("bad ACCENT value; ignored");
+ kind = ACC_NONE;
+ }
+ current_character->accent = kind;
+}
+
+void
+output_ofm_dimension(void)
+{
+ int i, j;
+
+ for (i=C_WD; i<=C_IC; i++) {
+ out_ofm_4(0);
+ for (j=0; j<measure_max[i]; j++) {
+ out_ofm_4(dimen_tables[i][j]);
+ }
+ }
+}
diff --git a/Build/source/texk/web2c/omegafonts/dimen_routines.h b/Build/source/texk/web2c/omegafonts/dimen_routines.h
new file mode 100644
index 00000000000..a3894cf7f9a
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/dimen_routines.h
@@ -0,0 +1,38 @@
+/* dimen_routines.h: Data structures for holding widths, heights, etc.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+extern int *dimen_tables[];
+
+extern void set_character_measure(int, int);
+extern void print_measures(void);
+extern void init_measures(void);
+extern void build_dimen_tables(void);
+extern void retrieve_dimen_tables(void);
+extern void print_dimen_tables(void);
+extern void set_accent(unsigned);
+extern void output_ofm_dimension(void);
+
+extern unsigned nw;
+extern unsigned nh;
+extern unsigned nd;
+extern unsigned ni;
diff --git a/Build/source/texk/web2c/omegafonts/dvi.h b/Build/source/texk/web2c/omegafonts/dvi.h
new file mode 100644
index 00000000000..8c9eb5b8265
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/dvi.h
@@ -0,0 +1,93 @@
+/* dvi.h: All of the DVI commands
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+/* VF commands */
+
+#define VF_ID 202 /* the second byte of a VF file */
+#define VF_LONG_CHAR 242 /* long format for character packets */
+
+/* DVI commands */
+
+#define DVI_SET_CHAR_0 0 /* typeset character 0 and move right */
+#define DVI_SET_CHAR_127 127 /* ... to 127 */
+#define DVI_SET_1 128 /* typeset a char (1 byte) and move right */
+#define DVI_SET_2 129 /* typeset a char (2 bytes) and move right */
+#define DVI_SET_3 130 /* typeset a char (3 bytes) and move right */
+#define DVI_SET_4 131 /* typeset a char (4 bytes) and move right */
+#define DVI_SET_RULE 132 /* typeset a rule and move right */
+#define DVI_PUT_1 133 /* typeset a char (1 byte) and stay put */
+#define DVI_PUT_2 134 /* typeset a char (2 bytes) and stay put */
+#define DVI_PUT_3 135 /* typeset a char (3 bytes) and stay put */
+#define DVI_PUT_4 136 /* typeset a char (4 bytes) and stay put */
+#define DVI_PUT_RULE 137 /* typeset a rule and stay put */
+#define DVI_NOP 138 /* no-op */
+#define DVI_BOP 139 /* beginning of page */
+#define DVI_EOP 140 /* end of page */
+#define DVI_PUSH 141 /* save the current positions */
+#define DVI_POP 142 /* restore previous positions */
+#define DVI_RIGHT_1 143 /* move right (1 byte) */
+#define DVI_RIGHT_2 144 /* move right (2 bytes) */
+#define DVI_RIGHT_3 145 /* move right (3 bytes) */
+#define DVI_RIGHT_4 146 /* move right (4 bytes) */
+#define DVI_W_0 147 /* move right by |w| */
+#define DVI_W_1 148 /* move right and set |w| (1 byte) */
+#define DVI_W_2 149 /* move right and set |w| (2 bytes) */
+#define DVI_W_3 150 /* move right and set |w| (3 bytes) */
+#define DVI_W_4 151 /* move right and set |w| (4 bytes) */
+#define DVI_X_0 152 /* move right by |x| */
+#define DVI_X_1 153 /* move right and set |x| (1 byte) */
+#define DVI_X_2 154 /* move right and set |x| (2 bytes) */
+#define DVI_X_3 155 /* move right and set |x| (3 bytes) */
+#define DVI_X_4 156 /* move right and set |x| (4 bytes) */
+#define DVI_DOWN_1 157 /* move down (1 byte) */
+#define DVI_DOWN_2 158 /* move down (2 bytes) */
+#define DVI_DOWN_3 159 /* move down (3 bytes) */
+#define DVI_DOWN_4 160 /* move down (4 bytes) */
+#define DVI_Y_0 161 /* move down by |y| */
+#define DVI_Y_1 162 /* move down and set |y| (1 byte) */
+#define DVI_Y_2 163 /* move down and set |y| (2 bytes) */
+#define DVI_Y_3 164 /* move down and set |y| (3 bytes) */
+#define DVI_Y_4 165 /* move down and set |y| (4 bytes) */
+#define DVI_Z_0 166 /* move down by |z| */
+#define DVI_Z_1 167 /* move down and set |z| (1 byte) */
+#define DVI_Z_2 168 /* move down and set |z| (2 bytes) */
+#define DVI_Z_3 169 /* move down and set |z| (3 bytes) */
+#define DVI_Z_4 170 /* move down and set |z| (4 bytes) */
+#define DVI_FNT_NUM_0 171 /* set current font to 0 */
+#define DVI_FNT_NUM_63 234 /* ... to 234 */
+#define DVI_FNT_1 235 /* set current font (1 byte) */
+#define DVI_FNT_2 236 /* set current font (2 bytes) */
+#define DVI_FNT_3 237 /* set current font (3 bytes) */
+#define DVI_FNT_4 238 /* set current font (4 bytes) */
+#define DVI_XXX_1 239 /* extension to DVI primitives (1 byte) */
+#define DVI_XXX_2 240 /* extension to DVI primitives (2 bytes) */
+#define DVI_XXX_3 241 /* extension to DVI primitives (3 bytes) */
+#define DVI_XXX_4 242 /* extension to DVI primitives (4 bytes) */
+#define DVI_FNT_DEF_1 243 /* declare font (1 byte) */
+#define DVI_FNT_DEF_2 244 /* declare font (2 bytes) */
+#define DVI_FNT_DEF_3 245 /* declare font (3 bytes) */
+#define DVI_FNT_DEF_4 246 /* declare font (4 bytes) */
+#define DVI_PRE 247 /* preamble */
+#define DVI_POST 248 /* postamble beginning */
+#define DVI_POST_POST 249 /* postamble ending */
+
diff --git a/Build/source/texk/web2c/omegafonts/error_routines.c b/Build/source/texk/web2c/omegafonts/error_routines.c
new file mode 100644
index 00000000000..dfb234cb539
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/error_routines.c
@@ -0,0 +1,184 @@
+/* error_routines.c: General error routines.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "parser.h"
+
+/* Error routines:
+
+All of the routines in this file have the same general format.
+They
+
+*/
+
+void
+lex_error_0(string fmt)
+{
+ fprintf(stderr, "line %d (lexing): ", line_number);
+ fprintf(stderr, fmt);
+ fprintf(stderr, "\n");
+}
+
+void
+lex_error_1(string fmt, int item)
+{
+ fprintf(stderr, "line %d (lexing): ", line_number);
+ fprintf(stderr, fmt, item);
+ fprintf(stderr, "\n");
+}
+
+void
+lex_error_s(string fmt, string item)
+{
+ fprintf(stderr, "line %d (lexing): ", line_number);
+ fprintf(stderr, fmt, item);
+ fprintf(stderr, "\n");
+}
+
+void
+lex_error_s_1(string fmt, string item, int item1)
+{
+ fprintf(stderr, "line %d (lexing): ", line_number);
+ fprintf(stderr, fmt, item, item1);
+ fprintf(stderr, "\n");
+}
+
+void
+yyerror(string fmt)
+{
+ fprintf(stderr, "line %d (parsing): ", line_number);
+ fprintf(stderr, fmt);
+ fprintf(stderr, "\n");
+}
+
+
+void
+warning_0(string fmt)
+{
+ fprintf(stderr, "line %d (warning): ", line_number);
+ fprintf(stderr, fmt);
+ fprintf(stderr, "\n");
+}
+
+void
+warning_1(string fmt, int item)
+{
+ fprintf(stderr, "line %d (warning): ", line_number);
+ fprintf(stderr, fmt, item);
+ fprintf(stderr, "\n");
+}
+
+void
+warning_2(string fmt, int item, int item2)
+{
+ fprintf(stderr, "line %d (warning): ", line_number);
+ fprintf(stderr, fmt, item, item2);
+ fprintf(stderr, "\n");
+}
+
+void
+warning_s(string fmt, string item)
+{
+ fprintf(stderr, "line %d (warning): ", line_number);
+ fprintf(stderr, fmt, item);
+ fprintf(stderr, "\n");
+}
+
+void
+warning_s_1(string fmt, string item, int item1)
+{
+ fprintf(stderr, "line %d (warning): ", line_number);
+ fprintf(stderr, fmt, item, item1);
+ fprintf(stderr, "\n");
+}
+
+void
+warning_s_2(string fmt, string item, int item1, int item2)
+{
+ fprintf(stderr, "line %d (warning): ", line_number);
+ fprintf(stderr, fmt, item, item1, item2);
+ fprintf(stderr, "\n");
+}
+
+void
+fatal_error_0(string fmt)
+{
+ fprintf(stderr, "line %d (fatal): ", line_number);
+ fprintf(stderr, fmt);
+ fprintf(stderr, "\n");
+ exit(1);
+}
+
+void
+fatal_error_1(string fmt, int item)
+{
+ fprintf(stderr, "line %d (fatal): ", line_number);
+ fprintf(stderr, fmt, item);
+ fprintf(stderr, "\n");
+ exit(1);
+}
+
+void
+fatal_error_2(string fmt, int item, int item2)
+{
+ fprintf(stderr, "line %d (fatal): ", line_number);
+ fprintf(stderr, fmt, item, item2);
+ fprintf(stderr, "\n");
+ exit(1);
+}
+
+void
+fatal_error_s(string fmt, string item)
+{
+ fprintf(stderr, "line %d (fatal): ", line_number);
+ fprintf(stderr, fmt, item);
+ fprintf(stderr, "\n");
+ exit(1);
+}
+
+void
+internal_error_0(string fmt)
+{
+ fprintf(stderr, "line %d (internal): ", line_number);
+ fprintf(stderr, fmt);
+ fprintf(stderr, "\n");
+ exit(2);
+}
+
+void
+internal_error_1(string fmt, int item)
+{
+ fprintf(stderr, "line %d (internal): ", line_number);
+ fprintf(stderr, fmt, item);
+ fprintf(stderr, "\n");
+ exit(2);
+}
+
+void
+internal_error_s(string fmt, string item)
+{
+ fprintf(stderr, "line %d (internal): ", line_number);
+ fprintf(stderr, fmt, item);
+ fprintf(stderr, "\n");
+ exit(2);
+}
diff --git a/Build/source/texk/web2c/omegafonts/error_routines.h b/Build/source/texk/web2c/omegafonts/error_routines.h
new file mode 100644
index 00000000000..6bd09db62f9
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/error_routines.h
@@ -0,0 +1,47 @@
+/* error_routines.h: General error routines.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+extern void lex_error_0(string);
+extern void lex_error_1(string, int);
+extern void lex_error_s(string, string);
+extern void lex_error_s_1(string, string, int);
+
+extern void fatal_error_0(string);
+extern void fatal_error_1(string, int);
+extern void fatal_error_2(string, int, int);
+extern void fatal_error_s(string, string);
+
+extern void yyerror(string);
+
+extern void warning_0(string);
+extern void warning_1(string, int);
+extern void warning_2(string, int, int);
+extern void warning_s(string, string);
+extern void warning_s_1(string, string, int);
+extern void warning_s_2(string, string, int, int);
+
+extern void internal_error_0(string);
+extern void internal_error_1(string, int);
+extern void internal_error_s(string, string);
+
+
diff --git a/Build/source/texk/web2c/omegafonts/extra_routines.c b/Build/source/texk/web2c/omegafonts/extra_routines.c
new file mode 100644
index 00000000000..924417f2f27
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/extra_routines.c
@@ -0,0 +1,479 @@
+/* extra_routines.c: Tables for glues, rules, penalties, etc.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "manifests.h"
+#include "list_routines.h"
+#include "extra_routines.h"
+#include "header_routines.h"
+#include "error_routines.h"
+
+#define MAX_EXTRA_TABLES 16
+#define MAX_TABLE_ENTRIES 256
+
+unsigned *ivalue_tables[MAX_EXTRA_TABLES];
+unsigned *penalty_tables[MAX_EXTRA_TABLES];
+fix *fvalue_tables[MAX_EXTRA_TABLES];
+fix *mvalue_tables[MAX_EXTRA_TABLES];
+rule *rule_tables[MAX_EXTRA_TABLES];
+glue *glue_tables[MAX_EXTRA_TABLES];
+
+unsigned max_ivalue_entry[MAX_EXTRA_TABLES];
+unsigned max_penalty_entry[MAX_EXTRA_TABLES];
+unsigned max_fvalue_entry[MAX_EXTRA_TABLES];
+unsigned max_mvalue_entry[MAX_EXTRA_TABLES];
+unsigned max_rule_entry[MAX_EXTRA_TABLES];
+unsigned max_glue_entry[MAX_EXTRA_TABLES];
+
+unsigned no_ivalue_tables = 0;
+unsigned no_penalty_tables = 0;
+unsigned no_fvalue_tables = 0;
+unsigned no_mvalue_tables = 0;
+unsigned no_rule_tables = 0;
+unsigned no_glue_tables = 0;
+
+unsigned *cur_ivalue_table;
+unsigned *cur_penalty_table;
+fix *cur_mvalue_table;
+fix *cur_fvalue_table;
+rule *cur_rule_table;
+glue *cur_glue_table;
+
+unsigned cur_ivalue_table_index;
+unsigned cur_penalty_table_index;
+unsigned cur_mvalue_table_index;
+unsigned cur_fvalue_table_index;
+unsigned cur_rule_table_index;
+unsigned cur_glue_table_index;
+
+unsigned *cur_ivalue_entry;
+unsigned *cur_penalty_entry;
+fix *cur_mvalue_entry;
+fix *cur_fvalue_entry;
+rule *cur_rule_entry;
+glue *cur_glue_entry;
+
+unsigned nki=0;
+unsigned nwi=0;
+unsigned nkp=0;
+unsigned nwp=0;
+unsigned nkm=0;
+unsigned nwm=0;
+unsigned nkf=0;
+unsigned nwf=0;
+unsigned nkr=0;
+unsigned nwr=0;
+unsigned nkg=0;
+unsigned nwg=0;
+
+void
+compute_ofm_extra_stuff(void)
+{
+ unsigned i=0;
+
+ if (ofm_level >= OFM_LEVEL1) {
+ nki = no_ivalue_tables;
+ nkp = no_penalty_tables;
+ nkm = no_mvalue_tables;
+ nkf = no_fvalue_tables;
+ nkr = no_rule_tables;
+ nkg = no_glue_tables;
+ for (i=0; i<nki; i++) {
+ nwi += max_ivalue_entry[i];
+ }
+ for (i=0; i<nkp; i++) {
+ nwp += max_penalty_entry[i];
+ }
+ for (i=0; i<nkm; i++) {
+ nwm += max_mvalue_entry[i];
+ }
+ for (i=0; i<nkf; i++) {
+ nwf += max_fvalue_entry[i];
+ }
+ for (i=0; i<nkr; i++) {
+ nwr += 3 * max_rule_entry[i];
+ }
+ for (i=0; i<nkg; i++) {
+ nwg += 4 * max_glue_entry[i];
+ }
+ }
+}
+
+void
+output_ofm_extra_stuff(void)
+{
+ if (ofm_level >= OFM_LEVEL1) {
+ fatal_error_0("OFM level 1 not currently supported");
+ }
+}
+
+void
+init_all_tables(void)
+{
+ unsigned i=0;
+
+ for (i=0; i<MAX_EXTRA_TABLES; i++) {
+ ivalue_tables[i] = NULL;
+ penalty_tables[i] = NULL;
+ fvalue_tables[i] = NULL;
+ mvalue_tables[i] = NULL;
+ rule_tables[i] = NULL;
+ glue_tables[i] = NULL;
+ }
+}
+
+void
+init_font_ivalue(unsigned tab)
+{
+ unsigned j;
+
+ if (tab>=MAX_EXTRA_TABLES)
+ internal_error_1("init_font_ivalue (tab=%d)", tab);
+ if (ivalue_tables[tab] != NULL) {
+ warning_1("IVALUE table (D %d) previously defined; "
+ "old value ignored", tab);
+ cur_ivalue_table = ivalue_tables[tab];
+ for (j=0; j<MAX_TABLE_ENTRIES; j++) {
+ cur_ivalue_table[j] = 0;
+ }
+ } else {
+ no_ivalue_tables++;
+ ivalue_tables[tab] =
+ (unsigned *) xmalloc(MAX_TABLE_ENTRIES*sizeof(unsigned));
+ cur_ivalue_table = ivalue_tables[tab];
+ }
+ max_ivalue_entry[tab] = 0;
+}
+
+void
+init_font_penalty(unsigned tab)
+{
+ unsigned j;
+
+ if (tab>=MAX_EXTRA_TABLES)
+ internal_error_1("init_font_penalty (tab=%d)", tab);
+ if (penalty_tables[tab] != NULL) {
+ warning_1("IVALUE table (D %d) previously defined; "
+ "old value ignored", tab);
+ cur_penalty_table = ivalue_tables[tab];
+ for (j=0; j<MAX_TABLE_ENTRIES; j++) {
+ cur_penalty_table[j] = 0;
+ }
+ } else {
+ no_penalty_tables++;
+ penalty_tables[tab] =
+ (unsigned *) xmalloc(MAX_TABLE_ENTRIES*sizeof(unsigned));
+ cur_penalty_table = ivalue_tables[tab];
+ }
+ max_penalty_entry[tab] = 0;
+}
+
+void
+init_font_mvalue(unsigned tab)
+{
+ unsigned j;
+
+ if (tab>=MAX_EXTRA_TABLES)
+ internal_error_1("init_font_mvalue (tab=%d)", tab);
+ if (mvalue_tables[tab] != NULL) {
+ warning_1("MVALUE table (D %d) previously defined; "
+ "old value ignored", tab);
+ cur_mvalue_table = mvalue_tables[tab];
+ for (j=0; j<MAX_TABLE_ENTRIES; j++) {
+ cur_mvalue_table[j] = 0;
+ }
+ } else {
+ no_mvalue_tables++;
+ mvalue_tables[tab] =
+ (fix *) xmalloc(MAX_TABLE_ENTRIES*sizeof(unsigned));
+ cur_mvalue_table = mvalue_tables[tab];
+ }
+ max_mvalue_entry[tab] = 0;
+}
+
+void
+init_font_fvalue(unsigned tab)
+{
+ unsigned j;
+
+ if (tab>=MAX_EXTRA_TABLES)
+ internal_error_1("init_font_fvalue (tab=%d)", tab);
+ if (fvalue_tables[tab] != NULL) {
+ warning_1("FVALUE table (D %d) previously defined; "
+ "old value ignored", tab);
+ cur_fvalue_table = fvalue_tables[tab];
+ for (j=0; j<MAX_TABLE_ENTRIES; j++) {
+ cur_fvalue_table[j] = 0;
+ }
+ } else {
+ no_fvalue_tables++;
+ fvalue_tables[tab] =
+ (fix *) xmalloc(MAX_TABLE_ENTRIES*sizeof(unsigned));
+ cur_fvalue_table = fvalue_tables[tab];
+ }
+ max_fvalue_entry[tab] = 0;
+}
+
+void
+init_font_rule(unsigned tab)
+{
+ unsigned j;
+
+ if (tab>=MAX_EXTRA_TABLES)
+ internal_error_1("init_font_rule (tab=%d)", tab);
+ if (rule_tables[tab] != NULL) {
+ warning_1("RULE table (D %d) previously defined; "
+ "old value ignored", tab);
+ cur_rule_table = rule_tables[tab];
+ for (j=0; j<MAX_TABLE_ENTRIES; j++) {
+ cur_rule_table[j].rule_wd = 0;
+ cur_rule_table[j].rule_dp = 0;
+ cur_rule_table[j].rule_ht = 0;
+ }
+ } else {
+ no_rule_tables++;
+ rule_tables[tab] =
+ (rule *) xmalloc(MAX_TABLE_ENTRIES*sizeof(rule));
+ cur_rule_table = rule_tables[tab];
+ }
+ max_rule_entry[tab] = 0;
+}
+
+void
+init_font_glue(unsigned tab)
+{
+ unsigned j;
+
+ if (tab>=MAX_EXTRA_TABLES)
+ internal_error_1("init_font_glue (tab=%d)", tab);
+ if (glue_tables[tab] != NULL) {
+ warning_1("GLUE table (D %d) previously defined; "
+ "old value ignored", tab);
+ cur_glue_table = glue_tables[tab];
+ for (j=0; j<MAX_TABLE_ENTRIES; j++) {
+ cur_glue_table[j].glue_width = 0;
+ cur_glue_table[j].glue_stretch = 0;
+ cur_glue_table[j].glue_shrink = 0;
+ cur_glue_table[j].glue_stretch_order = 0;
+ cur_glue_table[j].glue_shrink_order = 0;
+ cur_glue_table[j].glue_type = 0;
+ cur_glue_table[j].glue_arg_type = GLUEARG_NONE;
+ cur_glue_table[j].glue_arg1 = 0;
+ cur_glue_table[j].glue_arg2 = 0;
+ }
+ } else {
+ no_glue_tables++;
+ glue_tables[tab] =
+ (glue *) xmalloc(MAX_TABLE_ENTRIES*sizeof(glue));
+ cur_glue_table = glue_tables[tab];
+ }
+ max_glue_entry[tab] = 0;
+}
+
+
+void
+init_font_ivalue_entry(unsigned index)
+{
+ if (index>=MAX_TABLE_ENTRIES)
+ internal_error_1("init_font_ivalue_entry (index=%d)", index);
+ cur_ivalue_entry = &cur_ivalue_table[index];
+ if (max_ivalue_entry[cur_ivalue_table_index]<index)
+ max_ivalue_entry[cur_ivalue_table_index] = index;
+}
+
+void
+init_font_penalty_entry(unsigned index)
+{
+ if (index>=MAX_TABLE_ENTRIES)
+ internal_error_1("init_font_penalty_entry (index=%d)", index);
+ cur_penalty_entry = &cur_penalty_table[index];
+ if (max_penalty_entry[cur_penalty_table_index]<index)
+ max_penalty_entry[cur_penalty_table_index] = index;
+}
+
+void
+init_font_mvalue_entry(unsigned index)
+{
+ if (index>=MAX_TABLE_ENTRIES)
+ internal_error_1("init_font_mvalue_entry (index=%d)", index);
+ cur_mvalue_entry = &cur_mvalue_table[index];
+ if (max_mvalue_entry[cur_mvalue_table_index]<index)
+ max_mvalue_entry[cur_mvalue_table_index] = index;
+}
+
+void
+init_font_fvalue_entry(unsigned index)
+{
+ if (index>=MAX_TABLE_ENTRIES)
+ internal_error_1("init_font_fvalue_entry (index=%d)", index);
+ cur_fvalue_entry = &cur_fvalue_table[index];
+ if (max_fvalue_entry[cur_fvalue_table_index]<index)
+ max_fvalue_entry[cur_fvalue_table_index] = index;
+}
+
+void
+init_font_rule_entry(unsigned index)
+{
+ if (index>=MAX_TABLE_ENTRIES)
+ internal_error_1("init_font_rule_entry (index=%d)", index);
+ cur_rule_entry = &cur_rule_table[index];
+ if (max_rule_entry[cur_rule_table_index]<index)
+ max_rule_entry[cur_rule_table_index] = index;
+}
+
+void
+init_font_glue_entry(unsigned index)
+{
+ if (index>=MAX_TABLE_ENTRIES)
+ internal_error_1("init_font_glue_entry (index=%d)", index);
+ cur_glue_entry = &cur_glue_table[index];
+ if (max_glue_entry[cur_glue_table_index]<index)
+ max_glue_entry[cur_glue_table_index] = index;
+}
+
+
+void
+set_font_ivalue_definition(unsigned val)
+{
+ *cur_ivalue_entry = val;
+}
+
+void
+set_font_penalty_definition(unsigned val)
+{
+ *cur_penalty_entry = val;
+}
+
+void
+set_font_mvalue_definition(fix fval)
+{
+ *cur_mvalue_entry = fval;
+}
+
+void
+set_font_fvalue_definition(fix fval)
+{
+ *cur_fvalue_entry = fval;
+}
+
+void
+set_font_rule_measure(unsigned measure, fix fval)
+{
+ switch (measure) {
+ case RULE_WD: {
+ cur_rule_entry->rule_wd = fval; break;
+ }
+ case RULE_HT: {
+ cur_rule_entry->rule_ht = fval; break;
+ }
+ case RULE_DP: {
+ cur_rule_entry->rule_dp = fval; break;
+ }
+ default: {
+ internal_error_1("set_font_rule_measure (measure=%d)", measure);
+ }
+ }
+}
+
+
+void
+set_font_glue_width(fix width)
+{
+ cur_glue_entry->glue_width = width;
+}
+
+void
+set_font_glue_shrink_stretch(unsigned shrink_stretch,
+ fix width, unsigned order)
+{
+ switch (shrink_stretch) {
+ case GLUE_SHRINK: {
+ cur_glue_entry->glue_shrink = width; break;
+ cur_glue_entry->glue_shrink_order = order; break;
+ }
+ case GLUE_STRETCH: {
+ cur_glue_entry->glue_stretch_order = order; break;
+ }
+ default: {
+ internal_error_1("set_font_rule_measure (shrink_stretch=%d)",
+ shrink_stretch);
+ }
+ }
+}
+
+void
+set_font_glue_type(unsigned type)
+{
+ cur_glue_entry->glue_type = type;
+}
+
+void
+set_font_glue_character(unsigned c)
+{
+ cur_glue_entry->glue_arg_type = GLUEARG_CHAR;
+ cur_glue_entry->glue_arg1 = c;
+}
+
+void
+set_font_glue_rule(unsigned rule_table, unsigned rule_index)
+{
+ cur_glue_entry->glue_arg_type = GLUEARG_RULE;
+ cur_glue_entry->glue_arg1 = rule_table;
+ cur_glue_entry->glue_arg2 = rule_index;
+}
+
+void
+set_character_ivalue(unsigned table, unsigned index)
+{
+ fatal_error_0("CHARIVALUE not currently supported");
+}
+
+void
+set_character_penalty(unsigned table, unsigned index)
+{
+ fatal_error_0("CHARPENALTY not currently supported");
+}
+
+void
+set_character_mvalue(unsigned table, unsigned index)
+{
+ fatal_error_0("CHARMVALUE not currently supported");
+}
+
+void
+set_character_fvalue(unsigned table, unsigned index)
+{
+ fatal_error_0("CHARFVALUE not currently supported");
+}
+
+void
+set_character_rule(unsigned table, unsigned index)
+{
+ fatal_error_0("CHARRULE not currently supported");
+}
+
+void
+set_character_glue(unsigned table, unsigned index)
+{
+ fatal_error_0("CHARGLUE not currently supported");
+}
diff --git a/Build/source/texk/web2c/omegafonts/extra_routines.h b/Build/source/texk/web2c/omegafonts/extra_routines.h
new file mode 100644
index 00000000000..6f8a5a10acc
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/extra_routines.h
@@ -0,0 +1,88 @@
+/* extra_routines.h: Tables for glues, rules, penalties, etc.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+extern void init_font_ivalue(unsigned);
+extern void init_font_mvalue(unsigned);
+extern void init_font_fvalue(unsigned);
+extern void init_font_penalty(unsigned);
+extern void init_font_rule(unsigned);
+extern void init_font_glue(unsigned);
+
+
+void init_font_ivalue_entry(unsigned);
+void set_font_ivalue_definition(unsigned);
+void init_font_mvalue_entry(unsigned);
+void set_font_mvalue_definition(fix);
+void init_font_fvalue_entry(unsigned);
+void set_font_fvalue_definition(fix);
+void init_font_penalty_entry(unsigned);
+void set_font_penalty_definition(unsigned);
+void init_font_rule_entry(unsigned);
+void set_font_rule_measure(unsigned, fix);
+void init_font_glue_entry(unsigned);
+void set_font_glue_type(unsigned);
+void set_font_glue_width(fix);
+void set_font_glue_character(unsigned);
+void set_font_glue_rule(unsigned, unsigned);
+void set_font_glue_shrink_stretch(unsigned, fix, unsigned);
+
+typedef struct rule_struct {
+ fix rule_wd;
+ fix rule_ht;
+ fix rule_dp;
+} rule;
+
+typedef struct glue_struct {
+ fix glue_width;
+ fix glue_stretch;
+ fix glue_shrink;
+ unsigned glue_stretch_order;
+ unsigned glue_shrink_order;
+ unsigned glue_type;
+ unsigned glue_arg_type;
+ unsigned glue_arg1;
+ unsigned glue_arg2;
+} glue;
+
+extern void set_character_ivalue(unsigned, unsigned);
+extern void set_character_penalty(unsigned, unsigned);
+extern void set_character_mvalue(unsigned, unsigned);
+extern void set_character_fvalue(unsigned, unsigned);
+extern void set_character_rule(unsigned, unsigned);
+extern void set_character_glue(unsigned, unsigned);
+extern void compute_ofm_extra_stuff(void);
+extern void output_ofm_extra_stuff(void);
+
+extern unsigned nki;
+extern unsigned nwi;
+extern unsigned nkp;
+extern unsigned nwp;
+extern unsigned nkm;
+extern unsigned nwm;
+extern unsigned nkf;
+extern unsigned nwf;
+extern unsigned nkr;
+extern unsigned nwr;
+extern unsigned nkg;
+extern unsigned nwg;
+
diff --git a/Build/source/texk/web2c/omegafonts/font_routines.c b/Build/source/texk/web2c/omegafonts/font_routines.c
new file mode 100644
index 00000000000..8cb763b7db0
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/font_routines.c
@@ -0,0 +1,757 @@
+/* font_routines.c: Data structures for virtual font support
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "manifests.h"
+#include "dvi.h"
+#include "error_routines.h"
+#include "list_routines.h"
+#include "font_routines.h"
+#include "char_routines.h"
+#include "header_routines.h"
+#include "print_routines.h"
+#include "out_routines.h"
+#include "omfonts.h"
+
+#define BLOCK 256
+
+font *font_table = NULL;
+unsigned font_table_size = 0;
+unsigned no_fonts = 0;
+font *cur_font = NULL;
+unsigned cur_font_index = 0;
+
+unsigned vtitle_length = 0;
+unsigned vf_check_sum = 0;
+unsigned vf_design_size = 0;
+
+void
+font_table_init(void)
+{
+ font_table_size = BLOCK;
+ font_table = (font *) xmalloc(font_table_size);
+ no_fonts = 0;
+}
+
+void
+font_no_incr(void)
+{
+ if (no_fonts == font_table_size) {
+ font_table_size += BLOCK;
+ font_table = (font *) xrealloc(font_table, font_table_size);
+ }
+ no_fonts++;
+}
+
+void
+clear_map_font(int font_number)
+{
+ if (cur_font==NULL) internal_error_0("clear_map_font");
+ cur_font->font_number = font_number;
+ cur_font->font_name = NULL;
+ cur_font->font_area = NULL;
+ cur_font->font_at = 0;
+ cur_font->font_checksum = 0;
+ cur_font->font_dsize = 10*UNITY;
+ cur_font->font_at_defined = FALSE;
+ cur_font->font_checksum_defined = FALSE;
+ cur_font->font_dsize_defined = FALSE;
+ cur_font->ovf_packet = NULL;
+ cur_font->ovf_packet_length = 0;
+}
+
+void
+init_map_font(int font_number)
+{
+ unsigned i=0;
+
+ while (i<no_fonts) {
+ if (font_number == font_table[i].font_number) {
+ warning_1("MAPFONT index (D %d) previously defined; "
+ "old definition ignored", font_number);
+ cur_font = &font_table[i];
+ if (cur_font->font_area != NULL)
+ free(cur_font->font_area);
+ if (cur_font->font_name != NULL)
+ free(cur_font->font_name);
+ if (cur_font->ovf_packet != NULL)
+ free(cur_font->ovf_packet);
+ clear_map_font(font_number);
+ break;
+ }
+ i++;
+ }
+ if (i==no_fonts) {
+ font_no_incr();
+ cur_font = &font_table[i];
+ clear_map_font(font_number);
+ }
+ packet_table_init();
+ append_command(DVI_FNT_DEF_1, i);
+ cur_font_index = i;
+ cur_font = &font_table[i];
+ cur_font->ovf_packet = cur_packet;
+ cur_font->ovf_packet_length = packet_ptr;
+ packet_table_end();
+
+}
+
+void
+set_font_name(string name)
+{
+ if (cur_font==NULL) {
+ internal_error_0("set_font_name");
+ }
+ if (cur_font->font_name != NULL) {
+ warning_0("FONTNAME previously defined; old value ignored");
+ free(cur_font->font_name);
+ cur_font->font_name=NULL;
+ }
+ cur_font->font_name = name;
+}
+
+void
+set_font_area(string area)
+{
+ if (cur_font==NULL) {
+ internal_error_0("set_font_area");
+ }
+ if (cur_font->font_area != NULL) {
+ warning_0("FONTAREA previously defined; old value ignored");
+ free(cur_font->font_area);
+ cur_font->font_area=NULL;
+ }
+ cur_font->font_area = area;
+}
+
+void
+set_font_check_sum(unsigned cs)
+{
+ if (cur_font==NULL) {
+ internal_error_0("set_font_check_sum");
+ }
+ if (cur_font->font_checksum_defined != FALSE) {
+ warning_0("FONTCHECKSUM previously defined; old value ignored");
+ }
+ cur_font->font_checksum = cs;
+ cur_font->font_checksum_defined = TRUE;
+}
+
+void
+set_font_at(fix at)
+{
+ if (cur_font==NULL) {
+ internal_error_0("set_font_at");
+ }
+ if (cur_font->font_at_defined != FALSE) {
+ warning_0("FONTAT previously defined; old value ignored");
+ }
+ cur_font->font_at = at;
+ cur_font->font_at_defined = TRUE;
+}
+
+void
+set_font_design_size(fix ds)
+{
+ if (cur_font==NULL) {
+ internal_error_0("set_font_design_size");
+ }
+ if (cur_font->font_dsize_defined != FALSE) {
+ warning_0("FONTDSIZE previously defined; old value ignored");
+ }
+ cur_font->font_dsize = ds;
+ cur_font->font_dsize_defined = TRUE;
+}
+
+string vtitle = NULL;
+
+void
+set_vtitle(string title)
+{
+ if (vtitle!=NULL) {
+ warning_0("VTITLE previously defined; old value ignored");
+ free(vtitle); vtitle = NULL;
+ }
+ vtitle = title;
+}
+
+unsigned packet_table_size = 0;
+unsigned char *packet_table = NULL;
+unsigned char *cur_packet = NULL;
+unsigned packet_ptr = 0;
+
+void
+packet_table_init(void)
+{
+ packet_table_size = BLOCK;
+ packet_table = (unsigned char *) xmalloc(packet_table_size);
+ packet_ptr = 0;
+ cur_packet = packet_table;
+}
+
+void
+packet_ptr_incr(void)
+{
+ if (packet_ptr == packet_table_size) {
+ packet_table_size += BLOCK;
+ packet_table = (unsigned char *)
+ xrealloc(packet_table, packet_table_size);
+ }
+ packet_ptr++;
+}
+
+void
+append_to_packet(unsigned val)
+{
+ packet_ptr_incr();
+ packet_table[packet_ptr-1] = val & 0xff;
+}
+
+void
+init_map(void)
+{
+ move_table_init();
+ packet_table_init();
+}
+
+void
+end_map(void)
+{
+ current_character->ovf_packet = cur_packet;
+ current_character->ovf_packet_length = packet_ptr;
+ packet_table_end();
+}
+
+void
+append_command_2(unsigned cmd_0, unsigned max_n,
+ unsigned cmd_1, unsigned actual)
+{
+ if ((actual < 0) || (actual > 0x7fffffff))
+ internal_error_1("append_command (actual=%d)", actual);
+ if ((cmd_0 + actual) <= max_n)
+ append_to_packet(cmd_0 + actual);
+ else
+ append_command(cmd_1, actual);
+}
+
+void
+append_command(unsigned cmd_1, unsigned actual)
+{
+ if ((cmd_1 != DVI_SET_1) && (cmd_1 != DVI_FNT_1) &&
+ (cmd_1 != DVI_FNT_DEF_1) && (cmd_1 != DVI_XXX_1)) {
+ internal_error_1("append_command (cmd_1=%d)", cmd_1);
+ }
+ if (actual < 0x100) {
+ append_to_packet(cmd_1);
+ append_to_packet(actual);
+ } else if (actual < 0x10000) {
+ append_to_packet(cmd_1 + 1);
+ append_to_packet(actual >> 8);
+ append_to_packet(actual & 0xff);
+ } else if (actual < 0x1000000) {
+ append_to_packet(cmd_1 + 2);
+ append_to_packet(actual >> 16);
+ append_to_packet((actual >> 8) & 0xff);
+ append_to_packet(actual & 0xff);
+ } else {
+ append_to_packet(cmd_1 + 3);
+/* BUG: Should deal with negative numbers */
+ append_to_packet((actual >> 24) & 0xff);
+ append_to_packet((actual >> 16) & 0xff);
+ append_to_packet((actual >> 8) & 0xff);
+ append_to_packet(actual & 0xff);
+ }
+
+}
+
+unsigned char *ovf_ptr=NULL;
+
+int
+ovf_get_arg(unsigned char **ptr, unsigned k, boolean is_signed)
+{
+ int a, b;
+
+ if (k>4) internal_error_1("ovf_get_arg (k=%d)", k);
+ a = b = (int) ((**ptr) & 0xff);
+ (*ptr)++;
+ if ((is_signed==TRUE) || (k==4)) { /* 4-byte numbers are signed */
+ if (b > 0x7f) { a = a - 0x100; }
+ }
+ while (k>1) {
+ b = (**ptr) & 0xff;
+ (*ptr)++;
+ a = 0x100 * a + b;
+ k--;
+ }
+ return a;
+}
+
+void
+input_command(unsigned *cmd, int *actual)
+{
+ unsigned the_cmd = *ovf_ptr & 0xff;
+
+ ovf_ptr++;
+ if ((the_cmd>=DVI_SET_CHAR_0) && (the_cmd<=DVI_SET_CHAR_127)) {
+ (*cmd)=DVI_SET_1;
+ (*actual) = the_cmd;
+ } else if ((the_cmd>=DVI_SET_1) && (the_cmd<=DVI_SET_4)) {
+ (*cmd)=DVI_SET_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_SET_1 + 1, FALSE);
+ } else if ((the_cmd>=DVI_FNT_NUM_0) && (the_cmd<=DVI_FNT_NUM_63)) {
+ (*cmd)=DVI_FNT_1;
+ (*actual) = the_cmd - DVI_FNT_NUM_0;
+ } else if ((the_cmd>=DVI_FNT_1) && (the_cmd<=DVI_FNT_4)) {
+ (*cmd)=DVI_FNT_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_FNT_1 + 1, FALSE);
+ } else if ((the_cmd>=DVI_FNT_DEF_1) && (the_cmd<=DVI_FNT_DEF_4)) {
+ (*cmd)=DVI_FNT_DEF_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_FNT_DEF_1 + 1, FALSE);
+ } else if ((the_cmd>=DVI_XXX_1) && (the_cmd<=DVI_XXX_4)) {
+ (*cmd)=DVI_XXX_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_XXX_1 + 1, FALSE);
+ } else if ((the_cmd>=DVI_RIGHT_1) && (the_cmd<=DVI_RIGHT_4)) {
+ (*cmd)=DVI_RIGHT_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_RIGHT_1 + 1, TRUE);
+ } else if ((the_cmd>=DVI_DOWN_1) && (the_cmd<=DVI_DOWN_4)) {
+ (*cmd)=DVI_DOWN_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_DOWN_1 + 1, TRUE);
+ } else if ((the_cmd>=DVI_W_1) && (the_cmd<=DVI_W_4)) {
+ (*cmd)=DVI_W_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_W_1 + 1, TRUE);
+ } else if ((the_cmd>=DVI_X_1) && (the_cmd<=DVI_X_4)) {
+ (*cmd)=DVI_X_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_X_1 + 1, TRUE);
+ } else if ((the_cmd>=DVI_Y_1) && (the_cmd<=DVI_Y_4)) {
+ (*cmd)=DVI_Y_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_Y_1 + 1, TRUE);
+ } else if ((the_cmd>=DVI_Z_1) && (the_cmd<=DVI_Z_4)) {
+ (*cmd)=DVI_Z_1;
+ (*actual) = ovf_get_arg(&ovf_ptr, the_cmd - DVI_Z_1 + 1, TRUE);
+ }
+}
+
+
+void
+append_to_packet_fix(unsigned cmd, fix fval)
+{
+ unsigned k;
+ unsigned negative=FALSE;
+ int t;
+
+ if (design_units != UNITY)
+ fval = zround(((double)fval) / ((double)design_units) * 1048576.0);
+ if (fval<0) {
+ negative = TRUE;
+ fval = -1 - fval;
+ }
+ if (cmd == 0) {
+ k = 4; t = 0x1000000;
+ } else {
+ t = 0x7f; k = 1;
+ while (fval>t) {
+ t = (t<<8) | 0xff; k++;
+ }
+ append_to_packet(cmd+k-1); t = t/0x80 + 1;
+ }
+ do {
+ if (negative == TRUE) {
+ append_to_packet(0xff - fval/t);
+ fval = (fval/t)*t + t-1-fval;
+ negative = FALSE;
+ } else {
+ append_to_packet((fval/t) & 0xff);
+ }
+ k--; t = t >> 8;
+ } while (k != 0);
+}
+
+unsigned move_table_size = 0;
+move *move_table = NULL;
+move *cur_move = NULL;
+unsigned move_ptr = 0;
+
+void
+move_table_init(void)
+{
+ if (move_table == NULL) {
+ move_table_size = BLOCK;
+ move_table = (move *) xmalloc(move_table_size);
+ }
+ move_ptr = 0;
+ cur_move = move_table;
+ cur_move->h = 0; cur_move->v = 0;
+}
+
+void
+packet_table_end(void)
+{
+ cur_packet = NULL;
+ packet_ptr = 0;
+ packet_table_size = 0;
+}
+
+
+void
+move_ptr_decr(void)
+{
+ if (move_ptr==0)
+ internal_error_0("move_ptr_incr");
+ move_ptr--;
+ cur_move = &move_table[move_ptr];
+}
+
+void
+move_ptr_incr(void)
+{
+ if (move_ptr == move_table_size) {
+ move_table_size += BLOCK;
+ move_table = (move *) xrealloc(move_table, move_table_size);
+ }
+ move_ptr++;
+ cur_move = &move_table[move_ptr];
+}
+
+unsigned
+get_hex(unsigned char c)
+{
+ if ((c>='0') || (c<='9')) return(c-'0');
+ if ((c>='A') || (c<='F')) return(c-'A'+10);
+ internal_error_1("get_hex (a=%c)", c);
+}
+
+void
+set_select_font(unsigned f)
+{
+ append_command_2(DVI_FNT_NUM_0, DVI_FNT_NUM_63, DVI_FNT_1, f);
+}
+
+void
+set_set_char(unsigned c)
+{
+ if (cur_font==NULL) {
+ warning_1("Character (H %X) cannot be typeset in undefined font", c);
+ } else {
+ append_command_2(DVI_SET_CHAR_0, DVI_SET_CHAR_127, DVI_SET_1, c);
+ }
+}
+
+void
+set_set_rule(fix height, fix width)
+{
+ append_to_packet(DVI_SET_RULE);
+ append_to_packet_fix(0, height);
+ append_to_packet_fix(0, width);
+}
+
+void
+set_move(unsigned direction, fix fval)
+{
+ if (cur_move == NULL) {
+ internal_error_0("set_move");
+ }
+ if (direction == M_LEFT) {
+ fval = -fval;
+ direction = M_RIGHT;
+ } else if (direction == M_UP) {
+ fval = -fval;
+ direction = M_DOWN;
+ }
+ if (direction == M_RIGHT) { /* horizontal movement */
+ if (cur_move->h == 0) {
+ cur_move->wfix = fval; cur_move->h++;
+ append_to_packet_fix(DVI_W_1, fval);
+ } else if (fval == cur_move->wfix) {
+ append_to_packet(DVI_W_0);
+ } else if (cur_move->h == 1) {
+ cur_move->xfix = fval; cur_move->h++;
+ append_to_packet_fix(DVI_X_1, fval);
+ } else if (fval == cur_move->xfix) {
+ append_to_packet(DVI_X_0);
+ } else {
+ append_to_packet_fix(DVI_RIGHT_1, fval);
+ }
+ } else { /* vertical movement */
+ if (cur_move->v == 0) {
+ cur_move->yfix = fval; cur_move->v++;
+ append_to_packet_fix(DVI_Y_1, fval);
+ } else if (fval == cur_move->yfix) {
+ append_to_packet(DVI_Y_0);
+ } else if (cur_move->v == 1) {
+ cur_move->zfix = fval; cur_move->v++;
+ append_to_packet_fix(DVI_Z_1, fval);
+ } else if (fval == cur_move->zfix) {
+ append_to_packet(DVI_Z_0);
+ } else {
+ append_to_packet_fix(DVI_DOWN_1, fval);
+ }
+ }
+}
+
+void
+set_push(void)
+{
+ append_to_packet(DVI_PUSH);
+ move_ptr_incr();
+ cur_move->h = 0;
+ cur_move->v = 0;
+}
+
+void
+set_pop(void)
+{
+ append_to_packet(DVI_POP);
+ move_ptr_decr();
+}
+
+void
+set_special(string special_string)
+{
+ unsigned len = strlen(special_string);
+ unsigned i=0;
+
+ append_command(DVI_XXX_1, len);
+ for (i=0; i<len; i++) {
+ append_to_packet(special_string[i]);
+ }
+}
+
+void
+set_special_hex(string special_hex_string)
+{
+ unsigned len = strlen(special_hex_string);
+ unsigned i=0;
+
+ append_command(DVI_XXX_1, len/2);
+ for (i=0; i<len; i+=2) {
+ append_to_packet(get_hex(special_hex_string[i])*16+
+ get_hex(special_hex_string[i+1]));
+ }
+}
+
+unsigned file_ovf_count = 0;
+
+void
+out_ovf(unsigned i)
+{
+ fputc(i,file_ovf);
+ file_ovf_count++;
+}
+
+void
+out_ovf_4(unsigned i)
+{
+ fputc(i>>24, file_ovf);
+ fputc((i>>16)&0xff, file_ovf);
+ fputc((i>>8)&0xff, file_ovf);
+ fputc(i&0xff, file_ovf);
+ file_ovf_count += 4;
+}
+
+void
+output_ovf_fonts(void)
+{
+ unsigned i, j, k1, k2;
+
+ for (i=0; i<no_fonts; i++) {
+ cur_font = font_table+i;
+ for (j=0; j<cur_font->ovf_packet_length; j++)
+ out_ovf(cur_font->ovf_packet[j]);
+ out_ovf_4(cur_font->font_checksum);
+ out_ovf_4(cur_font->font_at);
+ out_ovf_4((unsigned int)cur_font->font_dsize);
+ if (cur_font->font_area != NULL) {
+ k2 = strlen(cur_font->font_area);
+ out_ovf(k2);
+ } else {
+ k2 = 0; out_ovf(0);
+ }
+ if (cur_font->font_name != NULL) {
+ k1 = strlen(cur_font->font_name);
+ out_ovf(k1);
+ } else {
+ k1 = 4; out_ovf(4);
+ }
+ if (cur_font->font_area != NULL) {
+ for (j=0; j<k2; j++)
+ out_ovf(cur_font->font_area[j]);
+ }
+ if (cur_font->font_name != NULL) {
+ for (j=0; j<k1; j++)
+ out_ovf(cur_font->font_name[j]);
+ } else {
+ out_ovf('N'); out_ovf('U'); out_ovf('L'); out_ovf('L');
+ }
+ }
+}
+
+void
+output_ovf_file(void)
+{
+ unsigned i, k;
+
+ out_ovf(DVI_PRE); out_ovf(VF_ID);
+ /* Check for vtitle==NULL by Joel Riou <joel.riou@normalesup.org> */
+ k = vtitle ? strlen(vtitle) : 0; out_ovf(k);
+ for (i=0; i<k; i++) out_ovf(vtitle[i]);
+ out_ovf_4(check_sum); out_ovf_4(design_size);
+ output_ovf_fonts();
+ output_ovf_chars();
+ do {
+ out_ovf(DVI_POST);
+ } while ((file_ovf_count % 4) != 0);
+}
+
+void
+in_ovf_4(int *value)
+{
+ *value = (((*ovf_ptr) & 0xff) << 24) |
+ (((*(ovf_ptr+1)) & 0xff) << 16) |
+ (((*(ovf_ptr+2)) & 0xff) << 8) |
+ ((*(ovf_ptr+3)) & 0xff);
+ ovf_ptr += 4;
+}
+
+void
+in_ovf_unsigned_4(unsigned *value)
+{
+ *value = (((*ovf_ptr) & 0xff) << 24) |
+ (((*(ovf_ptr+1)) & 0xff) << 16) |
+ (((*(ovf_ptr+2)) & 0xff) << 8) |
+ ((*(ovf_ptr+3)) & 0xff);
+ ovf_ptr += 4;
+}
+
+void
+in_ovf_3(int *value)
+{
+ *value = (((*ovf_ptr) & 0xff) << 16) |
+ (((*(ovf_ptr+1)) & 0xff) << 8) |
+ ((*(ovf_ptr+2)) & 0xff);
+ ovf_ptr += 3;
+}
+
+void
+in_ovf(int *value)
+{
+ *value = (*ovf_ptr) & 0xff;
+ ovf_ptr ++;
+}
+
+void
+input_ovf_file(void)
+{
+ ovf_ptr = ovf;
+ if ((*ovf_ptr & 0xff) != DVI_PRE)
+ fatal_error_0("Not a VF or OVF file; first byte should be 247");
+ ovf_ptr++;
+ if ((*ovf_ptr & 0xff) != VF_ID)
+ fatal_error_0("Not a VF or OVF file; second byte should be 202");
+ ovf_ptr++;
+ vtitle_length = *ovf_ptr & 0xff;
+ ovf_ptr++;
+ vtitle = (char *) xmalloc(vtitle_length+1);
+ strncpy(vtitle, (const char *)ovf_ptr, vtitle_length);
+ vtitle[vtitle_length] = '\0';
+ ovf_ptr += vtitle_length;
+ print_vtitle(vtitle);
+ in_ovf_unsigned_4(&vf_check_sum);
+ in_ovf_unsigned_4(&vf_design_size);
+}
+
+
+void
+input_ovf_fonts(void)
+{
+ int cur_font_area_length;
+ int cur_font_name_length;
+ char *cur_font_name;
+ char *cur_font_area;
+ unsigned cur_font_check_sum;
+ int cur_font_at;
+ int cur_font_dsize;
+ unsigned cmd;
+
+ font_table_init();
+ while (((*ovf_ptr & 0xff) >= DVI_FNT_DEF_1) &&
+ ((*ovf_ptr & 0xff) <= DVI_FNT_DEF_4)) {
+ cur_font_index = no_fonts;
+ cur_font = &(font_table[cur_font_index]);
+ font_no_incr();
+ input_command(&cmd, &(cur_font->font_number));
+ print_map_font(cur_font->font_number);
+ in_ovf_unsigned_4(&cur_font_check_sum);
+ cur_font_at = ovf_get_arg(&ovf_ptr, 4, FALSE);
+ cur_font_dsize = ovf_get_arg(&ovf_ptr, 4, FALSE);
+ in_ovf(&cur_font_area_length);
+ in_ovf(&cur_font_name_length);
+ cur_font_area = NULL;
+ if (cur_font_area_length != 0) {
+ cur_font_area = (char *)xmalloc(cur_font_area_length+1);
+ strncpy(cur_font_area, (const char *)ovf_ptr, cur_font_area_length);
+ cur_font_area[cur_font_area_length] = '\0';
+ ovf_ptr += cur_font_area_length;
+ print_font_area(cur_font_area);
+ }
+ cur_font_name = NULL;
+ if (cur_font_name_length != 0) {
+ cur_font_name = (char *)xmalloc(cur_font_name_length+1);
+ strncpy(cur_font_name, (const char *)ovf_ptr, cur_font_name_length);
+ cur_font_name[cur_font_name_length] = '\0';
+ ovf_ptr += cur_font_name_length;
+ print_font_name(cur_font_name);
+ }
+ print_font_check_sum(cur_font_check_sum);
+ print_font_at(cur_font_at);
+ print_font_design_size(cur_font_dsize);
+ right();
+ }
+}
+
+void
+input_ovf_chars(void)
+{
+ int pl,cc,wd;
+
+ while ((*ovf_ptr & 0xff) <= VF_LONG_CHAR) {
+ if ((*ovf_ptr & 0xff) == VF_LONG_CHAR) {
+ ovf_ptr++;
+ in_ovf_4(&pl);
+ in_ovf_4(&cc);
+ in_ovf_4(&wd);
+ } else {
+ in_ovf(&pl);
+ in_ovf(&cc);
+ in_ovf_3(&wd);
+ }
+ ensure_existence(cc);
+ current_secondary_character->ovf_packet_length = pl;
+ current_secondary_character->ovf_packet = ovf_ptr;
+ ovf_ptr += pl;
+ }
+ while (ovf_ptr < (ovf+length_ovf)) {
+ if ((*ovf_ptr & 0xff) != DVI_POST)
+ fatal_error_0("Not a VF or OVF file; final bytes should be 248");
+ ovf_ptr++;
+ }
+}
diff --git a/Build/source/texk/web2c/omegafonts/font_routines.h b/Build/source/texk/web2c/omegafonts/font_routines.h
new file mode 100644
index 00000000000..4aafa6647be
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/font_routines.h
@@ -0,0 +1,98 @@
+/* font_routines.h: Data structures for virtual font support.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+typedef struct font_struct {
+ int font_number;
+ unsigned font_checksum;
+ double font_dsize;
+ string font_name;
+ string font_area;
+ fix font_at;
+ unsigned char *ovf_packet;
+ unsigned ovf_packet_length;
+ boolean font_at_defined;
+ boolean font_dsize_defined;
+ boolean font_checksum_defined;
+} font;
+
+typedef struct move_struct {
+ fix wfix;
+ fix xfix;
+ fix yfix;
+ fix zfix;
+ unsigned h;
+ unsigned v;
+} move;
+
+extern font *font_table;
+extern unsigned no_fonts;
+extern unsigned cur_font_index;
+extern font *cur_font;
+extern unsigned char *cur_packet;
+
+extern string vtitle;
+
+extern unsigned packet_table_size;
+extern unsigned char *packet_table;
+extern unsigned char *cur_packet;
+extern unsigned packet_ptr;
+
+extern void clear_map_font(int);
+extern void init_map_font(int);
+extern void set_font_name(string);
+extern void set_font_area(string);
+extern void set_font_check_sum(unsigned);
+extern void set_font_at(fix);
+extern void set_font_design_size(fix);
+
+extern void set_vtitle(string );
+extern void init_map(void);
+extern void end_map(void);
+extern void set_select_font(unsigned);
+extern void set_set_char(unsigned);
+extern void set_set_rule(fix, fix);
+extern void set_move(unsigned, fix);
+extern void set_push(void);
+extern void set_pop(void);
+extern void set_special(string );
+extern void set_special_hex(string );
+extern unsigned get_hex(unsigned char);
+
+extern void append_command(unsigned, unsigned);
+extern void append_command_2(unsigned, unsigned, unsigned, unsigned);
+extern void append_to_packet_fix(unsigned, fix);
+extern void move_table_init(void);
+extern void font_table_init(void);
+
+extern void packet_table_init(void);
+extern void packet_table_end(void);
+extern void out_ovf(unsigned);
+extern void out_ovf_4(unsigned);
+
+extern int ovf_get_arg(unsigned char **, unsigned,boolean);
+extern void input_command(unsigned *, int *);
+extern void input_ovf_fonts(void);
+extern void input_ovf_chars(void);
+extern void input_ovf_file(void);
+extern void in_ovf_4(int *);
+extern void in_ovf_unsigned_4(unsigned *);
diff --git a/Build/source/texk/web2c/omegafonts/header_routines.c b/Build/source/texk/web2c/omegafonts/header_routines.c
new file mode 100644
index 00000000000..48e3ef00ec6
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/header_routines.c
@@ -0,0 +1,651 @@
+/* header_routines.c: Headers of font metric files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "list_routines.h"
+#include "manifests.h"
+#include "header_routines.h"
+#include "print_routines.h"
+#include "error_routines.h"
+#include "out_ofm.h"
+#include "omfonts.h"
+
+#define LOC_CHECK_SUM 0
+#define LOC_DESIGN_SIZE 4
+#define LOC_CODING_SCHEME 8
+#define LOC_FAMILY (LOC_CODING_SCHEME+LEN_CODING_SCHEME+1)
+#define LOC_SEVEN_FLAG (LOC_FAMILY+LEN_FAMILY+1)
+#define LOC_FACE (LOC_SEVEN_FLAG+3)
+
+#define HEADER_MIN 18
+#define HEADER_MAX 255
+
+
+string header;
+av_list header_list = NULL;
+unsigned header_max = HEADER_MIN-1;
+
+unsigned check_sum;
+boolean check_sum_specified;
+
+fix design_size;
+boolean design_size_specified;
+
+fix design_units;
+boolean design_units_specified;
+
+string coding_scheme;
+boolean coding_scheme_specified;
+
+string family;
+boolean family_specified;
+
+unsigned face;
+boolean face_specified;
+
+unsigned ofm_level;
+boolean ofm_level_specified;
+
+unsigned font_dir;
+boolean font_dir_specified;
+
+boolean seven_bit;
+boolean seven_bit_specified;
+boolean seven_bit_calculated;
+
+unsigned font_type = FT_VANILLA;
+
+unsigned lh;
+
+void
+store_header_int(unsigned loc, unsigned val)
+{
+ header[loc] = 0xff & (val >> 24) ;
+ header[loc+1] = 0xff & (val >> 16) ;
+ header[loc+2] = 0xff & (val >> 8) ;
+ header[loc+3] = 0xff & val ;
+}
+
+void
+store_header_byte(unsigned loc, unsigned val)
+{
+ header[loc] = 0xff & val ;
+}
+
+void
+retrieve_header_int(unsigned loc, unsigned *where)
+{
+ string ptr = header+loc;
+
+ *where = ((* ptr & 0xff) << 24) |
+ ((*(ptr+1) & 0xff) << 16) |
+ ((*(ptr+2) & 0xff) << 8) |
+ (*(ptr+3) & 0xff) ;
+
+}
+
+void
+retrieve_header_byte(unsigned loc, unsigned char *where)
+{
+ *where = header[loc];
+}
+
+/* HEADER */
+
+void
+init_header_word()
+{
+header_list = NULL;
+header_max = HEADER_MIN-1;
+font_type = FT_VANILLA;
+}
+
+void
+set_header_word(unsigned index, unsigned val)
+{
+ av_list L1, L2;
+
+ if (index > HEADER_MAX) {
+ warning_0("HEADER index must be at most 255; ignored");
+ return;
+ }
+ if (index < HEADER_MIN) {
+ warning_0("HEADER index must be at least 18; ignored");
+ return;
+ }
+ L1 = header_list;
+ if (L1 == NULL) {
+ header_list = av_list1(index, val);
+ header_max = index;
+ } else {
+ L2 = L1->ptr;
+ while ((L2 != NULL) && (lattr(L2) <= index)) {
+ L1 = L2;
+ L2 = L2->ptr;
+ }
+ if (index < lattr(L1)) {
+ header_list = av_list1(index, val);
+ header_list->ptr = L1;
+ } else if (index == lattr(L1)) {
+ warning_1("HEADER index (%d) previously defined; "
+ "old value ignored", index);
+ lval(L1) = val;
+ } else {
+ L2 = av_list1(index, val);
+ L2->ptr = L1->ptr;
+ if (L1->ptr==NULL) header_max = index;
+ L1->ptr = L2;
+ }
+ }
+}
+
+void
+store_header_word()
+{
+ av_list L = header_list;
+ unsigned ctr = HEADER_MIN;
+
+ header = (string) xmalloc(4*(header_max+1));
+ while (L != NULL) {
+ while (ctr<lattr(L)) {
+ store_header_int(ctr*4,0);
+ ctr++;
+ }
+ store_header_int(ctr*4,lval(L));
+ ctr++; L = L->ptr;
+ }
+}
+
+void
+retrieve_header_word()
+{
+ unsigned j = HEADER_MIN, value, header_no=lh;
+
+ header_list = NULL;
+ while (j <= header_no) {
+ retrieve_header_int(j*4, &value);
+ if (value != 0) {
+ set_header_word(j, value);
+ }
+ j++;
+ }
+}
+
+void
+print_header(void)
+{
+ av_list L = header_list;
+
+ print_check_sum();
+ print_design_size();
+ print_coding_scheme();
+ print_family();
+ print_face();
+ print_seven_bit_safe_flag();
+ while (L!=NULL) {
+ print_header_word(lattr(L),lval(L));
+ L = L->ptr;
+ }
+}
+
+/* CHECKSUM */
+
+void
+init_check_sum(void)
+{
+ check_sum = 0;
+ check_sum_specified = FALSE;
+}
+
+void
+set_check_sum(unsigned cs)
+{
+ check_sum = cs;
+ check_sum_specified = TRUE;
+}
+
+void
+store_check_sum(void)
+{
+
+ calculate_check_sum();
+ store_header_int(LOC_CHECK_SUM, check_sum);
+}
+
+void
+retrieve_check_sum(void)
+{
+ retrieve_header_int(LOC_CHECK_SUM, &check_sum);
+}
+
+void
+calculate_check_sum(void)
+{
+/*
+ if (check_sum_specified == FALSE) {
+ not_yet_done("checksum calculation");
+ }
+*/
+}
+
+
+/* DESIGNSIZE */
+
+void
+init_design_size()
+{
+ design_size = 10*UNITY;
+ design_size_specified = FALSE;
+}
+
+void
+set_design_size(fix ds)
+{
+ if (design_size_specified==TRUE)
+ warning_0("DESIGNSIZE previously defined; old value ignored");
+ if (ds<1) {
+ warning_0("DESIGNSIZE value must be at least 1; set to 10");
+ design_size = 10*UNITY;
+ } else {
+ design_size = ds;
+ }
+ design_size_specified = TRUE;
+}
+
+void
+store_design_size(void)
+{
+ store_header_int(LOC_DESIGN_SIZE, design_size);
+}
+
+void
+retrieve_design_size(void)
+{
+ retrieve_header_int(LOC_DESIGN_SIZE, (unsigned *) &design_size);
+}
+
+
+/* DESIGNUNITS */
+
+void
+init_design_units(void)
+{
+ design_units = UNITY;
+ design_units_specified = FALSE;
+}
+
+void
+set_design_units(fix du)
+{
+ if (design_units_specified==TRUE)
+ warning_0("DESIGNUNITS previously defined; old value ignored");
+ if (du<=0) {
+ warning_0("DESIGNUNITS value must be positive; set to 1");
+ design_units = UNITY;
+ } else {
+ design_units = du;
+ }
+ design_units_specified = TRUE;
+}
+
+
+/* CODINGSCHEME */
+
+void
+init_coding_scheme(void)
+{
+ coding_scheme = "UNSPECIFIED";
+ coding_scheme_specified = FALSE;
+}
+
+void
+set_coding_scheme(string sval)
+{
+ if (coding_scheme_specified==TRUE) {
+ warning_0("CODINGSCHEME previously defined; old value ignored");
+ free(coding_scheme); coding_scheme=NULL;
+ }
+ coding_scheme = sval;
+
+ if (!strncmp(coding_scheme, "TEX MATH SY", 11) ||
+ !strncmp(coding_scheme, "TeX math sy", 11))
+ font_type = FT_MATHSY;
+ else if (!strncmp(coding_scheme, "TEX MATH EX", 11) ||
+ !strncmp(coding_scheme, "TeX math ex", 11))
+ font_type = FT_MATHEX;
+ else font_type = FT_VANILLA;
+
+ coding_scheme_specified = TRUE;
+}
+
+void
+store_coding_scheme(void)
+{
+ register unsigned i=0, j=LOC_CODING_SCHEME, len=strlen(coding_scheme);
+
+ header[j] = len;
+ for (j++; i<len; i++,j++) header[j] = coding_scheme[i];
+ for (; j<(LOC_CODING_SCHEME+LEN_CODING_SCHEME); j++)
+ header[j] = '\0';;
+}
+
+
+void
+retrieve_coding_scheme(void)
+{
+ register unsigned i=0, j=LOC_CODING_SCHEME, len=header[LOC_CODING_SCHEME];
+
+ coding_scheme = (string) xmalloc(len+1);
+ for (j++; i<len; i++,j++) {
+ coding_scheme[i] = header[j];
+ if ((text_format == TEXT_CODE_UPPER) &&
+ (coding_scheme[i] >= 'a') &&
+ (coding_scheme[i] <= 'z')) {
+ coding_scheme[i] += 'A' - 'a';
+ }
+ }
+ coding_scheme[i] = '\0';
+ if (!strncmp(coding_scheme, "TEX MATH SY", 11) ||
+ !strncmp(coding_scheme, "TeX math sy", 11))
+ font_type = FT_MATHSY;
+ else if (!strncmp(coding_scheme, "TEX MATH EX", 11) ||
+ !strncmp(coding_scheme, "TeX math ex", 11))
+ font_type = FT_MATHEX;
+ else font_type = FT_VANILLA;
+}
+
+/* FAMILY */
+
+void
+init_family(void)
+{
+ family = "UNSPECIFIED";
+ family_specified = FALSE;
+}
+
+void
+set_family(string sval)
+{
+ if (family_specified==TRUE) {
+ warning_0("FAMILY previously defined; old value ignored");
+ free(family); family=NULL;
+ }
+ family = sval;
+ family_specified = TRUE;
+}
+
+void
+store_family(void)
+{
+ register unsigned i=0, j=LOC_FAMILY, len=strlen(family);
+
+ if (len>LEN_FAMILY) internal_error_1("store_family (len=%d)", len);
+ header[j] = len;
+ for (j++; i<len; i++,j++) header[j] = family[i];
+ for (; j<=(LOC_FAMILY+LEN_FAMILY); j++)
+ header[j] = '\0';;
+}
+
+
+void
+retrieve_family(void)
+{
+ register unsigned i=0, j=LOC_FAMILY, len=header[LOC_FAMILY];
+
+ family = (string) xmalloc(len+1);
+ for (j++; i<len; i++,j++) {
+ family[i] = header[j];
+ if ((text_format == TEXT_CODE_UPPER) &&
+ (family[i] >= 'a') &&
+ (family[i] <= 'z')) {
+ family[i] += 'A' - 'a';
+ }
+ }
+ family[i] = '\0';
+}
+
+/* FACE */
+
+void
+init_face()
+{
+ face = 0;
+ face_specified = FALSE;
+}
+
+void
+set_face(unsigned f)
+{
+ if (face_specified==TRUE)
+ warning_0("FACE previously defined; old value ignored");
+ if (face>255) {
+ warning_0("FACE value must be less than 256");
+ } else {
+ face = f;
+ }
+ face_specified = TRUE;
+}
+
+void
+store_face(void)
+{
+ store_header_byte(LOC_FACE, face);
+}
+
+void
+retrieve_face(void)
+{
+ unsigned char face_byte;
+ retrieve_header_byte(LOC_FACE, &face_byte);
+ face = face_byte;
+}
+
+/* OFMLEVEL */
+
+void
+init_ofm_level()
+{
+ ofm_level = OFM_TFM;
+ ofm_level_specified = FALSE;
+}
+
+void
+set_ofm_level(unsigned level)
+{
+ if (ofm_level_specified==TRUE)
+ warning_0("OFMLEVEL previously defined; old value ignored");
+ /* Fix from Joel Riou <joel.riou@normalesup.org> */
+ if ((level != 0) && (level != 1)) {
+ warning_0("OFMLEVEL value must be D 0 or D 1");
+ } else {
+ ofm_level = level ? OFM_LEVEL1 : OFM_LEVEL0;
+ }
+ ofm_level_specified = TRUE;
+}
+
+/* FONTDIR */
+
+void
+init_font_dir()
+{
+ font_dir = DIR_ORD+DIR_TL;
+ font_dir_specified = FALSE;
+}
+
+void
+set_font_dir(unsigned direction)
+{
+ if (font_dir_specified==TRUE)
+ warning_0("FONTDIR previously defined; old value ignored");
+ if ((direction < DIR_MIN) || (direction > DIR_MAX)) {
+ warning_0("bad FONTDIR value; ignored");
+ } else {
+ font_dir = direction;
+ }
+ font_dir_specified = TRUE;
+}
+
+/* SEVENBITSAFEFLAG */
+
+void
+init_seven_bit_safe_flag()
+{
+ seven_bit = 0;
+ seven_bit_calculated = 1;
+ seven_bit_specified = FALSE;
+}
+
+void
+set_seven_bit_safe_flag(unsigned f)
+{
+ if (seven_bit_specified==TRUE)
+ warning_0("SEVENBITSAFEFLAG previously defined; "
+ "old value ignored");
+ if ((f!=FALSE) && (f!=TRUE)) {
+ internal_error_1("set_seven_bit_safe_flag (f=%d)", f);
+ }
+ seven_bit = f;
+ seven_bit_specified = TRUE;
+}
+
+void
+store_seven_bit_safe_flag(void)
+{
+ store_header_byte(LOC_SEVEN_FLAG, seven_bit);
+}
+
+void
+retrieve_seven_bit_safe_flag(void)
+{
+ unsigned char seven_bit_byte;
+ retrieve_header_byte(LOC_SEVEN_FLAG, &seven_bit_byte);
+ seven_bit = (seven_bit_byte != 0);
+}
+
+void
+calculate_seven_bit_safe_flag(void)
+{
+ if ((seven_bit_specified == TRUE) && (seven_bit == 1) &&
+ (seven_bit_calculated == 0)) {
+ warning_0("SEVENBITSAFEFLAG value specified TRUE; "
+ "really FALSE");
+ }
+ seven_bit = seven_bit_calculated;
+}
+
+void
+init_header(void)
+{
+ init_header_word();
+ init_check_sum();
+ init_design_size();
+ init_design_units();
+ init_coding_scheme();
+ init_family();
+ init_face();
+ init_seven_bit_safe_flag();
+}
+
+void
+store_header(void)
+{
+
+ store_header_word();
+ store_check_sum();
+ store_design_size();
+ store_coding_scheme();
+ store_family();
+ store_face();
+ store_seven_bit_safe_flag();
+
+/*
+ { int i;
+ for (i=0; i<(4*(header_max+1)); i++) {
+ if (!(i%4)) fprintf(stdout, "\n");
+ fprintf(stdout, "%d: %c (%d, %2x) ",
+ i, header[i], header[i], header[i]);
+ }
+ fprintf(stdout, "\n");
+*/
+ if (header_list!=NULL) {
+ av_list L1 = header_list, L2;
+ while (L1 != NULL) {
+ L2 = L1->ptr;
+ free(L1);
+ L1 = L2;
+ }
+ }
+ lh = header_max;
+ header_list = NULL;
+ header_max = HEADER_MIN-1;
+
+ retrieve_header();
+}
+
+void
+retrieve_header(void)
+{
+ retrieve_header_word();
+ retrieve_check_sum();
+ retrieve_design_size();
+ retrieve_coding_scheme();
+ retrieve_family();
+ retrieve_face();
+ retrieve_seven_bit_safe_flag();
+}
+
+void
+output_ofm_header(void)
+{
+ unsigned i=0, j, k1, k2;
+
+ av_list L = header_list;
+
+ out_ofm_4(check_sum); i++;
+ out_ofm_4(design_size); i++;
+ k1 = strlen(coding_scheme);
+ out_ofm(k1);
+ for (j=0; j<k1; j++) out_ofm(coding_scheme[j]);
+ for (j=k1; j<LEN_CODING_SCHEME; j++) out_ofm(0);
+ k2 = strlen(family);
+ out_ofm(k2);
+ for (j=0; j<k2; j++) out_ofm(family[j]);
+ for (j=k2; j<LEN_FAMILY; j++) out_ofm(0);
+ if ((ofm_level==OFM_TFM) && (seven_bit_specified==TRUE))
+ out_ofm(seven_bit);
+ else
+ out_ofm(0);
+ out_ofm(0); out_ofm(0); out_ofm(face);
+ i = 1 + LOC_SEVEN_FLAG / 4;
+ lh = header_max + 1;
+ while(L != NULL) {
+ j=lattr(L);
+ while (i<j) {
+ out_ofm_4(0);
+ i++;
+ }
+ out_ofm_4(lval(L));
+ L = L->ptr; i++;
+ }
+ while (i<lh) {out_ofm_4(0); i++;}
+}
diff --git a/Build/source/texk/web2c/omegafonts/header_routines.h b/Build/source/texk/web2c/omegafonts/header_routines.h
new file mode 100644
index 00000000000..44b2483e03a
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/header_routines.h
@@ -0,0 +1,109 @@
+/* header_routines.h: Headers of font metric files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+extern string header;
+
+extern unsigned check_sum;
+extern boolean check_sum_specified;
+
+extern fix design_size;
+extern boolean design_size_specified;
+
+extern fix design_units;
+extern boolean design_units_specified;
+
+extern string coding_scheme;
+extern boolean coding_scheme_specified;
+
+extern string family;
+extern boolean family_specified;
+
+extern unsigned face;
+extern boolean face_specified;
+
+extern unsigned ofm_level;
+extern boolean ofm_level_specified;
+
+extern unsigned font_dir;
+extern boolean font_dir_specified;
+
+extern boolean seven_bit;
+extern boolean seven_bit_specified;
+extern boolean seven_bit_calculated;
+
+extern unsigned font_type;
+
+extern unsigned header_max;
+extern unsigned lh;
+
+extern void store_header_int(unsigned, unsigned);
+extern void store_header_byte(unsigned, unsigned);
+extern void retrieve_header_int(unsigned, unsigned *);
+extern void retrieve_header_byte(unsigned, unsigned char *);
+extern void set_header_word(unsigned, unsigned);
+
+extern void init_check_sum(void);
+extern void set_check_sum(unsigned);
+extern void store_check_sum(void);
+extern void retrieve_check_sum(void);
+extern void calculate_check_sum(void);
+
+extern void init_design_size(void);
+extern void set_design_size(fix);
+extern void store_design_size(void);
+extern void retrieve_design_size(void);
+
+extern void init_design_units(void);
+extern void set_design_units(fix);
+
+extern void init_coding_scheme(void);
+extern void set_coding_scheme(string );
+extern void store_coding_scheme(void);
+extern void retrieve_coding_scheme(void);
+
+extern void init_family(void);
+extern void set_family(string );
+extern void store_family(void);
+extern void retrieve_family(void);
+
+extern void init_face();
+extern void set_face(unsigned);
+extern void store_face(void);
+extern void retrieve_face(void);
+
+extern void init_seven_bit_safe_flag();
+extern void set_seven_bit_safe_flag(unsigned);
+extern void store_seven_bit_safe_flag(void);
+extern void retrieve_seven_bit_safe_flag(void);
+extern void calculate_seven_bit_safe_flag(void);
+
+extern void init_header(void);
+extern void store_header(void);
+extern void retrieve_header(void);
+extern void print_header(void);
+
+extern void output_ofm_header(void);
+
+extern void set_ofm_level(unsigned);
+extern void set_font_dir(unsigned);
+extern void output_ofm_header(void);
diff --git a/Build/source/texk/web2c/omegafonts/lex.yy.c-dist b/Build/source/texk/web2c/omegafonts/lex.yy.c-dist
new file mode 100644
index 00000000000..8e546c1e762
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/lex.yy.c-dist
@@ -0,0 +1,3390 @@
+
+#line 3 "lex.yy.c"
+
+#define YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 31
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t;
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else /* ! __cplusplus */
+
+#if __STDC__
+
+#define YY_USE_CONST
+
+#endif /* __STDC__ */
+#endif /* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index. If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition. This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state. The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE yyrestart(yyin )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+extern int yyleng;
+
+extern FILE *yyin, *yyout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+ /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires
+ * access to the local variable yy_act. Since yyless() is a macro, it would break
+ * existing scanners that call yyless() from OUTSIDE yylex.
+ * One obvious solution it to make yy_act a global. I tried that, and saw
+ * a 5% performance hit in a non-yylineno scanner, because yy_act is
+ * normally declared as a register variable-- so it is not worth it.
+ */
+ #define YY_LESS_LINENO(n) \
+ do { \
+ int yyl;\
+ for ( yyl = n; yyl < yyleng; ++yyl )\
+ if ( yytext[yyl] == '\n' )\
+ --yylineno;\
+ }while(0)
+
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ *yy_cp = (yy_hold_char); \
+ YY_RESTORE_YY_MORE_OFFSET \
+ (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+ YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+ } \
+ while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr) )
+
+/* The following is because we cannot portably get our hands on size_t
+ * (without autoconf's help, which isn't available because we want
+ * flex-generated scanners to compile on their own).
+ */
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef unsigned int yy_size_t;
+#endif
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+ {
+ FILE *yy_input_file;
+
+ char *yy_ch_buf; /* input buffer */
+ char *yy_buf_pos; /* current position in input buffer */
+
+ /* Size of input buffer in bytes, not including room for EOB
+ * characters.
+ */
+ yy_size_t yy_buf_size;
+
+ /* Number of characters read into yy_ch_buf, not including EOB
+ * characters.
+ */
+ int yy_n_chars;
+
+ /* Whether we "own" the buffer - i.e., we know we created it,
+ * and can realloc() it to grow it, and should free() it to
+ * delete it.
+ */
+ int yy_is_our_buffer;
+
+ /* Whether this is an "interactive" input source; if so, and
+ * if we're using stdio for input, then we want to use getc()
+ * instead of fread(), to make sure we stop fetching input after
+ * each newline.
+ */
+ int yy_is_interactive;
+
+ /* Whether we're considered to be at the beginning of a line.
+ * If so, '^' rules will be active on the next match, otherwise
+ * not.
+ */
+ int yy_at_bol;
+
+ int yy_bs_lineno; /**< The line count. */
+ int yy_bs_column; /**< The column count. */
+
+ /* Whether to try to fill the input buffer when we reach the
+ * end of it.
+ */
+ int yy_fill_buffer;
+
+ int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+ /* When an EOF's been seen but there's still some text to process
+ * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+ * shouldn't try reading from the input source any more. We might
+ * still have a bunch of tokens to match, though, because of
+ * possible backing-up.
+ *
+ * When we actually see the EOF, we change the status to "new"
+ * (via yyrestart()), so that the user can continue scanning by
+ * just pointing yyin at a new input file.
+ */
+#define YY_BUFFER_EOF_PENDING 2
+
+ };
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+ ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+ : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when yytext is formed. */
+static char yy_hold_char;
+static int yy_n_chars; /* number of characters read into yy_ch_buf */
+int yyleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 1; /* whether we need to initialize */
+static int yy_start = 0; /* start state number */
+
+/* Flag which is used to allow yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin. A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void yyrestart (FILE *input_file );
+void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer );
+YY_BUFFER_STATE yy_create_buffer (FILE *file,int size );
+void yy_delete_buffer (YY_BUFFER_STATE b );
+void yy_flush_buffer (YY_BUFFER_STATE b );
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer );
+void yypop_buffer_state (void );
+
+static void yyensure_buffer_stack (void );
+static void yy_load_buffer_state (void );
+static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file );
+
+#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size );
+YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str );
+YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,int len );
+
+void *yyalloc (yy_size_t );
+void *yyrealloc (void *,yy_size_t );
+void yyfree (void * );
+
+#define yy_new_buffer yy_create_buffer
+
+#define yy_set_interactive(is_interactive) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){ \
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+ }
+
+#define yy_set_bol(at_bol) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){\
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+ }
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+typedef unsigned char YY_CHAR;
+
+FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+
+typedef int yy_state_type;
+
+#define YY_FLEX_LEX_COMPAT
+extern int yylineno;
+
+int yylineno = 1;
+
+extern char yytext[];
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[] );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up yytext.
+ */
+#define YY_DO_BEFORE_ACTION \
+ (yytext_ptr) = yy_bp; \
+ yyleng = (size_t) (yy_cp - yy_bp); \
+ (yy_hold_char) = *yy_cp; \
+ *yy_cp = '\0'; \
+ if ( yyleng + (yy_more_offset) >= YYLMAX ) \
+ YY_FATAL_ERROR( "token too large, exceeds YYLMAX" ); \
+ yy_flex_strncpy( &yytext[(yy_more_offset)], (yytext_ptr), yyleng + 1 ); \
+ yyleng += (yy_more_offset); \
+ (yy_prev_more_offset) = (yy_more_offset); \
+ (yy_more_offset) = 0; \
+ (yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 197
+#define YY_END_OF_BUFFER 198
+/* This struct is not used in this scanner,
+ but its presence is necessary. */
+struct yy_trans_info
+ {
+ flex_int32_t yy_verify;
+ flex_int32_t yy_nxt;
+ };
+static yyconst flex_int16_t yy_acclist[258] =
+ { 0,
+ 9, 9, 198, 196, 197, 1, 196, 197, 2, 197,
+ 3, 196, 197, 4, 196, 197, 196, 197, 196, 197,
+ 196, 197, 196, 197, 196, 197, 196, 197, 196, 197,
+ 196, 197, 196, 197, 196, 197, 196, 197, 196, 197,
+ 196, 197, 196, 197, 196, 197, 196, 197, 196, 197,
+ 196, 197, 196, 197, 196, 197, 196, 197, 196, 197,
+ 196, 197, 1, 172, 42, 8, 8, 6, 171, 7,
+ 31, 44, 102, 41, 5, 107, 9, 43, 40, 46,
+ 163, 23, 170, 143, 45, 77, 78, 79, 106, 75,
+ 9, 142, 33, 32, 85, 86, 82, 83, 84, 173,
+
+ 47, 49, 164, 61, 67, 55, 60, 66, 54, 63,
+ 69, 57, 62, 68, 56, 59, 65, 53, 58, 64,
+ 52, 169, 30, 48, 180, 179, 181, 178, 70, 71,
+ 50, 38, 37, 39, 36, 167, 89, 90, 80, 81,
+ 11, 100, 139, 151, 24, 138, 110, 140, 174, 150,
+ 149, 148, 73, 12, 51, 16, 98, 141, 104, 105,
+ 15, 72, 88, 87, 35, 74, 175, 162, 161, 20,
+ 176, 165, 166, 14, 137, 13, 136, 156, 155, 154,
+ 27, 111, 109, 112, 177, 115, 28, 26, 101, 145,
+ 144, 114, 108, 146, 29, 193, 113, 91, 158, 157,
+
+ 159, 168, 21, 76, 120, 122, 119, 117, 123, 121,
+ 116, 118, 133, 132, 134, 153, 34, 147, 186, 191,
+ 194, 189, 103, 160, 22, 135, 152, 184, 187, 182,
+ 17, 25, 10, 99, 195, 93, 94, 95, 96, 97,
+ 188, 192, 190, 17, 185, 183, 128, 130, 127, 125,
+ 131, 129, 124, 126, 92, 18, 19
+ } ;
+
+static yyconst flex_int16_t yy_accept[784] =
+ { 0,
+ 1, 2, 3, 4, 6, 9, 11, 14, 17, 19,
+ 21, 23, 25, 27, 29, 31, 33, 35, 37, 39,
+ 41, 43, 45, 47, 49, 51, 53, 55, 57, 59,
+ 61, 63, 64, 64, 64, 64, 64, 64, 64, 64,
+ 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
+ 65, 65, 65, 65, 65, 65, 65, 65, 65, 65,
+ 65, 65, 65, 65, 65, 65, 65, 65, 65, 65,
+ 65, 65, 65, 65, 65, 65, 65, 65, 65, 65,
+ 65, 65, 65, 65, 65, 65, 65, 65, 65, 65,
+ 65, 65, 65, 65, 65, 65, 66, 66, 67, 68,
+
+ 68, 68, 68, 68, 68, 68, 68, 68, 68, 69,
+ 69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
+ 70, 70, 70, 70, 71, 71, 71, 72, 72, 73,
+ 74, 75, 75, 75, 75, 75, 75, 75, 76, 76,
+ 76, 76, 77, 77, 77, 77, 78, 78, 79, 79,
+ 79, 79, 79, 79, 79, 79, 79, 79, 79, 79,
+ 79, 79, 79, 80, 80, 80, 80, 80, 80, 81,
+ 81, 81, 81, 81, 81, 81, 81, 81, 82, 82,
+ 82, 82, 82, 82, 82, 82, 82, 82, 82, 82,
+ 82, 82, 82, 82, 82, 83, 83, 84, 84, 84,
+
+ 85, 85, 85, 85, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 87, 88, 89, 89, 89, 89, 89,
+ 90, 91, 92, 93, 93, 93, 93, 93, 93, 93,
+ 93, 93, 93, 93, 93, 93, 94, 94, 94, 94,
+ 95, 95, 96, 97, 97, 98, 99, 100, 100, 100,
+ 101, 101, 101, 101, 101, 102, 103, 103, 103, 103,
+ 103, 103, 104, 104, 104, 104, 104, 104, 104, 104,
+ 104, 104, 104, 104, 104, 104, 104, 104, 104, 104,
+ 104, 104, 104, 104, 104, 105, 106, 107, 108, 109,
+ 110, 111, 112, 113, 114, 115, 116, 117, 118, 119,
+
+ 120, 121, 122, 122, 123, 123, 123, 123, 123, 123,
+ 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
+ 123, 123, 123, 124, 125, 125, 125, 125, 125, 125,
+ 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
+ 125, 125, 125, 125, 125, 125, 125, 126, 127, 128,
+ 128, 128, 129, 129, 129, 129, 129, 129, 130, 131,
+ 131, 131, 131, 131, 131, 131, 131, 131, 131, 132,
+ 132, 132, 132, 132, 132, 132, 133, 133, 133, 134,
+ 135, 135, 135, 135, 135, 135, 136, 136, 137, 137,
+ 137, 137, 137, 137, 137, 138, 139, 140, 141, 141,
+
+ 141, 142, 142, 143, 143, 143, 143, 143, 143, 143,
+ 143, 143, 143, 143, 144, 144, 144, 144, 144, 144,
+ 145, 146, 147, 147, 147, 147, 147, 147, 147, 148,
+ 149, 149, 149, 150, 150, 150, 150, 150, 150, 150,
+ 150, 151, 152, 153, 153, 153, 153, 153, 153, 153,
+ 153, 153, 154, 154, 154, 154, 154, 154, 154, 155,
+ 155, 155, 156, 156, 156, 156, 156, 156, 156, 156,
+ 156, 156, 156, 156, 156, 156, 156, 156, 156, 157,
+ 157, 157, 157, 157, 157, 157, 157, 157, 157, 157,
+ 157, 157, 157, 157, 157, 157, 157, 157, 157, 157,
+
+ 157, 157, 157, 157, 157, 157, 158, 158, 158, 158,
+ 158, 158, 158, 158, 158, 158, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 160, 161, 161,
+ 162, 163, 164, 165, 165, 166, 167, 167, 168, 168,
+ 168, 168, 168, 168, 168, 169, 169, 169, 169, 169,
+ 170, 171, 172, 172, 173, 174, 174, 174, 174, 174,
+ 175, 175, 175, 175, 175, 175, 176, 176, 176, 177,
+ 177, 178, 178, 179, 180, 180, 180, 181, 181, 182,
+ 182, 183, 184, 184, 184, 184, 184, 185, 185, 185,
+ 185, 185, 185, 185, 185, 185, 185, 185, 185, 185,
+
+ 185, 185, 185, 185, 186, 186, 186, 187, 187, 188,
+ 188, 188, 188, 188, 188, 188, 188, 188, 188, 188,
+ 188, 189, 189, 189, 189, 189, 190, 190, 190, 190,
+ 190, 191, 191, 191, 192, 193, 194, 195, 195, 195,
+ 196, 196, 196, 196, 196, 196, 196, 196, 196, 197,
+ 197, 197, 197, 197, 197, 198, 199, 199, 199, 200,
+ 201, 202, 202, 203, 203, 203, 204, 204, 205, 205,
+ 206, 207, 208, 209, 210, 211, 212, 213, 214, 215,
+ 216, 216, 217, 217, 217, 218, 219, 219, 219, 220,
+ 220, 220, 220, 221, 222, 223, 224, 224, 224, 224,
+
+ 224, 225, 225, 225, 226, 226, 227, 228, 228, 228,
+ 229, 230, 231, 231, 231, 231, 231, 232, 232, 233,
+ 234, 234, 235, 235, 235, 235, 235, 236, 236, 236,
+ 236, 236, 237, 238, 239, 240, 241, 241, 241, 242,
+ 242, 242, 243, 244, 244, 245, 245, 245, 246, 247,
+ 247, 247, 247, 247, 247, 247, 247, 247, 247, 247,
+ 247, 248, 249, 250, 251, 252, 253, 254, 255, 255,
+ 255, 255, 255, 255, 255, 255, 256, 256, 256, 256,
+ 257, 258, 258
+ } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 2, 1, 1, 1, 1, 1, 1, 1, 4,
+ 5, 1, 6, 1, 6, 7, 8, 9, 10, 11,
+ 12, 13, 14, 9, 9, 15, 15, 1, 1, 1,
+ 1, 16, 1, 1, 17, 18, 19, 20, 21, 22,
+ 23, 24, 25, 1, 26, 27, 28, 29, 30, 31,
+ 32, 33, 34, 35, 36, 37, 38, 39, 40, 41,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1
+ } ;
+
+static yyconst flex_int32_t yy_meta[42] =
+ { 0,
+ 1, 2, 3, 1, 1, 4, 4, 1, 5, 5,
+ 5, 5, 5, 5, 6, 1, 7, 7, 7, 7,
+ 7, 7, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1
+ } ;
+
+static yyconst flex_int16_t yy_base[791] =
+ { 0,
+ 0, 0, 837, 838, 834, 838, 838, 838, 808, 15,
+ 18, 53, 42, 795, 44, 806, 43, 795, 798, 32,
+ 35, 61, 45, 68, 794, 69, 85, 799, 799, 33,
+ 29, 825, 801, 804, 799, 800, 23, 820, 794, 45,
+ 787, 71, 66, 798, 816, 73, 782, 97, 68, 789,
+ 786, 797, 777, 810, 794, 793, 780, 790, 784, 775,
+ 785, 767, 786, 767, 762, 767, 771, 796, 769, 763,
+ 766, 763, 768, 758, 774, 111, 759, 762, 95, 755,
+ 762, 769, 102, 40, 108, 754, 759, 750, 757, 760,
+ 759, 756, 761, 743, 746, 758, 745, 838, 771, 736,
+
+ 738, 751, 740, 750, 750, 741, 737, 735, 761, 745,
+ 736, 730, 734, 725, 102, 103, 104, 736, 731, 728,
+ 719, 726, 731, 749, 730, 722, 838, 727, 123, 725,
+ 729, 724, 717, 707, 707, 713, 130, 134, 713, 722,
+ 721, 838, 709, 712, 715, 0, 147, 838, 713, 141,
+ 712, 119, 711, 706, 699, 700, 709, 708, 695, 704,
+ 140, 152, 707, 688, 703, 686, 695, 702, 159, 698,
+ 693, 685, 696, 694, 692, 163, 686, 838, 690, 690,
+ 680, 687, 151, 671, 678, 677, 681, 686, 171, 174,
+ 178, 179, 184, 187, 838, 675, 674, 204, 664, 206,
+
+ 678, 662, 670, 680, 678, 664, 674, 182, 656, 658,
+ 663, 672, 838, 838, 838, 667, 659, 659, 75, 838,
+ 838, 0, 190, 140, 654, 649, 664, 657, 651, 660,
+ 660, 654, 641, 647, 646, 838, 639, 652, 647, 838,
+ 636, 838, 838, 637, 838, 838, 838, 636, 649, 838,
+ 643, 639, 642, 644, 647, 838, 641, 640, 626, 640,
+ 641, 838, 638, 625, 618, 627, 618, 136, 615, 630,
+ 135, 630, 615, 621, 626, 623, 616, 617, 616, 615,
+ 123, 167, 612, 606, 838, 838, 838, 838, 838, 838,
+ 838, 838, 838, 838, 838, 838, 838, 838, 838, 838,
+
+ 838, 838, 599, 838, 149, 614, 188, 600, 609, 598,
+ 597, 616, 611, 595, 609, 605, 592, 195, 587, 606,
+ 592, 603, 838, 838, 605, 593, 602, 590, 598, 593,
+ 586, 595, 598, 597, 586, 575, 590, 575, 217, 584,
+ 578, 576, 571, 585, 570, 568, 838, 838, 838, 582,
+ 570, 838, 565, 582, 571, 579, 570, 838, 838, 578,
+ 575, 563, 562, 572, 573, 568, 564, 566, 570, 552,
+ 559, 552, 561, 548, 545, 838, 562, 542, 838, 838,
+ 560, 559, 546, 543, 546, 838, 536, 838, 538, 536,
+ 534, 533, 531, 531, 838, 838, 838, 838, 202, 534,
+
+ 838, 543, 838, 542, 215, 537, 544, 524, 542, 541,
+ 529, 527, 528, 517, 536, 525, 518, 517, 518, 838,
+ 838, 511, 520, 511, 524, 506, 521, 519, 838, 504,
+ 513, 506, 838, 517, 502, 496, 501, 499, 513, 501,
+ 838, 838, 838, 510, 513, 218, 512, 506, 494, 505,
+ 500, 838, 497, 499, 491, 490, 499, 486, 838, 483,
+ 484, 838, 482, 492, 497, 484, 472, 490, 483, 488,
+ 481, 480, 489, 484, 483, 475, 468, 482, 838, 460,
+ 478, 465, 472, 467, 478, 477, 474, 471, 489, 449,
+ 462, 467, 460, 459, 464, 467, 462, 465, 448, 459,
+
+ 454, 457, 456, 459, 454, 838, 445, 444, 437, 447,
+ 453, 447, 445, 440, 445, 428, 443, 446, 221, 445,
+ 427, 421, 429, 437, 418, 426, 838, 838, 420, 430,
+ 838, 838, 838, 424, 838, 838, 418, 838, 427, 431,
+ 414, 429, 414, 410, 838, 409, 408, 416, 425, 838,
+ 838, 838, 417, 838, 838, 404, 398, 413, 418, 838,
+ 410, 406, 244, 413, 397, 838, 396, 395, 838, 403,
+ 838, 402, 838, 838, 399, 392, 838, 399, 838, 390,
+ 838, 838, 389, 396, 392, 400, 838, 387, 402, 384,
+ 378, 386, 394, 375, 386, 387, 378, 377, 384, 379,
+
+ 373, 385, 370, 838, 369, 378, 838, 378, 838, 380,
+ 379, 378, 363, 362, 375, 368, 373, 358, 371, 357,
+ 838, 223, 231, 233, 226, 838, 369, 368, 367, 352,
+ 838, 360, 366, 838, 838, 838, 838, 355, 350, 838,
+ 355, 354, 355, 346, 345, 352, 359, 341, 838, 339,
+ 339, 337, 354, 331, 838, 838, 340, 351, 838, 838,
+ 838, 327, 838, 338, 344, 838, 330, 838, 321, 838,
+ 838, 838, 838, 838, 838, 838, 838, 838, 838, 838,
+ 316, 838, 325, 311, 838, 838, 328, 306, 838, 304,
+ 301, 305, 310, 838, 306, 838, 301, 320, 298, 287,
+
+ 838, 298, 283, 838, 289, 838, 838, 296, 285, 293,
+ 838, 292, 274, 283, 281, 30, 106, 262, 838, 838,
+ 157, 838, 164, 181, 206, 227, 838, 220, 223, 238,
+ 0, 838, 838, 838, 838, 838, 236, 230, 838, 230,
+ 231, 838, 838, 240, 267, 251, 276, 838, 838, 263,
+ 255, 280, 260, 255, 258, 268, 269, 261, 287, 269,
+ 838, 838, 838, 838, 838, 838, 838, 838, 290, 259,
+ 278, 263, 263, 272, 264, 838, 267, 281, 284, 838,
+ 838, 838, 325, 331, 336, 342, 346, 348, 353, 356
+ } ;
+
+static yyconst flex_int16_t yy_def[791] =
+ { 0,
+ 782, 1, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 783, 782, 782,
+ 782, 782, 782, 782, 784, 782, 782, 782, 782, 782,
+ 782, 782, 782, 785, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 786, 782, 782,
+ 782, 782, 782, 782, 782, 787, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 783, 782,
+
+ 782, 782, 782, 782, 782, 782, 782, 782, 784, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 785, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 788, 787, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 788, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 789, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 790, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 789, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 0, 782, 782, 782, 782, 782, 782, 782, 782
+ } ;
+
+static yyconst flex_int16_t yy_nxt[880] =
+ { 0,
+ 4, 5, 6, 7, 8, 4, 4, 9, 4, 4,
+ 4, 4, 4, 4, 4, 4, 10, 11, 12, 13,
+ 14, 15, 16, 17, 18, 19, 20, 21, 22, 23,
+ 24, 25, 26, 27, 28, 29, 30, 4, 31, 4,
+ 4, 34, 36, 45, 54, 48, 68, 37, 58, 88,
+ 730, 60, 90, 35, 38, 91, 59, 96, 97, 61,
+ 49, 101, 46, 55, 62, 102, 69, 89, 50, 159,
+ 76, 63, 160, 51, 76, 39, 40, 64, 41, 42,
+ 52, 65, 43, 44, 70, 106, 118, 104, 71, 77,
+ 66, 105, 339, 107, 110, 119, 67, 72, 48, 111,
+
+ 73, 112, 340, 74, 78, 79, 113, 717, 80, 341,
+ 81, 82, 76, 150, 115, 83, 76, 146, 157, 84,
+ 85, 151, 158, 116, 117, 161, 189, 191, 193, 152,
+ 204, 153, 395, 396, 190, 192, 194, 232, 162, 213,
+ 214, 215, 138, 138, 138, 138, 138, 138, 782, 242,
+ 243, 233, 782, 146, 380, 384, 345, 205, 224, 244,
+ 225, 245, 246, 247, 226, 227, 255, 278, 228, 346,
+ 385, 248, 381, 279, 256, 229, 397, 398, 230, 263,
+ 737, 402, 264, 403, 265, 266, 267, 268, 738, 285,
+ 269, 286, 288, 270, 289, 271, 291, 294, 292, 295,
+
+ 272, 328, 297, 287, 298, 300, 290, 301, 329, 342,
+ 293, 296, 405, 343, 330, 739, 299, 331, 417, 302,
+ 305, 406, 306, 307, 316, 308, 309, 344, 310, 418,
+ 740, 311, 312, 437, 313, 483, 314, 484, 317, 318,
+ 319, 523, 488, 320, 592, 563, 438, 489, 672, 670,
+ 674, 741, 676, 742, 524, 671, 743, 593, 677, 744,
+ 746, 622, 747, 748, 749, 673, 750, 675, 782, 751,
+ 623, 732, 733, 734, 735, 736, 624, 752, 625, 753,
+ 754, 752, 759, 760, 761, 763, 765, 767, 769, 770,
+ 762, 769, 773, 768, 774, 775, 776, 755, 777, 778,
+
+ 779, 780, 764, 766, 781, 729, 756, 728, 727, 726,
+ 725, 771, 757, 724, 758, 723, 722, 721, 720, 719,
+ 718, 717, 716, 715, 772, 98, 98, 714, 98, 98,
+ 98, 98, 109, 713, 712, 109, 109, 124, 711, 710,
+ 124, 124, 124, 138, 709, 708, 138, 147, 707, 147,
+ 147, 147, 222, 222, 731, 706, 705, 731, 731, 731,
+ 745, 745, 745, 704, 703, 702, 701, 700, 699, 698,
+ 697, 696, 695, 694, 693, 692, 691, 690, 689, 688,
+ 687, 686, 685, 684, 683, 682, 681, 680, 679, 678,
+ 669, 668, 667, 666, 665, 664, 663, 662, 661, 660,
+
+ 659, 658, 657, 656, 655, 654, 653, 652, 651, 650,
+ 649, 648, 647, 646, 645, 644, 643, 642, 641, 640,
+ 639, 638, 637, 636, 635, 634, 633, 632, 631, 630,
+ 629, 628, 627, 626, 621, 620, 619, 618, 617, 616,
+ 615, 614, 613, 612, 611, 610, 609, 608, 607, 606,
+ 605, 604, 603, 602, 601, 600, 599, 598, 597, 596,
+ 595, 594, 591, 590, 589, 588, 587, 586, 585, 584,
+ 583, 582, 581, 580, 579, 578, 577, 576, 575, 574,
+ 573, 572, 571, 570, 569, 568, 567, 566, 565, 564,
+ 563, 562, 561, 560, 559, 558, 557, 556, 555, 554,
+
+ 553, 552, 551, 550, 549, 548, 547, 546, 545, 544,
+ 543, 542, 541, 540, 539, 538, 537, 536, 535, 534,
+ 533, 532, 531, 530, 529, 528, 527, 526, 525, 522,
+ 521, 520, 519, 518, 517, 516, 515, 514, 513, 512,
+ 511, 510, 509, 508, 507, 506, 505, 504, 503, 502,
+ 501, 500, 499, 498, 497, 496, 495, 494, 493, 492,
+ 491, 490, 487, 486, 485, 482, 481, 480, 479, 478,
+ 477, 476, 475, 474, 473, 472, 471, 470, 469, 468,
+ 467, 466, 465, 464, 463, 462, 461, 460, 459, 458,
+ 457, 456, 455, 454, 453, 452, 451, 450, 449, 448,
+
+ 447, 446, 445, 444, 443, 442, 441, 440, 439, 436,
+ 435, 434, 433, 432, 431, 430, 429, 428, 427, 426,
+ 425, 424, 423, 422, 421, 420, 419, 416, 415, 414,
+ 413, 412, 411, 410, 409, 408, 407, 404, 401, 400,
+ 399, 394, 393, 392, 391, 390, 389, 388, 387, 386,
+ 383, 382, 379, 378, 377, 376, 375, 374, 373, 372,
+ 371, 370, 369, 368, 367, 366, 365, 364, 363, 362,
+ 361, 360, 359, 358, 357, 356, 355, 354, 353, 352,
+ 351, 350, 349, 348, 347, 338, 337, 336, 335, 334,
+ 333, 332, 327, 326, 325, 324, 323, 322, 321, 315,
+
+ 304, 303, 284, 283, 282, 281, 280, 277, 276, 275,
+ 274, 273, 262, 261, 260, 259, 258, 257, 254, 253,
+ 252, 251, 250, 249, 241, 240, 239, 238, 237, 236,
+ 235, 234, 231, 223, 221, 220, 219, 218, 217, 216,
+ 212, 211, 210, 209, 208, 207, 206, 203, 202, 201,
+ 782, 200, 199, 198, 197, 196, 195, 188, 187, 186,
+ 185, 184, 782, 183, 182, 181, 180, 179, 178, 177,
+ 176, 175, 99, 174, 173, 172, 171, 170, 169, 168,
+ 167, 166, 165, 164, 163, 156, 155, 154, 149, 148,
+ 145, 144, 143, 142, 141, 140, 139, 68, 137, 136,
+
+ 135, 134, 133, 132, 131, 130, 129, 128, 127, 126,
+ 125, 54, 123, 122, 121, 120, 114, 45, 108, 103,
+ 100, 99, 95, 94, 93, 92, 32, 87, 86, 75,
+ 57, 56, 53, 47, 33, 32, 782, 3, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782
+ } ;
+
+static yyconst flex_int16_t yy_chk[880] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 10, 11, 13, 17, 15, 23, 11, 20, 30,
+ 716, 21, 31, 10, 12, 31, 20, 37, 37, 21,
+ 15, 40, 13, 17, 21, 40, 23, 30, 15, 84,
+ 26, 21, 84, 15, 26, 12, 12, 22, 12, 12,
+ 15, 22, 12, 12, 24, 43, 49, 42, 24, 26,
+ 22, 42, 219, 43, 46, 49, 22, 24, 48, 46,
+
+ 24, 46, 219, 24, 26, 27, 46, 717, 27, 219,
+ 27, 27, 76, 79, 48, 27, 76, 76, 83, 27,
+ 27, 79, 83, 48, 48, 85, 115, 116, 117, 79,
+ 129, 79, 281, 281, 115, 116, 117, 152, 85, 137,
+ 137, 137, 138, 138, 138, 138, 138, 138, 147, 161,
+ 161, 152, 147, 147, 268, 271, 224, 129, 150, 161,
+ 150, 162, 162, 162, 150, 150, 169, 183, 150, 224,
+ 271, 162, 268, 183, 169, 150, 282, 282, 150, 176,
+ 721, 305, 176, 305, 176, 176, 176, 176, 723, 189,
+ 176, 189, 190, 176, 190, 176, 191, 192, 191, 192,
+
+ 176, 208, 193, 189, 193, 194, 190, 194, 208, 223,
+ 191, 192, 307, 223, 208, 724, 193, 208, 318, 194,
+ 198, 307, 198, 198, 200, 198, 198, 223, 198, 318,
+ 725, 198, 198, 339, 198, 399, 198, 399, 200, 200,
+ 200, 446, 405, 200, 519, 563, 339, 405, 623, 622,
+ 624, 726, 625, 728, 446, 622, 729, 519, 625, 730,
+ 737, 563, 738, 740, 741, 623, 744, 624, 745, 746,
+ 563, 718, 718, 718, 718, 718, 563, 747, 563, 750,
+ 751, 752, 753, 754, 755, 756, 757, 758, 759, 760,
+ 755, 769, 770, 758, 771, 772, 773, 752, 774, 775,
+
+ 777, 778, 756, 757, 779, 715, 752, 714, 713, 712,
+ 710, 769, 752, 709, 752, 708, 705, 703, 702, 700,
+ 699, 698, 697, 695, 769, 783, 783, 693, 783, 783,
+ 783, 783, 784, 692, 691, 784, 784, 785, 690, 688,
+ 785, 785, 785, 786, 687, 684, 786, 787, 683, 787,
+ 787, 787, 788, 788, 789, 681, 669, 789, 789, 789,
+ 790, 790, 790, 667, 665, 664, 662, 658, 657, 654,
+ 653, 652, 651, 650, 648, 647, 646, 645, 644, 643,
+ 642, 641, 639, 638, 633, 632, 630, 629, 628, 627,
+ 620, 619, 618, 617, 616, 615, 614, 613, 612, 611,
+
+ 610, 608, 606, 605, 603, 602, 601, 600, 599, 598,
+ 597, 596, 595, 594, 593, 592, 591, 590, 589, 588,
+ 586, 585, 584, 583, 580, 578, 576, 575, 572, 570,
+ 568, 567, 565, 564, 562, 561, 559, 558, 557, 556,
+ 553, 549, 548, 547, 546, 544, 543, 542, 541, 540,
+ 539, 537, 534, 530, 529, 526, 525, 524, 523, 522,
+ 521, 520, 518, 517, 516, 515, 514, 513, 512, 511,
+ 510, 509, 508, 507, 505, 504, 503, 502, 501, 500,
+ 499, 498, 497, 496, 495, 494, 493, 492, 491, 490,
+ 489, 488, 487, 486, 485, 484, 483, 482, 481, 480,
+
+ 478, 477, 476, 475, 474, 473, 472, 471, 470, 469,
+ 468, 467, 466, 465, 464, 463, 461, 460, 458, 457,
+ 456, 455, 454, 453, 451, 450, 449, 448, 447, 445,
+ 444, 440, 439, 438, 437, 436, 435, 434, 432, 431,
+ 430, 428, 427, 426, 425, 424, 423, 422, 419, 418,
+ 417, 416, 415, 414, 413, 412, 411, 410, 409, 408,
+ 407, 406, 404, 402, 400, 394, 393, 392, 391, 390,
+ 389, 387, 385, 384, 383, 382, 381, 378, 377, 375,
+ 374, 373, 372, 371, 370, 369, 368, 367, 366, 365,
+ 364, 363, 362, 361, 360, 357, 356, 355, 354, 353,
+
+ 351, 350, 346, 345, 344, 343, 342, 341, 340, 338,
+ 337, 336, 335, 334, 333, 332, 331, 330, 329, 328,
+ 327, 326, 325, 322, 321, 320, 319, 317, 316, 315,
+ 314, 313, 312, 311, 310, 309, 308, 306, 303, 284,
+ 283, 280, 279, 278, 277, 276, 275, 274, 273, 272,
+ 270, 269, 267, 266, 265, 264, 263, 261, 260, 259,
+ 258, 257, 255, 254, 253, 252, 251, 249, 248, 244,
+ 241, 239, 238, 237, 235, 234, 233, 232, 231, 230,
+ 229, 228, 227, 226, 225, 218, 217, 216, 212, 211,
+ 210, 209, 207, 206, 205, 204, 203, 202, 201, 199,
+
+ 197, 196, 188, 187, 186, 185, 184, 182, 181, 180,
+ 179, 177, 175, 174, 173, 172, 171, 170, 168, 167,
+ 166, 165, 164, 163, 160, 159, 158, 157, 156, 155,
+ 154, 153, 151, 149, 145, 144, 143, 141, 140, 139,
+ 136, 135, 134, 133, 132, 131, 130, 128, 126, 125,
+ 124, 123, 122, 121, 120, 119, 118, 114, 113, 112,
+ 111, 110, 109, 108, 107, 106, 105, 104, 103, 102,
+ 101, 100, 99, 97, 96, 95, 94, 93, 92, 91,
+ 90, 89, 88, 87, 86, 82, 81, 80, 78, 77,
+ 75, 74, 73, 72, 71, 70, 69, 68, 67, 66,
+
+ 65, 64, 63, 62, 61, 60, 59, 58, 57, 56,
+ 55, 54, 53, 52, 51, 50, 47, 45, 44, 41,
+ 39, 38, 36, 35, 34, 33, 32, 29, 28, 25,
+ 19, 18, 16, 14, 9, 5, 3, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782, 782,
+ 782, 782, 782, 782, 782, 782, 782, 782, 782
+ } ;
+
+/* Table of booleans, true if rule could match eol. */
+static yyconst flex_int32_t yy_rule_can_match_eol[198] =
+ { 0,
+0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, };
+
+extern int yy_flex_debug;
+int yy_flex_debug = 0;
+
+static yy_state_type *yy_state_buf=0, *yy_state_ptr=0;
+static char *yy_full_match;
+static int yy_lp;
+#define REJECT \
+{ \
+*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ \
+yy_cp = (yy_full_match); /* restore poss. backed-over text */ \
+++(yy_lp); \
+goto find_rule; \
+}
+
+static int yy_more_offset = 0;
+static int yy_prev_more_offset = 0;
+#define yymore() ((yy_more_offset) = yy_flex_strlen( yytext ))
+#define YY_NEED_STRLEN
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET \
+ { \
+ (yy_more_offset) = (yy_prev_more_offset); \
+ yyleng -= (yy_more_offset); \
+ }
+#ifndef YYLMAX
+#define YYLMAX 8192
+#endif
+
+char yytext[YYLMAX];
+char *yytext_ptr;
+#line 1 "./pl.l"
+#line 2 "./pl.l"
+/* pl.l: Lexical analysis of property list files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+Copyright (c) 2002 Roozbeh Pournader
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include <string.h>
+#ifdef WIN32
+#include <win32lib.h>
+#endif
+#include "parser.h"
+#include "kpathsea/types.h"
+#include "y_tab.h"
+#include "manifests.h"
+#include "error_routines.h"
+#ifdef __cplusplus
+#define yyinput input
+#endif
+
+int line_number = 1;
+extern YYSTYPE yylval;
+
+/* POTENTIAL BUG: saved_text could be run over; should check */
+#define MAX_PTR 10000
+char saved_text[MAX_PTR];
+
+extern void scan_int(unsigned);
+extern void scan_char(void);
+extern void scan_fix(void);
+extern void scan_string(char *, unsigned, unsigned);
+extern void scan_hex_string();
+
+/* from kpathsea, but avoid including kpathsea header files */
+extern char *xstrdup (const char *);
+
+#define KEEP_MIN 0
+#define KEEP_NONE 0
+#define KEEP_ALL 1
+#define KEEP_CONVERT 2
+#define KEEP_MAX 2
+
+#define BASE_MIN 2
+#define BASE_MAX 16
+
+/* For Solaris's lex, to increase tables sizes --RP */
+/* Space before number keeps ancient flex happy. */
+#line 1036 "lex.yy.c"
+
+#define INITIAL 0
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int yywrap (void );
+#else
+extern int yywrap (void );
+#endif
+#endif
+
+ static void yyunput (int c,char *buf_ptr );
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO (void) fwrite( yytext, yyleng, 1, yyout )
+#endif
+
+/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+ { \
+ int c = '*'; \
+ size_t n; \
+ for ( n = 0; n < max_size && \
+ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+ buf[n] = (char) c; \
+ if ( c == '\n' ) \
+ buf[n++] = (char) c; \
+ if ( c == EOF && ferror( yyin ) ) \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ result = n; \
+ } \
+ else \
+ { \
+ errno=0; \
+ while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \
+ { \
+ if( errno != EINTR) \
+ { \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ break; \
+ } \
+ errno=0; \
+ clearerr(yyin); \
+ } \
+ }\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int yylex (void);
+
+#define YY_DECL int yylex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after yytext and yyleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+ YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp, *yy_bp;
+ register int yy_act;
+
+#line 80 "./pl.l"
+
+
+#line 1190 "lex.yy.c"
+
+ if ( (yy_init) )
+ {
+ (yy_init) = 0;
+
+#ifdef YY_USER_INIT
+ YY_USER_INIT;
+#endif
+
+ if ( ! (yy_state_buf) )
+ (yy_state_buf) = (yy_state_type *)yyalloc(YY_BUF_SIZE + 2 );
+
+ if ( ! (yy_start) )
+ (yy_start) = 1; /* first start state */
+
+ if ( ! yyin )
+ yyin = stdin;
+
+ if ( ! yyout )
+ yyout = stdout;
+
+ if ( ! YY_CURRENT_BUFFER ) {
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_load_buffer_state( );
+ }
+
+ while ( 1 ) /* loops until end-of-file is reached */
+ {
+ yy_cp = (yy_c_buf_p);
+
+ /* Support of yytext. */
+ *yy_cp = (yy_hold_char);
+
+ /* yy_bp points to the position in yy_ch_buf of the start of
+ * the current run.
+ */
+ yy_bp = yy_cp;
+
+ yy_current_state = (yy_start);
+
+ (yy_state_ptr) = (yy_state_buf);
+ *(yy_state_ptr)++ = yy_current_state;
+
+yy_match:
+ do
+ {
+ register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 783 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *(yy_state_ptr)++ = yy_current_state;
+ ++yy_cp;
+ }
+ while ( yy_base[yy_current_state] != 838 );
+
+yy_find_action:
+ yy_current_state = *--(yy_state_ptr);
+ (yy_lp) = yy_accept[yy_current_state];
+find_rule: /* we branch to this label when backing up */
+ for ( ; ; ) /* until we find what rule we matched */
+ {
+ if ( (yy_lp) && (yy_lp) < yy_accept[yy_current_state + 1] )
+ {
+ yy_act = yy_acclist[(yy_lp)];
+ {
+ (yy_full_match) = yy_cp;
+ break;
+ }
+ }
+ --yy_cp;
+ yy_current_state = *--(yy_state_ptr);
+ (yy_lp) = yy_accept[yy_current_state];
+ }
+
+ YY_DO_BEFORE_ACTION;
+
+ if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] )
+ {
+ int yyl;
+ for ( yyl = (yy_prev_more_offset); yyl < yyleng; ++yyl )
+ if ( yytext[yyl] == '\n' )
+
+ yylineno++;
+;
+ }
+
+do_action: /* This label is used only to access EOF actions. */
+
+ switch ( yy_act )
+ { /* beginning of action switch */
+case 1:
+YY_RULE_SETUP
+#line 82 "./pl.l"
+{}
+ YY_BREAK
+case 2:
+/* rule 2 can match eol */
+YY_RULE_SETUP
+#line 83 "./pl.l"
+{line_number++; }
+ YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 85 "./pl.l"
+return(LEFT);
+ YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 86 "./pl.l"
+return(RIGHT);
+ YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 88 "./pl.l"
+{scan_int(8); return(NUMBER); }
+ YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 89 "./pl.l"
+{scan_int(10); return(NUMBER); }
+ YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 90 "./pl.l"
+{scan_int(16); return(NUMBER); }
+ YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 91 "./pl.l"
+{scan_char(); return(NUMBER); }
+ YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 92 "./pl.l"
+{scan_fix(); return(FIX); }
+ YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 94 "./pl.l"
+{scan_string("CODINGSCHEME", KEEP_CONVERT, LEN_CODING_SCHEME);
+ return(CODINGSCHEME); }
+ YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 96 "./pl.l"
+{scan_string("FAMILY", KEEP_CONVERT, LEN_FAMILY);
+ return(FAMILY); }
+ YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 98 "./pl.l"
+{scan_string("VTITLE", KEEP_ALL, LEN_VTITLE);
+ return(VTITLE); }
+ YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 100 "./pl.l"
+{scan_string("FONTNAME", KEEP_ALL, LEN_FONT_NAME);
+ return(FONTNAME); }
+ YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 102 "./pl.l"
+{scan_string("FONTAREA", KEEP_ALL, LEN_FONT_AREA);
+ return(FONTAREA); }
+ YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 104 "./pl.l"
+{scan_string("SPECIAL", KEEP_ALL, 0);
+ return(SPECIAL); }
+ YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 106 "./pl.l"
+{scan_string("COMMENT", KEEP_NONE, 0);
+ return(COMMENT); }
+ YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 109 "./pl.l"
+{scan_hex_string(); return(SPECIALHEX); }
+ YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 112 "./pl.l"
+{yylval.yint=1; return(SEVENBITSAFEFLAG); }
+ YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 113 "./pl.l"
+{yylval.yint=0; return(SEVENBITSAFEFLAG); }
+ YY_BREAK
+case 20:
+YY_RULE_SETUP
+#line 115 "./pl.l"
+return(CHECKSUM);
+ YY_BREAK
+case 21:
+YY_RULE_SETUP
+#line 116 "./pl.l"
+return(DESIGNSIZE);
+ YY_BREAK
+case 22:
+YY_RULE_SETUP
+#line 117 "./pl.l"
+return(DESIGNUNITS);
+ YY_BREAK
+case 23:
+YY_RULE_SETUP
+#line 118 "./pl.l"
+return(FACE);
+ YY_BREAK
+case 24:
+YY_RULE_SETUP
+#line 119 "./pl.l"
+return(HEADER);
+ YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 120 "./pl.l"
+return(BOUNDARYCHAR);
+ YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 121 "./pl.l"
+return(FONTDIMEN);
+ YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 122 "./pl.l"
+return(LIGTABLE);
+ YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 123 "./pl.l"
+return(CHARACTER);
+ YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 125 "./pl.l"
+return(PARAMETER);
+ YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 126 "./pl.l"
+return(LABEL);
+ YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 127 "./pl.l"
+return(KRN);
+ YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 128 "./pl.l"
+return(STOP);
+ YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 129 "./pl.l"
+return(SKIP);
+ YY_BREAK
+case 34:
+YY_RULE_SETUP
+#line 130 "./pl.l"
+return(NEXTLARGER);
+ YY_BREAK
+case 35:
+YY_RULE_SETUP
+#line 131 "./pl.l"
+return(VARCHAR);
+ YY_BREAK
+case 36:
+YY_RULE_SETUP
+#line 133 "./pl.l"
+{yylval.yint = C_WD; return(CHARMEASURE); }
+ YY_BREAK
+case 37:
+YY_RULE_SETUP
+#line 134 "./pl.l"
+{yylval.yint = C_HT; return(CHARMEASURE); }
+ YY_BREAK
+case 38:
+YY_RULE_SETUP
+#line 135 "./pl.l"
+{yylval.yint = C_DP; return(CHARMEASURE); }
+ YY_BREAK
+case 39:
+YY_RULE_SETUP
+#line 136 "./pl.l"
+{yylval.yint = C_IC; return(CHARMEASURE); }
+ YY_BREAK
+case 40:
+YY_RULE_SETUP
+#line 138 "./pl.l"
+{yylval.yint = E_TOP; return(EXTEN); }
+ YY_BREAK
+case 41:
+YY_RULE_SETUP
+#line 139 "./pl.l"
+{yylval.yint = E_MID; return(EXTEN); }
+ YY_BREAK
+case 42:
+YY_RULE_SETUP
+#line 140 "./pl.l"
+{yylval.yint = E_BOT; return(EXTEN); }
+ YY_BREAK
+case 43:
+YY_RULE_SETUP
+#line 141 "./pl.l"
+{yylval.yint = E_REP; return(EXTEN); }
+ YY_BREAK
+case 44:
+YY_RULE_SETUP
+#line 143 "./pl.l"
+{yylval.yint = L_0; return(LIG); }
+ YY_BREAK
+case 45:
+YY_RULE_SETUP
+#line 144 "./pl.l"
+{yylval.yint = L_B; return(LIG); }
+ YY_BREAK
+case 46:
+YY_RULE_SETUP
+#line 145 "./pl.l"
+{yylval.yint = L_A; return(LIG); }
+ YY_BREAK
+case 47:
+YY_RULE_SETUP
+#line 146 "./pl.l"
+{yylval.yint = L_AB; return(LIG); }
+ YY_BREAK
+case 48:
+YY_RULE_SETUP
+#line 147 "./pl.l"
+{yylval.yint = L_Bx; return(LIG); }
+ YY_BREAK
+case 49:
+YY_RULE_SETUP
+#line 148 "./pl.l"
+{yylval.yint = L_Ax; return(LIG); }
+ YY_BREAK
+case 50:
+YY_RULE_SETUP
+#line 149 "./pl.l"
+{yylval.yint = L_ABx; return(LIG); }
+ YY_BREAK
+case 51:
+YY_RULE_SETUP
+#line 150 "./pl.l"
+{yylval.yint = L_ABxx; return(LIG); }
+ YY_BREAK
+case 52:
+YY_RULE_SETUP
+#line 152 "./pl.l"
+{yylval.yint = F_MRR; return(NUMBER); }
+ YY_BREAK
+case 53:
+YY_RULE_SETUP
+#line 153 "./pl.l"
+{yylval.yint = F_MIR; return(NUMBER); }
+ YY_BREAK
+case 54:
+YY_RULE_SETUP
+#line 154 "./pl.l"
+{yylval.yint = F_BRR; return(NUMBER); }
+ YY_BREAK
+case 55:
+YY_RULE_SETUP
+#line 155 "./pl.l"
+{yylval.yint = F_BIR; return(NUMBER); }
+ YY_BREAK
+case 56:
+YY_RULE_SETUP
+#line 156 "./pl.l"
+{yylval.yint = F_LRR; return(NUMBER); }
+ YY_BREAK
+case 57:
+YY_RULE_SETUP
+#line 157 "./pl.l"
+{yylval.yint = F_LIR; return(NUMBER); }
+ YY_BREAK
+case 58:
+YY_RULE_SETUP
+#line 158 "./pl.l"
+{yylval.yint = F_MRC; return(NUMBER); }
+ YY_BREAK
+case 59:
+YY_RULE_SETUP
+#line 159 "./pl.l"
+{yylval.yint = F_MIC; return(NUMBER); }
+ YY_BREAK
+case 60:
+YY_RULE_SETUP
+#line 160 "./pl.l"
+{yylval.yint = F_BRC; return(NUMBER); }
+ YY_BREAK
+case 61:
+YY_RULE_SETUP
+#line 161 "./pl.l"
+{yylval.yint = F_BIC; return(NUMBER); }
+ YY_BREAK
+case 62:
+YY_RULE_SETUP
+#line 162 "./pl.l"
+{yylval.yint = F_LRC; return(NUMBER); }
+ YY_BREAK
+case 63:
+YY_RULE_SETUP
+#line 163 "./pl.l"
+{yylval.yint = F_LIC; return(NUMBER); }
+ YY_BREAK
+case 64:
+YY_RULE_SETUP
+#line 164 "./pl.l"
+{yylval.yint = F_MRE; return(NUMBER); }
+ YY_BREAK
+case 65:
+YY_RULE_SETUP
+#line 165 "./pl.l"
+{yylval.yint = F_MIE; return(NUMBER); }
+ YY_BREAK
+case 66:
+YY_RULE_SETUP
+#line 166 "./pl.l"
+{yylval.yint = F_BRE; return(NUMBER); }
+ YY_BREAK
+case 67:
+YY_RULE_SETUP
+#line 167 "./pl.l"
+{yylval.yint = F_BIE; return(NUMBER); }
+ YY_BREAK
+case 68:
+YY_RULE_SETUP
+#line 168 "./pl.l"
+{yylval.yint = F_LRE; return(NUMBER); }
+ YY_BREAK
+case 69:
+YY_RULE_SETUP
+#line 169 "./pl.l"
+{yylval.yint = F_LIE; return(NUMBER); }
+ YY_BREAK
+case 70:
+YY_RULE_SETUP
+#line 171 "./pl.l"
+{yylval.yint = P_SLANT; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 71:
+YY_RULE_SETUP
+#line 172 "./pl.l"
+{yylval.yint = P_SPACE; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 72:
+YY_RULE_SETUP
+#line 173 "./pl.l"
+{yylval.yint = P_STRETCH; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 73:
+YY_RULE_SETUP
+#line 174 "./pl.l"
+{yylval.yint = P_SHRINK; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 74:
+YY_RULE_SETUP
+#line 175 "./pl.l"
+{yylval.yint = P_XHEIGHT; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 75:
+YY_RULE_SETUP
+#line 176 "./pl.l"
+{yylval.yint = P_QUAD; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 76:
+YY_RULE_SETUP
+#line 177 "./pl.l"
+{yylval.yint = P_EXTRASPACE; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 77:
+YY_RULE_SETUP
+#line 178 "./pl.l"
+{yylval.yint = P_NUM1; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 78:
+YY_RULE_SETUP
+#line 179 "./pl.l"
+{yylval.yint = P_NUM2; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 79:
+YY_RULE_SETUP
+#line 180 "./pl.l"
+{yylval.yint = P_NUM3; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 80:
+YY_RULE_SETUP
+#line 181 "./pl.l"
+{yylval.yint = P_DENOM1; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 81:
+YY_RULE_SETUP
+#line 182 "./pl.l"
+{yylval.yint = P_DENOM2; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 82:
+YY_RULE_SETUP
+#line 183 "./pl.l"
+{yylval.yint = P_SUP1; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 83:
+YY_RULE_SETUP
+#line 184 "./pl.l"
+{yylval.yint = P_SUP2; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 84:
+YY_RULE_SETUP
+#line 185 "./pl.l"
+{yylval.yint = P_SUP3; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 85:
+YY_RULE_SETUP
+#line 186 "./pl.l"
+{yylval.yint = P_SUB1; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 86:
+YY_RULE_SETUP
+#line 187 "./pl.l"
+{yylval.yint = P_SUB2; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 87:
+YY_RULE_SETUP
+#line 188 "./pl.l"
+{yylval.yint = P_SUPDROP; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 88:
+YY_RULE_SETUP
+#line 189 "./pl.l"
+{yylval.yint = P_SUBDROP; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 89:
+YY_RULE_SETUP
+#line 190 "./pl.l"
+{yylval.yint = P_DELIM1; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 90:
+YY_RULE_SETUP
+#line 191 "./pl.l"
+{yylval.yint = P_DELIM2; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 91:
+YY_RULE_SETUP
+#line 192 "./pl.l"
+{yylval.yint = P_AXISHEIGHT; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 92:
+YY_RULE_SETUP
+#line 194 "./pl.l"
+{yylval.yint = P_DEFAULTRULETHICKNESS;
+ return(NAMEDPARAMETER); }
+ YY_BREAK
+case 93:
+YY_RULE_SETUP
+#line 196 "./pl.l"
+{yylval.yint = P_BIGOPSPACING1; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 94:
+YY_RULE_SETUP
+#line 197 "./pl.l"
+{yylval.yint = P_BIGOPSPACING2; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 95:
+YY_RULE_SETUP
+#line 198 "./pl.l"
+{yylval.yint = P_BIGOPSPACING3; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 96:
+YY_RULE_SETUP
+#line 199 "./pl.l"
+{yylval.yint = P_BIGOPSPACING4; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 97:
+YY_RULE_SETUP
+#line 200 "./pl.l"
+{yylval.yint = P_BIGOPSPACING5; return(NAMEDPARAMETER); }
+ YY_BREAK
+case 98:
+YY_RULE_SETUP
+#line 202 "./pl.l"
+{return(MAPFONT); }
+ YY_BREAK
+case 99:
+YY_RULE_SETUP
+#line 203 "./pl.l"
+{return(FONTCHECKSUM); }
+ YY_BREAK
+case 100:
+YY_RULE_SETUP
+#line 204 "./pl.l"
+{return(FONTAT); }
+ YY_BREAK
+case 101:
+YY_RULE_SETUP
+#line 205 "./pl.l"
+{return(FONTDSIZE); }
+ YY_BREAK
+case 102:
+YY_RULE_SETUP
+#line 206 "./pl.l"
+{return(MAP); }
+ YY_BREAK
+case 103:
+YY_RULE_SETUP
+#line 207 "./pl.l"
+{return(SELECTFONT); }
+ YY_BREAK
+case 104:
+YY_RULE_SETUP
+#line 208 "./pl.l"
+{return(SETCHAR); }
+ YY_BREAK
+case 105:
+YY_RULE_SETUP
+#line 209 "./pl.l"
+{return(SETRULE); }
+ YY_BREAK
+case 106:
+YY_RULE_SETUP
+#line 210 "./pl.l"
+{return(PUSH); }
+ YY_BREAK
+case 107:
+YY_RULE_SETUP
+#line 211 "./pl.l"
+{return(POP); }
+ YY_BREAK
+case 108:
+YY_RULE_SETUP
+#line 213 "./pl.l"
+{yylval.yint = M_RIGHT; return(MOVE); }
+ YY_BREAK
+case 109:
+YY_RULE_SETUP
+#line 214 "./pl.l"
+{yylval.yint = M_LEFT; return(MOVE); }
+ YY_BREAK
+case 110:
+YY_RULE_SETUP
+#line 215 "./pl.l"
+{yylval.yint = M_UP; return(MOVE); }
+ YY_BREAK
+case 111:
+YY_RULE_SETUP
+#line 216 "./pl.l"
+{yylval.yint = M_DOWN; return(MOVE); }
+ YY_BREAK
+case 112:
+YY_RULE_SETUP
+#line 218 "./pl.l"
+return(OFMLEVEL);
+ YY_BREAK
+case 113:
+YY_RULE_SETUP
+#line 219 "./pl.l"
+{yylval.yint = ACC_TOP; return(ACCENT); }
+ YY_BREAK
+case 114:
+YY_RULE_SETUP
+#line 220 "./pl.l"
+{yylval.yint = ACC_MID; return(ACCENT); }
+ YY_BREAK
+case 115:
+YY_RULE_SETUP
+#line 221 "./pl.l"
+{yylval.yint = ACC_BOT; return(ACCENT); }
+ YY_BREAK
+case 116:
+YY_RULE_SETUP
+#line 223 "./pl.l"
+{yylval.yint = DIR_ORD+DIR_TL; return(FONTDIR);}
+ YY_BREAK
+case 117:
+YY_RULE_SETUP
+#line 224 "./pl.l"
+{yylval.yint = DIR_ORD+DIR_LT; return(FONTDIR);}
+ YY_BREAK
+case 118:
+YY_RULE_SETUP
+#line 225 "./pl.l"
+{yylval.yint = DIR_ORD+DIR_TR; return(FONTDIR);}
+ YY_BREAK
+case 119:
+YY_RULE_SETUP
+#line 226 "./pl.l"
+{yylval.yint = DIR_ORD+DIR_LB; return(FONTDIR);}
+ YY_BREAK
+case 120:
+YY_RULE_SETUP
+#line 227 "./pl.l"
+{yylval.yint = DIR_ORD+DIR_BL; return(FONTDIR);}
+ YY_BREAK
+case 121:
+YY_RULE_SETUP
+#line 228 "./pl.l"
+{yylval.yint = DIR_ORD+DIR_RT; return(FONTDIR);}
+ YY_BREAK
+case 122:
+YY_RULE_SETUP
+#line 229 "./pl.l"
+{yylval.yint = DIR_ORD+DIR_BR; return(FONTDIR);}
+ YY_BREAK
+case 123:
+YY_RULE_SETUP
+#line 230 "./pl.l"
+{yylval.yint = DIR_ORD+DIR_RB; return(FONTDIR);}
+ YY_BREAK
+case 124:
+YY_RULE_SETUP
+#line 231 "./pl.l"
+{yylval.yint = DIR_NAT+DIR_TL; return(FONTDIR);}
+ YY_BREAK
+case 125:
+YY_RULE_SETUP
+#line 232 "./pl.l"
+{yylval.yint = DIR_NAT+DIR_LT; return(FONTDIR);}
+ YY_BREAK
+case 126:
+YY_RULE_SETUP
+#line 233 "./pl.l"
+{yylval.yint = DIR_NAT+DIR_TR; return(FONTDIR);}
+ YY_BREAK
+case 127:
+YY_RULE_SETUP
+#line 234 "./pl.l"
+{yylval.yint = DIR_NAT+DIR_LB; return(FONTDIR);}
+ YY_BREAK
+case 128:
+YY_RULE_SETUP
+#line 235 "./pl.l"
+{yylval.yint = DIR_NAT+DIR_BL; return(FONTDIR);}
+ YY_BREAK
+case 129:
+YY_RULE_SETUP
+#line 236 "./pl.l"
+{yylval.yint = DIR_NAT+DIR_RT; return(FONTDIR);}
+ YY_BREAK
+case 130:
+YY_RULE_SETUP
+#line 237 "./pl.l"
+{yylval.yint = DIR_NAT+DIR_BR; return(FONTDIR);}
+ YY_BREAK
+case 131:
+YY_RULE_SETUP
+#line 238 "./pl.l"
+{yylval.yint = DIR_NAT+DIR_RB; return(FONTDIR);}
+ YY_BREAK
+case 132:
+YY_RULE_SETUP
+#line 240 "./pl.l"
+return(FONTIVALUE);
+ YY_BREAK
+case 133:
+YY_RULE_SETUP
+#line 241 "./pl.l"
+return(FONTFVALUE);
+ YY_BREAK
+case 134:
+YY_RULE_SETUP
+#line 242 "./pl.l"
+return(FONTMVALUE);
+ YY_BREAK
+case 135:
+YY_RULE_SETUP
+#line 243 "./pl.l"
+return(FONTPENALTY);
+ YY_BREAK
+case 136:
+YY_RULE_SETUP
+#line 244 "./pl.l"
+return(FONTRULE);
+ YY_BREAK
+case 137:
+YY_RULE_SETUP
+#line 245 "./pl.l"
+return(FONTGLUE);
+ YY_BREAK
+case 138:
+YY_RULE_SETUP
+#line 247 "./pl.l"
+return(IVALUE);
+ YY_BREAK
+case 139:
+YY_RULE_SETUP
+#line 248 "./pl.l"
+return(FVALUE);
+ YY_BREAK
+case 140:
+YY_RULE_SETUP
+#line 249 "./pl.l"
+return(MVALUE);
+ YY_BREAK
+case 141:
+YY_RULE_SETUP
+#line 250 "./pl.l"
+return(PENALTY);
+ YY_BREAK
+case 142:
+YY_RULE_SETUP
+#line 251 "./pl.l"
+return(RULE);
+ YY_BREAK
+case 143:
+YY_RULE_SETUP
+#line 252 "./pl.l"
+return(GLUE);
+ YY_BREAK
+case 144:
+YY_RULE_SETUP
+#line 254 "./pl.l"
+return(IVALUEVAL);
+ YY_BREAK
+case 145:
+YY_RULE_SETUP
+#line 255 "./pl.l"
+return(FVALUEVAL);
+ YY_BREAK
+case 146:
+YY_RULE_SETUP
+#line 256 "./pl.l"
+return(MVALUEVAL);
+ YY_BREAK
+case 147:
+YY_RULE_SETUP
+#line 257 "./pl.l"
+return(PENALTYVAL);
+ YY_BREAK
+case 148:
+YY_RULE_SETUP
+#line 259 "./pl.l"
+{ yylval.yint = RULE_WD; return(RULEMEASURE); }
+ YY_BREAK
+case 149:
+YY_RULE_SETUP
+#line 260 "./pl.l"
+{ yylval.yint = RULE_HT; return(RULEMEASURE); }
+ YY_BREAK
+case 150:
+YY_RULE_SETUP
+#line 261 "./pl.l"
+{ yylval.yint = RULE_DP; return(RULEMEASURE); }
+ YY_BREAK
+case 151:
+YY_RULE_SETUP
+#line 263 "./pl.l"
+return(GLUEWD);
+ YY_BREAK
+case 152:
+YY_RULE_SETUP
+#line 264 "./pl.l"
+{ yylval.yint = GLUE_STRETCH; return(GLUESHRINKSTRETCH); }
+ YY_BREAK
+case 153:
+YY_RULE_SETUP
+#line 265 "./pl.l"
+{ yylval.yint = GLUE_SHRINK; return(GLUESHRINKSTRETCH); }
+ YY_BREAK
+case 154:
+YY_RULE_SETUP
+#line 267 "./pl.l"
+return(GLUETYPE);
+ YY_BREAK
+case 155:
+YY_RULE_SETUP
+#line 268 "./pl.l"
+return(GLUERULE);
+ YY_BREAK
+case 156:
+YY_RULE_SETUP
+#line 269 "./pl.l"
+return(GLUECHAR);
+ YY_BREAK
+case 157:
+YY_RULE_SETUP
+#line 271 "./pl.l"
+return(CHARIVALUE);
+ YY_BREAK
+case 158:
+YY_RULE_SETUP
+#line 272 "./pl.l"
+return(CHARFVALUE);
+ YY_BREAK
+case 159:
+YY_RULE_SETUP
+#line 273 "./pl.l"
+return(CHARMVALUE);
+ YY_BREAK
+case 160:
+YY_RULE_SETUP
+#line 274 "./pl.l"
+return(CHARPENALTY);
+ YY_BREAK
+case 161:
+YY_RULE_SETUP
+#line 275 "./pl.l"
+return(CHARRULE);
+ YY_BREAK
+case 162:
+YY_RULE_SETUP
+#line 276 "./pl.l"
+return(CHARGLUE);
+ YY_BREAK
+case 163:
+YY_RULE_SETUP
+#line 278 "./pl.l"
+return(CKRN);
+ YY_BREAK
+case 164:
+YY_RULE_SETUP
+#line 279 "./pl.l"
+return(CGLUE);
+ YY_BREAK
+case 165:
+YY_RULE_SETUP
+#line 280 "./pl.l"
+return(CPENALTY);
+ YY_BREAK
+case 166:
+YY_RULE_SETUP
+#line 281 "./pl.l"
+return(CPENGLUE);
+ YY_BREAK
+case 167:
+YY_RULE_SETUP
+#line 282 "./pl.l"
+return(CLABEL);
+ YY_BREAK
+case 168:
+YY_RULE_SETUP
+#line 284 "./pl.l"
+return(CHARREPEAT);
+ YY_BREAK
+case 169:
+YY_RULE_SETUP
+#line 287 "./pl.l"
+{yylval.yint = O_FILLL; return(GLUEORDER); }
+ YY_BREAK
+case 170:
+YY_RULE_SETUP
+#line 288 "./pl.l"
+{yylval.yint = O_FILL; return(GLUEORDER); }
+ YY_BREAK
+case 171:
+YY_RULE_SETUP
+#line 289 "./pl.l"
+{yylval.yint = O_FIL; return(GLUEORDER); }
+ YY_BREAK
+case 172:
+YY_RULE_SETUP
+#line 290 "./pl.l"
+{yylval.yint = O_FI; return(GLUEORDER); }
+ YY_BREAK
+case 173:
+YY_RULE_SETUP
+#line 291 "./pl.l"
+{yylval.yint = O_UNIT; return(GLUEORDER); }
+ YY_BREAK
+case 174:
+YY_RULE_SETUP
+#line 293 "./pl.l"
+{yylval.yint = K_NORMAL; return(GLUEKIND); }
+ YY_BREAK
+case 175:
+YY_RULE_SETUP
+#line 294 "./pl.l"
+{yylval.yint = K_ALEADERS; return(GLUEKIND); }
+ YY_BREAK
+case 176:
+YY_RULE_SETUP
+#line 295 "./pl.l"
+{yylval.yint = K_CLEADERS; return(GLUEKIND); }
+ YY_BREAK
+case 177:
+YY_RULE_SETUP
+#line 296 "./pl.l"
+{yylval.yint = K_XLEADERS; return(GLUEKIND); }
+ YY_BREAK
+case 178:
+YY_RULE_SETUP
+#line 298 "./pl.l"
+{yylval.yint = C_SECWD; return(CHARMEASURE); }
+ YY_BREAK
+case 179:
+YY_RULE_SETUP
+#line 299 "./pl.l"
+{yylval.yint = C_SECHT; return(CHARMEASURE); }
+ YY_BREAK
+case 180:
+YY_RULE_SETUP
+#line 300 "./pl.l"
+{yylval.yint = C_SECDP; return(CHARMEASURE); }
+ YY_BREAK
+case 181:
+YY_RULE_SETUP
+#line 301 "./pl.l"
+{yylval.yint = C_SECIC; return(CHARMEASURE); }
+ YY_BREAK
+case 182:
+YY_RULE_SETUP
+#line 303 "./pl.l"
+{yylval.yint = C_P_TOPAXIS; return(CHARMEASURE); }
+ YY_BREAK
+case 183:
+YY_RULE_SETUP
+#line 304 "./pl.l"
+{yylval.yint = C_P_TOPAXISBIs; return(CHARMEASURE); }
+ YY_BREAK
+case 184:
+YY_RULE_SETUP
+#line 305 "./pl.l"
+{yylval.yint = C_P_BOTAXIS; return(CHARMEASURE); }
+ YY_BREAK
+case 185:
+YY_RULE_SETUP
+#line 306 "./pl.l"
+{yylval.yint = C_P_BOTAXISBIS; return(CHARMEASURE); }
+ YY_BREAK
+case 186:
+YY_RULE_SETUP
+#line 307 "./pl.l"
+{yylval.yint = C_P_MIDHOR; return(CHARMEASURE); }
+ YY_BREAK
+case 187:
+YY_RULE_SETUP
+#line 308 "./pl.l"
+{yylval.yint = C_P_MIDVERT; return(CHARMEASURE); }
+ YY_BREAK
+case 188:
+YY_RULE_SETUP
+#line 309 "./pl.l"
+{yylval.yint = C_P_BASESLANT; return(CHARMEASURE); }
+ YY_BREAK
+case 189:
+YY_RULE_SETUP
+#line 311 "./pl.l"
+{yylval.yint = C_S_TOPAXIS; return(CHARMEASURE); }
+ YY_BREAK
+case 190:
+YY_RULE_SETUP
+#line 312 "./pl.l"
+{yylval.yint = C_S_TOPAXISBIs; return(CHARMEASURE); }
+ YY_BREAK
+case 191:
+YY_RULE_SETUP
+#line 313 "./pl.l"
+{yylval.yint = C_S_BOTAXIS; return(CHARMEASURE); }
+ YY_BREAK
+case 192:
+YY_RULE_SETUP
+#line 314 "./pl.l"
+{yylval.yint = C_S_BOTAXISBIS; return(CHARMEASURE); }
+ YY_BREAK
+case 193:
+YY_RULE_SETUP
+#line 315 "./pl.l"
+{yylval.yint = C_S_MIDHOR; return(CHARMEASURE); }
+ YY_BREAK
+case 194:
+YY_RULE_SETUP
+#line 316 "./pl.l"
+{yylval.yint = C_S_MIDVERT; return(CHARMEASURE); }
+ YY_BREAK
+case 195:
+YY_RULE_SETUP
+#line 317 "./pl.l"
+{yylval.yint = C_S_BASESLANT; return(CHARMEASURE); }
+ YY_BREAK
+case 196:
+YY_RULE_SETUP
+#line 319 "./pl.l"
+{lex_error_1("unexpected character (%x); ignored",
+ yytext[0]);}
+ YY_BREAK
+case 197:
+YY_RULE_SETUP
+#line 321 "./pl.l"
+ECHO;
+ YY_BREAK
+#line 2284 "lex.yy.c"
+ case YY_STATE_EOF(INITIAL):
+ yyterminate();
+
+ case YY_END_OF_BUFFER:
+ {
+ /* Amount of text matched not including the EOB char. */
+ int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+ /* Undo the effects of YY_DO_BEFORE_ACTION. */
+ *yy_cp = (yy_hold_char);
+ YY_RESTORE_YY_MORE_OFFSET
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+ {
+ /* We're scanning a new file or input source. It's
+ * possible that this happened because the user
+ * just pointed yyin at a new source and called
+ * yylex(). If so, then we have to assure
+ * consistency between YY_CURRENT_BUFFER and our
+ * globals. Here is the right place to do so, because
+ * this is the first action (other than possibly a
+ * back-up) that will match for the new input source.
+ */
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+ }
+
+ /* Note that here we test for yy_c_buf_p "<=" to the position
+ * of the first EOB in the buffer, since yy_c_buf_p will
+ * already have been incremented past the NUL character
+ * (since all states make transitions on EOB to the
+ * end-of-buffer state). Contrast this with the test
+ * in input().
+ */
+ if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ { /* This was really a NUL. */
+ yy_state_type yy_next_state;
+
+ (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ /* Okay, we're now positioned to make the NUL
+ * transition. We couldn't have
+ * yy_get_previous_state() go ahead and do it
+ * for us because it doesn't know how to deal
+ * with the possibility of jamming (and we don't
+ * want to build jamming into it because then it
+ * will run more slowly).
+ */
+
+ yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+ if ( yy_next_state )
+ {
+ /* Consume the NUL. */
+ yy_cp = ++(yy_c_buf_p);
+ yy_current_state = yy_next_state;
+ goto yy_match;
+ }
+
+ else
+ {
+ yy_cp = (yy_c_buf_p);
+ goto yy_find_action;
+ }
+ }
+
+ else switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ (yy_did_buffer_switch_on_eof) = 0;
+
+ if ( yywrap( ) )
+ {
+ /* Note: because we've taken care in
+ * yy_get_next_buffer() to have set up
+ * yytext, we can now set up
+ * yy_c_buf_p so that if some total
+ * hoser (like flex itself) wants to
+ * call the scanner after we return the
+ * YY_NULL, it'll still work - another
+ * YY_NULL will get returned.
+ */
+ (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+ yy_act = YY_STATE_EOF(YY_START);
+ goto do_action;
+ }
+
+ else
+ {
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+ }
+ break;
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) =
+ (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_match;
+
+ case EOB_ACT_LAST_MATCH:
+ (yy_c_buf_p) =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_find_action;
+ }
+ break;
+ }
+
+ default:
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--no action found" );
+ } /* end of action switch */
+ } /* end of scanning one token */
+} /* end of yylex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ * EOB_ACT_LAST_MATCH -
+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ * EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+ register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+ register char *source = (yytext_ptr);
+ register int number_to_move, i;
+ int ret_val;
+
+ if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--end of buffer missed" );
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+ { /* Don't try to fill the buffer, so this is an EOF. */
+ if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+ {
+ /* We matched a single character, the EOB, so
+ * treat this as a final EOF.
+ */
+ return EOB_ACT_END_OF_FILE;
+ }
+
+ else
+ {
+ /* We matched some text prior to the EOB, first
+ * process it.
+ */
+ return EOB_ACT_LAST_MATCH;
+ }
+ }
+
+ /* Try to read more data. */
+
+ /* First move last chars to start of buffer. */
+ number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+ for ( i = 0; i < number_to_move; ++i )
+ *(dest++) = *(source++);
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+ /* don't do the read, it's not guaranteed to return an EOF,
+ * just force an EOF
+ */
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+ else
+ {
+ size_t num_to_read =
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+ while ( num_to_read <= 0 )
+ { /* Not enough room in the buffer - grow it. */
+
+ YY_FATAL_ERROR(
+"input buffer overflow, can't enlarge buffer because scanner uses REJECT" );
+
+ }
+
+ if ( num_to_read > YY_READ_BUF_SIZE )
+ num_to_read = YY_READ_BUF_SIZE;
+
+ /* Read in more data. */
+ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+ (yy_n_chars), num_to_read );
+
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ if ( (yy_n_chars) == 0 )
+ {
+ if ( number_to_move == YY_MORE_ADJ )
+ {
+ ret_val = EOB_ACT_END_OF_FILE;
+ yyrestart(yyin );
+ }
+
+ else
+ {
+ ret_val = EOB_ACT_LAST_MATCH;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+ YY_BUFFER_EOF_PENDING;
+ }
+ }
+
+ else
+ ret_val = EOB_ACT_CONTINUE_SCAN;
+
+ (yy_n_chars) += number_to_move;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+ (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+ return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+ static yy_state_type yy_get_previous_state (void)
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp;
+
+ yy_current_state = (yy_start);
+
+ (yy_state_ptr) = (yy_state_buf);
+ *(yy_state_ptr)++ = yy_current_state;
+
+ for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+ {
+ register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 783 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *(yy_state_ptr)++ = yy_current_state;
+ }
+
+ return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ * next_state = yy_try_NUL_trans( current_state );
+ */
+ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state )
+{
+ register int yy_is_jam;
+
+ register YY_CHAR yy_c = 1;
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 783 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ yy_is_jam = (yy_current_state == 782);
+ if ( ! yy_is_jam )
+ *(yy_state_ptr)++ = yy_current_state;
+
+ return yy_is_jam ? 0 : yy_current_state;
+}
+
+ static void yyunput (int c, register char * yy_bp )
+{
+ register char *yy_cp;
+
+ yy_cp = (yy_c_buf_p);
+
+ /* undo effects of setting up yytext */
+ *yy_cp = (yy_hold_char);
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ { /* need to shift things up to make room */
+ /* +2 for EOB chars. */
+ register int number_to_move = (yy_n_chars) + 2;
+ register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+ register char *source =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+ while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ *--dest = *--source;
+
+ yy_cp += (int) (dest - source);
+ yy_bp += (int) (dest - source);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ YY_FATAL_ERROR( "flex scanner push-back overflow" );
+ }
+
+ *--yy_cp = (char) c;
+
+ if ( c == '\n' ){
+ --yylineno;
+ }
+
+ (yytext_ptr) = yy_bp;
+ (yy_hold_char) = *yy_cp;
+ (yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+ static int yyinput (void)
+#else
+ static int input (void)
+#endif
+
+{
+ int c;
+
+ *(yy_c_buf_p) = (yy_hold_char);
+
+ if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+ {
+ /* yy_c_buf_p now points to the character we want to return.
+ * If this occurs *before* the EOB characters, then it's a
+ * valid NUL; if not, then we've hit the end of the buffer.
+ */
+ if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ /* This was really a NUL. */
+ *(yy_c_buf_p) = '\0';
+
+ else
+ { /* need more input */
+ int offset = (yy_c_buf_p) - (yytext_ptr);
+ ++(yy_c_buf_p);
+
+ switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_LAST_MATCH:
+ /* This happens because yy_g_n_b()
+ * sees that we've accumulated a
+ * token and flags that we need to
+ * try matching the token before
+ * proceeding. But for input(),
+ * there's no matching to consider.
+ * So convert the EOB_ACT_LAST_MATCH
+ * to EOB_ACT_END_OF_FILE.
+ */
+
+ /* Reset buffer status. */
+ yyrestart(yyin );
+
+ /*FALLTHROUGH*/
+
+ case EOB_ACT_END_OF_FILE:
+ {
+ if ( yywrap( ) )
+ return EOF;
+
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+#ifdef __cplusplus
+ return yyinput();
+#else
+ return input();
+#endif
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) = (yytext_ptr) + offset;
+ break;
+ }
+ }
+ }
+
+ c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */
+ *(yy_c_buf_p) = '\0'; /* preserve yytext */
+ (yy_hold_char) = *++(yy_c_buf_p);
+
+ if ( c == '\n' )
+
+ yylineno++;
+;
+
+ return c;
+}
+#endif /* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ *
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+ void yyrestart (FILE * input_file )
+{
+
+ if ( ! YY_CURRENT_BUFFER ){
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_init_buffer(YY_CURRENT_BUFFER,input_file );
+ yy_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ *
+ */
+ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer )
+{
+
+ /* TODO. We should be able to replace this entire function body
+ * with
+ * yypop_buffer_state();
+ * yypush_buffer_state(new_buffer);
+ */
+ yyensure_buffer_stack ();
+ if ( YY_CURRENT_BUFFER == new_buffer )
+ return;
+
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+ yy_load_buffer_state( );
+
+ /* We don't actually know whether we did this switch during
+ * EOF (yywrap()) processing, but the only time this flag
+ * is looked at is after yywrap() is called, so it's safe
+ * to go ahead and always set it.
+ */
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void yy_load_buffer_state (void)
+{
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+ yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+ (yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ *
+ * @return the allocated buffer state.
+ */
+ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size )
+{
+ YY_BUFFER_STATE b;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_buf_size = size;
+
+ /* yy_ch_buf has to be 2 characters longer than the size given because
+ * we need to put in 2 end-of-buffer characters.
+ */
+ b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2 );
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_is_our_buffer = 1;
+
+ yy_init_buffer(b,file );
+
+ return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with yy_create_buffer()
+ *
+ */
+ void yy_delete_buffer (YY_BUFFER_STATE b )
+{
+
+ if ( ! b )
+ return;
+
+ if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+ if ( b->yy_is_our_buffer )
+ yyfree((void *) b->yy_ch_buf );
+
+ yyfree((void *) b );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a yyrestart() or at EOF.
+ */
+ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file )
+
+{
+ int oerrno = errno;
+
+ yy_flush_buffer(b );
+
+ b->yy_input_file = file;
+ b->yy_fill_buffer = 1;
+
+ /* If b is the current buffer, then yy_init_buffer was _probably_
+ * called from yyrestart() or through yy_get_next_buffer.
+ * In that case, we don't want to reset the lineno or column.
+ */
+ if (b != YY_CURRENT_BUFFER){
+ b->yy_bs_lineno = 1;
+ b->yy_bs_column = 0;
+ }
+
+ b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+
+ errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ *
+ */
+ void yy_flush_buffer (YY_BUFFER_STATE b )
+{
+ if ( ! b )
+ return;
+
+ b->yy_n_chars = 0;
+
+ /* We always need two end-of-buffer characters. The first causes
+ * a transition to the end-of-buffer state. The second causes
+ * a jam in that state.
+ */
+ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+ b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+ b->yy_buf_pos = &b->yy_ch_buf[0];
+
+ b->yy_at_bol = 1;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ if ( b == YY_CURRENT_BUFFER )
+ yy_load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ * the current state. This function will allocate the stack
+ * if necessary.
+ * @param new_buffer The new state.
+ *
+ */
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+ if (new_buffer == NULL)
+ return;
+
+ yyensure_buffer_stack();
+
+ /* This block is copied from yy_switch_to_buffer. */
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ /* Only push if top exists. Otherwise, replace top. */
+ if (YY_CURRENT_BUFFER)
+ (yy_buffer_stack_top)++;
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+ /* copied from yy_switch_to_buffer. */
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ * The next element becomes the new top.
+ *
+ */
+void yypop_buffer_state (void)
+{
+ if (!YY_CURRENT_BUFFER)
+ return;
+
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ if ((yy_buffer_stack_top) > 0)
+ --(yy_buffer_stack_top);
+
+ if (YY_CURRENT_BUFFER) {
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+ }
+}
+
+/* Allocates the stack if it does not exist.
+ * Guarantees space for at least one push.
+ */
+static void yyensure_buffer_stack (void)
+{
+ int num_to_alloc;
+
+ if (!(yy_buffer_stack)) {
+
+ /* First allocation is just for 2 elements, since we don't know if this
+ * scanner will even need a stack. We use 2 instead of 1 to avoid an
+ * immediate realloc on the next call.
+ */
+ num_to_alloc = 1;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
+ (num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+
+ memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+
+ (yy_buffer_stack_max) = num_to_alloc;
+ (yy_buffer_stack_top) = 0;
+ return;
+ }
+
+ if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+ /* Increase the buffer to prepare for a possible push. */
+ int grow_size = 8 /* arbitrary grow size */;
+
+ num_to_alloc = (yy_buffer_stack_max) + grow_size;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
+ ((yy_buffer_stack),
+ num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+
+ /* zero only the new slots.*/
+ memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+ (yy_buffer_stack_max) = num_to_alloc;
+ }
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )
+{
+ YY_BUFFER_STATE b;
+
+ if ( size < 2 ||
+ base[size-2] != YY_END_OF_BUFFER_CHAR ||
+ base[size-1] != YY_END_OF_BUFFER_CHAR )
+ /* They forgot to leave room for the EOB's. */
+ return 0;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+
+ b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */
+ b->yy_buf_pos = b->yy_ch_buf = base;
+ b->yy_is_our_buffer = 0;
+ b->yy_input_file = 0;
+ b->yy_n_chars = b->yy_buf_size;
+ b->yy_is_interactive = 0;
+ b->yy_at_bol = 1;
+ b->yy_fill_buffer = 0;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ yy_switch_to_buffer(b );
+
+ return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to yylex() will
+ * scan from a @e copy of @a str.
+ * @param str a NUL-terminated string to scan
+ *
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ * yy_scan_bytes() instead.
+ */
+YY_BUFFER_STATE yy_scan_string (yyconst char * yy_str )
+{
+
+ return yy_scan_bytes(yy_str,strlen(yy_str) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_bytes (yyconst char * bytes, int len )
+{
+ YY_BUFFER_STATE b;
+ char *buf;
+ yy_size_t n;
+ int i;
+
+ /* Get memory for full buffer, including space for trailing EOB's. */
+ n = len + 2;
+ buf = (char *) yyalloc(n );
+ if ( ! buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+
+ for ( i = 0; i < len; ++i )
+ buf[i] = bytes[i];
+
+ buf[len] = buf[len+1] = YY_END_OF_BUFFER_CHAR;
+
+ b = yy_scan_buffer(buf,n );
+ if ( ! b )
+ YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+
+ /* It's okay to grow etc. this buffer, and we should throw it
+ * away when we're done.
+ */
+ b->yy_is_our_buffer = 1;
+
+ return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+ (void) fprintf( stderr, "%s\n", msg );
+ exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ yytext[yyleng] = (yy_hold_char); \
+ (yy_c_buf_p) = yytext + yyless_macro_arg; \
+ (yy_hold_char) = *(yy_c_buf_p); \
+ *(yy_c_buf_p) = '\0'; \
+ yyleng = yyless_macro_arg; \
+ } \
+ while ( 0 )
+
+/* Accessor methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ *
+ */
+int yyget_lineno (void)
+{
+
+ return yylineno;
+}
+
+/** Get the input stream.
+ *
+ */
+FILE *yyget_in (void)
+{
+ return yyin;
+}
+
+/** Get the output stream.
+ *
+ */
+FILE *yyget_out (void)
+{
+ return yyout;
+}
+
+/** Get the length of the current token.
+ *
+ */
+int yyget_leng (void)
+{
+ return yyleng;
+}
+
+/** Get the current token.
+ *
+ */
+
+char *yyget_text (void)
+{
+ return yytext;
+}
+
+/** Set the current line number.
+ * @param line_number
+ *
+ */
+void yyset_lineno (int line_number )
+{
+
+ yylineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ *
+ * @see yy_switch_to_buffer
+ */
+void yyset_in (FILE * in_str )
+{
+ yyin = in_str ;
+}
+
+void yyset_out (FILE * out_str )
+{
+ yyout = out_str ;
+}
+
+int yyget_debug (void)
+{
+ return yy_flex_debug;
+}
+
+void yyset_debug (int bdebug )
+{
+ yy_flex_debug = bdebug ;
+}
+
+/* yylex_destroy is for both reentrant and non-reentrant scanners. */
+int yylex_destroy (void)
+{
+
+ /* Pop the buffer stack, destroying each element. */
+ while(YY_CURRENT_BUFFER){
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ yypop_buffer_state();
+ }
+
+ /* Destroy the stack itself. */
+ yyfree((yy_buffer_stack) );
+ (yy_buffer_stack) = NULL;
+
+ yyfree ( (yy_state_buf) );
+
+ return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+ register int i;
+ for ( i = 0; i < n; ++i )
+ s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+ register int n;
+ for ( n = 0; s[n]; ++n )
+ ;
+
+ return n;
+}
+#endif
+
+void *yyalloc (yy_size_t size )
+{
+ return (void *) malloc( size );
+}
+
+void *yyrealloc (void * ptr, yy_size_t size )
+{
+ /* The cast to (char *) in the following accommodates both
+ * implementations that use char* generic pointers, and those
+ * that use void* generic pointers. It works with the latter
+ * because both ANSI C and C++ allow castless assignment from
+ * any pointer type to void*, and deal with argument conversions
+ * as though doing an assignment.
+ */
+ return (void *) realloc( (char *) ptr, size );
+}
+
+void yyfree (void * ptr )
+{
+ free( (char *) ptr ); /* see yyrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#undef YY_NEW_FILE
+#undef YY_FLUSH_BUFFER
+#undef yy_set_bol
+#undef yy_new_buffer
+#undef yy_set_interactive
+#undef yytext_ptr
+#undef YY_DO_BEFORE_ACTION
+
+#ifdef YY_DECL_IS_OURS
+#undef YY_DECL_IS_OURS
+#undef YY_DECL
+#endif
+#line 321 "./pl.l"
+
+
+
+/* added by Thomas Esser, suggested by Olaf Weber */
+#ifdef yywrap
+#undef yywrap
+#endif
+
+int
+yywrap (void)
+{ return 1; }
+
+void
+scan_int(unsigned base)
+{
+ register unsigned j, q = 0x10000 / base, c0=0, c1=0, i=1;
+
+ if ((base<BASE_MIN) || (base>BASE_MAX))
+ internal_error_1("scan_int (base=%d)", base);
+ while ((yytext[i]==' ') || (yytext[i]=='\t')) {
+ yytext[i] = ' ';
+ i++;
+ }
+ for (; i<yyleng; i++) {
+ j = yytext[i];
+ if (j>='A') j = j + '0' + 10 - 'A' ;
+ c0 = base*c0 + (c1 / q);
+ c1 = base*(c1 % q) + j - '0';
+ if (c0 > 0xffff) {
+ lex_error_s("numeric value (%s) too large; set to 0", yytext);
+ c0=0; c1=0; break;
+ }
+ }
+ yylval.yint = c0 * 0x10000 + c1;
+}
+
+void
+scan_fix(void)
+{
+ unsigned i=1;
+ unsigned sign = 1;
+ unsigned j=0;
+ unsigned acc=0;
+ unsigned int_part;
+ unsigned fraction_digits[7];
+
+ while ((yytext[i]==' ') || (yytext[i]=='\t') ||
+ (yytext[i]=='+') || (yytext[i]=='-')) {
+ if (yytext[i]=='\t') yytext[i] = ' ';
+ if (yytext[i]=='-') sign *= -1;
+ i++;
+ }
+ acc=0;
+ while ((i<yyleng) && (yytext[i]!='.')) {
+ acc = acc*10 + yytext[i]-'0';
+ i++;
+ if (acc >=0x800 ) {
+ lex_error_s("fix value (%s) too large; set to 0", yytext);
+ yylval.yfix = 0;
+ return;
+ }
+ }
+ int_part = acc; acc = 0;
+ if (i < yyleng) {
+ i++;
+ while ((i<yyleng) && j<7) {
+ fraction_digits[j] = 0x200000*(yytext[i]-'0');
+ i++; j++;
+ }
+ while (j>0) {acc = fraction_digits[--j] + acc / 10;}
+ acc = (acc + 10) / 20;
+ }
+ if ((acc > UNITY) && (int_part=2047)) {
+ lex_error_s("fix value (%s) too large; set to 0", yytext);
+ yylval.yfix = 0;
+ return;
+ }
+ yylval.yfix = sign * (int_part*UNITY + acc);
+}
+
+void
+scan_char(void)
+{
+ register unsigned i=1;
+
+ while ((yytext[i]==' ') || (yytext[i]=='\t')) i++;
+ if ((yytext[i]<041) || (yytext[i]>0176) ||
+ (yytext[i]=='(') || (yytext[i]==')')) {
+ lex_error_1("C value (H %X) must be ASCII (not paren); "
+ "set to 'A'", yytext[i]);
+ yylval.yint = 'A';
+ } else yylval.yint = yytext[i];
+}
+
+void
+scan_string(char *attribute, unsigned keep, unsigned length)
+{
+ register unsigned c, saved_ptr = 0, paren_level = 0;
+ unsigned error_msg = FALSE;
+
+ if ((keep<KEEP_MIN) || (keep>KEEP_MAX))
+ internal_error_1("scan_string (keep=%d)", keep);
+ while (((c = input()) != EOF) &&
+ ((c == ' ') || (c == '\t') || (c == '\n'))) {
+ if (c == '\n') {line_number++;}
+ }
+ if (c==EOF) fatal_error_s("EOF while scanning %s", attribute);
+ while ((c != EOF) &&
+ ((c != ')') || (paren_level>0))) {
+ if (c==')') {
+ paren_level--;
+ if (keep==KEEP_CONVERT) {
+ lex_error_s_1("%s character (H %X) converted to slash",
+ attribute, c);
+ c = '/';
+ }
+ } else if (c=='(') {
+ paren_level++;
+ if (keep==KEEP_CONVERT) {
+ lex_error_s_1("%s character (H %X) converted to slash",
+ attribute, c);
+ c = '/';
+ }
+ } else if ((c<' ') || (c>='~')) {
+ if (c=='\n') line_number++;
+ if (keep==KEEP_CONVERT) {
+ lex_error_s_1("%s character (H %X) converted to blank",
+ attribute, c);
+ c = ' ';
+ }
+ }
+ if (saved_ptr<(MAX_PTR-3))
+ saved_text[saved_ptr++] = c;
+ else if (error_msg == FALSE) {
+ lex_error_s_1("%s string longer than %d characters; truncating",
+ attribute, MAX_PTR);
+ error_msg = TRUE;
+ }
+ c = input();
+ }
+ if (c==EOF) fatal_error_s("EOF while scanning %s", attribute);
+ unput(')');
+ saved_text[saved_ptr++] = '\0';
+ if (keep!=KEEP_NONE) {
+ if ((length != 0) && (strlen(saved_text)>length)) {
+ lex_error_s_1("%s string limited to %d characters; truncated",
+ attribute, length);
+ saved_text[length] = '\0';
+ }
+ yylval.ystring = xstrdup(saved_text);
+ } else {
+ yylval.ystring = NULL;
+ }
+}
+
+void
+scan_hex_string(void)
+{
+ register unsigned i=10;
+
+ while ((yytext[i]==' ') || (yytext[i]=='\t')) i++;
+ yylval.ystring = xstrdup(yytext+i);
+}
+
diff --git a/Build/source/texk/web2c/omegafonts/ligkern_routines.c b/Build/source/texk/web2c/omegafonts/ligkern_routines.c
new file mode 100644
index 00000000000..6f8fbf3d76b
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/ligkern_routines.c
@@ -0,0 +1,576 @@
+/* ligkern_routines.c: The ligature/kerning table.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "manifests.h"
+#include "list_routines.h"
+#include "ligkern_routines.h"
+#include "char_routines.h"
+#include "out_routines.h"
+#include "print_routines.h"
+#include "error_routines.h"
+#include "header_routines.h"
+#include "out_ofm.h"
+
+unsigned nk=0;
+unsigned nl=0;
+
+fix *kern_table;
+av_list kern_list = NULL;
+unsigned no_kerns = 0;
+
+unsigned min_nl=0;
+unsigned bchar = CHAR_BOUNDARY;
+unsigned bchar_label = 0;
+unsigned bchar_remainder;
+unsigned lk_step_ended=FALSE;
+
+four_entries lig_kern_table[100000];
+
+void
+set_boundary_character(unsigned c)
+{
+ /* What checks are required ? */
+ bchar = c;
+}
+
+void
+init_ligkern(void)
+{
+ lk_step_ended = FALSE;
+ nl = 0;
+ min_nl = 0;
+}
+
+void
+set_label_command(unsigned c)
+{
+ if (c==CHAR_BOUNDARY) { /* BOUNDARYCHAR */
+ bchar_label = nl;
+ } else {
+ check_char_tag(c);
+ set_char_tag(c, TAG_LIG);
+ if (nl==0) set_char_remainder(c, 0);
+ else set_char_remainder(c, nl);
+ }
+ if (min_nl <= nl) { min_nl = nl+1; }
+ lk_step_ended = FALSE;
+ no_labels++;
+}
+
+void
+set_stop_command(void)
+{
+ if (lk_step_ended == TRUE) {
+ lig_kern_table[nl-1].entries[0] =
+ lig_kern_table[nl-1].entries[0] / 256 * 256 + STOP_FLAG;
+ } else {
+ warning_0("STOP must follow LIG or KRN; ignored");
+ }
+ lk_step_ended = FALSE;
+}
+
+void
+set_skip_command(unsigned val)
+{
+ if (lk_step_ended == TRUE) {
+ if (val>128) {
+ warning_0("Maximum SKIP amount is 127; ignored");
+ } else {
+ lig_kern_table[nl-1].entries[0] = val;
+ if (min_nl <= (nl+val)) { min_nl = nl+val+1; }
+ }
+ } else {
+ warning_0("SKIP must follow LIG or KRN; ignored");
+ }
+ lk_step_ended = FALSE;
+}
+
+void
+set_ligature_command(unsigned lig, unsigned c, unsigned val)
+{
+ lig_kern_table[nl].entries[0] = 0;
+ lig_kern_table[nl].entries[1] = c;
+ lig_kern_table[nl].entries[2] = lig;
+ lig_kern_table[nl].entries[3] = val;
+ nl++;
+ lk_step_ended = TRUE;
+
+}
+
+void
+set_kerning_command(unsigned c, fix fval)
+{
+ unsigned k = set_new_kern(fval);
+
+ lig_kern_table[nl].entries[0] = 0;
+ lig_kern_table[nl].entries[1] = c;
+ if (ofm_level==OFM_TFM) {
+ lig_kern_table[nl].entries[2] = KERN_FLAG + (k/256);
+ lig_kern_table[nl].entries[3] = k % 256;
+ } else {
+ lig_kern_table[nl].entries[2] = KERN_FLAG + (k/65536);
+ lig_kern_table[nl].entries[3] = k % 65536;
+ }
+ nl++;
+ lk_step_ended = TRUE;
+}
+
+void
+set_c_label_command(unsigned new_class)
+{
+ fatal_error_0("CLABEL not currently supported");
+}
+
+void
+set_c_kerning_command(unsigned new_class, fix fval)
+{
+ fatal_error_0("CKRN not currently supported");
+}
+
+void
+set_c_glue_command(unsigned new_class, unsigned glue_index)
+{
+ fatal_error_0("CGLUE not currently supported");
+}
+
+void
+set_c_penalty_command(unsigned new_class, unsigned pen_index)
+{
+ fatal_error_0("CPEN not currently supported");
+}
+
+void
+set_c_penglue_command(unsigned new_class, unsigned pen_index, unsigned glue_index)
+{
+ fatal_error_0("CPENGLUE not currently supported");
+}
+
+int
+set_new_kern(fix fval)
+{
+ unsigned index;
+ av_list L1, L2;
+
+ L1 = kern_list;
+ if (L1 == NULL) {
+ index = nk++;
+ kern_list = av_list1(index, fval);
+ } else {
+ L2 = L1->ptr;
+ while ((lval(L1) != fval) && (L2 != NULL)) {
+ L1 = L2;
+ L2 = L2->ptr;
+ }
+ if (fval == lval(L1)) {
+ index = lattr(L1);
+ } else {
+ index = nk++;
+ L2 = av_list1(index, fval);
+ L1->ptr = L2;
+ }
+ }
+ return index;
+}
+
+
+void
+build_kern_table(void)
+{
+ av_list L1 = kern_list, L2;
+ unsigned i = 0;
+
+ kern_table = (fix *) xmalloc((nk+1)*sizeof(int));
+ while (L1 != NULL) {
+ kern_table[i] = lval(L1);
+ L2 = L1->ptr;
+ free(L1); L1 = L2;
+ i++;
+ }
+}
+
+void
+print_kerns(void)
+{
+ unsigned i;
+
+ if (nk>0) {
+ left(); out("COMMENT"); out_ln();
+ for (i=0; i<nk; i++) {
+ left(); out("KERN_ENTRY");
+ out(" "); out_int(i,10);
+ out(" "); out_fix(kern_table[i]);
+ right();
+ }
+ right();
+ }
+}
+
+void
+print_ligkern_table(void)
+{
+ unsigned i;
+ four_entries *entry;
+
+ sort_ptr = 1;
+ if (nl>0) {
+ left(); out("LIGTABLE"); out_ln();
+ for (i=0; i<nl; i++) {
+ while ((sort_ptr<=label_ptr) && (i==label_table[sort_ptr].rr)) {
+ print_label_command(label_table[sort_ptr].cc);
+ sort_ptr++;
+ }
+ entry = lig_kern_table+i;
+ print_one_lig_kern_entry(lig_kern_table+i, TRUE);
+ }
+ right();
+ }
+}
+
+void
+print_one_lig_kern_entry(four_entries *lentry, boolean show_stop)
+{
+ if (lentry->entries[2] >= KERN_FLAG) {
+ if (ofm_level==OFM_TFM) {
+ print_kerning_command(lentry->entries[1],
+ kern_table[256*(lentry->entries[2]-KERN_FLAG)+lentry->entries[3]]);
+ } else {
+ print_kerning_command(lentry->entries[1],
+ kern_table[65536*(lentry->entries[2]-KERN_FLAG)+lentry->entries[3]]);
+ }
+ } else {
+ print_ligature_command(lentry->entries[2],
+ lentry->entries[1],
+ lentry->entries[3]);
+ }
+ if ((show_stop == TRUE) && (lentry->entries[0] > 0)) {
+ if (lentry->entries[0] >= STOP_FLAG) {
+ print_stop_command();
+ } else {
+ print_skip_command(0);
+ }
+ }
+}
+
+hash_list hash_table[PRIME];
+
+unsigned x_lig_cycle;
+unsigned y_lig_cycle = CHAR_BOUNDARY;
+
+int
+l_f(hash_list h, unsigned x, unsigned y)
+{
+ switch(h->new_class) {
+ case LIG_SIMPLE: {break;}
+ case LIG_LEFT_Z: {
+ h->new_class = LIG_PENDING;
+ h->lig_z = l_eval(h->lig_z, y);
+ h->new_class = LIG_SIMPLE;
+ break;
+ }
+ case LIG_RIGHT_Z: {
+ h->new_class = LIG_PENDING;
+ h->lig_z = l_eval(x, h->lig_z);
+ h->new_class = LIG_SIMPLE;
+ break;
+ }
+ case LIG_BOTH_Z: {
+ h->new_class = LIG_PENDING;
+ h->lig_z = l_eval(l_eval(x,h->lig_z), y);
+ h->new_class = LIG_SIMPLE;
+ break;
+ }
+ case LIG_PENDING: {
+ x_lig_cycle = x;
+ y_lig_cycle = y;
+ h->lig_z = CHAR_ERROR;
+ h->new_class = LIG_SIMPLE;
+ break;
+ }
+ default: {
+ internal_error_1("f (new_class=%d)", h->new_class);
+ }
+ }
+ return (h->lig_z);
+}
+
+int
+l_eval(unsigned x, unsigned y)
+{
+ hash_list h;
+
+ if ((x==CHAR_ERROR) || (y==CHAR_ERROR)) return CHAR_ERROR;
+ h = l_hash_lookup(x, y);
+ if (h == NULL) return y;
+ return l_f(h, x, y);
+}
+
+queue hash_entries;
+
+int
+l_hash_input(unsigned p, unsigned c)
+{
+
+ four_entries *entry = lig_kern_table+p;
+ unsigned y = entry->entries[1];
+ unsigned t = entry->entries[2];
+ unsigned cc = LIG_SIMPLE;
+ unsigned zz = entry->entries[3];
+ unsigned key;
+ hash_list L1, L2;
+
+ if (t >= KERN_FLAG) zz = y;
+ else {
+ switch(t) {
+ case L_0:
+ case L_Ax: { break; }
+ case L_Bx:
+ case L_ABxx: { zz = y; break; }
+ case L_B:
+ case L_ABx: { cc = LIG_LEFT_Z; break; }
+ case L_A: { cc = LIG_RIGHT_Z; break; }
+ case L_AB: { cc = LIG_BOTH_Z; break; }
+ default: {
+ internal_error_1("l_hash_input (case=%d)", t);
+ }
+ }
+ }
+ key = (c & 0x7fff)*(y & 0x7fff) % PRIME;
+ if (hash_table[key] == NULL) {
+ hash_table[key] = hash_list1(c,y,cc,zz);
+ append_to_queue(&hash_entries, hash_table[key]);
+ } else {
+ L1 = hash_table[key];
+ L2 = L1->ptr;
+ while ((L2 != NULL) &&
+ ((L2->x <= c) || ((L2->x == c) && (L2->y <= y)))) {
+ L1 = L2;
+ L2 = L2->ptr;
+ }
+ if (L2 == NULL) {
+ L2 = hash_list1(c,y,cc,zz);
+ append_to_queue(&hash_entries, L2);
+ L2->ptr = L1->ptr;
+ L1->ptr = L2;
+ } else if ((c < L2->x) || ((c == L2->x) && (y < L2->y))) {
+ hash_table[key] = hash_list1(c,y,cc,zz);
+ hash_table[key]->ptr = L1;
+ append_to_queue(&hash_entries, hash_table[key]);
+ } else if ((c == L2->x) && (y < L2->y)) {
+ return FALSE; /* unused ligature command */
+ } else {
+ L2 = hash_list1(c,y,cc,zz);
+ append_to_queue(&hash_entries, L2);
+ L2->ptr = L1->ptr;
+ L1->ptr = L2;
+ }
+ }
+ return TRUE;
+}
+
+hash_list
+l_hash_lookup(unsigned x, unsigned y)
+{
+ unsigned key = (x & 0x7fff)*(y & 0x7fff) % PRIME;
+ hash_list L = hash_table[key];
+
+ if (L==NULL) return NULL;
+ while (L->x < x) L = L->ptr;
+ if (L->x != x) return NULL;
+ while ((L->x == x) && (L->y < y)) L = L->ptr;
+ if (L->y != y) return NULL;
+ return L;
+}
+
+void
+check_ligature_ends_properly(void)
+{
+ if (nl>0) {
+ if (bchar_label != 0) {
+ /* make room for it; the actual label will be stored later */
+ nl++;
+ }
+ while (min_nl > nl) {
+ nl++;
+ }
+ if (lig_kern_table[nl].entries[0] == 0) {
+ lig_kern_table[nl].entries[0] = STOP_FLAG;
+ }
+ }
+}
+
+void
+check_ligature_program(unsigned c, unsigned lab)
+{
+ unsigned lig_ptr = lab;
+ four_entries *entry;
+
+ while (lig_ptr < nl) {
+ entry = lig_kern_table+lig_ptr;
+ if (l_hash_input(lig_ptr,c)) {
+ if (entry->entries[2] < KERN_FLAG) {
+ if (entry->entries[1] != bchar)
+ check_existence_and_safety(c, entry->entries[1],
+ ligature_commands[entry->entries[2]],
+ "%s character examined by (H %X)");
+ if (entry->entries[3] >= 128)
+/* Needs fixing */
+ if ((c < 128) || (c == -1))
+ if ((entry->entries[1] < 128) ||
+ (entry->entries[1] == bchar))
+ seven_bit_calculated = 0;
+ check_existence_and_safety(c, entry->entries[3],
+ ligature_commands[entry->entries[2]],
+ "%s character generated by (H %X)");
+ } else {
+ check_existence_and_safety(c, entry->entries[1],
+ "KRN", "%s character examined by (H %X)");
+ }
+ }
+ if (entry->entries[0] >= STOP_FLAG) lig_ptr = nl;
+ else lig_ptr = lig_ptr + 1 + entry->entries[0];
+ }
+}
+
+void
+check_ligature_infinite_loops(void)
+{
+ list entry = hash_entries.front;
+ hash_list tt;
+ unsigned new_class;
+
+ while (entry != NULL) {
+ tt = (hash_list) entry->contents;
+ if (tt->new_class > LIG_SIMPLE)
+ new_class = l_f(tt, tt->x, tt->y);
+ entry = entry->ptr;
+ }
+ if (y_lig_cycle != 0x80000000) {
+ if (x_lig_cycle == CHAR_BOUNDARY) {
+ warning_1("Infinite ligature loop starting with boundary and %d",
+ y_lig_cycle);
+ } else {
+ warning_2("Infinite ligature loop starting with %d and %d",
+ x_lig_cycle, y_lig_cycle);
+ }
+ clear_ligature_entries();
+ nl = 0; bchar = CHAR_BOUNDARY; bchar_label = 0;
+ }
+}
+
+void
+doublecheck_ligatures(void)
+{
+ unsigned i;
+
+ if (nl>0) {
+ for (i=0; i<nl; i++) {
+ if (lig_kern_table[i].entries[2] < KERN_FLAG) {
+ if (lig_kern_table[i].entries[0] != CHAR_BOUNDARY) {
+ doublecheck_existence(
+ lig_kern_table[i].entries[1],
+ ligature_commands[lig_kern_table[i].entries[2]],
+ "Unused %s step refers to nonexistent character (H %X)");
+ doublecheck_existence(
+ lig_kern_table[i].entries[3],
+ ligature_commands[lig_kern_table[i].entries[2]],
+ "Unused %s step refers to nonexistent character (H %X)");
+ }
+ } else {
+ doublecheck_existence(
+ lig_kern_table[i].entries[1],
+ "KRN",
+ "Unused %s step refers to nonexistent character (H %X)");
+ }
+ }
+ }
+}
+
+void
+output_ofm_ligkern(void)
+{
+ unsigned i;
+ four_entries *entry;
+
+ if (ofm_level == OFM_TFM) {
+ for (i=0; i<nl; i++) {
+ entry = lig_kern_table+i;
+ out_ofm(entry->entries[0] & 0xff);
+ out_ofm(entry->entries[1] & 0xff);
+ out_ofm(entry->entries[2] & 0xff);
+ out_ofm(entry->entries[3] & 0xff);
+ }
+ } else {
+ for (i=0; i<nl; i++) {
+ entry = lig_kern_table+i;
+ out_ofm_2(entry->entries[0] & 0xffff);
+ out_ofm_2(entry->entries[1] & 0xffff);
+ out_ofm_2(entry->entries[2] & 0xffff);
+ out_ofm_2(entry->entries[3] & 0xffff);
+ }
+ }
+ for (i=0; i<nk; i++) {
+ out_ofm_4(kern_table[i]);
+ }
+}
+
+void
+retrieve_ligkern_table(unsigned char *ofm_lig_table,
+ unsigned char *ofm_kern_table)
+{
+ unsigned i;
+ four_entries *entry;
+ unsigned char *table_entry;
+
+ if (ofm_level == OFM_TFM) {
+ for (i=0; i<nl; i++) {
+ entry = lig_kern_table+i;
+ table_entry = ofm_lig_table+(4*i);
+ entry->entries[0] = (*table_entry) & 0xff;
+ entry->entries[1] = (*(table_entry+1)) & 0xff;
+ entry->entries[2] = (*(table_entry+2)) & 0xff;
+ entry->entries[3] = (*(table_entry+3)) & 0xff;
+ }
+ } else {
+ for (i=0; i<nl; i++) {
+ entry = lig_kern_table+i;
+ table_entry = ofm_lig_table+(8*i);
+ entry->entries[0] = (((*table_entry) & 0xff) * 0x100)
+ + ((*(table_entry+1)) & 0xff);
+ entry->entries[1] = (((*(table_entry+2)) & 0xff) * 0x100)
+ + ((*(table_entry+3)) & 0xff);
+ entry->entries[2] = (((*(table_entry+4)) & 0xff) * 0x100)
+ + ((*(table_entry+5)) & 0xff);
+ entry->entries[3] = (((*(table_entry+6)) & 0xff) * 0x100)
+ + ((*(table_entry+7)) & 0xff);
+ }
+ }
+ kern_table = (fix *) xmalloc((nk+1)*sizeof(int));
+ for (i=0; i<nk; i++) {
+ table_entry = ofm_kern_table+(4*i);
+ kern_table[i] = (((*table_entry) & 0xff) << 24) |
+ (((*(table_entry+1)) & 0xff) << 16) |
+ (((*(table_entry+2)) & 0xff) << 8) |
+ ((*(table_entry+3)) & 0xff);
+ }
+}
diff --git a/Build/source/texk/web2c/omegafonts/ligkern_routines.h b/Build/source/texk/web2c/omegafonts/ligkern_routines.h
new file mode 100644
index 00000000000..66a9be31ca0
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/ligkern_routines.h
@@ -0,0 +1,67 @@
+/* ligkern_routines.h: The ligature/kerning table.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+extern four_entries lig_kern_table[100000];
+
+extern void init_ligkern_entry(void);
+extern void set_label_command(unsigned);
+extern void set_ligature_command(unsigned, unsigned, unsigned);
+extern void set_kerning_command(unsigned, fix);
+extern void set_stop_command(void);
+extern void set_skip_command(unsigned);
+extern int set_new_kern(fix);
+extern void print_kerns(void);
+extern void build_kern_table(void);
+extern void set_boundary_character(unsigned);
+
+extern void check_ligature_program(unsigned,unsigned);
+extern void check_ligature_ends_properly(void);
+extern void check_ligature_infinite_loops(void);
+extern void doublecheck_ligatures(void);
+
+extern void print_ligkern_table(void);
+extern void init_ligkern(void);
+
+extern int l_f(hash_list, unsigned, unsigned);
+extern int l_eval(unsigned, unsigned);
+extern int l_hash_input(unsigned, unsigned);
+extern hash_list l_hash_lookup(unsigned, unsigned);
+
+#define PRIME 1009
+
+#define KERN_FLAG 128
+#define STOP_FLAG 128
+
+
+extern void set_c_label_command(unsigned);
+extern void set_c_kerning_command(unsigned, fix);
+extern void set_c_glue_command(unsigned, unsigned);
+extern void set_c_penalty_command(unsigned, unsigned);
+extern void set_c_penglue_command(unsigned, unsigned, unsigned);
+
+extern unsigned nl;
+extern unsigned nk;
+
+extern void output_ofm_ligkern(void);
+extern void retrieve_ligkern_table(unsigned char *, unsigned char *);
+extern void print_one_lig_kern_entry(four_entries *, boolean);
diff --git a/Build/source/texk/web2c/omegafonts/list_routines.c b/Build/source/texk/web2c/omegafonts/list_routines.c
new file mode 100644
index 00000000000..35e390c0527
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/list_routines.c
@@ -0,0 +1,256 @@
+/* list_routines.c: Types used in this program.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "list_routines.h"
+
+list
+cons (void *x, list L)
+{
+list temp;
+temp = (list) xmalloc(sizeof(cell));
+temp->contents = x;
+temp->ptr = L;
+return temp;
+}
+
+list
+list1 (void *x)
+{
+list temp;
+temp = (list) xmalloc(sizeof(cell));
+temp->contents = x;
+temp->ptr = NULL;
+return temp;
+}
+
+list
+list2 (void *x, void *y)
+{
+list temp, temp1;
+temp = (list) xmalloc(sizeof(cell));
+temp1 = (list) xmalloc(sizeof(cell));
+temp->contents = x;
+temp->ptr = temp1;
+temp1->contents = y;
+temp1->ptr = NULL;
+return temp;
+}
+
+list
+append (list K, list L)
+{
+if (K==NULL) return L;
+return cons(K->contents, append(K->ptr, L));
+}
+
+list
+append1 (list L, void *x)
+{
+return (append(L,list1(x)));
+}
+
+
+/* Attribute-value list functions */
+
+av_list
+av_cons (int attr, int val, av_list L)
+{
+av_list temp;
+temp = (av_list) xmalloc(sizeof(av_cell));
+temp->attribute = attr;
+temp->value = val;
+temp->ptr = L;
+return temp;
+}
+
+av_list
+av_list1 (int attr, int val)
+{
+av_list temp;
+temp = (av_list) xmalloc(sizeof(av_cell));
+temp->attribute = attr;
+temp->value = val;
+temp->ptr = NULL;
+return temp;
+}
+
+av_list
+av_list2 (int attr, int val, int attr1, int val1)
+{
+av_list temp, temp1;
+temp = (av_list) xmalloc(sizeof(av_cell));
+temp1 = (av_list) xmalloc(sizeof(av_cell));
+temp->attribute = attr;
+temp->value = val;
+temp->ptr = temp1;
+temp1->attribute = attr1;
+temp1->value = val1;
+temp1->ptr = NULL;
+return temp;
+}
+
+av_list
+av_append (av_list K, av_list L)
+{
+if (K==NULL) return L;
+return av_cons(K->attribute, K->value, av_append(K->ptr, L));
+}
+
+av_list
+av_append1 (av_list L, int attr, int val)
+{
+return (av_append(L,av_list1(attr, val)));
+}
+
+
+/* Index-value list functions */
+
+in_list
+in_cons (int val, in_list N, in_list L)
+{
+in_list temp;
+temp = (in_list) xmalloc(sizeof(in_cell));
+temp->value = val;
+temp->actual = N;
+temp->ptr = L;
+return temp;
+}
+
+in_list
+in_list1 (int val, in_list N)
+{
+in_list temp;
+temp = (in_list) xmalloc(sizeof(in_cell));
+temp->value = val;
+temp->actual = N;
+temp->ptr = NULL;
+return temp;
+}
+
+in_list
+in_list2 (int val, in_list N, int val1, in_list N1)
+{
+in_list temp, temp1;
+temp = (in_list) xmalloc(sizeof(in_cell));
+temp1 = (in_list) xmalloc(sizeof(in_cell));
+temp->value = val;
+temp->ptr = temp1;
+temp->actual = N;
+temp1->value = val1;
+temp->actual = N1;
+temp1->ptr = NULL;
+return temp;
+}
+
+in_list
+in_append (in_list K, in_list L)
+{
+if (K==NULL) return L;
+return in_cons(K->value, K->actual, in_append(K->ptr, L));
+}
+
+in_list
+in_append1 (in_list L, int val, in_list N)
+{
+return (in_append(L,in_list1(val, N)));
+}
+
+/* Attribute-value list functions */
+
+hash_list
+hash_cons (int x, int y, int new_class, int lig_z, hash_list L)
+{
+hash_list temp;
+temp = (hash_list) xmalloc(sizeof(hash_cell));
+temp->x = x;
+temp->y = y;
+temp->new_class = new_class;
+temp->lig_z = lig_z;
+temp->ptr = L;
+return temp;
+}
+
+hash_list
+hash_list1 (int x, int y, int new_class, int lig_z)
+{
+hash_list temp;
+temp = (hash_list) xmalloc(sizeof(hash_cell));
+temp->x = x;
+temp->y = y;
+temp->new_class = new_class;
+temp->lig_z = lig_z;
+temp->ptr = NULL;
+return temp;
+}
+
+hash_list
+hash_list2(int x,int y,int new_class,int lig_z,int x1,int y1,int class1,int lig_z1)
+{
+hash_list temp, temp1;
+temp = (hash_list) xmalloc(sizeof(hash_cell));
+temp1 = (hash_list) xmalloc(sizeof(hash_cell));
+temp->x = x;
+temp->y = y;
+temp->new_class = new_class;
+temp->lig_z = lig_z;
+temp->ptr = temp1;
+temp1->x = x1;
+temp1->y = y1;
+temp1->new_class = class1;
+temp1->lig_z = lig_z1;
+temp1->ptr = NULL;
+return temp;
+}
+
+hash_list
+hash_append (hash_list K, hash_list L)
+{
+if (K==NULL) return L;
+return hash_cons(K->x, K->y, K->new_class, K->lig_z, hash_append(K->ptr, L));
+}
+
+hash_list
+hash_append1 (hash_list L, int x, int y, int new_class, int lig_z)
+{
+return (hash_append(L,hash_list1(x, y, new_class, lig_z)));
+}
+
+void
+init_queue(queue *q)
+{
+ q->front = NULL;
+ q->tail = NULL;
+}
+
+void
+append_to_queue(queue *q, void *content)
+{
+ if (q->front == NULL) {
+ q->front = list1(content);
+ q->tail = q->front;
+ } else {
+ q->tail->ptr = list1(content);
+ q->tail = q->tail->ptr;
+ }
+}
diff --git a/Build/source/texk/web2c/omegafonts/list_routines.h b/Build/source/texk/web2c/omegafonts/list_routines.h
new file mode 100644
index 00000000000..c2ca6d654dd
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/list_routines.h
@@ -0,0 +1,104 @@
+/* list_routines.h: Types used in this program.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+typedef int fix;
+
+typedef struct cell_struct {
+ struct cell_struct *ptr;
+ void *contents;
+} cell;
+typedef cell *list;
+
+typedef struct av_cell_struct {
+ struct av_cell_struct *ptr;
+ int attribute;
+ int value;
+} av_cell;
+typedef av_cell *av_list;
+
+typedef struct in_cell_struct {
+ struct in_cell_struct *ptr;
+ struct in_cell_struct *actual;
+ int value;
+ int index;
+} in_cell;
+typedef in_cell *in_list;
+
+typedef struct hash_cell_struct {
+ int x;
+ int y;
+ int new_class;
+ int lig_z;
+ struct hash_cell_struct *ptr;
+} hash_cell;
+
+typedef hash_cell *hash_list;
+
+typedef struct queue_struct {
+ struct cell_struct *front;
+ struct cell_struct *tail;
+} queue;
+
+extern list cons(void *, list);
+extern list list1(void *);
+extern list list2(void *, void *);
+extern list append(list, list);
+extern list append1(list, void *);
+
+extern av_list av_cons(int,int, av_list);
+extern av_list av_list1(int,int);
+extern av_list av_list2(int,int, int,int);
+extern av_list av_append(av_list, av_list);
+extern av_list av_append1(av_list, int,int);
+
+extern in_list in_cons(int,in_list, in_list);
+extern in_list in_list1(int,in_list);
+extern in_list in_list2(int,in_list, int,in_list);
+extern in_list in_append(in_list, in_list);
+extern in_list in_append1(in_list, int,in_list);
+
+extern hash_list hash_cons(int,int,int,int, hash_list);
+extern hash_list hash_list1(int,int,int,int);
+extern hash_list hash_list2(int,int,int,int, int,int,int,int);
+extern hash_list hash_append(hash_list, hash_list);
+extern hash_list hash_append1(hash_list, int,int,int,int);
+
+#define lattr(L) (L->attribute)
+#define lval(L) (L->value)
+
+typedef struct four_pieces_struct {
+ unsigned int pieces[4];
+} four_pieces;
+
+typedef struct four_entries_struct {
+ int entries[4];
+} four_entries;
+
+#define lb0(L) (((four_entries *)((L)->contents))->entries[0])
+#define lb1(L) (((four_entries *)((L)->contents))->entries[1])
+#define lb2(L) (((four_entries *)((L)->contents))->entries[2])
+#define lb3(L) (((four_entries *)((L)->contents))->entries[3])
+
+
+extern void init_queue(queue *);
+extern void append_to_queue(queue *, void *);
diff --git a/Build/source/texk/web2c/omegafonts/manifests.h b/Build/source/texk/web2c/omegafonts/manifests.h
new file mode 100644
index 00000000000..94a1a80141c
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/manifests.h
@@ -0,0 +1,280 @@
+/* manifests.h: Various constants used everywhere.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+/* Character measures */
+
+#define C_MIN 0
+
+#define C_WD 0
+#define C_HT 1
+#define C_DP 2
+#define C_IC 3
+
+#define C_SECWD 4
+#define C_SECHT 5
+#define C_SECDP 6
+#define C_SECIC 7
+
+#define C_P_TOPAXIS 8
+#define C_P_TOPAXISBIs 9
+#define C_P_BOTAXIS 10
+#define C_P_BOTAXISBIS 11
+#define C_P_MIDHOR 12
+#define C_P_MIDVERT 13
+#define C_P_BASESLANT 14
+
+#define C_S_TOPAXIS 16
+#define C_S_TOPAXISBIs 17
+#define C_S_BOTAXIS 18
+#define C_S_BOTAXISBIS 19
+#define C_S_MIDHOR 20
+#define C_S_MIDVERT 21
+#define C_S_BASESLANT 22
+
+#define C_MAX 22
+
+/* Extensible pieces */
+
+#define E_MIN 0
+
+#define E_TOP 0
+#define E_MID 1
+#define E_BOT 2
+#define E_REP 3
+
+#define E_MAX 3
+
+/* Ligature commands */
+
+#define L_MIN 0
+
+#define L_0 0 /* LIG */
+#define L_B 1 /* LIG/ */
+#define L_A 2 /* /LIG */
+#define L_AB 3 /* /LIG/ */
+#define L_Bx 5 /* LIG/> */
+#define L_Ax 6 /* /LIG> */
+#define L_ABx 7 /* /LIG/> */
+#define L_ABxx 11 /* /LIG/>> */
+
+#define L_MAX 11
+
+/* Xerox faces */
+
+#define F_MIN 0
+
+#define F_MRR 0
+#define F_MIR 1
+#define F_BRR 2
+#define F_BIR 3
+#define F_LRR 4
+#define F_LIR 5
+#define F_MRC 6
+#define F_MIC 7
+#define F_BRC 8
+#define F_BIC 9
+#define F_LRC 10
+#define F_LIC 11
+#define F_MRE 12
+#define F_MIE 13
+#define F_BRE 14
+#define F_BIE 15
+#define F_LRE 16
+#define F_LIE 17
+
+#define F_MAX 17
+
+/* Named parameters */
+
+#define P_MIN 1
+
+#define P_SLANT 1
+#define P_SPACE 2
+#define P_STRETCH 3
+#define P_SHRINK 4
+#define P_XHEIGHT 5
+#define P_QUAD 6
+#define P_EXTRASPACE 7
+
+#define P_MAX 7
+
+/* Named math symbol parameters */
+
+#define P_MATHSY_MIN 8
+
+#define P_NUM1 8
+#define P_NUM2 9
+#define P_NUM3 10
+#define P_DENOM1 11
+#define P_DENOM2 12
+#define P_SUP1 13
+#define P_SUP2 14
+#define P_SUP3 15
+#define P_SUB1 16
+#define P_SUB2 17
+#define P_SUPDROP 18
+#define P_SUBDROP 19
+#define P_DELIM1 20
+#define P_DELIM2 21
+#define P_AXISHEIGHT 22
+
+#define P_MATHSY_MAX 22
+
+/* Named math extension parameters */
+
+#define P_MATHEX_MIN 8
+
+#define P_DEFAULTRULETHICKNESS 8
+#define P_BIGOPSPACING1 9
+#define P_BIGOPSPACING2 10
+#define P_BIGOPSPACING3 11
+#define P_BIGOPSPACING4 12
+#define P_BIGOPSPACING5 13
+
+#define P_MATHEX_MAX 13
+
+/* Typesetting directions */
+
+#define DIR_MIN 0
+
+#define DIR_ORD 0
+#define DIR_NAT 8
+
+#define DIR_TL 0
+#define DIR_LT 1
+#define DIR_TR 2
+#define DIR_LB 3
+#define DIR_BL 4
+#define DIR_RT 5
+#define DIR_BR 6
+#define DIR_RB 7
+
+#define DIR_MAX 15
+
+/* Kinds of accent */
+
+#define ACC_NONE 0
+#define ACC_TOP 1
+#define ACC_MID 2
+#define ACC_BOT 3
+
+/* Move directions */
+
+#define M_MIN 0
+
+#define M_RIGHT 0
+#define M_LEFT 1
+#define M_UP 2
+#define M_DOWN 3
+
+#define M_MAX 3
+
+/* Rule measures */
+
+#define RULE_MIN 0
+
+#define RULE_WD 0
+#define RULE_HT 1
+#define RULE_DP 2
+
+#define RULE_MAX 2
+
+/* Glue shrink or stretch */
+
+#define GLUE_MIN 0
+
+#define GLUE_SHRINK 0
+#define GLUE_STRETCH 1
+
+#define GLUE_MAX 1
+
+/* Glue orders */
+
+#define O_MIN 0
+
+#define O_UNIT 0
+#define O_FI 1
+#define O_FIL 2
+#define O_FILL 3
+#define O_FILLL 4
+
+#define O_MAX 4
+
+
+/* Glue kinds */
+
+#define K_MIN 0
+
+#define K_NORMAL 0
+#define K_ALEADERS 1
+#define K_CLEADERS 2
+#define K_XLEADERS 3
+
+#define K_MAX 3
+
+
+/* Font types */
+
+#define FT_MIN 0
+
+#define FT_VANILLA 0
+#define FT_MATHSY 1
+#define FT_MATHEX 2
+
+#define FT_MAX 2
+
+
+#define UNITY 0x100000
+#define INFINITY 0x7fffffff
+
+#define LEN_CODING_SCHEME 39
+#define LEN_FAMILY 19
+#define LEN_VTITLE 255
+#define LEN_FONT_NAME 255
+#define LEN_FONT_AREA 255
+
+#define TAG_NONE 0
+#define TAG_LIG 1
+#define TAG_LIST 2
+#define TAG_EXT 3
+
+#define CHAR_MINIMUM 0x0
+#define CHAR_MAXIMUM 0x7fffffff
+#define CHAR_BOUNDARY 0x80000000
+#define CHAR_ERROR 0x80000001
+
+#define LIG_SIMPLE 0 /* f(x,y) = z */
+#define LIG_LEFT_Z 1 /* f(x,y) = f(z,y) */
+#define LIG_RIGHT_Z 2 /* f(x,y) = f(x,z) */
+#define LIG_BOTH_Z 3 /* f(x,y) = f(f(x,z),y) */
+#define LIG_PENDING 4 /* f(x,y) is being evaluated */
+
+#define GLUEARG_NONE 0
+#define GLUEARG_CHAR 1
+#define GLUEARG_RULE 2
+
+#define OFM_NOLEVEL 0
+#define OFM_TFM 1
+#define OFM_LEVEL0 2
+#define OFM_LEVEL1 3
+#define OFM_LEVEL2 4
diff --git a/Build/source/texk/web2c/omegafonts/omfonts.c b/Build/source/texk/web2c/omegafonts/omfonts.c
new file mode 100644
index 00000000000..bfbbf7f429f
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/omfonts.c
@@ -0,0 +1,323 @@
+/* omfonts.c: Main routine for ofm2opl, opl2ofm, ovf2ovp, ovp2ovf.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define OFM2OPL
+#define OPL2OFM
+#define OVP2OVF
+#define OVF2OVP
+#include "cpascal.h"
+#include "parser.h"
+#include "manifests.h"
+#include "omfonts.h"
+#include "list_routines.h"
+#include "error_routines.h"
+#include "header_routines.h"
+#include "font_routines.h"
+#include "param_routines.h"
+#include "char_routines.h"
+#include "dimen_routines.h"
+#include "parse_ofm.h"
+
+#define PROG_MIN 0
+#define PROG_OFM2OPL 0
+#define PROG_OVF2OVP 1
+#define PROG_OPL2OFM 2
+#define PROG_OVP2OVF 3
+#define PROG_MAX 3
+
+extern FILE *yyin;
+
+#define cmdline(i) (argv[i])
+
+int verbose_option;
+int char_format = CHAR_CODE_NUM;
+int num_format = NUM_CODE_HEX;
+int text_format = TEXT_CODE_MIXED;
+
+int program;
+
+string name_ofm = NULL;
+string name_opl = NULL;
+string name_ovp = NULL;
+string name_ovf = NULL;
+
+FILE *file_ofm = NULL;
+FILE *file_opl = NULL;
+FILE *file_ovp = NULL;
+FILE *file_ovf = NULL;
+FILE *file_output = NULL;
+
+unsigned char *ofm = NULL;
+unsigned char *ovf = NULL;
+
+unsigned length_ofm = 0;
+unsigned length_ovf = 0;
+
+const_string name_program;
+const_string *name_help;
+string name_msg;
+
+string name_empty = NULL;
+
+int no_files=0;
+string *files[3] = {NULL, NULL, NULL};
+string suffixes[3] = {NULL, NULL, NULL};
+string full_suffixes[3] = {NULL, NULL, NULL};
+
+static struct option long_options[] = {
+ {"verbose", 0, &verbose_option, 1},
+ {"char-format", 1, 0, 0},
+ {"num-format", 1, 0, 0},
+ {"text-format", 1, 0, 0},
+ {"help", 0, 0, 0},
+ {"version", 0, 0, 0},
+ {0, 0, 0, 0}
+};
+
+int
+main (int argc, string *argv)
+{
+ int getopt_return_val;
+ int option_index = 0;
+
+ name_program = xbasename(argv[0]);
+ if (!strcmp(name_program, "ofm2opl") ||
+ !strcmp(name_program, "OFM2OPL.EXE")) {
+ program = PROG_OFM2OPL;
+ name_help = OFM2OPLHELP;
+ name_program = "ofm2opl";
+ name_msg = "This is ofm2opl, Version 2.0";
+ no_files = 2;
+ files[0] = &name_ofm;
+ files[1] = &name_opl;
+ suffixes[0] = "ofm";
+ suffixes[1] = "opl";
+ full_suffixes[0] = ".ofm";
+ full_suffixes[1] = ".opl";
+ } else if (!strcmp(name_program, "opl2ofm") ||
+ !strcmp(name_program, "OPL2OFM.EXE")) {
+ program = PROG_OPL2OFM;
+ name_help = OPL2OFMHELP;
+ name_program = "opl2ofm";
+ name_msg = "This is opl2ofm, Version 2.0";
+ no_files = 2;
+ files[0] = &name_opl;
+ files[1] = &name_ofm;
+ suffixes[0] = "opl";
+ suffixes[1] = "ofm";
+ full_suffixes[0] = ".opl";
+ full_suffixes[1] = ".ofm";
+ } else if (!strcmp(name_program, "ovp2ovf") ||
+ !strcmp(name_program, "OVP2OVF.EXE")) {
+ program = PROG_OVP2OVF;
+ name_help = OVP2OVFHELP;
+ name_program = "ovp2ovf";
+ name_msg = "This is ovp2ovf, Version 2.0";
+ no_files = 3;
+ files[0] = &name_ovp;
+ files[1] = &name_ovf;
+ files[2] = &name_ofm;
+ suffixes[0] = "ovp";
+ suffixes[1] = "ovf";
+ suffixes[2] = "ofm";
+ full_suffixes[0] = ".ovp";
+ full_suffixes[1] = ".ovf";
+ full_suffixes[2] = ".ofm";
+ } else if (!strcmp(name_program, "ovf2ovp") ||
+ !strcmp(name_program, "OVF2OVP.EXE")) {
+ program = PROG_OVF2OVP;
+ name_help = OVF2OVPHELP;
+ name_program = "ovf2ovp";
+ name_msg = "This is ovf2ovp, Version 2.0";
+ no_files = 3;
+ files[0] = &name_ovf;
+ files[1] = &name_ofm;
+ files[2] = &name_ovp;
+ suffixes[0] = "ovf";
+ suffixes[1] = "ofm";
+ suffixes[2] = "ovp";
+ full_suffixes[0] = ".ovf";
+ full_suffixes[1] = ".ofm";
+ full_suffixes[2] = ".ovp";
+ } else {
+ fprintf(stderr , "Unrecognized program: %s\n", name_program);
+ fprintf(stderr ,
+ "This binary supports ofm2opl, opl2ofm, ovf2ovp, and ovp2ovf\n");
+ exit(1);
+ }
+ kpse_set_program_name(name_program, NULL);
+ kpse_init_prog(uppercasify(name_program), 0, nil, nil);
+
+ do {
+ getopt_return_val =
+ getopt_long_only(argc, argv, "", long_options, &option_index) ;
+ if (getopt_return_val == -1) { ; }
+ else if ( getopt_return_val == 63 ) {
+ usage (name_program);
+ } else if (!strcmp(long_options[option_index].name, "help")) {
+ usagehelp (name_help, NULL);
+ } else if (!strcmp(long_options[option_index ].name, "version")) {
+ printversionandexit(name_msg, nil,
+ "J. Plaice, Y. Haralambous, D.E. Knuth");
+ } else if (!strcmp(long_options[option_index ].name, "char-format")) {
+ if (!strcmp(optarg, "ascii")) char_format = CHAR_CODE_ASCII;
+ else if (!strcmp(optarg, "num")) char_format = CHAR_CODE_NUM;
+ else warning_s("Bad character code format (%s)", optarg);
+ } else if (!strcmp(long_options[option_index ].name, "num-format")) {
+ if (!strcmp(optarg, "hex")) num_format = NUM_CODE_HEX;
+ else if (!strcmp(optarg, "octal")) num_format = NUM_CODE_OCTAL;
+ else warning_s("Bad number code format (%s)", optarg);
+ } else if (!strcmp(long_options[option_index ].name, "text-format")) {
+ if (!strcmp(optarg, "upper")) text_format = TEXT_CODE_UPPER;
+ else if (!strcmp(optarg, "mixed")) text_format = TEXT_CODE_MIXED;
+ else warning_s("Bad text code format (%s)", optarg);
+ }
+ } while (getopt_return_val != -1);
+ if (((argc-optind) > no_files) || ((argc-optind) < 1)) {
+ fprintf(stderr , "%s: %s\n", name_program,
+ no_files == 2 ? "Need one or two file arguments."
+ : "Need one to three file arguments.");
+ usage (name_program);
+ }
+ *(files[0]) = extend_filename(cmdline(optind) , suffixes[0]);
+ if (optind+2 <= argc) {
+ *(files[1]) = extend_filename(cmdline(optind+1) , suffixes[1]);
+ if (no_files == 3) {
+ if (optind+3 <= argc) {
+ *(files[2]) = extend_filename(cmdline(optind+2) , suffixes[2]);
+ } else if (program == PROG_OVP2OVF) {
+ *(files[2]) = extend_filename(cmdline(optind+1), suffixes[2]);
+ }
+ }
+ } else if (program != PROG_OFM2OPL) {
+ *(files[1]) = basenamechangesuffix(*(files[0]),
+ full_suffixes[0], full_suffixes[1]);
+ if ((no_files == 3) && (program == PROG_OVP2OVF)) {
+ *(files[2]) = basenamechangesuffix(*(files[0]),
+ full_suffixes[0], full_suffixes[2]);
+ }
+ }
+
+ switch(program) {
+ case PROG_OFM2OPL: {
+ file_ofm = kpse_open_file(name_ofm, kpse_ofm_format);
+ read_in_whole(&ofm, &length_ofm, file_ofm, name_ofm);
+ (void)fclose(file_ofm);
+ if (name_opl==NULL) file_opl = stdout;
+ else rewrite(file_opl, name_opl);
+ file_output = file_opl;
+ parse_ofm(FALSE);
+ break;
+ }
+ case PROG_OVF2OVP: {
+ file_ovf = kpse_open_file(name_ovf, kpse_ovf_format);
+ read_in_whole(&ovf, &length_ovf, file_ovf, name_ovf);
+ (void)fclose(file_ovf);
+ file_ofm = kpse_open_file(name_ofm, kpse_ofm_format);
+ read_in_whole(&ofm, &length_ofm, file_ofm, name_ofm);
+ (void)fclose(file_ofm);
+ if (name_ovp==NULL) file_ovp = stdout;
+ else rewrite(file_ovp, name_ovp);
+ file_output = file_ovp;
+ parse_ofm(TRUE);
+ break;
+ }
+ case PROG_OPL2OFM: {
+ file_opl = kpse_open_file(name_opl, kpse_opl_format);
+ rewritebin(file_ofm, name_ofm);
+ init_tables();
+ yyin = file_opl;
+ (void)yyparse();
+ output_ofm_file();
+ (void)fclose(file_ofm);
+ break;
+ }
+ case PROG_OVP2OVF: {
+ file_ovp = kpse_open_file(name_ovp, kpse_ovp_format);
+ rewritebin(file_ovf, name_ovf);
+ rewritebin(file_ofm, name_ofm);
+ init_tables();
+ yyin = file_ovp;
+ (void)yyparse();
+ output_ofm_file();
+ /*(void)fclose(file_ofm);*/
+ output_ovf_file();
+ (void)fclose(file_ovf);
+ break;
+ }
+ default: {exit(1);}
+ }
+ exit(0);
+}
+
+#define BIG_BLOCK 0x20000
+#define LITTLE_BLOCK 0x1000
+
+void
+read_in_whole(unsigned char **contents_loc,
+ unsigned *length_loc,
+ FILE *file,
+ string name)
+{
+ unsigned no_read;
+ unsigned no_total_read = 0;
+ unsigned size = BIG_BLOCK;
+ string where;
+ string current_block;
+
+ current_block = (char *) xmalloc(size);
+ where = current_block;
+
+ while (1) {
+ no_read = fread(where, 1, LITTLE_BLOCK, file);
+ no_total_read += no_read;
+ if ((no_total_read+LITTLE_BLOCK) > size) {
+ size *= 2;
+ current_block = (char *) xrealloc(current_block, size);
+ }
+ where = current_block + no_total_read;
+ if (ferror(file)) {
+ fatal_error_s("Error while reading file %s", name);
+ } else if (feof(file)) {
+ break;
+ }
+ }
+
+ *contents_loc = (unsigned char *) current_block;
+ *length_loc = no_total_read;
+}
+
+void
+init_tables(void)
+{
+ font_table_init(); /* subsidiary fonts in virtual fonts */
+ init_header();
+ init_planes();
+ init_measures();
+}
+
+void
+output_text_file(FILE *dest)
+{
+}
+
diff --git a/Build/source/texk/web2c/omegafonts/omfonts.h b/Build/source/texk/web2c/omegafonts/omfonts.h
new file mode 100644
index 00000000000..8889f501a41
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/omfonts.h
@@ -0,0 +1,50 @@
+/* omfonts.h: Main routine for ofm2opl, opl2ofm, ovf2ovp, ovp2ovf.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define CHAR_CODE_NUM 0
+#define CHAR_CODE_ASCII 1
+#define NUM_CODE_HEX 0
+#define NUM_CODE_OCTAL 1
+#define TEXT_CODE_UPPER 0
+#define TEXT_CODE_MIXED 1
+
+extern FILE *file_ovf;
+extern FILE *file_output;
+extern int verbose_option;
+extern int char_format;
+extern int num_format;
+extern int text_format;
+
+extern unsigned length_ofm;
+extern unsigned length_ovf;
+
+extern unsigned char *ofm;
+extern unsigned char *ovf;
+
+extern int main(int, string *);
+extern void read_in_whole(unsigned char **, unsigned *, FILE *, string );
+extern void init_tables(void);
+extern void output_ofm_file(void);
+extern void output_ovf_file(void);
+extern void output_text_file(FILE *);
+
diff --git a/Build/source/texk/web2c/omegafonts/out_ofm.c b/Build/source/texk/web2c/omegafonts/out_ofm.c
new file mode 100644
index 00000000000..300b7c66c98
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/out_ofm.c
@@ -0,0 +1,209 @@
+/* out_ofm.c: Outputting to an OFM file.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "list_routines.h"
+#include "header_routines.h"
+#include "manifests.h"
+#include "char_routines.h"
+#include "ligkern_routines.h"
+#include "out_ofm.h"
+#include "extra_routines.h"
+#include "param_routines.h"
+#include "dimen_routines.h"
+#include "error_routines.h"
+#include "parse_ofm.h"
+
+void
+output_ofm_file(void)
+{
+ check_and_correct();
+ compute_ofm_character_info();
+ compute_ofm_subsizes();
+ output_ofm_subsizes();
+ output_ofm_header();
+ compute_ofm_extra_stuff();
+ output_ofm_extra_stuff();
+ output_ofm_character_info();
+ output_ofm_dimension();
+ output_ofm_ligkern();
+ output_ofm_extensible();
+ output_ofm_parameter();
+}
+
+extern unsigned header_ptr;
+extern unsigned mw,mh,md,mi;
+
+void
+compute_ofm_subsizes(void)
+{
+ switch(ofm_level) {
+ case OFM_TFM: {
+ lh = header_max + 1;
+ if (bc > ec) bc = 1;
+ if (ec>255)
+ fatal_error_1(
+ "Char (%x) too big for TFM (max ff); use OFM file",ec);
+ nw++; nh++; nd++; ni++;
+ compute_ligkern_offset();
+ lf = 6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+lk_offset+nk+ne+np;
+ /*lf = 6+lh+(ec-bc+1)+nw+nh+nd+ni+nl-1+lk_offset+nk+ne+np;*/
+ break;
+ }
+ case OFM_LEVEL0: {
+ lh = header_max + 1;
+ if (ec>65535)
+ fatal_error_1(
+ "Char (%x) too big for OFM level-0 (max ffff); use level-2",
+ ec);
+ if (bc > ec) bc = 1;
+ nw++; nh++; nd++; ni++;
+ compute_ligkern_offset();
+ lf = 14+lh+2*(ec-bc+1)+nw+nh+nd+ni+2*(nl+lk_offset)+nk+2*ne+np;
+ break;
+ }
+ case OFM_LEVEL1: {
+ lh = header_max + 1;
+ if (ec>65535)
+ fatal_error_1(
+ "Char (%x) too big for OFM level-1 (max ffff); use level-2",
+ ec);
+ if (bc > ec) bc = 1;
+ nw++; nh++; nd++; ni++;
+ compute_ligkern_offset();
+ lf = 29+lh+ncw+nw+nh+nd+ni+2*(nl+lk_offset)+nk+2*ne+np+
+ nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp;
+ nco = 29+lh+nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp;
+ break;
+ }
+ default: { internal_error_0("output_ofm_subfiles"); }
+ }
+}
+
+void
+output_ofm_subsizes(void)
+{
+ switch(ofm_level) {
+ case OFM_TFM: {
+ out_ofm_2(lf); out_ofm_2(lh); out_ofm_2(bc); out_ofm_2(ec);
+ out_ofm_2(nw); out_ofm_2(nh); out_ofm_2(nd); out_ofm_2(ni);
+ out_ofm_2(nl+lk_offset); out_ofm_2(nk);
+ out_ofm_2(ne); out_ofm_2(np);
+ break;
+ }
+ case OFM_LEVEL0: {
+ out_ofm_4(0);
+ out_ofm_4(lf); out_ofm_4(lh); out_ofm_4(bc); out_ofm_4(ec);
+ out_ofm_4(nw); out_ofm_4(nh); out_ofm_4(nd); out_ofm_4(ni);
+ out_ofm_4(nl+lk_offset); out_ofm_4(nk);
+ out_ofm_4(ne); out_ofm_4(np); out_ofm_4(font_dir);
+ break;
+ }
+ case OFM_LEVEL1: {
+ out_ofm_4(1);
+ out_ofm_4(lf); out_ofm_4(lh); out_ofm_4(bc); out_ofm_4(ec);
+ out_ofm_4(nw); out_ofm_4(nh); out_ofm_4(nd); out_ofm_4(ni);
+ out_ofm_4(nl+lk_offset); out_ofm_4(nk);
+ out_ofm_4(ne); out_ofm_4(np); out_ofm_4(font_dir);
+ out_ofm_4(nco); out_ofm_4(ncw); out_ofm_4(npc);
+ out_ofm_4(nki); out_ofm_4(nwi);
+ out_ofm_4(nkf); out_ofm_4(nwf);
+ out_ofm_4(nkm); out_ofm_4(nwm);
+ out_ofm_4(nkr); out_ofm_4(nwr);
+ out_ofm_4(nkg); out_ofm_4(nwg);
+ out_ofm_4(nkp); out_ofm_4(nwp);
+ break;
+ }
+ default: { internal_error_0("output_ofm_subfiles"); }
+ }
+}
+
+extern FILE *file_ofm;
+unsigned file_ofm_count = 0;
+
+void
+out_ofm(unsigned i)
+{
+ fputc(i,file_ofm);
+ file_ofm_count++;
+}
+
+void
+out_ofm_2(unsigned i)
+{
+
+ fputc((i>>8)&0xff, file_ofm);
+ fputc(i&0xff, file_ofm);
+ file_ofm_count += 2;
+}
+
+void
+out_ofm_4(unsigned i)
+{
+ fputc((i>>24)&0xff, file_ofm);
+ fputc((i>>16)&0xff, file_ofm);
+ fputc((i>>8)&0xff, file_ofm);
+ fputc(i&0xff, file_ofm);
+ file_ofm_count += 4;
+}
+
+void
+out_ofm_char(unsigned i)
+{
+ if (ofm_level == OFM_NOLEVEL) {
+ internal_error_1("out_ofm_char.1 (ofm_level=%d)", ofm_level);
+ }
+ if (ofm_level == OFM_TFM) {
+ if (i>=0x100) internal_error_1("out_ofm_char.2 (i=%x)", i);
+ out_ofm(i);
+ } else {
+ if (i>=0x10000) internal_error_1("out_ofm_char.3 (i=%x)", i);
+ out_ofm_2(i);
+ }
+}
+
+#define dabs(x) ((x)>=0?(x):-(x))
+
+void
+out_ofm_scaled(fix fval)
+{
+ if (dabs((double)fval/(double)design_units) >= 16.0) {
+ warning_2("The relative dimension %d is too large.\n"
+ "Must be less than 16*designsize = %d designunits",
+ fval/0x100000, design_units/0x10000);
+ fval = 0;
+ }
+ if (design_units != UNITY) {
+ fval = zround(((double)fval/(double)design_units) * 1048576.0);
+ }
+ if (fval < 0) {
+ out_ofm(255); fval = fval + 0x1000000;
+ if (fval <= 0) fval = 1;
+ } else {
+ out_ofm(0);
+ if (fval >= 0x1000000) fval = 0xffffff;
+ }
+ out_ofm((fval >> 16) & 0xff);
+ out_ofm((fval >> 8) & 0xff);
+ out_ofm(fval & 0xff);
+}
diff --git a/Build/source/texk/web2c/omegafonts/out_ofm.h b/Build/source/texk/web2c/omegafonts/out_ofm.h
new file mode 100644
index 00000000000..3a519f79a4b
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/out_ofm.h
@@ -0,0 +1,36 @@
+/* out_ofm.h: Outputting to an OFM file.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+extern void output_ofm_file(void);
+extern void out_ofm_4(unsigned);
+extern void out_ofm_2(unsigned);
+extern void out_ofm_char(unsigned);
+extern void out_ofm_scaled(fix);
+extern void out_ofm(unsigned);
+
+extern void compute_ofm_subsizes(void);
+extern void output_ofm_subsizes(void);
+extern void output_ofm_header(void);
+extern void output_ofm_extra_stuff(void);
+extern void compute_ofm_character_info(void);
+extern void output_ofm_character_info(void);
diff --git a/Build/source/texk/web2c/omegafonts/out_routines.c b/Build/source/texk/web2c/omegafonts/out_routines.c
new file mode 100644
index 00000000000..7282d607a40
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/out_routines.c
@@ -0,0 +1,381 @@
+/* out_routines.c: Low-level routines for outputting OPL and OVP files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "list_routines.h"
+#include "manifests.h"
+#include "omfonts.h"
+#include "out_routines.h"
+#include "error_routines.h"
+#include "header_routines.h"
+#include "char_routines.h"
+
+/* Character measures */
+
+string character_measures[] =
+ { "CHARWD", "CHARHT", "CHARDP", "CHARIC",
+ "SECWD", "SECHT", "SECDP", "SECIC",
+ "PRIMTOPAXIS", "PRIMTOPAXISBIS", "PRIMBOTAXIS", "PRIMBOTAXISBIS",
+ "PRIMMIDHOR", "PRIMMIDVERT", "PRIMBASESLANT", NULL,
+ "SECTOPAXIS", "SECTOPAXISBIS", "SECBOTAXIS", "SECBOTAXISBIS",
+ "SECMIDHOR", "SECMIDVERT", "SECBASESLANT", NULL};
+
+void
+out_character_measure(unsigned measure)
+{
+ if ((measure < C_MIN) || (measure > C_MAX) ||
+ (character_measures[measure]==NULL)) {
+ internal_error_1("out_character_measure (measure=%d)", measure);
+ }
+ out(character_measures[measure]);
+}
+
+/* Extensible pieces */
+
+string extensible_pieces[] =
+ { "TOP", "MID", "BOT", "REP", NULL };
+
+void
+out_extensible_piece(unsigned piece)
+{
+ if ((piece < E_MIN) || (piece > E_MAX)) {
+ internal_error_1("out_extensible_piece (piece=%d)", piece);
+ }
+ out(extensible_pieces[piece]);
+}
+
+/* Ligature commands */
+
+string ligature_commands[] =
+ { "LIG", "LIG/", "/LIG", "/LIG/", NULL,
+ "LIG/>", "/LIG>", "/LIG/>", NULL, NULL,
+ NULL, "/LIG/>>", NULL };
+
+void
+out_ligature_command(unsigned command)
+{
+ if ((command < L_MIN) || (command > L_MAX) ||
+ (ligature_commands[command]==NULL)) {
+ internal_error_1("out_ligature_command (command=%d)", command);
+ }
+ out(ligature_commands[command]);
+}
+
+/* Xerox faces */
+
+string xerox_faces[] =
+ { "MRR", "MIR", "BRR", "BIR", "LRR", "LIR",
+ "MRC", "MIC", "BRC", "BIC", "LRC", "LIC",
+ "MRE", "MIE", "BRE", "BIE", "LRE", "LIE", NULL };
+
+void
+print_xerox_face(int face)
+{
+ if ((face < F_MIN) || (face > F_MAX)) {
+ internal_error_1("print_xerox_face (face=%d)", face);
+ }
+ out("F "); out(xerox_faces[face]);
+}
+
+/* Named parameters */
+
+string named_parameters[] =
+ { NULL, "SLANT", "SPACE", "STRETCH", "SHRINK", "XHEIGHT",
+ "QUAD", "EXTRASPACE", NULL };
+
+void
+out_named_parameter(unsigned parameter)
+{
+ if ((parameter < P_MIN) || (parameter > P_MAX)) {
+ internal_error_1("out_named_parameter (parameter = %d)", parameter);
+ }
+ out(named_parameters[parameter]);
+}
+
+/* Named math symbol parameters */
+
+string named_mathsy_parameters[] =
+ { NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
+ "NUM1", "NUM2", "NUM3", "DENOM1",
+ "DENOM2", "SUP1", "SUP2", "SUP3", "SUB1", "SUB2",
+ "SUPDROP", "SUBDROP", "DELIM1", "DELIM2", "AXISHEIGHT", NULL };
+
+void
+out_named_mathsy_parameter(unsigned parameter)
+{
+ if ((parameter < P_MATHSY_MIN) || (parameter > P_MATHSY_MAX) ||
+ (named_mathsy_parameters[parameter]==NULL)) {
+ internal_error_1("out_named_mathsy_parameter (parameter=%d)",parameter);
+ }
+ out(named_mathsy_parameters[parameter]);
+}
+
+/* Named math extension parameters */
+
+string named_mathex_parameters[] =
+ { NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
+ "DEFAULTRULETHICKNESS", "BIGOPSPACING1",
+ "BIGOPSPACING2", "BIGOPSPACING3",
+ "BIGOPSPACING4", "BIGOPSPACING5", NULL };
+
+void
+out_named_mathex_parameter(unsigned parameter)
+{
+ if ((parameter < P_MATHEX_MIN) || (parameter > P_MATHEX_MAX) ||
+ (named_mathex_parameters[parameter]==NULL)) {
+ internal_error_1("out_named_mathex_parameter (parameter=%d)",parameter);
+ }
+ out(named_mathex_parameters[parameter]);
+}
+
+/* Typesetting directions */
+
+string type_directions[] =
+ { "FONTDIR", "NATURALFONTDIR", NULL };
+
+string actual_directions[] =
+ { "TL", "LT", "TR", "RT", "LB", "BL", "BR", "RB", NULL };
+
+void
+out_type_direction(unsigned direction)
+{
+ if ((direction < DIR_MIN) || (direction > DIR_MAX)) {
+ internal_error_1("out_type_direction (direction=%d)", direction);
+ }
+ out(type_directions[direction/8]); out(" ");
+ out(actual_directions[direction%8]);
+}
+
+/* Kinds of accents */
+
+string accent_kinds[] =
+ { NULL, "TOPACCENT", "MIDACCENT", "BOTACCENT", NULL };
+
+void
+out_accent_kind(unsigned kind)
+{
+ if ((kind < ACC_TOP) || (kind > ACC_BOT)) {
+ internal_error_1("out_accent_kind (kind=%d)", kind);
+ }
+ out(accent_kinds[kind]);
+}
+
+/* Move directions */
+
+string move_directions[] =
+ { "MOVERIGHT", "MOVELEFT", "MOVEUP", "MOVEDOWN", NULL };
+
+void
+out_move_direction(unsigned direction)
+{
+ if ((direction < M_MIN) || (direction > M_MAX)) {
+ internal_error_1("out_move_direction (direction=%d)", direction);
+ }
+ out(move_directions[direction]);
+}
+
+/* Rule measures */
+
+string rule_measures[] =
+ { "RULEWD", "RULEHT", "RULEDP", NULL };
+
+void
+out_rule_measure(unsigned measure)
+{
+ if ((measure < RULE_MIN) || (measure > RULE_MAX)) {
+ internal_error_1("out_rule_measure (measure=%d)", measure);
+ }
+ out(rule_measures[measure]);
+}
+
+/* Glue shrink or stretch */
+
+string glue_shrink_stretch[] =
+ { "GLUESHRINK", "GLUESTRETCH", NULL };
+
+void
+out_shrink_stretch(unsigned shrink_stretch)
+{
+ if ((shrink_stretch < GLUE_MIN) || (shrink_stretch > GLUE_MAX)) {
+ internal_error_1("out_shrink_stretch (shrink_stretch=%d)",
+ shrink_stretch);
+ }
+ out(glue_shrink_stretch[shrink_stretch]);
+}
+
+/* Glue orders */
+
+string glue_orders[] =
+ { "UNIT", "FI", "FIL", "FILL", "FILLL", NULL };
+
+void
+out_glue_order(unsigned order)
+{
+ if ((order < O_MIN) || (order > O_MAX)) {
+ internal_error_1("out_glue_order (order=%d)", order);
+ }
+ out(glue_orders[order]);
+}
+
+/* Glue kinds */
+
+string glue_kinds[] =
+ { "NORMAL", "ALEADERS", "CLEADERS", "ALEADERS", "XLEADERS", NULL };
+
+void
+out_glue_kind(unsigned kind)
+{
+ if ((kind < K_MIN) || (kind > K_MAX)) {
+ internal_error_1("out_glue_kind (kind=%d)", kind);
+ }
+ out(glue_kinds[kind]);
+}
+
+unsigned parenthesis_level=0;
+unsigned digits[12];
+
+/* Basic routines used by everyone */
+
+void
+out_ln(void)
+{
+ unsigned i;
+ out("\n");
+ for (i = 0; i < parenthesis_level; i++) out(" ");
+}
+
+void
+left(void)
+{
+ parenthesis_level++; out("(");
+}
+
+void
+right(void)
+{
+ if (parenthesis_level==0) internal_error_0("right");
+ parenthesis_level--; out(")"); out_ln();
+}
+
+void
+out_char(unsigned val)
+{
+ if (char_format==CHAR_CODE_NUM) out_num(val);
+ else if (font_type!=FT_VANILLA) out_num(val);
+ else if (((val>='0') && (val<='9')) ||
+ ((val>='A') && (val<='Z')) ||
+ ((val>='a') && (val<='z')))
+ fprintf(file_output, "C %c", val);
+ else out_num(val);
+}
+
+void
+out_num(unsigned val)
+{
+ if (num_format==NUM_CODE_OCTAL) out_int(val, 8);
+ else out_int(val, 16);
+}
+
+void
+out_int(unsigned val, unsigned base)
+{
+ register unsigned j=0, acc=val;
+ if (val < 0) internal_error_1("out_int (val=%d)", val);
+ if (base==16) out("H ");
+ else if (base==10) out("D ");
+ else if (base==8) out("O ");
+ else internal_error_1("out_int (base=%d)", base);
+ do {
+ digits[j] = acc % base;
+ j++;
+ acc = acc / base;
+ } while (acc > 0);
+/*
+ if ((base==16) && (ec>=0x100)) {
+ while (j<4) { digits[j] = 0; j++; }
+ }
+*/
+ out_digits(j);
+}
+
+void
+out_as_fix(fix fval)
+{
+ register fix x=0;
+
+ if (fval<0) {
+ x = 0xff000000;
+ fval = fval + 0x1000000;
+ }
+ x = x | (fval & 0xff);
+ fval = fval % 0x100;
+ x = x | ((fval & 0xff) << 8);
+ fval = fval % 0x100;
+ x = x | ((fval & 0xff) << 16);
+ out_fix(x);
+}
+
+void
+out_fix(fix fval)
+{
+ register int a = (fval & 0xfff00000) >> 20, f = fval & 0xfffff, j=0;
+ register int delta;
+
+ out("R ");
+ if (a>0x7ff) {
+ out("-"); a = 0x1000 - a;
+ if (f>0) {
+ f = 0x100000 - f; a--;
+ }
+ }
+ do {
+ digits[j] = a % 10;
+ j++;
+ a = a / 10;
+ } while (a > 0);
+ out_digits(j);
+ out(".");
+ f = 10*f + 5; delta = 10;
+ do {
+ if (delta>0x100000) f = f + 0x80000 - (delta / 2);
+ fprintf(file_output, "%c", (f / 0x100000) + '0');
+ f = 10 * (f % 0x100000); delta = delta*10;
+ } while (f>delta);
+}
+
+void
+out_digits(unsigned counter)
+{
+ register unsigned j=counter, c;
+ while (j>0) {
+ c = digits[--j];
+ if (c<10) fprintf(file_output, "%c", c+'0');
+ else fprintf(file_output, "%c", c+'A'-10);
+ }
+}
+
+void
+out(string sval)
+{
+ fprintf(file_output, sval);
+}
diff --git a/Build/source/texk/web2c/omegafonts/out_routines.h b/Build/source/texk/web2c/omegafonts/out_routines.h
new file mode 100644
index 00000000000..ff4f0a85869
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/out_routines.h
@@ -0,0 +1,50 @@
+/* out_routines.h: Low-level routines for outputting OPL and OVP files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+extern string extensible_pieces[];
+extern string ligature_commands[];
+
+extern void out_character_measure(unsigned);
+extern void out_extensible_piece(unsigned);
+extern void out_ligature_command(unsigned);
+extern void out_named_parameter(unsigned);
+extern void out_named_mathsy_parameter(unsigned);
+extern void out_named_mathex_parameter(unsigned);
+extern void out_move_direction(unsigned);
+extern void out_glue_order(unsigned);
+extern void out_glue_kind(unsigned);
+extern void out_ln(void);
+extern void out_char(unsigned);
+extern void out_num(unsigned);
+extern void out_int(unsigned,unsigned);
+extern void out_as_fix(fix);
+extern void out_fix(fix);
+extern void out_digits(unsigned);
+extern void out(string);
+extern void right(void);
+extern void left(void);
+extern void print_xerox_face(int);
+extern void out_rule_measure(unsigned);
+extern void out_shrink_stretch(unsigned);
+extern void out_type_direction(unsigned);
+extern void out_accent_kind(unsigned);
diff --git a/Build/source/texk/web2c/omegafonts/param_routines.c b/Build/source/texk/web2c/omegafonts/param_routines.c
new file mode 100644
index 00000000000..959d4019d98
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/param_routines.c
@@ -0,0 +1,154 @@
+/* param_routines.c: Data structures for parameter lists.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "list_routines.h"
+#include "manifests.h"
+#include "header_routines.h"
+#include "param_routines.h"
+#include "print_routines.h"
+#include "out_routines.h"
+#include "error_routines.h"
+#include "out_ofm.h"
+
+#define PARAM_MIN 1
+
+av_list param_list = NULL;
+int param_max = PARAM_MIN-1;
+int param_started = FALSE;
+
+unsigned np=0;
+
+void
+init_parameters(void)
+{
+ if (param_started==TRUE)
+ warning_0("FONTDIMEN previously defined; all old parameters ignored");
+ if (param_list!=NULL) {
+ av_list L1 = param_list, L2;
+ while (L1 != NULL) {
+ L2 = L1->ptr;
+ free(L1);
+ L1 = L2;
+ }
+ }
+ param_list = NULL;
+ param_max = PARAM_MIN-1;
+ np=param_max;
+ param_started = TRUE;
+}
+
+void
+set_param_word(int index, int val)
+{
+ av_list L1, L2;
+
+ if (index < PARAM_MIN) {
+ warning_0("PARAMETER index must be at least 1; ignored");
+ return;
+ }
+ L1 = param_list;
+ if (L1 == NULL) {
+ param_list = av_list1(index, val);
+ param_max = index;
+ np=param_max;
+ } else {
+ L2 = L1->ptr;
+ while ((L2 != NULL) && (lattr(L2) <= index)) {
+ L1 = L2;
+ L2 = L2->ptr;
+ }
+ if (index < lattr(L1)) {
+ param_list = av_list1(index, val);
+ param_list->ptr = L1;
+ } else if (index == lattr(L1)) {
+ warning_1("PARAMETER index (%d) previously defined; "
+ "old value ignored", index);
+ lval(L1) = val;
+ } else {
+ if (L2==NULL) {param_max=index; np=param_max;}
+ L2 = av_list1(index, val);
+ L2->ptr = L1->ptr;
+ L1->ptr = L2;
+ }
+ }
+}
+
+void
+retrieve_parameters(unsigned char *table)
+{
+ int value;
+ unsigned i;
+ unsigned np_prime = np;
+
+ param_list = NULL;
+ for (i=1; i<=np_prime; i++) {
+ value = ((table[4*i] & 0xff) << 24) |
+ ((table[4*i+1] & 0xff) << 16) |
+ ((table[4*i+2] & 0xff) << 8) |
+ (table[4*i+3] & 0xff);
+ if ((i<=7) | (value != 0)) {
+ set_param_word(i, value);
+ }
+ }
+ np = np_prime;
+}
+
+void
+print_parameters(void)
+{
+ av_list L = param_list;
+
+ print_font_dimension();
+ while (L != NULL) {
+ print_parameter(lattr(L), lval(L));
+ L = L->ptr;
+ }
+ right();
+}
+
+
+void
+output_ofm_parameter(void)
+{
+ unsigned i=1, j;
+
+ av_list L = param_list;
+
+ while(L != NULL) {
+ j=lattr(L);
+ while (i<j) {
+ output_ofm_one_parameter(i, 0);
+ i++;
+ }
+ output_ofm_one_parameter(i, lval(L));
+ L = L->ptr; i++;
+ }
+}
+
+void
+output_ofm_one_parameter(unsigned i, fix param)
+{
+ if (i==P_SLANT) out_ofm_4(param);
+ else out_ofm_scaled(param);
+}
diff --git a/Build/source/texk/web2c/omegafonts/param_routines.h b/Build/source/texk/web2c/omegafonts/param_routines.h
new file mode 100644
index 00000000000..a3025d7c7ec
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/param_routines.h
@@ -0,0 +1,30 @@
+/* param_routines.h: Data structures for parameter lists.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+extern void init_parameters(void);
+extern void set_param_word(int, int);
+extern void retrieve_parameters(unsigned char *);
+extern void print_parameters(void);
+extern void output_ofm_parameter(void);
+extern void output_ofm_one_parameter(unsigned, fix);
+
+extern unsigned np;
diff --git a/Build/source/texk/web2c/omegafonts/parse_ofm.c b/Build/source/texk/web2c/omegafonts/parse_ofm.c
new file mode 100644
index 00000000000..9dc839d382d
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/parse_ofm.c
@@ -0,0 +1,594 @@
+/* parse_ofm.h: Checking an existent OFM file
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "list_routines.h"
+#include "header_routines.h"
+#include "manifests.h"
+#include "char_routines.h"
+#include "ligkern_routines.h"
+#include "out_ofm.h"
+#include "extra_routines.h"
+#include "param_routines.h"
+#include "dimen_routines.h"
+#include "error_routines.h"
+#include "print_routines.h"
+#include "out_routines.h"
+#include "font_routines.h"
+#include "parse_ofm.h"
+#include "omfonts.h"
+#include "manifests.h"
+
+unsigned top_char, top_width, top_height, top_depth, top_italic;
+unsigned start_ptr, check_sum_pos, design_size_pos, scheme_pos;
+unsigned seven_bit_flag_pos;
+unsigned random_word_pos, header_length;
+
+unsigned ivalues_start,fvalues_start,mvalues_start,
+ rules_start,glues_start,penalties_start;
+unsigned ivalues_base,fvalues_base,mvalues_base,
+ rules_base,glues_base,penalties_base;
+unsigned char_base,width_base,height_base,depth_base,italic_base;
+unsigned lig_kern_base,kern_base,exten_base,param_base;
+ /* base addresses for the subfiles */
+unsigned char_start;
+unsigned bytes_per_entry;
+
+unsigned lf;
+boolean ofm_on;
+unsigned start_pos;
+unsigned family_pos;
+unsigned ofm_ptr;
+unsigned ncw;
+unsigned ncl;
+unsigned nce;
+unsigned nco;
+unsigned npc;
+
+void
+eval_two_bytes(unsigned *pos) {
+ if (ofm[ofm_ptr]>127)
+ fatal_error_0("One of the subfile sizes (2) is negative");
+ *pos = ofm[ofm_ptr]*0x100 + ofm[ofm_ptr+1];
+ ofm_ptr += 2;
+}
+
+void
+eval_four_bytes(unsigned *pos) {
+ if (ofm[ofm_ptr]>127)
+ fatal_error_0("One of the subfile sizes (4) is negative");
+ *pos = ofm[ofm_ptr]*0x1000000 + ofm[ofm_ptr+1]*0x10000 +
+ ofm[ofm_ptr+2]*0x100 + ofm[ofm_ptr+3];
+ ofm_ptr += 4;
+}
+
+void
+parse_ofm(boolean read_ovf)
+{
+ ofm_organize();
+ if (read_ovf == TRUE) input_ovf_file();
+ ofm_read_simple();
+ if (read_ovf == TRUE) input_ovf_fonts();
+ ofm_read_rest();
+ if (read_ovf == TRUE) input_ovf_chars();
+ print_characters(read_ovf);
+}
+
+/* parse_ofm ensures that all of the header entries are consistent.
+ The file is assumed to have been read in already, with the
+ contents in the ofm array (length_ofm bytes).
+*/
+
+void
+ofm_organize(void)
+{
+ unsigned char_ptr,copies,i,j;
+
+ ofm_on = false; ofm_level = OFM_NOLEVEL; lf = 0; lh = 0;
+ nco = 0; ncw = 0; npc = 0;
+ bc = 0; ec = 0; nw = 0; nh = 0; nd = 0; ni = 0;
+ nl = 0; nk = 0; ne = 0; np = 0;
+ nki = 0; nwi = 0; nkf = 0; nwf = 0;
+ nkm = 0; nwm = 0;
+ nkr = 0; nwr = 0; nkg = 0; nwg = 0;
+ nkp = 0; nwp = 0; font_dir = 0;
+
+ if (length_ofm < 8)
+ fatal_error_0("File too short");
+ lf = ofm[0]*256 + ofm[1];
+ if (lf==0) { /* This is not a TFM file, it is an OFM-file */
+ ofm_on = TRUE;
+
+ /* next line edited by Thomas Esser, based on a patch send
+ * by Hossein Movahhedian. The old code had " + 1"
+ * instead of "+ 2" and caused lots of segfaults */
+ ofm_level = ofm[2]*0x100 + ofm[3] + 2;
+ if (ofm[4]>127)
+ fatal_error_0("File length is negative");
+ lf = ofm[4]*0x1000000 + ofm[5]*0x10000 + ofm[6]*0x100 + ofm[7];
+ } else {
+ ofm_on = FALSE;
+ ofm_level = OFM_TFM;
+ }
+ if ((lf*4)!=length_ofm)
+ fatal_error_2("Stated (%d) and actual (%d) file length do not match",
+ lf*4, length_ofm);
+
+ switch(ofm_level) {
+ case OFM_TFM: { start_pos = 2; check_sum_pos = 24; break; }
+ case OFM_LEVEL0: { start_pos = 8; check_sum_pos = 56; break; }
+ case OFM_LEVEL1: { start_pos = 8; check_sum_pos = 116; break; }
+ default: { fatal_error_1("OFMLEVEL %d not supported", ofm_level-1);
+ break; }
+ }
+ design_size_pos = check_sum_pos+4;
+ scheme_pos = design_size_pos+4;
+ family_pos = scheme_pos+40;
+ random_word_pos = family_pos+20;
+
+ ofm_ptr = start_pos;
+
+ if (ofm_on==FALSE) {
+ eval_two_bytes(&lh);
+ eval_two_bytes(&bc);
+ eval_two_bytes(&ec);
+ eval_two_bytes(&nw);
+ eval_two_bytes(&nh);
+ eval_two_bytes(&nd);
+ eval_two_bytes(&ni);
+ eval_two_bytes(&nl);
+ eval_two_bytes(&nk);
+ eval_two_bytes(&ne);
+ eval_two_bytes(&np);
+ ncw = (ec-bc+1);
+ ncl = nl;
+ nce = ne;
+ header_length = 6;
+ top_char = 255;
+ top_width = 255;
+ top_height = 15;
+ top_depth = 15;
+ top_italic = 63;
+ } else {
+ eval_four_bytes(&lh);
+ eval_four_bytes(&bc);
+ eval_four_bytes(&ec);
+ eval_four_bytes(&nw);
+ eval_four_bytes(&nh);
+ eval_four_bytes(&nd);
+ eval_four_bytes(&ni);
+ eval_four_bytes(&nl);
+ eval_four_bytes(&nk);
+ eval_four_bytes(&ne);
+ eval_four_bytes(&np);
+ eval_four_bytes(&font_dir);
+ top_char = 65535;
+ top_width = 65535;
+ top_height = 255;
+ top_depth = 255;
+ top_italic = 255;
+ ncl = nl*2;
+ nce = ne*2;
+ if (ofm_level==OFM_LEVEL0) {
+ header_length = 14;
+ ncw = 2*(ec-bc+1);
+ } else {
+ header_length = 29;
+ eval_four_bytes(&nco);
+ eval_four_bytes(&ncw);
+ eval_four_bytes(&npc);
+ eval_four_bytes(&nki); /* Kinds of font ivalues */
+ eval_four_bytes(&nwi); /* Words of font ivalues */
+ eval_four_bytes(&nkf); /* Kinds of font fvalues */
+ eval_four_bytes(&nwf); /* Words of font fvalues */
+ eval_four_bytes(&nkm); /* Kinds of font mvalues */
+ eval_four_bytes(&nwm); /* Words of font mvalues */
+ eval_four_bytes(&nkr); /* Kinds of font rules */
+ eval_four_bytes(&nwr); /* Words of font rules */
+ eval_four_bytes(&nkg); /* Kinds of font glues */
+ eval_four_bytes(&nwg); /* Words of font glues */
+ eval_four_bytes(&nkp); /* Kinds of font penalties */
+ eval_four_bytes(&nwp); /* Words of font penalties */
+ }
+ }
+ if (lf != (header_length+lh+ncw+nw+nh+nd+ni+ncl+nk+nce+np+
+ nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp))
+ fatal_error_0("Subfile sizes do not add up to the stated total");
+ if (lh < 2)
+ fatal_error_1("The header length is only %d", lh);
+ if ((bc > (ec+1)) || (ec > top_char))
+ fatal_error_2("The character code range %d .. %d is illegal", bc, ec);
+ if ((nw==0) || (nh==0) || (nd==0) || (ni==0))
+ fatal_error_0("Incomplete subfiles for character dimensions");
+ ivalues_start = header_length+lh;
+ fvalues_start = ivalues_start+nki;
+ mvalues_start = fvalues_start+nkf;
+ rules_start = mvalues_start+nkm;
+ glues_start = rules_start+nkr;
+ penalties_start = glues_start+nkg;
+ ivalues_base = penalties_start+nkp;
+ fvalues_base = ivalues_base+nwi;
+ mvalues_base = fvalues_base+nwf;
+ rules_base = mvalues_base+nwm;
+ glues_base = rules_base+nwr;
+ penalties_base = glues_base+nwg;
+ char_base = penalties_base+nwp;
+ bytes_per_entry = (12 + 2*npc) / 4 * 4;
+ init_planes();
+ no_labels = 0;
+ switch (ofm_level) {
+ case OFM_TFM: {
+ for(i=bc; i<=ec; i++) {
+ init_character(i,NULL);
+ char_start = 4*char_base+4*(i-bc);
+ current_character->index_indices[C_WD] =
+ ofm[char_start] & 0xff;
+ current_character->index_indices[C_HT] =
+ (ofm[char_start+1] & 0xf0) >> 4;
+ current_character->index_indices[C_DP] =
+ ofm[char_start+1] & 0xf;
+ current_character->index_indices[C_IC] =
+ (ofm[char_start+2] & 0xfc) >> 2;
+ current_character->tag =
+ ofm[char_start+2] & 0x3;
+ if (current_character->tag == TAG_LIG) no_labels++;
+ current_character->remainder =
+ ofm[char_start+3] & 0xff;
+ }
+ break;
+ }
+ case OFM_LEVEL0: {
+ for(i=bc; i<=ec; i++) {
+ init_character(i,NULL);
+ char_start = 4*char_base+8*(i-bc);
+ current_character->index_indices[C_WD] =
+ ((ofm[char_start] & 0xff) << 8) |
+ (ofm[char_start+1] & 0xff);
+ current_character->index_indices[C_HT] =
+ ofm[char_start+2] & 0xff;
+ current_character->index_indices[C_DP] =
+ ofm[char_start+3] & 0xff;
+ current_character->index_indices[C_IC] =
+ ofm[char_start+4] & 0xff;
+ current_character->tag =
+ ofm[char_start+5] & 0x3;
+ if (current_character->tag == TAG_LIG) no_labels++;
+ current_character->remainder =
+ ((ofm[char_start+6] & 0xff) << 8) |
+ (ofm[char_start+7] & 0xff);
+ }
+ break;
+ }
+ case OFM_LEVEL1: {
+ char_ptr = 4*char_base;
+ i = bc;
+ while (i<=ec) {
+ init_character(i,NULL);
+ copies = 1+256*ofm[char_ptr+8]+ofm[char_ptr+9];
+ for (j=1; j<=copies; j++) {
+ char_start = char_ptr;
+ i++;
+ }
+ char_ptr = char_ptr + bytes_per_entry;
+ }
+ if (char_ptr != (4*(char_base+ncw)))
+ fatal_error_0("Length of char info table does not "
+ "correspond to specification");
+ break;
+ }
+ default: {
+ fatal_error_1("Inappropriate font level (%d)", ofm_level-1);
+ }
+ }
+ width_base = char_base+ncw;
+ height_base = width_base+nw;
+ depth_base = height_base+nh;
+ italic_base = depth_base+nd;
+ lig_kern_base = italic_base+ni;
+ if (ofm_level==OFM_TFM) {
+ kern_base = lig_kern_base+nl;
+ } else {
+ kern_base = lig_kern_base+2*nl;
+ }
+ exten_base = kern_base+nk;
+ if (ofm_level==OFM_TFM) {
+ param_base = exten_base+ne-1;
+ } else {
+ param_base = exten_base+2*ne-1;
+ }
+}
+
+void
+ofm_read_simple(void)
+{
+
+ if (ofm_on==TRUE) {
+ print_ofm_level(ofm_level-1);
+ print_font_dir(font_dir);
+ }
+ header = (char *) ofm+check_sum_pos;
+ retrieve_header();
+ print_family();
+ print_face();
+ print_coding_scheme();
+ print_design_size();
+ out("(COMMENT DESIGNSIZE IS IN POINTS)"); out_ln();
+ out("(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)"); out_ln();
+ print_check_sum();
+ if ((seven_bit == TRUE) || (ofm_level != OFM_TFM))
+ print_seven_bit_safe_flag();
+ retrieve_parameters(ofm+(4*param_base));
+ print_parameters();
+}
+
+void
+ofm_read_rest(void)
+{
+ retrieve_dimen_tables();
+ if (verbose_option==TRUE) print_dimen_tables();
+ retrieve_ligkern_table(ofm+(4*lig_kern_base), ofm+(4*kern_base));
+ adjust_labels(FALSE);
+ if (verbose_option==TRUE) print_labels();
+ print_ligkern_table();
+ retrieve_exten_table(ofm+(4*exten_base));
+ if (verbose_option==TRUE) print_extens();
+}
+
+/*
+@ Once the input data successfully passes these basic checks,
+\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion
+to \.{PL} format will take place. Access to the various subfiles
+is facilitated by computing the following base addresses. For example,
+the |char_info| for character |c| in a \.{TFM} file will start in location
+|4*(char_base+c)| of the |tfm| array.
+
+@<Globals...@>=
+
+@ Of course we want to define macros that suppress the detail of how the
+font information is actually encoded. Each word will be referred to by
+the |tfm| index of its first byte. For example, if |c| is a character
+code between |bc| and |ec|, then |tfm[char_info(c)]| will be the
+first byte of its |char_info|, i.e., the |width_index|; furthermore
+|width(c)| will point to the |fix_word| for |c|'s width.
+*/
+
+#if 0
+#define char_info(c) char_start[c]
+#define nonexistent(c) ((c<bc)or(c>ec)or(width_index(c)=0))
+#define width(c) 4*(width_base+width_index(c))
+#define height(c) 4*(height_base+height_index(c))
+#define depth(c) 4*(depth_base+depth_index(c))
+#define italic(c) 4*(italic_base+italic_index(c))
+#define kern(i) 4*(kern_base+i) /* i is an index, not a char */
+#define param(i) 4*(param_base+i) /* likewise */
+#endif
+
+/*
+unsigned
+width_index(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[char_info(c)];
+else
+ return 256*ofm[char_info(c)]+ofm[char_info(c)+1];
+}
+
+unsigned
+height_index(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[char_info(c)+1] / 16;
+else
+ return ofm[char_info(c)+2];
+}
+
+unsigned
+depth_index(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[char_info(c)+1] % 16;
+else
+ return ofm[char_info(c)+3];
+}
+
+unsigned
+italic_index(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[char_info(c)+2] / 4;
+else if (ofm_level == OFM_TFM)
+ return ofm[char_info(c)+4]*64 + ofm[char_info(c)+5] / 4;
+else
+ return ofm[char_info(c)+4];
+}
+
+unsigned
+tag(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[char_info(c)+2] % 4;
+else
+ return ofm[char_info(c)+5] % 4;
+}
+
+void
+set_no_tag(unsigned c)
+{
+if (ofm_on==FALSE)
+ ofm[char_info(c)+2] = (ofm[char_info(c)+2] / 64)*64 + TAG_NONE;
+else
+ ofm[char_info(c)+5] = (ofm[char_info(c)+5] / 64)*64 + TAG_NONE;
+}
+
+boolean
+ctag(unsigned c)
+{
+if (ofm_level != OFM_LEVEL1)
+ return FALSE;
+else
+ return ofm[char_info(c)+5] / 4 % 2;
+}
+
+void
+set_no_ctag(unsigned c)
+{
+if (ofm_level != OFM_LEVEL1)
+ ofm[char_info(c)+5] =
+ ofm[char_info(c)+5] / 8 * 8 + ofm[char_info(c)+5] % 4;
+}
+
+unsigned
+no_repeats(unsigned c)
+{
+if (ofm_level == OFM_NOLEVEL)
+ return 0;
+else
+ return 256*ofm[char_info(c)+8]+ofm[char_info(c)+9];
+}
+
+unsigned
+char_param(unsigned c, unsigned i)
+{
+ return 256*ofm[char_info(c)+2*i+10]+ofm[char_info(c)+2*i+11];
+}
+
+unsigned
+rremainder(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[char_info(c)+3];
+else
+ return 256*ofm[char_info(c)+6]+ofm[char_info(c)+7];
+}
+
+unsigned
+lig_step(unsigned c)
+{
+if (ofm_on==FALSE)
+ return 4*(lig_kern_base+c);
+else
+ return 4*(lig_kern_base+2*c);
+}
+
+unsigned
+exten(unsigned c)
+{
+if (ofm_on==FALSE)
+ return 4*(exten_base+rremainder(c));
+else
+ return 4*(exten_base+2*rremainder(c));
+}
+
+unsigned
+l_skip_byte(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[c];
+else
+ return 256*ofm[c]+ofm[c+1];
+}
+
+void
+set_l_skip_byte(unsigned c, unsigned newc)
+{
+if (ofm_on==FALSE)
+ ofm[c] = newc;
+else {
+ ofm[c] = newc / 256;
+ ofm[c+1] = newc % 256;
+}
+}
+
+unsigned
+l_next_char(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[c+1];
+else
+ return 256*ofm[c+2]+ofm[c+3];
+}
+
+void
+set_l_next_char(unsigned c, unsigned newc)
+{
+if (ofm_on==FALSE)
+ ofm[c+1] = newc;
+else {
+ ofm[c+2] = newc / 256;
+ ofm[c+3] = newc % 256;
+}
+}
+
+unsigned
+l_op_byte(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[c+2];
+else
+ return 256*ofm[c+4]+ofm[c+5];
+}
+
+void
+set_l_op_byte(unsigned c, unsigned newc)
+{
+if (ofm_on==FALSE)
+ ofm[c+2] = newc;
+else {
+ ofm[c+2] = newc / 256;
+ ofm[c+3] = newc % 256;
+}
+}
+
+unsigned
+l_remainder(unsigned c)
+{
+if (ofm_on==FALSE)
+ return ofm[c+3];
+else
+ return 256*ofm[c+6]+ofm[c+7];
+}
+
+void
+set_l_remainder(unsigned c, unsigned newc)
+{
+if (ofm_on==FALSE)
+ ofm[c+3] = newc;
+else {
+ ofm[c+6] = newc / 256;
+ ofm[c+7] = newc % 256;
+}
+}
+
+unsigned
+ofm_get_4(unsigned c)
+{
+ return (ofm[c]<<24) | (ofm[c+1]<<16) | (ofm[c+2]<<8) | ofm[c+3];
+}
+
+unsigned
+ofm_get_1(unsigned c)
+{
+ return ofm[c];
+}
+
+*/
diff --git a/Build/source/texk/web2c/omegafonts/parse_ofm.h b/Build/source/texk/web2c/omegafonts/parse_ofm.h
new file mode 100644
index 00000000000..de4d275cc33
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/parse_ofm.h
@@ -0,0 +1,58 @@
+/* parse_ofm.h: Checking an existent OFM file
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+extern unsigned char_base,width_base,height_base,depth_base,italic_base;
+extern unsigned npc,nco,ncw,lf;
+
+extern void parse_ofm(boolean);
+extern void ofm_organize(void);
+extern void ofm_read_simple(void);
+extern void ofm_read_rest(void);
+
+extern void eval_two_bytes(unsigned *);
+extern void eval_four_bytes(unsigned *);
+
+extern unsigned width_index(unsigned);
+extern unsigned height_index(unsigned);
+extern unsigned depth_index(unsigned);
+extern unsigned italic_index(unsigned);
+extern unsigned tag(unsigned);
+extern void set_no_tag(unsigned);
+extern boolean ctag(unsigned);
+extern void set_no_ctag(unsigned);
+extern unsigned no_repeats(unsigned);
+extern unsigned char_param(unsigned, unsigned);
+extern unsigned rremainder(unsigned);
+extern unsigned lig_step(unsigned);
+extern unsigned exten(unsigned);
+extern unsigned l_skip_byte(unsigned);
+extern void set_l_skip_byte(unsigned, unsigned);
+extern unsigned l_next_char(unsigned);
+extern void set_l_next_char(unsigned, unsigned);
+extern unsigned l_op_byte(unsigned);
+extern void set_l_op_byte(unsigned, unsigned);
+extern unsigned l_remainder(unsigned);
+extern void set_l_remainder(unsigned, unsigned);
+
+extern unsigned ofm_get_4(unsigned);
+extern unsigned ofm_get_1(unsigned);
diff --git a/Build/source/texk/web2c/omegafonts/parser.h b/Build/source/texk/web2c/omegafonts/parser.h
new file mode 100644
index 00000000000..c5ff2cae708
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/parser.h
@@ -0,0 +1,35 @@
+/* parser.h: Definitions for the property lists parser.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define YYSTYPE yystype
+typedef union {
+ unsigned yint;
+ int yfix;
+ char *ystring ;
+} yystype;
+
+extern YYSTYPE yylval;
+extern int line_number;
+extern FILE *yyin;
+extern int yylex(void);
+extern int yyparse(void);
diff --git a/Build/source/texk/web2c/omegafonts/pl.l b/Build/source/texk/web2c/omegafonts/pl.l
new file mode 100644
index 00000000000..beed1ace77f
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/pl.l
@@ -0,0 +1,482 @@
+%{
+/* pl.l: Lexical analysis of property list files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+Copyright (c) 2002 Roozbeh Pournader
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include <string.h>
+#ifdef WIN32
+#include <win32lib.h>
+#endif
+#include "parser.h"
+#include "kpathsea/types.h"
+#include "y_tab.h"
+#include "manifests.h"
+#include "error_routines.h"
+#ifdef __cplusplus
+#define yyinput input
+#endif
+
+int line_number = 1;
+extern YYSTYPE yylval;
+
+/* POTENTIAL BUG: saved_text could be run over; should check */
+#define MAX_PTR 10000
+char saved_text[MAX_PTR];
+
+extern void scan_int(unsigned);
+extern void scan_char(void);
+extern void scan_fix(void);
+extern void scan_string(char *, unsigned, unsigned);
+extern void scan_hex_string();
+
+/* from kpathsea, but avoid including kpathsea header files */
+extern char *xstrdup (const char *);
+
+#define KEEP_MIN 0
+#define KEEP_NONE 0
+#define KEEP_ALL 1
+#define KEEP_CONVERT 2
+#define KEEP_MAX 2
+
+#define BASE_MIN 2
+#define BASE_MAX 16
+
+%}
+
+/* For Solaris's lex, to increase tables sizes --RP */
+/* Space before number keeps ancient flex happy. */
+%e 4000
+%p 7000
+%n 1000
+
+ws [ \t]+
+hexnumber H{ws}[A-F0-9]+
+octnumber O{ws}[0-7]+
+decnumber D{ws}[0-9]+
+realnumber R[ \t+-]+[0-9]*("."[0-9]*){0,1}
+charnumber C{ws}.
+hexstring ([A-F0-9][A-F0-9])*
+
+%%
+
+{ws} {}
+\n {line_number++; }
+
+"(" return(LEFT);
+")" return(RIGHT);
+
+{octnumber} {scan_int(8); return(NUMBER); }
+{decnumber} {scan_int(10); return(NUMBER); }
+{hexnumber} {scan_int(16); return(NUMBER); }
+{charnumber} {scan_char(); return(NUMBER); }
+{realnumber} {scan_fix(); return(FIX); }
+
+CODINGSCHEME {scan_string("CODINGSCHEME", KEEP_CONVERT, LEN_CODING_SCHEME);
+ return(CODINGSCHEME); }
+FAMILY {scan_string("FAMILY", KEEP_CONVERT, LEN_FAMILY);
+ return(FAMILY); }
+VTITLE {scan_string("VTITLE", KEEP_ALL, LEN_VTITLE);
+ return(VTITLE); }
+FONTNAME {scan_string("FONTNAME", KEEP_ALL, LEN_FONT_NAME);
+ return(FONTNAME); }
+FONTAREA {scan_string("FONTAREA", KEEP_ALL, LEN_FONT_AREA);
+ return(FONTAREA); }
+SPECIAL {scan_string("SPECIAL", KEEP_ALL, 0);
+ return(SPECIAL); }
+COMMENT {scan_string("COMMENT", KEEP_NONE, 0);
+ return(COMMENT); }
+
+SPECIALHEX{ws}{hexstring} {scan_hex_string(); return(SPECIALHEX); }
+
+
+SEVENBITSAFEFLAG{ws}TRUE {yylval.yint=1; return(SEVENBITSAFEFLAG); }
+SEVENBITSAFEFLAG{ws}FALSE {yylval.yint=0; return(SEVENBITSAFEFLAG); }
+
+CHECKSUM return(CHECKSUM);
+DESIGNSIZE return(DESIGNSIZE);
+DESIGNUNITS return(DESIGNUNITS);
+FACE return(FACE);
+HEADER return(HEADER);
+BOUNDARYCHAR return(BOUNDARYCHAR);
+FONTDIMEN return(FONTDIMEN);
+LIGTABLE return(LIGTABLE);
+CHARACTER return(CHARACTER);
+
+PARAMETER return(PARAMETER);
+LABEL return(LABEL);
+KRN return(KRN);
+STOP return(STOP);
+SKIP return(SKIP);
+NEXTLARGER return(NEXTLARGER);
+VARCHAR return(VARCHAR);
+
+CHARWD {yylval.yint = C_WD; return(CHARMEASURE); }
+CHARHT {yylval.yint = C_HT; return(CHARMEASURE); }
+CHARDP {yylval.yint = C_DP; return(CHARMEASURE); }
+CHARIC {yylval.yint = C_IC; return(CHARMEASURE); }
+
+TOP {yylval.yint = E_TOP; return(EXTEN); }
+MID {yylval.yint = E_MID; return(EXTEN); }
+BOT {yylval.yint = E_BOT; return(EXTEN); }
+REP {yylval.yint = E_REP; return(EXTEN); }
+
+LIG {yylval.yint = L_0; return(LIG); }
+"LIG/" {yylval.yint = L_B; return(LIG); }
+"/LIG" {yylval.yint = L_A; return(LIG); }
+"/LIG/" {yylval.yint = L_AB; return(LIG); }
+"LIG/>" {yylval.yint = L_Bx; return(LIG); }
+"/LIG>" {yylval.yint = L_Ax; return(LIG); }
+"/LIG/>" {yylval.yint = L_ABx; return(LIG); }
+"/LIG/>>" {yylval.yint = L_ABxx; return(LIG); }
+
+F{ws}MRR {yylval.yint = F_MRR; return(NUMBER); }
+F{ws}MIR {yylval.yint = F_MIR; return(NUMBER); }
+F{ws}BRR {yylval.yint = F_BRR; return(NUMBER); }
+F{ws}BIR {yylval.yint = F_BIR; return(NUMBER); }
+F{ws}LRR {yylval.yint = F_LRR; return(NUMBER); }
+F{ws}LIR {yylval.yint = F_LIR; return(NUMBER); }
+F{ws}MRC {yylval.yint = F_MRC; return(NUMBER); }
+F{ws}MIC {yylval.yint = F_MIC; return(NUMBER); }
+F{ws}BRC {yylval.yint = F_BRC; return(NUMBER); }
+F{ws}BIC {yylval.yint = F_BIC; return(NUMBER); }
+F{ws}LRC {yylval.yint = F_LRC; return(NUMBER); }
+F{ws}LIC {yylval.yint = F_LIC; return(NUMBER); }
+F{ws}MRE {yylval.yint = F_MRE; return(NUMBER); }
+F{ws}MIE {yylval.yint = F_MIE; return(NUMBER); }
+F{ws}BRE {yylval.yint = F_BRE; return(NUMBER); }
+F{ws}BIE {yylval.yint = F_BIE; return(NUMBER); }
+F{ws}LRE {yylval.yint = F_LRE; return(NUMBER); }
+F{ws}LIE {yylval.yint = F_LIE; return(NUMBER); }
+
+SLANT {yylval.yint = P_SLANT; return(NAMEDPARAMETER); }
+SPACE {yylval.yint = P_SPACE; return(NAMEDPARAMETER); }
+STRETCH {yylval.yint = P_STRETCH; return(NAMEDPARAMETER); }
+SHRINK {yylval.yint = P_SHRINK; return(NAMEDPARAMETER); }
+XHEIGHT {yylval.yint = P_XHEIGHT; return(NAMEDPARAMETER); }
+QUAD {yylval.yint = P_QUAD; return(NAMEDPARAMETER); }
+EXTRASPACE {yylval.yint = P_EXTRASPACE; return(NAMEDPARAMETER); }
+NUM1 {yylval.yint = P_NUM1; return(NAMEDPARAMETER); }
+NUM2 {yylval.yint = P_NUM2; return(NAMEDPARAMETER); }
+NUM3 {yylval.yint = P_NUM3; return(NAMEDPARAMETER); }
+DENOM1 {yylval.yint = P_DENOM1; return(NAMEDPARAMETER); }
+DENOM2 {yylval.yint = P_DENOM2; return(NAMEDPARAMETER); }
+SUP1 {yylval.yint = P_SUP1; return(NAMEDPARAMETER); }
+SUP2 {yylval.yint = P_SUP2; return(NAMEDPARAMETER); }
+SUP3 {yylval.yint = P_SUP3; return(NAMEDPARAMETER); }
+SUB1 {yylval.yint = P_SUB1; return(NAMEDPARAMETER); }
+SUB2 {yylval.yint = P_SUB2; return(NAMEDPARAMETER); }
+SUPDROP {yylval.yint = P_SUPDROP; return(NAMEDPARAMETER); }
+SUBDROP {yylval.yint = P_SUBDROP; return(NAMEDPARAMETER); }
+DELIM1 {yylval.yint = P_DELIM1; return(NAMEDPARAMETER); }
+DELIM2 {yylval.yint = P_DELIM2; return(NAMEDPARAMETER); }
+AXISHEIGHT {yylval.yint = P_AXISHEIGHT; return(NAMEDPARAMETER); }
+
+DEFAULTRULETHICKNESS {yylval.yint = P_DEFAULTRULETHICKNESS;
+ return(NAMEDPARAMETER); }
+BIGOPSPACING1 {yylval.yint = P_BIGOPSPACING1; return(NAMEDPARAMETER); }
+BIGOPSPACING2 {yylval.yint = P_BIGOPSPACING2; return(NAMEDPARAMETER); }
+BIGOPSPACING3 {yylval.yint = P_BIGOPSPACING3; return(NAMEDPARAMETER); }
+BIGOPSPACING4 {yylval.yint = P_BIGOPSPACING4; return(NAMEDPARAMETER); }
+BIGOPSPACING5 {yylval.yint = P_BIGOPSPACING5; return(NAMEDPARAMETER); }
+
+MAPFONT {return(MAPFONT); }
+FONTCHECKSUM {return(FONTCHECKSUM); }
+FONTAT {return(FONTAT); }
+FONTDSIZE {return(FONTDSIZE); }
+MAP {return(MAP); }
+SELECTFONT {return(SELECTFONT); }
+SETCHAR {return(SETCHAR); }
+SETRULE {return(SETRULE); }
+PUSH {return(PUSH); }
+POP {return(POP); }
+
+MOVERIGHT {yylval.yint = M_RIGHT; return(MOVE); }
+MOVELEFT {yylval.yint = M_LEFT; return(MOVE); }
+MOVEUP {yylval.yint = M_UP; return(MOVE); }
+MOVEDOWN {yylval.yint = M_DOWN; return(MOVE); }
+
+OFMLEVEL return(OFMLEVEL);
+TOPACCENT {yylval.yint = ACC_TOP; return(ACCENT); }
+MIDACCENT {yylval.yint = ACC_MID; return(ACCENT); }
+BOTACCENT {yylval.yint = ACC_BOT; return(ACCENT); }
+
+FONTDIR{ws}TL {yylval.yint = DIR_ORD+DIR_TL; return(FONTDIR);}
+FONTDIR{ws}LT {yylval.yint = DIR_ORD+DIR_LT; return(FONTDIR);}
+FONTDIR{ws}TR {yylval.yint = DIR_ORD+DIR_TR; return(FONTDIR);}
+FONTDIR{ws}LB {yylval.yint = DIR_ORD+DIR_LB; return(FONTDIR);}
+FONTDIR{ws}BL {yylval.yint = DIR_ORD+DIR_BL; return(FONTDIR);}
+FONTDIR{ws}RT {yylval.yint = DIR_ORD+DIR_RT; return(FONTDIR);}
+FONTDIR{ws}BR {yylval.yint = DIR_ORD+DIR_BR; return(FONTDIR);}
+FONTDIR{ws}RB {yylval.yint = DIR_ORD+DIR_RB; return(FONTDIR);}
+NATURALFONTDIR{ws}TL {yylval.yint = DIR_NAT+DIR_TL; return(FONTDIR);}
+NATURALFONTDIR{ws}LT {yylval.yint = DIR_NAT+DIR_LT; return(FONTDIR);}
+NATURALFONTDIR{ws}TR {yylval.yint = DIR_NAT+DIR_TR; return(FONTDIR);}
+NATURALFONTDIR{ws}LB {yylval.yint = DIR_NAT+DIR_LB; return(FONTDIR);}
+NATURALFONTDIR{ws}BL {yylval.yint = DIR_NAT+DIR_BL; return(FONTDIR);}
+NATURALFONTDIR{ws}RT {yylval.yint = DIR_NAT+DIR_RT; return(FONTDIR);}
+NATURALFONTDIR{ws}BR {yylval.yint = DIR_NAT+DIR_BR; return(FONTDIR);}
+NATURALFONTDIR{ws}RB {yylval.yint = DIR_NAT+DIR_RB; return(FONTDIR);}
+
+FONTIVALUE return(FONTIVALUE);
+FONTFVALUE return(FONTFVALUE);
+FONTMVALUE return(FONTMVALUE);
+FONTPENALTY return(FONTPENALTY);
+FONTRULE return(FONTRULE);
+FONTGLUE return(FONTGLUE);
+
+IVALUE return(IVALUE);
+FVALUE return(FVALUE);
+MVALUE return(MVALUE);
+PENALTY return(PENALTY);
+RULE return(RULE);
+GLUE return(GLUE);
+
+IVALUEVAL return(IVALUEVAL);
+FVALUEVAL return(FVALUEVAL);
+MVALUEVAL return(MVALUEVAL);
+PENALTYVAL return(PENALTYVAL);
+
+RULEWD { yylval.yint = RULE_WD; return(RULEMEASURE); }
+RULEHT { yylval.yint = RULE_HT; return(RULEMEASURE); }
+RULEDP { yylval.yint = RULE_DP; return(RULEMEASURE); }
+
+GLUEWD return(GLUEWD);
+GLUESTRETCH { yylval.yint = GLUE_STRETCH; return(GLUESHRINKSTRETCH); }
+GLUESHRINK { yylval.yint = GLUE_SHRINK; return(GLUESHRINKSTRETCH); }
+
+GLUETYPE return(GLUETYPE);
+GLUERULE return(GLUERULE);
+GLUECHAR return(GLUECHAR);
+
+CHARIVALUE return(CHARIVALUE);
+CHARFVALUE return(CHARFVALUE);
+CHARMVALUE return(CHARMVALUE);
+CHARPENALTY return(CHARPENALTY);
+CHARRULE return(CHARRULE);
+CHARGLUE return(CHARGLUE);
+
+CKRN return(CKRN);
+CGLUE return(CGLUE);
+CPENALTY return(CPENALTY);
+CPENGLUE return(CPENGLUE);
+CLABEL return(CLABEL);
+
+CHARREPEAT return(CHARREPEAT);
+
+
+FILLL {yylval.yint = O_FILLL; return(GLUEORDER); }
+FILL {yylval.yint = O_FILL; return(GLUEORDER); }
+FIL {yylval.yint = O_FIL; return(GLUEORDER); }
+FI {yylval.yint = O_FI; return(GLUEORDER); }
+UNIT {yylval.yint = O_UNIT; return(GLUEORDER); }
+
+NORMAL {yylval.yint = K_NORMAL; return(GLUEKIND); }
+ALEADERS {yylval.yint = K_ALEADERS; return(GLUEKIND); }
+CLEADERS {yylval.yint = K_CLEADERS; return(GLUEKIND); }
+XLEADERS {yylval.yint = K_XLEADERS; return(GLUEKIND); }
+
+SECWD {yylval.yint = C_SECWD; return(CHARMEASURE); }
+SECHT {yylval.yint = C_SECHT; return(CHARMEASURE); }
+SECDP {yylval.yint = C_SECDP; return(CHARMEASURE); }
+SECIC {yylval.yint = C_SECIC; return(CHARMEASURE); }
+
+PRIMTOPAXIS {yylval.yint = C_P_TOPAXIS; return(CHARMEASURE); }
+PRIMTOPAXISBIS {yylval.yint = C_P_TOPAXISBIs; return(CHARMEASURE); }
+PRIMBOTAXIS {yylval.yint = C_P_BOTAXIS; return(CHARMEASURE); }
+PRIMBOTAXISBIS {yylval.yint = C_P_BOTAXISBIS; return(CHARMEASURE); }
+PRIMMIDHOR {yylval.yint = C_P_MIDHOR; return(CHARMEASURE); }
+PRIMMIDVERT {yylval.yint = C_P_MIDVERT; return(CHARMEASURE); }
+PRIMBASESLANT {yylval.yint = C_P_BASESLANT; return(CHARMEASURE); }
+
+SECTOPAXIS {yylval.yint = C_S_TOPAXIS; return(CHARMEASURE); }
+SECTOPAXISBIS {yylval.yint = C_S_TOPAXISBIs; return(CHARMEASURE); }
+SECBOTAXIS {yylval.yint = C_S_BOTAXIS; return(CHARMEASURE); }
+SECBOTAXISBIS {yylval.yint = C_S_BOTAXISBIS; return(CHARMEASURE); }
+SECMIDHOR {yylval.yint = C_S_MIDHOR; return(CHARMEASURE); }
+SECMIDVERT {yylval.yint = C_S_MIDVERT; return(CHARMEASURE); }
+SECBASESLANT {yylval.yint = C_S_BASESLANT; return(CHARMEASURE); }
+
+. {lex_error_1("unexpected character (%x); ignored",
+ yytext[0]);}
+%%
+
+/* added by Thomas Esser, suggested by Olaf Weber */
+#ifdef yywrap
+#undef yywrap
+#endif
+
+int
+yywrap (void)
+{ return 1; }
+
+void
+scan_int(unsigned base)
+{
+ register unsigned j, q = 0x10000 / base, c0=0, c1=0, i=1;
+
+ if ((base<BASE_MIN) || (base>BASE_MAX))
+ internal_error_1("scan_int (base=%d)", base);
+ while ((yytext[i]==' ') || (yytext[i]=='\t')) {
+ yytext[i] = ' ';
+ i++;
+ }
+ for (; i<yyleng; i++) {
+ j = yytext[i];
+ if (j>='A') j = j + '0' + 10 - 'A' ;
+ c0 = base*c0 + (c1 / q);
+ c1 = base*(c1 % q) + j - '0';
+ if (c0 > 0xffff) {
+ lex_error_s("numeric value (%s) too large; set to 0", yytext);
+ c0=0; c1=0; break;
+ }
+ }
+ yylval.yint = c0 * 0x10000 + c1;
+}
+
+void
+scan_fix(void)
+{
+ unsigned i=1;
+ unsigned sign = 1;
+ unsigned j=0;
+ unsigned acc=0;
+ unsigned int_part;
+ unsigned fraction_digits[7];
+
+ while ((yytext[i]==' ') || (yytext[i]=='\t') ||
+ (yytext[i]=='+') || (yytext[i]=='-')) {
+ if (yytext[i]=='\t') yytext[i] = ' ';
+ if (yytext[i]=='-') sign *= -1;
+ i++;
+ }
+ acc=0;
+ while ((i<yyleng) && (yytext[i]!='.')) {
+ acc = acc*10 + yytext[i]-'0';
+ i++;
+ if (acc >=0x800 ) {
+ lex_error_s("fix value (%s) too large; set to 0", yytext);
+ yylval.yfix = 0;
+ return;
+ }
+ }
+ int_part = acc; acc = 0;
+ if (i < yyleng) {
+ i++;
+ while ((i<yyleng) && j<7) {
+ fraction_digits[j] = 0x200000*(yytext[i]-'0');
+ i++; j++;
+ }
+ while (j>0) {acc = fraction_digits[--j] + acc / 10;}
+ acc = (acc + 10) / 20;
+ }
+ if ((acc > UNITY) && (int_part=2047)) {
+ lex_error_s("fix value (%s) too large; set to 0", yytext);
+ yylval.yfix = 0;
+ return;
+ }
+ yylval.yfix = sign * (int_part*UNITY + acc);
+}
+
+void
+scan_char(void)
+{
+ register unsigned i=1;
+
+ while ((yytext[i]==' ') || (yytext[i]=='\t')) i++;
+ if ((yytext[i]<041) || (yytext[i]>0176) ||
+ (yytext[i]=='(') || (yytext[i]==')')) {
+ lex_error_1("C value (H %X) must be ASCII (not paren); "
+ "set to 'A'", yytext[i]);
+ yylval.yint = 'A';
+ } else yylval.yint = yytext[i];
+}
+
+void
+scan_string(char *attribute, unsigned keep, unsigned length)
+{
+ register unsigned c, saved_ptr = 0, paren_level = 0;
+ unsigned error_msg = FALSE;
+
+ if ((keep<KEEP_MIN) || (keep>KEEP_MAX))
+ internal_error_1("scan_string (keep=%d)", keep);
+ while (((c = input()) != EOF) &&
+ ((c == ' ') || (c == '\t') || (c == '\n'))) {
+ if (c == '\n') {line_number++;}
+ }
+ if (c==EOF) fatal_error_s("EOF while scanning %s", attribute);
+ while ((c != EOF) &&
+ ((c != ')') || (paren_level>0))) {
+ if (c==')') {
+ paren_level--;
+ if (keep==KEEP_CONVERT) {
+ lex_error_s_1("%s character (H %X) converted to slash",
+ attribute, c);
+ c = '/';
+ }
+ } else if (c=='(') {
+ paren_level++;
+ if (keep==KEEP_CONVERT) {
+ lex_error_s_1("%s character (H %X) converted to slash",
+ attribute, c);
+ c = '/';
+ }
+ } else if ((c<' ') || (c>='~')) {
+ if (c=='\n') line_number++;
+ if (keep==KEEP_CONVERT) {
+ lex_error_s_1("%s character (H %X) converted to blank",
+ attribute, c);
+ c = ' ';
+ }
+ }
+ if (saved_ptr<(MAX_PTR-3))
+ saved_text[saved_ptr++] = c;
+ else if (error_msg == FALSE) {
+ lex_error_s_1("%s string longer than %d characters; truncating",
+ attribute, MAX_PTR);
+ error_msg = TRUE;
+ }
+ c = input();
+ }
+ if (c==EOF) fatal_error_s("EOF while scanning %s", attribute);
+ unput(')');
+ saved_text[saved_ptr++] = '\0';
+ if (keep!=KEEP_NONE) {
+ if ((length != 0) && (strlen(saved_text)>length)) {
+ lex_error_s_1("%s string limited to %d characters; truncated",
+ attribute, length);
+ saved_text[length] = '\0';
+ }
+ yylval.ystring = xstrdup(saved_text);
+ } else {
+ yylval.ystring = NULL;
+ }
+}
+
+void
+scan_hex_string(void)
+{
+ register unsigned i=10;
+
+ while ((yytext[i]==' ') || (yytext[i]=='\t')) i++;
+ yylval.ystring = xstrdup(yytext+i);
+}
diff --git a/Build/source/texk/web2c/omegafonts/pl.y b/Build/source/texk/web2c/omegafonts/pl.y
new file mode 100644
index 00000000000..2833db377cd
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/pl.y
@@ -0,0 +1,544 @@
+%{
+/* pl.y: Grammar for reading property list files
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "parser.h"
+#include "manifests.h"
+#include "list_routines.h"
+#include "error_routines.h"
+#include "out_routines.h"
+#include "char_routines.h"
+#include "header_routines.h"
+#include "param_routines.h"
+#include "dimen_routines.h"
+#include "ligkern_routines.h"
+#include "print_routines.h"
+#include "font_routines.h"
+#include "extra_routines.h"
+
+%}
+
+/* Basic tokens */
+
+%token LEFT
+%token RIGHT
+%token NUMBER
+%token FIX
+%token COMMENT
+
+/* Tokens found in PL, OPL, VF and OVF files */
+
+%token CHECKSUM
+%token DESIGNSIZE
+%token DESIGNUNITS
+%token CODINGSCHEME /* implicit string */
+%token FAMILY /* implicit string */
+%token FACE
+%token SEVENBITSAFEFLAG /* implicit 0 (FALSE) or 1 (TRUE) */
+%token HEADER
+%token FONTDIMEN
+%token LIGTABLE
+%token BOUNDARYCHAR
+%token CHARACTER
+
+%token NAMEDPARAMETER /* implicit integer */
+%token PARAMETER
+
+%token CHARMEASURE /* implicit integer */
+%token NEXTLARGER
+%token VARCHAR
+%token EXTEN /* implicit integer */
+
+%token LABEL
+%token LIG /* implicit integer */
+%token KRN
+%token STOP
+%token SKIP
+
+/* Tokens found only in VF and OVF files */
+
+%token VTITLE
+
+%token MAPFONT
+%token FONTNAME
+%token FONTAREA
+%token FONTCHECKSUM
+%token FONTAT
+%token FONTDSIZE
+
+%token MAP
+%token SELECTFONT
+%token SETCHAR
+%token SETRULE
+%token MOVE
+%token PUSH
+%token POP
+%token SPECIAL
+%token SPECIALHEX
+
+/* Tokens found only in OPL and OVF files */
+
+%token CHARREPEAT
+%token FONTIVALUE
+%token FONTFVALUE
+%token FONTMVALUE
+%token FONTPENALTY
+%token FONTRULE
+%token FONTGLUE
+
+%token CLABEL
+%token CKRN
+%token CGLUE
+%token CPENALTY
+%token CPENGLUE
+
+%token CHARIVALUE
+%token CHARFVALUE
+%token CHARMVALUE
+%token CHARPENALTY
+%token CHARRULE
+%token CHARGLUE
+
+%token IVALUE
+%token IVALUEVAL
+
+%token MVALUE
+%token MVALUEVAL
+
+%token FVALUE
+%token FVALUEVAL
+
+%token PENALTY
+%token PENALTYVAL
+
+%token RULE
+%token RULEMEASURE
+
+%token GLUE
+%token GLUEWD
+%token GLUETYPE
+%token GLUEKIND /* Implicit integer */
+%token GLUERULE
+%token GLUECHAR
+%token GLUESHRINKSTRETCH
+%token GLUEORDER /* Implicit integer */
+
+
+%token OFMLEVEL
+%token FONTDIR
+%token ACCENT
+
+%%
+
+File:
+ Entries
+;
+
+Entries :
+ /* */
+| Entries
+ LEFT OneEntry RIGHT
+;
+
+OneEntry :
+
+/* The following entries are found in PL, OPL, VP and OVP files */
+
+ CHECKSUM NUMBER
+ { set_check_sum($2.yint); }
+| DESIGNSIZE FIX
+ { set_design_size($2.yfix); }
+| DESIGNUNITS FIX
+ { set_design_units($2.yfix); }
+| CODINGSCHEME
+ { set_coding_scheme($1.ystring); }
+| FAMILY
+ { set_family($1.ystring); }
+| FACE NUMBER
+ { set_face($2.yint); }
+| SEVENBITSAFEFLAG
+ { set_seven_bit_safe_flag($1.yint); }
+| HEADER NUMBER NUMBER
+ { set_header_word($2.yint, $3.yint); }
+| FONTDIMEN
+ { init_parameters(); }
+ FontParameters
+| LIGTABLE
+ { init_ligkern(); }
+ LigKernEntries
+| BOUNDARYCHAR NUMBER
+ { set_boundary_character($2.yint); }
+| CHARACTER NUMBER
+ { init_character($2.yint, NULL); }
+ CharacterEntries
+| COMMENT
+
+/* The following entries are found only in VP and OVP files */
+
+| VTITLE
+ { set_vtitle($1.ystring); }
+| MAPFONT NUMBER
+ { init_map_font($2.yint); }
+ MapFontEntries
+
+/* The following entries are found only in OPL and OVP files */
+
+| OFMLEVEL NUMBER
+ { set_ofm_level($2.yint); }
+| FONTDIR
+ { set_font_dir($1.yint); }
+| CHARREPEAT NUMBER NUMBER
+ { init_character($2.yint,NULL); }
+ CharacterEntries
+ { copy_characters($2.yint,$3.yint); }
+| FONTIVALUE NUMBER
+ {init_font_ivalue($2.yint);}
+ FontIvalueEntries
+| FONTMVALUE NUMBER
+ { init_font_mvalue($2.yint);}
+ FontMvalueEntries
+| FONTFVALUE NUMBER
+ { init_font_fvalue($2.yint);}
+ FontFvalueEntries
+| FONTPENALTY NUMBER
+ { init_font_penalty($2.yint);}
+ FontPenaltyEntries
+| FONTRULE NUMBER
+ { init_font_rule($2.yint);}
+ FontRuleEntries
+| FONTGLUE NUMBER
+ { init_font_glue($2.yint);}
+ FontGlueEntries
+;
+
+FontParameters :
+ /* */
+| FontParameters
+ LEFT OneFontParameter RIGHT
+;
+
+OneFontParameter :
+ NAMEDPARAMETER FIX
+ { set_param_word($1.yint, $2.yfix); }
+| PARAMETER NUMBER FIX
+ { set_param_word($2.yint, $3.yfix); }
+| COMMENT
+;
+
+LigKernEntries :
+ /* */
+| LigKernEntries
+ LEFT OneLigKernEntry RIGHT
+;
+
+OneLigKernEntry :
+ LABEL NUMBER
+ { set_label_command($2.yint); }
+| LABEL BOUNDARYCHAR
+ { set_label_command(CHAR_BOUNDARY); }
+| LIG NUMBER NUMBER
+ { set_ligature_command($1.yint, $2.yint, $3.yint); }
+| KRN NUMBER FIX
+ { set_kerning_command($2.yint, $3.yfix); }
+| STOP
+ { set_stop_command(); }
+| SKIP NUMBER
+ { set_skip_command($2.yint); }
+| COMMENT
+
+/* The following entries are found only in OPL and OVP files */
+
+| CLABEL NUMBER
+ { set_c_label_command($2.yint); }
+| CKRN NUMBER FIX
+ { set_c_kerning_command($2.yint, $3.yfix); }
+| CGLUE NUMBER NUMBER
+ { set_c_glue_command($2.yint, $3.yint); }
+| CPENALTY NUMBER NUMBER
+ { set_c_penalty_command($2.yint, $3.yint); }
+| CPENGLUE NUMBER NUMBER NUMBER
+ { set_c_penglue_command($2.yint, $3.yint, $4.yint); }
+;
+
+CharacterEntries :
+ /* */
+| CharacterEntries
+ LEFT OneCharacterEntry RIGHT
+;
+
+OneCharacterEntry :
+ CHARMEASURE FIX
+ { set_character_measure($1.yint, $2.yfix); }
+| NEXTLARGER NUMBER
+ { set_next_larger($2.yint); }
+| VARCHAR
+ { init_var_character(); }
+ VarCharParameters
+| COMMENT
+
+/* The following character entries are found only in VP and OVP files */
+
+| MAP
+ { init_map(); }
+ MapEntries
+ { end_map(); }
+
+/* The following entries are found only in OPL and OVP files */
+
+| ACCENT
+ { set_accent($1.yint); }
+| CHARIVALUE NUMBER NUMBER
+ { set_character_ivalue($2.yint, $3.yint); }
+| CHARMVALUE NUMBER NUMBER
+ { set_character_mvalue($2.yint, $3.yint); }
+| CHARFVALUE NUMBER NUMBER
+ { set_character_fvalue($2.yint, $3.yint); }
+| CHARPENALTY NUMBER NUMBER
+ { set_character_penalty($2.yint, $3.yint); }
+| CHARRULE NUMBER NUMBER
+ { set_character_rule($2.yint, $3.yint); }
+| CHARGLUE NUMBER NUMBER
+ { set_character_glue($2.yint, $3.yint); }
+
+;
+
+VarCharParameters :
+ /* */
+| VarCharParameters
+ LEFT OneVarCharParameter RIGHT
+;
+
+OneVarCharParameter :
+ EXTEN NUMBER
+ { set_extensible_piece($1.yint, $2.yint); }
+| COMMENT
+;
+
+
+/* The following four nonterminals are found only in VP and OVP files */
+
+MapFontEntries :
+ /* */
+| MapFontEntries
+ LEFT OneMapFontEntry RIGHT
+;
+
+OneMapFontEntry :
+ FONTNAME
+ { set_font_name($1.ystring); }
+| FONTAREA
+ { set_font_area($1.ystring); }
+| FONTCHECKSUM NUMBER
+ { set_font_check_sum($2.yint); }
+| FONTAT FIX
+ { set_font_at($2.yfix); }
+| FONTDSIZE FIX
+ { set_font_design_size($2.yfix); }
+| COMMENT
+;
+
+MapEntries :
+ /* */
+| MapEntries
+ LEFT OneMapEntry RIGHT
+;
+
+OneMapEntry :
+ SELECTFONT NUMBER
+ { set_select_font($2.yint); }
+| SETCHAR NUMBER
+ { set_set_char($2.yint); }
+| SETRULE FIX FIX
+ { set_set_rule($2.yfix, $3.yfix); }
+| MOVE FIX
+ { set_move($1.yint, $2.yfix); }
+| PUSH
+ { set_push(); }
+| POP
+ { set_pop(); }
+| SPECIAL
+ { set_special($1.ystring); }
+| SPECIALHEX
+ { set_special_hex($1.ystring); }
+;
+
+/* The remaining nonterminals are found only in OPL and OVP files */
+
+FontIvalueEntries :
+ /* */
+| FontIvalueEntries
+ LEFT OneFontIvalueEntry RIGHT
+;
+
+OneFontIvalueEntry :
+ IVALUE NUMBER
+ { init_font_ivalue_entry($2.yint); }
+ IvalueDefinition
+| COMMENT
+;
+
+IvalueDefinition :
+ /* */
+| IvalueDefinition
+ LEFT OneIvalueDefinition RIGHT
+;
+
+OneIvalueDefinition :
+ IVALUEVAL NUMBER
+ { set_font_ivalue_definition($2.yint); }
+| COMMENT
+;
+
+FontMvalueEntries :
+ /* */
+| FontMvalueEntries
+ LEFT OneFontMvalueEntry RIGHT
+;
+
+OneFontMvalueEntry :
+ MVALUE NUMBER
+ { init_font_mvalue_entry($2.yint); }
+ MvalueDefinition
+| COMMENT
+;
+
+MvalueDefinition :
+ /* */
+| MvalueDefinition
+ LEFT OneMvalueDefinition RIGHT
+;
+
+OneMvalueDefinition :
+ MVALUEVAL FIX
+ { set_font_mvalue_definition($2.yfix); }
+| COMMENT
+;
+
+FontFvalueEntries :
+ /* */
+| FontFvalueEntries
+ LEFT OneFontFvalueEntry RIGHT
+;
+
+OneFontFvalueEntry :
+ FVALUE NUMBER
+ { init_font_fvalue_entry($2.yint); }
+ FvalueDefinition
+| COMMENT
+;
+
+FvalueDefinition :
+ /* */
+| FvalueDefinition
+ LEFT OneFvalueDefinition RIGHT
+;
+
+OneFvalueDefinition :
+ FVALUEVAL FIX
+ { set_font_fvalue_definition($2.yfix); }
+| COMMENT
+;
+
+FontPenaltyEntries :
+ /* */
+| FontPenaltyEntries
+ LEFT OneFontPenaltyEntry RIGHT
+;
+
+OneFontPenaltyEntry :
+ PENALTY NUMBER
+ { init_font_penalty_entry($2.yint); }
+ PenaltyDefinition
+| COMMENT
+;
+
+PenaltyDefinition :
+ /* */
+| PenaltyDefinition
+ LEFT OnePenaltyDefinition RIGHT
+;
+
+OnePenaltyDefinition :
+ PENALTYVAL NUMBER
+ { set_font_penalty_definition($2.yint); }
+| COMMENT
+;
+
+FontRuleEntries :
+ /* */
+| FontRuleEntries
+ LEFT OneFontRuleEntry RIGHT
+;
+
+OneFontRuleEntry :
+ RULE NUMBER
+ { init_font_rule_entry($2.yint); }
+ RuleDefinition
+| COMMENT
+;
+
+RuleDefinition :
+ /* */
+| RuleDefinition
+ LEFT OneRuleDefinition RIGHT
+;
+
+OneRuleDefinition :
+ RULEMEASURE FIX
+ { set_font_rule_measure($1.yint, $2.yfix); }
+| COMMENT
+;
+
+FontGlueEntries :
+ /* */
+| FontGlueEntries
+ LEFT OneFontGlueEntry RIGHT
+;
+
+OneFontGlueEntry :
+ GLUE NUMBER
+ { init_font_glue_entry($2.yint); }
+ GlueDefinition
+| COMMENT
+;
+
+GlueDefinition :
+ /* */
+| GlueDefinition
+ LEFT OneGlueDefinition RIGHT
+;
+
+OneGlueDefinition :
+ GLUETYPE GLUEKIND
+ { set_font_glue_type($2.yint); }
+| GLUEWD FIX
+ { set_font_glue_width($2.yfix); }
+| GLUECHAR NUMBER
+ { set_font_glue_character($2.yint); }
+| GLUERULE NUMBER NUMBER
+ { set_font_glue_rule($2.yint, $3.yint); }
+| GLUESHRINKSTRETCH FIX GLUEORDER
+ { set_font_glue_shrink_stretch($1.yint, $2.yfix, $3.yint); }
+| COMMENT
+;
diff --git a/Build/source/texk/web2c/omegafonts/print_routines.c b/Build/source/texk/web2c/omegafonts/print_routines.c
new file mode 100644
index 00000000000..5bb2260c953
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/print_routines.c
@@ -0,0 +1,727 @@
+/* print_routines.c: higher-level routines for printing OPL and OVP files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "list_routines.h"
+#include "manifests.h"
+#include "print_routines.h"
+#include "header_routines.h"
+#include "out_routines.h"
+#include "error_routines.h"
+#include "omfonts.h"
+
+void
+print_check_sum(void)
+{
+ left();
+ out("CHECKSUM");
+ out(" "); out_num(check_sum);
+ right();
+}
+
+void
+print_design_size(void)
+{
+ left();
+ out("DESIGNSIZE");
+ out(" "); out_fix(design_size);
+ right();
+}
+
+void
+print_design_units(void)
+{
+ left();
+ out("DESIGNUNITS");
+ out(" "); out_fix(design_units);
+ right();
+}
+
+void
+print_coding_scheme(void)
+{
+ left();
+ out("CODINGSCHEME");
+ out(" "); out(coding_scheme);
+ right();
+}
+
+void
+print_family(void)
+{
+ left();
+ out("FAMILY");
+ out(" "); out(family);
+ right();
+}
+
+void
+print_face(void)
+{
+ left();
+ out("FACE");
+ out(" ");
+ if ((face >= F_MIN) && (face <= F_MAX)) print_xerox_face(face);
+ else out_num(face);
+ right();
+}
+
+void
+print_seven_bit_safe_flag(void)
+{
+ left();
+ out("SEVENBITSAFEFLAG"); out(" ");
+ if (seven_bit == 1) out("TRUE");
+ else if (seven_bit == 0) out("FALSE");
+ else internal_error_1("print_seven_bit_safe_flag (seven_bit=%d)", seven_bit);
+ right();
+
+}
+
+void
+print_header_word(unsigned val1, unsigned val2)
+{
+ left();
+ out("HEADER");
+ out(" "); out_int(val1,10);
+ out(" "); out_num(val2);
+ right();
+}
+
+void
+print_font_dimension(void)
+{
+ left();
+ out("FONTDIMEN"); out_ln();
+}
+
+void
+print_ligature_table(void)
+{
+ left();
+ out("LIGTABLE"); out_ln();
+}
+
+void
+print_boundary_character(unsigned val)
+{
+ left();
+ out("BOUNDARYCHAR");
+ out(" "); out_num(val);
+ right();
+}
+
+void
+print_character(unsigned val)
+{
+ left();
+ out("CHARACTER");
+ out(" "); out_char(val); out_ln();
+}
+
+void
+print_parameter(unsigned parameter, fix fval)
+{
+ left();
+ if ((font_type==FT_MATHSY) &&
+ (parameter>=P_MATHSY_MIN) &&
+ (parameter<=P_MATHSY_MAX)) {
+ out_named_mathsy_parameter(parameter);
+ } else if ((font_type==FT_MATHEX) &&
+ (parameter>=P_MATHEX_MIN) &&
+ (parameter<=P_MATHEX_MAX)) {
+ out_named_mathex_parameter(parameter);
+ } else if (parameter<=P_MAX) {
+ out_named_parameter(parameter);
+ } else {
+ out("PARAMETER"); out(" "); out_int(parameter,10);
+ }
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_label_command(unsigned val)
+{
+ left();
+ out("LABEL"); out(" ");
+ if (val == -1) out("BOUNDARYCHAR");
+ else out_char(val);
+ right();
+}
+
+void
+print_ligature_command(unsigned command, unsigned val1, unsigned val2)
+{
+ left();
+ out_ligature_command(command);
+ out(" "); out_char(val1);
+ out(" "); out_char(val2);
+ right();
+}
+
+void
+print_kerning_command(unsigned val, fix fval)
+{
+ left();
+ out("KRN");
+ out(" "); out_char(val);
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_stop_command(void)
+{
+ left();
+ out("STOP");
+ right();
+}
+
+void
+print_skip_command(unsigned val)
+{
+ left();
+ out("SKIP");
+ out(" "); out_int(val,10);
+ right();
+}
+
+void
+print_character_measure(unsigned measure, fix fval)
+{
+ left();
+ out_character_measure(measure);
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_next_larger(unsigned val)
+{
+ left();
+ out("NEXTLARGER");
+ out(" "); out_char(val);
+ right();
+}
+
+void
+print_var_character(void)
+{
+ left(); out("VARCHAR"); out_ln();
+}
+
+void
+print_extensible_piece(unsigned piece, unsigned val)
+{
+ left();
+ out_extensible_piece(piece);
+ out(" "); out_char(val);
+ right();
+}
+
+/* Primitives used in VF and OVF files */
+
+void
+print_vtitle(string sval)
+{
+ left();
+ out("VTITLE");
+ out(" "); out(sval);
+ right();
+}
+
+void
+print_map_font(unsigned val)
+{
+ left();
+ out("MAPFONT");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_name(string sval)
+{
+ left();
+ out("FONTNAME");
+ out(" "); out(sval);
+ right();
+}
+
+void
+print_font_area(string sval)
+{
+ left();
+ out("FONTAREA");
+ out(" "); out(sval);
+ right();
+}
+
+void
+print_font_check_sum(unsigned val)
+{
+ left();
+ out("FONTCHECKSUM");
+ out(" "); out_num(val);
+ right();
+}
+
+void
+print_font_at(fix fval)
+{
+ left();
+ out("FONTAT");
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_font_design_size(fix fval)
+{
+ left();
+ out("FONTDSIZE");
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_map(void)
+{
+ left(); out("MAP"); out_ln();
+}
+
+void
+print_select_font(unsigned val)
+{
+ left();
+ out("SELECTFONT");
+ out(" "); out_int(val,10);
+ right();
+}
+
+void
+print_set_char(unsigned val)
+{
+ left();
+ out("SETCHAR");
+ out(" "); out_char(val);
+ right();
+}
+
+void
+print_put_char(unsigned val)
+{
+ left();
+ out("PUTCHAR");
+ out(" "); out_char(val);
+ right();
+}
+
+void
+print_set_rule(fix fval1, fix fval2)
+{
+ left();
+ out("SETRULE");
+ out(" "); out_fix(fval1);
+ out(" "); out_fix(fval2);
+ right();
+}
+
+void
+print_put_rule(fix fval1, fix fval2)
+{
+ left();
+ out("PUTRULE");
+ out(" "); out_fix(fval1);
+ out(" "); out_fix(fval2);
+ right();
+}
+
+void
+print_push(void)
+{
+ left(); out("PUSH"); right();
+}
+
+void
+print_pop(void)
+{
+ left(); out("POP"); right();
+}
+
+void
+print_move(unsigned direction, fix fval)
+{
+ left();
+ out_move_direction(direction);
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_special(string sval)
+{
+ left();
+ out("SPECIAL");
+ out(" "); out(sval);
+ right();
+}
+
+void
+print_special_hex(string sval)
+{
+ left();
+ out("SPECIALHEX");
+ out(" "); out(sval);
+ right();
+}
+
+/* Primitives used in OPL and OVF files */
+
+void
+print_character_repeat(unsigned val1, unsigned val2)
+{
+ left();
+ out("CHARREPEAT");
+ out(" "); out_char(val1);
+ out(" "); out_char(val2); out_ln();
+}
+
+void
+print_font_ivalue(unsigned val)
+{
+ left();
+ out("FONTIVALUE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_mvalue(unsigned val)
+{
+ left();
+ out("FONTMVALUE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_fvalue(unsigned val)
+{
+ left();
+ out("FONTFVALUE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_penalty(unsigned val)
+{
+ left();
+ out("FONTPENALTY");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_rule(unsigned val)
+{
+ left();
+ out("FONTRULE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_glue(unsigned val)
+{
+ left();
+ out("FONTGLUE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_c_label_command(unsigned val)
+{
+ left();
+ out("CLABEL"); out(" "); out_int(val,10);
+ right();
+}
+
+void
+print_c_kerning_command(unsigned val1, unsigned val2)
+{
+ left();
+ out("CKRN"); out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_c_glue_command(unsigned val1, unsigned val2)
+{
+ left();
+ out("CGLUE"); out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_c_penalty_command(unsigned val1, unsigned val2)
+{
+ left();
+ out("CPENALTY"); out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_c_penglue_command(unsigned val1, unsigned val2, unsigned val3)
+{
+ left();
+ out("CPENGLUE"); out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ out(" "); out_int(val3,10);
+ right();
+}
+
+void
+print_character_ivalue(unsigned val1, unsigned val2)
+{
+ left();
+ out("CHARIVALUE");
+ out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_character_mvalue(unsigned val1, unsigned val2)
+{
+ left();
+ out("CHARMVALUE");
+ out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_character_fvalue(unsigned val1, unsigned val2)
+{
+ left();
+ out("CHARFVALUE");
+ out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_character_penalty(unsigned val1, unsigned val2)
+{
+ left();
+ out("CHARPENALTY");
+ out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_character_rule(unsigned val1, unsigned val2)
+{
+ left();
+ out("CHARRULE");
+ out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_character_glue(unsigned val1, unsigned val2)
+{
+ left();
+ out("CHARGLUE");
+ out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_font_ivalue_entry(unsigned val)
+{
+ left();
+ out("IVALUE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_ivalue_definition(unsigned val)
+{
+ left();
+ out("IVALUEVAL");
+ out(" "); out_int(val,10);
+ right();
+}
+
+void
+print_font_mvalue_entry(unsigned val)
+{
+ left();
+ out("MVALUE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_mvalue_definition(fix fval)
+{
+ left();
+ out("MVALUEVAL");
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_font_fvalue_entry(unsigned val)
+{
+ left();
+ out("FVALUE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_fvalue_definition(fix fval)
+{
+ left();
+ out("FVALUEVAL");
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_font_penalty_entry(unsigned val)
+{
+ left();
+ out("PENALTY");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_penalty_definition(unsigned val)
+{
+ left();
+ out("PENALTYVAL");
+ out(" "); out_int(val,10);
+ right();
+}
+
+void
+print_font_rule_entry(unsigned val)
+{
+ left();
+ out("RULE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_rule_measure(unsigned val, fix fval)
+{
+ left();
+ out_rule_measure(val);
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_font_glue_entry(unsigned val)
+{
+ left();
+ out("GLUE");
+ out(" "); out_int(val,10); out_ln();
+}
+
+void
+print_font_glue_type(unsigned val)
+{
+ left();
+ out("GLUETYPE");
+ out(" "); out_glue_kind(val);
+ right();
+}
+
+void
+print_font_glue_width(fix fval)
+{
+ left();
+ out("GLUEWD");
+ out(" "); out_fix(fval);
+ right();
+}
+
+void
+print_font_glue_character(unsigned val)
+{
+ left();
+ out("GLUECHAR");
+ out(" "); out_char(val);
+ right();
+}
+
+void
+print_font_glue_rule(unsigned val1, unsigned val2)
+{
+ left();
+ out("GLUERULE");
+ out(" "); out_int(val1,10);
+ out(" "); out_int(val2,10);
+ right();
+}
+
+void
+print_font_glue_shrink_stretch(unsigned val1, fix fval, unsigned val2)
+{
+ left();
+ out_shrink_stretch(val1);
+ out(" "); out_fix(fval);
+ out(" "); out_glue_order(val2);
+ right();
+}
+
+void
+print_ofm_level(unsigned val)
+{
+ left();
+ out("OFMLEVEL");
+ out(" "); out_int(val,10);
+ right();
+}
+
+void
+print_font_dir(unsigned val)
+{
+ left();
+ out_type_direction(val);
+ right();
+}
+
+void
+print_accent(unsigned val)
+{
+ left();
+ out_accent_kind(val);
+ right();
+}
+
diff --git a/Build/source/texk/web2c/omegafonts/print_routines.h b/Build/source/texk/web2c/omegafonts/print_routines.h
new file mode 100644
index 00000000000..1362b56bd18
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/print_routines.h
@@ -0,0 +1,105 @@
+/* print_routines.h: higher-level routines for printing OPL and OVP files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+extern void print_check_sum(void);
+extern void print_design_size(void);
+extern void print_design_units(void);
+extern void print_coding_scheme(void);
+extern void print_family(void);
+extern void print_face(void);
+extern void print_seven_bit_safe_flag(void);
+extern void print_header_word(unsigned, unsigned);
+extern void print_font_dimension(void);
+extern void print_ligature_table(void);
+extern void print_boundary_character(unsigned);
+extern void print_character(unsigned);
+extern void print_parameter(unsigned, fix);
+extern void print_label_command(unsigned);
+extern void print_ligature_command(unsigned, unsigned, unsigned);
+extern void print_kerning_command(unsigned, fix);
+extern void print_stop_command(void);
+extern void print_skip_command(unsigned);
+extern void print_character_measure(unsigned, fix);
+extern void print_next_larger(unsigned);
+extern void print_var_character(void);
+extern void print_extensible_piece(unsigned, unsigned);
+
+extern void print_vtitle(string);
+extern void print_map_font(unsigned);
+extern void print_font_name(string);
+extern void print_font_area(string);
+extern void print_font_check_sum(unsigned);
+extern void print_font_at(fix);
+extern void print_font_design_size(fix);
+extern void print_map(void);
+extern void print_select_font(unsigned);
+extern void print_set_char(unsigned);
+extern void print_put_char(unsigned);
+extern void print_set_rule(fix, fix);
+extern void print_put_rule(fix, fix);
+extern void print_push(void);
+extern void print_pop(void);
+extern void print_move(unsigned, fix);
+extern void print_special(string);
+extern void print_special_hex(string);
+
+extern void print_character_repeat(unsigned, unsigned);
+extern void print_font_ivalue(unsigned);
+extern void print_font_mvalue(unsigned);
+extern void print_font_fvalue(unsigned);
+extern void print_font_penalty(unsigned);
+extern void print_font_rule(unsigned);
+extern void print_font_glue(unsigned);
+extern void print_c_label_command(unsigned);
+extern void print_c_kerning_command(unsigned, unsigned);
+extern void print_c_glue_command(unsigned, unsigned);
+extern void print_c_penalty_command(unsigned, unsigned);
+extern void print_c_penglue_command(unsigned, unsigned, unsigned);
+extern void print_character_ivalue(unsigned, unsigned);
+extern void print_character_mvalue(unsigned, unsigned);
+extern void print_character_fvalue(unsigned, unsigned);
+extern void print_character_penalty(unsigned, unsigned);
+extern void print_character_rule(unsigned, unsigned);
+extern void print_character_glue(unsigned, unsigned);
+extern void print_font_ivalue_entry(unsigned);
+extern void print_font_ivalue_definition(unsigned);
+extern void print_font_mvalue_entry(unsigned);
+extern void print_font_mvalue_definition(fix);
+extern void print_font_fvalue_entry(unsigned);
+extern void print_font_fvalue_definition(fix);
+extern void print_font_penalty_entry(unsigned);
+extern void print_font_penalty_definition(unsigned);
+extern void print_font_rule_entry(unsigned);
+extern void print_font_rule_measure(unsigned, fix);
+extern void print_font_rule_height(fix);
+extern void print_font_rule_depth(fix);
+extern void print_font_glue_entry(unsigned);
+extern void print_font_glue_type(unsigned);
+extern void print_font_glue_width(fix);
+extern void print_font_glue_character(unsigned);
+extern void print_font_glue_rule(unsigned,unsigned);
+extern void print_font_glue_shrink_stretch(unsigned, fix, unsigned);
+extern void print_ofm_level(unsigned);
+extern void print_font_dir(unsigned);
+extern void print_accent(unsigned);
+
diff --git a/Build/source/texk/web2c/omegafonts/win32.mak b/Build/source/texk/web2c/omegafonts/win32.mak
new file mode 100644
index 00000000000..9e79707f5de
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/win32.mak
@@ -0,0 +1,81 @@
+################################################################################
+#
+# Makefile : Web2C / Omega / Omegafonts
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/01/07 11:10:43 popineau>
+#
+################################################################################
+root_srcdir = ..\..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+USE_KPATHSEA = 1
+USE_GNUW32 = 1
+
+# These get expanded from the parent directory, not this one.
+!include <msvc/common.mak>
+
+DEFS = -I.. $(DEFS) -DHAVE_CONFIG_H
+
+LEX_OUTPUT_ROOT = lex_yy
+
+proglib = ..\lib\$(objdir)\lib.lib
+
+programs = $(objdir)\omfonts.exe
+linked_programs = $(objdir)\ofm2opl.exe $(objdir)\opl2ofm.exe \
+ $(objdir)\ovf2ovp.exe $(objdir)\ovp2ovf.exe
+
+omfonts_objects = $(objdir)\omfonts.obj $(objdir)\y_tab.obj \
+ $(objdir)\$(LEX_OUTPUT_ROOT).obj $(objdir)\char_routines.obj \
+ $(objdir)\dimen_routines.obj $(objdir)\error_routines.obj \
+ $(objdir)\header_routines.obj $(objdir)\ligkern_routines.obj \
+ $(objdir)\list_routines.obj $(objdir)\out_routines.obj \
+ $(objdir)\param_routines.obj $(objdir)\print_routines.obj \
+ $(objdir)\font_routines.obj $(objdir)\extra_routines.obj \
+ $(objdir)\out_ofm.obj $(objdir)\parse_ofm.obj
+
+all: $(objdir) $(programs)
+
+$(objdir)\omfonts.exe: $(omfonts_objects) $(proglib) $(kpathsealib)
+ $(link) $(**) $(conlibs)
+
+$(objdir)\omfonts.obj: omfonts.c y_tab.h
+
+y_tab.c y_tab.h: pl.y
+ $(yacc) -d -v $(srcdir)\pl.y -o y_tab.c
+
+$(objdir)\$(LEX_OUTPUT_ROOT).obj: parser.h
+
+$(LEX_OUTPUT_ROOT).c: pl.l
+ $(lex) -t $(srcdir)\pl.l | sed "/^extern int isatty YY/d" > $(LEX_OUTPUT_ROOT).c
+
+!include <msvc/config.mak>
+!include <msvc/install.mak>
+
+install:: install-exec
+
+install-programs: install-exec
+
+install-exec:: install-links
+
+install-links: $(programs)
+ -@echo $(verbose) & for %%i in ($(linked_programs)) do $(copy) $(programs) $(bindir)\%%~nxi $(redir_stdout)
+
+!include <msvc/clean.mak>
+
+clean::
+ -@echo $(verbose) & ( \
+ for %%i in (y_tab.c y_tab.h y.output yacc.* $(LEX_OUTPUT_ROOT).c) do $(del) %%i $(redir_stderr) \
+ )
+
+!include <msvc/rdepend.mak>
+!include "./depend.mak"
+
+#
+# Local Variables:
+# mode: makefile
+# End:
diff --git a/Build/source/texk/web2c/omegafonts/y_tab.c-dist b/Build/source/texk/web2c/omegafonts/y_tab.c-dist
new file mode 100644
index 00000000000..10b79adf607
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/y_tab.c-dist
@@ -0,0 +1,2030 @@
+/* A Bison parser, made by GNU Bison 1.875a. */
+
+/* Skeleton parser for Yacc-like parsing with Bison,
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+/* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+/* Written by Richard Stallman by simplifying the original so called
+ ``semantic'' parser. */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+ infringing on user name space. This should be done even for local
+ variables, as they might otherwise be expanded by user macros.
+ There are some unavoidable exceptions within include files to
+ define necessary library symbols; they are noted "INFRINGES ON
+ USER NAME SPACE" below. */
+
+/* Identify Bison output. */
+#define YYBISON 1
+
+/* Skeleton name. */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers. */
+#define YYPURE 0
+
+/* Using locations. */
+#define YYLSP_NEEDED 0
+
+
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ LEFT = 258,
+ RIGHT = 259,
+ NUMBER = 260,
+ FIX = 261,
+ COMMENT = 262,
+ CHECKSUM = 263,
+ DESIGNSIZE = 264,
+ DESIGNUNITS = 265,
+ CODINGSCHEME = 266,
+ FAMILY = 267,
+ FACE = 268,
+ SEVENBITSAFEFLAG = 269,
+ HEADER = 270,
+ FONTDIMEN = 271,
+ LIGTABLE = 272,
+ BOUNDARYCHAR = 273,
+ CHARACTER = 274,
+ NAMEDPARAMETER = 275,
+ PARAMETER = 276,
+ CHARMEASURE = 277,
+ NEXTLARGER = 278,
+ VARCHAR = 279,
+ EXTEN = 280,
+ LABEL = 281,
+ LIG = 282,
+ KRN = 283,
+ STOP = 284,
+ SKIP = 285,
+ VTITLE = 286,
+ MAPFONT = 287,
+ FONTNAME = 288,
+ FONTAREA = 289,
+ FONTCHECKSUM = 290,
+ FONTAT = 291,
+ FONTDSIZE = 292,
+ MAP = 293,
+ SELECTFONT = 294,
+ SETCHAR = 295,
+ SETRULE = 296,
+ MOVE = 297,
+ PUSH = 298,
+ POP = 299,
+ SPECIAL = 300,
+ SPECIALHEX = 301,
+ CHARREPEAT = 302,
+ FONTIVALUE = 303,
+ FONTFVALUE = 304,
+ FONTMVALUE = 305,
+ FONTPENALTY = 306,
+ FONTRULE = 307,
+ FONTGLUE = 308,
+ CLABEL = 309,
+ CKRN = 310,
+ CGLUE = 311,
+ CPENALTY = 312,
+ CPENGLUE = 313,
+ CHARIVALUE = 314,
+ CHARFVALUE = 315,
+ CHARMVALUE = 316,
+ CHARPENALTY = 317,
+ CHARRULE = 318,
+ CHARGLUE = 319,
+ IVALUE = 320,
+ IVALUEVAL = 321,
+ MVALUE = 322,
+ MVALUEVAL = 323,
+ FVALUE = 324,
+ FVALUEVAL = 325,
+ PENALTY = 326,
+ PENALTYVAL = 327,
+ RULE = 328,
+ RULEMEASURE = 329,
+ GLUE = 330,
+ GLUEWD = 331,
+ GLUETYPE = 332,
+ GLUEKIND = 333,
+ GLUERULE = 334,
+ GLUECHAR = 335,
+ GLUESHRINKSTRETCH = 336,
+ GLUEORDER = 337,
+ OFMLEVEL = 338,
+ FONTDIR = 339,
+ ACCENT = 340
+ };
+#endif
+#define LEFT 258
+#define RIGHT 259
+#define NUMBER 260
+#define FIX 261
+#define COMMENT 262
+#define CHECKSUM 263
+#define DESIGNSIZE 264
+#define DESIGNUNITS 265
+#define CODINGSCHEME 266
+#define FAMILY 267
+#define FACE 268
+#define SEVENBITSAFEFLAG 269
+#define HEADER 270
+#define FONTDIMEN 271
+#define LIGTABLE 272
+#define BOUNDARYCHAR 273
+#define CHARACTER 274
+#define NAMEDPARAMETER 275
+#define PARAMETER 276
+#define CHARMEASURE 277
+#define NEXTLARGER 278
+#define VARCHAR 279
+#define EXTEN 280
+#define LABEL 281
+#define LIG 282
+#define KRN 283
+#define STOP 284
+#define SKIP 285
+#define VTITLE 286
+#define MAPFONT 287
+#define FONTNAME 288
+#define FONTAREA 289
+#define FONTCHECKSUM 290
+#define FONTAT 291
+#define FONTDSIZE 292
+#define MAP 293
+#define SELECTFONT 294
+#define SETCHAR 295
+#define SETRULE 296
+#define MOVE 297
+#define PUSH 298
+#define POP 299
+#define SPECIAL 300
+#define SPECIALHEX 301
+#define CHARREPEAT 302
+#define FONTIVALUE 303
+#define FONTFVALUE 304
+#define FONTMVALUE 305
+#define FONTPENALTY 306
+#define FONTRULE 307
+#define FONTGLUE 308
+#define CLABEL 309
+#define CKRN 310
+#define CGLUE 311
+#define CPENALTY 312
+#define CPENGLUE 313
+#define CHARIVALUE 314
+#define CHARFVALUE 315
+#define CHARMVALUE 316
+#define CHARPENALTY 317
+#define CHARRULE 318
+#define CHARGLUE 319
+#define IVALUE 320
+#define IVALUEVAL 321
+#define MVALUE 322
+#define MVALUEVAL 323
+#define FVALUE 324
+#define FVALUEVAL 325
+#define PENALTY 326
+#define PENALTYVAL 327
+#define RULE 328
+#define RULEMEASURE 329
+#define GLUE 330
+#define GLUEWD 331
+#define GLUETYPE 332
+#define GLUEKIND 333
+#define GLUERULE 334
+#define GLUECHAR 335
+#define GLUESHRINKSTRETCH 336
+#define GLUEORDER 337
+#define OFMLEVEL 338
+#define FONTDIR 339
+#define ACCENT 340
+
+
+
+
+/* Copy the first part of user declarations. */
+#line 1 "./pl.y"
+
+/* pl.y: Grammar for reading property list files
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "cpascal.h"
+#include "parser.h"
+#include "manifests.h"
+#include "list_routines.h"
+#include "error_routines.h"
+#include "out_routines.h"
+#include "char_routines.h"
+#include "header_routines.h"
+#include "param_routines.h"
+#include "dimen_routines.h"
+#include "ligkern_routines.h"
+#include "print_routines.h"
+#include "font_routines.h"
+#include "extra_routines.h"
+
+
+
+/* Enabling traces. */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+
+/* Enabling verbose error messages. */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
+typedef int YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+
+
+/* Copy the second part of user declarations. */
+
+
+/* Line 214 of yacc.c. */
+#line 298 "y.tab.c"
+
+#if ! defined (yyoverflow) || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols. */
+
+# if YYSTACK_USE_ALLOCA
+# define YYSTACK_ALLOC alloca
+# else
+# ifndef YYSTACK_USE_ALLOCA
+# if defined (alloca) || defined (_ALLOCA_H)
+# define YYSTACK_ALLOC alloca
+# else
+# ifdef __GNUC__
+# define YYSTACK_ALLOC __builtin_alloca
+# endif
+# endif
+# endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+ /* Pacify GCC's `empty if-body' warning. */
+# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
+# else
+# if defined (__STDC__) || defined (__cplusplus)
+# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
+# endif
+# define YYSTACK_ALLOC malloc
+# define YYSTACK_FREE free
+# endif
+#endif /* ! defined (yyoverflow) || YYERROR_VERBOSE */
+
+
+#if (! defined (yyoverflow) \
+ && (! defined (__cplusplus) \
+ || (YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member. */
+union yyalloc
+{
+ short yyss;
+ YYSTYPE yyvs;
+ };
+
+/* The size of the maximum gap between one aligned stack and the next. */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+ N elements. */
+# define YYSTACK_BYTES(N) \
+ ((N) * (sizeof (short) + sizeof (YYSTYPE)) \
+ + YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO. The source and destination do
+ not overlap. */
+# ifndef YYCOPY
+# if 1 < __GNUC__
+# define YYCOPY(To, From, Count) \
+ __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+# else
+# define YYCOPY(To, From, Count) \
+ do \
+ { \
+ register YYSIZE_T yyi; \
+ for (yyi = 0; yyi < (Count); yyi++) \
+ (To)[yyi] = (From)[yyi]; \
+ } \
+ while (0)
+# endif
+# endif
+
+/* Relocate STACK from its old location to the new one. The
+ local variables YYSIZE and YYSTACKSIZE give the old and new number of
+ elements in the stack, and YYPTR gives the new location of the
+ stack. Advance YYPTR to a properly aligned location for the next
+ stack. */
+# define YYSTACK_RELOCATE(Stack) \
+ do \
+ { \
+ YYSIZE_T yynewbytes; \
+ YYCOPY (&yyptr->Stack, Stack, yysize); \
+ Stack = &yyptr->Stack; \
+ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+ yyptr += yynewbytes / sizeof (*yyptr); \
+ } \
+ while (0)
+
+#endif
+
+#if defined (__STDC__) || defined (__cplusplus)
+ typedef signed char yysigned_char;
+#else
+ typedef short yysigned_char;
+#endif
+
+/* YYFINAL -- State number of the termination state. */
+#define YYFINAL 3
+/* YYLAST -- Last index in YYTABLE. */
+#define YYLAST 221
+
+/* YYNTOKENS -- Number of terminals. */
+#define YYNTOKENS 86
+/* YYNNTS -- Number of nonterminals. */
+#define YYNNTS 59
+/* YYNRULES -- Number of rules. */
+#define YYNRULES 154
+/* YYNRULES -- Number of states. */
+#define YYNSTATES 272
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */
+#define YYUNDEFTOK 2
+#define YYMAXUTOK 340
+
+#define YYTRANSLATE(YYX) \
+ ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */
+static const unsigned char yytranslate[] =
+{
+ 0, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 1, 2, 3, 4,
+ 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
+ 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, 40, 41, 42, 43, 44,
+ 45, 46, 47, 48, 49, 50, 51, 52, 53, 54,
+ 55, 56, 57, 58, 59, 60, 61, 62, 63, 64,
+ 65, 66, 67, 68, 69, 70, 71, 72, 73, 74,
+ 75, 76, 77, 78, 79, 80, 81, 82, 83, 84,
+ 85
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+ YYRHS. */
+static const unsigned short yyprhs[] =
+{
+ 0, 0, 3, 5, 6, 11, 14, 17, 20, 22,
+ 24, 27, 29, 33, 34, 38, 39, 43, 46, 47,
+ 52, 54, 56, 57, 62, 65, 67, 68, 74, 75,
+ 80, 81, 86, 87, 92, 93, 98, 99, 104, 105,
+ 110, 111, 116, 119, 123, 125, 126, 131, 134, 137,
+ 141, 145, 147, 150, 152, 155, 159, 163, 167, 172,
+ 173, 178, 181, 184, 185, 189, 191, 192, 196, 198,
+ 202, 206, 210, 214, 218, 222, 223, 228, 231, 233,
+ 234, 239, 241, 243, 246, 249, 252, 254, 255, 260,
+ 263, 266, 270, 273, 275, 277, 279, 281, 282, 287,
+ 288, 293, 295, 296, 301, 304, 306, 307, 312, 313,
+ 318, 320, 321, 326, 329, 331, 332, 337, 338, 343,
+ 345, 346, 351, 354, 356, 357, 362, 363, 368, 370,
+ 371, 376, 379, 381, 382, 387, 388, 393, 395, 396,
+ 401, 404, 406, 407, 412, 413, 418, 420, 421, 426,
+ 429, 432, 435, 439, 443
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS. */
+static const short yyrhs[] =
+{
+ 87, 0, -1, 88, -1, -1, 88, 3, 89, 4,
+ -1, 8, 5, -1, 9, 6, -1, 10, 6, -1,
+ 11, -1, 12, -1, 13, 5, -1, 14, -1, 15,
+ 5, 5, -1, -1, 16, 90, 101, -1, -1, 17,
+ 91, 103, -1, 18, 5, -1, -1, 19, 5, 92,
+ 105, -1, 7, -1, 31, -1, -1, 32, 5, 93,
+ 111, -1, 83, 5, -1, 84, -1, -1, 47, 5,
+ 5, 94, 105, -1, -1, 48, 5, 95, 115, -1,
+ -1, 50, 5, 96, 120, -1, -1, 49, 5, 97,
+ 125, -1, -1, 51, 5, 98, 130, -1, -1, 52,
+ 5, 99, 135, -1, -1, 53, 5, 100, 140, -1,
+ -1, 101, 3, 102, 4, -1, 20, 6, -1, 21,
+ 5, 6, -1, 7, -1, -1, 103, 3, 104, 4,
+ -1, 26, 5, -1, 26, 18, -1, 27, 5, 5,
+ -1, 28, 5, 6, -1, 29, -1, 30, 5, -1,
+ 7, -1, 54, 5, -1, 55, 5, 6, -1, 56,
+ 5, 5, -1, 57, 5, 5, -1, 58, 5, 5,
+ 5, -1, -1, 105, 3, 106, 4, -1, 22, 6,
+ -1, 23, 5, -1, -1, 24, 107, 109, -1, 7,
+ -1, -1, 38, 108, 113, -1, 85, -1, 59, 5,
+ 5, -1, 61, 5, 5, -1, 60, 5, 5, -1,
+ 62, 5, 5, -1, 63, 5, 5, -1, 64, 5,
+ 5, -1, -1, 109, 3, 110, 4, -1, 25, 5,
+ -1, 7, -1, -1, 111, 3, 112, 4, -1, 33,
+ -1, 34, -1, 35, 5, -1, 36, 6, -1, 37,
+ 6, -1, 7, -1, -1, 113, 3, 114, 4, -1,
+ 39, 5, -1, 40, 5, -1, 41, 6, 6, -1,
+ 42, 6, -1, 43, -1, 44, -1, 45, -1, 46,
+ -1, -1, 115, 3, 116, 4, -1, -1, 65, 5,
+ 117, 118, -1, 7, -1, -1, 118, 3, 119, 4,
+ -1, 66, 5, -1, 7, -1, -1, 120, 3, 121,
+ 4, -1, -1, 67, 5, 122, 123, -1, 7, -1,
+ -1, 123, 3, 124, 4, -1, 68, 6, -1, 7,
+ -1, -1, 125, 3, 126, 4, -1, -1, 69, 5,
+ 127, 128, -1, 7, -1, -1, 128, 3, 129, 4,
+ -1, 70, 6, -1, 7, -1, -1, 130, 3, 131,
+ 4, -1, -1, 71, 5, 132, 133, -1, 7, -1,
+ -1, 133, 3, 134, 4, -1, 72, 5, -1, 7,
+ -1, -1, 135, 3, 136, 4, -1, -1, 73, 5,
+ 137, 138, -1, 7, -1, -1, 138, 3, 139, 4,
+ -1, 74, 6, -1, 7, -1, -1, 140, 3, 141,
+ 4, -1, -1, 75, 5, 142, 143, -1, 7, -1,
+ -1, 143, 3, 144, 4, -1, 77, 78, -1, 76,
+ 6, -1, 80, 5, -1, 79, 5, 5, -1, 81,
+ 6, 82, -1, 7, -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
+static const unsigned short yyrline[] =
+{
+ 0, 155, 155, 158, 160, 168, 170, 172, 174, 176,
+ 178, 180, 182, 185, 184, 188, 187, 190, 193, 192,
+ 195, 199, 202, 201, 207, 209, 212, 211, 216, 215,
+ 219, 218, 222, 221, 225, 224, 228, 227, 231, 230,
+ 235, 237, 242, 244, 246, 249, 251, 256, 258, 260,
+ 262, 264, 266, 268, 272, 274, 276, 278, 280, 284,
+ 286, 291, 293, 296, 295, 298, 303, 302, 309, 311,
+ 313, 315, 317, 319, 321, 326, 328, 333, 335, 341,
+ 343, 348, 350, 352, 354, 356, 358, 361, 363, 368,
+ 370, 372, 374, 376, 378, 380, 382, 388, 390, 396,
+ 395, 398, 401, 403, 408, 410, 413, 415, 421, 420,
+ 423, 426, 428, 433, 435, 438, 440, 446, 445, 448,
+ 451, 453, 458, 460, 463, 465, 471, 470, 473, 476,
+ 478, 483, 485, 488, 490, 496, 495, 498, 501, 503,
+ 508, 510, 513, 515, 521, 520, 523, 526, 528, 533,
+ 535, 537, 539, 541, 543
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE
+/* YYTNME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+ First, the terminals, then, starting at YYNTOKENS, nonterminals. */
+static const char *const yytname[] =
+{
+ "$end", "error", "$undefined", "LEFT", "RIGHT", "NUMBER", "FIX",
+ "COMMENT", "CHECKSUM", "DESIGNSIZE", "DESIGNUNITS", "CODINGSCHEME",
+ "FAMILY", "FACE", "SEVENBITSAFEFLAG", "HEADER", "FONTDIMEN", "LIGTABLE",
+ "BOUNDARYCHAR", "CHARACTER", "NAMEDPARAMETER", "PARAMETER",
+ "CHARMEASURE", "NEXTLARGER", "VARCHAR", "EXTEN", "LABEL", "LIG", "KRN",
+ "STOP", "SKIP", "VTITLE", "MAPFONT", "FONTNAME", "FONTAREA",
+ "FONTCHECKSUM", "FONTAT", "FONTDSIZE", "MAP", "SELECTFONT", "SETCHAR",
+ "SETRULE", "MOVE", "PUSH", "POP", "SPECIAL", "SPECIALHEX", "CHARREPEAT",
+ "FONTIVALUE", "FONTFVALUE", "FONTMVALUE", "FONTPENALTY", "FONTRULE",
+ "FONTGLUE", "CLABEL", "CKRN", "CGLUE", "CPENALTY", "CPENGLUE",
+ "CHARIVALUE", "CHARFVALUE", "CHARMVALUE", "CHARPENALTY", "CHARRULE",
+ "CHARGLUE", "IVALUE", "IVALUEVAL", "MVALUE", "MVALUEVAL", "FVALUE",
+ "FVALUEVAL", "PENALTY", "PENALTYVAL", "RULE", "RULEMEASURE", "GLUE",
+ "GLUEWD", "GLUETYPE", "GLUEKIND", "GLUERULE", "GLUECHAR",
+ "GLUESHRINKSTRETCH", "GLUEORDER", "OFMLEVEL", "FONTDIR", "ACCENT",
+ "$accept", "File", "Entries", "OneEntry", "@1", "@2", "@3", "@4", "@5",
+ "@6", "@7", "@8", "@9", "@10", "@11", "FontParameters",
+ "OneFontParameter", "LigKernEntries", "OneLigKernEntry",
+ "CharacterEntries", "OneCharacterEntry", "@12", "@13",
+ "VarCharParameters", "OneVarCharParameter", "MapFontEntries",
+ "OneMapFontEntry", "MapEntries", "OneMapEntry", "FontIvalueEntries",
+ "OneFontIvalueEntry", "@14", "IvalueDefinition", "OneIvalueDefinition",
+ "FontMvalueEntries", "OneFontMvalueEntry", "@15", "MvalueDefinition",
+ "OneMvalueDefinition", "FontFvalueEntries", "OneFontFvalueEntry", "@16",
+ "FvalueDefinition", "OneFvalueDefinition", "FontPenaltyEntries",
+ "OneFontPenaltyEntry", "@17", "PenaltyDefinition",
+ "OnePenaltyDefinition", "FontRuleEntries", "OneFontRuleEntry", "@18",
+ "RuleDefinition", "OneRuleDefinition", "FontGlueEntries",
+ "OneFontGlueEntry", "@19", "GlueDefinition", "OneGlueDefinition", 0
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+ token YYLEX-NUM. */
+static const unsigned short yytoknum[] =
+{
+ 0, 256, 257, 258, 259, 260, 261, 262, 263, 264,
+ 265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
+ 275, 276, 277, 278, 279, 280, 281, 282, 283, 284,
+ 285, 286, 287, 288, 289, 290, 291, 292, 293, 294,
+ 295, 296, 297, 298, 299, 300, 301, 302, 303, 304,
+ 305, 306, 307, 308, 309, 310, 311, 312, 313, 314,
+ 315, 316, 317, 318, 319, 320, 321, 322, 323, 324,
+ 325, 326, 327, 328, 329, 330, 331, 332, 333, 334,
+ 335, 336, 337, 338, 339, 340
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
+static const unsigned char yyr1[] =
+{
+ 0, 86, 87, 88, 88, 89, 89, 89, 89, 89,
+ 89, 89, 89, 90, 89, 91, 89, 89, 92, 89,
+ 89, 89, 93, 89, 89, 89, 94, 89, 95, 89,
+ 96, 89, 97, 89, 98, 89, 99, 89, 100, 89,
+ 101, 101, 102, 102, 102, 103, 103, 104, 104, 104,
+ 104, 104, 104, 104, 104, 104, 104, 104, 104, 105,
+ 105, 106, 106, 107, 106, 106, 108, 106, 106, 106,
+ 106, 106, 106, 106, 106, 109, 109, 110, 110, 111,
+ 111, 112, 112, 112, 112, 112, 112, 113, 113, 114,
+ 114, 114, 114, 114, 114, 114, 114, 115, 115, 117,
+ 116, 116, 118, 118, 119, 119, 120, 120, 122, 121,
+ 121, 123, 123, 124, 124, 125, 125, 127, 126, 126,
+ 128, 128, 129, 129, 130, 130, 132, 131, 131, 133,
+ 133, 134, 134, 135, 135, 137, 136, 136, 138, 138,
+ 139, 139, 140, 140, 142, 141, 141, 143, 143, 144,
+ 144, 144, 144, 144, 144
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */
+static const unsigned char yyr2[] =
+{
+ 0, 2, 1, 0, 4, 2, 2, 2, 1, 1,
+ 2, 1, 3, 0, 3, 0, 3, 2, 0, 4,
+ 1, 1, 0, 4, 2, 1, 0, 5, 0, 4,
+ 0, 4, 0, 4, 0, 4, 0, 4, 0, 4,
+ 0, 4, 2, 3, 1, 0, 4, 2, 2, 3,
+ 3, 1, 2, 1, 2, 3, 3, 3, 4, 0,
+ 4, 2, 2, 0, 3, 1, 0, 3, 1, 3,
+ 3, 3, 3, 3, 3, 0, 4, 2, 1, 0,
+ 4, 1, 1, 2, 2, 2, 1, 0, 4, 2,
+ 2, 3, 2, 1, 1, 1, 1, 0, 4, 0,
+ 4, 1, 0, 4, 2, 1, 0, 4, 0, 4,
+ 1, 0, 4, 2, 1, 0, 4, 0, 4, 1,
+ 0, 4, 2, 1, 0, 4, 0, 4, 1, 0,
+ 4, 2, 1, 0, 4, 0, 4, 1, 0, 4,
+ 2, 1, 0, 4, 0, 4, 1, 0, 4, 2,
+ 2, 2, 3, 3, 1
+};
+
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+ STATE-NUM when YYTABLE doesn't specify something else to do. Zero
+ means the default is an error. */
+static const unsigned char yydefact[] =
+{
+ 3, 0, 2, 1, 0, 20, 0, 0, 0, 8,
+ 9, 0, 11, 0, 13, 15, 0, 0, 21, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 25, 0,
+ 5, 6, 7, 10, 0, 40, 45, 17, 18, 22,
+ 0, 28, 32, 30, 34, 36, 38, 24, 4, 12,
+ 14, 16, 59, 79, 26, 97, 115, 106, 124, 133,
+ 142, 0, 0, 19, 23, 59, 29, 33, 31, 35,
+ 37, 39, 44, 0, 0, 0, 53, 0, 0, 0,
+ 51, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 27, 0, 0, 0, 0, 0, 0, 42, 0, 41,
+ 47, 48, 0, 0, 52, 54, 0, 0, 0, 0,
+ 46, 65, 0, 0, 63, 66, 0, 0, 0, 0,
+ 0, 0, 68, 0, 86, 81, 82, 0, 0, 0,
+ 0, 101, 0, 0, 119, 0, 0, 110, 0, 0,
+ 128, 0, 0, 137, 0, 0, 146, 0, 0, 43,
+ 49, 50, 55, 56, 57, 0, 61, 62, 75, 87,
+ 0, 0, 0, 0, 0, 0, 60, 83, 84, 85,
+ 80, 99, 98, 117, 116, 108, 107, 126, 125, 135,
+ 134, 144, 143, 58, 64, 67, 69, 71, 70, 72,
+ 73, 74, 102, 120, 111, 129, 138, 147, 0, 0,
+ 100, 118, 109, 127, 136, 145, 78, 0, 0, 0,
+ 0, 0, 0, 93, 94, 95, 96, 0, 0, 0,
+ 0, 0, 0, 0, 77, 76, 89, 90, 0, 92,
+ 88, 105, 0, 0, 123, 0, 0, 114, 0, 0,
+ 132, 0, 0, 141, 0, 0, 154, 0, 0, 0,
+ 0, 0, 0, 91, 104, 103, 122, 121, 113, 112,
+ 131, 130, 140, 139, 150, 149, 0, 151, 0, 148,
+ 152, 153
+};
+
+/* YYDEFGOTO[NTERM-NUM]. */
+static const short yydefgoto[] =
+{
+ -1, 1, 2, 29, 35, 36, 52, 53, 65, 55,
+ 57, 56, 58, 59, 60, 50, 75, 51, 87, 63,
+ 123, 158, 159, 184, 208, 64, 130, 185, 217, 66,
+ 133, 192, 200, 233, 68, 139, 194, 202, 239, 67,
+ 136, 193, 201, 236, 69, 142, 195, 203, 242, 70,
+ 145, 196, 204, 245, 71, 148, 197, 205, 252
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+ STATE-NUM. */
+#define YYPACT_NINF -8
+static const short yypact[] =
+{
+ -8, 8, 9, -8, 11, -8, 4, 5, 29, -8,
+ -8, 34, -8, 35, -8, -8, 36, 39, -8, 40,
+ 41, 44, 46, 76, 77, 79, 81, 82, -8, 10,
+ -8, -8, -8, -8, 83, -8, -8, -8, -8, -8,
+ 84, -8, -8, -8, -8, -8, -8, -8, -8, -8,
+ 33, 80, -8, -8, -8, -8, -8, -8, -8, -8,
+ -8, 27, 72, 87, 88, -8, 89, 101, 102, 108,
+ 109, 118, -8, 116, 119, 121, -8, 32, 126, 127,
+ -8, 128, 129, 130, 131, 132, 133, 135, -7, 73,
+ 87, 0, -2, -1, 6, 3, -3, -8, 117, -8,
+ -8, -8, 136, 134, -8, -8, 137, 139, 140, 141,
+ -8, -8, 142, 144, -8, -8, 145, 146, 147, 148,
+ 149, 150, -8, 138, -8, -8, -8, 151, 152, 153,
+ 143, -8, 155, 157, -8, 158, 160, -8, 161, 163,
+ -8, 164, 166, -8, 167, 169, -8, 170, 172, -8,
+ -8, -8, -8, -8, -8, 173, -8, -8, -8, -8,
+ 174, 175, 176, 177, 178, 179, -8, -8, -8, -8,
+ -8, -8, -8, -8, -8, -8, -8, -8, -8, -8,
+ -8, -8, -8, -8, 154, 159, -8, -8, -8, -8,
+ -8, -8, -8, -8, -8, -8, -8, -8, 78, 74,
+ 162, 165, 168, 171, 182, 183, -8, 184, 186, 187,
+ 188, 181, 185, -8, -8, -8, -8, 190, 31, 26,
+ 25, -4, -5, -6, -8, -8, -8, -8, 189, -8,
+ -8, -8, 191, 193, -8, 192, 195, -8, 194, 197,
+ -8, 198, 200, -8, 196, 201, -8, 202, 99, 204,
+ 205, 206, 203, -8, -8, -8, -8, -8, -8, -8,
+ -8, -8, -8, -8, -8, -8, 208, -8, 106, -8,
+ -8, -8
+};
+
+/* YYPGOTO[NTERM-NUM]. */
+static const short yypgoto[] =
+{
+ -8, -8, -8, -8, -8, -8, -8, -8, -8, -8,
+ -8, -8, -8, -8, -8, -8, -8, -8, -8, 156,
+ -8, -8, -8, -8, -8, -8, -8, -8, -8, -8,
+ -8, -8, -8, -8, -8, -8, -8, -8, -8, -8,
+ -8, -8, -8, -8, -8, -8, -8, -8, -8, -8,
+ -8, -8, -8, -8, -8, -8, -8, -8, -8
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If
+ positive, shift that token. If negative, reduce the rule which
+ number is the opposite. If zero, do what YYDEFACT says.
+ If YYTABLE_NINF, syntax error. */
+#define YYTABLE_NINF -1
+static const unsigned short yytable[] =
+{
+ 111, 246, 243, 240, 146, 134, 137, 131, 3, 30,
+ 143, 31, 4, 140, 48, 112, 113, 114, 5, 6,
+ 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,
+ 17, 115, 237, 234, 72, 32, 61, 100, 231, 33,
+ 34, 37, 18, 19, 38, 39, 40, 73, 74, 41,
+ 101, 42, 116, 117, 118, 119, 120, 121, 20, 21,
+ 22, 23, 24, 25, 26, 132, 138, 135, 241, 244,
+ 247, 248, 147, 249, 250, 251, 144, 141, 122, 76,
+ 124, 43, 44, 62, 45, 206, 46, 47, 49, 54,
+ 88, 89, 91, 238, 27, 28, 235, 232, 77, 78,
+ 79, 80, 81, 207, 92, 93, 125, 126, 127, 128,
+ 129, 94, 95, 209, 210, 211, 212, 213, 214, 215,
+ 216, 96, 97, 149, 98, 99, 82, 83, 84, 85,
+ 86, 102, 103, 104, 105, 106, 107, 108, 109, 110,
+ 151, 150, 166, 152, 153, 154, 155, 170, 156, 157,
+ 160, 161, 162, 163, 164, 165, 167, 198, 168, 169,
+ 171, 172, 199, 173, 174, 218, 175, 176, 219, 177,
+ 178, 220, 179, 180, 221, 181, 182, 265, 183, 186,
+ 187, 188, 189, 190, 191, 222, 223, 228, 271, 224,
+ 225, 229, 226, 227, 230, 253, 254, 255, 256, 257,
+ 258, 259, 262, 260, 261, 263, 0, 269, 264, 266,
+ 267, 0, 268, 270, 0, 0, 0, 0, 0, 0,
+ 0, 90
+};
+
+static const yysigned_char yycheck[] =
+{
+ 7, 7, 7, 7, 7, 7, 7, 7, 0, 5,
+ 7, 6, 3, 7, 4, 22, 23, 24, 7, 8,
+ 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,
+ 19, 38, 7, 7, 7, 6, 3, 5, 7, 5,
+ 5, 5, 31, 32, 5, 5, 5, 20, 21, 5,
+ 18, 5, 59, 60, 61, 62, 63, 64, 47, 48,
+ 49, 50, 51, 52, 53, 65, 67, 69, 72, 74,
+ 76, 77, 75, 79, 80, 81, 73, 71, 85, 7,
+ 7, 5, 5, 3, 5, 7, 5, 5, 5, 5,
+ 3, 3, 3, 68, 83, 84, 70, 66, 26, 27,
+ 28, 29, 30, 25, 3, 3, 33, 34, 35, 36,
+ 37, 3, 3, 39, 40, 41, 42, 43, 44, 45,
+ 46, 3, 6, 6, 5, 4, 54, 55, 56, 57,
+ 58, 5, 5, 5, 5, 5, 5, 5, 5, 4,
+ 6, 5, 4, 6, 5, 5, 5, 4, 6, 5,
+ 5, 5, 5, 5, 5, 5, 5, 3, 6, 6,
+ 5, 4, 3, 5, 4, 3, 5, 4, 3, 5,
+ 4, 3, 5, 4, 3, 5, 4, 78, 5, 5,
+ 5, 5, 5, 5, 5, 3, 3, 6, 82, 5,
+ 4, 6, 5, 5, 4, 6, 5, 4, 6, 4,
+ 6, 4, 6, 5, 4, 4, -1, 4, 6, 5,
+ 5, -1, 6, 5, -1, -1, -1, -1, -1, -1,
+ -1, 65
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+ symbol of state STATE-NUM. */
+static const unsigned char yystos[] =
+{
+ 0, 87, 88, 0, 3, 7, 8, 9, 10, 11,
+ 12, 13, 14, 15, 16, 17, 18, 19, 31, 32,
+ 47, 48, 49, 50, 51, 52, 53, 83, 84, 89,
+ 5, 6, 6, 5, 5, 90, 91, 5, 5, 5,
+ 5, 5, 5, 5, 5, 5, 5, 5, 4, 5,
+ 101, 103, 92, 93, 5, 95, 97, 96, 98, 99,
+ 100, 3, 3, 105, 111, 94, 115, 125, 120, 130,
+ 135, 140, 7, 20, 21, 102, 7, 26, 27, 28,
+ 29, 30, 54, 55, 56, 57, 58, 104, 3, 3,
+ 105, 3, 3, 3, 3, 3, 3, 6, 5, 4,
+ 5, 18, 5, 5, 5, 5, 5, 5, 5, 5,
+ 4, 7, 22, 23, 24, 38, 59, 60, 61, 62,
+ 63, 64, 85, 106, 7, 33, 34, 35, 36, 37,
+ 112, 7, 65, 116, 7, 69, 126, 7, 67, 121,
+ 7, 71, 131, 7, 73, 136, 7, 75, 141, 6,
+ 5, 6, 6, 5, 5, 5, 6, 5, 107, 108,
+ 5, 5, 5, 5, 5, 5, 4, 5, 6, 6,
+ 4, 5, 4, 5, 4, 5, 4, 5, 4, 5,
+ 4, 5, 4, 5, 109, 113, 5, 5, 5, 5,
+ 5, 5, 117, 127, 122, 132, 137, 142, 3, 3,
+ 118, 128, 123, 133, 138, 143, 7, 25, 110, 39,
+ 40, 41, 42, 43, 44, 45, 46, 114, 3, 3,
+ 3, 3, 3, 3, 5, 4, 5, 5, 6, 6,
+ 4, 7, 66, 119, 7, 70, 129, 7, 68, 124,
+ 7, 72, 134, 7, 74, 139, 7, 76, 77, 79,
+ 80, 81, 144, 6, 5, 4, 6, 4, 6, 4,
+ 5, 4, 6, 4, 6, 78, 5, 5, 6, 4,
+ 5, 82
+};
+
+#if ! defined (YYSIZE_T) && defined (__SIZE_TYPE__)
+# define YYSIZE_T __SIZE_TYPE__
+#endif
+#if ! defined (YYSIZE_T) && defined (size_t)
+# define YYSIZE_T size_t
+#endif
+#if ! defined (YYSIZE_T)
+# if defined (__STDC__) || defined (__cplusplus)
+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
+# endif
+#endif
+#if ! defined (YYSIZE_T)
+# define YYSIZE_T unsigned int
+#endif
+
+#define yyerrok (yyerrstatus = 0)
+#define yyclearin (yychar = YYEMPTY)
+#define YYEMPTY (-2)
+#define YYEOF 0
+
+#define YYACCEPT goto yyacceptlab
+#define YYABORT goto yyabortlab
+#define YYERROR goto yyerrlab1
+
+
+/* Like YYERROR except do call yyerror. This remains here temporarily
+ to ease the transition to the new meaning of YYERROR, for GCC.
+ Once GCC version 2 has supplanted version 1, this can go. */
+
+#define YYFAIL goto yyerrlab
+
+#define YYRECOVERING() (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value) \
+do \
+ if (yychar == YYEMPTY && yylen == 1) \
+ { \
+ yychar = (Token); \
+ yylval = (Value); \
+ yytoken = YYTRANSLATE (yychar); \
+ YYPOPSTACK; \
+ goto yybackup; \
+ } \
+ else \
+ { \
+ yyerror ("syntax error: cannot back up");\
+ YYERROR; \
+ } \
+while (0)
+
+#define YYTERROR 1
+#define YYERRCODE 256
+
+/* YYLLOC_DEFAULT -- Compute the default location (before the actions
+ are run). */
+
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N) \
+ Current.first_line = Rhs[1].first_line; \
+ Current.first_column = Rhs[1].first_column; \
+ Current.last_line = Rhs[N].last_line; \
+ Current.last_column = Rhs[N].last_column;
+#endif
+
+/* YYLEX -- calling `yylex' with the right arguments. */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested. */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+# include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+# define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args) \
+do { \
+ if (yydebug) \
+ YYFPRINTF Args; \
+} while (0)
+
+# define YYDSYMPRINT(Args) \
+do { \
+ if (yydebug) \
+ yysymprint Args; \
+} while (0)
+
+# define YYDSYMPRINTF(Title, Token, Value, Location) \
+do { \
+ if (yydebug) \
+ { \
+ YYFPRINTF (stderr, "%s ", Title); \
+ yysymprint (stderr, \
+ Token, Value); \
+ YYFPRINTF (stderr, "\n"); \
+ } \
+} while (0)
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (cinluded). |
+`------------------------------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yy_stack_print (short *bottom, short *top)
+#else
+static void
+yy_stack_print (bottom, top)
+ short *bottom;
+ short *top;
+#endif
+{
+ YYFPRINTF (stderr, "Stack now");
+ for (/* Nothing. */; bottom <= top; ++bottom)
+ YYFPRINTF (stderr, " %d", *bottom);
+ YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top) \
+do { \
+ if (yydebug) \
+ yy_stack_print ((Bottom), (Top)); \
+} while (0)
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced. |
+`------------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yy_reduce_print (int yyrule)
+#else
+static void
+yy_reduce_print (yyrule)
+ int yyrule;
+#endif
+{
+ int yyi;
+ unsigned int yylineno = yyrline[yyrule];
+ YYFPRINTF (stderr, "Reducing stack by rule %d (line %u), ",
+ yyrule - 1, yylineno);
+ /* Print the symbols being reduced, and their result. */
+ for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
+ YYFPRINTF (stderr, "%s ", yytname [yyrhs[yyi]]);
+ YYFPRINTF (stderr, "-> %s\n", yytname [yyr1[yyrule]]);
+}
+
+# define YY_REDUCE_PRINT(Rule) \
+do { \
+ if (yydebug) \
+ yy_reduce_print (Rule); \
+} while (0)
+
+/* Nonzero means print parse trace. It is left uninitialized so that
+ multiple parsers can coexist. */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YYDSYMPRINT(Args)
+# define YYDSYMPRINTF(Title, Token, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks. */
+#ifndef YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+ if the built-in stack extension method is used).
+
+ Do not make this value too large; the results are undefined if
+ SIZE_MAX < YYSTACK_BYTES (YYMAXDEPTH)
+ evaluated with infinite-precision integer arithmetic. */
+
+#if YYMAXDEPTH == 0
+# undef YYMAXDEPTH
+#endif
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+# if defined (__GLIBC__) && defined (_STRING_H)
+# define yystrlen strlen
+# else
+/* Return the length of YYSTR. */
+static YYSIZE_T
+# if defined (__STDC__) || defined (__cplusplus)
+yystrlen (const char *yystr)
+# else
+yystrlen (yystr)
+ const char *yystr;
+# endif
+{
+ register const char *yys = yystr;
+
+ while (*yys++ != '\0')
+ continue;
+
+ return yys - yystr - 1;
+}
+# endif
+# endif
+
+# ifndef yystpcpy
+# if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
+# define yystpcpy stpcpy
+# else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+ YYDEST. */
+static char *
+# if defined (__STDC__) || defined (__cplusplus)
+yystpcpy (char *yydest, const char *yysrc)
+# else
+yystpcpy (yydest, yysrc)
+ char *yydest;
+ const char *yysrc;
+# endif
+{
+ register char *yyd = yydest;
+ register const char *yys = yysrc;
+
+ while ((*yyd++ = *yys++) != '\0')
+ continue;
+
+ return yyd - 1;
+}
+# endif
+# endif
+
+#endif /* !YYERROR_VERBOSE */
+
+
+
+#if YYDEBUG
+/*--------------------------------.
+| Print this symbol on YYOUTPUT. |
+`--------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yysymprint (FILE *yyoutput, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yysymprint (yyoutput, yytype, yyvaluep)
+ FILE *yyoutput;
+ int yytype;
+ YYSTYPE *yyvaluep;
+#endif
+{
+ /* Pacify ``unused variable'' warnings. */
+ (void) yyvaluep;
+
+ if (yytype < YYNTOKENS)
+ {
+ YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+# ifdef YYPRINT
+ YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# endif
+ }
+ else
+ YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+ switch (yytype)
+ {
+ default:
+ break;
+ }
+ YYFPRINTF (yyoutput, ")");
+}
+
+#endif /* ! YYDEBUG */
+/*-----------------------------------------------.
+| Release the memory associated to this symbol. |
+`-----------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yydestruct (int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yytype, yyvaluep)
+ int yytype;
+ YYSTYPE *yyvaluep;
+#endif
+{
+ /* Pacify ``unused variable'' warnings. */
+ (void) yyvaluep;
+
+ switch (yytype)
+ {
+
+ default:
+ break;
+ }
+}
+
+
+/* Prevent warnings from -Wmissing-prototypes. */
+
+#ifdef YYPARSE_PARAM
+# if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void *YYPARSE_PARAM);
+# else
+int yyparse ();
+# endif
+#else /* ! YYPARSE_PARAM */
+#if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The lookahead symbol. */
+int yychar;
+
+/* The semantic value of the lookahead symbol. */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far. */
+int yynerrs;
+
+
+
+/*----------.
+| yyparse. |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+# if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void *YYPARSE_PARAM)
+# else
+int yyparse (YYPARSE_PARAM)
+ void *YYPARSE_PARAM;
+# endif
+#else /* ! YYPARSE_PARAM */
+#if defined (__STDC__) || defined (__cplusplus)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+
+ register int yystate;
+ register int yyn;
+ int yyresult;
+ /* Number of tokens to shift before error messages enabled. */
+ int yyerrstatus;
+ /* Lookahead token as an internal (translated) token number. */
+ int yytoken = 0;
+
+ /* Three stacks and their tools:
+ `yyss': related to states,
+ `yyvs': related to semantic values,
+ `yyls': related to locations.
+
+ Refer to the stacks thru separate pointers, to allow yyoverflow
+ to reallocate them elsewhere. */
+
+ /* The state stack. */
+ short yyssa[YYINITDEPTH];
+ short *yyss = yyssa;
+ register short *yyssp;
+
+ /* The semantic value stack. */
+ YYSTYPE yyvsa[YYINITDEPTH];
+ YYSTYPE *yyvs = yyvsa;
+ register YYSTYPE *yyvsp;
+
+
+
+#define YYPOPSTACK (yyvsp--, yyssp--)
+
+ YYSIZE_T yystacksize = YYINITDEPTH;
+
+ /* The variables used to return semantic value and location from the
+ action routines. */
+ YYSTYPE yyval;
+
+
+ /* When reducing, the number of symbols on the RHS of the reduced
+ rule. */
+ int yylen;
+
+ YYDPRINTF ((stderr, "Starting parse\n"));
+
+ yystate = 0;
+ yyerrstatus = 0;
+ yynerrs = 0;
+ yychar = YYEMPTY; /* Cause a token to be read. */
+
+ /* Initialize stack pointers.
+ Waste one element of value and location stack
+ so that they stay on the same level as the state stack.
+ The wasted elements are never initialized. */
+
+ yyssp = yyss;
+ yyvsp = yyvs;
+
+ goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate. |
+`------------------------------------------------------------*/
+ yynewstate:
+ /* In all cases, when you get here, the value and location stacks
+ have just been pushed. so pushing a state here evens the stacks.
+ */
+ yyssp++;
+
+ yysetstate:
+ *yyssp = yystate;
+
+ if (yyss + yystacksize - 1 <= yyssp)
+ {
+ /* Get the current used size of the three stacks, in elements. */
+ YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+ {
+ /* Give user a chance to reallocate the stack. Use copies of
+ these so that the &'s don't force the real ones into
+ memory. */
+ YYSTYPE *yyvs1 = yyvs;
+ short *yyss1 = yyss;
+
+
+ /* Each stack pointer address is followed by the size of the
+ data in use in that stack, in bytes. This used to be a
+ conditional around just the two extra args, but that might
+ be undefined if yyoverflow is a macro. */
+ yyoverflow ("parser stack overflow",
+ &yyss1, yysize * sizeof (*yyssp),
+ &yyvs1, yysize * sizeof (*yyvsp),
+
+ &yystacksize);
+
+ yyss = yyss1;
+ yyvs = yyvs1;
+ }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+ goto yyoverflowlab;
+# else
+ /* Extend the stack our own way. */
+ if (YYMAXDEPTH <= yystacksize)
+ goto yyoverflowlab;
+ yystacksize *= 2;
+ if (YYMAXDEPTH < yystacksize)
+ yystacksize = YYMAXDEPTH;
+
+ {
+ short *yyss1 = yyss;
+ union yyalloc *yyptr =
+ (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+ if (! yyptr)
+ goto yyoverflowlab;
+ YYSTACK_RELOCATE (yyss);
+ YYSTACK_RELOCATE (yyvs);
+
+# undef YYSTACK_RELOCATE
+ if (yyss1 != yyssa)
+ YYSTACK_FREE (yyss1);
+ }
+# endif
+#endif /* no yyoverflow */
+
+ yyssp = yyss + yysize - 1;
+ yyvsp = yyvs + yysize - 1;
+
+
+ YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+ (unsigned long int) yystacksize));
+
+ if (yyss + yystacksize - 1 <= yyssp)
+ YYABORT;
+ }
+
+ YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+ goto yybackup;
+
+/*-----------.
+| yybackup. |
+`-----------*/
+yybackup:
+
+/* Do appropriate processing given the current state. */
+/* Read a lookahead token if we need one and don't already have one. */
+/* yyresume: */
+
+ /* First try to decide what to do without reference to lookahead token. */
+
+ yyn = yypact[yystate];
+ if (yyn == YYPACT_NINF)
+ goto yydefault;
+
+ /* Not known => get a lookahead token if don't already have one. */
+
+ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
+ if (yychar == YYEMPTY)
+ {
+ YYDPRINTF ((stderr, "Reading a token: "));
+ yychar = YYLEX;
+ }
+
+ if (yychar <= YYEOF)
+ {
+ yychar = yytoken = YYEOF;
+ YYDPRINTF ((stderr, "Now at end of input.\n"));
+ }
+ else
+ {
+ yytoken = YYTRANSLATE (yychar);
+ YYDSYMPRINTF ("Next token is", yytoken, &yylval, &yylloc);
+ }
+
+ /* If the proper action on seeing token YYTOKEN is to reduce or to
+ detect an error, take that action. */
+ yyn += yytoken;
+ if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+ goto yydefault;
+ yyn = yytable[yyn];
+ if (yyn <= 0)
+ {
+ if (yyn == 0 || yyn == YYTABLE_NINF)
+ goto yyerrlab;
+ yyn = -yyn;
+ goto yyreduce;
+ }
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ /* Shift the lookahead token. */
+ YYDPRINTF ((stderr, "Shifting token %s, ", yytname[yytoken]));
+
+ /* Discard the token being shifted unless it is eof. */
+ if (yychar != YYEOF)
+ yychar = YYEMPTY;
+
+ *++yyvsp = yylval;
+
+
+ /* Count tokens shifted since error; after three, turn off error
+ status. */
+ if (yyerrstatus)
+ yyerrstatus--;
+
+ yystate = yyn;
+ goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state. |
+`-----------------------------------------------------------*/
+yydefault:
+ yyn = yydefact[yystate];
+ if (yyn == 0)
+ goto yyerrlab;
+ goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction. |
+`-----------------------------*/
+yyreduce:
+ /* yyn is the number of a rule to reduce with. */
+ yylen = yyr2[yyn];
+
+ /* If YYLEN is nonzero, implement the default value of the action:
+ `$$ = $1'.
+
+ Otherwise, the following line sets YYVAL to garbage.
+ This behavior is undocumented and Bison
+ users should not rely upon it. Assigning to YYVAL
+ unconditionally makes the parser a bit smaller, and it avoids a
+ GCC warning that YYVAL may be used uninitialized. */
+ yyval = yyvsp[1-yylen];
+
+
+ YY_REDUCE_PRINT (yyn);
+ switch (yyn)
+ {
+ case 5:
+#line 169 "./pl.y"
+ { set_check_sum(yyvsp[0].yint); }
+ break;
+
+ case 6:
+#line 171 "./pl.y"
+ { set_design_size(yyvsp[0].yfix); }
+ break;
+
+ case 7:
+#line 173 "./pl.y"
+ { set_design_units(yyvsp[0].yfix); }
+ break;
+
+ case 8:
+#line 175 "./pl.y"
+ { set_coding_scheme(yyvsp[0].ystring); }
+ break;
+
+ case 9:
+#line 177 "./pl.y"
+ { set_family(yyvsp[0].ystring); }
+ break;
+
+ case 10:
+#line 179 "./pl.y"
+ { set_face(yyvsp[0].yint); }
+ break;
+
+ case 11:
+#line 181 "./pl.y"
+ { set_seven_bit_safe_flag(yyvsp[0].yint); }
+ break;
+
+ case 12:
+#line 183 "./pl.y"
+ { set_header_word(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 13:
+#line 185 "./pl.y"
+ { init_parameters(); }
+ break;
+
+ case 15:
+#line 188 "./pl.y"
+ { init_ligkern(); }
+ break;
+
+ case 17:
+#line 191 "./pl.y"
+ { set_boundary_character(yyvsp[0].yint); }
+ break;
+
+ case 18:
+#line 193 "./pl.y"
+ { init_character(yyvsp[0].yint, NULL); }
+ break;
+
+ case 21:
+#line 200 "./pl.y"
+ { set_vtitle(yyvsp[0].ystring); }
+ break;
+
+ case 22:
+#line 202 "./pl.y"
+ { init_map_font(yyvsp[0].yint); }
+ break;
+
+ case 24:
+#line 208 "./pl.y"
+ { set_ofm_level(yyvsp[0].yint); }
+ break;
+
+ case 25:
+#line 210 "./pl.y"
+ { set_font_dir(yyvsp[0].yint); }
+ break;
+
+ case 26:
+#line 212 "./pl.y"
+ { init_character(yyvsp[-1].yint,NULL); }
+ break;
+
+ case 27:
+#line 214 "./pl.y"
+ { copy_characters(yyvsp[-3].yint,yyvsp[-2].yint); }
+ break;
+
+ case 28:
+#line 216 "./pl.y"
+ {init_font_ivalue(yyvsp[0].yint);}
+ break;
+
+ case 30:
+#line 219 "./pl.y"
+ { init_font_mvalue(yyvsp[0].yint);}
+ break;
+
+ case 32:
+#line 222 "./pl.y"
+ { init_font_fvalue(yyvsp[0].yint);}
+ break;
+
+ case 34:
+#line 225 "./pl.y"
+ { init_font_penalty(yyvsp[0].yint);}
+ break;
+
+ case 36:
+#line 228 "./pl.y"
+ { init_font_rule(yyvsp[0].yint);}
+ break;
+
+ case 38:
+#line 231 "./pl.y"
+ { init_font_glue(yyvsp[0].yint);}
+ break;
+
+ case 42:
+#line 243 "./pl.y"
+ { set_param_word(yyvsp[-1].yint, yyvsp[0].yfix); }
+ break;
+
+ case 43:
+#line 245 "./pl.y"
+ { set_param_word(yyvsp[-1].yint, yyvsp[0].yfix); }
+ break;
+
+ case 47:
+#line 257 "./pl.y"
+ { set_label_command(yyvsp[0].yint); }
+ break;
+
+ case 48:
+#line 259 "./pl.y"
+ { set_label_command(CHAR_BOUNDARY); }
+ break;
+
+ case 49:
+#line 261 "./pl.y"
+ { set_ligature_command(yyvsp[-2].yint, yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 50:
+#line 263 "./pl.y"
+ { set_kerning_command(yyvsp[-1].yint, yyvsp[0].yfix); }
+ break;
+
+ case 51:
+#line 265 "./pl.y"
+ { set_stop_command(); }
+ break;
+
+ case 52:
+#line 267 "./pl.y"
+ { set_skip_command(yyvsp[0].yint); }
+ break;
+
+ case 54:
+#line 273 "./pl.y"
+ { set_c_label_command(yyvsp[0].yint); }
+ break;
+
+ case 55:
+#line 275 "./pl.y"
+ { set_c_kerning_command(yyvsp[-1].yint, yyvsp[0].yfix); }
+ break;
+
+ case 56:
+#line 277 "./pl.y"
+ { set_c_glue_command(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 57:
+#line 279 "./pl.y"
+ { set_c_penalty_command(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 58:
+#line 281 "./pl.y"
+ { set_c_penglue_command(yyvsp[-2].yint, yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 61:
+#line 292 "./pl.y"
+ { set_character_measure(yyvsp[-1].yint, yyvsp[0].yfix); }
+ break;
+
+ case 62:
+#line 294 "./pl.y"
+ { set_next_larger(yyvsp[0].yint); }
+ break;
+
+ case 63:
+#line 296 "./pl.y"
+ { init_var_character(); }
+ break;
+
+ case 66:
+#line 303 "./pl.y"
+ { init_map(); }
+ break;
+
+ case 67:
+#line 305 "./pl.y"
+ { end_map(); }
+ break;
+
+ case 68:
+#line 310 "./pl.y"
+ { set_accent(yyvsp[0].yint); }
+ break;
+
+ case 69:
+#line 312 "./pl.y"
+ { set_character_ivalue(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 70:
+#line 314 "./pl.y"
+ { set_character_mvalue(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 71:
+#line 316 "./pl.y"
+ { set_character_fvalue(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 72:
+#line 318 "./pl.y"
+ { set_character_penalty(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 73:
+#line 320 "./pl.y"
+ { set_character_rule(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 74:
+#line 322 "./pl.y"
+ { set_character_glue(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 77:
+#line 334 "./pl.y"
+ { set_extensible_piece(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 81:
+#line 349 "./pl.y"
+ { set_font_name(yyvsp[0].ystring); }
+ break;
+
+ case 82:
+#line 351 "./pl.y"
+ { set_font_area(yyvsp[0].ystring); }
+ break;
+
+ case 83:
+#line 353 "./pl.y"
+ { set_font_check_sum(yyvsp[0].yint); }
+ break;
+
+ case 84:
+#line 355 "./pl.y"
+ { set_font_at(yyvsp[0].yfix); }
+ break;
+
+ case 85:
+#line 357 "./pl.y"
+ { set_font_design_size(yyvsp[0].yfix); }
+ break;
+
+ case 89:
+#line 369 "./pl.y"
+ { set_select_font(yyvsp[0].yint); }
+ break;
+
+ case 90:
+#line 371 "./pl.y"
+ { set_set_char(yyvsp[0].yint); }
+ break;
+
+ case 91:
+#line 373 "./pl.y"
+ { set_set_rule(yyvsp[-1].yfix, yyvsp[0].yfix); }
+ break;
+
+ case 92:
+#line 375 "./pl.y"
+ { set_move(yyvsp[-1].yint, yyvsp[0].yfix); }
+ break;
+
+ case 93:
+#line 377 "./pl.y"
+ { set_push(); }
+ break;
+
+ case 94:
+#line 379 "./pl.y"
+ { set_pop(); }
+ break;
+
+ case 95:
+#line 381 "./pl.y"
+ { set_special(yyvsp[0].ystring); }
+ break;
+
+ case 96:
+#line 383 "./pl.y"
+ { set_special_hex(yyvsp[0].ystring); }
+ break;
+
+ case 99:
+#line 396 "./pl.y"
+ { init_font_ivalue_entry(yyvsp[0].yint); }
+ break;
+
+ case 104:
+#line 409 "./pl.y"
+ { set_font_ivalue_definition(yyvsp[0].yint); }
+ break;
+
+ case 108:
+#line 421 "./pl.y"
+ { init_font_mvalue_entry(yyvsp[0].yint); }
+ break;
+
+ case 113:
+#line 434 "./pl.y"
+ { set_font_mvalue_definition(yyvsp[0].yfix); }
+ break;
+
+ case 117:
+#line 446 "./pl.y"
+ { init_font_fvalue_entry(yyvsp[0].yint); }
+ break;
+
+ case 122:
+#line 459 "./pl.y"
+ { set_font_fvalue_definition(yyvsp[0].yfix); }
+ break;
+
+ case 126:
+#line 471 "./pl.y"
+ { init_font_penalty_entry(yyvsp[0].yint); }
+ break;
+
+ case 131:
+#line 484 "./pl.y"
+ { set_font_penalty_definition(yyvsp[0].yint); }
+ break;
+
+ case 135:
+#line 496 "./pl.y"
+ { init_font_rule_entry(yyvsp[0].yint); }
+ break;
+
+ case 140:
+#line 509 "./pl.y"
+ { set_font_rule_measure(yyvsp[-1].yint, yyvsp[0].yfix); }
+ break;
+
+ case 144:
+#line 521 "./pl.y"
+ { init_font_glue_entry(yyvsp[0].yint); }
+ break;
+
+ case 149:
+#line 534 "./pl.y"
+ { set_font_glue_type(yyvsp[0].yint); }
+ break;
+
+ case 150:
+#line 536 "./pl.y"
+ { set_font_glue_width(yyvsp[0].yfix); }
+ break;
+
+ case 151:
+#line 538 "./pl.y"
+ { set_font_glue_character(yyvsp[0].yint); }
+ break;
+
+ case 152:
+#line 540 "./pl.y"
+ { set_font_glue_rule(yyvsp[-1].yint, yyvsp[0].yint); }
+ break;
+
+ case 153:
+#line 542 "./pl.y"
+ { set_font_glue_shrink_stretch(yyvsp[-2].yint, yyvsp[-1].yfix, yyvsp[0].yint); }
+ break;
+
+
+ }
+
+/* Line 999 of yacc.c. */
+#line 1837 "y.tab.c"
+
+ yyvsp -= yylen;
+ yyssp -= yylen;
+
+
+ YY_STACK_PRINT (yyss, yyssp);
+
+ *++yyvsp = yyval;
+
+
+ /* Now `shift' the result of the reduction. Determine what state
+ that goes to, based on the state we popped back to and the rule
+ number reduced by. */
+
+ yyn = yyr1[yyn];
+
+ yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+ if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+ yystate = yytable[yystate];
+ else
+ yystate = yydefgoto[yyn - YYNTOKENS];
+
+ goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+ /* If not already recovering from an error, report this error. */
+ if (!yyerrstatus)
+ {
+ ++yynerrs;
+#if YYERROR_VERBOSE
+ yyn = yypact[yystate];
+
+ if (YYPACT_NINF < yyn && yyn < YYLAST)
+ {
+ YYSIZE_T yysize = 0;
+ int yytype = YYTRANSLATE (yychar);
+ char *yymsg;
+ int yyx, yycount;
+
+ yycount = 0;
+ /* Start YYX at -YYN if negative to avoid negative indexes in
+ YYCHECK. */
+ for (yyx = yyn < 0 ? -yyn : 0;
+ yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ yysize += yystrlen (yytname[yyx]) + 15, yycount++;
+ yysize += yystrlen ("syntax error, unexpected ") + 1;
+ yysize += yystrlen (yytname[yytype]);
+ yymsg = (char *) YYSTACK_ALLOC (yysize);
+ if (yymsg != 0)
+ {
+ char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
+ yyp = yystpcpy (yyp, yytname[yytype]);
+
+ if (yycount < 5)
+ {
+ yycount = 0;
+ for (yyx = yyn < 0 ? -yyn : 0;
+ yyx < (int) (sizeof (yytname) / sizeof (char *));
+ yyx++)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ {
+ const char *yyq = ! yycount ? ", expecting " : " or ";
+ yyp = yystpcpy (yyp, yyq);
+ yyp = yystpcpy (yyp, yytname[yyx]);
+ yycount++;
+ }
+ }
+ yyerror (yymsg);
+ YYSTACK_FREE (yymsg);
+ }
+ else
+ yyerror ("syntax error; also virtual memory exhausted");
+ }
+ else
+#endif /* YYERROR_VERBOSE */
+ yyerror ("syntax error");
+ }
+
+
+
+ if (yyerrstatus == 3)
+ {
+ /* If just tried and failed to reuse lookahead token after an
+ error, discard it. */
+
+ /* Return failure if at end of input. */
+ if (yychar == YYEOF)
+ {
+ /* Pop the error token. */
+ YYPOPSTACK;
+ /* Pop the rest of the stack. */
+ while (yyss < yyssp)
+ {
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
+ yydestruct (yystos[*yyssp], yyvsp);
+ YYPOPSTACK;
+ }
+ YYABORT;
+ }
+
+ YYDSYMPRINTF ("Error: discarding", yytoken, &yylval, &yylloc);
+ yydestruct (yytoken, &yylval);
+ yychar = YYEMPTY;
+
+ }
+
+ /* Else will try to reuse lookahead token after shifting the error
+ token. */
+ goto yyerrlab1;
+
+
+/*----------------------------------------------------.
+| yyerrlab1 -- error raised explicitly by an action. |
+`----------------------------------------------------*/
+yyerrlab1:
+ yyerrstatus = 3; /* Each real token shifted decrements this. */
+
+ for (;;)
+ {
+ yyn = yypact[yystate];
+ if (yyn != YYPACT_NINF)
+ {
+ yyn += YYTERROR;
+ if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+ {
+ yyn = yytable[yyn];
+ if (0 < yyn)
+ break;
+ }
+ }
+
+ /* Pop the current state because it cannot handle the error token. */
+ if (yyssp == yyss)
+ YYABORT;
+
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
+ yydestruct (yystos[yystate], yyvsp);
+ yyvsp--;
+ yystate = *--yyssp;
+
+ YY_STACK_PRINT (yyss, yyssp);
+ }
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ YYDPRINTF ((stderr, "Shifting error token, "));
+
+ *++yyvsp = yylval;
+
+
+ yystate = yyn;
+ goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here. |
+`-------------------------------------*/
+yyacceptlab:
+ yyresult = 0;
+ goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here. |
+`-----------------------------------*/
+yyabortlab:
+ yyresult = 1;
+ goto yyreturn;
+
+#ifndef yyoverflow
+/*----------------------------------------------.
+| yyoverflowlab -- parser overflow comes here. |
+`----------------------------------------------*/
+yyoverflowlab:
+ yyerror ("parser stack overflow");
+ yyresult = 2;
+ /* Fall through. */
+#endif
+
+yyreturn:
+#ifndef yyoverflow
+ if (yyss != yyssa)
+ YYSTACK_FREE (yyss);
+#endif
+ return yyresult;
+}
+
+
+
diff --git a/Build/source/texk/web2c/omegafonts/y_tab.h-dist b/Build/source/texk/web2c/omegafonts/y_tab.h-dist
new file mode 100644
index 00000000000..6c108f3e665
--- /dev/null
+++ b/Build/source/texk/web2c/omegafonts/y_tab.h-dist
@@ -0,0 +1,214 @@
+/* A Bison parser, made by GNU Bison 1.875a. */
+
+/* Skeleton parser for Yacc-like parsing with Bison,
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+/* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ LEFT = 258,
+ RIGHT = 259,
+ NUMBER = 260,
+ FIX = 261,
+ COMMENT = 262,
+ CHECKSUM = 263,
+ DESIGNSIZE = 264,
+ DESIGNUNITS = 265,
+ CODINGSCHEME = 266,
+ FAMILY = 267,
+ FACE = 268,
+ SEVENBITSAFEFLAG = 269,
+ HEADER = 270,
+ FONTDIMEN = 271,
+ LIGTABLE = 272,
+ BOUNDARYCHAR = 273,
+ CHARACTER = 274,
+ NAMEDPARAMETER = 275,
+ PARAMETER = 276,
+ CHARMEASURE = 277,
+ NEXTLARGER = 278,
+ VARCHAR = 279,
+ EXTEN = 280,
+ LABEL = 281,
+ LIG = 282,
+ KRN = 283,
+ STOP = 284,
+ SKIP = 285,
+ VTITLE = 286,
+ MAPFONT = 287,
+ FONTNAME = 288,
+ FONTAREA = 289,
+ FONTCHECKSUM = 290,
+ FONTAT = 291,
+ FONTDSIZE = 292,
+ MAP = 293,
+ SELECTFONT = 294,
+ SETCHAR = 295,
+ SETRULE = 296,
+ MOVE = 297,
+ PUSH = 298,
+ POP = 299,
+ SPECIAL = 300,
+ SPECIALHEX = 301,
+ CHARREPEAT = 302,
+ FONTIVALUE = 303,
+ FONTFVALUE = 304,
+ FONTMVALUE = 305,
+ FONTPENALTY = 306,
+ FONTRULE = 307,
+ FONTGLUE = 308,
+ CLABEL = 309,
+ CKRN = 310,
+ CGLUE = 311,
+ CPENALTY = 312,
+ CPENGLUE = 313,
+ CHARIVALUE = 314,
+ CHARFVALUE = 315,
+ CHARMVALUE = 316,
+ CHARPENALTY = 317,
+ CHARRULE = 318,
+ CHARGLUE = 319,
+ IVALUE = 320,
+ IVALUEVAL = 321,
+ MVALUE = 322,
+ MVALUEVAL = 323,
+ FVALUE = 324,
+ FVALUEVAL = 325,
+ PENALTY = 326,
+ PENALTYVAL = 327,
+ RULE = 328,
+ RULEMEASURE = 329,
+ GLUE = 330,
+ GLUEWD = 331,
+ GLUETYPE = 332,
+ GLUEKIND = 333,
+ GLUERULE = 334,
+ GLUECHAR = 335,
+ GLUESHRINKSTRETCH = 336,
+ GLUEORDER = 337,
+ OFMLEVEL = 338,
+ FONTDIR = 339,
+ ACCENT = 340
+ };
+#endif
+#define LEFT 258
+#define RIGHT 259
+#define NUMBER 260
+#define FIX 261
+#define COMMENT 262
+#define CHECKSUM 263
+#define DESIGNSIZE 264
+#define DESIGNUNITS 265
+#define CODINGSCHEME 266
+#define FAMILY 267
+#define FACE 268
+#define SEVENBITSAFEFLAG 269
+#define HEADER 270
+#define FONTDIMEN 271
+#define LIGTABLE 272
+#define BOUNDARYCHAR 273
+#define CHARACTER 274
+#define NAMEDPARAMETER 275
+#define PARAMETER 276
+#define CHARMEASURE 277
+#define NEXTLARGER 278
+#define VARCHAR 279
+#define EXTEN 280
+#define LABEL 281
+#define LIG 282
+#define KRN 283
+#define STOP 284
+#define SKIP 285
+#define VTITLE 286
+#define MAPFONT 287
+#define FONTNAME 288
+#define FONTAREA 289
+#define FONTCHECKSUM 290
+#define FONTAT 291
+#define FONTDSIZE 292
+#define MAP 293
+#define SELECTFONT 294
+#define SETCHAR 295
+#define SETRULE 296
+#define MOVE 297
+#define PUSH 298
+#define POP 299
+#define SPECIAL 300
+#define SPECIALHEX 301
+#define CHARREPEAT 302
+#define FONTIVALUE 303
+#define FONTFVALUE 304
+#define FONTMVALUE 305
+#define FONTPENALTY 306
+#define FONTRULE 307
+#define FONTGLUE 308
+#define CLABEL 309
+#define CKRN 310
+#define CGLUE 311
+#define CPENALTY 312
+#define CPENGLUE 313
+#define CHARIVALUE 314
+#define CHARFVALUE 315
+#define CHARMVALUE 316
+#define CHARPENALTY 317
+#define CHARRULE 318
+#define CHARGLUE 319
+#define IVALUE 320
+#define IVALUEVAL 321
+#define MVALUE 322
+#define MVALUEVAL 323
+#define FVALUE 324
+#define FVALUEVAL 325
+#define PENALTY 326
+#define PENALTYVAL 327
+#define RULE 328
+#define RULEMEASURE 329
+#define GLUE 330
+#define GLUEWD 331
+#define GLUETYPE 332
+#define GLUEKIND 333
+#define GLUERULE 334
+#define GLUECHAR 335
+#define GLUESHRINKSTRETCH 336
+#define GLUEORDER 337
+#define OFMLEVEL 338
+#define FONTDIR 339
+#define ACCENT 340
+
+
+
+
+#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
+typedef int YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+extern YYSTYPE yylval;
+
+
+
diff --git a/Build/source/texk/web2c/omegaware/ChangeLog b/Build/source/texk/web2c/omegaware/ChangeLog
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/ChangeLog
diff --git a/Build/source/texk/web2c/omegaware/odvicopy.ch b/Build/source/texk/web2c/omegaware/odvicopy.ch
new file mode 100644
index 00000000000..fa490c7b857
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/odvicopy.ch
@@ -0,0 +1,710 @@
+% odvicopy.ch: web2c changes for odvicopy.web
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original dvicopy.ch.
+%
+% dvicopy.ch for C compilation with web2c.
+% The original version of this file was created by Monika Jayme and
+% Klaus Guntermann at TH Darmstadt (THD), FR Germany.
+% Some parts are borrowed from the changes to dvitype, vftovp and vptovf.
+%
+% July 90 THD First versions for dvicopy 0.91 and 0.92
+% Aug 09 90 THD Updated to dvicopy 1.0 and released
+% Mar 20 91 THD Updated to dvicopy 1.2
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+@z
+
+@x [3] Set up kpathsea.
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+ print (banner); print_ln (version_string);
+@z
+
+@x [5] Big enough arrays to convert the dvilj sample font document.
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts}
+@!max_chars=10000; {maximum number of different characters among all fonts}
+@!max_widths=3000; {maximum number of different characters widths}
+@!max_packets=5000; {maximum number of different characters packets;
+ must be less than 65536}
+@!max_bytes=30000; {maximum number of bytes for characters packets}
+@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!name_length=50; {a file name shouldn't be longer than this}
+@y
+@<Constants...@>=
+@!max_fonts=1000; {maximum number of distinct fonts}
+@!max_chars=750000; {maximum number of different characters among all fonts}
+@!max_widths=10000; {maximum number of different characters widths}
+@!max_packets=100000; {maximum number of different characters packets;
+ must be less than 65536}
+@!max_bytes=3000000; {maximum number of bytes for characters packets}
+@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!terminal_line_length=256; {maximum number of characters input in a single
+ line of input from the terminal}
+@z
+
+% [14] Redirect output, so it can go to either stdout or stderr,
+% depending on where the output dvi file is going.
+@x
+@d print(#)==write(output,#)
+@d print_ln(#)==write_ln(output,#)
+@d new_line==write_ln(output) {start new line}
+@y
+@d print(#)==write(term_out,#)
+@d print_ln(#)==write_ln(term_out,#)
+@d new_line==write_ln(term_out) {start new line}
+@z
+
+@x [14] Permissive input.
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+@y
+@!ASCII_code=0..255; {a subrange of the integers}
+@z
+
+% [15] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@z
+
+@x [23] Remove non-local goto
+@d abort(#)==begin print_ln(' ',#,'.'); jump_out;
+ end
+
+@<Error handling...@>=
+@<Basic printing procedures@>@;
+procedure close_files_and_terminate; forward;
+@#
+procedure jump_out;
+begin mark_fatal; close_files_and_terminate;
+goto final_end;
+end;
+@y
+@d abort(#)==begin write_ln(stderr, ' ',#,'.'); jump_out;
+ end
+
+@<Error handling...@>=
+@<Basic printing procedures@>@;
+procedure close_files_and_terminate; forward;
+@#
+procedure jump_out;
+begin mark_fatal; close_files_and_terminate;
+uexit(1);
+end;
+@z
+
+@x [51] Fix casting problem in C.
+@d comp_spair(#) == if a<128 then #:=a*256+b @+ else #:=(a-256)*256+b
+@d comp_upair(#) == #:=a*256+b
+@y
+@d comp_spair(#) == if a<128 then #:=a*intcast(256)+b
+ @+ else #:=(a-intcast(256))*intcast(256)+b
+@d comp_upair(#) == #:=a*intcast(256)+b
+@z
+
+@x [52]
+if a<128 then #:=(a*256+b)*256+c @+ else #:=((a-256)*256+b)*256+c
+@d comp_utrio(#) == #:=(a*256+b)*256+c
+@y
+if a<128 then #:=(a*intcast(256)+b)*intcast(256)+c @+
+else #:=((a-intcast(256))*intcast(256)+b)*intcast(256)+c
+@d comp_utrio(#) == #:=(a*intcast(256)+b)*intcast(256)+c
+@z
+
+@x [53]
+if a<128 then #:=((a*256+b)*256+c)*256+d
+else #:=(((a-256)*256+b)*256+c)*256+d
+@y
+if a<128 then #:=((a*intcast(256)+b)*intcast(256)+c)*intcast(256)+d
+else #:=(((a-intcast(256))*intcast(256)+b)*intcast(256)+c)*intcast(256)+d
+@z
+
+@x [62] cur_name is no longer a fixed-size array.
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+@!cur_name:^char;
+@z
+
+@x [63] Ignore arguments to make_font_name.
+@ For \.{TFM} and \.{VF} files we just append the apropriate extension
+to the file name packet; in addition a system dependent area part
+(usually different for \.{TFM} and \.{VF} files) is prepended if
+the file name packet contains no area part.
+@^system dependencies@>
+
+@d append_to_name(#)==
+ if l_cur_name<name_length then
+ begin incr(l_cur_name); cur_name[l_cur_name]:=#;
+ end
+ else overflow(str_name_length,name_length)
+@d make_font_name_end(#)==
+ append_to_name(#[l]); make_name
+@d make_font_name(#)==
+ l_cur_name:=0; for l:=1 to # do make_font_name_end
+@y
+@ Since files are actually searched through path definitions,
+the area definitions are ignored here.
+To reduce the required changes we simply ignore the parameters given
+to |make_font_name|.
+@^system dependencies@>
+
+@d append_to_name(#)== begin
+ cur_name[l_cur_name]:=#;
+ incr(l_cur_name);
+ end
+@d make_font_name_end(#)==
+ make_name
+@d make_font_name(#)==
+ l_cur_name:=0; make_font_name_end
+@z
+
+% [67] No conversion of filenames in lower case, and initialize and
+% terminate for C strings.
+@x
+cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
+@y
+cur_name := xmalloc_array (char, pckt_length (n) + pckt_length (e));
+cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
+@z
+
+@x
+ if (b>="a")and(b<="z") then Decr(b)("a"-"A"); {convert to upper case}
+@y
+@z
+
+@x
+cur_loc:=pckt_start[e]; cur_limit:=pckt_start[e+1];
+while cur_loc<cur_limit do
+ begin pckt_extract(b); append_res_to_name(xchr[b]);
+ end;
+while l_cur_name<name_length do
+ begin incr(l_cur_name); cur_name[l_cur_name]:=' ';
+ end;
+@y Skip copying in the extension, kpathsea knows what to do.
+ cur_name[l_cur_name] := 0;
+@z
+
+@x [92]
+id4(".")("T")("F")("M")(tfm_ext); {file name extension for \.{TFM} files}
+id4(".")("O")("F")("M")(ofm_ext); {file name extension for \.{OFM} files}
+@y
+id4(".")("t")("f")("m")(tfm_ext); {file name extension for \.{TFM} files}
+id4(".")("o")("f")("m")(ofm_ext); {file name extension for \.{OFM} files}
+@z
+
+@x [93] Set default directory name
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{TFM} directory, which is a system-dependent place where
+the \.{TFM} files for standard fonts are kept.
+The string variable |TFM_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d TFM_default_area_name=='TeXfonts:' {change this to the correct name}
+@d OFM_default_area_name=='TeXfonts:' {change this to the correct name}
+@d TFM_default_area_name_length=9 {change this to the correct length}
+@d OFM_default_area_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!TFM_default_area:packed array[1..TFM_default_area_name_length] of char;
+@!OFM_default_area:packed array[1..OFM_default_area_name_length] of char;
+@y
+@ If no font directory has been specified, we search paths.
+@z
+
+@x [94] Remove initialization of now-defunct array
+@ @<Set init...@>=
+TFM_default_area:=TFM_default_area_name;
+OFM_default_area:=OFM_default_area_name;
+@y
+@ (No initialization to be done. Keep this module to preserve numbering.)
+@z
+
+@x [96] Open TFM file
+@<TFM: Open |tfm_file|@>=
+make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
+reset(tfm_file,cur_name);
+if eof(tfm_file) then begin
+ make_font_name(OFM_default_area_name_length)(OFM_default_area)(ofm_ext);
+ reset(tfm_file,cur_name);
+ if eof(tfm_file) then
+@^system dependencies@>
+ abort('---not loaded, TFM or OFM file can''t be opened!')
+ else font_extend(cur_fnt):=true
+@.TFM or OFM file can\'t be opened@>
+ end
+else font_extend(cur_fnt):=false
+@y
+|TFM_default_area_name_length| and |TFM_default_area| will not
+be used by |make_font_name|.
+
+@<TFM: Open |tfm_file|@>=
+make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
+full_name := kpse_find_tfm (cur_name);
+if full_name then begin
+ resetbin (tfm_file, full_name);
+ free (cur_name);
+ free (full_name);
+ font_extend(cur_fnt):=false
+ end
+else begin
+ make_font_name(OFM_default_area_name_length)(OFM_default_area)(ofm_ext);
+ full_name := kpse_find_ofm (cur_name);
+ if full_name then begin
+ resetbin (tfm_file, full_name);
+ free (cur_name);
+ free (full_name);
+ font_extend(cur_fnt):=true
+ end
+ else abort('---not loaded, TFM or OFM file can''t be opened!')
+ end
+@z
+
+@x
+close_in(tfm_file);
+@y
+xfclose(tfm_file, cur_name);
+@z
+
+@x [103] Fix casting problem in C.
+@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*256+tfm_b1
+@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
+if tfm_b2>127 then bad_font
+else #:=tfm_b2*256+tfm_b3
+@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
+if tfm_b0<128 then #:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+else #:=(((tfm_b0-256)*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
+(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3)
+@y
+@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*intcast(256)+tfm_b1
+@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
+if tfm_b2>127 then bad_font
+else #:=tfm_b2*intcast(256)+tfm_b3
+@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
+if tfm_b0<128
+then #:=((tfm_b0*intcast(256)+tfm_b1)*intcast(256)+tfm_b2)*intcast(256)+tfm_b3
+else #:=(((tfm_b0-intcast(256))*intcast(256)+tfm_b1)
+ *intcast(256)+tfm_b2)*intcast(256)+tfm_b3
+@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
+(((tfm_b0*intcast(256)+tfm_b1)*intcast(256)+tfm_b2)*intcast(256)+tfm_b3)
+@z
+
+@x [109] Declare full_name.
+@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
+@y
+@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
+@!full_name: ^char;
+@z
+
+@x [111] Fix up opening the binary files
+@ To prepare |dvi_file| for input, we |reset| it.
+
+@<Open input file(s)@>=
+reset(dvi_file); {prepares to read packed bytes from |dvi_file|}
+dvi_loc:=0;
+@y
+@ To prepare |dvi_file| for input, we |reset| it.
+
+@<Open input file(s)@>=
+dvi_loc:=0;
+@z
+
+@x [113] Make dvi_length() and dvi_move() work.
+@p function dvi_length:int_32;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure dvi_move(@!n:int_32);
+begin set_pos(dvi_file,n); dvi_loc:=n;
+end;
+@y
+@p function dvi_length:int_32;
+begin xfseek(dvi_file, 0, 2, 'odvicopy');
+dvi_loc:=xftell(dvi_file, 'odvicopy');
+dvi_length:=dvi_loc;
+end;
+@#
+procedure dvi_move(n:int_32);
+begin xfseek(dvi_file, n, 0, 'odvicopy');
+dvi_loc:=n;
+end;
+@z
+
+@x
+id3(".")("V")("F")(vf_ext); {file name extension for \.{VF} files}
+id4(".")("O")("V")("F")(ovf_ext); {file name extension for \.{OVF} files}
+@y
+id3(".")("v")("f")(vf_ext); {file name extension for \.{VF} files}
+id4(".")("o")("v")("f")(ovf_ext); {file name extension for \.{OVF} files}
+@z
+
+@x [137/138] Set default directory name
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{VF} directory, which is a system-dependent place where
+the \.{VF} files for standard fonts are kept.
+The string variable |VF_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d VF_default_area_name=='TeXvfonts:' {change this to the correct name}
+@d VF_default_area_name_length=10 {change this to the correct length}
+@d OVF_default_area_name=='TeXvfonts:' {change this to the correct name}
+@d OVF_default_area_name_length=10 {change this to the correct length}
+
+@<Glob...@>=
+@!VF_default_area:packed array[1..VF_default_area_name_length] of char;
+@!OVF_default_area:packed array[1..OVF_default_area_name_length] of char;
+
+@ @<Set init...@>=
+VF_default_area:=VF_default_area_name;
+OVF_default_area:=OVF_default_area_name;
+@y
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{VF} directory, which is a system-dependent place where
+the \.{VF} files for standard fonts are kept.
+
+Actually, under UNIX the standard area is defined in an external
+file \.{site.h}. And the users have a path searched for fonts,
+by setting the \.{VFFONTS} environment variable.
+
+@ (No initialization to be done. Keep this module to preserve numbering.)
+@z
+
+@x [139] Open VF file
+@<VF: Open |vf_file| or |goto not_found|@>=
+make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
+reset(vf_file,cur_name);
+if eof(vf_file) then begin
+ make_font_name(OVF_default_area_name_length)(OVF_default_area)(ovf_ext);
+ reset(vf_file,cur_name);
+ if eof(vf_file) then
+@^system dependencies@>
+ goto not_found
+ end;
+@y
+Do path searching. But the \.{VF} file may not exist.
+
+@<VF: Open |vf_file| or |goto not_found|@>=
+make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
+full_name := kpse_find_vf (cur_name);
+if full_name then begin
+ resetbin (vf_file, full_name);
+ free (cur_name);
+ free (full_name);
+ end
+else begin
+ make_font_name(OVF_default_area_name_length)(OVF_default_area)(ovf_ext);
+ full_name := kpse_find_ovf (cur_name);
+ if full_name then begin
+ resetbin (vf_file, full_name);
+ free (cur_name);
+ free (full_name);
+ end
+ else goto not_found
+ end;
+@z
+
+@x
+close_in(vf_file);
+@y
+xfclose(vf_file,cur_name);
+@z
+
+@x [163] copy elements of array piece by piece
+@ @<VF: Start a new level@>=
+append_one(push);
+vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+@y
+@ \.{web2c} does not like array assignments. So we need to do them
+through a macro replacement.
+
+@d do_vf_move(#) == vf_move[vf_ptr]# := vf_move[vf_ptr-1]#
+@d vf_move_assign == begin do_vf_move([0][0]); do_vf_move([0][1]);
+ do_vf_move([1][0]); do_vf_move([1][1])
+ end
+
+@<VF: Start a new level@>=
+append_one(push);
+vf_move_assign;
+@z
+
+@x [170] and again...
+ vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+@y
+ vf_move_assign;
+@z
+
+@x [175] break is fflush.
+@d update_terminal == break(output) {empty the terminal output buffer}
+@y
+@d update_terminal == fflush(stdout) {empty the terminal output buffer}
+@z
+
+@x [175]
+procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin if n_opt=0 then
+ begin print('Enter option: '); update_terminal; reset(input);
+ if eoln(input) then read_ln(input);
+ k:=0; pckt_room(terminal_line_length);
+ while (k<terminal_line_length)and not eoln(input) do
+ begin append_byte(xord[input^]); incr(k); get(input);
+ end;
+ end
+else if k_opt<n_opt then
+ begin incr(k_opt);
+ {Copy command line option number |k_opt| into |byte_mem| array!}
+ end;
+end;
+@y
+procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin print('Enter option: '); update_terminal;
+{|if eoln(input) then read_ln(input);|}
+k:=0; pckt_room(terminal_line_length);
+while (k<terminal_line_length)and not eoln(input) do
+ begin append_byte(xord[getc(input)]); incr(k);
+ end;
+end;
+@z
+
+@x [231] No dialog, remove unused final label.
+dialog; {get options}
+@y
+@z
+@x
+final_end:end.
+@y
+end.
+@z
+
+@x [236] Do this later, to avoid creating empty files.
+@<Open output file(s)@>=
+rewrite(out_file); {prepares to write packed bytes to |out_file|}
+@y
+@<Open output file(s)@>=
+@z
+
+@x [238] Use external routine to output bytes.
+@d out_byte(#) == write(out_file,#) {write next \.{DVI} byte}
+@y
+@d out_byte(#) == put_byte(#,out_file) {write next \.{DVI} byte}
+@z
+
+@x [250] String declaration.
+@!comment:packed array[1..comm_length] of char; {preamble comment prefix}
+@y
+@!comment:^char; {preamble comment prefix}
+@z
+
+@x [251] Output the string from 0 to len-1, not 1 to len.
+for k:=1 to comm_length do append_byte(xord[comment[k]]);
+@y
+for k:=0 to comm_length - 1 do append_byte(xord[comment[k]]);
+@z
+
+@x [] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVIcopy} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+This macro tests if its argument is the current option, as represented
+by the index variable |option_index|.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 5; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+ @!k, @!m: c_int_type;
+ @!end_num: ^char;
+begin
+ @<Define the option table@>;
+ @<Initialize options@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('odvicopy');
+
+ end else if argument_is ('help') then begin
+ usage_help (ODVICOPY_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit
+ (banner, 'J. Plaice, Y. Haralambous, P. Breitenlohner', nil);
+
+ end else if argument_is ('magnification') then begin
+ out_mag := atou (optarg);
+
+ end else if argument_is ('max-pages') then begin
+ max_pages := atou (optarg);
+
+ end else if argument_is ('page-start') then begin
+ @<Determine the desired |start_count| values from |optarg|@>;
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We can have zero, one, or two remaining arguments.}
+ if optind = argc then begin
+ dvi_file := make_binary_file (stdin);
+ out_file := make_binary_file (stdout);
+ term_out := stderr;
+
+ end else if optind + 1 = argc then begin
+ resetbin (dvi_file, extend_filename (cmdline (optind), 'dvi'));
+ out_file := make_binary_file (stdout);
+ term_out := stderr;
+
+ end else if optind + 2 = argc then begin
+ resetbin (dvi_file, extend_filename (cmdline (optind), 'dvi'));
+ rewritebin (out_file, extend_filename (cmdline (optind + 1), 'dvi'));
+ term_out := stdout;
+
+ end else begin
+ write_ln (stderr, 'odvicopy: Need at most two file arguments.');
+ usage ('odvicopy');
+ end;
+end;
+
+@ Here is the first of the options we allow.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[0].name := 'help';
+long_options[0].has_arg := 0;
+long_options[0].flag := 0;
+long_options[0].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Magnification to apply.
+@.-magnification@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'magnification';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ How many pages to do.
+@.-max-pages@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'max-pages';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ What page to start at.
+@.-page-start@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'page-start';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Parsing the starting page specification is a bit complicated.
+(This is the same as in \.{DVItype}.)
+
+@<Determine the desired |start_count|...@> =
+k := 0; {which \.{\\count} register we're on}
+m := 0; {position in |optarg|}
+while optarg[m] do begin
+ if optarg[m] = "*" then begin
+ start_there[k] := false;
+ incr (m);
+
+ end else if optarg[m] = "." then begin
+ incr (k);
+ if k >= 10 then begin
+ write_ln (stderr, 'odvicopy: More than ten count registers specified.');
+ uexit (1);
+ end;
+ incr (m);
+
+ end else begin
+ start_count[k] := strtol (optarg + m, address_of (end_num), 10);
+ if end_num = optarg + m then begin
+ write_ln (stderr, 'odvicopy: -page-start values must be numeric or *.');
+ uexit (1);
+ end;
+ start_there[k] := true;
+ m := m + end_num - (optarg + m);
+ end;
+end;
+start_vals := k;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ @<Glob...@> =
+@!term_out:text;
+@z
diff --git a/Build/source/texk/web2c/omegaware/odvicopy.web b/Build/source/texk/web2c/omegaware/odvicopy.web
new file mode 100644
index 00000000000..cda08cc427f
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/odvicopy.web
@@ -0,0 +1,4688 @@
+% odvicopy.web: Omega version of file dvicopy.web
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original dvicopy.web.
+%
+% This program is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 1, or (at your option)
+% any later version.
+%
+% You should have received a copy of the GNU General Public License
+% along with this program; if not, write to the Free Software
+% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+%
+% Version 0.9 was finished May 21, 1990.
+% Version 1.0 pixel rounding for real devices (August 6, 1990).
+% Version 1.1 major rearrangements for DVIprint (October 7, 1990).
+% Version 1.2 fixed some bugs, page selection (February 13, 1991).
+% Version 1.3 several more changes, command line options,
+% don't load fonts that are never used (August 25, 1992).
+% Version 1.4 fixed a typo (March 28, 1995).
+% Version 1.5 avoided cur_name_length identifier conflict (October 15, 1995).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=manfnt % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\mathchardef\RA="3221 % right arrow
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{ODVI\lowercase{copy}} % don't change this line!
+\def\contentspagenumber{1}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont ODVIcopy} processor}
+ \vskip 5pt
+ \centerline{Copyright (C) 1990,95 Peter Breitenlohner,
+1994,97 John Plaice and Yannis Haralambous}
+ \centerline{Distributed under terms of GNU General Public License}
+ \vskip 15pt
+ \centerline{(Version 1.5, March 1997)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ This program was developed at the Max-Planck-Institut f\"ur Physik
+ (Werner-Heisenberg-Institut), Munich, Germany.
+ And modified at the Universit\'e Laval, Qu\'ebec, Canada.
+ `\TeX' is a trademark of the American Mathematical Society.
+ `{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley
+ Publishing Company.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{ODVIcopy} utility program copies (selected pages of) binary
+device-independent (``\.{DVI}'') files that are produced by document
+compilers such as \TeX and $\Omega$,
+and replaces all references to characters from
+virtual fonts by the typesetting instructions specified for them in
+binary virtual-font (``\.{VF}'' or ``OVF'') files.
+This program has two chief purposes: (1)~It can be used as preprocessor
+for existing \.{DVI}-related software in cases where this software is
+unable to handle virtual fonts or (given suitable \.{VF} or \.{OVF} files)
+where this software cannot handle fonts with more than 128~characters;
+and (2)~it serves as an example of a program that reads \.{DVI},
+\.{VF} and \.{OVF} files correctly, for system programmers who are developing
+\.{DVI}-related software.
+
+Goal number (1) is important since quite a few existing programs have
+to be adapted to the extened capabilities of Version~3 of \TeX\ which
+will require some time. Moreover some existing programs are `as is' and
+the source code is, unfortunately, not available.
+Goal number (2) needs perhaps a bit more explanation. Programs for
+typesetting need to be especially careful about how they do arithmetic; if
+rounding errors accumulate, margins won't be straight, vertical rules
+won't line up, and so on (see the documentaion of \.{DVItype} for more
+details). This program is written as if it were a \.{DVI}-driver for a
+hypothetical typesetting device |out_file|, the output file receiving
+the copy of the input |dvi_file|. In addition all code related to
+|out_file| is concentrated in two chapters at the end of this program
+and quite independent of the rest of the code concerned with the
+decoding of \.{DVI}, \.{VF} and \.{OVF} files and with font substitutions. Thus
+it should be relatively easy to replace the device dependent code of
+this program by the corresponding code required for a real typesetting
+device. Having this in mind \.{DVItype}'s pixel rounding algorithms are
+included as conditional code not used by \.{ODVIcopy}.
+
+The \.{ODVIcopy} program is an extension of \.{DVIcopy} that allows
+the use of \.{OVF} and \.{OFM} files, which are used by the $\Omega$
+typesetting system. These files allows fonts with 65536 characters,
+unlike ordinary \.{VF} and \.{TFM} files, which only allow 256
+characters. The definition for \.{OVF} files is identical to the one for
+\.{VF} files. On the other hand, \.{OFM} files are different; their
+documentation can be found in the $\Omega$ web.
+
+Unless the contrary is specified below, all references to \.{TFM} files
+also refer to \.{OFM} files, similarly for \.{VF} and \.{OVF} files.
+References to \.{DVIcopy} also apply to \.{ODVIcopy}.
+
+
+The |banner| and |preamble_comment| strings defined here should be
+changed whenever \.{ODVIcopy} gets modified.
+
+@d banner=='This is ODVIcopy, Version 1.5' {printed when the program starts}
+@d title=='ODVIcopy' {the name of this program, used in some messages}
+@d copyright==
+ '(C) 1990,95 P. Breitenlohner, 1994,97 J. Plaice and Y. Haralambous'
+@#
+@d preamble_comment=='ODVIcopy 1.5 output from '
+@d comm_length=25 {length of |preamble_comment|}
+@d from_length=6 {length of its |' from '| part}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{DVIcopy} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+All places where nonstandard constructions are used have been listed in
+the index under ``system dependencies.''
+@!@^system dependencies@>
+
+One of the extensions to standard \PASCAL\ that we shall deal with is the
+ability to move to a random place in a binary file; another is to
+determine the length of a binary file. Such extensions are not necessary
+for reading \.{DVI} files; since \.{DVIcopy} is (a model for) a
+production program it should, however, be made as efficient as possible
+for a particular system. If \.{DVIcopy} is being used with
+\PASCAL s for which random file positioning is not efficiently available,
+the following definition should be changed from |true| to |false|; in such
+cases, \.{DVIcopy} will not include the optional feature that reads the
+postamble first.
+
+@d random_reading==true {should we skip around in the file?}
+
+@ The program begins with a fairly normal header, made up of pieces that
+@^system dependencies@>
+will mostly be filled in later. The \.{DVI} input comes from file
+|dvi_file|, the \.{DVI} output goes to file |out_file|, and messages
+go to \PASCAL's standard |output| file.
+The \.{TFM} and \.{VF} files are defined later since their external names
+are determined dynamically.
+
+If it is necessary to abort the job because of a fatal error, the program
+calls the `|jump_out|' procedure, which goes to the label |final_end|.
+
+@d final_end = 9999 {go here to wrap it up}
+
+@p @t\4@>@<Compiler directives@>@/
+program ODVI_copy(@!dvi_file,@!out_file,@!output);
+label final_end;
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ print_ln(copyright);
+ print_ln('Distributed under terms of GNU General Public License');@/
+ @<Set initial values@>@/
+ end;
+
+@ The definition of |max_font_type| should be adapted to the number of
+font types used by the program; the first three values have a fixed
+meaning: |defined_font=0| indicates that a font has been defined,
+|loaded_font=1| indicates that the \.{TFM} file has been loaded but the
+font has not yet been used, and |vf_font_type=2| indicates a virtual
+font. Font type values |>=real_font=3| indicate real fonts and
+different font types are used to distinguish various kinds of font files
+(\.{GF} or \.{PK} or \.{PXL}). \.{DVIcopy} uses |out_font_type=3| for
+fonts that appear in the output \.{DVI} file.
+@!@^font types@>
+
+@d defined_font=0 {this font has been defined}
+@d loaded_font=1 {this font has been defined and loaded}
+@d vf_font_type=2 {this font is a virtual font}
+@d real_font=3 {smallest font type for real fonts}
+@#
+@d out_font_type=3 {this font appears in the output file}
+@d max_font_type=3
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{DVIcopy}'s capacity.
+
+@d max_select=10 {maximum number of page selection ranges}
+
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts}
+@!max_chars=10000; {maximum number of different characters among all fonts}
+@!max_widths=3000; {maximum number of different characters widths}
+@!max_packets=5000; {maximum number of different characters packets;
+ must be less than 65536}
+@!max_bytes=30000; {maximum number of bytes for characters packets}
+@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!name_length=50; {a file name shouldn't be longer than this}
+@!neg_max_chars=-10000; {maximum number of different characters among all fonts}
+
+@ As mentioned above, \.{DVIcopy} has two chief purposes: (1)~It produces
+a copy of the input \.{DVI} file with all references to characters from
+virtual fonts replaced by their expansion as specified in the character
+packets of \.{VF} files; and (2)~it serves as an example of a program
+that reads \.{DVI} and \.{VF} files correctly, for system programmers
+who are developing \.{DVI}-related software.
+
+In fact, a very large section of code (starting with the second chapter
+`Introduction (continued)' and ending with the fifteenth chapter
+`The main program') is used in identical form in \.{DVIcopy} and in
+\.{DVIprint}, a prototype \.{DVI}-driver. This has been made possible
+mostly by using several \.{WEB} coding tricks, such as not to make the
+resulting \PASCAL\ program inefficient in any way.
+
+Parts of the program that are needed in \.{DVIprint} but not in
+\.{DVIcopy} are delimited by the codewords `$|device|\ldots|ecived|$';
+these are mostly the pixel rounding algorithms used to convert the
+\.{DVI} units of a \.{DVI} file to the raster units of a real output
+device and have been copied more or less verbatim from \.{DVItype}.
+
+@d device==@{ {change this to `$\\{device}\equiv\null$' when output
+ for a real device is produced}
+@d ecived==@t@>@} {change this to `$\\{ecived}\equiv\null$' when output
+ for a real device is produced}
+@f device==begin
+@f ecived==end
+
+@* Introduction (continued).
+On some systems it is necessary to use various integer subrange types
+in order to make \.{\title} efficient; this is true in particular for
+frequently used variables such as loop indices. Consider an integer
+variable |x| with values in the range |0..255|: on most small systems
+|x| should be a one or two byte integer whereas on most large systems
+|x| should be a four byte integer.
+Clearly the author of a program knows best which range of values is
+required for each variable; thus \.{\title} never uses \PASCAL's |integer|
+type. All integer variables are declared as one of the integer subrange
+types defined below as \.{WEB} macros or \PASCAL\ types; these definitions
+can be used without system-dependent changes, provided the signed 32~bit
+integers are a subset of the standard type |integer|, and the compiler
+automatically uses the optimal representation for integer subranges
+(both conditions need not be satisfied for a particular system).
+@^system dependencies@>
+
+The complementary problem of storing large arrays of integer type
+variables as compactly as possible is addressed differently; here
+\.{\title} uses a \PASCAL\ |type|~declaration for each kind of array
+element.
+
+Note that the primary purpose of these definitions is optimizations, not
+range checking. All places where optimization for a particular system is
+highly desirable have been listed in the index under ``optimization.''
+@!@^optimization@>
+
+@d int_32 == integer {signed 32~bit integers}
+
+@<Types...@>=
+@!int_31 = 0..@"7FFFFFFF; {unsigned 31~bit integer}
+@!int_24u = 0..@"FFFFFF; {unsigned 24~bit integer}
+@!int_24 = -@"800000..@"7FFFFF; {signed 24~bit integer}
+@!int_23 = 0..@"7FFFFF; {unsigned 23~bit integer}
+@!int_16u = 0..@"FFFF; {unsigned 16~bit integer}
+@!int_16 = -@"8000..@"7FFF; {signed 16~bit integer}
+@!int_15 = 0..@"7FFF; {unsigned 15~bit integer}
+@!int_8u = 0..@"FF; {unsigned 8~bit integer}
+@!int_8 = -@"80..@"7F; {signed 8~bit integer}
+@!int_7 = 0..@"7F; {unsigned 7~bit integer}
+
+@ Some of this code is optional for use when debugging only;
+such material is enclosed between the delimiters |debug| and $|gubed|$.
+Other parts, delimited by |stat| and $|tats|$, are optionally included
+if statistics about \.{\title}'s memory usage are desired.
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$'
+ when gathering usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
+ when gathering usage statistics}
+@f stat==begin
+@f tats==end
+
+@ The \PASCAL\ compiler used to develop this program has ``compiler
+directives'' that can appear in comments whose first character is a dollar sign.
+In production versions of \.{\title} these directives tell the compiler that
+@^system dependencies@>
+it is safe to avoid range checks and to leave out the extra code it inserts
+for the \PASCAL\ debugger's benefit, although interrupts will occur if
+there is arithmetic overflow.
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ Labels are given symbolic names by the following definitions. We insert
+the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
+procedure in which we have used the `|return|' statement defined below;
+the label `|restart|' is occasionally used at the very beginning of a
+procedure; and the label `|reswitch|' is occasionally used just prior to
+a \&{case} statement in which some cases change the conditions and we wish to
+branch to the newly applicable case.
+Loops that are set up with the \&{loop} construction defined below are
+commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
+and they are sometimes repeated by going to `|continue|'.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=31 {go here when you've found it}
+@d not_found=32 {go here when you've found something else}
+
+@ The term |print| is used instead of |write| when this program writes on
+|output|, so that all such output could easily be redirected if desired;
+the term |d_print| is used for conditional output if we are debugging.
+
+@d print(#)==write(output,#)
+@d print_ln(#)==write_ln(output,#)
+@d new_line==write_ln(output) {start new line}
+@d print_nl(#)== {print information starting on a new line}
+ begin new_line; print(#);
+ end
+@#
+@d d_print(#)==@!debug print(#) @; @+ gubed
+@d d_print_ln(#)==@! debug print_ln(#) @; @+ gubed
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@#
+@d Incr_Decr_end(#)==#
+@d Incr(#)==#:=#+Incr_Decr_end {we use |Incr(a)(b)| to increase \dots}
+@d Decr(#)==#:=#-Incr_Decr_end {\dots\ and |Decr(a)(b)| to decrease
+ variable |a| by |b|; this can be optimized for some compilers}
+@#
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@f loop == xclause
+
+@ We assume that |case| statements may include a default case that applies
+if no matching label is found. Thus, we shall use constructions like
+@^system dependencies@>
+$$\vbox{\halign{#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the compiler
+used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
+and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
+`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
+and |endcases| should be changed to agree with local conventions. (Of
+course, if no default mechanism is available, the |case| statements of
+this program must be extended by listing all remaining cases.
+Donald~E. Knuth, the author of the \.{WEB} system program \.{TANGLE},
+@^Knuth, Donald Ervin@>
+would have taken the trouble to modify \.{TANGLE} so that such extensions
+were done automatically, if he had not wanted to encourage \PASCAL\
+compiler writers to make this important change in \PASCAL, where it belongs.)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{\title} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used, and because \.{DVI} and \.{VF} files use ASCII code for
+file names and certain other strings.
+
+The next few sections of \.{\title} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{\title} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+If such codes appear in the \.{DVI} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{\title}.
+So we shall assume that the \PASCAL\ system being used for \.{\title}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ @<Local variables for init...@>=
+@!i:int_16; {loop index for initializations}
+
+@ The \.{\title} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Reporting errors to the user.
+The \.{\title} processor does not verify that every single bit read from
+one of its binary input files is meaningful and consistent; there are
+other programs, e.g., \.{DVItype}, \.{TFtoPL}, and \.{VFtoPL}, specially
+designed for that purpose.
+
+On the other hand, \.{\title} is designed to avoid unpredictable results
+due to undetected arithmetic overflow, or due to violation of integer
+subranges or array bounds under {\it all\/} circumstances. Thus a fair
+amount of checking is done when reading and analyzing the input data,
+even in cases where such checking reduces the efficiency of the program
+to some extent.
+
+@ A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d harmless_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+@#
+@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
+@d mark_error==history:=error_message
+@d mark_fatal==history:=fatal_message
+
+@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
+
+@ @<Set init...@>=history:=spotless;
+
+@ If an input (\.{DVI}, \.{TFM}, \.{VF}, or other) file is badly malformed,
+the whole process must be aborted; \.{\title} will give up, after issuing
+an error message about what caused the error. These messages will, however,
+in most cases just indicate which input file caused the error. One of the
+programs \.{DVItype}, \.{TFtoPL} or \.{VFtoVP} should then be used to
+diagnose the error in full detail.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+transfers control to the label |final_end| at the end of the program,
+contains the only non-local |@!goto| statement in \.{\title}.
+@^system dependencies@>
+Some \PASCAL\ compilers do not implement non-local |goto| statements. In
+such cases the |goto final_end| in |jump_out| should simply be replaced
+by a call on some system procedure that quietly terminates the program.
+@^system dependencies@>
+
+@d abort(#)==begin print_ln(' ',#,'.'); jump_out;
+ end
+
+@<Error handling...@>=
+@<Basic printing procedures@>@;
+procedure close_files_and_terminate; forward;
+@#
+procedure jump_out;
+begin mark_fatal; close_files_and_terminate;
+goto final_end;
+end;
+
+@ Sometimes the program's behavior is far different from what it should
+be, and \.{\title} prints an error message that is really for the
+\.{\title} maintenance person, not the user. In such cases the program
+says |confusion(|indication of where we are|)|.
+
+@<Error handling...@>=
+procedure confusion(@!p:pckt_pointer);
+begin print(' !This can''t happen ('); print_packet(p); print_ln(').');
+@.This can't happen@>
+jump_out;
+end;
+
+@ An overflow stop occurs if \.{\title}'s tables aren't large enough.
+
+@<Error handling...@>=
+procedure overflow(@!p:pckt_pointer;@!n:int_16u);
+begin print(' !Sorry, ',title,' capacity exceeded ['); print_packet(p);
+@.Sorry, {\title} capacity exceeded@>
+print_ln('=',n:1,'].');
+jump_out;
+end;
+
+@* Binary data and binary files.
+A detailed description of the \.{DVI} file format can be found in the
+documentation of \TeX, \.{DVItype}, or \.{GFtoDVI}; here we just define
+symbolic names for some of the \.{DVI} command bytes.
+
+@d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@#
+@d dvi_id=2 {identifies \.{DVI} files}
+@d dvi_pad=223 {pad bytes at end of \.{DVI} file}
+
+@ A \.{DVI}, \.{VF}, or \.{TFM} file is a sequence of 8-bit bytes.
+The bytes appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo. One, two, three, or four consecutive bytes are often
+interpreted as (signed or unsigned) integers.
+We might as well define the corresponding data types.
+@!@^system dependencies@>
+
+@<Types...@>=
+@!signed_byte=-@"80..@"7F; {signed one-byte quantity}
+@!eight_bits=0..@"FF; {unsigned one-byte quantity}
+@!signed_pair=-@"8000..@"7FFF; {signed two-byte quantity}
+@!sixteen_bits=0..@"FFFF; {unsigned two-byte quantity}
+@!signed_trio=-@"800000..@"7FFFFF; {signed three-byte quantity}
+@!twentyfour_bits=0..@"FFFFFF; {unsigned three-byte quantity}
+@!signed_quad=int_32; {signed four-byte quantity}
+
+@ Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{\title} is written in standard \PASCAL.
+@^system dependencies@>
+
+One common way to solve the problem is to consider files of |integer|
+numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
+a sequence of four bytes $(a,b,c,d)$ using the following code, which
+avoids the controversial integer division of negative numbers:
+$$\vbox{\halign{#\hfil\cr
+|if x>=0 then a:=x div @'100000000|\cr
+|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
+\quad|end|\cr
+|x:=x mod @'100000000;|\cr
+|b:=x div @'200000; x:=x mod @'200000;|\cr
+|c:=x div @'400; d:=x mod @'400;|\cr}}$$
+The four bytes are then kept in a buffer and output one by one. (On 36-bit
+computers, an additional division by 16 is necessary at the beginning.
+Another way to separate an integer into four bytes is to use/abuse
+\PASCAL's variant records, storing an integer and retrieving bytes that are
+packed in the same place; {\sl caveat implementor!\/}) It is also desirable
+in some cases to read a hundred or so integers at a time, maintaining a
+larger buffer.
+
+@ We shall stick to simple \PASCAL\ in the standard version of this program,
+for reasons of clarity, even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ For some operating systems it may be convenient or even necessary to
+close the input files.
+
+@d close_in(#)==do_nothing {close an input file}
+
+@ Character packets extracted from \.{VF} files will be stored in a large
+array |byte_mem|. Other packets of bytes, e.g., character packets
+extracted from a \.{GF} or \.{PK} or \.{PXL} file could be stored in the
+same way. A `|pckt_pointer|' variable, which signifies a packet,
+is an index into another array |pckt_start|. The actual sequence of bytes
+in the packet pointed to by |p| appears in positions |pckt_start[p]| to
+|pckt_start[p+1]-1|, inclusive, in |byte_mem|.
+
+Packets will also be used to store sequences of |ASCII_code|s; in this
+respect the |byte_mem| array is very similar to \TeX's string pool and
+part of the following code has, in fact, been copied more or less
+verbatim from \TeX.
+
+In other respects the packets resemble the identifiers used by
+\.{TANGLE} and \.{WEAVE} (also stored in an array called |byte_mem|)
+since there is, in general, at most one packet with a given contents;
+thus part of the code below has been adapted from the corresponding code
+in these programs.
+
+Some \PASCAL\ compilers won't pack integers into a single byte unless the
+integers lie in the range |-128..127|. To accommodate such systems we
+access the array |byte_mem| only via macros that can easily be redefined.
+@^system dependencies@>
+
+@d bi(#) == # {convert from |eight_bits| to |packed_byte|}
+@d bo(#) == # {convert from |packed_byte| to |eight_bits|}
+
+@<Types...@>=
+@!packed_byte = eight_bits; {elements of |byte_mem| array}
+@!byte_pointer = 0..max_bytes; {an index into |byte_mem|}
+@!pckt_pointer = 0..max_packets; {an index into |pckt_start|}
+
+@ The global variable |byte_ptr| points to the first unused location in
+|byte_mem| and |pckt_ptr| points to the first unused location in
+|pckt_start|.
+
+@<Globals...@>=
+@!byte_mem: packed array [byte_pointer] of packed_byte; {bytes of packets}
+@!pckt_start: array [pckt_pointer] of byte_pointer;
+ {directory into |byte_mem|}
+@!byte_ptr: byte_pointer;
+@!pckt_ptr: pckt_pointer;
+
+@ Several of the elementary operations with packets are performed using
+\.{WEB} macros instead of \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a packet.
+@.WEB@>
+
+@d pckt_length(#)==(pckt_start[#+1]-pckt_start[#]) {the number of bytes
+ in packet number \#}
+
+@ Packets are created by appending bytes to |byte_mem|.
+The |append_byte| macro, defined here, does not check to see if the
+value of |byte_ptr| has gotten too high; this test is supposed to be
+made before |append_byte| is used. There is also a |flush_byte|
+macro, which erases the last byte appended.
+
+To test if there is room to append |l| more bytes to |byte_mem|,
+we shall write |pckt_room(l)|, which aborts \.{\title} and gives an
+apologetic error message if there isn't enough room.
+
+@d append_byte(#) == {put byte \# at the end of |byte_mem|}
+begin byte_mem[byte_ptr]:=bi(#); incr(byte_ptr);
+end
+@d flush_byte == decr(byte_ptr) {forget the last byte in |byte_mem|}
+@d pckt_room(#) == {make sure that |byte_mem| hasn't overflowed}
+ if max_bytes-byte_ptr<# then overflow(str_bytes,max_bytes)
+@#
+@d append_one(#) ==
+begin pckt_room(1); append_byte(#);
+end
+
+@ The length of the current packet is called |cur_pckt_length|:
+
+@d cur_pckt_length == (byte_ptr - pckt_start[pckt_ptr])
+
+@ Once a sequence of bytes has been appended to |byte_mem|, it
+officially becomes a packet when the |make_packet| function is called.
+This function returns as its value the identification number of either
+an existing packet with the same contents or, if no such packet exists,
+of the new packet. Thus two packets have the same contents if and only
+if they have the same identification number. In order to locate the
+packet with a given contents, or to find out that no such packet exists,
+we need a hash table. The hash table is kept by the method of simple
+chaining, where the heads of the individual lists appear in the |p_hash|
+array. If |h| is a hash code, the hash table list starts at |p_hash[h]|
+and proceeds through |p_link| pointers.
+
+@d hash_size=353 {should be prime, must be |>256|}
+
+@<Types...@>=
+@!hash_code=0..hash_size;
+
+@ @<Glob...@>=
+@!p_link:array[pckt_pointer] of pckt_pointer; {hash table}
+@!p_hash:array[hash_code] of pckt_pointer;
+
+@ Initially |byte_mem| and all the hash lists are empty; |empty_packet|
+is the empty packet.
+
+@d empty_packet=0 {the empty packet}
+@d invalid_packet==max_packets {used when there is no packet}
+
+@<Set init...@>=
+pckt_ptr:=1; byte_ptr:=1;
+pckt_start[0]:=1; pckt_start[1]:=1;
+for h:=0 to hash_size-1 do p_hash[h]:=0;
+
+@ @<Local variables for init...@>=
+@!h:hash_code; {index into hash-head arrays}
+
+@ Here now is the |make_packet| function used to create packets (and
+strings).
+
+@p function make_packet:pckt_pointer;
+label found;
+var i,@!k:byte_pointer; {indices into |byte_mem|}
+@!h:hash_code; {hash code}
+@!s,@!l:byte_pointer; {start and length of the given packet}
+@!p:pckt_pointer; {where the packet is being sought}
+begin s:=pckt_start[pckt_ptr]; l:=byte_ptr-s; {compute start and length}
+if l=0 then p:=empty_packet
+else begin @<Compute the packet hash code |h|@>;
+ @<Compute the packet location |p|@>;
+ if pckt_ptr=max_packets then overflow(str_packets,max_packets);
+ incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr;
+ end;
+found:make_packet:=p;
+end;
+
+@ A simple hash code is used: If the sequence of bytes is
+$b_1b_2\ldots b_n$, its hash value will be
+$$(2^{n-1}b_1+2^{n-2}b_2+\cdots+b_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the packet hash...@>=
+h:=bo(byte_mem[s]); i:=s+1;
+while i<byte_ptr do
+ begin h:=(h+h+bo(byte_mem[i])) mod hash_size; incr(i);
+ end
+
+@ If the packet is new, it will be placed in position |p=pckt_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the packet location...@>=
+p:=p_hash[h];
+while p<>0 do
+ begin if pckt_length(p)=l then
+ @<Compare packet |p| with current packet, |goto found| if equal@>;
+ p:=p_link[p];
+ end;
+p:=pckt_ptr; {the current packet is new}
+p_link[p]:=p_hash[h]; p_hash[h]:=p {insert |p| at beginning of hash list}
+
+@ @<Compare packet |p|...@>=
+begin i:=s; k:=pckt_start[p];
+while (i<byte_ptr)and(byte_mem[i]=byte_mem[k]) do
+ begin incr(i); incr(k);
+ end;
+if i=byte_ptr then {all bytes agree}
+ begin byte_ptr:=pckt_start[pckt_ptr]; goto found;
+ end;
+end
+
+@ Some packets are initialized with predefined strings of |ASCII_code|s;
+a few macros permit us to do the initialization with a compact program.
+Since this initialization is done when |byte_mem| is still empty, and
+since |byte_mem| is supposed to be large enough for all the predefined
+strings, |pckt_room| is used only if we are debugging.
+
+@d pid0(#)==#:=make_packet
+@d pid1(#)==byte_mem[byte_ptr-1]:=bi(#); pid0
+@d pid2(#)==byte_mem[byte_ptr-2]:=bi(#); pid1
+@d pid3(#)==byte_mem[byte_ptr-3]:=bi(#); pid2
+@d pid4(#)==byte_mem[byte_ptr-4]:=bi(#); pid3
+@d pid5(#)==byte_mem[byte_ptr-5]:=bi(#); pid4
+@d pid6(#)==byte_mem[byte_ptr-6]:=bi(#); pid5
+@d pid7(#)==byte_mem[byte_ptr-7]:=bi(#); pid6
+@d pid8(#)==byte_mem[byte_ptr-8]:=bi(#); pid7
+@d pid9(#)==byte_mem[byte_ptr-9]:=bi(#); pid8
+@d pid10(#)==byte_mem[byte_ptr-10]:=bi(#); pid9
+@#
+@d pid_init(#)==
+ @!debug pckt_room(#); @+ gubed @;
+ Incr(byte_ptr)(#)
+@#
+@d id1==pid_init(1); pid1
+@d id2==pid_init(2); pid2
+@d id3==pid_init(3); pid3
+@d id4==pid_init(4); pid4
+@d id5==pid_init(5); pid5
+@d id6==pid_init(6); pid6
+@d id7==pid_init(7); pid7
+@d id8==pid_init(8); pid8
+@d id9==pid_init(9); pid9
+@d id10==pid_init(10); pid10
+
+@ Here we initialize some strings used as argument of the |overflow| and
+|confusion| procedures.
+
+@<Initialize predefined strings@>=
+id5("f")("o")("n")("t")("s")(str_fonts);
+id5("c")("h")("a")("r")("s")(str_chars);
+id6("w")("i")("d")("t")("h")("s")(str_widths);
+id7("p")("a")("c")("k")("e")("t")("s")(str_packets);
+id5("b")("y")("t")("e")("s")(str_bytes);
+id9("r")("e")("c")("u")("r")("s")("i")("o")("n")(str_recursion);
+id5("s")("t")("a")("c")("k")(str_stack);
+id10("n")("a")("m")("e")("l")("e")("n")("g")("t")("h")(str_name_length);
+
+@ @<Glob...@>=
+@!str_fonts,@!str_chars,@!str_widths,@!str_packets,@!str_bytes,
+@!str_recursion,@!str_stack,@!str_name_length:pckt_pointer;
+
+@ Some packets, e.g., the preamble comments of \.{DVI} and \.{VF} files,
+are needed only temporarily. In such cases |new_packet| is used to
+create a packet (which might duplicate an existing packet) and
+|flush_packet| is used to discard it; the calls to |new_packet| and
+|flush_packet| must occur in balanced pairs, without any intervening
+calls to |make_packet|.
+
+@p function new_packet: pckt_pointer;
+begin if pckt_ptr=max_packets then overflow(str_packets,max_packets);
+new_packet:=pckt_ptr; incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr;
+end;
+@#
+procedure flush_packet;
+begin decr(pckt_ptr); byte_ptr:=pckt_start[pckt_ptr];
+end;
+
+@ The |print_packet| procedure prints the contents of a packet; such a
+packets should, of course, consists of a sequence of |ASCII_code|s.
+
+@<Basic printing...@>=
+procedure print_packet(p:pckt_pointer);
+var k:byte_pointer;
+begin for k:=pckt_start[p] to pckt_start[p+1]-1 do
+ print(xchr[bo(byte_mem[k])]);
+end;
+
+@ When we interpret a packet we will use two (global or local) variables:
+|cur_loc| will point to the byte to be used next, and |cur_limit| will
+point to the start of the next packet. The macro |pckt_extract| will be
+used to extract one byte; it should, however, never be used with
+|cur_loc>=cur_limit|.
+
+@d pckt_extract(#) ==
+@!debug if cur_loc>=cur_limit then confusion(str_packets) @+ else @/
+gubed @;
+ begin #:=bo(byte_mem[cur_loc]); incr(cur_loc); @+ end
+
+@<Globals...@>=
+@!cur_pckt: pckt_pointer; {the current packet}
+@!cur_loc: byte_pointer; {current location in a packet}
+@!cur_limit: byte_pointer; {start of next packet}
+
+@ We will need routines to extract one, two, three, or four bytes from
+|byte_mem|, from the \.{DVI} file, or from a \.{VF} file and assemble
+them into (signed or unsigned) integers and these routines should be
+optimized for efficiency. Here we define \.{WEB} macros to be used for
+the body of these routines; thus the changes for system dependent
+optimization have to be applied only once.
+@^system dependencies@>
+@^optimization@>
+
+In addition we demonstrates how these macros can be used to define
+functions that extract one, two, three, or four bytes from a character
+packet and assemble them into signed or unsigned integers (assuming that
+|cur_loc| and |cur_limit| are initialized suitably).
+
+@d begin_byte(#) ==
+var a:eight_bits;
+begin #(a)
+@d comp_sbyte(#) == if a<128 then #:=a @+ else #:=a-256
+@d comp_ubyte(#) == #:=a
+@f begin_byte == begin
+
+@p function pckt_sbyte:int_8; {returns the next byte, signed}
+@!begin_byte(pckt_extract); comp_sbyte(pckt_sbyte);
+end;
+@#
+function pckt_ubyte:int_8u; {returns the next byte, unsigned}
+@!begin_byte(pckt_extract); comp_ubyte(pckt_ubyte);
+end;
+
+@ @d begin_pair(#) ==
+var a,@!b:eight_bits;
+begin #(a); #(b)
+@d comp_spair(#) == if a<128 then #:=a*256+b @+ else #:=(a-256)*256+b
+@d comp_upair(#) == #:=a*256+b
+@f begin_pair == begin
+
+@p function pckt_spair:int_16; {returns the next two bytes, signed}
+@!begin_pair(pckt_extract); comp_spair(pckt_spair);
+end;
+@#
+function pckt_upair:int_16u; {returns the next two bytes, unsigned}
+@!begin_pair(pckt_extract); comp_upair(pckt_upair);
+end;
+
+@ @d begin_trio(#) ==
+var a,@!b,@!c:eight_bits;
+begin #(a); #(b); #(c)
+@d comp_strio(#) ==
+if a<128 then #:=(a*256+b)*256+c @+ else #:=((a-256)*256+b)*256+c
+@d comp_utrio(#) == #:=(a*256+b)*256+c
+@f begin_trio == begin
+
+@p function pckt_strio:int_24; {returns the next three bytes, signed}
+@!begin_trio(pckt_extract); comp_strio(pckt_strio);
+end;
+@#
+function pckt_utrio:int_24u; {returns the next three bytes, unsigned}
+@!begin_trio(pckt_extract); comp_utrio(pckt_utrio);
+end;
+
+@ @d begin_quad(#) ==
+var a,@!b,@!c,@!d:eight_bits;
+begin #(a); #(b); #(c); #(d)
+@d comp_squad(#) ==
+if a<128 then #:=((a*256+b)*256+c)*256+d
+else #:=(((a-256)*256+b)*256+c)*256+d
+@f begin_quad == begin
+
+@p function pckt_squad:int_32; {returns the next four bytes, signed}
+@!begin_quad(pckt_extract); comp_squad(pckt_squad);
+end;
+
+@ A similar set of routines is needed for the inverse task of
+decomposing a \.{DVI} command into a sequence of bytes to be appended
+to |byte_mem| or, in the case of \.{DVIcopy}, to be written to the
+output file. Again we define \.{WEB} macros to be used for the body
+of these routines; thus the changes for system dependent optimization
+have to be applied only once.
+@^system dependencies@>
+@^optimization@>
+
+First, the |pckt_one| outputs one byte, negative values are represented
+in two's complement notation.
+
+@d begin_one == begin
+@d comp_one(#) ==
+if x<0 then Incr(x)(256);
+#(x)
+@f begin_one == begin
+
+@p @!device
+procedure pckt_one(@!x:int_32); {output one byte}
+@!begin_one; pckt_room(1); comp_one(append_byte);
+end;
+ecived
+
+@ The |pckt_two| outputs two bytes, negative values are represented in
+two's complement notation.
+
+@d begin_two == begin
+@d comp_two(#) ==
+if x<0 then Incr(x)(@"10000);
+#(x div @"100); #(x mod @"100)
+@f begin_two == begin
+
+@p @!device
+procedure pckt_two(@!x:int_32); {output two byte}
+@!begin_two; pckt_room(2); comp_two(append_byte);
+end;
+ecived
+
+@ The |pckt_four| procedure outputs four bytes in two's complement
+notation, without risking arithmetic overflow.
+
+@d begin_four == begin
+@d comp_four(#) ==
+if x>=0 then #(x div @"1000000)
+else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
+ #((x div @"1000000) + 128);
+ end;
+x:=x mod @"1000000; #(x div @"10000);
+x:=x mod @"10000; #(x div @"100);
+#(x mod @"100)
+@f begin_four == begin
+
+@p procedure pckt_four(@!x:int_32); {output four bytes}
+@!begin_four; pckt_room(4); comp_four(append_byte);
+end;
+
+@ Next, the |pckt_char| procedure outputs a |set_char| or \\{set} command
+or, if |upd=false|, a |put| command.
+
+@d begin_char ==
+var o:eight_bits; {|set1| or |put1|}
+begin
+@d comp_char(#) ==
+if (res>=0) and (res<@"100) then begin
+ if (not upd)or(res>127)or(ext<>0) then
+ begin o:=dvi_char_cmd[upd]; {|set1| or |put1|}
+ if ext<0 then Incr(ext)(@"1000000);
+ if ext=0 then #(o) @+ else @;
+ begin if ext<@"100 then #(o+1) @+ else @;
+ begin if ext<@"10000 then #(o+2) @+ else @;
+ begin #(o+3); #(ext div @"10000); ext:=ext mod @"10000;
+ end;
+ #(ext div @"100); ext:=ext mod @"100;
+ end;
+ #(ext);
+ end;
+ end;
+ #(res)
+ end
+else
+ begin if (res>=0) and (res<@"10000) then #(o+1) @+ else @;
+ begin if (res>=0) and (res<@"1000000) then #(o+2) @+ else @;
+ begin #(o+3);
+ if res>=0 then #(res div @"1000000)
+ else begin Incr(res)(@"40000000); Incr(res)(@"40000000);
+ #((res div @"1000000) + 128); res:=res mod @"1000000;
+ end;
+ res:=res mod @"1000000
+ end;
+ #(res div @"10000); res:= res mod @"10000
+ end;
+ #(res div @"100); res:=res mod @"100; #(res)
+ end
+
+@f begin_char == begin
+
+@p procedure pckt_char(@!upd:boolean;@!ext:int_32;@!res:int_32);
+ {output \\{set} or |put|}
+@!begin_char; pckt_room(5); comp_char(append_byte);
+end;
+
+@ Then, the |pckt_unsigned| procedure outputs a |fnt| or |xxx|
+command with its first parameter (normally unsigned); a |fnt| command
+is converted into |fnt_num| whenever this is possible.
+
+@d begin_unsigned == begin
+@d comp_unsigned(#) ==
+if (x<@"100)and(x>=0) then
+ if (o=fnt1)and(x<64) then Incr(x)(fnt_num_0) @+ else #(o)
+else
+ begin if (x<@"10000)and(x>=0) then #(o+1) @+ else @;
+ begin if (x<@"1000000)and(x>=0) then #(o+2) @+ else @;
+ begin #(o+3);
+ if x>=0 then #(x div @"1000000)
+ else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
+ #((x div @"1000000) + 128);
+ end;
+ x:=x mod @"1000000;
+ end;
+ #(x div @"10000); x:=x mod @"10000;
+ end;
+ #(x div @"100); x:=x mod @"100;
+ end;
+#(x)
+@f begin_unsigned == begin
+
+@p procedure pckt_unsigned(@!o:eight_bits;@!x:int_32);
+ {output |fnt_num|, |fnt|, or |xxx|}
+@!begin_unsigned; pckt_room(5); comp_unsigned(append_byte);
+end;
+
+@ Finally, the |pckt_signed| procedure outputs a movement (|right|, |w|,
+|x|, |down|, |y|, or |z|) command with its (signed) parameter.
+
+@d begin_signed ==
+var xx:int_31; {`absolute value' of |x|}
+begin
+@d comp_signed(#) ==
+if x>=0 then xx:=x @+ else xx:=-(x+1);
+if xx<@"80 then
+ begin #(o); @+ if x<0 then Incr(x)(@"100); @+ end
+else begin if xx<@"8000 then
+ begin #(o+1); @+ if x<0 then Incr(x)(@"10000); @+ end
+ else begin if xx<@"800000 then
+ begin #(o+2); @+ if x<0 then Incr(x)(@"1000000); @+ end
+ else begin #(o+3);
+ if x>=0 then #(x div @"1000000)
+ else begin x:=@"7FFFFFFF-xx; #((x div @"1000000) + 128); @+ end;
+ x:=x mod @"1000000;
+ end;
+ #(x div @"10000); x:=x mod @"10000;
+ end;
+ #(x div @"100); x:=x mod @"100;
+ end;
+#(x)
+@f begin_signed == begin
+
+@p procedure pckt_signed(@!o:eight_bits;@!x:int_32);
+ {output |right|, |w|, |x|, |down|, |y|, or |z|}
+@!begin_signed; pckt_room(5); comp_signed(append_byte);
+end;
+
+@ The |hex_packet| procedure prints the contents of a packet in
+hexadecimal form.
+
+@<Basic printing...@>=
+@!debug procedure hex_packet(@!p:pckt_pointer); {prints a packet in hex}
+var j,@!k,@!l:byte_pointer; {indices into |byte_mem|}
+@!d:int_8u;
+begin j:=pckt_start[p]-1; k:=pckt_start[p+1]-1;
+print_ln(' packet=',p:1,' start=',j+1:1,' length=',k-j:1);
+for l:=j+1 to k do
+ begin d:=(bo(byte_mem[l])) div 16;
+ if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]);
+ d:=(bo(byte_mem[l])) mod 16;
+ if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]);
+ if (l=k)or(((l-j) mod 16)=0) then new_line
+ else if ((l-j) mod 4)=0 then print(' ')
+ else print(' ');
+ end;
+end;
+gubed
+
+@* File names.
+The structure of file names is different for different systems; therefore
+this part of the program will, in most cases, require system dependent
+modifications. Here we assume that a file name consists of three parts:
+an area or directory specifying where the file can be found, a name
+proper and an extension; \.{\title} assumes that these three parts appear
+in order stated above but this need not be true in all cases.
+
+The font names extracted from \.{DVI} and \.{VF} files consist of an area
+part and a name proper; these are stored as packets consisting of the
+length of the area part followed by the area and the name proper.
+When we print an external font name we simple print the area and the name
+contained in the `file name packet' without delimiter between them.
+This may need to be modified for some systems.
+@^system dependencies@>
+
+@<Basic printing...@>=
+procedure print_font(@!f:font_number);
+var p:pckt_pointer; {the font name packet}
+@!k:byte_pointer; {index into |byte_mem|}
+@!m:int_31; {font magnification}
+begin print(' = '); p:=font_name(f);
+for k:=pckt_start[p]+1 to pckt_start[p+1]-1 do
+ print(xchr[bo(byte_mem[k])]);
+m:=round((font_scaled(f)/font_design(f))*out_mag);
+if m<>1000 then print(' scaled ',m:1);
+end;
+
+@ Before a font file can be opened for input we must build a string
+with its external name.
+
+@<Glob...@>=
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!l_cur_name:int_15; {this many characters are actually relevant in
+ |cur_name|}
+
+@ For \.{TFM} and \.{VF} files we just append the apropriate extension
+to the file name packet; in addition a system dependent area part
+(usually different for \.{TFM} and \.{VF} files) is prepended if
+the file name packet contains no area part.
+@^system dependencies@>
+
+@d append_to_name(#)==
+ if l_cur_name<name_length then
+ begin incr(l_cur_name); cur_name[l_cur_name]:=#;
+ end
+ else overflow(str_name_length,name_length)
+@d make_font_name_end(#)==
+ append_to_name(#[l]); make_name
+@d make_font_name(#)==
+ l_cur_name:=0; for l:=1 to # do make_font_name_end
+
+@ For files with character raster data (e.g., \.{GF} or \.{PK} files) the
+the extension and\slash or area part will in most cases depend on the
+resolution of the output device (corrected for font magnification).
+If the special character |res_char| occurs in the extension and\slash or
+default area, a character string representing the device resolution will
+be substituted.
+@^system dependencies@>
+
+@d res_char=='?' {character to be replaced by font resolution}
+@d res_ASCII="?" {|xord[res_char]|}
+@#
+@d append_res_to_name(#)==
+ begin c:=#;
+ @!device if c=res_char then
+ for ll:=n_res_digits downto 1 do append_to_name(res_digits[ll])
+ else ecived@;@/
+ append_to_name(c);
+ end
+@d make_font_res_end(#)==
+ append_res_to_name(#[l]); make_name
+@d make_font_res(#)==
+ make_res; l_cur_name:=0; for l:=1 to # do make_font_res_end
+
+@ @<Glob...@>=
+@!device
+@!f_res:int_16u; {font resolution}
+@!res_digits:array [1..5] of char;
+@!n_res_digits:int_7; {number of significant characters in |res_digits|}
+ecived
+
+@ The |make_res| procedure creates a sequence of characters representing
+to the font resolution |f_res|.
+
+@p @!device procedure make_res;
+var r:int_16u;
+begin n_res_digits:=0; r:=f_res;
+repeat incr(n_res_digits);
+ res_digits[n_res_digits]:=xchr["0"+(r mod 10)]; r:=r div 10;
+until r=0;
+end;
+ecived
+
+@ The |make_name| procedure used to build the external file name. The
+global variable |l_cur_name| contains the length of a default area
+which has been copied to |cur_name| before |make_name| is called.
+@^system dependencies@>
+
+@p procedure make_name(@!e:pckt_pointer);
+var b:eight_bits; {a byte extracted from |byte_mem|}
+@!n:pckt_pointer; {file name packet}
+@!cur_loc,@!cur_limit:byte_pointer; {indices into |byte_mem|}
+@!device
+@!ll:int_15; {loop index}
+ecived@;@/
+@!c:char; {a character to be appended to |cur_name|}
+begin n:=font_name(cur_fnt);
+cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
+pckt_extract(b); {length of area part}
+if b>0 then l_cur_name:=0;
+while cur_loc<cur_limit do
+ begin pckt_extract(b);
+ if (b>="a")and(b<="z") then Decr(b)("a"-"A"); {convert to upper case}
+ append_to_name(xchr[b]);
+ end;
+cur_loc:=pckt_start[e]; cur_limit:=pckt_start[e+1];
+while cur_loc<cur_limit do
+ begin pckt_extract(b); append_res_to_name(xchr[b]);
+ end;
+while l_cur_name<name_length do
+ begin incr(l_cur_name); cur_name[l_cur_name]:=' ';
+ end;
+end;
+
+@* Font data.
+@ \.{DVI} file format does not include information about character widths, since
+that would tend to make the files a lot longer. But a program that reads
+a \.{DVI} file is supposed to know the widths of the characters that appear
+in \\{set\_char} commands. Therefore \.{\title} looks at the font metric
+(\.{TFM}) files for the fonts that are involved.
+@.TFM {\rm files}@>
+@.OFM {\rm files}@>
+
+The character-width data appears also in other files (e.g., in \.{VF} files
+or in \.{GF} and \.{PK} files that specify bit patterns for digitized
+characters); thus, it is usually possible for \.{DVI} reading programs
+to get by with accessing only one file per font. For \.{VF} reading
+programs there is, however, a problem: (1)~when reading the character
+packets from a \.{VF} file the \.{TFM} width for its local fonts should
+be known in order to analyze and optimize the packets (e.g., determine
+if a packet must indeed be enclosed with |push| and |pop| as implied by
+the \.{VF} format); and (2)~ in order to avoid infinite recursion such
+programs must not try to read a \.{VF} file for a font before a
+character from that font is actually used. Thus \.{\title} reads the
+\.{TFM} file whenever a new font is encountered and delays the decision
+whether this is a virtual font or not.
+
+@ First of all we need to know for each font~|f| such things as its
+external name, design and scaled size, and the approximate size of
+inter-word spaces. In addition we need to know the range |bc..ec| of
+valid characters for this font, and for each character~|c| in~|f| we
+need to know if this character exists and if so what is the width of~|c|.
+Depending on the font type of~|f| we may want to know a few other things
+about character~|c| in~|f| such as the character packet from a \.{VF}
+file or the raster data from a \.{PK} file.
+@^font types@>
+
+In \.{\title} we want to be able to handle the full range
+|@t$-2^{31}$@><=c<@t$2^{31}$@>| of character codes; each character code
+is decomposed into a character residue |0<=res<256| and character
+extension |@t$-2^{23}$@><=ext<@t$2^{23}$@>| such that |c=256*ext+res|.
+At present \.{VFtoVP}, \.{VPtoVF}, and the standard version of \TeX\ use
+only characters in the range |0<=c<256| (i.e., |ext=0|), there are,
+however, extensions of \TeX\ which use characters with |ext<>0|.
+In any case characters with |ext<>0| will be used rather infrequently
+and we want to handle this possibility without too much overhead.
+
+Some of the data for each character~|c| depend only on its residue:
+first of all its width and escapement; others, such as \.{VF} packets or
+raster data will also depend on its extension. The later will be stored
+as packets in |byte_mem|, and the packets for characters with the same
+residue but different extension will be chained.
+
+Thus we have to maintain several variables for each character
+residue~|bc<=res<=ec| from each font~|f|; we store each type of variable
+in a large array such that the array index |font_chars(f)+res| points to
+the value for characters with residue |res| from font~|f|.
+
+Although \TeX\ was designed to be used with 256 characters, $\Omega$
+has no such restrictions. Therefore when \.{OVF} and \.{OFM} files
+are being used, |ext| will remain 0 and |res| will vary over the full
+range of values.
+
+@ Quite often a particular width value is shared by several characters in
+a font or even by characters from different fonts; the later will
+probably occur in particular for virtual fonts and the local fonts used
+by them. Thus the array |widths| is used to store all different \.{TFM}
+width values of all legal characters in all fonts; a variable of type
+|width_pointer| is an index into |widths| or is zero if a characters does
+not exist.
+
+In order to locate a given width value we use again a hash
+table with simple chaining; this time the heads of the individual lists
+appear in the |w_hash| array and the lists proceed through |w_link|
+pointers.
+
+@<Types...@>=
+@!width_pointer=0..max_widths; {an index into |widths|}
+
+@ @<Glob...@>=
+@!widths:array[width_pointer] of int_32; {the different width values}
+@!w_link:array[width_pointer] of width_pointer; {hash table}
+@!w_hash:array[hash_code] of width_pointer;
+@!n_widths:width_pointer; {first unoccupied position in |widths|}
+
+@ Initially the |widths| array and all the hash lists are empty, except
+for one entry: the width value zero; in addition we set |widths[0]:=0|.
+
+@d invalid_width=0 {width pointer for invalid characters}
+@d zero_width=1 {a width pointer to the value zero}
+
+@<Set init...@>=
+w_hash[0]:=1; w_link[1]:=0; widths[0]:=0; widths[1]:=0; n_widths:=2;
+for h:=1 to hash_size-1 do w_hash[h]:=0;
+
+@ The |make_width| function returns an index into |widths| and, if
+necessary, adds a new width value; thus two characters will have the
+same |width_pointer| if and only if their widths agree.
+
+@p function make_width(@!w:int_32):width_pointer;
+label found;
+var h:hash_code; {hash code}
+@!p:width_pointer; {where the identifier is being sought}
+@!x:int_16; {intermediate value}
+begin widths[n_widths]:=w;
+@<Compute the width hash code |h|@>;
+@<Compute the width location |p|, |goto| found unless the value is new@>;
+if n_widths=max_widths then overflow(str_widths,max_widths);
+incr(n_widths);
+found:make_width:=p;
+end;
+
+@ A simple hash code is used: If the width value consists of the four
+bytes $b_0b_1b_2b_3$, its hash value will be
+$$(8*b_0+4*b_1+2*b_2+b_3)\,\bmod\,|hash_size|.$$
+
+@<Compute the width hash...@>=
+if w>=0 then x:=w div @"1000000
+else begin w:=w+@"40000000; w:=w+@"40000000; x:=(w div @"1000000)+@"80;
+ end;
+w:=w mod @"1000000; x:=x+x+(w div @"10000);
+w:=w mod @"10000; x:=x+x+(w div @"100);
+h:=(x+x+(w mod @"100)) mod hash_size
+
+@ If the width is new, it has been placed into position |p=n_widths|,
+otherwise |p| will point to its existing location.
+
+@<Compute the width location...@>=
+p:=w_hash[h];
+while p<>0 do
+ begin if widths[p]=widths[n_widths] then goto found;
+ p:=w_link[p];
+ end;
+p:=n_widths; {the current width is new}
+w_link[p]:=w_hash[h]; w_hash[h]:=p {insert |p| at beginning of hash list}
+
+@ The |char_widths| array is used to store the |width_pointer|s for all
+different characters among all fonts. The |char_packets| array is used
+to store the |pckt_pointer|s for all different characters among all
+fonts; they can point to character packets from \.{VF} files or, e.g.,
+raster packets from \.{PK} files.
+
+@<Types...@>=
+@!char_offset=neg_max_chars..max_chars; {|char_pointer| offset for a font}
+@!char_pointer=0..max_chars; {index into |char_widths| or similar arrays}
+
+@ @<Glob...@>=
+@!char_widths:array[char_pointer] of width_pointer; {width pointers}
+@!char_packets:array[char_pointer] of pckt_pointer; {packet pointers}
+@!n_chars:char_pointer; {first unused position in |char_widths|}
+
+@ @<Set init...@>=
+n_chars:=0;
+
+@ The current number of known fonts is |nf|; each known font has an
+internal number |f|, where |0<=f<nf|. For the moment we need for each
+known font: |font_check|, |font_scaled|, |font_design|, |font_name|,
+|font_bc|, |font_ec|, |font_chars|, and |font_type|. Here |font_scaled|
+and |font_design| are measured in \.{DVI} units and |font_chars| is of
+type |char_offset|: the width pointer for character~|c| of the font is
+stored in |char_widths[char_offset+c]| (for |font_bc<=c<=font_ec|).
+Later on we will need additional information depending on the font type:
+\.{VF} or real (\.{GF}, \.{PK} or \.{PXL}).
+
+@<Types...@>=
+@!f_type=defined_font..max_font_type; {type of a font}
+@!font_number=0..max_fonts;
+
+@ @<Glob...@>=
+@!nf:font_number;
+
+@ These data are stored in several arrays and we use \.{WEB} macros
+to access the various fields. Thus it would be simple to store the
+data in an array of record structures and adapt the \.{WEB} macros
+accordingly.
+
+We will say, e.g., |font_name(f)| for the name field of font~|f|, and
+|font_width(f)(c)| for the width pointer of character~|c| in font~|f|
+and |font_packet(f)(c)| for its character packet (this character
+exists provided |font_bc(f)<=c<=font_ec(f)| and
+|font_width(f)(c)<>invalid_width|). The actual width of character~|c| in
+font~|f| is stored in |widths[font_width(f)(c)]|.
+
+@d font_check(#)==fnt_check[#] {checksum}
+@d font_scaled(#)==fnt_scaled[#] {scaled or `at' size}
+@d font_design(#)==fnt_design[#] {design size}
+@d font_name(#)==fnt_name[#] {area plus name packet}
+@d font_bc(#)==fnt_bc[#] {first character}
+@d font_ec(#)==fnt_ec[#] {last character}
+@d font_chars(#)==fnt_chars[#] {character info offset}
+@d font_type(#)==fnt_type[#] {type of this font}
+@d font_font(#)==fnt_font[#] {use depends on |font_type|}
+@#
+@d font_width_end(#)==#]
+@d font_width(#)==char_widths[font_chars(#)+font_width_end
+@d font_packet(#)==char_packets[font_chars(#)+font_width_end
+@d font_extend(#)==fnt_extended[#]
+
+@<Glob...@>=
+@!fnt_check:array [font_number] of int_32; {checksum}
+@!fnt_scaled:array [font_number] of int_31; {scaled size}
+@!fnt_design:array [font_number] of int_31; {design size}
+@!device @<Declare device dependent font data arrays@>@; @+ ecived @; @/
+@!fnt_name:array [font_number] of pckt_pointer; {pointer to area plus
+ name packet}
+@!fnt_bc:array [font_number] of int_31; {first character}
+@!fnt_ec:array [font_number] of int_31; {last character}
+@!fnt_chars:array [font_number] of char_offset; {character info offset}
+@!fnt_type:array [font_number] of f_type; {type of font}
+@!fnt_font:array [font_number] of font_number; {use depends on |font_type|}
+@!fnt_extended:array [font_number] of boolean; {\.{TFM} or \.{OFM} file}
+
+@ @d invalid_font==max_fonts {used when there is no valid font}
+
+@<Set init...@>=
+@!device @<Initialize device dependent font data@>@; @+ ecived @;@/
+nf:=0;
+
+@ A \.{VF}, or \.{GF}, or \.{PK} file may contain information for
+several characters with the same residue but with different extension;
+all except the first of the corresponding packets in |byte_mem| will
+contain a pointer to the previous one and |font_packet(f)(res)|
+identifies the last such packet.
+
+A character packet in |byte_mem| starts with a flag byte
+$$\hbox{|flag=@"40*ext_flag+@"20*chain_flag+type_flag|}$$
+with |0<=ext_flag<=3|, |0<=chain_flag<=1|, |0<=type_flag<=@"1F|,
+followed by |ext_flag| bytes with the character extension for this
+packet and, if |chain_flag=1|, by a two byte packet pointer to the
+previous packet for the same font and character residue. The actual
+character packet follows after these header bytes and the
+interpretation of the |type_flag| depends on whether this is a \.{VF}
+packet or a packet for raster data.
+
+The empty packet is interpreted as a special case of a packet with
+|flag=0|.
+
+@d ext_flag=@"40
+@d chain_flag=@"20
+
+@<Types...@>=
+@!type_flag=0..chain_flag-1; {the range of values for the |type_flag|}
+
+@ The global variable |cur_fnt| is the internal font number of the
+currently selected font, or equals |invalid_font| if no font has
+been selected; |cur_res| and |cur_ext| are the residue and extension
+part of the current character code. The type of a character packet
+located by the |find_packet| function defined below is |cur_type|.
+While building a character packet for a character, |pckt_ext| and
+|pckt_res| are the extension and residue of this character; |pckt_dup|
+indicates whether a packet for this extension exists already.
+
+@<Glob...@>=
+@!cur_fnt:font_number; {the currently selected font}
+@!cur_ext:int_24; {the current character extension}
+@!cur_res:int_32; {the current character residue}
+@!cur_type:type_flag; {type of the current character packet}
+@!pckt_ext:int_24; {character extension for the current character packet}
+@!pckt_res:int_32; {character residue for the current character packet}
+@!pckt_dup:boolean; {is there a previous packet for the same extension?}
+@!pckt_prev:pckt_pointer; {a previous packet for the same extension}
+@!pckt_m_msg,@!pckt_s_msg,@!pckt_d_msg:int_7; {counts for various character
+ packet error messages}
+
+@ @<Set init...@>=
+cur_fnt:=invalid_font; pckt_m_msg:=0; pckt_s_msg:=0; pckt_d_msg:=0;
+
+@ The |find_packet| functions is used to locate the character packet for
+the character with residue~|cur_res| and extension~|cur_ext| from
+font~|cur_fnt| and returns |false| if no packet exists for any extension;
+otherwise the result is |true| and the global variables |cur_packet|,
+|cur_type|, |cur_loc|, and |cur_limit| are initialized. In case none of
+the character packets has the correct extension, the last one in the
+chain (the one defined first) is used instead and |cur_ext| is changed
+accordingly.
+
+@p function find_packet:boolean;
+label found,exit;
+var p,@!q:pckt_pointer; {current and next packet}
+@!f:eight_bits; {a flag byte}
+@!e:int_24; {extension for a packet}
+begin @<Locate a character packet and |goto found| if found@>;
+if font_packet(cur_fnt)(cur_res)=invalid_packet then
+ begin if pckt_m_msg<10 then {stop telling after first 10 times}
+ begin print_ln('---missing character packet for character ',cur_res:1,
+@.missing character packet...@>
+ ' font ',cur_fnt:1);
+ incr(pckt_m_msg); mark_error;
+ if pckt_m_msg=10 then print_ln('---further messages suppressed.');
+ end;
+ find_packet:=false; return;
+ end;
+if pckt_s_msg<10 then {stop telling after first 10 times}
+ begin print_ln('---substituted character packet with extension ',
+@.substituted character packet...@>
+ e:1,' instead of ',cur_ext:1,' for character ',cur_res:1,
+ ' font ',cur_fnt:1);
+ incr(pckt_s_msg); mark_error;
+ if pckt_s_msg=10 then print_ln('---further messages suppressed.');
+ end;
+cur_ext:=e;
+found: cur_pckt:=p; cur_type:=f; find_packet:=true;
+exit: end;
+
+@ @<Locate a character packet and |goto found| if found@>=
+q:=font_packet(cur_fnt)(cur_res);
+while q<>invalid_packet do
+ begin p:=q; q:=invalid_packet;
+ cur_loc:=pckt_start[p]; cur_limit:=pckt_start[p+1];
+ if p=empty_packet then
+ begin e:=0; f:=0;
+ end
+ else begin pckt_extract(f);
+ case (f div ext_flag) of
+ 0: e:=0;
+ 1: e:=pckt_ubyte;
+ 2: e:=pckt_upair;
+ 3: e:=pckt_strio;
+ end; {there are no other cases}
+ if (f mod ext_flag)>=chain_flag then q:=pckt_upair;
+ f:=f mod chain_flag;
+ end;
+ if e=cur_ext then goto found;
+ end
+
+@ The |start_packet| procedure is used to create the header bytes of a
+character packet for the character with residue~|cur_res| and
+extension~|cur_ext| from font~|cur_fnt|; if a previous such packet
+exists, we try to build an exact duplicate, i.e., use the chain field of
+that previous packet.
+
+@p procedure start_packet(@!t:type_flag);
+label found,not_found;
+var p,@!q:pckt_pointer; {current and next packet}
+@!f:int_8u; {a flag byte}
+@!e:int_32; {extension for a packet}
+@!cur_loc: byte_pointer; {current location in a packet}
+@!cur_limit: byte_pointer; {start of next packet}
+begin @<Locate a character packet and |goto found| if found@>;
+q:=font_packet(cur_fnt)(cur_res); pckt_dup:=false; goto not_found;
+found: pckt_dup:=true; pckt_prev:=p;
+not_found: pckt_ext:=cur_ext; pckt_res:=cur_res; pckt_room(6);
+@!debug if byte_ptr<>pckt_start[pckt_ptr] then confusion(str_packets);
+gubed @;@/
+if q=invalid_packet then f:=t @+ else f:=t+chain_flag;
+e:=cur_ext;
+if e<0 then Incr(e)(@"1000000);
+if e=0 then append_byte(f) @+ else @;
+ begin if e<@"100 then append_byte(f+ext_flag) @+ else @;
+ begin if e<@"10000 then append_byte(f+ext_flag+ext_flag) @+ else @;
+ begin append_byte(f+ext_flag+ext_flag+ext_flag);
+ append_byte(e div @"10000); e:=e mod @"10000;
+ end;
+ append_byte(e div @"100); e:=e mod @"100;
+ end;
+ append_byte(e);
+ end;
+if q<>invalid_packet then
+ begin append_byte(q div @"100); append_byte(q mod @"100);
+ end;
+end;
+
+@ The |build_packet| procedure is used to finish a character packet.
+If a previous packet for the same character extension exists, the new
+one is discarded; if the two packets are identical, as it occasionally
+occurs for raster files, this is done without an error message.
+
+@p procedure build_packet;
+var k,@!l:byte_pointer; {indices into |byte_mem|}
+begin if pckt_dup then
+ begin k:=pckt_start[pckt_prev+1]; l:=pckt_start[pckt_ptr];
+ if (byte_ptr-l)<>(k-pckt_start[pckt_prev]) then pckt_dup:=false;
+ while pckt_dup and(byte_ptr>l) do
+ begin flush_byte; decr(k);
+ if byte_mem[byte_ptr]<>byte_mem[k] then pckt_dup:=false;
+ end;
+ if (not pckt_dup)and(pckt_d_msg<10) then {stop telling after first 10 times}
+ begin print('---duplicate packet for character ',pckt_res:1);
+@.duplicate packet for character...@>
+ if pckt_ext<>0 then print('.',pckt_ext:1);
+ print_ln(' font ',cur_fnt:1);
+ incr(pckt_d_msg); mark_error;
+ if pckt_d_msg=10 then print_ln('---further messages suppressed.');
+ end;
+ byte_ptr:=l;
+ end
+else font_packet(cur_fnt)(pckt_res):=make_packet;
+end;
+
+@* Defining fonts.
+A detailed description of the \.{TFM} file format can be found in the
+documentation of \TeX, \MF, or \.{TFtoPL}. In order to read \.{TFM}
+files the program uses the binary file variable |tfm_file|.
+
+@<Glob...@>=
+@!tfm_file:byte_file; {a \.{TFM} file}
+@!tfm_ext:pckt_pointer; {extension for \.{TFM} files}
+@!ofm_ext:pckt_pointer; {extension for \.{OFM} files}
+
+@ @<Initialize predefined strings@>=
+id4(".")("T")("F")("M")(tfm_ext); {file name extension for \.{TFM} files}
+id4(".")("O")("F")("M")(ofm_ext); {file name extension for \.{OFM} files}
+
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{TFM} directory, which is a system-dependent place where
+the \.{TFM} files for standard fonts are kept.
+The string variable |TFM_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d TFM_default_area_name=='TeXfonts:' {change this to the correct name}
+@d OFM_default_area_name=='TeXfonts:' {change this to the correct name}
+@d TFM_default_area_name_length=9 {change this to the correct length}
+@d OFM_default_area_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!TFM_default_area:packed array[1..TFM_default_area_name_length] of char;
+@!OFM_default_area:packed array[1..OFM_default_area_name_length] of char;
+
+@ @<Set init...@>=
+TFM_default_area:=TFM_default_area_name;
+OFM_default_area:=OFM_default_area_name;
+
+@ If a \.{TFM} file is badly malformed, we say |bad_font|; for a \.{TFM}
+file the |bad_tfm| procedure is used to give an error message which
+refers the user to \.{TFtoPL} and \.{PLtoTF}, and terminates \.{\title}.
+
+@<Error handling...@>=
+procedure bad_tfm;
+begin print('Bad TFM or OFM file'); print_font(cur_fnt); print_ln('!');
+@.Bad TFM or OFM file@>
+abort('Use OFM2OPL/OPL2OFM/TFtoPL/PLtoTF to diagnose and correct the problem');
+@.Use OFM2OPL/OPL2OFM/TFtoPL/PLtoTF@>
+end;
+@#
+procedure bad_font;
+begin new_line;
+case font_type(cur_fnt) of
+ defined_font: confusion(str_fonts);
+ loaded_font: bad_tfm;
+ @<Cases for |bad_font|@>@;@/
+ end; {there are no other cases}
+end;
+
+@ To prepare |tfm_file| for input we |reset| it.
+
+@<TFM: Open |tfm_file|@>=
+make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
+reset(tfm_file,cur_name);
+if eof(tfm_file) then begin
+ make_font_name(OFM_default_area_name_length)(OFM_default_area)(ofm_ext);
+ reset(tfm_file,cur_name);
+ if eof(tfm_file) then
+@^system dependencies@>
+ abort('---not loaded, TFM or OFM file can''t be opened!')
+ else font_extend(cur_fnt):=true
+@.TFM or OFM file can\'t be opened@>
+ end
+else font_extend(cur_fnt):=false
+
+@ It turns out to be convenient to read four bytes at a time, when we
+are inputting from \.{TFM} files. The input goes into global variables
+|tfm_b0|, |tfm_b1|, |tfm_b2|, and |tfm_b3|, with |tfm_b0| getting
+the first byte and |tfm_b3| the fourth.
+
+@<Glob...@>=
+@!tfm_b0,@!tfm_b1,@!tfm_b2,@!tfm_b3: eight_bits; {four bytes input at once}
+
+@ Reading a \.{TFM} file should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes from |tfm_file| is read into a buffer and will then be extracted
+from that buffer. In order to simplify such system dependent changes
+we use the \.{WEB} macro |tfm_byte| to extract the next \.{TFM} or \.{OFM}
+byte; this macro and |eof(tfm_file)| are used only in the |read_tfm_word|
+procedure which sets |tfm_b0| through |tfm_b3| to the next four bytes
+in the current \.{TFM} file. Here we give simple-minded definitions in
+terms of standard \PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d tfm_byte(#)==read(tfm_file,#) {read next \.{TFM} byte}
+
+@p procedure read_tfm_word;
+begin tfm_byte(tfm_b0); tfm_byte(tfm_b1);
+tfm_byte(tfm_b2); tfm_byte(tfm_b3);
+if eof(tfm_file) then bad_font;
+end;
+
+@ Here are three procedures used to check the consistency of font files:
+First, the |check_check_sum| procedure compares two check sum values: a
+warning is given if they differ and are both non-zero; if the second
+value is not zero it may replace the first one.
+Next, the |check_design_size| procedure compares two design size
+values: a warning is given if they differ by more than a small amount.
+Finally, the |check_width| function compares the character width value
+for character |cur_res| read from a \.{VF} or raster file for font
+|cur_fnt| with the value previously read from the \.{TFM} file and
+returns the width pointer for that value; a warning is given if the two
+values differ.
+
+@p procedure check_check_sum(@!c:int_32;@!u:boolean);
+ {compare |font_check(cur_fnt)| with |c|}
+begin if (c<>font_check(cur_fnt))and(c<>0) then
+ begin
+ if font_check(cur_fnt)<>0 then
+ begin new_line; print_ln('---beware: check sums do not agree! (',
+@.beware: check sums do not agree@>
+@.check sums do not agree@>
+ c:1,' vs. ',font_check(cur_fnt):1,')');
+ mark_harmless;
+ end;
+ if u then font_check(cur_fnt):=c;
+ end;
+end;
+@#
+procedure check_design_size(@!d:int_32);
+ {compare |font_design(cur_fnt)| with |d|}
+begin if abs(d-font_design(cur_fnt))>2 then
+ begin new_line; print_ln('---beware: design sizes do not agree! (',
+@.beware: design sizes do not agree@>
+@.design sizes do not agree@>
+ d:1,' vs. ',font_design(cur_fnt):1,')');
+ mark_error;
+ end;
+end;
+@#
+procedure print_hex(@!num:int_31);
+var c:int_31;
+begin print('"');
+c:=num div @"10000000;
+if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']);
+num:=num mod @"10000000;
+c:=num div @"1000000;
+if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']);
+num:=num mod @"1000000;
+c:=num div @"100000;
+if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']);
+num:=num mod @"100000;
+c:=num div @"10000;
+if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']);
+num:=num mod @"10000;
+c:=num div @"1000;
+if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']);
+num:=num mod @"1000;
+c:=num div @"100;
+if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']);
+num:=num mod @"100;
+c:=num div @"10;
+if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']);
+num:=num mod @"10;
+c:=num;
+if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']);
+end;
+@#
+function check_width(w:int_32):width_pointer;
+ {compare |widths[font_width(cur_fnt)(cur_res)]| with |w|}
+var wp:width_pointer; {pointer to \.{TFM} width value}
+begin if (cur_res>=font_bc(cur_fnt))and(cur_res<=font_ec(cur_fnt)) then
+ wp:=font_width(cur_fnt)(cur_res)
+else wp:=invalid_width;
+if wp=invalid_width then
+ begin print_nl('Bad char ',cur_res:1);
+@.Bad char c@>
+ if cur_ext<>0 then print('.',cur_ext:1);
+ print(' font ',cur_fnt:1); print_font(cur_fnt);
+ abort(' (compare TFM or OFM file)');
+ end;
+if w<>widths[wp] then
+ begin
+ print_hex(cur_ext);
+ print(' ');
+ print_hex(cur_res);
+ print(': char widths do not agree! (');
+@.beware: char widths do not agree@>
+@.char widths do not agree@>
+ print_hex(w);
+ print(' vs. ');
+ print_hex(widths[wp]);
+ print_ln(')');
+ mark_error;
+ end;
+check_width:=wp;
+end;
+
+@ The |load_font| procedure reads the \.{TFM} file for a font and puts
+the data extracted into position |cur_fnt| of the font data arrays.
+
+@p procedure load_font; {reads a \.{TFM} file}
+var l,j,lprime:int_32; {loop index}
+@!p:char_pointer; {index into |char_widths|}
+@!q:width_pointer; {index into |widths|}
+@!bc,@!ec:int_31; {first and last character in this font}
+@!lf:int_31; {length of file in four byte words}
+@!lh:int_31; {length of header in four byte words}
+@!nw:int_31; {number of words in width table}
+@!w:int_32; {a four byte integer}
+@!first_two:int_31;
+@!ofm_level:int_32;
+@!nco,@!extra_words:int_31;
+@!tfm_width:int_31;
+@<Variables for scaling computation@>@;
+begin print('TFM: font ',cur_fnt:1); print_font(cur_fnt);
+font_type(cur_fnt):=loaded_font;
+@<TFM: Open |tfm_file|@>;
+@<TFM: Read past the header data@>;
+@<TFM: Store character-width indices@>;
+@<TFM: Read and convert the width values@>;
+@<TFM: Convert character-width indices to character-width pointers@>;
+close_in(tfm_file);
+@!device @<Initialize device dependent data for a font@>@; @+ ecived @; @/
+d_print(' loaded at ',font_scaled(cur_fnt):1,' DVI units');
+print_ln('.');
+end;
+
+@ @<Glob...@>=
+@!tfm_conv:real; {\.{DVI} units per absolute \.{TFM} unit}
+
+@ We will use the following \.{WEB} macros to construct integers from
+two or four of the four bytes read by |read_tfm_word|.
+@^system dependencies@>
+
+@d tfm_b03(#)== {|tfm_b0..tfm_b3| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*@"1000000+tfm_b1*@"10000+tfm_b2*@"100+tfm_b3
+
+@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*256+tfm_b1
+@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
+if tfm_b2>127 then bad_font
+else #:=tfm_b2*256+tfm_b3
+@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
+if tfm_b0<128 then #:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+else #:=(((tfm_b0-256)*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
+(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3)
+
+@d read_tfm_width(#)==begin
+read_tfm_word;
+if first_two<>0 then tfm_width:=tfm_b0
+else begin
+ if # then read_tfm_word;
+ tfm_b01(tfm_width);
+ end
+end
+
+@<TFM: Read past the header data@>=
+read_tfm_word; tfm_b01(first_two);
+if (first_two<>0) then begin
+ ofm_level:=-1;
+ tfm_b23(lh);
+ read_tfm_word; tfm_b01(bc); tfm_b23(ec);
+ if ec<bc then
+ begin bc:=1; ec:=0;
+ end
+ else if ec>255 then bad_font;
+ read_tfm_word; tfm_b01(nw);
+ if (nw=0)or(nw>256) then bad_font;
+ for l:=-2 to lh do
+ begin read_tfm_word;
+ if l=1 then
+ begin tfm_squad(w); check_check_sum(w,true);
+ end
+ else if l=2 then
+ begin if tfm_b0>127 then bad_font;
+ check_design_size(round(tfm_conv*tfm_uquad));
+ end
+ end
+ end
+else begin
+ tfm_b23(ofm_level);
+ read_tfm_word; tfm_b03(lf);
+ read_tfm_word; tfm_b03(lh);
+ read_tfm_word; tfm_b03(bc);
+ read_tfm_word; tfm_b03(ec);
+ if ec<bc then begin
+ bc:=1; ec:=0;
+ end
+ else if ec>65535 then bad_font;
+ read_tfm_word; tfm_b03(nw);
+ if (nw=0)or(nw>65536) then bad_font;
+ for l:=1 to 8 do
+ begin if eof(tfm_file) then bad_font;
+ read_tfm_word;
+ end;
+ if ofm_level=1 then begin
+ read_tfm_word;
+ nco:=(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3) div 2;
+ read_tfm_word; read_tfm_word;
+ extra_words:=(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3) div 2;
+ for l:=1 to 12 do
+ begin if eof(tfm_file) then bad_font;
+ read_tfm_word;
+ end;
+ end;
+ for l:=1 to lh do begin
+ read_tfm_word;
+ if l=1 then begin
+ tfm_squad(w); check_check_sum(w,true);
+ end
+ else if l=2 then begin
+ if tfm_b0>127 then bad_font;
+ check_design_size(round(tfm_conv*tfm_uquad));
+ end
+ end;
+ if ofm_level>0 then
+ for l:=1 to (nco-29-lh) do
+ read_tfm_word;
+ end
+
+@ The width indices for the characters are stored in positions |n_chars|
+through |n_chars-bc+ec| of the |char_widths| array; if characters on
+either end of the range |bc..ec| do not exist, they are ignored and the
+range is adjusted accordingly.
+
+@<TFM: Store character-width indices@>=
+if ofm_level<=0 then begin
+ read_tfm_width(false);
+ while (tfm_width=0)and(bc<=ec) do
+ begin incr(bc); read_tfm_width(true);
+ end;
+ font_bc(cur_fnt):=bc; font_chars(cur_fnt):=n_chars-bc;
+ if ec>=max_chars-font_chars(cur_fnt) then overflow(str_chars,max_chars);
+ for l:=bc to ec do
+ begin char_widths[n_chars]:=tfm_width; incr(n_chars); read_tfm_width(true);
+ end;
+ while (char_widths[n_chars-1]=0)and(ec>=bc) do
+ begin decr(n_chars); decr(ec);
+ end;
+ font_ec(cur_fnt):=ec
+ end
+else begin
+ font_bc(cur_fnt):=bc; font_chars(cur_fnt):=n_chars-bc;
+ if ec>=max_chars-font_chars(cur_fnt) then overflow(str_chars,max_chars);
+ font_ec(cur_fnt):=ec;
+ l:=bc;
+ while l<ec do begin
+ read_tfm_word;
+ tfm_width:=tfm_b0*256+tfm_b1;
+ char_widths[n_chars]:=tfm_width; incr(n_chars);
+ read_tfm_word; read_tfm_word;
+ lprime:=l+(tfm_b0*256+tfm_b1);
+ for j:=l+1 to lprime do begin
+ char_widths[n_chars]:=tfm_width; incr(n_chars);
+ end;
+ l:=lprime;
+ for j:=1 to extra_words do
+ read_tfm_word;
+ end;
+ read_tfm_word;
+ end
+
+@ The most important part of |load_font| is the width computation, which
+involves multiplying the relative widths in the \.{TFM} file by the
+scaling factor in the \.{DVI} file. A similar computation is used for
+dimensions read from \.{VF} files. This fixed-point multiplication must
+be done with precisely the same accuracy by all \.{DVI}-reading programs,
+in order to validate the assumptions made by \.{DVI}-writing programs
+like \TeX82.
+
+Let us therefore summarize what needs to be done. Each width in a \.{TFM}
+file appears as a four-byte quantity called a |fix_word|. A |fix_word|
+whose respective bytes are $(a,b,c,d)$ represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+(No other choices of $a$ are allowed, since the magnitude of a \.{TFM}
+dimension must be less than 16.) We want to multiply this quantity by the
+integer~|z|, which is known to be less than $2^{27}$.
+If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$,
+$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or
+16, to obtain a multiplier less than $2^{23}$, and we can compensate for
+this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let
+$\beta=2^{4-e}$; we shall compute
+$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$,
+or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
+This calculation must be done exactly, for the reasons stated above; the
+following program does the job in a system-independent way, assuming
+that arithmetic is exact on numbers less than $2^{31}$ in magnitude. We
+use \.{WEB} macros for various versions of this computation.
+@^system dependencies@>
+@^optimization@>
+
+@d tfm_fix3u== {convert |tfm_b1..tfm_b3| to an unsigned scaled dimension}
+(((((tfm_b3*z)div@'400)+(tfm_b2*z))div@'400)+(tfm_b1*z))div beta
+@#
+@d tfm_fix4(#)== {convert |tfm_b0..tfm_b3| to a scaled dimension}
+ #:=tfm_fix3u;
+ if tfm_b0>0 then if tfm_b0=255 then Decr(#)(alpha) else bad_font
+@d tfm_fix3(#)== {convert |tfm_b1..tfm_b3| to a scaled dimension}
+ #:=tfm_fix3u; @+ if tfm_b1>127 then Decr(#)(alpha)
+@d tfm_fix2== {convert |tfm_b2..tfm_b3| to a scaled dimension}
+ if tfm_b2>127 then tfm_b1:=255 else tfm_b1:=0;
+ tfm_fix3
+@d tfm_fix1== {convert |tfm_b3| to a scaled dimension}
+ if tfm_b3>127 then tfm_b1:=255 else tfm_b1:=0;
+ tfm_b2:=tfm_b1; tfm_fix3
+
+@<Variables for scaling computation@>=
+@!z:int_32; {multiplier}
+@!alpha:int_32; {correction for negative values}
+@!beta:int_15; {divisor}
+
+@ @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>=
+alpha:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; alpha:=alpha+alpha;
+ end;
+beta:=256 div alpha; alpha:=alpha*z
+
+@ The first width value, which indicates that a character does not exist
+and which must vanish, is converted to |invalid_width|; the other width
+values are scaled by |font_scaled(cur_fnt)| and converted to width
+pointers by |make_width|. The resulting width pointers are stored
+temporarily in the |char_widths| array, following the with indices.
+
+@<TFM: Read and convert the width values@>=
+if nw-1>max_chars-n_chars then overflow(str_chars,max_chars);
+if (tfm_b0<>0)or(tfm_b1<>0)or(tfm_b2<>0)or(tfm_b3<>0) then bad_font
+ else char_widths[n_chars]:=invalid_width;
+z:=font_scaled(cur_fnt);
+@<Replace |z|...@>;
+for p:=n_chars+1 to n_chars+nw-1 do
+ begin read_tfm_word; tfm_fix4(w);
+ char_widths[p]:=make_width(w);
+ end
+
+@ We simply translate the width indices into width pointers. In addition
+we initialize the character packets with the invalid packet.
+
+@<TFM: Convert character-width indices to character-width pointers@>=
+for p:=font_chars(cur_fnt)+bc to n_chars-1 do
+ begin q:=char_widths[n_chars+char_widths[p]]; char_widths[p]:=q;
+ char_packets[p]:=invalid_packet;
+ end
+
+@ When processing a font definition we put the data extracted from the
+\.{DVI} or \.{VF} file into position |nf| of the font data arrays and
+call |define_font| to obtain the internal font number for this font.
+The parameter |load| is true if the \.{TFM} file should be loaded.
+
+@p function define_font(@!load:boolean):font_number;
+var save_fnt:font_number; {used to save |cur_fnt|}
+begin save_fnt:=cur_fnt; {save}
+cur_fnt:=0;
+while (font_name(cur_fnt)<>font_name(nf))or@|
+ (font_scaled(cur_fnt)<>font_scaled(nf)) do incr(cur_fnt);
+d_print(' => ',cur_fnt:1); print_font(cur_fnt);
+if cur_fnt<nf then
+ begin check_check_sum(font_check(nf),true);
+ check_design_size(font_design(nf));
+ @!debug if font_type(cur_fnt)=defined_font then print(' defined')
+ else print(' loaded');
+ print(' previously');
+ gubed@;
+ end
+else begin if nf=max_fonts then overflow(str_fonts,max_fonts);
+ incr(nf); font_font(cur_fnt):=invalid_font;
+ font_type(cur_fnt):=defined_font;
+ d_print(' defined');
+ end;
+print_ln('.');
+if load and(font_type(cur_fnt)=defined_font) then load_font;
+define_font:=cur_fnt;
+cur_fnt:=save_fnt; {restore}
+end;
+
+@* Low-level DVI input routines.
+The program uses the binary file variable |dvi_file| for its main input
+file; |dvi_loc| is the number of the byte about to be read next from
+|dvi_file|.
+
+@<Glob...@>=
+@!dvi_file:byte_file; {the stuff we are \.{\title}ing}
+@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
+
+@ If the \.{DVI} file is badly malformed, we say |bad_dvi|; this
+procedure gives an error message which refers the user to \.{DVItype},
+and terminates \.{\title}.
+
+@<Error handling...@>=
+procedure bad_dvi;
+begin new_line; print_ln('Bad DVI file: loc=',dvi_loc:1,'!');
+@.Bad DVI file@>
+print(' Use DVItype with output level');
+@.Use DVItype@>
+if random_reading then print('=4') @+ else print('<4');
+abort('to diagnose the problem');
+end;
+
+@ To prepare |dvi_file| for input, we |reset| it.
+
+@<Open input file(s)@>=
+reset(dvi_file); {prepares to read packed bytes from |dvi_file|}
+dvi_loc:=0;
+
+@ Reading the \.{DVI} file should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes from |dvi_file| is read into a buffer and will then be extracted
+from that buffer. In order to simplify such system dependent changes
+we use a pair of \.{WEB} macros: |dvi_byte| extracts the next \.{DVI}
+byte and |dvi_eof| is |true| if we have reached the end of the \.{DVI}
+file. Here we give simple minded definitions for these macros in terms
+of standard \PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d dvi_eof == eof(dvi_file) {has the \.{DVI} file been exhausted?}
+@d dvi_byte(#) ==
+ if dvi_eof then bad_dvi
+ else read(dvi_file,#) {obtain next \.{DVI} byte}
+
+@ Next we come to the routines that are used only if |random_reading| is
+|true|. The driver program below needs two such routines: |dvi_length| should
+compute the total number of bytes in |dvi_file|, possibly also
+causing |eof(dvi_file)| to be true; and |dvi_move(n)| should position
+|dvi_file| so that the next |dvi_byte| will read byte |n|, starting with
+|n=0| for the first byte in the file.
+@^system dependencies@>
+
+Such routines are, of course, highly system dependent. They are implemented
+here in terms of two assumed system routines called |set_pos| and |cur_pos|.
+The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
+negative or larger than the total number of items in |f|; in the latter
+case, |set_pos(f,n)| moves to the end of file |f|.
+The call |cur_pos(f)| gives the total number of items in |f|, if
+|eof(f)| is true; we use |cur_pos| only in such a situation.
+
+@p function dvi_length:int_32;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure dvi_move(@!n:int_32);
+begin set_pos(dvi_file,n); dvi_loc:=n;
+end;
+
+@ We need seven simple functions to read the next byte or bytes
+from |dvi_file|.
+
+@p function dvi_sbyte:int_8; {returns the next byte, signed}
+@!begin_byte(dvi_byte); incr(dvi_loc); comp_sbyte(dvi_sbyte);
+end;
+@#
+function dvi_ubyte:int_8u; {returns the next byte, unsigned}
+@!begin_byte(dvi_byte); incr(dvi_loc); comp_ubyte(dvi_ubyte);
+end;
+@#
+function dvi_spair:int_16; {returns the next two bytes, signed}
+@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_spair(dvi_spair);
+end;
+@#
+function dvi_upair:int_16u; {returns the next two bytes, unsigned}
+@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_upair(dvi_upair);
+end;
+@#
+function dvi_strio:int_24; {returns the next three bytes, signed}
+@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_strio(dvi_strio);
+end;
+@#
+function dvi_utrio:int_24u; {returns the next three bytes, unsigned}
+@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_utrio(dvi_utrio);
+end;
+@#
+function dvi_squad:int_32; {returns the next four bytes, signed}
+@!begin_quad(dvi_byte); Incr(dvi_loc)(4); comp_squad(dvi_squad);
+end;
+
+@ Three other functions are used in cases where a four byte integer
+(which is always signed) must have a non-negative value, a positive
+value, or is a pointer which must be either positive or |=-1|.
+
+@p function dvi_uquad:int_31; {result must be non-negative}
+var x:int_32;
+begin x:=dvi_squad; if x<0 then bad_dvi
+else dvi_uquad:=x;
+end;
+@#
+function dvi_pquad:int_31; {result must be positive}
+var x:int_32;
+begin x:=dvi_squad; if x<=0 then bad_dvi
+else dvi_pquad:=x;
+end;
+@#
+function dvi_pointer:int_32; {result must be positive or |=-1|}
+var x:int_32;
+begin x:=dvi_squad; if (x<=0)and(x<>-1) then bad_dvi
+else dvi_pointer:=x;
+end;
+
+@ Given the structure of the \.{DVI} commands it is fairly obvious
+that their interpretation consists of two steps: First zero to four
+bytes are read in order to obtain the value of the first parameter
+(e.g., zero bytes for |set_char_0|, four bytes for |set4|); then,
+depending on the command class, a specific action is performed (e.g.,
+typeset a character but don't move the reference point for |put1..put4|).
+
+The \.{DVItype} program uses large case statements for both steps;
+unfortunately some \PASCAL\ compilers fail to implement large case
+statements efficiently -- in particular those as the one used in the
+|first_par| function of \.{DVItype}. Here we use a pair of look up tables:
+|dvi_par| determines how to obtain the value of the first parameter, and
+|dvi_cl| determines the command class.
+
+A slight complication arises from the fact that we want to decompose the
+character code of each character to be typeset into a residue
+|0<=char_res<256| and extension: |char_code=char_res+256*char_ext|;
+the \.{TFM} widths as well as the pixel widths for a given resolution
+are the same for all characters in a font with the same residue.
+For \.{OFM} files, |char_res| can have any value and |char_ext=0|.
+
+@d two_cases(#)==#,#+1
+@d three_cases(#)==#,#+1,#+2
+@d five_cases(#)==#,#+1,#+2,#+3,#+4
+
+@ First we define the values used as array elements of |dvi_par|; we
+distinguish between pure numbers and dimensions because dimensions read
+from a \.{VF} file must be scaled.
+
+@d char_par=0 {character for \\{set} and |put|}
+@d no_par=1 {no parameter}
+@d dim1_par=2 {one-byte signed dimension}
+@d num1_par=3 {one-byte unsigned number}
+@d dim2_par=4 {two-byte signed dimension}
+@d num2_par=5 {two-byte unsigned number}
+@d dim3_par=6 {three-byte signed dimension}
+@d num3_par=7 {three-byte unsigned number}
+@d dim4_par=8 {four-byte signed dimension}
+@d num4_par=9 {four-byte signed number}
+@d numu_par=10 {four-byte non-negative number}
+@d rule_par=11 {dimensions for |set_rule| and |put_rule|}
+@d fnt_par=12 {font for |fnt_num| commands}
+@d max_par=12 {largest possible value}
+
+@<Types...@>=
+@!cmd_par=char_par..max_par;
+
+@ Here we declare the array |dvi_par|.
+
+@<Globals...@>=
+@!dvi_par:packed array [eight_bits] of cmd_par;
+
+@ And here we initialize it.
+
+@<Set init...@>=
+for i:=0 to put1+3 do dvi_par[i]:=char_par;@/
+for i:=nop to 255 do dvi_par[i]:=no_par;@/
+dvi_par[set_rule]:=rule_par; dvi_par[put_rule]:=rule_par;@/
+dvi_par[right1]:=dim1_par; dvi_par[right1+1]:=dim2_par;
+dvi_par[right1+2]:=dim3_par; dvi_par[right1+3]:=dim4_par;@/
+for i:=fnt_num_0 to fnt_num_0+63 do dvi_par[i]:=fnt_par;@/
+dvi_par[fnt1]:=num1_par; dvi_par[fnt1+1]:=num2_par;
+dvi_par[fnt1+2]:=num3_par; dvi_par[fnt1+3]:=num4_par;@/
+dvi_par[xxx1]:=num1_par; dvi_par[xxx1+1]:=num2_par;
+dvi_par[xxx1+2]:=num3_par; dvi_par[xxx1+3]:=numu_par;@/
+for i:=0 to 3 do
+ begin dvi_par[i+w1]:=dvi_par[i+right1];
+ dvi_par[i+x1]:=dvi_par[i+right1];
+ dvi_par[i+down1]:=dvi_par[i+right1];
+ dvi_par[i+y1]:=dvi_par[i+right1];
+ dvi_par[i+z1]:=dvi_par[i+right1];
+ dvi_par[i+fnt_def1]:=dvi_par[i+fnt1];
+ end;
+
+@ Next we define the values used as array elements of |dvi_cl|;
+several \.{DVI} commands (e.g., |nop|, |bop|, |eop|, |pre|, |post|) will
+always be treated separately and are therfore assigned to the invalid
+class here.
+
+@d char_cl=0
+@d rule_cl=char_cl+1
+@d xxx_cl=char_cl+2
+@d push_cl=3
+@d pop_cl=4
+@d w0_cl=5
+@d x0_cl=w0_cl+1
+@d right_cl=w0_cl+2
+@d w_cl=w0_cl+3
+@d x_cl=w0_cl+4
+@d y0_cl=10
+@d z0_cl=y0_cl+1
+@d down_cl=y0_cl+2
+@d y_cl=y0_cl+3
+@d z_cl=y0_cl+4
+@d fnt_cl=15
+@d fnt_def_cl=16
+@d invalid_cl=17
+@d max_cl=invalid_cl {largest possible value}
+
+@<Types...@>=
+@!cmd_cl=char_cl..max_cl;
+
+@ Here we declare the array |dvi_cl|.
+
+@<Globals...@>=
+@!dvi_cl:packed array [eight_bits] of cmd_cl;
+
+@ And here we initialize it.
+
+@<Set init...@>=
+for i:=set_char_0 to put1+3 do dvi_cl[i]:=char_cl;
+dvi_cl[set_rule]:=rule_cl; dvi_cl[put_rule]:=rule_cl;@/
+dvi_cl[nop]:=invalid_cl;
+dvi_cl[bop]:=invalid_cl; dvi_cl[eop]:=invalid_cl;@/
+dvi_cl[push]:=push_cl; dvi_cl[pop]:=pop_cl;@/
+dvi_cl[w0]:=w0_cl; dvi_cl[x0]:=x0_cl;@/
+dvi_cl[y0]:=y0_cl; dvi_cl[z0]:=z0_cl;@/
+for i:=0 to 3 do
+ begin dvi_cl[i+right1]:=right_cl;
+ dvi_cl[i+w1]:=w_cl;
+ dvi_cl[i+x1]:=x_cl;@/
+ dvi_cl[i+down1]:=down_cl;
+ dvi_cl[i+y1]:=y_cl;
+ dvi_cl[i+z1]:=z_cl;@/
+ dvi_cl[i+xxx1]:=xxx_cl;
+ dvi_cl[i+fnt_def1]:=fnt_def_cl;
+ end;
+for i:=fnt_num_0 to fnt1+3 do dvi_cl[i]:=fnt_cl;
+for i:=pre to 255 do dvi_cl[i]:=invalid_cl;
+
+@ A few small arrays are used to generate \.{DVI} commands.
+
+@<Glob...@>=
+@!dvi_char_cmd:array[boolean] of eight_bits; {|put1| and |set1|}
+@!dvi_rule_cmd:array[boolean] of eight_bits; {|put_rule| and |set_rule|}
+@!dvi_right_cmd:array[right_cl..x_cl] of eight_bits; {|right1|, |w1|, and |x1|}
+@!dvi_down_cmd:array[down_cl..z_cl] of eight_bits; {|down1|, |y1|, and |z1|}
+
+@ @<Set init...@>=
+dvi_char_cmd[false]:=put1;
+dvi_char_cmd[true]:=set1;@/
+dvi_rule_cmd[false]:=put_rule;
+dvi_rule_cmd[true]:=set_rule;@/
+dvi_right_cmd[right_cl]:=right1;
+dvi_right_cmd[w_cl]:=w1;
+dvi_right_cmd[x_cl]:=x1;@/
+dvi_down_cmd[down_cl]:=down1;
+dvi_down_cmd[y_cl]:=y1;
+dvi_down_cmd[z_cl]:=z1;
+
+@ The global variables |cur_cmd|, |cur_parm| and |cur_class| are used
+for the current \.{DVI} command, its first parameter (if any), and its
+command class respectively.
+
+@<Glob...@>=
+@!cur_cmd:eight_bits; {current \.{DVI} command byte}
+@!cur_parm:int_32; {its first parameter (if any)}
+@!cur_class:cmd_cl; {its class}
+
+@ When typesetting a character or rule, the boolean variable |cur_upd|
+is |true| for \\{set} commands, |false| for |put| commands.
+
+@<Glob...@>=
+@!cur_cp:char_pointer; {|char_widths| index for the current character}
+@!cur_wp:width_pointer; {width pointer of the current character}
+@!cur_upd:boolean; {is this a \\{set} or |set_rule| command ?}
+@!cur_v_dimen:int_32; {a vertical dimension}
+@!cur_h_dimen:int_32; {a horizontal dimension}
+
+@ @<Set init...@>=
+cur_cp:=0; cur_wp:=invalid_width; {so they can be saved and restored!}
+
+@ The |dvi_first_par| procedure first reads \.{DVI} command bytes into
+|cur_cmd| until |cur_cmd<>nop|; then |cur_parm| is set to the value of
+the first parameter (if any) and |cur_class| to the command class.
+
+@d set_cur_char(#)== {set up |cur_res|, |cur_ext|, and |cur_upd|}
+begin cur_ext:=0;
+if cur_cmd<set1 then
+ begin cur_res:=cur_cmd; cur_upd:=true
+ end
+else begin cur_res:=#; cur_upd:=(cur_cmd<put1);
+ Decr(cur_cmd)(dvi_char_cmd[cur_upd]);
+ if font_extend(cur_fnt) then
+ begin
+ cur_ext:=0;
+ while cur_cmd>0 do
+ begin
+ cur_res:=cur_res*256+#; decr(cur_cmd);
+ end
+ end
+ else
+ while cur_cmd>0 do
+ begin if cur_cmd=3 then if cur_res>127 then cur_ext:=-1;
+ cur_ext:=cur_ext*256+cur_res; cur_res:=#; decr(cur_cmd);
+ end;
+ end;
+end
+
+@p procedure dvi_first_par;
+begin repeat cur_cmd:=dvi_ubyte;
+until cur_cmd<>nop; {skip over |nop|s}
+case dvi_par[cur_cmd] of
+char_par: set_cur_char(dvi_ubyte);
+no_par: do_nothing;
+dim1_par: cur_parm:=dvi_sbyte;
+num1_par: cur_parm:=dvi_ubyte;
+dim2_par: cur_parm:=dvi_spair;
+num2_par: cur_parm:=dvi_upair;
+dim3_par: cur_parm:=dvi_strio;
+num3_par: cur_parm:=dvi_utrio;
+two_cases(dim4_par): cur_parm:=dvi_squad; {|dim4_par| and |num4_par|}
+numu_par: cur_parm:=dvi_uquad;
+rule_par:
+ begin cur_v_dimen:=dvi_squad; cur_h_dimen:=dvi_squad;
+ cur_upd:=(cur_cmd=set_rule);
+ end;
+fnt_par:cur_parm:=cur_cmd-fnt_num_0;
+end; {there are no other cases}
+cur_class:=dvi_cl[cur_cmd];
+end;
+
+@ The global variable |dvi_nf| is used for the number of different
+\.{DVI} fonts defined so far; their external font numbers (as extracted
+from the \.{DVI} file) are stored in the array |dvi_e_fnts|, the
+corresponding internal font numbers used internally by \.{\title} are
+stored in the array |dvi_i_fnts|.
+
+@<Glob...@>=
+@!dvi_e_fnts:array[font_number] of int_32; {external font numbers}
+@!dvi_i_fnts:array[font_number] of font_number; {corresponding
+ internal font numbers}
+@!dvi_nf:font_number; {number of \.{DVI} fonts defined so far}
+
+@ @<Set ini...@>=
+dvi_nf:=0;
+
+@ The |dvi_font| procedure sets |cur_fnt| to the internal font number
+corresponding to the external font number |cur_parm| (or aborts the
+program if such a font was never defined).
+
+@p procedure dvi_font; {computes |cur_fnt| corresponding to |cur_parm|}
+var f:font_number; {where the font is sought}
+begin @<DVI: Locate font |cur_parm|@>;
+if f=dvi_nf then bad_dvi;
+cur_fnt:=dvi_i_fnts[f];
+if font_type(cur_fnt)=defined_font then load_font;
+end;
+
+@ @<DVI: Locate font |cur_parm|@>=
+f:=0; dvi_e_fnts[dvi_nf]:=cur_parm;
+while cur_parm<>dvi_e_fnts[f] do incr(f)
+
+@ Finally the |dvi_do_font| procedure is called when one of the command
+|fnt_def1..fnt_def4| and its first parameter have been read from the
+\.{DVI} file; the argument indicates whether this should be the second
+definition of the font (|true|) or not (|false|).
+
+@p procedure dvi_do_font(@!second:boolean);
+var f:font_number; {where the font is sought}
+@!k:int_15; {general purpose variable}
+begin print('DVI: font ',cur_parm:1);
+@<DVI: Locate font |cur_parm|@>;
+if (f=dvi_nf)=second then bad_dvi;
+font_check(nf):=dvi_squad;
+font_scaled(nf):=dvi_pquad;
+font_design(nf):=dvi_pquad;
+k:=dvi_ubyte; pckt_room(1); append_byte(k);
+Incr(k)(dvi_ubyte); pckt_room(k);
+while k>0 do begin append_byte(dvi_ubyte); decr(k);
+ end;
+font_name(nf):=make_packet; {the font area plus name}
+dvi_i_fnts[dvi_nf]:=define_font(false);
+if not second then
+ begin if dvi_nf=max_fonts then overflow(str_fonts,max_fonts);
+ incr(dvi_nf);
+ end
+else if dvi_i_fnts[f]<>dvi_i_fnts[dvi_nf] then bad_dvi;
+end;
+
+@* Low-level VF input routines.
+A detailed description of the \.{VF} file format can be found in
+the documentation of \.{VFtoVP}; here we just define symbolic names for
+some of the \.{VF} command bytes.
+
+@d long_char=242 {\.{VF} command for general character packet}
+@#
+@d vf_id=202 {identifies \.{VF} files}
+
+@ The program uses the binary file variable |vf_file| for input from
+\.{VF} files; |vf_loc| is the number of the byte about to be read next
+from |vf_file|.
+
+@<Glob...@>=
+@!vf_file:byte_file; {a \.{VF} file}
+@!vf_loc:int_32; {where we are about to look, in |vf_file|}
+@!vf_limit:int_32; {value of |vf_loc| at end of a character packet}
+@!vf_ext:pckt_pointer; {extension for \.{VF} files}
+@!ovf_ext:pckt_pointer; {extension for \.{OVF} files}
+@!vf_cur_fnt:font_number; {current font number in a \.{VF} file}
+
+@ @<Initialize predefined strings@>=
+id3(".")("V")("F")(vf_ext); {file name extension for \.{VF} files}
+id4(".")("O")("V")("F")(ovf_ext); {file name extension for \.{OVF} files}
+
+@ If a \.{VF} file is badly malformed, we say |bad_font|; this procedure
+gives an error message which refers the user to \.{VFtoVP} and
+\.{OVPtoOVF}, and terminates \.{\title}.
+
+@<Cases for |bad_font|@>=
+vf_font_type: begin print('Bad (O)VF file'); print_font(cur_fnt);
+@.Bad (O)VF file@>
+ print_ln(' loc=',vf_loc:1);
+ abort(
+ 'Use OVF2OVP/OVP2OVF/VFtoVP/VPtoVF to diagnose and correct the problem');
+@.Use OVF2OVP/OVP2OVF/VFtoVP/VPtoVF@>
+ end;
+
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{VF} directory, which is a system-dependent place where
+the \.{VF} files for standard fonts are kept.
+The string variable |VF_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d VF_default_area_name=='TeXvfonts:' {change this to the correct name}
+@d VF_default_area_name_length=10 {change this to the correct length}
+@d OVF_default_area_name=='TeXvfonts:' {change this to the correct name}
+@d OVF_default_area_name_length=10 {change this to the correct length}
+
+@<Glob...@>=
+@!VF_default_area:packed array[1..VF_default_area_name_length] of char;
+@!OVF_default_area:packed array[1..OVF_default_area_name_length] of char;
+
+@ @<Set init...@>=
+VF_default_area:=VF_default_area_name;
+OVF_default_area:=OVF_default_area_name;
+
+@ To prepare |vf_file| for input we |reset| it.
+
+@<VF: Open |vf_file| or |goto not_found|@>=
+make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
+reset(vf_file,cur_name);
+if eof(vf_file) then begin
+ make_font_name(OVF_default_area_name_length)(OVF_default_area)(ovf_ext);
+ reset(vf_file,cur_name);
+ if eof(vf_file) then
+@^system dependencies@>
+ goto not_found
+ end;
+vf_loc:=0
+
+@ Reading a \.{VF} file should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes from |vf_file| is read into a buffer and will then be extracted
+from that buffer. In order to simplify such system dependent changes
+we use a pair of \.{WEB} macros: |vf_byte| extracts the next \.{VF}
+byte and |vf_eof| is |true| if we have reached the end of the \.{VF}
+file. Here we give simple minded definitions for these macros in terms
+of standard \PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d vf_eof == eof(vf_file) {has the \.{VF} file been exhausted?}
+@d vf_byte(#) ==
+ if vf_eof then bad_font
+ else read(vf_file,#) {obtain next \.{VF} byte}
+
+@ We need several simple functions to read the next byte or bytes
+from |vf_file|.
+
+@p function vf_ubyte:int_8u; {returns the next byte, unsigned}
+@!begin_byte(vf_byte); incr(vf_loc); comp_ubyte(vf_ubyte);
+end;
+@#
+function vf_upair:int_16u; {returns the next two bytes, unsigned}
+@!begin_pair(vf_byte); Incr(vf_loc)(2); comp_upair(vf_upair);
+end;
+@#
+function vf_strio:int_24; {returns the next three bytes, signed}
+@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_strio(vf_strio);
+end;
+@#
+function vf_utrio:int_24u; {returns the next three bytes, unsigned}
+@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_utrio(vf_utrio);
+end;
+@#
+function vf_squad:int_32; {returns the next four bytes, signed}
+@!begin_quad(vf_byte); Incr(vf_loc)(4); comp_squad(vf_squad);
+end;
+
+@ All dimensions in a \.{VF} file, except the design sizes of a virtual
+font and its local fonts, are |fix_word|s that must be scaled in exactly
+the same way as the character widths from a \.{TFM} file; we can use the
+same code, but this time |z|, |alpha|, and |beta| are global variables.
+
+@<Glob...@>=
+@<Variables for scaling computation@>@;
+
+@ We need five functions to read the next byte or bytes and convert a
+|fix_word| to a scaled dimension.
+
+@p function vf_fix1:int_32; {returns the next byte as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b3); incr(vf_loc);
+tfm_fix1(x); vf_fix1:=x;
+end;
+@#
+function vf_fix2:int_32; {returns the next two bytes as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b2); vf_byte(tfm_b3); Incr(vf_loc)(2);
+tfm_fix2(x); vf_fix2:=x;
+end;
+@#
+function vf_fix3:int_32; {returns the next three bytes as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(3);@/
+tfm_fix3(x); vf_fix3:=x;
+end;
+@#
+function vf_fix3u:int_32; {returns the next three bytes as scaled value}
+begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(3);@/
+vf_fix3u:=tfm_fix3u;
+end;
+@#
+function vf_fix4:int_32; {returns the next four bytes as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(4);@/
+tfm_fix4(x); vf_fix4:=x;
+end;
+
+@ Three other functions are used in cases where the result must have a
+non-negative value or a positive value.
+
+@p function vf_uquad:int_31; {result must be non-negative}
+var x:int_32;
+begin x:=vf_squad; if x<0 then bad_font @+ else vf_uquad:=x;
+end;
+@#
+function vf_pquad:int_31; {result must be positive}
+var x:int_32;
+begin x:=vf_squad; if x<=0 then bad_font @+ else vf_pquad:=x;
+end;
+@#
+function vf_fixp:int_31; {result must be positive}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(4);@/
+if tfm_b0>0 then bad_font;
+vf_fixp:=tfm_fix3u;
+end;
+
+@ The |vf_first_par| procedure first reads a \.{VF} command byte into
+|cur_cmd|; then |cur_parm| is set to the value of the first parameter
+(if any) and |cur_class| to the command class.
+
+@d set_cur_wp_end(#)== if cur_wp=invalid_width then #
+@d set_cur_wp(#)== {set |cur_wp| to the char's width pointer}
+cur_wp:=invalid_width;
+if #<>invalid_font then
+ if (cur_res>=font_bc(#))and(cur_res<=font_ec(#)) then
+ begin cur_cp:=font_chars(#)+cur_res; cur_wp:=char_widths[cur_cp];
+ end;
+set_cur_wp_end
+
+@p procedure vf_first_par;
+begin cur_cmd:=vf_ubyte;
+case dvi_par[cur_cmd] of
+char_par:
+ begin set_cur_char(vf_ubyte); set_cur_wp(vf_cur_fnt)(bad_font);
+ end;
+no_par: do_nothing;
+dim1_par: cur_parm:=vf_fix1;
+num1_par: cur_parm:=vf_ubyte;
+dim2_par: cur_parm:=vf_fix2;
+num2_par: cur_parm:=vf_upair;
+dim3_par: cur_parm:=vf_fix3;
+num3_par: cur_parm:=vf_utrio;
+dim4_par: cur_parm:=vf_fix4;
+num4_par: cur_parm:=vf_squad;
+numu_par: cur_parm:=vf_uquad;
+rule_par:
+ begin cur_v_dimen:=vf_fix4; cur_h_dimen:=vf_fix4;
+ cur_upd:=(cur_cmd=set_rule);
+ end;
+fnt_par:cur_parm:=cur_cmd-fnt_num_0;
+end; {there are no other cases}
+cur_class:=dvi_cl[cur_cmd];
+end;
+
+@ For a virtual font we set |font_type(f):=vf_font_type|; in this case
+|font_font(f)| is the default font for character packets from virtual
+font~|f|.
+@^font types@>
+
+The global variable |vf_nf| is used for the number of different local
+fonts defined in a \.{VF} file so far; their external font numbers
+(as extracted from the \.{VF} file) are stored in the array |vf_e_fnts|,
+the corresponding internal font numbers used internally by \.{\title} are
+stored in the array |vf_i_fnts|.
+
+@<Glob...@>=
+@!vf_e_fnts:array[font_number] of int_32; {external font numbers}
+@!vf_i_fnts:array[font_number] of font_number; {corresponding
+ internal font numbers}
+@!vf_nf:font_number; {number of local fonts defined so far}
+@!lcl_nf:font_number; {largest |vf_nf| value for any \.{VF} file}
+
+@ @<Set init...@>=
+lcl_nf:=0;
+
+@ The |vf_font| procedure sets |vf_cur_fnt| to the internal font number
+corresponding to the external font number |cur_parm| (or aborts the
+program if such a font was never defined).
+
+@p procedure vf_font; {computes |vf_cur_fnt| corresponding to |cur_parm|}
+var f:font_number; {where the font is sought}
+begin @<VF: Locate font |cur_parm|@>;
+if f=vf_nf then bad_font;
+vf_cur_fnt:=vf_i_fnts[f];
+end;
+
+@ @<VF: Locate font |cur_parm|@>=
+f:=0; vf_e_fnts[vf_nf]:=cur_parm;
+while cur_parm<>vf_e_fnts[f] do incr(f)
+
+@ Finally the |vf_do_font| procedure is called when one of the command
+|fnt_def1..fnt_def4| and its first parameter have been read from the
+\.{VF} file.
+
+@p procedure vf_do_font;
+var f:font_number; {where the font is sought}
+@!k:int_31; {general purpose variable}
+begin
+print('VF: font ',cur_parm:1);@/
+@<VF: Locate font |cur_parm|@>;
+if f<>vf_nf then bad_font;
+font_check(nf):=vf_squad;
+font_scaled(nf):=vf_fixp;
+font_design(nf):=round(tfm_conv*vf_pquad);
+k:=vf_ubyte; pckt_room(1); append_byte(k);
+Incr(k)(vf_ubyte); pckt_room(k);
+while k>0 do begin append_byte(vf_ubyte); decr(k);
+ end;
+font_name(nf):=make_packet; {the font area plus name}
+vf_i_fnts[vf_nf]:=define_font(true);
+if vf_nf=lcl_nf then
+ if lcl_nf=max_fonts then overflow(str_fonts,max_fonts)
+ else incr(lcl_nf);
+incr(vf_nf);
+end;
+
+@* Reading VF and OVF files.
+The |do_vf| function attempts to read the \.{VF} file for a font and
+returns |false| if the \.{VF} file could not be found; otherwise the
+font type is changed to |vf_font_type|.
+
+@p function do_vf:boolean; {read a \.{VF} file}
+label reswitch,done,not_found,exit;
+var temp_int:int_32; {integer for temporary variables}
+@!temp_byte:int_8u; {byte for temporary variables}
+@!k:byte_pointer; {index into |byte_mem|}
+@!l:int_15; {general purpose variable}
+@!save_ext:int_24; {used to save |cur_ext|}
+@!save_res:int_32; {used to save |cur_res|}
+@!save_cp:width_pointer; {used to save |cur_cp|}
+@!save_wp:width_pointer; {used to save |cur_wp|}
+@!save_upd:boolean; {used to save |cur_upd|}
+@!vf_wp:width_pointer; {width pointer for the current character packet}
+@!vf_fnt:font_number; {current font in the current character packet}
+@!move_zero:boolean; {|true| if rule 1 is used}
+@!last_pop:boolean; {|true| if final |pop| has been manufactured}
+begin @<VF: Open |vf_file| or |goto not_found|@>;
+save_ext:=cur_ext; save_res:=cur_res; save_cp:=cur_cp; save_wp:=cur_wp;
+save_upd:=cur_upd; {save}
+font_type(cur_fnt):=vf_font_type;@/
+@<VF: Process the preamble@>;@/
+@<VF: Process the font definitions@>;@/
+while cur_cmd<=long_char do @<VF: Build a character packet@>;
+if cur_cmd<>post then bad_font;
+@!debug print('VF file for font ',cur_fnt:1); print_font(cur_fnt);
+print_ln(' loaded.');
+gubed @;@/
+close_in(vf_file);
+cur_ext:=save_ext; cur_res:=save_res; cur_cp:=save_cp; cur_wp:=save_wp;
+cur_upd:=save_upd; {restore}
+do_vf:=true; return;
+not_found:do_vf:=false;
+exit:end;
+
+@ @<VF: Process the preamble@>=
+if vf_ubyte<>pre then bad_font;
+if vf_ubyte<>vf_id then bad_font;
+temp_byte:=vf_ubyte; pckt_room(temp_byte);
+for l:=1 to temp_byte do append_byte(vf_ubyte);
+if font_extend(cur_fnt) then print('O');
+print('VF file: '''); print_packet(new_packet); print(''',');
+flush_packet;@/
+check_check_sum(vf_squad,false);
+check_design_size(round(tfm_conv*vf_pquad));@/
+z:=font_scaled(cur_fnt);
+@<Replace |z|...@>;@/
+print_nl(' for font ',cur_fnt:1); print_font(cur_fnt); print_ln('.')
+
+@ @<VF: Process the font definitions@>=
+vf_i_fnts[0]:=invalid_font; vf_nf:=0;@/
+cur_cmd:=vf_ubyte;
+while (cur_cmd>=fnt_def1)and(cur_cmd<=fnt_def1+3) do
+ begin case cur_cmd-fnt_def1 of
+ 0: cur_parm:=vf_ubyte;
+ 1: cur_parm:=vf_upair;
+ 2: cur_parm:=vf_utrio;
+ 3: cur_parm:=vf_squad;
+ end; {there are no other cases}
+ vf_do_font;
+ cur_cmd:=vf_ubyte;
+ end;
+font_font(cur_fnt):=vf_i_fnts[0]
+
+@ The \.{VF} format specifies that the interpretation of each packet
+begins with |w=x=y=z=0|; any |w0|, |x0|, |y0|, or |z0| command using
+these initial values will be ignored.
+
+@<Types...@>=
+@!vf_state=array[0..1,0..1] of boolean; {state of |w|, |x|, |y|, and |z|}
+
+@ As implied by the \.{VF} format the \.{DVI} commands read from the \.{VF}
+file are enclosed by |push| and |pop|; as we read \.{DVI}
+commands and append them to |byte_mem|, we perform a set of
+transformations in order to simplify the resulting packet: Let |zero| be
+any of the commands |put|, |put_rule|, |fnt_num|, |fnt|, or |xxx| which
+all leave the current position on the page unchanged, let |move| be any
+of the horizontal or vertical movement commands |right1..z4|, and let
+|any| be any sequence of commands containing |push| and |pop| in
+properly nested pairs; whenever possible we apply one of the following
+transformation rules: $$\def\n#1:{\hbox to 3cm{\hfil#1:}}
+\leqalignno{
+\hbox{|push| |zero|}&\RA\hbox{|zero| |push|}&\n1:\cr
+\hbox{|move| |pop|}&\RA\hbox{|pop|}&\n2:\cr
+\hbox{|push| |pop|}&\RA{}&\n3:\cr
+\hbox{|push| |set_char| |pop|}&\RA\hbox{|put|}&\n4a:\cr
+\hbox{|push| \\{set} |pop|}&\RA\hbox{|put|}&\n4b:\cr
+\hbox{|push| |set_rule| |pop|}&\RA\hbox{|put_rule|}&\n4c:\cr
+\hbox{|push| |push| |any| |pop|}&\RA\hbox{|push| |any| |pop| |push|}&\n5:\cr
+\hbox{|push| |any| |pop| |pop|}&\RA\hbox{|any| |pop|}&\n6:\cr
+}$$
+
+@ In order to perform these transformations we need a stack which is
+indexed by |vf_ptr|, the number of |push| commands without corresponding
+|pop| in the packet we are building; the |vf_push_loc| array contains
+the locations in |byte_mem| following such |push| commands.
+In view of rule~5 consecutive |push| commands are never stored, the
+|vf_push_num| array is used to count them.
+The |vf_last| array indicates the type of the last non-discardable item:
+a character, a rule, or a group enclosed by |push| and |pop|;
+the |vf_last_end| array points to the ending locations and, if
+|vf_last<>vf_other|, the |vf_last_loc| array points to the starting
+locations of these items.
+
+@d vf_set=0 {|vf_set=char_cl|, last item is a |set_char| or \\{set}}
+@d vf_rule=1 {|vf_rule=rule_cl|, last item is a |set_rule|}
+@d vf_group=2 {last item is a group enclosed by |push| and |pop|}
+@d vf_put=3 {last item is a |put|}
+@d vf_other=4 {last item (if any) is none of the above}
+
+@<Types...@>=
+@!vf_type=vf_set..vf_other;
+
+@ @<Glob...@>=
+@!vf_move: array[stack_pointer] of vf_state; {state of |w|, |x|, |y|, and |z|}
+@!vf_push_loc: array[stack_pointer] of byte_pointer; {end of a |push|}
+@!vf_last_loc: array[stack_pointer] of byte_pointer; {start of an item}
+@!vf_last_end: array[stack_pointer] of byte_pointer; {end of an item}
+@!vf_push_num: array[stack_pointer] of eight_bits; {|push| count}
+@!vf_last: array[stack_pointer] of vf_type; {type of last item}
+@!vf_ptr:stack_pointer; {current number of unfinished groups}
+@!stack_used:stack_pointer; {largest |vf_ptr| or |stack_ptr| value}
+
+@ We use two small arrays to determine the item type of a character or a
+rule.
+
+@<Glob...@>=
+@!vf_char_type:array[boolean] of vf_type;
+@!vf_rule_type:array[boolean] of vf_type;
+
+@ @<Set init...@>=
+vf_move[0][0][0]:=false; vf_move[0][0][1]:=false;
+vf_move[0][1][0]:=false; vf_move[0][1][1]:=false;@/
+stack_used:=0;@/
+vf_char_type[false]:=vf_put; vf_char_type[true]:=vf_set;@/
+vf_rule_type[false]:=vf_other; vf_rule_type[true]:=vf_rule;
+
+@ Here we read the first bytes of a character packet from the \.{VF} or \.{OVF}
+file and initialize the packet being built in |byte_mem|; the start of
+the whole packet is stored in |vf_push_loc[0]|. When the character
+packet is finished, a type is be assigned to it: |vf_simple| if the
+packet ends with a character of the correct width, or |vf_complex|
+otherwise. Moreover, if such a packet for a character with
+extension zero consists of just one character with extension zero and
+the same residue, and if there is no previous packet, the whole packet
+is replaced by the empty packet.
+
+@d vf_simple=0 {the packet ends with a character of the correct width}
+@d vf_complex=vf_simple+1 {otherwise}
+
+@<VF: Build a character packet@>=
+begin if cur_cmd<long_char then
+ begin vf_limit:=cur_cmd;
+ cur_ext:=0; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix3u);
+ end
+else if font_extend(cur_fnt) then
+ begin vf_limit:=vf_uquad;
+ cur_ext:=0; cur_res:=vf_squad; vf_wp:=check_width(vf_fix4);
+ end
+else begin vf_limit:=vf_uquad;
+ cur_ext:=vf_strio; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix4);
+ end;
+Incr(vf_limit)(vf_loc);
+vf_push_loc[0]:=byte_ptr; vf_last_end[0]:=byte_ptr;
+vf_last[0]:=vf_other; vf_ptr:=0;@/
+start_packet(vf_complex);
+@<VF: Append \.{DVI} commands to the character packet@>;@/
+k:=pckt_start[pckt_ptr];
+if vf_last[0]=vf_put then if cur_wp=vf_wp then
+ begin decr(byte_mem[k]); {change |vf_complex| into |vf_simple|}
+ if (byte_mem[k]=bi(0))and@|(vf_push_loc[0]=vf_last_loc[0])and@|
+ (cur_ext=0)and@|(cur_res=pckt_res) then byte_ptr:=k;
+ end;
+build_packet;
+cur_cmd:=vf_ubyte;
+end
+
+@ For every \.{DVI} command read from the \.{VF} file some action is
+performed; in addition the initial |push| and the final |pop| are
+manufactured here.
+
+@<VF: Append \.{DVI} commands to the character packet@>=
+vf_cur_fnt:=font_font(cur_fnt); vf_fnt:=vf_cur_fnt;@/
+last_pop:=false; cur_class:=push_cl; {initial |push|}
+loop begin
+reswitch:case cur_class of
+ three_cases(char_cl): @<VF: Do a |char|, |rule|, or |xxx|@>;
+ push_cl: @<VF: Do a |push|@>;
+ pop_cl: @<VF: Do a |pop|@>;
+ two_cases(w0_cl):
+ if vf_move[vf_ptr][0][cur_class-w0_cl] then append_one(cur_cmd);
+ three_cases(right_cl):
+ begin pckt_signed(dvi_right_cmd[cur_class],cur_parm);
+ if cur_class>=w_cl then vf_move[vf_ptr][0][cur_class-w_cl]:=true;
+ end;
+ two_cases(y0_cl):
+ if vf_move[vf_ptr][1][cur_class-y0_cl] then append_one(cur_cmd);
+ three_cases(down_cl):
+ begin pckt_signed(dvi_down_cmd[cur_class],cur_parm);
+ if cur_class>=y_cl then vf_move[vf_ptr][1][cur_class-y_cl]:=true;
+ end;
+ fnt_cl: vf_font;
+ fnt_def_cl: bad_font;
+ invalid_cl: if cur_cmd<>nop then bad_font;
+ end; {there are no other cases}
+ if vf_loc<vf_limit then vf_first_par
+ else if last_pop then goto done
+ else begin cur_class:=pop_cl; last_pop:=true; {final |pop|}
+ end;
+ end;
+done:if (vf_ptr<>0)or(vf_loc<>vf_limit) then bad_font
+
+@ For a |push| we either increase |vf_push_num| or start a new level and
+append a |push|.
+
+@d incr_stack(#)==
+if #=stack_used then
+ if stack_used=stack_size then overflow(str_stack,stack_size)
+ else incr(stack_used);
+incr(#)
+
+@<VF: Do a |push|@>=
+if (vf_ptr>0)and(vf_push_loc[vf_ptr]=byte_ptr) then
+ begin if vf_push_num[vf_ptr]=255 then overflow(str_stack,255);
+ incr(vf_push_num[vf_ptr]);
+ end
+else begin incr_stack(vf_ptr);
+ @<VF: Start a new level@>;
+ vf_push_num[vf_ptr]:=0;
+ end
+
+@ @<VF: Start a new level@>=
+append_one(push);
+vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+vf_push_loc[vf_ptr]:=byte_ptr;
+vf_last_end[vf_ptr]:=byte_ptr;
+vf_last[vf_ptr]:=vf_other
+
+@ When a character, a rule, or an |xxx| is appended, transformation
+rule~1 might be applicable.
+
+@<VF: Do a |char|, |rule|, or |xxx|@>=
+begin if (vf_ptr=0)or(byte_ptr>vf_push_loc[vf_ptr]) then move_zero:=false
+else case cur_class of
+char_cl: move_zero:=(not cur_upd)or(vf_cur_fnt<>vf_fnt);
+rule_cl: move_zero:=not cur_upd;
+xxx_cl: move_zero:=true;
+end; {there are no other cases}
+if move_zero then
+ begin decr(byte_ptr); decr(vf_ptr);
+ end;
+case cur_class of
+char_cl: @<VF: Do a |fnt|, a |char|, or both@>;
+rule_cl: @<VF: Do a |rule|@>;
+xxx_cl: @<VF: Do an |xxx|@>;
+end; {there are no other cases}
+vf_last_end[vf_ptr]:=byte_ptr;
+if move_zero then
+ begin incr(vf_ptr); append_one(push); vf_push_loc[vf_ptr]:=byte_ptr;
+ vf_last_end[vf_ptr]:=byte_ptr;
+ if cur_class=char_cl then if cur_upd then goto reswitch;
+ end;
+end
+
+@ A special situation arises if transformation rule~1 is applied to a
+|fnt_num| of |fnt| command, but not to the |set_char| or \\{set} command
+following it; in this case |cur_upd| and |move_zero| are both |true| and
+the |set_char| or \\{set} command will be appended later.
+
+@<VF: Do a |fnt|, a |char|, or both@>=
+begin if vf_cur_fnt<>vf_fnt then
+ begin vf_last[vf_ptr]:=vf_other;
+ pckt_unsigned(fnt1,vf_cur_fnt); vf_fnt:=vf_cur_fnt;
+ end;
+if (not move_zero)or(not cur_upd) then
+ begin vf_last[vf_ptr]:=vf_char_type[cur_upd];
+ vf_last_loc[vf_ptr]:=byte_ptr;
+ pckt_char(cur_upd,cur_ext,cur_res);
+ end;
+end
+
+@ @<VF: Do a |rule|@>=
+begin vf_last[vf_ptr]:=vf_rule_type[cur_upd];
+vf_last_loc[vf_ptr]:=byte_ptr;
+append_one(dvi_rule_cmd[cur_upd]);
+pckt_four(cur_v_dimen); pckt_four(cur_h_dimen);
+end
+
+@ @<VF: Do an |xxx|@>=
+begin vf_last[vf_ptr]:=vf_other;
+pckt_unsigned(xxx1,cur_parm); pckt_room(cur_parm);
+while cur_parm>0 do
+ begin append_byte(vf_ubyte); decr(cur_parm);
+ end;
+end
+
+@ Transformation rules 2--6 are triggered by a |pop|, either read from
+the \.{VF} file or manufactured at the end of the packet.
+
+@<VF: Do a |pop|@>=
+begin if vf_ptr<1 then bad_font;
+byte_ptr:=vf_last_end[vf_ptr]; {this is rule 2}
+if vf_last[vf_ptr]<=vf_rule then
+ if vf_last_loc[vf_ptr]=vf_push_loc[vf_ptr] then
+ @<VF: Prepare for rule 4@>;
+if byte_ptr=vf_push_loc[vf_ptr] then @<VF: Apply rule 3 or 4@>
+else begin if vf_last[vf_ptr]=vf_group then @<VF: Apply rule 6@>;
+ append_one(pop); decr(vf_ptr); vf_last[vf_ptr]:=vf_group;
+ vf_last_loc[vf_ptr]:=vf_push_loc[vf_ptr+1]-1;
+ vf_last_end[vf_ptr]:=byte_ptr;
+ if vf_push_num[vf_ptr+1]>0 then @<VF: Apply rule 5@>;
+ end;
+end
+
+@ In order to implement transformation rule~4, we cancel the |set_char|,
+\\{set}, or |set_rule|, append a |pop|, and insert a |put| or |put_rule|
+with the old parameters.
+
+@<VF: Prepare for rule 4@>=
+begin cur_class:=vf_last[vf_ptr]; cur_upd:=false;
+byte_ptr:=vf_push_loc[vf_ptr];
+end
+
+@ @<VF: Apply rule 3 or 4@>=
+begin if vf_push_num[vf_ptr]>0 then
+ begin decr(vf_push_num[vf_ptr]);
+ vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+ end
+else begin decr(byte_ptr); decr(vf_ptr);
+ end;
+if cur_class<>pop_cl then goto reswitch; {this is rule 4}
+end
+
+@ @<VF: Apply rule 6@>=
+begin Decr(byte_ptr)(2);
+for k:=vf_last_loc[vf_ptr]+1 to byte_ptr do byte_mem[k-1]:=byte_mem[k];
+vf_last[vf_ptr]:=vf_other; vf_last_end[vf_ptr]:=byte_ptr;
+end
+
+@ @<VF: Apply rule 5@>=
+begin incr(vf_ptr);
+@<VF: Start a new level@>;
+decr(vf_push_num[vf_ptr]);
+end
+
+@ The \.{VF} formats specify that after a character packet invoked by a
+|set_char| or \\{set} command, ``|h|~is increased by the \.{TFM} width
+(properly scaled)---just as if a simple character had been typeset'';
+for |vf_simple| packets this is achieved by changing the final |put|
+command into |set_char| or \\{set}, but for |vf_complex| packets an
+explicit movement must be done. This poses a problem for programs,
+such as \.{DVIcopy}, which write a new \.{DVI} file with all references
+to characters from virtual fonts replaced by their character packets:
+The \.{DVItype} program specifies that the horizontal movements after a
+|set_char| or \\{set} command, after a |set_rule| command, and after one
+of the commands |right1..x4|, are all treated differently when \.{DVI}
+units are converted to pixels.
+
+Thus we introduce a slight extension of \.{DVItype}'s pixel rounding
+algorithm and hope that this extension will become part of the standard
+\.{DVItype} program in the near future: If a \.{DVI} file contains a
+|set_rule| command for a rule with the negative height |width_dimen|,
+then this rule shall be treated in exactly the same way as a ficticious
+character whose width is the width of that rule; as value of |width_dimen|
+we choose $-2^{31}$, the smallest signed 32-bit integer.
+
+@<Glob...@>=
+@!width_dimen:int_32; {vertical dimension of special rules}
+
+@ When initializing |width_dimen| we are careful to avoid arithmetic
+overflow.
+
+@<Set init...@>=
+width_dimen:=-@"40000000; Decr(width_dimen)(@"40000000);
+
+@* Terminal communication.
+When \.{\title} begins, it engages the user in a brief dialog so that
+various options may be specified. This part of \.{\title} requires
+nonstandard \PASCAL\ constructions to handle the online interaction; so
+it may be preferable in some cases to omit the dialog and simply to
+stick to the default options. On other hand, the system-dependent
+routines that are needed are not complicated, so it will not be terribly
+difficult to introduce them; furthermore they are similar to those in
+\.{DVItype}.
+
+It may be desirable to (optionally) specify all the options in the
+command line and skip the dialog with the user, provided the operating
+system permits this. Here we just define the system-indepent part of the
+code required for this possibility. Since a complete option (a keyword
+possibly followed by one or several parameters) may have embedded blanks
+it might be necessary to replace these blanks by some other separator,
+e.g., by a '/'. Using, e.g., \.{UNIX} style options one might then say
+$$\.{\title\space-mag/2000 -sel/17.3/5 -sel/47 ...}$$
+to override the magnification factor that is stated in the \.{DVI} file,
+and to select five pages starting with the page numbered~17.3 as well as
+all remaining pages starting with the one numbered~47; alternatively one
+might simply say
+$$\.{\title\space- ...}$$
+to skip the dialog and use the default options.
+
+The system-dependent initialization code should set the |n_opt| variable
+to the number of options found in the command line. If |n_opt=0| the
+|input_ln| procedure defined below will promt the user for options. If
+|n_opt>0| the |k_opt| variable will be incremented and another piece of
+system-dependent code is invoked instead of the dialog; that code should
+place the value of command line option number |k_opt| as temporary
+string into the |byte-mem| array. This process will be repeated until
+|k_opt=n_opt|, indicating that all command line options have been
+processed.
+@^system dependencies@>
+
+@d opt_separator="/" {acts as blank when scanning (command line) options}
+
+@<Set init...@>=
+n_opt:=0; {change this to indicate the presence of command line options}
+k_opt:=0; {just in case}
+
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that
+line into the |byte_mem| array as a temporary string. \PASCAL's
+standard |input| file is used for terminal input, as |output| is used
+for terminal output.
+
+Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall invoke a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+@^system dependencies@>
+
+@d update_terminal == break(output) {empty the terminal output buffer}
+@#
+@d scan_blank(#)== {tests for `blank' when scanning (command line) options}
+ ((byte_mem[#]=bi(" "))or(byte_mem[#]=bi(opt_separator)))
+@d scan_skip== {skip `blanks'}
+ while scan_blank(scan_ptr)and(scan_ptr<byte_ptr) do incr(scan_ptr)
+@d scan_init== {initialize |scan_ptr|}
+ byte_mem[byte_ptr]:=bi(" "); scan_ptr:=pckt_start[pckt_ptr-1]; scan_skip
+
+@<Action procedures for |dialog|@>=
+procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin if n_opt=0 then
+ begin print('Enter option: '); update_terminal; reset(input);
+ if eoln(input) then read_ln(input);
+ k:=0; pckt_room(terminal_line_length);
+ while (k<terminal_line_length)and not eoln(input) do
+ begin append_byte(xord[input^]); incr(k); get(input);
+ end;
+ end
+else if k_opt<n_opt then
+ begin incr(k_opt);
+ {Copy command line option number |k_opt| into |byte_mem| array!}
+ end;
+end;
+
+@ The global variable |scan_ptr| is used while scanning the temporary
+packet; it points to the next byte in |byte_mem| to be examined.
+
+@<Glob...@>=
+@!n_opt:int_16; {number of options found in command line}
+@!k_opt:int_16; {number of command line options processed}
+@!scan_ptr:byte_pointer; {pointer to next byte to be examined}
+@!sep_char:text_char; {|' '| or |xchr[opt_separator]|}
+
+@ The |scan_keyword| function is used to test for keywords in a character
+string stored as temporary packet in |byte_mem|; the result is |true|
+(and |scan_ptr| is updated) if the characters starting at position
+|scan_ptr| are an abbreviation of a given keyword followed by at least
+one blank.
+
+@<Action procedures for |dialog|@>=
+function scan_keyword(@!p:pckt_pointer;@!l:int_7):boolean;
+var i,@!j,@!k:byte_pointer; {indices into |byte_mem|}
+begin i:=pckt_start[p]; j:=pckt_start[p+1]; k:=scan_ptr;
+while (i<j)and((byte_mem[k]=byte_mem[i])or(byte_mem[k]=byte_mem[i]-"a"+"A")) do
+ begin incr(i); incr(k);
+ end;
+if scan_blank(k)and(i-pckt_start[p]>=l) then
+ begin scan_ptr:=k; scan_skip; scan_keyword:=true;
+ end
+else scan_keyword:=false;
+end;
+
+@ Here is a routine that scans a (possibly signed) integer and computes
+the decimal value. If no decimal integer starts at |scan_ptr|, the
+value~0 is returned. The integer should be less than $2^{31}$ in
+absolute value.
+
+@<Action procedures for |dialog|@>=
+function scan_int:int_32;
+var x:int_32; {accumulates the value}
+@!negative:boolean; {should the value be negated?}
+begin if byte_mem[scan_ptr]="-" then
+ begin negative:=true; incr(scan_ptr);
+ end
+else negative:=false;
+x:=0;
+while (byte_mem[scan_ptr]>="0")and(byte_mem[scan_ptr]<="9") do
+ begin x:=10*x+byte_mem[scan_ptr]-"0"; incr(scan_ptr);
+ end;
+scan_skip;
+if negative then scan_int:=-x @+ else scan_int:=x;
+end;
+
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{\title} begins.
+@^system dependencies@>
+
+@p @<Action procedures for |dialog|@>@;
+procedure dialog;
+label exit;
+var p:pckt_pointer; {packet being created}
+begin @<Initialize options@>@;
+loop begin input_ln; p:=new_packet; scan_init;
+ if scan_ptr=byte_ptr then
+ begin flush_packet; return;
+ end@;@/
+ @<Cases for options@>@;@/
+ else begin if n_opt=0 then sep_char:=' '
+ else sep_char:=xchr[opt_separator];
+ print_options;
+ if n_opt>0 then
+ begin print('Bad command line option: ');
+ print_packet(p); abort('---run terminated');
+ end;
+ end;
+ flush_packet;
+ end;
+exit:end;
+
+@ The |print_options| procedure might be used in a `Usage message'
+displaying the command line syntax.
+
+@<Basic printing...@>=
+procedure print_options;
+begin print_ln('Valid options are:');
+@<Print valid options@>@;
+end;
+
+@* Subroutines for typesetting commands.
+This is the central part of the whole \.{\title} program:
+When a typesetting command from the \.{DVI} file or from a \.{VF} packet
+has been decoded, one of the typesetting routines defined below is
+invoked to execute the command; apart from the necessary book keeping,
+these routines invoke device dependent code defined later.
+
+@p @<Declare typesetting procedures@>
+
+@ These typesetting routines communicate with the rest of the program
+through global variables.
+
+@<Glob...@>=
+@!type_setting:boolean; {|true| while typesetting a page}
+
+@ @<Set init...@>=
+type_setting:=false;
+
+@ The user may select up to |max_select| ranges of consecutive pages to
+be processed. Each starting page specification is recorded in two global
+arrays called |start_count| and |start_there|. For example, `\.{1.*.-5}'
+is represented by |start_there[0]=true|, |start_count[0]=1|,
+|start_there[1]=false|, |start_there[2]=true|, |start_count[2]=-5|. We
+also set |start_vals=2|, to indicate that count 2 was the last one
+mentioned. The other values of |start_count| and |start_there| are not
+important, in this example. The number of pages is recorded in
+|max_pages|; a non positive value indicates that there is no limit.
+
+@d start_count==select_count[cur_select] {count values to select
+ starting page}
+@d start_there==select_there[cur_select] {is the |start_count| value
+ relevant?}
+@d start_vals==select_vals[cur_select] {the last count considered
+ significant}
+@d max_pages==select_max[cur_select] {at most this many |bop..eop| pages
+ will be printed}
+
+@<Glob...@>=
+@!select_count:array[0..max_select-1,0..9] of int_32;
+@!select_there:array[0..max_select-1,0..9] of boolean;
+@!select_vals:array[0..max_select-1] of 0..9;
+@!select_max:array[0..max_select-1] of int_32;
+@!out_mag:int_32; {output maginfication}
+@!count:array[0..9] of int_32; {the count values on the current page}
+@!num_select:0..max_select; {number of page selection ranges specified}
+@!cur_select:0..max_select; {current page selection range}
+@!selected:boolean; {has starting page been found?}
+@!all_done:boolean; {have all selected pages been processed?}
+@!str_mag,@!str_select:pckt_pointer;
+
+@ Here is a simple subroutine that tests if the current page might be the
+starting page.
+
+@p function start_match:boolean; {does |count| match the starting spec?}
+var k:0..9; {loop index}
+@!match:boolean; {does everything match so far?}
+begin match:=true;
+for k:=0 to start_vals do
+ if start_there[k]and(start_count[k]<>count[k]) then match:=false;
+start_match:=match;
+end;
+
+@ @<Initialize options@>=
+out_mag:=0; cur_select:=0; max_pages:=0; selected:=true;
+
+@ @<Print valid options@>=
+print_ln(' mag',sep_char,'<new_mag>');
+print_ln(' select',sep_char,'<start_count>',sep_char,
+ '[<max_pages>] (up to ',max_select:1,' ranges)');
+
+@ @<Action procedures for |dialog|@>=
+procedure scan_count; {scan a |start_count| value}
+begin if byte_mem[scan_ptr]=bi("*") then
+ begin start_there[start_vals]:=false; incr(scan_ptr); scan_skip;
+ end
+else begin start_there[start_vals]:=true;
+ start_count[start_vals]:=scan_int;
+ if cur_select=0 then selected:=false; {don't start at first page}
+ end;
+end;
+
+@ @<Cases for options@>=
+else if scan_keyword(str_mag,3) then out_mag:=scan_int
+else if scan_keyword(str_select,3) then
+ if cur_select=max_select then print_ln('Too many page selections')
+ else begin start_vals:=0; scan_count;
+ while (start_vals<9)and(byte_mem[scan_ptr]=bi(".")) do
+ begin incr(start_vals); incr(scan_ptr); scan_count;
+ end;
+ max_pages:=scan_int; incr(cur_select);
+ end
+
+@ @<Initialize predefined strings@>=
+id3("m")("a")("g")(str_mag);
+id6("s")("e")("l")("e")("c")("t")(str_select);
+
+@ A stack is used to keep track of the current horizonal and vertical
+position, |h| and |v|, and the four registers |w|, |x|, |y|, and |z|;
+the register pairs |(w,x)| and |(y,z)| are maintained as arrays.
+
+@<Types...@>=
+@!device @<Declare device dependend types@>@; @+ ecived @; @/
+@!stack_pointer=0..stack_size;@/
+@!stack_index=1..stack_size;@/
+@!pair_32=array[0..1] of int_32; {a pair of |int_32| variables}
+@!stack_record=record@;@/
+ @!h_field:int_32; {horizontal position |h|}
+ @!v_field:int_32; {vertical position |v|}
+ @!w_x_field:pair_32; {|w| and |x| register for horizontal movements}
+ @!y_z_field:pair_32; {|y| and |z| register for vertical movements}
+ @!device @<Device dependent stack record fields@>@; @+ ecived @; @/
+ end;
+
+@ The current values are kept in |cur_stack|; they are pushed onto and
+popped from |stack|. We use \.{WEB} macros to access the current values.
+
+@d cur_h==cur_stack.h_field {the current |@!h| value}
+@d cur_v==cur_stack.v_field {the current |@!v| value}
+@d cur_w_x==cur_stack.w_x_field {the current |@!w| and |@!x| value}
+@d cur_y_z==cur_stack.y_z_field {the current |@!y| and |@!z| value}
+
+@<Glob...@>=
+@!stack:array[stack_index] of stack_record; {the pushed values}
+@!cur_stack:stack_record; {the current values}
+@!zero_stack:stack_record; {initial values}
+@!stack_ptr:stack_pointer; {last used position in |stack|}
+
+@ @<Set init...@>=
+zero_stack.h_field:=0; zero_stack.v_field:=0;
+for i:=0 to 1 do
+ begin zero_stack.w_x_field[i]:=0; zero_stack.y_z_field[i]:=0;
+ end;
+@!device @<Initialize device dependent stack record fields@>@; @+ ecived @; @/
+
+@ When typesetting for a real device we must convert the current
+position from \.{DVI} units to pixels, i.e., |cur_h| and |cur_v| into
+|cur_hh| and |cur_vv|. This might be a good place to collect everything
+related to the conversion from \.{DVI} units to pixels and in particular
+all the pixel rounding algorithms.
+
+@d font_space(#)==fnt_space[#] {boundary between ``small'' and ``large''
+ spaces}
+
+@<Declare device dependent font data arrays@>=
+@!fnt_space:array [font_number] of int_32; {boundary between ``small''
+ and ``large'' spaces}
+
+@ @<Initialize device dependent font data@>=
+font_space(invalid_font):=0;
+
+@ @<Initialize device dependent data for a font@>=
+font_space(cur_fnt):=font_scaled(cur_fnt) div 6;
+ {this is a 3-unit ``thin space''}
+
+@ The |char_pixels| array is used to store the horizontal character
+escapements: for \.{PK} or \.{GF} files we use the values given there,
+otherwise we must convert the character widths to (horizontal) pixels.
+The horizontal escapement of character~|c| in font~|f| is given by
+|font_pixel(f)(c)|.
+
+@d font_pixel(#)==char_pixels[font_chars(#)+font_width_end
+@#
+@d max_pix_value==@"7FFF {largest allowed pixel value; this range may not
+ suffice for high resolution output devices}
+
+@<Declare device dependend types@>=
+@!pix_value=-max_pix_value..max_pix_value; {a pixel coordinate or displacement}
+
+@ @<Glob...@>=
+@!device
+@!char_pixels:array[char_pointer] of pix_value; {character escapements}
+@!h_pixels:pix_value; {a horizontal dimension in pixels}
+@!v_pixels:pix_value; {a vertical dimension in pixels}
+@!temp_pix:pix_value; {temporary value for pixel rounding}
+ecived
+
+@ @d cur_hh==cur_stack.hh_field {the current |@!hh| value}
+@d cur_vv==cur_stack.vv_field {the current |@!vv| value}
+
+@<Device dependent stack record fields@>=
+@!hh_field:pix_value; {horizontal pixel position |hh|}
+@!vv_field:pix_value; {vertical pixel position |vv|}
+
+@ @<Initialize device dependent stack record fields@>=
+zero_stack.hh_field:=0; zero_stack.vv_field:=0;
+
+@ For small movements we round the increment in position, for large
+movements we round the incremented position. The same applies to rule
+dimensions with the only difference that they will always be rounded
+towards larger values. For characters we increment the horizontal
+position by the escapement values obtained, e.g., from a \.{PK} file or
+by the \.{TFM} width converted to pixels.
+
+@d h_pixel_round(#)==round(h_conv*(#))
+@d v_pixel_round(#)==round(v_conv*(#))
+@^system dependencies@>
+@#
+@d large_h_space(#)==(#>=font_space(cur_fnt))or(#<=-4*font_space(cur_fnt))
+ {is this a ``large'' horizontal distance?}
+@d large_v_space(#)==(abs(#)>=5*font_space(cur_fnt))
+ {is this a ``large'' vertical distance?}
+@#
+@d h_rule_pixels== {converts the rule width |cur_h_dimen| to pixels}
+@!device if large_h_space(cur_h_dimen) then
+ begin h_pixels:=h_pixel_round(cur_h+cur_h_dimen)-cur_hh;
+ if h_pixels<=0 then if cur_h_dimen>0 then h_pixels:=1;
+ end
+else begin h_pixels:=trunc(h_conv*cur_h_dimen);
+ if h_pixels<h_conv*cur_h_dimen then incr(h_pixels);
+ end;
+ecived
+@#
+@d v_rule_pixels== {converts the rule height |cur_v_dimen| to pixels}
+@!device if large_v_space(cur_v_dimen) then
+ begin v_pixels:=cur_vv-v_pixel_round(cur_v-cur_v_dimen);
+ if v_pixels<=0 then v_pixels:=1; {used only for |cur_v_dimen>0|}
+ end
+else begin v_pixels:=trunc(v_conv*cur_v_dimen);
+ if v_pixels<v_conv*cur_v_dimen then incr(v_pixels);
+ end;
+ecived
+
+@ A sequence of consecutive rules, or consecutive characters in a
+fixed-width font whose width is not an integer number of pixels, can
+cause |hh| to drift far away from a correctly rounded value. \.{\title}
+ensures that the amount of drift will never exceed |max_h_drift| pixels;
+similarly |vv| shall never drift away from the correctly rounded value
+by more than |max_v_drift| pixels.
+
+@d h_upd_end(#)== {check for proper horizontal pixel rounding}
+begin Incr(cur_hh)(#); temp_pix:=h_pixel_round(cur_h);
+if abs(temp_pix-cur_hh)>max_h_drift then
+ if temp_pix>cur_hh then cur_hh:=temp_pix-max_h_drift
+ else cur_hh:=temp_pix+max_h_drift;
+end @+ ecived
+@d h_upd_char(#)==Incr(cur_h)(#)@;
+ @!device; h_upd_end
+@d h_upd_move(#)==Incr(cur_h)(#)@;
+ @!device; if large_h_space(#) then cur_hh:=h_pixel_round(cur_h)
+ else h_upd_end
+@#
+@d v_upd_end(#)== {check for proper vertical pixel rounding}
+begin Incr(cur_vv)(#); temp_pix:=v_pixel_round(cur_v);
+if abs(temp_pix-cur_vv)>max_v_drift then
+ if temp_pix>cur_vv then cur_vv:=temp_pix-max_v_drift
+ else cur_vv:=temp_pix+max_v_drift;
+end @+ ecived
+@d v_upd_move(#)==Incr(cur_v)(#)@;
+ @!device; if large_v_space(#) then cur_vv:=v_pixel_round(cur_v)
+ else v_upd_end
+
+@ The routines defined below use sections named `Declare local variables
+(if any) for \dots' or `Declare additional local variables for \dots';
+the former may declare variables (including the keyword \&{var}), whereas
+the later must at least contain the keyword \&{var}. In general, both may
+start with the declaration of labels, constants, and\slash or types.
+
+Let us start with the simple cases:
+The |do_pre| procedure is called when the preamble has been read from
+the \.{DVI} file; the preamble comment has just been converted into a
+temporary packet with the |new_packet| procedure.
+
+@p procedure do_pre;@/
+@<OUT: Declare local variables (if any) for |do_pre|@>@;
+begin all_done:=false; num_select:=cur_select; cur_select:=0;
+if num_select=0 then max_pages:=0;
+@!device
+h_conv:=(dvi_num/254000.0)*(h_resolution/dvi_den)*(out_mag/1000.0);
+v_conv:=(dvi_num/254000.0)*(v_resolution/dvi_den)*(out_mag/1000.0);
+ecived @; @/
+@<OUT: Process the |pre|@>@;@/
+end;
+
+@ The |do_bop| procedure is called when a |bop| has been read. This
+routine determines whether a page shall be processed or skipped and sets
+the variable |type_setting| accordingly.
+
+@p procedure do_bop;@/
+@<OUT: Declare additional local variables |do_bop|@>@;
+@!i,@!j:0..9; {indices into |count|}
+begin @<Determine whether this page should be processed or skipped@>;
+print('DVI: ');
+if type_setting then print('process') @+ else print('skipp');
+print('ing page ',count[0]:1); j:=9;
+while (j>0)and(count[j]=0) do decr(j);
+for i:=1 to j do print('.',count[i]:1);
+d_print(' at ',dvi_loc-45:1);
+print_ln('.');
+if type_setting then
+ begin stack_ptr:=0; cur_stack:=zero_stack; cur_fnt:=invalid_font;@/
+ @<OUT: Process a |bop|@>@;@/
+ end;
+end;
+
+@ Note that the device dependent code `OUT: Process a |bop|' may choose
+to set |type_setting| to false even if |selected| is true.
+
+@<Determine whether this page...@>=
+if not selected then selected:=start_match;
+type_setting:=selected
+
+@ The |do_eop| procedure is called in order to process an |eop|; the
+stack should be empty.
+
+@p procedure do_eop;@/
+@<OUT: Declare local variables (if any) for |do_eop|@>@;
+begin if stack_ptr<>0 then bad_dvi;
+@<OUT: Process an |eop|@>@;
+if max_pages>0 then
+ begin decr(max_pages);
+ if max_pages=0 then
+ begin selected:=false; incr(cur_select);
+ if cur_select=num_select then all_done:=true;
+ end;
+ end;
+type_setting:=false;
+end;
+
+@ The procedures |do_push| and |do_pop| are called in order to process
+|push| and |pop| commands; |do_push| must check for stack overflow,
+|do_pop| should never be called when the stack is empty.
+
+@p procedure do_push; {push onto stack}
+@<OUT: Declare local variables (if any) for |do_push|@>@;
+begin incr_stack(stack_ptr); stack[stack_ptr]:=cur_stack;@/
+@<OUT: Process a |push|@>@;
+end;
+@#
+procedure do_pop; {pop from stack}
+@<OUT: Declare local variables (if any) for |do_pop|@>@;
+begin if stack_ptr=0 then bad_dvi;
+cur_stack:=stack[stack_ptr]; decr(stack_ptr);
+@<OUT: Process a |pop|@>@;@/
+end;
+
+@ The |do_xxx| procedure is called in order to process a special command.
+The bytes of the special string have been put into |byte_mem| as the
+current string. They are converted to a temporary packet and discarded
+again.
+
+@p procedure do_xxx;@/
+@<OUT: Declare additional local variables for |do_xxx|@>@;
+@!p:pckt_pointer; {temporary packet}
+begin p:=new_packet;@/
+@<OUT: Process an |xxx|@>@;@/
+flush_packet;
+end;
+
+@ Next are the movement commands:
+The |do_right| procedure is called in order to process the horizontal
+movement commands |right|, |w|, and |x|.
+
+
+@p procedure do_right;@/
+@<OUT: Declare local variables (if any) for |do_right|@>@;
+begin if cur_class>=w_cl then cur_w_x[cur_class-w_cl]:=cur_parm
+else if cur_class<right_cl then cur_parm:=cur_w_x[cur_class-w0_cl];
+@<OUT: Process a |right| or |w| or |x|@>@;@/
+h_upd_move(cur_parm)(h_pixel_round(cur_parm));
+@<OUT: Move right@>@;
+end;
+
+@ The |do_down| procedure is called in order to process the vertical
+movement commands |down|, |y|, and |z|.
+
+@p procedure do_down;@/
+@<OUT: Declare local variables (if any) for |do_down|@>@;
+begin if cur_class>=y_cl then cur_y_z[cur_class-y_cl]:=cur_parm
+else if cur_class<down_cl then cur_parm:=cur_y_z[cur_class-y0_cl];
+@<OUT: Process a |down| or |y| or |z|@>@;@/
+v_upd_move(cur_parm)(v_pixel_round(cur_parm));
+@<OUT: Move down@>@;
+end;
+
+@ The |do_width| procedure, or actually the |do_a_width| macro, is
+called in order to increase the current horizontal position |cur_h| by
+|cur_h_dimen| in exactly the same way as if a character of width
+|cur_h_dimen| had been typeset.
+
+@d do_a_width(#)==
+ begin @!device h_pixels:=#; @+ ecived @; @+ do_width;
+ end
+
+@p procedure do_width;@/
+@<OUT: Declare local variables (if any) for |do_width|@>@;
+begin @<OUT: Typeset a |width|@>@;@/
+h_upd_char(cur_h_dimen)(h_pixels);
+@<OUT: Move right@>@;
+end;
+
+@ Finally we have the commands for the typesetting of rules and characters;
+the global variable |cur_upd| is |true| if the horizontal position shall
+be updated (\\{set} commands).
+
+The |do_rule| procedure is called in order to typeset a rule.
+
+@p procedure do_rule;@/
+@<OUT: Declare additional local variables |do_rule|@>@;
+@!visible:boolean;
+begin h_rule_pixels@;
+if (cur_h_dimen>0)and(cur_v_dimen>0) then
+ begin visible:=true; v_rule_pixels@;
+ @<OUT: Typeset a visible |rule|@>@;
+ end
+else begin visible:=false;
+ @<OUT: Typeset an invisible |rule|@>@;
+ end;
+if cur_upd then
+ begin h_upd_move(cur_h_dimen)(h_pixels);
+ @<OUT: Move right@>@;
+ end;
+end;
+
+@ Last not least the |do_char| procedure is called in order to typeset
+character~|cur_res| with extension~|cur_ext| from the real font~|cur_fnt|.
+
+@p procedure do_char;@/
+@<OUT: Declare local variables (if any) for |do_char|@>@;
+begin @<OUT: Typeset a |char|@>@;
+if cur_upd then
+ begin h_upd_char(widths[cur_wp])(char_pixels[cur_cp]);
+ @<OUT: Move right@>@;
+ end;
+end;
+
+@ If the program terminates abnormally, the following code may be
+invoked in the middle of a page.
+
+@<Finish output file(s)@>=
+begin if type_setting then @<OUT: Finish incomplete page@>;
+@<OUT: Finish output file(s)@>@;
+end
+
+@ When the first character of font~|cur_fnt| is about to be typeset, the
+|do_font| procedure is called in order to decide whether this is a
+virtual font or a real font.
+
+One step in this decision is the attempt to find and read the \.{VF}
+file for this font; other attempts to locate a font file may be
+performed before and after that, depending on the nature of the output
+device and on the structure of the file system at a particular
+installation. For a real device we convert the character widths to
+(horizontal) pixels.
+
+In any case |do_font| must change |font_type(cur_fnt)| to a value
+|>defined_font|; as a last resort one might use the \.{TFM} width data
+and draw boxes or leave blank spaces in the output.
+
+@p procedure do_font;@/
+label done;@/
+@<OUT: Declare additional local variables for |do_font|@>@;
+@!p:char_pointer; {index into |char_widths| and |char_pixels|}
+begin @!debug if font_type(cur_fnt)=defined_font then confusion(str_fonts);
+gubed@;
+@!device for p:=font_chars(cur_fnt)+font_bc(cur_fnt)
+ to font_chars(cur_fnt)+font_ec(cur_fnt) do
+ char_pixels[p]:=h_pixel_round(widths[char_widths[p]]);
+ecived@;
+@<OUT: Look for a font file before trying to read the \.{VF} file;
+ if found |goto done|@>@;@/
+if do_vf then goto done; {try to read the \.{VF} file}
+@<OUT: Look for a font file after trying to read the \.{VF} file@>@;@/
+done:
+@!debug if font_type(cur_fnt)<=loaded_font then confusion(str_fonts);
+gubed@;
+end;
+
+@ Before a character of font~|cur_fnt| is typeset the following piece of
+code ensures that the font is ready to be used.
+
+@<Prepare to use font |cur_fnt|@>=
+@<OUT: Prepare to use font |cur_fnt|@>@;
+if font_type(cur_fnt)<=loaded_font then do_font {|cur_fnt| was not yet used}
+
+@* Interpreting VF packets.
+The |pckt_first_par| procedure first reads a \.{DVI} command byte from
+the packet into |cur_cmd|; then |cur_parm| is set to the value of the
+first parameter (if any) and |cur_class| to the command class.
+
+@p procedure pckt_first_par;
+begin cur_cmd:=pckt_ubyte;
+case dvi_par[cur_cmd] of
+char_par: set_cur_char(pckt_ubyte);
+no_par: do_nothing;
+dim1_par: cur_parm:=pckt_sbyte;
+num1_par: cur_parm:=pckt_ubyte;
+dim2_par: cur_parm:=pckt_spair;
+num2_par: cur_parm:=pckt_upair;
+dim3_par: cur_parm:=pckt_strio;
+num3_par: cur_parm:=pckt_utrio;
+three_cases(dim4_par): cur_parm:=pckt_squad; {|dim4|, |num4|, or |numu|}
+rule_par:
+ begin cur_v_dimen:=pckt_squad; cur_h_dimen:=pckt_squad;
+ cur_upd:=(cur_cmd=set_rule);
+ end;
+fnt_par:cur_parm:=cur_cmd-fnt_num_0;
+end; {there are no other cases}
+cur_class:=dvi_cl[cur_cmd];
+end;
+
+@ The |do_vf_packet| procedure is called in order to interpret the
+character packet for a virtual character. Such a packet may contain the
+instruction to typeset a character from the same or an other virtual
+font; in such cases |do_vf_packet| calls itself recursively. The
+recursion level, i.e., the number of times this has happened, is kept
+in the global variable |n_recur| and should not exceed |max_recursion|.
+@^recursion@>
+
+@<Types...@>=
+@!recur_pointer=0..max_recursion;
+
+@ The \.{\title} processor should detect an infinite recursion caused by
+bad \.{VF} files; thus a new recursion level is entered even in cases
+where this could be avoided without difficulty.
+
+If the recursion level exceeds the allowed maximum, we want to give
+a traceback how this has happened; thus some of the global variables
+used in different invocations of |do_vf_packet| are saved in a stack,
+others are saved as local variables of |do_vf_packet|.
+
+@<Glob...@>=
+@!recur_fnt:array[recur_pointer] of font_number; {this packet's font}
+@!recur_ext:array[recur_pointer] of int_24; {this packet's extension}
+@!recur_res:array[recur_pointer] of int_32; {this packet's residue}
+@!recur_pckt:array[recur_pointer] of pckt_pointer; {the packet}
+@!recur_loc:array[recur_pointer] of byte_pointer; {next byte of packet}
+@!n_recur:recur_pointer; {current recursion level}
+@!recur_used:recur_pointer; {highest recursion level used so far}
+
+@ @<Set init...@>=
+n_recur:=0; recur_used:=0;
+
+@ Here now is the |do_vf_packet| procedure.
+
+@p procedure do_vf_packet;
+label continue,found,done;
+var k:recur_pointer; {loop index}
+@!f:int_8u; {packet type flag}
+@!save_upd:boolean; {used to save |cur_upd|}
+@!save_cp:width_pointer; {used to save |cur_cp|}
+@!save_wp:width_pointer; {used to save |cur_wp|}
+@!save_limit:byte_pointer; {used to save |cur_limit|}
+begin @<VF: Save values on entry to |do_vf_packet|@>;@/
+@<VF: Interpret the \.{DVI} commands in the packet@>@;@/
+if save_upd then
+ begin cur_h_dimen:=widths[save_wp]; do_a_width(char_pixels[save_cp]);
+ end;
+@<VF: Restore values on exit from |do_vf_packet|@>;@/
+end;
+
+@ On entry to |do_vf_packet| several values must be saved.
+
+@<VF: Save values on entry to |do_vf_packet|@>=
+save_upd:=cur_upd; save_cp:=cur_cp; save_wp:=cur_wp;@/
+recur_fnt[n_recur]:=cur_fnt;
+recur_ext[n_recur]:=cur_ext;
+recur_res[n_recur]:=cur_res
+
+@ Some of these values must be restored on exit from |do_vf_packet|.
+
+@<VF: Restore values on exit from |do_vf_packet|@>=
+cur_fnt:=recur_fnt[n_recur]
+
+@ If |cur_pckt| is the empty packet, we manufacture a |put| command;
+otherwise we read and interpret \.{DVI} commands from the packet.
+
+@<VF: Interpret the \.{DVI} commands in the packet@>=
+if find_packet then f:=cur_type @+ else goto done;
+recur_pckt[n_recur]:=cur_pckt;
+save_limit:=cur_limit;
+cur_fnt:=font_font(cur_fnt);
+if cur_pckt=empty_packet then
+ begin cur_class:=char_cl; goto found;
+ end;
+if cur_loc>=cur_limit then goto done;
+continue: pckt_first_par;
+found: case cur_class of
+char_cl: @<VF: Typeset a |char|@>;
+rule_cl: do_rule;
+xxx_cl:
+ begin pckt_room(cur_parm);
+ while cur_parm>0 do
+ begin append_byte(pckt_ubyte); decr(cur_parm);
+ end;
+ do_xxx;
+ end;
+push_cl: do_push;
+pop_cl: do_pop;
+five_cases(w0_cl): do_right; {|right|, |w|, or |x|}
+five_cases(y0_cl): do_down; {|down|, |y|, or |z|}
+fnt_cl: cur_fnt:=cur_parm;
+othercases confusion(str_packets); {font definition or invalid}
+endcases;
+if cur_loc<cur_limit then goto continue;
+done:
+
+@ The final |put| of a simple packet may be changed into |set_char| or
+\\{set}.
+
+@<VF: Typeset a |char|@>=
+begin @<Prepare to use font |cur_fnt|@>;
+cur_cp:=font_chars(cur_fnt)+cur_res; cur_wp:=char_widths[cur_cp];
+if (cur_loc=cur_limit)and(f=vf_simple) and save_upd then
+ begin save_upd:=false; cur_upd:=true;
+ end;
+if font_type(cur_fnt)=vf_font_type then
+ @<VF: Enter a new recursion level@>
+else do_char;
+end
+
+@ Before entering a new recursion level we must test for overflow; in
+addition a few variables must be saved and restored.
+A |set_char| or \\{set} followed by |pop| is changed into |put|.
+
+@<VF: Enter a new recursion level@>=
+begin recur_loc[n_recur]:=cur_loc; {save}
+if cur_loc<cur_limit then
+ if byte_mem[cur_loc]=bi(pop) then cur_upd:=false;
+if n_recur=recur_used then
+ if recur_used=max_recursion then
+ @<VF: Display the recursion traceback and terminate@>
+ else incr(recur_used);@/
+incr(n_recur); do_vf_packet; decr(n_recur); {recurse}
+cur_loc:=recur_loc[n_recur]; cur_limit:=save_limit; {restore}
+end
+
+@ @<VF: Display the recursion traceback and terminate@>=
+begin print_ln(' !Infinite VF recursion?');
+@.Infinite VF recursion?@>
+for k:=max_recursion downto 0 do
+ begin print('level=',k:1,' font');
+ d_print('=',recur_fnt[k]:1);
+ print_font(recur_fnt[k]);
+ print(' char=',recur_res[k]:1);
+ if recur_ext[k]<>0 then print('.',recur_ext[k]:1);
+ new_line;
+ @!debug hex_packet(recur_pckt[k]); print_ln('loc=',recur_loc[k]:1);
+ gubed@;
+ end;
+overflow(str_recursion,max_recursion);
+end
+
+@* Interpreting the DVI file.
+The |do_dvi| procedure reads the entire \.{DVI} file and initiates
+whatever actions may be necessary.
+
+@p procedure do_dvi;
+label done,exit;
+var temp_byte:int_8u; {byte for temporary variables}
+@!temp_int:int_32; {integer for temporary variables}
+@!dvi_start:int_32; {starting location}
+@!dvi_bop_post:int_32; {location of |bop| or |post|}
+@!dvi_back:int_32; {a back pointer}
+@!k:int_15; {general purpose variable}
+begin @<DVI: Process the preamble@>;
+if random_reading then @<DVI: Process the postamble@>;
+repeat dvi_first_par;
+ while cur_class=fnt_def_cl do
+ begin dvi_do_font(random_reading); dvi_first_par;
+ end;
+ if cur_cmd=bop then @<DVI: Process one page@>;
+until cur_cmd<>eop;
+if cur_cmd<>post then bad_dvi;
+exit:end;
+
+@ @<DVI: Process the preamble@>=
+if dvi_ubyte<>pre then bad_dvi;
+if dvi_ubyte<>dvi_id then bad_dvi;
+dvi_num:=dvi_pquad; dvi_den:=dvi_pquad; dvi_mag:=dvi_pquad;
+tfm_conv:=(25400000.0/dvi_num)*(dvi_den/473628672)/16.0;
+temp_byte:=dvi_ubyte; pckt_room(temp_byte);
+for k:=1 to temp_byte do append_byte(dvi_ubyte);
+print('DVI file: '''); print_packet(new_packet); print_ln(''',');
+print(' num=',dvi_num:1,', den=',dvi_den:1,', mag=',dvi_mag:1);
+if out_mag<=0 then out_mag:=dvi_mag @+ else print(' => ',out_mag:1);
+print_ln('.');
+do_pre; flush_packet
+
+@ @<Glob...@>=
+@!dvi_num:int_31; {numerator}
+@!dvi_den:int_31; {denominator}
+@!dvi_mag:int_31; {magnification}
+
+@ @<DVI: Process the postamble@>=
+begin dvi_start:=dvi_loc; {remember start of first page}
+@<DVI: Find the postamble@>;
+d_print_ln('DVI: postamble at ',dvi_bop_post:1);
+dvi_back:=dvi_pointer;
+if dvi_num<>dvi_pquad then bad_dvi;
+if dvi_den<>dvi_pquad then bad_dvi;
+if dvi_mag<>dvi_pquad then bad_dvi;
+temp_int:=dvi_squad; temp_int:=dvi_squad;
+if stack_size<dvi_upair then overflow(str_stack,stack_size);
+temp_int:=dvi_upair;
+dvi_first_par;
+while cur_class=fnt_def_cl do
+ begin dvi_do_font(false); dvi_first_par;
+ end;
+if cur_cmd<>post_post then bad_dvi;
+if not selected then @<DVI: Find the starting page@>;
+dvi_move(dvi_start); {go to first or starting page}
+end
+
+@ @<DVI: Find the postamble@>=
+temp_int:=dvi_length-5;
+repeat if temp_int<49 then bad_dvi;
+dvi_move(temp_int); temp_byte:=dvi_ubyte; decr(temp_int);
+until temp_byte<>dvi_pad;
+if temp_byte<>dvi_id then bad_dvi;
+dvi_move(temp_int-4); if dvi_ubyte<>post_post then bad_dvi;
+dvi_bop_post:=dvi_pointer;
+if (dvi_bop_post<15)or(dvi_bop_post>dvi_loc-34) then bad_dvi;
+dvi_move(dvi_bop_post); if dvi_ubyte<>post then bad_dvi
+
+@ @<DVI: Find the starting page@>=
+begin dvi_start:=dvi_bop_post; {just in case}
+while dvi_back<>-1 do
+ begin if (dvi_back<15)or(dvi_back>dvi_bop_post-46) then bad_dvi;
+ dvi_bop_post:=dvi_back; dvi_move(dvi_back);
+ if dvi_ubyte<>bop then bad_dvi;
+ for k:=0 to 9 do count[k]:=dvi_squad;
+ if start_match then dvi_start:=dvi_bop_post;
+ dvi_back:=dvi_pointer;
+ end;
+end
+
+@ When a |bop| has been read, the \.{DVI} commands for one page are
+interpreted until an |eop| is found.
+
+@<DVI: Process one page@>=
+begin for k:=0 to 9 do count[k]:=dvi_squad;
+temp_int:=dvi_pointer; do_bop;
+dvi_first_par;
+if type_setting then @<DVI: Process a page; then |goto done|@>
+else @<DVI: Skip a page; then |goto done|@>;
+done:if cur_cmd<>eop then bad_dvi;
+if selected then
+ begin do_eop;
+ if all_done then return;
+ end;
+end
+
+@ All \.{DVI} commands are processed, as long as |cur_class<>invalid_cl|;
+then we should have found an |eop|.
+
+@<DVI: Process a page; then |goto done|@>=
+loop begin
+ case cur_class of
+ char_cl: @<DVI: Typeset a |char|@>;
+ rule_cl:
+ if cur_upd and(cur_v_dimen=width_dimen) then
+ do_a_width(h_pixel_round(cur_h_dimen))
+ else do_rule;
+ xxx_cl:
+ begin pckt_room(cur_parm);
+ while cur_parm>0 do
+ begin append_byte(dvi_ubyte); decr(cur_parm);
+ end;
+ do_xxx;
+ end;
+ push_cl: do_push;
+ pop_cl: do_pop;
+ five_cases(w0_cl): do_right; {|right|, |w|, or |x|}
+ five_cases(y0_cl): do_down; {|down|, |y|, or |z|}
+ fnt_cl: dvi_font;
+ fnt_def_cl: dvi_do_font(random_reading);
+ invalid_cl: goto done;
+ end; {there are no other cases}
+dvi_first_par; {get the next command}
+end
+
+@ While skipping a page all commands other than font definitions are
+ignored.
+
+@<DVI: Skip a page; then |goto done|@>=
+loop begin
+ case cur_class of
+ xxx_cl: while cur_parm>0 do
+ begin temp_byte:=dvi_ubyte; decr(cur_parm);
+ end;
+ fnt_def_cl: dvi_do_font(random_reading);
+ invalid_cl: goto done;
+ othercases do_nothing;
+ endcases;
+dvi_first_par; {get the next command}
+end
+
+@ @<DVI: Typeset a |char|@>=
+begin @<Prepare to use font |cur_fnt|@>;
+set_cur_wp(cur_fnt)(bad_dvi);
+if font_type(cur_fnt)=vf_font_type then do_vf_packet @+ else do_char;
+end
+
+@* The main program.
+The code for real devices is still rather incomplete.
+Moreover several branches of the program have not been tested because
+they are never used with \.{DVI} files made by \TeX\ and \.{VF} files
+made by \.{VPtoVF}. The same holds true for~$\Omega$.
+
+@ At the end of the program the output file(s) have to be finished and
+on some systems it may be necessary to close input and\slash or output
+files.
+@^system dependencies@>
+
+@p procedure close_files_and_terminate;
+var k:@!int_15; {general purpose index}
+begin close_in(dvi_file);
+if history<fatal_message then @<Finish output file(s)@>;
+stat @<Print memory usage statistics@>;@+tats@;@/
+@<Close output file(s)@>@;
+@<Print the job |history|@>;
+end;
+
+@ Now we are ready to put it all together.
+Here is where \.{\title} starts, and where it ends.
+@^system dependencies@>
+
+@p begin initialize; {get all variables initialized}
+@<Initialize predefined strings@>@;
+dialog; {get options}
+@<Open input file(s)@>@;
+@<Open output file(s)@>@;
+do_dvi; {process the entire \.{DVI} file}
+close_files_and_terminate;
+final_end:end.
+
+@ @<Print memory usage statistics@>=
+print_ln('Memory usage statistics:');
+print(dvi_nf:1,' dvi, ',lcl_nf:1,' local, ');
+@<Print more font usage statistics@>@;@/
+print_ln('and ',nf:1,' internal fonts of ',max_fonts:1);
+print_ln(n_widths:1,' widths of ',max_widths:1,' for ',
+ n_chars:1,' characters of ',max_chars:1);
+print_ln(pckt_ptr:1,' byte packets of ',max_packets:1,' with ',
+ byte_ptr:1,' bytes of ',max_bytes:1);
+@<Print more memory usage statistics@>@;@/
+print_ln(stack_used:1,' of ',stack_size:1,' stack and ',
+ recur_used:1,' of ',max_recursion:1,' recursion levels.')
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_ln('(No errors were found.)');
+harmless_message: print_ln('(Did you see the warning message above?)');
+error_message: print_ln('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_ln('(That was a fatal error, my friend.)');
+end {there are no other cases}
+
+@* Low-level output routines.
+The program uses the binary file variable |out_file| for its main output
+file; |out_loc| is the number of the byte about to be written next on
+|out_file|.
+
+@<Glob...@>=
+@!out_file:byte_file; {the \.{DVI} file we are writing}
+@!out_loc:int_32; {where we are about to write, in |out_file|}
+@!out_back:int_32; {a back pointer}
+@!out_max_v:int_31; {maximum |v| value so far}
+@!out_max_h:int_31; {maximum |h| value so far}
+@!out_stack:int_16u; {maximum stack depth}
+@!out_pages:int_16u; {total number of pages}
+
+@ @<Set ini...@>=
+out_loc:=0; out_back:=-1;
+out_max_v:=0; out_max_h:=0;
+out_stack:=0; out_pages:=0;
+
+@ To prepare |out_file| for output, we |rewrite| it.
+
+@<Open output file(s)@>=
+rewrite(out_file); {prepares to write packed bytes to |out_file|}
+
+@ For some operating systems it may be necessary to close |out_file|.
+
+@<Close output file(s)@>=
+
+@ Writing the |out_file| should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes will be accumulated in a buffer and is then written from that
+buffer to |out_file|. In order to simplify such system dependent changes
+we use the \.{WEB} macro |out_byte| to write the next \.{DVI} byte. Here
+we give a simple minded definition for this macro in terms of standard
+\PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d out_byte(#) == write(out_file,#) {write next \.{DVI} byte}
+
+@ The \.{WEB} macro |out_one| is used to write one byte and to update
+|out_loc|.
+
+@d out_one(#) == begin out_byte(#); incr(out_loc); @+ end
+
+@ First the |out_packet| procedure copies a packet to |out_file|.
+
+@<Declare typesetting procedures@>=
+procedure out_packet(@!p:pckt_pointer);
+var k:byte_pointer; {index into |byte_mem|}
+begin Incr(out_loc)(pckt_length(p));
+for k:=pckt_start[p] to pckt_start[p+1]-1 do out_byte(bo(byte_mem[k]));
+end;
+
+@ Next are the procedures used to write integer numbers or even complete
+\.{DVI} commands to |out_file|; they all keep |out_loc| up to date.
+
+The |out_four| procedure outputs four bytes in two's complement notation,
+without risking arithmetic overflow.
+
+@<Declare typesetting procedures@>=
+procedure out_four(@!x:int_32); {output four bytes}
+@!begin_four; comp_four(out_byte); Incr(out_loc)(4);
+end;
+
+@ The |out_char| procedure outputs a |set_char| or \\{set} command or, if
+|upd=false|, a |put| command.
+
+@<Declare typesetting procedures@>=
+procedure out_char(@!upd:boolean;@!ext:int_32;@!res:int_32);
+ {output \\{set} or |put|}
+@!begin_char; comp_char(out_one);
+end;
+
+@ The |out_unsigned| procedure outputs a |fnt|, |xxx|, or |fnt_def|
+command with its first parameter (normally unsigned); a |fnt| command
+is converted into |fnt_num| whenever this is possible.
+
+@<Declare typesetting procedures@>=
+procedure out_unsigned(@!o:eight_bits;@!x:int_32);
+ {output |fnt_num|, |fnt|, |xxx|, or |fnt_def|}
+@!begin_unsigned; comp_unsigned(out_one);
+end;
+
+@ The |out_signed| procedure outputs a movement (|right|, |w|,
+|x|, |down|, |y|, or |z|) command with its (signed) parameter.
+
+@<Declare typesetting procedures@>=
+procedure out_signed(@!o:eight_bits;@!x:int_32);
+ {output |right|, |w|, |x|, |down|, |y|, or |z|}
+@!begin_signed; comp_signed(out_one);
+end;
+
+@ For an output font we set |font_type(f):=out_font_type|; in this case
+|font_font(f)| is the font number used for font~|f| in |out_file|.
+@^font types@>
+
+The global variable |out_nf| is the number of fonts already used in
+|out_file| and the array |out_fnts| contains their internal font numbers;
+the current font in |out_file| is called |out_fnt|.
+
+@<Glob...@>=
+@!out_fnts:array[font_number] of font_number; {internal font numbers}
+@!out_nf:font_number; {number of fonts used in |out_file|}
+@!out_fnt:font_number; {internal font number of current output font}
+
+@ @<Set init...@>=
+out_nf:=0;
+
+@ @<Print more font usage statistics@>=
+print(out_nf:1,' out, ');
+
+@ The |out_fnt_def| procedure outputs a complete font definition
+command.
+
+@<Declare typesetting procedures@>=
+procedure out_fnt_def(@!f:font_number);
+var p:pckt_pointer; {the font name packet}
+@!k,@!l:byte_pointer; {indices into |byte_mem|}
+@!a:eight_bits; {length of area part}
+begin out_unsigned(fnt_def1,font_font(f)); out_four(font_check(f));
+out_four(font_scaled(f)); out_four(font_design(f));@/
+p:=font_name(f); k:=pckt_start[p]; l:=pckt_start[p+1]-1;
+a:=bo(byte_mem[k]);@/
+Incr(out_loc)(l-k+2); out_byte(a); out_byte(l-k-a);
+while k<l do
+ begin incr(k); out_byte(bo(byte_mem[k]));
+ end;
+end;
+
+@* Writing the output file.
+Here we define the device dependent parts of the typesetting routines
+described earlier in this program.
+
+First we define a few quantities required by the device dependent code
+for a real output device in order to demonstrate how they might be
+defined and in order to be able to compile \.{DVIcopy} with the device
+dependent code included.
+
+@d h_resolution==300 {horizontal resolution in pixels per inch (dpi)}
+@d v_resolution==300 {vertical resolution in pixels per inch (dpi)}
+
+@d max_h_drift==2 {we insist that |abs(hh-h_pixel_round(h))<=max_h_drift|}
+@d max_v_drift==2 {we insist that |abs(vv-v_pixel_round(v))<=max_v_drift|}
+
+@<Glob...@>=
+@!device
+@!h_conv:real; {converts \.{DVI} units to horizontal pixels}
+@!v_conv:real; {converts \.{DVI} units to vertical pixels}
+ecived
+
+@ These are the local variables (if any) needed for |do_pre|.
+
+@<OUT: Declare local variables (if any) for |do_pre|@>=
+var k:int_15; {general purpose variable}
+@!p,@!q,@!r:byte_pointer; {indices into |byte_mem|}
+@!comment:packed array[1..comm_length] of char; {preamble comment prefix}
+
+@ And here is the device dependent code for |do_pre|; the \.{DVI} preamble
+comment written to |out_file| is similar to the one produced by \.{GFtoPK},
+but we want to apply our preamble comment prefix only once.
+
+@<OUT: Process the |pre|@>=
+out_one(pre); out_one(dvi_id);
+out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/
+p:=pckt_start[pckt_ptr-1]; q:=byte_ptr; {location of old \.{DVI} comment}
+comment:=preamble_comment; pckt_room(comm_length);
+for k:=1 to comm_length do append_byte(xord[comment[k]]);
+while byte_mem[p]=bi(" ") do incr(p); {remove leading blanks}
+if p=q then Decr(byte_ptr)(from_length)
+else begin k:=0;
+ while (k<comm_length)and(byte_mem[p+k]=byte_mem[q+k]) do incr(k);
+ if k=comm_length then Incr(p)(comm_length);
+ end;
+k:=byte_ptr-p; {total length}
+if k>255 then
+ begin k:=255; q:=p+255-comm_length; {at most 255 bytes}
+ end;
+out_one(k); out_packet(new_packet); flush_packet;
+for r:=p to q-1 do out_one(bo(byte_mem[r]));
+
+@ These are the additional local variables (if any) needed for |do_bop|;
+the variables |@!i| and |@!j| are already declared.
+
+@<OUT: Declare additional local variables |do_bop|@>=
+var
+
+@ And here is the device dependent code for |do_bop|.
+
+@<OUT: Process a |bop|@>=
+out_one(bop); incr(out_pages);
+for i:=0 to 9 do out_four(count[i]);
+out_four(out_back); out_back:=out_loc-45;
+out_fnt:=invalid_font;
+
+@ These are the local variables (if any) needed for |do_eop|.
+
+@<OUT: Declare local variables (if any) for |do_eop|@>=
+
+@ And here is the device dependent code for |do_eop|.
+
+@<OUT: Process an |eop|@>=
+out_one(eop);
+
+@ These are the local variables (if any) needed for |do_push|.
+
+@<OUT: Declare local variables (if any) for |do_push|@>=
+
+@ And here is the device dependent code for |do_push|.
+
+@<OUT: Process a |push|@>=
+if stack_ptr>out_stack then out_stack:=stack_ptr;
+out_one(push);
+
+@ These are the local variables (if any) needed for |do_pop|.
+
+@<OUT: Declare local variables (if any) for |do_pop|@>=
+
+@ And here is the device dependent code for |do_pop|.
+
+@<OUT: Process a |pop|@>=
+out_one(pop);
+
+@ These are the additional local variables (if any) needed for |do_xxx|;
+the variable |@!p|, the pointer to the packet containing the special
+string, is already declared.
+
+@<OUT: Declare additional local variables for |do_xxx|@>=
+var
+
+@ And here is the device dependent code for |do_xxx|.
+
+@<OUT: Process an |xxx|@>=
+out_unsigned(xxx1,pckt_length(p)); out_packet(p);
+
+@ These are the local variables (if any) needed for |do_right|.
+
+@<OUT: Declare local variables (if any) for |do_right|@>=
+
+@ And here is the device dependent code for |do_right|.
+
+@<OUT: Process a |right| or |w| or |x|@>=
+if cur_class<right_cl then out_one(cur_cmd) {|w0| or |x0|}
+else out_signed(dvi_right_cmd[cur_class],cur_parm); {|right|, |w|, or |x|}
+
+@ Here we update the |out_max_h| value.
+
+@<OUT: Move right@>=
+if abs(cur_h)>out_max_h then out_max_h:=abs(cur_h);
+
+@ These are the local variables (if any) needed for |do_down|.
+
+@<OUT: Declare local variables (if any) for |do_down|@>=
+
+@ And here is the device dependent code for |do_down|.
+
+@<OUT: Process a |down| or |y| or |z|@>=
+if cur_class<down_cl then out_one(cur_cmd) {|y0| or |z0|}
+else out_signed(dvi_down_cmd[cur_class],cur_parm); {|down|, |y|, or |z|}
+
+@ Here we update the |out_max_v| value.
+
+@<OUT: Move down@>=
+if abs(cur_v)>out_max_v then out_max_v:=abs(cur_v);
+
+@ These are the local variables (if any) needed for |do_width|.
+
+@<OUT: Declare local variables (if any) for |do_width|@>=
+
+@ And here is the device dependent code for |do_width|.
+
+@<OUT: Typeset a |width|@>=
+out_one(set_rule);
+out_four(width_dimen); out_four(cur_h_dimen);
+
+@ These are the additional local variables (if any) needed for |do_rule|;
+the variable |@!visible| is already declared.
+
+@<OUT: Declare additional local variables |do_rule|@>=
+var
+
+@ And here is the device dependent code for |do_rule|.
+
+@<OUT: Typeset a visible |rule|@>=
+out_one(dvi_rule_cmd[cur_upd]);
+out_four(cur_v_dimen); out_four(cur_h_dimen);
+
+@ @<OUT: Typeset an invisible |rule|@>=
+@<OUT: Typeset a visible |rule|@>
+
+@ These are the additional local variables (if any) needed for |do_font|;
+the variable |@!p| is already declared.
+
+@<OUT: Declare additional local variables for |do_font|@>=
+var
+
+@ And here is the device dependent code for |do_font|; if the \.{VF} file
+for a font could not be found, we simply assume this must be a real font.
+
+@<OUT: Look for a font file before trying to read the \.{VF} file;
+ if found |goto done|@>=
+
+@ @<OUT: Look for a font file after trying to read the \.{VF} file@>=
+if(out_nf>=max_fonts) then overflow(str_fonts,max_fonts);
+print('OUT: font ',cur_fnt:1); d_print(' => ',out_nf:1);
+print_font(cur_fnt);
+d_print(' at ',font_scaled(cur_fnt):1,' DVI units'); print_ln('.');
+font_type(cur_fnt):=out_font_type; font_font(cur_fnt):=out_nf;
+out_fnts[out_nf]:=cur_fnt; incr(out_nf);
+out_fnt_def(cur_fnt);
+
+@ And here is some device dependent code used before each character.
+
+@<OUT: Prepare to use font |cur_fnt|@>=
+
+@ These are the local variables (if any) needed for |do_char|.
+
+@<OUT: Declare local variables (if any) for |do_char|@>=
+
+@ And here is the device dependent code for |do_char|.
+
+@<OUT: Typeset a |char|@>=
+@!debug if font_type(cur_fnt)<>out_font_type then confusion(str_fonts);
+gubed @;
+if cur_fnt<>out_fnt then
+ begin out_unsigned(fnt1,font_font(cur_fnt)); out_fnt:=cur_fnt;
+ end;
+out_char(cur_upd,cur_ext,cur_res);
+
+@ If the program terminates in the middle of a page, we write as many
+|pop|s as necessary and one |eop|.
+
+@<OUT: Finish incomplete page@>=
+begin while stack_ptr>0 do
+ begin out_one(pop); decr(stack_ptr);
+ end;
+ out_one(eop);
+end
+
+@ If the output file has been started, we write the postamble; in
+addition we print the number of bytes and pages written to |out_file|.
+
+@<OUT: Finish output file(s)@>=
+if out_loc>0 then
+ begin @<OUT: Write the postamble@>;
+ k:=7-((out_loc-1) mod 4); {the number of |dvi_pad| bytes}
+ while k>0 do
+ begin out_one(dvi_pad); decr(k);
+ end;
+ print('OUT file: ',out_loc:1,' bytes, ',out_pages:1,' page');
+ if out_pages<>1 then print('s');
+ end
+else print('OUT file: no output');
+print_ln(' written.');
+if out_pages=0 then mark_harmless;
+
+@ Here we simply write the values accumulated during the \.{DVI} output.
+
+@<OUT: Write the postamble@>=
+out_one(post); out_four(out_back); out_back:=out_loc-5;@/
+out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/
+out_four(out_max_v); out_four(out_max_h);@/
+out_one(out_stack div @"100); out_one(out_stack mod @"100);@/
+out_one(out_pages div @"100); out_one(out_pages mod @"100);@/
+k:=out_nf;
+while k>0 do
+ begin decr(k); out_fnt_def(out_fnts[k]);
+ end;
+out_one(post_post); out_four(out_back);@/
+out_one(dvi_id)
+
+@ Here we could print more memory usage statistics; this possibility is,
+however, not used for \.{DVIcopy}.
+
+@<Print more memory usage statistics@>=
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVIcopy} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
+
diff --git a/Build/source/texk/web2c/omegaware/odvitype.ch b/Build/source/texk/web2c/omegaware/odvitype.ch
new file mode 100644
index 00000000000..a1e49ad1c6c
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/odvitype.ch
@@ -0,0 +1,767 @@
+% odvitype.ch: web2c changes for file odvitype.web
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original dvitype.ch.
+%
+% dvitype.ch for C compilation with web2c.
+%
+% 04/04/83 (PC) Merged with Pavel's change file and made to work with the
+% version 1.0 of DVItype released with version 0.95 of TeX in
+% February, 1983.
+% 04/18/83 (PC) Added changes to module 47 so that it would work the same
+% when input was a file (or pipe) as with a terminal.
+% 06/29/83 (HWT) Brought up to version 1.1 as released with version 0.99 of
+% TeX, with new change file format
+% 07/28/83 (HWT) Brought up to version 2 as released with version 0.999.
+% Only the banner changes.
+% 11/21/83 (HWT) Brought up to version 2.2 as released with version 1.0.
+% 02/19/84 (HWT) Made it use the TEXFONTS environment variable.
+% 03/23/84 (HWT) Brought up to version 2.3.
+% 07/11/84 (HWT) Brought up to version 2.6 as released with version 1.1.
+% 11/07/84 (ETM) Brought up to version 2.7 as released with version 1.2.
+% 03/09/88 (ETM) Brought up to version 2.9
+% 03/16/88 (ETM) Converted for use with WEB to C.
+% 11/30/89 (KB) To version 3.
+% 01/16/90 (SR) To version 3.2.
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{DVI$\,$\lowercase{type} changes for C}
+@z
+
+% [3] Specify the output file to simplify web2c, and don't print the
+% banner until later.
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@y
+@d print(#)==write(stdout, #)
+@d print_ln(#)==write_ln(stdout, #)
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+ print (banner);
+ print_ln (version_string);
+@z
+
+@x [5] Allow more fonts, more widths, no arbitrary filename length.
+@!max_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
+@!max_widths=100000; {maximum number of different characters among all fonts}
+@y
+@!max_fonts=500; {maximum number of distinct fonts per \.{DVI} file}
+@!max_widths=100000; {maximum number of different characters among all fonts}
+@z
+@x
+@!name_size=1000; {total length of all font file names}
+@!name_length=50; {a file name shouldn't be longer than this}
+@y
+@!name_size=10000; {total length of all font file names}
+@z
+
+@x [7] Remove non-local goto.
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+@y
+@d jump_out==uexit(1)
+@d abort(#)==begin write_ln(stderr,#); jump_out; end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+@z
+
+@x [8] Permissive input.
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+@y
+@!ASCII_code=0..255; {a subrange of the integers}
+@z
+
+% [9] The text_char type is used as an array index into `xord'. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@z
+
+@x [23] Fix up opening the files.
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_name);
+end;
+@y
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin
+ cur_name := extend_filename (cmdline (optind), 'dvi');
+ resetbin (dvi_file, cur_name);
+ cur_loc := 0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+var full_name: ^char;
+begin
+ full_name := kpse_find_tfm (cur_name);
+ if full_name then begin
+ tfm_file := fopen (full_name, FOPEN_RBIN_MODE);
+ end else begin
+ full_name := kpse_find_ofm (cur_name);
+ if full_name then begin
+ tfm_file := fopen (full_name, FOPEN_RBIN_MODE);
+ end else begin
+ tfm_file := nil;
+ end;
+ end;
+end;
+@z
+
+@x [24] No arbitrary limit on filename length.
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+@!cur_name:^char; {external name}
+@z
+
+@x [27] Make get_n_bytes routines work with 16-bit math.
+get_two_bytes:=a*256+b;
+@y
+get_two_bytes:=intcast(a)*256+intcast(b);
+@z
+@x
+get_three_bytes:=(a*256+b)*256+c;
+@y
+get_three_bytes:=(intcast(a)*256+intcast(b))*256+intcast(c);
+@z
+@x
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+@y
+if a<128 then signed_trio:=(intcast(a)*256+b)*256+intcast(c)
+else signed_trio:=((intcast(a)-256)*256+intcast(b))*256+intcast(c);
+@z
+@x
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+@y
+if a<128 then signed_quad:=((intcast(a)*256+b)*256+intcast(c))*256+intcast(d)
+else signed_quad:=(((intcast(a)-256)*256+intcast(b))*256+intcast(c))*256+intcast(d);
+@z
+
+@x [28] dvi_length and move_to_byte.
+@p function dvi_length:integer;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin set_pos(dvi_file,n); cur_loc:=n;
+end;
+@y
+@p function dvi_length:integer;
+begin
+ xfseek (dvi_file, 0, 2, 'odvitype');
+ cur_loc := xftell(dvi_file, 'odvitype');
+ dvi_length := cur_loc;
+end;
+@#
+procedure move_to_byte(n:integer);
+begin
+ xfseek (dvi_file, n, 0, 'odvitype');
+ cur_loc:=n;
+end;
+@z
+
+@x [35] Make 16-bit TFM calculations work.
+if (b0*256+b1)<>0 then begin {TFM file}
+ ofm_level:=-1;
+ lh:=b2*256+b3;
+ read_tfm_word; font_bc[nf]:=b0*256+b1; font_ec[nf]:=b2*256+b3;
+@y
+if (intcast(b0)*256+intcast(b1))<>0 then begin {TFM file}
+ ofm_level:=-1;
+ lh:=intcast(b2)*256+intcast(b3);
+ read_tfm_word; font_bc[nf]:=intcast(b0)*256+intcast(b1);
+ font_ec[nf]:=intcast(b2)*256+intcast(b3);
+@z
+@x
+ read_tfm_word; nw:=b0*256+b1;
+@y
+ read_tfm_word; nw:=intcast(b0)*256+intcast(b1);
+@z
+@x
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3
+@y
+ if b0<128 then tfm_check_sum:=((intcast(b0)*256+intcast(b1))*256+intcast(b2))*256+intcast(b3)
+ else tfm_check_sum:=(((intcast(b0)-256)*256+intcast(b1))*256+intcast(b2))*256+intcast(b3)
+@z
+@x
+ ofm_level:=b2*256+b3;
+ read_tfm_word;
+ read_tfm_word; lh:=((b0*256+b1)*256+b2)*256+b3;
+ read_tfm_word; font_bc[nf]:=((b0*256+b1)*256+b2)*256+b3;
+ read_tfm_word; font_ec[nf]:=((b0*256+b1)*256+b2)*256+b3;
+@y
+ ofm_level:=intcast(b2)*256+intcast(b3);
+ read_tfm_word;
+ read_tfm_word; lh:=((intcast(b0)*256+intcast(b1))*256+intcast(b2))*256+intcast(b3);
+ read_tfm_word; font_bc[nf]:=((intcast(b0)*256+intcast(b1))*256+intcast(b2))*256+intcast(b3);
+ read_tfm_word; font_ec[nf]:=((intcast(b0)*256+intcast(b1))*256+intcast(b2))*256+intcast(b3);
+@z
+@x
+ read_tfm_word; nw:=((b0*256+b1)*256+b2)*256+b3;
+@y
+ read_tfm_word; nw:=((intcast(b0)*256+intcast(b1))*256+intcast(b2))*256+intcast(b3);
+@z
+@x
+ read_tfm_word; extra_words:=(((b0*256+b1)*256+b2)*256+b3) div 2;
+@y
+ read_tfm_word;
+ extra_words:=(((intcast(b0)*256+intcast(b1))*256+intcast(b2))*256+intcast(b3)) div 2;
+@z
+@x
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3
+@y
+ if b0<128 then tfm_check_sum:=((intcast(b0)*256+intcast(b1))*256+intcast(b2))*256+intcast(b3)
+ else tfm_check_sum:=(((intcast(b0)-256)*256+intcast(b1))*256+intcast(b2))*256+intcast(b3)
+@z
+@x
+ if (b0*256+b1)>nw then goto 9997;
+ width[k]:=(b0*256+b1);
+@y
+ if (intcast(b0)*256+intcast(b1))>nw then goto 9997;
+ width[k]:=(intcast(b0)*256+intcast(b1));
+@z
+@x
+ if (b0*256+b1)>nw then goto 9997;
+ width[k]:=(b0*256+b1);
+ read_tfm_word; read_tfm_word;
+ kprime:=k+(b0*256+b1);
+@y
+ if (intcast(b0)*256+intcast(b1))>nw then goto 9997;
+ width[k]:=(intcast(b0)*256+intcast(b1));
+ read_tfm_word; read_tfm_word;
+ kprime:=k+(intcast(b0)*256+intcast(b1));
+@z
+
+@x [43] Initialize optional variables sooner.
+out_mode:=the_works; max_pages:=1000000; start_vals:=0; start_there[0]:=false;
+@y
+@ Initializations are done sooner now.
+@z
+
+@x [45] No dialog.
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+@ No dialog.
+@z
+
+@x [47] No input_ln.
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+@y
+@z
+
+@x [48] No dialog.
+@ The global variable |buf_ptr| is used while scanning each line of input;
+it points to the first unread character in |buffer|.
+
+@<Glob...@>=
+@!buf_ptr:0..terminal_line_length; {the number of characters read}
+@y
+@ No dialog.
+@z
+
+@x [49] No dialog.
+@ Here is a routine that scans a (possibly signed) integer and computes
+the decimal value. If no decimal integer starts at |buf_ptr|, the
+value 0 is returned. The integer should be less than $2^{31}$ in
+absolute value.
+
+@p function get_integer:integer;
+var x:integer; {accumulates the value}
+@!negative:boolean; {should the value be negated?}
+begin if buffer[buf_ptr]="-" then
+ begin negative:=true; incr(buf_ptr);
+ end
+else negative:=false;
+x:=0;
+while (buffer[buf_ptr]>="0")and(buffer[buf_ptr]<="9") do
+ begin x:=10*x+buffer[buf_ptr]-"0"; incr(buf_ptr);
+ end;
+if negative then get_integer:=-x @+ else get_integer:=x;
+end;
+
+@y
+@ No dialog.
+@z
+
+@x [50-55] No dialog.
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{DVItype} begins.
+@^system dependencies@>
+
+@p procedure dialog;
+label 1,2,3,4,5;
+var k:integer; {loop variable}
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);
+@<Determine the desired |out_mode|@>;
+@<Determine the desired |start_count| values@>;
+@<Determine the desired |max_pages|@>;
+@<Determine the desired |resolution|@>;
+@<Determine the desired |new_mag|@>;
+@<Print all the selected options@>;
+end;
+
+@ @<Determine the desired |out_mode|@>=
+1: write(term_out,'Output level (default=4, ? for help): ');
+out_mode:=the_works; input_ln;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="4") then out_mode:=buffer[0]-"0"
+ else begin write(term_out,'Type 4 for complete listing,');
+ write(term_out,' 0 for errors only,');
+ write_ln(term_out,' 1 or 2 or 3 for something in between.');
+ goto 1;
+ end
+
+@ @<Determine the desired |start...@>=
+2: write(term_out,'Starting page (default=*): ');
+start_vals:=0; start_there[0]:=false;
+input_ln; buf_ptr:=0; k:=0;
+if buffer[0]<>" " then
+ repeat if buffer[buf_ptr]="*" then
+ begin start_there[k]:=false; incr(buf_ptr);
+ end
+ else begin start_there[k]:=true; start_count[k]:=get_integer;
+ end;
+ if (k<9)and(buffer[buf_ptr]=".") then
+ begin incr(k); incr(buf_ptr);
+ end
+ else if buffer[buf_ptr]=" " then start_vals:=k
+ else begin write(term_out,'Type, e.g., 1.*.-5 to specify the ');
+ write_ln(term_out,'first page with \count0=1, \count2=-5.');
+ goto 2;
+ end;
+ until start_vals=k
+
+@ @<Determine the desired |max_pages|@>=
+3: write(term_out,'Maximum number of pages (default=1000000): ');
+max_pages:=1000000; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin max_pages:=get_integer;
+ if max_pages<=0 then
+ begin write_ln(term_out,'Please type a positive number.');
+ goto 3;
+ end;
+ end
+
+@ @<Determine the desired |resolution|@>=
+4: write(term_out,'Assumed device resolution');
+write(term_out,' in pixels per inch (default=300/1): ');
+resolution:=300.0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin k:=get_integer;
+ if (k>0)and(buffer[buf_ptr]="/")and
+ (buffer[buf_ptr+1]>"0")and(buffer[buf_ptr+1]<="9") then
+ begin incr(buf_ptr); resolution:=k/get_integer;
+ end
+ else begin write(term_out,'Type a ratio of positive integers;');
+ write_ln(term_out,' (1 pixel per mm would be 254/10).');
+ goto 4;
+ end;
+ end
+
+@ @<Determine the desired |new_mag|@>=
+5: write(term_out,'New magnification (default=0 to keep the old one): ');
+new_mag:=0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="9") then new_mag:=get_integer
+ else begin write(term_out,'Type a positive integer to override ');
+ write_ln(term_out,'the magnification in the DVI file.');
+ goto 5;
+ end
+@y
+@ No dialog (50).
+@ No dialog (51).
+@ No dialog (52).
+@ No dialog (53).
+@ No dialog (54).
+@ No dialog (55).
+@z
+
+@x [56] Fix printing of floating point number.
+print_ln(' Resolution = ',resolution:12:8,' pixels per inch');
+if new_mag>0 then print_ln(' New magnification factor = ',new_mag/1000:8:3)
+@y
+print (' Resolution = ');
+print_real (resolution, 12, 8);
+print_ln (' pixels per inch');
+if new_mag > 0
+then begin
+ print (' New magnification factor = ');
+ print_real (new_mag / 1000.0, 8, 3);
+ print_ln('')
+end
+@z
+
+@x [59] We use r for something else.
+@!r:0..name_length; {index into |cur_name|}
+@y
+@!r:0..name_size; {current filename length}
+@z
+
+@x [62] <Load the new font...> close the file when we're done
+if out_mode=errors_only then print_ln(' ');
+@y
+if out_mode=errors_only then print_ln(' ');
+if tfm_file then
+ xfclose (tfm_file, cur_name); {should be the |kpse_find_tfm| result}
+free (cur_name); {We |xmalloc|'d this before we got called.}
+@z
+
+@x [64] Don't set default_directory_name.
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+@y
+Under Unix, users have a path searched for fonts, there's no single
+default directory.
+@z
+
+@x [65] Remove initialization of default_directory.
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+@y
+@ (No initialization needs to be done. Keep this module to preserve
+numbering.)
+@z
+
+@x [66] Don't append `.tfm' here, and keep lowercase.
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@^system dependencies@>
+
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if p=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_name[nf] to font_name[nf+1]-1 do
+ begin incr(r);
+ if r+4>name_length then
+ abort('ODVItype capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.ODVItype capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+@y
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. We do not impose a maximum limit
+here. It's too bad there is a limit on the total length of all
+filenames, but it doesn't seem worth reprogramming all that.
+@^system dependencies@>
+
+@d name_start == font_name[nf]
+@d name_end == font_name[nf+1]
+
+@<Move font name into the |cur_name| string@>=
+r := name_end - name_start;
+cur_name := xmalloc_array (char, r);
+{|strncpy| might be faster, but it's probably a good idea to keep the
+ |xchr| translation.}
+for k := name_start to name_end do begin
+ cur_name[k - name_start] := xchr[names[k]];
+end;
+cur_name[r] := 0; {Append null byte for C.}
+@z
+
+@x [80] (major,minor) optionally show opcode
+@d show(#)==begin flush_text; showing:=true; print(a:1,': ',#);
+ end
+@d major(#)==if out_mode>errors_only then show(#)
+@d minor(#)==if out_mode>terse then
+ begin showing:=true; print(a:1,': ',#);
+@y
+@d show(#)==begin flush_text; showing:=true; print(a:1,': ',#);
+ if show_opcodes and (o >= 128) then print (' {', o:1, '}');
+ end
+@d major(#)==if out_mode>errors_only then show(#)
+@d minor(#)==if out_mode>terse then
+ begin showing:=true; print(a:1,': ',#);
+ if show_opcodes and (o >= 128) then print (' {', o:1, '}');
+@z
+
+@x [106] (main) No dialog; remove unused label.
+dialog; {set up all the options}
+@y
+@<Print all the selected options@>;
+@z
+
+@x
+final_end:end.
+@y
+end.
+@z
+
+@x [109] Fix another floating point print.
+print_ln('magnification=',mag:1,'; ',conv:16:8,' pixels per DVI unit')
+@y
+print ('magnification=', mag:1, '; ');
+print_real (conv, 16, 8);
+print_ln (' pixels per DVI unit')
+@z
+
+@x [111] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVItype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 8; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+ @!end_num:^char; {for \.{page-start}}
+begin
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('odvitype');
+
+ end else if argument_is ('help') then begin
+ usage_help (ODVITYPE_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit
+ (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth');
+
+ end else if argument_is ('output-level') then begin
+ out_mode := atou (optarg);
+ if (out_mode = 0) or (out_mode > 4) then begin
+ write_ln (stderr, 'Value for --output-level must be >= 1 and <= 4.');
+ uexit (1);
+ end;
+
+ end else if argument_is ('page-start') then begin
+ @<Determine the desired |start_count| values from |optarg|@>;
+
+ end else if argument_is ('max-pages') then begin
+ max_pages := atou (optarg);
+
+ end else if argument_is ('dpi') then begin
+ resolution := atof (optarg);
+
+ end else if argument_is ('magnification') then begin
+ new_mag := atou (optarg);
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 1 <> argc) then begin
+ write_ln (stderr, 'odvitype: Need exactly one file argument.');
+ usage ('odvitype');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ How verbose to be.
+@.-output-level@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'output-level';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+out_mode := the_works; {default}
+
+@ What page to start at.
+@.-page-start@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'page-start';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Parsing the starting page specification is a bit complicated.
+
+@<Determine the desired |start_count|...@> =
+k := 0; {which \.{\\count} register we're on}
+m := 0; {position in |optarg|}
+while optarg[m] do begin
+ if optarg[m] = "*" then begin
+ start_there[k] := false;
+ incr (m);
+
+ end else if optarg[m] = "." then begin
+ incr (k);
+ if k >= 10 then begin
+ write_ln (stderr, 'odvitype: More than ten count registers specified.');
+ uexit (1);
+ end;
+ incr (m);
+
+ end else begin
+ start_count[k] := strtol (optarg + m, address_of (end_num), 10);
+ if end_num = optarg + m then begin
+ write_ln (stderr, 'odvitype: -page-start values must be numeric or *.');
+ uexit (1);
+ end;
+ start_there[k] := true;
+ m := m + end_num - (optarg + m);
+ end;
+end;
+start_vals := k;
+
+@ How many pages to do.
+@.-max-pages@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'max-pages';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+max_pages := 1000000; {default}
+
+@ Resolution, in pixels per inch.
+@.-dpi@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'dpi';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+resolution := 300.0; {default}
+
+@ Magnification to apply.
+@.-magnification@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'magnification';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+new_mag := 0; {default is to keep the old one}
+
+@ Whether to show numeric opcodes.
+@.-show-opcodes@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'show-opcodes';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (show_opcodes);
+long_options[current_option].val := 1;
+incr (current_option);
+new_mag := 0; {default is to keep the old one}
+
+@ @<Glob...@> =
+@!show_opcodes: c_int_type;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/omegaware/odvitype.web b/Build/source/texk/web2c/omegaware/odvitype.web
new file mode 100644
index 00000000000..ef5136bb3f2
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/odvitype.web
@@ -0,0 +1,2594 @@
+% odvitype.web: Omega version of file dvitype.web
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original dvitype.web.
+%
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was completed in September, 1982.
+% Slight changes were made in October, 1982, for version 0.7 of TeX.
+% Version 1.1 corrected minor bugs (May, 1983).
+% Version 2 was released with version 0.999 of TeX (July, 1983).
+% Version 2.1 corrected a bug when no fonts are present (September, 1983).
+% Version 2.2 corrected bugs in max_*_so_far and put1 (October, 1983).
+% Version 2.3 corrected spacing of accents (March, 1984).
+% Version 2.4 fixed rounding, changed oriental font conventions (April, 1984).
+% Version 2.5 improved the case of zero pages (May, 1984).
+% Version 2.6 introduced max_drift (June, 1984).
+% Version 2.7 had minor editorial changes (August, 1984).
+% Version 2.8 made default resolution 300/1 (April, 1985).
+% Version 2.9 changed negative scaling as in TeX version 2.7 (November, 1987).
+% Version 3 introduced an intermediate level of verbosity (October,1989).
+% Version 3.1 gave magnification info in final font list (November, 1989).
+% Version 3.2 doublechecked design size of each font (January, 1990).
+% Version 3.3 had more robust for loops in print_font, define_font (May, 1990).
+% Version 3.4 more robustness in presence of bad fonts (September, 1990).
+% Version 3.5 checked skipped material more strictly (March, 1995).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{ODVI$\,$\lowercase{type}}
+\def\contentspagenumber{401}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont ODVItype} processor}
+ \vskip 15pt
+ \centerline{(Version 1.5, March 1997)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{DVItype} utility program reads binary device-independent (``\.{DVI}'')
+files that are produced by document compilers such as \TeX, and converts them
+into symbolic form. This program has two chief purposes: (1)~It can be used to
+determine whether a \.{DVI} file is valid or invalid, when diagnosing
+compiler errors; and (2)~it serves as an example of a program that reads
+\.{DVI} files correctly, for system programmers who are developing
+\.{DVI}-related software.
+
+Goal number (2) needs perhaps a bit more explanation. Programs for
+typesetting need to be especially careful about how they do arithmetic; if
+rounding errors accumulate, margins won't be straight, vertical rules
+won't line up, and so on. But if rounding is done everywhere, even in the
+midst of words, there will be uneven spacing between the letters, and that
+looks bad. Human eyes notice differences of a thousandth of an inch in the
+positioning of lines that are close together; on low resolution devices,
+where rounding produces effects four times as great as this, the problem
+is especially critical. Experience has shown that unusual care is needed
+even on high-resolution equipment; for example, a mistake in the sixth
+significant hexadecimal place of a constant once led to a difficult-to-find
+bug in some software for the Alphatype CRS, which has a resolution of 5333
+pixels per inch (make that 5333.33333333 pixels per inch). The document
+compilers that generate \.{DVI} files make certain assumptions about the
+arithmetic that will be used by \.{DVI}-reading software, and if these
+assumptions are violated the results will be of inferior quality.
+Therefore the present program is intended as a guide to proper procedure
+in the critical places where a bit of subtlety is involved.
+
+The first \.{DVItype} program was designed by David Fuchs in 1979, and it
+@^Fuchs, David Raymond@>
+went through several versions on different computers as the format of
+\.{DVI} files was evolving to its present form. Peter Breitenlohner
+helped with the latest revisions.
+@^Breitenlohner, Peter@>
+
+The |banner| string defined here should be changed whenever \.{DVItype}
+gets modified.
+
+@d banner=='This is ODVItype, Version 1.5' {printed when the program starts}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{DVItype} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+All places where nonstandard constructions are used have been listed in
+the index under ``system dependencies.''
+@!@^system dependencies@>
+
+One of the extensions to standard \PASCAL\ that we shall deal with is the
+ability to move to a random place in a binary file; another is to
+determine the length of a binary file. Such extensions are not necessary
+for reading \.{DVI} files, and they are not important for efficiency
+reasons either---an infrequently used program like \.{DVItype} does not
+have to be efficient. But they are included there because of \.{DVItype}'s
+r\^^Dole as a model of a \.{DVI} reading routine, since other \.{DVI}
+processors ought to be highly efficient. If \.{DVItype} is being used with
+\PASCAL s for which random file positioning is not efficiently available,
+the following definition should be changed from |true| to |false|; in such
+cases, \.{DVItype} will not include the optional feature that reads the
+postamble first.
+
+Another extension is to use a default |case| as in \.{TANGLE}, \.{WEAVE},
+etc.
+
+@d random_reading==true {should we skip around in the file?}
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The binary input comes from |dvi_file|, and the symbolic output is written
+on \PASCAL's standard |output| file. The term |print| is used instead of
+|write| when this program writes on |output|, so that all such output
+could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program DVI_type(@!dvi_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'. Another label, |done|, is used when stopping normally.
+
+@d final_end=9999 {label for the end of it all}
+@d done=30 {go here when finished with a subtask}
+
+@<Labels...@>=final_end,done;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{DVItype}'s capacity.
+
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
+@!max_widths=100000; {maximum number of different characters among all fonts}
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!name_size=1000; {total length of all font file names}
+@!name_length=50; {a file name shouldn't be longer than this}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ If the \.{DVI} file is badly malformed, the whole process must be aborted;
+\.{DVItype} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{DVItype}.
+@^system dependencies@>
+
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{DVItype} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used, and because \.{DVI} files use ASCII code for file names
+and certain other strings.
+
+The next few sections of \.{DVItype} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{DVItype} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+If such codes appear in the \.{DVI} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{DVItype}.
+So we shall assume that the \PASCAL\ system being used for \.{DVItype}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{DVItype} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Device-independent file format.
+Before we get into the details of \.{DVItype}, we need to know exactly
+what \.{DVI} files are. The form of such files was designed by David R.
+@^Fuchs, David Raymond@>
+Fuchs in 1979. Almost any reasonable typesetting device can be driven by
+a program that takes \.{DVI} files as input, and dozens of such
+\.{DVI}-to-whatever programs have been written. Thus, it is possible to
+print the output of document compilers like \TeX\ on many different kinds
+of equipment.
+
+A \.{DVI} file is a stream of 8-bit bytes, which may be regarded as a
+series of commands in a machine-like language. The first byte of each command
+is the operation code, and this code is followed by zero or more bytes
+that provide parameters to the command. The parameters themselves may consist
+of several consecutive bytes; for example, the `|set_rule|' command has two
+parameters, each of which is four bytes long. Parameters are usually
+regarded as nonnegative integers; but four-byte-long parameters,
+and shorter parameters that denote distances, can be
+either positive or negative. Such parameters are given in two's complement
+notation. For example, a two-byte-long distance parameter has a value between
+$-2^{15}$ and $2^{15}-1$.
+@.DVI {\rm files}@>
+
+A \.{DVI} file consists of a ``preamble,'' followed by a sequence of one
+or more ``pages,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that define the dimensions used in the
+file; this must come first. Each ``page'' consists of a |bop| command,
+followed by any number of other commands that tell where characters are to
+be placed on a physical page, followed by an |eop| command. The pages
+appear in the order that they were generated, not in any particular
+numerical order. If we ignore |nop| commands and \\{fnt\_def} commands
+(which are allowed between any two commands in the file), each |eop|
+command is immediately followed by a |bop| command, or by a |post|
+command; in the latter case, there are no more pages in the file, and the
+remaining bytes form the postamble. Further details about the postamble
+will be explained later.
+
+Some parameters in \.{DVI} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first byte is number~0, then comes number~1, and so on. For example,
+one of the parameters of a |bop| command points to the previous |bop|;
+this makes it feasible to read the pages in backwards order, in case the
+results are being directed to a device that stacks its output face up.
+Suppose the preamble of a \.{DVI} file occupies bytes 0 to 99. Now if the
+first page occupies bytes 100 to 999, say, and if the second
+page occupies bytes 1000 to 1999, then the |bop| that starts in byte 1000
+points to 100 and the |bop| that starts in byte 2000 points to 1000. (The
+very first |bop|, i.e., the one that starts in byte 100, has a pointer of $-1$.)
+
+@ The \.{DVI} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+implicit instead of explicit. When a \.{DVI}-reading program reads the
+commands for a page, it keeps track of several quantities: (a)~The current
+font |f| is an integer; this value is changed only
+by \\{fnt} and \\{fnt\_num} commands. (b)~The current position on the page
+is given by two numbers called the horizontal and vertical coordinates,
+|h| and |v|. Both coordinates are zero at the upper left corner of the page;
+moving to the right corresponds to increasing the horizontal coordinate, and
+moving down corresponds to increasing the vertical coordinate. Thus, the
+coordinates are essentially Cartesian, except that vertical directions are
+flipped; the Cartesian version of |(h,v)| would be |(h,-v)|. (c)~The
+current spacing amounts are given by four numbers |w|, |x|, |y|, and |z|,
+where |w| and~|x| are used for horizontal spacing and where |y| and~|z|
+are used for vertical spacing. (d)~There is a stack containing
+|(h,v,w,x,y,z)| values; the \.{DVI} commands |push| and |pop| are used to
+change the current level of operation. Note that the current font~|f| is
+not pushed and popped; the stack contains only information about
+positioning.
+
+The values of |h|, |v|, |w|, |x|, |y|, and |z| are signed integers having up
+to 32 bits, including the sign. Since they represent physical distances,
+there is a small unit of measurement such that increasing |h| by~1 means
+moving a certain tiny distance to the right. The actual unit of
+measurement is variable, as explained below.
+
+@ Here is a list of all the commands that may appear in a \.{DVI} file. Each
+command is specified by its symbolic name (e.g., |bop|), its opcode byte
+(e.g., 139), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|p[4]|' means that parameter |p| is four bytes long.
+
+\yskip\hang|set_char_0| 0. Typeset character number~0 from font~|f|
+such that the reference point of the character is at |(h,v)|. Then
+increase |h| by the width of that character. Note that a character may
+have zero or negative width, so one cannot be sure that |h| will advance
+after this command; but |h| usually does increase.
+
+\yskip\hang|set_char_1| through |set_char_127| (opcodes 1 to 127).
+Do the operations of |set_char_0|; but use the character whose number
+matches the opcode, instead of character~0.
+
+\yskip\hang|set1| 128 |c[1]|. Same as |set_char_0|, except that character
+number~|c| is typeset. \TeX82 uses this command for characters in the
+range |128<=c<256|.
+
+\yskip\hang|set2| 129 |c[2]|. Same as |set1|, except that |c|~is two
+bytes long, so it is in the range |0<=c<65536|. \TeX82 never uses this
+command, which is intended for processors that deal with oriental languages;
+but \.{DVItype} will allow character codes greater than 255, assuming that
+they all have the same width as the character whose code is $c \bmod 256$.
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+\yskip\hang|set3| 130 |c[3]|. Same as |set1|, except that |c|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|set4| 131 |c[4]|. Same as |set1|, except that |c|~is four
+bytes long, possibly even negative. Imagine that.
+
+\yskip\hang|set_rule| 132 |a[4]| |b[4]|. Typeset a solid black rectangle
+of height |a| and width |b|, with its bottom left corner at |(h,v)|. Then
+set |h:=h+b|. If either |a<=0| or |b<=0|, nothing should be typeset. Note
+that if |b<0|, the value of |h| will decrease even though nothing else happens.
+Programs that typeset from \.{DVI} files should be careful to make the rules
+line up carefully with digitized characters, as explained in connection with
+the |rule_pixels| subroutine below.
+
+\yskip\hang|put1| 133 |c[1]|. Typeset character number~|c| from font~|f|
+such that the reference point of the character is at |(h,v)|. (The `put'
+commands are exactly like the `set' commands, except that they simply put out a
+character or a rule without moving the reference point afterwards.)
+
+\yskip\hang|put2| 134 |c[2]|. Same as |set2|, except that |h| is not changed.
+
+\yskip\hang|put3| 135 |c[3]|. Same as |set3|, except that |h| is not changed.
+
+\yskip\hang|put4| 136 |c[4]|. Same as |set4|, except that |h| is not changed.
+
+\yskip\hang|put_rule| 137 |a[4]| |b[4]|. Same as |set_rule|, except that
+|h| is not changed.
+
+\yskip\hang|nop| 138. No operation, do nothing. Any number of |nop|'s
+may occur between \.{DVI} commands, but a |nop| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|bop| 139 $c_0[4]$ $c_1[4]$ $\ldots$ $c_9[4]$ $p[4]$. Beginning
+of a page: Set |(h,v,w,x,y,z):=(0,0,0,0,0,0)| and set the stack empty. Set
+the current font |f| to an undefined value. The ten $c_i$ parameters can
+be used to identify pages, if a user wants to print only part of a \.{DVI}
+file; \TeX82 gives them the values of \.{\\count0} $\ldots$ \.{\\count9}
+at the time \.{\\shipout} was invoked for this page. The parameter |p|
+points to the previous |bop| command in the file, where the first |bop|
+has $p=-1$.
+
+\yskip\hang|eop| 140. End of page: Print what you have read since the
+previous |bop|. At this point the stack should be empty. (The \.{DVI}-reading
+programs that drive most output devices will have kept a buffer of the
+material that appears on the page that has just ended. This material is
+largely, but not entirely, in order by |v| coordinate and (for fixed |v|) by
+|h|~coordinate; so it usually needs to be sorted into some order that is
+appropriate for the device in question. \.{DVItype} does not do such sorting.)
+
+\yskip\hang|push| 141. Push the current values of |(h,v,w,x,y,z)| onto the
+top of the stack; do not change any of these values. Note that |f| is
+not pushed.
+
+\yskip\hang|pop| 142. Pop the top six values off of the stack and assign
+them to |(h,v,w,x,y,z)|. The number of pops should never exceed the number
+of pushes, since it would be highly embarrassing if the stack were empty
+at the time of a |pop| command.
+
+\yskip\hang|right1| 143 |b[1]|. Set |h:=h+b|, i.e., move right |b| units.
+The parameter is a signed number in two's complement notation, |-128<=b<128|;
+if |b<0|, the reference point actually moves left.
+
+\yskip\hang|right2| 144 |b[2]|. Same as |right1|, except that |b| is a
+two-byte quantity in the range |-32768<=b<32768|.
+
+\yskip\hang|right3| 145 |b[3]|. Same as |right1|, except that |b| is a
+three-byte quantity in the range |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|right4| 146 |b[4]|. Same as |right1|, except that |b| is a
+four-byte quantity in the range |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|w0| 147. Set |h:=h+w|; i.e., move right |w| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|w| gets particular values.
+
+\yskip\hang|w1| 148 |b[1]|. Set |w:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |w|~spacing and moves right by |b|.
+
+\yskip\hang|w2| 149 |b[2]|. Same as |w1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|w3| 150 |b[3]|. Same as |w1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|w4| 151 |b[4]|. Same as |w1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|x0| 152. Set |h:=h+x|; i.e., move right |x| units. The `|x|'
+commands are like the `|w|' commands except that they involve |x| instead
+of |w|.
+
+\yskip\hang|x1| 153 |b[1]|. Set |x:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |x|~spacing and moves right by |b|.
+
+\yskip\hang|x2| 154 |b[2]|. Same as |x1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|x3| 155 |b[3]|. Same as |x1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|x4| 156 |b[4]|. Same as |x1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|down1| 157 |a[1]|. Set |v:=v+a|, i.e., move down |a| units.
+The parameter is a signed number in two's complement notation, |-128<=a<128|;
+if |a<0|, the reference point actually moves up.
+
+\yskip\hang|down2| 158 |a[2]|. Same as |down1|, except that |a| is a
+two-byte quantity in the range |-32768<=a<32768|.
+
+\yskip\hang|down3| 159 |a[3]|. Same as |down1|, except that |a| is a
+three-byte quantity in the range |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|down4| 160 |a[4]|. Same as |down1|, except that |a| is a
+four-byte quantity in the range |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|y0| 161. Set |v:=v+y|; i.e., move down |y| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|y| gets particular values.
+
+\yskip\hang|y1| 162 |a[1]|. Set |y:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |y|~spacing and moves down by |a|.
+
+\yskip\hang|y2| 163 |a[2]|. Same as |y1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|y3| 164 |a[3]|. Same as |y1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|y4| 165 |a[4]|. Same as |y1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|z0| 166. Set |v:=v+z|; i.e., move down |z| units. The `|z|' commands
+are like the `|y|' commands except that they involve |z| instead of |y|.
+
+\yskip\hang|z1| 167 |a[1]|. Set |z:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |z|~spacing and moves down by |a|.
+
+\yskip\hang|z2| 168 |a[2]|. Same as |z1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|z3| 169 |a[3]|. Same as |z1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|z4| 170 |a[4]|. Same as |z1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|fnt_num_0| 171. Set |f:=0|. Font 0 must previously have been
+defined by a \\{fnt\_def} instruction, as explained below.
+
+\yskip\hang|fnt_num_1| through |fnt_num_63| (opcodes 172 to 234). Set
+|f:=1|, \dots, |f:=63|, respectively.
+
+\yskip\hang|fnt1| 235 |k[1]|. Set |f:=k|. \TeX82 uses this command for font
+numbers in the range |64<=k<256|.
+
+\yskip\hang|fnt2| 236 |k[2]|. Same as |fnt1|, except that |k|~is two
+bytes long, so it is in the range |0<=k<65536|. \TeX82 never generates this
+command, but large font numbers may prove useful for specifications of
+color or texture, or they may be used for special fonts that have fixed
+numbers in some external coding scheme.
+
+\yskip\hang|fnt3| 237 |k[3]|. Same as |fnt1|, except that |k|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|fnt4| 238 |k[4]|. Same as |fnt1|, except that |k|~is four
+bytes long; this is for the really big font numbers (and for the negative ones).
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |nop| unless special \.{DVI}-reading
+programs are being used. \TeX82 generates |xxx1| when a short enough
+\.{\\special} appears, setting |k| to the number of bytes being sent. It
+is recommended that |x| be a string having the form of a keyword followed
+by possible parameters relevant to that keyword.
+
+\yskip\hang|xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be ridiculously
+large. \TeX82 uses |xxx4| when |xxx1| would be incorrect.
+
+\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<256|; font definitions will be explained shortly.
+
+\yskip\hang|fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<65536|.
+
+\yskip\hang|fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
+
+\yskip\hang|pre| 247 |i[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameters |i|, |num|, |den|, |mag|, |k|, and |x| are explained below.
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@ @d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The preamble contains basic information about the file as a whole. As
+stated above, there are six parameters:
+$$\hbox{|@!i[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
+The |i| byte identifies \.{DVI} format; currently this byte is always set
+to~2. (The value |i=3| is currently used for an extended format that
+allows a mixture of right-to-left and left-to-right typesetting.
+Some day we will set |i=4|, when \.{DVI} format makes another
+incompatible change---perhaps in the year 2048.)
+
+The next two parameters, |num| and |den|, are positive integers that define
+the units of measurement; they are the numerator and denominator of a
+fraction by which all dimensions in the \.{DVI} file could be multiplied
+in order to get lengths in units of $10^{-7}$ meters. (For example, there are
+exactly 7227 \TeX\ points in 254 centimeters, and \TeX82 works with scaled
+points where there are $2^{16}$ sp in a point, so \TeX82 sets |num=25400000|
+and $|den|=7227\cdot2^{16}=473628672$.)
+@^sp@>
+
+The |mag| parameter is what \TeX82 calls \.{\\mag}, i.e., 1000 times the
+desired magnification. The actual fraction by which dimensions are
+multiplied is therefore $mn/1000d$. Note that if a \TeX\ source document
+does not call for any `\.{true}' dimensions, and if you change it only by
+specifying a different \.{\\mag} setting, the \.{DVI} file that \TeX\
+creates will be completely unchanged except for the value of |mag| in the
+preamble and postamble. (Fancy \.{DVI}-reading programs allow users to
+override the |mag|~setting when a \.{DVI} file is being printed.)
+
+Finally, |k| and |x| allow the \.{DVI} writer to include a comment, which is not
+interpreted further. The length of comment |x| is |k|, where |0<=k<256|.
+
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+
+@ Font definitions for a given font number |k| contain further parameters
+$$\hbox{|c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.}$$
+The four-byte value |c| is the check sum that \TeX\ (or whatever program
+generated the \.{DVI} file) found in the \.{TFM} file for this font;
+|c| should match the check sum of the font found by programs that read
+this \.{DVI} file.
+@^check sum@>
+
+Parameter |s| contains a fixed-point scale factor that is applied to the
+character widths in font |k|; font dimensions in \.{TFM} files and other
+font files are relative to this quantity, which is always positive and
+less than $2^{27}$. It is given in the same units as the other dimensions
+of the \.{DVI} file. Parameter |d| is similar to |s|; it is the ``design
+size,'' and (like~|s|) it is given in \.{DVI} units. Thus, font |k| is to be
+used at $|mag|\cdot s/1000d$ times its normal size.
+
+The remaining part of a font definition gives the external name of the font,
+which is an ASCII string of length |a+l|. The number |a| is the length
+of the ``area'' or directory, and |l| is the length of the font name itself;
+the standard local system font area is supposed to be used when |a=0|.
+The |n| field contains the area in its first |a| bytes.
+
+Font definitions must appear before the first use of a particular font number.
+Once font |k| is defined, it must not be defined again; however, we
+shall see below that font definitions appear in the postamble as well as
+in the pages, so in this sense each font number is defined exactly twice,
+if at all. Like |nop| commands, font definitions can
+appear before the first |bop|, or between an |eop| and a |bop|.
+
+@ The last page in a \.{DVI} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \TeX\ has
+accumulated about the file, making it possible to print subsets of the data
+with reasonable efficiency. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |num[4]| |den[4]| |mag[4]| |l[4]| |u[4]| |s[2]| |t[2]|\cr
+ $\langle\,$font definitions$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the final |bop| in the file. The next three
+parameters, |num|, |den|, and |mag|, are duplicates of the quantities that
+appeared in the preamble.
+
+Parameters |l| and |u| give respectively the height-plus-depth of the tallest
+page and the width of the widest page, in the same units as other dimensions
+of the file. These numbers might be used by a \.{DVI}-reading program to
+position individual ``pages'' on large sheets of film or paper; however,
+the standard convention for output on normal size paper is to position each
+page so that the upper left-hand corner is exactly one inch from the left
+and the top. Experience has shown that it is unwise to design \.{DVI}-to-printer
+software that attempts cleverly to center the output; a fixed position of
+the upper left corner is easiest for users to understand and to work with.
+Therefore |l| and~|u| are often ignored.
+
+Parameter |s| is the maximum stack depth (i.e., the largest excess of
+|push| commands over |pop| commands) needed to process this file. Then
+comes |t|, the total number of pages (|bop| commands) present.
+
+The postamble continues with font definitions, which are any number of
+\\{fnt\_def} commands as described above, possibly interspersed with |nop|
+commands. Each font number that is used in the \.{DVI} file must be defined
+exactly twice: Once before it is first selected by a \\{fnt} command, and once
+in the postamble.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the font definitions, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~2, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \TeX\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{DVI} file makes it feasible for
+\.{DVI}-reading programs to find the postamble first, on most computers,
+even though \TeX\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{DVI} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{DVI} reader discovers all the information needed for typesetting the
+pages. Note that it is also possible to skip through the \.{DVI} file at
+reasonably high speed to locate a particular page, if that proves
+desirable. This saves a lot of time, since \.{DVI} files used in production
+jobs tend to be large.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{DVI}
+format has been designed to work most efficiently with modern operating systems.
+As noted above, \.{DVItype} will limit itself to the restrictions of standard
+\PASCAL\ if |random_reading| is defined to be |false|.
+
+@* Input from binary files.
+We have seen that a \.{DVI} file is a sequence of 8-bit bytes. The bytes
+appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{DVItype} is written in standard \PASCAL.
+@^system dependencies@>
+
+One common way to solve the problem is to consider files of |integer|
+numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
+a sequence of four bytes $(a,b,c,d)$ using the following code, which
+avoids the controversial integer division of negative numbers:
+$$\vbox{\halign{#\hfil\cr
+|if x>=0 then a:=x div @'100000000|\cr
+|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
+\quad|end|\cr
+|x:=x mod @'100000000;|\cr
+|b:=x div @'200000; x:=x mod @'200000;|\cr
+|c:=x div @'400; d:=x mod @'400;|\cr}}$$
+The four bytes are then kept in a buffer and output one by one. (On 36-bit
+computers, an additional division by 16 is necessary at the beginning.
+Another way to separate an integer into four bytes is to use/abuse
+\PASCAL's variant records, storing an integer and retrieving bytes that are
+packed in the same place; {\sl caveat implementor!\/}) It is also desirable
+in some cases to read a hundred or so integers at a time, maintaining a
+larger buffer.
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with two binary file variables: |dvi_file| is the main
+input file that we are translating into symbolic form, and |tfm_file| is
+the current font metric file from which character-width information is
+being read.
+
+@<Glob...@>=
+@!dvi_file:byte_file; {the stuff we are \.{DVI}typing}
+@!tfm_file:byte_file; {a font metric file}
+
+@ To prepare these files for input, we |reset| them. An extension of
+\PASCAL\ is needed in the case of |tfm_file|, since we want to associate
+it with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_name);
+end;
+
+@ If you looked carefully at the preceding code, you probably asked,
+``What are |cur_loc| and |cur_name|?'' Good question. They're global
+variables: |cur_loc| is the number of the byte about to be read next from
+|dvi_file|, and |cur_name| is a string variable that will be set to the
+current font metric file name before |open_tfm_file| is called.
+
+@<Glob...@>=
+@!cur_loc:integer; {where we are about to look, in |dvi_file|}
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+
+@ It turns out to be convenient to read four bytes at a time, when we are
+inputting from \.{TFM} files. The input goes into global variables
+|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3|
+the fourth.
+
+@<Glob...@>=
+@!b0,@!b1,@!b2,@!b3: eight_bits; {four bytes input at once}
+
+@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
+four bytes in the current \.{TFM} file.
+@^system dependencies@>
+
+@p procedure read_tfm_word;
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+end;
+
+@ We shall use another set of simple functions to read the next byte or
+bytes from |dvi_file|. There are seven possibilities, each of which is
+treated as a separate function in order to minimize the overhead for
+subroutine calls.
+@^system dependencies@>
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(dvi_file) then get_byte:=0
+else begin read(dvi_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(dvi_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@ Finally we come to the routines that are used only if |random_reading| is
+|true|. The driver program below needs two such routines: |dvi_length| should
+compute the total number of bytes in |dvi_file|, possibly also
+causing |eof(dvi_file)| to be true; and |move_to_byte(n)|
+should position |dvi_file| so that the next |get_byte| will read byte |n|,
+starting with |n=0| for the first byte in the file.
+@^system dependencies@>
+
+Such routines are, of course, highly system dependent. They are implemented
+here in terms of two assumed system routines called |set_pos| and |cur_pos|.
+The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
+negative or larger than the total number of items in |f|; in the latter
+case, |set_pos(f,n)| moves to the end of file |f|.
+The call |cur_pos(f)| gives the total number of items in |f|, if
+|eof(f)| is true; we use |cur_pos| only in such a situation.
+
+@p function dvi_length:integer;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin set_pos(dvi_file,n); cur_loc:=n;
+end;
+
+@* Reading the font information.
+\.{DVI} file format does not include information about character widths, since
+that would tend to make the files a lot longer. But a program that reads
+a \.{DVI} file is supposed to know the widths of the characters that appear
+in \\{set\_char} commands. Therefore \.{DVItype} looks at the font metric
+(\.{TFM}) files for the fonts that are involved.
+@.TFM {\rm files}@>
+
+The character-width data appears also in other files (e.g., in \.{GF} files
+that specify bit patterns for digitized characters);
+thus, it is usually possible for \.{DVI} reading programs to get by with
+accessing only one file per font. \.{DVItype} has a comparatively easy
+task in this regard, since it needs only a few words of information from
+each font; other \.{DVI}-to-printer programs may have to go to some pains to
+deal with complications that arise when a large number of large font files
+all need to be accessed simultaneously.
+
+@ For purposes of this program, we need to know only two things about a
+given character |c| in a given font |f|: (1)~Is |c| a legal character
+in~|f|? (2)~If so, what is the width of |c|? We also need to know the
+symbolic name of each font, so it can be printed out, and we need to know
+the approximate size of inter-word spaces in each font.
+
+The answers to these questions appear implicitly in the following data
+structures. The current number of known fonts is |nf|. Each known font has
+an internal number |f|, where |0<=f<nf|; the external number of this font,
+i.e., its font identification number in the \.{DVI} file, is
+|font_num[f]|, and the external name of this font is the string that
+occupies positions |font_name[f]| through |font_name[f+1]-1| of the array
+|names|. The latter array consists of |ASCII_code| characters, and
+|font_name[nf]| is its first unoccupied position. A horizontal motion
+in the range |-4*font_space[f]<h<font_space[f]|
+will be treated as a `kern' that is not
+indicated in the printouts that \.{DVItype} produces between brackets. The
+legal characters run from |font_bc[f]| to |font_ec[f]|, inclusive; more
+precisely, a given character |c| is valid in font |f| if and only if
+|font_bc[f]<=c<=font_ec[f]| and |char_width(f)(c)<>invalid_width|.
+Finally, |char_width(f)(c)=width[width_base[f]+c]|, and |width_ptr| is the
+first unused position of the |width| array.
+
+@d char_width_end(#)==#]
+@d char_width(#)==width[width_base[#]+char_width_end
+@d invalid_width==@'17777777777
+@d invalid_font==max_fonts
+
+@<Glob...@>=
+@!font_num:array [0..max_fonts] of integer; {external font numbers}
+@!font_name:array [0..max_fonts] of 1..name_size; {starting positions
+ of external font names}
+@!names:array [1..name_size] of ASCII_code; {characters of names}
+@!font_check_sum:array [0..max_fonts] of integer; {check sums}
+@!font_scaled_size:array [0..max_fonts] of integer; {scale factors}
+@!font_design_size:array [0..max_fonts] of integer; {design sizes}
+@!font_space:array [0..max_fonts] of integer; {boundary between ``small''
+ and ``large'' spaces}
+@!font_bc:array [0..max_fonts] of integer; {beginning characters in fonts}
+@!font_ec:array [0..max_fonts] of integer; {ending characters in fonts}
+@!width_base:array [0..max_fonts] of integer; {index into |width| table}
+@!width:array [0..max_widths] of integer; {character widths, in \.{DVI} units}
+@!nf:0..max_fonts; {the number of known fonts}
+@!width_ptr:0..max_widths; {the number of known character widths}
+
+@ @<Set init...@>=
+nf:=0; width_ptr:=0; font_name[0]:=1;@/
+font_space[invalid_font]:=0; {for |out_space| and |out_vmove|}
+font_bc[invalid_font]:=1; font_ec[invalid_font]:=0;
+
+@ It is, of course, a simple matter to print the name of a given font.
+
+@p procedure print_font(@!f:integer); {|f| is an internal font number}
+var k:0..name_size; {index into |names|}
+begin if f=invalid_font then print('UNDEFINED!')
+@.UNDEFINED@>
+else begin for k:=font_name[f] to font_name[f+1]-1 do
+ print(xchr[names[k]]);
+ end;
+end;
+
+@ An auxiliary array |in_width| is used to hold the widths as they are
+input. The global variables |tfm_check_sum| and |tfm_design_size| are
+set to the check sum and design size that
+appear in the current \.{TFM} file.
+
+@<Glob...@>=
+@!in_width:array[0..65535] of integer; {\.{TFM} width data in \.{DVI} units}
+@!tfm_check_sum:integer; {check sum found in |tfm_file|}
+@!tfm_design_size:integer; {design size found in |tfm_file|, in \.{DVI} units}
+@!tfm_conv:real; {\.{DVI} units per absolute \.{TFM} unit}
+
+@ Here is a procedure that absorbs the necessary information from a
+\.{TFM} file, assuming that the file has just been successfully reset
+so that we are ready to read its first byte. (A complete description of
+\.{TFM} file format appears in the documentation of \.{TFtoPL} and will
+not be repeated here.) The procedure does not check the \.{TFM} file
+for validity, nor does it give explicit information about what is
+wrong with a \.{TFM} file that proves to be invalid; \.{DVI}-reading
+programs need not do this, since \.{TFM} files are almost always valid,
+and since the \.{TFtoPL} utility program has been specifically designed
+to diagnose \.{TFM} errors. The procedure simply returns |false| if it
+detects anything amiss in the \.{TFM} data.
+
+There is a parameter, |z|, which represents the scaling factor being
+used to compute the font dimensions; it must be in the range $0<z<2^{27}$.
+
+@p function in_TFM(@!z:integer):boolean; {input \.{TFM} data or return |false|}
+label 9997, {go here when the format is bad}
+ 9998, {go here when the information cannot be loaded}
+ 9999; {go here to exit}
+var k:integer; {index for loops}
+@!lh:integer; {length of the header data, in four-byte words}
+@!nw:integer; {number of words in the width table}
+@!wp:0..max_widths; {new value of |width_ptr| after successful input}
+@!alpha,@!beta:integer; {quantities used in the scaling computation}
+@!nco:integer; {offset to get to the characters}
+@!extra_words:integer; {no of extra words in |char_info| words}
+@!ofm_level:integer; {TFM, OFM level 0 or 1}
+@!j,kprime:integer; {extra counters}
+begin @<Read past the header data; |goto 9997| if there is a problem@>;
+@<Store character-width indices at the end of the |width| table@>;
+@<Read and convert the width values, setting up the |in_width| table@>;
+@<Move the widths from |in_width| to |width|, and append |pixel_width| values@>;
+width_ptr:=wp; in_TFM:=true; goto 9999;
+9997: print_ln('---not loaded, font metric file is bad');
+@.TFM file is bad@>
+9998: in_TFM:=false;
+9999: end;
+
+@ @<Read past the header...@>=
+read_tfm_word;
+if (b0*256+b1)<>0 then begin {TFM file}
+ ofm_level:=-1;
+ lh:=b2*256+b3;
+ read_tfm_word; font_bc[nf]:=b0*256+b1; font_ec[nf]:=b2*256+b3;
+ if font_ec[nf]<font_bc[nf] then font_bc[nf]:=font_ec[nf]+1;
+ if width_ptr+font_ec[nf]-font_bc[nf]+1>max_widths then
+ begin print_ln('---not loaded, ODVItype needs larger width table');
+@.ODVItype needs larger...@>
+ goto 9998;
+ end;
+ wp:=width_ptr+font_ec[nf]-font_bc[nf]+1;
+ read_tfm_word; nw:=b0*256+b1;
+ if (nw=0)or(nw>256) then goto 9997;
+ for k:=1 to 3+lh do
+ begin if eof(tfm_file) then goto 9997;
+ read_tfm_word;
+ if k=4 then
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3
+ else if k=5 then
+ if b0<128 then
+ tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3))
+ else goto 9997;
+ end;
+ end
+else begin
+ ofm_level:=b2*256+b3;
+ read_tfm_word;
+ read_tfm_word; lh:=((b0*256+b1)*256+b2)*256+b3;
+ read_tfm_word; font_bc[nf]:=((b0*256+b1)*256+b2)*256+b3;
+ read_tfm_word; font_ec[nf]:=((b0*256+b1)*256+b2)*256+b3;
+ if font_ec[nf]<font_bc[nf] then font_bc[nf]:=font_ec[nf]+1;
+ if width_ptr+font_ec[nf]-font_bc[nf]+1>max_widths then
+ begin print_ln('---not loaded, ODVItype needs larger width table');
+@.ODVItype needs larger...@>
+ goto 9998;
+ end;
+ wp:=width_ptr+font_ec[nf]-font_bc[nf]+1;
+ read_tfm_word; nw:=((b0*256+b1)*256+b2)*256+b3;
+ if (nw=0)or(nw>65536) then goto 9997;
+ for k:=1 to 8 do
+ begin if eof(tfm_file) then goto 9997;
+ read_tfm_word;
+ end;
+ if ofm_level=1 then begin
+ read_tfm_word; nco:=(((b0*256+b1)*256+b2)*256+b3) div 2;
+ read_tfm_word;
+ read_tfm_word; extra_words:=(((b0*256+b1)*256+b2)*256+b3) div 2;
+ for k:=1 to 12 do
+ begin if eof(tfm_file) then goto 9997;
+ read_tfm_word;
+ end;
+ end;
+ for k:=1 to lh do
+ begin if eof(tfm_file) then goto 9997;
+ read_tfm_word;
+ if k=1 then
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3
+ else if k=2 then
+ if b0<128 then
+ tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3))
+ else goto 9997;
+ end;
+ if ofm_level=1 then
+ for k:=1 to (nco-29-lh) do
+ read_tfm_word;
+ end
+
+@ @<Store character-width indices...@>=
+case ofm_level of
+ -1:begin
+ if wp>0 then for k:=width_ptr to wp-1 do
+ begin read_tfm_word;
+ if b0>nw then goto 9997;
+ width[k]:=b0;
+ end;
+ end;
+ 0:begin
+ if wp>0 then for k:=width_ptr to wp-1 do
+ begin read_tfm_word;
+ if (b0*256+b1)>nw then goto 9997;
+ width[k]:=(b0*256+b1);
+ read_tfm_word;
+ end;
+ end;
+ 1:begin
+ if wp>0 then begin
+ k:=width_ptr;
+ while k<wp do begin
+ read_tfm_word;
+ if (b0*256+b1)>nw then goto 9997;
+ width[k]:=(b0*256+b1);
+ read_tfm_word; read_tfm_word;
+ kprime:=k+(b0*256+b1);
+ for j:=k+1 to kprime do
+ width[j]:=width[k];
+ k:=kprime;
+ for j:=1 to extra_words do
+ read_tfm_word;
+ end
+ end
+ end;
+end;
+
+
+@ The most important part of |in_TFM| is the width computation, which
+involves multiplying the relative widths in the \.{TFM} file by the
+scaling factor in the \.{DVI} file. This fixed-point multiplication
+must be done with precisely the same accuracy by all \.{DVI}-reading programs,
+in order to validate the assumptions made by \.{DVI}-writing programs
+like \TeX82.
+
+Let us therefore summarize what needs to be done. Each width in a \.{TFM}
+file appears as a four-byte quantity called a |fix_word|. A |fix_word|
+whose respective bytes are $(a,b,c,d)$ represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+(No other choices of $a$ are allowed, since the magnitude of a \.{TFM}
+dimension must be less than 16.) We want to multiply this quantity by the
+integer~|z|, which is known to be less than $2^{27}$.
+If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$,
+$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or
+16, to obtain a multiplier less than $2^{23}$, and we can compensate for
+this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let
+$\beta=2^{4-e}$; we shall compute
+$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$,
+or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
+This calculation must be
+done exactly, for the reasons stated above; the following program does the
+job in a system-independent way, assuming that arithmetic is exact on
+numbers less than $2^{31}$ in magnitude.
+
+@<Read and convert the width values...@>=
+@<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>;
+for k:=0 to nw-1 do
+ begin read_tfm_word;
+ in_width[k]:=(((((b3*z)div@'400)+(b2*z))div@'400)+(b1*z))div beta;
+ if b0>0 then if b0<255 then goto 9997
+ else in_width[k]:=in_width[k]-alpha;
+ end
+
+@ @<Replace |z|...@>=
+begin alpha:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; alpha:=alpha+alpha;
+ end;
+beta:=256 div alpha; alpha:=alpha*z;
+end
+
+@ A \.{DVI}-reading program usually works with font files instead of
+\.{TFM} files, so \.{DVItype} is atypical in that respect. Font files
+should, however, contain exactly the same character width data that is
+found in the corresponding \.{TFM}s; check sums are used to help
+ensure this. In addition, font files usually also contain the widths of
+characters in pixels, since the device-independent character widths of
+\.{TFM} files are generally not perfect multiples of pixels.
+
+The |pixel_width| array contains this information; when |width[k]| is the
+device-independent width of some character in \.{DVI} units, |pixel_width[k]|
+is the corresponding width of that character in an actual font.
+The macro |char_pixel_width| is set up to be analogous to |char_width|.
+
+@d char_pixel_width(#)==pixel_width[width_base[#]+char_width_end
+
+@<Glob...@>=
+@!pixel_width:array[0..max_widths] of integer; {actual character widths,
+ in pixels}
+@!conv:real; {converts \.{DVI} units to pixels}
+@!true_conv:real; {converts unmagnified \.{DVI} units to pixels}
+@!numerator,@!denominator:integer; {stated conversion ratio}
+@!mag:integer; {magnification factor times 1000}
+
+@ The following code computes pixel widths by simply rounding the \.{TFM}
+widths to the nearest integer number of pixels, based on the conversion factor
+|conv| that converts \.{DVI} units to pixels. However, such a simple
+formula will not be valid for all fonts, and it will often give results that
+are off by $\pm1$ when a low-resolution font has been carefully
+hand-fitted. For example, a font designer often wants to make the letter `m'
+a pixel wider or narrower in order to make the font appear more consistent.
+\.{DVI}-to-printer programs should therefore input the correct pixel width
+information from font files whenever there is a chance that it may differ.
+A warning message may also be desirable in the case that at least one character
+is found whose pixel width differs from |conv*width| by more than a full pixel.
+@^system dependencies@>
+
+@d pixel_round(#)==round(conv*(#))
+
+@<Move the widths from |in_width| to |width|, and append |pixel_width| values@>=
+if in_width[0]<>0 then goto 9997; {the first width should be zero}
+width_base[nf]:=width_ptr-font_bc[nf];
+if wp>0 then for k:=width_ptr to wp-1 do
+ if width[k]=0 then
+ begin width[k]:=invalid_width; pixel_width[k]:=0;
+ end
+ else begin width[k]:=in_width[width[k]];
+ pixel_width[k]:=pixel_round(width[k]);
+ end
+
+@* Optional modes of output.
+\.{DVItype} will print different quantities of information based on some
+options that the user must specify: The |out_mode| level is set to one of
+five values (|errors_only|, |terse|, |mnemonics_only|,
+|verbose|, |the_works|), giving
+different degrees of output; and the typeout can be confined to a
+restricted subset of the pages by specifying the desired starting page and
+the maximum number of pages. Furthermore there is an option to specify the
+resolution of an assumed discrete output device, so that pixel-oriented
+calculations will be shown; and there is an option to override the
+magnification factor that is stated in the \.{DVI} file.
+
+The starting page is specified by giving a sequence of 1 to 10 numbers or
+asterisks separated by dots. For example, the specification `\.{1.*.-5}'
+can be used to refer to a page output by \TeX\ when $\.{\\count0}=1$
+and $\.{\\count2}=-5$. (Recall that |bop| commands in a \.{DVI} file
+are followed by ten `count' values.) An asterisk matches any number,
+so the `\.*' in `\.{1.*.-5}' means that \.{\\count1} is ignored when
+specifying the first page. If several pages match the given specification,
+\.{DVItype} will begin with the earliest such page in the file. The
+default specification `\.*' (which matches all pages) therefore denotes
+the page at the beginning of the file.
+
+When \.{DVItype} begins, it engages the user in a brief dialog so that the
+options will be specified. This part of \.{DVItype} requires nonstandard
+\PASCAL\ constructions to handle the online interaction; so it may be
+preferable in some cases to omit the dialog and simply to stick to the
+default options (|out_mode=the_works|, starting page `\.*',
+|max_pages=1000000|, |resolution=300.0|, |new_mag=0|). On other hand, the
+system-dependent routines that are needed are not complicated, so it will
+not be terribly difficult to introduce them.
+@^system dependencies@>
+
+@d errors_only=0 {value of |out_mode| when minimal printing occurs}
+@d terse=1 {value of |out_mode| for abbreviated output}
+@d mnemonics_only=2 {value of |out_mode| for medium-quantity output}
+@d verbose=3 {value of |out_mode| for detailed tracing}
+@d the_works=4 {|verbose|, plus check of postamble if |random_reading|}
+
+@<Glob...@>=
+@!out_mode:errors_only..the_works; {controls the amount of output}
+@!max_pages:integer; {at most this many |bop..eop| pages will be printed}
+@!resolution:real; {pixels per inch}
+@!new_mag:integer; {if positive, overrides the postamble's magnification}
+
+@ The starting page specification is recorded in two global arrays called
+|start_count| and |start_there|. For example, `\.{1.*.-5}' is represented
+by |start_there[0]=true|, |start_count[0]=1|, |start_there[1]=false|,
+|start_there[2]=true|, |start_count[2]=-5|.
+We also set |start_vals=2|, to indicate that count 2 was the last one
+mentioned. The other values of |start_count| and |start_there| are not
+important, in this example.
+
+@<Glob...@>=
+@!start_count:array[0..9] of integer; {count values to select starting page}
+@!start_there:array[0..9] of boolean; {is the |start_count| value relevant?}
+@!start_vals:0..9; {the last count considered significant}
+@!count:array[0..9] of integer; {the count values on the current page}
+
+@ @<Set init...@>=
+out_mode:=the_works; max_pages:=1000000; start_vals:=0; start_there[0]:=false;
+
+@ Here is a simple subroutine that tests if the current page might be the
+starting page.
+
+@p function start_match:boolean; {does |count| match the starting spec?}
+var k:0..9; {loop index}
+@!match:boolean; {does everything match so far?}
+begin match:=true;
+for k:=0 to start_vals do
+ if start_there[k]and(start_count[k]<>count[k]) then match:=false;
+start_match:=match;
+end;
+
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+
+@ Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall invoke a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ During the dialog, \.{DVItype} will treat the first blank space in a
+line as the end of that line. Therefore |input_ln| makes sure that there
+is always at least one blank space in |buffer|.
+@^system dependencies@>
+
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+
+@ The global variable |buf_ptr| is used while scanning each line of input;
+it points to the first unread character in |buffer|.
+
+@<Glob...@>=
+@!buf_ptr:0..terminal_line_length; {the number of characters read}
+
+@ Here is a routine that scans a (possibly signed) integer and computes
+the decimal value. If no decimal integer starts at |buf_ptr|, the
+value 0 is returned. The integer should be less than $2^{31}$ in
+absolute value.
+
+@p function get_integer:integer;
+var x:integer; {accumulates the value}
+@!negative:boolean; {should the value be negated?}
+begin if buffer[buf_ptr]="-" then
+ begin negative:=true; incr(buf_ptr);
+ end
+else negative:=false;
+x:=0;
+while (buffer[buf_ptr]>="0")and(buffer[buf_ptr]<="9") do
+ begin x:=10*x+buffer[buf_ptr]-"0"; incr(buf_ptr);
+ end;
+if negative then get_integer:=-x @+ else get_integer:=x;
+end;
+
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{DVItype} begins.
+@^system dependencies@>
+
+@p procedure dialog;
+label 1,2,3,4,5;
+var k:integer; {loop variable}
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);
+@<Determine the desired |out_mode|@>;
+@<Determine the desired |start_count| values@>;
+@<Determine the desired |max_pages|@>;
+@<Determine the desired |resolution|@>;
+@<Determine the desired |new_mag|@>;
+@<Print all the selected options@>;
+end;
+
+@ @<Determine the desired |out_mode|@>=
+1: write(term_out,'Output level (default=4, ? for help): ');
+out_mode:=the_works; input_ln;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="4") then out_mode:=buffer[0]-"0"
+ else begin write(term_out,'Type 4 for complete listing,');
+ write(term_out,' 0 for errors only,');
+ write_ln(term_out,' 1 or 2 or 3 for something in between.');
+ goto 1;
+ end
+
+@ @<Determine the desired |start...@>=
+2: write(term_out,'Starting page (default=*): ');
+start_vals:=0; start_there[0]:=false;
+input_ln; buf_ptr:=0; k:=0;
+if buffer[0]<>" " then
+ repeat if buffer[buf_ptr]="*" then
+ begin start_there[k]:=false; incr(buf_ptr);
+ end
+ else begin start_there[k]:=true; start_count[k]:=get_integer;
+ end;
+ if (k<9)and(buffer[buf_ptr]=".") then
+ begin incr(k); incr(buf_ptr);
+ end
+ else if buffer[buf_ptr]=" " then start_vals:=k
+ else begin write(term_out,'Type, e.g., 1.*.-5 to specify the ');
+ write_ln(term_out,'first page with \count0=1, \count2=-5.');
+ goto 2;
+ end;
+ until start_vals=k
+
+@ @<Determine the desired |max_pages|@>=
+3: write(term_out,'Maximum number of pages (default=1000000): ');
+max_pages:=1000000; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin max_pages:=get_integer;
+ if max_pages<=0 then
+ begin write_ln(term_out,'Please type a positive number.');
+ goto 3;
+ end;
+ end
+
+@ @<Determine the desired |resolution|@>=
+4: write(term_out,'Assumed device resolution');
+write(term_out,' in pixels per inch (default=300/1): ');
+resolution:=300.0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin k:=get_integer;
+ if (k>0)and(buffer[buf_ptr]="/")and
+ (buffer[buf_ptr+1]>"0")and(buffer[buf_ptr+1]<="9") then
+ begin incr(buf_ptr); resolution:=k/get_integer;
+ end
+ else begin write(term_out,'Type a ratio of positive integers;');
+ write_ln(term_out,' (1 pixel per mm would be 254/10).');
+ goto 4;
+ end;
+ end
+
+@ @<Determine the desired |new_mag|@>=
+5: write(term_out,'New magnification (default=0 to keep the old one): ');
+new_mag:=0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="9") then new_mag:=get_integer
+ else begin write(term_out,'Type a positive integer to override ');
+ write_ln(term_out,'the magnification in the DVI file.');
+ goto 5;
+ end
+
+@ After the dialog is over, we print the options so that the user
+can see what \.{DVItype} thought was specified.
+
+@<Print all the selected options@>=
+print_ln('Options selected:');
+@.Options selected@>
+print(' Starting page = ');
+for k:=0 to start_vals do
+ begin if start_there[k] then print(start_count[k]:1)
+ else print('*');
+ if k<start_vals then print('.')
+ else print_ln(' ');
+ end;
+print_ln(' Maximum number of pages = ',max_pages:1);
+print(' Output level = ',out_mode:1);
+case out_mode of
+errors_only: print_ln(' (showing bops, fonts, and error messages only)');
+terse: print_ln(' (terse)');
+mnemonics_only: print_ln(' (mnemonics)');
+verbose: print_ln(' (verbose)');
+the_works: if random_reading then print_ln(' (the works)')
+ else begin out_mode:=verbose;
+ print_ln(' (the works: same as level 3 in this DVItype)');
+ end;
+end;@/
+print_ln(' Resolution = ',resolution:12:8,' pixels per inch');
+if new_mag>0 then print_ln(' New magnification factor = ',new_mag/1000:8:3)
+
+@* Defining fonts.
+When |out_mode=the_works|, \.{DVItype} reads the postamble first and loads
+all of the fonts defined there; then it processes the pages. In this
+case, a \\{fnt\_def} command should match a previous definition if and only
+if the \\{fnt\_def} being processed is not in the postamble. But if
+|out_mode<the_works|, \.{DVItype} reads the pages first and the postamble
+last, so the conventions are reversed: a \\{fnt\_def} should match a previous
+\\{fnt\_def} if and only if the current one is a part of the postamble.
+
+A global variable |in_postamble| is provided to tell whether we are
+processing the postamble or not.
+
+@<Glob...@>=
+@!in_postamble:boolean; {are we reading the postamble?}
+
+@ @<Set init...@>=
+in_postamble:=false;
+
+@ The following subroutine does the necessary things when a \\{fnt\_def}
+command is being processed.
+
+@p procedure define_font(@!e:integer); {|e| is an external font number}
+var f:0..max_fonts;
+@!p:integer; {length of the area/directory spec}
+@!n:integer; {length of the font name proper}
+@!c,@!q,@!d,@!m:integer; {check sum, scaled size, design size, magnification}
+@!r:0..name_length; {index into |cur_name|}
+@!j,@!k:0..name_size; {indices into |names|}
+@!mismatch:boolean; {do names disagree?}
+begin if nf=max_fonts then abort('DVItype capacity exceeded (max fonts=',
+ max_fonts:1,')!');
+@.DVItype capacity exceeded...@>
+font_num[nf]:=e; f:=0;
+while font_num[f]<>e do incr(f);
+@<Read the font parameters into position for font |nf|, and
+ print the font name@>;
+if ((out_mode=the_works)and in_postamble)or@|
+ ((out_mode<the_works)and not in_postamble) then
+ begin if f<nf then print_ln('---this font was already defined!');
+@.this font was already defined@>
+ end
+else begin if f=nf then print_ln('---this font wasn''t loaded before!');
+@.this font wasn't loaded before@>
+ end;
+if f=nf then @<Load the new font, unless there are problems@>
+else @<Check that the current font definition matches the old one@>;
+end;
+
+@ @<Check that the current...@>=
+begin if font_check_sum[f]<>c then
+ print_ln('---check sum doesn''t match previous definition!');
+@.check sum doesn't match@>
+if font_scaled_size[f]<>q then
+ print_ln('---scaled size doesn''t match previous definition!');
+@.scaled size doesn't match@>
+if font_design_size[f]<>d then
+ print_ln('---design size doesn''t match previous definition!');
+@.design size doesn't match@>
+j:=font_name[f]; k:=font_name[nf];
+if font_name[f+1]-j<>font_name[nf+1]-k then mismatch:=true
+else begin mismatch:=false;
+ while j<font_name[f+1] do
+ begin if names[j]<>names[k] then mismatch:=true;
+ incr(j); incr(k);
+ end;
+ end;
+if mismatch then print_ln('---font name doesn''t match previous definition!');
+@.font name doesn't match@>
+end
+
+@ @<Read the font parameters into position for font |nf|...@>=
+c:=signed_quad; font_check_sum[nf]:=c;@/
+q:=signed_quad; font_scaled_size[nf]:=q;@/
+d:=signed_quad; font_design_size[nf]:=d;@/
+if (q<=0) or (d<=0) then m:=1000
+else m:=round((1000.0*conv*q)/(true_conv*d));
+p:=get_byte; n:=get_byte;
+if font_name[nf]+n+p>name_size then
+ abort('DVItype capacity exceeded (name size=',name_size:1,')!');
+@.DVItype capacity exceeded...@>
+font_name[nf+1]:=font_name[nf]+n+p;
+if showing then print(': ')
+ {when |showing| is true, the font number has already been printed}
+else print('Font ',e:1,': ');
+if n+p=0 then print('null font name!')
+@.null font name@>
+else for k:=font_name[nf] to font_name[nf+1]-1 do names[k]:=get_byte;
+print_font(nf);
+if not showing then if m<>1000 then print(' scaled ',m:1)
+@.scaled@>
+
+@ @<Load the new font, unless there are problems@>=
+begin @<Move font name into the |cur_name| string@>;
+open_tfm_file;
+if eof(tfm_file) then
+ print('---not loaded, TFM file can''t be opened!')
+@.TFM file can\'t be opened@>
+else begin if (q<=0)or(q>=@'1000000000) then
+ print('---not loaded, bad scale (',q:1,')!')
+@.bad scale@>
+ else if (d<=0)or(d>=@'1000000000) then
+ print('---not loaded, bad design size (',d:1,')!')
+@.bad design size@>
+ else if in_TFM(q) then @<Finish loading the new font info@>;
+ end;
+if out_mode=errors_only then print_ln(' ');
+end
+
+@ @<Finish loading...@>=
+begin font_space[nf]:=q div 6; {this is a 3-unit ``thin space''}
+if (c<>0)and(tfm_check_sum<>0)and(c<>tfm_check_sum) then
+ begin print_ln('---beware: check sums do not agree!');
+@.beware: check sums do not agree@>
+@.check sums do not agree@>
+ print_ln(' (',c:1,' vs. ',tfm_check_sum:1,')');
+ print(' ');
+ end;
+if abs(tfm_design_size-d)>2 then
+ begin print_ln('---beware: design sizes do not agree!');
+@.beware: design sizes do not agree@>
+@.design sizes do not agree@>
+ print_ln(' (',d:1,' vs. ',tfm_design_size:1,')');
+ print(' ');
+ end;
+print('---loaded at size ',q:1,' DVI units');
+d:=round((100.0*conv*q)/(true_conv*d));
+if d<>100 then
+ begin print_ln(' '); print(' (this font is magnified ',d:1,'%)');
+ end;
+@.this font is magnified@>
+incr(nf); {now the new font is officially present}
+end
+
+@ If |p=0|, i.e., if no font directory has been specified, \.{DVItype}
+is supposed to use the default font directory, which is a
+system-dependent place where the standard fonts are kept.
+The string variable |default_directory| contains the name of this area.
+@^system dependencies@>
+
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@^system dependencies@>
+
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if p=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_name[nf] to font_name[nf+1]-1 do
+ begin incr(r);
+ if r+4>name_length then
+ abort('ODVItype capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.ODVItype capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+
+@* Low level output routines.
+Simple text in the \.{DVI} file is saved in a buffer until |line_length-2|
+characters have accumulated, or until some non-simple \.{DVI} operation
+occurs. Then the accumulated text is printed on a line, surrounded by
+brackets. The global variable |text_ptr| keeps track of the number of
+characters currently in the buffer.
+
+@<Glob...@>=
+@!text_ptr:0..line_length; {the number of characters in |text_buf|}
+@!text_buf:array[1..line_length] of ASCII_code; {saved characters}
+
+@ @<Set init...@>=
+text_ptr:=0;
+
+@ The |flush_text| procedure will empty the buffer if there is something in it.
+
+@p procedure flush_text;
+var k:0..line_length; {index into |text_buf|}
+begin if text_ptr>0 then
+ begin if out_mode>errors_only then
+ begin print('[');
+ for k:=1 to text_ptr do print(xchr[text_buf[k]]);
+ print_ln(']');
+ end;
+ text_ptr:=0;
+ end;
+end;
+
+@ And the |out_text| procedure puts something in it.
+
+@p procedure out_text(c:ASCII_code);
+begin if text_ptr=line_length-2 then flush_text;
+incr(text_ptr); text_buf[text_ptr]:=c;
+end;
+
+@* Translation to symbolic form.
+The main work of \.{DVItype} is accomplished by the |do_page| procedure,
+which produces the output for an entire page, assuming that the |bop|
+command for that page has already been processed. This procedure is
+essentially an interpretive routine that reads and acts on the \.{DVI}
+commands.
+
+@ The definition of \.{DVI} files refers to six registers,
+$(h,v,w,x,y,z)$, which hold integer values in \.{DVI} units. In practice,
+we also need registers |hh| and |vv|, the pixel analogs of $h$ and $v$,
+since it is not always true that |hh=pixel_round(h)| or
+|vv=pixel_round(v)|.
+
+The stack of $(h,v,w,x,y,z)$ values is represented by eight arrays
+called |hstack|, \dots, |zstack|, |hhstack|, and |vvstack|.
+
+@<Glob...@>=
+@!h,@!v,@!w,@!x,@!y,@!z,@!hh,@!vv:integer; {current state values}
+@!hstack,@!vstack,@!wstack,@!xstack,@!ystack,@!zstack:
+ array [0..stack_size] of integer; {pushed down values in \.{DVI} units}
+@!hhstack,@!vvstack:
+ array [0..stack_size] of integer; {pushed down values in pixels}
+
+@ Three characteristics of the pages (their |max_v|, |max_h|, and
+|max_s|) are specified in the postamble, and a warning message
+is printed if these limits are exceeded. Actually |max_v| is set to
+the maximum height plus depth of a page, and |max_h| to the maximum width,
+for purposes of page layout. Since characters can legally be set outside
+of the page boundaries, it is not an error when |max_v| or |max_h| is
+exceeded. But |max_s| should not be exceeded.
+
+The postamble also specifies the total number of pages; \.{DVItype}
+checks to see if this total is accurate.
+
+@<Glob...@>=
+@!max_v:integer; {the value of |abs(v)| should probably not exceed this}
+@!max_h:integer; {the value of |abs(h)| should probably not exceed this}
+@!max_s:integer; {the stack depth should not exceed this}
+@!max_v_so_far,@!max_h_so_far,@!max_s_so_far:integer; {the record high levels}
+@!total_pages:integer; {the stated total number of pages}
+@!page_count:integer; {the total number of pages seen so far}
+
+@ @<Set init...@>=
+max_v:=@'17777777777-99; max_h:=@'17777777777-99; max_s:=stack_size+1;@/
+max_v_so_far:=0; max_h_so_far:=0; max_s_so_far:=0; page_count:=0;
+
+@ Before we get into the details of |do_page|, it is convenient to
+consider a simpler routine that computes the first parameter of each
+opcode.
+
+@d four_cases(#)==#,#+1,#+2,#+3
+@d eight_cases(#)==four_cases(#),four_cases(#+4)
+@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
+@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
+@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
+
+@p function first_par(o:eight_bits):integer;
+begin case o of
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64):
+ first_par:=o-set_char_0;
+set1,put1,fnt1,xxx1,fnt_def1: first_par:=get_byte;
+set1+1,put1+1,fnt1+1,xxx1+1,fnt_def1+1: first_par:=get_two_bytes;
+set1+2,put1+2,fnt1+2,xxx1+2,fnt_def1+2: first_par:=get_three_bytes;
+right1,w1,x1,down1,y1,z1: first_par:=signed_byte;
+right1+1,w1+1,x1+1,down1+1,y1+1,z1+1: first_par:=signed_pair;
+right1+2,w1+2,x1+2,down1+2,y1+2,z1+2: first_par:=signed_trio;
+set1+3,set_rule,put1+3,put_rule,right1+3,w1+3,x1+3,down1+3,y1+3,z1+3,
+ fnt1+3,xxx1+3,fnt_def1+3: first_par:=signed_quad;
+nop,bop,eop,push,pop,pre,post,post_post,undefined_commands: first_par:=0;
+w0: first_par:=w;
+x0: first_par:=x;
+y0: first_par:=y;
+z0: first_par:=z;
+sixty_four_cases(fnt_num_0): first_par:=o-fnt_num_0;
+end;
+end;
+
+@ Here is another subroutine that we need: It computes the number of
+pixels in the height or width of a rule. Characters and rules will line up
+properly if the sizes are computed precisely as specified here. (Since
+|conv| is computed with some floating-point roundoff error, in a
+machine-dependent way, format designers who are tailoring something for a
+particular resolution should not plan their measurements to come out to an
+exact integer number of pixels; they should compute things so that the
+rule dimensions are a little less than an integer number of pixels, e.g.,
+4.99 instead of 5.00.)
+
+@p function rule_pixels(x:integer):integer;
+ {computes $\lceil|conv|\cdot x\rceil$}
+var n:integer;
+begin n:=trunc(conv*x);
+if n<conv*x then rule_pixels:=n+1 @+ else rule_pixels:=n;
+end;
+
+@ Strictly speaking, the |do_page| procedure is really a function with
+side effects, not a `\&{procedure}'\thinspace; it returns the value |false|
+if \.{DVItype} should be aborted because of some unusual happening. The
+subroutine is organized as a typical interpreter, with a multiway branch
+on the command code followed by |goto| statements leading to routines that
+finish up the activities common to different commands. We will use the
+following labels:
+
+@d fin_set=41 {label for commands that set or put a character}
+@d fin_rule=42 {label for commands that set or put a rule}
+@d move_right=43 {label for commands that change |h|}
+@d move_down=44 {label for commands that change |v|}
+@d show_state=45 {label for commands that change |s|}
+@d change_font=46 {label for commands that change |cur_font|}
+
+@ Some \PASCAL\ compilers severely restrict the length of procedure bodies,
+so we shall split |do_page| into two parts, one of which is
+called |special_cases|. The different parts communicate with each other
+via the global variables mentioned above, together with the following ones:
+
+@<Glob...@>=
+@!s:integer; {current stack size}
+@!ss:integer; {stack size to print}
+@!cur_font:integer; {current internal font number}
+@!showing:boolean; {is the current command being translated in full?}
+
+@ Here is the overall setup.
+
+@p @t\4@>@<Declare the function called |special_cases|@>@;
+function do_page:boolean;
+label fin_set,fin_rule,move_right,show_state,done,9998,9999;
+var o:eight_bits; {operation code of the current command}
+@!p,@!q:integer; {parameters of the current command}
+@!a:integer; {byte number of the current command}
+@!hhh:integer; {|h|, rounded to the nearest pixel}
+begin cur_font:=invalid_font; {set current font undefined}
+s:=0; h:=0; v:=0; w:=0; x:=0; y:=0; z:=0; hh:=0; vv:=0;
+ {initialize the state variables}
+while true do @<Translate the next command in the \.{DVI} file;
+ |goto 9999| with |do_page=true| if it was |eop|;
+ |goto 9998| if premature termination is needed@>;
+9998: print_ln('!'); do_page:=false;
+9999: end;
+
+@ Commands are broken down into ``major'' and ``minor'' categories:
+A major command is always shown in full, while a minor one is
+put into the buffer in abbreviated form. Minor commands, which
+account for the bulk of most \.{DVI} files, involve horizontal spacing
+and the typesetting of characters in a line; these are shown in full
+only if |out_mode>=verbose|.
+
+@d show(#)==begin flush_text; showing:=true; print(a:1,': ',#);
+ end
+@d major(#)==if out_mode>errors_only then show(#)
+@d minor(#)==if out_mode>terse then
+ begin showing:=true; print(a:1,': ',#);
+ end
+@d error(#)==if not showing then show(#) else print(' ',#)
+
+@<Translate the next command...@>=
+begin a:=cur_loc; showing:=false;
+o:=get_byte; p:=first_par(o);
+if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+@<Start translation of command |o| and |goto| the appropriate label to
+ finish the job@>;
+fin_set: @<Finish a command that either sets or puts a character, then
+ |goto move_right| or |done|@>;
+fin_rule: @<Finish a command that either sets or puts a rule, then
+ |goto move_right| or |done|@>;
+move_right: @<Finish a command that sets |h:=h+q|, then |goto done|@>;
+show_state: @<Show the values of |ss|, |h|, |v|, |w|, |x|, |y|, |z|,
+ |hh|, and |vv|; then |goto done|@>;
+done: if showing then print_ln(' ');
+end
+
+@ The multiway switch in |first_par|, above, was organized by the length
+of each command; the one in |do_page| is organized by the semantics.
+
+@<Start translation...@>=
+if o<set_char_0+128 then @<Translate a |set_char| command@>
+else case o of
+ four_cases(set1): begin major('set',o-set1+1:1,' ',p:1); goto fin_set;
+ end;
+ four_cases(put1): begin major('put',o-put1+1:1,' ',p:1); goto fin_set;
+ end;
+ set_rule: begin major('setrule'); goto fin_rule;
+ end;
+ put_rule: begin major('putrule'); goto fin_rule;
+ end;
+ @t\4@>@<Cases for commands |nop|, |bop|, \dots, |pop|@>@;
+ @t\4@>@<Cases for horizontal motion@>@;
+ othercases if special_cases(o,p,a) then goto done@+else goto 9998
+ endcases
+
+@ @<Declare the function called |special_cases|@>=
+function special_cases(@!o:eight_bits;@!p,@!a:integer):boolean;
+label change_font,move_down,done,9998;
+var q:integer; {parameter of the current command}
+@!k:integer; {loop index}
+@!bad_char:boolean; {has a non-ASCII character code appeared in this \\{xxx}?}
+@!pure:boolean; {is the command error-free?}
+@!vvv:integer; {|v|, rounded to the nearest pixel}
+begin pure:=true;
+case o of
+@t\4@>@<Cases for vertical motion@>@;
+@t\4@>@<Cases for fonts@>@;
+four_cases(xxx1): @<Translate an |xxx| command and |goto done|@>;
+pre: begin error('preamble command within a page!'); goto 9998;
+ end;
+@.preamble command within a page@>
+post,post_post: begin error('postamble command within a page!'); goto 9998;
+@.postamble command within a page@>
+ end;
+othercases begin error('undefined command ',o:1,'!');
+ goto done;
+@.undefined command@>
+ end
+endcases;
+move_down: @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+change_font: @<Finish a command that changes the current font,
+ then |goto done|@>;
+9998: pure:=false;
+done: special_cases:=pure;
+end;
+
+@ @<Cases for commands |nop|, |bop|, \dots, |pop|@>=
+nop: begin minor('nop'); goto done;
+ end;
+bop: begin error('bop occurred before eop!'); goto 9998;
+@.bop occurred before eop@>
+ end;
+eop: begin major('eop');
+ if s<>0 then error('stack not empty at end of page (level ',
+ s:1,')!');
+@.stack not empty...@>
+ do_page:=true; print_ln(' '); goto 9999;
+ end;
+push: begin major('push');
+ if s=max_s_so_far then
+ begin max_s_so_far:=s+1;
+ if s=max_s then error('deeper than claimed in postamble!');
+@.deeper than claimed...@>
+@.push deeper than claimed...@>
+ if s=stack_size then
+ begin error('DVItype capacity exceeded (stack size=',
+ stack_size:1,')'); goto 9998;
+ end;
+ end;
+ hstack[s]:=h; vstack[s]:=v; wstack[s]:=w;
+ xstack[s]:=x; ystack[s]:=y; zstack[s]:=z;
+ hhstack[s]:=hh; vvstack[s]:=vv; incr(s); ss:=s-1; goto show_state;
+ end;
+pop: begin major('pop');
+ if s=0 then error('(illegal at level zero)!')
+ else begin decr(s); hh:=hhstack[s]; vv:=vvstack[s];
+ h:=hstack[s]; v:=vstack[s]; w:=wstack[s];
+ x:=xstack[s]; y:=ystack[s]; z:=zstack[s];
+ end;
+ ss:=s; goto show_state;
+ end;
+
+@ Rounding to the nearest pixel is best done in the manner shown here, so as
+to be inoffensive to the eye: When the horizontal motion is small, like a
+kern, |hh| changes by rounding the kern; but when the motion is large, |hh|
+changes by rounding the true position |h| so that accumulated rounding errors
+disappear. We allow a larger space in the negative direction than in
+the positive one, because \TeX\ makes comparatively
+large backspaces when it positions accents.
+
+@d out_space(#)==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then
+ begin out_text(" "); hh:=pixel_round(h+p);
+ end
+ else hh:=hh+pixel_round(p);
+ minor(#,' ',p:1); q:=p; goto move_right
+
+@<Cases for horizontal motion@>=
+four_cases(right1):begin out_space('right',o-right1+1:1);
+ end;
+w0,four_cases(w1):begin w:=p; out_space('w',o-w0:1);
+ end;
+x0,four_cases(x1):begin x:=p; out_space('x',o-x0:1);
+ end;
+
+@ Vertical motion is done similarly, but with the threshold between
+``small'' and ``large'' increased by a factor of five. The idea is to make
+fractions like ``$1\over2$'' round consistently, but to absorb accumulated
+rounding errors in the baseline-skip moves.
+
+@d out_vmove(#)==if abs(p)>=5*font_space[cur_font] then vv:=pixel_round(v+p)
+ else vv:=vv+pixel_round(p);
+ major(#,' ',p:1); goto move_down
+
+@<Cases for vertical motion@>=
+four_cases(down1):begin out_vmove('down',o-down1+1:1);
+ end;
+y0,four_cases(y1):begin y:=p; out_vmove('y',o-y0:1);
+ end;
+z0,four_cases(z1):begin z:=p; out_vmove('z',o-z0:1);
+ end;
+
+@ @<Cases for fonts@>=
+sixty_four_cases(fnt_num_0): begin major('fntnum',p:1);
+ goto change_font;
+ end;
+four_cases(fnt1): begin major('fnt',o-fnt1+1:1,' ',p:1);
+ goto change_font;
+ end;
+four_cases(fnt_def1): begin major('fntdef',o-fnt_def1+1:1,' ',p:1);
+ define_font(p); goto done;
+ end;
+
+@ @<Translate an |xxx| command and |goto done|@>=
+begin major('xxx '''); bad_char:=false;
+if p<0 then error('string of negative length!');
+@.string of negative length@>
+for k:=1 to p do
+ begin q:=get_byte;
+ if (q<" ")or(q>"~") then bad_char:=true;
+ if showing then print(xchr[q]);
+ end;
+if showing then print('''');
+if bad_char then error('non-ASCII character in xxx command!');
+@.non-ASCII character...@>
+goto done;
+end
+
+@ @<Translate a |set_char|...@>=
+begin if (o>" ")and(o<="~") then
+ begin out_text(p); minor('setchar',p:1);
+ end
+else major('setchar',p:1);
+goto fin_set;
+end
+
+@ @<Finish a command that either sets or puts a character...@>=
+{if p<0 then p:=255-((-1-p) mod 256)
+ else if p>=256 then p:=p mod 256;} {width computation for oriental fonts}
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+if (p<font_bc[cur_font])or(p>font_ec[cur_font]) then q:=invalid_width
+else q:=char_width(cur_font)(p);
+if q=invalid_width then
+ begin error('character ',p:1,' invalid in font ');
+@.character $c$ invalid...@>
+ print_font(cur_font);
+ if cur_font<>invalid_font then
+ print('!'); {the invalid font has `\.!' in its name}
+ end;
+if o>=put1 then goto done;
+if q=invalid_width then q:=0
+else hh:=hh+char_pixel_width(cur_font)(p);
+goto move_right
+
+@ @<Finish a command that either sets or puts a rule...@>=
+q:=signed_quad;
+if showing then
+ begin print(' height ',p:1,', width ',q:1);
+ if out_mode>mnemonics_only then
+ if (p<=0)or(q<=0) then print(' (invisible)')
+ else print(' (',rule_pixels(p):1,'x',rule_pixels(q):1,' pixels)');
+ end;
+if o=put_rule then goto done;
+if showing then if out_mode>mnemonics_only then print_ln(' ');
+hh:=hh+rule_pixels(q); goto move_right
+
+@ A sequence of consecutive rules, or consecutive characters in a fixed-width
+font whose width is not an integer number of pixels, can cause |hh| to drift
+far away from a correctly rounded value. \.{DVItype} ensures that the
+amount of drift will never exceed |max_drift| pixels.
+
+Since \.{DVItype} is intended to diagnose strange errors, it checks
+carefully to make sure that |h| and |v| do not get out of range.
+Normal \.{DVI}-reading programs need not do this.
+
+@d infinity==@'17777777777 {$\infty$ (approximately)}
+@d max_drift=2 {we insist that abs|(hh-pixel_round(h))<=max_drift|}
+
+@<Finish a command that sets |h:=h+q|, then |goto done|@>=
+if (h>0)and(q>0) then if h>infinity-q then
+ begin error('arithmetic overflow! parameter changed from ',
+@.arithmetic overflow...@>
+ q:1,' to ',infinity-h:1);
+ q:=infinity-h;
+ end;
+if (h<0)and(q<0) then if -h>q+infinity then
+ begin error('arithmetic overflow! parameter changed from ',
+ q:1, ' to ',(-h)-infinity:1);
+ q:=(-h)-infinity;
+ end;
+hhh:=pixel_round(h+q);
+if abs(hhh-hh)>max_drift then
+ if hhh>hh then hh:=hhh-max_drift
+ else hh:=hhh+max_drift;
+if showing then if out_mode>mnemonics_only then
+ begin print(' h:=',h:1);
+ if q>=0 then print('+');
+ print(q:1,'=',h+q:1,', hh:=',hh:1);
+ end;
+h:=h+q;
+if abs(h)>max_h_so_far then
+ begin if abs(h)>max_h+99 then
+ begin error('warning: |h|>',max_h:1,'!');
+@.warning: |h|...@>
+ max_h:=abs(h);
+ end;
+ max_h_so_far:=abs(h);
+ end;
+goto done
+
+@ @<Finish a command that sets |v:=v+p|, then |goto done|@>=
+if (v>0)and(p>0) then if v>infinity-p then
+ begin error('arithmetic overflow! parameter changed from ',
+@.arithmetic overflow...@>
+ p:1,' to ',infinity-v:1);
+ p:=infinity-v;
+ end;
+if (v<0)and(p<0) then if -v>p+infinity then
+ begin error('arithmetic overflow! parameter changed from ',
+ p:1, ' to ',(-v)-infinity:1);
+ p:=(-v)-infinity;
+ end;
+vvv:=pixel_round(v+p);
+if abs(vvv-vv)>max_drift then
+ if vvv>vv then vv:=vvv-max_drift
+ else vv:=vvv+max_drift;
+if showing then if out_mode>mnemonics_only then
+ begin print(' v:=',v:1);
+ if p>=0 then print('+');
+ print(p:1,'=',v+p:1,', vv:=',vv:1);
+ end;
+v:=v+p;
+if abs(v)>max_v_so_far then
+ begin if abs(v)>max_v+99 then
+ begin error('warning: |v|>',max_v:1,'!');
+@.warning: |v|...@>
+ max_v:=abs(v);
+ end;
+ max_v_so_far:=abs(v);
+ end;
+goto done
+
+@ @<Show the values of |ss|, |h|, |v|, |w|, |x|, |y|, |z|...@>=
+if showing then if out_mode>mnemonics_only then
+ begin print_ln(' ');
+ print('level ',ss:1,':(h=',h:1,',v=',v:1,
+ ',w=',w:1,',x=',x:1,',y=',y:1,',z=',z:1,
+ ',hh=',hh:1,',vv=',vv:1,')');
+ end;
+goto done
+
+@ @<Finish a command that changes the current font...@>=
+font_num[nf]:=p; cur_font:=0;
+while font_num[cur_font]<>p do incr(cur_font);
+if cur_font=nf then
+ begin cur_font:=invalid_font;
+ error('invalid font selection: font ',p:1,' was never defined!');
+ end;
+if showing then if out_mode>mnemonics_only then
+ begin print(' current font is '); print_font(cur_font);
+ end;
+goto done
+
+@* Skipping pages.
+A routine that's much simpler than |do_page| is used to pass over
+pages that are not being translated. The |skip_pages| subroutine
+is assumed to begin just after the preamble has been read, or just
+after a |bop| has been processed. It continues until either finding a
+|bop| that matches the desired starting page specifications, or until
+running into the postamble.
+
+@p @t\4@>@<Declare the procedure called |scan_bop|@>@;
+procedure skip_pages(@!bop_seen:boolean);
+label 9999; {end of this subroutine}
+var p:integer; {a parameter}
+@!k:0..255; {command code}
+@!down_the_drain:integer; {garbage}
+begin showing:=false;
+while true do
+ begin if not bop_seen then
+ begin scan_bop;
+ if in_postamble then goto 9999;
+ if not started then if start_match then
+ begin started:=true; goto 9999;
+ end;
+ end;
+ @<Skip until finding |eop|@>;
+ bop_seen:=false;
+ end;
+9999:end;
+
+@ @<Skip until finding |eop|@>=
+repeat if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+ k:=get_byte;
+ p:=first_par(k);
+ case k of
+ set_rule,put_rule: down_the_drain:=signed_quad;
+ four_cases(fnt_def1): begin define_font(p);
+ print_ln(' ');
+ end;
+ four_cases(xxx1): while p>0 do
+ begin down_the_drain:=get_byte; decr(p);
+ end;
+ bop,pre,post,post_post,undefined_commands:
+ bad_dvi('illegal command at byte ',cur_loc-1:1);
+@.illegal command at byte n@>
+ othercases do_nothing
+ endcases;
+until k=eop;
+
+@ Global variables called |old_backpointer| and |new_backpointer|
+are used to check whether the back pointers are properly set up.
+Another one tells whether we have already found the starting page.
+
+@<Glob...@>=
+@!old_backpointer:integer; {the previous |bop| command location}
+@!new_backpointer:integer; {the current |bop| command location}
+@!started:boolean; {has the starting page been found?}
+
+@ @<Set init...@>=
+old_backpointer:=-1; started:=false;
+
+@ The |scan_bop| procedure reads \.{DVI} commands following the preamble
+or following |eop|, until finding either |bop| or the postamble.
+
+@<Declare the procedure called |scan_bop|@>=
+procedure scan_bop;
+var k:0..255; {command code}
+begin repeat if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+ k:=get_byte;
+ if (k>=fnt_def1)and(k<fnt_def1+4) then
+ begin define_font(first_par(k)); k:=nop;
+ end;
+until k<>nop;
+if k=post then in_postamble:=true
+else begin if k<>bop then bad_dvi('byte ',cur_loc-1:1,' is not bop');
+@.byte n is not bop@>
+ new_backpointer:=cur_loc-1; incr(page_count);
+ for k:=0 to 9 do count[k]:=signed_quad;
+ if signed_quad<>old_backpointer
+ then print_ln('backpointer in byte ',cur_loc-4:1,
+ ' should be ',old_backpointer:1,'!');
+@.backpointer...should be p@>
+ old_backpointer:=new_backpointer;
+ end;
+end;
+
+@* Using the backpointers.
+The routines in this section of the program are brought into play only
+if |random_reading| is |true| (and only if |out_mode=the_works|).
+First comes a routine that illustrates how to find the postamble quickly.
+
+@<Find the postamble, working back from the end@>=
+n:=dvi_length;
+if n<53 then bad_dvi('only ',n:1,' bytes long');
+@.only n bytes long@>
+m:=n-4;
+repeat if m=0 then bad_dvi('all 223s');
+@.all 223s@>
+move_to_byte(m); k:=get_byte; decr(m);
+until k<>223;
+if k<>id_byte then bad_dvi('ID byte is ',k:1);
+@.ID byte is wrong@>
+move_to_byte(m-3); q:=signed_quad;
+if (q<0)or(q>m-33) then bad_dvi('post pointer ',q:1,' at byte ',m-3:1);
+@.post pointer is wrong@>
+move_to_byte(q); k:=get_byte;
+if k<>post then bad_dvi('byte ',q:1,' is not post');
+@.byte n is not post@>
+post_loc:=q; first_backpointer:=signed_quad
+
+@ Note that the last steps of the above code save the locations of the
+the |post| byte and the final |bop|. We had better declare these global
+variables, together with two more that we will need shortly.
+
+@<Glob...@>=
+@!post_loc:integer; {byte location where the postamble begins}
+@!first_backpointer:integer; {the pointer following |post|}
+@!start_loc:integer; {byte location of the first page to process}
+@!after_pre:integer; {byte location immediately following the preamble}
+
+@ The next little routine shows how the backpointers can be followed
+to move through a \.{DVI} file in reverse order. Ordinarily a \.{DVI}-reading
+program would do this only if it wants to print the pages backwards or
+if it wants to find a specified starting page that is not necessarily the
+first page in the file; otherwise it would of course be simpler and faster
+just to read the whole file from the beginning.
+
+@<Count the pages and move to the starting page@>=
+q:=post_loc; p:=first_backpointer; start_loc:=-1;
+if p<0 then in_postamble:=true
+else begin repeat
+ {now |q| points to a |post| or |bop| command; |p>=0| is prev pointer}
+ if p>q-46 then
+ bad_dvi('page link ',p:1,' after byte ',q:1);
+@.page link wrong...@>
+ q:=p; move_to_byte(q); k:=get_byte;
+ if k=bop then incr(page_count)
+ else bad_dvi('byte ',q:1,' is not bop');
+@.byte n is not bop@>
+ for k:=0 to 9 do count[k]:=signed_quad;
+ p:=signed_quad;
+ if start_match then
+ begin start_loc:=q; old_backpointer:=p;
+ end;
+ until p<0;
+ if start_loc<0 then abort('starting page number could not be found!');
+@.starting page number...@>
+ if old_backpointer<0 then start_loc:=after_pre; {we want to check everything}
+ move_to_byte(start_loc);
+ end;
+if page_count<>total_pages then
+ print_ln('there are really ',page_count:1,' pages, not ',total_pages:1,'!')
+@.there are really n pages@>
+
+@* Reading the postamble.
+Now imagine that we are reading the \.{DVI} file and positioned just
+four bytes after the |post| command. That, in fact, is the situation,
+when the following part of \.{DVItype} is called upon to read, translate,
+and check the rest of the postamble.
+
+@p procedure read_postamble;
+var k:integer; {loop index}
+@!p,@!q,@!m:integer; {general purpose registers}
+begin showing:=false; post_loc:=cur_loc-5;
+print_ln('Postamble starts at byte ',post_loc:1,'.');
+@.Postamble starts at byte n@>
+if signed_quad<>numerator then
+ print_ln('numerator doesn''t match the preamble!');
+@.numerator doesn't match@>
+if signed_quad<>denominator then
+ print_ln('denominator doesn''t match the preamble!');
+@.denominator doesn't match@>
+if signed_quad<>mag then if new_mag=0 then
+ print_ln('magnification doesn''t match the preamble!');
+@.magnification doesn't match@>
+max_v:=signed_quad; max_h:=signed_quad;@/
+print('maxv=',max_v:1,', maxh=',max_h:1);@/
+max_s:=get_two_bytes; total_pages:=get_two_bytes;@/
+print_ln(', maxstackdepth=',max_s:1,', totalpages=',total_pages:1);
+if out_mode<the_works then
+ @<Compare the \\{lust} parameters with the accumulated facts@>;
+@<Process the font definitions of the postamble@>;
+@<Make sure that the end of the file is well-formed@>;
+end;
+
+@ No warning is given when |max_h_so_far| exceeds |max_h| by less than~100,
+since 100 units is invisibly small; it's approximately the wavelength of
+visible light, in the case of \TeX\ output. Rounding errors can be expected
+to make |h| and |v| slightly more than |max_h| and |max_v|, every once in
+a~while; hence small discrepancies are not cause for alarm.
+
+@<Compare the \\{lust}...@>=
+begin if max_v+99<max_v_so_far then
+ print_ln('warning: observed maxv was ',max_v_so_far:1);
+@.warning: observed maxv...@>
+@.observed maxv was x@>
+if max_h+99<max_h_so_far then
+ print_ln('warning: observed maxh was ',max_h_so_far:1);
+@.warning: observed maxh...@>
+@.observed maxh was x@>
+if max_s<max_s_so_far then
+ print_ln('warning: observed maxstackdepth was ',max_s_so_far:1);
+@.warning: observed maxstack...@>
+@.observed maxstackdepth was x@>
+if page_count<>total_pages then
+ print_ln('there are really ',page_count:1,' pages, not ',total_pages:1,'!');
+end
+@.there are really n pages@>
+
+@ When we get to the present code, the |post_post| command has
+just been read.
+
+@<Make sure that the end of the file is well-formed@>=
+q:=signed_quad;
+if q<>post_loc then
+ print_ln('bad postamble pointer in byte ',cur_loc-4:1,'!');
+@.bad postamble pointer@>
+m:=get_byte;
+if m<>id_byte then print_ln('identification in byte ',cur_loc-1:1,
+@.identification...should be n@>
+ ' should be ',id_byte:1,'!');
+k:=cur_loc; m:=223;
+while (m=223)and not eof(dvi_file) do m:=get_byte;
+if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1,
+@.signature...should be...@>
+ ' should be 223')
+else if cur_loc<k+4 then
+ print_ln('not enough signature bytes at end of file (',
+@.not enough signature bytes...@>
+ cur_loc-k:1,')');
+
+@ @<Process the font definitions...@>=
+repeat k:=get_byte;
+if (k>=fnt_def1)and(k<fnt_def1+4) then
+ begin p:=first_par(k); define_font(p); print_ln(' '); k:=nop;
+ end;
+until k<>nop;
+if k<>post_post then
+ print_ln('byte ',cur_loc-1:1,' is not postpost!')
+@.byte n is not postpost@>
+
+@* The main program.
+Now we are ready to put it all together. This is where \.{DVItype} starts,
+and where it ends.
+
+@p begin initialize; {get all variables initialized}
+dialog; {set up all the options}
+@<Process the preamble@>;
+if out_mode=the_works then {|random_reading=true|}
+ begin @<Find the postamble, working back from the end@>;
+ in_postamble:=true; read_postamble; in_postamble:=false;
+ @<Count the pages and move to the starting page@>;
+ end;
+skip_pages(false);
+if not in_postamble then @<Translate up to |max_pages| pages@>;
+if out_mode<the_works then
+ begin if not in_postamble then skip_pages(true);
+ if signed_quad<>old_backpointer then
+ print_ln('backpointer in byte ',cur_loc-4:1,
+ ' should be ',old_backpointer:1,'!');
+@.backpointer...should be p@>
+ read_postamble;
+ end;
+final_end:end.
+
+@ The main program needs a few global variables in order to do its work.
+
+@<Glob...@>=
+@!k,@!m,@!n,@!p,@!q:integer; {general purpose registers}
+
+@ A \.{DVI}-reading program that reads the postamble first need not look at the
+preamble; but \.{DVItype} looks at the preamble in order to do error
+checking, and to display the introductory comment.
+
+@<Process the preamble@>=
+open_dvi_file;
+p:=get_byte; {fetch the first byte}
+if p<>pre then bad_dvi('First byte isn''t start of preamble!');
+@.First byte isn't...@>
+p:=get_byte; {fetch the identification byte}
+if p<>id_byte then
+ print_ln('identification in byte 1 should be ',id_byte:1,'!');
+@.identification...should be n@>
+@<Compute the conversion factors@>;
+p:=get_byte; {fetch the length of the introductory comment}
+print('''');
+while p>0 do
+ begin decr(p); print(xchr[get_byte]);
+ end;
+print_ln('''');
+after_pre:=cur_loc
+
+@ The conversion factor |conv| is figured as follows: There are exactly
+|n/d| decimicrons per \.{DVI} unit, and 254000 decimicrons per inch,
+and |resolution| pixels per inch. Then we have to adjust this
+by the stated amount of magnification.
+
+@<Compute the conversion factors@>=
+numerator:=signed_quad; denominator:=signed_quad;
+if numerator<=0 then bad_dvi('numerator is ',numerator:1);
+@.numerator is wrong@>
+if denominator<=0 then bad_dvi('denominator is ',denominator:1);
+@.denominator is wrong@>
+print_ln('numerator/denominator=',numerator:1,'/',denominator:1);
+tfm_conv:=(25400000.0/numerator)*(denominator/473628672)/16.0;
+conv:=(numerator/254000.0)*(resolution/denominator);
+mag:=signed_quad;
+if new_mag>0 then mag:=new_mag
+else if mag<=0 then bad_dvi('magnification is ',mag:1);
+@.magnification is wrong@>
+true_conv:=conv; conv:=true_conv*(mag/1000.0);
+print_ln('magnification=',mag:1,'; ',conv:16:8,' pixels per DVI unit')
+
+@ The code shown here uses a convention that has proved to be useful:
+If the starting page was specified as, e.g., `\.{1.*.-5}', then
+all page numbers in the file are displayed by showing the values of
+counts 0, 1, and~2, separated by dots. Such numbers can, for example,
+be displayed on the console of a printer when it is working on that
+page.
+
+@<Translate up to...@>=
+begin while max_pages>0 do
+ begin decr(max_pages);
+ print_ln(' '); print(cur_loc-45:1,': beginning of page ');
+ for k:=0 to start_vals do
+ begin print(count[k]:1);
+ if k<start_vals then print('.')
+ else print_ln(' ');
+ end;
+ if not do_page then bad_dvi('page ended unexpectedly');
+@.page ended unexpectedly@>
+ scan_bop;
+ if in_postamble then goto done;
+ end;
+done:end
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVItype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.ch b/Build/source/texk/web2c/omegaware/ofm2opl.ch
new file mode 100644
index 00000000000..830fee4d04c
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/ofm2opl.ch
@@ -0,0 +1,461 @@
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original tftopl.ch.
+%
+% tftopl.ch for C compilation with web2c.
+%
+% 04/04/83 (PC) Original version, made to work with version 1.0 of TFtoPL,
+% released with version 0.96 of TeX in February, 1983.
+% 04/16/83 (PC) Brought up to version 1.0 released with version 0.97 of TeX
+% in April, 1983.
+% 06/30/83 (HWT) Revised changefile format, for use with version 1.7 Tangle.
+% 07/28/83 (HWT) Brought up to version 2
+% 11/21/83 (HWT) Brought up to version 2.1
+% 03/24/84 (HWT) Brought up to version 2.2
+% 07/12/84 (HWT) Brought up to version 2.3
+% 07/05/87 (ETM) Brought up to version 2.5
+% 03/22/88 (ETM) Converted for use with WEB to C.
+% 11/30/89 (KB) Version 3.
+% 01/16/90 (SR) Version 3.1.
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+%\let\maybe=\iffalse
+%\def\title{TF\lowercase{to}PL changes for C}
+@z
+
+% [2] Fix files in program statement. We need to tell web2c about one
+% special variable. Perhaps it would be better to allow @define's
+% anywhere in a source file, but that seemed just as painful as this.
+@x
+@p program OFM2OPL(@!tfm_file,@!pl_file,@!output);
+@y
+@p
+{Tangle doesn't recognize @@ when it's right after the \.=.}
+@\@= @@define var tfm;@>@\
+program OFM2OPL(@!tfm_file,@!pl_file,@!output);
+@z
+
+@x [still 2] Don't print banner until later (and unless verbose).
+procedure initialize; {this procedure gets things started properly}
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ begin
+ kpse_set_progname (argv[0]);
+ kpse_init_prog ('OFM2OPL', 0, nil, nil);
+ {We |xrealloc| when we know how big the file is. The 1000 comes
+ from the negative lower bound.}
+ tfm_file_array := cast_to_byte_pointer (xmalloc (2000000));
+ parse_arguments;
+@z
+
+%@x [5] Increase sizes to match vptovf.
+%@!tfm_size=30000; {maximum length of |tfm| data, in bytes}
+%@!lig_size=5000; {maximum length of |lig_kern| program, in words}
+%@!hash_size=5003; {preferably a prime number, a bit larger than the number
+% of character pairs in lig/kern steps}
+%@y
+%@!tfm_size=40000; {maximum length of |tfm| data, in bytes}
+%@!lig_size=8000; {maximum length of |lig_kern| program, in words ($<2^{15}$)}
+%@!hash_size=8009; {preferably a prime number, a bit larger than the number
+% of character pairs in lig/kern steps}
+%@z
+
+@x [7] Open the TFM file.
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file);
+@y
+@ On some systems you may have to do something special to read a
+packed file of bytes. With C under Unix, we just open the file by name
+and read characters from it.
+
+@<Set init...@>=
+tfm_file := kpse_open_file (tfm_name, kpse_ofm_format);
+if verbose then begin
+ print (banner);
+ print_ln (version_string);
+end;
+@z
+
+@x [17] Open the PL file.
+@!pl_file:text;
+
+@ @<Set init...@>=
+rewrite(pl_file);
+@y
+@!pl_file:text;
+
+@ If an explicit filename isn't given, we write to |stdout|.
+
+@<Set init...@>=
+if optind + 1 = argc then begin
+ pl_file := stdout;
+end else begin
+ pl_name := extend_filename (cmdline (optind + 1), 'opl');
+ rewrite (pl_file, pl_name);
+end;
+@z
+
+@x [18,19] Make |tfm| be dynamically allocated, and rename `index'.
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!index=-1000..tfm_size; {address of a byte in |tfm|}
+@!char_type=0..65535;
+@!xchar_type=0..65536;
+@!xxchar_type=0..65537;
+@!xxxchar_type=0..65538;
+
+@
+@<Glob...@>=
+@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
+@y
+@d index == index_type
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!index=integer; {address of a byte in |tfm|}
+@!char_type=0..65535;
+@!xchar_type=0..65536;
+@!xxchar_type=0..65537;
+@!xxxchar_type=0..65538;
+
+@ CHECK OUT tfm array ranges.
+@<Glob...@>=
+{Kludge here to define |tfm| as a macro which takes care of the negative
+ lower bound. We've defined |tfm| for the benefit of web2c above.}
+@=#define tfm (tfmfilearray + 1001);@>@\
+@!tfm_file_array: pointer_to_byte; {the input data all goes here}
+@z
+
+@x [20] Send error output to stderr.
+@d abort(#)==begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a OFM?');
+@y
+@d abort(#)==begin write_ln(stderr, #);
+ write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OFM?');
+@z
+
+@x [20] Allow arbitrarily large input files.
+if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+@y
+{|tfm_file_array
+ := cast_to_byte_pointer (xrealloc (tfm_file_array, 4 * lf - 1 + 1108));|}
+@z
+
+% [27, 28] Change strings to C char pointers. The Pascal strings are
+% indexed starting at 1, so we pad with a blank.
+@x
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+@y
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string;
+ {strings for output in the user's external character set}
+@!ASCII_all: packed array[0..256] of char;
+@!MBL_string,@!RI_string,@!RCE_string: c_string;
+ {handy string constants for |face| codes}
+@z
+
+@x
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+HEX:='0123456789ABCDEF';@/
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+@y
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+HEX:=' 0123456789ABCDEF';@/
+strcpy (ASCII_all, ASCII_04);
+strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
+strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/
+MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE';
+@z
+
+% [38] How we output the character code depends on |charcode_format|.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+begin if font_type>vanilla then
+ out_hex_char(c)
+else if (c>="0")and(c<="9") then
+ out(' C ',c-"0":1)
+else if (c>="A")and(c<="Z") then
+ out(' C ',ASCII_10[c-"A"+2])
+else if (c>="a")and(c<="z") then
+ out(' C ',ASCII_14[c-"a"+2])
+else out_hex_char(c);
+@y
+begin if (font_type > vanilla) or (charcode_format = charcode_hex) then
+ out_hex_char(c)
+else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~")
+ and (c <> "(") and (c <> ")") then
+ out(' C ', ASCII_all[c - " " + 1])
+{default case, use hex}
+else out_hex_char(c);
+@z
+
+% [39] Don't output the face code as an integer.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ out(MBL_string[1+(b mod 3)]);
+ out(RI_string[1+s]);
+ out(RCE_string[1+(b div 3)]);
+@y
+ put_byte(MBL_string[1+(b mod 3)], pl_file);
+ put_byte(RI_string[1+s], pl_file);
+ put_byte(RCE_string[1+(b div 3)], pl_file);
+@z
+
+@x [40] Force 32-bit constant arithmetic for 16-bit machines.
+f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
+@y
+f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
+@z
+
+% [78] No progress reports unless verbose.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ incr(chars_on_line);
+ end;
+ if no_repeats(c)>0 then begin
+ print_hex(c); print('-'); print_hex(c+no_repeats(c));
+ left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
+ end
+ else begin
+ print_hex(c); {progress report}
+ left; out('CHARACTER'); out_char(c); out_ln;
+ end;
+@y
+ if verbose then incr(chars_on_line);
+ end;
+ if no_repeats(c)>0 then begin
+ if verbose then begin
+ print_hex(c); print('-'); print_hex(c+no_repeats(c));
+ end;
+ left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
+ end
+ else begin
+ if verbose then print_hex(c); {progress report}
+ left; out('CHARACTER'); out_char(c); out_ln;
+ end;
+@z
+
+% [89] Change the name of the variable `class', since AIX 3.1's <math.h>
+% defines a function by that name.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d pending=4 {$f(x,y)$ is being evaluated}
+@y
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+@d class == class_var
+@z
+
+% [90] Change name of the function `f'.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
+@y
+ r:=f_fn(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
+@z
+
+% [94] web2c can't handle these mutually recursive procedures.
+% But let's do a fake definition of f here, so that it gets into web2c's
+% symbol table. We also have to change the name, because there is also a
+% variable named `f', and some C compilers can't deal with that.
+@x
+@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+@y
+@p
+ifdef('notdef')
+function f_fn(@!h,@!x,@!y:index):index; begin end;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+endif('notdef')
+@z
+@x
+else eval:=f(h,x,y);
+@y
+else eval:=f_fn(h,x,y);
+@z
+
+% [95] The real definition of f.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p function f;
+@y
+@p function f_fn(@!h,@!x,@!y:index):index;
+@z
+@x
+f:=lig_z[h];
+@y
+f_fn:=lig_z[h];
+@z
+
+% [99] No final newline unless verbose.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+do_characters; print_ln('.');@/
+@y
+do_characters; if verbose then print_ln('.');@/
+@z
+
+@x [100] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TFtoPL} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 4; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('ofm2opl');
+
+ end else if argument_is ('help') then begin
+ usage_help (OFM2OPL_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit
+ (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth');
+
+ end else if argument_is ('charcode-format') then begin
+ if strcmp (optarg, 'ascii') = 0 then
+ charcode_format := charcode_ascii
+ else if strcmp (optarg, 'hex') = 0 then
+ charcode_format := charcode_hex
+ else
+ write_ln (stderr, 'Bad character code format', optarg, '.');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ write_ln (stderr, 'ofm2opl: Need one or two file arguments.');
+ usage ('ofm2opl');
+ end;
+
+ tfm_name := cmdline (optind);
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+@.-verbose@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@
+@<Initialize the option...@> =
+verbose := false;
+
+@ This option changes how we output character codes.
+@.-charcode-format@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'charcode-format';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ We use an ``enumerated'' type to store the information.
+
+@<Type...@> =
+@!charcode_format_type = charcode_ascii..charcode_default;
+
+@
+@<Const...@> =
+@!charcode_ascii = 0;
+@!charcode_hex = 1;
+@!charcode_default = 2;
+
+@
+@<Global...@> =
+@!charcode_format: charcode_format_type;
+
+@ It starts off as the default, which is hex for OFM2OPL.
+
+@<Initialize the option...@> =
+charcode_format := charcode_default;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!tfm_name, @!pl_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.web b/Build/source/texk/web2c/omegaware/ofm2opl.web
new file mode 100644
index 00000000000..d18931fd3a9
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/ofm2opl.web
@@ -0,0 +1,2322 @@
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+% applies only to the changes to the original tftopl.web.
+%
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was implemented in January 1982.
+% In February 1982 a new restriction on ligature steps was added.
+% In June 1982 the routines were divided into smaller pieces for IBM people,
+% and the result was designated "Version 1" in September 1982.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 2 (July 1983) was released with TeX version 0.999.
+% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN.
+% Version 2.2 (February 1984) simplified decimal fraction output.
+% Version 2.3 (May 1984) fixed a bug when lh=17.
+% Version 2.4 (July 1984) fixed a bug involving unused ligature code.
+% Version 2.5 (September 1985) updated the standard codingscheme names.
+% Version 3 (October 1989) introduced new ligature capabilities.
+% Version 3.1 (November 1989) renamed z[] to lig_z[] for better portability.
+
+% Version 1.0 of OFM2OPL (December 1995) allows one to read OFM files.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{OFM2OPL}
+\def\contentspagenumber{201}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont OFM2OPL} processor}
+ \vskip 15pt
+ \centerline{(Version 1.11, February 2000)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of the original report
+ by D. E. Knuth
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{OFM2OPL} utility program converts $\Omega$ and \TeX\ font
+metric (``\.{TFM}'' and ``\.{OFM}'') files into equivalent
+property-list (``\.{PL}'' and ``\.{OPL}'') files. It also
+makes a thorough check of the given \.{TFM} or \.{OFM} file,
+using essentially the same algorithm as \TeX\ or $\Omega$. Thus
+if \TeX\ or $\Omega$ complains that a \.{TFM} or an \.{OFM}
+file is ``bad,'' this program will pinpoint the source or sources of
+badness. A \.{PL} or \.{OPL} file output by this program can be edited
+with a normal text editor, and the result can be converted back to \.{TFM}
+or \.{OFM} format using the companion program \.{OPLtoOFM}.
+
+The first \.{TFtoPL} program was designed by Leo Guibas in the summer of
+1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw
+also had a significant effect on the evolution of the present code.
+
+Extensions for an enhanced ligature mechanism were added by
+D. E. Knuth in 1989.
+
+Extensions to handle extended font metric files (``\.{OFM}'') were
+added by John Plaice in December 1995 and January 1996, resulting in
+the new program \.{OFM2OPL}. In the following documentation, all
+unchanged references to the \.{TFtoPL} program and to \.{TFM} and
+\.{PL} files also apply to the \.{OFM2OPL} program and to \.{OFM}
+and \.{OPL} files.
+
+The |banner| string defined here should be changed whenever \.{OFM2OPL}
+gets modified.
+
+@d banner=='This is OFM2OPL, Version 1.11'
+
+@ This program is written entirely in standard \PASCAL, except that
+it occasionally has lower case letters in strings that are output.
+Such letters can be converted to upper case if necessary. The input is read
+from |tfm_file|, and the output is written on |pl_file|; error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program OFM2OPL(@!tfm_file,@!pl_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{TFtoPL}'s capacity.
+
+@<Constants...@>=
+@!tfm_size=2000000; {maximum length of |tfm| data, in bytes}
+@!lig_size=800000; {maximum length of |lig_kern| program, in words}
+@!hash_size=130003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@!hash_mult=16007; {another prime}
+@!max_char=65535; {the largest character number in a font}
+@!xmax_char=65536; {|max_char|+1}
+@!xxmax_char=65537;{|max_char|+2}
+@!xmax_label=80001;{must be greater than |max_lig_steps|}
+@!mem_size=262152; {|max_char|*4+8}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* Font metric data.
+The following description of \.{TFM} files is not sufficient for
+\.{OFM} files. The additional documentation necessary for the
+\.{OFM} files can be found in another file, such as the $\Omega$
+change files.
+
+The idea behind \.{TFM} files is that typesetting routines like \TeX\
+need a compact way to store the relevant information about several
+dozen fonts, and computer centers need a compact way to store the
+relevant information about several hundred fonts. \.{TFM} files are
+compact, and most of the information they contain is highly relevant,
+so they provide a solution to the problem.
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of 4, we could
+also regard the file as a sequence of 32-bit words; but \TeX\ uses the
+byte interpretation, and so does \.{TFtoPL}. Note that the bytes
+are considered to be unsigned numbers.
+
+@<Glob...@>=
+@!tfm_file:packed file of 0..255;
+
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file);
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|@!lf|&length of the entire file, in words;\cr
+|@!lh|&length of the header data, in words;\cr
+|@!bc|&smallest character code in the font;\cr
+|@!ec|&largest character code in the font;\cr
+|@!nw|&number of words in the width table;\cr
+|@!nh|&number of words in the height table;\cr
+|@!nd|&number of words in the depth table;\cr
+|@!ni|&number of words in the italic correction table;\cr
+|@!nl|&number of words in the lig/kern table;\cr
+|@!nk|&number of words in the kern table;\cr
+|@!ne|&number of words in the extensible character table;\cr
+|@!np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+|ne<=256|, and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+
+@<Glob...@>=
+@!ofm_level,
+@!nco,@!ncw,@!npc,@!nki,@!nwi,@!nkf,@!nwf,@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp,
+@!nkm,@!nwm,@!real_lf,
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np,@!font_dir:integer;
+ {subfile sizes}
+@!ofm_on:boolean;
+
+@ @<Set init...@>=
+ofm_on:=false; ofm_level:=-1; lf:=0; lh:=0;
+nco:=0; ncw:=0; npc:=0; bc:=0; ec:=0; nw:=0; nh:=0; nd:=0; ni:=0;
+nl:=0; nk:=0; ne:=0; np:=0;
+nki:=0; nwi:=0; nkf:=0; nwf:=0;
+nkm:=0; nwm:=0; real_lf:=0;
+nkr:=0; nwr:=0; nkg:=0; nwg:=0;
+nkp:=0; nwp:=0; font_dir:=0;
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
+header&|[0..lh-1]stuff|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but one of
+the |fix_word| values will lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+and for \.{TFM} files to be used with Xerox printing software it must
+contain at least 18 words, allocated as described below. When different
+kinds of devices need to be interfaced, it may be necessary to add further
+words to the header block.
+
+\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the
+\.{DVI} output file whenever it uses the font. Later on when the \.{DVI}
+file is printed, possibly on another computer, the actual font that gets
+used is supposed to have a check sum that agrees with the one in the
+\.{TFM} file used by \TeX. In this way, users will be warned about
+potential incompatibilities. (However, if the check sum is zero in either
+the font file or the \.{TFM} file, no check is made.) The actual relation
+between this check sum and the rest of the \.{TFM} file is not important;
+the check sum is simply an identification number with the property that
+incompatible fonts almost always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of the
+font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number
+must be at least 1.0; it is fairly arbitrary, but usually the design size
+is 10.0 for a ``10 point'' font, i.e., a font that was designed to look
+best at a 10-point size, whatever that really means. When a \TeX\ user
+asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the
+design size and replace it by $\delta$, and to multiply the $x$ and~$y$
+coordinates of the points in the font image by a factor of $\delta$
+divided by the design size. {\sl All other dimensions in the\/\ \.{TFM}
+file are |fix_word|\kern-1pt\ numbers in design-size units.} Thus, for example,
+the value of |param[6]|, one \.{em} or \.{\\quad}, is often the |fix_word|
+value $2^{20}=1.0$, since many fonts have a design size equal to one em.
+The other dimensions must be less than 16 design-size units in absolute
+value; thus, |header[1]| and |param[1]| are the only |fix_word| entries in
+the whole \.{TFM} file whose first byte might be something besides 0 or
+255. @^design size@>
+
+\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify
+the character coding scheme. The first byte, which must be between 0 and
+39, is the number of subsequent ASCII bytes actually relevant in this
+string, which is intended to specify what character-code-to-symbol
+convention is present in the font. Examples are \.{ASCII} for standard
+ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math
+extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for
+special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case
+when there is no information. Parentheses should not appear in this name.
+(Such a string is said to be in {\mc BCPL} format.)
+@^coding scheme@>
+
+\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the
+font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format.
+This field is also known as the ``font identifier.''
+@^family name@>
+@^font identifier@>
+
+\yskip\hang|header[17]|, if present, contains a first byte called the
+|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte
+called the |face|. If the value of the fourth byte is less than 18, it has
+the following interpretation as a ``weight, slope, and expansion'': Add 0
+or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to
+0 or 6 or 12 (for regular or condensed or extended). For example, 13 is
+0+1+12, so it represents medium italic extended. A three-letter code
+(e.g., \.{MIE}) can be used for such |face| data.
+
+\yskip\hang|header[18..@twhatever@>]| might also be present; the individual
+words are simply called |header[18]|, |header[19]|, etc., at the moment.
+
+@ Next comes the |char_info| array, which contains one |char_info_word|
+per character. Each |char_info_word| contains six fields packed into
+four bytes as follows.
+
+\yskip\hang first byte: |width_index| (8 bits)\par
+\hang second byte: |height_index| (4 bits) times 16, plus |depth_index|
+ (4~bits)\par
+\hang third byte: |italic_index| (6 bits) times 4, plus |tag|
+ (2~bits)\par
+\hang fourth byte: |remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is |width[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation |width[0]=height[0]=depth[0]=italic[0]=0|
+should always hold, so that an index of zero implies a value of zero.
+The |width_index| should never be zero unless the character does
+not exist in the font, since a character is valid if and only if it lies
+between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at |lig_kern[remainder]|.\par
+\hang|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain. The
+|remainder| field gives the character code of the next larger character.\par
+\hang|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|exten[remainder]|.\par
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word is a
+|lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+ step if the byte is 128 or more, otherwise the next step is obtained by
+ skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+ then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+ a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+Notice that if $a=0$ and $b=1$, the current character is unchanged; if
+$a=b$ and $c=1$, the current character is changed but the next character is
+unchanged. \.{TFtoPL} will check to see that infinite loops are avoided.
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must have
+|256*op_byte+remainder<nl|. If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+command is performed.
+
+@d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@ Extensible characters are specified by an |extensible_recipe|,
+which consists of four bytes called |top|, |mid|,
+|bot|, and |rep| (in this order). These bytes are the character codes
+of individual pieces used to build up a large symbol.
+If |top|, |mid|, or |bot| are zero,
+they are not present in the built-up result. For example, an extensible
+vertical line is like an extensible bracket, except that the top and
+bottom pieces are missing.
+
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=@!slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it's the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character |" "| in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the height of letters for which accents don't
+have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+When the character coding scheme is \.{TeX math symbols}, the font is
+supposed to have 15 additional parameters called |num1|, |num2|, |num3|,
+|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|,
+|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the
+character coding scheme is \.{TeX math extension}, the font is supposed to
+have six additional parameters called |default_rule_thickness| and
+|big_op_spacing1| through |big_op_spacing5|.
+
+@ So that is what \.{TFM} files hold. The next question is, ``What about
+\.{PL} files?'' A complete answer to that question appears in the
+documentation of the companion program, \.{PLtoTF}, so it will not
+be repeated here. Suffice it to say that a \.{PL} file is an ordinary
+\PASCAL\ text file, and that the output of \.{TFtoPL} uses only a
+subset of the possible constructions that might appear in a \.{PL} file.
+Furthermore, hardly anybody really wants to look at the formal
+definition of \.{PL} format, because it is almost self-explanatory when
+you see an example or two.
+
+@<Glob...@>=
+@!pl_file:text;
+
+@ @<Set init...@>=
+rewrite(pl_file);
+
+@* Unpacked representation.
+The first thing \.{TFtoPL} does is read the entire |tfm_file| into an array of
+bytes, |tfm[0..(4*lf-1)]|.
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!index=-1000..tfm_size; {address of a byte in |tfm|}
+@!char_type=0..65535;
+@!xchar_type=0..65536;
+@!xxchar_type=0..65537;
+@!xxxchar_type=0..65538;
+
+@
+@<Glob...@>=
+@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
+ {the negative addresses avoid range checks for invalid characters}
+@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
+@!start_ptr,@!check_sum,@!design_size,@!scheme,@!family,@!random_word:integer;
+@!header_length,@!char_ptr,@!copies,@!j:integer;
+
+@ The input may, of course, be all screwed up and not a \.{TFM} file
+at all. So we begin cautiously.
+
+@d abort(#)==begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a OFM?');
+ goto final_end;
+ end
+
+@<Read the whole input file@>=
+read(tfm_file,tfm[0]);
+if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
+@.The first byte...@>
+if eof(tfm_file) then abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
+if lf=0 then begin
+ for i:=2 to 7 do
+ begin
+ if eof(tfm_file)
+ then abort('The input file is too short to designate its length!');
+ read(tfm_file, tfm[i]);
+ end;
+ ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3];
+ if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!');
+ lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7];
+end
+else
+begin
+ ofm_on := false;
+end;
+case ofm_level of
+-1: begin start_ptr:=2; check_sum:=24; end;
+ 0: begin start_ptr:=8; check_sum:=56; end;
+ 1: begin start_ptr:=8; check_sum:=116; end;
+end;
+design_size:=check_sum+4;
+scheme:=design_size+4;
+family:=scheme+40;
+random_word:=family+20;
+if lf=0 then
+ abort('The file claims to have length zero, but that''s impossible!');
+@.The file claims...@>
+if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+for tfm_ptr:=start_ptr to 4*lf-1 do
+ begin if eof(tfm_file) then
+ abort('The file has fewer bytes than it claims!');
+@.The file has fewer bytes...@>
+ read(tfm_file,tfm[tfm_ptr]);
+ end;
+if not eof(tfm_file) then
+ begin print_ln('There''s some extra junk at the end of the OFM file,');
+@.There's some extra junk...@>
+ print_ln('but I''ll proceed as if it weren''t there.');
+ end
+
+@ After the file has been read successfully, we look at the subfile sizes
+to see if they check out.
+
+@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then
+ abort('One of the subfile sizes is negative!');
+@.One of the subfile sizes...@>
+ #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1];
+ tfm_ptr:=tfm_ptr+2;
+ end
+@d eval_four_bytes(#)==begin if tfm[tfm_ptr]>127 then
+ abort('One of the subfile sizes is negative!');
+@.One of the subfile sizes...@>
+ #:=tfm[tfm_ptr]*@"1000000+tfm[tfm_ptr+1]*@"10000+
+ tfm[tfm_ptr+2]*@"100+tfm[tfm_ptr+3];
+ tfm_ptr:=tfm_ptr+4;
+ end
+
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>=
+begin
+if not ofm_on then begin
+ tfm_ptr:=2;
+ eval_two_bytes(lh);
+ eval_two_bytes(bc);
+ eval_two_bytes(ec);
+ eval_two_bytes(nw);
+ eval_two_bytes(nh);
+ eval_two_bytes(nd);
+ eval_two_bytes(ni);
+ eval_two_bytes(nl);
+ eval_two_bytes(nk);
+ eval_two_bytes(ne);
+ eval_two_bytes(np);
+ ncw:=(ec-bc+1);
+ header_length:=6;
+ top_char:=255;
+ top_width:=255;
+ top_height:=15;
+ top_depth:=15;
+ top_italic:=63;
+ end
+else begin
+ tfm_ptr:=8;
+ eval_four_bytes(lh);
+ eval_four_bytes(bc);
+ eval_four_bytes(ec);
+ eval_four_bytes(nw);
+ eval_four_bytes(nh);
+ eval_four_bytes(nd);
+ eval_four_bytes(ni);
+ eval_four_bytes(nl);
+ eval_four_bytes(nk);
+ eval_four_bytes(ne);
+ eval_four_bytes(np);
+ eval_four_bytes(font_dir);
+ top_char:=65535;
+ top_width:=65535;
+ top_height:=255;
+ top_depth:=255;
+ top_italic:=255;
+ if ofm_level=0 then begin
+ header_length:=14;
+ ncw:=2*(ec-bc+1);
+ end
+ else begin
+ header_length:=29;
+ eval_four_bytes(nco);
+ eval_four_bytes(ncw);
+ eval_four_bytes(npc);
+ eval_four_bytes(nki); {Kinds of font ivalues}
+ eval_four_bytes(nwi); {Words of font ivalues}
+ eval_four_bytes(nkf); {Kinds of font fvalues}
+ eval_four_bytes(nwf); {Words of font fvalues}
+ eval_four_bytes(nkm); {Kinds of font mvalues}
+ eval_four_bytes(nwm); {Words of font mvalues}
+ eval_four_bytes(nkr); {Kinds of font rules}
+ eval_four_bytes(nwr); {Words of font rules}
+ eval_four_bytes(nkg); {Kinds of font glues}
+ eval_four_bytes(nwg); {Words of font glues}
+ eval_four_bytes(nkp); {Kinds of font penalties}
+ eval_four_bytes(nwp); {Words of font penalties}
+ end;
+ end;
+if lf<>(header_length+lh+ncw+nw+nh+nd+ni+2*nl+nk+2*ne+np+
+ nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp) then
+ abort('Subfile sizes don''t add up to the stated total!');
+@.Subfile sizes don't add up...@>
+if lh<2 then abort('The header length is only ',lh:1,'!');
+@.The header length...@>
+if (2*nl)>(4*lig_size) then
+ abort('The lig/kern program is longer than I can handle!');
+@.The lig/kern program...@>
+if (bc>ec+1)or(ec>top_char) then abort('The character code range ',
+@.The character code range...@>
+ bc:1,'..',ec:1,'is illegal!');
+if ec>max_char then
+ abort('Character ',ec:1,'is too large. Ask a wizard to enlarge me.');
+if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
+ abort('Incomplete subfiles for character dimensions!');
+@.Incomplete subfiles...@>
+if ne>(top_char+1) then abort('There are ',ne:1,' extensible recipes!');
+@.There are ... recipes@>
+end
+
+@ Once the input data successfully passes these basic checks,
+\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion
+to \.{PL} format will take place. Access to the various subfiles
+is facilitated by computing the following base addresses. For example,
+the |char_info| for character |c| in a \.{TFM} file will start in location
+|4*(char_base+c)| of the |tfm| array.
+
+@<Globals...@>=
+@!ivalues_start,@!fvalues_start,@!mvalues_start,
+@!rules_start,@!glues_start,@!penalties_start:
+integer;
+@!ivalues_base,@!fvalues_base,@!mvalues_base,
+@!rules_base,@!glues_base,@!penalties_base:
+integer;
+@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base: integer;
+@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
+ {base addresses for the subfiles}
+@!char_start:array [0..max_char] of integer;
+@!bytes_per_entry:integer;
+
+@ @<Compute the base addresses@>=
+begin
+ivalues_start:=header_length+lh;
+fvalues_start:=ivalues_start+nki;
+mvalues_start:=fvalues_start+nkf;
+rules_start:=mvalues_start+nkm;
+glues_start:=rules_start+nkr;
+penalties_start:=glues_start+nkg;
+ivalues_base:=penalties_start+nkp;
+fvalues_base:=ivalues_base+nwi;
+mvalues_base:=fvalues_base+nwf;
+rules_base:=mvalues_base+nwm;
+glues_base:=rules_base+nwr;
+penalties_base:=glues_base+nwg;
+char_base:=penalties_base+nwp;
+bytes_per_entry:=(12 + 2*npc) div 4 * 4;
+if not ofm_on then begin
+ for i:=bc to ec do begin
+ char_start[i]:=4*char_base+4*(i-bc);
+ end;
+ end
+else if ofm_level=0 then begin
+ for i:=bc to ec do begin
+ char_start[i]:=4*char_base+8*(i-bc);
+ end;
+ end
+else begin
+ char_ptr:=4*char_base;
+ i:=bc;
+ while i<=ec do begin
+ copies:=1+256*tfm[char_ptr+8]+tfm[char_ptr+9];
+ for j:=1 to copies do begin
+ char_start[i]:=char_ptr;
+ i:=i+1;
+ end;
+ char_ptr:=char_ptr + bytes_per_entry;
+ end;
+ if char_ptr<>(4*(char_base+ncw)) then
+ abort('Length of char info table does not correspond to specification');
+ end;
+width_base:=char_base+ncw;
+height_base:=width_base+nw;
+depth_base:=height_base+nh;
+italic_base:=depth_base+nd;
+lig_kern_base:=italic_base+ni;
+kern_base:=lig_kern_base+2*nl;
+exten_base:=kern_base+nk;
+param_base:=exten_base+2*ne-1;
+end
+
+@ Of course we want to define macros that suppress the detail of how the
+font information is actually encoded. Each word will be referred to by
+the |tfm| index of its first byte. For example, if |c| is a character
+code between |bc| and |ec|, then |tfm[char_info(c)]| will be the
+first byte of its |char_info|, i.e., the |width_index|; furthermore
+|width(c)| will point to the |fix_word| for |c|'s width.
+
+@d char_info(#)==char_start[#]
+@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0))
+@d width(#)==4*(width_base+width_index(#))
+@d height(#)==4*(height_base+height_index(#))
+@d depth(#)==4*(depth_base+depth_index(#))
+@d italic(#)==4*(italic_base+italic_index(#))
+@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
+@d param(#)==4*(param_base+#) {likewise}
+
+@p function width_index(c:char_type):integer;
+begin if not ofm_on then
+ width_index:=tfm[char_info(c)]
+else
+ width_index:=256*tfm[char_info(c)]+tfm[char_info(c)+1];
+end;
+
+function height_index(c:char_type):integer;
+begin if not ofm_on then
+ height_index:=tfm[char_info(c)+1] div 16
+else
+ height_index:=tfm[char_info(c)+2];
+end;
+
+function depth_index(c:char_type):integer;
+begin if not ofm_on then
+ depth_index:=tfm[char_info(c)+1] mod 16
+else
+ depth_index:=tfm[char_info(c)+3];
+end;
+
+function italic_index(c:char_type):integer;
+begin if not ofm_on then
+ italic_index:=tfm[char_info(c)+2] div 4
+else if ofm_level=0 then
+ italic_index:=tfm[char_info(c)+4]*64 + tfm[char_info(c)+5] div 4
+else
+ italic_index:=tfm[char_info(c)+4];
+end;
+
+function tag(c:char_type):integer;
+begin if not ofm_on then
+ tag:=tfm[char_info(c)+2] mod 4
+else
+ tag:=tfm[char_info(c)+5] mod 4;
+end;
+
+procedure set_no_tag(c:char_type);
+begin if not ofm_on then
+ tfm[char_info(c)+2] := (tfm[char_info(c)+2] div 64)*64 + no_tag
+else
+ tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag;
+end;
+
+function ctag(c:char_type):boolean;
+begin if not (ofm_level=1) then
+ ctag:=false
+else
+ ctag:=tfm[char_info(c)+5] div 4 mod 2;
+end;
+
+procedure set_no_ctag(c:char_type);
+begin if not (ofm_level=1) then
+ tfm[char_info(c)+5] :=
+ tfm[char_info(c)+5] div 8 * 8 + tfm[char_info(c)+5] mod 4;
+end;
+
+function no_repeats(c:char_type):integer;
+begin if ofm_level<=0 then
+ no_repeats:=0
+else
+ no_repeats:=256*tfm[char_info(c)+8]+tfm[char_info(c)+9];
+end;
+
+function char_param(c:char_type; i:integer):integer;
+begin
+ char_param:=256*tfm[char_info(c)+2*i+10]+tfm[char_info(c)+2*i+11];
+end;
+
+function rremainder(c:char_type):integer;
+begin if not ofm_on then
+ rremainder:=tfm[char_info(c)+3]
+else
+ rremainder:=256*tfm[char_info(c)+6]+tfm[char_info(c)+7];
+end;
+
+function lig_step(c:char_type):integer;
+begin if not ofm_on then
+ lig_step:=4*(lig_kern_base+c)
+else
+ lig_step:=4*(lig_kern_base+2*c);
+end;
+
+function exten(c:char_type):integer;
+begin if not ofm_on then
+ exten:=4*(exten_base+rremainder(c))
+else
+ exten:=4*(exten_base+2*rremainder(c));
+end;
+
+function l_skip_byte(c:integer):integer;
+begin if not ofm_on then
+ l_skip_byte:=tfm[c]
+else
+ l_skip_byte:=256*tfm[c]+tfm[c+1];
+end;
+
+procedure set_l_skip_byte(c:integer; newc:integer);
+begin if not ofm_on then
+ tfm[c]:=newc
+else begin
+ tfm[c]:=newc div 256;
+ tfm[c+1]:=newc mod 256
+ end
+end;
+
+function l_next_char(c:integer):integer;
+begin if not ofm_on then
+ l_next_char:=tfm[c+1]
+else
+ l_next_char:=256*tfm[c+2]+tfm[c+3];
+end;
+
+procedure set_l_next_char(c:integer; newc:char_type);
+begin if not ofm_on then
+ tfm[c+1]:=newc
+else begin
+ tfm[c+2]:=newc div 256;
+ tfm[c+3]:=newc mod 256
+ end
+end;
+
+function l_op_byte(c:integer):integer;
+begin if not ofm_on then
+ l_op_byte:=tfm[c+2]
+else
+ l_op_byte:=256*tfm[c+4]+tfm[c+5];
+end;
+
+procedure set_l_op_byte(c:integer; newc:integer);
+begin if not ofm_on then
+ tfm[c+2]:=newc
+else begin
+ tfm[c+2]:=newc div 256;
+ tfm[c+3]:=newc mod 256
+ end
+end;
+
+function l_remainder(c:integer):integer;
+begin if not ofm_on then
+ l_remainder:=tfm[c+3]
+else
+ l_remainder:=256*tfm[c+6]+tfm[c+7];
+end;
+
+procedure set_l_remainder(c:integer; newc:char_type);
+begin if not ofm_on then
+ tfm[c+3]:=newc
+else begin
+ tfm[c+6]:=newc div 256;
+ tfm[c+7]:=newc mod 256
+ end
+end;
+
+@ One of the things we would like to do is take cognizance of fonts whose
+character coding scheme is \.{TeX math symbols} or \.{TeX math extension};
+we will set the |font_type| variable to one of the three choices
+|vanilla|, |mathsy|, or |mathex|.
+
+@d vanilla=0 {not a special scheme}
+@d mathsy=1 {\.{TeX math symbols} scheme}
+@d mathex=2 {\.{TeX math extension} scheme}
+
+@<Glob...@>=
+@!font_type:vanilla..mathex; {is this font special?}
+
+@* Basic output subroutines.
+Let us now define some procedures that will reduce the rest of \.{TFtoPL}'s
+work to a triviality.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{PL} file:
+
+@d out(#)==write(pl_file,#)
+
+@ In order to stick to standard \PASCAL, we use three strings called
+|ASCII_04|, |ASCII_10|, and |ASCII_14|, in terms of which we can do the
+appropriate conversion of ASCII codes. Three other little strings are
+used to produce |face| codes like \.{MIE}.
+
+@<Glob...@>=
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+
+@ @<Set init...@>=
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+HEX:='0123456789ABCDEF';@/
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+
+@ The array |dig| will hold a sequence of digits to be output.
+
+@<Glob...@>=
+@!dig:array[0..32] of integer;
+
+@ Here, in fact, are two procedures that output
+|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
+
+@p procedure out_digs(j:integer); {outputs |j| digits}
+begin repeat decr(j); out(HEX[1+dig[j]]);
+ until j=0;
+end;
+@#
+procedure print_digs(j:integer); {prints |j| digits}
+begin repeat decr(j); print(HEX[1+dig[j]]);
+ until j=0;
+end;
+
+@ The |print_number| procedure indicates how |print_digs| can be used.
+This procedure can print in octal, decimal or hex notation.
+
+@d print_hex(#)==print_number(#,16)
+@d print_octal(#)==print_number(#,8)
+@d print_decimal(#)==print_number(#,10)
+
+@p procedure print_number(c:integer; form:integer); {prints value of |c|}
+var j:0..32; {index into |dig|}
+begin
+j:=0;
+if (c<0) then begin
+ print_ln('Internal error: print_number (negative value)');
+ c:=0;
+ end;
+if form=8 then
+ print('''') {an apostrophe indicates the octal notation}
+else if form=16 then
+ print('"') { a double apostrophe indicates the hexadecimal notation}
+else if form<>10 then begin
+ print_ln('Internal error: print_number (form)');
+ form:=16;
+ end;
+while (c>0) or (j=0) do begin
+ dig[j]:=c mod form; c:=c div form;
+ j:=j+1;
+ end;
+print_digs(j);
+end;
+
+@ A \.{PL} file has nested parentheses, and we want to format the output
+so that its structure is clear. The |level| variable keeps track of the
+depth of nesting.
+
+@<Glob...@>=
+@!level:0..5;
+
+@ @<Set init...@>=
+level:=0;
+
+@ Three simple procedures suffice to produce the desired structure in the
+output.
+
+@p procedure out_ln; {finishes one line, indents the next}
+var l:0..5;
+begin write_ln(pl_file);
+for l:=1 to level do out(' ');
+end;
+@#
+procedure left; {outputs a left parenthesis}
+begin incr(level); out('(');
+end;
+@#
+procedure right; {outputs a right parenthesis and finishes a line}
+begin decr(level); out(')'); out_ln;
+end;
+
+@ The value associated with a property can be output in a variety of
+ways. For example, we might want to output a {\mc BCPL} string that
+begins in |tfm[k]|:
+
+@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space}
+var l:0..39; {the number of bytes remaining}
+begin out(' '); l:=tfm[k];
+while l>0 do
+ begin incr(k); decr(l);
+ case tfm[k] div @'40 of
+ 1: out(ASCII_04[1+(tfm[k] mod @'40)]);
+ 2: out(ASCII_10[1+(tfm[k] mod @'40)]);
+ 3: out(ASCII_14[1+(tfm[k] mod @'40)]);
+ end;
+ end;
+end;
+
+@ The property value might also be a sequence of |l| bytes, beginning
+in |tfm[k]|, that we would like to output in hex notation.
+The following procedure assumes that |l<=4|, but larger values of |l|
+could be handled easily by enlarging the |dig| array and increasing
+the upper bounds on |b| and |j|.
+
+@d out_octal_number(#)==out_number(#,8)
+@d out_decimal_number(#)==out_number(#,10)
+@d out_hex_number(#)==out_number(#,16)
+@d out_dec(#)==out_decimal_number(#)
+@d out_hex_char(#)==out_hex_number(#)
+
+@p procedure out_number(c:integer; form:integer); {outputs value of |c|}
+var j:0..32; {index into |dig|}
+begin
+j:=0;
+if (c<0) then begin
+ print_ln('Internal error: print_number (negative value)');
+ c:=0;
+ end;
+if form=8 then
+ out(' O ')
+else if form=10 then
+ out(' D ')
+else if form=16 then
+ out(' H ')
+else begin
+ print_ln('Internal error: print_number (form)');
+ form:=16;
+ out(' H ')
+ end;
+while (c>0) or (j=0) do begin
+ dig[j]:=c mod form; c:=c div form;
+ j:=j+1;
+ end;
+out_digs(j);
+end;
+@#
+procedure out_hex(@!k,@!l:index);
+ {outputs |l| bytes in hex}
+var a:0..@"7FFFFFFF; {accumulator for bits not yet output}
+@!b:0..32; {the number of significant bits in |a|}
+@!j:0..11; {the number of digits of output}
+begin
+out(' H ');
+a:=0; b:=0; j:=0;
+while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>;
+while (a>0)or(j=0) do begin
+ dig[j]:=a mod 16; a:=a div 16; incr(j);
+ end;
+out_digs(j);
+end;
+
+@ @<Reduce \(1)|l|...@>=
+begin decr(l);
+if tfm[k+l]<>0 then begin
+ while b>3 do begin
+ dig[j]:=a mod 16; a:=a div 16; b:=b-4; incr(j);
+ end;
+ case b of
+ 0: a:=tfm[k+l];
+ 1:a:=a+2*tfm[k+l];
+ 2:a:=a+4*tfm[k+l];
+ 3:a:=a+8*tfm[k+l];
+ end;
+ end;
+b:=b+8;
+end
+
+@ The property value may be a character, which is output in hex
+unless it is a letter or a digit. This procedure is the only place
+where a lowercase letter will be output to the \.{PL} file.
+@^system dependencies@>
+
+@p procedure out_char(@!c:integer); {outputs a character}
+begin if font_type>vanilla then
+ out_hex_char(c)
+else if (c>="0")and(c<="9") then
+ out(' C ',c-"0":1)
+else if (c>="A")and(c<="Z") then
+ out(' C ',ASCII_10[c-"A"+2])
+else if (c>="a")and(c<="z") then
+ out(' C ',ASCII_14[c-"a"+2])
+else out_hex_char(c);
+end;
+
+@ The property value might be a ``face'' byte, which is output in the
+curious code mentioned earlier, provided that it is less than 18.
+
+@p procedure out_face(@!k:index); {outputs a |face|}
+var s:0..1; {the slope}
+@!b:0..8; {the weight and expansion}
+begin if tfm[k]>=18 then out_hex(k,1)
+else begin out(' F '); {specify face-code format}
+ s:=tfm[k] mod 2; b:=tfm[k] div 2;
+ out(MBL_string[1+(b mod 3)]);
+ out(RI_string[1+s]);
+ out(RCE_string[1+(b div 3)]);
+ end;
+end;
+
+@ And finally, the value might be a |fix_word|, which is output in
+decimal notation with just enough decimal places for \.{PLtoTF}
+to recover every bit of the given |fix_word|.
+
+All of the numbers involved in the intermediate calculations of
+this procedure will be nonnegative and less than $10\cdot2^{24}$.
+
+@p procedure out_fix(@!k:index); {outputs a |fix_word|}
+var a:0..@'7777; {accumulator for the integer part}
+@!f:integer; {accumulator for the fraction part}
+@!j:0..12; {index into |dig|}
+@!delta:integer; {amount if allowable inaccuracy}
+begin out(' R '); {specify real format}
+a:=(tfm[k]*16)+(tfm[k+1] div 16);
+f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
+if a>@'3777 then @<Reduce \(2)negative to positive@>;
+@<Output the integer part, |a|, in decimal notation@>;
+@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>;
+end;
+
+@ The following code outputs at least one digit even if |a=0|.
+
+@<Output the integer...@>=
+begin j:=0;
+repeat dig[j]:=a mod 10; a:=a div 10; incr(j);
+until a=0;
+out_digs(j);
+end
+
+@ And the following code outputs at least one digit to the right
+of the decimal point.
+
+@<Output the fraction...@>=
+begin out('.'); f:=10*f+5; delta:=10;
+repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2);
+out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10;
+until f<=delta;
+end;
+
+@ @<Reduce \(2)negative to positive@>=
+begin out('-'); a:=@'10000-a;
+if f>0 then begin
+ f:=@'4000000-f; decr(a);
+ end;
+end
+
+@* Doing it.
+\TeX\ checks the information of a \.{TFM} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. And when it finds something wrong, it justs
+calls the file ``bad,'' without identifying the nature of the problem,
+since \.{TFM} files are supposed to be good almost all of the time.
+
+Of course, a bad file shows up every now and again, and that's where
+\.{TFtoPL} comes in. This program wants to catch at least as many errors as
+\TeX\ does, and to give informative error messages besides.
+All of the errors are corrected, so that the \.{PL} output will
+be correct (unless, of course, the \.{TFM} file was so loused up
+that no attempt is being made to fathom it).
+
+@ Just before each character is processed, its code is printed in hex
+notation. Up to eight such codes appear on a line; so we have a variable
+to keep track of how many are currently there. We also keep track of
+whether or not any errors have had to be corrected.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+@!perfect:boolean; {was the file free of errors?}
+
+@ @<Set init...@>=
+chars_on_line:=0;@/
+perfect:=true; {innocent until proved guilty}
+
+@ Error messages are given with the help of the |bad| and |range_error|
+and |bad_char| macros:
+
+@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print_ln('Bad OFM file: ',#);
+ end
+@.Bad OFM file@>
+@d range_error(#)==begin perfect:=false; print_ln(' ');
+ print(#,' index for character ');
+ print_hex(c); print_ln(' is too large;');
+ print_ln('so I reset it to zero.');
+ end
+@d bad_char_tail(#)==print_hex(#); print_ln('.');
+ end
+@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
+ bad_char_tail
+@d correct_bad_char_tail(#)==#(k,0)
+ end
+@d correct_bad_char_middle(#)==print_hex(#(k)); print_ln('.');
+ correct_bad_char_tail
+@d correct_bad_char(#)== begin perfect:=false;
+ if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
+ correct_bad_char_middle
+
+@<Glob...@>=
+@!i:integer; {an index to words of a subfile}
+@!c:xchar_type; {a random character}
+@!d:0..3; {byte number in a word}
+@!k:index; {a random index}
+@!r:0..65535; {a random two-byte value}
+@!count:0..127; {for when we need to enumerate a small set}
+
+@ There are a lot of simple things to do, and they have to be done one
+at a time, so we might as well get down to business. The first things
+that \.{TFtoPL} will put into the \.{PL} file appear in the header part.
+
+@<Do the header@>=
+begin
+case ofm_level of
+0: begin out('(OFMLEVEL H 0)'); out_ln; end;
+1: begin out('(OFMLEVEL H 1)'); out_ln; end;
+end;
+if ofm_on then begin
+ left;
+ if font_dir<=7 then out('FONTDIR')
+ else out('NFONTDIR');
+ case font_dir mod 8 of
+ 0: out(' TL');
+ 1: out(' LT');
+ 2: out(' TR');
+ 3: out(' LB');
+ 4: out(' BL');
+ 5: out(' RT');
+ 6: out(' BR');
+ 7: out(' RB');
+ end;
+ right
+ end;
+font_type:=vanilla;
+if lh>=12 then begin
+ @<Set the true |font_type|@>;
+ if lh>=17 then begin
+ @<Output the family name@>;
+ if lh>=18 then @<Output the rest of the header@>;
+ end;
+ @<Output the character coding scheme@>;
+ end;
+@<Output the design size@>;
+@<Output the check sum@>;
+@<Output the |seven_bit_safe_flag|@>;
+end
+
+@ @<Output the check sum@>=
+left; out('CHECKSUM'); out_hex(check_sum,4);
+right
+
+@ Incorrect design sizes are changed to 10 points.
+
+@d bad_design(#)==begin bad('Design size ',#,'!');
+@.Design size wrong@>
+ print_ln('I''ve set it to 10 points.');
+ out(' D 10');
+ end
+
+@ @<Output the design size@>=
+left; out('DESIGNSIZE');
+if tfm[design_size]>127 then bad_design('negative')
+else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then
+ bad_design('too small')
+else out_fix(design_size);
+right;
+out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln;
+out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln
+@.DESIGNSIZE IS IN POINTS@>
+
+@ Since we have to check two different {\mc BCPL} strings for validity,
+we might as well write a subroutine to make the check.
+
+@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|}
+var j:index; {runs through the string}
+@!c:integer; {character being checked}
+begin if tfm[k]>=l then
+ begin bad('String is too long; I''ve shortened it drastically.');
+@.String is too long...@>
+ tfm[k]:=1;
+ end;
+for j:=k+1 to k+tfm[k] do
+ begin c:=tfm[j];
+ if (c="(")or(c=")") then
+ begin bad('Parenthesis in string has been changed to slash.');
+@.Parenthesis...changed to slash@>
+ tfm[j]:="/";
+ end
+ else if (c<" ")or(c>"~") then
+ begin bad('Nonstandard ASCII code has been blotted out.');
+@.Nonstandard ASCII code...@>
+ tfm[j]:="?";
+ end
+ else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters}
+ end;
+end;
+
+@ The |font_type| starts out |vanilla|; possibly we need to reset it.
+
+@<Set the true |font_type|@>=
+begin check_BCPL(scheme,40);
+if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@|
+ (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@|
+ (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@|
+ (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@|
+ (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then
+ begin if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy
+ else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex;
+ end;
+end
+
+@ @<Output the character coding scheme@>=
+left; out('CODINGSCHEME');
+out_BCPL(scheme);
+right
+
+@ @<Output the family name@>=
+left; out('FAMILY');
+check_BCPL(family,20);
+out_BCPL(family);
+right
+
+@ @<Output the rest of the header@>=
+begin left; out('FACE'); out_face(random_word+3); right;
+for i:=18 to lh-1 do begin
+ left; out('HEADER D ',i:1);
+ out_hex(check_sum+4*i,@,4); right;
+ end;
+end
+
+@ This program does not check to see if the |seven_bit_safe_flag| has the
+correct setting, i.e., if it really reflects the seven-bit-safety of
+the \.{TFM} file; the stated value is merely put into the \.{PL} file.
+The \.{PLtoTF} program will store a correct value and give a warning
+message if a file falsely claims to be safe.
+
+@<Output the |seven_bit_safe_flag|@>=
+begin left; out('SEVENBITSAFEFLAG FALSE'); right;
+end
+
+@ The next thing to take care of is the list of parameters.
+
+@<Do the parameters@>=
+if np>0 then begin
+ left; out('FONTDIMEN'); out_ln;
+ for i:=1 to np do @<Check and output the $i$th parameter@>;
+ right;
+ end;
+@<Check to see if |np| is complete for this font type@>;
+
+@ @<Check to see if |np|...@>=
+if (font_type=mathsy)and(np<>22) then
+ print_ln('Unusual number of fontdimen parameters for a math symbols font (',
+@.Unusual number of fontdimen...@>
+ np:1,' not 22).')
+else if (font_type=mathex)and(np<>13) then
+ print_ln('Unusual number of fontdimen parameters for an extension font (',
+ np:1,' not 13).')
+
+@ All |fix_word| values except the design size and the first parameter
+will be checked to make sure that they are less than 16.0 in magnitude,
+using the |check_fix| macro:
+
+@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;');
+ print_ln('I have set it to zero.');
+ end
+@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then
+ begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0;
+ check_fix_tail
+
+@<Check and output the $i$th parameter@>=
+begin left;
+if i=1 then out('SLANT') {this parameter is not checked}
+else begin check_fix(param(i))('Parameter');@/
+@.Parameter n is too big@>
+ @<Output the name of parameter $i$@>;
+ end;
+out_fix(param(i)); right;
+end
+
+@ @<Output the name...@>=
+if i<=7 then case i of
+ 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK');
+ 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end
+else if (i<=22)and(font_type=mathsy) then case i of
+ 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3');
+ 11:out('DENOM1');@+12:out('DENOM2');
+ 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3');
+ 16:out('SUB1');@+17:out('SUB2');
+ 18:out('SUPDROP');@+19:out('SUBDROP');
+ 20:out('DELIM1');@+21:out('DELIM2');
+ 22:out('AXISHEIGHT')@+end
+else if (i<=13)and(font_type=mathex) then
+ if i=8 then out('DEFAULTRULETHICKNESS')
+ else out('BIGOPSPACING',i-8:1)
+else out('PARAMETER D ',i:1)
+
+@ @<Glob...@>=
+@!start_counter,@!base_counter,@!number_entries:integer;
+@!value:integer;
+
+@ @<Do the ivalue parameters@>=
+if nki>0 then begin
+ start_counter:=ivalues_start*4;
+ base_counter:=ivalues_base*4;
+ for i:=0 to nki-1 do @<Check and output the $i$th ivalue table@>;
+ end;
+
+@ @<Check and output the $i$th ivalue table@>=
+begin
+left; out('FONTIVALUE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('IVALUE'); out_hex_number(j); out_ln;
+ value:=256*tfm[base_counter+2]+tfm[base_counter+3];
+ left; out('IVALUEVAL'); out_hex_number(value); right;
+ right;
+ base_counter:=base_counter+4;
+ end;
+right;
+start_counter:=start_counter+4;;
+end;
+
+@ @<Do the fvalue parameters@>=
+if nkf>0 then begin
+ start_counter:=fvalues_start*4;
+ base_counter:=fvalues_base*4;
+ for i:=0 to nkf-1 do @<Check and output the $i$th fvalue table@>;
+ end;
+
+@ @<Check and output the $i$th fvalue table@>=
+begin
+left; out('FONTFVALUE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('FVALUE'); out_hex_number(j); out_ln;
+ left; out('FVALUEVAL'); out_fix(base_counter); right;
+ right;
+ base_counter:=base_counter+4;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the mvalue parameters@>=
+if nkm>0 then begin
+ start_counter:=mvalues_start*4;
+ base_counter:=mvalues_base*4;
+ for i:=0 to nkm-1 do @<Check and output the $i$th mvalue table@>;
+ end;
+
+@ @<Check and output the $i$th mvalue table@>=
+begin
+left; out('FONTMVALUE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('MVALUE'); out_hex_number(j); out_ln;
+ left; out('MVALUEVAL'); out_fix(base_counter); right;
+ right;
+ base_counter:=base_counter+4;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the rule parameters@>=
+if nkr>0 then
+ begin
+ start_counter:=rules_start*4;
+ base_counter:=rules_base*4;
+ for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>;
+ end;
+
+@ @<Check and output the $i$th rule table@>=
+begin
+left; out('FONTRULE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('RULE'); out_hex_number(j); out_ln;
+ left; out('RULEWD'); out_fix(base_counter); right;
+ left; out('RULEHT'); out_fix(base_counter+4); right;
+ left; out('RULEDP'); out_fix(base_counter+8); right;
+ right;
+ base_counter:=base_counter+12;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the glue parameters@>=
+if nkg>0 then begin
+ start_counter:=glues_start*4;
+ base_counter:=glues_base*4;
+ for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>;
+ end;
+
+@ @<Glob...@>=
+@!glue_subtype,@!glue_argument_kind,@!glue_stretch_order,
+@!glue_shrink_order,@!glue_argument:integer;
+
+@ @<Check and output the $i$th glue table@>=
+begin
+left; out('FONTGLUE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('GLUE'); out_hex_number(j); out_ln;
+ glue_subtype:=tfm[base_counter] div 16;
+ glue_argument_kind:=tfm[base_counter] mod 16;
+ glue_stretch_order:=tfm[base_counter+1] div 16;
+ glue_shrink_order:=tfm[base_counter+1] mod 16;
+ glue_argument:=tfm[base_counter+2]*256+tfm[base_counter+3];
+ left;
+ out('GLUETYPE');
+ case glue_subtype of
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ end;
+ right;
+ case glue_argument_kind of
+ 1: begin
+ left; out('GLUERULE'); out_hex_number(glue_argument); right;
+ end;
+ 2: begin
+ left; out('GLUECHAR'); out_hex_number(glue_argument); right;
+ end;
+ end;
+ left;
+ out('GLUESTRETCHORDER');
+ case glue_stretch_order of
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ 4: out(' H 4');
+ end;
+ right;
+ left;
+ out('GLUESHRINKORDER');
+ case glue_shrink_order of
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ 4: out(' H 4');
+ end;
+ right;
+ left; out('GLUEWD'); out_fix(base_counter+4); right;
+ left; out('GLUESTRETCH'); out_fix(base_counter+8); right;
+ left; out('GLUESHRINK'); out_fix(base_counter+12); right;
+ right;
+ base_counter:=base_counter+16;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the penalty parameters@>=
+if nkp>0 then begin
+ start_counter:=penalties_start*4;
+ base_counter:=penalties_base*4;
+ for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>;
+ end;
+
+@ @<Check and output the $i$th penalty table@>=
+begin
+left; out('FONTPENALTY'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('PENALTY'); out_hex_number(j); out_ln;
+ value:=256*tfm[base_counter+2]+tfm[base_counter+3];
+ left; out('PENALTYVAL'); out_hex_number(value); right;
+ right;
+ base_counter:=base_counter+4;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ We need to check the range of all the remaining |fix_word| values,
+and to make sure that |width[0]=0|, etc.
+
+@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0)
+
+@<Check the |fix_word| entries@>=
+if nonzero_fix(4*width_base) then bad('width[0] should be zero.');
+@.should be zero@>
+if nonzero_fix(4*height_base) then bad('height[0] should be zero.');
+if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.');
+if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.');
+for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width');
+@.Width n is too big@>
+for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height');
+@.Height n is too big@>
+for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth');
+@.Depth n is too big@>
+for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction');
+@.Italic correction n is too big@>
+if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
+@.Kern n is too big@>
+
+@ The ligature/kerning program comes next. Before we can put it out in
+\.{PL} format, we need to make a table of ``labels'' that will be inserted
+into the program. For each character |c| whose |tag| is |lig_tag| and
+whose starting address is |r|, we will store the pair |(c,r)| in the
+|label_table| array. If there's a boundary-char program starting at~|r|,
+we also store the pair |(256,r)|.
+This array is sorted by its second components, using the
+simple method of straight insertion.
+
+@<Glob...@>=
+@!label_table:array[xxxchar_type] of record
+@!cc:xchar_type;@!rr:0..lig_size;ischar:boolean;end;
+@!label_ptr:xxchar_type; {the largest entry in |label_table|}
+@!sort_ptr:xxchar_type; {index into |label_table|}
+@!boundary_char:xchar_type; {boundary character, or |xmax_char| if none}
+@!bchar_label:0..xmax_label; {beginning of boundary character program}
+
+@ @<Set init...@>=
+boundary_char:=xmax_char; bchar_label:=xmax_label;@/
+label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
+
+@ We'll also identify and remove inaccessible program steps, using the
+|activity| array.
+
+@d unreachable=0 {a program step not known to be reachable}
+@d pass_through=1 {a program step passed through on initialization}
+@d accessible=2 {a program step that can be relevant}
+
+@<Glob...@>=
+@!activity:array[0..lig_size] of unreachable..accessible;
+@!ai,@!acti:0..lig_size; {indices into |activity|}
+
+@ @<Do the ligatures and kerns@>=
+if nl>0 then
+ begin for ai:=0 to (nl-1) do activity[ai]:=unreachable;
+ @<Check for a boundary char@>;
+ end;
+@<Build the label table@>;
+if nl>0 then
+ begin left; out('LIGTABLE'); out_ln;@/
+ @<Compute the |activity| array@>;
+ @<Output and correct the ligature/kern program@>;
+ right;
+ @<Check for ligature cycles@>;
+ end
+
+@ We build the label table even when |nl=0|, because this catches errors
+that would not otherwise be detected.
+
+@<Build...@>=
+for c:=bc to ec do
+if (tag(c)=lig_tag) or (ctag(c)) then begin
+ r:=rremainder(c);
+ if (l_skip_byte(lig_step(r)) div 256)=0 then begin
+ if r<nl then begin
+ if l_skip_byte(lig_step(r))>stop_flag then begin
+ r:=256*l_op_byte(lig_step(r))+l_remainder(lig_step(r));
+ if r<nl then
+ if activity[rremainder(c)]=unreachable then
+ activity[rremainder(c)]:=pass_through;
+ end;
+ end;
+ end;
+ if r>=nl then begin
+ perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for character '); print_hex(c);
+ print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c);
+ set_no_ctag(c);
+@.Ligature/kern starting index...@>
+ end
+ else @<Insert |(c,r)| into |label_table|@>;
+ end;
+label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end}
+
+@ @<Insert |(c,r)|...@>=
+begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+while label_table[sort_ptr].rr>r do begin
+ label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+label_table[sort_ptr+1].ischar:=not ctag(c);
+if ctag(c) then
+ label_table[sort_ptr+1].cc:=char_param(c,0)
+else
+ label_table[sort_ptr+1].cc:=c;
+label_table[sort_ptr+1].rr:=r; {fill the hole}
+incr(label_ptr); activity[r]:=accessible;
+end
+
+@ @<Check for a bound...@>=
+if l_skip_byte(lig_step(0))=255 then begin
+ left; out('BOUNDARYCHAR');
+ boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right;
+ activity[0]:=pass_through;
+ end;
+if l_skip_byte(lig_step(nl-1))=255 then begin
+ r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1));
+ if r>=nl then begin
+ perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for boundarychar is too large;');
+ print_ln('so I removed it.');
+@.Ligature/kern starting index...@>
+ end
+ else begin label_ptr:=1; label_table[1].cc:=xmax_char;
+ label_table[1].rr:=r;
+ bchar_label:=r; activity[r]:=accessible;
+ end;
+ activity[nl-1]:=pass_through;
+ end
+
+@ @<Compute the |activity| array@>=
+for ai:=0 to (nl-1) do
+if (l_skip_byte(lig_step(ai)) div 256)=1 then
+ activity[ai]:=accessible
+else if activity[ai]=accessible then begin
+ r:=l_skip_byte(lig_step(ai));
+ if r<stop_flag then begin
+ r:=r+ai+1;
+ if r>=nl then begin
+ bad('Ligature/kern step ',ai:1,' skips too far;');
+@.Lig...skips too far@>
+ print_ln('I made it stop.'); set_l_skip_byte(lig_step(ai),stop_flag);
+ end
+ else activity[r]:=accessible;
+ end;
+ end
+
+@ We ignore |pass_through| items, which don't need to be mentioned in
+the \.{PL} file.
+
+@<Output and correct the ligature...@>=
+sort_ptr:=1; {point to the next label that will be needed}
+for acti:=0 to nl-1 do if activity[acti]<>pass_through then
+ begin i:=acti; @<Take care of commenting out unreachable steps@>;
+ @<Output any labels for step $i$@>;
+ @<Output step $i$ of the ligature/kern program@>;
+ end;
+if level=2 then right {the final step was unreachable}
+
+@ @<Globals...@>=
+@!output_clabels:array[0..256] of boolean;
+@!clabel_runner:integer;
+
+@ @<Set init...@>=
+for clabel_runner:=0 to 256 do
+ output_clabels[clabel_runner]:=false;
+
+@ @<Output any labels...@>=
+while i=label_table[sort_ptr].rr do begin
+ if not label_table[sort_ptr].ischar then begin
+ if not output_clabels[label_table[sort_ptr].cc] then begin
+ output_clabels[label_table[sort_ptr].cc]:=true;
+ left;
+ out('CLABEL');
+ out_char(label_table[sort_ptr].cc);
+ right;
+ end
+ end
+ else begin
+ left;
+ out('LABEL');
+ if label_table[sort_ptr].cc=xmax_char then out(' BOUNDARYCHAR')
+ else out_char(label_table[sort_ptr].cc);
+ right;
+ end;
+ incr(sort_ptr);
+ end
+
+@ @<Take care of commenting out...@>=
+if activity[i]=unreachable then begin
+ if level=1 then begin
+ left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
+ end
+ end
+else if level=2 then right
+
+@ @<Output step $i$...@>=
+begin k:=lig_step(i);
+if (l_skip_byte(k) div 256)=1 then begin
+ case l_op_byte(k) of
+ 17: begin
+ left; out('CPEN');
+ out_hex_number(l_next_char(k));
+ out_hex_number(l_remainder(k));
+ right;
+ end;
+ 18: begin
+ left; out('CGLUE');
+ out_hex_number(l_next_char(k));
+ out_hex_number(l_remainder(k));
+ right;
+ end;
+ 19: begin
+ left; out('CPENGLUE');
+ out_hex_number(l_next_char(k));
+ out_hex_number(l_remainder(k) div 256);
+ out_hex_number(l_remainder(k) mod 256);
+ right;
+ end;
+ 20: begin
+ left; out('CKRN');
+ out_hex_number(l_next_char(k));
+ r:=l_remainder(k);
+ if r>=nk then begin
+ bad('Kern index too large.');
+@.Kern index too large@>
+ out(' R 0.0');
+ end
+ else out_fix(kern(r));
+ right;
+ end;
+ end;
+ end
+else if l_skip_byte(k)>stop_flag then begin
+ if (256*l_op_byte(k)+l_remainder(k))>=nl then
+ bad('Ligature unconditional stop command address is too big.');
+@.Ligature unconditional stop...@>
+ end
+else if l_op_byte(k)>=kern_flag then @<Output a kern step@>
+else @<Output a ligature step@>;
+if (l_skip_byte(k) mod 256)>0 then
+ if level=1 then @<Output either \.{SKIP} or \.{STOP}@>;
+end
+
+@ The \.{SKIP} command is a bit tricky, because we will be omitting all
+inaccessible commands.
+
+@<Output either...@>=
+begin
+if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)')
+else begin
+ count:=0;
+ for ai:=(i+1) to (i+(l_skip_byte(k) mod 256)) do
+ if activity[ai]=accessible then incr(count);
+ out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares}
+ end;
+out_ln;
+end
+
+@ @<Output a kern step@>=
+begin if nonexistent(l_next_char(k)) then
+ if l_next_char(k)<>boundary_char then
+ correct_bad_char('Kern step for')(l_next_char)(set_l_next_char);
+@.Kern step for nonexistent...@>
+left; out('KRN'); out_char(l_next_char(k));
+r:=256*(l_op_byte(k)-kern_flag)+l_remainder(k);
+if r>=nk then
+ begin bad('Kern index too large.');
+@.Kern index too large@>
+ out(' R 0.0');
+ end
+else out_fix(kern(r));
+right;
+end
+
+@ @<Output a ligature step@>=
+begin
+if nonexistent(l_next_char(k)) then
+ if l_next_char(k)<>boundary_char then
+ correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char);
+@.Ligature step for nonexistent...@>
+if nonexistent(l_remainder(k)) then
+ correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder);
+@.Ligature step produces...@>
+left; r:=l_op_byte(k);
+if (r=4)or((r>7)and(r<>11)) then begin
+ print_ln('Ligature step with nonstandard code changed to LIG');
+ r:=0; set_l_op_byte(k,0);
+ end;
+if r mod 4>1 then out('/');
+out('LIG');
+if odd(r) then out('/');
+while r>3 do begin
+ out('>'); r:=r-4;
+ end;
+out_char(l_next_char(k)); out_char(l_remainder(k)); right;
+end
+
+@ The last thing on \.{TFtoPL}'s agenda is to go through the
+list of |char_info| and spew out the information about each individual
+character.
+
+@<Do the characters@>=
+sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments}
+c:=bc;
+while (c<=ec) do
+begin
+if width_index(c)>0 then begin
+ if chars_on_line=8 then begin
+ print_ln(' '); chars_on_line:=1;
+ end
+ else begin
+ if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+ if no_repeats(c)>0 then begin
+ print_hex(c); print('-'); print_hex(c+no_repeats(c));
+ left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
+ end
+ else begin
+ print_hex(c); {progress report}
+ left; out('CHARACTER'); out_char(c); out_ln;
+ end;
+ @<Output the character's width@>;
+ if height_index(c)>0 then @<Output the character's height@>;
+ if depth_index(c)>0 then @<Output the character's depth@>;
+ if italic_index(c)>0 then @<Output the italic correction@>;
+ case tag(c) of
+ no_tag: do_nothing;
+ lig_tag: @<Output the applicable part of the ligature/kern
+ program as a comment@>;
+ list_tag: @<Output the character link unless there is a problem@>;
+ ext_tag: @<Output an extensible character recipe@>;
+ end; {there are no other cases}
+ for i:=0 to npc-1 do begin
+ if char_param(c,i)<>0 then begin
+ left;
+ if i<nki then begin
+ out('CHARIVALUE'); out_hex_number(i);
+ end
+ else if i<(nki+nkf) then begin
+ out('CHARFVALUE'); out_hex_number(i-nki);
+ end
+ else if i<(nki+nkf+nkr) then begin
+ out('CHARRULE'); out_hex_number(i-nki-nkf);
+ end
+ else if i<(nki+nkf+nkr+nkg) then begin
+ out('CHARGLUE'); out_hex_number(i-nki-nkf-nkr);
+ end
+ else if i<(nki+nkf+nkr+nkg+nkp) then begin
+ out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkr-nkg);
+ end;
+ out_hex_number(char_param(c,i));
+ right;
+ end;
+ end;
+ right;
+ end;
+c:=c+1+no_repeats(c);
+end
+
+@ @<Output the character's width@>=
+if width_index(c)>=nw then range_error('Width')
+@.Width index for char...@>
+else begin left; out('CHARWD'); out_fix(width(c)); right;
+ end
+
+@ @<Output the character's height@>=
+if height_index(c)>=nh then range_error('Height')
+@.Height index for char...@>
+else begin left; out('CHARHT'); out_fix(height(c)); right;
+ end
+
+@ @<Output the character's depth@>=
+if depth_index(c)>=nd then range_error('Depth')
+@.Depth index for char@>
+else begin left; out('CHARDP'); out_fix(depth(c)); right;
+ end
+
+@ @<Output the italic correction@>=
+if italic_index(c)>=ni then range_error('Italic correction')
+@.Italic correction index for char...@>
+else begin left; out('CHARIC'); out_fix(italic(c)); right;
+ end
+
+@ @<Output the applicable part of the ligature...@>=
+begin left; out('COMMENT'); out_ln;@/
+i:=rremainder(c); r:=lig_step(i);
+if (l_skip_byte(r) mod 256)>stop_flag
+then i:=256*l_op_byte(r)+l_remainder(r);
+repeat @<Output step...@>;
+if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl
+else i:=i+1+(l_skip_byte(k) mod 256);
+until i>=nl;
+right;
+end
+
+@ We want to make sure that there is no cycle of characters linked together
+by |list_tag| entries, since such a cycle would get \TeX\ into an endless
+loop. If such a cycle exists, the routine here detects it when processing
+the largest character code in the cycle.
+
+@<Output the character link unless there is a problem@>=
+begin r:=rremainder(c);
+if nonexistent(r) then
+ begin bad_char('Character list link to')(r); set_no_tag(c);
+@.Character list link...@>
+ end
+else begin while (r<c)and(tag(r)=list_tag) do r:=rremainder(r);
+ if r=c then
+ begin bad('Cycle in a character list!');
+@.Cycle in a character list@>
+ print('Character '); print_hex(c);
+ print_ln(' now ends the list.');
+ set_no_tag(c);
+ end
+ else begin left; out('NEXTLARGER'); out_char(rremainder(c));
+ right;
+ end;
+ end;
+end
+
+@ @<Output an extensible character recipe@>=
+if rremainder(c)>=ne then
+ begin range_error('Extensible'); set_no_tag(c);
+@.Extensible index for char@>
+ end
+else begin left; out('VARCHAR'); out_ln;
+ @<Output the extensible pieces that exist@>;
+ right;
+ end
+
+@ @<Glob...@>=
+@!exten_char:integer;
+
+@ @<Output the extensible pieces that...@>=
+for d:=0 to 3 do begin
+ if not ofm_on then begin
+ k:=exten(c)+d;
+ exten_char:=tfm[k];
+ end
+ else begin
+ k:=exten(c)+2*d;
+ exten_char:=256*tfm[k]+tfm[k+1];
+ end;
+ if (d=3)or(exten_char>0) then begin
+ left;
+ case d of
+ 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
+ if nonexistent(exten_char) then out_char(c)
+ else out_char(exten_char);
+ right;
+ end
+ end
+
+@ Some of the extensible recipes may not actually be used, but \TeX\ will
+complain about them anyway if they refer to nonexistent characters.
+Therefore \.{TFtoPL} must check them too.
+
+@<Check the extensible recipes@>=
+if ne>0 then
+ for c:=0 to ne-1 do
+ for d:=0 to 3 do begin
+ if not ofm_on then begin
+ k:=4*(exten_base+c)+d;
+ exten_char:=tfm[k];
+ end
+ else begin
+ k:=4*(exten_base+c)+2*d;
+ exten_char:=256*tfm[k]+tfm[k+1];
+ end;
+ if (exten_char>0)or(d=3) then begin
+ if nonexistent(exten_char) then begin
+ bad_char('Extensible recipe involves the')(exten_char);
+@.Extensible recipe involves...@>
+ if d<3 then begin
+ if not ofm_on then begin
+ tfm[k]:=0;
+ end
+ else begin
+ tfm[k]:=0;
+ tfm[k+1]:=0;
+ end;
+ end;
+ end;
+ end;
+ end
+
+@* Checking for ligature loops.
+We have programmed almost everything but the most interesting calculation of
+all, which has been saved for last as a special treat. \TeX's extended
+ligature mechanism allows unwary users to specify sequences of ligature
+replacements that never terminate. For example, the pair of commands
+$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$
+alternately replaces character $x$ by character $y$ and vice versa. A similar
+loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and
+ \.{(LIG/ $z$ $x$)} occurs in the program for $y$.
+
+More complicated loops are also possible. For example, suppose the ligature
+programs for $x$ and $y$ are
+$$\vcenter{\halign{#\hfil\cr
+\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr
+\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$
+then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$,
+\dots, ad infinitum.
+
+@ To detect such loops, \.{TFtoPL} attempts to evaluate the function
+$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as
+follows: If the current character is $x$ and the next character is
+$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor
+first moves past $y$, the character immediately to its left is
+$f(x,y)$. This function is defined if and only if no infinite loop is
+generated when the cursor is between $x$ and~$y$.
+
+The function $f(x,y)$ can be defined recursively. It turns out that all pairs
+$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$;
+this happens if there's no ligature between $x$ and $y$, or in the cases
+\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a
+\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$;
+then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to
+either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted
+ligature character.
+
+The first two of these classes can be merged; we can also consider
+$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated.
+For technical reasons we allow $x$ to be 256 (for the boundary character
+at the left) or 257 (in cases when an error has been detected).
+
+For each pair $(x,y)$ having a ligature program step, we store
+$(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+@<Glob...@>=
+@!hash:array[0..hash_size] of integer;
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of xxchar_type;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size;
+ {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!x_lig_cycle,@!y_lig_cycle:integer; {problematic ligature pair}
+
+@ @<Check for ligature cycles@>=
+hash_ptr:=0; y_lig_cycle:=xmax_char;
+for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table}
+for c:=bc to ec do if tag(c)=lig_tag then
+ begin i:=rremainder(c);
+ if (l_skip_byte(lig_step(i)) mod 256)>stop_flag then
+ i:=256*l_op_byte(lig_step(i))+l_remainder(lig_step(i));
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if bchar_label<nl then
+ begin c:=xmax_char; i:=bchar_label;
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if hash_ptr=hash_size then
+ begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ goto final_end;
+ end;
+for hh:=1 to hash_ptr do
+ begin r:=hash_list[hh];
+ if class[r]>simple then {make sure $f$ is defined}
+ r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
+ end;
+if y_lig_cycle<xmax_char then
+ begin print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=xmax_char
+ then print('boundary')@+else print_hex(x_lig_cycle);
+ print(' and '); print_hex(y_lig_cycle); print_ln('!');
+ out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
+ end
+
+@ @<Enter data for character $c$...@>=
+repeat hash_input; k:=l_skip_byte(lig_step(i));
+if k>=stop_flag then i:=nl
+else i:=i+1+k;
+until i>=nl
+
+@ We use an ``ordered hash table'' with linear probing, because such a table
+is efficient when the lookup of a random key tends to be unsuccessful.
+
+@p procedure hash_input; {enter data for character |c| and command |i|}
+label 30; {go here for a quick exit}
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:char_type; {function value or ligature character being entered}
+@!y:char_type; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then goto 30;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then goto 30; {unused ligature command}
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+30:end;
+
+@ We must store kern commands as well as ligature commands, because
+the former might make the latter inapplicable.
+
+@<Compute the command param...@>=
+k:=lig_step(i); y:=l_next_char(k); t:=l_op_byte(k);
+cc:=simple; zz:=l_remainder(k);
+if t>=kern_flag then zz:=y
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures.
+Kind of a neat algorithm, generalizing a depth-first search.
+
+@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:index):index| here.
+
+@p function f;
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
+ lig_z[h]:=xxmax_char; class[h]:=simple;
+ end; {the value |xxmax_char| will break all cycles,
+ since it's not in |hash|}
+end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+First comes the |organize| procedure, which reads the input data and
+gets ready for subsequent events. If something goes wrong, the routine
+returns |false|.
+
+@p function organize:boolean;
+label final_end, 30;
+var tfm_ptr:index; {an index into |tfm|}
+begin @<Read the whole input file@>;@/
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;@/
+@<Compute the base addresses@>;@/
+organize:=true; goto 30;
+final_end: organize:=false;
+30: end;
+
+@ Next we do the simple things.
+
+@p procedure do_simple_things;
+var i:integer; {an index to words of a subfile}
+begin @<Do the header@>;@/
+@<Do the parameters@>;@/
+@<Do the ivalue parameters@>;@/
+@<Do the fvalue parameters@>;@/
+@<Do the mvalue parameters@>;@/
+@<Do the rule parameters@>;@/
+@<Do the glue parameters@>;@/
+@<Do the penalty parameters@>;@/
+@<Check the |fix_word| entries@>@/
+end;
+
+@ And then there's a routine for individual characters.
+
+@p procedure do_characters;
+var @!c:integer; {character being done}
+@!k:index; {a random index}
+@!ai:0..lig_size; {index into |activity|}
+begin @<Do the characters@>;@/
+end;
+
+@ Here is where \.{TFtoPL} begins and ends.
+@p begin initialize;@/
+if not organize then goto final_end;
+do_simple_things;@/
+@<Do the ligatures and kerns@>;
+@<Check the extensible recipes@>;
+do_characters; print_ln('.');@/
+if level<>0 then print_ln('This program isn''t working!');
+@.This program isn't working@>
+if not perfect then
+ out('(COMMENT THE OFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)');
+@.THE OFM FILE WAS BAD...@>
+final_end:end.
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TFtoPL} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.ch b/Build/source/texk/web2c/omegaware/opl2ofm.ch
new file mode 100644
index 00000000000..a080c2479ea
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/opl2ofm.ch
@@ -0,0 +1,337 @@
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original pltotf.ch.
+%
+% pltotf.ch for C compilation with web2c.
+%
+% 04/04/83 (PC) Original version, made to work with version 1.2 of PLtoTF.
+% 04/16/83 (PC) Brought up to version 1.3 of PLtoTF.
+% 06/30/83 (HWT) Revised changefile format for version 1.7 Tangle
+% 07/28/83 (HWT) Brought up to version 2
+% 12/19/86 (ETM) Brought up to version 2.1
+% 07/05/87 (ETM) Brought up to version 2.3
+% 03/22/88 (ETM) Converted for use with WEB to C
+% 11/29/89 (KB) Version 3.
+% 01/16/90 (SR) Version 3.2.
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+%\let\maybe=\iffalse
+%\def\title{OPL2OFM changes for C}
+@z
+
+@x [still 2] No banner unless verbose.
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+@z
+
+@x [3] Larger constants.
+@!buf_size=60; {length of lines displayed in error messages}
+@y
+@!buf_size=3000; {max input line length, output error line length}
+@z
+%@x
+%@!max_lig_steps=5000;
+% {maximum length of ligature program, must be at most $32767-257=32510$}
+%@!max_kerns=500; {the maximum number of distinct kern values}
+%@!hash_size=5003; {preferably a prime number, a bit larger than the number
+% of character pairs in lig/kern steps}
+%@y
+%@!max_lig_steps=32500;
+% {maximum length of ligature program, must be at most $32767-257=32510$}
+%@!max_kerns=15000; {the maximum number of distinct kern values}
+%@!hash_size=15077; {preferably a prime number, a bit larger than the number
+% of character pairs in lig/kern steps}
+%@z
+
+@x [6] Open PL file.
+reset(pl_file);
+@y
+reset (pl_file, pl_name);
+if verbose then begin
+ print (banner);
+ print_ln (version_string);
+end;
+@z
+
+@x [16] Open TFM file.
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(tfm_file);
+@y
+@ On some systems you may have to do something special to write a
+packed file of bytes. It's no problem in C.
+@^system dependencies@>
+
+@<Set init...@>=
+rewritebin (tfm_file, tfm_name);
+@z
+
+@x [79] `index' might be a library routine.
+|k|th element of its list.
+@y
+|k|th element of its list.
+@d index == index_var
+@z
+
+@x [103] No output (except errors) unless verbose.
+@<Print |c| in hex notation@>;
+@y
+if verbose then @<Print |c| in hex notation@>;
+@z
+
+% [27, 28] Change strings to C char pointers. The Pascal strings are
+% indexed starting at 1, so we pad with a blank.
+@x
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+@y
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string;
+ {strings for output in the user's external character set}
+@!ASCII_all: packed array[0..256] of char;
+@!MBL_string,@!RI_string,@!RCE_string: c_string;
+ {handy string constants for |face| codes}
+@z
+
+@x
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+HEX:='0123456789ABCDEF';@/
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+@y
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+HEX:=' 0123456789ABCDEF';@/
+strcpy (ASCII_all, ASCII_04);
+strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
+strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/
+MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE';
+@z
+
+@x [115] Output of reals.
+@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
+@.I had to round...@>
+ #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
+@y
+@ @d round_message(#)==if delta>0 then begin print('I had to round some ',
+@.I had to round...@>
+ #,'s by '); print_real((((delta+1) div 2)/@'4000000),1,7);
+ print_ln(' units.'); end
+@z
+
+% [118] Change the name of the variable `class', since AIX 3.1's <math.h>
+% defines a function by that name.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d pending=4 {$f(x,y)$ is being evaluated}
+@y
+@d pending=4 {$f(x,y)$ is being evaluated}
+@d class == class_var {Avoid problems with AIX \.{<math.h>}}
+@z
+
+% [123] web2c can't handle these mutually recursive procedures.
+% But let's do a fake definition of f here, so that it gets into web2c's
+% symbol table...
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+@y
+@p
+ifdef('notdef')
+function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+endif('notdef')
+@z
+
+% [124] ... and then really define it now.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p function f;
+@y
+@p function f(@!h,@!x,@!y:indx):indx;
+@z
+
+@x [127] Fix up output of bytes.
+@d out(#)==write(tfm_file,#)
+@y
+@d out(#)==putbyte(#,tfm_file)
+@z
+
+@x [136] Fix output of reals.
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if abs(x/design_units)>=16.0 then begin
+ print_ln('The relative dimension ',x/@'4000000:1:3,
+ ' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then print(' =',design_units/@'200000:1:3,
+ ' designunits');
+@y
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if fabs(x/design_units)>=16.0 then begin
+ print('The relative dimension ');
+ print_real(x/@'4000000,1,3);
+ print_ln(' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then begin print(' =');
+ print_real(design_units/@'200000,1,3);
+ print(' designunits');
+ end;
+@z
+
+% [141] char_remainder[c] is unsigned, and label_table[sort_ptr].rr
+% might be -1, and if -1 is coerced to being unsigned, it will be bigger
+% than anything else.
+@x
+ while label_table[sort_ptr].rr>char_remainder[c] do begin
+@y
+ while label_table[sort_ptr].rr>intcast(char_remainder[c]) do begin
+@z
+
+@x [147] Be quiet unless verbose.
+read_input; print('.');@/
+@y
+read_input;
+if verbose then print_ln('.');
+@z
+
+@x [148] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PLtoTF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 3; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('opl2ofm');
+
+ end else if argument_is ('help') then begin
+ usage_help (OPL2OFM_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit
+ (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one or two remaining arguments.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ write_ln (stderr, 'opl2ofm: Need one or two file arguments.');
+ usage ('opl2ofm');
+ end;
+
+ pl_name := extend_filename (cmdline (optind), 'opl');
+
+ {If an explicit output filename isn't given, construct it from |pl_name|.}
+ if optind + 2 = argc then begin
+ tfm_name := extend_filename (cmdline (optind + 1), 'ofm');
+ end else begin
+ tfm_name := basename_change_suffix (pl_name, '.opl', '.ofm');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@
+@<Initialize the option...@> =
+verbose := false;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!tfm_name,@!pl_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.web b/Build/source/texk/web2c/omegaware/opl2ofm.web
new file mode 100644
index 00000000000..df91a25dfee
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/opl2ofm.web
@@ -0,0 +1,4363 @@
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+% applies only to the changes to the original pltotf.web
+%
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was implemented in January 1982.
+% In February 1982 a new restriction on ligature steps was added.
+% In June 1982 the routines were divided into smaller pieces for IBM people.
+% Hex was added in September 1982, and the result became "Version 1".
+% Version 1.1 fixed a bug in section 28 (since eoln is undefined after eof).
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 1.2 fixed a bug in section 115 (TOP, MID, and BOT can be zero)
+% Version 1.3 (April 1983) blanked out unused BCPL header bytes
+% Version 2 (July 1983) was released with TeX version 0.999.
+% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN.
+% Version 2.2 (May 1985) added checksum computation to match METAFONT.
+% Version 2.3 (August 1985) introduced `backup' to fix a minor bug.
+% Version 3 (October 1989) introduced extended ligature features.
+% Version 3.1 (November 1989) fixed two bugs (notably min_nl:=0).
+% Version 3.2 (December 1989) improved `shorten', increased max_letters.
+% Version 3.3 (September 1990) fixed `nonexistent char 0' (John Gourlay).
+% Version 3.4 (March 1991) has more robust `out_scaled' (Wayne Sullivan).
+% Version 3.5 (March 1995) initialized lk_step_ended (Armin K\"ollner).
+
+% Version 1.0 of OPL2OFM (March 1997) allows one to read OPL files
+% and generate OFM files.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=logo10 % for the METAFONT logo
+\def\MF{{\logo METAFONT}}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{OPL2OFM}
+\def\contentspagenumber{301}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont OPL2OFM} processor}
+ \vskip 15pt
+ \centerline{(Version 1.11, February 2000)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of the original report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{OPL2OFM} utility program converts property-list (``\.{PL}''
+and (``\.{OPL}'') files into equivalent \TeX\ and $\Omega$ font metric
+(``\.{TFM}'' and ``\.{OFM}) files. It also makes a thorough check of
+the given \.{PL} or \.{OPL} file, so that the \.{TFM} or \.{OFM} file
+should be acceptable to \TeX\ or $\Omega$.
+
+The first \.{PLtoTF} program was designed by Leo Guibas in the summer of
+1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw
+also had a significant effect on the evolution of the present code.
+
+Extensions for an enhanced ligature mechanism were added by D. E. Knuth
+in 1989.
+
+Extensions to handle extended font metric files (``\.{OFM}'') were
+added by John Plaice in December 1995 and January 1996, resulting in the
+new program \.{OPLtoOFM}. In the following documentation, all unchanged
+references to the \.{PLtoTF} program and to \.{TFM} and \.{PL} files also
+apply to the \.{OPLtoOFM} program and to \.{OFM} and \.{OPL} files.
+
+The |banner| string defined here should be changed whenever \.{OPLtoOFM}
+gets modified.
+
+@d banner=='This is OPL2OFM, Version 1.11'
+
+@ This program is written entirely in standard \PASCAL, except that
+it has to do some slightly system-dependent character code conversion
+on input. Furthermore, lower case letters are used in error messages;
+they could be converted to upper case if necessary. The input is read
+from |pl_file|, and the output is written on |tfm_file|; error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program OPL2OFM(@!pl_file,@!tfm_file,@!output);
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{PLtoTF}'s capacity.
+
+@<Constants...@>=
+@!buf_size=60; {length of lines displayed in error messages}
+@!max_header_bytes=100; {four times the maximum number of words allowed in
+ the \.{TFM} file header block, must be 1024 or less}
+@!max_param_words=100; {the maximum number of \.{fontdimen} parameters allowed}
+@!max_lig_steps=800000;
+ {maximum length of ligature program, must be at most $32767-257=32510$}
+@!xmax_label=800001;
+@!max_kerns=50000; {the maximum number of distinct kern values}
+@!hash_size=130003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@!hash_mult=16007; {another prime}
+@!tfm_size=2000000; {maximum length of |tfm| data, in bytes}
+@!lig_size=800000; {maximum length of |lig_kern| program, in words}
+@!max_char=65535; {the largest character number in a font}
+@!xmax_char=65536; {|max_char|+1}
+@!xxmax_char=65537;{|max_char|+2}
+@!xxxmax_char=65538;{|max_char|+3}
+@!mem_size=262144; {|max_char|*4+8}
+@!max_width=65535; {the largest character width number}
+@!max_height=255; {the largest character height number}
+@!max_depth=255; {the largest character depth number}
+@!max_italic=255; {the largest character italic correction number}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* Property list description of font metric data.
+The idea behind \.{PL} files is that precise details about fonts, i.e., the
+facts that are needed by typesetting routines like \TeX, sometimes have to
+be supplied by hand. The nested property-list format provides a reasonably
+convenient way to do this.
+
+A good deal of computation is necessary to parse and process a
+\.{PL} file, so it would be inappropriate for \TeX\ itself to do this
+every time it loads a font. \TeX\ deals only with the compact descriptions
+of font metric data that appear in \.{TFM} files. Such data is so compact,
+however, it is almost impossible for anybody but a computer to read it.
+The purpose of \.{PLtoTF} is to convert from a human-oriented file of text
+to a computer-oriented file of binary numbers.
+
+@<Glob...@>=
+@!pl_file:text;
+
+@ @<Set init...@>=
+reset(pl_file);
+
+@ A \.{PL} file is a list of entries of the form
+$$\.{(PROPERTYNAME VALUE)}$$
+where the property name is one of a finite set of names understood by
+this program, and the value may itself in turn be a property list.
+The idea is best understood by looking at an example, so let's consider
+a fragment of the \.{PL} file for a hypothetical font.
+$$\vbox{\halign{\.{#}\hfil\cr
+(FAMILY NOVA)\cr
+(FACE F MIE)\cr
+(CODINGSCHEME ASCII)\cr
+(DESIGNSIZE D 10)\cr
+(DESIGNUNITS D 18)\cr
+(COMMENT A COMMENT IS IGNORED)\cr
+(COMMENT (EXCEPT THIS ONE ISN'T))\cr
+(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr
+\qquad\qquad IT SAYS IT ISN'T))\cr
+(FONTDIMEN\cr
+\qquad (SLANT R -.25)\cr
+\qquad (SPACE D 6)\cr
+\qquad (SHRINK D 2)\cr
+\qquad (STRETCH D 3)\cr
+\qquad (XHEIGHT R 10.55)\cr
+\qquad (QUAD D 18)\cr
+\qquad )\cr
+(LIGTABLE\cr
+\qquad (LABEL C f)\cr
+\qquad (LIG C f O 200)\cr
+\qquad (SKIP D 1)\cr
+\qquad (LABEL O 200)\cr
+\qquad (LIG C i O 201)\cr
+\qquad (KRN O 51 R 1.5)\cr
+\qquad (/LIG C ? C f)\cr
+\qquad (STOP)\cr
+\qquad )\cr
+(CHARACTER C f\cr
+\qquad (CHARWD D 6)\cr
+\qquad (CHARHT R 13.5)\cr
+\qquad (CHARIC R 1.5)\cr
+\qquad )\cr}}$$
+This example says that the font whose metric information is being described
+belongs to the hypothetical
+\.{NOVA} family; its face code is medium italic extended;
+and the characters appear in ASCII code positions. The design size is 10 points,
+and all other sizes in this \.{PL} file are given in units such that 18 units
+equals the design size. The font is slanted with a slope of $-.25$ (hence the
+letters actually slant backward---perhaps that is why the family name is
+\.{NOVA}). The normal space between words is 6 units (i.e., one third of
+the 18-unit design size), with glue that shrinks by 2 units or stretches by 3.
+The letters for which accents don't need to be raised or lowered are 10.55
+units high, and one em equals 18 units.
+
+The example ligature table is a bit trickier. It specifies that the
+letter \.f followed by another \.f is changed to code @'200, while
+code @'200 followed by \.i is changed to @'201; presumably codes @'200
+and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases
+\.f and @'200, if the following character is the code @'51 (which is a
+right parenthesis), an additional 1.5 units of space should be inserted
+before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or
+\.{KRN} command, which in this case is the second \.{LIG}; in this way
+two different ligature/kern programs can come together.)
+Finally, if either \.f or @'200 is followed by a question mark,
+the question mark is replaced by \.f and the ligature program is
+started over. (Thus, the character pair `\.{f?}' would actually become
+the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To
+avoid this restart procedure, the \.{/LIG} command could be replaced
+by \.{/LIG>}; then `\.{f?} would become `f\kern0ptf' and `\.{f?f}'
+would become `f\kern0ptff'.)
+
+Character \.f itself is 6 units wide and 13.5 units tall, in this example.
+Its depth is zero (since \.{CHARDP} is not given), and its italic correction
+is 1.5 units.
+
+@ The example above illustrates most of the features found in \.{PL} files.
+Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a
+string as their value; this string continues until the first unmatched
+right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT}
+and \.{LABEL}, take a number as their value. This number can be expressed in
+a variety of ways, indicated by a prefixed code; \.D stands for decimal,
+\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and
+\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as
+their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and
+\.{CHARACTER}, have more complicated values that involve property lists.
+
+A property name is supposed to be used only in an appropriate property
+list. For example, \.{CHARWD} shouldn't occur on the outer level or
+within \.{FONTDIMEN}.
+
+The individual property-and-value pairs in a property list can appear in
+any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the above
+example, although the \.{TFM} file always puts the stretch parameter first.
+One could even give the information about characters like `\.f' before
+specifying the number of units in the design size, or before specifying the
+ligature and kerning table. However, the \.{LIGTABLE} itself is an exception
+to this rule; the individual elements of the \.{LIGTABLE} property list
+can be reordered only to a certain extent without changing the meaning
+of that table.
+
+If property-and-value pairs are omitted, a default value is used. For example,
+we have already noted that the default for \.{CHARDP} is zero. The default
+for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated
+below.
+
+If the same property name is used more than once, \.{PLtoTF} will not notice
+the discrepancy; it simply uses the final value given. Once again, however, the
+\.{LIGTABLE} is an exception to this rule; \.{PLtoTF} will complain if there
+is more than one label for some character. And of course many of the
+entries in the \.{LIGTABLE} property list have the same property name.
+
+From these rules, you can guess (correctly) that \.{PLtoTF} operates in four
+main steps. First it assigns the default values to all properties; then it scans
+through the \.{PL} file, changing property values as new ones are seen; then
+it checks the information and corrects any problems; and finally it outputs
+the \.{TFM} file.
+
+@ Instead of relying on a hypothetical example, let's consider a complete
+grammar for \.{PL} files. At the outer level, the following property names
+are valid:
+
+\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a
+nonnegative integer less than $2^{32}$, is used to identify a particular
+version of a font; it should match the check sum value stored with the font
+itself. An explicit check sum of zero is used to bypass
+check sum testing. If no checksum is specified in the \.{PL} file,
+\.{PLtoTF} will compute the checksum that \MF\ would compute from the
+same data.
+
+\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which
+should be a real number in the range |1.0<=x<2048|, represents the default
+amount by which all quantities will be scaled if the font is not loaded
+with an `\.{at}' specification. For example, if one says
+`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM}
+file is ignored and effectively replaced by 15 points; but if one simply
+says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is
+always in units of printer's points.
+
+\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value
+should be a positive real number; it says how many units equals the design
+size (or the eventual `\.{at}' size, if the font is being scaled). For
+example, suppose you have a font that has been digitized with 600 pixels per
+em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}'
+if you wanted to give all of your measurements in units of pixels.
+
+\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 40.
+It identifies the correspondence between the numeric codes and font characters.
+(\TeX\ ignores this information, but other software programs make use of it.)
+
+\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 20.
+It identifies the name of the family to which this font belongs, e.g.,
+`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for
+example, when converting \.{DVI} files to \.{PRESS} files for Xerox
+equipment.)
+
+\yskip\hang\.{FACE} (one-byte value). This number, which must lie between
+0 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its
+family. For example, bold italic condensed fonts might have the same family name
+as light roman extended fonts, differing only in their face byte. (\TeX\
+ignores this information; but it is needed, for example, when converting
+\.{DVI} files to \.{PRESS} files for Xerox equipment.)
+
+\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The
+value should start with either `\.T' (true) or `\.F' (false). If true, character
+codes less than 128 cannot lead to codes of 128 or more via ligatures or
+charlists or extensible characters. (\TeX82 ignores this flag, but older
+versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.)
+\.{PLtoTF} computes the correct value of this flag and gives an error message
+only if a claimed ``true'' value is incorrect.
+
+\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value).
+The one-byte value should be between 18 and a maximum limit that can be
+raised or lowered depending on the compile-time setting of |max_header_bytes|.
+The four-byte value goes into the header word whose index is the one-byte
+value; for example, to set |header[18]:=1|, one may write
+`\.{(HEADER D 18 O 1)}'. This notation is used for header information that
+is presently unnamed. (\TeX\ ignores it.)
+
+\yskip\hang\.{FONTDIMEN} (property list value). See below for the names
+allowed in this property list.
+
+\yskip\hang\.{LIGTABLE} (property list value). See below for the rules
+about this special kind of property list.
+
+\yskip\hang\.{BOUNDARYCHAR} (integer value). If this character appears in
+a \.{LIGTABLE} command, it matches ``end of word'' as well as itself.
+If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs
+within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning.
+
+\yskip\hang\.{CHARACTER}. The value is an integer followed by
+a property list. The integer represents the number of a character that is
+present in the font; the property list of a character is defined below.
+The default is an empty property list.
+
+@ Numeric property list values can be given in various forms identified by
+a prefixed letter.
+
+\yskip\hang\.C denotes an ASCII character, which should be a standard visible
+character that is not a parenthesis. The numeric value will therefore be
+between @'41 and @'176 but not @'50 or @'51.
+
+\yskip\hang\.D denotes a decimal integer, which must be nonnegative and
+less than 256. (Use \.R for larger values or for negative values.)
+
+\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes
+are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC},
+\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE},
+\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively.
+
+\yskip\hang\.O denotes an unsigned octal integer, which must be less than
+$2^{32}$, i.e., at most `\.{O 37777777777}'.
+
+\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than
+$2^{32}$, i.e., at most `\.{H FFFFFFFF}'.
+
+\yskip\hang\.R denotes a real number in decimal notation, optionally preceded
+by a `\.+' or `\.-' sign, and optionally including a decimal point. The
+absolute value must be less than 2048.
+
+@ The property names allowed in a \.{FONTDIMEN} property list correspond to
+various \TeX\ parameters, each of which has a (real) numeric value. All
+of the parameters except \.{SLANT} are in design units. The admissible
+names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT},
+\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1},
+\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP},
+\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters
+1~to~22. The alternate names \.{DEFAULTRULETHICKNESS},
+\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3},
+\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters
+8 to 13.
+
+The notation `\.{PARAMETER} $n$' provides another way to specify the
+$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way
+to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive
+and less than |max_param_words|.
+
+@ The elements of a \.{CHARACTER} property list can be of six different types.
+
+\yskip\hang\.{CHARWD} (real value) denotes the character's width in
+design units.
+
+\yskip\hang\.{CHARHT} (real value) denotes the character's height in
+design units.
+
+\yskip\hang\.{CHARDP} (real value) denotes the character's depth in
+design units.
+
+\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in
+design units.
+
+\yskip\hang\.{NEXTLARGER} (integer value), specifies the character that
+follows the present one in a ``charlist.'' The value must be the number of a
+character in the font, and there must be no infinite cycles of supposedly
+larger and larger characters.
+
+\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character.
+This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot
+both be used within the same \.{CHARACTER} list.
+
+\yskip\noindent
+The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID},
+\.{BOT} or \.{REP}; the values are integers, which must be zero or the number
+of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means
+that the corresponding piece of the extensible character is absent. A nonzero
+value, or a \.{REP} value of zero, denotes the character code used to make
+up the top, middle, bottom, or replicated piece of an extensible character.
+
+@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a
+program in a simple command language that \TeX\ uses for ligatures and kerns.
+If several \.{LIGTABLE} lists appear, they are effectively concatenated into
+a single list.
+
+\yskip\hang\.{LABEL} (integer value) means that the program for the
+stated character value starts here. The integer must be the number of a
+character in the font; its \.{CHARACTER} property list must not have a
+\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step
+must follow.
+
+\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for
+beginning-of-word ligatures starts here.
+
+\yskip\hang\.{LIG} (two integer values). The instruction `\.{(LIG} $c$ $r$\.)'
+means, ``If the next character is $c$, then insert character~$r$ and
+possibly delete the current character and/or~$c$;
+otherwise go on to the next instruction.''
+Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately
+preceded or followed by a slash, and then immediately followed by \.>
+characters not exceeding the number of slashes. Thus there are eight
+possible forms:
+$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil
+\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$
+The slashes specify retention of the left or right original character; the
+\.> signs specify passing over the result without further ligature processing.
+
+\yskip\hang\.{KRN} (an integer value and a real value). The instruction
+`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert
+a blank space of width $r$ between the current character character and $c$;
+otherwise go on to the next intruction.'' The value of $r$, which is in
+units of the design size, is often negative. Character code $c$ must exist
+in the font.
+
+\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
+It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL}
+or \.{STOP} or \.{SKIP}.
+
+\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies
+continuation of a ligature/kern program after the specified number of \.{LIG}
+or \.{KRN} has been skipped over. The number of subsequent \.{LIG} and \.{KRN}
+instructions must therefore exceed this specified amount.
+
+@ In addition to all these possibilities, the property name \.{COMMENT} is
+allowed in any property list. Such comments are ignored.
+
+@ So that is what \.{PL} files hold. The next question is, ``What about
+\.{TFM} files?'' A complete answer to that question appears in the
+documentation of the companion program, \.{TFtoPL}, so it will not
+be repeated here. Suffice it to say that a \.{TFM} file stores all of the
+relevant font information in a sequence of 8-bit bytes. The number of
+bytes is always a multiple of 4, so we could regard the \.{TFM} file
+as a sequence of 32-bit words; but \TeX\ uses the byte interpretation,
+and so does \.{PLtoTF}. Note that the bytes are considered to be unsigned
+numbers.
+
+@<Glob...@>=
+@!tfm_file:packed file of 0..255;
+
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(tfm_file);
+
+@* Basic input routines.
+For the purposes of this program, a |byte| is an unsigned 16-bit quantity,
+and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes
+correspond to one-character constants like \.{"A"} in \.{WEB} language.
+
+@<Types...@>=
+@!byte=0..65535; {unsigned sixteen-bit quantity}
+@!ASCII_code=@'40..@'177; {standard ASCII code numbers}
+
+@ One of the things \.{PLtoTF} has to do is convert characters of strings
+to ASCII form, since that is the code used for the family name and the
+coding scheme in a \.{TFM} file. An array |xord| is used to do the
+conversion from |char|; the method below should work with little or no change
+on most \PASCAL\ systems.
+@^system dependencies@>
+
+@d first_ord=0 {ordinal number of the smallest element of |char|}
+@d last_ord=127 {ordinal number of the largest element of |char|}
+
+@<Global...@>=
+@!xord:array[char] of ASCII_code; {conversion table}
+
+@ @<Local variables for init...@>=
+@!k:integer; {all-purpose initialization index}
+
+@ Characters that should not appear in \.{PL} files (except in comments)
+are mapped into @'177.
+
+@d invalid_code=@'177 {code deserving an error message}
+
+@<Set init...@>=
+for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code;
+xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#";
+xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'";
+xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=",";
+xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1";
+xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6";
+xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";";
+xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?";
+xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C";
+xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H";
+xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M";
+xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R";
+xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W";
+xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\";
+xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a";
+xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f";
+xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k";
+xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p";
+xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u";
+xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z";
+xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~";
+
+@ In order to help catch errors of badly nested parentheses, \.{PLtoTF}
+assumes that the user will begin each line with a number of blank spaces equal
+to some constant times the number of open parentheses at the beginning of
+that line. However, the program doesn't know in advance what the constant
+is, nor does it want to print an error message on every line for a user
+who has followed no consistent pattern of indentation.
+
+Therefore the following strategy is adopted: If the user has been consistent
+with indentation for ten or more lines, an indentation error will be
+reported. The constant of indentation is reset on every line that should
+have nonzero indentation.
+
+@<Glob...@>=
+@!line:integer; {the number of the current line}
+@!good_indent:integer; {the number of lines since the last bad indentation}
+@!indent: integer; {the number of spaces per open parenthesis, zero if unknown}
+@!level: integer; {the current number of open parentheses}
+
+@ @<Set init...@>=
+line:=0; good_indent:=0; indent:=0; level:=0;
+
+@ The input need not really be broken into lines of any maximum length, and
+we could read it character by character without any buffering. But we shall
+place it into a small buffer so that offending lines can be displayed in error
+messages.
+
+@<Glob...@>=
+@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer
+ at end-of-line marks?}
+@!limit:0..buf_size; {position of the last character present in the buffer}
+@!loc:0..buf_size; {position of the last character read in the buffer}
+@!buffer:array[1..buf_size] of char;
+@!input_has_ended:boolean; {there is no more input to read}
+
+@ @<Set init...@>=
+limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false;
+
+@ Just before each \.{CHARACTER} property list is evaluated, the character
+code is printed in octal notation. Up to eight such codes appear on a line;
+so we have a variable to keep track of how many are currently there.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+
+@ @<Set init...@>=
+chars_on_line:=0;
+
+@ The following routine prints an error message and an indication of
+where the error was detected. The error message should not include any
+final punctuation, since this procedure supplies its own.
+
+@d err_print(#)==begin if chars_on_line>0 then print_ln(' ');
+ print(#); show_error_context;
+ end
+
+@p procedure show_error_context; {prints the current scanner location}
+var k:0..buf_size; {an index into |buffer|}
+begin print_ln(' (line ',line:1,').');
+if not left_ln then print('...');
+for k:=1 to loc do print(buffer[k]); {print the characters already scanned}
+print_ln(' ');
+if not left_ln then print(' ');
+for k:=1 to loc do print(' '); {space out the second line}
+for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen}
+if right_ln then print_ln(' ')@+else print_ln('...');
+chars_on_line:=0;
+end;
+
+@ Here is a procedure that does the right thing when we are done
+reading the present contents of the buffer. It keeps |buffer[buf_size]|
+empty, in order to avoid range errors on certain \PASCAL\ compilers.
+
+An infinite sequence of right parentheses is placed at the end of the
+file, so that the program is sure to get out of whatever level of nesting
+it is in.
+
+On some systems it is desirable to modify this code so that tab marks
+in the buffer are replaced by blank spaces. (Simply setting
+|xord[chr(@'11)]:=" "| would not work; for example, two-line
+error messages would not come out properly aligned.)
+@^system dependencies@>
+
+@p procedure fill_buffer;
+begin left_ln:=right_ln; limit:=0; loc:=0;
+if left_ln then begin
+ if line>0 then read_ln(pl_file);
+ incr(line);
+ end;
+if eof(pl_file) then begin
+ limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
+ end
+else begin
+ while (limit<buf_size-1)and(not eoln(pl_file)) do begin
+ incr(limit); read(pl_file,buffer[limit]);
+ end;
+ buffer[limit+1]:=' '; right_ln:=eoln(pl_file);
+ if left_ln then @<Set |loc| to the number of leading blanks in
+ the buffer, and check the indentation@>;
+ end;
+end;
+
+@ The interesting part about |fill_buffer| is the part that learns what
+indentation conventions the user is following, if any.
+
+@d bad_indent(#)==begin if good_indent>=10 then err_print(#);
+ good_indent:=0; indent:=0;
+ end
+
+@<Set |loc|...@>=
+begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
+if loc<limit then begin
+ if level=0 then
+ if loc=0 then incr(good_indent)
+ else bad_indent('Warning: Indented line occurred at level zero')
+@.Warning: Indented line...@>
+ else if indent=0 then
+ if loc mod level=0 then begin
+ indent:=loc div level; good_indent:=1;
+ end
+ else good_indent:=0
+ else if indent*level=loc then incr(good_indent)
+ else bad_indent('Warning: Inconsistent indentation; ',
+@.Warning: Inconsistent indentation...@>
+ 'you are at parenthesis level ',level:1);
+ end;
+end
+
+@* Basic scanning routines.
+The global variable |cur_char| holds the ASCII code corresponding to the
+character most recently read from the input buffer, or to a character that
+has been substituted for the real one.
+
+@<Global...@>=
+@!cur_char:ASCII_code; {we have just read this}
+
+@ Here is a procedure that sets |cur_char| to an ASCII code for the
+next character of input, if that character is a letter or digit or slash
+or \.>. Otherwise
+it sets |cur_char:=" "|, and the input system will be poised to reread the
+character that was rejected, whether or not it was a space.
+Lower case letters are converted to upper case.
+
+@p procedure get_keyword_char;
+begin while (loc=limit)and(not right_ln) do fill_buffer;
+if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
+else begin
+ cur_char:=xord[buffer[loc+1]];
+ if cur_char>="a" then cur_char:=cur_char-@'40;
+ if ((cur_char>="0")and(cur_char<="9")) then incr(loc)
+ else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc)
+ else if cur_char="/" then incr(loc)
+ else if cur_char=">" then incr(loc)
+ else cur_char:=" ";
+ end;
+end;
+
+@ The following procedure sets |cur_char| to the next character code,
+and converts lower case to upper case. If the character is a left or
+right parenthesis, it will not be ``digested''; the character will
+be read again and again, until the calling routine does something
+like `|incr(loc)|' to get past it. Such special treatment of parentheses
+insures that the structural information they contain won't be lost in
+the midst of other error recovery operations.
+
+@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc);
+ end {undoes the effect of |get_next|}
+
+@p procedure get_next; {sets |cur_char| to next, balks at parentheses}
+begin while loc=limit do fill_buffer;
+incr(loc); cur_char:=xord[buffer[loc]];
+if cur_char>="a" then
+ if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
+ else begin
+ if cur_char=invalid_code then begin
+ err_print('Illegal character in the file');
+@.Illegal character...@>
+ cur_char:="?";
+ end;
+ end
+else if (cur_char<=")")and(cur_char>="(") then decr(loc);
+end;
+
+@ The next procedure is used to ignore the text of a comment, or to pass over
+erroneous material. As such, it has the privilege of passing parentheses.
+It stops after the first right parenthesis that drops the level below
+the level in force when the procedure was called.
+
+@p procedure skip_to_end_of_item;
+var l:integer; {initial value of |level|}
+begin l:=level;
+while level>=l do begin
+ while loc=limit do fill_buffer;
+ incr(loc);
+ if buffer[loc]=')' then decr(level)
+ else if buffer[loc]='(' then incr(level);
+ end;
+if input_has_ended then err_print('File ended unexpectedly: No closing ")"');
+@.File ended unexpectedly...@>
+cur_char:=" "; {now the right parenthesis has been read and digested}
+end;
+
+@ Sometimes we merely want to skip past characters in the input until we
+reach a left or a right parenthesis. For example, we do this whenever we
+have finished scanning a property value and we hope that a right parenthesis
+is next (except for possible blank spaces).
+
+@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")")
+@d skip_error(#)==begin err_print(#); skip_to_paren;
+ end {this gets to the right parenthesis if something goes wrong}
+@d flush_error(#)==begin err_print(#); skip_to_end_of_item;
+ end {this gets past the right parenthesis if something goes wrong}
+
+@ After a property value has been scanned, we want to move just past the
+right parenthesis that should come next in the input (except for possible
+blank spaces).
+
+@p procedure finish_the_property; {do this when the value has been scanned}
+begin while cur_char=" " do get_next;
+if cur_char<>")" then err_print('Junk after property value will be ignored');
+@.Junk after property value...@>
+skip_to_end_of_item;
+end;
+
+@* Scanning property names.
+We have to figure out the meaning of names that appear in the \.{PL} file,
+by looking them up in a dictionary of known keywords. Keyword number $n$
+appears in locations |start[n]| through |start[n+1]-1| of an array called
+|dictionary|.
+
+@d max_name_index=300 {upper bound on the number of keywords}
+@d max_letters=3000 {upper bound on the total length of all keywords}
+
+@<Global...@>=
+@!start:array[1..max_name_index] of 0..max_letters;
+@!dictionary:array[0..max_letters] of ASCII_code;
+@!start_ptr:0..max_name_index; {the first available place in |start|}
+@!dict_ptr:0..max_letters; {the first available place in |dictionary|}
+
+@ @<Set init...@>=
+start_ptr:=1; start[1]:=0; dict_ptr:=0;
+
+@ When we are looking for a name, we put it into the |cur_name| array.
+When we have found it, the corresponding |start| index will go into
+the global variable |name_ptr|.
+
+@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}}
+
+@<Glob...@>=
+@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up}
+@!name_length:0..longest_name; {its length}
+@!name_ptr:0..max_name_index; {its ordinal number in the dictionary}
+
+@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L
+in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary
+operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]|
+points into the |start| array.
+
+@d hash_prime=307 {size of the hash table}
+
+@<Glob...@>=
+@!nhash:array[0..hash_prime-1] of 0..max_name_index;
+@!cur_hash:0..hash_prime-1; {current position in the hash table}
+
+@ @<Local...@>=
+@!h:0..hash_prime-1; {runs through the hash table}
+
+@ @<Set init...@>=
+for h:=0 to hash_prime-1 do nhash[h]:=0;
+
+@ Since there is no chance of the hash table overflowing, the procedure
+is very simple. After |lookup| has done its work, |cur_hash| will point
+to the place where the given name was found, or where it should be inserted.
+
+@p procedure lookup; {finds |cur_name| in the dictionary}
+var k:0..longest_name; {index into |cur_name|}
+@!j:0..max_letters; {index into |dictionary|}
+@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement}
+@!cur_hash_reset:boolean;
+begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
+not_found:=true;
+cur_hash_reset:=false;
+while not_found do begin
+ if (cur_hash=0) and (cur_hash_reset) then
+ not_found:=false
+ else begin
+ if cur_hash=0 then begin
+ cur_hash:=hash_prime-1;
+ cur_hash_reset:=true
+ end
+ else decr(cur_hash);
+ if nhash[cur_hash]=0 then not_found:=false
+ else begin
+ j:=start[nhash[cur_hash]];
+ if start[nhash[cur_hash]+1]=j+name_length then begin
+ not_found:=false;
+ for k:=1 to name_length do
+ if dictionary[j+k-1]<>cur_name[k] then not_found:=true;
+ end
+ end
+ end
+ end;
+name_ptr:=nhash[cur_hash];
+end;
+
+@ @<Compute the hash...@>=
+cur_hash:=cur_name[1];
+for k:=2 to name_length do
+ cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime
+
+@ The ``meaning'' of the keyword that begins at |start[k]| in the
+dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given
+symbolic meanings by the following definitions.
+
+@d comment_code=0
+@d check_sum_code=1
+@d design_size_code=2
+@d design_units_code=3
+@d coding_scheme_code=4
+@d family_code=5
+@d face_code=6
+@d seven_bit_safe_flag_code=7
+@d header_code= 8
+@d font_dimen_code=9
+@d lig_table_code=10
+@d boundary_char_code=11
+@d font_dir_code=14
+@d n_font_dir_code=15
+@d character_code=16
+@d parameter_code=30
+@d char_info_code=70
+@d width=1
+@d height=2
+@d depth=3
+@d italic=4
+@d sec_width=5
+@d sec_height=6
+@d sec_depth=7
+@d sec_italic=8
+@d accent=9
+@d prim_top_axis=10
+@d prim_top_axis_bis=11
+@d prim_bot_axis=12
+@d prim_bot_axis_bis=13
+@d prim_mid_hor=14
+@d prim_mid_vert=15
+@d prim_base_slant=16
+@d sec_top_axis=17
+@d sec_top_axis_bis=18
+@d sec_bot_axis=19
+@d sec_bot_axis_bis=20
+@d sec_mid_hor=21
+@d sec_mid_vert=22
+@d sec_base_slant=23
+@d char_wd_code=char_info_code+width
+@d char_ht_code=char_info_code+height
+@d char_dp_code=char_info_code+depth
+@d char_ic_code=char_info_code+italic
+@d sec_width_code=char_info_code+sec_width
+@d sec_height_code=char_info_code+sec_height
+@d sec_depth_code=char_info_code+sec_depth
+@d sec_italic_code=char_info_code+sec_italic
+@d accent_code=char_info_code+accent
+@d prim_top_axis_code=char_info_code+prim_top_axis
+@d prim_top_axis_bis_code=char_info_code+prim_top_axis_bis
+@d prim_bot_axis_code=char_info_code+prim_bot_axis
+@d prim_bot_axis_bis_code=char_info_code+prim_bot_axis_bis
+@d prim_mid_hor_code=char_info_code+prim_mid_hor
+@d prim_mid_vert_code=char_info_code+prim_mid_vert
+@d prim_base_slant_code=char_info_code+prim_base_slant
+@d sec_top_axis_code=char_info_code+sec_top_axis
+@d sec_top_axis_bis_code=char_info_code+sec_top_axis_bis
+@d sec_bot_axis_code=char_info_code+sec_bot_axis
+@d sec_bot_axis_bis_code=char_info_code+sec_bot_axis_bis
+@d sec_mid_hor_code=char_info_code+sec_mid_hor
+@d sec_mid_vert_code=char_info_code+sec_mid_vert
+@d sec_base_slant_code=char_info_code+sec_base_slant
+@d next_larger_code=100
+@d var_char_code=102
+@d label_code=130
+@d stop_code=131
+@d skip_code=132
+@d krn_code=133
+@d lig_code=134
+@d ofm_level_code=140
+@d char_repeat_code=150
+@d char_ivalue_code=151
+@d char_fvalue_code=152
+@d char_mvalue_code=153
+@d char_rule_code=154
+@d char_glue_code=155
+@d char_penalty_code=156
+@d font_rule_code=160
+@d rule_code=161
+@d rule_width_code=162
+@d rule_height_code=163
+@d rule_depth_code=164
+@d font_glue_code=170
+@d glue_code=171
+@d glue_type_code=172
+@d glue_stretch_order_code=173
+@d glue_shrink_order_code=174
+@d glue_width_code=175
+@d glue_stretch_code=176
+@d glue_shrink_code=177
+@d glue_char_code=178
+@d glue_rule_code=179
+@d order_unit_code=181
+@d order_fi_code=182
+@d order_fil_code=183
+@d order_fill_code=184
+@d order_filll_code=185
+@d type_normal_code=186
+@d type_aleaders_code=187
+@d type_cleaders_code=188
+@d type_xleaders_code=189
+@d font_penalty_code=190
+@d penalty_code=191
+@d penalty_val_code=192
+@d font_mvalue_code=200
+@d mvalue_code=201
+@d mvalue_val_code=202
+@d font_fvalue_code=210
+@d fvalue_code=211
+@d fvalue_val_code=212
+@d font_ivalue_code=220
+@d ivalue_code=221
+@d ivalue_val_code=222
+@d clabel_code=231
+@d cpen_code=232
+@d cglue_code=233
+@d cpenglue_code=234
+@d ckrn_code=235
+@d TL_dir_code=240
+@d LT_dir_code=241
+@d TR_dir_code=242
+@d LB_dir_code=243
+@d BL_dir_code=244
+@d RT_dir_code=245
+@d BR_dir_code=246
+@d RB_dir_code=247
+
+
+@<Glo...@>=
+@!equiv:array[0..max_name_index] of byte;
+@!cur_code:byte; {equivalent most recently found in |equiv|}
+
+@ We have to get the keywords into the hash table and into the dictionary in
+the first place (sigh). The procedure that does this has the desired
+|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing
+for the initialization, the keyword being initialized is placed into the
+last positions of |cur_name|, instead of the first positions.
+
+@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary}
+var k:0..longest_name;
+begin for k:=1 to name_length do
+ cur_name[k]:=cur_name[k+longest_name-name_length];
+{now the name has been shifted into the correct position}
+lookup; {this sets |cur_hash| to the proper insertion place}
+nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v;
+for k:=1 to name_length do
+ begin dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr);
+ end;
+incr(start_ptr); start[start_ptr]:=dict_ptr;
+end;
+
+@ Here are the macros to load a name of up to 20 letters into the
+dictionary. For example, the macro |load5| is used for five-letter keywords.
+
+@d tail(#)==enter_name(#)
+@d t20(#)==cur_name[20]:=#;tail
+@d t19(#)==cur_name[19]:=#;t20
+@d t18(#)==cur_name[18]:=#;t19
+@d t17(#)==cur_name[17]:=#;t18
+@d t16(#)==cur_name[16]:=#;t17
+@d t15(#)==cur_name[15]:=#;t16
+@d t14(#)==cur_name[14]:=#;t15
+@d t13(#)==cur_name[13]:=#;t14
+@d t12(#)==cur_name[12]:=#;t13
+@d t11(#)==cur_name[11]:=#;t12
+@d t10(#)==cur_name[10]:=#;t11
+@d t9(#)==cur_name[9]:=#;t10
+@d t8(#)==cur_name[8]:=#;t9
+@d t7(#)==cur_name[7]:=#;t8
+@d t6(#)==cur_name[6]:=#;t7
+@d t5(#)==cur_name[5]:=#;t6
+@d t4(#)==cur_name[4]:=#;t5
+@d t3(#)==cur_name[3]:=#;t4
+@d t2(#)==cur_name[2]:=#;t3
+@d t1(#)==cur_name[1]:=#;t2
+@d load2==name_length:=2;t19
+@d load3==name_length:=3;t18
+@d load4==name_length:=4;t17
+@d load5==name_length:=5;t16
+@d load6==name_length:=6;t15
+@d load7==name_length:=7;t14
+@d load8==name_length:=8;t13
+@d load9==name_length:=9;t12
+@d load10==name_length:=10;t11
+@d load11==name_length:=11;t10
+@d load12==name_length:=12;t9
+@d load13==name_length:=13;t8
+@d load14==name_length:=14;t7
+@d load15==name_length:=15;t6
+@d load16==name_length:=16;t5
+@d load17==name_length:=17;t4
+@d load18==name_length:=18;t3
+@d load19==name_length:=19;t2
+@d load20==name_length:=20;t1
+
+@ (Thank goodness for keyboard macros in the text editor used to create this
+\.{WEB} file.)
+
+@<Enter all of the names and their equivalents, except the parameter names@>=
+equiv[0]:=comment_code; {this is used after unknown keywords}
+load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/
+load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/
+load11("D")("E")("S")("I")("G")("N")
+ ("U")("N")("I")("T")("S")(design_units_code);@/
+load12("C")("O")("D")("I")("N")("G")
+ ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/
+load6("F")("A")("M")("I")("L")("Y")(family_code);@/
+load4("F")("A")("C")("E")(face_code);@/
+load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@>
+ ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/
+load6("H")("E")("A")("D")("E")("R")(header_code);@/
+load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/
+load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/
+load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R")
+ (boundary_char_code);@/
+load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/
+load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/
+load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/
+load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/
+load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/
+load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/
+load5("S")("E")("C")("W")("D")(sec_width_code);@/
+load5("S")("E")("C")("H")("T")(sec_height_code);@/
+load5("S")("E")("C")("D")("P")(sec_depth_code);@/
+load5("S")("E")("C")("I")("C")(sec_italic_code);@/
+load6("A")("C")("C")("E")("N")("T")(accent_code);@/
+load11("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")(prim_top_axis_code);@/
+load14("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(prim_top_axis_bis_code);@/
+load11("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")(prim_bot_axis_code);@/
+load14("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(prim_bot_axis_bis_code);@/
+load10("P")("R")("I")("M")("M")("I")("D")("H")("O")("R")(prim_mid_hor_code);@/
+load10("P")("R")("I")("M")("M")("I")("D")("V")("E")("R")(prim_mid_vert_code);@/
+load13("P")("R")("I")("M")("B")("A")("S")("E")("S")("L")("A")("N")("T")(prim_base_slant_code);@/
+load10("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")(sec_top_axis_code);@/
+load13("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(sec_top_axis_bis_code);@/
+load10("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")(sec_bot_axis_code);@/
+load13("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(sec_bot_axis_bis_code);@/
+load9("S")("E")("C")("M")("I")("D")("H")("O")("R")(sec_mid_hor_code);@/
+load9("S")("E")("C")("M")("I")("D")("V")("E")("R")(sec_mid_vert_code);@/
+load12("S")("E")("C")("B")("A")("S")("E")("S")("L")("A")("N")("T")(sec_base_slant_code);@/
+load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/
+load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/
+load3("T")("O")("P")(var_char_code+1);@/
+load3("M")("I")("D")(var_char_code+2);@/
+load3("B")("O")("T")(var_char_code+3);@/
+load3("R")("E")("P")(var_char_code+4);@/
+load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format}
+load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/
+load5("L")("A")("B")("E")("L")(label_code);@/
+load4("S")("T")("O")("P")(stop_code);@/
+load4("S")("K")("I")("P")(skip_code);@/
+load3("K")("R")("N")(krn_code);@/
+load3("L")("I")("G")(lig_code);@/
+load4("/")("L")("I")("G")(lig_code+2);@/
+load5("/")("L")("I")("G")(">")(lig_code+6);@/
+load4("L")("I")("G")("/")(lig_code+1);@/
+load5("L")("I")("G")("/")(">")(lig_code+5);@/
+load5("/")("L")("I")("G")("/")(lig_code+3);@/
+load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/
+load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/
+load6("C")("L")("A")("B")("E")("L")(clabel_code);@/
+load4("C")("P")("E")("N")(cpen_code);@/
+load5("C")("G")("L")("U")("E")(cglue_code);@/
+load8("C")("P")("E")("N")("G")("L")("U")("E")(cpenglue_code);@/
+load4("C")("K")("R")("N")(ckrn_code);@/
+load8("O")("F")("M")("L")("E")("V")("E")("L")(ofm_level_code);@/
+load7("F")("O")("N")("T")("D")("I")("R")(font_dir_code);@/
+load8("N")("F")("O")("N")("T")("D")("I")("R")(n_font_dir_code);@/
+load10("C")("H")("A")("R")("R")("E")("P")("E")("A")("T")(char_repeat_code);@/
+load10("C")("H")("A")("R")("I")("V")("A")("L")("U")("E")(char_ivalue_code);@/
+load10("C")("H")("A")("R")("F")("V")("A")("L")("U")("E")(char_fvalue_code);@/
+load10("C")("H")("A")("R")("M")("V")("A")("L")("U")("E")(char_mvalue_code);@/
+load8("C")("H")("A")("R")("R")("U")("L")("E")(char_rule_code);@/
+load8("C")("H")("A")("R")("G")("L")("U")("E")(char_glue_code);@/
+load11("C")("H")("A")("R")("P")("E")("N")("A")("L")("T")("Y")(char_penalty_code);@/
+load8("F")("O")("N")("T")("R")("U")("L")("E")(font_rule_code);@/
+load4("R")("U")("L")("E")(rule_code);@/
+load6("R")("U")("L")("E")("W")("D")(rule_width_code);@/
+load6("R")("U")("L")("E")("H")("T")(rule_height_code);@/
+load6("R")("U")("L")("E")("D")("P")(rule_depth_code);@/
+load8("F")("O")("N")("T")("G")("L")("U")("E")(font_glue_code);@/
+load4("G")("L")("U")("E")(glue_code);@/
+load8("G")("L")("U")("E")("T")("Y")("P")("E")(glue_type_code);@/
+load16("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")("O")("R")("D")("E")("R")(glue_stretch_order_code);@/
+load15("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")("O")("R")("D")("E")("R")(glue_shrink_order_code);@/
+load8("G")("L")("U")("E")("R")("U")("L")("E")(glue_rule_code);@/
+load8("G")("L")("U")("E")("C")("H")("A")("R")(glue_char_code);@/
+load6("G")("L")("U")("E")("W")("D")(glue_width_code);@/
+load11("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")(glue_stretch_code);@/
+load10("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")(glue_shrink_code);@/
+load4("U")("N")("I")("T")(order_unit_code);@/
+load2("F")("I")(order_fi_code);@/
+load3("F")("I")("L")(order_fil_code);@/
+load4("F")("I")("L")("L")(order_fill_code);@/
+load5("F")("I")("L")("L")("L")(order_filll_code);@/
+load6("N")("O")("R")("M")("A")("L")(type_normal_code);@/
+load8("A")("L")("E")("A")("D")("E")("R")("S")(type_aleaders_code);@/
+load8("C")("L")("E")("A")("D")("E")("R")("S")(type_cleaders_code);@/
+load8("X")("L")("E")("A")("D")("E")("R")("S")(type_xleaders_code);@/
+load11("F")("O")("N")("T")("P")("E")("N")("A")("L")("T")("Y")(font_penalty_code);@/
+load7("P")("E")("N")("A")("L")("T")("Y")(penalty_code);@/
+load10("P")("E")("N")("A")("L")("T")("Y")("V")("A")("L")(penalty_val_code);@/
+load10("F")("O")("N")("T")("M")("V")("A")("L")("U")("E")(font_mvalue_code);@/
+load6("M")("V")("A")("L")("U")("E")(mvalue_code);@/
+load9("M")("V")("A")("L")("U")("E")("V")("A")("L")(mvalue_val_code);@/
+load10("F")("O")("N")("T")("F")("V")("A")("L")("U")("E")(font_fvalue_code);@/
+load6("F")("V")("A")("L")("U")("E")(fvalue_code);@/
+load9("F")("V")("A")("L")("U")("E")("V")("A")("L")(fvalue_val_code);@/
+load10("F")("O")("N")("T")("I")("V")("A")("L")("U")("E")(font_ivalue_code);@/
+load6("I")("V")("A")("L")("U")("E")(ivalue_code);@/
+load9("I")("V")("A")("L")("U")("E")("V")("A")("L")(ivalue_val_code);@/
+load2("T")("L")(TL_dir_code);
+load2("L")("T")(LT_dir_code);
+load2("T")("R")(TR_dir_code);
+load2("L")("B")(LB_dir_code);
+load2("B")("L")(BL_dir_code);
+load2("R")("T")(RT_dir_code);
+load2("B")("R")(BR_dir_code);
+load2("R")("B")(RB_dir_code);
+
+@ @<Enter the parameter names@>=
+load5("S")("L")("A")("N")("T")(parameter_code+1);@/
+load5("S")("P")("A")("C")("E")(parameter_code+2);@/
+load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/
+load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/
+load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/
+load4("Q")("U")("A")("D")(parameter_code+6);@/
+load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/
+load4("N")("U")("M")("1")(parameter_code+8);@/
+load4("N")("U")("M")("2")(parameter_code+9);@/
+load4("N")("U")("M")("3")(parameter_code+10);@/
+load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/
+load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/
+load4("S")("U")("P")("1")(parameter_code+13);@/
+load4("S")("U")("P")("2")(parameter_code+14);@/
+load4("S")("U")("P")("3")(parameter_code+15);@/
+load4("S")("U")("B")("1")(parameter_code+16);@/
+load4("S")("U")("B")("2")(parameter_code+17);@/
+load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/
+load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/
+load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/
+load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/
+load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/
+load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@>
+ ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/
+
+@ When a left parenthesis has been scanned, the following routine
+is used to interpret the keyword that follows, and to store the
+equivalent value in |cur_code|.
+
+@p procedure get_name;
+begin incr(loc); incr(level); {pass the left parenthesis}
+cur_char:=" ";
+while cur_char=" " do get_next;
+if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character}
+name_length:=0; get_keyword_char; {prepare to scan the name}
+while cur_char<>" " do begin
+ if name_length=longest_name then cur_name[1]:="X" {force error}
+ else incr(name_length);
+ cur_name[name_length]:=cur_char;
+ get_keyword_char;
+ end;
+lookup;
+if name_ptr=0 then err_print('Sorry, I don''t know that property name');
+@.Sorry, I don't know...@>
+cur_code:=equiv[name_ptr];
+end;
+
+@* Scanning numeric data.
+The next thing we need is a trio of subroutines to read the one-byte,
+four-byte, and real numbers that may appear as property values.
+These subroutines are careful to stick to numbers between $-2^{31}$
+and $2^{31}-1$, inclusive, so that a computer with two's complement
+32-bit arithmetic will not be interrupted by overflow.
+
+@ The first number scanner, which returns a one-byte value, surely has
+no problems of arithmetic overflow.
+
+@p function get_byte:byte; {scans a one-byte property value}
+var acc:integer; {an accumulator}
+@!t:ASCII_code; {the type of value to be scanned}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+t:=cur_char; acc:=0;
+repeat get_next;
+until cur_char<>" "; {skip the blanks after the type code}
+if t="C" then @<Scan an ASCII character code@>
+else if t="D" then @<Scan a small decimal number@>
+else if t="O" then @<Scan a small octal number@>
+else if t="H" then @<Scan a small hexadecimal number@>
+else if t="F" then @<Scan a face code@>
+else skip_error('You need "C" or "D" or "O" or "H" or "F" here');
+@.You need "C" or "D" ...here@>
+cur_char:=" "; get_byte:=acc;
+end;
+
+@ The |get_next| routine converts lower case to upper case, but it leaves
+the character in the buffer, so we can unconvert it.
+
+@<Scan an ASCII...@>=
+if (cur_char>=@'41)and(cur_char<=@'176)and
+ ((cur_char<"(")or(cur_char>")")) then
+ acc:=xord[buffer[loc]]
+else skip_error('"C" value must be standard ASCII and not a paren')
+@:C value}\.{"C" value must be...@>
+
+@ @<Scan a small dec...@>=
+begin while (cur_char>="0")and(cur_char<="9") do begin
+ acc:=acc*10+cur_char-"0";
+ if acc>65535 then begin
+ skip_error('This value shouldn''t exceed 65535');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small oct...@>=
+begin while (cur_char>="0")and(cur_char<="7") do
+ begin acc:=acc*8+cur_char-"0";
+ if acc>65535 then begin
+ skip_error('This value shouldn''t exceed ''177777');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small hex...@>=
+begin while ((cur_char>="0")and(cur_char<="9"))or
+ ((cur_char>="A")and(cur_char<="F")) do begin
+ if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+ acc:=acc*16+cur_char-"0";
+ if acc>65535 then begin
+ skip_error('This value shouldn''t exceed "FFFF');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a face...@>=
+begin if cur_char="B" then acc:=2
+else if cur_char="L" then acc:=4
+else if cur_char<>"M" then acc:=18;
+get_next;
+if cur_char="I" then incr(acc)
+else if cur_char<>"R" then acc:=18;
+get_next;
+if cur_char="C" then acc:=acc+6
+else if cur_char="E" then acc:=acc+12
+else if cur_char<>"R" then acc:=18;
+if acc>=18 then begin
+ skip_error('Illegal face code, I changed it to MRR');
+@.Illegal face code...@>
+ acc:=0;
+ end;
+end
+
+@ The routine that scans a four-byte value puts its output into |cur_bytes|,
+which is a record containing (yes, you guessed it) four bytes.
+
+@<Types...@>=
+@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end;
+
+@ @d c0==cur_bytes.b0
+@d c1==cur_bytes.b1
+@d c2==cur_bytes.b2
+@d c3==cur_bytes.b3
+
+@<Glob...@>=
+@!cur_bytes:four_bytes; {a four-byte accumulator}
+@!zero_bytes:four_bytes; {four bytes all zero}
+
+@ @<Set init...@>=
+zero_bytes.b0:=0; zero_bytes.b1:=0; zero_bytes.b2:=0; zero_bytes.b3:=0;
+
+@ Since the |get_four_bytes| routine is used very infrequently, no attempt
+has been made to make it fast; we only want it to work.
+This is no longer the case, but we hope that it is not too slow.
+
+@p procedure get_four_bytes; {scans an unsigned constant and sets |four_bytes|}
+var c:integer; {leading byte}
+@!r:integer; {radix}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+r:=0; cur_bytes:=zero_bytes; {start with the accumulator zero}
+if cur_char="H" then r:=16
+else if cur_char="O" then r:=8
+else if cur_char="D" then r:=10
+else skip_error('Decimal ("D"), octal ("O") or hex ("H") value is needed here');
+@.Decimal ("D"), octal ("O") or hex ("H")...@>
+if r>0 then begin
+ repeat get_next;
+ until cur_char<>" "; {skip the blanks after the type code}
+ while ((cur_char>="0")and(cur_char<="9"))or@|
+ ((cur_char>="A")and(cur_char<="F")) do
+ @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>;
+ end;
+end;
+
+function get_integer:integer; {scans an integer property value}
+begin get_four_bytes;
+get_integer:=(c0*@"1000000)+(c1*@"10000)+(c2*@"100)+c3;
+end;
+
+@ @<Multiply by |r|...@>=
+begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+if cur_char>="0"+r then skip_error('Illegal digit')
+@.Illegal digit@>
+else begin
+ c:=c3*r+cur_char-"0"; c3:=c mod 256;@/
+ c:=c2*r+c div 256; c2:=c mod 256;@/
+ c:=c1*r+c div 256; c1:=c mod 256;@/
+ c:=c0*r+c div 256;
+ if c<256 then c0:=c
+ else begin
+ cur_bytes:=zero_bytes;
+ if r=8 then
+ skip_error('Sorry, the maximum octal value is O 37777777777')
+@.Sorry, the maximum...@>
+ else if r=10 then
+ skip_error('Sorry, the maximum decimal value is D 4294967295')
+ else skip_error('Sorry, the maximum hex value is H FFFFFFFF');
+ end;
+ get_next;
+ end;
+end
+
+@ The remaining scanning routine is the most interesting. It scans a real
+constant and returns the nearest |fix_word| approximation to that constant.
+A |fix_word| is a 32-bit integer that represents a real value that
+has been multiplied by $2^{20}$. Since \.{PLtoTF} restricts the magnitude
+of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$.
+
+@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0}
+
+@<Types...@>=
+@!fix_word=integer; {a scaled real value with 20 bits of fraction}
+@!unsigned_integer=integer;
+
+@ When a real value is desired, we might as well treat `\.D' and `\.R'
+formats as if they were identical.
+
+@p function get_fix:fix_word; {scans a real property value}
+var negative:boolean; {was there a minus sign?}
+@!acc:integer; {an accumulator}
+@!int_part:integer; {the integer part}
+@!j:0..7; {the number of decimal places stored}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+negative:=false; acc:=0; {start with the accumulators zero}
+if (cur_char<>"R")and(cur_char<>"D") then
+ skip_error('An "R" or "D" value is needed here')
+@.An "R" or "D" ... needed here@>
+else begin
+ @<Scan the blanks and/or signs after the type code@>;
+ while (cur_char>="0") and (cur_char<="9") do
+ @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>;
+ int_part:=acc; acc:=0;
+ if cur_char="." then @<Scan the fraction part and put it in |acc|@>;
+ if (acc>=unity)and(int_part=2047) then
+ skip_error('Real constants must be less than 2048')
+@.Real constants must be...@>
+ else acc:=int_part*unity+acc;
+ end;
+if negative then get_fix:=-acc@+else get_fix:=acc;
+end;
+
+@ @<Scan the blanks...@>=
+repeat get_next;
+if cur_char="-" then begin
+ cur_char:=" "; negative:=true;
+ end
+else if cur_char="+" then cur_char:=" ";
+until cur_char<>" "
+
+@ @<Multiply by 10...@>=
+begin acc:=acc*10+cur_char-"0";
+if acc>=2048 then begin
+ skip_error('Real constants must be less than 2048');
+@.Real constants must be...@>
+ acc:=0; cur_char:=" ";
+ end
+else get_next;
+end
+
+@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven
+of the digits $d_j$. A correct result is obtained if we first compute
+$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which
+$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
+
+@<Glob...@>=
+@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$}
+
+@ @<Scan the frac...@>=
+begin j:=0; get_next;
+while (cur_char>="0")and(cur_char<="9") do begin
+ if j<7 then begin
+ incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
+ end;
+ get_next;
+ end;
+acc:=0;
+while j>0 do begin
+ acc:=fraction_digits[j]+(acc div 10); decr(j);
+ end;
+acc:=(acc+10) div 20;
+end
+
+@* Storing the property values.
+When property values have been found, they are squirreled away in a bunch
+of arrays. The header information is unpacked into bytes in an array
+called |header_bytes|. The ligature/kerning program is stored in an array
+of type |four_bytes|.
+Another |four_bytes| array holds the specifications of extensible characters.
+The kerns and parameters are stored in separate arrays of |fix_word| values.
+
+Instead of storing the design size in the header array, we will keep it
+in a |fix_word| variable until the last minute. The number of units in the
+design size is also kept in a |fix_word|.
+
+@<Glob...@>=
+@!header_bytes:array[header_index] of byte; {the header block}
+@!header_ptr:header_index; {the number of header bytes in use}
+@!design_size:fix_word; {the design size}
+@!design_units:fix_word; {reciprocal of the scaling factor}
+@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?}
+@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program}
+@!nl:unsigned_integer; {the number of ligature/kern instructions so far}
+@!min_nl:unsigned_integer; {the final value of |nl| must be at least this}
+@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts}
+@!nk:0..max_kerns; {the number of entries of |kern|}
+@!exten:array[char_type] of four_bytes; {extensible character specs}
+@!ne:xchar_type; {the number of extensible characters}
+@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters}
+@!np:0..max_param_words; {the largest parameter set nonzero}
+@!check_sum_specified:boolean; {did the user name the check sum?}
+@!bchar:xchar_type; {the right boundary character, or 256 if unspecified}
+@!font_dir:integer; {font direction}
+
+@ @<Types...@>=
+@!char_type=0..max_char;
+@!xchar_type=0..xmax_char;
+@!xxchar_type=0..xxmax_char;
+@!xxxchar_type=0..xxxmax_char;
+@!header_index=0..max_header_bytes;
+@!indx=xxchar_type;
+
+@ @<Local...@>=
+@!d:header_index; {an index into |header_bytes|}
+
+@ We start by setting up the default values.
+
+@d check_sum_loc=0
+@d design_size_loc=4
+@d coding_scheme_loc=8
+@d family_loc=coding_scheme_loc+40
+@d seven_flag_loc=family_loc+20
+@d face_loc=seven_flag_loc+3
+
+@<Set init...@>=
+for d:=0 to 18*4-1 do header_bytes[d]:=0;
+header_bytes[8]:=11; header_bytes[9]:="U";
+header_bytes[10]:="N";
+header_bytes[11]:="S";
+header_bytes[12]:="P";
+header_bytes[13]:="E";
+header_bytes[14]:="C";
+header_bytes[15]:="I";
+header_bytes[16]:="F";
+header_bytes[17]:="I";
+header_bytes[18]:="E";
+header_bytes[19]:="D";
+@.UNSPECIFIED@>
+for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40];
+design_size:=10*unity; design_units:=unity; seven_bit_safe_flag:=false;@/
+header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/
+check_sum_specified:=false; bchar:=xmax_char;
+font_dir:=0;
+
+@ Most of the dimensions, however, go into the |memory| array. There are
+at most |max_char+2| widths, |max_char+2| heights, |max_char+2| depths,
+and |max_char+2| italic corrections, since the value 0 is required but
+it need not be used. So |memory| has room for |4*max_char+8| entries,
+each of which is a |fix_word|. An auxiliary table called |link| is
+used to link these words together in linear lists, so that sorting and
+other operations can be done conveniently.
+
+We also add four ``list head'' words to the |memory| and |link| arrays;
+these are in locations |width| through |italic|, i.e., 1 through 4.
+For example, |link[height]| points to the smallest element in
+the sorted list of distinct heights that have appeared so far, and
+|memory[height]| is the number of distinct heights.
+
+@<Types...@>=
+@!pointer=0..mem_size; {an index into memory}
+
+@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain
+pointers to the |memory| array entries where the corresponding dimensions
+appear. Two other arrays, |char_tag| and |char_remainder|, hold
+the other information that \.{TFM} files pack into a |char_info_word|.
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+@d bchar_label==char_remainder[xmax_char]
+ {beginning of ligature program for left boundary}
+
+@<Glob...@>=
+@!memory:array[pointer] of fix_word; {character dimensions and kerns}
+@!mem_ptr:pointer; {largest |memory| word in use}
+@!link:array[pointer] of pointer; {to make lists of |memory| items}
+@!char_wd:array[char_type] of pointer; {pointers to the widths}
+@!char_ht:array[char_type] of pointer; {pointers to the heights}
+@!char_dp:array[char_type] of pointer; {pointers to the depths}
+@!char_ic:array[char_type] of pointer; {pointers to italic corrections}
+@!char_tag:array[char_type] of no_tag..ext_tag; {character tags}
+@!char_remainder:array[xchar_type] of xchar_type;
+ {pointers to ligature labels,
+ next larger characters, or extensible characters}
+@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
+
+@ @<Local...@>=
+@!c:integer; {runs through all character codes}
+
+@ @<Set init...@>=
+bchar_label:=xmax_label;
+for c:=0 to max_char do begin
+ char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
+ char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists}
+memory[width]:=0; link[width]:=0; {width list is empty}
+memory[height]:=0; link[height]:=0; {height list is empty}
+memory[depth]:=0; link[depth]:=0; {depth list is empty}
+memory[italic]:=0; link[italic]:=0; {italic list is empty}
+mem_ptr:=italic;
+
+@ As an example of these data structures, let us consider the simple
+routine that inserts a potentially new element into one of the dimension
+lists. The first parameter indicates the list head (i.e., |h=width| for
+the width list, etc.); the second parameter is the value that is to be
+inserted into the list if it is not already present. The procedure
+returns the value of the location where the dimension appears in |memory|.
+The fact that |memory[0]| is larger than any legal dimension makes the
+algorithm particularly short.
+
+We do have to handle two somewhat subtle situations. A width of zero must be
+put into the list, so that a zero-width character in the font will not appear
+to be nonexistent (i.e., so that its |char_wd| index will not be zero), but
+this does not need to be done for heights, depths, or italic corrections.
+Furthermore, it is necessary to test for memory overflow even though we
+have provided room for the maximum number of different dimensions in any
+legal font, since the \.{PL} file might foolishly give any number of
+different sizes to the same character.
+
+@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list}
+var p:pointer; {the current node of interest}
+begin if (d=0)and(h<>width) then sort_in:=0
+else begin
+ p:=h;
+ while d>=memory[link[p]] do p:=link[p];
+ if (d=memory[p])and(p<>h) then sort_in:=p
+ else if mem_ptr=mem_size then
+ begin err_print('Memory overflow: too many widths, etc');
+@.Memory overflow...@>
+ print_ln('Congratulations! It''s hard to make this error.');
+ sort_in:=p;
+ end
+ else begin
+ incr(mem_ptr); memory[mem_ptr]:=d;
+ link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]);
+ sort_in:=mem_ptr;
+ end;
+ end;
+end;
+
+@ When these lists of dimensions are eventually written to the \.{OFM}
+file, we may have to do some rounding of values, because the \.{OFM} file
+allows at most 65536 widths, 256 heights, 256 depths, and 256 italic
+corrections. The following procedure takes a given list head |h| and a
+given dimension |d|, and returns the minimum $m$ such that the elements
+of the list can be covered by $m$ intervals of width $d$. It also sets
+|next_d| to the smallest value $d^\prime>d$ such that the covering found
+by this procedure would be different. In particular, if $d=0$ it computes
+the number of elements of the list, and sets |next_d| to the smallest
+distance between two list elements. (The covering by intervals of width
+|next_d| is not guaranteed to have fewer than $m$ elements, but in
+practice this seems to happen most of the time.)
+
+@<Glob...@>=
+@!next_d:fix_word; {the next larger interval that is worth trying}
+
+@ Once again we can make good use of the fact that |memory[0]| is ``infinite.''
+
+@p function min_cover(@!h:pointer;@!d:fix_word):integer;
+var p:pointer; {the current node of interest}
+@!l:fix_word; {the least element covered by the current interval}
+@!m:integer; {the current size of the cover being generated}
+begin m:=0; p:=link[h]; next_d:=memory[0];
+while p<>0 do begin
+ incr(m); l:=memory[p];
+ while memory[link[p]]<=l+d do p:=link[p];
+ p:=link[p];
+ if memory[p]-l<next_d then next_d:=memory[p]-l;
+ end;
+min_cover:=m;
+end;
+
+@ The following procedure uses |min_cover| to determine the smallest $d$
+such that a given list can be covered with at most a given number of
+intervals.
+
+@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round}
+var d:fix_word; {the current trial interval length}
+@!k:integer; {the size of a minimum cover}
+begin if memory[h]>m then begin
+ excess:=memory[h]-m;
+ k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|}
+ repeat d:=d+d; k:=min_cover(h,d);
+ until k<=m; {first we ascend rapidly until finding the range}
+ d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps}
+ while k>m do begin
+ d:=next_d; k:=min_cover(h,d);
+ end;
+ shorten:=d;
+ end
+else shorten:=0;
+end;
+
+@ When we are nearly ready to output the \.{TFM} file, we will set
+|index[p]:=k| if the dimension in |memory[p]| is being rounded to the
+|k|th element of its list.
+
+@<Glob...@>=
+@!index:array[pointer] of byte;
+@!excess:byte; {number of words to remove, if list is being shortened}
+
+@ Here is the procedure that sets the |index| values. It also shortens
+the list so that there is only one element per covering interval;
+the remaining elements are the midpoints of their clusters.
+
+@p procedure set_indices(@!h:pointer;@!d:fix_word);
+ {reduces and indexes a list}
+var p:pointer; {the current node of interest}
+@!q:pointer; {trails one step behind |p|}
+@!m:byte; {index number of nodes in the current interval}
+@!l:fix_word; {least value in the current interval}
+begin q:=h; p:=link[q]; m:=0;
+while p<>0 do begin
+ incr(m); l:=memory[p]; index[p]:=m;
+ while memory[link[p]]<=l+d do begin
+ p:=link[p]; index[p]:=m; decr(excess);
+ if excess=0 then d:=0;
+ end;
+ link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p];
+ end;
+memory[h]:=m;
+end;
+
+@* The input phase.
+We're ready now to read and parse the \.{PL} file, storing property
+values as we go.
+
+@<Glob...@>=
+@!c:integer; {the current character or byte being processed}
+@!cprime:char_type; {Processing for several characters together}
+@!crange:char_type; {ditto}
+
+@ @<Read all the input@>=
+cur_char:=" ";
+repeat while cur_char=" " do get_next;
+if cur_char="(" then @<Read a font property value@>
+else if (cur_char=")")and not input_has_ended then begin
+ err_print('Extra right parenthesis');
+ incr(loc); cur_char:=" ";
+ end
+@.Extra right parenthesis@>
+else if not input_has_ended then junk_error;
+until input_has_ended
+
+@ The |junk_error| routine just referred to is called when something
+appears in the forbidden area between properties of a property list.
+
+@p procedure junk_error; {gets past no man's land}
+begin err_print('There''s junk here that is not in parentheses');
+@.There's junk here...@>
+skip_to_paren;
+end;
+
+@ For each font property, we are supposed to read the data from the
+left parenthesis that is the current value of |cur_char| to the right
+parenthesis that matches it in the input. The main complication is
+to recover with reasonable grace from various error conditions that
+might arise.
+
+@<Read a font property value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<110) and (cur_code>character_code) then
+ flush_error('This property name doesn''t belong on the outer level')
+else if (cur_code>=110) and ((cur_code mod 10)<>0) then
+ flush_error('This property name doesn''t belong on the outer level')
+@.This property name doesn't belong...@>
+else begin @<Read the font property value specified by |cur_code|@>;
+ finish_the_property;
+ end;
+end
+
+@ @<Read the font property value spec...@>=
+case cur_code of
+ check_sum_code: begin
+ check_sum_specified:=true;
+ read_four_bytes(check_sum_loc);
+ end;
+ design_size_code: @<Read the design size@>;
+ design_units_code: @<Read the design units@>;
+ coding_scheme_code: read_BCPL(coding_scheme_loc,40);
+ family_code: read_BCPL(family_loc,20);
+ face_code: begin
+ c:=get_byte; if c>255 then
+ begin err_print('FACE clipped to 255'); c:=255 end;
+ header_bytes[face_loc]:=c
+ end;
+ seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
+ header_code: @<Read an indexed header word@>;
+ font_dimen_code: @<Read font parameter list@>;
+ lig_table_code: read_lig_kern;
+ boundary_char_code: bchar:=get_byte;
+ character_code: read_char_info;
+ ofm_level_code: @<Read OFM level code@>;
+ font_dir_code: @<Read font direction code@>;
+ n_font_dir_code: @<Read natural font direction code@>;
+ char_repeat_code: read_repeated_character_info;
+ font_rule_code: read_font_rule_list;
+ font_glue_code: read_font_glue_list;
+ font_penalty_code: read_font_penalty_list;
+ font_mvalue_code: read_font_mvalue_list;
+ font_fvalue_code: read_font_fvalue_list;
+ font_ivalue_code: read_font_ivalue_list;
+ end
+
+@ The |case| statement just given makes use of two subroutines that we
+haven't defined yet. The first of these puts a 32-bit octal quantity
+into four specified bytes of the header block.
+
+@p procedure read_four_bytes(l:header_index);
+begin get_four_bytes;
+header_bytes[l]:=c0;
+header_bytes[l+1]:=c1;
+header_bytes[l+2]:=c2;
+header_bytes[l+3]:=c3;
+end;
+
+@ The second little procedure is used to scan a string and to store it in
+the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed
+to contain at most |n| bytes, including the first byte (which holds the
+length of the rest of the string).
+
+@p procedure read_BCPL(l:header_index;n:byte);
+var k:header_index;
+begin k:=l;
+while cur_char=" " do get_next;
+while (cur_char<>"(")and(cur_char<>")") do begin
+ if k<l+n then incr(k);
+ if k<l+n then header_bytes[k]:=cur_char;
+ get_next;
+ end;
+if k=l+n then begin
+ err_print('String is too long; its first ',n-1:1,
+@.String is too long...@>
+ ' characters will be kept'); decr(k);
+ end;
+header_bytes[l]:=k-l;
+while k<l+n-1 do begin {tidy up the remaining bytes by setting them to nulls}
+ incr(k); header_bytes[k]:=0;
+ end;
+end;
+
+@ @<Read the design size@>=
+begin next_d:=get_fix;
+if next_d<unity then
+ err_print('The design size must be at least 1')
+@.The design size must...@>
+else design_size:=next_d;
+end
+
+@ @<Read the design units@>=
+begin next_d:=get_fix;
+if next_d<=0 then
+ err_print('The number of units per design size must be positive')
+@.The number of units...@>
+else design_units:=next_d;
+end
+
+@ @<Read the seven-bit-safe...@>=
+begin while cur_char=" " do get_next;
+if cur_char="T" then seven_bit_safe_flag:=true
+else if cur_char="F" then seven_bit_safe_flag:=false
+else err_print('The flag value should be "TRUE" or "FALSE"');
+@.The flag value should be...@>
+skip_to_paren;
+end
+
+@ @<Read an indexed header word@>=
+begin c:=get_byte;
+if c<18 then skip_error('HEADER indices should be 18 or more')
+@.HEADER indices...@>
+else if 4*c+4>max_header_bytes then
+ skip_error('This HEADER index is too big for my present table size')
+@.This HEADER index is too big...@>
+else begin
+ while header_ptr<4*c+4 do begin
+ header_bytes[header_ptr]:=0; incr(header_ptr);
+ end;
+ read_four_bytes(4*c);
+ end;
+end
+
+@ The remaining kinds of font property values that need to be read are
+those that involve property lists on higher levels. Each of these has a
+loop similar to the one that was used at level zero. Then we put the
+right parenthesis back so that `|finish_the_property|' will be happy;
+there is probably a more elegant way to do this.
+
+@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")";
+ end
+
+@<Read font parameter list@>=
+begin while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a parameter value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a parameter value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
+ flush_error('This property name doesn''t belong in a FONTDIMEN list')
+@.This property name doesn't belong...@>
+else begin
+ if cur_code=parameter_code then c:=get_integer
+ else c:=cur_code-parameter_code;
+ if c=0 then flush_error('PARAMETER index must not be zero')
+@.PARAMETER index must not...@>
+ else if c>max_param_words then
+ flush_error('This PARAMETER index is too big for my present table size')
+@.This PARAMETER index is too big...@>
+ else begin
+ while np<c do begin
+ incr(np); param[np]:=0;
+ end;
+ param[c]:=get_fix;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Read ligature/kern list@>=
+begin lk_step_ended:=false;
+while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then read_lig_kern_command
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a ligature/kern command@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code>=label_code) and (cur_code<=(lig_code+11)) then begin
+ case cur_code of
+ label_code:@<Read a label step@>;
+ stop_code:@<Read a stop step@>;
+ skip_code:@<Read a skip step@>;
+ krn_code:@<Read a kerning step@>;
+ lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,
+ lig_code+6,lig_code+7,lig_code+11:@<Read a ligature step@>;
+ end; {there are no other cases |>=label_code|}
+ finish_the_property;
+end
+else if (cur_code>=clabel_code) and (cur_code<=cpenglue_code) then begin
+ case cur_code of
+ clabel_code:@<Read an extended label step@>;
+ cpen_code:@<Read an extended penalty step@>;
+ cglue_code:@<Read an extended glue step@>;
+ cpenglue_code:@<Read an extended penalty/glue step@>;
+ ckrn_code:@<Read an extended kern step@>;
+ end; {there are no other cases |>=label_code|}
+ finish_the_property;
+end
+else flush_error('This property name doesn''t belong in a LIGTABLE list');
+@.This property name doesn't belong...@>
+end
+
+@ When a character is about to be tagged, we call the following
+procedure so that an error message is given in case of multiple tags.
+
+@p procedure check_tag(c:integer); {print error if |c| already tagged}
+begin case char_tag[c] of
+ no_tag: do_nothing;
+ lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
+@.This character already...@>
+ list_tag: err_print('This character already has a NEXTLARGER spec');
+ ext_tag: err_print('This character already has a VARCHAR spec');
+ end;
+end;
+
+@ @<Read a label step@>=
+begin while cur_char=" " do get_next;
+if cur_char="B" then begin
+ bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
+ end
+else begin
+ backup; c:=get_byte;
+ check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
+ end;
+if min_nl<=nl then min_nl:=nl+1;
+lk_step_ended:=false;
+end
+
+@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@<Globals...@>=
+@!lk_step_ended:boolean;
+ {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?}
+@!krn_ptr:0..max_kerns; {an index into |kern|}
+
+@ @<Read a stop step@>=
+if not lk_step_ended then
+ err_print('STOP must follow LIG or KRN')
+@.STOP must follow LIG or KRN@>
+else begin
+ lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
+ lk_step_ended:=false;
+ end
+
+@ @<Read a skip step@>=
+if not lk_step_ended then
+ err_print('SKIP must follow LIG or KRN')
+@.SKIP must follow LIG or KRN@>
+else begin
+ c:=get_byte;
+ if c>=128 then err_print('Maximum SKIP amount is 127')
+@.Maximum SKIP amount...@>
+ else if nl+c>=max_lig_steps then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+ else begin
+ lig_kern[nl-1].b0:=c;
+ if min_nl<=nl+c then min_nl:=nl+c+1;
+ end;
+ lk_step_ended:=false;
+ end
+
+@ @<Read a ligature step@>=
+begin lig_kern[nl].b0:=0;
+lig_kern[nl].b2:=cur_code-lig_code;
+lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b3:=get_byte;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read a kerning step@>=
+begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
+kern[nk]:=get_fix; krn_ptr:=0;
+while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
+if krn_ptr=nk then begin
+ if nk<max_kerns then incr(nk)
+ else begin
+ err_print('Sorry, too many different kerns for me to handle');
+@.Sorry, too many different kerns...@>
+ decr(krn_ptr);
+ end;
+ end;
+if ofm_level=-1 then begin
+ lig_kern[nl].b2:=kern_flag+(krn_ptr div 256);
+ lig_kern[nl].b3:=krn_ptr mod 256;
+ end
+else begin
+ lig_kern[nl].b2:=kern_flag+(krn_ptr div 65536);
+ lig_kern[nl].b3:=krn_ptr mod 65536;
+ end;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Global...@>=
+@!category_remainders:array[0..256] of integer;
+@!ivalue_category,@!max_ivalue_category:integer;
+@!glue_category,@!max_glue_category:integer;
+@!penalty_category,@!max_penalty_category:integer;
+
+@ @<Set init...@>=
+for ivalue_category:=0 to 256 do begin
+ category_remainders[ivalue_category]:=-1;
+ end;
+max_ivalue_category:=-1;
+max_glue_category:=-1;
+max_penalty_category:=-1;
+
+@ @<Read an extended label step@>=
+begin
+c:=get_byte;
+category_remainders[c]:=nl;
+if max_ivalue_category<c then max_ivalue_category:=c;
+if min_nl<=nl then min_nl:=nl+1;
+lk_step_ended:=false;
+end
+
+@ @<Read an extended penalty step@>=
+begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b2:=17;
+penalty_category:=get_byte;
+if max_penalty_category<penalty_category then
+ max_penalty_category:=penalty_category;
+lig_kern[nl].b3:=penalty_category;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read an extended glue step@>=
+begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b2:=18;
+glue_category:=get_byte;
+if max_glue_category<glue_category then
+ max_glue_category:=glue_category;
+lig_kern[nl].b3:=glue_category;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read an extended penalty/glue step@>=
+begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b2:=19;
+penalty_category:=get_byte;
+if max_penalty_category<penalty_category then
+ max_penalty_category:=penalty_category;
+glue_category:=get_byte;
+if max_glue_category<glue_category then
+ max_glue_category:=glue_category;
+lig_kern[nl].b3:=penalty_category*256+glue_category;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read an extended kern step@>=
+begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b2:=20;
+kern[nk]:=get_fix; krn_ptr:=0;
+while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
+if krn_ptr=nk then begin
+ if nk<max_kerns then incr(nk)
+ else begin
+ err_print('Sorry, too many different kerns for me to handle');
+@.Sorry, too many different kerns...@>
+ decr(krn_ptr);
+ end;
+ end;
+if krn_ptr>65535 then
+ err_print('Sorry, too many different kerns for me to handle');
+lig_kern[nl].b3:=krn_ptr;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Globals...@>=
+@!char_extended_tag:array [char_type] of boolean;
+
+@ @<Set init...@>=
+for c:=0 to max_char do
+ char_extended_tag[c]:=false;
+
+@ @<Finish up the extended font stuff@>=
+begin
+if max_penalty_category>0 then begin
+ if nkp=0 then
+ err_print('No PENALTY table')
+ else if npp[0]<max_penalty_category then
+ err_print('Not enough PENALTY entries');
+ end;
+if max_glue_category>0 then begin
+ if nkg=0 then
+ err_print('No GLUE table')
+ else if npg[0]<max_glue_category then
+ err_print('Not enough GLUE entries');
+ end;
+if max_ivalue_category>0 then begin
+ if nki=0 then
+ err_print('No IVALUE table')
+ else if npi[0]<max_ivalue_category then
+ err_print('Not enough IVALUE entries')
+ else begin
+ for c:=0 to max_char do begin
+ if (char_wd[c]<>0) then begin
+ for j:=0 to max_ivalue_category do
+ if char_table[c,0]=j then begin
+ if category_remainders[j]<>-1 then begin
+ if char_tag[c]<>0 then
+ err_print('Character already has a tag')
+ else begin
+ char_extended_tag[c]:=true;
+ char_remainder[c]:=category_remainders[j];
+ end;
+ end;
+ end;
+ end;
+ end;
+ end;
+ end;
+end
+
+@ @<Global...@>=
+tables_read:boolean;
+
+@ @<Set init...@>=
+tables_read:=false;
+
+@ Finally we come to the part of \.{PLtoTF}'s input mechanism
+that is used most, the processing of individual character data.
+
+@<Read character info list@>=
+begin
+if not tables_read then begin
+ compute_new_header_ofm;
+ tables_read:=true;
+ end;
+c:=get_byte; {read the character code that is being specified}
+@<Print |c| in hex notation@>;
+while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then read_character_property
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
+finish_inner_property_list;
+end
+
+@ @<Globals...@>=
+@!char_original:array [0..max_char] of integer;
+@!char_repeats:array [0..max_char] of integer;
+@!diff:boolean;
+@!needed_space,@!extra_bytes:integer;
+
+@ @<Set init...@>=
+for ch_entry:=0 to max_char do begin
+ char_original[ch_entry]:=ch_entry;
+ char_repeats[ch_entry]:=0;
+ end;
+
+@ @<Read repeated character info@>=
+begin
+if not tables_read then begin
+ @<Compute the new header information for OFM files@>;
+ tables_read:=true;
+ end;
+c:=get_byte; {read the character code that is being specified}
+@<Print |c| in hex notation@>;
+crange:=get_byte; {read how many characters are being defined}
+if (crange<0) then begin
+ err_print('Character ranges must be positive');
+ crange:=0;
+ end;
+if ((c+crange)>max_char) then begin
+ err_print('Character range too large');
+ crange:=0;
+ end;
+print('-'); print_hex(c+crange);
+while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then read_character_property
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
+finish_inner_property_list;
+cprime:=c;
+for c:=(cprime+1) to (cprime+crange) do begin
+ char_wd[c]:=char_wd[cprime];
+ char_ht[c]:=char_ht[cprime];
+ char_dp[c]:=char_dp[cprime];
+ char_ic[c]:=char_ic[cprime];
+ for tab:=0 to (nki+nkf+nkr+nkg+nkp-1) do begin
+ char_table[c,tab]:= char_table[cprime,tab];
+ end;
+ end;
+end
+
+@ Tables for character parameters
+
+@d char_param_tables==8
+
+@<Globals...@>=
+@!char_table:array [0..max_char,0..char_param_tables] of integer;
+@!ch_table,@!ch_entry:integer;
+@!temp_value:integer;
+
+@ @<Set init...@>=
+for c:=0 to max_char do
+ for ch_table:=0 to char_param_tables do
+ char_table[c,ch_table]:=0;
+
+@ @<Read a character property@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<char_wd_code)or
+ ((cur_code>var_char_code)and
+ ((cur_code<char_ivalue_code)or(cur_code>char_penalty_code)))
+then
+ flush_error('This property name doesn''t belong in a CHARACTER list')
+@.This property name doesn't belong...@>
+else begin
+ case cur_code of
+ char_wd_code:char_wd[c]:=sort_in(width,get_fix);
+ char_ht_code:char_ht[c]:=sort_in(height,get_fix);
+ char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
+ char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
+ sec_width_code:temp_value:=get_fix;
+ sec_height_code:temp_value:=get_fix;
+ sec_depth_code:temp_value:=get_fix;
+ sec_italic_code:temp_value:=get_fix;
+ accent_code:temp_value:=get_fix;
+ prim_top_axis_code:temp_value:=get_fix;
+ prim_top_axis_bis_code:temp_value:=get_fix;
+ prim_bot_axis_code:temp_value:=get_fix;
+ prim_bot_axis_bis_code:temp_value:=get_fix;
+ prim_mid_hor_code:temp_value:=get_fix;
+ prim_mid_vert_code:temp_value:=get_fix;
+ prim_base_slant_code:temp_value:=get_fix;
+ sec_top_axis_code:temp_value:=get_fix;
+ sec_top_axis_bis_code:temp_value:=get_fix;
+ sec_bot_axis_code:temp_value:=get_fix;
+ sec_bot_axis_bis_code:temp_value:=get_fix;
+ sec_mid_hor_code:temp_value:=get_fix;
+ sec_mid_vert_code:temp_value:=get_fix;
+ sec_base_slant_code:temp_value:=get_fix;
+ next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
+ char_remainder[c]:=get_byte;
+ end;
+ var_char_code:@<Read an extensible recipe for |c|@>;
+ char_ivalue_code: begin
+ ch_table:=get_integer;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkci then nkci:=ch_table;
+ end;
+ char_fvalue_code: begin
+ ch_table:=get_integer+nki;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcf then nkcf:=ch_table;
+ end;
+ char_mvalue_code: begin
+ ch_table:=get_integer+nki+nkf;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcm then nkcm:=ch_table;
+ end;
+ char_rule_code: begin
+ ch_table:=get_integer+nki+nkf+nkm;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcr then nkcr:=ch_table;
+ end;
+ char_glue_code: begin
+ ch_table:=get_integer+nki+nkf+nkm+nkr;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcg then nkcg:=ch_table;
+ end;
+ char_penalty_code: begin
+ ch_table:=get_integer+nki+nkf+nkm+nkr+nkg;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcp then nkcp:=ch_table;
+ end;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ @<Read an extensible r...@>=
+begin if ne=xmax_char then
+ err_print('Sorry, too many VARCHAR specs')
+@.Sorry, too many VARCHAR specs@>
+else begin
+ check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
+ exten[ne]:=zero_bytes;
+ while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an extensible piece@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ incr(ne);
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an extensible p...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then
+ flush_error('This property name doesn''t belong in a VARCHAR list')
+@.This property name doesn't belong...@>
+else begin
+ case cur_code-(var_char_code+1) of
+ 0:exten[ne].b0:=get_byte;
+ 1:exten[ne].b1:=get_byte;
+ 2:exten[ne].b2:=get_byte;
+ 3:exten[ne].b3:=get_byte;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ The input routine is now complete except for the following code,
+which prints a progress report as the file is being read.
+@<Glob...@>=
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+
+@ @<Set init...@>=
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+HEX:='0123456789ABCDEF';@/
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+
+@ The array |dig| will hold a sequence of digits to be output.
+
+@<Glob...@>=
+@!dig:array[0..32] of integer;
+
+@ Here, in fact, are two procedures that output
+|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
+
+@p procedure out_digs(j:integer); {outputs |j| digits}
+begin repeat decr(j); out(HEX[1+dig[j]]);
+until j=0;
+end;
+@#
+procedure print_digs(j:integer); {prints |j| digits}
+begin repeat decr(j); print(HEX[1+dig[j]]);
+until j=0;
+end;
+
+
+@ The |print_number| procedure indicates how |print_digs| can be used.
+This procedure can print in octal, decimal or hex notation.
+
+@d print_hex(#)==print_number(#,16)
+@d print_octal(#)==print_number(#,8)
+@d print_decimal(#)==print_number(#,10)
+
+@p procedure print_number(c:integer; form:integer); {prints value of |c|}
+var j:0..32; {index into |dig|}
+begin
+j:=0;
+if (c<0) then begin
+ print_ln('Internal error: print_number (negative value)');
+ c:=0
+ end;
+if form=8 then
+ print('''') {an apostrophe indicates the octal notation}
+else if form=16 then
+ print('"') { a double apostrophe indicates the hexadecimal notation}
+else if form<>10 then begin
+ print_ln('Internal error: print_number');
+ form:=10
+ end;
+while (c>0) or (j=0) do begin
+ dig[j]:=c mod form; c:=c div form;
+ j:=j+1;
+ end;
+print_digs(j);
+end;
+
+
+@ @<Print |c| in hex...@>=
+begin if chars_on_line=8 then begin
+ print_ln(' '); chars_on_line:=1;
+ end
+else begin
+ if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+print_hex(c); {progress report}
+end
+
+@* The checking and massaging phase.
+Once the whole \.{PL} file has been read in, we must check it for consistency
+and correct any errors. This process consists mainly of running through
+the characters that exist and seeing if they refer to characters that
+don't exist. We also compute the true value of |seven_unsafe|; we make sure
+that the charlists and ligature programs contain no loops; and we
+shorten the lists of widths, heights, depths, and italic corrections,
+if necessary, to keep from exceeding the required maximum sizes.
+
+@<Glob...@>=
+@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?}
+
+@ @<Correct and check the information@>=
+if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>;
+seven_unsafe:=false;
+for c:=0 to max_char do if char_wd[c]<>0 then
+ @<For all characters |g| generated by |c|,
+ make sure that |char_wd[g]| is nonzero, and
+ set |seven_unsafe| if |c<128<=g|@>;
+if bchar_label<xmax_label then begin
+ c:=xmax_char; @<Check ligature program of |c|@>;
+ end;
+if seven_bit_safe_flag and seven_unsafe then
+ print_ln('The font is not really seven-bit-safe!');
+@.The font is not...safe@>
+@<Check for infinite ligature loops@>;
+@<Doublecheck the lig/kern commands and the extensible recipes@>;
+finish_extended_font;
+for c:=0 to max_char do
+ @<Make sure that |c| is not the largest element of a charlist cycle@>;
+@<Put the width, height, depth, and italic lists into final form@>
+
+@ The checking that we need in several places is accomplished by three
+macros that are only slightly tricky.
+
+@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0);
+ print(#,' '); print_hex(c);
+ print_ln(' had no CHARACTER spec.');
+ end;
+ end
+@d check_existence_and_safety(#)==begin g:=#;
+ if (g>=128)and(c<128) then seven_unsafe:=true;
+ if char_wd[g]=0 then existence_tail
+@d check_existence(#)==begin g:=#;
+ if char_wd[g]=0 then existence_tail
+
+@<For all characters |g| generated by |c|...@>=
+case char_tag[c] of
+ no_tag: do_nothing;
+ lig_tag: @<Check ligature program of |c|@>;
+ list_tag: check_existence_and_safety(char_remainder[c])
+ ('The character NEXTLARGER than');
+@.The character NEXTLARGER...@>
+ ext_tag:@<Check the pieces of |exten[c]|@>;
+ end
+
+@ @<Check the pieces...@>=
+begin if exten[char_remainder[c]].b0>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b0)
+ ('TOP piece of character');
+@.TOP piece of character...@>
+if exten[char_remainder[c]].b1>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b1)
+ ('MID piece of character');
+@.MID piece of character...@>
+if exten[char_remainder[c]].b2>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b2)
+ ('BOT piece of character');
+@.BOT piece of character...@>
+check_existence_and_safety(exten[char_remainder[c]].b3)
+ ('REP piece of character');
+@.REP piece of character...@>
+end
+
+@ @<Make sure that |c| is not the largest element of a charlist cycle@>=
+if char_tag[c]=list_tag then begin
+ g:=char_remainder[c];
+ while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g];
+ if g=c then begin
+ char_tag[c]:=no_tag;
+ print('A cycle of NEXTLARGER characters has been broken at ');
+@.A cycle of NEXTLARGER...@>
+ print_hex(c); print_ln('.');
+ end;
+ end
+
+@ @<Global...@>=
+@!delta:fix_word; {size of the intervals needed for rounding}
+
+@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
+@.I had to round...@>
+ #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
+
+@<Put the width, height, depth, and italic lists into final form@>=
+case ofm_level of
+ -1: begin
+ top_width:=255; top_depth:=15; top_height:=15; top_italic:=63;
+ end;
+ 0: begin
+ top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255;
+ end;
+ 1: begin
+ top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255;
+ end;
+ end;
+delta:=shorten(width,top_width); set_indices(width,delta);
+ round_message('width');@/
+delta:=shorten(height,top_height); set_indices(height,delta);
+ round_message('height');@/
+delta:=shorten(depth,top_depth); set_indices(depth,delta);
+ round_message('depth');@/
+delta:=shorten(italic,top_italic); set_indices(italic,delta);
+ round_message('italic correction');
+
+@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}}
+ lig_kern[nl].b0:=255; lig_kern[nl].b1:=0;
+ lig_kern[nl].b2:=0; lig_kern[nl].b3:=0
+
+@<Make sure the ligature/kerning program ends...@>=
+begin if bchar_label<xmax_label then {make room for it} begin
+ clear_lig_kern_entry; incr(nl);
+ end; {|bchar_label| will be stored later}
+while min_nl>nl do begin
+ clear_lig_kern_entry; incr(nl);
+ end;
+if (lig_kern[nl-1].b0 mod 256)=0 then
+ lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
+end
+
+@ It's not trivial to check for infinite loops generated by repeated
+insertion of ligature characters. But fortunately there is a nice
+algorithm for such testing, copied here from the program \.{TFtoPL}
+where it is explained further.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+
+@ @<Glo...@>=
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!hash:array[0..hash_size] of integer;
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of xxchar_type;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!tt:indx; {temporary register}
+@!x_lig_cycle,@!y_lig_cycle:xchar_type; {problematic ligature pair}
+
+@ @<Set init...@>=
+hash_ptr:=0; y_lig_cycle:=xmax_char;
+for k:=0 to hash_size do hash[k]:=0;
+
+@ @d lig_exam==lig_kern[lig_ptr].b1
+@d lig_gen==lig_kern[lig_ptr].b3
+
+@<Check lig...@>=
+begin lig_ptr:=char_remainder[c];
+if (lig_kern[lig_ptr].b0 div 256)=0 then
+begin
+repeat if hash_input(lig_ptr,c) then begin
+ if lig_kern[lig_ptr].b2<kern_flag then begin
+ if lig_exam<>bchar then
+ check_existence(lig_exam)('LIG character examined by');
+@.LIG character examined...@>
+ check_existence(lig_gen)('LIG character generated by');
+@.LIG character generated...@>
+ if lig_gen>=128 then if(c<128)or(c=bchar) then
+ if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true;
+ end
+ else if lig_exam<>bchar then
+ check_existence(lig_exam)('KRN character examined by');
+@.KRN character examined...@>
+ end;
+if (lig_kern[lig_ptr].b0 mod 256)>=stop_flag then lig_ptr:=nl
+else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0;
+until lig_ptr>=nl;
+end;
+end
+
+@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made
+into a boolean function that returns |false| if the ligature command
+was masked by a previous one.
+
+@p function hash_input(@!p,@!c:indx):boolean;
+ {enter data for character |c| and command in location |p|, unless it isn't new}
+label 30; {go here for a quick exit}
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:char_type; {function value or ligature character being entered}
+@!y:char_type; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then
+ begin hash_input:=false; goto 30;@+end;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
+while hash[h]>0 do begin
+ if hash[h]<=key then begin
+ if hash[h]=key then begin
+ hash_input:=false; goto 30; {unused ligature command}
+ end;
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+hash_input:=true;
+30:end;
+
+@ @<Compute the command param...@>=
+y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple;
+zz:=lig_kern[p].b3;
+if t>=kern_flag then zz:=y
+else begin
+ case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ (More good stuff from \.{TFtoPL}.)
+
+@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:indx):indx| here.
+
+@p function f;
+begin
+case class[h] of
+ simple: do_nothing;
+ left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+ right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+ both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+ pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
+ lig_z[h]:=xxmax_char; class[h]:=simple;
+ end; {the value |xxmax_char| will break all cycles,
+ since it's not in |hash|}
+ end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@ @<Check for infinite...@>=
+if hash_ptr<hash_size then for hh:=1 to hash_ptr do begin
+ tt:=hash_list[hh];
+ if class[tt]>simple then {make sure $f$ is well defined}
+ tt:=f(tt,(hash[tt]-1)div xmax_char,(hash[tt]-1)mod xmax_char);
+ end;
+if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then begin
+ if hash_ptr<hash_size then begin
+ print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=xmax_char
+ then print('boundary')@+else print_hex(x_lig_cycle);
+ print(' and '); print_hex(y_lig_cycle); print_ln('!');
+ end
+ else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ print_ln('All ligatures will be cleared.');
+ for c:=0 to max_char do if char_tag[c]=lig_tag then begin
+ char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+ nl:=0; bchar:=xmax_char; bchar_label:=xmax_label;
+ end
+
+@ The lig/kern program may still contain references to nonexistent characters,
+if parts of that program are never used. Similarly, there may be extensible
+characters that are never used, because they were overridden by
+\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we
+must fix such errors.
+
+@d double_check_tail(#)==@t\1@>if char_wd[0]=0
+ then char_wd[0]:=sort_in(width,0);
+ print('Unused ',#,' refers to nonexistent character ');
+ print_hex(c); print_ln('!');
+ end;
+ end
+@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#;
+ if char_wd[c]=0 then if c<>bchar then
+ begin lig_kern[lig_ptr].#:=0; double_check_tail
+@d double_check_ext(#)==begin c:=exten[g].#;
+ if c>0 then if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+@d double_check_rep(#)==begin c:=exten[g].#;
+ if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+
+@<Doublecheck...@>=
+if nl>0 then for lig_ptr:=0 to nl-1 do
+ if (lig_kern[lig_ptr].b0 div 256)=0 then begin
+ if lig_kern[lig_ptr].b2<kern_flag then begin
+ if lig_kern[lig_ptr].b0<255 then begin
+ double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
+ end;
+ end
+ else double_check_lig(b1)('KRN step');
+ end;
+@.Unused LIG step...@>
+@.Unused KRN step...@>
+if ne>0 then for g:=0 to ne-1 do begin
+ double_check_ext(b0)('VARCHAR TOP');
+ double_check_ext(b1)('VARCHAR MID');
+ double_check_ext(b2)('VARCHAR BOT');
+ double_check_rep(b3)('VARCHAR REP');
+@.Unused VARCHAR...@>
+ end
+
+@* The output phase.
+Now that we know how to get all of the font data correctly stored in
+\.{PLtoTF}'s memory, it only remains to write the answers out.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{TFM} file:
+
+@d out(#)==write(tfm_file,#)
+
+@ The general plan for producing \.{TFM} files is long but simple:
+
+@<Do the font metric output@>=
+compute_subfile_sizes;
+output_subfile_sizes;
+@<Output the header block@>;
+output_new_information_ofm;
+output_character_info;
+@<Output the dimensions themselves@>;
+@<Output the ligature/kern program@>;
+@<Output the extensible character recipes@>;
+@<Output the parameters@>;
+
+@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are.
+We already know most of these numbers; for example, the number of distinct
+widths is |memory[width]+1|, where the $+1$ accounts for the zero width that
+is always supposed to be present. But we still should compute the beginning
+and ending character codes (|bc| and |ec|), the number of header words (|lh|),
+and the total number of words in the \.{TFM} file (|lf|).
+
+@<Gl...@>=
+@!bc:byte; {the smallest character code in the font}
+@!ec:byte; {the largest character code in the font}
+@!lh:byte; {the number of words in the header block}
+@!lf:unsigned_integer; {the number of words in the entire \.{TFM} file}
+@!not_found:boolean; {has a font character been found?}
+@!temp_width:fix_word; {width being used to compute a check sum}
+@!ncw,@!nco,@!npc:integer;
+
+@ It might turn out that no characters exist at all. But \.{PLtoTF} keeps
+going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
+will be~1.
+
+@<Compute the subfile sizes@>=
+case ofm_level of
+ -1: begin
+ lh:=header_ptr div 4;@/
+ not_found:=true; bc:=0;
+ while not_found do
+ if (char_wd[bc]>0)or(bc=255) then not_found:=false
+ else incr(bc);
+ not_found:=true; ec:=255;
+ while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+ if bc>ec then bc:=1;
+ incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+ incr(memory[italic]);@/
+ @<Compute the ligature/kern program offset@>;
+ lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+ memory[italic]+nl+lk_offset+nk+ne+np;
+ end;
+ 0: begin
+ lh:=header_ptr div 4;@/
+ not_found:=true; bc:=0;
+ while not_found do
+ if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
+ else incr(bc);
+ not_found:=true; ec:=max_char;
+ while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+ if bc>ec then bc:=1;
+ incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+ incr(memory[italic]);@/
+ @<Compute the ligature/kern program offset@>;
+ lf:=14+lh+2*(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+ memory[italic]+2*nl+lk_offset+nk+2*ne+np;
+ end;
+ 1: begin
+ lh:=header_ptr div 4;@/
+ not_found:=true; bc:=0;
+ while not_found do
+ if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
+ else incr(bc);
+ not_found:=true; ec:=max_char;
+ while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+ if bc>ec then bc:=1;
+ incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+ incr(memory[italic]);@/
+ @<Compute the ligature/kern program offset@>;
+ @<Compute the character info size@>;
+ lf:=29+lh+ncw+memory[width]+memory[height]+memory[depth]+
+ memory[italic]+2*(nl+lk_offset)+nk+2*ne+np+
+ nki+nwi+nkf+nwf+nkm+nwm++nkr+nwr+nkg+nwg+nkp+nwp;
+ nco:=29+lh+nki+nwi+nkf+nwf+nkm+nwm++nkr+nwr+nkg+nwg+nkp+nwp;
+ end;
+ end;
+
+@ @d out_size(#)==out((#) div 256); out((#) mod 256)
+ @d out_integer(#)==out((#) div @"1000000);
+ out(((#) mod @"1000000) div @"10000);
+ out(((#) mod @"10000) div @"100);
+ out((#) mod @"100)
+
+@<Output the subfile sizes@>=
+case ofm_level of
+ -1: begin
+ out_size(lf); out_size(lh); out_size(bc); out_size(ec);
+ out_size(memory[width]); out_size(memory[height]);
+ out_size(memory[depth]); out_size(memory[italic]);
+ out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np);
+ end;
+ 0: begin
+ out_integer(0);
+ out_integer(lf); out_integer(lh); out_integer(bc); out_integer(ec);
+ out_integer(memory[width]); out_integer(memory[height]);
+ out_integer(memory[depth]); out_integer(memory[italic]);
+ out_integer(nl+lk_offset); out_integer(nk);
+ out_integer(ne); out_integer(np); out_integer(font_dir);
+ end;
+ 1: begin
+ out_integer(1);
+ out_integer(lf); out_integer(lh);
+ out_integer(bc); out_integer(ec);
+ out_integer(memory[width]); out_integer(memory[height]);
+ out_integer(memory[depth]); out_integer(memory[italic]);
+ out_integer(nl+lk_offset); out_integer(nk);
+ out_integer(ne); out_integer(np); out_integer(font_dir);
+ out_integer(nco); out_integer(ncw); out_integer(npc);
+ out_integer(nki); out_integer(nwi); out_integer(nkf); out_integer(nwf);
+ out_integer(nkm); out_integer(nwm); out_integer(nkr); out_integer(nwr);
+ out_integer(nkg); out_integer(nwg); out_integer(nkp); out_integer(nwp);
+ end;
+ end;
+
+@ The routines that follow need a few temporary variables of different types.
+
+@<Gl...@>=
+@!j:0..max_header_bytes; {index into |header_bytes|}
+@!p:pointer; {index into |memory|}
+@!q:width..italic; {runs through the list heads for dimensions}
+@!par_ptr:0..max_param_words; {runs through the parameters}
+
+@ The header block follows the subfile sizes. The necessary information all
+appears in |header_bytes|, except that the design size and the seven-bit-safe
+flag must still be set.
+
+@<Output the header block@>=
+if not check_sum_specified then @<Compute the check sum@>;
+header_bytes[design_size_loc]:=design_size div @'100000000;
+ {this works since |design_size>0|}
+header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256;
+header_bytes[design_size_loc+2]:=(design_size div 256) mod 256;
+header_bytes[design_size_loc+3]:=design_size mod 256;
+if not seven_unsafe then header_bytes[seven_flag_loc]:=128;
+for j:=0 to header_ptr-1 do out(header_bytes[j]);
+
+@ @<Compute the check sum@>=
+begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
+for c:=bc to ec do if char_wd[c]>0 then begin
+ temp_width:=memory[char_wd[c]];
+ if design_units<>unity then
+ temp_width:=round((temp_width/design_units)*1048576.0);
+ temp_width:=temp_width + (c+4)*@'20000000; {this should be positive}
+ c0:=(c0+c0+temp_width) mod 255;
+ c1:=(c1+c1+temp_width) mod 253;
+ c2:=(c2+c2+temp_width) mod 251;
+ c3:=(c3+c3+temp_width) mod 247;
+ end;
+header_bytes[check_sum_loc]:=c0;
+header_bytes[check_sum_loc+1]:=c1;
+header_bytes[check_sum_loc+2]:=c2;
+header_bytes[check_sum_loc+3]:=c3;
+end
+
+@ @<Global...@>=
+@!tab:integer;
+
+@
+@<Compute the character info size@>=
+if ofm_level=1 then begin
+ ncw:=0;
+ if nkcp>-1 then
+ npc:=nki+nkf+nkr+nkg+nkcp+1
+ else if nkcg>-1 then
+ npc:=nki+nkf+nkr+nkcg+1
+ else if nkcr>-1 then
+ npc:=nki+nkf+nkcr+1
+ else if nkcf>-1 then
+ npc:=nki+nkcf+1
+ else if nkci>-1 then
+ npc:=nkci+1
+ else
+ npc:=0;
+ needed_space:=(12+npc*2) div 4;
+ extra_bytes:=(needed_space*4) - (10+npc*2);
+ for c:=bc to ec do begin
+ if char_original[c]=c then begin
+ cprime:=c+1;
+ diff:=false;
+ while (not diff) and (cprime<=ec) do begin
+ if index[char_wd[c]]<>index[char_wd[cprime]] then diff:=true;
+ if index[char_ht[c]]<>index[char_ht[cprime]] then diff:=true;
+ if index[char_dp[c]]<>index[char_dp[cprime]] then diff:=true;
+ if index[char_ic[c]]<>index[char_ic[cprime]] then diff:=true;
+ if char_remainder[c]<>char_remainder[cprime] then diff:=true;
+ for tab:=0 to npc-1 do begin
+ if char_table[c,tab]<>char_table[cprime,tab] then diff:=true;
+ end;
+ if not diff then begin
+ char_original[cprime]:=c;
+ cprime:=cprime+1;
+ end;
+ end;
+ if cprime>(c+1) then begin
+ char_repeats[c]:=cprime-c-1;
+ end;
+ ncw:=ncw+needed_space;
+ end;
+ end;
+ end;
+
+@ The next block contains packed |char_info|.
+
+@<Output the character info@>=
+index[0]:=0;
+for c:=bc to ec do
+case ofm_level of
+ -1: begin
+ out(index[char_wd[c]]);
+ out(index[char_ht[c]]*16+index[char_dp[c]]);
+ out(index[char_ic[c]]*4+char_tag[c]);
+ out(char_remainder[c]);
+ end;
+ 0: begin
+ out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256);
+ out(index[char_ht[c]]); out(index[char_dp[c]]);
+ out(index[char_ic[c]] div 64);out((index[char_ic[c]] mod 64)*4+char_tag[c]);
+ out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
+ end;
+ 1: begin
+ if c=char_original[c] then begin
+ out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256);
+ out(index[char_ht[c]]); out(index[char_dp[c]]);
+ out(index[char_ic[c]]);
+ tab:=char_tag[c];
+ if char_extended_tag[c] then begin
+ tab:=5;
+ end;
+ out(tab);
+ out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
+ out_size(char_repeats[c]);
+ for tab:=0 to npc-1 do begin
+ out(char_table[c,tab] div 256); out(char_table[c,tab] mod 256);
+ end;
+ for tab:=1 to extra_bytes do begin
+ out(0);
+ end;
+ end;
+ end;
+ end;
+
+
+@ When a scaled quantity is output, we may need to divide it by |design_units|.
+The following subroutine takes care of this, using floating point arithmetic
+only if |design_units<>1.0|.
+
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if abs(x/design_units)>=16.0 then begin
+ print_ln('The relative dimension ',x/@'4000000:1:3,
+ ' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then print(' =',design_units/@'200000:1:3,
+ ' designunits');
+ print_ln(')'); x:=0;
+ end;
+if design_units<>unity then x:=round((x/design_units)*1048576.0);
+if x<0 then begin
+ out(255); x:=x+@'100000000;
+ if x<=0 then x:=1;
+ end
+else begin out(0);
+ if x>=@'100000000 then x:=@'77777777;
+ end;
+n:=x div @'200000; m:=x mod @'200000;
+out(n); out(m div 256); out(m mod 256);
+end;
+
+@ We have output the packed indices for individual characters.
+The scaled widths, heights, depths, and italic corrections are next.
+
+@<Output the dimensions themselves@>=
+for q:=width to italic do begin
+ out(0); out(0); out(0); out(0); {output the zero word}
+ p:=link[q]; {head of list}
+ while p>0 do begin
+ out_scaled(memory[p]);
+ p:=link[p];
+ end;
+ end;
+
+@ One embarrassing problem remains: The ligature/kern program might be very
+long, but the starting addresses in |char_remainder| can be at most~255.
+Therefore we need to output some indirect address information; we want to
+compute |lk_offset| so that addition of |lk_offset| to all remainders makes
+all but |lk_offset| distinct remainders less than~256.
+
+For this we need a sorted table of all relevant remainders.
+
+@<Glob...@>=
+@!label_table:array[xchar_type] of record
+ @!rr: -1..xmax_label; {sorted label values}
+ @!cc: integer; {associated characters}
+ end;
+@!label_ptr:xchar_type; {index of highest entry in |label_table|}
+@!sort_ptr:xchar_type; {index into |label_table|}
+@!lk_offset:xchar_type; {smallest offset value that might work}
+@!t:0..xmax_label; {label value that is being redirected}
+@!extra_loc_needed:boolean; {do we need a special word for |bchar|?}
+
+@ @<Compute the ligature/kern program offset@>=
+@<Insert all labels into |label_table|@>;
+if bchar<xmax_char then begin
+ extra_loc_needed:=true; lk_offset:=1;
+ end
+else begin
+ extra_loc_needed:=false; lk_offset:=0;
+ end;
+@<Find the minimum |lk_offset| and adjust all remainders@>;
+if bchar_label<xmax_label then begin
+ if ofm_level=-1 then begin
+ lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 256;
+ lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 256;
+ end
+ else begin
+ lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 65536;
+ lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 65536;
+ end
+ end
+
+@ @<Insert all labels...@>=
+label_ptr:=0; label_table[0].rr:=-1; {sentinel}
+for c:=bc to ec do if char_tag[c]=lig_tag then begin
+ sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+ while label_table[sort_ptr].rr>char_remainder[c] do begin
+ label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+ label_table[sort_ptr+1].cc:=c;
+ label_table[sort_ptr+1].rr:=char_remainder[c];
+ incr(label_ptr);
+ end
+
+@ @<Find the minimum |lk_offset| and adjust all remainders@>=
+begin sort_ptr:=label_ptr; {the largest unallocated label}
+if ofm_level=-1 then begin
+ if label_table[sort_ptr].rr+lk_offset > 255 then begin
+ lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
+ repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin
+ decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ end;
+ incr(lk_offset); decr(sort_ptr);
+ until lk_offset+label_table[sort_ptr].rr<256;
+ {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|}
+ end;
+ end
+else begin
+ if label_table[sort_ptr].rr+lk_offset > 65535 then begin
+ lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
+ repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin
+ decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ end;
+ incr(lk_offset); decr(sort_ptr);
+ until lk_offset+label_table[sort_ptr].rr<65536;
+ {N.B.: |lk_offset=65536| satisfies this when |sort_ptr=0|}
+ end;
+ end;
+if lk_offset>0 then while sort_ptr>0 do begin
+ char_remainder[label_table[sort_ptr].cc]:=
+ char_remainder[label_table[sort_ptr].cc]+lk_offset;
+ decr(sort_ptr);
+ end;
+end
+
+@ @<Output the ligature/kern program@>=
+if ofm_level=-1 then begin
+ if extra_loc_needed then begin {|lk_offset=1|}
+ out(255); out(bchar); out(0); out(0);
+ end
+ else for sort_ptr:=1 to lk_offset do begin {output the redirection specs}
+ t:=label_table[label_ptr].rr;
+ if bchar<256 then begin
+ out(255); out(bchar);
+ end
+ else begin
+ out(254); out(0);
+ end;
+ out_size(t+lk_offset);
+ repeat decr(label_ptr); until label_table[label_ptr].rr<t;
+ end;
+ if nl>0 then for lig_ptr:=0 to nl-1 do begin
+ out(lig_kern[lig_ptr].b0);
+ out(lig_kern[lig_ptr].b1);
+ out(lig_kern[lig_ptr].b2);
+ out(lig_kern[lig_ptr].b3);
+ end;
+ if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
+ end
+else begin
+ if extra_loc_needed then {|lk_offset=1|} begin
+ out_size(255); out_size(bchar); out_size(0); out_size(0);
+ end
+ else
+ for sort_ptr:=1 to lk_offset do {output the redirection specs} begin
+ t:=label_table[label_ptr].rr;
+ if bchar<xmax_char then begin
+ out_size(255); out_size(bchar);
+ end
+ else begin
+ out_size(254); out_size(0);
+ end;
+ out_size((t+lk_offset) div 256);
+ out_size((t+lk_offset) mod 256);
+ repeat decr(label_ptr); until label_table[label_ptr].rr<t;
+ end;
+ if nl>0 then for lig_ptr:=0 to nl-1 do begin
+ out_size(lig_kern[lig_ptr].b0);
+ out_size(lig_kern[lig_ptr].b1);
+ out_size(lig_kern[lig_ptr].b2);
+ out_size(lig_kern[lig_ptr].b3);
+ end;
+ if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
+ end
+
+@ @<Output the extensible character recipes@>=
+if ofm_level=-1 then begin
+ if ne>0 then for c:=0 to ne-1 do begin
+ out(exten[c].b0);
+ out(exten[c].b1);
+ out(exten[c].b2);
+ out(exten[c].b3);
+ end;
+ end
+else begin
+ if ne>0 then for c:=0 to ne-1 do begin
+ out_size(exten[c].b0);
+ out_size(exten[c].b1);
+ out_size(exten[c].b2);
+ out_size(exten[c].b3);
+ end;
+ end;
+
+@ For our grand finale, we wind everything up by outputting the parameters.
+
+@<Output the parameters@>=
+for par_ptr:=1 to np do begin
+ if par_ptr=1 then
+ @<Output the slant (|param[1]|) without scaling@>
+ else out_scaled(param[par_ptr]);
+ end
+
+@ @<Output the slant...@>=
+begin if param[1]<0 then begin
+ param[1]:=param[1]+@'10000000000;
+ out((param[1] div @'100000000)+256-64);
+ end
+else out(param[1] div @'100000000);
+out((param[1] div @'200000) mod 256);
+out((param[1] div 256) mod 256);
+out(param[1] mod 256);
+end
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+@p procedure param_enter;
+begin @<Enter the parameter names@>;
+end;
+@#
+procedure name_enter; {enter all names and their equivalents}
+begin @<Enter all of the names...@>;
+param_enter;
+end;
+@#
+procedure read_lig_kern;
+var @!krn_ptr:0..max_kerns; {an index into |kern|}
+@!c:integer; {runs through all character codes}
+begin @<Read ligature/kern list@>;
+end;
+@#
+procedure output_new_information_ofm;
+begin @<Output the new information for OFM files@>;
+end;
+@#
+procedure compute_new_header_ofm;
+begin @<Compute the new header information for OFM files@>;
+end;
+@#
+procedure finish_extended_font;
+begin @<Finish up the extended font stuff@>;
+end;
+@#
+procedure output_subfile_sizes;
+begin @<Output the subfile sizes@>;
+end;
+@#
+procedure compute_subfile_sizes;
+begin @<Compute the subfile sizes@>;
+end;
+@#
+procedure output_character_info;
+begin @<Output the character info@>;
+end;
+@#
+procedure read_font_rule_list;
+begin @<Read font rule list@>;
+end;
+@#
+procedure read_font_glue_list;
+begin @<Read font glue list@>;
+end;
+@#
+procedure read_font_penalty_list;
+begin @<Read font penalty list@>;
+end;
+@#
+procedure read_font_mvalue_list;
+begin @<Read font mvalue list@>;
+end;
+@#
+procedure read_font_fvalue_list;
+begin @<Read font fvalue list@>;
+end;
+@#
+procedure read_font_ivalue_list;
+begin @<Read font ivalue list@>;
+end;
+@#
+procedure read_repeated_character_info;
+begin @<Read repeated character info@>;
+end;
+@#
+procedure read_lig_kern_command;
+begin @<Read a ligature/kern command@>;
+end;
+@#
+procedure read_character_property;
+begin @<Read a character property@>;
+end;
+@#
+procedure read_char_info;
+begin @<Read character info list@>;
+end;
+@#
+procedure read_input;
+var @!c:integer; {header or parameter index}
+begin @<Read all the input@>;
+end;
+@#
+procedure corr_and_check;
+var @!c:integer; {runs through all character codes}
+@!hh:0..hash_size; {an index into |hash_list|}
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!g:byte; {a character generated by the current character |c|}
+begin @<Correct and check the information@>
+end;
+
+@ Here is where \.{PLtoTF} begins and ends.
+
+@p begin initialize;@/
+name_enter;@/
+read_input; print('.');@/
+corr_and_check;@/
+@<Do the font metric output@>;
+end.
+
+@ @<Global...@>=
+@!ofm_level:integer;
+
+@ @<Set init...@>=
+ofm_level:=-1; {Suppose that it is a TFM file}
+
+@ @<Read OFM level code@>=
+begin
+ofm_level:=get_integer;
+if (ofm_level<0) or (ofm_level>1) then begin
+ flush_error('OFMLEVEL must be 0 or 1 -- 1 assumed');
+ ofm_level:=1;
+ end;
+end
+
+@ @<Read font direction code@>=
+begin
+font_dir:=-1;
+repeat get_next;
+until cur_char<>" ";
+case cur_char of
+ "T": begin get_next;
+ if cur_char="L" then font_dir:=0
+ else if cur_char="R" then font_dir:=2;
+ end;
+ "B": begin get_next;
+ if cur_char="L" then font_dir:=4
+ else if cur_char="R" then font_dir:=6;
+ end;
+ "R": begin get_next;
+ if cur_char="T" then font_dir:=5
+ else if cur_char="B" then font_dir:=7;
+ end;
+ "L": begin get_next;
+ if cur_char="T" then font_dir:=1
+ else if cur_char="B" then font_dir:=3;
+ end;
+ end;
+while cur_char<>")" do get_next;
+if font_dir = -1 then begin
+ flush_error('FONTDIR must be valid direction, -- TR assumed');
+ font_dir:=0;
+ end;
+end
+
+@ @<Read natural font direction code@>=
+begin
+font_dir:=-1;
+repeat get_next;
+until cur_char<>" ";
+case cur_char of
+ "T": begin get_next;
+ if cur_char="L" then font_dir:=8
+ else if cur_char="R" then font_dir:=10;
+ end;
+ "B": begin get_next;
+ if cur_char="L" then font_dir:=12
+ else if cur_char="R" then font_dir:=14;
+ end;
+ "R": begin get_next;
+ if cur_char="T" then font_dir:=13
+ else if cur_char="B" then font_dir:=15;
+ end;
+ "L": begin get_next;
+ if cur_char="T" then font_dir:=9
+ else if cur_char="B" then font_dir:=11;
+ end;
+ end;
+while cur_char<>")" do get_next;
+if font_dir = -1 then begin
+ flush_error('NFONTDIR must be valid direction, -- TR assumed');
+ font_dir:=8;
+ end;
+end
+
+@
+Here are some general values for the various entries.
+They can all be changed.
+
+@d arrays_per_kind==20
+@d entries_per_array==200
+
+@ @<Constants...@>=
+@!rule_arrays=arrays_per_kind;
+@!rule_entries=entries_per_array;
+
+@ @<Types...@>=
+rule_array_type=0..rule_arrays;
+rule_entry_type=0..rule_entries;
+rule_node=
+record
+ rn_width: fix_word;
+ rn_height: fix_word;
+ rn_depth: fix_word;
+end;
+
+@ @<Global...@>=
+@!rules:array[rule_array_type,rule_entry_type] of rule_node;
+@!npr:array[rule_array_type] of integer;
+@!nkr:integer;
+@!nkcr:integer;
+@!nwr:integer;
+@!r_array:integer;
+@!r_number:integer;
+
+@ @<Set init...@>=
+for r_array := 0 to rule_arrays do begin
+ npr[r_array]:=0;
+ @<Null out the rule@>;
+ end;
+nkr:=-1;
+nkcr:=-1;
+
+@ @<Read font rule list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+r_array:=get_integer;
+if r_array>rule_arrays then
+ flush_error('This FONTRULE table index is too big for my present size')
+else if r_array<0 then
+ flush_error('This FONTRULE index is negative')
+else begin
+ if r_array>nkr then nkr:=r_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a rule@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read a rule@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>rule_code then
+ flush_error('This property name doesn''t belong in a RULE list')
+else begin
+ r_number:=get_integer;
+ if r_number>rule_entries then
+ flush_error('This RULE index is too big for my present table size')
+ else if r_number<0 then
+ flush_error('This RULE index is negative')
+ else begin
+ while npr[r_array]<r_number do begin
+ incr(npr[r_array]); @<Null out the rule@>;
+ end;
+ @<Read all of a rule's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the rule@>=
+begin
+rules[r_array,npr[r_array]].rn_width:=0;
+rules[r_array,npr[r_array]].rn_depth:=0;
+rules[r_array,npr[r_array]].rn_height:=0;
+end
+
+@ @<Read all of a rule's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single rule value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single rule value@>=
+begin
+get_name;
+case cur_code of
+ rule_width_code:
+ rules[r_array,r_number].rn_width:=get_fix;
+ rule_height_code:
+ rules[r_array,r_number].rn_height:=get_fix;
+ rule_depth_code:
+ rules[r_array,r_number].rn_depth:=get_fix;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for rules@>=
+begin
+nwr:=0;
+for r_array := 0 to nkr do begin
+ incr(npr[r_array]);
+ nwr := nwr + 3*npr[r_array];
+ end;
+incr(nkr);
+end
+
+@ @<Output the rules@>=
+begin
+for r_array:= 0 to nkr-1 do
+ for r_number:=0 to npr[r_array]-1 do begin
+ out_scaled(rules[r_array,r_number].rn_width);
+ out_scaled(rules[r_array,r_number].rn_height);
+ out_scaled(rules[r_array,r_number].rn_depth);
+ end;
+end
+
+@ @<Output the rule headers@>=
+begin
+for r_array:= 0 to nkr-1 do begin
+ out_integer(npr[r_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!glue_arrays=arrays_per_kind;
+@!glue_entries=entries_per_array;
+
+@
+@d t_normal==0
+@d t_aleaders==1
+@d t_cleaders==2
+@d t_xleaders==3
+
+@d o_unit==0
+@d o_fi==1
+@d o_fil==2
+@d o_fill==3
+@d o_filll==4
+
+@d g_space==0
+@d g_rule==1
+@d g_char==2
+
+@<Types...@>=
+glue_array_type=0..glue_arrays;
+glue_entry_type=0..glue_entries;
+glue_node=
+record
+ gn_width: fix_word;
+ gn_stretch: fix_word;
+ gn_shrink: fix_word;
+ gn_type: integer;
+ gn_arg_type: g_space..g_char;
+ gn_stretch_order: integer;
+ gn_shrink_order: integer;
+ gn_argument: integer;
+end;
+
+@ @<Global...@>=
+@!glues:array[glue_array_type,glue_entry_type] of glue_node;
+@!npg:array[glue_array_type] of integer;
+@!nkg:integer;
+@!nkcg:integer;
+@!nwg:integer;
+@!g_array:integer;
+@!g_byte:integer;
+@!g_number:integer;
+
+@ @<Set init...@>=
+for g_array := 0 to glue_arrays do
+begin
+ npg[g_array]:=0;
+ @<Null out the glue@>;
+end;
+nkg:=-1;
+nkcg:=-1;
+
+@ @<Read font glue list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+g_array:=get_integer;
+if g_array>glue_arrays then
+ flush_error('This FONTGLUE table index is too big for my present size')
+else if g_array<0 then
+ flush_error('This FONTGLUE index is negative')
+else begin
+ if g_array>nkg then nkg:=g_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a glue@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read a glue@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>glue_code then
+ flush_error('This property name doesn''t belong in a GLUE list')
+else begin
+ g_number:=get_integer;
+ if g_number>glue_entries then
+ flush_error('This GLUE index is too big for my present table size')
+ else if g_number<0 then
+ flush_error('This GLUE index is negative')
+ else begin
+ while npg[g_array]<g_number do begin
+ incr(npg[g_array]); @<Null out the glue@>;
+ end;
+ @<Read all of a glue's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the glue@>=
+begin
+glues[g_array,npg[g_array]].gn_width:=0;
+glues[g_array,npg[g_array]].gn_stretch:=0;
+glues[g_array,npg[g_array]].gn_shrink:=0;
+glues[g_array,npg[g_array]].gn_type:=0;
+glues[g_array,npg[g_array]].gn_arg_type:=0;
+glues[g_array,npg[g_array]].gn_stretch_order:=0;
+glues[g_array,npg[g_array]].gn_shrink_order:=0;
+glues[g_array,npg[g_array]].gn_argument:=0;
+end
+
+@ @<Read all of a glue's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single glue value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single glue value@>=
+begin
+get_name;
+case cur_code of
+ glue_width_code:
+ glues[g_array,g_number].gn_width:=get_fix;
+ glue_stretch_code:
+ glues[g_array,g_number].gn_stretch:=get_fix;
+ glue_shrink_code:
+ glues[g_array,g_number].gn_shrink:=get_fix;
+ glue_type_code: begin
+ g_byte:=get_integer;
+ if (g_byte<0) or (g_byte>3) then begin
+ g_byte:=0;
+ end;
+ glues[g_array,g_number].gn_type:=g_byte;
+ end;
+ glue_stretch_order_code: begin
+ g_byte:=get_integer;
+ if (g_byte<0) or (g_byte>4) then begin
+ g_byte:=0;
+ end;
+ glues[g_array,g_number].gn_stretch_order:=g_byte;
+ end;
+ glue_shrink_order_code: begin
+ g_byte:=get_integer;
+ if (g_byte<0) or (g_byte>4) then begin
+ g_byte:=0;
+ end;
+ glues[g_array,g_number].gn_shrink_order:=g_byte;
+ end;
+ glue_char_code: begin
+ glues[g_array,g_number].gn_argument:=get_integer;
+ glues[g_array,g_number].gn_arg_type:=g_char;
+ end;
+ glue_rule_code: begin
+ glues[g_array,g_number].gn_argument:=get_integer;
+ glues[g_array,g_number].gn_arg_type:=g_rule;
+ end;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for glues@>=
+begin
+nwg:=0;
+for g_array := 0 to nkg do begin
+ incr(npg[g_array]);
+ nwg := nwg + 4*npg[g_array];
+ end;
+incr(nkg);
+end
+
+@ @<Output the glues@>=
+begin
+for g_array:= 0 to nkg-1 do
+ for g_number:=0 to npg[g_array]-1 do begin
+ g_byte:=glues[g_array,g_number].gn_type*16+
+ glues[g_array,g_number].gn_arg_type;
+ out(g_byte);
+ g_byte:=glues[g_array,g_number].gn_stretch_order*16+
+ glues[g_array,g_number].gn_shrink_order;
+ out(g_byte);
+ g_byte:=glues[g_array,g_number].gn_argument div 256;
+ out(g_byte);
+ g_byte:=glues[g_array,g_number].gn_argument mod 256;
+ out(g_byte);
+ out_scaled(glues[g_array,g_number].gn_width);
+ out_scaled(glues[g_array,g_number].gn_stretch);
+ out_scaled(glues[g_array,g_number].gn_shrink);
+ end;
+end
+
+@ @<Output the glue headers@>=
+begin
+for g_array:= 0 to nkg-1 do begin
+ out_integer(npg[g_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!penalty_arrays=arrays_per_kind;
+@!penalty_entries=entries_per_array;
+
+@ @<Types...@>=
+penalty_array_type=0..penalty_arrays;
+penalty_entry_type=0..penalty_entries;
+penalty_node=
+record
+ pn_val: integer;
+end;
+
+@ @<Global...@>=
+@!penalties:array[penalty_array_type,penalty_entry_type] of penalty_node;
+@!npp:array[penalty_array_type] of integer;
+@!nkp:integer;
+@!nkcp:integer;
+@!nwp:integer;
+@!p_array:integer;
+@!p_number:integer;
+
+@ @<Set init...@>=
+for p_array := 0 to penalty_arrays do begin
+ npp[p_array]:=0;
+ @<Null out the penalty@>;
+ end;
+nkp:=-1;
+nkcp:=-1;
+
+@ @<Read font penalty list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+p_array:=get_integer;
+if p_array>penalty_arrays then
+ flush_error('This FONTPENALTY table index is too big for my present size')
+else if p_array<0 then
+ flush_error('This FONTPENALTY index is negative')
+else begin
+ if p_array>nkp then nkp:=p_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a penalty@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read a penalty@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>penalty_code then
+ flush_error('This property name doesn''t belong in a PENALTY list')
+else begin
+ p_number:=get_integer;
+ if p_number>penalty_entries then
+ flush_error('This PENALTY index is too big for my present table size')
+ else if p_number<0 then
+ flush_error('This PENALTY index is negative')
+ else begin
+ while npp[p_array]<p_number do begin
+ incr(npp[p_array]); @<Null out the penalty@>;
+ end;
+ @<Read all of a penalty's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the penalty@>=
+begin
+penalties[p_array,npp[p_array]].pn_val:=0;
+end
+
+@ @<Read all of a penalty's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single penalty value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single penalty value@>=
+begin
+get_name;
+case cur_code of
+ penalty_val_code:
+ penalties[p_array,p_number].pn_val:=get_integer;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for penalties@>=
+begin
+nwp:=0;
+for p_array := 0 to nkp do begin
+ incr(npp[p_array]);
+ nwp := nwp + npp[p_array];
+ end;
+incr(nkp);
+end
+
+@ @<Output the penalties@>=
+begin
+for p_array:= 0 to nkp-1 do
+ for p_number:=0 to npp[p_array]-1 do begin
+ out_integer(penalties[p_array,p_number].pn_val);
+ end;
+end
+
+@ @<Output the penalty headers@>=
+begin
+for p_array:= 0 to nkp-1 do begin
+ out_integer(npp[p_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!mvalue_arrays=arrays_per_kind;
+@!mvalue_entries=entries_per_array;
+
+@ @<Types...@>=
+mvalue_array_type=0..mvalue_arrays;
+mvalue_entry_type=0..mvalue_entries;
+mvalue_node=
+record
+ fn_val: fix_word;
+end;
+
+@ @<Global...@>=
+@!mvalues:array[mvalue_array_type,mvalue_entry_type] of mvalue_node;
+@!npm:array[mvalue_array_type] of integer;
+@!nkm:integer;
+@!nkcm:integer;
+@!nwm:integer;
+@!m_array:integer;
+@!m_number:integer;
+
+@ @<Set init...@>=
+for m_array := 0 to mvalue_arrays do begin
+ npm[m_array]:=0;
+ @<Null out the mvalue@>;
+ end;
+nkm:=-1;
+nkcm:=-1;
+
+@ @<Read font mvalue list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+m_array:=get_integer;
+if m_array>mvalue_arrays then
+ flush_error('This FONTMVALUE table index is too big for my present size')
+else if m_array<0 then
+ flush_error('This FONTMVALUE index is negative')
+else begin
+ if m_array>nkm then nkm:=m_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an mvalue@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an mvalue@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>mvalue_code then
+ flush_error('This property name doesn''t belong in an MVALUE list')
+else begin
+ m_number:=get_integer;
+ if m_number>mvalue_entries then
+ flush_error('This MVALUE index is too big for my present table size')
+ else if m_number<0 then
+ flush_error('This MVALUE index is negative')
+ else begin
+ while npm[m_array]<m_number do begin
+ incr(npm[m_array]); @<Null out the mvalue@>;
+ end;
+ @<Read all of an mvalue's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the mvalue@>=
+begin
+mvalues[m_array,npm[m_array]].fn_val:=0;
+end
+
+@ @<Read all of an mvalue's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single mvalue value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single mvalue value@>=
+begin
+get_name;
+case cur_code of
+ mvalue_val_code:
+ mvalues[m_array,m_number].fn_val:=get_fix;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for mvalues@>=
+begin
+nwm:=0;
+for m_array := 0 to nkm do begin
+ incr(npm[m_array]);
+ nwm := nwm + npm[m_array];
+ end;
+incr(nkm);
+end
+
+@ @<Output the mvalues@>=
+begin
+for m_array:= 0 to nkm-1 do
+ for m_number:=0 to npm[m_array]-1 do begin
+ out_scaled(mvalues[m_array,m_number].fn_val);
+ end;
+end
+
+@ @<Output the mvalue headers@>=
+begin
+for m_array:= 0 to nkm-1 do begin
+ out_integer(npm[m_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!fvalue_arrays=arrays_per_kind;
+@!fvalue_entries=entries_per_array;
+
+@ @<Types...@>=
+fvalue_array_type=0..fvalue_arrays;
+fvalue_entry_type=0..fvalue_entries;
+fvalue_node=
+record
+ fn_val: fix_word;
+end;
+
+@ @<Global...@>=
+@!fvalues:array[fvalue_array_type,fvalue_entry_type] of fvalue_node;
+@!npf:array[fvalue_array_type] of integer;
+@!nkf:integer;
+@!nkcf:integer;
+@!nwf:integer;
+@!f_array:integer;
+@!f_number:integer;
+
+@ @<Set init...@>=
+for f_array := 0 to fvalue_arrays do begin
+ npf[f_array]:=0;
+ @<Null out the fvalue@>;
+ end;
+nkf:=-1;
+nkcf:=-1;
+
+@ @<Read font fvalue list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+f_array:=get_integer;
+if f_array>fvalue_arrays then
+ flush_error('This FONTFVALUE table index is too big for my present size')
+else if f_array<0 then
+ flush_error('This FONTFVALUE index is negative')
+else begin
+ if f_array>nkf then nkf:=f_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an fvalue@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an fvalue@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>fvalue_code then
+ flush_error('This property name doesn''t belong in an FVALUE list')
+else begin
+ f_number:=get_integer;
+ if f_number>fvalue_entries then
+ flush_error('This FVALUE index is too big for my present table size')
+ else if f_number<0 then
+ flush_error('This FVALUE index is negative')
+ else begin
+ while npf[f_array]<f_number do begin
+ incr(npf[f_array]); @<Null out the fvalue@>;
+ end;
+ @<Read all of an fvalue's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the fvalue@>=
+begin
+fvalues[f_array,npf[f_array]].fn_val:=0;
+end
+
+@ @<Read all of an fvalue's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single fvalue value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single fvalue value@>=
+begin
+get_name;
+case cur_code of
+ fvalue_val_code:
+ fvalues[f_array,f_number].fn_val:=get_fix;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for fvalues@>=
+begin
+nwf:=0;
+for f_array := 0 to nkf do begin
+ incr(npf[f_array]);
+ nwf := nwf + npf[f_array];
+ end;
+incr(nkf);
+end
+
+@ @<Output the fvalues@>=
+begin
+for f_array:= 0 to nkf-1 do
+ for f_number:=0 to npf[f_array]-1 do begin
+ out_scaled(fvalues[f_array,f_number].fn_val);
+ end;
+end
+
+@ @<Output the fvalue headers@>=
+begin
+for f_array:= 0 to nkf-1 do begin
+ out_integer(npf[f_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!ivalue_arrays=arrays_per_kind;
+@!ivalue_entries=entries_per_array;
+
+@ @<Types...@>=
+ivalue_array_type=0..ivalue_arrays;
+ivalue_entry_type=0..ivalue_entries;
+ivalue_node=
+record
+ in_val: integer;
+end;
+
+@ @<Global...@>=
+@!ivalues:array[ivalue_array_type,ivalue_entry_type] of ivalue_node;
+@!npi:array[ivalue_array_type] of integer;
+@!font_i_array:boolean;
+@!nki:integer;
+@!nkci:integer;
+@!nwi:integer;
+@!i_array:integer;
+@!i_number:integer;
+
+@ @<Set init...@>=
+for i_array := 0 to ivalue_arrays do begin
+ npi[i_array]:=0;
+ @<Null out the ivalue@>;
+ end;
+nki:=-1;
+nkci:=-1;
+
+@ @<Read font ivalue list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+i_array:=get_integer;
+if i_array>ivalue_arrays then
+ flush_error('This FONTIVALUE table index is too big for my present size')
+else if i_array<0 then
+ flush_error('This FONTIVALUE index is negative')
+else begin
+ if i_array>nki then nki:=i_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an ivalue@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an ivalue@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>ivalue_code then
+ flush_error('This property name doesn''t belong in an IVALUE list')
+else begin
+ i_number:=get_integer;
+ if i_number>ivalue_entries then
+ flush_error('This IVALUE index is too big for my present table size')
+ else if i_number<0 then
+ flush_error('This IVALUE index is negative')
+ else begin
+ while npi[i_array]<i_number do begin
+ incr(npi[i_array]); @<Null out the ivalue@>;
+ end;
+ @<Read all of an ivalue's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the ivalue@>=
+begin
+ivalues[i_array,npi[i_array]].in_val:=0;
+end
+
+@ @<Read all of an ivalue's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single ivalue value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single ivalue value@>=
+begin
+get_name;
+case cur_code of
+ ivalue_val_code:
+ ivalues[i_array,i_number].in_val:=get_integer;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for ivalues@>=
+begin
+nwi:=0;
+for i_array := 0 to nki do begin
+ incr(npi[i_array]);
+ nwi := nwi + npi[i_array];
+ end;
+incr(nki);
+end
+
+@ @<Output the ivalues@>=
+begin
+for i_array:= 0 to nki-1 do
+ for i_number:=0 to npi[i_array]-1 do begin
+ out_integer(ivalues[i_array,i_number].in_val);
+ end;
+end
+
+@ @<Output the ivalue headers@>=
+begin
+for i_array:= 0 to nki-1 do begin
+ out_integer(npi[i_array]);
+ end;
+end
+
+@ @<Compute the new header information for OFM files@>=
+begin
+@<Header information for ivalues@>;
+@<Header information for fvalues@>;
+@<Header information for mvalues@>;
+@<Header information for rules@>;
+@<Header information for glues@>;
+@<Header information for penalties@>;
+end
+
+@ @<Output the new information for OFM files@>=
+begin
+@<Output the ivalue headers@>;
+@<Output the fvalue headers@>;
+@<Output the mvalue headers@>;
+@<Output the rule headers@>;
+@<Output the glue headers@>;
+@<Output the penalty headers@>;
+@<Output the ivalues@>;
+@<Output the fvalues@>;
+@<Output the rules@>;
+@<Output the glues@>;
+@<Output the penalties@>;
+end
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PLtoTF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/omegaware/otangle.ch b/Build/source/texk/web2c/omegaware/otangle.ch
new file mode 100644
index 00000000000..3e85ff8bbc7
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/otangle.ch
@@ -0,0 +1,474 @@
+% otangle.ch: web2c changes to file tangle.ch
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original tangle.ch.
+%
+% otangle.ch for C compilation with web2c.
+%
+% 10/9/82 (HT) Original version
+% 11/29 (HT) New version, with conversion to lowercase handled properly
+% Also, new control sequence:
+% @=...text...@> Put ...text... verbatim on a line
+% by itself in the Pascal output.
+% (argument must fit on one line)
+% This control sequence facilitates putting #include "gcons.h"
+% (for example) in files meant for the pc compiler.
+% Also, changed command line usage, so that the absence of a
+% change file implies no change file, rather than one with the
+% same name as the web file, with .ch at the end.
+% 1/15/83 (HT) Changed to work with version 1.2, which incorporates the
+% above change (though unbundling the output line breaking),
+% so mainly had to remove stuff.
+% 2/17 (HT) Fixed bug that caused 0-9 in identifiers to be converted to
+% Q-Y on output.
+% 3/18 (HT) Brought up to work with Version 1.5. Added -r command line
+% flag to cause a .rpl file to be written with all the lines
+% of the .web file that were replaced because of the .ch file
+% (useful for comparing with previous .rpl files, to see if a
+% change file will still work with a new version of a .web file)
+% Also, made it write a newline just before exit.
+% 4/12 (PC) Merged with Pavel's version, including adding a call to exit()
+% at the end depending upon the value of history.
+% 4/16 (PC) Brought up to date with version 1.5 released April, 1983.
+% 6/28 (HWT) Brought up to date with version 1.7 released June, 1983.
+% With new change file format, the -r option is now unnecessary.
+% 7/17 (HWT) Brought up to date with version 2.0 released July, 1983.
+% 12/18/83 (ETM) Brought up to date with version 2.5 released November, 1983.
+% 11/07/84 (ETM) Brought up to date with version 2.6.
+% 12/15/85 (ETM) Brought up to date with version 2.8.
+% 03/07/88 (ETM) Converted for use with WEB2C
+% 01/02/89 (PAM) Cosmetic upgrade to version 2.9
+% 11/30/89 (KB) Version 4.
+% (more recent changes in the ChangeLog)
+
+@x [0] Print only changes.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{TANGLE changes for C}
+@z
+
+@x [?] Define and call parse_arguments.
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values@>@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+ @<Set initial values@>@/
+@z
+
+@x [8] Constants: increase id lengths, for TeX--XeT and tex2pdf.
+@!buf_size=100; {maximum length of input line}
+@y
+@!buf_size=3000; {maximum length of input line}
+@z
+@x
+@!max_names=10239; {number of identifiers, strings, module names;
+ must be less than 10240}
+@!max_texts=10239; {number of replacement texts, must be less than 10240}
+@y
+@!max_names=10239; {number of identifiers, strings, module names;
+ must be less than 10240}
+@!max_texts=10239; {number of replacement texts, must be less than 10240}
+@z
+
+@x
+@!stack_size=50; {number of simultaneous levels of macro expansion}
+@!max_id_length=12; {long identifiers are chopped to this length, which must
+ not exceed |line_length|}
+@!unambig_length=7; {identifiers must be unique if chopped to this length}
+ {note that 7 is more strict than \PASCAL's 8, but this can be varied}
+@y
+@!stack_size=100; {number of simultaneous levels of macro expansion}
+@!max_id_length=50; {long identifiers are chopped to this length, which must
+ not exceed |line_length|}
+@!unambig_length=25; {identifiers must be unique if chopped to this length}
+@z
+
+% [??] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [17] enable maximum character set
+for i:=1 to @'37 do xchr[i]:=' ';
+for i:=@'200 to @'377 do xchr[i]:=' ';
+@y
+for i:=1 to @'37 do xchr[i]:=chr(i);
+for i:=@'200 to @'377 do xchr[i]:=chr(i);
+@z
+
+@x [20] terminal output: use standard i/o
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@y
+@d term_out==stdout
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@z
+
+@x
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+@y
+@z
+
+@x [21] init terminal
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{TANGLE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal.
+@^system dependencies@>
+
+@<Set init...@>=
+ {Nothing need be done for C.}
+@z
+
+@x [22] flush terminal buffer
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == fflush(term_out) {empty the terminal output buffer}
+@z
+
+@x [24] open input files
+begin reset(web_file); reset(change_file);
+@y
+begin reset(web_file, web_name);
+if chg_name then reset(change_file, chg_name);
+@z
+
+@x [26] Open output files (except for the pool file).
+rewrite(Pascal_file); rewrite(pool);
+@y
+rewrite (Pascal_file, pascal_name);
+@z
+
+@x [28] Fix f^.
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+@y
+ begin buffer[limit]:=xord[getc(f)];
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do vgetc(f);
+@z
+
+@x [??] Fix `jump_out'.
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_TANGLE;
+end;
+@y
+@d jump_out==uexit(1)
+@d fatal_error(#)==begin new_line; write(stderr, #);
+ error; mark_fatal; uexit(1);
+ end
+@z
+
+@x [38] Provide for a larger `byte_mem' and `tok_mem'. Extra capacity:
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@d zz=3 {we multiply the token capacity by approximately this amount}
+@y
+@d ww=3 {we multiply the byte capacity by approximately this amount}
+@d zz=4 {we multiply the token capacity by approximately this amount}
+@z
+
+@x [58] Remove conversion to uppercase
+ begin if buffer[i]>="a" then chopped_id[s]:=buffer[i]-@'40
+ else chopped_id[s]:=buffer[i];
+@y
+ begin chopped_id[s]:=buffer[i];
+@z
+
+@x [63] Remove conversion to uppercase
+ begin if c>="a" then c:=c-@'40; {merge lowercase with uppercase}
+@y
+ begin
+@z
+
+@x [64] Delayed pool file opening.
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+ equiv[p]:=buffer[id_first+1]+1073741824
+else begin equiv[p]:=string_ptr+1073741824;
+ l:=l-double_chars-1;
+@y
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+ equiv[p]:=buffer[id_first+1]+1073741824
+else begin
+ {Avoid creating empty pool files.}
+ if string_ptr = 65536 then begin
+ {Change |".web"| to |".pool"| and use the current directory.}
+ pool_name := basename_change_suffix (web_name, '.web', '.pool');
+ rewrite (pool, pool_name);
+ end;
+ equiv[p]:=string_ptr+1073741824;
+ l:=l-double_chars-1;
+@z
+
+@x [105] Accept DIV, div, MOD, and mod
+ (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+ ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@|
+@^uppercase@>
+@y
+ (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+ ((out_contrib[1]="d")and(out_contrib[2]="i")and(out_contrib[3]="v")) or@|
+ ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) or@|
+ ((out_contrib[1]="m")and(out_contrib[2]="o")and(out_contrib[3]="d")) ))or@|
+@z
+
+@x [110] lowercase ids
+@^uppercase@>
+ if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+ (out_buf[out_ptr-1]="V"))or @/
+ ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+ (out_buf[out_ptr-1]="D")) then@/ goto bad_case
+@y
+ if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+ (out_buf[out_ptr-1]="V"))or @/
+ ((out_buf[out_ptr-3]="d")and(out_buf[out_ptr-2]="i")and
+ (out_buf[out_ptr-1]="v"))or @/
+ ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+ (out_buf[out_ptr-1]="D"))or @/
+ ((out_buf[out_ptr-3]="m")and(out_buf[out_ptr-2]="o")and
+ (out_buf[out_ptr-1]="d")) then@/ goto bad_case
+@z
+
+@x [114] lowercase operators (`and', `or', etc.)
+and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D";
+@^uppercase@>
+ send_out(ident,3);
+ end;
+not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T";
+ send_out(ident,3);
+ end;
+set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N";
+ send_out(ident,2);
+ end;
+or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2);
+@y
+and_sign: begin out_contrib[1]:="a"; out_contrib[2]:="n"; out_contrib[3]:="d";
+ send_out(ident,3);
+ end;
+not_sign: begin out_contrib[1]:="n"; out_contrib[2]:="o"; out_contrib[3]:="t";
+ send_out(ident,3);
+ end;
+set_element_sign: begin out_contrib[1]:="i"; out_contrib[2]:="n";
+ send_out(ident,2);
+ end;
+or_sign: begin out_contrib[1]:="o"; out_contrib[2]:="r"; send_out(ident,2);
+@z
+
+@x [116] Remove conversion to uppercase
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to uppercase,
+with underlines removed. Extremely long identifiers must be chopped.
+
+(Some \PASCAL\ compilers work with lowercase letters instead of
+uppercase. If this module of \.{TANGLE} is changed, it's also necessary
+to change from uppercase to lowercase in the modules that are
+listed in the index under ``uppercase''.)
+@^system dependencies@>
+@^uppercase@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+ #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
+ end;
+"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1);
+ end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+ while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+ begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+ if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40
+ else if out_contrib[k]="_" then decr(k);
+ end;
+ send_out(ident,k);
+ end;
+@y
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to lowercase,
+with underlines removed. Extremely long identifiers must be chopped.
+@^system dependencies@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+ #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"),
+"a",up_to("z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
+ end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+ while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+ begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+ if out_contrib[k]="_" then decr(k);
+ end;
+ send_out(ident,k);
+ end;
+@z
+
+@x [??] Fix casting bug
+@d add_in(#)==begin accumulator:=accumulator+next_sign*(#); next_sign:=+1;
+ end
+@y
+@d add_in(#)==begin accumulator:=accumulator+next_sign*intcast(#); next_sign:=+1;
+ end
+@z
+
+@x [179] make term_in = input
+any error stop will set |debug_cycle| to zero.
+@y
+any error stop will set |debug_cycle| to zero.
+
+@d term_in==stdin
+@z
+
+@x
+@!term_in:text_file; {the user's terminal as an input file}
+@y
+@z
+
+@x [180] remove term_in reset
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+@y
+@z
+
+@x [182] write newline just before exit; use value of |history|
+print_ln(banner); {print a ``banner line''}
+@y
+print (banner); {print a ``banner line''}
+print_ln (version_string);
+@z
+
+@x
+@<Print the job |history|@>;
+@y
+@<Print the job |history|@>;
+new_line;
+if (history <> spotless) and (history <> harmless_message)
+then uexit (1)
+else uexit (0);
+@z
+
+@x [188] System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TANGLE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 3; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('otangle');
+
+ end else if argument_is ('help') then begin
+ usage_help (OTANGLE_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit
+ (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ write_ln (stderr, 'otangle: Need one or two file arguments.');
+ usage ('otangle');
+ end;
+
+ {Supply |".web"| and |".ch"| extensions if necessary.}
+ web_name := extend_filename (cmdline (optind), 'web');
+ if optind + 2 = argc then begin
+ chg_name := extend_filename (cmdline (optind + 1), 'ch');
+ end;
+
+ {Change |".web"| to |".p"| and use the current directory.}
+ pascal_name := basename_change_suffix (web_name, '.web', '.p');
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Globals...@>=
+@!web_name,@!chg_name,@!pascal_name,@!pool_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/omegaware/otangle.web b/Build/source/texk/web2c/omegaware/otangle.web
new file mode 100644
index 00000000000..4bd5a028ee2
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/otangle.web
@@ -0,0 +1,3328 @@
+% otangle.web: Omega version of file tangle.web
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original tangle.web.
+%
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was released in December, 1981.
+% Version 1 was released in September, 1982, with version 0 of TeX.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 1.2 introduced {:nnn} comments, added @@= and @@\ (December, 1982).
+% Version 1.4 added "history" (February, 1983).
+% Version 1.5 conformed to TeX version 0.96 and fixed @@\ (March, 1983).
+% Version 1.7 introduced the new change file format (June, 1983).
+% Version 2.0 was released in July, 1983, with version 0.999 of TeX.
+% Version 2.5 was released in November, 1983, with version 1.0 of TeX.
+% Version 2.6 fixed a bug: force-line-break after a constant (August, 1984).
+% Version 2.7 fixed the definition of check_sum_prime (May, 1985).
+% Version 2.8 fixed a bug in change_buffer movement (August, 1985).
+% Version 2.9 allows nonnumeric macros before their def (December, 1988).
+% Version 3, for Sewell's book, fixed long-line bug in input_ln (March, 1989).
+% Version 4 was major change to allow 8-bit input (September, 1989).
+% Version 4.1 conforms to ANSI standard for-loop rules (September, 1990).
+% Version 4.2 fixes stat report if phase one dies (March, 1991).
+% Version 4.3 fixes @@ bug in verbatim, catches extra } (September, 1991).
+% Version 4.4 activates debug_help on errors as advertised (February, 1993).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\def\pb{$\.|\ldots\.|$} % Pascal brackets (|...|)
+\def\v{\.{\char'174}} % vertical (|) in typewriter font
+\mathchardef\BA="3224 % double arrow
+\def\({} % kludge for alphabetizing certain module names
+
+\def\title{OTANGLE}
+\def\contentspagenumber{123} % should be odd
+\def\topofcontents{\null\vfill
+ \titlefalse % include headline on the contents page
+ \def\rheader{\mainfont Appendix E\hfil \contentspagenumber}
+ \centerline{\titlefont The {\ttitlefont OTANGLE} processor}
+ \vskip 15pt
+ \centerline{(Version 4.4)}
+ \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program converts a \.{WEB} file to a \PASCAL\ file. It was written
+by D. E. Knuth in September, 1981; a somewhat similar {\mc SAIL} program had
+been developed in March, 1979. Since this program describes itself, a
+bootstrapping process involving hand-translation had to be used to get started.
+
+For large \.{WEB} files one should have a large memory, since \.{TANGLE} keeps
+all the \PASCAL\ text in memory (in an abbreviated form). The program uses
+a few features of the local \PASCAL\ compiler that may need to be changed in
+other installations:
+
+\yskip\item{1)} Case statements have a default.
+\item{2)} Input-output routines may need to be adapted for use with a particular
+character set and/or for printing messages on the user's terminal.
+
+\yskip\noindent
+These features are also present in the \PASCAL\ version of \TeX, where they
+are used in a similar (but more complex) way. System-dependent portions
+of \.{TANGLE} can be identified by looking at the entries for `system
+dependencies' in the index below.
+@!@^system dependencies@>
+
+The ``banner line'' defined here should be changed whenever \.{TANGLE}
+is modified.
+
+@d banner=='This is OTANGLE, Version 4.4'
+
+@ The program begins with a fairly normal header, made up of pieces that
+@^system dependencies@>
+will mostly be filled in later. The \.{WEB} input comes from files |web_file|
+and |change_file|, the \PASCAL\ output goes to file |Pascal_file|,
+and the string pool output goes to file |pool|.
+
+If it is necessary to abort the job because of a fatal error, the program
+calls the `|jump_out|' procedure, which goes to the label |end_of_TANGLE|.
+
+@d end_of_TANGLE = 9999 {go here to wrap it up}
+
+@p @t\4@>@<Compiler directives@>@/
+program OTANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool);
+label end_of_TANGLE; {go here to finish}
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values@>@/
+ end;
+
+@ Some of this code is optional for use when debugging only;
+such material is enclosed between the delimiters |debug| and $|gubed|$.
+Other parts, delimited by |stat| and $|tats|$, are optionally included if
+statistics about \.{TANGLE}'s memory usage are desired.
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$'
+ when gathering usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
+ when gathering usage statistics}
+@f stat==begin
+@f tats==end
+
+@ The \PASCAL\ compiler used to develop this system has ``compiler
+directives'' that can appear in comments whose first character is a dollar sign.
+In production versions of \.{TANGLE} these directives tell the compiler that
+@^system dependencies@>
+it is safe to avoid range checks and to leave out the extra code it inserts
+for the \PASCAL\ debugger's benefit, although interrupts will occur if
+there is arithmetic overflow.
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ Labels are given symbolic names by the following definitions. We insert
+the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
+procedure in which we have used the `|return|' statement defined below;
+the label `|restart|' is occasionally used at the very beginning of a
+procedure; and the label `|reswitch|' is occasionally used just prior to
+a \&{case} statement in which some cases change the conditions and we wish to
+branch to the newly applicable case.
+Loops that are set up with the \&{loop} construction defined below are
+commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
+and they are sometimes repeated by going to `|continue|'.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=31 {go here when you've found it}
+@d not_found=32 {go here when you've found something else}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@f loop == xclause
+
+@ We assume that |case| statements may include a default case that applies
+if no matching label is found. Thus, we shall use constructions like
+@^system dependencies@>
+$$\vbox{\halign{#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the compiler
+used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
+and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
+`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
+and |endcases| should be changed to agree with local conventions. (Of
+course, if no default mechanism is available, the |case| statements of
+this program must be extended by listing all remaining cases. The author
+would have taken the trouble to modify \.{TANGLE} so that such extensions
+were done automatically, if he had not wanted to encourage \PASCAL\
+compiler writers to make this important change in \PASCAL, where it belongs.)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters are set big enough to handle \TeX, so they
+should be sufficient for most applications of \.{TANGLE}.
+
+@<Constants...@>=
+@!buf_size=100; {maximum length of input line}
+@!max_bytes=65535; {|1/ww| times the number of bytes in identifiers,
+ strings, and module names; must be less than 65536}
+@!max_toks=65535; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+ must be less than 65536}
+@!max_names=10239; {number of identifiers, strings, module names;
+ must be less than 10240}
+@!max_texts=10239; {number of replacement texts, must be less than 10240}
+@!hash_size=353; {should be prime}
+@!longest_name=400; {module names shouldn't be longer than this}
+@!line_length=72; {lines of \PASCAL\ output have at most this many characters}
+@!out_buf_size=144; {length of output buffer, should be twice |line_length|}
+@!stack_size=50; {number of simultaneous levels of macro expansion}
+@!max_id_length=12; {long identifiers are chopped to this length, which must
+ not exceed |line_length|}
+@!unambig_length=7; {identifiers must be unique if chopped to this length}
+ {note that 7 is more strict than \PASCAL's 8, but this can be varied}
+
+@ A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d harmless_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+@#
+@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
+@d mark_error==history:=error_message
+@d mark_fatal==history:=fatal_message
+@d biggest_char=65535
+@d number_chars=65536
+
+@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
+
+@ @<Set init...@>=history:=spotless;
+
+@* The character set.
+One of the main goals in the design of \.{WEB} has been to make it readily
+portable between a wide variety of computers. Yet \.{WEB} by its very
+nature must use a greater variety of characters than most computer
+programs deal with, and character encoding is one of the areas in which
+existing machines differ most widely from each other.
+
+To resolve this problem, all input to \.{WEAVE} and \.{TANGLE} is converted
+to an internal eight-bit code that is essentially standard ASCII, the ``American
+Standard Code for Information Interchange.'' The conversion is done
+immediately when each character is read in. Conversely, characters are
+converted from ASCII to the user's external representation just before
+they are output. (The original ASCII code was seven bits only; \.{WEB} now
+allows eight bits in an attempt to keep up with modern times.)
+
+Such an internal code is relevant to users of \.{WEB} only because it is
+the code used for preprocessed constants like \.{"A"}. If you are writing
+a program in \.{WEB} that makes use of such one-character constants, you
+should convert your input to ASCII form, like \.{WEAVE} and \.{TANGLE} do.
+Otherwise \.{WEB}'s internal coding scheme does not affect you.
+@^ASCII code@>
+
+Here is a table of the standard visible ASCII codes:
+$$\def\:{\char\count255\global\advance\count255 by 1}
+\count255='40
+\vbox{
+\hbox{\hbox to 40pt{\it\hfill0\/\hfill}%
+\hbox to 40pt{\it\hfill1\/\hfill}%
+\hbox to 40pt{\it\hfill2\/\hfill}%
+\hbox to 40pt{\it\hfill3\/\hfill}%
+\hbox to 40pt{\it\hfill4\/\hfill}%
+\hbox to 40pt{\it\hfill5\/\hfill}%
+\hbox to 40pt{\it\hfill6\/\hfill}%
+\hbox to 40pt{\it\hfill7\/\hfill}}
+\vskip 4pt
+\hrule
+\def\^{\vrule height 10.5pt depth 4.5pt}
+\halign{\hbox to 0pt{\hskip -24pt\O{#0}\hfill}&\^
+\hbox to 40pt{\tt\hfill#\hfill\^}&
+&\hbox to 40pt{\tt\hfill#\hfill\^}\cr
+04&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+05&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+06&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+07&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+10&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+11&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+12&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+13&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+14&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+15&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+16&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+17&\:&\:&\:&\:&\:&\:&\:\cr}
+\hrule width 280pt}$$
+(Actually, of course, code @'040 is an invisible blank space.) Code @'136
+was once an upward arrow (\.{\char'13}), and code @'137 was
+once a left arrow (\.^^X), in olden times when the first draft
+of ASCII code was prepared; but \.{WEB} works with today's standard
+ASCII in which those codes represent circumflex and underline as shown.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers, a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, so \.{WEB} assumes that it is being used
+with a \PASCAL\ whose character set contains at least the characters of
+standard ASCII as listed above. Some \PASCAL\ compilers use the original
+name |char| for the data type associated with the characters in text files,
+while other \PASCAL s consider |char| to be a 64-element subrange of a larger
+data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters in the input and output
+files. We shall also assume that |text_char| consists of the elements
+|chr(first_text_char)| through |chr(last_text_char)|, inclusive. The
+following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{WEAVE} and \.{TANGLE} processors convert between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ If we assume that every system using \.{WEB} is able to read and write the
+visible characters of standard ASCII (although not necessarily using the
+ASCII codes to represent them), the following assignment statements initialize
+most of the |xchr| array properly, without needing any system-dependent
+changes. For example, the statement \.{xchr[@@\'101]:=\'A\'} that appears
+in the present \.{WEB} file might be encoded in, say, {\mc EBCDIC} code
+on the external medium on which it resides, but \.{TANGLE} will convert from
+this external code to ASCII and back again. Therefore the assignment
+statement \.{XCHR[65]:=\'A\'} will appear in the corresponding \PASCAL\ file,
+and \PASCAL\ will compile this statement so that |xchr[65]| receives the
+character \.A in the external (|char|) code. Note that it would be quite
+incorrect to say \.{xchr[@@\'101]:="A"}, because |"A"| is a constant of
+type |integer|, not |char|, and because we have $|"A"|=65$ regardless of
+the external character set.
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+xchr[0]:=' '; xchr[@'177]:=' '; {these ASCII codes are not used}
+
+@ Some of the ASCII codes below @'40 have been given symbolic names in
+\.{WEAVE} and \.{TANGLE} because they are used with a special meaning.
+
+@d and_sign=@'4 {equivalent to `\.{and}'}
+@d not_sign=@'5 {equivalent to `\.{not}'}
+@d set_element_sign=@'6 {equivalent to `\.{in}'}
+@d tab_mark=@'11 {ASCII code used as tab-skip}
+@d line_feed=@'12 {ASCII code thrown away at end of line}
+@d form_feed=@'14 {ASCII code used at end of page}
+@d carriage_return=@'15 {ASCII code used at end of line}
+@d left_arrow=@'30 {equivalent to `\.{:=}'}
+@d not_equal=@'32 {equivalent to `\.{<>}'}
+@d less_or_equal=@'34 {equivalent to `\.{<=}'}
+@d greater_or_equal=@'35 {equivalent to `\.{>=}'}
+@d equivalence_sign=@'36 {equivalent to `\.{==}'}
+@d or_sign=@'37 {equivalent to `\.{or}'}
+
+@ When we initialize the |xord| array and the remaining parts of |xchr|,
+it will be convenient to make use of an index variable, |i|.
+
+@<Local variables for init...@>=
+@!i:0..255;
+
+@ Here now is the system-dependent part of the character set.
+If \.{WEB} is being implemented on a garden-variety \PASCAL\ for which
+only standard ASCII codes will appear in the input and output files, you
+don't need to make any changes here. But if you have, for example, an extended
+character set like the one in Appendix~C of {\sl The \TeX book}, the first
+line of code in this module should be changed to
+$$\hbox{|for i:=1 to @'37 do xchr[i]:=chr(i);|}$$
+\.{WEB}'s character set is essentially identical to \TeX's, even with respect to
+characters less than @'40.
+@^system dependencies@>
+
+Changes to the present module will make \.{WEB} more friendly on computers
+that have an extended character set, so that one can type things like
+\.^^Z\ instead of \.{<>}. If you have an extended set of characters that
+are easily incorporated into text files, you can assign codes arbitrarily
+here, giving an |xchr| equivalent to whatever characters the users of
+\.{WEB} are allowed to have in their input files, provided that unsuitable
+characters do not correspond to special codes like |carriage_return|
+that are listed above.
+
+(The present file \.{TANGLE.WEB} does not contain any of the non-ASCII
+characters, because it is intended to be used with all implementations of
+\.{WEB}. It was originally created on a Stanford system that has a
+convenient extended character set, then ``sanitized'' by applying another
+program that transliterated all of the non-standard characters into
+standard equivalents.)
+
+@<Set init...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+for i:=@'200 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=" ";
+for i:=1 to @'377 do xord[xchr[i]]:=i;
+xord[' ']:=" ";
+
+@* Input and output.
+The input conventions of this program are intended to be very much like those
+of \TeX\ (except, of course, that they are much simpler, because much less
+needs to be done). Furthermore they are identical to those of \.{WEAVE}.
+Therefore people who need to make modifications to all three systems
+should be able to do so without too many headaches.
+
+We use the standard \PASCAL\ input/output procedures in several places that
+\TeX\ cannot, since \.{TANGLE} does not have to deal with files that are named
+dynamically by the user, and since there is no input from the terminal.
+
+@ Terminal output is done by writing on file |term_out|, which is assumed to
+consist of characters of type |text_char|:
+@^system dependencies@>
+
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
+@d new_line==write_ln(term_out) {start new line}
+@d print_nl(#)== {print information starting on a new line}
+ begin new_line; print(#);
+ end
+
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{TANGLE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+
+@ The |update_terminal| procedure is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ The main input comes from |web_file|; this input may be overridden
+by changes in |change_file|. (If |change_file| is empty, there are no changes.)
+
+@<Globals...@>=
+@!web_file:text_file; {primary input}
+@!change_file:text_file; {updates}
+
+@ The following code opens the input files. Since these files were listed
+in the program header, we assume that the \PASCAL\ runtime system has
+already checked that suitable file names have been given; therefore no
+additional error checking needs to be done.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read |web_file| and |change_file|}
+begin reset(web_file); reset(change_file);
+end;
+
+@ The main output goes to |Pascal_file|, and string pool constants are
+written to the |pool| file.
+
+@<Globals...@>=
+@!Pascal_file: text_file;
+@!pool: text_file;
+
+@ The following code opens |Pascal_file| and |pool|.
+Since these files were listed in the program header, we assume that the
+\PASCAL\ runtime system has checked that suitable external file names have
+been given.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(Pascal_file); rewrite(pool);
+
+@ Input goes into an array called |buffer|.
+
+@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code;
+
+@ The |input_ln| procedure brings the next line of input from the specified
+file into the |buffer| array and returns the value |true|, unless the file has
+already been entirely read, in which case it returns |false|. The conventions
+of \TeX\ are followed; i.e., |ASCII_code| numbers representing the next line
+of the file are input into |buffer[0]|, |buffer[1]|, \dots,
+|buffer[limit-1]|; trailing blanks are ignored;
+and the global variable |limit| is set to the length of the
+@^system dependencies@>
+line. The value of |limit| must be strictly less than |buf_size|.
+
+We assume that none of the |ASCII_code| values
+of |buffer[j]| for |0<=j<limit| is equal to 0, @'177, |line_feed|, |form_feed|,
+or |carriage_return|.
+
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ if final_limit>limit then final_limit:=limit;
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+
+@* Reporting errors to the user.
+The \.{TANGLE} processor operates in two phases: first it inputs the source
+file and stores a compressed representation of the program, then it produces
+the \PASCAL\ output from the compressed representation.
+
+The global variable |phase_one| tells whether we are in Phase I or not.
+
+@<Globals...@>=
+@!phase_one: boolean; {|true| in Phase I, |false| in Phase II}
+
+@ If an error is detected while we are debugging,
+we usually want to look at the contents of memory.
+A special procedure will be declared later for this purpose.
+
+@<Error handling...@>=
+@!debug @+ procedure debug_help; forward;@+ gubed
+
+@ During the first phase, syntax errors are reported to the user by saying
+$$\hbox{`|err_print('! Error message')|'},$$
+followed by `|jump_out|' if no recovery from the error is provided.
+This will print the error message followed by an indication of where the error
+was spotted in the source file. Note that no period follows the error message,
+since the error routine will automatically supply a period.
+
+Errors that are noticed during the second phase are reported to the user
+in the same fashion, but the error message will be
+followed by an indication of where the error was spotted in the output file.
+
+The actual error indications are provided by a procedure called |error|.
+
+@d err_print(#)==begin new_line; print(#); error;
+ end
+
+@<Error handling...@>=
+procedure error; {prints '\..' and location of error message}
+var j: 0..out_buf_size; {index into |out_buf|}
+@!k,@!l: 0..buf_size; {indices into |buffer|}
+begin if phase_one then @<Print error location based on input buffer@>
+else @<Print error location based on output buffer@>;
+update_terminal; mark_error;
+@!debug debug_skipped:=debug_cycle; debug_help;@+gubed
+end;
+
+@ The error locations during Phase I can be indicated by using the global
+variables |loc|, |line|, and |changing|, which tell respectively the first
+unlooked-at position in |buffer|, the current line number, and whether or not
+the current line is from |change_file| or |web_file|.
+This routine should be modified on systems whose standard text editor
+has special line-numbering conventions.
+@^system dependencies@>
+
+@<Print error location based on input buffer@>=
+begin if changing then print('. (change file ')@+else print('. (');
+print_ln('l.', line:1, ')');
+if loc>=limit then l:=limit else l:=loc;
+for k:=1 to l do
+ if buffer[k-1]=tab_mark then print(' ')
+ else print(xchr[buffer[k-1]]); {print the characters already read}
+new_line;
+for k:=1 to l do print(' '); {space out the next line}
+for k:=l+1 to limit do print(xchr[buffer[k-1]]); {print the part not yet read}
+print(' '); {this space separates the message from future asterisks}
+end
+
+@ The position of errors detected during the second phase can be indicated
+by outputting the partially-filled output buffer, which contains |out_ptr|
+entries.
+
+@<Print error location based on output...@>=
+begin print_ln('. (l.',line:1,')');
+for j:=1 to out_ptr do print(xchr[out_buf[j-1]]); {print current partial line}
+print('... '); {indicate that this information is partial}
+end
+
+@ The |jump_out| procedure just cuts across all active procedure levels
+and jumps out of the program. This is the only non-local |goto| statement
+in \.{TANGLE}. It is used when no recovery from a particular error has
+been provided.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the code that appears at label |end_of_TANGLE| should be
+copied into the |jump_out| procedure, followed by a call to a system procedure
+that terminates the program.
+
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_TANGLE;
+end;
+
+@ Sometimes the program's behavior is far different from what it should be,
+and \.{TANGLE} prints an error message that is really for the \.{TANGLE}
+maintenance person, not the user. In such cases the program says
+|confusion('indication of where we are')|.
+
+@d confusion(#)==fatal_error('! This can''t happen (',#,')')
+@.This can't happen@>
+
+@ An overflow stop occurs if \.{TANGLE}'s tables aren't large enough.
+
+@d overflow(#)==fatal_error('! Sorry, ',#,' capacity exceeded')
+@.Sorry, x capacity exceeded@>
+
+
+@* Data structures.
+Most of the user's \PASCAL\ code is packed into eight-bit integers
+in two large arrays called |byte_mem| and |tok_mem|.
+The |byte_mem| array holds the names of identifiers, strings, and modules;
+the |tok_mem| array holds the replacement texts
+for macros and modules. Allocation is sequential, since things are deleted only
+during Phase II, and only in a last-in-first-out manner.
+
+Auxiliary arrays |byte_start| and |tok_start| are used as directories to
+|byte_mem| and |tok_mem|, and the |link|, |ilk|, |equiv|, and |text_link|
+arrays give further information about names. These auxiliary arrays
+consist of sixteen-bit items.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!sixteen_bits=integer; {not quite a two-byte quantity}
+
+@ \.{TANGLE} has been designed to avoid the need for indices that are more
+than sixteen bits wide, so that it can be used on most computers. But
+there are programs that need more than 65536 tokens, and some programs
+even need more than 65536 bytes; \TeX\ is one of these. To get around
+this problem, a slight complication has been added to the data structures:
+|byte_mem| and |tok_mem| are two-dimensional arrays, whose first index is
+either 0 or 1. (For generality, the first index is actually allowed to run
+between 0 and |ww-1| in |byte_mem|, or between 0 and |zz-1| in |tok_mem|,
+where |ww| and |zz| are set to 2 and~3; the program will work for any
+positive values of |ww| and |zz|, and it can be simplified in obvious ways
+if |ww=1| or |zz=1|.)
+
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@d zz=3 {we multiply the token capacity by approximately this amount}
+
+@<Globals...@>=
+@!byte_mem: packed array [0..ww-1,0..max_bytes] of ASCII_code;
+ {characters of names}
+@!tok_mem: packed array [0..zz-1,0..max_toks] of eight_bits; {tokens}
+@!byte_start: array [0..max_names] of sixteen_bits; {directory into |byte_mem|}
+@!tok_start: array [0..max_texts] of sixteen_bits; {directory into |tok_mem|}
+@!link: array [0..max_names] of sixteen_bits; {hash table or tree links}
+@!ilk: array [0..max_names] of sixteen_bits; {type codes or tree links}
+@!equiv: array [0..max_names] of sixteen_bits; {info corresponding to names}
+@!text_link: array [0..max_texts] of sixteen_bits; {relates replacement texts}
+
+@ The names of identifiers are found by computing a hash address |h| and
+then looking at strings of bytes signified by |hash[h]|, |link[hash[h]]|,
+|link[link[hash[h]]]|, \dots, until either finding the desired name
+or encountering a zero.
+
+A `|name_pointer|' variable, which signifies a name, is an index into
+|byte_start|. The actual sequence of characters in the name pointed to by
+|p| appears in positions |byte_start[p]| to |byte_start[p+ww]-1|, inclusive,
+in the segment of |byte_mem| whose first index is |p mod ww|. Thus, when
+|ww=2| the even-numbered name bytes appear in |byte_mem[0,@t$*$@>]|
+and the odd-numbered ones appear in |byte_mem[1,@t$*$@>]|.
+The pointer 0 is used for undefined module names; we don't
+want to use it for the names of identifiers, since 0 stands for a null
+pointer in a linked list.
+
+Strings are treated like identifiers; the first character (a double-quote)
+distinguishes a string from an alphabetic name, but for \.{TANGLE}'s purposes
+strings behave like numeric macros. (A `string' here refers to the
+strings delimited by double-quotes that \.{TANGLE} processes. \PASCAL\
+string constants delimited by single-quote marks are not given such special
+treatment; they simply appear as sequences of characters in the \PASCAL\
+texts.) The total number of strings in the string
+pool is called |string_ptr|, and the total number of names in |byte_mem|
+is called |name_ptr|. The total number of bytes occupied in
+|byte_mem[w,@t$*$@>]| is called |byte_ptr[w]|.
+
+We usually have |byte_start[name_ptr+w]=byte_ptr[(name_ptr+w) mod ww]|
+for |0<=w<ww|, since these are the starting positions for the next |ww|
+names to be stored in |byte_mem|.
+
+@d length(#)==byte_start[#+ww]-byte_start[#] {the length of a name}
+
+@<Types...@>=
+@!name_pointer=0..max_names; {identifies a name}
+
+@ @<Global...@>=
+@!name_ptr:name_pointer; {first unused position in |byte_start|}
+@!string_ptr:name_pointer; {next number to be given to a string of length |<>1|}
+@!byte_ptr:array [0..ww-1] of 0..max_bytes;
+ {first unused position in |byte_mem|}
+@!pool_check_sum:integer; {sort of a hash for the whole string pool}
+
+@ @<Local variables for init...@>=
+@!wi: 0..ww-1; {to initialize the |byte_mem| indices}
+
+@ @<Set init...@>=
+for wi:=0 to ww-1 do
+ begin byte_start[wi]:=0; byte_ptr[wi]:=0;
+ end;
+byte_start[ww]:=0; {this makes name 0 of length zero}
+name_ptr:=1; string_ptr:=number_chars; pool_check_sum:=271828;
+
+@ Replacement texts are stored in |tok_mem|, using similar conventions.
+A `|text_pointer|' variable is an index into |tok_start|, and the
+replacement text that corresponds to |p| runs from positions
+|tok_start[p]| to |tok_start[p+zz]-1|, inclusive, in the segment of
+|tok_mem| whose first index is |p mod zz|. Thus, when |zz=2| the
+even-numbered replacement texts appear in |tok_mem[0,@t$*$@>]| and the
+odd-numbered ones appear in |tok_mem[1,@t$*$@>]|. Furthermore,
+|text_link[p]| is used to connect pieces of text that have the same name,
+as we shall see later. The pointer 0 is used for undefined replacement
+texts.
+
+The first position of |tok_mem[z,@t$*$@>]| that is unoccupied by
+replacement text is called |tok_ptr[z]|, and the first unused location of
+|tok_start| is called |text_ptr|. We usually have the identity
+|tok_start[text_ptr+z]=tok_ptr[(text_ptr+z) mod zz]|, for |0<=z<zz|, since
+these are the starting positions for the next |zz| replacement texts to
+be stored in |tok_mem|.
+
+@<Types...@>=
+@!text_pointer=0..max_texts; {identifies a replacement text}
+
+@ It is convenient to maintain a variable |z| that is equal to |text_ptr
+mod zz|, so that we always insert tokens into segment |z| of |tok_mem|.
+
+@<Glob...@>=
+@t\hskip1em@>@!text_ptr:text_pointer; {first unused position in |tok_start|}
+@t\hskip1em@>@!tok_ptr:array[0..zz-1] of 0..max_toks;
+ {first unused position in a given segment of |tok_mem|}
+@t\hskip1em@>@!z:0..zz-1; {current segment of |tok_mem|}
+stat @!max_tok_ptr:array[0..zz-1] of 0..max_toks;
+ {largest values assumed by |tok_ptr|}
+tats
+
+@ @<Local variables for init...@>=
+@!zi:0..zz-1; {to initialize the |tok_mem| indices}
+
+@ @<Set init...@>=
+for zi:=0 to zz-1 do
+ begin tok_start[zi]:=0; tok_ptr[zi]:=0;
+ end;
+tok_start[zz]:=0; {this makes replacement text 0 of length zero}
+text_ptr:=1; z:=1 mod zz;
+
+@ Four types of identifiers are distinguished by their |ilk|:
+
+\yskip\hang |normal| identifiers will appear in the \PASCAL\ program as
+ordinary identifiers since they have not been defined to be macros; the
+corresponding value in the |equiv| array
+for such identifiers is a link in a secondary hash table that
+is used to check whether any two of them agree in their first |unambig_length|
+characters after underline symbols are removed and lowercase letters are
+changed to uppercase.
+
+\yskip\hang |numeric| identifiers have been defined to be numeric macros;
+their |equiv| value contains the corresponding numeric value plus $2^{15}$.
+Strings are treated as numeric macros.
+
+\yskip\hang |simple| identifiers have been defined to be simple macros;
+their |equiv| value points to the corresponding replacement text.
+
+\yskip\hang |parametric| identifiers have been defined to be parametric macros;
+like simple identifiers, their |equiv| value points to the replacement text.
+
+@d normal=0 {ordinary identifiers have |normal| ilk}
+@d numeric=1 {numeric macros and strings have |numeric| ilk}
+@d simple=2 {simple macros have |simple| ilk}
+@d parametric=3 {parametric macros have |parametric| ilk}
+
+@ The names of modules are stored in |byte_mem| together
+with the identifier names, but a hash table is not used for them because
+\.{TANGLE} needs to be able to recognize a module name when given a prefix of
+that name. A conventional binary seach tree is used to retrieve module names,
+with fields called |llink| and |rlink| in place of |link| and |ilk|. The
+root of this tree is |rlink[0]|. If |p| is a pointer to a module name,
+|equiv[p]| points to its replacement text, just as in simple and parametric
+macros, unless this replacement text has not yet been defined (in which case
+|equiv[p]=0|).
+
+@d llink==link {left link in binary search tree for module names}
+@d rlink==ilk {right link in binary search tree for module names}
+
+@<Set init...@>=
+rlink[0]:=0; {the binary search tree starts out with nothing in it}
+equiv[0]:=0; {the undefined module has no replacement text}
+
+@ Here is a little procedure that prints the text of a given name.
+
+@p procedure print_id(@!p:name_pointer); {print identifier or module name}
+var k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+begin if p>=name_ptr then print('IMPOSSIBLE')
+else begin w:=p mod ww;
+ for k:=byte_start[p] to byte_start[p+ww]-1 do print(xchr[byte_mem[w,k]]);
+ end;
+end;
+
+@* Searching for identifiers.
+The hash table described above is updated by the |id_lookup| procedure,
+which finds a given identifier and returns a pointer to its index in
+|byte_start|. If the identifier was not already present, it is inserted with
+a given |ilk| code; and an error message is printed if the identifier is being
+doubly defined.
+
+Because of the way \.{TANGLE}'s scanning mechanism works, it is most convenient
+to let |id_lookup| search for an identifier that is present in the |buffer|
+array. Two other global variables specify its position in the buffer: the
+first character is |buffer[id_first]|, and the last is |buffer[id_loc-1]|.
+Furthermore, if the identifier is really a string, the global variable
+|double_chars| tells how many of the characters in the buffer appear
+twice (namely \.{@@@@} and \.{""}), since this additional information makes
+it easy to calculate the true length of the string. The final double-quote
+of the string is not included in its ``identifier,'' but the first one is,
+so the string length is |id_loc-id_first-double_chars-1|.
+
+We have mentioned that |normal| identifiers belong to two hash tables,
+one for their true names as they appear in the \.{WEB} file and the other
+when they have been reduced to their first |unambig_length| characters.
+The hash tables are kept by the method of simple chaining, where the
+heads of the individual lists appear in the |hash| and |chop_hash| arrays.
+If |h| is a hash code, the primary hash table list starts at |hash[h]| and
+proceeds through |link| pointers; the secondary hash table list starts at
+|chop_hash[h]| and proceeds through |equiv| pointers. Of course, the same
+identifier will probably have two different values of |h|.
+
+The |id_lookup| procedure uses an auxiliary array called |chopped_id| to
+contain up to |unambig_length| characters of the current identifier, if
+it is necessary to compute the secondary hash code. (This array could be
+declared local to |id_lookup|, but in general we are making all array
+declarations global in this program, because some compilers and some machine
+architectures make dynamic array allocation inefficient.)
+
+@<Glob...@>=
+@!id_first:0..buf_size; {where the current identifier begins in the buffer}
+@!id_loc:0..buf_size; {just after the current identifier in the buffer}
+@!double_chars:0..buf_size; {correction to length in case of strings}
+@#
+@!hash,@!chop_hash:array [0..hash_size] of sixteen_bits; {heads of hash lists}
+@!chopped_id:array [0..unambig_length] of ASCII_code; {chopped identifier}
+
+@ Initially all the hash lists are empty.
+
+@<Local variables for init...@>=
+@!h:0..hash_size; {index into hash-head arrays}
+
+@ @<Set init...@>=
+for h:=0 to hash_size-1 do
+ begin hash[h]:=0; chop_hash[h]:=0;
+ end;
+
+@ Here now is the main procedure for finding identifiers (and strings).
+The parameter |t| is set to |normal| except when the identifier is
+a macro name that is just being defined; in the latter case, |t| will be
+|numeric|, |simple|, or |parametric|.
+
+@p function id_lookup(@!t:eight_bits):name_pointer; {finds current identifier}
+label found, not_found;
+var c:eight_bits; {byte being chopped}
+@!i:0..buf_size; {index into |buffer|}
+@!h:0..hash_size; {hash code}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!l:0..buf_size; {length of the given identifier}
+@!p,@!q:name_pointer; {where the identifier is being sought}
+@!s:0..unambig_length; {index into |chopped_id|}
+begin l:=id_loc-id_first; {compute the length}
+@<Compute the hash code |h|@>;
+@<Compute the name location |p|@>;
+if (p=name_ptr)or(t<>normal) then
+ @<Update the tables and check for possible errors@>;
+id_lookup:=p;
+end;
+
+@ A simple hash code is used: If the sequence of
+ASCII codes is $c_1c_2\ldots c_m$, its hash value will be
+$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the hash...@>=
+h:=buffer[id_first]; i:=id_first+1;
+while i<id_loc do
+ begin h:=(h+h+buffer[i]) mod hash_size; incr(i);
+ end
+
+@ If the identifier is new, it will be placed in position |p=name_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the name location...@>=
+p:=hash[h];
+while p<>0 do
+ begin if length(p)=l then
+ @<Compare name |p| with current identifier, |goto found| if equal@>;
+ p:=link[p];
+ end;
+p:=name_ptr; {the current identifier is new}
+link[p]:=hash[h]; hash[h]:=p; {insert |p| at beginning of hash list}
+found:
+
+@ @<Compare name |p|...@>=
+begin i:=id_first; k:=byte_start[p]; w:=p mod ww;
+while (i<id_loc)and(buffer[i]=byte_mem[w,k]) do
+ begin incr(i); incr(k);
+ end;
+if i=id_loc then goto found; {all characters agree}
+end
+
+@ @<Update the tables...@>=
+begin if ((p<>name_ptr)and(t<>normal)and(ilk[p]=normal)) or
+ ((p=name_ptr)and(t=normal)and(buffer[id_first]<>"""")) then
+ @<Compute the secondary hash code |h| and put the first characters
+ into the auxiliary array |chopped_id|@>;
+if p<>name_ptr then
+ @<Give double-definition error, if necessary, and change |p| to type |t|@>
+else @<Enter a new identifier into the table at position |p|@>;
+end
+
+@ The following routine, which is called into play when it is necessary to
+look at the secondary hash table, computes the same hash function as before
+(but on the chopped data), and places a zero after the chopped identifier
+in |chopped_id| to serve as a convenient sentinel.
+
+@<Compute the secondary...@>=
+begin i:=id_first; s:=0; h:=0;
+while (i<id_loc)and(s<unambig_length) do
+ begin if buffer[i]<>"_" then
+ begin if buffer[i]>="a" then chopped_id[s]:=buffer[i]-@'40
+ else chopped_id[s]:=buffer[i];
+ h:=(h+h+chopped_id[s]) mod hash_size; incr(s);
+ end;
+ incr(i);
+ end;
+chopped_id[s]:=0;
+end
+
+@ If a nonnumeric macro has appeared before it was defined, \.{TANGLE}
+will still work all right; after all, such behavior is typical of the
+replacement texts for modules, which act very much like macros.
+However, an undefined numeric macro may not be used on the right-hand
+side of another numeric macro definition, so \.{TANGLE} finds it
+simplest to make a blanket rule that numeric macros should be defined
+before they are used. The following routine gives an error message and
+also fixes up any damage that may have been caused.
+
+@<Give double...@>= {now |p<>name_ptr| and |t<>normal|}
+begin if ilk[p]=normal then
+ begin if t=numeric then err_print('! This identifier has already appeared');
+@.This identifier has already...@>
+ @<Remove |p| from secondary hash table@>;
+ end
+else err_print('! This identifier was defined before');
+@.This identifier was defined...@>
+ilk[p]:=t;
+end
+
+@ When we have to remove a secondary hash entry, because a |normal| identifier
+is changing to another |ilk|, the hash code |h| and chopped identifier have
+already been computed.
+
+@<Remove |p| from secondary...@>=
+q:=chop_hash[h];
+if q=p then chop_hash[h]:=equiv[p]
+else begin while equiv[q]<>p do q:=equiv[q];
+ equiv[q]:=equiv[p];
+ end
+
+@ The following routine could make good use of a generalized |pack| procedure
+that puts items into just part of a packed array instead of the whole thing.
+
+@<Enter a new identifier...@>=
+begin if (t=normal)and(buffer[id_first]<>"""") then
+ @<Check for ambiguity and update secondary hash@>;
+w:=name_ptr mod ww; k:=byte_ptr[w];
+if k+l>max_bytes then overflow('byte memory');
+if name_ptr>max_names-ww then overflow('name');
+i:=id_first; {get ready to move the identifier into |byte_mem|}
+while i<id_loc do
+ begin byte_mem[w,k]:=buffer[i]; incr(k); incr(i);
+ end;
+byte_ptr[w]:=k; byte_start[name_ptr+ww]:=k; incr(name_ptr);
+if buffer[id_first]<>"""" then ilk[p]:=t
+else @<Define and output a new string of the pool@>;
+end
+
+@ @<Check for ambig...@>=
+begin q:=chop_hash[h];
+while q<>0 do
+ begin @<Check if |q| conflicts with |p|@>;
+ q:=equiv[q];
+ end;
+equiv[p]:=chop_hash[h]; chop_hash[h]:=p; {put |p| at front of secondary list}
+end
+
+@ @<Check if |q| conflicts...@>=
+begin k:=byte_start[q]; s:=0; w:=q mod ww;
+while (k<byte_start[q+ww]) and (s<unambig_length) do
+ begin c:=byte_mem[w,k];
+ if c<>"_" then
+ begin if c>="a" then c:=c-@'40; {merge lowercase with uppercase}
+ if chopped_id[s]<>c then goto not_found;
+ incr(s);
+ end;
+ incr(k);
+ end;
+if (k=byte_start[q+ww])and(chopped_id[s]<>0) then goto not_found;
+print_nl('! Identifier conflict with ');
+@.Identifier conflict...@>
+for k:=byte_start[q] to byte_start[q+ww]-1 do print(xchr[byte_mem[w,k]]);
+error; q:=0; {only one conflict will be printed, since |equiv[0]=0|}
+not_found:
+end
+
+@ We compute the string pool check sum by working modulo a prime number
+that is large but not so large that overflow might occur.
+
+@d check_sum_prime==@'3777777667 {$2^{29}-73$}
+@^preprocessed strings@>
+
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+ equiv[p]:=buffer[id_first+1]+1073741824
+else begin equiv[p]:=string_ptr+1073741824;
+ l:=l-double_chars-1;
+ if l>99 then err_print('! Preprocessed string is too long');
+@.Preprocessed string is too long@>
+ incr(string_ptr);
+ write(pool,xchr["0"+l div 10],xchr["0"+l mod 10]); {output the length}
+ pool_check_sum:=pool_check_sum+pool_check_sum+l;
+ while pool_check_sum>check_sum_prime do
+ pool_check_sum:=pool_check_sum-check_sum_prime;
+ i:=id_first+1;
+ while i<id_loc do
+ begin write(pool,xchr[buffer[i]]); {output characters of string}
+ pool_check_sum:=pool_check_sum+pool_check_sum+buffer[i];
+ while pool_check_sum>check_sum_prime do
+ pool_check_sum:=pool_check_sum-check_sum_prime;
+ if (buffer[i]="""") or (buffer[i]="@@") then
+ i:=i+2 {omit second appearance of doubled character}
+ else incr(i);
+ end;
+ write_ln(pool);
+ end;
+end
+
+@* Searching for module names.
+The |mod_lookup| procedure finds the module name |mod_text[1..l]| in the
+search tree, after inserting it if necessary, and returns a pointer to
+where it was found.
+
+@<Glob...@>=
+@!mod_text:array [0..longest_name] of ASCII_code; {name being sought for}
+
+@ According to the rules of \.{WEB}, no module name
+should be a proper prefix of another, so a ``clean'' comparison should
+occur between any two names. The result of |mod_lookup| is 0 if this
+prefix condition is violated. An error message is printed when such violations
+are detected during phase two of \.{WEAVE}.
+
+@d less=0 {the first name is lexicographically less than the second}
+@d equal=1 {the first name is equal to the second}
+@d greater=2 {the first name is lexicographically greater than the second}
+@d prefix=3 {the first name is a proper prefix of the second}
+@d extension=4 {the first name is a proper extension of the second}
+
+@p function mod_lookup(@!l:sixteen_bits):name_pointer; {finds module name}
+label found;
+var c:less..extension; {comparison between two names}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {father of node |p|}
+begin c:=greater; q:=0; p:=rlink[0]; {|rlink[0]| is the root of the tree}
+while p<>0 do
+ begin @<Set \(|c| to the result of comparing the given name to
+ name |p|@>;
+ q:=p;
+ if c=less then p:=llink[q]
+ else if c=greater then p:=rlink[q]
+ else goto found;
+ end;
+@<Enter a new module name into the tree@>;
+found: if c<>equal then
+ begin err_print('! Incompatible section names'); p:=0;
+@.Incompatible module names@>
+ end;
+mod_lookup:=p;
+end;
+
+@ @<Enter a new module name...@>=
+w:=name_ptr mod ww; k:=byte_ptr[w];
+if k+l>max_bytes then overflow('byte memory');
+if name_ptr>max_names-ww then overflow('name');
+p:=name_ptr;
+if c=less then llink[q]:=p else rlink[q]:=p;
+llink[p]:=0; rlink[p]:=0; c:=equal; equiv[p]:=0;
+for j:=1 to l do byte_mem[w,k+j-1]:=mod_text[j];
+byte_ptr[w]:=k+l; byte_start[name_ptr+ww]:=k+l; incr(name_ptr);
+
+@ @<Set \(|c|...@>=
+begin k:=byte_start[p]; w:=p mod ww; c:=equal; j:=1;
+while (k<byte_start[p+ww]) and (j<=l) and (mod_text[j]=byte_mem[w,k]) do
+ begin incr(k); incr(j);
+ end;
+if k=byte_start[p+ww] then
+ if j>l then c:=equal
+ else c:=extension
+else if j>l then c:=prefix
+else if mod_text[j]<byte_mem[w,k] then c:=less
+else c:=greater;
+end
+
+@ The |prefix_lookup| procedure is supposed to find exactly one module
+name that has |mod_text[1..l]| as a prefix. Actually the algorithm silently
+accepts also the situation that some module name is a prefix of
+|mod_text[1..l]|, because the user who painstakingly typed in more than
+necessary probably doesn't want to be told about the wasted effort.
+
+@p function prefix_lookup(@!l:sixteen_bits):name_pointer; {finds name extension}
+var c:less..extension; {comparison between two names}
+@!count:0..max_names; {the number of hits}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {another place to resume the search after one branch is done}
+@!r:name_pointer; {extension found}
+begin q:=0; p:=rlink[0]; count:=0; r:=0; {begin search at root of tree}
+while p<>0 do
+ begin @<Set \(|c|...@>;
+ if c=less then p:=llink[p]
+ else if c=greater then p:=rlink[p]
+ else begin r:=p; incr(count); q:=rlink[p]; p:=llink[p];
+ end;
+ if p=0 then
+ begin p:=q; q:=0;
+ end;
+ end;
+if count<>1 then
+ if count=0 then err_print('! Name does not match')
+@.Name does not match@>
+ else err_print('! Ambiguous prefix');
+@.Ambiguous prefix@>
+prefix_lookup:=r; {the result will be 0 if there was no match}
+end;
+
+@* Tokens.
+Replacement texts, which represent \PASCAL\ code in a compressed format,
+appear in |tok_mem| as mentioned above. The codes in
+these texts are called `tokens'; some tokens occupy two consecutive
+eight-bit byte positions, and the others take just one byte.
+
+If $p>0$ points to a replacement text, |tok_start[p]| is the |tok_mem| position
+of the first eight-bit code of that text. If |text_link[p]=0|,
+this is the replacement text for a macro, otherwise it is the replacement
+text for a module. In the latter case |text_link[p]| is either equal to
+|module_flag|, which means that there is no further text for this module, or
+|text_link[p]| points to a
+continuation of this replacement text; such links are created when
+several modules have \PASCAL\ texts with the same name, and they also
+tie together all the \PASCAL\ texts of unnamed modules.
+The replacement text pointer for the first unnamed module
+appears in |text_link[0]|, and the most recent such pointer is |last_unnamed|.
+
+@d module_flag==max_texts {final |text_link| in module replacement texts}
+
+@<Glob...@>=
+@!last_unnamed:text_pointer; {most recent replacement text of unnamed module}
+
+@ @<Set init...@>= last_unnamed:=0; text_link[0]:=0;
+
+@ If the first byte of a token is less than @'200, the token occupies a
+single byte. Otherwise we make a sixteen-bit token by combining two consecutive
+bytes |a| and |b|. If |@'200<=a<@'250|, then $(a-@'200)\times2^8+b$ points
+to an identifier; if |@'250<=a<@'320|, then
+$(a-@'250)\times2^8+b$ points to a module name; otherwise, i.e., if
+|@'320<=a<@'400|, then $(a-@'320)\times2^8+b$ is the number of the module
+in which the current replacement text appears.
+
+Codes less than @'200 are 7-bit ASCII codes that represent themselves.
+In particular, a single-character identifier like `|x|' will be a one-byte
+token, while all longer identifiers will occupy two bytes.
+
+Some of the 7-bit ASCII codes will not be present, however, so we can
+use them for special purposes. The following symbolic names are used:
+
+\yskip\hang |param| denotes insertion of a parameter. This occurs only in
+the replacement texts of parametric macros, outside of single-quoted strings
+in those texts.
+
+\hang |begin_comment| denotes \.{@@\{}, which will become either
+\.{\{} or \.{[}.
+
+\hang |end_comment| denotes \.{@@\}}, which will become either
+\.{\}} or \.{]}.
+
+\hang |octal| denotes the \.{@@\'} that precedes an octal constant.
+
+\hang |hex| denotes the \.{@@"} that precedes a hexadecimal constant.
+
+\hang |check_sum| denotes the \.{@@\char'44} that denotes the string pool
+check sum.
+
+\hang |join| denotes the concatenation of adjacent items with no
+space or line breaks allowed between them (the \.{@@\&} operation of \.{WEB}).
+
+\hang |double_dot| denotes `\.{..}' in \PASCAL.
+
+\hang |verbatim| denotes the \.{@@=} that begins a verbatim \PASCAL\ string.
+It is also used for the end of the string.
+
+\hang |force_line| denotes the \.{@@\\} that forces a new line in the
+\PASCAL\ output.
+@^ASCII code@>
+
+@d param=0 {ASCII null code will not appear}
+@d verbatim=@'2 {extended ASCII alpha should not appear}
+@d force_line=@'3 {extended ASCII beta should not appear}
+@d begin_comment=@'11 {ASCII tab mark will not appear}
+@d end_comment=@'12 {ASCII line feed will not appear}
+@d octal=@'14 {ASCII form feed will not appear}
+@d hex=@'15 {ASCII carriage return will not appear}
+@d double_dot=@'40 {ASCII space will not appear except in strings}
+@d check_sum=@'175 {will not be confused with right brace}
+@d join=@'177 {ASCII delete will not appear}
+
+@ The following procedure is used to enter a two-byte value into
+|tok_mem| when a replacement text is being generated.
+
+@p procedure store_two_bytes(@!x:sixteen_bits);
+ {stores high byte, then low byte}
+begin if tok_ptr[z]+2>max_toks then overflow('token');
+tok_mem[z,tok_ptr[z]]:=x div@'400; {this could be done by a shift command}
+tok_mem[z,tok_ptr[z]+1]:=x mod@'400; {this could be done by a logical and}
+tok_ptr[z]:=tok_ptr[z]+2;
+end;
+
+@ When \.{TANGLE} is being operated in debug mode, it has a procedure to display
+a replacement text in symbolic form. This procedure has not been spruced up to
+generate a real great format, but at least the results are not as bad as
+a memory dump.
+
+@p @!debug procedure print_repl(@!p:text_pointer);
+var k:0..max_toks; {index into |tok_mem|}
+@!a: sixteen_bits; {current byte(s)}
+@!zp: 0..zz-1; {segment of |tok_mem| being accessed}
+begin if p>=text_ptr then print('BAD')
+else begin k:=tok_start[p]; zp:=p mod zz;
+ while k<tok_start[p+zz] do
+ begin a:=tok_mem[zp,k];
+ if a>=@'200 then @<Display two-byte token starting with |a|@>
+ else @<Display one-byte token |a|@>;
+ incr(k);
+ end;
+ end;
+end;
+gubed
+
+@ @<Display two-byte...@>=
+begin incr(k);
+if a<@'250 then {identifier or string}
+ begin a:=(a-@'200)*@'400+tok_mem[zp,k]; print_id(a);
+ if byte_mem[a mod ww,byte_start[a]]="""" then print('"')
+ else print(' ');
+ end
+else if a<@'320 then {module name}
+ begin print('@@<'); print_id((a-@'250)*@'400+tok_mem[zp,k]);
+ print('@@>');
+ end
+else begin a:=(a-@'320)*@'400+tok_mem[zp,k]; {module number}
+ print('@@',xchr["{"],a:1,'@@',xchr["}"]); {can't use right brace
+ between \&{debug} and \&{gubed}}
+ end;
+end
+
+@ @<Display one-byte...@>=
+case a of
+begin_comment: print('@@',xchr["{"]);
+end_comment: print('@@',xchr["}"]); {can't use right brace
+ between \&{debug} and \&{gubed}}
+octal: print('@@''');
+hex: print('@@"');
+check_sum: print('@@$');
+param: print('#');
+"@@": print('@@@@');
+verbatim: print('@@=');
+force_line: print('@@\');
+othercases print(xchr[a])
+endcases
+
+@* Stacks for output.
+Let's make sure that our data structures contain enough information to
+produce the entire \PASCAL\ program as desired, by working next on the
+algorithms that actually do produce that program.
+
+@ The output process uses a stack to keep track of what is going on at
+different ``levels'' as the macros are being expanded.
+Entries on this stack have five parts:
+
+\yskip\hang |end_field| is the |tok_mem| location where the replacement
+text of a particular level will end;
+
+\hang |byte_field| is the |tok_mem| location from which the next token
+on a particular level will be read;
+
+\hang |name_field| points to the name corresponding to a particular level;
+
+\hang |repl_field| points to the replacement text currently being read
+at a particular level;
+
+\hang |mod_field| is the module number, or zero if this is a macro.
+
+\yskip\noindent The current values of these five quantities are referred to
+quite frequently, so they are stored in a separate place instead of in
+the |stack| array. We call the current values |cur_end|, |cur_byte|,
+|cur_name|, |cur_repl|, and |cur_mod|.
+
+The global variable |stack_ptr| tells how many levels of output are
+currently in progress. The end of all output occurs when the stack is
+empty, i.e., when |stack_ptr=0|.
+
+@<Types...@>=
+@t\4@>@!output_state=record
+ @!end_field: sixteen_bits; {ending location of replacement text}
+ @!byte_field: sixteen_bits; {present location within replacement text}
+ @!name_field: name_pointer; {|byte_start| index for text being output}
+ @!repl_field: text_pointer; {|tok_start| index for text being output}
+ @!mod_field: 0..@'27777; {module number or zero if not a module}
+ end;
+
+@ @d cur_end==cur_state.end_field {current ending location in |tok_mem|}
+@d cur_byte==cur_state.byte_field {location of next output byte in |tok_mem|}
+@d cur_name==cur_state.name_field {pointer to current name being expanded}
+@d cur_repl==cur_state.repl_field {pointer to current replacement text}
+@d cur_mod==cur_state.mod_field {current module number being expanded}
+
+@<Globals...@>=
+@!cur_state : output_state; {|cur_end|, |cur_byte|, |cur_name|,
+ |cur_repl|, |cur_mod|}
+@!stack : array [1..stack_size] of output_state; {info for non-current levels}
+@!stack_ptr: 0..stack_size; {first unused location in the output state stack}
+
+@ It is convenient to keep a global variable |zo| equal to |cur_repl mod zz|.
+
+@<Glob...@>=
+@!zo:0..zz-1; {the segment of |tok_mem| from which output is coming}
+
+@ Parameters must also be stacked. They are placed in
+|tok_mem| just above the other replacement texts, and dummy parameter
+`names' are placed in |byte_start| just after the other names.
+The variables |text_ptr| and |tok_ptr[z]| essentially serve as parameter
+stack pointers during the output phase, so there is no need for a separate
+data structure to handle this problem.
+
+@ There is an implicit stack corresponding to meta-comments that are output
+via \.{@@\{} and \.{@@\}}. But this stack need not be represented in detail,
+because we only need to know whether it is empty or not. A global variable
+|brace_level| tells how many items would be on this stack if it were present.
+
+@<Globals...@>=
+@!brace_level: eight_bits; {current depth of $\.{@@\{}\ldots\.{@@\}}$ nesting}
+
+@ To get the output process started, we will perform the following
+initialization steps. We may assume that |text_link[0]| is nonzero, since it
+points to the \PASCAL\ text in the first unnamed module that generates
+code; if there are no such modules, there is nothing to output, and an
+error message will have been generated before we do any of the initialization.
+
+@<Initialize the output stacks@>=
+stack_ptr:=1; brace_level:=0; cur_name:=0; cur_repl:=text_link[0];
+zo:=cur_repl mod zz; cur_byte:=tok_start[cur_repl];
+cur_end:=tok_start[cur_repl+zz]; cur_mod:=0;
+
+@ When the replacement text for name |p| is to be inserted into the output,
+the following subroutine is called to save the old level of output and get
+the new one going.
+
+@p procedure push_level(@!p:name_pointer); {suspends the current level}
+begin if stack_ptr=stack_size then overflow('stack')
+else begin stack[stack_ptr]:=cur_state; {save |cur_end|, |cur_byte|, etc.}
+ incr(stack_ptr);
+ cur_name:=p; cur_repl:=equiv[p]; zo:=cur_repl mod zz;
+ cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz];
+ cur_mod:=0;
+ end;
+end;
+
+@ When we come to the end of a replacement text, the |pop_level| subroutine
+does the right thing: It either moves to the continuation of this replacement
+text or returns the state to the most recently stacked level. Part of this
+subroutine, which updates the parameter stack, will be given later when we
+study the parameter stack in more detail.
+
+@p procedure pop_level; {do this when |cur_byte| reaches |cur_end|}
+label exit;
+begin if text_link[cur_repl]=0 then {end of macro expansion}
+ begin if ilk[cur_name]=parametric then
+ @<Remove a parameter from the parameter stack@>;
+ end
+else if text_link[cur_repl]<module_flag then {link to a continuation}
+ begin cur_repl:=text_link[cur_repl]; {we will stay on the same level}
+ zo:=cur_repl mod zz;
+ cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz];
+ return;
+ end;
+decr(stack_ptr); {we will go down to the previous level}
+if stack_ptr>0 then
+ begin cur_state:=stack[stack_ptr]; zo:=cur_repl mod zz;
+ end;
+exit: end;
+
+@ The heart of the output procedure is the |get_output| routine, which produces
+the next token of output that is not a reference to a macro. This procedure
+handles all the stacking and unstacking that is necessary. It returns the
+value |number| if the next output has a numeric value (the value of a
+numeric macro or string), in which case |cur_val| has been set to the
+number in question. The procedure also returns the value |module_number|
+if the next output begins or ends the replacement text of some module,
+in which case |cur_val| is that module's number (if beginning) or the
+negative of that value (if ending). And it returns the value |identifier|
+if the next output is an identifier of length two or more, in which case
+|cur_val| points to that identifier name.
+
+@d number=@'200 {code returned by |get_output| when next output is numeric}
+@d module_number=@'201 {code returned by |get_output| for module numbers}
+@d identifier=@'202 {code returned by |get_output| for identifiers}
+
+@<Globals...@>=
+@!cur_val:integer; {additional information corresponding to output token}
+
+@ If |get_output| finds that no more output remains, it returns the value zero.
+
+@p function get_output:sixteen_bits; {returns next token after macro expansion}
+label restart, done, found;
+var a:sixteen_bits; {value of current byte}
+@!b:eight_bits; {byte being copied}
+@!bal:sixteen_bits; {excess of \.( versus \.) while copying a parameter}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+begin restart: if stack_ptr=0 then
+ begin a:=0; goto found;
+ end;
+if cur_byte=cur_end then
+ begin cur_val:=-cur_mod; pop_level;
+ if cur_val=0 then goto restart;
+ a:=module_number; goto found;
+ end;
+a:=tok_mem[zo,cur_byte]; incr(cur_byte);
+if a<@'200 then {one-byte token}
+ if a=param then
+ @<Start scanning current macro parameter, |goto restart|@>
+ else goto found;
+a:=(a-@'200)*@'400+tok_mem[zo,cur_byte]; incr(cur_byte);
+if a<@'24000 then {|@'24000=(@'250-@'200)*@'400|}
+ @<Expand macro |a| and |goto found|, or |goto restart| if no output found@>;
+if a<@'50000 then {|@'50000=(@'320-@'200)*@'400|}
+ @<Expand module |a-@'24000|, |goto restart|@>;
+cur_val:=a-@'50000; a:=module_number; cur_mod:=cur_val;
+found:
+@!debug if trouble_shooting then debug_help;@;@+gubed@/
+get_output:=a;
+end;
+
+@ The user may have forgotten to give any \PASCAL\ text for a module name,
+or the \PASCAL\ text may have been associated with a different name by mistake.
+
+@<Expand module |a-...@>=
+begin a:=a-@'24000;
+if equiv[a]<>0 then push_level(a)
+else if a<>0 then
+ begin print_nl('! Not present: <'); print_id(a); print('>'); error;
+@.Not present: <section name>@>
+ end;
+goto restart;
+end
+
+@ @<Expand macro ...@>=
+begin case ilk[a] of
+normal: begin cur_val:=a; a:=identifier;
+ end;
+numeric: begin cur_val:=equiv[a]-1073741824; a:=number;
+ end;
+simple: begin push_level(a); goto restart;
+ end;
+parametric: begin @<Put a parameter on the parameter stack,
+ or |goto restart| if error occurs@>;
+ push_level(a); goto restart;
+ end;
+othercases confusion('output')
+endcases;@/
+goto found;
+end
+
+@ We come now to the interesting part, the job of putting a parameter on
+the parameter stack. First we pop the stack if necessary until getting to
+a level that hasn't ended. Then the next character must be a `\.(';
+and since parentheses are balanced on each level, the entire parameter must
+be present, so we can copy it without difficulty.
+
+@<Put a parameter...@>=
+while (cur_byte=cur_end)and(stack_ptr>0) do pop_level;
+if (stack_ptr=0)or(tok_mem[zo,cur_byte]<>"(") then
+ begin print_nl('! No parameter given for '); print_id(a); error;
+@.No parameter given for macro@>
+ goto restart;
+ end;
+@<Copy the parameter into |tok_mem|@>;
+equiv[name_ptr]:=text_ptr; ilk[name_ptr]:=simple; w:=name_ptr mod ww;
+k:=byte_ptr[w];
+@!debug if k=max_bytes then overflow('byte memory');
+byte_mem[w,k]:="#"; incr(k); byte_ptr[w]:=k;
+gubed {this code has set the parameter identifier for debugging printouts}
+if name_ptr>max_names-ww then overflow('name');
+byte_start[name_ptr+ww]:=k; incr(name_ptr);
+if text_ptr>max_texts-zz then overflow('text');
+text_link[text_ptr]:=0; tok_start[text_ptr+zz]:=tok_ptr[z];
+incr(text_ptr);
+z:=text_ptr mod zz
+
+@ The |pop_level| routine undoes the effect of parameter-pushing when
+a parameter macro is finished:
+
+@<Remove a parameter...@>=
+begin decr(name_ptr); decr(text_ptr);
+z:=text_ptr mod zz;
+stat if tok_ptr[z]>max_tok_ptr[z] then max_tok_ptr[z]:=tok_ptr[z];
+tats {the maximum value of |tok_ptr| occurs just before parameter popping}
+tok_ptr[z]:=tok_start[text_ptr];
+@!debug decr(byte_ptr[name_ptr mod ww]);@+gubed
+end
+
+@ When a parameter occurs in a replacement text, we treat it as a simple
+macro in position (|name_ptr-1|):
+
+@<Start scanning...@>=
+begin push_level(name_ptr-1); goto restart;
+end
+
+@ Similarly, a |param| token encountered as we copy a parameter is converted
+into a simple macro call for |name_ptr-1|.
+Some care is needed to handle cases like \\{macro}|(#; print('#)'))|; the
+\.{\#} token will have been changed to |param| outside of strings, but we
+still must distinguish `real' parentheses from those in strings.
+
+@d app_repl(#)==begin if tok_ptr[z]=max_toks then overflow('token');
+ tok_mem[z,tok_ptr[z]]:=#; incr(tok_ptr[z]); end
+
+@<Copy the parameter...@>=
+bal:=1; incr(cur_byte); {skip the opening `\.('}
+loop@+ begin b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+ if b=param then store_two_bytes(name_ptr+@'77777)
+ else begin if b>=@'200 then
+ begin app_repl(b);
+ b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+ end
+ else case b of
+ "(": incr(bal);
+ ")": begin decr(bal);
+ if bal=0 then goto done;
+ end;
+ "'": repeat app_repl(b);
+ b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+ until b="'"; {copy string, don't change |bal|}
+ othercases do_nothing
+ endcases;
+ app_repl(b);
+ end;
+ end;
+done:
+
+@* Producing the output.
+The |get_output| routine above handles most of the complexity of output
+generation, but there are two further considerations that have a nontrivial
+effect on \.{TANGLE}'s algorithms.
+
+First, we want to make sure that the output is broken into lines not
+exceeding |line_length| characters per line, where these breaks occur at
+valid places (e.g., not in the middle of a string or a constant or an
+identifier, not between `\.<' and `\.>', not at a `\.{@@\&}' position
+where quantities are being joined together). Therefore we assemble the
+output into a buffer before deciding where the line breaks will appear.
+However, we make very little attempt to make ``logical'' line breaks that
+would enhance the readability of the output; people are supposed to read
+the input of \.{TANGLE} or the \TeX ed output of \.{WEAVE}, but not the
+tangled-up output. The only concession to readability is that a break after
+a semicolon will be made if possible, since commonly used ``pretty
+printing'' routines give better results in such cases.
+
+Second, we want to decimalize non-decimal constants, and to combine integer
+quantities that are added or subtracted, because \PASCAL\ doesn't allow
+constant expressions in subrange types or in case labels. This means we
+want to have a procedure that treats a construction like \.{(E-15+17)}
+as equivalent to `\.{(E+2)}', while also leaving `\.{(1E-15+17)}' and
+`\.{(E-15+17*y)}' untouched. Consider also `\.{-15+17.5}' versus
+`\.{-15+17..5}'. We shall not combine integers preceding or following
+\.*, \./, \.{div}, \.{mod}, or \.{@@\&}. Note that if |y| has been defined
+to equal $-2$, we must expand `\.{x*y}' into `\.{x*(-2)}'; but `\.{x-y}'
+can expand into `\.{x+2}' and we can even change `\.{x - y mod z}' to
+@^mod@>
+`\.{x + 2 mod z}' because \PASCAL\ has a nonstandard \&{mod} operation!
+
+The following solution to these problems has been adopted: An array
+|out_buf| contains characters that have been generated but not yet output,
+and there are three pointers into this array. One of these, |out_ptr|, is
+the number of characters currently in the buffer, and we will have
+|1<=out_ptr<=line_length| most of the time. The second is |break_ptr|,
+which is the largest value |<=out_ptr| such that we are definitely entitled
+to end a line by outputting the characters |out_buf[1..(break_ptr-1)]|;
+we will always have |break_ptr<=line_length|. Finally, |semi_ptr| is either
+zero or the largest known value of a legal break after a semicolon or comment
+on the current line; we will always have |semi_ptr<=break_ptr|.
+
+@<Globals...@>=
+@!out_buf: array [0..out_buf_size] of ASCII_code; {assembled characters}
+@!out_ptr: 0..out_buf_size; {first available place in |out_buf|}
+@!break_ptr: 0..out_buf_size; {last breaking place in |out_buf|}
+@!semi_ptr: 0..out_buf_size; {last semicolon breaking place in |out_buf|}
+
+@ Besides having those three pointers,
+the output process is in one of several states:
+
+\yskip\hang |num_or_id| means that the last item in the buffer is a number or
+identifier, hence a blank space or line break must be inserted if the next
+item is also a number or identifier.
+
+\yskip\hang |unbreakable| means that the last item in the buffer was followed
+by the \.{@@\&} operation that inhibits spaces between it and the next item.
+
+\yskip\hang |sign| means that the last item in the buffer is to be followed
+by \.+ or \.-, depending on whether |out_app| is positive or negative.
+
+\yskip\hang |sign_val| means that the decimal equivalent of
+$\vert|out_val|\vert$ should be appended to the buffer. If |out_val<0|,
+or if |out_val=0| and |last_sign<0|, the number should be preceded by a minus
+sign. Otherwise it should be preceded by the character |out_sign| unless
+|out_sign=0|; the |out_sign| variable is either 0 or \.{"\ "} or \.{"+"}.
+
+\yskip\hang |sign_val_sign| is like |sign_val|, but also append \.+ or \.-
+afterwards, depending on whether |out_app| is positive or negative.
+
+\yskip\hang |sign_val_val| is like |sign_val|, but also append the decimal
+equivalent of |out_app| including its sign, using |last_sign| in case
+|out_app=0|.
+
+\yskip\hang |misc| means none of the above.
+
+\yskip\noindent
+For example, the output buffer and output state run through the following
+sequence as we generate characters from `\.{(x-15+19-2)}':
+$$\vbox{\halign{$\hfil#\hfil$\quad&#\hfil&\quad\hfil#\hfil&\quad
+\hfil#\hfil&\quad\hfil#\hfil&\quad\hfil#\hfil\quad&\hfil#\hfil\cr
+output&|out_buf|&|out_state|&|out_sign|&|out_val|&|out_app|&|last_sign|\cr
+\noalign{\vskip 3pt}
+(&\.(&|misc|\cr
+x&\.{(x}&|num_or_id|\cr
+-&\.{(x}&|sign|&&&$-1$&$-1$\cr
+15&\.{(x}&|sign_val|&\.{"+"}&$-15$&&$-15$\cr
++&\.{(x}&|sign_val_sign|&\.{"+"}&$-15$&$+1$&$+1$\cr
+19&\.{(x}&|sign_val_val|&\.{"+"}&$-15$&$+19$&$+1$\cr
+-&\.{(x}&|sign_val_sign|&\.{"+"}&$+4$&$-1$&$-1$\cr
+2&\.{(x}&|sign_val_val|&\.{"+"}&$+4$&$-2$&$-2$\cr
+)&\.{(x+2)}&|misc|\cr}}$$
+At each stage we have put as much into the buffer as possible without
+knowing what is coming next. Examples like `\.{x-0.1}' indicate why
+|last_sign| is needed to associate the proper sign with an output of zero.
+
+In states |num_or_id|, |unbreakable|, and |misc| the last item in the buffer
+lies between |break_ptr| and |out_ptr-1|, inclusive; in the other states we
+have |break_ptr=out_ptr|.
+
+The numeric values assigned to |num_or_id|, etc., have been chosen to
+shorten some of the program logic; for example, the program makes use of
+the fact that |sign+2=sign_val_sign|.
+
+@d misc=0 {state associated with special characters}
+@d num_or_id=1 {state associated with numbers and identifiers}
+@d sign=2 {state associated with pending \.+ or \.-}
+@d sign_val=num_or_id+2 {state associated with pending sign and value}
+@d sign_val_sign=sign+2 {|sign_val| followed by another pending sign}
+@d sign_val_val=sign_val+2 {|sign_val| followed by another pending value}
+@d unbreakable=sign_val_val+1 {state associated with \.{@@\&}}
+
+@<Globals...@>=
+@!out_state:eight_bits; {current status of partial output}
+@!out_val,@!out_app:integer; {pending values}
+@!out_sign:ASCII_code; {sign to use if appending |out_val>=0|}
+@!last_sign:-1..+1; {sign to use if appending a zero}
+
+@ During the output process, |line| will equal the number of the next line
+to be output.
+
+@<Initialize the output buffer@>=
+out_state:=misc; out_ptr:=0; break_ptr:=0; semi_ptr:=0; out_buf[0]:=0; line:=1;
+
+@ Here is a routine that is invoked when |out_ptr>line_length|
+or when it is time to flush out the final line. The |flush_buffer| procedure
+often writes out the line up to the current |break_ptr| position, then moves the
+remaining information to the front of |out_buf|. However, it prefers to
+write only up to |semi_ptr|, if the residual line won't be too long.
+
+@d check_break==if out_ptr>line_length then flush_buffer
+
+@p procedure flush_buffer; {writes one line to output file}
+var k:0..out_buf_size; {index into |out_buf|}
+@!b:0..out_buf_size; {value of |break_ptr| upon entry}
+begin b:=break_ptr;
+if (semi_ptr<>0)and(out_ptr-semi_ptr<=line_length) then break_ptr:=semi_ptr;
+for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]);
+write_ln(Pascal_file); incr(line);
+if line mod 100 = 0 then
+ begin print('.');
+ if line mod 500 = 0 then print(line:1);
+ update_terminal; {progress report}
+ end;
+if break_ptr<out_ptr then
+ begin if out_buf[break_ptr]=" " then
+ begin incr(break_ptr); {drop space at break}
+ if break_ptr>b then b:=break_ptr;
+ end;
+ for k:=break_ptr to out_ptr-1 do out_buf[k-break_ptr]:=out_buf[k];
+ end;
+out_ptr:=out_ptr-break_ptr; break_ptr:=b-break_ptr; semi_ptr:=0;
+if out_ptr>line_length then
+ begin err_print('! Long line must be truncated'); out_ptr:=line_length;
+@.Long line must be truncated@>
+ end;
+end;
+
+@ @<Empty the last line from the buffer@>=
+break_ptr:=out_ptr; semi_ptr:=0; flush_buffer;
+if brace_level<>0 then
+ err_print('! Program ended at brace level ',brace_level:1);
+@.Program ended at brace level n@>
+
+@ Another simple and useful routine appends the decimal equivalent of
+a nonnegative integer to the output buffer.
+
+@d app(#)==begin out_buf[out_ptr]:=#; incr(out_ptr); {append a single character}
+ end
+
+@p procedure app_val(@!v:integer); {puts |v| into buffer, assumes |v>=0|}
+var k:0..out_buf_size; {index into |out_buf|}
+begin k:=out_buf_size; {first we put the digits at the very end of |out_buf|}
+repeat out_buf[k]:=v mod 10; v:=v div 10; decr(k);
+until v=0;
+repeat incr(k); app(out_buf[k]+"0");
+until k=out_buf_size; {then we append them, most significant first}
+end;
+
+@ The output states are kept up to date by the output routines, which are
+called |send_out|, |send_val|, and |send_sign|. The |send_out| procedure
+has two parameters: |t| tells the type of information being sent and
+|v| contains the information proper. Some information may also be passed
+in the array |out_contrib|.
+
+\yskip\hang If |t=misc| then |v| is a character to be output.
+
+\hang If |t=str| then |v| is the length of a string or something like `\.{<>}'
+in |out_contrib|.
+
+\hang If |t=ident| then |v| is the length of an identifier in |out_contrib|.
+
+\hang If |t=frac| then |v| is the length of a fraction and/or exponent in
+|out_contrib|.
+
+@d str=1 {|send_out| code for a string}
+@d ident=2 {|send_out| code for an identifier}
+@d frac=3 {|send_out| code for a fraction}
+
+@<Glob...@>=
+@!out_contrib:array[1..line_length] of ASCII_code; {a contribution to |out_buf|}
+
+@ A slightly subtle point in the following code is that the user may ask
+for a |join| operation (i.e., \.{@@\&}) following whatever is being sent
+out. We will see later that |join| is implemented in part by calling
+|send_out(frac,0)|.
+
+@p procedure send_out(@!t:eight_bits; @!v:sixteen_bits);
+ {outputs |v| of type |t|}
+label restart;
+var k: 0..line_length; {index into |out_contrib|}
+begin @<Get the buffer ready for appending the new information@>;
+if t<>misc then for k:=1 to v do app(out_contrib[k])
+else app(v);
+check_break;
+if (t=misc)and((v=";")or(v="}")) then
+ begin semi_ptr:=out_ptr; break_ptr:=out_ptr;
+ end;
+if t>=ident then out_state:=num_or_id {|t=ident| or |frac|}
+else out_state:=misc {|t=str| or |misc|}
+end;
+
+@ Here is where the buffer states for signs and values collapse into simpler
+states, because we are about to append something that doesn't combine with
+the previous integer constants.
+
+We use an ASCII-code trick: Since |","-1="+"| and |","+1="-"|, we have
+|","-c=@t sign of $c$@>|, when $\vert c\vert=1$.
+
+@<Get the buffer ready...@>=
+restart: case out_state of
+num_or_id: if t<>frac then
+ begin break_ptr:=out_ptr;
+ if t=ident then app(" ");
+ end;
+sign: begin app(","-out_app); check_break; break_ptr:=out_ptr;
+ end;
+sign_val,sign_val_sign: begin @<Append \(|out_val| to buffer@>;
+ out_state:=out_state-2; goto restart;
+ end;
+sign_val_val: @<Reduce |sign_val_val| to |sign_val| and |goto restart|@>;
+misc: if t<>frac then break_ptr:=out_ptr;@/
+othercases do_nothing {this is for |unbreakable| state}
+endcases
+
+@ @<Append \(|out_val|...@>=
+if (out_val<0)or((out_val=0)and(last_sign<0)) then app("-")
+else if out_sign>0 then app(out_sign);
+app_val(abs(out_val)); check_break;
+
+@ @<Reduce |sign_val_val|...@>=
+begin if (t=frac)or(@<Contribution is \.* or \./ or \.{DIV} or \.{MOD}@>) then
+ begin @<Append \(|out_val| to buffer@>;
+ out_sign:="+"; out_val:=out_app;
+ end
+else out_val:=out_val+out_app;
+out_state:=sign_val; goto restart;
+end
+
+@ @<Contribution is \.*...@>=
+((t=ident)and(v=3)and@|
+ (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+ ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@|
+@^uppercase@>
+ ((t=misc)and((v="*")or(v="/")))
+
+@ The following routine is called with $v=\pm1$ when a plus or minus sign is
+appended to the output. It extends \PASCAL\ to allow repeated signs
+(e.g., `\.{--}' is equivalent to `\.+'), rather than to give an error message.
+The signs following `\.E' in real constants are treated as part of a fraction,
+so they are not seen by this routine.
+
+@p procedure send_sign(@!v:integer);
+begin case out_state of
+sign, sign_val_sign: out_app:=out_app*v;
+sign_val:begin out_app:=v; out_state:=sign_val_sign;
+ end;
+sign_val_val: begin out_val:=out_val+out_app; out_app:=v;
+ out_state:=sign_val_sign;
+ end;
+othercases begin break_ptr:=out_ptr; out_app:=v; out_state:=sign;
+ end
+endcases;@/
+last_sign:=out_app;
+end;
+
+@ When a (signed) integer value is to be output, we call |send_val|.
+
+@d bad_case=666 {this is a label used below}
+
+@p procedure send_val(@!v:integer); {output the (signed) value |v|}
+label bad_case, {go here if we can't keep |v| in the output state}
+ exit;
+begin case out_state of
+num_or_id: begin @<If previous output was \.{DIV} or \.{MOD}, |goto bad_case|@>;
+ out_sign:=" "; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr;
+ last_sign:=+1;
+ end;
+misc: begin @<If previous output was \.* or \./, |goto bad_case|@>;
+ out_sign:=0; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr;
+ last_sign:=+1;
+ end;
+@t\4@>@<Handle cases of |send_val| when |out_state| contains a sign@>@;
+othercases goto bad_case
+endcases;@/
+return;
+bad_case: @<Append the decimal value of |v|, with parentheses if negative@>;
+exit: end;
+
+@ @<Handle cases of |send_val|...@>=
+sign: begin out_sign:="+"; out_state:=sign_val; out_val:=out_app*v;
+ end;
+sign_val: begin out_state:=sign_val_val; out_app:=v;
+ err_print('! Two numbers occurred without a sign between them');
+ end;
+sign_val_sign: begin out_state:=sign_val_val; out_app:=out_app*v;
+ end;
+sign_val_val: begin out_val:=out_val+out_app; out_app:=v;
+ err_print('! Two numbers occurred without a sign between them');
+@.Two numbers occurred...@>
+ end;
+
+@ @<If previous output was \.*...@>=
+if (out_ptr=break_ptr+1)and((out_buf[break_ptr]="*")or(out_buf[break_ptr]="/"))
+ then goto bad_case
+
+@ @<If previous output was \.{DIV}...@>=
+if (out_ptr=break_ptr+3)or
+ ((out_ptr=break_ptr+4)and(out_buf[break_ptr]=" ")) then
+@^uppercase@>
+ if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+ (out_buf[out_ptr-1]="V"))or @/
+ ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+ (out_buf[out_ptr-1]="D")) then@/ goto bad_case
+
+@ @<Append the decimal value...@>=
+if v>=0 then
+ begin if out_state=num_or_id then
+ begin break_ptr:=out_ptr; app(" ");
+ end;
+ app_val(v); check_break; out_state:=num_or_id;
+ end
+else begin app("("); app("-"); app_val(-v); app(")"); check_break;
+ out_state:=misc;
+ end
+
+@* The big output switch.
+To complete the output process, we need a routine that takes the results
+of |get_output| and feeds them to |send_out|, |send_val|, or |send_sign|.
+This procedure `|send_the_output|' will be invoked just once, as follows:
+
+@<Phase II: Output the contents of the compressed tables@>=
+if text_link[0]=0 then
+ begin print_nl('! No output was specified.'); mark_harmless;
+@.No output was specified@>
+ end
+else begin print_nl('Writing the output file'); update_terminal;@/
+ @<Initialize the output stacks@>;
+ @<Initialize the output buffer@>;
+ send_the_output;@/
+ @<Empty the last line...@>;
+ print_nl('Done.');
+ end
+
+@ A many-way switch is used to send the output:
+
+@d get_fraction=2 {this label is used below}
+
+@p procedure send_the_output;
+label get_fraction, {go here to finish scanning a real constant}
+ reswitch, continue;
+var cur_char:eight_bits; {the latest character received}
+ @!k:0..line_length; {index into |out_contrib|}
+ @!j:0..max_bytes; {index into |byte_mem|}
+ @!w:0..ww-1; {segment of |byte_mem|}
+ @!n:integer; {number being scanned}
+begin while stack_ptr>0 do
+ begin cur_char:=get_output;
+ reswitch: case cur_char of
+ 0: do_nothing; {this case might arise if output ends unexpectedly}
+ @t\4@>@<Cases related to identifiers@>@;
+ @t\4@>@<Cases related to constants, possibly leading to
+ |get_fraction| or |reswitch|@>@;
+ "+","-": send_sign(","-cur_char);
+ @t\4@>@<Cases like \.{<>} and \.{:=}@>@;
+ "'": @<Send a string, |goto reswitch|@>;
+ @<Other printable characters@>: send_out(misc,cur_char);
+ @t\4@>@<Cases involving \.{@@\{} and \.{@@\}}@>@;
+ join: begin send_out(frac,0); out_state:=unbreakable;
+ end;
+ verbatim: @<Send verbatim string@>;
+ force_line: @<Force a line break@>;
+ othercases err_print('! Can''t output ASCII code ',cur_char:1)
+@.Can't output ASCII code n@>
+ endcases;@/
+ goto continue;
+ get_fraction: @<Special code to finish real constants@>;
+ continue: end;
+end;
+
+@ @<Cases like \.{<>}...@>=
+and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D";
+@^uppercase@>
+ send_out(ident,3);
+ end;
+not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T";
+ send_out(ident,3);
+ end;
+set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N";
+ send_out(ident,2);
+ end;
+or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2);
+ end;
+left_arrow: begin out_contrib[1]:=":"; out_contrib[2]:="="; send_out(str,2);
+ end;
+not_equal: begin out_contrib[1]:="<"; out_contrib[2]:=">"; send_out(str,2);
+ end;
+less_or_equal: begin out_contrib[1]:="<"; out_contrib[2]:="="; send_out(str,2);
+ end;
+greater_or_equal: begin out_contrib[1]:=">"; out_contrib[2]:="=";
+ send_out(str,2);
+ end;
+equivalence_sign: begin out_contrib[1]:="="; out_contrib[2]:="=";
+ send_out(str,2);
+ end;
+double_dot: begin out_contrib[1]:="."; out_contrib[2]:="."; send_out(str,2);
+ end;
+
+@ Please don't ask how all of the following characters can actually get
+through \.{TANGLE} outside of strings. It seems that |""""| and |"{"|
+cannot actually occur at this point of the program, but they have
+been included just in case \.{TANGLE} changes.
+
+If \.{TANGLE} is producing code for a \PASCAL\ compiler that uses `\.{(.}'
+and `\.{.)}' instead of square brackets (e.g., on machines with {\mc EBCDIC}
+code), one should remove |"["| and |"]"| from this list and put them into
+the preceding module in the appropriate way. Similarly, some compilers
+want `\.\^' to be converted to `\.{@@}'.
+@^system dependencies@>@^EBCDIC@>
+
+@<Other printable characters@>=
+"!","""","#","$","%","&","(",")","*",",","/",":",";","<","=",">","?",
+"@@","[","\","]","^","_","`","{","|"
+
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to uppercase,
+with underlines removed. Extremely long identifiers must be chopped.
+
+(Some \PASCAL\ compilers work with lowercase letters instead of
+uppercase. If this module of \.{TANGLE} is changed, it's also necessary
+to change from uppercase to lowercase in the modules that are
+listed in the index under ``uppercase''.)
+@^system dependencies@>
+@^uppercase@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+ #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
+ end;
+"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1);
+ end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+ while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+ begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+ if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40
+ else if out_contrib[k]="_" then decr(k);
+ end;
+ send_out(ident,k);
+ end;
+
+@ After sending a string, we need to look ahead at the next character, in order
+to see if there were two consecutive single-quote marks. Afterwards we go to
+|reswitch| to process the next character.
+
+@<Send a string...@>=
+begin k:=1; out_contrib[1]:="'";
+repeat if k<line_length then incr(k);
+out_contrib[k]:=get_output;
+until (out_contrib[k]="'")or(stack_ptr=0);
+if k=line_length then err_print('! String too long');
+@.String too long@>
+send_out(str,k); cur_char:=get_output;
+if cur_char="'" then out_state:=unbreakable;
+goto reswitch;
+end
+
+@ Sending a verbatim string is similar, but we don't have to look ahead.
+
+@<Send verbatim string@>=
+begin k:=0;
+repeat if k<line_length then incr(k);
+out_contrib[k]:=get_output;
+until (out_contrib[k]=verbatim)or(stack_ptr=0);
+if k=line_length then err_print('! Verbatim string too long');
+@.Verbatim string too long@>
+send_out(str,k-1);
+end
+
+@ In order to encourage portable software, \.{TANGLE} complains
+if the constants get dangerously close to the largest value representable
+on a 32-bit computer ($2^{31}-1$).
+
+@d digits=="0","1","2","3","4","5","6","7","8","9"
+
+@<Cases related to constants...@>=
+digits: begin n:=0;
+ repeat cur_char:=cur_char-"0";
+ if n>=@'1463146314 then err_print('! Constant too big')
+@.Constant too big@>
+ else n:=10*n+cur_char;
+ cur_char:=get_output;
+ until (cur_char>"9")or(cur_char<"0");
+ send_val(n); k:=0;
+ if cur_char="e" then cur_char:="E";
+@^uppercase@>
+ if cur_char="E" then goto get_fraction
+ else goto reswitch;
+ end;
+check_sum: send_val(pool_check_sum);
+octal: begin n:=0; cur_char:="0";
+ repeat cur_char:=cur_char-"0";
+ if n>=@'2000000000 then err_print('! Constant too big')
+ else n:=8*n+cur_char;
+ cur_char:=get_output;
+ until (cur_char>"7")or(cur_char<"0");
+ send_val(n); goto reswitch;
+ end;
+hex: begin n:=0; cur_char:="0";
+ repeat if cur_char>="A" then cur_char:=cur_char+10-"A"
+ else cur_char:=cur_char-"0";
+ if n>=@"8000000 then err_print('! Constant too big')
+ else n:=16*n+cur_char;
+ cur_char:=get_output;
+ until (cur_char>"F")or(cur_char<"0")or@|
+ ((cur_char>"9")and(cur_char<"A"));
+ send_val(n); goto reswitch;
+ end;
+number: send_val(cur_val);
+".": begin k:=1; out_contrib[1]:="."; cur_char:=get_output;
+ if cur_char="." then
+ begin out_contrib[2]:="."; send_out(str,2);
+ end
+ else if (cur_char>="0")and(cur_char<="9") then goto get_fraction
+ else begin send_out(misc,"."); goto reswitch;
+ end;
+ end;
+
+@ The following code appears at label `|get_fraction|', when we want to
+scan to the end of a real constant. The first |k| characters of a fraction
+have already been placed in |out_contrib|, and |cur_char| is the next character.
+
+@<Special code...@>=
+repeat if k<line_length then incr(k);
+out_contrib[k]:=cur_char; cur_char:=get_output;
+if (out_contrib[k]="E")and((cur_char="+")or(cur_char="-")) then
+@^uppercase@>
+ begin if k<line_length then incr(k);
+ out_contrib[k]:=cur_char; cur_char:=get_output;
+ end
+else if cur_char="e" then cur_char:="E";
+until (cur_char<>"E")and((cur_char<"0")or(cur_char>"9"));
+if k=line_length then err_print('! Fraction too long');
+@.Fraction too long@>
+send_out(frac,k); goto reswitch
+
+@ Some \PASCAL\ compilers do not recognize comments in braces, so the
+comments must be delimited by `\.{(*}' and `\.{*)}'.
+@^system dependencies@>
+In such cases the statement `|send_out(misc,"{")|' that appears here should
+be replaced by `\ignorespaces|begin out_contrib[1]:="("; out_contrib[2]:="*";
+send_out(str,2); end|', and a similar change should be made to
+`|send_out(misc,"}")|'.
+
+@<Cases involving \.{@@\{} and \.{@@\}}@>=
+begin_comment: begin if brace_level=0 then send_out(misc,"{")
+ else send_out(misc,"[");
+ incr(brace_level);
+ end;
+end_comment: if brace_level>0 then
+ begin decr(brace_level);
+ if brace_level=0 then send_out(misc,"}")
+ else send_out(misc,"]");
+ end
+ else err_print('! Extra @@}');
+@.Extra \AT!\}@>
+module_number: begin if brace_level=0 then send_out(misc,"{")
+ else send_out(misc,"[");
+ if cur_val<0 then
+ begin send_out(misc,":"); send_val(-cur_val);
+ end
+ else begin send_val(cur_val); send_out(misc,":");
+ end;
+ if brace_level=0 then send_out(misc,"}")
+ else send_out(misc,"]");
+ end;
+
+@ @<Force a line break@>=
+begin send_out(str,0); {normalize the buffer}
+while out_ptr>0 do
+ begin if out_ptr<=line_length then break_ptr:=out_ptr;
+ flush_buffer;
+ end;
+out_state:=misc;
+end
+
+@* Introduction to the input phase.
+We have now seen that \.{TANGLE} will be able to output the full
+\PASCAL\ program, if we can only get that program into the byte memory in
+the proper format. The input process is something like the output process
+in reverse, since we compress the text as we read it in and we expand it
+as we write it out.
+
+There are three main input routines. The most interesting is the one that gets
+the next token of a \PASCAL\ text; the other two are used to scan rapidly past
+\TeX\ text in the \.{WEB} source code. One of the latter routines will jump to
+the next token that starts with `\.{@@}', and the other skips to the end
+of a \PASCAL\ comment.
+
+@ But first we need to consider the low-level routine |get_line|
+that takes care of merging |change_file| into |web_file|. The |get_line|
+procedure also updates the line numbers for error messages.
+
+@<Globals...@>=
+@!ii:integer; {general purpose |for| loop variable in the outer block}
+@!line:integer; {the number of the current line in the current file}
+@!other_line:integer; {the number of the current line in the input file that
+ is not currently being read}
+@!temp_line:integer; {used when interchanging |line| with |other_line|}
+@!limit:0..buf_size; {the last character position occupied in the buffer}
+@!loc:0..buf_size; {the next character position to be read from the buffer}
+@!input_has_ended: boolean; {if |true|, there is no more input}
+@!changing: boolean; {if |true|, the current line is from |change_file|}
+
+@ As we change |changing| from |true| to |false| and back again, we must
+remember to swap the values of |line| and |other_line| so that the |err_print|
+routine will be sure to report the correct line number.
+
+@d change_changing==
+ changing := not changing;
+ temp_line:=other_line; other_line:=line; line:=temp_line
+ {|line @t$\null\BA\null$@> other_line|}
+
+@ When |changing| is |false|, the next line of |change_file| is kept in
+|change_buffer[0..change_limit]|, for purposes of comparison with the next
+line of |web_file|. After the change file has been completely input, we
+set |change_limit:=0|, so that no further matches will be made.
+
+@<Globals...@>=
+@!change_buffer:array[0..buf_size] of ASCII_code;
+@!change_limit:0..buf_size; {the last position occupied in |change_buffer|}
+
+@ Here's a simple function that checks if the two buffers are different.
+
+@p function lines_dont_match:boolean;
+label exit;
+var k:0..buf_size; {index into the buffers}
+begin lines_dont_match:=true;
+if change_limit<>limit then return;
+if limit>0 then
+ for k:=0 to limit-1 do if change_buffer[k]<>buffer[k] then return;
+lines_dont_match:=false;
+exit: end;
+
+@ Procedure |prime_the_change_buffer| sets |change_buffer| in preparation
+for the next matching operation. Since blank lines in the change file are
+not used for matching, we have |(change_limit=0)and not changing| if and
+only if the change file is exhausted. This procedure is called only
+when |changing| is true; hence error messages will be reported correctly.
+
+@p procedure prime_the_change_buffer;
+label continue, done, exit;
+var k:0..buf_size; {index into the buffers}
+begin change_limit:=0; {this value will be used if the change file ends}
+@<Skip over comment lines in the change file; |return| if end of file@>;
+@<Skip to the next nonblank line; |return| if end of file@>;
+@<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>;
+exit: end;
+
+@ While looking for a line that begins with \.{@@x} in the change file,
+we allow lines that begin with \.{@@}, as long as they don't begin with
+\.{@@y} or \.{@@z} (which would probably indicate that the change file is
+fouled up).
+
+@<Skip over comment lines in the change file...@>=
+loop@+ begin incr(line);
+ if not input_ln(change_file) then return;
+ if limit<2 then goto continue;
+ if buffer[0]<>"@@" then goto continue;
+ if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if buffer[1]="x" then goto done;
+ if (buffer[1]="y")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@x?');
+@.Where is the match...@>
+ end;
+continue: end;
+done:
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+repeat incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended after @@x');
+@.Change file ended...@>
+ return;
+ end;
+until limit>0;
+
+@ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>=
+begin change_limit:=limit;
+if limit>0 then for k:=0 to limit-1 do change_buffer[k]:=buffer[k];
+end
+
+@ The following procedure is used to see if the next change entry should
+go into effect; it is called only when |changing| is false.
+The idea is to test whether or not the current
+contents of |buffer| matches the current contents of |change_buffer|.
+If not, there's nothing more to do; but if so, a change is called for:
+All of the text down to the \.{@@y} is supposed to match. An error
+message is issued if any discrepancy is found. Then the procedure
+prepares to read the next line from |change_file|.
+
+@p procedure check_change; {switches to |change_file| if the buffers match}
+label exit;
+var n:integer; {the number of discrepancies found}
+@!k:0..buf_size; {index into the buffers}
+begin if lines_dont_match then return;
+n:=0;
+loop@+ begin change_changing; {now it's |true|}
+ incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended before @@y');
+@.Change file ended...@>
+ change_limit:=0; change_changing; {|false| again}
+ return;
+ end;
+ @<If the current line starts with \.{@@y},
+ report any discrepancies and |return|@>;
+ @<Move |buffer| and |limit|...@>;
+ change_changing; {now it's |false|}
+ incr(line);
+ if not input_ln(web_file) then
+ begin err_print('! WEB file ended during a change');
+@.WEB file ended...@>
+ input_has_ended:=true; return;
+ end;
+ if lines_dont_match then incr(n);
+ end;
+exit: end;
+
+@ @<If the current line starts with \.{@@y}...@>=
+if limit>1 then if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@y?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="y" then
+ begin if n>0 then
+ begin loc:=2; err_print('! Hmm... ',n:1,
+ ' of the preceding lines failed to match');
+@.Hmm... n of the preceding...@>
+ end;
+ return;
+ end;
+ end
+
+@ @<Initialize the input system@>=
+open_input; line:=0; other_line:=0;@/
+changing:=true; prime_the_change_buffer; change_changing;@/
+limit:=0; loc:=1; buffer[0]:=" "; input_has_ended:=false;
+
+@ The |get_line| procedure is called when |loc>limit|; it puts the next
+line of merged input into the buffer and updates the other variables
+appropriately. A space is placed at the right end of the line.
+
+@p procedure get_line; {inputs the next line}
+label restart;
+begin restart: if changing then
+ @<Read from |change_file| and maybe turn off |changing|@>;
+if not changing then
+ begin @<Read from |web_file| and maybe turn on |changing|@>;
+ if changing then goto restart;
+ end;
+loc:=0; buffer[limit]:=" ";
+end;
+
+@ @<Read from |web_file|...@>=
+begin incr(line);
+if not input_ln(web_file) then input_has_ended:=true
+else if limit=change_limit then
+ if buffer[0]=change_buffer[0] then
+ if change_limit>0 then check_change;
+end
+
+@ @<Read from |change_file|...@>=
+begin incr(line);
+if not input_ln(change_file) then
+ begin err_print('! Change file ended without @@z');
+@.Change file ended...@>
+ buffer[0]:="@@"; buffer[1]:="z"; limit:=2;
+ end;
+if limit>1 then {check if the change has ended}
+ if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="y") then
+ begin loc:=2; err_print('! Where is the matching @@z?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="z" then
+ begin prime_the_change_buffer; change_changing;
+ end;
+ end;
+end
+
+@ At the end of the program, we will tell the user if the change file
+had a line that didn't match any relevant line in |web_file|.
+
+@<Check that all changes have been read@>=
+if change_limit<>0 then {|changing| is false}
+ begin for ii:=0 to change_limit do buffer[ii]:=change_buffer[ii];
+ limit:=change_limit; changing:=true; line:=other_line; loc:=change_limit;
+ err_print('! Change file entry did not match');
+@.Change file entry did not match@>
+ end
+
+@ Important milestones are reached during the input phase when certain
+control codes are sensed.
+
+Control codes in \.{WEB} begin with `\.{@@}', and the next character
+identifies the code. Some of these are of interest only to \.{WEAVE},
+so \.{TANGLE} ignores them; the others are converted by \.{TANGLE} into
+internal code numbers by the |control_code| function below. The ordering
+of these internal code numbers has been chosen to simplify the program logic;
+larger numbers are given to the control codes that denote more significant
+milestones.
+
+@d ignore=0 {control code of no interest to \.{TANGLE}}
+@d control_text=@'203 {control code for `\.{@@t}', `\.{@@\^}', etc.}
+@d format=@'204 {control code for `\.{@@f}'}
+@d definition=@'205 {control code for `\.{@@d}'}
+@d begin_Pascal=@'206 {control code for `\.{@@p}'}
+@d module_name=@'207 {control code for `\.{@@<}'}
+@d new_module=@'210 {control code for `\.{@@\ }' and `\.{@@*}'}
+
+@p function control_code(@!c:ASCII_code):eight_bits; {convert |c| after \.{@@}}
+begin case c of
+"@@": control_code:="@@"; {`quoted' at sign}
+"'": control_code:=octal; {precedes octal constant}
+"""": control_code:=hex; {precedes hexadecimal constant}
+"$": control_code:=check_sum; {string pool check sum}
+" ",tab_mark: control_code:=new_module; {beginning of a new module}
+"*": begin print('*',module_count+1:1);
+ update_terminal; {print a progress report}
+ control_code:=new_module; {beginning of a new module}
+ end;
+"D","d": control_code:=definition; {macro definition}
+"F","f": control_code:=format; {format definition}
+"{": control_code:=begin_comment; {begin-comment delimiter}
+"}": control_code:=end_comment; {end-comment delimiter}
+"P","p": control_code:=begin_Pascal; {\PASCAL\ text in unnamed module}
+"T","t","^",".",":": control_code:=control_text; {control text to be ignored}
+"&": control_code:=join; {concatenate two tokens}
+"<": control_code:=module_name; {beginning of a module name}
+"=": control_code:=verbatim; {beginning of \PASCAL\ verbatim mode}
+"\": control_code:=force_line; {force a new line in \PASCAL\ output}
+othercases control_code:=ignore {ignore all other cases}
+endcases;
+end;
+
+@ The |skip_ahead| procedure reads through the input at fairly high speed
+until finding the next non-ignorable control code, which it returns.
+
+@p function skip_ahead:eight_bits; {skip to next control code}
+label done;
+var c:eight_bits; {control code found}
+begin loop begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin c:=new_module; goto done;
+ end;
+ end;
+ buffer[limit+1]:="@@";
+ while buffer[loc]<>"@@" do incr(loc);
+ if loc<=limit then
+ begin loc:=loc+2; c:=control_code(buffer[loc-1]);
+ if (c<>ignore)or(buffer[loc-1]=">") then goto done;
+ end;
+ end;
+done: skip_ahead:=c;
+end;
+
+@ The |skip_comment| procedure reads through the input at somewhat high speed
+until finding the first unmatched right brace or until coming to the end
+of the file. It ignores characters following `\.\\' characters, since all
+braces that aren't nested are supposed to be hidden in that way. For
+example, consider the process of skipping the first comment below,
+where the string containing the right brace has been typed as \.{\`\\.\\\}\'}
+in the \.{WEB} file.
+
+@p procedure skip_comment; {skips to next unmatched `\.\}'}
+label exit;
+var bal:eight_bits; {excess of left braces}
+@!c:ASCII_code; {current character}
+begin bal:=0;
+loop@+ begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin err_print('! Input ended in mid-comment');
+@.Input ended in mid-comment@>
+ return;
+ end;
+ end;
+ c:=buffer[loc]; incr(loc);
+ @<Do special things when |c="@@", "\", "{", "}"|; |return| at end@>;
+ end;
+exit:end;
+
+@ @<Do special things when |c="@@"...@>=
+if c="@@" then
+ begin c:=buffer[loc];
+ if (c<>" ")and(c<>tab_mark)and(c<>"*")and(c<>"z")and(c<>"Z") then incr(loc)
+ else begin err_print('! Section ended in mid-comment');
+@.Section ended in mid-comment@>
+ decr(loc); return;
+ end
+ end
+else if (c="\")and(buffer[loc]<>"@@") then incr(loc)
+else if c="{" then incr(bal)
+else if c="}" then
+ begin if bal=0 then return;
+ decr(bal);
+ end
+
+@* Inputting the next token.
+As stated above, \.{TANGLE}'s most interesting input procedure is the
+|get_next| routine that inputs the next token. However, the procedure
+isn't especially difficult.
+
+In most cases the tokens output by |get_next| have the form used in
+replacement texts, except that two-byte tokens are not produced.
+An identifier that isn't one letter long is represented by the
+output `|identifier|', and in such a case the global variables
+|id_first| and |id_loc| will have been set to the appropriate values
+needed by the |id_lookup| procedure. A string that begins with a
+double-quote is also considered an |identifier|, and in such a case
+the global variable |double_chars| will also have been set appropriately.
+Control codes produce the corresponding output of the |control_code|
+function above; and if that code is |module_name|, the value of |cur_module|
+will point to the |byte_start| entry for that module name.
+
+Another global variable, |scanning_hex|, is |true| during the time that
+the letters \.A through \.F should be treated as if they were digits.
+
+@<Globals...@>=
+@!cur_module: name_pointer; {name of module just scanned}
+@!scanning_hex: boolean; {are we scanning a hexadecimal constant?}
+
+@ @<Set init...@>=
+scanning_hex:=false;
+
+@ At the top level, |get_next| is a multi-way switch based on the next
+character in the input buffer. A |new_module| code is inserted at the
+very end of the input file.
+
+@p function get_next:eight_bits; {produces the next input token}
+label restart,done,found;
+var c:eight_bits; {the current character}
+@!d:eight_bits; {the next character}
+@!j,@!k:0..longest_name; {indices into |mod_text|}
+begin restart: if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin c:=new_module; goto found;
+ end;
+ end;
+c:=buffer[loc]; incr(loc);
+if scanning_hex then @<Go to |found| if |c| is a hexadecimal digit,
+ otherwise set |scanning_hex:=false|@>;
+case c of
+"A",up_to("Z"),"a",up_to("z"): @<Get an identifier@>;
+"""": @<Get a preprocessed string@>;
+"@@": @<Get control code and possible module name@>;
+@t\4@>@<Compress two-symbol combinations like `\.{:=}'@>@;
+" ",tab_mark: goto restart; {ignore spaces and tabs}
+"{": begin skip_comment; goto restart;
+ end;
+"}": begin err_print('! Extra }'); goto restart;
+@.Extra \}@>
+ end;
+othercases if c>=128 then goto restart {ignore nonstandard characters}
+ else do_nothing
+endcases;
+found:@!debug if trouble_shooting then debug_help;@;@+gubed@/
+get_next:=c;
+end;
+
+@ @<Go to |found| if |c| is a hexadecimal digit...@>=
+if ((c>="0")and(c<="9"))or((c>="A")and(c<="F")) then goto found
+else scanning_hex:=false
+
+@ Note that the following code substitutes \.{@@\{} and \.{@@\}} for the
+respective combinations `\.{(*}' and `\.{*)}'. Explicit braces should be used
+for \TeX\ comments in \PASCAL\ text.
+
+@d compress(#)==begin if loc<=limit then begin c:=#; incr(loc); end; end
+
+@<Compress two-symbol...@>=
+".": if buffer[loc]="." then compress(double_dot)
+ else if buffer[loc]=")" then compress("]");
+":": if buffer[loc]="=" then compress(left_arrow);
+"=": if buffer[loc]="=" then compress(equivalence_sign);
+">": if buffer[loc]="=" then compress(greater_or_equal);
+"<": if buffer[loc]="=" then compress(less_or_equal)
+ else if buffer[loc]=">" then compress(not_equal);
+"(": if buffer[loc]="*" then compress(begin_comment)
+ else if buffer[loc]="." then compress("[");
+"*": if buffer[loc]=")" then compress(end_comment);
+
+@ We have to look at the preceding character to make sure this isn't part
+of a real constant, before trying to find an identifier starting with
+`\.e' or `\.E'.
+
+@<Get an identifier@>=
+begin if ((c="e")or(c="E"))and(loc>1) then
+ if (buffer[loc-2]<="9")and(buffer[loc-2]>="0") then c:=0;
+if c<>0 then
+ begin decr(loc); id_first:=loc;
+ repeat incr(loc); d:=buffer[loc];
+ until ((d<"0")or((d>"9")and(d<"A"))or((d>"Z")and(d<"a"))or(d>"z")) and
+ (d<>"_");
+ if loc>id_first+1 then
+ begin c:=identifier; id_loc:=loc;
+ end;
+ end
+else c:="E"; {exponent of a real constant}
+end
+
+@ A string that starts and ends with double-quote marks is converted into
+an identifier that behaves like a numeric macro by means of the following
+piece of the program.
+@^preprocessed strings@>
+
+@<Get a preprocessed string@>=
+begin double_chars:=0; id_first:=loc-1;
+repeat d:=buffer[loc]; incr(loc);
+ if (d="""")or(d="@@") then
+ if buffer[loc]=d then
+ begin incr(loc); d:=0; incr(double_chars);
+ end
+ else begin if d="@@" then err_print('! Double @@ sign missing')
+@.Double \AT! sign missing@>
+ end
+ else if loc>limit then
+ begin err_print('! String constant didn''t end'); d:="""";
+@.String constant didn't end@>
+ end;
+until d="""";
+id_loc:=loc-1; c:=identifier;
+end
+
+@ After an \.{@@} sign has been scanned, the next character tells us
+whether there is more work to do.
+
+@<Get control code and possible module name@>=
+begin c:=control_code(buffer[loc]); incr(loc);
+if c=ignore then goto restart
+else if c=hex then scanning_hex:=true
+else if c=module_name then
+ @<Scan the \(module name and make |cur_module| point to it@>
+else if c=control_text then
+ begin repeat c:=skip_ahead;
+ until c<>"@@";
+ if buffer[loc-1]<>">" then
+ err_print('! Improper @@ within control text');
+@.Improper \AT! within control text@>
+ goto restart;
+ end;
+end
+
+@ @<Scan the \(module name...@>=
+begin @<Put module name into |mod_text[1..k]|@>;
+if k>3 then
+ begin if (mod_text[k]=".")and(mod_text[k-1]=".")and(mod_text[k-2]=".") then
+ cur_module:=prefix_lookup(k-3)
+ else cur_module:=mod_lookup(k);
+ end
+else cur_module:=mod_lookup(k);
+end
+
+@ Module names are placed into the |mod_text| array with consecutive spaces,
+tabs, and carriage-returns replaced by single spaces. There will be no
+spaces at the beginning or the end. (We set |mod_text[0]:=" "| to facilitate
+this, since the |mod_lookup| routine uses |mod_text[1]| as the first
+character of the name.)
+
+@<Set init...@>=mod_text[0]:=" ";
+
+@ @<Put module name...@>=
+k:=0;
+loop@+ begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin err_print('! Input ended in section name');
+@.Input ended in section name@>
+ goto done;
+ end;
+ end;
+ d:=buffer[loc];
+ @<If end of name, |goto done|@>;
+ incr(loc); if k<longest_name-1 then incr(k);
+ if (d=" ")or(d=tab_mark) then
+ begin d:=" "; if mod_text[k-1]=" " then decr(k);
+ end;
+ mod_text[k]:=d;
+ end;
+done: @<Check for overlong name@>;
+if (mod_text[k]=" ")and(k>0) then decr(k);
+
+@ @<If end of name,...@>=
+if d="@@" then
+ begin d:=buffer[loc+1];
+ if d=">" then
+ begin loc:=loc+2; goto done;
+ end;
+ if (d=" ")or(d=tab_mark)or(d="*") then
+ begin err_print('! Section name didn''t end'); goto done;
+@.Section name didn't end@>
+ end;
+ incr(k); mod_text[k]:="@@"; incr(loc); {now |d=buffer[loc]| again}
+ end
+
+@ @<Check for overlong name@>=
+if k>=longest_name-2 then
+ begin print_nl('! Section name too long: ');
+@.Section name too long@>
+ for j:=1 to 25 do print(xchr[mod_text[j]]);
+ print('...'); mark_harmless;
+ end
+
+@* Scanning a numeric definition.
+When \.{TANGLE} looks at the \PASCAL\ text following the `\.=' of a numeric
+macro definition, it calls on the precedure |scan_numeric(p)|, where |p|
+points to the name that is to be defined. This procedure evaluates the
+right-hand side, which must consist entirely of integer constants and
+defined numeric macros connected with \.+ and \.- signs (no parentheses).
+It also sets the global variable |next_control| to the control code that
+terminated this definition.
+
+A definition ends with the control codes |definition|, |format|, |module_name|,
+|begin_Pascal|, and |new_module|, all of which can be recognized
+by the fact that they are the largest values |get_next| can return.
+
+@d end_of_definition(#)==(#>=format)
+ {is |#| a control code ending a definition?}
+
+@<Global...@>=
+@!next_control:eight_bits; {control code waiting to be acted upon}
+
+@ The evaluation of a numeric expression makes use of two variables called the
+|accumulator| and the |next_sign|. At the beginning, |accumulator| is zero and
+|next_sign| is $+1$. When a \.+ or \.- is scanned, |next_sign| is multiplied
+by the value of that sign. When a numeric value is scanned, it is multiplied by
+|next_sign| and added to the |accumulator|, then |next_sign| is reset to $+1$.
+
+@d add_in(#)==begin accumulator:=accumulator+next_sign*(#); next_sign:=+1;
+ end
+
+@p procedure scan_numeric(@!p:name_pointer); {defines numeric macros}
+label reswitch, done;
+var accumulator:integer; {accumulates sums}
+@!next_sign:-1..+1; {sign to attach to next value}
+@!q:name_pointer; {points to identifiers being evaluated}
+@!val:integer; {constants being evaluated}
+begin @<Set \(|accumulator| to the value of the right-hand side@>;
+if abs(accumulator)>=1073741824 then
+ begin err_print('! Value too big: ',accumulator:1); accumulator:=0;
+@.Value too big@>
+ end;
+equiv[p]:=accumulator+1073741824;
+ {name |p| now is defined to equal |accumulator|}
+end;
+
+@ @<Set \(|accumulator| to the value of the right-hand side@>=
+accumulator:=0; next_sign:=+1;
+loop@+ begin next_control:=get_next;
+ reswitch: case next_control of
+ digits: begin @<Set |val| to value of decimal constant, and
+ set |next_control| to the following token@>;
+ add_in(val); goto reswitch;
+ end;
+ octal: begin @<Set |val| to value of octal constant, and
+ set |next_control| to the following token@>;
+ add_in(val); goto reswitch;
+ end;
+ hex: begin @<Set |val| to value of hexadecimal constant, and
+ set |next_control| to the following token@>;
+ add_in(val); goto reswitch;
+ end;
+ identifier: begin q:=id_lookup(normal);
+ if ilk[q]<>numeric then
+ begin next_control:="*"; goto reswitch; {leads to error}
+ end;
+ add_in(equiv[q]-1073741824);
+ end;
+ "+": do_nothing;
+ "-": next_sign:=-next_sign;
+ format, definition, module_name, begin_Pascal, new_module: goto done;
+ ";": err_print('! Omit semicolon in numeric definition');
+@.Omit semicolon in numeric def...@>
+ othercases @<Signal error, flush rest of the definition@>
+ endcases;
+ end;
+done:
+
+@ @<Signal error, flush rest...@>=
+begin err_print('! Improper numeric definition will be flushed');
+@.Improper numeric definition...@>
+repeat next_control:=skip_ahead
+until end_of_definition(next_control);
+if next_control=module_name then
+ begin {we want to scan the module name too}
+ loc:=loc-2; next_control:=get_next;
+ end;
+accumulator:=0; goto done;
+end
+
+@ @<Set |val| to value of decimal...@>=
+val:=0;
+repeat val:=10*val+next_control-"0"; next_control:=get_next;
+until (next_control>"9")or(next_control<"0")
+
+@ @<Set |val| to value of octal...@>=
+val:=0; next_control:="0";
+repeat val:=8*val+next_control-"0"; next_control:=get_next;
+until (next_control>"7")or(next_control<"0")
+
+@ @<Set |val| to value of hex...@>=
+val:=0; next_control:="0";
+repeat if next_control>="A" then next_control:=next_control+"0"+10-"A";
+val:=16*val+next_control-"0"; next_control:=get_next;
+until (next_control>"F")or(next_control<"0")or@|
+ ((next_control>"9")and(next_control<"A"))
+
+@* Scanning a macro definition.
+The rules for generating the replacement texts corresponding to simple
+macros, parametric macros, and \PASCAL\ texts of a module are almost
+identical, so a single procedure is used for all three cases. The
+differences are that
+
+\yskip\item{a)} The sign |#| denotes a parameter only when it appears
+outside of strings in a parametric macro; otherwise it stands for the
+ASCII character |#|. (This is not used in standard \PASCAL, but some
+\PASCAL s allow, for example, `\.{/\#}' after a certain kind of file name.)
+
+\item{b)}Module names are not allowed in simple macros or parametric macros;
+in fact, the appearance of a module name terminates such macros and denotes
+the name of the current module.
+
+\item{c)}The symbols \.{@@d} and \.{@@f} and \.{@@p} are not allowed after
+module names, while they terminate macro definitions.
+
+@ Therefore there is a procedure |scan_repl| whose parameter |t| specifies
+either |simple| or |parametric| or |module_name|. After |scan_repl| has
+acted, |cur_repl_text| will point to the replacement text just generated, and
+|next_control| will contain the control code that terminated the activity.
+
+@<Globals...@>=
+@!cur_repl_text:text_pointer; {replacement text formed by |scan_repl|}
+
+@ @p procedure scan_repl(@!t:eight_bits); {creates a replacement text}
+label continue, done, found, reswitch;
+var a:sixteen_bits; {the current token}
+@!b:ASCII_code; {a character from the buffer}
+@!bal:eight_bits; {left parentheses minus right parentheses}
+begin bal:=0;
+loop@+ begin continue: a:=get_next;
+ case a of
+ "(": incr(bal);
+ ")": if bal=0 then err_print('! Extra )')
+@.Extra )@>
+ else decr(bal);
+ "'": @<Copy a string from the buffer to |tok_mem|@>;
+ "#": if t=parametric then a:=param;
+ @t\4@>@<In cases that |a| is a non-ASCII token (|identifier|,
+ |module_name|, etc.), either process it and change |a| to a byte
+ that should be stored, or |goto continue| if |a| should be ignored,
+ or |goto done| if |a| signals the end of this replacement text@>@;
+ othercases do_nothing
+ endcases;@/
+ app_repl(a); {store |a| in |tok_mem|}
+ end;
+done: next_control:=a;
+@<Make sure the parentheses balance@>;
+if text_ptr>max_texts-zz then overflow('text');
+cur_repl_text:=text_ptr; tok_start[text_ptr+zz]:=tok_ptr[z];
+incr(text_ptr);
+if z=zz-1 then z:=0@+else incr(z);
+end;
+
+@ @<Make sure the parentheses balance@>=
+if bal>0 then
+ begin if bal=1 then err_print('! Missing )')
+ else err_print('! Missing ',bal:1,' )''s');
+@.Missing n )@>
+ while bal>0 do
+ begin app_repl(")"); decr(bal);
+ end;
+ end
+
+@ @<In cases that |a| is...@>=
+identifier: begin a:=id_lookup(normal); app_repl((a div @'400)+@'200);
+ a:=a mod @'400;
+ end;
+module_name: if t<>module_name then goto done
+ else begin app_repl((cur_module div @'400)+@'250);
+ a:=cur_module mod @'400;
+ end;
+verbatim: @<Copy verbatim string from the buffer to |tok_mem|@>;
+definition, format, begin_Pascal: if t<>module_name then goto done
+ else begin err_print('! @@',xchr[buffer[loc-1]],
+@.\AT!p is ignored in Pascal text@>
+@.\AT!d is ignored in Pascal text@>
+@.\AT!f is ignored in Pascal text@>
+ ' is ignored in Pascal text'); goto continue;
+ end;
+new_module: goto done;
+
+@ @<Copy a string...@>=
+begin b:="'";
+loop@+ begin app_repl(b);
+ if b="@@" then
+ if buffer[loc]="@@" then incr(loc) {store only one \.{@@}}
+ else err_print('! You should double @@ signs in strings');
+@.You should double \AT! signs@>
+ if loc=limit then
+ begin err_print('! String didn''t end');
+@.String didn't end@>
+ buffer[loc]:="'"; buffer[loc+1]:=0;
+ end;
+ b:=buffer[loc]; incr(loc);
+ if b="'" then
+ begin if buffer[loc]<>"'" then goto found
+ else begin incr(loc); app_repl("'");
+ end;
+ end;
+ end;
+found: end {now |a| holds the final |"'"| that will be stored}
+
+@ @<Copy verbatim string...@>=
+begin app_repl(verbatim);
+buffer[limit+1]:="@@";
+reswitch: if buffer[loc]="@@" then
+ begin if loc<limit then if buffer[loc+1]="@@" then
+ begin app_repl("@@");
+ loc:=loc+2;
+ goto reswitch;
+ end;
+ end
+else begin app_repl(buffer[loc]);
+ incr(loc);
+ goto reswitch;
+ end;
+if loc>=limit then err_print('! Verbatim string didn''t end')
+@.Verbatim string didn't end@>
+else if buffer[loc+1]<>">" then
+ err_print('! You should double @@ signs in verbatim strings');
+@.You should double \AT! signs@>
+loc:=loc+2;
+end {another |verbatim| byte will be stored, since |a=verbatim|}
+
+@ The following procedure is used to define a simple or parametric macro,
+just after the `\.{==}' of its definition has been scanned.
+
+@p procedure define_macro(@!t:eight_bits);
+var p:name_pointer; {the identifier being defined}
+begin p:=id_lookup(t); scan_repl(t);@/
+equiv[p]:=cur_repl_text; text_link[cur_repl_text]:=0;
+end;
+
+@* Scanning a module.
+The |scan_module| procedure starts when `\.{@@\ }' or `\.{@@*}' has been
+sensed in the input, and it proceeds until the end of that module. It
+uses |module_count| to keep track of the current module number; with luck,
+\.{WEAVE} and \.{TANGLE} will both assign the same numbers to modules.
+
+@<Globals...@>=
+@!module_count:0..@'27777; {the current module number}
+
+@ The top level of |scan_module| is trivial.
+@p procedure scan_module;
+label continue, done, exit;
+var p:name_pointer; {module name for the current module}
+begin incr(module_count);
+@<Scan the \(definition part of the current module@>;
+@<Scan the \PASCAL\ part of the current module@>;
+exit: end;
+
+@ @<Scan the \(definition part...@>=
+next_control:=0;
+loop@+ begin continue: while next_control<=format do
+ begin next_control:=skip_ahead;
+ if next_control=module_name then
+ begin {we want to scan the module name too}
+ loc:=loc-2; next_control:=get_next;
+ end;
+ end;
+ if next_control<>definition then goto done;
+ next_control:=get_next; {get identifier name}
+ if next_control<>identifier then
+ begin err_print('! Definition flushed, must start with ',
+@.Definition flushed...@>
+ 'identifier of length > 1'); goto continue;
+ end;
+ next_control:=get_next; {get token after the identifier}
+ if next_control="=" then
+ begin scan_numeric(id_lookup(numeric)); goto continue;
+ end
+ else if next_control=equivalence_sign then
+ begin define_macro(simple); goto continue;
+ end
+ else @<If the next text is `|(#)==|', call |define_macro|
+ and |goto continue|@>;
+ err_print('! Definition flushed since it starts badly');
+@.Definition flushed...@>
+ end;
+done:
+
+@ @<If the next text is `|(#)==|'...@>=
+if next_control="(" then
+ begin next_control:=get_next;
+ if next_control="#" then
+ begin next_control:=get_next;
+ if next_control=")" then
+ begin next_control:=get_next;
+ if next_control="=" then
+ begin err_print('! Use == for macros');
+@.Use == for macros@>
+ next_control:=equivalence_sign;
+ end;
+ if next_control=equivalence_sign then
+ begin define_macro(parametric); goto continue;
+ end;
+ end;
+ end;
+ end;
+
+@ @<Scan the \PASCAL...@>=
+case next_control of
+begin_Pascal:p:=0;
+module_name: begin p:=cur_module;
+ @<Check that |=| or |==| follows this module name, otherwise |return|@>;
+ end;
+othercases return
+endcases;@/
+@<Insert the module number into |tok_mem|@>;
+scan_repl(module_name); {now |cur_repl_text| points to the replacement text}
+@<Update the data structure so that the replacement text is accessible@>;
+
+@ @<Check that |=|...@>=
+repeat next_control:=get_next;
+until next_control<>"+"; {allow optional `\.{+=}'}
+if (next_control<>"=")and(next_control<>equivalence_sign) then
+ begin err_print('! Pascal text flushed, = sign is missing');
+@.Pascal text flushed...@>
+ repeat next_control:=skip_ahead;
+ until next_control=new_module;
+ return;
+ end
+
+@ @<Insert the module number...@>=
+store_two_bytes(@'150000+module_count); {|@'150000=@'320*@'400|}
+
+@ @<Update the data...@>=
+if p=0 then {unnamed module}
+ begin text_link[last_unnamed]:=cur_repl_text; last_unnamed:=cur_repl_text;
+ end
+else if equiv[p]=0 then equiv[p]:=cur_repl_text {first module of this name}
+else begin p:=equiv[p];
+ while text_link[p]<module_flag do p:=text_link[p]; {find end of list}
+ text_link[p]:=cur_repl_text;
+ end;
+text_link[cur_repl_text]:=module_flag;
+ {mark this replacement text as a nonmacro}
+
+@* Debugging.
+The \PASCAL\ debugger with which \.{TANGLE} was developed allows breakpoints
+to be set, and variables can be read and changed, but procedures cannot be
+executed. Therefore a `|debug_help|' procedure has been inserted in the main
+loops of each phase of the program; when |ddt| and |dd| are set to appropriate
+values, symbolic printouts of various tables will appear.
+
+The idea is to set a breakpoint inside the |debug_help| routine, at the
+place of `\ignorespaces|breakpoint:|\unskip' below. Then when
+|debug_help| is to be activated, set |trouble_shooting| equal to |true|.
+The |debug_help| routine will prompt you for values of |ddt| and |dd|,
+discontinuing this when |ddt<=0|; thus you type $2n+1$ integers, ending
+with zero or a negative number. Then control either passes to the
+breakpoint, allowing you to look at and/or change variables (if you typed
+zero), or to exit the routine (if you typed a negative value).
+
+Another global variable, |debug_cycle|, can be used to skip silently
+past calls on |debug_help|. If you set |debug_cycle>1|, the program stops
+only every |debug_cycle| times |debug_help| is called; however,
+any error stop will set |debug_cycle| to zero.
+
+@<Globals...@>=
+@!debug@!trouble_shooting:boolean; {is |debug_help| wanted?}
+@!ddt:integer; {operation code for the |debug_help| routine}
+@!dd:integer; {operand in procedures performed by |debug_help|}
+@!debug_cycle:integer; {threshold for |debug_help| stopping}
+@!debug_skipped:integer; {we have skipped this many |debug_help| calls}
+@!term_in:text_file; {the user's terminal as an input file}
+gubed
+
+@ The debugging routine needs to read from the user's terminal.
+@^system dependencies@>
+@<Set init...@>=
+@!debug trouble_shooting:=true; debug_cycle:=1; debug_skipped:=0;@/
+trouble_shooting:=false; debug_cycle:=99999; {use these when it almost works}
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+gubed
+
+@ @d breakpoint=888 {place where a breakpoint is desirable}
+@^system dependencies@>
+
+@p @!debug procedure debug_help; {routine to display various things}
+label breakpoint,exit;
+var k:integer; {index into various arrays}
+begin incr(debug_skipped);
+if debug_skipped<debug_cycle then return;
+debug_skipped:=0;
+loop@+ begin write(term_out,'#'); update_terminal; {prompt}
+ read(term_in,ddt); {read a list of integers}
+ if ddt<0 then return
+ else if ddt=0 then
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: ddt:=0;@\
+ end
+ else begin read(term_in,dd);
+ case ddt of
+ 1: print_id(dd);
+ 2: print_repl(dd);
+ 3: for k:=1 to dd do print(xchr[buffer[k]]);
+ 4: for k:=1 to dd do print(xchr[mod_text[k]]);
+ 5: for k:=1 to out_ptr do print(xchr[out_buf[k]]);
+ 6: for k:=1 to dd do print(xchr[out_contrib[k]]);
+ othercases print('?')
+ endcases;
+ end;
+ end;
+exit:end;
+gubed
+
+@* The main program.
+We have defined plenty of procedures, and it is time to put the last
+pieces of the puzzle in place. Here is where \.{TANGLE} starts, and where
+it ends.
+@^system dependencies@>
+
+@p begin initialize;
+@<Initialize the input system@>;
+print_ln(banner); {print a ``banner line''}
+@<Phase I: Read all the user's text and compress it into |tok_mem|@>;
+stat for ii:=0 to zz-1 do max_tok_ptr[ii]:=tok_ptr[ii];@+tats@;@/
+@<Phase II:...@>;
+end_of_TANGLE:
+if string_ptr>number_chars then @<Finish off the string pool file@>;
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@t\4\4@>{here files should be closed if the operating system requires it}
+@<Print the job |history|@>;
+end.
+
+@ @<Phase I:...@>=
+phase_one:=true;
+module_count:=0;
+repeat next_control:=skip_ahead;
+until next_control=new_module;
+while not input_has_ended do scan_module;
+@<Check that all changes have been read@>;
+phase_one:=false;
+
+@ @<Finish off the string pool file@>=
+begin print_nl(string_ptr-number_chars:1,
+ ' strings written to string pool file.');
+write(pool,'*');
+for ii:=1 to 9 do
+ begin out_buf[ii]:=pool_check_sum mod 10;
+ pool_check_sum:=pool_check_sum div 10;
+ end;
+for ii:=9 downto 1 do write(pool,xchr["0"+out_buf[ii]]);
+write_ln(pool);
+end
+
+@ @<Glob...@>=
+stat @!wo:0..ww-1; {segment of memory for which statistics are being printed}
+tats
+
+@ @<Print statistics about memory usage@>=
+print_nl('Memory usage statistics:');
+print_nl(name_ptr:1, ' names, ', text_ptr:1, ' replacement texts;');
+print_nl(byte_ptr[0]:1);
+for wo:=1 to ww-1 do print('+',byte_ptr[wo]:1);
+if phase_one then
+ for ii:=0 to zz-1 do max_tok_ptr[ii]:=tok_ptr[ii];
+print(' bytes, ', max_tok_ptr[0]:1);
+for ii:=1 to zz-1 do print('+',max_tok_ptr[ii]:1);
+print(' tokens.');
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_nl('(No errors were found.)');
+harmless_message: print_nl('(Did you see the warning message above?)');
+error_message: print_nl('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_nl('(That was a fatal error, my friend.)');
+end {there are no other cases}
+
+@* System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TANGLE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+
+@* Index.
+Here is a cross-reference table for the \.{TANGLE} processor.
+All modules in which an identifier is
+used are listed with that identifier, except that reserved words are
+indexed only when they appear in format definitions, and the appearances
+of identifiers in module names are not indexed. Underlined entries
+correspond to where the identifier was declared. Error messages and
+a few other things like ``ASCII code'' are indexed here too.
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.ch b/Build/source/texk/web2c/omegaware/ovf2ovp.ch
new file mode 100644
index 00000000000..4c2c3effb3d
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/ovf2ovp.ch
@@ -0,0 +1,610 @@
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original vftovp.ch.
+%
+% vftovp.ch for C compilation with web2c.
+% Written by kb@cs.umb.edu.
+% This file is in the public domain.
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+%\let\maybe=\iffalse
+%\def\title{VF$\,$\lowercase{to}$\,$VP changes for C}
+@z
+
+@x still [2] Set up for path reading.
+procedure initialize; {this procedure gets things started properly}
+ var @!k:integer; {all-purpose index for initialization}
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @!k:integer; {all-purpose index for initialization}
+ begin
+ kpse_set_progname (argv[0]);
+ kpse_init_prog ('VFTOVP', 0, nil, nil);
+ parse_arguments;
+@z
+
+% [4] No name_length.
+% Also, AIX defines `class' in <math.h>, so let's take this opportunity to
+% define that away.
+@x
+@<Constants...@>=
+@y
+@d class == class_var
+@<Constants...@>=
+@z
+
+@x
+@!name_length=50; {a file name shouldn't be longer than this}
+@y
+@z
+
+@x [11] Open the files.
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file); reset(vf_file);
+@y
+@ We don't have to do anything special to read a packed file of bytes,
+but we do want to use environment variables to find the input files.
+@^system dependencies@>
+
+@<Set init...@>=
+{See comments at |kpse_find_vf| in \.{kpathsea/tex-file.h} for why we
+ don't use it.}
+vf_file := kpse_open_file (vf_name, kpse_ovf_format);
+tfm_file := kpse_open_file (tfm_name, kpse_ofm_format);
+
+if verbose then begin
+ print (banner);
+ print_ln (version_string);
+end;
+@z
+
+@x [21] Open VPL file.
+@!vpl_file:text;
+
+@ @<Set init...@>=
+rewrite(vpl_file);
+@y
+@!vpl_file:text;
+
+@ If an explicit filename isn't given, we write to |stdout|.
+
+@<Set init...@>=
+if optind + 3 > argc then begin
+ vpl_file := stdout;
+end else begin
+ vpl_name := extend_filename (cmdline (optind + 2), 'ovp');
+ rewrite (vpl_file, vpl_name);
+end;
+@z
+
+% [24] `index' is not a good choice of identifier in C.
+@x
+@<Types...@>=
+@!index=0..tfm_size; {address of a byte in |tfm|}
+@y
+@d index == index_type
+
+@<Types...@>=
+@!index=0..tfm_size; {address of a byte in |tfm|}
+@z
+
+% [24] abort() should cause a bad exit code.
+@x
+@d abort(#)==begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a OFM?');
+ goto final_end;
+ end
+@y
+@d abort(#)==begin print_ln(#);
+ write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OFM?');
+ uexit(1);
+ end
+@z
+
+% [31] Ditto for vf_abort.
+@x
+@d vf_abort(#)==begin
+ print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a OVF?');
+ goto final_end;
+ end
+@y
+@d vf_abort(#)==begin
+ write_ln(stderr, #);
+ write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OVF?');
+ uexit(1);
+ end
+@z
+
+@x [32] Be quiet if not -verbose.
+for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
+print_ln(' '); reg_count:=0;
+@y
+if verbose then begin
+ for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
+ print_ln(' ');
+end;
+reg_count:=0;
+@z
+
+@x [35] Be quiet if not -verbose.
+@<Print the name of the local font@>;
+@y
+if verbose then begin
+ @<Print the name of the local font@>;
+end;
+@z
+
+@x [36] Output of real numbers.
+print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2,
+ 'pt')
+@y
+print(' at ');
+print_real((((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize, 2, 2);
+print_ln('pt')
+@z
+
+@x [37] No arbitrary max on cur_name.
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+@!cur_name:^char; {external tfm name}
+@z
+
+@x [39] Open another TFM file.
+reset(tfm_file,cur_name);
+@^system dependencies@>
+if eof(tfm_file) then
+ print_ln('---not loaded, font metric file can''t be opened!')
+@.font metric file can\'t be opened@>
+else begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon}
+@y
+tfm_file := kpse_open_file (cur_name, kpse_ofm_format);
+@^system dependencies@>
+if eof(tfm_file) then
+ print_ln('---not loaded, font metric file can''t be opened!')
+@.font metric file can\'t be opened@>
+else begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon}
+@z
+
+@x [40] Be quiet if not -verbose.
+ print_ln('Check sum in OVF file being replaced by font metric check sum');
+@y
+ if verbose then
+ print_ln('Check sum in OVF file being replaced by font metric check sum');
+@z
+
+@x [42] Remove initialization of now-defunct array.
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+@y
+@ (No initialization to be done. Keep this module to preserve numbering.)
+@z
+
+@x [44] Don't append `.tfm' here, and keep lowercase.
+for k:=1 to name_length do cur_name[k]:=' ';
+if a=0 then begin
+ for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_start[font_ptr]+14 to vf_ptr-1 do begin
+ incr(r);
+ if r+4>name_length then vf_abort('Font name too long for me!');
+@.Font name too long for me@>
+ if (vf[k]>="a")and(vf[k]<="z") then
+ cur_name[r]:=xchr[vf[k]-@'40]
+ else cur_name[r]:=xchr[vf[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+@y
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. We do not impose an arbitrary limit
+on the filename length.
+@^system dependencies@>
+
+@d name_start == (font_start[font_ptr] + 14)
+@d name_end == vf_ptr
+
+@<Move font name into the |cur_name| string@>=
+r := name_end - name_start;
+cur_name := xmalloc (r + 1);
+{|strncpy| might be faster, but it's probably a good idea to keep the
+ |xchr| translation.}
+for k := name_start to name_end do begin
+ cur_name[k - name_start] := xchr[vf[k]];
+end;
+cur_name[r] := 0; {Append null byte since this is C.}
+@z
+
+@x [49] Change strings to C char pointers, so we can initialize them.
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!xchr:packed array [0..255] of char;
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+@y
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string;
+ {strings for output in the user's external character set}
+@!ASCII_all: packed array[0..256] of char;
+@!xchr:packed array [0..255] of char;
+@!MBL_string,@!RI_string,@!RCE_string: c_string;
+ {handy string constants for |face| codes}
+@z
+
+@x [50] The Pascal strings are indexed starting at 1, so we pad with a blank.
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/
+HEX:='0123456789ABCDEF';@/
+@y
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~?';@/
+HEX:=' 0123456789ABCDEF';@/
+strcpy (ASCII_all, ASCII_04);
+strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
+strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/
+@z
+
+@x
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+@y
+MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE';
+@z
+
+% [60] How we output the character code depends on |charcode_format|.
+@x
+begin if font_type>vanilla then
+ out_hex_char(c)
+else if (c>="0")and(c<="9") then
+ out(' C ',c-"0":1)
+else if (c>="A")and(c<="Z") then
+ out(' C ',ASCII_10[c-"A"+2])
+else if (c>="a")and(c<="z") then
+ out(' C ',ASCII_14[c-"a"+2])
+else out_hex_char(c);
+end;
+@y
+begin if (font_type > vanilla) or (charcode_format = charcode_hex) then
+ out_hex_char(c)
+else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~")
+ and (c <> "(") and (c <> ")") then
+ out(' C ', ASCII_all[c - " " + 1])
+{default case, use hex}
+else out_hex_char(c);
+end;
+@z
+
+% [61] Don't output the face code as an integer.
+@x
+ out(MBL_string[1+(b mod 3)]);
+ out(RI_string[1+s]);
+ out(RCE_string[1+(b div 3)]);
+@y
+ put_byte(MBL_string[1+(b mod 3)], vpl_file);
+ put_byte(RI_string[1+s], vpl_file);
+ put_byte(RCE_string[1+(b div 3)], vpl_file);
+@z
+
+@x [62] Force 32-bit constant arithmetic for 16-bit machines.
+f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
+@y
+f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
+@z
+
+% [100] No progress reports unless verbose.
+@x
+ incr(chars_on_line);
+ end;
+ for cprime:=c to (c+no_repeats(c)) do begin
+ print_hex(cprime); {progress report}
+@y
+ if verbose then incr(chars_on_line);
+ end;
+ for cprime:=c to (c+no_repeats(c)) do begin
+ if verbose then print_hex(cprime); {progress report}
+@z
+
+% [112] No nonlocal goto's.
+@x
+ print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ goto final_end;
+@y
+ write_ln(stderr, 'Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ uexit(1);
+@z
+
+% still [112] We can't have a function named `f', because of the local
+% variable in do_simple_things. It would be better, but harder, to fix
+% web2c.
+@x
+ r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
+@y
+ r:=lig_f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
+@z
+
+@x
+ out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
+@y
+ out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); uexit(1);
+@z
+
+% [116] web2c can't handle these mutually recursive procedures.
+% But let's do a fake definition of f here, so that it gets into web2c's
+% symbol table...
+@x
+@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+@y
+@p
+ifdef('notdef')
+function lig_f(@!h,@!x,@!y:index):index; begin end;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+endif('notdef')
+@z
+
+@x
+else eval:=f(h,x,y);
+@y
+else eval:=lig_f(h,x,y);
+@z
+
+@x [117] ... and then really define it now.
+@p function f;
+@y
+@p function lig_f(@!h,@!x,@!y:index):index;
+@z
+
+@x
+f:=lig_z[h];
+@y
+lig_f:=lig_z[h];
+@z
+
+@x [124] Some cc's can't handle 136 case labels.
+ o:=vf[vf_ptr]; incr(vf_ptr);
+ case o of
+ @<Cases of \.{DVI} instructions that can appear in character packets@>@;
+@y
+ o:=vf[vf_ptr]; incr(vf_ptr);
+ if ((o<=set_char_0+127))or
+ ((o>=set1)and(o<=set1+3))or((o>=put1)and(o<=put1+3)) then
+begin if o>=set1 then
+ if o>=put1 then c:=get_bytes(o-put1+1,false)
+ else c:=get_bytes(o-set1+1,false)
+ else c:=o;
+ if f=font_ptr then
+ bad_vf('Character ',c:1,' in undeclared font will be ignored')
+@.Character...will be ignored@>
+ else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+ k:=font_chars[f];@+while vf[k]<>c do incr(k);
+ if k=font_start[f+1]-1 then
+ bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
+ else begin if o>=put1 then out('(PUSH)');
+ left; out('SETCHAR'); out_char(c);
+ if o>=put1 then out(')(POP');
+ right;
+ end;
+ end;
+ end
+ else case o of
+ @<Cases of \.{DVI} instructions that can appear in character packets@>
+@z
+
+@x [125] `signed' is a reserved word in ANSI C.
+@p function get_bytes(@!k:integer;@!signed:boolean):integer;
+@y
+@d signed == is_signed {|signed| is a reserved word in ANSI C}
+@p function get_bytes(@!k:integer;@!signed:boolean):integer;
+@z
+
+@x [126] No nonlocal goto's.
+ begin print_ln('Stack overflow!'); goto final_end;
+@y
+ begin write_ln(stderr, 'Stack overflow!'); uexit(1);
+@z
+
+@x [129] This code moved outside the case statement
+@ Before we typeset a character we make sure that it exists.
+
+@<Cases...@>=
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
+ four_cases(set1),four_cases(put1):begin if o>=set1 then
+ if o>=put1 then c:=get_bytes(o-put1+1,false)
+ else c:=get_bytes(o-set1+1,false)
+ else c:=o;
+ if f=font_ptr then
+ bad_vf('Character ',c:1,' in undeclared font will be ignored')
+@.Character...will be ignored@>
+ else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+ k:=font_chars[f];@+while vf[k]<>c do incr(k);
+ if k=font_start[f+1]-1 then
+ bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
+ else begin if o>=put1 then out('(PUSH)');
+ left; out('SETCHAR'); out_char(c);
+ if o>=put1 then out(')(POP');
+ right;
+ end;
+ end;
+ end;
+@y
+@ Before we typeset a character we make sure that it exists.
+(These cases moved outside the case statement, section 124.)
+@z
+
+@x [134] No final newline unless verbose.
+print_ln('.');@/
+@y
+if verbose then print_ln('.');@/
+@z
+
+@x [135] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{VFtoVP} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 4; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+ end else if getopt_return_val = "?" then begin
+ usage ('ovf2ovp');
+
+ end else if argument_is ('help') then begin
+ usage_help (OVF2OVP_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit
+ (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth');
+
+ end else if argument_is ('charcode-format') then begin
+ if strcmp (optarg, 'ascii') = 0 then
+ charcode_format := charcode_ascii
+ else if strcmp (optarg, 'hex') = 0 then
+ charcode_format := charcode_hex
+ else
+ write_ln (stderr, 'Bad character code format', optarg, '.');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one two three remaining arguments.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc)
+ and (optind + 3 <> argc) then begin
+ write_ln (stderr, 'ovf2ovp: Need one to three file arguments.');
+ usage ('ovf2ovp');
+ end;
+
+ vf_name := cmdline (optind);
+ if optind + 2 <= argc then begin
+ tfm_name := cmdline (optind + 1); {The user specified the TFM name.}
+ end else begin
+ {User did not specify TFM name; default it from the VF name.}
+ tfm_name := basename_change_suffix (vf_name, '.ovf', '.ofm');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+@.-verbose@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@ The global variable |verbose| determines whether or not we print
+progress information.
+
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@ It starts off |false|.
+
+@<Initialize the option...@> =
+verbose := false;
+
+@ Here is an option to change how we output character codes.
+@.-charcode-format@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'charcode-format';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ We use an ``enumerated'' type to store the information.
+
+@<Type...@> =
+@!charcode_format_type = charcode_ascii..charcode_default;
+
+@
+@<Const...@> =
+@!charcode_ascii = 0;
+@!charcode_hex = 1;
+@!charcode_default = 2;
+
+@
+@<Global...@> =
+@!charcode_format: charcode_format_type;
+
+@ It starts off as the default, which is hex for OFM2OPL.
+
+@<Initialize the option...@> =
+charcode_format := charcode_default;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!vf_name, @!tfm_name, @!vpl_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.web b/Build/source/texk/web2c/omegaware/ovf2ovp.web
new file mode 100644
index 00000000000..2e2e374dca5
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/ovf2ovp.web
@@ -0,0 +1,3138 @@
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+% applies only to the changes to the original vftovp.web.
+%
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was implemented in December 1989.
+% Version 1.1 fixed problems of strict Pascal (April 1990).
+% Version 1.2 fixed various bugs found by Peter Breitenlohner (September 1990).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{OVF2OVP}
+\def\contentspagenumber{101}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont OVF2OVP} processor}
+ \vskip 15pt
+ \centerline{(Version 1.11, February 2000)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this program
+ was supported in part by the National Science
+ Foundation and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{VFtoVP} utility program converts a virtual font (``\.{VF}'') file
+and its associated \TeX\ font metric (``\.{TFM}'')
+file into an equivalent virtual-property-list (``\.{VPL}'') file. It also
+makes a thorough check of the given files, using algorithms that are
+essentially the same as those used by
+\.{DVI} device drivers and by \TeX. Thus if \TeX\ or a \.{DVI} driver
+complains that a \.{TFM} or \.{VF}
+file is ``bad,'' this program will pinpoint the source or sources of
+badness. A \.{VPL} file output by this program can be edited with
+a normal text editor, and the result can be converted back to \.{VF} and \.{TFM}
+format using the companion program \.{VPtoVF}.
+
+\indent\.{VFtoVP} is an extended version of the program \.{TFtoPL}, which
+is part of the standard \TeX ware library.
+The idea of a virtual font was inspired by the work of David R. Fuchs
+@^Fuchs, David Raymond@>
+who designed a similar set of conventions in 1984 while developing a
+device driver for ArborText, Inc. He wrote a somewhat similar program
+called \.{AMFtoXPL}.
+
+The |banner| string defined here should be changed whenever \.{VFtoVP}
+gets modified.
+
+@d banner=='This is OVF2OVP, Version 1.11' {printed when the program starts}
+
+@ This program is written entirely in standard \PASCAL, except that
+it occasionally has lower case letters in strings that are output.
+Such letters can be converted to upper case if necessary. The input is read
+from |vf_file| and |tfm_file|; the output is written on |vpl_file|.
+Error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program OVF2OVP(@!vf_file,@!tfm_file,@!vpl_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @!k:integer; {all-purpose index for initialization}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{VFtoVP}'s capacity.
+
+@<Constants...@>=
+@!tfm_size=2000000; {maximum length of |tfm| data, in bytes}
+@!vf_size=600000; {maximum length of |vf| data, in bytes}
+@!max_fonts=300; {maximum number of local fonts in the |vf| file}
+@!lig_size=800000; {maximum length of |lig_kern| program, in words}
+@!hash_size=130003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@!hash_mult=16007; {another prime}
+@!max_char=65535; {the largest character number in a font}
+@!xmax_char=65536; {|max_char|+1}
+@!xxmax_char=65537;{|max_char|+2}
+@!xmax_label=80001;{must be greater than |max_lig_steps|}
+@!mem_size=40008; {|max_char|*4+8}
+@!name_length=50; {a file name shouldn't be longer than this}
+@!max_stack=50; {maximum depth of \.{DVI} stack in character packets}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+@d exit=10 {go here to leave a procedure}
+@d not_found=45 {go here when you've found nothing}
+@d return==goto exit {terminate a procedure call}
+@f return==nil
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+
+@* Virtual fonts. The idea behind \.{VF} files is that a general
+interface mechanism is needed to switch between the myriad font
+layouts provided by different suppliers of typesetting equipment.
+Without such a mechanism, people must go to great lengths writing
+inscrutable macros whenever they want to use typesetting conventions
+based on one font layout in connection with actual fonts that have
+another layout. This puts an extra burden on the typesetting system,
+interfering with the other things it needs to do (like kerning,
+hyphenation, and ligature formation).
+
+These difficulties go away when we have a ``virtual font,''
+i.e., a font that exists in a logical sense but not a physical sense.
+A typesetting system like \TeX\ can do its job without knowing where the
+actual characters come from; a device driver can then do its job by
+letting a \.{VF} file tell what actual characters correspond to the
+characters \TeX\ imagined were present. The actual characters
+can be shifted and/or magnified and/or combined with other characters
+from many different fonts. A virtual font can even make use of characters
+from virtual fonts, including itself.
+
+Virtual fonts also allow convenient character substitutions for proofreading
+purposes, when fonts designed for one output device are unavailable on another.
+
+@ A \.{VF} file is organized as a stream of 8-bit bytes, using conventions
+borrowed from \.{DVI} and \.{PK} files. Thus, a device driver that knows
+about \.{DVI} and \.{PK} format will already
+contain most of the mechanisms necessary to process \.{VF} files.
+We shall assume that \.{DVI} format is understood; the conventions in the
+\.{DVI} documentation (see, for example, {\sl \TeX: The Program}, part 31)
+are adopted here to define \.{VF} format.
+
+A preamble
+appears at the beginning, followed by a sequence of character definitions,
+followed by a postamble. More precisely, the first byte of every \.{VF} file
+must be the first byte of the following ``preamble command'':
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]| |cs[4]| |ds[4]|.
+Here |i| is the identification byte of \.{VF}, currently 202. The string
+|x| is merely a comment, usually indicating the source of the \.{VF} file.
+Parameters |cs| and |ds| are respectively the check sum and the design size
+of the virtual font; they should match the first two words in the header of
+the \.{TFM} file, as described below.
+
+\yskip
+After the |pre| command, the preamble continues with font definitions;
+every font needed to specify ``actual'' characters in later
+\\{set\_char} commands is defined here. The font definitions are
+exactly the same in \.{VF} files as they are in \.{DVI} files, except
+that the scaled size |s| is relative and the design size |d| is absolute:
+
+\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<256|.
+
+\yskip\hang|@!fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<65536|.
+
+\yskip\hang|@!fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|@!fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
+
+\yskip\noindent
+These font numbers |k| are ``local''; they have no relation to font numbers
+defined in the \.{DVI} file that uses this virtual font. The dimension~|s|,
+which represents the scaled size of the local font being defined,
+is a |fix_word| relative to the design size of the virtual font.
+Thus if the local font is to be used at the same size
+as the design size of the virtual font itself, |s| will be the
+integer value $2^{20}$. The value of |s| must be positive and less than
+$2^{24}$ (thus less than 16 when considered as a |fix_word|).
+The dimension~|d| is a |fix_word| in units of printer's points; hence it
+is identical to the design size found in the corresponding \.{TFM} file.
+
+@d id_byte=202
+
+@<Glob...@>=
+@!vf_file:packed file of byte;
+
+@ The preamble is followed by zero or more character packets, where each
+character packet begins with a byte that is $<243$. Character packets have
+two formats, one long and one short:
+
+\yskip\hang|long_char| 242 |pl[4]| |cc[4]| |tfm[4]| |dvi[pl]|. This long form
+specifies a virtual character in the general case.
+
+\yskip\hang|short_char0..short_char241|
+|pl[1]| |cc[1]| |tfm[3]| |dvi[pl]|. This short form specifies a
+virtual character in the common case
+when |0<=pl<242| and |0<=cc<256| and $0\le|tfm|<2^{24}$.
+
+\yskip\noindent
+Here |pl| denotes the packet length following the |tfm| value; |cc| is
+the character code; and |tfm| is the character width copied from the
+\.{TFM} file for this virtual font. There should be at most one character
+packet having any given |cc| code.
+
+The |dvi| bytes are a sequence of complete \.{DVI} commands, properly
+nested with respect to |push| and |pop|. All \.{DVI} operations are
+permitted except |bop|, |eop|, and commands with opcodes |>=243|.
+Font selection commands (|fnt_num0| through |fnt4|) must refer to fonts
+defined in the preamble.
+
+Dimensions that appear in the \.{DVI} instructions are analogous to
+|fix_word| quantities; i.e., they are integer multiples of $2^{-20}$ times
+the design size of the virtual font. For example, if the virtual font
+has design size $10\,$pt, the \.{DVI} command to move down $5\,$pt
+would be a \\{down} instruction with parameter $2^{19}$. The virtual font
+itself might be used at a different size, say $12\,$pt; then that
+\\{down} instruction would move down $6\,$pt instead. Each dimension
+must be less than $2^{24}$ in absolute value.
+
+Device drivers processing \.{VF} files treat the sequences of |dvi| bytes
+as subroutines or macros, implicitly enclosing them with |push| and |pop|.
+Each subroutine begins with |w=x=y=z=0|, and with current font~|f| the
+number of the first-defined in the preamble (undefined if there's no
+such font). After the |dvi| commands have been
+performed, the |h| and~|v| position registers of \.{DVI} format and the
+current font~|f| are restored to their former values;
+then, if the subroutine has been invoked by a \\{set\_char} or \\{set}
+command, |h|~is increased by the \.{TFM} width
+(properly scaled)---just as if a simple character had been typeset.
+
+@d long_char=242 {\.{VF} command for general character packet}
+@d set_char_0=0 {\.{DVI} command to typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d improper_DVI_for_VF==139,140,243,244,245,246,247,248,249,250,251,252,
+ 253,254,255
+
+@ The character packets are followed by a trivial postamble, consisting of
+one or more bytes all equal to |post| (248). The total number of bytes
+in the file should be a multiple of~4.
+
+@* Font metric data.
+The idea behind \.{TFM} files is that typesetting routines like \TeX\
+need a compact way to store the relevant information about several
+dozen fonts, and computer centers need a compact way to store the
+relevant information about several hundred fonts. \.{TFM} files are
+compact, and most of the information they contain is highly relevant,
+so they provide a solution to the problem.
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of 4, we could
+also regard the file as a sequence of 32-bit words; but \TeX\ uses the
+byte interpretation, and so does \.{VFtoVP}. Note that the bytes
+are considered to be unsigned numbers.
+
+@<Glob...@>=
+@!tfm_file:packed file of byte;
+
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file); reset(vf_file);
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|@!lf|&length of the entire file, in words;\cr
+|@!lh|&length of the header data, in words;\cr
+|@!bc|&smallest character code in the font;\cr
+|@!ec|&largest character code in the font;\cr
+|@!nw|&number of words in the width table;\cr
+|@!nh|&number of words in the height table;\cr
+|@!nd|&number of words in the depth table;\cr
+|@!ni|&number of words in the italic correction table;\cr
+|@!nl|&number of words in the lig/kern table;\cr
+|@!nk|&number of words in the kern table;\cr
+|@!ne|&number of words in the extensible character table;\cr
+|@!np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+|ne<=256|, and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+
+@<Glob...@>=
+@!ofm_level,
+@!nco,@!ncw,@!npc,@!nki,@!nwi,@!nkf,@!nwf,@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp,
+@!nkm,@!nwm,@!real_lf,
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np,@!font_dir:integer;
+ {subfile sizes}
+@!ofm_on:boolean;
+
+@ @<Set init...@>=
+ofm_on:=false; ofm_level:=-1; lf:=0; lh:=0;
+nco:=0; ncw:=0; npc:=0; bc:=0; ec:=0; nw:=0; nh:=0; nd:=0; ni:=0;
+nl:=0; nk:=0; ne:=0; np:=0;
+nki:=0; nwi:=0; nkf:=0; nwf:=0;
+nkm:=0; nwm:=0; real_lf:=0;
+nkr:=0; nwr:=0; nkg:=0; nwg:=0;
+nkp:=0; nwp:=0; font_dir:=0;
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
+header&|[0..lh-1]stuff|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but one of
+the |fix_word| values will lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+and for \.{TFM} files to be used with Xerox printing software it must
+contain at least 18 words, allocated as described below. When different
+kinds of devices need to be interfaced, it may be necessary to add further
+words to the header block.
+
+\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the
+\.{DVI} output file whenever it uses the font. Later on when the \.{DVI}
+file is printed, possibly on another computer, the actual font that gets
+used is supposed to have a check sum that agrees with the one in the
+\.{TFM} file used by \TeX. In this way, users will be warned about
+potential incompatibilities. (However, if the check sum is zero in either
+the font file or the \.{TFM} file, no check is made.) The actual relation
+between this check sum and the rest of the \.{TFM} file is not important;
+the check sum is simply an identification number with the property that
+incompatible fonts almost always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of the
+font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number
+must be at least 1.0; it is fairly arbitrary, but usually the design size
+is 10.0 for a ``10 point'' font, i.e., a font that was designed to look
+best at a 10-point size, whatever that really means. When a \TeX\ user
+asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the
+design size and replace it by $\delta$, and to multiply the $x$ and~$y$
+coordinates of the points in the font image by a factor of $\delta$
+divided by the design size. {\sl All other dimensions in the\/\ \.{TFM}
+file are |fix_word|\kern-1pt\ numbers in design-size units.} Thus, for example,
+the value of |param[6]|, one \.{em} or \.{\\quad}, is often the |fix_word|
+value $2^{20}=1.0$, since many fonts have a design size equal to one em.
+The other dimensions must be less than 16 design-size units in absolute
+value; thus, |header[1]| and |param[1]| are the only |fix_word| entries in
+the whole \.{TFM} file whose first byte might be something besides 0 or
+255. @^design size@>
+
+\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify
+the character coding scheme. The first byte, which must be between 0 and
+39, is the number of subsequent ASCII bytes actually relevant in this
+string, which is intended to specify what character-code-to-symbol
+convention is present in the font. Examples are \.{ASCII} for standard
+ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math
+extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for
+special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case
+when there is no information. Parentheses should not appear in this name.
+(Such a string is said to be in {\mc BCPL} format.)
+@^coding scheme@>
+
+\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the
+font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format.
+This field is also known as the ``font identifier.''
+@^family name@>
+@^font identifier@>
+
+\yskip\hang|header[17]|, if present, contains a first byte called the
+|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte
+called the |face|. If the value of the fourth byte is less than 18, it has
+the following interpretation as a ``weight, slope, and expansion'': Add 0
+or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to
+0 or 6 or 12 (for regular or condensed or extended). For example, 13 is
+0+1+12, so it represents medium italic extended. A three-letter code
+(e.g., \.{MIE}) can be used for such |face| data.
+
+\yskip\hang|header[18..@twhatever@>]| might also be present; the individual
+words are simply called |header[18]|, |header[19]|, etc., at the moment.
+
+@ Next comes the |char_info| array, which contains one |char_info_word|
+per character. Each |char_info_word| contains six fields packed into
+four bytes as follows.
+
+\yskip\hang first byte: |width_index| (8 bits)\par
+\hang second byte: |height_index| (4 bits) times 16, plus |depth_index|
+ (4~bits)\par
+\hang third byte: |italic_index| (6 bits) times 4, plus |tag|
+ (2~bits)\par
+\hang fourth byte: |remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is |width[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation |width[0]=height[0]=depth[0]=italic[0]=0|
+should always hold, so that an index of zero implies a value of zero.
+The |width_index| should never be zero unless the character does
+not exist in the font, since a character is valid if and only if it lies
+between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at |lig_kern[remainder]|.\par
+\hang|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain. The
+|remainder| field gives the character code of the next larger character.\par
+\hang|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|exten[remainder]|.\par
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word is a
+|lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+ step if the byte is 128 or more, otherwise the next step is obtained by
+ skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+ then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+ a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+Notice that if $a=0$ and $b=1$, the current character is unchanged; if
+$a=b$ and $c=1$, the current character is changed but the next character is
+unchanged. \.{VFtoVP} will check to see that infinite loops are avoided.
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must have
+|256*op_byte+remainder<nl|. If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+command is performed.
+
+@d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@ Extensible characters are specified by an |extensible_recipe|,
+which consists of four bytes called |top|, |mid|,
+|bot|, and |rep| (in this order). These bytes are the character codes
+of individual pieces used to build up a large symbol.
+If |top|, |mid|, or |bot| are zero,
+they are not present in the built-up result. For example, an extensible
+vertical line is like an extensible bracket, except that the top and
+bottom pieces are missing.
+
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=@!slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it's the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character |" "| in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the height of letters for which accents don't
+have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+When the character coding scheme is \.{TeX math symbols}, the font is
+supposed to have 15 additional parameters called |num1|, |num2|, |num3|,
+|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|,
+|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the
+character coding scheme is \.{TeX math extension}, the font is supposed to
+have six additional parameters called |default_rule_thickness| and
+|big_op_spacing1| through |big_op_spacing5|.
+
+@ So that is what \.{TFM} files hold. The next question is, ``What about
+\.{VPL} files?'' A complete answer to that question appears in the
+documentation of the companion program, \.{VPtoVF}, so it will not
+be repeated here. Suffice it to say that a \.{VPL} file is an ordinary
+\PASCAL\ text file, and that the output of \.{VFtoVP} uses only a
+subset of the possible constructions that might appear in a \.{VPL} file.
+Furthermore, hardly anybody really wants to look at the formal
+definition of \.{VPL} format, because it is almost self-explanatory when
+you see an example or two.
+
+@<Glob...@>=
+@!vpl_file:text;
+
+@ @<Set init...@>=
+rewrite(vpl_file);
+
+@* Unpacking the TFM file.
+The first thing \.{VFtoVP} does is read the entire |tfm_file| into an array of
+bytes, |tfm[0..(4*lf-1)]|.
+
+@<Types...@>=
+@!index=0..tfm_size; {address of a byte in |tfm|}
+@!char_type=0..65535;
+@!xchar_type=0..65536;
+@!xxchar_type=0..65537;
+@!xxxchar_type=0..65538;
+
+@
+@<Glob...@>=
+@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
+ {the negative addresses avoid range checks for invalid characters}
+@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
+@!start_ptr,@!check_sum,@!design_size,@!scheme,@!family,@!random_word:integer;
+@!header_length,@!char_ptr,@!copies,@!j:integer;
+
+@ The input may, of course, be all screwed up and not a \.{TFM} file
+at all. So we begin cautiously.
+
+@d abort(#)==begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a OFM?');
+ goto final_end;
+ end
+
+@<Read the whole font metric file@>=
+read(tfm_file,tfm[0]);
+if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
+@.The first byte...@>
+if eof(tfm_file) then abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
+if lf=0 then begin
+ for i:=2 to 7 do begin
+ if eof(tfm_file)
+ then abort('The input file is too short to designate its length!');
+ read(tfm_file, tfm[i]);
+ end;
+ ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3];
+ if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!');
+ lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7];
+ end
+else begin
+ ofm_on := false;
+ end;
+case ofm_level of
+ -1: begin start_ptr:=2; check_sum:=24; end;
+ 0: begin start_ptr:=8; check_sum:=56; end;
+ 1: begin start_ptr:=8; check_sum:=116; end;
+ end;
+design_size:=check_sum+4;
+scheme:=design_size+4;
+family:=scheme+40;
+random_word:=family+20;
+if lf=0 then
+ abort('The file claims to have length zero, but that''s impossible!');
+@.The file claims...@>
+if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+for tfm_ptr:=start_ptr to 4*lf-1 do begin
+ if eof(tfm_file) then
+ abort('The file has fewer bytes than it claims!');
+@.The file has fewer bytes...@>
+ read(tfm_file,tfm[tfm_ptr]);
+ end;
+if not eof(tfm_file) then begin
+ print_ln('There''s some extra junk at the end of the OFM file,');
+@.There's some extra junk...@>
+ print_ln('but I''ll proceed as if it weren''t there.');
+ end
+
+@ After the file has been read successfully, we look at the subfile sizes
+to see if they check out.
+
+@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then
+ abort('One of the subfile sizes is negative!');
+@.One of the subfile sizes...@>
+ #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1];
+ tfm_ptr:=tfm_ptr+2;
+ end
+@d eval_four_bytes(#)==begin if tfm[tfm_ptr]>127 then
+ abort('One of the subfile sizes is negative!');
+@.One of the subfile sizes...@>
+ #:=tfm[tfm_ptr]*@"1000000+tfm[tfm_ptr+1]*@"10000+
+ tfm[tfm_ptr+2]*@"100+tfm[tfm_ptr+3];
+ tfm_ptr:=tfm_ptr+4;
+ end
+
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>=
+begin
+if not ofm_on then begin
+ tfm_ptr:=2;
+ eval_two_bytes(lh);
+ eval_two_bytes(bc);
+ eval_two_bytes(ec);
+ eval_two_bytes(nw);
+ eval_two_bytes(nh);
+ eval_two_bytes(nd);
+ eval_two_bytes(ni);
+ eval_two_bytes(nl);
+ eval_two_bytes(nk);
+ eval_two_bytes(ne);
+ eval_two_bytes(np);
+ ncw:=(ec-bc+1);
+ header_length:=6;
+ top_char:=255;
+ top_width:=255;
+ top_height:=15;
+ top_depth:=15;
+ top_italic:=63;
+ end
+else begin
+ tfm_ptr:=8;
+ eval_four_bytes(lh);
+ eval_four_bytes(bc);
+ eval_four_bytes(ec);
+ eval_four_bytes(nw);
+ eval_four_bytes(nh);
+ eval_four_bytes(nd);
+ eval_four_bytes(ni);
+ eval_four_bytes(nl);
+ eval_four_bytes(nk);
+ eval_four_bytes(ne);
+ eval_four_bytes(np);
+ eval_four_bytes(font_dir);
+ top_char:=65535;
+ top_width:=65535;
+ top_height:=255;
+ top_depth:=255;
+ top_italic:=255;
+ if ofm_level=0 then begin
+ header_length:=14;
+ ncw:=2*(ec-bc+1);
+ end
+ else begin
+ header_length:=29;
+ eval_four_bytes(nco);
+ eval_four_bytes(ncw);
+ eval_four_bytes(npc);
+ eval_four_bytes(nki); {Kinds of font ivalues}
+ eval_four_bytes(nwi); {Words of font ivalues}
+ eval_four_bytes(nkf); {Kinds of font fvalues}
+ eval_four_bytes(nwf); {Words of font fvalues}
+ eval_four_bytes(nkm); {Kinds of font mvalues}
+ eval_four_bytes(nwm); {Words of font mvalues}
+ eval_four_bytes(nkr); {Kinds of font rules}
+ eval_four_bytes(nwr); {Words of font rules}
+ eval_four_bytes(nkg); {Kinds of font glues}
+ eval_four_bytes(nwg); {Words of font glues}
+ eval_four_bytes(nkp); {Kinds of font penalties}
+ eval_four_bytes(nwp); {Words of font penalties}
+ end;
+ end;
+if lf<>(header_length+lh+ncw+nw+nh+nd+ni+2*nl+nk+2*ne+np+
+ nki+nwi+nkf+nwf+nkr+nwr+nkg+nwg+nkp+nwp) then
+ abort('Subfile sizes don''t add up to the stated total!');
+@.Subfile sizes don't add up...@>
+if lh<2 then abort('The header length is only ',lh:1,'!');
+@.The header length...@>
+if (2*nl)>(4*lig_size) then
+ abort('The lig/kern program is longer than I can handle!');
+@.The lig/kern program...@>
+if (bc>ec+1)or(ec>top_char) then abort('The character code range ',
+@.The character code range...@>
+ bc:1,'..',ec:1,'is illegal!');
+if ec>max_char then
+ abort('Character ',ec:1,'is too large. Ask a wizard to enlarge me.');
+if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
+ abort('Incomplete subfiles for character dimensions!');
+@.Incomplete subfiles...@>
+if ne>(top_char+1) then abort('There are ',ne:1,' extensible recipes!');
+@.There are ... recipes@>
+end
+
+@ Once the input data successfully passes these basic checks,
+\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion
+to \.{PL} format will take place. Access to the various subfiles
+is facilitated by computing the following base addresses. For example,
+the |char_info| for character |c| in a \.{TFM} file will start in location
+|4*(char_base+c)| of the |tfm| array.
+
+@<Globals...@>=
+@!ivalues_start,@!fvalues_start,@!mvalues_start,
+@!rules_start,@!glues_start,@!penalties_start:
+integer;
+@!ivalues_base,@!fvalues_base,@!mvalues_base,
+@!rules_base,@!glues_base,@!penalties_base:
+integer;
+@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base: integer;
+@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
+ {base addresses for the subfiles}
+@!char_start:array [0..max_char] of integer;
+@!bytes_per_entry:integer;
+
+@ @<Compute the base addresses@>=
+begin
+ivalues_start:=header_length+lh;
+fvalues_start:=ivalues_start+nki;
+mvalues_start:=fvalues_start+nkf;
+rules_start:=mvalues_start+nkm;
+glues_start:=rules_start+nkr;
+penalties_start:=glues_start+nkg;
+ivalues_base:=penalties_start+nkp;
+fvalues_base:=ivalues_base+nwi;
+mvalues_base:=fvalues_base+nwi;
+rules_base:=mvalues_base+nwm;
+glues_base:=rules_base+nwr;
+penalties_base:=glues_base+nwg;
+char_base:=penalties_base+nwp;
+bytes_per_entry:=(12 + 2*npc) div 4 * 4;
+if not ofm_on then begin
+ for i:=bc to ec do begin
+ char_start[i]:=4*char_base+4*(i-bc);
+ end;
+ end
+else if ofm_level=0 then begin
+ for i:=bc to ec do begin
+ char_start[i]:=4*char_base+8*(i-bc);
+ end;
+ end
+else begin
+ char_ptr:=4*char_base;
+ i:=bc;
+ while i<=ec do begin
+ copies:=1+256*tfm[char_ptr+8]+tfm[char_ptr+9];
+ for j:=1 to copies do begin
+ char_start[i]:=char_ptr;
+ i:=i+1;
+ end;
+ char_ptr:=char_ptr + bytes_per_entry;
+ end;
+ if char_ptr<>(4*(char_base+ncw)) then
+ abort('Length of char info table does not correspond to specification');
+ end;
+width_base:=char_base+ncw;
+height_base:=width_base+nw;
+depth_base:=height_base+nh;
+italic_base:=depth_base+nd;
+lig_kern_base:=italic_base+ni;
+kern_base:=lig_kern_base+2*nl;
+exten_base:=kern_base+nk;
+param_base:=exten_base+2*ne-1;
+end
+
+@ Of course we want to define macros that suppress the detail of how the
+font information is actually encoded. Each word will be referred to by
+the |tfm| index of its first byte. For example, if |c| is a character
+code between |bc| and |ec|, then |tfm[char_info(c)]| will be the
+first byte of its |char_info|, i.e., the |width_index|; furthermore
+|width(c)| will point to the |fix_word| for |c|'s width.
+
+@d char_info(#)==char_start[#]
+@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0))
+@d width(#)==4*(width_base+width_index(#))
+@d height(#)==4*(height_base+height_index(#))
+@d depth(#)==4*(depth_base+depth_index(#))
+@d italic(#)==4*(italic_base+italic_index(#))
+@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
+@d param(#)==4*(param_base+#) {likewise}
+
+@p function width_index(c:char_type):integer;
+begin if not ofm_on then
+ width_index:=tfm[char_info(c)]
+else
+ width_index:=256*tfm[char_info(c)]+tfm[char_info(c)+1];
+end;
+
+function height_index(c:char_type):integer;
+begin if not ofm_on then
+ height_index:=tfm[char_info(c)+1] div 16
+else
+ height_index:=tfm[char_info(c)+2];
+end;
+
+function depth_index(c:char_type):integer;
+begin if not ofm_on then
+ depth_index:=tfm[char_info(c)+1] mod 16
+else
+ depth_index:=tfm[char_info(c)+3];
+end;
+
+function italic_index(c:char_type):integer;
+begin if not ofm_on then
+ italic_index:=tfm[char_info(c)+2] div 4
+else if ofm_level=0 then
+ italic_index:=tfm[char_info(c)+4]*64 + tfm[char_info(c)+5] div 4
+else
+ italic_index:=tfm[char_info(c)+4];
+end;
+
+function tag(c:char_type):integer;
+begin if not ofm_on then
+ tag:=tfm[char_info(c)+2] mod 4
+else
+ tag:=tfm[char_info(c)+5] mod 4;
+end;
+
+procedure set_no_tag(c:char_type);
+begin if not ofm_on then
+ tfm[char_info(c)+2] := (tfm[char_info(c)+2] div 64)*64 + no_tag
+else
+ tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag;
+end;
+
+function ctag(c:char_type):boolean;
+begin if not (ofm_level=1) then
+ ctag:=false
+else
+ ctag:=tfm[char_info(c)+5] div 4 mod 2;
+end;
+
+procedure set_no_ctag(c:char_type);
+begin if not (ofm_level=1) then
+ tfm[char_info(c)+5] :=
+ tfm[char_info(c)+5] div 8 * 8 + tfm[char_info(c)+5] mod 4;
+end;
+
+function no_repeats(c:char_type):integer;
+begin if ofm_level<=0 then
+ no_repeats:=0
+else
+ no_repeats:=256*tfm[char_info(c)+8]+tfm[char_info(c)+9];
+end;
+
+function char_param(c:char_type; i:integer):integer;
+begin
+ char_param:=256*tfm[char_info(c)+2*i+10]+tfm[char_info(c)+2*i+11];
+end;
+
+function rremainder(c:char_type):integer;
+begin if not ofm_on then
+ rremainder:=tfm[char_info(c)+3]
+else
+ rremainder:=256*tfm[char_info(c)+6]+tfm[char_info(c)+7];
+end;
+
+function lig_step(c:char_type):integer;
+begin if not ofm_on then
+ lig_step:=4*(lig_kern_base+c)
+else
+ lig_step:=4*(lig_kern_base+2*c);
+end;
+
+function exten(c:char_type):integer;
+begin if not ofm_on then
+ exten:=4*(exten_base+rremainder(c))
+else
+ exten:=4*(exten_base+2*rremainder(c));
+end;
+
+function l_skip_byte(c:integer):integer;
+begin if not ofm_on then
+ l_skip_byte:=tfm[c]
+else
+ l_skip_byte:=256*tfm[c]+tfm[c+1];
+end;
+
+procedure set_l_skip_byte(c:integer; newc:integer);
+begin if not ofm_on then
+ tfm[c]:=newc
+else begin
+ tfm[c]:=newc div 256;
+ tfm[c+1]:=newc mod 256
+ end
+end;
+
+function l_next_char(c:integer):integer;
+begin if not ofm_on then
+ l_next_char:=tfm[c+1]
+else
+ l_next_char:=256*tfm[c+2]+tfm[c+3];
+end;
+
+procedure set_l_next_char(c:integer; newc:char_type);
+begin if not ofm_on then
+ tfm[c+1]:=newc
+else begin
+ tfm[c+2]:=newc div 256;
+ tfm[c+3]:=newc mod 256
+ end
+end;
+
+function l_op_byte(c:integer):integer;
+begin if not ofm_on then
+ l_op_byte:=tfm[c+2]
+else
+ l_op_byte:=256*tfm[c+4]+tfm[c+5];
+end;
+
+procedure set_l_op_byte(c:integer; newc:integer);
+begin if not ofm_on then
+ tfm[c+2]:=newc
+else begin
+ tfm[c+2]:=newc div 256;
+ tfm[c+3]:=newc mod 256
+ end
+end;
+
+function l_remainder(c:integer):integer;
+begin if not ofm_on then
+ l_remainder:=tfm[c+3]
+else
+ l_remainder:=256*tfm[c+6]+tfm[c+7];
+end;
+
+procedure set_l_remainder(c:integer; newc:char_type);
+begin if not ofm_on then
+ tfm[c+3]:=newc
+else begin
+ tfm[c+6]:=newc div 256;
+ tfm[c+7]:=newc mod 256
+ end
+end;
+
+@ One of the things we would like to do is take cognizance of fonts whose
+character coding scheme is \.{TeX math symbols} or \.{TeX math extension};
+we will set the |font_type| variable to one of the three choices
+|vanilla|, |mathsy|, or |mathex|.
+
+@d vanilla=0 {not a special scheme}
+@d mathsy=1 {\.{TeX math symbols} scheme}
+@d mathex=2 {\.{TeX math extension} scheme}
+
+@<Glob...@>=
+@!font_type:vanilla..mathex; {is this font special?}
+
+@* Unpacking the VF file.
+Once the \.{TFM} file has been brought into memory, \.{VFtoVP} completes
+the input phase by reading the \.{VF} information into another array of bytes.
+In this case we don't store all the data; we check the redundant bytes
+for consistency with their \.{TFM} counterparts, and we partially decode
+the packets.
+
+@<Glob...@>=
+@!vf:array[0..vf_size] of byte; {the \.{VF} input data goes here}
+@!font_number:array[0..max_fonts] of integer; {local font numbers}
+@!font_start,@!font_chars:array[0..max_fonts] of 0..vf_size; {font info}
+@!font_ptr:0..max_fonts; {number of local fonts}
+@!packet_start,@!packet_end:array[char_type] of 0..vf_size;
+ {character packet boundaries}
+@!packet_found:boolean; {at least one packet has appeared}
+@!temp_byte:byte;@+@!reg_count:integer; {registers for simple calculations}
+@!real_dsize:real; {the design size, converted to floating point}
+@!pl:integer; {packet length}
+@!vf_ptr:0..vf_size; {first unused location in |vf|}
+@!vf_count:integer; {number of bytes read from |vf_file|}
+
+@ Again we cautiously verify that we've been given decent data.
+
+@d read_vf(#)==read(vf_file,#)
+@d vf_abort(#)==begin
+ print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a OVF?');
+ goto final_end;
+ end
+
+@<Read the whole \.{VF} file@>=
+read_vf(temp_byte);
+if temp_byte<>pre then vf_abort('The first byte isn''t `pre''!');
+@.The first byte...@>
+@<Read the preamble command@>;
+@<Read and store the font definitions and character packets@>;
+@<Read and verify the postamble@>
+
+@ @d vf_store(#)==@t@>@;@/
+ if vf_ptr+#>=vf_size then vf_abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+ for k:=vf_ptr to vf_ptr+#-1 do
+ begin if eof(vf_file) then vf_abort('The file ended prematurely!');
+@.The file ended prematurely@>
+ read_vf(vf[k]);
+ end;
+ vf_count:=vf_count+#; vf_ptr:=vf_ptr+#
+
+@<Read the preamble command@>=
+if eof(vf_file) then vf_abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read_vf(temp_byte);
+if temp_byte<>id_byte then vf_abort('Wrong OVF version number in second byte!');
+@.Wrong OVF version...@>
+if eof(vf_file) then vf_abort('The input file is only two bytes long!');
+read_vf(temp_byte); {read the length of introductory comment}
+vf_count:=11; vf_ptr:=0; vf_store(temp_byte);
+for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
+print_ln(' '); reg_count:=0;
+for k:=0 to 7 do
+ begin if eof(vf_file) then vf_abort('The file ended prematurely!');
+@.The file ended prematurely@>
+ read_vf(temp_byte);
+ if temp_byte=tfm[check_sum+k] then incr(reg_count);
+ end;
+real_dsize:=(((tfm[design_size]*256+tfm[design_size+1])*256+tfm[design_size+2])
+ *256+tfm[design_size+3])/@'4000000;
+if reg_count<>8 then
+ begin print_ln('Check sum and/or design size mismatch.');
+@.Check sum...mismatch@>
+ print_ln('Data from OFM file will be assumed correct.');
+ end
+
+@ @<Read and store the font definitions and character packets@>=
+for k:=0 to 65535 do packet_start[k]:=vf_size;
+font_ptr:=0; packet_found:=false; font_start[0]:=vf_ptr;
+repeat if eof(vf_file) then
+ begin print_ln('File ended without a postamble!'); temp_byte:=post;
+@.File ended without a postamble@>
+ end
+else begin read_vf(temp_byte); incr(vf_count);
+ if temp_byte<>post then
+ if temp_byte>long_char then @<Read and store a font definition@>
+ else @<Read and store a character packet@>;
+ end;
+until temp_byte=post
+
+@ @<Read and verify the postamble@>=
+while (temp_byte=post)and not eof(vf_file) do
+ begin read_vf(temp_byte); incr(vf_count);
+ end;
+if not eof(vf_file) then
+ begin print_ln('There''s some extra junk at the end of the OVF file.');
+@.There's some extra junk...@>
+ print_ln('I''ll proceed as if it weren''t there.');
+ end;
+if vf_count mod 4 <> 0 then
+ print_ln('VF data not a multiple of 4 bytes')
+@.VF data not a multiple of 4 bytes@>
+
+@ @<Read and store a font definition@>=
+begin if packet_found or(temp_byte>=pre) then
+ vf_abort('Illegal byte ',temp_byte:1,' at beginning of character packet!');
+@.Illegal byte...@>
+font_number[font_ptr]:=vf_read(temp_byte-fnt_def1+1);
+if font_ptr=max_fonts then vf_abort('I can''t handle that many fonts!');
+@.I can't handle that many fonts@>
+vf_store(14); {|c[4]| |s[4]| |d[4]| |a[1]| |l[1]|}
+if vf[vf_ptr-10]>0 then {|s| is negative or exceeds $2^{24}-1$}
+ vf_abort('Mapped font size is too big!');
+@.Mapped font size...big@>
+a:=vf[vf_ptr-2]; l:=vf[vf_ptr-1]; vf_store(a+l); {|n[a+l]|}
+@<Print the name of the local font@>;
+@<Read the local font's \.{TFM} file and record the characters it contains@>;
+incr(font_ptr); font_start[font_ptr]:=vf_ptr;
+end
+
+@ The font area may need to be separated from the font name on some systems.
+Here we simply reproduce the font area and font name (with no space
+or punctuation between them).
+@^system dependencies@>
+
+@<Print the name...@>=
+print('MAPFONT ',font_ptr:1,': ');
+for k:=font_start[font_ptr]+14 to vf_ptr-1 do print(xchr[vf[k]]);
+k:=font_start[font_ptr]+5;
+print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2,
+ 'pt')
+
+@ Now we must read in another \.{TFM} file. But this time we needn't be so
+careful, because we merely want to discover which characters are present.
+The next few sections of the program are copied pretty much verbatim from
+\.{DVItype}, so that system-dependent modifications can be copied from existing
+software.
+
+It turns out to be convenient to read four bytes at a time, when we are
+inputting from the local \.{TFM} files. The input goes into global variables
+|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3|
+the fourth.
+
+@<Glob...@>=
+@!a:integer; {length of the area/directory spec}
+@!l:integer; {length of the font name proper}
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!b0,@!b1,@!b2,@!b3: byte; {four bytes input at once}
+@!font_lh:integer; {header length of current local font}
+@!font_bc,@!font_ec:integer; {character range of current local font}
+@!font_ofm_level,@!font_extra_words:integer;
+@!font_kprime,@!font_j:integer;
+
+@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
+four bytes in the current \.{TFM} file.
+@^system dependencies@>
+
+@d read_tfm(#)==if eof(tfm_file) then #:=0@+else read(tfm_file,#)
+
+@p procedure read_tfm_word;
+begin read_tfm(b0); read_tfm(b1);
+read_tfm(b2); read_tfm(b3);
+end;
+
+@ We use the |vf| array to store a list of all valid characters in the
+local font, beginning at location |font_chars[f]|.
+
+@<Read the local font's \.{TFM} file...@>=
+font_chars[font_ptr]:=vf_ptr;
+@<Move font name into the |cur_name| string@>;
+reset(tfm_file,cur_name);
+@^system dependencies@>
+if eof(tfm_file) then
+ print_ln('---not loaded, font metric file can''t be opened!')
+@.font metric file can\'t be opened@>
+else begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon}
+ @<Read past the header@>;
+ if font_bc<=font_ec then
+ if font_ec>65535 then print_ln('---not loaded, bad font metric file!')
+@.bad font metric file@>
+ else @<Read |char_info| entries@>;
+ if eof(tfm_file) then
+ print_ln('---trouble is brewing, font metric file ended too soon!');
+@.trouble is brewing...@>
+ end;
+incr(vf_ptr) {leave space for character search later}
+
+@ @<Read past the header@>=
+read_tfm_word;
+if (b0*256+b1)<>0 then begin {TFM file}
+ font_ofm_level:=-1;
+ font_lh:=b2*256+b3;
+ read_tfm_word; font_bc:=b0*256+b1; font_ec:=b2*256+b3;
+ if font_ec<font_bc then font_bc:=font_ec+1;
+ read_tfm_word;
+ for k:=1 to 3+font_lh do begin
+ read_tfm_word;
+ if k=4 then @<Check the check sum@>;
+ if k=5 then @<Check the design size@>;
+ end;
+ end
+else begin
+ font_ofm_level:=b2*256+b3;
+ read_tfm_word; font_lh:=((b0*256+b1)*256+b2)*256+b3;
+ read_tfm_word; font_bc:=((b0*256+b1)*256+b2)*256+b3;
+ read_tfm_word; font_ec:=((b0*256+b1)*256+b2)*256+b3;
+ if font_ec<font_bc then font_bc:=font_ec+1;
+ read_tfm_word;
+ for k:=1 to 8 do begin
+ read_tfm_word;
+ end;
+ if font_ofm_level=1 then begin
+ read_tfm_word; read_tfm_word; read_tfm_word;
+ font_extra_words:=(((b0*256+b1)*256+b2)*256+b3) div 2;
+ for k:=1 to 5 do begin
+ read_tfm_word;
+ end;
+ end;
+ for k:=1 to lh do begin
+ read_tfm_word;
+ if k=1 then @<Check the check sum@>;
+ if k=2 then @<Check the design size@>;
+ end;
+ end
+
+@ @<Read |char_info| entries@>=
+case font_ofm_level of
+ -1: begin
+ for k:=font_bc to font_ec do begin
+ read_tfm_word;
+ if b0>0 then begin {character |k| exists in the font}
+ vf[vf_ptr]:=k; incr(vf_ptr);
+ if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+ end;
+ end;
+ end;
+ 0: begin
+ for k:=font_bc to font_ec do
+ begin read_tfm_word;
+ if (b0*256+b1)>0 then {character |k| exists in the font}
+ begin vf[vf_ptr]:=k; incr(vf_ptr);
+ if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+ end;
+ read_tfm_word;
+ end;
+ end;
+ 1: begin
+ k:=font_bc;
+ while k<font_ec do begin
+ read_tfm_word;
+ if (b0*256+b1)>0 then begin {character |k| exists in the font}
+ vf[vf_ptr]:=k; incr(vf_ptr);
+ if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+ end;
+ read_tfm_word; read_tfm_word;
+ font_kprime:=k+(b0*256+b1);
+ for font_j:=k+1 to font_kprime do begin
+ vf[vf_ptr]:=font_j; incr(vf_ptr);
+ if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+ end;
+ k:=font_kprime;
+ for font_j:=1 to font_extra_words do
+ read_tfm_word;
+ end
+ end;
+end;
+
+@ @<Check the check sum@>=
+if b0+b1+b2+b3>0 then
+ if(b0<>vf[font_start[font_ptr]])or@|
+ (b1<>vf[font_start[font_ptr]+1])or@|
+ (b2<>vf[font_start[font_ptr]+2])or@|
+ (b3<>vf[font_start[font_ptr]+3]) then begin
+ print_ln('Check sum in OVF file being replaced by font metric check sum');
+@.Check sum...replaced...@>
+ vf[font_start[font_ptr]]:=b0;
+ vf[font_start[font_ptr]+1]:=b1;
+ vf[font_start[font_ptr]+2]:=b2;
+ vf[font_start[font_ptr]+3]:=b3;
+ end
+
+@ @<Check the design size@>=
+if(b0<>vf[font_start[font_ptr]+8])or@|
+ (b1<>vf[font_start[font_ptr]+9])or@|
+ (b2<>vf[font_start[font_ptr]+10])or@|
+ (b3<>vf[font_start[font_ptr]+11]) then
+ begin print_ln('Design size in OVF file being replaced by font metric design size');
+@.Design size...replaced...@>
+ vf[font_start[font_ptr]+8]:=b0;
+ vf[font_start[font_ptr]+9]:=b1;
+ vf[font_start[font_ptr]+10]:=b2;
+ vf[font_start[font_ptr]+11]:=b3;
+ end
+
+@ If no font directory has been specified, \.{DVI}-reading software
+is supposed to use the default font directory, which is a
+system-dependent place where the standard fonts are kept.
+The string variable |default_directory| contains the name of this area.
+@^system dependencies@>
+
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@^system dependencies@>
+
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if a=0 then begin
+ for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_start[font_ptr]+14 to vf_ptr-1 do begin
+ incr(r);
+ if r+4>name_length then vf_abort('Font name too long for me!');
+@.Font name too long for me@>
+ if (vf[k]>="a")and(vf[k]<="z") then
+ cur_name[r]:=xchr[vf[k]-@'40]
+ else cur_name[r]:=xchr[vf[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+
+
+@ It's convenient to have a subroutine
+that reads a |k|-byte number from |vf_file|.
+
+@d get_vf(#)==if eof(vf_file) then #:=0 @+else read_vf(#)
+
+@p function vf_read(@!k:integer):integer; {actually |1<=k<=4|}
+var @!b:byte; {input byte}
+@!a:integer; {accumulator}
+begin vf_count:=vf_count+k; get_vf(b); a:=b;
+if k=4 then if b>=128 then a:=a-256; {4-byte numbers are signed}
+while k>1 do begin
+ get_vf(b);
+ a:=256*a+b; decr(k);
+ end;
+vf_read:=a;
+end;
+
+@ The \.{VF} format supports arbitrary 4-byte character codes,
+but \.{VPL} format presently does not. But \.{OVP} does.
+
+@<Read and store a character packet@>=
+begin if temp_byte=long_char then
+ begin pl:=vf_read(4); c:=vf_read(4); reg_count:=vf_read(4);
+ {|pl[4]| |cc[4]| |tfm[4]|}
+ end
+else begin pl:=temp_byte; c:=vf_read(1); reg_count:=vf_read(3);
+ {|pl[1]| |cc[1]| |tfm[3]|}
+ end;
+if nonexistent(c) then vf_abort('Character ',c:1,' does not exist!');
+@.Character c does not exist@>
+if packet_start[c]<vf_size then
+ print_ln('Discarding earlier packet for character ',c:1);
+@.Discarding earlier packet...@>
+if reg_count<>tfm_width(c) then
+ print_ln('Incorrect OFM width for character ',c:1,' in OVF file');
+@.Incorrect OFM width...@>
+if pl<0 then vf_abort('Negative packet length!');
+@.Negative packet length@>
+packet_start[c]:=vf_ptr; vf_store(pl); packet_end[c]:=vf_ptr-1;
+packet_found:=true;
+end
+
+@ The preceding code requires a simple subroutine that evaluates \.{TFM} data.
+
+@p function tfm_width(@!c:integer):integer;
+var @!a:integer; {accumulator}
+@!k:index; {index into |tfm|}
+begin k:=width(c); {we assume that character |c| exists}
+a:=tfm[k];
+if a>=128 then a:=a-256;
+tfm_width:=((256*a+tfm[k+1])*256+tfm[k+2])*256+tfm[k+3];
+end;
+
+@* Basic output subroutines.
+Let us now define some procedures that will reduce the rest of \.{VFtoVP}'s
+work to a triviality.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{VPL} file:
+
+@d out(#)==write(vpl_file,#)
+
+@ In order to stick to standard \PASCAL, we use an |xchr| array to do
+appropriate conversion of ASCII codes. Three other little strings are
+used to produce |face| codes like \.{MIE}.
+
+@<Glob...@>=
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!xchr:packed array [0..255] of char;
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+
+@ @<Set init...@>=
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/
+HEX:='0123456789ABCDEF';@/
+for k:=0 to 255 do xchr[k]:='?';
+for k:=0 to @'37 do begin
+ xchr[k+@'40]:=ASCII_04[k+1];
+ xchr[k+@'100]:=ASCII_10[k+1];
+ xchr[k+@'140]:=ASCII_14[k+1];
+ end;
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+
+@ The array |dig| will hold a sequence of digits to be output.
+
+@<Glob...@>=
+@!dig:array[0..11] of integer;
+
+@ Here, in fact, are two procedures that output
+|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
+
+@p procedure out_digs(j:integer); {outputs |j| digits}
+begin repeat decr(j); out(HEX[1+dig[j]]);
+ until j=0;
+end;
+@#
+procedure print_digs(j:integer); {prints |j| digits}
+begin repeat decr(j); print(HEX[1+dig[j]]);
+ until j=0;
+end;
+
+@ The |print_number| procedure indicates how |print_digs| can be used.
+This procedure can print in octal, decimal or hex notation.
+
+@d print_hex(#)==print_number(#,16)
+@d print_octal(#)==print_number(#,8)
+@d print_decimal(#)==print_number(#,10)
+
+@p procedure print_number(c:integer; form:integer); {prints value of |c|}
+var j:0..32; {index into |dig|}
+begin
+j:=0;
+if (c<0) then begin
+ print_ln('Internal error: print_number (negative value)');
+ c:=0;
+ end;
+if form=8 then
+ print('''') {an apostrophe indicates the octal notation}
+else if form=16 then
+ print('"') { a double apostrophe indicates the hexadecimal notation}
+else if form<>10 then begin
+ print_ln('Internal error: print_number (form)');
+ form:=16;
+ end;
+while (c>0) or (j=0) do begin
+ dig[j]:=c mod form; c:=c div form;
+ j:=j+1;
+ end;
+print_digs(j);
+end;
+
+@ A \.{VPL} file has nested parentheses, and we want to format the output
+so that its structure is clear. The |level| variable keeps track of the
+depth of nesting.
+
+@<Glob...@>=
+@!level:0..5;
+
+@ @<Set init...@>=
+level:=0;
+
+@ Three simple procedures suffice to produce the desired structure in the
+output.
+
+@p procedure out_ln; {finishes one line, indents the next}
+var l:0..5;
+begin write_ln(vpl_file);
+for l:=1 to level do out(' ');
+end;
+@#
+procedure left; {outputs a left parenthesis}
+begin incr(level); out('(');
+end;
+@#
+procedure right; {outputs a right parenthesis and finishes a line}
+begin decr(level); out(')'); out_ln;
+end;
+
+@ The value associated with a property can be output in a variety of
+ways. For example, we might want to output a {\mc BCPL} string that
+begins in |tfm[k]|:
+
+@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space}
+var l:0..39; {the number of bytes remaining}
+begin out(' '); l:=tfm[k];
+while l>0 do begin
+ incr(k); decr(l); out(xchr[tfm[k]]);
+ end;
+end;
+
+@ The property value might also be a sequence of |l| bytes, beginning
+in |tfm[k]|, that we would like to output in hex notation.
+The following procedure assumes that |l<=4|, but larger values of |l|
+could be handled easily by enlarging the |dig| array and increasing
+the upper bounds on |b| and |j|.
+
+@d out_octal_number(#)==out_number(#,8)
+@d out_decimal_number(#)==out_number(#,10)
+@d out_hex_number(#)==out_number(#,16)
+@d out_dec(#)==out_decimal_number(#)
+@d out_hex_char(#)==out_hex_number(#)
+
+@p procedure out_number(c:integer; form:integer); {outputs value of |c|}
+var j:0..32; {index into |dig|}
+begin
+j:=0;
+if (c<0) then begin
+ print_ln('Internal error: print_number (negative value)');
+ c:=0;
+ end;
+if form=8 then
+ out(' O ')
+else if form=10 then
+ out(' D ')
+else if form=16 then
+ out(' H ')
+else begin
+ print_ln('Internal error: print_number (form)');
+ form:=16;
+ out(' H ')
+ end;
+while (c>0) or (j=0) do begin
+ dig[j]:=c mod form; c:=c div form;
+ j:=j+1;
+ end;
+out_digs(j);
+end;
+@#
+procedure out_hex(@!k,@!l:index);
+ {outputs |l| bytes in hex}
+var a:0..@"7FFFFFFF; {accumulator for bits not yet output}
+@!b:0..32; {the number of significant bits in |a|}
+@!j:0..11; {the number of digits of output}
+begin
+out(' H ');
+a:=0; b:=0; j:=0;
+while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>;
+while (a>0)or(j=0) do begin
+ dig[j]:=a mod 16; a:=a div 16; incr(j);
+ end;
+out_digs(j);
+end;
+
+@ @<Reduce \(1)|l|...@>=
+begin decr(l);
+if tfm[k+l]<>0 then begin
+ while b>2 do begin
+ dig[j]:=a mod 16; a:=a div 16; b:=b-4; incr(j);
+ end;
+ case b of
+ 0: a:=tfm[k+l];
+ 1:a:=a+2*tfm[k+l];
+ 2:a:=a+4*tfm[k+l];
+ 3:a:=a+8*tfm[k+l];
+ end;
+ end;
+b:=b+8;
+end
+
+@ The property value may be a character, which is output in hex
+unless it is a letter or a digit. This procedure is the only place
+where a lowercase letter will be output to the \.{PL} file.
+@^system dependencies@>
+
+@p procedure out_char(@!c:integer); {outputs a character}
+begin if font_type>vanilla then
+ out_hex_char(c)
+else if (c>="0")and(c<="9") then
+ out(' C ',c-"0":1)
+else if (c>="A")and(c<="Z") then
+ out(' C ',ASCII_10[c-"A"+2])
+else if (c>="a")and(c<="z") then
+ out(' C ',ASCII_14[c-"a"+2])
+else out_hex_char(c);
+end;
+
+@ The property value might be a ``face'' byte, which is output in the
+curious code mentioned earlier, provided that it is less than 18.
+
+@p procedure out_face(@!k:index); {outputs a |face|}
+var s:0..1; {the slope}
+@!b:0..8; {the weight and expansion}
+begin if tfm[k]>=18 then out_hex(k,1)
+else begin
+ out(' F '); {specify face-code format}
+ s:=tfm[k] mod 2; b:=tfm[k] div 2;
+ out(MBL_string[1+(b mod 3)]);
+ out(RI_string[1+s]);
+ out(RCE_string[1+(b div 3)]);
+ end;
+end;
+
+@ And finally, the value might be a |fix_word|, which is output in
+decimal notation with just enough decimal places for \.{VPtoVF}
+to recover every bit of the given |fix_word|.
+
+All of the numbers involved in the intermediate calculations of
+this procedure will be nonnegative and less than $10\cdot2^{24}$.
+
+@p procedure out_fix(@!k:index); {outputs a |fix_word|}
+var a:0..@'7777; {accumulator for the integer part}
+@!f:integer; {accumulator for the fraction part}
+@!j:0..12; {index into |dig|}
+@!delta:integer; {amount if allowable inaccuracy}
+begin out(' R '); {specify real format}
+a:=(tfm[k]*16)+(tfm[k+1] div 16);
+f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
+if a>@'3777 then @<Reduce \(2)negative to positive@>;
+@<Output the integer part, |a|, in decimal notation@>;
+@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>;
+end;
+
+@ The following code outputs at least one digit even if |a=0|.
+
+@<Output the integer...@>=
+begin j:=0;
+repeat dig[j]:=a mod 10; a:=a div 10; incr(j);
+until a=0;
+out_digs(j);
+end
+
+@ And the following code outputs at least one digit to the right
+of the decimal point.
+
+@<Output the fraction...@>=
+begin out('.'); f:=10*f+5; delta:=10;
+repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2);
+out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10;
+until f<=delta;
+end;
+
+@ @<Reduce \(2)negative to positive@>=
+begin out('-'); a:=@'10000-a;
+if f>0 then begin
+ f:=@'4000000-f; decr(a);
+ end;
+end
+
+@* Outputting the TFM info.
+\TeX\ checks the information of a \.{TFM} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. And when it finds something wrong, it justs
+calls the file ``bad,'' without identifying the nature of the problem,
+since \.{TFM} files are supposed to be good almost all of the time.
+
+Of course, a bad file shows up every now and again, and that's where
+\.{VFtoVP} comes in. This program wants to catch at least as many errors as
+\TeX\ does, and to give informative error messages besides.
+All of the errors are corrected, so that the \.{VPL} output will
+be correct (unless, of course, the \.{TFM} file was so loused up
+that no attempt is being made to fathom it).
+
+@ Just before each character is processed, its code is printed in hex
+notation. Up to eight such codes appear on a line; so we have a variable
+to keep track of how many are currently there. We also keep track of
+whether or not any errors have had to be corrected.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+@!perfect:boolean; {was the file free of errors?}
+
+@ @<Set init...@>=
+chars_on_line:=0;@/
+perfect:=true; {innocent until proved guilty}
+
+@ Error messages are given with the help of the |bad| and |range_error|
+and |bad_char| macros:
+
+@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print_ln('Bad OFM file: ',#);
+ end
+@.Bad OFM file@>
+@d range_error(#)==begin perfect:=false; print_ln(' ');
+ print(#,' index for character ');
+ print_hex(c); print_ln(' is too large;');
+ print_ln('so I reset it to zero.');
+ end
+@d bad_char_tail(#)==print_hex(#); print_ln('.');
+ end
+@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
+ bad_char_tail
+@d correct_bad_char_tail(#)==#(k,0)
+ end
+@d correct_bad_char_middle(#)==print_hex(#(k)); print_ln('.');
+ correct_bad_char_tail
+@d correct_bad_char(#)== begin perfect:=false;
+ if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
+ correct_bad_char_middle
+
+@<Glob...@>=
+@!i:integer; {an index to words of a subfile}
+@!c:xchar_type; {a random character}
+@!d:0..3; {byte number in a word}
+@!k:index; {a random index}
+@!r:0..65535; {a random two-byte value}
+@!count:0..127; {for when we need to enumerate a small set}
+
+@ There are a lot of simple things to do, and they have to be done one
+at a time, so we might as well get down to business. The first things
+that \.{VFtoVP} will put into the \.{VPL} file appear in the header part.
+
+@<Do the header@>=
+begin
+case ofm_level of
+ 0: begin out('(OFMLEVEL H 0)'); out_ln; end;
+ 1: begin out('(OFMLEVEL H 1)'); out_ln; end;
+ end;
+if ofm_on then begin
+ left;
+ if font_dir<=7 then out('FONTDIR')
+ else out('NFONTDIR');
+ case font_dir mod 8 of
+ 0: out(' TL');
+ 1: out(' LT');
+ 2: out(' TR');
+ 3: out(' LB');
+ 4: out(' BL');
+ 5: out(' RT');
+ 6: out(' BR');
+ 7: out(' RB');
+ end;
+ right
+ end;
+font_type:=vanilla;
+if lh>=12 then begin
+ @<Set the true |font_type|@>;
+ if lh>=17 then begin
+ @<Output the family name@>;
+ if lh>=18 then @<Output the rest of the header@>;
+ end;
+ @<Output the character coding scheme@>;
+ end;
+@<Output the design size@>;
+@<Output the check sum@>;
+@<Output the |seven_bit_safe_flag|@>;
+end
+
+@ @<Output the check sum@>=
+left; out('CHECKSUM'); out_hex(check_sum,4);
+right
+
+@ Incorrect design sizes are changed to 10 points.
+
+@d bad_design(#)==begin bad('Design size ',#,'!');
+@.Design size wrong@>
+ print_ln('I''ve set it to 10 points.');
+ out(' D 10');
+ end
+
+@ @<Output the design size@>=
+left; out('DESIGNSIZE');
+if tfm[design_size]>127 then bad_design('negative')
+else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then
+ bad_design('too small')
+else out_fix(design_size);
+right;
+out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln;
+out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln
+@.DESIGNSIZE IS IN POINTS@>
+
+@ Since we have to check two different {\mc BCPL} strings for validity,
+we might as well write a subroutine to make the check.
+
+@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|}
+var j:index; {runs through the string}
+@!c:integer; {character being checked}
+begin if tfm[k]>=l then begin
+ bad('String is too long; I''ve shortened it drastically.');
+@.String is too long...@>
+ tfm[k]:=1;
+ end;
+for j:=k+1 to k+tfm[k] do begin
+ c:=tfm[j];
+ if (c="(")or(c=")") then
+ begin bad('Parenthesis in string has been changed to slash.');
+@.Parenthesis...changed to slash@>
+ tfm[j]:="/";
+ end
+ else if (c<" ")or(c>"~") then begin
+ bad('Nonstandard ASCII code has been blotted out.');
+@.Nonstandard ASCII code...@>
+ tfm[j]:="?";
+ end
+ else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters}
+ end;
+end;
+
+@ The |font_type| starts out |vanilla|; possibly we need to reset it.
+
+@<Set the true |font_type|@>=
+begin check_BCPL(scheme,40);
+if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@|
+ (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@|
+ (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@|
+ (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@|
+ (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then begin
+ if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy
+ else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex;
+ end;
+end
+
+@ @<Output the character coding scheme@>=
+left; out('CODINGSCHEME');
+out_BCPL(scheme);
+right
+
+@ @<Output the family name@>=
+left; out('FAMILY');
+check_BCPL(family,20);
+out_BCPL(family);
+right
+
+@ @<Output the rest of the header@>=
+begin left; out('FACE'); out_face(random_word+3); right;
+for i:=18 to lh-1 do begin
+ left; out('HEADER D ',i:1);
+ out_hex(check_sum+4*i,@,4); right;
+ end;
+end
+
+@ This program does not check to see if the |seven_bit_safe_flag| has the
+correct setting, i.e., if it really reflects the seven-bit-safety of
+the \.{TFM} file; the stated value is merely put into the \.{VPL} file.
+The \.{VPtoVF} program will store a correct value and give a warning
+message if a file falsely claims to be safe.
+
+@<Output the |seven_bit_safe_flag|@>=
+if (lh>17) and (tfm[random_word]>127) then begin
+ left; out('SEVENBITSAFEFLAG FALSE'); right;
+ end
+
+@ The next thing to take care of is the list of parameters.
+
+@<Do the parameters@>=
+if np>0 then begin
+ left; out('FONTDIMEN'); out_ln;
+ for i:=1 to np do @<Check and output the $i$th parameter@>;
+ right;
+ end;
+@<Check to see if |np| is complete for this font type@>;
+
+@ @<Check to see if |np|...@>=
+if (font_type=mathsy)and(np<>22) then
+ print_ln('Unusual number of fontdimen parameters for a math symbols font (',
+@.Unusual number of fontdimen...@>
+ np:1,' not 22).')
+else if (font_type=mathex)and(np<>13) then
+ print_ln('Unusual number of fontdimen parameters for an extension font (',
+ np:1,' not 13).')
+
+@ All |fix_word| values except the design size and the first parameter
+will be checked to make sure that they are less than 16.0 in magnitude,
+using the |check_fix| macro:
+
+@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;');
+ print_ln('I have set it to zero.');
+ end
+@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then
+ begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0;
+ check_fix_tail
+
+@<Check and output the $i$th parameter@>=
+begin left;
+if i=1 then out('SLANT') {this parameter is not checked}
+else begin check_fix(param(i))('Parameter');@/
+@.Parameter n is too big@>
+ @<Output the name of parameter $i$@>;
+ end;
+out_fix(param(i)); right;
+end
+
+@ @<Output the name...@>=
+if i<=7 then case i of
+ 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK');
+ 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end
+else if (i<=22)and(font_type=mathsy) then case i of
+ 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3');
+ 11:out('DENOM1');@+12:out('DENOM2');
+ 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3');
+ 16:out('SUB1');@+17:out('SUB2');
+ 18:out('SUPDROP');@+19:out('SUBDROP');
+ 20:out('DELIM1');@+21:out('DELIM2');
+ 22:out('AXISHEIGHT')@+end
+else if (i<=13)and(font_type=mathex) then
+ if i=8 then out('DEFAULTRULETHICKNESS')
+ else out('BIGOPSPACING',i-8:1)
+else out('PARAMETER D ',i:1)
+
+@ @<Glob...@>=
+@!start_counter,@!base_counter,@!number_entries:integer;
+@!value:integer;
+
+@ @<Do the ivalue parameters@>=
+if nki>0 then begin
+ start_counter:=ivalues_start*4;
+ base_counter:=ivalues_base*4;
+ for i:=0 to nki-1 do @<Check and output the $i$th ivalue table@>;
+ end;
+
+@ @<Check and output the $i$th ivalue table@>=
+begin
+left; out('FONTIVALUE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('IVALUE'); out_hex_number(j); out_ln;
+ value:=256*tfm[base_counter+2]+tfm[base_counter+3];
+ left; out('IVALUEVAL'); out_hex_number(value); right;
+ right;
+ base_counter:=base_counter+4;
+ end;
+right;
+start_counter:=start_counter+4;;
+end;
+
+@ @<Do the fvalue parameters@>=
+if nkf>0 then begin
+ start_counter:=fvalues_start*4;
+ base_counter:=fvalues_base*4;
+ for i:=0 to nkf-1 do @<Check and output the $i$th fvalue table@>;
+ end;
+
+@ @<Check and output the $i$th fvalue table@>=
+begin
+left; out('FONTFVALUE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('FVALUE'); out_hex_number(j); out_ln;
+ left; out('FVALUEVAL'); out_fix(base_counter); right;
+ right;
+ base_counter:=base_counter+4;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the mvalue parameters@>=
+if nkm>0 then begin
+ start_counter:=mvalues_start*4;
+ base_counter:=mvalues_base*4;
+ for i:=0 to nkm-1 do @<Check and output the $i$th mvalue table@>;
+ end;
+
+@ @<Check and output the $i$th mvalue table@>=
+begin
+left; out('FONTMVALUE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('MVALUE'); out_hex_number(j); out_ln;
+ left; out('MVALUEVAL'); out_fix(base_counter); right;
+ right;
+ base_counter:=base_counter+4;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the rule parameters@>=
+if nkr>0 then begin
+ start_counter:=rules_start*4;
+ base_counter:=rules_base*4;
+ for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>;
+ end;
+
+@ @<Check and output the $i$th rule table@>=
+begin
+left; out('FONTRULE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('RULE'); out_hex_number(j); out_ln;
+ left; out('RULEWD'); out_fix(base_counter); right;
+ left; out('RULEHT'); out_fix(base_counter+4); right;
+ left; out('RULEDP'); out_fix(base_counter+8); right;
+ right;
+ base_counter:=base_counter+12;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the glue parameters@>=
+if nkg>0 then begin
+ start_counter:=glues_start*4;
+ base_counter:=glues_base*4;
+ for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>;
+ end;
+
+@ @<Glob...@>=
+@!glue_subtype,@!glue_argument_kind,@!glue_stretch_order,
+@!glue_shrink_order,@!glue_argument:integer;
+
+@ @<Check and output the $i$th glue table@>=
+begin
+left; out('FONTGLUE'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('GLUE'); out_hex_number(j); out_ln;
+ glue_subtype:=tfm[base_counter] div 16;
+ glue_argument_kind:=tfm[base_counter] mod 16;
+ glue_stretch_order:=tfm[base_counter+1] div 16;
+ glue_shrink_order:=tfm[base_counter+1] mod 16;
+ glue_argument:=tfm[base_counter+2]*256+tfm[base_counter+3];
+ left;
+ out('GLUETYPE');
+ case glue_subtype of
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ end;
+ right;
+ case glue_argument_kind of
+ 1: begin
+ left; out('GLUERULE'); out_hex_number(glue_argument); right;
+ end;
+ 2: begin
+ left; out('GLUECHAR'); out_hex_number(glue_argument); right;
+ end;
+ end;
+ left;
+ out('GLUESTRETCHORDER');
+ case glue_stretch_order of
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ 4: out(' H 4');
+ end;
+ right;
+ left;
+ out('GLUESHRINKORDER');
+ case glue_shrink_order of
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ 4: out(' H 4');
+ end;
+ right;
+ left; out('GLUEWD'); out_fix(base_counter+4); right;
+ left; out('GLUESTRETCH'); out_fix(base_counter+8); right;
+ left; out('GLUESHRINK'); out_fix(base_counter+12); right;
+ right;
+ base_counter:=base_counter+16;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the penalty parameters@>=
+if nkp>0 then begin
+ start_counter:=penalties_start*4;
+ base_counter:=penalties_base*4;
+ for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>;
+ end;
+
+@ @<Check and output the $i$th penalty table@>=
+begin
+left; out('FONTPENALTY'); out_hex_number(i); out_ln;
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+ left; out('PENALTY'); out_hex_number(j); out_ln;
+ value:=256*tfm[base_counter+2]+tfm[base_counter+3];
+ left; out('PENALTYVAL'); out_hex_number(value); right;
+ right;
+ base_counter:=base_counter+4;
+ end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ We need to check the range of all the remaining |fix_word| values,
+and to make sure that |width[0]=0|, etc.
+
+@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0)
+
+@<Check the |fix_word| entries@>=
+if nonzero_fix(4*width_base) then bad('width[0] should be zero.');
+@.should be zero@>
+if nonzero_fix(4*height_base) then bad('height[0] should be zero.');
+if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.');
+if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.');
+for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width');
+@.Width n is too big@>
+for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height');
+@.Height n is too big@>
+for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth');
+@.Depth n is too big@>
+for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction');
+@.Italic correction n is too big@>
+if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
+@.Kern n is too big@>
+
+@ The ligature/kerning program comes next. Before we can put it out in
+\.{PL} format, we need to make a table of ``labels'' that will be inserted
+into the program. For each character |c| whose |tag| is |lig_tag| and
+whose starting address is |r|, we will store the pair |(c,r)| in the
+|label_table| array. If there's a boundary-char program starting at~|r|,
+we also store the pair |(256,r)|.
+This array is sorted by its second components, using the
+simple method of straight insertion.
+
+@<Glob...@>=
+@!label_table:array[xxxchar_type] of record
+@!cc:xchar_type;@!rr:0..lig_size;ischar:boolean;end;
+@!label_ptr:xxchar_type; {the largest entry in |label_table|}
+@!sort_ptr:xxchar_type; {index into |label_table|}
+@!boundary_char:xchar_type; {boundary character, or |xmax_char| if none}
+@!bchar_label:0..xmax_label; {beginning of boundary character program}
+
+@ @<Set init...@>=
+boundary_char:=xmax_char; bchar_label:=xmax_label;@/
+label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
+
+@ We'll also identify and remove inaccessible program steps, using the
+|activity| array.
+
+@d unreachable=0 {a program step not known to be reachable}
+@d pass_through=1 {a program step passed through on initialization}
+@d accessible=2 {a program step that can be relevant}
+
+@<Glob...@>=
+@!activity:array[0..lig_size] of unreachable..accessible;
+@!ai,@!acti:0..lig_size; {indices into |activity|}
+
+@ @<Do the ligatures and kerns@>=
+if nl>0 then begin
+ for ai:=0 to (nl-1) do activity[ai]:=unreachable;
+ @<Check for a boundary char@>;
+ end;
+@<Build the label table@>;
+if nl>0 then begin
+ left; out('LIGTABLE'); out_ln;@/
+ @<Compute the |activity| array@>;
+ @<Output and correct the ligature/kern program@>;
+ right;
+ @<Check for ligature cycles@>;
+ end
+
+@ We build the label table even when |nl=0|, because this catches errors
+that would not otherwise be detected.
+
+@<Build...@>=
+for c:=bc to ec do
+if (tag(c)=lig_tag) or (ctag(c)) then begin
+ r:=rremainder(c);
+ if (l_skip_byte(lig_step(r)) div 256)=0 then begin
+ if r<nl then begin
+ if l_skip_byte(lig_step(r))>stop_flag then begin
+ r:=256*l_op_byte(lig_step(r))+l_remainder(lig_step(r));
+ if r<nl then if activity[rremainder(c)]=unreachable then
+ activity[rremainder(c)]:=pass_through;
+ end;
+ end;
+ end;
+ if r>=nl then begin
+ perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for character '); print_hex(c);
+ print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c);
+ set_no_ctag(c);
+@.Ligature/kern starting index...@>
+ end
+ else @<Insert |(c,r)| into |label_table|@>;
+ end;
+label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end}
+
+@ @<Insert |(c,r)|...@>=
+begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+while label_table[sort_ptr].rr>r do begin
+ label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+label_table[sort_ptr+1].ischar:=not ctag(c);
+if ctag(c) then
+ label_table[sort_ptr+1].cc:=char_param(c,0)
+else
+ label_table[sort_ptr+1].cc:=c;
+label_table[sort_ptr+1].rr:=r; {fill the hole}
+incr(label_ptr); activity[r]:=accessible;
+end
+
+@ @<Check for a bound...@>=
+if l_skip_byte(lig_step(0))=255 then begin
+ left; out('BOUNDARYCHAR');
+ boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right;
+ activity[0]:=pass_through;
+ end;
+if l_skip_byte(lig_step(nl-1))=255 then begin
+ r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1));
+ if r>=nl then begin
+ perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for boundarychar is too large;');
+ print_ln('so I removed it.');
+@.Ligature/kern starting index...@>
+ end
+ else begin
+ label_ptr:=1; label_table[1].cc:=xmax_char;
+ label_table[1].rr:=r;
+ bchar_label:=r; activity[r]:=accessible;
+ end;
+ activity[nl-1]:=pass_through;
+ end
+
+@ @<Compute the |activity| array@>=
+for ai:=0 to (nl-1) do
+if (l_skip_byte(lig_step(ai)) div 256)=1 then
+ activity[ai]:=accessible
+else if activity[ai]=accessible then begin
+ r:=l_skip_byte(lig_step(ai));
+ if r<stop_flag then begin
+ r:=r+ai+1;
+ if r>=nl then begin
+ bad('Ligature/kern step ',ai:1,' skips too far;');
+@.Lig...skips too far@>
+ print_ln('I made it stop.'); set_l_skip_byte(lig_step(ai),stop_flag);
+ end
+ else activity[r]:=accessible;
+ end;
+ end
+
+@ We ignore |pass_through| items, which don't need to be mentioned in
+the \.{PL} file.
+
+@<Output and correct the ligature...@>=
+sort_ptr:=1; {point to the next label that will be needed}
+for acti:=0 to nl-1 do if activity[acti]<>pass_through then begin
+ i:=acti; @<Take care of commenting out unreachable steps@>;
+ @<Output any labels for step $i$@>;
+ @<Output step $i$ of the ligature/kern program@>;
+ end;
+if level=2 then right {the final step was unreachable}
+
+@ @<Globals...@>=
+@!output_clabels:array[0..256] of boolean;
+@!clabel_runner:integer;
+@!cprime:integer;
+
+@ @<Set init...@>=
+for clabel_runner:=0 to 256 do
+ output_clabels[clabel_runner]:=false;
+
+@ @<Output any labels...@>=
+while i=label_table[sort_ptr].rr do begin
+ if not label_table[sort_ptr].ischar then begin
+ if not output_clabels[label_table[sort_ptr].cc] then begin
+ output_clabels[label_table[sort_ptr].cc]:=true;
+ left;
+ out('CLABEL');
+ out_char(label_table[sort_ptr].cc);
+ right;
+ end
+ end
+ else begin
+ left;
+ out('LABEL');
+ if label_table[sort_ptr].cc=xmax_char then out(' BOUNDARYCHAR')
+ else out_char(label_table[sort_ptr].cc);
+ right;
+ end;
+ incr(sort_ptr);
+ end
+
+@ @<Take care of commenting out...@>=
+if activity[i]=unreachable then begin
+ if level=1 then begin
+ left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
+ end
+ end
+else if level=2 then right
+
+@ @<Output step $i$...@>=
+begin k:=lig_step(i);
+if (l_skip_byte(k) div 256)=1 then begin
+ case l_op_byte(k) of
+ 17: begin
+ left; out('CPEN');
+ out_hex_number(l_next_char(k));
+ out_hex_number(l_remainder(k));
+ right;
+ end;
+ 18: begin
+ left; out('CGLUE');
+ out_hex_number(l_next_char(k));
+ out_hex_number(l_remainder(k));
+ right;
+ end;
+ 19: begin
+ left; out('CPENGLUE');
+ out_hex_number(l_next_char(k));
+ out_hex_number(l_remainder(k) div 256);
+ out_hex_number(l_remainder(k) mod 256);
+ right;
+ end;
+ 20: begin
+ left; out('CKRN');
+ out_hex_number(l_next_char(k));
+ r:=l_remainder(k);
+ if r>=nk then begin
+ bad('Kern index too large.');
+@.Kern index too large@>
+ out(' R 0.0');
+ end
+ else out_fix(kern(r));
+ right;
+ end;
+ end;
+ end
+else if l_skip_byte(k)>stop_flag then begin
+ if (256*l_op_byte(k)+l_remainder(k))>=nl then
+ bad('Ligature unconditional stop command address is too big.');
+@.Ligature unconditional stop...@>
+ end
+else if l_op_byte(k)>=kern_flag then @<Output a kern step@>
+else @<Output a ligature step@>;
+if (l_skip_byte(k) mod 256)>0 then
+ if level=1 then @<Output either \.{SKIP} or \.{STOP}@>;
+end
+
+@ The \.{SKIP} command is a bit tricky, because we will be omitting all
+inaccessible commands.
+
+@<Output either...@>=
+begin if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)')
+else begin
+ count:=0;
+ for ai:=(i+1) to (i+(l_skip_byte(k) mod 256)) do
+ if activity[ai]=accessible then incr(count);
+ out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares}
+ end;
+out_ln;
+end
+
+@ @<Output a kern step@>=
+begin if nonexistent(l_next_char(k)) then
+ if l_next_char(k)<>boundary_char then
+ correct_bad_char('Kern step for')(l_next_char)(set_l_next_char);
+@.Kern step for nonexistent...@>
+left; out('KRN'); out_char(l_next_char(k));
+r:=256*(l_op_byte(k)-kern_flag)+l_remainder(k);
+if r>=nk then begin
+ bad('Kern index too large.');
+@.Kern index too large@>
+ out(' R 0.0');
+ end
+else out_fix(kern(r));
+right;
+end
+
+@ @<Output a ligature step@>=
+begin if nonexistent(l_next_char(k)) then
+ if l_next_char(k)<>boundary_char then
+ correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char);
+@.Ligature step for nonexistent...@>
+if nonexistent(l_remainder(k)) then
+correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder);
+@.Ligature step produces...@>
+left; r:=l_op_byte(k);
+if (r=4)or((r>7)and(r<>11)) then begin
+ print_ln('Ligature step with nonstandard code changed to LIG');
+ r:=0; set_l_op_byte(k,0);
+ end;
+if r mod 4>1 then out('/');
+out('LIG');
+if odd(r) then out('/');
+while r>3 do begin
+ out('>'); r:=r-4;
+ end;
+out_char(l_next_char(k)); out_char(l_remainder(k)); right;
+end
+
+@ The last thing on \.{VFtoVP}'s agenda is to go through the
+list of |char_info| and spew out the information about each individual
+character.
+
+@<Do the characters@>=
+sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments}
+c:=bc;
+while (c<=ec) do begin
+ if width_index(c)>0 then begin
+ if chars_on_line=8 then begin
+ print_ln(' '); chars_on_line:=1;
+ end
+ else begin
+ if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+ for cprime:=c to (c+no_repeats(c)) do begin
+ print_hex(cprime); {progress report}
+ left; out('CHARACTER'); out_char(cprime); out_ln;
+ @<Output the character's width@>;
+ if height_index(c)>0 then @<Output the character's height@>;
+ if depth_index(c)>0 then @<Output the character's depth@>;
+ if italic_index(c)>0 then @<Output the italic correction@>;
+ case tag(c) of
+ no_tag: do_nothing;
+ lig_tag: @<Output the applicable part of the ligature/kern
+ program as a comment@>;
+ list_tag: @<Output the character link unless there is a problem@>;
+ ext_tag: @<Output an extensible character recipe@>;
+ end; {there are no other cases}
+ for i:=0 to npc-1 do begin
+ if char_param(c,i)<>0 then begin
+ left;
+ if i<nki then begin
+ out('CHARIVALUE'); out_hex_number(i);
+ end
+ else if i<(nki+nkf) then begin
+ out('CHARFVALUE'); out_hex_number(i-nki);
+ end
+ else if i<(nki+nkf+nkr) then begin
+ out('CHARRULE'); out_hex_number(i-nki-nkf);
+ end
+ else if i<(nki+nkf+nkr+nkg) then begin
+ out('CHARGLUE'); out_hex_number(i-nki-nkf-nkr);
+ end
+ else if i<(nki+nkf+nkr+nkg+nkp) then begin
+ out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkr-nkg);
+ end;
+ out_hex_number(char_param(c,i));
+ right;
+ end;
+ end;
+ if not do_map(cprime) then goto final_end;
+ right;
+ end;
+ end;
+ c:=c+1+no_repeats(c);
+ end
+
+@ @<Output the character's width@>=
+if width_index(c)>=nw then range_error('Width')
+@.Width index for char...@>
+else begin left; out('CHARWD'); out_fix(width(c)); right;
+ end
+
+@ @<Output the character's height@>=
+if height_index(c)>=nh then range_error('Height')
+@.Height index for char...@>
+else begin left; out('CHARHT'); out_fix(height(c)); right;
+ end
+
+@ @<Output the character's depth@>=
+if depth_index(c)>=nd then range_error('Depth')
+@.Depth index for char@>
+else begin left; out('CHARDP'); out_fix(depth(c)); right;
+ end
+
+@ @<Output the italic correction@>=
+if italic_index(c)>=ni then range_error('Italic correction')
+@.Italic correction index for char...@>
+else begin left; out('CHARIC'); out_fix(italic(c)); right;
+ end
+
+@ @<Output the applicable part of the ligature...@>=
+begin left; out('COMMENT'); out_ln;@/
+i:=rremainder(c); r:=lig_step(i);
+if (l_skip_byte(r) mod 256)>stop_flag
+then i:=256*l_op_byte(r)+l_remainder(r);
+repeat @<Output step...@>;
+if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl
+else i:=i+1+(l_skip_byte(k) mod 256);
+until i>=nl;
+right;
+end
+
+@ We want to make sure that there is no cycle of characters linked together
+by |list_tag| entries, since such a cycle would get \TeX\ into an endless
+loop. If such a cycle exists, the routine here detects it when processing
+the largest character code in the cycle.
+
+@<Output the character link unless there is a problem@>=
+begin r:=rremainder(c);
+if nonexistent(r) then begin
+ bad_char('Character list link to')(r); set_no_tag(c);
+@.Character list link...@>
+ end
+else begin
+ while (r<c)and(tag(r)=list_tag) do r:=rremainder(r);
+ if r=c then begin
+ bad('Cycle in a character list!');
+@.Cycle in a character list@>
+ print('Character '); print_hex(c);
+ print_ln(' now ends the list.');
+ set_no_tag(c);
+ end
+ else begin
+ left; out('NEXTLARGER'); out_char(rremainder(c));
+ right;
+ end;
+ end;
+end
+
+@ @<Output an extensible character recipe@>=
+if rremainder(c)>=ne then begin
+ range_error('Extensible'); set_no_tag(c);
+@.Extensible index for char@>
+ end
+else begin
+ left; out('VARCHAR'); out_ln;
+ @<Output the extensible pieces that exist@>;
+ right;
+ end
+
+@ @<Glob...@>=
+@!exten_char:integer;
+
+@ @<Output the extensible pieces that...@>=
+for d:=0 to 3 do begin
+ if not ofm_on then begin
+ k:=exten(c)+d;
+ exten_char:=tfm[k];
+ end
+ else begin
+ k:=exten(c)+2*d;
+ exten_char:=256*tfm[k]+tfm[k+1];
+ end;
+ if (d=3)or(exten_char>0) then begin
+ left;
+ case d of
+ 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
+ if nonexistent(exten_char) then out_char(c)
+ else out_char(exten_char);
+ right;
+ end
+ end
+
+@ Some of the extensible recipes may not actually be used, but \TeX\ will
+complain about them anyway if they refer to nonexistent characters.
+Therefore \.{VFtoVP} must check them too.
+
+@<Check the extensible recipes@>=
+if ne>0 then
+ for c:=0 to ne-1 do
+ for d:=0 to 3 do begin
+ if not ofm_on then begin
+ k:=4*(exten_base+c)+d;
+ exten_char:=tfm[k];
+ end
+ else begin
+ k:=4*(exten_base+c)+2*d;
+ exten_char:=256*tfm[k]+tfm[k+1];
+ end;
+ if (exten_char>0)or(d=3) then begin
+ if nonexistent(exten_char) then begin
+ bad_char('Extensible recipe involves the')(exten_char);
+@.Extensible recipe involves...@>
+ if d<3 then begin
+ if not ofm_on then begin
+ tfm[k]:=0;
+ end
+ else begin
+ tfm[k]:=0;
+ tfm[k+1]:=0;
+ end;
+ end;
+ end;
+ end;
+ end
+
+@* Checking for ligature loops.
+We have programmed almost everything but the most interesting calculation of
+all, which has been saved for last as a special treat. \TeX's extended
+ligature mechanism allows unwary users to specify sequences of ligature
+replacements that never terminate. For example, the pair of commands
+$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$
+alternately replaces character $x$ by character $y$ and vice versa. A similar
+loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and
+ \.{(LIG/ $z$ $x$)} occurs in the program for $y$.
+
+More complicated loops are also possible. For example, suppose the ligature
+programs for $x$ and $y$ are
+$$\vcenter{\halign{#\hfil\cr
+\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr
+\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$
+then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$,
+\dots, ad infinitum.
+
+@ To detect such loops, \.{TFtoPL} attempts to evaluate the function
+$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as
+follows: If the current character is $x$ and the next character is
+$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor
+first moves past $y$, the character immediately to its left is
+$f(x,y)$. This function is defined if and only if no infinite loop is
+generated when the cursor is between $x$ and~$y$.
+
+The function $f(x,y)$ can be defined recursively. It turns out that all pairs
+$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$;
+this happens if there's no ligature between $x$ and $y$, or in the cases
+\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a
+\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$;
+then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to
+either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted
+ligature character.
+
+The first two of these classes can be merged; we can also consider
+$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated.
+For technical reasons we allow $x$ to be 256 (for the boundary character
+at the left) or 257 (in cases when an error has been detected).
+
+For each pair $(x,y)$ having a ligature program step, we store
+$(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+@<Glob...@>=
+@!hash:array[0..hash_size] of integer;
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of xxchar_type;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size;
+ {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!x_lig_cycle,@!y_lig_cycle:xchar_type; {problematic ligature pair}
+
+@ @<Check for ligature cycles@>=
+hash_ptr:=0; y_lig_cycle:=xmax_char;
+for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table}
+for c:=bc to ec do if tag(c)=lig_tag then begin
+ i:=rremainder(c);
+ if (l_skip_byte(lig_step(i)) mod 256)>stop_flag then
+ i:=256*l_op_byte(lig_step(i))+l_remainder(lig_step(i));
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if bchar_label<nl then begin
+ c:=xmax_char; i:=bchar_label;
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if hash_ptr=hash_size then begin
+ print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ goto final_end;
+ end;
+for hh:=1 to hash_ptr do begin
+ r:=hash_list[hh];
+ if class[r]>simple then {make sure $f$ is defined}
+ r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
+ end;
+if y_lig_cycle<xmax_char then begin
+ print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=xmax_char
+ then print('boundary')@+else print_hex(x_lig_cycle);
+ print(' and '); print_hex(y_lig_cycle); print_ln('!');
+ out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
+ end
+
+@ @<Enter data for character $c$...@>=
+repeat hash_input; k:=l_skip_byte(lig_step(i));
+if k>=stop_flag then i:=nl
+else i:=i+1+k;
+until i>=nl
+
+@ We use an ``ordered hash table'' with linear probing, because such a table
+is efficient when the lookup of a random key tends to be unsuccessful.
+
+@p procedure hash_input; {enter data for character |c| and command |i|}
+label 30; {go here for a quick exit}
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:char_type; {function value or ligature character being entered}
+@!y:char_type; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then goto 30;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
+while hash[h]>0 do begin
+ if hash[h]<=key then begin
+ if hash[h]=key then goto 30; {unused ligature command}
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+30:end;
+
+@ We must store kern commands as well as ligature commands, because
+the former might make the latter inapplicable.
+
+@<Compute the command param...@>=
+k:=lig_step(i); y:=l_next_char(k); t:=l_op_byte(k);
+cc:=simple; zz:=l_remainder(k);
+if t>=kern_flag then zz:=y
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures.
+Kind of a neat algorithm, generalizing a depth-first search.
+
+@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:index):index| here.
+
+@p function f;
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
+ lig_z[h]:=xxmax_char; class[h]:=simple;
+ end; {the value |xxmax_char| will break all cycles,
+ since it's not in |hash|}
+end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@* Outputting the VF info.
+The routines we've used for output from the |tfm| array have counterparts
+for output from |vf|. One difference is that the string outputs from |vf|
+need to be checked for balanced parentheses. The |string_balance| routine
+tests the string of length~|l| that starts at location~|k|.
+
+@p function string_balance(@!k,@!l:integer):boolean;
+label not_found,exit;
+var @!j,@!bal:integer;
+begin if l>0 then if vf[k]=" " then goto not_found;
+ {a leading blank is considered unbalanced}
+bal:=0;
+for j:=k to k+l-1 do begin
+ if (vf[j]<" ")or(vf[j]>=127) then goto not_found;
+ if vf[j]="(" then incr(bal)
+ else if vf[j]=")" then
+ if bal=0 then goto not_found else decr(bal);
+ end;
+if bal>0 then goto not_found;
+string_balance:=true; return;
+not_found:string_balance:=false;
+exit:end;
+
+@ @d bad_vf(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print_ln('Bad OVF file: ',#);
+ end
+@.Bad OVF file@>
+
+@<Do the virtual font title@>=
+if string_balance(0,font_start[0]) then begin
+ left; out('VTITLE ');
+ for k:=0 to font_start[0]-1 do out(xchr[vf[k]]);
+ right;
+ end
+else bad_vf('Title is not a balanced ASCII string')
+@.Title is not balanced@>
+
+@ We can re-use some code by moving |fix_word| data to |tfm|, using the
+fact that the design size has already been output.
+
+@p procedure out_as_fix(@!x:integer);
+var @!k:1..3;
+begin if abs(x)>=@'100000000 then
+ bad_vf('Oversize dimension has been reset to zero.');
+@.Oversize dimension...@>
+if x>=0 then tfm[design_size]:=0
+else begin
+ tfm[design_size]:=255; x:=x+@'100000000;
+ end;
+for k:=3 downto 1 do begin
+ tfm[design_size+k]:=x mod 256; x:=x div 256;
+ end;
+out_fix(design_size);
+end;
+
+@ @<Do the local fonts@>=
+for f:=0 to font_ptr-1 do begin
+ left; out('MAPFONT D ',f:1); out_ln;
+ @<Output the font area and name@>;
+ for k:=0 to 11 do tfm[k]:=vf[font_start[f]+k];
+ if tfm[0]+tfm[1]+tfm[2]+tfm[3]>0 then begin
+ left; out('FONTCHECKSUM'); out_hex(0,4); right;
+ end;
+ left; out('FONTAT'); out_fix(4); right;
+ left; out('FONTDSIZE'); out_fix(8); right; right;
+ end
+
+@ @<Output the font area and name@>=
+a:=vf[font_start[f]+12]; l:=vf[font_start[f]+13];
+if a>0 then
+ if not string_balance(font_start[f]+14,a) then
+ bad_vf('Improper font area will be ignored')
+@.Improper font area@>
+ else begin
+ left; out('FONTAREA ');
+ for k:=font_start[f]+14 to font_start[f]+a+13 do out(xchr[vf[k]]);
+ right;
+ end;
+if (l=0)or not string_balance(font_start[f]+14+a,l) then
+ bad_vf('Improper font name will be ignored')
+@.Improper font name@>
+else begin
+ left; out('FONTNAME ');
+ for k:=font_start[f]+14+a to font_start[f]+a+l+13 do out(xchr[vf[k]]);
+ right;
+ end
+
+@ Now we get to the interesting part of \.{VF} output, where \.{DVI}
+commands are translated into symbolic form. The \.{VPL} language is a subset
+of \.{DVI}, so we sometimes need to output semantic equivalents of
+the commands instead of producing a literal translation. This causes a
+small but tolerable loss of efficiency. We need to simulate the stack
+used by \.{DVI}-reading software.
+
+@<Glob...@>=
+@!top:0..max_stack; {\.{DVI} stack pointer}
+@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of integer;
+ {stacked values of \.{DVI} registers |w|, |x|, |y|, |z|}
+@!vf_limit:0..vf_size; {the current packet ends here}
+@!o:byte; {the current opcode}
+
+@ @<Do the packet for character |c|@>=
+if packet_start[c]=vf_size then
+ bad_vf('Missing packet for character ',c:1)
+@.Missing packet@>
+else begin
+ left; out('MAP'); out_ln;
+ top:=0; wstack[0]:=0; xstack[0]:=0; ystack[0]:=0; zstack[0]:=0;
+ vf_ptr:=packet_start[c]; vf_limit:=packet_end[c]+1; f:=0;
+ while vf_ptr<vf_limit do begin
+ o:=vf[vf_ptr]; incr(vf_ptr);
+ case o of
+ @<Cases of \.{DVI} instructions that can appear in character packets@>@;
+ improper_DVI_for_VF: bad_vf('Illegal DVI code ',o:1,' will be ignored');
+ end; {there are no other cases}
+ end;
+ if top>0 then begin
+ bad_vf('More pushes than pops!');
+@.More pushes than pops@>
+ repeat out('(POP)'); decr(top);@+until top=0;
+ end;
+ right;
+ end
+
+@ A procedure called |get_bytes| helps fetch the parameters of \.{DVI} commands.
+
+@p function get_bytes(@!k:integer;@!signed:boolean):integer;
+var @!a:integer; {accumulator}
+begin if vf_ptr+k>vf_limit then begin
+ bad_vf('Packet ended prematurely'); k:=vf_limit-vf_ptr;
+ end;
+a:=vf[vf_ptr];
+if (k=4) or signed then
+ if a>=128 then a:=a-256;
+incr(vf_ptr);
+while k>1 do begin
+ a:=a*256+vf[vf_ptr]; incr(vf_ptr); decr(k);
+ end;
+get_bytes:=a;
+end;
+
+@ Let's look at the simplest cases first, in order to get some experience.
+
+@d four_cases(#)==#,#+1,#+2,#+3
+@d eight_cases(#)==four_cases(#),four_cases(#+4)
+@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
+@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
+@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
+
+@<Cases...@>=
+nop:do_nothing;
+push:begin if top=max_stack then
+ begin print_ln('Stack overflow!'); goto final_end;
+@.Stack overflow@>
+ end;
+ incr(top); wstack[top]:=wstack[top-1]; xstack[top]:=xstack[top-1];
+ ystack[top]:=ystack[top-1]; zstack[top]:=zstack[top-1]; out('(PUSH)');
+ out_ln;
+ end;
+pop:if top=0 then bad_vf('More pops than pushes!')
+@.More pops than pushes@>
+ else begin decr(top); out('(POP)'); out_ln;
+ end;
+set_rule,put_rule:begin if o=put_rule then out('(PUSH)');
+ left; out('SETRULE'); out_as_fix(get_bytes(4,true));
+ out_as_fix(get_bytes(4,true));
+ if o=put_rule then out(')(POP');
+ right;
+ end;
+
+@ Horizontal and vertical motions become \.{RIGHT} and \.{DOWN} in \.{VPL}
+lingo.
+
+@<Cases...@>=
+four_cases(right1):begin out('(MOVERIGHT');
+ out_as_fix(get_bytes(o-right1+1,true));
+ out(')'); out_ln;@+end;
+w0,four_cases(w1):begin if o<>w0 then wstack[top]:=get_bytes(o-w1+1,true);
+ out('(MOVERIGHT'); out_as_fix(wstack[top]); out(')'); out_ln;@+end;
+x0,four_cases(x1):begin if o<>x0 then xstack[top]:=get_bytes(o-x1+1,true);
+ out('(MOVERIGHT'); out_as_fix(xstack[top]); out(')'); out_ln;@+end;
+four_cases(down1):begin out('(MOVEDOWN'); out_as_fix(get_bytes(o-down1+1,true));
+ out(')'); out_ln;@+end;
+y0,four_cases(y1):begin if o<>y0 then ystack[top]:=get_bytes(o-y1+1,true);
+ out('(MOVEDOWN'); out_as_fix(ystack[top]); out(')'); out_ln;@+end;
+z0,four_cases(z1):begin if o<>z0 then zstack[top]:=get_bytes(o-z1+1,true);
+ out('(MOVEDOWN'); out_as_fix(zstack[top]); out(')'); out_ln;@+end;
+
+@ Variable |f| always refers to the current font. If |f=font_ptr|, it's
+a font that hasn't been defined (so its characters will be ignored).
+
+@<Cases...@>=
+sixty_four_cases(fnt_num_0),four_cases(fnt1):begin f:=0;
+ if o>=fnt1 then font_number[font_ptr]:=get_bytes(o-fnt1+1,false)
+ else font_number[font_ptr]:=o-fnt_num_0;
+ while font_number[f]<>font_number[font_ptr] do incr(f);
+ if f=font_ptr then bad_vf('Undeclared font selected')
+@.Undeclared font selected@>
+ else begin out('(SELECTFONT D ',f:1,')'); out_ln;
+ end;
+ end;
+
+@ Before we typeset a character we make sure that it exists.
+
+@<Cases...@>=
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
+ four_cases(set1),four_cases(put1):begin if o>=set1 then
+ if o>=put1 then c:=get_bytes(o-put1+1,false)
+ else c:=get_bytes(o-set1+1,false)
+ else c:=o;
+ if f=font_ptr then
+ bad_vf('Character ',c:1,' in undeclared font will be ignored')
+@.Character...will be ignored@>
+ else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+ k:=font_chars[f];@+while vf[k]<>c do incr(k);
+ if k=font_start[f+1]-1 then
+ bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
+ else begin if o>=put1 then out('(PUSH)');
+ left; out('SETCHAR'); out_char(c);
+ if o>=put1 then out(')(POP');
+ right;
+ end;
+ end;
+ end;
+
+@ The ``special'' commands are the only ones remaining to be dealt with.
+We use a hexadecimal
+output in the general case, if a simple string would be inadequate.
+
+@d vf_out_hex(#)==begin a:=#;
+ if a<10 then out(a:1)
+ else out(xchr[a-10+"A"]);
+ end
+
+@<Cases...@>=
+four_cases(xxx1):begin k:=get_bytes(o-xxx1+1,false);
+ if k<0 then bad_vf('String of negative length!')
+ else begin left;
+ if k+vf_ptr>vf_limit then
+ begin bad_vf('Special command truncated to packet length');
+ k:=vf_limit-vf_ptr;
+ end;
+ if (k>64)or not string_balance(vf_ptr,k) then
+ begin out('SPECIALHEX ');
+ while k>0 do
+ begin if k mod 32=0 then out_ln
+ else if k mod 4=0 then out(' ');
+ vf_out_hex(vf[vf_ptr] div 16); vf_out_hex(vf[vf_ptr] mod 16);
+ incr(vf_ptr); decr(k);
+ end;
+ end
+ else begin out('SPECIAL ');
+ while k>0 do
+ begin out(xchr[vf[vf_ptr]]); incr(vf_ptr); decr(k);
+ end;
+ end;
+ right;
+ end;
+ end;
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+First come the |vf_input| and |organize| procedures, which read the input data
+and get ready for subsequent events. If something goes wrong, the routines
+return |false|.
+
+@p function vf_input:boolean;
+label final_end, exit;
+var vf_ptr:0..vf_size; {an index into |vf|}
+@!k:integer; {all-purpose index}
+@!c:integer; {character code}
+begin @<Read the whole \.{VF} file@>;
+vf_input:=true; return;
+final_end: vf_input:=false;
+exit: end;
+@#
+function organize:boolean;
+label final_end, exit;
+var tfm_ptr:index; {an index into |tfm|}
+begin @<Read the whole font metric file@>;
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;
+@<Compute the base addresses@>;
+organize:=vf_input; return;
+final_end: organize:=false;
+exit: end;
+
+@ Next we do the simple things.
+
+@p procedure do_simple_things;
+var i:0..@'77777; {an index to words of a subfile}
+@!f:0..vf_size; {local font number}
+@!k:integer; {all-purpose index}
+begin @<Do the virtual font title@>;
+@<Do the header@>;
+@<Do the parameters@>;
+@<Do the ivalue parameters@>;@/
+@<Do the fvalue parameters@>;@/
+@<Do the rule parameters@>;@/
+@<Do the glue parameters@>;@/
+@<Do the penalty parameters@>;@/
+@<Do the local fonts@>;
+@<Check the |fix_word| entries@>;
+end;
+
+@ And then there's a routine for individual characters.
+
+@p function do_map(@!c:integer):boolean;
+label final_end,exit;
+var @!k:integer;
+@!f:0..vf_size; {current font number}
+begin @<Do the packet for character |c|@>;
+do_map:=true; return;
+final_end: do_map:=false;
+exit:end;
+@#
+function do_characters:boolean;
+label final_end, exit;
+var @!c:integer; {character being done}
+@!k:index; {a random index}
+@!ai:0..lig_size; {index into |activity|}
+begin @<Do the characters@>;@/
+do_characters:=true; return;
+final_end: do_characters:=false;
+exit:end;
+
+@ Here is where \.{VFtoVP} begins and ends.
+@p begin initialize;@/
+if not organize then goto final_end;
+do_simple_things;@/
+@<Do the ligatures and kerns@>;
+@<Check the extensible recipes@>;
+if not do_characters then goto final_end;
+print_ln('.');@/
+if level<>0 then print_ln('This program isn''t working!');
+@.This program isn't working@>
+if not perfect then begin
+ out('(COMMENT THE OFM AND/OR OVF FILE WAS BAD, ');
+ out('SO THE DATA HAS BEEN CHANGED!)');
+ end;
+@.THE OFM AND/OR OVF FILE WAS BAD...@>
+final_end:end.
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{VFtoVP} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.ch b/Build/source/texk/web2c/omegaware/ovp2ovf.ch
new file mode 100644
index 00000000000..c105f60ceb0
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/ovp2ovf.ch
@@ -0,0 +1,320 @@
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original vptovf.ch.
+%
+% vptovf.ch for C compilation with web2c.
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+%\let\maybe=\iffalse
+%\def\title{OVP2OVF changes for C}
+@z
+
+@x [2] Print the banner later.
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+@z
+
+@x [3] Increase constants.
+@!buf_size=60; {length of lines displayed in error messages}
+@y
+@!buf_size=3000; {max input line length, output error line length}
+@z
+%@x
+%@!vf_size=10000; {maximum length of |vf| data, in bytes}
+%@!max_stack=100; {maximum depth of simulated \.{DVI} stack}
+%@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed}
+%@!max_lig_steps=5000;
+% {maximum length of ligature program, must be at most $32767-257=32510$}
+%@!max_kerns=500; {the maximum number of distinct kern values}
+%@!hash_size=5003; {preferably a prime number, a bit larger than the number
+% of character pairs in lig/kern steps}
+%@y
+%@!vf_size=50000; {maximum length of |vf| data, in bytes}
+%@!max_stack=100; {maximum depth of simulated \.{DVI} stack}
+%@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed}
+%@!max_lig_steps=10000;
+% {maximum length of ligature program, must be at most $32767-257=32510$}
+%@!max_kerns=10000; {the maximum number of distinct kern values}
+%@!hash_size=10007; {preferably a prime number, a bit larger than the number
+% of character pairs in lig/kern steps}
+%@z
+
+@x [6] Open VPL file.
+reset(vpl_file);
+@y
+reset (vpl_file, vpl_name);
+if verbose then begin
+ print (banner);
+ print_ln (banner);
+end;
+@z
+
+@x [22] Open output files.
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(vf_file); rewrite(tfm_file);
+@y
+@ On some systems you may have to do something special to write a
+packed file of bytes.
+@^system dependencies@>
+
+@<Set init...@>=
+rewritebin (vf_file, vf_name);
+rewritebin (tfm_file, tfm_name);
+@z
+
+% [89] `index' is not a good choice for an identifier on Unix systems.
+% Neither is `class', on AIX.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+|k|th element of its list.
+@y
+|k|th element of its list.
+
+@d index == index_var
+@d class == class_var
+@z
+
+@x [118] No output unless verbose.
+@<Print |c| in hex notation@>;
+@y
+if verbose then @<Print |c| in hex notation@>;
+@z
+
+@x
+@!HEX: packed array [1..32] of char;
+@y
+@!HEX: c_string;
+@z
+
+@x
+HEX:='0123456789ABCDEF';@/
+@y
+HEX:=' 0123456789ABCDEF';@/
+@z
+
+@x [144] Output of real numbers.
+@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
+@.I had to round...@>
+ #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
+@y
+@ @d round_message(#)==if delta>0 then begin print('I had to round some ',
+@.I had to round...@>
+ #,'s by '); print_real((((delta+1) div 2)/@'4000000),1,7);
+ print_ln(' units.'); end
+@z
+
+@x [152] Fix up the mutually recursive procedures a la pltotf.
+@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+@y
+@p
+ifdef('notdef')
+function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+endif('notdef')
+@z
+
+@x [153] Finish fixing up f.
+@p function f;
+@y
+@p function f(@!h,@!x,@!y:indx):indx;
+@z
+
+@x [156] Change TFM-byte output to fix ranges.
+@d out(#)==write(tfm_file,#)
+@y
+@d out(#)==putbyte(#,tfm_file)
+@z
+
+@x [165] Fix output of reals.
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if abs(x/design_units)>=16.0 then begin
+ print_ln('The relative dimension ',x/@'4000000:1:3,
+ ' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then print(' =',design_units/@'200000:1:3,
+ ' designunits');
+@y
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if fabs(x/design_units)>=16.0 then begin
+ print('The relative dimension ');
+ print_real(x/@'4000000,1,3);
+ print_ln(' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then begin print(' =');
+ print_real(design_units/@'200000,1,3);
+ print(' designunits');
+ end;
+@z
+
+% [141] char_remainder[c] is unsigned, and label_table[sort_ptr].rr
+% might be -1, and if -1 is coerced to being unsigned, it will be bigger
+% than anything else.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ while label_table[sort_ptr].rr>char_remainder[c] do begin
+@y
+ while label_table[sort_ptr].rr>intcast(char_remainder[c]) do begin
+@z
+
+@x [175] Change VF-byte output to fix ranges.
+@d vout(#)==write(vf_file,#)
+@y
+@d vout(#)==putbyte(#,vf_file)
+@z
+
+@x [181] Be quiet unless verbose.
+read_input; print_ln('.');@/
+@y
+read_input;
+if verbose then print_ln('.');
+@z
+
+@x [182] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{VPtoVF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 3; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('ovp2ovf'); {|getopt| has already given an error message.}
+
+ end else if argument_is ('help') then begin
+ usage_help (OVP2OVF_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit
+ (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one to three remaining arguments.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc)
+ and (optind + 3 <> argc) then begin
+ write_ln (stderr, 'ovp2ovf: Need one to three file arguments.');
+ usage ('ovp2ovf');
+ end;
+
+ vpl_name := extend_filename (cmdline (optind), 'ovp');
+
+ if optind + 2 <= argc then begin
+ {Specified one or both of the output files.}
+ vf_name := extend_filename (cmdline (optind + 1), 'ovf');
+ if optind + 3 <= argc then begin {Both.}
+ tfm_name := extend_filename (cmdline (optind + 2), 'ofm');
+ end else begin {Just one.}
+ tfm_name := extend_filename (cmdline (optind + 1), 'ofm');
+ end;
+ end else begin {Neither.}
+ vf_name := basename_change_suffix (vpl_name, '.ovp', '.ovf');
+ tfm_name := basename_change_suffix (vpl_name, '.ovp', '.ofm');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+@.-verbose@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@ The global variable |verbose| determines whether or not we print
+progress information.
+
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@ It starts off |false|.
+
+@<Initialize the option...@> =
+verbose := false;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!vpl_name, @!tfm_name, @!vf_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.web b/Build/source/texk/web2c/omegaware/ovp2ovf.web
new file mode 100644
index 00000000000..0b6a6a329a7
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/ovp2ovf.web
@@ -0,0 +1,5071 @@
+%
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+% applies only to the changes to the original vptovf.web.
+%
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was implemented in December 1989.
+% Version 1.1 fixed some for-loop indices for stricter Pascal (April 1990).
+% Version 1.2 fixed `nonexistent char 0' bug, and a bit more (September 1990).
+% Version 1.3 has more robust `out_scaled' (March 1991).
+% Version 1.4 (March 1995) initialized lk_step_ended (Armin K\"ollner).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=logo10 % for the METAFONT logo
+\def\MF{{\logo METAFONT}}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{OVP2OVF}
+\def\contentspagenumber{201}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont OVP2OVF} processor}
+ \vskip 15pt
+ \centerline{(Version 1.11, February 2000)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this program
+ was supported in part by the National Science
+ Foundation and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{OVP2OVF} utility program converts virtual-property-list (``\.{VPL}''
+and ``\.{OVP}'') files into an equivalent pair of files called a virtual
+font (``\.{OVF}'') file and an $\Omega$ font metric (``\.{OFM}'') file.
+It also makes a thorough check of the given \.{VPL} or \.{OVP} file,
+so that the \.{OVF} file should be acceptable to device drivers and
+the \.{OFM} file should be acceptable to $\Omega$.
+
+In the following documentation, all unchanged references to
+the \.{VPtoVF} program and to \.{VPL}, \.{VF} and \.{TFM} files also apply to
+the \.{OVP2OVF} program and to \.{OVP}, \.{OVF} and \.{OFM} files.
+
+\indent\.{VPtoVF} is an extended version of the program \.{PLtoTF}, which
+is part of the standard \TeX ware library.
+\.{OVP2OVF} is an extended version of \.{VPtoVF} that allows
+much larger fonts.
+The idea of a virtual font was inspired by the work of David R. Fuchs
+@^Fuchs, David Raymond@>
+who designed a similar set of conventions in 1984 while developing a
+device driver for ArborText, Inc. He wrote a somewhat similar program
+called \.{PLFONT}.
+
+The |banner| string defined here should be changed whenever \.{OVP2OVF}
+gets modified.
+
+@d banner=='This is OVP2OVF, Version 1.11'
+{printed when the program starts}
+
+@ This program is written entirely in standard \PASCAL, except that
+it has to do some slightly system-dependent character code conversion
+on input. Furthermore, lower case letters are used in error messages;
+they could be converted to upper case if necessary. The input is read
+from |vpl_file|, and the output is written on |vf_file| and |tfm_file|;
+error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program OVP2OVF(@!vpl_file,@!vf_file,@!tfm_file,@!output);
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{VPtoVF}'s capacity.
+
+@<Constants...@>=
+@!ofm_type=0; {16-bit OFM; sufficient for most purposes}
+@!max_char=65535; {the largest character number in a font}
+@!xmax_char=65536; {|max_char|+1}
+@!xxmax_char=65537;{|max_char|+2}
+@!mem_size=262148; {|max_char|*4+8}
+@!max_font=1000; {the largest font number}
+@!xmax_font=1001; {|max_font|+1}
+@!xxmax_font=1002; {|max_font|+2}
+@!max_width=65535; {the largest character width number}
+@!max_height=255; {the largest character height number}
+@!max_depth=255; {the largest character depth number}
+@!max_italic=255; {the largest character italic correction number}
+@!buf_size=60; {length of lines displayed in error messages}
+@!max_header_bytes=100; {four times the maximum number of words allowed in
+ the \.{TFM} file header block, must be 1024 or less}
+@!vf_size=200000; {maximum length of |vf| data, in bytes}
+@!max_stack=100; {maximum depth of simulated \.{DVI} stack}
+@!max_param_words=100; {the maximum number of \.{fontdimen} parameters allowed}
+@!max_lig_steps=800000; {maximum length of ligature program}
+@!xmax_label=800001; {must be greater than |max_lig_steps|}
+@!hash_size=130003; {preferably a prime number,
+ a bit larger than |max_lig_steps|, the number
+ of character pairs in lig/kern steps}
+@!hash_mult=16007; {another prime}
+@!max_kerns=100000; {the maximum number of distinct kern values}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* Property list description of font metric data.
+The idea behind \.{VPL} files is that precise details about fonts, i.e., the
+facts that are needed by typesetting routines like \TeX, sometimes have to
+be supplied by hand. The nested property-list format provides a reasonably
+convenient way to do this.
+
+A good deal of computation is necessary to parse and process a
+\.{VPL} file, so it would be inappropriate for \TeX\ itself to do this
+every time it loads a font. \TeX\ deals only with the compact descriptions
+of font metric data that appear in \.{TFM} files. Such data is so compact,
+however, it is almost impossible for anybody but a computer to read it.
+
+Device drivers also need a compact way to describe mappings from \TeX's idea
+of a font to the actual characters a device can produce. They can do this
+conveniently when given a packed sequence of bytes called a \.{VF} file.
+
+The purpose of \.{VPtoVF} is to convert from a human-oriented file of text
+to computer-oriented files of binary numbers. There's a companion program,
+\.{VFtoVP}, which goes the other way.
+
+@<Glob...@>=
+@!vpl_file:text;
+
+@ @<Set init...@>=
+reset(vpl_file);
+
+@ A \.{VPL} file is like a \.{PL} file with a few extra features, so we
+can begin to define it by reviewing the definition of \.{PL} files. The
+material in the next few sections is copied from the program \.{PLtoTF}.
+An \.{OVP} file is simply a \.{VPL} file that does not restrict fonts
+to 256 characters.
+
+A \.{PL} file is a list of entries of the form
+$$\.{(PROPERTYNAME VALUE)}$$
+where the property name is one of a finite set of names understood by
+this program, and the value may itself in turn be a property list.
+The idea is best understood by looking at an example, so let's consider
+a fragment of the \.{PL} file for a hypothetical font.
+$$\vbox{\halign{\.{#}\hfil\cr
+(FAMILY NOVA)\cr
+(FACE F MIE)\cr
+(CODINGSCHEME ASCII)\cr
+(DESIGNSIZE D 10)\cr
+(DESIGNUNITS D 18)\cr
+(COMMENT A COMMENT IS IGNORED)\cr
+(COMMENT (EXCEPT THIS ONE ISN'T))\cr
+(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr
+\qquad\qquad IT SAYS IT ISN'T))\cr
+(FONTDIMEN\cr
+\qquad (SLANT R -.25)\cr
+\qquad (SPACE D 6)\cr
+\qquad (SHRINK D 2)\cr
+\qquad (STRETCH D 3)\cr
+\qquad (XHEIGHT R 10.55)\cr
+\qquad (QUAD D 18)\cr
+\qquad )\cr
+(LIGTABLE\cr
+\qquad (LABEL C f)\cr
+\qquad (LIG C f O 200)\cr
+\qquad (SKIP D 1)\cr
+\qquad (LABEL O 200)\cr
+\qquad (LIG C i O 201)\cr
+\qquad (KRN O 51 R 1.5)\cr
+\qquad (/LIG C ? C f)\cr
+\qquad (STOP)\cr
+\qquad )\cr
+(CHARACTER C f\cr
+\qquad (CHARWD D 6)\cr
+\qquad (CHARHT R 13.5)\cr
+\qquad (CHARIC R 1.5)\cr
+\qquad )\cr}}$$
+This example says that the font whose metric information is being described
+belongs to the hypothetical
+\.{NOVA} family; its face code is medium italic extended;
+and the characters appear in ASCII code positions. The design size is 10 points,
+and all other sizes in this \.{PL} file are given in units such that 18 units
+equals the design size. The font is slanted with a slope of $-.25$ (hence the
+letters actually slant backward---perhaps that is why the family name is
+\.{NOVA}). The normal space between words is 6 units (i.e., one third of
+the 18-unit design size), with glue that shrinks by 2 units or stretches by 3.
+The letters for which accents don't need to be raised or lowered are 10.55
+units high, and one em equals 18 units.
+
+The example ligature table is a bit trickier. It specifies that the
+letter \.f followed by another \.f is changed to code @'200, while
+code @'200 followed by \.i is changed to @'201; presumably codes @'200
+and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases
+\.f and @'200, if the following character is the code @'51 (which is a
+right parenthesis), an additional 1.5 units of space should be inserted
+before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or
+\.{KRN} command, which in this case is the second \.{LIG}; in this way
+two different ligature/kern programs can come together.)
+Finally, if either \.f or @'200 is followed by a question mark,
+the question mark is replaced by \.f and the ligature program is
+started over. (Thus, the character pair `\.{f?}' would actually become
+the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To
+avoid this restart procedure, the \.{/LIG} command could be replaced
+by \.{/LIG>}; then `\.{f?} would become `f\kern0ptf' and `\.{f?f}'
+would become `f\kern0ptff'.)
+
+Character \.f itself is 6 units wide and 13.5 units tall, in this example.
+Its depth is zero (since \.{CHARDP} is not given), and its italic correction
+is 1.5 units.
+
+@ The example above illustrates most of the features found in \.{PL} files.
+Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a
+string as their value; this string continues until the first unmatched
+right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT}
+and \.{LABEL}, take a number as their value. This number can be expressed in
+a variety of ways, indicated by a prefixed code; \.D stands for decimal,
+\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and
+\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as
+their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and
+\.{CHARACTER}, have more complicated values that involve property lists.
+
+A property name is supposed to be used only in an appropriate property
+list. For example, \.{CHARWD} shouldn't occur on the outer level or
+within \.{FONTDIMEN}.
+
+The individual property-and-value pairs in a property list can appear in
+any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the above
+example, although the \.{TFM} file always puts the stretch parameter first.
+One could even give the information about characters like `\.f' before
+specifying the number of units in the design size, or before specifying the
+ligature and kerning table. However, the \.{LIGTABLE} itself is an exception
+to this rule; the individual elements of the \.{LIGTABLE} property list
+can be reordered only to a certain extent without changing the meaning
+of that table.
+
+If property-and-value pairs are omitted, a default value is used. For example,
+we have already noted that the default for \.{CHARDP} is zero. The default
+for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated
+below.
+
+If the same property name is used more than once, \.{VPtoVF} will not notice
+the discrepancy; it simply uses the final value given. Once again, however, the
+\.{LIGTABLE} is an exception to this rule; \.{VPtoVF} will complain if there
+is more than one label for some character. And of course many of the
+entries in the \.{LIGTABLE} property list have the same property name.
+
+@ A \.{VPL} file also includes information about how to create each character,
+by typesetting characters from other fonts and/or by drawing lines, etc.
+Such information is the value of the `\.{MAP}' property, which can be
+illustrated as follows:
+$$\vbox{\halign{\.{#}\hfil\cr
+(MAPFONT D 0 (FONTNAME Times-Roman))\cr
+(MAPFONT D 1 (FONTNAME Symbol))\cr
+(MAPFONT D 2 (FONTNAME cmr10)(FONTAT D 20))\cr
+(CHARACTER O 0 (MAP (SELECTFONT D 1)(SETCHAR C G)))\cr
+(CHARACTER O 76 (MAP (SETCHAR O 277)))\cr
+(CHARACTER D 197 (MAP\cr
+\qquad(PUSH)(SETCHAR C A)(POP)\cr
+\qquad(MOVEUP R 0.937)(MOVERIGHT R 1.5)(SETCHAR O 312)))\cr
+(CHARACTER O 200 (MAP (MOVEDOWN R 2.1)(SETRULE R 1 R 8)))\cr
+(CHARACTER O 201 (MAP\cr
+\qquad (SPECIAL ps: /SaveGray currentgray def .5 setgray)\cr
+\qquad (SELECTFONT D 2)(SETCHAR C A)\cr
+\qquad (SPECIAL ps: SaveGray setgray)))\cr
+}}$$
+(These specifications appear in addition to the conventional \.{PL}
+information. The \.{MAP} attribute can be mixed in with other attributes
+like \.{CHARWD} or it can be given separately.)
+
+In this example, the virtual font is composed of characters that can be
+fabricated from three actual fonts, `\.{Times-Roman}',
+`\.{Symbol}', and `\.{cmr10} \.{at} \.{20\\u}' (where \.{\\u}
+is the unit size in this \.{VPL} file). Character |@'0| is typeset as
+a `G' from the symbol font. Character |@'76| is typeset as character |@'277|
+from the ordinary Times font. (If no other font is selected, font
+number~0 is the default. If no \.{MAP} attribute is given, the default map
+is a character of the same number in the default font.)
+
+Character 197 (decimal) is more interesting: First an A is typeset (in the
+default font Times), and this is enclosed by \.{PUSH} and \.{POP} so that
+the original position is restored. Then the accent character |@'312| is
+typeset, after moving up .937 units and right 1.5 units.
+
+To typeset character |@'200| in this virtual font, we move down 2.1 units,
+then typeset a rule that is 1 unit high and 8 units wide.
+
+Finally, to typeset character |@'201|, we do something that requires a
+special ability to interpret PostScript commands; this example
+sets the PostScript ``color'' to 50\char`\%\ gray and typesets an `A'
+from \.{cmr10} in that color.
+
+In general, the \.{MAP} attribute of a virtual character can be any sequence
+of typesetting commands that might appear in a page of a \.{DVI} file.
+A single character might map into an entire page.
+
+@ But instead of relying on a hypothetical example, let's consider a complete
+grammar for \.{VPL} files, beginning with the (unchanged) grammatical rules
+for \.{PL} files. At the outer level, the following property names
+are valid in any \.{PL} file:
+
+\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a
+nonnegative integer less than $2^{32}$, is used to identify a particular
+version of a font; it should match the check sum value stored with the font
+itself. An explicit check sum of zero is used to bypass
+check sum testing. If no checksum is specified in the \.{VPL} file,
+\.{VPtoVF} will compute the checksum that \MF\ would compute from the
+same data.
+
+\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which
+should be a real number in the range |1.0<=x<2048|, represents the default
+amount by which all quantities will be scaled if the font is not loaded
+with an `\.{at}' specification. For example, if one says
+`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM}
+file is ignored and effectively replaced by 15 points; but if one simply
+says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is
+always in units of printer's points.
+
+\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value
+should be a positive real number; it says how many units equals the design
+size (or the eventual `\.{at}' size, if the font is being scaled). For
+example, suppose you have a font that has been digitized with 600 pixels per
+em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}'
+if you wanted to give all of your measurements in units of pixels.
+
+\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 40.
+It identifies the correspondence between the numeric codes and font characters.
+(\TeX\ ignores this information, but other software programs make use of it.)
+
+\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 20.
+It identifies the name of the family to which this font belongs, e.g.,
+`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for
+example, when converting \.{DVI} files to \.{PRESS} files for Xerox
+equipment.)
+
+\yskip\hang\.{FACE} (one-byte value). This number, which must lie between
+0 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its
+family. For example, bold italic condensed fonts might have the same family name
+as light roman extended fonts, differing only in their face byte. (\TeX\
+ignores this information; but it is needed, for example, when converting
+\.{DVI} files to \.{PRESS} files for Xerox equipment.)
+
+\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The
+value should start with either `\.T' (true) or `\.F' (false). If true, character
+codes less than 128 cannot lead to codes of 128 or more via ligatures or
+charlists or extensible characters. (\TeX82 ignores this flag, but older
+versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.)
+\.{VPtoVF} computes the correct value of this flag and gives an error message
+only if a claimed ``true'' value is incorrect.
+
+\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value).
+The one-byte value should be between 18 and a maximum limit that can be
+raised or lowered depending on the compile-time setting of |max_header_bytes|.
+The four-byte value goes into the header word whose index is the one-byte
+value; for example, to set |header[18]:=1|, one may write
+`\.{(HEADER D 18 O 1)}'. This notation is used for header information that
+is presently unnamed. (\TeX\ ignores it.)
+
+\yskip\hang\.{FONTDIMEN} (property list value). See below for the names
+allowed in this property list.
+
+\yskip\hang\.{LIGTABLE} (property list value). See below for the rules
+about this special kind of property list.
+
+\yskip\hang\.{BOUNDARYCHAR} (integer value). If this character appears in
+a \.{LIGTABLE} command, it matches ``end of word'' as well as itself.
+If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs
+within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning.
+
+\yskip\hang\.{CHARACTER}. The value is an integer followed by
+a property list. The integer represents the number of a character that is
+present in the font; the property list of a character is defined below.
+The default is an empty property list.
+
+@ Numeric property list values can be given in various forms identified by
+a prefixed letter.
+
+\yskip\hang\.C denotes an ASCII character, which should be a standard visible
+character that is not a parenthesis. The numeric value will therefore be
+between @'41 and @'176 but not @'50 or @'51.
+
+\yskip\hang\.D denotes an unsigned decimal integer, which must be
+less than $2^{32}$, i.e., at most `\.{D 4294967295}'.
+
+\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes
+are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC},
+\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE},
+\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively.
+
+\yskip\hang\.O denotes an unsigned octal integer, which must be less than
+$2^{32}$, i.e., at most `\.{O 37777777777}'.
+
+\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than
+$2^{32}$, i.e., at most `\.{H FFFFFFFF}'.
+
+\yskip\hang\.R denotes a real number in decimal notation, optionally preceded
+by a `\.+' or `\.-' sign, and optionally including a decimal point. The
+absolute value must be less than 2048.
+
+@ The property names allowed in a \.{FONTDIMEN} property list correspond to
+various \TeX\ parameters, each of which has a (real) numeric value. All
+of the parameters except \.{SLANT} are in design units. The admissible
+names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT},
+\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1},
+\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP},
+\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters
+1~to~22. The alternate names \.{DEFAULTRULETHICKNESS},
+\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3},
+\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters
+8 to 13.
+
+The notation `\.{PARAMETER} $n$' provides another way to specify the
+$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way
+to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive
+and less than |max_param_words|.
+
+@ The elements of a \.{CHARACTER} property list can be of six different types.
+
+\yskip\hang\.{CHARWD} (real value) denotes the character's width in
+design units.
+
+\yskip\hang\.{CHARHT} (real value) denotes the character's height in
+design units.
+
+\yskip\hang\.{CHARDP} (real value) denotes the character's depth in
+design units.
+
+\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in
+design units.
+
+\yskip\hang\.{NEXTLARGER} (integer value), specifies the character that
+follows the present one in a ``charlist.'' The value must be the number of a
+character in the font, and there must be no infinite cycles of supposedly
+larger and larger characters.
+
+\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character.
+This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot
+both be used within the same \.{CHARACTER} list.
+
+\yskip\noindent
+The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID},
+\.{BOT} or \.{REP}; the values are integers, which must be zero or the number
+of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means
+that the corresponding piece of the extensible character is absent. A nonzero
+value, or a \.{REP} value of zero, denotes the character code used to make
+up the top, middle, bottom, or replicated piece of an extensible character.
+
+@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a
+program in a simple command language that \TeX\ uses for ligatures and kerns.
+If several \.{LIGTABLE} lists appear, they are effectively concatenated into
+a single list.
+
+\yskip\hang\.{LABEL} (integer value) means that the program for the
+stated character value starts here. The integer must be the number of a
+character in the font; its \.{CHARACTER} property list must not have a
+\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step
+must follow.
+
+\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for
+beginning-of-word ligatures starts here.
+
+\yskip\hang\.{LIG} (two integer values). The instruction `\.{(LIG} $c$ $r$\.)'
+means, ``If the next character is $c$, then insert character~$r$ and
+possibly delete the current character and/or~$c$;
+otherwise go on to the next instruction.''
+Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately
+preceded or followed by a slash, and then immediately followed by \.>
+characters not exceeding the number of slashes. Thus there are eight
+possible forms:
+$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil
+\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$
+The slashes specify retention of the left or right original character; the
+\.> signs specify passing over the result without further ligature processing.
+
+\yskip\hang\.{KRN} (an integer value and a real value). The instruction
+`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert
+a blank space of width $r$ between the current character character and $c$;
+otherwise go on to the next intruction.'' The value of $r$, which is in
+units of the design size, is often negative. Character code $c$ must exist
+in the font.
+
+\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
+It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL}
+or \.{STOP} or \.{SKIP}.
+
+\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies
+continuation of a ligature/kern program after the specified number of \.{LIG}
+or \.{KRN} has been skipped over. The number of subsequent \.{LIG} and \.{KRN}
+instructions must therefore exceed this specified amount.
+
+@ In addition to all these possibilities, the property name \.{COMMENT} is
+allowed in any property list. Such comments are ignored.
+
+@ So that is what \.{PL} files hold. In a \.{VPL} file additional
+properties are recognized; two of these are valid on the outermost level:
+
+\yskip\hang\.{VTITLE} (string value, default is empty). The value will be
+reproduced at the beginning of the \.{VF} file (and printed on the terminal
+by \.{VFtoVP} when it examines that file).
+
+\yskip\hang\.{MAPFONT}. The value is a nonnegative integer followed by
+a property list. The integer represents an identifying number for fonts
+used in \.{MAP} attributes. The property list, which identifies the font and
+relative size, is defined below.
+
+\yskip\noindent
+And one additional ``virtual property'' is valid within a \.{CHARACTER}:
+
+\yskip\hang\.{MAP}. The value is a property list consisting of typesetting
+commands. Default is the single command \.{SETCHAR}~$c$, where $c$ is
+the current character number.
+
+@ The elements of a \.{MAPFONT} property list can be of the following types.
+
+\yskip\hang\.{FONTNAME} (string value, default is \.{NULL}).
+This is the font's identifying name.
+
+\yskip\hang\.{FONTAREA} (string value, default is empty). If the font appears
+in a nonstandard directory, according to local conventions, the directory
+name is given here. (This is system dependent, just as in \.{DVI} files.)
+
+\yskip\hang\.{FONTCHECKSUM} (four-byte value, default is zero). This value,
+which should be a nonnegative integer less than $2^{32}$, can be used to
+check that the font being referred to matches the intended font. If nonzero,
+it should equal the \.{CHECKSUM} parameter in that font.
+
+\yskip\hang\.{FONTAT} (numeric value, default is the \.{DESIGNUNITS} of the
+present virtual font). This value is relative to the design units of
+the present virtual font, hence it will be scaled when the virtual
+font is magnified or reduced. It represents the value that will
+effectively replace the design size of the font being referred to,
+so that all characters will be scaled appropriately.
+
+\yskip\hang\.{FONTDSIZE} (numeric value, default is 10). This value is
+absolute, in units of printer's points. It should equal the \.{DESIGNSIZE}
+parameter in the font being referred to.
+
+\yskip\noindent
+If any of the
+string values contain parentheses, the parentheses must be balanced. Leading
+blanks are removed from the strings, but trailing blanks are not.
+
+@ Finally, the elements of a \.{MAP} property list are an ordered sequence
+of typesetting commands chosen from among the following:
+
+\yskip\hang\.{SELECTFONT} (four-byte integer value). The value must be the
+number of a previously defined \.{MAPFONT}. This font (or more precisely, the
+final font that is mapped to that code number, if two \.{MAPFONT} properties
+happen to specify the same code) will be used in subsequent \.{SETCHAR}
+instructions until overridden by another \.{SELECTFONT}. The first-specified
+\.{MAPFONT} is implicitly selected before the first \.{SELECTFONT} in every
+character's map.
+
+\yskip\hang\.{SETCHAR} (integer value). There must be a character of
+this number in the currently selected font. (\.{VPtoVF} doesn't check that
+the character is valid, but \.{VFtoVP} does.) That character is typeset at the
+current position, and the typesetter moves right by the \.{CHARWD} in
+that character's \.{TFM} file.
+
+\yskip\hang\.{SETRULE} (two real values). The first value specifies height,
+the second specifies width, in design units. If both height and width are
+positive, a rule is typeset at the current position. Then the typesetter
+moves right, by the specified width.
+
+\yskip\hang\.{MOVERIGHT}, \.{MOVELEFT}, \.{MOVEUP}, \.{MOVEDOWN} (real
+value). The typesetter moves its current position
+by the number of design units specified.
+
+\yskip\hang\.{PUSH} The current typesetter position is remembered, to
+be restored on a subsequent \.{POP}.
+
+\yskip\hang\.{POP} The current typesetter position is reset to where it
+was on the most recent unmatched \.{PUSH}. The \.{PUSH} and \.{POP}
+commands in any \.{MAP} must be properly nested like balanced parentheses.
+
+\yskip\hang\.{SPECIAL} (string value). The subsequent characters, starting
+with the first nonblank and ending just before the first `\.)' that has no
+matching `\.(', are interpreted according to local conventions with the
+same system-dependent meaning as a `special' (\\{xxx}) command
+in a \.{DVI} file.
+
+\yskip\hang\.{SPECIALHEX} (hexadecimal string value). The subsequent
+nonblank characters before the next `\.)' must consist entirely of
+hexadecimal digits, and they must contain an even number of such digits.
+Each pair of hex digits specifies a byte, and this string of bytes is
+treated just as the value of a \.{SPECIAL}. (This convention permits
+arbitrary byte strings to be represented in an ordinary text file.)
+
+@ Virtual font mapping is a recursive process, like macro expansion.
+Thus, a \.{MAPFONT} might
+specify another virtual font, whose characters are themselves mapped to
+other fonts. As an example of this possibility, consider the
+following curious file called \.{recurse.vpl}, which defines a
+virtual font that is self-contained and self-referential:
+$$\vbox{\halign{\.{#}\cr
+(VTITLE Example of recursion)\cr
+(MAPFONT D 0 (FONTNAME recurse)(FONTAT D 2))\cr
+(CHARACTER C A (CHARWD D 1)(CHARHT D 1)(MAP (SETRULE D 1 D 1)))\cr
+(CHARACTER C B (CHARWD D 2)(CHARHT D 2)(MAP (SETCHAR C A)))\cr
+(CHARACTER C C (CHARWD D 4)(CHARHT D 4)(MAP (SETCHAR C B)))\cr
+}}$$
+The design size is 10 points (the default), hence the character \.A
+in font \.{recurse} is a $10\times10$ point black square. Character \.B
+is typeset as character \.A in \.{recurse} {scaled} {2000}, hence it
+is a $20\times20$ point black square. And character \.C is typeset as
+character \.{B} in \.{recurse} {scaled} {2000}, hence its size is
+$40\times40$.
+
+Users are responsible for making sure that infinite recursion doesn't happen.
+
+@ So that is what \.{VPL} files hold. From these rules,
+you can guess (correctly) that \.{VPtoVF} operates in four main stages.
+First it assigns the default values to all properties; then it scans
+through the \.{VPL} file, changing property values as new ones are seen; then
+it checks the information and corrects any problems; and finally it outputs
+the \.{VF} and \.{TFM} files.
+
+@ The next question is, ``What are \.{VF} and
+\.{TFM} files?'' A complete answer to that question appears in the
+documentation of the companion programs, \.{VFtoVP} and
+\.{TFtoPL}, so the details will not
+be repeated here. Suffice it to say that a \.{VF} or
+\.{TFM} file stores all of the
+relevant font information in a sequence of 8-bit bytes. The number of
+bytes is always a multiple of 4, so we could regard the files
+as sequences of 32-bit words; but \TeX\ uses the byte interpretation,
+and so does \.{VPtoVF}. Note that the bytes are considered to be unsigned
+numbers.
+
+@<Glob...@>=
+@!vf_file:packed file of 0..255;
+@!tfm_file:packed file of 0..255;
+
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(vf_file); rewrite(tfm_file);
+
+@* Basic input routines.
+For the purposes of this program, a |byte| is an unsigned 16-bit quantity,
+and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes
+correspond to one-character constants like \.{"A"} in \.{WEB} language.
+
+@<Types...@>=
+@!byte=0..65535; {unsigned 16-bit quantity}
+@!ASCII_code=@'40..@'177; {standard ASCII code numbers}
+
+@ One of the things \.{VPtoVF} has to do is convert characters of strings
+to ASCII form, since that is the code used for the family name and the
+coding scheme in a \.{TFM} file. An array |xord| is used to do the
+conversion from |char|; the method below should work with little or no change
+on most \PASCAL\ systems.
+@^system dependencies@>
+
+@d first_ord=0 {ordinal number of the smallest element of |char|}
+@d last_ord=127 {ordinal number of the largest element of |char|}
+
+@<Global...@>=
+@!xord:array[char] of ASCII_code; {conversion table}
+
+@ @<Local variables for init...@>=
+@!k:integer; {all-purpose initialization index}
+
+@ Characters that should not appear in \.{VPL} files (except in comments)
+are mapped into @'177.
+
+@d invalid_code=@'177 {code deserving an error message}
+
+@<Set init...@>=
+for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code;
+xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#";
+xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'";
+xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=",";
+xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1";
+xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6";
+xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";";
+xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?";
+xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C";
+xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H";
+xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M";
+xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R";
+xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W";
+xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\";
+xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a";
+xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f";
+xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k";
+xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p";
+xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u";
+xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z";
+xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~";
+
+@ In order to help catch errors of badly nested parentheses, \.{VPtoVF}
+assumes that the user will begin each line with a number of blank spaces equal
+to some constant times the number of open parentheses at the beginning of
+that line. However, the program doesn't know in advance what the constant
+is, nor does it want to print an error message on every line for a user
+who has followed no consistent pattern of indentation.
+
+Therefore the following strategy is adopted: If the user has been consistent
+with indentation for ten or more lines, an indentation error will be
+reported. The constant of indentation is reset on every line that should
+have nonzero indentation.
+
+@<Glob...@>=
+@!line:integer; {the number of the current line}
+@!good_indent:integer; {the number of lines since the last bad indentation}
+@!indent: integer; {the number of spaces per open parenthesis, zero if unknown}
+@!level: integer; {the current number of open parentheses}
+
+@ @<Set init...@>=
+line:=0; good_indent:=0; indent:=0; level:=0;
+
+@ The input need not really be broken into lines of any maximum length, and
+we could read it character by character without any buffering. But we shall
+place it into a small buffer so that offending lines can be displayed in error
+messages.
+
+@<Glob...@>=
+@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer
+ at end-of-line marks?}
+@!limit:0..buf_size; {position of the last character present in the buffer}
+@!loc:0..buf_size; {position of the last character read in the buffer}
+@!buffer:array[1..buf_size] of char;
+@!input_has_ended:boolean; {there is no more input to read}
+
+@ @<Set init...@>=
+limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false;
+
+@ Just before each \.{CHARACTER} property list is evaluated, the character
+code is printed in octal notation. Up to eight such codes appear on a line;
+so we have a variable to keep track of how many are currently there.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+
+@ @<Set init...@>=
+chars_on_line:=0;
+
+@ The following routine prints an error message and an indication of
+where the error was detected. The error message should not include any
+final punctuation, since this procedure supplies its own.
+
+@d err_print(#)==begin if chars_on_line>0 then print_ln(' ');
+ print(#); show_error_context;
+ end
+
+@p procedure show_error_context; {prints the current scanner location}
+var k:0..buf_size; {an index into |buffer|}
+begin print_ln(' (line ',line:1,').');
+if not left_ln then print('...');
+for k:=1 to loc do print(buffer[k]); {print the characters already scanned}
+print_ln(' ');
+if not left_ln then print(' ');
+for k:=1 to loc do print(' '); {space out the second line}
+for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen}
+if right_ln then print_ln(' ')@+else print_ln('...');
+chars_on_line:=0;
+end;
+
+@ Here is a procedure that does the right thing when we are done
+reading the present contents of the buffer. It keeps |buffer[buf_size]|
+empty, in order to avoid range errors on certain \PASCAL\ compilers.
+
+An infinite sequence of right parentheses is placed at the end of the
+file, so that the program is sure to get out of whatever level of nesting
+it is in.
+
+On some systems it is desirable to modify this code so that tab marks
+in the buffer are replaced by blank spaces. (Simply setting
+|xord[chr(@'11)]:=" "| would not work; for example, two-line
+error messages would not come out properly aligned.)
+@^system dependencies@>
+
+@p procedure fill_buffer;
+begin left_ln:=right_ln; limit:=0; loc:=0;
+if left_ln then begin
+ if line>0 then read_ln(vpl_file);
+ incr(line);
+ end;
+if eof(vpl_file) then begin
+ limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
+ end
+else begin
+ while (limit<buf_size-1)and(not eoln(vpl_file)) do begin
+ incr(limit); read(vpl_file,buffer[limit]);
+ end;
+ buffer[limit+1]:=' '; right_ln:=eoln(vpl_file);
+ if left_ln then @<Set |loc| to the number of leading blanks in
+ the buffer, and check the indentation@>;
+ end;
+end;
+
+@ The interesting part about |fill_buffer| is the part that learns what
+indentation conventions the user is following, if any.
+
+@d bad_indent(#)==begin if good_indent>=10 then err_print(#);
+ good_indent:=0; indent:=0;
+ end
+
+@<Set |loc|...@>=
+begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
+if loc<limit then begin
+ if level=0 then
+ if loc=0 then incr(good_indent)
+ else bad_indent('Warning: Indented line occurred at level zero')
+@.Warning: Indented line...@>
+ else if indent=0 then
+ if loc mod level=0 then begin
+ indent:=loc div level; good_indent:=1;
+ end
+ else good_indent:=0
+ else if indent*level=loc then incr(good_indent)
+ else bad_indent('Warning: Inconsistent indentation; ',
+@.Warning: Inconsistent indentation...@>
+ 'you are at parenthesis level ',level:1);
+ end;
+end
+
+@* Basic scanning routines.
+The global variable |cur_char| holds the ASCII code corresponding to the
+character most recently read from the input buffer, or to a character that
+has been substituted for the real one.
+
+@<Global...@>=
+@!cur_char:ASCII_code; {we have just read this}
+
+@ Here is a procedure that sets |cur_char| to an ASCII code for the
+next character of input, if that character is a letter or digit or slash
+or \.>. Otherwise
+it sets |cur_char:=" "|, and the input system will be poised to reread the
+character that was rejected, whether or not it was a space.
+Lower case letters are converted to upper case.
+
+@p procedure get_keyword_char;
+begin while (loc=limit)and(not right_ln) do fill_buffer;
+if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
+else begin
+ cur_char:=xord[buffer[loc+1]];
+ if cur_char>="a" then cur_char:=cur_char-@'40;
+ if ((cur_char>="0")and(cur_char<="9")) then incr(loc)
+ else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc)
+ else if cur_char="/" then incr(loc)
+ else if cur_char=">" then incr(loc)
+ else cur_char:=" ";
+ end;
+end;
+
+@ The following procedure sets |cur_char| to the next character code,
+and converts lower case to upper case. If the character is a left or
+right parenthesis, it will not be ``digested''; the character will
+be read again and again, until the calling routine does something
+like `|incr(loc)|' to get past it. Such special treatment of parentheses
+insures that the structural information they contain won't be lost in
+the midst of other error recovery operations.
+
+@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc);
+ end {undoes the effect of |get_next|}
+
+@p procedure get_next; {sets |cur_char| to next, balks at parentheses}
+begin while loc=limit do fill_buffer;
+incr(loc); cur_char:=xord[buffer[loc]];
+if cur_char>="a" then
+ if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
+ else begin
+ if cur_char=invalid_code then begin
+ err_print('Illegal character in the file');
+@.Illegal character...@>
+ cur_char:="?";
+ end;
+ end
+else if (cur_char<=")")and(cur_char>="(") then decr(loc);
+end;
+
+@ Here's a procedure that scans a hexadecimal digit or a right parenthesis.
+
+@p function get_hex:byte;
+var @!a:integer; {partial result}
+begin repeat get_next;
+until cur_char<>" ";
+a:=cur_char-")";
+if a>0 then begin
+ a:=cur_char-"0";
+ if cur_char>"9" then
+ if cur_char<"A" then a:=-1 else a:=cur_char-"A"+10;
+ end;
+if (a<0)or(a>15) then begin
+ err_print('Illegal hexadecimal digit'); get_hex:=0;
+@.Illegal hexadecimal digit@>
+ end
+else get_hex:=a;
+end;
+
+@ The next procedure is used to ignore the text of a comment, or to pass over
+erroneous material. As such, it has the privilege of passing parentheses.
+It stops after the first right parenthesis that drops the level below
+the level in force when the procedure was called.
+
+@p procedure skip_to_end_of_item;
+var l:integer; {initial value of |level|}
+begin l:=level;
+while level>=l do begin
+ while loc=limit do fill_buffer;
+ incr(loc);
+ if buffer[loc]=')' then decr(level)
+ else if buffer[loc]='(' then incr(level);
+ end;
+if input_has_ended then err_print('File ended unexpectedly: No closing ")"');
+@.File ended unexpectedly...@>
+cur_char:=" "; {now the right parenthesis has been read and digested}
+end;
+
+@ A similar procedure copies the bytes remaining in an item. The copied bytes
+go into an array |vf| that we'll declare later. Leading blanks are ignored.
+
+@d vf_store(#)==
+ begin vf[vf_ptr]:=#;
+ if vf_ptr=vf_size then err_print('I''m out of memory---increase my vfsize!')
+@.I'm out of memory...@>
+ else incr(vf_ptr);
+ end
+
+@p procedure copy_to_end_of_item;
+label 30;
+var l:integer; {initial value of |level|}
+@!nonblank_found:boolean; {have we seen a nonblank character yet?}
+begin l:=level; nonblank_found:=false;
+while true do begin
+ while loc=limit do fill_buffer;
+ if buffer[loc+1]=')' then
+ if level=l then goto 30@+else decr(level);
+ incr(loc);
+ if buffer[loc]='(' then incr(level);
+ if buffer[loc]<>' ' then nonblank_found:=true;
+ if nonblank_found then
+ if xord[buffer[loc]]=invalid_code then begin
+ err_print('Illegal character in the file');
+@.Illegal character...@>
+ vf_store("?");
+ end
+ else vf_store(xord[buffer[loc]]);
+ end;
+30:end;
+
+@ Sometimes we merely want to skip past characters in the input until we
+reach a left or a right parenthesis. For example, we do this whenever we
+have finished scanning a property value and we hope that a right parenthesis
+is next (except for possible blank spaces).
+
+@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")")
+@d skip_error(#)==begin err_print(#); skip_to_paren;
+ end {this gets to the right parenthesis if something goes wrong}
+@d flush_error(#)==begin err_print(#); skip_to_end_of_item;
+ end {this gets past the right parenthesis if something goes wrong}
+
+@ After a property value has been scanned, we want to move just past the
+right parenthesis that should come next in the input (except for possible
+blank spaces).
+
+@p procedure finish_the_property; {do this when the value has been scanned}
+begin while cur_char=" " do get_next;
+if cur_char<>")" then err_print('Junk after property value will be ignored');
+@.Junk after property value...@>
+skip_to_end_of_item;
+end;
+
+@* Scanning property names.
+We have to figure out the meaning of names that appear in the \.{VPL} file,
+by looking them up in a dictionary of known keywords. Keyword number $n$
+appears in locations |start[n]| through |start[n+1]-1| of an array called
+|dictionary|.
+
+@d max_name_index=300 {upper bound on the number of keywords}
+@d max_letters=3000 {upper bound on the total length of all keywords}
+
+@<Global...@>=
+@!start:array[1..max_name_index] of 0..max_letters;
+@!dictionary:array[0..max_letters] of ASCII_code;
+@!start_ptr:0..max_name_index; {the first available place in |start|}
+@!dict_ptr:0..max_letters; {the first available place in |dictionary|}
+
+@ @<Set init...@>=
+start_ptr:=1; start[1]:=0; dict_ptr:=0;
+
+@ When we are looking for a name, we put it into the |cur_name| array.
+When we have found it, the corresponding |start| index will go into
+the global variable |name_ptr|.
+
+@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}}
+
+@<Glob...@>=
+@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up}
+@!name_length:0..longest_name; {its length}
+@!name_ptr:0..max_name_index; {its ordinal number in the dictionary}
+
+@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L
+in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary
+operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]|
+points into the |start| array.
+
+@d hash_prime=307 {size of the hash table}
+
+@<Glob...@>=
+@!nhash:array[0..hash_prime-1] of 0..max_name_index;
+@!cur_hash:0..hash_prime-1; {current position in the hash table}
+
+@ @<Local...@>=
+@!h:0..hash_prime-1; {runs through the hash table}
+
+@ @<Set init...@>=
+for h:=0 to hash_prime-1 do nhash[h]:=0;
+
+@ Since there is no chance of the hash table overflowing, the procedure
+is very simple. After |lookup| has done its work, |cur_hash| will point
+to the place where the given name was found, or where it should be inserted.
+
+@p procedure lookup; {finds |cur_name| in the dictionary}
+var k:0..longest_name; {index into |cur_name|}
+@!j:0..max_letters; {index into |dictionary|}
+@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement}
+@!cur_hash_reset:boolean;
+begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
+not_found:=true;
+cur_hash_reset:=false;
+while not_found do begin
+ if (cur_hash=0) and (cur_hash_reset) then
+ not_found:=false
+ else begin
+ if cur_hash=0 then begin
+ cur_hash:=hash_prime-1;
+ cur_hash_reset:=true
+ end
+ else decr(cur_hash);
+ if nhash[cur_hash]=0 then not_found:=false
+ else begin
+ j:=start[nhash[cur_hash]];
+ if start[nhash[cur_hash]+1]=j+name_length then begin
+ not_found:=false;
+ for k:=1 to name_length do
+ if dictionary[j+k-1]<>cur_name[k] then not_found:=true;
+ end
+ end
+ end
+ end;
+name_ptr:=nhash[cur_hash];
+end;
+
+@ @<Compute the hash...@>=
+cur_hash:=cur_name[1];
+for k:=2 to name_length do
+ cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime
+
+@ The ``meaning'' of the keyword that begins at |start[k]| in the
+dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given
+symbolic meanings by the following definitions.
+
+@d comment_code=0
+@d check_sum_code=1
+@d design_size_code=2
+@d design_units_code=3
+@d coding_scheme_code=4
+@d family_code=5
+@d face_code=6
+@d seven_bit_safe_flag_code=7
+@d header_code= 8
+@d font_dimen_code=9
+@d lig_table_code=10
+@d boundary_char_code=11
+@d virtual_title_code=12
+@d map_font_code=13
+@d font_dir_code=14
+@d n_font_dir_code=15
+@d character_code=16
+@d font_name_code=21
+@d font_area_code=22
+@d font_checksum_code=23
+@d font_at_code=24
+@d font_dsize_code=25
+@d parameter_code=30
+@d char_info_code=70
+@d width=1
+@d height=2
+@d depth=3
+@d italic=4
+@d sec_width=5
+@d sec_height=6
+@d sec_depth=7
+@d sec_italic=8
+@d accent=9
+@d prim_top_axis=10
+@d prim_top_axis_bis=11
+@d prim_bot_axis=12
+@d prim_bot_axis_bis=13
+@d prim_mid_hor=14
+@d prim_mid_vert=15
+@d prim_base_slant=16
+@d sec_top_axis=17
+@d sec_top_axis_bis=18
+@d sec_bot_axis=19
+@d sec_bot_axis_bis=20
+@d sec_mid_hor=21
+@d sec_mid_vert=22
+@d sec_base_slant=23
+@d char_wd_code=char_info_code+width
+@d char_ht_code=char_info_code+height
+@d char_dp_code=char_info_code+depth
+@d char_ic_code=char_info_code+italic
+@d sec_width_code=char_info_code+sec_width
+@d sec_height_code=char_info_code+sec_height
+@d sec_depth_code=char_info_code+sec_depth
+@d sec_italic_code=char_info_code+sec_italic
+@d accent_code=char_info_code+accent
+@d prim_top_axis_code=char_info_code+prim_top_axis
+@d prim_top_axis_bis_code=char_info_code+prim_top_axis_bis
+@d prim_bot_axis_code=char_info_code+prim_bot_axis
+@d prim_bot_axis_bis_code=char_info_code+prim_bot_axis_bis
+@d prim_mid_hor_code=char_info_code+prim_mid_hor
+@d prim_mid_vert_code=char_info_code+prim_mid_vert
+@d prim_base_slant_code=char_info_code+prim_base_slant
+@d sec_top_axis_code=char_info_code+sec_top_axis
+@d sec_top_axis_bis_code=char_info_code+sec_top_axis_bis
+@d sec_bot_axis_code=char_info_code+sec_bot_axis
+@d sec_bot_axis_bis_code=char_info_code+sec_bot_axis_bis
+@d sec_mid_hor_code=char_info_code+sec_mid_hor
+@d sec_mid_vert_code=char_info_code+sec_mid_vert
+@d sec_base_slant_code=char_info_code+sec_base_slant
+@d next_larger_code=100
+@d map_code=101
+@d var_char_code=102
+@d select_font_code=110
+@d set_char_code=111
+@d set_rule_code=112
+@d move_right_code=113
+@d move_down_code=115
+@d push_code=117
+@d pop_code=118
+@d special_code=119
+@d special_hex_code=120
+@d label_code=130
+@d stop_code=131
+@d skip_code=132
+@d krn_code=133
+@d lig_code=134
+@d ofm_level_code=140
+@d char_repeat_code=150
+@d char_ivalue_code=151
+@d char_fvalue_code=152
+@d char_mvalue_code=153
+@d char_rule_code=154
+@d char_glue_code=155
+@d char_penalty_code=156
+@d font_rule_code=160
+@d rule_code=161
+@d rule_width_code=162
+@d rule_height_code=163
+@d rule_depth_code=164
+@d font_glue_code=170
+@d glue_code=171
+@d glue_type_code=172
+@d glue_stretch_order_code=173
+@d glue_shrink_order_code=174
+@d glue_width_code=175
+@d glue_stretch_code=176
+@d glue_shrink_code=177
+@d glue_char_code=178
+@d glue_rule_code=179
+@d order_unit_code=181
+@d order_fi_code=182
+@d order_fil_code=183
+@d order_fill_code=184
+@d order_filll_code=185
+@d type_normal_code=186
+@d type_aleaders_code=187
+@d type_cleaders_code=188
+@d type_xleaders_code=189
+@d font_penalty_code=190
+@d penalty_code=191
+@d penalty_val_code=192
+@d font_mvalue_code=200
+@d mvalue_code=201
+@d mvalue_val_code=202
+@d font_fvalue_code=210
+@d fvalue_code=211
+@d fvalue_val_code=212
+@d font_ivalue_code=220
+@d ivalue_code=221
+@d ivalue_val_code=222
+@d clabel_code=231
+@d cpen_code=232
+@d cglue_code=233
+@d cpenglue_code=234
+@d ckrn_code=235
+@d TL_dir_code=240
+@d LT_dir_code=241
+@d TR_dir_code=242
+@d LB_dir_code=243
+@d BL_dir_code=244
+@d RT_dir_code=245
+@d BR_dir_code=246
+@d RB_dir_code=247
+
+@<Glo...@>=
+@!equiv:array[0..max_name_index] of byte;
+@!cur_code:byte; {equivalent most recently found in |equiv|}
+
+@ We have to get the keywords into the hash table and into the dictionary in
+the first place (sigh). The procedure that does this has the desired
+|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing
+for the initialization, the keyword being initialized is placed into the
+last positions of |cur_name|, instead of the first positions.
+
+@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary}
+var k:0..longest_name;
+begin for k:=1 to name_length do
+ cur_name[k]:=cur_name[k+longest_name-name_length];
+{now the name has been shifted into the correct position}
+lookup; {this sets |cur_hash| to the proper insertion place}
+nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v;
+for k:=1 to name_length do begin
+ dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr);
+ end;
+incr(start_ptr); start[start_ptr]:=dict_ptr;
+end;
+
+@ Here are the macros to load a name of up to 20 letters into the
+dictionary. For example, the macro |load5| is used for five-letter keywords.
+
+@d tail(#)==enter_name(#)
+@d t20(#)==cur_name[20]:=#;tail
+@d t19(#)==cur_name[19]:=#;t20
+@d t18(#)==cur_name[18]:=#;t19
+@d t17(#)==cur_name[17]:=#;t18
+@d t16(#)==cur_name[16]:=#;t17
+@d t15(#)==cur_name[15]:=#;t16
+@d t14(#)==cur_name[14]:=#;t15
+@d t13(#)==cur_name[13]:=#;t14
+@d t12(#)==cur_name[12]:=#;t13
+@d t11(#)==cur_name[11]:=#;t12
+@d t10(#)==cur_name[10]:=#;t11
+@d t9(#)==cur_name[9]:=#;t10
+@d t8(#)==cur_name[8]:=#;t9
+@d t7(#)==cur_name[7]:=#;t8
+@d t6(#)==cur_name[6]:=#;t7
+@d t5(#)==cur_name[5]:=#;t6
+@d t4(#)==cur_name[4]:=#;t5
+@d t3(#)==cur_name[3]:=#;t4
+@d t2(#)==cur_name[2]:=#;t3
+@d t1(#)==cur_name[1]:=#;t2
+@d load2==name_length:=2;t19
+@d load3==name_length:=3;t18
+@d load4==name_length:=4;t17
+@d load5==name_length:=5;t16
+@d load6==name_length:=6;t15
+@d load7==name_length:=7;t14
+@d load8==name_length:=8;t13
+@d load9==name_length:=9;t12
+@d load10==name_length:=10;t11
+@d load11==name_length:=11;t10
+@d load12==name_length:=12;t9
+@d load13==name_length:=13;t8
+@d load14==name_length:=14;t7
+@d load15==name_length:=15;t6
+@d load16==name_length:=16;t5
+@d load17==name_length:=17;t4
+@d load18==name_length:=18;t3
+@d load19==name_length:=19;t2
+@d load20==name_length:=20;t1
+
+@ (Thank goodness for keyboard macros in the text editor used to create this
+\.{WEB} file.)
+
+@<Enter all the \.{PL} names and their equivalents,
+ except the parameter names@>=
+equiv[0]:=comment_code; {this is used after unknown keywords}
+load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/
+load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/
+load11("D")("E")("S")("I")("G")("N")
+ ("U")("N")("I")("T")("S")(design_units_code);@/
+load12("C")("O")("D")("I")("N")("G")
+ ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/
+load6("F")("A")("M")("I")("L")("Y")(family_code);@/
+load4("F")("A")("C")("E")(face_code);@/
+load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@>
+ ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/
+load6("H")("E")("A")("D")("E")("R")(header_code);@/
+load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/
+load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/
+load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R")
+ (boundary_char_code);@/
+load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/
+load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/
+load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/
+load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/
+load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/
+load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/
+load5("S")("E")("C")("W")("D")(sec_width_code);@/
+load5("S")("E")("C")("H")("T")(sec_height_code);@/
+load5("S")("E")("C")("D")("P")(sec_depth_code);@/
+load5("S")("E")("C")("I")("C")(sec_italic_code);@/
+load6("A")("C")("C")("E")("N")("T")(accent_code);@/
+load11("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")(prim_top_axis_code);@/
+load14("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(prim_top_axis_bis_code);@/
+load11("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")(prim_bot_axis_code);@/
+load14("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(prim_bot_axis_bis_code);@/
+load10("P")("R")("I")("M")("M")("I")("D")("H")("O")("R")(prim_mid_hor_code);@/
+load10("P")("R")("I")("M")("M")("I")("D")("V")("E")("R")(prim_mid_vert_code);@/
+load13("P")("R")("I")("M")("B")("A")("S")("E")("S")("L")("A")("N")("T")(prim_base_slant_code);@/
+load10("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")(sec_top_axis_code);@/
+load13("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(sec_top_axis_bis_code);@/
+load10("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")(sec_bot_axis_code);@/
+load13("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(sec_bot_axis_bis_code);@/
+load9("S")("E")("C")("M")("I")("D")("H")("O")("R")(sec_mid_hor_code);@/
+load9("S")("E")("C")("M")("I")("D")("V")("E")("R")(sec_mid_vert_code);@/
+load12("S")("E")("C")("B")("A")("S")("E")("S")("L")("A")("N")("T")(sec_base_slant_code);@/
+load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/
+load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/
+load3("T")("O")("P")(var_char_code+1);@/
+load3("M")("I")("D")(var_char_code+2);@/
+load3("B")("O")("T")(var_char_code+3);@/
+load3("R")("E")("P")(var_char_code+4);@/
+load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format}
+load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/
+load5("L")("A")("B")("E")("L")(label_code);@/
+load4("S")("T")("O")("P")(stop_code);@/
+load4("S")("K")("I")("P")(skip_code);@/
+load3("K")("R")("N")(krn_code);@/
+load3("L")("I")("G")(lig_code);@/
+load4("/")("L")("I")("G")(lig_code+2);@/
+load5("/")("L")("I")("G")(">")(lig_code+6);@/
+load4("L")("I")("G")("/")(lig_code+1);@/
+load5("L")("I")("G")("/")(">")(lig_code+5);@/
+load5("/")("L")("I")("G")("/")(lig_code+3);@/
+load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/
+load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/
+load6("C")("L")("A")("B")("E")("L")(clabel_code);@/
+load4("C")("P")("E")("N")(cpen_code);@/
+load5("C")("G")("L")("U")("E")(cglue_code);@/
+load8("C")("P")("E")("N")("G")("L")("U")("E")(cpenglue_code);@/
+load4("C")("K")("R")("N")(ckrn_code);@/
+load8("O")("F")("M")("L")("E")("V")("E")("L")(ofm_level_code);@/
+load7("F")("O")("N")("T")("D")("I")("R")(font_dir_code);@/
+load8("N")("F")("O")("N")("T")("D")("I")("R")(n_font_dir_code);@/
+load10("C")("H")("A")("R")("R")("E")("P")("E")("A")("T")(char_repeat_code);@/
+load10("C")("H")("A")("R")("I")("V")("A")("L")("U")("E")(char_ivalue_code);@/
+load10("C")("H")("A")("R")("F")("V")("A")("L")("U")("E")(char_fvalue_code);@/
+load10("C")("H")("A")("R")("M")("V")("A")("L")("U")("E")(char_mvalue_code);@/
+load8("C")("H")("A")("R")("R")("U")("L")("E")(char_rule_code);@/
+load8("C")("H")("A")("R")("G")("L")("U")("E")(char_glue_code);@/
+load11("C")("H")("A")("R")("P")("E")("N")("A")("L")("T")("Y")(char_penalty_code);@/
+load8("F")("O")("N")("T")("R")("U")("L")("E")(font_rule_code);@/
+load4("R")("U")("L")("E")(rule_code);@/
+load6("R")("U")("L")("E")("W")("D")(rule_width_code);@/
+load6("R")("U")("L")("E")("H")("T")(rule_height_code);@/
+load6("R")("U")("L")("E")("D")("P")(rule_depth_code);@/
+load8("F")("O")("N")("T")("G")("L")("U")("E")(font_glue_code);@/
+load4("G")("L")("U")("E")(glue_code);@/
+load8("G")("L")("U")("E")("T")("Y")("P")("E")(glue_type_code);@/
+load16("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")("O")("R")("D")("E")("R")(glue_stretch_order_code);@/
+load15("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")("O")("R")("D")("E")("R")(glue_shrink_order_code);@/
+load8("G")("L")("U")("E")("R")("U")("L")("E")(glue_rule_code);@/
+load8("G")("L")("U")("E")("C")("H")("A")("R")(glue_char_code);@/
+load6("G")("L")("U")("E")("W")("D")(glue_width_code);@/
+load11("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")(glue_stretch_code);@/
+load10("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")(glue_shrink_code);@/
+load4("U")("N")("I")("T")(order_unit_code);@/
+load2("F")("I")(order_fi_code);@/
+load3("F")("I")("L")(order_fil_code);@/
+load4("F")("I")("L")("L")(order_fill_code);@/
+load5("F")("I")("L")("L")("L")(order_filll_code);@/
+load6("N")("O")("R")("M")("A")("L")(type_normal_code);@/
+load8("A")("L")("E")("A")("D")("E")("R")("S")(type_aleaders_code);@/
+load8("C")("L")("E")("A")("D")("E")("R")("S")(type_cleaders_code);@/
+load8("X")("L")("E")("A")("D")("E")("R")("S")(type_xleaders_code);@/
+load11("F")("O")("N")("T")("P")("E")("N")("A")("L")("T")("Y")(font_penalty_code);@/
+load7("P")("E")("N")("A")("L")("T")("Y")(penalty_code);@/
+load10("P")("E")("N")("A")("L")("T")("Y")("V")("A")("L")(penalty_val_code);@/
+load10("F")("O")("N")("T")("M")("V")("A")("L")("U")("E")(font_mvalue_code);@/
+load6("M")("V")("A")("L")("U")("E")(mvalue_code);@/
+load9("M")("V")("A")("L")("U")("E")("V")("A")("L")(mvalue_val_code);@/
+load10("F")("O")("N")("T")("F")("V")("A")("L")("U")("E")(font_fvalue_code);@/
+load6("F")("V")("A")("L")("U")("E")(fvalue_code);@/
+load9("F")("V")("A")("L")("U")("E")("V")("A")("L")(fvalue_val_code);@/
+load10("F")("O")("N")("T")("I")("V")("A")("L")("U")("E")(font_ivalue_code);@/
+load6("I")("V")("A")("L")("U")("E")(ivalue_code);@/
+load9("I")("V")("A")("L")("U")("E")("V")("A")("L")(ivalue_val_code);@/
+load2("T")("L")(TL_dir_code);
+load2("L")("T")(LT_dir_code);
+load2("T")("R")(TR_dir_code);
+load2("L")("B")(LB_dir_code);
+load2("B")("L")(BL_dir_code);
+load2("R")("T")(RT_dir_code);
+load2("B")("R")(BR_dir_code);
+load2("R")("B")(RB_dir_code);
+
+@ \.{VPL} files may contain the following in addition to the \.{PL} names.
+
+@<Enter all the \.{VPL} names@>=
+load6("V")("T")("I")("T")("L")("E")(virtual_title_code);@/
+load7("M")("A")("P")("F")("O")("N")("T")(map_font_code);@/
+load3("M")("A")("P")(map_code);@/
+load8("F")("O")("N")("T")("N")("A")("M")("E")(font_name_code);@/
+load8("F")("O")("N")("T")("A")("R")("E")("A")(font_area_code);@/
+load12("F")("O")("N")("T")
+ ("C")("H")("E")("C")("K")("S")("U")("M")(font_checksum_code);@/
+load6("F")("O")("N")("T")("A")("T")(font_at_code);@/
+load9("F")("O")("N")("T")("D")("S")("I")("Z")("E")(font_dsize_code);@/
+load10("S")("E")("L")("E")("C")("T")("F")("O")("N")("T")(select_font_code);@/
+load7("S")("E")("T")("C")("H")("A")("R")(set_char_code);@/
+load7("S")("E")("T")("R")("U")("L")("E")(set_rule_code);@/
+load9("M")("O")("V")("E")("R")("I")("G")("H")("T")(move_right_code);@/
+load8("M")("O")("V")("E")("L")("E")("F")("T")(move_right_code+1);@/
+load8("M")("O")("V")("E")("D")("O")("W")("N")(move_down_code);@/
+load6("M")("O")("V")("E")("U")("P")(move_down_code+1);@/
+load4("P")("U")("S")("H")(push_code);@/
+load3("P")("O")("P")(pop_code);@/
+load7("S")("P")("E")("C")("I")("A")("L")(special_code);@/
+load10("S")("P")("E")("C")("I")("A")("L")("H")("E")("X")(special_hex_code);@/
+
+@ @<Enter the parameter names@>=
+load5("S")("L")("A")("N")("T")(parameter_code+1);@/
+load5("S")("P")("A")("C")("E")(parameter_code+2);@/
+load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/
+load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/
+load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/
+load4("Q")("U")("A")("D")(parameter_code+6);@/
+load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/
+load4("N")("U")("M")("1")(parameter_code+8);@/
+load4("N")("U")("M")("2")(parameter_code+9);@/
+load4("N")("U")("M")("3")(parameter_code+10);@/
+load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/
+load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/
+load4("S")("U")("P")("1")(parameter_code+13);@/
+load4("S")("U")("P")("2")(parameter_code+14);@/
+load4("S")("U")("P")("3")(parameter_code+15);@/
+load4("S")("U")("B")("1")(parameter_code+16);@/
+load4("S")("U")("B")("2")(parameter_code+17);@/
+load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/
+load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/
+load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/
+load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/
+load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/
+load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@>
+ ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/
+
+@ When a left parenthesis has been scanned, the following routine
+is used to interpret the keyword that follows, and to store the
+equivalent value in |cur_code|.
+
+@p procedure get_name;
+begin incr(loc); incr(level); {pass the left parenthesis}
+cur_char:=" ";
+while cur_char=" " do get_next;
+if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character}
+name_length:=0; get_keyword_char; {prepare to scan the name}
+while cur_char<>" " do begin
+ if name_length=longest_name then cur_name[1]:="X" {force error}
+ else incr(name_length);
+ cur_name[name_length]:=cur_char;
+ get_keyword_char;
+ end;
+lookup;
+if name_ptr=0 then err_print('Sorry, I don''t know that property name');
+@.Sorry, I don't know...@>
+cur_code:=equiv[name_ptr];
+end;
+
+@* Scanning numeric data.
+The next thing we need is a trio of subroutines to read the one-byte,
+four-byte, and real numbers that may appear as property values.
+These subroutines are careful to stick to numbers between $-2^{31}$
+and $2^{31}-1$, inclusive, so that a computer with two's complement
+32-bit arithmetic will not be interrupted by overflow.
+
+@ The first number scanner, which returns a one-byte value, surely has
+no problems of arithmetic overflow.
+
+@p function get_byte:byte; {scans a one-byte property value}
+var acc:integer; {an accumulator}
+@!t:ASCII_code; {the type of value to be scanned}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+t:=cur_char; acc:=0;
+repeat get_next;
+until cur_char<>" "; {skip the blanks after the type code}
+if t="C" then @<Scan an ASCII character code@>
+else if t="D" then @<Scan a small decimal number@>
+else if t="O" then @<Scan a small octal number@>
+else if t="H" then @<Scan a small hexadecimal number@>
+else if t="F" then @<Scan a face code@>
+else skip_error('You need "C" or "D" or "O" or "H" or "F" here');
+@.You need "C" or "D" ...here@>
+cur_char:=" "; get_byte:=acc;
+end;
+
+@ The |get_next| routine converts lower case to upper case, but it leaves
+the character in the buffer, so we can unconvert it.
+
+@<Scan an ASCII...@>=
+if (cur_char>=@'41)and(cur_char<=@'176)and
+ ((cur_char<"(")or(cur_char>")")) then
+ acc:=xord[buffer[loc]]
+else skip_error('"C" value must be standard ASCII and not a paren')
+@:C value}\.{"C" value must be...@>
+
+@ @<Scan a small dec...@>=
+begin while (cur_char>="0")and(cur_char<="9") do begin
+ acc:=acc*10+cur_char-"0";
+ if acc>65535 then begin
+ skip_error('This value shouldn''t exceed 65535');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small oct...@>=
+begin while (cur_char>="0")and(cur_char<="7") do begin
+ acc:=acc*8+cur_char-"0";
+ if acc>65535 then begin
+ skip_error('This value shouldn''t exceed ''177777');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small hex...@>=
+begin while ((cur_char>="0")and(cur_char<="9"))or
+ ((cur_char>="A")and(cur_char<="F")) do begin
+ if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+ acc:=acc*16+cur_char-"0";
+ if acc>65535 then begin
+ skip_error('This value shouldn''t exceed "FFFF');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a face...@>=
+begin if cur_char="B" then acc:=2
+else if cur_char="L" then acc:=4
+else if cur_char<>"M" then acc:=18;
+get_next;
+if cur_char="I" then incr(acc)
+else if cur_char<>"R" then acc:=18;
+get_next;
+if cur_char="C" then acc:=acc+6
+else if cur_char="E" then acc:=acc+12
+else if cur_char<>"R" then acc:=18;
+if acc>=18 then begin
+ skip_error('Illegal face code, I changed it to MRR');
+@.Illegal face code...@>
+ acc:=0;
+ end;
+end
+
+@ The routine that scans a four-byte value puts its output into |cur_bytes|,
+which is a record containing (yes, you guessed it) four bytes.
+
+@<Types...@>=
+@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end;
+
+@ @d c0==cur_bytes.b0
+@d c1==cur_bytes.b1
+@d c2==cur_bytes.b2
+@d c3==cur_bytes.b3
+
+@<Glob...@>=
+@!cur_bytes:four_bytes; {a four-byte accumulator}
+@!zero_bytes:four_bytes; {four bytes all zero}
+
+@ @<Set init...@>=
+zero_bytes.b0:=0; zero_bytes.b1:=0; zero_bytes.b2:=0; zero_bytes.b3:=0;
+
+@ Since the |get_four_bytes| routine is used very infrequently, no attempt
+has been made to make it fast; we only want it to work.
+This is no longer the case, but we hope it's not too slow.
+
+@p procedure get_four_bytes; {scans an unsigned constant and sets |four_bytes|}
+var c:integer; {local two-byte accumulator}
+@!r:integer; {radix}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+r:=0; cur_bytes:=zero_bytes; {start with the accumulator zero}
+if cur_char="H" then r:=16
+else if cur_char="O" then r:=8
+else if cur_char="D" then r:=10
+else skip_error('Decimal ("D"), octal ("O"), or hex ("H") value needed here');
+@.Decimal ("D"), octal ("O"), or hex...@>
+if r>0 then begin
+ repeat get_next;
+ until cur_char<>" "; {skip the blanks after the type code}
+ while ((cur_char>="0")and(cur_char<="9"))or@|
+ ((cur_char>="A")and(cur_char<="F")) do
+ @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>;
+ end;
+end;
+
+function get_integer:integer; {scans an integer property value}
+begin get_four_bytes;
+get_integer:=(c0*@"1000000)+(c1*@"10000)+(c2*@"100)+c3;
+end;
+
+
+@ @<Multiply by |r|...@>=
+begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+if cur_char>="0"+r then skip_error('Illegal digit')
+@.Illegal digit@>
+else begin
+ c:=c3*r+cur_char-"0"; c3:=c mod 256;@/
+ c:=c2*r+c div 256; c2:=c mod 256;@/
+ c:=c1*r+c div 256; c1:=c mod 256;@/
+ c:=c0*r+c div 256;
+ if c<256 then c0:=c
+ else begin
+ cur_bytes:=zero_bytes;
+ if r=8 then
+ skip_error('Sorry, the maximum octal value is O 37777777777')
+@.Sorry, the maximum...@>
+ else if r=10 then
+ skip_error('Sorry, the maximum decimal value is D 4294967295')
+ else skip_error('Sorry, the maximum hex value is H FFFFFFFF');
+ end;
+ get_next;
+ end;
+end
+
+@ The remaining scanning routine is the most interesting. It scans a real
+constant and returns the nearest |fix_word| approximation to that constant.
+A |fix_word| is a 32-bit integer that represents a real value that
+has been multiplied by $2^{20}$. Since \.{VPtoVF} restricts the magnitude
+of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$.
+
+@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0}
+
+@<Types...@>=
+@!fix_word=integer; {a scaled real value with 20 bits of fraction}
+@!unsigned_integer=integer;
+
+@ When a real value is desired, we might as well treat `\.D' and `\.R'
+formats as if they were identical.
+
+@p function get_fix:fix_word; {scans a real property value}
+var negative:boolean; {was there a minus sign?}
+@!acc:integer; {an accumulator}
+@!int_part:integer; {the integer part}
+@!j:0..7; {the number of decimal places stored}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+negative:=false; acc:=0; {start with the accumulators zero}
+if (cur_char<>"R")and(cur_char<>"D") then
+ skip_error('An "R" or "D" value is needed here')
+@.An "R" or "D" ... needed here@>
+else begin @<Scan the blanks and/or signs after the type code@>;
+ while (cur_char>="0") and (cur_char<="9") do
+ @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>;
+ int_part:=acc; acc:=0;
+ if cur_char="." then @<Scan the fraction part and put it in |acc|@>;
+ if (acc>=unity)and(int_part=2047) then
+ skip_error('Real constants must be less than 2048')
+@.Real constants must be...@>
+ else acc:=int_part*unity+acc;
+ end;
+if negative then get_fix:=-acc@+else get_fix:=acc;
+end;
+
+@ @<Scan the blanks...@>=
+repeat get_next;
+if cur_char="-" then begin
+ cur_char:=" "; negative:=true;
+ end
+else if cur_char="+" then cur_char:=" ";
+until cur_char<>" "
+
+@ @<Multiply by 10...@>=
+begin acc:=acc*10+cur_char-"0";
+if acc>=2048 then begin
+ skip_error('Real constants must be less than 2048');
+@.Real constants must be...@>
+ acc:=0; cur_char:=" ";
+ end
+else get_next;
+end
+
+@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven
+of the digits $d_j$. A correct result is obtained if we first compute
+$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which
+$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
+
+@<Glob...@>=
+@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$}
+
+@ @<Scan the frac...@>=
+begin j:=0; get_next;
+while (cur_char>="0")and(cur_char<="9") do begin
+ if j<7 then begin
+ incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
+ end;
+ get_next;
+ end;
+acc:=0;
+while j>0 do begin
+ acc:=fraction_digits[j]+(acc div 10); decr(j);
+ end;
+acc:=(acc+10) div 20;
+end
+
+@* Storing the property values.
+When property values have been found, they are squirreled away in a bunch
+of arrays. The header information is unpacked into bytes in an array
+called |header_bytes|. The ligature/kerning program is stored in an array
+of type |four_bytes|.
+Another |four_bytes| array holds the specifications of extensible characters.
+The kerns and parameters are stored in separate arrays of |fix_word| values.
+Virtual font data goes into an array |vf| of single-byte values.
+
+We maintain information about at most |max_font+1| local fonts.
+
+Instead of storing the design size in the header array, we will keep it
+in a |fix_word| variable until the last minute. The number of units in the
+design size is also kept in a |fix_word|.
+
+@<Glob...@>=
+@!header_bytes:array[header_index] of byte; {the header block}
+@!header_ptr:header_index; {the number of header bytes in use}
+@!design_size:fix_word; {the design size}
+@!design_units:fix_word; {reciprocal of the scaling factor}
+@!frozen_du:boolean; {have we used |design_units| irrevocably?}
+@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?}
+@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program}
+@!nl:unsigned_integer; {the number of ligature/kern instructions so far}
+@!min_nl:unsigned_integer; {the final value of |nl| must be at least this}
+@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts}
+@!nk:0..max_kerns; {the number of entries of |kern|}
+@!exten:array[char_type] of four_bytes; {extensible character specs}
+@!ne:xchar_type; {the number of extensible characters}
+@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters}
+@!np:0..max_param_words; {the largest parameter set nonzero}
+@!check_sum_specified:boolean; {did the user name the check sum?}
+@!bchar:xchar_type; {right boundary character, |xmax_char| if unspecified}
+@!font_dir:integer; {font direction}
+@!vf:array[0..vf_size] of byte; {stored bytes for \.{VF} file}
+@!vf_ptr:0..vf_size; {first unused location in |vf|}
+@!vtitle_start:0..vf_size; {starting location of \.{VTITLE} string}
+@!vtitle_length:byte; {length of \.{VTITLE} string}
+@!packet_start:array[char_type] of 0..vf_size;
+ {beginning location of character packet}
+@!packet_length:array[char_type] of integer; {length of character packet}
+@!font_ptr:xfont_type; {number of distinct local fonts seen}
+@!cur_font:xfont_type; {number of the current local font}
+@!fname_start:array[font_type] of 0..vf_size; {beginning of local font name}
+@!fname_length:array[font_type] of byte; {length of local font name}
+@!farea_start:array[font_type] of 0..vf_size; {beginning of local font area}
+@!farea_length:array[font_type] of byte; {length of local font area}
+@!font_checksum:array[font_type] of four_bytes; {local font checksum}
+@!font_number:array[xfont_type] of integer; {local font id number}
+@!font_at:array[font_type] of fix_word; {local font ``at size''}
+@!font_dsize:array[font_type] of fix_word; {local font design size}
+
+@ @<Types...@>=
+@!char_type=0..max_char;
+@!xchar_type=0..xmax_char;
+@!xxchar_type=0..xxmax_char;
+@!font_type=0..max_font;
+@!xfont_type=0..xmax_font;
+@!header_index=0..max_header_bytes;
+@!indx=xxchar_type;
+
+@ @<Local...@>=
+@!d:header_index; {an index into |header_bytes|}
+
+@ We start by setting up the default values.
+
+@d check_sum_loc=0
+@d design_size_loc=4
+@d coding_scheme_loc=8
+@d family_loc=coding_scheme_loc+40
+@d seven_flag_loc=family_loc+20
+@d face_loc=seven_flag_loc+3
+
+@<Set init...@>=
+for d:=0 to 18*4-1 do header_bytes[d]:=0;
+header_bytes[8]:=11; header_bytes[9]:="U";
+header_bytes[10]:="N";
+header_bytes[11]:="S";
+header_bytes[12]:="P";
+header_bytes[13]:="E";
+header_bytes[14]:="C";
+header_bytes[15]:="I";
+header_bytes[16]:="F";
+header_bytes[17]:="I";
+header_bytes[18]:="E";
+header_bytes[19]:="D";
+@.UNSPECIFIED@>
+for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40];
+design_size:=10*unity; design_units:=unity; frozen_du:=false;
+seven_bit_safe_flag:=false;@/
+header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/
+check_sum_specified:=false; bchar:=xmax_char;@/
+font_dir:=0;
+vf_ptr:=0; vtitle_start:=0; vtitle_length:=0; font_ptr:=0;
+for k:=0 to max_char do packet_start[k]:=vf_size;
+for k:=0 to 127 do packet_length[k]:=1;
+for k:=128 to 255 do packet_length[k]:=2;
+for k:=256 to max_char do packet_length[k]:=3;
+
+@ Most of the dimensions, however, go into the |memory| array. There are
+at most |max_char+2| widths, |max_char+2| heights,
+|max_char+2| depths, and |max_char+2| italic corrections,
+since the value 0 is required but it need not be used. So |memory| has room
+for |4*max_char+8| entries, each of which is a |fix_word|. An auxiliary table called
+|link| is used to link these words together in linear lists, so that
+sorting and other operations can be done conveniently.
+
+We also add four ``list head'' words to the |memory| and |link| arrays;
+these are in locations |width| through |italic|, i.e., 1 through 4.
+For example, |link[height]| points to the smallest element in
+the sorted list of distinct heights that have appeared so far, and
+|memory[height]| is the number of distinct heights.
+
+@<Types...@>=
+@!pointer=0..mem_size; {an index into memory}
+
+@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain
+pointers to the |memory| array entries where the corresponding dimensions
+appear. Two other arrays, |char_tag| and |char_remainder|, hold
+the other information that \.{TFM} files pack into a |char_info_word|.
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+@d bchar_label==char_remainder[xmax_char]
+ {beginning of ligature program for left boundary}
+
+@<Glob...@>=
+@!memory:array[pointer] of fix_word; {character dimensions and kerns}
+@!mem_ptr:pointer; {largest |memory| word in use}
+@!link:array[pointer] of pointer; {to make lists of |memory| items}
+@!char_wd:array[char_type] of pointer; {pointers to the widths}
+@!char_ht:array[char_type] of pointer; {pointers to the heights}
+@!char_dp:array[char_type] of pointer; {pointers to the depths}
+@!char_ic:array[char_type] of pointer; {pointers to italic corrections}
+@!char_tag:array[char_type] of no_tag..ext_tag; {character tags}
+@!char_remainder:array[xchar_type] of xchar_type;
+ {pointers to ligature labels,
+ next larger characters, or extensible characters}
+@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
+
+@ @<Local...@>=
+@!c:integer; {runs through all character codes}
+
+@ @<Set init...@>=
+bchar_label:=xmax_label;
+for c:=0 to max_char do begin
+ char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
+ char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists}
+memory[width]:=0; link[width]:=0; {width list is empty}
+memory[height]:=0; link[height]:=0; {height list is empty}
+memory[depth]:=0; link[depth]:=0; {depth list is empty}
+memory[italic]:=0; link[italic]:=0; {italic list is empty}
+mem_ptr:=italic;
+
+@ As an example of these data structures, let us consider the simple
+routine that inserts a potentially new element into one of the dimension
+lists. The first parameter indicates the list head (i.e., |h=width| for
+the width list, etc.); the second parameter is the value that is to be
+inserted into the list if it is not already present. The procedure
+returns the value of the location where the dimension appears in |memory|.
+The fact that |memory[0]| is larger than any legal dimension makes the
+algorithm particularly short.
+
+We do have to handle two somewhat subtle situations. A width of zero must be
+put into the list, so that a zero-width character in the font will not appear
+to be nonexistent (i.e., so that its |char_wd| index will not be zero), but
+this does not need to be done for heights, depths, or italic corrections.
+Furthermore, it is necessary to test for memory overflow even though we
+have provided room for the maximum number of different dimensions in any
+legal font, since the \.{VPL} file might foolishly give any number of
+different sizes to the same character.
+
+@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list}
+var p:pointer; {the current node of interest}
+begin if (d=0)and(h<>width) then sort_in:=0
+else begin p:=h;
+ while d>=memory[link[p]] do p:=link[p];
+ if (d=memory[p])and(p<>h) then sort_in:=p
+ else if mem_ptr=mem_size then begin
+ err_print('Memory overflow: too many widths, etc');
+@.Memory overflow...@>
+ print_ln('Congratulations! It''s hard to make this error.');
+ sort_in:=p;
+ end
+ else begin
+ incr(mem_ptr); memory[mem_ptr]:=d;
+ link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]);
+ sort_in:=mem_ptr;
+ end;
+ end;
+end;
+
+@ When these lists of dimensions are eventually written to the \.{OFM}
+file, we may have to do some rounding of values, because the \.{OFM} file
+allows at most 65536 widths, 256 heights, 256 depths, and 256 italic
+corrections. The following procedure takes a given list head |h| and a
+given dimension |d|, and returns the minimum $m$ such that the elements
+of the list can be covered by $m$ intervals of width $d$. It also sets
+|next_d| to the smallest value $d^\prime>d$ such that the covering found
+by this procedure would be different. In particular, if $d=0$ it computes
+the number of elements of the list, and sets |next_d| to the smallest
+distance between two list elements. (The covering by intervals of width
+|next_d| is not guaranteed to have fewer than $m$ elements, but in
+practice this seems to happen most of the time.)
+
+@<Glob...@>=
+@!next_d:fix_word; {the next larger interval that is worth trying}
+
+@ Once again we can make good use of the fact that |memory[0]| is ``infinite.''
+
+@p function min_cover(@!h:pointer;@!d:fix_word):integer;
+var p:pointer; {the current node of interest}
+@!l:fix_word; {the least element covered by the current interval}
+@!m:integer; {the current size of the cover being generated}
+begin m:=0; p:=link[h]; next_d:=memory[0];
+while p<>0 do begin
+ incr(m); l:=memory[p];
+ while memory[link[p]]<=l+d do p:=link[p];
+ p:=link[p];
+ if memory[p]-l<next_d then next_d:=memory[p]-l;
+ end;
+min_cover:=m;
+end;
+
+@ The following procedure uses |min_cover| to determine the smallest $d$
+such that a given list can be covered with at most a given number of
+intervals.
+
+@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round}
+var d:fix_word; {the current trial interval length}
+@!k:integer; {the size of a minimum cover}
+begin if memory[h]>m then begin
+ excess:=memory[h]-m;
+ k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|}
+ repeat d:=d+d; k:=min_cover(h,d);
+ until k<=m; {first we ascend rapidly until finding the range}
+ d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps}
+ while k>m do begin
+ d:=next_d; k:=min_cover(h,d);
+ end;
+ shorten:=d;
+ end
+else shorten:=0;
+end;
+
+@ When we are nearly ready to output the \.{TFM} file, we will set
+|index[p]:=k| if the dimension in |memory[p]| is being rounded to the
+|k|th element of its list.
+
+@<Glob...@>=
+@!index:array[pointer] of byte;
+@!excess:byte; {number of words to remove, if list is being shortened}
+
+@ Here is the procedure that sets the |index| values. It also shortens
+the list so that there is only one element per covering interval;
+the remaining elements are the midpoints of their clusters.
+
+@p procedure set_indices(@!h:pointer;@!d:fix_word); {reduces and indexes a list}
+var p:pointer; {the current node of interest}
+@!q:pointer; {trails one step behind |p|}
+@!m:byte; {index number of nodes in the current interval}
+@!l:fix_word; {least value in the current interval}
+begin q:=h; p:=link[q]; m:=0;
+while p<>0 do begin
+ incr(m); l:=memory[p]; index[p]:=m;
+ while memory[link[p]]<=l+d do begin
+ p:=link[p]; index[p]:=m; decr(excess);
+ if excess=0 then d:=0;
+ end;
+ link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p];
+ end;
+memory[h]:=m;
+end;
+
+@* The input phase.
+We're ready now to read and parse the \.{VPL} file, storing property
+values as we go.
+
+@<Glob...@>=
+@!c:integer; {the current character or byte being processed}
+@!cprime:char_type; {Processing for several characters together}
+@!crange:char_type; {ditto}
+@!x:fix_word; {current dimension of interest}
+@!k:integer; {general-purpose index}
+
+@ @<Read all the input@>=
+cur_char:=" ";
+repeat while cur_char=" " do get_next;
+if cur_char="(" then @<Read a font property value@>
+else if (cur_char=")")and not input_has_ended then begin
+ err_print('Extra right parenthesis');
+ incr(loc); cur_char:=" ";
+ end
+@.Extra right parenthesis@>
+else if not input_has_ended then junk_error;
+until input_has_ended
+
+@ The |junk_error| routine just referred to is called when something
+appears in the forbidden area between properties of a property list.
+
+@p procedure junk_error; {gets past no man's land}
+begin err_print('There''s junk here that is not in parentheses');
+@.There's junk here...@>
+skip_to_paren;
+end;
+
+@ For each font property, we are supposed to read the data from the
+left parenthesis that is the current value of |cur_char| to the right
+parenthesis that matches it in the input. The main complication is
+to recover with reasonable grace from various error conditions that
+might arise.
+
+@<Read a font property value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<110) and (cur_code>character_code) then
+ flush_error('This property name doesn''t belong on the outer level')
+else if (cur_code>=110) and ((cur_code mod 10)<>0) then
+ flush_error('This property name doesn''t belong on the outer level')
+@.This property name doesn't belong...@>
+else begin
+ @<Read the font property value specified by |cur_code|@>;
+ finish_the_property;
+ end;
+end
+
+@ @<Read the font property value spec...@>=
+case cur_code of
+check_sum_code: begin check_sum_specified:=true; read_four_bytes(check_sum_loc);
+ end;
+design_size_code: @<Read the design size@>;
+design_units_code: @<Read the design units@>;
+coding_scheme_code: read_BCPL(coding_scheme_loc,40);
+family_code: read_BCPL(family_loc,20);
+face_code: begin c:=get_byte; if c>255 then begin
+ err_print('FACE clipped to 255'); c:=255 end;
+ header_bytes[face_loc]:=c
+ end;
+seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
+header_code: @<Read an indexed header word@>;
+font_dimen_code: @<Read font parameter list@>;
+lig_table_code: read_lig_kern;
+boundary_char_code: bchar:=get_byte;
+virtual_title_code: begin vtitle_start:=vf_ptr; copy_to_end_of_item;
+ if vf_ptr>vtitle_start+255 then begin
+ err_print('VTITLE clipped to 255 characters'); vtitle_length:=255;
+@.VTITLE clipped...@>
+ end
+ else vtitle_length:=vf_ptr-vtitle_start;
+ end;
+map_font_code:@<Read a local font list@>;
+character_code: read_char_info;
+ofm_level_code: @<Read OFM level code@>;
+font_dir_code: @<Read font direction code@>;
+n_font_dir_code: @<Read natural font direction code@>;
+char_repeat_code: read_repeated_character_info;
+font_rule_code: read_font_rule_list;
+font_glue_code: read_font_glue_list;
+font_penalty_code: read_font_penalty_list;
+font_mvalue_code: read_font_mvalue_list;
+font_fvalue_code: read_font_fvalue_list;
+font_ivalue_code: read_font_ivalue_list;
+end
+
+@ The |case| statement just given makes use of three subroutines that we
+haven't defined yet. The first of these puts a 32-bit octal quantity
+into four specified bytes of the header block.
+
+@p procedure read_four_bytes(l:header_index);
+begin get_four_bytes;
+header_bytes[l]:=c0;
+header_bytes[l+1]:=c1;
+header_bytes[l+2]:=c2;
+header_bytes[l+3]:=c3;
+end;
+
+@ The second little procedure is used to scan a string and to store it in
+the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed
+to contain at most |n| bytes, including the first byte (which holds the
+length of the rest of the string).
+
+@p procedure read_BCPL(l:header_index;n:byte);
+var k:header_index;
+begin k:=l;
+while cur_char=" " do get_next;
+while (cur_char<>"(")and(cur_char<>")") do begin
+ if k<l+n then incr(k);
+ if k<l+n then header_bytes[k]:=cur_char;
+ get_next;
+ end;
+if k=l+n then begin
+ err_print('String is too long; its first ',n-1:1,
+@.String is too long...@>
+ ' characters will be kept'); decr(k);
+ end;
+header_bytes[l]:=k-l;
+while k<l+n-1 do begin {tidy up the remaining bytes by setting them to nulls}
+ incr(k); header_bytes[k]:=0;
+ end;
+end;
+
+@ @<Read the design size@>=
+begin next_d:=get_fix;
+if next_d<unity then
+ err_print('The design size must be at least 1')
+@.The design size must...@>
+else design_size:=next_d;
+end
+
+@ @<Read the design units@>=
+begin next_d:=get_fix;
+if next_d<=0 then
+ err_print('The number of units per design size must be positive')
+@.The number of units...@>
+else if frozen_du then
+ err_print('Sorry, it''s too late to change the design units')
+@.Sorry, it's too late...@>
+else design_units:=next_d;
+end
+
+@ @<Read the seven-bit-safe...@>=
+begin while cur_char=" " do get_next;
+if cur_char="T" then seven_bit_safe_flag:=true
+else if cur_char="F" then seven_bit_safe_flag:=false
+else err_print('The flag value should be "TRUE" or "FALSE"');
+@.The flag value should be...@>
+skip_to_paren;
+end
+
+@ @<Read an indexed header word@>=
+begin c:=get_byte;
+if c<18 then skip_error('HEADER indices should be 18 or more')
+@.HEADER indices...@>
+else if 4*c+4>max_header_bytes then
+ skip_error('This HEADER index is too big for my present table size')
+@.This HEADER index is too big...@>
+else begin
+ while header_ptr<4*c+4 do begin
+ header_bytes[header_ptr]:=0; incr(header_ptr);
+ end;
+ read_four_bytes(4*c);
+ end;
+end
+
+@ The remaining kinds of font property values that need to be read are
+those that involve property lists on higher levels. Each of these has a
+loop similar to the one that was used at level zero. Then we put the
+right parenthesis back so that `|finish_the_property|' will be happy;
+there is probably a more elegant way to do this.
+
+@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")";
+ end
+
+@<Read font parameter list@>=
+begin while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a parameter value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a parameter value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
+ flush_error('This property name doesn''t belong in a FONTDIMEN list')
+@.This property name doesn't belong...@>
+else begin if cur_code=parameter_code then c:=get_integer
+ else c:=cur_code-parameter_code;
+ if c=0 then flush_error('PARAMETER index must not be zero')
+@.PARAMETER index must not...@>
+ else if c>max_param_words then
+ flush_error('This PARAMETER index is too big for my present table size')
+@.This PARAMETER index is too big...@>
+ else begin
+ while np<c do begin
+ incr(np); param[np]:=0;
+ end;
+ param[c]:=get_fix;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Read a local font list@>=
+begin font_number[font_ptr]:=get_integer; cur_font:=0;
+while font_number[font_ptr]<>font_number[cur_font] do incr(cur_font);
+if cur_font=font_ptr then {it's a new font number}
+ if font_ptr<xmax_font then @<Initialize a new local font@>
+ else err_print('Sorry, too many different mapfonts');
+@.Sorry, too many different mapfonts@>
+if cur_font=font_ptr then skip_to_end_of_item
+else while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a local font property@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Initialize a new local font@>=
+begin incr(font_ptr);
+fname_start[cur_font]:=vf_size; fname_length[cur_font]:=4; {\.{NULL}}
+farea_start[cur_font]:=vf_size; farea_length[cur_font]:=0;
+font_checksum[cur_font]:=zero_bytes;
+font_at[cur_font]:=@'4000000; {denotes design size of this virtual font}
+font_dsize[cur_font]:=@'50000000; {the |fix_word| for 10}
+end
+
+@ @<Read a local font property@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<font_name_code)or(cur_code>font_dsize_code) then
+ flush_error('This property name doesn''t belong in a MAPFONT list')
+@.This property name doesn't belong...@>
+else begin
+ case cur_code of
+ font_name_code:@<Read a local font name@>;
+ font_area_code:@<Read a local font area@>;
+ font_checksum_code:begin
+ get_four_bytes; font_checksum[cur_font]:=cur_bytes;
+ end;
+ font_at_code: begin frozen_du:=true;
+ if design_units=unity then font_at[cur_font]:=get_fix
+ else font_at[cur_font]:=round((get_fix/design_units)*1048576.0);
+ end;
+ font_dsize_code:font_dsize[cur_font]:=get_fix;
+ end; {there are no other cases}
+ finish_the_property;
+ end;
+end
+
+@ @<Read a local font name@>=
+begin fname_start[cur_font]:=vf_ptr; copy_to_end_of_item;
+if vf_ptr>fname_start[cur_font]+255 then begin
+ err_print('FONTNAME clipped to 255 characters');
+@.FONTNAME clipped...@>
+ fname_length[cur_font]:=255;
+ end
+else fname_length[cur_font]:=vf_ptr-fname_start[cur_font];
+end
+
+@ @<Read a local font area@>=
+begin farea_start[cur_font]:=vf_ptr; copy_to_end_of_item;
+if vf_ptr>farea_start[cur_font]+255 then begin
+ err_print('FONTAREA clipped to 255 characters');
+@.FONTAREA clipped...@>
+ farea_length[cur_font]:=255;
+ end
+else farea_length[cur_font]:=vf_ptr-farea_start[cur_font];
+end
+
+@ @<Read ligature/kern list@>=
+begin lk_step_ended:=false;
+while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then read_lig_kern_command
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a ligature/kern command@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code>=label_code) and (cur_code<=(lig_code+11)) then begin
+ case cur_code of
+ label_code:@<Read a label step@>;
+ stop_code:@<Read a stop step@>;
+ skip_code:@<Read a skip step@>;
+ krn_code:@<Read a kerning step@>;
+ lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,
+ lig_code+7,lig_code+11:@<Read a ligature step@>;
+ end; {there are no other cases |>=label_code|}
+ finish_the_property;
+ end
+else if (cur_code>=clabel_code) and (cur_code<=cpenglue_code) then begin
+ case cur_code of
+ clabel_code:@<Read an extended label step@>;
+ cpen_code:@<Read an extended penalty step@>;
+ cglue_code:@<Read an extended glue step@>;
+ cpenglue_code:@<Read an extended penalty/glue step@>;
+ ckrn_code:@<Read an extended kern step@>;
+ end; {there are no other cases |>=label_code|}
+ finish_the_property;
+ end
+else flush_error('This property name doesn''t belong in a LIGTABLE list');
+@.This property name doesn't belong...@>
+end
+
+@ When a character is about to be tagged, we call the following
+procedure so that an error message is given in case of multiple tags.
+
+@p procedure check_tag(c:byte); {print error if |c| already tagged}
+begin case char_tag[c] of
+no_tag: do_nothing;
+lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
+@.This character already...@>
+list_tag: err_print('This character already has a NEXTLARGER spec');
+ext_tag: err_print('This character already has a VARCHAR spec');
+end;
+end;
+
+@ @<Read a label step@>=
+begin while cur_char=" " do get_next;
+if cur_char="B" then begin
+ bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
+ end
+else begin
+ backup; c:=get_byte;
+ check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
+ end;
+if min_nl<=nl then min_nl:=nl+1;
+lk_step_ended:=false;
+end
+
+@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@<Globals...@>=
+@!lk_step_ended:boolean;
+ {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?}
+@!krn_ptr:0..max_kerns; {an index into |kern|}
+
+@ @<Read a stop step@>=
+if not lk_step_ended then
+ err_print('STOP must follow LIG or KRN')
+@.STOP must follow LIG or KRN@>
+else begin
+ lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
+ lk_step_ended:=false;
+ end
+
+@ @<Read a skip step@>=
+if not lk_step_ended then
+ err_print('SKIP must follow LIG or KRN')
+@.SKIP must follow LIG or KRN@>
+else begin
+ c:=get_byte;
+ if c>=128 then err_print('Maximum SKIP amount is 127')
+@.Maximum SKIP amount...@>
+ else if nl+c>=max_lig_steps then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+ else begin
+ lig_kern[nl-1].b0:=c;
+ if min_nl<=nl+c then min_nl:=nl+c+1;
+ end;
+ lk_step_ended:=false;
+ end
+
+@ @<Read a ligature step@>=
+begin lig_kern[nl].b0:=0;
+lig_kern[nl].b2:=cur_code-lig_code;
+lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b3:=get_byte;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read a kerning step@>=
+begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
+kern[nk]:=get_fix; krn_ptr:=0;
+while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
+if krn_ptr=nk then begin
+ if nk<max_kerns then incr(nk)
+ else begin
+ err_print('Sorry, too many different kerns for me to handle');
+@.Sorry, too many different kerns...@>
+ decr(krn_ptr);
+ end;
+ end;
+if ofm_level=-1 then begin
+ lig_kern[nl].b2:=kern_flag+(krn_ptr div 256);
+ lig_kern[nl].b3:=krn_ptr mod 256;
+ end
+else begin
+ lig_kern[nl].b2:=kern_flag+(krn_ptr div 65536);
+ lig_kern[nl].b3:=krn_ptr mod 65536;
+ end;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Global...@>=
+@!category_remainders:array[0..256] of integer;
+@!ivalue_category,@!max_ivalue_category:integer;
+@!glue_category,@!max_glue_category:integer;
+@!penalty_category,@!max_penalty_category:integer;
+
+@ @<Set init...@>=
+for ivalue_category:=0 to 256 do begin
+ category_remainders[ivalue_category]:=-1;
+end;
+max_ivalue_category:=-1;
+max_glue_category:=-1;
+max_penalty_category:=-1;
+
+@ @<Read an extended label step@>=
+begin
+c:=get_byte;
+category_remainders[c]:=nl;
+if max_ivalue_category<c then max_ivalue_category:=c;
+if min_nl<=nl then min_nl:=nl+1;
+lk_step_ended:=false;
+end
+
+@ @<Read an extended penalty step@>=
+begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b2:=17;
+penalty_category:=get_byte;
+if max_penalty_category<penalty_category then
+ max_penalty_category:=penalty_category;
+lig_kern[nl].b3:=penalty_category;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read an extended glue step@>=
+begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b2:=18;
+glue_category:=get_byte;
+if max_glue_category<glue_category then
+ max_glue_category:=glue_category;
+lig_kern[nl].b3:=glue_category;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read an extended penalty/glue step@>=
+begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b2:=19;
+penalty_category:=get_byte;
+if max_penalty_category<penalty_category then
+ max_penalty_category:=penalty_category;
+glue_category:=get_byte;
+if max_glue_category<glue_category then
+ max_glue_category:=glue_category;
+lig_kern[nl].b3:=penalty_category*256+glue_category;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read an extended kern step@>=
+begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b2:=20;
+kern[nk]:=get_fix; krn_ptr:=0;
+while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
+if krn_ptr=nk then begin
+ if nk<max_kerns then incr(nk)
+ else begin
+ err_print('Sorry, too many different kerns for me to handle');
+@.Sorry, too many different kerns...@>
+ decr(krn_ptr);
+ end;
+ end;
+if krn_ptr>65535 then
+ err_print('Sorry, too many different kerns for me to handle');
+lig_kern[nl].b3:=krn_ptr;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Globals...@>=
+@!char_extended_tag:array [char_type] of boolean;
+
+@ @<Set init...@>=
+for c:=0 to max_char do
+ char_extended_tag[c]:=false;
+
+@ @<Finish up the extended font stuff@>=
+begin
+if max_penalty_category>0 then begin
+ if nkp=0 then
+ err_print('No PENALTY table')
+ else if npp[0]<max_penalty_category then
+ err_print('Not enough PENALTY entries');
+ end;
+if max_glue_category>0 then begin
+ if nkg=0 then
+ err_print('No GLUE table')
+ else if npg[0]<max_glue_category then
+ err_print('Not enough GLUE entries');
+ end;
+if max_ivalue_category>0 then begin
+ if nki=0 then
+ err_print('No IVALUE table')
+ else if npi[0]<max_ivalue_category then
+ err_print('Not enough IVALUE entries')
+ else begin
+ for c:=0 to max_char do begin
+ if (char_wd[c]<>0) then begin
+ for j:=0 to max_ivalue_category do
+ if char_table[c,0]=j then begin
+ if category_remainders[j]<>-1 then begin
+ if char_tag[c]<>0 then
+ err_print('Character already has a tag')
+ else begin
+ char_extended_tag[c]:=true;
+ char_remainder[c]:=category_remainders[j];
+ end;
+ end;
+ end;
+ end;
+ end;
+ end;
+ end;
+end
+
+@ @<Global...@>=
+tables_read:boolean;
+
+@ @<Set init...@>=
+tables_read:=false;
+
+@ Finally we come to the part of \.{VPtoVF}'s input mechanism
+that is used most, the processing of individual character data.
+
+@<Read character info list@>=
+begin
+if not tables_read then begin
+ @<Compute the new header information for OFM files@>;
+ tables_read:=true;
+ end;
+c:=get_byte; {read the character code that is being specified}
+@<Print |c| in hex notation@>;
+while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then read_character_property
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
+finish_inner_property_list;
+end
+
+@ @<Globals...@>=
+@!char_original:array [0..max_char] of integer;
+@!char_repeats:array [0..max_char] of integer;
+@!diff:boolean;
+@!needed_space,@!extra_bytes:integer;
+
+@ @<Set init...@>=
+for ch_entry:=0 to max_char do begin
+ char_original[ch_entry]:=ch_entry;
+ char_repeats[ch_entry]:=0;
+ end;
+
+@ @<Read repeated character info@>=
+begin
+if not tables_read then begin
+ compute_new_header_ofm;
+ tables_read:=true;
+ end;
+c:=get_byte; {read the character code that is being specified}
+@<Print |c| in hex notation@>;
+crange:=get_byte; {read how many characters are being defined}
+if (crange<0) then begin
+ err_print('Character ranges must be positive');
+ crange:=0;
+ end;
+if ((c+crange)>max_char) then begin
+ err_print('Character range too large');
+ crange:=0;
+ end;
+print('-'); print_hex(c+crange);
+while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then read_character_property
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
+finish_inner_property_list;
+cprime:=c;
+for c:=(cprime+1) to (cprime+crange) do begin
+ char_wd[c]:=char_wd[cprime];
+ char_ht[c]:=char_ht[cprime];
+ char_dp[c]:=char_dp[cprime];
+ char_ic[c]:=char_ic[cprime];
+ for tab:=0 to (nki+nkf+nkr+nkg+nkp-1) do begin
+ char_table[c,tab]:= char_table[cprime,tab];
+ end;
+ end;
+end
+
+@ Tables for character parameters
+
+@d char_param_tables==8
+
+@<Globals...@>=
+@!char_table:array [0..max_char,0..char_param_tables] of integer;
+@!ch_table,@!ch_entry:integer;
+@!temp_value:integer;
+
+@ @<Set init...@>=
+for c:=0 to max_char do
+ for ch_table:=0 to char_param_tables do
+ char_table[c,ch_table]:=0;
+
+@ @<Read a character property@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<char_wd_code) or
+ ((cur_code>var_char_code) and not
+ ((cur_code>=char_ivalue_code) and (cur_code<=char_penalty_code)))
+ then
+ flush_error('This property name doesn''t belong in a CHARACTER list')
+@.This property name doesn't belong...@>
+else begin
+ case cur_code of
+ char_wd_code:char_wd[c]:=sort_in(width,get_fix);
+ char_ht_code:char_ht[c]:=sort_in(height,get_fix);
+ char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
+ char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
+ sec_width_code:temp_value:=get_fix;
+ sec_height_code:temp_value:=get_fix;
+ sec_depth_code:temp_value:=get_fix;
+ sec_italic_code:temp_value:=get_fix;
+ accent_code:temp_value:=get_fix;
+ prim_top_axis_code:temp_value:=get_fix;
+ prim_top_axis_bis_code:temp_value:=get_fix;
+ prim_bot_axis_code:temp_value:=get_fix;
+ prim_bot_axis_bis_code:temp_value:=get_fix;
+ prim_mid_hor_code:temp_value:=get_fix;
+ prim_mid_vert_code:temp_value:=get_fix;
+ prim_base_slant_code:temp_value:=get_fix;
+ sec_top_axis_code:temp_value:=get_fix;
+ sec_top_axis_bis_code:temp_value:=get_fix;
+ sec_bot_axis_code:temp_value:=get_fix;
+ sec_bot_axis_bis_code:temp_value:=get_fix;
+ sec_mid_hor_code:temp_value:=get_fix;
+ sec_mid_vert_code:temp_value:=get_fix;
+ sec_base_slant_code:temp_value:=get_fix;
+ next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
+ char_remainder[c]:=get_byte;
+ end;
+ map_code:read_packet(c);
+ var_char_code:@<Read an extensible recipe for |c|@>;
+ char_ivalue_code: begin
+ ch_table:=get_integer;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkci then nkci:=ch_table;
+ end;
+ char_fvalue_code: begin
+ ch_table:=get_integer+nki;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcf then nkcf:=ch_table;
+ end;
+ char_mvalue_code: begin
+ ch_table:=get_integer+nki+nkf;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcm then nkcm:=ch_table;
+ end;
+ char_rule_code: begin
+ ch_table:=get_integer+nki+nkf+nkm;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcr then nkcr:=ch_table;
+ end;
+ char_glue_code: begin
+ ch_table:=get_integer+nki+nkf+nkm+nkr;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcg then nkcg:=ch_table;
+ end;
+ char_penalty_code: begin
+ ch_table:=get_integer+nki+nkf+nkm+nkr+nkg;
+ ch_entry:=get_integer;
+ char_table[c,ch_table]:=ch_entry;
+ if ch_table>nkcp then nkcp:=ch_table;
+ end;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ @<Read an extensible r...@>=
+begin if ne=xmax_char then
+ err_print('Sorry, too many VARCHAR specs')
+@.Sorry, too many VARCHAR specs@>
+else begin
+ check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
+ exten[ne]:=zero_bytes;
+ while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an extensible piece@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ incr(ne);
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an extensible p...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then
+ flush_error('This property name doesn''t belong in a VARCHAR list')
+@.This property name doesn't belong...@>
+else begin
+ case cur_code-(var_char_code+1) of
+ 0:exten[ne].b0:=get_byte;
+ 1:exten[ne].b1:=get_byte;
+ 2:exten[ne].b2:=get_byte;
+ 3:exten[ne].b3:=get_byte;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ The input routine is now complete except for the following code,
+which prints a progress report as the file is being read.
+
+@ @<Glob...@>=
+@!HEX: packed array [1..32] of char;
+
+@ @<Set init...@>=
+HEX:='0123456789ABCDEF';@/
+
+@ The array |dig| will hold a sequence of digits to be output.
+
+@<Glob...@>=
+@!dig:array[0..32] of integer;
+
+@ Here, in fact, are two procedures that output
+|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
+
+@p procedure out_digs(j:integer); {outputs |j| digits}
+begin repeat decr(j); out(HEX[1+dig[j]]);
+ until j=0;
+end;
+@#
+procedure print_digs(j:integer); {prints |j| digits}
+begin repeat decr(j); print(HEX[1+dig[j]]);
+ until j=0;
+end;
+
+@ The |print_number| procedure indicates how |print_digs| can be used.
+This procedure can print in octal, decimal or hex notation.
+
+@d print_hex(#)==print_number(#,16)
+@d print_octal(#)==print_number(#,8)
+@d print_decimal(#)==print_number(#,10)
+
+@p procedure print_number(c:integer; form:integer); {prints value of
+|c|}
+var j:0..32; {index into |dig|}
+begin
+j:=0;
+if (c<0) then begin
+ print_ln('Internal error: print_number (negative value)');
+ c:=0;
+ end;
+if form=8 then
+ print('''') {an apostrophe indicates the octal notation}
+else if form=16 then
+ print('"') { a double apostrophe indicates the hexadecimal
+notation}
+else if form<>10 then begin
+ print_ln('Internal error: print_number (form)');
+ form:=16;
+ end;
+while (c>0) or (j=0) do begin
+ dig[j]:=c mod form; c:=c div form;
+ j:=j+1;
+ end;
+print_digs(j);
+end;
+
+@ @<Print |c| in hex...@>=
+begin if chars_on_line=8 then begin
+ print_ln(' '); chars_on_line:=1;
+ end
+else begin
+ if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+print_hex(c); {progress report}
+end
+
+
+@* Assembling the mappings.
+Each \.{MAP} property is a sequence of \.{DVI} instructions, for which
+we need to know some of the opcodes.
+We add afterwards the definitions for outputting typesetting commands.
+
+@d set_char_0=0 {\.{DVI} command to typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d Incr_Decr(#) == #
+@d Incr(#) == #:=#+Incr_Decr {increase a variable}
+
+@d out_four(#) ==
+if x>=0 then #(x div @"1000000)
+else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
+ #((x div @"1000000) + 128);
+ end;
+x:=x mod @"1000000; #(x div @"10000);
+x:=x mod @"10000; #(x div @"100);
+#(x mod @"100)
+
+@d out_cmd(#) ==
+if (x<@"100)and(x>=0) then begin
+ if (o<>set1)or(x>127) then
+ if (o=fnt1)and(x<64) then Incr(x)(fnt_num_0) @+ else #(o);
+ end
+else begin
+ if (x<@"10000)and(x>=0) then #(o+1) @+ else begin
+ if (x<@"1000000)and(x>=0) then #(o+2) @+ else begin
+ #(o+3);
+ if x>=0 then #(x div @"1000000)
+ else begin
+ Incr(x)(@"40000000); Incr(x)(@"40000000);
+ #((x div @"1000000) + 128); x:=x mod @"1000000;
+ end;
+ #(x div @"10000); x:=x mod @"10000;
+ end;
+ #(x div @"10000); x:=x mod @"10000;
+ end;
+ #(x div @"100); x:=x mod @"100;
+ end;
+#(x)
+
+@p
+procedure vf_store_set(@!x:integer);
+var @!o:byte;
+begin o:=set1; out_cmd(vf_store);
+end;
+
+procedure vfout_set(@!x:integer);
+var @!o:byte;
+begin o:=set1; out_cmd(vout);
+end;
+
+procedure vf_store_fnt(@!x:integer);
+var @!o:byte;
+begin o:=fnt1; out_cmd(vf_store);
+end;
+
+procedure vfout_fntdef(@!x:integer);
+var @!o:byte;
+begin o:=fnt_def1; out_cmd(vout);
+end;
+
+procedure vfout_char(@!x:integer);
+begin out_four(vout);
+end;
+
+
+@ We keep stacks of movement values, in order to optimize the \.{DVI} code
+in simple cases.
+
+@<Glob...@>=
+@!hstack:array[0..max_stack] of 0..2; {number of known horizontal movements}
+@!vstack:array[0..max_stack] of 0..2; {number of known vertical movements}
+@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of fix_word;
+@!stack_ptr:0..max_stack;
+
+@ The packet is built by straightforward assembly of \.{DVI} instructions.
+
+@p @<Declare the |vf_fix| procedure@>@;@/
+procedure read_packet(@!c:byte);
+var @!cc:char_type; {character being typeset}
+@!x:fix_word; {movement}
+@!h,@!v:0..2; {top of |hstack| and |vstack|}
+@!special_start:0..vf_size; {location of |xxx1| command}
+@!k:0..vf_size; {loop index}
+begin packet_start[c]:=vf_ptr; stack_ptr:=0; h:=0; v:=0;
+cur_font:=0;
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read and assemble a list of \.{DVI} commands@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+while stack_ptr>0 do begin
+ err_print('Missing POP supplied');
+@.Missing POP supplied@>
+ vf_store(pop); decr(stack_ptr);
+ end;
+packet_length[c]:=vf_ptr-packet_start[c];
+finish_inner_property_list;
+end;
+
+@ @<Read and assemble a list of \.{DVI}...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<select_font_code)or(cur_code>special_hex_code) then
+ flush_error('This property name doesn''t belong in a MAP list')
+@.This property name doesn't belong...@>
+else begin
+ case cur_code of
+ select_font_code:@<Assemble a font selection@>;
+ set_char_code:@<Assemble a typesetting instruction@>;
+ set_rule_code:@<Assemble a rulesetting instruction@>;
+ move_right_code,move_right_code+1:@<Assemble a horizontal movement@>;
+ move_down_code,move_down_code+1:@<Assemble a vertical movement@>;
+ push_code:@<Assemble a stack push@>;
+ pop_code:@<Assemble a stack pop@>;
+ special_code,special_hex_code:@<Assemble a special command@>;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ @<Assemble a font selection@>=
+begin font_number[font_ptr]:=get_integer;
+cur_font:=0;
+while font_number[font_ptr]<>font_number[cur_font] do incr(cur_font);
+if cur_font=font_ptr then err_print('Undefined MAPFONT cannot be selected')
+@.Undefined MAPFONT...@>
+else vf_store_fnt(cur_font);
+end
+
+@ @<Assemble a typesetting instruction@>=
+if cur_font=font_ptr then
+ err_print('Character cannot be typeset in undefined font')
+@.Character cannot be typeset...@>
+else begin
+ cc:=get_byte; vf_store_set(cc);
+ end
+
+@ Here's a procedure that converts a |fix_word| to a sequence of
+\.{DVI} bytes.
+
+@<Declare the |vf_fix|...@>=
+procedure vf_fix(@!opcode:byte;@!x:fix_word);
+var negative:boolean;
+@!k:0..4; {number of bytes to typeset}
+@!t:integer; {threshold}
+begin frozen_du:=true;
+if design_units<>unity then x:=round((x/design_units)*1048576.0);
+if x>0 then negative:=false
+else begin negative:=true; x:=-1-x;@+end;
+if opcode=0 then begin
+ k:=4; t:=@'100000000;@+end
+else begin
+ t:=127; k:=1;
+ while x>t do begin
+ t:=256*t+255; incr(k);
+ end;
+ vf_store(opcode+k-1); t:=t div 128 +1;
+ end;
+repeat if negative then begin
+ vf_store(255-(x div t)); negative:=false;
+ x:=(x div t)*t+t-1-x;
+ end
+else vf_store((x div t) mod 256);
+decr(k); t:=t div 256;
+until k=0;
+end;
+
+@ @<Assemble a rulesetting instruction@>=
+begin vf_store(set_rule); vf_fix(0,get_fix); vf_fix(0,get_fix);
+end
+
+@ @<Assemble a horizontal movement@>=
+begin if cur_code=move_right_code then x:=get_fix@+else x:=-get_fix;
+if h=0 then begin
+ wstack[stack_ptr]:=x; h:=1; vf_fix(w1,x);@+end
+else if x=wstack[stack_ptr] then vf_store(w0)
+else if h=1 then begin
+ xstack[stack_ptr]:=x; h:=2; vf_fix(x1,x);@+end
+else if x=xstack[stack_ptr] then vf_store(x0)
+else vf_fix(right1,x);
+end
+
+@ @<Assemble a vertical movement@>=
+begin if cur_code=move_down_code then x:=get_fix@+else x:=-get_fix;
+if v=0 then begin
+ ystack[stack_ptr]:=x; v:=1; vf_fix(y1,x);@+end
+else if x=ystack[stack_ptr] then vf_store(y0)
+else if v=1 then begin
+ zstack[stack_ptr]:=x; v:=2; vf_fix(z1,x);@+end
+else if x=zstack[stack_ptr] then vf_store(z0)
+else vf_fix(down1,x);
+end
+
+@ @<Assemble a stack push@>=
+if stack_ptr=max_stack then {too pushy}
+ err_print('Don''t push so much---stack is full!')
+@.Don't push so much...@>
+else begin
+ vf_store(push); hstack[stack_ptr]:=h; vstack[stack_ptr]:=v;
+ incr(stack_ptr); h:=0; v:=0;
+ end
+
+@ @<Assemble a stack pop@>=
+if stack_ptr=0 then
+ err_print('Empty stack cannot be popped')
+@.Empty stack...@>
+else begin
+ vf_store(pop); decr(stack_ptr);
+ h:=hstack[stack_ptr]; v:=vstack[stack_ptr];
+ end
+
+@ @<Assemble a special command@>=
+begin vf_store(xxx1); vf_store(0); {dummy length}
+special_start:=vf_ptr;
+if cur_code=special_code then copy_to_end_of_item
+else begin
+ repeat x:=get_hex;
+ if cur_char>")" then vf_store(x*16+get_hex);
+ until cur_char<=")";
+ end;
+if vf_ptr-special_start>255 then @<Convert |xxx1| command to |xxx4|@>
+else vf[special_start-1]:=vf_ptr-special_start;
+end
+
+@ @<Convert |xxx1|...@>=
+if vf_ptr+3>vf_size then begin
+ err_print('Special command being clipped---no room left!');
+@.Special command being clipped...@>
+ vf_ptr:=special_start+255; vf[special_start-1]:=255;
+ end
+else begin
+ for k:=vf_ptr downto special_start do vf[k+3]:=vf[k];
+ x:=vf_ptr-special_start; vf_ptr:=vf_ptr+3;
+ vf[special_start-2]:=xxx4;
+ vf[special_start-1]:=x div @'100000000;
+ vf[special_start]:=(x div @'200000) mod 256;
+ vf[special_start+1]:=(x div @'400) mod 256;
+ vf[special_start+2]:=x mod 256;
+ end
+
+@* The checking and massaging phase.
+Once the whole \.{VPL} file has been read in, we must check it for consistency
+and correct any errors. This process consists mainly of running through
+the characters that exist and seeing if they refer to characters that
+don't exist. We also compute the true value of |seven_unsafe|; we make sure
+that the charlists and ligature programs contain no loops; and we
+shorten the lists of widths, heights, depths, and italic corrections,
+if necessary, to keep from exceeding the required maximum sizes.
+
+@<Glob...@>=
+@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?}
+
+@ @<Correct and check the information@>=
+if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>;
+seven_unsafe:=false;
+for c:=0 to max_char do if char_wd[c]<>0 then
+ @<For all characters |g| generated by |c|,
+ make sure that |char_wd[g]| is nonzero, and
+ set |seven_unsafe| if |c<128<=g|@>;
+if bchar_label<xmax_label then begin
+ c:=xmax_char; @<Check ligature program of |c|@>;
+ end;
+if seven_bit_safe_flag and seven_unsafe then
+ print_ln('The font is not really seven-bit-safe!');
+@.The font is not...safe@>
+@<Check for infinite ligature loops@>;
+@<Doublecheck the lig/kern commands and the extensible recipes@>;
+finish_extended_font;
+for c:=0 to max_char do
+ @<Make sure that |c| is not the largest element of a charlist cycle@>;
+@<Put the width, height, depth, and italic lists into final form@>
+
+@ The checking that we need in several places is accomplished by three
+macros that are only slightly tricky.
+
+@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0);
+ print(#,' '); print_hex(c);
+ print_ln(' had no CHARACTER spec.');
+ end;
+ end
+@d check_existence_and_safety(#)==begin g:=#;
+ if (g>=128)and(c<128) then seven_unsafe:=true;
+ if char_wd[g]=0 then existence_tail
+@d check_existence(#)==begin g:=#;
+ if char_wd[g]=0 then existence_tail
+
+@<For all characters |g| generated by |c|...@>=
+case char_tag[c] of
+no_tag: do_nothing;
+lig_tag: @<Check ligature program of |c|@>;
+list_tag: check_existence_and_safety(char_remainder[c])
+ ('The character NEXTLARGER than');
+@.The character NEXTLARGER...@>
+ext_tag:@<Check the pieces of |exten[c]|@>;
+end
+
+@ @<Check the pieces...@>=
+begin if exten[char_remainder[c]].b0>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b0)
+ ('TOP piece of character');
+@.TOP piece of character...@>
+if exten[char_remainder[c]].b1>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b1)
+ ('MID piece of character');
+@.MID piece of character...@>
+if exten[char_remainder[c]].b2>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b2)
+ ('BOT piece of character');
+@.BOT piece of character...@>
+check_existence_and_safety(exten[char_remainder[c]].b3)
+ ('REP piece of character');
+@.REP piece of character...@>
+end
+
+@ @<Make sure that |c| is not the largest element of a charlist cycle@>=
+if char_tag[c]=list_tag then begin
+ g:=char_remainder[c];
+ while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g];
+ if g=c then begin
+ char_tag[c]:=no_tag;
+ print('A cycle of NEXTLARGER characters has been broken at ');
+@.A cycle of NEXTLARGER...@>
+ print_hex(c); print_ln('.');
+ end;
+ end
+
+@ @<Glob...@>=
+@!delta:fix_word; {size of the intervals needed for rounding}
+
+@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
+@.I had to round...@>
+ #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
+
+@<Put the width, height, depth, and italic lists into final form@>=
+case ofm_level of
+ -1: begin
+ top_width:=255; top_depth:=15; top_height:=15; top_italic:=63;
+ end;
+ 0: begin
+ top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255;
+ end;
+ 1: begin
+ top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255;
+ end;
+ end;
+delta:=shorten(width,max_width); set_indices(width,delta);
+ round_message('width');@/
+delta:=shorten(height,max_height); set_indices(height,delta);
+ round_message('height');@/
+delta:=shorten(depth,max_depth); set_indices(depth,delta);
+ round_message('depth');@/
+delta:=shorten(italic,max_italic); set_indices(italic,delta);
+ round_message('italic correction');
+
+@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}}
+ lig_kern[nl].b0:=255; lig_kern[nl].b1:=0;
+ lig_kern[nl].b2:=0; lig_kern[nl].b3:=0
+
+@<Make sure the ligature/kerning program ends...@>=
+begin if bchar_label<xmax_label then begin {make room for it}
+ clear_lig_kern_entry; incr(nl);
+ end; {|bchar_label| will be stored later}
+while min_nl>nl do begin
+ clear_lig_kern_entry; incr(nl);
+ end;
+if (lig_kern[nl-1].b0 mod 256)=0 then
+ lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
+end
+
+@ It's not trivial to check for infinite loops generated by repeated
+insertion of ligature characters. But fortunately there is a nice
+algorithm for such testing, copied here from the program \.{TFtoPL}
+where it is explained further.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+
+@ @<Glo...@>=
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!hash:array[0..hash_size] of integer;
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of xxchar_type;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!tt:indx; {temporary register}
+@!x_lig_cycle,@!y_lig_cycle:xchar_type; {problematic ligature pair}
+
+@ @<Set init...@>=
+hash_ptr:=0; y_lig_cycle:=xmax_char;
+for k:=0 to hash_size do hash[k]:=0;
+
+@ @d lig_exam==lig_kern[lig_ptr].b1
+@d lig_gen==lig_kern[lig_ptr].b3
+
+@<Check lig...@>=
+begin lig_ptr:=char_remainder[c];
+repeat if hash_input(lig_ptr,c) then begin
+ if lig_kern[lig_ptr].b2<kern_flag then begin
+ if lig_exam<>bchar then
+ check_existence(lig_exam)('LIG character examined by');
+@.LIG character examined...@>
+ check_existence(lig_gen)('LIG character generated by');
+@.LIG character generated...@>
+ if lig_gen>=128 then if(c<128)or(c=bchar) then
+ if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true;
+ end
+ else if lig_exam<>bchar then
+ check_existence(lig_exam)('KRN character examined by');
+@.KRN character examined...@>
+ end;
+if (lig_kern[lig_ptr].b0 mod 256)>=stop_flag then lig_ptr:=nl
+else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0;
+until lig_ptr>=nl;
+end
+
+@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made
+into a boolean function that returns |false| if the ligature command
+was masked by a previous one.
+
+@p function hash_input(@!p,@!c:indx):boolean;
+ {enter data for character |c| and command in location |p|, unless it isn't new}
+label 30; {go here for a quick exit}
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:char_type; {function value or ligature character being entered}
+@!y:char_type; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then
+ begin hash_input:=false; goto 30;@+end;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
+while hash[h]>0 do begin
+ if hash[h]<=key then begin
+ if hash[h]=key then begin
+ hash_input:=false; goto 30; {unused ligature command}
+ end;
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+hash_input:=true;
+30:end;
+
+@ @<Compute the command param...@>=
+y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple;
+zz:=lig_kern[p].b3;
+if t>=kern_flag then zz:=y
+else begin
+ case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ (More good stuff from \.{TFtoPL}.)
+
+@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=xmax_char*x+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:indx):indx| here.
+
+@p function f;
+begin case class[h] of
+ simple: do_nothing;
+ left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+ right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+ both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+ pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
+ lig_z[h]:=xxmax_char; class[h]:=simple;
+ end; {the value |xxmax_char| will break all cycles, since it's not in |hash|}
+ end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@ @<Check for infinite...@>=
+if hash_ptr<hash_size then for hh:=1 to hash_ptr do begin
+ tt:=hash_list[hh];
+ if class[tt]>simple then {make sure $f$ is well defined}
+ tt:=f(tt,(hash[tt]-1)div xmax_char,(hash[tt]-1)mod xmax_char);
+ end;
+if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then begin
+ if hash_ptr<hash_size then begin
+ print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=xmax_char
+ then print('boundary')@+else print_hex(x_lig_cycle);
+ print(' and '); print_hex(y_lig_cycle); print_ln('!');
+ end
+ else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ print_ln('All ligatures will be cleared.');
+ for c:=0 to max_char do if char_tag[c]=lig_tag then begin
+ char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+ nl:=0; bchar:=xmax_char; bchar_label:=xmax_label;
+ end
+
+@ The lig/kern program may still contain references to nonexistent characters,
+if parts of that program are never used. Similarly, there may be extensible
+characters that are never used, because they were overridden by
+\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we
+must fix such errors.
+
+@d double_check_tail(#)==@t\1@>if char_wd[0]=0
+ then char_wd[0]:=sort_in(width,0);
+ print('Unused ',#,' refers to nonexistent character ');
+ print_hex(c); print_ln('!');
+ end;
+ end
+@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#;
+ if char_wd[c]=0 then if c<>bchar then
+ begin lig_kern[lig_ptr].#:=0; double_check_tail
+@d double_check_ext(#)==begin c:=exten[g].#;
+ if c>0 then if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+@d double_check_rep(#)==begin c:=exten[g].#;
+ if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+
+@<Doublecheck...@>=
+if nl>0 then for lig_ptr:=0 to nl-1 do
+ if (lig_kern[lig_ptr].b0 div 256)=0 then begin
+ if lig_kern[lig_ptr].b2<kern_flag then begin
+ if lig_kern[lig_ptr].b0<255 then begin
+ double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
+ end;
+ end
+ else double_check_lig(b1)('KRN step');
+ end;
+@.Unused LIG step...@>
+@.Unused KRN step...@>
+if ne>0 then for g:=0 to ne-1 do begin
+ double_check_ext(b0)('VARCHAR TOP');
+ double_check_ext(b1)('VARCHAR MID');
+ double_check_ext(b2)('VARCHAR BOT');
+ double_check_rep(b3)('VARCHAR REP');
+@.Unused VARCHAR...@>
+ end
+
+@* The TFM output phase.
+Now that we know how to get all of the font data correctly stored in
+\.{VPtoVF}'s memory, it only remains to write the answers out.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{TFM} file:
+
+@d out(#)==write(tfm_file,#)
+
+@p procedure out_int(@!x:integer);
+begin out_four(out);
+end;
+
+
+@ The general plan for producing \.{TFM} files is long but simple:
+
+@<Do the font metric output@>=
+compute_subfile_sizes;
+output_subfile_sizes;
+@<Output the header block@>;
+output_new_information_ofm;
+output_character_info;
+@<Output the dimensions themselves@>;
+@<Output the ligature/kern program@>;
+@<Output the extensible character recipes@>;
+@<Output the parameters@>
+
+@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are.
+We already know most of these numbers; for example, the number of distinct
+widths is |memory[width]+1|, where the $+1$ accounts for the zero width that
+is always supposed to be present. But we still should compute the beginning
+and ending character codes (|bc| and |ec|), the number of header words (|lh|),
+and the total number of words in the \.{TFM} file (|lf|).
+
+@<Gl...@>=
+@!bc:char_type; {the smallest character code in the font}
+@!ec:char_type; {the largest character code in the font}
+@!lh:char_type; {the number of words in the header block}
+@!lf:unsigned_integer; {the number of words in the entire \.{TFM} file}
+@!not_found:boolean; {has a font character been found?}
+@!temp_width:fix_word; {width being used to compute a check sum}
+@!ncw,@!nco,@!npc:integer;
+
+@ It might turn out that no characters exist at all. But \.{VPtoVF} keeps
+going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
+will be~1.
+
+@<Compute the subfile sizes@>=
+case ofm_level of
+ -1: begin
+ lh:=header_ptr div 4;@/
+ not_found:=true; bc:=0;
+ while not_found do
+ if (char_wd[bc]>0)or(bc=255) then not_found:=false
+ else incr(bc);
+ not_found:=true; ec:=255;
+ while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+ if bc>ec then bc:=1;
+ incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+ incr(memory[italic]);@/
+ @<Compute the ligature/kern program offset@>;
+ lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+ memory[italic]+nl+lk_offset+nk+ne+np;
+ end;
+ 0: begin
+ lh:=header_ptr div 4;@/
+ not_found:=true; bc:=0;
+ while not_found do
+ if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
+ else incr(bc);
+ not_found:=true; ec:=max_char;
+ while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+ if bc>ec then bc:=1;
+ incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+ incr(memory[italic]);@/
+ @<Compute the ligature/kern program offset@>;
+ lf:=14+lh+2*(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+ memory[italic]+2*nl+lk_offset+nk+2*ne+np;
+ end;
+ 1: begin
+ lh:=header_ptr div 4;@/
+ not_found:=true; bc:=0;
+ while not_found do
+ if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
+ else incr(bc);
+ not_found:=true; ec:=max_char;
+ while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+ if bc>ec then bc:=1;
+ incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+ incr(memory[italic]);@/
+ @<Compute the ligature/kern program offset@>;
+ @<Compute the character info size@>;
+ lf:=29+lh+ncw+memory[width]+memory[height]+memory[depth]+
+ memory[italic]+2*(nl+lk_offset)+nk+2*ne+np+
+ nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp;
+ nco:=29+lh+nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp;
+ end;
+ end;
+
+@ @d out_size(#)==out((#) div 256); out((#) mod 256)
+ @d out_integer(#)==out((#) div @"1000000);
+ out(((#) mod @"1000000) div @"10000);
+ out(((#) mod @"10000) div @"100);
+ out((#) mod @"100)
+
+@<Output the subfile sizes@>=
+case ofm_level of
+ -1: begin
+ out_size(lf); out_size(lh); out_size(bc); out_size(ec);
+ out_size(memory[width]); out_size(memory[height]);
+ out_size(memory[depth]); out_size(memory[italic]);
+ out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np);
+ end;
+ 0: begin
+ out_integer(0);
+ out_integer(lf); out_integer(lh); out_integer(bc); out_integer(ec);
+ out_integer(memory[width]); out_integer(memory[height]);
+ out_integer(memory[depth]); out_integer(memory[italic]);
+ out_integer(nl+lk_offset); out_integer(nk);
+ out_integer(ne); out_integer(np); out_integer(font_dir);
+ end;
+ 1: begin
+ out_integer(1);
+ out_integer(lf); out_integer(lh);
+ out_integer(bc); out_integer(ec);
+ out_integer(memory[width]); out_integer(memory[height]);
+ out_integer(memory[depth]); out_integer(memory[italic]);
+ out_integer(nl+lk_offset); out_integer(nk);
+ out_integer(ne); out_integer(np); out_integer(font_dir);
+ out_integer(nco); out_integer(ncw); out_integer(npc);
+ out_integer(nki); out_integer(nwi); out_integer(nkf); out_integer(nwf);
+ out_integer(nkm); out_integer(nwm); out_integer(nkr); out_integer(nwr);
+ out_integer(nkg); out_integer(nwg); out_integer(nkp); out_integer(nwp);
+ end;
+ end;
+
+@ The routines that follow need a few temporary variables of different types.
+
+@<Gl...@>=
+@!j:0..max_header_bytes; {index into |header_bytes|}
+@!p:pointer; {index into |memory|}
+@!q:width..italic; {runs through the list heads for dimensions}
+@!par_ptr:0..max_param_words; {runs through the parameters}
+
+@ The header block follows the subfile sizes. The necessary information all
+appears in |header_bytes|, except that the design size and the seven-bit-safe
+flag must still be set.
+
+@<Output the header block@>=
+if not check_sum_specified then @<Compute the check sum@>;
+header_bytes[design_size_loc]:=design_size div @'100000000;
+ {this works since |design_size>0|}
+header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256;
+header_bytes[design_size_loc+2]:=(design_size div 256) mod 256;
+header_bytes[design_size_loc+3]:=design_size mod 256;
+if not seven_unsafe then header_bytes[seven_flag_loc]:=128;
+for j:=0 to header_ptr-1 do out(header_bytes[j]);
+
+@ @<Compute the check sum@>=
+begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
+for c:=bc to ec do if char_wd[c]>0 then begin
+ temp_width:=memory[char_wd[c]];
+ if design_units<>unity then
+ temp_width:=round((temp_width/design_units)*1048576.0);
+ temp_width:=temp_width + (c+4)*@'20000000; {this should be positive}
+ c0:=(c0+c0+temp_width) mod 255;
+ c1:=(c1+c1+temp_width) mod 253;
+ c2:=(c2+c2+temp_width) mod 251;
+ c3:=(c3+c3+temp_width) mod 247;
+ end;
+header_bytes[check_sum_loc]:=c0;
+header_bytes[check_sum_loc+1]:=c1;
+header_bytes[check_sum_loc+2]:=c2;
+header_bytes[check_sum_loc+3]:=c3;
+end
+
+@ @<Global...@>=
+@!tab:integer;
+
+@
+@<Compute the character info size@>=
+if ofm_level=1 then begin
+ ncw:=0;
+ if nkcp>-1 then
+ npc:=nki+nkf+nkr+nkg+nkcp+1
+ else if nkcg>-1 then
+ npc:=nki+nkf+nkr+nkcg+1
+ else if nkcr>-1 then
+ npc:=nki+nkf+nkcr+1
+ else if nkcf>-1 then
+ npc:=nki+nkcf+1
+ else if nkci>-1 then
+ npc:=nkci+1
+ else
+ npc:=0;
+ needed_space:=(12+npc*2) div 4;
+ extra_bytes:=(needed_space*4) - (10+npc*2);
+ for c:=bc to ec do begin
+ if char_original[c]=c then begin
+ cprime:=c+1;
+ diff:=false;
+ while (not diff) and (cprime<=ec) do begin
+ if index[char_wd[c]]<>index[char_wd[cprime]] then diff:=true;
+ if index[char_ht[c]]<>index[char_ht[cprime]] then diff:=true;
+ if index[char_dp[c]]<>index[char_dp[cprime]] then diff:=true;
+ if index[char_ic[c]]<>index[char_ic[cprime]] then diff:=true;
+ if char_remainder[c]<>char_remainder[cprime] then diff:=true;
+ for tab:=0 to npc-1 do begin
+ if char_table[c,tab]<>char_table[cprime,tab] then diff:=true;
+ end;
+ if not diff then begin
+ char_original[cprime]:=c;
+ cprime:=cprime+1;
+ end;
+ end;
+ if cprime>(c+1) then begin
+ char_repeats[c]:=cprime-c-1;
+ end;
+ ncw:=ncw+needed_space;
+ end;
+ end;
+ end;
+
+@ The next block contains packed |char_info|.
+
+@d out_two(#)==out((#) div 256); out((#) mod 256)
+
+@d out_three(#)==out((#) div 65536); out_two((#) mod 65536)
+
+
+@<Output the character info@>=
+index[0]:=0;
+for c:=bc to ec do
+case ofm_level of
+ -1: begin
+ out(index[char_wd[c]]);
+ out(index[char_ht[c]]*16+index[char_dp[c]]);
+ out(index[char_ic[c]]*4+char_tag[c]);
+ out(char_remainder[c]);
+ end;
+ 0: begin
+ out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256);
+ out(index[char_ht[c]]); out(index[char_dp[c]]);
+ out(index[char_ic[c]] div 64);out((index[char_ic[c]] mod 64)*4+char_tag[c]);
+ out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
+ end;
+ 1: begin
+ if c=char_original[c] then begin
+ out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256);
+ out(index[char_ht[c]]); out(index[char_dp[c]]);
+ out(index[char_ic[c]]);
+ tab:=char_tag[c];
+ if char_extended_tag[c] then begin
+ tab:=5;
+ end;
+ out(tab);
+ out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
+ out_size(char_repeats[c]);
+ for tab:=0 to npc-1 do begin
+ out(char_table[c,tab] div 256); out(char_table[c,tab] mod 256);
+ end;
+ for tab:=1 to extra_bytes do begin
+ out(0);
+ end;
+ end;
+ end;
+ end;
+
+@ When a scaled quantity is output, we may need to divide it by |design_units|.
+The following subroutine takes care of this, using floating point arithmetic
+only if |design_units<>1.0|.
+
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if abs(x/design_units)>=16.0 then begin
+ print_ln('The relative dimension ',x/@'4000000:1:3,
+ ' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then print(' =',design_units/@'200000:1:3,
+ ' designunits');
+ print_ln(')'); x:=0;
+ end;
+if design_units<>unity then x:=round((x/design_units)*1048576.0);
+if x<0 then begin
+ out(255); x:=x+@'100000000;
+ if x<=0 then x:=1;
+ end
+else begin
+ out(0);
+ if x>=@'100000000 then x:=@'77777777;
+ end;
+n:=x div @'200000; m:=x mod @'200000;
+out(n); out(m div 256); out(m mod 256);
+end;
+
+@ We have output the packed indices for individual characters.
+The scaled widths, heights, depths, and italic corrections are next.
+
+@<Output the dimensions themselves@>=
+for q:=width to italic do begin
+ out(0); out(0); out(0); out(0); {output the zero word}
+ p:=link[q]; {head of list}
+ while p>0 do begin
+ out_scaled(memory[p]);
+ p:=link[p];
+ end;
+ end;
+
+@ One embarrassing problem remains: The ligature/kern program might be very
+long, but the starting addresses in |char_remainder| can be at most~65535.
+Therefore we need to output some indirect address information; we want to
+compute |lk_offset| so that addition of |lk_offset| to all remainders makes
+all but |lk_offset| distinct remainders less than~65536.
+
+For this we need a sorted table of all relevant remainders.
+
+@<Glob...@>=
+@!label_table:array[xchar_type] of record
+ @!rr: -1..xmax_label; {sorted label values}
+ @!cc: char_type; {associated characters}
+ end;
+@!label_ptr:xchar_type; {index of highest entry in |label_table|}
+@!sort_ptr:xchar_type; {index into |label_table|}
+@!lk_offset:xchar_type; {smallest offset value that might work}
+@!t:0..xmax_label; {label value that is being redirected}
+@!extra_loc_needed:boolean; {do we need a special word for |bchar|?}
+
+@ @<Compute the ligature/kern program offset@>=
+@<Insert all labels into |label_table|@>;
+if bchar<xmax_char then begin
+ extra_loc_needed:=true; lk_offset:=1;
+ end
+else begin
+ extra_loc_needed:=false; lk_offset:=0;
+ end;
+@<Find the minimum |lk_offset| and adjust all remainders@>;
+if bchar_label<xmax_label then begin
+ lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 65536;
+ lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 65536;
+ end
+
+@ @<Insert all labels...@>=
+label_ptr:=0; label_table[0].rr:=-1; {sentinel}
+for c:=bc to ec do if char_tag[c]=lig_tag then begin
+ sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+ while label_table[sort_ptr].rr>char_remainder[c] do begin
+ label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+ label_table[sort_ptr+1].cc:=c;
+ label_table[sort_ptr+1].rr:=char_remainder[c];
+ incr(label_ptr);
+ end
+
+@ @<Find the minimum |lk_offset| and adjust all remainders@>=
+begin sort_ptr:=label_ptr; {the largest unallocated label}
+if ofm_level=-1 then begin
+ if label_table[sort_ptr].rr+lk_offset > 255 then begin
+ lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
+ repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin
+ decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ end;
+ incr(lk_offset); decr(sort_ptr);
+ until lk_offset+label_table[sort_ptr].rr<256;
+ {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|}
+ end;
+ end
+else begin
+ if label_table[sort_ptr].rr+lk_offset > 65535 then begin
+ lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
+ repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin
+ decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ end;
+ incr(lk_offset); decr(sort_ptr);
+ until lk_offset+label_table[sort_ptr].rr<65536;
+ {N.B.: |lk_offset=65536| satisfies this when |sort_ptr=0|}
+ end;
+ end;
+if lk_offset>0 then
+ while sort_ptr>0 do begin
+ char_remainder[label_table[sort_ptr].cc]:=
+ char_remainder[label_table[sort_ptr].cc]+lk_offset;
+ decr(sort_ptr);
+ end;
+end
+
+@ @<Output the ligature/kern program@>=
+if ofm_level=-1 then begin
+ if extra_loc_needed then begin {|lk_offset=1|}
+ out(255); out(bchar); out(0); out(0);
+ end
+ else for sort_ptr:=1 to lk_offset do begin {output the redirection specs}
+ t:=label_table[label_ptr].rr;
+ if bchar<256 then begin
+ out(255); out(bchar);
+ end
+ else begin
+ out(254); out(0);
+ end;
+ out_size(t+lk_offset);
+ repeat decr(label_ptr); until label_table[label_ptr].rr<t;
+ end;
+ if nl>0 then for lig_ptr:=0 to nl-1 do begin
+ out(lig_kern[lig_ptr].b0);
+ out(lig_kern[lig_ptr].b1);
+ out(lig_kern[lig_ptr].b2);
+ out(lig_kern[lig_ptr].b3);
+ end;
+ if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
+ end
+else begin
+ if extra_loc_needed then begin {|lk_offset=1|}
+ out_size(255); out_size(bchar); out_size(0); out_size(0);
+ end
+ else for sort_ptr:=1 to lk_offset do begin {output the redirection specs}
+ t:=label_table[label_ptr].rr;
+ if bchar<xmax_char then begin
+ out_size(255); out_size(bchar);
+ end
+ else begin
+ out_size(254); out_size(0);
+ end;
+ out_size((t+lk_offset) div 256);
+ out_size((t+lk_offset) mod 256);
+ repeat decr(label_ptr); until label_table[label_ptr].rr<t;
+ end;
+ if nl>0 then for lig_ptr:=0 to nl-1 do begin
+ out_size(lig_kern[lig_ptr].b0);
+ out_size(lig_kern[lig_ptr].b1);
+ out_size(lig_kern[lig_ptr].b2);
+ out_size(lig_kern[lig_ptr].b3);
+ end;
+ if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
+ end
+
+@ @<Output the extensible character recipes@>=
+if ofm_level=-1 then begin
+ if ne>0 then for c:=0 to ne-1 do begin
+ out(exten[c].b0);
+ out(exten[c].b1);
+ out(exten[c].b2);
+ out(exten[c].b3);
+ end;
+ end
+else begin
+ if ne>0 then for c:=0 to ne-1 do begin
+ out_size(exten[c].b0);
+ out_size(exten[c].b1);
+ out_size(exten[c].b2);
+ out_size(exten[c].b3);
+ end;
+ end;
+
+@ For our grand finale, we wind everything up by outputting the parameters.
+
+@<Output the parameters@>=
+for par_ptr:=1 to np do begin
+ if par_ptr=1 then
+ @<Output the slant (|param[1]|) without scaling@>
+ else out_scaled(param[par_ptr]);
+ end
+
+@ @<Output the slant...@>=
+begin if param[1]<0 then begin
+ param[1]:=param[1]+@'10000000000;
+ out((param[1] div @'100000000)+256-64);
+ end
+else out(param[1] div @'100000000);
+out((param[1] div @'200000) mod 256);
+out((param[1] div 256) mod 256);
+out(param[1] mod 256);
+end
+
+@* The VF output phase.
+Output to |vf_file| is considerably simpler.
+
+@d id_byte=202 {current version of \.{VF} format}
+@d vout(#)==write(vf_file,#)
+
+@<Glob...@>=
+@!vcount:integer; {number of bytes written to |vf_file|}
+
+@ We need a routine to output integers as four bytes. Negative values
+will never be less than $-2^{24}$.
+
+@p procedure vout_int(@!x:integer);
+begin if x>=0 then vout(x div @'100000000)
+else begin
+ vout(255); x:=x+@'100000000;
+ end;
+vout((x div @'200000) mod 256);
+vout((x div @'400) mod 256); vout(x mod 256);
+end;
+
+@ @<Do the \.{VF} output@>=
+vout(pre); vout(id_byte); vout(vtitle_length);
+for k:=0 to vtitle_length-1 do vout(vf[vtitle_start+k]);
+for k:=check_sum_loc to design_size_loc+3 do vout(header_bytes[k]);
+vcount:=vtitle_length+11;
+for cur_font:=0 to font_ptr-1 do @<Output a local font definition@>;
+for c:=bc to ec do if char_wd[c]>0 then
+ @<Output a packet for character |c|@>;
+repeat vout(post); incr(vcount);
+until vcount mod 4 = 0
+
+@ @<Output a local font definition@>=
+begin vfout_fntdef(cur_font);@/
+vout(font_checksum[cur_font].b0);
+vout(font_checksum[cur_font].b1);
+vout(font_checksum[cur_font].b2);
+vout(font_checksum[cur_font].b3);
+vout_int(font_at[cur_font]);
+vout_int(font_dsize[cur_font]);
+vout(farea_length[cur_font]);
+vout(fname_length[cur_font]);
+for k:=0 to farea_length[cur_font]-1 do vout(vf[farea_start[cur_font]+k]);
+if fname_start[cur_font]=vf_size then begin
+ vout("N"); vout("U"); vout("L"); vout("L");
+ end
+else for k:=0 to fname_length[cur_font]-1 do vout(vf[fname_start[cur_font]+k]);
+vcount:=vcount+12+farea_length[cur_font]+fname_length[cur_font];
+end
+
+@ @<Output a packet for character |c|@>=
+begin x:=memory[char_wd[c]];
+if design_units<>unity then x:=round((x/design_units)*1048576.0);
+if (packet_length[c]>241)or(x<0)or(x>=@'100000000)or(c<0)or(c>255) then begin
+ vout(242); vout_int(packet_length[c]); vfout_char(c); vout_int(x);
+ vcount:=vcount+13+packet_length[c];
+ end
+else begin
+ vout(packet_length[c]); vout(c); vout(x div @'200000);
+ vout((x div @'400) mod 256); vout(x mod 256);
+ vcount:=vcount+5+packet_length[c];
+ end;
+if packet_start[c]=vf_size then
+ vfout_set(c)
+else for k:=0 to packet_length[c]-1 do vout(vf[packet_start[c]+k]);
+end
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+@p procedure param_enter;
+begin @<Enter the parameter names@>;
+end;
+@#
+procedure vpl_enter;
+begin @<Enter all the \.{VPL} names@>;
+end;
+@#
+procedure name_enter; {enter all names and their equivalents}
+begin @<Enter all the \.{PL} names...@>;
+vpl_enter; param_enter;
+end;
+@#
+procedure read_lig_kern;
+var @!krn_ptr:0..max_kerns; {an index into |kern|}
+@!c:byte; {runs through all character codes}
+begin @<Read ligature/kern list@>;
+end;
+@#
+procedure output_new_information_ofm;
+begin @<Output the new information for OFM files@>;
+end;
+@#
+procedure compute_new_header_ofm;
+begin @<Compute the new header information for OFM files@>;
+end;
+@#
+procedure finish_extended_font;
+begin @<Finish up the extended font stuff@>;
+end;
+@#
+procedure output_subfile_sizes;
+begin @<Output the subfile sizes@>;
+end;
+@#
+procedure compute_subfile_sizes;
+begin @<Compute the subfile sizes@>;
+end;
+@#
+procedure output_character_info;
+begin @<Output the character info@>;
+end;
+@#
+@#
+procedure read_font_rule_list;
+begin @<Read font rule list@>;
+end;
+@#
+procedure read_font_glue_list;
+begin @<Read font glue list@>;
+end;
+@#
+procedure read_font_penalty_list;
+begin @<Read font penalty list@>;
+end;
+@#
+procedure read_font_mvalue_list;
+begin @<Read font mvalue list@>;
+end;
+@#
+procedure read_font_fvalue_list;
+begin @<Read font fvalue list@>;
+end;
+@#
+procedure read_font_ivalue_list;
+begin @<Read font ivalue list@>;
+end;
+@#
+procedure read_repeated_character_info;
+begin @<Read repeated character info@>;
+end;
+@#
+procedure read_lig_kern_command;
+begin @<Read a ligature/kern command@>;
+end;
+@#
+procedure read_character_property;
+begin @<Read a character property@>;
+end;
+@#
+procedure read_char_info;
+begin @<Read character info list@>;
+end;
+@#
+procedure read_input;
+var @!c:byte; {header or parameter index}
+begin @<Read all the input@>;
+end;
+@#
+procedure corr_and_check;
+var @!c:xchar_type; {runs through all character codes}
+@!hh:0..hash_size; {an index into |hash_list|}
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!g:byte; {a character generated by the current character |c|}
+begin @<Correct and check the information@>
+end;
+@#
+procedure vf_output;
+var @!c:char_type; {runs through all character codes}
+@!cur_font:xfont_type; {runs through all local fonts}
+@!k:integer; {loop index}
+begin @<Do the \.{VF} output@>;
+end;
+
+@ Here is where \.{VPtoVF} begins and ends.
+
+@p begin initialize;@/
+name_enter;@/
+read_input; print_ln('.');@/
+corr_and_check;@/
+@<Do the font metric output@>;
+vf_output;
+end.
+
+@ @<Global...@>=
+@!ofm_level:integer;
+
+@ @<Set init...@>=
+ofm_level:=0; {Suppose that it is a level 0 OFM file}
+
+@ @<Read OFM level code@>=
+begin
+ofm_level:=get_integer;
+if (ofm_level<0) or (ofm_level>1) then begin
+ flush_error('OFMLEVEL must be 0 or 1 -- 1 assumed');
+ ofm_level:=1;
+ end;
+end
+
+@ @<Read font direction code@>=
+begin
+font_dir:=-1;
+repeat get_next;
+until cur_char<>" ";
+case cur_char of
+ "T": begin get_next;
+ if cur_char="L" then font_dir:=0
+ else if cur_char="R" then font_dir:=2;
+ end;
+ "B": begin get_next;
+ if cur_char="L" then font_dir:=4
+ else if cur_char="R" then font_dir:=6;
+ end;
+ "R": begin get_next;
+ if cur_char="T" then font_dir:=5
+ else if cur_char="B" then font_dir:=7;
+ end;
+ "L": begin get_next;
+ if cur_char="T" then font_dir:=1
+ else if cur_char="B" then font_dir:=3;
+ end;
+ end;
+while cur_char<>")" do get_next;
+if font_dir = -1 then begin
+ flush_error('FONTDIR must be valid direction, -- TR assumed');
+ font_dir:=0;
+ end;
+end
+
+@ @<Read natural font direction code@>=
+begin
+font_dir:=-1;
+repeat get_next;
+until cur_char<>" ";
+case cur_char of
+ "T": begin get_next;
+ if cur_char="L" then font_dir:=8
+ else if cur_char="R" then font_dir:=10;
+ end;
+ "B": begin get_next;
+ if cur_char="L" then font_dir:=12
+ else if cur_char="R" then font_dir:=14;
+ end;
+ "R": begin get_next;
+ if cur_char="T" then font_dir:=13
+ else if cur_char="B" then font_dir:=15;
+ end;
+ "L": begin get_next;
+ if cur_char="T" then font_dir:=9
+ else if cur_char="B" then font_dir:=11;
+ end;
+ end;
+while cur_char<>")" do get_next;
+if font_dir = -1 then begin
+ flush_error('NFONTDIR must be valid direction, -- TR assumed');
+ font_dir:=8;
+ end;
+end
+
+@
+Here are some general values for the various entries.
+They can all be changed.
+
+@d arrays_per_kind==20
+@d entries_per_array==200
+
+@ @<Constants...@>=
+@!rule_arrays=arrays_per_kind;
+@!rule_entries=entries_per_array;
+
+@ @<Types...@>=
+rule_array_type=0..rule_arrays;
+rule_entry_type=0..rule_entries;
+rule_node=
+record
+ rn_width: fix_word;
+ rn_height: fix_word;
+ rn_depth: fix_word;
+end;
+
+@ @<Global...@>=
+@!rules:array[rule_array_type,rule_entry_type] of rule_node;
+@!npr:array[rule_array_type] of integer;
+@!nkr:integer;
+@!nkcr:integer;
+@!nwr:integer;
+@!r_array:integer;
+@!r_number:integer;
+
+@ @<Set init...@>=
+for r_array := 0 to rule_arrays do begin
+ npr[r_array]:=0;
+ @<Null out the rule@>;
+ end;
+nkr:=-1;
+nkcr:=-1;
+
+@ @<Read font rule list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+r_array:=get_integer;
+if r_array>rule_arrays then
+ flush_error('This FONTRULE table index is too big for my present size')
+else if r_array<0 then
+ flush_error('This FONTRULE index is negative')
+else begin
+ if r_array>nkr then nkr:=r_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a rule@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read a rule@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>rule_code then
+ flush_error('This property name doesn''t belong in a RULE list')
+else begin
+ r_number:=get_integer;
+ if r_number>rule_entries then
+ flush_error('This RULE index is too big for my present table size')
+ else if r_number<0 then
+ flush_error('This RULE index is negative')
+ else begin
+ while npr[r_array]<r_number do begin
+ incr(npr[r_array]); @<Null out the rule@>;
+ end;
+ @<Read all of a rule's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the rule@>=
+begin
+rules[r_array,npr[r_array]].rn_width:=0;
+rules[r_array,npr[r_array]].rn_depth:=0;
+rules[r_array,npr[r_array]].rn_height:=0;
+end
+
+@ @<Read all of a rule's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single rule value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single rule value@>=
+begin
+get_name;
+case cur_code of
+ rule_width_code:
+ rules[r_array,r_number].rn_width:=get_fix;
+ rule_height_code:
+ rules[r_array,r_number].rn_height:=get_fix;
+ rule_depth_code:
+ rules[r_array,r_number].rn_depth:=get_fix;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for rules@>=
+begin
+nwr:=0;
+for r_array := 0 to nkr do begin
+ incr(npr[r_array]);
+ nwr := nwr + 3*npr[r_array];
+ end;
+incr(nkr);
+end
+
+@ @<Output the rules@>=
+begin
+for r_array:= 0 to nkr-1 do
+ for r_number:=0 to npr[r_array]-1 do begin
+ out_scaled(rules[r_array,r_number].rn_width);
+ out_scaled(rules[r_array,r_number].rn_height);
+ out_scaled(rules[r_array,r_number].rn_depth);
+ end;
+end
+
+@ @<Output the rule headers@>=
+begin
+for r_array:= 0 to nkr-1 do begin
+ out_integer(npr[r_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!glue_arrays=arrays_per_kind;
+@!glue_entries=entries_per_array;
+
+@
+@d t_normal==0
+@d t_aleaders==1
+@d t_cleaders==2
+@d t_xleaders==3
+
+@d o_unit==0
+@d o_fi==1
+@d o_fil==2
+@d o_fill==3
+@d o_filll==4
+
+@d g_space==0
+@d g_rule==1
+@d g_char==2
+
+@<Types...@>=
+glue_array_type=0..glue_arrays;
+glue_entry_type=0..glue_entries;
+glue_node=
+record
+ gn_width: fix_word;
+ gn_stretch: fix_word;
+ gn_shrink: fix_word;
+ gn_type: integer;
+ gn_arg_type: g_space..g_char;
+ gn_stretch_order: integer;
+ gn_shrink_order: integer;
+ gn_argument: integer;
+end;
+
+@ @<Global...@>=
+@!glues:array[glue_array_type,glue_entry_type] of glue_node;
+@!npg:array[glue_array_type] of integer;
+@!nkg:integer;
+@!nkcg:integer;
+@!nwg:integer;
+@!g_array:integer;
+@!g_byte:integer;
+@!g_number:integer;
+
+@ @<Set init...@>=
+for g_array := 0 to glue_arrays do
+begin
+ npg[g_array]:=0;
+ @<Null out the glue@>;
+end;
+nkg:=-1;
+nkcg:=-1;
+
+@ @<Read font glue list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+g_array:=get_integer;
+if g_array>glue_arrays then
+ flush_error('This FONTGLUE table index is too big for my present size')
+else if g_array<0 then
+ flush_error('This FONTGLUE index is negative')
+else begin
+ if g_array>nkg then nkg:=g_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a glue@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read a glue@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>glue_code then
+ flush_error('This property name doesn''t belong in a GLUE list')
+else begin
+ g_number:=get_integer;
+ if g_number>glue_entries then
+ flush_error('This GLUE index is too big for my present table size')
+ else if g_number<0 then
+ flush_error('This GLUE index is negative')
+ else begin
+ while npg[g_array]<g_number do begin
+ incr(npg[g_array]); @<Null out the glue@>;
+ end;
+ @<Read all of a glue's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the glue@>=
+begin
+glues[g_array,npg[g_array]].gn_width:=0;
+glues[g_array,npg[g_array]].gn_stretch:=0;
+glues[g_array,npg[g_array]].gn_shrink:=0;
+glues[g_array,npg[g_array]].gn_type:=0;
+glues[g_array,npg[g_array]].gn_arg_type:=0;
+glues[g_array,npg[g_array]].gn_stretch_order:=0;
+glues[g_array,npg[g_array]].gn_shrink_order:=0;
+glues[g_array,npg[g_array]].gn_argument:=0;
+end
+
+@ @<Read all of a glue's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single glue value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single glue value@>=
+begin
+get_name;
+case cur_code of
+ glue_width_code:
+ glues[g_array,g_number].gn_width:=get_fix;
+ glue_stretch_code:
+ glues[g_array,g_number].gn_stretch:=get_fix;
+ glue_shrink_code:
+ glues[g_array,g_number].gn_shrink:=get_fix;
+ glue_type_code: begin
+ g_byte:=get_integer;
+ if (g_byte<0) or (g_byte>3) then begin
+ g_byte:=0;
+ end;
+ glues[g_array,g_number].gn_type:=g_byte;
+ end;
+ glue_stretch_order_code: begin
+ g_byte:=get_integer;
+ if (g_byte<0) or (g_byte>4) then begin
+ g_byte:=0;
+ end;
+ glues[g_array,g_number].gn_stretch_order:=g_byte;
+ end;
+ glue_shrink_order_code: begin
+ g_byte:=get_integer;
+ if (g_byte<0) or (g_byte>4) then begin
+ g_byte:=0;
+ end;
+ glues[g_array,g_number].gn_shrink_order:=g_byte;
+ end;
+ glue_char_code: begin
+ glues[g_array,g_number].gn_argument:=get_integer;
+ glues[g_array,g_number].gn_arg_type:=g_char;
+ end;
+ glue_rule_code: begin
+ glues[g_array,g_number].gn_argument:=get_integer;
+ glues[g_array,g_number].gn_arg_type:=g_rule;
+ end;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for glues@>=
+begin
+nwg:=0;
+for g_array := 0 to nkg do begin
+ incr(npg[g_array]);
+ nwg := nwg + 4*npg[g_array];
+ end;
+incr(nkg);
+end
+
+@ @<Output the glues@>=
+begin
+for g_array:= 0 to nkg-1 do
+ for g_number:=0 to npg[g_array]-1 do begin
+ g_byte:=glues[g_array,g_number].gn_type*16+
+ glues[g_array,g_number].gn_arg_type;
+ out(g_byte);
+ g_byte:=glues[g_array,g_number].gn_stretch_order*16+
+ glues[g_array,g_number].gn_shrink_order;
+ out(g_byte);
+ g_byte:=glues[g_array,g_number].gn_argument div 256;
+ out(g_byte);
+ g_byte:=glues[g_array,g_number].gn_argument mod 256;
+ out(g_byte);
+ out_scaled(glues[g_array,g_number].gn_width);
+ out_scaled(glues[g_array,g_number].gn_stretch);
+ out_scaled(glues[g_array,g_number].gn_shrink);
+ end;
+end
+
+@ @<Output the glue headers@>=
+begin
+for g_array:= 0 to nkg-1 do begin
+ out_integer(npg[g_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!penalty_arrays=arrays_per_kind;
+@!penalty_entries=entries_per_array;
+
+@ @<Types...@>=
+penalty_array_type=0..penalty_arrays;
+penalty_entry_type=0..penalty_entries;
+penalty_node=
+record
+ pn_val: integer;
+end;
+
+@ @<Global...@>=
+@!penalties:array[penalty_array_type,penalty_entry_type] of penalty_node;
+@!npp:array[penalty_array_type] of integer;
+@!nkp:integer;
+@!nkcp:integer;
+@!nwp:integer;
+@!p_array:integer;
+@!p_number:integer;
+
+@ @<Set init...@>=
+for p_array := 0 to penalty_arrays do begin
+ npp[p_array]:=0;
+ @<Null out the penalty@>;
+ end;
+nkp:=-1;
+nkcp:=-1;
+
+@ @<Read font penalty list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+p_array:=get_integer;
+if p_array>penalty_arrays then
+ flush_error('This FONTPENALTY table index is too big for my present size')
+else if p_array<0 then
+ flush_error('This FONTPENALTY index is negative')
+else begin
+ if p_array>nkp then nkp:=p_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a penalty@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read a penalty@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>penalty_code then
+ flush_error('This property name doesn''t belong in a PENALTY list')
+else begin
+ p_number:=get_integer;
+ if p_number>penalty_entries then
+ flush_error('This PENALTY index is too big for my present table size')
+ else if p_number<0 then
+ flush_error('This PENALTY index is negative')
+ else begin
+ while npp[p_array]<p_number do begin
+ incr(npp[p_array]); @<Null out the penalty@>;
+ end;
+ @<Read all of a penalty's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the penalty@>=
+begin
+penalties[p_array,npp[p_array]].pn_val:=0;
+end
+
+@ @<Read all of a penalty's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single penalty value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single penalty value@>=
+begin
+get_name;
+case cur_code of
+ penalty_val_code:
+ penalties[p_array,p_number].pn_val:=get_integer;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for penalties@>=
+begin
+nwp:=0;
+for p_array := 0 to nkp do begin
+ incr(npp[p_array]);
+ nwp := nwp + npp[p_array];
+ end;
+incr(nkp);
+end
+
+@ @<Output the penalties@>=
+begin
+for p_array:= 0 to nkp-1 do
+ for p_number:=0 to npp[p_array]-1 do begin
+ out_integer(penalties[p_array,p_number].pn_val);
+ end;
+end
+
+@ @<Output the penalty headers@>=
+begin
+for p_array:= 0 to nkp-1 do begin
+ out_integer(npp[p_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!mvalue_arrays=arrays_per_kind;
+@!mvalue_entries=entries_per_array;
+
+@ @<Types...@>=
+mvalue_array_type=0..mvalue_arrays;
+mvalue_entry_type=0..mvalue_entries;
+mvalue_node=
+record
+ fn_val: fix_word;
+end;
+
+@ @<Global...@>=
+@!mvalues:array[mvalue_array_type,mvalue_entry_type] of mvalue_node;
+@!npm:array[mvalue_array_type] of integer;
+@!nkm:integer;
+@!nkcm:integer;
+@!nwm:integer;
+@!m_array:integer;
+@!m_number:integer;
+
+@ @<Set init...@>=
+for m_array := 0 to mvalue_arrays do begin
+ npm[m_array]:=0;
+ @<Null out the mvalue@>;
+ end;
+nkm:=-1;
+nkcm:=-1;
+
+@ @<Read font mvalue list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+m_array:=get_integer;
+if m_array>mvalue_arrays then
+ flush_error('This FONTMVALUE table index is too big for my present size')
+else if m_array<0 then
+ flush_error('This FONTMVALUE index is negative')
+else begin
+ if m_array>nkm then nkm:=m_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an mvalue@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an mvalue@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>mvalue_code then
+ flush_error('This property name doesn''t belong in an MVALUE list')
+else begin
+ m_number:=get_integer;
+ if m_number>mvalue_entries then
+ flush_error('This MVALUE index is too big for my present table size')
+ else if m_number<0 then
+ flush_error('This MVALUE index is negative')
+ else begin
+ while npm[m_array]<m_number do begin
+ incr(npm[m_array]); @<Null out the mvalue@>;
+ end;
+ @<Read all of an mvalue's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the mvalue@>=
+begin
+mvalues[m_array,npm[m_array]].fn_val:=0;
+end
+
+@ @<Read all of an mvalue's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single mvalue value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single mvalue value@>=
+begin
+get_name;
+case cur_code of
+ mvalue_val_code:
+ mvalues[m_array,m_number].fn_val:=get_fix;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for mvalues@>=
+begin
+nwm:=0;
+for m_array := 0 to nkm do begin
+ incr(npm[m_array]);
+ nwm := nwm + npm[m_array];
+ end;
+incr(nkm);
+end
+
+@ @<Output the mvalues@>=
+begin
+for m_array:= 0 to nkm-1 do
+ for m_number:=0 to npm[m_array]-1 do begin
+ out_scaled(mvalues[m_array,m_number].fn_val);
+ end;
+end
+
+@ @<Output the mvalue headers@>=
+begin
+for m_array:= 0 to nkm-1 do begin
+ out_integer(npm[m_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!fvalue_arrays=arrays_per_kind;
+@!fvalue_entries=entries_per_array;
+
+@ @<Types...@>=
+fvalue_array_type=0..fvalue_arrays;
+fvalue_entry_type=0..fvalue_entries;
+fvalue_node=
+record
+ fn_val: fix_word;
+end;
+
+@ @<Global...@>=
+@!fvalues:array[fvalue_array_type,fvalue_entry_type] of fvalue_node;
+@!npf:array[fvalue_array_type] of integer;
+@!nkf:integer;
+@!nkcf:integer;
+@!nwf:integer;
+@!f_array:integer;
+@!f_number:integer;
+
+@ @<Set init...@>=
+for f_array := 0 to fvalue_arrays do begin
+ npf[f_array]:=0;
+ @<Null out the fvalue@>;
+ end;
+nkf:=-1;
+nkcf:=-1;
+
+@ @<Read font fvalue list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+f_array:=get_integer;
+if f_array>fvalue_arrays then
+ flush_error('This FONTFVALUE table index is too big for my present size')
+else if f_array<0 then
+ flush_error('This FONTFVALUE index is negative')
+else begin
+ if f_array>nkf then nkf:=f_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an fvalue@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an fvalue@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>fvalue_code then
+ flush_error('This property name doesn''t belong in an FVALUE list')
+else begin
+ f_number:=get_integer;
+ if f_number>fvalue_entries then
+ flush_error('This FVALUE index is too big for my present table size')
+ else if f_number<0 then
+ flush_error('This FVALUE index is negative')
+ else begin
+ while npf[f_array]<f_number do begin
+ incr(npf[f_array]); @<Null out the fvalue@>;
+ end;
+ @<Read all of an fvalue's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the fvalue@>=
+begin
+fvalues[f_array,npf[f_array]].fn_val:=0;
+end
+
+@ @<Read all of an fvalue's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single fvalue value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single fvalue value@>=
+begin
+get_name;
+case cur_code of
+ fvalue_val_code:
+ fvalues[f_array,f_number].fn_val:=get_fix;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for fvalues@>=
+begin
+nwf:=0;
+for f_array := 0 to nkf do begin
+ incr(npf[f_array]);
+ nwf := nwf + npf[f_array];
+ end;
+incr(nkf);
+end
+
+@ @<Output the fvalues@>=
+begin
+for f_array:= 0 to nkf-1 do
+ for f_number:=0 to npf[f_array]-1 do begin
+ out_scaled(fvalues[f_array,f_number].fn_val);
+ end;
+end
+
+@ @<Output the fvalue headers@>=
+begin
+for f_array:= 0 to nkf-1 do begin
+ out_integer(npf[f_array]);
+ end;
+end
+
+@ @<Constants...@>=
+@!ivalue_arrays=arrays_per_kind;
+@!ivalue_entries=entries_per_array;
+
+@ @<Types...@>=
+ivalue_array_type=0..ivalue_arrays;
+ivalue_entry_type=0..ivalue_entries;
+ivalue_node=
+record
+ in_val: integer;
+end;
+
+@ @<Global...@>=
+@!ivalues:array[ivalue_array_type,ivalue_entry_type] of ivalue_node;
+@!npi:array[ivalue_array_type] of integer;
+@!font_i_array:boolean;
+@!nki:integer;
+@!nkci:integer;
+@!nwi:integer;
+@!i_array:integer;
+@!i_number:integer;
+
+@ @<Set init...@>=
+for i_array := 0 to ivalue_arrays do begin
+ npi[i_array]:=0;
+ @<Null out the ivalue@>;
+ end;
+nki:=-1;
+nkci:=-1;
+
+@ @<Read font ivalue list@>=
+begin
+if tables_read then
+ flush_error('All parameter tables must appear before character info');
+i_array:=get_integer;
+if i_array>ivalue_arrays then
+ flush_error('This FONTIVALUE table index is too big for my present size')
+else if i_array<0 then
+ flush_error('This FONTIVALUE index is negative')
+else begin
+ if i_array>nki then nki:=i_array;
+ while level=1 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an ivalue@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an ivalue@>=
+begin
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>ivalue_code then
+ flush_error('This property name doesn''t belong in an IVALUE list')
+else begin
+ i_number:=get_integer;
+ if i_number>ivalue_entries then
+ flush_error('This IVALUE index is too big for my present table size')
+ else if i_number<0 then
+ flush_error('This IVALUE index is negative')
+ else begin
+ while npi[i_array]<i_number do begin
+ incr(npi[i_array]); @<Null out the ivalue@>;
+ end;
+ @<Read all of an ivalue's values@>;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Null out the ivalue@>=
+begin
+ivalues[i_array,npi[i_array]].in_val:=0;
+end
+
+@ @<Read all of an ivalue's values@>=
+begin
+while level=2 do begin
+ while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a single ivalue value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a single ivalue value@>=
+begin
+get_name;
+case cur_code of
+ ivalue_val_code:
+ ivalues[i_array,i_number].in_val:=get_integer;
+ end;
+finish_the_property;
+end
+
+@ @<Header information for ivalues@>=
+begin
+nwi:=0;
+for i_array := 0 to nki do begin
+ incr(npi[i_array]);
+ nwi := nwi + npi[i_array];
+ end;
+incr(nki);
+end
+
+@ @<Output the ivalues@>=
+begin
+for i_array:= 0 to nki-1 do
+ for i_number:=0 to npi[i_array]-1 do begin
+ out_integer(ivalues[i_array,i_number].in_val);
+ end;
+end
+
+@ @<Output the ivalue headers@>=
+begin
+for i_array:= 0 to nki-1 do begin
+ out_integer(npi[i_array]);
+ end;
+end
+
+@ @<Compute the new header information for OFM files@>=
+begin
+@<Header information for ivalues@>;
+@<Header information for fvalues@>;
+@<Header information for mvalues@>;
+@<Header information for rules@>;
+@<Header information for glues@>;
+@<Header information for penalties@>;
+end
+
+@ @<Output the new information for OFM files@>=
+begin
+@<Output the ivalue headers@>;
+@<Output the fvalue headers@>;
+@<Output the mvalue headers@>;
+@<Output the rule headers@>;
+@<Output the glue headers@>;
+@<Output the penalty headers@>;
+@<Output the ivalues@>;
+@<Output the fvalues@>;
+@<Output the rules@>;
+@<Output the glues@>;
+@<Output the penalties@>;
+end
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{VPtoVF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/otangle.rc b/Build/source/texk/web2c/otangle.rc
new file mode 100644
index 00000000000..c6b16abc20b
--- /dev/null
+++ b/Build/source/texk/web2c/otangle.rc
@@ -0,0 +1,35 @@
+/* otangle.rc: otangle resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " otangle 4.4"
+
+#define VER_INTERNALNAME_STR "otangle"
+#define VER_ORIGINALFILENAME_STR "otangle.exe"
+
+#define VER_FILEDESCRIPTION_STR "Web-to-Pascal Converter"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1994--2000 by John Plaice \
+and Yannis Haralambous; applies only to the changes to the original tangle.web."
+
+#include <texlive.version>
+
+/* otangle.rc ends here */
diff --git a/Build/source/texk/web2c/otps/ChangeLog b/Build/source/texk/web2c/otps/ChangeLog
new file mode 100644
index 00000000000..6cc4795582b
--- /dev/null
+++ b/Build/source/texk/web2c/otps/ChangeLog
@@ -0,0 +1,21 @@
+2002-11-18 Roozbeh Pournader <roozbeh@sharif.edu>
+
+ * otp2ocp.c: fixed a bug in detecting the '.otp' suffix (patch by
+ Behdad Esfahbod).
+ * ChangeLog: some cleanup;
+
+2002-10-23 Roozbeh Pournader <roozbeh@sharif.edu>
+
+ * otp2ocp.c: added two copyright lines.
+ * otp.l: fixed a buffer overflow bug, now accepts all end of line
+ formats, fixed error reports on numbers greater than 65535 (patch
+ by Behdad Esfahbod).
+ * otp.h: changed '#define's to 'enum' (patch by Behdad Esfahbod).
+ * lex.yy.c-dist: rebuilt.
+
+2002-10-15 Roozbeh Pournader <roozbeh@sharif.edu>
+
+ * otp2ocp.c: fixed some '.ocp' writing bugs; otp2ocp now fails with
+ a non-zero return value if parsing the input fails (patch by
+ Behdad Esfahbod <omega@behdad.org>).
+ * otp2ocp.c, outocp.c: 'indent'-ed.
diff --git a/Build/source/texk/web2c/otps/Makefile.in b/Build/source/texk/web2c/otps/Makefile.in
new file mode 100644
index 00000000000..5351bcc279f
--- /dev/null
+++ b/Build/source/texk/web2c/otps/Makefile.in
@@ -0,0 +1,52 @@
+# Makefile for TeX-project WEB sources to C conversion programs.
+
+# These get expanded from the parent directory, not this one.
+kpse_include ../make/common.mk
+kpse_include ../make/programs.mk
+kpse_include ../make/paths.mk
+kpse_include kpathsea.mk
+
+LEX = @LEX@
+LEXLIB = @LEXLIB@
+LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@
+YACC = @YACC@
+
+proglib = ../lib/lib.a
+programs = otp2ocp outocp
+scripts = mkocp mkofm
+
+otp2ocp_objects = otp2ocp.o routines.o y_tab.o $(LEX_OUTPUT_ROOT).o
+all: $(programs)
+otp2ocp: $(otp2ocp_objects)
+ $(kpathsea_link) $(otp2ocp_objects) $(LEXLIB) $(LOADLIBES)
+
+otp2ocp.o: otp2ocp.c y_tab.h
+y_tab.c y_tab.h: otp.y
+ $(YACC) -d -v $(srcdir)/otp.y
+ -test -f y.tab.c && mv -f y.tab.c y_tab.c
+ -test -f y.tab.h && mv -f y.tab.h y_tab.h
+$(LEX_OUTPUT_ROOT).o: otp.h
+$(LEX_OUTPUT_ROOT).c: otp.l
+ $(LEX) $(srcdir)/otp.l
+
+outocp: outocp.o
+ $(kpathsea_link) outocp.o $(LOADLIBES)
+
+$(programs): $(proglib) $(kpathsea)
+
+install-programs: $(programs)
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(bindir)
+ for p in $(programs); do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+ for p in $(scripts); do $(INSTALL_SCRIPT) $(srcdir)/$$p $(scriptdir); done
+
+Makefile: Makefile.in ../config.status
+ cd .. && $(SHELL) config.status
+
+kpse_include ../make/tkpathsea.mk
+kpse_include ../make/clean.mk
+
+clean::
+ rm -f y_tab.c y_tab.h y.out* yacc.* $(LEX_OUTPUT_ROOT).c
+
+kpse_include ../make/rdepend.mk
+kpse_include otps/depend.mk
diff --git a/Build/source/texk/web2c/otps/depend.mak b/Build/source/texk/web2c/otps/depend.mak
new file mode 100644
index 00000000000..fcd8a570a6c
--- /dev/null
+++ b/Build/source/texk/web2c/otps/depend.mak
@@ -0,0 +1,67 @@
+$(objdir)/otp2ocp.obj: \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/tex-file.h \
+ $(kpathseadir)/c-vararg.h \
+ routines.h \
+ ../config.h \
+ $(kpathseadir)/../web2c/c-auto.h
+
+$(objdir)/routines.obj: \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ routines.h \
+ ../config.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ otp.h
+
+$(objdir)/outocp.obj: \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/tex-file.h \
+ $(kpathseadir)/c-vararg.h \
+ otp.h
+
diff --git a/Build/source/texk/web2c/otps/depend.mk b/Build/source/texk/web2c/otps/depend.mk
new file mode 100644
index 00000000000..81ba667227c
--- /dev/null
+++ b/Build/source/texk/web2c/otps/depend.mk
@@ -0,0 +1,53 @@
+$(LEX_OUTPUT_ROOT).o: $(LEX_OUTPUT_ROOT).c \
+ routines.h ../config.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ yystype.h y_tab.h
+otp2ocp.o: otp2ocp.c $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/tex-file.h $(kpathsea_srcdir)/c-vararg.h routines.h \
+ ../config.h ../../web2c/c-auto.h
+outocp.o: outocp.c $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/tex-file.h $(kpathsea_srcdir)/c-vararg.h otp.h
+routines.o: routines.c $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ routines.h ../config.h ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h \
+ $(kpathsea_srcdir)/c-fopen.h \
+ otp.h
+y_tab.o: y_tab.c otp.h routines.h ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ yystype.h
diff --git a/Build/source/texk/web2c/otps/lex.yy.c-dist b/Build/source/texk/web2c/otps/lex.yy.c-dist
new file mode 100644
index 00000000000..ad8394f92ec
--- /dev/null
+++ b/Build/source/texk/web2c/otps/lex.yy.c-dist
@@ -0,0 +1,1988 @@
+
+#line 3 "lex.yy.c"
+
+#define YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 31
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t;
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else /* ! __cplusplus */
+
+#if __STDC__
+
+#define YY_USE_CONST
+
+#endif /* __STDC__ */
+#endif /* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index. If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition. This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state. The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE yyrestart(yyin )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+extern int yyleng;
+
+extern FILE *yyin, *yyout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+ /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires
+ * access to the local variable yy_act. Since yyless() is a macro, it would break
+ * existing scanners that call yyless() from OUTSIDE yylex.
+ * One obvious solution it to make yy_act a global. I tried that, and saw
+ * a 5% performance hit in a non-yylineno scanner, because yy_act is
+ * normally declared as a register variable-- so it is not worth it.
+ */
+ #define YY_LESS_LINENO(n) \
+ do { \
+ int yyl;\
+ for ( yyl = n; yyl < yyleng; ++yyl )\
+ if ( yytext[yyl] == '\n' )\
+ --yylineno;\
+ }while(0)
+
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ *yy_cp = (yy_hold_char); \
+ YY_RESTORE_YY_MORE_OFFSET \
+ (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+ YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+ } \
+ while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr) )
+
+/* The following is because we cannot portably get our hands on size_t
+ * (without autoconf's help, which isn't available because we want
+ * flex-generated scanners to compile on their own).
+ */
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef unsigned int yy_size_t;
+#endif
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+ {
+ FILE *yy_input_file;
+
+ char *yy_ch_buf; /* input buffer */
+ char *yy_buf_pos; /* current position in input buffer */
+
+ /* Size of input buffer in bytes, not including room for EOB
+ * characters.
+ */
+ yy_size_t yy_buf_size;
+
+ /* Number of characters read into yy_ch_buf, not including EOB
+ * characters.
+ */
+ int yy_n_chars;
+
+ /* Whether we "own" the buffer - i.e., we know we created it,
+ * and can realloc() it to grow it, and should free() it to
+ * delete it.
+ */
+ int yy_is_our_buffer;
+
+ /* Whether this is an "interactive" input source; if so, and
+ * if we're using stdio for input, then we want to use getc()
+ * instead of fread(), to make sure we stop fetching input after
+ * each newline.
+ */
+ int yy_is_interactive;
+
+ /* Whether we're considered to be at the beginning of a line.
+ * If so, '^' rules will be active on the next match, otherwise
+ * not.
+ */
+ int yy_at_bol;
+
+ int yy_bs_lineno; /**< The line count. */
+ int yy_bs_column; /**< The column count. */
+
+ /* Whether to try to fill the input buffer when we reach the
+ * end of it.
+ */
+ int yy_fill_buffer;
+
+ int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+ /* When an EOF's been seen but there's still some text to process
+ * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+ * shouldn't try reading from the input source any more. We might
+ * still have a bunch of tokens to match, though, because of
+ * possible backing-up.
+ *
+ * When we actually see the EOF, we change the status to "new"
+ * (via yyrestart()), so that the user can continue scanning by
+ * just pointing yyin at a new input file.
+ */
+#define YY_BUFFER_EOF_PENDING 2
+
+ };
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+ ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+ : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when yytext is formed. */
+static char yy_hold_char;
+static int yy_n_chars; /* number of characters read into yy_ch_buf */
+int yyleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 1; /* whether we need to initialize */
+static int yy_start = 0; /* start state number */
+
+/* Flag which is used to allow yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin. A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void yyrestart (FILE *input_file );
+void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer );
+YY_BUFFER_STATE yy_create_buffer (FILE *file,int size );
+void yy_delete_buffer (YY_BUFFER_STATE b );
+void yy_flush_buffer (YY_BUFFER_STATE b );
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer );
+void yypop_buffer_state (void );
+
+static void yyensure_buffer_stack (void );
+static void yy_load_buffer_state (void );
+static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file );
+
+#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size );
+YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str );
+YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,int len );
+
+void *yyalloc (yy_size_t );
+void *yyrealloc (void *,yy_size_t );
+void yyfree (void * );
+
+#define yy_new_buffer yy_create_buffer
+
+#define yy_set_interactive(is_interactive) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){ \
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+ }
+
+#define yy_set_bol(at_bol) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){\
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+ }
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+typedef unsigned char YY_CHAR;
+
+FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+
+typedef int yy_state_type;
+
+#define YY_FLEX_LEX_COMPAT
+extern int yylineno;
+
+int yylineno = 1;
+
+extern char yytext[];
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[] );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up yytext.
+ */
+#define YY_DO_BEFORE_ACTION \
+ (yytext_ptr) = yy_bp; \
+ yyleng = (size_t) (yy_cp - yy_bp); \
+ (yy_hold_char) = *yy_cp; \
+ *yy_cp = '\0'; \
+ if ( yyleng + (yy_more_offset) >= YYLMAX ) \
+ YY_FATAL_ERROR( "token too large, exceeds YYLMAX" ); \
+ yy_flex_strncpy( &yytext[(yy_more_offset)], (yytext_ptr), yyleng + 1 ); \
+ yyleng += (yy_more_offset); \
+ (yy_prev_more_offset) = (yy_more_offset); \
+ (yy_more_offset) = 0; \
+ (yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 25
+#define YY_END_OF_BUFFER 26
+/* This struct is not used in this scanner,
+ but its presence is necessary. */
+struct yy_trans_info
+ {
+ flex_int32_t yy_verify;
+ flex_int32_t yy_nxt;
+ };
+static yyconst flex_int16_t yy_acclist[130] =
+ { 0,
+ 26, 24, 25, 1, 24, 25, 3, 25, 3, 24,
+ 25, 24, 25, 24, 25, 6, 24, 25, 24, 25,
+ 24, 25, 24, 25, 8, 24, 25, 24, 25, 8,
+ 24, 25, 8, 24, 25, 8, 24, 25, 8, 24,
+ 25, 8, 24, 25, 8, 24, 25, 8, 24, 25,
+ 8, 24, 25, 8, 24, 25, 8, 24, 25, 3,
+ 9, 2, 6, 11, 10, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 4, 5,
+ 7, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 22, 20, 23, 8, 8, 21,
+
+ 8, 19, 8, 8, 8, 8, 8, 8, 8, 18,
+ 8, 8, 8, 8, 12, 8, 8, 8, 8, 8,
+ 13, 15, 16, 14, 8, 8, 8, 8, 17
+ } ;
+
+static yyconst flex_int16_t yy_accept[103] =
+ { 0,
+ 1, 1, 1, 2, 4, 7, 9, 12, 14, 16,
+ 19, 21, 23, 25, 28, 30, 33, 36, 39, 42,
+ 45, 48, 51, 54, 57, 60, 61, 61, 62, 62,
+ 63, 64, 65, 66, 66, 66, 67, 67, 68, 69,
+ 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 87, 88, 89,
+ 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,
+ 100, 101, 102, 103, 104, 105, 106, 107, 108, 109,
+ 110, 111, 112, 113, 114, 115, 116, 117, 118, 119,
+ 120, 121, 122, 123, 124, 125, 126, 127, 128, 129,
+
+ 130, 130
+ } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
+ 1, 1, 4, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 5, 6, 7, 6, 6, 8, 6, 9, 6,
+ 6, 6, 6, 6, 6, 6, 6, 10, 10, 10,
+ 10, 10, 10, 10, 10, 11, 11, 12, 6, 13,
+ 14, 15, 6, 16, 17, 17, 17, 17, 17, 17,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 6, 6, 6, 6, 19, 20, 21, 22, 17, 23,
+
+ 24, 17, 25, 26, 27, 18, 18, 28, 29, 30,
+ 31, 32, 18, 33, 34, 35, 36, 37, 18, 38,
+ 18, 18, 6, 6, 6, 6, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1
+ } ;
+
+static yyconst flex_int32_t yy_meta[39] =
+ { 0,
+ 1, 1, 1, 1, 2, 2, 2, 2, 2, 3,
+ 3, 2, 2, 2, 2, 2, 3, 4, 4, 2,
+ 3, 3, 3, 3, 4, 4, 4, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 4
+ } ;
+
+static yyconst flex_int16_t yy_base[107] =
+ { 0,
+ 0, 0, 130, 131, 131, 131, 126, 121, 124, 29,
+ 112, 110, 34, 0, 0, 96, 99, 95, 12, 91,
+ 89, 83, 13, 83, 96, 131, 109, 108, 111, 131,
+ 35, 131, 131, 0, 103, 0, 103, 84, 85, 72,
+ 85, 75, 74, 82, 69, 71, 68, 80, 78, 0,
+ 89, 131, 77, 85, 84, 83, 61, 57, 80, 59,
+ 78, 63, 53, 59, 52, 131, 131, 131, 61, 49,
+ 131, 47, 131, 70, 57, 56, 55, 44, 65, 41,
+ 131, 41, 40, 39, 38, 131, 59, 58, 57, 56,
+ 40, 131, 131, 131, 131, 35, 35, 30, 36, 131,
+
+ 131, 50, 54, 56, 59, 44
+ } ;
+
+static yyconst flex_int16_t yy_def[107] =
+ { 0,
+ 101, 1, 101, 101, 101, 101, 101, 102, 103, 101,
+ 101, 101, 101, 104, 105, 104, 104, 104, 104, 104,
+ 104, 104, 104, 104, 104, 101, 102, 101, 103, 101,
+ 101, 101, 101, 106, 101, 104, 101, 104, 104, 104,
+ 104, 104, 104, 104, 104, 104, 104, 104, 104, 106,
+ 101, 101, 104, 104, 104, 104, 104, 104, 104, 104,
+ 104, 104, 104, 104, 104, 101, 101, 101, 104, 104,
+ 101, 104, 101, 104, 104, 104, 104, 104, 104, 104,
+ 101, 104, 104, 104, 104, 101, 104, 104, 104, 104,
+ 104, 101, 101, 101, 101, 104, 104, 104, 104, 101,
+
+ 0, 101, 101, 101, 101, 101
+ } ;
+
+static yyconst flex_int16_t yy_nxt[170] =
+ { 0,
+ 4, 5, 6, 7, 5, 4, 8, 9, 4, 10,
+ 10, 4, 11, 12, 4, 13, 14, 14, 4, 15,
+ 16, 17, 18, 19, 14, 14, 20, 14, 21, 14,
+ 22, 23, 14, 24, 25, 14, 14, 14, 31, 31,
+ 34, 41, 35, 46, 31, 31, 50, 100, 47, 42,
+ 27, 27, 27, 27, 29, 29, 29, 29, 36, 36,
+ 37, 37, 37, 99, 98, 97, 96, 95, 94, 93,
+ 92, 91, 90, 89, 88, 87, 86, 85, 84, 83,
+ 82, 81, 80, 79, 78, 77, 76, 75, 74, 73,
+ 72, 71, 70, 69, 68, 67, 66, 65, 51, 64,
+
+ 63, 62, 61, 60, 59, 58, 57, 56, 55, 54,
+ 53, 52, 51, 30, 27, 28, 49, 48, 45, 44,
+ 43, 40, 39, 38, 33, 32, 30, 28, 26, 101,
+ 3, 101, 101, 101, 101, 101, 101, 101, 101, 101,
+ 101, 101, 101, 101, 101, 101, 101, 101, 101, 101,
+ 101, 101, 101, 101, 101, 101, 101, 101, 101, 101,
+ 101, 101, 101, 101, 101, 101, 101, 101, 101
+ } ;
+
+static yyconst flex_int16_t yy_chk[170] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 10, 10,
+ 13, 19, 13, 23, 31, 31, 106, 99, 23, 19,
+ 102, 102, 102, 102, 103, 103, 103, 103, 104, 104,
+ 105, 105, 105, 98, 97, 96, 91, 90, 89, 88,
+ 87, 85, 84, 83, 82, 80, 79, 78, 77, 76,
+ 75, 74, 72, 70, 69, 65, 64, 63, 62, 61,
+ 60, 59, 58, 57, 56, 55, 54, 53, 51, 49,
+
+ 48, 47, 46, 45, 44, 43, 42, 41, 40, 39,
+ 38, 37, 35, 29, 28, 27, 25, 24, 22, 21,
+ 20, 18, 17, 16, 12, 11, 9, 8, 7, 3,
+ 101, 101, 101, 101, 101, 101, 101, 101, 101, 101,
+ 101, 101, 101, 101, 101, 101, 101, 101, 101, 101,
+ 101, 101, 101, 101, 101, 101, 101, 101, 101, 101,
+ 101, 101, 101, 101, 101, 101, 101, 101, 101
+ } ;
+
+/* Table of booleans, true if rule could match eol. */
+static yyconst flex_int32_t yy_rule_can_match_eol[26] =
+ { 0,
+0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, };
+
+extern int yy_flex_debug;
+int yy_flex_debug = 0;
+
+static yy_state_type *yy_state_buf=0, *yy_state_ptr=0;
+static char *yy_full_match;
+static int yy_lp;
+#define REJECT \
+{ \
+*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ \
+yy_cp = (yy_full_match); /* restore poss. backed-over text */ \
+++(yy_lp); \
+goto find_rule; \
+}
+
+static int yy_more_offset = 0;
+static int yy_prev_more_offset = 0;
+#define yymore() ((yy_more_offset) = yy_flex_strlen( yytext ))
+#define YY_NEED_STRLEN
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET \
+ { \
+ (yy_more_offset) = (yy_prev_more_offset); \
+ yyleng -= (yy_more_offset); \
+ }
+#ifndef YYLMAX
+#define YYLMAX 8192
+#endif
+
+char yytext[YYLMAX];
+char *yytext_ptr;
+#line 1 "./otp.l"
+#line 2 "./otp.l"
+/* otp.l: Lexical analysis for OTP files
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+Copyright (c) 2002 Behdad Esfahbod
+Copyright (c) 2002 Roozbeh Pournader
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "routines.h"
+#include "yystype.h"
+#include "y_tab.h"
+#define YY_NO_UNPUT
+int line_number = 1;
+int i,j,last;
+extern YYSTYPE yylval;
+#line 603 "lex.yy.c"
+
+#define INITIAL 0
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int yywrap (void );
+#else
+extern int yywrap (void );
+#endif
+#endif
+
+ static void yyunput (int c,char *buf_ptr );
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO (void) fwrite( yytext, yyleng, 1, yyout )
+#endif
+
+/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+ { \
+ int c = '*'; \
+ size_t n; \
+ for ( n = 0; n < max_size && \
+ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+ buf[n] = (char) c; \
+ if ( c == '\n' ) \
+ buf[n++] = (char) c; \
+ if ( c == EOF && ferror( yyin ) ) \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ result = n; \
+ } \
+ else \
+ { \
+ errno=0; \
+ while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \
+ { \
+ if( errno != EINTR) \
+ { \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ break; \
+ } \
+ errno=0; \
+ clearerr(yyin); \
+ } \
+ }\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int yylex (void);
+
+#define YY_DECL int yylex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after yytext and yyleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+ YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp, *yy_bp;
+ register int yy_act;
+
+#line 43 "./otp.l"
+
+#line 756 "lex.yy.c"
+
+ if ( (yy_init) )
+ {
+ (yy_init) = 0;
+
+#ifdef YY_USER_INIT
+ YY_USER_INIT;
+#endif
+
+ if ( ! (yy_state_buf) )
+ (yy_state_buf) = (yy_state_type *)yyalloc(YY_BUF_SIZE + 2 );
+
+ if ( ! (yy_start) )
+ (yy_start) = 1; /* first start state */
+
+ if ( ! yyin )
+ yyin = stdin;
+
+ if ( ! yyout )
+ yyout = stdout;
+
+ if ( ! YY_CURRENT_BUFFER ) {
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_load_buffer_state( );
+ }
+
+ while ( 1 ) /* loops until end-of-file is reached */
+ {
+ yy_cp = (yy_c_buf_p);
+
+ /* Support of yytext. */
+ *yy_cp = (yy_hold_char);
+
+ /* yy_bp points to the position in yy_ch_buf of the start of
+ * the current run.
+ */
+ yy_bp = yy_cp;
+
+ yy_current_state = (yy_start);
+
+ (yy_state_ptr) = (yy_state_buf);
+ *(yy_state_ptr)++ = yy_current_state;
+
+yy_match:
+ do
+ {
+ register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 102 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *(yy_state_ptr)++ = yy_current_state;
+ ++yy_cp;
+ }
+ while ( yy_base[yy_current_state] != 131 );
+
+yy_find_action:
+ yy_current_state = *--(yy_state_ptr);
+ (yy_lp) = yy_accept[yy_current_state];
+find_rule: /* we branch to this label when backing up */
+ for ( ; ; ) /* until we find what rule we matched */
+ {
+ if ( (yy_lp) && (yy_lp) < yy_accept[yy_current_state + 1] )
+ {
+ yy_act = yy_acclist[(yy_lp)];
+ {
+ (yy_full_match) = yy_cp;
+ break;
+ }
+ }
+ --yy_cp;
+ yy_current_state = *--(yy_state_ptr);
+ (yy_lp) = yy_accept[yy_current_state];
+ }
+
+ YY_DO_BEFORE_ACTION;
+
+ if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] )
+ {
+ int yyl;
+ for ( yyl = (yy_prev_more_offset); yyl < yyleng; ++yyl )
+ if ( yytext[yyl] == '\n' )
+
+ yylineno++;
+;
+ }
+
+do_action: /* This label is used only to access EOF actions. */
+
+ switch ( yy_act )
+ { /* beginning of action switch */
+case 1:
+YY_RULE_SETUP
+#line 44 "./otp.l"
+{}
+ YY_BREAK
+case 2:
+/* rule 2 can match eol */
+YY_RULE_SETUP
+#line 45 "./otp.l"
+{ line_number++;}
+ YY_BREAK
+case 3:
+/* rule 3 can match eol */
+YY_RULE_SETUP
+#line 46 "./otp.l"
+{ line_number++;}
+ YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 47 "./otp.l"
+{
+ yylval.yint=0;
+ for (i=2; i<yyleng; i++) {
+ j = yytext[i];
+ if ((j>='0')&&(j<='9')) {
+ yylval.yint = (yylval.yint*16)+(j-'0');
+ } else if ((j>='a')&&(j<='f')) {
+ yylval.yint = (yylval.yint*16)+(j-'a'+10);
+ } else { /* ((j>='A') && (j>='F')) */
+ yylval.yint = (yylval.yint*16)+(j-'A'+10);
+ }
+ if (yylval.yint>65535) {
+ fprintf(stderr, "line %d: value too large (%x)\n",
+ line_number, yylval.yint);
+ exit(1);
+ }
+ }
+ return(NUMBER);
+ }
+ YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 66 "./otp.l"
+{
+ yylval.yint=0;
+ for (i=2; i<yyleng; i++) {
+ j = yytext[i];
+ yylval.yint = (yylval.yint*8)+(j-'0');
+ if (yylval.yint>65535) {
+ fprintf(stderr, "line %d: value too large (%o)\n",
+ line_number, yylval.yint);
+ exit(1);
+ }
+ }
+ return(NUMBER);
+ }
+ YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 79 "./otp.l"
+{
+ yylval.yint=0;
+ for (i=0; i<yyleng; i++) {
+ j = yytext[i];
+ yylval.yint = (yylval.yint*10)+(j-'0');
+ if (yylval.yint>65535) {
+ fprintf(stderr, "line %d: value too large (%d)\n",
+ line_number, yylval.yint);
+ exit(1);
+ }
+ }
+ return(NUMBER);
+ }
+ YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 92 "./otp.l"
+{
+ yylval.yint=yytext[1];
+ return(NUMBER);
+}
+ YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 96 "./otp.l"
+{ yylval.ystring=xstrdup(yytext); return(ID); }
+ YY_BREAK
+case 9:
+/* rule 9 can match eol */
+YY_RULE_SETUP
+#line 97 "./otp.l"
+{
+ char *newtext;
+ last=yyleng-2;
+ i=0;
+ j=1;
+ newtext=yylval.ystring=xstrdup(yytext);
+ while (j<=last) {
+ newtext[i]=yytext[j];
+ if ((yytext[j]=='"') && (yytext[j+1]=='"')) j=j+2;
+ else j++;
+ i++;
+ }
+ newtext[i]='\0';
+ return(STRING);
+ }
+ YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 112 "./otp.l"
+return(RIGHTARROW);
+ YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 113 "./otp.l"
+return(LEFTARROW);
+ YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 114 "./otp.l"
+return(INPUT);
+ YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 115 "./otp.l"
+return(OUTPUT);
+ YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 116 "./otp.l"
+return(ALIASES);
+ YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 117 "./otp.l"
+return(STATES);
+ YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 118 "./otp.l"
+return(TABLES);
+ YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 119 "./otp.l"
+return(EXPRESSIONS);
+ YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 120 "./otp.l"
+return(PUSH);
+ YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 121 "./otp.l"
+return(POP);
+ YY_BREAK
+case 20:
+YY_RULE_SETUP
+#line 122 "./otp.l"
+return(DIV);
+ YY_BREAK
+case 21:
+YY_RULE_SETUP
+#line 123 "./otp.l"
+return(MOD);
+ YY_BREAK
+case 22:
+YY_RULE_SETUP
+#line 124 "./otp.l"
+return(BEG);
+ YY_BREAK
+case 23:
+YY_RULE_SETUP
+#line 125 "./otp.l"
+return(END);
+ YY_BREAK
+case 24:
+YY_RULE_SETUP
+#line 126 "./otp.l"
+return(yytext[0]);
+ YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 128 "./otp.l"
+ECHO;
+ YY_BREAK
+#line 1042 "lex.yy.c"
+ case YY_STATE_EOF(INITIAL):
+ yyterminate();
+
+ case YY_END_OF_BUFFER:
+ {
+ /* Amount of text matched not including the EOB char. */
+ int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+ /* Undo the effects of YY_DO_BEFORE_ACTION. */
+ *yy_cp = (yy_hold_char);
+ YY_RESTORE_YY_MORE_OFFSET
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+ {
+ /* We're scanning a new file or input source. It's
+ * possible that this happened because the user
+ * just pointed yyin at a new source and called
+ * yylex(). If so, then we have to assure
+ * consistency between YY_CURRENT_BUFFER and our
+ * globals. Here is the right place to do so, because
+ * this is the first action (other than possibly a
+ * back-up) that will match for the new input source.
+ */
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+ }
+
+ /* Note that here we test for yy_c_buf_p "<=" to the position
+ * of the first EOB in the buffer, since yy_c_buf_p will
+ * already have been incremented past the NUL character
+ * (since all states make transitions on EOB to the
+ * end-of-buffer state). Contrast this with the test
+ * in input().
+ */
+ if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ { /* This was really a NUL. */
+ yy_state_type yy_next_state;
+
+ (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ /* Okay, we're now positioned to make the NUL
+ * transition. We couldn't have
+ * yy_get_previous_state() go ahead and do it
+ * for us because it doesn't know how to deal
+ * with the possibility of jamming (and we don't
+ * want to build jamming into it because then it
+ * will run more slowly).
+ */
+
+ yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+ if ( yy_next_state )
+ {
+ /* Consume the NUL. */
+ yy_cp = ++(yy_c_buf_p);
+ yy_current_state = yy_next_state;
+ goto yy_match;
+ }
+
+ else
+ {
+ yy_cp = (yy_c_buf_p);
+ goto yy_find_action;
+ }
+ }
+
+ else switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ (yy_did_buffer_switch_on_eof) = 0;
+
+ if ( yywrap( ) )
+ {
+ /* Note: because we've taken care in
+ * yy_get_next_buffer() to have set up
+ * yytext, we can now set up
+ * yy_c_buf_p so that if some total
+ * hoser (like flex itself) wants to
+ * call the scanner after we return the
+ * YY_NULL, it'll still work - another
+ * YY_NULL will get returned.
+ */
+ (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+ yy_act = YY_STATE_EOF(YY_START);
+ goto do_action;
+ }
+
+ else
+ {
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+ }
+ break;
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) =
+ (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_match;
+
+ case EOB_ACT_LAST_MATCH:
+ (yy_c_buf_p) =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_find_action;
+ }
+ break;
+ }
+
+ default:
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--no action found" );
+ } /* end of action switch */
+ } /* end of scanning one token */
+} /* end of yylex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ * EOB_ACT_LAST_MATCH -
+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ * EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+ register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+ register char *source = (yytext_ptr);
+ register int number_to_move, i;
+ int ret_val;
+
+ if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--end of buffer missed" );
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+ { /* Don't try to fill the buffer, so this is an EOF. */
+ if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+ {
+ /* We matched a single character, the EOB, so
+ * treat this as a final EOF.
+ */
+ return EOB_ACT_END_OF_FILE;
+ }
+
+ else
+ {
+ /* We matched some text prior to the EOB, first
+ * process it.
+ */
+ return EOB_ACT_LAST_MATCH;
+ }
+ }
+
+ /* Try to read more data. */
+
+ /* First move last chars to start of buffer. */
+ number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+ for ( i = 0; i < number_to_move; ++i )
+ *(dest++) = *(source++);
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+ /* don't do the read, it's not guaranteed to return an EOF,
+ * just force an EOF
+ */
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+ else
+ {
+ size_t num_to_read =
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+ while ( num_to_read <= 0 )
+ { /* Not enough room in the buffer - grow it. */
+
+ YY_FATAL_ERROR(
+"input buffer overflow, can't enlarge buffer because scanner uses REJECT" );
+
+ }
+
+ if ( num_to_read > YY_READ_BUF_SIZE )
+ num_to_read = YY_READ_BUF_SIZE;
+
+ /* Read in more data. */
+ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+ (yy_n_chars), num_to_read );
+
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ if ( (yy_n_chars) == 0 )
+ {
+ if ( number_to_move == YY_MORE_ADJ )
+ {
+ ret_val = EOB_ACT_END_OF_FILE;
+ yyrestart(yyin );
+ }
+
+ else
+ {
+ ret_val = EOB_ACT_LAST_MATCH;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+ YY_BUFFER_EOF_PENDING;
+ }
+ }
+
+ else
+ ret_val = EOB_ACT_CONTINUE_SCAN;
+
+ (yy_n_chars) += number_to_move;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+ (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+ return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+ static yy_state_type yy_get_previous_state (void)
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp;
+
+ yy_current_state = (yy_start);
+
+ (yy_state_ptr) = (yy_state_buf);
+ *(yy_state_ptr)++ = yy_current_state;
+
+ for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+ {
+ register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 102 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *(yy_state_ptr)++ = yy_current_state;
+ }
+
+ return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ * next_state = yy_try_NUL_trans( current_state );
+ */
+ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state )
+{
+ register int yy_is_jam;
+
+ register YY_CHAR yy_c = 1;
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 102 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ yy_is_jam = (yy_current_state == 101);
+ if ( ! yy_is_jam )
+ *(yy_state_ptr)++ = yy_current_state;
+
+ return yy_is_jam ? 0 : yy_current_state;
+}
+
+ static void yyunput (int c, register char * yy_bp )
+{
+ register char *yy_cp;
+
+ yy_cp = (yy_c_buf_p);
+
+ /* undo effects of setting up yytext */
+ *yy_cp = (yy_hold_char);
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ { /* need to shift things up to make room */
+ /* +2 for EOB chars. */
+ register int number_to_move = (yy_n_chars) + 2;
+ register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+ register char *source =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+ while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ *--dest = *--source;
+
+ yy_cp += (int) (dest - source);
+ yy_bp += (int) (dest - source);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ YY_FATAL_ERROR( "flex scanner push-back overflow" );
+ }
+
+ *--yy_cp = (char) c;
+
+ if ( c == '\n' ){
+ --yylineno;
+ }
+
+ (yytext_ptr) = yy_bp;
+ (yy_hold_char) = *yy_cp;
+ (yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+ static int yyinput (void)
+#else
+ static int input (void)
+#endif
+
+{
+ int c;
+
+ *(yy_c_buf_p) = (yy_hold_char);
+
+ if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+ {
+ /* yy_c_buf_p now points to the character we want to return.
+ * If this occurs *before* the EOB characters, then it's a
+ * valid NUL; if not, then we've hit the end of the buffer.
+ */
+ if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ /* This was really a NUL. */
+ *(yy_c_buf_p) = '\0';
+
+ else
+ { /* need more input */
+ int offset = (yy_c_buf_p) - (yytext_ptr);
+ ++(yy_c_buf_p);
+
+ switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_LAST_MATCH:
+ /* This happens because yy_g_n_b()
+ * sees that we've accumulated a
+ * token and flags that we need to
+ * try matching the token before
+ * proceeding. But for input(),
+ * there's no matching to consider.
+ * So convert the EOB_ACT_LAST_MATCH
+ * to EOB_ACT_END_OF_FILE.
+ */
+
+ /* Reset buffer status. */
+ yyrestart(yyin );
+
+ /*FALLTHROUGH*/
+
+ case EOB_ACT_END_OF_FILE:
+ {
+ if ( yywrap( ) )
+ return EOF;
+
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+#ifdef __cplusplus
+ return yyinput();
+#else
+ return input();
+#endif
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) = (yytext_ptr) + offset;
+ break;
+ }
+ }
+ }
+
+ c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */
+ *(yy_c_buf_p) = '\0'; /* preserve yytext */
+ (yy_hold_char) = *++(yy_c_buf_p);
+
+ if ( c == '\n' )
+
+ yylineno++;
+;
+
+ return c;
+}
+#endif /* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ *
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+ void yyrestart (FILE * input_file )
+{
+
+ if ( ! YY_CURRENT_BUFFER ){
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_init_buffer(YY_CURRENT_BUFFER,input_file );
+ yy_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ *
+ */
+ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer )
+{
+
+ /* TODO. We should be able to replace this entire function body
+ * with
+ * yypop_buffer_state();
+ * yypush_buffer_state(new_buffer);
+ */
+ yyensure_buffer_stack ();
+ if ( YY_CURRENT_BUFFER == new_buffer )
+ return;
+
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+ yy_load_buffer_state( );
+
+ /* We don't actually know whether we did this switch during
+ * EOF (yywrap()) processing, but the only time this flag
+ * is looked at is after yywrap() is called, so it's safe
+ * to go ahead and always set it.
+ */
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void yy_load_buffer_state (void)
+{
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+ yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+ (yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ *
+ * @return the allocated buffer state.
+ */
+ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size )
+{
+ YY_BUFFER_STATE b;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_buf_size = size;
+
+ /* yy_ch_buf has to be 2 characters longer than the size given because
+ * we need to put in 2 end-of-buffer characters.
+ */
+ b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2 );
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_is_our_buffer = 1;
+
+ yy_init_buffer(b,file );
+
+ return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with yy_create_buffer()
+ *
+ */
+ void yy_delete_buffer (YY_BUFFER_STATE b )
+{
+
+ if ( ! b )
+ return;
+
+ if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+ if ( b->yy_is_our_buffer )
+ yyfree((void *) b->yy_ch_buf );
+
+ yyfree((void *) b );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a yyrestart() or at EOF.
+ */
+ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file )
+
+{
+ int oerrno = errno;
+
+ yy_flush_buffer(b );
+
+ b->yy_input_file = file;
+ b->yy_fill_buffer = 1;
+
+ /* If b is the current buffer, then yy_init_buffer was _probably_
+ * called from yyrestart() or through yy_get_next_buffer.
+ * In that case, we don't want to reset the lineno or column.
+ */
+ if (b != YY_CURRENT_BUFFER){
+ b->yy_bs_lineno = 1;
+ b->yy_bs_column = 0;
+ }
+
+ b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+
+ errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ *
+ */
+ void yy_flush_buffer (YY_BUFFER_STATE b )
+{
+ if ( ! b )
+ return;
+
+ b->yy_n_chars = 0;
+
+ /* We always need two end-of-buffer characters. The first causes
+ * a transition to the end-of-buffer state. The second causes
+ * a jam in that state.
+ */
+ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+ b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+ b->yy_buf_pos = &b->yy_ch_buf[0];
+
+ b->yy_at_bol = 1;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ if ( b == YY_CURRENT_BUFFER )
+ yy_load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ * the current state. This function will allocate the stack
+ * if necessary.
+ * @param new_buffer The new state.
+ *
+ */
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+ if (new_buffer == NULL)
+ return;
+
+ yyensure_buffer_stack();
+
+ /* This block is copied from yy_switch_to_buffer. */
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ /* Only push if top exists. Otherwise, replace top. */
+ if (YY_CURRENT_BUFFER)
+ (yy_buffer_stack_top)++;
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+ /* copied from yy_switch_to_buffer. */
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ * The next element becomes the new top.
+ *
+ */
+void yypop_buffer_state (void)
+{
+ if (!YY_CURRENT_BUFFER)
+ return;
+
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ if ((yy_buffer_stack_top) > 0)
+ --(yy_buffer_stack_top);
+
+ if (YY_CURRENT_BUFFER) {
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+ }
+}
+
+/* Allocates the stack if it does not exist.
+ * Guarantees space for at least one push.
+ */
+static void yyensure_buffer_stack (void)
+{
+ int num_to_alloc;
+
+ if (!(yy_buffer_stack)) {
+
+ /* First allocation is just for 2 elements, since we don't know if this
+ * scanner will even need a stack. We use 2 instead of 1 to avoid an
+ * immediate realloc on the next call.
+ */
+ num_to_alloc = 1;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
+ (num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+
+ memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+
+ (yy_buffer_stack_max) = num_to_alloc;
+ (yy_buffer_stack_top) = 0;
+ return;
+ }
+
+ if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+ /* Increase the buffer to prepare for a possible push. */
+ int grow_size = 8 /* arbitrary grow size */;
+
+ num_to_alloc = (yy_buffer_stack_max) + grow_size;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
+ ((yy_buffer_stack),
+ num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+
+ /* zero only the new slots.*/
+ memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+ (yy_buffer_stack_max) = num_to_alloc;
+ }
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )
+{
+ YY_BUFFER_STATE b;
+
+ if ( size < 2 ||
+ base[size-2] != YY_END_OF_BUFFER_CHAR ||
+ base[size-1] != YY_END_OF_BUFFER_CHAR )
+ /* They forgot to leave room for the EOB's. */
+ return 0;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+
+ b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */
+ b->yy_buf_pos = b->yy_ch_buf = base;
+ b->yy_is_our_buffer = 0;
+ b->yy_input_file = 0;
+ b->yy_n_chars = b->yy_buf_size;
+ b->yy_is_interactive = 0;
+ b->yy_at_bol = 1;
+ b->yy_fill_buffer = 0;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ yy_switch_to_buffer(b );
+
+ return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to yylex() will
+ * scan from a @e copy of @a str.
+ * @param str a NUL-terminated string to scan
+ *
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ * yy_scan_bytes() instead.
+ */
+YY_BUFFER_STATE yy_scan_string (yyconst char * yy_str )
+{
+
+ return yy_scan_bytes(yy_str,strlen(yy_str) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_bytes (yyconst char * bytes, int len )
+{
+ YY_BUFFER_STATE b;
+ char *buf;
+ yy_size_t n;
+ int i;
+
+ /* Get memory for full buffer, including space for trailing EOB's. */
+ n = len + 2;
+ buf = (char *) yyalloc(n );
+ if ( ! buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+
+ for ( i = 0; i < len; ++i )
+ buf[i] = bytes[i];
+
+ buf[len] = buf[len+1] = YY_END_OF_BUFFER_CHAR;
+
+ b = yy_scan_buffer(buf,n );
+ if ( ! b )
+ YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+
+ /* It's okay to grow etc. this buffer, and we should throw it
+ * away when we're done.
+ */
+ b->yy_is_our_buffer = 1;
+
+ return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+ (void) fprintf( stderr, "%s\n", msg );
+ exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ yytext[yyleng] = (yy_hold_char); \
+ (yy_c_buf_p) = yytext + yyless_macro_arg; \
+ (yy_hold_char) = *(yy_c_buf_p); \
+ *(yy_c_buf_p) = '\0'; \
+ yyleng = yyless_macro_arg; \
+ } \
+ while ( 0 )
+
+/* Accessor methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ *
+ */
+int yyget_lineno (void)
+{
+
+ return yylineno;
+}
+
+/** Get the input stream.
+ *
+ */
+FILE *yyget_in (void)
+{
+ return yyin;
+}
+
+/** Get the output stream.
+ *
+ */
+FILE *yyget_out (void)
+{
+ return yyout;
+}
+
+/** Get the length of the current token.
+ *
+ */
+int yyget_leng (void)
+{
+ return yyleng;
+}
+
+/** Get the current token.
+ *
+ */
+
+char *yyget_text (void)
+{
+ return yytext;
+}
+
+/** Set the current line number.
+ * @param line_number
+ *
+ */
+void yyset_lineno (int line_number )
+{
+
+ yylineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ *
+ * @see yy_switch_to_buffer
+ */
+void yyset_in (FILE * in_str )
+{
+ yyin = in_str ;
+}
+
+void yyset_out (FILE * out_str )
+{
+ yyout = out_str ;
+}
+
+int yyget_debug (void)
+{
+ return yy_flex_debug;
+}
+
+void yyset_debug (int bdebug )
+{
+ yy_flex_debug = bdebug ;
+}
+
+/* yylex_destroy is for both reentrant and non-reentrant scanners. */
+int yylex_destroy (void)
+{
+
+ /* Pop the buffer stack, destroying each element. */
+ while(YY_CURRENT_BUFFER){
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ yypop_buffer_state();
+ }
+
+ /* Destroy the stack itself. */
+ yyfree((yy_buffer_stack) );
+ (yy_buffer_stack) = NULL;
+
+ yyfree ( (yy_state_buf) );
+
+ return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+ register int i;
+ for ( i = 0; i < n; ++i )
+ s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+ register int n;
+ for ( n = 0; s[n]; ++n )
+ ;
+
+ return n;
+}
+#endif
+
+void *yyalloc (yy_size_t size )
+{
+ return (void *) malloc( size );
+}
+
+void *yyrealloc (void * ptr, yy_size_t size )
+{
+ /* The cast to (char *) in the following accommodates both
+ * implementations that use char* generic pointers, and those
+ * that use void* generic pointers. It works with the latter
+ * because both ANSI C and C++ allow castless assignment from
+ * any pointer type to void*, and deal with argument conversions
+ * as though doing an assignment.
+ */
+ return (void *) realloc( (char *) ptr, size );
+}
+
+void yyfree (void * ptr )
+{
+ free( (char *) ptr ); /* see yyrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#undef YY_NEW_FILE
+#undef YY_FLUSH_BUFFER
+#undef yy_set_bol
+#undef yy_new_buffer
+#undef yy_set_interactive
+#undef yytext_ptr
+#undef YY_DO_BEFORE_ACTION
+
+#ifdef YY_DECL_IS_OURS
+#undef YY_DECL_IS_OURS
+#undef YY_DECL
+#endif
+#line 128 "./otp.l"
+
+
+
+
diff --git a/Build/source/texk/web2c/otps/mkocp b/Build/source/texk/web2c/otps/mkocp
new file mode 100755
index 00000000000..41ffead8bf1
--- /dev/null
+++ b/Build/source/texk/web2c/otps/mkocp
@@ -0,0 +1,6 @@
+#!/bin/sh
+# Initial definition. Will leave the .ocp file in the local directory.
+(
+otp2ocp `basename "$1" .ocp` || exit 1
+) 1>&2 </dev/null
+echo `basename "$1" .ocp`.ocp
diff --git a/Build/source/texk/web2c/otps/mkofm b/Build/source/texk/web2c/otps/mkofm
new file mode 100755
index 00000000000..ef820171f08
--- /dev/null
+++ b/Build/source/texk/web2c/otps/mkofm
@@ -0,0 +1,3 @@
+#!/bin/sh
+# Initial definition. For the moment only makes .tfm files.
+mktextfm $*
diff --git a/Build/source/texk/web2c/otps/otp.h b/Build/source/texk/web2c/otps/otp.h
new file mode 100644
index 00000000000..5e8433fea50
--- /dev/null
+++ b/Build/source/texk/web2c/otps/otp.h
@@ -0,0 +1,73 @@
+/* otp.h: Instructions found in OCP files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+Copyright (c) 2002 Behdad Esfahbod
+Copyright (c) 2002 Roozbeh Pournader
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+enum {
+ OTP_START_TOKENS = 256,
+ OTP_RIGHT_OUTPUT,
+ OTP_RIGHT_NUM,
+ OTP_RIGHT_CHAR,
+ OTP_RIGHT_LCHAR,
+ OTP_RIGHT_SOME,
+
+ OTP_PBACK_OUTPUT,
+ OTP_PBACK_NUM,
+ OTP_PBACK_CHAR,
+ OTP_PBACK_LCHAR,
+ OTP_PBACK_SOME,
+
+ OTP_ADD,
+ OTP_SUB,
+ OTP_MULT,
+ OTP_DIV,
+ OTP_MOD,
+ OTP_LOOKUP,
+ OTP_PUSH_NUM,
+ OTP_PUSH_CHAR,
+ OTP_PUSH_LCHAR,
+
+ OTP_STATE_CHANGE,
+ OTP_STATE_PUSH,
+ OTP_STATE_POP,
+
+ OTP_LEFT_START,
+ OTP_LEFT_RETURN,
+ OTP_LEFT_BACKUP,
+
+ OTP_GOTO,
+ OTP_GOTO_NE,
+ OTP_GOTO_EQ,
+ OTP_GOTO_LT,
+ OTP_GOTO_LE,
+ OTP_GOTO_GT,
+ OTP_GOTO_GE,
+ OTP_GOTO_NO_ADVANCE,
+ OTP_GOTO_BEG,
+ OTP_GOTO_END,
+
+ OTP_STOP,
+};
+
+#define OTP_PBACK_OFFSET (OTP_PBACK_OUTPUT - OTP_RIGHT_OUTPUT)
+
diff --git a/Build/source/texk/web2c/otps/otp.l b/Build/source/texk/web2c/otps/otp.l
new file mode 100644
index 00000000000..b80cce902bf
--- /dev/null
+++ b/Build/source/texk/web2c/otps/otp.l
@@ -0,0 +1,129 @@
+%{
+/* otp.l: Lexical analysis for OTP files
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+Copyright (c) 2002 Behdad Esfahbod
+Copyright (c) 2002 Roozbeh Pournader
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "routines.h"
+#include "yystype.h"
+#include "y_tab.h"
+#define YY_NO_UNPUT
+int line_number = 1;
+int i,j,last;
+extern YYSTYPE yylval;
+%}
+
+
+hexnumber @\"[a-fA-F0-9]+
+octnumber @'[0-7]+
+decnumber [0-9]+
+id ([a-zA-Z][_a-zA-Z0-9]*)
+string \"([^\"]|\"\")*\"
+
+%%
+[ \t] {}
+"%".*\n { line_number++;}
+\r\n|\n|\r { line_number++;}
+{hexnumber} {
+ yylval.yint=0;
+ for (i=2; i<yyleng; i++) {
+ j = yytext[i];
+ if ((j>='0')&&(j<='9')) {
+ yylval.yint = (yylval.yint*16)+(j-'0');
+ } else if ((j>='a')&&(j<='f')) {
+ yylval.yint = (yylval.yint*16)+(j-'a'+10);
+ } else { /* ((j>='A') && (j>='F')) */
+ yylval.yint = (yylval.yint*16)+(j-'A'+10);
+ }
+ if (yylval.yint>65535) {
+ fprintf(stderr, "line %d: value too large (%x)\n",
+ line_number, yylval.yint);
+ exit(1);
+ }
+ }
+ return(NUMBER);
+ }
+{octnumber} {
+ yylval.yint=0;
+ for (i=2; i<yyleng; i++) {
+ j = yytext[i];
+ yylval.yint = (yylval.yint*8)+(j-'0');
+ if (yylval.yint>65535) {
+ fprintf(stderr, "line %d: value too large (%o)\n",
+ line_number, yylval.yint);
+ exit(1);
+ }
+ }
+ return(NUMBER);
+ }
+{decnumber} {
+ yylval.yint=0;
+ for (i=0; i<yyleng; i++) {
+ j = yytext[i];
+ yylval.yint = (yylval.yint*10)+(j-'0');
+ if (yylval.yint>65535) {
+ fprintf(stderr, "line %d: value too large (%d)\n",
+ line_number, yylval.yint);
+ exit(1);
+ }
+ }
+ return(NUMBER);
+ }
+"`"[\x20-\x7e]"'" {
+ yylval.yint=yytext[1];
+ return(NUMBER);
+}
+{id} { yylval.ystring=xstrdup(yytext); return(ID); }
+{string} {
+ char *newtext;
+ last=yyleng-2;
+ i=0;
+ j=1;
+ newtext=yylval.ystring=xstrdup(yytext);
+ while (j<=last) {
+ newtext[i]=yytext[j];
+ if ((yytext[j]=='"') && (yytext[j+1]=='"')) j=j+2;
+ else j++;
+ i++;
+ }
+ newtext[i]='\0';
+ return(STRING);
+ }
+=> return(RIGHTARROW);
+"<"= return(LEFTARROW);
+input: return(INPUT);
+output: return(OUTPUT);
+aliases: return(ALIASES);
+states: return(STATES);
+tables: return(TABLES);
+expressions: return(EXPRESSIONS);
+push: return(PUSH);
+pop: return(POP);
+div: return(DIV);
+mod: return(MOD);
+beg: return(BEG);
+end: return(END);
+. return(yytext[0]);
+
+%%
+
diff --git a/Build/source/texk/web2c/otps/otp.y b/Build/source/texk/web2c/otps/otp.y
new file mode 100644
index 00000000000..ec1095eba6d
--- /dev/null
+++ b/Build/source/texk/web2c/otps/otp.y
@@ -0,0 +1,325 @@
+%{
+/* otp.y: Grammar for OTP files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "otp.h"
+#include "routines.h"
+#include "yystype.h"
+int k, len;
+
+void yyerror(char * msg)
+{
+fprintf(stderr, "line %d: %s\n", line_number, msg);
+}
+%}
+
+%token NUMBER
+%token ID
+%token STRING
+%token LEFTARROW
+%token RIGHTARROW
+%token INPUT
+%token OUTPUT
+%token ALIASES
+%token STATES
+%token TABLES
+%token EXPRESSIONS
+%token PUSH
+%token POP
+%token DIV
+%token MOD
+%token BEG
+%token END
+
+%left '+' '-'
+%left '*' DIV MOD
+
+%%
+
+File :
+ Input
+ Output
+ Tables
+ States
+ Aliases
+ Expressions
+ ;
+
+Input :
+ /* Empty */
+ { input_bytes=2; }
+ | INPUT NUMBER ';'
+ { input_bytes=$2.yint; }
+ ;
+
+Output :
+ /* Empty */
+ { output_bytes=2; }
+ | OUTPUT NUMBER ';'
+ { output_bytes=$2.yint; }
+ ;
+
+Tables :
+ /* Empty */
+ | TABLES MoreTables
+ ;
+
+MoreTables :
+ OneTable
+ | MoreTables OneTable
+ ;
+
+OneTable :
+ ID '[' NUMBER ']'
+ { store_table($1.ystring, $3.yint); }
+ '=' '{' Numbers '}' ';'
+ ;
+
+Numbers :
+ /* Empty */
+ | MoreNumbers
+ ;
+
+MoreNumbers :
+ NUMBER
+ { add_to_table($1.yint); }
+ | MoreNumbers ',' NUMBER
+ { add_to_table($3.yint); }
+ ;
+
+States :
+ /* Empty */
+ | STATES MoreStates ';'
+ ;
+
+MoreStates :
+ ID
+ { store_state($1.ystring); }
+ | MoreStates ',' ID
+ { store_state($3.ystring); }
+ ;
+
+Aliases :
+ /* Empty */
+ | ALIASES MoreAliases
+ ;
+
+MoreAliases :
+ OneAlias
+ | MoreAliases OneAlias
+ ;
+
+OneAlias :
+ ID '=' OneCompleteLeft ';'
+ { store_alias($1.ystring, $3.yleft); }
+ ;
+
+OneCompleteLeft :
+ STRING
+ { $$.yleft = StringLeft($1.ystring); }
+ | OneLeft '<' NUMBER ',' NUMBER '>'
+ { $$.yleft = CompleteLeft($1.yleft, $3.yint, $5.yint); }
+ | OneLeft '<' NUMBER ',' '>'
+ { $$.yleft = PlusLeft($1.yleft, $3.yint); }
+ | OneLeft
+ { $$.yleft = $1.yleft; }
+ ;
+
+OneLeft :
+ NUMBER
+ { $$.yleft = SingleLeft($1.yint); }
+ | NUMBER '-' NUMBER
+ { $$.yleft = DoubleLeft($1.yint, $3.yint); }
+ | '.'
+ { $$.yleft = WildCard(); }
+ | '^' '(' ChoiceLeft ')'
+ { $$.yleft = NotChoiceLeft($3.ylleft); }
+ | '(' ChoiceLeft ')'
+ { $$.yleft = ChoiceLeft($2.ylleft); }
+ | '{' ID '}'
+ { $$.yleft = lookup_alias($2.ystring); }
+ ;
+
+ChoiceLeft :
+ OneLeft
+ { $$.ylleft = llist1($1.yleft); }
+ | ChoiceLeft '|' OneLeft
+ { $$.ylleft = lappend1($1.ylleft, $3.yleft); }
+ ;
+
+Expressions :
+ EXPRESSIONS MoreExpressions
+ {
+ for(cur_state=0; cur_state<no_states; cur_state++) {
+ if ((states[cur_state].no_exprs)==0) {
+ out_int(OTP_LEFT_START, 0);
+ } else {
+ out_int(OTP_LEFT_RETURN, 0);
+ }
+ out_int(OTP_RIGHT_CHAR, 1);
+ out_int(OTP_STOP, 0);
+ }
+ }
+ ;
+
+MoreExpressions :
+ OneExpr
+ | MoreExpressions OneExpr
+ ;
+
+OneExpr :
+ LeftState
+ { states[cur_state].no_exprs++; }
+ TotalLeft
+ { out_left($3.ylleft); right_offset=0; }
+ RIGHTARROW Right
+ { right_offset=OTP_PBACK_OFFSET; }
+ PushBack RightState ';'
+ { fill_in_left(); }
+ ;
+
+PushBack :
+ /* Empty */
+ | LEFTARROW Right
+ ;
+
+LeftState :
+ /* Empty */
+ { cur_state = 0; }
+ | '<' ID '>'
+ { cur_state = lookup_state($2.ystring); }
+ ;
+
+TotalLeft :
+ BegLeft Left EndLeft
+ { $$.ylleft = lappend($1.ylleft, lappend($2.ylleft, $3.ylleft)); }
+| BegLeft EndLeft
+ { $$.ylleft = lappend($1.ylleft, $2.ylleft); }
+ ;
+
+BegLeft :
+ /* Empty */
+ { $$.ylleft = nil; }
+ | BEG
+ { $$.ylleft = llist1(BeginningLeft()); }
+ ;
+
+EndLeft :
+ /* Empty */
+ { $$.ylleft = nil; }
+ | END
+ { $$.ylleft = llist1(EndLeft()); }
+ ;
+
+Left :
+ OneCompleteLeft
+ { $$.ylleft = llist1($1.yleft); }
+ | Left OneCompleteLeft
+ { $$.ylleft = lappend1($1.ylleft, $2.yleft); }
+ ;
+
+Right :
+ /* Empty */
+ | Right OneRight
+ ;
+
+OneRight :
+ STRING
+ {
+ len=strlen($1.ystring);
+ for (k=0; k<len; k++) {
+ out_right(OTP_RIGHT_NUM, ($1.ystring)[k]);
+ }
+ }
+ | NUMBER
+ { out_right(OTP_RIGHT_NUM, $1.yint); }
+ | '\\' NUMBER
+ { out_right(OTP_RIGHT_CHAR, $2.yint); }
+ | '\\' '$'
+ { out_right(OTP_RIGHT_LCHAR, 0); }
+ | '\\' '(' '$' '-' NUMBER ')'
+ { out_right(OTP_RIGHT_LCHAR, $5.yint); }
+ | '\\' '*'
+ {
+ out_right(OTP_RIGHT_SOME, 0);
+ out_int(0,0);
+ }
+ | '\\' '(' '*' '+' NUMBER ')'
+ {
+ out_right(OTP_RIGHT_SOME, $5.yint);
+ out_int(0, 0);
+ }
+ | '\\' '(' '*' '-' NUMBER ')'
+ {
+ out_right(OTP_RIGHT_SOME, 0);
+ out_int(0, $5.yint);
+ }
+ | '\\' '(' '*' '+' NUMBER '-' NUMBER ')'
+ {
+ out_right(OTP_RIGHT_SOME, $5.yint);
+ out_int(0, $7.yint);
+ }
+ | '#' OneRightExpr
+ { out_right(OTP_RIGHT_OUTPUT, 0); }
+ ;
+
+RestRightExpr :
+ OneRightExpr
+ | RestRightExpr '+' OneRightExpr
+ { out_int(OTP_ADD, 0); }
+ | RestRightExpr '-' OneRightExpr
+ { out_int(OTP_SUB, 0); }
+ | RestRightExpr '*' OneRightExpr
+ { out_int(OTP_MULT, 0); }
+ | RestRightExpr DIV OneRightExpr
+ { out_int(OTP_DIV, 0); }
+ | RestRightExpr MOD OneRightExpr
+ { out_int(OTP_MOD, 0); }
+ | ID
+ { out_int(OTP_PUSH_NUM, lookup_table($1.ystring)); }
+ '[' RestRightExpr ']'
+ { out_int(OTP_LOOKUP, 0); }
+ ;
+
+OneRightExpr :
+ NUMBER
+ { out_int(OTP_PUSH_NUM, $1.yint); }
+ | '\\' NUMBER
+ { out_int(OTP_PUSH_CHAR, $2.yint); }
+ | '\\' '$'
+ { out_int(OTP_PUSH_LCHAR, 0); }
+ | '\\' '(' '$' '-' NUMBER ')'
+ { out_int(OTP_PUSH_LCHAR, $5.yint); }
+ | '(' RestRightExpr ')'
+ ;
+
+RightState :
+ /* Empty */
+ | '<' ID '>'
+ { out_int(OTP_STATE_CHANGE, lookup_state($2.ystring)); }
+ | '<' PUSH ID '>'
+ { out_int(OTP_STATE_PUSH, lookup_state($3.ystring)); }
+ | '<' POP '>'
+ { out_int(OTP_STATE_POP, 0); }
+ ;
+%%
diff --git a/Build/source/texk/web2c/otps/otp2ocp.c b/Build/source/texk/web2c/otps/otp2ocp.c
new file mode 100644
index 00000000000..bb1e41b1148
--- /dev/null
+++ b/Build/source/texk/web2c/otps/otp2ocp.c
@@ -0,0 +1,173 @@
+/* otp2ocp.c: Main program for transforming OTP files into OCP files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+Copyright (c) 2002 Behdad Esfahbod
+Copyright (c) 2002 Roozbeh Pournader
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include <kpathsea/config.h>
+#include <kpathsea/types.h>
+#include <kpathsea/c-proto.h>
+#include <kpathsea/c-std.h>
+#include <kpathsea/c-fopen.h>
+#include <kpathsea/tex-file.h>
+#include "routines.h"
+
+extern FILE *yyin;
+int yywrap
+P1H (void)
+{
+ return 1;
+}
+
+void output
+P2C (FILE *, output_file, int, i)
+{
+/* make sure output is in big-endian form */
+ char j;
+ int k;
+ k = i;
+ j = k >> 24;
+ fwrite (&j, 1, 1, output_file);
+ k = k & 0xffffff;
+ j = k >> 16;
+ fwrite (&j, 1, 1, output_file);
+ k = k & 0xffff;
+ j = k >> 8;
+ fwrite (&j, 1, 1, output_file);
+ j = k & 0xff;
+ fwrite (&j, 1, 1, output_file);
+}
+
+void otp_read
+P2C (string, input_name, string, output_name)
+{
+ int i, j, len, no_words;
+ int *table, *instrs;
+ FILE *input_file, *output_file;
+
+ input_file = xfopen (input_name, FOPEN_R_MODE);
+ store_state ("INITIAL");
+ yyin = input_file;
+ if (yyparse ())
+ exit (EXIT_FAILURE);
+ output_file = xfopen (output_name, FOPEN_WBIN_MODE);
+ room_for_tables = 0;
+ for (i = 0; i < no_tables; i++)
+ {
+ room_for_tables = room_for_tables + tables[i].length;
+ }
+ room_for_states = 0;
+ for (i = 0; i < no_states; i++)
+ {
+ room_for_states = room_for_states + states[i].length;
+ }
+ no_words = no_tables + room_for_tables + no_states + room_for_states + 7;
+ output (output_file, no_words);
+ output (output_file, input_bytes);
+ output (output_file, output_bytes);
+ output (output_file, no_tables);
+ output (output_file, room_for_tables);
+ output (output_file, no_states);
+ output (output_file, room_for_states);
+ for (i = 0; i < no_tables; i++)
+ {
+ len = tables[i].length;
+ output (output_file, len);
+ }
+ for (i = 0; i < no_tables; i++)
+ {
+ len = tables[i].length;
+ table = tables[i].table;
+ for (j = 0; j < len; j++)
+ {
+ output (output_file, table[j]);
+ }
+ }
+ for (i = 0; i < no_states; i++)
+ {
+ len = states[i].length;
+ output (output_file, len);
+ }
+ for (i = 0; i < no_states; i++)
+ {
+ len = states[i].length;
+ instrs = states[i].instrs;
+ for (j = 0; j < len; j++)
+ {
+ output (output_file, instrs[j]);
+ }
+ }
+}
+
+int main
+P2C (int, argc, string *, argv)
+{
+ string input_name, full_input_name;
+ string output_name;
+
+ kpse_set_progname (argv[0]);
+ switch (argc)
+ {
+ case 1:
+ fprintf (stderr, "otp2ocp: No file given\n");
+ return EXIT_FAILURE;
+ case 2:
+ {
+ int len;
+ input_name = argv[1];
+ len = strlen (input_name);
+ output_name = malloc (len + 5);
+ if (!output_name)
+ {
+ fprintf (stderr, "otp2ocp: Memory exhausted\n");
+ return EXIT_FAILURE;
+ }
+ strcpy (output_name, xbasename (input_name));
+ len = strlen (output_name);
+ if (len > 4 && 0 == strcmp (output_name + len - 4, ".otp"))
+ {
+ strcpy (output_name + len - 4, ".ocp");
+ }
+ else
+ {
+ strcat (output_name, ".ocp");
+ }
+ break;
+ }
+ case 3:
+ input_name = argv[1];
+ output_name = argv[2];
+ break;
+ default:
+ fprintf (stderr, "otp2ocp: Too many arguments\n");
+ return EXIT_FAILURE;
+ }
+ full_input_name = kpse_find_file (input_name, kpse_otp_format, true);
+ if (!full_input_name)
+ {
+ fprintf (stderr, "otp2ocp: %s not found\n", input_name);
+ return EXIT_FAILURE;
+ }
+ otp_read (full_input_name, output_name);
+
+ return EXIT_SUCCESS;
+}
diff --git a/Build/source/texk/web2c/otps/outocp.c b/Build/source/texk/web2c/otps/outocp.c
new file mode 100644
index 00000000000..4adc01255b1
--- /dev/null
+++ b/Build/source/texk/web2c/otps/outocp.c
@@ -0,0 +1,228 @@
+/* outocp.c: ASCII output for OCP files, mainly for debugging purposes.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include <kpathsea/config.h>
+#include <kpathsea/types.h>
+#include <kpathsea/c-proto.h>
+#include <kpathsea/c-std.h>
+#include <kpathsea/c-fopen.h>
+#include <kpathsea/tex-file.h>
+#include "otp.h"
+
+char *otp_names[] = {
+ " ",
+ "OTP_RIGHT_OUTPUT ",
+ "OTP_RIGHT_NUM ",
+ "OTP_RIGHT_CHAR ",
+ "OTP_RIGHT_LCHAR ",
+ "OTP_RIGHT_SOME ",
+ "OTP_PBACK_OUTPUT ",
+ "OTP_PBACK_NUM ",
+ "OTP_PBACK_CHAR ",
+ "OTP_PBACK_LCHAR ",
+ "OTP_PBACK_SOME ",
+ "OTP_ADD ",
+ "OTP_SUB ",
+ "OTP_MULT ",
+ "OTP_DIV ",
+ "OTP_MOD ",
+ "OTP_LOOKUP ",
+ "OTP_PUSH_NUM ",
+ "OTP_PUSH_CHAR ",
+ "OTP_PUSH_LCHAR ",
+ "OTP_STATE_CHANGE ",
+ "OTP_STATE_PUSH ",
+ "OTP_STATE_POP ",
+ "OTP_LEFT_START ",
+ "OTP_LEFT_RETURN ",
+ "OTP_LEFT_BACKUP ",
+ "OTP_GOTO ",
+ "OTP_GOTO_NE ",
+ "OTP_GOTO_EQ ",
+ "OTP_GOTO_LT ",
+ "OTP_GOTO_LE ",
+ "OTP_GOTO_GT ",
+ "OTP_GOTO_GE ",
+ "OTP_GOTO_NO_ADVANCE",
+ "OTP_GOTO_BEG ",
+ "OTP_GOTO_END ",
+ "OTP_STOP "
+};
+
+
+void ctp_abort
+P1C (string, s)
+{
+ fprintf (stderr, s);
+ exit (EXIT_FAILURE);
+}
+
+int no_words_read = 0;
+
+int ctp_get
+P1C (FILE *, input_file)
+{
+ int ctpchar;
+ ctpchar = getc (input_file);
+ if (ctpchar == EOF)
+ {
+ ctp_abort ("Unexpected end of file\n");
+ }
+ return ctpchar;
+}
+
+int ctp_read
+P1C (FILE *, input_file)
+{
+ int ctpword;
+ no_words_read++;
+ ctpword = ctp_get (input_file);
+ if (ctpword > 127)
+ {
+ ctp_abort ("first octet > 127");
+ }
+ ctpword = ctpword * 256 + ctp_get (input_file);
+ ctpword = ctpword * 256 + ctp_get (input_file);
+ ctpword = ctpword * 256 + ctp_get (input_file);
+ return ctpword;
+}
+
+void ctp_explain
+P1C (FILE *, input_file)
+{
+ int i, j, arg, entry, instruction;
+ int ctp_length, real_ctp_length, ctp_input, ctp_output,
+ ctp_no_tables, ctp_room_tables, ctp_no_states, ctp_room_states;
+ int room_tables[100], room_states[100];
+
+ ctp_length = ctp_read (input_file);
+ fprintf (stdout, "ctp_length : %3x(%3d)\n", ctp_length, ctp_length);
+ real_ctp_length = ctp_length - 7;
+ fprintf (stdout, "real_ctp_length: %3x(%3d)\n",
+ real_ctp_length, real_ctp_length);
+ ctp_input = ctp_read (input_file);
+ fprintf (stdout, "ctp_input : %3x(%3d)\n", ctp_input, ctp_input);
+ ctp_output = ctp_read (input_file);
+ fprintf (stdout, "ctp_output : %3x(%3d)\n", ctp_output, ctp_output);
+ ctp_no_tables = ctp_read (input_file);
+ fprintf (stdout, "ctp_no_tables : %3x(%3d)\n",
+ ctp_no_tables, ctp_no_tables);
+ ctp_room_tables = ctp_read (input_file);
+ fprintf (stdout, "ctp_room_tables: %3x(%3d)\n",
+ ctp_room_tables, ctp_room_tables);
+ ctp_no_states = ctp_read (input_file);
+ fprintf (stdout, "ctp_no_states : %3x(%3d)\n",
+ ctp_no_states, ctp_no_states);
+ ctp_room_states = ctp_read (input_file);
+ fprintf (stdout, "ctp_room_states: %3x(%3d)\n\n",
+ ctp_room_states, ctp_room_states);
+ if (ctp_no_tables >= 100)
+ {
+ ctp_abort ("Too many tables\n");
+ }
+ if (ctp_no_states >= 100)
+ {
+ ctp_abort ("Too many states\n");
+ }
+ if (ctp_no_tables != 0)
+ {
+ for (i = 0; i < ctp_no_tables; i++)
+ {
+ room_tables[i] = ctp_read (input_file);
+ fprintf (stdout, "Table %2x(%2d): %3x(%3d)entries\n",
+ i, i, room_tables[i], room_tables[i]);
+ }
+ fprintf (stdout, "\n");
+ for (i = 0; i < ctp_no_tables; i++)
+ {
+ for (j = 0; j < room_tables[i]; j++)
+ {
+ entry = ctp_read (input_file);
+ fprintf (stdout, "Table %2x(%2d), entry %3x(%3d): %2x(%3d)\n",
+ i, i, j, j, entry, entry);
+ }
+ }
+ fprintf (stdout, "\n");
+ }
+ if (ctp_no_states != 0)
+ {
+ for (i = 0; i < ctp_no_states; i++)
+ {
+ room_states[i] = ctp_read (input_file);
+ fprintf (stdout, "State %2x(%2d): %3x(%3d) entries\n",
+ i, i, room_states[i], room_states[i]);
+ }
+ fprintf (stdout, "\n");
+ for (i = 0; i < ctp_no_states; i++)
+ {
+ for (j = 0; j < room_states[i]; j++)
+ {
+ instruction = ctp_read (input_file);
+ arg = instruction & 0xffffff;
+ if ((arg >= 32) && (arg < 127))
+ fprintf (stdout,
+ "State %2x(%2d), entry %3x(%3d): %s %2x(%3d,`%c')\n",
+ i, i, j, j, otp_names[instruction >> 24],
+ arg, arg, arg);
+ else
+ fprintf (stdout,
+ "State %2x(%2d), entry %3x(%3d): %s %2x(%3d)\n",
+ i, i, j, j, otp_names[instruction >> 24], arg, arg);
+ }
+ }
+ }
+ fprintf (stdout, "\nfile length should be: %3x(%3d)\n",
+ ctp_length, ctp_length);
+ fprintf (stdout, "number words read : %3x(%3d)\n",
+ no_words_read, no_words_read);
+}
+
+int main
+P2C (int, argc, string *, argv)
+{
+ string input_name, full_input_name;
+ FILE *input_file;
+
+ kpse_set_progname (argv[0]);
+ switch (argc)
+ {
+ case 1:
+ fprintf (stderr, "outocp: No file given\n");
+ return EXIT_FAILURE;
+ case 2:
+ input_name = argv[1];
+ break;
+ default:
+ fprintf (stderr, "outocp: Too many arguments\n");
+ return EXIT_FAILURE;
+ }
+ full_input_name = kpse_find_file (input_name, kpse_ocp_format, true);
+ if (!full_input_name)
+ {
+ fprintf (stderr, "outocp: %s not found\n", input_name);
+ return EXIT_FAILURE;
+ }
+ input_file = xfopen (full_input_name, FOPEN_RBIN_MODE);
+ ctp_explain (input_file);
+ return EXIT_SUCCESS;
+}
diff --git a/Build/source/texk/web2c/otps/routines.c b/Build/source/texk/web2c/otps/routines.c
new file mode 100644
index 00000000000..4dcc8b66f9e
--- /dev/null
+++ b/Build/source/texk/web2c/otps/routines.c
@@ -0,0 +1,549 @@
+/* routines.c: Generating the finite state automaton.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include <kpathsea/config.h>
+#include <kpathsea/types.h>
+#include <kpathsea/c-proto.h>
+#include <kpathsea/c-std.h>
+#include "routines.h"
+#include "otp.h"
+
+#define out_ptr (states[cur_state].length)
+#define out_array (states[cur_state].instrs)
+
+list left_false_holes;
+
+int left_state;
+int right_offset;
+int input_bytes;
+int output_bytes;
+
+int no_states = 0;
+int cur_state = 0;
+int room_for_states = 0;
+state_type states[100];
+
+int no_tables = 0;
+int cur_table = 0;
+int room_for_tables = 0;
+table_type tables[100];
+
+int no_aliases = 0;
+alias_pair aliases[1000];
+
+list
+cons P2C(int, x, list, L)
+{
+list temp;
+temp = (list) malloc(sizeof(cell));
+temp->val = x;
+temp->ptr = L;
+return temp;
+}
+
+list
+list1 P1C(int, x)
+{
+list temp;
+temp = (list) malloc(sizeof(cell));
+temp->val = x;
+temp->ptr = nil;
+return temp;
+}
+
+list
+list2 P2C(int, x, int, y)
+{
+list temp, temp1;
+temp = (list) malloc(sizeof(cell));
+temp1 = (list) malloc(sizeof(cell));
+temp->val = x;
+temp->ptr = temp1;
+temp1->val = y;
+temp1->ptr = nil;
+return temp;
+}
+
+list
+append P2C(list, K, list, L)
+{
+if (K==nil) return L;
+return cons(K->val, append(K->ptr, L));
+}
+
+list
+append1 P2C(list, L, int, x)
+{
+return (append(L,list1(x)));
+}
+
+llist
+lcons P2C(left, x, llist, L)
+{
+llist temp;
+temp = (llist) malloc(sizeof(lcell));
+temp->val = x;
+temp->ptr = L;
+return temp;
+}
+
+llist
+llist1 P1C(left, x)
+{
+llist temp;
+temp = (llist) malloc(sizeof(lcell));
+temp->val = x;
+temp->ptr = nil;
+return temp;
+}
+
+llist
+llist2 P2C(left, x, left, y)
+{
+llist temp, temp1;
+temp = (llist) malloc(sizeof(lcell));
+temp1 = (llist) malloc(sizeof(lcell));
+temp->val = x;
+temp->ptr = temp1;
+temp1->val = y;
+temp1->ptr = nil;
+return temp;
+}
+
+llist
+lappend P2C(llist, K, llist, L)
+{
+if (K==nil) return L;
+return lcons(K->val, lappend(K->ptr, L));
+}
+
+llist
+lappend1 P2C(llist, L, left, x)
+{
+return (lappend(L,llist1(x)));
+}
+
+left
+WildCard P1H(void)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=WILDCARD;
+return temp;
+}
+
+left
+StringLeft P1C(char *, x)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=STRINGLEFT;
+temp->valstr=x;
+return temp;
+}
+
+left
+SingleLeft P1C(int, x)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=SINGLELEFT;
+temp->val1=x;
+return temp;
+}
+
+left
+DoubleLeft P2C(int, x, int, y)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=DOUBLELEFT;
+temp->val1=x;
+temp->val2=y;
+return temp;
+}
+
+left
+ChoiceLeft P1C(llist, L)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=CHOICELEFT;
+temp->more_lefts=L;
+return temp;
+}
+
+left
+NotChoiceLeft P1C(llist, L)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=NOTCHOICELEFT;
+temp->more_lefts=L;
+return temp;
+}
+
+left
+PlusLeft P2C(left, l, int, n)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=PLUSLEFT;
+temp->one_left=l;
+temp->val1=n;
+return temp;
+}
+
+left
+CompleteLeft P3C(left, l, int, n, int, m)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=COMPLETELEFT;
+temp->one_left=l;
+temp->val1=n;
+temp->val2=m;
+return temp;
+}
+
+left
+BeginningLeft P1H(void)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=BEGINNINGLEFT;
+return temp;
+}
+
+left
+EndLeft P1H(void)
+{
+left temp;
+temp = (left) malloc(sizeof(lft_cell));
+temp->kind=ENDLEFT;
+return temp;
+}
+
+list
+gen_left P1C(left, arg)
+{
+int save_ptr, k;
+list holes, false_holes, true_holes, backup_holes;
+char *runner;
+llist p;
+
+switch(arg->kind) {
+case WILDCARD:
+ return nil;
+case STRINGLEFT:
+ runner=arg->valstr;
+ holes=nil;
+ while (*runner) {
+ out_int(OTP_GOTO_NE, *runner);
+ out_int(0, 0);
+ holes=cons(out_ptr-1,holes);
+ runner++;
+ if (*runner) {
+ out_int(OTP_GOTO_NO_ADVANCE, 0);
+ holes = cons(out_ptr-1, holes);
+ }
+ }
+ return holes;
+case SINGLELEFT:
+ out_int(OTP_GOTO_NE, arg->val1);
+ out_int(0, 0);
+ return list1(out_ptr-1);
+case DOUBLELEFT:
+ out_int(OTP_GOTO_LT, arg->val1);
+ out_int(0, 0);
+ save_ptr = out_ptr;
+ out_int(OTP_GOTO_GT, arg->val2);
+ out_int(0, 0);
+ return list2(save_ptr-1, out_ptr-1);
+case CHOICELEFT:
+ true_holes=nil;
+ false_holes=nil;
+ p=arg->more_lefts;
+ while (p!=nil) {
+ false_holes = gen_left(p->val);
+ if (p->ptr) {
+ out_int(OTP_GOTO, 0);
+ true_holes=cons(out_ptr-1, true_holes);
+ fill_in(false_holes);
+ }
+ p=p->ptr;
+ }
+ fill_in(true_holes);
+ return false_holes;
+case NOTCHOICELEFT:
+ true_holes=nil;
+ p=arg->more_lefts;
+ while (p!=nil) {
+ false_holes = gen_left(p->val);
+ out_int(OTP_GOTO, 0);
+ true_holes=cons(out_ptr-1, true_holes);
+ fill_in(false_holes);
+ p=p->ptr;
+ }
+ return true_holes;
+case PLUSLEFT:
+ false_holes=nil;
+ true_holes=nil;
+ backup_holes=nil;
+ k=1;
+ while (k<arg->val1) {
+ holes = gen_left(arg->one_left);
+ false_holes = append(false_holes, holes);
+ out_int(OTP_GOTO_NO_ADVANCE, 0);
+ false_holes = cons(out_ptr-1, false_holes);
+ k++;
+ }
+ holes=gen_left(arg->one_left);
+ false_holes = append(false_holes, holes);
+ save_ptr = out_ptr;
+ out_int(OTP_GOTO_NO_ADVANCE, 0);
+ true_holes=cons(out_ptr-1, true_holes);
+ backup_holes=gen_left(arg->one_left);
+ out_int(OTP_GOTO, save_ptr);
+ fill_in(backup_holes);
+ out_int(OTP_LEFT_BACKUP, 0);
+ fill_in(true_holes);
+ return false_holes;
+case COMPLETELEFT:
+ false_holes=nil;
+ true_holes=nil;
+ backup_holes=nil;
+ k=1;
+ if (arg->val1 > arg->val2) {
+ return nil;
+ }
+ while (k<=arg->val1) {
+ holes = gen_left(arg->one_left);
+ false_holes = append(false_holes, holes);
+ out_int(OTP_GOTO_NO_ADVANCE, 0);
+ false_holes = cons(out_ptr-1, false_holes);
+ k++;
+ }
+ while (k<arg->val2) {
+ holes = gen_left(arg->one_left);
+ true_holes = append(true_holes, holes);
+ out_int(OTP_GOTO_NO_ADVANCE, 0);
+ backup_holes = cons(out_ptr-1, backup_holes);
+ k++;
+ }
+ holes = gen_left(arg->one_left);
+ true_holes = append(true_holes, holes);
+ out_int(OTP_GOTO, out_ptr+2);
+ fill_in(true_holes);
+ out_int(OTP_LEFT_BACKUP, 0);
+ fill_in(backup_holes);
+ return false_holes;
+case BEGINNINGLEFT:
+ out_int(OTP_GOTO_BEG, 0);
+ true_holes=list1(out_ptr-1);
+ out_int(OTP_GOTO, 0);
+ false_holes=list1(out_ptr-1);
+ fill_in(true_holes);
+ return false_holes;
+case ENDLEFT:
+ out_int(OTP_GOTO_END, 0);
+ true_holes=list1(out_ptr-1);
+ out_int(OTP_GOTO, 0);
+ false_holes=list1(out_ptr-1);
+ fill_in(true_holes);
+ return false_holes;
+default:
+ fprintf(stderr, "Unrecognized left: %d\n", arg->kind);
+ exit(EXIT_FAILURE);
+}
+}
+
+void
+store_alias P2C(string, str, left, l)
+{
+int i;
+for (i=0; i<no_aliases; i++) {
+ if (!strcmp(str,aliases[i].str)) {
+ fprintf(stderr, "alias %s already defined\n", str);
+ exit(1);
+ }
+}
+aliases[i].str=xstrdup(str);
+aliases[i].left_val=l;
+no_aliases++;
+}
+
+left
+lookup_alias P1C(string, str)
+{
+int i;
+for (i=0; i<no_aliases; i++) {
+ if (!strcmp(str,aliases[i].str)) {
+ return aliases[i].left_val;
+ }
+}
+fprintf(stderr, "state %s not defined\n", str);
+exit(EXIT_FAILURE);
+}
+
+void
+out_left P1C(llist, L)
+{
+llist p;
+list holes;
+if ((states[cur_state].no_exprs)==1) {
+ out_int(OTP_LEFT_START, 0);
+} else {
+ out_int(OTP_LEFT_RETURN, 0);
+}
+p=L;
+left_false_holes=nil;
+while (p!=nil) {
+ holes = gen_left(p->val);
+ if ((p->ptr != nil) &&
+ ((p->val)->kind !=BEGINNINGLEFT) &&
+ (((p->ptr)->val)->kind !=ENDLEFT)) {
+ out_int(OTP_GOTO_NO_ADVANCE, 0);
+ left_false_holes = cons(out_ptr-1,left_false_holes);
+ }
+ left_false_holes = append(left_false_holes, holes);
+ p=p->ptr;
+}
+}
+
+void
+fill_in_left P1H(void)
+{
+ out_int(OTP_STOP, 0);
+ fill_in(left_false_holes);
+}
+
+void
+fill_in P1C(list, L)
+{
+list p;
+p=L;
+while (p!=0) {
+ out_array[p->val] = out_array[p->val] + out_ptr;
+ p=p->ptr;
+}
+}
+
+void
+out_right P2C(int, instr, int, val)
+{
+out_int(instr+right_offset, val);
+}
+
+void
+out_int P2C(int, instr, int, val)
+{
+if (val>=(1<<24)) {
+ fprintf(stderr, "Argument (%d) of instruction too big\n", val);
+ exit(EXIT_FAILURE);
+}
+add_to_state((instr<<24)+val);
+}
+
+void
+store_state P1C(string, str)
+{
+int i;
+for (i=0; i<no_states; i++) {
+ if (!strcmp(str,states[i].str)) {
+ fprintf(stderr, "state %s already defined\n", str);
+ exit(EXIT_FAILURE);
+ }
+}
+states[i].str=xstrdup(str);
+states[i].length=0;
+states[i].no_exprs=0;
+cur_state=i;
+no_states++;
+}
+
+int
+lookup_state P1C(string, str)
+{
+int i;
+for (i=0; i<no_states; i++) {
+ if (!strcmp(str,states[i].str)) {
+ return i;
+ }
+}
+fprintf(stderr, "state %s not defined\n", str);
+exit(EXIT_FAILURE);
+}
+
+void
+add_to_state P1C(int, x)
+{
+int len;
+len = states[cur_state].length;
+if (len > ARRAY_SIZE) {
+ char * str = states[cur_state].str;
+ fprintf(stderr, "%s state has too many instructions\n", str);
+ exit(EXIT_FAILURE);
+}
+(states[cur_state].instrs)[len] = x;
+states[cur_state].length = len+1;
+}
+
+void
+store_table P2C(string, str, int, len)
+{
+int i;
+for (i=0; i<no_tables; i++) {
+ if (!strcmp(str,tables[i].str)) {
+ fprintf(stderr, "table %s already defined\n", str);
+ exit(EXIT_FAILURE);
+ }
+}
+tables[i].str=xstrdup(str);
+tables[i].length=0;
+cur_table=i;
+no_tables++;
+}
+
+void
+add_to_table P1C(int, x)
+{
+int len;
+len = tables[cur_table].length;
+(tables[cur_table].table)[len] = x;
+tables[cur_table].length = len+1;
+}
+
+int
+lookup_table P1C(string, str)
+{
+int i;
+for (i=0; i<no_tables; i++) {
+ if (!strcmp(str,tables[i].str)) {
+ return i;
+ }
+}
+fprintf(stderr, "table %s not defined\n", str);
+exit(EXIT_FAILURE);
+}
+
diff --git a/Build/source/texk/web2c/otps/routines.h b/Build/source/texk/web2c/otps/routines.h
new file mode 100644
index 00000000000..2e4a7ee8d93
--- /dev/null
+++ b/Build/source/texk/web2c/otps/routines.h
@@ -0,0 +1,148 @@
+/* routines.h: Generating the finite state automaton
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+#ifdef KPATHSEA
+#include <kpathsea/config.h>
+#include <kpathsea/c-memstr.h>
+#include <kpathsea/c-std.h>
+#else /* !KPATHSEA */
+#include <stdio.h>
+#include <string.h>
+#ifdef __STDC__
+#include <stdlib.h>
+#else
+extern void exit();
+#endif
+#endif /* KPATHSEA */
+
+#define nil 0
+
+#define WILDCARD 0
+#define STRINGLEFT 1
+#define SINGLELEFT 2
+#define DOUBLELEFT 3
+#define CHOICELEFT 4
+#define NOTCHOICELEFT 5
+#define PLUSLEFT 6
+#define COMPLETELEFT 7
+#define BEGINNINGLEFT 8
+#define ENDLEFT 9
+
+extern int yyparse();
+extern int yylex();
+
+extern int line_number;
+typedef struct cell_struct {struct cell_struct *ptr;
+ int val; } cell;
+typedef cell *list;
+
+typedef struct left_cell {
+ int kind;
+ int val1, val2;
+ char *valstr;
+ struct lcell_struct *more_lefts;
+ struct left_cell *one_left;
+} lft_cell;
+typedef lft_cell *left;
+
+typedef struct lcell_struct {struct lcell_struct *ptr;
+ left val; } lcell;
+typedef lcell *llist;
+
+extern list cons();
+extern list list1();
+extern list list2();
+extern list append();
+extern list append1();
+
+extern llist lcons();
+extern llist llist1 P1H(left);
+extern llist llist2();
+extern llist lappend P2H(llist,llist);
+extern llist lappend1 P2H(llist,left);
+
+extern left WildCard();
+extern left SingleLeft P1H(int);
+extern left StringLeft P1H(char *);
+extern left DoubleLeft P2H(int,int);
+extern left ChoiceLeft P1H(llist);
+extern left NotChoiceLeft P1H(llist);
+extern left PlusLeft P2H(left,int);
+extern left CompleteLeft P3H(left,int,int);
+extern left BeginningLeft();
+extern left EndLeft();
+extern list gen_left();
+extern void fill_in_left();
+extern void out_left P1H(llist);
+extern int no_lefts;
+
+extern void store_alias P2H(string, left);
+extern left lookup_alias P1H(string);
+
+#define ARRAY_SIZE 10000
+typedef struct {
+ int length;
+ char * str;
+ int table[ARRAY_SIZE];
+} table_type;
+
+extern int no_tables;
+extern int cur_table;
+extern int room_for_tables;
+extern table_type tables[];
+extern void add_to_table P1H(int);
+
+typedef struct {
+ int length;
+ char * str;
+ int no_exprs;
+ int instrs[ARRAY_SIZE];
+} state_type;
+
+extern int no_states;
+extern int cur_state;
+extern int room_for_states;
+extern state_type states[];
+extern void add_to_state P1H(int);
+
+extern void fill_in P1H(list);
+extern void right_int();
+extern void out_int P2H(int,int);
+extern void out_right P2H(int,int);
+
+extern void store_state P1H(string);
+extern int lookup_state P1H(string);
+extern void store_table P2H(string, int);
+extern int lookup_table P1H(string);
+
+typedef struct { char * str; left left_val; } alias_pair;
+
+extern alias_pair aliases[];
+
+extern int right_offset;
+extern int input_bytes;
+extern int output_bytes;
+
diff --git a/Build/source/texk/web2c/otps/win32.mak b/Build/source/texk/web2c/otps/win32.mak
new file mode 100644
index 00000000000..b8269f57ed2
--- /dev/null
+++ b/Build/source/texk/web2c/otps/win32.mak
@@ -0,0 +1,70 @@
+################################################################################
+#
+# Makefile : Web2C / Omega / otps
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/01/07 11:11:21 popineau>
+#
+################################################################################
+root_srcdir = ..\..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+USE_KPATHSEA = 1
+USE_GNUW32 = 1
+
+# These get expanded from the parent directory, not this one.
+!include <msvc/common.mak>
+
+DEFS = -I.. $(DEFS) -DHAVE_CONFIG_H
+
+LEX_OUTPUT_ROOT = lex_yy
+
+proglib = ..\lib\$(objdir)\lib.lib
+programs = $(objdir)\otp2ocp.exe $(objdir)\outocp.exe
+
+otp2ocp_objects = $(objdir)\otp2ocp.obj $(objdir)\routines.obj \
+ $(objdir)\y_tab.obj $(objdir)\$(LEX_OUTPUT_ROOT).obj
+
+default: all
+
+all: $(objdir) $(programs)
+
+$(objdir)\otp2ocp.exe: $(otp2ocp_objects) $(kpathsealib) # $(proglib)
+ $(link) $(otp2ocp_objects) $(kpathsealib) $(conlibs)
+
+$(objdir)\otp2ocp.obj: otp2ocp.c y_tab.h
+
+y_tab.c y_tab.h: otp.y
+ $(yacc) -d -v otp.y -o y_tab.c
+
+$(objdir)\$(LEX_OUTPUT_ROOT).obj: otp.h
+
+$(LEX_OUTPUT_ROOT).c: otp.l
+ $(lex) -t otp.l | sed "/^extern int isatty YY/d" > $(LEX_OUTPUT_ROOT).c
+
+$(objdir)\outocp.exe: $(objdir)\outocp.obj $(kpathsealib) # $(proglib)
+ $(link) $(objdir)\outocp.obj $(kpathsealib) $(conlibs)
+
+!include <msvc/config.mak>
+!include <msvc/install.mak>
+
+install install-programs:: install-exec
+
+!include <msvc/clean.mak>
+
+clean::
+ -@echo $(verbose) & ( \
+ for %%i in (y_tab.c y_tab.h y.output yacc.* $(LEX_OUTPUT_ROOT).c) do $(del) %%i $(redir_stderr) \
+ )
+
+!include <msvc/rdepend.mak>
+!include "./depend.mak"
+
+#
+# Local Variables:
+# mode: makefile
+# End:
diff --git a/Build/source/texk/web2c/otps/y_tab.c-dist b/Build/source/texk/web2c/otps/y_tab.c-dist
new file mode 100644
index 00000000000..675596f95e3
--- /dev/null
+++ b/Build/source/texk/web2c/otps/y_tab.c-dist
@@ -0,0 +1,1707 @@
+/* A Bison parser, made by GNU Bison 1.875a. */
+
+/* Skeleton parser for Yacc-like parsing with Bison,
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+/* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+/* Written by Richard Stallman by simplifying the original so called
+ ``semantic'' parser. */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+ infringing on user name space. This should be done even for local
+ variables, as they might otherwise be expanded by user macros.
+ There are some unavoidable exceptions within include files to
+ define necessary library symbols; they are noted "INFRINGES ON
+ USER NAME SPACE" below. */
+
+/* Identify Bison output. */
+#define YYBISON 1
+
+/* Skeleton name. */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers. */
+#define YYPURE 0
+
+/* Using locations. */
+#define YYLSP_NEEDED 0
+
+
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ NUMBER = 258,
+ ID = 259,
+ STRING = 260,
+ LEFTARROW = 261,
+ RIGHTARROW = 262,
+ INPUT = 263,
+ OUTPUT = 264,
+ ALIASES = 265,
+ STATES = 266,
+ TABLES = 267,
+ EXPRESSIONS = 268,
+ PUSH = 269,
+ POP = 270,
+ DIV = 271,
+ MOD = 272,
+ BEG = 273,
+ END = 274
+ };
+#endif
+#define NUMBER 258
+#define ID 259
+#define STRING 260
+#define LEFTARROW 261
+#define RIGHTARROW 262
+#define INPUT 263
+#define OUTPUT 264
+#define ALIASES 265
+#define STATES 266
+#define TABLES 267
+#define EXPRESSIONS 268
+#define PUSH 269
+#define POP 270
+#define DIV 271
+#define MOD 272
+#define BEG 273
+#define END 274
+
+
+
+
+/* Copy the first part of user declarations. */
+#line 1 "./otp.y"
+
+/* otp.y: Grammar for OTP files.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#include "otp.h"
+#include "routines.h"
+#include "yystype.h"
+int k, len;
+
+void yyerror(char * msg)
+{
+fprintf(stderr, "line %d: %s\n", line_number, msg);
+}
+
+
+/* Enabling traces. */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+
+/* Enabling verbose error messages. */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
+typedef int YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+
+
+/* Copy the second part of user declarations. */
+
+
+/* Line 214 of yacc.c. */
+#line 160 "y.tab.c"
+
+#if ! defined (yyoverflow) || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols. */
+
+# if YYSTACK_USE_ALLOCA
+# define YYSTACK_ALLOC alloca
+# else
+# ifndef YYSTACK_USE_ALLOCA
+# if defined (alloca) || defined (_ALLOCA_H)
+# define YYSTACK_ALLOC alloca
+# else
+# ifdef __GNUC__
+# define YYSTACK_ALLOC __builtin_alloca
+# endif
+# endif
+# endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+ /* Pacify GCC's `empty if-body' warning. */
+# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
+# else
+# if defined (__STDC__) || defined (__cplusplus)
+# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
+# endif
+# define YYSTACK_ALLOC malloc
+# define YYSTACK_FREE free
+# endif
+#endif /* ! defined (yyoverflow) || YYERROR_VERBOSE */
+
+
+#if (! defined (yyoverflow) \
+ && (! defined (__cplusplus) \
+ || (YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member. */
+union yyalloc
+{
+ short yyss;
+ YYSTYPE yyvs;
+ };
+
+/* The size of the maximum gap between one aligned stack and the next. */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+ N elements. */
+# define YYSTACK_BYTES(N) \
+ ((N) * (sizeof (short) + sizeof (YYSTYPE)) \
+ + YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO. The source and destination do
+ not overlap. */
+# ifndef YYCOPY
+# if 1 < __GNUC__
+# define YYCOPY(To, From, Count) \
+ __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+# else
+# define YYCOPY(To, From, Count) \
+ do \
+ { \
+ register YYSIZE_T yyi; \
+ for (yyi = 0; yyi < (Count); yyi++) \
+ (To)[yyi] = (From)[yyi]; \
+ } \
+ while (0)
+# endif
+# endif
+
+/* Relocate STACK from its old location to the new one. The
+ local variables YYSIZE and YYSTACKSIZE give the old and new number of
+ elements in the stack, and YYPTR gives the new location of the
+ stack. Advance YYPTR to a properly aligned location for the next
+ stack. */
+# define YYSTACK_RELOCATE(Stack) \
+ do \
+ { \
+ YYSIZE_T yynewbytes; \
+ YYCOPY (&yyptr->Stack, Stack, yysize); \
+ Stack = &yyptr->Stack; \
+ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+ yyptr += yynewbytes / sizeof (*yyptr); \
+ } \
+ while (0)
+
+#endif
+
+#if defined (__STDC__) || defined (__cplusplus)
+ typedef signed char yysigned_char;
+#else
+ typedef short yysigned_char;
+#endif
+
+/* YYFINAL -- State number of the termination state. */
+#define YYFINAL 5
+/* YYLAST -- Last index in YYTABLE. */
+#define YYLAST 177
+
+/* YYNTOKENS -- Number of terminals. */
+#define YYNTOKENS 40
+/* YYNNTS -- Number of nonterminals. */
+#define YYNNTS 36
+/* YYNRULES -- Number of rules. */
+#define YYNRULES 85
+/* YYNRULES -- Number of states. */
+#define YYNSTATES 159
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */
+#define YYUNDEFTOK 2
+#define YYMAXUTOK 274
+
+#define YYTRANSLATE(YYX) \
+ ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */
+static const unsigned char yytranslate[] =
+{
+ 0, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 39, 38, 2, 2, 2,
+ 34, 35, 22, 20, 29, 21, 32, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 23,
+ 30, 26, 31, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 24, 37, 25, 33, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 27, 36, 28, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 1, 2, 3, 4,
+ 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
+ 15, 16, 17, 18, 19
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+ YYRHS. */
+static const unsigned short yyprhs[] =
+{
+ 0, 0, 3, 10, 11, 15, 16, 20, 21, 24,
+ 26, 29, 30, 41, 42, 44, 46, 50, 51, 55,
+ 57, 61, 62, 65, 67, 70, 75, 77, 84, 90,
+ 92, 94, 98, 100, 105, 109, 113, 115, 119, 122,
+ 124, 127, 128, 129, 130, 141, 142, 145, 146, 150,
+ 154, 157, 158, 160, 161, 163, 165, 168, 169, 172,
+ 174, 176, 179, 182, 189, 192, 199, 206, 215, 218,
+ 220, 224, 228, 232, 236, 240, 241, 247, 249, 252,
+ 255, 262, 266, 267, 271, 276
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS. */
+static const yysigned_char yyrhs[] =
+{
+ 41, 0, -1, 42, 43, 44, 50, 52, 58, -1,
+ -1, 8, 3, 23, -1, -1, 9, 3, 23, -1,
+ -1, 12, 45, -1, 46, -1, 45, 46, -1, -1,
+ 4, 24, 3, 25, 47, 26, 27, 48, 28, 23,
+ -1, -1, 49, -1, 3, -1, 49, 29, 3, -1,
+ -1, 11, 51, 23, -1, 4, -1, 51, 29, 4,
+ -1, -1, 10, 53, -1, 54, -1, 53, 54, -1,
+ 4, 26, 55, 23, -1, 5, -1, 56, 30, 3,
+ 29, 3, 31, -1, 56, 30, 3, 29, 31, -1,
+ 56, -1, 3, -1, 3, 21, 3, -1, 32, -1,
+ 33, 34, 57, 35, -1, 34, 57, 35, -1, 27,
+ 4, 28, -1, 56, -1, 57, 36, 56, -1, 13,
+ 59, -1, 60, -1, 59, 60, -1, -1, -1, -1,
+ 65, 61, 66, 62, 7, 70, 63, 64, 75, 23,
+ -1, -1, 6, 70, -1, -1, 30, 4, 31, -1,
+ 67, 69, 68, -1, 67, 68, -1, -1, 18, -1,
+ -1, 19, -1, 55, -1, 69, 55, -1, -1, 70,
+ 71, -1, 5, -1, 3, -1, 37, 3, -1, 37,
+ 38, -1, 37, 34, 38, 21, 3, 35, -1, 37,
+ 22, -1, 37, 34, 22, 20, 3, 35, -1, 37,
+ 34, 22, 21, 3, 35, -1, 37, 34, 22, 20,
+ 3, 21, 3, 35, -1, 39, 74, -1, 74, -1,
+ 72, 20, 74, -1, 72, 21, 74, -1, 72, 22,
+ 74, -1, 72, 16, 74, -1, 72, 17, 74, -1,
+ -1, 4, 73, 24, 72, 25, -1, 3, -1, 37,
+ 3, -1, 37, 38, -1, 37, 34, 38, 21, 3,
+ 35, -1, 34, 72, 35, -1, -1, 30, 4, 31,
+ -1, 30, 14, 4, 31, -1, 30, 15, 31, -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
+static const unsigned short yyrline[] =
+{
+ 0, 60, 60, 70, 71, 77, 78, 82, 84, 88,
+ 89, 94, 93, 98, 100, 104, 106, 110, 112, 116,
+ 118, 122, 124, 128, 129, 133, 138, 140, 142, 144,
+ 149, 151, 153, 155, 157, 159, 164, 166, 171, 186,
+ 187, 192, 194, 196, 191, 201, 203, 208, 209, 214,
+ 216, 222, 223, 229, 230, 235, 237, 241, 243, 247,
+ 254, 256, 258, 260, 262, 267, 272, 277, 282, 287,
+ 288, 290, 292, 294, 296, 299, 298, 305, 307, 309,
+ 311, 313, 316, 318, 320, 322
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE
+/* YYTNME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+ First, the terminals, then, starting at YYNTOKENS, nonterminals. */
+static const char *const yytname[] =
+{
+ "$end", "error", "$undefined", "NUMBER", "ID", "STRING", "LEFTARROW",
+ "RIGHTARROW", "INPUT", "OUTPUT", "ALIASES", "STATES", "TABLES",
+ "EXPRESSIONS", "PUSH", "POP", "DIV", "MOD", "BEG", "END", "'+'", "'-'",
+ "'*'", "';'", "'['", "']'", "'='", "'{'", "'}'", "','", "'<'", "'>'",
+ "'.'", "'^'", "'('", "')'", "'|'", "'\\\\'", "'$'", "'#'", "$accept",
+ "File", "Input", "Output", "Tables", "MoreTables", "OneTable", "@1",
+ "Numbers", "MoreNumbers", "States", "MoreStates", "Aliases",
+ "MoreAliases", "OneAlias", "OneCompleteLeft", "OneLeft", "ChoiceLeft",
+ "Expressions", "MoreExpressions", "OneExpr", "@2", "@3", "@4",
+ "PushBack", "LeftState", "TotalLeft", "BegLeft", "EndLeft", "Left",
+ "Right", "OneRight", "RestRightExpr", "@5", "OneRightExpr",
+ "RightState", 0
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+ token YYLEX-NUM. */
+static const unsigned short yytoknum[] =
+{
+ 0, 256, 257, 258, 259, 260, 261, 262, 263, 264,
+ 265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
+ 43, 45, 42, 59, 91, 93, 61, 123, 125, 44,
+ 60, 62, 46, 94, 40, 41, 124, 92, 36, 35
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
+static const unsigned char yyr1[] =
+{
+ 0, 40, 41, 42, 42, 43, 43, 44, 44, 45,
+ 45, 47, 46, 48, 48, 49, 49, 50, 50, 51,
+ 51, 52, 52, 53, 53, 54, 55, 55, 55, 55,
+ 56, 56, 56, 56, 56, 56, 57, 57, 58, 59,
+ 59, 61, 62, 63, 60, 64, 64, 65, 65, 66,
+ 66, 67, 67, 68, 68, 69, 69, 70, 70, 71,
+ 71, 71, 71, 71, 71, 71, 71, 71, 71, 72,
+ 72, 72, 72, 72, 72, 73, 72, 74, 74, 74,
+ 74, 74, 75, 75, 75, 75
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */
+static const unsigned char yyr2[] =
+{
+ 0, 2, 6, 0, 3, 0, 3, 0, 2, 1,
+ 2, 0, 10, 0, 1, 1, 3, 0, 3, 1,
+ 3, 0, 2, 1, 2, 4, 1, 6, 5, 1,
+ 1, 3, 1, 4, 3, 3, 1, 3, 2, 1,
+ 2, 0, 0, 0, 10, 0, 2, 0, 3, 3,
+ 2, 0, 1, 0, 1, 1, 2, 0, 2, 1,
+ 1, 2, 2, 6, 2, 6, 6, 8, 2, 1,
+ 3, 3, 3, 3, 3, 0, 5, 1, 2, 2,
+ 6, 3, 0, 3, 4, 3
+};
+
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+ STATE-NUM when YYTABLE doesn't specify something else to do. Zero
+ means the default is an error. */
+static const unsigned char yydefact[] =
+{
+ 3, 0, 0, 5, 0, 1, 0, 7, 4, 0,
+ 0, 17, 6, 0, 8, 9, 0, 21, 0, 10,
+ 19, 0, 0, 0, 0, 18, 0, 0, 22, 23,
+ 47, 2, 11, 20, 0, 24, 0, 47, 39, 41,
+ 0, 30, 26, 0, 32, 0, 0, 0, 29, 0,
+ 40, 51, 0, 0, 0, 0, 36, 0, 25, 0,
+ 48, 52, 42, 53, 13, 31, 35, 0, 34, 0,
+ 0, 0, 54, 55, 50, 53, 15, 0, 14, 33,
+ 37, 0, 57, 56, 49, 0, 0, 0, 28, 43,
+ 12, 16, 27, 60, 59, 0, 0, 45, 58, 61,
+ 64, 0, 62, 77, 0, 0, 68, 57, 82, 0,
+ 0, 75, 0, 69, 78, 0, 79, 46, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 81,
+ 0, 0, 0, 0, 44, 0, 0, 0, 0, 73,
+ 74, 70, 71, 72, 0, 83, 0, 85, 0, 65,
+ 66, 63, 0, 0, 84, 0, 76, 80, 67
+};
+
+/* YYDEFGOTO[NTERM-NUM]. */
+static const yysigned_char yydefgoto[] =
+{
+ -1, 2, 3, 7, 11, 14, 15, 40, 77, 78,
+ 17, 21, 23, 28, 29, 47, 48, 57, 31, 37,
+ 38, 51, 71, 97, 108, 39, 62, 63, 74, 75,
+ 89, 98, 112, 123, 113, 119
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+ STATE-NUM. */
+#define YYPACT_NINF -96
+static const yysigned_char yypact[] =
+{
+ 0, 10, 18, 11, 44, -96, 54, 53, -96, 48,
+ 81, 75, -96, 64, 81, -96, 85, 80, 88, -96,
+ -96, 43, 89, 79, 69, -96, 91, 70, 89, -96,
+ 67, -96, -96, -96, 22, -96, 94, 17, -96, -96,
+ 73, 82, -96, 96, -96, 68, 41, 78, 74, 76,
+ -96, 87, 83, 103, 84, 41, -96, -20, -96, 105,
+ -96, -96, -96, 19, 106, -96, -96, 34, -96, 41,
+ 86, 104, -96, -96, -96, 19, -96, 90, 92, -96,
+ -96, 45, -96, -96, -96, 93, 110, 95, -96, -3,
+ -96, -96, -96, -96, -96, 1, 8, 108, -96, -96,
+ -96, -17, -96, -96, 6, 3, -96, -96, 97, 60,
+ 98, -96, 42, -96, -96, 99, -96, -3, 46, 100,
+ 114, 117, 119, 101, 8, 8, 8, 8, 8, -96,
+ 107, 102, 120, 109, -96, -7, 111, 112, 6, -96,
+ -96, -96, -96, -96, 126, -96, 113, -96, 127, -96,
+ -96, -96, 62, 115, -96, 116, -96, -96, -96
+};
+
+/* YYPGOTO[NTERM-NUM]. */
+static const yysigned_char yypgoto[] =
+{
+ -96, -96, -96, -96, -96, -96, 118, -96, -96, -96,
+ -96, -96, -96, -96, 121, -56, -43, 122, -96, -96,
+ 123, -96, -96, -96, -96, -96, -96, -96, 56, -96,
+ 27, -96, -2, -96, -95, -96
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If
+ positive, shift that token. If negative, reduce the rule which
+ number is the opposite. If zero, do what YYDEFACT says.
+ If YYTABLE_NINF, syntax error. */
+#define YYTABLE_NINF -39
+static const short yytable[] =
+{
+ 93, 106, 94, 56, 99, 109, 114, 73, 1, 103,
+ 111, 103, 56, 4, 148, 68, 69, -38, 5, 83,
+ 6, 110, 41, 100, 42, 41, 80, 42, 149, 139,
+ 140, 141, 142, 143, 95, 101, 96, 115, 72, 102,
+ 104, 116, 104, 105, 41, 105, 43, 36, 87, 43,
+ 131, 44, 45, 46, 44, 45, 46, 9, 124, 125,
+ 132, 133, 126, 127, 128, 10, 25, 8, 43, 79,
+ 69, 12, 26, 44, 45, 46, 88, 129, 124, 125,
+ 120, 121, 126, 127, 128, 13, 16, 156, 18, 20,
+ 22, 24, 30, 27, 32, 33, 34, 36, 49, 52,
+ 54, 58, 55, 53, 59, 61, 65, 60, 70, 76,
+ 64, 82, 66, 91, 107, 81, 90, 135, 85, 122,
+ 136, 86, 137, 134, 146, 138, 92, 118, 144, 153,
+ 155, 84, 19, 145, 117, 0, 152, 130, 0, 0,
+ 147, 0, 0, 0, 154, 0, 150, 151, 0, 35,
+ 157, 158, 0, 0, 0, 0, 0, 0, 0, 0,
+ 50, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 67
+};
+
+static const short yycheck[] =
+{
+ 3, 96, 5, 46, 3, 22, 3, 63, 8, 3,
+ 4, 3, 55, 3, 21, 35, 36, 0, 0, 75,
+ 9, 38, 3, 22, 5, 3, 69, 5, 35, 124,
+ 125, 126, 127, 128, 37, 34, 39, 34, 19, 38,
+ 34, 38, 34, 37, 3, 37, 27, 30, 3, 27,
+ 4, 32, 33, 34, 32, 33, 34, 3, 16, 17,
+ 14, 15, 20, 21, 22, 12, 23, 23, 27, 35,
+ 36, 23, 29, 32, 33, 34, 31, 35, 16, 17,
+ 20, 21, 20, 21, 22, 4, 11, 25, 24, 4,
+ 10, 3, 13, 4, 25, 4, 26, 30, 4, 26,
+ 4, 23, 34, 21, 30, 18, 3, 31, 3, 3,
+ 27, 7, 28, 3, 6, 29, 23, 3, 28, 21,
+ 3, 29, 3, 23, 4, 24, 31, 30, 21, 3,
+ 3, 75, 14, 31, 107, -1, 138, 38, -1, -1,
+ 31, -1, -1, -1, 31, -1, 35, 35, -1, 28,
+ 35, 35, -1, -1, -1, -1, -1, -1, -1, -1,
+ 37, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, 55
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+ symbol of state STATE-NUM. */
+static const unsigned char yystos[] =
+{
+ 0, 8, 41, 42, 3, 0, 9, 43, 23, 3,
+ 12, 44, 23, 4, 45, 46, 11, 50, 24, 46,
+ 4, 51, 10, 52, 3, 23, 29, 4, 53, 54,
+ 13, 58, 25, 4, 26, 54, 30, 59, 60, 65,
+ 47, 3, 5, 27, 32, 33, 34, 55, 56, 4,
+ 60, 61, 26, 21, 4, 34, 56, 57, 23, 30,
+ 31, 18, 66, 67, 27, 3, 28, 57, 35, 36,
+ 3, 62, 19, 55, 68, 69, 3, 48, 49, 35,
+ 56, 29, 7, 55, 68, 28, 29, 3, 31, 70,
+ 23, 3, 31, 3, 5, 37, 39, 63, 71, 3,
+ 22, 34, 38, 3, 34, 37, 74, 6, 64, 22,
+ 38, 4, 72, 74, 3, 34, 38, 70, 30, 75,
+ 20, 21, 21, 73, 16, 17, 20, 21, 22, 35,
+ 38, 4, 14, 15, 23, 3, 3, 3, 24, 74,
+ 74, 74, 74, 74, 21, 31, 4, 31, 21, 35,
+ 35, 35, 72, 3, 31, 3, 25, 35, 35
+};
+
+#if ! defined (YYSIZE_T) && defined (__SIZE_TYPE__)
+# define YYSIZE_T __SIZE_TYPE__
+#endif
+#if ! defined (YYSIZE_T) && defined (size_t)
+# define YYSIZE_T size_t
+#endif
+#if ! defined (YYSIZE_T)
+# if defined (__STDC__) || defined (__cplusplus)
+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
+# endif
+#endif
+#if ! defined (YYSIZE_T)
+# define YYSIZE_T unsigned int
+#endif
+
+#define yyerrok (yyerrstatus = 0)
+#define yyclearin (yychar = YYEMPTY)
+#define YYEMPTY (-2)
+#define YYEOF 0
+
+#define YYACCEPT goto yyacceptlab
+#define YYABORT goto yyabortlab
+#define YYERROR goto yyerrlab1
+
+
+/* Like YYERROR except do call yyerror. This remains here temporarily
+ to ease the transition to the new meaning of YYERROR, for GCC.
+ Once GCC version 2 has supplanted version 1, this can go. */
+
+#define YYFAIL goto yyerrlab
+
+#define YYRECOVERING() (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value) \
+do \
+ if (yychar == YYEMPTY && yylen == 1) \
+ { \
+ yychar = (Token); \
+ yylval = (Value); \
+ yytoken = YYTRANSLATE (yychar); \
+ YYPOPSTACK; \
+ goto yybackup; \
+ } \
+ else \
+ { \
+ yyerror ("syntax error: cannot back up");\
+ YYERROR; \
+ } \
+while (0)
+
+#define YYTERROR 1
+#define YYERRCODE 256
+
+/* YYLLOC_DEFAULT -- Compute the default location (before the actions
+ are run). */
+
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N) \
+ Current.first_line = Rhs[1].first_line; \
+ Current.first_column = Rhs[1].first_column; \
+ Current.last_line = Rhs[N].last_line; \
+ Current.last_column = Rhs[N].last_column;
+#endif
+
+/* YYLEX -- calling `yylex' with the right arguments. */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested. */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+# include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+# define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args) \
+do { \
+ if (yydebug) \
+ YYFPRINTF Args; \
+} while (0)
+
+# define YYDSYMPRINT(Args) \
+do { \
+ if (yydebug) \
+ yysymprint Args; \
+} while (0)
+
+# define YYDSYMPRINTF(Title, Token, Value, Location) \
+do { \
+ if (yydebug) \
+ { \
+ YYFPRINTF (stderr, "%s ", Title); \
+ yysymprint (stderr, \
+ Token, Value); \
+ YYFPRINTF (stderr, "\n"); \
+ } \
+} while (0)
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (cinluded). |
+`------------------------------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yy_stack_print (short *bottom, short *top)
+#else
+static void
+yy_stack_print (bottom, top)
+ short *bottom;
+ short *top;
+#endif
+{
+ YYFPRINTF (stderr, "Stack now");
+ for (/* Nothing. */; bottom <= top; ++bottom)
+ YYFPRINTF (stderr, " %d", *bottom);
+ YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top) \
+do { \
+ if (yydebug) \
+ yy_stack_print ((Bottom), (Top)); \
+} while (0)
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced. |
+`------------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yy_reduce_print (int yyrule)
+#else
+static void
+yy_reduce_print (yyrule)
+ int yyrule;
+#endif
+{
+ int yyi;
+ unsigned int yylineno = yyrline[yyrule];
+ YYFPRINTF (stderr, "Reducing stack by rule %d (line %u), ",
+ yyrule - 1, yylineno);
+ /* Print the symbols being reduced, and their result. */
+ for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
+ YYFPRINTF (stderr, "%s ", yytname [yyrhs[yyi]]);
+ YYFPRINTF (stderr, "-> %s\n", yytname [yyr1[yyrule]]);
+}
+
+# define YY_REDUCE_PRINT(Rule) \
+do { \
+ if (yydebug) \
+ yy_reduce_print (Rule); \
+} while (0)
+
+/* Nonzero means print parse trace. It is left uninitialized so that
+ multiple parsers can coexist. */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YYDSYMPRINT(Args)
+# define YYDSYMPRINTF(Title, Token, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks. */
+#ifndef YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+ if the built-in stack extension method is used).
+
+ Do not make this value too large; the results are undefined if
+ SIZE_MAX < YYSTACK_BYTES (YYMAXDEPTH)
+ evaluated with infinite-precision integer arithmetic. */
+
+#if YYMAXDEPTH == 0
+# undef YYMAXDEPTH
+#endif
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+# if defined (__GLIBC__) && defined (_STRING_H)
+# define yystrlen strlen
+# else
+/* Return the length of YYSTR. */
+static YYSIZE_T
+# if defined (__STDC__) || defined (__cplusplus)
+yystrlen (const char *yystr)
+# else
+yystrlen (yystr)
+ const char *yystr;
+# endif
+{
+ register const char *yys = yystr;
+
+ while (*yys++ != '\0')
+ continue;
+
+ return yys - yystr - 1;
+}
+# endif
+# endif
+
+# ifndef yystpcpy
+# if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
+# define yystpcpy stpcpy
+# else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+ YYDEST. */
+static char *
+# if defined (__STDC__) || defined (__cplusplus)
+yystpcpy (char *yydest, const char *yysrc)
+# else
+yystpcpy (yydest, yysrc)
+ char *yydest;
+ const char *yysrc;
+# endif
+{
+ register char *yyd = yydest;
+ register const char *yys = yysrc;
+
+ while ((*yyd++ = *yys++) != '\0')
+ continue;
+
+ return yyd - 1;
+}
+# endif
+# endif
+
+#endif /* !YYERROR_VERBOSE */
+
+
+
+#if YYDEBUG
+/*--------------------------------.
+| Print this symbol on YYOUTPUT. |
+`--------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yysymprint (FILE *yyoutput, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yysymprint (yyoutput, yytype, yyvaluep)
+ FILE *yyoutput;
+ int yytype;
+ YYSTYPE *yyvaluep;
+#endif
+{
+ /* Pacify ``unused variable'' warnings. */
+ (void) yyvaluep;
+
+ if (yytype < YYNTOKENS)
+ {
+ YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+# ifdef YYPRINT
+ YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# endif
+ }
+ else
+ YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+ switch (yytype)
+ {
+ default:
+ break;
+ }
+ YYFPRINTF (yyoutput, ")");
+}
+
+#endif /* ! YYDEBUG */
+/*-----------------------------------------------.
+| Release the memory associated to this symbol. |
+`-----------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yydestruct (int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yytype, yyvaluep)
+ int yytype;
+ YYSTYPE *yyvaluep;
+#endif
+{
+ /* Pacify ``unused variable'' warnings. */
+ (void) yyvaluep;
+
+ switch (yytype)
+ {
+
+ default:
+ break;
+ }
+}
+
+
+/* Prevent warnings from -Wmissing-prototypes. */
+
+#ifdef YYPARSE_PARAM
+# if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void *YYPARSE_PARAM);
+# else
+int yyparse ();
+# endif
+#else /* ! YYPARSE_PARAM */
+#if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The lookahead symbol. */
+int yychar;
+
+/* The semantic value of the lookahead symbol. */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far. */
+int yynerrs;
+
+
+
+/*----------.
+| yyparse. |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+# if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void *YYPARSE_PARAM)
+# else
+int yyparse (YYPARSE_PARAM)
+ void *YYPARSE_PARAM;
+# endif
+#else /* ! YYPARSE_PARAM */
+#if defined (__STDC__) || defined (__cplusplus)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+
+ register int yystate;
+ register int yyn;
+ int yyresult;
+ /* Number of tokens to shift before error messages enabled. */
+ int yyerrstatus;
+ /* Lookahead token as an internal (translated) token number. */
+ int yytoken = 0;
+
+ /* Three stacks and their tools:
+ `yyss': related to states,
+ `yyvs': related to semantic values,
+ `yyls': related to locations.
+
+ Refer to the stacks thru separate pointers, to allow yyoverflow
+ to reallocate them elsewhere. */
+
+ /* The state stack. */
+ short yyssa[YYINITDEPTH];
+ short *yyss = yyssa;
+ register short *yyssp;
+
+ /* The semantic value stack. */
+ YYSTYPE yyvsa[YYINITDEPTH];
+ YYSTYPE *yyvs = yyvsa;
+ register YYSTYPE *yyvsp;
+
+
+
+#define YYPOPSTACK (yyvsp--, yyssp--)
+
+ YYSIZE_T yystacksize = YYINITDEPTH;
+
+ /* The variables used to return semantic value and location from the
+ action routines. */
+ YYSTYPE yyval;
+
+
+ /* When reducing, the number of symbols on the RHS of the reduced
+ rule. */
+ int yylen;
+
+ YYDPRINTF ((stderr, "Starting parse\n"));
+
+ yystate = 0;
+ yyerrstatus = 0;
+ yynerrs = 0;
+ yychar = YYEMPTY; /* Cause a token to be read. */
+
+ /* Initialize stack pointers.
+ Waste one element of value and location stack
+ so that they stay on the same level as the state stack.
+ The wasted elements are never initialized. */
+
+ yyssp = yyss;
+ yyvsp = yyvs;
+
+ goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate. |
+`------------------------------------------------------------*/
+ yynewstate:
+ /* In all cases, when you get here, the value and location stacks
+ have just been pushed. so pushing a state here evens the stacks.
+ */
+ yyssp++;
+
+ yysetstate:
+ *yyssp = yystate;
+
+ if (yyss + yystacksize - 1 <= yyssp)
+ {
+ /* Get the current used size of the three stacks, in elements. */
+ YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+ {
+ /* Give user a chance to reallocate the stack. Use copies of
+ these so that the &'s don't force the real ones into
+ memory. */
+ YYSTYPE *yyvs1 = yyvs;
+ short *yyss1 = yyss;
+
+
+ /* Each stack pointer address is followed by the size of the
+ data in use in that stack, in bytes. This used to be a
+ conditional around just the two extra args, but that might
+ be undefined if yyoverflow is a macro. */
+ yyoverflow ("parser stack overflow",
+ &yyss1, yysize * sizeof (*yyssp),
+ &yyvs1, yysize * sizeof (*yyvsp),
+
+ &yystacksize);
+
+ yyss = yyss1;
+ yyvs = yyvs1;
+ }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+ goto yyoverflowlab;
+# else
+ /* Extend the stack our own way. */
+ if (YYMAXDEPTH <= yystacksize)
+ goto yyoverflowlab;
+ yystacksize *= 2;
+ if (YYMAXDEPTH < yystacksize)
+ yystacksize = YYMAXDEPTH;
+
+ {
+ short *yyss1 = yyss;
+ union yyalloc *yyptr =
+ (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+ if (! yyptr)
+ goto yyoverflowlab;
+ YYSTACK_RELOCATE (yyss);
+ YYSTACK_RELOCATE (yyvs);
+
+# undef YYSTACK_RELOCATE
+ if (yyss1 != yyssa)
+ YYSTACK_FREE (yyss1);
+ }
+# endif
+#endif /* no yyoverflow */
+
+ yyssp = yyss + yysize - 1;
+ yyvsp = yyvs + yysize - 1;
+
+
+ YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+ (unsigned long int) yystacksize));
+
+ if (yyss + yystacksize - 1 <= yyssp)
+ YYABORT;
+ }
+
+ YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+ goto yybackup;
+
+/*-----------.
+| yybackup. |
+`-----------*/
+yybackup:
+
+/* Do appropriate processing given the current state. */
+/* Read a lookahead token if we need one and don't already have one. */
+/* yyresume: */
+
+ /* First try to decide what to do without reference to lookahead token. */
+
+ yyn = yypact[yystate];
+ if (yyn == YYPACT_NINF)
+ goto yydefault;
+
+ /* Not known => get a lookahead token if don't already have one. */
+
+ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
+ if (yychar == YYEMPTY)
+ {
+ YYDPRINTF ((stderr, "Reading a token: "));
+ yychar = YYLEX;
+ }
+
+ if (yychar <= YYEOF)
+ {
+ yychar = yytoken = YYEOF;
+ YYDPRINTF ((stderr, "Now at end of input.\n"));
+ }
+ else
+ {
+ yytoken = YYTRANSLATE (yychar);
+ YYDSYMPRINTF ("Next token is", yytoken, &yylval, &yylloc);
+ }
+
+ /* If the proper action on seeing token YYTOKEN is to reduce or to
+ detect an error, take that action. */
+ yyn += yytoken;
+ if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+ goto yydefault;
+ yyn = yytable[yyn];
+ if (yyn <= 0)
+ {
+ if (yyn == 0 || yyn == YYTABLE_NINF)
+ goto yyerrlab;
+ yyn = -yyn;
+ goto yyreduce;
+ }
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ /* Shift the lookahead token. */
+ YYDPRINTF ((stderr, "Shifting token %s, ", yytname[yytoken]));
+
+ /* Discard the token being shifted unless it is eof. */
+ if (yychar != YYEOF)
+ yychar = YYEMPTY;
+
+ *++yyvsp = yylval;
+
+
+ /* Count tokens shifted since error; after three, turn off error
+ status. */
+ if (yyerrstatus)
+ yyerrstatus--;
+
+ yystate = yyn;
+ goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state. |
+`-----------------------------------------------------------*/
+yydefault:
+ yyn = yydefact[yystate];
+ if (yyn == 0)
+ goto yyerrlab;
+ goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction. |
+`-----------------------------*/
+yyreduce:
+ /* yyn is the number of a rule to reduce with. */
+ yylen = yyr2[yyn];
+
+ /* If YYLEN is nonzero, implement the default value of the action:
+ `$$ = $1'.
+
+ Otherwise, the following line sets YYVAL to garbage.
+ This behavior is undocumented and Bison
+ users should not rely upon it. Assigning to YYVAL
+ unconditionally makes the parser a bit smaller, and it avoids a
+ GCC warning that YYVAL may be used uninitialized. */
+ yyval = yyvsp[1-yylen];
+
+
+ YY_REDUCE_PRINT (yyn);
+ switch (yyn)
+ {
+ case 3:
+#line 70 "./otp.y"
+ { input_bytes=2; }
+ break;
+
+ case 4:
+#line 72 "./otp.y"
+ { input_bytes=yyvsp[-1].yint; }
+ break;
+
+ case 5:
+#line 77 "./otp.y"
+ { output_bytes=2; }
+ break;
+
+ case 6:
+#line 79 "./otp.y"
+ { output_bytes=yyvsp[-1].yint; }
+ break;
+
+ case 11:
+#line 94 "./otp.y"
+ { store_table(yyvsp[-3].ystring, yyvsp[-1].yint); }
+ break;
+
+ case 15:
+#line 105 "./otp.y"
+ { add_to_table(yyvsp[0].yint); }
+ break;
+
+ case 16:
+#line 107 "./otp.y"
+ { add_to_table(yyvsp[0].yint); }
+ break;
+
+ case 19:
+#line 117 "./otp.y"
+ { store_state(yyvsp[0].ystring); }
+ break;
+
+ case 20:
+#line 119 "./otp.y"
+ { store_state(yyvsp[0].ystring); }
+ break;
+
+ case 25:
+#line 134 "./otp.y"
+ { store_alias(yyvsp[-3].ystring, yyvsp[-1].yleft); }
+ break;
+
+ case 26:
+#line 139 "./otp.y"
+ { yyval.yleft = StringLeft(yyvsp[0].ystring); }
+ break;
+
+ case 27:
+#line 141 "./otp.y"
+ { yyval.yleft = CompleteLeft(yyvsp[-5].yleft, yyvsp[-3].yint, yyvsp[-1].yint); }
+ break;
+
+ case 28:
+#line 143 "./otp.y"
+ { yyval.yleft = PlusLeft(yyvsp[-4].yleft, yyvsp[-2].yint); }
+ break;
+
+ case 29:
+#line 145 "./otp.y"
+ { yyval.yleft = yyvsp[0].yleft; }
+ break;
+
+ case 30:
+#line 150 "./otp.y"
+ { yyval.yleft = SingleLeft(yyvsp[0].yint); }
+ break;
+
+ case 31:
+#line 152 "./otp.y"
+ { yyval.yleft = DoubleLeft(yyvsp[-2].yint, yyvsp[0].yint); }
+ break;
+
+ case 32:
+#line 154 "./otp.y"
+ { yyval.yleft = WildCard(); }
+ break;
+
+ case 33:
+#line 156 "./otp.y"
+ { yyval.yleft = NotChoiceLeft(yyvsp[-1].ylleft); }
+ break;
+
+ case 34:
+#line 158 "./otp.y"
+ { yyval.yleft = ChoiceLeft(yyvsp[-1].ylleft); }
+ break;
+
+ case 35:
+#line 160 "./otp.y"
+ { yyval.yleft = lookup_alias(yyvsp[-1].ystring); }
+ break;
+
+ case 36:
+#line 165 "./otp.y"
+ { yyval.ylleft = llist1(yyvsp[0].yleft); }
+ break;
+
+ case 37:
+#line 167 "./otp.y"
+ { yyval.ylleft = lappend1(yyvsp[-2].ylleft, yyvsp[0].yleft); }
+ break;
+
+ case 38:
+#line 172 "./otp.y"
+ {
+ for(cur_state=0; cur_state<no_states; cur_state++) {
+ if ((states[cur_state].no_exprs)==0) {
+ out_int(OTP_LEFT_START, 0);
+ } else {
+ out_int(OTP_LEFT_RETURN, 0);
+ }
+ out_int(OTP_RIGHT_CHAR, 1);
+ out_int(OTP_STOP, 0);
+ }
+ }
+ break;
+
+ case 41:
+#line 192 "./otp.y"
+ { states[cur_state].no_exprs++; }
+ break;
+
+ case 42:
+#line 194 "./otp.y"
+ { out_left(yyvsp[0].ylleft); right_offset=0; }
+ break;
+
+ case 43:
+#line 196 "./otp.y"
+ { right_offset=OTP_PBACK_OFFSET; }
+ break;
+
+ case 44:
+#line 198 "./otp.y"
+ { fill_in_left(); }
+ break;
+
+ case 47:
+#line 208 "./otp.y"
+ { cur_state = 0; }
+ break;
+
+ case 48:
+#line 210 "./otp.y"
+ { cur_state = lookup_state(yyvsp[-1].ystring); }
+ break;
+
+ case 49:
+#line 215 "./otp.y"
+ { yyval.ylleft = lappend(yyvsp[-2].ylleft, lappend(yyvsp[-1].ylleft, yyvsp[0].ylleft)); }
+ break;
+
+ case 50:
+#line 217 "./otp.y"
+ { yyval.ylleft = lappend(yyvsp[-1].ylleft, yyvsp[0].ylleft); }
+ break;
+
+ case 51:
+#line 222 "./otp.y"
+ { yyval.ylleft = nil; }
+ break;
+
+ case 52:
+#line 224 "./otp.y"
+ { yyval.ylleft = llist1(BeginningLeft()); }
+ break;
+
+ case 53:
+#line 229 "./otp.y"
+ { yyval.ylleft = nil; }
+ break;
+
+ case 54:
+#line 231 "./otp.y"
+ { yyval.ylleft = llist1(EndLeft()); }
+ break;
+
+ case 55:
+#line 236 "./otp.y"
+ { yyval.ylleft = llist1(yyvsp[0].yleft); }
+ break;
+
+ case 56:
+#line 238 "./otp.y"
+ { yyval.ylleft = lappend1(yyvsp[-1].ylleft, yyvsp[0].yleft); }
+ break;
+
+ case 59:
+#line 248 "./otp.y"
+ {
+ len=strlen(yyvsp[0].ystring);
+ for (k=0; k<len; k++) {
+ out_right(OTP_RIGHT_NUM, (yyvsp[0].ystring)[k]);
+ }
+ }
+ break;
+
+ case 60:
+#line 255 "./otp.y"
+ { out_right(OTP_RIGHT_NUM, yyvsp[0].yint); }
+ break;
+
+ case 61:
+#line 257 "./otp.y"
+ { out_right(OTP_RIGHT_CHAR, yyvsp[0].yint); }
+ break;
+
+ case 62:
+#line 259 "./otp.y"
+ { out_right(OTP_RIGHT_LCHAR, 0); }
+ break;
+
+ case 63:
+#line 261 "./otp.y"
+ { out_right(OTP_RIGHT_LCHAR, yyvsp[-1].yint); }
+ break;
+
+ case 64:
+#line 263 "./otp.y"
+ {
+ out_right(OTP_RIGHT_SOME, 0);
+ out_int(0,0);
+ }
+ break;
+
+ case 65:
+#line 268 "./otp.y"
+ {
+ out_right(OTP_RIGHT_SOME, yyvsp[-1].yint);
+ out_int(0, 0);
+ }
+ break;
+
+ case 66:
+#line 273 "./otp.y"
+ {
+ out_right(OTP_RIGHT_SOME, 0);
+ out_int(0, yyvsp[-1].yint);
+ }
+ break;
+
+ case 67:
+#line 278 "./otp.y"
+ {
+ out_right(OTP_RIGHT_SOME, yyvsp[-3].yint);
+ out_int(0, yyvsp[-1].yint);
+ }
+ break;
+
+ case 68:
+#line 283 "./otp.y"
+ { out_right(OTP_RIGHT_OUTPUT, 0); }
+ break;
+
+ case 70:
+#line 289 "./otp.y"
+ { out_int(OTP_ADD, 0); }
+ break;
+
+ case 71:
+#line 291 "./otp.y"
+ { out_int(OTP_SUB, 0); }
+ break;
+
+ case 72:
+#line 293 "./otp.y"
+ { out_int(OTP_MULT, 0); }
+ break;
+
+ case 73:
+#line 295 "./otp.y"
+ { out_int(OTP_DIV, 0); }
+ break;
+
+ case 74:
+#line 297 "./otp.y"
+ { out_int(OTP_MOD, 0); }
+ break;
+
+ case 75:
+#line 299 "./otp.y"
+ { out_int(OTP_PUSH_NUM, lookup_table(yyvsp[0].ystring)); }
+ break;
+
+ case 76:
+#line 301 "./otp.y"
+ { out_int(OTP_LOOKUP, 0); }
+ break;
+
+ case 77:
+#line 306 "./otp.y"
+ { out_int(OTP_PUSH_NUM, yyvsp[0].yint); }
+ break;
+
+ case 78:
+#line 308 "./otp.y"
+ { out_int(OTP_PUSH_CHAR, yyvsp[0].yint); }
+ break;
+
+ case 79:
+#line 310 "./otp.y"
+ { out_int(OTP_PUSH_LCHAR, 0); }
+ break;
+
+ case 80:
+#line 312 "./otp.y"
+ { out_int(OTP_PUSH_LCHAR, yyvsp[-1].yint); }
+ break;
+
+ case 83:
+#line 319 "./otp.y"
+ { out_int(OTP_STATE_CHANGE, lookup_state(yyvsp[-1].ystring)); }
+ break;
+
+ case 84:
+#line 321 "./otp.y"
+ { out_int(OTP_STATE_PUSH, lookup_state(yyvsp[-1].ystring)); }
+ break;
+
+ case 85:
+#line 323 "./otp.y"
+ { out_int(OTP_STATE_POP, 0); }
+ break;
+
+
+ }
+
+/* Line 999 of yacc.c. */
+#line 1512 "y.tab.c"
+
+ yyvsp -= yylen;
+ yyssp -= yylen;
+
+
+ YY_STACK_PRINT (yyss, yyssp);
+
+ *++yyvsp = yyval;
+
+
+ /* Now `shift' the result of the reduction. Determine what state
+ that goes to, based on the state we popped back to and the rule
+ number reduced by. */
+
+ yyn = yyr1[yyn];
+
+ yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+ if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+ yystate = yytable[yystate];
+ else
+ yystate = yydefgoto[yyn - YYNTOKENS];
+
+ goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+ /* If not already recovering from an error, report this error. */
+ if (!yyerrstatus)
+ {
+ ++yynerrs;
+#if YYERROR_VERBOSE
+ yyn = yypact[yystate];
+
+ if (YYPACT_NINF < yyn && yyn < YYLAST)
+ {
+ YYSIZE_T yysize = 0;
+ int yytype = YYTRANSLATE (yychar);
+ char *yymsg;
+ int yyx, yycount;
+
+ yycount = 0;
+ /* Start YYX at -YYN if negative to avoid negative indexes in
+ YYCHECK. */
+ for (yyx = yyn < 0 ? -yyn : 0;
+ yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ yysize += yystrlen (yytname[yyx]) + 15, yycount++;
+ yysize += yystrlen ("syntax error, unexpected ") + 1;
+ yysize += yystrlen (yytname[yytype]);
+ yymsg = (char *) YYSTACK_ALLOC (yysize);
+ if (yymsg != 0)
+ {
+ char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
+ yyp = yystpcpy (yyp, yytname[yytype]);
+
+ if (yycount < 5)
+ {
+ yycount = 0;
+ for (yyx = yyn < 0 ? -yyn : 0;
+ yyx < (int) (sizeof (yytname) / sizeof (char *));
+ yyx++)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ {
+ const char *yyq = ! yycount ? ", expecting " : " or ";
+ yyp = yystpcpy (yyp, yyq);
+ yyp = yystpcpy (yyp, yytname[yyx]);
+ yycount++;
+ }
+ }
+ yyerror (yymsg);
+ YYSTACK_FREE (yymsg);
+ }
+ else
+ yyerror ("syntax error; also virtual memory exhausted");
+ }
+ else
+#endif /* YYERROR_VERBOSE */
+ yyerror ("syntax error");
+ }
+
+
+
+ if (yyerrstatus == 3)
+ {
+ /* If just tried and failed to reuse lookahead token after an
+ error, discard it. */
+
+ /* Return failure if at end of input. */
+ if (yychar == YYEOF)
+ {
+ /* Pop the error token. */
+ YYPOPSTACK;
+ /* Pop the rest of the stack. */
+ while (yyss < yyssp)
+ {
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
+ yydestruct (yystos[*yyssp], yyvsp);
+ YYPOPSTACK;
+ }
+ YYABORT;
+ }
+
+ YYDSYMPRINTF ("Error: discarding", yytoken, &yylval, &yylloc);
+ yydestruct (yytoken, &yylval);
+ yychar = YYEMPTY;
+
+ }
+
+ /* Else will try to reuse lookahead token after shifting the error
+ token. */
+ goto yyerrlab1;
+
+
+/*----------------------------------------------------.
+| yyerrlab1 -- error raised explicitly by an action. |
+`----------------------------------------------------*/
+yyerrlab1:
+ yyerrstatus = 3; /* Each real token shifted decrements this. */
+
+ for (;;)
+ {
+ yyn = yypact[yystate];
+ if (yyn != YYPACT_NINF)
+ {
+ yyn += YYTERROR;
+ if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+ {
+ yyn = yytable[yyn];
+ if (0 < yyn)
+ break;
+ }
+ }
+
+ /* Pop the current state because it cannot handle the error token. */
+ if (yyssp == yyss)
+ YYABORT;
+
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
+ yydestruct (yystos[yystate], yyvsp);
+ yyvsp--;
+ yystate = *--yyssp;
+
+ YY_STACK_PRINT (yyss, yyssp);
+ }
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ YYDPRINTF ((stderr, "Shifting error token, "));
+
+ *++yyvsp = yylval;
+
+
+ yystate = yyn;
+ goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here. |
+`-------------------------------------*/
+yyacceptlab:
+ yyresult = 0;
+ goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here. |
+`-----------------------------------*/
+yyabortlab:
+ yyresult = 1;
+ goto yyreturn;
+
+#ifndef yyoverflow
+/*----------------------------------------------.
+| yyoverflowlab -- parser overflow comes here. |
+`----------------------------------------------*/
+yyoverflowlab:
+ yyerror ("parser stack overflow");
+ yyresult = 2;
+ /* Fall through. */
+#endif
+
+yyreturn:
+#ifndef yyoverflow
+ if (yyss != yyssa)
+ YYSTACK_FREE (yyss);
+#endif
+ return yyresult;
+}
+
+
+#line 325 "./otp.y"
+
+
diff --git a/Build/source/texk/web2c/otps/y_tab.h-dist b/Build/source/texk/web2c/otps/y_tab.h-dist
new file mode 100644
index 00000000000..bfe9285131f
--- /dev/null
+++ b/Build/source/texk/web2c/otps/y_tab.h-dist
@@ -0,0 +1,82 @@
+/* A Bison parser, made by GNU Bison 1.875a. */
+
+/* Skeleton parser for Yacc-like parsing with Bison,
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+/* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ NUMBER = 258,
+ ID = 259,
+ STRING = 260,
+ LEFTARROW = 261,
+ RIGHTARROW = 262,
+ INPUT = 263,
+ OUTPUT = 264,
+ ALIASES = 265,
+ STATES = 266,
+ TABLES = 267,
+ EXPRESSIONS = 268,
+ PUSH = 269,
+ POP = 270,
+ DIV = 271,
+ MOD = 272,
+ BEG = 273,
+ END = 274
+ };
+#endif
+#define NUMBER 258
+#define ID 259
+#define STRING 260
+#define LEFTARROW 261
+#define RIGHTARROW 262
+#define INPUT 263
+#define OUTPUT 264
+#define ALIASES 265
+#define STATES 266
+#define TABLES 267
+#define EXPRESSIONS 268
+#define PUSH 269
+#define POP 270
+#define DIV 271
+#define MOD 272
+#define BEG 273
+#define END 274
+
+
+
+
+#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
+typedef int YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+extern YYSTYPE yylval;
+
+
+
diff --git a/Build/source/texk/web2c/otps/yystype.h b/Build/source/texk/web2c/otps/yystype.h
new file mode 100644
index 00000000000..ef9eefc60da
--- /dev/null
+++ b/Build/source/texk/web2c/otps/yystype.h
@@ -0,0 +1,31 @@
+/* yystype.h: Type declarations for the parser.
+
+This file is part of Omega,
+which is based on the web2c distribution of TeX,
+
+Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
+
+Omega is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+Omega is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Omega; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+*/
+
+#define YYSTYPE yystype
+typedef union {
+ int yint;
+ char* ystring ;
+ list ylist;
+ left yleft;
+ llist ylleft;
+} yystype;
diff --git a/Build/source/texk/web2c/patgen.ch b/Build/source/texk/web2c/patgen.ch
new file mode 100644
index 00000000000..555528ed2b5
--- /dev/null
+++ b/Build/source/texk/web2c/patgen.ch
@@ -0,0 +1,261 @@
+% patgen.ch for C compilation with web2c.
+%
+% 07/01/83 (HWT) Original version, made to work with patgen released with
+% version 0.99 of TeX in July 1983. It may not work
+% properly---it is hard to test without more information.
+% 03/23/88 (ETM) Brought up to date, converted for use with WEB to C.
+
+@x WEAVE: print changes only
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{PATGEN changes for C}
+@z
+
+@x Terminal I/O
+@d get_input(#)==read(input,#)
+@d get_input_ln(#)==
+ begin if eoln(input) then read_ln(input);
+ read(input,#);
+ end
+@#
+@y
+@d get_input(#)==#:=input_int(std_input)
+@d get_input_ln(#)==begin #:=getc(std_input); read_ln(std_input); end @#
+@z
+
+@x Need standard input.
+@p @<Compiler directives@>@/
+@y
+@d std_input==stdin
+@p @<Compiler directives@>@/
+@z
+
+@x Add file opening to initialization
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+ print (banner);
+ print_ln (version_string);
+@z
+
+@x Error handling
+@d error(#)==begin print_ln(#); jump_out; end
+@y
+@d error(#)==begin write_ln(stderr, #); uexit(1); end;
+@z
+
+@x Fix signed char problem
+@!text_char=char; {the data type of characters in text files}
+@!ASCII_code=0..last_ASCII_code; {internal representation of input characters}
+@y
+@!ASCII_code=0..last_ASCII_code; {internal representation of input characters}
+@!text_char=ASCII_code; {the data type of characters in text files}
+@z
+
+@x Increase constants.
+@!trie_size=55000; {space for pattern trie}
+@!triec_size=26000; {space for pattern count trie, must be less than
+ |trie_size| and greater than the number of occurrences of any pattern in
+ the dictionary}
+@y
+@!trie_size=550000; {space for pattern trie}
+@!triec_size=260000; {space for pattern count trie, must be less than
+ |trie_size| and greater than the number of occurrences of any pattern in
+ the dictionary}
+@z
+@x
+@!max_buf_len=80; {maximum length of input lines, must be at least |max_len|}
+@y
+@!max_buf_len=3000; {maximum length of input lines, must be at least |max_len|}
+@z
+
+@x Close both input and output files.
+@d close_out(#)==close(#) {close an output file}
+@d close_in(#)==do_nothing {close an input file}
+@y
+@d close_out(#)==xfclose(#, 'outputfile') {close an output file}
+@d close_in(#)==xfclose(#, 'inputfile') {close an input file}
+@z
+
+@x Add f_name declaration, and temporaries for efficiency printing.
+@!dictionary, @!patterns, @!translate, @!patout, @!pattmp: text_file;
+@y
+@!dictionary, @!patterns, @!translate, @!patout, @!pattmp: text_file;
+@!f_name: ^char;
+@!bad_frac, @!denom, @!eff: real;
+@z
+
+@x Get translate filename from command line.
+reset(translate);
+@y
+f_name := cmdline (4);
+reset (translate, f_name);
+@z
+
+@x Input kludge.
+ repeat print('left_hyphen_min, right_hyphen_min: '); get_input(n1,n2);@/
+@y
+ repeat print('left_hyphen_min, right_hyphen_min: '); input_2ints(n1,n2);@/
+@z
+
+@x Floating point output kludge for Web2c.
+ print_ln(', efficiency = ',
+ good_count/(good_pat_count+bad_count/bad_eff):1:2)
+@y
+begin
+ print(', efficiency = ');
+ print_real(good_count/(good_pat_count+bad_count/bad_eff),1,2);
+ write_ln(output);
+end
+@z
+
+@x Get dictionary filename from command line.
+ reset(dictionary);@/
+@y
+f_name := cmdline(1);
+reset (dictionary, f_name);
+@z
+
+% Fix file name initialization, since can't assign a constant string
+% that we're going to write into.
+@x
+ begin filnam:='pattmp. ';
+ filnam[8]:=xdig[hyph_level];
+@y
+ begin strcpy (filnam, 'pattmp. ');
+ filnam[7]:=xdig[hyph_level];
+@z
+
+@x Work around floating point I/O deficiency.
+ if (good_count+miss_count)>0 then
+ print_ln((100*good_count/(good_count+miss_count)):1:2,' %, ',
+ (100*bad_count/(good_count+miss_count)):1:2,' %, ',
+ (100*miss_count/(good_count+miss_count)):1:2,' %');
+@y
+ if (good_count+miss_count)>0 then
+ begin print_real((100*good_count/(good_count+miss_count)),1,2);
+ print(' %, ');
+ print_real((100*bad_count/(good_count+miss_count)),1,2);
+ print(' %, ');
+ print_real((100*miss_count/(good_count+miss_count)),1,2);
+ print_ln(' %');
+ end;
+@z
+
+@x Get pattern filename from command line.
+reset(patterns);
+@y
+f_name := cmdline (2);
+reset (patterns, f_name);
+@z
+
+@x Fix reading of multiple variables in the same line
+repeat print('hyph_start, hyph_finish: '); get_input(n1,n2);@/
+@y
+repeat print('hyph_start, hyph_finish: '); input_2ints(n1,n2);@/
+@z
+@x
+ repeat print('pat_start, pat_finish: '); get_input(n1,n2);@/
+@y
+ repeat print('pat_start, pat_finish: '); input_2ints(n1,n2);@/
+@z
+@x
+ get_input(n1,n2,n3);@/
+@y
+ input_3ints(n1,n2,n3);@/
+@z
+
+@x Get output file name from command line.
+rewrite(patout);
+@y
+f_name := cmdline (3);
+rewrite (patout, f_name);
+@z
+
+@x System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PATGEN} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 2; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ do_nothing;
+
+ end else if getopt_return_val = '?' then begin
+ usage ('patgen');
+
+ end else if argument_is ('help') then begin
+ usage_help (PATGEN_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil,
+ 'Frank M. Liang and Peter Breitenlohner');
+
+ end; {Else it was just a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 4 <> argc) then begin
+ write_ln (stderr, 'patgen: Need exactly four arguments.');
+ usage ('patgen');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/patgen.rc b/Build/source/texk/web2c/patgen.rc
new file mode 100644
index 00000000000..3796554cae7
--- /dev/null
+++ b/Build/source/texk/web2c/patgen.rc
@@ -0,0 +1,34 @@
+/* patgen.rc: patgen resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " patgen 2.3"
+
+#define VER_INTERNALNAME_STR "patgen"
+#define VER_ORIGINALFILENAME_STR "patgen.exe"
+
+#define VER_FILEDESCRIPTION_STR "Generates hyphenation files for TeX"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#include <texlive.version>
+
+/* patgen.rc ends here */
diff --git a/Build/source/texk/web2c/patgen.web b/Build/source/texk/web2c/patgen.web
new file mode 100644
index 00000000000..ab8f2beab0f
--- /dev/null
+++ b/Build/source/texk/web2c/patgen.web
@@ -0,0 +1,1978 @@
+% This is PATGEN.WEB in text format, as of August 23, 2004.
+% Version 1.0 was finished in 1983.
+% Version 2.0 major revision for `8-bit TeX' (November 8, 1991).
+% Version 2.1 allows left/right_hypen_min from terminal (April, 1992).
+% Version 2.2 added `close_in(dictionary)' (August, 1996).
+% Version 2.3 avoided division by zero - Karl Berry (October, 1996).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\def\PASCAL{Pascal}
+
+\def\title{PATGEN}
+\def\contentspagenumber{45} % should be odd
+\def\topofcontents{
+ \line{\tenit Appendix\hfil \mainfont\contentspagenumber}
+ \vfill
+ \null\vskip 40pt
+ \centerline{\titlefont {\ttitlefont PAT}tern {\ttitlefont GEN}eration
+ program}
+ \vskip 8pt
+ \centerline{\titlefont for the \TeX 82 hyphenator}
+ \vskip 15pt
+ \centerline{(Version 2.3, August 2004)}
+ \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program takes a list of hyphenated words and generates a set of
+patterns that can be used by the \TeX 82 hyphenation algorithm.
+
+The patterns consist of strings of letters and digits, where a digit
+indicates a `hyphenation value' for some intercharacter position. For
+example, the pattern \.{3t2ion} specifies that if the string \.{tion}
+occurs in a word, we should assign a hyphenation value of 3 to the
+position immediately before the \.{t}, and a value of 2 to the position
+between the \.{t} and the \.{i}.
+
+To hyphenate a word, we find all patterns that match within the word and
+determine the hyphenation values for each intercharacter position. If
+more than one pattern applies to a given position, we take the maximum of
+the values specified (i.e., the higher value takes priority). If the
+resulting hyphenation value is odd, this position is a feasible
+breakpoint; if the value is even or if no value has been specified, we are
+not allowed to break at this position.
+
+In order to find quickly the patterns that match in a given word and to
+compute the associated hyphenation values, the patterns generated by this
+program are compiled by \.{INITEX} into a compact version of a finite
+state machine. For further details, see the \TeX 82 source.
+
+The |banner| string defined here should be changed whenever \.{PATGEN}
+gets modified.
+
+@d banner=='This is PATGEN, Version 2.3' {printed when the program starts}
+
+@ The original version~1 of \.{PATGEN} was written by Frank~M. Liang
+@^Liang, Franklin Mark@>
+in 1982; a major revision (version~2) by Peter Breitenlohner in 1991
+@^Breitenlohner, Peter@>
+is mostly related to the new features of `8-bit \TeX' (version~3 of
+\TeX 82). The differences between versions~1 and~2 fall into several
+categories (all of Liang's algorithms have been left essentially
+unchanged): (1)~enhancements related to 8-bit \TeX, e.g., the
+introduction of 8-bit |ASCII_code| values and of \.{\\lefthyphenmin} and
+\.{\\righthyphenmin}; (2)~a modification of the input and output
+procedures which should make language specific modifications of this
+program unnecessary (information about the external representation of
+all `letters' used by a particular language is obtained from the
+|translate| file); (3)~removal of ANSI standard \PASCAL\ and range check
+violations; (4)~removal of uninitialized variables; (5)~minor
+modifications in order to simplify system-dependent modifications.
+@^range check violations@>
+
+@ This program is written in standard \PASCAL, except where it is
+necessary to use extensions. All places where nonstandard constructions
+are used have been listed in the index under ``system dependencies.''
+@!@^system dependencies@>
+
+The program uses \PASCAL's standard |input| and |output| files to read
+from and write to the user's terminal.
+
+@d print(#)==write(output,#)
+@d print_ln(#)==write_ln(output,#)
+@d get_input(#)==read(input,#)
+@d get_input_ln(#)==
+ begin if eoln(input) then read_ln(input);
+ read(input,#);
+ end
+@#
+@d end_of_PATGEN=9999
+
+@p @<Compiler directives@>@/
+program PATGEN(@!dictionary,@!patterns,@!translate,@!patout);
+label end_of_PATGEN;
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ The patterns are generated in a series of sequential passes through the
+dictionary. In each pass, we collect count statistics for a particular
+type of pattern, taking into account the effect of patterns chosen in
+previous passes. At the end of a pass, the counts are examined and new
+patterns are selected.
+
+Patterns are chosen one level at a time, in order of increasing
+hyphenation value. In the sample run shown below, the parameters
+|hyph_start| and |hyph_finish| specify the first and last levels,
+respectively, to be generated.
+
+Patterns at each level are chosen in order of increasing pattern length
+(usually starting with length~2). This is controlled by the parameters
+|pat_start| and |pat_finish| specified at the beginning of each level.
+
+Furthermore patterns of the same length applying to different
+intercharacter positions are chosen in separate passes through the
+dictionary. Since patterns of length $n$ may apply to $n+1$ different
+positions, choosing a set of patterns of lengths $2$ through $n$ for a
+given level requires $(n+1)(n+2)/2-3$ passes through the word list.
+
+At each level, the selection of patterns is controlled by the three
+parameters |good_wt|, |bad_wt|, and |thresh|. A hyphenating pattern will
+be selected if |good*good_wt-bad*bad_wt>=thresh|, where |good| and
+|bad| are the number of times the pattern could and could not be
+hyphenated, respectively, at a particular point. For inhibiting patterns,
+|good| is the number of errors inhibited, and |bad| is the number of
+previously found hyphens inhibited.
+
+@<Globals...@>=
+@!pat_start, @!pat_finish: dot_type;
+@!hyph_start, @!hyph_finish: val_type;
+@!good_wt, @!bad_wt, @!thresh: integer;
+
+@ The proper choice of the parameters to achieve a desired degree of
+hyphenation is discussed in Chapter~4. Below we show part of a sample run
+of \.{PATGEN}, with the user's inputs underlined.
+$$\vbox{\halign{\.{#\hfil}\cr
+$\underline{\smash{\.{ex patgen}}}$\cr
+DICTIONARY : $\underline{\smash{\.{murray.hyf}}}$\cr
+PATTERNS : $\underline{\smash{\.{nul:}}}$\cr
+TRANSLATE : $\underline{\smash{\.{nul:}}}$\cr
+PATOUT : $\underline{\smash{\.{murray.pat}}}$\cr
+This is PATGEN, Version 2.0\cr
+left\_hyphen\_min = 2, right\_hyphen\_min = 3, 26 letters\cr
+0 patterns read in\cr
+pattern trie has 256 nodes, trie\_max = 256, 0 outputs\cr
+hyph\_start, hyph\_finish: $\underline{\.{1 1}}$\cr
+pat\_start, pat\_finish: $\underline{\.{2 3}}$\cr
+good weight, bad weight, threshold: $\underline{\.{1 3 3}}$\cr
+processing dictionary with pat\_len = 2, pat\_dot = 1\cr
+\cr
+0 good, 0 bad, 3265 missed\cr
+ 0.00 \%, 0.00 \%, 100.00 \%\cr
+338 patterns, 466 nodes in count trie, triec\_max = 983\cr
+46 good and 152 bad patterns added (more to come)\cr
+finding 715 good and 62 bad hyphens, efficiency = 10.72\cr
+pattern trie has 326 nodes, trie\_max = 509, 2 outputs\cr
+processing dictionary with pat\_len = 2, pat\_dot = 0\cr
+\cr
+\hskip 1.5em ...\cr
+\cr
+1592 nodes and 39 outputs deleted\cr
+total of 220 patterns at hyph\_level 1\cr
+hyphenate word list? $\underline{\smash{\.{y}}}$\cr
+writing pattmp.1\cr
+\cr
+2529 good, 243 bad, 736 missed\cr
+ 77.46 \%, 7.44 \%, 22.54 \%\cr}}$$
+
+@ Note that before beginning a pattern selection run, a file of existing
+patterns may be read in. In order for pattern selection to work properly,
+this file should only contain patterns with hyphenation values less than
+|hyph_start|. Each word in the dictionary is hyphenated according to the
+existing set of patterns (including those chosen on previous passes of the
+current run) before pattern statistics are collected.
+
+Also, a hyphenated word list may be written out at the end of a run. This
+list can be read back in as the `dictionary' to continue pattern selection
+from this point. In addition to ordinary hyphens (|'-'|) the new list
+will contain two additional kinds of ``hyphens'' between letters, namely
+hyphens that have been found by previously generated patterns, as well
+as erroneous hyphens that have been inserted by those patterns. These
+are represented by the symbols |'*'| and |'.'|, respectively. The three
+characters |'-'|, |'*'|, and |'.'| are, in fact, just the default values
+used to represent the three kinds of hyphens, the |translate| file may
+specify different characters to be used instead of them.
+
+In addition, a word list can include hyphen weights, both for entire words
+and for individual hyphen positions. (The syntax for this is explained in
+the dictionary processing routines.) Thus common words can be weighted
+more heavily, or, more generally, words can be weighted according to their
+frequency of occurrence, if such information is available. The use of
+hyphen weights combined with an appropriate setting of the pattern
+selection threshold can be used to guarantee hyphenation of certain words
+or certain hyphen positions within a word.
+
+@ Below we show the first few lines of a typical word list,
+before and after generating a level of patterns.
+$$\vbox{\halign{\tabskip 1in\.{#\hfil}&\.{#\hfil}\cr
+abil-i-ty& abil*i*ty\cr
+ab-sence& ab*sence\cr
+ab-stract& ab*stract\cr
+ac-a-dem-ic& ac-a-d.em-ic\cr
+ac-cept& ac*cept\cr
+ac-cept-able& ac*cept-able\cr
+ac-cept-ed& ac*cept*ed\cr
+\hskip 1.5em ...&\hskip 1.5em ...\cr
+}}$$
+
+@ We augment \PASCAL 's control structures a bit using |goto|\unskip's
+and the following symbolic labels.
+
+@d exit=10 {go here to leave a procedure}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=40 {go here when you've found it}
+@d not_found=41 {go here when you've found something else}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#)==#:=#+1 {increase a variable by unity}
+@d decr(#)==#:=#-1 {decrease a variable by unity}
+@#
+@d Incr_Decr_end(#)==#
+@d Incr(#)==#:=#+Incr_Decr_end {we use |Incr(a)(b)| to increase \dots}
+@d Decr(#)==#:=#-Incr_Decr_end {\dots\ and |Decr(a)(b)| to decrease
+ variable |a| by |b|; this can be optimized for some compilers}
+@#
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return==goto exit {terminate a procedure call}
+@f return==nil
+@f loop == xclause
+
+@ In case of serious problems \.{PATGEN} will give up, after issuing an
+error message about what caused the error. Such errors might be
+discovered inside of subroutines inside of subroutines, so a \.{WEB}
+macro called |jump_out| has been introduced. This macro, which transfers
+control to the label |end_of_PATGEN| at the end of the program, contains
+the only non-local |@!goto| statement in \.{PATGEN}. Some \PASCAL\
+compilers do not implement non-local |goto| statements. In such cases
+the |goto end_of_PATGEN| in the definition of |jump_out| should simply
+be replaced by a call on some system procedure that quietly terminates
+the program.
+@^system dependencies@>
+
+An overflow stop occurs if \.{PATGEN}'s tables aren't large enough.
+
+@d jump_out==goto end_of_PATGEN {terminates \.{PATGEN}}
+@#
+@d error(#)==begin print_ln(#); jump_out; end
+@d overflow(#)==error('PATGEN capacity exceeded, sorry [',#,'].')
+@.PATGEN capacity exceeded ...@>
+
+@ @<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@^system dependencies@>
+
+@* The character set.
+Since different \PASCAL\ systems may use different character sets, we use
+the name |text_char| to stand for the data type of characters appearing in
+external text files. We also assume that |text_char| consists of the
+elements |chr(first_text_char)| through |chr(last_text_char)|, inclusive.
+The definitions below should be adjusted if necessary.
+@^system dependencies@>
+@^character set dependencies@>
+
+Internally, characters will be represented using the type |ASCII_code|.
+Note, however, that only some of the standard ASCII characters are
+assigned a fixed |ASCII_code|; all other characters are assigned an
+|ASCII_code| dynamically when they are first read from the |translate|
+file specifying the external representation of the `letters' used by a
+particular language. For the sake of generality the standard version of
+this program allows for 256 different |ASCII_code| values, but 128 of
+them would probably suffice for all practical purposes.
+
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@#
+@d last_ASCII_code=255 {the highest allowed |ASCII_code| value}
+
+@<Types...@>=
+@!text_char=char; {the data type of characters in text files}
+@!ASCII_code=0..last_ASCII_code; {internal representation of input characters}
+@!text_file=text;
+
+@ Some \PASCAL s can store only signed eight-bit quantities (|-128..127|)
+but not unsigned ones (|0..255|) in one byte. If storage is tight we
+must, for such \PASCAL s, either restrict |ASCII_code| to the range
+|0..127| (with some loss of generality) or convert between |ASCII_code|
+and |packed_ASCII_code| and vice versa by subtracting or adding an
+offset. (Or we might define |packed_ASCII_code| as |char| and use
+suitable typecasts for the conversion.) Only the type |packed_ASCII_code|
+will be used for large arrays and the \.{WEB} macros |si| and |so| will
+always be used to convert an |ASCII_code| into a |packed_ASCII_code| and
+vice versa.
+@^system dependencies@>
+
+@d min_packed=0 {change this to `$\\{min\_packed}=-128$' when necessary;
+ and don't forget to change the definitions of |si| and |so| below
+ accordingly}
+@#
+@d si(#)==# {converts |ASCII_code| to |packed_ASCII_code|}
+@d so(#)==# {converts |packed_ASCII_code| to |ASCII_code|}
+
+@<Types...@>=
+@!packed_ASCII_code=min_packed..last_ASCII_code+min_packed;
+
+@ We want to make sure that the ``constants'' defined in this program
+satisfy all the required relations. Some of them are needed to avoid
+time-consuming checks while processing the dictionary and\slash or to
+prevent range check and array bound violations.
+@^range check violations@>
+
+Here we check that the definitions of |ASCII_code| and
+|packed_ASCII_code| are consistent with those of |si| and |so|.
+
+@<Set init...@>=
+bad:=0;@/
+if last_ASCII_code<127 then bad:=1;
+if (si(0)<>min_packed)or(so(min_packed)<>0) then bad:=2;@/
+@<Check the ``constant'' values for consistency@>@;
+if bad>0 then error('Bad constants---case ',bad:1);
+@.Bad constants@>
+
+@ @<Local variables for init...@>=
+@!bad:integer;
+@!i:text_char;
+@!j:ASCII_code;
+
+@ We convert between |ASCII_code| and the user's external character set by
+means of arrays |xord| and |xchr| that are analogous to \PASCAL's |ord|
+and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ The following code initializes the |xchr| array with some of the
+standard ASCII characters.
+
+@<Set init...@>=
+for j:=0 to last_ASCII_code do xchr[j]:=' ';
+xchr["."]:='.';@/
+xchr["0"]:='0'; xchr["1"]:='1'; xchr["2"]:='2'; xchr["3"]:='3';
+xchr["4"]:='4'; xchr["5"]:='5'; xchr["6"]:='6'; xchr["7"]:='7';
+xchr["8"]:='8'; xchr["9"]:='9';@/
+xchr["A"]:='A'; xchr["B"]:='B'; xchr["C"]:='C'; xchr["D"]:='D';
+xchr["E"]:='E'; xchr["F"]:='F'; xchr["G"]:='G'; xchr["H"]:='H';
+xchr["I"]:='I'; xchr["J"]:='J'; xchr["K"]:='K'; xchr["L"]:='L';
+xchr["M"]:='M'; xchr["N"]:='N'; xchr["O"]:='O'; xchr["P"]:='P';
+xchr["Q"]:='Q'; xchr["R"]:='R'; xchr["S"]:='S'; xchr["T"]:='T';
+xchr["U"]:='U'; xchr["V"]:='V'; xchr["W"]:='W'; xchr["X"]:='X';
+xchr["Y"]:='Y'; xchr["Z"]:='Z';@/
+xchr["a"]:='a'; xchr["b"]:='b'; xchr["c"]:='c'; xchr["d"]:='d';
+xchr["e"]:='e'; xchr["f"]:='f'; xchr["g"]:='g'; xchr["h"]:='h';
+xchr["i"]:='i'; xchr["j"]:='j'; xchr["k"]:='k'; xchr["l"]:='l';
+xchr["m"]:='m'; xchr["n"]:='n'; xchr["o"]:='o'; xchr["p"]:='p';
+xchr["q"]:='q'; xchr["r"]:='r'; xchr["s"]:='s'; xchr["t"]:='t';
+xchr["u"]:='u'; xchr["v"]:='v'; xchr["w"]:='w'; xchr["x"]:='x';
+xchr["y"]:='y'; xchr["z"]:='z';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@d invalid_code=0 {|ASCII_code| that should not appear}
+@d tab_char=@'11 {|ord| of tab character; tab characters seem to be
+ unavoidable with files from UNIX systems}
+@^system dependencies@>
+@^character set dependencies@>
+
+@<Set init...@>=
+for i:=chr(first_text_char) to chr(last_text_char) do
+ xord[i]:=invalid_code;
+for j:=0 to last_ASCII_code do xord[xchr[j]]:=j;
+xord[' ']:=" "; xord[chr(tab_char)]:=" ";
+
+@ So far each invalid |ASCII_code| has been assigned the character |' '|
+and all invalid characters have been assigned |ASCII_code=invalid_code|.
+The |get_ASCII| function, used only while reading the |translate| file,
+returns the |ASCII_code| corresponding to a character, assigning a new
+|ASCII_code| first if necessary.
+
+@d num_ASCII_codes=last_ASCII_code+1 {number of different |ASCII_code| values}
+
+@p function get_ASCII(@!c:text_char):ASCII_code;
+label found;
+var i: ASCII_code;
+begin i:=xord[c];
+if i=invalid_code then
+ begin while i<last_ASCII_code do
+ begin incr(i);
+ if (xchr[i]=' ')and(i<>" ") then goto found;
+ end;
+ overflow(num_ASCII_codes:1,' characters');
+ found: xord[c]:=i; xchr[i]:=c;
+ end;
+get_ASCII:=i;
+end;
+
+@ The \TeX 82 hyphenation algorithm operates on `hyphenable words'
+converted temporarily to lower case, i.e., they may consist of up to
+255 different `letters' corresponding to \.{\\lccode}s |1..255|. These
+\.{\\lccode}s could, in principle, be language dependent but this might
+lead to undesirable results when hyphenating multilingual paragraphs.
+No more than 245 different letters can occur in hyphenation patterns
+since the characters |'0'..'9'| and |'.'| play a special r\^^Dole when
+reading patterns. For the purpose of this program each letter is
+represented internally by a unique |internal_code>=2| (|internal_code=1|
+is the |edge_of_word| indicator); |internal_code| values |2..127| will
+probably suffice for all practical purposes, but we allow the range
+|2..last_ASCII_code| for the sake of generality. Syntactically
+|internal_code| and |ASCII_code| are the same, we will use one or the
+other name according to the semantic context.
+
+@d edge_of_word=1 {|internal_code| for start and end of a word}
+
+@<Types...@>=
+@!internal_code=ASCII_code;
+@!packed_internal_code=packed_ASCII_code;
+
+@ Note that an |internal_code| used by this program is in general quite
+different from the |ASCII_code| (or rather \.{\\lccode}) used by \TeX
+82. This program allows the input of characters (from the |dictionary|
+and |patterns| file) corresponding to an |internal_code| in either lower
+or upper case form; the output (to the |patout| and |pattmp| file) will
+always be in lower case form.
+
+Unfortunately there does not (yet?) exist a standardized and widely
+accepted 8-bit character set (or a unique one-to-one translation between
+such sets). On the other hand macro expansion takes place in \TeX 82
+when reading hyphenable words and when reading patterns. Thus the lower
+and upper case versions of all `letters' used by a particular language
+can (and for the sake of portability should) be represented entirely in
+terms of the standard ASCII character set; either directly as characters
+or via macros (or active characters) with or without arguments. The
+macro definitions for such a representation will in general be language
+dependent.
+
+For the purpose of this program the external representation of the lower
+and upper case version of a letter (i.e., |internal_code|) consists of a
+unique sequence of characters (or \\{ASCII\_codes}), the only restriction
+being that no such sequence must be a subsequence of an other one.
+Moreover such sequences must not start with |' '|, |'.'|, |'0'..'9'| or
+with one of the three characters (|'-'|, |'*'|, and |'.'|) representing
+hyphens in the |dictionary| file; a sequence may, however, end with a
+mandatory |' '| as, e.g., the sequence |'\ss '|.
+
+The language dependent values of \.{\\lefthyphenmin} and
+\.{\\righthyphenmin} as well as the external representation of the lower
+and upper case letters and their collating sequence are specified in the
+|translate| file, thus making any language dependent modifications of
+this program unnecessary. If the |translate| file is empty (or does not
+exist) the values \.{\\lefthyphenmin=2} and \.{\\righthyphenmin=3} and
+|internal_code| values |2..27| with the one character external
+representations |'a'..'z'| and |'A'..'Z'| will be used as defaults.
+
+Incidentally this program can be used to convert a |dictionary| and
+|patterns| file from one (``upper case'') to another (``lower case'')
+external representation of letters.
+
+@ When reading the |dictionary| (and |patterns|) file sequences of
+characters must be recognized and converted to their corresponding
+|internal_code|. This conversion is part of \.{PATGEN}s inner loop and
+@^inner loop@>
+must therefore be done as efficient as possible. Thus we will
+mostly bypass the conversion from character to |ASCII_code| and convert
+directly to the corresponding |internal_code| using the |xclass|
+and |xint| arrays. Six types of characters are distinguished by their
+|xclass|:
+
+\yskip\hang |space_class| character |' '| terminates a pattern or word.
+
+\yskip\hang |digit_class| characters |'0'..'9'| are hyphen values for a
+pattern or hyphen weights for a word; their |xint| is the corresponding
+numeric value |0..9|.
+
+\yskip\hang |hyf_class| characters (|'.'|, |'-'|, and |'*'|) are `dots'
+and indicate hyphens in a word; their |xint| is the corresponding
+numeric value |err_hyf..found_hyf|.
+
+\yskip\hang |letter_class| characters represent a letter; their |xint|
+is the corresponding |internal_code|.
+
+\yskip\hang |escape_class| characters indicate the start of a
+multi-character sequence representing a letter.
+
+\yskip\hang |invalid_class| characters should not occur except as part
+of multi-character sequences.
+
+@d space_class=0 {the character |' '|}
+@d digit_class=1 {the characters |'0'..'9'|}
+@d hyf_class=2 {the `hyphen' characters (|'.'|, |'-'|, and |'*'|)}
+@d letter_class=3 {characters representing a letter}
+@d escape_class=4 {characters that start a multi-character sequence
+ representing a letter}
+@d invalid_class=5 {characters that normally should not occur}
+@#
+@d no_hyf=0 {no hyphen}
+@d err_hyf=1 {erroneous hyphen}
+@d is_hyf=2 {hyphen}
+@d found_hyf=3 {found hyphen}
+
+@<Types...@>=
+@!class_type=space_class..invalid_class; {class of a character}
+@!digit=0..9; {a hyphen weight (or word weight)}
+@!hyf_type=no_hyf..found_hyf; {type of a hyphen}
+
+@ In addition we will use the |xext|, |xdig|, and |xdot| arrays to
+convert from the internal representation to the corresponding
+characters.
+
+@<Globals...@>=
+@!xclass: array [text_char] of class_type;
+ {specifies the class of a character}
+@!xint: array [text_char] of internal_code;
+ {specifies the |internal_code| for a character}
+@!xdig: array [0..9] of text_char;
+ {specifies conversion of output characters}
+@!xext: array [internal_code] of text_char;
+ {specifies conversion of output characters}
+@!xhyf: array [err_hyf..found_hyf] of text_char;
+ {specifies conversion of output characters}
+
+@ @<Set init...@>=
+for i:=chr(first_text_char) to chr(last_text_char) do
+ begin xclass[i]:=invalid_class; xint[i]:=0;
+ end;
+xclass[' ']:=space_class;
+for j:=0 to last_ASCII_code do xext[j]:=' ';
+xext[edge_of_word]:='.';
+for j:=0 to 9 do
+ begin xdig[j]:=xchr[j+"0"];
+ xclass[xdig[j]]:=digit_class; xint[xdig[j]]:=j;
+ end;
+xhyf[err_hyf]:='.'; xhyf[is_hyf]:='-'; xhyf[found_hyf]:='*';
+ {default representation for hyphens}
+
+@ We assume that words use only the letters |cmin+1| through |cmax|.
+This allows us to save some time on trie operations that involve
+searching for packed transitions belonging to a particular state.
+
+@d cmin=edge_of_word
+
+@<Globals...@>=
+@!cmax: internal_code; {largest |internal_code| or |ASCII_code|}
+
+@* Data structures.
+The main data structure used in this program is a dynamic packed trie.
+In fact we use two of them, one for the set of patterns selected so far,
+and one for the patterns being considered in the current pass.
+
+For a pattern $p_1\ldots p_k$, the information associated with that
+pattern is accessed by setting |@t$t_1$@>:=trie_root+@t$p_1$@>| and
+then, for |1<i<=k|, setting |@t$t_i$@>:=trie_link(@t$t_{i-1}$@>)+
+@t$p_i$@>|; the pattern information is then stored in a location addressed
+by |@t$t_k$@>|. Since all trie nodes are packed into a single array, in
+order to distinguish nodes belonging to different trie families, a special
+field is provided such that |trie_char@t$(t_i)=si(p_i)$@>| for all |i|.
+
+In addition the trie must support dynamic insertions and deletions. This
+is done by maintaining a doubly linked list of unoccupied cells and
+repacking trie families as necessary when insertions are made.
+
+Each trie node consists of three fields: the character |trie_char|, and
+the two link fields |trie_link| and |trie_back|. In addition there is a
+separate boolean array |trie_base_used|. When a node is unoccupied,
+|trie_char=min_packed| and the link fields point to the next and previous
+unoccupied nodes, respectively, in the doubly linked list. When a node is
+occupied, |trie_link| points to the next trie family, and |trie_back|
+(renamed |trie_outp|) contains the output associated with this transition.
+The |trie_base_used| bit indicates that some family has been packed at
+this base location, and is used to prevent two families from being packed
+at the same location.
+
+@ The sizes of the pattern tries may have to be adjusted depending
+on the particular application (i.e., the parameter settings and the
+size of the dictionary). The sizes below were sufficient to generate
+the original set of english \TeX 82 hyphenation patterns (file
+\.{hyphen.tex}).
+
+@<Constants...@>=
+@!trie_size=55000; {space for pattern trie}
+@!triec_size=26000; {space for pattern count trie, must be less than
+ |trie_size| and greater than the number of occurrences of any pattern in
+ the dictionary}
+@!max_ops=4080; {size of output hash table, should be a multiple of 510}
+@!max_val=10; {maximum number of levels$+1$, also used to denote bad patterns}
+@!max_dot=15; {maximum pattern length, also maximum length of external
+ representation of a `letter'}
+@!max_len=50; {maximum word length}
+@!max_buf_len=80; {maximum length of input lines, must be at least |max_len|}
+
+@ @<Check the ``constant'' values for consistency@>=
+if (triec_size<4096)or(trie_size<triec_size) then bad:=3;
+if max_ops>trie_size then bad:=4;
+if max_val>10 then bad:=5;
+if max_buf_len<max_len then bad:=6;
+
+@ @<Types...@>=
+@!q_index=1..last_ASCII_code; {number of transitions in a state}
+@!val_type=0..max_val; {hyphenation values}
+@!dot_type=0..max_dot; {dot positions}
+@!op_type=0..max_ops; {index into output hash table}
+@!word_index=0..max_len; {index into |word|}
+@!trie_pointer=0..trie_size;
+@!triec_pointer=0..triec_size;@/
+@!op_word=packed record dot: dot_type; val: val_type; op: op_type end;
+
+@ Trie is actually stored with its components in separate packed arrays,
+in order to save space and time (although this depends on the computer's
+word size and the size of the trie pointers).
+
+@<Globals...@>=
+@!trie_c: packed array[trie_pointer] of packed_internal_code;
+@!trie_l, @!trie_r: packed array[trie_pointer] of trie_pointer;
+@!trie_taken: packed array[trie_pointer] of boolean;
+@!triec_c: packed array[triec_pointer] of packed_internal_code;
+@!triec_l, @!triec_r: packed array[triec_pointer] of triec_pointer;
+@!triec_taken: packed array[triec_pointer] of boolean;
+@!ops: array[op_type] of op_word; {output hash table}
+
+@ When some trie state is being worked on, an unpacked version of the
+state is kept in positions |1..qmax| of the global arrays |trieq_c|,
+|trieq_l|, and |trieq_r|. The character fields need not be in any
+particular order.
+
+@<Globals...@>=
+@!trieq_c: array[q_index] of internal_code; {character fields of a
+ single trie state}
+@!trieq_l, @!trieq_r: array[q_index] of trie_pointer; {link fields}
+@!qmax: q_index; {number of transitions in an unpacked state}
+@!qmax_thresh: q_index; {controls density of first-fit packing}
+
+@ Trie fields are accessed using the following macros.
+
+@d trie_char(#)==trie_c[#]
+@d trie_link(#)==trie_l[#]
+@d trie_back(#)==trie_r[#]
+@d trie_outp(#)==trie_r[#]
+@d trie_base_used(#)==trie_taken[#]
+@#
+@d triec_char(#)==triec_c[#]
+@d triec_link(#)==triec_l[#]
+@d triec_back(#)==triec_r[#]
+@d triec_good(#)==triec_l[#]
+@d triec_bad(#)==triec_r[#]
+@d triec_base_used(#)==triec_taken[#]
+@#
+@d q_char(#)==trieq_c[#]
+@d q_link(#)==trieq_l[#]
+@d q_back(#)==trieq_r[#]
+@d q_outp(#)==trieq_r[#]
+@#
+@d hyf_val(#)==ops[#].val
+@d hyf_dot(#)==ops[#].dot
+@d hyf_nxt(#)==ops[#].op
+
+@* Routines for pattern trie.
+The pattern trie holds the set of patterns chosen prior to the current
+pass, including bad or ``hopeless'' patterns at the current level that
+occur too few times in the dictionary to be of use. Each transition of
+the trie includes an output field pointing to the hyphenation information
+associated with this transition.
+
+@<Globals...@>=
+@!trie_max: trie_pointer; {maximum occupied trie node}
+@!trie_bmax: trie_pointer; {maximum base of trie family}
+@!trie_count: trie_pointer; {number of occupied trie nodes, for space usage
+ statistics}
+@!op_count: op_type; {number of outputs in hash table}
+
+@ Initially, the dynamic packed trie has just one state, namely the root,
+with all transitions present (but with null links). This is convenient
+because the root will never need to be repacked and also we won't have to
+check that the base is nonnegative when packing other states.
+Moreover in many cases we need not check for a vanishing link field:
+if |trie_link(t)=0| then a subsequent test for
+|trie_char(trie_link(t)+c)=si(c)| will always fail due to |trie_root=1|.
+
+@d trie_root=1
+
+@p procedure init_pattern_trie;
+var c: internal_code; @!h: op_type;
+begin for c:=0 to last_ASCII_code do
+ begin trie_char(trie_root+c):=si(c); {indicates node occupied;
+ fake for |c=0|}
+ trie_link(trie_root+c):=0;
+ trie_outp(trie_root+c):=0;
+ trie_base_used(trie_root+c):=false;
+ end;
+ trie_base_used(trie_root):=true;
+ trie_bmax:=trie_root;
+ trie_max:=trie_root+last_ASCII_code;
+ trie_count:=num_ASCII_codes;@/
+ qmax_thresh:=5;@/
+ trie_link(0):=trie_max+1;
+ trie_back(trie_max+1):=0;@/
+ {|trie_link(0)| is used as the head of the doubly linked list of
+ unoccupied cells}
+ for h:=1 to max_ops do hyf_val(h):=0; {clear output hash table}
+ op_count:=0;
+end;
+
+@ The |first_fit| procedure finds a hole in the packed trie into which the
+state in |trieq_c|, |trieq_l|, and |trieq_r| will fit. This is normally
+done by going through the linked list of unoccupied cells and testing if
+the state will fit at each position. However if a state has too many
+transitions (and is therefore unlikely to fit among existing
+transitions) we don't bother and instead just pack it immediately to the
+right of the occupied region (starting at |trie_max+1|).
+
+@p function first_fit: trie_pointer;
+label found, not_found;
+var s, @!t: trie_pointer; @!q: q_index;
+begin @<Set |s| to the trie base location at which this state should be
+ packed@>;
+ for q:=1 to qmax do {pack it}
+ begin t:=s+q_char(q);@/
+ trie_link(trie_back(t)):=trie_link(t);
+ trie_back(trie_link(t)):=trie_back(t); {link around
+ filled cell}
+ trie_char(t):=si(q_char(q));
+ trie_link(t):=q_link(q);
+ trie_outp(t):=q_outp(q);
+ if t>trie_max then trie_max:=t;
+ end;
+ trie_base_used(s):=true;
+ first_fit:=s
+end;
+
+@ The threshold for large states is initially 5 transitions. If more than
+one level of patterns is being generated, the threshold is set to 7 on
+subsequent levels because the pattern trie will be sparser after bad
+patterns are deleted (see |delete_bad_patterns|).
+
+@<Set |s| to the trie base location at which this state should be packed@>=
+if qmax>qmax_thresh then t:=trie_back(trie_max+1) @+else t:=0;
+loop begin t:=trie_link(t); s:=t-q_char(1); {get next unoccupied cell}
+ @<Ensure |trie| linked up to |s+num_ASCII_codes|@>;
+ if trie_base_used(s) then goto not_found;
+ for q:=qmax downto 2 do {check if state fits here}
+ if trie_char(s+q_char(q))<>min_packed then goto not_found;
+ goto found;
+ not_found: end;
+found:
+
+@ The trie is only initialized (as a doubly linked list of empty cells) as
+far as necessary. Here we extend the initialization if necessary, and
+check for overflow.
+
+@<Ensure |trie| linked up to |s+num_ASCII_codes|@>=
+if s>trie_size-num_ASCII_codes then
+ overflow(trie_size:1,' pattern trie nodes');
+while trie_bmax<s do
+ begin incr(trie_bmax);
+ trie_base_used(trie_bmax):=false;
+ trie_char(trie_bmax+last_ASCII_code):=min_packed;
+ trie_link(trie_bmax+last_ASCII_code):=trie_bmax+num_ASCII_codes;
+ trie_back(trie_bmax+num_ASCII_codes):=trie_bmax+last_ASCII_code;
+ end
+
+@ The |unpack| procedure finds all transitions associated with the state
+with base |s|, puts them into the arrays |trieq_c|, |trieq_l|, and
+|trieq_r|, and sets |qmax| to one more than the number of transitions
+found. Freed cells are put at the beginning of the free list.
+
+@p procedure unpack(@!s: trie_pointer);
+var c: internal_code; @!t: trie_pointer;
+begin qmax:=1;
+for c:=cmin to cmax do {search for transitions belonging to this state}
+ begin t:=s+c;
+ if so(trie_char(t))=c then {found one}
+ begin q_char(qmax):=c;
+ q_link(qmax):=trie_link(t);
+ q_outp(qmax):=trie_outp(t);
+ incr(qmax);@/
+ {now free trie node}
+ trie_back(trie_link(0)):=t;
+ trie_link(t):=trie_link(0);
+ trie_link(0):=t;
+ trie_back(t):=0;
+ trie_char(t):=min_packed;
+ end;
+ end;
+trie_base_used(s):=false;
+end;
+
+@ The function |new_trie_op| returns the `opcode' for the output
+consisting of hyphenation value~|v|, hyphen position |d|, and next output
+|n|. The hash function used by |new_trie_op| is based on the idea that
+313/510 is an approximation to the golden ratio [cf.\ {\sl The Art of
+Computer Programming \bf3} (1973), 510--512]; but the choice is
+comparatively unimportant in this particular application.
+
+@p function new_trie_op(@!v: val_type; @!d: dot_type; @!n: op_type): op_type;
+label exit;
+var h: op_type;
+begin h:=((n+313*d+361*v) mod max_ops)+1; {trial hash location}
+loop begin if hyf_val(h)=0 then {empty position found}
+ begin incr(op_count);
+ if op_count=max_ops then overflow(max_ops:1,' outputs');
+ hyf_val(h):=v; hyf_dot(h):=d; hyf_nxt(h):=n; new_trie_op:=h; return;
+ end;
+ if (hyf_val(h)=v) and (hyf_dot(h)=d) and
+ (hyf_nxt(h)=n) then {already in hash table}
+ begin new_trie_op:=h; return;
+ end;
+ if h>1 then decr(h) @+else h:=max_ops; {try again}
+ end;
+exit: end;
+
+@ @<Globals...@>=
+@!pat: array[dot_type] of internal_code; {current pattern}
+@!pat_len: dot_type; {pattern length}
+
+@ Now that we have provided the necessary routines for manipulating the
+dynamic packed trie, here is a procedure that inserts a pattern of length
+|pat_len|, stored in the |pat| array, into the pattern trie. It also adds
+a new output.
+
+@p procedure insert_pattern(@!val: val_type; @!dot: dot_type);
+var i: dot_type; @!s, @!t: trie_pointer;
+begin i:=1;
+ s:=trie_root+pat[i]; t:=trie_link(s);
+ while (t>0) and (i<pat_len) do {follow existing trie}
+ begin incr(i); Incr(t)(pat[i]);
+ if so(trie_char(t))<>pat[i] then
+ @<Insert critical transition, possibly repacking@>;
+ s:=t; t:=trie_link(s);
+ end;
+ q_link(1):=0; q_outp(1):=0; qmax:=1;
+ while i<pat_len do {insert rest of pattern}
+ begin incr(i); q_char(1):=pat[i];
+ t:=first_fit;
+ trie_link(s):=t;
+ s:=t+pat[i];
+ incr(trie_count);
+ end;
+ trie_outp(s):=new_trie_op(val,dot,trie_outp(s));
+end;
+
+@ We have accessed a transition not in the trie. We insert it, repacking
+the state if necessary.
+
+@<Insert critical transition, possibly repacking@>=
+begin if trie_char(t)=min_packed then
+ begin {we're lucky, no repacking needed}
+ trie_link(trie_back(t)):=trie_link(t);
+ trie_back(trie_link(t)):=trie_back(t);@/
+ trie_char(t):=si(pat[i]);
+ trie_link(t):=0;
+ trie_outp(t):=0;
+ if t>trie_max then trie_max:=t;
+ end
+else begin {whoops, have to repack}
+ unpack(t-pat[i]);@/
+ q_char(qmax):=pat[i];
+ q_link(qmax):=0;
+ q_outp(qmax):=0;@/
+ t:=first_fit;
+ trie_link(s):=t;
+ Incr(t)(pat[i]);
+ end;
+incr(trie_count);
+end
+
+@* Routines for pattern count trie.
+The pattern count trie is used to store the set of patterns considered in
+the current pass, along with the counts of good and bad instances. The
+fields of this trie are the same as the pattern trie, except that there is
+no output field, and leaf nodes are also used to store counts
+(|triec_good| and |triec_bad|). Except where noted, the following
+routines are analogous to the pattern trie routines.
+
+@<Globals...@>=
+@!triec_max, @!triec_bmax, @!triec_count: triec_pointer; {same as for pattern
+ trie}
+@!triec_kmax: triec_pointer; {shows growth of trie during pass}
+@!pat_count: integer; {number of patterns in count trie}
+
+@ [See |init_pattern_trie|.] The variable |triec_kmax| always contains
+the size of the count trie rounded up to the next multiple of 4096, and is
+used to show the growth of the trie during each pass.
+
+@d triec_root=1
+
+@p procedure init_count_trie;
+var c: internal_code;
+begin for c:=0 to last_ASCII_code do
+ begin triec_char(triec_root+c):=si(c);@/
+ triec_link(triec_root+c):=0;
+ triec_back(triec_root+c):=0;
+ triec_base_used(triec_root+c):=false;
+ end;
+ triec_base_used(triec_root):=true;
+ triec_bmax:=triec_root; triec_max:=triec_root+last_ASCII_code;
+ triec_count:=num_ASCII_codes; triec_kmax:=4096;@/
+ triec_link(0):=triec_max+1; triec_back(triec_max+1):=0;@/
+ pat_count:=0;
+end;
+
+@ [See |first_fit|.]
+
+@p function firstc_fit: triec_pointer;
+label found, not_found;
+var a, @!b: triec_pointer; @!q: q_index;
+begin @<Set |b| to the count trie base location at which this state should
+ be packed@>;
+ for q:=1 to qmax do {pack it}
+ begin a:=b+q_char(q);@/
+ triec_link(triec_back(a)):=triec_link(a);
+ triec_back(triec_link(a)):=triec_back(a);@/
+ triec_char(a):=si(q_char(q));
+ triec_link(a):=q_link(q);
+ triec_back(a):=q_back(q);
+ if a>triec_max then triec_max:=a;
+ end;
+ triec_base_used(b):=true;
+ firstc_fit:=b
+end;
+
+@ The threshold for attempting a first-fit packing is 3 transitions, which
+is lower than for the pattern trie because speed is more important here.
+
+@<Set |b| to the count trie base location...@>=
+if qmax>3 then a:=triec_back(triec_max+1) @+else a:=0;
+loop begin a:=triec_link(a); b:=a-q_char(1);@/
+ @<Ensure |triec| linked up to |b+num_ASCII_codes|@>;
+ if triec_base_used(b) then goto not_found;
+ for q:=qmax downto 2 do
+ if triec_char(b+q_char(q))<>min_packed then goto not_found;
+ goto found;
+ not_found: end;
+found:
+
+@ @<Ensure |triec| linked up to |b+num_ASCII_codes|@>=
+if b>triec_kmax-num_ASCII_codes then
+ begin if triec_kmax=triec_size then
+ overflow(triec_size:1,' count trie nodes');
+ print(triec_kmax div 1024:1, 'K ');
+ if triec_kmax>triec_size-4096 then triec_kmax:=triec_size
+ else Incr(triec_kmax)(4096);
+ end;
+while triec_bmax<b do
+ begin incr(triec_bmax);
+ triec_base_used(triec_bmax):=false;
+ triec_char(triec_bmax+last_ASCII_code):=min_packed;
+ triec_link(triec_bmax+last_ASCII_code):=triec_bmax+num_ASCII_codes;
+ triec_back(triec_bmax+num_ASCII_codes):=triec_bmax+last_ASCII_code;
+ end
+
+@ [See |unpack|.]
+
+@p procedure unpackc(@!b: triec_pointer);
+var c: internal_code; @!a: triec_pointer;
+begin qmax:=1;
+for c:=cmin to cmax do {search for transitions belonging to this state}
+ begin a:=b+c;
+ if so(triec_char(a))=c then {found one}
+ begin q_char(qmax):=c;
+ q_link(qmax):=triec_link(a);
+ q_back(qmax):=triec_back(a);
+ incr(qmax);@/
+ triec_back(triec_link(0)):=a;
+ triec_link(a):=triec_link(0);
+ triec_link(0):=a; triec_back(a):=0;
+ triec_char(a):=min_packed;
+ end;
+ end;
+triec_base_used(b):=false;
+end;
+
+@ [See |insert_pattern|.] Patterns being inserted into the count trie are
+always substrings of the current word, so they are contained in the array
+|word| with length |pat_len| and finishing position |fpos|.
+
+@p function insertc_pat(@!fpos: word_index): triec_pointer;
+var spos: word_index; @!a, @!b: triec_pointer;
+begin spos:=fpos-pat_len; {starting position of pattern}
+ incr(spos); b:=triec_root+word[spos]; a:=triec_link(b);
+ while (a>0) and (spos<fpos) do {follow existing trie}
+ begin incr(spos); Incr(a)(word[spos]);
+ if so(triec_char(a))<>word[spos] then
+ @<Insert critical count transition, possibly repacking@>;
+ b:=a; a:=triec_link(a);
+ end;
+ q_link(1):=0; q_back(1):=0; qmax:=1;
+ while spos<fpos do {insert rest of pattern}
+ begin incr(spos); q_char(1):=word[spos];
+ a:=firstc_fit;
+ triec_link(b):=a;
+ b:=a+word[spos];
+ incr(triec_count);
+ end;
+ insertc_pat:=b;
+ incr(pat_count);
+end;
+
+@ @<Insert critical count transition, possibly repacking@>=
+begin if triec_char(a)=min_packed then {lucky}
+ begin triec_link(triec_back(a)):=triec_link(a);
+ triec_back(triec_link(a)):=triec_back(a);
+ triec_char(a):=si(word[spos]);
+ triec_link(a):=0;
+ triec_back(a):=0;
+ if a>triec_max then triec_max:=a;
+ end
+else begin {have to repack}
+ unpackc(a-word[spos]);@/
+ q_char(qmax):=word[spos];
+ q_link(qmax):=0;
+ q_back(qmax):=0;
+ a:=firstc_fit;
+ triec_link(b):=a;
+ Incr(a)(word[spos]);
+ end;
+incr(triec_count);
+end
+
+@* Input and output.
+For some \PASCAL\ systems output files must be closed before the program
+terminates; it may also be necessary to close input files. Since
+standard \PASCAL\ does not provide for this, we use \.{WEB} macros and
+will say |close_out(f)| resp.\ |close_in(f)|; these macros should not
+produce errors or system messages, even if a file could not be opened
+successfully.
+@^system dependencies@>
+
+@d close_out(#)==close(#) {close an output file}
+@d close_in(#)==do_nothing {close an input file}
+
+@<Globals...@>=
+@!dictionary, @!patterns, @!translate, @!patout, @!pattmp: text_file;
+
+@ When reading a line from one of the input files (|dictionary|,
+|patterns|, or |translate|) the characters read from that line (padded
+with blanks if necessary) are to be placed into the |buf| array. Reading
+lines from the |dictionary| file should be as efficient as possible
+since this is part of \.{PATGEN}'s ``inner loop''. Standard \PASCAL,
+unfortunately, does not provide for this; consequently the \.{WEB} macro
+|read_buf| defined below should be optimized if possible. For many
+\PASCAL's this can be done with |read_ln(f,buf)| where |buf| is declared
+as \PASCAL\ string (i.e., as \&{packed} \&{array} |[1..any]| \&{of}
+|char|), for others a string type with dynamic length can be used.
+@^inner loop@>@^system dependencies@>
+
+@d read_buf(#)== {reads a line from input file |#| into |buf| array}
+ begin buf_ptr:=0;
+ while not eoln(#) do
+ begin if (buf_ptr>=max_buf_len) then bad_input('Line too long');
+@.Line too long@>
+ incr(buf_ptr); read(#,buf[buf_ptr]);
+ end;
+ read_ln(#);
+ while buf_ptr<max_buf_len do
+ begin incr(buf_ptr); buf[buf_ptr]:=' ';
+ end;
+ end
+
+@<Globals...@>=
+@!buf: array[1..max_buf_len] of text_char; {array to hold lines of input}
+@!buf_ptr: 0..max_buf_len; {index into |buf|}
+
+@ When an error is caused by bad input data we say |bad_input(#)| in
+order to disply the contents of the |buf| array before terminating with
+an error message.
+
+@d print_buf== {print contents of |buf| array}
+ begin buf_ptr:=0;
+ repeat incr(buf_ptr); print(buf[buf_ptr]);
+ until buf_ptr=max_buf_len;
+ print_ln(' ');
+ end
+@d bad_input(#)==begin print_buf; error(#); end
+
+@ The |translate| file may specify the values of \.{\\lefthyphenmin} and
+\.{\\righthyphenmin} as well as the external representation and
+collating sequence of the `letters' used by the language. In addition
+replacements may be specified for the characters |'-'|, |'*'|, and |'.'|
+representing hyphens in the word list. If the |translate| file is empty
+(or does not exist) default values will be used.
+
+@p procedure read_translate;
+label done;
+var c: text_char;
+@!n: integer;
+@!j: ASCII_code;
+@!bad: boolean;
+@!lower: boolean;
+@!i: dot_type; @!s, @!t: trie_pointer;
+begin imax:=edge_of_word;
+reset(translate);
+if eof(translate) then
+ @<Set up default character translation tables@>
+else begin read_buf(translate); @<Set up hyphenation data@>;
+ cmax:=last_ASCII_code-1;
+ while not eof(translate) do @<Set up representation(s) for a letter@>;
+ end;
+close_in(translate);
+print_ln('left_hyphen_min = ',left_hyphen_min:1,
+ ', right_hyphen_min = ',right_hyphen_min:1,
+ ', ',imax-edge_of_word:1,' letters');
+cmax:=imax;
+end;
+
+@ @<Globals...@>=
+@!imax: internal_code; {largest |internal_code| assigned so far}
+@!left_hyphen_min, @!right_hyphen_min: dot_type;
+
+@ @<Set up default...@>=
+begin left_hyphen_min:=2; right_hyphen_min:=3;
+for j:="A" to "Z" do
+ begin incr(imax);
+ c:=xchr[j+"a"-"A"]; xclass[c]:=letter_class; xint[c]:=imax;
+ xext[imax]:=c;
+ c:=xchr[j]; xclass[c]:=letter_class; xint[c]:=imax;
+ end;
+end
+
+@ The first line of the |translate| file must contain the values
+of \.{\\lefthyphenmin} and \.{\\righthyphenmin} in columns 1--2 and
+3--4. In addition columns~5, 6, and~7 may (optionally) contain
+replacements for the default characters |'.'|, |'-'|, and |'*'|
+respectively, representing hyphens in the word list.
+If the values specified for \.{\\lefthyphenmin} and \.{\\righthyphenmin}
+are invalid (e.g., blank) new values are read from the terminal.
+
+@<Set up hyphenation...@>=
+bad:=false;
+if buf[1]=' ' then n:=0
+else if xclass[buf[1]]=digit_class then n:=xint[buf[1]]@+
+else bad:=true;
+if xclass[buf[2]]=digit_class then n:=10*n+xint[buf[2]]@+
+else bad:=true;
+if (n>=1)and(n<max_dot) then left_hyphen_min:=n@+else bad:=true;
+if buf[3]=' ' then n:=0
+else if xclass[buf[3]]=digit_class then n:=xint[buf[3]]@+
+else bad:=true;
+if xclass[buf[4]]=digit_class then n:=10*n+xint[buf[4]]@+
+else bad:=true;
+if (n>=1)and(n<max_dot) then right_hyphen_min:=n@+
+else bad:=true;
+if bad then
+ begin bad:=false;
+ repeat print('left_hyphen_min, right_hyphen_min: '); get_input(n1,n2);@/
+ if (n1>=1)and(n1<max_dot)and(n2>=1)and(n2<max_dot) then
+ begin left_hyphen_min:=n1; right_hyphen_min:=n2;
+ end
+ else begin n1:=0;
+ print_ln('Specify 1<=left_hyphen_min,right_hyphen_min<=',
+ max_dot-1:1,' !');
+ end;
+ until n1>0;
+ end;
+for j:=err_hyf to found_hyf do
+ begin if buf[j+4]<>' ' then xhyf[j]:=buf[j+4];
+ if xclass[xhyf[j]]=invalid_class then xclass[xhyf[j]]:=hyf_class@+
+ else bad:=true;
+ end;
+xclass['.']:=hyf_class; {in case the default has been changed}
+if bad then bad_input('Bad hyphenation data')
+@.Bad hyphenation data@>
+
+@ Each following line is either a comment or specifies the external
+representations for one `letter' used by the language. Comment lines
+start with two equal characters (e.g., are blank) and are ignored.
+Other lines contain the external representation of the lower case
+version and an arbitrary number of `upper case versions' of a letter
+preceded and separated by a delimiter and followed by two consecutive
+delimiters; the delimiter may be any character not occuring in either
+version.
+
+@<Set up repres...@>=
+begin read_buf(translate); buf_ptr:=1; lower:=true;
+while not bad do {lower and then upper case version}
+ begin pat_len:=0;
+ repeat if buf_ptr<max_buf_len then incr(buf_ptr) @+ else bad:=true;
+ if buf[buf_ptr]=buf[1] then
+ if pat_len=0 then goto done
+ else begin if lower then
+ begin if imax=last_ASCII_code then
+ begin print_buf; overflow(num_ASCII_codes:1,' letters');
+ end;
+ incr(imax); xext[imax]:=xchr[pat[pat_len]];
+ end;
+ c:=xchr[pat[1]];
+ if pat_len=1 then
+ begin if xclass[c]<>invalid_class then bad:=true;
+ xclass[c]:=letter_class; xint[c]:=imax;
+ end
+ else @<Insert a letter into pattern trie@>;
+ end
+ else if pat_len=max_dot then bad:=true
+ else begin incr(pat_len); pat[pat_len]:=get_ASCII(buf[buf_ptr]);
+ end;
+ until (buf[buf_ptr]=buf[1])or bad;
+ lower:=false;
+ end;
+done: if bad then bad_input('Bad representation');
+@.Bad representation@>
+end
+
+@ When the (lower or upper case) external representation of a letter
+consists of more than one character and the corresponding |ASCII_code|
+values have been placed into the |pat| array we store them in
+the pattern trie. [See |insert_pattern|.] Since this `external subtrie'
+starts at |trie_link(trie_root)| it does not interfere with normal
+patterns. The output field of leaf nodes contains the |internal_code|
+and the link field distinguishes between lower and upper case letters.
+
+@<Insert a letter...@>=
+begin if xclass[c]=invalid_class then xclass[c]:=escape_class;
+if xclass[c]<>escape_class then bad:=true;
+i:=0; s:=trie_root; t:=trie_link(s);
+while (t>trie_root) and (i<pat_len) do {follow existing trie}
+ begin incr(i); Incr(t)(pat[i]);
+ if so(trie_char(t))<>pat[i] then
+ @<Insert critical transition, possibly repacking@>
+ else if trie_outp(t)>0 then bad:=true;
+ s:=t; t:=trie_link(s);
+ end;
+if t>trie_root then bad:=true;
+q_link(1):=0; q_outp(1):=0; qmax:=1;
+while i<pat_len do {insert rest of pattern}
+ begin incr(i); q_char(1):=pat[i];
+ t:=first_fit;
+ trie_link(s):=t;
+ s:=t+pat[i];
+ incr(trie_count);
+ end;
+trie_outp(s):=imax;
+if not lower then trie_link(s):=trie_root;
+end
+
+@ The |get_letter| \.{WEB} macro defined here will be used in
+|read_word| and |read_patterns| to obtain the |internal_code|
+corresponding to a letter externally represented by a multi-character
+sequence (starting with an |escape_class| character).
+
+@d get_letter(#)==
+ begin t:=trie_root;
+ loop begin t:=trie_link(t)+xord[c];
+ if so(trie_char(t))<>xord[c] then bad_input('Bad representation');
+@.Bad representation@>
+ if trie_outp(t)<>0 then
+ begin #:=trie_outp(t); goto done;
+ end;
+ if buf_ptr=max_buf_len then c:=' '
+ else begin incr(buf_ptr); c:=buf[buf_ptr];
+ end;
+ end;
+ done: end
+
+@ In order to prepare for the output phase we store all but the last of
+the \\{ASCII\_codes} of the external representation of each `lower case
+letter' in the pattern count trie which is no longer used at that time.
+The recursive |find_letters| procedure traverses the `external subtrie'.
+
+@p procedure find_letters(@!b: trie_pointer; @!i: dot_type);@/
+ {traverse subtries of family |b|; |i| is current depth in trie}
+var c: ASCII_code; {a local variable that must be saved on recursive calls}
+@!a: trie_pointer; {does not need to be saved}
+@!j: dot_type; {loop index}
+@!l: triec_pointer;
+begin if i=1 then init_count_trie;
+for c:=cmin to last_ASCII_code do {find transitions belonging to this family}
+ begin a:=b+c;
+ if so(trie_char(a))=c then {found one}
+ begin pat[i]:=c;
+ if trie_outp(a)=0 then find_letters(trie_link(a),i+1)
+ else if trie_link(a)=0 then {this is a lower case letter}
+ @<Insert external representation for a letter into count trie@>;
+ end;
+ end;
+end;
+
+@ Starting from |triec_root+trie_outp(a)| we proceed through link fields
+and store all \\{ASCII\_codes} except the last one in the count trie;
+the last character has already been stored in the |xext| array.
+
+@<Insert external...@>=
+begin l:=triec_root+trie_outp(a);
+for j:=1 to i-1 do
+ begin if triec_max=triec_size then
+ overflow(triec_size:1,' count trie nodes');
+ incr(triec_max); triec_link(l):=triec_max; l:=triec_max;
+ triec_char(l):=si(pat[j]);
+ end;
+triec_link(l):=0;
+end
+
+@ During the output phase we will say |write_letter(i)(f)| and
+|write(f,xext[i])| to write the lower case external representation of
+the letter with internal code |i| to file |f|: |xext[i]| is the last
+character of the external representation whereas the \.{WEB} macro
+|write_letter| defined here writes all preceding characters (if any).
+
+@d write_letter_end(#)==while l>0 do
+ begin write(#,xchr[so(triec_char(l))]); l:=triec_link(l);
+ end
+@d write_letter(#)==l:=triec_link(triec_root+#); write_letter_end
+
+@* Routines for traversing pattern tries.
+At the end of a pass, we traverse the count trie using the following
+recursive procedure, selecting good and bad patterns and inserting them
+into the pattern trie.
+
+@p procedure traverse_count_trie(@!b: triec_pointer; @!i: dot_type);@/
+{traverse subtries of family |b|; |i| is current depth in trie}
+var c: internal_code; {a local variable that must be saved on recursive calls}
+ @!a: triec_pointer; {does not need to be saved}
+begin
+for c:=cmin to cmax do {find transitions belonging to this family}
+ begin a:=b+c;
+ if so(triec_char(a))=c then {found one}
+ begin pat[i]:=c;
+ if i<pat_len then traverse_count_trie(triec_link(a),i+1)
+ else @<Decide what to do with this pattern@>;
+ end;
+ end;
+end;
+
+@ When we have come to the end of a pattern, |triec_good(a)| and
+|triec_bad(a)| contain the number of times this pattern helps or hinders
+the cause. We use the counts to determine if this pattern should be
+selected, or if it is hopeless, or if we can't decide yet. In the latter
+case, we set |more_to_come| true to indicate that there might still be
+good patterns extending the current type of patterns.
+
+@<Decide what to do...@>=
+if good_wt*triec_good(a)<thresh then {hopeless pattern}
+begin insert_pattern(max_val,pat_dot);
+ incr(bad_pat_count)
+end else
+if good_wt*triec_good(a)-bad_wt*triec_bad(a)>=thresh then {good pattern}
+begin insert_pattern(hyph_level,pat_dot);
+ incr(good_pat_count);
+ Incr(good_count)(triec_good(a));
+ Incr(bad_count)(triec_bad(a));
+end else
+ more_to_come:=true
+
+@ Some global variables are used to accumulate statistics about the
+performance of a pass.
+
+@<Globals...@>=
+@!good_pat_count, @!bad_pat_count: integer; {number of patterns added at end
+ of pass}
+@!good_count, @!bad_count, @!miss_count: integer; {hyphen counts}
+@!level_pattern_count: integer; {number of good patterns at level}
+@!more_to_come: boolean;
+
+@ The recursion in |traverse_count_trie| is initiated by the following
+procedure, which also prints some statistics about the patterns chosen.
+The ``efficiency'' is an estimate of pattern effectiveness.
+
+@d bad_eff==(thresh/good_wt)
+
+@p procedure collect_count_trie;
+begin good_pat_count:=0; bad_pat_count:=0;
+ good_count:=0; bad_count:=0;
+ more_to_come:=false;
+ traverse_count_trie(triec_root,1); @/
+ print(good_pat_count:1,' good and ',
+ bad_pat_count:1,' bad patterns added');
+ Incr(level_pattern_count)(good_pat_count);
+ if more_to_come then print_ln(' (more to come)') @+else print_ln(' ');
+ print('finding ',good_count:1,' good and ',bad_count:1,' bad hyphens');
+ if good_pat_count>0 then
+ print_ln(', efficiency = ',
+ good_count/(good_pat_count+bad_count/bad_eff):1:2)
+ else print_ln(' ');
+ print_ln('pattern trie has ',trie_count:1,' nodes, ',@|
+ 'trie_max = ',trie_max:1,', ',op_count:1,' outputs');
+end;
+
+@ At the end of a level, we traverse the pattern trie and delete bad
+patterns by removing their outputs. If no output remains, the node is
+also deleted.
+
+@p function delete_patterns(@!s: trie_pointer): trie_pointer;@/
+{delete bad patterns in subtrie |s|, return 0 if entire subtrie freed,
+ otherwise |s|}
+var c: internal_code; @!t: trie_pointer; @!all_freed: boolean;
+ {must be saved on recursive calls}
+ @!h, @!n: op_type; {do not need to be saved}
+begin all_freed:=true;
+ for c:=cmin to cmax do {find transitions belonging to this family}
+ begin t:=s+c;
+ if so(trie_char(t))=c then
+ begin @<Link around bad outputs@>;
+ if trie_link(t)>0 then
+ trie_link(t):=delete_patterns(trie_link(t));
+ if (trie_link(t)>0) or (trie_outp(t)>0) or (s=trie_root) then
+ all_freed:=false
+ else
+ @<Deallocate this node@>;
+ end;
+ end;
+ if all_freed then {entire state is freed}
+ begin trie_base_used(s):=false;
+ s:=0;
+ end;
+ delete_patterns:=s;
+end;
+
+@ @<Link around bad outputs@>=
+begin h:=0;
+ hyf_nxt(0):=trie_outp(t);
+ n:=hyf_nxt(0);
+ while n>0 do
+ begin if hyf_val(n)=max_val then hyf_nxt(h):=hyf_nxt(n)
+ else h:=n;
+ n:=hyf_nxt(h);
+ end;
+ trie_outp(t):=hyf_nxt(0);
+end
+
+@ Cells freed by |delete_patterns| are put at the end of the free list.
+
+@<Deallocate this node@>=
+begin trie_link(trie_back(trie_max+1)):=t;
+ trie_back(t):=trie_back(trie_max+1);
+ trie_link(t):=trie_max+1;
+ trie_back(trie_max+1):=t;
+ trie_char(t):=min_packed;@/
+ decr(trie_count);
+end
+
+@ The recursion in |delete_patterns| is initiated by the following
+procedure, which also prints statistics about the number of nodes deleted,
+and zeros bad outputs in the hash table. Note that the hash table may
+become somewhat disorganized when more levels are added, but this defect
+isn't serious.
+
+@p procedure delete_bad_patterns;
+var old_op_count: op_type;
+ @!old_trie_count: trie_pointer;
+ @!t: trie_pointer; @!h: op_type;
+begin old_op_count:=op_count;
+ old_trie_count:=trie_count;@/
+ t:=delete_patterns(trie_root);
+ for h:=1 to max_ops do
+ if hyf_val(h)=max_val then
+ begin hyf_val(h):=0; decr(op_count);
+ end;
+ print_ln(old_trie_count-trie_count:1,' nodes and ',@|
+ old_op_count-op_count:1,' outputs deleted');
+ qmax_thresh:=7; {pattern trie will be sparser because of deleted
+ patterns}
+end;
+
+@ After all patterns have been generated, we will traverse the pattern
+trie and output all patterns. Note that if a pattern appears more than
+once, only the maximum value at each position will be output.
+
+@p procedure output_patterns(@!s: trie_pointer; @!pat_len: dot_type);@/
+{output patterns in subtrie |s|; |pat_len| is current depth in trie}
+var c: internal_code; {must be saved on recursive calls}
+@!t: trie_pointer; @!h: op_type; @!d: dot_type;@/
+@!l: triec_pointer; {for |write_letter|}
+begin for c:=cmin to cmax do
+ begin t:=s+c;
+ if so(trie_char(t))=c then
+ begin pat[pat_len]:=c;
+ h:=trie_outp(t);
+ if h>0 then @<Output this pattern@>;
+ if trie_link(t)>0 then output_patterns(trie_link(t),pat_len+1);
+ end;
+ end;
+end;
+
+@ @<Output this pattern@>=
+begin for d:=0 to pat_len do hval[d]:=0;
+ repeat d:=hyf_dot(h);
+ if hval[d]<hyf_val(h) then hval[d]:=hyf_val(h);
+ h:=hyf_nxt(h);
+ until h=0;
+ if hval[0]>0 then write(patout,xdig[hval[0]]);
+ for d:=1 to pat_len do
+ begin write_letter(pat[d])(patout); write(patout,xext[pat[d]]);
+ if hval[d]>0 then write(patout,xdig[hval[d]]);
+ end;
+ write_ln(patout);
+end
+
+@* Dictionary processing routines.
+The procedures in this section are the ``inner loop'' of the pattern
+generation process. To speed the program up, key parts of these routines
+could be coded in machine language.
+@^inner loop@>
+
+@<Globals...@>=
+@!word: array[word_index] of internal_code; {current word}
+@!dots: array[word_index] of hyf_type; {current hyphens}
+@!dotw: array[word_index] of digit; {dot weights}
+@!hval: array[word_index] of val_type; {hyphenation values}
+@!no_more: array[word_index] of boolean; {positions `knocked out'}
+@!wlen: word_index; {length of current word}
+@!word_wt: digit; {global word weight}
+@!wt_chg: boolean; {indicates |word_wt| has changed}
+
+@ The words in the |dictionary| consist of the `letters' used by the
+language. ``Dots'' between letters can be one of four possibilities:
+|'-'| indicating a hyphen, |'*'| indicating a found hyphen, |'.'|
+indicating an error, or nothing; these are represented internally by the
+four values |is_hyf|, |found_hyf|, |err_hyf|, and |no_hyf| respectively.
+When reading a word we will, however, convert |err_hyf| into |no_hyf|
+and |found_hyf| into |is_hyf| thus ignoring whether a hyphen has or
+has not been found by a previous set of patterns.
+
+@<Prepare to read dictionary@>=
+xclass['.']:=invalid_class; {in case the default has been changed}
+xclass[xhyf[err_hyf]]:=hyf_class; xint[xhyf[err_hyf]]:=no_hyf;
+xclass[xhyf[is_hyf]]:=hyf_class; xint[xhyf[is_hyf]]:=is_hyf;
+xclass[xhyf[found_hyf]]:=hyf_class; xint[xhyf[found_hyf]]:=is_hyf;
+
+@ Furthermore single-digit word weights are allowed. A digit at
+the beginning of a word indicates a global word weight that is to be
+applied to all following words (until the next global word weight). A
+digit at some intercharacter position indicates a weight for that position
+only.
+
+The |read_word| procedure scans a line of input representing a word,
+and places the letters into the array |word|, with |word[1]=word[wlen]=
+edge_of_word|. The dot appearing between |word[dpos]| and |word[dpos+1]|
+is placed in |dots[dpos]|, and the corresponding dot weight in
+|dotw[dpos]|.
+
+@p procedure read_word;
+label done, found;
+var c: text_char;
+@!t: trie_pointer;
+begin read_buf(dictionary);
+word[1]:=edge_of_word; wlen:=1; buf_ptr:=0;
+repeat incr(buf_ptr); c:=buf[buf_ptr];
+ case xclass[c] of
+ space_class: goto found;
+ digit_class:
+ if wlen=1 then {global word weight}
+ begin if xint[c]<>word_wt then wt_chg:=true;
+ word_wt:=xint[c];
+ end
+ else dotw[wlen]:=xint[c]; {dot weight}
+ hyf_class: dots[wlen]:=xint[c]; {record the dot |c|}
+ letter_class: {record the letter |c|}
+ begin incr(wlen);
+ if wlen=max_len then
+ begin print_buf; overflow('word length=',max_len:1);
+ end;
+ word[wlen]:=xint[c]; dots[wlen]:=no_hyf; dotw[wlen]:=word_wt;
+ end;
+ escape_class: {record a multi-character sequence starting with |c|}
+ begin incr(wlen);
+ if wlen=max_len then
+ begin print_buf; overflow('word length=',max_len:1);
+ end;
+ get_letter(word[wlen]); dots[wlen]:=no_hyf; dotw[wlen]:=word_wt;
+ end;
+ invalid_class: bad_input('Bad character');
+@.Bad character@>
+ end;
+until buf_ptr=max_buf_len;
+found: incr(wlen); word[wlen]:=edge_of_word;
+end;
+
+@ Here is a procedure that uses the existing patterns to hyphenate the
+current word. The hyphenation value applying between the characters
+|word[dpos]| and |word[dpos+1]| is stored in |hval[dpos]|.
+
+In addition, |no_more[dpos]| is set to |true| if this position is
+``knocked out'' by either a good or bad pattern at this level. That is,
+if the pattern with current length and hyphen position is a superstring of
+either a good or bad pattern at this level, then we don't need to collect
+count statistics for the pattern because it can't possibly be chosen in
+this pass. Thus we don't even need to insert such patterns into the count
+trie, which saves a good deal of space.
+
+@p procedure hyphenate;
+label done;
+var spos, @!dpos, @!fpos: word_index;
+ @!t: trie_pointer; @!h: op_type; @!v: val_type;
+begin
+for spos:=wlen-hyf_max downto 0 do
+ begin no_more[spos]:=false; hval[spos]:=0;
+ fpos:=spos+1; t:=trie_root+word[fpos];
+ repeat h:=trie_outp(t);
+ while h>0 do @<Store output |h| in the |hval| and
+ |no_more| arrays, and advance |h|@>;
+ t:=trie_link(t);
+ if t=0 then goto done;
+ incr(fpos); Incr(t)(word[fpos]);
+ until so(trie_char(t))<>word[fpos];
+ done:
+ end;
+end;
+
+@ In order to avoid unnecessary test (and range check violations) the
+globals |hyf_min|, |hyf_max|, and |hyf_len| are set up such that only
+positions from |hyf_min| up to |wlen-hyf_max| of the |word| array need
+to be checked, and that words with |wlen<hyf_len| need not to be checked
+at all.
+
+@<Globals...@>=
+@!hyf_min, @!hyf_max, @!hyf_len: word_index; {limits for legal hyphens}
+
+@ @<Prepare to read dictionary@>=
+hyf_min:=left_hyphen_min+1; hyf_max:=right_hyphen_min+1;
+hyf_len:=hyf_min+hyf_max;
+
+@ @<Store output |h| in the |hval| and |no_more| arrays, and advance |h|@>=
+begin dpos:=spos+hyf_dot(h);
+ v:=hyf_val(h);
+ if (v<max_val) and (hval[dpos]<v) then hval[dpos]:=v;
+ if (v>=hyph_level) then {check if position knocked out}
+ if ((fpos-pat_len)<=(dpos-pat_dot))and((dpos-pat_dot)<=spos) then
+ no_more[dpos]:=true;
+ h:=hyf_nxt(h);
+end
+
+@ The |change_dots| procedure updates the |dots| array representing the
+printing values of the hyphens. Initially, hyphens (and correctly
+found hyphens) in the word list are represented by |is_hyf| whereas
+non-hyphen positions (and erroneous hyphens) are represented by |no_hyf|.
+Here these values are increased by one for each hyphen found by the
+current patterns, thus changing |no_hyf| into |err_hyf| and |is_hyf|
+into |found_hyf|. The routine also collects statistics about the number
+of good, bad, and missed hyphens.
+
+@d incr_wt(#)==Incr(#)(dotw[dpos])
+
+@p procedure change_dots;
+var dpos: word_index;
+begin for dpos:=wlen-hyf_max downto hyf_min do
+ begin if odd(hval[dpos]) then incr(dots[dpos]);
+ if dots[dpos]=found_hyf then incr_wt(good_count)
+ else if dots[dpos]=err_hyf then incr_wt(bad_count)
+ else if dots[dpos]=is_hyf then incr_wt(miss_count);
+ end;
+end;
+
+@ The following procedure outputs the word as hyphenated by the current
+patterns, including any word weights. Hyphens inhibited by the values of
+\.{\\lefthyphenmin} and \.{\\righthyphenmin} are output as well.
+
+@p procedure output_hyphenated_word;
+var dpos: word_index;@/
+@!l: triec_pointer; {for |write_letter|}
+begin if wt_chg then {output global word weight}
+ begin write(pattmp,xdig[word_wt]); wt_chg:=false
+ end;
+for dpos:=2 to wlen-2 do
+ begin write_letter(word[dpos])(pattmp); write(pattmp,xext[word[dpos]]);
+ if dots[dpos]<>no_hyf then write(pattmp,xhyf[dots[dpos]]);
+ if dotw[dpos]<>word_wt then write(pattmp,xdig[dotw[dpos]]);
+ end;
+write_letter(word[wlen-1])(pattmp); write_ln(pattmp,xext[word[wlen-1]]);
+end;
+
+@ For each dot position in the current word, the |do_word| routine first
+checks to see if we need to consider it. It might be knocked out or a dot
+we don't care about. That is, when considering hyphenating patterns, for
+example, we don't need to count hyphens already found. If a relevant dot
+is found, we increment the count in the count trie for the corresponding
+pattern, inserting it first if necessary. At this point of the program
+range check violations may occur if these counts are incremented beyond
+|triec_max|; it would, however, be too expensive to prevent this.
+@^range check violations@>
+
+@p procedure do_word;
+label continue, done;
+var spos, @!dpos, @!fpos: word_index; @!a: triec_pointer;
+ @!goodp: boolean;
+begin for dpos:=wlen-dot_max downto dot_min do
+ begin spos:=dpos-pat_dot;
+ fpos:=spos+pat_len;
+ @<Check this dot position and |goto continue| if don't care@>;
+ incr(spos); a:=triec_root+word[spos];
+ while spos<fpos do
+ begin {follow existing count trie}
+ incr(spos);
+ a:=triec_link(a)+word[spos];
+ if so(triec_char(a))<>word[spos] then
+ begin {insert new count pattern}
+ a:=insertc_pat(fpos);
+ goto done;
+ end;
+ end;
+ done: if goodp then incr_wt(triec_good(a))
+ @+else incr_wt(triec_bad(a));
+ continue:
+ end;
+end;
+
+@ The globals |good_dot| and |bad_dot| will be set to |is_hyf| and
+|no_hyf|, or |err_hyf| and |found_hyf|, depending on whether the current
+level is odd or even, respectively. The globals |dot_min|, |dot_max|,
+and |dot_len| are analogous to |hyf_min|, |hyf_max|, and |hyf_len|
+defined earlier.
+
+@<Globals...@>=
+@!good_dot, @!bad_dot: hyf_type; {good and bad hyphens at current level}
+@!dot_min, @!dot_max, @!dot_len: word_index; {limits for legal dots}
+
+@ @<Prepare to read dictionary@>=
+if procesp then
+ begin dot_min:=pat_dot; dot_max:=pat_len-pat_dot;
+ if dot_min<hyf_min then dot_min:=hyf_min;
+ if dot_max<hyf_max then dot_max:=hyf_max;
+ dot_len:=dot_min+dot_max;
+ if odd(hyph_level) then
+ begin good_dot:=is_hyf; bad_dot:=no_hyf;
+ end
+ else begin good_dot:=err_hyf; bad_dot:=found_hyf;
+ end;
+ end;
+
+@ If the dot position |dpos| is out of bounds, knocked out, or a ``don't
+care'', we skip this position. Otherwise we set the flag |goodp|
+indicating whether this is a good or bad dot.
+
+@<Check this dot position...@>=
+if no_more[dpos] then goto continue;
+if dots[dpos]=good_dot then goodp:=true else
+if dots[dpos]=bad_dot then goodp:=false else goto continue;
+
+@ If |hyphp| is set to |true|, |do_dictionary| will write out a copy of
+the dictionary as hyphenated by the current set of patterns. If |procesp|
+is set to |true|, |do_dictionary| will collect pattern statistics for
+patterns with length |pat_len| and hyphen position |pat_dot|, at level
+|hyph_level|.
+
+@<Globals...@>=
+@!procesp, @!hyphp: boolean;
+@!pat_dot: dot_type; {hyphen position, measured from beginning of pattern}
+@!hyph_level: val_type; {hyphenation level}
+@!filnam: packed array[1..8] of char; {for |pattmp|}
+
+@ The following procedure makes a pass through the word list, and also
+prints out statistics about number of hyphens found and storage used by
+the count trie.
+
+@p procedure do_dictionary;
+begin good_count:=0; bad_count:=0; miss_count:=0;
+ word_wt:=1; wt_chg:=false;
+ reset(dictionary);@/
+ @<Prepare to read dictionary@>@;@/
+ if procesp then
+ begin init_count_trie;
+ print_ln('processing dictionary with pat_len = ',pat_len:1,
+ ', pat_dot = ',pat_dot:1);
+ end;
+ if hyphp then
+ begin filnam:='pattmp. ';
+ filnam[8]:=xdig[hyph_level];
+ rewrite(pattmp,filnam);
+ print_ln('writing pattmp.', xdig[hyph_level]);
+ end;
+ @<Process words until end of file@>;@/
+ close_in(dictionary);@/
+ print_ln(' ');
+ print_ln(good_count:1,' good, ',bad_count:1,' bad, ',
+ miss_count:1,' missed');
+ if (good_count+miss_count)>0 then
+ print_ln((100*good_count/(good_count+miss_count)):1:2,' %, ',
+ (100*bad_count/(good_count+miss_count)):1:2,' %, ',
+ (100*miss_count/(good_count+miss_count)):1:2,' %');
+ if procesp then
+ print_ln(pat_count:1,' patterns, ',triec_count:1,
+ ' nodes in count trie, ','triec_max = ',triec_max:1);
+ if hyphp then close_out(pattmp);
+end;
+
+@ @<Process words...@>=
+while not eof(dictionary) do
+ begin read_word;
+ if wlen>=hyf_len then {short words are never hyphenated}
+ begin hyphenate; change_dots;
+ end;
+ if hyphp then if wlen>2 then output_hyphenated_word;
+ {empty words are ignored}
+ if procesp then if wlen>=dot_len then do_word;
+ end
+
+@* Reading patterns.
+Before beginning a run, we can read in a file of existing patterns. This
+is useful for extending a previous pattern selection run to get some more
+levels. (Since these runs are quite time-consuming, it is convenient to
+choose patterns one level at a time, pausing to look at the results of the
+previous level, and possibly amending the dictionary.)
+
+@p procedure read_patterns;
+label done, found;
+var c: text_char;
+@!d: digit;
+@!i: dot_type;
+@!t: trie_pointer;
+begin xclass['.']:=letter_class; xint['.']:=edge_of_word;
+level_pattern_count:=0; max_pat:=0;
+reset(patterns);
+while not eof(patterns) do
+ begin read_buf(patterns);
+ incr(level_pattern_count);@/
+ @<Get pattern and dots and |goto found|@>;
+ found: @<Insert pattern@>;
+ end;
+close_in(patterns);
+print_ln(level_pattern_count:1,' patterns read in');@/
+print_ln('pattern trie has ',trie_count:1,' nodes, ',@|
+ 'trie_max = ',trie_max:1,', ',op_count:1,' outputs');
+end;
+
+@ The global variable |max_pat| keeps track of the largest hyphenation
+value found in any pattern.
+
+@<Globals...@>=
+@!max_pat: val_type;
+
+@ When a new pattern has been input into |buf|, we extract the letters of
+the pattern, and insert the hyphenation values (digits) into the |hval|
+array.
+
+@<Get pattern...@>=
+pat_len:=0; buf_ptr:=0; hval[0]:=0;
+repeat incr(buf_ptr); c:=buf[buf_ptr];
+ case xclass[c] of
+ space_class: goto found;
+ digit_class:
+ begin d:=xint[c];
+ if d>=max_val then bad_input('Bad hyphenation value');
+@.Bad hyphenation value@>
+ if d>max_pat then max_pat:=d;
+ hval[pat_len]:=d;
+ end;
+ letter_class:
+ begin incr(pat_len); hval[pat_len]:=0; pat[pat_len]:=xint[c];
+ end;
+ escape_class: {record a multi-character sequence starting with |c|}
+ begin incr(pat_len); hval[pat_len]:=0; get_letter(pat[pat_len]);
+ end;
+ hyf_class, invalid_class: bad_input('Bad character');
+@.Bad character@>
+ end;
+until buf_ptr=max_buf_len
+
+@ Then we insert the pattern for each non-vanishing hyphenation value.
+In addition we check that |edge_of_word| (i.e., |'.'|) occurs only as
+first or last character; otherwise we would have to perform a time
+consuming test for the end of a word in the |hyphenate| procedure.
+
+@<Insert pattern@>=
+if pat_len>0 then {avoid spurious patterns}
+ for i:=0 to pat_len do
+ begin if hval[i]<>0 then insert_pattern(hval[i],i);
+ if i>1 then if i<pat_len then if pat[i]=edge_of_word then
+ bad_input('Bad edge_of_word');
+@.Bad edge_of_word@>
+ end
+
+@* The main program.
+This is where \.{PATGEN} actually starts. We initialize the pattern trie,
+get |hyph_level| and |pat_len| limits from the terminal, and generate
+patterns.
+
+@p begin initialize;
+init_pattern_trie;
+read_translate;
+read_patterns;
+procesp:=true; hyphp:=false;@/
+repeat print('hyph_start, hyph_finish: '); get_input(n1,n2);@/
+ if (n1>=1)and(n1<max_val)and(n2>=1)and(n2<max_val) then
+ begin hyph_start:=n1; hyph_finish:=n2;
+ end
+ else begin n1:=0;
+ print_ln('Specify 1<=hyph_start,hyph_finish<=',max_val-1:1,' !');
+ end;
+until n1>0;
+hyph_level:=max_pat; {in case |hyph_finish<hyph_start|}
+for i:=hyph_start to hyph_finish do
+ begin hyph_level:=i; level_pattern_count:=0;
+ if hyph_level>hyph_start then print_ln(' ')
+ else if hyph_start<=max_pat then
+ print_ln('Largest hyphenation value ',max_pat:1,
+ ' in patterns should be less than hyph_start');@/
+@.Largest hyphenation value@>
+ repeat print('pat_start, pat_finish: '); get_input(n1,n2);@/
+ if (n1>=1)and(n1<=n2)and(n2<=max_dot) then
+ begin pat_start:=n1; pat_finish:=n2;
+ end
+ else begin n1:=0;
+ print_ln('Specify 1<=pat_start<=pat_finish<=',max_dot:1,' !');
+ end;
+ until n1>0;
+ repeat print('good weight, bad weight, threshold: ');
+ get_input(n1,n2,n3);@/
+ if (n1>=1)and(n2>=1)and(n3>=1) then
+ begin good_wt:=n1; bad_wt:=n2; thresh:=n3;
+ end
+ else begin n1:=0;
+ print_ln('Specify good weight, bad weight, threshold>=1 !');
+ end;
+ until n1>0;
+ @<Generate a level@>;
+ delete_bad_patterns;
+ print_ln('total of ',level_pattern_count:1,
+ ' patterns at hyph_level ',hyph_level:1);
+ end;
+find_letters(trie_link(trie_root),1); {prepare for output}
+rewrite(patout);
+output_patterns(trie_root,1);
+close_out(patout);@/
+@<Make final pass to hyphenate word list@>;
+end_of_PATGEN:
+end.
+
+@ The patterns of a given length (at a given level) are chosen with dot
+positions ordered in an ``organ-pipe'' fashion. For example, for
+|pat_len=4| we choose patterns for different dot positions in the order 2,
+1, 3, 0, 4. The variable |dot1| controls this iteration in a clever
+manner.
+
+@<Globals...@>=
+@!n1, @!n2, @!n3: integer; {accumulators}
+@!i: val_type; {loop index: hyphenation level}
+@!j: dot_type; {loop index: pattern length}
+@!k: dot_type; {loop index: hyphen position}
+@!dot1: dot_type;
+@!more_this_level: array[dot_type] of boolean;
+
+@ The array |more_this_level| remembers which positions are permanently
+``knocked out''. That is, if there aren't any possible good patterns
+remaining at a certain dot position, we don't need to consider longer
+patterns at this level containing that position.
+
+@<Generate a level@>=
+for k:=0 to max_dot do more_this_level[k]:=true;
+for j:=pat_start to pat_finish do
+ begin pat_len:=j; pat_dot:=pat_len div 2; dot1:=pat_dot*2;
+ repeat pat_dot:=dot1-pat_dot; dot1:=pat_len*2-dot1-1;
+ if more_this_level[pat_dot] then
+ begin do_dictionary; collect_count_trie;
+ more_this_level[pat_dot]:=more_to_come;
+ end;
+ until pat_dot=pat_len;
+ for k:=max_dot downto 1 do
+ if not more_this_level[k-1] then more_this_level[k]:=false;
+ end
+
+@ When all patterns have been found, the user has a chance to see what
+they do. The resulting \.{pattmp} file can be used as the new
+`dictionary' if we want to continue pattern generation from this point.
+
+@<Make final pass to hyphenate word list@>=
+procesp:=false; hyphp:=true;@/
+print('hyphenate word list? ');
+get_input_ln(buf[1]);
+if (buf[1]='Y') or (buf[1]='y') then do_dictionary
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PATGEN} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/pdfetex.rc b/Build/source/texk/web2c/pdfetex.rc
new file mode 100644
index 00000000000..69bf9d84067
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetex.rc
@@ -0,0 +1,42 @@
+/* pdfetex.rc: pdfetex resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " pdfeTeX 3.14159-1.10a-2.1"
+
+#define VER_INTERNALNAME_STR TEXLIVE_LIBRARYPREFIX_STR "pdfetex"
+#define VER_ORIGINALFILENAME_STR TEXLIVE_LIBRARYPREFIX_STR "pdfetex.dll"
+
+#define VER_FILEDESCRIPTION_STR "pdfeTeX DLL"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1996-2003\r\n\
+The NTS Team (eTeX)/Han The Thanh (pdfTeX)\r\n\
+The TeX program is copyright (C) 1982 by D. E. Knuth."
+
+#define VER_LEGALTRADEMARKS_STR \
+"e-TeX and NTS are trademarks of the NTS group.\
+TeX is a trademark of the American Mathematical Society."
+
+#define VER_FILETYPE VFT_DLL
+
+#include <texlive.version>
+
+/* pdfetex.rc ends here */
diff --git a/Build/source/texk/web2c/pdfetexdir/ChangeLog b/Build/source/texk/web2c/pdfetexdir/ChangeLog
new file mode 100644
index 00000000000..d6004e43700
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/ChangeLog
@@ -0,0 +1,69 @@
+2004-08-21 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdfetex.ch2: Adapted to e-TeX version 2.2.
+
+2004-08-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdfetexextra.in: File was renamed from pdftexextra.h; the
+ current pdfTeX and e-TeX versions are substituted from
+ ../pdftexdir/pdftex.version and ../etexdir/etex.version. Variant
+ of code supplied by Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+ * pdfetex.mk: Added rule to insert pdfTeX and e-TeX versions into
+ pdfetexextra.h. Variant of code supplied by Peter Breitenlohner
+ <peb@mppmu.mpg.de>.
+
+2004-08-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdfetex.mk: vadjust.ch moved from pdfxtexdir to pdftexdir.
+
+2004-08-17 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdfetex.mk: Resurrected etex.fix, there is again a need to
+ include late-breaking changes.
+
+2004-07-29 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdfetex.ch[12]: Somewhat rearrange handling of kern and math
+ nodes in order to reduce interference between eTeX and pdfTeX
+ change files.
+
+ * pdfetex.ch1 (hlist_out): Keep full mixed direction typesetting
+ code.
+
+2004-07-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdfetex.ch[12]: Reorganize additional command codes for convert
+ and last_item in order to reduce interference between eTeX and
+ pdfTeX change files.
+
+2004-07-23 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdfetex.ch[12], tex.ch[01]: Reorganize handling of banner
+ string in order to reduce interference between eTeX, pdfTeX,
+ and web2c change files.
+
+2004-07-22 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdfetex.ch[12]: Removed unused token types for pdfTeX's
+ additional token list parameters.
+
+2004-07-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdfetex.ch[12], tex.ch0: Reorganize handling of additional
+ token list and integer parameters and e-TeX's additional
+ penalties in order to reduce interference between eTeX, pdfTeX,
+ and web2c change files.
+
+ * pdfetex.mk (pdfetex.ch): Remove tex.ch2 from build rules.
+
+ * tex.ch2: Removed.
+
+2004-07-17 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdfetex.mk: Rewrite build rules for pdfetex.{web,ch},
+ remove etex.{ch0,ch1,fix}, tex.ch2, and several non-dependencies.
+
+ * pdfetex.ch2: Adapt to eTeX changes.
+
+ * ChangeLog: New file.
diff --git a/Build/source/texk/web2c/pdfetexdir/Makefile.in b/Build/source/texk/web2c/pdfetexdir/Makefile.in
new file mode 100644
index 00000000000..2e44137efe7
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/Makefile.in
@@ -0,0 +1,3 @@
+mostlyclean clean:
+distclean maintainer-clean extraclean: clean
+ rm -f Makefile
diff --git a/Build/source/texk/web2c/pdfetexdir/NEWS b/Build/source/texk/web2c/pdfetexdir/NEWS
new file mode 120000
index 00000000000..c0976dad2e1
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/NEWS
@@ -0,0 +1 @@
+../pdftexdir/NEWS \ No newline at end of file
diff --git a/Build/source/texk/web2c/pdfetexdir/README b/Build/source/texk/web2c/pdfetexdir/README
new file mode 120000
index 00000000000..4809940adaa
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/README
@@ -0,0 +1 @@
+../pdftexdir/README \ No newline at end of file
diff --git a/Build/source/texk/web2c/pdfetexdir/extratime.ch b/Build/source/texk/web2c/pdfetexdir/extratime.ch
new file mode 100644
index 00000000000..d417ab25e29
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/extratime.ch
@@ -0,0 +1,131 @@
+%
+% extratime.ch -- benchmarking support
+%
+% (c) 2005 Taco Hoekwater, taco@elvenkind.com
+%
+% This change file implements an interface to the precise system
+% time (if available) as an aid in benchmarking TeX macro code.
+%
+% Two new primitives are provided:
+%
+% \item |\elapsedtime| is a read-only integer that (initially)
+% returns the amount of time passed since the start of this run.
+% This amount is given in `scaled seconds': the value 65536
+% counts as one second.
+% If more time has passed than 32767 seconds, |\maxint| will be
+% returned.
+%
+% \item |\resettime| updates the internal timer, such that
+% subsequent calls to |\elapsedtime| will restart from 0.
+%
+% Besides this web change file,
+% there is also a new C function needed in |texmfmp.{c,h}|, and a
+% new definition in |texmf.defines| to keep |convert| happy.
+
+% This change file is intended to be used as the last one in
+% pdfetex's |tie| chains, a patch for |Makefile.in| is included.
+%
+%
+
+@x
+@ The integer parameters should really be initialized by a macro package;
+@y
+@ @<Glob...@>=
+@!epochseconds: integer;
+@!microseconds: integer;
+
+@
+@p function get_microinterval:integer;
+var s,@!m:integer; {seconds and microseconds}
+begin
+ seconds_and_micros(s,m);
+ if (s-epochseconds)>32767 then
+ get_microinterval := max_integer
+ else if (microseconds<m) then
+ get_microinterval := ((s-1-epochseconds)*65536)+ (((m+1000000-microseconds)/100)*65536)/10000
+ else
+ get_microinterval := ((s-epochseconds)*65536) + (((m-microseconds)/100)*65536)/10000;
+end;
+
+@ The integer parameters should really be initialized by a macro package;
+@z
+
+@x
+@d badness_code=input_line_no_code+1 {code for \.{\\badness}}
+@y
+@d elapsed_time_code=input_line_no_code+1 {code for \.{\\elapsedtime}}
+@d badness_code=input_line_no_code+2 {code for \.{\\badness}}
+@z
+
+@x l.9016
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+@y
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+primitive("elapsedtime",last_item,elapsed_time_code);
+@!@:elapsed_time_}{\.{\\elapsedtime} primitive@>
+@z
+
+@x l.30672
+@d pdftex_last_extension_code == pdftex_first_extension_code + 24
+@y
+@d reset_timer_code == pdftex_first_extension_code + 25
+@d pdftex_last_extension_code == pdftex_first_extension_code + 25
+@z
+
+
+@x l.30735
+primitive("pdftrailer",extension,pdf_trailer_code);@/
+@!@:pdf_trailer_}{\.{\\pdftrailer} primitive@>
+@y
+primitive("pdftrailer",extension,pdf_trailer_code);@/
+@!@:pdf_trailer_}{\.{\\pdftrailer} primitive@>
+primitive("resettimer",extension,reset_timer_code);@/
+@!@:reset_timer_}{\.{\\resettimer} primitive@>
+@z
+
+
+@x l.30776
+ pdf_trailer_code: print_esc("pdftrailer");
+@y
+ pdf_trailer_code: print_esc("pdftrailer");
+ reset_timer_code: print_esc("resettimer");
+@z
+
+@x l.30822
+pdf_trailer_code: @<Implement \.{\\pdftrailer}@>;
+@y
+pdf_trailer_code: @<Implement \.{\\pdftrailer}@>;
+reset_timer_code: @<Implement \.{\\resettimer}@>;
+@z
+
+
+@x l.31776
+@ @<Implement \.{\\pdftrailer}@>=
+@y
+@ @<Set initial values of key variables@>=
+ seconds_and_micros(epochseconds,microseconds);
+
+@ @<Implement \.{\\resettimer}@>=
+begin
+ seconds_and_micros(epochseconds,microseconds);
+end
+
+@ @<Implement \.{\\pdftrailer}@>=
+@z
+
+@x l.33134
+last_node_type_code: print_esc("lastnodetype");
+@y
+last_node_type_code: print_esc("lastnodetype");
+elapsed_time_code: print_esc("elapsedtime");
+@z
+
+@x l.33124
+eTeX_version_code: cur_val:=eTeX_version;
+@y
+eTeX_version_code: cur_val:=eTeX_version;
+elapsed_time_code: cur_val:=get_microinterval;
+@z
+
diff --git a/Build/source/texk/web2c/pdfetexdir/pdfetex.ch1 b/Build/source/texk/web2c/pdfetexdir/pdfetex.ch1
new file mode 100644
index 00000000000..7e9db26eeb6
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/pdfetex.ch1
@@ -0,0 +1,82 @@
+%
+% Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdfetexdir/pdfetex.ch1#9 $
+%
+@x [1.2] l.188
+@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@#
+@d banner==eTeX_banner
+@y
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@z
+
+@x [17.230] l.4727 - first pdfTeX, then e-TeX additional token list parameters
+@d tex_toks=local_base+10 {end of \TeX's token list parameters}
+@y
+@d toks_base=local_base+10 {table of 256 token list registers}
+@z
+
+@x [17.236] l.4960 - first pdfTeX, then e-TeX additional integer parameters
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@y
+@d int_pars=55 {total number of integer parameters}
+@z
+
+@x [26.416] l.8400- first pdfTeX, then e-TeX additional command codes
+@d badness_code=input_line_no_code+1 {code for \.{\\badness}}
+@#
+@d eTeX_int=badness_code+1 {first of \eTeX\ codes for integers}
+@y
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@#
+@d eTeX_int=pdftex_last_item_codes+1 {first of \eTeX\ codes for integers}
+@z
+
+@x [26.424] l.8506
+if m>=input_line_no_code then
+@y
+if cur_chr>glue_val then
+@z
+
+@x [26.424] l.8507
+ input_line_no_code: cur_val:=line;
+ badness_code: cur_val:=last_badness;
+@y
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+@z
+
+@x [27.468] l.9207 - first e-TeX, then pdfTeX additional command codes
+@d job_name_code=etex_convert_codes {command code for \.{\\jobname}}
+@y
+@d job_name_code=5 {command code for \.{\\jobname}}
+@z
+
+@x [649]
+hpack:=r;
+@y
+exit: hpack:=r;
+@z
+
+@x [33.651] l.12936
+ kern_node: x:=x+width(p);
+@y
+ kern_node,math_node: x:=x+width(p);
+@z
diff --git a/Build/source/texk/web2c/pdfetexdir/pdfetex.ch2 b/Build/source/texk/web2c/pdfetexdir/pdfetex.ch2
new file mode 100644
index 00000000000..67ddf06edd9
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/pdfetex.ch2
@@ -0,0 +1,242 @@
+%
+% Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdfetexdir/pdfetex.ch2#20 $
+%
+@x limbo
+\def\pdfTeX{pdf\TeX}
+@y
+\def\pdfTeX{pdf\TeX}
+\def\pdfeTeX{pdf\eTeX}
+@z
+
+@x [2]
+@d pdfTeX_banner=='This is pdfTeX, Version 3.141592',pdftex_version_string
+@y
+@d pdfeTeX_banner=='This is pdfeTeX, Version 3.141592',pdftex_version_string,eTeX_version_string
+ {printed when \pdfeTeX\ starts}
+@#
+@d pdfTeX_banner=='This is pdfTeX, Version 3.141592',pdftex_version_string
+@z
+
+@x [2]
+@d banner==pdfTeX_banner
+@y
+@d banner==pdfeTeX_banner
+@z
+
+@x [230] -- first pdfTeX, then e-TeX additional token list parameters
+@d toks_base=pdf_toks {table of 256 token list registers}
+@#
+@d etex_toks_base=tex_toks {base for \eTeX's token list parameters}
+@y
+@d etex_toks_base=pdf_toks {base for \eTeX's token list parameters}
+@z
+
+@x [236] -- first pdfTeX, then e-TeX additional integer parameters
+@d int_pars=pdf_int_pars {total number of integer parameters}
+@#
+@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters}
+@y
+@d etex_int_base=pdf_int_pars {base for \eTeX's integer parameters}
+@z
+
+@x [424]
+ else begin case m of
+ begin case m of
+@y
+ else begin case m of
+@z
+
+@x [424]
+ end; {there are no other cases}
+@y
+@z
+
+@x [468] -- first e-TeX, then pdfTeX additional command codes
+@d pdftex_first_expand_code = 5 {base for \pdfTeX's command codes}
+@y
+@d pdftex_first_expand_code = etex_convert_codes {base for \pdfTeX's command codes}
+@z
+
+@x [32f]
+@!edge:scaled; {left edge of sub-box, or right edge of leader space}
+@y
+@!edge:scaled; {right edge of sub-box or leader space}
+@!prev_p:pointer; {one step behind |p|}
+@z
+
+@x [32f]
+base_line:=cur_v; left_edge:=cur_h;
+@y
+base_line:=cur_v;
+prev_p:=this_box+list_offset;
+@<Initialize |hlist_out| for mixed...@>;
+left_edge:=cur_h;
+@z
+
+@x [32f]
+decr(cur_s);
+@y
+@<Finish |hlist_out| for mixed...@>;
+decr(cur_s);
+@z
+
+@x [32f]
+ p:=link(p);
+@y
+ prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|}
+ p:=link(p);
+@z
+
+@x [32f]
+kern_node,math_node:cur_h:=cur_h+width(p);
+@y
+kern_node:cur_h:=cur_h+width(p);
+math_node: @<Handle a math node in |hlist_out|@>;
+@z
+
+@x [32f]
+othercases do_nothing
+@y
+@/@<Cases of |hlist_out| that arise in mixed direction text only@>@;
+othercases do_nothing
+@z
+
+@x [32f]
+next_p:p:=link(p);
+@y
+next_p:prev_p:=p; p:=link(p);
+@z
+
+@x [32f]
+ temp_ptr:=p; edge:=cur_h;
+@y
+ temp_ptr:=p; edge:=cur_h+width(p);
+ if cur_dir=right_to_left then cur_h:=edge;
+@z
+
+@x [32f]
+ cur_h:=edge+width(p); cur_v:=base_line;
+@y
+ cur_h:=edge; cur_v:=base_line;
+@z
+
+@x [32f]
+rule_wd:=rule_wd+cur_g;
+@y
+rule_wd:=rule_wd+cur_g;
+if eTeX_ex then @<Handle a glue node for mixed...@>;
+@z
+
+@x [32f]
+ edge:=cur_h+rule_wd; lx:=0;
+@y
+ if cur_dir=right_to_left then cur_h:=cur_h-10;
+ edge:=cur_h+rule_wd; lx:=0;
+@z
+
+@x [32f]
+ cur_h:=edge-10; goto next_p;
+@y
+ if cur_dir=right_to_left then cur_h:=edge
+ else cur_h:=edge-10;
+ goto next_p;
+@z
+
+@x [32f]
+save_h:=cur_h; temp_ptr:=leader_box;
+@y
+save_h:=cur_h; temp_ptr:=leader_box;
+if cur_dir=right_to_left then cur_h:=cur_h+leader_wd;
+@z
+
+@x [32f]
+ cur_h:=left_edge+shift_amount(p); {shift the box right}
+@y
+ if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p)
+ else cur_h:=left_edge+shift_amount(p); {shift the box right}
+@z
+
+@x [32f]
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+ pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+@y
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+ begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
+ pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+ cur_h:=left_edge;
+ end;
+@z
+
+@x [32f]
+begin cur_h:=left_edge+shift_amount(leader_box);@/
+@y
+begin if cur_dir=right_to_left then
+ cur_h:=left_edge-shift_amount(leader_box)
+ else cur_h:=left_edge+shift_amount(leader_box);
+@z
+
+@x [32f]
+@<(\pdfTeX) Ship box |p| out@>;
+@y
+@<(\pdfTeX) Ship box |p| out@>;
+if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>;
+@z
+
+@x
+pdf_print("/Producer (pdfTeX-");
+@y
+pdf_print("/Producer (pdfeTeX-");
+@z
+
+@x [649]
+exit: {|hpack|}
+@y
+@z
+
+@x [651]
+ math_node: x:=x+width(p);
+@y
+@z
+
+@x
+ obj_xform_resources(k) := null;
+ scan_int;
+ if box(cur_val) = null then
+ pdf_error("ext1", "\pdfxform cannot be used with a void box");
+ obj_xform_width(k) := width(box(cur_val));
+ obj_xform_height(k) := height(box(cur_val));
+ obj_xform_depth(k) := depth(box(cur_val));
+ obj_xform_box(k) := box(cur_val); {save pointer to the box}
+ box(cur_val) := null;
+ pdf_last_xform := k;
+@y
+ obj_xform_resources(k) := null;
+ scan_int;
+ fetch_box(p);
+ if p = null then
+ pdf_error("ext1", "\pdfxform cannot be used with a void box");
+ obj_xform_width(k) := width(p);
+ obj_xform_height(k) := height(p);
+ obj_xform_depth(k) := depth(p);
+ obj_xform_box(k) := p; {save pointer to the box}
+ change_box(null);
+ pdf_last_xform := k;
+@z
diff --git a/Build/source/texk/web2c/pdfetexdir/pdfetex.defines b/Build/source/texk/web2c/pdfetexdir/pdfetex.defines
new file mode 100644
index 00000000000..456f0b7ac60
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/pdfetex.defines
@@ -0,0 +1,105 @@
+{
+Copyright (c) 1996-2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdfetexdir/pdfetex.defines#13 $
+}
+
+{ pdftex.defines: additions for pdfTeX }
+
+{ macros from pdftex.h }
+@define function pdfcharmarked();
+@define function getlpcode();
+@define function getrpcode();
+@define function getefcode();
+@define function texbopenin();
+@define function vfbopenin ();
+@define procedure pdfmarkchar();
+@define procedure writepdf();
+
+{ functions from mapfile.c }
+@define function hasfmentry();
+@define function tfmoffm();
+@define procedure checkextfm();
+@define procedure pdfmapfile();
+@define procedure pdfmapline();
+@define procedure pdfinitmapfile();
+
+{ functions from utils.c }
+@define procedure escapehex();
+@define procedure escapename();
+@define procedure escapestring();
+@define function extxnoverd();
+@define procedure getcreationdate;
+@define procedure getfiledump();
+@define procedure getfilemoddate();
+@define procedure getfilesize();
+@define procedure getmatch();
+@define procedure getmd5sum();
+@define function getresnameprefix;
+@define procedure initstarttime;
+@define function isquotebad;
+@define function makecstring();
+@define procedure matchstrings();
+@define procedure libpdffinish;
+@define procedure makepdftexbanner;
+@define procedure printcreationdate;
+@define procedure printID();
+@define procedure setjobid();
+@define procedure unescapehex();
+@define procedure writestreamlength();
+
+
+{ functions from vfpacket.c }
+@define function newvfpacket();
+@define function packetbyte;
+@define procedure startpacket();
+@define procedure storepacket();
+
+{ functions from writefont.c }
+@define procedure dopdffont();
+
+{ functions from writeimg.c }
+@define function checkimageb();
+@define function checkimagec();
+@define function checkimagei();
+@define function epdforigx();
+@define function epdforigy();
+@define function imageheight();
+@define function imagepages();
+@define function imagecolordepth();
+@define function imagewidth();
+@define function imagexres();
+@define function imageyres();
+@define function ispdfimage();
+@define function readimage();
+@define procedure deleteimage();
+@define procedure updateimageprocset();
+@define procedure writeimage();
+
+{ functions from writet3.c }
+@define function getpkcharwidth();
+
+{ functions from writezip.c }
+@define procedure writezip();
+
+{ functions from avlstuff.c }
+@define procedure avlputobj();
+@define function avlfindobj();
+
+{ end of pdftex.defines }
diff --git a/Build/source/texk/web2c/pdfetexdir/pdfetex.h b/Build/source/texk/web2c/pdfetexdir/pdfetex.h
new file mode 100644
index 00000000000..3503b880dc8
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/pdfetex.h
@@ -0,0 +1,50 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdfetexdir/pdfetex.h#4 $
+*/
+
+/* Additions to texmfmp.h for pdfTeX */
+
+/* mark a char in font */
+#define pdfmarkchar(f, c) pdfcharused[f][c/8] |= (1<<(c%8))
+
+/* test whether a char in font is marked */
+#define pdfcharmarked(f, c) (boolean)(pdfcharused[f][c/8] & (1<<(c%8)))
+
+/* writepdf() always writes by fwrite() */
+#define writepdf(a, b) \
+ (void) fwrite ((char *) &pdfbuf[a], sizeof (pdfbuf[a]), \
+ (int) ((b) - (a) + 1), pdffile)
+
+#define getlpcode(f, c) \
+ (pdffontlpbase[f] == 0 ? 0 : pdfmem[pdffontlpbase[f] + c])
+
+#define getrpcode(f, c) \
+ (pdffontrpbase[f] == 0 ? 0 : pdfmem[pdffontrpbase[f] + c])
+
+#define getefcode(f, c) \
+ (pdffontefbase[f] == 0 ? 1000 : pdfmem[pdffontefbase[f] + c])
+
+#define texbopenin(f) \
+ open_input (&(f), kpse_tex_format, FOPEN_RBIN_MODE)
+#define vfbopenin(f) \
+ open_input (&(f), kpse_vf_format, FOPEN_RBIN_MODE)
+
+#include <pdftexdir/ptexlib.h>
diff --git a/Build/source/texk/web2c/pdfetexdir/pdfetex.mak b/Build/source/texk/web2c/pdfetexdir/pdfetex.mak
new file mode 100644
index 00000000000..c30864e2df0
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/pdfetex.mak
@@ -0,0 +1,164 @@
+################################################################################
+#
+# Makefile : pdfeTeX, web2c win32.mak makefile fragment to build pdfe-TeX
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/03/20 17:02:03 popineau>
+#
+################################################################################
+
+Makefile: $(srcdir)\pdfetexdir\pdfetex.mak
+
+# We build pdfetex
+pdfetex = $(objdir)\pdfetex.exe
+!ifdef TEX_DLL
+pdfetex = $(pdfetex) $(objdir)\$(library_prefix)pdfetex.dll
+!endif
+
+# The C sources.
+pdfetex_c = pdfetex.c
+pdfetex_o = $(objdir)\pdfetex.obj
+
+!ifdef TEX_DLL
+$(objdir)\$(library_prefix)pdfetex.exp: $(objdir)\$(library_prefix)pdfetex.lib
+
+$(objdir)\$(library_prefix)pdfetex.lib: $(pdfetex_o)
+ $(archive) /DEF $(pdfetex_o)
+
+$(objdir)\$(library_prefix)pdfetex.dll: $(pdfetex_o) $(objdir)\$(library_prefix)pdfetex.exp $(objdir)\pdfetex.res $(pdftexlibs) $(kpathsealib) $(proglib)
+ $(link_dll) $(**) $(socketlibs) $(conlibs)
+
+$(objdir)\pdfetex.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)pdfetex.lib $(proglib)
+ $(link) $(**) $(conlibs)
+!else
+$(objdir)\pdfetex.exe: $(pdfetex_o) $(objdir)\win32main.obj $(objdir)\pdfetex.res $(pdftexlibs) $(kpathsealib) $(proglib)
+ $(link) $(**) $(socketlibs) $(conlibs)
+!endif
+
+pdfetex: $(pdfetex)
+
+# C file dependencies.
+$(pdfetex_c) pdfetexcoerce.h pdfetexd.h: pdfetex.p $(web2c_texmf)
+ $(web2c) pdfetex
+
+# Tangling
+pdfetex.p pdfetex.pool: $(objdir)\tangle.exe pdfetex.web pdfetex.ch
+ .\$(objdir)\tangle pdfetex.web pdfetex.ch
+
+pdfetex_files = \
+ etexdir\etex.ch0 \
+ etexdir\etex.ch \
+ etexdir\etex.fix \
+ etexdir\etex.ch1 \
+ pdfetexdir\pdfetex.ch1 \
+ pdftexdir\pdftex.ch \
+ pdftexdir/hz.ch \
+ pdftexdir/misc.ch \
+ pdfetexdir\pdfetex.ch2
+
+pdfetex_changefiles = \
+ pdfetexdir\tex.ch0 \
+ tex.ch \
+ tex-supp-w32.ch \
+ etexdir\tex.ch1 \
+ etexdir\tex.ech \
+ etexdir\tex.ch2 \
+ pdfetexdir\tex.ch1 \
+ pdftexdir\tex.pch \
+ pdfetexdir\tex.ch2 \
+# pdfetexdir\tex.ch3
+
+# Generation of the web and ch files.
+pdfetex.web: $(objdir)\tie.exe tex.web $(pdfetex_files) \
+ pdfetexdir\pdfetex.h pdfetexdir\pdfetex.defines # pdfetexdir\pdfetex.mak
+ .\$(objdir)\tie -m pdfetex.web tex.web $(pdfetex_files)
+
+pdfetex.ch: $(objdir)\tie.exe pdfetex.web $(pdfetex_changefiles) # pdfetexdir/pdfetex.mak
+ .\$(objdir)\tie -c pdfetex.ch pdfetex.web $(pdfetex_changefiles)
+
+pdfetexdir\pdfetex.h: pdftexdir\pdftex.h
+ -@$(del) $(@) $(redir_stderr)
+ $(copy) $(**) $(@)
+
+pdfetexdir\pdfetex.defines: pdftexdir\pdftex.defines
+ -@$(del) $(@) $(redir_stderr)
+ $(copy) $(**) $(@)
+
+check: pdfetex-check
+pdfetex-check: pdfetex pdfetex.efmt
+
+clean:: pdfetex-clean
+pdfetex-clean:
+# $(LIBTOOL) --mode=clean $(RM) pdfetex
+ -@echo $(verbose) & ( \
+ for %%i in ($(pdfetex_o) $(pdfetex_c) pdfetexextra.c pdfetexcoerce.h \
+ pdfetexd.h pdfetex.p pdfetex.pool pdfetex.web pdfetex.ch \
+ pdfetex.efmt pdfetex.log) do $(del) %%i $(redir_stderr) \
+ )
+
+# Dumps
+# all_pdfefmts = pdfetex.efmt $(pdfefmts)
+# pdfefmts: $(all_pdfefmts)
+
+# pdfetex.efmt: $(pdfetex)
+# $(dumpenv) $(make) progname=pdfetex files="etex.src plain.tex cmr10.tfm" prereq-check
+# $(dumpenv) ./pdfetex --progname=pdfetex --jobname=pdfetex --ini "*\pdfoutput=1\input etex.src \dump" <nul
+#
+# pdfelatex.efmt: $(pdfetex)
+# $(dumpenv) $(make) progname=pdfelatex files="latex.ltx" prereq-check
+# $(dumpenv) ./pdfetex --progname=pdfelatex --jobname=pdfelatex --ini "*\pdfoutput=1\input latex.ltx" <nul
+#
+# pdflatex.efmt: $(pdfetex)
+# $(dumpenv) $(make) progname=pdflatex files="latex.ltx" prereq-check
+# $(dumpenv) ./pdfetex --progname=pdflatex --jobname=pdflatex --ini "*\pdfoutput=1\input latex.ltx" <nul
+
+#
+# Installation.
+install-pdfetex: install-pdfetex-exec install-pdfetex-data
+install-pdfetex-exec: install-pdfetex-links
+# install-pdfetex-data: install-pdfetex-dumps
+install-pdfetex-dumps: install-pdfetex-fmts
+
+# The actual binary executables and pool files.
+install-programs: install-pdfetex-programs
+install-pdfetex-programs: $(pdfetex) $(bindir)
+ -@echo $(verbose) & ( \
+ for %%p in ($(pdfetex)) do $(copy) %%p $(bindir) \
+ ) $(redir_stdout)
+
+# install-links: install-pdfetex-links
+install-pdfetex-links: install-pdfetex-programs
+# -@echo $(verbose) & ( \
+# pushd $(bindir) & \
+# $(del) .\pdfeinitex.exe .\pdfevirtex.exe & \
+# $(lnexe) .\pdfetex.exe $(bindir)\pdfeinitex.exe & \
+# $(lnexe) .\pdfetex.exe $(bindir)\pdfevirtex.exe & \
+# popd \
+# ) $(redir_stdout)
+ -@echo $(verbose) & ( \
+ if not "$(pdfefmts)"=="" \
+ for %%i in ($(pdfefmts)) do \
+ pushd $(bindir) & \
+ $(del) .\%%~ni.exe & \
+ $(lnexe) .\pdfetex.exe $(bindir)\%%~ni.exe & \
+ popd \
+ ) $(redir_stdout)
+
+# install-fmts: install-pdfetex-fmts
+install-pdfetex-fmts: pdfefmts $(fmtdir)
+ -@echo $(verbose) & ( \
+ for %%f in ($(all_pdfefmts)) \
+ do $(copy) %%f $(fmtdir)\%%f \
+ ) $(redir_stdout)
+
+# Auxiliary files.
+install-data:: install-pdfetex-data
+install-pdfetex-data: $(texpooldir)
+ @$(copy) pdfetex.pool $(texpooldir)\pdfetex.pool $(redir_stdout)
+
+# end of pdfetex.mak
+#
+# Local variables:
+# page-delimiter: "^# \f"
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/pdfetexdir/pdfetex.mk b/Build/source/texk/web2c/pdfetexdir/pdfetex.mk
new file mode 100644
index 00000000000..8cae918c365
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/pdfetex.mk
@@ -0,0 +1,133 @@
+# Makefile fragment for pdfeTeX and web2c. --infovore@xs4all.nl. Public domain.
+# This fragment contains the parts of the makefile that are most likely to
+# differ between releases of pdfeTeX.
+
+Makefile: $(srcdir)/pdfetexdir/pdfetex.mk
+
+# We build pdfetex
+pdfetex = @PETEX@ pdfetex
+pdfetexdir = pdfetexdir
+
+# The C sources.
+pdfetex_c = pdfetexini.c pdfetex0.c pdfetex1.c pdfetex2.c pdfetex3.c
+pdfetex_o = pdfetexini.o pdfetex0.o pdfetex1.o pdfetex2.o pdfetex3.o pdfetexextra.o
+
+# Making pdfetex
+pdfetex: pdftexd.h $(pdfetex_o) $(pdfetexextra_o) $(pdftexlibsdep)
+ @CXXHACKLINK@ $(pdfetex_o) $(pdfetexextra_o) $(pdftexlibs) $(socketlibs) @CXXHACKLDLIBS@ @CXXLDEXTRA@
+
+# C file dependencies.
+$(pdfetex_c) pdfetexcoerce.h pdfetexd.h: pdfetex.p $(web2c_texmf) $(srcdir)/pdfetexdir/pdfetex.defines
+ $(web2c) pdfetex
+pdfetexextra.c: pdfetexdir/pdfetexextra.h lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/pdfetex/ $(srcdir)/lib/texmfmp.c >$@
+pdfetexdir/pdfetexextra.h: pdfetexdir/pdfetexextra.in pdftexdir/pdftex.version etexdir/etex.version
+ sed -e s/PDFTEX-VERSION/`cat pdftexdir/pdftex.version`/ \
+ -e s/ETEX-VERSION/`cat etexdir/etex.version`/ \
+ $(srcdir)/pdfetexdir/pdfetexextra.in >$@
+
+# Tangling
+pdfetex.p pdfetex.pool: tangle pdfetex.web pdfetex.ch
+ $(TANGLE) pdfetex.web pdfetex.ch
+
+# Generation of the web and ch file.
+# Sources for pdfetex.web:
+pdfetex_web_srcs = $(srcdir)/tex.web \
+ $(srcdir)/etexdir/etex.ch \
+ $(srcdir)/etexdir/etex.fix \
+ $(srcdir)/pdfetexdir/pdfetex.ch1 \
+ $(srcdir)/pdftexdir/pdftex.ch \
+ $(srcdir)/pdftexdir/hz.ch \
+ $(srcdir)/pdftexdir/misc.ch \
+ $(srcdir)/pdftexdir/vadjust.ch \
+ $(srcdir)/pdftexdir/pdftex2.ch \
+ $(srcdir)/pdfetexdir/pdfetex.ch2
+# Sources for pdfetex.ch:
+pdfetex_ch_srcs = pdfetex.web \
+ $(srcdir)/pdfetexdir/tex.ch0 \
+ $(srcdir)/tex.ch \
+ $(srcdir)/etexdir/tex.ch1 \
+ $(srcdir)/etexdir/tex.ech \
+ $(srcdir)/pdfetexdir/tex.ch1 \
+ $(srcdir)/pdftexdir/tex.pch \
+ $(srcdir)/pdftexdir/noligatures.ch \
+ $(srcdir)/pdftexdir/pdfstrcmp.ch \
+ $(srcdir)/pdftexdir/randoms.ch
+# Rules:
+pdfetex.web: tie pdfetexdir/pdfetex.mk $(pdfetex_web_srcs)
+ $(TIE) -m pdfetex.web $(pdfetex_web_srcs)
+pdfetex.ch: $(pdfetex_ch_srcs)
+ $(TIE) -c pdfetex.ch $(pdfetex_ch_srcs)
+
+# for developing only
+pdfetex-org.web: $(pdfetex_ch_srcs_org)
+ $(TIE) -m $@ $(pdfetex_ch_srcs_org)
+pdfetex-all.web: pdfetex.web pdfetex.ch
+ $(TIE) -m $@ pdfetex.web pdfetex.ch
+
+$(srcdir)/pdfetexdir/pdfetex.h: $(srcdir)/pdftexdir/pdftex.h
+ cp -f $(srcdir)/pdftexdir/pdftex.h $@
+
+$(srcdir)/pdfetexdir/pdfetex.defines: $(srcdir)/pdftexdir/pdftex.defines
+ cp -f $(srcdir)/pdftexdir/pdftex.defines $@
+
+check: @PETEX@ pdfetex-check
+pdfetex-check: pdfetex pdfetex.fmt
+
+clean:: pdfetex-clean
+pdfetex-clean:
+ $(LIBTOOL) --mode=clean $(RM) pdfetex
+ rm -f $(pdfetex_o) $(pdfetex_c) pdfetexextra.c pdfetexcoerce.h
+ rm -f pdfetexdir/pdfetexextra.h
+ rm -f pdfetexd.h pdfetex.p pdfetex.pool pdfetex.web pdfetex.ch
+ rm -f pdfetex.fmt pdfetex.log
+
+# Dumps
+all_pdfefmts = @FMU@ pdfetex.fmt $(pdfefmts)
+
+dumps: @PETEX@ pdfefmts
+pdfefmts: $(all_pdfefmts)
+
+pdfefmtdir = $(web2cdir)/pdfetex
+$(pdfefmtdir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(pdfefmtdir)
+
+pdfetex.fmt: pdfetex
+ $(dumpenv) $(MAKE) progname=pdfetex files="etex.src plain.tex cmr10.tfm" prereq-check
+ $(dumpenv) ./pdfetex --progname=pdfetex --jobname=pdfetex --ini \*\\pdfoutput=1\\input etex.src \\dump </dev/null
+
+pdflatex.fmt: pdfetex
+ $(dumpenv) $(MAKE) progname=pdflatex files="latex.ltx" prereq-check
+ $(dumpenv) ./pdfetex --progname=pdflatex --jobname=pdflatex --ini \*\\pdfoutput=1\\input latex.ltx </dev/null
+
+#
+# Installation.
+install-pdfetex: install-pdfetex-exec install-pdfetex-data
+install-pdfetex-exec: install-pdfetex-links
+install-pdfetex-data: install-pdfetex-pool @FMU@ install-pdfetex-dumps
+install-pdfetex-dumps: install-pdfetex-fmts
+
+# The actual binary executables and pool files.
+install-programs: @PETEX@ install-pdfetex-programs
+install-pdfetex-programs: $(pdfetex) $(bindir)
+ for p in pdfetex; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+
+install-links: @PETEX@ install-pdfetex-links
+install-pdfetex-links: install-pdfetex-programs
+ #cd $(bindir) && (rm -f pdfeinitex pdfevirtex; \
+ # $(LN) pdfetex pdfeinitex; $(LN) pdfetex pdfevirtex)
+
+install-fmts: @PETEX@ install-pdfetex-fmts
+install-pdfetex-fmts: pdfefmts $(pdfefmtdir)
+ pdfefmts="$(all_pdfefmts)"; \
+ for f in $$pdfefmts; do $(INSTALL_DATA) $$f $(pdfefmtdir)/$$f; done
+ pdfefmts="$(pdfefmts)"; \
+ for f in $$pdfefmts; do base=`basename $$f .fmt`; \
+ (cd $(bindir) && (rm -f $$base; $(LN) pdfetex $$base)); done
+
+# Auxiliary files.
+install-data:: @PETEX@ install-pdfetex-data
+install-pdfetex-pool: pdfetex.pool $(texpooldir)
+ $(INSTALL_DATA) pdfetex.pool $(texpooldir)/pdfetex.pool
+
+# end of pdfetex.mk
diff --git a/Build/source/texk/web2c/pdfetexdir/pdfetexextra.in b/Build/source/texk/web2c/pdfetexdir/pdfetexextra.in
new file mode 100644
index 00000000000..3b602568de4
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/pdfetexextra.in
@@ -0,0 +1,41 @@
+/*
+Copyright (c) 1996-2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: pdfetexextra.in,v 1.4 2004/08/26 18:19:57 olaf Exp $
+*/
+
+/* pdfetexextra.in: banner etc. for pdfeTeX.
+
+ This is included by pdfeTeX, from ../pdfetexextra.c
+ (generated from ../lib/texmfmp.c).
+*/
+
+#define BANNER "This is pdfeTeX, Version 3.141592-PDFTEX-VERSION-ETEX-VERSION"
+#define COPYRIGHT_HOLDER "Peter Breitenlohner (eTeX)/Han The Thanh (pdfTeX)"
+#define AUTHOR NULL
+#define PROGRAM_HELP PDFETEXHELP
+#define BUG_ADDRESS "pdftex@tug.org"
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "pdfeinitex"
+#define VIR_PROGRAM "pdfevirtex"
+
diff --git a/Build/source/texk/web2c/pdfetexdir/tex.ch0 b/Build/source/texk/web2c/pdfetexdir/tex.ch0
new file mode 100644
index 00000000000..2dcb3746d6f
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/tex.ch0
@@ -0,0 +1,42 @@
+%
+% Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdfetexdir/tex.ch0#10 $
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one comes first, resolves inconsistencies between the generated
+% pdfetex.web and tex.ch
+
+@x [1.2] l.188
+@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@#
+@d banner==pdfeTeX_banner
+@y
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@z
+
+@x [17.236] l.4960 - first web2c, then pdfTeX, then e-TeX additional integer parameters
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@#
+@d pdftex_first_integer_code = tex_int_pars {base for \pdfTeX's integer parameters}
+@y
+@d int_pars=55 {total number of integer parameters}
+@#
+@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters}
+@z
diff --git a/Build/source/texk/web2c/pdfetexdir/tex.ch1 b/Build/source/texk/web2c/pdfetexdir/tex.ch1
new file mode 100644
index 00000000000..48f85ef8941
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/tex.ch1
@@ -0,0 +1,45 @@
+%
+% Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdfetexdir/tex.ch1#12 $
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one resolves inconsistencies between the etex changes for
+% web2c and pdftex changes for web2c.
+
+@x [1] m.2 l.188 - Web2C: extensions imply we're not pdfeTeX
+@d pdfeTeX_banner=='This is pdfeTeX, Version 3.141592',pdftex_version_string,eTeX_version_string
+@y
+@d pdfeTeX_banner_k=='This is pdfeTeXk, Version 3.141592',pdftex_version_string,eTeX_version_string
+@d pdfeTeX_banner=='This is pdfeTeX, Version 3.141592',pdftex_version_string,eTeX_version_string
+@z
+
+@x [1] m.2 l.188 - banner
+@d banner==eTeX_banner
+@d banner_k==eTeX_banner_k
+@y
+@d banner==pdfeTeX_banner
+@d banner_k==pdfeTeX_banner_k
+@z
+
+@x [17.236] l.4960 - first web2c, then pdfTeX, then e-TeX additional integer parameters
+@d etex_int_base=web2c_int_pars {base for \eTeX's integer parameters}
+@y
+@d pdftex_first_integer_code = web2c_int_pars {base for \pdfTeX's integer parameters}
+@z
diff --git a/Build/source/texk/web2c/pdfetexdir/tex.ch2 b/Build/source/texk/web2c/pdfetexdir/tex.ch2
new file mode 100644
index 00000000000..4f647d8c242
--- /dev/null
+++ b/Build/source/texk/web2c/pdfetexdir/tex.ch2
@@ -0,0 +1,21 @@
+%
+% Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdfetexdir/tex.ch2#8 $
+%
diff --git a/Build/source/texk/web2c/pdftex.rc b/Build/source/texk/web2c/pdftex.rc
new file mode 100644
index 00000000000..4b1df75adc1
--- /dev/null
+++ b/Build/source/texk/web2c/pdftex.rc
@@ -0,0 +1,41 @@
+/* pdftex.rc: pdftex resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " pdfTeX 3.14159-1.10a-2.1"
+
+#define VER_INTERNALNAME_STR TEXLIVE_LIBRARYPREFIX_STR "pdftex"
+#define VER_ORIGINALFILENAME_STR TEXLIVE_LIBRARYPREFIX_STR "pdftex.dll"
+
+#define VER_FILEDESCRIPTION_STR "pdfTeX DLL"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1996-2003\r\n\
+Han The Thanh (pdfTeX)\r\n\
+The TeX program is copyright (C) 1982 by D. E. Knuth."
+
+#define VER_LEGALTRADEMARKS_STR "TeX is a trademark of the American \
+Mathematical Society."
+
+#define VER_FILETYPE VFT_DLL
+
+#include <texlive.version>
+
+/* pdftex.rc ends here */
diff --git a/Build/source/texk/web2c/pdftexdir/ChangeLog b/Build/source/texk/web2c/pdftexdir/ChangeLog
new file mode 100644
index 00000000000..a0a770ed962
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/ChangeLog
@@ -0,0 +1,104 @@
+2004-10-29 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * pdftex.mk (pdftex): Build fix: pdftexextra.c depends on
+ pdftexextra.h.
+
+2004-09-07 The pdfTeX team:
+
+ * README: pdftex version 1.20a.
+
+ * NEWS: pdftex version 1.20a.
+
+ * pdftex.ch: pdftex version 1.20a.
+
+2004-08-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdftexlib.mk (pdftexdir/libpdf.a): Add pdftexdir/pdftexextra.h
+ to the dependencies, so it gets built before we go and try to
+ build the library.
+
+ * pdftex.version: Is from now on a generated file.
+
+ * pdftexextra.in: Renamed from pdftexextra.h; the current pdfTeX
+ version is substituted from pdftex.version. Variant of code
+ supplied by Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+ * pdftex.mk: Added rules to extract current pdfTeX version from
+ pdftex.ch and insert into pdftex.version and pdftexextra.h.
+ Variant of code supplied by Peter Breitenlohner
+ <peb@mppmu.mpg.de>.
+
+2004-08-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * vadjust.ch: Moved here from pdfxtexdir.
+
+ * pdftex.mk: vadjust.ch moved to this directory from pdfxtexdir.
+
+2004-08-23 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * pdftex.mk: Scrap rules for pdftexinfo. These are obsolete.
+
+ * pdftex.mak: Scrap rules for pdftexinfo.
+
+2004-08-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: The .cc.o suffix rule should use ALL_CXXFLAGS (as
+ is done for ALL_CFLAGS). From Jan Nieuwenhuizen
+ <janneke@gnu.org>.
+
+2004-07-29 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdftex.ch, hz.ch: Somewhat rearrange handling of kern and
+ math nodes in order to reduce interference between eTeX and
+ pdfTeX change files. Somewhat disentangle margin kerns such
+ that pdftex.web and pdfetex.web can be built with or without
+ hz.ch (not true for pdf*tex.ch).
+
+2004-07-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdftex.ch: Reorganize additional command codes for convert
+ and last_item in order to reduce interference between eTeX and
+ pdfTeX change files.
+
+ * change-files.txt: Adjust to current status.
+
+2004-07-23 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdftex.ch, tex.ch[01], tex.pch: Reorganize handling of banner
+ string in order to reduce interference between eTeX, pdfTeX,
+ and web2c change files.
+
+2004-07-22 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdftex.ch: Removed unused token types for pdfTeX's additional
+ token list parameters.
+
+2004-07-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * hz.ch, pdftex.ch, tex.ch[01], tex.pch: Reorganize handling of
+ additional token list and integer parameters in order to reduce
+ interference between eTeX, pdfTeX, and web2c change files.
+
+ * pdftex.ch: Add a note that this file not only defines pdftex.web
+ in terms of changes to be applies to tex.web, but in addition
+ is used to define pdfetex.web.
+
+ * tex.pch: Add a note that this file is used to construct the
+ web2c change files for both pdfTeX and pfdeTeX.
+
+ * pdftex.mk (pdftex.ch): Remove tex.ch2 from build rules.
+
+ * tex.ch2: Removed
+
+2004-07-17 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdftex.mk: Rewrite build rules for pdftex.{web,ch}.
+
+ * pdftex.ch: Adapt glue and leader box rounding to TeX 3.141592.
+ Remove a few modules that were identical copies of those in TeX.
+
+2004-07-16 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * ttf2afm.c: Add various const's, to avoid compiler warnings.
+
+ * ChangeLog: New file.
diff --git a/Build/source/texk/web2c/pdftexdir/Makefile.in b/Build/source/texk/web2c/pdftexdir/Makefile.in
new file mode 100644
index 00000000000..631e10c9861
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/Makefile.in
@@ -0,0 +1,60 @@
+# Makefile for libpdf - te@dbs.uni-hannover.de
+# $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/Makefile.in#23 $
+
+kpse_include ../make/common.mk
+kpse_include ../make/programs.mk
+kpse_include ../make/library.mk
+
+kpathsea_srcdir_parent = $(srcdir)/../..
+kpathsea_dir_parent = ../..
+
+ALL_CXXFLAGS = @CXXFLAGS@ @DEFS@ $(XXCFLAGS) -I. -I$(srcdir) -I$(kpathsea_dir_parent) -I$(kpathsea_srcdir_parent) @LIBXPDFCPPFLAGS@
+CXX = @CXX@
+
+.SUFFIXES: .cc .o
+.cc.o:
+ $(CXX) $(ALL_CXXFLAGS) -c $<
+
+# XCFLAGS=-Wstrict-prototypes -Wmissing-prototypes
+
+LIBPNGDIR=../../../libs/libpng
+LIBPNGSRCDIR=$(srcdir)/$(LIBPNGDIR)
+
+ZLIBDIR=../../../libs/zlib
+ZLIBSRCDIR=$(srcdir)/$(ZLIBDIR)
+
+LIBXPDFDIR=../../../libs/xpdf
+LIBXPDFSRCDIR=$(srcdir)/$(LIBXPDFDIR)
+
+LIBMD5DIR=../../../libs/md5
+LIBMD5SRCDIR=$(srcdir)/$(LIBMD5DIR)
+
+XCPPFLAGS=-I.. -I$(srcdir)/.. -I../.. -I$(srcdir)/../.. -I$(LIBMD5DIR) -I$(LIBMD5SRCDIR)\
+@LIBPNGCPPFLAGS@ @ZLIBCPPFLAGS@ -DpdfTeX
+
+
+OBJS = epdf.o mapfile.o utils.o vfpacket.o pkin.o \
+writefont.o writet1.o writet3.o writezip.o writeenc.o writettf.o \
+writejpg.o writepng.o writeimg.o pdftoepdf.o avl.o avlstuff.o
+
+all: libpdf.a
+
+pdftosrc.o: $(srcdir)/pdftosrc.cc
+
+libpdf.a: $(OBJS)
+ rm -f $@
+ $(AR) $(ARFLAGS) $@ $(OBJS)
+ $(RANLIB) $@
+
+kpse_include ../make/clean.mk
+
+clean::
+ rm -f libpdf.a ttf2afm pdftosrc
+
+depend:
+ rm -f $(OBJS) ttf2afm.o pdftosrc.o
+ XXCFLAGS=-MM XCFLAGS=-MM $(MAKE) -k $(OBJS) ttf2afm.o pdftosrc.o | \
+ grep -v "^$(CC)\|$(CXX)\|$(AR)\|make\|klibtool" | \
+ sed 's: [^ ]*/\.\./libs/[^ ]*::g' > $(srcdir)/depend.mk
+
+kpse_include pdftexdir/depend.mk
diff --git a/Build/source/texk/web2c/pdftexdir/NEWS b/Build/source/texk/web2c/pdftexdir/NEWS
new file mode 100644
index 00000000000..98e30db8b7f
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/NEWS
@@ -0,0 +1,400 @@
+-------------------------------------------------
+pdfTeX 3.141592-1.30.4 was released on 2005-10-17
+-------------------------------------------------
+- bugfix: whitespaces in filenames didn't work on Unix anymore (bug 377)
+- bugfix: two \immediates cancel themselves (bug 437)
+- bugfix: wrong file name in error messages of image inclusion (bug 435)
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.3 was released on 2005-09-04
+-------------------------------------------------
+- bugfix: \write18
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.2 was released on 2005-08-25
+-------------------------------------------------
+- fixed some build problems and minor bugs introduced in 1.30.1
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.1 was released on 2005-08-21
+-------------------------------------------------
+- the eTeX extensions can now be enabled with the cmdline switch -etex
+- pdfTeX uses xpdf 3.01
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.0 was released on 2005-08-01
+-------------------------------------------------
+- pdfxtex (introduced with 1.20a) is gone; all extensions are now in pdf(e)tex.
+- Some primitives have been renamed; the old names will still work, but are
+ deprecated and some give a warning that they are obsolete:
+ \pdfoptionpdfminorversion -> \pdfminorversion
+ \pdfoptionalwaysusepdfpagebox -> \pdfforcepagebox
+ \pdfoptionpdfinclusionerrorlevel -> \pdfinclusionerrorlevel
+- pdftex knows two new units:
+ - new Didot (1nd=0.375mm)
+ - new Cicero (1nc=12nd)
+- New primitives:
+ - Inclusion of pngs has been greatly improved: It now does
+ - alpha channel and transparency (only if %!PDF >=1.4)
+ - 16-bit colour (only if %!PDF >=1.5); this must be enabled by setting
+ \pdfimagehicolor to 1.
+ - gamma correction; this must be enabled by setting \pdfimageapplygamma to
+ 1. The device gamma is taken from \pdfgamma. If no embedded value can be
+ found in the png image, then the value of \pdfimagegamma is used instead.
+ - fast direct embedding of png streams, if their structure allows this; the
+ automatic fall-back is to decompress and re-compress as before.
+ - pdfTeX now has an interface to the precise system time (if available) as an
+ aid in benchmarking TeX macro code.
+ - \pdfelapsedtime is a read-only integer that (initially) returns the
+ amount of time passed since the start of this run. This amount is given
+ in `scaled seconds': the value 65536 counts as one second. If more time
+ has passed than 32767 seconds, (2^31)-1 will be returned.
+ - \pdfresettimer updates the internal timer, such that subsequent calls to
+ \pdfelapsedtime will restart from 0.
+ - pdfTeX can now generate random numbers:
+ - \pdfuniformdeviate <count> generates a uniformly distributed random
+ integer value between 0 (inclusive) and <count> (exclusive).
+ - \pdfnormaldeviate expands to a random integer value with a mean of 0 and
+ a unit of 65536.
+ - \pdfrandomseed allows access to the current seed value.
+ - \pdfsetrandomseed <count> sets the random seed to a specific value.
+ - \pdfnoligatures\f disables ligatures for the loaded font \f.
+ - Escaping strings:
+ - \pdfescapestring{<a>} escapes the string <a> so that it can be used as
+ PDF string.
+ - \pdfescapename{<a>} escapes the string <a> so that it can be used as PDF
+ name.
+ - \pdfescapehex{<a>} converts the string <a> to uppercase hexadecimal
+ representation.
+ - \pdfunescapehex{<b>} reverses the effect of \pdfescapehex
+ - \pdfcreationdate expands to the date string that pdfTeX uses in the info
+ dict as default.
+ - \pdffilemoddate{<file>} expands to the modification date of <file> in the
+ same format as \pdfcreationdate (PDF date format).
+ - \pdffilesize{<file>} expands to the size of <file> as string.
+ - \pdfmdfivesum{<abc>} or \pdfmdfivesum file {<file>} calculates the md5
+ sum (of a string or a file) and converts it to uppercase hexadecimal format
+ (same as \pdfescapehex).
+ - \pdffiledump [offset <int>] [length <int>] <general text>
+ Expands to a hex dump of the file given in <general text>, starting at
+ given offset or 0 with given length.
+ - \pdfshellescape is a read-only integer that is 1 if \write18 is enabled, 0
+ otherwise.
+ - \pdfxformname <object number>, which expands to the number in the
+ corresponding form XObject name.
+ - \leftmarginkern <box number> and \rightmarginkern <box number> tell the
+ margin kern at the left and right side of the horizontal list stored in box
+ <box number>.
+ - \pdfpkmode is a token register that sets the MF mode for pixel font
+ generation. The contents of this register is dumped into the format, so one
+ can (optionally) preset it e.g. in part of pdftexconfig.tex.
+ - \pdftracingfonts: An integer variable controlling the tracing of font
+ expansion. It is zero by default; then we get a log (with fontexpansion)
+ like this
+ ...\tenrm t
+ ...\tenrm (+20) e
+ Without font expansion, this default should be compatible with TeX's
+ original log output.
+ If \pdftracingfonts is set to 1 (or greater), we get a more verbose log:
+ ...\xivtt (cmtt10@14.0pt) t
+ ...\xivtt (cmtt10+20@14.0pt) e
+ See also bug 304.
+- New experimental primitives:
+ - \pdfmatch [icase] [subcount <number>}] {<pattern>}{<string>}
+ Implements pattern matching using the POSIX regex.
+ It returns the same values as \pdfstrcmp, but with the following semantics:
+ -1: error case (invalid pattern, ...)
+ 0: no match
+ 1: match found
+ Options:
+ * icase: case insensitive matching
+ * subcount: it sets the table size for found subpatterns.
+ A number "-1" resets the table size to the start default.
+ - \pdflastmatch <number>
+ The result of \pdfmatch is stored in an array. The entry "0" contains the
+ match, the following entries submatches. The positions of the matches are
+ also available. They are encoded:
+ <position> "->" <match string>
+ The position "-1" with an empty string indicates that this entry is not
+ set.
+ - \pdfstrcmp{<a>}{<b>} compares two strings and returns the strings "0" if
+ <a> equals <b>, "-1" if <a> is less than <b>, "1" if <a> is greater than
+ <b>
+- The primitive \pdfmovechars has been removed (bug 294)
+- Bugfixes:
+ - empty strings are not supressed anymore (bug 335)
+ - \unhboxing and character protusion didn't work well together (bug 292)
+ - --jobname didn't work if there was no filename at all (bug 302)
+ - Some problem with fonts on solaris (bug 315)
+ - Dangling font objects with non-replacable fonts (bug 311).
+ - \pdfxform didn't work with box>255 (bug 310)
+ - cmap: unicode ???? is mapped to multiple glyphs (bug 306).
+- pdfTeX uses zlib 1.2.3
+
+------------------------------------------------
+pdfTeX 3.141592-1.21a was released on 2005-02-04
+------------------------------------------------
+- ttf2afm 1.0:
+ - added support for refering to glyphs via unicode in encoding files (ie 'uniXXX')
+ - added some more info to the AFM output
+ - some minor bug fixes
+ - a short documentation available
+- pdftex now understand forms 'uniXXXX' in encoding files (only makes sense
+ with TrueType fonts)
+- added subset tag for TrueType fonts
+- PDF strings are now printed as following:
+ (This is a string) -> (This is a string)
+ This is a string -> (This is a string)
+ <a1b245c1a2...> -> <a1b245c1a2...>
+- check for double newline char to get rid of empty lines in PDF output
+- Fixed a bug in the scanning of map lines introduced in the fix of bug #242 in
+ 1.20b.
+- Fixed three problems in xpdf; xpdf is now 3.00pl3
+- \ifeof18 is a simple method to test if \write18 is enabled.
+- a few extensions in pdfxtex:
+ - \pdflastximagecolordepth returns the last color depth
+ - \pdfximage supports a keyword "colorspace" following an object number
+ representing a ColorSpace object
+ - \pdfstrcmp compares two strings
+ - \pdfescapestring/\pdflastescapedstring provide a way to escape string
+ - \pdffirstlineheight/\pdflastlinedepth/\pdfeachlineheight/\pdfeachlinedepth
+ allow fixing line dimen
+ - patches from Taco
+ - px dimen unit
+ - tagcode patch
+ - quitvmode patch
+
+------------------------------------------------
+pdfTeX 3.141592-1.20b was released on 2004-12-22
+------------------------------------------------
+- Fixed some minor bugs, mostly with hz
+- The info line "output format initialized to PDF/DVI" isn't shown anymore, as
+ this info wasn't reliable (bug 112).
+- Now the PDF-related statistics (PDF objects...) in the .log file is only
+ shown in PDF output mode. It start with a line "PDF statistics:".
+- \pdfimageresolution is not limited to 2400 [dpi] anymore, can now be between
+ 0 and 65535 [dpi].
+- pdfTeX uses xpdf 3.00pl2
+- pdfTeX uses libpng 1.2.8, which fixes some png-related bugs.
+
+------------------------------------------------
+pdfTeX 3.141592-1.20a was released on 2004-09-06
+------------------------------------------------
+- There is a new program pdfxtex, which contains experimental features which
+ might end up in pdftex in the future.
+- Most distributions now use eTeX as the default engine, so when you call
+ pdftex you will get pdfeTeX. Most distributions now also use pdfTeX as the
+ default engine, so when you call latex you will get pdfeTeX running LaTeX.:-)
+- We are setting up pdfTeX as a project at sarovar
+ (http://sarovar.org/projects/pdftex/). Please report bugs etc. through the
+ site.
+- Support for the file pdftex.cfg is gone completely. All parameters that had
+ previously been set by it can be set through primitives; their values are
+ dumped to the format file.
+- The searchpath for encoding and mapfiles has been changed.
+ See http://tug.org/pipermail/tex-live/2004-January/004734.html and
+ http://tug.org/pipermail/tex-live/2004-January/004791.html
+- eTeX is now version 2.2, incorporating the last changes to TeX (3.141592).
+- New options for \pdfmapfile:
+ General functionality: Map items (map files, new: also single map lines; see
+ \pdfmapline) are put in list of pending map items. During the next shipout,
+ pending map items are sequentially scanned for their map entries, and an
+ internal map entry database is updated, using the modes below. Then the list
+ of pending map items is cleared. Map entries of fonts already in use are left
+ untouched. New: All \pdfmapfile and \pdfmapline commands can also be given
+ after shipout of the first page.
+ - \pdfmapfile {foo.map} clears the list of pending map items and starts a new
+ list with the only pending file foo.map. When the map entry lines of
+ foo.map are scanned, duplicate map entries are ignored and a warning is
+ issued. This is the old behaviour.
+ - \pdfmapfile {+foo.map} puts foo.map in the list of pending map items. When
+ the map entry lines of foo.map are scanned, duplicate map entries are
+ ignored and a warning is issued.
+ - \pdfmapfile {=foo.map} puts foo.map in the list of pending map items. When
+ foo.map is scanned, matching map entries in database are replaced by new
+ entries from foo.map.
+ - \pdfmapfile {-foo.map} puts foo.map in the list of pending map items. When
+ foo.map is scanned, matching map entries are deleted from database.
+ - \pdfmapfile {} clears the list of pending map items. It does not affect map
+ entries already registered into the database. This is the old behaviour.
+- New command \pdfmapline {line}. It's like \pdfmapfile but here you can set
+ single map lines like in the map files directly. The modifiers (+-=) have the
+ same effect as with \pdfmapfile.
+- Simplified the handling of the 14 Type 1 "standard fonts" (Times,
+ Helvetica...): They are now more or less handled like any other Type 1 font.
+ See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000648.html
+- hz: So far the font expansion feature required that the user must be able to
+ create expanded tfms (eg cmr10+10.tfm). Now font expansion can be used
+ without creating these tfms.
+ See http://www.ntg.nl/pipermail/ntg-pdftex/2004-May/000504.html
+- hz: Changed \pdffontexpand primitive --> the expand factor is now fixed to
+ 1000 and the argument is ignored. This will lead to spurious texts of "1000"
+ in your output if you compile old documents.
+- New command \pdftexbanner which returns a string with the full banner of the
+ current binary (e.g. "This is pdfTeX, Version 3.141592-1.20a (Web2C 7.5.3)
+ kpathsea version 3.5.3")
+- The PTEX.FullBanner key is now inserted in the document info dict instead of
+ the catalog. Newer versions of Acrobat display it.
+- Now includes support for encTeX.
+- Extended \pdfannot to use reserveobjnum/useobjnum
+ See http://www.ntg.nl/pipermail/ntg-pdftex/2004-March/000424.html
+- Bugfix: pdfTeX would read an .xpdfrc when including pdfs.
+ See http://tug.org/pipermail/pdftex/2004-March/004835.html
+- Bugfix: The strings in /ID would sometimes be empty.
+- Bugfix: Even when mapfiles or encodings or PostScript font files were
+ missing, pdfTeX still produced a (most often corrupt) pdf. Now it aborts with
+ an error in these cases.
+- numerous small bugfixes.
+- pdfTeX now uses the GNU libavl from Ben Pfaff for managing of fontmap
+ entries.
+- pdfTeX uses zlib 1.2.1
+- pdfTeX uses xpdf 3.00
+- pdfTeX uses libpng 1.2.7
+
+------------------------------------------------
+pdfTeX 3.141592-1.11b was released on 2003-10-06
+------------------------------------------------
+- Bugfix: The handling of /Rotate produced displaced images when /Rotate was 90
+ or 270.
+
+------------------------------------------------
+pdfTeX 3.141592-1.11a was released on 2003-08-02
+------------------------------------------------
+- New command \pdftrailer analogue to \pdfcatalog whose argument ends up in the
+ trailer dictionary.
+- The behaviour when an included pdf has a newer version than the one specified
+ with \pdfoptionpdfminorversion can be controlled by the new internal integer
+ \pdfoptionpdfinclusionerrorlevel: If it's 0, pdfTeX gives only a warning; if
+ it's 1, it raises an error.
+ This can also be set in pdftex.cfg with pdf_inclusion_errorlevel
+- The syntax for outlines has been extended to allow attributes:
+ <outline spec> --> <attr spec> <action spec> [count <number>] <general text>
+ See http://www.ntg.nl/pipermail/ntg-pdftex/2003-June/000165.html
+- The syntax of \pdfobj has been extended:
+ \pdfobj <object type spec> (h, v, m)
+ <object type spec> --> reserveobjnum
+ | [useobjnum <number>] [<attr spec>] [stream [<attr spec>]] <object contents>
+ <object contents> --> <file spec>
+ | <general text>
+ When the optional keyword `reserveobjnum' and `useobjnum' is not given, the
+ behaviour is unchanged.
+ See also http://tug.org/mailman/htdig/pdftex/2003-March/003814.html
+- Bugfix: /CreationDate didn't care for the timezone and could be fooled.
+ See http://www.ntg.nl/pipermail/ntg-pdftex/2003-July/000223.html
+- Bugfix: The translation of 8-bit characters in included pdfs that had their
+ eighth bit set sometimes got wrong because of a missing typecast.
+ See http://www.ntg.nl/pipermail/ntg-pdftex/2003-July/000216.html
+- Bugfix: pdfTeX -ini would crash with a minimal file because it didn't read
+ it's config and so didn't know anything about fonts.
+ See http://tug.org/pipermail/pdftex/2003-July/004262.html
+- Bugfix: \pdfstartlink would produce spurious /NewWindow entries. Also the
+ syntax of <action spec> and <goto-action spec> has been cleaned up.
+ See http://www.ntg.nl/pipermail/ntg-pdftex/2003-June/000167.html
+- Bugfix: \pdffontattr was not used for T3 fonts.
+ See http://tug.org/pipermail/pdftex/2003-June/004127.html
+- Bugfix: The cropbox of an included pdf would sometimes not be used.
+ See http://tug.org/pipermail/pdftex/2003-May/004037.html
+- pdfTeX uses xpdf 2.02
+
+------------------------------------------------
+pdfTeX 3.141592-1.10b was released on 2003-02-26
+------------------------------------------------
+- The numbers in transformation matrices are allways written with maximum
+ precision (see http://tug.org/pipermail/pdftex/2003-February/003596.html).
+- Incorporated the new version of TeX: 3.141592
+- Bugfix: Numbers in pdfs would sometimes be just a wee bit of (changed
+ implementation of pdftoepdf.convertNumToPDF).
+- Bugfix: When setting the /Producer, /Creator or /CreationDate keys with
+ /pdfinfo pdfTeX would also insert default values which caused duplicate keys
+ in the info dict (see
+ http://tug.org/pipermail/pdftex/2003-February/003524.html).
+- The reading of mapfiles is much faster (see
+ http://tug.org/pipermail/pdftex/2002-July/002843.html).
+- Bugfix: AR5 had problems with the CTM when displaying in "fit visible" mode
+ (see http://tug.org/pipermail/pdftex/2002-May/002688.html).
+- Bugfix: str_in_str had wrong indices (see
+ http://tug.org/pipermail/pdftex/2002-March/002367.html).
+- Bugfix: decimal_digits defaulted to 0, which caused problems with included
+ images when including pdfs (see
+ http://tug.org/pipermail/pdftex/2003-February/003518.html).
+ It now defaults to 4.
+- Bugfix: the type of included images was decided based only on the extensions;
+ now pdfTeX looks for magic bytes at the start of files (see
+ http://tug.org/pipermail/pdftex/2003-February/003519.html)
+
+-----------------------------------------------
+pdfTeX 3.14159-1.10a was released on 2003-01-16
+-----------------------------------------------
+- pdfTeX is now able to produce pdf1.4 (which is also the default) and has
+ almost complete support for including pdf1.4 files:
+ - Additional attributes like MetaData are copied from included pdfs.
+ - Currently the Page Group attribute (see sections 7.3.6 and 7.5.5 of the pdf
+ 1.4 reference) of included pdfs is NOT copied (as we don't know how to
+ handle this when imposing pdfs).
+ This means including pdfs with transparency features will work as long as
+ the included pdf doesn't use Page Groups; if it does, the result might not
+ be what is expected (One application known to use Page Groups is Adobe
+ Illustrator v9++). The distributed pdfTeX binaries will give a warning
+ about any occurance of a Page Group in an included pdf and ignore the Page
+ Group (thus producing syntactically correct pdfs but probably not the
+ intended output).
+ Acrobat 5++ and newer versions of Jaws display files without Page Groups
+ correctly, so this might not really be a problem.
+ See pdftoepdf.cc for preprocessor flags which allow this behaviour to be
+ changed (copying the Page Group (most likely producing incorrect pdf) or
+ treating Page Groups as errors).
+- The new primitive \pdfoptionpdfminorversion sets the pdf version of the
+ generated file and the latest allowed pdf version of included pdfs:
+ \pdfoptionpdfminorversion=3
+ tells pdfTeX to set the pdf version to 1.3 and allows only included pdfs with
+ versions <= 1.3 .
+ The default for \pdfoptionpdfminorversion is 4 for pdf 1.4
+ This must appear before any data is written to the generated pdf file, so
+ you should put it at the very start of your files.
+ This can also be set in pdftex.cfg with pdf_minorversion
+- It is now possible to specify the pdf page box to use when including pdfs.
+ The syntax has been extended:
+ \pdfximage [<image attr spec>] <general text> (h, v, m)
+ <image attr spec> --> [<rule spec>] [<attr spec>] [<page spec>] [<pdf box spec>]
+ <pdf box spec> --> mediabox|cropbox|bleedbox|trimbox|artbox
+ The default is cropbox (which defaults to mediabox), to be compatible with
+ previous versions of pdfTeX.
+ The page box specified at \pdfximage can be globally overridden with the
+ config parameter always_use_pdfpagebox and the command
+ \pdfoptionalwaysusepdfpagebox <integer>, where 0 is the default (use whatever
+ is specified with \pdfximage), 1 is media, 2 is crop, 3 is bleed, 4 is trim
+ and 5 is artbox. This can only be set once per object, i.e. the value used at
+ \pdfximage is remembered.
+ See the pdf reference for an explanation of the boxes.
+- The support for the inclusion of jpeg images has been extended to allow the
+ inclusion of JPEG/Exif files which are produced by digital photo cameras
+ (thanks to Hartmut Henkel).
+- The support for the inclusion of tif images has been removed as it was of
+ limited use (it worked only for gray-scale and rgb images) and produced wrong
+ results (all other images types where treated as rgb images).
+ Tif images can be converted on *nix on-the-fly to pngs with the help of
+ ImageMagick, epstopdf.sty or pdftex.def v0.4 or newer, and this rule:
+ \DeclareGraphicsRule{.tif}{png}{.png}{`convert #1 `basename #1 .tif`.png}
+- The extensions for pdf encryption have been removed, since they make the
+ pdfTeX code overly complex. Those needing pdf encryption are encouraged to
+ produce a standalone program for encrypting pdfs.
+- pdfTeX now writes a usage statistic about the pdfTeX specific memory to the
+ log.
+- numerous bugfixes, most of them in the inclusion of pdfs.
+- pdfTeX uses xpdf 2.01
+- pdfTeX uses libpng 1.2.5
+
+---------------------------------------------------------------------
+pdfTeX 3.14159-1.00a-pretest-20011127-ojmw was released on 2002-01-29
+---------------------------------------------------------------------
+
+----------------------------------------------------------------
+pdfTeX 3.14159-1.00a-pretest-20010806 was released on 2001-08-06
+----------------------------------------------------------------
+
+----------------------------------------------------------------
+pdfTeX 3.14159-1.00a-pretest-20010804 was released on 2001-08-04
+----------------------------------------------------------------
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/NEWS#88 $
+// vim: tw=79:ts=2:expandtab:autoindent
diff --git a/Build/source/texk/web2c/pdftexdir/README b/Build/source/texk/web2c/pdftexdir/README
new file mode 100644
index 00000000000..c56f359cbbe
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/README
@@ -0,0 +1,90 @@
+pdfTeX
+======
+
+README for version 3.14159-1.30.4 of $Date: 2005/10/17 $
+========================================================
+
+This directory contains the version 1.30.4 of pdfTeX, an extended version of
+TeX that can create PDF directly from TeX source files and enhance the
+result of TeX typesetting with the help of PDF. When PDF output is not
+selected, pdfTeX produces normal DVI output, otherwise it produces PDF
+output that looks identical to the DVI output. An important aspect of this
+project is to investigate alternative justification algorithms, optionally
+making use of multiple master fonts.
+
+pdfeTeX is an even more extended version of TeX than pdfTeX because it is
+not based on TeX but on eTeX, an extended version of TeX.
+
+pdfTeX is based on the original TeX sources and Web2c, and has been
+successfully compiled on Unix, Win32 and DOS systems. It is still under
+development and features may change; it produces reasonable PDF code.
+
+See the file NEWS for changes to the program.
+
+Documentation about pdfTeX can be found at http://www.pdftex.org
+
+There is also a mailing list on pdfTeX; go to
+http://tug.org/mailman/listinfo/pdftex for more information about it. Its
+searchable archive can be found at http://tug.org/pipermail/pdftex/
+Please read http://www.catb.org/~esr/faqs/smart-questions.html before
+asking any questions on the pdfTeX mailing list.
+
+A mailing list for the developement of pdfTeX can be found at
+http://www.ntg.nl/mailman/listinfo/ntg-pdftex
+
+
+LEGAL ISSUES
+============
+
+pdfTeX is copyright (c) 1996-2005 Han The Thanh, <thanh@pdftex.org>
+
+pdfTeX is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation; either version 2 of the License, or (at your option) any later
+version.
+
+pdfTeX is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+details.
+
+You should have received a copy of the GNU General Public License along
+with pdfTeX; if not, write to the Free Software Foundation, Inc., 59 Temple
+Place, Suite 330, Boston, MA 02111-1307 USA
+
+pdfTeX uses code from TeX; for these parts the original copyright by Don
+Knuth applies. See the source files for details.
+
+pdfeTeX uses code from eTeX; for these parts the original copyright by
+Peter Breitenlohner applies. See the source files for details.
+
+
+WHAT TO DO IF YOU BELIEVE YOU HAVE FOUND A BUG IN pdfTeX
+========================================================
+
+Please read http://www.chiark.greenend.org.uk/~sgtatham/bugs.html and
+follow the guidelines there. Then go to the sarovar site of pdfTeX
+(http://sarovar.org/projects/pdftex/) and submit your bug report there.
+Here you can also report feature requests or patches.
+
+
+CONTRIBUTORS
+============
+
+Peter Breitenlohner, Ricardo Sanchez Carmenes, Otfried Cheong, Thomas
+Esser, Hans Hagen, Hartmut Henkel, Taco Hoekwater, Pawel Jackowski, Tom
+Kacvinsky, Akira Kakuto, Reinhard Kotucha, Derek B. Noonburg, Heiko
+Oberdiek, Jiri Osoba, Fabrice Popineau, Sebastian Rahtz, Tomas Rokicki,
+Martin Schröder, Petr Sojka, Olaf Weber, Jiri Zlatuska.
+
+pdfTeX is built on top of TeX, written by Donald Knuth cum suis (Liang and
+so), and eTeX, written by Peter Breitenlohner cum suis; part of the
+paragraph optimization is inspired by the work of Hermann Zapf.
+
+
+------------------------------------------------------------------------------
+
+Please send bug reports, offers of help, etc. to martin@pdftex.org
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/README#33 $
+// vim: tw=75
diff --git a/Build/source/texk/web2c/pdftexdir/avl.c b/Build/source/texk/web2c/pdftexdir/avl.c
new file mode 100644
index 00000000000..7b6bc17eac0
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/avl.c
@@ -0,0 +1,890 @@
+/* Produced by texiweb from libavl.w on 2003/01/06 at 18:07. */
+
+/* libavl - library for manipulation of binary trees.
+ Copyright (C) 1998-2002 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+ See the GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA.
+
+ The author may be contacted at <blp@gnu.org> on the Internet, or
+ write to Ben Pfaff, Stanford University, Computer Science Dept., 353
+ Serra Mall, Stanford CA 94305, USA.
+*/
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "avl.h"
+
+/* Creates and returns a new table
+ with comparison function |compare| using parameter |param|
+ and memory allocator |allocator|.
+ Returns |NULL| if memory allocation failed. */
+struct avl_table *
+avl_create (avl_comparison_func *compare, void *param,
+ struct libavl_allocator *allocator)
+{
+ struct avl_table *tree;
+
+ assert (compare != NULL);
+
+ if (allocator == NULL)
+ allocator = &avl_allocator_default;
+
+ tree = allocator->libavl_malloc (allocator, sizeof *tree);
+ if (tree == NULL)
+ return NULL;
+
+ tree->avl_root = NULL;
+ tree->avl_compare = compare;
+ tree->avl_param = param;
+ tree->avl_alloc = allocator;
+ tree->avl_count = 0;
+ tree->avl_generation = 0;
+
+ return tree;
+}
+
+/* Search |tree| for an item matching |item|, and return it if found.
+ Otherwise return |NULL|. */
+void *
+avl_find (const struct avl_table *tree, const void *item)
+{
+ const struct avl_node *p;
+
+ assert (tree != NULL && item != NULL);
+ for (p = tree->avl_root; p != NULL; )
+ {
+ int cmp = tree->avl_compare (item, p->avl_data, tree->avl_param);
+
+ if (cmp < 0)
+ p = p->avl_link[0];
+ else if (cmp > 0)
+ p = p->avl_link[1];
+ else /* |cmp == 0| */
+ return p->avl_data;
+ }
+
+ return NULL;
+}
+
+/* Inserts |item| into |tree| and returns a pointer to |item|'s address.
+ If a duplicate item is found in the tree,
+ returns a pointer to the duplicate without inserting |item|.
+ Returns |NULL| in case of memory allocation failure. */
+void **
+avl_probe (struct avl_table *tree, void *item)
+{
+ struct avl_node *y, *z; /* Top node to update balance factor, and parent. */
+ struct avl_node *p, *q; /* Iterator, and parent. */
+ struct avl_node *n; /* Newly inserted node. */
+ struct avl_node *w; /* New root of rebalanced subtree. */
+ int dir; /* Direction to descend. */
+
+ unsigned char da[AVL_MAX_HEIGHT]; /* Cached comparison results. */
+ int k = 0; /* Number of cached results. */
+
+ assert (tree != NULL && item != NULL);
+
+ z = (struct avl_node *) &tree->avl_root;
+ y = tree->avl_root;
+ dir = 0;
+ for (q = z, p = y; p != NULL; q = p, p = p->avl_link[dir])
+ {
+ int cmp = tree->avl_compare (item, p->avl_data, tree->avl_param);
+ if (cmp == 0)
+ return &p->avl_data;
+
+ if (p->avl_balance != 0)
+ z = q, y = p, k = 0;
+ da[k++] = dir = cmp > 0;
+ }
+
+ n = q->avl_link[dir] =
+ tree->avl_alloc->libavl_malloc (tree->avl_alloc, sizeof *n);
+ if (n == NULL)
+ return NULL;
+
+ tree->avl_count++;
+ n->avl_data = item;
+ n->avl_link[0] = n->avl_link[1] = NULL;
+ n->avl_balance = 0;
+ if (y == NULL)
+ return &n->avl_data;
+
+ for (p = y, k = 0; p != n; p = p->avl_link[da[k]], k++)
+ if (da[k] == 0)
+ p->avl_balance--;
+ else
+ p->avl_balance++;
+
+ if (y->avl_balance == -2)
+ {
+ struct avl_node *x = y->avl_link[0];
+ if (x->avl_balance == -1)
+ {
+ w = x;
+ y->avl_link[0] = x->avl_link[1];
+ x->avl_link[1] = y;
+ x->avl_balance = y->avl_balance = 0;
+ }
+ else
+ {
+ assert (x->avl_balance == +1);
+ w = x->avl_link[1];
+ x->avl_link[1] = w->avl_link[0];
+ w->avl_link[0] = x;
+ y->avl_link[0] = w->avl_link[1];
+ w->avl_link[1] = y;
+ if (w->avl_balance == -1)
+ x->avl_balance = 0, y->avl_balance = +1;
+ else if (w->avl_balance == 0)
+ x->avl_balance = y->avl_balance = 0;
+ else /* |w->avl_balance == +1| */
+ x->avl_balance = -1, y->avl_balance = 0;
+ w->avl_balance = 0;
+ }
+ }
+ else if (y->avl_balance == +2)
+ {
+ struct avl_node *x = y->avl_link[1];
+ if (x->avl_balance == +1)
+ {
+ w = x;
+ y->avl_link[1] = x->avl_link[0];
+ x->avl_link[0] = y;
+ x->avl_balance = y->avl_balance = 0;
+ }
+ else
+ {
+ assert (x->avl_balance == -1);
+ w = x->avl_link[0];
+ x->avl_link[0] = w->avl_link[1];
+ w->avl_link[1] = x;
+ y->avl_link[1] = w->avl_link[0];
+ w->avl_link[0] = y;
+ if (w->avl_balance == +1)
+ x->avl_balance = 0, y->avl_balance = -1;
+ else if (w->avl_balance == 0)
+ x->avl_balance = y->avl_balance = 0;
+ else /* |w->avl_balance == -1| */
+ x->avl_balance = +1, y->avl_balance = 0;
+ w->avl_balance = 0;
+ }
+ }
+ else
+ return &n->avl_data;
+ z->avl_link[y != z->avl_link[0]] = w;
+
+ tree->avl_generation++;
+ return &n->avl_data;
+}
+
+/* Inserts |item| into |table|.
+ Returns |NULL| if |item| was successfully inserted
+ or if a memory allocation error occurred.
+ Otherwise, returns the duplicate item. */
+void *
+avl_insert (struct avl_table *table, void *item)
+{
+ void **p = avl_probe (table, item);
+ return p == NULL || *p == item ? NULL : *p;
+}
+
+/* Inserts |item| into |table|, replacing any duplicate item.
+ Returns |NULL| if |item| was inserted without replacing a duplicate,
+ or if a memory allocation error occurred.
+ Otherwise, returns the item that was replaced. */
+void *
+avl_replace (struct avl_table *table, void *item)
+{
+ void **p = avl_probe (table, item);
+ if (p == NULL || *p == item)
+ return NULL;
+ else
+ {
+ void *r = *p;
+ *p = item;
+ return r;
+ }
+}
+
+/* Deletes from |tree| and returns an item matching |item|.
+ Returns a null pointer if no matching item found. */
+void *
+avl_delete (struct avl_table *tree, const void *item)
+{
+ /* Stack of nodes. */
+ struct avl_node *pa[AVL_MAX_HEIGHT]; /* Nodes. */
+ unsigned char da[AVL_MAX_HEIGHT]; /* |avl_link[]| indexes. */
+ int k; /* Stack pointer. */
+
+ struct avl_node *p; /* Traverses tree to find node to delete. */
+ int cmp; /* Result of comparison between |item| and |p|. */
+
+ assert (tree != NULL && item != NULL);
+
+ k = 0;
+ p = (struct avl_node *) &tree->avl_root;
+ for (cmp = -1; cmp != 0;
+ cmp = tree->avl_compare (item, p->avl_data, tree->avl_param))
+ {
+ int dir = cmp > 0;
+
+ pa[k] = p;
+ da[k++] = dir;
+
+ p = p->avl_link[dir];
+ if (p == NULL)
+ return NULL;
+ }
+ item = p->avl_data;
+
+ if (p->avl_link[1] == NULL)
+ pa[k - 1]->avl_link[da[k - 1]] = p->avl_link[0];
+ else
+ {
+ struct avl_node *r = p->avl_link[1];
+ if (r->avl_link[0] == NULL)
+ {
+ r->avl_link[0] = p->avl_link[0];
+ r->avl_balance = p->avl_balance;
+ pa[k - 1]->avl_link[da[k - 1]] = r;
+ da[k] = 1;
+ pa[k++] = r;
+ }
+ else
+ {
+ struct avl_node *s;
+ int j = k++;
+
+ for (;;)
+ {
+ da[k] = 0;
+ pa[k++] = r;
+ s = r->avl_link[0];
+ if (s->avl_link[0] == NULL)
+ break;
+
+ r = s;
+ }
+
+ s->avl_link[0] = p->avl_link[0];
+ r->avl_link[0] = s->avl_link[1];
+ s->avl_link[1] = p->avl_link[1];
+ s->avl_balance = p->avl_balance;
+
+ pa[j - 1]->avl_link[da[j - 1]] = s;
+ da[j] = 1;
+ pa[j] = s;
+ }
+ }
+
+ tree->avl_alloc->libavl_free (tree->avl_alloc, p);
+
+ assert (k > 0);
+ while (--k > 0)
+ {
+ struct avl_node *y = pa[k];
+
+ if (da[k] == 0)
+ {
+ y->avl_balance++;
+ if (y->avl_balance == +1)
+ break;
+ else if (y->avl_balance == +2)
+ {
+ struct avl_node *x = y->avl_link[1];
+ if (x->avl_balance == -1)
+ {
+ struct avl_node *w;
+ assert (x->avl_balance == -1);
+ w = x->avl_link[0];
+ x->avl_link[0] = w->avl_link[1];
+ w->avl_link[1] = x;
+ y->avl_link[1] = w->avl_link[0];
+ w->avl_link[0] = y;
+ if (w->avl_balance == +1)
+ x->avl_balance = 0, y->avl_balance = -1;
+ else if (w->avl_balance == 0)
+ x->avl_balance = y->avl_balance = 0;
+ else /* |w->avl_balance == -1| */
+ x->avl_balance = +1, y->avl_balance = 0;
+ w->avl_balance = 0;
+ pa[k - 1]->avl_link[da[k - 1]] = w;
+ }
+ else
+ {
+ y->avl_link[1] = x->avl_link[0];
+ x->avl_link[0] = y;
+ pa[k - 1]->avl_link[da[k - 1]] = x;
+ if (x->avl_balance == 0)
+ {
+ x->avl_balance = -1;
+ y->avl_balance = +1;
+ break;
+ }
+ else
+ x->avl_balance = y->avl_balance = 0;
+ }
+ }
+ }
+ else
+ {
+ y->avl_balance--;
+ if (y->avl_balance == -1)
+ break;
+ else if (y->avl_balance == -2)
+ {
+ struct avl_node *x = y->avl_link[0];
+ if (x->avl_balance == +1)
+ {
+ struct avl_node *w;
+ assert (x->avl_balance == +1);
+ w = x->avl_link[1];
+ x->avl_link[1] = w->avl_link[0];
+ w->avl_link[0] = x;
+ y->avl_link[0] = w->avl_link[1];
+ w->avl_link[1] = y;
+ if (w->avl_balance == -1)
+ x->avl_balance = 0, y->avl_balance = +1;
+ else if (w->avl_balance == 0)
+ x->avl_balance = y->avl_balance = 0;
+ else /* |w->avl_balance == +1| */
+ x->avl_balance = -1, y->avl_balance = 0;
+ w->avl_balance = 0;
+ pa[k - 1]->avl_link[da[k - 1]] = w;
+ }
+ else
+ {
+ y->avl_link[0] = x->avl_link[1];
+ x->avl_link[1] = y;
+ pa[k - 1]->avl_link[da[k - 1]] = x;
+ if (x->avl_balance == 0)
+ {
+ x->avl_balance = +1;
+ y->avl_balance = -1;
+ break;
+ }
+ else
+ x->avl_balance = y->avl_balance = 0;
+ }
+ }
+ }
+ }
+
+ tree->avl_count--;
+ tree->avl_generation++;
+ return (void *) item;
+}
+
+/* Refreshes the stack of parent pointers in |trav|
+ and updates its generation number. */
+static void
+trav_refresh (struct avl_traverser *trav)
+{
+ assert (trav != NULL);
+
+ trav->avl_generation = trav->avl_table->avl_generation;
+
+ if (trav->avl_node != NULL)
+ {
+ avl_comparison_func *cmp = trav->avl_table->avl_compare;
+ void *param = trav->avl_table->avl_param;
+ struct avl_node *node = trav->avl_node;
+ struct avl_node *i;
+
+ trav->avl_height = 0;
+ for (i = trav->avl_table->avl_root; i != node; )
+ {
+ assert (trav->avl_height < AVL_MAX_HEIGHT);
+ assert (i != NULL);
+
+ trav->avl_stack[trav->avl_height++] = i;
+ i = i->avl_link[cmp (node->avl_data, i->avl_data, param) > 0];
+ }
+ }
+}
+
+/* Initializes |trav| for use with |tree|
+ and selects the null node. */
+void
+avl_t_init (struct avl_traverser *trav, struct avl_table *tree)
+{
+ trav->avl_table = tree;
+ trav->avl_node = NULL;
+ trav->avl_height = 0;
+ trav->avl_generation = tree->avl_generation;
+}
+
+/* Initializes |trav| for |tree|
+ and selects and returns a pointer to its least-valued item.
+ Returns |NULL| if |tree| contains no nodes. */
+void *
+avl_t_first (struct avl_traverser *trav, struct avl_table *tree)
+{
+ struct avl_node *x;
+
+ assert (tree != NULL && trav != NULL);
+
+ trav->avl_table = tree;
+ trav->avl_height = 0;
+ trav->avl_generation = tree->avl_generation;
+
+ x = tree->avl_root;
+ if (x != NULL)
+ while (x->avl_link[0] != NULL)
+ {
+ assert (trav->avl_height < AVL_MAX_HEIGHT);
+ trav->avl_stack[trav->avl_height++] = x;
+ x = x->avl_link[0];
+ }
+ trav->avl_node = x;
+
+ return x != NULL ? x->avl_data : NULL;
+}
+
+/* Initializes |trav| for |tree|
+ and selects and returns a pointer to its greatest-valued item.
+ Returns |NULL| if |tree| contains no nodes. */
+void *
+avl_t_last (struct avl_traverser *trav, struct avl_table *tree)
+{
+ struct avl_node *x;
+
+ assert (tree != NULL && trav != NULL);
+
+ trav->avl_table = tree;
+ trav->avl_height = 0;
+ trav->avl_generation = tree->avl_generation;
+
+ x = tree->avl_root;
+ if (x != NULL)
+ while (x->avl_link[1] != NULL)
+ {
+ assert (trav->avl_height < AVL_MAX_HEIGHT);
+ trav->avl_stack[trav->avl_height++] = x;
+ x = x->avl_link[1];
+ }
+ trav->avl_node = x;
+
+ return x != NULL ? x->avl_data : NULL;
+}
+
+/* Searches for |item| in |tree|.
+ If found, initializes |trav| to the item found and returns the item
+ as well.
+ If there is no matching item, initializes |trav| to the null item
+ and returns |NULL|. */
+void *
+avl_t_find (struct avl_traverser *trav, struct avl_table *tree, void *item)
+{
+ struct avl_node *p, *q;
+
+ assert (trav != NULL && tree != NULL && item != NULL);
+ trav->avl_table = tree;
+ trav->avl_height = 0;
+ trav->avl_generation = tree->avl_generation;
+ for (p = tree->avl_root; p != NULL; p = q)
+ {
+ int cmp = tree->avl_compare (item, p->avl_data, tree->avl_param);
+
+ if (cmp < 0)
+ q = p->avl_link[0];
+ else if (cmp > 0)
+ q = p->avl_link[1];
+ else /* |cmp == 0| */
+ {
+ trav->avl_node = p;
+ return p->avl_data;
+ }
+
+ assert (trav->avl_height < AVL_MAX_HEIGHT);
+ trav->avl_stack[trav->avl_height++] = p;
+ }
+
+ trav->avl_height = 0;
+ trav->avl_node = NULL;
+ return NULL;
+}
+
+/* Attempts to insert |item| into |tree|.
+ If |item| is inserted successfully, it is returned and |trav| is
+ initialized to its location.
+ If a duplicate is found, it is returned and |trav| is initialized to
+ its location. No replacement of the item occurs.
+ If a memory allocation failure occurs, |NULL| is returned and |trav|
+ is initialized to the null item. */
+void *
+avl_t_insert (struct avl_traverser *trav, struct avl_table *tree, void *item)
+{
+ void **p;
+
+ assert (trav != NULL && tree != NULL && item != NULL);
+
+ p = avl_probe (tree, item);
+ if (p != NULL)
+ {
+ trav->avl_table = tree;
+ trav->avl_node =
+ ((struct avl_node *)
+ ((char *) p - offsetof (struct avl_node, avl_data)));
+ trav->avl_generation = tree->avl_generation - 1;
+ return *p;
+ }
+ else
+ {
+ avl_t_init (trav, tree);
+ return NULL;
+ }
+}
+
+/* Initializes |trav| to have the same current node as |src|. */
+void *
+avl_t_copy (struct avl_traverser *trav, const struct avl_traverser *src)
+{
+ assert (trav != NULL && src != NULL);
+
+ if (trav != src)
+ {
+ trav->avl_table = src->avl_table;
+ trav->avl_node = src->avl_node;
+ trav->avl_generation = src->avl_generation;
+ if (trav->avl_generation == trav->avl_table->avl_generation)
+ {
+ trav->avl_height = src->avl_height;
+ memcpy (trav->avl_stack, (const void *) src->avl_stack,
+ sizeof *trav->avl_stack * trav->avl_height);
+ }
+ }
+
+ return trav->avl_node != NULL ? trav->avl_node->avl_data : NULL;
+}
+
+/* Returns the next data item in inorder
+ within the tree being traversed with |trav|,
+ or if there are no more data items returns |NULL|. */
+void *
+avl_t_next (struct avl_traverser *trav)
+{
+ struct avl_node *x;
+
+ assert (trav != NULL);
+
+ if (trav->avl_generation != trav->avl_table->avl_generation)
+ trav_refresh (trav);
+
+ x = trav->avl_node;
+ if (x == NULL)
+ {
+ return avl_t_first (trav, trav->avl_table);
+ }
+ else if (x->avl_link[1] != NULL)
+ {
+ assert (trav->avl_height < AVL_MAX_HEIGHT);
+ trav->avl_stack[trav->avl_height++] = x;
+ x = x->avl_link[1];
+
+ while (x->avl_link[0] != NULL)
+ {
+ assert (trav->avl_height < AVL_MAX_HEIGHT);
+ trav->avl_stack[trav->avl_height++] = x;
+ x = x->avl_link[0];
+ }
+ }
+ else
+ {
+ struct avl_node *y;
+
+ do
+ {
+ if (trav->avl_height == 0)
+ {
+ trav->avl_node = NULL;
+ return NULL;
+ }
+
+ y = x;
+ x = trav->avl_stack[--trav->avl_height];
+ }
+ while (y == x->avl_link[1]);
+ }
+ trav->avl_node = x;
+
+ return x->avl_data;
+}
+
+/* Returns the previous data item in inorder
+ within the tree being traversed with |trav|,
+ or if there are no more data items returns |NULL|. */
+void *
+avl_t_prev (struct avl_traverser *trav)
+{
+ struct avl_node *x;
+
+ assert (trav != NULL);
+
+ if (trav->avl_generation != trav->avl_table->avl_generation)
+ trav_refresh (trav);
+
+ x = trav->avl_node;
+ if (x == NULL)
+ {
+ return avl_t_last (trav, trav->avl_table);
+ }
+ else if (x->avl_link[0] != NULL)
+ {
+ assert (trav->avl_height < AVL_MAX_HEIGHT);
+ trav->avl_stack[trav->avl_height++] = x;
+ x = x->avl_link[0];
+
+ while (x->avl_link[1] != NULL)
+ {
+ assert (trav->avl_height < AVL_MAX_HEIGHT);
+ trav->avl_stack[trav->avl_height++] = x;
+ x = x->avl_link[1];
+ }
+ }
+ else
+ {
+ struct avl_node *y;
+
+ do
+ {
+ if (trav->avl_height == 0)
+ {
+ trav->avl_node = NULL;
+ return NULL;
+ }
+
+ y = x;
+ x = trav->avl_stack[--trav->avl_height];
+ }
+ while (y == x->avl_link[0]);
+ }
+ trav->avl_node = x;
+
+ return x->avl_data;
+}
+
+/* Returns |trav|'s current item. */
+void *
+avl_t_cur (struct avl_traverser *trav)
+{
+ assert (trav != NULL);
+
+ return trav->avl_node != NULL ? trav->avl_node->avl_data : NULL;
+}
+
+/* Replaces the current item in |trav| by |new| and returns the item replaced.
+ |trav| must not have the null item selected.
+ The new item must not upset the ordering of the tree. */
+void *
+avl_t_replace (struct avl_traverser *trav, void *new)
+{
+ void *old;
+
+ assert (trav != NULL && trav->avl_node != NULL && new != NULL);
+ old = trav->avl_node->avl_data;
+ trav->avl_node->avl_data = new;
+ return old;
+}
+
+static void
+copy_error_recovery (struct avl_node **stack, int height,
+ struct avl_table *new, avl_item_func *destroy)
+{
+ assert (stack != NULL && height >= 0 && new != NULL);
+
+ for (; height > 2; height -= 2)
+ stack[height - 1]->avl_link[1] = NULL;
+ avl_destroy (new, destroy);
+}
+
+/* Copies |org| to a newly created tree, which is returned.
+ If |copy != NULL|, each data item in |org| is first passed to |copy|,
+ and the return values are inserted into the tree,
+ with |NULL| return values taken as indications of failure.
+ On failure, destroys the partially created new tree,
+ applying |destroy|, if non-null, to each item in the new tree so far,
+ and returns |NULL|.
+ If |allocator != NULL|, it is used for allocation in the new tree.
+ Otherwise, the same allocator used for |org| is used. */
+struct avl_table *
+avl_copy (const struct avl_table *org, avl_copy_func *copy,
+ avl_item_func *destroy, struct libavl_allocator *allocator)
+{
+ struct avl_node *stack[2 * (AVL_MAX_HEIGHT + 1)];
+ int height = 0;
+
+ struct avl_table *new;
+ const struct avl_node *x;
+ struct avl_node *y;
+
+ assert (org != NULL);
+ new = avl_create (org->avl_compare, org->avl_param,
+ allocator != NULL ? allocator : org->avl_alloc);
+ if (new == NULL)
+ return NULL;
+ new->avl_count = org->avl_count;
+ if (new->avl_count == 0)
+ return new;
+
+ x = (const struct avl_node *) &org->avl_root;
+ y = (struct avl_node *) &new->avl_root;
+ for (;;)
+ {
+ while (x->avl_link[0] != NULL)
+ {
+ assert (height < 2 * (AVL_MAX_HEIGHT + 1));
+
+ y->avl_link[0] =
+ new->avl_alloc->libavl_malloc (new->avl_alloc,
+ sizeof *y->avl_link[0]);
+ if (y->avl_link[0] == NULL)
+ {
+ if (y != (struct avl_node *) &new->avl_root)
+ {
+ y->avl_data = NULL;
+ y->avl_link[1] = NULL;
+ }
+
+ copy_error_recovery (stack, height, new, destroy);
+ return NULL;
+ }
+
+ stack[height++] = (struct avl_node *) x;
+ stack[height++] = y;
+ x = x->avl_link[0];
+ y = y->avl_link[0];
+ }
+ y->avl_link[0] = NULL;
+
+ for (;;)
+ {
+ y->avl_balance = x->avl_balance;
+ if (copy == NULL)
+ y->avl_data = x->avl_data;
+ else
+ {
+ y->avl_data = copy (x->avl_data, org->avl_param);
+ if (y->avl_data == NULL)
+ {
+ y->avl_link[1] = NULL;
+ copy_error_recovery (stack, height, new, destroy);
+ return NULL;
+ }
+ }
+
+ if (x->avl_link[1] != NULL)
+ {
+ y->avl_link[1] =
+ new->avl_alloc->libavl_malloc (new->avl_alloc,
+ sizeof *y->avl_link[1]);
+ if (y->avl_link[1] == NULL)
+ {
+ copy_error_recovery (stack, height, new, destroy);
+ return NULL;
+ }
+
+ x = x->avl_link[1];
+ y = y->avl_link[1];
+ break;
+ }
+ else
+ y->avl_link[1] = NULL;
+
+ if (height <= 2)
+ return new;
+
+ y = stack[--height];
+ x = stack[--height];
+ }
+ }
+}
+
+/* Frees storage allocated for |tree|.
+ If |destroy != NULL|, applies it to each data item in inorder. */
+void
+avl_destroy (struct avl_table *tree, avl_item_func *destroy)
+{
+ struct avl_node *p, *q;
+
+ assert (tree != NULL);
+
+ for (p = tree->avl_root; p != NULL; p = q)
+ if (p->avl_link[0] == NULL)
+ {
+ q = p->avl_link[1];
+ if (destroy != NULL && p->avl_data != NULL)
+ destroy (p->avl_data, tree->avl_param);
+ tree->avl_alloc->libavl_free (tree->avl_alloc, p);
+ }
+ else
+ {
+ q = p->avl_link[0];
+ p->avl_link[0] = q->avl_link[1];
+ q->avl_link[1] = p;
+ }
+
+ tree->avl_alloc->libavl_free (tree->avl_alloc, tree);
+}
+
+/* Allocates |size| bytes of space using |malloc()|.
+ Returns a null pointer if allocation fails. */
+void *
+avl_malloc (struct libavl_allocator *allocator, size_t size)
+{
+ assert (allocator != NULL && size > 0);
+ return malloc (size);
+}
+
+/* Frees |block|. */
+void
+avl_free (struct libavl_allocator *allocator, void *block)
+{
+ assert (allocator != NULL && block != NULL);
+ free (block);
+}
+
+/* Default memory allocator that uses |malloc()| and |free()|. */
+struct libavl_allocator avl_allocator_default =
+ {
+ avl_malloc,
+ avl_free
+ };
+
+#undef NDEBUG
+#include <assert.h>
+
+/* Asserts that |avl_insert()| succeeds at inserting |item| into |table|. */
+void
+(avl_assert_insert) (struct avl_table *table, void *item)
+{
+ void **p = avl_probe (table, item);
+ assert (p != NULL && *p == item);
+}
+
+/* Asserts that |avl_delete()| really removes |item| from |table|,
+ and returns the removed item. */
+void *
+(avl_assert_delete) (struct avl_table *table, void *item)
+{
+ void *p = avl_delete (table, item);
+ assert (p != NULL);
+ return p;
+}
+
diff --git a/Build/source/texk/web2c/pdftexdir/avl.h b/Build/source/texk/web2c/pdftexdir/avl.h
new file mode 100644
index 00000000000..446a11a0ba9
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/avl.h
@@ -0,0 +1,123 @@
+/* Produced by texiweb from libavl.w on 2003/01/06 at 18:07. */
+
+/* libavl - library for manipulation of binary trees.
+ Copyright (C) 1998-2002 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+ See the GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA.
+
+ The author may be contacted at <blp@gnu.org> on the Internet, or
+ write to Ben Pfaff, Stanford University, Computer Science Dept., 353
+ Serra Mall, Stanford CA 94305, USA.
+*/
+
+#ifndef AVL_H
+#define AVL_H 1
+
+#include <stddef.h>
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+
+/* Function types. */
+typedef int avl_comparison_func (const void *avl_a, const void *avl_b,
+ void *avl_param);
+typedef void avl_item_func (void *avl_item, void *avl_param);
+typedef void *avl_copy_func (void *avl_item, void *avl_param);
+
+#ifndef LIBAVL_ALLOCATOR
+#define LIBAVL_ALLOCATOR
+/* Memory allocator. */
+struct libavl_allocator
+ {
+ void *(*libavl_malloc) (struct libavl_allocator *, size_t libavl_size);
+ void (*libavl_free) (struct libavl_allocator *, void *libavl_block);
+ };
+#endif
+
+/* Default memory allocator. */
+extern struct libavl_allocator avl_allocator_default;
+void *avl_malloc (struct libavl_allocator *, size_t);
+void avl_free (struct libavl_allocator *, void *);
+
+/* Maximum AVL height. */
+#ifndef AVL_MAX_HEIGHT
+#define AVL_MAX_HEIGHT 32
+#endif
+
+/* Tree data structure. */
+struct avl_table
+ {
+ struct avl_node *avl_root; /* Tree's root. */
+ avl_comparison_func *avl_compare; /* Comparison function. */
+ void *avl_param; /* Extra argument to |avl_compare|. */
+ struct libavl_allocator *avl_alloc; /* Memory allocator. */
+ size_t avl_count; /* Number of items in tree. */
+ unsigned long avl_generation; /* Generation number. */
+ };
+
+/* An AVL tree node. */
+struct avl_node
+ {
+ struct avl_node *avl_link[2]; /* Subtrees. */
+ void *avl_data; /* Pointer to data. */
+ signed char avl_balance; /* Balance factor. */
+ };
+
+/* AVL traverser structure. */
+struct avl_traverser
+ {
+ struct avl_table *avl_table; /* Tree being traversed. */
+ struct avl_node *avl_node; /* Current node in tree. */
+ struct avl_node *avl_stack[AVL_MAX_HEIGHT];
+ /* All the nodes above |avl_node|. */
+ size_t avl_height; /* Number of nodes in |avl_parent|. */
+ unsigned long avl_generation; /* Generation number. */
+ };
+
+/* Table functions. */
+struct avl_table *avl_create (avl_comparison_func *, void *,
+ struct libavl_allocator *);
+struct avl_table *avl_copy (const struct avl_table *, avl_copy_func *,
+ avl_item_func *, struct libavl_allocator *);
+void avl_destroy (struct avl_table *, avl_item_func *);
+void **avl_probe (struct avl_table *, void *);
+void *avl_insert (struct avl_table *, void *);
+void *avl_replace (struct avl_table *, void *);
+void *avl_delete (struct avl_table *, const void *);
+void *avl_find (const struct avl_table *, const void *);
+void avl_assert_insert (struct avl_table *, void *);
+void *avl_assert_delete (struct avl_table *, void *);
+
+#define avl_count(table) ((size_t) (table)->avl_count)
+
+/* Table traverser functions. */
+void avl_t_init (struct avl_traverser *, struct avl_table *);
+void *avl_t_first (struct avl_traverser *, struct avl_table *);
+void *avl_t_last (struct avl_traverser *, struct avl_table *);
+void *avl_t_find (struct avl_traverser *, struct avl_table *, void *);
+void *avl_t_insert (struct avl_traverser *, struct avl_table *, void *);
+void *avl_t_copy (struct avl_traverser *, const struct avl_traverser *);
+void *avl_t_next (struct avl_traverser *);
+void *avl_t_prev (struct avl_traverser *);
+void *avl_t_cur (struct avl_traverser *);
+void *avl_t_replace (struct avl_traverser *, void *);
+
+#if defined(__cplusplus)
+}
+#endif
+
+#endif /* avl.h */
diff --git a/Build/source/texk/web2c/pdftexdir/avlstuff.c b/Build/source/texk/web2c/pdftexdir/avlstuff.c
new file mode 100644
index 00000000000..1fab93223f1
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/avlstuff.c
@@ -0,0 +1,131 @@
+/*
+Copyright (c) 2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by Free
+Software Foundation; either version 2 of the License, or (at your option)
+any later version.
+
+This file is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with this file; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/avlstuff.c#5 $
+
+formatted by indent -kr
+*/
+
+#include "ptexlib.h"
+#include <kpathsea/c-vararg.h>
+#include <kpathsea/c-proto.h>
+#include "avl.h"
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/avlstuff.c#5 $";
+
+/* One AVL tree for each obj_type 0...pdfobjtypemax */
+
+static struct avl_table *PdfObjTree[pdfobjtypemax + 1] =
+ { NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL };
+
+
+/* memory management functions for avl */
+
+void *avl_xmalloc(struct libavl_allocator *allocator, size_t size)
+{
+ assert(allocator != NULL && size > 0);
+ return xmalloc(size);
+}
+
+void avl_xfree(struct libavl_allocator *allocator, void *block)
+{
+ assert(allocator != NULL && block != NULL);
+ xfree(block);
+}
+
+struct libavl_allocator avl_xallocator = {
+ avl_xmalloc,
+ avl_xfree
+};
+
+
+/* AVL sort objentry into avl_table[] */
+
+int compare_info(const void *pa, const void *pb, void *param)
+{
+ integer a, b;
+ int as, ae, bs, be, al, bl;
+
+ a = ((const objentry *) pa)->int0;
+ b = ((const objentry *) pb)->int0;
+ if (a < 0 && b < 0) { /* string comparison */
+ as = strstart[-a];
+ ae = strstart[-a + 1]; /* start of next string in pool */
+ bs = strstart[-b];
+ be = strstart[-b + 1];
+ al = ae - as;
+ bl = be - bs;
+ if (al < bl) /* compare first by string length */
+ return -1;
+ else if (al > bl)
+ return 1;
+ else
+ for (; as < ae; as++, bs++) {
+ if (strpool[as] < strpool[bs])
+ return -1;
+ if (strpool[as] > strpool[bs])
+ return 1;
+ }
+ return 0;
+ } else { /* integer comparison */
+ if (a < b)
+ return -1;
+ else if (a > b)
+ return 1;
+ else
+ return 0;
+ }
+}
+
+
+void avlputobj(integer objptr, integer t)
+{
+ static void **pp;
+
+ if (PdfObjTree[t] == NULL) {
+ PdfObjTree[t] = avl_create(compare_info, NULL, &avl_xallocator);
+ if (PdfObjTree[t] == NULL)
+ pdftex_fail("avlstuff.c: avl_create() PdfObjTree failed");
+ }
+ pp = avl_probe(PdfObjTree[t], &(objtab[objptr]));
+ if (pp == NULL)
+ pdftex_fail("avlstuff.c: avl_probe() out of memory in insertion");
+}
+
+
+/* replacement for linear search pascal function "find_obj" */
+
+integer avlfindobj(integer t, integer i, integer byname)
+{
+ static objentry *p;
+ static objentry tmp;
+
+ if (byname > 0)
+ tmp.int0 = -i;
+ else
+ tmp.int0 = i;
+ if (PdfObjTree[t] == NULL)
+ return 0;
+ p = (objentry *) avl_find(PdfObjTree[t], &tmp);
+ if (p == NULL)
+ return 0;
+ else
+ return (int) (p - (objentry *) objtab);
+}
+
+/* end of file avlstuff.c */
diff --git a/Build/source/texk/web2c/pdftexdir/avlstuff.h b/Build/source/texk/web2c/pdftexdir/avlstuff.h
new file mode 100644
index 00000000000..2ffa57b627d
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/avlstuff.h
@@ -0,0 +1,29 @@
+/*
+Copyright (c) 2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by Free
+Software Foundation; either version 2 of the License, or (at your option)
+any later version.
+
+This file is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with this file; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/avlstuff.h#5 $
+
+formatted by indent -kr
+*/
+
+#include "avl.h"
+
+/* memory management functions for avl */
+
+extern struct libavl_allocator avl_xallocator;
+
+/* end of file avlstuff.h */
diff --git a/Build/source/texk/web2c/pdftexdir/change-files.txt b/Build/source/texk/web2c/pdftexdir/change-files.txt
new file mode 100644
index 00000000000..496c1e313ed
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/change-files.txt
@@ -0,0 +1,132 @@
+How change files are applied for pdftex/pdfetex?
+
+============================= pdftex =============================
+
+1) pdftex.web is generated from
+ ./tie -m pdftex.web $(srcdir)/tex.web \
+ $(srcdir)/pdftexdir/pdftex.ch \
+ $(srcdir)/pdftexdir/hz.ch \
+ $(srcdir)/pdftexdir/misc.ch
+
+Input:
+ tex.web:
+ the original tex sources
+
+ pdftexdir/pdftex.ch:
+ PDF-specific changes
+
+ pdftexdir/hz.ch:
+ HZ extension
+
+ pdftexdir/misc.ch:
+ miscellany extensions
+
+
+Output:
+ pdftex.web:
+ pdftex without system-dependent changes
+
+2) pdftex.ch is generated from
+ ./tie -c pdftex.ch pdftex.web \
+ $(srcdir)/pdftexdir/tex.ch0 \
+ $(srcdir)/tex.ch \
+ $(srcdir)/pdftexdir/tex.ch1 \
+ $(srcdir)/pdftexdir/tex.pch
+
+Input:
+ pdftex.web:
+ from step 1), ie pdftex without system-dependent changes
+
+ pdftexdir/tex.ch0:
+ % Change file to assist in creating the web2c-specific change file.
+ % This one comes first, resolves inconsistencies between the
+ % generated pdftex.web and tex.ch
+
+ change the pdftex banner to tex banner, so tex.ch can be applied
+
+ tex.ch:
+ the main web2c-specific (or other system-dependent) change file
+
+ pdftexdir/tex.ch1:
+ % Change file to assist in creating the web2c-specific change file.
+ % This one resolves inconsistencies between tex.ch and tex.pch.
+
+ change the tex banner to pdftex banner (reverse tex.ch0)
+
+ pdftexdir/tex.pch:
+ % Change file containing web2c-specific or system-dependent changes to
+ % pdftex
+
+Output:
+ pdftex.ch (not pdftexdir/pdftex.ch):
+ additional & system-dependent changes
+
+
+============================= pdfetex =============================
+
+1) pdfetex.web is generated from
+ ./tie -m pdfetex.web $(srcdir)/tex.web \
+ $(srcdir)/etexdir/etex.ch \
+ $(srcdir)/pdfetexdir/pdfetex.ch1 \
+ $(srcdir)/pdftexdir/pdftex.ch \
+ $(srcdir)/pdftexdir/hz.ch \
+ $(srcdir)/pdftexdir/misc.ch \
+ $(srcdir)/pdfetexdir/pdfetex.ch2
+
+ pdfetex.web should contain system-independent changes only;
+
+Input:
+ etexdir/etex.ch:
+ system-independent changes by etex
+
+ pdfetexdir/pdfetex.ch1:
+ reverse some etex changes so system-independent pdftex change files can
+ be applied
+
+ pdftexdir/{pdftex,hz,misc}.ch:
+ system-independent changes by pdftex
+
+ pdfetexdir/pdfetex.ch2:
+ merge changes by etexdir/etex.ch & pdftexdir/{pdftex,hz,...}.ch
+
+Output:
+ pdfetex.web:
+ pdfetex without system-dependent changes
+
+
+2) pdfetex.ch is generated from
+ ./tie -c pdfetex.ch pdfetex.web \
+ $(srcdir)/pdfetexdir/tex.ch0 \
+ $(srcdir)/tex.ch \
+ $(srcdir)/etexdir/tex.ch1 \
+ $(srcdir)/etexdir/tex.ech \
+ $(srcdir)/pdfetexdir/tex.ch1 \
+ $(srcdir)/pdftexdir/tex.pch
+
+Input:
+ pdfetex.web:
+ from step 1), ie pdfetex without system-dependent changes
+
+ pdfetexdir/tex.ch0:
+ % Change file to assist in creating the web2c-specific change file.
+ % This one comes first, resolves inconsistencies between the generated
+ % pdfetex.web and tex.ch
+
+ change the pdfetex banner to tex banner, so tex.ch can be applied
+
+ tex.ch:
+ the main web2c-specific (or other system-dependent) change file
+
+ the etex changes files:
+ system-dependent changes by etex
+
+ pdfetexdir/tex.ch1:
+ reverses some system-dependent changes by etex (the banner) so
+ pdftexdir/tex.pch can be applied
+
+ pdftexdir/tex.pch:
+ system-dependent changes by pdftex
+
+Output:
+ pdfetex.ch:
+ additional & system-dependent changes
diff --git a/Build/source/texk/web2c/pdftexdir/depend.mak b/Build/source/texk/web2c/pdftexdir/depend.mak
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/depend.mak
diff --git a/Build/source/texk/web2c/pdftexdir/depend.mk b/Build/source/texk/web2c/pdftexdir/depend.mk
new file mode 100644
index 00000000000..3f83c3d34d9
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/depend.mk
@@ -0,0 +1,54 @@
+epdf.o: epdf.c ptexlib.h ../pdftexd.h ../texmfmp.h ../cpascal.h \
+ ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h ptexmac.h
+mapfile.o: mapfile.c ptexlib.h ../pdftexd.h ../texmfmp.h ../cpascal.h \
+ ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h ptexmac.h
+papersiz.o: papersiz.c ptexlib.h ../pdftexd.h ../texmfmp.h \
+ ../cpascal.h ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h \
+ ptexmac.h
+utils.o: utils.c ptexlib.h ../pdftexd.h ../texmfmp.h ../cpascal.h \
+ ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h ptexmac.h \
+ ../../../libs/zlib/zlib.h ../../../libs/zlib/zconf.h \
+ ../../../libs/md5/md5.h pdftexextra.h
+vfpacket.o: vfpacket.c ptexlib.h ../pdftexd.h ../texmfmp.h \
+ ../cpascal.h ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h \
+ ptexmac.h
+pkin.o: pkin.c ptexlib.h ../pdftexd.h ../texmfmp.h ../cpascal.h \
+ ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h ptexmac.h
+writefont.o: writefont.c ../../../libs/xpdf/goo/gmem.h ptexlib.h \
+ ../pdftexd.h ../texmfmp.h ../cpascal.h ../config.h ../help.h \
+ ../texmfmem.h ../pdftexcoerce.h ptexmac.h
+writet1.o: writet1.c ptexlib.h ../pdftexd.h ../texmfmp.h ../cpascal.h \
+ ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h ptexmac.h
+writet3.o: writet3.c ptexlib.h ../pdftexd.h ../texmfmp.h ../cpascal.h \
+ ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h ptexmac.h
+writezip.o: writezip.c ptexlib.h ../pdftexd.h ../texmfmp.h \
+ ../cpascal.h ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h \
+ ptexmac.h ../../../libs/zlib/zlib.h ../../../libs/zlib/zconf.h
+writeenc.o: writeenc.c ptexlib.h ../pdftexd.h ../texmfmp.h \
+ ../cpascal.h ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h \
+ ptexmac.h
+writettf.o: writettf.c ptexlib.h ../pdftexd.h ../texmfmp.h \
+ ../cpascal.h ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h \
+ ptexmac.h macnames.c
+writejpg.o: writejpg.c ptexlib.h ../pdftexd.h ../texmfmp.h \
+ ../cpascal.h ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h \
+ ptexmac.h image.h
+writepng.o: writepng.c ptexlib.h ../pdftexd.h ../texmfmp.h \
+ ../cpascal.h ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h \
+ ptexmac.h image.h
+writeimg.o: writeimg.c ptexlib.h ../pdftexd.h ../texmfmp.h \
+ ../cpascal.h ../config.h ../help.h ../texmfmem.h ../pdftexcoerce.h \
+ ptexmac.h image.h
+pdftoepdf.o: pdftoepdf.cc ../../../libs/xpdf/xpdf/Object.h \
+ ../../../libs/xpdf/goo/gmem.h ../../../libs/xpdf/xpdf/Array.h \
+ ../../../libs/xpdf/xpdf/Dict.h ../../../libs/xpdf/xpdf/Stream.h \
+ ../../../libs/xpdf/xpdf/XRef.h ../../../libs/xpdf/xpdf/Catalog.h \
+ ../../../libs/xpdf/xpdf/Page.h ../../../libs/xpdf/xpdf/GfxFont.h \
+ ../../../libs/xpdf/xpdf/Error.h epdf.h
+ttf2afm.o: ttf2afm.c macnames.c
+pdftosrc.o: pdftosrc.cc ../../../libs/xpdf/xpdf/Object.h \
+ ../../../libs/xpdf/xpdf/Array.h ../../../libs/xpdf/xpdf/Dict.h \
+ ../../../libs/xpdf/xpdf/Stream.h ../../../libs/xpdf/xpdf/XRef.h \
+ ../../../libs/xpdf/xpdf/Catalog.h ../../../libs/xpdf/xpdf/Page.h \
+ ../../../libs/xpdf/xpdf/PDFDoc.h ../../../libs/xpdf/xpdf/Link.h \
+ ../../../libs/xpdf/xpdf/Error.h ../../../libs/xpdf/xpdf/config.h
diff --git a/Build/source/texk/web2c/pdftexdir/epdf.c b/Build/source/texk/web2c/pdftexdir/epdf.c
new file mode 100644
index 00000000000..95000755b0d
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/epdf.c
@@ -0,0 +1,75 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/epdf.c#10 $
+*/
+
+#include "ptexlib.h"
+#include <kpathsea/c-vararg.h>
+#include <kpathsea/c-proto.h>
+
+integer pdfbufmax = pdfbufsize;
+
+extern void epdf_check_mem(void);
+
+int is_subsetable(fm_entry *fm)
+{
+ return is_included(fm) && is_subsetted(fm);
+}
+
+int is_type1(fm_entry *fm)
+{
+ return is_t1fontfile(fm);
+}
+
+void mark_glyphs(fm_entry *fm, char *charset)
+{
+ char *new_charset = fm->charset;
+ if (charset == NULL)
+ return;
+ if (new_charset == NULL)
+ new_charset = xstrdup(charset);
+ else {
+ xretalloc(new_charset, strlen(new_charset)+strlen(charset)+1, char);
+ strcat(new_charset, charset);
+ }
+ fm->charset = new_charset;
+}
+
+void embed_whole_font(fm_entry *fm)
+{
+ fm->all_glyphs = true;
+}
+
+integer get_fontfile(fm_entry *fm)
+{
+ return fm->ff_objnum;
+}
+
+integer get_fontname(fm_entry *fm)
+{
+ if (fm->fn_objnum == 0)
+ fm->fn_objnum = pdfnewobjnum();
+ return fm->fn_objnum;
+}
+
+void epdf_free(void)
+{
+ epdf_check_mem();
+}
diff --git a/Build/source/texk/web2c/pdftexdir/epdf.h b/Build/source/texk/web2c/pdftexdir/epdf.h
new file mode 100644
index 00000000000..27ce221061d
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/epdf.h
@@ -0,0 +1,103 @@
+/*
+Copyright (c) 1996-2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/epdf.h#17 $
+*/
+
+extern "C" {
+
+#include <kpathsea/c-auto.h>
+
+/* the following code is extremly ugly but needed for including web2c/config.h */
+
+#include <kpathsea/c-proto.h> /* define P?H macros */
+
+typedef const char *const_string; /* including kpathsea/types.h doesn't work on some systems */
+
+#define KPATHSEA_CONFIG_H /* avoid including other kpathsea header files */
+ /* from web2c/config.h */
+
+#ifdef CONFIG_H /* CONFIG_H has been defined by some xpdf */
+#undef CONFIG_H /* header file */
+#endif
+
+#include <web2c/c-auto.h> /* define SIZEOF_LONG */
+#include <web2c/config.h> /* define type integer */
+
+#include <web2c/pdftexdir/ptexmac.h>
+
+#define pdfbufsize pdfbufmax
+
+extern float epdf_width;
+extern float epdf_height;
+extern float epdf_orig_x;
+extern float epdf_orig_y;
+extern integer epdf_selected_page;
+extern integer epdf_num_pages;
+extern integer epdf_page_box;
+extern integer epdf_always_use_pdf_pagebox;
+extern void *epdf_doc;
+extern void *epdf_xref;
+
+extern integer pdfstreamlength;
+extern integer pdfptr;
+typedef unsigned char eightbits ;
+extern eightbits pdfbuf[];
+extern integer pdfbufmax;
+
+extern char notdef[];
+
+extern int is_subsetable(struct fm_entry *);
+extern int is_type1(struct fm_entry *);
+extern struct fm_entry * lookup_fontmap(char *);
+extern integer get_fontfile(struct fm_entry *);
+extern integer get_fontname(struct fm_entry *);
+extern integer pdfnewobjnum(void);
+extern integer read_pdf_info(char*, char*, integer, integer, integer, integer);
+extern void embed_whole_font(struct fm_entry *);
+extern void epdf_check_mem(void);
+extern void epdf_delete(void);
+extern void epdf_free(void);
+extern void mark_glyphs(struct fm_entry *, char *);
+extern void pdf_printf(const char *fmt,...);
+extern void pdf_puts(const char *);
+extern void pdfbeginstream(void);
+extern void pdfendobj(void);
+extern void pdfendstream(void);
+extern void pdfflush(void);
+extern void pdftex_fail(const char *fmt,...);
+extern void pdftex_warn(const char *fmt,...);
+extern void tex_printf(const char *, ...);
+extern void write_enc(char **, struct enc_entry *, integer);
+extern void write_epdf(void);
+extern void zpdfbegindict(integer);
+extern void zpdfbeginobj(integer);
+extern void zpdfcreateobj(integer, integer);
+extern void zpdfnewdict(integer, integer);
+
+/* utils.c */
+extern char *convertStringToPDFString(char *in, int len);
+
+/* config.c */
+extern integer cfgpar(integer);
+
+/* avlstuff.c */
+extern void avl_put_obj (integer, integer);
+extern integer avl_find_obj (integer, integer, integer);
+}
diff --git a/Build/source/texk/web2c/pdftexdir/hz.ch b/Build/source/texk/web2c/pdftexdir/hz.ch
new file mode 100644
index 00000000000..d8ec58fb5e7
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/hz.ch
@@ -0,0 +1,1935 @@
+% WEB change file containing HZ extensions for pdfTeX
+%
+% Copyright (c) 1996-2002 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/hz.ch#15 $
+
+@x [155] - margin kerning
+@d acc_kern=2 {|subtype| of kern nodes from accents}
+@y
+@d acc_kern=2 {|subtype| of kern nodes from accents}
+
+@# {memory structure for marginal kerns}
+@d margin_kern_node = 40
+@d margin_kern_node_size = 3
+@d margin_char(#) == info(# + 2)
+
+@# {|subtype| of marginal kerns}
+@d left_side == 0
+@d right_side == 1
+
+@# {base for lp/rp/ef codes starts from 2:
+ 0 for |hyphen_char|,
+ 1 for |skew_char|}
+@d lp_code_base == 2
+@d rp_code_base == 3
+@d ef_code_base == 4
+
+@d max_hlist_stack = 512 {maximum fill level for |hlist_stack|}
+{maybe good if larger than |2 * max_quarterword|, so that box nesting level would overflow first}
+@z
+
+@x [183] - margin kerning
+ kern_node: @<Display kern |p|@>;
+@y
+ margin_kern_node: begin
+ print_esc("kern");
+ print_scaled(width(p));
+ if subtype(p) = left_side then
+ print(" (left margin)")
+ else
+ print(" (right margin)");
+ end;
+ kern_node: @<Display kern |p|@>;
+@z
+
+@x [202] - margin kerning
+ kern_node,math_node,penalty_node: do_nothing;
+@y
+ kern_node,math_node,penalty_node: do_nothing;
+ margin_kern_node: begin
+ free_avail(margin_char(p));
+ free_node(p, margin_kern_node_size);
+ goto done;
+ end;
+@z
+
+@x [206] - margin kerning
+kern_node,math_node,penalty_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+@y
+kern_node,math_node,penalty_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+margin_kern_node: begin
+ r := get_node(margin_kern_node_size);
+ fast_get_avail(margin_char(r));
+ font(margin_char(r)) := font(margin_char(p));
+ character(margin_char(r)) := character(margin_char(p));
+ words := small_node_size;
+ end;
+@z
+
+@x [236]
+@d pdf_int_pars=pdftex_first_integer_code + 17 {total number of \pdfTeX's integer parameters}
+@y
+@d pdf_adjust_spacing_code = pdftex_first_integer_code + 17 {level of spacing adjusting}
+@d pdf_protrude_chars_code = pdftex_first_integer_code + 18 {protrude chars at left/right edge of paragraphs}
+@d pdf_tracing_fonts_code = pdftex_first_integer_code + 19 {level of font detail in log}
+@d pdf_int_pars=pdftex_first_integer_code + 20 {total number of \pdfTeX's integer parameters}
+@z
+
+@x [236]
+@d error_context_lines==int_par(error_context_lines_code)
+@y
+@d error_context_lines==int_par(error_context_lines_code)
+@#
+@d pdf_adjust_spacing == int_par(pdf_adjust_spacing_code)
+@d pdf_protrude_chars == int_par(pdf_protrude_chars_code)
+@d pdf_tracing_fonts == int_par(pdf_tracing_fonts_code)
+@z
+
+@x [237]
+error_context_lines_code:print_esc("errorcontextlines");
+@y
+error_context_lines_code:print_esc("errorcontextlines");
+@#
+pdf_adjust_spacing_code: print_esc("pdfadjustspacing");
+pdf_protrude_chars_code: print_esc("pdfprotrudechars");
+pdf_tracing_fonts_code: print_esc("pdftracingfonts");
+@z
+
+@x [238]
+primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+@y
+primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+primitive("pdfadjustspacing",assign_int,int_base+pdf_adjust_spacing_code);@/
+@!@:pdf_adjust_spacing_}{\.{\\pdfadjustspacing} primitive@>
+primitive("pdfprotrudechars",assign_int,int_base+pdf_protrude_chars_code);@/
+@!@:pdf_protrude_chars_}{\.{\\pdfprotrudechars} primitive@>
+primitive("pdftracingfonts",assign_int,int_base+pdf_tracing_fonts_code);@/
+@!@:pdf_tracing_fonts_}{\.{\\pdftracingfonts} primitive@>
+@z
+
+@x [267] - displaying fonts
+@<Print the font identifier for |font(p)|@>=
+print_esc(font_id_text(font(p)))
+@y
+@<Print the font identifier for |font(p)|@>=
+begin
+ print_esc(font_id_text(font(p)));
+ if pdf_tracing_fonts > 0 then begin
+ print(" (");
+ print(font_name[font(p)]);
+ if font_size[font(p)] <> font_dsize[font(p)] then begin
+ print("@@");
+ print_scaled(font_size[font(p)]);
+ print("pt");
+ end;
+ print(")");
+ end else
+ if pdf_font_expand_ratio[font(p)] <> 0 then begin
+ print(" (");
+ if pdf_font_expand_ratio[font(p)] > 0 then
+ print("+");
+ print_int(pdf_font_expand_ratio[font(p)]);
+ print(")");
+ end;
+end
+@z
+
+@x [413] - font expansion
+var m:halfword; {|chr_code| part of the operand token}
+@y
+var m:halfword; {|chr_code| part of the operand token}
+ n, k: integer; {accumulators}
+@z
+
+@x [426] - font expansion, margin kerning
+begin scan_font_ident;
+if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+else scanned_result(skew_char[cur_val])(int_val);
+@y
+begin scan_font_ident;
+if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+else if m=1 then scanned_result(skew_char[cur_val])(int_val)
+else begin
+ n := cur_val;
+ scan_char_num;
+ k := cur_val;
+ case m of
+ lp_code_base: scanned_result(get_lp_code(n, k))(int_val);
+ rp_code_base: scanned_result(get_rp_code(n, k))(int_val);
+ ef_code_base: scanned_result(get_ef_code(n, k))(int_val);
+ end;
+end;
+@z
+
+@x [468]
+@d pdftex_convert_codes = pdftex_first_expand_code + 9 {end of \pdfTeX's command codes}
+@y
+@d left_margin_kern_code = pdftex_first_expand_code + 9 {command code for \.{\\leftmarginkern}}
+@d right_margin_kern_code = pdftex_first_expand_code + 10 {command code for \.{\\rightmarginkern}}
+@d pdftex_convert_codes = pdftex_first_expand_code + 11 {end of \pdfTeX's command codes}
+@z
+
+@x [468]
+primitive("pdfpageref",convert,pdf_page_ref_code);@/
+@!@:pdf_page_ref_}{\.{\\pdfpageref} primitive@>
+@y
+primitive("pdfpageref",convert,pdf_page_ref_code);@/
+@!@:pdf_page_ref_}{\.{\\pdfpageref} primitive@>
+primitive("leftmarginkern",convert,left_margin_kern_code);@/
+@!@:left_margin_kern_}{\.{\\leftmarginkern} primitive@>
+primitive("rightmarginkern",convert,right_margin_kern_code);@/
+@!@:right_margin_kern_}{\.{\\rightmarginkern} primitive@>
+@z
+
+@x [469]
+ pdf_page_ref_code: print_esc("pdfpageref");
+@y
+ pdf_page_ref_code: print_esc("pdfpageref");
+ left_margin_kern_code: print_esc("leftmarginkern");
+ right_margin_kern_code: print_esc("rightmarginkern");
+@z
+
+@x [470]
+var old_setting:0..max_selector; {holds |selector| setting}
+@y
+var old_setting:0..max_selector; {holds |selector| setting}
+p, q: pointer;
+@z
+
+@x [471]
+pdf_page_ref_code: begin
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("pageref", "invalid page number");
+end;
+@y
+pdf_page_ref_code: begin
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("pageref", "invalid page number");
+end;
+left_margin_kern_code, right_margin_kern_code: begin
+ scan_int;
+ if (box(cur_val) = null) or (type(box(cur_val)) <> hlist_node) then
+ pdf_error("marginkern", "a non-empty hbox expected")
+end;
+@z
+
+@x [472]
+pdf_page_ref_code: print_int(get_obj(obj_type_page, cur_val, false));
+@y
+pdf_page_ref_code: print_int(get_obj(obj_type_page, cur_val, false));
+left_margin_kern_code: begin
+ p := list_ptr(box(cur_val));
+ if (p <> null) and (not is_char_node(p)) and
+ (type(p) = glue_node) and (subtype(p) = left_skip_code + 1) then
+ p := link(p);
+ if (p <> null) and (not is_char_node(p)) and
+ (type(p) = margin_kern_node) and (subtype(p) = left_side) then
+ print_scaled(width(p))
+ else
+ print("0");
+ print("pt");
+end;
+right_margin_kern_code: begin
+ q := list_ptr(box(cur_val));
+ p := null;
+ if q <> null then begin
+ p := prev_rightmost(q, null);
+ if (p <> null) and (not is_char_node(p)) and
+ (type(p) = glue_node) and (subtype(p) = right_skip_code + 1) then
+ p := prev_rightmost(q, p);
+ end;
+ if (p <> null) and (not is_char_node(p)) and
+ (type(p) = margin_kern_node) and (subtype(p) = right_side) then
+ print_scaled(width(p))
+ else
+ print("0");
+ print("pt");
+end;
+@z
+
+@x [622] - margin kerning
+glue_node: @<Move right or output leaders@>;
+@y
+glue_node: @<Move right or output leaders@>;
+margin_kern_node,
+@z
+
+
+@x [???] - font expansion
+@!tmp_f: internal_font_number; {for use with |pdf_init_font|}
+
+@y
+@!tmp_f: internal_font_number; {for use with |pdf_init_font|}
+@ Here come some subroutines to deal with expanded fonts for HZ-algorithm.
+
+@p
+function init_font_base(v: integer): integer;
+var i, j: integer;
+begin
+ i := pdf_get_mem(256);
+ for j := 0 to 255 do
+ pdf_mem[i + j] := v;
+ init_font_base := i;
+end;
+
+procedure set_lp_code(f: internal_font_number; c: eight_bits; i: integer);
+begin
+ if pdf_font_lp_base[f] = 0 then
+ pdf_font_lp_base[f] := init_font_base(0);
+ pdf_mem[pdf_font_lp_base[f] + c] := fix_int(i, -1000, 1000);
+end;
+
+procedure set_rp_code(f: internal_font_number; c: eight_bits; i: integer);
+begin
+ if pdf_font_rp_base[f] = 0 then
+ pdf_font_rp_base[f] := init_font_base(0);
+ pdf_mem[pdf_font_rp_base[f] + c] := fix_int(i, -1000, 1000);
+end;
+
+procedure set_ef_code(f: internal_font_number; c: eight_bits; i: integer);
+begin
+ if pdf_font_ef_base[f] = 0 then
+ pdf_font_ef_base[f] := init_font_base(1000);
+ pdf_mem[pdf_font_ef_base[f] + c] := fix_int(i, 0, 1000);
+end;
+
+function expand_font_name(f: internal_font_number; e: integer): str_number;
+var old_setting:0..max_selector; {holds |selector| setting}
+begin
+ old_setting:=selector; selector:=new_string;
+ print(font_name[f]);
+ if e > 0 then
+ print("+"); {minus sign will be printed by |print_int|}
+ print_int(e);
+ selector:=old_setting;
+ expand_font_name := make_string;
+end;
+
+function auto_expand_font(f: internal_font_number; e: integer): internal_font_number;
+{creates an expanded font from the base font; doesn't load expanded tfm at all}
+var k: internal_font_number;
+ nw, nk, ni, i, j: integer;
+begin
+ k := font_ptr + 1;
+ incr(font_ptr);
+ if (font_ptr >= font_max) then
+ overflow("maximum internal font number (font_max)", font_max);
+ font_name[k] := expand_font_name(f, e);
+ font_area[k] := font_area[f];
+ font_id_text(k) := font_id_text(f);
+ hyphen_char[k] := hyphen_char[f];
+ skew_char[k] := skew_char[f];
+ font_bchar[k] := font_bchar[f];
+ font_false_bchar[k] := font_false_bchar[f];
+ font_bc[k] := font_bc[f];
+ font_ec[k] := font_ec[f];
+ font_size[k] := font_size[f];
+ font_dsize[k] := font_dsize[f];
+ font_params[k] := font_params[f];
+ font_glue[k] := font_glue[f];
+ bchar_label[k] := bchar_label[f];
+
+ char_base[k] := char_base[f];
+ height_base[k] := height_base[f];
+ depth_base[k] := depth_base[f];
+ lig_kern_base[k] := lig_kern_base[f];
+ exten_base[k] := exten_base[f];
+ param_base[k] := param_base[f];
+
+ nw := height_base[f] - width_base[f];
+ ni := lig_kern_base[f] - italic_base[f];
+ nk := exten_base[f] - (kern_base[f] + kern_base_offset);
+ if (fmem_ptr + nw + ni + nk >= font_mem_size) then
+ overflow("number of words of font memory (font_mem_size)", font_mem_size);
+ width_base[k] := fmem_ptr;
+ italic_base[k] := width_base[k] + nw;
+ kern_base[k] := italic_base[k] + ni - kern_base_offset;
+ fmem_ptr := fmem_ptr + nw + ni + nk;
+
+ for i := 0 to nw - 1 do
+ font_info[width_base[k] + i].sc :=
+ round_xn_over_d(font_info[width_base[f] + i].sc, 1000 + e, 1000);
+ for i := 0 to ni - 1 do
+ font_info[italic_base[k] + i].sc :=
+ round_xn_over_d(font_info[italic_base[f] + i].sc, 1000 + e, 1000);
+ for i := 0 to nk - 1 do
+ font_info[kern_base[k] + kern_base_offset + i].sc :=
+ round_xn_over_d(font_info[kern_base[f] + kern_base_offset + i].sc, 1000 + e, 1000);
+
+ auto_expand_font := k;
+end;
+
+procedure set_expand_param(k, f: internal_font_number; e: integer);
+var i, j: integer;
+begin
+ if pdf_font_rp_base[f] = 0 then
+ pdf_font_rp_base[f] := init_font_base(0);
+ if pdf_font_lp_base[f] = 0 then
+ pdf_font_lp_base[f] := init_font_base(0);
+ if pdf_font_ef_base[f] = 0 then
+ pdf_font_ef_base[f] := init_font_base(1000);
+ pdf_font_expand_ratio[k] := e;
+ pdf_font_step[k] := pdf_font_step[f];
+ pdf_font_auto_expand[k] := pdf_font_auto_expand[f];
+ pdf_font_blink[k] := f; {???}
+ pdf_font_lp_base[k] := pdf_font_lp_base[f];
+ pdf_font_rp_base[k] := pdf_font_rp_base[f];
+ pdf_font_ef_base[k] := pdf_font_ef_base[f];
+end;
+
+function tfm_lookup(s: str_number; fs: scaled): internal_font_number;
+{looks up for a TFM with name |s| loaded at |fs| size; if found then flushes |s|}
+var k: internal_font_number;
+begin
+ if fs <> 0 then begin
+ for k := font_base + 1 to font_ptr do
+ if str_eq_str(font_name[k], s) and (font_size[k] = fs) then begin
+ flush_str(s);
+ tfm_lookup := k;
+ return;
+ end;
+ end
+ else begin
+ for k := font_base + 1 to font_ptr do
+ if str_eq_str(font_name[k], s) then begin
+ flush_str(s);
+ tfm_lookup := k;
+ return;
+ end;
+ end;
+ tfm_lookup := null_font;
+end;
+
+function load_expand_font(f: internal_font_number; e: integer): internal_font_number;
+{loads font |f| expanded by |e| thousandths into font memory; |e| is nonzero
+and is a multiple of |pdf_font_step[f]|}
+label found;
+var s: str_number; {font name}
+ k: internal_font_number;
+begin
+ s := expand_font_name(f, e);
+ k := tfm_lookup(s, font_size[f]);
+ if k = null_font then begin
+ if pdf_font_auto_expand[f] then
+ k := auto_expand_font(f, e)
+ else
+ k := read_font_info(null_cs, s, "", font_size[f]);
+ end;
+ set_expand_param(k, f, e);
+ load_expand_font := k;
+end;
+
+function auto_expand_vf(f: internal_font_number): boolean;
+{check for a virtual auto-expanded font}
+var save_f, bf, lf, k: internal_font_number;
+ e: integer;
+begin
+ auto_expand_vf := false;
+ if (not pdf_font_auto_expand[f]) or (pdf_font_blink[f] = null_font) then
+ return; {not an auto-expanded font}
+ bf := pdf_font_blink[f];
+ if pdf_font_type[bf] = new_font_type then {we must process the base font first}
+ begin
+ save_f := tmp_f;
+ tmp_f := bf;
+ do_vf;
+ tmp_f := save_f;
+ end;
+
+ if pdf_font_type[bf] <> virtual_font_type then
+ return; {not a virtual font}
+
+ e := pdf_font_expand_ratio[f];
+ for k := 0 to vf_local_font_num[bf] - 1 do begin
+ lf := vf_default_font[bf] + k;
+ vf_e_fnts[vf_nf] := vf_e_fnts[lf];
+ vf_i_fnts[vf_nf] := auto_expand_font(vf_i_fnts[lf], e);
+ set_expand_param(vf_i_fnts[vf_nf], vf_i_fnts[lf], e);
+ incr(vf_nf);
+ end;
+ vf_packet_base[f] := vf_packet_base[bf];
+ vf_local_font_num[f] := vf_local_font_num[bf];
+ vf_default_font[f] := vf_nf - vf_local_font_num[f];
+
+ pdf_font_type[f] := virtual_font_type;
+ auto_expand_vf := true;
+end;
+
+function fix_expand_value(f: internal_font_number; e: integer): integer;
+{return the multiple of |pdf_font_step[f]| that is nearest to |e|}
+var step: integer;
+ max_expand: integer;
+ neg: boolean;
+begin
+ fix_expand_value := 0;
+ if e = 0 then
+ return;
+ if e < 0 then begin
+ e := -e;
+ neg := true;
+ max_expand := -pdf_font_expand_ratio[pdf_font_shrink[f]];
+ end
+ else begin
+ neg := false;
+ max_expand := pdf_font_expand_ratio[pdf_font_stretch[f]];
+ end;
+ if e > max_expand then
+ e := max_expand
+ else begin
+ step := pdf_font_step[f];
+ if e mod step > 0 then
+ e := step*round_xn_over_d(e, 1, step);
+ end;
+ if neg then
+ e := -e;
+ fix_expand_value := e;
+end;
+
+function get_expand_font(f: internal_font_number; e: integer): internal_font_number;
+{look up and create if not found an expanded version of |f|; |f| is an
+expandable font; |e| is nonzero and is a multiple of |pdf_font_step[f]|}
+var k: internal_font_number;
+begin
+ k := pdf_font_elink[f];
+ while k <> null_font do begin
+ if pdf_font_expand_ratio[k] = e then begin
+ get_expand_font := k;
+ return;
+ end;
+ k := pdf_font_elink[k];
+ end;
+ k := load_expand_font(f, e);
+ pdf_font_elink[k] := pdf_font_elink[f];
+ pdf_font_elink[f] := k;
+ get_expand_font := k;
+end;
+
+function expand_font(f: internal_font_number; e: integer): internal_font_number;
+{looks up for font |f| expanded by |e| thousandths, |e| is an arbitrary value
+between max stretch and max shrink of |f|; if not found then creates it}
+var max_expand: integer;
+begin
+ expand_font := f;
+ if e = 0 then
+ return;
+ e := fix_expand_value(f, e);
+ if e = 0 then
+ return;
+ if pdf_font_elink[f] = null_font then
+ pdf_error("font expansion", "uninitialized pdf_font_elink");
+ expand_font := get_expand_font(f, e);
+end;
+
+procedure read_expand_font; {read font expansion spec and load expanded font}
+var font_shrink, font_stretch, font_step: integer;
+ f: internal_font_number;
+ auto_expand: boolean;
+begin
+ {read font expansion parameters}
+ scan_font_ident;
+ f := cur_val;
+ if f = null_font then
+ pdf_error("font expansion", "invalid font identifier");
+ scan_optional_equals;
+ scan_int;
+ font_stretch := fix_int(cur_val, 0, 1000);
+ scan_int;
+ font_shrink := fix_int(cur_val, 0, 1000);
+ scan_int;
+ font_step := fix_int(cur_val, 0, 1000);
+ if font_step = 0 then
+ pdf_error("font expansion", "invalid step");
+ font_stretch := font_stretch - font_stretch mod font_step;
+ if font_stretch < 0 then
+ font_stretch := 0;
+ font_shrink := font_shrink - font_shrink mod font_step;
+ if font_shrink < 0 then
+ font_shrink := 0;
+ if font_shrink = 1000 then
+ font_shrink := font_shrink - font_step; {don't allow zero-width font}
+ if (font_stretch = 0) and (font_shrink = 0) then
+ pdf_error("font expansion", "invalid limit");
+ auto_expand := false;
+ if scan_keyword("autoexpand") then begin
+ auto_expand := true;
+ @<Scan an optional space@>; end;
+
+ {check if the font can be expanded}
+ if (pdf_font_expand_ratio[f] <> 0) then
+ pdf_error("font expansion", "this font has been expanded by another font so it cannot be used now");
+ if (pdf_font_step[f] <> 0) then
+ {this font has been expanded, ensure the expansion parameters are identical}
+ begin
+ if (pdf_font_step[f] <> font_step) or
+ ((pdf_font_stretch[f] = null_font) and (font_stretch <> 0)) or
+ ((pdf_font_stretch[f] <> null_font) and
+ (pdf_font_expand_ratio[pdf_font_stretch[f]] <> font_stretch)) or
+ ((pdf_font_shrink[f] = null_font) and (font_shrink <> 0)) or
+ ((pdf_font_shrink[f] <> null_font) and
+ (pdf_font_expand_ratio[pdf_font_shrink[f]] <> -font_shrink)) or
+ (pdf_font_auto_expand[f] <> auto_expand)
+ then
+ pdf_error("font expansion", "font has been expanded with different parameters");
+ end
+ else begin
+ pdf_font_step[f] := font_step;
+ pdf_font_auto_expand[f] := auto_expand;
+ if font_stretch > 0 then
+ pdf_font_stretch[f] := get_expand_font(f, font_stretch);
+ if font_shrink > 0 then
+ pdf_font_shrink[f] := get_expand_font(f, -font_shrink);
+ end;
+end;
+@z
+
+@x [32f] - margin kerning
+glue_node: @<(\pdfTeX) Move right or output leaders@>;
+@y
+glue_node: @<(\pdfTeX) Move right or output leaders@>;
+margin_kern_node,
+@z
+
+@x [649] - font expansion
+@ Here now is |hpack|, which contains few if any surprises.
+
+@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+@y
+@ @<Glob...@>=
+@!pdf_font_blink: ^internal_font_number; {link to base font (used for expanded fonts only)}
+@!pdf_font_elink: ^internal_font_number; {link to expanded fonts (used for base fonts only)}
+@!pdf_font_stretch: ^integer; {limit of stretching}
+@!pdf_font_shrink: ^integer; {limit of shrinking}
+@!pdf_font_step: ^integer; {amount of one step of expansion}
+@!pdf_font_expand_ratio: ^integer; {expansion ratio of a particular font}
+@!pdf_font_auto_expand: ^boolean; {this font is auto-expanded?}
+@!pdf_font_lp_base: ^integer; {base of left-protruding factor}
+@!pdf_font_rp_base: ^integer; {base of right-protruding factor}
+@!pdf_font_ef_base: ^integer; {base of font expansion factor}
+@!font_expand_ratio: integer; {current expansion ratio}
+@!last_leftmost_char: pointer;
+@!last_rightmost_char: pointer;
+@!hlist_stack:array[0..max_hlist_stack] of pointer; {stack for |find_protchar_left()| and |find_protchar_right()|}
+@!hlist_stack_level:0..max_hlist_stack; {fill level for |hlist_stack|}
+
+@ @d cal_margin_kern_var(#) ==
+begin
+ character(cp) := character(#);
+ font(cp) := font(#);
+ do_subst_font(cp, 1000);
+ if font(cp) <> font(#) then
+ margin_kern_stretch := margin_kern_stretch + left_pw(#) - left_pw(cp);
+ font(cp) := font(#);
+ do_subst_font(cp, -1000);
+ if font(cp) <> font(#) then
+ margin_kern_shrink := margin_kern_shrink + left_pw(cp) - left_pw(#);
+end
+
+@<Calculate variations of marginal kerns@>=
+begin
+ lp := last_leftmost_char;
+ rp := last_rightmost_char;
+ fast_get_avail(cp);
+ if lp <> null then
+ cal_margin_kern_var(lp);
+ if rp <> null then
+ cal_margin_kern_var(rp);
+ free_avail(cp);
+end
+
+@ Here is |hpack|, which is place where we do font substituting when
+font expansion is being used. We define some constants used when calling
+|hpack| to deal with font expansion.
+
+@d cal_expand_ratio == 2 {calculate amount for font expansion after breaking
+ paragraph into lines}
+@d subst_ex_font == 3 {substitute fonts}
+
+@d substituted = 3 {|subtype| of kern nodes that should be substituted}
+
+@d left_pw(#) == char_pw(#, left_side)
+@d right_pw(#) == char_pw(#, right_side)
+
+@p
+function check_expand_pars(f: internal_font_number): boolean;
+var k: internal_font_number;
+begin
+ check_expand_pars := false;
+ if (pdf_font_step[f] = 0) or ((pdf_font_stretch[f] = null_font) and
+ (pdf_font_shrink[f] = null_font)) then
+ return;
+ if cur_font_step < 0 then
+ cur_font_step := pdf_font_step[f]
+ else if cur_font_step <> pdf_font_step[f] then
+ pdf_error("font expansion", "using fonts with different step of expansion in one paragraph is not allowed");
+ k := pdf_font_stretch[f];
+ if k <> null_font then begin
+ if max_stretch_ratio < 0 then
+ max_stretch_ratio := pdf_font_expand_ratio[k]
+ else if max_stretch_ratio <> pdf_font_expand_ratio[k] then
+ pdf_error("font expansion", "using fonts with different limit of expansion in one paragraph is not allowed");
+ end;
+ k := pdf_font_shrink[f];
+ if k <> null_font then begin
+ if max_shrink_ratio < 0 then
+ max_shrink_ratio := pdf_font_expand_ratio[k]
+ else if max_shrink_ratio <> pdf_font_expand_ratio[k] then
+ pdf_error("font expansion", "using fonts with different limit of expansion in one paragraph is not allowed");
+ end;
+ check_expand_pars := true;
+end;
+
+function char_stretch(f: internal_font_number; c: eight_bits): scaled;
+var k: internal_font_number;
+ dw: scaled;
+ ef: integer;
+begin
+ char_stretch := 0;
+ k := pdf_font_stretch[f];
+ ef := get_ef_code(f, c);
+ if (k <> null_font) and (ef > 0) then begin
+ dw := char_width(k)(char_info(k)(c)) - char_width(f)(char_info(f)(c));
+ if dw > 0 then
+ char_stretch := round_xn_over_d(dw, ef, 1000);
+ end;
+end;
+
+function char_shrink(f: internal_font_number; c: eight_bits): scaled;
+var k: internal_font_number;
+ dw: scaled;
+ ef: integer;
+begin
+ char_shrink := 0;
+ k := pdf_font_shrink[f];
+ ef := get_ef_code(f, c);
+ if (k <> null_font) and (ef > 0) then begin
+ dw := char_width(f)(char_info(f)(c)) - char_width(k)(char_info(k)(c));
+ if dw > 0 then
+ char_shrink := round_xn_over_d(dw, ef, 1000);
+ end;
+end;
+
+function get_kern(f: internal_font_number; lc, rc: eight_bits): scaled;
+label continue;
+var i: four_quarters;
+ j: four_quarters;
+ k: font_index;
+ p: pointer;
+ s: integer;
+begin
+ get_kern := 0;
+ i := char_info(f)(lc);
+ if char_tag(i) <> lig_tag then
+ return;
+ k := lig_kern_start(f)(i);
+ j := font_info[k].qqqq;
+ if skip_byte(j) <= stop_flag then
+ goto continue + 1;
+ k := lig_kern_restart(f)(j);
+continue:
+ j := font_info[k].qqqq;
+continue + 1:
+ if (next_char(j) = rc) and (skip_byte(j) <= stop_flag) and
+ (op_byte(j) >= kern_flag)
+ then begin
+ get_kern := char_kern(f)(j);
+ return;
+ end;
+ if skip_byte(j) = qi(0) then
+ incr(k)
+ else begin
+ if skip_byte(j) >= stop_flag then
+ return;
+ k := k + qo(skip_byte(j)) + 1;
+ end;
+ goto continue;
+end;
+
+function kern_stretch(p: pointer): scaled;
+var l, r: pointer;
+ d: scaled;
+begin
+ kern_stretch := 0;
+ if (prev_char_p = null) or (link(prev_char_p) <> p) or (link(p) = null)
+ then
+ return;
+ l := prev_char_p;
+ r := link(p);
+ if type(l) = ligature_node then
+ l := lig_char(l);
+ if type(r) = ligature_node then
+ r := lig_char(r);
+ if not (is_char_node(l) and is_char_node(r) and
+ (font(l) = font(r)) and
+ (pdf_font_stretch[font(l)] <> null_font))
+ then
+ return;
+ d := get_kern(pdf_font_stretch[font(l)], character(l), character(r));
+ kern_stretch := round_xn_over_d(d - width(p),
+ get_ef_code(font(l), character(l)), 1000);
+end;
+
+function kern_shrink(p: pointer): scaled;
+var l, r: pointer;
+ d: scaled;
+begin
+ kern_shrink := 0;
+ if (prev_char_p = null) or (link(prev_char_p) <> p) or (link(p) = null)
+ then
+ return;
+ l := prev_char_p;
+ r := link(p);
+ if type(l) = ligature_node then
+ l := lig_char(l);
+ if type(r) = ligature_node then
+ r := lig_char(r);
+ if not (is_char_node(l) and is_char_node(r) and
+ (font(l) = font(r)) and
+ (pdf_font_shrink[font(l)] <> null_font))
+ then
+ return;
+ d := get_kern(pdf_font_shrink[font(l)], character(l), character(r));
+ kern_shrink := round_xn_over_d(width(p) - d,
+ get_ef_code(font(l), character(l)), 1000);
+end;
+
+procedure do_subst_font(p: pointer; ex_ratio: integer);
+var f, k: internal_font_number;
+ r: pointer;
+ ef: integer;
+begin
+ if not is_char_node(p) and (type(p) = disc_node) then begin
+ r := pre_break(p);
+ while r <> null do begin
+ if is_char_node(r) or (type(r) = ligature_node) then
+ do_subst_font(r, ex_ratio);
+ r := link(r);
+ end;
+ r := post_break(p);
+ while r <> null do begin
+ if is_char_node(r) or (type(r) = ligature_node) then
+ do_subst_font(r, ex_ratio);
+ r := link(r);
+ end;
+ return;
+ end;
+ if is_char_node(p) then
+ r := p
+ else if type(p) = ligature_node then
+ r := lig_char(p)
+ else begin
+ {|short_display_n(p, 5);|}
+ pdf_error("font expansion", "invalid node type");
+ end;
+ f := font(r);
+ ef := get_ef_code(f, character(r));
+ if ef = 0 then
+ return;
+ if (pdf_font_stretch[f] <> null_font) and (ex_ratio > 0) then
+ k := expand_font(f, divide_scaled(ex_ratio*
+ pdf_font_expand_ratio[pdf_font_stretch[f]]*ef,
+ 1000000, 0))
+ else if (pdf_font_shrink[f] <> null_font) and (ex_ratio < 0) then
+ k := expand_font(f, -divide_scaled(ex_ratio*
+ pdf_font_expand_ratio[pdf_font_shrink[f]]*ef,
+ 1000000, 0))
+ else
+ k := f;
+ if k <> f then begin
+ font(r) := k;
+ if not is_char_node(p) then begin
+ r := lig_ptr(p);
+ while r <> null do begin
+ font(r) := k;
+ r := link(r);
+ end;
+ end;
+ end;
+end;
+
+function char_pw(p: pointer; side: small_number): scaled;
+var f: internal_font_number;
+ c: integer;
+begin
+ char_pw := 0;
+ if side = left_side then
+ last_leftmost_char := null
+ else
+ last_rightmost_char := null;
+ if p = null then
+ return;
+ if not is_char_node(p) then begin
+ if type(p) = ligature_node then
+ p := lig_char(p)
+ else
+ return;
+ end;
+ f := font(p);
+ if side = left_side then begin
+ c := get_lp_code(f, character(p));
+ last_leftmost_char := p;
+ end
+ else begin
+ c := get_rp_code(f, character(p));
+ last_rightmost_char := p;
+ end;
+ if c = 0 then
+ return;
+ char_pw :=
+ round_xn_over_d(quad(f), c, 1000);
+end;
+
+function new_margin_kern(w: scaled; p: pointer; side: small_number): pointer;
+var k: pointer;
+begin
+ k := get_node(margin_kern_node_size);
+ type(k) := margin_kern_node;
+ subtype(k) := side;
+ width(k) := w;
+ if p = null then
+ pdf_error("margin kerning", "invalid pointer to marginal char node");
+ fast_get_avail(margin_char(k));
+ character(margin_char(k)) := character(p);
+ font(margin_char(k)) := font(p);
+ new_margin_kern := k;
+end;
+
+function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+@z
+
+@x [649] - font expansion
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+subtype(r):=min_quarterword; shift_amount(r):=0;
+q:=r+list_offset; link(q):=p;@/
+@y
+font_stretch: scaled;
+font_shrink: scaled;
+k: scaled;
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+subtype(r):=min_quarterword; shift_amount(r):=0;
+q:=r+list_offset; link(q):=p;@/
+if m = cal_expand_ratio then begin
+ prev_char_p := null;
+ font_stretch := 0;
+ font_shrink := 0;
+ font_expand_ratio := 0;
+end;
+@z
+
+@x [649] - font expansion
+hpack:=r;
+@y
+if (m = cal_expand_ratio) and (font_expand_ratio <> 0) then begin
+ font_expand_ratio := fix_int(font_expand_ratio, -1000, 1000);
+ q := list_ptr(r);
+ free_node(r, box_node_size);
+ r := hpack(q, w, subst_ex_font);
+end;
+hpack:=r;
+@z
+
+@x [651] - font expansion
+ kern_node: x:=x+width(p);
+@y
+ margin_kern_node: begin
+ if m = cal_expand_ratio then begin
+ f := font(margin_char(p));
+ do_subst_font(margin_char(p), 1000);
+ if f <> font(margin_char(p)) then
+ font_stretch := font_stretch - width(p) -
+ char_pw(margin_char(p), subtype(p));
+ font(margin_char(p)) := f;
+ do_subst_font(margin_char(p), -1000);
+ if f <> font(margin_char(p)) then
+ font_shrink := font_shrink - width(p) -
+ char_pw(margin_char(p), subtype(p));
+ font(margin_char(p)) := f;
+ end
+ else if m = subst_ex_font then begin
+ do_subst_font(margin_char(p), font_expand_ratio);
+ width(p) := -char_pw(margin_char(p), subtype(p));
+ end;
+ x := x + width(p);
+ end;
+ kern_node: begin
+ if (m = cal_expand_ratio) and (subtype(p) = normal) then begin
+ k := kern_stretch(p);
+ if k <> 0 then begin
+ subtype(p) := substituted;
+ font_stretch := font_stretch + k;
+ end;
+ k := kern_shrink(p);
+ if k <> 0 then begin
+ subtype(p) := substituted;
+ font_shrink := font_shrink + k;
+ end;
+ end
+ else if (m = subst_ex_font) and (subtype(p) = substituted) then begin
+ if type(link(p)) = ligature_node then
+ width(p) := get_kern(font(prev_char_p),
+ character(prev_char_p),
+ character(lig_char(link(p))))
+ else
+ width(p) := get_kern(font(prev_char_p),
+ character(prev_char_p),
+ character(link(p)))
+ end;
+ x := x + width(p);
+ end;
+@z
+
+@x [651] - font expansion
+ ligature_node: @<Make node |p| look like a |char_node|
+ and |goto reswitch|@>;
+@y
+ ligature_node: begin
+ if m = subst_ex_font then
+ do_subst_font(p, font_expand_ratio);
+ @<Make node |p| look like a |char_node| and |goto reswitch|@>;
+ end;
+ disc_node:
+ if m = subst_ex_font then
+ do_subst_font(p, font_expand_ratio);
+@z
+
+@x [654] - font expansion
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+@y
+begin
+if m >= cal_expand_ratio then begin
+ prev_char_p := p;
+ case m of
+ cal_expand_ratio: begin
+ f := font(p);
+ add_char_stretch(font_stretch)(character(p));
+ add_char_shrink(font_shrink)(character(p));
+ end;
+ subst_ex_font:
+ do_subst_font(p, font_expand_ratio);
+ endcases;
+end;
+f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+@z
+
+@x [658] - font expansion
+@ @<Determine horizontal glue stretch setting...@>=
+begin @<Determine the stretch order@>;
+@y
+@ If |hpack| is called with |m=cal_expand_ratio| we calculate
+|font_expand_ratio| and return without checking for overfull or underfull box.
+
+@<Determine horizontal glue stretch setting...@>=
+begin @<Determine the stretch order@>;
+if (m = cal_expand_ratio) and (o = normal) and (font_stretch > 0) then begin
+ font_expand_ratio := divide_scaled(x, font_stretch, 3);
+ return;
+end;
+@z
+
+@x [664] - font expansion
+@ @<Determine horizontal glue shrink setting...@>=
+begin @<Determine the shrink order@>;
+@y
+@ @<Determine horizontal glue shrink setting...@>=
+begin @<Determine the shrink order@>;
+if (m = cal_expand_ratio) and (o = normal) and (font_shrink > 0) then begin
+ font_expand_ratio := divide_scaled(x, font_shrink, 3);
+ return;
+end;
+@z
+
+@x [822] - font expansion
+@d delta_node_size=7 {number of words in a delta node}
+@y
+@d delta_node_size=9 {number of words in a delta node}
+@z
+
+@x [823] - font expansion, margin kerning, avoiding overfull boxes
+@<Glo...@>=
+@!active_width:array[1..6] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..6] of scaled; {distance from current active node}
+@!background:array[1..6] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..6] of scaled; {length being computed after current break}
+@y
+@d do_seven_eight(#) == if pdf_adjust_spacing > 1 then begin #(7);#(8); end
+@d do_all_eight(#) == do_all_six(#); do_seven_eight(#)
+@d do_one_seven_eight(#) == #(1); do_seven_eight(#)
+
+@d total_font_stretch == cur_active_width[7]
+@d total_font_shrink == cur_active_width[8]
+
+@d save_active_width(#) == prev_active_width[#] := active_width[#]
+@d restore_active_width(#) == active_width[#] := prev_active_width[#]
+
+@<Glo...@>=
+@!active_width:array[1..8] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..8] of scaled; {distance from current active node}
+@!background:array[1..8] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..8] of scaled; {length being computed after current break}
+@#
+@!auto_breaking: boolean; {make |auto_breaking| accessible out of |line_break|}
+@!prev_p: pointer; {make |prev_p| accessible out of |line_break|}
+@!first_p: pointer; {to access the first node of the paragraph}
+@!prev_char_p: pointer; {pointer to the previous char of an implicit kern}
+@!next_char_p: pointer; {pointer to the next char of an implicit kern}
+@#
+@!try_prev_break: boolean; {force break at the previous legal breakpoint?}
+@!prev_legal: pointer; {the previous legal breakpoint}
+@!prev_prev_legal: pointer; {to save |prev_p| corresponding to |prev_legal|}
+@!prev_auto_breaking: boolean; {to save |auto_breaking| corresponding to |prev_legal|}
+@!prev_active_width: array[1..8] of scaled; {to save |active_width| corresponding to |prev_legal|}
+@!rejected_cur_p: pointer; {the last |cur_p| that has been rejected}
+@!before_rejected_cur_p: boolean; {|cur_p| is still before |rejected_cur_p|?}
+@#
+@!max_stretch_ratio: integer; {maximal stretch ratio of expanded fonts}
+@!max_shrink_ratio: integer; {maximal shrink ratio of expanded fonts}
+@!cur_font_step: integer; {the current step of expanded fonts}
+@z
+
+@x [827] - font expansion
+background[6]:=shrink(q)+shrink(r);
+@y
+background[6]:=shrink(q)+shrink(r);
+if pdf_adjust_spacing > 1 then begin
+ background[7] := 0;
+ background[8] := 0;
+ max_stretch_ratio := -1;
+ max_shrink_ratio := -1;
+ cur_font_step := -1;
+ prev_char_p := null;
+end;
+@z
+
+@x [829] - margin kerning
+@<Declare subprocedures for |line_break|@>=
+procedure try_break(@!pi:integer;@!break_type:small_number);
+@y
+@d cp_skipable(#) == {skipable nodes at the margins during character protrusion}
+(
+ not is_char_node(#) and
+ (
+ (type(#) = ins_node)
+ or (type(#) = mark_node)
+ or (type(#) = adjust_node)
+ or (type(#) = penalty_node)
+ or ((type(#) = whatsit_node) and
+ (subtype(#) <> pdf_refximage_node) and
+ (subtype(#) <> pdf_refxform_node)) {reference to an image or XObject form}
+ or ((type(#) = disc_node) and
+ (pre_break(#) = null) and
+ (post_break(#) = null) and
+ (replace_count(#) = 0)) {an empty |disc_node|}
+ or ((type(#) = math_node) and (width(#) = 0))
+ or ((type(#) = kern_node) and
+ ((width(#) = 0) or (subtype(#) = normal)))
+ or ((type(#) = glue_node) and (glue_ptr(#) = zero_glue))
+ or ((type(#) = hlist_node) and (width(#) = 0) and (height(#) = 0) and
+ (depth(#) = 0) and (list_ptr(#) = null))
+ )
+)
+
+
+@<Declare subprocedures for |line_break|@>=
+procedure push_node(p: pointer);
+begin
+ if hlist_stack_level > max_hlist_stack then
+ pdf_error("push_node", "stack overflow");
+ hlist_stack[hlist_stack_level] := p;
+ hlist_stack_level := hlist_stack_level + 1;
+end;
+
+function pop_node: pointer;
+begin
+ hlist_stack_level := hlist_stack_level - 1;
+ if hlist_stack_level < 0 then {would point to some bug}
+ pdf_error("pop_node", "stack underflow (internal error)");
+ pop_node := hlist_stack[hlist_stack_level];
+end;
+
+function find_protchar_left(l: pointer; d: boolean): pointer;
+{searches left to right from list head |l|, returns 1st non-skipable item}
+var t: pointer;
+ run: boolean;
+begin
+ if (link(l) <> null) and (type(l) = hlist_node) and (width(l) = 0)
+ and (height(l) = 0) and (depth(l) = 0) and (list_ptr(l) = null) then
+ l := link(l) {for paragraph start with \.{\\parindent = 0pt}}
+ else if d then
+ while (link(l) <> null) and (not (is_char_node(l) or non_discardable(l))) do
+ l := link(l); {std.\ discardables at line break, \TeX book, p 95}
+ hlist_stack_level := 0;
+ run := true;
+ repeat
+ t := l;
+ while run and (type(l) = hlist_node) and (list_ptr(l) <> null) do begin
+ push_node(l);
+ l := list_ptr(l);
+ end;
+ while run and cp_skipable(l) do begin
+ while (link(l) = null) and (hlist_stack_level > 0) do begin
+ l := pop_node; {don't visit this node again}
+ end;
+ if link(l) <> null then
+ l := link(l)
+ else if hlist_stack_level = 0 then run := false
+ end;
+ until t = l;
+ find_protchar_left := l;
+end;
+
+function find_protchar_right(l, r: pointer): pointer;
+{searches right to left from list tail |r| to head |l|, returns 1st non-skipable item}
+var t: pointer;
+ run: boolean;
+begin
+ find_protchar_right := null;
+ if r = null then return;
+ hlist_stack_level := 0;
+ run := true;
+ repeat
+ t := r;
+ while run and (type(r) = hlist_node) and (list_ptr(r) <> null) do begin
+ push_node(l);
+ push_node(r);
+ l := list_ptr(r);
+ r := l;
+ while link(r) <> null do
+ r := link(r);
+ end;
+ while run and cp_skipable(r) do begin
+ while (r = l) and (hlist_stack_level > 0) do begin
+ r := pop_node; {don't visit this node again}
+ l := pop_node;
+ end;
+ if (r <> l) and (r <> null) then
+ r := prev_rightmost(l, r)
+ else if (r = l) and (hlist_stack_level = 0) then run := false
+ end;
+ until t = r;
+ find_protchar_right := r;
+end;
+
+function total_pw(q, p: pointer): scaled;
+{returns the total width of character protrusion of a line;
+|cur_break(break_node(q))| and |p| is the leftmost resp. rightmost node in the
+horizontal list representing the actual line}
+var l, r, s: pointer;
+ n: integer;
+begin
+ if break_node(q) = null then
+ l := first_p
+ else
+ l := cur_break(break_node(q));
+ r := prev_rightmost(prev_p, p); {get |link(r)=p|}
+ {let's look at the right margin first}
+ {|
+ short_display_n(r, 2);
+ print("&");
+ short_display_n(p, 2);
+ print_ln;
+ |}
+ if (p <> null) and (type(p) = disc_node) and (pre_break(p) <> null) then
+ {a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break|}
+ begin
+ r := pre_break(p);
+ while link(r) <> null do
+ r := link(r);
+ end else r := find_protchar_right(l, r);
+ {now the left margin}
+ {|
+ short_display_n(l, 2);
+ print_ln;
+ breadth_max := 10;
+ depth_threshold := 2;
+ show_node_list(l);
+ print_ln;
+ |}
+ if (l <> null) and (type(l) = disc_node) then begin
+ if post_break(l) <> null then begin
+ l := post_break(l); {protrude the first char}
+ goto done;
+ end else {discard |replace_count(l)| nodes}
+ begin
+ n := replace_count(l);
+ l := link(l);
+ while n > 0 do begin
+ if link(l) <> null then
+ l := link(l);
+ decr(n);
+ end;
+ end;
+ end;
+ l := find_protchar_left(l, true);
+done:
+ total_pw := left_pw(l) + right_pw(r);
+end;
+
+procedure try_break(@!pi:integer;@!break_type:small_number);
+@z
+
+@x
+var r:pointer; {runs through the active list}
+@y
+var r:pointer; {runs through the active list}
+@!margin_kern_stretch: scaled;
+@!margin_kern_shrink: scaled;
+@!lp, rp, cp: pointer;
+@z
+
+
+@x [829] - font expansion
+do_all_six(copy_to_cur_active);
+@y
+do_all_eight(copy_to_cur_active);
+@z
+
+@x [832] - font expansion
+ begin do_all_six(update_width);
+@y
+ begin do_all_eight(update_width);
+@z
+
+@x [837] - font expansion
+begin no_break_yet:=false; do_all_six(set_break_width_to_background);
+@y
+begin no_break_yet:=false; do_all_eight(set_break_width_to_background);
+@z
+
+@x [839] - font expansion
+@<Glob...@>=
+@!disc_width:scaled; {the length of discretionary material preceding a break}
+@y
+@d reset_disc_width(#) == disc_width[#] := 0
+
+@d add_disc_width_to_break_width(#) ==
+ break_width[#] := break_width[#] + disc_width[#]
+
+@d add_disc_width_to_active_width(#) ==
+ active_width[#] := active_width[#] + disc_width[#]
+
+@d sub_disc_width_from_active_width(#) ==
+ active_width[#] := active_width[#] - disc_width[#]
+
+@d add_char_stretch_end(#) == char_stretch(f, #)
+@d add_char_stretch(#) == # := # + add_char_stretch_end
+
+@d add_char_shrink_end(#) == char_shrink(f, #)
+@d add_char_shrink(#) == # := # + add_char_shrink_end
+
+@d sub_char_stretch_end(#) == char_stretch(f, #)
+@d sub_char_stretch(#) == # := # - sub_char_stretch_end
+
+@d sub_char_shrink_end(#) == char_shrink(f, #)
+@d sub_char_shrink(#) == # := # - sub_char_shrink_end
+
+@d add_kern_stretch_end(#) == kern_stretch(#)
+@d add_kern_stretch(#) == # := # + add_kern_stretch_end
+
+@d add_kern_shrink_end(#) == kern_shrink(#)
+@d add_kern_shrink(#) == # := # + add_kern_shrink_end
+
+@d sub_kern_stretch_end(#) == kern_stretch(#)
+@d sub_kern_stretch(#) == # := # - sub_kern_stretch_end
+
+@d sub_kern_shrink_end(#) == kern_shrink(#)
+@d sub_kern_shrink(#) == # := # - sub_kern_shrink_end
+
+@<Glob...@>=
+@!disc_width: array[1..8] of scaled; {the length of discretionary material preceding a break}
+@z
+
+@x [840] - font expansion
+break_width[1]:=break_width[1]+disc_width;
+@y
+do_one_seven_eight(add_disc_width_to_break_width);
+@z
+
+@x [841] - font expansion
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+@y
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := v;
+ sub_char_stretch(break_width[7])(character(v));
+ sub_char_shrink(break_width[8])(character(v));
+ end;
+@z
+
+@x [841] - font expansion
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+@y
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := v;
+ sub_char_stretch(break_width[7])(character(lig_char(v)));
+ sub_char_shrink(break_width[8])(character(lig_char(v)));
+ end;
+@z
+
+@x [841] - font expansion
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]-width(v);
+@y
+ hlist_node,vlist_node,rule_node,kern_node: begin
+ break_width[1]:=break_width[1]-width(v);
+ if (type(v) = kern_node) and
+ (pdf_adjust_spacing > 1) and (subtype(v) = normal)
+ then begin
+ sub_kern_stretch(break_width[7])(v);
+ sub_kern_shrink(break_width[8])(v);
+ end;
+ end;
+@z
+
+@x [842] - font expansion
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+@y
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := s;
+ add_char_stretch(break_width[7])(character(s));
+ add_char_shrink(break_width[8])(character(s));
+ end;
+@z
+
+@x [842] - font expansion
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+@y
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := s;
+ add_char_stretch(break_width[7])(character(lig_char(s)));
+ add_char_shrink(break_width[8])(character(lig_char(s)));
+ end;
+@z
+
+@x [842] - font expansion
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]+width(s);
+@y
+ hlist_node,vlist_node,rule_node,kern_node: begin
+ break_width[1]:=break_width[1]+width(s);
+ if (type(s) = kern_node) and
+ (pdf_adjust_spacing > 1) and (subtype(s) = normal)
+ then begin
+ add_kern_stretch(break_width[7])(s);
+ add_kern_shrink(break_width[8])(s);
+ end;
+ end;
+@z
+
+@x [843] - font expansion
+ begin do_all_six(convert_to_break_width);
+@y
+ begin do_all_eight(convert_to_break_width);
+@z
+
+@x [843] - font expansion
+ begin do_all_six(store_break_width);
+@y
+ begin do_all_eight(store_break_width);
+@z
+
+@x [843] - font expansion
+ do_all_six(new_delta_to_break_width);
+@y
+ do_all_eight(new_delta_to_break_width);
+@z
+
+@x [844] - font expansion
+ do_all_six(new_delta_from_break_width);
+@y
+ do_all_eight(new_delta_from_break_width);
+@z
+
+@x [851] - font expansion, margin kerning
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+@y
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+
+{|
+if pdf_output > 2 then begin
+print_ln;
+if (r <> null) and (break_node(r) <> null) then
+ short_display_n(cur_break(break_node(r)), 5);
+print_ln;
+short_display_n(cur_p, 5);
+print_ln;
+end;
+|}
+
+if pdf_protrude_chars > 1 then
+ shortfall := shortfall + total_pw(r, cur_p);
+if (pdf_adjust_spacing > 1) and (shortfall <> 0) then begin
+ margin_kern_stretch := 0;
+ margin_kern_shrink := 0;
+ if pdf_protrude_chars > 1 then
+ @<Calculate variations of marginal kerns@>;
+ if (shortfall > 0) and ((total_font_stretch + margin_kern_stretch) > 0)
+ then begin
+ if (total_font_stretch + margin_kern_stretch) > shortfall then
+ shortfall := ((total_font_stretch + margin_kern_stretch) div
+ (max_stretch_ratio div cur_font_step)) div 2
+ else
+ shortfall := shortfall - (total_font_stretch + margin_kern_stretch);
+ end
+ else if (shortfall < 0) and ((total_font_shrink + margin_kern_shrink) > 0)
+ then begin
+ if (total_font_shrink + margin_kern_shrink) > -shortfall then
+ shortfall := -((total_font_shrink + margin_kern_shrink) div
+ (max_shrink_ratio div cur_font_step)) div 2
+ else
+ shortfall := shortfall + (total_font_shrink + margin_kern_shrink);
+ end;
+end;
+@z
+
+@x [860] - font expansion
+ begin do_all_six(downdate_width);
+@y
+ begin do_all_eight(downdate_width);
+@z
+
+@x [860] - font expansion
+ begin do_all_six(update_width);
+ do_all_six(combine_two_deltas);
+@y
+ begin do_all_eight(update_width);
+ do_all_eight(combine_two_deltas);
+@z
+
+@x [861] - font expansion
+ begin do_all_six(update_active);
+ do_all_six(copy_to_cur_active);
+@y
+ begin do_all_eight(update_active);
+ do_all_eight(copy_to_cur_active);
+@z
+
+@x [862] - margin kerning, avoiding overfull boxes
+@!auto_breaking:boolean; {is node |cur_p| outside a formula?}
+@!prev_p:pointer; {helps to determine when glue nodes are breakpoints}
+@y
+@z
+
+@x [863] - margin kerning, avoiding overfull boxes
+ while (cur_p<>null)and(link(active)<>last_active) do
+@y
+ prev_char_p := null;
+ prev_legal := null;
+ rejected_cur_p := null;
+ try_prev_break := false;
+ before_rejected_cur_p := false;
+ first_p := cur_p; {to access the first node of paragraph as the first active
+ node has |break_node=null|}
+ while (cur_p<>null)and(link(active)<>last_active) do
+@z
+
+@x [864] - font expansion
+do_all_six(store_background);@/
+@y
+do_all_eight(store_background);@/
+@z
+
+@x [666] - font expansion
+ else act_width:=act_width+width(cur_p);
+@y
+ else begin
+ act_width:=act_width+width(cur_p);
+ if (pdf_adjust_spacing > 1) and (subtype(cur_p) = normal) then begin
+ add_kern_stretch(active_width[7])(cur_p);
+ add_kern_shrink(active_width[8])(cur_p);
+ end;
+ end;
+@z
+
+@x [866] - font expansion
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+@y
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+ if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := cur_p;
+ add_char_stretch(active_width[7])(character(lig_char(cur_p)));
+ add_char_shrink(active_width[8])(character(lig_char(cur_p)));
+ end;
+@z
+
+@x [867] - font expansion
+act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+@y
+act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := cur_p;
+ add_char_stretch(active_width[7])(character(cur_p));
+ add_char_shrink(active_width[8])(character(cur_p));
+end;
+@z
+
+@x [869] - font expansion
+begin s:=pre_break(cur_p); disc_width:=0;
+@y
+begin s:=pre_break(cur_p);
+do_one_seven_eight(reset_disc_width);
+@z
+
+@x [869] - font expansion
+ act_width:=act_width+disc_width;
+ try_break(hyphen_penalty,hyphenated);
+ act_width:=act_width-disc_width;
+@y
+ do_one_seven_eight(add_disc_width_to_active_width);
+ try_break(hyphen_penalty,hyphenated);
+ do_one_seven_eight(sub_disc_width_from_active_width);
+@z
+
+@x [870] - font expansion
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+@y
+ disc_width[1]:=disc_width[1]+char_width(f)(char_info(f)(character(s)));
+ if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := s;
+ add_char_stretch(disc_width[7])(character(s));
+ add_char_shrink(disc_width[8])(character(s));
+ end;
+@z
+
+@x [870] - font expansion
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+@y
+ disc_width[1]:=disc_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := s;
+ add_char_stretch(disc_width[7])(character(lig_char(s)));
+ add_char_shrink(disc_width[8])(character(lig_char(s)));
+ end;
+@z
+
+@x [870] - font expansion
+ hlist_node,vlist_node,rule_node,kern_node:
+ disc_width:=disc_width+width(s);
+@y
+ hlist_node,vlist_node,rule_node,kern_node: begin
+ disc_width[1]:=disc_width[1]+width(s);
+ if (type(s) = kern_node) and
+ (pdf_adjust_spacing > 1) and (subtype(s) = normal)
+ then begin
+ add_kern_stretch(disc_width[7])(s);
+ add_kern_shrink(disc_width[8])(s);
+ end;
+ end;
+@z
+
+@x [871] - font expansion
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+@y
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := s;
+ add_char_stretch(active_width[7])(character(s));
+ add_char_shrink(active_width[8])(character(s));
+ end;
+@z
+
+@x [871] - font expansion
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+@y
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
+ prev_char_p := s;
+ add_char_stretch(active_width[7])(character(lig_char(s)));
+ add_char_shrink(active_width[8])(character(lig_char(s)));
+ end;
+@z
+
+@x [871] - font expansion
+ hlist_node,vlist_node,rule_node,kern_node:
+ act_width:=act_width+width(s);
+@y
+ hlist_node,vlist_node,rule_node,kern_node: begin
+ act_width:=act_width+width(s);
+ if (type(s) = kern_node) and
+ (pdf_adjust_spacing > 1) and (subtype(s) = normal)
+ then begin
+ add_kern_stretch(active_width[7])(s);
+ add_kern_shrink(active_width[8])(s);
+ end;
+ end;
+@z
+
+@x [877] - margin kerning
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@y
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+ p, k: pointer;
+ w: scaled;
+ glue_break: boolean; {was a break at glue?}
+ ptmp: pointer;
+@z
+
+@x [881] - margin kerning
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+@y
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+glue_break := false;
+@z
+
+@x [881] - margin kerning
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+@y
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ glue_break := true;
+ goto done;
+@z
+
+@x [881] - margin kerning
+@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+done:
+@y
+done:
+
+{at this point |q| is the rightmost breakpoint; the only exception is the case
+of a discretionary break with non-empty |pre_break|, then |q| has been changed
+to the last node of the |pre_break| list}
+
+if pdf_protrude_chars > 0 then begin
+ if disc_break and (is_char_node(q) or (type(q) <> disc_node))
+ {|q| has been reset to the last node of |pre_break|}
+ then begin
+ p := q;
+ ptmp := p;
+ end else begin
+ p := prev_rightmost(temp_head, q); {get |link(p) = q|}
+ ptmp := p;
+ p := find_protchar_right(temp_head, p);
+ end;
+ {|
+ short_display_n(p, 1);
+ print_ln;
+ |}
+ w := right_pw(p);
+ if w <> 0 then {we have found a marginal kern, append it after |ptmp|}
+ begin
+ k := new_margin_kern(-w, last_rightmost_char, right_side);
+ link(k) := link(ptmp);
+ link(ptmp) := k;
+ if (ptmp = q) then
+ q := link(q);
+ end;
+end;
+
+{if |q| was not a breakpoint at glue and has been reset to |rightskip| then
+ we append |rightskip| after |q| now}
+if not glue_break then begin
+ @<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+end;
+@z
+
+@x [887] - margin kerning
+if left_skip<>zero_glue then
+@y
+{at this point |q| is the leftmost node; all discardable nodes have been discarded}
+if pdf_protrude_chars > 0 then begin
+ p := q;
+ p := find_protchar_left(p, false); {no more discardables}
+ w := left_pw(p);
+ if w <> 0 then begin
+ k := new_margin_kern(-w, last_leftmost_char, left_side);
+ link(k) := q;
+ q := k;
+ end;
+end;
+if left_skip<>zero_glue then
+@z
+
+@x [889] - font expansion, pre vadjust
+just_box:=hpack(q,cur_width,exactly);
+@y
+if pdf_adjust_spacing > 0 then
+ just_box := hpack(q, cur_width, cal_expand_ratio)
+else
+ just_box := hpack(q, cur_width, exactly);
+@z
+
+@x [1110] - margin kerning
+var p:pointer; {the box}
+@y
+var p:pointer; {the box}
+ r: pointer; {to remove marginal kern nodes}
+@z
+
+@x [1110] - margin kerning
+while link(tail)<>null do tail:=link(tail);
+@y
+while link(tail) <> null do begin
+ r := link(tail);
+ if not is_char_node(r) and (type(r) = margin_kern_node) then begin
+ link(tail) := link(r);
+ free_avail(margin_char(r));
+ free_node(r, margin_kern_node_size);
+ end;
+ tail:=link(tail);
+end;
+@z
+
+@x [1147] - margin kerning
+ligature_node:@<Make node |p| look like a |char_node|...@>;
+@y
+ligature_node:@<Make node |p| look like a |char_node|...@>;
+margin_kern_node: d:=width(p);
+@z
+
+@x [1253] - font expansion
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
+ end;
+@y
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ if n < lp_code_base then begin
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
+ end
+ else begin
+ scan_char_num; p := cur_val;
+ scan_optional_equals; scan_int;
+ case n of
+ lp_code_base: set_lp_code(f, p, cur_val);
+ rp_code_base: set_rp_code(f, p, cur_val);
+ ef_code_base: set_ef_code(f, p, cur_val);
+ end;
+ end;
+end;
+@z
+
+@x [1254] - font expansion
+primitive("skewchar",assign_font_int,1);
+@!@:skew_char_}{\.{\\skewchar} primitive@>
+@y
+primitive("skewchar",assign_font_int,1);
+@!@:skew_char_}{\.{\\skewchar} primitive@>
+primitive("lpcode",assign_font_int,lp_code_base);
+@!@:lp_code_}{\.{\\lpcode} primitive@>
+primitive("rpcode",assign_font_int,rp_code_base);
+@!@:rp_code_}{\.{\\rpcode} primitive@>
+primitive("efcode",assign_font_int,ef_code_base);
+@!@:ef_code_}{\.{\\efcode} primitive@>
+@z
+
+@x [1255] - font expansion
+assign_font_int: if chr_code=0 then print_esc("hyphenchar")
+ else print_esc("skewchar");
+@y
+assign_font_int: case chr_code of
+0: print_esc("hyphenchar");
+1: print_esc("skewchar");
+lp_code_base: print_esc("lpcode");
+rp_code_base: print_esc("rpcode");
+ef_code_base: print_esc("efcode");
+endcases;
+@z
+
+@x [1344]
+@d pdftex_last_extension_code == pdftex_first_extension_code + 27
+@y
+@d pdf_font_expand_code == pdftex_first_extension_code + 28
+@d pdftex_last_extension_code == pdftex_first_extension_code + 28
+@z
+
+@x [1344]
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+@y
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+primitive("pdffontexpand",extension,pdf_font_expand_code);@/
+@!@:pdf_font_expand_}{\.{\\pdffontexpand} primitive@>
+@z
+
+@x [1346]
+ immediate_code:print_esc("immediate");
+ set_language_code:print_esc("setlanguage");
+@y
+ immediate_code:print_esc("immediate");
+ set_language_code:print_esc("setlanguage");
+ pdf_font_expand_code: print_esc("pdffontexpand");
+@z
+
+@x [1348]
+set_language_code:@<Implement \.{\\setlanguage}@>;
+@y
+set_language_code:@<Implement \.{\\setlanguage}@>;
+pdf_font_expand_code: @<Implement \.{\\pdffontexpand}@>;
+@z
+
+@x [1354]
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+@y
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+
+@ @<Implement \.{\\pdffontexpand}@>=
+ read_expand_font
+@z
+
+@x [15??]
+@<Declare procedures that need to be declared forward for pdftex@>=
+@y
+@<Declare procedures that need to be declared forward for pdftex@>=
+function prev_rightmost(s, e: pointer): pointer;
+{finds the node preceding the rightmost node |e|; |s| is some node
+before |e|}
+var p: pointer;
+begin
+ prev_rightmost := null;
+ p := s;
+ if p = null then
+ return;
+ while link(p) <> e do begin
+ p := link(p);
+ if p = null then
+ return;
+ end;
+ prev_rightmost := p;
+end;
+@z
+
diff --git a/Build/source/texk/web2c/pdftexdir/image.h b/Build/source/texk/web2c/pdftexdir/image.h
new file mode 100644
index 00000000000..2f9dcc94171
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/image.h
@@ -0,0 +1,104 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/image.h#10 $
+*/
+
+#include <png.h>
+
+/* JPG_IMAGE_INFO is main structure for interchange of image data */
+
+#define JPG_UINT16 unsigned int
+#define JPG_UINT32 unsigned long
+#define JPG_UINT8 unsigned char
+
+typedef struct {
+ int color_space; /* used color space. See JPG_ constants */
+ JPG_UINT8 bits_per_component; /* bits per component */
+ JPG_UINT32 length; /* length of file/data */
+ FILE *file; /* jpg file */
+} JPG_IMAGE_INFO;
+
+typedef struct {
+ png_structp png_ptr;
+ png_infop info_ptr;
+} png_image_struct;
+
+typedef struct {
+ integer orig_x;
+ integer orig_y;
+ integer selected_page;
+ integer page_box;
+ integer always_use_pdfpagebox;
+ void *doc;
+} pdf_image_struct;
+
+typedef struct {
+ char *image_name;
+ int image_type;
+ int color_type;
+ integer width;
+ integer height;
+ integer x_res;
+ integer y_res;
+ integer num_pages;
+ integer colorspace_ref;
+ union {
+ pdf_image_struct *pdf;
+ png_image_struct png;
+ JPG_IMAGE_INFO *jpg;
+ } image_struct;
+} image_entry;
+
+extern image_entry *image_ptr, *image_array;
+extern integer image_max;
+
+#define IMAGE_TYPE_NONE 0
+#define IMAGE_TYPE_PDF 1
+#define IMAGE_TYPE_PNG 2
+#define IMAGE_TYPE_JPG 3
+#define IMAGE_TYPE_TIF 4
+
+#define IMAGE_COLOR_B 1
+#define IMAGE_COLOR_C 2
+#define IMAGE_COLOR_I 4
+
+#define img_ptr(N) (image_array + (N))
+#define img_name(N) (img_ptr(N)->image_name)
+#define img_type(N) (img_ptr(N)->image_type)
+#define img_color(N) (img_ptr(N)->color_type)
+#define img_colorspace_ref(N) (img_ptr(N)->colorspace_ref)
+#define img_pages(N) (img_ptr(N)->num_pages)
+#define img_width(N) (img_ptr(N)->width)
+#define img_height(N) (img_ptr(N)->height)
+#define img_xres(N) (img_ptr(N)->x_res)
+#define img_yres(N) (img_ptr(N)->y_res)
+#define png_ptr(N) (img_ptr(N)->image_struct.png.png_ptr)
+#define png_info(N) (img_ptr(N)->image_struct.png.info_ptr)
+#define pdf_ptr(N) (img_ptr(N)->image_struct.pdf)
+#define jpg_ptr(N) (img_ptr(N)->image_struct.jpg)
+#define tif_ptr(N) (img_ptr(N)->image_struct.tif)
+
+extern integer read_pdf_info(char*, char*, integer, integer, integer, integer);
+extern void write_epdf(void);
+extern void epdf_delete(void);
+extern void read_png_info(integer);
+extern void write_png(integer);
+extern void read_jpg_info(integer);
+extern void write_jpg(integer);
diff --git a/Build/source/texk/web2c/pdftexdir/macnames.c b/Build/source/texk/web2c/pdftexdir/macnames.c
new file mode 100644
index 00000000000..7f2005e8e20
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/macnames.c
@@ -0,0 +1,312 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/macnames.c#5 $
+*/
+
+const char notdef[] = ".notdef";
+
+const char *mac_glyph_names[] = {
+/* 0x00 */
+ notdef,
+ ".null",
+ "CR",
+ "space",
+ "exclam",
+ "quotedbl",
+ "numbersign",
+ "dollar",
+ "percent",
+ "ampersand",
+ "quotesingle",
+ "parenleft",
+ "parenright",
+ "asterisk",
+ "plus",
+ "comma",
+/* 0x10 */
+ "hyphen",
+ "period",
+ "slash",
+ "zero",
+ "one",
+ "two",
+ "three",
+ "four",
+ "five",
+ "six",
+ "seven",
+ "eight",
+ "nine",
+ "colon",
+ "semicolon",
+ "less",
+/* 0x20 */
+ "equal",
+ "greater",
+ "question",
+ "at",
+ "A",
+ "B",
+ "C",
+ "D",
+ "E",
+ "F",
+ "G",
+ "H",
+ "I",
+ "J",
+ "K",
+ "L",
+/* 0x30 */
+ "M",
+ "N",
+ "O",
+ "P",
+ "Q",
+ "R",
+ "S",
+ "T",
+ "U",
+ "V",
+ "W",
+ "X",
+ "Y",
+ "Z",
+ "bracketleft",
+ "backslash",
+/* 0x40 */
+ "bracketright",
+ "asciicircum",
+ "underscore",
+ "grave",
+ "a",
+ "b",
+ "c",
+ "d",
+ "e",
+ "f",
+ "g",
+ "h",
+ "i",
+ "j",
+ "k",
+ "l",
+/* 0x50 */
+ "m",
+ "n",
+ "o",
+ "p",
+ "q",
+ "r",
+ "s",
+ "t",
+ "u",
+ "v",
+ "w",
+ "x",
+ "y",
+ "z",
+ "braceleft",
+ "bar",
+/* 0x60 */
+ "braceright",
+ "asciitilde",
+ "Adieresis",
+ "Aring",
+ "Ccedilla",
+ "Eacute",
+ "Ntilde",
+ "Odieresis",
+ "Udieresis",
+ "aacute",
+ "agrave",
+ "acircumflex",
+ "adieresis",
+ "atilde",
+ "aring",
+ "ccedilla",
+/* 0x70 */
+ "eacute",
+ "egrave",
+ "ecircumflex",
+ "edieresis",
+ "iacute",
+ "igrave",
+ "icircumflex",
+ "idieresis",
+ "ntilde",
+ "oacute",
+ "ograve",
+ "ocircumflex",
+ "odieresis",
+ "otilde",
+ "uacute",
+ "ugrave",
+/* 0x80 */
+ "ucircumflex",
+ "udieresis",
+ "dagger",
+ "degree",
+ "cent",
+ "sterling",
+ "section",
+ "bullet",
+ "paragraph",
+ "germandbls",
+ "registered",
+ "copyright",
+ "trademark",
+ "acute",
+ "dieresis",
+ "notequal",
+/* 0x90 */
+ "AE",
+ "Oslash",
+ "infinity",
+ "plusminus",
+ "lessequal",
+ "greaterequal",
+ "yen",
+ "mu",
+ "partialdiff",
+ "Sigma",
+ "Pi",
+ "pi",
+ "integral",
+ "ordfeminine",
+ "ordmasculine",
+ "Omega",
+/* 0xa0 */
+ "ae",
+ "oslash",
+ "questiondown",
+ "exclamdown",
+ "logicalnot",
+ "radical",
+ "florin",
+ "approxequal",
+ "Delta",
+ "guillemotleft",
+ "guillemotright",
+ "ellipsis",
+ "nbspace",
+ "Agrave",
+ "Atilde",
+ "Otilde",
+/* 0xb0 */
+ "OE",
+ "oe",
+ "endash",
+ "emdash",
+ "quotedblleft",
+ "quotedblright",
+ "quoteleft",
+ "quoteright",
+ "divide",
+ "lozenge",
+ "ydieresis",
+ "Ydieresis",
+ "fraction",
+ "currency",
+ "guilsinglleft",
+ "guilsinglright",
+/* 0xc0 */
+ "fi",
+ "fl",
+ "daggerdbl",
+ "periodcentered",
+ "quotesinglbase",
+ "quotedblbase",
+ "perthousand",
+ "Acircumflex",
+ "Ecircumflex",
+ "Aacute",
+ "Edieresis",
+ "Egrave",
+ "Iacute",
+ "Icircumflex",
+ "Idieresis",
+ "Igrave",
+/* 0xd0 */
+ "Oacute",
+ "Ocircumflex",
+ "applelogo",
+ "Ograve",
+ "Uacute",
+ "Ucircumflex",
+ "Ugrave",
+ "dotlessi",
+ "circumflex",
+ "tilde",
+ "macron",
+ "breve",
+ "dotaccent",
+ "ring",
+ "cedilla",
+ "hungarumlaut",
+/* 0xe0 */
+ "ogonek",
+ "caron",
+ "Lslash",
+ "lslash",
+ "Scaron",
+ "scaron",
+ "Zcaron",
+ "zcaron",
+ "brokenbar",
+ "Eth",
+ "eth",
+ "Yacute",
+ "yacute",
+ "Thorn",
+ "thorn",
+ "minus",
+/* 0xf0 */
+ "multiply",
+ "onesuperior",
+ "twosuperior",
+ "threesuperior",
+ "onehalf",
+ "onequarter",
+ "threequarters",
+ "franc",
+ "Gbreve",
+ "gbreve",
+ "Idot",
+ "Scedilla",
+ "scedilla",
+ "Cacute",
+ "cacute",
+ "Ccaron",
+/* 0x100 */
+ "ccaron",
+ "dmacron"
+};
+
+const char *ambiguous_names[] = {
+ "Delta", /* increment */
+ "Omega", /* Ohm */
+ "Pi", /* product */
+ "Sigma", /* summation */
+ "dmacron", /* dslash */
+ "macron", /* overscore */
+ "periodcentered", /* middot */
+ NULL
+};
diff --git a/Build/source/texk/web2c/pdftexdir/mapfile.c b/Build/source/texk/web2c/pdftexdir/mapfile.c
new file mode 100644
index 00000000000..758290127ca
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/mapfile.c
@@ -0,0 +1,1150 @@
+/*
+Copyright (c) 1996-2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/mapfile.c#30 $
+
+source code indentation by "indent -kr -nut"
+*/
+
+#include <math.h>
+#include "ptexlib.h"
+#include <kpathsea/c-auto.h>
+#include <kpathsea/c-memstr.h>
+#include "avlstuff.h"
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/mapfile.c#30 $";
+
+#define FM_BUF_SIZE 1024
+
+static FILE *fm_file;
+
+#define fm_open() \
+ open_input (&fm_file, kpse_fontmap_format, FOPEN_RBIN_MODE)
+#define fm_close() xfclose(fm_file, cur_file_name)
+#define fm_getchar() xgetc(fm_file)
+#define fm_eof() feof(fm_file)
+
+enum _mode { FM_DUPIGNORE, FM_REPLACE, FM_DELETE };
+enum _ltype { MAPFILE, MAPLINE };
+enum _tfmavail { TFM_UNCHECKED, TFM_FOUND, TFM_NOTFOUND };
+
+typedef struct mitem {
+ int mode; /* FM_DUPIGNORE or FM_REPLACE or FM_DELETE */
+ int type; /* map file or map line */
+ char *line; /* pointer to map file name or map line */
+ int lineno; /* line number in map file */
+ struct mitem *next; /* pointer to next item, or NULL */
+} mapitem;
+mapitem *miptr, *mapitems = NULL;
+
+fm_entry *fm_cur;
+static const char nontfm[] = "<nontfm>";
+static fm_entry *loaded_tfm_found;
+static fm_entry *avail_tfm_found;
+static fm_entry *non_tfm_found;
+static fm_entry *not_avail_tfm_found;
+
+#define read_field(r, q, buf) do { \
+ for (q = buf; *r != ' ' && *r != 10; *q++ = *r++); \
+ *q = 0; \
+ skip (r, ' '); \
+} while (0)
+
+#define set_field(F) do { \
+ if (q > buf) \
+ fm->F = xstrdup(buf); \
+ if (*r == 10) \
+ goto done; \
+} while (0)
+
+static fm_entry *new_fm_entry(void)
+{
+ fm_entry *fm;
+ fm = xtalloc(1, fm_entry);
+ fm->tfm_name = NULL;
+ fm->ps_name = NULL;
+ fm->flags = 0;
+ fm->ff_name = NULL;
+ fm->subset_tag = NULL;
+ fm->encoding = NULL;
+ fm->tfm_num = getnullfont();
+ fm->tfm_avail = TFM_UNCHECKED;
+ fm->type = 0;
+ fm->slant = 0;
+ fm->extend = 0;
+ fm->ff_objnum = 0;
+ fm->fn_objnum = 0;
+ fm->fd_objnum = 0;
+ fm->charset = NULL;
+ fm->all_glyphs = false;
+ fm->links = 0;
+ return fm;
+}
+
+static void delete_fm_entry(fm_entry * fm)
+{
+ xfree(fm->tfm_name);
+ xfree(fm->ps_name);
+ xfree(fm->ff_name);
+ xfree(fm->subset_tag);
+ xfree(fm->charset);
+ xfree(fm);
+}
+
+static ff_entry *new_ff_entry(void)
+{
+ ff_entry *ff;
+ ff = xtalloc(1, ff_entry);
+ ff->ff_name = NULL;
+ ff->ff_path = NULL;
+ return ff;
+}
+
+static void delete_ff_entry(ff_entry * ff)
+{
+ xfree(ff->ff_name);
+ xfree(ff->ff_path);
+ xfree(ff);
+}
+
+static fm_entry *dummy_fm_entry()
+{
+ static const fm_entry const_fm_entry;
+ return (fm_entry *) & const_fm_entry;
+}
+
+char *mk_base_tfm(char *tfmname, int *i)
+{
+ static char buf[SMALL_BUF_SIZE];
+ char *p = tfmname, *r = strend(p) - 1, *q = r;
+ while (q > p && isdigit(*q))
+ --q;
+ if (!(q > p) || q == r || (*q != '+' && *q != '-'))
+ return NULL;
+ check_buf(q - p + 1, SMALL_BUF_SIZE);
+ strncpy(buf, p, (unsigned) (q - p));
+ buf[q - p] = 0;
+ *i = atoi(q);
+ return buf;
+}
+
+static fmentryptr fmlookup(internalfontnumber);
+
+boolean hasfmentry(internalfontnumber f)
+{
+ if (pdffontmap[f] == NULL)
+ pdffontmap[f] = fmlookup(f);
+ assert(pdffontmap[f] != NULL);
+ return pdffontmap[f] != (fmentryptr) dummy_fm_entry();
+}
+
+/**********************************************************************/
+
+struct avl_table *tfm_tree = NULL;
+struct avl_table *ps_tree = NULL;
+struct avl_table *ff_tree = NULL;
+
+/* AVL sort fm_entry into tfm_tree by tfm_name */
+
+static int comp_fm_entry_tfm(const void *pa, const void *pb, void *p)
+{
+ return strcmp(((const fm_entry *) pa)->tfm_name,
+ ((const fm_entry *) pb)->tfm_name);
+}
+
+#define cmp_return(a, b) \
+ if (a > b) \
+ return 1; \
+ if (a < b) \
+ return -1
+
+/* AVL sort fm_entry into ps_tree by ps_name, slant, and extend */
+
+static int comp_fm_entry_ps(const void *pa, const void *pb, void *p)
+{
+ const fm_entry *p1 = (const fm_entry *) pa, *p2 =
+ (const fm_entry *) pb;
+ int i;
+ assert(p1->ps_name != NULL && p2->ps_name != NULL);
+ if ((i = strcmp(p1->ps_name, p2->ps_name)) != 0)
+ return i;
+ cmp_return(p1->slant, p2->slant);
+ cmp_return(p1->extend, p2->extend);
+ if (p1->tfm_name != NULL && p2->tfm_name != NULL &&
+ (i = strcmp(p1->tfm_name, p2->tfm_name)) != 0)
+ return i;
+ return 0;
+}
+
+/* AVL sort ff_entry into ff_tree by ff_name */
+
+static int comp_ff_entry(const void *pa, const void *pb, void *p)
+{
+ return strcmp(((const ff_entry *) pa)->ff_name,
+ ((const ff_entry *) pb)->ff_name);
+}
+
+static void create_avl_trees()
+{
+ if (tfm_tree == NULL) {
+ tfm_tree = avl_create(comp_fm_entry_tfm, NULL, &avl_xallocator);
+ assert(tfm_tree != NULL);
+ }
+ if (ps_tree == NULL) {
+ ps_tree = avl_create(comp_fm_entry_ps, NULL, &avl_xallocator);
+ assert(ps_tree != NULL);
+ }
+ if (ff_tree == NULL) {
+ ff_tree = avl_create(comp_ff_entry, NULL, &avl_xallocator);
+ assert(ff_tree != NULL);
+ }
+}
+
+/*
+The function avl_do_entry() is not completely symmetrical with regards
+to tfm_name and ps_name handling, e. g. a duplicate tfm_name gives a
+"goto exit", and no ps_name link is tried. This is to keep it compatible
+with the original version.
+*/
+
+static int avl_do_entry(fm_entry * fp, int mode)
+{
+ fm_entry *p, *p2;
+ void *a;
+ void **aa;
+ struct avl_traverser trav;
+
+ /* handle tfm_name link */
+
+ if (strcmp(fp->tfm_name, nontfm) != 0) {
+ p = (fm_entry *) avl_find(tfm_tree, fp);
+ if (p != NULL) {
+ if (mode == FM_DUPIGNORE) {
+ pdftex_warn
+ ("fontmap entry for `%s' already exists, duplicates ignored",
+ fp->tfm_name);
+ goto exit;
+ } else { /* mode == FM_REPLACE / FM_DELETE */
+ if (fontused[p->tfm_num]) {
+ pdftex_warn
+ ("fontmap entry for `%s' has been used, replace/delete not allowed",
+ fp->tfm_name);
+ goto exit;
+ }
+ a = avl_delete(tfm_tree, p);
+ assert(a != NULL);
+ unset_tfmlink(p);
+ if (!has_pslink(p))
+ delete_fm_entry(p);
+ }
+ }
+ if (mode != FM_DELETE) {
+ aa = avl_probe(tfm_tree, fp);
+ assert(aa != NULL);
+ set_tfmlink(fp);
+ }
+ }
+
+ /* handle ps_name link */
+
+ if (fp->ps_name != NULL) {
+ assert(fp->tfm_name != NULL);
+ p = (fm_entry *) avl_find(ps_tree, fp);
+ if (p != NULL) {
+ if (mode == FM_DUPIGNORE) {
+ pdftex_warn
+ ("ps_name entry for `%s' already exists, duplicates ignored",
+ fp->ps_name);
+ goto exit;
+ } else { /* mode == FM_REPLACE / FM_DELETE */
+ if (fontused[p->tfm_num]) {
+ /* REPLACE/DELETE not allowed */
+ pdftex_warn
+ ("fontmap entry for `%s' has been used, replace/delete not allowed",
+ p->tfm_name);
+ goto exit;
+ }
+ a = avl_delete(ps_tree, p);
+ assert(a != NULL);
+ unset_pslink(p);
+ if (!has_tfmlink(p))
+ delete_fm_entry(p);
+ }
+ }
+ if (mode != FM_DELETE) {
+ aa = avl_probe(ps_tree, fp);
+ assert(aa != NULL);
+ set_pslink(fp);
+ }
+ }
+ exit:
+ if (!has_tfmlink(fp) && !has_pslink(fp)) /* e. g. after FM_DELETE */
+ return 1; /* deallocation of fm_entry structure required */
+ else
+ return 0;
+}
+
+/**********************************************************************/
+/* consistency check for map entry, with warn flag */
+
+int check_fm_entry(fm_entry * fm, boolean warn)
+{
+ int a = 0;
+ assert(fm != NULL);
+ if (fm->ps_name != NULL) {
+ if (is_basefont(fm)) {
+ if (is_fontfile(fm) && !is_included(fm)) {
+ if (warn)
+ pdftex_warn
+ ("invalid entry for `%s': font file must be included or omitted for base fonts",
+ fm->tfm_name);
+ a += 1;
+ }
+ } else { /* not a base font */
+ /* if no font file given, drop this entry */
+ if (!is_fontfile(fm)) {
+ if (warn)
+ pdftex_warn
+ ("invalid entry for `%s': font file missing",
+ fm->tfm_name);
+ a += 2;
+ }
+ }
+ }
+ if (is_truetype(fm) && is_reencoded(fm) && !is_subsetted(fm)) {
+ if (warn)
+ pdftex_warn
+ ("invalid entry for `%s': only subsetted TrueType font can be reencoded",
+ fm->tfm_name);
+ a += 4;
+ }
+ if ((fm->slant != 0 || fm->extend != 0) &&
+ (!is_included(fm) || is_truetype(fm))) {
+ if (warn)
+ pdftex_warn
+ ("invalid entry for `%s': SlantFont/ExtendFont can be used only with embedded T1 fonts",
+ fm->tfm_name);
+ a += 8;
+ }
+ if (abs(fm->slant) > 1000) {
+ if (warn)
+ pdftex_warn
+ ("invalid entry for `%s': too big value of SlantFont (%g)",
+ fm->tfm_name, fm->slant / 1000.0);
+ a += 16;
+ }
+ if (abs(fm->extend) > 2000) {
+ if (warn)
+ pdftex_warn
+ ("invalid entry for `%s': too big value of ExtendFont (%g)",
+ fm->tfm_name, fm->extend / 1000.0);
+ a += 32;
+ }
+ return a;
+}
+
+/**********************************************************************/
+/* returns true if s is one of the 14 std. font names; speed-trimmed. */
+
+boolean check_basefont(char *s)
+{
+ static const char *basefont_names[] = {
+ "Courier", /* 0:7 */
+ "Courier-Bold", /* 1:12 */
+ "Courier-Oblique", /* 2:15 */
+ "Courier-BoldOblique", /* 3:19 */
+ "Helvetica", /* 4:9 */
+ "Helvetica-Bold", /* 5:14 */
+ "Helvetica-Oblique", /* 6:17 */
+ "Helvetica-BoldOblique", /* 7:21 */
+ "Symbol", /* 8:6 */
+ "Times-Roman", /* 9:11 */
+ "Times-Bold", /* 10:10 */
+ "Times-Italic", /* 11:12 */
+ "Times-BoldItalic", /* 12:16 */
+ "ZapfDingbats" /* 13:12 */
+ };
+ static const int index[] =
+ { -1, -1, -1, -1, -1, -1, 8, 0, -1, 4, 10, 9, -1, -1, 5, 2, 12, 6,
+ -1, 3, -1, 7
+ };
+ int n = strlen(s), k = -1;
+ if (n > 21)
+ return false;
+ if (n == 12) { /* three names have length 12 */
+ switch (*s) {
+ case 'C':
+ k = 1; /* Courier-Bold */
+ break;
+ case 'T':
+ k = 11; /* Times-Italic */
+ break;
+ case 'Z':
+ k = 13; /* ZapfDingbats */
+ break;
+ default:
+ return false;
+ }
+ } else
+ k = index[n];
+ if (k > -1 && strcmp(basefont_names[k], s) == 0)
+ return true;
+ return false;
+};
+
+/**********************************************************************/
+
+static void fm_scan_line(mapitem * mitem)
+{
+ int a, b, c, j, u = 0, v = 0;
+ float d;
+ char fm_line[FM_BUF_SIZE], buf[FM_BUF_SIZE];
+ fm_entry *fm;
+ char *p, *q, *r, *s;
+ p = fm_line;
+ switch (mitem->type) {
+ case MAPFILE:
+ do {
+ c = fm_getchar();
+ append_char_to_buf(c, p, fm_line, FM_BUF_SIZE);
+ }
+ while (c != 10);
+ break;
+ case MAPLINE:
+ s = mitem->line;
+ while ((c = *s++) != 0)
+ append_char_to_buf(c, p, fm_line, FM_BUF_SIZE);
+ break;
+ default:
+ assert(0);
+ }
+ append_eol(p, fm_line, FM_BUF_SIZE);
+ if (is_cfg_comment(*fm_line))
+ return;
+ r = fm_line;
+ read_field(r, q, buf);
+ fm = new_fm_entry();
+ set_field(tfm_name);
+ p = r;
+ read_field(r, q, buf);
+ if (*buf != '<' && *buf != '"')
+ set_field(ps_name);
+ else
+ r = p; /* unget the field */
+ if (isdigit(*r)) { /* font flags given */
+ fm->flags = atoi(r);
+ while (isdigit(*r))
+ r++;
+ } else
+ fm->flags = 4; /* treat as Symbol font */
+ while (1) { /* loop through "specials", encoding, font file */
+ skip(r, ' ');
+ switch (*r) {
+ case 10:
+ goto done;
+ case '"': /* opening quote */
+ r++;
+ u = v = 0;
+ do {
+ skip(r, ' ');
+ if (sscanf(r, "%f %n", &d, &j) > 0) {
+ s = r + j; /* jump behind number, eat also blanks, if any */
+ if (*(s - 1) == 'E' || *(s - 1) == 'e')
+ s--; /* e. g. 0.5ExtendFont: %f = 0.5E */
+ if (strncmp(s, "SlantFont", strlen("SlantFont")) == 0) {
+ d *= 1000.0; /* correct rounding also for neg. numbers */
+ fm->slant = (integer) (d > 0 ? d + 0.5 : d - 0.5);
+ r = s + strlen("SlantFont");
+ } else
+ if (strncmp(s, "ExtendFont", strlen("ExtendFont"))
+ == 0) {
+ d *= 1000.0;
+ fm->extend = (integer) (d > 0 ? d + 0.5 : d - 0.5);
+ if (fm->extend == 1000)
+ fm->extend = 0;
+ r = s + strlen("ExtendFont");
+ } else { /* unknown name */
+ for (r = s; *r != ' ' && *r != '"' && *r != 10; r++); /* jump over name */
+ c = *r; /* remember char for temporary end of string */
+ *r = '\0';
+ pdftex_warn
+ ("invalid entry for `%s': unknown name `%s' ignored",
+ fm->tfm_name, s);
+ *r = c;
+ }
+ } else
+ for (; *r != ' ' && *r != '"' && *r != 10; r++);
+ }
+ while (*r == ' ');
+ if (*r == '"') /* closing quote */
+ r++;
+ else {
+ pdftex_warn
+ ("invalid entry for `%s': closing quote missing",
+ fm->tfm_name);
+ goto bad_line;
+ }
+ break;
+ default: /* encoding or font file specification */
+ a = b = 0;
+ if (*r == '<') {
+ a = *r++;
+ if (*r == '<' || *r == '[')
+ b = *r++;
+ }
+ read_field(r, q, buf);
+ /* encoding, formats: '8r.enc' or '<8r.enc' or '<[8r.enc' */
+ if (strlen(buf) > 4
+ && strcasecmp(strend(buf) - 4, ".enc") == 0) {
+ fm->encoding = add_enc(buf);
+ u = v = 0; /* u, v used if intervening blank: "<< foo" */
+ } else if (strlen(buf) > 0) { /* file name given */
+ /* font file, formats:
+ * subsetting: '<cmr10.pfa'
+ * no subsetting: '<<cmr10.pfa'
+ * no embedding: 'cmr10.pfa'
+ */
+ if (a == '<' || u == '<') {
+ set_included(fm);
+ if ((a == '<' && b == 0) || (a == 0 && v == 0))
+ set_subsetted(fm);
+ /* otherwise b == '<' (or '[') => no subsetting */
+ }
+ set_field(ff_name);
+ u = v = 0;
+ } else {
+ u = a;
+ v = b;
+ }
+ }
+ }
+ done:
+ if (fm->ps_name != NULL && check_basefont(fm->ps_name))
+ set_basefont(fm);
+ if (is_fontfile(fm)
+ && strcasecmp(strend(fm_fontfile(fm)) - 4, ".ttf") == 0)
+ set_truetype(fm);
+ if (check_fm_entry(fm, true) != 0)
+ goto bad_line;
+ /*
+ Until here the map line has been completely scanned without errors;
+ fm points to a valid, freshly filled-out fm_entry structure.
+ Now follows the actual work of registering/deleting.
+ */
+ if (avl_do_entry(fm, mitem->mode) == 0) /* if success */
+ return;
+ bad_line:
+ delete_fm_entry(fm);
+}
+
+/**********************************************************************/
+
+void fm_read_info()
+{
+ mapitem *tmp;
+ create_avl_trees();
+ while (mapitems != NULL) {
+ assert(mapitems->line != NULL);
+ mapitems->lineno = 1;
+ switch (mapitems->type) {
+ case MAPFILE:
+ set_cur_file_name(mapitems->line);
+ if (!fm_open()) {
+ pdftex_warn("cannot open font map file");
+ } else {
+ cur_file_name = (char *) nameoffile + 1;
+ tex_printf("{%s", cur_file_name);
+ while (!fm_eof()) {
+ fm_scan_line(mapitems);
+ mapitems->lineno++;
+ }
+ fm_close();
+ tex_printf("}");
+ fm_file = NULL;
+ }
+ break;
+ case MAPLINE:
+ cur_file_name = NULL; /* makes pdftex_warn() shorter */
+ fm_scan_line(mapitems);
+ break;
+ default:
+ assert(0);
+ }
+ tmp = mapitems;
+ mapitems = mapitems->next;
+ xfree(tmp->line);
+ xfree(tmp);
+ }
+ cur_file_name = NULL;
+ return;
+}
+
+/**********************************************************************/
+
+/*
+char *mk_exname(char *basename, int e)
+{
+ static char buf[SMALL_BUF_SIZE];
+ char *p = basename, *r;
+ if ((r = strrchr(p, '.')) == NULL)
+ r = strend(p);
+ check_buf(r - p + strlen(r) + 10, SMALL_BUF_SIZE);
+ strncpy(buf, p, (unsigned) (r - p));
+ sprintf(buf + (r - p), "%+i", e);
+ strcat(buf, r);
+ return buf;
+}
+*/
+
+internalfontnumber tfmoffm(fmentryptr fm_pt)
+{
+ return ((fm_entry *) fm_pt)->tfm_num;
+}
+
+static fm_entry *mk_ex_fm(internalfontnumber f, fm_entry * basefm, int ex)
+{
+ fm_entry *fm;
+ integer e = basefm->extend;
+ if (e == 0)
+ e = 1000;
+ fm = new_fm_entry();
+ fm->flags = basefm->flags;
+ fm->encoding = basefm->encoding;
+ fm->type = basefm->type;
+ fm->slant = basefm->slant;
+ fm->extend = roundxnoverd(e, 1000 + ex, 1000); /* modify ExtentFont to simulate expansion */
+ if (fm->extend == 1000)
+ fm->extend = 0;
+ fm->tfm_name = xstrdup(makecstring(fontname[f]));
+ if (basefm->ps_name != NULL)
+ fm->ps_name = xstrdup(basefm->ps_name);
+ fm->ff_name = xstrdup(basefm->ff_name);
+ fm->ff_objnum = pdfnewobjnum();
+ fm->tfm_num = f;
+ fm->tfm_avail = TFM_FOUND;
+ assert(strcmp(fm->tfm_name, nontfm) != 0);
+ return fm;
+}
+
+static void init_fm(fm_entry * fm, internalfontnumber f)
+{
+ if (fm->fd_objnum == 0 && !no_font_desc(fm))
+ fm->fd_objnum = pdfnewobjnum();
+ if (fm->ff_objnum == 0 && is_included(fm))
+ fm->ff_objnum = pdfnewobjnum();
+ if (fm->tfm_num == getnullfont()) {
+ fm->tfm_num = f;
+ fm->tfm_avail = TFM_FOUND;
+ }
+}
+
+static fmentryptr fmlookup(internalfontnumber f)
+{
+ char *tfm, *p;
+ fm_entry *fm, *exfm;
+ fm_entry tmp;
+ int ai, e;
+ if (tfm_tree == NULL || mapitems != NULL)
+ fm_read_info();
+ tfm = makecstring(fontname[f]);
+ assert(strcmp(tfm, nontfm) != 0);
+
+ /* Look up for full <tfmname>[+-]<expand> */
+ tmp.tfm_name = tfm;
+ fm = (fm_entry *) avl_find(tfm_tree, &tmp);
+ if (fm != NULL) {
+ init_fm(fm, f);
+ return (fmentryptr) fm;
+ }
+ tfm = mk_base_tfm(makecstring(fontname[f]), &e);
+ if (tfm == NULL) /* not an expanded font, nothing to do */
+ return (fmentryptr) dummy_fm_entry();
+
+ tmp.tfm_name = tfm;
+ fm = (fm_entry *) avl_find(tfm_tree, &tmp);
+ if (fm != NULL) { /* found an entry with the base tfm name, e.g. cmr10 */
+ if (!is_t1fontfile(fm) || !is_included(fm)) {
+ pdftex_warn
+ ("font %s cannot be expanded (not an included Type1 font)",
+ tfm);
+ return (fmentryptr) dummy_fm_entry();
+ }
+ exfm = mk_ex_fm(f, fm, e); /* copies all fields from fm except tfm name */
+ init_fm(exfm, f);
+ ai = avl_do_entry(exfm, FM_DUPIGNORE);
+ assert(ai == 0);
+ return (fmentryptr) exfm;
+ }
+ return (fmentryptr) dummy_fm_entry();
+}
+
+/*
+ Early check whether a font file exists. Used e. g. for replacing fonts
+ of embedded PDF files: Without font file, the font within the embedded
+ PDF-file is used. Search tree ff_tree is used in 1st instance, as it
+ may be faster than the kpse_find_file(), and kpse_find_file() is called
+ only once per font file name + expansion parameter. This might help
+ keeping speed, if many PDF pages with same fonts are to be embedded.
+
+ The ff_tree contains only font files, which are actually needed,
+ so this tree typically is much smaller than the tfm_tree or ps_tree.
+*/
+
+ff_entry *check_ff_exist(fm_entry * fm)
+{
+ ff_entry *ff;
+ ff_entry tmp;
+ char *ex_ffname;
+ void **aa;
+
+ assert(fm->ff_name != NULL);
+ tmp.ff_name = fm->ff_name;
+ ff = (ff_entry *) avl_find(ff_tree, &tmp);
+ if (ff == NULL) { /* not yet in database */
+ ff = new_ff_entry();
+ ff->ff_name = xstrdup(fm->ff_name);
+ if (is_truetype(fm))
+ ff->ff_path =
+ kpse_find_file(fm->ff_name, kpse_truetype_format, 0);
+ else
+ ff->ff_path =
+ kpse_find_file(fm->ff_name, kpse_type1_format, 0);
+ aa = avl_probe(ff_tree, ff);
+ assert(aa != NULL);
+ }
+ return ff;
+}
+
+/**********************************************************************/
+
+static boolean used_tfm(fm_entry * p)
+{
+ internalfontnumber f;
+ strnumber s;
+ ff_entry *ff;
+
+ /* check if the font file is not a TrueType font */
+ /* font replacement makes sense only for included Type1 files */
+ if (is_truetype(p) || !is_included(p))
+ return false;
+
+ /* check if the font file is available */
+ ff = check_ff_exist(p);
+ if (ff->ff_path == NULL)
+ return false;
+
+ /* check whether this font has been used */
+ if (fontused[p->tfm_num])
+ return true;
+ assert(p->tfm_name != NULL);
+
+ /* check whether we didn't find a loaded font yet,
+ * and this font has been loaded */
+ if (loaded_tfm_found == NULL && strcmp(p->tfm_name, nontfm) != 0) {
+ s = maketexstring(p->tfm_name);
+ if ((f = tfmlookup(s, 0)) != getnullfont()) {
+ loaded_tfm_found = p;
+ if (pdffontmap[f] == NULL)
+ pdffontmap[f] = (fmentryptr) p;
+ if (p->tfm_num == getnullfont())
+ p->tfm_num = f;
+ assert(p->tfm_num == f);
+ /* don't call flushstr() here as it has been called by tfmlookup() */
+ } else
+ flushstr(s);
+ }
+
+ /* check whether we didn't find either a loaded or a loadable font yet,
+ * and this font is loadable */
+ if (avail_tfm_found == NULL && loaded_tfm_found == NULL &&
+ strcmp(p->tfm_name, nontfm) != 0) {
+ if (p->tfm_avail == TFM_UNCHECKED) {
+ if (kpse_find_file(p->tfm_name, kpse_tfm_format, 0) != NULL) {
+ avail_tfm_found = p;
+ p->tfm_avail = TFM_FOUND;
+ } else {
+ p->tfm_avail = TFM_NOTFOUND;
+ if (not_avail_tfm_found == NULL)
+ not_avail_tfm_found = p;
+ }
+ }
+ }
+
+ /* check whether the current entry is a <nontfm> entry */
+ if (non_tfm_found == NULL && strcmp(p->tfm_name, nontfm) == 0)
+ non_tfm_found = p;
+
+ return false;
+}
+
+/* lookup_ps_name looks for an entry with a given ps name + slant + extend;
+ * return NULL if not found.
+ *
+ * As there may exist several such entries, we need to select the `right'
+ * one. We do so by checking all such entries and return the first one that
+ * fulfils the following criteria (in descending priority):
+ *
+ * - the tfm has been used (some char from this font has been typeset)
+ * - the tfm has been loaded (but not used yet)
+ * - the tfm can be loaded (but not loaded yet)
+ * - the tfm is present in map files, but cannot be loaded. In this case a
+ * dummy tfm can be loaded instead, and a warning should be written out
+ */
+
+static fm_entry *lookup_ps_name(fm_entry * fm)
+{
+ fm_entry *p, *p2;
+ struct avl_traverser t, t2;
+ strnumber s;
+ int a;
+
+ loaded_tfm_found = NULL;
+ avail_tfm_found = NULL;
+ non_tfm_found = NULL;
+ not_avail_tfm_found = NULL;
+
+ assert(fm->tfm_name == NULL);
+ p = (fm_entry *) avl_t_find(&t, ps_tree, fm);
+ if (p == NULL)
+ return NULL;
+ t2 = t;
+ p2 = avl_t_prev(&t2);
+
+ /* search forward */
+ do {
+ if (used_tfm(p))
+ return p;
+ p = avl_t_next(&t);
+ }
+ while (p != NULL && comp_fm_entry_ps(fm, p, NULL) == 0);
+
+ /* search backward */
+ while (p2 != NULL && comp_fm_entry_ps(fm, p2, NULL) == 0) {
+ if (used_tfm(p2))
+ return p2;
+ p2 = avl_t_prev(&t2);
+ }
+
+ if (loaded_tfm_found != NULL)
+ p = loaded_tfm_found;
+ else if (avail_tfm_found != NULL) {
+ p = avail_tfm_found;
+ p->tfm_num = readfontinfo(getnullcs(), maketexstring(p->tfm_name),
+ getnullstr(), -1000);
+ p->tfm_avail = TFM_FOUND;
+ } else if (non_tfm_found != NULL) {
+ p = non_tfm_found;
+ p->tfm_num = newdummyfont();
+ p->tfm_avail = TFM_FOUND;
+ } else if (not_avail_tfm_found != NULL) {
+ p = not_avail_tfm_found;
+ pdftex_warn("`%s' not loadable, use a dummy tfm instead",
+ p->tfm_name);
+ p2 = new_fm_entry();
+ p2->flags = p->flags;
+ p2->encoding = p->encoding;
+ p2->type = p->type;
+ p2->slant = p->slant;
+ p2->extend = p->extend;
+ p2->tfm_name = xstrdup(nontfm);
+ p2->ps_name = xstrdup(p->ps_name);
+ if (p->ff_name != NULL)
+ p2->ff_name = xstrdup(p->ff_name);
+ p2->tfm_num = newdummyfont();
+ p2->tfm_avail = TFM_FOUND;
+ a = avl_do_entry(p2, FM_DUPIGNORE);
+ assert(a == 0);
+ p = p2;
+ } else
+ return NULL;
+ assert(p->tfm_num != getnullfont());
+ return p;
+}
+
+/* Lookup fontmap for /BaseFont entries of embedded PDF-files;
+ * return dummy_fm_entry() if not found */
+
+fm_entry *lookup_fontmap(char *bname)
+{
+ fm_entry *fm, *fmx;
+ fm_entry tmp, tmpx;
+ ff_entry *ff;
+ char buf[SMALL_BUF_SIZE];
+ char *a, *b, *c, *d, *e, *s;
+ strnumber str;
+ int i, sl, ex, ai;
+ if (tfm_tree == NULL || mapitems != NULL)
+ fm_read_info();
+ if (bname == NULL)
+ return NULL;
+ if (strlen(bname) >= SMALL_BUF_SIZE)
+ pdftex_fail("Font name too long: `%s'", bname);
+ strcpy(buf, bname); /* keep bname untouched for later */
+ s = buf;
+ if (strlen(buf) > 7) { /* check for subsetted name tag */
+ for (i = 0; i < 6; i++, s++)
+ if (*s < 'A' || *s > 'Z')
+ break;
+ if (i == 6 && *s == '+')
+ s++; /* if name tag found, skip behind it */
+ else
+ s = buf;
+ }
+
+ /*
+ Scan -Slant_<slant> and -Extend_<extend> font name extensions;
+ three valid formats:
+ <fontname>-Slant_<slant>
+ <fontname>-Slant_<slant>-Extend_<extend>
+ <fontname>-Extend_<extend>
+ Slant entry must come _before_ Extend entry
+ */
+
+ tmp.slant = 0;
+ tmp.extend = 0;
+ if ((a = strstr(s, "-Slant_")) != NULL) {
+ b = a + strlen("-Slant_");
+ sl = (int) strtol(b, &e, 10);
+ if ((e != b) && (e == strend(b))) {
+ tmp.slant = sl;
+ *a = 0; /* bname string ends before "-Slant_" */
+ } else {
+ if (e != b) { /* only if <slant> is valid number */
+ if ((c = strstr(e, "-Extend_")) != NULL) {
+ d = c + strlen("-Extend_");
+ ex = (int) strtol(d, &e, 10);
+ if ((e != d) && (e == strend(d))) {
+ tmp.slant = sl;
+ tmp.extend = ex;
+ *a = 0; /* bname string ends before "-Slant_" */
+ }
+ }
+ }
+ }
+ } else {
+ if ((a = strstr(s, "-Extend_")) != NULL) {
+ b = a + strlen("-Extend_");
+ ex = (int) strtol(b, &e, 10);
+ if ((e != b) && (e == strend(b))) {
+ tmp.extend = ex;
+ *a = 0; /* bname string ends before "-Extend_" */
+ }
+ }
+ }
+ tmp.ps_name = s;
+ tmp.tfm_name = NULL;
+ fm = lookup_ps_name(&tmp);
+ if (fm != NULL) {
+ if (!(is_type1(fm) && is_included(fm))) {
+ pdftex_warn
+ ("PS name '%s' is found but ignored (not an included Type1 font)",
+ tmp.ps_name);
+ return NULL;
+ }
+ i = fm->tfm_num;
+ assert(i != getnullfont());
+ if (pdffontmap[i] == NULL)
+ pdffontmap[i] = (fmentryptr) fm;
+ if (fm->ff_objnum == 0 && is_included(fm))
+ fm->ff_objnum = pdfnewobjnum();
+ if (!fontused[i])
+ pdfinitfont(i);
+ return fm;
+ }
+/*
+ The following code snipplet handles fonts with "Slant" and "Extend"
+ name extensions in embedded PDF files, which don't yet have an
+ fm_entry. If such a font is found (e. g. CMR10-Extend_1020), and no
+ fm_entry for this is found in the ps_tree (e. g. ps_name = "CMR10",
+ extend = 1020), and if an unextended base font (e. g. CMR10) is found,
+ a new <nontfm> fm_entry is created and put into the ps_tree. Then
+ the lookup_fontmap() function is (recursively) called again, which
+ then should find the new fm_entry. The same can be done manually by
+ a map entry e. g.:
+
+ \pdfmapline{+<nontfm> CMR10 "1.02 ExtendFont" <cmr10.pfb}
+
+ This would also match the embedded font CMR10-Extend_1020, and replace
+ it by an extended copy of cmr10.pfb. -- But not by an expanded version;
+ no MM files (e.g. cmr10+20.pfb) would be used.
+*/
+
+ tmpx.ps_name = s;
+ tmpx.tfm_name = NULL;
+ tmpx.slant = 0;
+ tmpx.extend = 0;
+/* fm = (fm_entry *) avl_find(ps_tree, &tmpx); */
+ fm = lookup_ps_name(&tmpx);
+ if (fm != NULL) {
+ if (is_truetype(fm) || !is_included(fm))
+ return NULL;
+ ff = check_ff_exist(fm);
+ if (ff->ff_path == NULL)
+ return NULL;
+ fmx = new_fm_entry();
+ fmx->flags = fm->flags;
+ fmx->encoding = fm->encoding;
+ fmx->type = fm->type;
+ fmx->slant = tmp.slant;
+ fmx->extend = tmp.extend;
+ fmx->tfm_name = xstrdup(nontfm);
+ fmx->ps_name = xstrdup(s);
+ fmx->ff_name = xstrdup(fm->ff_name);
+ ai = avl_do_entry(fmx, FM_DUPIGNORE);
+ assert(ai == 0);
+ fm = lookup_fontmap(bname); /* new try */
+ assert(fm != NULL);
+ return fm;
+ }
+ return NULL;
+}
+
+/**********************************************************************/
+/*
+Add map file name or map line contents to the linked list "mapitems".
+Items not beginning with [+-=] flush list with pending items. Leading
+blanks and blanks immediately following [+-=] are ignored.
+*/
+
+char *add_map_item(char *s, int type)
+{
+ char *p;
+ int l; /* length of map item (without [+-=]) */
+ mapitem *tmp;
+ int mode;
+ for (; *s == ' '; s++); /* ignore leading blanks */
+ switch (*s) {
+ case '+': /* +mapfile.map, +mapline */
+ mode = FM_DUPIGNORE; /* insert entry, if it is not duplicate */
+ s++;
+ break;
+ case '=': /* =mapfile.map, =mapline */
+ mode = FM_REPLACE; /* try to replace earlier entry */
+ s++;
+ break;
+ case '-': /* -mapfile.map, -mapline */
+ mode = FM_DELETE; /* try to delete entry */
+ s++;
+ break;
+ default:
+ mode = FM_DUPIGNORE; /* also flush pending list */
+ while (mapitems != NULL) {
+ tmp = mapitems;
+ mapitems = mapitems->next;
+ xfree(tmp->line);
+ xfree(tmp);
+ }
+ }
+ for (; *s == ' '; s++); /* ignore blanks after [+-=] */
+ p = s; /* map item starts here */
+ switch (type) { /* find end of map item */
+ case MAPFILE:
+ for (; *p != 0 && *p != ' ' && *p != 10; p++);
+ break;
+ case MAPLINE: /* blanks allowed */
+ for (; *p != 0 && *p != 10; p++);
+ break;
+ default:
+ assert(0);
+ }
+ l = p - s;
+ if (l > 0) { /* only if real item to add */
+ tmp = xtalloc(1, mapitem);
+ if (mapitems == NULL)
+ mapitems = tmp; /* start new list */
+ else
+ miptr->next = tmp;
+ miptr = tmp;
+ miptr->mode = mode;
+ miptr->type = type;
+ miptr->line = xtalloc(l + 1, char);
+ *(miptr->line) = 0;
+ strncat(miptr->line, s, l);
+ miptr->next = NULL;
+ }
+ return p;
+}
+
+void pdfmapfile(integer t)
+{
+ add_map_item(makecstring(tokenstostring(t)), MAPFILE);
+ flushstr(lasttokensstring);
+}
+
+void pdfmapline(integer t)
+{
+ add_map_item(makecstring(tokenstostring(t)), MAPLINE);
+ flushstr(lasttokensstring);
+}
+
+void pdfinitmapfile(string map_name)
+{
+ if (mapitems == NULL) {
+ mapitems = xtalloc(1, mapitem);
+ miptr = mapitems;
+ miptr->mode = FM_DUPIGNORE;
+ miptr->type = MAPFILE;
+ miptr->line = xstrdup(map_name);
+ miptr->next = NULL;
+ }
+}
+
+/**********************************************************************/
+/* cleaning up... */
+
+static void destroy_fm_entry_tfm(void *pa, void *pb)
+{
+ fm_entry *fm;
+ fm = (fm_entry *) pa;
+ if (!has_pslink(fm))
+ delete_fm_entry(fm);
+ else
+ unset_tfmlink(fm);
+}
+
+static void destroy_fm_entry_ps(void *pa, void *pb)
+{
+ fm_entry *fm;
+ fm = (fm_entry *) pa;
+ if (!has_tfmlink(fm))
+ delete_fm_entry(fm);
+ else
+ unset_pslink(fm);
+}
+
+static void destroy_ff_entry(void *pa, void *pb)
+{
+ ff_entry *ff;
+ ff = (ff_entry *) pa;
+ delete_ff_entry(ff);
+}
+
+void fm_free(void)
+{
+ if (tfm_tree != NULL)
+ avl_destroy(tfm_tree, destroy_fm_entry_tfm);
+ if (ps_tree != NULL)
+ avl_destroy(ps_tree, destroy_fm_entry_ps);
+ if (ff_tree != NULL)
+ avl_destroy(ff_tree, destroy_ff_entry);
+}
+
+/**********************************************************************/
+/* end of mapfile.c */
diff --git a/Build/source/texk/web2c/pdftexdir/misc.ch b/Build/source/texk/web2c/pdftexdir/misc.ch
new file mode 100644
index 00000000000..0d69f25597c
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/misc.ch
@@ -0,0 +1,21 @@
+% WEB change file containing miscellany extensions for pdfTeX
+%
+% Copyright (c) 1996-2002 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/misc.ch#5 $
diff --git a/Build/source/texk/web2c/pdftexdir/noligatures.ch b/Build/source/texk/web2c/pdftexdir/noligatures.ch
new file mode 100644
index 00000000000..2a8ef91f4a1
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/noligatures.ch
@@ -0,0 +1,116 @@
+% Copyright (c) 2005 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftex.ch#163 $
+@ This change file creates an extra primitive named \.{\\pdfnoligatures}, allowing
+you to destroy all ligatures of a loaded font. The command code is
+|assign_font_int|, with the new modifier value |no_lig_code|.
+
+Nothing other than the |char_tag| value is changed, and nothing is saved.
+The primitive works directly on |font_info|, so all changes are global,
+the same as for the other font assignment primitives. Usage is quite
+straightforward: \.{\\pdfnoligatures \\f } disables ligatures for font \.{\\f}.
+The expansion of \.{\\pdfnoligatures \\f } is either |1|, when the font has
+no ligatures, or |0|, when the font does have ligatures.
+
+Thanh: this patch uses |orig_char_info| because it is to be inserted
+after tex.pch. If you merge this into pdftex.ch, you may want to change
+back to |char_info|. It would not compile without using the
+|orig| trick because |effective_char| is not yet known at the spot
+where |test_no_ligatures| is used. sigh.
+
+@x [230]
+@d ef_code_base == 4
+@y
+@d ef_code_base == 4
+@d no_lig_code == 6 {|tag_code| is 5 }
+@z
+
+@x [230]
+begin scan_font_ident;
+if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+else if m=1 then scanned_result(skew_char[cur_val])(int_val)
+@y
+begin scan_font_ident;
+if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+else if m=1 then scanned_result(skew_char[cur_val])(int_val)
+else if m=no_lig_code then scanned_result(test_no_ligatures(cur_val))(int_val)
+@z
+
+@x [577]
+@<Declare procedures that scan font-related stuff@>=
+function get_tag_code(f: internal_font_number; c: eight_bits): integer;
+@y
+@<Declare procedures that scan font-related stuff@>=
+function test_no_ligatures(f: internal_font_number): integer;
+label exit;
+var c:integer;
+begin
+ test_no_ligatures:= 1;
+ for c := font_bc[f] to font_ec[f] do
+ if char_exists(orig_char_info(f)(c)) then
+ if odd(char_tag(orig_char_info(f)(c))) then begin
+ test_no_ligatures:= 0;
+ return;
+ end;
+ exit:
+end;
+
+function get_tag_code(f: internal_font_number; c: eight_bits): integer;
+@z
+
+@x [???]
+function init_font_base(v: integer): integer;
+@y
+procedure set_no_ligatures(f: internal_font_number);
+var c:integer;
+begin
+ for c := font_bc[f] to font_ec[f] do
+ if char_exists(orig_char_info(f)(c)) then
+ if char_tag(orig_char_info(f)(c))=lig_tag then
+ op_byte(orig_char_info(f)(c)) := (op_byte(orig_char_info(f)(c))) - lig_tag;
+end;
+
+function init_font_base(v: integer): integer;
+@z
+
+@x [1253]
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ if n < lp_code_base then begin
+@y
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ if n = no_lig_code then set_no_ligatures(f)
+ else if n < lp_code_base then begin
+@z
+
+@x [1254]
+primitive("efcode",assign_font_int,ef_code_base);
+@!@:ef_code_}{\.{\\efcode} primitive@>
+@y
+primitive("efcode",assign_font_int,ef_code_base);
+@!@:ef_code_}{\.{\\efcode} primitive@>
+primitive("pdfnoligatures",assign_font_int,no_lig_code);
+@!@:no_lig_code_}{\.{\\pdfnoligatures} primitive@>
+@z
+
+@x [1255]
+ef_code_base: print_esc("efcode");
+@y
+ef_code_base: print_esc("efcode");
+no_lig_code: print_esc("pdfnoligatures");
+@z
diff --git a/Build/source/texk/web2c/pdftexdir/pdfstrcmp.ch b/Build/source/texk/web2c/pdftexdir/pdfstrcmp.ch
new file mode 100644
index 00000000000..071ba74f281
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdfstrcmp.ch
@@ -0,0 +1,609 @@
+% Copyright (c) 2005 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftex.ch#163 $
+%
+% experimental patch to make \pdfstrcmp expandable
+%
+% put it after tex.pch
+%
+% x line numbers of file pdfetex-org.web before patch
+%
+%***********************************************************************
+
+@x 9388
+@d pdftex_last_item_codes = pdftex_first_rint_code + 10 {end of \pdfTeX's command codes}
+@y
+@d pdf_shell_escape_code = pdftex_first_rint_code + 11 {code for \.{\\pdfshellescape}}
+@d pdftex_last_item_codes = pdftex_first_rint_code + 11 {end of \pdfTeX's command codes}
+@z
+
+@x 9442
+primitive("pdfelapsedtime",last_item,elapsed_time_code);
+@!@:elapsed_time_}{\.{\\pdfelapsedtime} primitive@>
+@y
+primitive("pdfelapsedtime",last_item,elapsed_time_code);
+@!@:elapsed_time_}{\.{\\pdfelapsedtime} primitive@>
+primitive("pdfshellescape",last_item,pdf_shell_escape_code);
+@!@:elapsed_time_}{\.{\\pdfshellescape} primitive@>
+@z
+
+@x 9470
+ elapsed_time_code: print_esc("pdfelapsedtime");
+@y
+ elapsed_time_code: print_esc("pdfelapsedtime");
+ pdf_shell_escape_code: print_esc("pdfshellescape");
+@z
+
+@x 9561
+ elapsed_time_code: cur_val := get_microinterval;
+@y
+ elapsed_time_code: cur_val := get_microinterval;
+ pdf_shell_escape_code:
+ begin
+ if shell_enabled_p then cur_val := 1
+ else cur_val := 0;
+ end;
+@z
+
+@x 10332
+@d pdf_last_escaped_string_code = pdftex_first_expand_code + 7 {command code for \.{\\pdflastescapedstring}}
+@d pdf_last_escaped_name_code = pdftex_first_expand_code + 8 {command code for \.{\\pdflastescapename}}
+@y
+@d pdf_escape_string_code = pdftex_first_expand_code + 7 {command code for \.{\\pdfescapestring}}
+@d pdf_escape_name_code = pdftex_first_expand_code + 8 {command code for \.{\\pdfescapename}}
+@z
+
+@x 10336
+@d pdftex_convert_codes = pdftex_first_expand_code + 11 {end of \pdfTeX's command codes}
+@y
+@d pdf_strcmp_code = pdftex_first_expand_code + 11 {command code for \.{\\pdfstrcmp}}
+@d pdf_escape_hex_code = pdftex_first_expand_code + 12 {command code for \.{\\pdfescapehex}}
+@d pdf_unescape_hex_code = pdftex_first_expand_code + 13 {command code for \.{\\pdfunescapehex}}
+@d pdf_creation_date_code = pdftex_first_expand_code + 14 {command code for \.{\\pdfcreationdate}}
+@d pdf_file_mod_date_code = pdftex_first_expand_code + 15 {command code for \.{\\pdffilemoddate}}
+@d pdf_file_size_code = pdftex_first_expand_code + 16 {command code for \.{\\pdffilesize}}
+@d pdf_mdfive_sum_code = pdftex_first_expand_code + 17 {command code for \.{\\pdfmdfivesum}}
+@d pdf_file_dump_code = pdftex_first_expand_code + 18 {command code for \.{\\pdffiledump}}
+@d pdf_match_code = pdftex_first_expand_code + 19 {command code for \.{\\pdfmatch}}
+@d pdf_last_match_code = pdftex_first_expand_code + 20 {command code for \.{\\pdflastmatch}}
+@d pdftex_convert_codes = pdftex_first_expand_code + 21 {end of \pdfTeX's command codes}
+@z
+
+%***********************************************************************
+
+@x 10369
+primitive("pdflastescapedstring",convert,pdf_last_escaped_string_code);@/
+@!@:pdf_last_escaped_string_}{\.{\\pdflastescapedstring} primitive@>
+primitive("pdflastescapedname",convert,pdf_last_escaped_name_code);@/
+@!@:pdf_last_escaped_name_}{\.{\\pdflastescapedname} primitive@>
+@y
+primitive("pdfescapestring",convert,pdf_escape_string_code);@/
+@!@:pdf_escape_string_}{\.{\\pdfescapestring} primitive@>
+primitive("pdfescapename",convert,pdf_escape_name_code);@/
+@!@:pdf_escape_name_}{\.{\\pdfescapename} primitive@>
+primitive("pdfescapehex",convert,pdf_escape_hex_code);@/
+@!@:pdf_escape_hex_}{\.{\\pdfescapehex} primitive@>
+primitive("pdfunescapehex",convert,pdf_unescape_hex_code);@/
+@!@:pdf_unescape_hex_}{\.{\\pdfunescapehex} primitive@>
+primitive("pdfcreationdate",convert,pdf_creation_date_code);@/
+@!@:pdf_creation_date_}{\.{\\pdfcreationdate} primitive@>
+primitive("pdffilemoddate",convert,pdf_file_mod_date_code);@/
+@!@:pdf_file_mod_date_}{\.{\\pdffilemoddate} primitive@>
+primitive("pdffilesize",convert,pdf_file_size_code);@/
+@!@:pdf_file_size_}{\.{\\pdffilesize} primitive@>
+primitive("pdfmdfivesum",convert,pdf_mdfive_sum_code);@/
+@!@:pdf_mdfive_sum_}{\.{\\pdfmdfivesum} primitive@>
+primitive("pdffiledump",convert,pdf_file_dump_code);@/
+@!@:pdf_file_dump_}{\.{\\pdffiledump} primitive@>
+primitive("pdfmatch",convert,pdf_match_code);@/
+@!@:pdf_match_}{\.{\\pdfmatch} primitive@>
+primitive("pdflastmatch",convert,pdf_last_match_code);@/
+@!@:pdf_last_match_}{\.{\\pdflastmatch} primitive@>
+primitive("pdfstrcmp",convert,pdf_strcmp_code);@/
+@!@:pdf_strcmp_}{\.{\\pdfstrcmp} primitive@>
+@z
+
+%***********************************************************************
+
+@x 10394
+ pdf_last_escaped_string_code: print_esc("pdflastescapedstring");
+ pdf_last_escaped_name_code: print_esc("pdflastescapedname");
+@y
+ pdf_escape_string_code: print_esc("pdfescapestring");
+ pdf_escape_name_code: print_esc("pdfescapename");
+ pdf_escape_hex_code: print_esc("pdfescapehex");
+ pdf_unescape_hex_code: print_esc("pdfunescapehex");
+ pdf_creation_date_code: print_esc("pdfcreationdate");
+ pdf_file_mod_date_code: print_esc("pdffilemoddate");
+ pdf_file_size_code: print_esc("pdffilesize");
+ pdf_mdfive_sum_code: print_esc("pdfmdfivesum");
+ pdf_file_dump_code: print_esc("pdffiledump");
+ pdf_match_code: print_esc("pdfmatch");
+ pdf_last_match_code: print_esc("pdflastmatch");
+ pdf_strcmp_code: print_esc("pdfstrcmp");
+@z
+
+%***********************************************************************
+
+@x 10403
+@p procedure conv_toks;
+var old_setting:0..max_selector; {holds |selector| setting}
+p, q: pointer;
+@!c:number_code..job_name_code; {desired type of conversion}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!b:pool_pointer; {base of temporary string}
+@!i, l: integer; {index to access escaped string or name}
+begin c:=cur_chr; @<Scan the argument for command |c|@>;
+old_setting:=selector; selector:=new_string; b:=pool_ptr;
+@<Print the result of command |c|@>;
+selector:=old_setting; link(garbage):=str_toks(b); ins_list(link(temp_head));
+end;
+@y
+@p procedure conv_toks;
+label exit;
+var old_setting:0..max_selector; {holds |selector| setting}
+p, q: pointer;
+@!c:number_code..job_name_code; {desired type of conversion}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!save_def_ref: pointer; {|def_ref| upon entry, important if inside `\.{\\message}'}
+@!save_warning_index: pointer;
+@!bool: boolean; {temp boolean}
+@!i: integer; {first temp integer}
+@!j: integer; {second temp integer}
+@!b:pool_pointer; {base of temporary string}
+@!s: str_number; {first temp string}
+@!t: str_number; {second temp string}
+begin c:=cur_chr; @<Scan the argument for command |c|@>;
+old_setting:=selector; selector:=new_string; b:=pool_ptr;
+@<Print the result of command |c|@>;
+selector:=old_setting; link(garbage):=str_toks(b); ins_list(link(temp_head));
+exit:end;
+@z
+
+@x 10450
+pdf_last_escaped_string_code: do_nothing;
+pdf_last_escaped_name_code: do_nothing;
+job_name_code: if job_name=0 then open_log_file;
+@y
+pdf_escape_string_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ escapestring(str_start[s]);
+ link(garbage) := str_toks(b);
+ flush_str(s);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_escape_name_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ escapename(str_start[s]);
+ link(garbage) := str_toks(b);
+ flush_str(s);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_escape_hex_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ escapehex(str_start[s]);
+ link(garbage) := str_toks(b);
+ flush_str(s);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_unescape_hex_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ unescapehex(str_start[s]);
+ link(garbage) := str_toks(b);
+ flush_str(s);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_creation_date_code:
+ begin
+ b := pool_ptr;
+ getcreationdate;
+ link(garbage) := str_toks(b);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_file_mod_date_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ getfilemoddate(s);
+ link(garbage) := str_toks(b);
+ flush_str(s);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_file_size_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ getfilesize(s);
+ link(garbage) := str_toks(b);
+ flush_str(s);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_mdfive_sum_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ bool := scan_keyword("file");
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ getmd5sum(s, bool);
+ link(garbage) := str_toks(b);
+ flush_str(s);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_file_dump_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ {scan offset}
+ cur_val := 0;
+ if (scan_keyword("offset")) then begin
+ scan_int;
+ if (cur_val < 0) then begin
+ print_err("Bad file offset");
+@.Bad file offset@>
+ help2("A file offset must be between 0 and 2^{31}-1,")@/
+ ("I changed this one to zero.");
+ int_error(cur_val);
+ cur_val := 0;
+ end;
+ end;
+ i := cur_val;
+ {scan length}
+ cur_val := 0;
+ if (scan_keyword("length")) then begin
+ scan_int;
+ if (cur_val < 0) then begin
+ print_err("Bad dump length");
+@.Bad dump length@>
+ help2("A dump length must be between 0 and 2^{31}-1,")@/
+ ("I changed this one to zero.");
+ int_error(cur_val);
+ cur_val := 0;
+ end;
+ end;
+ j := cur_val;
+ {scan file name}
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ getfiledump(s, i, j);
+ link(garbage) := str_toks(b);
+ flush_str(s);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_match_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ {scan for icase}
+ bool := scan_keyword("icase");
+ {scan for subcount}
+ i := -1; {default for subcount}
+ if scan_keyword("subcount") then begin
+ scan_int;
+ i := cur_val;
+ end;
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ scan_pdf_ext_toks;
+ t := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ matchstrings(s, t, i, bool);
+ link(garbage) := str_toks(b);
+ flush_str(t);
+ flush_str(s);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_last_match_code:
+ begin
+ scan_int;
+ if cur_val < 0 then begin
+ print_err("Bad match number");
+@.Bad match number@>
+ help2("Since I expected zero or a positive number,")@/
+ ("I changed this one to zero.");
+ int_error(cur_val);
+ cur_val := 0;
+ end;
+ b := pool_ptr;
+ getmatch(cur_val);
+ link(garbage) := str_toks(b);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_strcmp_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ compare_strings;
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ end;
+job_name_code: if job_name=0 then open_log_file;
+@z
+
+%***********************************************************************
+
+@x 10512
+pdf_last_escaped_string_code: begin
+ l := escapedstrlen;
+ for i := 0 to l - 1 do
+ print_char(getescapedstrchar(i));
+end;
+pdf_last_escaped_name_code: begin
+ l := escapednamelen;
+ for i := 0 to l - 1 do
+ print_char(getescapednamechar(i));
+end;
+job_name_code: print(job_name);
+@y
+pdf_strcmp_code: print_int(cur_val);
+job_name_code: print(job_name);
+@z
+
+%***********************************************************************
+
+@x 32168
+@d pdf_strcmp_code == pdftex_first_extension_code + 24
+@d pdf_escape_string_code == pdftex_first_extension_code + 25
+@d pdf_escape_name_code == pdftex_first_extension_code + 26
+@d reset_timer_code == pdftex_first_extension_code + 27
+@d pdf_font_expand_code == pdftex_first_extension_code + 28
+@d pdftex_last_extension_code == pdftex_first_extension_code + 28
+@y
+@d reset_timer_code == pdftex_first_extension_code + 24
+@d pdf_font_expand_code == pdftex_first_extension_code + 25
+@d pdftex_last_extension_code == pdftex_first_extension_code + 25
+@z
+
+%***********************************************************************
+
+@x 32239
+primitive("pdfstrcmp",extension,pdf_strcmp_code);@/
+@!@:pdf_strcmp_}{\.{\\pdfstrcmp} primitive@>
+primitive("pdfescapestring",extension,pdf_escape_string_code);@/
+@!@:pdf_escape_string_}{\.{\\pdfescapestring} primitive@>
+primitive("pdfescapename",extension,pdf_escape_name_code);@/
+@!@:pdf_escape_name_}{\.{\\pdfescapename} primitive@>
+@y
+@z
+
+%***********************************************************************
+
+@x 32287
+ pdf_strcmp_code: print_esc("pdfstrcmp");
+ pdf_escape_string_code: print_esc("pdfescapestring");
+ pdf_escape_name_code: print_esc("pdfescapename");
+@y
+@z
+
+%***********************************************************************
+
+@x 32337
+pdf_strcmp_code: @<Implement \.{\\pdfstrcmp}@>;
+pdf_escape_string_code: @<Implement \.{\\pdfescapestring}@>;
+pdf_escape_name_code: @<Implement \.{\\pdfescapename}@>;
+@y
+@z
+
+%***********************************************************************
+
+@x 32463
+procedure compare_strings; {to implement \.{\\pdfstrcmp}}
+label done;
+var s1, s2: str_number;
+ i1, i2, j1, j2: pool_pointer;
+ result: integer;
+begin
+ call_func(scan_toks(false, true));
+ s1 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ call_func(scan_toks(false, true));
+ s2 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ i1 := str_start[s1];
+ j1 := str_start[s1 + 1];
+ i2 := str_start[s2];
+ j2 := str_start[s2 + 1];
+ while (i1 < j1) and (i2 < j2) do begin
+ if str_pool[i1] < str_pool[i2] then begin
+ result := -1;
+ goto done;
+ end;
+ if str_pool[i1] > str_pool[i2] then begin
+ result := 1;
+ goto done;
+ end;
+ incr(i1);
+ incr(i2);
+ end;
+ if (i1 = j1) and (i2 = j2) then
+ result := 0
+ else if i1 < j1 then
+ result := 1
+ else
+ result := -1;
+done:
+ pdf_retval := result;
+ flush_str(s2);
+ flush_str(s1);
+end;
+@y
+procedure compare_strings; {to implement \.{\\pdfstrcmp}}
+label done;
+var s1, s2: str_number;
+ i1, i2, j1, j2: pool_pointer;
+begin
+ call_func(scan_toks(false, true));
+ s1 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ call_func(scan_toks(false, true));
+ s2 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ i1 := str_start[s1];
+ j1 := str_start[s1 + 1];
+ i2 := str_start[s2];
+ j2 := str_start[s2 + 1];
+ while (i1 < j1) and (i2 < j2) do begin
+ if str_pool[i1] < str_pool[i2] then begin
+ cur_val := -1;
+ goto done;
+ end;
+ if str_pool[i1] > str_pool[i2] then begin
+ cur_val := 1;
+ goto done;
+ end;
+ incr(i1);
+ incr(i2);
+ end;
+ if (i1 = j1) and (i2 = j2) then
+ cur_val := 0
+ else if i1 < j1 then
+ cur_val := 1
+ else
+ cur_val := -1;
+done:
+ flush_str(s2);
+ flush_str(s1);
+ cur_val_level := int_val;
+end;
+@z
+
+%***********************************************************************
+
+@x 33387
+@ @<Implement \.{\\pdfescapestring}@>=
+begin
+ scan_pdf_ext_toks;
+ escapestr(tokens_to_string(def_ref));
+ flush_str(last_tokens_string);
+ delete_token_ref(def_ref);
+end
+
+@ @<Implement \.{\\pdfescapename}@>=
+begin
+ scan_pdf_ext_toks;
+ escapename(tokens_to_string(def_ref));
+ flush_str(last_tokens_string);
+ delete_token_ref(def_ref);
+end
+@y
+@z
+
+@x 33406
+@ @<Implement \.{\\pdfstrcmp}@>=
+compare_strings
+@y
+@z
+
+@x 33409
+@ @<Set initial values of key variables@>=
+ seconds_and_micros(epochseconds,microseconds);
+@y
+@ @<Set initial values of key variables@>=
+ seconds_and_micros(epochseconds,microseconds);
+ init_start_time;
+@z
+
+%***********************************************************************
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.ch b/Build/source/texk/web2c/pdftexdir/pdftex.ch
new file mode 100644
index 00000000000..6ae23335465
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftex.ch
@@ -0,0 +1,6853 @@
+% WEB change file containing code for pdfTeX features extending TeX; % to be applied to tex.web (Version 3.141592) in order to define the
+% pdfTeX program.
+%
+% Note: This file, pdftex.ch, defines pdftex.web in terms of changes to be
+% applied to tex.web; in terms of a program such as TIE (or equivalent),
+%
+% tex.web )
+% + ) => tie -m ... => etex.web
+% pdftexdir/pdftex.ch )
+%
+% In addition, this file is used to define pdfetex.web, a combination
+% of e-TeX and pdfTeX as follows:
+%
+% tex.web )
+% + )
+% etexdir/etex.ch )
+% + )
+% pdfetexdir/pdfetex.ch1 ) => tie -m ... => pdfetex.web
+% + )
+% pdftexdir/pdftex.ch )
+% + )
+% pdfetexdir/pdfetex.ch2 )
+%
+% where the two (small) files pdfetexdir/pdfetex.ch[12] take care of
+% interferences between e-Tex changes (etexdir/etex.ch) and pdfTeX changes
+% (pdftexdir/pdftex.ch). Consequently, changes in these files have to be
+% coordinated.
+%
+% Copyright (c) 1996-2005 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftex.ch#171 $
+%
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+%
+% all pdfTeX new primitives have the prefix "\pdf", apart from:
+% o extension of \vadjust
+% o extension of \font
+% o \efcode
+% o \lpcode, \rpcode
+% o \leftmarginkern, \rightmarginkern
+
+@x limbo
+\def\PASCAL{Pascal}
+@y
+\def\PASCAL{Pascal}
+\def\pdfTeX{pdf\TeX}
+\def\PDF{PDF}
+@z
+
+@x [2] - This change is made for TeX 3.141592
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@y
+@d pdftex_version==130 { \.{\\pdftexversion} }
+@d pdftex_revision=="4" { \.{\\pdftexrevision} }
+@d pdftex_version_string=='-1.30.4' {current \pdfTeX\ version}
+@#
+@d pdfTeX_banner=='This is pdfTeX, Version 3.141592',pdftex_version_string
+ {printed when \pdfTeX\ starts}
+@#
+@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@#
+@d banner==pdfTeX_banner
+@z
+
+% Some procedures that need to be declared forward
+@x [173]
+@* \[12] Displaying boxes.
+@y
+@<Declare procedures that need to be declared forward for pdftex@>@;
+
+@* \[12] Displaying boxes.
+@z
+
+% Define pdftex token list parameters
+@x [230]
+@d toks_base=local_base+10 {table of 256 token list registers}
+@y
+@d tex_toks=local_base+10 {end of \TeX's token list parameters}
+@#
+@d pdftex_first_loc = tex_toks {base for \pdfTeX's token list parameters}
+@d pdf_pages_attr_loc = pdftex_first_loc + 0 {points to token list for \.{\\pdfpagesattr}}
+@d pdf_page_attr_loc = pdftex_first_loc + 1 {points to token list for \.{\\pdfpageattr}}
+@d pdf_page_resources_loc = pdftex_first_loc + 2 {points to token list for \.{\\pdfpageresources}}
+@d pdf_pk_mode_loc = pdftex_first_loc + 3 {points to token list for \.{\\pdfpkmode}}
+@d pdf_toks=pdftex_first_loc+4 {end of \pdfTeX's token list parameters}
+@#
+@d toks_base=pdf_toks {table of 256 token list registers}
+@z
+
+@x [230]
+@d err_help==equiv(err_help_loc)
+@y
+@d err_help==equiv(err_help_loc)
+@d pdf_pages_attr==equiv(pdf_pages_attr_loc)
+@d pdf_page_attr==equiv(pdf_page_attr_loc)
+@d pdf_page_resources==equiv(pdf_page_resources_loc)
+@d pdf_pk_mode==equiv(pdf_pk_mode_loc)
+@z
+
+@x [230]
+primitive("errhelp",assign_toks,err_help_loc);
+@!@:err_help_}{\.{\\errhelp} primitive@>
+@y
+primitive("errhelp",assign_toks,err_help_loc);
+@!@:err_help_}{\.{\\errhelp} primitive@>
+primitive("pdfpagesattr",assign_toks,pdf_pages_attr_loc);
+@!@:pdf_pages_attr_}{\.{\\pdfpagesattr} primitive@>
+primitive("pdfpageattr",assign_toks,pdf_page_attr_loc);
+@!@:pdf_page_attr_}{\.{\\pdfpageattr} primitive@>
+primitive("pdfpageresources",assign_toks,pdf_page_resources_loc);
+@!@:pdf_page_resources_}{\.{\\pdfpageresources} primitive@>
+primitive("pdfpkmode",assign_toks,pdf_pk_mode_loc);
+@!@:pdf_pk_mode_}{\.{\\pdfpkmode} primitive@>
+@z
+
+@x [231]
+ othercases print_esc("errhelp")
+@y
+ pdf_pages_attr_loc: print_esc("pdfpagesattr");
+ pdf_page_attr_loc: print_esc("pdfpageattr");
+ pdf_page_resources_loc: print_esc("pdfpageresources");
+ pdf_pk_mode_loc: print_esc("pdfpkmode");
+ othercases print_esc("errhelp")
+@z
+
+% Define pdftex integer parameters
+@x [236]
+@d int_pars=55 {total number of integer parameters}
+@y
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@#
+@d pdftex_first_integer_code = tex_int_pars {base for \pdfTeX's integer parameters}
+@d pdf_output_code = pdftex_first_integer_code + 0 {switch on PDF output if positive}
+@d pdf_compress_level_code = pdftex_first_integer_code + 1 {compress level of streams}
+@d pdf_decimal_digits_code = pdftex_first_integer_code + 2 {digits after the decimal point of numbers}
+@d pdf_move_chars_code = pdftex_first_integer_code + 3 {move chars 0..31 to higher area if possible}
+@d pdf_image_resolution_code = pdftex_first_integer_code + 4 {default image resolution}
+@d pdf_pk_resolution_code = pdftex_first_integer_code + 5 {default resolution of PK font}
+@d pdf_unique_resname_code = pdftex_first_integer_code + 6 {generate unique names for resouces}
+@d pdf_option_always_use_pdfpagebox_code = pdftex_first_integer_code + 7 {if the pdf inclusion should always use a specific pdf page box}
+@d pdf_option_pdf_inclusion_errorlevel_code = pdftex_first_integer_code + 8 {if the pdf inclusion should treat pdfs newer than |pdf_minor_version| as an error}
+@d pdf_minor_version_code = pdftex_first_integer_code + 9 {fractional part of the pdf version produced}
+@d pdf_force_pagebox_code = pdftex_first_integer_code + 10 {if the pdf inclusion should always use a specific pdf page box}
+@d pdf_inclusion_errorlevel_code = pdftex_first_integer_code + 11 {if the pdf inclusion should treat pdfs newer than |pdf_minor_version| as an error}
+@d pdf_gamma_code = pdftex_first_integer_code + 12
+@d pdf_image_gamma_code = pdftex_first_integer_code + 13
+@d pdf_image_hicolor_code = pdftex_first_integer_code + 14
+@d pdf_image_apply_gamma_code = pdftex_first_integer_code + 15
+@d pdf_px_dimen_code = pdftex_first_integer_code + 16 {the code for the pixel dimen value}
+@d pdf_int_pars=pdftex_first_integer_code + 17 {total number of \pdfTeX's integer parameters}
+@#
+@d int_pars=pdf_int_pars {total number of integer parameters}
+@z
+
+@x [236]
+@d error_context_lines==int_par(error_context_lines_code)
+@y
+@d error_context_lines==int_par(error_context_lines_code)
+@#
+@d pdf_output == int_par(pdf_output_code)
+@d pdf_compress_level == int_par(pdf_compress_level_code)
+@d pdf_decimal_digits == int_par(pdf_decimal_digits_code)
+@d pdf_move_chars == int_par(pdf_move_chars_code)
+@d pdf_image_resolution == int_par(pdf_image_resolution_code)
+@d pdf_pk_resolution == int_par(pdf_pk_resolution_code)
+@d pdf_unique_resname == int_par(pdf_unique_resname_code)
+@d pdf_option_always_use_pdfpagebox == int_par(pdf_option_always_use_pdfpagebox_code)
+@d pdf_option_pdf_inclusion_errorlevel == int_par(pdf_option_pdf_inclusion_errorlevel_code)
+@d pdf_minor_version == int_par(pdf_minor_version_code)
+@d pdf_force_pagebox == int_par(pdf_force_pagebox_code)
+@d pdf_inclusion_errorlevel == int_par(pdf_inclusion_errorlevel_code)
+@d pdf_gamma == int_par(pdf_gamma_code)
+@d pdf_image_gamma == int_par(pdf_image_gamma_code)
+@d pdf_image_hicolor == int_par(pdf_image_hicolor_code)
+@d pdf_image_apply_gamma == int_par(pdf_image_apply_gamma_code)
+@d pdf_px_dimen == int_par(pdf_px_dimen_code)
+@z
+
+@x [237]
+error_context_lines_code:print_esc("errorcontextlines");
+@y
+error_context_lines_code:print_esc("errorcontextlines");
+@#
+pdf_output_code: print_esc("pdfoutput");
+pdf_compress_level_code: print_esc("pdfcompresslevel");
+pdf_decimal_digits_code: print_esc("pdfdecimaldigits");
+pdf_move_chars_code: print_esc("pdfmovechars");
+pdf_image_resolution_code: print_esc("pdfimageresolution");
+pdf_pk_resolution_code: print_esc("pdfpkresolution");
+pdf_unique_resname_code: print_esc("pdfuniqueresname");
+pdf_option_always_use_pdfpagebox_code: print_esc("pdfoptionalwaysusepdfpagebox");
+pdf_option_pdf_inclusion_errorlevel_code: print_esc("pdfoptionpdfinclusionerrorlevel");
+pdf_minor_version_code: print_esc("pdfminorversion");
+pdf_force_pagebox_code: print_esc("pdfforcepagebox");
+pdf_inclusion_errorlevel_code: print_esc("pdfinclusionerrorlevel");
+pdf_gamma_code: print_esc("pdfgamma");
+pdf_image_gamma_code: print_esc("pdfimagegamma");
+pdf_image_hicolor_code: print_esc("pdfimagehicolor");
+pdf_image_apply_gamma_code: print_esc("pdfimageapplygamma");
+pdf_px_dimen_code: print_esc("pdfpxdimen");
+@z
+
+@x [238]
+primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+@y
+primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+primitive("pdfoutput",assign_int,int_base+pdf_output_code);@/
+@!@:pdf_output_}{\.{\\pdfoutput} primitive@>
+primitive("pdfcompresslevel",assign_int,int_base+pdf_compress_level_code);@/
+@!@:pdf_compress_level_}{\.{\\pdfcompresslevel} primitive@>
+primitive("pdfdecimaldigits",assign_int,int_base+pdf_decimal_digits_code);@/
+@!@:pdf_decimal_digits_}{\.{\\pdfdecimaldigits} primitive@>
+primitive("pdfmovechars",assign_int,int_base+pdf_move_chars_code);@/
+@!@:pdf_move_chars_}{\.{\\pdfmovechars} primitive@>
+primitive("pdfimageresolution",assign_int,int_base+pdf_image_resolution_code);@/
+@!@:pdf_image_resolution_}{\.{\\pdfimageresolution} primitive@>
+primitive("pdfpkresolution",assign_int,int_base+pdf_pk_resolution_code);@/
+@!@:pdf_pk_resolution_}{\.{\\pdfpkresolution} primitive@>
+primitive("pdfuniqueresname",assign_int,int_base+pdf_unique_resname_code);@/
+@!@:pdf_unique_resname_}{\.{\\pdfuniqueresname} primitive@>
+primitive("pdfoptionpdfminorversion",assign_int,int_base+pdf_minor_version_code);@/
+@!@:pdf_minor_version_}{\.{\\pdfoptionpdfminorversion} primitive@>
+primitive("pdfoptionalwaysusepdfpagebox",assign_int,int_base+pdf_option_always_use_pdfpagebox_code);@/
+@!@:pdf_option_always_use_pdfpagebox_}{\.{\\pdfoptionalwaysusepdfpagebox} primitive@>
+primitive("pdfoptionpdfinclusionerrorlevel",assign_int,int_base+pdf_option_pdf_inclusion_errorlevel_code);@/
+@!@:pdf_option_pdf_inclusion_errorlevel_}{\.{\\pdfoptionpdfinclusionerrorlevel} primitive@>
+primitive("pdfminorversion",assign_int,int_base+pdf_minor_version_code);@/
+@!@:pdf_minor_version_}{\.{\\pdfminorversion} primitive@>
+primitive("pdfforcepagebox",assign_int,int_base+pdf_force_pagebox_code);@/
+@!@:pdf_force_pagebox_}{\.{\\pdfforcepagebox} primitive@>
+primitive("pdfinclusionerrorlevel",assign_int,int_base+pdf_inclusion_errorlevel_code);@/
+@!@:pdf_inclusion_errorlevel_}{\.{\\pdfinclusionerrorlevel} primitive@>
+primitive("pdfgamma",assign_int,int_base+pdf_gamma_code);@/
+@!@:pdf_gamma_}{\.{\\pdfgamma} primitive@>
+primitive("pdfimagegamma",assign_int,int_base+pdf_image_gamma_code);@/
+@!@:pdf_image_gamma_}{\.{\\pdfimagegamma} primitive@>
+primitive("pdfimagehicolor",assign_int,int_base+pdf_image_hicolor_code);@/
+@!@:pdf_image_hicolor_}{\.{\\pdfimagehicolor} primitive@>
+primitive("pdfimageapplygamma",assign_int,int_base+pdf_image_apply_gamma_code);@/
+@!@:pdf_image_apply_gamma_}{\.{\\pdfimageapplygamma} primitive@>
+primitive("pdfpxdimen",assign_int,int_base+pdf_px_dimen_code);@/
+@!@:pdf_px_dimen_}{\.{\\pdfpxdimen} primitive@>
+@z
+
+@x [240] - pxdimen
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+@y
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+pdf_px_dimen := unity;
+@z
+
+% Define pdftex dimension parameters
+@x [247]
+@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking}
+@y
+@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking}
+@d pdftex_first_dimen_code = 21 {first number defined in this section}
+@d pdf_h_origin_code = pdftex_first_dimen_code + 0 {horigin of the PDF output}
+@d pdf_v_origin_code = pdftex_first_dimen_code + 1 {vorigin of the PDF output}
+@d pdf_page_width_code = pdftex_first_dimen_code + 2 {page width of the PDF output}
+@d pdf_page_height_code = pdftex_first_dimen_code + 3 {page height of the PDF output}
+@d pdf_link_margin_code = pdftex_first_dimen_code + 4 {link margin in the PDF output}
+@d pdf_dest_margin_code = pdftex_first_dimen_code + 5 {dest margin in the PDF output}
+@d pdf_thread_margin_code = pdftex_first_dimen_code + 6 {thread margin in the PDF output}
+@d pdf_first_line_height_code = pdftex_first_dimen_code + 7
+@d pdf_last_line_depth_code = pdftex_first_dimen_code + 8
+@d pdf_each_line_height_code = pdftex_first_dimen_code + 9
+@d pdf_each_line_depth_code = pdftex_first_dimen_code + 10
+@d pdftex_last_dimen_code = pdftex_first_dimen_code + 10 {last number defined in this section}
+@z
+
+@x
+@d dimen_pars=21 {total number of dimension parameters}
+@y
+@d dimen_pars = pdftex_last_dimen_code + 1 {total number of dimension parameters}
+@z
+
+@x [247]
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@y
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@d pdf_h_origin == dimen_par(pdf_h_origin_code)
+@d pdf_v_origin == dimen_par(pdf_v_origin_code)
+@d pdf_page_width == dimen_par(pdf_page_width_code)
+@d pdf_page_height == dimen_par(pdf_page_height_code)
+@d pdf_link_margin == dimen_par(pdf_link_margin_code)
+@d pdf_dest_margin == dimen_par(pdf_dest_margin_code)
+@d pdf_thread_margin == dimen_par(pdf_thread_margin_code)
+@d pdf_first_line_height == dimen_par(pdf_first_line_height_code)
+@d pdf_last_line_depth == dimen_par(pdf_last_line_depth_code)
+@d pdf_each_line_height == dimen_par(pdf_each_line_height_code)
+@d pdf_each_line_depth == dimen_par(pdf_each_line_depth_code)
+@z
+
+@x [247]
+emergency_stretch_code:print_esc("emergencystretch");
+@y
+emergency_stretch_code:print_esc("emergencystretch");
+pdf_h_origin_code: print_esc("pdfhorigin");
+pdf_v_origin_code: print_esc("pdfvorigin");
+pdf_page_width_code: print_esc("pdfpagewidth");
+pdf_page_height_code: print_esc("pdfpageheight");
+pdf_link_margin_code: print_esc("pdflinkmargin");
+pdf_dest_margin_code: print_esc("pdfdestmargin");
+pdf_thread_margin_code: print_esc("pdfthreadmargin");
+pdf_first_line_height_code: print_esc("pdffirstlineheight");
+pdf_last_line_depth_code: print_esc("pdflastlinedepth");
+pdf_each_line_height_code: print_esc("pdfeachlineheight");
+pdf_each_line_depth_code: print_esc("pdfeachlinedepth");
+@z
+
+@x [248]
+primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/
+@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
+@y
+primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/
+@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
+primitive("pdfhorigin",assign_dimen,dimen_base+pdf_h_origin_code);@/
+@!@:pdf_h_origin_}{\.{\\pdfhorigin} primitive@>
+primitive("pdfvorigin",assign_dimen,dimen_base+pdf_v_origin_code);@/
+@!@:pdf_v_origin_}{\.{\\pdfvorigin} primitive@>
+primitive("pdfpagewidth",assign_dimen,dimen_base+pdf_page_width_code);@/
+@!@:pdf_page_width_}{\.{\\pdfpagewidth} primitive@>
+primitive("pdfpageheight",assign_dimen,dimen_base+pdf_page_height_code);@/
+@!@:pdf_page_height_}{\.{\\pdfpageheight} primitive@>
+primitive("pdflinkmargin",assign_dimen,dimen_base+pdf_link_margin_code);@/
+@!@:pdf_link_margin_}{\.{\\pdflinkmargin} primitive@>
+primitive("pdfdestmargin",assign_dimen,dimen_base+pdf_dest_margin_code);@/
+@!@:pdf_dest_margin_}{\.{\\pdfdestmargin} primitive@>
+primitive("pdfthreadmargin",assign_dimen,dimen_base+pdf_thread_margin_code);@/
+@!@:pdf_thread_margin_}{\.{\\pdfthreadmargin} primitive@>
+primitive("pdffirstlineheight",assign_dimen,dimen_base+pdf_first_line_height_code);@/
+@!@:pdf_first_line_height_}{\.{\\pdffirstlineheight} primitive@>
+primitive("pdflastlinedepth",assign_dimen,dimen_base+pdf_last_line_depth_code);@/
+@!@:pdf_last_line_depth_}{\.{\\pdflastlinedepth} primitive@>
+primitive("pdfeachlineheight",assign_dimen,dimen_base+pdf_each_line_height_code);@/
+@!@:pdf_each_line_height_}{\.{\\pdfeachlineheight} primitive@>
+primitive("pdfeachlinedepth",assign_dimen,dimen_base+pdf_each_line_depth_code);@/
+@!@:pdf_each_line_depth_}{\.{\\pdfeachlinedepth} primitive@>
+@z
+
+% Define some read-only pdfTeX primitives
+@x [416]
+|glue_val|, |input_line_no_code|, or |badness_code|.
+@y
+|glue_val|, |input_line_no_code|, or |badness_code|.
+\pdfTeX\ adds the codes for its extensions: |pdftex_version_code|, \dots\ .
+@z
+
+@x [416]
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@y
+@d badness_code=input_line_no_code+1 {code for \.{\\badness}}
+@#
+@d pdftex_first_rint_code = badness_code + 1 {base for \pdfTeX's command codes}
+@d pdftex_version_code = pdftex_first_rint_code + 0 {code for \.{\\pdftexversion}}
+@d pdf_last_obj_code = pdftex_first_rint_code + 1 {code for \.{\\pdflastobj}}
+@d pdf_last_xform_code = pdftex_first_rint_code + 2 {code for \.{\\pdflastxform}}
+@d pdf_last_ximage_code = pdftex_first_rint_code + 3 {code for \.{\\pdflastximage}}
+@d pdf_last_ximage_pages_code = pdftex_first_rint_code + 4 {code for \.{\\pdflastximagepages}}
+@d pdf_last_annot_code = pdftex_first_rint_code + 5 {code for \.{\\pdflastannot}}
+@d pdf_last_x_pos_code = pdftex_first_rint_code + 6 {code for \.{\\pdflastxpos}}
+@d pdf_last_y_pos_code = pdftex_first_rint_code + 7 {code for \.{\\pdflastypos}}
+@d pdf_retval_code = pdftex_first_rint_code + 8 {global multi-purpose return value}
+@d pdf_last_ximage_colordepth_code = pdftex_first_rint_code + 9 {code for \.{\\pdflastximagecolordepth}}
+@d elapsed_time_code = pdftex_first_rint_code + 10 {code for \.{\\pdfelapsedtime}}
+@d pdftex_last_item_codes = pdftex_first_rint_code + 10 {end of \pdfTeX's command codes}
+@z
+
+@x [416]
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+@y
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+primitive("pdftexversion",last_item,pdftex_version_code);@/
+@!@:pdftex_version_}{\.{\\pdftexversion} primitive@>
+primitive("pdflastobj",last_item,pdf_last_obj_code);@/
+@!@:pdf_last_obj_}{\.{\\pdflastobj} primitive@>
+primitive("pdflastxform",last_item,pdf_last_xform_code);@/
+@!@:pdf_last_xform_}{\.{\\pdflastxform} primitive@>
+primitive("pdflastximage",last_item,pdf_last_ximage_code);@/
+@!@:pdf_last_ximage_}{\.{\\pdflastximage} primitive@>
+primitive("pdflastximagepages",last_item,pdf_last_ximage_pages_code);@/
+@!@:pdf_last_ximage_pages_}{\.{\\pdflastximagepages} primitive@>
+primitive("pdflastannot",last_item,pdf_last_annot_code);@/
+@!@:pdf_last_annot_}{\.{\\pdflastannot} primitive@>
+primitive("pdflastxpos",last_item,pdf_last_x_pos_code);@/
+@!@:pdf_last_x_pos_}{\.{\\pdflastxpos} primitive@>
+primitive("pdflastypos",last_item,pdf_last_y_pos_code);@/
+@!@:pdf_last_y_pos_}{\.{\\pdflastypos} primitive@>
+primitive("pdfretval",last_item,pdf_retval_code);@/
+@!@:pdf_retval_}{\.{\\pdfretval} primitive@>
+primitive("pdflastximagecolordepth",last_item,pdf_last_ximage_colordepth_code);@/
+@!@:pdf_last_ximage_colordepth_}{\.{\\pdflastximagecolordepth} primitive@>
+primitive("pdfelapsedtime",last_item,elapsed_time_code);
+@!@:elapsed_time_}{\.{\\pdfelapsedtime} primitive@>
+@z
+
+@x [417]
+ othercases print_esc("badness")
+@y
+ pdftex_version_code: print_esc("pdftexversion");
+ pdf_last_obj_code: print_esc("pdflastobj");
+ pdf_last_xform_code: print_esc("pdflastxform");
+ pdf_last_ximage_code: print_esc("pdflastximage");
+ pdf_last_ximage_pages_code: print_esc("pdflastximagepages");
+ pdf_last_annot_code: print_esc("pdflastannot");
+ pdf_last_x_pos_code: print_esc("pdflastxpos");
+ pdf_last_y_pos_code: print_esc("pdflastypos");
+ pdf_retval_code: print_esc("pdfretval");
+ pdf_last_ximage_colordepth_code: print_esc("pdflastximagecolordepth");
+ elapsed_time_code: print_esc("pdfelapsedtime");
+ othercases print_esc("badness")
+@z
+
+@x [424]
+if cur_chr>glue_val then
+@y
+if m>=input_line_no_code then
+@z
+
+@x [424]
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+@y
+ begin case m of
+ input_line_no_code: cur_val:=line;
+ badness_code: cur_val:=last_badness;
+ pdftex_version_code: cur_val := pdftex_version;
+ pdf_last_obj_code: cur_val := pdf_last_obj;
+ pdf_last_xform_code: cur_val := pdf_last_xform;
+ pdf_last_ximage_code: cur_val := pdf_last_ximage;
+ pdf_last_ximage_pages_code: cur_val := pdf_last_ximage_pages;
+ pdf_last_annot_code: cur_val := pdf_last_annot;
+ pdf_last_x_pos_code: cur_val := pdf_last_x_pos;
+ pdf_last_y_pos_code: cur_val := pdf_last_y_pos;
+ pdf_retval_code: cur_val := pdf_retval;
+ pdf_last_ximage_colordepth_code: cur_val := pdf_last_ximage_colordepth;
+ elapsed_time_code: cur_val := get_microinterval;
+ end; {there are no other cases}
+@z
+
+@x [455] - pxdimen
+else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>)
+@.ex@>
+@y
+else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>)
+@.ex@>
+else if scan_keyword("px") then v:=pdf_px_dimen
+@.px@>
+@z
+
+@x new Didot (1nd=0.375mm), new Cicero (1nc=12nd)
+@ The necessary conversion factors can all be specified exactly as
+fractions whose numerator and denominator are 32768 or less.
+According to the definitions here, $\rm2660\,dd\approx1000.33297\,mm$;
+this agrees well with the value $\rm1000.333\,mm$ cited by Bosshard
+@^Bosshard, Hans Rudolf@>
+in {\sl Technische Grundlagen zur Satzherstellung\/} (Bern, 1980).
+@y
+@ The necessary conversion factors can all be specified exactly as
+fractions whose numerator and denominator are 65535 or less.
+According to the definitions here, $\rm2660\,dd\approx1000.33297\,mm$;
+this agrees well with the value $\rm1000.333\,mm$ cited by Bosshard
+@^Bosshard, Hans Rudolf@>
+in {\sl Technische Grundlagen zur Satzherstellung\/} (Bern, 1980).
+The Didot point has been newly standardized in 1978;
+it's now exactly $\rm 1\,nd=0.375\,mm$.
+Conversion uses the equation $0.375=21681/20320/72.27\cdot25.4$.
+The new Cicero follows the new Didot point; $\rm 1\,nc=12\,nd$.
+@z
+
+@x new Didot (1nd=0.375mm), new Cicero (1nc=12nd)
+else if scan_keyword("cc") then set_conversion(14856)(1157)
+@.cc@>
+@y
+else if scan_keyword("cc") then set_conversion(14856)(1157)
+@.cc@>
+else if scan_keyword("nd") then set_conversion(21681)(20320)
+@.nd@>
+else if scan_keyword("nc") then set_conversion(65043)(5080)
+@.nc@>
+@z
+
+@x new Didot (1nd=0.375mm), new Cicero (1nc=12nd)
+ ("cm, mm, dd, cc, bp, or sp; but yours is a new one!")@/
+@y
+ ("cm, mm, dd, cc, nd, nc, bp, or sp; but yours is a new one!")@/
+@z
+
+% Define some char token producing pdfTeX primitives
+@x [468]
+@d number_code=0 {command code for \.{\\number}}
+@y
+\pdfTeX\ adds \.{\\eTeXrevision}, \.{\\pdftexrevision}, \.{\\pdftexbanner},
+\.{\\pdffontname}, \.{\\pdffontobjnum}, \.{\\pdffontsize}, and \.{\\pdfpageref}
+such that |job_name_code| remains last.
+
+@d number_code=0 {command code for \.{\\number}}
+@z
+
+@x [468]
+@d job_name_code=5 {command code for \.{\\jobname}}
+@y
+@d pdftex_first_expand_code = 5 {base for \pdfTeX's command codes}
+@d pdftex_revision_code = pdftex_first_expand_code + 0 {command code for \.{\\pdftexrevision}}
+@d pdftex_banner_code = pdftex_first_expand_code + 1 {command code for \.{\\pdftexbanner}}
+@d pdf_font_name_code = pdftex_first_expand_code + 2 {command code for \.{\\pdffontname}}
+@d pdf_font_objnum_code = pdftex_first_expand_code + 3 {command code for \.{\\pdffontobjnum}}
+@d pdf_font_size_code = pdftex_first_expand_code + 4 {command code for \.{\\pdffontsize}}
+@d pdf_page_ref_code = pdftex_first_expand_code + 5 {command code for \.{\\pdfpageref}}
+@d pdf_xform_name_code = pdftex_first_expand_code + 6 {command code for \.{\\pdfxformname}}
+@d pdf_last_escaped_string_code = pdftex_first_expand_code + 7 {command code for \.{\\pdflastescapedstring}}
+@d pdf_last_escaped_name_code = pdftex_first_expand_code + 8 {command code for \.{\\pdflastescapename}}
+@d pdftex_convert_codes = pdftex_first_expand_code + 9 {end of \pdfTeX's command codes}
+@d job_name_code=pdftex_convert_codes {command code for \.{\\jobname}}
+@z
+
+@x [468]
+primitive("jobname",convert,job_name_code);@/
+@y
+@#
+primitive("pdftexrevision",convert,pdftex_revision_code);@/
+@!@:pdftex_revision_}{\.{\\pdftexrevision} primitive@>
+primitive("pdftexbanner",convert,pdftex_banner_code);@/
+@!@:pdftex_banner_}{\.{\\pdftexbanner} primitive@>
+primitive("pdffontname",convert,pdf_font_name_code);@/
+@!@:pdf_font_name_}{\.{\\pdffontname} primitive@>
+primitive("pdffontobjnum",convert,pdf_font_objnum_code);@/
+@!@:pdf_font_objnum_}{\.{\\pdffontobjnum} primitive@>
+primitive("pdffontsize",convert,pdf_font_size_code);@/
+@!@:pdf_font_size_}{\.{\\pdffontsize} primitive@>
+primitive("pdfpageref",convert,pdf_page_ref_code);@/
+@!@:pdf_page_ref_}{\.{\\pdfpageref} primitive@>
+primitive("pdfxformname",convert,pdf_xform_name_code);@/
+@!@:pdf_xform_name_}{\.{\\pdfxformname} primitive@>
+primitive("pdflastescapedstring",convert,pdf_last_escaped_string_code);@/
+@!@:pdf_last_escaped_string_}{\.{\\pdflastescapedstring} primitive@>
+primitive("pdflastescapedname",convert,pdf_last_escaped_name_code);@/
+@!@:pdf_last_escaped_name_}{\.{\\pdflastescapedname} primitive@>
+@#
+primitive("jobname",convert,job_name_code);@/
+@z
+
+@x [469]
+ othercases print_esc("jobname")
+@y
+ pdftex_revision_code: print_esc("pdftexrevision");
+ pdftex_banner_code: print_esc("pdftexbanner");
+ pdf_font_name_code: print_esc("pdffontname");
+ pdf_font_objnum_code: print_esc("pdffontobjnum");
+ pdf_font_size_code: print_esc("pdffontsize");
+ pdf_page_ref_code: print_esc("pdfpageref");
+ pdf_xform_name_code: print_esc("pdfxformname");
+ pdf_last_escaped_string_code: print_esc("pdflastescapedstring");
+ pdf_last_escaped_name_code: print_esc("pdflastescapedname");
+ othercases print_esc("jobname")
+@z
+
+@x [465] - pdfescapestring
+@!b:pool_pointer; {base of temporary string}
+@y
+@!b:pool_pointer; {base of temporary string}
+@!i, l: integer; {index to access escaped string or name}
+@z
+
+@x [471]
+job_name_code: if job_name=0 then open_log_file;
+@y
+pdftex_revision_code: do_nothing;
+pdftex_banner_code: do_nothing;
+pdf_font_name_code, pdf_font_objnum_code, pdf_font_size_code: begin
+ scan_font_ident;
+ if cur_val = null_font then
+ pdf_error("font", "invalid font identifier");
+ if c <> pdf_font_size_code then begin
+ pdf_check_vf(cur_val);
+ if not font_used[cur_val] then
+ pdf_init_font(cur_val);
+ end;
+end;
+pdf_page_ref_code: begin
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("pageref", "invalid page number");
+end;
+pdf_xform_name_code: begin
+ scan_int;
+ pdf_check_obj(obj_type_xform, cur_val);
+end;
+pdf_last_escaped_string_code: do_nothing;
+pdf_last_escaped_name_code: do_nothing;
+job_name_code: if job_name=0 then open_log_file;
+@z
+
+@x [472]
+job_name_code: print(job_name);
+@y
+pdftex_revision_code: print(pdftex_revision);
+pdftex_banner_code: print(pdftex_banner);
+pdf_font_name_code, pdf_font_objnum_code: begin
+ set_ff(cur_val);
+ if c = pdf_font_name_code then
+ print_int(obj_info(pdf_font_num[ff]))
+ else
+ print_int(pdf_font_num[ff]);
+end;
+pdf_font_size_code: begin
+ print_scaled(font_size[cur_val]);
+ print("pt");
+end;
+pdf_page_ref_code: print_int(get_obj(obj_type_page, cur_val, false));
+pdf_xform_name_code: print_int(obj_info(cur_val));
+pdf_last_escaped_string_code: begin
+ l := escapedstrlen;
+ for i := 0 to l - 1 do
+ print_char(getescapedstrchar(i));
+end;
+pdf_last_escaped_name_code: begin
+ l := escapednamelen;
+ for i := 0 to l - 1 do
+ print_char(getescapednamechar(i));
+end;
+job_name_code: print(job_name);
+@z
+
+@x [577] - tagcode
+@<Declare procedures that scan font-related stuff@>=
+procedure scan_font_ident;
+@y
+@<Declare procedures that scan font-related stuff@>=
+function get_tag_code(f: internal_font_number; c: eight_bits): integer;
+var i:small_number;
+begin
+ if is_valid_char(c) then
+ begin i := char_tag(char_info(f)(c));
+ if i = lig_tag then
+ get_tag_code := 1
+ else if i = list_tag then
+ get_tag_code := 2
+ else if i = ext_tag then
+ get_tag_code := 4
+ else
+ get_tag_code := 0;
+ end
+ else
+ get_tag_code := -1;
+end;
+procedure scan_font_ident;
+@z
+
+% Shipping out to PDF
+@x [638]
+@ The |hlist_out| and |vlist_out| procedures are now complete, so we are
+ready for the |ship_out| routine that gets them started in the first place.
+
+@p procedure ship_out(@!p:pointer); {output the box |p|}
+@y
+@ The |hlist_out| and |vlist_out| procedures are now complete, so we are
+ready for the |dvi_ship_out| routine that gets them started in the first place.
+
+@p procedure dvi_ship_out(@!p:pointer); {output the box |p|}
+@z
+
+@x [644]
+@* \[33] Packaging.
+@y
+
+@* \[32a] \pdfTeX\ basic.
+
+Initialize pdftex's parameters to some useful default value.
+Helpful in case one forgets to set them during initex run.
+
+@<Initialize table entries...@>=
+pdf_h_origin := (one_hundred_inch + 50) div 100;
+pdf_v_origin := (one_hundred_inch + 50) div 100;
+pdf_compress_level := 9;
+pdf_decimal_digits := 4;
+pdf_image_resolution := 72;
+pdf_minor_version := 4;
+pdf_gamma := 1000;
+pdf_image_gamma := 2200;
+pdf_image_hicolor := 1;
+pdf_image_apply_gamma := 0;
+
+@ The subroutines define the corresponding macros so we can use them
+in C.
+
+@d flushable(#) == (# = str_ptr - 1)
+
+@d is_valid_char(#)==((font_bc[f] <= #) and (# <= font_ec[f]) and
+ char_exists(char_info(f)(#)))
+
+@p function get_pdf_compress_level: integer;
+begin
+ get_pdf_compress_level := pdf_compress_level;
+end;
+
+function get_nullfont: internal_font_number;
+begin
+ get_nullfont := null_font;
+end;
+
+function get_nullcs: pointer;
+begin
+ get_nullcs := null_cs;
+end;
+
+function get_nullptr: pointer;
+begin
+ get_nullptr := null;
+end;
+
+function get_tex_int(code: integer): integer;
+begin
+ get_tex_int := int_par(code);
+end;
+
+function get_tex_dimen(code: integer): scaled;
+begin
+ get_tex_dimen := dimen_par(code);
+end;
+
+function get_x_height(f: internal_font_number): scaled;
+begin
+ get_x_height := x_height(f);
+end;
+
+function get_charwidth(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_charwidth := char_width(f)(char_info(f)(c))
+ else
+ get_charwidth := 0;
+end;
+
+function get_charheight(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_charheight := char_height(f)(height_depth(char_info(f)(c)))
+ else
+ get_charheight := 0;
+end;
+
+function get_chardepth(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_chardepth := char_depth(f)(height_depth(char_info(f)(c)))
+ else
+ get_chardepth := 0;
+end;
+
+function get_quad(f: internal_font_number): scaled;
+begin
+ get_quad := quad(f);
+end;
+
+function get_slant(f: internal_font_number): scaled;
+begin
+ get_slant := slant(f);
+end;
+
+function new_dummy_font: internal_font_number;
+begin
+ new_dummy_font := read_font_info(null_cs, "dummy", "", -1000);
+end;
+
+@ Helper for debugging purposes
+
+@p procedure short_display_n(@!p, m:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+ i: integer;
+begin
+i := 0;
+font_in_short_display:=null_font;
+if p = null then
+ return;
+while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ print_ASCII(qo(character(p)));
+ end;
+ end
+ else begin
+ if (type(p) = glue_node) or
+ (type(p) = disc_node) or
+ (type(p) = penalty_node) or
+ ((type(p) = kern_node) and (subtype(p) = explicit)) then
+ incr(i);
+ if i >= m then
+ return;
+ if (type(p) = disc_node) then begin
+ print("|");
+ short_display(pre_break(p));
+ print("|");
+ short_display(post_break(p));
+ print("|");
+ n:=replace_count(p);
+ while n>0 do
+ begin if link(p)<>null then p:=link(p);
+ decr(n);
+ end;
+ end
+ else
+ @<Print a short indication of the contents of node |p|@>;
+ end;
+ p:=link(p);
+ if p = null then
+ return;
+ end;
+ update_terminal;
+end;
+
+@ Sometimes it is neccesary to allocate memory for PDF output that cannot
+be deallocated then, so we use |pdf_mem| for this purpose.
+
+@<Constants...@>=
+@!inf_pdf_mem_size = 10000; {min size of the |pdf_mem| array}
+@!sup_pdf_mem_size = 10000000; {max size of the |pdf_mem| array}
+
+@ @<Glob...@>=
+@!pdf_mem_size: integer;
+@!pdf_mem: ^integer;
+@!pdf_mem_ptr: integer;
+
+@ @<Set init...@>=
+pdf_mem_ptr := 1; {the first word is not used so we can use zero as a value for testing
+whether a pointer to |pdf_mem| is valid}
+pdf_mem_size := inf_pdf_mem_size; {allocated size of |pdf_mem| array}
+
+@ We use |pdf_get_mem| to allocate memory in |pdf_mem|
+
+@p function pdf_get_mem(s: integer): integer; {allocate |s| words in |pdf_mem|}
+var a: integer;
+begin
+ if s > sup_pdf_mem_size - pdf_mem_size then
+ overflow("PDF memory size (pdf_mem_size)", pdf_mem_size);
+ if pdf_mem_ptr + s > pdf_mem_size then begin
+ a := 0.2 * pdf_mem_size;
+ if pdf_mem_ptr + s > pdf_mem_size + a then
+ pdf_mem_size := pdf_mem_ptr + s
+ else if pdf_mem_size < sup_pdf_mem_size - a then
+ pdf_mem_size := pdf_mem_size + a
+ else
+ pdf_mem_size := sup_pdf_mem_size;
+ pdf_mem := xrealloc_array(pdf_mem, integer, pdf_mem_size);
+ end;
+ pdf_get_mem := pdf_mem_ptr;
+ pdf_mem_ptr := pdf_mem_ptr + s;
+end;
+
+@* \[32b] \pdfTeX\ output low-level subroutines.
+We use the similiar subroutines to handle the output buffer for
+PDF output. When compress is used, the state of writing to buffer
+is held in |zip_write_state|. We must write the header of PDF
+output file in initialization to ensure that it will be the first
+written bytes.
+
+@<Constants...@>=
+@!pdf_buf_size = 16384; {size of the PDF buffer}
+
+@ The following macros are similar as for \.{DVI} buffer handling
+
+@d pdf_offset == (pdf_gone + pdf_ptr) {the file offset of last byte in PDF
+buffer that |pdf_ptr| points to}
+
+@d no_zip == 0 {no \.{ZIP} compression}
+@d zip_writing == 1 {\.{ZIP} compression being used}
+@d zip_finish == 2 {finish \.{ZIP} compression}
+
+@d pdf_quick_out(#) == {output a byte to PDF buffer without checking of
+overflow}
+begin
+ pdf_buf[pdf_ptr] := #;
+ incr(pdf_ptr);
+end
+
+@d pdf_room(#) == {make sure that there are at least |n| bytes free in PDF
+buffer}
+begin
+ if pdf_buf_size < # then
+ overflow("PDF output buffer", pdf_buf_size);
+ if pdf_ptr + # > pdf_buf_size then
+ pdf_flush;
+end
+
+@d pdf_out(#) == {do the same as |pdf_quick_out| and flush the PDF
+buffer if necessary}
+begin
+ if pdf_ptr > pdf_buf_size then
+ pdf_flush;
+ pdf_quick_out(#);
+end
+
+@<Glob...@>=
+@!pdf_file: byte_file; {the PDF output file}
+@!pdf_buf: array[0..pdf_buf_size] of eight_bits; {the PDF buffer}
+@!pdf_ptr: integer; {pointer to the first unused byte in the PDF buffer}
+@!pdf_gone: integer; {number of bytes that were flushed to output}
+@!pdf_save_offset: integer; {to save |pdf_offset|}
+@!zip_write_state: integer; {which state of compression we are in}
+@!fixed_pdf_minor_version: integer; {fixed minor part of the pdf version}
+@!pdf_minor_version_written: boolean; {flag if the pdf version has been written}
+@!fixed_pdfoutput: integer; {fixed output format}
+@!fixed_pdfoutput_set: boolean; {|fixed_pdfoutput| has been set?}
+@!fixed_gamma: integer;
+@!fixed_image_gamma: integer;
+@!fixed_image_hicolor: boolean;
+@!fixed_image_apply_gamma: integer;
+@!epochseconds: integer;
+@!microseconds: integer;
+
+@ @<Set init...@>=
+pdf_buf[0] := "%";
+pdf_buf[1] := "P";
+pdf_buf[2] := "D";
+pdf_buf[3] := "F";
+pdf_buf[4] := "-";
+pdf_buf[5] := "1";
+pdf_buf[6] := ".";
+pdf_buf[7] := "4";
+pdf_buf[8] := pdf_new_line_char;
+pdf_buf[9] := "%";
+pdf_buf[10] := 208;
+pdf_buf[11] := 212;
+pdf_buf[12] := 197;
+pdf_buf[13] := 216;
+pdf_buf[14] := pdf_new_line_char;
+pdf_ptr := 15;
+pdf_gone := 0;
+zip_write_state := no_zip;
+pdf_minor_version_written := false;
+fixed_pdfoutput_set := false;
+fixed_gamma := 1000;
+fixed_image_gamma := 2200;
+fixed_image_hicolor := 1;
+fixed_image_apply_gamma := 0;
+
+@ @p
+function fix_int(val, min, max: integer): integer;
+begin
+ if val < min then
+ fix_int := min
+ else if val > max then
+ fix_int := max
+ else
+ fix_int := val;
+end;
+
+@ This checks that |pdfminorversion| can only be set before any
+bytes have been written to the generated pdf file. It should be called
+directly after every |ensure_pdf_open|.
+
+@p procedure check_pdfminorversion;
+begin
+ if not pdf_minor_version_written then begin
+ pdf_minor_version_written := true;
+ if (pdf_minor_version < 0) or (pdf_minor_version > 9) then begin
+ print_err("pdfTeX error (illegal pdfminorversion)");
+ print_ln;
+ help2 ("The pdfminorversion must be between 0 and 9.")@/
+ ("I changed this to 4.");
+ int_error (pdf_minor_version);
+ pdf_minor_version := 4;
+ end;
+ fixed_pdf_minor_version := pdf_minor_version;
+ pdf_buf[7] := chr(ord("0") + fixed_pdf_minor_version);
+ fixed_gamma := fix_int(pdf_gamma, 0, 1000000);
+ fixed_image_gamma := fix_int(pdf_image_gamma, 0, 1000000);
+ fixed_image_hicolor := fix_int(pdf_image_hicolor, 0, 1);
+ fixed_image_apply_gamma := fix_int(pdf_image_apply_gamma, 0, 1);
+ end
+ else begin
+ if fixed_pdf_minor_version <> pdf_minor_version then
+ pdf_error("setup",
+ "\pdfminorversion cannot be changed after data is written to the pdf file");
+ end;
+end;
+
+@ Checks that we have a name for the generated pdf file and that it's open.
+|check_pdfminorversion| should be called directly
+hereafter.
+
+@p procedure ensure_pdf_open;
+begin
+ if output_file_name <> 0 then
+ return;
+ if job_name = 0 then
+ open_log_file;
+ pack_job_name(".pdf");
+ while not b_open_out(pdf_file) do
+ prompt_file_name("file name for output",".pdf");
+ output_file_name := b_make_name_string(pdf_file);
+end;
+
+@ The PDF buffer is flushed by calling |pdf_flush|, which checks the
+variable |zip_write_state| and will compress the buffer before flushing if
+neccesary. We call |pdf_begin_stream| to begin a stream and |pdf_end_stream|
+to finish it. The stream contents will be compressed if compression is turn on.
+
+@p procedure pdf_flush; {flush out the |pdf_buf|}
+begin
+ ensure_pdf_open;
+ check_pdfminorversion;
+ case zip_write_state of
+ no_zip: if pdf_ptr > 0 then begin
+ write_pdf(0, pdf_ptr - 1);
+ pdf_gone := pdf_gone + pdf_ptr;
+ end;
+ zip_writing:
+ write_zip(false);
+ zip_finish: begin
+ write_zip(true);
+ zip_write_state := no_zip;
+ end;
+ end;
+ pdf_ptr := 0;
+end;
+
+procedure pdf_begin_stream; {begin a stream}
+begin
+ ensure_pdf_open;
+ check_pdfminorversion;
+ pdf_print_ln("/Length ");
+ pdf_stream_length_offset := pdf_offset - 11;
+ pdf_stream_length := 0;
+ if pdf_compress_level > 0 then begin
+ pdf_print_ln("/Filter /FlateDecode");
+ pdf_print_ln(">>");
+ pdf_print_ln("stream");
+ pdf_flush;
+ zip_write_state := zip_writing;
+ end
+ else begin
+ pdf_print_ln(">>");
+ pdf_print_ln("stream");
+ pdf_save_offset := pdf_offset;
+ end;
+end;
+
+procedure pdf_end_stream; {end a stream}
+begin
+ if pdf_compress_level > 0 then
+ zip_write_state := zip_finish
+ else
+ pdf_stream_length := pdf_offset - pdf_save_offset;
+ pdf_flush;
+ write_stream_length(pdf_stream_length, pdf_stream_length_offset);
+ if pdf_compress_level > 0 then
+ pdf_out(pdf_new_line_char);
+ pdf_print_ln("endstream");
+ pdf_end_obj;
+end;
+
+@ Basic printing procedures for PDF output are very similiar to \TeX\ basic
+printing ones but the output is going to PDF buffer. Subroutines with
+suffix |_ln| append a new-line character to the PDF output.
+
+@d pdf_new_line_char == 10 {new-line character for UNIX platforms}
+
+@d pdf_print_nl == {output a new-line character to PDF buffer}
+if (pdf_ptr > 0) and (pdf_buf[pdf_ptr - 1] <> pdf_new_line_char) then
+ pdf_out(pdf_new_line_char)
+
+@d pdf_print_ln(#) == {print out a string to PDF buffer followed by
+a new-line character}
+begin
+ pdf_print(#);
+ pdf_print_nl;
+end
+
+@d pdf_print_int_ln(#) == {print out an integer to PDF buffer followed by
+a new-line character}
+begin
+ pdf_print_int(#);
+ pdf_print_nl;
+end
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+procedure pdf_error(t, p: str_number);
+begin
+ normalize_selector;
+ print_err("pdfTeX error");
+ if t <> 0 then begin
+ print(" (");
+ print(t);
+ print(")");
+ end;
+ print(": "); print(p);
+ succumb;
+end;
+
+procedure pdf_warning(t, p: str_number; append_nl: boolean);
+begin
+ print_err("pdfTeX warning");
+ if t <> 0 then begin
+ print(" (");
+ print(t);
+ print(")");
+ end;
+ print(": "); print(p);
+ if append_nl then
+ print_ln;
+end;
+
+procedure remove_last_space;
+begin
+ if (pdf_ptr > 0) and (pdf_buf[pdf_ptr - 1] = 32) then
+ decr(pdf_ptr);
+end;
+
+procedure pdf_print_octal(n: integer); {prints an integer in octal form to
+PDF buffer}
+var k:0..23; {index to current digit; we assume that $|n|<10^{23}$}
+begin
+ k:=0;
+ repeat dig[k]:=n mod 8; n:=n div 8; incr(k);
+ until n=0;
+ if k = 1 then begin
+ pdf_out("0");
+ pdf_out("0");
+ end;
+ if k = 2 then
+ pdf_out("0");
+ while k>0 do begin
+ decr(k);
+ pdf_out("0"+dig[k]);
+ end;
+end;
+
+procedure pdf_print_char(f: internal_font_number; c: integer);
+{ print out a character to PDF buffer; the character will be printed in octal
+ form in the following cases: chars <= 32, backslash (92), left parenthesis
+ (40) and right parenthesis (41) }
+begin
+ if c <= 32 then
+ c := pdf_char_map[f, c];
+ pdf_mark_char(f, c);
+ if (c <= 32) or (c = 92) or (c = 40) or (c = 41) or (c > 127) then begin
+ pdf_out(92); {output a backslash}
+ pdf_print_octal(c);
+ end
+ else
+ pdf_out(c);
+end;
+
+procedure pdf_print(s: str_number); {print out a string to PDF buffer}
+var j: pool_pointer; {current character code position}
+ c: integer;
+begin
+ j := str_start[s];
+ while j < str_start[s + 1] do begin
+ c := str_pool[j];
+ pdf_out(c);
+ incr(j);
+ end;
+end;
+
+function str_in_str(s, r: str_number; i: integer): boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j, k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin
+ str_in_str := false;
+ if length(s) < i + length(r) then
+ return;
+ j := i + str_start[s];
+ k := str_start[r];
+ while (j < str_start[s + 1]) and (k < str_start[r + 1]) do begin
+ if str_pool[j] <> str_pool[k] then
+ return;
+ incr(j);
+ incr(k);
+ end;
+ str_in_str := true;
+end;
+
+procedure literal(s: str_number; literal_mode: integer; warn: boolean);
+var j: pool_pointer; {current character code position}
+begin
+ j:=str_start[s];
+ if literal_mode = scan_special then begin
+ if not (str_in_str(s, "PDF:", 0) or str_in_str(s, "pdf:", 0)) then begin
+ if warn and not (str_in_str(s, "SRC:", 0)
+ or str_in_str(s, "src:", 0)
+ or (length(s) = 0)) then
+ print_nl("Non-PDF special ignored!");
+ return;
+ end;
+ j := j + length("PDF:");
+ if str_in_str(s, "direct:", length("PDF:")) then begin
+ j := j + length("direct:");
+ literal_mode := direct_always; end
+ else if str_in_str(s, "page:", length("PDF:")) then begin
+ j := j + length("page:");
+ literal_mode := direct_page; end
+ else
+ literal_mode := reset_origin;
+ end;
+ case literal_mode of
+ reset_origin: begin
+ pdf_end_text;
+ pdf_set_origin;
+ end;
+ direct_page:
+ pdf_end_text;
+ direct_always: begin
+ pdf_first_space_corr := 0;
+ pdf_end_string;
+ pdf_print_nl;
+ end;
+ othercases confusion("literal1")
+ endcases;
+ while j<str_start[s+1] do begin
+ pdf_out(str_pool[j]);
+ incr(j);
+ end;
+ pdf_print_nl;
+end;
+
+procedure pdf_print_int(n:integer); {print out a integer to PDF buffer}
+var k:integer; {index to current digit ($0\le k\le23$); we assume that $|n|<10^{23}$}
+m:integer; {used to negate |n| in possibly dangerous cases}
+begin
+ k:=0;
+ if n<0 then
+ begin pdf_out("-");
+ if n>-100000000 then negate(n)
+ else begin m:=-1-n; n:=m div 10; m:=(m mod 10)+1; k:=1;
+ if m<10 then dig[0]:=m
+ else begin dig[0]:=0; incr(n);
+ end;
+ end;
+ end;
+ repeat dig[k]:=n mod 10; n:=n div 10; incr(k);
+ until n=0;
+ pdf_room(k);
+ while k>0 do begin
+ decr(k);
+ pdf_quick_out("0"+dig[k]);
+ end;
+end;
+
+procedure pdf_print_two(n:integer); {prints two least significant digits in
+decimal form to PDF buffer}
+begin n:=abs(n) mod 100; pdf_out("0"+(n div 10));
+pdf_out("0"+(n mod 10));
+end;
+
+function tokens_to_string(p: pointer): str_number; {return a string from tokens
+list}
+begin
+ if selector = new_string then
+ pdf_error("tokens", "tokens_to_string() called while selector = new_string");
+ old_setting:=selector; selector:=new_string;
+ show_token_list(link(p),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ last_tokens_string := make_string;
+ tokens_to_string := last_tokens_string;
+end;
+
+
+@ To print |scaled| value to PDF output we need some subroutines to ensure
+accurary.
+
+@d max_integer == @"7FFFFFFF {$2^{31}-1$}
+@d call_func(#) == begin if # <> 0 then do_nothing end
+
+@<Glob...@>=
+@!one_bp: scaled; {scaled value corresponds to 1bp}
+@!one_hundred_bp: scaled; {scaled value corresponds to 100bp}
+@!one_hundred_inch: scaled; {scaled value corresponds to 100in}
+@!ten_pow: array[0..9] of integer; {$10^0..10^9$}
+@!scaled_out: integer; {amount of |scaled| that was taken out in
+|divide_scaled|}
+@!init_pdf_output: boolean;
+
+@ @<Set init...@>=
+one_bp := 65782; {65781.76}
+one_hundred_bp := 6578176;
+one_hundred_inch := 473628672;
+ten_pow[0] := 1;
+for i := 1 to 9 do
+ ten_pow[i] := 10*ten_pow[i - 1];
+init_pdf_output := false;
+
+
+@ The following function divides |s| by |m|. |dd| is number of decimal digits.
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+function divide_scaled(s, m: scaled; dd: integer): scaled;
+var q, r: scaled;
+ sign, i: integer;
+begin
+ sign := 1;
+ if s < 0 then begin
+ sign := -sign;
+ s := -s;
+ end;
+ if m < 0 then begin
+ sign := -sign;
+ m := -m;
+ end;
+ if m = 0 then
+ pdf_error("arithmetic", "divided by zero")
+ else if m >= (max_integer div 10) then
+ pdf_error("arithmetic", "number too big");
+ q := s div m;
+ r := s mod m;
+ for i := 1 to dd do begin
+ q := 10*q + (10*r) div m;
+ r := (10*r) mod m;
+ end;
+ if 2*r >= m then begin
+ incr(q);
+ r := r - m;
+ end;
+ scaled_out := sign*(s - (r div ten_pow[dd]));
+ divide_scaled := sign*q;
+end;
+
+function round_xn_over_d(@!x:scaled; @!n,@!d:integer):scaled;
+var positive:boolean; {was |x>=0|?}
+@!t,@!u,@!v:nonnegative_integer; {intermediate quantities}
+begin if x>=0 then positive:=true
+else begin negate(x); positive:=false;
+ end;
+t:=(x mod @'100000)*n;
+u:=(x div @'100000)*n+(t div @'100000);
+v:=(u mod d)*@'100000 + (t mod @'100000);
+if u div d>=@'100000 then arith_error:=true
+else u:=@'100000*(u div d) + (v div d);
+v := v mod d;
+if 2*v >= d then
+ incr(u);
+if positive then
+ round_xn_over_d := u
+else
+ round_xn_over_d := -u;
+end;
+
+
+@ Next subroutines are needed for controling spacing in PDF page description.
+The procedure |adv_char_width| advances |pdf_h| by the amount |w|, which is
+the character width. We cannot simply add |w| to |pdf_h|, but must
+calculate the amount corresponding to |w| in the PDF output. For PK fonts
+things are more complicated, as we have to deal with scaling bitmaps as well.
+
+@p
+procedure adv_char_width(f: internal_font_number; w: scaled); {update |pdf_h|
+by character width |w| from font |f|}
+begin
+ if hasfmentry(f) then begin
+ call_func(divide_scaled(w, pdf_font_size[f], 3));
+ pdf_h := pdf_h + scaled_out;
+ end
+ else
+ pdf_h := pdf_h + get_pk_char_width(f, w);
+end;
+
+procedure pdf_print_real(m, d: integer); {print $m/10^d$ as real}
+var n: integer;
+begin
+ if m < 0 then begin
+ pdf_out("-");
+ m := -m;
+ end;
+ n := ten_pow[d];
+ pdf_print_int(m div n);
+ m := m mod n;
+ if m > 0 then begin
+ pdf_out(".");
+ n := n div 10;
+ while m < n do begin
+ pdf_out("0");
+ n := n div 10;
+ end;
+ while m mod 10 = 0 do
+ m := m div 10;
+ pdf_print_int(m);
+ end;
+end;
+
+procedure pdf_print_bp(s: scaled); {print scaled as |bp|}
+begin
+ pdf_print_real(divide_scaled(s, one_hundred_bp, fixed_decimal_digits + 2),
+ fixed_decimal_digits);
+end;
+
+procedure pdf_print_mag_bp(s: scaled); {take |mag| into account}
+begin
+ prepare_mag;
+ if mag <> 1000 then
+ s := round_xn_over_d(s, mag, 1000);
+ pdf_print_bp(s);
+end;
+
+@* \[32c] PDF page description.
+
+@d pdf_x(#) == ((#) - pdf_origin_h) {convert $x$-coordinate from \.{DVI} to
+PDF}
+@d pdf_y(#) == (pdf_origin_v - (#)) {convert $y$-coordinate from \.{DVI} to
+PDF}
+
+@<Glob...@>=
+@!pdf_f: internal_font_number; {the current font in PDF output page}
+@!pdf_h: scaled; {current horizontal coordinate in PDF output page}
+@!pdf_v: scaled; {current vertical coordinate in PDF output page}
+@!pdf_last_h: scaled; {last horizontal coordinate in PDF output page}
+@!pdf_last_v: scaled; {last vertical coordinate in PDF output page}
+@!pdf_origin_h: scaled; {current horizontal origin in PDF output page}
+@!pdf_origin_v: scaled; {current vertical origin in PDF output page}
+@!pdf_first_space_corr: integer; {amount of first word spacing while drawing a string;
+for some reason it is not taken into account of the length of the string, so we
+have to save it in order to adjust spacing when string drawing is finished}
+@!pdf_doing_string: boolean; {we are writing string to PDF file?}
+@!pdf_doing_text: boolean; {we are writing text section to PDF file?}
+@!pdf_font_changed: boolean; {current font has been changed?}
+@!min_bp_val: scaled;
+@!fixed_pk_resolution: integer;
+@!fixed_decimal_digits: integer;
+@!pk_scale_factor: integer;
+@!pdf_output_option: integer;
+@!pdf_output_value: integer;
+
+@ Following procedures implement low-level subroutines to convert \TeX{}
+internal structures to PDF page description.
+
+@p procedure pdf_set_origin; {set the origin to |cur_h|, |cur_v|}
+begin
+ if (abs(cur_h - pdf_origin_h) >= min_bp_val) or
+ (abs(cur_v - pdf_origin_v) >= min_bp_val) then begin
+ pdf_print("1 0 0 1 ");
+ pdf_print_bp(cur_h - pdf_origin_h);
+ pdf_origin_h := pdf_origin_h + scaled_out;
+ pdf_out(" ");
+ pdf_print_bp(pdf_origin_v - cur_v);
+ pdf_origin_v := pdf_origin_v - scaled_out;
+ pdf_print_ln(" cm");
+ end;
+ pdf_h := pdf_origin_h;
+ pdf_last_h := pdf_origin_h;
+ pdf_v := pdf_origin_v;
+ pdf_last_v := pdf_origin_v;
+end;
+
+procedure pdf_end_string; {end the current string}
+begin
+ if pdf_doing_string then begin
+ pdf_print(")]TJ");
+ if pdf_first_space_corr <> 0 then begin
+ pdf_h := pdf_h - pdf_first_space_corr;
+ pdf_first_space_corr := 0;
+ end;
+ pdf_doing_string := false;
+ end;
+end;
+
+procedure pdf_moveto(v, v_out: scaled); {set the next starting point to |cur_h|, |cur_v|}
+begin
+ pdf_out(" ");
+ pdf_print_bp(cur_h - pdf_last_h);
+ pdf_h := pdf_last_h + scaled_out;
+ pdf_out(" ");
+ pdf_print_real(v, fixed_decimal_digits);
+ pdf_print(" Td");
+ pdf_v := pdf_last_v - v_out;
+ pdf_last_h := pdf_h;
+ pdf_last_v := pdf_v;
+end;
+
+procedure pdf_begin_text; forward;
+
+procedure pdf_print_font_tag(f: internal_font_number);
+begin
+ if pdf_font_expand_ratio[f] = 0 then
+ return;
+ if pdf_font_expand_ratio[f] > 0 then
+ pdf_print("+"); {minus sign will be printed by |pdf_print_int|}
+ pdf_print_int(pdf_font_expand_ratio[f]);
+end;
+
+procedure pdf_set_font(f: internal_font_number);
+label found;
+var p: pointer;
+ k: internal_font_number;
+begin
+ if not font_used[f] then
+ pdf_init_font(f);
+ set_ff(f);
+ k := ff;
+ p := pdf_font_list;
+ while p <> null do begin
+ set_ff(info(p));
+ if ff = k then
+ goto found;
+ p := link(p);
+ end;
+ pdf_append_list(f)(pdf_font_list); {|f| not found in |pdf_font_list|}
+found:
+ pdf_begin_text;
+ pdf_print("/F");
+ pdf_print_int(k);
+ pdf_print_font_tag(f);
+ pdf_print_resname_prefix;
+ pdf_out(" ");
+ pdf_print_bp(font_size[f]);
+ pdf_print(" Tf");
+ pdf_f := f;
+ pdf_font_changed := true;
+end;
+
+procedure pdf_begin_text; {begin a text section}
+var temp_cur_h, temp_cur_v: scaled;
+begin
+ if not pdf_doing_text then begin
+ temp_cur_h := cur_h;
+ temp_cur_v := cur_v;
+ cur_h := 0;
+ cur_v := cur_page_height;
+ pdf_set_origin;
+ cur_h := temp_cur_h;
+ cur_v := temp_cur_v;
+ pdf_print_ln("BT");
+ pdf_doing_text := true;
+ pdf_f := null_font;
+ pdf_first_space_corr := 0;
+ pdf_doing_string := false;
+ end;
+end;
+
+procedure pdf_begin_string(f: internal_font_number); {begin to draw a string}
+var b: boolean; {|b| is true only when we must adjust word spacing
+at the beginning of string}
+ s, s_out, v, v_out: scaled;
+begin
+ pdf_begin_text;
+ if f <> pdf_f then begin
+ pdf_end_string;
+ pdf_set_font(f);
+ end;
+ b := false;
+ s := divide_scaled(cur_h - pdf_h, pdf_font_size[f], 3);
+ s_out := scaled_out;
+ if abs(cur_v - pdf_v) >= min_bp_val then begin
+ v := divide_scaled(pdf_last_v - cur_v, one_hundred_bp,
+ fixed_decimal_digits + 2);
+ v_out := scaled_out;
+ end
+ else begin
+ v := 0;
+ v_out := 0;
+ end;
+ if pdf_font_changed or (v <> 0) or (abs(s) >= @'100000) then begin
+ pdf_end_string;
+ pdf_moveto(v, v_out);
+ pdf_font_changed := false;
+ s := 0;
+ s_out := 0;
+ end;
+ if pdf_doing_string then begin
+ if s <> 0 then
+ pdf_out(")");
+ end
+ else begin
+ pdf_out("[");
+ if s <> 0 then
+ b := true
+ else
+ pdf_out("(");
+ pdf_doing_string := true;
+ end;
+ if s <> 0 then begin
+ pdf_print_int(-s);
+ if b then
+ pdf_first_space_corr := s_out;
+ pdf_out("(");
+ pdf_h := pdf_h + s_out;
+ end;
+end;
+
+procedure pdf_end_text; {end a text section}
+begin
+ if pdf_doing_text then begin
+ pdf_end_string;
+ pdf_print_nl;
+ pdf_print_ln("ET");
+ pdf_doing_text := false;
+ end;
+end;
+
+procedure pdf_set_rule(x, y, w, h: scaled); {draw a rule}
+begin
+ pdf_end_text;
+ pdf_set_origin;
+ if h <= one_bp then begin
+ pdf_print_ln("q");
+ pdf_print_ln("[]0 d");
+ pdf_print_ln("0 J");
+ pdf_print_bp(h); pdf_print_ln(" w");
+ pdf_print("0 "); pdf_print_bp((h + 1)/2); pdf_print_ln(" m");
+ pdf_print_bp(w); pdf_print(" "); pdf_print_bp((h + 1)/2);
+ pdf_print_ln(" l");
+ pdf_print_ln("S");
+ pdf_print_ln("Q");
+ end
+ else if w <= one_bp then begin
+ pdf_print_ln("q");
+ pdf_print_ln("[]0 d");
+ pdf_print_ln("0 J");
+ pdf_print_bp(w); pdf_print_ln(" w");
+ pdf_print_bp((w + 1)/2); pdf_print_ln(" 0 m");
+ pdf_print_bp((w + 1)/2); pdf_print(" "); pdf_print_bp(h);
+ pdf_print_ln(" l");
+ pdf_print_ln("S");
+ pdf_print_ln("Q");
+ end
+ else begin
+ pdf_print_bp(pdf_x(x)); pdf_out(" ");
+ pdf_print_bp(pdf_y(y)); pdf_out(" ");
+ pdf_print_bp(w); pdf_out(" ");
+ pdf_print_bp(h); pdf_print_ln(" re f");
+ end;
+end;
+
+
+procedure pdf_rectangle(left, top, right, bottom: scaled); {output a
+rectangle specification to PDF file}
+begin
+ prepare_mag;
+ pdf_print("/Rect [");
+ pdf_print_mag_bp(pdf_x(left)); pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(bottom)); pdf_out(" ");
+ pdf_print_mag_bp(pdf_x(right)); pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(top));
+ pdf_print_ln("]");
+end;
+
+@* \[32d] The cross-reference table.
+
+The cross-reference table |obj_tab| is an array of |obj_tab_size| of
+|tab_entry|. Each entry contains four integer fields and represents an object
+in PDF file whose object number is the index of this entry in |obj_tab|.
+Objects in |obj_tab| maybe linked into list; objects in such a linked list have
+the same type.
+
+@<Types...@>=
+@!obj_entry = record@;@/
+ int0, int1, int2, int3: integer;
+end;
+
+@ The first field contains information representing identifier of this object.
+It is usally a number for most of object types, but it may be a string number
+for named destination or named thread.
+
+The second field of |obj_entry| contains link to the next
+object in |obj_tab| if this object in linked in a list.
+
+The third field holds the byte offset of the object in the output PDF file.
+Objects that have been not written yet have this field set to zero. However
+sometimes we have to use this field to store some info before the object is
+written out.
+
+The last field usually represents the pointer to some auxiliary data
+structure depending on the object type; however it may be used as a counter as
+well.
+
+@d obj_info(#) == obj_tab[#].int0 {information representing identifier of this object}
+@d obj_link(#) == obj_tab[#].int1 {link to the next entry in linked list}
+@d obj_offset(#) == obj_tab[#].int2 {byte offset of this object in PDF output file}
+@d obj_aux(#) == obj_tab[#].int3 {auxiliary pointer}
+@d is_obj_written(#) == (obj_offset(#) <> 0)
+
+@# {types of objects}
+@d obj_type_others == 0 {objects which are not linked in any list}
+@d obj_type_page == 1 {index of linked list of Page objects}
+@d obj_type_pages == 2 {index of linked list of Pages objects}
+@d obj_type_font == 3 {index of linked list of Fonts objects}
+@d obj_type_outline == 4 {index of linked list of outline objects}
+@d obj_type_dest == 5 {index of linked list of destination objects}
+@d obj_type_obj == 6 {index of linked list of raw objects}
+@d obj_type_xform == 7 {index of linked list of XObject forms}
+@d obj_type_ximage == 8 {index of linked list of XObject image}
+@d obj_type_thread == 9 {index of linked list of num article threads}
+@d head_tab_max == obj_type_thread {max index of |head_tab|}
+
+@# {max number of kids for balanced trees}
+@d pages_tree_kids_max == 6 {max number of kids of Pages tree node}
+@d name_tree_kids_max == @'100000 {max number of kids of node of name tree for
+name destinations}
+
+@# {when a whatsit node representing annotation is created, words |1..3| are
+width, height and depth of this annotation; after shipping out words |1..4|
+are rectangle specification of annotation. For whatsit node representing
+destination |pdf_left| and |pdf_top| are used for some types of destinations}
+
+@# {coordinates of destinations/threads/annotations (in whatsit node)}
+@d pdf_left(#) == mem[# + 1].sc
+@d pdf_top(#) == mem[# + 2].sc
+@d pdf_right(#) == mem[# + 3].sc
+@d pdf_bottom(#) == mem[# + 4].sc
+
+@# {dimesion of destinations/threads/annotations (in whatsit node)}
+@d pdf_width(#) == mem[# + 1].sc
+@d pdf_height(#) == mem[# + 2].sc
+@d pdf_depth(#) == mem[# + 3].sc
+
+@# {data structure for \.{\\pdfliteral}}
+@d pdf_literal_data(#) == link(#+1) {data}
+@d pdf_literal_mode(#) == info(#+1) {mode of resetting the text matrix
+ while writing data to the page stream}
+@# {modes of resetting the text matrix}
+@d reset_origin == 0 {end text (ET) if needed, reset text matrix}
+@d direct_page == 1 {end text (ET) if needed, don't reset text matrix}
+@d direct_always == 2 {don't reset text matrix}
+@d scan_special == 3 {look into special text}
+
+@# {data structure for \.{\\pdfobj} and \.{\\pdfrefobj}}
+@d pdf_refobj_node_size == 2 {size of whatsit node representing the raw object}
+@d pdf_obj_objnum(#) == info(# + 1) {number of the raw object}
+@d obj_data_ptr == obj_aux {pointer to |pdf_mem|}
+@d pdfmem_obj_size == 4 {size of memory in |pdf_mem| which
+ |obj_data_ptr| holds}
+@d obj_obj_data(#) == pdf_mem[obj_data_ptr(#) + 0] {object data}
+@d obj_obj_is_stream(#) == pdf_mem[obj_data_ptr(#) + 1] {will this object
+ be written as a stream instead of a dictionary?}
+@d obj_obj_stream_attr(#) == pdf_mem[obj_data_ptr(#) + 2] {additional
+ object attributes for streams}
+@d obj_obj_is_file(#) == pdf_mem[obj_data_ptr(#) + 3] {data should be
+ read from an external file?}
+
+@# {data structure for \.{\\pdfxform} and \.{\\pdfrefxform}}
+@d pdf_refxform_node_size == 5 {size of whatsit node for xform; words 1..3 are
+ form dimensions}
+@d pdf_xform_objnum(#) == info(# + 4) {object number}
+@d pdfmem_xform_size == 6 {size of memory in |pdf_mem| which
+ |obj_data_ptr| holds}
+@d obj_xform_width(#) == pdf_mem[obj_data_ptr(#) + 0]
+@d obj_xform_height(#) == pdf_mem[obj_data_ptr(#) + 1]
+@d obj_xform_depth(#) == pdf_mem[obj_data_ptr(#) + 2]
+@d obj_xform_box(#) == pdf_mem[obj_data_ptr(#) + 3] {this field holds
+ pointer to the corresponding box}
+@d obj_xform_attr(#) == pdf_mem[obj_data_ptr(#) + 4] {additional xform
+ attributes}
+@d obj_xform_resources(#) == pdf_mem[obj_data_ptr(#) + 5] {additional xform
+ Resources}
+
+@# {data structure for \.{\\pdfximage} and \.{\\pdfrefximage}}
+@d pdf_refximage_node_size == 5 {size of whatsit node for ximage; words 1..3
+ are image dimensions}
+@d pdf_ximage_objnum(#) == info(# + 4) {object number}
+@d pdfmem_ximage_size == 5 {size of memory in |pdf_mem| which
+ |obj_data_ptr| holds}
+@d obj_ximage_width(#) == pdf_mem[obj_data_ptr(#) + 0]
+@d obj_ximage_height(#) == pdf_mem[obj_data_ptr(#) + 1]
+@d obj_ximage_depth(#) == pdf_mem[obj_data_ptr(#) + 2]
+@d obj_ximage_attr(#) == pdf_mem[obj_data_ptr(#) + 3] {additional ximage attributes}
+@d obj_ximage_data(#) == pdf_mem[obj_data_ptr(#) + 4] {pointer to image data}
+
+@# {data structure of annotations; words 1..4 represent the coordinates of
+ the annotation}
+@d obj_annot_ptr == obj_aux {pointer to corresponding whatsit node}
+@d pdf_annot_node_size == 7 {size of whatsit node representing annotation}
+@d pdf_annot_data(#) == info(# + 5) {raw data of general annotations}
+@d pdf_link_attr(#) == info(# + 5) {attributes of link annotations}
+@d pdf_link_action(#) == link(# + 5) {pointer to action structure}
+@d pdf_annot_objnum(#) == mem[# + 6].int {object number of corresponding object}
+
+@# {types of actions}
+@d pdf_action_page == 0 {Goto action}
+@d pdf_action_goto == 1 {Goto action}
+@d pdf_action_thread == 2 {Thread action}
+@d pdf_action_user == 3 {user-defined action}
+
+@# {data structure of actions}
+@d pdf_action_size == 3 {size of action structure in |mem|}
+@d pdf_action_type == type {action type}
+@d pdf_action_named_id == subtype {identifier is type of name}
+@d pdf_action_id == link {destination/thread name identifier}
+@d pdf_action_file(#) == info(# + 1) {file name for external action}
+@d pdf_action_new_window(#)== link(# + 1) {open a new window?}
+@d pdf_action_page_tokens(#) == info(# + 2) {specification of goto page action}
+@d pdf_action_user_tokens(#) == info(# + 2) {user-defined action string}
+@d pdf_action_refcount(#) == link(# + 2) {counter of references to this action}
+
+@# {data structure of outlines; it's not able to write out outline entries
+before all outline entries are defined, so memory allocated for outline
+entries can't not be deallocated and will stay in memory. For this reason we
+will store data of outline entries in |pdf_mem| instead of |mem|}
+
+@d pdfmem_outline_size == 8 {size of memory in |pdf_mem| which
+|obj_outline_ptr| points to}
+@d obj_outline_count == obj_info{count of all opened children}
+@d obj_outline_ptr == obj_aux {pointer to |pdf_mem|}
+@d obj_outline_title(#) == pdf_mem[obj_outline_ptr(#)]
+@d obj_outline_parent(#) == pdf_mem[obj_outline_ptr(#) + 1]
+@d obj_outline_prev(#) == pdf_mem[obj_outline_ptr(#) + 2]
+@d obj_outline_next(#) == pdf_mem[obj_outline_ptr(#) + 3]
+@d obj_outline_first(#) == pdf_mem[obj_outline_ptr(#) + 4]
+@d obj_outline_last(#) == pdf_mem[obj_outline_ptr(#) + 5]
+@d obj_outline_action_objnum(#) == pdf_mem[obj_outline_ptr(#) + 6] {object number of
+action}
+@d obj_outline_attr(#) == pdf_mem[obj_outline_ptr(#) + 7]
+
+@# {types of destinations}
+@d pdf_dest_xyz == 0
+@d pdf_dest_fit == 1
+@d pdf_dest_fith == 2
+@d pdf_dest_fitv == 3
+@d pdf_dest_fitb == 4
+@d pdf_dest_fitbh == 5
+@d pdf_dest_fitbv == 6
+@d pdf_dest_fitr == 7
+
+@# {data structure of destinations}
+@d obj_dest_ptr == obj_aux {pointer to |pdf_dest_node|}
+@d pdf_dest_node_size == 7 {size of whatsit node for destination;
+words |1..4| hold dest dimensions, word |6| identifier type, subtype
+and identifier of destination, word |6| the corresponding object number}
+@d pdf_dest_type(#) == type(# + 5) {type of destination}
+@d pdf_dest_named_id(#) == subtype(# + 5) {is named identifier?}
+@d pdf_dest_id(#) == link(# + 5) {destination identifier}
+@d pdf_dest_xyz_zoom(#) == info(# + 6) {zoom factor for |destxyz| destination}
+@d pdf_dest_objnum(#) == link(# + 6) {object number of corresponding
+object}
+
+@# {data structure of threads; words 1..4 represent the coordinates of the
+ corners}
+@d pdf_thread_node_size == 7
+@d pdf_thread_named_id(#) == subtype(# + 5) {is a named identifier}
+@d pdf_thread_id(#) == link(# + 5) {thread identifier}
+@d pdf_thread_attr(#) == info(# + 6) {attributes of thread}
+@d obj_thread_first == obj_aux {pointer to the first bead}
+
+@# {data structure of beads}
+@d pdfmem_bead_size == 5 {size of memory in |pdf_mem| which
+ |obj_bead_ptr| points to}
+@d obj_bead_ptr == obj_aux {pointer to |pdf_mem|}
+@d obj_bead_rect(#) == pdf_mem[obj_bead_ptr(#)]
+@d obj_bead_page(#) == pdf_mem[obj_bead_ptr(#) + 1]
+@d obj_bead_next(#) == pdf_mem[obj_bead_ptr(#) + 2]
+@d obj_bead_prev(#) == pdf_mem[obj_bead_ptr(#) + 3]
+@d obj_bead_attr(#) == pdf_mem[obj_bead_ptr(#) + 4]
+@d obj_bead_data == obj_bead_rect {pointer to the corresponding
+whatsit node; |obj_bead_rect| is needed only when the bead rectangle has
+been written out and after that |obj_bead_data| is not needed any more
+so we can use this field for both}
+
+@<Constants...@>=
+@!inf_obj_tab_size = 32000; {min size of the cross-reference table for PDF output}
+@!sup_obj_tab_size = 8388607; {max size of the cross-reference table for PDF output}
+@!inf_dest_names_size = 10000; {min size of the destination names table for PDF output}
+@!sup_dest_names_size = 131072; {max size of the destination names table for PDF output}
+@!pdf_objtype_max = head_tab_max;
+@!pdf_pdf_box_spec_media = 0;
+@!pdf_pdf_box_spec_crop = 1;
+@!pdf_pdf_box_spec_bleed = 2;
+@!pdf_pdf_box_spec_trim = 3;
+@!pdf_pdf_box_spec_art = 4;
+
+@ @<Glob...@>=
+@!obj_tab_size:integer;
+@!obj_tab:^obj_entry;
+@!head_tab: array[1..head_tab_max] of integer;
+@!obj_ptr: integer; {objects counter}
+@!pdf_last_pages: integer; {pointer to most recently generated pages object}
+@!pdf_last_page: integer; {pointer to most recently generated page object}
+@!pdf_last_stream: integer; {pointer to most recently generated stream}
+@!pdf_stream_length: integer; {length of most recently generated stream}
+@!pdf_stream_length_offset: integer; {file offset of the last stream length}
+@!pdf_append_list_arg: integer; {for use with |pdf_append_list|}
+@!ff: integer; {for use with |set_ff|}
+
+@ @<Set init...@>=
+obj_ptr := 0;
+for k := 1 to head_tab_max do
+ head_tab[k] := 0;
+
+@ Here we implement subroutines for work with objects and related things.
+Some of them are used in former parts too, so we need to declare them
+forward.
+
+@d pdf_append_list_end(#) == # := append_ptr(#, pdf_append_list_arg); end
+@d pdf_append_list(#) == begin pdf_append_list_arg := #; pdf_append_list_end
+@d set_ff(#) == begin
+ if pdf_font_num[#] < 0 then
+ ff := -pdf_font_num[#]
+ else
+ ff := #;
+end
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+procedure append_dest_name(s: str_number; n: integer);
+begin
+ if pdf_dest_names_ptr = dest_names_size then
+ overflow("number of destination names", dest_names_size);
+ dest_names[pdf_dest_names_ptr].objname := s;
+ dest_names[pdf_dest_names_ptr].objnum := n;
+ incr(pdf_dest_names_ptr);
+end;
+
+procedure pdf_create_obj(t, i: integer); {create an object with type |t| and
+identifier |i|}
+label done;
+var p, q: integer;
+begin
+ if obj_ptr = obj_tab_size then
+ overflow("indirect objects table size", obj_tab_size);
+ incr(obj_ptr);
+ obj_info(obj_ptr) := i;
+ obj_offset(obj_ptr) := 0;
+ obj_aux(obj_ptr) := 0;
+ avl_put_obj(obj_ptr, t);
+ if t = obj_type_page then begin
+ p := head_tab[t];
+ {find the right position to insert newly created object}@/
+ if (p = 0) or (obj_info(p) < i) then begin
+ obj_link(obj_ptr) := p;
+ head_tab[t] := obj_ptr;
+ end
+ else begin
+ while p <> 0 do begin
+ if obj_info(p) < i then
+ goto done;
+ q := p;
+ p := obj_link(p);
+ end;
+done:
+ obj_link(q) := obj_ptr;
+ obj_link(obj_ptr) := p;
+ end;
+ end
+ else if t <> obj_type_others then begin
+ obj_link(obj_ptr) := head_tab[t];
+ head_tab[t] := obj_ptr;
+ if (t = obj_type_dest) and (i < 0) then
+ append_dest_name(-obj_info(obj_ptr), obj_ptr);
+ end;
+end;
+
+function pdf_new_objnum: integer; {create a new object and return its number}
+begin
+ pdf_create_obj(obj_type_others, 0);
+ pdf_new_objnum := obj_ptr;
+end;
+
+procedure pdf_begin_obj(i: integer); {begin a PDF object}
+begin
+ ensure_pdf_open;
+ check_pdfminorversion;
+ obj_offset(i) := pdf_offset;
+ pdf_print_int(i);
+ pdf_print_ln(" 0 obj");
+end;
+
+procedure pdf_end_obj;
+begin
+ pdf_print_ln("endobj"); {end a PDF object}
+end;
+
+procedure pdf_begin_dict(i: integer); {begin a PDF dictionary object}
+begin
+ obj_offset(i) := pdf_offset;
+ pdf_print_int(i);
+ pdf_print_ln(" 0 obj <<");
+end;
+
+procedure pdf_end_dict; {end a PDF object of type dictionary}
+begin
+ pdf_print_ln(">> endobj");
+end;
+
+procedure pdf_new_obj(t, i: integer); {begin to a new object}
+begin
+ pdf_create_obj(t, i);
+ pdf_begin_obj(obj_ptr);
+end;
+
+procedure pdf_new_dict(t, i: integer); {begin a new object with type dictionary}
+begin
+ pdf_create_obj(t, i);
+ pdf_begin_dict(obj_ptr);
+end;
+
+function append_ptr(p: pointer; i: integer): pointer; {appends a pointer with
+info |i| to the end of linked list with head |p|}
+var q: pointer;
+begin
+ append_ptr := p;
+ fast_get_avail(q);
+ info(q) := i;
+ link(q) := null;
+ if p = null then begin
+ append_ptr := q;
+ return;
+ end;
+ while link(p) <> null do
+ p := link(p);
+ link(p) := q;
+end;
+
+function pdf_lookup_list(p: pointer; i: integer): pointer; {looks up for pointer
+with info |i| in list |p|}
+begin
+ pdf_lookup_list := null;
+ while p <> null do begin
+ if info(p) = i then begin
+ pdf_lookup_list := p;
+ return;
+ end;
+ p := link(p);
+ end;
+end;
+
+@ @<Glob...@>=
+@!pdf_image_procset: integer; {collection of image types used in current page/form}
+@!pdf_text_procset: boolean; {mask of used ProcSet's in the current page/form}
+
+@ Subroutines to print out various PDF objects
+
+@d is_hex_char(#) == (((# >= '0') and (# <= '9')) or
+ ((# >= 'A') and (# <= 'F')) or
+ ((# >= 'a') and (# <= 'f')))
+
+@p procedure pdf_print_fw_int(n, w: integer); {print out an integer with
+fixed width; used for outputting cross-reference table}
+var k:integer; {$0\le k\le23$}
+begin
+ k:=0;
+ repeat dig[k]:=n mod 10; n:=n div 10; incr(k);
+ until k = w;
+ pdf_room(k);
+ while k>0 do begin
+ decr(k);
+ pdf_quick_out("0"+dig[k]);
+ end;
+end;
+
+procedure pdf_int_entry(s: str_number; v: integer); {print out an entry in
+dictionary with integer value to PDF buffer}
+begin
+ pdf_out("/");
+ pdf_print(s);
+ pdf_out(" ");
+ pdf_print_int(v);
+end;
+
+procedure pdf_int_entry_ln(s: str_number; v: integer);
+begin
+ pdf_int_entry(s, v);
+ pdf_print_nl;
+end;
+
+procedure pdf_indirect(s: str_number; o: integer); {print out an indirect
+entry in dictionary}
+begin
+ pdf_out("/");
+ pdf_print(s);
+ pdf_out(" ");
+ pdf_print_int(o);
+ pdf_print(" 0 R");
+end;
+
+procedure pdf_indirect_ln(s: str_number; o: integer);
+begin
+ pdf_indirect(s, o);
+ pdf_print_nl;
+end;
+
+procedure pdf_print_str(s: str_number); {print out |s| as string in PDF
+output}
+label done;
+var i, j, k: pool_pointer;
+ is_hex_string: boolean;
+begin
+ i := str_start[s];
+ j := i + length(s) - 1;
+ if i > j then begin
+ pdf_print("()"); {null string}
+ return;
+ end;
+ if (str_pool[i] = '(') and (str_pool[j] = ')') then begin
+ pdf_print(s);
+ return;
+ end;
+ is_hex_string := false;
+ if (str_pool[i] <> '<') or (str_pool[j] <> '>') or odd(length(s)) then
+ goto done;
+ incr(i);
+ decr(j);
+ while i < j do begin
+ if is_hex_char(str_pool[i]) and is_hex_char(str_pool[i + 1]) then
+ i := i + 2
+ else
+ goto done;
+ end;
+ is_hex_string := true;
+done:
+ if is_hex_string then
+ pdf_print(s)
+ else begin
+ pdf_out("(");
+ pdf_print(s);
+ pdf_out(")");
+ end;
+end;
+
+procedure pdf_print_str_ln(s: str_number); {print out |s| as string in PDF
+output}
+begin
+ pdf_print_str(s);
+ pdf_print_nl;
+end;
+
+procedure pdf_str_entry(s, v: str_number); {print out an entry in
+dictionary with string value to PDF buffer}
+begin
+ if v = 0 then
+ return;
+ pdf_out("/");
+ pdf_print(s);
+ pdf_out(" ");
+ pdf_print_str(v);
+end;
+
+procedure pdf_str_entry_ln(s, v: str_number);
+begin
+ if v = 0 then
+ return;
+ pdf_str_entry(s, v);
+ pdf_print_nl;
+end;
+
+@* \[32e] Font processing.
+
+As pdfTeX should also act as a back-end driver, it needs to support virtual
+font too. Information about virtual font can be found in source of some
+\.{DVI}-related programs.
+
+Whenever we want to write out a character in a font to PDF output, we
+should check whether the used font is new font (has not been used yet),
+virtual font or real font. The array |pdf_font_type| holds flag of each used
+font. After initialization flag of each font is set to |new_font_type|.
+The first time when a character of a font is written out, pdfTeX looks for
+the corresponding virtual font. If the corresponding virtual font exists, then
+the font type is set to |virtual_font_type|; otherwise it will be set to
+|real_font_type|. |subst_font_type| indicates fonts that have been substituted
+during adjusting spacing. Such fonts are linked via the |pdf_font_elink| array.
+
+@d new_font_type = 0 {new font (has not been used yet)}
+@d virtual_font_type = 1 {virtual font}
+@d real_font_type = 2 {real font}
+@d subst_font_type = 3 {substituted font}
+@d pdf_init_font(#) == begin tmp_f := #; pdf_create_font_obj; end
+@d pdf_check_vf(#) == begin
+ tmp_f := #;
+ do_vf;
+ if pdf_font_type[#] = virtual_font_type then
+ pdf_error("font", "command cannot be used with virtual font");
+end
+
+@d pdf_check_new_font(#) ==
+ if pdf_font_type[#] = new_font_type then begin
+ tmp_f := #;
+ do_vf;
+ end
+
+@<Declare procedures that need to be declared forward...@>=
+procedure pdf_create_font_obj; forward;
+procedure do_vf; forward;
+procedure scan_pdf_ext_toks; forward;
+
+@ @<Glob...@>=
+@!pdf_font_type: ^eight_bits; {the type of font}
+@!pdf_font_attr: ^str_number; {pointer to additional attributes}
+@!tmp_f: internal_font_number; {for use with |pdf_init_font|}
+
+@ To set PDF font we need to find out fonts with the same name, because \TeX\
+can load the same font several times for various sizes. For such fonts we
+define only one font resource. The array |pdf_font_num| holds the object
+number of font resource. A negative value of an entry of |pdf_font_num|
+indicates that the corresponding font shares the font resource with the font
+whose internal number is the absolute value of the entry. For partial
+downloading we also need to hold flags indicating which characters in particular
+font are used in array |pdf_char_used|.
+
+@d pdf_print_resname_prefix ==
+if pdf_resname_prefix <> 0 then
+ pdf_print(pdf_resname_prefix)
+
+@p procedure pdf_use_font(f: internal_font_number; fontnum: integer);
+begin
+ call_func(divide_scaled(font_size[f], one_hundred_bp,
+ fixed_decimal_digits + 2));
+ pdf_font_size[f] := scaled_out;
+ font_used[f] := true;
+ pdf_font_num[f] := fontnum;
+ if pdf_move_chars > 0 then begin
+ pdf_warning(0,"Primitive \pdfmovechars is obsolete.",true);
+ pdf_move_chars := 0; {warn only once}
+ end;
+end;
+
+procedure pdf_create_font_obj;
+var f, k: internal_font_number;
+begin
+ f := tmp_f;
+ if not font_used[f] then begin
+ if hasfmentry(f) then begin
+ {this font is scaleable, so different sizes can share a single font object}
+ k := tfm_of_fm(pdf_font_map[f]);
+ if (k <> f) and str_eq_str(font_name[k], font_name[f]) then begin
+ pdf_use_font(f, -k);
+ return;
+ end;
+ end;
+ pdf_create_obj(obj_type_font, f);
+ pdf_use_font(f, obj_ptr);
+ end;
+end;
+
+@ We need to hold information about used characters in each font for partial
+downloading.
+
+@<Types...@>=
+char_used_array = array[0..31] of eight_bits;
+char_map_array = array[0..32] of eight_bits; {move chars in range 0..32}
+fm_entry_ptr = ^integer;
+
+@ @<Glob...@>=
+@!pdf_char_used: ^char_used_array; {to mark used chars}
+@!pdf_char_map: ^char_map_array; {where to map chars 0..32}
+@!pdf_font_size: ^scaled; {used size of font in PDF file}
+@!pdf_font_num: ^integer; {mapping between internal font number in \TeX\ and
+ font name defined in resources in PDF file}
+@!pdf_font_map: ^fm_entry_ptr; {pointer into AVL tree of font mappings}
+@!pdf_font_list: pointer; {list of used fonts in current page}
+@!pdf_resname_prefix: str_number; {global prefix of resources name}
+@!last_tokens_string: str_number; {the number of the most recently string
+created by |tokens_to_string|}
+
+@ @<Set init...@>=
+pdf_resname_prefix := 0;
+last_tokens_string := 0;
+
+
+@ Here we implement reading information from \.{VF} file.
+
+@d vf_max_packet_length = 10000 {max length of character packet in \.{VF} file}
+
+@#
+@d vf_error = 61 {label to go to when an error occur}
+@d do_char = 70 {label to go to typesetting a character of virtual font}
+@#
+@d long_char = 242 {\.{VF} command for general character packet}
+@d vf_id = 202 {identifies \.{VF} files}
+@d put1=133 {typeset a character}
+
+@#
+@d vf_byte == getc(vf_file) {get a byte from\.{VF} file}
+@d vf_packet(#) == vf_packet_start[vf_packet_base[#] + vf_packet_end
+@d vf_packet_end(#) == #]
+
+@#
+@d bad_vf(#) == begin vf_err_str := #; goto vf_error; end {go out \.{VF}
+processing with an error message}
+@d four_cases(#) == #,#+1,#+2,#+3
+
+@#
+@d tmp_b0 == tmp_w.qqqq.b0
+@d tmp_b1 == tmp_w.qqqq.b1
+@d tmp_b2 == tmp_w.qqqq.b2
+@d tmp_b3 == tmp_w.qqqq.b3
+@d tmp_int == tmp_w.int
+
+@#
+@d scaled3u == {convert |tmp_b1..tmp_b3| to an unsigned scaled dimension}
+(((((tmp_b3*vf_z)div@'400)+(tmp_b2*vf_z))div@'400)+(tmp_b1*vf_z))div vf_beta
+@d scaled4(#) == {convert |tmp_b0..tmp_b3| to a scaled dimension}
+ #:=scaled3u;
+ if tmp_b0>0 then if tmp_b0=255 then # := # - vf_alpha
+@d scaled3(#) == {convert |tmp_b1..tmp_b3| to a scaled dimension}
+ #:=scaled3u; @+ if tmp_b1>127 then # := # - vf_alpha
+@d scaled2 == {convert |tmp_b2..tmp_b3| to a scaled dimension}
+ if tmp_b2>127 then tmp_b1:=255 else tmp_b1:=0;
+ scaled3
+@d scaled1 == {convert |tmp_b3| to a scaled dimension}
+ if tmp_b3>127 then tmp_b1:=255 else tmp_b1:=0;
+ tmp_b2:=tmp_b1; scaled3
+
+@<Glob...@>=
+@!vf_packet_base: ^integer; {base addresses of character packets from virtual fonts}
+@!vf_default_font: ^internal_font_number; {default font in a \.{VF} file}
+@!vf_local_font_num: ^internal_font_number; {number of local fonts in a \.{VF} file}
+@!vf_packet_length: integer; {length of the current packet}
+@!vf_file: byte_file;
+@!vf_nf: internal_font_number; {the local fonts counter}
+@!vf_e_fnts: ^integer; {external font numbers}
+@!vf_i_fnts: ^internal_font_number; {corresponding internal font numbers}
+@!tmp_w: memory_word; {accumulator}
+@!vf_z: integer; {multiplier}
+@!vf_alpha: integer; {correction for negative values}
+@!vf_beta: 1..16; {divisor}
+
+@ @<Set init...@>=
+vf_nf := 0;
+
+@ The |do_vf| procedure attempts to read the \.{VF} file for a font, and sets
+|pdf_font_type| to |real_font_type| if the \.{VF} file could not be found
+or loaded, otherwise sets |pdf_font_type| to |virtual_font_type|. At this
+time, |tmp_f| is the internal font number of the current \.{TFM} font. To
+process font definitions in virtual font we call |vf_def_font|.
+
+@p procedure vf_replace_z;
+begin
+ vf_alpha:=16;
+ while vf_z>=@'40000000 do begin
+ vf_z:=vf_z div 2;
+ vf_alpha:=vf_alpha+vf_alpha;
+ end;
+ vf_beta:=256 div vf_alpha;
+ vf_alpha:=vf_alpha*vf_z;
+end;
+
+function vf_read(k: integer): integer; {read |k| bytes as an integer from \.{VF} file}
+var i: integer;
+begin
+ i := 0;
+ while k > 0 do begin
+ i := i*256 + vf_byte;
+ decr(k);
+ end;
+ vf_read := i;
+end;
+
+procedure vf_local_font_warning(f, k: internal_font_number; s: str_number);
+{print a warning message if an error ocurrs during processing local fonts in
+\.{VF} file}
+begin
+ print_nl(s);
+ print(" in local font ");
+ print(font_name[k]);
+ print(" in virtual font ");
+ print(font_name[f]);
+ print(".vf ignored.");
+end;
+
+function vf_def_font(f: internal_font_number): internal_font_number;
+{process a local font in \.{VF} file}
+var k: internal_font_number;
+ s: str_number;
+ ds, fs: scaled;
+ cs: four_quarters;
+ c: integer;
+begin
+ cs.b0 := vf_byte; cs.b1 := vf_byte; cs.b2 := vf_byte; cs.b3 := vf_byte;
+ tmp_b0 := vf_byte; tmp_b1 := vf_byte; tmp_b2 := vf_byte; tmp_b3 := vf_byte;
+ scaled4(fs);
+ ds := vf_read(4) div @'20;
+ tmp_b0 := vf_byte;
+ tmp_b1 := vf_byte;
+ while tmp_b0 > 0 do begin
+ decr(tmp_b0);
+ if vf_byte > 0 then
+ do_nothing; {skip the font path}
+ end;
+ str_room(tmp_b1);
+ while tmp_b1 > 0 do begin
+ decr(tmp_b1);
+ append_char(vf_byte);
+ end;
+ s := make_string;
+ k := tfm_lookup(s, fs);
+ if k = null_font then
+ k := read_font_info(null_cs, s, "", fs);
+ if k <> null_font then begin
+ if ((cs.b0 <> 0) or (cs.b1 <> 0) or (cs.b2 <> 0) or (cs.b3 <> 0)) and
+ ((font_check[k].b0 <> 0) or (font_check[k].b1 <> 0) or
+ (font_check[k].b2 <> 0) or (font_check[k].b3 <> 0)) and
+ ((cs.b0 <> font_check[k].b0) or (cs.b1 <> font_check[k].b1) or
+ (cs.b2 <> font_check[k].b2) or (cs.b3 <> font_check[k].b3)) then
+ vf_local_font_warning(f, k, "checksum mismatch");
+ if ds <> font_dsize[k] then
+ vf_local_font_warning(f, k, "design size mismatch");
+ end;
+ if pdf_font_expand_ratio[f] <> 0 then
+ set_expand_param(k, f, pdf_font_expand_ratio[f]);
+ vf_def_font := k;
+end;
+
+procedure do_vf; {process \.{VF} file with font internal number |f|}
+label vf_error;
+var cmd, k, n: integer;
+ cc, cmd_length: integer;
+ tfm_width: scaled;
+ vf_err_str, s: str_number;
+ stack_level: vf_stack_index;
+ save_vf_nf: internal_font_number;
+ f: internal_font_number;
+
+begin
+ f := tmp_f;
+ pdf_font_type[f] := real_font_type;
+ if auto_expand_vf(f) then
+ return; {auto-expanded virtual font}
+ stack_level := 0;
+ @<Open |vf_file|, return if not found@>;
+ @<Process the preamble@>;@/
+ @<Process the font definitions@>;@/
+ @<Allocate memory for the new virtual font@>;@/
+ while cmd <= long_char do begin@/
+ @<Build a character packet@>;@/
+ end;
+ if cmd <> post then
+ bad_vf("POST command expected");
+ b_close(vf_file);
+ pdf_font_type[f] := virtual_font_type;
+ return;
+vf_error:
+ print_nl("Error in processing VF font (");
+ print(font_name[f]);
+ print(".vf): ");
+ print(vf_err_str);
+ print(", virtual font will be ignored");
+ print_ln;
+ b_close(vf_file);
+ update_terminal;
+end;
+
+@ @<Open |vf_file|, return if not found@>=
+pack_file_name(font_name[f], "", ".vf");
+if not vf_b_open_in(vf_file) then
+ return
+
+@ @<Process the preamble@>=
+if vf_byte <> pre then
+ bad_vf("PRE command expected");
+if vf_byte <> vf_id then
+ bad_vf("wrong id byte");
+cmd_length := vf_byte;
+for k := 1 to cmd_length do
+ tmp_int := vf_byte;
+tmp_b0 := vf_byte; tmp_b1 := vf_byte; tmp_b2 := vf_byte; tmp_b3 := vf_byte;
+if ((tmp_b0 <> 0) or (tmp_b1 <> 0) or (tmp_b2 <> 0) or (tmp_b3 <> 0)) and
+ ((font_check[f].b0 <> 0) or (font_check[f].b1 <> 0) or
+ (font_check[f].b2 <> 0) or (font_check[f].b3 <> 0)) and
+ ((tmp_b0 <> font_check[f].b0) or (tmp_b1 <> font_check[f].b1) or
+ (tmp_b2 <> font_check[f].b2) or (tmp_b3 <> font_check[f].b3)) then begin
+ print_nl("checksum mismatch in font ");
+ print(font_name[f]);
+ print(".vf ignored");
+end;
+if vf_read(4) div @'20 <> font_dsize[f] then begin
+ print_nl("design size mismatch in font ");
+ print(font_name[f]);
+ print(".vf ignored");
+end;
+update_terminal;
+vf_z := font_size[f];
+vf_replace_z
+
+@ @<Process the font definitions@>=
+cmd := vf_byte;
+save_vf_nf := vf_nf;
+while (cmd >= fnt_def1) and (cmd <= fnt_def1 + 3) do begin
+ vf_e_fnts[vf_nf] := vf_read(cmd - fnt_def1 + 1);
+ vf_i_fnts[vf_nf] := vf_def_font(f);
+ incr(vf_nf);
+ cmd := vf_byte;
+end;
+vf_default_font[f] := save_vf_nf;
+vf_local_font_num[f] := vf_nf - save_vf_nf;
+
+@ @<Allocate memory for the new virtual font@>=
+ vf_packet_base[f] := new_vf_packet(f)
+
+@ @<Build a character packet@>=
+if cmd = long_char then begin
+ vf_packet_length := vf_read(4);
+ cc := vf_read(4);
+ if not is_valid_char(cc) then
+ bad_vf("invalid character code");
+ tmp_b0 := vf_byte; tmp_b1 := vf_byte; tmp_b2 := vf_byte; tmp_b3 := vf_byte;
+ scaled4(tfm_width);
+end
+else begin
+ vf_packet_length := cmd;
+ cc := vf_byte;
+ if not is_valid_char(cc) then
+ bad_vf("invalid character code");
+ tmp_b1 := vf_byte; tmp_b2 := vf_byte; tmp_b3 := vf_byte;
+ scaled3(tfm_width);
+end;
+if vf_packet_length < 0 then
+ bad_vf("negative packet length");
+if vf_packet_length > vf_max_packet_length then
+ bad_vf("packet length too long");
+if (tfm_width <> char_width(f)(char_info(f)(cc))) then begin
+ print_nl("character width mismatch in font ");
+ print(font_name[f]);
+ print(".vf ignored");
+end;
+str_room(vf_packet_length);
+while vf_packet_length > 0 do begin
+ cmd := vf_byte;
+ decr(vf_packet_length);
+ @<Cases of \.{DVI} commands that can appear in character packet@>;
+ if cmd <> nop then
+ append_char(cmd);
+ vf_packet_length := vf_packet_length - cmd_length;
+ while cmd_length > 0 do begin
+ decr(cmd_length);
+ append_char(vf_byte);
+ end;
+end;
+if stack_level <> 0 then
+ bad_vf("more PUSHs than POPs in character packet");
+if vf_packet_length <> 0 then
+ bad_vf("invalid packet length or DVI command in packet");
+@<Store the packet being built@>;
+cmd := vf_byte
+
+@ @<Store the packet being built@>=
+s := make_string;
+storepacket(f, cc, s);
+flush_str(s)
+
+@ @<Cases of \.{DVI} commands that can appear in character packet@>=
+if (cmd >= set_char_0) and (cmd <= set_char_0 + 127) then
+ cmd_length := 0
+else if ((fnt_num_0 <= cmd) and (cmd <= fnt_num_0 + 63)) or
+ ((fnt1 <= cmd) and (cmd <= fnt1 + 3)) then begin
+ if cmd >= fnt1 then begin
+ k := vf_read(cmd - fnt1 + 1);
+ vf_packet_length := vf_packet_length - (cmd - fnt1 + 1);
+ end
+ else
+ k := cmd - fnt_num_0;
+ if k >= 256 then
+ bad_vf("too many local fonts");
+ n := 0;
+ while (n < vf_local_font_num[f]) and
+ (vf_e_fnts[vf_default_font[f] + n] <> k) do
+ incr(n);
+ if n = vf_local_font_num[f] then
+ bad_vf("undefined local font");
+ if k <= 63 then
+ append_char(fnt_num_0 + k)
+ else begin
+ append_char(fnt1);
+ append_char(k);
+ end;
+ cmd_length := 0;
+ cmd := nop;
+end
+else case cmd of
+set_rule, put_rule: cmd_length := 8;
+four_cases(set1): cmd_length := cmd - set1 + 1;
+four_cases(put1): cmd_length := cmd - put1 + 1;
+four_cases(right1): cmd_length := cmd - right1 + 1;
+four_cases(w1): cmd_length := cmd - w1 + 1;
+four_cases(x1): cmd_length := cmd - x1 + 1;
+four_cases(down1): cmd_length := cmd - down1 + 1;
+four_cases(y1): cmd_length := cmd - y1 + 1;
+four_cases(z1): cmd_length := cmd - z1 + 1;
+four_cases(xxx1): begin
+ cmd_length := vf_read(cmd - xxx1 + 1);
+ vf_packet_length := vf_packet_length - (cmd - xxx1 + 1);
+ if cmd_length > vf_max_packet_length then
+ bad_vf("packet length too long");
+ if cmd_length < 0 then
+ bad_vf("string of negative length");
+ append_char(xxx1);
+ append_char(cmd_length);
+ cmd := nop; {|cmd| has been already stored above as |xxx1|}
+end;
+w0, x0, y0, z0, nop:
+ cmd_length := 0;
+push, pop: begin
+ cmd_length := 0;
+ if cmd = push then
+ if stack_level = vf_stack_size then
+ overflow("virtual font stack size", vf_stack_size)
+ else
+ incr(stack_level)
+ else
+ if stack_level = 0 then
+ bad_vf("more POPs than PUSHs in character")
+ else
+ decr(stack_level);
+end;
+othercases
+ bad_vf("improver DVI command");
+endcases
+
+@ The |do_vf_packet| procedure is called in order to interpret the
+character packet for a virtual character. Such a packet may contain the
+instruction to typeset a character from the same or an other virtual
+font; in such cases |do_vf_packet| calls itself recursively. The
+recursion level, i.e., the number of times this has happened, is kept
+in the global variable |vf_cur_s| and should not exceed |vf_max_recursion|.
+
+@<Constants...@>=
+@!vf_max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!vf_stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+
+@ @<Types...@>=
+@!vf_stack_index=0..vf_stack_size; {an index into the stack}
+@!vf_stack_record=record
+ stack_h, stack_v, stack_w, stack_x, stack_y, stack_z: scaled;
+end;
+
+@ @<Glob...@>=
+@!vf_cur_s: 0..vf_max_recursion; {current recursion level}
+@!vf_stack: array [vf_stack_index] of vf_stack_record;
+@!vf_stack_ptr: vf_stack_index; {pointer into |vf_stack|}
+
+@ @<Set init...@>=
+vf_cur_s := 0;
+vf_stack_ptr := 0;
+
+@ Some functions for processing character packets.
+
+@p function packet_read(k: integer): integer; {read |k| bytes as an integer from
+character packet}
+var i: integer;
+begin
+ i := 0;
+ while k > 0 do begin
+ i := i*256 + packet_byte;
+ decr(k);
+ end;
+ packet_read := i;
+end;
+
+function packet_scaled(k: integer): integer; {get |k| bytes from packet as a
+scaled}
+var s: scaled;
+begin
+ case k of
+ 1: begin
+ tmp_b3 := packet_byte;
+ scaled1(s);
+ end;
+ 2: begin
+ tmp_b2 := packet_byte;
+ tmp_b3 := packet_byte;
+ scaled2(s);
+ end;
+ 3: begin
+ tmp_b1 := packet_byte;
+ tmp_b2 := packet_byte;
+ tmp_b3 := packet_byte;
+ scaled3(s);
+ end;
+ 4: begin
+ tmp_b0 := packet_byte;
+ tmp_b1 := packet_byte;
+ tmp_b2 := packet_byte;
+ tmp_b3 := packet_byte;
+ scaled4(s);
+ end;
+ othercases pdf_error("vf", "invalid number size");
+ endcases;
+ packet_scaled := s;
+end;
+
+procedure do_vf_packet(f: internal_font_number; c: eight_bits); {typeset the \.{DVI} commands in the
+character packet for character |c| in current font |f|}
+label do_char, continue;
+var save_packet_ptr, save_packet_length: pool_pointer;
+ save_vf, k, n: internal_font_number;
+ base_line, save_h, save_v: scaled;
+ cmd: integer;
+ char_move: boolean;
+ w, x, y, z: scaled;
+ s: str_number;
+begin
+ incr(vf_cur_s);
+ if vf_cur_s > vf_max_recursion then
+ overflow("max level recursion of virtual fonts", vf_max_recursion);
+ push_packet_state;
+ start_packet(f, c);
+ vf_z := font_size[f];
+ vf_replace_z;
+ save_vf := f;
+ f := vf_i_fnts[vf_default_font[save_vf]];
+ save_v := cur_v;
+ save_h := cur_h;
+ w := 0; x := 0; y := 0; z := 0;
+ while vf_packet_length > 0 do begin
+ cmd := packet_byte;
+ @<Do typesetting the \.{DVI} commands in virtual character packet@>;
+continue:
+ end;
+ cur_h := save_h;
+ cur_v := save_v;
+ pop_packet_state;
+ vf_z := font_size[f];
+ vf_replace_z;
+ decr(vf_cur_s);
+end;
+
+@ The following code typesets a character to PDF output.
+
+@d output_one_char(#)==begin
+ pdf_check_new_font(f);
+ if pdf_font_type[f] = virtual_font_type then
+ do_vf_packet(f, #)
+ else begin
+ pdf_begin_string(f);
+ pdf_print_char(f, #);
+ adv_char_width(f, char_width(f)(char_info(f)(#)));
+ end;
+end
+
+
+@<Do typesetting the \.{DVI} commands in virtual character packet@>=
+if (cmd >= set_char_0) and (cmd <= set_char_0 + 127) then begin
+ if not is_valid_char(cmd) then begin
+ char_warning(f, cmd);
+ goto continue;
+ end;
+ c := cmd;
+ char_move := true;
+ goto do_char;
+end
+else if ((fnt_num_0 <= cmd) and (cmd <= fnt_num_0 + 63)) or (cmd = fnt1) then begin
+ if cmd = fnt1 then
+ k := packet_byte
+ else
+ k := cmd - fnt_num_0;
+ n := 0;
+ while (n < vf_local_font_num[save_vf]) and
+ (vf_e_fnts[vf_default_font[save_vf] + n] <> k) do
+ incr(n);
+ if (n = vf_local_font_num[save_vf]) then
+ f := null_font
+ else
+ f := vf_i_fnts[vf_default_font[save_vf] + n];
+end
+else case cmd of
+push: begin
+ vf_stack[vf_stack_ptr].stack_h := cur_h;
+ vf_stack[vf_stack_ptr].stack_v := cur_v;
+ vf_stack[vf_stack_ptr].stack_w := w;
+ vf_stack[vf_stack_ptr].stack_x := x;
+ vf_stack[vf_stack_ptr].stack_y := y;
+ vf_stack[vf_stack_ptr].stack_z := z;
+ incr(vf_stack_ptr);
+end;
+pop: begin
+ decr(vf_stack_ptr);
+ cur_h := vf_stack[vf_stack_ptr].stack_h;
+ cur_v := vf_stack[vf_stack_ptr].stack_v;
+ w := vf_stack[vf_stack_ptr].stack_w;
+ x := vf_stack[vf_stack_ptr].stack_x;
+ y := vf_stack[vf_stack_ptr].stack_y;
+ z := vf_stack[vf_stack_ptr].stack_z;
+end;
+four_cases(set1), four_cases(put1): begin
+ if (set1 <= cmd) and (cmd <= set1 + 3) then begin
+ tmp_int := packet_read(cmd - set1 + 1);
+ char_move := true;
+ end
+ else begin
+ tmp_int := packet_read(cmd - put1 + 1);
+ char_move := false;
+ end;
+ if not is_valid_char(tmp_int) then begin
+ char_warning(f, tmp_int);
+ goto continue;
+ end;
+ c := tmp_int;
+ goto do_char;
+end;
+set_rule, put_rule: begin
+ rule_ht := packet_scaled(4);
+ rule_wd := packet_scaled(4);
+ if (rule_wd > 0) and (rule_ht > 0) then begin
+ pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+ if cmd = set_rule then
+ cur_h := cur_h + rule_wd;
+ end;
+end;
+four_cases(right1):
+ cur_h := cur_h + packet_scaled(cmd - right1 + 1);
+w0, four_cases(w1): begin
+ if cmd > w0 then
+ w := packet_scaled(cmd - w0);
+ cur_h := cur_h + w;
+end;
+x0, four_cases(x1): begin
+ if cmd > x0 then
+ x := packet_scaled(cmd - x0);
+ cur_h := cur_h + x;
+end;
+four_cases(down1):
+ cur_v := cur_v + packet_scaled(cmd - down1 + 1);
+y0, four_cases(y1): begin
+ if cmd > y0 then
+ y := packet_scaled(cmd - y0);
+ cur_v := cur_v + y;
+end;
+z0, four_cases(z1): begin
+ if cmd > z0 then
+ z := packet_scaled(cmd - z0);
+ cur_v := cur_v + z;
+end;
+four_cases(xxx1): begin
+ tmp_int := packet_read(cmd - xxx1 + 1);
+ str_room(tmp_int);
+ while tmp_int > 0 do begin
+ decr(tmp_int);
+ append_char(packet_byte);
+ end;
+ s := make_string;
+ literal(s, scan_special, false);
+ flush_str(s);
+end;
+othercases pdf_error("vf", "invalid DVI command");
+endcases;
+goto continue;
+do_char:
+if is_valid_char(c) then
+ output_one_char(c)
+else
+ char_warning(f, c);
+if char_move then
+ cur_h := cur_h + char_width(f)(char_info(f)(c))
+
+@* \[32f] PDF shipping out.
+To ship out a \TeX\ box to PDF page description we need to implement
+|pdf_hlist_out|, |pdf_vlist_out| and |pdf_ship_out|, which are equivalent to
+the \TeX' original |hlist_out|, |vlist_out| and |ship_out| resp. But first we
+need to declare some procedures needed in |pdf_hlist_out| and |pdf_vlist_out|.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_out_literal(p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+ s: str_number;
+begin
+ old_setting:=selector; selector:=new_string;
+ show_token_list(link(pdf_literal_data(p)),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ s := make_string;
+ literal(s, pdf_literal_mode(p), false);
+ flush_str(s);
+end;
+
+procedure pdf_special(p: pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+ s: str_number;
+begin
+ old_setting:=selector; selector:=new_string;
+ show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ s := make_string;
+ literal(s, scan_special, true);
+ flush_str(s);
+end;
+
+procedure pdf_print_toks(p: pointer); {print tokens list |p|}
+var s: str_number;
+begin
+ s := tokens_to_string(p);
+ if length(s) > 0 then
+ pdf_print(s);
+ flush_str(s);
+end;
+
+procedure pdf_print_toks_ln(p: pointer); {print tokens list |p|}
+var s: str_number;
+begin
+ s := tokens_to_string(p);
+ if length(s) > 0 then begin
+ pdf_print(s);
+ pdf_print_nl;
+ end;
+ flush_str(s);
+end;
+
+@ Similiar to |vlist_out|, |pdf_vlist_out| needs to be declared forward
+
+@p procedure@?pdf_vlist_out; forward;
+
+@ The implementation of procedure |pdf_hlist_out| is similiar to |hlist_out|
+
+@p @t\4@>@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>@t@>@/
+
+procedure pdf_hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+@!left_edge: scaled; {the left coordinate for this box}
+@!save_h: scaled; {what |cur_h| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p:pointer; {current position in the hlist}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_wd:scaled; {width of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {left edge of sub-box, or right edge of leader space}
+@!running_link: pointer; {pointer to `running' link if exists}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+incr(cur_s);
+base_line:=cur_v; left_edge:=cur_h;
+running_link := null;
+@<Create link annotation for the current hbox if needed@>;
+while p<>null do
+ @<Output node |p| for |pdf_hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+decr(cur_s);
+end;
+
+@ @<Create link annotation for the current hbox if needed@>=
+if running_link = null then begin
+ if is_running(pdf_link_wd) and (pdf_link_level = cur_s) then begin
+ append_link(this_box, left_edge, base_line);
+ running_link := last_link;
+ end;
+end
+else
+ last_link := running_link
+
+@ @<Output node |p| for |pdf_hlist_out|...@>=
+reswitch: if is_char_node(p) then
+ begin
+ repeat f:=font(p); c:=character(p);
+ if is_valid_char(c) then
+ output_one_char(c)
+ else
+ char_warning(f, c);
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+ p:=link(p);
+ until not is_char_node(p);
+ end
+else @<Output the non-|char_node| |p| for |pdf_hlist_out|
+ and move to the next node@>
+
+@ @<Output the non-|char_node| |p| for |pdf_hlist_out|...@>=
+begin case type(p) of
+hlist_node,vlist_node:@<(\pdfTeX) Output a box in an hlist@>;
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in |pdf_hlist_out|@>;
+glue_node: @<(\pdfTeX) Move right or output leaders@>;
+kern_node,math_node:cur_h:=cur_h+width(p);
+ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>;
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<(\pdfTeX) Output a rule in an hlist@>;
+move_past: cur_h:=cur_h+rule_wd;
+next_p:p:=link(p);
+end
+
+@ @<(\pdfTeX) Output a box in an hlist@>=
+if list_ptr(p)=null then cur_h:=cur_h+width(p)
+else begin
+ cur_v:=base_line+shift_amount(p); {shift the box down}
+ temp_ptr:=p; edge:=cur_h;
+ if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+ cur_h:=edge+width(p); cur_v:=base_line;
+ end
+
+@ @<(\pdfTeX) Output a rule in an hlist@>=
+if is_running(rule_ht) then rule_ht:=height(this_box);
+if is_running(rule_dp) then rule_dp:=depth(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+ begin cur_v:=base_line+rule_dp;
+ pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+ cur_v:=base_line;
+ end
+
+@ @<(\pdfTeX) Move right or output leaders@>=
+begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
+if g_sign<>normal then
+ begin if g_sign=stretching then
+ begin if stretch_order(g)=g_order then
+ begin cur_glue:=cur_glue+stretch(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+ cur_g:=round(glue_temp);
+ end;
+ end
+ else if shrink_order(g)=g_order then
+ begin cur_glue:=cur_glue-shrink(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+ cur_g:=round(glue_temp);
+ end;
+ end;
+rule_wd:=rule_wd+cur_g;
+if subtype(p)>=a_leaders then
+ @<(\pdfTeX) Output leaders in an hlist, |goto fin_rule| if a rule
+ or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<(\pdfTeX) Output leaders in an hlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+ begin rule_ht:=height(leader_box); rule_dp:=depth(leader_box);
+ goto fin_rule;
+ end;
+leader_wd:=width(leader_box);
+if (leader_wd>0)and(rule_wd>0) then
+ begin rule_wd:=rule_wd+10; {compensate for floating-point rounding}
+ edge:=cur_h+rule_wd; lx:=0;
+ @<Let |cur_h| be the position of the first box, and set |leader_wd+lx|
+ to the spacing between corresponding parts of boxes@>;
+ while cur_h+leader_wd<=edge do
+ @<(\pdfTeX) Output a leader box at |cur_h|,
+ then advance |cur_h| by |leader_wd+lx|@>;
+ cur_h:=edge-10; goto next_p;
+ end;
+end
+
+@ @<(\pdfTeX) Output a leader box at |cur_h|, ...@>=
+begin cur_v:=base_line+shift_amount(leader_box);@/
+save_h:=cur_h; temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+doing_leaders:=outer_doing_leaders;
+cur_v:=base_line;
+cur_h:=save_h+leader_wd+lx;
+end
+
+@ The |pdf_vlist_out| routine is similar to |pdf_hlist_out|, but a bit simpler.
+@p procedure pdf_vlist_out; {output a |pdf_vlist_node| box}
+label move_past, fin_rule, next_p;
+var left_edge: scaled; {the left coordinate for this box}
+@!top_edge: scaled; {the top coordinate for this box}
+@!save_v: scaled; {what |cur_v| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p:pointer; {current position in the vlist}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_ht:scaled; {height of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {bottom boundary of leader space}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+incr(cur_s);
+left_edge:=cur_h; cur_v:=cur_v-height(this_box); top_edge:=cur_v;
+@<Create thread for the current vbox if needed@>;
+while p<>null do
+ @<Output node |p| for |pdf_vlist_out| and move to the next node,
+ maintaining the condition |cur_h=left_edge|@>;
+decr(cur_s);
+end;
+
+@ @<Create thread for the current vbox if needed@>=
+if (last_thread <> null) and is_running(pdf_thread_dp) and
+ (pdf_thread_level = cur_s) then
+ append_thread(this_box, left_edge, top_edge + height(this_box))
+
+@ @<Output node |p| for |pdf_vlist_out|...@>=
+begin if is_char_node(p) then confusion("pdfvlistout")
+@:this can't happen pdfvlistout}{\quad pdfvlistout@>
+else @<Output the non-|char_node| |p| for |pdf_vlist_out|@>;
+next_p:p:=link(p);
+end
+
+@ @<Output the non-|char_node| |p| for |pdf_vlist_out|@>=
+begin case type(p) of
+hlist_node,vlist_node:@<(\pdfTeX) Output a box in a vlist@>;
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in |pdf_vlist_out|@>;
+glue_node: @<(\pdfTeX) Move down or output leaders@>;
+kern_node:cur_v:=cur_v+width(p);
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<(\pdfTeX) Output a rule in a vlist, |goto next_p|@>;
+move_past: cur_v:=cur_v+rule_ht;
+end
+
+@ @<(\pdfTeX) Output a box in a vlist@>=
+if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
+else begin cur_v:=cur_v+height(p); save_v:=cur_v;
+ cur_h:=left_edge+shift_amount(p); {shift the box right}
+ temp_ptr:=p;
+ if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+ cur_v:=save_v+depth(p); cur_h:=left_edge;
+ end
+
+@ @<(\pdfTeX) Output a rule in a vlist...@>=
+if is_running(rule_wd) then rule_wd:=width(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+cur_v:=cur_v+rule_ht;
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+ pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+goto next_p
+
+@ @<(\pdfTeX) Move down or output leaders@>=
+begin g:=glue_ptr(p); rule_ht:=width(g)-cur_g;
+if g_sign<>normal then
+ begin if g_sign=stretching then
+ begin if stretch_order(g)=g_order then
+ begin cur_glue:=cur_glue+stretch(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+ cur_g:=round(glue_temp);
+ end;
+ end
+ else if shrink_order(g)=g_order then
+ begin cur_glue:=cur_glue-shrink(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+ cur_g:=round(glue_temp);
+ end;
+ end;
+rule_ht:=rule_ht+cur_g;
+if subtype(p)>=a_leaders then
+ @<(\pdfTeX) Output leaders in a vlist, |goto fin_rule| if a rule
+ or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<(\pdfTeX) Output leaders in a vlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+ begin rule_wd:=width(leader_box); rule_dp:=0;
+ goto fin_rule;
+ end;
+leader_ht:=height(leader_box)+depth(leader_box);
+if (leader_ht>0)and(rule_ht>0) then
+ begin rule_ht:=rule_ht+10; {compensate for floating-point rounding}
+ edge:=cur_v+rule_ht; lx:=0;
+ @<Let |cur_v| be the position of the first box, and set |leader_ht+lx|
+ to the spacing between corresponding parts of boxes@>;
+ while cur_v+leader_ht<=edge do
+ @<(\pdfTeX) Output a leader box at |cur_v|,
+ then advance |cur_v| by |leader_ht+lx|@>;
+ cur_v:=edge-10; goto next_p;
+ end;
+end
+
+@ @<(\pdfTeX) Output a leader box at |cur_v|, ...@>=
+begin cur_h:=left_edge+shift_amount(leader_box);@/
+cur_v:=cur_v+height(leader_box); save_v:=cur_v;
+temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+doing_leaders:=outer_doing_leaders;
+cur_h:=left_edge;
+cur_v:=save_v-height(leader_box)+leader_ht+lx;
+end
+
+@ |fix_pdfoutput| freezes |pdfoutput| when something has been written to
+the output.
+
+@p procedure fix_pdfoutput;
+begin
+ if not fixed_pdfoutput_set then begin
+ fixed_pdfoutput := pdf_output;
+ fixed_pdfoutput_set := true;
+ end
+ else if fixed_pdfoutput <> pdf_output then
+ pdf_error("setup",
+ "\pdfoutput can only be changed before anything is written to the output");
+end;
+
+
+@ |pdf_ship_out| is used instead of |ship_out| to shipout a box to PDF
+output. If |shipping_page| is not set then the output will be a Form object,
+otherwise it will be a Page object.
+
+@p procedure pdf_ship_out(p: pointer; shipping_page: boolean); {output the box |p|}
+label done, done1;
+var i,j,k:integer; {general purpose accumulators}
+r: integer; {accumulator to copy node for pending link annotation}
+save_font_list: pointer; {to save |pdf_font_list| during flushing pending forms}
+save_obj_list: pointer; {to save |pdf_obj_list|}
+save_ximage_list: pointer; {to save |pdf_ximage_list|}
+save_xform_list: pointer; {to save |pdf_xform_list|}
+save_image_procset: integer; {to save |pdf_image_procset|}
+save_text_procset: integer; {to save |pdf_text_procset|}
+pdf_last_resources: integer; {pointer to most recently generated Resources object}
+s:str_number;
+old_setting:0..max_selector; {saved |selector| setting}
+begin if tracing_output>0 then
+ begin print_nl(""); print_ln;
+ print("Completed box being shipped out");
+@.Completed box...@>
+ end;
+if not init_pdf_output then begin
+ @<Initialize variables for \.{PDF} output@>;
+ init_pdf_output := true;
+end;
+is_shipping_page := shipping_page;
+if shipping_page then begin
+ if term_offset>max_print_line-9 then print_ln
+ else if (term_offset>0)or(file_offset>0) then print_char(" ");
+ print_char("["); j:=9;
+ while (count(j)=0)and(j>0) do decr(j);
+ for k:=0 to j do
+ begin print_int(count(k));
+ if k<j then print_char(".");
+ end;
+ update_terminal;
+end;
+if tracing_output>0 then
+ begin if shipping_page then print_char("]");
+ begin_diagnostic; show_box(p); end_diagnostic(true);
+ end;
+@<(\pdfTeX) Ship box |p| out@>;
+if (tracing_output<=0) and shipping_page then print_char("]");
+dead_cycles:=0;
+update_terminal; {progress report}
+@<Flush the box from memory, showing statistics if requested@>;
+end;
+
+@ @<(\pdfTeX) Ship box |p| out@>=
+@<Update the values of |max_h| and |max_v|; but if the page is too large,
+ |goto done|@>;
+@<Initialize variables as |pdf_ship_out| begins@>;
+if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+if shipping_page then
+ incr(total_pages);
+cur_s:=-1;
+@<Finish shipping@>;
+done:
+
+@ @<Initialize variables as |pdf_ship_out| begins@>=
+fix_pdfoutput;
+temp_ptr:=p;
+prepare_mag;
+pdf_last_resources := pdf_new_objnum;
+@<Reset resources lists@>;
+if not shipping_page then begin
+ pdf_xform_width := width(p);
+ pdf_xform_height := height(p);
+ pdf_xform_depth := depth(p);
+ pdf_begin_dict(pdf_cur_form);
+ pdf_last_stream := pdf_cur_form;
+ cur_v := height(p);
+ cur_h := 0;
+ pdf_origin_h := 0;
+ pdf_origin_v := pdf_xform_height + pdf_xform_depth;
+end
+else begin
+ @<Calculate page dimensions and margins@>;
+ pdf_last_page := get_obj(obj_type_page, total_pages + 1, 0);
+ obj_aux(pdf_last_page) := 1; {mark that this page has beed created}
+ pdf_new_dict(obj_type_others, 0);
+ pdf_last_stream := obj_ptr;
+ cur_h := cur_h_offset;
+ cur_v := height(p) + cur_v_offset;
+ pdf_origin_h := 0;
+ pdf_origin_v := cur_page_height;
+ @<Reset PDF mark lists@>;
+end;
+if not shipping_page then begin
+ @<Write out Form stream header@>;
+end;
+@<Start stream of page/form contents@>
+
+@ @<Reset resources lists@>=
+pdf_font_list := null;
+pdf_obj_list := null;
+pdf_xform_list := null;
+pdf_ximage_list := null;
+pdf_text_procset := false;
+pdf_image_procset := 0
+
+@ @<Reset PDF mark lists@>=
+pdf_annot_list := null;
+pdf_link_list := null;
+pdf_dest_list := null;
+pdf_bead_list := null;
+last_link := null;
+last_thread := null
+
+@ @<Calculate page dimensions and margins@>=
+cur_h_offset := pdf_h_origin + h_offset;
+cur_v_offset := pdf_v_origin + v_offset;
+if pdf_page_width <> 0 then
+ cur_page_width := pdf_page_width
+else
+ cur_page_width := width(p) + 2*cur_h_offset;
+if pdf_page_height <> 0 then
+ cur_page_height := pdf_page_height
+else
+ cur_page_height := height(p) + depth(p) + 2*cur_v_offset
+
+@ Here we write out the header for Form.
+
+@<Write out Form stream header@>=
+pdf_print_ln("/Type /XObject");
+pdf_print_ln("/Subtype /Form");
+if obj_xform_attr(pdf_cur_form) <> null then begin
+ pdf_print_toks_ln(obj_xform_attr(pdf_cur_form));
+ delete_toks(obj_xform_attr(pdf_cur_form));
+end;
+pdf_print("/BBox [");
+pdf_print("0 0 ");
+pdf_print_bp(pdf_xform_width); pdf_out(" ");
+pdf_print_bp(pdf_xform_height + pdf_xform_depth); pdf_print_ln("]");
+pdf_print_ln("/FormType 1");
+pdf_print_ln("/Matrix [1 0 0 1 0 0]");
+pdf_indirect_ln("Resources", pdf_last_resources)
+
+@ @<Start stream of page/form contents@>=
+pdf_begin_stream;
+if shipping_page then begin
+ @<Adjust transformation matrix for the magnification ratio@>;
+end
+
+@ @<Adjust transformation matrix for the magnification ratio@>=
+prepare_mag;
+if mag <> 1000 then begin
+ pdf_print_real(mag, 3);
+ pdf_print(" 0 0 ");
+ pdf_print_real(mag, 3);
+ pdf_print_ln(" 0 0 cm");
+end
+
+@ @<Finish shipping@>=
+@<Finish stream of page/form contents@>;
+if shipping_page then begin
+ @<Write out page object@>;
+end;
+@<Flush out pending raw objects@>;
+@<Flush out pending forms@>;
+@<Flush out pending images@>;
+if shipping_page then begin
+ @<Flush out pending PDF marks@>;
+end;
+@<Write out resources dictionary@>;
+@<Flush resources lists@>;
+if shipping_page then begin
+ @<Flush PDF mark lists@>;
+end
+
+@ @<Finish stream of page/form contents@>=
+pdf_end_text;
+pdf_end_stream
+
+@ @<Write out resources dictionary@>=
+pdf_begin_dict(pdf_last_resources);
+@<Print additional resources@>;
+@<Generate font resources@>;
+@<Generate XObject resources@>;
+@<Generate ProcSet@>;
+pdf_end_dict
+
+@ @<Print additional resources@>=
+if shipping_page then begin
+ if pdf_page_resources <> null then
+ pdf_print_toks_ln(pdf_page_resources);
+end
+else begin
+ if obj_xform_resources(pdf_cur_form) <> null then begin
+ pdf_print_toks_ln(obj_xform_resources(pdf_cur_form));
+ delete_toks(obj_xform_resources(pdf_cur_form));
+ end;
+end
+
+@ In the end of shipping out a page we reset all the lists holding objects
+have been created during the page shipping.
+
+@d delete_toks(#) == begin delete_token_ref(#); # := null; end
+
+@<Flush resources lists@>=
+flush_list(pdf_font_list);
+flush_list(pdf_obj_list);
+flush_list(pdf_xform_list);
+flush_list(pdf_ximage_list)
+
+@ @<Flush PDF mark lists@>=
+flush_list(pdf_annot_list);
+flush_list(pdf_link_list);
+flush_list(pdf_dest_list);
+flush_list(pdf_bead_list)
+
+@ @<Generate font resources@>=
+if pdf_font_list <> null then begin
+ pdf_print("/Font << ");
+ k := pdf_font_list;
+ while k <> null do begin
+ pdf_print("/F");
+ set_ff(info(k));
+ pdf_print_int(ff);
+ pdf_print_font_tag(info(k));
+ pdf_print_resname_prefix;
+ pdf_out(" ");
+ pdf_print_int(pdf_font_num[ff]);
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ pdf_print_ln(">>");
+ pdf_text_procset := true;
+end
+
+@ @<Generate XObject resources@>=
+if (pdf_xform_list <> null) or (pdf_ximage_list <> null) then begin
+ pdf_print("/XObject << ");
+ k := pdf_xform_list;
+ while k <> null do begin
+ pdf_print("/Fm");
+ pdf_print_int(obj_info(info(k)));
+ pdf_print_resname_prefix;
+ pdf_out(" ");
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ k := pdf_ximage_list;
+ while k <> null do begin
+ pdf_print("/Im");
+ pdf_print_int(obj_info(info(k)));
+ pdf_print_resname_prefix;
+ pdf_out(" ");
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ update_image_procset(obj_ximage_data(info(k)));
+ k := link(k);
+ end;
+ pdf_print_ln(">>");
+end
+
+@ @<Generate ProcSet@>=
+pdf_print("/ProcSet [ /PDF");
+if pdf_text_procset then
+ pdf_print(" /Text");
+if check_image_b(pdf_image_procset) then
+ pdf_print(" /ImageB");
+if check_image_c(pdf_image_procset) then
+ pdf_print(" /ImageC");
+if check_image_i(pdf_image_procset) then
+ pdf_print(" /ImageI");
+pdf_print_ln(" ]")
+
+@ @<Write out page object@>=
+pdf_begin_dict(pdf_last_page);
+pdf_print_ln("/Type /Page");
+pdf_indirect_ln("Contents", pdf_last_stream);
+pdf_indirect_ln("Resources", pdf_last_resources);
+pdf_print("/MediaBox [0 0 ");
+pdf_print_mag_bp(cur_page_width); pdf_out(" ");
+pdf_print_mag_bp(cur_page_height);
+pdf_print_ln("]");
+if pdf_page_attr <> null then
+ pdf_print_toks_ln(pdf_page_attr);
+@<Generate parent pages object@>;
+@<Generate array of annotations or beads in page@>;
+pdf_end_dict
+
+@ @<Generate parent pages object@>=
+if total_pages mod pages_tree_kids_max = 1 then begin
+ pdf_create_obj(obj_type_pages, pages_tree_kids_max);
+ pdf_last_pages := obj_ptr;
+end;
+pdf_indirect_ln("Parent", pdf_last_pages)
+
+@ @<Generate array of annotations or beads in page@>=
+if (pdf_annot_list <> null) or (pdf_link_list <> null) then begin
+ pdf_print("/Annots [ ");
+ k := pdf_annot_list;
+ while k <> null do begin
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ k := pdf_link_list;
+ while k <> null do begin
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ pdf_print_ln("]");
+end;
+if pdf_bead_list <> null then begin
+ k := pdf_bead_list;
+ pdf_print("/B [ ");
+ while k <> null do begin
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ pdf_print_ln("]");
+end
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_write_obj(n: integer); {write a raw PDF object}
+var s: str_number;
+ f: byte_file;
+begin
+ s := tokens_to_string(obj_obj_data(n));
+ delete_toks(obj_obj_data(n));
+ if obj_obj_is_stream(n) > 0 then begin
+ pdf_begin_dict(n);
+ if obj_obj_stream_attr(n) <> null then begin
+ pdf_print_toks_ln(obj_obj_stream_attr(n));
+ delete_toks(obj_obj_stream_attr(n));
+ end;
+ pdf_begin_stream;
+ end
+ else
+ pdf_begin_obj(n);
+ if obj_obj_is_file(n) > 0 then begin
+ cur_name := s;
+ cur_area := "";
+ cur_ext := "";
+ pack_cur_name;
+ if not tex_b_openin(f) then
+ pdf_error("ext5", "cannot open file for embedding");
+ print("<<");
+ print(s);
+ while not eof(f) do
+ pdf_out(getc(f));
+ print(">>");
+ b_close(f);
+ end
+ else if obj_obj_is_stream(n) > 0 then
+ pdf_print(s)
+ else
+ pdf_print_ln(s);
+ if obj_obj_is_stream(n) > 0 then
+ pdf_end_stream
+ else
+ pdf_end_obj;
+ flush_str(s);
+end;
+
+procedure flush_whatsit_node(p: pointer; s: small_number);
+begin
+ type(p) := whatsit_node;
+ subtype(p) := s;
+ if link(p) <> null then
+ pdf_error("flush_whatsit_node", "link(p) is not null");
+ flush_node_list(p);
+end;
+
+@ @<Flush out pending raw objects@>=
+if pdf_obj_list <> null then begin
+ k := pdf_obj_list;
+ while k <> null do begin
+ if not is_obj_written(info(k)) then
+ pdf_write_obj(info(k));
+ k := link(k);
+ end;
+end
+
+@ When flushing pending forms we need to save and restore resources lists
+ (|pdf_font_list|, |pdf_obj_list|, |pdf_xform_list| and |pdf_ximage_list|),
+ which are also used by page shipping.
+
+@<Flush out pending forms@>=
+if pdf_xform_list <> null then begin
+ k := pdf_xform_list;
+ while k <> null do begin
+ if not is_obj_written(info(k)) then begin
+ pdf_cur_form := info(k);
+ @<Save resources lists@>;
+ @<Reset resources lists@>;
+ pdf_ship_out(obj_xform_box(pdf_cur_form), false);
+ @<Restore resources lists@>;
+ end;
+ k := link(k);
+ end;
+end
+
+@ @<Save resources lists@>=
+save_font_list := pdf_font_list;
+save_obj_list := pdf_obj_list;
+save_xform_list := pdf_xform_list;
+save_ximage_list := pdf_ximage_list;
+save_text_procset := pdf_text_procset;
+save_image_procset := pdf_image_procset
+
+@ @<Restore resources lists@>=
+pdf_font_list := save_font_list;
+pdf_obj_list := save_obj_list;
+pdf_xform_list := save_xform_list;
+pdf_ximage_list := save_ximage_list;
+pdf_text_procset := save_text_procset;
+pdf_image_procset := save_image_procset
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_write_image(n: integer); {write an image}
+begin
+ pdf_begin_dict(n);
+ if obj_ximage_attr(n) <> null then begin
+ pdf_print_toks_ln(obj_ximage_attr(n));
+ delete_toks(obj_ximage_attr(n));
+ end;
+ write_image(obj_ximage_data(n));
+ delete_image(obj_ximage_data(n));
+end;
+
+@ @<Flush out pending images@>=
+if pdf_ximage_list <> null then begin
+ k := pdf_ximage_list;
+ while k <> null do begin
+ if not is_obj_written(info(k)) then
+ pdf_write_image(info(k));
+ k := link(k);
+ end;
+end
+
+@ @<Flush out pending PDF marks@>=
+pdf_origin_h := 0;
+pdf_origin_v := cur_page_height;
+@<Flush out PDF annotations@>;
+@<Flush out PDF link annotations@>;
+@<Flush out PDF mark destinations@>;
+@<Flush out PDF bead rectangle specifications@>
+
+@ @<Flush out PDF annotations@>=
+if pdf_annot_list <> null then begin
+ k := pdf_annot_list;
+ while k <> null do begin
+ i := obj_annot_ptr(info(k)); {|i| points to |pdf_annot_node|}
+ pdf_begin_dict(info(k));
+ pdf_print_ln("/Type /Annot");
+ pdf_print_toks_ln(pdf_annot_data(i));
+ pdf_rectangle(pdf_left(i), pdf_top(i), pdf_right(i), pdf_bottom(i));
+ pdf_end_dict;
+ k := link(k);
+ end;
+end
+
+@ @<Flush out PDF link annotations@>=
+if pdf_link_list <> null then begin
+ @<Write out PDF link annotations@>;
+ @<Free PDF link annotations@>;
+end
+
+@ @<Write out PDF link annotations@>=
+k := pdf_link_list;
+while k <> null do begin
+ i := obj_annot_ptr(info(k));
+ pdf_begin_dict(info(k));
+ pdf_print_ln("/Type /Annot");
+ if pdf_link_attr(i) <> null then
+ pdf_print_toks_ln(pdf_link_attr(i));
+ pdf_rectangle(pdf_left(i), pdf_top(i), pdf_right(i), pdf_bottom(i));
+ if pdf_action_type(pdf_link_action(i)) <> pdf_action_user
+ then begin
+ pdf_print_ln("/Subtype /Link");
+ pdf_print("/A ");
+ end;
+ write_action(pdf_link_action(i));
+ pdf_end_dict;
+ k := link(k);
+end
+
+@ @<Free PDF link annotations@>=
+k := pdf_link_list;
+while k <> null do begin
+ i := obj_annot_ptr(info(k));
+ {nodes with |info = null| were created by |append_link| and
+ must be flushed here, as they are not linked in any list}
+ if info(i) = max_halfword then
+ flush_whatsit_node(i, pdf_start_link_node);
+ k := link(k);
+end
+
+@ @<Flush out PDF mark destinations@>=
+if pdf_dest_list <> null then begin
+ k := pdf_dest_list;
+ while k <> null do begin
+ if is_obj_written(info(k)) then
+ pdf_error("ext5",
+ "destination has been already written (this shouldn't happen)")
+ else begin
+ i := obj_dest_ptr(info(k));
+ if pdf_dest_named_id(i) > 0 then begin
+ pdf_begin_dict(info(k));
+ pdf_print("/D ");
+ end
+ else
+ pdf_begin_obj(info(k));
+ pdf_out("["); pdf_print_int(pdf_last_page); pdf_print(" 0 R ");
+ case pdf_dest_type(i) of
+ pdf_dest_xyz: begin
+ pdf_print("/XYZ ");
+ pdf_print_mag_bp(pdf_x(pdf_left(i))); pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(pdf_top(i))); pdf_out(" ");
+ if pdf_dest_xyz_zoom(i) = null then
+ pdf_print("null")
+ else begin
+ pdf_print_int(pdf_dest_xyz_zoom(i) div 1000);
+ pdf_out(".");
+ pdf_print_int((pdf_dest_xyz_zoom(i) mod 1000));
+ end;
+ end;
+ pdf_dest_fit:
+ pdf_print("/Fit");
+ pdf_dest_fith: begin
+ pdf_print("/FitH ");
+ pdf_print_mag_bp(pdf_y(pdf_top(i)));
+ end;
+ pdf_dest_fitv: begin
+ pdf_print("/FitV ");
+ pdf_print_mag_bp(pdf_x(pdf_left(i)));
+ end;
+ pdf_dest_fitb:
+ pdf_print("/FitB");
+ pdf_dest_fitbh: begin
+ pdf_print("/FitBH ");
+ pdf_print_mag_bp(pdf_y(pdf_top(i)));
+ end;
+ pdf_dest_fitbv: begin
+ pdf_print("/FitBV ");
+ pdf_print_mag_bp(pdf_x(pdf_left(i)));
+ end;
+ pdf_dest_fitr: begin
+ pdf_print("/FitR ");
+ pdf_print_rect_spec(i);
+ end;
+ othercases pdf_error("ext5", "unknown dest type");
+ endcases;
+ pdf_print_ln("]");
+ if pdf_dest_named_id(i) > 0 then
+ pdf_end_dict
+ else
+ pdf_end_obj;
+ end;
+ k := link(k);
+ end;
+end
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_print_rect_spec(r: pointer); {prints a rect spec}
+begin
+ pdf_print_mag_bp(pdf_x(pdf_left(r)));
+ pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(pdf_bottom(r)));
+ pdf_out(" ");
+ pdf_print_mag_bp(pdf_x(pdf_right(r)));
+ pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(pdf_top(r)));
+end;
+
+@ @<Flush out PDF bead rectangle specifications@>=
+if pdf_bead_list <> null then begin
+ k := pdf_bead_list;
+ while k <> null do begin
+ pdf_new_obj(obj_type_others, 0);
+ pdf_out("[");
+ i := obj_bead_data(info(k)); {pointer to a whatsit or whatsit-like node}
+ pdf_print_rect_spec(i);
+ if info(i) = max_halfword then {not a whatsit node, so must be destroyed here}
+ flush_whatsit_node(i, pdf_start_thread_node);
+ pdf_print_ln("]");
+ obj_bead_rect(info(k)) := obj_ptr; {rewrite |obj_bead_data|}
+ pdf_end_obj;
+ k := link(k);
+ end;
+end
+
+@ In the end we must flush PDF objects that cannot be written out
+immediately after shipping out pages.
+
+@ @<Output outlines@>=
+if pdf_first_outline <> 0 then begin
+ pdf_new_dict(obj_type_others, 0);
+ outlines := obj_ptr;
+ l := pdf_first_outline; k := 0;
+ repeat
+ incr(k);
+ a := open_subentries(l);
+ if obj_outline_count(l) > 0 then
+ k := k + a;
+ obj_outline_parent(l) := obj_ptr;
+ l := obj_outline_next(l);
+ until l = 0;
+ pdf_print_ln("/Type /Outlines");
+ pdf_indirect_ln("First", pdf_first_outline);
+ pdf_indirect_ln("Last", pdf_last_outline);
+ pdf_int_entry_ln("Count", k);
+ pdf_end_dict;
+ @<Output PDF outline entries@>;
+end
+else
+ outlines := 0
+
+@ @<Output PDF outline entries@>=
+k := head_tab[obj_type_outline];
+while k <> 0 do begin
+ if obj_outline_parent(k) = pdf_parent_outline then begin
+ if obj_outline_prev(k) = 0 then
+ pdf_first_outline := k;
+ if obj_outline_next(k) = 0 then
+ pdf_last_outline := k;
+ end;
+ pdf_begin_dict(k);
+ pdf_indirect_ln("Title", obj_outline_title(k));
+ pdf_indirect_ln("A", obj_outline_action_objnum(k));
+ if obj_outline_parent(k) <> 0 then
+ pdf_indirect_ln("Parent", obj_outline_parent(k));
+ if obj_outline_prev(k) <> 0 then
+ pdf_indirect_ln("Prev", obj_outline_prev(k));
+ if obj_outline_next(k) <> 0 then
+ pdf_indirect_ln("Next", obj_outline_next(k));
+ if obj_outline_first(k) <> 0 then
+ pdf_indirect_ln("First", obj_outline_first(k));
+ if obj_outline_last(k) <> 0 then
+ pdf_indirect_ln("Last", obj_outline_last(k));
+ if obj_outline_count(k) <> 0 then
+ pdf_int_entry_ln("Count", obj_outline_count(k));
+ if obj_outline_attr(k) <> 0 then begin
+ pdf_print_toks_ln(obj_outline_attr(k));
+ delete_toks(obj_outline_attr(k));
+ end;
+ pdf_end_dict;
+ k := obj_link(k);
+end
+
+@ @<Output article threads@>=
+if head_tab[obj_type_thread] <> 0 then begin
+ pdf_new_obj(obj_type_others, 0);
+ threads := obj_ptr;
+ pdf_out("[");
+ k := head_tab[obj_type_thread];
+ while k <> 0 do begin
+ pdf_print_int(k);
+ pdf_print(" 0 R ");
+ k := obj_link(k);
+ end;
+ remove_last_space;
+ pdf_print_ln("]");
+ pdf_end_obj;
+ k := head_tab[obj_type_thread];
+ while k <> 0 do begin
+ out_thread(k);
+ k := obj_link(k);
+ end;
+end
+else
+ threads := 0
+
+@ Now we are ready to declare our new procedure |ship_out|. It will call
+|pdf_ship_out| if the integer parameter |pdf_output| is positive; otherwise it
+will call |dvi_ship_out|, which is the \TeX\ original |ship_out|.
+
+@p procedure ship_out(p:pointer); {output the box |p|}
+begin
+ fix_pdfoutput;
+ if pdf_output > 0 then
+ pdf_ship_out(p, true)
+ else
+ dvi_ship_out(p);
+end;
+
+@ @<Initialize variables for \.{PDF} output@>=
+ensure_pdf_open;
+check_pdfminorversion;
+prepare_mag;
+fixed_decimal_digits := fix_int(pdf_decimal_digits, 0, 4);
+min_bp_val :=
+ divide_scaled(one_hundred_bp, ten_pow[fixed_decimal_digits + 2], 0);
+fixed_pk_resolution := fix_int(pdf_pk_resolution, 72, 2400);
+pk_scale_factor :=
+ divide_scaled(72, fixed_pk_resolution, 5 + fixed_decimal_digits);
+if pdf_pk_mode <> null then begin
+ kpse_init_prog('PDFTEX', fixed_pk_resolution,
+ make_cstring(tokens_to_string(pdf_pk_mode)), nil);
+ flush_string;
+end else
+ kpse_init_prog('PDFTEX', fixed_pk_resolution, nil, nil);
+if not kpse_var_value('MKTEXPK') then
+ kpse_set_program_enabled (kpse_pk_format, 1, kpse_src_cmdline);
+set_job_id(year, month, day, time, pdftex_version, pdftex_revision);
+if (pdf_unique_resname > 0) and (pdf_resname_prefix = 0) then
+ pdf_resname_prefix := get_resname_prefix
+
+@ Finishing the PDF output file.
+
+The following procedures sort the table of destination names
+@p function str_less_str(s1, s2: str_number): boolean; {compare two strings}
+var j1, j2: pool_pointer;
+ l, i: integer;
+begin
+ j1 := str_start[s1];
+ j2 := str_start[s2];
+ if length(s1) < length(s2) then
+ l := length(s1)
+ else
+ l := length(s2);
+ i := 0;
+ while (i < l) and (str_pool[j1 + i] = str_pool[j2 + i]) do
+ incr(i);
+ if ((i < l) and (str_pool[j1 + i] < str_pool[j2 + i])) or
+ ((i = l) and (length(s1) < length(s2))) then
+ str_less_str := true
+ else
+ str_less_str := false;
+end;
+
+procedure sort_dest_names(l, r: integer); {sorts |dest_names| by names}
+var i, j: integer;
+ s: str_number;
+ x, y: integer;
+ e: dest_name_entry;
+begin
+ i := l;
+ j := r;
+ s := dest_names[(l + r) div 2].objname;
+ repeat
+ while str_less_str(dest_names[i].objname, s) do
+ incr(i);
+ while str_less_str(s, dest_names[j].objname) do
+ decr(j);
+ if i <= j then begin
+ e := dest_names[i];
+ dest_names[i] := dest_names[j];
+ dest_names[j] := e;
+ incr(i);
+ decr(j);
+ end;
+ until i > j;
+ if l < j then
+ sort_dest_names(l, j);
+ if i < r then
+ sort_dest_names(i, r);
+end;
+
+@ Now the finish of PDF output file. At this moment all Page objects
+are already written completely to PDF output file.
+
+@<Finish the PDF file@>=
+if total_pages=0 then print_nl("No pages of output.")
+@.No pages of output@>
+else begin
+ pdf_flush; {to make sure that the output file name has been already
+ created}
+ if total_pages mod pages_tree_kids_max <> 0 then
+ obj_info(pdf_last_pages) := total_pages mod pages_tree_kids_max;
+ {last pages object may have less than |pages_tree_kids_max| chilrend}
+ @<Check for non-existing pages@>;
+ @<Reverse the linked list of Page and Pages objects@>;
+ @<Check for non-existing destinations@>;
+ @<Output fonts definition@>;
+ @<Output pages tree@>;
+ @<Output outlines@>;
+ @<Output name tree@>;
+ @<Output article threads@>;
+ @<Output the catalog object@>;
+ pdf_print_info;
+ @<Output the |obj_tab|@>;
+ @<Output the trailer@>;
+ pdf_flush;
+ print_nl("Output written on "); print_file_name(0, output_file_name, 0);
+ @.Output written on x@>
+ print(" ("); print_int(total_pages); print(" page");
+ if total_pages<>1 then print_char("s");
+ print(", "); print_int(pdf_offset); print(" bytes).");
+ libpdffinish;
+ b_close(pdf_file);
+end
+
+@ Destinations that have been referenced but don't exists have
+|obj_dest_ptr=null|. Leaving them undefined might cause troubles for
+PDF browsers, so we need to fix them.
+
+@p procedure pdf_fix_dest(k: integer);
+begin
+ if obj_dest_ptr(k) <> null then
+ return;
+ pdf_warning("dest", "", false);
+ if obj_info(k) < 0 then begin
+ print("name{");
+ print(-obj_info(k));
+ print("}");
+ end
+ else begin
+ print("num");
+ print_int(obj_info(k));
+ end;
+ print(" has been referenced but does not exist, replaced by a fixed one");
+ print_ln; print_ln;
+ pdf_begin_obj(k);
+ pdf_out("[");
+ pdf_print_int(head_tab[obj_type_page]);
+ pdf_print_ln(" 0 R /Fit]");
+ pdf_end_obj;
+end;
+
+@ @<Check for non-existing destinations@>=
+k := head_tab[obj_type_dest];
+while k <> 0 do begin
+ pdf_fix_dest(k);
+ k := obj_link(k);
+end
+
+@ @<Check for non-existing pages@>=
+k := head_tab[obj_type_page];
+while obj_aux(k) = 0 do begin
+ pdf_warning("dest", "Page ", false);
+ print_int(obj_info(k));
+ print(" has been referenced but does not exist!");
+ print_ln; print_ln;
+ k := obj_link(k);
+end;
+head_tab[obj_type_page] := k
+
+@ @<Reverse the linked list of Page and Pages objects@>=
+k := head_tab[obj_type_page];
+l := 0;
+repeat
+ i := obj_link(k);
+ obj_link(k) := l;
+ l := k;
+ k := i;
+until k = 0;
+head_tab[obj_type_page] := l;
+k := head_tab[obj_type_pages];
+l := 0;
+repeat
+ i := obj_link(k);
+ obj_link(k) := l;
+ l := k;
+ k := i;
+until k = 0;
+head_tab[obj_type_pages] := l
+
+@ @<Output fonts definition@>=
+for k := font_base + 1 to font_ptr do
+ if font_used[k] and hasfmentry(k) then begin
+ if pdf_font_num[k] < 0 then
+ i := -pdf_font_num[k]
+ else
+ i := tfm_of_fm(pdf_font_map[k]);
+ if i <> k then
+ for j := 0 to 255 do
+ if pdf_char_marked(k, j) then
+ pdf_mark_char(i, j);
+ end;
+k := head_tab[obj_type_font];
+while k <> 0 do begin
+ f := obj_info(k);
+ do_pdf_font(k, f);
+ k := obj_link(k);
+end
+
+@ We will generate in each single step the parents of all Pages/Page objects in
+the previous level. These new generated Pages object will create a new level of
+Pages tree. We will repeat this until search only one Pages object. This one
+will be the Root object.
+
+@<Output pages tree@>=
+a := obj_ptr + 1; {all Pages objects whose children are not Page objects
+should have index greater than |a|}
+l := head_tab[obj_type_pages]; {|l| is the index of current Pages object which is
+being output}
+k := head_tab[obj_type_page]; {|k| is the index of current child of |l|}
+if obj_link(l) = 0 then
+ is_root := true {only Pages object; total pages is not greater than
+ |pages_tree_kids_max|}
+else
+ is_root := false;
+b := obj_ptr + 1; {to init |c| in next step}
+repeat
+ i := 0; {counter of Pages object in current level}
+ c := b; {first Pages object in previous level}
+ b := obj_ptr + 1; {succcesor of last created object}
+ repeat
+ if not is_root then begin
+ if i mod pages_tree_kids_max = 0 then begin {create a new Pages object for next level}
+ pdf_last_pages := pdf_new_objnum;
+ obj_info(pdf_last_pages) := obj_info(l);
+ end
+ else
+ obj_info(pdf_last_pages) := obj_info(pdf_last_pages) +
+ obj_info(l);
+ end;
+ @<Output the current Pages object in this level@>;
+ incr(i);
+ if l < a then
+ l := obj_link(l)
+ else
+ incr(l);
+ until (l = 0) or (l = b);
+ if l = 0 then
+ l := a;
+ if b = obj_ptr then
+ is_root := true;
+until false;
+done:
+
+@ @<Output the current Pages object in this level@>=
+pdf_begin_dict(l);
+pdf_print_ln("/Type /Pages");
+pdf_int_entry_ln("Count", obj_info(l));
+if not is_root then
+ pdf_indirect_ln("Parent", pdf_last_pages);
+pdf_print("/Kids [");
+j := 0;
+repeat
+ pdf_print_int(k);
+ pdf_print(" 0 R ");
+ if k < a then {the next Pages/Page object must be |obj_link(k)|}
+ k := obj_link(k)
+ else {|k >= a|, the next Pages object is |k + 1|}
+ incr(k);
+ incr(j);
+until ((l < a) and (j = obj_info(l))) or
+ (k = 0) or (k = c) or
+ (j = pages_tree_kids_max);
+remove_last_space;
+pdf_print_ln("]");
+if k = 0 then begin
+ if head_tab[obj_type_pages] <> 0 then begin {we are in Page objects list}
+ k := head_tab[obj_type_pages];
+ head_tab[obj_type_pages] := 0;
+ end
+ else {we are in Pages objects list}
+ k := a;
+end;
+if is_root and (pdf_pages_attr <> null) then
+ pdf_print_toks_ln(pdf_pages_attr);
+pdf_end_dict;
+if is_root then
+ goto done
+
+@ The name tree is very similiar to Pages tree so its construction should be
+certain from Pages tree construction. For intermediate node |obj_info| will be
+the first name and |obj_link| will be the last name in \.{\\Limits} array.
+Note that |pdf_dest_names_ptr| will be less than |obj_ptr|, so we test if
+|k < pdf_dest_names_ptr| then |k| is index of leaf in |dest_names|; else
+|k| will be index in |obj_tab| of some intermediate node.
+
+@<Output name tree@>=
+if pdf_dest_names_ptr = 0 then begin
+ dests := 0;
+ goto done1;
+end;
+sort_dest_names(0, pdf_dest_names_ptr - 1);
+a := obj_ptr + 1; {first intermediate node of name tree}
+l := a; {index of node being output}
+k := 0; {index of current child of |l|; if |k < pdf_dest_names_ptr| then this is
+pointer to |dest_names| array; otherwise it is the pointer to |obj_tab|
+(object number) }
+repeat
+ c := obj_ptr + 1; {first node in current level}
+ repeat
+ pdf_create_obj(obj_type_others, 0); {create a new node for next level}
+ @<Output the current node in this level@>;
+ incr(l);
+ incr(i);
+ until k = c;
+until false;
+done1:
+if (dests <> 0) or (pdf_names_toks <> null) then begin
+ pdf_new_dict(obj_type_others, 0);
+ if (dests <> 0) then
+ pdf_indirect_ln("Dests", dests);
+ if pdf_names_toks <> null then begin
+ pdf_print_toks_ln(pdf_names_toks);
+ delete_toks(pdf_names_toks);
+ end;
+ pdf_end_dict;
+ names_tree := obj_ptr;
+end
+else
+ names_tree := 0
+
+@ @<Output the current node in this level@>=
+pdf_begin_dict(l);
+j := 0;
+if k < pdf_dest_names_ptr then begin
+ obj_info(l) := dest_names[k].objname;
+ pdf_print("/Names [");
+ repeat
+ pdf_print_str(dest_names[k].objname);
+ pdf_out(" ");
+ pdf_print_int(dest_names[k].objnum);
+ pdf_print(" 0 R ");
+ incr(j);
+ incr(k);
+ until (j = name_tree_kids_max) or (k = pdf_dest_names_ptr);
+ remove_last_space;
+ pdf_print_ln("]");
+ obj_link(l) := dest_names[k - 1].objname;
+ if k = pdf_dest_names_ptr then
+ k := a;
+end
+else begin
+ obj_info(l) := obj_info(k);
+ pdf_print("/Kids [");
+ repeat
+ pdf_print_int(k);
+ pdf_print(" 0 R ");
+ incr(j);
+ incr(k);
+ until (j = name_tree_kids_max) or (k = c);
+ remove_last_space;
+ pdf_print_ln("]");
+ obj_link(l) := obj_link(k - 1);
+end;
+if (l > k) or (l = a) then begin
+ pdf_print("/Limits [");
+ pdf_print_str(obj_info(l));
+ pdf_out(" ");
+ pdf_print_str(obj_link(l));
+ pdf_print_ln("]");
+ pdf_end_dict;
+end
+else begin
+ pdf_end_dict;
+ dests := l;
+ goto done1;
+end
+
+@ @<Output the catalog object@>=
+pdf_new_dict(obj_type_others, 0);
+root := obj_ptr;
+pdf_print_ln("/Type /Catalog");
+pdf_indirect_ln("Pages", pdf_last_pages);
+if threads <> 0 then
+ pdf_indirect_ln("Threads", threads);
+if outlines <> 0 then
+ pdf_indirect_ln("Outlines", outlines);
+if names_tree <> 0 then
+ pdf_indirect_ln("Names", names_tree);
+if pdf_catalog_toks <> null then begin
+ pdf_print_toks_ln(pdf_catalog_toks);
+ delete_toks(pdf_catalog_toks);
+end;
+if pdf_catalog_openaction <> 0 then
+ pdf_indirect_ln("OpenAction", pdf_catalog_openaction);
+pdf_end_dict
+
+@ If the same keys in a dictionary are given several times,
+then it is not defined which value is choosen by an application.
+Therefore the keys |/Producer| and |/Creator| are only set,
+if the token list |pdf_info_toks|, converted to a string does
+not contain these key strings.
+
+@p function substr_of_str(s, t: str_number):boolean;
+label continue,exit;
+var j, k, kk: pool_pointer; {running indices}
+begin
+ k:=str_start[t];
+ while (k < str_start[t+1] - length(s)) do begin
+ j:=str_start[s];
+ kk:=k;
+ while (j < str_start[s+1]) do begin
+ if str_pool[j] <> str_pool[kk] then
+ goto continue;
+ incr(j);
+ incr(kk);
+ end;
+ substr_of_str:=true;
+ return;
+ continue: incr(k);
+ end;
+ substr_of_str:=false;
+end;
+
+procedure pdf_print_info; {print info object}
+var s: str_number;
+ creator_given, producer_given, creationdate_given: boolean;
+begin
+ pdf_new_dict(obj_type_others, 0);
+ creator_given:=false;
+ producer_given:=false;
+ creationdate_given:=false;
+ if pdf_info_toks <> null then begin
+ s:=tokens_to_string(pdf_info_toks);
+ creator_given:=substr_of_str("/Creator", s);
+ producer_given:=substr_of_str("/Producer", s);
+ creationdate_given:=substr_of_str("/CreationDate", s);
+ end;
+ if not producer_given then begin
+ @<Print the Producer key@>;
+ end;
+ if pdf_info_toks <> null then begin
+ if length(s) > 0 then begin
+ pdf_print(s);
+ pdf_print_nl;
+ end;
+ flush_str(s);
+ delete_toks(pdf_info_toks);
+ end;
+ if not creator_given then
+ pdf_str_entry_ln("Creator", "TeX");
+ if not creationdate_given then begin
+ @<Print the CreationDate key@>;
+ end;
+ pdf_str_entry_ln("PTEX.Fullbanner", pdftex_banner);
+ pdf_end_dict;
+end;
+
+@ @<Print the Producer key@>=
+pdf_print("/Producer (pdfTeX-");
+pdf_print_int(pdftex_version div 100);
+pdf_out(".");
+pdf_print_int(pdftex_version mod 100);
+pdf_out(".");
+pdf_print(pdftex_revision);
+pdf_print_ln(")")
+
+@ @<Print the CreationDate key@>=
+print_creation_date;
+
+@ @<Glob...@>=
+@!pdftex_banner: str_number; {the complete banner}
+
+@ @<Output the |obj_tab|@>=
+l := 0;
+for k := 1 to obj_ptr do
+ if obj_offset(k) = 0 then begin
+ obj_link(l) := k;
+ l := k;
+ end;
+obj_link(l) := 0;
+pdf_save_offset := pdf_offset;
+pdf_print_ln("xref");
+pdf_print("0 "); pdf_print_int_ln(obj_ptr + 1);
+pdf_print_fw_int(obj_link(0), 10);
+pdf_print_ln(" 65535 f ");
+for k := 1 to obj_ptr do begin
+ if obj_offset(k) = 0 then begin
+ pdf_print_fw_int(obj_link(k), 10);
+ pdf_print_ln(" 00000 f ");
+ end
+ else begin
+ pdf_print_fw_int(obj_offset(k), 10);
+ pdf_print_ln(" 00000 n ");
+ end;
+end
+
+@ @<Output the trailer@>=
+pdf_print_ln("trailer");
+pdf_print("<< ");
+pdf_int_entry_ln("Size", obj_ptr + 1);
+pdf_indirect_ln("Root", root);
+pdf_indirect_ln("Info", obj_ptr);
+if pdf_trailer_toks <> null then begin
+ pdf_print_toks_ln(pdf_trailer_toks);
+ delete_toks(pdf_trailer_toks);
+end;
+print_ID(output_file_name);
+pdf_print_ln(" >>");
+pdf_print_ln("startxref");
+pdf_print_int_ln(pdf_save_offset);
+pdf_print_ln("%%EOF")
+
+@* \[33] Packaging.
+@z
+
+@x [649]
+exit: hpack:=r;
+@y
+exit: {|hpack|}
+hpack:=r;
+@z
+
+@x [651]
+ kern_node,math_node: x:=x+width(p);
+@y
+ kern_node: x:=x+width(p);
+ math_node: x:=x+width(p);
+@z
+
+@x [888] - fixlinedimen
+append_to_vlist(just_box);
+@y
+if pdf_each_line_height <> 0 then
+ height(just_box) := pdf_each_line_height;
+if pdf_each_line_depth <> 0 then
+ depth(just_box) := pdf_each_line_depth;
+if (pdf_first_line_height <> 0) and (cur_line = prev_graf + 1) then
+ height(just_box) := pdf_first_line_height;
+if (pdf_last_line_depth <> 0) and (cur_line + 1 = best_line) then
+ depth(just_box) := pdf_last_line_depth;
+append_to_vlist(just_box);
+@z
+
+@x [889]
+adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly);
+@y
+adjust_tail:=adjust_head;
+just_box:=hpack(q,cur_width,exactly);
+@z
+
+@x [1088] - quitvmode
+@ A paragraph begins when horizontal-mode material occurs in vertical mode,
+or when the paragraph is explicitly started by `\.{\\indent}' or
+`\.{\\noindent}'.
+
+@<Put each...@>=
+primitive("indent",start_par,1);
+@!@:indent_}{\.{\\indent} primitive@>
+primitive("noindent",start_par,0);
+@!@:no_indent_}{\.{\\noindent} primitive@>
+@y
+@ Here is a really small patch to add a new primitive called
+\.{\\quitvmode}. In vertical modes, it is identical to \.{\\indent},
+but in horizontal and math modes it is really a no-op (as opposed to
+\.{\\indent}, which executes the |indent_in_hmode| procedure).
+
+A paragraph begins when horizontal-mode material occurs in vertical mode,
+or when the paragraph is explicitly started by `\.{\\quitvmode}',
+`\.{\\indent}' or `\.{\\noindent}'.
+
+@<Put each...@>=
+primitive("indent",start_par,1);
+@!@:indent_}{\.{\\indent} primitive@>
+primitive("noindent",start_par,0);
+@!@:no_indent_}{\.{\\noindent} primitive@>
+primitive("quitvmode",start_par,2);
+@!@:quit_vmode_}{\.{\\quitvmode} primitive@>
+@z
+
+@x [1089] - quitvmode
+start_par: if chr_code=0 then print_esc("noindent")@+ else print_esc("indent");
+@y
+start_par: if chr_code=0 then print_esc("noindent")@+ else if chr_code=1 then print_esc("indent")@+ else print_esc("quitvmode");
+@z
+
+@x [1092] - quitvmode
+hmode+start_par,mmode+start_par: indent_in_hmode;
+@y
+hmode+start_par,mmode+start_par: if cur_chr<>2 then indent_in_hmode;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Declare the necessary variables for finishing PDF file
+% Close PDF output if necessary
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x [1333]
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+@y
+procedure close_files_and_terminate;
+label done, done1;
+var a, b, c, i, j, k, l: integer; {all-purpose index}
+ is_root: boolean; {|pdf_last_pages| is root of Pages tree?}
+ root, outlines, threads, names_tree, dests, fixed_dest: integer;
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal;
+if fixed_pdfoutput > 0 then begin
+ if history = fatal_error_stop then
+ print_err(" ==> Fatal error occurred, the output PDF file is not finished!")
+ else begin
+ @<Finish the PDF file@>;
+ end;
+end
+else begin
+ @<Finish the \.{DVI} file@>;
+end;
+@z
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Output statistics about the pdftex specific sizes only in PDF mode.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x [1334]
+ wlog_ln(' ',max_in_stack:1,'i,',max_nest_stack:1,'n,',@|
+ max_param_stack:1,'p,',@|
+ max_buf_stack+1:1,'b,',@|
+ max_save_stack+6:1,'s stack positions out of ',@|
+ stack_size:1,'i,',
+ nest_size:1,'n,',
+ param_size:1,'p,',
+ buf_size:1,'b,',
+ save_size:1,'s');
+ end
+@y
+ wlog_ln(' ',max_in_stack:1,'i,',max_nest_stack:1,'n,',@|
+ max_param_stack:1,'p,',@|
+ max_buf_stack+1:1,'b,',@|
+ max_save_stack+6:1,'s stack positions out of ',@|
+ stack_size:1,'i,',
+ nest_size:1,'n,',
+ param_size:1,'p,',
+ buf_size:1,'b,',
+ save_size:1,'s');
+ if (pdf_output > 0) then begin
+ wlog_ln('PDF statistics:');
+ wlog_ln(' ',obj_ptr:1,' PDF objects out of ',obj_tab_size:1);
+ wlog_ln(' ',pdf_dest_names_ptr:1,' named destinations out of ',dest_names_size:1);
+ wlog_ln(' ',pdf_mem_ptr:1,' words of extra memory for PDF output out of ',pdf_mem_size:1);
+ end;
+ end
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Override pdf_output value from format file with command line option
+% and initialize other options
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ while (loc<limit)and(buffer[loc]=" ") do incr(loc);
+ end;
+@y
+ while (loc<limit)and(buffer[loc]=" ") do incr(loc);
+ end;
+if (pdf_output_option <> 0) then pdf_output := pdf_output_value;
+pdf_init_map_file('pdftex.map');
+@z
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% PDF-speficic extensions that don't fall to any previous category
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x [1344]
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@y
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@d pdftex_first_extension_code = 6
+@d pdf_literal_node == pdftex_first_extension_code + 0
+@d pdf_obj_code == pdftex_first_extension_code + 1
+@d pdf_refobj_node == pdftex_first_extension_code + 2
+@d pdf_xform_code == pdftex_first_extension_code + 3
+@d pdf_refxform_node == pdftex_first_extension_code + 4
+@d pdf_ximage_code == pdftex_first_extension_code + 5
+@d pdf_refximage_node == pdftex_first_extension_code + 6
+@d pdf_annot_node == pdftex_first_extension_code + 7
+@d pdf_start_link_node == pdftex_first_extension_code + 8
+@d pdf_end_link_node == pdftex_first_extension_code + 9
+@d pdf_outline_code == pdftex_first_extension_code + 10
+@d pdf_dest_node == pdftex_first_extension_code + 11
+@d pdf_thread_node == pdftex_first_extension_code + 12
+@d pdf_start_thread_node == pdftex_first_extension_code + 13
+@d pdf_end_thread_node == pdftex_first_extension_code + 14
+@d pdf_save_pos_node == pdftex_first_extension_code + 15
+@d pdf_info_code == pdftex_first_extension_code + 16
+@d pdf_catalog_code == pdftex_first_extension_code + 17
+@d pdf_names_code == pdftex_first_extension_code + 18
+@d pdf_font_attr_code == pdftex_first_extension_code + 19
+@d pdf_include_chars_code == pdftex_first_extension_code + 20
+@d pdf_map_file_code == pdftex_first_extension_code + 21
+@d pdf_map_line_code == pdftex_first_extension_code + 22
+@d pdf_trailer_code == pdftex_first_extension_code + 23
+@d pdf_strcmp_code == pdftex_first_extension_code + 24
+@d pdf_escape_string_code == pdftex_first_extension_code + 25
+@d pdf_escape_name_code == pdftex_first_extension_code + 26
+@d reset_timer_code == pdftex_first_extension_code + 27
+@d pdftex_last_extension_code == pdftex_first_extension_code + 27
+@z
+
+@x [1344]
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+@y
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+primitive("pdfliteral",extension,pdf_literal_node);@/
+@!@:pdf_literal_}{\.{\\pdfliteral} primitive@>
+primitive("pdfobj",extension,pdf_obj_code);@/
+@!@:pdf_obj_}{\.{\\pdfobj} primitive@>
+primitive("pdfrefobj",extension,pdf_refobj_node);@/
+@!@:pdf_refobj_}{\.{\\pdfrefobj} primitive@>
+primitive("pdfxform",extension,pdf_xform_code);@/
+@!@:pdf_xform_}{\.{\\pdfxform} primitive@>
+primitive("pdfrefxform",extension,pdf_refxform_node);@/
+@!@:pdf_refxform_}{\.{\\pdfrefxform} primitive@>
+primitive("pdfximage",extension,pdf_ximage_code);@/
+@!@:pdf_ximage_}{\.{\\pdfximage} primitive@>
+primitive("pdfrefximage",extension,pdf_refximage_node);@/
+@!@:pdf_refximage_}{\.{\\pdfrefximage} primitive@>
+primitive("pdfannot",extension,pdf_annot_node);@/
+@!@:pdf_annot_}{\.{\\pdfannot} primitive@>
+primitive("pdfstartlink",extension,pdf_start_link_node);@/
+@!@:pdf_start_link_}{\.{\\pdfstartlink} primitive@>
+primitive("pdfendlink",extension,pdf_end_link_node);@/
+@!@:pdf_end_link_}{\.{\\pdfendlink} primitive@>
+primitive("pdfoutline",extension,pdf_outline_code);@/
+@!@:pdf_outline_}{\.{\\pdfoutline} primitive@>
+primitive("pdfdest",extension,pdf_dest_node);@/
+@!@:pdf_dest_}{\.{\\pdfdest} primitive@>
+primitive("pdfthread",extension,pdf_thread_node);@/
+@!@:pdf_thread_}{\.{\\pdfthread} primitive@>
+primitive("pdfstartthread",extension,pdf_start_thread_node);@/
+@!@:pdf_start_thread_}{\.{\\pdfstartthread} primitive@>
+primitive("pdfendthread",extension,pdf_end_thread_node);@/
+@!@:pdf_end_thread_}{\.{\\pdfendthread} primitive@>
+primitive("pdfsavepos",extension,pdf_save_pos_node);@/
+@!@:pdf_save_pos_}{\.{\\pdfsavepos} primitive@>
+primitive("pdfinfo",extension,pdf_info_code);@/
+@!@:pdf_info_}{\.{\\pdfinfo} primitive@>
+primitive("pdfcatalog",extension,pdf_catalog_code);@/
+@!@:pdf_catalog_}{\.{\\pdfcatalog} primitive@>
+primitive("pdfnames",extension,pdf_names_code);@/
+@!@:pdf_names_}{\.{\\pdfnames} primitive@>
+primitive("pdfincludechars",extension,pdf_include_chars_code);@/
+@!@:pdf_include_chars_}{\.{\\pdfincludechars} primitive@>
+primitive("pdffontattr",extension,pdf_font_attr_code);@/
+@!@:pdf_font_attr_}{\.{\\pdffontattr} primitive@>
+primitive("pdfmapfile",extension,pdf_map_file_code);@/
+@!@:pdf_map_file_}{\.{\\pdfmapfile} primitive@>
+primitive("pdfmapline",extension,pdf_map_line_code);@/
+@!@:pdf_map_line_}{\.{\\pdfmapline} primitive@>
+primitive("pdftrailer",extension,pdf_trailer_code);@/
+@!@:pdf_trailer_}{\.{\\pdftrailer} primitive@>
+primitive("pdfstrcmp",extension,pdf_strcmp_code);@/
+@!@:pdf_strcmp_}{\.{\\pdfstrcmp} primitive@>
+primitive("pdfescapestring",extension,pdf_escape_string_code);@/
+@!@:pdf_escape_string_}{\.{\\pdfescapestring} primitive@>
+primitive("pdfescapename",extension,pdf_escape_name_code);@/
+@!@:pdf_escape_name_}{\.{\\pdfescapename} primitive@>
+primitive("pdfresettimer",extension,reset_timer_code);@/
+@!@:reset_timer_}{\.{\\pdfresettimer} primitive@>
+@z
+
+@x [1346]
+ set_language_code:print_esc("setlanguage");
+@y
+ set_language_code:print_esc("setlanguage");
+ pdf_literal_node: print_esc("pdfliteral");
+ pdf_obj_code: print_esc("pdfobj");
+ pdf_refobj_node: print_esc("pdfrefobj");
+ pdf_xform_code: print_esc("pdfxform");
+ pdf_refxform_node: print_esc("pdfrefxform");
+ pdf_ximage_code: print_esc("pdfximage");
+ pdf_refximage_node: print_esc("pdfrefximage");
+ pdf_annot_node: print_esc("pdfannot");
+ pdf_start_link_node: print_esc("pdfstartlink");
+ pdf_end_link_node: print_esc("pdfendlink");
+ pdf_outline_code: print_esc("pdfoutline");
+ pdf_dest_node: print_esc("pdfdest");
+ pdf_thread_node: print_esc("pdfthread");
+ pdf_start_thread_node: print_esc("pdfstartthread");
+ pdf_end_thread_node: print_esc("pdfendthread");
+ pdf_save_pos_node: print_esc("pdfsavepos");
+ pdf_info_code: print_esc("pdfinfo");
+ pdf_catalog_code: print_esc("pdfcatalog");
+ pdf_names_code: print_esc("pdfnames");
+ pdf_include_chars_code: print_esc("pdfincludechars");
+ pdf_font_attr_code: print_esc("pdffontattr");
+ pdf_map_file_code: print_esc("pdfmapfile");
+ pdf_map_line_code: print_esc("pdfmapline");
+ pdf_trailer_code: print_esc("pdftrailer");
+ pdf_strcmp_code: print_esc("pdfstrcmp");
+ pdf_escape_string_code: print_esc("pdfescapestring");
+ pdf_escape_name_code: print_esc("pdfescapename");
+ reset_timer_code: print_esc("pdfresettimer");
+@z
+
+@x [1348]
+immediate_code:@<Implement \.{\\immediate}@>;
+set_language_code:@<Implement \.{\\setlanguage}@>;
+@y
+immediate_code:@<Implement \.{\\immediate}@>;
+set_language_code:@<Implement \.{\\setlanguage}@>;
+pdf_literal_node: @<Implement \.{\\pdfliteral}@>;
+pdf_obj_code: @<Implement \.{\\pdfobj}@>;
+pdf_refobj_node: @<Implement \.{\\pdfrefobj}@>;
+pdf_xform_code: @<Implement \.{\\pdfxform}@>;
+pdf_refxform_node: @<Implement \.{\\pdfrefxform}@>;
+pdf_ximage_code: @<Implement \.{\\pdfximage}@>;
+pdf_refximage_node: @<Implement \.{\\pdfrefximage}@>;
+pdf_annot_node: @<Implement \.{\\pdfannot}@>;
+pdf_start_link_node: @<Implement \.{\\pdfstartlink}@>;
+pdf_end_link_node: @<Implement \.{\\pdfendlink}@>;
+pdf_outline_code: @<Implement \.{\\pdfoutline}@>;
+pdf_dest_node: @<Implement \.{\\pdfdest}@>;
+pdf_thread_node: @<Implement \.{\\pdfthread}@>;
+pdf_start_thread_node: @<Implement \.{\\pdfstartthread}@>;
+pdf_end_thread_node: @<Implement \.{\\pdfendthread}@>;
+pdf_save_pos_node: @<Implement \.{\\pdfsavepos}@>;
+pdf_info_code: @<Implement \.{\\pdfinfo}@>;
+pdf_catalog_code: @<Implement \.{\\pdfcatalog}@>;
+pdf_names_code: @<Implement \.{\\pdfnames}@>;
+pdf_include_chars_code: @<Implement \.{\\pdfincludechars}@>;
+pdf_font_attr_code: @<Implement \.{\\pdffontattr}@>;
+pdf_map_file_code: @<Implement \.{\\pdfmapfile}@>;
+pdf_map_line_code: @<Implement \.{\\pdfmapline}@>;
+pdf_trailer_code: @<Implement \.{\\pdftrailer}@>;
+pdf_strcmp_code: @<Implement \.{\\pdfstrcmp}@>;
+pdf_escape_string_code: @<Implement \.{\\pdfescapestring}@>;
+pdf_escape_name_code: @<Implement \.{\\pdfescapename}@>;
+reset_timer_code: @<Implement \.{\\pdfresettimer}@>;
+@z
+
+@x [1354]
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+@y
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+
+@ The following macros are needed for further manipulation with whatsit nodes
+for \pdfTeX{} extensions (copying, destroying etc.)
+
+@d add_action_ref(#) == incr(pdf_action_refcount(#)) {increase count of
+references to this action}
+
+@d delete_action_ref(#) == {decrease count of references to this
+action; free it if there is no reference to this action}
+begin
+ if pdf_action_refcount(#) = null then begin
+ if pdf_action_type(#) = pdf_action_user then
+ delete_token_ref(pdf_action_user_tokens(#))
+ else begin
+ if pdf_action_file(#) <> null then
+ delete_token_ref(pdf_action_file(#));
+ if pdf_action_type(#) = pdf_action_page then
+ delete_token_ref(pdf_action_page_tokens(#))
+ else if pdf_action_named_id(#) > 0 then
+ delete_token_ref(pdf_action_id(#));
+ end;
+ free_node(#, pdf_action_size);
+ end
+ else
+ decr(pdf_action_refcount(#));
+end
+
+@ We have to check whether \.{\\pdfoutput} is set for using \pdfTeX{}
+ extensions.
+@<Declare procedures needed in |do_ext...@>=
+procedure check_pdfoutput(s: str_number; is_error : boolean);
+begin
+ if pdf_output <= 0 then
+ if is_error then
+ pdf_error(s, "used while \pdfoutput is not set")
+ else
+ pdf_warning(s, "used while \pdfoutput is not set; ignoring it", true);
+end;
+
+procedure scan_pdf_ext_toks;
+begin
+ call_func(scan_toks(false, true)); {like \.{\\special}}
+end;
+
+procedure compare_strings; {to implement \.{\\pdfstrcmp}}
+label done;
+var s1, s2: str_number;
+ i1, i2, j1, j2: pool_pointer;
+ result: integer;
+begin
+ call_func(scan_toks(false, true));
+ s1 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ call_func(scan_toks(false, true));
+ s2 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ i1 := str_start[s1];
+ j1 := str_start[s1 + 1];
+ i2 := str_start[s2];
+ j2 := str_start[s2 + 1];
+ while (i1 < j1) and (i2 < j2) do begin
+ if str_pool[i1] < str_pool[i2] then begin
+ result := -1;
+ goto done;
+ end;
+ if str_pool[i1] > str_pool[i2] then begin
+ result := 1;
+ goto done;
+ end;
+ incr(i1);
+ incr(i2);
+ end;
+ if (i1 = j1) and (i2 = j2) then
+ result := 0
+ else if i1 < j1 then
+ result := 1
+ else
+ result := -1;
+done:
+ pdf_retval := result;
+ flush_str(s2);
+ flush_str(s1);
+end;
+
+@ @<Implement \.{\\pdfliteral}@>=
+begin
+ check_pdfoutput("\pdfliteral", true);
+ new_whatsit(pdf_literal_node, write_node_size);
+ if scan_keyword("direct") then
+ pdf_literal_mode(tail) := direct_always
+ else if scan_keyword("page") then
+ pdf_literal_mode(tail) := direct_page
+ else
+ pdf_literal_mode(tail) := reset_origin;
+ scan_pdf_ext_toks;
+ pdf_literal_data(tail) := def_ref;
+end
+
+@ The \.{\\pdfobj} primitive is used to create a ``raw'' object in the PDF
+ output file. The object contents will be hold in memory and will be written
+ out only when the object is referenced by \.{\\pdfrefobj}. When \.{\\pdfobj}
+ is used with \.{\\immediate}, the object contents will be written out
+ immediately. Objects referenced in the current page are appended into
+ |pdf_obj_list|.
+
+@<Glob...@>=
+@!pdf_last_obj: integer;
+
+@ @<Implement \.{\\pdfobj}@>=
+begin
+ check_pdfoutput("\pdfobj", true);
+ if scan_keyword("reserveobjnum") then begin
+ @<Scan an optional space@>;
+ incr(pdf_obj_count);
+ pdf_create_obj(obj_type_obj, pdf_obj_count);
+ pdf_last_obj := obj_ptr;
+ end
+ else begin
+ k := -1;
+ if scan_keyword("useobjnum") then begin
+ scan_int;
+ k := cur_val;
+ if (k <= 0) or (k > obj_ptr) or (obj_data_ptr(k) <> 0) then begin
+ pdf_warning("\pdfobj", "invalid object number being ignored", true);
+ pdf_retval := -1; {signal the problem}
+ k := -1; {will be generated again}
+ end;
+ end;
+ if k < 0 then begin
+ incr(pdf_obj_count);
+ pdf_create_obj(obj_type_obj, pdf_obj_count);
+ k := obj_ptr;
+ end;
+ obj_data_ptr(k) := pdf_get_mem(pdfmem_obj_size);
+ if scan_keyword("stream") then begin
+ obj_obj_is_stream(k) := 1;
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ obj_obj_stream_attr(k) := def_ref;
+ end
+ else
+ obj_obj_stream_attr(k) := null;
+ end
+ else
+ obj_obj_is_stream(k) := 0;
+ if scan_keyword("file") then
+ obj_obj_is_file(k) := 1
+ else
+ obj_obj_is_file(k) := 0;
+ scan_pdf_ext_toks;
+ obj_obj_data(k) := def_ref;
+ pdf_last_obj := k;
+ end;
+end
+
+@ We need to check whether the referenced object exists.
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+procedure pdf_check_obj(t, n: integer);
+var k: integer;
+begin
+ k := head_tab[t];
+ while (k <> 0) and (k <> n) do
+ k := obj_link(k);
+ if k = 0 then
+ pdf_error("ext1", "cannot find referenced object");
+end;
+
+@ @<Implement \.{\\pdfrefobj}@>=
+begin
+ check_pdfoutput("\pdfrefobj", true);
+ scan_int;
+ pdf_check_obj(obj_type_obj, cur_val);
+ new_whatsit(pdf_refobj_node, pdf_refobj_node_size);
+ pdf_obj_objnum(tail) := cur_val;
+end
+
+@ \.{\\pdfxform} and \.{\\pdfrefxform} are similiar to \.{\\pdfobj} and
+ \.{\\pdfrefobj}
+
+@<Glob...@>=
+@!pdf_last_xform: integer;
+
+@ @<Implement \.{\\pdfxform}@>=
+begin
+ check_pdfoutput("\pdfxform", true);
+ incr(pdf_xform_count);
+ pdf_create_obj(obj_type_xform, pdf_xform_count);
+ k := obj_ptr;
+ obj_data_ptr(k) := pdf_get_mem(pdfmem_xform_size);
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ obj_xform_attr(k) := def_ref;
+ end
+ else
+ obj_xform_attr(k) := null;
+ if scan_keyword("resources") then begin
+ scan_pdf_ext_toks;
+ obj_xform_resources(k) := def_ref;
+ end
+ else
+ obj_xform_resources(k) := null;
+ scan_int;
+ if box(cur_val) = null then
+ pdf_error("ext1", "\pdfxform cannot be used with a void box");
+ obj_xform_width(k) := width(box(cur_val));
+ obj_xform_height(k) := height(box(cur_val));
+ obj_xform_depth(k) := depth(box(cur_val));
+ obj_xform_box(k) := box(cur_val); {save pointer to the box}
+ box(cur_val) := null;
+ pdf_last_xform := k;
+end
+
+@ @<Implement \.{\\pdfrefxform}@>=
+begin
+ check_pdfoutput("\pdfrefxform", true);
+ scan_int;
+ pdf_check_obj(obj_type_xform, cur_val);
+ new_whatsit(pdf_refxform_node, pdf_refxform_node_size);
+ pdf_xform_objnum(tail) := cur_val;
+ pdf_width(tail) := obj_xform_width(cur_val);
+ pdf_height(tail) := obj_xform_height(cur_val);
+ pdf_depth(tail) := obj_xform_depth(cur_val);
+end
+
+@ \.{\\pdfximage} and \.{\\pdfrefximage} are similiar to \.{\\pdfxform} and
+ \.{\\pdfrefxform}. As we have to scan |<rule spec>| quite often, it is better
+ have a |rule_node| that holds the most recently scanned |<rule spec>|.
+
+@<Glob...@>=
+@!pdf_last_ximage: integer;
+@!pdf_last_ximage_pages: integer;
+@!pdf_last_ximage_colordepth: integer;
+@!alt_rule: pointer;
+@!pdf_last_pdf_box_spec: integer;
+
+@ @<Set init...@>=
+alt_rule := null;
+
+@ @<Declare procedures needed in |do_ext...@>=
+procedure scale_image(n: integer);
+var x, y, xr, yr: integer; {size and resolution of image}
+ w, h: scaled; {indeed size corresponds to image resolution}
+ default_res: integer;
+begin
+ x := image_width(obj_ximage_data(n));
+ y := image_height(obj_ximage_data(n));
+ xr := image_x_res(obj_ximage_data(n));
+ yr := image_y_res(obj_ximage_data(n));
+ if (xr > 65535) or (yr > 65535) then begin
+ xr := 0;
+ yr := 0;
+ pdf_warning("ext1", "too large image resolution ignored", true);
+ end;
+ if (x <= 0) or (y <= 0) or (xr < 0) or (yr < 0) then
+ pdf_error("ext1", "invalid image dimensions");
+ if is_pdf_image(obj_ximage_data(n)) then begin
+ w := x;
+ h := y;
+ end
+ else begin
+ default_res := fix_int(pdf_image_resolution, 0, 65535);
+ if (default_res > 0) and ((xr = 0) or (yr = 0)) then begin
+ xr := default_res;
+ yr := default_res;
+ end;
+ if is_running(obj_ximage_width(n)) and
+ is_running(obj_ximage_height(n)) then
+ begin
+ if (xr > 0) and (yr > 0) then begin
+ w := ext_xn_over_d(one_hundred_inch, x, 100*xr);
+ h := ext_xn_over_d(one_hundred_inch, y, 100*yr);
+ end
+ else begin
+ w := ext_xn_over_d(one_hundred_inch, x, 7200);
+ h := ext_xn_over_d(one_hundred_inch, y, 7200);
+ end;
+ end;
+ end;
+ if is_running(obj_ximage_width(n)) and is_running(obj_ximage_height(n)) and
+ is_running(obj_ximage_depth(n)) then begin
+ obj_ximage_width(n) := w;
+ obj_ximage_height(n) := h;
+ obj_ximage_depth(n) := 0;
+ end
+ else if is_running(obj_ximage_width(n)) then begin
+ {image depth or height is explicitly specified}
+ if is_running(obj_ximage_height(n)) then begin
+ {image depth is explicitly specified}
+ obj_ximage_width(n) := ext_xn_over_d(h, x, y);
+ obj_ximage_height(n) := h - obj_ximage_depth(n);
+ end
+ else if is_running(obj_ximage_depth(n)) then begin
+ {image height is explicitly specified}
+ obj_ximage_width(n) := ext_xn_over_d(obj_ximage_height(n), x, y);
+ obj_ximage_depth(n) := 0;
+ end
+ else begin
+ {both image depth and height are explicitly specified}
+ obj_ximage_width(n) := ext_xn_over_d(obj_ximage_height(n) +
+ obj_ximage_depth(n), x, y);
+ end;
+ end
+ else begin
+ {image width is explicitly specified}
+ if is_running(obj_ximage_height(n)) and
+ is_running(obj_ximage_depth(n)) then begin
+ {both image depth and height are not specified}
+ obj_ximage_height(n) := ext_xn_over_d(obj_ximage_width(n), y, x);
+ obj_ximage_depth(n) := 0;
+ end
+ {image depth is explicitly specified}
+ else if is_running(obj_ximage_height(n)) then begin
+ obj_ximage_height(n) :=
+ ext_xn_over_d(obj_ximage_width(n), y, x) - obj_ximage_depth(n);
+ end
+ {image height is explicitly specified}
+ else if is_running(obj_ximage_depth(n)) then begin
+ obj_ximage_depth(n) := 0;
+ end
+ {both image depth and height are explicitly specified}
+ else
+ do_nothing;
+ end;
+end;
+
+procedure scan_pdf_box_spec; {scans pdf-box-spec to |pdf_last_pdf_box_spec|}
+begin
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_crop;
+
+ if scan_keyword("mediabox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_media
+ else if scan_keyword("cropbox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_crop
+ else if scan_keyword("bleedbox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_bleed
+ else if scan_keyword("trimbox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_trim
+ else if scan_keyword("artbox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_art
+end;
+
+procedure scan_alt_rule; {scans rule spec to |alt_rule|}
+label reswitch;
+begin
+ if alt_rule = null then
+ alt_rule := new_rule;
+ width(alt_rule) := null_flag;
+ height(alt_rule) := null_flag;
+ depth(alt_rule) := null_flag;
+reswitch:
+ if scan_keyword("width") then begin
+ scan_normal_dimen;
+ width(alt_rule) := cur_val;
+ goto reswitch;
+ end;
+ if scan_keyword("height") then begin
+ scan_normal_dimen;
+ height(alt_rule) := cur_val;
+ goto reswitch;
+ end;
+ if scan_keyword("depth") then begin
+ scan_normal_dimen;
+ depth(alt_rule) := cur_val;
+ goto reswitch;
+ end;
+end;
+
+procedure scan_image;
+label reswitch;
+var p: pointer;
+ k: integer;
+ named: str_number;
+ s: str_number;
+ page, colorspace: integer;
+begin
+ incr(pdf_ximage_count);
+ pdf_create_obj(obj_type_ximage, pdf_ximage_count);
+ k := obj_ptr;
+ obj_data_ptr(k) := pdf_get_mem(pdfmem_ximage_size);
+ scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
+ obj_ximage_width(k) := width(alt_rule);
+ obj_ximage_height(k) := height(alt_rule);
+ obj_ximage_depth(k) := depth(alt_rule);
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ obj_ximage_attr(k) := def_ref;
+ end
+ else
+ obj_ximage_attr(k) := null;
+ named := 0;
+ if scan_keyword("named") then begin
+ scan_pdf_ext_toks;
+ named := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ end
+ else if scan_keyword("page") then begin
+ scan_int;
+ page := cur_val;
+ end
+ else
+ page := 1;
+ if scan_keyword("colorspace") then begin
+ scan_int;
+ colorspace := cur_val;
+ end
+ else
+ colorspace := 0;
+ scan_pdf_box_spec; {scans pdf-box-spec to |pdf_last_pdf_box_spec|}
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ if pdf_option_always_use_pdfpagebox <> 0 then begin
+ pdf_warning(0,"Primitive \pdfoptionalwaysusepdfpagebox is obsolete; use \pdfforcepagebox instead.",true);
+ pdf_force_pagebox := pdf_option_always_use_pdfpagebox;
+ pdf_option_always_use_pdfpagebox := 0; {warn once}
+ end;
+ if pdf_option_pdf_inclusion_errorlevel <> 0 then begin
+ pdf_warning(0,"Primitive \pdfoptionpdfinclusionerrorlevel is obsolete; use \pdfinclusionerrorlevel instead.",true);
+ pdf_inclusion_errorlevel := pdf_option_pdf_inclusion_errorlevel;
+ pdf_option_pdf_inclusion_errorlevel := 0; {warn once}
+ end;
+ if pdf_force_pagebox > 0 then begin
+ print_err("pdfTeX warning (image inclusion): ");
+ print ("\pdfforcepagebox is in use (");
+ print_int (pdf_force_pagebox);
+ print (")");
+ print_ln;
+ end;
+ obj_ximage_data(k) := read_image(s, page, named, colorspace,
+ pdf_minor_version,
+ pdf_force_pagebox,
+ pdf_inclusion_errorlevel);
+ if named <> 0 then flush_str(named);
+ flush_str(s);
+ scale_image(k);
+ pdf_last_ximage := k;
+ pdf_last_ximage_pages := image_pages(obj_ximage_data(k));
+ pdf_last_ximage_colordepth := image_colordepth(obj_ximage_data(k));
+end;
+
+@ @<Implement \.{\\pdfximage}@>=
+begin
+ check_pdfoutput("\pdfximage", true);
+ check_pdfminorversion;
+ scan_image;
+end
+
+@ @<Implement \.{\\pdfrefximage}@>=
+begin
+ check_pdfoutput("\pdfrefximage", true);
+ scan_int;
+ pdf_check_obj(obj_type_ximage, cur_val);
+ new_whatsit(pdf_refximage_node, pdf_refximage_node_size);
+ pdf_ximage_objnum(tail) := cur_val;
+ pdf_width(tail) := obj_ximage_width(cur_val);
+ pdf_height(tail) := obj_ximage_height(cur_val);
+ pdf_depth(tail) := obj_ximage_depth(cur_val);
+end
+
+@ The following function finds object with identifier |i| and type |t|.
+ |i < 0| indicates that |-i| should be treated as a string number. If no
+ such object exists then it will be created. This function is used mainly to
+ find destination for link annotations and outlines; however it is also used
+ in |pdf_ship_out| (to check whether a Page object already exists) so we need
+ to declare it together with subroutines needed in |pdf_hlist_out| and
+ |pdf_vlist_out|.
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+function find_obj(t, i: integer; byname: boolean): integer;
+begin
+ find_obj := avl_find_obj(t, i, byname);
+end;
+
+procedure flush_str(s: str_number); {flush a string if possible}
+begin
+ if flushable(s) then
+ flush_string;
+end;
+
+function get_obj(t, i: integer; byname: boolean): integer;
+var r: integer;
+ s: str_number;
+begin
+ if byname > 0 then begin
+ s := tokens_to_string(i);
+ r := find_obj(t, s, true);
+ end
+ else begin
+ s := 0;
+ r := find_obj(t, i, false);
+ end;
+ if r = 0 then begin
+ if byname > 0 then begin
+ pdf_create_obj(t, -s);
+ s := 0;
+ end
+ else
+ pdf_create_obj(t, i);
+ r := obj_ptr;
+ if t = obj_type_dest then
+ obj_dest_ptr(r) := null;
+ end;
+ if s <> 0 then
+ flush_str(s);
+ get_obj := r;
+end;
+
+function get_microinterval:integer;
+var s,@!m:integer; {seconds and microseconds}
+begin
+ seconds_and_micros(s,m);
+ if (s-epochseconds)>32767 then
+ get_microinterval := max_integer
+ else if (microseconds>m) then
+ get_microinterval := ((s-1-epochseconds)*65536)+ (((m+1000000-microseconds)/100)*65536)/10000
+ else
+ get_microinterval := ((s-epochseconds)*65536) + (((m-microseconds)/100)*65536)/10000;
+end;
+
+
+@ @<Declare procedures needed in |do_ext...@>=
+function scan_action: pointer; {read an action specification}
+var p, t: integer;
+ s: str_number;
+begin
+ p := get_node(pdf_action_size);
+ scan_action := p;
+ pdf_action_file(p) := null;
+ pdf_action_refcount(p) := null;
+ if scan_keyword("user") then
+ pdf_action_type(p) := pdf_action_user
+ else if scan_keyword("goto") then
+ pdf_action_type(p) := pdf_action_goto
+ else if scan_keyword("thread") then
+ pdf_action_type(p) := pdf_action_thread
+ else
+ pdf_error("ext1", "action type missing");
+ if pdf_action_type(p) = pdf_action_user then begin
+ scan_pdf_ext_toks;
+ pdf_action_user_tokens(p) := def_ref;
+ return;
+ end;
+ if scan_keyword("file") then begin
+ scan_pdf_ext_toks;
+ pdf_action_file(p) := def_ref;
+ end;
+ if scan_keyword("page") then begin
+ if pdf_action_type(p) <> pdf_action_goto then
+ pdf_error("ext1", "only GoTo action can be used with `page'");
+ pdf_action_type(p) := pdf_action_page;
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("ext1", "page number must be positive");
+ pdf_action_id(p) := cur_val;
+ pdf_action_named_id(p) := 0;
+ scan_pdf_ext_toks;
+ pdf_action_page_tokens(p) := def_ref;
+ end
+ else if scan_keyword("name") then begin
+ scan_pdf_ext_toks;
+ pdf_action_named_id(p) := 1;
+ pdf_action_id(p) := def_ref;
+ end
+ else if scan_keyword("num") then begin
+ if (pdf_action_type(p) = pdf_action_goto) and
+ (pdf_action_file(p) <> null) then
+ pdf_error("ext1",
+ "`goto' option cannot be used with both `file' and `num'");
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("ext1", "num identifier must be positive");
+ pdf_action_named_id(p) := 0;
+ pdf_action_id(p) := cur_val;
+ end
+ else
+ pdf_error("ext1", "identifier type missing");
+ if scan_keyword("newwindow") then begin
+ pdf_action_new_window(p) := 1;
+ @<Scan an optional space@>; end
+ else if scan_keyword("nonewwindow") then begin
+ pdf_action_new_window(p) := 2;
+ @<Scan an optional space@>; end
+ else
+ pdf_action_new_window(p) := 0;
+ if (pdf_action_new_window(p) > 0) and
+ (((pdf_action_type(p) <> pdf_action_goto) and
+ (pdf_action_type(p) <> pdf_action_page)) or
+ (pdf_action_file(p) = null)) then
+ pdf_error("ext1",
+ "`newwindow'/`nonewwindow' must be used with `goto' and `file' option");
+end;
+
+procedure new_annot_whatsit(w, s: small_number); {create a new whatsit node for
+annotation}
+var p: pointer;
+begin
+ new_whatsit(w, s);
+ scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
+ pdf_width(tail) := width(alt_rule);
+ pdf_height(tail) := height(alt_rule);
+ pdf_depth(tail) := depth(alt_rule);
+ if (w = pdf_start_link_node) then begin
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ pdf_link_attr(tail) := def_ref;
+ end
+ else
+ pdf_link_attr(tail) := null;
+ end;
+ if (w = pdf_thread_node) or (w = pdf_start_thread_node) then begin
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ pdf_thread_attr(tail) := def_ref;
+ end
+ else
+ pdf_thread_attr(tail) := null;
+ end;
+end;
+
+@ @<Glob...@>=
+@!pdf_last_annot: integer;
+
+@ @<Implement \.{\\pdfannot}@>=
+begin
+ check_pdfoutput("\pdfannot", true);
+ if scan_keyword("reserveobjnum") then begin
+ pdf_last_annot := pdf_new_objnum;
+ @<Scan an optional space@>; end
+ else begin
+ if scan_keyword("useobjnum") then begin
+ scan_int;
+ k := cur_val;
+ if (k <= 0) or (k > obj_ptr) or (obj_annot_ptr(k) <> 0) then
+ pdf_error("ext1", "invalid object number");
+ end
+ else
+ k := pdf_new_objnum;
+ new_annot_whatsit(pdf_annot_node, pdf_annot_node_size);
+ pdf_annot_objnum(tail) := k;
+ scan_pdf_ext_toks;
+ pdf_annot_data(tail) := def_ref;
+ pdf_last_annot := k;
+ end
+end
+
+@ @<Implement \.{\\pdfstartlink}@>=
+begin
+ check_pdfoutput("\pdfstartlink", true);
+ if abs(mode) = vmode then
+ pdf_error("ext1", "\pdfstartlink cannot be used in vertical mode");
+ new_annot_whatsit(pdf_start_link_node, pdf_annot_node_size);
+ pdf_link_action(tail) := scan_action;
+end
+
+@ @<Implement \.{\\pdfendlink}@>=
+begin
+ check_pdfoutput("\pdfendlink", true);
+ if abs(mode) = vmode then
+ pdf_error("ext1", "\pdfendlink cannot be used in vertical mode");
+ new_whatsit(pdf_end_link_node, small_node_size);
+end
+
+@ @<Declare procedures needed in |do_ext...@>=
+function outline_list_count(p: pointer): integer; {return number of outline
+entries in the same level with |p|}
+var k: integer;
+begin
+ k := 1;
+ while obj_outline_prev(p) <> 0 do begin
+ incr(k);
+ p := obj_outline_prev(p);
+ end;
+ outline_list_count := k;
+end;
+
+@ @<Implement \.{\\pdfoutline}@>=
+begin
+ check_pdfoutput("\pdfoutline", true);
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ r := def_ref;
+ end
+ else
+ r := 0;
+ p := scan_action;
+ if scan_keyword("count") then begin
+ scan_int;
+ i := cur_val;
+ end
+ else
+ i := 0;
+ scan_pdf_ext_toks;
+ q := def_ref;
+ pdf_new_obj(obj_type_others, 0);
+ j := obj_ptr;
+ write_action(p);
+ pdf_end_obj;
+ delete_action_ref(p);
+ pdf_create_obj(obj_type_outline, 0);
+ k := obj_ptr;
+ obj_outline_ptr(k) := pdf_get_mem(pdfmem_outline_size);
+ obj_outline_action_objnum(k) := j;
+ obj_outline_count(k) := i;
+ pdf_new_obj(obj_type_others, 0);
+ pdf_print_str_ln(tokens_to_string(q));
+ flush_str(last_tokens_string);
+ delete_token_ref(q);
+ pdf_end_obj;
+ obj_outline_title(k) := obj_ptr;
+ obj_outline_prev(k) := 0;
+ obj_outline_next(k) := 0;
+ obj_outline_first(k) := 0;
+ obj_outline_last(k) := 0;
+ obj_outline_parent(k) := pdf_parent_outline;
+ obj_outline_attr(k) := r;
+ if pdf_first_outline = 0 then
+ pdf_first_outline := k;
+ if pdf_last_outline = 0 then begin
+ if pdf_parent_outline <> 0 then
+ obj_outline_first(pdf_parent_outline) := k;
+ end
+ else begin
+ obj_outline_next(pdf_last_outline) := k;
+ obj_outline_prev(k) := pdf_last_outline;
+ end;
+ pdf_last_outline := k;
+ if obj_outline_count(k) <> 0 then begin
+ pdf_parent_outline := k;
+ pdf_last_outline := 0;
+ end
+ else if (pdf_parent_outline <> 0) and
+ (outline_list_count(k) = abs(obj_outline_count(pdf_parent_outline))) then
+ begin
+ j := pdf_last_outline;
+ repeat
+ obj_outline_last(pdf_parent_outline) := j;
+ j := pdf_parent_outline;
+ pdf_parent_outline := obj_outline_parent(pdf_parent_outline);
+ until (pdf_parent_outline = 0) or
+ (outline_list_count(j) < abs(obj_outline_count(pdf_parent_outline)));
+ if pdf_parent_outline = 0 then
+ pdf_last_outline := pdf_first_outline
+ else
+ pdf_last_outline := obj_outline_first(pdf_parent_outline);
+ while obj_outline_next(pdf_last_outline) <> 0 do
+ pdf_last_outline := obj_outline_next(pdf_last_outline);
+ end;
+end
+
+@ When a destination is created we need to check whether another destination
+with the same identifier already exists and give a warning if needed.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure warn_dest_dup(id: integer; byname: small_number; s1, s2: str_number);
+begin
+ pdf_warning(s1, "destination with the same identifier (", false);
+ if byname > 0 then begin
+ print("name");
+ print_mark(id);
+ end
+ else begin
+ print("num");
+ print_int(id);
+ end;
+ print(") ");
+ print(s2);
+ print_ln;
+ show_context;
+end;
+
+@ Notice that |scan_keyword| doesn't care if two words have same prefix; so
+we should be careful when scan keywords with same prefix. The main rule: if
+there are two or more keywords with the same prefix, then always test in
+order from the longest one to the shortest one.
+
+@<Implement \.{\\pdfdest}@>=
+begin
+ check_pdfoutput("\pdfdest", true);
+ q := tail;
+ new_whatsit(pdf_dest_node, pdf_dest_node_size);
+ if scan_keyword("num") then begin
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("ext1", "num identifier must be positive");
+ if cur_val > max_halfword then
+ pdf_error("ext1", "number too big");
+ pdf_dest_id(tail) := cur_val;
+ pdf_dest_named_id(tail) := 0;
+ end
+ else if scan_keyword("name") then begin
+ scan_pdf_ext_toks;
+ pdf_dest_id(tail) := def_ref;
+ pdf_dest_named_id(tail) := 1;
+ end
+ else
+ pdf_error("ext1", "identifier type missing");
+ if scan_keyword("xyz") then begin
+ pdf_dest_type(tail) := pdf_dest_xyz;
+ if scan_keyword("zoom") then begin
+ scan_int;
+ if cur_val > max_halfword then
+ pdf_error("ext1", "number too big");
+ pdf_dest_xyz_zoom(tail) := cur_val;
+ end
+ else
+ pdf_dest_xyz_zoom(tail) := null;
+ end
+ else if scan_keyword("fitbh") then
+ pdf_dest_type(tail) := pdf_dest_fitbh
+ else if scan_keyword("fitbv") then
+ pdf_dest_type(tail) := pdf_dest_fitbv
+ else if scan_keyword("fitb") then
+ pdf_dest_type(tail) := pdf_dest_fitb
+ else if scan_keyword("fith") then
+ pdf_dest_type(tail) := pdf_dest_fith
+ else if scan_keyword("fitv") then
+ pdf_dest_type(tail) := pdf_dest_fitv
+ else if scan_keyword("fitr") then
+ pdf_dest_type(tail) := pdf_dest_fitr
+ else if scan_keyword("fit") then
+ pdf_dest_type(tail) := pdf_dest_fit
+ else
+ pdf_error("ext1", "destination type missing");
+ @<Scan an optional space@>;
+ if pdf_dest_type(tail) = pdf_dest_fitr then begin
+ scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
+ pdf_width(tail) := width(alt_rule);
+ pdf_height(tail) := height(alt_rule);
+ pdf_depth(tail) := depth(alt_rule);
+ end;
+ if pdf_dest_named_id(tail) <> 0 then begin
+ i := tokens_to_string(pdf_dest_id(tail));
+ k := find_obj(obj_type_dest, i, true);
+ flush_str(i);
+ end
+ else
+ k := find_obj(obj_type_dest, pdf_dest_id(tail), false);
+ if (k <> 0) and (obj_dest_ptr(k) <> null) then begin
+ warn_dest_dup(pdf_dest_id(tail), pdf_dest_named_id(tail),
+ "ext4", "has been already used, duplicate ignored");
+ flush_node_list(tail);
+ tail := q;
+ link(q) := null;
+ end;
+end
+
+@ @<Declare procedures needed in |do_ext...@>=
+procedure scan_thread_id;
+begin
+ if scan_keyword("num") then begin
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("ext1", "num identifier must be positive");
+ if cur_val > max_halfword then
+ pdf_error("ext1", "number too big");
+ pdf_thread_id(tail) := cur_val;
+ pdf_thread_named_id(tail) := 0;
+ end
+ else if scan_keyword("name") then begin
+ scan_pdf_ext_toks;
+ pdf_thread_id(tail) := def_ref;
+ pdf_thread_named_id(tail) := 1;
+ end
+ else
+ pdf_error("ext1", "identifier type missing");
+end;
+
+@ @<Implement \.{\\pdfthread}@>=
+begin
+ check_pdfoutput("\pdfthread", true);
+ new_annot_whatsit(pdf_thread_node, pdf_thread_node_size);
+ scan_thread_id;
+end
+
+@ @<Implement \.{\\pdfstartthread}@>=
+begin
+ check_pdfoutput("\pdfstartthread", true);
+ new_annot_whatsit(pdf_start_thread_node, pdf_thread_node_size);
+ scan_thread_id;
+end
+
+@ @<Implement \.{\\pdfendthread}@>=
+begin
+ check_pdfoutput("\pdfendthread", true);
+ new_whatsit(pdf_end_thread_node, small_node_size);
+end
+
+@ @<Glob...@>=
+@!pdf_last_x_pos: integer;
+@!pdf_last_y_pos: integer;
+
+@ @<Implement \.{\\pdfsavepos}@>=
+begin
+ check_pdfoutput("\pdfsavepos", true);
+ new_whatsit(pdf_save_pos_node, small_node_size);
+end
+
+@ To implement primitives as \.{\\pdfinfo}, \.{\\pdfcatalog} or
+\.{\\pdfnames} we need to concatenate tokens lists.
+
+@<Declare procedures needed in |do_ext...@>=
+function concat_tokens(q, r: pointer): pointer; {concat |q| and |r| and
+returns the result tokens list}
+var p: pointer;
+begin
+ if q = null then begin
+ concat_tokens := r;
+ return;
+ end;
+ p := q;
+ while link(p) <> null do
+ p := link(p);
+ link(p) := link(r);
+ free_avail(r);
+ concat_tokens := q;
+end;
+
+@ @<Implement \.{\\pdfinfo}@>=
+begin
+ check_pdfoutput("\pdfinfo", false);
+ scan_pdf_ext_toks;
+ if pdf_output > 0 then
+ pdf_info_toks := concat_tokens(pdf_info_toks, def_ref);
+end
+
+@ @<Implement \.{\\pdfcatalog}@>=
+begin
+ check_pdfoutput("\pdfcatalog", false);
+ scan_pdf_ext_toks;
+ if pdf_output > 0 then
+ pdf_catalog_toks := concat_tokens(pdf_catalog_toks, def_ref);
+ if scan_keyword("openaction") then
+ if pdf_catalog_openaction <> 0 then
+ pdf_error("ext1", "duplicate of openaction")
+ else begin
+ p := scan_action;
+ pdf_new_obj(obj_type_others, 0);
+ if pdf_output > 0 then
+ pdf_catalog_openaction := obj_ptr;
+ write_action(p);
+ pdf_end_obj;
+ delete_action_ref(p);
+ end;
+end
+
+@ @<Implement \.{\\pdfnames}@>=
+begin
+ check_pdfoutput("\pdfnames", true);
+ scan_pdf_ext_toks;
+ pdf_names_toks := concat_tokens(pdf_names_toks, def_ref);
+end
+
+@ @<Implement \.{\\pdftrailer}@>=
+begin
+ check_pdfoutput("\pdftrailer", false);
+ scan_pdf_ext_toks;
+ if pdf_output > 0 then
+ pdf_trailer_toks := concat_tokens(pdf_trailer_toks, def_ref);
+end
+
+@ @<Implement \.{\\pdfescapestring}@>=
+begin
+ scan_pdf_ext_toks;
+ escapestr(tokens_to_string(def_ref));
+ flush_str(last_tokens_string);
+ delete_token_ref(def_ref);
+end
+
+@ @<Implement \.{\\pdfescapename}@>=
+begin
+ scan_pdf_ext_toks;
+ escapename(tokens_to_string(def_ref));
+ flush_str(last_tokens_string);
+ delete_token_ref(def_ref);
+end
+
+@ @<Glob...@>=
+@!pdf_retval: integer; {global multi-purpose return value}
+
+@ @<Implement \.{\\pdfstrcmp}@>=
+compare_strings
+
+@ @<Set initial values of key variables@>=
+ seconds_and_micros(epochseconds,microseconds);
+
+@ @<Implement \.{\\pdfresettimer}@>=
+begin
+ seconds_and_micros(epochseconds,microseconds);
+end
+
+
+@ The following subroutines are about PDF-specific font issues.
+
+@<Declare procedures needed in |do_ext...@>=
+procedure pdf_include_chars;
+var s: str_number;
+ k: pool_pointer; {running indices}
+ f: internal_font_number;
+begin
+ scan_font_ident;
+ f := cur_val;
+ if f = null_font then
+ pdf_error("font", "invalid font identifier");
+ pdf_check_vf(f);
+ if not font_used[f] then
+ pdf_init_font(f);
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ k := str_start[s];
+ while k < str_start[s + 1] do begin
+ pdf_mark_char(f, str_pool[k]);
+ incr(k);
+ end;
+ flush_str(s);
+end;
+
+
+@ @<Implement \.{\\pdfincludechars}@>=
+begin
+ check_pdfoutput("\pdfincludechars", true);
+ pdf_include_chars;
+end
+
+@ @<Implement \.{\\pdffontattr}@>=
+begin
+ check_pdfoutput("\pdffontattr", true);
+ scan_font_ident;
+ k := cur_val;
+ if k = null_font then
+ pdf_error("font", "invalid font identifier");
+ scan_pdf_ext_toks;
+ pdf_font_attr[k] := tokens_to_string(def_ref);
+end
+
+@ @<Implement \.{\\pdfmapfile}@>=
+begin
+ check_pdfoutput("\pdfmapfile", true);
+ scan_pdf_ext_toks;
+ pdfmapfile(def_ref);
+ delete_token_ref(def_ref);
+end
+
+@ @<Implement \.{\\pdfmapline}@>=
+begin
+ check_pdfoutput("\pdfmapline", true);
+ scan_pdf_ext_toks;
+ pdfmapline(def_ref);
+ delete_token_ref(def_ref);
+end
+
+@ The following function are needed for outputing article thread.
+
+@<Declare procedures needed in |do_ext...@>=
+procedure thread_title(thread: integer);
+begin
+ pdf_print("/Title (");
+ if obj_info(thread) < 0 then
+ pdf_print(-obj_info(thread))
+ else
+ pdf_print_int(obj_info(thread));
+ pdf_print_ln(")");
+end;
+
+procedure pdf_fix_thread(thread: integer);
+var a: pointer;
+begin
+ pdf_warning("thread", "destination ", false);
+ if obj_info(thread) < 0 then begin
+ print("name{");
+ print(-obj_info(thread));
+ print("}");
+ end
+ else begin
+ print("num");
+ print_int(obj_info(thread));
+ end;
+ print(" has been referenced but does not exist, replaced by a fixed one");
+ print_ln; print_ln;
+ pdf_new_dict(obj_type_others, 0);
+ a := obj_ptr;
+ pdf_indirect_ln("T", thread);
+ pdf_indirect_ln("V", a);
+ pdf_indirect_ln("N", a);
+ pdf_indirect_ln("P", head_tab[obj_type_page]);
+ pdf_print("/R [0 0 ");
+ pdf_print_bp(pdf_page_width); pdf_out(" ");
+ pdf_print_bp(pdf_page_height);
+ pdf_print_ln("]");
+ pdf_end_dict;
+ pdf_begin_dict(thread);
+ pdf_print_ln("/I << ");
+ thread_title(thread);
+ pdf_print_ln(">>");
+ pdf_indirect_ln("F", a);
+ pdf_end_dict;
+end;
+
+procedure out_thread(thread: integer);
+var a, b, c: pointer;
+ last_attr: integer;
+begin
+ if obj_thread_first(thread) = 0 then begin
+ pdf_fix_thread(thread);
+ return;
+ end;
+ pdf_begin_dict(thread);
+ a := obj_thread_first(thread);
+ b := a;
+ last_attr := 0;
+ repeat
+ if obj_bead_attr(a) <> 0 then
+ last_attr := obj_bead_attr(a);
+ a := obj_bead_next(a);
+ until a = b;
+ if last_attr <> 0 then
+ pdf_print_ln(last_attr)
+ else begin
+ pdf_print_ln("/I << ");
+ thread_title(thread);
+ pdf_print_ln(">>");
+ end;
+ pdf_indirect_ln("F", a);
+ pdf_end_dict;
+ repeat
+ pdf_begin_dict(a);
+ if a = b then
+ pdf_indirect_ln("T", thread);
+ pdf_indirect_ln("V", obj_bead_prev(a));
+ pdf_indirect_ln("N", obj_bead_next(a));
+ pdf_indirect_ln("P", obj_bead_page(a));
+ pdf_indirect_ln("R", obj_bead_rect(a));
+ pdf_end_dict;
+ a := obj_bead_next(a);
+ until a = b;
+end;
+
+@ @<Display <rule spec> for whatsit node created by \pdfTeX@>=
+print("(");
+print_rule_dimen(pdf_height(p));
+print_char("+");
+print_rule_dimen(pdf_depth(p));
+print(")x");
+print_rule_dimen(pdf_width(p))
+@z
+
+@x [1356]
+othercases print("whatsit?")
+@y
+pdf_literal_node: begin
+ print_esc("pdfliteral");
+ case pdf_literal_mode(p) of
+ reset_origin:
+ do_nothing;
+ direct_page:
+ print(" page");
+ direct_always:
+ print(" direct");
+ othercases confusion("literal2")
+ endcases;
+ print_mark(pdf_literal_data(p));
+end;
+pdf_refobj_node: begin
+ print_esc("pdfrefobj");
+ if obj_obj_is_stream(pdf_obj_objnum(p)) > 0 then begin
+ if obj_obj_stream_attr(pdf_obj_objnum(p)) <> null then begin
+ print(" attr");
+ print_mark(obj_obj_stream_attr(pdf_obj_objnum(p)));
+ end;
+ print(" stream");
+ end;
+ if obj_obj_is_file(pdf_obj_objnum(p)) > 0 then
+ print(" file");
+ print_mark(obj_obj_data(pdf_obj_objnum(p)));
+end;
+pdf_refxform_node: begin
+ print_esc("pdfrefxform");
+ print("(");
+ print_scaled(obj_xform_height(pdf_xform_objnum(p)));
+ print_char("+");
+ print_scaled(obj_xform_depth(pdf_xform_objnum(p)));
+ print(")x");
+ print_scaled(obj_xform_width(pdf_xform_objnum(p)));
+end;
+pdf_refximage_node: begin
+ print_esc("pdfrefximage");
+ print("(");
+ print_scaled(obj_ximage_height(pdf_ximage_objnum(p)));
+ print_char("+");
+ print_scaled(obj_ximage_depth(pdf_ximage_objnum(p)));
+ print(")x");
+ print_scaled(obj_ximage_width(pdf_ximage_objnum(p)));
+end;
+pdf_annot_node: begin
+ print_esc("pdfannot");
+ @<Display <rule spec> for whatsit node created by \pdfTeX@>;
+ print_mark(pdf_annot_data(p));
+end;
+pdf_start_link_node: begin
+ print_esc("pdflink");
+ @<Display <rule spec> for whatsit node created by \pdfTeX@>;
+ if pdf_link_attr(p) <> null then begin
+ print(" attr");
+ print_mark(pdf_link_attr(p));
+ end;
+ print(" action");
+ if pdf_action_type(pdf_link_action(p)) = pdf_action_user then begin
+ print(" user");
+ print_mark(pdf_action_user_tokens(pdf_link_action(p)));
+ return;
+ end;
+ if pdf_action_file(pdf_link_action(p)) <> null then begin
+ print(" file");
+ print_mark(pdf_action_file(pdf_link_action(p)));
+ end;
+ case pdf_action_type(pdf_link_action(p)) of
+ pdf_action_goto: begin
+ if pdf_action_named_id(pdf_link_action(p)) > 0 then begin
+ print(" goto name");
+ print_mark(pdf_action_id(pdf_link_action(p)));
+ end
+ else begin
+ print(" goto num");
+ print_int(pdf_action_id(pdf_link_action(p)))
+ end;
+ end;
+ pdf_action_page: begin
+ print(" page");
+ print_int(pdf_action_id(pdf_link_action(p)));
+ print_mark(pdf_action_page_tokens(pdf_link_action(p)));
+ end;
+ pdf_action_thread: begin
+ if pdf_action_named_id(pdf_link_action(p)) > 0 then begin
+ print(" thread name");
+ print_mark(pdf_action_id(pdf_link_action(p)));
+ end
+ else begin
+ print(" thread num");
+ print_int(pdf_action_id(pdf_link_action(p)));
+ end;
+ end;
+ othercases pdf_error("displaying", "unknown action type");
+ endcases;
+end;
+pdf_end_link_node: print_esc("pdfendlink");
+pdf_dest_node: begin
+ print_esc("pdfdest");
+ if pdf_dest_named_id(p) > 0 then begin
+ print(" name");
+ print_mark(pdf_dest_id(p));
+ end
+ else begin
+ print(" num");
+ print_int(pdf_dest_id(p));
+ end;
+ print(" ");
+ case pdf_dest_type(p) of
+ pdf_dest_xyz: begin
+ print("xyz");
+ if pdf_dest_xyz_zoom(p) <> null then begin
+ print(" zoom");
+ print_int(pdf_dest_xyz_zoom(p));
+ end;
+ end;
+ pdf_dest_fitbh: print("fitbh");
+ pdf_dest_fitbv: print("fitbv");
+ pdf_dest_fitb: print("fitb");
+ pdf_dest_fith: print("fith");
+ pdf_dest_fitv: print("fitv");
+ pdf_dest_fitr: begin
+ print("fitr");
+ @<Display <rule spec> for whatsit node created by \pdfTeX@>;
+ end;
+ pdf_dest_fit: print("fit");
+ othercases print("unknown!");
+ endcases;
+end;
+pdf_thread_node,
+pdf_start_thread_node: begin
+ if subtype(p) = pdf_thread_node then
+ print_esc("pdfthread")
+ else
+ print_esc("pdfstartthread");
+ print("("); print_rule_dimen(pdf_height(p)); print_char("+");
+ print_rule_dimen(pdf_depth(p)); print(")x");
+ print_rule_dimen(pdf_width(p));
+ if pdf_thread_attr(p) <> null then begin
+ print(" attr");
+ print_mark(pdf_thread_attr(p));
+ end;
+ if pdf_thread_named_id(p) > 0 then begin
+ print(" name");
+ print_mark(pdf_thread_id(p));
+ end
+ else begin
+ print(" num");
+ print_int(pdf_thread_id(p));
+ end;
+end;
+pdf_end_thread_node: print_esc("pdfendthread");
+pdf_save_pos_node: print_esc("pdfsavepos");
+othercases print("whatsit?")
+@z
+
+@x [1357]
+othercases confusion("ext2")
+@y
+pdf_literal_node: begin
+ r := get_node(write_node_size);
+ add_token_ref(pdf_literal_data(p));
+ words := write_node_size;
+end;
+pdf_refobj_node: begin
+ r := get_node(pdf_refobj_node_size);
+ words := pdf_refobj_node_size;
+end;
+pdf_refxform_node: begin
+ r := get_node(pdf_refxform_node_size);
+ words := pdf_refxform_node_size;
+end;
+pdf_refximage_node: begin
+ r := get_node(pdf_refximage_node_size);
+ words := pdf_refximage_node_size;
+end;
+pdf_annot_node: begin
+ r := get_node(pdf_annot_node_size);
+ add_token_ref(pdf_annot_data(p));
+ words := pdf_annot_node_size;
+end;
+pdf_start_link_node: begin
+ r := get_node(pdf_annot_node_size);
+ pdf_height(r) := pdf_height(p);
+ pdf_depth(r) := pdf_depth(p);
+ pdf_width(r) := pdf_width(p);
+ pdf_link_attr(r) := pdf_link_attr(p);
+ if pdf_link_attr(r) <> null then
+ add_token_ref(pdf_link_attr(r));
+ pdf_link_action(r) := pdf_link_action(p);
+ add_action_ref(pdf_link_action(r));
+end;
+pdf_end_link_node:
+ r := get_node(small_node_size);
+pdf_dest_node: begin
+ r := get_node(pdf_dest_node_size);
+ if pdf_dest_named_id(p) > 0 then
+ add_token_ref(pdf_dest_id(p));
+ words := pdf_dest_node_size;
+end;
+pdf_thread_node,
+pdf_start_thread_node: begin
+ r := get_node(pdf_thread_node_size);
+ if pdf_thread_named_id(p) > 0 then
+ add_token_ref(pdf_thread_id(p));
+ if pdf_thread_attr(p) <> null then
+ add_token_ref(pdf_thread_attr(p));
+ words := pdf_thread_node_size;
+end;
+pdf_end_thread_node:
+ r := get_node(small_node_size);
+pdf_save_pos_node:
+ r := get_node(small_node_size);
+othercases confusion("ext2")
+@z
+
+@x [1358]
+othercases confusion("ext3")
+@y
+pdf_literal_node: begin
+ delete_token_ref(pdf_literal_data(p));
+ free_node(p, write_node_size);
+end;
+pdf_refobj_node:
+ free_node(p, pdf_refobj_node_size);
+pdf_refxform_node:
+ free_node(p, pdf_refxform_node_size);
+pdf_refximage_node:
+ free_node(p, pdf_refximage_node_size);
+pdf_annot_node: begin
+ delete_token_ref(pdf_annot_data(p));
+ free_node(p, pdf_annot_node_size);
+end;
+pdf_start_link_node: begin
+ if pdf_link_attr(p) <> null then
+ delete_token_ref(pdf_link_attr(p));
+ delete_action_ref(pdf_link_action(p));
+ free_node(p, pdf_annot_node_size);
+end;
+pdf_end_link_node:
+ free_node(p, small_node_size);
+pdf_dest_node: begin
+ if pdf_dest_named_id(p) > 0 then
+ delete_token_ref(pdf_dest_id(p));
+ free_node(p, pdf_dest_node_size);
+end;
+pdf_thread_node,
+pdf_start_thread_node: begin
+ if pdf_thread_named_id(p) > 0 then
+ delete_token_ref(pdf_thread_id(p));
+ if pdf_thread_attr(p) <> null then
+ delete_token_ref(pdf_thread_attr(p));
+ free_node(p, pdf_thread_node_size);
+end;
+pdf_end_thread_node:
+ free_node(p, small_node_size);
+pdf_save_pos_node:
+ free_node(p, small_node_size);
+othercases confusion("ext3")
+@z
+
+@x [1359]
+@ @<Incorporate a whatsit node into a vbox@>=do_nothing
+@y
+@ @<Incorporate a whatsit node into a vbox@>=
+if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+begin x:=x+d+pdf_height(p); d:=pdf_depth(p);
+s:=0;
+if pdf_width(p)+s>w then w:=pdf_width(p)+s;
+end
+@z
+
+@x [1360]
+@ @<Incorporate a whatsit node into an hbox@>=do_nothing
+@y
+@ @<Incorporate a whatsit node into an hbox@>=
+if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+begin x:=x+pdf_width(p);
+s:=0;
+if pdf_height(p)-s>h then h:=pdf_height(p)-s;
+if pdf_depth(p)+s>d then d:=pdf_depth(p)+s;
+end
+@z
+
+@x [1361]
+@ @<Let |d| be the width of the whatsit |p|@>=d:=0
+@y
+@ @<Let |d| be the width of the whatsit |p|@>=
+if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+ d := pdf_width(p)
+else
+ d := 0
+@z
+
+@x [1362]
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p)
+@y
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+begin
+adv_past(cur_p);
+if (subtype(cur_p) = pdf_refxform_node) or (subtype(cur_p) = pdf_refximage_node) then
+ act_width:=act_width+pdf_width(cur_p);
+end
+@z
+
+@x [1364]
+@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
+goto contribute
+@y
+@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
+begin
+ if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+ begin page_total:=page_total+page_depth+pdf_height(p);
+ page_depth:=pdf_depth(p);
+ end;
+ goto contribute;
+end
+@z
+
+@x [1365]
+@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
+goto not_found
+@y
+@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
+begin
+ if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+ begin cur_height:=cur_height+prev_dp+pdf_height(p); prev_dp:=pdf_depth(p);
+ end;
+ goto not_found;
+end
+@z
+
+@x [1375]
+@<Implement \.{\\immediate}@>=
+begin get_x_token;
+if (cur_cmd=extension)and(cur_chr<=close_node) then
+ begin p:=tail; do_extension; {append a whatsit node}
+ out_what(tail); {do the action immediately}
+ flush_node_list(tail); tail:=p; link(p):=null;
+ end
+else back_input;
+end
+@y
+@<Implement \.{\\immediate}@>=
+begin get_x_token;
+if cur_cmd=extension then begin
+ if cur_chr<=close_node then
+ begin p:=tail; do_extension; {append a whatsit node}
+ out_what(tail); {do the action immediately}
+ flush_node_list(tail); tail:=p; link(p):=null;
+ end
+ else case cur_chr of
+ pdf_obj_code: begin
+ do_extension; {scan object and set |pdf_last_obj|}
+ if obj_data_ptr(pdf_last_obj) = 0 then {this object has not been initialized yet}
+ pdf_error("ext1", "`\pdfobj reserveobjnum' cannot be used with \immediate");
+ pdf_write_obj(pdf_last_obj);
+ end;
+ pdf_xform_code: begin
+ do_extension; {scan form and set |pdf_last_xform|}
+ pdf_cur_form := pdf_last_xform;
+ pdf_ship_out(obj_xform_box(pdf_last_xform), false);
+ end;
+ pdf_ximage_code: begin
+ do_extension; {scan image and set |pdf_last_ximage|}
+ pdf_write_image(pdf_last_ximage);
+ end;
+ othercases back_input
+ endcases;
+end
+else
+ back_input;
+end
+@z
+
+@x [1378]
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+@y
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+
+@ Shipping out PDF marks.
+
+@<Types...@>=
+dest_name_entry = record
+ objname: str_number; {destination name}
+ objnum: integer; {destination object number}
+end;
+
+@ @<Glob...@>=
+@!cur_page_width: scaled; {width of page being shipped}
+@!cur_page_height: scaled; {height of page being shipped}
+@!cur_h_offset: scaled; {horizontal offset of page being shipped}
+@!cur_v_offset: scaled; {vertical offset of page being shipped}
+@!pdf_obj_list: pointer; {list of objects in the current page}
+@!pdf_xform_list: pointer; {list of forms in the current page}
+@!pdf_ximage_list: pointer; {list of images in the current page}
+@!pdf_link_level: integer; {depth of nesting of box containing link annotation}
+@!last_link: pointer; {pointer to the last link annotation}
+@!pdf_link_ht, pdf_link_dp, pdf_link_wd: scaled; {dimensions of the last link
+annotation}
+@!last_thread: pointer; {pointer to the last thread}
+@!pdf_thread_ht, pdf_thread_dp, pdf_thread_wd: scaled; {dimensions of the last
+thread}
+@!pdf_last_thread_id: halfword; {identifier of the last thread}
+@!pdf_last_thread_named_id: boolean; {is identifier of the last thread named}
+@!pdf_thread_level: integer; {depth of nesting of box containing the last thread}
+@!pdf_annot_list: pointer; {list of annotations in the current page}
+@!pdf_link_list: pointer; {list of link annotations in the current page}
+@!pdf_dest_list: pointer; {list of destinations in the current page}
+@!pdf_bead_list: pointer; {list of thread beads in the current page}
+@!pdf_obj_count: integer; {counter of objects}
+@!pdf_xform_count: integer; {counter of forms}
+@!pdf_ximage_count: integer; {counter of images}
+@!pdf_cur_form: integer; {the form being output}
+@!pdf_first_outline, pdf_last_outline, pdf_parent_outline: integer;
+@!pdf_xform_width,
+@!pdf_xform_height,
+@!pdf_xform_depth: scaled; {dimension of the current form}
+@!pdf_info_toks: pointer; {additional keys of Info dictionary}
+@!pdf_catalog_toks: pointer; {additional keys of Catalog dictionary}
+@!pdf_catalog_openaction: integer;
+@!pdf_names_toks: pointer; {additional keys of Names dictionary}
+@!pdf_dest_names_ptr: integer; {first unused position in |dest_names|}
+@!dest_names_size: integer; {maximum number of names in name tree of PDF output file}
+@!dest_names: ^dest_name_entry;
+@!image_orig_x, image_orig_y: integer; {origin of cropped pdf images}
+@!link_level_stack: pointer; {stack to save |pdf_link_level|}
+@!pdf_trailer_toks: pointer; {additional keys of Trailer dictionary}
+
+@ @<Set init...@>=
+pdf_link_level := -1;
+link_level_stack := null;
+pdf_first_outline:= 0;
+pdf_last_outline:= 0;
+pdf_parent_outline:= 0;
+pdf_obj_count := 0;
+pdf_xform_count := 0;
+pdf_ximage_count := 0;
+pdf_dest_names_ptr := 0;
+pdf_info_toks := null;
+pdf_catalog_toks := null;
+pdf_names_toks := null;
+pdf_catalog_openaction := 0;
+pdf_trailer_toks := null;
+
+@ The following procedures are needed for outputing whatsit nodes for
+pdfTeX.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure write_action(p: pointer); {write an action specification}
+var s: str_number;
+ d: integer;
+begin
+ if pdf_action_type(p) = pdf_action_user then begin
+ pdf_print_toks_ln(pdf_action_user_tokens(p));
+ return;
+ end;
+ pdf_print("<< ");
+ if pdf_action_file(p) <> null then begin
+ pdf_print("/F ");
+ s := tokens_to_string(pdf_action_file(p));
+ if (str_pool[str_start[s]] = 40) and
+ (str_pool[str_start[s] + length(s) - 1] = 41) then
+ pdf_print(s)
+ else begin
+ pdf_print_str(s);
+ end;
+ flush_str(s);
+ pdf_print(" ");
+ if pdf_action_new_window(p) > 0 then begin
+ pdf_print("/NewWindow ");
+ if pdf_action_new_window(p) = 1 then
+ pdf_print("true ")
+ else
+ pdf_print("false ");
+ end;
+ end;
+ case pdf_action_type(p) of
+ pdf_action_page: begin
+ if pdf_action_file(p) = null then begin
+ pdf_print("/S /GoTo /D [");
+ pdf_print_int(get_obj(obj_type_page, pdf_action_id(p), false));
+ pdf_print(" 0 R");
+ end
+ else begin
+ pdf_print("/S /GoToR /D [");
+ pdf_print_int(pdf_action_id(p) - 1);
+ end;
+ pdf_out(" ");
+ pdf_print(tokens_to_string(pdf_action_page_tokens(p)));
+ flush_str(last_tokens_string);
+ pdf_out("]");
+ end;
+ pdf_action_goto: begin
+ if pdf_action_file(p) = null then begin
+ pdf_print("/S /GoTo ");
+ d := get_obj(obj_type_dest, pdf_action_id(p),
+ pdf_action_named_id(p));
+ end
+ else
+ pdf_print("/S /GoToR ");
+ if pdf_action_named_id(p) > 0 then begin
+ pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
+ flush_str(last_tokens_string);
+ end
+ else if pdf_action_file(p) = null then
+ pdf_indirect("D", d)
+ else
+ pdf_error("ext4", "`goto' option cannot be used with both `file' and `num'");
+ end;
+ pdf_action_thread: begin
+ pdf_print("/S /Thread ");
+ if pdf_action_file(p) = null then
+ d := get_obj(obj_type_thread, pdf_action_id(p),
+ pdf_action_named_id(p));
+ if pdf_action_named_id(p) > 0 then begin
+ pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
+ flush_str(last_tokens_string);
+ end
+ else if pdf_action_file(p) = null then
+ pdf_indirect("D", d)
+ else
+ pdf_int_entry("D", pdf_action_id(p));
+ end;
+ endcases;
+ pdf_print_ln(" >>");
+end;
+
+procedure set_rect_dimens(p, parent_box: pointer; x, y, w, h, d, margin: scaled);
+begin
+ pdf_left(p) := cur_h;
+ if is_running(w) then
+ pdf_right(p) := x + width(parent_box)
+ else
+ pdf_right(p) := cur_h + w;
+ if is_running(h) then
+ pdf_top(p) := y - height(parent_box)
+ else
+ pdf_top(p) := cur_v - h;
+ if is_running(d) then
+ pdf_bottom(p) := y + depth(parent_box)
+ else
+ pdf_bottom(p) := cur_v + d;
+ pdf_left(p) := pdf_left(p) - margin;
+ pdf_top(p) := pdf_top(p) - margin;
+ pdf_right(p) := pdf_right(p) + margin;
+ pdf_bottom(p) := pdf_bottom(p) + margin;
+end;
+
+procedure do_annot(p, parent_box: pointer; x, y: scaled);
+begin
+ if not is_shipping_page then
+ pdf_error("ext4", "annotations cannot be inside an XForm");
+ if doing_leaders then
+ return;
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_width(p), pdf_height(p), pdf_depth(p), 0);
+ obj_annot_ptr(pdf_annot_objnum(p)) := p;
+ pdf_append_list(pdf_annot_objnum(p))(pdf_annot_list);
+end;
+
+@ To implement nesting link annotations, we need a stack to save box testing
+level of each link that has been broken. Each stack entry holds the
+box nesting level and pointer the whatsit node created for
+corresponding \.{\\pdfstartlink}.
+
+@d link_level(#) == info(#)
+@d link_ptr(#) == info(# + 1)
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure save_link_level(l: pointer);
+var p, r: pointer;
+begin
+ pdf_link_level := cur_s;
+ r := copy_node_list(l);
+ pdf_link_wd := pdf_width(r);
+ pdf_link_ht := pdf_height(r);
+ pdf_link_dp := pdf_depth(r);
+ p := get_node(small_node_size);
+ link_level(p) := pdf_link_level;
+ link_ptr(p) := r;
+ link(p) := link_level_stack;
+ link_level_stack := p;
+end;
+
+procedure do_link(p, parent_box: pointer; x, y: scaled);
+begin
+ if not is_shipping_page then
+ pdf_error("ext4", "link annotations cannot be inside an XForm");
+ if type(parent_box) <> hlist_node then
+ pdf_error("ext4", "link annotations can be inside hbox only");
+ save_link_level(p);
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_link_wd, pdf_link_ht, pdf_link_dp, pdf_link_margin);
+ last_link := p;
+ pdf_create_obj(obj_type_others, 0);
+ obj_annot_ptr(obj_ptr) := p;
+ pdf_append_list(obj_ptr)(pdf_link_list);
+end;
+
+procedure restore_link_level;
+var p, r: pointer;
+begin
+ if link_level_stack = null then
+ pdf_error("ext4", "invalid stack of link nesting level");
+ p := link_level_stack;
+ link_level_stack := link(p);
+ r := link_ptr(p);
+ flush_node_list(r);
+ free_node(p, small_node_size);
+ p := link_level_stack;
+ if p = null then
+ pdf_link_level := -1
+ else begin
+ pdf_link_level := link_level(p);
+ r := link_ptr(p);
+ pdf_link_wd := pdf_width(r);
+ pdf_link_ht := pdf_height(r);
+ pdf_link_dp := pdf_depth(r);
+ end;
+end;
+
+procedure end_link;
+begin
+ if pdf_link_level <> cur_s then
+ pdf_error("ext4", "\pdfendlink ended up in different nesting level than \pdfstartlink");
+ if is_running(pdf_link_wd) and (last_link <> null) then
+ pdf_right(last_link) := cur_h + pdf_link_margin;
+ restore_link_level;
+ last_link := null;
+end;
+
+@ For ``running'' annotations we must append a new node when the end of
+annotation is in other box than its start. The new created node is identical to
+corresponding whatsit node representing the start of annotation, but its
+|info| field is |null|. We set |info| field just before destroying the node, in
+order to use |flush_node_list| to do the job.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure append_link(parent_box: pointer; x, y: scaled); {append a new
+|pdf_start_link_node| to |pdf_link_list| and update |last_link|}
+var p, r: integer;
+begin
+ if type(parent_box) <> hlist_node then
+ pdf_error("ext4", "link annotations can be inside hbox only");
+ r := copy_node_list(link_ptr(link_level_stack)); {copy link node to |r|}
+ info(r) := max_halfword; {mark that this node is not a whatsit node}
+ link(r) := null; {this node will be destroyed separately}
+ set_rect_dimens(r, parent_box, x, y,
+ pdf_link_wd, pdf_link_ht, pdf_link_dp, pdf_link_margin);
+ pdf_create_obj(obj_type_others, 0);
+ obj_annot_ptr(obj_ptr) := r;
+ last_link := r;
+ pdf_append_list(obj_ptr)(pdf_link_list);
+end;
+
+@ Threads are handled in similar way as link annotations.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure append_bead(p: pointer);
+var a, b, c, t: integer;
+begin
+ if not is_shipping_page then
+ pdf_error("ext4", "threads cannot be inside an XForm");
+ t := get_obj(obj_type_thread, pdf_thread_id(p), pdf_thread_named_id(p));
+ b := pdf_new_objnum;
+ obj_bead_ptr(b) := pdf_get_mem(pdfmem_bead_size);
+ obj_bead_page(b) := pdf_last_page;
+ obj_bead_data(b) := p;
+ if pdf_thread_attr(p) <> null then
+ obj_bead_attr(b) := tokens_to_string(pdf_thread_attr(p))
+ else
+ obj_bead_attr(b) := 0;
+ if obj_thread_first(t) = 0 then begin
+ obj_thread_first(t) := b;
+ obj_bead_next(b) := b;
+ obj_bead_prev(b) := b;
+ end
+ else begin
+ a := obj_thread_first(t);
+ c := obj_bead_prev(a);
+ obj_bead_prev(b) := c;
+ obj_bead_next(b) := a;
+ obj_bead_prev(a) := b;
+ obj_bead_next(c) := b;
+ end;
+ pdf_append_list(b)(pdf_bead_list);
+end;
+
+procedure do_thread(p, parent_box: pointer; x, y: scaled);
+begin
+ if doing_leaders then
+ return;
+ if subtype(p) = pdf_start_thread_node then begin
+ pdf_thread_wd := pdf_width(p);
+ pdf_thread_ht := pdf_height(p);
+ pdf_thread_dp := pdf_depth(p);
+ pdf_last_thread_id := pdf_thread_id(p);
+ pdf_last_thread_named_id := (pdf_thread_named_id(p) > 0);
+ if pdf_last_thread_named_id then
+ add_token_ref(pdf_thread_id(p));
+ pdf_thread_level := cur_s;
+ end;
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_width(p), pdf_height(p), pdf_depth(p),
+ pdf_thread_margin);
+ append_bead(p);
+ last_thread := p;
+end;
+
+procedure append_thread(parent_box: pointer; x, y: scaled);
+var p: pointer;
+begin
+ p := get_node(pdf_thread_node_size);
+ info(p) := max_halfword; {this is not a whatsit node}
+ link(p) := null; {this node will be destroyed separately}
+ pdf_width(p) := pdf_thread_wd;
+ pdf_height(p) := pdf_thread_ht;
+ pdf_depth(p) := pdf_thread_dp;
+ pdf_thread_attr(p) := null;
+ pdf_thread_id(p) := pdf_last_thread_id;
+ if pdf_last_thread_named_id then begin
+ add_token_ref(pdf_thread_id(p));
+ pdf_thread_named_id(p) := 1;
+ end
+ else
+ pdf_thread_named_id(p) := 0;
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_width(p), pdf_height(p), pdf_depth(p),
+ pdf_thread_margin);
+ append_bead(p);
+ last_thread := p;
+end;
+
+procedure end_thread;
+begin
+ if pdf_thread_level <> cur_s then
+ pdf_error("ext4", "\pdfendthread ended up in different nesting level than \pdfstartthread");
+ if is_running(pdf_thread_dp) and (last_thread <> null) then
+ pdf_bottom(last_thread) := cur_v + pdf_thread_margin;
+ if pdf_last_thread_named_id then
+ delete_token_ref(pdf_last_thread_id);
+ last_thread := null;
+end;
+
+function open_subentries(p: pointer): integer;
+var k, c: integer;
+ l, r: integer;
+begin
+ k := 0;
+ if obj_outline_first(p) <> 0 then begin
+ l := obj_outline_first(p);
+ repeat
+ incr(k);
+ c := open_subentries(l);
+ if obj_outline_count(l) > 0 then
+ k := k + c;
+ obj_outline_parent(l) := p;
+ r := obj_outline_next(l);
+ if r = 0 then
+ obj_outline_last(p) := l;
+ l := r;
+ until l = 0;
+ end;
+ if obj_outline_count(p) > 0 then
+ obj_outline_count(p) := k
+ else
+ obj_outline_count(p) := -k;
+ open_subentries := k;
+end;
+
+procedure do_dest(p, parent_box: pointer; x, y: scaled);
+var k: integer;
+begin
+ if not is_shipping_page then
+ pdf_error("ext4", "destinations cannot be inside an XForm");
+ if doing_leaders then
+ return;
+ k := get_obj(obj_type_dest, pdf_dest_id(p), pdf_dest_named_id(p));
+ if obj_dest_ptr(k) <> null then begin
+ warn_dest_dup(pdf_dest_id(p), pdf_dest_named_id(p),
+ "ext4", "has been already used, duplicate ignored");
+ return;
+ end;
+ obj_dest_ptr(k) := p;
+ pdf_append_list(k)(pdf_dest_list);
+ case pdf_dest_type(p) of
+ pdf_dest_xyz: begin
+ pdf_left(p) := cur_h;
+ pdf_top(p) := cur_v;
+ end;
+ pdf_dest_fith,
+ pdf_dest_fitbh:
+ pdf_top(p) := cur_v;
+ pdf_dest_fitv,
+ pdf_dest_fitbv:
+ pdf_left(p) := cur_h;
+ pdf_dest_fit,
+ pdf_dest_fitb:
+ do_nothing;
+ pdf_dest_fitr:
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_width(p), pdf_height(p), pdf_depth(p),
+ pdf_dest_margin);
+ endcases;
+end;
+
+procedure out_form(p: pointer);
+begin
+ pdf_end_text;
+ pdf_print_ln("q");
+ if pdf_lookup_list(pdf_xform_list, pdf_xform_objnum(p)) = null then
+ pdf_append_list(pdf_xform_objnum(p))(pdf_xform_list);
+ cur_v := cur_v + obj_xform_depth(pdf_xform_objnum(p));
+ pdf_print("1 0 0 1 ");
+ pdf_print_bp(pdf_x(cur_h)); pdf_out(" ");
+ pdf_print_bp(pdf_y(cur_v));
+ pdf_print_ln(" cm");
+ pdf_print("/Fm");
+ pdf_print_int(obj_info(pdf_xform_objnum(p)));
+ pdf_print_resname_prefix;
+ pdf_print_ln(" Do");
+ pdf_print_ln("Q");
+end;
+
+procedure out_image(p: pointer);
+var image: integer;
+begin
+ image := obj_ximage_data(pdf_ximage_objnum(p));
+ pdf_end_text;
+ pdf_print_ln("q");
+ if pdf_lookup_list(pdf_ximage_list, pdf_ximage_objnum(p)) = null then
+ pdf_append_list(pdf_ximage_objnum(p))(pdf_ximage_list);
+ if not is_pdf_image(image) then begin
+ pdf_print_real(ext_xn_over_d(pdf_width(p),
+ ten_pow[6], one_hundred_bp), 4);
+ pdf_print(" 0 0 ");
+ pdf_print_real(ext_xn_over_d(pdf_height(p) + pdf_depth(p),
+ ten_pow[6], one_hundred_bp), 4);
+ pdf_out(" ");
+ pdf_print_bp(pdf_x(cur_h)); pdf_out(" ");
+ pdf_print_bp(pdf_y(cur_v));
+ end
+ else begin
+ pdf_print_real(ext_xn_over_d(pdf_width(p),
+ ten_pow[6], image_width(image)), 6);
+ pdf_print(" 0 0 ");
+ pdf_print_real(ext_xn_over_d(pdf_height(p) + pdf_depth(p),
+ ten_pow[6], image_height(image)), 6);
+ pdf_out(" ");
+ pdf_print_bp(pdf_x(cur_h) -
+ ext_xn_over_d(pdf_width(p), epdf_orig_x(image),
+ image_width(image)));
+ pdf_out(" ");
+ pdf_print_bp(pdf_y(cur_v) -
+ ext_xn_over_d(pdf_height(p), epdf_orig_y(image),
+ image_height(image)));
+ end;
+ pdf_print_ln(" cm");
+ pdf_print("/Im");
+ pdf_print_int(obj_info(pdf_ximage_objnum(p)));
+ pdf_print_resname_prefix;
+ pdf_print_ln(" Do");
+ pdf_print_ln("Q");
+end;
+
+
+@ @<Output the whatsit node |p| in |pdf_vlist_out|@>=
+case subtype(p) of
+pdf_literal_node:
+ pdf_out_literal(p);
+pdf_refobj_node:
+ pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
+pdf_refxform_node:
+ @<Output a Form node in a vlist@>;
+pdf_refximage_node:
+ @<Output a Image node in a vlist@>;
+pdf_annot_node:
+ do_annot(p, this_box, left_edge, top_edge + height(this_box));
+pdf_start_link_node:
+ pdf_error("ext4", "\pdfstartlink ended up in vlist");
+pdf_end_link_node:
+ pdf_error("ext4", "\pdfendlink ended up in vlist");
+pdf_dest_node:
+ do_dest(p, this_box, left_edge, top_edge + height(this_box));
+pdf_thread_node,
+pdf_start_thread_node:
+ do_thread(p, this_box, left_edge, top_edge + height(this_box));
+pdf_end_thread_node:
+ end_thread;
+pdf_save_pos_node:
+ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+special_node:
+ pdf_special(p);
+othercases out_what(p);
+endcases
+
+@ @<Glob...@>=
+@!is_shipping_page: boolean; {set to |shipping_page| when |pdf_ship_out| starts}
+
+@ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>=
+begin
+ pdf_last_x_pos := cur_h;
+ if is_shipping_page then
+ pdf_last_y_pos := cur_page_height - cur_v
+ else
+ pdf_last_y_pos := pdf_xform_height + pdf_xform_depth - cur_v;
+end
+
+@ @<Output a Image node in a vlist@>=
+begin cur_v:=cur_v+pdf_height(p)+pdf_depth(p); save_v:=cur_v;
+ cur_h:=left_edge;
+ out_image(p);
+ cur_v:=save_v; cur_h:=left_edge;
+ end
+
+@ @<Output a Form node in a vlist@>=
+begin cur_v:=cur_v+pdf_height(p); save_v:=cur_v;
+ cur_h:=left_edge;
+ out_form(p);
+ cur_v:=save_v+pdf_depth(p); cur_h:=left_edge;
+ end
+
+@ @<Output the whatsit node |p| in |pdf_hlist_out|@>=
+case subtype(p) of
+pdf_literal_node:
+ pdf_out_literal(p);
+pdf_refobj_node:
+ pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
+pdf_refxform_node:
+ @<Output a Form node in a hlist@>;
+pdf_refximage_node:
+ @<Output a Image node in a hlist@>;
+pdf_annot_node:
+ do_annot(p, this_box, left_edge, base_line);
+pdf_start_link_node:
+ do_link(p, this_box, left_edge, base_line);
+pdf_end_link_node: begin
+ end_link;
+ @<Create link annotation for the current hbox if needed@>;
+end;
+pdf_dest_node:
+ do_dest(p, this_box, left_edge, base_line);
+pdf_thread_node:
+ do_thread(p, this_box, left_edge, base_line);
+pdf_start_thread_node:
+ pdf_error("ext4", "\pdfstartthread ended up in hlist");
+pdf_end_thread_node:
+ pdf_error("ext4", "\pdfendthread ended up in hlist");
+pdf_save_pos_node:
+ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+special_node:
+ pdf_special(p);
+othercases out_what(p);
+endcases
+
+@ @<Output a Image node in a hlist@>=
+begin
+ cur_v:=base_line+pdf_depth(p);
+ edge:=cur_h;
+ out_image(p);
+ cur_h:=edge+pdf_width(p); cur_v:=base_line;
+ end
+
+@ @<Output a Form node in a hlist@>=
+begin
+ cur_v:=base_line;
+ edge:=cur_h;
+ out_form(p);
+ cur_h:=edge+pdf_width(p); cur_v:=base_line;
+ end
+@z
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.defines b/Build/source/texk/web2c/pdftexdir/pdftex.defines
new file mode 100644
index 00000000000..2bd9ef1fefa
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftex.defines
@@ -0,0 +1,105 @@
+{
+Copyright (c) 1996-2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftex.defines#15 $
+}
+
+{ pdftex.defines: additions for pdfTeX }
+
+{ macros from pdftex.h }
+@define function pdfcharmarked();
+@define function getlpcode();
+@define function getrpcode();
+@define function getefcode();
+@define function texbopenin();
+@define function vfbopenin ();
+@define procedure pdfmarkchar();
+@define procedure writepdf();
+
+{ functions from mapfile.c }
+@define function hasfmentry();
+@define function tfmoffm();
+@define procedure checkextfm();
+@define procedure pdfmapfile();
+@define procedure pdfmapline();
+@define procedure pdfinitmapfile();
+
+{ functions from utils.c }
+@define procedure escapehex();
+@define procedure escapename();
+@define procedure escapestring();
+@define function extxnoverd();
+@define procedure getcreationdate;
+@define procedure getfiledump();
+@define procedure getfilemoddate();
+@define procedure getfilesize();
+@define procedure getmatch();
+@define procedure getmd5sum();
+@define function getresnameprefix;
+@define procedure initstarttime;
+@define function isquotebad;
+@define function makecstring();
+@define procedure matchstrings();
+@define procedure libpdffinish;
+@define procedure makepdftexbanner;
+@define procedure printcreationdate;
+@define procedure printID();
+@define procedure setjobid();
+@define procedure unescapehex();
+@define procedure writestreamlength();
+
+
+{ functions from vfpacket.c }
+@define function newvfpacket();
+@define function packetbyte;
+@define procedure startpacket();
+@define procedure storepacket();
+
+{ functions from writefont.c }
+@define procedure dopdffont();
+
+{ functions from writeimg.c }
+@define function checkimageb();
+@define function checkimagec();
+@define function checkimagei();
+@define function epdforigx();
+@define function epdforigy();
+@define function imageheight();
+@define function imagepages();
+@define function imagecolordepth();
+@define function imagewidth();
+@define function imagexres();
+@define function imageyres();
+@define function ispdfimage();
+@define function readimage();
+@define procedure deleteimage();
+@define procedure updateimageprocset();
+@define procedure writeimage();
+
+{ functions from writet3.c }
+@define function getpkcharwidth();
+
+{ functions from writezip.c }
+@define procedure writezip();
+
+{ functions from avlstuff.c }
+@define procedure avlputobj();
+@define function avlfindobj();
+
+{ end of pdftex.defines }
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.h b/Build/source/texk/web2c/pdftexdir/pdftex.h
new file mode 100644
index 00000000000..837d3f5a2e9
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftex.h
@@ -0,0 +1,50 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftex.h#4 $
+*/
+
+/* Additions to texmfmp.h for pdfTeX */
+
+/* mark a char in font */
+#define pdfmarkchar(f, c) pdfcharused[f][c/8] |= (1<<(c%8))
+
+/* test whether a char in font is marked */
+#define pdfcharmarked(f, c) (boolean)(pdfcharused[f][c/8] & (1<<(c%8)))
+
+/* writepdf() always writes by fwrite() */
+#define writepdf(a, b) \
+ (void) fwrite ((char *) &pdfbuf[a], sizeof (pdfbuf[a]), \
+ (int) ((b) - (a) + 1), pdffile)
+
+#define getlpcode(f, c) \
+ (pdffontlpbase[f] == 0 ? 0 : pdfmem[pdffontlpbase[f] + c])
+
+#define getrpcode(f, c) \
+ (pdffontrpbase[f] == 0 ? 0 : pdfmem[pdffontrpbase[f] + c])
+
+#define getefcode(f, c) \
+ (pdffontefbase[f] == 0 ? 1000 : pdfmem[pdffontefbase[f] + c])
+
+#define texbopenin(f) \
+ open_input (&(f), kpse_tex_format, FOPEN_RBIN_MODE)
+#define vfbopenin(f) \
+ open_input (&(f), kpse_vf_format, FOPEN_RBIN_MODE)
+
+#include <pdftexdir/ptexlib.h>
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.mak b/Build/source/texk/web2c/pdftexdir/pdftex.mak
new file mode 100644
index 00000000000..1acfb87c4e9
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftex.mak
@@ -0,0 +1,199 @@
+################################################################################
+#
+# Makefile : pdftex, web2c win32.mak fragment to build pdfTeX
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/03/20 16:40:35 popineau>
+#
+################################################################################
+
+# The libraries are not mentioned. As the matter stands, a change in their
+# number or how they are configured requires changes to the main distribution
+# anyway.
+
+Makefile: pdftexdir\pdftex.mk
+
+pdftex_bin = $(objdir)\pdftex.exe $(objdir)\pdfetex.exe $(objdir)\ttf2afm.exe $(objdir)\pdftosrc.exe
+# pdftex_exe = pdftex.exe pdfetex.exe ttf2afm.exe pdftosrc.exe
+pdftex_pool = pdftex.pool pdfetex.pool
+# linux_build_dir = $(HOME)\pdftex\build\linux\texk\web2c
+
+# We build pdftex
+pdftex = $(objdir)\pdftex.exe
+!ifdef TEX_DLL
+pdftex = $(pdftex) $(objdir)\$(library_prefix)pdftex.dll
+!endif
+
+# The C sources.
+pdftex_c = pdftex.c
+pdftex_o = $(objdir)\pdftex.obj
+
+# Making pdftex
+!ifdef TEX_DLL
+$(objdir)\$(library_prefix)pdftex.exp: $(objdir)\$(library_prefix)pdftex.lib
+
+$(objdir)\$(library_prefix)pdftex.lib: $(pdftex_o)
+ $(archive) /DEF $(pdftex_o)
+
+$(objdir)\$(library_prefix)pdftex.dll: $(pdftex_o) $(objdir)\$(library_prefix)pdftex.exp $(objdir)\pdftex.res $(pdftexlibs) $(kpathsealib) $(proglib)
+ $(link_dll) $(**) $(socketlibs) $(conlibs)
+
+$(objdir)\pdftex.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)pdftex.lib $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+!else
+$(objdir)\pdftex.exe: $(pdftex_o) $(objdir)\win32main.obj $(objdir)\pdftex.res $(pdftexlibs) $(kpathsealib) $(proglib)
+ $(link) $(**) $(socketlibs) $(conlibs)
+!endif
+
+# C file dependencies.
+$(pdftex_c) pdftexcoerce.h pdftexd.h: pdftex.p $(web2c_texmf)
+ $(web2c) pdftex
+
+# Tangling.
+pdftex.p pdftex.pool: .\$(objdir)\tangle.exe pdftex.web pdftex.ch
+ .\$(objdir)\tangle pdftex.web pdftex.ch
+
+# Generation of the web and ch files.
+pdftex.web: $(objdir)\tie.exe \
+ tex.web \
+ pdftexdir/pdftex.ch \
+ pdftexdir/hz.ch \
+ pdftexdir/misc.ch \
+ # pdftexdir\pdftex.mak
+ .\$(objdir)\tie -m pdftex.web tex.web \
+ pdftexdir\pdftex.ch \
+ $(srcdir)/pdftexdir/hz.ch \
+ $(srcdir)/pdftexdir/misc.ch
+
+pdftex.ch: $(objdir)\tie.exe pdftex.web \
+ pdftexdir\tex.ch0 \
+ tex.ch \
+ tex-supp-w32.ch \
+ pdftexdir\tex.ch1 \
+ pdftexdir\tex.pch \
+ pdftexdir\tex.ch2
+# pdftexdir\pdftex.mak
+ .\$(objdir)\tie -c pdftex.ch \
+ pdftex.web \
+ $(srcdir)\pdftexdir\tex.ch0 \
+ tex.ch \
+ tex-supp-w32.ch \
+ $(srcdir)\pdftexdir\tex.ch1 \
+ $(srcdir)\pdftexdir\tex.pch \
+ $(srcdir)\pdftexdir\tex.ch2
+
+# Tests...
+check: pdftex-check
+pdftex-check: pdftex pdftex.fmt
+
+# Cleaning up.
+clean:: pdftex-clean
+pdftex-clean:
+# $(LIBTOOL) --mode=clean $(RM) pdftex
+ -@echo $(verbose) & ( \
+ for %%i in ($(pdftex_o) $(pdftex_c) pdftexextra.c pdftexcoerce.h \
+ pdftexd.h pdftex.p pdftex.pool pdftex.web pdftex.ch \
+ pdftex.fmt pdftex.log) do $(del) %%i $(redir_stderr) \
+ )
+
+# Dumps.
+# all_pdffmts = pdftex.fmt $(pdffmts)
+
+# dumps: pdffmts
+# pdffmts: $(all_pdffmts)
+# pdftex.fmt: $(pdftex)
+# $(dumpenv) $(make) progname=pdftex files="plain.tex cmr10.tfm" prereq-check
+# $(dumpenv) .\$(objdir)\pdftex --progname=pdftex --jobname=pdftex --ini "\pdfoutput=1 \input plain \dump" <nul
+#
+# pdfolatex.fmt: $(pdftex)
+# $(dumpenv) $(make) progname=pdfolatex files="latex.ltx" prereq-check
+# $(dumpenv) .\$(objdir)\pdftex --progname=pdfolatex --jobname=pdfolatex --ini "\pdfoutput=1 \input latex.ltx" <nul
+#
+# pdflatex.fmt: $(pdftex)
+# $(dumpenv) $(make) progname=pdflatex files="latex.ltx" prereq-check
+# $(dumpenv) .\$(objdir)\pdftex --progname=pdflatex --jobname=pdflatex --ini "\pdfoutput=1 \input latex.ltx" <nul
+#
+#
+# Installation.
+install-pdftex: install-pdftex-exec install-pdftex-data
+install-pdftex-exec: install-pdftex-links
+# install-pdftex-data: install-pdftex-dumps
+install-pdftex-dumps: install-pdftex-fmts
+
+# The actual binary executables and pool files.
+install-programs: install-pdftex-programs
+install-pdftex-programs: $(pdftex) $(bindir)
+ -@echo $(verbose) & ( \
+ for %%p in ($(pdftex)) do $(copy) %%p $(bindir) \
+ ) $(redir_stdout)
+
+# install-links: install-pdftex-links
+install-pdftex-links: install-pdftex-programs
+# -@echo $(verbose) & ( \
+# pushd $(bindir) & \
+# $(del) .\pdfinitex.exe .\pdfvirtex.exe & \
+# $(lnexe) .\pdftex.exe $(bindir)\pdfinitex.exe & \
+# $(lnexe) .\pdftex.exe $(bindir)\pdfvirtex.exe & \
+# popd \
+# ) $(redir_stdout)
+ -@echo $(verbose) & ( \
+ if not "$(pdffmts)"=="" \
+ for %%i in ($(pdffmts)) do \
+ pushd $(bindir) & \
+ $(del) .\%%~ni.exe & \
+ $(lnexe) .\pdftex.exe $(bindir)\%%~ni.exe & \
+ popd \
+ ) $(redir_stdout)
+
+# install-fmts: install-pdftex-fmts
+install-pdftex-fmts: pdffmts $(fmtdir)
+ -@echo $(verbose) & ( \
+ for %%f in ($(all_pdffmts)) \
+ do $(copy) %%f $(fmtdir)\%%f \
+ ) $(redir_stdout)
+
+# Auxiliary files.
+install-data:: install-pdftex-data
+install-pdftex-data: $(texpooldir)
+ @$(copy) pdftex.pool $(texpooldir)\pdftex.pool $(redir_stdout)
+
+#
+# ttf2afm
+ttf2afm = $(objdir)\ttf2afm.exe
+
+$(objdir)\ttf2afm.exe: $(objdir)\ttf2afm.obj
+ $(link) $(**) $(kpathsealib) $(proglib) $(conlibs)
+
+$(objdir)\ttf2afm.obj: pdftexdir\ttf2afm.c pdftexdir\macnames.c
+ $(compile) -I.\pdftexdir pdftexdir\ttf2afm.c
+check: ttf2afm-check
+ttf2afm-check: $(objdir)\ttf2afm.exe
+clean:: ttf2afm-clean
+ttf2afm-clean:
+# $(LIBTOOL) --mode=clean $(RM) ttf2afm
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\ttf2afm.obj $(objdir)\macnames.obj \
+ ttf2afm.c macnames.c) do $(del) %%i $(redir_stderr) \
+ )
+#
+# pdftosrc
+pdftosrc = $(objdir)\pdftosrc.exe
+
+$(objdir)\pdftosrc.exe: $(objdir)\pdftosrc.obj $(xpdflib)
+ $(link) $(objdir)\pdftosrc.obj $(xpdflib) $(kpathsealib) $(proglib) $(conlibs)
+
+$(objdir)\pdftosrc.obj: pdftexdir\pdftosrc.cc
+ $(compile) /Tp $(**)
+check: pdftosrc-check
+pdftosrc-check: $(objdir)\pdftosrc.exe
+clean:: pdftosrc-clean
+pdftosrc-clean:
+# $(LIBTOOL) --mode=clean $(RM) pdftosrc
+ -@$(del) $(objdir)\pdftosrc.obj $(redir_stderr)
+
+# end of pdftex.mak
+#
+# Local variables:
+# page-delimiter: "^# \f"
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.mk b/Build/source/texk/web2c/pdftexdir/pdftex.mk
new file mode 100644
index 00000000000..56a770546cf
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftex.mk
@@ -0,0 +1,201 @@
+# Makefile fragment for pdfTeX and web2c. --infovore@xs4all.nl. Public domain.
+# This fragment contains the parts of the makefile that are most likely to
+# differ between releases of pdfTeX.
+
+# The libraries are not mentioned. As the matter stands, a change in their
+# number or how they are configured requires changes to the main distribution
+# anyway.
+
+# $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftex.mk#38 $
+
+Makefile: pdftexdir/pdftex.mk
+
+pdftex_bin = pdftex pdfetex ttf2afm pdftosrc
+linux_build_dir = $(HOME)/pdftex/build/linux/texk/web2c
+
+# We build pdftex
+pdftex = @PTEX@ pdftex
+pdftexdir = pdftexdir
+
+# Extract pdftex version
+pdftexdir/pdftex.version: pdftexdir/pdftex.ch
+ grep '^@d pdftex_version_string==' $(srcdir)/pdftexdir/pdftex.ch \
+ | sed "s/^.*'-//;s/'.*$$//" \
+ >pdftexdir/pdftex.version
+
+# The C sources.
+pdftex_c = pdftexini.c pdftex0.c pdftex1.c pdftex2.c pdftex3.c
+pdftex_o = pdftexini.o pdftex0.o pdftex1.o pdftex2.o pdftex3.o pdftexextra.o
+
+# Making pdftex
+pdftex: $(pdftex_o) $(pdftexextra_o) $(pdftexlibsdep)
+ @CXXHACKLINK@ $(pdftex_o) $(pdftexextra_o) $(pdftexlibs) $(socketlibs) @CXXHACKLDLIBS@ @CXXLDEXTRA@
+
+# C file dependencies.
+$(pdftex_c) pdftexcoerce.h pdftexd.h: pdftex.p $(web2c_texmf)
+ $(web2c) pdftex
+pdftexextra.c: pdftexdir/pdftexextra.h lib/texmfmp.c
+ sed s/TEX-OR-MF-OR-MP/pdftex/ $(srcdir)/lib/texmfmp.c >$@
+pdftexdir/pdftexextra.h: pdftexdir/pdftexextra.in pdftexdir/pdftex.version
+ sed s/PDFTEX-VERSION/`cat pdftexdir/pdftex.version`/ \
+ $(srcdir)/pdftexdir/pdftexextra.in >$@
+
+# Tangling.
+pdftex.p pdftex.pool: tangle pdftex.web pdftex.ch
+ $(TANGLE) pdftex.web pdftex.ch
+
+# Generation of the web and ch files.
+# Sources for pdftex.web:
+pdftex_web_srcs = $(srcdir)/tex.web \
+ $(srcdir)/pdftexdir/pdftex.ch \
+ $(srcdir)/pdftexdir/hz.ch \
+ $(srcdir)/pdftexdir/misc.ch \
+ $(srcdir)/pdftexdir/vadjust.ch \
+ $(srcdir)/pdftexdir/pdftex2.ch
+# Sources for etex.ch:
+pdftex_ch_srcs = pdftex.web \
+ $(srcdir)/pdftexdir/tex.ch0 \
+ $(srcdir)/tex.ch \
+ $(srcdir)/pdftexdir/tex.ch1 \
+ $(srcdir)/pdftexdir/tex.pch \
+ $(srcdir)/pdftexdir/noligatures.ch \
+ $(srcdir)/pdftexdir/pdfstrcmp.ch \
+ $(srcdir)/pdftexdir/randoms.ch
+# Rules:
+pdftex.web: tie pdftexdir/pdftex.mk $(pdftex_web_srcs)
+ $(TIE) -m pdftex.web $(pdftex_web_srcs)
+pdftex.ch: $(pdftex_ch_srcs)
+ $(TIE) -c pdftex.ch $(pdftex_ch_srcs)
+
+# for developing only
+pdftex-org.web: $(pdftex_ch_srcs_org)
+ $(TIE) -m $@ $(pdftex_ch_srcs_org)
+pdftex-all.web: pdftex.web pdftex.ch
+ $(TIE) -m $@ pdftex.web pdftex.ch
+
+# Tests...
+check: @PTEX@ pdftex-check
+pdftex-check: pdftex pdftex.fmt
+
+# Cleaning up.
+clean:: pdftex-clean
+pdftex-clean:
+ $(LIBTOOL) --mode=clean $(RM) pdftex
+ rm -f $(pdftex_o) $(pdftex_c) pdftexextra.c pdftexcoerce.h
+ rm -f pdftexdir/pdftexextra.h pdftexdir/pdftex.version
+ rm -f pdftexd.h pdftex.p pdftex.pool pdftex.web pdftex.ch
+ rm -f pdftex.fmt pdftex.log
+
+# Dumps.
+all_pdffmts = @FMU@ pdftex.fmt $(pdffmts)
+
+dumps: @PTEX@ pdffmts
+pdffmts: $(all_pdffmts)
+
+pdffmtdir = $(web2cdir)/pdftex
+$(pdffmtdir)::
+ $(SHELL) $(top_srcdir)/../mkinstalldirs $(pdffmtdir)
+
+pdftex.fmt: pdftex
+ $(dumpenv) $(MAKE) progname=pdftex files="plain.tex cmr10.tfm" prereq-check
+ $(dumpenv) ./pdftex --progname=pdftex --jobname=pdftex --ini \\pdfoutput=1 \\input plain \\dump </dev/null
+
+pdfolatex.fmt: pdftex
+ $(dumpenv) $(MAKE) progname=pdfolatex files="latex.ltx" prereq-check
+ $(dumpenv) ./pdftex --progname=pdfolatex --jobname=pdfolatex --ini \\pdfoutput=1 \\input latex.ltx </dev/null
+
+#pdflatex.fmt: pdftex
+# $(dumpenv) $(MAKE) progname=pdflatex files="latex.ltx" prereq-check
+# $(dumpenv) ./pdftex --progname=pdflatex --jobname=pdflatex --ini \\pdfoutput=1 \\input latex.ltx </dev/null
+
+#
+# Installation.
+install-pdftex: install-pdftex-exec install-pdftex-data
+install-pdftex-exec: install-pdftex-links
+install-pdftex-data: install-pdftex-pool @FMU@ install-pdftex-dumps
+install-pdftex-dumps: install-pdftex-fmts
+
+# The actual binary executables and pool files.
+install-programs: @PTEX@ install-pdftex-programs
+install-pdftex-programs: pdftex $(bindir)
+ for p in pdftex; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+
+install-links: @PTEX@ install-pdftex-links
+install-pdftex-links: install-pdftex-programs
+ #cd $(bindir) && (rm -f pdfinitex pdfinitex; \
+ # $(LN) pdftex pdfinitex; $(LN) pdftex pdfvirtex)
+
+install-fmts: @PTEX@ install-pdftex-fmts
+install-pdftex-fmts: pdffmts $(pdffmtdir)
+ pdffmts="$(all_pdffmts)"; \
+ for f in $$pdffmts; do $(INSTALL_DATA) $$f $(pdffmtdir)/$$f; done
+ pdffmts="$(pdffmts)"; \
+ for f in $$pdffmts; do base=`basename $$f .fmt`; \
+ (cd $(bindir) && (rm -f $$base; $(LN) pdftex $$base)); done
+
+# Auxiliary files.
+install-data:: @PTEX@ install-pdftex-data
+install-pdftex-pool: pdftex.pool $(texpooldir)
+ $(INSTALL_DATA) pdftex.pool $(texpooldir)/pdftex.pool
+
+
+#
+# ttf2afm
+ttf2afm = ttf2afm
+
+ttf2afm: ttf2afm.o
+ $(kpathsea_link) ttf2afm.o $(kpathsea)
+ttf2afm.o: ttf2afm.c macnames.c
+ $(compile) -c $< -o $@
+ttf2afm.c:
+ cp $(srcdir)/pdftexdir/ttf2afm.c .
+macnames.c:
+ cp $(srcdir)/pdftexdir/macnames.c .
+check: ttf2afm-check
+ttf2afm-check: ttf2afm
+clean:: ttf2afm-clean
+ttf2afm-clean:
+ $(LIBTOOL) --mode=clean $(RM) ttf2afm
+ rm -f ttf2afm.o macnames.o
+ rm -f ttf2afm.c macnames.c
+#
+# pdftosrc
+pdftosrc = pdftosrc
+
+pdftosrc: pdftexdir/pdftosrc.o $(LIBXPDFDEP)
+ @CXXHACKLINK@ pdftexdir/pdftosrc.o $(LDLIBXPDF) -lm @CXXLDEXTRA@
+pdftexdir/pdftosrc.o:$(srcdir)/pdftexdir/pdftosrc.cc
+ cd pdftexdir && $(MAKE) pdftosrc.o
+check: pdftosrc-check
+pdftosrc-check: pdftosrc
+clean:: pdftosrc-clean
+pdftosrc-clean:
+ $(LIBTOOL) --mode=clean $(RM) pdftosrc
+#
+# pdftex binaries archive
+pdftexbin:
+ $(MAKE) $(pdftex_bin)
+
+pdftex-cross:
+ $(MAKE) web2c-cross
+ $(MAKE) pdftexbin
+
+web2c-cross: $(web2c_programs)
+ @if test ! -x $(linux_build_dir)/tangle; then echo Error: linux_build_dir not ready; exit -1; fi
+ rm -f web2c/fixwrites web2c/splitup web2c/web2c
+ cp -f $(linux_build_dir)/web2c/fixwrites web2c
+ cp -f $(linux_build_dir)/web2c/splitup web2c
+ cp -f $(linux_build_dir)/web2c/web2c web2c
+ touch web2c/fixwrites web2c/splitup web2c/web2c
+ $(MAKE) tangleboot && rm -f tangleboot && \
+ cp -f $(linux_build_dir)/tangleboot . && touch tangleboot
+ $(MAKE) ctangleboot && rm -f ctangleboot && \
+ cp -f $(linux_build_dir)/ctangleboot . && touch ctangleboot
+ $(MAKE) ctangle && rm -f ctangle && \
+ cp -f $(linux_build_dir)/ctangle . && touch ctangle
+ $(MAKE) tie && rm -f tie && \
+ cp -f $(linux_build_dir)/tie . && touch tie
+ $(MAKE) tangle && rm -f tangle && \
+ cp -f $(linux_build_dir)/tangle . && touch tangle
+
+# end of pdftex.mk
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex2.ch b/Build/source/texk/web2c/pdftexdir/pdftex2.ch
new file mode 100644
index 00000000000..227cb474242
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftex2.ch
@@ -0,0 +1,89 @@
+% WEB change file containing pdftex codes that are conveninent to be here
+% instead of pdftex.ch due to changes files coming after pdftex.ch (hz.ch &
+% vadjust.ch)
+%
+% Copyright (c) 1996-2005 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftex2.ch#5 $
+
+@x [230] - tagcode
+@d ef_code_base == 4
+@y
+@d ef_code_base == 4
+@d tag_code == 5
+@z
+
+@x [230] - tagcode
+ ef_code_base: scanned_result(get_ef_code(n, k))(int_val);
+@y
+ ef_code_base: scanned_result(get_ef_code(n, k))(int_val);
+ tag_code: scanned_result(get_tag_code(n, k))(int_val);
+@z
+
+@x [???] - tagcode
+function init_font_base(v: integer): integer;
+@y
+procedure set_tag_code(f: internal_font_number; c: eight_bits; i: integer);
+var fixedi:integer;
+begin
+ if is_valid_char(c) then
+ begin fixedi := abs(fix_int(i,-7,0));
+ if fixedi >= 4 then begin
+ if char_tag(char_info(f)(c)) = ext_tag then
+ op_byte(char_info(f)(c)) := (op_byte(char_info(f)(c))) - ext_tag;
+ fixedi := fixedi - 4;
+ end;
+ if fixedi >= 2 then begin
+ if char_tag(char_info(f)(c)) = list_tag then
+ op_byte(char_info(f)(c)) := (op_byte(char_info(f)(c))) - list_tag;
+ fixedi := fixedi - 2;
+ end;
+ if fixedi >= 1 then begin
+ if char_tag(char_info(f)(c)) = lig_tag then
+ op_byte(char_info(f)(c)) := (op_byte(char_info(f)(c))) - lig_tag;
+ end;
+ end;
+end;
+
+function init_font_base(v: integer): integer;
+@z
+
+@x [1253] - tagcode
+ ef_code_base: set_ef_code(f, p, cur_val);
+@y
+ ef_code_base: set_ef_code(f, p, cur_val);
+ tag_code: set_tag_code(f, p, cur_val);
+@z
+
+@x [1254] - tagcode
+primitive("efcode",assign_font_int,ef_code_base);
+@!@:ef_code_}{\.{\\efcode} primitive@>
+@y
+primitive("efcode",assign_font_int,ef_code_base);
+@!@:ef_code_}{\.{\\efcode} primitive@>
+primitive("tagcode",assign_font_int,tag_code);
+@!@:tag_code_}{\.{\\tagcode} primitive@>
+@z
+
+@x [1255]
+ef_code_base: print_esc("efcode");
+@y
+ef_code_base: print_esc("efcode");
+tag_code: print_esc("tagcode");
+@z
diff --git a/Build/source/texk/web2c/pdftexdir/pdftexextra.in b/Build/source/texk/web2c/pdftexdir/pdftexextra.in
new file mode 100644
index 00000000000..cd81871bec9
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftexextra.in
@@ -0,0 +1,40 @@
+/*
+Copyright (c) 1996-2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: pdftexextra.in,v 1.4 2004/08/26 18:14:18 olaf Exp $
+*/
+
+/* pdftexextra.in: banner etc. for pdfTeX.
+
+ This is included by pdfTeX, from ../etexextra.c
+ (generated from ../lib/texmfmp.c).
+*/
+
+#define BANNER "This is pdfTeX, Version 3.141592-PDFTEX-VERSION"
+#define COPYRIGHT_HOLDER "Han The Thanh"
+#define AUTHOR NULL
+#define PROGRAM_HELP PDFTEXHELP
+#define BUG_ADDRESS "pdftex@tug.org"
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "pdfinitex"
+#define VIR_PROGRAM "pdfvirtex"
diff --git a/Build/source/texk/web2c/pdftexdir/pdftexlib.mk b/Build/source/texk/web2c/pdftexdir/pdftexlib.mk
new file mode 100644
index 00000000000..5b3f745385c
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftexlib.mk
@@ -0,0 +1,76 @@
+## pdftexlib.mk - Makefile fragment for libraries used by pdf[ex]tex.
+# Public domain.
+
+# The pdf*tex programs depend on a number of libraries.
+# Include dependencies to get the built if we don't do make
+# from the top-level directory.
+
+Makefile: pdftexdir/pdftexlib.mk
+
+# libz
+
+ZLIBDIR=../../libs/zlib
+ZLIBSRCDIR=$(srcdir)/$(ZLIBDIR)
+ZLIBDEP = @ZLIBDEP@
+LDZLIB = @LDZLIB@
+
+$(ZLIBDIR)/libz.a: $(ZLIBSRCDIR)
+ cd $(ZLIBDIR) && $(MAKE) $(common_makeargs) libz.a
+
+
+# libpng
+
+LIBPNGDIR=../../libs/libpng
+LIBPNGSRCDIR=$(srcdir)/$(LIBPNGDIR)
+LIBPNGDEP = @LIBPNGDEP@
+LDLIBPNG = @LDLIBPNG@
+
+$(LIBPNGDIR)/libpng.a: $(LIBPNGSRCDIR)/*.c
+ cd $(LIBPNGDIR) && $(MAKE) $(common_makeargs) libpng.a
+
+
+# libxpdf
+
+LIBXPDFDIR=../../libs/xpdf
+LIBXPDFSRCDIR=$(srcdir)/$(LIBXPDFDIR)
+LIBXPDFDEP = @LIBXPDFDEP@
+LDLIBXPDF = @LDLIBXPDF@
+
+$(LIBXPDFDIR)/fofi/libfofi.a: $(LIBXPDFSRCDIR)/fofi/*.cc \
+ $(LIBXPDFSRCDIR)/fofi/*.h
+ cd $(LIBXPDFDIR)/fofi; $(MAKE) $(common_makeargs) libfofi.a
+$(LIBXPDFDIR)/goo/libGoo.a: $(LIBXPDFSRCDIR)/goo/*.cc \
+ $(LIBXPDFSRCDIR)/goo/*.c $(LIBXPDFSRCDIR)/goo/*.h
+ cd $(LIBXPDFDIR)/goo; $(MAKE) $(common_makeargs) libGoo.a
+$(LIBXPDFDIR)/xpdf/libxpdf.a: $(LIBXPDFSRCDIR)/xpdf/*.cc \
+ $(LIBXPDFSRCDIR)/xpdf/*.h
+ cd $(LIBXPDFDIR)/xpdf; $(MAKE) $(common_makeargs) libxpdf.a
+
+
+# md5
+
+LIBMD5DIR=../../libs/md5
+LIBMD5SRCDIR=$(srcdir)/$(LIBMD5DIR)
+LIBMD5DEP=$(LIBMD5DIR)/md5.o
+
+$(LIBMD5DEP): $(LIBMD5SRCDIR)/md5.c $(LIBMD5SRCDIR)/md5.h
+clean:: md5lib-clean
+md5lib-clean:
+ rm -f $(LIBMD5DEP)
+
+
+# libpdf itself
+pdflib = pdftexdir/libpdf.a
+pdflib_sources = $(srcdir)/pdftexdir/*.c $(srcdir)/pdftexdir/*.cc \
+ $(srcdir)/pdftexdir/*.h
+
+pdftexdir/libpdf.a: $(pdflib_sources) pdftexdir/pdftexextra.h
+ cd pdftexdir && $(MAKE) $(common_makeargs) libpdf.a
+
+
+# Convenience variables.
+
+pdftexlibs = $(pdflib) $(LDLIBPNG) $(LDZLIB) $(LDLIBXPDF) $(LIBMD5DEP)
+pdftexlibsdep = $(pdflib) $(LIBPNGDEP) $(ZLIBDEP) $(LIBXPDFDEP) $(LIBMD5DEP)
+
+## end of pdftexlib.mk - Makefile fragment for libraries used by pdf[ex]tex.
diff --git a/Build/source/texk/web2c/pdftexdir/pdftoepdf.cc b/Build/source/texk/web2c/pdftexdir/pdftoepdf.cc
new file mode 100644
index 00000000000..ef52a356763
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftoepdf.cc
@@ -0,0 +1,1072 @@
+/*
+Copyright 1996-2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftoepdf.cc#53 $
+*/
+
+#include <stdlib.h>
+#include <math.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <aconf.h>
+#include <GString.h>
+#include <gmem.h>
+#include <gfile.h>
+#include <config.h>
+#include "Object.h"
+#include "Stream.h"
+#include "Array.h"
+#include "Dict.h"
+#include "XRef.h"
+#include "Catalog.h"
+#include "Link.h"
+#include "Page.h"
+#include "GfxFont.h"
+#include "PDFDoc.h"
+#include "GlobalParams.h"
+#include "Error.h"
+
+#include "epdf.h"
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftoepdf.cc#53 $";
+
+/* we avoid reading all necessary kpathsea headers, but we need xstrdup */
+#ifdef __cplusplus
+extern "C" {
+ extern KPSEDLL char *xstrdup (const char *);
+}
+#else
+ extern KPSEDLL char *xstrdup (const char *);
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+// FIXME: This definition is a duplicate from ../pdftexcoerce.h, which is
+// not usable here because of different macro definitions.
+extern integer pdflastpdfboxspec ;
+}
+#endif
+
+/*
+ * Used flags below:
+ * PDFTEX_COPY_PAGEGROUP
+ * if pdfTeX should copy a page group (a new feature in pdf1.4 for
+ * transparency) of an included file. The current support for this is
+ * most likely broken. pdfTeX will at least give a warning if this flag
+ * is not set. Surprisingly Acrobat and Jaws display files without a
+ * page group correctly, so it might be safe to not set the flag.
+ * See also PDFTEX_COPY_PAGEGROUP_NOFAIL
+ * PDFTEX_COPY_PAGEGROUP_NOFAIL
+ * if set to false pdfTeX will treat a page group in an included file as
+ * an error and abort gracefully. This is only evaluated if
+ * PDFTEX_COPY_PAGEGROUP is set.
+ */
+
+// FIXME: These definitions are duplicates from pdftexd.h
+/* #define PDF_PDF_BOX_SPEC_MEDIA 0 */
+/* #define PDF_PDF_BOX_SPEC_CROP 1 */
+/* #define PDF_PDF_BOX_SPEC_BLEED 2 */
+/* #define PDF_PDF_BOX_SPEC_TRIM 3 */
+/* #define PDF_PDF_BOX_SPEC_ART 4 */
+#define pdfpdfboxspecmedia ( 0 )
+#define pdfpdfboxspeccrop ( 1 )
+#define pdfpdfboxspecbleed ( 2 )
+#define pdfpdfboxspectrim ( 3 )
+#define pdfpdfboxspecart ( 4 )
+
+// The prefix for the PDF keys special to pdfTeX
+// This has been registered with Adobe by Hans Hagen
+#define pdfkeyprefix "PTEX"
+
+// PdfObject encapsulates the xpdf Object type, and properly
+// frees its resources on destruction.
+// Use obj-> to access members of the Object, and
+// &obj to get a pointer to the object.
+// It is no longer necessary to call Object::free explicitely.
+
+class PdfObject {
+public:
+ PdfObject() { /* nothing */ }
+ ~PdfObject() { iObject.free(); }
+ Object* operator->() { return &iObject; }
+ Object* operator&() { return &iObject; }
+private: // no copying or assigning
+ PdfObject(const PdfObject &);
+ void operator=(const PdfObject &);
+public:
+ Object iObject;
+};
+
+// when copying the Resources of the selected page, all objects are copied
+// recusively top-down. Indirect objects however are not fetched during
+// copying, but get a new object number from pdftex and then will be
+// appended into a linked list. Duplicates are checked and removed from the
+// list of indirect objects during appending.
+
+enum InObjType {
+ objFont,
+ objFontDesc,
+ objOther
+};
+
+struct InObj {
+ Ref ref; // ref in original PDF
+ InObjType type; // object type
+ InObj *next; // next entry in list of indirect objects
+ integer num; // new object number in output PDF
+ fm_entry * fontmap; // pointer to font map entry
+ integer enc_objnum; // Encoding for objFont
+ int written; // has it been written to output PDF?
+};
+
+struct UsedEncoding {
+ integer enc_objnum;
+ GfxFont *font;
+ UsedEncoding *next;
+};
+
+static InObj *inObjList;
+static UsedEncoding *encodingList;
+static GBool isInit = gFalse;
+
+// --------------------------------------------------------------------
+// Maintain list of open embedded PDF files
+// --------------------------------------------------------------------
+
+struct PdfDocument {
+ char *file_name;
+ PDFDoc *doc;
+ XRef *xref;
+ InObj *inObjList;
+ int occurences; // number of references to the document; the doc can be
+ // deleted when this is negative
+ PdfDocument *next;
+};
+
+static PdfDocument *pdfDocuments = 0;
+
+static XRef *xref = 0;
+
+// Returns pointer to PdfDocument record for PDF file.
+// Creates a new record if it doesn't exist yet.
+// xref is made current for the document.
+
+static PdfDocument *find_add_document(char *file_name)
+{
+ PdfDocument *p = pdfDocuments;
+ while (p && strcmp(p->file_name, file_name) != 0)
+ p = p->next;
+ if (p) {
+ xref = p->xref;
+ (p->occurences)++;
+#ifdef DEBUG
+ fprintf(stderr, "\nIncrementing %s (%d)\n", p->file_name, p->occurences);
+#endif
+ return p;
+ }
+ p = new PdfDocument;
+ p->file_name = xstrdup(file_name);
+ p->xref = xref = 0;
+ p->occurences = 0;
+#ifdef DEBUG
+ fprintf(stderr, "\nCreating %s (%d)\n", p->file_name, p->occurences);
+#endif
+ GString *docName = new GString(p->file_name);
+ p->doc = new PDFDoc(docName); // takes ownership of docName
+ if (!p->doc->isOk() || !p->doc->okToPrint()) {
+ pdftex_fail("xpdf: reading PDF image failed");
+ }
+ p->inObjList = 0;
+ p->next = pdfDocuments;
+ pdfDocuments = p;
+ return p;
+}
+
+// Deallocate a PdfDocument with all its resources
+static void delete_document(PdfDocument *pdf_doc)
+{
+ PdfDocument **p = &pdfDocuments;
+ while (*p && *p != pdf_doc)
+ p = &((*p)->next);
+ // should not happen:
+ if (!*p)
+ return;
+ // unlink from list
+ *p = pdf_doc->next;
+ // free pdf_doc's resources
+ InObj *r, *n;
+ for (r = pdf_doc->inObjList; r != 0; r = n) {
+ n = r->next;
+ delete r;
+ }
+ xref = pdf_doc->xref;
+ delete pdf_doc->doc;
+ xfree(pdf_doc->file_name);
+ delete pdf_doc;
+}
+
+// Replacement for
+// Object *initDict(Dict *dict1){ initObj(objDict); dict = dict1; return this; }
+static void initDictFromDict (PdfObject &obj, Dict *dict)
+{
+ obj->initDict(xref);
+ for (int i = 0,
+ l = dict->getLength();
+ i < l;
+ i++) {
+ Object obj1;
+ obj->dictAdd(copyString(dict->getKey(i)), dict->getValNF(i, &obj1));
+ }
+}
+
+// --------------------------------------------------------------------
+
+static int addEncoding(GfxFont *gfont)
+{
+ UsedEncoding *n;
+ n = new UsedEncoding;
+ n->next = encodingList;
+ encodingList = n;
+ n->font = gfont;
+ n->enc_objnum = pdfnewobjnum();
+ return n->enc_objnum;
+}
+
+#define addFont(ref, fontmap, enc_objnum) \
+ addInObj(objFont, ref, fontmap, enc_objnum)
+
+#define addFontDesc(ref, fontmap) \
+ addInObj(objFontDesc, ref, fontmap, 0)
+
+#define addOther(ref) \
+ addInObj(objOther, ref, 0, 0)
+
+static int addInObj(InObjType type, Ref ref, fm_entry *f, integer e)
+{
+ InObj *p, *q, *n = new InObj;
+ if (ref.num == 0)
+ pdftex_fail("pdf inclusion: invalid reference");
+ n->ref = ref;
+ n->type = type;
+ n->next = 0;
+ n->fontmap = f;
+ n->enc_objnum = e;
+ n->written = 0;
+ if (inObjList == 0)
+ inObjList = n;
+ else {
+ for (p = inObjList; p != 0; p = p->next) {
+ if (p->ref.num == ref.num && p->ref.gen == ref.gen) {
+ delete n;
+ return p->num;
+ }
+ q = p;
+ }
+ // it is important to add new objects at the end of the list,
+ // because new objects are being added while the list is being
+ // written out.
+ q->next = n;
+ }
+ n->num = pdfnewobjnum();
+ return n->num;
+}
+
+static void copyObject(Object *);
+
+static void copyName(char *s)
+{
+ pdf_puts("/");
+ for (; *s != 0; s++) {
+ if (isdigit(*s) || isupper(*s) || islower(*s) || *s == '_' ||
+ *s == '.' || *s == '-' )
+ pdfout(*s);
+ else
+ pdf_printf("#%.2X", *s & 0xFF);
+ }
+}
+
+static void copyDictEntry(Object *obj, int i)
+{
+ PdfObject obj1;
+ copyName(obj->dictGetKey(i));
+ pdf_puts(" ");
+ obj->dictGetValNF(i, &obj1);
+ copyObject(&obj1);
+ pdf_puts("\n");
+}
+
+static void copyDict(Object *obj)
+{
+ int i, l;
+ if (!obj->isDict())
+ pdftex_fail("pdf inclusion: invalid dict type <%s>",
+ obj->getTypeName());
+ for (i = 0, l = obj->dictGetLength(); i < l; ++i)
+ copyDictEntry(obj, i);
+}
+
+static void copyFontDict(Object *obj, InObj *r)
+{
+ int i, l;
+ char *key;
+ if (!obj->isDict())
+ pdftex_fail("pdf inclusion: invalid dict type <%s>",
+ obj->getTypeName());
+ pdf_puts("<<\n");
+ if (r->type == objFont) { // Font dict
+ for (i = 0, l = obj->dictGetLength(); i < l; ++i) {
+ key = obj->dictGetKey(i);
+ if (strcmp("BaseFont", key) == 0 ||
+ strcmp("Encoding", key) == 0)
+ continue; // skip original values
+ copyDictEntry(obj, i);
+ }
+ // write new BaseFont and Encoding
+ pdf_printf("/BaseFont %i 0 R\n", (int)get_fontname(r->fontmap));
+ pdf_printf("/Encoding %i 0 R\n", (int)r->enc_objnum);
+ }
+ else { // FontDescriptor dict
+ for (i = 0, l = obj->dictGetLength(); i < l; ++i) {
+ key = obj->dictGetKey(i);
+ if (strcmp("FontName", key) == 0 ||
+ strncmp("FontFile", key, strlen("FontFile")) == 0)
+ continue; // ignore original FontFile/FontName
+ if (strcmp("CharSet", key) == 0)
+ continue; // ignore CharSet
+ copyDictEntry(obj, i);
+ }
+ // write new FontName and FontFile
+ pdf_printf("/FontName %i 0 R\n", (int)get_fontname(r->fontmap));
+ pdf_printf("/FontFile %i 0 R\n", (int)get_fontfile(r->fontmap));
+ }
+ pdf_puts(">>");
+}
+
+static void copyStream(Stream *str)
+{
+ int c;
+ str->reset();
+ while ((c = str->getChar()) != EOF)
+ pdfout(c);
+}
+
+static void copyProcSet(Object *obj)
+{
+ int i, l;
+ PdfObject procset;
+ if (!obj->isArray())
+ pdftex_fail("pdf inclusion: invalid ProcSet array type <%s>",
+ obj->getTypeName());
+ pdf_puts("/ProcSet [ ");
+ for (i = 0, l = obj->arrayGetLength(); i < l; ++i) {
+ obj->arrayGetNF(i, &procset);
+ if (!procset->isName())
+ pdftex_fail("pdf inclusion: invalid ProcSet entry type <%s>",
+ procset->getTypeName());
+ copyName(procset->getName());
+ pdf_puts(" ");
+ }
+ pdf_puts("]\n");
+}
+
+static void copyFont(char *tag, Object *fontRef)
+{
+ PdfObject fontdict, subtype, basefont, fontdescRef, fontdesc, charset, fontfile;
+ GfxFont *gfont;
+ fm_entry *fontmap;
+ // Check whether the font has already been embedded before analysing it.
+ InObj *p;
+ Ref ref = fontRef->getRef();
+ for (p = inObjList; p; p = p->next) {
+ if (p->ref.num == ref.num && p->ref.gen == ref.gen) {
+ copyName(tag);
+ pdf_printf(" %d 0 R ", p->num);
+ return;
+ }
+ }
+ /* only handle included Type1 fonts; anything else will be copied */
+ if (fontRef->fetch(xref, &fontdict) &&
+ fontdict->isDict() &&
+ fontdict->dictLookup("Subtype", &subtype) &&
+ subtype->isName() &&
+ fontdict->dictLookup("BaseFont", &basefont) &&
+ basefont->isName() &&
+ fontdict->dictLookupNF("FontDescriptor", &fontdescRef) &&
+ fontdescRef->isRef() &&
+ fontdescRef->fetch(xref, &fontdesc) &&
+ fontdesc->isDict() &&
+ fontdesc->dictLookupNF("FontDescriptor", &fontdescRef) &&
+ ((strcmp(subtype->getName(), "Type1") == 0 &&
+ fontdesc->dictLookup("FontFile", &fontfile)) ||
+ (strcmp(subtype->getName(), "Type1C") == 0 &&
+ fontdesc->dictLookup("FontFile3", &fontfile))) &&
+ fontfile->isStream()
+ ) {
+ fontmap = lookup_fontmap(basefont->getName());
+ if (fontmap != NULL) {
+ if (fontdesc->dictLookup("CharSet", &charset) &&
+ charset->isString() && is_subsetable(fontmap))
+ mark_glyphs(fontmap, charset->getString()->getCString());
+ else
+ embed_whole_font(fontmap);
+ addFontDesc(fontdescRef->getRef(), fontmap);
+ copyName(tag);
+ gfont = GfxFont::makeFont(xref, tag, fontRef->getRef(),
+ fontdict->getDict());
+ pdf_printf(" %d 0 R ", addFont(fontRef->getRef(), fontmap,
+ addEncoding(gfont)));
+ return;
+ }
+ }
+ copyName(tag);
+ pdf_puts(" ");
+ copyObject(fontRef);
+}
+
+static void copyFontResources(Object *obj)
+{
+ PdfObject fontRef;
+ int i, l;
+ if (!obj->isDict())
+ pdftex_fail("pdf inclusion: invalid font resources dict type <%s>",
+ obj->getTypeName());
+ pdf_puts("/Font << ");
+ for (i = 0, l = obj->dictGetLength(); i < l; ++i) {
+ obj->dictGetValNF(i, &fontRef);
+ if (fontRef->isRef())
+ copyFont(obj->dictGetKey(i), &fontRef);
+ else
+ pdftex_fail("pdf inclusion: invalid font in reference type <%s>",
+ fontRef->getTypeName());
+ }
+ pdf_puts(">>\n");
+}
+
+static void copyOtherResources(Object *obj, char *key)
+{
+ /* copies all other resources (write_epdf handles Fonts and ProcSets),
+ * but gives a warning if an object is not a dictionary.
+ */
+ if (!obj->isDict())
+ //FIXME: Write the message only to the log file
+ pdftex_warn("pdf inclusion: invalid other resource which is no dict"
+ " (key '%s', type <%s>); copying it anyway.",
+ key,
+ obj->getTypeName());
+ copyName(key);
+ pdf_puts(" ");
+ copyObject(obj);
+}
+
+/* converts double to string; very small and very large numbers are NOT
+ * converted to scientific notation.
+ * n must be a number or real confirming to the implementation limits of PDF as
+ * specified in appendix C.1 of the pdf ref.
+ * These are:
+ * maximum value of ints is +2^32
+ * maximum value of reals is +2^15
+ * smalles values of reals is 1/(2^16)
+ */
+static char *
+convertNumToPDF(double n)
+{
+ static const int precision = 6;
+ static const int fact = (int) 1E6; /* must be 10^precision */
+ static const double epsilon = 0.5E-6; /* 2epsilon must be 10^-precision */
+ static char buf[64];
+ // handle very small values: return 0
+ if (fabs(n) < epsilon) {buf[0] = '0'; buf[1] = '\0';}
+ else {
+ char ints[64];
+ int bindex = 0, sindex = 0;
+ int ival, fval;
+ // handle the sign part if n is negative
+ if (n < 0) {
+ buf[bindex++] = '-';
+ n = -n;
+ }
+ n += epsilon; // for rounding
+ // handle the integer part, simply with sprintf
+ ival = (int)floor(n);
+ n -= ival;
+ sprintf(ints, "%d", ival);
+ while (ints[sindex] != 0) buf[bindex++] = ints[sindex++];
+ // handle the fractional part up to 'precision' digits
+ fval = (int)floor(n*fact);
+ if (fval) {
+ // set a dot
+ buf[bindex++] = '.';
+ sindex = bindex + precision;
+ buf[sindex--] = '\0';
+ // fill up trailing zeros with the string terminator NULL
+ while (((fval % 10) == 0) && (sindex >= bindex)) {
+ buf[sindex--] = '\0';
+ fval /= 10;
+ }
+ // fill up the fractional part back to front
+ while (sindex >= bindex) {
+ buf[sindex--] = (fval % 10) + '0';
+ fval /= 10;
+ }
+ } else buf[bindex++] = 0;
+ }
+ return (char *)buf;
+}
+
+static void copyObject(Object *obj)
+{
+ PdfObject obj1;
+ int i, l, c;
+ Ref ref;
+ char *p;
+ GString *s;
+ if (obj->isBool()) {
+ pdf_printf("%s", obj->getBool() ? "true" : "false");
+ }
+ else if (obj->isInt()) {
+ pdf_printf("%i", obj->getInt());
+ }
+ else if (obj->isReal()) {
+ pdf_printf("%s", convertNumToPDF(obj->getReal()));
+ }
+ else if (obj->isNum()) {
+ pdf_printf("%s", convertNumToPDF(obj->getNum()));
+ }
+ else if (obj->isString()) {
+ s = obj->getString();
+ p = s->getCString();
+ l = s->getLength();
+ if (strlen(p) == (unsigned int)l) {
+ pdf_puts("(");
+ for (; *p != 0; p++) {
+ c = (unsigned char)*p;
+ if (c == '(' || c == ')' || c == '\\')
+ pdf_printf("\\%c", c);
+ else if (c < 0x20 || c > 0x7F)
+ pdf_printf("\\%03o", c);
+ else
+ pdfout(c);
+ }
+ pdf_puts(")");
+ }
+ else {
+ pdf_puts("<");
+ for (i = 0; i < l; i++) {
+ c = s->getChar(i) & 0xFF;
+ pdf_printf("%.2x", c);
+ }
+ pdf_puts(">");
+ }
+ }
+ else if (obj->isName()) {
+ copyName(obj->getName());
+ }
+ else if (obj->isNull()) {
+ pdf_puts("null");
+ }
+ else if (obj->isArray()) {
+ pdf_puts("[");
+ for (i = 0, l = obj->arrayGetLength(); i < l; ++i) {
+ obj->arrayGetNF(i, &obj1);
+ if (!obj1->isName())
+ pdf_puts(" ");
+ copyObject(&obj1);
+ }
+ pdf_puts("]");
+ }
+ else if (obj->isDict()) {
+ pdf_puts("<<\n");
+ copyDict(obj);
+ pdf_puts(">>");
+ }
+ else if (obj->isStream()) {
+ initDictFromDict (obj1, obj->streamGetDict());
+ obj->streamGetDict()->incRef();
+ pdf_puts("<<\n");
+ copyDict(&obj1);
+ pdf_puts(">>\n");
+ pdf_puts("stream\n");
+ copyStream(obj->getStream()->getBaseStream());
+ pdf_puts("endstream");
+ }
+ else if (obj->isRef()) {
+ ref = obj->getRef();
+ if (ref.num == 0) {
+ pdftex_warn("pdf inclusion: reference to invalid object was replaced by <null>");
+ pdf_puts("null");
+ }
+ else
+ pdf_printf("%d 0 R", addOther(ref));
+ }
+ else {
+ pdftex_fail("pdf inclusion: type <%s> cannot be copied",
+ obj->getTypeName());
+ }
+}
+
+static void writeRefs()
+{
+ InObj *r;
+ for (r = inObjList; r != 0; r = r->next) {
+ if (!r->written) {
+ Object obj1;
+ r->written = 1;
+ zpdfbeginobj(r->num);
+ xref->fetch(r->ref.num, r->ref.gen, &obj1);
+ if (r->type == objFont || r->type == objFontDesc)
+ copyFontDict(&obj1, r);
+ else
+ copyObject(&obj1);
+ pdf_puts("\n");
+ pdfendobj();
+ obj1.free();
+ }
+ }
+}
+
+static void writeEncodings()
+{
+ UsedEncoding *r, *n;
+ char *glyphNames[MAX_CHAR_CODE + 1], *s;
+ int i;
+ for (r = encodingList; r != 0; r = r->next) {
+ for (i = 0; i <= MAX_CHAR_CODE; i++) {
+ if (r->font->isCIDFont()) {
+ pdftex_warn("pdf inclusion: CID font included, encoding maybe wrong");
+ }
+ if ((s = ((Gfx8BitFont *)r->font)->getCharName(i)) != 0)
+ glyphNames[i] = s;
+ else
+ glyphNames[i] = notdef;
+ }
+ write_enc(glyphNames, NULL, r->enc_objnum);
+ }
+ for (r = encodingList; r != 0; r = n) {
+ n = r->next;
+ delete r->font;
+ delete r;
+ }
+}
+
+/* Reads various information about the pdf and sets it up for later inclusion.
+ * This will fail if the pdf version of the pdf is higher than
+ * minor_pdf_version_wanted or page_name is given and can not be found.
+ * It makes no sense to give page_name _and_ page_num.
+ * Returns the page number.
+ */
+integer
+read_pdf_info(char *image_name, char *page_name, integer page_num,
+ integer minor_pdf_version_wanted, integer always_use_pdf_pagebox,
+ integer pdf_inclusion_errorlevel)
+{
+ PdfDocument *pdf_doc;
+ Page *page;
+ int rotate;
+ PDFRectangle *pagebox;
+ float pdf_version_found, pdf_version_wanted;
+ // initialize
+ if (!isInit) {
+ globalParams = new GlobalParams();
+ globalParams->setErrQuiet(gFalse);
+ isInit = gTrue;
+ }
+ // open PDF file
+ pdf_doc = find_add_document(image_name);
+ epdf_doc = (void *) pdf_doc;
+#ifdef DEBUG
+ fprintf(stderr, "\nReading information on %s\n", pdf_doc->file_name);
+#endif
+ // check pdf version
+ // this works only for pdf 1.x -- but since any versions of pdf newer
+ // than 1.x will not be backwards compatible to pdf 1.x, pdfTeX will
+ // then have to changed drastically anyway.
+ pdf_version_found = pdf_doc->doc->getPDFVersion();
+ pdf_version_wanted = 1 + (minor_pdf_version_wanted * 0.1);
+ if (pdf_version_found > pdf_version_wanted) {
+ char msg[] = "pdf inclusion: found pdf version <%.1f>, but at most version <%.1f> allowed";
+ if (pdf_inclusion_errorlevel > 0) {
+ pdftex_fail(msg, pdf_version_found, pdf_version_wanted);
+ } else {
+ pdftex_warn(msg, pdf_version_found, pdf_version_wanted);
+ }
+ }
+ epdf_num_pages = pdf_doc->doc->getCatalog()->getNumPages();
+ if (page_name) {
+ // get page by name
+ GString name(page_name);
+ LinkDest *link = pdf_doc->doc->findDest(&name);
+ if (link == 0 || !link->isOk())
+ pdftex_fail("pdf inclusion: invalid destination <%s>",
+ page_name);
+ Ref ref = link->getPageRef();
+ page_num = pdf_doc->doc->getCatalog()->findPage(ref.num, ref.gen);
+ if (page_num == 0)
+ pdftex_fail("pdf inclusion: destination is not a page <%s>",
+ page_name);
+ delete link;
+ } else {
+ // get page by number
+ if (page_num <= 0 || page_num > epdf_num_pages)
+ pdftex_fail("pdf inclusion: required page does not exist <%i>",
+ epdf_num_pages);
+ }
+ // get the required page
+ page = pdf_doc->doc->getCatalog()->getPage(page_num);
+
+ // get the pagebox (media, crop...) to use.
+ // always_use_pdf_pagebox can set in the config file to override the
+ // setting through pdfximage.
+ if (always_use_pdf_pagebox < 1) {
+ switch (pdflastpdfboxspec) {
+ case pdfpdfboxspeccrop:
+ pagebox = page->getCropBox();
+ break;
+
+ case pdfpdfboxspecbleed:
+ pagebox = page->getBleedBox();
+ break;
+
+ case pdfpdfboxspectrim:
+ pagebox = page->getTrimBox();
+ break;
+
+ case pdfpdfboxspecart:
+ pagebox = page->getArtBox();
+ break;
+
+ default:
+ pagebox = page->getMediaBox();
+ }
+ }
+ else {
+ switch (always_use_pdf_pagebox) {
+ case 1 :
+ pagebox = page->getMediaBox();
+ break;
+ case 2 :
+ pagebox = page->getCropBox();
+ break;
+ case 3 :
+ pagebox = page->getBleedBox();
+ break;
+ case 4 :
+ pagebox = page->getTrimBox();
+ break;
+ default : // 5 and larger
+ pagebox = page->getArtBox();
+ }
+ }
+#ifdef DEBUG
+ fprintf(stderr,
+ "\npagebox->x1: %.8f, pagebox->x2: %.8f, pagebox->y1: %.8f, pagebox->y2: %.8f\n",
+ pagebox->x1, pagebox->x2, pagebox->y1, pagebox->y2);
+#endif
+ epdf_width = pagebox->x2 - pagebox->x1;
+ epdf_height = pagebox->y2 - pagebox->y1;
+ epdf_orig_x = pagebox->x1;
+ epdf_orig_y = pagebox->y1;
+
+ rotate = page->getRotate();
+ // handle page rotation and adjust dimens as needed
+ if (rotate != 0) {
+ if (rotate % 90 == 0) {
+ // handle only the simple case: multiple of 90s.
+ // these are the only values allowed according to the
+ // reference (v1.3, p.78).
+ // 180 needs no special treatment here
+ register float f;
+ switch (rotate) {
+ case 90: f = epdf_height; epdf_height = epdf_width; epdf_width = f; break;
+ case 270: f = epdf_height; epdf_height = epdf_width; epdf_width = f; break;
+ }
+ }
+ }
+ pdf_doc->xref = pdf_doc->doc->getXRef();
+ return page_num;
+}
+
+/* writes the current epf_doc.
+ * Here the included pdf is copied, so most errors that can happen during pdf
+ * inclusion will arise here.
+ */
+void
+write_epdf(void)
+{
+ Page *page;
+ PdfObject contents, obj1, obj2;
+ PdfObject group, metadata, pieceinfo, separationInfo;
+ Object info;
+ char *key;
+ int i, l;
+ int rotate;
+ double scale[6] = {0, 0, 0, 0, 0, 0};
+ bool writematrix = false;
+ PdfDocument *pdf_doc = (PdfDocument *) epdf_doc;
+ (pdf_doc->occurences)--;
+#ifdef DEBUG
+ fprintf(stderr, "\nDecrementing %s (%d)\n", pdf_doc->file_name, pdf_doc->occurences);
+#endif
+ xref = pdf_doc->xref;
+ inObjList = pdf_doc->inObjList;
+ encodingList = 0;
+ page = pdf_doc->doc->getCatalog()->getPage(epdf_selected_page);
+ rotate = page->getRotate();
+ PDFRectangle *pagebox;
+ // write the Page header
+ pdf_puts("/Type /XObject\n");
+ pdf_puts("/Subtype /Form\n");
+ pdf_puts("/FormType 1\n");
+
+ // write additional information
+ pdf_printf("/%s.FileName (%s)\n", pdfkeyprefix,
+ convertStringToPDFString(pdf_doc->file_name,
+ strlen(pdf_doc->file_name)));
+ pdf_printf("/%s.PageNumber %i\n", pdfkeyprefix, epdf_selected_page);
+ pdf_doc->doc->getDocInfoNF(&info);
+ if (info.isRef()) {
+ // the info dict must be indirect (pdf ref p.61)
+ pdf_printf("/%s.InfoDict ", pdfkeyprefix);
+ pdf_printf("%d 0 R \n", addOther(info.getRef()));
+ }
+
+ // get the pagebox (media, crop...) to use.
+ // epdf_always_use_pdf_pagebox is a copy of always_use_pdf_pagebox which
+ // can set in the config file to override the setting through pdfximage.
+ if (epdf_always_use_pdf_pagebox < 1) {
+ switch (epdf_page_box) {
+ case pdfpdfboxspeccrop:
+ pagebox = page->getCropBox();
+ break;
+
+ case pdfpdfboxspecbleed:
+ pagebox = page->getBleedBox();
+ break;
+
+ case pdfpdfboxspectrim:
+ pagebox = page->getTrimBox();
+ break;
+
+ case pdfpdfboxspecart:
+ pagebox = page->getArtBox();
+ break;
+
+ default:
+ pagebox = page->getMediaBox();
+ }
+ }
+ else {
+ switch (epdf_always_use_pdf_pagebox) {
+ case 1 :
+ pagebox = page->getMediaBox();
+ break;
+ case 2 :
+ pagebox = page->getCropBox();
+ break;
+ case 3 :
+ pagebox = page->getBleedBox();
+ break;
+ case 4 :
+ pagebox = page->getTrimBox();
+ break;
+ default : // 5 and larger
+ pagebox = page->getArtBox();
+ }
+ }
+#ifdef DEBUG
+ fprintf(stderr,
+ "\npagebox->x1: %.8f, pagebox->x2: %.8f, pagebox->y1: %.8f, pagebox->y2: %.8f\n",
+ pagebox->x1, pagebox->x2, pagebox->y1, pagebox->y2);
+#endif
+
+ // handle page rotation
+ if (rotate != 0) {
+ if (rotate % 90 == 0) {
+ // this handles only the simple case: multiple of 90s but these
+ // are the only values allowed according to the reference
+ // (v1.3, p.78).
+ // the image is rotated around its center.
+ // the /Rotate key is clockwise while the matrix is
+ // counterclockwise :-%
+ tex_printf (", page is rotated %d degrees", rotate);
+ switch (rotate) {
+ case 90: scale[1] = -1; scale[2] = 1; scale[4] = pagebox->x1 - pagebox->y1; scale[5] = pagebox->y1 + pagebox->x2; writematrix = true; break;
+ case 180: scale[0] = scale[3] = -1; scale[4] = pagebox->x1 + pagebox->x2; scale[5] = pagebox->y1 + pagebox->y2; writematrix = true; break; // width and height are exchanged
+ case 270: scale[1] = 1; scale[2] = -1; scale[4] = pagebox->x1 + pagebox->y2; scale[5] = pagebox->y1 - pagebox->x1; writematrix = true; break;
+ }
+ if (writematrix) { // The matrix is only written if the image is rotated.
+ pdf_printf("/Matrix [%.8f %.8f %.8f %.8f %.8f %.8f]\n",
+ scale[0],
+ scale[1],
+ scale[2],
+ scale[3],
+ scale[4],
+ scale[5]);
+ }
+ }
+ }
+
+ pdf_printf("/BBox [%.8f %.8f %.8f %.8f]\n",
+ pagebox->x1,
+ pagebox->y1,
+ pagebox->x2,
+ pagebox->y2);
+
+ // write the page Group if it's there
+ if (page->getGroup() != NULL) {
+#if PDFTEX_COPY_PAGEGROUP
+# if PDFTEX_COPY_PAGEGROUP_NOFAIL
+ // FIXME: This will most likely produce incorrect PDFs :-(
+ initDictFromDict(group, page->getGroup());
+ if (group->dictGetLength() > 0) {
+ pdf_puts("/Group ");
+ copyObject (&group);
+ pdf_puts("\n");
+ }
+# else
+ // FIXME: currently we don't know how to handle Page Groups so we abort gracefully :-(
+ pdftex_fail("pdf inclusion: Page Group detected which pdfTeX can't handle. Sorry.");
+# endif
+#else
+ // FIXME: currently we don't know how to handle Page Groups so we at least give a warning :-(
+ pdftex_warn("pdf inclusion: Page Group detected which pdfTeX can't handle. Ignoring it.");
+#endif
+ }
+
+ // write the page Metadata if it's there
+ if (page->getMetadata() != NULL) {
+ metadata->initStream(page->getMetadata());
+ pdf_puts("/Metadata ");
+ copyObject (&metadata);
+ pdf_puts("\n");
+ }
+
+ // write the page PieceInfo if it's there
+ if (page->getPieceInfo() != NULL) {
+ initDictFromDict (pieceinfo, page->getPieceInfo());
+ if (pieceinfo->dictGetLength() > 0) {
+ pdf_puts("/PieceInfo ");
+ copyObject (&pieceinfo);
+ pdf_puts("\n");
+ }
+ }
+
+ // write the page SeparationInfo if it's there
+ if (page->getSeparationInfo() != NULL) {
+ initDictFromDict (separationInfo, page->getSeparationInfo());
+ if (separationInfo->dictGetLength() > 0) {
+ pdf_puts("/SeparationInfo ");
+ copyObject (&separationInfo);
+ pdf_puts("\n");
+ }
+ }
+
+ // write the Resources dictionary
+ if (page->getResourceDict() == NULL) {
+ // Resources can be missing (files without them have been spotted
+ // in the wild). This violates the pdf spec, which claims they are
+ // required, but all RIPs accept them.
+ // We "replace" them with empty Resources.
+ pdftex_warn("pdf inclusion: no /Resources detected. Replacing with empty /Resources.");
+ pdf_puts("/Resources <<>>\n");
+ }
+ else {
+ initDictFromDict (obj1, page->getResourceDict());
+ page->getResourceDict()->incRef();
+ if (!obj1->isDict())
+ pdftex_fail("pdf inclusion: invalid resources dict type <%s>",
+ obj1->getTypeName());
+ pdf_puts("/Resources <<\n");
+ for (i = 0, l = obj1->dictGetLength(); i < l; ++i) {
+ obj1->dictGetVal(i, &obj2);
+ key = obj1->dictGetKey(i);
+ if (strcmp("Font", key) == 0)
+ copyFontResources(&obj2);
+ else if (strcmp("ProcSet", key) == 0)
+ copyProcSet(&obj2);
+ else
+ copyOtherResources(&obj2, key);
+ }
+ pdf_puts(">>\n");
+ }
+ // write the page contents
+ page->getContents(&contents);
+ if (contents->isStream()) {
+ initDictFromDict (obj1, contents->streamGetDict());
+ contents->streamGetDict()->incRef();
+ copyDict(&obj1);
+ pdf_puts(">>\nstream\n");
+ copyStream(contents->getStream()->getBaseStream());
+ pdf_puts("endstream\n");
+ pdfendobj();
+ }
+ else if (contents->isArray()) {
+ pdfbeginstream();
+ for (i = 0, l = contents->arrayGetLength(); i < l; ++i) {
+ Object contentsobj;
+ copyStream((contents->arrayGet(i, &contentsobj))->getStream());
+ contentsobj.free();
+ }
+ pdfendstream();
+ }
+ else {// the contents are optional, but we need to include an empty stream
+ pdfbeginstream();
+ pdfendstream();
+ }
+ // write out all indirect objects
+ writeRefs();
+ // write out all used encodings (and delete list)
+ writeEncodings();
+ // save object list, xref
+ pdf_doc->inObjList = inObjList;
+ pdf_doc->xref = xref;
+}
+
+// Called when an image has been written and it's resources in image_tab are
+// freed and it's not referenced anymore.
+void
+epdf_delete()
+{
+ PdfDocument *pdf_doc = (PdfDocument *) epdf_doc;
+ xref = pdf_doc->xref;
+ if (pdf_doc->occurences < 0) {
+#ifdef DEBUG
+ fprintf(stderr, "\nDeleting %s\n", pdf_doc->file_name);
+#endif
+ delete_document(pdf_doc);
+ }
+}
+
+// Called when PDF embedding system is finalized.
+// Now deallocate all remaining PdfDocuments.
+void epdf_check_mem()
+{
+ if (isInit) {
+ PdfDocument *p, *n;
+ for (p = pdfDocuments; p; p = n) {
+ n = p->next;
+ delete_document(p);
+ }
+ // see above for globalParams
+ delete globalParams;
+ }
+}
+// vi:ts=4:tw=79:expandtab:ai:
diff --git a/Build/source/texk/web2c/pdftexdir/pdftosrc.cc b/Build/source/texk/web2c/pdftexdir/pdftosrc.cc
new file mode 100644
index 00000000000..ec83aca7b94
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftosrc.cc
@@ -0,0 +1,130 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftosrc.cc#10 $
+*/
+
+#include <stdlib.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <aconf.h>
+#include <GString.h>
+#include <gmem.h>
+#include <gfile.h>
+#include "Object.h"
+#include "Stream.h"
+#include "Array.h"
+#include "Dict.h"
+#include "XRef.h"
+#include "Catalog.h"
+#include "Page.h"
+#include "GfxFont.h"
+#include "PDFDoc.h"
+#include "GlobalParams.h"
+#include "Error.h"
+
+static XRef *xref = 0;
+
+int main(int argc, char *argv[])
+{
+ char *p, buf[1024];
+ PDFDoc *doc;
+ GString *fileName;
+ Stream *s;
+ Object srcStream, srcName, catalogDict;
+ FILE *outfile;
+ char *outname;
+ int objnum = 0, objgen = 0;
+ int c;
+ fprintf(stderr, "pdftosrc version %s\n", xpdfVersion);
+ if (argc < 2) {
+ fprintf(stderr, "Usage: pdftosrc <PDF-file> [<stream-object-number>]\n");
+ exit(1);
+ }
+ fileName = new GString(argv[1]);
+ globalParams = new GlobalParams();
+ doc = new PDFDoc(fileName);
+ if (!doc->isOk()) {
+ fprintf(stderr, "Invalid PDF file\n");
+ exit(1);
+ }
+ if (argc >= 3) {
+ objnum = atoi(argv[2]);
+ if (argc >= 4)
+ objgen = atoi(argv[3]);
+ }
+ xref = doc->getXRef();
+ catalogDict.initNull();
+ xref->getCatalog(&catalogDict);
+ if (!catalogDict.isDict("Catalog")) {
+ fprintf(stderr, "No Catalog found\n");
+ exit(1);
+ }
+ srcStream.initNull();
+ if (objnum == 0) {
+ catalogDict.dictLookup("SourceObject", &srcStream);
+ if (!srcStream.isStream("SourceFile")) {
+ fprintf(stderr, "No SourceObject found\n");
+ exit(1);
+ }
+ srcName.initNull();
+ srcStream.getStream()->getDict()->lookup("SourceName", &srcName);
+ if (!srcName.isString()) {
+ fprintf(stderr, "No SourceName found\n");
+ exit(1);
+ }
+ outname = srcName.getString()->getCString();
+ // We cannot free srcName, as objname shares its string.
+ // srcName.free();
+ }
+ else {
+ xref->fetch(objnum, objgen, &srcStream);
+ if (!srcStream.isStream()) {
+ fprintf(stderr, "Not a Stream object\n");
+ exit(1);
+ }
+ sprintf(buf, "%s", fileName->getCString());
+ if ((p = strrchr(buf, '.')) == 0)
+ p = strchr(buf, 0);
+ if (objgen == 0)
+ sprintf(p, ".%i", objnum);
+ else
+ sprintf(p, ".%i+%i", objnum, objgen);
+ outname = buf;
+ }
+ if (!(outfile = fopen(outname, "wb"))) {
+ fprintf(stderr, "Cannot open file \"%s\" for writing\n", outname);
+ exit(1);
+ }
+ s = srcStream.getStream();
+ s->reset();
+ while ((c = s->getChar()) != EOF)
+ fputc(c, outfile);
+ if (objnum == 0)
+ fprintf(stderr, "Source file extracted to %s\n", outname);
+ else
+ fprintf(stderr, "Stream object extracted to %s\n", outname);
+ fclose(outfile);
+ catalogDict.free();
+ srcStream.free();
+ delete doc;
+ delete globalParams;
+}
diff --git a/Build/source/texk/web2c/pdftexdir/pdftosrc.rc b/Build/source/texk/web2c/pdftexdir/pdftosrc.rc
new file mode 100644
index 00000000000..6929fbade24
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftosrc.rc
@@ -0,0 +1,35 @@
+/* pdftosrc.rc: pdftosrc resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " pdftosrc 2.01"
+
+#define VER_INTERNALNAME_STR "pdftosrc"
+#define VER_ORIGINALFILENAME_STR "pdftosrc.exe"
+
+#define VER_FILEDESCRIPTION_STR "PDF Source Extractor"
+
+#define VER_COMPANYNAME_STR ""
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#include <texlive.version>
+
+/* pdftosrc.rc ends here */
diff --git a/Build/source/texk/web2c/pdftexdir/pkin.c b/Build/source/texk/web2c/pdftexdir/pkin.c
new file mode 100644
index 00000000000..3bece2124ad
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pkin.c
@@ -0,0 +1,427 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pkin.c#4 $
+*/
+
+/*
+ * NAME
+ * pkin.c - implementation of readchar()
+ * DESCRIPTION
+ * This implementation of readchar() uses parts of the program dvips
+ * written by Tomas Rokicki--the inventor of the pkformat--(loadfont.c,
+ * download.c and unpack.c). Dvips in turn is derived from pktype.
+ * Pktype(TeX) is described in debt in ``The PKtype processor'',
+ * which is available as pktype.weave as part of the METAFONTware.
+ * What was needed to implement readchar() is rearranged in pkfile.c to
+ * get more modularity in the style of MODULA2.
+ * BUGFIXES
+ * May 1997: Eric Delaunay <delaunay@lix.polytechnique.fr> reports a
+ * problem with huge fonts (greater than 1008 DPI). The code for
+ * handling PK characters in `extended format' was wrongly derived
+ * from dvips. Made some minor improvements regarding error handling.
+ * REDESIGN
+ * Piet Tutelaers
+ * rcpt@urc.tue.nl
+ *
+ * Modified for use with pdftex by Han The Thanh <thanh@fi.muni.cz>.
+ */
+
+#include "ptexlib.h"
+
+/*
+ * Now we have some routines to get stuff from the pk file. pkbyte returns
+ * the next byte from the pk file.
+ */
+
+
+/*
+static FILE *pkfile ;
+*/
+
+extern FILE *t3_file;
+#define pkfile t3_file
+
+static shalfword pkbyte(void)
+{
+ register shalfword i ;
+
+ if ((i=xgetc(pkfile))==EOF)
+ pdftex_fail("unexpected eof in pk file") ;
+ return(i) ;
+}
+
+static integer pkduo(void)
+{
+ register integer i ;
+
+ i = pkbyte() ;
+ if (i > 127)
+ i -= 256 ;
+ i = i * 256 + pkbyte() ;
+ return(i) ;
+}
+
+static integer pktrio(void)
+{
+ register integer i ;
+
+ i = pkbyte() ;
+ if (i > 127)
+ i -= 256 ;
+ i = i * 256 + pkbyte() ;
+ i = i * 256 + pkbyte() ;
+ return(i) ;
+}
+
+static integer pkquad(void)
+{
+ register integer i ;
+
+ i = pkbyte() ;
+ if (i > 127)
+ i -= 256 ;
+ i = i * 256 + pkbyte() ;
+ i = i * 256 + pkbyte() ;
+ i = i * 256 + pkbyte() ;
+ return(i) ;
+}
+
+/*
+ * The next part is devoted to unpacking the character data.
+ */
+
+/*
+ * We need procedures to get a nybble, bit, and packed word from the
+ * packed data structure.
+ */
+
+static halfword inputbyte, flagbyte ;
+static halfword bitweight ;
+static halfword dynf ;
+static halfword repeatcount ;
+
+static shalfword getnyb(void)
+{ halfword temp;
+ if ( bitweight == 0 )
+ { bitweight = 16 ;
+ inputbyte = pkbyte();
+ temp = inputbyte >> 4 ;
+ } else {
+ bitweight = 0 ;
+ temp = inputbyte & 15 ;
+ }
+ return(temp);
+}
+
+static boolean getbit(void)
+{
+ bitweight >>= 1 ;
+ if ( bitweight == 0 )
+ { inputbyte = pkbyte();
+ bitweight = 128 ;
+ }
+ return(inputbyte & bitweight) ;
+}
+
+static halfword (*realfunc)(void) ;
+long pk_remainder ;
+static halfword handlehuge(halfword i, halfword k);
+
+static halfword pkpackednum(void) {
+register halfword i, j ;
+ i = getnyb () ;
+ if ( i == 0 )
+ { do { j = getnyb () ;
+ i++ ;
+ } while ( ! ( j != 0 ) ) ;
+ if ( i > 3 ) {
+/*
+ * Damn, we got a huge count! We *fake* it by giving an artificially
+ * large repeat count.
+ */
+ return(handlehuge(i, j)) ;
+ } else {
+ while ( i > 0 )
+ { j = j * 16 + getnyb () ;
+ i-- ;
+ }
+ return ( j - 15 + ( 13 - dynf ) * 16 + dynf ) ;
+ }
+ }
+ else if ( i <= dynf ) return ( i ) ;
+ else if ( i < 14 ) return ( ( i - dynf - 1 ) * 16 + getnyb () + dynf + 1
+ ) ;
+ else
+ { if ( i == 14 ) repeatcount = pkpackednum () ;
+ else repeatcount = 1 ;
+#ifdef DEBUG
+ printf("[%d]", repeatcount);
+#endif
+ return ( (*realfunc)() ) ;
+ }
+ }
+
+static halfword rest(void)
+{
+ halfword i ;
+
+ if (pk_remainder < 0) {
+ pk_remainder = - pk_remainder ;
+ return ( 0 ) ;
+ } else if (pk_remainder > 0) {
+ if (pk_remainder > 4000) {
+ pk_remainder = 4000 - pk_remainder ;
+ return ( 4000 ) ;
+ } else {
+ i = pk_remainder ;
+ pk_remainder = 0 ;
+ realfunc = pkpackednum ;
+ return ( i ) ;
+ }
+ } else {
+ pdftex_fail("shouldn't happen") ;
+ return 0; /*NOTREACHED*/
+ }
+}
+
+static halfword handlehuge(halfword i, halfword k)
+{
+ register long j = k ;
+
+ while (i) {
+ j = (j << 4L) + getnyb() ;
+ i-- ;
+ }
+ pk_remainder = j - 15 + ( 13 - dynf ) * 16 + dynf ;
+ realfunc = rest ;
+ return ( rest() ) ;
+}
+
+/*
+ * And now we have our unpacking routine.
+ */
+
+static halfword gpower[17] = { 0, 1, 3, 7, 15, 31, 63, 127,
+ 255, 511, 1023, 2047, 4095, 8191, 16383, 32767, 65535 } ;
+
+static void unpack(chardesc *cd)
+{
+ register integer i, j ;
+ register halfword word, wordweight ;
+ halfword *raster;
+ shalfword rowsleft ;
+ boolean turnon ;
+ shalfword hbit ;
+ halfword count ;
+ shalfword wordwidth ;
+
+ wordwidth = (cd->cwidth + 15) / 16 ;
+ i = 2 * cd->cheight * (long)wordwidth ;
+ if (i <= 0)
+ i = 2 ;
+ if (i > cd->rastersize) {
+ xfree(cd->raster);
+ cd->rastersize = i;
+ cd->raster = xtalloc(cd->rastersize, halfword);
+ }
+ raster = cd->raster;
+ realfunc = pkpackednum ;
+ dynf = flagbyte / 16 ;
+ turnon = flagbyte & 8 ;
+ if ( dynf == 14 )
+ { bitweight = 0 ;
+ for ( i = 1 ; i <= cd->cheight ; i ++ )
+ { word = 0 ;
+ wordweight = 32768 ;
+ for ( j = 1 ; j <= cd->cwidth ; j ++ )
+ { if ( getbit () ) word += wordweight ;
+ wordweight >>= 1 ;
+ if ( wordweight == 0 )
+ { *raster++ = word ;
+ word = 0 ;
+ wordweight = 32768 ;
+ }
+ }
+ if ( wordweight != 32768 )
+ *raster++ = word ;
+ }
+ } else {
+ rowsleft = cd->cheight ;
+ hbit = cd->cwidth ;
+ repeatcount = 0 ;
+ wordweight = 16 ;
+ word = 0 ;
+ bitweight = 0 ;
+ while ( rowsleft > 0 )
+ { count = (*realfunc)() ;
+#ifdef DEBUG
+ if (turnon) printf("(%d) ",count);
+ else printf("%d ",count);
+#endif
+ while ( count != 0 )
+ { if ( ( count < wordweight ) && ( count < hbit ) )
+ { if ( turnon ) word += gpower [ wordweight ] - gpower
+ [ wordweight - count ] ;
+ hbit -= count ;
+ wordweight -= count ;
+ count = 0 ;
+ }
+ else if ( ( count >= hbit ) && ( hbit <= wordweight ) )
+ { if ( turnon )
+ word += gpower [ wordweight ] - gpower
+ [ wordweight - hbit ] ;
+ *raster++ = word ;
+ for ( i = 1 ; i <= repeatcount ; i ++ ) {
+ for ( j = 1 ; j <= wordwidth ; j ++ ) {
+ *raster = *(raster - wordwidth) ;
+ raster++ ;
+ }
+ }
+ rowsleft -= repeatcount + 1 ;
+ repeatcount = 0 ;
+ word = 0 ;
+ wordweight = 16 ;
+ count -= hbit ;
+ hbit = cd->cwidth ;
+ }
+ else
+ { if ( turnon ) word += gpower [ wordweight ] ;
+ *raster++ = word ;
+ word = 0 ;
+ count -= wordweight ;
+ hbit -= wordweight ;
+ wordweight = 16 ;
+ }
+ }
+ turnon = ! turnon ;
+ }
+ if ( ( rowsleft != 0 ) || ( (integer)hbit != cd->cwidth ) )
+ pdftex_fail("error while unpacking; more bits than required");
+ }
+}
+
+/*
+ * readchar(): the main routine
+ * Reads the character definition of character `c' into `cd' if available,
+ * return FALSE (0) otherwise.
+ */
+
+/*
+ * readchar(): the main routine
+ * check pk preamble if necessary,
+ * read the next character definition into `cd',
+ * return EOF if no character definition is available
+ */
+
+int readchar(boolean check_preamble, chardesc *cd)
+{
+ register shalfword i ;
+ register integer k ;
+ register integer length=0 ;
+
+/*
+ * Check the preamble of the pkfile
+ */
+ if (check_preamble) {
+ if (pkbyte()!=247)
+ pdftex_fail("bad pk file, expected pre") ;
+ if (pkbyte()!=89)
+ pdftex_fail("bad version of pk file") ;
+ for(i=pkbyte(); i>0; i--) /* creator of pkfile */
+ (void)pkbyte() ;
+ (void)pkquad(); /* design size */
+ k = pkquad() ; /* checksum */
+ k = pkquad() ; /* hppp */
+ k = pkquad() ; /* vppp */
+ }
+/*
+ * Now we skip to the desired character definition
+ */
+ while ((flagbyte=pkbyte())!=245) {
+ if (flagbyte < 240) {
+ switch (flagbyte & 7) {
+case 0: case 1: case 2: case 3:
+ length = (flagbyte & 7) * 256 + pkbyte() - 3;
+ cd->charcode = pkbyte() ;
+ (void) pktrio() ; /* TFMwidth */
+ cd->xescape = pkbyte() ; /* pixel width */
+ cd->cwidth = pkbyte() ;
+ cd->cheight = pkbyte() ;
+ cd->xoff = pkbyte() ;
+ cd->yoff = pkbyte() ;
+ if (cd->xoff > 127)
+ cd->xoff -= 256 ;
+ if (cd->yoff > 127)
+ cd->yoff -= 256 ;
+ break ;
+case 4: case 5: case 6:
+ length = (flagbyte & 3) * 65536L + pkbyte() * 256L ;
+ length = length + pkbyte() - 4L ;
+ cd->charcode = pkbyte() ;
+ (void) pktrio() ; /* TFMwidth */
+ cd->xescape = pkduo() ; /* pixelwidth */
+ cd->cwidth = pkduo() ;
+ cd->cheight = pkduo() ;
+ cd->xoff = pkduo() ;
+ cd->yoff = pkduo() ;
+ break ;
+case 7:
+ length = pkquad() - 9L;
+ cd->charcode = pkquad();
+ (void) pkquad() ; /* TFMwidth */
+ cd->xescape = pkquad(); /* pixelwidth */
+ k = pkquad() ;
+ cd->cwidth = pkquad();
+ cd->cheight = pkquad();
+ cd->xoff = pkquad();
+ cd->yoff = pkquad();
+ }
+ if (length <= 0)
+ pdftex_fail("packet length (%i) too small", (int)length) ;
+ unpack(cd);
+ return 1;
+ } else {
+ k = 0 ;
+ switch (flagbyte) {
+case 243:
+ k = pkbyte() ;
+ if (k > 127)
+ k -= 256 ;
+case 242:
+ k = k * 256 + pkbyte() ;
+case 241:
+ k = k * 256 + pkbyte() ;
+case 240:
+ k = k * 256 + pkbyte() ;
+ while (k-- > 0)
+ i = pkbyte() ;
+ break ;
+case 244:
+ k = pkquad() ;
+ break ;
+case 246:
+ break ;
+default:
+ pdftex_fail("unexpected command (%i)", (int)flagbyte) ;
+ }
+ }
+ }
+ return 0; /* character not found */
+}
diff --git a/Build/source/texk/web2c/pdftexdir/ptexlib.h b/Build/source/texk/web2c/pdftexdir/ptexlib.h
new file mode 100644
index 00000000000..90159001e39
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/ptexlib.h
@@ -0,0 +1,219 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/ptexlib.h#26 $
+*/
+
+#ifndef PDFTEXLIB
+#define PDFTEXLIB
+
+/* WEB2C macros and prototypes */
+#if !defined(PDFTEXCOERCE) && !defined(PDFETEXCOERCE)
+#ifdef pdfTeX
+#undef pdfTeX /* to avoid warning about redefining pdfTeX in pdftexd.h */
+#endif /* pdfTeX */
+#define EXTERN extern
+#include "pdftexd.h"
+#endif
+
+/* pdftexlib macros */
+#include "ptexmac.h"
+
+/* pdftexlib type declarations */
+typedef struct {
+ const char *pdfname;
+ const char *t1name;
+ float value;
+ boolean valid;
+} key_entry;
+
+typedef struct {
+ boolean loaded; /* the encoding has been loaded? */
+ char *name; /* encoding file name */
+ integer objnum; /* object number */
+ char **glyph_names;
+} enc_entry;
+
+typedef struct {
+ char *tfm_name; /* TFM file name */
+ char *ps_name; /* PostScript name */
+ integer flags; /* font flags */
+ char *ff_name; /* font file name */
+ char *subset_tag; /* pseudoUniqueTag for subsetted font */
+ enc_entry *encoding; /* pointer to corresponding encoding */
+ internalfontnumber tfm_num; /* number of the TFM refering this entry */
+ unsigned short type; /* font type (T1/TTF/...) */
+ short slant; /* SlantFont */
+ short extend; /* ExtendFont */
+ integer ff_objnum; /* FontFile object number */
+ integer fn_objnum; /* FontName/BaseName object number */
+ integer fd_objnum; /* FontDescriptor object number */
+ char *charset; /* string containing used glyphs */
+ boolean all_glyphs; /* embed all glyphs? */
+ unsigned short links; /* link flags from tfm_tree and ps_tree */
+ short tfm_avail; /* flags whether a tfm is available */
+} fm_entry;
+
+typedef struct {
+ char *ff_name; /* base name of font file */
+ char *ff_path; /* full path to font file */
+} ff_entry;
+
+typedef short shalfword ;
+typedef struct {
+ integer charcode,
+ cwidth,
+ cheight,
+ xoff,
+ yoff,
+ xescape,
+ rastersize;
+ halfword *raster;
+} chardesc;
+
+/* pdftexlib variable declarations */
+extern boolean fontfile_found;
+extern boolean is_otf_font;
+extern boolean true_dimen;
+extern boolean write_ttf_glyph_names;
+extern char **t1_glyph_names, *t1_builtin_glyph_names[];
+extern char *cur_file_name;
+extern const char notdef[];
+extern fm_entry *fm_cur;
+extern integer t1_length1, t1_length2, t1_length3;
+extern integer ttf_length;
+extern internalfontnumber tex_font;
+extern key_entry font_keys[];
+extern strnumber last_tex_string;
+extern size_t last_ptr_index;
+extern char fontname_buf[];
+
+/* pdftexlib function prototypes */
+
+/* epdf.c */
+extern integer get_fontfile_num(int);
+extern integer get_fontname_num(int);
+extern void epdf_free(void);
+
+/* mapfile.c */
+extern char *mk_basename(char *);
+extern char *mk_exname(char *, int);
+extern fm_entry * lookup_fontmap(char *);
+extern boolean hasfmentry(internalfontnumber);
+extern internalfontnumber tfmoffm(fmentryptr);
+extern void checkextfm(strnumber, integer);
+extern void fm_free(void);
+extern void fm_read_info(void);
+extern ff_entry * check_ff_exist(fm_entry *);
+extern void pdfmapfile(integer);
+extern void pdfmapline(integer);
+
+/* papersiz.c */
+extern integer myatodim(char **);
+extern integer myatol(char **);
+
+/* pkin.c */
+extern int readchar(boolean, chardesc *);
+
+/* utils.c */
+extern boolean str_eq_cstr(strnumber, char *);
+extern char *makecstring(integer);
+extern int xfflush(FILE *);
+extern int xgetc(FILE *);
+extern int xputc(int, FILE *);
+extern scaled extxnoverd(scaled, scaled, scaled);
+extern size_t xfwrite(void *, size_t size, size_t nmemb, FILE *);
+extern strnumber getresnameprefix(void);
+extern strnumber maketexstring(const char *);
+extern integer fb_offset(void);
+extern void fb_flush(void);
+extern void fb_putchar(eightbits b);
+extern void fb_seek(integer);
+extern void libpdffinish(void);
+extern char *makecfilename(strnumber s);
+extern void make_subset_tag(fm_entry *, char **);
+extern void pdf_printf(const char *,...);
+extern void pdf_puts(const char *);
+extern void pdftex_fail(const char *,...);
+extern void pdftex_warn(const char *,...);
+extern void setjobid(int, int, int, int, int, int);
+extern void tex_printf(const char *, ...);
+extern void writestreamlength(integer, integer);
+extern char *convertStringToPDFString(char *in, int len);
+extern void printID(strnumber);
+
+/* vfpacket.c */
+extern eightbits packetbyte(void);
+extern integer newvfpacket(internalfontnumber);
+extern void poppacketstate(void);
+extern void pushpacketstate(void);
+extern void startpacket(internalfontnumber, integer);
+extern void storepacket(integer, integer, integer);
+extern void vf_free(void);
+
+/* writeenc.c */
+extern boolean indexed_enc(fm_entry *);
+extern enc_entry *add_enc(char *);
+extern void enc_free(void);
+extern void read_enc(enc_entry *);
+extern void write_enc(char **, enc_entry *, integer);
+
+/* writefont.c */
+extern void dopdffont(integer, internalfontnumber);
+
+/* writeimg.c */
+extern boolean checkimageb(integer);
+extern boolean checkimagec(integer);
+extern boolean checkimagei(integer);
+extern boolean ispdfimage(integer);
+extern integer epdforigx(integer);
+extern integer epdforigy(integer);
+extern integer imageheight(integer);
+extern integer imagepages(integer);
+extern integer imagewidth(integer);
+extern integer imagexres(integer);
+extern integer imageyres(integer);
+extern integer readimage(strnumber, integer, strnumber, integer, integer, integer, integer);
+extern void deleteimage(integer);
+extern void img_free(void) ;
+extern void updateimageprocset(integer);
+extern void writeimage(integer);
+
+/* writet1.c */
+extern boolean t1_subset(char *, char *, unsigned char *);
+extern void load_enc(char *, char **);
+extern void writet1(void);
+extern void t1_free(void);
+
+/* writet3.c */
+extern void writet3(int, internalfontnumber);
+extern scaled getpkcharwidth(internalfontnumber, scaled);
+
+/* writettf.c */
+extern void writettf(void);
+extern void writeotf(void);
+
+/* writezip.c */
+extern void writezip(boolean);
+
+/* avlstuff.c */
+extern void avlputobj(integer, integer);
+extern integer avlfindobj(integer, integer, integer);
+
+#endif /* PDFTEXLIB */
diff --git a/Build/source/texk/web2c/pdftexdir/ptexmac.h b/Build/source/texk/web2c/pdftexdir/ptexmac.h
new file mode 100644
index 00000000000..ed6ebe7d9be
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/ptexmac.h
@@ -0,0 +1,196 @@
+/*
+Copyright (c) 1996-2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/ptexmac.h#18 $
+*/
+
+#ifndef PDFTEXMAC
+#define PDFTEXMAC
+
+/* Not all systems define it. */
+#ifndef M_PI
+#define M_PI 3.14159265358979323846 /* pi */
+#define M_PI_2 1.5707963267948966192E0 /*Hex 2^ 0 * 1.921FB54442D18 */
+#define M_PI_4 7.8539816339744830962E-1 /*Hex 2^-1 * 1.921FB54442D18 */
+#endif
+
+#ifdef WIN32
+// Why relying on gmalloc() ???
+#define gmalloc(n) xmalloc(n)
+#define gfree(p) free(p)
+#define inline __inline
+#define srandom(n) srand(n)
+#define random() rand()
+#endif
+
+/* Pascal WEB macros */
+#define maxinteger 0x7FFFFFFF
+#define maxdimen 0x3FFFFFFF
+
+#define objinfo(n) objtab[n].int0
+
+#define pdfroom(n) do { \
+ if (pdfbufsize < n) \
+ pdftex_fail("PDF output buffer overflowed"); \
+ if (pdfptr + n > pdfbufsize) \
+ pdfflush(); \
+} while (0)
+
+#define pdfout(c) do { \
+ if (pdfptr > pdfbufsize) \
+ pdfflush(); \
+ pdfbuf[pdfptr++] = c; \
+} while (0)
+
+#define pdfoffset() (pdfgone + pdfptr)
+#define pdfinitfont(f) {tmpf = f; pdfcreatefontobj();}
+
+#define MAX_CHAR_CODE 255
+
+#define PRINTF_BUF_SIZE 1024
+#define MAX_CSTRING_LEN 1024
+#define MAX_PSTRING_LEN 1024
+#define SMALL_BUF_SIZE 256
+#define SMALL_ARRAY_SIZE 256
+#define FONTNAME_BUF_SIZE 128 /* a PDF name can be maximum 127 chars long */
+
+#define check_buf(size, buf_size) \
+ if ((size) > (buf_size)) \
+ pdftex_fail("buffer overflow", (buf_size))
+
+#define append_char_to_buf(c, p, buf, buf_size) do { \
+ if (c == 9) \
+ c = 32; \
+ if (c == 13 || c == EOF) \
+ c = 10; \
+ if (c != ' ' || (p > buf && p[-1] != 32)) { \
+ check_buf(p - buf + 1, (buf_size)); \
+ *p++ = c; \
+ } \
+} while (0)
+
+#define append_eol(p, buf, buf_size) do { \
+ check_buf(p - buf + 2, (buf_size)); \
+ if (p - buf > 1 && p[-1] != 10) \
+ *p++ = 10; \
+ if (p - buf > 2 && p[-2] == 32) { \
+ p[-2] = 10; \
+ p--; \
+ } \
+ *p = 0; \
+} while (0)
+
+#define remove_eol(p, buf) do { \
+ p = strend(buf) - 1; \
+ if (*p == 10) \
+ *p = 0; \
+} while (0)
+
+#define skip(p, c) if (*p == c) p++
+
+#define alloc_array(T, n, s) do { \
+ if (T##_array == NULL) { \
+ T##_limit = (s); \
+ if ((n) > T##_limit) \
+ T##_limit = (n); \
+ T##_array = xtalloc(T##_limit, T##_entry); \
+ T##_ptr = T##_array; \
+ } \
+ else if (T##_ptr - T##_array + (n) > T##_limit) { \
+ last_ptr_index = T##_ptr - T##_array; \
+ T##_limit *= 2; \
+ if (T##_ptr - T##_array + (n) > T##_limit) \
+ T##_limit = T##_ptr - T##_array + (n); \
+ xretalloc(T##_array, T##_limit, T##_entry); \
+ T##_ptr = T##_array + last_ptr_index; \
+ } \
+} while (0)
+
+#define is_cfg_comment(c) \
+ (c == 10 || c == '*' || c == '#' || c == ';' || c == '%')
+
+#define define_array(T) \
+T##_entry *T##_ptr, *T##_array = NULL; \
+size_t T##_limit
+
+#define xfree(p) do { if (p != NULL) free(p); p = NULL; } while (0)
+#define strend(s) strchr(s, 0)
+#define xtalloc XTALLOC
+#define xretalloc XRETALLOC
+
+#define ASCENT_CODE 0
+#define CAPHEIGHT_CODE 1
+#define DESCENT_CODE 2
+#define FONTNAME_CODE 3
+#define ITALIC_ANGLE_CODE 4
+#define STEMV_CODE 5
+#define XHEIGHT_CODE 6
+#define FONTBBOX1_CODE 7
+#define FONTBBOX2_CODE 8
+#define FONTBBOX3_CODE 9
+#define FONTBBOX4_CODE 10
+#define MAX_KEY_CODE (FONTBBOX1_CODE + 1)
+#define FONT_KEYS_NUM (FONTBBOX4_CODE + 1)
+
+#define F_INCLUDED 0x01
+#define F_SUBSETTED 0x02
+#define F_TRUETYPE 0x04
+#define F_BASEFONT 0x08
+
+#define set_included(fm) ((fm)->type |= F_INCLUDED)
+#define set_subsetted(fm) ((fm)->type |= F_SUBSETTED)
+#define set_truetype(fm) ((fm)->type |= F_TRUETYPE)
+#define set_basefont(fm) ((fm)->type |= F_BASEFONT)
+
+#define unset_included(fm) ((fm)->type &= ~F_INCLUDED)
+#define unset_subsetted(fm) ((fm)->type &= ~F_SUBSETTED)
+#define unset_truetype(fm) ((fm)->type &= ~F_TRUETYPE)
+#define unset_basefont(fm) ((fm)->type &= ~F_BASEFONT)
+
+#define unset_fontfile(fm) xfree((fm)->ff_name)
+
+#define is_included(fm) ((fm)->type & F_INCLUDED)
+#define is_subsetted(fm) ((fm)->type & F_SUBSETTED)
+#define is_truetype(fm) ((fm)->type & F_TRUETYPE)
+#define is_basefont(fm) ((fm)->type & F_BASEFONT)
+#define no_font_desc(fm) (is_basefont(fm) && !is_included(fm))
+
+#define fm_slant(fm) (fm)->slant
+#define fm_extend(fm) (fm)->extend
+#define fm_fontfile(fm) (fm)->ff_name
+
+#define is_reencoded(fm) ((fm)->encoding != NULL)
+#define is_fontfile(fm) (fm_fontfile(fm) != NULL)
+#define is_t1fontfile(fm) (is_fontfile(fm) && !is_truetype(fm))
+
+#define LINK_TFM 0x01
+#define LINK_PS 0x02
+#define set_tfmlink(fm) ((fm)->links |= LINK_TFM)
+#define set_pslink(fm) ((fm)->links |= LINK_PS)
+#define unset_tfmlink(fm) ((fm)->links &= ~LINK_TFM)
+#define unset_pslink(fm) ((fm)->links &= ~LINK_PS)
+#define has_tfmlink(fm) ((fm)->links & LINK_TFM)
+#define has_pslink(fm) ((fm)->links & LINK_PS)
+
+
+#define set_cur_file_name(s) \
+ cur_file_name = s; \
+ packfilename(maketexstring(cur_file_name), getnullstr(), getnullstr())
+
+#endif /* PDFTEXMAC */
diff --git a/Build/source/texk/web2c/pdftexdir/randoms.ch b/Build/source/texk/web2c/pdftexdir/randoms.ch
new file mode 100644
index 00000000000..2268143406d
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/randoms.ch
@@ -0,0 +1,569 @@
+% randoms.ch
+% Copyright (c) 2005 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftex.ch#163 $
+%
+% This is a WEB change file for pseudo-random numbers in pdftex 1.30 and above.
+%
+% There are four new primitives:
+%
+% \pdfuniformdeviate <count>
+% Generates a uniformly distributed random integer value
+% between 0 (inclusive) and <count> (exclusive).
+% This primitive expands to a list of tokens.
+%
+% \pdfnormaldeviate
+% Expands to a random integer value with a mean of 0 and a
+% unit of 65536.
+% This primitive expands to a list of tokens.
+%
+% \pdfrandomseed
+% You can use \the\pdfrandomseed to query the current seed value,
+% so you can e.g. the value to the log file.
+%
+% The initial value of the seed is derived from the system time,
+% and is not more than 1,000,999,999 (this ensures that the value
+% can be used with commands like \count).
+%
+% \pdfsetrandomseed <count>
+% This sets the random seed to a specific value, allowing you
+% to re-play sequences of semi-randoms at a later moment.
+%
+% Most of the actual code is taken from metapost, and originally
+% written by Knuth, for Metafont. Glue to make it work in TeX is
+% by me. If you find an error, it is bound to be in my code,
+% not Knuth's :-)
+%
+% Taco Hoekwater (taco@metatex.org), june 27, 2005. No restrictions.
+
+@x
+@* \[8] Packed data.
+@y
+@* \[7b] Random numbers.
+
+\font\tenlogo=logo10 % font used for the METAFONT logo
+\def\MP{{\tenlogo META}\-{\tenlogo POST}}
+
+This section is (almost) straight from MetaPost. I had to change
+the types (use |integer| instead of |fraction|), but that should
+not have any influence on the actual calculations (the original
+comments refer to quantities like |fraction_four| ($2^{30}$), and
+that is the same as the numeric representation of |maxdimen|).
+
+I've copied the low-level variables and routines that are needed, but
+only those (e.g. |m_log|), not the accompanying ones like |m_exp|. Most
+of the following low-level numeric routines are only needed within the
+calculation of |norm_rand|. I've been forced to rename |make_fraction|
+to |make_frac| because TeX already has a routine by that name with
+a wholly different function (it creates a |fraction_noad| for math
+typesetting) -- Taco
+
+And now let's complete our collection of numeric utility routines
+by considering random number generation.
+\MP\ generates pseudo-random numbers with the additive scheme recommended
+in Section 3.6 of {\sl The Art of Computer Programming}; however, the
+results are random fractions between 0 and |fraction_one-1|, inclusive.
+
+There's an auxiliary array |randoms| that contains 55 pseudo-random
+fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod 2^{28}$,
+we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
+The global variable |j_random| tells which element has most recently
+been consumed.
+
+@<Glob...@>=
+@!randoms:array[0..54] of integer; {the last 55 random values generated}
+@!j_random:0..54; {the number of unused |randoms|}
+@!random_seed:scaled; {the default random seed}
+
+@ A small bit of metafont is needed.
+
+@d fraction_half==@'1000000000 {$2^{27}$, represents 0.50000000}
+@d fraction_one==@'2000000000 {$2^{28}$, represents 1.00000000}
+@d fraction_four==@'10000000000 {$2^{30}$, represents 4.00000000}
+@d el_gordo == @'17777777777 {$2^{31}-1$, the largest value that \MP\ likes}
+@d halfp(#)==(#) div 2
+@d double(#) == #:=#+# {multiply a variable by two}
+
+@ The |make_frac| routine produces the |fraction| equivalent of
+|p/q|, given integers |p| and~|q|; it computes the integer
+$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are
+positive. If |p| and |q| are both of the same scaled type |t|,
+the ``type relation'' |make_frac(t,t)=fraction| is valid;
+and it's also possible to use the subroutine ``backwards,'' using
+the relation |make_frac(t,fraction)=t| between scaled types.
+
+If the result would have magnitude $2^{31}$ or more, |make_frac|
+sets |arith_error:=true|. Most of \MP's internal computations have
+been designed to avoid this sort of error.
+
+If this subroutine were programmed in assembly language on a typical
+machine, we could simply compute |(@t$2^{28}$@>*p)div q|, since a
+double-precision product can often be input to a fixed-point division
+instruction. But when we are restricted to \PASCAL\ arithmetic it
+is necessary either to resort to multiple-precision maneuvering
+or to use a simple but slow iteration. The multiple-precision technique
+would be about three times faster than the code adopted here, but it
+would be comparatively long and tricky, involving about sixteen
+additional multiplications and divisions.
+
+This operation is part of \MP's ``inner loop''; indeed, it will
+consume nearly 10\pct! of the running time (exclusive of input and output)
+if the code below is left unchanged. A machine-dependent recoding
+will therefore make \MP\ run faster. The present implementation
+is highly portable, but slow; it avoids multiplication and division
+except in the initial stage. System wizards should be careful to
+replace it with a routine that is guaranteed to produce identical
+results in all cases.
+@^system dependencies@>
+
+As noted below, a few more routines should also be replaced by machine-dependent
+code, for efficiency. But when a procedure is not part of the ``inner loop,''
+such changes aren't advisable; simplicity and robustness are
+preferable to trickery, unless the cost is too high.
+@^inner loop@>
+
+@p function make_frac(@!p,@!q:integer):integer;
+var @!f:integer; {the fraction bits, with a leading 1 bit}
+@!n:integer; {the integer part of $\vert p/q\vert$}
+@!negative:boolean; {should the result be negated?}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin if p>=0 then negative:=false
+else begin negate(p); negative:=true;
+ end;
+if q<=0 then
+ begin debug if q=0 then confusion("/");@;@+gubed@;@/
+@:this can't happen /}{\quad \./@>
+ negate(q); negative:=not negative;
+ end;
+n:=p div q; p:=p mod q;
+if n>=8 then
+ begin arith_error:=true;
+ if negative then make_frac:=-el_gordo@+else make_frac:=el_gordo;
+ end
+else begin n:=(n-1)*fraction_one;
+ @<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>;
+ if negative then make_frac:=-(f+n)@+else make_frac:=f+n;
+ end;
+end;
+
+@ The |repeat| loop here preserves the following invariant relations
+between |f|, |p|, and~|q|:
+(i)~|0<=p<q|; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and
+$p_0$ is the original value of~$p$.
+
+Notice that the computation specifies
+|(p-q)+p| instead of |(p+p)-q|, because the latter could overflow.
+Let us hope that optimizing compilers do not miss this point; a
+special variable |be_careful| is used to emphasize the necessary
+order of computation. Optimizing compilers should keep |be_careful|
+in a register, not store it in memory.
+@^inner loop@>
+
+@<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>=
+f:=1;
+repeat be_careful:=p-q; p:=be_careful+p;
+if p>=0 then f:=f+f+1
+else begin double(f); p:=p+q;
+ end;
+until f>=fraction_one;
+be_careful:=p-q;
+if be_careful+p>=0 then incr(f)
+
+@
+
+@p function take_frac(@!q:integer;@!f:integer):integer;
+var @!p:integer; {the fraction so far}
+@!negative:boolean; {should the result be negated?}
+@!n:integer; {additional multiple of $q$}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin @<Reduce to the case that |f>=0| and |q>0|@>;
+if f<fraction_one then n:=0
+else begin n:=f div fraction_one; f:=f mod fraction_one;
+ if q<=el_gordo div n then n:=n*q
+ else begin arith_error:=true; n:=el_gordo;
+ end;
+ end;
+f:=f+fraction_one;
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>;
+be_careful:=n-el_gordo;
+if be_careful+p>0 then
+ begin arith_error:=true; n:=el_gordo-p;
+ end;
+if negative then take_frac:=-(n+p)
+else take_frac:=n+p;
+end;
+
+@ @<Reduce to the case that |f>=0| and |q>0|@>=
+if f>=0 then negative:=false
+else begin negate(f); negative:=true;
+ end;
+if q<0 then
+ begin negate(q); negative:=not negative;
+ end;
+
+@ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor
+=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and
+$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$.
+@^inner loop@>
+
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>=
+p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$}
+if q<fraction_four then
+ repeat if odd(f) then p:=halfp(p+q)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+else repeat if odd(f) then p:=p+halfp(q-p)@+else p:=halfp(p);
+ f:=halfp(f);
+ until f=1
+
+@ The subroutines for logarithm and exponential involve two tables.
+The first is simple: |two_to_the[k]| equals $2^k$. The second involves
+a bit more calculation, which the author claims to have done correctly:
+|spec_log[k]| is $2^{27}$ times $\ln\bigl(1/(1-2^{-k})\bigr)=
+2^{-k}+{1\over2}2^{-2k}+{1\over3}2^{-3k}+\cdots\,$, rounded to the
+nearest integer.
+
+@<Glob...@>=
+@!two_to_the:array[0..30] of integer; {powers of two}
+@!spec_log:array[1..28] of integer; {special logarithms}
+
+
+@ @<Set init...@>=
+two_to_the[0]:=1;
+for k:=1 to 30 do two_to_the[k]:=2*two_to_the[k-1];
+spec_log[1]:=93032640;
+spec_log[2]:=38612034;
+spec_log[3]:=17922280;
+spec_log[4]:=8662214;
+spec_log[5]:=4261238;
+spec_log[6]:=2113709;
+spec_log[7]:=1052693;
+spec_log[8]:=525315;
+spec_log[9]:=262400;
+spec_log[10]:=131136;
+spec_log[11]:=65552;
+spec_log[12]:=32772;
+spec_log[13]:=16385;
+for k:=14 to 27 do spec_log[k]:=two_to_the[27-k];
+spec_log[28]:=1;
+
+@
+
+@p function m_log(@!x:integer):integer;
+var @!y,@!z:integer; {auxiliary registers}
+@!k:integer; {iteration counter}
+begin if x<=0 then @<Handle non-positive logarithm@>
+else begin y:=1302456956+4-100; {$14\times2^{27}\ln2\approx1302456956.421063$}
+ z:=27595+6553600; {and $2^{16}\times .421063\approx 27595$}
+ while x<fraction_four do
+ begin double(x); y:=y-93032639; z:=z-48782;
+ end; {$2^{27}\ln2\approx 93032639.74436163$
+ and $2^{16}\times.74436163\approx 48782$}
+ y:=y+(z div unity); k:=2;
+ while x>fraction_four+4 do
+ @<Increase |k| until |x| can be multiplied by a
+ factor of $2^{-k}$, and adjust $y$ accordingly@>;
+ m_log:=y div 8;
+ end;
+end;
+
+@ @<Increase |k| until |x| can...@>=
+begin z:=((x-1) div two_to_the[k])+1; {$z=\lceil x/2^k\rceil$}
+while x<fraction_four+z do
+ begin z:=halfp(z+1); k:=k+1;
+ end;
+y:=y+spec_log[k]; x:=x-z;
+end
+
+@ @<Handle non-positive logarithm@>=
+begin print_err("Logarithm of ");
+@.Logarithm...replaced by 0@>
+print_scaled(x); print(" has been replaced by 0");
+help2("Since I don't take logs of non-positive numbers,")@/
+ ("I'm zeroing this one. Proceed, with fingers crossed.");
+error; m_log:=0;
+end
+
+@ The following somewhat different subroutine tests rigorously if $ab$ is
+greater than, equal to, or less than~$cd$,
+given integers $(a,b,c,d)$. In most cases a quick decision is reached.
+The result is $+1$, 0, or~$-1$ in the three respective cases.
+
+@d return_sign(#)==begin ab_vs_cd:=#; return;
+ end
+
+@p function ab_vs_cd(@!a,b,c,d:integer):integer;
+label exit;
+var @!q,@!r:integer; {temporary registers}
+begin @<Reduce to the case that |a,c>=0|, |b,d>0|@>;
+loop@+ begin q := a div d; r := c div b;
+ if q<>r then
+ if q>r then return_sign(1)@+else return_sign(-1);
+ q := a mod d; r := c mod b;
+ if r=0 then
+ if q=0 then return_sign(0)@+else return_sign(1);
+ if q=0 then return_sign(-1);
+ a:=b; b:=q; c:=d; d:=r;
+ end; {now |a>d>0| and |c>b>0|}
+exit:end;
+
+@ @<Reduce to the case that |a...@>=
+if a<0 then
+ begin negate(a); negate(b);
+ end;
+if c<0 then
+ begin negate(c); negate(d);
+ end;
+if d<=0 then
+ begin if b>=0 then
+ if ((a=0)or(b=0))and((c=0)or(d=0)) then return_sign(0)
+ else return_sign(1);
+ if d=0 then
+ if a=0 then return_sign(0)@+else return_sign(-1);
+ q:=a; a:=c; c:=q; q:=-b; b:=-d; d:=q;
+ end
+else if b<=0 then
+ begin if b<0 then if a>0 then return_sign(-1);
+ if c=0 then return_sign(0) else return_sign(-1);
+ end
+
+@ To consume a random integer, the program below will say `|next_random|'
+and then it will fetch |randoms[j_random]|.
+
+@d next_random==if j_random=0 then new_randoms
+ else decr(j_random)
+
+@p procedure new_randoms;
+var @!k:0..54; {index into |randoms|}
+@!x:integer; {accumulator}
+begin for k:=0 to 23 do
+ begin x:=randoms[k]-randoms[k+31];
+ if x<0 then x:=x+fraction_one;
+ randoms[k]:=x;
+ end;
+for k:=24 to 54 do
+ begin x:=randoms[k]-randoms[k-24];
+ if x<0 then x:=x+fraction_one;
+ randoms[k]:=x;
+ end;
+j_random:=54;
+end;
+
+@ To initialize the |randoms| table, we call the following routine.
+
+@p procedure init_randoms(@!seed:integer);
+var @!j,@!jj,@!k:integer; {more or less random integers}
+@!i:0..54; {index into |randoms|}
+begin j:=abs(seed);
+while j>=fraction_one do j:=halfp(j);
+k:=1;
+for i:=0 to 54 do
+ begin jj:=k; k:=j-k; j:=jj;
+ if k<0 then k:=k+fraction_one;
+ randoms[(i*21)mod 55]:=j;
+ end;
+new_randoms; new_randoms; new_randoms; {``warm up'' the array}
+end;
+
+@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x|
+or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
+
+Note that the call of |take_frac| will produce the values 0 and~|x|
+with about half the probability that it will produce any other particular
+values between 0 and~|x|, because it rounds its answers.
+
+@p function unif_rand(@!x:integer):integer;
+var @!y:integer; {trial value}
+begin next_random; y:=take_frac(abs(x),randoms[j_random]);
+if y=abs(x) then unif_rand:=0
+else if x>0 then unif_rand:=y
+else unif_rand:=-y;
+end;
+
+@ Finally, a normal deviate with mean zero and unit standard deviation
+can readily be obtained with the ratio method (Algorithm 3.4.1R in
+{\sl The Art of Computer Programming\/}).
+
+@p function norm_rand:integer;
+var @!x,@!u,@!l:integer; {what the book would call $2^{16}X$, $2^{28}U$,
+ and $-2^{24}\ln U$}
+begin repeat
+ repeat next_random;
+ x:=take_frac(112429,randoms[j_random]-fraction_half);
+ {$2^{16}\sqrt{8/e}\approx 112428.82793$}
+ next_random; u:=randoms[j_random];
+ until abs(x)<u;
+x:=make_frac(x,u);
+l:=139548960-m_log(u); {$2^{24}\cdot12\ln2\approx139548959.6165$}
+until ab_vs_cd(1024,l,x,x)>=0;
+norm_rand:=x;
+end;
+
+@* \[8] Packed data.
+@z
+
+@x l.388
+@d pdftex_last_item_codes = pdftex_first_rint_code + 11 {end of \pdfTeX's command codes}
+@y
+@d random_seed_code = pdftex_first_rint_code + 12 {code for \.{\\pdfrandomseed}}
+@d pdftex_last_item_codes = pdftex_first_rint_code + 12 {end of \pdfTeX's command codes}
+@z
+
+@x l.417
+primitive("pdfelapsedtime",last_item,elapsed_time_code);
+@!@:elapsed_time_}{\.{\\pdfelapsedtime} primitive@>
+@y
+primitive("pdfelapsedtime",last_item,elapsed_time_code);
+@!@:elapsed_time_}{\.{\\pdfelapsedtime} primitive@>
+primitive("pdfrandomseed",last_item,random_seed_code);
+@!@:random_seed_}{\.{\\pdfrandomseed} primitive@>
+@z
+
+@x l.434
+ elapsed_time_code: print_esc("pdfelapsedtime");
+@y
+ elapsed_time_code: print_esc("pdfelapsedtime");
+ random_seed_code: print_esc("pdfrandomseed");
+@z
+
+@x l.461
+ elapsed_time_code: cur_val := get_microinterval;
+@y
+ elapsed_time_code: cur_val := get_microinterval;
+ random_seed_code: cur_val := random_seed;
+@z
+
+@x
+@d pdftex_convert_codes = pdftex_first_expand_code + 21 {end of \pdfTeX's command codes}
+@y
+@d uniform_deviate_code = pdftex_first_expand_code + 21 {end of \pdfTeX's command codes}
+@d normal_deviate_code = pdftex_first_expand_code + 22 {end of \pdfTeX's command codes}
+@d pdftex_convert_codes = pdftex_first_expand_code + 23 {end of \pdfTeX's command codes}
+@z
+
+@x
+primitive("jobname",convert,job_name_code);@/
+@y
+primitive("pdfuniformdeviate",convert,uniform_deviate_code);@/
+@!@:uniform_deviate_}{\.{\\pdfuniformdeviate} primitive@>
+primitive("pdfnormaldeviate",convert,normal_deviate_code);@/
+@!@:normal_deviate_}{\.{\\pdfnormaldeviate} primitive@>
+primitive("jobname",convert,job_name_code);@/
+@z
+
+@x
+ othercases print_esc("jobname")
+@y
+ uniform_deviate_code: print_esc("pdfuniformdeviate");
+ normal_deviate_code: print_esc("pdfnormaldeviate");
+ othercases print_esc("jobname")
+@z
+
+@x
+pdf_strcmp_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ compare_strings;
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ end;
+job_name_code: if job_name=0 then open_log_file;
+@y
+pdf_strcmp_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ compare_strings;
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ end;
+job_name_code: if job_name=0 then open_log_file;
+uniform_deviate_code: scan_int;
+normal_deviate_code: do_nothing;
+@z
+
+@x
+job_name_code: print(job_name);
+@y
+uniform_deviate_code: print_int(unif_rand(cur_val));
+normal_deviate_code: print_int(norm_rand);
+job_name_code: print(job_name);
+@z
+
+
+@x
+@<Compute the magic offset@>;
+@y
+random_seed :=(microseconds*1000)+(epochseconds mod 1000000);@/
+init_randoms(random_seed);@/
+@<Compute the magic offset@>;
+@z
+
+@x l. 4562
+@d pdftex_last_extension_code == pdftex_first_extension_code + 25
+@y
+@d set_random_seed_code == pdftex_first_extension_code + 26
+@d pdftex_last_extension_code == pdftex_first_extension_code + 26
+@z
+
+@x l.4625
+primitive("pdfresettimer",extension,reset_timer_code);@/
+@!@:reset_timer_}{\.{\\pdfresettimer} primitive@>
+@y
+primitive("pdfresettimer",extension,reset_timer_code);@/
+@!@:reset_timer_}{\.{\\pdfresettimer} primitive@>
+primitive("pdfsetrandomseed",extension,set_random_seed_code);@/
+@!@:set_random_seed_code}{\.{\\pdfsetrandomseed} primitive@>
+@z
+
+@x
+ reset_timer_code: print_esc("pdfresettimer");
+@y
+ reset_timer_code: print_esc("pdfresettimer");
+ set_random_seed_code: print_esc("pdfsetrandomseed");
+@z
+
+@x
+reset_timer_code: @<Implement \.{\\pdfresettimer}@>;
+@y
+reset_timer_code: @<Implement \.{\\pdfresettimer}@>;
+set_random_seed_code: @<Implement \.{\\pdfsetrandomseed}@>;
+@z
+
+@x
+@ @<Implement \.{\\pdfresettimer}@>=
+@y
+@ Negative random seed values are silently converted to positive ones
+
+@<Implement \.{\\pdfsetrandomseed}@>=
+begin
+ scan_int;
+ if cur_val<0 then negate(cur_val);
+ random_seed := cur_val;
+ init_randoms(random_seed);
+end
+
+@ @<Implement \.{\\pdfresettimer}@>=
+@z
+
diff --git a/Build/source/texk/web2c/pdftexdir/tex.ch0 b/Build/source/texk/web2c/pdftexdir/tex.ch0
new file mode 100644
index 00000000000..f3c0b93fa80
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/tex.ch0
@@ -0,0 +1,42 @@
+%
+% Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/tex.ch0#10 $
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one comes first, resolves inconsistencies between the generated
+% pdftex.web and tex.ch
+
+@x [1.2] l.188
+@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@#
+@d banner==pdfTeX_banner
+@y
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@z
+
+@x [17.236] l.4960 - first web2c, then pdfTeX additional integer parameters
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@#
+@d pdftex_first_integer_code = tex_int_pars {base for \pdfTeX's integer parameters}
+@y
+@d int_pars=55 {total number of integer parameters}
+@#
+@d pdftex_first_integer_code = tex_int_pars {base for \pdfTeX's integer parameters}
+@z
diff --git a/Build/source/texk/web2c/pdftexdir/tex.ch1 b/Build/source/texk/web2c/pdftexdir/tex.ch1
new file mode 100644
index 00000000000..172e2a6668b
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/tex.ch1
@@ -0,0 +1,39 @@
+%
+% Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/tex.ch1#11 $
+%
+% Change file to assist in creating the web2c-specific change file.
+% This one resolves inconsistencies between tex.ch and tex.pch.
+
+@x [1] m.2 l.188 - banner
+@d banner==TeX_banner
+@d banner_k==TeX_banner_k
+@y
+@d banner==pdfTeX_banner
+@d banner_k==pdfTeX_banner_k
+@z
+
+@x [17.236] l.4960 - first web2c, then pdfTeX additional integer parameters
+@d int_pars=web2c_int_pars {total number of integer parameters}
+@#
+@d pdftex_first_integer_code = tex_int_pars {base for \pdfTeX's integer parameters}
+@y
+@d pdftex_first_integer_code = web2c_int_pars {base for \pdfTeX's integer parameters}
+@z
diff --git a/Build/source/texk/web2c/pdftexdir/tex.pch b/Build/source/texk/web2c/pdftexdir/tex.pch
new file mode 100644
index 00000000000..ca78e387dd5
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/tex.pch
@@ -0,0 +1,355 @@
+% Copyright (c) 1996-2005 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% Note: This file, pdftexdir/tex.pch, contains the web2c changes for the
+% pdfTeX specific part of pdftex.web (defined in pdftexdir/pdftex.ch)
+% and is used as follows to construct the web2c change file for pdfTeX:
+%
+% pdftexdir/tex.ch0 )
+% + )
+% tex.ch )
+% + ) => tie -c ... => pdftex.ch
+% pdftexdir/tex.ch1 )
+% + )
+% pdftexdir/tex.pch )
+%
+% In addition, this file is used to construct the web2c change file
+% for pdfeTeX:
+%
+% pdfetexdir/tex.ch0 )
+% + )
+% tex.ch )
+% + )
+% etexdir/tex.ch1 )
+% + ) => tie -c ... => pdfetex.ch
+% etexdir/tex.ech )
+% + )
+% pdfetexdir/tex.ch1 )
+% + )
+% pdftexdir/tex.pch )
+%
+% where the four (small) files pdf{,e}texdir/tex.ch[01] take care
+% of interferences between web2c, e-Tex, pdfTeX changes.
+% Consequently, changes in all these files have to be coordinated.
+
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/tex.pch#26 $
+% Change file containing web2c-specific or system-dependent changes to
+% pdftex
+
+@x [1] m.2 l.188 - Web2C: extensions imply we're not pdfTeX
+@d pdfTeX_banner=='This is pdfTeX, Version 3.141592',pdftex_version_string
+@y
+@d pdfTeX_banner_k=='This is pdfTeXk, Version 3.141592',pdftex_version_string
+@d pdfTeX_banner=='This is pdfTeX, Version 3.141592',pdftex_version_string
+@z
+
+@x (MLTeX)
+ begin i := char_tag(char_info(f)(c));
+@y
+ begin i := char_tag(orig_char_info(f)(c));
+@z
+
+@x (MLTeX)
+@d is_valid_char(#)==((font_bc[f] <= #) and (# <= font_ec[f]) and
+ char_exists(char_info(f)(#)))
+@y
+@d is_valid_char(#)==((font_bc[f] <= #) and (# <= font_ec[f]) and
+ char_exists(orig_char_info(f)(#)))
+@z
+
+@x (MLTeX)
+function get_charwidth(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_charwidth := char_width(f)(char_info(f)(c))
+ else
+ get_charwidth := 0;
+end;
+
+function get_charheight(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_charheight := char_height(f)(height_depth(char_info(f)(c)))
+ else
+ get_charheight := 0;
+end;
+
+function get_chardepth(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_chardepth := char_depth(f)(height_depth(char_info(f)(c)))
+ else
+ get_chardepth := 0;
+end;
+@y
+function get_charwidth(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_charwidth := char_width(f)(orig_char_info(f)(c))
+ else
+ get_charwidth := 0;
+end;
+
+function get_charheight(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_charheight := char_height(f)(height_depth(orig_char_info(f)(c)))
+ else
+ get_charheight := 0;
+end;
+
+function get_chardepth(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_chardepth := char_depth(f)(height_depth(orig_char_info(f)(c)))
+ else
+ get_chardepth := 0;
+end;
+@z
+
+@x (MLTeX)
+label reswitch, move_past, fin_rule, next_p;
+@y
+label reswitch, move_past, fin_rule, next_p, found, continue;
+@z
+
+@x (MLTeX)
+ if is_valid_char(c) then
+ output_one_char(c)
+ else
+ char_warning(f, c);
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+@y
+ if is_valid_char(c) then begin
+ output_one_char(c);
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+ goto continue;
+ end;
+ if mltex_enabled_p then
+ @<(\pdfTeX) Output a substitution, |goto continue| if not possible@>;
+continue:
+@z
+
+@x
+@ The |pdf_vlist_out| routine is similar to |pdf_hlist_out|, but a bit simpler.
+@y
+@ @<(\pdfTeX) Output a substitution, |goto continue| if not possible@>=
+ begin
+ @<Get substitution information, check it, goto |found|
+ if all is ok, otherwise goto |continue|@>;
+found: @<Print character substition tracing log@>;
+ @<(\pdfTeX) Rebuild character using substitution information@>;
+ end
+
+@ @<(\pdfTeX) Rebuild character using substitution information@>=
+ base_x_height:=x_height(f);
+ base_slant:=slant(f)/float_constant(65536);
+@^real division@>
+ accent_slant:=base_slant; {slant of accent character font}
+ base_width:=char_width(f)(ib_c);
+ base_height:=char_height(f)(height_depth(ib_c));
+ accent_width:=char_width(f)(ia_c);
+ accent_height:=char_height(f)(height_depth(ia_c));
+ @/{compute necessary horizontal shift (don't forget slant)}@/
+ delta:=round((base_width-accent_width)/float_constant(2)+
+ base_height*base_slant-base_x_height*accent_slant);
+@^real multiplication@>
+@^real addition@>
+ @/{1. For centering/horizontal shifting insert a kern node.}@/
+ cur_h:=cur_h+delta;
+ @/{2. Then insert the accent character possibly shifted up or down.}@/
+ if ((base_height<>base_x_height) and (accent_height>0)) then
+ begin {the accent must be shifted up or down}
+ cur_v:=base_line+(base_x_height-base_height);
+ output_one_char(accent_c);
+ cur_v:=base_line;
+ end
+ else begin
+ output_one_char(accent_c);
+ end;
+ cur_h:=cur_h+accent_width;
+ @/{3. For centering/horizontal shifting insert another kern node.}@/
+ cur_h:=cur_h+(-accent_width-delta);
+ @/{4. Output the base character.}@/
+ output_one_char(base_c);
+ cur_h:=cur_h+base_width;
+
+@ The |pdf_vlist_out| routine is similar to |pdf_hlist_out|, but a bit simpler.
+@z
+
+@x [49.1259]
+ begin if s>0 then
+ begin if s=font_size[f] then goto common_ending;
+ end
+ else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
+ goto common_ending;
+ end
+@y
+ begin
+ if pdf_font_step[f] = 0 then begin
+ if s>0 then
+ begin if s=font_size[f] then goto common_ending;
+ end
+ else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
+ goto common_ending;
+ end
+ end
+@z
+
+@x (WEB2C!)
+param_base:=xmalloc_array(integer, font_max);
+
+undump_things(font_check[null_font], font_ptr+1-null_font);
+@y
+param_base:=xmalloc_array(integer, font_max);
+
+pdf_char_used:=xmalloc_array(char_used_array, font_max);
+pdf_char_map:=xmalloc_array(char_map_array, font_max);
+pdf_font_size:=xmalloc_array(scaled, font_max);
+pdf_font_num:=xmalloc_array(integer, font_max);
+pdf_font_map:=xmalloc_array(fm_entry_ptr, font_max);
+pdf_font_type:=xmalloc_array(eight_bits, font_max);
+pdf_font_attr:=xmalloc_array(str_number, font_max);
+pdf_font_blink:=xmalloc_array(internal_font_number, font_max);
+pdf_font_elink:=xmalloc_array(internal_font_number, font_max);
+pdf_font_stretch:=xmalloc_array(integer, font_max);
+pdf_font_shrink:=xmalloc_array(integer, font_max);
+pdf_font_step:=xmalloc_array(integer, font_max);
+pdf_font_expand_ratio:=xmalloc_array(integer, font_max);
+pdf_font_auto_expand:=xmalloc_array(boolean, font_max);
+pdf_font_lp_base:=xmalloc_array(integer, font_max);
+pdf_font_rp_base:=xmalloc_array(integer, font_max);
+pdf_font_ef_base:=xmalloc_array(integer, font_max);
+vf_packet_base:=xmalloc_array(integer, font_max);
+vf_default_font:=xmalloc_array(internal_font_number, font_max);
+vf_local_font_num:=xmalloc_array(internal_font_number, font_max);
+vf_e_fnts:=xmalloc_array(integer, font_max);
+vf_i_fnts:=xmalloc_array(internal_font_number, font_max);
+
+for font_k := font_base to font_max do begin
+ for k := 0 to 31 do begin
+ pdf_char_used[font_k, k] := 0;
+ pdf_char_map[font_k, k] := k;
+ end;
+ pdf_char_map[font_k, 32] := 32;
+ pdf_font_size[font_k] := 0;
+ pdf_font_num[font_k] := 0;
+ pdf_font_map[font_k] := 0;
+ pdf_font_type[font_k] := new_font_type;
+ pdf_font_attr[font_k] := "";
+ pdf_font_blink[font_k] := null_font;
+ pdf_font_elink[font_k] := null_font;
+ pdf_font_stretch[font_k] := null_font;
+ pdf_font_shrink[font_k] := null_font;
+ pdf_font_step[font_k] := 0;
+ pdf_font_expand_ratio[font_k] := 0;
+ pdf_font_auto_expand[font_k] := false;
+ pdf_font_lp_base[font_k] := 0;
+ pdf_font_rp_base[font_k] := 0;
+ pdf_font_ef_base[font_k] := 0;
+end;
+
+make_pdftex_banner;
+undump_things(font_check[null_font], font_ptr+1-null_font);
+@z
+
+@x [51.1]
+ setup_bound_var (0)('hash_extra')(hash_extra);
+
+@y
+ setup_bound_var (0)('hash_extra')(hash_extra);
+ setup_bound_var (65536)('obj_tab_size')(obj_tab_size);
+ setup_bound_var (20000)('dest_names_size')(dest_names_size);
+@z
+
+@x [51.2]
+ const_chk (hash_extra);
+ if error_line > ssup_error_line then error_line := ssup_error_line;
+@y
+ const_chk (hash_extra);
+ const_chk (obj_tab_size);
+ const_chk (pdf_mem_size);
+ const_chk (dest_names_size);
+ if error_line > ssup_error_line then error_line := ssup_error_line;
+@z
+
+@x [51.3]
+ hyph_link :=xmalloc_array (hyph_pointer, hyph_size);
+@y
+ hyph_link :=xmalloc_array (hyph_pointer, hyph_size);
+ obj_tab:=xmalloc_array (obj_entry, obj_tab_size);
+ pdf_mem:=xmalloc_array (integer, inf_pdf_mem_size); {will grow dynamically}
+ dest_names:=xmalloc_array (dest_name_entry, dest_names_size);
+@z
+
+@x (WEB2C!)
+ param_base:=xmalloc_array(integer, font_max);
+
+ font_ptr:=null_font; fmem_ptr:=7;
+@y
+param_base:=xmalloc_array(integer, font_max);
+
+pdf_char_used:=xmalloc_array(char_used_array,font_max);
+pdf_char_map:=xmalloc_array(char_map_array,font_max);
+pdf_font_size:=xmalloc_array(scaled,font_max);
+pdf_font_num:=xmalloc_array(integer,font_max);
+pdf_font_map:=xmalloc_array(fm_entry_ptr,font_max);
+pdf_font_type:=xmalloc_array(eight_bits,font_max);
+pdf_font_attr:=xmalloc_array(str_number,font_max);
+pdf_font_blink:=xmalloc_array(internal_font_number,font_max);
+pdf_font_elink:=xmalloc_array(internal_font_number,font_max);
+pdf_font_stretch:=xmalloc_array(integer,font_max);
+pdf_font_shrink:=xmalloc_array(integer,font_max);
+pdf_font_step:=xmalloc_array(integer,font_max);
+pdf_font_expand_ratio:=xmalloc_array(integer,font_max);
+pdf_font_auto_expand:=xmalloc_array(boolean,font_max);
+pdf_font_lp_base:=xmalloc_array(integer,font_max);
+pdf_font_rp_base:=xmalloc_array(integer,font_max);
+pdf_font_ef_base:=xmalloc_array(integer,font_max);
+vf_packet_base:=xmalloc_array(integer,font_max);
+vf_default_font:=xmalloc_array(internal_font_number,font_max);
+vf_local_font_num:=xmalloc_array(internal_font_number,font_max);
+vf_e_fnts:=xmalloc_array(integer,font_max);
+vf_i_fnts:=xmalloc_array(internal_font_number,font_max);
+
+for font_k := font_base to font_max do begin
+ for k := 0 to 31 do begin
+ pdf_char_used[font_k, k] := 0;
+ pdf_char_map[font_k, k] := k;
+ end;
+ pdf_char_map[font_k, 32] := 32;
+ pdf_font_size[font_k] := 0;
+ pdf_font_num[font_k] := 0;
+ pdf_font_map[font_k] := 0;
+ pdf_font_type[font_k] := new_font_type;
+ pdf_font_attr[font_k] := "";
+ pdf_font_blink[font_k] := null_font;
+ pdf_font_elink[font_k] := null_font;
+ pdf_font_stretch[font_k] := null_font;
+ pdf_font_shrink[font_k] := null_font;
+ pdf_font_step[font_k] := 0;
+ pdf_font_expand_ratio[font_k] := 0;
+ pdf_font_auto_expand[font_k] := false;
+ pdf_font_lp_base[font_k] := 0;
+ pdf_font_rp_base[font_k] := 0;
+ pdf_font_ef_base[font_k] := 0;
+end;
+
+font_ptr:=null_font; fmem_ptr:=7;
+make_pdftex_banner;
+@z
diff --git a/Build/source/texk/web2c/pdftexdir/ttf2afm.c b/Build/source/texk/web2c/pdftexdir/ttf2afm.c
new file mode 100644
index 00000000000..d3aa7051339
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/ttf2afm.c
@@ -0,0 +1,998 @@
+/*
+Copyright (c) 1996-2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/ttf2afm.c#21 $
+*/
+
+/*
+#include <kpathsea/c-auto.h>
+#include <kpathsea/c-fopen.h>
+#include <kpathsea/c-limits.h>
+#include <kpathsea/c-memstr.h>
+#include <kpathsea/c-proto.h>
+#include <kpathsea/c-std.h>
+#include <kpathsea/c-unistd.h>
+#include <kpathsea/c-vararg.h>
+#include <kpathsea/getopt.h>
+*/
+#include <kpathsea/kpathsea.h>
+#include <time.h>
+#include <libgen.h>
+#include <pdftexdir/ptexmac.h>
+#include <pdftexdir/writettf.h>
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/ttf2afm.c#21 $";
+
+/* constants used for print_glyph */
+#define AS_NAME 0
+#define AS_INDEX 1
+#define AS_UNICODE 2
+
+#define VERSION "1.0"
+
+#define enc_getchar() xgetc(encfile)
+#define enc_eof() feof(encfile)
+#define pdftex_fail ttf_fail
+
+#define print_str(S) if (S != NULL) fprintf(outfile, #S " %s\n", S)
+#define print_dimen(N) if (N != 0) fprintf(outfile, #N " %i\n", (int)get_ttf_funit(N))
+
+#define get_ttf_funit(n) \
+ (n < 0 ? -((-n/upem)*1000 + ((-n%upem)*1000)/upem) :\
+ ((n/upem)*1000 + ((n%upem)*1000)/upem))
+
+typedef struct _unicode_entry {
+ TTF_USHORT code;
+ struct _unicode_entry *next;
+} unicode_entry;
+
+typedef struct {
+ TTF_ULONG wx;
+ const char *name;
+ TTF_USHORT index;
+ TTF_LONG bbox[4];
+ TTF_LONG offset;
+ char found;
+ unicode_entry *unicode_list;
+} mtx_entry;
+
+typedef struct _kern_entry {
+ TTF_FWORD value;
+ TTF_USHORT adjacent;
+ struct _kern_entry *next;
+} kern_entry;
+
+
+char *FontName = NULL;
+char *FullName = NULL;
+char *FamilyName = NULL;
+char *Notice = NULL;
+char *Version = NULL;
+char *Weight = NULL;
+TTF_LONG ItalicAngle = 0;
+TTF_LONG IsFixedPitch = 0;
+TTF_LONG FontBBox1 = 0;
+TTF_LONG FontBBox2 = 0;
+TTF_LONG FontBBox3 = 0;
+TTF_LONG FontBBox4 = 0;
+TTF_LONG UnderlinePosition = 0;
+TTF_LONG UnderlineThickness = 0;
+TTF_LONG CapHeight = 0;
+TTF_LONG XHeight = 0;
+TTF_LONG Ascender = 0;
+TTF_LONG Descender = 0;
+
+char *cur_file_name = NULL;
+char *bname = NULL;
+FILE *fontfile, *encfile, *outfile = NULL;
+char enc_line[ENC_BUF_SIZE];
+int print_glyph = AS_NAME; /* print glyph as names by default*/
+int print_cmap = 0;
+int use_ext_enc = 0; /* use external encoding? */
+int select_unicode = 1; /* use the first unicode mapping by default */
+int printing_enc = 0; /* set to 1 while printing encodings */
+
+
+TTF_USHORT upem;
+TTF_USHORT ntabs;
+int nhmtx;
+int post_format;
+int loca_format;
+int nglyphs;
+int nkernpairs = 0;
+int names_count = 0;
+char *ps_glyphs_buf = NULL;
+dirtab_entry *dir_tab;
+mtx_entry *mtx_tab;
+kern_entry *kern_tab;
+char *enc_names[MAX_CHAR_CODE + 1];
+
+cmap_entry *cmap_tab;
+TTF_USHORT ncmapsubtabs;
+long cmap_offset;
+
+TTF_USHORT unicode_map[0xFFFF];
+
+#include "macnames.c"
+
+void ttf_fail(char *fmt,...)
+{
+ va_list args;
+ va_start(args, fmt);
+ fprintf(stderr, "\nError: ttf2afm");
+ if (cur_file_name)
+ fprintf(stderr, " (file %s)", cur_file_name);
+ fprintf(stderr, ": ");
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+ exit(-1);
+}
+
+void ttf_warn(char *fmt,...)
+{
+ va_list args;
+ va_start(args, fmt);
+ fprintf(stderr, "\nWarning: ttf2afm");
+ if (cur_file_name)
+ fprintf(stderr, " (file %s)", cur_file_name);
+ fprintf(stderr, ": ");
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+}
+
+int xgetc(FILE *stream)
+{
+ int c = getc(stream);
+ if (c < 0 && c != EOF)
+ ttf_fail("getc() failed");
+ return c;
+}
+
+long ttf_getnum(int s)
+{
+ long i = 0;
+ int c;
+ while (s > 0) {
+ if ((c = xgetc(fontfile)) < 0)
+ ttf_fail("unexpected EOF");
+ i = (i << 8) + c;
+ s--;
+ }
+ return i;
+}
+
+dirtab_entry *name_lookup(char *s)
+{
+ dirtab_entry *p;
+ for (p = dir_tab; p - dir_tab < ntabs; p++)
+ if (strncmp(p->tag, s, 4) == 0)
+ break;
+ if (p - dir_tab == ntabs)
+ p = NULL;
+ return p;
+}
+
+void ttf_seek_tab(char *name, TTF_LONG offset)
+{
+ dirtab_entry *p = name_lookup(name);
+ if (p == NULL)
+ ttf_fail("can't find table `%s'", name);
+ if (fseek(fontfile, p->offset + offset, SEEK_SET) < 0)
+ ttf_fail("fseek() failed while reading `%s' table", name);
+}
+
+void ttf_seek_off(char *name, TTF_LONG offset)
+{
+ if (fseek(fontfile, offset, SEEK_SET) < 0)
+ ttf_fail("fseek() failed while reading `%s' table", name);
+}
+
+void store_kern_value(TTF_USHORT i, TTF_USHORT j, TTF_FWORD v)
+{
+ kern_entry *pk;
+ for (pk = kern_tab + i; pk->next != NULL; pk = pk->next);
+ pk->next = xtalloc(1, kern_entry);
+ pk = pk->next;
+ pk->next = NULL;
+ pk->adjacent = j;
+ pk->value = v;
+}
+
+TTF_FWORD get_kern_value(TTF_USHORT i, TTF_USHORT j)
+{
+ kern_entry *pk;
+ for (pk = kern_tab + i; pk->next != NULL; pk = pk->next)
+ if (pk->adjacent == j)
+ return pk->value;
+ return 0;
+}
+
+void free_tabs()
+{
+ int i;
+ kern_entry *p, *q, *r;
+ unicode_entry *u, *v;
+ mtx_entry *pm;
+ xfree(ps_glyphs_buf);
+ xfree(dir_tab);
+ xfree(cmap_tab);
+ for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++)
+ if (pm->unicode_list != NULL) {
+ for (u = pm->unicode_list; u != NULL; u = v) {
+ v = u->next;
+ xfree(u);
+ }
+ }
+ xfree(mtx_tab);
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (enc_names[i] != notdef)
+ free(enc_names[i]);
+ if (kern_tab == NULL)
+ return;
+ for (p = kern_tab; p - kern_tab < nglyphs; p++)
+ if (p->next != NULL) {
+ for (q = p->next; q != NULL; q = r) {
+ r = q->next;
+ xfree(q);
+ }
+ }
+ xfree(kern_tab);
+}
+
+void enc_getline()
+{
+ char *p;
+ int c;
+restart:
+ if (enc_eof())
+ ttf_fail("unexpected end of file");
+ p = enc_line;
+ do {
+ c = enc_getchar();
+ append_char_to_buf(c, p, enc_line, ENC_BUF_SIZE);
+ } while (c != 10);
+ append_eol(p, enc_line, ENC_BUF_SIZE);
+ if (p - enc_line <= 2 || *enc_line == '%')
+ goto restart;
+}
+
+void read_encoding(char *encname)
+{
+ char buf[ENC_BUF_SIZE], *q, *r;
+ int i;
+ cur_file_name = encname;
+ if ((encfile = kpse_open_file(encname, kpse_enc_format)) == NULL)
+ ttf_fail("can't open encoding file for reading");
+ enc_getline();
+ if (*enc_line != '/' || (r = strchr(enc_line, '[')) == 0)
+ ttf_fail("invalid encoding vector: name or `[' missing:\n%s", enc_line);
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ enc_names[i] = (char*) notdef;
+ if (r[1] == 32)
+ r += 2;
+ else
+ r++;
+ for (;;) {
+ while (*r == '/') {
+ for (q = buf, r++; *r != ' ' && *r != 10 && *r != ']' && *r != '/'; *q++ = *r++);
+ *q = 0;
+ if (*r == ' ')
+ r++;
+ if (strcmp(buf, notdef) != 0)
+ enc_names[names_count] = xstrdup(buf);
+ if (names_count++ > MAX_CHAR_CODE)
+ ttf_fail("encoding vector contains more than %i names",
+ (int)(MAX_CHAR_CODE + 1));
+ }
+ if (*r != 10 && *r != '%')
+ if (strncmp(r, "] def", strlen("] def")) == 0)
+ goto done;
+ else
+ ttf_fail("invalid encoding vector: a name or `] def' expected:\n%s", enc_line);
+ enc_getline();
+ r = enc_line;
+ }
+done:
+ xfclose(encfile, cur_file_name);
+ if (names_count != MAX_CHAR_CODE + 1)
+ ttf_warn("encoding vector contains only %i names (expected %i)",
+ names_count, MAX_CHAR_CODE + 1);
+}
+
+void append_unicode(long glyph_index, TTF_USHORT code)
+{
+ mtx_entry *m;
+ unicode_entry *u, *v;
+ assert(glyph_index >= 0 && glyph_index < nglyphs);
+ u = xtalloc(1, unicode_entry), *v;
+ m = mtx_tab + glyph_index;
+ u->next = NULL;
+ u->code = code;
+ if (m->unicode_list == NULL)
+ m->unicode_list = u;
+ else {
+ for (v = m->unicode_list; v->next != NULL; v = v->next);
+ v->next = u;
+ }
+}
+
+void read_cmap()
+{
+ cmap_entry *e;
+ seg_entry *seg_tab, *s;
+ TTF_USHORT *glyphId, format, segCount;
+ long int n, i, j, k, first_code, length, last_sep, index;
+ int unicode_map_count = 0;
+ ttf_seek_tab("cmap", TTF_USHORT_SIZE); /* skip the table vesrion number (=0) */
+ ncmapsubtabs = get_ushort();
+ cmap_offset = xftell(fontfile, cur_file_name) - 2*TTF_USHORT_SIZE;
+ cmap_tab = xtalloc(ncmapsubtabs, cmap_entry);
+ for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
+ e->platform_id = get_ushort();
+ e->encoding_id = get_ushort();
+ e->offset = get_ulong();
+ }
+ for (i = 0; i < 0xFFFF; ++i)
+ unicode_map[i] = NOGLYPH_ASSIGNED_YET;
+ for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
+ ttf_seek_off("cmap", cmap_offset + e->offset);
+ format = get_ushort();
+ if (is_unicode_mapping(e) && format == 4) {
+ ++unicode_map_count;
+ if (unicode_map_count == select_unicode)
+ goto read_unicode_mapping;
+ }
+ continue;
+read_unicode_mapping:
+ length = get_ushort(); /* length of subtable */
+ get_ushort(); /* skip the version number */
+ segCount = get_ushort()/2;
+ get_ushort(); /* skip searchRange */
+ get_ushort(); /* skip entrySelector */
+ get_ushort(); /* skip rangeShift */
+ seg_tab = xtalloc(segCount, seg_entry);
+ for (s = seg_tab; s - seg_tab < segCount; s++)
+ s->endCode = get_ushort();
+ get_ushort(); /* skip reversedPad */
+ for (s = seg_tab; s - seg_tab < segCount; s++)
+ s->startCode = get_ushort();
+ for (s = seg_tab; s - seg_tab < segCount; s++)
+ s->idDelta = get_ushort();
+ for (s = seg_tab; s - seg_tab < segCount; s++)
+ s->idRangeOffset = get_ushort();
+ length -= 8*TTF_USHORT_SIZE + 4*segCount*TTF_USHORT_SIZE;
+ n = length/TTF_USHORT_SIZE; /* number of glyphID's */
+ glyphId = xtalloc(n, TTF_USHORT);
+ for (i = 0; i < n; i++)
+ glyphId[i] = get_ushort();
+ for (s = seg_tab; s - seg_tab < segCount; s++) {
+ for (i = s->startCode; i <= s->endCode; i++) {
+ if (i == 0xFFFF)
+ break;
+ if (s->idRangeOffset != 0xFFFF) {
+ if (s->idRangeOffset == 0)
+ index = (s->idDelta + i) & 0xFFFF;
+ else {
+ k = (i - s->startCode) + s->idRangeOffset/2 +
+ (s - seg_tab) - segCount ;
+ assert(k >= 0 && k < n);
+ index = glyphId[k];
+ if (index != 0)
+ index = (index + s->idDelta) & 0xFFFF;
+ }
+ if (index < 0 || index >= nglyphs)
+ ttf_fail("cmap: glyph index out of range [0..%i)", nglyphs);
+ if (unicode_map[i] != NOGLYPH_ASSIGNED_YET)
+ ttf_fail("cmap: unicode %.4X is mapped to multiple glyphs", i);
+ if (unicode_map[i] == 0)
+ ttf_warn("unicode %.4X is mapped to glyph 0", i);
+ unicode_map[i] = index;
+ append_unicode(index, i);
+ }
+ }
+ }
+ xfree(seg_tab);
+ xfree(glyphId);
+ break;
+ }
+ if (e - cmap_tab == ncmapsubtabs)
+ ttf_fail("Invalid argument `-m %i': out of range [1..%i]",
+ select_unicode, unicode_map_count);
+}
+
+void read_font()
+{
+ long i, j, k, l, n, m, platform_id, encoding_id;
+ TTF_FWORD kern_value;
+ char buf[1024], *p;
+ dirtab_entry *pd;
+ kern_entry *pk;
+ mtx_entry *pm;
+ ttf_skip(TTF_FIXED_SIZE);
+ ntabs = get_ushort();
+ ttf_skip(3*TTF_USHORT_SIZE);
+ dir_tab = xtalloc(ntabs, dirtab_entry);
+ for (pd = dir_tab; pd - dir_tab < ntabs; pd++) {
+ pd->tag[0] = get_char();
+ pd->tag[1] = get_char();
+ pd->tag[2] = get_char();
+ pd->tag[3] = get_char();
+ ttf_skip(TTF_ULONG_SIZE);
+ pd->offset = get_ulong();
+ pd->length = get_ulong();
+ }
+ ttf_seek_tab("head", 2*TTF_FIXED_SIZE + 2*TTF_ULONG_SIZE + TTF_USHORT_SIZE);
+ upem = get_ushort();
+ ttf_skip(16);
+ FontBBox1 = get_fword();
+ FontBBox2 = get_fword();
+ FontBBox3 = get_fword();
+ FontBBox4 = get_fword();
+ ttf_skip(TTF_USHORT_SIZE);
+ ttf_skip(TTF_USHORT_SIZE + TTF_SHORT_SIZE);
+ loca_format = get_short();
+ ttf_seek_tab("maxp", TTF_FIXED_SIZE);
+ nglyphs = get_ushort();
+ mtx_tab = xtalloc(nglyphs + 1, mtx_entry);
+ for (pm = mtx_tab; pm - mtx_tab < nglyphs + 1; pm++) {
+ pm->name = NULL; /* notdef */
+ pm->found = 0;
+ pm->unicode_list = NULL;
+ }
+ ttf_seek_tab("hhea", TTF_FIXED_SIZE);
+ Ascender = get_fword();
+ Descender = get_fword();
+ ttf_skip(TTF_FWORD_SIZE + TTF_UFWORD_SIZE + 3*TTF_FWORD_SIZE + 8*TTF_SHORT_SIZE);
+ nhmtx = get_ushort();
+ ttf_seek_tab("hmtx", 0);
+ for (pm = mtx_tab; pm - mtx_tab < nhmtx; pm++) {
+ pm->wx = get_ufword();
+ ttf_skip(TTF_FWORD_SIZE);
+ }
+ i = pm[-1].wx;
+ for (; pm - mtx_tab < nglyphs; pm++)
+ pm->wx = i;
+ ttf_seek_tab("post", 0);
+ post_format = get_fixed();
+ ItalicAngle = get_fixed();
+ UnderlinePosition = get_fword();
+ UnderlineThickness = get_fword();
+ IsFixedPitch = get_ulong();
+ ttf_skip(4*TTF_ULONG_SIZE);
+ switch (post_format) {
+ case 0x00010000:
+ for (pm = mtx_tab; pm - mtx_tab < NMACGLYPHS; pm++)
+ pm->name = mac_glyph_names[pm - mtx_tab];
+ break;
+ case 0x00020000:
+ l = get_ushort(); /* some fonts have this value different from nglyphs */
+ for (pm = mtx_tab; pm - mtx_tab < l; pm++)
+ pm->index = get_ushort();
+ if ((pd = name_lookup("post")) == NULL)
+ ttf_fail("can't find table `post'");
+ n = pd->length - (xftell(fontfile, cur_file_name) - pd->offset);
+ ps_glyphs_buf = xtalloc(n + 1, char);
+ for (m = 0, p = ps_glyphs_buf; p - ps_glyphs_buf < n;) {
+ for (i = get_byte(); i > 0; i--)
+ *p++ = get_char();
+ *p++ = 0;
+ m++;
+ }
+ for (pm = mtx_tab; pm - mtx_tab < l; pm++) {
+ if (pm->index < NMACGLYPHS)
+ pm->name = mac_glyph_names[pm->index];
+ else {
+ k = pm->index - NMACGLYPHS;
+ if (k < m) {
+ for (p = ps_glyphs_buf; k > 0; k--)
+ p = (char *)strend(p) + 1;
+ pm->name = p;
+ }
+ else {
+ pm->name = NULL; /* index out of valid range, fix name to notdef */
+ }
+ }
+ }
+ break;
+ case 0x00030000:
+ if (print_glyph == AS_NAME) {
+ ttf_warn("no names available in `post' table, print glyph names as indices");
+ print_glyph = AS_INDEX;
+ }
+ break;
+ default:
+ ttf_fail("unsupported format (%.8X) of `post' table", post_format);
+ }
+ ttf_seek_tab("loca", 0);
+ for (pm = mtx_tab; pm - mtx_tab < nglyphs + 1; pm++)
+ pm->offset = (loca_format == 1 ? get_ulong() : get_ushort() << 1);
+ if ((pd = name_lookup("glyf")) == NULL)
+ ttf_fail("can't find table `glyf'");
+ for (n = pd->offset, pm = mtx_tab; pm - mtx_tab < nglyphs; pm++) {
+ ttf_seek_off("glyf", n + pm->offset);
+ ttf_skip(TTF_SHORT_SIZE);
+ pm->bbox[0] = get_fword();
+ pm->bbox[1] = get_fword();
+ pm->bbox[2] = get_fword();
+ pm->bbox[3] = get_fword();
+ }
+
+ ttf_seek_tab("name", 0);
+ i = ftell(fontfile);
+ get_ushort(); /* skip Format selector (=0) */
+ n = get_ushort(); /* number of name records */
+ j = get_ushort() + i; /* start of string storage */
+ i += 3*TTF_USHORT_SIZE; /* update the current offset */
+ while (n-- > 0) {
+ ttf_seek_off("name", i);
+ platform_id = get_ushort();
+ encoding_id = get_ushort();
+ get_ushort(); /* skip language_id */
+ k = get_ushort(); /* name_id */
+ l = get_ushort(); /* string length */
+ if ((platform_id == 1 && encoding_id == 0) &&
+ (k == 0 || k == 1 || k == 4 || k == 5 ||
+ k == 6)) {
+ ttf_seek_off("name", j + get_ushort());
+ for (p = buf; l-- > 0; p++)
+ *p = get_char();
+ *p++ = 0;
+ p = xstrdup(buf);
+ switch (k) {
+ case 0: Notice = p; break;
+ case 1: FamilyName = p; break;
+ case 4: FullName = p; break;
+ case 5: Version = p; break;
+ case 6: FontName = p; break;
+ }
+ if (Notice != NULL && FamilyName != NULL &&
+ FullName != NULL && FontName != NULL &&
+ Version != NULL)
+ break;
+ }
+ i += 6*TTF_USHORT_SIZE;
+ }
+ if ((pd = name_lookup("PCLT")) != NULL) {
+ ttf_seek_off("PCLT", pd->offset + TTF_FIXED_SIZE + TTF_ULONG_SIZE + TTF_USHORT_SIZE);
+ XHeight = get_ushort();
+ if (XHeight > FontBBox4) {
+ ttf_warn("XHeight is too big (%i)\n"
+ "This is likely a font bug, so I discarded this parameter.",
+ (int)get_ttf_funit(XHeight));
+ XHeight = 0;
+ }
+ ttf_skip(2*TTF_USHORT_SIZE);
+ CapHeight = get_ushort();
+ if (CapHeight > FontBBox4) {
+ ttf_warn("CapHeight is too big (%i)\n"
+ "This is likely a font bug, so I discarded this parameter.",
+ (int)get_ttf_funit(CapHeight));
+ CapHeight = 0;
+ }
+ }
+ if ((pd = name_lookup("OS/2")) != NULL) {
+ ttf_seek_off("OS/2", pd->offset + TTF_USHORT_SIZE + TTF_SHORT_SIZE);
+ switch (get_ushort()) {
+ case 100: Weight = xstrdup("Thin"); break;
+ case 200: Weight = xstrdup("ExtraLight"); break;
+ case 300: Weight = xstrdup("Light"); break;
+ case 400: Weight = xstrdup("Normal"); break;
+ case 500: Weight = xstrdup("Medium"); break;
+ case 600: Weight = xstrdup("SemiBold"); break;
+ case 700: Weight = xstrdup("Bold"); break;
+ case 800: Weight = xstrdup("ExtraBold"); break;
+ case 900: Weight = xstrdup("Black"); break;
+ }
+ }
+ read_cmap();
+ if ((pd = name_lookup("kern")) == NULL)
+ return;
+ kern_tab = xtalloc(nglyphs, kern_entry);
+ for (pk = kern_tab; pk - kern_tab < nglyphs; pk++) {
+ pk->next = NULL;
+ pk->value = 0;
+ }
+ ttf_seek_off("kern", pd->offset + TTF_USHORT_SIZE);
+ for (n = get_ushort(); n > 0; n--) {
+ ttf_skip(2*TTF_USHORT_SIZE);
+ k = get_ushort();
+ if (!(k & 1) || (k & 2) || (k & 4))
+ return;
+ if (k >> 8 != 0) {
+ ttf_warn("warning: only format 0 supported of `kern' \
+ subtables, others are ignored\n");
+ continue;
+ }
+ k = get_ushort();
+ ttf_skip(3*TTF_USHORT_SIZE);
+ while (k-- > 0) {
+ i = get_ushort();
+ j = get_ushort();
+ kern_value = get_fword();
+ if (kern_value != 0) {
+ store_kern_value(i, j, kern_value);
+ nkernpairs++;
+ }
+ }
+ }
+}
+
+int null_glyph(const char *s)
+{
+ return (s == NULL || s == notdef);
+ /*
+ strcmp(s, ".null") == 0 ||
+ strcmp(s, ".notdef") == 0 ||
+ strcmp(s, "CR") == 0 ||
+ strcmp(s, "nonmarkingreturn") == 0
+ */
+}
+
+void print_glyph_name(FILE *f, long glyph_index, int convention)
+{
+ unicode_entry *u;
+ static char buf[1024];
+ const char *n;
+ assert(glyph_index >= 0 && glyph_index < nglyphs);
+ n = mtx_tab[glyph_index].name;
+ if (printing_enc && (n == notdef || glyph_index == 0)) {
+ fputs(notdef, f);
+ return;
+ }
+ switch (convention) {
+ case AS_NAME:
+ if (!null_glyph(n))
+ fprintf(f, "%s", mtx_tab[glyph_index].name);
+ else if (n == notdef && glyph_index == 0)
+ fputs(notdef, f);
+ else
+ fprintf(f, "%s%li", GLYPH_PREFIX_INDEX, glyph_index);
+ break;
+ case AS_INDEX:
+ fprintf(f, "%s%li", GLYPH_PREFIX_INDEX, glyph_index);
+ break;
+ case AS_UNICODE:
+ u = mtx_tab[glyph_index].unicode_list;
+ if (glyph_index == 0 || u == NULL)
+ fprintf(f, "%s%li", GLYPH_PREFIX_INDEX, glyph_index);
+ else {
+ fprintf(f, "%s%.4X", GLYPH_PREFIX_UNICODE, u->code);
+ if (u->next != NULL) {
+ *buf = 0;
+ for (; u != NULL; u = u->next) {
+ assert(strlen(buf) + strlen(GLYPH_PREFIX_UNICODE) + 4 < sizeof(buf));
+ sprintf(strend(buf), "%s%.4X ", GLYPH_PREFIX_UNICODE, u->code);
+ }
+ ttf_warn("glyph %li have multiple encodings: %s",
+ glyph_index, buf);
+ }
+ }
+ break;
+ }
+}
+
+void print_char_metric(FILE *f, int charcode, long glyph_index)
+{
+ assert(glyph_index >= 0 && glyph_index < nglyphs);
+ fprintf(f, "C %i ; WX %i ; N ", (int) charcode,
+ (int)get_ttf_funit(mtx_tab[glyph_index].wx));
+ print_glyph_name(f, glyph_index, print_glyph);
+ fprintf(f, " ; B %i %i %i %i ;\n",
+ (int)get_ttf_funit(mtx_tab[glyph_index].bbox[0]),
+ (int)get_ttf_funit(mtx_tab[glyph_index].bbox[1]),
+ (int)get_ttf_funit(mtx_tab[glyph_index].bbox[2]),
+ (int)get_ttf_funit(mtx_tab[glyph_index].bbox[3]));
+}
+
+void print_afm(char *date, char *fontname)
+{
+ int i, ncharmetrics;
+ mtx_entry *pm;
+ short mtx_index[MAX_CHAR_CODE + 1], *idx;
+ unsigned int index;
+ char **pe;
+ kern_entry *pk, *qk;
+ unicode_entry *u;
+ char buf[20];
+ fputs("StartFontMetrics 2.0\n", outfile);
+ fprintf(outfile, "Comment Converted at %s by ttf2afm from font file `%s'\n", date, fontname);
+ print_str(FontName);
+ print_str(FullName);
+ print_str(FamilyName);
+ print_str(Weight);
+ fprintf(outfile, "ItalicAngle %i", (int)(ItalicAngle/0x10000));
+ if (ItalicAngle%0x10000 > 0)
+ fprintf(outfile, ".%i", (int)((ItalicAngle%0x10000)*1000)/0x10000);
+ fputs("\n", outfile);
+ fprintf(outfile, "IsFixedPitch %s\n", IsFixedPitch ? "true" : "false");
+ fprintf(outfile, "FontBBox %i %i %i %i\n",
+ (int)get_ttf_funit(FontBBox1),
+ (int)get_ttf_funit(FontBBox2),
+ (int)get_ttf_funit(FontBBox3),
+ (int)get_ttf_funit(FontBBox4));
+ print_dimen(UnderlinePosition);
+ print_dimen(UnderlineThickness);
+ print_str(Version);
+ print_str(Notice);
+ fputs("EncodingScheme FontSpecific\n", outfile);
+ print_dimen(CapHeight);
+ print_dimen(XHeight);
+ print_dimen(Ascender);
+ print_dimen(Descender);
+ ncharmetrics = nglyphs;
+ if (use_ext_enc == 0) { /* external encoding vector not given */
+ fprintf(outfile, "StartCharMetrics %u\n", ncharmetrics);
+ for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++) {
+ pm->found = 1;
+ print_char_metric(outfile, -1, pm - mtx_tab);
+ }
+ }
+ else { /* external encoding vector given */
+ for (idx = mtx_index; idx - mtx_index <= MAX_CHAR_CODE; *idx++ = 0);
+ for (pe = enc_names; pe - enc_names < names_count; pe++) {
+ if (*pe == notdef)
+ continue;
+ /* scan form `uniABCD' */
+ if (sscanf(*pe, GLYPH_PREFIX_UNICODE "%X", &index) == 1) {
+ if (unicode_map[index] != NOGLYPH_ASSIGNED_YET) {
+ pm = mtx_tab + unicode_map[index];
+ pm->found = 1;
+ }
+ else
+ ttf_warn("`unicode %s%.4X' is not mapped to any glyph",
+ GLYPH_PREFIX_UNICODE, index);
+ continue;
+ }
+ /* scan form `index123' */
+ if (sscanf(*pe, GLYPH_PREFIX_INDEX "%u", &index) == 1) {
+ if (index >= nglyphs)
+ ttf_fail("`%s' out of valid range [0..%i)",
+ *pe, nglyphs);
+ pm = mtx_tab + index;
+ pm->found = 1;
+ continue;
+ }
+ for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++)
+ if (pm->name != NULL && strcmp(*pe, pm->name) == 0)
+ break;
+ if (pm - mtx_tab < nglyphs) {
+ mtx_index[pe - enc_names] = pm - mtx_tab;
+ pm->found = 1;
+ continue;
+ }
+ else
+ ttf_warn("glyph `%s' not found", *pe);
+ }
+ fprintf(outfile, "StartCharMetrics %u\n", ncharmetrics);
+ for (idx = mtx_index; idx - mtx_index <= MAX_CHAR_CODE; idx++) {
+ if (*idx != 0 && mtx_tab[*idx].found == 1)
+ print_char_metric(outfile, idx - mtx_index, *idx);
+ }
+ for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++) {
+ if (pm->found == 0)
+ print_char_metric(outfile, -1, pm - mtx_tab);
+ }
+ }
+end_metrics:
+ fputs("EndCharMetrics\n", outfile);
+ if (nkernpairs == 0)
+ goto end_kerns;
+ fprintf(outfile, "StartKernData\nStartKernPairs %i\n", nkernpairs);
+ for (pk = kern_tab; pk - kern_tab < nglyphs; pk++)
+ for (qk = pk; qk != NULL; qk = qk->next)
+ if (qk->value != 0) {
+ fputs("KPX ", outfile);
+ print_glyph_name(outfile, pk - kern_tab, print_glyph);
+ fputs(" ", outfile);
+ print_glyph_name(outfile, qk->adjacent, print_glyph);
+ fprintf(outfile, " %i\n", get_ttf_funit(qk->value));
+ }
+ fputs("EndKernPairs\nEndKernData\n", outfile);
+end_kerns:
+ fputs("EndFontMetrics\n", outfile);
+}
+
+void print_encoding(char *fontname)
+{
+ long int i, k, first_code, length, last_sep;
+ FILE *file;
+ TTF_USHORT format;
+ char *enc_name, *end_enc_name;
+ cmap_entry *e;
+ const char *n;
+ printing_enc = 1;
+ enc_name = xtalloc(strlen(bname) + 20, char);
+ strcpy(enc_name, bname);
+ end_enc_name = strend(enc_name);
+ for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
+ ttf_seek_off("cmap", cmap_offset + e->offset);
+ format = get_ushort();
+ if (format != 0 && format != 4 && format != 6) {
+ ttf_warn("format %i of encoding subtable unsupported", (int)format);
+ continue;
+ }
+ sprintf(end_enc_name, ".e%i%i",
+ (int)e->platform_id, (int)e->encoding_id);
+ if ((file = xfopen(enc_name, FOPEN_W_MODE)) == NULL)
+ ttf_fail("cannot open file for writing (%s)\n", enc_name);
+ fprintf(file, "%% Encoding table from font file %s\n", fontname);
+ fprintf(file, "%% Platform ID %i", (int)e->platform_id);
+ switch (e->platform_id) {
+ case 0: fprintf(file, " (Apple Unicode)"); break;
+ case 1: fprintf(file, " (Macintosh)"); break;
+ case 2: fprintf(file, " (ISO)"); break;
+ case 3: fprintf(file, " (Microsoft)"); break;
+ }
+ fprintf(file, "\n");
+ fprintf(file, "%% Encoding ID %i", (int)e->encoding_id);
+ if (e->platform_id == 1 && e->encoding_id == 0)
+ fprintf(file, " (Roman)");
+ if (e->platform_id == 3)
+ switch (e->encoding_id) {
+ case 0: fprintf(file, " (Symbol)"); break;
+ case 1: fprintf(file, " (Unicode)"); break;
+ }
+ fprintf(file, "\n");
+ fprintf(file, "%% Format %i", (int)(format));
+ switch (format) {
+ case 0: fprintf(file, " (byte encoding table)"); break;
+ case 4: fprintf(file, " (segment mapping to delta values)"); break;
+ case 6: fprintf(file, " (trimmed table mapping)"); break;
+ }
+ fprintf(file, "\n");
+ fprintf(file, "/Encoding%i [\n", (int)(e - cmap_tab + 1));
+ switch (format) {
+ case 0:
+ get_ushort(); /* skip length */
+ get_ushort(); /* skip version number */
+ for (i = 0; i <= MAX_CHAR_CODE; i++) {
+ fputs("/", file);
+ print_glyph_name(file, get_byte(), print_glyph);
+ fputs("\n", file);
+ }
+ break;
+ case 4:
+ for (i = 0; i < nglyphs; ++i) {
+ fprintf(file, "%% Glyph %li -> ", i);
+ print_glyph_name(file, i, AS_UNICODE);
+ fputs("\n", file);
+ }
+ break;
+ case 6:
+ get_ushort(); /* skip table length */
+ get_ushort(); /* skip version number */
+ first_code = get_ushort(); /* first character code */
+ for (i = 0; i < first_code; ++i)
+ fprintf(file, "/%s\n", notdef);
+ length = get_ushort(); /* number of character codes */
+ for (i = first_code; i < first_code + length; i++) {
+ k = get_ushort();
+ if (i > MAX_CHAR_CODE)
+ fputs("% ", file);
+ fputs("/", file);
+ print_glyph_name(file, k, print_glyph);
+ fputs("\n", file);
+ }
+ for (i = first_code + length; i <= MAX_CHAR_CODE; i++)
+ fprintf(file, "/%s\n", notdef);
+ break;
+ default:
+ ttf_warn("format %i of encoding subtable unsupported", (int)format);
+ }
+ fprintf(file, "] def\n");
+ }
+ xfree(enc_name);
+}
+
+void usage()
+{
+ cur_file_name = NULL;
+ fprintf(stderr,
+ "Usage: ttf2afm [-i|-u|-c|-v] [-e enc] [-o filename] [-m NUM] fontfile\n"
+ " -i: force printing glyph names in form 'index123'\n"
+ " -u: force printing glyph names in form 'uniABCD'\n"
+ " -c: print encoding tables to `basename.e<platformID><encodingID>'\n"
+ " -v: print version\n"
+ " -e enc: encode the AFM output using encoding vector from `enc'\n"
+ " -o filename: write output to file `filename' instead of stdout\n"
+ " -m NUM: select unicode mapping (default = 1, ie the first)\n"
+ " fontfile: the TrueType fontfile\n"
+ "\nPlease send bug reports or feature requests to <pdftex@tug.org>\n"
+ );
+ _exit(-1);
+}
+
+int main(int argc, char **argv)
+{
+ char date[128], *s;
+ time_t t = time(&t);
+ int c;
+ kpse_set_progname(argv[0]);
+ kpse_init_prog("ttf2afm", 0, 0, 0) ;
+ while ((c = getopt(argc, argv, "iucve:o:m:")) != -1)
+ switch (c) {
+ case 'i':
+ print_glyph = AS_INDEX;
+ break;
+ case 'u':
+ print_glyph = AS_UNICODE;
+ break;
+ case 'c':
+ print_cmap = 1;
+ break;
+ case 'e':
+ cur_file_name = optarg;
+ read_encoding(cur_file_name);
+ use_ext_enc = 1;
+ break;
+ case 'o':
+ cur_file_name = optarg;
+ outfile = xfopen(cur_file_name, FOPEN_W_MODE);
+ if (outfile == NULL)
+ ttf_fail("cannot open file for writing");
+ break;
+ case 'm':
+ select_unicode = atoi(optarg);
+ break;
+ case 'v':
+ fprintf(stderr,
+ "ttf2afm version " VERSION "\n"
+ "Copyright (C) 1997-2005 Han The Thanh.\n"
+ "There is NO warranty. Redistribution of this software is\n"
+ "covered by the terms of both the pdfTeX copyright and\n"
+ "the GNU General Public License.\n"
+ "For more information about these matters, see the files\n"
+ "named COPYING and the pdfTeX source.\n"
+ "Primary author of ttf2afm: Han The Thanh.\n"
+ );
+ _exit(0);
+ default:
+ usage();
+ }
+ if (argc - optind != 1)
+ usage();
+ sprintf(date, "%s\n", ctime(&t));
+ *(char *)strchr(date, '\n') = 0;
+ cur_file_name = argv[optind];
+ if (print_cmap) {
+ bname = strdup(xbasename(cur_file_name));
+ if ((s = rindex(bname, '.')) != NULL)
+ *s = 0;
+ }
+ if ((fontfile = kpse_open_file(cur_file_name, kpse_truetype_format)) == NULL)
+ ttf_fail("can't open font file for reading");
+ read_font();
+ if (outfile == NULL)
+ outfile = stdout;
+ print_afm(date, cur_file_name);
+ if (print_cmap)
+ print_encoding(cur_file_name);
+ xfree(FontName);
+ xfree(FullName);
+ xfree(FamilyName);
+ xfree(Notice);
+ xfree(Version);
+ xfree(Weight);
+ free_tabs();
+ xfclose(fontfile, cur_file_name);
+ return 0;
+}
diff --git a/Build/source/texk/web2c/pdftexdir/ttf2afm.rc b/Build/source/texk/web2c/pdftexdir/ttf2afm.rc
new file mode 100644
index 00000000000..a63881df7d1
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/ttf2afm.rc
@@ -0,0 +1,35 @@
+/* ttf2afm.rc: ttf2afm -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " ttf2afm 1.10a"
+
+#define VER_INTERNALNAME_STR "ttf2afm"
+#define VER_ORIGINALFILENAME_STR "ttf2afm.exe"
+
+#define VER_FILEDESCRIPTION_STR "TTF-to-AFM Converter"
+
+#define VER_COMPANYNAME_STR ""
+#define VER_LEGALCOPYRIGHT_STR "Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>"
+
+#include "texlive.version"
+
+/* ttf2afm.rc ends here */
diff --git a/Build/source/texk/web2c/pdftexdir/utils.c b/Build/source/texk/web2c/pdftexdir/utils.c
new file mode 100644
index 00000000000..c1be283ba2e
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/utils.c
@@ -0,0 +1,1129 @@
+/*
+Copyright (c) 1996-2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/utils.c#25 $
+*/
+
+#include "sys/types.h"
+#include "regex.h"
+#include "ptexlib.h"
+#include "zlib.h"
+#include "md5.h"
+#include <kpathsea/c-vararg.h>
+#include <kpathsea/c-proto.h>
+#include <kpathsea/c-stat.h>
+#include <kpathsea/c-fopen.h>
+#include <time.h>
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/utils.c#25 $";
+
+char *cur_file_name = NULL;
+strnumber last_tex_string;
+static char print_buf[PRINTF_BUF_SIZE];
+static char *jobname_cstr = NULL;
+static char *job_id_string = NULL;
+extern string ptexbanner; /* from web2c/lib/texmfmp.c */
+extern string versionstring; /* from web2c/lib/version.c */
+extern KPSEDLL string kpathsea_version_string; /* from kpathsea/version.c */
+
+size_t last_ptr_index; /* for use with alloc_array */
+
+/* define fb_ptr, fb_array & fb_limit */
+typedef char fb_entry;
+define_array(fb);
+
+/* define char_ptr, char_array & char_limit */
+typedef char char_entry;
+define_array(char);
+
+integer fb_offset(void)
+{
+ return fb_ptr - fb_array;
+}
+
+void fb_seek(integer offset)
+{
+ fb_ptr = fb_array + offset;
+}
+
+void fb_putchar(eightbits b)
+{
+ alloc_array(fb, 1, SMALL_ARRAY_SIZE);
+ *fb_ptr++ = b;
+}
+
+void fb_flush(void)
+{
+ fb_entry *p;
+ integer n;
+ for (p = fb_array; p < fb_ptr;) {
+ n = pdfbufsize - pdfptr;
+ if (fb_ptr - p < n)
+ n = fb_ptr - p;
+ memcpy(pdfbuf + pdfptr, p, (unsigned)n);
+ pdfptr += n;
+ if (pdfptr == pdfbufsize)
+ pdfflush();
+ p += n;
+ }
+ fb_ptr = fb_array;
+}
+
+static void fnstr_append(const char *s)
+{
+ int l = strlen(s) + 1;
+ alloc_array(char, l, SMALL_ARRAY_SIZE);
+ strcat(char_ptr, s);
+ char_ptr = strend(char_ptr);
+}
+
+void make_subset_tag(fm_entry *fm_cur, char **glyph_names)
+{
+ char tag[7];
+ unsigned long crc;
+ int i, l = strlen(job_id_string) + 1;
+ alloc_array(char, l, SMALL_ARRAY_SIZE);
+ strcpy(char_array, job_id_string);
+ char_ptr = strend(char_array);
+ if (fm_cur->tfm_name != NULL) {
+ fnstr_append(" TFM name: ");
+ fnstr_append(fm_cur->tfm_name);
+ }
+ fnstr_append(" PS name: ");
+ if (font_keys[FONTNAME_CODE].valid)
+ fnstr_append(fontname_buf);
+ else if (fm_cur->ps_name != NULL)
+ fnstr_append(fm_cur->ps_name);
+ fnstr_append(" Encoding: ");
+ if (fm_cur->encoding != NULL && (fm_cur->encoding)->name != NULL)
+ fnstr_append((fm_cur->encoding)->name);
+ else
+ fnstr_append("built-in");
+ fnstr_append(" CharSet: ");
+ assert(glyph_names != NULL);
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (pdfcharmarked(tex_font, i) && glyph_names[i] != notdef) {
+ fnstr_append(" /");
+ fnstr_append(glyph_names[i]);
+ }
+ if (fm_cur->charset != NULL) {
+ fnstr_append(" Extra CharSet: ");
+ fnstr_append(fm_cur->charset);
+ }
+ crc = crc32(0L, Z_NULL, 0);
+ crc = crc32(crc, (Bytef*)char_array, strlen(char_array));
+ /* we need to fit a 32-bit number into a string of 6 uppercase chars long;
+ * there are 26 uppercase chars ==> each char represents a number in range
+ * 0..25. The maximal number that can be represented by the tag is
+ * 26^6 - 1, which is a number between 2^28 and 2^29. Thus the bits 29..31
+ * of the CRC must be dropped out.
+ */
+ for (i = 0; i < 6; i++) {
+ tag[i] = 'A' + crc % 26;
+ crc /= 26;
+ }
+ tag[6] = 0;
+ fm_cur->subset_tag = xstrdup(tag);
+}
+
+void pdf_puts(const char *s)
+{
+ pdfroom(strlen(s) + 1);
+ while (*s)
+ pdfbuf[pdfptr++] = *s++;
+}
+
+void pdf_printf(const char *fmt,...)
+{
+ va_list args;
+ va_start(args, fmt);
+ vsprintf(print_buf, fmt, args);
+ pdf_puts(print_buf);
+ va_end(args);
+}
+
+strnumber maketexstring(const char *s)
+{
+ int l;
+ if (s == NULL || *s == 0)
+ return getnullstr();
+ l = strlen(s);
+ check_buf(poolptr + l, poolsize);
+ while (l-- > 0)
+ strpool[poolptr++] = *s++;
+ last_tex_string = makestring();
+ return last_tex_string;
+}
+
+void tex_printf(const char *fmt, ...)
+{
+ va_list args;
+ va_start(args, fmt);
+ vsprintf(print_buf, fmt, args);
+ print(maketexstring(print_buf));
+ flushstr(last_tex_string);
+ xfflush(stdout);
+ va_end(args);
+}
+
+/* Helper for pdftex_fail. */
+static void safe_print(const char *str)
+{
+ const char *c;
+ for (c = str; *c; ++c)
+ print(*c);
+}
+
+/* pdftex_fail may be called when a buffer overflow has happened/is
+ happening, therefore may not call mktexstring. However, with the
+ current implementation it appears that error messages are misleading,
+ possibly because pool overflows are detected too late. */
+void pdftex_fail(const char *fmt,...)
+{
+ va_list args;
+ va_start(args, fmt);
+ println();
+ safe_print("Error: ");
+ safe_print(program_invocation_name);
+ if (cur_file_name) {
+ safe_print(" (file ");
+ safe_print(cur_file_name);
+ safe_print(")");
+ }
+ safe_print(": ");
+ vsprintf(print_buf, fmt, args);
+ safe_print(print_buf);
+ va_end(args);
+ println();
+ safe_print(" ==> Fatal error occurred, the output PDF file is not finished!");
+ println();
+ exit(-1);
+}
+
+void pdftex_warn(const char *fmt,...)
+{
+ va_list args;
+ va_start(args, fmt);
+ println();
+ tex_printf("Warning: %s", program_invocation_name);
+ if (cur_file_name)
+ tex_printf(" (file %s)", cur_file_name);
+ tex_printf(": ");
+ vsprintf(print_buf, fmt, args);
+ print(maketexstring(print_buf));
+ flushstr(last_tex_string);
+ va_end(args);
+ println();
+}
+
+char *makecstring(integer s)
+{
+ static char cstrbuf[MAX_CSTRING_LEN];
+ char *p = cstrbuf;
+ int i, l = strstart[s + 1] - strstart[s];
+ check_buf(l + 1, MAX_CSTRING_LEN);
+ for (i = 0; i < l; i++)
+ *p++ = strpool[i + strstart[s]];
+ *p = 0;
+ return cstrbuf;
+}
+
+/*
+boolean str_eq_cstr(strnumber n, char *s)
+{
+ int l;
+ if (s == NULL || n == 0)
+ return false;
+ l = strstart[n];
+ while (*s && l < strstart[n + 1] && *s == strpool[l])
+ l++, s++;
+ return !*s && l == strstart[n + 1];
+}
+*/
+
+void setjobid(int year, int month, int day, int time, int pdftexversion, int pdftexrevision)
+{
+ char *name_string, *format_string, *s;
+
+ if (job_id_string != NULL)
+ return;
+
+ name_string = xstrdup(makecstring(jobname));
+ format_string = xstrdup(makecstring(formatident));
+ s = xtalloc(SMALL_BUF_SIZE +
+ strlen(name_string) +
+ strlen(format_string) +
+ strlen(ptexbanner) +
+ strlen(versionstring) +
+ strlen(kpathsea_version_string), char);
+ /* The Web2c version string starts with a space. */
+ sprintf(s, "%.4d/%.2d/%.2d %.2d:%.2d %s %s %s%s %s",
+ year, month, day, time/60, time%60,
+ name_string, format_string, ptexbanner,
+ versionstring, kpathsea_version_string);
+ job_id_string = xstrdup(s);
+ xfree(s);
+ xfree(name_string);
+ xfree(format_string);
+}
+
+void makepdftexbanner(void)
+{
+ static boolean pdftexbanner_init = false;
+ char *s;
+
+ if (pdftexbanner_init)
+ return;
+
+ s = xtalloc(SMALL_BUF_SIZE +
+ strlen(ptexbanner) +
+ strlen(versionstring) +
+ strlen(kpathsea_version_string), char);
+ /* The Web2c version string starts with a space. */
+ sprintf(s, "%s%s %s", ptexbanner, versionstring, kpathsea_version_string);
+ pdftexbanner = maketexstring(s);
+ xfree(s);
+ pdftexbanner_init = true;
+}
+
+strnumber getresnameprefix(void)
+{
+/* static char name_str[] = */
+/* "!\"$&'*+,-.0123456789:;=?@ABCDEFGHIJKLMNOPQRSTUVWXYZ\\" */
+/* "^_`abcdefghijklmnopqrstuvwxyz|~"; */
+ static char name_str[] =
+"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
+ char prefix[7]; /* make a tag of 6 chars long */
+ unsigned long crc;
+ int i, base = strlen(name_str);
+ crc = crc32(0L, Z_NULL, 0);
+ crc = crc32(crc, (Bytef*)job_id_string, strlen(job_id_string));
+ for (i = 0; i < 6; i++) {
+ prefix[i] = name_str[crc % base];
+ crc /= base;
+ }
+ prefix[6] = 0;
+ return maketexstring(prefix);
+}
+
+size_t xfwrite(void *ptr, size_t size, size_t nmemb, FILE *stream)
+{
+ if (fwrite(ptr, size, nmemb, stream) != nmemb)
+ pdftex_fail("fwrite() failed");
+ return nmemb;
+}
+
+int xfflush(FILE *stream)
+{
+ if (fflush(stream) != 0)
+ pdftex_fail("fflush() failed");
+ return 0;
+}
+
+int xgetc(FILE *stream)
+{
+ int c = getc(stream);
+ if (c < 0 && c != EOF)
+ pdftex_fail("getc() failed");
+ return c;
+}
+
+int xputc(int c, FILE *stream)
+{
+ int i = putc(c, stream);
+ if (i < 0)
+ pdftex_fail("putc() failed");
+ return i;
+}
+
+void writestreamlength(integer length, integer offset)
+{
+ integer save_offset;
+ if (jobname_cstr == NULL)
+ jobname_cstr = xstrdup(makecstring(jobname));
+ save_offset = xftell(pdffile, jobname_cstr);
+ xfseek(pdffile, offset, SEEK_SET, jobname_cstr);
+ fprintf(pdffile, "%li", (long int)length);
+ xfseek(pdffile, pdfoffset(), SEEK_SET, jobname_cstr);
+}
+
+scaled extxnoverd(scaled x, scaled n, scaled d)
+{
+ double r = (((double)x)*((double)n))/((double)d);
+ if (r > 0)
+ r += 0.5;
+ else
+ r -= 0.5;
+ if (r >= (double)maxinteger || r <= -(double)maxinteger)
+ pdftex_warn("arithmetic: number too big");
+ return r;
+}
+
+void libpdffinish()
+{
+ xfree(fb_array);
+ xfree(char_array);
+ xfree(job_id_string);
+ fm_free();
+ t1_free();
+ enc_free();
+ img_free();
+ vf_free();
+ epdf_free();
+}
+
+/* Converts any string given in in in an allowed PDF string which can be
+ * handled by printf et.al.: \ is escaped to \\, parenthesis are escaped and
+ * control characters are octal encoded.
+ * This assumes that the string does not contain any already escaped
+ * characters!
+ */
+char *convertStringToPDFString (char *in, int len)
+{
+ static char pstrbuf[MAX_PSTRING_LEN];
+ char *out = pstrbuf;
+ int i, j;
+ char buf[5];
+ j = 0;
+ for (i = 0; i < len; i++) {
+ check_buf(j + sizeof(buf), MAX_PSTRING_LEN);
+ if (((unsigned char)in[i] < '!') || ((unsigned char)in[i] > '~')){
+ /* convert control characters into oct */
+ sprintf (buf, "\\%03o", (unsigned int)(unsigned char)in[i]);
+ out[j++] = buf[0];
+ out[j++] = buf[1];
+ out[j++] = buf[2];
+ out[j++] = buf[3];
+ }
+ else if ((in[i] == '(') || (in[i] == ')')) {
+ /* escape paranthesis */
+ out[j++] = '\\';
+ out[j++] = in[i];
+ }
+ else if (in[i] == '\\') {
+ /* escape backslash */
+ out[j++] = '\\';
+ out[j++] = '\\';
+ }
+ else {
+ /* copy char :-) */
+ out[j++] = in[i];
+ }
+ }
+ out[j] = '\0';
+ return pstrbuf;
+}
+
+
+/* Converts any string given in in in an allowed PDF string which can be
+ * handled by printf et.al.: \ is escaped to \\, parenthesis are escaped and
+ * control characters are octal encoded.
+ * This assumes that the string does not contain any already escaped
+ * characters!
+ *
+ * See escapename for parameter description.
+ */
+void escapestring(poolpointer in)
+{
+ poolpointer out = poolptr;
+ unsigned char ch;
+ while (in < out) {
+ if (poolptr + 4 >= poolsize) {
+ poolptr = poolsize;
+ /* error by str_toks that calls str_room(1) */
+ return;
+ }
+
+ ch = (unsigned char)strpool[in++];
+
+ if ((ch < '!') || (ch > '~')) {
+ /* convert control characters into oct */
+ sprintf (&strpool[poolptr], "\\%.3o", (unsigned int)ch);
+ poolptr += 4;
+ continue;
+ }
+ if ((ch == '(') || (ch == ')') || (ch == '\\')) {
+ /* escape parenthesis and backslash */
+ strpool[poolptr++] = '\\';
+ }
+ /* copy char :-) */
+ strpool[poolptr++] = ch;
+ }
+}
+
+
+/* Convert any given string in a PDF name using escaping mechanism
+ of PDF 1.2. The result does not include the leading slash.
+
+ PDF specification 1.6, section 3.2.6 "Name Objects" explains:
+ <blockquote>
+ Beginning with PDF 1.2, any character except null (character code 0) may
+ be included in a name by writing its 2-digit hexadecimal code, preceded
+ by the number sign character (#); see implementation notes 3 and 4 in
+ Appendix H. This syntax is required to represent any of the delimiter or
+ white-space characters or the number sign character itself; it is
+ recommended but not required for characters whose codes are outside the
+ range 33 (!) to 126 (~).
+ </blockquote>
+ The following table shows the conversion that are done by this
+ function:
+ code result reason
+ -----------------------------------
+ 0 ignored not allowed
+ 1..32 escaped must for white-space:
+ 9 (tab), 10 (lf), 12 (ff), 13 (cr), 32 (space)
+ recommended for the other control characters
+ 35 escaped escape char "#"
+ 37 escaped delimiter "%"
+ 40..41 escaped delimiters "(" and ")"
+ 47 escaped delimiter "/"
+ 60 escaped delimiter "<"
+ 62 escaped delimiter ">"
+ 91 escaped delimiter "["
+ 93 escaped delimiter "]"
+ 123 escaped delimiter "{"
+ 125 escaped delimiter "}"
+ 127..255 escaped recommended
+ else copy regular characters
+
+ Parameter "in" is a pointer into the string pool where
+ the input string is located. The output string is written
+ as temporary string right after the input string.
+ Thus at the begin of the procedure the global variable
+ "poolptr" points to the start of the output string and
+ after the end when the procedure returns.
+*/
+void escapename(poolpointer in)
+{
+ poolpointer out = poolptr;
+ unsigned char ch;
+
+ while (in < out) {
+ if (poolptr + 3 >= poolsize) {
+ poolptr = poolsize;
+ /* error by str_toks that calls str_room(1) */
+ return;
+ }
+
+ ch = (unsigned char)strpool[in++];
+
+ if ((ch >= 1 && ch <= 32) || ch >= 127) {
+ /* escape */
+ sprintf(&strpool[poolptr], "#%.2X", (unsigned int)ch);
+ poolptr += 3;
+ continue;
+ }
+ switch (ch) {
+ case 0:
+ /* ignore */
+ break;
+ case 35:
+ case 37:
+ case 40:
+ case 41:
+ case 47:
+ case 60:
+ case 62:
+ case 91:
+ case 93:
+ case 123:
+ case 125:
+ /* escape */
+ sprintf(&strpool[poolptr], "#%.2X", (unsigned int)ch);
+ poolptr += 3;
+ break;
+ default:
+ /* copy */
+ strpool[poolptr++] = ch;
+ }
+ }
+}
+
+/* Convert any given string in a PDF hexadecimal string. The
+ result does not include the angle brackets.
+
+ This procedure uses uppercase hexadecimal letters.
+
+ See escapename for description of parameters.
+*/
+void escapehex(poolpointer in)
+{
+ poolpointer out = poolptr;
+ unsigned char ch;
+
+ while (in < out) {
+ if (poolptr + 2 >= poolsize) {
+ poolptr = poolsize;
+ /* error by str_toks that calls str_room(1) */
+ return;
+ }
+
+ ch = (unsigned char)strpool[in++];
+
+ sprintf(&strpool[poolptr], "%.2X", (unsigned int)ch);
+ poolptr += 2;
+ }
+}
+
+/* Unescape any given hexadecimal string.
+
+ Last hex digit can be omitted, it is replaced by zero, see
+ PDF specification.
+
+ Invalid digits are silently ignored.
+
+ See escapename for description of parameters.
+*/
+void unescapehex(poolpointer in)
+{
+ poolpointer out = poolptr;
+ unsigned char ch, a;
+ boolean first = true;
+
+ while (in < out) {
+ if (poolptr + 1 >= poolsize) {
+ poolptr = poolsize;
+ /* error by str_toks that calls str_room(1) */
+ return;
+ }
+
+ ch = (unsigned char)strpool[in++];
+
+ if ((ch >= '0') && (ch <= '9')) {
+ ch -= '0';
+ }
+ else if ((ch >= 'A') && (ch <= 'F')) {
+ ch -= 'A' - 10;
+ }
+ else if ((ch >= 'a') && (ch <= 'f')) {
+ ch -= 'a' - 10;
+ }
+ else {
+ continue; /* ignore wrong character */
+ }
+
+ if (first) {
+ a = ch << 4;
+ first = false;
+ continue;
+ }
+
+ strpool[poolptr++] = a + ch;
+ first = true;
+ }
+ if (!first) { /* last hex digit is omitted */
+ strpool[poolptr++] = ch << 4;
+ }
+}
+
+
+/* Converts any string given in in in an allowed PDF string which is
+ * hexadecimal encoded;
+ * sizeof(out) should be at least lin*2+1.
+ */
+void convertStringToHexString (char *in, char *out, int lin)
+{
+ int i, j;
+ char buf[3];
+ j = 0;
+ for (i = 0; i < lin; i++) {
+ sprintf (buf, "%02X", (unsigned int)(unsigned char)in[i]);
+ out[j++] = buf[0];
+ out[j++] = buf[1];
+ }
+ out[j] = '\0';
+}
+
+/* Compute the ID string as per PDF1.4 9.3:
+ <blockquote>
+ File identifers are defined by the optional ID entry in a PDF file's
+ trailer dictionary (see Section 3.4.4, "File Trailer"; see also
+ implementation note 105 in Appendix H). The value of this entry is an
+ array of two strings. The first string is a permanent identifier based
+ on the contents of the file at the time it was originally created, and
+ does not change when the file is incrementally updated. The second
+ string is a changing identifier based on the file's contents at the
+ time it was last updated. When a file is first written, both
+ identifiers are set to the same value. If both identifiers match when a
+ file reference is resolved, it is very likely that the correct file has
+ been found; if only the first identifier matches, then a different
+ version of the correct file has been found.
+ To help ensure the uniqueness of file identifiers, it is recommend
+ that they be computed using a message digest algorithm such as MD5
+ (described in Internet RFC 1321, The MD5 Message-Digest Algorithm; see
+ the Bibliography), using the following information (see implementation
+ note 106 in Appendix H):
+ - The current time
+ - A string representation of the file's location, usually a pathname
+ - The size of the file in bytes
+ - The values of all entries in the file's document information
+ dictionary (see Section 9.2.1, Document Information Dictionary )
+ </blockquote>
+ This stipulates only that the two IDs must be identical when the file is
+ created and that they should be reasonably unique. Since it's difficult
+ to get the file size at this point in the execution of pdfTeX and
+ scanning the info dict is also difficult, we start with a simpler
+ implementation using just the first two items.
+ */
+void printID (strnumber filename)
+{
+ time_t t;
+ size_t size;
+ char time_str[32];
+ md5_state_t state;
+ md5_byte_t digest[16];
+ char id[64];
+ char *file_name;
+ char pwd[4096];
+ /* start md5 */
+ md5_init(&state);
+ /* get the time */
+ t = time(NULL);
+ size = strftime (time_str, sizeof(time_str), "%Y%m%dT%H%M%SZ", gmtime(&t));
+ md5_append(&state, (const md5_byte_t *)time_str, size);
+ /* get the file name */
+ if (getcwd(pwd, sizeof(pwd)) == NULL)
+ pdftex_fail("getcwd() failed (path too long?)");
+ file_name = makecstring(filename);
+ md5_append(&state, (const md5_byte_t *)pwd, strlen(pwd));
+ md5_append(&state, (const md5_byte_t *)"/", 1);
+ md5_append(&state, (const md5_byte_t *)file_name, strlen(file_name));
+ /* finish md5 */
+ md5_finish(&state, digest);
+ /* write the IDs */
+ convertStringToHexString ((char*)digest, id, 16);
+ pdf_printf("/ID [<%s> <%s>]", id, id);
+}
+
+/* Print the /CreationDate entry.
+
+ PDF Reference, third edition says about the expected date format:
+ <blockquote>
+ 3.8.2 Dates
+
+ PDF defines a standard date format, which closely follows that of
+ the international standard ASN.1 (Abstract Syntax Notation One),
+ defined in ISO/IEC 8824 (see the Bibliography). A date is a string
+ of the form
+
+ (D:YYYYMMDDHHmmSSOHH'mm')
+
+ where
+
+ YYYY is the year
+ MM is the month
+ DD is the day (01-31)
+ HH is the hour (00-23)
+ mm is the minute (00-59)
+ SS is the second (00-59)
+ O is the relationship of local time to Universal Time (UT),
+ denoted by one of the characters +, -, or Z (see below)
+ HH followed by ' is the absolute value of the offset from UT
+ in hours (00-23)
+ mm followed by ' is the absolute value of the offset from UT
+ in minutes (00-59)
+
+ The apostrophe character (') after HH and mm is part of the syntax.
+ All fields after the year are optional. (The prefix D:, although also
+ optional, is strongly recommended.) The default values for MM and DD
+ are both 01; all other numerical fields default to zero values. A plus
+ sign (+) as the value of the O field signifies that local time is
+ later than UT, a minus sign (-) that local time is earlier than UT,
+ and the letter Z that local time is equal to UT. If no UT information
+ is specified, the relationship of the specified time to UT is
+ considered to be unknown. Whether or not the time zone is known, the
+ rest of the date should be specified in local time.
+
+ For example, December 23, 1998, at 7:52 PM, U.S. Pacific Standard
+ Time, is represented by the string
+
+ D:199812231952-08'00'
+ </blockquote>
+
+ The main difficulty is get the time zone offset. strftime() does this in ISO
+ C99 (e.g. newer glibc) with %z, but we have to work with other systems (e.g.
+ Solaris 2.5).
+*/
+
+time_t start_time = 0;
+#define TIME_STR_SIZE 30
+char start_time_str[TIME_STR_SIZE];
+char time_str[TIME_STR_SIZE];
+ /* minimum size for time_str is 24: "D:YYYYmmddHHMMSS+HH'MM'" */
+
+void makepdftime(time_t t, char *time_str)
+{
+
+ struct tm lt, gmt;
+ size_t size;
+ int off, off_hours, off_mins;
+
+ /* get the time */
+ lt = *localtime(&t);
+ size = strftime(time_str, TIME_STR_SIZE, "D:%Y%m%d%H%M%S", &lt);
+ /* expected format: "YYYYmmddHHMMSS" */
+ if (size == 0) {
+ /* unexpected, contents of time_str is undefined */
+ time_str[0] = '\0';
+ return;
+ }
+
+ /* correction for seconds: %S can be in range 00..61,
+ the PDF reference expects 00..59,
+ therefore we map "60" and "61" to "59" */
+ if (time_str[14] == '6') {
+ time_str[14] = '5';
+ time_str[15] = '9';
+ time_str[16] = '\0'; /* for safety */
+ }
+
+ /* get the time zone offset */
+ gmt = *gmtime(&t);
+
+ /* this calculation method was found in exim's tod.c */
+ off = 60*(lt.tm_hour - gmt.tm_hour) + lt.tm_min - gmt.tm_min;
+ if (lt.tm_year != gmt.tm_year) {
+ off += (lt.tm_year > gmt.tm_year) ? 1440 : -1440;
+ }
+ else if (lt.tm_yday != gmt.tm_yday) {
+ off += (lt.tm_yday > gmt.tm_yday) ? 1440 : -1440;
+ }
+
+ if (off == 0) {
+ time_str[size++] = 'Z';
+ time_str[size] = 0;
+ }
+ else {
+ off_hours = off/60;
+ off_mins = abs(off - off_hours*60);
+ sprintf(&time_str[size], "%+03i'%02d'", off_hours, off_mins);
+ }
+}
+
+void initstarttime() {
+ if (start_time == 0) {
+ start_time = time((time_t *) NULL);
+ makepdftime(start_time, start_time_str);
+ }
+}
+
+void printcreationdate() {
+ initstarttime();
+ pdf_printf("/CreationDate (%s)\n", start_time_str);
+}
+
+void getcreationdate()
+{
+ /* put creation date on top of string pool and update poolptr */
+ poolpointer out = poolptr;
+ unsigned char ch;
+ int len = strlen(start_time_str);
+
+ initstarttime();
+
+ if (poolptr + len >= poolsize) {
+ poolptr = poolsize;
+ /* error by str_toks that calls str_room(1) */
+ return;
+ }
+
+ memcpy(&strpool[poolptr], start_time_str, len);
+ poolptr += len;
+}
+
+void getfilemoddate(strnumber s) {
+ struct stat file_data;
+
+ char *file_name = kpse_find_tex(makecfilename(s));
+ if (file_name == NULL) {
+ return; /* empty string */
+ }
+
+ /* get file status */
+ if (stat(file_name, &file_data) == 0) {
+ int len;
+
+ makepdftime(file_data.st_mtime, time_str);
+ len = strlen(time_str);
+ if (poolptr + len >= poolsize) {
+ poolptr = poolsize;
+ /* error by str_toks that calls str_room(1) */
+ }
+ else {
+ memcpy(&strpool[poolptr], time_str, len);
+ poolptr += len;
+ }
+ }
+ /* else { errno contains error code } */
+
+ xfree(file_name);
+}
+
+void getfilesize(strnumber s) {
+ struct stat file_data;
+
+ char *file_name = kpse_find_tex(makecfilename(s));
+ if (file_name == NULL) {
+ return; /* empty string */
+ }
+
+ /* get file status */
+ if (stat(file_name, &file_data) == 0) {
+ int len;
+ char buf[20];
+
+ /* st_size has type off_t */
+ sprintf(buf, "%lu", (long unsigned int)file_data.st_size);
+ len = strlen(buf);
+ if (poolptr + len >= poolsize) {
+ poolptr = poolsize;
+ /* error by str_toks that calls str_room(1) */
+ }
+ else {
+ memcpy(&strpool[poolptr], buf, len);
+ poolptr += len;
+ }
+ }
+ /* else { errno contains error code } */
+
+ xfree(file_name);
+}
+
+#define DIGEST_SIZE 16
+#define FILE_BUF_SIZE 1024
+
+void getmd5sum(strnumber s, boolean file) {
+ md5_state_t state;
+ md5_byte_t digest[DIGEST_SIZE];
+ char outbuf[2 * DIGEST_SIZE + 1];
+ int len = 2 * DIGEST_SIZE;
+
+ if (file) {
+ char file_buf[FILE_BUF_SIZE];
+ int read = 0;
+ FILE *f;
+
+ char *file_name = kpse_find_tex(makecfilename(s));
+ if (file_name == NULL) {
+ return; /* empty string */
+ }
+ /* in case of error the empty string is returned,
+ no need for xfopen that aborts on error.
+ */
+ f = fopen(file_name, FOPEN_RBIN_MODE);
+ if (f == NULL) {
+ xfree(file_name);
+ return;
+ }
+ md5_init(&state);
+ while ((read = fread(&file_buf, sizeof(char),
+ FILE_BUF_SIZE, f)) > 0) {
+ md5_append(&state, (const md5_byte_t *)file_buf, read);
+ }
+ md5_finish(&state, digest);
+ fclose(f);
+
+ xfree(file_name);
+ }
+ else {
+ /* s contains the data */
+ md5_init(&state);
+ md5_append(&state,
+ (const md5_byte_t *)&strpool[strstart[s]],
+ strstart[s + 1] - strstart[s]);
+ md5_finish(&state, digest);
+ }
+
+ if (poolptr + len >= poolsize) {
+ /* error by str_toks that calls str_room(1) */
+ return;
+ }
+ convertStringToHexString((char*)digest, outbuf, DIGEST_SIZE);
+ memcpy(&strpool[poolptr], outbuf, len);
+ poolptr += len;
+}
+
+void getfiledump(strnumber s, int offset, int length) {
+ FILE *f;
+ int read;
+ poolpointer data_ptr;
+ poolpointer data_end;
+ char *file_name;
+
+ if (length == 0) {
+ /* empty result string */
+ return;
+ }
+
+ if (poolptr + 2 * length + 1 >= poolsize) {
+ /* no place for result */
+ poolptr = poolsize;
+ /* error by str_toks that calls str_room(1) */
+ return;
+ }
+
+ file_name = kpse_find_tex(makecfilename(s));
+ if (file_name == NULL) {
+ return; /* empty string */
+ }
+
+ /* read file data */
+ f = fopen(file_name, FOPEN_RBIN_MODE);
+ if (f == NULL) {
+ xfree(file_name);
+ return;
+ }
+ if (fseek(f, (long)offset, SEEK_SET) != 0) {
+ xfree(file_name);
+ return;
+ }
+ /* there is enough space in the string pool, the read
+ data are put in the upper half of the result, thus
+ the conversion to hex can be done without overwriting
+ unconverted bytes. Be aware that sprintf also appends
+ a nul byte at the end. */
+ data_ptr = poolptr + length;
+ read = fread(&strpool[data_ptr],
+ sizeof(char), length, f);
+ fclose(f);
+
+ /* convert to hex */
+ data_end = data_ptr + read;
+ for (; data_ptr < data_end; data_ptr++) {
+ sprintf(&strpool[poolptr], "%.2X",
+ (unsigned int)strpool[data_ptr]);
+ poolptr += 2;
+ }
+ xfree(file_name);
+}
+
+#define DEFAULT_SUB_MATCH_COUNT 10
+int sub_match_count = DEFAULT_SUB_MATCH_COUNT;
+regmatch_t *pmatch = NULL;
+char *match_string = NULL;
+
+void matchstrings(strnumber s, strnumber t, int subcount, boolean icase) {
+ regex_t preg;
+ int cflags = REG_EXTENDED;
+ int eflags = 0;
+ int ret;
+ char *str;
+
+ if (icase) {
+ cflags |= REG_ICASE;
+ }
+
+ if (poolptr + 10 >= poolsize) {
+ poolptr = poolsize;
+ return;
+ }
+
+ str = makecstring(s);
+ ret = regcomp(&preg, str, cflags);
+ if (ret != 0) {
+ int size = regerror(ret, &preg, NULL, 0);
+ str = xtalloc(size, char);
+ regerror(ret, &preg, str, size);
+ pdftex_warn("%s%s", "\\pdfmatch: ", str);
+ xfree(str);
+ strpool[poolptr++] = '-';
+ strpool[poolptr++] = '1';
+ }
+ else {
+ str = makecstring(t);
+ sub_match_count = ((subcount < 0) ?
+ DEFAULT_SUB_MATCH_COUNT : subcount);
+ xfree(pmatch);
+ if (sub_match_count > 0) {
+ pmatch = xtalloc(sub_match_count, regmatch_t);
+ }
+ ret = regexec(&preg, str, sub_match_count, pmatch, eflags);
+ xfree(match_string);
+ match_string = xstrdup(str);
+ if (ret == 0) {
+ strpool[poolptr++] = '1';
+ }
+ else { /* REG_NOMATCH */
+ strpool[poolptr++] = '0';
+ }
+ }
+
+ regfree(&preg);
+}
+
+void getmatch(int i) {
+ int size = 0;
+ int len = 0;
+
+ boolean found = i < sub_match_count
+ && match_string != NULL
+ && pmatch[i].rm_so >= 0
+ && i >= 0;
+
+ if (found) {
+ len = pmatch[i].rm_eo - pmatch[i].rm_so;
+ size = 20 + len;
+ /* 20: place for integer number and '->' */
+ }
+ else {
+ size = 4;
+ }
+
+ if (poolptr + size >= poolsize) {
+ poolptr = poolsize;
+ return;
+ }
+
+ if (found) {
+ sprintf(&strpool[poolptr], "%d", pmatch[i].rm_so);
+ poolptr += strlen(&strpool[poolptr]);
+ strpool[poolptr++] = '-';
+ strpool[poolptr++] = '>';
+ memcpy(&strpool[poolptr], &match_string[pmatch[i].rm_so], len);
+ poolptr += len;
+ return;
+ }
+
+ strpool[poolptr++] = '-';
+ strpool[poolptr++] = '1';
+ strpool[poolptr++] = '-';
+ strpool[poolptr++] = '>';
+}
+
+
+/* makecfilename
+ input/ouput same as makecstring:
+ input: string number
+ output: C string with quotes removed.
+*/
+char *makecfilename(strnumber s) {
+ char *name = makecstring(s);
+ char *p = name;
+ char *q = name;
+
+ while (*p) {
+ if (*p != '"')
+ *q++ = *p;
+ p++;
+ }
+ *q = '\0';
+ fprintf(stderr, " %s\n", name);
+ return name;
+}
diff --git a/Build/source/texk/web2c/pdftexdir/vadjust.ch b/Build/source/texk/web2c/pdftexdir/vadjust.ch
new file mode 100644
index 00000000000..09887ea01a8
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/vadjust.ch
@@ -0,0 +1,273 @@
+% WEB change file containing vadjust extension for pdfTeX
+%
+% Copyright (c) 1996-2004 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: vadjust.ch,v 1.2 2004/08/01 12:12:23 olaf Exp $
+
+@x [142] - pre-vadjust
+@d adjust_node=5 {|type| of an adjust node}
+@y
+@d adjust_node=5 {|type| of an adjust node}
+@d adjust_pre == subtype {pre-adjustment?}
+@#{|append_list| is used to append a list to |tail|}
+@d append_list(#) == begin link(tail) := link(#); append_list_end
+@d append_list_end(#) == tail := #; end
+
+@z
+
+@x [162] - pre-vadjust
+@d backup_head==mem_top-13 {head of token list built by |scan_keyword|}
+@d hi_mem_stat_min==mem_top-13 {smallest statically allocated word in
+ the one-word |mem|}
+@d hi_mem_stat_usage=14 {the number of one-word nodes always present}
+@y
+@d backup_head==mem_top-13 {head of token list built by |scan_keyword|}
+@d pre_adjust_head==mem_top-14 {head of pre-adjustment list returned by |hpack|}
+@d hi_mem_stat_min==mem_top-14 {smallest statically allocated word in
+ the one-word |mem|}
+@d hi_mem_stat_usage=15 {the number of one-word nodes always present}
+@z
+
+@x [197] - pre-vadjust
+begin print_esc("vadjust"); node_list_display(adjust_ptr(p)); {recursive call}
+@y
+begin print_esc("vadjust"); if adjust_pre(p) <> 0 then print(" pre ");
+node_list_display(adjust_ptr(p)); {recursive call}
+@z
+
+@x [649] - pre-vadjust
+if adjust_tail<>null then link(adjust_tail):=null;
+@y
+if adjust_tail<>null then link(adjust_tail):=null;
+if pre_adjust_tail<>null then link(pre_adjust_tail):=null;
+@z
+
+@x [655] - pre-vadjust
+@<Transfer node |p| to the adjustment list@>=
+begin while link(q)<>p do q:=link(q);
+if type(p)=adjust_node then
+ begin link(adjust_tail):=adjust_ptr(p);
+ while link(adjust_tail)<>null do adjust_tail:=link(adjust_tail);
+ p:=link(p); free_node(link(q),small_node_size);
+ end
+@y
+@<Glob...@>=
+@!pre_adjust_tail: pointer;
+
+@ @<Set init...@>=
+pre_adjust_tail := null;
+
+@ Materials in \.{\\vadjust} used with \.{pre} keyword will be appended to
+|pre_adjust_tail| instead of |adjust_tail|.
+
+@d update_adjust_list(#) == begin
+ link(#) := adjust_ptr(p);
+ while link(#) <> null do
+ # := link(#);
+end
+
+@<Transfer node |p| to the adjustment list@>=
+begin while link(q)<>p do q:=link(q);
+ if type(p) = adjust_node then begin
+ if adjust_pre(p) <> 0 then
+ update_adjust_list(pre_adjust_tail)
+ else
+ update_adjust_list(adjust_tail);
+ p := link(p); free_node(link(q), small_node_size);
+ end
+@z
+
+@x [770] - pre-vadjust
+@d align_stack_node_size=5 {number of |mem| words to save alignment states}
+@y
+@d align_stack_node_size=6 {number of |mem| words to save alignment states}
+@z
+
+@x [770] - pre-vadjust
+@!cur_head,@!cur_tail:pointer; {adjustment list pointers}
+@y
+@!cur_head,@!cur_tail:pointer; {adjustment list pointers}
+@!cur_pre_head,@!cur_pre_tail:pointer; {pre-adjustment list pointers}
+@z
+
+@x [771] - pre-vadjust
+cur_head:=null; cur_tail:=null;
+@y
+cur_head:=null; cur_tail:=null;
+cur_pre_head:=null; cur_pre_tail:=null;
+@z
+
+@x [772] - pre-vadjust
+info(p+4):=cur_head; link(p+4):=cur_tail;
+@y
+info(p+4):=cur_head; link(p+4):=cur_tail;
+info(p+5):=cur_pre_head; link(p+5):=cur_pre_tail;
+@z
+
+@x [771] - pre-vadjust
+cur_tail:=link(p+4); cur_head:=info(p+4);
+@y
+cur_tail:=link(p+4); cur_head:=info(p+4);
+cur_pre_tail:=link(p+5); cur_pre_head:=info(p+5);
+@z
+
+@x [786] - pre-vadjust
+cur_align:=link(preamble); cur_tail:=cur_head; init_span(cur_align);
+@y
+cur_align:=link(preamble); cur_tail:=cur_head; cur_pre_tail:=cur_pre_head;
+init_span(cur_align);
+@z
+
+@x [791] - pre-vadjust
+ begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u);
+ cur_tail:=adjust_tail; adjust_tail:=null;
+ end
+@y
+ begin adjust_tail:=cur_tail; pre_adjust_tail:=cur_pre_tail;
+ u:=hpack(link(head),natural); w:=width(u);
+ cur_tail:=adjust_tail; adjust_tail:=null;
+ cur_pre_tail:=pre_adjust_tail; pre_adjust_tail:=null;
+ end
+@z
+
+@x [799] - pre-vadjust
+ pop_nest; append_to_vlist(p);
+ if cur_head<>cur_tail then
+ begin link(tail):=link(cur_head); tail:=cur_tail;
+ end;
+@y
+ pop_nest;
+ if cur_pre_head <> cur_pre_tail then
+ append_list(cur_pre_head)(cur_pre_tail);
+ append_to_vlist(p);
+ if cur_head <> cur_tail then
+ append_list(cur_head)(cur_tail);
+@z
+
+@x [888] - pre-vadjust
+append_to_vlist(just_box);
+if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+adjust_tail:=null
+@y
+if pre_adjust_head <> pre_adjust_tail then
+ append_list(pre_adjust_head)(pre_adjust_tail);
+pre_adjust_tail := null;
+append_to_vlist(just_box);
+if adjust_head <> adjust_tail then
+ append_list(adjust_head)(adjust_tail);
+adjust_tail := null
+@z
+
+@x
+adjust_tail:=adjust_head;
+@y
+adjust_tail:=adjust_head;
+pre_adjust_tail := pre_adjust_head;
+@z
+
+@x [1076] - pre-vadjust
+ begin append_to_vlist(cur_box);
+ if adjust_tail<>null then
+ begin if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+ adjust_tail:=null;
+ end;
+@y
+ begin
+ if pre_adjust_tail <> null then begin
+ if pre_adjust_head <> pre_adjust_tail then
+ append_list(pre_adjust_head)(pre_adjust_tail);
+ pre_adjust_tail := null;
+ end;
+ append_to_vlist(cur_box);
+ if adjust_tail <> null then begin
+ if adjust_head <> adjust_tail then
+ append_list(adjust_head)(adjust_tail);
+ adjust_tail := null;
+ end;
+@z
+
+@x [1085] - pre-vadjust
+adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0);
+@y
+adjusted_hbox_group: begin adjust_tail:=adjust_head;
+ pre_adjust_tail:=pre_adjust_head; package(0);
+@z
+
+@x [1099] - pre-vadjust
+saved(0):=cur_val; incr(save_ptr);
+new_save_level(insert_group); scan_left_brace; normal_paragraph;
+push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+end;
+@y
+saved(0) := cur_val;
+if (cur_cmd = vadjust) and scan_keyword("pre") then
+ saved(1) := 1
+else
+ saved(1) := 0;
+save_ptr := save_ptr + 2;
+new_save_level(insert_group); scan_left_brace; normal_paragraph;
+push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+end;
+@z
+
+@x [1100] - pre-vadjust
+ d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr);
+@y
+ d:=split_max_depth; f:=floating_penalty; unsave; save_ptr := save_ptr - 2;
+@z
+
+@x [1100] - pre-vadjust
+ subtype(tail):=0; {the |subtype| is not used}
+@y
+ adjust_pre(tail) := saved(1); {the |subtype| is used for |adjust_pre|}
+@z
+
+@x [1198] - pre-vadjust
+@!t:pointer; {tail of adjustment list}
+@y
+@!t:pointer; {tail of adjustment list}
+@!pre_t:pointer; {tail of pre-adjustment list}
+@z
+
+@x [1199] - pre-vadjust
+adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b);
+t:=adjust_tail; adjust_tail:=null;@/
+@y
+adjust_tail:=adjust_head; pre_adjust_tail:=pre_adjust_head;
+b:=hpack(p,natural); p:=list_ptr(b);
+t:=adjust_tail; adjust_tail:=null;@/
+pre_t:=pre_adjust_tail; pre_adjust_tail:=null;@/
+@z
+
+@x [1205] - pre-vadjust
+if t<>adjust_head then {migrating material comes after equation number}
+ begin link(tail):=link(adjust_head); tail:=t;
+ end;
+@y
+if t<>adjust_head then {migrating material comes after equation number}
+ begin link(tail):=link(adjust_head); tail:=t;
+ end;
+if pre_t<>pre_adjust_head then
+ begin link(tail):=link(pre_adjust_head); tail:=pre_t;
+ end;
+@z
diff --git a/Build/source/texk/web2c/pdftexdir/vfpacket.c b/Build/source/texk/web2c/pdftexdir/vfpacket.c
new file mode 100644
index 00000000000..1f8f86b8d82
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/vfpacket.c
@@ -0,0 +1,116 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/vfpacket.c#7 $
+*/
+
+#include "ptexlib.h"
+
+typedef struct {
+ internalfontnumber font;
+ char *dataptr;
+ int len;
+} packet_entry;
+
+/* define packet_ptr, packet_array & packet_limit */
+define_array(packet);
+
+typedef struct {
+ char **data;
+ int *len;
+ internalfontnumber font;
+} vf_entry;
+
+/* define vf_ptr, vf_array & vf_limit */
+define_array(vf);
+
+static char *packet_data_ptr;
+
+integer newvfpacket(internalfontnumber f)
+{
+ int i,
+ n = fontec[f] - fontbc[f] + 1;
+ alloc_array(vf, 1, SMALL_ARRAY_SIZE);
+ vf_ptr->len = xtalloc(n, int);
+ vf_ptr->data = xtalloc(n, char *);
+ for (i = 0; i < n; i++) {
+ vf_ptr->data[i] = NULL;
+ vf_ptr->len[i] = 0;
+ }
+ vf_ptr->font = f;
+ return vf_ptr++ - vf_array;
+}
+
+void storepacket(integer f, integer c, integer s)
+{
+ int l = strstart[s + 1] - strstart[s];
+ vf_array[vfpacketbase[f]].len[c - fontbc[f]] = l;
+ vf_array[vfpacketbase[f]].data[c - fontbc[f]] = xtalloc(l, char);
+ memcpy((void *)vf_array[vfpacketbase[f]].data[c - fontbc[f]],
+ (void *)(strpool + strstart[s]), (unsigned)l);
+}
+
+void pushpacketstate()
+{
+ alloc_array(packet, 1, SMALL_ARRAY_SIZE);
+ packet_ptr->font = f;
+ packet_ptr->dataptr = packet_data_ptr;
+ packet_ptr->len = vfpacketlength;
+ packet_ptr++;
+}
+
+void poppacketstate()
+{
+ if (packet_ptr == packet_array)
+ pdftex_fail("packet stack empty, impossible to pop");
+ packet_ptr--;
+ f = packet_ptr->font;
+ packet_data_ptr = packet_ptr->dataptr;
+ vfpacketlength = packet_ptr->len;
+}
+
+void startpacket(internalfontnumber f, integer c)
+{
+ packet_data_ptr = vf_array[vfpacketbase[f]].data[c - fontbc[f]];
+ vfpacketlength = vf_array[vfpacketbase[f]].len[c - fontbc[f]];
+}
+
+eightbits packetbyte()
+{
+ vfpacketlength--;
+ return *packet_data_ptr++;
+}
+
+void vf_free(void)
+{
+ vf_entry *v;
+ int n;
+ char **p;
+ if (vf_array != NULL) {
+ for (v = vf_array; v < vf_ptr; v++) {
+ xfree(v->len);
+ n = fontec[v->font] - fontec[v->font] + 1;
+ for (p = v->data; p - v->data < n ; p++)
+ xfree(*p);
+ xfree(v->data);
+ }
+ xfree(vf_array);
+ }
+ xfree(packet_array);
+}
diff --git a/Build/source/texk/web2c/pdftexdir/win32.mak b/Build/source/texk/web2c/pdftexdir/win32.mak
new file mode 100644
index 00000000000..1a0e5ba3a45
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/win32.mak
@@ -0,0 +1,71 @@
+################################################################################
+#
+# Makefile : Web2C / pdftexdir
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/03/13 13:12:08 popineau>
+#
+################################################################################
+root_srcdir = ..\..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+
+USE_XPDF = 1
+USE_ZLIB = 1
+USE_PNG = 1
+USE_JPEG = 1
+USE_TEX = 1
+USE_MD5 = 1
+USE_GNUW32 = 1
+USE_KPATHSEA = 1
+
+!include <msvc/common.mak>
+
+DEFS = -I.. -I$(top_srcdir) $(DEFS) -DMAKE_TEX_DLL -DHAVE_CONFIG_H -DpdfeTeX
+
+objects = $(objdir)\avl.obj $(objdir)\avlstuff.obj $(objdir)\epdf.obj \
+ $(objdir)\mapfile.obj \
+ $(objdir)\utils.obj $(objdir)\vfpacket.obj \
+ $(objdir)\pkin.obj $(objdir)\writefont.obj $(objdir)\writet1.obj \
+ $(objdir)\writet3.obj $(objdir)\writezip.obj $(objdir)\writeenc.obj \
+ $(objdir)\writettf.obj $(objdir)\writejpg.obj $(objdir)\writepng.obj \
+ $(objdir)\writeimg.obj \
+ $(objdir)\pdftoepdf.obj
+
+default: all
+
+all: $(objdir) libpdftoepdf $(objdir)\libpdf.lib
+
+$(objdir)\libpdf.lib: $(objdir) $(objects) $(md5lib)
+ $(archive) $(objects) $(md5lib)
+
+libpdftoepdf: $(objdir) $(objdir)\libpdftoepdf.lib
+
+$(objdir)\libpdftoepdf.lib: $(objdir)\pdftoepdf.obj $(xpdflib)
+ $(archive) $(objdir)\pdftoepdf.obj $(xpdflib)
+
+$(objdir)\pdftoepdf.obj: pdftoepdf.cc # $(xpdf)
+
+ptexlib.h: ..\pdftexd.h
+
+..\pdftexd.h:
+ -@echo $(verbose) & ( \
+ pushd .. & $(make) pdftexd.h & popd \
+ )
+
+!include <msvc/config.mak>
+!include <msvc/install.mak>
+
+!include <msvc/clean.mak>
+!include <msvc/rdepend.mak>
+
+!include "./depend.mak"
+
+#
+# Local Variables:
+# mode: makefile
+# End:
diff --git a/Build/source/texk/web2c/pdftexdir/writeenc.c b/Build/source/texk/web2c/pdftexdir/writeenc.c
new file mode 100644
index 00000000000..7963403ec7e
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writeenc.c
@@ -0,0 +1,145 @@
+/*
+Copyright (c) 1996-2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writeenc.c#13 $
+
+source code indentation by "indent -kr -nut"
+*/
+
+#include "ptexlib.h"
+#include "avlstuff.h"
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writeenc.c#13 $";
+
+void read_enc(enc_entry * e)
+{
+ assert(e != NULL);
+ if (e->loaded)
+ return;
+ load_enc(e->name, e->glyph_names);
+ e->loaded = true;
+}
+
+/* write_enc is used to write either external encoding (given in map file) or
+ * internal encoding (read from the font file); when glyph_names is NULL
+ * the 2nd argument is a pointer to the encoding entry; otherwise the 3rd is
+ * the object number of the Encoding object
+ */
+void write_enc(char **glyph_names, enc_entry * e, integer eobjnum)
+{
+ boolean is_notdef;
+ int i;
+ char **g;
+ if (glyph_names == NULL) {
+ assert(e != NULL);
+ if (e->objnum != 0) /* the encoding has been written already */
+ return;
+ pdfnewdict(0, 0);
+ e->objnum = objptr;
+ g = e->glyph_names;
+ } else {
+ pdfbegindict(eobjnum);
+ g = glyph_names;
+ }
+ pdf_printf("/Type /Encoding\n/Differences [ 0 /%s", g[0]);
+ is_notdef = (g[0] == notdef);
+ for (i = 1; i <= MAX_CHAR_CODE; i++) {
+ if (g[i] == notdef) {
+ if (!is_notdef) {
+ pdf_printf(" %i/%s", i, notdef);
+ is_notdef = true;
+ }
+ } else {
+ if (is_notdef) {
+ pdf_printf(" %i", i);
+ is_notdef = false;
+ }
+ pdf_printf("/%s", g[i]);
+ }
+ }
+ pdf_puts("]\n");
+ pdfenddict();
+}
+
+/**********************************************************************/
+/* All encoding entries go into AVL tree for fast search by name. */
+
+struct avl_table *enc_tree = NULL;
+
+/* AVL sort enc_entry into enc_tree by name */
+
+static int comp_enc_entry(const void *pa, const void *pb, void *p)
+{
+ return strcmp(((const enc_entry *) pa)->name,
+ ((const enc_entry *) pb)->name);
+}
+
+enc_entry *add_enc(char *s)
+{
+ int i;
+ enc_entry tmp, *p;
+ void **aa;
+
+ assert(s != NULL);
+ if (enc_tree == NULL) {
+ enc_tree = avl_create(comp_enc_entry, NULL, &avl_xallocator);
+ assert(enc_tree != NULL);
+ }
+ tmp.name = s;
+ p = (enc_entry *) avl_find(enc_tree, &tmp);
+ if (p != NULL) /* encoding already registered */
+ return p;
+ p = xtalloc(1, enc_entry);
+ p->loaded = false;
+ p->name = xstrdup(s);
+ p->objnum = 0;
+ p->glyph_names = xtalloc(MAX_CHAR_CODE + 1, char *);
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ p->glyph_names[i] = (char *) notdef;
+ aa = avl_probe(enc_tree, p);
+ assert(aa != NULL);
+ return p;
+}
+
+/**********************************************************************/
+/* cleaning up... */
+
+static void destroy_enc_entry(void *pa, void *pb)
+{
+ enc_entry *p;
+ int i;
+
+ p = (enc_entry *) pa;
+ xfree(p->name);
+ if (p->glyph_names != NULL)
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (p->glyph_names[i] != notdef)
+ xfree(p->glyph_names[i]);
+ xfree(p->glyph_names);
+ xfree(p);
+}
+
+void enc_free()
+{
+ if (enc_tree != NULL)
+ avl_destroy(enc_tree, destroy_enc_entry);
+}
+
+/**********************************************************************/
diff --git a/Build/source/texk/web2c/pdftexdir/writefont.c b/Build/source/texk/web2c/pdftexdir/writefont.c
new file mode 100644
index 00000000000..abb0074bde0
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writefont.c
@@ -0,0 +1,318 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writefont.c#15 $
+*/
+
+#include "ptexlib.h"
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writefont.c#15 $";
+
+key_entry font_keys[FONT_KEYS_NUM] = {
+ {"Ascent", "Ascender", 0, false},
+ {"CapHeight", "CapHeight", 0, false},
+ {"Descent", "Descender", 0, false},
+ {"FontName", "FontName", 0, false},
+ {"ItalicAngle", "ItalicAngle", 0, false},
+ {"StemV", "StdVW", 0, false},
+ {"XHeight", "XHeight", 0, false},
+ {"FontBBox", "FontBBox", 0, false},
+ {"", "", 0, false},
+ {"", "", 0, false},
+ {"", "", 0, false}
+};
+
+internalfontnumber tex_font;
+boolean fontfile_found;
+boolean is_otf_font;
+boolean write_ttf_glyph_names;
+char fontname_buf[FONTNAME_BUF_SIZE];
+
+static int first_char, last_char;
+static integer char_widths[MAX_CHAR_CODE + 1];
+static boolean write_fontfile_only;
+static int char_widths_objnum,
+ encoding_objnum;
+static char **cur_glyph_names;
+
+static void print_key(integer code, integer v)
+{
+ pdf_printf("/%s ", font_keys[code].pdfname);
+ if (font_keys[code].valid)
+ pdf_printf("%i", (int)font_keys[code].value);
+ else
+ pdf_printf("%i", (int)dividescaled(v, pdffontsize[tex_font], 3));
+ pdf_puts("\n");
+}
+
+static void print_italic_angle()
+{
+ pdf_printf("/%s ", font_keys[ITALIC_ANGLE_CODE].pdfname);
+ if (font_keys[ITALIC_ANGLE_CODE].valid)
+ pdf_printf("%g", font_keys[ITALIC_ANGLE_CODE].value);
+ else
+ pdf_printf("%g", -atan(getslant(tex_font)/65536.0)*(180/M_PI));
+ pdf_puts("\n");
+}
+
+static integer getstemv(void)
+{
+ return getcharwidth(tex_font, '.')/3;
+}
+
+static void getbbox(void)
+{
+ font_keys[FONTBBOX1_CODE].value = 0;
+ font_keys[FONTBBOX2_CODE].value =
+ dividescaled(-getchardepth(tex_font, 'y'), pdffontsize[tex_font], 3);
+ font_keys[FONTBBOX3_CODE].value =
+ dividescaled(getquad(tex_font), pdffontsize[tex_font], 3);
+ font_keys[FONTBBOX4_CODE].value =
+ dividescaled(getcharheight(tex_font, 'H'), pdffontsize[tex_font], 3);
+}
+
+static void get_char_widths(void)
+{
+ int i;
+ for (i = 0; i <= MAX_CHAR_CODE; i++) {
+ if (i < fontbc[tex_font] || i > fontec[tex_font])
+ char_widths[i] = 0;
+ else
+ char_widths[i] = getcharwidth(tex_font, i);
+ }
+ for (i = fontbc[tex_font]; i <= 32; i++)
+ char_widths[pdfcharmap[tex_font][i]] = char_widths[i];
+ for (i = fontbc[tex_font]; i <= MAX_CHAR_CODE; i++)
+ if (pdfcharmarked(tex_font, i))
+ break;
+ first_char = i;
+ for (i = MAX_CHAR_CODE; i > first_char; i--)
+ if (pdfcharmarked(tex_font, i))
+ break;
+ last_char = i;
+ if ((first_char > last_char) ||
+ (first_char == last_char && !pdfcharmarked(tex_font, first_char))) {
+ write_fontfile_only = true; /* the font is used in PDF images only */
+ return;
+ }
+ for (i = first_char; i <= last_char; i++)
+ if (pdfcharmarked(tex_font, i))
+ char_widths[i] = dividescaled(char_widths[i],
+ pdffontsize[tex_font], 3);
+ else
+ char_widths[i] = 0;
+}
+
+static void write_char_widths(void)
+{
+ int i;
+ pdfbeginobj(char_widths_objnum);
+ pdf_puts("[");
+ for (i = first_char; i <= last_char; i++)
+ pdf_printf("%i ", char_widths[i]);
+ pdf_puts("]\n");
+ pdfendobj();
+}
+
+static void write_fontname(boolean as_reference)
+{
+ if (as_reference && fm_cur->fn_objnum != 0) {
+ pdf_printf("%i 0 R\n", (int)fm_cur->fn_objnum);
+ return;
+ }
+ pdf_puts("/");
+ if (fm_cur->subset_tag != NULL)
+ pdf_printf("%s+", fm_cur->subset_tag);
+ if (font_keys[FONTNAME_CODE].valid)
+ pdf_printf("%s", fontname_buf);
+ else if (fm_cur->ps_name != NULL)
+ pdf_printf("%s", fm_cur->ps_name);
+ else
+ pdf_printf("%s", fm_cur->tfm_name);
+ pdf_puts("\n");
+}
+
+static void write_fontobj(integer font_objnum)
+{
+ pdfbegindict(font_objnum);
+ pdf_puts("/Type /Font\n");
+ pdf_printf("/Subtype /%s\n", is_truetype(fm_cur) ? "TrueType" : "Type1");
+ if (encoding_objnum != 0)
+ pdf_printf("/Encoding %i 0 R\n", (int)encoding_objnum);
+ if (pdffontattr[tex_font] != getnullstr()) {
+ pdfprint(pdffontattr[tex_font]);
+ pdf_puts("\n");
+ }
+ if (no_font_desc(fm_cur)) {
+ pdf_printf("/BaseFont /%s\n", fm_cur->ps_name);
+ pdfenddict();
+ return;
+ }
+ char_widths_objnum = pdfnewobjnum();
+ pdf_printf("/FirstChar %i\n/LastChar %i\n/Widths %i 0 R\n",
+ first_char, last_char, char_widths_objnum);
+ pdf_printf("/BaseFont ");
+ write_fontname(true);
+ if (fm_cur->fd_objnum == 0)
+ fm_cur->fd_objnum = pdfnewobjnum();
+ pdf_printf("/FontDescriptor %i 0 R\n", fm_cur->fd_objnum);
+ pdfenddict();
+}
+
+static void write_fontfile(void)
+{
+ int i;
+ for (i = 0; i < FONT_KEYS_NUM; i++)
+ font_keys[i].valid = false;
+ fontfile_found = false;
+ is_otf_font = false;
+ if (is_truetype(fm_cur))
+ writettf();
+ else
+ writet1();
+ if (!fontfile_found || !is_included(fm_cur))
+ return;
+ if (fm_cur->ff_objnum == 0)
+ pdftex_fail("font file object number for `%s' not initialized",
+ fm_cur->tfm_name);
+ pdfbegindict(fm_cur->ff_objnum); /* font file stream */
+ if (is_truetype(fm_cur))
+ pdf_printf("/Length1 %i\n", (int)ttf_length);
+ else if (is_otf_font)
+ pdf_printf("/Subtype /Type1C\n");
+ else
+ pdf_printf("/Length1 %i\n/Length2 %i\n/Length3 %i\n",
+ (int)t1_length1, (int)t1_length2, (int)t1_length3);
+ pdfbeginstream();
+ fb_flush();
+ pdfendstream();
+}
+
+static void write_fontdescriptor(void)
+{
+ int i;
+ pdfbegindict(fm_cur->fd_objnum); /* font descriptor */
+ print_key(ASCENT_CODE, getcharheight(tex_font, 'h'));
+ print_key(CAPHEIGHT_CODE, getcharheight(tex_font, 'H'));
+ print_key(DESCENT_CODE, -getchardepth(tex_font, 'y'));
+ pdf_printf("/FontName ");
+ write_fontname(true);
+ print_italic_angle();
+ print_key(STEMV_CODE, getstemv());
+ print_key(XHEIGHT_CODE, getxheight(tex_font));
+ if (!font_keys[FONTBBOX1_CODE].valid) {
+ getbbox();
+ }
+ pdf_printf("/%s [%i %i %i %i]\n",
+ font_keys[FONTBBOX1_CODE].pdfname,
+ (int)font_keys[FONTBBOX1_CODE].value,
+ (int)font_keys[FONTBBOX2_CODE].value,
+ (int)font_keys[FONTBBOX3_CODE].value,
+ (int)font_keys[FONTBBOX4_CODE].value);
+ if (!fontfile_found && fm_cur->flags == 4)
+ pdf_puts("/Flags 34\n"); /* assumes a roman sans serif font */
+ else
+ pdf_printf("/Flags %i\n", (int)fm_cur->flags);
+ if (is_included(fm_cur) && fontfile_found) {
+ if (is_subsetted(fm_cur) && !is_truetype(fm_cur)) {
+ cur_glyph_names = t1_glyph_names;
+ pdf_puts("/CharSet (");
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (pdfcharmarked(tex_font, i) && cur_glyph_names[i] != notdef)
+ pdf_printf("/%s", cur_glyph_names[i]);
+ pdf_puts(")\n");
+ }
+ if (is_truetype(fm_cur))
+ pdf_printf("/FontFile2 %i 0 R\n", fm_cur->ff_objnum);
+ else if (is_otf_font)
+ pdf_printf("/FontFile3 %i 0 R\n", fm_cur->ff_objnum);
+ else
+ pdf_printf("/FontFile %i 0 R\n", fm_cur->ff_objnum);
+ }
+ pdfenddict();
+}
+
+void dopdffont(integer font_objnum, internalfontnumber f)
+{
+ int i;
+ tex_font = f;
+ cur_glyph_names = NULL;
+ encoding_objnum = 0;
+ write_ttf_glyph_names = false;
+ write_fontfile_only = false;
+ if (pdffontmap[tex_font] == NULL)
+ pdftex_fail("pdffontmap not initialized for font %s",
+ makecstring(fontname[tex_font]));
+ if (hasfmentry(tex_font))
+ fm_cur = (fm_entry *) pdffontmap[tex_font];
+ else
+ fm_cur = NULL;
+ if (fm_cur == NULL || (fm_cur->ps_name == NULL && fm_cur->ff_name == NULL)) {
+ writet3(font_objnum, tex_font);
+ return;
+ }
+
+ get_char_widths(); /* update char widths; also check whether this font is
+ used in embedded PDF only; if so then set
+ write_fontfile_only to true */
+
+ if (!write_fontfile_only) { /* encoding vector needed */
+ if ((is_reencoded(fm_cur))) {
+ read_enc(fm_cur->encoding);
+ if (!is_truetype(fm_cur)) {
+ write_enc(NULL, fm_cur->encoding, 0);
+ encoding_objnum = (fm_cur->encoding)->objnum;
+ }
+ else
+ write_ttf_glyph_names = true;
+ }
+ else if (is_fontfile(fm_cur) && !is_truetype(fm_cur)) {
+ encoding_objnum = pdfnewobjnum();
+ }
+ }
+ if (is_included(fm_cur))
+ write_fontfile();
+ if (fm_cur->fn_objnum != 0) {
+ pdfbeginobj(fm_cur->fn_objnum);
+ write_fontname(false);
+ pdfendobj();
+ }
+ if (!write_fontfile_only)
+ write_fontobj(font_objnum);
+ if (no_font_desc(fm_cur))
+ return;
+ if (!write_fontfile_only) {
+ write_fontdescriptor();
+ write_char_widths();
+ }
+ if (cur_glyph_names == t1_builtin_glyph_names) {
+ if (!write_fontfile_only) {
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (!pdfcharmarked(tex_font, i) && cur_glyph_names[i] != notdef) {
+ xfree(cur_glyph_names[i]);
+ cur_glyph_names[i] = (char*) notdef;
+ }
+ write_enc(cur_glyph_names, NULL, encoding_objnum);
+ }
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (cur_glyph_names[i] != notdef)
+ xfree(cur_glyph_names[i]);
+ }
+}
diff --git a/Build/source/texk/web2c/pdftexdir/writeimg.c b/Build/source/texk/web2c/pdftexdir/writeimg.c
new file mode 100644
index 00000000000..397e5fba7e0
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writeimg.c
@@ -0,0 +1,354 @@
+/*
+Copyright (c) 1996-2002, 2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writeimg.c#18 $
+*/
+
+#include "ptexlib.h"
+#include "image.h"
+#include <kpathsea/c-auto.h>
+#include <kpathsea/c-memstr.h>
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writeimg.c#18 $";
+
+#define bp2int(p) round(p*(onehundredbp/100.0))
+
+/* define image_ptr, image_array & image_limit */
+define_array(image);
+
+float epdf_width;
+float epdf_height;
+float epdf_orig_x;
+float epdf_orig_y;
+integer epdf_selected_page;
+integer epdf_num_pages;
+integer epdf_page_box;
+integer epdf_always_use_pdf_pagebox;
+void *epdf_doc;
+
+static integer new_image_entry(void)
+{
+ alloc_array(image, 1, SMALL_BUF_SIZE);
+ image_ptr->image_type = IMAGE_TYPE_NONE;
+ image_ptr->color_type = 0;
+ image_ptr->num_pages = 0;
+ image_ptr->x_res = 0;
+ image_ptr->y_res = 0;
+ image_ptr->width = 0;
+ image_ptr->height = 0;
+ image_ptr->colorspace_ref = 0;
+ return image_ptr++ - image_array;
+}
+
+integer imagecolor(integer img)
+{
+ return img_color(img);
+}
+
+integer imagewidth(integer img)
+{
+ return img_width(img);
+}
+
+integer imageheight(integer img)
+{
+ return img_height(img);
+}
+
+integer imagexres(integer img)
+{
+ return img_xres(img);
+}
+
+integer imageyres(integer img)
+{
+ return img_yres(img);
+}
+
+boolean ispdfimage(integer img)
+{
+ return img_type(img) == IMAGE_TYPE_PDF;
+}
+
+boolean checkimageb(integer procset)
+{
+ return procset & IMAGE_COLOR_B;
+}
+
+boolean checkimagec(integer procset)
+{
+ return procset & IMAGE_COLOR_C;
+}
+
+boolean checkimagei(integer procset)
+{
+ return procset & IMAGE_COLOR_I;
+}
+
+void updateimageprocset(integer img)
+{
+ pdfimageprocset |= img_color(img);
+}
+
+integer epdforigx(integer img)
+{
+ return pdf_ptr(img)->orig_x;
+}
+
+integer epdforigy(integer img)
+{
+ return pdf_ptr(img)->orig_y;
+}
+
+integer imagepages(integer img)
+{
+ return img_pages(img);
+}
+
+integer imagecolordepth(integer img)
+{
+ switch (img_type(img)) {
+ case IMAGE_TYPE_PNG:
+ return png_info(img)->bit_depth;
+ case IMAGE_TYPE_JPG:
+ return jpg_ptr(img)->bits_per_component;
+ case IMAGE_TYPE_PDF:
+ return 0;
+ default:
+ pdftex_fail("unknown type of image");
+ }
+}
+
+/*
+ Patch ImageTypeDetection 2003/02/08 by Heiko Oberdiek.
+
+ Function "readimage" performs some basic initializations.
+ Then it looks at the file extension to determine the
+ image type and calls specific code/functions.
+ The main disadvantage is that standard file extensions
+ have to be used, otherwise pdfTeX is not able to detect
+ the correct image type.
+
+ The patch now looks at the file header first regardless of
+ the file extension. This is implemented in function
+ "checktypebyheader". If this check fails, the traditional
+ test of standard file extension is tried, done in function
+ "checktypebyextension".
+
+ Magic headers:
+
+ * "PNG (Portable Network Graphics) Specification", Version 1.2
+ (http://www.libpng.org/pub/png):
+
+ | 3.1. PNG file signature
+ |
+ | The first eight bytes of a PNG file always contain the following
+ | (decimal) values:
+ |
+ | 137 80 78 71 13 10 26 10
+
+ Translation to C: "\x89PNG\r\n\x1A\n"
+
+ * "JPEG File Interchange Format", Version 1.02:
+
+ | o you can identify a JFIF file by looking for the following
+ | sequence: X'FF', SOI X'FF', APP0, <2 bytes to be skipped>,
+ | "JFIF", X'00'.
+
+ Function "checktypebyheader" only looks at the first two bytes:
+ "\xFF\xD8"
+
+ * "PDF Reference", third edition:
+ * The first line should contain "%PDF-1.0" until "%PDF-1.4"
+ (section 3.4.1 "File Header").
+ * The "implementation notes" say:
+
+ | 3.4.1, File Header
+ | 12. Acrobat viewers require only that the header appear
+ | somewhere within the first 1024 bytes of the file.
+ | 13. Acrobat viewers will also accept a header of the form
+ | %!PS-Adobe-N.n PDF-M.m
+
+ The check in function "checktypebyheader" only implements
+ the first issue. The implementation notes are not considered.
+ Therefore files with garbage at start of file must have the
+ standard extension.
+
+ Functions "checktypebyheader" and "checktypebyextension":
+ img_type(img) is set to IMAGE_TYPE_NONE by new_image_entry().
+ Both functions tries to detect a type and set img_type(img).
+ Thus a value other than IMAGE_TYPE_NONE indicates that a
+ type is found.
+*/
+
+#define HEADER_JPG "\xFF\xD8"
+#define HEADER_PNG "\x89PNG\r\n\x1A\n"
+#define HEADER_PDF "%PDF-1."
+#define MAX_HEADER (sizeof(HEADER_PNG)-1)
+static void checktypebyheader(integer img)
+{
+ int i;
+ FILE *file = NULL;
+ char header[MAX_HEADER];
+
+ if (img_type(img) != IMAGE_TYPE_NONE) /* nothing to do */
+ return;
+
+ /* read the header */
+ file = xfopen(img_name(img), FOPEN_RBIN_MODE);
+ for (i=0; i<MAX_HEADER; i++) {
+ header[i] = xgetc(file);
+ if (feof(file))
+ pdftex_fail("reading image file failed");
+ }
+ xfclose(file, img_name(img));
+
+ /* tests */
+ if (strncmp(header, HEADER_JPG, sizeof(HEADER_JPG)-1) == 0)
+ img_type(img) = IMAGE_TYPE_JPG;
+ else if (strncmp(header, HEADER_PNG, sizeof(HEADER_PNG)-1) == 0)
+ img_type(img) = IMAGE_TYPE_PNG;
+ else if (strncmp(header, HEADER_PDF, sizeof(HEADER_PDF)-1) == 0)
+ img_type(img) = IMAGE_TYPE_PDF;
+}
+
+static void checktypebyextension(integer img)
+{
+ char *image_suffix;
+
+ if (img_type(img) != IMAGE_TYPE_NONE) /* nothing to do */
+ return;
+ /* tests */
+ if ((image_suffix = strrchr(cur_file_name, '.')) == 0)
+ img_type(img) = IMAGE_TYPE_NONE;
+ else if (strcasecmp(image_suffix, ".pdf") == 0)
+ img_type(img) = IMAGE_TYPE_PDF;
+ else if (strcasecmp(image_suffix, ".png") == 0)
+ img_type(img) = IMAGE_TYPE_PNG;
+ else if (strcasecmp(image_suffix, ".jpg") == 0 ||
+ strcasecmp(image_suffix, ".jpeg") == 0)
+ img_type(img) = IMAGE_TYPE_JPG;
+}
+
+integer readimage(strnumber s, integer page_num, strnumber page_name, integer colorspace,
+ integer pdfversion, integer pdfforcepagebox,
+ integer pdfinclusionerrorlevel)
+{
+ char *dest = NULL;
+ integer img = new_image_entry();
+ img_colorspace_ref(img) = colorspace;
+
+ /* need to allocate new string as makecstring's buffer is
+ already used by cur_file_name */
+ if (page_name != 0)
+ dest = xstrdup(makecstring(page_name));
+ cur_file_name = makecfilename(s);
+ img_name(img) = kpse_find_file(cur_file_name, kpse_tex_format, true);
+ if (img_name(img) == NULL)
+ pdftex_fail("cannot find image file");
+ /* kpse_find_file perhaps changed the file name */
+ cur_file_name = img_name(img);
+ /* type checks */
+ checktypebyheader(img);
+ checktypebyextension(img);
+ /* read image */
+ switch (img_type(img)) {
+ case IMAGE_TYPE_PDF:
+ pdf_ptr(img) = xtalloc(1, pdf_image_struct);
+ pdf_ptr(img)->page_box = pdflastpdfboxspec;
+ pdf_ptr(img)->always_use_pdfpagebox = pdfforcepagebox;
+ page_num = read_pdf_info(img_name(img), dest, page_num,
+ pdfversion, pdfforcepagebox,
+ pdfinclusionerrorlevel);
+ img_width(img) = bp2int(epdf_width);
+ img_height(img) = bp2int(epdf_height);
+ img_pages(img) = epdf_num_pages;
+ pdf_ptr(img)->orig_x = bp2int(epdf_orig_x);
+ pdf_ptr(img)->orig_y = bp2int(epdf_orig_y);
+ pdf_ptr(img)->selected_page = page_num;
+ pdf_ptr(img)->doc = epdf_doc;
+ break;
+ case IMAGE_TYPE_PNG:
+ img_pages(img) = 1;
+ read_png_info(img);
+ break;
+ case IMAGE_TYPE_JPG:
+ jpg_ptr(img) = xtalloc(1, JPG_IMAGE_INFO);
+ img_pages(img) = 1;
+ read_jpg_info(img);
+ break;
+ default:
+ pdftex_fail("unknown type of image");
+ }
+ xfree(dest);
+ cur_file_name = NULL;
+ return img;
+}
+
+void writeimage(integer img)
+{
+ cur_file_name = img_name(img);
+ tex_printf(" <%s", img_name(img));
+ switch (img_type(img)) {
+ case IMAGE_TYPE_PNG:
+ write_png(img);
+ break;
+ case IMAGE_TYPE_JPG:
+ write_jpg(img);
+ break;
+ case IMAGE_TYPE_PDF:
+ epdf_doc = pdf_ptr(img)->doc;
+ epdf_selected_page = pdf_ptr(img)->selected_page;
+ epdf_page_box = pdf_ptr(img)->page_box;
+ epdf_always_use_pdf_pagebox = pdf_ptr(img)->always_use_pdfpagebox;
+ write_epdf();
+ break;
+ default:
+ pdftex_fail("unknown type of image");
+ }
+ tex_printf(">");
+ cur_file_name = NULL;
+}
+
+void deleteimage(integer img)
+{
+ switch (img_type(img)) {
+ case IMAGE_TYPE_PDF:
+ epdf_doc = pdf_ptr(img)->doc;
+ epdf_delete();
+ break;
+ case IMAGE_TYPE_PNG:
+ xfclose(png_ptr(img)->io_ptr, cur_file_name);
+ png_destroy_read_struct(&(png_ptr(img)), &(png_info(img)), NULL);
+ break;
+ case IMAGE_TYPE_JPG:
+ xfclose(jpg_ptr(img)->file, cur_file_name);
+ break;
+ default:
+ pdftex_fail("unknown type of image");
+ }
+ xfree(img_name(img));
+ return;
+}
+
+void img_free()
+{
+ xfree(image_array);
+}
diff --git a/Build/source/texk/web2c/pdftexdir/writejpg.c b/Build/source/texk/web2c/pdftexdir/writejpg.c
new file mode 100644
index 00000000000..1b01737e4e5
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writejpg.c
@@ -0,0 +1,227 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writejpg.c#10 $
+*/
+
+#include "ptexlib.h"
+#include "image.h"
+
+#define JPG_GRAY 1 /* Gray color space, use /DeviceGray */
+#define JPG_RGB 3 /* RGB color space, use /DeviceRGB */
+#define JPG_CMYK 4 /* CMYK color space, use /DeviceCMYK */
+
+typedef enum { /* JPEG marker codes */
+ M_SOF0 = 0xc0, /* baseline DCT */
+ M_SOF1 = 0xc1, /* extended sequential DCT */
+ M_SOF2 = 0xc2, /* progressive DCT */
+ M_SOF3 = 0xc3, /* lossless (sequential) */
+
+ M_SOF5 = 0xc5, /* differential sequential DCT */
+ M_SOF6 = 0xc6, /* differential progressive DCT */
+ M_SOF7 = 0xc7, /* differential lossless */
+
+ M_JPG = 0xc8, /* JPEG extensions */
+ M_SOF9 = 0xc9, /* extended sequential DCT */
+ M_SOF10 = 0xca, /* progressive DCT */
+ M_SOF11 = 0xcb, /* lossless (sequential) */
+
+ M_SOF13 = 0xcd, /* differential sequential DCT */
+ M_SOF14 = 0xce, /* differential progressive DCT */
+ M_SOF15 = 0xcf, /* differential lossless */
+
+ M_DHT = 0xc4, /* define Huffman tables */
+
+ M_DAC = 0xcc, /* define arithmetic conditioning table */
+
+ M_RST0 = 0xd0, /* restart */
+ M_RST1 = 0xd1, /* restart */
+ M_RST2 = 0xd2, /* restart */
+ M_RST3 = 0xd3, /* restart */
+ M_RST4 = 0xd4, /* restart */
+ M_RST5 = 0xd5, /* restart */
+ M_RST6 = 0xd6, /* restart */
+ M_RST7 = 0xd7, /* restart */
+
+ M_SOI = 0xd8, /* start of image */
+ M_EOI = 0xd9, /* end of image */
+ M_SOS = 0xda, /* start of scan */
+ M_DQT = 0xdb, /* define quantization tables */
+ M_DNL = 0xdc, /* define number of lines */
+ M_DRI = 0xdd, /* define restart interval */
+ M_DHP = 0xde, /* define hierarchical progression */
+ M_EXP = 0xdf, /* expand reference image(s) */
+
+ M_APP0 = 0xe0, /* application marker, used for JFIF */
+ M_APP1 = 0xe1, /* application marker */
+ M_APP2 = 0xe2, /* application marker */
+ M_APP3 = 0xe3, /* application marker */
+ M_APP4 = 0xe4, /* application marker */
+ M_APP5 = 0xe5, /* application marker */
+ M_APP6 = 0xe6, /* application marker */
+ M_APP7 = 0xe7, /* application marker */
+ M_APP8 = 0xe8, /* application marker */
+ M_APP9 = 0xe9, /* application marker */
+ M_APP10 = 0xea, /* application marker */
+ M_APP11 = 0xeb, /* application marker */
+ M_APP12 = 0xec, /* application marker */
+ M_APP13 = 0xed, /* application marker */
+ M_APP14 = 0xee, /* application marker, used by Adobe */
+ M_APP15 = 0xef, /* application marker */
+
+ M_JPG0 = 0xf0, /* reserved for JPEG extensions */
+ M_JPG13 = 0xfd, /* reserved for JPEG extensions */
+ M_COM = 0xfe, /* comment */
+
+ M_TEM = 0x01, /* temporary use */
+
+ M_ERROR = 0x100 /* dummy marker, internal use only */
+} JPEG_MARKER;
+
+static JPG_UINT16 read2bytes(FILE *f)
+{
+ int c = xgetc(f);
+ return (c << 8) + xgetc(f);
+}
+
+void read_jpg_info(integer img)
+{
+ int i;
+ char jpg_id[]="JFIF";
+ int units=0;
+ img_xres(img)=img_yres(img)=0;
+ jpg_ptr(img)->file = xfopen(img_name(img), FOPEN_RBIN_MODE);
+ xfseek(jpg_ptr(img)->file,0,SEEK_END,cur_file_name);
+ jpg_ptr(img)->length=xftell(jpg_ptr(img)->file,cur_file_name);
+ xfseek(jpg_ptr(img)->file,0,SEEK_SET,cur_file_name);
+ if(read2bytes(jpg_ptr(img)->file)!=0xFFD8)
+ pdftex_fail("reading JPEG image failed");
+
+ if(read2bytes(jpg_ptr(img)->file)==0xFFE0) { /* JFIF APP0 */
+ (void)read2bytes(jpg_ptr(img)->file);
+ for(i=0;i<5;i++) if(xgetc(jpg_ptr(img)->file)!=jpg_id[i])
+ pdftex_fail("reading JPEG image failed");
+ (void)read2bytes(jpg_ptr(img)->file);
+ units=xgetc(jpg_ptr(img)->file);
+ img_xres(img)=read2bytes(jpg_ptr(img)->file);
+ img_yres(img)=read2bytes(jpg_ptr(img)->file);
+ switch(units) {
+ case 1: break; /* pixels per inch */
+ case 2: img_xres(img)*=2.54; img_yres(img)*=2.54;
+ break; /* pixels per cm */
+ default:img_xres(img)=img_yres(img)=0; break;
+ }
+ }
+
+ xfseek(jpg_ptr(img)->file,0,SEEK_SET,cur_file_name);
+ while(1) {
+ if(feof(jpg_ptr(img)->file) || fgetc(jpg_ptr(img)->file)!=0xFF)
+ pdftex_fail("reading JPEG image failed");
+ switch(xgetc(jpg_ptr(img)->file)) {
+ case M_SOF5:
+ case M_SOF6:
+ case M_SOF7:
+ case M_SOF9:
+ case M_SOF10:
+ case M_SOF11:
+ case M_SOF13:
+ case M_SOF14:
+ case M_SOF15:
+ pdftex_fail("unsupported type of compression");
+ case M_SOF2:
+ if (fixedpdfminorversion <= 2)
+ pdftex_fail("cannot use progressive DCT with PDF-1.2");
+ case M_SOF0:
+ case M_SOF1:
+ case M_SOF3:
+ (void)read2bytes(jpg_ptr(img)->file); /* read segment length */
+ jpg_ptr(img)->bits_per_component = xgetc(jpg_ptr(img)->file);
+ img_height(img) = read2bytes(jpg_ptr(img)->file);
+ img_width(img) = read2bytes(jpg_ptr(img)->file);
+ jpg_ptr(img)->color_space = xgetc(jpg_ptr(img)->file);
+ xfseek(jpg_ptr(img)->file,0,SEEK_SET,cur_file_name);
+ switch (jpg_ptr(img)->color_space) {
+ case JPG_GRAY:
+ img_color(img) = IMAGE_COLOR_B;
+ break;
+ case JPG_RGB:
+ img_color(img) = IMAGE_COLOR_C;
+ break;
+ case JPG_CMYK:
+ img_color(img) = IMAGE_COLOR_C;
+ break;
+ default:
+ pdftex_fail("Unsupported color space %i",
+ (int)jpg_ptr(img)->color_space);
+ }
+ return;
+ case M_SOI: /* ignore markers without parameters */
+ case M_EOI:
+ case M_TEM:
+ case M_RST0:
+ case M_RST1:
+ case M_RST2:
+ case M_RST3:
+ case M_RST4:
+ case M_RST5:
+ case M_RST6:
+ case M_RST7:
+ break;
+ default: /* skip variable length markers */
+ xfseek(jpg_ptr(img)->file,read2bytes(jpg_ptr(img)->file)-2,SEEK_CUR,cur_file_name);
+ break;
+ }
+ }
+}
+
+void write_jpg(integer img)
+{
+ long unsigned l;
+ FILE *f;
+ pdf_puts("/Type /XObject\n/Subtype /Image\n");
+ pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n/Length %i\n",
+ img_width(img),
+ img_height(img),
+ (int)jpg_ptr(img)->bits_per_component,
+ (int)jpg_ptr(img)->length);
+ pdf_puts("/ColorSpace ");
+ if (img_colorspace_ref(img) != 0) {
+ pdf_printf("%i 0 R\n", (int)img_colorspace_ref(img));
+ }
+ else {
+ switch (jpg_ptr(img)->color_space) {
+ case JPG_GRAY:
+ pdf_puts("/DeviceGray\n");
+ break;
+ case JPG_RGB:
+ pdf_puts("/DeviceRGB\n");
+ break;
+ case JPG_CMYK:
+ pdf_puts("/DeviceCMYK\n/Decode [1 0 1 0 1 0 1 0]\n");
+ break;
+ default:
+ pdftex_fail("Unsupported color space %i",
+ (int)jpg_ptr(img)->color_space);
+ }
+ }
+ pdf_puts("/Filter /DCTDecode\n>>\nstream\n");
+ for (l = jpg_ptr(img)->length, f = jpg_ptr(img)->file; l > 0; l--)
+ pdfout(xgetc(f));
+ pdf_puts("endstream\nendobj\n");
+}
diff --git a/Build/source/texk/web2c/pdftexdir/writepng.c b/Build/source/texk/web2c/pdftexdir/writepng.c
new file mode 100644
index 00000000000..30340c9e08e
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writepng.c
@@ -0,0 +1,593 @@
+/*
+Copyright (c) 1996-2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writepng.c#8 $
+*/
+
+#include "ptexlib.h"
+#include "image.h"
+
+
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writepng.c#8 $";
+
+
+void read_png_info(integer img)
+{
+ double gamma;
+ FILE *png_file = xfopen(img_name(img), FOPEN_RBIN_MODE);
+
+ if ((png_ptr(img) = png_create_read_struct(PNG_LIBPNG_VER_STRING,
+ NULL, NULL, NULL)) == NULL)
+ pdftex_fail("libpng: png_create_read_struct() failed");
+ if ((png_info(img) = png_create_info_struct(png_ptr(img))) == NULL)
+ pdftex_fail("libpng: png_create_info_struct() failed");
+ if (setjmp(png_ptr(img)->jmpbuf))
+ pdftex_fail("libpng: internal error");
+ png_init_io(png_ptr(img), png_file);
+ png_read_info(png_ptr(img), png_info(img));
+ /* simple transparency support */
+ if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_tRNS)) {
+ png_set_tRNS_to_alpha(png_ptr(img));
+ }
+ /* alpha channel support */
+ if (fixedpdfminorversion < 4 && png_ptr(img)->color_type | PNG_COLOR_MASK_ALPHA)
+ png_set_strip_alpha(png_ptr(img));
+ /* 16bit depth support */
+ if (fixedpdfminorversion < 5)
+ fixedimagehicolor = 0;
+ if (png_info(img)->bit_depth == 16 && !fixedimagehicolor)
+ png_set_strip_16(png_ptr(img));
+ /* gamma support */
+ if (fixedimageapplygamma) {
+ if(png_get_gAMA(png_ptr(img), png_info(img), &gamma))
+ png_set_gamma(png_ptr(img), (fixedgamma / 1000.0), gamma);
+ else
+ png_set_gamma(png_ptr(img), (fixedgamma / 1000.0), (1000.0/ fixedimagegamma ));
+ }
+ /* reset structure */
+ png_read_update_info(png_ptr(img), png_info(img));
+ /* resolution support */
+ img_width(img) = png_info(img)->width;
+ img_height(img) = png_info(img)->height;
+ if (png_info(img)->valid & PNG_INFO_pHYs) {
+ img_xres(img) =
+ round(0.0254*png_get_x_pixels_per_meter(png_ptr(img), png_info(img)));
+ img_yres(img) =
+ round(0.0254*png_get_y_pixels_per_meter(png_ptr(img), png_info(img)));
+ }
+ switch (png_info(img)->color_type) {
+ case PNG_COLOR_TYPE_PALETTE:
+ img_color(img) = IMAGE_COLOR_C | IMAGE_COLOR_I;
+ break;
+ case PNG_COLOR_TYPE_GRAY:
+ case PNG_COLOR_TYPE_GRAY_ALPHA:
+ img_color(img) = IMAGE_COLOR_B;
+ break;
+ case PNG_COLOR_TYPE_RGB:
+ case PNG_COLOR_TYPE_RGB_ALPHA:
+ img_color(img) = IMAGE_COLOR_C;
+ break;
+ default:
+ pdftex_fail("unsupported type of color_type <%i>", png_info(img)->color_type);
+ }
+}
+
+
+#define write_gray_pixel_16(r) \
+ if (j % 4 == 0||j % 4 == 1) pdfbuf[pdfptr++] = *r++; \
+ else smask[smask_ptr++] = *r++
+
+#define write_gray_pixel_8(r) \
+ if (j % 2 == 0) pdfbuf[pdfptr++] = *r++; \
+ else smask[smask_ptr++] = *r++
+
+
+#define write_rgb_pixel_16(r) \
+ if (!(j % 8 == 6||j % 8 == 7)) pdfbuf[pdfptr++] = *r++; \
+ else smask[smask_ptr++] = *r++
+
+#define write_rgb_pixel_8(r) \
+ if (j % 4 != 3) pdfbuf[pdfptr++] = *r++; \
+ else smask[smask_ptr++] = *r++
+
+#define write_simple_pixel(r) pdfbuf[pdfptr++] = *r++
+
+
+#define write_noninterlaced(outmac) \
+ for (i = 0; i < (int)png_info(img)->height; i++) { \
+ png_read_row(png_ptr(img), row, NULL); \
+ r = row; \
+ k = png_info(img)->rowbytes; \
+ while(k > 0) { \
+ l = (k > pdfbufsize)? pdfbufsize : k; \
+ pdfroom(l); \
+ for (j = 0; j < l; j++) { \
+ outmac; \
+ } \
+ k -= l; \
+ } \
+ }
+
+#define write_interlaced(outmac) \
+ for (i = 0; i < (int)png_info(img)->height; i++) { \
+ row = rows[i]; \
+ k = png_info(img)->rowbytes; \
+ while(k > 0) { \
+ l = (k > pdfbufsize)? pdfbufsize : k; \
+ pdfroom(l); \
+ for (j = 0; j < l; j++) { \
+ outmac; \
+ } \
+ k -= l; \
+ } \
+ xfree(rows[i]); \
+ }
+
+
+void write_png_palette (integer img)
+{
+ int i, j, k, l;
+ png_bytep row, r, *rows;
+ integer palette_objnum = 0;
+ pdfcreateobj(0, 0);
+ palette_objnum = objptr;
+ if (img_colorspace_ref(img) != 0) {
+ pdf_printf("%i 0 R\n", (int)img_colorspace_ref(img));
+ }
+ else {
+ pdf_printf("[/Indexed /DeviceRGB %i %i 0 R]\n",
+ (int)(png_info(img)->num_palette - 1),
+ (int)palette_objnum);
+ }
+ pdfbeginstream();
+ if (png_info(img)->interlace_type == PNG_INTERLACE_NONE) {
+ row = xtalloc(png_info(img)->rowbytes, png_byte);
+ write_noninterlaced(write_simple_pixel(r));
+ xfree(row);
+ } else {
+ if (png_info(img)->height*png_info(img)->rowbytes >= 10240000L)
+ pdftex_warn("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+ rows = xtalloc(png_info(img)->height, png_bytep);
+ for (i = 0; i < png_info(img)->height; i++)
+ rows[i] = xtalloc(png_info(img)->rowbytes, png_byte);
+ png_read_image(png_ptr(img), rows);
+ write_interlaced(write_simple_pixel(row));
+ xfree(rows);
+ }
+ pdfendstream();
+ if (palette_objnum > 0) {
+ pdfbegindict(palette_objnum);
+ pdfbeginstream();
+ for (i = 0; i < png_info(img)->num_palette; i++) {
+ pdfroom(3);
+ pdfbuf[pdfptr++] = png_info(img)->palette[i].red;
+ pdfbuf[pdfptr++] = png_info(img)->palette[i].green;
+ pdfbuf[pdfptr++] = png_info(img)->palette[i].blue;
+ }
+ pdfendstream();
+ }
+}
+
+void write_png_gray (integer img)
+{
+ int i, j, k, l;
+ png_bytep row, r, *rows;
+ if (img_colorspace_ref(img) != 0) {
+ pdf_printf("%i 0 R\n", (int)img_colorspace_ref(img));
+ }
+ else {
+ pdf_puts("/DeviceGray\n");
+ }
+ pdfbeginstream();
+ if (png_info(img)->interlace_type == PNG_INTERLACE_NONE) {
+ row = xtalloc(png_info(img)->rowbytes, png_byte);
+ write_noninterlaced(write_simple_pixel(r));
+ xfree(row);
+ } else {
+ if (png_info(img)->height*png_info(img)->rowbytes >= 10240000L)
+ pdftex_warn("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+ rows = xtalloc(png_info(img)->height, png_bytep);
+ for (i = 0; i < png_info(img)->height; i++)
+ rows[i] = xtalloc(png_info(img)->rowbytes, png_byte);
+ png_read_image(png_ptr(img), rows);
+ write_interlaced(write_simple_pixel(row));
+ xfree(rows);
+ }
+ pdfendstream();
+}
+
+
+
+void write_png_gray_alpha (integer img)
+{
+ int i, j, k, l;
+ png_bytep row, r, *rows;
+ integer smask_objnum = 0;
+ png_bytep smask;
+ integer smask_ptr = 0;
+ integer smask_size = 0;
+ int bitdepth;
+ if (img_colorspace_ref(img) != 0) {
+ pdf_printf("%i 0 R\n", (int)img_colorspace_ref(img));
+ }
+ else {
+ pdf_puts("/DeviceGray\n");
+ }
+ pdfcreateobj(0, 0);
+ smask_objnum = objptr;
+ pdf_printf("/SMask %i 0 R\n",
+ (int)smask_objnum);
+ smask_size = (png_info(img)->rowbytes/2)*png_info(img)->height;
+ smask = xtalloc(smask_size, png_byte);
+ pdfbeginstream();
+ if (png_info(img)->interlace_type == PNG_INTERLACE_NONE) {
+ row = xtalloc(png_info(img)->rowbytes, png_byte);
+ if ((png_info(img)->bit_depth == 16) && fixedimagehicolor) {
+ write_noninterlaced(write_gray_pixel_16(r));
+ } else {
+ write_noninterlaced(write_gray_pixel_8(r));
+ }
+ xfree(row);
+ } else {
+ if (png_info(img)->height*png_info(img)->rowbytes >= 10240000L)
+ pdftex_warn("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+ rows = xtalloc(png_info(img)->height, png_bytep);
+ for (i = 0; i < png_info(img)->height; i++)
+ rows[i] = xtalloc(png_info(img)->rowbytes, png_byte);
+ png_read_image(png_ptr(img), rows);
+ if ((png_info(img)->bit_depth == 16) && fixedimagehicolor) {
+ write_interlaced(write_gray_pixel_16(row));
+ } else {
+ write_interlaced(write_gray_pixel_8(row));
+ }
+ xfree(rows);
+ }
+ pdfendstream();
+ pdfflush();
+ /* now write the Smask object */
+ if (smask_objnum > 0) {
+ bitdepth = (int)png_info(img)->bit_depth;
+ pdfbegindict(smask_objnum);
+ pdf_puts("/Type /XObject\n/Subtype /Image\n");
+ pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n",
+ (int)png_info(img)->width,
+ (int)png_info(img)->height,
+ (bitdepth == 16 ? 8 : bitdepth));
+ pdf_puts("/ColorSpace /DeviceGray\n");
+ pdfbeginstream();
+ for (i = 0; i <smask_size; i++) {
+ if (i % 8 == 0)
+ pdfroom(8);
+ pdfbuf[pdfptr++] = smask[i];
+ if (bitdepth == 16)
+ i++;
+ }
+ xfree(smask);
+ pdfendstream();
+ }
+}
+
+void write_png_rgb (integer img)
+{
+ int i, j, k, l;
+ png_bytep row, r, *rows;
+ if (img_colorspace_ref(img) != 0) {
+ pdf_printf("%i 0 R\n", (int)img_colorspace_ref(img));
+ }
+ else {
+ pdf_puts("/DeviceRGB\n");
+ }
+ pdfbeginstream();
+ if (png_info(img)->interlace_type == PNG_INTERLACE_NONE) {
+ row = xtalloc(png_info(img)->rowbytes, png_byte);
+ write_noninterlaced(write_simple_pixel(r));
+ xfree(row);
+ } else {
+ if (png_info(img)->height*png_info(img)->rowbytes >= 10240000L)
+ pdftex_warn("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+ rows = xtalloc(png_info(img)->height, png_bytep);
+ for (i = 0; i < png_info(img)->height; i++)
+ rows[i] = xtalloc(png_info(img)->rowbytes, png_byte);
+ png_read_image(png_ptr(img), rows);
+ write_interlaced(write_simple_pixel(row));
+ xfree(rows);
+ }
+ pdfendstream();
+}
+
+void write_png_rgb_alpha (integer img)
+{
+ int i, j, k, l;
+ png_bytep row, r, *rows;
+ integer smask_objnum = 0;
+ png_bytep smask;
+ integer smask_ptr = 0;
+ integer smask_size = 0;
+ int bitdepth;
+ if (img_colorspace_ref(img) != 0) {
+ pdf_printf("%i 0 R\n", (int)img_colorspace_ref(img));
+ }
+ else {
+ pdf_puts("/DeviceRGB\n");
+ }
+ pdfcreateobj(0, 0);
+ smask_objnum = objptr;
+ pdf_printf("/SMask %i 0 R\n",
+ (int)smask_objnum);
+ smask_size = (png_info(img)->rowbytes/2)*png_info(img)->height;
+ smask = xtalloc(smask_size, png_byte);
+ pdfbeginstream();
+ if (png_info(img)->interlace_type == PNG_INTERLACE_NONE) {
+ row = xtalloc(png_info(img)->rowbytes, png_byte);
+ if ((png_info(img)->bit_depth == 16) && fixedimagehicolor) {
+ write_noninterlaced(write_rgb_pixel_16(r));
+ } else {
+ write_noninterlaced(write_rgb_pixel_8(r));
+ }
+ xfree(row);
+ } else {
+ if (png_info(img)->height*png_info(img)->rowbytes >= 10240000L)
+ pdftex_warn("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+ rows = xtalloc(png_info(img)->height, png_bytep);
+ for (i = 0; i < png_info(img)->height; i++)
+ rows[i] = xtalloc(png_info(img)->rowbytes, png_byte);
+ png_read_image(png_ptr(img), rows);
+ if ((png_info(img)->bit_depth == 16) && fixedimagehicolor) {
+ write_interlaced(write_rgb_pixel_16(row));
+ } else {
+ write_interlaced(write_rgb_pixel_8(row));
+ }
+ xfree(rows);
+ }
+ pdfendstream();
+ pdfflush();
+ /* now write the Smask object */
+ if (smask_objnum > 0) {
+ bitdepth = (int)png_info(img)->bit_depth;
+ pdfbegindict(smask_objnum);
+ pdf_puts("/Type /XObject\n/Subtype /Image\n");
+ pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n",
+ (int)png_info(img)->width,
+ (int)png_info(img)->height,
+ (bitdepth == 16 ? 8 : bitdepth));
+ pdf_puts("/ColorSpace /DeviceGray\n");
+ pdfbeginstream();
+ for (i = 0; i <smask_size; i++) {
+ if (i % 8 == 0)
+ pdfroom(8);
+ pdfbuf[pdfptr++] = smask[i];
+ if (bitdepth == 16)
+ i++;
+ }
+ xfree(smask);
+ pdfendstream();
+ }
+}
+
+
+/**********************************************************************/
+/*
+ *
+ * The |copy_png| function is from Hartmut Henkel. The goal is to use
+ * pdf's native FlateDecode support if that is possible.
+ *
+ * Only a subset of the png files allows this, but when possible it
+ * greatly improves inclusion speed.
+ *
+ */
+
+/* Code cheerfully gleaned from Thomas Merz' PDFlib, file p_png.c "SPNG - Simple PNG" */
+
+static int spng_getint(FILE * fp)
+{
+ unsigned char buf[4];
+ if (fread(buf, 1, 4, fp) != 4)
+ pdftex_fail("writepng: reading chunk type failed");
+ return (((((int) buf[0] << 8) + buf[1]) << 8) + buf[2] << 8) + buf[3];
+}
+
+#define SPNG_CHUNK_IDAT 0x49444154
+#define SPNG_CHUNK_IEND 0x49454E44
+
+void copy_png(integer img)
+{
+ FILE *fp = png_ptr(img)->io_ptr;
+ int i, len, type, streamlength = 0;
+ boolean endflag = false;
+ int idat = 0; /* flag to check continuous IDAT chunks sequence */
+ /* 1st pass to find overall stream /Length */
+ if (fseek(fp, 8, SEEK_SET) != 0)
+ pdftex_fail("writepng: fseek in PNG file failed");
+ do {
+ len = spng_getint(fp);
+ type = spng_getint(fp);
+ switch (type) {
+ case SPNG_CHUNK_IEND:
+ endflag = true;
+ break;
+ case SPNG_CHUNK_IDAT:
+ streamlength += len;
+ default:
+ if (fseek(fp, len + 4, SEEK_CUR) != 0)
+ pdftex_fail("writepng: fseek in PNG file failed");
+ }
+ } while (endflag == false);
+ pdf_printf("/Length %d\n", streamlength);
+ pdf_printf("/Filter /FlateDecode\n");
+ pdf_printf("/DecodeParms << ");
+ pdf_printf("/Colors %d ", png_info(img)->color_type == 2 ? 3 : 1);
+ pdf_printf("/Columns %d ", (int) png_info(img)->width);
+ pdf_printf("/BitsPerComponent %i ", (int) png_info(img)->bit_depth);
+ pdf_printf("/Predictor %d ", 10); /* actual predictor defined on line basis */
+ pdf_printf(">>\n>>\nstream\n");
+ /* 2nd pass to copy data */
+ endflag = false;
+ if (fseek(fp, 8, SEEK_SET) != 0)
+ pdftex_fail("writepng: fseek in PNG file failed");
+ do {
+ len = spng_getint(fp);
+ type = spng_getint(fp);
+ switch (type) {
+ case SPNG_CHUNK_IDAT: /* do copy */
+ if (idat == 2)
+ pdftex_fail("writepng: IDAT chunk sequence broken");
+ idat = 1;
+ while (len > 0) {
+ i = (len > pdfbufsize) ? pdfbufsize : len;
+ pdfroom(i);
+ fread(&pdfbuf[pdfptr], 1, i, fp);
+ pdfptr += i;
+ len -= i;
+ }
+ if (fseek(fp, 4, SEEK_CUR) != 0)
+ pdftex_fail("writepng: fseek in PNG file failed");
+ break;
+ case SPNG_CHUNK_IEND: /* done */
+ pdf_puts("\nendstream\nendobj\n");
+ endflag = true;
+ break;
+ default:
+ if (idat == 1)
+ idat = 2;
+ if (fseek(fp, len + 4, SEEK_CUR) != 0)
+ pdftex_fail("writepng: fseek in PNG file failed");
+ }
+ } while (endflag == false);
+}
+
+void write_png (integer img)
+{
+
+ double gamma, checked_gamma;
+ int i;
+ integer palette_objnum = 0;
+ if (fixedpdfminorversion < 5)
+ fixedimagehicolor = 0;
+
+ pdf_puts("/Type /XObject\n/Subtype /Image\n");
+ pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n",
+ (int)png_info(img)->width,
+ (int)png_info(img)->height,
+ (int)png_info(img)->bit_depth);
+ pdf_puts("/ColorSpace ");
+ checked_gamma = 1.0;
+ if (fixedimageapplygamma) {
+ if(png_get_gAMA(png_ptr(img), png_info(img), &gamma)) {
+ checked_gamma = (fixedgamma / 1000.0) * gamma;
+ } else {
+ checked_gamma = (fixedgamma / 1000.0) * (1000.0/ fixedimagegamma );
+ }
+ }
+ /* the switching between |png_info| and |png_ptr| queries has been trial and error.
+ */
+ if (fixedpdfminorversion > 1
+ && png_info(img)->interlace_type == PNG_INTERLACE_NONE
+ && (png_ptr(img)->transformations == 0 ||
+ png_ptr(img)->transformations == 0x2000 ) /* gamma */
+ && !(png_ptr(img)->color_type == PNG_COLOR_TYPE_GRAY_ALPHA ||
+ png_ptr(img)->color_type == PNG_COLOR_TYPE_RGB_ALPHA)
+ && (fixedimagehicolor || (png_ptr(img)->bit_depth <= 8))
+ && (checked_gamma <= 1.01 && checked_gamma > 0.99)
+ )
+ {
+ if (img_colorspace_ref(img) != 0) {
+ pdf_printf("%i 0 R\n", (int)img_colorspace_ref(img));
+ }
+ else {
+ switch (png_info(img)->color_type) {
+ case PNG_COLOR_TYPE_PALETTE:
+ pdfcreateobj(0, 0);
+ palette_objnum = objptr;
+ pdf_printf("[/Indexed /DeviceRGB %i %i 0 R]\n",
+ (int) (png_info(img)->num_palette - 1),
+ (int) palette_objnum);
+ break;
+ case PNG_COLOR_TYPE_GRAY:
+ pdf_puts("/DeviceGray\n");
+ break;
+ default: /* RGB */
+ pdf_puts("/DeviceRGB\n");
+ };
+ }
+ tex_printf(" (PNG copy)");
+ copy_png(img);
+ if (palette_objnum > 0) {
+ pdfbegindict(palette_objnum);
+ pdfbeginstream();
+ for (i = 0; i < png_info(img)->num_palette; i++) {
+ pdfroom(3);
+ pdfbuf[pdfptr++] = png_info(img)->palette[i].red;
+ pdfbuf[pdfptr++] = png_info(img)->palette[i].green;
+ pdfbuf[pdfptr++] = png_info(img)->palette[i].blue;
+ }
+ pdfendstream();
+ }
+ } else {
+ if (0) {
+ tex_printf(" PNG copy skipped because: ");
+ if(fixedimageapplygamma &&
+ (checked_gamma > 1.01 || checked_gamma < 0.99))
+ tex_printf("gamma delta=%lf ", checked_gamma);
+ if (png_ptr(img)->transformations != PNG_TRANSFORM_IDENTITY)
+ tex_printf("transform=%d",png_ptr(img)->transformations);
+ if ((png_info(img)->color_type != PNG_COLOR_TYPE_GRAY) &&
+ (png_info(img)->color_type != PNG_COLOR_TYPE_RGB) &&
+ (png_info(img)->color_type != PNG_COLOR_TYPE_PALETTE))
+ tex_printf("colortype ");
+ if (fixedpdfminorversion <= 1)
+ tex_printf("version=%d ",fixedpdfminorversion);
+ if (png_info(img)->interlace_type != PNG_INTERLACE_NONE)
+ tex_printf("interlaced ");
+ if (png_info(img)->bit_depth > 8)
+ tex_printf("bitdepth=%d ",png_info(img)->bit_depth);
+ if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_tRNS))
+ tex_printf("simple transparancy ");
+ }
+ switch (png_info(img)->color_type) {
+ case PNG_COLOR_TYPE_PALETTE:
+ write_png_palette(img);
+ break;
+ case PNG_COLOR_TYPE_GRAY:
+ write_png_gray(img);
+ break;
+ case PNG_COLOR_TYPE_GRAY_ALPHA:
+ if (fixedpdfminorversion >=4)
+ write_png_gray_alpha(img);
+ else
+ write_png_gray(img);
+ break;
+ case PNG_COLOR_TYPE_RGB:
+ write_png_rgb(img);
+ break;
+ case PNG_COLOR_TYPE_RGB_ALPHA:
+ if (fixedpdfminorversion >=4)
+ write_png_rgb_alpha(img);
+ else
+ write_png_rgb(img);
+ break;
+ default:
+ pdftex_fail("unsupported type of color_type <%i>", png_info(img)->color_type);
+ }
+ }
+ pdfflush();
+}
+
+
diff --git a/Build/source/texk/web2c/pdftexdir/writet1.c b/Build/source/texk/web2c/pdftexdir/writet1.c
new file mode 100644
index 00000000000..08704286524
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writet1.c
@@ -0,0 +1,1780 @@
+/*
+Copyright (c) 1996-2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writet1.c#25 $
+*/
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writet1.c#25 $";
+
+#ifdef pdfTeX /* writet1 used with pdfTeX */
+#include "ptexlib.h"
+#define t1_log(s) tex_printf(s)
+#define t1_open() \
+ open_input(&t1_file, kpse_type1_format, FOPEN_RBIN_MODE)
+#define enc_open() \
+ open_input(&enc_file, kpse_enc_format, FOPEN_RBIN_MODE)
+#define external_enc() (fm_cur->encoding)->glyph_names
+#define full_file_name() (char*)nameoffile + 1
+#define get_length1() t1_length1 = t1_offset() - t1_save_offset
+#define get_length2() t1_length2 = t1_offset() - t1_save_offset
+#define get_length3() t1_length3 = t1_offset() - t1_save_offset
+#define is_used_char(c) pdfcharmarked(tex_font, c)
+#define t1_putchar fb_putchar
+#define t1_offset fb_offset
+#define out_eexec_char t1_putchar
+#define save_offset() t1_save_offset = t1_offset()
+#define end_last_eexec_line() \
+ t1_eexec_encrypt = false
+#define t1_char(c) c
+#define embed_all_glyphs(tex_font) fm_cur->all_glyphs
+#define extra_charset() fm_cur->charset
+#define update_subset_tag() \
+ strncpy(fb_array + t1_fontname_offset, fm_cur->subset_tag, 6)
+
+integer t1_length1, t1_length2, t1_length3;
+static integer t1_save_offset;
+static integer t1_fontname_offset;
+extern char *fb_array;
+
+#else /* writet1 used with dvips */
+#include "dvips.h"
+#include "ptexmac.h"
+#undef fm_extend
+#define fm_extend(f) 0
+#undef fm_slant
+#define fm_slant(f) 0
+#undef is_reencoded
+#define is_reencoded(f) (cur_enc_name != NULL)
+#undef is_subsetted
+#define is_subsetted(f) true
+#undef is_included
+#define is_included(f) true
+#undef set_cur_file_name
+#define set_cur_file_name(s) cur_file_name = s
+#define t1_open() \
+ ((t1_file = search(headerpath, cur_file_name, FOPEN_RBIN_MODE)) != NULL)
+#define enc_open() \
+ ((enc_file = search(encpath, cur_file_name, FOPEN_RBIN_MODE)) != NULL)
+#define external_enc() ext_glyph_names
+#define full_file_name() cur_file_name
+#define get_length1()
+#define get_length2()
+#define get_length3()
+#define is_used_char(c) (grid[c] == 1)
+#define out_eexec_char t1_outhex
+#define save_offset()
+#define end_last_eexec_line() \
+ hexline_length = HEXLINE_WIDTH; \
+ end_hexline(); \
+ t1_eexec_encrypt = false
+#define t1_log(s)
+#define t1_scan_only()
+#define t1_include()
+#define t1_putchar(c) fputc(c, bitfile)
+#define t1_scan_keys()
+#define embed_all_glyphs(tex_font) false
+#undef pdfmovechars
+#ifdef SHIFTLOWCHARS
+extern char errbuf[];
+extern Boolean shiftlowchars;
+#define pdfmovechars shiftlowchars
+#define t1_char(c) T1Char(c)
+#else /* SHIFTLOWCHARS */
+#define t1_char(c) c
+#define pdfmovechars 0
+#endif /* SHIFTLOWCHARS */
+#define extra_charset() dvips_extra_charset
+#define make_subset_tag(a, b)
+#define update_subset_tag()
+
+static char *dvips_extra_charset ;
+extern FILE *bitfile ;
+extern FILE *search();
+static char *cur_file_name;
+static char *cur_enc_name;
+static unsigned char *grid;
+static char *ext_glyph_names[MAX_CHAR_CODE + 1];
+static char print_buf[PRINTF_BUF_SIZE];
+static int hexline_length;
+static char notdef[] = ".notdef";
+static size_t last_ptr_index;
+#endif /* pdfTeX */
+
+#include <kpathsea/c-vararg.h>
+#include <kpathsea/c-proto.h>
+
+#define t1_getchar() getc(t1_file)
+#define t1_ungetchar(c) ungetc(c, t1_file)
+#define t1_eof() feof(t1_file)
+#define t1_close() xfclose(t1_file, cur_file_name)
+
+#define enc_getchar() getc(enc_file)
+#define enc_eof() feof(enc_file)
+#define enc_close() xfclose(enc_file, cur_file_name)
+
+#define valid_code(c) (c >= 0 && c <= MAX_CHAR_CODE)
+
+static const char *standard_glyph_names[MAX_CHAR_CODE + 1] = {
+notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+notdef, notdef, notdef, notdef, notdef, "space", "exclam", "quotedbl",
+"numbersign", "dollar", "percent", "ampersand", "quoteright", "parenleft",
+"parenright", "asterisk", "plus", "comma", "hyphen", "period", "slash",
+"zero", "one", "two", "three", "four", "five", "six", "seven", "eight",
+"nine", "colon", "semicolon", "less", "equal", "greater", "question", "at",
+"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O",
+"P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "bracketleft",
+"backslash", "bracketright", "asciicircum", "underscore", "quoteleft", "a",
+"b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p",
+"q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "braceleft", "bar",
+"braceright", "asciitilde", notdef, notdef, notdef, notdef, notdef, notdef,
+notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+notdef, "exclamdown", "cent", "sterling", "fraction", "yen", "florin",
+"section", "currency", "quotesingle", "quotedblleft", "guillemotleft",
+"guilsinglleft", "guilsinglright", "fi", "fl", notdef, "endash", "dagger",
+"daggerdbl", "periodcentered", notdef, "paragraph", "bullet",
+"quotesinglbase", "quotedblbase", "quotedblright", "guillemotright",
+"ellipsis", "perthousand", notdef, "questiondown", notdef, "grave", "acute",
+"circumflex", "tilde", "macron", "breve", "dotaccent", "dieresis", notdef,
+"ring", "cedilla", notdef, "hungarumlaut", "ogonek", "caron", "emdash",
+notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+notdef, notdef, notdef, notdef, notdef, notdef, notdef, "AE", notdef,
+"ordfeminine", notdef, notdef, notdef, notdef, "Lslash", "Oslash", "OE",
+"ordmasculine", notdef, notdef, notdef, notdef, notdef, "ae", notdef, notdef,
+notdef, "dotlessi", notdef, notdef, "lslash", "oslash", "oe", "germandbls",
+notdef, notdef, notdef, notdef
+};
+
+static char charstringname[] = "/CharStrings";
+
+char **t1_glyph_names;
+char *t1_builtin_glyph_names[MAX_CHAR_CODE + 1];
+static boolean read_encoding_only;
+static int t1_encoding;
+
+#define T1_BUF_SIZE 0x10
+#define ENC_BUF_SIZE 0x1000
+
+#define ENC_STANDARD 0
+#define ENC_BUILTIN 1
+
+#define CS_HSTEM 1
+#define CS_VSTEM 3
+#define CS_VMOVETO 4
+#define CS_RLINETO 5
+#define CS_HLINETO 6
+#define CS_VLINETO 7
+#define CS_RRCURVETO 8
+#define CS_CLOSEPATH 9
+#define CS_CALLSUBR 10
+#define CS_RETURN 11
+#define CS_ESCAPE 12
+#define CS_HSBW 13
+#define CS_ENDCHAR 14
+#define CS_RMOVETO 21
+#define CS_HMOVETO 22
+#define CS_VHCURVETO 30
+#define CS_HVCURVETO 31
+#define CS_1BYTE_MAX (CS_HVCURVETO + 1)
+
+#define CS_DOTSECTION CS_1BYTE_MAX + 0
+#define CS_VSTEM3 CS_1BYTE_MAX + 1
+#define CS_HSTEM3 CS_1BYTE_MAX + 2
+#define CS_SEAC CS_1BYTE_MAX + 6
+#define CS_SBW CS_1BYTE_MAX + 7
+#define CS_DIV CS_1BYTE_MAX + 12
+#define CS_CALLOTHERSUBR CS_1BYTE_MAX + 16
+#define CS_POP CS_1BYTE_MAX + 17
+#define CS_SETCURRENTPOINT CS_1BYTE_MAX + 33
+#define CS_2BYTE_MAX (CS_SETCURRENTPOINT + 1)
+#define CS_MAX CS_2BYTE_MAX
+
+typedef unsigned char byte;
+
+typedef struct {
+ byte nargs; /* number of arguments */
+ boolean bottom; /* take arguments from bottom of stack? */
+ boolean clear; /* clear stack? */
+ boolean valid;
+} cc_entry; /* CharString Command */
+
+typedef struct {
+ char *name; /* glyph name (or notdef for Subrs entry) */
+ byte *data;
+ unsigned short len; /* length of the whole string */
+ unsigned short cslen; /* length of the encoded part of the string */
+ boolean used;
+ boolean valid;
+} cs_entry;
+
+static unsigned short t1_dr, t1_er;
+static const unsigned short t1_c1 = 52845, t1_c2 = 22719;
+static unsigned short t1_cslen;
+static short t1_lenIV;
+static char enc_line[ENC_BUF_SIZE];
+
+/* define t1_line_ptr, t1_line_array & t1_line_limit */
+typedef char t1_line_entry;
+define_array(t1_line);
+
+/* define t1_buf_ptr, t1_buf_array & t1_buf_limit */
+typedef char t1_buf_entry;
+define_array(t1_buf);
+
+static int cs_start;
+
+static cs_entry *cs_tab, *cs_ptr, *cs_notdef;
+static char *cs_dict_start, *cs_dict_end;
+static int cs_count, cs_size, cs_size_pos;
+
+static cs_entry *subr_tab;
+static char *subr_array_start, *subr_array_end;
+static int subr_max, subr_size, subr_size_pos;
+
+/* This list contains the begin/end tokens commonly used in the */
+/* /Subrs array of a Type 1 font. */
+static const char *cs_token_pairs_list[][2] = {
+ {" RD", "NP"},
+ {" -|", "|"},
+ {" RD", "noaccess put"},
+ {" -|", "noaccess put"},
+ {NULL, NULL}
+};
+static const char **cs_token_pair;
+
+static boolean t1_pfa, t1_cs, t1_scan, t1_eexec_encrypt, t1_synthetic;
+static int t1_in_eexec; /* 0 before eexec-encrypted, 1 during, 2 after */
+static long t1_block_length;
+static int last_hexbyte;
+static FILE *t1_file;
+static FILE *enc_file;
+
+#define str_prefix(s1, s2) (strncmp(s1, s2, strlen(s2)) == 0)
+#define t1_prefix(s) str_prefix(t1_line_array, s)
+#define t1_buf_prefix(s) str_prefix(t1_buf_array, s)
+#define t1_suffix(s) str_suffix(t1_line_array, t1_line_ptr, s)
+#define t1_buf_suffix(s) str_suffix(t1_buf_array, t1_buf_ptr, s)
+#define t1_charstrings() strstr(t1_line_array, charstringname)
+#define t1_subrs() t1_prefix("/Subrs")
+#define t1_end_eexec() t1_suffix("mark currentfile closefile")
+#define t1_cleartomark() t1_prefix("cleartomark")
+
+#ifndef pdfTeX
+static void pdftex_fail(char *fmt,...)
+{
+ va_list args;
+ va_start(args, fmt);
+ fputs("\nError: module writet1", stderr);
+ if (cur_file_name)
+ fprintf(stderr, " (file %s)", cur_file_name);
+ fputs(": ", stderr);
+ vsprintf(print_buf, fmt, args);
+ fputs(print_buf, stderr);
+ fputs("\n ==> Fatal error occurred, the output PS file is not finished!\n", stderr);
+ va_end(args);
+ exit(-1);
+}
+
+static void pdftex_warn(char *fmt,...)
+{
+ va_list args;
+ va_start(args, fmt);
+ fputs("\nWarning: module writet1 of dvips", stderr);
+ if (cur_file_name)
+ fprintf(stderr, " (file %s)", cur_file_name);
+ fputs(": ", stderr);
+ vsprintf(print_buf, fmt, args);
+ fputs(print_buf, stderr);
+ fputs("\n", stderr);
+ va_end(args);
+}
+
+#define HEXLINE_WIDTH 64
+
+static void end_hexline()
+{
+ if (hexline_length == HEXLINE_WIDTH) {
+ fputs("\n", bitfile);
+ hexline_length = 0;
+ }
+}
+
+static void t1_outhex(byte b)
+{
+ static char *hexdigits = "0123456789ABCDEF";
+ t1_putchar(hexdigits[b/16]);
+ t1_putchar(hexdigits[b%16]);
+ hexline_length += 2;
+ end_hexline();
+}
+#endif /* pdfTeX */
+
+
+static void enc_getline(void)
+{
+ char *p;
+ int c;
+restart:
+ if (enc_eof())
+ pdftex_fail("unexpected end of file");
+ p = enc_line;
+ do {
+ c = enc_getchar();
+ append_char_to_buf(c, p, enc_line, ENC_BUF_SIZE);
+ } while (c != 10);
+ append_eol(p, enc_line, ENC_BUF_SIZE);
+ if (p - enc_line < 2 || *enc_line == '%')
+ goto restart;
+}
+
+void load_enc(char *enc_name, char **glyph_names)
+{
+ char buf[ENC_BUF_SIZE], *p, *r;
+ int names_count;
+ set_cur_file_name(enc_name);
+ if (!enc_open()) {
+ pdftex_warn("cannot open encoding file for reading");
+ cur_file_name = NULL;
+ return;
+ }
+ t1_log("{");
+ t1_log(cur_file_name = full_file_name());
+ enc_getline();
+ if (*enc_line != '/' || (r = strchr(enc_line, '[')) == NULL) {
+ remove_eol(r, enc_line);
+ pdftex_fail("invalid encoding vector (a name or `[' missing): `%s'", enc_line);
+ }
+ names_count = 0;
+ r++; /* skip '[' */
+ skip(r, ' ');
+ for (;;) {
+ while (*r == '/') {
+ for (p = buf, r++; *r != ' ' && *r != 10 && *r != ']' && *r != '/'; *p++ = *r++);
+ *p = 0;
+ skip(r, ' ');
+ if (names_count > MAX_CHAR_CODE)
+ pdftex_fail("encoding vector contains more than %i names",
+ (int)(MAX_CHAR_CODE + 1));
+ if (strcmp(buf, notdef) != 0)
+ glyph_names[names_count] = xstrdup(buf);
+ names_count++;
+ }
+ if (*r != 10 && *r != '%') {
+ if (strncmp(r, "] def", strlen("] def")) == 0)
+ goto done;
+ else {
+ remove_eol(r, enc_line);
+ pdftex_fail("invalid encoding vector: a name or `] def' expected: `%s'", enc_line);
+ }
+ }
+ enc_getline();
+ r = enc_line;
+ }
+done:
+ enc_close();
+ t1_log("}");
+ cur_file_name = NULL;
+}
+
+static void t1_check_pfa(void)
+{
+ int c = t1_getchar();
+ if (c != 128)
+ t1_pfa = true;
+ else
+ t1_pfa = false;
+ t1_ungetchar(c);
+}
+
+static int t1_getbyte(void)
+{
+ int c = t1_getchar();
+ if (t1_pfa)
+ return c;
+ if (t1_block_length == 0) {
+ if (c != 128)
+ pdftex_fail("invalid marker");
+ c = t1_getchar();
+ if (c == 3) {
+ while (!t1_eof())
+ t1_getchar();
+ return EOF;
+ }
+ t1_block_length = t1_getchar() & 0xff;
+ t1_block_length |= (t1_getchar() & 0xff) << 8;
+ t1_block_length |= (t1_getchar() & 0xff) << 16;
+ t1_block_length |= (t1_getchar() & 0xff) << 24;
+ c = t1_getchar();
+ }
+ t1_block_length--;
+ return c;
+}
+
+static int hexval(int c)
+{
+ if (c >= 'A' && c <= 'F')
+ return c - 'A' + 10;
+ else if (c >= 'a' && c <= 'f')
+ return c - 'a' + 10;
+ else if (c >= '0' && c <= '9')
+ return c - '0';
+ else
+ return -1;
+}
+
+static byte edecrypt(byte cipher)
+{
+ byte plain;
+ if (t1_pfa) {
+ while (cipher == 10 || cipher == 13)
+ cipher = t1_getbyte();
+ last_hexbyte = cipher = (hexval(cipher) << 4) + hexval(t1_getbyte());
+ }
+ plain = (cipher^(t1_dr >> 8));
+ t1_dr = (cipher + t1_dr)*t1_c1 + t1_c2;
+ return plain;
+}
+
+static byte cdecrypt(byte cipher, unsigned short *cr)
+{
+ byte plain = (cipher^(*cr >> 8));
+ *cr = (cipher + *cr)*t1_c1 + t1_c2;
+ return plain;
+}
+
+static byte eencrypt(byte plain)
+{
+ byte cipher = (plain^(t1_er >> 8));
+ t1_er = (cipher + t1_er)*t1_c1 + t1_c2;
+ return cipher;
+}
+
+static byte cencrypt(byte plain, unsigned short *cr)
+{
+ byte cipher = (plain^(*cr >> 8));
+ *cr = (cipher + *cr)*t1_c1 + t1_c2;
+ return cipher;
+}
+
+static char *eol(char *s)
+{
+ char *p = strend(s);
+ if (p - s > 1 && p[-1] != 10) {
+ *p++ = 10;
+ *p = 0;
+ }
+ return p;
+}
+
+static float t1_scan_num(char *p, char **r)
+{
+ float f;
+ skip(p, ' ');
+ if (sscanf(p, "%g", &f) != 1) {
+ remove_eol(p, t1_line_array);
+ pdftex_fail("a number expected: `%s'", t1_line_array);
+ }
+ if (r != NULL) {
+ for (; isdigit(*p) || *p == '.' ||
+ *p == 'e' || *p == 'E' || *p == '+' || *p == '-'; p++);
+ *r = p;
+ }
+ return f;
+}
+
+static boolean str_suffix(const char *begin_buf, const char *end_buf,
+ const char *s)
+{
+ const char *s1 = end_buf - 1,
+ *s2 = strend(s) - 1;
+ if (*s1 == 10)
+ s1--;
+ while (s1 >= begin_buf && s2 >= s) {
+ if (*s1-- != *s2--)
+ return false;
+ }
+ return s2 < s;
+}
+
+static void t1_getline(void)
+{
+ int c, l, eexec_scan;
+ char *p;
+ static const char eexec_str[] = "currentfile eexec";
+ static int eexec_len = 17; /* strlen(eexec_str) */
+restart:
+ if (t1_eof())
+ pdftex_fail("unexpected end of file");
+ t1_line_ptr = t1_line_array;
+ alloc_array(t1_line, 1, T1_BUF_SIZE);
+ t1_cslen = 0;
+ eexec_scan = 0;
+ c = t1_getbyte();
+ if (c == EOF)
+ goto exit;
+ while (!t1_eof()) {
+ if (t1_in_eexec == 1)
+ c = edecrypt(c);
+ alloc_array(t1_line, 1, T1_BUF_SIZE);
+ append_char_to_buf(c, t1_line_ptr, t1_line_array, t1_line_limit);
+ if (t1_in_eexec == 0 && eexec_scan >= 0 && eexec_scan < eexec_len) {
+ if (t1_line_array[eexec_scan] == eexec_str[eexec_scan])
+ eexec_scan++;
+ else
+ eexec_scan = -1;
+ }
+ if (c == 10 || (t1_pfa && eexec_scan == eexec_len && c == 32))
+ break;
+ if (t1_cs && t1_cslen == 0 && (t1_line_ptr - t1_line_array > 4) &&
+ (t1_suffix(" RD ") || t1_suffix(" -| "))) {
+ p = t1_line_ptr - 5;
+ while (*p != ' ')
+ p--;
+ t1_cslen = l = t1_scan_num(p + 1, 0);
+ cs_start = t1_line_ptr - t1_line_array; /* cs_start is an index now */
+ alloc_array(t1_line, l, T1_BUF_SIZE);
+ while (l-- > 0)
+ *t1_line_ptr++ = edecrypt(t1_getbyte());
+ }
+ c = t1_getbyte();
+ }
+ alloc_array(t1_line, 2, T1_BUF_SIZE); /* append_eol can append 2 chars */
+ append_eol(t1_line_ptr, t1_line_array, t1_line_limit);
+ if (t1_line_ptr - t1_line_array < 2)
+ goto restart;
+ if (eexec_scan == eexec_len)
+ t1_in_eexec = 1;
+exit:
+ /* ensure that t1_buf_array has as much room as t1_line_array */
+ t1_buf_ptr = t1_buf_array;
+ alloc_array(t1_buf, t1_line_limit, t1_line_limit);
+}
+
+static void t1_putline(void)
+{
+ char *p = t1_line_array;
+ if (t1_line_ptr - t1_line_array <= 1)
+ return;
+ if (t1_eexec_encrypt) {
+ while (p < t1_line_ptr)
+ out_eexec_char(eencrypt(*p++));
+ }
+ else
+ while (p < t1_line_ptr)
+ t1_putchar(*p++);
+}
+
+static void t1_puts(const char *s)
+{
+ if (s != t1_line_array)
+ strcpy(t1_line_array, s);
+ t1_line_ptr = strend(t1_line_array);
+ t1_putline();
+}
+
+static void t1_printf(const char *fmt,...)
+{
+ va_list args;
+ va_start(args, fmt);
+ vsprintf(t1_line_array, fmt, args);
+ t1_puts(t1_line_array);
+ va_end(args);
+}
+
+static void t1_init_params(const char *open_name_prefix)
+{
+ t1_log(open_name_prefix);
+ t1_log(cur_file_name);
+ t1_lenIV = 4;
+ t1_dr = 55665;
+ t1_er = 55665;
+ t1_in_eexec = 0;
+ t1_cs = false;
+ t1_scan = true;
+ t1_synthetic = false;
+ t1_eexec_encrypt = false;
+ t1_block_length = 0;
+ t1_check_pfa();
+}
+
+static void t1_close_font_file(const char *close_name_suffix)
+{
+ t1_log(close_name_suffix);
+ t1_close();
+ cur_file_name = NULL;
+}
+
+static void t1_check_block_len(boolean decrypt)
+{
+ int l, c;
+ if (t1_block_length == 0)
+ return;
+ c = t1_getbyte();
+ if (decrypt)
+ c = edecrypt(c);
+ l = t1_block_length;
+ if (!(l == 0 && (c == 10 || c == 13))) {
+ pdftex_warn("%i bytes more than expected were ignored", l + 1);
+ while (l-- > 0)
+ t1_getbyte();
+ }
+}
+
+static void t1_start_eexec(void)
+{
+ int i;
+ if (is_included(fm_cur)) {
+ get_length1();
+ save_offset();
+ }
+ if (!t1_pfa)
+ t1_check_block_len(false);
+ for (t1_line_ptr = t1_line_array, i = 0; i < 4; i++) {
+ edecrypt(t1_getbyte());
+ *t1_line_ptr++ = 0;
+ }
+ t1_eexec_encrypt = true;
+ if (is_included(fm_cur))
+ t1_putline(); /* to put the first four bytes */
+}
+
+static void t1_stop_eexec(void)
+{
+ int c;
+ if (is_included(fm_cur)) {
+ get_length2();
+ save_offset();
+ }
+ end_last_eexec_line();
+ if (!t1_pfa)
+ t1_check_block_len(true);
+ else {
+ c = edecrypt(t1_getbyte());
+ if (!(c == 10 || c == 13)) {
+ if (last_hexbyte == 0)
+ t1_puts("00");
+ else
+ pdftex_warn("unexpected data after eexec");
+ }
+ }
+ t1_cs = false;
+ t1_in_eexec = 2;
+}
+
+#ifdef pdfTeX
+static void t1_modify_fm(void)
+{
+ /*
+ * font matrix is given as six numbers a0..a5, which stands for the matrix
+ *
+ * a0 a1 0
+ * M = a2 a3 0
+ * a4 a5 1
+ *
+ * ExtendFont is given as
+ *
+ * e 0 0
+ * E = 0 1 0
+ * 0 0 1
+ *
+ * SlantFont is given as
+ *
+ * 1 0 0
+ * S = s 1 0
+ * 0 0 1
+ *
+ * and the final transformation is
+ *
+ * e*a0 e*a1 0
+ * F = E.S.M = s*e*a0+a2 s*e*a1+a3 0
+ * a4 a5 1
+ */
+ float e, s, a[6], b[6];
+ int i, c;
+ char *p, *q, *r;
+ if ((p = strchr(t1_line_array, '[')) == 0)
+ if ((p = strchr(t1_line_array, '{')) == 0) {
+ remove_eol(p, t1_line_array);
+ pdftex_fail("FontMatrix: an array expected: `%s'", t1_line_array);
+ }
+ c = *p++; /* save the character '[' resp. '{' */
+ strncpy(t1_buf_array, t1_line_array, (unsigned)(p - t1_line_array));
+ r = t1_buf_array + (p - t1_line_array);
+ for (i = 0; i < 6; i++) {
+ a[i] = t1_scan_num(p, &q);
+ p = q;
+ }
+ if (fm_extend(fm_cur) != 0)
+ e = fm_extend(fm_cur)*1E-3;
+ else
+ e = 1;
+ s = fm_slant(fm_cur)*1E-3;
+ b[0] = e*a[0];
+ b[1] = e*a[1];
+ b[2] = s*e*a[0] + a[2];
+ b[3] = s*e*a[1] + a[3];
+ b[4] = a[4];
+ b[5] = a[5];
+ for (i = 0; i < 6; i++) {
+ sprintf(r, "%g ", b[i]);
+ r = strend(r);
+ }
+ if (c == '[') {
+ while (*p != ']' && *p != 0)
+ p++;
+ }
+ else {
+ while (*p != '}' && *p != 0)
+ p++;
+ }
+ if (*p == 0) {
+ remove_eol(p, t1_line_array);
+ pdftex_fail("FontMatrix: cannot find the corresponding character to '%c': `%s'", c, t1_line_array);
+ }
+ strcpy(r, p);
+ strcpy(t1_line_array, t1_buf_array);
+ t1_line_ptr = eol(t1_line_array);
+}
+
+static void t1_modify_italic(void)
+{
+ float a;
+ char *p, *r;
+ if (fm_slant(fm_cur) == 0)
+ return;
+ p = strchr(t1_line_array, ' ');
+ strncpy(t1_buf_array, t1_line_array, (unsigned)(p - t1_line_array + 1));
+ a = t1_scan_num(p + 1, &r);
+ a -= atan(fm_slant(fm_cur)*1E-3)*(180/M_PI);
+ sprintf(t1_buf_array + (p - t1_line_array + 1), "%g", a);
+ strcpy(strend(t1_buf_array), r);
+ strcpy(t1_line_array, t1_buf_array);
+ t1_line_ptr = eol(t1_line_array);
+ font_keys[ITALIC_ANGLE_CODE].value = round(a);
+ font_keys[ITALIC_ANGLE_CODE].valid = true;
+}
+
+static void t1_scan_keys(void)
+{
+ int i, k;
+ char *p, *q, *r;
+ key_entry *key;
+ if (fm_extend(fm_cur) != 0 || fm_slant(fm_cur) != 0) {
+ if (t1_prefix("/FontMatrix")) {
+ t1_modify_fm();
+ return;
+ }
+ if (t1_prefix("/ItalicAngle")) {
+ t1_modify_italic();
+ return;
+ }
+ }
+ if (t1_prefix("/FontType")) {
+ p = t1_line_array + strlen("FontType") + 1;
+ if ((i = t1_scan_num(p, 0)) != 1)
+ pdftex_fail("Type%d fonts unsupported by pdfTeX", i);
+ return;
+ }
+ for (key = font_keys; key - font_keys < MAX_KEY_CODE; key++)
+ if (strncmp(t1_line_array + 1, key->t1name, strlen(key->t1name)) == 0)
+ break;
+ if (key - font_keys == MAX_KEY_CODE)
+ return;
+ key->valid = true;
+ p = t1_line_array + strlen(key->t1name) + 1;
+ skip(p, ' ');
+ if ((k = key - font_keys) == FONTNAME_CODE) {
+ if (*p != '/') {
+ remove_eol(p, t1_line_array);
+ pdftex_fail("a name expected: `%s'", t1_line_array);
+ }
+ r = ++p; /* skip the slash */
+ for (q = t1_buf_array; *p != ' ' && *p != 10; *q++ = *p++);
+ *q = 0;
+ if (fm_slant(fm_cur) != 0) {
+ sprintf(q, "-Slant_%i", (int)fm_slant(fm_cur));
+ q = strend(q);
+ }
+ if (fm_extend(fm_cur) != 0) {
+ sprintf(q, "-Extend_%i", (int)fm_extend(fm_cur));
+ }
+ strncpy(fontname_buf, t1_buf_array, FONTNAME_BUF_SIZE);
+ /* at this moment we cannot call make_subset_tag() yet, as the encoding
+ * is not read; thus we mark the offset of the subset tag and write it
+ * later */
+ if (is_included(fm_cur) && is_subsetted(fm_cur)) {
+ t1_fontname_offset = t1_offset() + (r - t1_line_array);
+ strcpy(t1_buf_array, p);
+ sprintf(r, "ABCDEF+%s%s", fontname_buf, t1_buf_array);
+ t1_line_ptr = eol(r);
+ }
+ return;
+ }
+ if ((k == STEMV_CODE || k == FONTBBOX1_CODE) &&
+ (*p == '[' || *p == '{'))
+ p++;
+ if (k == FONTBBOX1_CODE) {
+ for (i = 0; i < 4; i++) {
+ key[i].value = t1_scan_num(p, &r);
+ p = r;
+ }
+ return;
+ }
+ key->value = t1_scan_num(p, 0);
+}
+
+#endif /* pdfTeX */
+
+static void t1_scan_param(void)
+{
+ static const char *lenIV = "/lenIV";
+ if (!t1_scan || *t1_line_array != '/')
+ return;
+ if (t1_prefix(lenIV)) {
+ t1_lenIV = t1_scan_num(t1_line_array + strlen(lenIV), 0);
+ return;
+ }
+ t1_scan_keys();
+}
+
+static void copy_glyph_names(char **glyph_names, int a, int b)
+{
+ if (glyph_names[b] != notdef) {
+ free(glyph_names[b]);
+ glyph_names[b] = (char*) notdef;
+ }
+ if (glyph_names[a] != notdef) {
+ glyph_names[b] = xstrdup(glyph_names[a]);
+ }
+}
+
+static void t1_builtin_enc(void)
+{
+ int i, a, b, c, counter = 0;
+ char *r, *p;
+ /*
+ * At this moment "/Encoding" is the prefix of t1_line_array
+ */
+ if (t1_suffix("def")) { /* predefined encoding */
+ sscanf(t1_line_array + strlen("/Encoding"), "%256s", t1_buf_array);
+ if (strcmp(t1_buf_array, "StandardEncoding") == 0) {
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (standard_glyph_names[i] == notdef)
+ t1_builtin_glyph_names[i] = (char*) notdef;
+ else
+ t1_builtin_glyph_names[i] = xstrdup(standard_glyph_names[i]);
+ t1_encoding = ENC_STANDARD;
+ }
+ else
+ pdftex_fail("cannot subset font (unknown predefined encoding `%s')",
+ t1_buf_array);
+ return;
+ } else
+ t1_encoding = ENC_BUILTIN;
+ /*
+ * At this moment "/Encoding" is the prefix of t1_line_array, and the encoding is
+ * not a predefined encoding
+ *
+ * We have two possible forms of Encoding vector. The first case is
+ *
+ * /Encoding [/a /b /c...] readonly def
+ *
+ * and the second case can look like
+ *
+ * /Encoding 256 array 0 1 255 {1 index exch /.notdef put} for
+ * dup 0 /x put
+ * dup 1 /y put
+ * ...
+ * readonly def
+ */
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ t1_builtin_glyph_names[i] = (char*) notdef;
+ if (t1_prefix("/Encoding [") || t1_prefix("/Encoding[")) { /* the first case */
+ r = strchr(t1_line_array, '[') + 1;
+ skip(r, ' ');
+ for(;;) {
+ while (*r == '/') {
+ for (p = t1_buf_array, r++;
+ *r != 32 && *r != 10 && *r != ']' && *r != '/';
+ *p++ = *r++);
+ *p = 0;
+ skip(r, ' ');
+ if (counter > MAX_CHAR_CODE)
+ pdftex_fail("encoding vector contains more than %i names",
+ (int)(MAX_CHAR_CODE + 1));
+ if (strcmp(t1_buf_array, notdef) != 0)
+ t1_builtin_glyph_names[counter] = xstrdup(t1_buf_array);
+ counter++;
+ }
+ if (*r != 10 && *r != '%') {
+ if (str_prefix(r, "] def") || str_prefix(r, "] readonly def"))
+ break;
+ else {
+ remove_eol(r, t1_line_array);
+ pdftex_fail("a name or `] def' or `] readonly def' expected: `%s'",
+ t1_line_array);
+ }
+ }
+ t1_getline();
+ r = t1_line_array;
+ }
+ }
+ else { /* the second case */
+ p = strchr(t1_line_array, 10);
+ for (;;) {
+ if (*p == 10) {
+ t1_getline();
+ p = t1_line_array;
+ }
+ /*
+ check for `dup <index> <glyph> put'
+ */
+ if (sscanf(p, "dup %i%256s put", &i, t1_buf_array) == 2 &&
+ *t1_buf_array == '/' && valid_code(i)) {
+ if (strcmp(t1_buf_array + 1, notdef) != 0)
+ t1_builtin_glyph_names[i] = xstrdup(t1_buf_array + 1);
+ p = strstr(p, " put") + strlen(" put");
+ skip(p, ' ');
+ }
+ /*
+ check for `dup dup <to> exch <from> get put'
+ */
+ else if (sscanf(p, "dup dup %i exch %i get put", &b, &a) == 2 &&
+ valid_code(a) && valid_code(b)) {
+ copy_glyph_names(t1_builtin_glyph_names, a, b);
+ p = strstr(p, " get put") + strlen(" get put");
+ skip(p, ' ');
+ }
+ /*
+ check for `dup dup <from> <size> getinterval <to> exch putinterval'
+ */
+ else if (sscanf(p, "dup dup %i %i getinterval %i exch putinterval",
+ &a, &c, &b) == 3 &&
+ valid_code(a) && valid_code(b) && valid_code(c)) {
+ for (i = 0; i < c; i++)
+ copy_glyph_names(t1_builtin_glyph_names, a + i, b + i);
+ p = strstr(p, " putinterval") + strlen(" putinterval");
+ skip(p, ' ');
+ }
+ /*
+ check for `def' or `readonly def'
+ */
+ else if ((p == t1_line_array || (p > t1_line_array && p[-1] == ' ')) &&
+ strcmp(p, "def\n") == 0)
+ return;
+ /*
+ skip an unrecognizable word
+ */
+ else {
+ while (*p != ' ' && *p != 10)
+ p++;
+ skip(p, ' ');
+ }
+ }
+ }
+}
+
+static void t1_check_end(void)
+{
+ if (t1_eof())
+ return;
+ t1_getline();
+ if (t1_prefix("{restore}"))
+ t1_putline();
+}
+
+#ifdef pdfTeX
+static boolean t1_open_fontfile(const char *open_name_prefix)
+{
+ char *ex_ffname = NULL;
+ ff_entry *ff;
+ ff = check_ff_exist(fm_cur);
+ if (ff->ff_path != NULL)
+ t1_file = xfopen(cur_file_name = ff->ff_path, FOPEN_RBIN_MODE);
+ else {
+ set_cur_file_name(fm_cur->ff_name);
+ pdftex_warn("cannot open Type 1 font file for reading");
+ return false;
+ }
+ t1_init_params(open_name_prefix);
+ fontfile_found = true;
+ return true;
+}
+
+static void t1_scan_only(void)
+{
+ do {
+ t1_getline();
+ t1_scan_param();
+ } while (t1_in_eexec == 0);
+ t1_start_eexec();
+ do {
+ t1_getline();
+ t1_scan_param();
+ } while (!(t1_charstrings() || t1_subrs()));
+}
+
+static void t1_include(void)
+{
+ do {
+ t1_getline();
+ t1_scan_param();
+ t1_putline();
+ } while (t1_in_eexec == 0);
+ t1_start_eexec();
+ do {
+ t1_getline();
+ t1_scan_param();
+ t1_putline();
+ } while (!(t1_charstrings() || t1_subrs()));
+ t1_cs = true;
+ do {
+ t1_getline();
+ t1_putline();
+ } while (!t1_end_eexec());
+ t1_stop_eexec();
+ do {
+ t1_getline();
+ t1_putline();
+ } while (!t1_cleartomark());
+ t1_check_end(); /* write "{restore}if" if found */
+ get_length3();
+}
+
+#else /* not pdfTeX */
+static boolean t1_open_fontfile(char *open_name_prefix)
+{
+ if (!t1_open()) {
+ (void)sprintf(errbuf, "! Couldn't find font file %s", cur_file_name);
+ error(errbuf);
+ }
+ t1_init_params(open_name_prefix);
+ return true;
+}
+#endif /* pdfTeX */
+
+#define check_subr(subr) \
+ if (subr >= subr_size || subr < 0) \
+ pdftex_fail("Subrs array: entry index out of range (%i)", subr);
+
+static const char **check_cs_token_pair()
+{
+ const char **p = (const char**) cs_token_pairs_list;
+ for (; p[0] != NULL; ++p)
+ if (t1_buf_prefix(p[0]) && t1_buf_suffix(p[1]))
+ return p;
+ return NULL;
+}
+
+static void cs_store(boolean is_subr)
+{
+ char *p;
+ cs_entry *ptr;
+ int subr;
+ for (p = t1_line_array, t1_buf_ptr = t1_buf_array; *p != ' '; *t1_buf_ptr++ = *p++);
+ *t1_buf_ptr = 0;
+ if (is_subr) {
+ subr = t1_scan_num(p + 1, 0);
+ check_subr(subr);
+ ptr = subr_tab + subr;
+ }
+ else {
+ ptr = cs_ptr++;
+ if (cs_ptr - cs_tab > cs_size)
+ pdftex_fail("CharStrings dict: more entries than dict size (%i)", cs_size);
+ if (strcmp(t1_buf_array + 1, notdef) == 0) /* skip the slash */
+ ptr->name = (char*) notdef;
+ else
+ ptr->name = xstrdup(t1_buf_array + 1);
+ }
+ /* copy " RD " + cs data to t1_buf_array */
+ memcpy(t1_buf_array, t1_line_array + cs_start - 4, (unsigned)(t1_cslen + 4));
+ /* copy the end of cs data to t1_buf_array */
+ for (p = t1_line_array + cs_start + t1_cslen, t1_buf_ptr = t1_buf_array + t1_cslen + 4;
+ *p != 10; *t1_buf_ptr++ = *p++);
+ *t1_buf_ptr++ = 10;
+ if (is_subr && cs_token_pair == NULL)
+ cs_token_pair = check_cs_token_pair();
+ ptr->len = t1_buf_ptr - t1_buf_array;
+ ptr->cslen = t1_cslen;
+ ptr->data = xtalloc(ptr->len, byte);
+ memcpy(ptr->data, t1_buf_array, ptr->len);
+ ptr->valid = true;
+}
+
+#define store_subr() cs_store(true)
+#define store_cs() cs_store(false)
+
+#define CC_STACK_SIZE 24
+
+static integer cc_stack[CC_STACK_SIZE], *stack_ptr = cc_stack;
+static cc_entry cc_tab[CS_MAX];
+static boolean is_cc_init = false;
+
+
+#define cc_pop(N) \
+ if (stack_ptr - cc_stack < (N)) \
+ stack_error(N); \
+ stack_ptr -= N
+
+#define stack_error(N) { \
+ pdftex_warn("CharString: invalid access (%i) to stack (%i entries)", \
+ N, stack_ptr - cc_stack); \
+ goto cs_error; \
+}
+
+/*
+static integer cc_get(integer index)
+{
+ if (index < 0) {
+ if (stack_ptr + index < cc_stack )
+ stack_error(stack_ptr - cc_stack + index);
+ return *(stack_ptr + index);
+ }
+ else {
+ if (cc_stack + index >= stack_ptr)
+ stack_error(index);
+ return cc_stack[index];
+ }
+}
+*/
+
+#define cc_get(N) ((N) < 0 ? *(stack_ptr + (N)) : *(cc_stack + (N)))
+
+#define cc_push(V) *stack_ptr++ = V
+#define cc_clear() stack_ptr = cc_stack
+
+#define set_cc(N, B, A, C) \
+ cc_tab[N].nargs = A; \
+ cc_tab[N].bottom = B; \
+ cc_tab[N].clear = C; \
+ cc_tab[N].valid = true
+
+static void cc_init(void)
+{
+ int i;
+ if (is_cc_init)
+ return;
+ for (i = 0; i < CS_MAX; i++)
+ cc_tab[i].valid = false;
+ set_cc(CS_HSTEM, true, 2, true);
+ set_cc(CS_VSTEM, true, 2, true);
+ set_cc(CS_VMOVETO, true, 1, true);
+ set_cc(CS_RLINETO, true, 2, true);
+ set_cc(CS_HLINETO, true, 1, true);
+ set_cc(CS_VLINETO, true, 1, true);
+ set_cc(CS_RRCURVETO, true, 6, true);
+ set_cc(CS_CLOSEPATH, false, 0, true);
+ set_cc(CS_CALLSUBR, false, 1, false);
+ set_cc(CS_RETURN, false, 0, false);
+ /*
+ set_cc(CS_ESCAPE, false, 0, false);
+ */
+ set_cc(CS_HSBW, true, 2, true);
+ set_cc(CS_ENDCHAR, false, 0, true);
+ set_cc(CS_RMOVETO, true, 2, true);
+ set_cc(CS_HMOVETO, true, 1, true);
+ set_cc(CS_VHCURVETO, true, 4, true);
+ set_cc(CS_HVCURVETO, true, 4, true);
+ set_cc(CS_DOTSECTION, false, 0, true);
+ set_cc(CS_VSTEM3, true, 6, true);
+ set_cc(CS_HSTEM3, true, 6, true);
+ set_cc(CS_SEAC, true, 5, true);
+ set_cc(CS_SBW, true, 4, true);
+ set_cc(CS_DIV, false, 2, false);
+ set_cc(CS_CALLOTHERSUBR, false, 0, false);
+ set_cc(CS_POP, false, 0, false);
+ set_cc(CS_SETCURRENTPOINT, true, 2, true);
+ is_cc_init = true;
+}
+
+#define cs_getchar() cdecrypt(*data++, &cr)
+
+#define mark_subr(n) cs_mark(0, n)
+#define mark_cs(s) cs_mark(s, 0)
+
+static void cs_warn(const char *cs_name, int subr, const char *fmt,...)
+{
+ char buf[SMALL_BUF_SIZE];
+ va_list args;
+ va_start(args, fmt);
+ vsprintf(buf, fmt, args);
+ va_end(args);
+ if (cs_name == NULL)
+ pdftex_warn("Subr (%i): %s", (int)subr, buf);
+ else
+ pdftex_warn("CharString (/%s): %s", cs_name, buf);
+}
+
+static void cs_mark(const char *cs_name, int subr)
+{
+ byte *data;
+ int i, b, cs_len;
+ integer a, a1, a2;
+ unsigned short cr;
+ static integer lastargOtherSubr3 = 3; /* the argument of last call to
+ OtherSubrs[3] */
+ cs_entry *ptr;
+ cc_entry *cc;
+ if (cs_name == NULL) {
+ check_subr(subr);
+ ptr = subr_tab + subr;
+ if (!ptr->valid)
+ return;
+ }
+ else {
+ if (cs_notdef != NULL &&
+ (cs_name == notdef || strcmp(cs_name, notdef) == 0))
+ ptr = cs_notdef;
+ else {
+ for (ptr = cs_tab; ptr < cs_ptr; ptr++)
+ if (strcmp(ptr->name, cs_name) == 0)
+ break;
+ if (ptr == cs_ptr) {
+ pdftex_warn("glyph `%s' undefined", cs_name);
+ return;
+ }
+ if (ptr->name == notdef)
+ cs_notdef = ptr;
+ }
+ }
+ /* only marked CharString entries and invalid entries can be skipped;
+ valid marked subrs must be parsed to keep the stack in sync */
+ if (!ptr->valid || (ptr->used && cs_name != NULL))
+ return;
+ ptr->used = true;
+ cr = 4330;
+ cs_len = ptr->cslen;
+ data = ptr->data + 4;
+ for (i = 0; i < t1_lenIV; i++, cs_len--)
+ cs_getchar();
+ while (cs_len > 0) {
+ --cs_len;
+ b = cs_getchar();
+ if (b >= 32) {
+ if (b <= 246)
+ a = b - 139;
+ else if (b <= 250) {
+ --cs_len;
+ a = ((b - 247) << 8) + 108 + cs_getchar();
+ }
+ else if (b <= 254) {
+ --cs_len;
+ a = -((b - 251) << 8) - 108 - cs_getchar();
+ }
+ else {
+ cs_len -= 4;
+ a = (cs_getchar() & 0xff) << 24;
+ a |= (cs_getchar() & 0xff) << 16;
+ a |= (cs_getchar() & 0xff) << 8;
+ a |= (cs_getchar() & 0xff) << 0;
+ if (sizeof(integer) > 4 && (a & 0x80000000))
+ a |= ~0x7FFFFFFF;
+ }
+ cc_push(a);
+ }
+ else {
+ if (b == CS_ESCAPE) {
+ b = cs_getchar() + CS_1BYTE_MAX;
+ cs_len--;
+ }
+ if (b >= CS_MAX) {
+ cs_warn(cs_name, subr, "command value out of range: %i", (int)b);
+ goto cs_error;
+ }
+ cc = cc_tab + b;
+ if (!cc->valid) {
+ cs_warn(cs_name, subr, "command not valid: %i", (int)b);
+ goto cs_error;
+ }
+ if (cc->bottom) {
+ if (stack_ptr - cc_stack < cc->nargs)
+ cs_warn(cs_name, subr,
+ "less arguments on stack (%i) than required (%i)",
+ (int)(stack_ptr - cc_stack), (int)cc->nargs);
+ else if (stack_ptr - cc_stack > cc->nargs)
+ cs_warn(cs_name, subr,
+ "more arguments on stack (%i) than required (%i)",
+ (int)(stack_ptr - cc_stack), (int)cc->nargs);
+ }
+ switch (cc - cc_tab) {
+ case CS_CALLSUBR:
+ a1 = cc_get(-1);
+ cc_pop(1);
+ mark_subr(a1);
+ if (!subr_tab[a1].valid) {
+ cs_warn(cs_name, subr,
+ "cannot call subr (%i)", (int)a1);
+ goto cs_error;
+ }
+ break;
+ case CS_DIV:
+ cc_pop(2);
+ cc_push(0);
+ break;
+ case CS_CALLOTHERSUBR:
+ if (cc_get(-1) == 3)
+ lastargOtherSubr3 = cc_get(-3);
+ a1 = cc_get(-2) + 2;
+ cc_pop(a1);
+ break;
+ case CS_POP:
+ cc_push(lastargOtherSubr3);
+ /* the only case when we care about the value being pushed onto
+ stack is when POP follows CALLOTHERSUBR (changing hints by
+ OtherSubrs[3])
+ */
+ break;
+ case CS_SEAC:
+ a1 = cc_get(3);
+ a2 = cc_get(4);
+ cc_clear();
+ mark_cs(standard_glyph_names[a1]);
+ mark_cs(standard_glyph_names[a2]);
+ break;
+ default:
+ if (cc->clear)
+ cc_clear();
+ }
+ }
+ }
+ return;
+cs_error: /* an error occured during parsing */
+ cc_clear();
+ ptr->valid = false;
+ ptr->used = false;
+}
+
+static void t1_subset_ascii_part(void)
+{
+ int i, j;
+ t1_getline();
+ while (!t1_prefix("/Encoding")) {
+ t1_scan_param();
+ t1_putline();
+ t1_getline();
+ }
+ t1_builtin_enc();
+ if (is_reencoded(fm_cur))
+ t1_glyph_names = external_enc();
+ else
+ t1_glyph_names = t1_builtin_glyph_names;
+ if (is_included(fm_cur) && is_subsetted(fm_cur)) {
+ make_subset_tag(fm_cur, t1_glyph_names);
+ update_subset_tag();
+ }
+ if (t1_encoding == ENC_STANDARD)
+ t1_puts("/Encoding StandardEncoding def\n");
+ else {
+ t1_puts("/Encoding 256 array\n0 1 255 {1 index exch /.notdef put} for\n");
+ for (i = 0, j = 0; i <= MAX_CHAR_CODE; i++) {
+ if (is_used_char(i) && t1_glyph_names[i] != notdef) {
+ j++;
+ t1_printf("dup %i /%s put\n", (int)t1_char(i), t1_glyph_names[i]);
+ }
+ }
+ /* We didn't mark anything for the Encoding array. */
+ /* We add "dup 0 /.notdef put" for compatibility */
+ /* with Acrobat 5.0. */
+ if (j == 0)
+ t1_puts("dup 0 /.notdef put\n");
+ t1_puts("readonly def\n");
+ }
+ do {
+ t1_getline();
+ t1_scan_param();
+ if (!t1_prefix("/UniqueID")) /* ignore UniqueID for subsetted fonts */
+ t1_putline();
+ } while (t1_in_eexec == 0);
+}
+
+#define t1_subr_flush() t1_flush_cs(true)
+#define t1_cs_flush() t1_flush_cs(false)
+
+static void t1_flush_cs(boolean);
+
+static void cs_init(void)
+{
+ cs_ptr = cs_tab = NULL;
+ cs_dict_start = cs_dict_end = NULL;
+ cs_count = cs_size = cs_size_pos = 0;
+ cs_token_pair = NULL;
+ subr_tab = NULL;
+ subr_array_start = subr_array_end = NULL;
+ subr_max = subr_size = subr_size_pos = 0;
+}
+
+static void init_cs_entry(cs_entry *cs)
+{
+ cs->data = NULL;
+ cs->name = NULL;
+ cs->len = 0;
+ cs->cslen = 0;
+ cs->used = false;
+ cs->valid = false;
+}
+
+static void t1_mark_glyphs(void);
+
+static void t1_read_subrs(void)
+{
+ int i, s;
+ cs_entry *ptr;
+ t1_getline();
+ while (!(t1_charstrings() || t1_subrs())) {
+ t1_scan_param();
+ t1_putline();
+ t1_getline();
+ }
+found:
+ t1_cs = true;
+ t1_scan = false;
+ if (!t1_subrs())
+ return;
+ subr_size_pos = strlen("/Subrs") + 1;
+ /* subr_size_pos points to the number indicating dict size after "/Subrs" */
+ subr_size = t1_scan_num(t1_line_array + subr_size_pos, 0);
+ if (subr_size == 0) {
+ while (!t1_charstrings())
+ t1_getline();
+ return;
+ }
+ subr_tab = xtalloc(subr_size, cs_entry);
+ for (ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
+ init_cs_entry(ptr);
+ subr_array_start = xstrdup(t1_line_array);
+ t1_getline();
+ while (t1_cslen) {
+ store_subr();
+ t1_getline();
+ }
+ /* mark the first four entries without parsing */
+ for (i = 0; i < subr_size && i < 4; i++)
+ subr_tab[i].used = true;
+ /* the end of the Subrs array might have more than one line so we need to
+ concatnate them to subr_array_end. Unfortunately some fonts don't have
+ the Subrs array followed by the CharStrings dict immediately (synthetic
+ fonts). If we cannot find CharStrings in next POST_SUBRS_SCAN lines then
+ we will treat the font as synthetic and ignore everything until next
+ Subrs is found
+ */
+#define POST_SUBRS_SCAN 5
+ s = 0;
+ *t1_buf_array = 0;
+ for (i = 0; i < POST_SUBRS_SCAN; i++) {
+ if (t1_charstrings())
+ break;
+ s += t1_line_ptr - t1_line_array;
+ alloc_array(t1_buf, s, T1_BUF_SIZE);
+ strcat(t1_buf_array, t1_line_array);
+ t1_getline();
+ }
+ subr_array_end = xstrdup(t1_buf_array);
+ if (i == POST_SUBRS_SCAN) { /* CharStrings not found;
+ suppose synthetic font */
+ for (ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
+ if (ptr->valid)
+ xfree(ptr->data);
+ xfree(subr_tab);
+ xfree(subr_array_start);
+ xfree(subr_array_end);
+ cs_init();
+ t1_cs = false;
+ t1_synthetic = true;
+ while (!(t1_charstrings() || t1_subrs()))
+ t1_getline();
+ goto found;
+ }
+}
+
+static void t1_flush_cs(boolean is_subr)
+{
+ char *p;
+ byte *r, *return_cs = NULL;
+ cs_entry *tab, *end_tab, *ptr;
+ char *start_line, *line_end;
+ int count, size_pos;
+ unsigned short cr, cs_len;
+ if (is_subr) {
+ start_line = subr_array_start;
+ line_end = subr_array_end;
+ size_pos = subr_size_pos;
+ tab = subr_tab;
+ count = subr_max + 1;
+ end_tab = subr_tab + count;
+ }
+ else {
+ start_line = cs_dict_start;
+ line_end = cs_dict_end;
+ size_pos = cs_size_pos;
+ tab = cs_tab;
+ end_tab = cs_ptr;
+ count = cs_count;
+ }
+ t1_line_ptr = t1_line_array;
+ for (p = start_line; p - start_line < size_pos;)
+ *t1_line_ptr++ = *p++;
+ while (isdigit(*p))
+ p++;
+ sprintf(t1_line_ptr, "%u", count);
+ strcat(t1_line_ptr, p);
+ t1_line_ptr = eol(t1_line_array);
+ t1_putline();
+
+ /* create return_cs to replace unsused subr's */
+ if (is_subr) {
+ cr = 4330;
+ cs_len = 0;
+ return_cs = xtalloc(t1_lenIV + 1, byte);
+ if (t1_lenIV > 0) {
+ for (cs_len = 0, r = return_cs; cs_len < t1_lenIV; cs_len++, r++)
+ *r = cencrypt(0x00, &cr);
+ *r = cencrypt(CS_RETURN, &cr);
+ }
+ else {
+ *return_cs = CS_RETURN;
+ }
+ cs_len++;
+ }
+
+ for (ptr = tab; ptr < end_tab; ptr++) {
+ if (ptr->used) {
+ if (is_subr)
+ sprintf(t1_line_array, "dup %u %u", ptr - tab, ptr->cslen);
+ else
+ sprintf(t1_line_array, "/%s %u", ptr->name, ptr->cslen);
+ p = strend(t1_line_array);
+ memcpy(p, ptr->data, ptr->len);
+ t1_line_ptr = p + ptr->len;
+ t1_putline();
+ }
+ else {
+ /* replace unsused subr's by return_cs */
+ if (is_subr) {
+ sprintf(t1_line_array, "dup %u %u%s ", ptr - tab, cs_len,
+ cs_token_pair[0]);
+ p = strend(t1_line_array);
+ memcpy(p, return_cs, cs_len);
+ t1_line_ptr = p + cs_len;
+ t1_putline();
+ sprintf(t1_line_array, " %s", cs_token_pair[1]);
+ t1_line_ptr = eol(t1_line_array);
+ t1_putline();
+ }
+ }
+ xfree(ptr->data);
+ if (ptr->name != notdef)
+ xfree(ptr->name);
+ }
+ sprintf(t1_line_array, "%s", line_end);
+ t1_line_ptr = eol(t1_line_array);
+ t1_putline();
+ if (is_subr)
+ xfree(return_cs);
+ xfree(tab);
+ xfree(start_line);
+ xfree(line_end);
+}
+
+static void t1_mark_glyphs(void)
+{
+ int i;
+ char *charset = extra_charset();
+ char *g, *s, *r;
+ cs_entry *ptr;
+ if (t1_synthetic || embed_all_glyphs(tex_font)) { /* mark everything */
+ if (cs_tab != NULL)
+ for (ptr = cs_tab; ptr < cs_ptr; ptr++)
+ if (ptr->valid)
+ ptr->used = true;
+ if (subr_tab != NULL) {
+ for (ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
+ if (ptr->valid)
+ ptr->used = true;
+ subr_max = subr_size - 1;
+ }
+ return;
+ }
+ mark_cs(notdef);
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (is_used_char(i)) {
+ if (t1_glyph_names[i] == notdef)
+ pdftex_warn("character %i is mapped to %s", i, notdef);
+ else
+ mark_cs(t1_glyph_names[i]);
+ }
+ if (charset == NULL)
+ goto set_subr_max;
+ g = s = charset + 1; /* skip the first '/' */
+ r = strend(g);
+ while (g < r) {
+ while (*s != '/' && s < r)
+ s++;
+ *s = 0; /* terminate g by rewriting '/' to 0 */
+ mark_cs(g);
+ g = s + 1;
+ }
+set_subr_max:
+ if (subr_tab != NULL)
+ for (subr_max = -1, ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
+ if (ptr->used && ptr - subr_tab > subr_max)
+ subr_max = ptr - subr_tab;
+}
+
+static void t1_subset_charstrings(void)
+{
+ cs_entry *ptr;
+ cs_size_pos = strstr(t1_line_array, charstringname) + strlen(charstringname)
+ - t1_line_array + 1;
+ /* cs_size_pos points to the number indicating
+ dict size after "/CharStrings" */
+ cs_size = t1_scan_num(t1_line_array + cs_size_pos, 0);
+ cs_ptr = cs_tab = xtalloc(cs_size, cs_entry);
+ for (ptr = cs_tab; ptr - cs_tab < cs_size; ptr++)
+ init_cs_entry(ptr);
+ cs_notdef = NULL;
+ cs_dict_start = xstrdup(t1_line_array);
+ t1_getline();
+ while (t1_cslen) {
+ store_cs();
+ t1_getline();
+ }
+ cs_dict_end = xstrdup(t1_line_array);
+ t1_mark_glyphs();
+ if (subr_tab != NULL) {
+ if (cs_token_pair == NULL)
+ pdftex_fail("This Type 1 font uses mismatched subroutine begin/end token pairs.");
+ t1_subr_flush();
+ }
+ for (cs_count = 0, ptr = cs_tab; ptr < cs_ptr; ptr++)
+ if (ptr->used)
+ cs_count++;
+ t1_cs_flush();
+}
+
+static void t1_subset_end(void)
+{
+ if (t1_synthetic) { /* copy to "dup /FontName get exch definefont pop" */
+ while (!strstr(t1_line_array, "definefont")) {
+ t1_getline();
+ t1_putline();
+ }
+ while (!t1_end_eexec())
+ t1_getline(); /* ignore the rest */
+ t1_putline(); /* write "mark currentfile closefile" */
+ }
+ else while (!t1_end_eexec()) { /* copy to "mark currentfile closefile" */
+ t1_getline();
+ t1_putline();
+ }
+ t1_stop_eexec();
+ while (!t1_cleartomark()) {
+ t1_getline();
+ t1_putline();
+ }
+ if (!t1_synthetic) /* don't check "{restore}if" for synthetic fonts */
+ t1_check_end(); /* write "{restore}if" if found */
+ get_length3();
+}
+
+void writet1(void)
+{
+ read_encoding_only = false;
+#ifdef pdfTeX
+ t1_save_offset = 0;
+ if (strcasecmp(strend(fm_fontfile(fm_cur)) - 4, ".otf") == 0) {
+ if (!is_included(fm_cur) || is_subsetted(fm_cur))
+ pdftex_fail("OTF fonts must be included entirely");
+ writeotf();
+ is_otf_font = true;
+ return;
+ }
+#endif
+ if (!is_included(fm_cur)) { /* scan parameters from font file */
+ if (!t1_open_fontfile("{"))
+ return;
+ t1_scan_only();
+ t1_close_font_file("}");
+ return;
+ }
+ if (!is_subsetted(fm_cur)) { /* include entire font */
+ if (!t1_open_fontfile("<<"))
+ return;
+ t1_include();
+ t1_close_font_file(">>");
+ return;
+ }
+ /* partial downloading */
+ if (!t1_open_fontfile("<"))
+ return;
+ t1_subset_ascii_part();
+ t1_start_eexec();
+ cc_init();
+ cs_init();
+ t1_read_subrs();
+ t1_subset_charstrings();
+ t1_subset_end();
+ t1_close_font_file(">");
+}
+
+void t1_free()
+{
+ xfree(t1_line_array);
+ xfree(t1_buf_array);
+}
+
+#ifndef pdfTeX
+boolean t1_subset(char *fontfile, char *encfile, unsigned char *g)
+{
+ int i;
+ cur_enc_name = encfile;
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ ext_glyph_names[i] = (char*) notdef;
+ if (cur_enc_name != NULL)
+ load_enc(cur_enc_name, ext_glyph_names);
+ grid = g;
+ cur_file_name = fontfile;
+ hexline_length = 0;
+ writet1();
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (ext_glyph_names[i] != notdef)
+ free(ext_glyph_names[i]);
+ return 1 ; /* note: there *is* no unsuccessful return */
+}
+
+boolean t1_subset_2(char *fontfile, unsigned char *g, char *extraGlyphs)
+{
+ int i;
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ ext_glyph_names[i] = (char*) notdef;
+ grid = g;
+ cur_file_name = fontfile;
+ hexline_length = 0;
+ dvips_extra_charset = extraGlyphs ;
+ writet1();
+ for (i = 0; i <= MAX_CHAR_CODE; i++)
+ if (ext_glyph_names[i] != notdef)
+ free(ext_glyph_names[i]);
+ return 1 ; /* note: there *is* no unsuccessful return */
+}
+#endif /* not pdfTeX */
diff --git a/Build/source/texk/web2c/pdftexdir/writet3.c b/Build/source/texk/web2c/pdftexdir/writet3.c
new file mode 100644
index 00000000000..fa9c09bc3d1
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writet3.c
@@ -0,0 +1,389 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writet3.c#9 $
+*/
+
+#include "ptexlib.h"
+#include <kpathsea/tex-glyph.h>
+#include <kpathsea/magstep.h>
+
+#define T3_BUF_SIZE 1024
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writet3.c#9 $";
+
+/* define t3_line_ptr, t3_line_array & t3_line_limit */
+typedef char t3_line_entry;
+define_array(t3_line);
+
+FILE *t3_file;
+static boolean t3_image_used;
+
+static integer t3_char_procs[MAX_CHAR_CODE + 1];
+static float t3_char_widths[MAX_CHAR_CODE + 1];
+static int t3_glyph_num;
+static float t3_font_scale;
+static integer t3_b0, t3_b1, t3_b2, t3_b3;
+static boolean is_pk_font;
+
+#define t3_open() \
+ open_input(&t3_file, kpse_miscfonts_format, FOPEN_RBIN_MODE)
+#define t3_close() xfclose(t3_file, cur_file_name)
+#define t3_getchar() xgetc(t3_file)
+#define t3_eof() feof(t3_file)
+#define t3_prefix(s) (!strncmp(t3_line_array, s, strlen(s)))
+#define t3_putchar(c) pdfout(c)
+
+#define t3_check_eof() \
+ if (t3_eof()) \
+ pdftex_fail("unexpected end of file");
+
+static void t3_getline(void)
+{
+ int c;
+restart:
+ t3_line_ptr = t3_line_array;
+ c = t3_getchar();
+ while (!t3_eof()) {
+ alloc_array(t3_line, 1, T3_BUF_SIZE);
+ append_char_to_buf(c, t3_line_ptr, t3_line_array, t3_line_limit);
+ if (c == 10)
+ break;
+ c = t3_getchar();
+ }
+ alloc_array(t3_line, 2, T3_BUF_SIZE);
+ append_eol(t3_line_ptr, t3_line_array, T3_BUF_SIZE);
+ if (t3_line_ptr - t3_line_array < 2 || *t3_line_array == '%') {
+ if (!t3_eof())
+ goto restart;
+ }
+}
+
+static void t3_putline(void)
+{
+ char *p = t3_line_array;
+ while (p < t3_line_ptr)
+ t3_putchar(*p++);
+}
+
+static void update_bbox(integer llx, integer lly, integer urx, integer ury, boolean is_first_glyph)
+{
+ if (is_first_glyph) {
+ t3_b0 = llx;
+ t3_b1 = lly;
+ t3_b2 = urx;
+ t3_b3 = ury;
+ }
+ else {
+ if (llx < t3_b0)
+ t3_b0 = llx;
+ if (lly < t3_b1)
+ t3_b1 = lly;
+ if (urx > t3_b2)
+ t3_b2 = urx;
+ if (ury > t3_b3)
+ t3_b3 = ury;
+ }
+}
+
+static void t3_write_glyph(internalfontnumber f)
+{
+ static char t3_begin_glyph_str[] = "\\pdfglyph";
+ static char t3_end_glyph_str[] = "\\endglyph";
+ int glyph_index;
+ int width, height, depth, llx, lly, urx, ury;
+ char *p;
+ t3_getline();
+ if (t3_prefix(t3_begin_glyph_str)) {
+ if (sscanf(t3_line_array + strlen(t3_begin_glyph_str) + 1,
+ "%i %i %i %i %i %i %i %i =", &glyph_index,
+ &width, &height, &depth, &llx, &lly, &urx, &ury) != 8) {
+ remove_eol(p, t3_line_array);
+ pdftex_warn("invalid glyph preamble: `%s'", t3_line_array);
+ return;
+ }
+ if (glyph_index < fontbc[f] || glyph_index > fontec[f])
+ return;
+ }
+ else
+ return;
+ if (!pdfcharmarked(f, glyph_index)) {
+ while (!t3_prefix(t3_end_glyph_str)) {
+ t3_check_eof();
+ t3_getline();
+ }
+ return;
+ }
+ update_bbox(llx, lly, urx, ury, t3_glyph_num == 0);
+ t3_glyph_num++;
+ pdfnewdict(0, 0);
+ t3_char_procs[glyph_index] = objptr;
+ if (width == 0)
+ t3_char_widths[glyph_index] =
+ (getcharwidth(f, glyph_index)/t3_font_scale) / pdffontsize[f];
+ else
+ t3_char_widths[glyph_index] = width;
+ pdfbeginstream();
+ t3_getline();
+ pdf_printf("%i 0 %i %i %i %i d1\nq\n",
+ (int)t3_char_widths[glyph_index], (int)llx,
+ (int)lly, (int)urx, (int)ury);
+ while (!t3_prefix(t3_end_glyph_str)) {
+ t3_check_eof();
+ if (t3_prefix("BI"))
+ t3_image_used = true;
+ t3_putline();
+ t3_getline();
+ }
+ pdf_puts("Q\n");
+ pdfendstream();
+}
+
+static integer get_pk_font_scale(internalfontnumber f)
+{
+ return
+ dividescaled(pkscalefactor,
+ dividescaled(pdffontsize[f], onehundredbp, fixeddecimaldigits + 2),
+ 0);
+}
+
+static integer pk_char_width(internalfontnumber f, scaled w)
+{
+ return
+ dividescaled(dividescaled(w, pdffontsize[f], 7),
+ get_pk_font_scale(f), 0);
+}
+
+scaled getpkcharwidth(internalfontnumber f, scaled w)
+{
+ return (get_pk_font_scale(f)/100000.0)*
+ (pk_char_width(f, w)/100.0)*
+ pdffontsize[f];
+}
+
+static boolean writepk(internalfontnumber f)
+{
+ kpse_glyph_file_type font_ret;
+ integer llx, lly, urx, ury;
+ integer cw, rw, i, j;
+ halfword *row;
+ char *name;
+ chardesc cd;
+ boolean is_null_glyph, check_preamble;
+ integer dpi;
+ int e;
+ dpi = kpse_magstep_fix(
+ round(fixedpkresolution*(((float)pdffontsize[f])/fontdsize[f])),
+ fixedpkresolution, NULL);
+ cur_file_name = makecstring(fontname[f]);
+ name = kpse_find_pk(cur_file_name, (unsigned)dpi, &font_ret);
+ if (name == NULL ||
+ !FILESTRCASEEQ(cur_file_name, font_ret.name) ||
+ !kpse_bitmap_tolerance((float)font_ret.dpi, (float)dpi)) {
+ pdftex_warn("Font %s at %i not found", cur_file_name, (int)dpi);
+ cur_file_name = NULL;
+ return false;
+ }
+ t3_file = xfopen(name, FOPEN_RBIN_MODE);
+ t3_image_used = true;
+ is_pk_font = true;
+ tex_printf(" <%s", (char *)name);
+ cd.rastersize = 256;
+ cd.raster = xtalloc(cd.rastersize, halfword);
+ check_preamble = true;
+ while (readchar(check_preamble, &cd) != 0) {
+ check_preamble = false;
+ if (!pdfcharmarked(f, cd.charcode))
+ continue;
+ t3_char_widths[cd.charcode] =
+ pk_char_width(f, getcharwidth(f, cd.charcode));
+ if (cd.cwidth < 1 || cd.cheight < 1) {
+ cd.xescape = cd.cwidth = round(t3_char_widths[cd.charcode]/100.0);
+ cd.cheight = 1;
+ cd.xoff = 0;
+ cd.yoff = 0;
+ is_null_glyph = true;
+ }
+ else
+ is_null_glyph = false;
+ llx = -cd.xoff;
+ lly = cd.yoff - cd.cheight + 1;
+ urx = cd.cwidth + llx + 1;
+ ury = cd.cheight + lly;
+ update_bbox(llx, lly, urx, ury, t3_glyph_num == 0);
+ t3_glyph_num++;
+ pdfnewdict(0, 0);
+ t3_char_procs[cd.charcode] = objptr;
+ pdfbeginstream();
+ pdfprintreal(t3_char_widths[cd.charcode], 2);
+ pdf_printf(" 0 %i %i %i %i d1\n",
+ (int)llx, (int)lly, (int)urx, (int)ury);
+ if (is_null_glyph)
+ goto end_stream;
+ pdf_printf("q\n%i 0 0 %i %i %i cm\nBI\n", (int)cd.cwidth,
+ (int)cd.cheight, (int)llx, (int)lly);
+ pdf_printf("/W %i\n/H %i\n",
+ (int)cd.cwidth, (int)cd.cheight);
+ pdf_puts("/IM true\n/BPC 1\n/D [1 0]\nID ");
+ cw = (cd.cwidth + 7)/8;
+ rw = (cd.cwidth + 15)/16;
+ row = cd.raster;
+ for (i = 0; i < cd.cheight; i++) {
+ for (j = 0; j < rw - 1; j++) {
+ pdfout(*row/256);
+ pdfout(*row%256);
+ row++;
+ }
+ pdfout(*row/256);
+ if (2*rw == cw)
+ pdfout(*row%256);
+ row++;
+ }
+ pdf_puts("\nEI\nQ\n");
+end_stream:
+ pdfendstream();
+ }
+ xfree(cd.raster);
+ cur_file_name = NULL;
+ return true;
+}
+
+void writet3(int objnum, internalfontnumber f)
+{
+ static char t3_font_scale_str[] = "\\pdffontscale";
+ int i, e;
+ int first_char, last_char;
+ integer pk_font_scale;
+ boolean is_notdef;
+ t3_glyph_num = 0;
+ t3_image_used = false;
+ for (i = 0; i <= MAX_CHAR_CODE; i++) {
+ t3_char_procs[i] = 0;
+ t3_char_widths[i] = 0;
+ }
+ packfilename(fontname[f], getnullstr(), maketexstring(".pgc"));
+ cur_file_name = makecstring(makenamestring());
+ is_pk_font = false;
+ if (!t3_open()) {
+ if (writepk(f))
+ goto write_font_dict;
+ else {
+ cur_file_name = NULL;
+ return;
+ }
+ }
+ tex_printf("<%s", nameoffile + 1);
+ t3_getline();
+ if (!t3_prefix(t3_font_scale_str) ||
+ sscanf(t3_line_array + strlen(t3_font_scale_str) + 1, "%g", &t3_font_scale) < 1 ||
+ t3_font_scale <= 0 || t3_font_scale > 1000 ) {
+ pdftex_warn("missing or invalid font scale");
+ t3_close();
+ cur_file_name = NULL;
+ return;
+ }
+ while (!t3_eof())
+ t3_write_glyph(f);
+write_font_dict:
+ for (i = fontbc[f]; i <= fontec[f]; i++)
+ if (pdfcharmarked(f, i))
+ break;
+ first_char = i;
+ for (i = fontec[f]; i > first_char; i--)
+ if (pdfcharmarked(f, i))
+ break;
+ last_char = i;
+ pdfbegindict(objnum); /* Type 3 font dictionary */
+ pdf_puts("/Type /Font\n/Subtype /Type3\n");
+ pdf_printf("/Name /F%i\n", (int)f);
+ if (pdffontattr[f] != getnullstr()) {
+ pdfprint(pdffontattr[f]);
+ pdf_puts("\n");
+ }
+ if (is_pk_font) {
+ pk_font_scale = get_pk_font_scale(f);
+ pdf_puts("/FontMatrix [");
+ pdfprintreal(pk_font_scale, 5);
+ pdf_puts(" 0 0 ");
+ pdfprintreal(pk_font_scale, 5);
+ pdf_puts(" 0 0]\n") ;
+ }
+ else
+ pdf_printf("/FontMatrix [%g 0 0 %g 0 0]\n",
+ (double)t3_font_scale, (double)t3_font_scale);
+ pdf_printf("/%s [ %i %i %i %i ]\n",
+ font_keys[FONTBBOX1_CODE].pdfname,
+ (int)t3_b0, (int)t3_b1,
+ (int)t3_b2, (int)t3_b3);
+ pdf_printf("/Resources << /ProcSet [ /PDF %s] >>\n",
+ t3_image_used ? "/ImageB " : "");
+ pdf_printf("/FirstChar %i\n/LastChar %i\n", first_char, last_char);
+ pdf_printf("/Widths %i 0 R\n/Encoding %i 0 R\n/CharProcs %i 0 R\n",
+ (int)(objptr + 1), (int)(objptr + 2),
+ (int)(objptr + 3));
+ pdfenddict();
+ pdfnewobj(0, 0); /* chars width array */
+ pdf_puts("[");
+ if (is_pk_font)
+ for (i = first_char; i <= last_char; i++) {
+ pdfprintreal(t3_char_widths[i], 2);
+ pdf_puts(" ");
+ }
+ else
+ for (i = first_char; i <= last_char; i++)
+ pdf_printf("%i ", (int)t3_char_widths[i]);
+ pdf_puts("]\n");
+ pdfendobj();
+ pdfnewdict(0, 0); /* encoding dictionary */
+ pdf_printf("/Type /Encoding\n/Differences [%i", first_char);
+ if (t3_char_procs[first_char] == 0) {
+ pdf_printf("/%s", notdef);
+ is_notdef = true;
+ }
+ else {
+ pdf_printf("/a%i", first_char);
+ is_notdef = false;
+ }
+ for (i = first_char + 1; i <= last_char; i++) {
+ if (t3_char_procs[i] == 0) {
+ if (!is_notdef) {
+ pdf_printf(" %i/%s", i, notdef);
+ is_notdef = true;
+ }
+ }
+ else {
+ if (is_notdef) {
+ pdf_printf(" %i", i);
+ is_notdef = false;
+ }
+ pdf_printf("/a%i", i);
+ }
+ }
+ pdf_puts("]\n");
+ pdfenddict();
+ pdfnewdict(0, 0); /* CharProcs dictionary */
+ for (i = first_char; i <= last_char; i++)
+ if (t3_char_procs[i] != 0)
+ pdf_printf("/a%i %i 0 R\n", (int)i, (int)t3_char_procs[i]);
+ pdfenddict();
+ t3_close();
+ tex_printf(">");
+ cur_file_name = NULL;
+}
diff --git a/Build/source/texk/web2c/pdftexdir/writettf.c b/Build/source/texk/web2c/pdftexdir/writettf.c
new file mode 100644
index 00000000000..e2d0d1641d6
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writettf.c
@@ -0,0 +1,1257 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writettf.c#16 $
+*/
+
+#include "ptexlib.h"
+#include "writettf.h"
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writettf.c#16 $";
+
+#define DEFAULT_NTABS 14
+#define NEW_CMAP_SIZE 2
+
+#define ttf_putchar fb_putchar
+#define ttf_offset fb_offset
+#define ttf_seek_outbuf fb_seek
+
+#define INFILE ttf_file
+
+#define ttf_open() \
+ open_input(&ttf_file, kpse_truetype_format, FOPEN_RBIN_MODE)
+#define ttf_close() xfclose(ttf_file, cur_file_name)
+#define ttf_getchar() xgetc(ttf_file)
+#define ttf_eof() feof(ttf_file)
+
+typedef struct {
+ TTF_LONG offset;
+ TTF_LONG newoffset;
+ TTF_UFWORD advWidth;
+ TTF_FWORD lsb;
+ char *name; /* name of glyph */
+ TTF_SHORT newindex; /* new index of glyph in output file */
+ TTF_USHORT name_index; /* index of name as read from font file */
+} glyph_entry;
+
+typedef struct {
+ char *name; /* name of glyph */
+ short newindex; /* new index of glyph in output file */
+} ttfenc_entry;
+
+typedef struct {
+ TTF_USHORT platform_id;
+ TTF_USHORT encoding_id;
+ TTF_USHORT language_id;
+ TTF_USHORT name_id;
+ TTF_USHORT length;
+ TTF_USHORT offset;
+ TTF_USHORT new_offset;
+ TTF_USHORT new_length;
+} name_record;
+
+static TTF_USHORT ntabs;
+static TTF_USHORT upem;
+static TTF_FIXED post_format;
+static TTF_SHORT loca_format;
+static TTF_ULONG last_glyf_offset;
+static TTF_USHORT glyphs_count;
+static TTF_USHORT new_glyphs_count;
+static TTF_USHORT nhmtxs;
+static TTF_USHORT new_ntabs;
+
+static glyph_entry *glyph_tab;
+static short *glyph_index;
+static cmap_entry *cmap_tab, new_cmap_tab[NEW_CMAP_SIZE];
+static name_record *name_tab;
+static int name_record_num;
+static char *name_buf;
+static int name_buf_size;
+static dirtab_entry *dir_tab;
+static char *glyph_name_buf;
+static TTF_ULONG checksum;
+static TTF_ULONG tab_length;
+static TTF_ULONG tmp_ulong;
+static TTF_ULONG checkSumAdjustment_offset;
+static FILE *ttf_file;
+static ttfenc_entry ttfenc_tab[MAX_CHAR_CODE + 1];
+
+static TTF_USHORT unicode_map[0xFFFF];
+
+
+integer ttf_length;
+
+#include "macnames.c"
+
+extern char *fb_array;
+
+static const char *newtabnames[] = {
+ "OS/2",
+ "PCLT",
+ "cmap",
+ "cvt ",
+ "fpgm",
+ "glyf",
+ "head",
+ "hhea",
+ "hmtx",
+ "loca",
+ "maxp",
+ "name",
+ "post",
+ "prep"
+};
+
+static unsigned char ttf_addchksm(unsigned char b)
+{
+ tmp_ulong = (tmp_ulong << 8) + b;
+ tab_length++;
+ if (tab_length % 4 == 0) {
+ checksum += tmp_ulong;
+ tmp_ulong = 0;
+ }
+ return b;
+}
+
+static TTF_ULONG ttf_getchksm(void)
+{
+ while (tab_length % 4 != 0)
+ ttf_putchar(ttf_addchksm(0)); /* ttf_addchksm updates tab_length */
+ return checksum;
+}
+
+static long ttf_putnum(int s, long n)
+{
+ long i = n;
+ char buf[TTF_LONG_SIZE + 1], *p = buf;
+ while (s-- > 0) {
+ *p++ = i & 0xFF;
+ i >>= 8;
+ }
+ p--;
+ while (p >= buf)
+ ttf_putchar(ttf_addchksm(*p--));
+ return n;
+}
+
+static long ttf_getnum(int s)
+{
+ long i = 0;
+ int c;
+ while (s > 0) {
+ if ((c = ttf_getchar()) < 0)
+ pdftex_fail("unexpected EOF");
+ i = (i << 8) + c;
+ s--;
+ }
+ return i;
+}
+
+static long ttf_funit(long n)
+{
+ if (n < 0)
+ return -((-n/upem)*1000 + ((-n%upem)*1000)/upem);
+ else
+ return (n/upem)*1000 + ((n%upem)*1000)/upem;
+}
+
+static void ttf_ncopy(int n)
+{
+ while (n-- > 0)
+ copy_byte();
+}
+
+static dirtab_entry *ttf_name_lookup(const char *s, boolean required)
+{
+ dirtab_entry *tab;
+ for (tab = dir_tab; tab - dir_tab < ntabs; tab++)
+ if (strncmp(tab->tag, s, 4) == 0)
+ break;
+ if (tab - dir_tab == ntabs) {
+ if (required)
+ pdftex_fail("can't find table `%s'", s);
+ else
+ tab = NULL;
+ }
+ return tab;
+}
+
+static dirtab_entry *ttf_seek_tab(const char *name, TTF_LONG offset)
+{
+ dirtab_entry *tab = ttf_name_lookup(name, true);
+ xfseek(INFILE, tab->offset + offset, SEEK_SET, cur_file_name);
+ return tab;
+}
+
+static void ttf_seek_off(TTF_LONG offset)
+{
+ xfseek(INFILE, offset, SEEK_SET, cur_file_name);
+}
+
+static void ttf_copy_encoding(void)
+{
+ int i;
+ char **glyph_names = (fm_cur->encoding)->glyph_names;
+ ttfenc_entry *e = ttfenc_tab;
+ pdfmarkchar(tex_font, 'a'); /* workaround for a bug of AcroReader 4.0 */
+ for (i = 0; i <= MAX_CHAR_CODE; i++, e++) {
+ if (pdfcharmarked(tex_font, i))
+ e->name = glyph_names[i];
+ else
+ e->name = (char*) notdef;
+ }
+}
+
+#define ttf_append_byte(B)\
+do {\
+ if (name_tab[i].platform_id == 3)\
+ *q++ = 0;\
+ *q++ = B;\
+} while (0)
+
+static void ttf_read_name(void)
+{
+ int i, j;
+ dirtab_entry *tab = ttf_seek_tab("name", TTF_USHORT_SIZE);
+ char *p;
+ name_record_num = get_ushort();
+ name_tab = xtalloc(name_record_num, name_record);
+ name_buf_size = tab->length -
+ (3*TTF_USHORT_SIZE + name_record_num*6*TTF_USHORT_SIZE);
+ name_buf = xtalloc(name_buf_size, char);
+ ttf_skip(TTF_USHORT_SIZE);
+ for (i = 0; i < name_record_num; i++) {
+ name_tab[i].platform_id = get_ushort();
+ name_tab[i].encoding_id = get_ushort();
+ name_tab[i].language_id = get_ushort();
+ name_tab[i].name_id = get_ushort();
+ name_tab[i].length = get_ushort();
+ name_tab[i].offset = get_ushort();
+ }
+ for (p = name_buf; p - name_buf < name_buf_size; p++)
+ *p = get_char();
+ /* look for PS font name */
+ for (i = 0; i < name_record_num; i++) {
+ if (name_tab[i].platform_id == 1 &&
+ name_tab[i].encoding_id == 0 &&
+ name_tab[i].name_id == 6) {
+ strncpy(fontname_buf, name_buf + name_tab[i].offset, name_tab[i].length);
+ fontname_buf[name_tab[i].length] = 0;
+ font_keys[FONTNAME_CODE].valid = true;
+ break;
+ }
+ }
+ if (!font_keys[FONTNAME_CODE].valid) {
+ for (i = 0; i < name_record_num; i++) {
+ if (name_tab[i].platform_id == 3 &&
+ (name_tab[i].encoding_id == 0 ||
+ name_tab[i].encoding_id == 1) &&
+ name_tab[i].name_id == 6) {
+ for (j = 0, p = fontname_buf; j < name_tab[i].length; j += 2)
+ *p++ = name_buf[name_tab[i].offset + j + 1];
+ *p = 0;
+ font_keys[FONTNAME_CODE].valid = true;
+ break;
+ }
+ }
+ }
+}
+
+static void ttf_read_mapx(void)
+{
+ int i;
+ glyph_entry *glyph;
+ ttf_seek_tab("maxp", TTF_FIXED_SIZE);
+ glyph_tab = xtalloc(1 + (glyphs_count = get_ushort()), glyph_entry);
+ for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count; glyph++) {
+ glyph->newindex = -1;
+ glyph->newoffset = 0;
+ glyph->name_index = 0;
+ glyph->name = (char*) notdef;
+ }
+ glyph_index = xtalloc(glyphs_count, short);
+ glyph_index[0] = 0; /* index of ".notdef" glyph */
+ glyph_index[1] = 1; /* index of ".null" glyph */
+}
+
+static void ttf_read_head(void)
+{
+ ttf_seek_tab("head", 2*TTF_FIXED_SIZE + 2*TTF_ULONG_SIZE + TTF_USHORT_SIZE);
+ upem = get_ushort();
+ ttf_skip(16);
+ font_keys[FONTBBOX1_CODE].value = ttf_funit(get_fword());
+ font_keys[FONTBBOX2_CODE].value = ttf_funit(get_fword());
+ font_keys[FONTBBOX3_CODE].value = ttf_funit(get_fword());
+ font_keys[FONTBBOX4_CODE].value = ttf_funit(get_fword());
+ font_keys[FONTBBOX1_CODE].valid = true;
+ font_keys[FONTBBOX2_CODE].valid = true;
+ font_keys[FONTBBOX3_CODE].valid = true;
+ font_keys[FONTBBOX4_CODE].valid = true;
+ ttf_skip(2*TTF_USHORT_SIZE + TTF_SHORT_SIZE);
+ loca_format = get_short();
+}
+
+static void ttf_read_hhea(void)
+{
+ ttf_seek_tab("hhea", TTF_FIXED_SIZE);
+ font_keys[ASCENT_CODE].value = ttf_funit(get_fword());
+ font_keys[DESCENT_CODE].value = ttf_funit(get_fword());
+ font_keys[ASCENT_CODE].valid = true;
+ font_keys[DESCENT_CODE].valid = true;
+ ttf_skip(TTF_FWORD_SIZE + TTF_UFWORD_SIZE + 3*TTF_FWORD_SIZE + 8*TTF_SHORT_SIZE);
+ nhmtxs = get_ushort();
+}
+
+static void ttf_read_pclt(void)
+{
+ if (ttf_name_lookup("PCLT", false) == NULL)
+ return;
+ ttf_seek_tab("PCLT", TTF_FIXED_SIZE + TTF_ULONG_SIZE + TTF_USHORT_SIZE);
+ font_keys[XHEIGHT_CODE].value = ttf_funit(get_ushort());
+ ttf_skip(2*TTF_USHORT_SIZE);
+ font_keys[CAPHEIGHT_CODE].value = ttf_funit(get_ushort());
+ font_keys[XHEIGHT_CODE].valid = true;
+ font_keys[CAPHEIGHT_CODE].valid = true;
+}
+
+static void ttf_read_hmtx(void)
+{
+ glyph_entry *glyph;
+ TTF_UFWORD last_advWidth;
+ ttf_seek_tab("hmtx", 0);
+ for (glyph = glyph_tab; glyph - glyph_tab < nhmtxs; glyph++) {
+ glyph->advWidth = get_ufword();
+ glyph->lsb = get_ufword();
+ }
+ if (nhmtxs < glyphs_count) {
+ last_advWidth = glyph[-1].advWidth;
+ for (;glyph - glyph_tab < glyphs_count; glyph++) {
+ glyph->advWidth = last_advWidth;
+ glyph->lsb = get_ufword();
+ }
+ }
+}
+
+static void ttf_read_post(void)
+{
+ int k, nnames;
+ long length;
+ long int_part, frac_part;
+ int sign = 1;
+ TTF_FIXED italic_angle;
+ char *p;
+ glyph_entry *glyph;
+ dirtab_entry *tab = ttf_seek_tab("post", 0);
+ post_format = get_fixed();
+ italic_angle = get_fixed();
+ int_part = italic_angle >> 16;
+ if (int_part > 0x7FFF) { /* a negative number */
+ int_part = 0x10000 - int_part;
+ sign = -1;
+ }
+ frac_part = italic_angle % 0x10000;
+ font_keys[ITALIC_ANGLE_CODE].value = sign*(int_part + frac_part*1.0/0x10000);
+ font_keys[ITALIC_ANGLE_CODE].valid = true;
+ if (glyph_tab == NULL)
+ return; /* being called from writeotf() */
+ ttf_skip(2*TTF_FWORD_SIZE + 5*TTF_ULONG_SIZE);
+ switch (post_format) {
+ case 0x10000:
+ for (glyph = glyph_tab; glyph - glyph_tab < NMACGLYPHS; glyph++) {
+ glyph->name = (char*)mac_glyph_names[glyph - glyph_tab];
+ glyph->name_index = glyph - glyph_tab;
+ }
+ break;
+ case 0x20000:
+ nnames = get_ushort(); /* some fonts have this value different from nglyphs */
+ for (glyph = glyph_tab; glyph - glyph_tab < nnames; glyph++)
+ glyph->name_index = get_ushort();
+ length = tab->length - (xftell(INFILE, cur_file_name) - tab->offset);
+ glyph_name_buf = xtalloc(length, char);
+ for (p = glyph_name_buf; p - glyph_name_buf < length;) {
+ for (k = get_byte(); k > 0; k--)
+ *p++ = get_char();
+ *p++ = 0;
+ }
+ for (glyph = glyph_tab; glyph - glyph_tab < nnames; glyph++) {
+ if (glyph->name_index < NMACGLYPHS)
+ glyph->name = (char*)mac_glyph_names[glyph->name_index];
+ else {
+ p = glyph_name_buf;
+ k = glyph->name_index - NMACGLYPHS;
+ for (; k > 0; k--)
+ p = strend(p) + 1;
+ glyph->name = p;
+ }
+ }
+ break;
+ case 0x00030000:
+ for (glyph = glyph_tab; glyph - glyph_tab < NMACGLYPHS; glyph++) {
+ glyph->name_index = glyph - glyph_tab;
+ }
+ break;
+ default:
+ pdftex_fail("unsupported format (%.8X) of `post' table", (unsigned int) post_format);
+ }
+}
+
+static void ttf_read_loca(void)
+{
+ glyph_entry *glyph;
+ ttf_seek_tab("loca", 0);
+ if (loca_format != 0)
+ for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count + 1; glyph++)
+ glyph->offset = get_ulong();
+ else
+ for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count + 1; glyph++)
+ glyph->offset = get_ushort() << 1;
+}
+
+static void ttf_read_tabdir()
+{
+ int i;
+ dirtab_entry *tab;
+/* if ((version= get_fixed()) != 0x00010000) */
+/* pdftex_fail("unsupport version 0x%.8X; can handle only version 1.0", (int)version); */
+ ttf_skip(TTF_FIXED_SIZE); /* ignore the sfnt number */
+ dir_tab = xtalloc(ntabs = get_ushort(), dirtab_entry);
+ ttf_skip(3*TTF_USHORT_SIZE);
+ for (tab = dir_tab; tab - dir_tab < ntabs; tab++) {
+ for (i = 0; i < 4; i++)
+ tab->tag[i] = get_char();
+ tab->checksum = get_ulong();
+ tab->offset = get_ulong();
+ tab->length = get_ulong();
+ }
+}
+
+static void ttf_read_cmap(void)
+{
+ cmap_entry *e;
+ seg_entry *seg_tab, *s;
+ TTF_USHORT *glyphId, format, segCount;
+ TTF_USHORT ncmapsubtabs;
+ long cmap_offset;
+ long int n, i, j, k, first_code, length, last_sep, index;
+ int unicode_map_count = 0;
+ int select_unicode = 1; /* may be changed later if needed */
+ ttf_seek_tab("cmap", TTF_USHORT_SIZE); /* skip the table vesrion number (=0) */
+ ncmapsubtabs = get_ushort();
+ cmap_offset = xftell(INFILE, cur_file_name) - 2*TTF_USHORT_SIZE;
+ cmap_tab = xtalloc(ncmapsubtabs, cmap_entry);
+ for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
+ e->platform_id = get_ushort();
+ e->encoding_id = get_ushort();
+ e->offset = get_ulong();
+ }
+ for (i = 0; i < 0xFFFF; ++i)
+ unicode_map[i] = NOGLYPH_ASSIGNED_YET;
+ for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
+ ttf_seek_off(cmap_offset + e->offset);
+ format = get_ushort();
+ if (is_unicode_mapping(e) && format == 4) {
+ ++unicode_map_count;
+ if (unicode_map_count == select_unicode)
+ goto read_unicode_mapping;
+ }
+ continue;
+read_unicode_mapping:
+ length = get_ushort(); /* length of subtable */
+ get_ushort(); /* skip the version number */
+ segCount = get_ushort()/2;
+ get_ushort(); /* skip searchRange */
+ get_ushort(); /* skip entrySelector */
+ get_ushort(); /* skip rangeShift */
+ seg_tab = xtalloc(segCount, seg_entry);
+ for (s = seg_tab; s - seg_tab < segCount; s++)
+ s->endCode = get_ushort();
+ get_ushort(); /* skip reversedPad */
+ for (s = seg_tab; s - seg_tab < segCount; s++)
+ s->startCode = get_ushort();
+ for (s = seg_tab; s - seg_tab < segCount; s++)
+ s->idDelta = get_ushort();
+ for (s = seg_tab; s - seg_tab < segCount; s++)
+ s->idRangeOffset = get_ushort();
+ length -= 8*TTF_USHORT_SIZE + 4*segCount*TTF_USHORT_SIZE;
+ n = length/TTF_USHORT_SIZE; /* number of glyphID's */
+ glyphId = xtalloc(n, TTF_USHORT);
+ for (i = 0; i < n; i++)
+ glyphId[i] = get_ushort();
+ for (s = seg_tab; s - seg_tab < segCount; s++) {
+ for (i = s->startCode; i <= s->endCode; i++) {
+ if (i == 0xFFFF)
+ break;
+ if (s->idRangeOffset != 0xFFFF) {
+ if (s->idRangeOffset == 0)
+ index = (s->idDelta + i) & 0xFFFF;
+ else {
+ k = (i - s->startCode) + s->idRangeOffset/2 +
+ (s - seg_tab) - segCount ;
+ assert(k >= 0 && k < n);
+ index = glyphId[k];
+ if (index != 0)
+ index = (index + s->idDelta) & 0xFFFF;
+ }
+ if (index >= glyphs_count)
+ pdftex_fail("cmap: glyph index %i out of range [0..%i)",
+ index, glyphs_count);
+ if (unicode_map[i] != NOGLYPH_ASSIGNED_YET)
+ pdftex_warn("cmap: multiple glyphs are mapped to unicode %.4X, "
+ "only %i will be used (glyph %i being ignored)",
+ i, unicode_map[i], index);
+ else
+ unicode_map[i] = index;
+ }
+ }
+ }
+ xfree(seg_tab);
+ xfree(glyphId);
+ break;
+ }
+ if (e - cmap_tab == ncmapsubtabs)
+ pdftex_fail("Invalid argument `-m %i': out of range [1..%i]",
+ select_unicode, unicode_map_count);
+ xfree(cmap_tab);
+}
+
+static void ttf_read_font(void)
+{
+ ttf_read_tabdir();
+ if (ttf_name_lookup("PCLT", false) == NULL)
+ new_ntabs--;
+ if (ttf_name_lookup("fpgm", false) == NULL)
+ new_ntabs--;
+ if (ttf_name_lookup("cvt ", false) == NULL)
+ new_ntabs--;
+ if (ttf_name_lookup("prep", false) == NULL)
+ new_ntabs--;
+ ttf_read_mapx();
+ ttf_read_head();
+ ttf_read_hhea();
+ ttf_read_pclt();
+ ttf_read_hmtx();
+ ttf_read_post();
+ ttf_read_loca();
+ ttf_read_name();
+ ttf_read_cmap();
+}
+
+static void ttf_reset_chksm(dirtab_entry *tab)
+{
+ checksum = 0;
+ tab_length = 0;
+ tmp_ulong = 0;
+ tab->offset = ttf_offset();
+ if (tab->offset % 4 != 0)
+ pdftex_warn("offset of `%4.4s' is not a multiple of 4", tab->tag);
+}
+
+
+static void ttf_set_chksm(dirtab_entry *tab)
+{
+ tab->length = ttf_offset() - tab->offset;
+ tab->checksum = ttf_getchksm();
+}
+
+static void ttf_copytab(const char *name)
+{
+ long i;
+ dirtab_entry *tab = ttf_seek_tab(name, 0);
+ ttf_reset_chksm(tab);
+ for (i = tab->length; i > 0; i--)
+ copy_char();
+ ttf_set_chksm(tab);
+}
+
+#define BYTE_ENCODING_LENGTH \
+ ((MAX_CHAR_CODE + 1)*TTF_BYTE_SIZE + 3*TTF_USHORT_SIZE)
+
+static void ttf_byte_encoding(void)
+{
+ ttfenc_entry *e;
+ put_ushort(0); /* format number (0: byte encoding table) */
+ put_ushort(BYTE_ENCODING_LENGTH); /* length of table */
+ put_ushort(0); /* version number */
+ for (e = ttfenc_tab; e - ttfenc_tab <= MAX_CHAR_CODE; e++)
+ if (e->newindex < 256) {
+ put_byte(e->newindex);
+ }
+ else {
+ if (e->name != notdef)
+ pdftex_warn("glyph `%s' has been mapped to `%s' in `ttf_byte_encoding' cmap table",
+ e->name, notdef);
+ put_byte(0); /* notdef */
+ }
+}
+
+#define TRIMMED_TABLE_MAP_LENGTH (TTF_USHORT_SIZE*(5 + (MAX_CHAR_CODE + 1)))
+
+static void ttf_trimmed_table_map(void)
+{
+ ttfenc_entry *e;
+ put_ushort(6); /* format number (6): trimmed table mapping */
+ put_ushort(TRIMMED_TABLE_MAP_LENGTH);
+ put_ushort(0); /* version number (0) */
+ put_ushort(0); /* first character code */
+ put_ushort(MAX_CHAR_CODE + 1); /* number of character code in table */
+ for (e = ttfenc_tab; e - ttfenc_tab <= MAX_CHAR_CODE; e++)
+ put_ushort(e->newindex);
+}
+
+#define SEG_MAP_DELTA_LENGTH ((16 + (MAX_CHAR_CODE + 1))*TTF_USHORT_SIZE)
+
+static void ttf_seg_map_delta(void)
+{
+ ttfenc_entry *e;
+ put_ushort(4); /* format number (4: segment mapping to delta values) */
+ put_ushort(SEG_MAP_DELTA_LENGTH);
+ put_ushort(0); /* version number */
+ put_ushort(4); /* 2*segCount */
+ put_ushort(4); /* searchRange */
+ put_ushort(1); /* entrySelector */
+ put_ushort(0); /* rangeShift */
+ put_ushort(0xF0FF); /* endCount[0] */
+ put_ushort(0xFFFF); /* endCount[1] */
+ put_ushort(0); /* reversedPad */
+ put_ushort(0xF000); /* startCount[0] */
+ put_ushort(0xFFFF); /* startCount[1] */
+ put_ushort(0); /* idDelta[0] */
+ put_ushort(1); /* idDelta[1] */
+ put_ushort(2*TTF_USHORT_SIZE); /* idRangeOffset[0] */
+ put_ushort(0); /* idRangeOffset[1] */
+ for (e = ttfenc_tab; e - ttfenc_tab <= MAX_CHAR_CODE; e++)
+ put_ushort(e->newindex);
+}
+
+#define CMAP_ENTRY_LENGTH (2*TTF_USHORT_SIZE + TTF_ULONG_SIZE)
+
+static void ttf_select_cmap(void)
+{
+ assert(sizeof(new_cmap_tab) <= NEW_CMAP_SIZE*sizeof(cmap_entry));
+ new_cmap_tab[0].platform_id = 1; /* Macintosh */
+ new_cmap_tab[0].encoding_id = 0; /* Symbol; ignore code page */
+ new_cmap_tab[0].format = new_glyphs_count < 256 ? 0 /* byte encoding */
+ : 6; /* trimmed table mapping */
+ new_cmap_tab[1].platform_id = 3; /* Microsoft */
+ new_cmap_tab[1].encoding_id = 0; /* Symbol; ignore code page */
+ new_cmap_tab[1].format = 4; /* segment mapping to delta */
+}
+
+static void ttf_write_cmap(void)
+{
+ cmap_entry *ce;
+ long offset;
+ dirtab_entry *tab = ttf_name_lookup("cmap", true);
+ ttf_select_cmap();
+ ttf_reset_chksm(tab);
+ put_ushort(0); /* table version number (0) */
+ put_ushort(NEW_CMAP_SIZE); /* number of encoding tables */
+ offset = 2*TTF_USHORT_SIZE + NEW_CMAP_SIZE*CMAP_ENTRY_LENGTH;
+ for (ce = new_cmap_tab; ce - new_cmap_tab < NEW_CMAP_SIZE; ce++) {
+ ce->offset = offset;
+ switch (ce->format) {
+ case 0:
+ offset += BYTE_ENCODING_LENGTH;
+ break;
+ case 4:
+ offset += SEG_MAP_DELTA_LENGTH;
+ break;
+ case 6:
+ offset += TRIMMED_TABLE_MAP_LENGTH;
+ break;
+ default:
+ pdftex_fail("invalid format (it should not have happened)");
+ }
+ put_ushort(ce->platform_id);
+ put_ushort(ce->encoding_id);
+ put_ulong(ce->offset);
+ }
+ for (ce = new_cmap_tab; ce - new_cmap_tab < NEW_CMAP_SIZE; ce++) {
+ switch (ce->format) {
+ case 0:
+ ttf_byte_encoding();
+ break;
+ case 4:
+ ttf_seg_map_delta();
+ break;
+ case 6:
+ ttf_trimmed_table_map();
+ break;
+ }
+ }
+ ttf_set_chksm(tab);
+}
+
+static int prepend_subset_tags(int index, char *p)
+{
+ boolean is_unicode = (name_tab[index].platform_id == 3);
+ int i;
+ assert(index > 0 && index < name_record_num && fm_cur->subset_tag != NULL);
+ if (is_unicode) {
+ for (i = 0; i < 6; ++i) {
+ *p++ = 0;
+ *p++ = fm_cur->subset_tag[i];
+ }
+ *p++ = 0;
+ *p++ = '+';
+ return 14;
+ } else {
+ strncpy(p, fm_cur->subset_tag, 6);
+ p += 6;
+ *p++ = '+';
+ return 7;
+ }
+}
+
+
+static void ttf_write_name(void)
+{
+ int i, l;
+ char *p;
+ int new_name_buf_size;
+ char *new_name_buf;
+ name_record *n;
+ dirtab_entry *tab = ttf_name_lookup("name", true);
+ if (is_subsetted(fm_cur)) {
+ l = 0;
+ for (i = 0; i < name_record_num; i++)
+ l += name_tab[i].length + 14; /* maximum lengh of new stogare area */
+ new_name_buf = xtalloc(l, char);
+ /* additional space for subset tags */
+ p = new_name_buf;
+ for (i = 0; i < name_record_num; i++) {
+ n = name_tab + i;
+ n->new_offset = p - new_name_buf;
+ if ((n->name_id == 1 || n->name_id == 3 ||
+ n->name_id == 4 || n->name_id == 6) &&
+ ((n->platform_id == 1 && n->encoding_id == 0) ||
+ (n->platform_id == 3 && n->encoding_id == 0) ||
+ (n->platform_id == 3 && n->encoding_id == 1)))
+ {
+ l = prepend_subset_tags(i, p);
+ p += l;
+ }
+ else
+ l = 0;
+ memcpy(p, name_buf + n->offset, n->length);
+ p += n->length;
+ n->new_length = n->length + l;
+ }
+ new_name_buf_size = p - new_name_buf;
+ }
+ else {
+ new_name_buf = name_buf;
+ new_name_buf_size = name_buf_size;
+ }
+ ttf_reset_chksm(tab);
+ put_ushort(0); /* Format selector */
+ put_ushort(name_record_num);
+ put_ushort(3*TTF_USHORT_SIZE + name_record_num*6*TTF_USHORT_SIZE);
+ for (i = 0; i < name_record_num; i++) {
+ put_ushort(name_tab[i].platform_id);
+ put_ushort(name_tab[i].encoding_id);
+ put_ushort(name_tab[i].language_id);
+ put_ushort(name_tab[i].name_id);
+ put_ushort(name_tab[i].new_length);
+ put_ushort(name_tab[i].new_offset);
+ }
+ for (p = new_name_buf; p - new_name_buf < new_name_buf_size; p++)
+ put_char(*p);
+ ttf_set_chksm(tab);
+ if (new_name_buf != name_buf)
+ xfree(new_name_buf);
+}
+
+static void ttf_write_dirtab(void)
+{
+ dirtab_entry *tab;
+ TTF_ULONG i, k;
+ char *p;
+ integer save_offset = ttf_offset();
+ ttf_seek_outbuf(TABDIR_OFF);
+ if (is_subsetted(fm_cur)) {
+ for (i = 0; i < DEFAULT_NTABS; i++) {
+ tab = ttf_name_lookup(newtabnames[i], false);
+ if (tab == NULL)
+ continue;
+ for (k = 0; k < 4; k++)
+ put_char(tab->tag[k]);
+ put_ulong(tab->checksum);
+ put_ulong(tab->offset);
+ put_ulong(tab->length);
+ }
+ }
+ else {
+ for (tab = dir_tab; tab - dir_tab < ntabs; tab++) {
+ for (k = 0; k < 4; k++)
+ put_char(tab->tag[k]);
+ put_ulong(tab->checksum);
+ put_ulong(tab->offset);
+ put_ulong(tab->length);
+ }
+ }
+ /* adjust checkSumAdjustment */
+ tmp_ulong = 0;
+ checksum = 0;
+ for (p = fb_array, i = 0; i < save_offset;) {
+ tmp_ulong = (tmp_ulong << 8) + *p++;
+ i++;
+ if (i % 4 == 0) {
+ checksum += tmp_ulong;
+ tmp_ulong = 0;
+ }
+ }
+ if (i % 4 != 0) {
+ pdftex_warn("font length is not a multiple of 4 (%li)", i);
+ checksum <<= 8*(4 - i % 4);
+ }
+ k = 0xB1B0AFBA - checksum;
+ ttf_seek_outbuf(checkSumAdjustment_offset);
+ put_ulong(k);
+ ttf_seek_outbuf(save_offset);
+}
+
+static void ttf_write_glyf(void)
+{
+ short *id, k;
+ TTF_USHORT idx;
+ TTF_USHORT flags;
+ dirtab_entry *tab = ttf_name_lookup("glyf", true);
+ long glyf_offset = tab->offset;
+ long new_glyf_offset = ttf_offset();
+ ttf_reset_chksm(tab);
+ for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
+ glyph_tab[*id].newoffset = ttf_offset() - new_glyf_offset;
+ if (glyph_tab[*id].offset != glyph_tab[*id + 1].offset) {
+ ttf_seek_off(glyf_offset + glyph_tab[*id].offset);
+ k = copy_short();
+ ttf_ncopy(4*TTF_FWORD_SIZE);
+ if (k < 0) {
+ do {
+ flags = copy_ushort();
+ idx = get_ushort();
+ if (glyph_tab[idx].newindex < 0) {
+ glyph_tab[idx].newindex = new_glyphs_count;
+ glyph_index[new_glyphs_count++] = idx;
+ /*
+ N.B.: Here we change `new_glyphs_count',
+ which appears in the condition of the `for' loop
+ */
+ }
+ put_ushort(glyph_tab[idx].newindex);
+ if (flags & ARG_1_AND_2_ARE_WORDS)
+ ttf_ncopy(2*TTF_SHORT_SIZE);
+ else
+ ttf_ncopy(TTF_USHORT_SIZE);
+ if (flags & WE_HAVE_A_SCALE)
+ ttf_ncopy(TTF_F2DOT14_SIZE);
+ else if (flags & WE_HAVE_AN_X_AND_Y_SCALE)
+ ttf_ncopy(2*TTF_F2DOT14_SIZE);
+ else if (flags & WE_HAVE_A_TWO_BY_TWO)
+ ttf_ncopy(4*TTF_F2DOT14_SIZE);
+ } while (flags & MORE_COMPONENTS);
+ if (flags & WE_HAVE_INSTRUCTIONS)
+ ttf_ncopy(copy_ushort());
+ }
+ else
+ ttf_ncopy(glyph_tab[*id + 1].offset - glyph_tab[*id].offset -
+ TTF_USHORT_SIZE - 4*TTF_FWORD_SIZE);
+ }
+ }
+ last_glyf_offset = ttf_offset() - new_glyf_offset;
+ ttf_set_chksm(tab);
+}
+
+static void ttf_reindex_glyphs(void)
+{
+ ttfenc_entry *e;
+ glyph_entry *glyph;
+ unsigned int index;
+ /*
+ * reindexing glyphs: we append index of used glyphs to `glyph_index'
+ * while going through `ttfenc_tab'. After appending a new entry to
+ * `glyph_index' we set field `newindex' of corresponding entries in both
+ * `glyph_tab' and `ttfenc_tab' to the newly created index
+ *
+ */
+ for (e = ttfenc_tab; e - ttfenc_tab <= MAX_CHAR_CODE; e++) {
+ e->newindex = 0; /* index of ".notdef" glyph */
+ if (e->name == notdef)
+ continue;
+ /* scan form `index123' */
+ if (sscanf(e->name, GLYPH_PREFIX_INDEX "%i", &index) == 1) {
+ if (index >= glyphs_count) {
+ pdftex_warn("`%s' out of valid range [0..%i)",
+ e->name, glyphs_count);
+ continue;
+ }
+ glyph = glyph_tab + index;
+ goto append_new_glyph;
+ }
+ /* scan form `uniABCD' */
+ if (sscanf(e->name, GLYPH_PREFIX_UNICODE "%X", &index) == 1) {
+ assert(index <= 0xFFFF);
+ if (unicode_map[index] != NOGLYPH_ASSIGNED_YET) {
+ if (unicode_map[index] >= glyphs_count) {
+ pdftex_warn("`%s' is mapped to index %i which is out of valid range [0..%i)",
+ e->name, unicode_map[index], glyphs_count);
+ continue;
+ }
+ glyph = glyph_tab + unicode_map[index];
+ goto append_new_glyph;
+ }
+ else {
+ pdftex_warn("`unicode %s%.4X' is not mapped to any glyph",
+ GLYPH_PREFIX_UNICODE, index);
+ continue;
+ }
+ }
+ /* look up by name */
+ for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count; glyph++)
+ if (glyph->name != notdef && strcmp(glyph->name, e->name) == 0)
+ break;
+ if (!(glyph - glyph_tab < glyphs_count)) {
+ pdftex_warn("glyph `%s' not found", e->name);
+ continue;
+ }
+append_new_glyph:
+ assert(glyph - glyph_tab < glyphs_count);
+ if (glyph->newindex < 0) {
+ glyph_index[new_glyphs_count] = glyph - glyph_tab;
+ glyph->newindex = new_glyphs_count;
+ new_glyphs_count++;
+ }
+ e->newindex = glyph->newindex;
+ }
+}
+
+static void ttf_write_head()
+{
+ dirtab_entry *tab;
+ tab = ttf_seek_tab("head", 0);
+ ttf_reset_chksm(tab);
+ ttf_ncopy(2*TTF_FIXED_SIZE);
+ checkSumAdjustment_offset = ttf_offset();
+ put_ulong(0);
+ ttf_skip(TTF_ULONG_SIZE); /* skip checkSumAdjustment */
+ ttf_ncopy(TTF_ULONG_SIZE + 2*TTF_USHORT_SIZE + 16 +
+ 4*TTF_FWORD_SIZE + 2*TTF_USHORT_SIZE + TTF_SHORT_SIZE);
+ if (is_subsetted(fm_cur)) {
+ put_short(loca_format);
+ put_short(0);
+ }
+ else
+ ttf_ncopy(2*TTF_SHORT_SIZE);
+ ttf_set_chksm(tab);
+}
+
+static void ttf_write_hhea(void)
+{
+ dirtab_entry *tab;
+ tab = ttf_seek_tab("hhea", 0);
+ ttf_reset_chksm(tab);
+ ttf_ncopy(TTF_FIXED_SIZE + 3*TTF_FWORD_SIZE + TTF_UFWORD_SIZE + 3*TTF_FWORD_SIZE + 8*TTF_SHORT_SIZE);
+ put_ushort(new_glyphs_count);
+ ttf_set_chksm(tab);
+}
+
+static void ttf_write_htmx(void)
+{
+ short *id;
+ dirtab_entry *tab = ttf_seek_tab("hmtx", 0);
+ ttf_reset_chksm(tab);
+ for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
+ put_ufword(glyph_tab[*id].advWidth);
+ put_ufword(glyph_tab[*id].lsb);
+ }
+ ttf_set_chksm(tab);
+}
+
+static void ttf_write_loca(void)
+{
+ short *id;
+ dirtab_entry *tab = ttf_seek_tab("loca", 0);
+ ttf_reset_chksm(tab);
+ loca_format = 0;
+ if (last_glyf_offset >= 0x00020000 || (last_glyf_offset & 1))
+ loca_format = 1;
+ else
+ for (id = glyph_index; id - glyph_index < new_glyphs_count; id++)
+ if (glyph_tab[*id].newoffset & 1) {
+ loca_format = 1;
+ break;
+ }
+ if (loca_format != 0) {
+ for (id = glyph_index; id - glyph_index < new_glyphs_count; id++)
+ put_ulong(glyph_tab[*id].newoffset);
+ put_ulong(last_glyf_offset);
+ }
+ else {
+ for (id = glyph_index; id - glyph_index < new_glyphs_count; id++)
+ put_ushort(glyph_tab[*id].newoffset/2);
+ put_ushort(last_glyf_offset/2);
+ }
+ ttf_set_chksm(tab);
+}
+
+static void ttf_write_mapx(void)
+{
+ dirtab_entry *tab = ttf_seek_tab("maxp", TTF_FIXED_SIZE + TTF_USHORT_SIZE);
+ ttf_reset_chksm(tab);
+ put_fixed(0x00010000);
+ put_ushort(new_glyphs_count);
+ ttf_ncopy(13*TTF_USHORT_SIZE);
+ ttf_set_chksm(tab);
+}
+
+static void ttf_write_OS2(void)
+{
+ dirtab_entry *tab = ttf_seek_tab("OS/2", 0);
+ TTF_USHORT version;
+ ttf_reset_chksm(tab);
+ version = get_ushort();
+ if (version != 0x0000 && version != 0x0001 && version != 0x0002)
+ pdftex_fail("unknown verssion of OS/2 table (%.4X)", version);
+ put_ushort(0x0001); /* fix version to 1*/
+ ttf_ncopy(2*TTF_USHORT_SIZE + 13*TTF_SHORT_SIZE + 10*TTF_BYTE_SIZE);
+ ttf_skip(4*TTF_ULONG_SIZE); /* ulUnicodeRange 1--4 */
+ put_ulong(0x00000003); /* Basic Latin + Latin-1 Supplement (0x0000--0x00FF) */
+ put_ulong(0x10000000); /* Private Use (0xE000--0xF8FF) */
+ put_ulong(0x00000000);
+ put_ulong(0x00000000);
+ ttf_ncopy(4*TTF_CHAR_SIZE + TTF_USHORT_SIZE); /* achVendID + fsSelection */
+ ttf_skip(2*TTF_USHORT_SIZE);
+ put_ushort(0x0000); /* usFirstCharIndex */
+ put_ushort(0xF0FF); /* usLastCharIndex */
+ ttf_ncopy(5*TTF_USHORT_SIZE);
+ /* for version 0 the OS/2 table ends here, the rest is for version 1 */
+ put_ulong(0x80000000); /* Symbol Character Set---don't use any code page */
+ put_ulong(0x00000000);
+ ttf_set_chksm(tab);
+}
+
+static boolean unsafe_name(char *s)
+{
+ const char **p;
+ for (p = ambiguous_names; *p != NULL; p++)
+ if (strcmp(s, *p) == 0)
+ return true;
+ return false;
+}
+
+static void ttf_write_post(void)
+{
+ dirtab_entry *tab = ttf_seek_tab("post", TTF_FIXED_SIZE);
+ glyph_entry *glyph;
+ char *s;
+ short *id;
+ int l;
+ ttf_reset_chksm(tab);
+ if (!write_ttf_glyph_names || post_format == 0x00030000) {
+ put_fixed(0x00030000);
+ ttf_ncopy(TTF_FIXED_SIZE + 2*TTF_FWORD_SIZE + 5*TTF_ULONG_SIZE);
+ }
+ else {
+ put_fixed(0x00020000);
+ ttf_ncopy(TTF_FIXED_SIZE + 2*TTF_FWORD_SIZE + 5*TTF_ULONG_SIZE);
+ put_ushort(new_glyphs_count);
+ k = 0;
+ for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
+ glyph = glyph_tab + *id;
+ if (glyph->name_index >= NMACGLYPHS || unsafe_name(glyph->name))
+ glyph->name_index = NMACGLYPHS + k++;
+ put_ushort(glyph->name_index);
+ }
+ for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
+ glyph = glyph_tab + *id;
+ if (glyph->name_index >= NMACGLYPHS) {
+ s = glyph->name;
+ l = strlen(s);
+ put_byte(l);
+ while (l-- > 0)
+ put_char(*s++);
+ }
+ }
+ }
+ ttf_set_chksm(tab);
+}
+
+static void ttf_init_font(int n)
+{
+ int i, k;
+ for (i = 1, k = 0; i <= n; i <<= 1, k++);
+ put_fixed(0x00010000); /* font version */
+ put_ushort(n); /* number of tables */
+ put_ushort(i << 3); /* search range */
+ put_ushort(k - 1); /* entry selector */
+ put_ushort((n<<4) - (i<<3)); /* range shift */
+ ttf_seek_outbuf(TABDIR_OFF + n*4*TTF_ULONG_SIZE);
+}
+
+static void ttf_subset_font(void)
+{
+ ttf_init_font(new_ntabs);
+ if (ttf_name_lookup("PCLT", false) != NULL)
+ ttf_copytab("PCLT");
+ if (ttf_name_lookup("fpgm", false) != NULL)
+ ttf_copytab("fpgm");
+ if (ttf_name_lookup("cvt ", false) != NULL)
+ ttf_copytab("cvt ");
+ if (ttf_name_lookup("prep", false) != NULL)
+ ttf_copytab("prep");
+ ttf_reindex_glyphs();
+ ttf_write_glyf();
+ ttf_write_loca();
+ ttf_write_OS2();
+ ttf_write_head();
+ ttf_write_hhea();
+ ttf_write_htmx();
+ ttf_write_mapx();
+ ttf_write_name();
+ ttf_write_post();
+ ttf_write_cmap();
+ ttf_write_dirtab();
+}
+
+static void ttf_copy_font(void)
+{
+ dirtab_entry *tab;
+ ttf_init_font(ntabs);
+ for (tab = dir_tab; tab - dir_tab < ntabs; tab++) {
+ if (strncmp(tab->tag, "head", 4) == 0)
+ ttf_write_head();
+ else
+ ttf_copytab(tab->tag);
+ }
+ ttf_write_dirtab();
+}
+
+void writettf()
+{
+ set_cur_file_name(fm_cur->ff_name);
+ if (is_subsetted(fm_cur) && !(is_reencoded(fm_cur))) {
+ pdftex_warn("encoding vector required for TrueType font subsetting");
+ cur_file_name = NULL;
+ return;
+ }
+ if (!ttf_open()) {
+ pdftex_fail("cannot open TrueType font file for reading");
+ }
+ cur_file_name = (char*)nameoffile + 1;
+ if (!is_included(fm_cur))
+ tex_printf("{%s", cur_file_name);
+ else if (is_subsetted(fm_cur))
+ tex_printf("<%s", cur_file_name);
+ else
+ tex_printf("<<%s", cur_file_name);
+ fontfile_found = true;
+ new_glyphs_count = 2;
+ new_ntabs = DEFAULT_NTABS;
+ dir_tab = NULL;
+ glyph_tab = NULL;
+ glyph_index = NULL;
+ glyph_name_buf = NULL;
+ name_tab = NULL;
+ name_buf = NULL;
+ ttf_read_font();
+ if (is_included(fm_cur)) {
+ pdfsaveoffset = pdfoffset();
+ pdfflush();
+ if (is_subsetted(fm_cur)) {
+ ttf_copy_encoding();
+ make_subset_tag(fm_cur, fm_cur->encoding->glyph_names);
+ ttf_subset_font();
+ }
+ else
+ ttf_copy_font();
+ ttf_length = ttf_offset();
+ }
+ xfree(dir_tab);
+ xfree(glyph_tab);
+ xfree(glyph_index);
+ xfree(glyph_name_buf);
+ xfree(name_tab);
+ xfree(name_buf);
+ ttf_close();
+ if (!is_included(fm_cur))
+ tex_printf("}");
+ else if (is_subsetted(fm_cur))
+ tex_printf(">");
+ else
+ tex_printf(">>");
+ cur_file_name = NULL;
+}
+
+void writeotf()
+{
+ dirtab_entry *tab;
+ long i;
+ set_cur_file_name(fm_cur->ff_name);
+ if (!open_input(&ttf_file, kpse_type1_format, FOPEN_RBIN_MODE)) {
+ pdftex_fail("cannot open OpenType font file for reading");
+ }
+ cur_file_name = (char*)nameoffile + 1;
+ tex_printf("<<%s", cur_file_name);
+ fontfile_found = true;
+ dir_tab = NULL;
+ glyph_tab = NULL;
+ ttf_read_tabdir();
+ /* read font parameters */
+ if (ttf_name_lookup("head", false) != NULL)
+ ttf_read_head();
+ if (ttf_name_lookup("hhea", false) != NULL)
+ ttf_read_hhea();
+ if (ttf_name_lookup("PCLT", false) != NULL)
+ ttf_read_pclt();
+ if (ttf_name_lookup("post", false) != NULL)
+ ttf_read_post();
+ /* copy font file */
+ tab = ttf_seek_tab("CFF ", 0);
+ for (i = tab->length; i > 0; i--)
+ copy_char();
+ xfree(dir_tab);
+ ttf_close();
+ tex_printf(">>");
+ cur_file_name = NULL;
+}
+
+/*
+ To calculate the checkSum for the 'head' table which itself includes the
+ checkSumAdjustment entry for the entire font, do the following:
+
+ * Set the checkSumAdjustment to 0.
+ * Calculate the checksum for all the tables including the 'head' table
+ and enter that value into the table directory.
+ * Calculate the checksum for the entire font.
+ * Subtract that value from the hex value B1B0AFBA.
+ * Store the result in checkSumAdjustment.
+
+ The checkSum for the 'head table which includes the checkSumAdjustment
+ entry for the entire font is now incorrect. That is not a problem. Do not
+ change it. An application attempting to verify that the 'head' table has
+ not changed should calculate the checkSum for that table by not including
+ the checkSumAdjustment value, and compare the result with the entry in the
+ table directory.
+
+ The table directory also includes the offset of the associated tagged
+ table from the beginning of the font file and the length of that table.
+
+
+ */
diff --git a/Build/source/texk/web2c/pdftexdir/writettf.h b/Build/source/texk/web2c/pdftexdir/writettf.h
new file mode 100644
index 00000000000..eca53cdfe30
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writettf.h
@@ -0,0 +1,130 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writettf.h#1 $
+*/
+
+typedef signed char TTF_CHAR;
+typedef unsigned char TTF_BYTE;
+typedef signed short TTF_SHORT;
+typedef unsigned short TTF_USHORT;
+typedef signed long TTF_LONG;
+typedef unsigned long TTF_ULONG;
+typedef unsigned long TTF_FIXED;
+typedef unsigned short TTF_FUNIT;
+typedef signed short TTF_FWORD;
+typedef unsigned short TTF_UFWORD;
+typedef unsigned short TTF_F2DOT14;
+
+#define TTF_CHAR_SIZE 1
+#define TTF_BYTE_SIZE 1
+#define TTF_SHORT_SIZE 2
+#define TTF_USHORT_SIZE 2
+#define TTF_LONG_SIZE 4
+#define TTF_ULONG_SIZE 4
+#define TTF_FIXED_SIZE 4
+#define TTF_FWORD_SIZE 2
+#define TTF_UFWORD_SIZE 2
+#define TTF_F2DOT14_SIZE 2
+
+#define ARG_1_AND_2_ARE_WORDS (1<<0)
+#define ARGS_ARE_XY_VALUES (1<<1)
+#define ROUND_XY_TO_GRID (1<<2)
+#define WE_HAVE_A_SCALE (1<<3)
+#define RESERVED (1<<4)
+#define MORE_COMPONENTS (1<<5)
+#define WE_HAVE_AN_X_AND_Y_SCALE (1<<6)
+#define WE_HAVE_A_TWO_BY_TWO (1<<7)
+#define WE_HAVE_INSTRUCTIONS (1<<8)
+#define USE_MY_METRICS (1<<9)
+
+#define get_type(t) ((t)ttf_getnum(t##_SIZE))
+#define ttf_skip(n) ttf_getnum(n)
+
+#define get_byte() get_type(TTF_BYTE)
+#define get_char() get_type(TTF_CHAR)
+#define get_ushort() get_type(TTF_USHORT)
+#define get_short() get_type(TTF_SHORT)
+#define get_ulong() get_type(TTF_ULONG)
+#define get_long() get_type(TTF_LONG)
+#define get_fixed() get_type(TTF_FIXED)
+#define get_funit() get_type(TTF_FUNIT)
+#define get_fword() get_type(TTF_FWORD)
+#define get_ufword() get_type(TTF_UFWORD)
+#define get_f2dot14() get_type(TTF_F2DOT14)
+
+#define put_num(t,n) ((t)ttf_putnum(t##_SIZE, n))
+
+#define put_char(n) put_num(TTF_CHAR, n)
+#define put_byte(n) put_num(TTF_BYTE, n)
+#define put_short(n) put_num(TTF_SHORT, n)
+#define put_ushort(n) put_num(TTF_USHORT, n)
+#define put_long(n) put_num(TTF_LONG, n)
+#define put_ulong(n) put_num(TTF_ULONG, n)
+#define put_fixed(n) put_num(TTF_FIXED, n)
+#define put_funit(n) put_num(TTF_FUNIT, n)
+#define put_fword(n) put_num(TTF_FWORD, n)
+#define put_ufword(n) put_num(TTF_UFWORD, n)
+#define put_f2dot14(n) put_num(TTF_F2DOT14, n)
+
+#define copy_byte() put_byte(get_byte())
+#define copy_char() put_char(get_char())
+#define copy_ushort() put_ushort(get_ushort())
+#define copy_short() put_short(get_short())
+#define copy_ulong() put_ulong(get_ulong())
+#define copy_long() put_long(get_long())
+#define copy_fixed() put_fixed(get_fixed())
+#define copy_funit() put_funit(get_funit())
+#define copy_fword() put_fword(get_fword())
+#define copy_ufword() put_ufword(get_ufword())
+#define copy_f2dot14() put_f2dot14(get_f2dot14())
+
+#define is_unicode_mapping(e) \
+ (e->platform_id == 0 || (e->platform_id == 3 || e->encoding_id == 1))
+
+
+#define NMACGLYPHS 258
+#define TABDIR_OFF 12
+#define ENC_BUF_SIZE 1024
+
+#define GLYPH_PREFIX_INDEX "index"
+#define GLYPH_PREFIX_UNICODE "uni"
+
+#define NOGLYPH_ASSIGNED_YET 0xFFFF /* indicating that no glyph is assigned to
+ an unicode */
+typedef struct {
+ char tag[4];
+ TTF_ULONG checksum;
+ TTF_ULONG offset;
+ TTF_ULONG length;
+} dirtab_entry;
+
+typedef struct {
+ TTF_USHORT platform_id;
+ TTF_USHORT encoding_id;
+ TTF_ULONG offset;
+ TTF_USHORT format;
+} cmap_entry;
+
+typedef struct {
+ TTF_USHORT endCode;
+ TTF_USHORT startCode;
+ TTF_USHORT idDelta;
+ TTF_USHORT idRangeOffset;
+} seg_entry;
diff --git a/Build/source/texk/web2c/pdftexdir/writezip.c b/Build/source/texk/web2c/pdftexdir/writezip.c
new file mode 100644
index 00000000000..3669397617c
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/writezip.c
@@ -0,0 +1,82 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+pdfTeX is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writezip.c#7 $
+*/
+
+#include "ptexlib.h"
+#include "zlib.h"
+
+static const char perforce_id[] =
+ "$Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/writezip.c#7 $";
+
+#define ZIP_BUF_SIZE 32768
+
+#define check_err(f, fn) \
+ if (f != Z_OK) \
+ pdftex_fail("zlib: %s() failed", fn)
+
+
+static char zipbuf[ZIP_BUF_SIZE];
+static z_stream c_stream; /* compression stream */
+
+void writezip(boolean finish)
+{
+ int err;
+
+ if (!getpdfcompresslevel()) {
+ if (pdfptr) {
+ pdfgone += xfwrite(pdfbuf, 1, pdfptr, pdffile);
+ pdfstreamlength += pdfptr;
+ }
+ return;
+ }
+
+ cur_file_name = NULL;
+ if (pdfstreamlength == 0) {
+ c_stream.zalloc = (alloc_func)0;
+ c_stream.zfree = (free_func)0;
+ c_stream.opaque = (voidpf)0;
+ check_err(deflateInit(&c_stream, getpdfcompresslevel()), "deflateInit");
+ c_stream.next_out = (Bytef*)zipbuf;
+ c_stream.avail_out = ZIP_BUF_SIZE;
+ }
+ c_stream.next_in = pdfbuf;
+ c_stream.avail_in = pdfptr;
+ for(;;) {
+ if (c_stream.avail_out == 0) {
+ pdfgone += xfwrite(zipbuf, 1, ZIP_BUF_SIZE, pdffile);
+ c_stream.next_out = (Bytef*)zipbuf;
+ c_stream.avail_out = ZIP_BUF_SIZE;
+ }
+ err = deflate(&c_stream, finish ? Z_FINISH : Z_NO_FLUSH);
+ if (finish && err == Z_STREAM_END)
+ break;
+ check_err(err, "deflate");
+ if (!finish && c_stream.avail_in == 0)
+ break;
+ }
+ if (finish) {
+ if (c_stream.avail_out < ZIP_BUF_SIZE) /* at least one byte has been output */
+ pdfgone += xfwrite(zipbuf, 1, ZIP_BUF_SIZE - c_stream.avail_out, pdffile);
+ check_err(deflateEnd(&c_stream), "deflateEnd");
+ xfflush(pdffile);
+ }
+ pdfstreamlength = c_stream.total_out;
+}
diff --git a/Build/source/texk/web2c/pktogf.ch b/Build/source/texk/web2c/pktogf.ch
new file mode 100644
index 00000000000..7a0d5d4aa61
--- /dev/null
+++ b/Build/source/texk/web2c/pktogf.ch
@@ -0,0 +1,494 @@
+% pktogf.ch for C compilation with web2c.
+%
+% 09/19/88 Pierre A. MacKay version 1.0.
+% 12/02/89 Karl Berry cosmetic changes.
+% 02/04/90 Karl new file-searching routines.
+% (more recent changes in the ChangeLog)
+%
+% One major change in output format is incorporated by this change
+% file. The local pktogf preamble comment is ignored and the
+% dated METAFONT comment is passed through unaltered. This
+% provides a continuous check on the origin of fonts in both
+% gf and pk formats. PKtoGF runs silently unless it is given the
+% -v switch in the command line.
+
+@x [0] WEAVE: print changes only
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{PK$\,$\lowercase{to}$\,$GF changes for C}
+@z
+
+@x [3] No global labels.
+@ Both the input and output come from binary files. On line interaction
+is handled through \PASCAL's standard |input| and |output| files.
+
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+
+@p program PKtoGF(input, output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+@y
+@ Both the input and output come from binary files. On line
+interaction is handled through \PASCAL's standard |input| and |output|
+files. For C compilation terminal input and output is directed to
+|stdin| and |stdout|. In this program there is no terminal input.
+Since the terminal output is really not very interesting, it is
+produced only when the \.{-v} command line flag is presented.
+
+@d print_ln(#)==if verbose then write_ln(output, #)
+@d print(#)==if verbose then write(output, #)
+
+@p program PKtoGF(input, output);
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+begin
+ kpse_set_progname (argv[0]);
+ kpse_init_prog ('PKTOGF', 0, nil, nil);
+ parse_arguments;
+ print_ln(banner);@/
+@z
+
+@x [5] Eliminate the |final_end| label
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+@y
+@ This module is deleted, because it is only useful for
+a non-local goto, which we don't use in C.
+@z
+
+% [6] Remove terminal_line_length, since there is no dialog, and
+% name_length, since there is no maximum size.
+@x
+@<Constants...@>=
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+@y
+@<Constants...@>=
+@z
+
+@x [7] Just exit, instead of doing a nonlocal goto.
+@d abort(#)==begin print_ln(' ',#); jump_out; end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+@y
+@d abort(#)==begin verbose:=true; print_ln(#); uexit(1);
+ end
+@z
+
+@x [30] Remove an unused variable (de-linting)
+function pk_packed_num : integer ;
+var i, j, k : integer ;
+@y
+function pk_packed_num : integer ;
+var i, j : integer ;
+@z
+
+@x [35] Use path searching to open |pk_file|.
+@p procedure open_gf_file; {prepares to write packed bytes in a |gf_file|}
+begin rewrite(gf_file,gf_name);
+gf_loc := 0 ;
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+@y
+In C, we do path searching based on the user's environment or the
+default path, via the Kpathsea library.
+
+@p procedure open_pk_file; {prepares to read packed bytes in |pk_file|}
+begin
+ {Don't use |kpse_find_pk|; we want the exact file or nothing.}
+ pk_name := cmdline (optind);
+ pk_file := kpse_open_file (cmdline (optind), kpse_pk_format);
+ if pk_file then begin
+ cur_loc := 0;
+ end;
+end;
+@#
+procedure open_gf_file; {prepares to write packed bytes in |gf_file|}
+begin
+ {If an explicit output filename isn't given, we construct it from |pk_name|.}
+ if optind + 1 = argc then begin
+ gf_name := basename_change_suffix (pk_name, 'pk', 'gf');
+ end else begin
+ gf_name := cmdline (optind + 1);
+ end;
+ rewritebin (gf_file, gf_name);
+ gf_loc := 0;
+end;
+@z
+
+@x [36] No arbitrary limit on filename length.
+@ We need a place to store the names of the input and output files, as well
+as a byte counter for the output file.
+
+@<Glob...@>=
+@!gf_name,@!pk_name:packed array[1..name_length] of char; {names of input
+ and output files}
+@y
+@ No arbitrary limit on filename length.
+
+@<Glob...@>=
+@!gf_name,@!pk_name:c_string; {names of input and output files}
+@z
+
+@x [42] Define gf_byte (in place of Pascal procedure).
+@ We need a procedure that will write a byte to the \.{GF} file. If the
+particular system
+@^system dependencies@>
+requires buffering, here is the place to do it.
+
+@p procedure gf_byte (i : integer) ;
+begin gf_file^ := i ;
+put(gf_file) ;
+incr(gf_loc) ;
+end;
+@y
+@ Byte output is handled by a C definition.
+
+@d gf_byte(#)==begin put_byte(#, gf_file); incr(gf_loc) end
+@z
+
+@x [43] Use the |get_byte| routines from dvitype (renamed).
+@ We also need a function that will get a single byte from the \.{PK} file.
+Again, buffering may be done in this procedure.
+
+@p function pk_byte : eight_bits ;
+var nybble, temp : eight_bits ;
+begin
+ temp := pk_file^ ;
+ get(pk_file) ;
+ pk_loc := pk_loc + 1 ;
+ pk_byte := temp ;
+end ;
+@y
+@ We shall use a set of simple functions to read the next byte or
+bytes from |pk_file|. There are seven possibilities, each of which is
+treated as a separate function in order to minimize the overhead for
+subroutine calls.
+@^system dependencies@>
+
+@d pk_byte==get_byte
+@d pk_loc==cur_loc
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(pk_file) then get_byte:=0
+else begin read(pk_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(pk_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(pk_file,a); read(pk_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(pk_file,a); read(pk_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@{
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(pk_file,a); read(pk_file,b); read(pk_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(pk_file,a); read(pk_file,b); read(pk_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@}
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(pk_file,a); read(pk_file,b); read(pk_file,c); read(pk_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@z
+
+@x [45] Adapt the DVItype functions.
+@ As we are reading the packed file, we often need to fetch 16 and 32 bit
+quantities. Here we have two procedures to do this.
+
+@p function signed_byte : integer ;
+var a : integer ;
+begin
+ a := pk_byte ;
+ if a > 127 then
+ a := a - 256 ;
+ signed_byte := a ;
+end ;
+@#
+function get_16 : integer ;
+var a : integer ;
+begin
+ a := pk_byte ;
+ get_16 := a * 256 + pk_byte ;
+end ;
+@#
+function signed_16 : integer ;
+var a : integer ;
+begin
+ a := signed_byte ;
+ signed_16 := a * 256 + pk_byte ;
+end ;
+@#
+function get_32 : integer ;
+var a : integer ;
+begin
+ a := get_16 ;
+ if a > 32767 then a := a - 65536 ;
+ get_32 := a * 65536 + get_16 ;
+end ;
+@y
+@ We put definitions here to access the \.{DVItype} functions supplied
+above. (|signed_byte| is already taken care of).
+
+@d get_16==get_two_bytes
+@d signed_16==signed_pair
+@d get_32==signed_quad
+@z
+
+@x [46] Remove unused function gf_sbyte.
+@p procedure gf_sbyte(i : integer) ;
+begin
+ if i < 0 then
+ i := i + 256 ;
+ gf_byte(i) ;
+end ;
+@#
+procedure gf_16(i : integer) ;
+@y
+@p procedure gf_16(i : integer) ;
+@z
+
+@x [46] Fix unlikely but possible overflow in addition in gf_quad.
+ i := (i + 1073741824) + 1073741824 ;
+@y
+ {|i<0| at this point, but a compiler is permitted to rearrange the
+ order of the additions, which would cause wrong results
+ in the unlikely event of a non-2's-complement representation.}
+ i := i + 1073741824;
+ i := i + 1073741824;
+@z
+
+@x [49] Preserve the METAFONT comment.
+j := pk_byte ;
+for i := 1 to j do hppp := pk_byte ;
+gf_byte(comm_length) ;
+for i := 1 to comm_length do
+ gf_byte(xord[comment[i]]) ;
+@y
+j := pk_byte ;
+gf_byte(j) ;
+print('{') ;
+for i := 1 to j do begin
+ hppp:=pk_byte;
+ gf_byte(hppp) ;
+ print(xchr[xord[hppp]]);
+ end;
+print_ln('}') ;
+@z
+
+@x [51] Since we preserve the METAFONT comment, this is unneeded.
+comment := preamble_comment ;
+@y
+@z
+
+@x [63] Remove unused variable.
+@!nybble : eight_bits ; {the current nybble}
+@y
+@z
+
+@x [65] Change jumpout to abort.
+ if rcp > max_counts then begin
+ print_ln('A character had too many run counts') ;
+ jump_out ;
+ end ;
+@y
+ if rcp > max_counts then abort('A character had too many run counts');
+@z
+
+@x [71] There is no terminal communication.
+@* Terminal communication.
+We must get the file names and determine whether input is to be in
+hexadecimal or binary. To do this, we use the standard input path
+name. We need a procedure to flush the input buffer. For most systems,
+this will be an empty statement. For other systems, a |print_ln| will
+provide a quick fix. We also need a routine to get a line of input from
+the terminal. On some systems, a simple |read_ln| will do. Finally,
+a macro to print a string to the first blank is required.
+
+@d flush_buffer == begin end
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+@y
+@* Terminal communication.
+Since this program runs entirely on command-line arguments, there
+is no terminal communication.
+@z
+
+@x [72] There is no dialog.
+@ @p procedure dialog ;
+var i : integer ; {index variable}
+buffer : packed array [1..name_length] of char; {input buffer}
+begin
+ for i := 1 to name_length do begin
+ gf_name[i] := ' ' ;
+ pk_name[i] := ' ' ;
+ end;
+ print('Input file name: ') ;
+ flush_buffer ;
+ get_line(pk_name) ;
+ print('Output file name: ') ;
+ flush_buffer ;
+ get_line(gf_name) ;
+end ;
+@y
+@ \.{pktogf.web} has a |dialog| procedure here.
+@z
+
+@x [73] There is no dialog and no |final_end| label.
+dialog ;
+@y
+@z
+@x
+final_end :
+@y
+@z
+
+@x System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtoGF} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 3; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('pktogf');
+
+ end else if argument_is ('help') then begin
+ usage_help (PKTOGF_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'Tomas Rokicki');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one or two remaining arguments.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ write_ln (stderr, 'pktogf: Need one or two file arguments.');
+ usage ('pktogf');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@
+@<Initialize the option...@> =
+verbose := false;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/pktogf.rc b/Build/source/texk/web2c/pktogf.rc
new file mode 100644
index 00000000000..149c3c03d49
--- /dev/null
+++ b/Build/source/texk/web2c/pktogf.rc
@@ -0,0 +1,32 @@
+/* pktogf.rc: pktogf resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " pktogf 1.1"
+
+#define VER_INTERNALNAME_STR "pktogf"
+#define VER_ORIGINALFILENAME_STR "pktogf.exe"
+
+#define VER_FILEDESCRIPTION_STR "PK-to-GF file converter"
+
+#include <texlive.version>
+
+/* pktogf.rc ends here */
diff --git a/Build/source/texk/web2c/pktogf.web b/Build/source/texk/web2c/pktogf.web
new file mode 100644
index 00000000000..8fc8a0256f6
--- /dev/null
+++ b/Build/source/texk/web2c/pktogf.web
@@ -0,0 +1,1727 @@
+% PKtoGF.web
+%
+% PKtoGF creates a generic font file from a packed pixel file.
+%
+% Preliminary 0.0 version: January, 1988
+% Fixed bug to include specials in character (1.0): January 1988
+% Cleaned up description (bitweight errors) no version change: July 1990
+% Fixed bug with empty character setting min_n to 1 (1.1): 19 October 1990
+\def\versiondate{19 October 1990}
+%
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\PASCAL{{\mc Pascal}}
+\def\tamu{Texas A\char38 M}
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+\def\title{PKtoGF}
+\def\contentspagenumber{0}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont PKtoGF} processor}
+ \vskip 15pt
+ \centerline{(Version 1.1, \versiondate)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program takes a packed, or \.{PK} file, and converts it into the
+standard \.{GF} format. The resulting \.{GF} file is standard in
+every way, and is essentially identical to the \.{GF} file from which
+the \.{PK} file was produced in the first place. Note that, however,
+\.{GF} to \.{PK} to \.{GF} is not an exact identity transformation, as
+the new \.{GF} file will have a different preamble string and the actual
+minimum bounding box will be used, instead of a possibly larger bounding
+box in the original \.{GF} file.
+
+@ The |banner| string defined here should be changed whenever \.{PKtoGF}
+gets modified. You should update the preamble comment as well.
+
+@d banner=='This is PKtoGF, Version 1.1'
+ {printed when the program starts}
+@d preamble_comment=='PKtoGF 1.1 output'
+@d comm_length==17
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{PKtoGF} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ Both the input and output come from binary files. On line interaction
+is handled through \PASCAL's standard |input| and |output| files.
+
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+
+@p program PKtoGF(input, output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ These constants determine the maximum length of a file name and the length
+of the terminal line, as well as the maximum number of run counts allowed
+per line of the \.{GF} file. (We need this to implement repeat counts.)
+@^system dependancies@>
+
+@<Constants...@>=
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+@!max_counts=400; {maximum number of run counts in a raster line}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ It is possible that a malformed packed file (heaven forbid!) or some other
+error might be detected by this program. Such errors might occur in a deeply
+nested procedure, so the procedure called |jump_out| has been added to transfer
+to the very end of the program with an error message.
+
+@d abort(#)==begin print_ln(' ',#); jump_out; end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{PKtoGF} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used.
+
+The next few sections of \.{PKtoGF} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{PKtoGF} need not deal with the controversial
+ASCII codes less than @'40.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{GFtoPK}.
+So we shall assume that the \PASCAL\ system being used for \.{GFtoPK}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{GFtoPK} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Generic font file format.
+The most important output produced by a typical run of \MF\ is the
+``generic font'' (\.{GF}) file that specifies the bit patterns of the
+characters that have been drawn. The term {\sl generic\/} indicates that
+this file format doesn't match the conventions of any name-brand manufacturer;
+but it is easy to convert \.{GF} files to the special format required by
+almost all digital phototypesetting equipment. There's a strong analogy
+between the \.{DVI} files written by \TeX\ and the \.{GF} files written
+by \MF; and, in fact, the file formats have a lot in common.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`|boc|' (beginning of character) command has six parameters, each of
+which is four bytes long. Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a |boc| command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an |eoc| command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each |eoc| command is immediately followed by a
+|boc| command, or by a |post| command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+@ The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~|m|; and (b)~the current row number,~|n|. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to get extremely large, but the \.{GF} format tries to be more
+general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising
+the region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
+coordinates |(x,y)| satisfy |m<=x<=m+1| and |n<=y<=n+1|. Negative values of
+|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of |n| and~|y| correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides |m| and |n|, there's also a third aspect of the current
+state, namely the @!|paint_switch|, which is always either \\{black} or
+\\{white}. Each \\{paint} command advances |m| by a specified amount~|d|,
+and blackens the intervening pixels if |paint_switch=black|; then
+the |paint_switch| changes to the opposite state. \.{GF}'s commands are
+designed so that |m| will never decrease within a row, and |n| will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened.
+
+@ Here is a list of all the commands that may appear in a \.{GF} file. Each
+command is specified by its symbolic name (e.g., |boc|), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|d[2]|' means that parameter |d| is two bytes long.
+
+\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
+nothing but change the |paint_switch| from \\{black} to \\{white} or
+vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with |d=1| to~63, defined as follows: If
+|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
+in columns |m| through |m+d-1| inclusive. Then, in any case,
+complement the |paint_switch| and advance |m| by~|d|.
+
+\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
+value of~|d|; \MF\ uses it to paint when |64<=d<256|.
+
+\yskip\hang|@!paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
+as~65535.
+
+\yskip\hang|@!paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
+|max_n[4]|. Beginning of a character: Here |c| is the character code, and
+|p| points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer |p| is |-1| if there was no
+prior character with an equivalent code.) The values of registers |m| and |n|
+defined by the instructions that follow for this character must
+satisfy |min_m<=m<=max_m| and |min_n<=n<=max_n|. (The values of |max_m| and
+|min_n| need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
+initialize the bounds of an array. Then it sets |m:=min_m|, |n:=max_n|, and
+|paint_switch:=white|.
+
+\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
+Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
+and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)
+
+\yskip\hang|eoc| 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have |eoc| immediately following |boc|.
+
+\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=white|. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m:=min_m|, and set
+|paint_switch:=white|. This is a way to produce |d| all-white rows.
+
+\yskip\hang|@!skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
+as 65535.
+
+\yskip\hang|@!skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=black|. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
+|new_row_0|, but with |m:=min_m+1| through |min_m+164|, respectively.
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear anywhere in \.{GF} files generated by other
+processors. It is recommended that |x| be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang|@!xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
+ridiculously large; |k| mustn't be negative.
+
+\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
+it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang|no_op| 244. No operation, do nothing. Any number of |no_op|'s
+may occur between \.{GF} commands, but a |no_op| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
+This command will appear only in the postamble, which will be explained
+shortly.
+
+\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
+Same as |char_loc|, except that |dy| is assumed to be zero, and the value
+of~|dx| is taken to be |65536*dm|, where |0<=dm<256|.
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter |i| is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first |boc|.)
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}
+
+@ Here are the opcodes that \.{GFtoPK} actually refers to.
+
+@d paint_0=0 {beginning of the \\{paint} commands}
+@d paint1=64 {move right a given number of columns, then
+ black${}\leftrightarrow{}$white}
+@d boc=67 {beginning of a character}
+@d boc1=68 {abbreviated |boc|}
+@d eoc=69 {end of a character}
+@d skip0=70 {skip no blank rows}
+@d skip1=71 {skip over blank rows}
+@d new_row_0=74 {move down one row and then right}
+@d max_new_row=238 {move down one row and then right}
+@d no_op=247 {noop}
+@d xxx1=239 {for \&{special} strings}
+@d yyy=243 {for \&{numspecial} numbers}
+@d nop=244 {no operation}
+@d char_loc=245 {character locators in the postamble}
+@d char_loc0=246 {character locators in the postamble}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The last character in a \.{GF} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
+ |@!min_m[4]| |@!max_m[4]| |@!min_n[4]| |@!max_n[4]|\cr
+ $\langle\,$character locators$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the byte following the final |eoc| in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The |ds| and |cs| parameters
+@^design size@> @^check sum@>
+give the design size and check sum, respectively, which are exactly the
+values put into the header of any \.{TFM} file that shares information with
+this \.{GF} file. Parameters |hppp| and |vppp| are the ratios of
+pixels per point, horizontally and vertically, expressed as |scaled| integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
+registers |m| and~|n| assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; |max_m| and |min_n| may, on the
+other hand, be tighter than the similar bounds in |boc| commands. For
+example, some character may have |min_n=-100| in its |boc|, but it might
+turn out that |n| never gets lower than |-50| in any character; then
+|min_n| can have any value |<=-50|. If there are no characters in the file,
+it's possible to have |min_m>max_m| and/or |min_n>max_n|.)
+
+@ Character locators are introduced by |char_loc| commands,
+which specify a character residue~|c|, character escapements (|dx,dy|),
+a character width~|w|, and a pointer~|p|
+to the beginning of that character. (If two or more characters have the
+same code~|c| modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+The character escapements (|dx,dy|) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of |scaled| pixels;
+i.e., |dx| is in horizontal pixel units times $2^{16}$, and |dy| is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, |dy|
+should be zero, but other document file formats allow nonzero vertical
+escapement.
+
+The character width~|w| duplicates the information in the \.{TFM} file; it
+is $2^{24}$ times the ratio of the true width to the font's design size.
+
+The backpointer |p| points to the character's |boc|, or to the first of
+a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
+immediately precede the |boc|, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about |p| applies also to the backpointers
+in |boc| commands, even though it wasn't explained in the description
+of~|boc|. @^backpointers@>
+
+Pointer |p| might be |-1| if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had |proofing<0| when the character was being shipped out,
+but then made |proofing>=0| in order to get a \.{GF} file.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the character locators, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~131, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual
+characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating
+systems. \.{GFtoPK} first reads the postamble, and then scans the file from
+front to back.
+
+@* Packed file format.
+The packed file format is a compact representation of the data contained in a
+\.{GF} file. The information content is the same, but packed (\.{PK}) files
+are almost always less than half the size of their \.{GF} counterparts. They
+are also easier to convert into a raster representation because they do not
+have a profusion of \\{paint}, \\{skip}, and \\{new\_row} commands to be
+separately interpreted. In addition, the \.{PK} format expressedly forbids
+\&{special} commands within a character. The minimum bounding box for each
+character is explicit in the format, and does not need to be scanned for as in
+the \.{GF} format. Finally, the width and escapement values are combined with
+the raster information into character ``packets'', making it simpler in many
+cases to process a character.
+
+A \.{PK} file is organized as a stream of 8-bit bytes. At times, these bytes
+might be split into 4-bit nybbles or single bits, or combined into multiple
+byte parameters. When bytes are split into smaller pieces, the `first' piece
+is always the most significant of the byte. For instance, the first bit of
+a byte is the bit with value 128; the first nybble can be found by dividing
+a byte by 16. Similarly, when bytes are combined into multiple byte
+parameters, the first byte is the most significant of the parameter. If the
+parameter is signed, it is represented by two's-complement notation.
+
+The set of possible eight-bit values are separated into two sets, those that
+introduce a character definition, and those that do not. The values that
+introduce a character definition comprise the range from 0 to 239; byte values
+above 239 are interpreted commands. Bytes which introduce character
+definitions are called flag bytes, and various fields within the byte indicate
+various things about how the character definition is encoded. Command bytes
+have zero or more parameters, and can never appear within a character
+definition or between parameters of another command, where they would be
+interpeted as data.
+
+A \.{PK} file consists of a preamble, followed by a sequence of one or more
+character definitions, followed by a postamble. The preamble command must
+be the first byte in the file, followed immediately by its parameters.
+Any number of character definitions may follow, and any command but the
+preamble command and the postamble command may occur between character
+definitions. The very last command in the file must be the postamble.
+
+@ The packed file format is intended to be easy to read and interpret by
+device drivers. The small size of the file reduces the input/output overhead
+each time a font is defined. For those drivers that load and save each font
+file into memory, the small size also helps reduce the memory requirements.
+The length of each character packet is specified, allowing the character raster
+data to be loaded into memory by simply counting bytes, rather than
+interpreting each command; then, each character can be interpreted on a demand
+basis. This also makes it possible for a driver to skip a particular
+character quickly if it knows that the character is unused.
+
+@ First, the command bytes shall be presented; then the format of the
+character definitions will be defined. Eight of the possible sixteen
+commands (values 240 through 255) are currently defined; the others are
+reserved for future extensions. The commands are listed below. Each command
+is specified by its symbolic name (e.g., \\{pk\_no\_op}), its opcode byte,
+and any parameters. The parameters are followed by a bracketed number
+telling how many bytes they occupy, with the number preceded by a plus sign if
+it is a signed quantity. (Four byte quantities are always signed, however.)
+
+\yskip\hang|pk_xxx1| 240 |k[1]| |x[k]|. This command is undefined in general;
+it functions as a $(k+2)$-byte \\{no\_op} unless special \.{PK}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string. It is recommended that |x| be a string having the form
+of a keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang\\{pk\_xxx2} 241 |k[2]| |x[k]|. Like |pk_xxx1|, but |0<=k<65536|.
+
+\yskip\hang\\{pk\_xxx3} 242 |k[3]| |x[k]|. Like |pk_xxx1|, but
+|0<=k<@t$2^{24}$@>|. \MF\ uses this when sending a \&{special} string whose
+length exceeds~255.
+
+\yskip\hang\\{pk\_xxx4} 243 |k[4]| |x[k]|. Like |pk_xxx1|, but |k| can be
+ridiculously large; |k| musn't be negative.
+
+\yskip\hang|pk_yyy| 244 |y[4]|. This command is undefined in general; it
+functions as a five-byte \\{no\_op} unless special \.{PK} reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a result of
+\&{numspecial} commands; the intent is to provide numeric parameters to
+\\{xxx} commands that immediately precede.
+
+\yskip\hang|pk_post| 245. Beginning of the postamble. This command is
+followed by enough |pk_no_op| commands to make the file a multiple
+of four bytes long. Zero through three bytes are usual, but any number
+is allowed.
+This should make the file easy to read on machines which pack four bytes to
+a word.
+
+\yskip\hang|pk_no_op| 246. No operation, do nothing. Any number of
+|pk_no_op|'s may appear between \.{PK} commands, but a |pk_no_op| cannot be
+inserted between a command and its parameters, between two parameters, or
+inside a character definition.
+
+\yskip\hang|pk_pre| 247 |i[1]| |k[1]| |x[k]| |ds[4]| |cs[4]| |hppp[4]|
+|vppp[4]|. Preamble command. Here, |i| is the identification byte of the
+file, currently equal to 89. The string |x| is merely a comment, usually
+indicating the source of the \.{PK} file. The parameters |ds| and |cs| are
+the design size of the file in $1/2^{20}$ points, and the checksum of the
+file, respectively. The checksum should match the \.{TFM} file and the
+\.{GF} files for this font. Parameters |hppp| and |vppp| are the ratios
+of pixels per point, horizontally and vertically, multiplied by $2^{16}$; they
+can be used to correlate the font with specific device resolutions,
+magnifications, and ``at sizes''. Usually, the name of the \.{PK} file is
+formed by concatenating the font name (e.g., cmr10) with the resolution at
+which the font is prepared in pixels per inch multiplied by the magnification
+factor, and the letters \.{PK}. For instance, cmr10 at 300 dots per inch
+should be named CMR10.300PK; at one thousand dots per inch and magstephalf,
+it should be named CMR10.1095PK.
+
+@ We put a few of the above opcodes into definitions for symbolic use by
+this program.
+
+@d pk_id = 89 {the version of \.{PK} file described}
+@d pk_xxx1 = 240 {\&{special} commands}
+@d pk_yyy = 244 {\&{numspecial} commands}
+@d pk_post = 245 {postamble}
+@d pk_no_op = 246 {no operation}
+@d pk_pre = 247 {preamble}
+
+@ The \.{PK} format has two conflicting goals; to pack character raster and
+size information as compactly as possible, while retaining ease of translation
+into raster and other forms. A suitable compromise was found in the use of
+run-encoding of the raster information. Instead of packing the individual
+bits of the character, we instead count the number of consecutive `black' or
+`white' pixels in a horizontal raster row, and then encode this number. Run
+counts are found for each row, from the top of the character to the bottom.
+This is essentially the way the \.{GF} format works.
+Instead of presenting each row individually, however, let us concatenate all
+of the horizontal raster rows into one long string of pixels, and encode this
+row. With knowledge of the width of the bit-map, the original character glyph
+can be easily reconstructed. In addition, we do not need special commands to
+mark the end of one row and the beginning of the next.
+
+Next, let us put the burden of finding the minimum bounding box on the part
+of the font generator, since the characters will usually be used much more
+often than they are generated. The minimum bounding box is the smallest
+rectangle which encloses all `black' pixels of a character. Let us also
+eliminate the need for a special end of character marker, by supplying
+exactly as many bits as are required to fill the minimum bounding box, from
+which the end of the character is implicit.
+
+Let us next consider the distribution of the run counts. Analysis of several
+dozen pixel files at 300 dots per inch yields a distribution peaking at four,
+falling off slowly until ten, then a bit more steeply until twenty, and then
+asymptotically approaching the horizontal. Thus, the great majority of our
+run counts will fit in a four-bit nybble. The eight-bit byte is attractive for
+our run-counts, as it is the standard on many systems; however, the wasted four
+bits in the majority of cases seems a high price to pay. Another possibility
+is to use a Huffman-type encoding scheme with a variable number of bits for
+each run-count; this was rejected because of the overhead in fetching and
+examining individual bits in the file. Thus, the character raster definitions
+in the \.{PK} file format are based on the four-bit nybble.
+
+@ The analysis of the pixel files yielded another interesting statistic: fully
+37\char`\%\
+of the raster rows were duplicates of the previous row. Thus, the \.{PK}
+format allows the specification of repeat counts, which indicate how many times
+a horizontal raster row is to be repeated. These repeated rows are taken out
+of the character glyph before individual rows are concatenated into the long
+string of pixels.
+
+For elegance, we disallow a run count of zero. The case of a null raster
+description should be gleaned from the character width and height being equal
+to zero, and no raster data should be read. No other zero counts are ever
+necessary. Also, in the absence of repeat counts, the repeat value is set to
+be zero (only the original row is sent.) If a repeat count is seen, it takes
+effect on the current row. The current row is defined as the row on which the
+first pixel of the next run count will lie. The repeat count is set back to
+zero when the last pixel in the current row is seen, and the row is sent out.
+
+This poses a problem for entirely black and entirely white rows, however. Let
+us say that the current row ends with four white pixels, and then we have five
+entirely empty rows, followed by a black pixel at the beginning of the next
+row, and the character width is ten pixels. We would like to use a repeat
+count, but there is no legal place to put it. If we put it before the white
+run count, it will apply to the current row. If we put it after, it applies
+to the row with the black pixel at the beginning. Thus, entirely white or
+entirely black repeated rows are always packed as large run counts (in this
+case, a white run count of 54) rather than repeat counts.
+
+@ Now let us turn our attention to the actual packing of the run counts and
+repeat counts into nybbles. There are only sixteen possible nybble values.
+We need to indicate run counts and repeat counts. Since the run counts are
+much more common, we will devote the majority of the nybble values to them.
+We therefore indicate a repeat count by a nybble of 14 followed by a packed
+number, where a packed number will be explained later. Since the repeat
+count value of one is so common, we indicate a repeat one command by a single
+nybble of 15. A 14 followed by the packed number 1 is still legal for a
+repeat one count, however. The run counts are coded directly as packed
+numbers.
+
+For packed numbers, therefore, we have the nybble values 0 through 13. We
+need to represent the positive integers up to, say, $2^{31}-1$. We would
+like the more common smaller numbers to take only one or two nybbles, and
+the infrequent large numbers to take three or more. We could therefore
+allocate one nybble value to indicate a large run count taking three or more
+nybbles. We do this with the value 0.
+
+@ We are left with the values 1 through 13. We can allocate some of these, say
+|dyn_f|, to be one-nybble run counts.
+These will work for the run counts |1..dyn_f|. For subsequent run
+counts, we will use a nybble greater than |dyn_f|, followed by a second nybble,
+whose value can run from 0 through 15. Thus, the two-byte nybble values will
+run from |dyn_f+1..(13-dyn_f)*16+dyn_f|. We have our definition of large run
+count values now, being all counts greater than |(13-dyn_f)*16+dyn_f|.
+
+We can analyze our several dozen pixel files and determine an optimal value of
+|dyn_f|, and use this value for all of the characters. Unfortunately, values
+of |dyn_f| that pack small characters well tend to pack the large characters
+poorly, and values that pack large characters well are not efficient for the
+smaller characters. Thus, we choose the optimal |dyn_f| on a character basis,
+picking the value which will pack each individual character in the smallest
+number of nybbles. Legal values of |dyn_f| run from 0 (with no one-byte run
+counts) to 13 (with no two-byte run counts).
+
+@ Our only remaining task in the coding of packed numbers is the large run
+counts. We use a scheme suggested by D.~E.~Knuth
+@^Knuth, D.~E.@>
+which will simply and elegantly represent arbitrarily large values. The
+general scheme to represent an integer |i| is to write its hexadecimal
+representation, with leading zeros removed. Then we count the number of
+digits, and prepend one less than that many zeros before the hexadecimal
+representation. Thus, the values from one to fifteen occupy one nybble;
+the values sixteen through 255 occupy three, the values 256 through 4095
+require five, etc.
+
+For our purposes, however, we have already represented the numbers one
+through |(13-dyn_f)*16+dyn_f|. In addition, the one-nybble values have
+already been taken by our other commands, which means that only the values
+from sixteen up are available to us for long run counts. Thus, we simply
+normalize our long run counts, by subtracting |(13-dyn_f)*16+dyn_f+1| and
+adding 16, and then representing the result according to the scheme above.
+
+@ The final algorithm for decoding the run counts based on the above scheme
+might look like this, assuming a procedure called \\{pk\_nyb} is available
+to get the next nybble from the file, and assuming that the global
+|repeat_count| indicates whether a row needs to be repeated. Note that this
+routine is recursive, but since a repeat count can never directly follow
+another repeat count, it can only be recursive to one level.
+
+@<Packed number procedure@>=
+function pk_packed_num : integer ;
+var i, j, k : integer ;
+begin
+ i := get_nyb ;
+ if i = 0 then begin
+ repeat j := get_nyb ; incr(i) ; until j <> 0 ;
+ while i > 0 do begin j := j * 16 + get_nyb ; decr(i) ; end ;
+ pk_packed_num := j - 15 + (13-dyn_f)*16 + dyn_f ;
+ end else if i <= dyn_f then
+ pk_packed_num := i
+ else if i < 14 then
+ pk_packed_num := (i-dyn_f-1)*16+get_nyb+dyn_f+1
+ else begin
+ if i = 14 then
+ repeat_count := pk_packed_num
+ else
+ repeat_count := 1 ;
+ pk_packed_num := pk_packed_num ;
+ end ;
+end ;
+
+@ For low resolution fonts, or characters with `gray' areas, run encoding can
+often make the character many times larger. Therefore, for those characters
+that cannot be encoded efficiently with run counts, the \.{PK} format allows
+bit-mapping of the characters. This is indicated by a |dyn_f| value of
+14. The bits are packed tightly, by concatenating all of the horizontal raster
+rows into one long string, and then packing this string eight bits to a byte.
+The number of bytes required can be calculated by |(width*height+7) div 8|.
+This format should only be used when packing the character by run counts takes
+more bytes than this, although, of course, it is legal for any character.
+Any extra bits in the last byte should be set to zero.
+
+@ At this point, we are ready to introduce the format for a character
+descripter. It consists of three parts: a flag byte, a character preamble,
+and the raster data. The most significant four bits of the flag byte
+yield the |dyn_f| value for that character. (Notice that only values of
+0 through 14 are legal for |dyn_f|, with 14 indicating a bit mapped character;
+thus, the flag bytes do not conflict with the command bytes, whose upper nybble
+is always 15.) The next bit (with weight 8) indicates whether the first run
+count is a black count or a white count, with a one indicating a black count.
+For bit-mapped characters, this bit should be set to a zero. The next bit
+(with weight 4) indicates whether certain later parameters (referred to as size
+parameters) are given in one-byte or two-byte quantities, with a one indicating
+that they are in two-byte quantities. The last two bits are concatenated on to
+the beginning of the length parameter in the character preamble, which will be
+explained below.
+
+However, if the last three bits of the flag byte are all set (normally
+indicating that the size parameters are two-byte values and that a 3 should be
+prepended to the length parameter), then a long format of the character
+preamble should be used instead of one of the short forms.
+
+Therefore, there are three formats for the character preamble, and which one
+is used depends on the least significant three bits of the flag byte. If the
+least significant three bits are in the range zero through three, the short
+format is used. If they are in the range four through six, the extended short
+format is used. Otherwise, if the least significant bits are all set, then
+the long form of the character preamble is used. The preamble formats are
+explained below.
+
+\yskip\hang Short form: |flag[1]| |pl[1]| |cc[1]| |tfm[3]| |dm[1]| |w[1]|
+|h[1]| |hoff[+1]| |voff[+1]|.
+If this format of the character preamble is used, the above
+parameters must all fit in the indicated number of bytes, signed or unsigned
+as indicated. Almost all of the standard \TeX\ font characters fit; the few
+exceptions are fonts such as \.{aminch}.
+
+\yskip\hang Extended short form: |flag[1]| |pl[2]| |cc[1]| |tfm[3]| |dm[2]|
+|w[2]| |h[2]| |hoff[+2]| |voff[+2]|. Larger characters use this extended
+format.
+
+\yskip\hang Long form: |flag[1]| |pl[4]| |cc[4]| |tfm[4]| |dx[4]| |dy[4]|
+|w[4]| |h[4]| |hoff[4]| |voff[4]|. This is the general format which
+allows all of the
+parameters of the \.{GF} file format, including vertical escapement.
+\vskip\baselineskip
+The |flag| parameter is the flag byte. The parameter |pl| (packet length)
+contains the offset
+of the byte following this character descripter, with respect to the beginning
+of the |tfm| width parameter. This is given so a \.{PK} reading program can,
+once it has read the flag byte, packet length, and character code (|cc|), skip
+over the character by simply reading this many more bytes. For the two short
+forms of the character preamble, the last two bits of the flag byte should be
+considered the two most-significant bits of the packet length. For the short
+format, the true packet length might be calculated as |(flag mod 4)*256+pl|;
+for the extended format, it might be calculated as |(flag mod 4)*65536+pl|.
+
+The |w| parameter is the width and the |h| parameter is the height in pixels
+of the minimum bounding box. The |dx| and |dy| parameters are the horizontal
+and vertical escapements, respectively. In the short formats, |dy| is assumed
+to be zero and |dm| is |dy| but in pixels;
+in the long format, |dx| and |dy| are both
+in pixels multiplied by $2^{16}$. The |hoff| is the horizontal offset from the
+upper left pixel to the reference pixel; the |voff| is the vertical offset.
+They are both given in pixels, with right and down being positive. The
+reference pixel is the pixel which occupies the unit square in \MF; the
+\MF\ reference point is the lower left hand corner of this pixel. (See the
+example below.)
+
+@ \TeX\ requires that all characters which have the same character codes
+modulo 256 also have the same |tfm| widths, and escapement values. The \.{PK}
+format does not itself make this a requirement, but in order for the font to
+work correctly with the \TeX\ software, this constraint should be observed.
+
+
+Following the character preamble is the raster information for the
+character, packed by run counts or by bits, as indicated by the flag byte.
+If the character is packed by run counts and the required number of nybbles
+is odd, then the last byte of the raster description should have a zero
+for its least significant nybble.
+
+@ As an illustration of the \.{PK} format, the character \char4\ from the font
+amr10 at 300 dots per inch will be encoded. (Note: amr fonts are obsolete,
+and the reference to this character is retained from an older version of
+the Computer Modern fonts solely for illustration.) This character was chosen
+because it illustrates some
+of the borderline cases. The raster for the character looks like this (the
+row numbers are chosen for convenience, and are not \MF's row numbers.)
+
+\vskip\baselineskip
+\centerline{\vbox{\baselineskip=10pt
+\halign{\hfil#\quad&&\hfil#\hfil\cr
+0& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+1& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+2& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+3& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+4& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+5& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+6& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+7\cr
+8\cr
+9& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+10& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+11& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+12& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+13& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+14& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+15& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+16& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+17& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+18& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+19\cr
+20\cr
+21\cr
+22& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+23& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+24& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+25& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+26& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+27& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+28&*& &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+&\hphantom{M}&\hphantom{M}\cr
+}}}
+The width of the minimum bounding box for this character is 20; its height
+is 29. The `*' represents the reference pixel; notice how it lies outside the
+minimum bounding box. The |hoff| value is $-2$, and the |voff| is~28.
+
+The first task is to calculate the run counts and repeat counts. The repeat
+counts are placed at the first transition (black to white or white to black)
+in a row, and are enclosed in brackets. White counts are enclosed in
+parentheses. It is relatively easy to generate the counts list:
+\vskip\baselineskip
+\centerline{82 [2] (16) 2 (42) [2] 2 (12) 2 (4) [3]}
+\centerline{16 (4) [2] 2 (12) 2 (62) [2] 2 (16) 82}
+\vskip\baselineskip
+Note that any duplicated rows that are not all white or all black are removed
+before the repeat counts are calculated. The rows thus removed are rows 5, 6,
+10, 11, 13, 14, 15, 17, 18, 23, and 24.
+
+@ The next step in the encoding of this character is to calculate the optimal
+value of |dyn_f|. The details of how this calculation is done are not
+important here; suffice it to say that there is a simple algorithm which in one
+pass over the count list can determine the best value of |dyn_f|. For this
+character, the optimal value turns out to be 8 (atypically low). Thus, all
+count values less than or equal to 8 are packed in one nybble; those from
+nine to $(13-8)*16+8$ or 88 are packed in two nybbles. The run encoded values
+now become (in hex, separated according to the above list):
+\vskip\baselineskip
+\centerline{\tt D9 E2 97 2 B1 E2 2 93 2 4 E3}
+\centerline{\tt 97 4 E2 2 93 2 C5 E2 2 97 D9}
+\vskip\baselineskip\noindent
+which comes to 36 nybbles, or 18 bytes. This is shorter than the 73 bytes
+required for the bit map, so we use the run count packing.
+
+@ The short form of the character preamble is used because all of the
+parameters fit in their respective lengths. The packet length is therefore
+18 bytes for the raster, plus
+eight bytes for the character preamble parameters following the character
+code, or 26. The |tfm| width for this character is 640796, or {\tt 9C71C} in
+hexadecimal. The horizontal escapement is 25 pixels. The flag byte is
+88 hex, indicating the short preamble, the black first count, and the
+|dyn_f| value of 8. The final total character packet, in hexadecimal, is:
+\vskip\baselineskip
+$$\vbox{\halign{\hfil #\quad&&{\tt #\ }\cr
+Flag byte&88\cr
+Packet length&1A\cr
+Character code&04\cr
+|tfm| width&09&C7&1C\cr
+Horizontal escapement (pixels)&19\cr
+Width of bit map&14\cr
+Height of bit map&1D\cr
+Horizontal offset (signed)&FE\cr
+Vertical offset&1C\cr
+Raster data&D9&E2&97\cr
+&2B&1E&22\cr
+&93&24&E3\cr
+&97&4E&22\cr
+&93&2C&5E\cr
+&22&97&D9\cr}}$$
+
+@ This format was written by Tomas Rokicki in August, 1985.
+
+@* Input and output.
+There are two types of files that this program must deal with---standard
+text files and files of bytes (packed files and generic font files.)
+For our purposes, we shall consider an eight-bit byte to consist of the
+values |0..255|. If your system does not pack these values to a byte, it is
+no major difficulty; you must only insure that the input function
+|pk_byte| can read packed bytes, and that the output fuunction |gf_byte|
+packs the bytes to be shipped.
+
+@<Types...@>=
+@!eight_bits=0..255; {packed file byte}
+@!byte_file=packed file of eight_bits ; {for packed file words}
+@^system dependancies@>
+
+@ @<Glob...@>=
+@!gf_file,@!pk_file:byte_file; {the I/O streams}
+@^system dependencies@>
+
+@ To prepare these files for input, we |reset| them. An extension of
+\PASCAL\ is needed in the case of |gf_file|, since we want to associate
+it with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_gf_file; {prepares to write packed bytes in a |gf_file|}
+begin rewrite(gf_file,gf_name);
+gf_loc := 0 ;
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+
+@ We need a place to store the names of the input and output files, as well
+as a byte counter for the output file.
+
+@<Glob...@>=
+@!gf_name,@!pk_name:packed array[1..name_length] of char; {names of input
+ and output files}
+@!gf_loc, @!pk_loc:integer; {how many bytes have we sent?}
+
+@ We need a procedure that will write a byte to the \.{GF} file. If the
+particular system
+@^system dependencies@>
+requires buffering, here is the place to do it.
+
+@p procedure gf_byte (i : integer) ;
+begin gf_file^ := i ;
+put(gf_file) ;
+incr(gf_loc) ;
+end;
+
+@ We also need a function that will get a single byte from the \.{PK} file.
+Again, buffering may be done in this procedure.
+
+@p function pk_byte : eight_bits ;
+var nybble, temp : eight_bits ;
+begin
+ temp := pk_file^ ;
+ get(pk_file) ;
+ pk_loc := pk_loc + 1 ;
+ pk_byte := temp ;
+end ;
+
+@ Now we are ready to open the files and write the identification of the
+pixel file.
+
+@<Open files@>=
+open_pk_file ;
+open_gf_file
+
+@ As we are reading the packed file, we often need to fetch 16 and 32 bit
+quantities. Here we have two procedures to do this.
+
+@p function signed_byte : integer ;
+var a : integer ;
+begin
+ a := pk_byte ;
+ if a > 127 then
+ a := a - 256 ;
+ signed_byte := a ;
+end ;
+@#
+function get_16 : integer ;
+var a : integer ;
+begin
+ a := pk_byte ;
+ get_16 := a * 256 + pk_byte ;
+end ;
+@#
+function signed_16 : integer ;
+var a : integer ;
+begin
+ a := signed_byte ;
+ signed_16 := a * 256 + pk_byte ;
+end ;
+@#
+function get_32 : integer ;
+var a : integer ;
+begin
+ a := get_16 ;
+ if a > 32767 then a := a - 65536 ;
+ get_32 := a * 65536 + get_16 ;
+end ;
+
+@ As we are writing the \.{GF} file, we often need to write signed and
+unsigned, one, two, three, and four-byte values. These routines give
+us that capability.
+
+@p procedure gf_sbyte(i : integer) ;
+begin
+ if i < 0 then
+ i := i + 256 ;
+ gf_byte(i) ;
+end ;
+@#
+procedure gf_16(i : integer) ;
+begin
+ gf_byte(i div 256) ;
+ gf_byte(i mod 256) ;
+end ;
+@#
+procedure gf_24(i : integer) ;
+begin
+ gf_byte(i div 65536) ;
+ gf_16(i mod 65536) ;
+end ;
+@#
+procedure gf_quad(i : integer) ;
+begin
+ if i >= 0 then begin
+ gf_byte(i div 16777216) ;
+ end else begin
+ i := (i + 1073741824) + 1073741824 ;
+ gf_byte(128 + (i div 16777216)) ;
+ end ;
+ gf_24(i mod 16777216) ;
+end ;
+
+@* Character unpacking.
+Now we deal with unpacking characters into the \.{GF} representation.
+
+@<Unpack and write character@>=
+dyn_f := flag_byte div 16 ;
+flag_byte := flag_byte mod 16 ;
+turn_on := flag_byte >= 8 ;
+if turn_on then flag_byte := flag_byte - 8 ;
+if flag_byte = 7 then
+ @<Read long character preamble@>
+else if flag_byte > 3 then
+ @<Read extended short character preamble@>
+else
+ @<Read short character preamble@> ;
+@<Calculate and check |min_m|, |max_m|, |min_n|, and |max_n|@> ;
+@<Save character locator@> ;
+@<Write character preamble@> ;
+@<Read and translate raster description@> ;
+gf_byte(eoc) ;
+last_eoc := gf_loc ;
+if end_of_packet <> pk_loc then abort('Bad pk file! Bad packet length.')
+
+@ We need a whole lot of globals used but not defined up there.
+
+@<Glob...@>=
+@!i, @!j : integer ; {index pointers}
+@!end_of_packet : integer ; {where we expect the end of the packet to be}
+@!dyn_f : integer ; {dynamic packing variable}
+@!car : integer ; {the character we are reading}
+@!tfm_width : integer ; {the TFM width of the current character}
+@!x_off, @!y_off : integer ; {the offsets for the character}
+
+@ Now we read and check the preamble of the \.{PK} file. In the preamble, we
+find the |hppp|, |design_size|, |checksum|. We write the relevant parameters
+to the \.{GF} file, including the preamble comment.
+
+@<Read preamble@>=
+if pk_byte <> pk_pre then abort('Bad pk file! pre command missing.') ;
+gf_byte(pre) ;
+if pk_byte <> pk_id then abort('Wrong version of packed file!.') ;
+gf_byte(gf_id_byte) ;
+j := pk_byte ;
+for i := 1 to j do hppp := pk_byte ;
+gf_byte(comm_length) ;
+for i := 1 to comm_length do
+ gf_byte(xord[comment[i]]) ;
+design_size := get_32 ;
+checksum := get_32 ;
+hppp := get_32 ; vppp := get_32 ;
+if hppp <> vppp then print_ln('Warning: aspect ratio not 1:1!') ;
+magnification := round(hppp * 72.27 * 5 / 65536) ;
+last_eoc := gf_loc
+
+@ Of course, we need to define the above variables.
+
+@<Glob...@>=
+@!comment : packed array[1..comm_length] of char ;
+@!magnification : integer ; {resolution at which pixel file is prepared}
+@!design_size : integer ; {design size in \.{FIXes}}
+@!checksum : integer ; {checksum of pixel file}
+@!hppp, @!vppp : integer ; {horizontal and vertical points per inch}
+
+@ @<Set init...@>=
+comment := preamble_comment ;
+
+@ Now, the character preamble reading modules. First, we have the general
+case: the long character preamble format.
+
+@<Read long character preamble@>=
+begin
+ packet_length := get_32 ; car := get_32 ;
+ end_of_packet := packet_length + pk_loc ;
+ tfm_width := get_32 ;
+ hor_esc := get_32 ;
+ ver_esc := get_32 ;
+ c_width := get_32 ;
+ c_height := get_32 ;
+ word_width := (c_width + 31) div 32 ;
+ x_off := get_32 ;
+ y_off := get_32 ;
+end
+
+@ This module reads the character preamble with double byte parameters.
+
+@<Read extended short character preamble@>=
+begin
+ packet_length := (flag_byte - 4) * 65536 + get_16 ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ i := pk_byte ;
+ tfm_width := i * 65536 + get_16 ;
+ hor_esc := get_16 * 65536 ;
+ ver_esc := 0 ;
+ c_width := get_16 ;
+ c_height := get_16 ;
+ word_width := (c_width + 31) div 32 ;
+ x_off := signed_16 ;
+ y_off := signed_16 ;
+end
+
+@ Here we read the most common character preamble, that with single byte
+parameters.
+
+@<Read short character preamble@>=
+begin
+ packet_length := flag_byte * 256 + pk_byte ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ i := pk_byte ;
+ tfm_width := i * 65536 + get_16 ;
+ hor_esc := pk_byte * 65536 ;
+ ver_esc := 0 ;
+ c_width := pk_byte ;
+ c_height := pk_byte ;
+ word_width := (c_width + 31) div 32 ;
+ x_off := signed_byte ;
+ y_off := signed_byte ;
+end
+
+@ Some more globals:
+
+@<Glob...@>=
+@!c_height, @!c_width : integer ; {sizes of the character glyphs}
+@!word_width : integer ; {width of character in raster words}
+@!hor_esc, @!ver_esc : integer ; {the character escapement}
+@!packet_length : integer ; {the length of the packet in bytes}
+@!last_eoc : integer ; {the last end of character}
+
+@ The \.{GF} format requires the minimum and maximum |m| and |n|
+values in the postamble, so we generate them here. One thing
+that should be noted, here. The value |max_n-min_n| will be the
+height of the character glyph, but for the width, you need to
+use |max_m-min_m-1|, because of the peculiarities of the \.{GF}
+format.
+
+@<Calculate and check |min_m|, |max_m|, |min_n|, and |max_n|@>=
+if (c_height = 0) or (c_width = 0) then begin
+ c_height := 0 ; c_width := 0 ; x_off := 0 ; y_off := 0 ;
+end ;
+min_m := - x_off ;
+if min_m < mmin_m then
+ mmin_m := min_m ;
+max_m := c_width + min_m ;
+if max_m > mmax_m then
+ mmax_m := max_m ;
+min_n := y_off - c_height + 1 ;
+max_n := y_off ;
+if min_n > max_n then
+ min_n := max_n ;
+if min_n < mmin_n then
+ mmin_n := min_n ;
+if max_n > mmax_n then
+ mmax_n := max_n
+
+@ We have to declare the variables which hold the bounding box. We
+also need the arrays that hold the back pointers to the characters,
+the horizontal and vertical escapements, and the \.{TFM} widths.
+
+@<Glob...@>=
+@!min_m, @!max_m, @!min_n, @!max_n : integer ;
+@!mmin_m, @!mmax_m, @!mmin_n, @!mmax_n : integer ;
+@!char_pointer, @!s_tfm_width : array [0..255] of integer ;
+@!s_hor_esc, @!s_ver_esc : array [0..255] of integer ;
+@!this_char_ptr : integer ;
+
+@ We initialize these bounding box values to be ridiculous, and say
+that there were no characters seen yet.
+
+@<Set init...@>=
+mmin_m := 999999 ;
+mmin_n := 999999 ;
+mmax_m := -999999 ;
+mmax_n := -999999 ;
+for i := 0 to 255 do
+ char_pointer[i] := -1 ;
+
+@ This module takes care of the simple job of writing the character
+preamble, after picking one to fit.
+
+@<Write character preamble@>=
+begin
+ if (char_pointer[car mod 256] = -1) and
+ (car >= 0) and (car < 256) and
+ (max_m >= 0) and (max_m < 256) and
+ (max_n >= 0) and (max_n < 256) and
+ (max_m >= min_m) and (max_n >= min_n) and
+ (max_m < min_m + 256) and (max_n < min_n + 256) then begin
+ char_pointer[car mod 256] := this_char_ptr ;
+ gf_byte(boc1) ;
+ gf_byte(car) ;
+ gf_byte(max_m - min_m) ;
+ gf_byte(max_m) ;
+ gf_byte(max_n - min_n) ;
+ gf_byte(max_n) ;
+ end else begin
+ gf_byte(boc) ;
+ gf_quad(car) ;
+ gf_quad(char_pointer[car mod 256]) ;
+ char_pointer[car mod 256] := this_char_ptr ;
+ gf_quad(min_m) ;
+ gf_quad(max_m) ;
+ gf_quad(min_n) ;
+ gf_quad(max_n) ;
+ end ;
+end
+
+@ In this routine we either save or check the current character
+parameters.
+
+@<Save character locator@>=
+begin
+ i := car mod 256 ;
+ if (char_pointer[i] = -1) then begin
+ s_ver_esc[i] := ver_esc ;
+ s_hor_esc[i] := hor_esc ;
+ s_tfm_width[i] := tfm_width ;
+ end else begin
+ if (s_ver_esc[i] <> ver_esc) or
+ (s_hor_esc[i] <> hor_esc) or
+ (s_tfm_width[i] <> tfm_width) then
+ print_ln('Two characters mod ', i:1,' have mismatched parameters') ;
+ end ;
+end
+
+@ And another module to write out those character locators we have so
+carefully saved up the information for.
+
+@<Write character locators@>=
+for i := 0 to 255 do
+ if char_pointer[i] <> -1 then begin
+ if (s_ver_esc[i] = 0) and (s_hor_esc[i] >= 0) and
+ (s_hor_esc[i] < 16777216) and (s_hor_esc[i] mod 65536 = 0) then begin
+ gf_byte(char_loc0) ;
+ gf_byte(i) ;
+ gf_byte(s_hor_esc[i] div 65536) ;
+ end else begin
+ gf_byte(char_loc) ;
+ gf_byte(i) ;
+ gf_quad(s_hor_esc[i]) ;
+ gf_quad(s_ver_esc[i]) ;
+ end ;
+ gf_quad(s_tfm_width[i]) ;
+ gf_quad(char_pointer[i]) ;
+ end
+
+@ Now we have the most important part of the program, where we actually
+interpret the commands in the raster description. First of all, we need
+a procedure to get a single nybble from the file, as well as one to get
+a single bit. We also use the |pk_packed_num| procedure defined in the
+\.{PK} file description.
+
+@p function get_nyb : integer ;
+var temp : eight_bits ;
+begin
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 16 ;
+ end ;
+ temp := input_byte div bit_weight ;
+ input_byte := input_byte - temp * bit_weight ;
+ bit_weight := bit_weight div 16 ;
+ get_nyb := temp ;
+end ;
+@#
+function get_bit : boolean ;
+var temp : boolean ;
+begin
+ bit_weight := bit_weight div 2 ;
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 128 ;
+ end ;
+ temp := input_byte >= bit_weight ;
+ if temp then
+ input_byte := input_byte - bit_weight ;
+ get_bit := temp ;
+end ;
+@<Packed number procedure@>
+
+@ Now, the globals to help communication between these procedures, and a buffer
+for the raster row counts.
+
+@<Glob...@>=
+@!input_byte : eight_bits ; {the byte we are currently decimating}
+@!bit_weight : eight_bits ; {weight of the current bit}
+@!nybble : eight_bits ; {the current nybble}
+@!row_counts : array [0..max_counts] of integer ;
+ {where the row is constructed}
+@!rcp : integer ; { the row counts pointer }
+
+@ Actually, if the character is a bit mapped character, then we
+make it look like run counts by determining the appropriate
+values ourselves. Thus, we have a routine which gets the next
+count value, below.
+
+@<Get next count value into |count|@>=
+begin
+ turn_on := not turn_on ;
+ if dyn_f = 14 then begin
+ count := 1 ;
+ done := false ;
+ while not done do begin
+ if count_down <= 0 then
+ done := true
+ else if (turn_on = get_bit) then
+ count := count + 1
+ else
+ done := true ;
+ count_down := count_down - 1 ;
+ end ;
+ end else
+ count := pk_packed_num ;
+end
+
+@ And the main procedure.
+
+@<Read and translate raster description@>=
+if (c_width > 0) and (c_height > 0) then begin
+ bit_weight := 0 ;
+ count_down := c_height * c_width - 1 ;
+ if dyn_f = 14 then
+ turn_on := get_bit ;
+ repeat_count := 0 ;
+ x_to_go := c_width ;
+ y_to_go := c_height ;
+ cur_n := c_height ;
+ count := 0 ;
+ first_on := turn_on ;
+ turn_on := not turn_on ;
+ rcp := 0 ;
+ while y_to_go > 0 do begin
+ if count = 0 then
+ @<Get next count...@> ;
+ if rcp = 0 then
+ first_on := turn_on ;
+ while count >= x_to_go do begin
+ row_counts[rcp] := x_to_go ;
+ count := count - x_to_go ;
+ for i := 0 to repeat_count do begin
+ @<Output row@> ;
+ y_to_go := y_to_go - 1 ;
+ end ;
+ repeat_count := 0 ;
+ x_to_go := c_width ;
+ rcp := 0 ;
+ if (count > 0) then
+ first_on := turn_on ;
+ end ;
+ if count > 0 then begin
+ row_counts[rcp] := count ;
+ if rcp = 0 then
+ first_on := turn_on ;
+ rcp := rcp + 1 ;
+ if rcp > max_counts then begin
+ print_ln('A character had too many run counts') ;
+ jump_out ;
+ end ;
+ x_to_go := x_to_go - count ;
+ count := 0 ;
+ end ;
+ end ;
+end
+
+@ This routine actually outputs a row to the \.{GF} file.
+
+@<Output row@>=
+if (rcp > 0) or first_on then begin
+ j := 0 ;
+ max := rcp ;
+ if not turn_on then
+ max := max - 1 ;
+ if cur_n - y_to_go = 1 then begin
+ if first_on then
+ gf_byte(new_row_0)
+ else if row_counts[0] < 165 then begin
+ gf_byte(new_row_0 + row_counts[0]) ;
+ j := j + 1 ;
+ end else
+ gf_byte(skip0) ;
+ end else if cur_n > y_to_go then begin
+ if cur_n - y_to_go < 257 then begin
+ gf_byte(skip1) ;
+ gf_byte(cur_n - y_to_go - 1) ;
+ end else begin
+ gf_byte(skip1+1) ;
+ gf_16(cur_n - y_to_go - 1) ;
+ end ;
+ if first_on then
+ gf_byte(paint_0) ;
+ end else if first_on then
+ gf_byte(paint_0) ;
+ cur_n := y_to_go ;
+ while j <= max do begin
+ if row_counts[j] < 64 then
+ gf_byte(paint_0 + row_counts[j])
+ else if row_counts[j] < 256 then begin
+ gf_byte(paint1) ;
+ gf_byte(row_counts[j]) ;
+ end else begin
+ gf_byte(paint1+1) ;
+ gf_16(row_counts[j]) ;
+ end ;
+ j := j + 1 ;
+ end ;
+end
+
+@ Here we need the array which counts down the number of bits, and
+the current state flag.
+
+@<Glob...@>=
+@!count_down : integer ; { have we run out of bits yet? }
+@!done : boolean ; { are we done yet? }
+@!max : integer ; { the maximum number of counts to output }
+@!repeat_count : integer ; {how many times to repeat the next row?}
+@!x_to_go, @!y_to_go : integer ; {how many columns/rows left?}
+@!turn_on, @!first_on : boolean ; {are we black here?}
+@!count : integer ; {how many bits of current color left?}
+@!cur_n : integer ; {what row are we at?}
+
+@ To finish the \.{GF} file, we write out a postamble, including the
+character locators that we stored away.
+
+@<Write \.{GF} postamble@>=
+j := gf_loc ;
+gf_byte(post) ;
+gf_quad(last_eoc) ;
+gf_quad(design_size) ;
+gf_quad(checksum) ;
+gf_quad(hppp) ;
+gf_quad(vppp) ;
+gf_quad(mmin_m) ;
+gf_quad(mmax_m) ;
+gf_quad(mmin_n) ;
+gf_quad(mmax_n) ;
+@<Write character locators@> ;
+gf_byte(post_post) ;
+gf_quad(j) ;
+gf_byte(gf_id_byte) ;
+for i := 0 to 3 do
+ gf_byte(223) ;
+while gf_loc mod 4 <> 0 do
+ gf_byte(223)
+
+@ We need the |flag_byte| variable.
+
+@<Glob...@>=
+@!flag_byte : integer ; {command or character flag byte}
+
+@ Another necessary procedure skips over any specials between characters
+and before and after the postamble. (It echoes the specials exactly.)
+
+@p procedure skip_specials ;
+var i, j, k : integer ;
+begin
+ this_char_ptr := gf_loc ;
+ repeat
+ flag_byte := pk_byte ;
+ if flag_byte >= 240 then
+ case flag_byte of
+ 240, 241, 242, 243 :
+begin
+ i := 0 ;
+ gf_byte(flag_byte-1) ;
+ for j := 240 to flag_byte do begin
+ k := pk_byte ;
+ gf_byte(k) ;
+ i := 256 * i + k ;
+ end ;
+ for j := 1 to i do gf_byte(pk_byte) ;
+end ;
+ 244 :
+begin
+ gf_byte(243) ;
+ gf_quad(get_32) ;
+end ;
+ 245 : begin end ;
+ 246 : begin end ;
+ 247, 248, 249, 250, 251, 252, 253, 254, 255 :
+ abort('Unexpected ', flag_byte:1,'!') ;
+ endcases ;
+ until (flag_byte < 240) or (flag_byte = pk_post) ;
+end ;
+
+@* Terminal communication.
+We must get the file names and determine whether input is to be in
+hexadecimal or binary. To do this, we use the standard input path
+name. We need a procedure to flush the input buffer. For most systems,
+this will be an empty statement. For other systems, a |print_ln| will
+provide a quick fix. We also need a routine to get a line of input from
+the terminal. On some systems, a simple |read_ln| will do. Finally,
+a macro to print a string to the first blank is required.
+
+@d flush_buffer == begin end
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+
+@ @p procedure dialog ;
+var i : integer ; {index variable}
+buffer : packed array [1..name_length] of char; {input buffer}
+begin
+ for i := 1 to name_length do begin
+ gf_name[i] := ' ' ;
+ pk_name[i] := ' ' ;
+ end;
+ print('Input file name: ') ;
+ flush_buffer ;
+ get_line(pk_name) ;
+ print('Output file name: ') ;
+ flush_buffer ;
+ get_line(gf_name) ;
+end ;
+
+@* The main program.
+Now that we have all the pieces written, let us put them together.
+
+@p begin
+initialize ;
+dialog ;
+@<Open files@> ;
+@<Read preamble@> ;
+skip_specials ;
+while flag_byte <> pk_post do begin
+ @<Unpack and write character@> ;
+ skip_specials ;
+end ;
+while not eof(pk_file) do i := pk_byte ;
+@<Write \.{GF} postamble@> ;
+print_ln(pk_loc:1,' bytes unpacked to ',gf_loc:1,' bytes.');
+final_end :
+end .
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtoGF} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/pktype.ch b/Build/source/texk/web2c/pktype.ch
new file mode 100644
index 00000000000..6071e88bb51
--- /dev/null
+++ b/Build/source/texk/web2c/pktype.ch
@@ -0,0 +1,366 @@
+% pktype.ch for C compilation with web2c.
+%
+% 09/27/88 Pierre A. MacKay Version 2.2.
+% 12/02/89 Karl Berry cosmetic changes.
+% 02/04/90 Karl new file-searching routines.
+% (more recent changes in the ChangeLog)
+%
+% There is no terminal input to this program.
+% Output is to stdout, and may, of course, be redirected.
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{PK$\,$\lowercase{type} changes for C}
+@z
+
+@x [4] Redirect output to stdout.
+@d t_print_ln(#)==write_ln(typ_file,#)
+@y
+@d typ_file==stdout
+@d t_print_ln(#)==write_ln(typ_file,#)
+@z
+
+@x [4] No global labels or constants.
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+@y
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+begin
+ kpse_set_progname (argv[0]);
+ kpse_init_prog ('PKTYPE', 0, nil, nil);
+ parse_arguments;
+ print(banner); print_ln(version_string);@/
+@z
+
+@x [5] Remove the unused label.
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+@y
+@z
+
+% [6] No need for |name_length| or |terminal_line_length|. Since these
+% were the only constants, the <Constants...> module is no longer needed.
+@x
+@<Constants...@>=
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+@y
+@z
+
+@x [8] Change abort to get rid of non-local goto.
+@ It is possible that a malformed packed file (heaven forbid!) or some other
+error might be detected by this program. Such errors might occur in a deeply
+nested procedure, so the procedure called |jump_out| has been added to transfer
+to the very end of the program with an error message.
+
+@d abort(#)==begin print_ln(' ',#); t_print_ln(' ',#); jump_out; end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+@y
+@ We use a call to the external C exit to avoid a non-local |goto|.
+
+@d abort(#)==begin print_ln(#); uexit(1) end
+
+@z
+
+@x [32] Remove typ_file from globals.
+@ @<Glob...@>=
+@!pk_file:byte_file; {where the input comes from}
+@!typ_file:text_file; {where the final output goes}
+@^system dependencies@>
+@y
+@ @<Glob...@>=
+@!pk_file:byte_file; {where the input comes from}
+@^system dependencies@>
+@z
+
+@x [33] Redo open_pk_file; scrap open_typ_file.
+@ To prepare these files for input and output, we |reset| and |rewrite| them.
+An extension of \PASCAL\ is needed, since we want to associate files
+with external names that are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+@#
+procedure open_typ_file; {prepares to write text data to the |typ_file|}
+begin rewrite(typ_file,typ_name);
+end;
+@y
+@ In C, do path searching.
+
+@p procedure open_pk_file; {prepares to read packed bytes in |pk_file|}
+begin
+ {Don't use |kpse_find_pk|; we want the exact file or nothing.}
+ pk_file := kpse_open_file (cmdline (1), kpse_pk_format);
+ cur_loc := 0;
+end;
+@z
+
+@x [34] Change pk_loc to cur_loc, and use C strings, not arrays.
+@!pk_name,@!typ_name:packed array[1..name_length] of char; {name of input
+ and output files}
+@!pk_loc:integer; {how many bytes have we read?}
+@y
+@!pk_name:^char; {name of input and output files}
+@!cur_loc:integer; {how many bytes have we read?}
+@z
+
+@x [??] Use modified routines to access pk_file.
+@p function pk_byte : eight_bits ;
+var temp : eight_bits ;
+begin
+ temp := pk_file^ ;
+ get(pk_file) ;
+ incr(pk_loc) ;
+ pk_byte := temp ;
+end ;
+@y
+We shall use a set of simple functions to read the next byte or
+bytes from |pk_file|. There are seven possibilities, each of which is
+treated as a separate function in order to minimize the overhead for
+subroutine calls. We comment out the ones we don't need
+@^system dependencies@>
+
+@d pk_byte==get_byte
+@d pk_loc==cur_loc
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(pk_file) then get_byte:=0
+else begin read(pk_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@{
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(pk_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@}
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(pk_file,a); read(pk_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@{
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(pk_file,a); read(pk_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(pk_file,a); read(pk_file,b); read(pk_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(pk_file,a); read(pk_file,b); read(pk_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@}
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(pk_file,a); read(pk_file,b); read(pk_file,c); read(pk_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@z
+
+@x [36] Don't need the <Open files> module.
+@ Now we are ready to open the files.
+
+@<Open files@>=
+open_pk_file ;
+open_typ_file ;
+t_print_ln(banner) ;
+t_print('Input file: ') ;
+i := 1 ;
+while pk_name[i] <> ' ' do begin
+ t_print(pk_name[i]) ; incr(i) ;
+end ;
+t_print_ln(' ')
+@y
+@ This module was needed when output was directed to |typ_file|.
+It is not needed when output goes to |stdout|.
+@z
+
+@x [37] Redefine get_16 and get_32.
+@p function get_16 : integer ;
+var a : integer ;
+begin a := pk_byte ; get_16 := a * 256 + pk_byte ; end ;
+@#
+function get_32 : integer ;
+var a : integer ;
+begin a := get_16 ; if a > 32767 then a := a - 65536 ;
+get_32 := a * 65536 + get_16 ; end ;
+@y
+@d get_16==get_two_bytes
+@d get_32==signed_quad
+@z
+
+% [53] web2c can't handle the implied serialism in Pascal write
+% statements. (From Martyn.Johnson@cl.cam.ac.uk.)
+@x
+ pk_yyy : t_print_ln((pk_loc-1):1,': Num special: ',get_32:1) ;
+@y
+ pk_yyy : begin t_print((pk_loc-1):1);
+ t_print_ln (': Num special: ',get_32:1) ; end;
+@z
+
+@x [54--55] Eliminate the ``Terminal communication'' chapter.
+@* Terminal communication.
+We must get the file names and determine whether input is to be in
+hexadecimal or binary. To do this, we use the standard input path
+name. We need a procedure to flush the input buffer. For most systems,
+this will be an empty statement. For other systems, a |print_ln| will
+provide a quick fix. We also need a routine to get a line of input from
+the terminal. On some systems, a simple |read_ln| will do. Finally,
+a macro to print a string to the first blank is required.
+
+@d flush_buffer == begin end
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+
+@ @p procedure dialog ;
+var i : integer ; {index variable}
+buffer : packed array [1..name_length] of char; {input buffer}
+begin
+ for i := 1 to name_length do begin
+ typ_name[i] := ' ' ;
+ pk_name[i] := ' ' ;
+ end;
+ print('Input file name: ') ;
+ flush_buffer ;
+ get_line(pk_name) ;
+ print('Output file name: ') ;
+ flush_buffer ;
+ get_line(typ_name) ;
+end ;
+@y
+@* Terminal communication. There isn't any.
+
+@ So there is no |procedure dialog|.
+@z
+
+@x [56] Restructure the main program.
+dialog ;
+@<Open files@> ;
+@y
+open_pk_file ;
+@z
+@x
+final_end :
+@y
+@z
+
+@x System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtype} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 2; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ do_nothing;
+
+ end else if getopt_return_val = '?' then begin
+ usage ('pktype');
+
+ end else if argument_is ('help') then begin
+ usage_help (PKTYPE_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'Tomas Rokicki');
+
+ end; {Else it was just a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 1 <> argc) then begin
+ write_ln (stderr, 'pktype: Need exactly one file argument.');
+ usage ('pktype');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/pktype.rc b/Build/source/texk/web2c/pktype.rc
new file mode 100644
index 00000000000..d0bfd307714
--- /dev/null
+++ b/Build/source/texk/web2c/pktype.rc
@@ -0,0 +1,34 @@
+/* pktype.rc: pktype resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " pktype 2.3"
+
+#define VER_INTERNALNAME_STR "pktype"
+#define VER_ORIGINALFILENAME_STR "pktype.exe"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#define VER_FILEDESCRIPTION_STR "Verifies and translates a PK file to human-readable form"
+
+#include <texlive.version>
+
+/* pktype.rc ends here */
diff --git a/Build/source/texk/web2c/pktype.web b/Build/source/texk/web2c/pktype.web
new file mode 100644
index 00000000000..eac85ee36f6
--- /dev/null
+++ b/Build/source/texk/web2c/pktype.web
@@ -0,0 +1,1158 @@
+% PKtype.web
+%
+% PKtype verifies the correctness of a PK file.
+%
+% Preliminary 0.0 version: May, 1985
+% First release, 0.9 version: 8 May 1985
+% Updated to reflect new pk format, 2.0 version: 25 July 1985
+% Updated again for new pk format, 2.1 version: 15 August 1985
+% Docmentation updated, 2.2 version: 17 November 1987
+%
+% slight editing to correspond with MFware report -- don, 21 Oct 89
+% additional editing suggested by P Breitenlohner -- don, 18 Nov 89
+% Corrected two typos -- 21 Dec 96 (don)
+
+\def\versiondate{18 November 1989}
+%
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\font\ninerm=cmr9
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\PASCAL{Pascal}
+\def\tamu{Texas A\char38 M}
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+\def\title{PKtype}
+\def\contentspagenumber{0}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont PKtype} processor}
+ \vskip 15pt
+ \centerline{(Version 2.3, \versiondate)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program reads a \.{PK} file, verifies that it is in the correct
+format, and writes it in textual format.
+
+@ The |banner| string defined here should be changed whenever \.{PKtype}
+gets modified.
+
+@d banner=='This is PKtype, Version 2.3' {printed when the program starts}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{PKtype} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ Both the input and output come from binary files. On line interaction
+is handled through \PASCAL's standard |input| and |output| files. Two macros
+are used to write to the type file, so this output can easily be redirected.
+
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+@d t_print_ln(#)==write_ln(typ_file,#)
+@d t_print(#)==write(typ_file,#)
+
+@p program PKtype(@!input,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ These constants determine the maximum length of a file name and the length
+of the terminal line, as well as the widest character that can be translated.
+@^system dependencies@>
+
+@<Constants...@>=
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ It is possible that a malformed packed file (heaven forbid!) or some other
+error might be detected by this program. Such errors might occur in a deeply
+nested procedure, so the procedure called |jump_out| has been added to transfer
+to the very end of the program with an error message.
+
+@d abort(#)==begin print_ln(' ',#); t_print_ln(' ',#); jump_out; end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{PKtype} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used.
+
+The next few sections of \.{PKtype} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{PKtype} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{PKtype}.
+So we shall assume that the \PASCAL\ system being used for \.{PKtype}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{PKtype} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Packed file format.
+The packed file format is a compact representation of the data contained in a
+\.{GF} file. The information content is the same, but packed (\.{PK}) files
+are almost always less than half the size of their \.{GF} counterparts. They
+are also easier to convert into a raster representation because they do not
+have a profusion of \\{paint}, \\{skip}, and \\{new\_row} commands to be
+separately interpreted. In addition, the \.{PK} format expressly forbids
+\&{special} commands within a character. The minimum bounding box for each
+character is explicit in the format, and does not need to be scanned for as in
+the \.{GF} format. Finally, the width and escapement values are combined with
+the raster information into character ``packets'', making it simpler in many
+cases to process a character.
+
+A \.{PK} file is organized as a stream of 8-bit bytes. At times, these bytes
+might be split into 4-bit nybbles or single bits, or combined into multiple
+byte parameters. When bytes are split into smaller pieces, the `first' piece
+is always the most significant of the byte. For instance, the first bit of
+a byte is the bit with value 128; the first nybble can be found by dividing
+a byte by 16. Similarly, when bytes are combined into multiple byte
+parameters, the first byte is the most significant of the parameter. If the
+parameter is signed, it is represented by two's-complement notation.
+
+The set of possible eight-bit values is separated into two sets, those that
+introduce a character definition, and those that do not. The values that
+introduce a character definition range from 0 to 239; byte values
+above 239 are interpreted as commands. Bytes that introduce character
+definitions are called flag bytes, and various fields within the byte indicate
+various things about how the character definition is encoded. Command bytes
+have zero or more parameters, and can never appear within a character
+definition or between parameters of another command, where they would be
+interpeted as data.
+
+A \.{PK} file consists of a preamble, followed by a sequence of one or more
+character definitions, followed by a postamble. The preamble command must
+be the first byte in the file, followed immediately by its parameters.
+Any number of character definitions may follow, and any command but the
+preamble command and the postamble command may occur between character
+definitions. The very last command in the file must be the postamble.
+
+@ The packed file format is intended to be easy to read and interpret by
+device drivers. The small size of the file reduces the input/output overhead
+each time a font is loaded. For those drivers that load and save each font
+file into memory, the small size also helps reduce the memory requirements.
+The length of each character packet is specified, allowing the character raster
+data to be loaded into memory by simply counting bytes, rather than
+interpreting each command; then, each character can be interpreted on a demand
+basis. This also makes it possible for a driver to skip a particular
+character quickly if it knows that the character is unused.
+
+@ First, the command bytes will be presented; then the format of the
+character definitions will be defined. Eight of the possible sixteen
+commands (values 240 through 255) are currently defined; the others are
+reserved for future extensions. The commands are listed below. Each command
+is specified by its symbolic name (e.g., \\{pk\_no\_op}), its opcode byte,
+and any parameters. The parameters are followed by a bracketed number
+telling how many bytes they occupy, with the number preceded by a plus sign if
+it is a signed quantity. (Four byte quantities are always signed, however.)
+
+\yskip\hang|pk_xxx1| 240 |k[1]| |x[k]|. This command is undefined in general;
+it functions as a $(k+2)$-byte \\{no\_op} unless special \.{PK}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string. It is recommended that |x| be a string having the form
+of a keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang\\{pk\_xxx2} 241 |k[2]| |x[k]|. Like |pk_xxx1|, but |0<=k<65536|.
+
+\yskip\hang\\{pk\_xxx3} 242 |k[3]| |x[k]|. Like |pk_xxx1|, but
+|0<=k<@t$2^{24}$@>|. \MF\ uses this when sending a \&{special} string whose
+length exceeds~255.
+
+\yskip\hang\\{pk\_xxx4} 243 |k[4]| |x[k]|. Like |pk_xxx1|, but |k| can be
+ridiculously large; |k| musn't be negative.
+
+\yskip\hang|pk_yyy| 244 |y[4]|. This command is undefined in general; it
+functions as a five-byte \\{no\_op} unless special \.{PK} reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a result of
+\&{numspecial} commands; the intent is to provide numeric parameters to
+\\{xxx} commands that immediately precede.
+
+\yskip\hang|pk_post| 245. Beginning of the postamble. This command is
+followed by enough |pk_no_op| commands to make the file a multiple
+of four bytes long. Zero through three bytes are usual, but any number
+is allowed.
+This should make the file easy to read on machines that pack four bytes to
+a word.
+
+\yskip\hang|pk_no_op| 246. No operation, do nothing. Any number of
+|pk_no_op|'s may appear between \.{PK} commands, but a |pk_no_op| cannot be
+inserted between a command and its parameters, between two parameters, or
+inside a character definition.
+
+\yskip\hang|pk_pre| 247 |i[1]| |k[1]| |x[k]| |ds[4]| |cs[4]| |hppp[4]|
+|vppp[4]|. Preamble command. Here, |i| is the identification byte of the
+file, currently equal to 89. The string |x| is merely a comment, usually
+indicating the source of the \.{PK} file. The parameters |ds| and |cs| are
+the design size of the file in $1/2^{20}$ points, and the checksum of the
+file, respectively. The checksum should match the \.{TFM} file and the
+\.{GF} files for this font. Parameters |hppp| and |vppp| are the ratios
+of pixels per point, horizontally and vertically, multiplied by $2^{16}$; they
+can be used to correlate the font with specific device resolutions,
+magnifications, and ``at sizes''. Usually, the name of the \.{PK} file is
+formed by concatenating the font name (e.g., cmr10) with the resolution at
+which the font is prepared in pixels per inch multiplied by the magnification
+factor, and the letters \.{pk}. For instance, cmr10 at 300 dots per inch
+should be named \.{cmr10.300pk}; at one thousand dots per inch and magstephalf,
+it should be named \.{cmr10.1095pk}.
+
+@ We put a few of the above opcodes into definitions for symbolic use by
+this program.
+
+@d pk_id = 89 {the version of \.{PK} file described}
+@d pk_xxx1 = 240 {\&{special} commands}
+@d pk_yyy = 244 {\&{numspecial} commands}
+@d pk_post = 245 {postamble}
+@d pk_no_op = 246 {no operation}
+@d pk_pre = 247 {preamble}
+@d pk_undefined == 248, 249, 250, 251, 252, 253, 254, 255
+
+@ The \.{PK} format has two conflicting goals: to pack character raster and
+size information as compactly as possible, while retaining ease of translation
+into raster and other forms. A suitable compromise was found in the use of
+run-encoding of the raster information. Instead of packing the individual
+bits of the character, we instead count the number of consecutive `black' or
+`white' pixels in a horizontal raster row, and then encode this number. Run
+counts are found for each row from left to right, traversing rows from the
+top to bottom. This is essentially the way the \.{GF} format works.
+Instead of presenting each row individually, however, we concatenate all
+of the horizontal raster rows into one long string of pixels, and encode this
+row. With knowledge of the width of the bit-map, the original character glyph
+can easily be reconstructed. In addition, we do not need special commands to
+mark the end of one row and the beginning of the next.
+
+Next, we place the burden of finding the minimum bounding box on the part
+of the font generator, since the characters will usually be used much more
+often than they are generated. The minimum bounding box is the smallest
+rectangle that encloses all `black' pixels of a character. We also
+eliminate the need for a special end of character marker, by supplying
+exactly as many bits as are required to fill the minimum bounding box, from
+which the end of the character is implicit.
+
+Let us next consider the distribution of the run counts. Analysis of several
+dozen pixel files at 300 dots per inch yields a distribution peaking at four,
+falling off slowly until ten, then a bit more steeply until twenty, and then
+asymptotically approaching the horizontal. Thus, the great majority of our
+run counts will fit in a four-bit nybble. The eight-bit byte is attractive for
+our run-counts, as it is the standard on many systems; however, the wasted four
+bits in the majority of cases seem a high price to pay. Another possibility
+is to use a Huffman-type encoding scheme with a variable number of bits for
+each run-count; this was rejected because of the overhead in fetching and
+examining individual bits in the file. Thus, the character raster definitions
+in the \.{PK} file format are based on the four-bit nybble.
+
+@ An analysis of typical pixel files yielded another interesting statistic:
+Fully 37\char`\%\
+of the raster rows were duplicates of the previous row. Thus, the \.{PK}
+format allows the specification of repeat counts, which indicate how many times
+a horizontal raster row is to be repeated. These repeated rows are taken out
+of the character glyph before individual rows are concatenated into the long
+string of pixels.
+
+For elegance, we disallow a run count of zero. The case of a null raster
+description should be gleaned from the character width and height being equal
+to zero, and no raster data should be read. No other zero counts are ever
+necessary. Also, in the absence of repeat counts, the repeat value is set to
+be zero (only the original row is sent.) If a repeat count is seen, it takes
+effect on the current row. The current row is defined as the row on which the
+first pixel of the next run count will lie. The repeat count is set back to
+zero when the last pixel in the current row is seen, and the row is sent out.
+
+This poses a problem for entirely black and entirely white rows, however. Let
+us say that the current row ends with four white pixels, and then we have five
+entirely empty rows, followed by a black pixel at the beginning of the next
+row, and the character width is ten pixels. We would like to use a repeat
+count, but there is no legal place to put it. If we put it before the white
+run count, it will apply to the current row. If we put it after, it applies
+to the row with the black pixel at the beginning. Thus, entirely white or
+entirely black repeated rows are always packed as large run counts (in this
+case, a white run count of 54) rather than repeat counts.
+
+@ Now we turn our attention to the actual packing of the run counts and
+repeat counts into nybbles. There are only sixteen possible nybble values.
+We need to indicate run counts and repeat counts. Since the run counts are
+much more common, we will devote the majority of the nybble values to them.
+We therefore indicate a repeat count by a nybble of 14 followed by a packed
+number, where a packed number will be explained later. Since the repeat
+count value of one is so common, we indicate a repeat one command by a single
+nybble of 15. A 14 followed by the packed number 1 is still legal for a
+repeat one count. The run counts are coded directly as packed
+numbers.
+
+For packed numbers, therefore, we have the nybble values 0 through 13. We
+need to represent the positive integers up to, say, $2^{31}-1$. We would
+like the more common smaller numbers to take only one or two nybbles, and
+the infrequent large numbers to take three or more. We could therefore
+allocate one nybble value to indicate a large run count taking three or more
+nybbles. We do this with the value 0.
+
+@ We are left with the values 1 through 13. We can allocate some of these, say
+|dyn_f|, to be one-nybble run counts.
+These will work for the run counts |1..dyn_f|. For subsequent run
+counts, we will use a nybble greater than |dyn_f|, followed by a second nybble,
+whose value can run from 0 through 15. Thus, the two-nybble values will
+run from |dyn_f+1..(13-dyn_f)*16+dyn_f|. We have our definition of large run
+count values now, being all counts greater than |(13-dyn_f)*16+dyn_f|.
+
+We can analyze our several dozen pixel files and determine an optimal value of
+|dyn_f|, and use this value for all of the characters. Unfortunately, values
+of |dyn_f| that pack small characters well tend to pack the large characters
+poorly, and values that pack large characters well are not efficient for the
+smaller characters. Thus, we choose the optimal |dyn_f| on a character basis,
+picking the value that will pack each individual character in the smallest
+number of nybbles. Legal values of |dyn_f| run from 0 (with no one-nybble run
+counts) to 13 (with no two-nybble run counts).
+
+@ Our only remaining task in the coding of packed numbers is the large run
+counts. We use a scheme suggested by D.~E.~Knuth
+@^Knuth, Donald Ervin@>
+that simply and elegantly represents arbitrarily large values. The
+general scheme to represent an integer |i| is to write its hexadecimal
+representation, with leading zeros removed. Then we count the number of
+digits, and prepend one less than that many zeros before the hexadecimal
+representation. Thus, the values from one to fifteen occupy one nybble;
+the values sixteen through 255 occupy three, the values 256 through 4095
+require five, etc.
+
+For our purposes, however, we have already represented the numbers one
+through |(13-dyn_f)*16+dyn_f|. In addition, the one-nybble values have
+already been taken by our other commands, which means that only the values
+from sixteen up are available to us for long run counts. Thus, we simply
+normalize our long run counts, by subtracting |(13-dyn_f)*16+dyn_f+1| and
+adding 16, and then we represent the result according to the scheme above.
+
+@ The final algorithm for decoding the run counts based on the above scheme
+looks like this, assuming that a procedure called \\{get\_nyb} is available
+to get the next nybble from the file, and assuming that the global
+|repeat_count| indicates whether a row needs to be repeated. Note that this
+routine is recursive, but since a repeat count can never directly follow
+another repeat count, it can only be recursive to one level.
+
+@<Packed number procedure@>=
+function pk_packed_num : integer ;
+var i, @!j : integer ;
+begin
+ i := get_nyb ;
+ if i = 0 then begin
+ repeat j := get_nyb ; incr(i) ; until j <> 0 ;
+ while i > 0 do begin j := j * 16 + get_nyb ; decr(i) ; end ;
+ pk_packed_num := j - 15 + (13-dyn_f)*16 + dyn_f ;
+ end else if i <= dyn_f then
+ pk_packed_num := i
+ else if i < 14 then
+ pk_packed_num := (i-dyn_f-1)*16+get_nyb+dyn_f+1
+ else begin
+ if repeat_count <> 0 then abort('Second repeat count for this row!') ;
+@.Second repeat count...@>
+ repeat_count := 1; {prevent recursion more than one level}
+ if i = 14 then repeat_count := pk_packed_num;
+ send_out(true, repeat_count) ;
+ pk_packed_num := pk_packed_num ;
+ end ;
+end ;
+
+@ For low resolution fonts, or characters with `gray' areas, run encoding can
+often make the character many times larger. Therefore, for those characters
+that cannot be encoded efficiently with run counts, the \.{PK} format allows
+bit-mapping of the characters. This is indicated by a |dyn_f| value of
+14. The bits are packed tightly, by concatenating all of the horizontal raster
+rows into one long string, and then packing this string eight bits to a byte.
+The number of bytes required can be calculated by |(width*height+7) div 8|.
+This format should only be used when packing the character by run counts takes
+more bytes than this, although, of course, it is legal for any character.
+Any extra bits in the last byte should be set to zero.
+
+@ At this point, we are ready to introduce the format for a character
+descriptor. It consists of three parts: a flag byte, a character preamble,
+and the raster data. The most significant four bits of the flag byte
+yield the |dyn_f| value for that character. (Notice that only values of
+0 through 14 are legal for |dyn_f|, with 14 indicating a bit mapped character;
+thus, the flag bytes do not conflict with the command bytes, whose upper nybble
+is always 15.) The next bit (with weight 8) indicates whether the first run
+count is a black count or a white count, with a one indicating a black count.
+For bit-mapped characters, this bit should be set to a zero. The next bit
+(with weight 4) indicates whether certain later parameters (referred to as size
+parameters) are given in one-byte or two-byte quantities, with a one indicating
+that they are in two-byte quantities. The last two bits are concatenated on to
+the beginning of the packet-length parameter in the character preamble,
+which will be explained below.
+
+However, if the last three bits of the flag byte are all set (normally
+indicating that the size parameters are two-byte values and that a 3 should be
+prepended to the length parameter), then a long format of the character
+preamble should be used instead of one of the short forms.
+
+Therefore, there are three formats for the character preamble; the one that
+is used depends on the least significant three bits of the flag byte. If the
+least significant three bits are in the range zero through three, the short
+format is used. If they are in the range four through six, the extended short
+format is used. Otherwise, if the least significant bits are all set, then
+the long form of the character preamble is used. The preamble formats are
+explained below.
+
+\yskip\hang Short form: |flag[1]| |pl[1]| |cc[1]| |tfm[3]| |dm[1]| |w[1]|
+|h[1]| |hoff[+1]| |voff[+1]|.
+If this format of the character preamble is used, the above
+parameters must all fit in the indicated number of bytes, signed or unsigned
+as indicated. Almost all of the standard \TeX\ font characters fit; the few
+exceptions are fonts such as \.{cminch}.
+
+\yskip\hang Extended short form: |flag[1]| |pl[2]| |cc[1]| |tfm[3]| |dm[2]|
+|w[2]| |h[2]| |hoff[+2]| |voff[+2]|. Larger characters use this extended
+format.
+
+\yskip\hang Long form: |flag[1]| |pl[4]| |cc[4]| |tfm[4]| |dx[4]| |dy[4]|
+|w[4]| |h[4]| |hoff[4]| |voff[4]|. This is the general format that
+allows all of the
+parameters of the \.{GF} file format, including vertical escapement.
+\vskip\baselineskip
+The |flag| parameter is the flag byte. The parameter |pl| (packet length)
+contains the offset
+of the byte following this character descriptor, with respect to the beginning
+of the |tfm| width parameter. This is given so a \.{PK} reading program can,
+once it has read the flag byte, packet length, and character code (|cc|), skip
+over the character by simply reading this many more bytes. For the two short
+forms of the character preamble, the last two bits of the flag byte should be
+considered the two most-significant bits of the packet length. For the short
+format, the true packet length might be calculated as |(flag mod 4)*256+pl|;
+for the short extended format, it might be calculated as
+|(flag mod 4)*65536+pl|.
+
+The |w| parameter is the width and the |h| parameter is the height in pixels
+of the minimum bounding box. The |dx| and |dy| parameters are the horizontal
+and vertical escapements, respectively. In the short formats, |dy| is assumed
+to be zero and |dm| is |dx| but in pixels;
+in the long format, |dx| and |dy| are both
+in pixels multiplied by $2^{16}$. The |hoff| is the horizontal offset from the
+upper left pixel to the reference pixel; the |voff| is the vertical offset.
+They are both given in pixels, with right and down being positive. The
+reference pixel is the pixel that occupies the unit square in \MF; the
+\MF\ reference point is the lower left hand corner of this pixel. (See the
+example below.)
+
+@ \TeX\ requires all characters that have the same character codes
+modulo 256 to have also the same |tfm| widths and escapement values. The \.{PK}
+format does not itself make this a requirement, but in order for the font to
+work correctly with the \TeX\ software, this constraint should be observed.
+(The standard version of \TeX\ cannot output character codes greater
+than 255, but extended versions do exist.)
+
+Following the character preamble is the raster information for the
+character, packed by run counts or by bits, as indicated by the flag byte.
+If the character is packed by run counts and the required number of nybbles
+is odd, then the last byte of the raster description should have a zero
+for its least significant nybble.
+
+@ As an illustration of the \.{PK} format, the character \char4\ from the font
+amr10 at 300 dots per inch will be encoded. This character was chosen
+because it illustrates some
+of the borderline cases. The raster for the character looks like this (the
+row numbers are chosen for convenience, and are not \MF's row numbers.)
+
+\vskip\baselineskip
+{\def\smbox{\vrule height 7pt width 7pt depth 0pt \hskip 3pt}%
+\catcode`\*=\active \let*=\smbox
+\centerline{\vbox{\baselineskip=10pt
+\halign{\hfil#\quad&&\hfil#\hfil\cr
+0& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+1& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+2& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+3& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+4& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+5& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+6& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+7\cr
+8\cr
+9& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+10& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+11& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+12& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+13& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+14& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+15& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+16& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+17& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+18& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+19\cr
+20\cr
+21\cr
+22& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+23& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+24& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+25& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+26& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+27& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+28&+& &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+&\hphantom{*}&\hphantom{*}\cr
+}}}}
+The width of the minimum bounding box for this character is 20; its height
+is 29. The `+' represents the reference pixel; notice how it lies outside the
+minimum bounding box. The |hoff| value is $-2$, and the |voff| is~28.
+
+The first task is to calculate the run counts and repeat counts. The repeat
+counts are placed at the first transition (black to white or white to black)
+in a row, and are enclosed in brackets. White counts are enclosed in
+parentheses. It is relatively easy to generate the counts list:
+\vskip\baselineskip
+\centerline{82 [2] (16) 2 (42) [2] 2 (12) 2 (4) [3]}
+\centerline{16 (4) [2] 2 (12) 2 (62) [2] 2 (16) 82}
+\vskip\baselineskip
+Note that any duplicated rows that are not all white or all black are removed
+before the run counts are calculated. The rows thus removed are rows 5, 6,
+10, 11, 13, 14, 15, 17, 18, 23, and 24.
+
+@ The next step in the encoding of this character is to calculate the optimal
+value of |dyn_f|. The details of how this calculation is done are not
+important here; suffice it to say that there is a simple algorithm that can
+determine the best value of |dyn_f| in one pass over the count list. For this
+character, the optimal value turns out to be 8 (atypically low). Thus, all
+count values less than or equal to 8 are packed in one nybble; those from
+nine to $(13-8)*16+8$ or 88 are packed in two nybbles. The run encoded values
+now become (in hex, separated according to the above list):
+\vskip\baselineskip
+\centerline{\tt D9 E2 97 2 B1 E2 2 93 2 4 E3}
+\centerline{\tt 97 4 E2 2 93 2 C5 E2 2 97 D9}
+\vskip\baselineskip\noindent
+which comes to 36 nybbles, or 18 bytes. This is shorter than the 73 bytes
+required for the bit map, so we use the run count packing.
+
+@ The short form of the character preamble is used because all of the
+parameters fit in their respective lengths. The packet length is therefore
+18 bytes for the raster, plus
+eight bytes for the character preamble parameters following the character
+code, or 26. The |tfm| width for this character is 640796, or {\tt 9C71C} in
+hexadecimal. The horizontal escapement is 25 pixels. The flag byte is
+88 hex, indicating the short preamble, the black first count, and the
+|dyn_f| value of 8. The final total character packet, in hexadecimal, is:
+\vskip\baselineskip
+$$\vbox{\halign{\hfil #\quad&&{\tt #\ }\cr
+Flag byte&88\cr
+Packet length&1A\cr
+Character code&04\cr
+|tfm| width&09&C7&1C\cr
+Horizontal escapement (pixels)&19\cr
+Width of bit map&14\cr
+Height of bit map&1D\cr
+Horizontal offset (signed)&FE\cr
+Vertical offset&1C\cr
+Raster data&D9&E2&97\cr
+&2B&1E&22\cr
+&93&24&E3\cr
+&97&4E&22\cr
+&93&2C&5E\cr
+&22&97&D9\cr}}$$
+
+@* Input and output.
+There are two types of files that this program must deal with---standard
+text files and files of bytes (packed files.)
+For our purposes, we shall consider an eight-bit byte to consist of the
+values |0..255|. If your system does not pack these values to a byte, it is
+no major difficulty; you must only insure that the input function
+|pk_byte| can read packed bytes.
+
+@<Types...@>=
+@!eight_bits=0..255; {packed file byte}
+@!byte_file=packed file of eight_bits ; {for packed file words}
+@^system dependencies@>
+
+@ @<Glob...@>=
+@!pk_file:byte_file; {where the input comes from}
+@!typ_file:text_file; {where the final output goes}
+@^system dependencies@>
+
+@ To prepare these files for input and output, we |reset| and |rewrite| them.
+An extension of \PASCAL\ is needed, since we want to associate files
+with external names that are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+@#
+procedure open_typ_file; {prepares to write text data to the |typ_file|}
+begin rewrite(typ_file,typ_name);
+end;
+
+@ We need a place to store the names of the input and output file, as well
+as a byte counter for the output file.
+
+@<Glob...@>=
+@!pk_name,@!typ_name:packed array[1..name_length] of char; {name of input
+ and output files}
+@!pk_loc:integer; {how many bytes have we read?}
+
+@ We also need a function that will get a single byte from the \.{pk} file.
+
+@p function pk_byte : eight_bits ;
+var temp : eight_bits ;
+begin
+ temp := pk_file^ ;
+ get(pk_file) ;
+ incr(pk_loc) ;
+ pk_byte := temp ;
+end ;
+
+@ Now we are ready to open the files.
+
+@<Open files@>=
+open_pk_file ;
+open_typ_file ;
+t_print_ln(banner) ;
+t_print('Input file: ') ;
+i := 1 ;
+while pk_name[i] <> ' ' do begin
+ t_print(pk_name[i]) ; incr(i) ;
+end ;
+t_print_ln(' ')
+
+@ As we are reading the packed file, we often need to fetch 16 and 32 bit
+quantities. Here we have two procedures to do this.
+
+@p function get_16 : integer ;
+var a : integer ;
+begin a := pk_byte ; get_16 := a * 256 + pk_byte ; end ;
+@#
+function get_32 : integer ;
+var a : integer ;
+begin a := get_16 ; if a > 32767 then a := a - 65536 ;
+get_32 := a * 65536 + get_16 ; end ;
+
+@ We still need the |term_pos| variable.
+
+@<Glob...@>=
+@!term_pos : integer ; {current terminal position}
+
+@ Now we read and check the preamble of the \.{PK} file. In the preamble, we
+find the |hppp|, |design_size|, |checksum|.
+
+@<Read preamble@>=
+if pk_byte <> pk_pre then abort('Bad PK file: pre command missing!') ;
+@.pre command missing@>
+if pk_byte <> pk_id then abort('Wrong version of PK file!') ;
+@.Wrong version of PK file@>
+j := pk_byte ;
+t_print('''') ;
+for i := 1 to j do t_print(xchr[pk_byte]) ;
+t_print_ln('''') ;
+design_size := get_32 ;
+t_print_ln('Design size = ',design_size:1) ;
+checksum := get_32 ;
+t_print_ln('Checksum = ',checksum:1) ;
+hppp := get_32 ; vppp := get_32 ;
+t_print('Resolution: horizontal = ',hppp:1,' vertical = ',vppp:1) ;
+magnification := round(hppp * 72.27 / 65536) ;
+t_print_ln(' (',magnification:1,' dpi)') ;
+if hppp <> vppp then print_ln('Warning: aspect ratio not 1:1!')
+
+@ Of course, we need to define the above variables.
+
+@<Glob...@>=
+@!magnification : integer ; {resolution at which pixel file is prepared}
+@!design_size : integer ; {design size in FIXes}
+@!checksum : integer ; {checksum of pixel file}
+@!hppp, @!vppp : integer ; {horizontal and vertical points per inch}
+
+@* Character unpacking.
+Here we simply unpack the character, writing the information we glean to the
+|typ_file|.
+
+@<Unpack and write character@>=
+t_print((pk_loc-1):1,': Flag byte = ',flag_byte:1) ;
+dyn_f := flag_byte div 16 ;
+flag_byte := flag_byte mod 16 ;
+turn_on := flag_byte >= 8 ;
+if turn_on then flag_byte := flag_byte - 8 ;
+if flag_byte = 7 then
+ @<Read long character preamble@>
+else if flag_byte > 3 then
+ @<Read extended short character preamble@>
+else
+ @<Read short character preamble@> ;
+t_print_ln(' Character = ',car:1,' Packet length = ',
+ packet_length:1) ;
+t_print_ln(' Dynamic packing variable = ',dyn_f:1) ;
+t_print(' TFM width = ',tfm_width:1,' dx = ',dx:1) ;
+if dy <> 0 then t_print_ln(' dy = ',dy:1) else t_print_ln(' ') ;
+t_print_ln(' Height = ',height:1,' Width = ',width:1,' X-offset = ',
+ x_off:1, ' Y-offset = ',y_off:1) ;
+@<Read and translate raster description@> ;
+if end_of_packet <> pk_loc then abort('Bad PK file: Bad packet length!')
+@.Bad packet length@>
+
+@ We need a whole lot of globals used but not defined up there.
+
+@<Glob...@>=
+@!i, @!j : integer ; {index pointers}
+@!flag_byte : integer ; {the byte that introduces the character definition}
+@!end_of_packet : integer ; {where we expect the end of the packet to be}
+@!width, @!height : integer ; {width and height of character}
+@!x_off, @!y_off : integer ; {x and y offsets of character}
+@!tfm_width : integer ; {character tfm width}
+@!tfms : array [0..255] of integer ; {character tfm widths}
+@!dx, @!dy : integer ; {escapement values}
+@!dxs, @!dys : array [0..255] of integer ; {escapement values}
+@!status : array[0..255] of boolean ; {has the character been seen?}
+@!dyn_f : integer ; {dynamic packing variable}
+@!car : integer ; {the character we are reading}
+@!packet_length : integer ; {the length of the character packet}
+
+@ Now, the preamble reading modules. First, we have the general case: the
+long character preamble format.
+
+@<Read long character preamble@>=
+begin
+ packet_length := get_32 ; car := get_32 ;
+ end_of_packet := packet_length + pk_loc ;
+ packet_length := packet_length + 9 ;
+ tfm_width := get_32 ;
+ dx := get_32 ; dy := get_32 ;
+ width := get_32 ;
+ height := get_32 ;
+ x_off := get_32 ; y_off := get_32 ;
+end
+
+@ This module reads the character preamble with double byte parameters.
+
+@<Read extended short character preamble@>=
+begin
+ packet_length := (flag_byte - 4) * 65536 + get_16 ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ packet_length := packet_length + 4 ;
+ i := pk_byte ;
+ tfm_width := i * 65536 + get_16 ;
+ dx := get_16 * 65536 ;
+ dy := 0 ;
+ width := get_16 ;
+ height := get_16 ;
+ x_off := get_16 ; y_off := get_16 ;
+ if x_off > 32767 then x_off := x_off - 65536 ;
+ if y_off > 32767 then y_off := y_off - 65536 ;
+end
+
+@ Here we read the most common character preamble, that with single byte
+parameters.
+
+@<Read short character preamble@>=
+begin
+ packet_length := flag_byte * 256 + pk_byte ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ packet_length := packet_length + 3 ;
+ i := pk_byte ;
+ tfm_width := i * 65536 + get_16 ;
+ dx := pk_byte * 65536 ;
+ dy := 0 ;
+ width := pk_byte ;
+ height := pk_byte ;
+ x_off := pk_byte ; y_off := pk_byte ;
+ if x_off > 127 then x_off := x_off - 256 ;
+ if y_off > 127 then y_off := y_off - 256 ;
+end
+
+@ Now we have the most important part of the program, where we actually
+interpret the commands in the raster description. First of all, we need
+a procedure to get a single nybble from the file, as well as one to get
+a single bit.
+
+@p function get_nyb : integer ;
+var temp : eight_bits ;
+begin
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 16 ;
+ end ;
+ temp := input_byte div bit_weight ;
+ input_byte := input_byte - temp * bit_weight ;
+ bit_weight := bit_weight div 16 ;
+ get_nyb := temp ;
+end ;
+@#
+function get_bit : boolean ;
+var temp : boolean ;
+begin
+ bit_weight := bit_weight div 2 ;
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 128 ;
+ end ;
+ temp := input_byte >= bit_weight ;
+ if temp then
+ input_byte := input_byte - bit_weight ;
+ get_bit := temp ;
+end ;
+
+@ We also need a function to write output to the screen. We put as many
+counts on a line as possible, to reduce the volume of output. Each count
+will appear as a number, with white counts enclosed by parentheses and repeat
+counts by brackets.
+
+@p procedure send_out(@!repeat_count: boolean ; @!value : integer ) ;
+var i, len : integer ;
+begin
+ i := 10 ; len := 1 ;
+ while value >= i do begin incr(len) ; i := i * 10 ; end ;
+ if repeat_count or not turn_on then len := len + 2 ;
+ if term_pos + len > 78 then begin
+ term_pos := len + 2 ; t_print_ln(' ') ; t_print(' ') ;
+ end else term_pos := term_pos + len ;
+ if repeat_count then t_print('[', value:1, ']')
+ else if turn_on then t_print(value:1)
+ else t_print('(', value:1, ')') ;
+end ;
+@<Packed number procedure@>
+
+@ Now, the globals to help communication between these procedures.
+
+@<Glob...@>=
+@!input_byte : eight_bits ; {the byte we are currently decimating}
+@!bit_weight : eight_bits ; {weight of the current bit}
+@!nybble : eight_bits ; {the current nybble}
+
+@ And the main procedure.
+
+@<Read and translate raster description@>=
+bit_weight := 0 ;
+if dyn_f = 14 then
+ @<Get raster by bits@>
+else @<Create normally packed raster@>
+
+@ If |dyn_f=14|, then we need to get the raster representation
+one bit at a time.
+
+@<Get raster by bits@>=
+begin
+for i := 1 to height do begin
+ t_print(' ') ;
+ for j := 1 to width do
+ if get_bit then t_print('*')
+ else t_print('.') ;
+ t_print_ln(' ') ;
+end;
+end
+
+@ Otherwise, we translate the bit counts into the raster rows. |count|
+contains the number of bits of the current color, and |turn_on| indicates
+whether or not they should be black. |rows_left| contains the number of
+rows to be sent.
+
+@<Create normally packed raster@>=
+begin
+term_pos := 2 ;
+t_print(' ') ;
+rows_left := height ;
+h_bit := width ;
+repeat_count := 0 ;
+while rows_left > 0 do begin
+ count := pk_packed_num ;
+ send_out(false, count) ;
+ if count >= h_bit then begin
+ rows_left := rows_left - repeat_count - 1 ;
+ repeat_count := 0 ;
+ count := count - h_bit ;
+ h_bit := width ;
+ rows_left := rows_left - count div width ;
+ count := count mod width ;
+ end ;
+ h_bit := h_bit - count ;
+ turn_on := not turn_on ;
+end ;
+t_print_ln(' ') ;
+if (rows_left <> 0) or (h_bit <> width) then
+ abort('Bad PK file: More bits than required!');
+@.More bits than required@>
+end
+
+@ We need to declare the repeat flag, bit counter, and color flag here.
+
+@<Glob...@>=
+@!repeat_count : integer ; {how many times to repeat the next row?}
+@!rows_left : integer ; {how many rows left?}
+@!turn_on : boolean ; {are we black here?}
+@!h_bit : integer ; {what is our horizontal position?}
+@!count : integer ; {how many bits of current color left?}
+
+@ If any specials are found, we write them out here.
+
+@d four_cases(#)==#,#+1,#+2,#+3
+
+@p procedure skip_specials ;
+var @!i, @!j: integer ;
+begin
+ repeat
+ flag_byte := pk_byte ;
+ if flag_byte >= 240 then
+ case flag_byte of
+ four_cases(pk_xxx1):
+begin
+ t_print((pk_loc-1):1,': Special: ''') ;
+ i := 0 ;
+ for j := pk_xxx1 to flag_byte do i := 256 * i + pk_byte ;
+ for j := 1 to i do t_print(xchr[pk_byte]) ;
+ t_print_ln('''') ;
+end ;
+ pk_yyy : t_print_ln((pk_loc-1):1,': Num special: ',get_32:1) ;
+ pk_post : t_print_ln((pk_loc-1):1,': Postamble') ;
+ pk_no_op : t_print_ln((pk_loc-1):1,': No op') ;
+ pk_pre, pk_undefined : abort('Unexpected ', flag_byte:1,'!') ;
+@.Unexpected bbb@>
+ endcases ;
+ until (flag_byte < 240) or (flag_byte = pk_post) ;
+end ;
+
+@* Terminal communication.
+We must get the file names and determine whether input is to be in
+hexadecimal or binary. To do this, we use the standard input path
+name. We need a procedure to flush the input buffer. For most systems,
+this will be an empty statement. For other systems, a |print_ln| will
+provide a quick fix. We also need a routine to get a line of input from
+the terminal. On some systems, a simple |read_ln| will do. Finally,
+a macro to print a string to the first blank is required.
+
+@d flush_buffer == begin end
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+
+@ @p procedure dialog ;
+var i : integer ; {index variable}
+buffer : packed array [1..name_length] of char; {input buffer}
+begin
+ for i := 1 to name_length do begin
+ typ_name[i] := ' ' ;
+ pk_name[i] := ' ' ;
+ end;
+ print('Input file name: ') ;
+ flush_buffer ;
+ get_line(pk_name) ;
+ print('Output file name: ') ;
+ flush_buffer ;
+ get_line(typ_name) ;
+end ;
+
+@* The main program.
+Now that we have all the pieces written, let us put them together.
+
+@p begin
+initialize ;
+dialog ;
+@<Open files@> ;
+@<Read preamble@> ;
+skip_specials ;
+while flag_byte <> pk_post do begin
+ @<Unpack and write character@> ;
+ skip_specials ;
+end ;
+j := 0 ;
+while not eof(pk_file) do begin
+ i := pk_byte ;
+ if i <> pk_no_op then abort('Bad byte at end of file: ',i:1) ;
+@.Bad byte at end of file@>
+ t_print_ln((pk_loc-1):1,': No op') ;
+ incr(j) ;
+end ;
+t_print_ln(pk_loc:1,' bytes read from packed file.');
+final_end :
+end .
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtype} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/pltotf.ch b/Build/source/texk/web2c/pltotf.ch
new file mode 100644
index 00000000000..64e2f9fb97b
--- /dev/null
+++ b/Build/source/texk/web2c/pltotf.ch
@@ -0,0 +1,300 @@
+% pltotf.ch for C compilation with web2c.
+%
+% 04/04/83 (PC) Original version, made to work with version 1.2 of PLtoTF.
+% 04/16/83 (PC) Brought up to version 1.3 of PLtoTF.
+% 06/30/83 (HWT) Revised changefile format for version 1.7 Tangle
+% 07/28/83 (HWT) Brought up to version 2
+% 12/19/86 (ETM) Brought up to version 2.1
+% 07/05/87 (ETM) Brought up to version 2.3
+% 03/22/88 (ETM) Converted for use with WEB to C
+% 11/29/89 (KB) Version 3.
+% 01/16/90 (SR) Version 3.2.
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{PL$\,$\lowercase{to}$\,$TF changes for C}
+@z
+
+@x [still 2] No banner unless verbose.
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+@z
+
+@x [3] Larger constants.
+@!buf_size=60; {length of lines displayed in error messages}
+@!max_header_bytes=100; {four times the maximum number of words allowed in
+ the \.{TFM} file header block, must be 1024 or less}
+@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed}
+@!max_lig_steps=5000;
+ {maximum length of ligature program, must be at most $32767-257=32510$}
+@!max_kerns=500; {the maximum number of distinct kern values}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@y
+@!buf_size=3000; {length of lines displayed in error messages}
+@!max_header_bytes=1000; {four times the maximum number of words allowed in
+ the \.{TFM} file header block, must be 1024 or less}
+@!max_param_words=300; {the maximum number of \.{fontdimen} parameters allowed}
+@!max_lig_steps=32510;
+ {maximum length of ligature program, must be at most $32767-257=32510$}
+@!max_kerns=5000; {the maximum number of distinct kern values}
+@!hash_size=32579; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@z
+
+@x [6] Open PL file.
+reset(pl_file);
+@y
+reset (pl_file, pl_name);
+if verbose then begin
+ print (banner);
+ print_ln (version_string);
+end;
+@z
+
+@x [16] Open TFM file.
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(tfm_file);
+@y
+@ On some systems you may have to do something special to write a
+packed file of bytes. It's no problem in C.
+@^system dependencies@>
+
+@<Set init...@>=
+rewritebin (tfm_file, tfm_name);
+@z
+
+@x [79] `index' might be a library routine.
+|k|th element of its list.
+@y
+|k|th element of its list.
+@d index == index_var
+@z
+
+@x [103] No output (except errors) unless verbose.
+@<Print |c| in octal notation@>;
+@y
+if verbose then @<Print |c| in octal notation@>;
+@z
+
+@x [115] Output of reals.
+@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
+@.I had to round...@>
+ #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
+@y
+@ @d round_message(#)==if delta>0 then begin print('I had to round some ',
+@.I had to round...@>
+ #,'s by '); print_real((((delta+1) div 2)/@'4000000),1,7);
+ print_ln(' units.'); end
+@z
+
+% [118] Change the name of the variable `class', since AIX 3.1's <math.h>
+% defines a function by that name.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d pending=4 {$f(x,y)$ is being evaluated}
+@y
+@d pending=4 {$f(x,y)$ is being evaluated}
+@d class == class_var {Avoid problems with AIX \.{<math.h>}}
+@z
+
+% [123] web2c can't handle these mutually recursive procedures.
+% But let's do a fake definition of f here, so that it gets into web2c's
+% symbol table...
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+@y
+@p
+ifdef('notdef')
+function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+endif('notdef')
+@z
+
+% [124] ... and then really define it now.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p function f;
+@y
+@p function f(@!h,@!x,@!y:indx):indx;
+@z
+
+@x [127] Fix up output of bytes.
+@d out(#)==write(tfm_file,#)
+@y
+@d out(#)==putbyte(#,tfm_file)
+@z
+
+@x [136] Fix output of reals.
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if abs(x/design_units)>=16.0 then
+ begin print_ln('The relative dimension ',x/@'4000000:1:3,
+ ' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then print(' =',design_units/@'200000:1:3,
+ ' designunits');
+@y
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if fabs(x/design_units)>=16.0 then
+ begin print('The relative dimension ');
+ print_real(x/@'4000000,1,3);
+ print_ln(' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then begin print(' =');
+ print_real(design_units/@'200000,1,3);
+ print(' designunits');
+ end;
+@z
+
+% [141] char_remainder[c] is unsigned, and label_table[sort_ptr].rr
+% might be -1, and if -1 is coerced to being unsigned, it will be bigger
+% than anything else.
+@x
+ while label_table[sort_ptr].rr>char_remainder[c] do
+@y
+ while label_table[sort_ptr].rr>intcast(char_remainder[c]) do
+@z
+
+@x [147] Be quiet unless verbose.
+read_input; print_ln('.');@/
+@y
+read_input;
+if verbose then print_ln('.');
+@z
+
+@x [148] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PLtoTF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 3; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('pltotf');
+
+ end else if argument_is ('help') then begin
+ usage_help (PLTOTF_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.E. Knuth');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one or two remaining arguments.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ write_ln (stderr, 'pltotf: Need one or two file arguments.');
+ usage ('pltotf');
+ end;
+
+ pl_name := extend_filename (cmdline (optind), 'pl');
+
+ {If an explicit output filename isn't given, construct it from |pl_name|.}
+ if optind + 2 = argc then begin
+ tfm_name := extend_filename (cmdline (optind + 1), 'tfm');
+ end else begin
+ tfm_name := basename_change_suffix (pl_name, '.pl', '.tfm');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@
+@<Initialize the option...@> =
+verbose := false;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!tfm_name,@!pl_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/pltotf.rc b/Build/source/texk/web2c/pltotf.rc
new file mode 100644
index 00000000000..ad613afe777
--- /dev/null
+++ b/Build/source/texk/web2c/pltotf.rc
@@ -0,0 +1,34 @@
+/* pltotf.rc: pltotf resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " pltotf 3.5"
+
+#define VER_INTERNALNAME_STR "pltotf"
+#define VER_ORIGINALFILENAME_STR "pltotf.exe"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#define VER_FILEDESCRIPTION_STR "PL-to-TFM file converter"
+
+#include <texlive.version>
+
+/* pltotf.rc ends here */
diff --git a/Build/source/texk/web2c/pltotf.web b/Build/source/texk/web2c/pltotf.web
new file mode 100644
index 00000000000..e54f4f3d7b4
--- /dev/null
+++ b/Build/source/texk/web2c/pltotf.web
@@ -0,0 +1,2514 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was implemented in January 1982.
+% In February 1982 a new restriction on ligature steps was added.
+% In June 1982 the routines were divided into smaller pieces for IBM people.
+% Hex was added in September 1982, and the result became "Version 1".
+% Version 1.1 fixed a bug in section 28 (since eoln is undefined after eof).
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 1.2 fixed a bug in section 115 (TOP, MID, and BOT can be zero)
+% Version 1.3 (April 1983) blanked out unused BCPL header bytes
+% Version 2 (July 1983) was released with TeX version 0.999.
+% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN.
+% Version 2.2 (May 1985) added checksum computation to match METAFONT.
+% Version 2.3 (August 1985) introduced `backup' to fix a minor bug.
+% Version 3 (October 1989) introduced extended ligature features.
+% Version 3.1 (November 1989) fixed two bugs (notably min_nl:=0).
+% Version 3.2 (December 1989) improved `shorten', increased max_letters.
+% Version 3.3 (September 1990) fixed `nonexistent char 0' (John Gourlay).
+% Version 3.4 (March 1991) has more robust `out_scaled' (Wayne Sullivan).
+% Version 3.5 (March 1995) initialized lk_step_ended (Armin K\"ollner).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=logo10 % for the METAFONT logo
+\def\MF{{\logo METAFONT}}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{PL\lowercase{to}TF}
+\def\contentspagenumber{301}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont PLtoTF} processor}
+ \vskip 15pt
+ \centerline{(Version 3.5, March 1995)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{PLtoTF} utility program converts property-list (``\.{PL}'')
+files into equivalent \TeX\ font metric (``\.{TFM}'') files. It also
+makes a thorough check of the given \.{PL} file, so that the \.{TFM}
+file should be acceptable to \TeX.
+
+The first \.{PLtoTF} program was designed by Leo Guibas in the summer of
+1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw
+also had a significant effect on the evolution of the present code.
+
+Extensions for an enhanced ligature mechanism were added by the author in 1989.
+
+The |banner| string defined here should be changed whenever \.{PLtoTF}
+gets modified.
+
+@d banner=='This is PLtoTF, Version 3.5' {printed when the program starts}
+
+@ This program is written entirely in standard \PASCAL, except that
+it has to do some slightly system-dependent character code conversion
+on input. Furthermore, lower case letters are used in error messages;
+they could be converted to upper case if necessary. The input is read
+from |pl_file|, and the output is written on |tfm_file|; error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program PLtoTF(@!pl_file,@!tfm_file,@!output);
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{PLtoTF}'s capacity.
+
+@<Constants...@>=
+@!buf_size=60; {length of lines displayed in error messages}
+@!max_header_bytes=100; {four times the maximum number of words allowed in
+ the \.{TFM} file header block, must be 1024 or less}
+@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed}
+@!max_lig_steps=5000;
+ {maximum length of ligature program, must be at most $32767-257=32510$}
+@!max_kerns=500; {the maximum number of distinct kern values}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* Property list description of font metric data.
+The idea behind \.{PL} files is that precise details about fonts, i.e., the
+facts that are needed by typesetting routines like \TeX, sometimes have to
+be supplied by hand. The nested property-list format provides a reasonably
+convenient way to do this.
+
+A good deal of computation is necessary to parse and process a
+\.{PL} file, so it would be inappropriate for \TeX\ itself to do this
+every time it loads a font. \TeX\ deals only with the compact descriptions
+of font metric data that appear in \.{TFM} files. Such data is so compact,
+however, it is almost impossible for anybody but a computer to read it.
+The purpose of \.{PLtoTF} is to convert from a human-oriented file of text
+to a computer-oriented file of binary numbers.
+
+@<Glob...@>=
+@!pl_file:text;
+
+@ @<Set init...@>=
+reset(pl_file);
+
+@ A \.{PL} file is a list of entries of the form
+$$\.{(PROPERTYNAME VALUE)}$$
+where the property name is one of a finite set of names understood by
+this program, and the value may itself in turn be a property list.
+The idea is best understood by looking at an example, so let's consider
+a fragment of the \.{PL} file for a hypothetical font.
+$$\vbox{\halign{\.{#}\hfil\cr
+(FAMILY NOVA)\cr
+(FACE F MIE)\cr
+(CODINGSCHEME ASCII)\cr
+(DESIGNSIZE D 10)\cr
+(DESIGNUNITS D 18)\cr
+(COMMENT A COMMENT IS IGNORED)\cr
+(COMMENT (EXCEPT THIS ONE ISN'T))\cr
+(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr
+\qquad\qquad IT SAYS IT ISN'T))\cr
+(FONTDIMEN\cr
+\qquad (SLANT R -.25)\cr
+\qquad (SPACE D 6)\cr
+\qquad (SHRINK D 2)\cr
+\qquad (STRETCH D 3)\cr
+\qquad (XHEIGHT R 10.55)\cr
+\qquad (QUAD D 18)\cr
+\qquad )\cr
+(LIGTABLE\cr
+\qquad (LABEL C f)\cr
+\qquad (LIG C f O 200)\cr
+\qquad (SKIP D 1)\cr
+\qquad (LABEL O 200)\cr
+\qquad (LIG C i O 201)\cr
+\qquad (KRN O 51 R 1.5)\cr
+\qquad (/LIG C ? C f)\cr
+\qquad (STOP)\cr
+\qquad )\cr
+(CHARACTER C f\cr
+\qquad (CHARWD D 6)\cr
+\qquad (CHARHT R 13.5)\cr
+\qquad (CHARIC R 1.5)\cr
+\qquad )\cr}}$$
+This example says that the font whose metric information is being described
+belongs to the hypothetical
+\.{NOVA} family; its face code is medium italic extended;
+and the characters appear in ASCII code positions. The design size is 10 points,
+and all other sizes in this \.{PL} file are given in units such that 18 units
+equals the design size. The font is slanted with a slope of $-.25$ (hence the
+letters actually slant backward---perhaps that is why the family name is
+\.{NOVA}). The normal space between words is 6 units (i.e., one third of
+the 18-unit design size), with glue that shrinks by 2 units or stretches by 3.
+The letters for which accents don't need to be raised or lowered are 10.55
+units high, and one em equals 18 units.
+
+The example ligature table is a bit trickier. It specifies that the
+letter \.f followed by another \.f is changed to code @'200, while
+code @'200 followed by \.i is changed to @'201; presumably codes @'200
+and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases
+\.f and @'200, if the following character is the code @'51 (which is a
+right parenthesis), an additional 1.5 units of space should be inserted
+before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or
+\.{KRN} command, which in this case is the second \.{LIG}; in this way
+two different ligature/kern programs can come together.)
+Finally, if either \.f or @'200 is followed by a question mark,
+the question mark is replaced by \.f and the ligature program is
+started over. (Thus, the character pair `\.{f?}' would actually become
+the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To
+avoid this restart procedure, the \.{/LIG} command could be replaced
+by \.{/LIG>}; then `\.{f?} would become `f\kern0ptf' and `\.{f?f}'
+would become `f\kern0ptff'.)
+
+Character \.f itself is 6 units wide and 13.5 units tall, in this example.
+Its depth is zero (since \.{CHARDP} is not given), and its italic correction
+is 1.5 units.
+
+@ The example above illustrates most of the features found in \.{PL} files.
+Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a
+string as their value; this string continues until the first unmatched
+right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT}
+and \.{LABEL}, take a number as their value. This number can be expressed in
+a variety of ways, indicated by a prefixed code; \.D stands for decimal,
+\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and
+\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as
+their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and
+\.{CHARACTER}, have more complicated values that involve property lists.
+
+A property name is supposed to be used only in an appropriate property
+list. For example, \.{CHARWD} shouldn't occur on the outer level or
+within \.{FONTDIMEN}.
+
+The individual property-and-value pairs in a property list can appear in
+any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the above
+example, although the \.{TFM} file always puts the stretch parameter first.
+One could even give the information about characters like `\.f' before
+specifying the number of units in the design size, or before specifying the
+ligature and kerning table. However, the \.{LIGTABLE} itself is an exception
+to this rule; the individual elements of the \.{LIGTABLE} property list
+can be reordered only to a certain extent without changing the meaning
+of that table.
+
+If property-and-value pairs are omitted, a default value is used. For example,
+we have already noted that the default for \.{CHARDP} is zero. The default
+for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated
+below.
+
+If the same property name is used more than once, \.{PLtoTF} will not notice
+the discrepancy; it simply uses the final value given. Once again, however, the
+\.{LIGTABLE} is an exception to this rule; \.{PLtoTF} will complain if there
+is more than one label for some character. And of course many of the
+entries in the \.{LIGTABLE} property list have the same property name.
+
+From these rules, you can guess (correctly) that \.{PLtoTF} operates in four
+main steps. First it assigns the default values to all properties; then it scans
+through the \.{PL} file, changing property values as new ones are seen; then
+it checks the information and corrects any problems; and finally it outputs
+the \.{TFM} file.
+
+@ Instead of relying on a hypothetical example, let's consider a complete
+grammar for \.{PL} files. At the outer level, the following property names
+are valid:
+
+\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a
+nonnegative integer less than $2^{32}$, is used to identify a particular
+version of a font; it should match the check sum value stored with the font
+itself. An explicit check sum of zero is used to bypass
+check sum testing. If no checksum is specified in the \.{PL} file,
+\.{PLtoTF} will compute the checksum that \MF\ would compute from the
+same data.
+
+\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which
+should be a real number in the range |1.0<=x<2048|, represents the default
+amount by which all quantities will be scaled if the font is not loaded
+with an `\.{at}' specification. For example, if one says
+`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM}
+file is ignored and effectively replaced by 15 points; but if one simply
+says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is
+always in units of printer's points.
+
+\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value
+should be a positive real number; it says how many units equals the design
+size (or the eventual `\.{at}' size, if the font is being scaled). For
+example, suppose you have a font that has been digitized with 600 pixels per
+em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}'
+if you wanted to give all of your measurements in units of pixels.
+
+\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 40.
+It identifies the correspondence between the numeric codes and font characters.
+(\TeX\ ignores this information, but other software programs make use of it.)
+
+\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 20.
+It identifies the name of the family to which this font belongs, e.g.,
+`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for
+example, when converting \.{DVI} files to \.{PRESS} files for Xerox
+equipment.)
+
+\yskip\hang\.{FACE} (one-byte value). This number, which must lie between
+0 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its
+family. For example, bold italic condensed fonts might have the same family name
+as light roman extended fonts, differing only in their face byte. (\TeX\
+ignores this information; but it is needed, for example, when converting
+\.{DVI} files to \.{PRESS} files for Xerox equipment.)
+
+\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The
+value should start with either `\.T' (true) or `\.F' (false). If true, character
+codes less than 128 cannot lead to codes of 128 or more via ligatures or
+charlists or extensible characters. (\TeX82 ignores this flag, but older
+versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.)
+\.{PLtoTF} computes the correct value of this flag and gives an error message
+only if a claimed ``true'' value is incorrect.
+
+\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value).
+The one-byte value should be between 18 and a maximum limit that can be
+raised or lowered depending on the compile-time setting of |max_header_bytes|.
+The four-byte value goes into the header word whose index is the one-byte
+value; for example, to set |header[18]:=1|, one may write
+`\.{(HEADER D 18 O 1)}'. This notation is used for header information that
+is presently unnamed. (\TeX\ ignores it.)
+
+\yskip\hang\.{FONTDIMEN} (property list value). See below for the names
+allowed in this property list.
+
+\yskip\hang\.{LIGTABLE} (property list value). See below for the rules
+about this special kind of property list.
+
+\yskip\hang\.{BOUNDARYCHAR} (one-byte value). If this character appears in
+a \.{LIGTABLE} command, it matches ``end of word'' as well as itself.
+If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs
+within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning.
+
+\yskip\hang\.{CHARACTER}. The value is a one-byte integer followed by
+a property list. The integer represents the number of a character that is
+present in the font; the property list of a character is defined below.
+The default is an empty property list.
+
+@ Numeric property list values can be given in various forms identified by
+a prefixed letter.
+
+\yskip\hang\.C denotes an ASCII character, which should be a standard visible
+character that is not a parenthesis. The numeric value will therefore be
+between @'41 and @'176 but not @'50 or @'51.
+
+\yskip\hang\.D denotes a decimal integer, which must be nonnegative and
+less than 256. (Use \.R for larger values or for negative values.)
+
+\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes
+are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC},
+\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE},
+\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively.
+
+\yskip\hang\.O denotes an unsigned octal integer, which must be less than
+$2^{32}$, i.e., at most `\.{O 37777777777}'.
+
+\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than
+$2^{32}$, i.e., at most `\.{H FFFFFFFF}'.
+
+\yskip\hang\.R denotes a real number in decimal notation, optionally preceded
+by a `\.+' or `\.-' sign, and optionally including a decimal point. The
+absolute value must be less than 2048.
+
+@ The property names allowed in a \.{FONTDIMEN} property list correspond to
+various \TeX\ parameters, each of which has a (real) numeric value. All
+of the parameters except \.{SLANT} are in design units. The admissible
+names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT},
+\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1},
+\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP},
+\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters
+1~to~22. The alternate names \.{DEFAULTRULETHICKNESS},
+\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3},
+\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters
+8 to 13.
+
+The notation `\.{PARAMETER} $n$' provides another way to specify the
+$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way
+to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive
+and less than |max_param_words|.
+
+@ The elements of a \.{CHARACTER} property list can be of six different types.
+
+\yskip\hang\.{CHARWD} (real value) denotes the character's width in
+design units.
+
+\yskip\hang\.{CHARHT} (real value) denotes the character's height in
+design units.
+
+\yskip\hang\.{CHARDP} (real value) denotes the character's depth in
+design units.
+
+\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in
+design units.
+
+\yskip\hang\.{NEXTLARGER} (one-byte value), specifies the character that
+follows the present one in a ``charlist.'' The value must be the number of a
+character in the font, and there must be no infinite cycles of supposedly
+larger and larger characters.
+
+\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character.
+This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot
+both be used within the same \.{CHARACTER} list.
+
+\yskip\noindent
+The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID},
+\.{BOT} or \.{REP}; the values are integers, which must be zero or the number
+of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means
+that the corresponding piece of the extensible character is absent. A nonzero
+value, or a \.{REP} value of zero, denotes the character code used to make
+up the top, middle, bottom, or replicated piece of an extensible character.
+
+@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a
+program in a simple command language that \TeX\ uses for ligatures and kerns.
+If several \.{LIGTABLE} lists appear, they are effectively concatenated into
+a single list.
+
+\yskip\hang\.{LABEL} (one-byte value) means that the program for the
+stated character value starts here. The integer must be the number of a
+character in the font; its \.{CHARACTER} property list must not have a
+\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step
+must follow.
+
+\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for
+beginning-of-word ligatures starts here.
+
+\yskip\hang\.{LIG} (two one-byte values). The instruction `\.{(LIG} $c$ $r$\.)'
+means, ``If the next character is $c$, then insert character~$r$ and
+possibly delete the current character and/or~$c$;
+otherwise go on to the next instruction.''
+Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately
+preceded or followed by a slash, and then immediately followed by \.>
+characters not exceeding the number of slashes. Thus there are eight
+possible forms:
+$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil
+\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$
+The slashes specify retention of the left or right original character; the
+\.> signs specify passing over the result without further ligature processing.
+
+\yskip\hang\.{KRN} (a one-byte value and a real value). The instruction
+`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert
+a blank space of width $r$ between the current character character and $c$;
+otherwise go on to the next intruction.'' The value of $r$, which is in
+design units, is often negative. Character code $c$ must exist
+in the font.
+
+\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
+It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL}
+or \.{STOP} or \.{SKIP}.
+
+\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies
+continuation of a ligature/kern program after the specified number of \.{LIG}
+or \.{KRN} steps has been skipped over. The number of subsequent \.{LIG} and
+\.{KRN} instructions must therefore exceed this specified amount.
+
+@ In addition to all these possibilities, the property name \.{COMMENT} is
+allowed in any property list. Such comments are ignored.
+
+@ So that is what \.{PL} files hold. The next question is, ``What about
+\.{TFM} files?'' A complete answer to that question appears in the
+documentation of the companion program, \.{TFtoPL}, so it will not
+be repeated here. Suffice it to say that a \.{TFM} file stores all of the
+relevant font information in a sequence of 8-bit bytes. The number of
+bytes is always a multiple of 4, so we could regard the \.{TFM} file
+as a sequence of 32-bit words; but \TeX\ uses the byte interpretation,
+and so does \.{PLtoTF}. Note that the bytes are considered to be unsigned
+numbers.
+
+@<Glob...@>=
+@!tfm_file:packed file of 0..255;
+
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(tfm_file);
+
+@* Basic input routines.
+For the purposes of this program, a |byte| is an unsigned eight-bit quantity,
+and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes
+correspond to one-character constants like \.{"A"} in \.{WEB} language.
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!ASCII_code=@'40..@'177; {standard ASCII code numbers}
+
+@ One of the things \.{PLtoTF} has to do is convert characters of strings
+to ASCII form, since that is the code used for the family name and the
+coding scheme in a \.{TFM} file. An array |xord| is used to do the
+conversion from |char|; the method below should work with little or no change
+on most \PASCAL\ systems.
+@^system dependencies@>
+
+@d first_ord=0 {ordinal number of the smallest element of |char|}
+@d last_ord=127 {ordinal number of the largest element of |char|}
+
+@<Global...@>=
+@!xord:array[char] of ASCII_code; {conversion table}
+
+@ @<Local variables for init...@>=
+@!k:integer; {all-purpose initialization index}
+
+@ Characters that should not appear in \.{PL} files (except in comments)
+are mapped into @'177.
+
+@d invalid_code=@'177 {code deserving an error message}
+
+@<Set init...@>=
+for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code;
+xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#";
+xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'";
+xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=",";
+xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1";
+xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6";
+xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";";
+xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?";
+xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C";
+xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H";
+xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M";
+xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R";
+xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W";
+xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\";
+xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a";
+xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f";
+xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k";
+xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p";
+xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u";
+xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z";
+xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~";
+
+@ In order to help catch errors of badly nested parentheses, \.{PLtoTF}
+assumes that the user will begin each line with a number of blank spaces equal
+to some constant times the number of open parentheses at the beginning of
+that line. However, the program doesn't know in advance what the constant
+is, nor does it want to print an error message on every line for a user
+who has followed no consistent pattern of indentation.
+
+Therefore the following strategy is adopted: If the user has been consistent
+with indentation for ten or more lines, an indentation error will be
+reported. The constant of indentation is reset on every line that should
+have nonzero indentation.
+
+@<Glob...@>=
+@!line:integer; {the number of the current line}
+@!good_indent:integer; {the number of lines since the last bad indentation}
+@!indent: integer; {the number of spaces per open parenthesis, zero if unknown}
+@!level: integer; {the current number of open parentheses}
+
+@ @<Set init...@>=
+line:=0; good_indent:=0; indent:=0; level:=0;
+
+@ The input need not really be broken into lines of any maximum length, and
+we could read it character by character without any buffering. But we shall
+place it into a small buffer so that offending lines can be displayed in error
+messages.
+
+@<Glob...@>=
+@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer
+ at end-of-line marks?}
+@!limit:0..buf_size; {position of the last character present in the buffer}
+@!loc:0..buf_size; {position of the last character read in the buffer}
+@!buffer:array[1..buf_size] of char;
+@!input_has_ended:boolean; {there is no more input to read}
+
+@ @<Set init...@>=
+limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false;
+
+@ Just before each \.{CHARACTER} property list is evaluated, the character
+code is printed in octal notation. Up to eight such codes appear on a line;
+so we have a variable to keep track of how many are currently there.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+
+@ @<Set init...@>=
+chars_on_line:=0;
+
+@ The following routine prints an error message and an indication of
+where the error was detected. The error message should not include any
+final punctuation, since this procedure supplies its own.
+
+@d err_print(#)==begin if chars_on_line>0 then print_ln(' ');
+ print(#); show_error_context;
+ end
+
+@p procedure show_error_context; {prints the current scanner location}
+var k:0..buf_size; {an index into |buffer|}
+begin print_ln(' (line ',line:1,').');
+if not left_ln then print('...');
+for k:=1 to loc do print(buffer[k]); {print the characters already scanned}
+print_ln(' ');
+if not left_ln then print(' ');
+for k:=1 to loc do print(' '); {space out the second line}
+for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen}
+if right_ln then print_ln(' ')@+else print_ln('...');
+chars_on_line:=0;
+end;
+
+@ Here is a procedure that does the right thing when we are done
+reading the present contents of the buffer. It keeps |buffer[buf_size]|
+empty, in order to avoid range errors on certain \PASCAL\ compilers.
+
+An infinite sequence of right parentheses is placed at the end of the
+file, so that the program is sure to get out of whatever level of nesting
+it is in.
+
+On some systems it is desirable to modify this code so that tab marks
+in the buffer are replaced by blank spaces. (Simply setting
+|xord[chr(@'11)]:=" "| would not work; for example, two-line
+error messages would not come out properly aligned.)
+@^system dependencies@>
+
+@p procedure fill_buffer;
+begin left_ln:=right_ln; limit:=0; loc:=0;
+if left_ln then
+ begin if line>0 then read_ln(pl_file);
+ incr(line);
+ end;
+if eof(pl_file) then
+ begin limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
+ end
+else begin while (limit<buf_size-1)and(not eoln(pl_file)) do
+ begin incr(limit); read(pl_file,buffer[limit]);
+ end;
+ buffer[limit+1]:=' '; right_ln:=eoln(pl_file);
+ if left_ln then @<Set |loc| to the number of leading blanks in
+ the buffer, and check the indentation@>;
+ end;
+end;
+
+@ The interesting part about |fill_buffer| is the part that learns what
+indentation conventions the user is following, if any.
+
+@d bad_indent(#)==begin if good_indent>=10 then err_print(#);
+ good_indent:=0; indent:=0;
+ end
+
+@<Set |loc|...@>=
+begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
+if loc<limit then
+ begin if level=0 then
+ if loc=0 then incr(good_indent)
+ else bad_indent('Warning: Indented line occurred at level zero')
+@.Warning: Indented line...@>
+ else if indent=0 then
+ if loc mod level=0 then
+ begin indent:=loc div level; good_indent:=1;
+ end
+ else good_indent:=0
+ else if indent*level=loc then incr(good_indent)
+ else bad_indent('Warning: Inconsistent indentation; ',
+@.Warning: Inconsistent indentation...@>
+ 'you are at parenthesis level ',level:1);
+ end;
+end
+
+@* Basic scanning routines.
+The global variable |cur_char| holds the ASCII code corresponding to the
+character most recently read from the input buffer, or to a character that
+has been substituted for the real one.
+
+@<Global...@>=
+@!cur_char:ASCII_code; {we have just read this}
+
+@ Here is a procedure that sets |cur_char| to an ASCII code for the
+next character of input, if that character is a letter or digit or slash
+or \.>. Otherwise
+it sets |cur_char:=" "|, and the input system will be poised to reread the
+character that was rejected, whether or not it was a space.
+Lower case letters are converted to upper case.
+
+@p procedure get_keyword_char;
+begin while (loc=limit)and(not right_ln) do fill_buffer;
+if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
+else begin cur_char:=xord[buffer[loc+1]];
+ if cur_char>="a" then cur_char:=cur_char-@'40;
+ if ((cur_char>="0")and(cur_char<="9")) then incr(loc)
+ else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc)
+ else if cur_char="/" then incr(loc)
+ else if cur_char=">" then incr(loc)
+ else cur_char:=" ";
+ end;
+end;
+
+@ The following procedure sets |cur_char| to the next character code,
+and converts lower case to upper case. If the character is a left or
+right parenthesis, it will not be ``digested''; the character will
+be read again and again, until the calling routine does something
+like `|incr(loc)|' to get past it. Such special treatment of parentheses
+insures that the structural information they contain won't be lost in
+the midst of other error recovery operations.
+
+@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc);
+ end {undoes the effect of |get_next|}
+
+@p procedure get_next; {sets |cur_char| to next, balks at parentheses}
+begin while loc=limit do fill_buffer;
+incr(loc); cur_char:=xord[buffer[loc]];
+if cur_char>="a" then
+ if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
+ else begin if cur_char=invalid_code then
+ begin err_print('Illegal character in the file');
+@.Illegal character...@>
+ cur_char:="?";
+ end;
+ end
+else if (cur_char<=")")and(cur_char>="(") then decr(loc);
+end;
+
+@ The next procedure is used to ignore the text of a comment, or to pass over
+erroneous material. As such, it has the privilege of passing parentheses.
+It stops after the first right parenthesis that drops the level below
+the level in force when the procedure was called.
+
+@p procedure skip_to_end_of_item;
+var l:integer; {initial value of |level|}
+begin l:=level;
+while level>=l do
+ begin while loc=limit do fill_buffer;
+ incr(loc);
+ if buffer[loc]=')' then decr(level)
+ else if buffer[loc]='(' then incr(level);
+ end;
+if input_has_ended then err_print('File ended unexpectedly: No closing ")"');
+@.File ended unexpectedly...@>
+cur_char:=" "; {now the right parenthesis has been read and digested}
+end;
+
+@ Sometimes we merely want to skip past characters in the input until we
+reach a left or a right parenthesis. For example, we do this whenever we
+have finished scanning a property value and we hope that a right parenthesis
+is next (except for possible blank spaces).
+
+@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")")
+@d skip_error(#)==begin err_print(#); skip_to_paren;
+ end {this gets to the right parenthesis if something goes wrong}
+@d flush_error(#)==begin err_print(#); skip_to_end_of_item;
+ end {this gets past the right parenthesis if something goes wrong}
+
+@ After a property value has been scanned, we want to move just past the
+right parenthesis that should come next in the input (except for possible
+blank spaces).
+
+@p procedure finish_the_property; {do this when the value has been scanned}
+begin while cur_char=" " do get_next;
+if cur_char<>")" then err_print('Junk after property value will be ignored');
+@.Junk after property value...@>
+skip_to_end_of_item;
+end;
+
+@* Scanning property names.
+We have to figure out the meaning of names that appear in the \.{PL} file,
+by looking them up in a dictionary of known keywords. Keyword number $n$
+appears in locations |start[n]| through |start[n+1]-1| of an array called
+|dictionary|.
+
+@d max_name_index=88 {upper bound on the number of keywords}
+@d max_letters=600 {upper bound on the total length of all keywords}
+
+@<Global...@>=
+@!start:array[1..max_name_index] of 0..max_letters;
+@!dictionary:array[0..max_letters] of ASCII_code;
+@!start_ptr:0..max_name_index; {the first available place in |start|}
+@!dict_ptr:0..max_letters; {the first available place in |dictionary|}
+
+@ @<Set init...@>=
+start_ptr:=1; start[1]:=0; dict_ptr:=0;
+
+@ When we are looking for a name, we put it into the |cur_name| array.
+When we have found it, the corresponding |start| index will go into
+the global variable |name_ptr|.
+
+@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}}
+
+@<Glob...@>=
+@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up}
+@!name_length:0..longest_name; {its length}
+@!name_ptr:0..max_name_index; {its ordinal number in the dictionary}
+
+@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L
+in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary
+operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]|
+points into the |start| array.
+
+@d hash_prime=101 {size of the hash table}
+
+@<Glob...@>=
+@!nhash:array[0..hash_prime-1] of 0..max_name_index;
+@!cur_hash:0..hash_prime-1; {current position in the hash table}
+
+@ @<Local...@>=
+@!h:0..hash_prime-1; {runs through the hash table}
+
+@ @<Set init...@>=
+for h:=0 to hash_prime-1 do nhash[h]:=0;
+
+@ Since there is no chance of the hash table overflowing, the procedure
+is very simple. After |lookup| has done its work, |cur_hash| will point
+to the place where the given name was found, or where it should be inserted.
+
+@p procedure lookup; {finds |cur_name| in the dictionary}
+var k:0..longest_name; {index into |cur_name|}
+@!j:0..max_letters; {index into |dictionary|}
+@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement}
+begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
+not_found:=true;
+while not_found do
+ begin if cur_hash=0 then cur_hash:=hash_prime-1@+else decr(cur_hash);
+ if nhash[cur_hash]=0 then not_found:=false
+ else begin j:=start[nhash[cur_hash]];
+ if start[nhash[cur_hash]+1]=j+name_length then
+ begin not_found:=false;
+ for k:=1 to name_length do
+ if dictionary[j+k-1]<>cur_name[k] then not_found:=true;
+ end;
+ end;
+ end;
+name_ptr:=nhash[cur_hash];
+end;
+
+@ @<Compute the hash...@>=
+cur_hash:=cur_name[1];
+for k:=2 to name_length do
+ cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime
+
+@ The ``meaning'' of the keyword that begins at |start[k]| in the
+dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given
+symbolic meanings by the following definitions.
+
+@d comment_code=0
+@d check_sum_code=1
+@d design_size_code=2
+@d design_units_code=3
+@d coding_scheme_code=4
+@d family_code=5
+@d face_code=6
+@d seven_bit_safe_flag_code=7
+@d header_code= 8
+@d font_dimen_code=9
+@d lig_table_code=10
+@d boundary_char_code=11
+@d character_code=12
+@d parameter_code=20
+@d char_info_code=50
+@d width=1
+@d height=2
+@d depth=3
+@d italic=4
+@d char_wd_code=char_info_code+width
+@d char_ht_code=char_info_code+height
+@d char_dp_code=char_info_code+depth
+@d char_ic_code=char_info_code+italic
+@d next_larger_code=55
+@d var_char_code=56
+@d label_code=70
+@d stop_code=71
+@d skip_code=72
+@d krn_code=73
+@d lig_code=74
+
+@<Glo...@>=
+@!equiv:array[0..max_name_index] of byte;
+@!cur_code:byte; {equivalent most recently found in |equiv|}
+
+@ We have to get the keywords into the hash table and into the dictionary in
+the first place (sigh). The procedure that does this has the desired
+|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing
+for the initialization, the keyword being initialized is placed into the
+last positions of |cur_name|, instead of the first positions.
+
+@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary}
+var k:0..longest_name;
+begin for k:=1 to name_length do
+ cur_name[k]:=cur_name[k+longest_name-name_length];
+{now the name has been shifted into the correct position}
+lookup; {this sets |cur_hash| to the proper insertion place}
+nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v;
+for k:=1 to name_length do
+ begin dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr);
+ end;
+incr(start_ptr); start[start_ptr]:=dict_ptr;
+end;
+
+@ Here are the macros to load a name of up to 20 letters into the
+dictionary. For example, the macro |load5| is used for five-letter keywords.
+
+@d tail(#)==enter_name(#)
+@d t20(#)==cur_name[20]:=#;tail
+@d t19(#)==cur_name[19]:=#;t20
+@d t18(#)==cur_name[18]:=#;t19
+@d t17(#)==cur_name[17]:=#;t18
+@d t16(#)==cur_name[16]:=#;t17
+@d t15(#)==cur_name[15]:=#;t16
+@d t14(#)==cur_name[14]:=#;t15
+@d t13(#)==cur_name[13]:=#;t14
+@d t12(#)==cur_name[12]:=#;t13
+@d t11(#)==cur_name[11]:=#;t12
+@d t10(#)==cur_name[10]:=#;t11
+@d t9(#)==cur_name[9]:=#;t10
+@d t8(#)==cur_name[8]:=#;t9
+@d t7(#)==cur_name[7]:=#;t8
+@d t6(#)==cur_name[6]:=#;t7
+@d t5(#)==cur_name[5]:=#;t6
+@d t4(#)==cur_name[4]:=#;t5
+@d t3(#)==cur_name[3]:=#;t4
+@d t2(#)==cur_name[2]:=#;t3
+@d t1(#)==cur_name[1]:=#;t2
+@d load3==name_length:=3;t18
+@d load4==name_length:=4;t17
+@d load5==name_length:=5;t16
+@d load6==name_length:=6;t15
+@d load7==name_length:=7;t14
+@d load8==name_length:=8;t13
+@d load9==name_length:=9;t12
+@d load10==name_length:=10;t11
+@d load11==name_length:=11;t10
+@d load12==name_length:=12;t9
+@d load13==name_length:=13;t8
+@d load14==name_length:=14;t7
+@d load15==name_length:=15;t6
+@d load16==name_length:=16;t5
+@d load17==name_length:=17;t4
+@d load18==name_length:=18;t3
+@d load19==name_length:=19;t2
+@d load20==name_length:=20;t1
+
+@ (Thank goodness for keyboard macros in the text editor used to create this
+\.{WEB} file.)
+
+@<Enter all of the names and their equivalents, except the parameter names@>=
+equiv[0]:=comment_code; {this is used after unknown keywords}
+load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/
+load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/
+load11("D")("E")("S")("I")("G")("N")
+ ("U")("N")("I")("T")("S")(design_units_code);@/
+load12("C")("O")("D")("I")("N")("G")
+ ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/
+load6("F")("A")("M")("I")("L")("Y")(family_code);@/
+load4("F")("A")("C")("E")(face_code);@/
+load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@>
+ ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/
+load6("H")("E")("A")("D")("E")("R")(header_code);@/
+load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/
+load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/
+load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R")
+ (boundary_char_code);@/
+load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/
+load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/
+load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/
+load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/
+load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/
+load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/
+load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/
+load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/
+load3("T")("O")("P")(var_char_code+1);@/
+load3("M")("I")("D")(var_char_code+2);@/
+load3("B")("O")("T")(var_char_code+3);@/
+load3("R")("E")("P")(var_char_code+4);@/
+load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format}
+load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/
+load5("L")("A")("B")("E")("L")(label_code);@/
+load4("S")("T")("O")("P")(stop_code);@/
+load4("S")("K")("I")("P")(skip_code);@/
+load3("K")("R")("N")(krn_code);@/
+load3("L")("I")("G")(lig_code);@/
+load4("/")("L")("I")("G")(lig_code+2);@/
+load5("/")("L")("I")("G")(">")(lig_code+6);@/
+load4("L")("I")("G")("/")(lig_code+1);@/
+load5("L")("I")("G")("/")(">")(lig_code+5);@/
+load5("/")("L")("I")("G")("/")(lig_code+3);@/
+load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/
+load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/
+
+@ @<Enter the parameter names@>=
+load5("S")("L")("A")("N")("T")(parameter_code+1);@/
+load5("S")("P")("A")("C")("E")(parameter_code+2);@/
+load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/
+load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/
+load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/
+load4("Q")("U")("A")("D")(parameter_code+6);@/
+load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/
+load4("N")("U")("M")("1")(parameter_code+8);@/
+load4("N")("U")("M")("2")(parameter_code+9);@/
+load4("N")("U")("M")("3")(parameter_code+10);@/
+load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/
+load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/
+load4("S")("U")("P")("1")(parameter_code+13);@/
+load4("S")("U")("P")("2")(parameter_code+14);@/
+load4("S")("U")("P")("3")(parameter_code+15);@/
+load4("S")("U")("B")("1")(parameter_code+16);@/
+load4("S")("U")("B")("2")(parameter_code+17);@/
+load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/
+load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/
+load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/
+load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/
+load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/
+load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@>
+ ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/
+
+@ When a left parenthesis has been scanned, the following routine
+is used to interpret the keyword that follows, and to store the
+equivalent value in |cur_code|.
+
+@p procedure get_name;
+begin incr(loc); incr(level); {pass the left parenthesis}
+cur_char:=" ";
+while cur_char=" " do get_next;
+if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character}
+name_length:=0; get_keyword_char; {prepare to scan the name}
+while cur_char<>" " do
+ begin if name_length=longest_name then cur_name[1]:="X" {force error}
+ else incr(name_length);
+ cur_name[name_length]:=cur_char;
+ get_keyword_char;
+ end;
+lookup;
+if name_ptr=0 then err_print('Sorry, I don''t know that property name');
+@.Sorry, I don't know...@>
+cur_code:=equiv[name_ptr];
+end;
+
+@* Scanning numeric data.
+The next thing we need is a trio of subroutines to read the one-byte,
+four-byte, and real numbers that may appear as property values.
+These subroutines are careful to stick to numbers between $-2^{31}$
+and $2^{31}-1$, inclusive, so that a computer with two's complement
+32-bit arithmetic will not be interrupted by overflow.
+
+@ The first number scanner, which returns a one-byte value, surely has
+no problems of arithmetic overflow.
+
+@p function get_byte:byte; {scans a one-byte property value}
+var acc:integer; {an accumulator}
+@!t:ASCII_code; {the type of value to be scanned}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+t:=cur_char; acc:=0;
+repeat get_next;
+until cur_char<>" "; {skip the blanks after the type code}
+if t="C" then @<Scan an ASCII character code@>
+else if t="D" then @<Scan a small decimal number@>
+else if t="O" then @<Scan a small octal number@>
+else if t="H" then @<Scan a small hexadecimal number@>
+else if t="F" then @<Scan a face code@>
+else skip_error('You need "C" or "D" or "O" or "H" or "F" here');
+@.You need "C" or "D" ...here@>
+cur_char:=" "; get_byte:=acc;
+end;
+
+@ The |get_next| routine converts lower case to upper case, but it leaves
+the character in the buffer, so we can unconvert it.
+
+@<Scan an ASCII...@>=
+if (cur_char>=@'41)and(cur_char<=@'176)and
+ ((cur_char<"(")or(cur_char>")")) then
+ acc:=xord[buffer[loc]]
+else skip_error('"C" value must be standard ASCII and not a paren')
+@:C value}\.{"C" value must be...@>
+
+@ @<Scan a small dec...@>=
+begin while (cur_char>="0")and(cur_char<="9") do
+ begin acc:=acc*10+cur_char-"0";
+ if acc>255 then
+ begin skip_error('This value shouldn''t exceed 255');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small oct...@>=
+begin while (cur_char>="0")and(cur_char<="7") do
+ begin acc:=acc*8+cur_char-"0";
+ if acc>255 then
+ begin skip_error('This value shouldn''t exceed ''377');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small hex...@>=
+begin while ((cur_char>="0")and(cur_char<="9"))or
+ ((cur_char>="A")and(cur_char<="F")) do
+ begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+ acc:=acc*16+cur_char-"0";
+ if acc>255 then
+ begin skip_error('This value shouldn''t exceed "FF');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a face...@>=
+begin if cur_char="B" then acc:=2
+else if cur_char="L" then acc:=4
+else if cur_char<>"M" then acc:=18;
+get_next;
+if cur_char="I" then incr(acc)
+else if cur_char<>"R" then acc:=18;
+get_next;
+if cur_char="C" then acc:=acc+6
+else if cur_char="E" then acc:=acc+12
+else if cur_char<>"R" then acc:=18;
+if acc>=18 then
+ begin skip_error('Illegal face code, I changed it to MRR');
+@.Illegal face code...@>
+ acc:=0;
+ end;
+end
+
+@ The routine that scans a four-byte value puts its output into |cur_bytes|,
+which is a record containing (yes, you guessed it) four bytes.
+
+@<Types...@>=
+@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end;
+
+@ @d c0==cur_bytes.b0
+@d c1==cur_bytes.b1
+@d c2==cur_bytes.b2
+@d c3==cur_bytes.b3
+
+@<Glob...@>=
+@!cur_bytes:four_bytes; {a four-byte accumulator}
+
+@ Since the |get_four_bytes| routine is used very infrequently, no attempt
+has been made to make it fast; we only want it to work.
+
+@p procedure get_four_bytes; {scans an octal constant and sets |four_bytes|}
+var c:integer; {leading byte}
+@!r:integer; {radix}
+@!q:integer; {|256/r|}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+r:=0; c0:=0; c1:=0; c2:=0; c3:=0; {start with the accumulator zero}
+if cur_char="H" then r:=16
+else if cur_char="O" then r:=8
+else skip_error('An octal ("O") or hex ("H") value is needed here');
+@.An octal ("O") or hex ("H")...@>
+if r>0 then
+ begin q:=256 div r;
+ repeat get_next;
+ until cur_char<>" "; {skip the blanks after the type code}
+ while ((cur_char>="0")and(cur_char<="9"))or@|
+ ((cur_char>="A")and(cur_char<="F")) do
+ @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>;
+ end;
+end;
+
+@ @<Multiply by |r|...@>=
+begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+c:=(r*c0)+(c1 div q);
+if c>255 then
+ begin c0:=0; c1:=0; c2:=0; c3:=0;
+ if r=8 then
+ skip_error('Sorry, the maximum octal value is O 37777777777')
+@.Sorry, the maximum octal...@>
+ else skip_error('Sorry, the maximum hex value is H FFFFFFFF');
+@.Sorry, the maximum hex...@>
+ end
+else if cur_char>="0"+r then skip_error('Illegal digit')
+@.Illegal digit@>
+else begin c0:=c;
+ c1:=(r*(c1 mod q))+(c2 div q);
+ c2:=(r*(c2 mod q))+(c3 div q);
+ c3:=(r*(c3 mod q))+cur_char-"0";
+ get_next;
+ end;
+end
+
+@ The remaining scanning routine is the most interesting. It scans a real
+constant and returns the nearest |fix_word| approximation to that constant.
+A |fix_word| is a 32-bit integer that represents a real value that
+has been multiplied by $2^{20}$. Since \.{PLtoTF} restricts the magnitude
+of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$.
+
+@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0}
+
+@<Types...@>=
+@!fix_word=integer; {a scaled real value with 20 bits of fraction}
+
+@ When a real value is desired, we might as well treat `\.D' and `\.R'
+formats as if they were identical.
+
+@p function get_fix:fix_word; {scans a real property value}
+var negative:boolean; {was there a minus sign?}
+@!acc:integer; {an accumulator}
+@!int_part:integer; {the integer part}
+@!j:0..7; {the number of decimal places stored}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+negative:=false; acc:=0; {start with the accumulators zero}
+if (cur_char<>"R")and(cur_char<>"D") then
+ skip_error('An "R" or "D" value is needed here')
+@.An "R" or "D" ... needed here@>
+else begin @<Scan the blanks and/or signs after the type code@>;
+ while (cur_char>="0") and (cur_char<="9") do
+ @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>;
+ int_part:=acc; acc:=0;
+ if cur_char="." then @<Scan the fraction part and put it in |acc|@>;
+ if (acc>=unity)and(int_part=2047) then
+ skip_error('Real constants must be less than 2048')
+@.Real constants must be...@>
+ else acc:=int_part*unity+acc;
+ end;
+if negative then get_fix:=-acc@+else get_fix:=acc;
+end;
+
+@ @<Scan the blanks...@>=
+repeat get_next;
+if cur_char="-" then
+ begin cur_char:=" "; negative:=true;
+ end
+else if cur_char="+" then cur_char:=" ";
+until cur_char<>" "
+
+@ @<Multiply by 10...@>=
+begin acc:=acc*10+cur_char-"0";
+if acc>=2048 then
+ begin skip_error('Real constants must be less than 2048');
+@.Real constants must be...@>
+ acc:=0; cur_char:=" ";
+ end
+else get_next;
+end
+
+@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven
+of the digits $d_j$. A correct result is obtained if we first compute
+$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which
+$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
+
+@<Glob...@>=
+@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$}
+
+@ @<Scan the frac...@>=
+begin j:=0; get_next;
+while (cur_char>="0")and(cur_char<="9") do
+ begin if j<7 then
+ begin incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
+ end;
+ get_next;
+ end;
+acc:=0;
+while j>0 do
+ begin acc:=fraction_digits[j]+(acc div 10); decr(j);
+ end;
+acc:=(acc+10) div 20;
+end
+
+@* Storing the property values.
+When property values have been found, they are squirreled away in a bunch
+of arrays. The header information is unpacked into bytes in an array
+called |header_bytes|. The ligature/kerning program is stored in an array
+of type |four_bytes|.
+Another |four_bytes| array holds the specifications of extensible characters.
+The kerns and parameters are stored in separate arrays of |fix_word| values.
+
+Instead of storing the design size in the header array, we will keep it
+in a |fix_word| variable until the last minute. The number of units in the
+design size is also kept in a |fix_word|.
+
+@<Glob...@>=
+@!header_bytes:array[header_index] of byte; {the header block}
+@!header_ptr:header_index; {the number of header bytes in use}
+@!design_size:fix_word; {the design size}
+@!design_units:fix_word; {reciprocal of the scaling factor}
+@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?}
+@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program}
+@!nl:0..32767; {the number of ligature/kern instructions so far}
+@!min_nl:0..32767; {the final value of |nl| must be at least this}
+@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts}
+@!nk:0..max_kerns; {the number of entries of |kern|}
+@!exten:array[0..255] of four_bytes; {extensible character specs}
+@!ne:0..256; {the number of extensible characters}
+@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters}
+@!np:0..max_param_words; {the largest parameter set nonzero}
+@!check_sum_specified:boolean; {did the user name the check sum?}
+@!bchar:0..256; {the right boundary character, or 256 if unspecified}
+
+@ @<Types...@>=
+@!header_index=0..max_header_bytes;
+@!indx=0..@'77777;
+
+@ @<Local...@>=
+@!d:header_index; {an index into |header_bytes|}
+
+@ We start by setting up the default values.
+
+@d check_sum_loc=0
+@d design_size_loc=4
+@d coding_scheme_loc=8
+@d family_loc=coding_scheme_loc+40
+@d seven_flag_loc=family_loc+20
+@d face_loc=seven_flag_loc+3
+
+@<Set init...@>=
+for d:=0 to 18*4-1 do header_bytes[d]:=0;
+header_bytes[8]:=11; header_bytes[9]:="U";
+header_bytes[10]:="N";
+header_bytes[11]:="S";
+header_bytes[12]:="P";
+header_bytes[13]:="E";
+header_bytes[14]:="C";
+header_bytes[15]:="I";
+header_bytes[16]:="F";
+header_bytes[17]:="I";
+header_bytes[18]:="E";
+header_bytes[19]:="D";
+@.UNSPECIFIED@>
+for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40];
+design_size:=10*unity; design_units:=unity; seven_bit_safe_flag:=false;@/
+header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/
+check_sum_specified:=false; bchar:=256;
+
+@ Most of the dimensions, however, go into the |memory| array. There are
+at most 257 widths, 257 heights, 257 depths, and 257 italic corrections,
+since the value 0 is required but it need not be used. So |memory| has room
+for 1028 entries, each of which is a |fix_word|. An auxiliary table called
+|link| is used to link these words together in linear lists, so that
+sorting and other operations can be done conveniently.
+
+We also add four ``list head'' words to the |memory| and |link| arrays;
+these are in locations |width| through |italic|, i.e., 1 through 4.
+For example, |link[height]| points to the smallest element in
+the sorted list of distinct heights that have appeared so far, and
+|memory[height]| is the number of distinct heights.
+
+@d mem_size=1028+4 {number of nonzero memory addresses}
+
+@<Types...@>=
+@!pointer=0..mem_size; {an index into memory}
+
+@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain
+pointers to the |memory| array entries where the corresponding dimensions
+appear. Two other arrays, |char_tag| and |char_remainder|, hold
+the other information that \.{TFM} files pack into a |char_info_word|.
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+@d bchar_label==char_remainder[256]
+ {beginning of ligature program for left boundary}
+
+@<Glob...@>=
+@!memory:array[pointer] of fix_word; {character dimensions and kerns}
+@!mem_ptr:pointer; {largest |memory| word in use}
+@!link:array[pointer] of pointer; {to make lists of |memory| items}
+@!char_wd:array[byte] of pointer; {pointers to the widths}
+@!char_ht:array[byte] of pointer; {pointers to the heights}
+@!char_dp:array[byte] of pointer; {pointers to the depths}
+@!char_ic:array[byte] of pointer; {pointers to italic corrections}
+@!char_tag:array[byte] of no_tag..ext_tag; {character tags}
+@!char_remainder:array[0..256] of 0..65535; {pointers to ligature labels,
+ next larger characters, or extensible characters}
+
+@ @<Local...@>=
+@!c:byte; {runs through all character codes}
+
+@ @<Set init...@>=
+bchar_label:=@'77777;
+for c:=0 to 255 do
+ begin char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
+ char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists}
+memory[width]:=0; link[width]:=0; {width list is empty}
+memory[height]:=0; link[height]:=0; {height list is empty}
+memory[depth]:=0; link[depth]:=0; {depth list is empty}
+memory[italic]:=0; link[italic]:=0; {italic list is empty}
+mem_ptr:=italic;
+
+@ As an example of these data structures, let us consider the simple
+routine that inserts a potentially new element into one of the dimension
+lists. The first parameter indicates the list head (i.e., |h=width| for
+the width list, etc.); the second parameter is the value that is to be
+inserted into the list if it is not already present. The procedure
+returns the value of the location where the dimension appears in |memory|.
+The fact that |memory[0]| is larger than any legal dimension makes the
+algorithm particularly short.
+
+We do have to handle two somewhat subtle situations. A width of zero must be
+put into the list, so that a zero-width character in the font will not appear
+to be nonexistent (i.e., so that its |char_wd| index will not be zero), but
+this does not need to be done for heights, depths, or italic corrections.
+Furthermore, it is necessary to test for memory overflow even though we
+have provided room for the maximum number of different dimensions in any
+legal font, since the \.{PL} file might foolishly give any number of
+different sizes to the same character.
+
+@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list}
+var p:pointer; {the current node of interest}
+begin if (d=0)and(h<>width) then sort_in:=0
+else begin p:=h;
+ while d>=memory[link[p]] do p:=link[p];
+ if (d=memory[p])and(p<>h) then sort_in:=p
+ else if mem_ptr=mem_size then
+ begin err_print('Memory overflow: more than 1028 widths, etc');
+@.Memory overflow...@>
+ print_ln('Congratulations! It''s hard to make this error.');
+ sort_in:=p;
+ end
+ else begin incr(mem_ptr); memory[mem_ptr]:=d;
+ link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]);
+ sort_in:=mem_ptr;
+ end;
+ end;
+end;
+
+@ When these lists of dimensions are eventually written to the \.{TFM}
+file, we may have to do some rounding of values, because the \.{TFM} file
+allows at most 256 widths, 16 heights, 16 depths, and 64 italic
+corrections. The following procedure takes a given list head |h| and a
+given dimension |d|, and returns the minimum $m$ such that the elements of
+the list can be covered by $m$ intervals of width $d$. It also sets
+|next_d| to the smallest value $d^\prime>d$ such that the covering found
+by this procedure would be different. In particular, if $d=0$ it computes
+the number of elements of the list, and sets |next_d| to the smallest
+distance between two list elements. (The covering by intervals of width
+|next_d| is not guaranteed to have fewer than $m$ elements, but in practice
+this seems to happen most of the time.)
+
+@<Glob...@>=
+@!next_d:fix_word; {the next larger interval that is worth trying}
+
+@ Once again we can make good use of the fact that |memory[0]| is ``infinite.''
+
+@p function min_cover(@!h:pointer;@!d:fix_word):integer;
+var p:pointer; {the current node of interest}
+@!l:fix_word; {the least element covered by the current interval}
+@!m:integer; {the current size of the cover being generated}
+begin m:=0; p:=link[h]; next_d:=memory[0];
+while p<>0 do
+ begin incr(m); l:=memory[p];
+ while memory[link[p]]<=l+d do p:=link[p];
+ p:=link[p];
+ if memory[p]-l<next_d then next_d:=memory[p]-l;
+ end;
+min_cover:=m;
+end;
+
+@ The following procedure uses |min_cover| to determine the smallest $d$
+such that a given list can be covered with at most a given number of
+intervals.
+
+@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round}
+var d:fix_word; {the current trial interval length}
+@!k:integer; {the size of a minimum cover}
+begin if memory[h]>m then
+ begin excess:=memory[h]-m;
+ k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|}
+ repeat d:=d+d; k:=min_cover(h,d);
+ until k<=m; {first we ascend rapidly until finding the range}
+ d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps}
+ while k>m do
+ begin d:=next_d; k:=min_cover(h,d);
+ end;
+ shorten:=d;
+ end
+else shorten:=0;
+end;
+
+@ When we are nearly ready to output the \.{TFM} file, we will set
+|index[p]:=k| if the dimension in |memory[p]| is being rounded to the
+|k|th element of its list.
+
+@<Glob...@>=
+@!index:array[pointer] of byte;
+@!excess:byte; {number of words to remove, if list is being shortened}
+
+@ Here is the procedure that sets the |index| values. It also shortens
+the list so that there is only one element per covering interval;
+the remaining elements are the midpoints of their clusters.
+
+@p procedure set_indices(@!h:pointer;@!d:fix_word); {reduces and indexes a list}
+var p:pointer; {the current node of interest}
+@!q:pointer; {trails one step behind |p|}
+@!m:byte; {index number of nodes in the current interval}
+@!l:fix_word; {least value in the current interval}
+begin q:=h; p:=link[q]; m:=0;
+while p<>0 do
+ begin incr(m); l:=memory[p]; index[p]:=m;
+ while memory[link[p]]<=l+d do
+ begin p:=link[p]; index[p]:=m; decr(excess);
+ if excess=0 then d:=0;
+ end;
+ link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p];
+ end;
+memory[h]:=m;
+end;
+
+@* The input phase.
+We're ready now to read and parse the \.{PL} file, storing property
+values as we go.
+
+@<Glob...@>=
+@!c:byte; {the current character or byte being processed}
+
+@ @<Read all the input@>=
+cur_char:=" ";
+repeat while cur_char=" " do get_next;
+if cur_char="(" then @<Read a font property value@>
+else if (cur_char=")")and not input_has_ended then
+ begin err_print('Extra right parenthesis');
+ incr(loc); cur_char:=" ";
+ end
+@.Extra right parenthesis@>
+else if not input_has_ended then junk_error;
+until input_has_ended
+
+@ The |junk_error| routine just referred to is called when something
+appears in the forbidden area between properties of a property list.
+
+@p procedure junk_error; {gets past no man's land}
+begin err_print('There''s junk here that is not in parentheses');
+@.There's junk here...@>
+skip_to_paren;
+end;
+
+@ For each font property, we are supposed to read the data from the
+left parenthesis that is the current value of |cur_char| to the right
+parenthesis that matches it in the input. The main complication is
+to recover with reasonable grace from various error conditions that might arise.
+
+@<Read a font property value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code>character_code then
+ flush_error('This property name doesn''t belong on the outer level')
+@.This property name doesn't belong...@>
+else begin @<Read the font property value specified by |cur_code|@>;
+ finish_the_property;
+ end;
+end
+
+@ @<Read the font property value spec...@>=
+case cur_code of
+check_sum_code: begin check_sum_specified:=true; read_four_bytes(check_sum_loc);
+ end;
+design_size_code: @<Read the design size@>;
+design_units_code: @<Read the design units@>;
+coding_scheme_code: read_BCPL(coding_scheme_loc,40);
+family_code: read_BCPL(family_loc,20);
+face_code:header_bytes[face_loc]:=get_byte;
+seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
+header_code: @<Read an indexed header word@>;
+font_dimen_code: @<Read font parameter list@>;
+lig_table_code: read_lig_kern;
+boundary_char_code: bchar:=get_byte;
+character_code: read_char_info;
+end
+
+@ The |case| statement just given makes use of two subroutines that we
+haven't defined yet. The first of these puts a 32-bit octal quantity
+into four specified bytes of the header block.
+
+@p procedure read_four_bytes(l:header_index);
+begin get_four_bytes;
+header_bytes[l]:=c0;
+header_bytes[l+1]:=c1;
+header_bytes[l+2]:=c2;
+header_bytes[l+3]:=c3;
+end;
+
+@ The second little procedure is used to scan a string and to store it in
+the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed
+to contain at most |n| bytes, including the first byte (which holds the
+length of the rest of the string).
+
+@p procedure read_BCPL(l:header_index;n:byte);
+var k:header_index;
+begin k:=l;
+while cur_char=" " do get_next;
+while (cur_char<>"(")and(cur_char<>")") do
+ begin if k<l+n then incr(k);
+ if k<l+n then header_bytes[k]:=cur_char;
+ get_next;
+ end;
+if k=l+n then
+ begin err_print('String is too long; its first ',n-1:1,
+@.String is too long...@>
+ ' characters will be kept'); decr(k);
+ end;
+header_bytes[l]:=k-l;
+while k<l+n-1 do {tidy up the remaining bytes by setting them to nulls}
+ begin incr(k); header_bytes[k]:=0;
+ end;
+end;
+
+@ @<Read the design size@>=
+begin next_d:=get_fix;
+if next_d<unity then
+ err_print('The design size must be at least 1')
+@.The design size must...@>
+else design_size:=next_d;
+end
+
+@ @<Read the design units@>=
+begin next_d:=get_fix;
+if next_d<=0 then
+ err_print('The number of units per design size must be positive')
+@.The number of units...@>
+else design_units:=next_d;
+end
+
+@ @<Read the seven-bit-safe...@>=
+begin while cur_char=" " do get_next;
+if cur_char="T" then seven_bit_safe_flag:=true
+else if cur_char="F" then seven_bit_safe_flag:=false
+else err_print('The flag value should be "TRUE" or "FALSE"');
+@.The flag value should be...@>
+skip_to_paren;
+end
+
+@ @<Read an indexed header word@>=
+begin c:=get_byte;
+if c<18 then skip_error('HEADER indices should be 18 or more')
+@.HEADER indices...@>
+else if 4*c+4>max_header_bytes then
+ skip_error('This HEADER index is too big for my present table size')
+@.This HEADER index is too big...@>
+else begin while header_ptr<4*c+4 do
+ begin header_bytes[header_ptr]:=0; incr(header_ptr);
+ end;
+ read_four_bytes(4*c);
+ end;
+end
+
+@ The remaining kinds of font property values that need to be read are
+those that involve property lists on higher levels. Each of these has a
+loop similar to the one that was used at level zero. Then we put the
+right parenthesis back so that `|finish_the_property|' will be happy;
+there is probably a more elegant way to do this.
+
+@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")";
+ end
+
+@<Read font parameter list@>=
+begin while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a parameter value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a parameter value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
+ flush_error('This property name doesn''t belong in a FONTDIMEN list')
+@.This property name doesn't belong...@>
+else begin if cur_code=parameter_code then c:=get_byte
+ else c:=cur_code-parameter_code;
+ if c=0 then flush_error('PARAMETER index must not be zero')
+@.PARAMETER index must not...@>
+ else if c>max_param_words then
+ flush_error('This PARAMETER index is too big for my present table size')
+@.This PARAMETER index is too big...@>
+ else begin while np<c do
+ begin incr(np); param[np]:=0;
+ end;
+ param[c]:=get_fix;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Read ligature/kern list@>=
+begin lk_step_ended:=false;
+while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a ligature/kern command@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a ligature/kern command@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<label_code then
+ flush_error('This property name doesn''t belong in a LIGTABLE list')
+@.This property name doesn't belong...@>
+else begin case cur_code of
+ label_code:@<Read a label step@>;
+ stop_code:@<Read a stop step@>;
+ skip_code:@<Read a skip step@>;
+ krn_code:@<Read a kerning step@>;
+ lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,lig_code+7,
+ lig_code+11:@<Read a ligature step@>;
+ end; {there are no other cases |>=label_code|}
+ finish_the_property;
+ end;
+end
+
+@ When a character is about to be tagged, we call the following
+procedure so that an error message is given in case of multiple tags.
+
+@p procedure check_tag(c:byte); {print error if |c| already tagged}
+begin case char_tag[c] of
+no_tag: do_nothing;
+lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
+@.This character already...@>
+list_tag: err_print('This character already has a NEXTLARGER spec');
+ext_tag: err_print('This character already has a VARCHAR spec');
+end;
+end;
+
+@ @<Read a label step@>=
+begin while cur_char=" " do get_next;
+if cur_char="B" then
+ begin bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
+ end
+else begin backup; c:=get_byte;
+ check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
+ end;
+if min_nl<=nl then min_nl:=nl+1;
+lk_step_ended:=false;
+end
+
+@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@<Globals...@>=
+@!lk_step_ended:boolean;
+ {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?}
+@!krn_ptr:0..max_kerns; {an index into |kern|}
+
+@ @<Read a stop step@>=
+if not lk_step_ended then
+ err_print('STOP must follow LIG or KRN')
+@.STOP must follow LIG or KRN@>
+else begin lig_kern[nl-1].b0:=stop_flag; lk_step_ended:=false;
+ end
+
+@ @<Read a skip step@>=
+if not lk_step_ended then
+ err_print('SKIP must follow LIG or KRN')
+@.SKIP must follow LIG or KRN@>
+else begin c:=get_byte;
+ if c>=128 then err_print('Maximum SKIP amount is 127')
+@.Maximum SKIP amount...@>
+ else if nl+c>=max_lig_steps then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+ else begin lig_kern[nl-1].b0:=c;
+ if min_nl<=nl+c then min_nl:=nl+c+1;
+ end;
+ lk_step_ended:=false;
+ end
+
+@ @<Read a ligature step@>=
+begin lig_kern[nl].b0:=0;
+lig_kern[nl].b2:=cur_code-lig_code;
+lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b3:=get_byte;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read a kerning step@>=
+begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
+kern[nk]:=get_fix; krn_ptr:=0;
+while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
+if krn_ptr=nk then
+ begin if nk<max_kerns then incr(nk)
+ else begin err_print('Sorry, too many different kerns for me to handle');
+@.Sorry, too many different kerns...@>
+ decr(krn_ptr);
+ end;
+ end;
+lig_kern[nl].b2:=kern_flag+(krn_ptr div 256);
+lig_kern[nl].b3:=krn_ptr mod 256;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ Finally we come to the part of \.{PLtoTF}'s input mechanism
+that is used most, the processing of individual character data.
+
+@<Read character info list@>=
+begin c:=get_byte; {read the character code that is being specified}
+@<Print |c| in octal notation@>;
+while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a character property@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
+finish_inner_property_list;
+end
+
+@ @<Read a character prop...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<char_wd_code)or(cur_code>var_char_code) then
+ flush_error('This property name doesn''t belong in a CHARACTER list')
+@.This property name doesn't belong...@>
+else begin case cur_code of
+ char_wd_code:char_wd[c]:=sort_in(width,get_fix);
+ char_ht_code:char_ht[c]:=sort_in(height,get_fix);
+ char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
+ char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
+ next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
+ char_remainder[c]:=get_byte;
+ end;
+ var_char_code:@<Read an extensible recipe for |c|@>;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ @<Read an extensible r...@>=
+begin if ne=256 then
+ err_print('At most 256 VARCHAR specs are allowed')
+@.At most 256 VARCHAR specs...@>
+else begin check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
+ exten[ne].b0:=0; exten[ne].b1:=0; exten[ne].b2:=0; exten[ne].b3:=0;
+ while level=2 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an extensible piece@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ incr(ne);
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an extensible p...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then
+ flush_error('This property name doesn''t belong in a VARCHAR list')
+@.This property name doesn't belong...@>
+else begin case cur_code-(var_char_code+1) of
+ 0:exten[ne].b0:=get_byte;
+ 1:exten[ne].b1:=get_byte;
+ 2:exten[ne].b2:=get_byte;
+ 3:exten[ne].b3:=get_byte;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ The input routine is now complete except for the following code,
+which prints a progress report as the file is being read.
+
+@p procedure print_octal(c:byte); {prints three octal digits}
+begin print('''',(c div 64):1,((c div 8) mod 8):1,(c mod 8):1);
+end;
+
+@ @<Print |c| in octal...@>=
+begin if chars_on_line=8 then
+ begin print_ln(' '); chars_on_line:=1;
+ end
+else begin if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+print_octal(c); {progress report}
+end
+
+@* The checking and massaging phase.
+Once the whole \.{PL} file has been read in, we must check it for consistency
+and correct any errors. This process consists mainly of running through
+the characters that exist and seeing if they refer to characters that
+don't exist. We also compute the true value of |seven_unsafe|; we make sure
+that the charlists and ligature programs contain no loops; and we
+shorten the lists of widths, heights, depths, and italic corrections,
+if necessary, to keep from exceeding the required maximum sizes.
+
+@<Glob...@>=
+@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?}
+
+@ @<Correct and check the information@>=
+if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>;
+seven_unsafe:=false;
+for c:=0 to 255 do if char_wd[c]<>0 then
+ @<For all characters |g| generated by |c|,
+ make sure that |char_wd[g]| is nonzero, and
+ set |seven_unsafe| if |c<128<=g|@>;
+if bchar_label<@'77777 then
+ begin c:=256; @<Check ligature program of |c|@>;
+ end;
+if seven_bit_safe_flag and seven_unsafe then
+ print_ln('The font is not really seven-bit-safe!');
+@.The font is not...safe@>
+@<Check for infinite ligature loops@>;
+@<Doublecheck the lig/kern commands and the extensible recipes@>;
+for c:=0 to 255 do
+ @<Make sure that |c| is not the largest element of a charlist cycle@>;
+@<Put the width, height, depth, and italic lists into final form@>
+
+@ The checking that we need in several places is accomplished by three
+macros that are only slightly tricky.
+
+@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0);
+ print(#,' '); print_octal(c);
+ print_ln(' had no CHARACTER spec.');
+ end;
+ end
+@d check_existence_and_safety(#)==begin g:=#;
+ if (g>=128)and(c<128) then seven_unsafe:=true;
+ if char_wd[g]=0 then existence_tail
+@d check_existence(#)==begin g:=#;
+ if char_wd[g]=0 then existence_tail
+
+@<For all characters |g| generated by |c|...@>=
+case char_tag[c] of
+no_tag: do_nothing;
+lig_tag: @<Check ligature program of |c|@>;
+list_tag: check_existence_and_safety(char_remainder[c])
+ ('The character NEXTLARGER than');
+@.The character NEXTLARGER...@>
+ext_tag:@<Check the pieces of |exten[c]|@>;
+end
+
+@ @<Check the pieces...@>=
+begin if exten[char_remainder[c]].b0>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b0)
+ ('TOP piece of character');
+@.TOP piece of character...@>
+if exten[char_remainder[c]].b1>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b1)
+ ('MID piece of character');
+@.MID piece of character...@>
+if exten[char_remainder[c]].b2>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b2)
+ ('BOT piece of character');
+@.BOT piece of character...@>
+check_existence_and_safety(exten[char_remainder[c]].b3)
+ ('REP piece of character');
+@.REP piece of character...@>
+end
+
+@ @<Make sure that |c| is not the largest element of a charlist cycle@>=
+if char_tag[c]=list_tag then
+ begin g:=char_remainder[c];
+ while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g];
+ if g=c then
+ begin char_tag[c]:=no_tag;
+ print('A cycle of NEXTLARGER characters has been broken at ');
+@.A cycle of NEXTLARGER...@>
+ print_octal(c); print_ln('.');
+ end;
+ end
+
+@ @<Glob...@>=
+@!delta:fix_word; {size of the intervals needed for rounding}
+
+@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
+@.I had to round...@>
+ #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
+
+@<Put the width, height, depth, and italic lists into final form@>=
+delta:=shorten(width,255); set_indices(width,delta); round_message('width');@/
+delta:=shorten(height,15); set_indices(height,delta); round_message('height');@/
+delta:=shorten(depth,15); set_indices(depth,delta); round_message('depth');@/
+delta:=shorten(italic,63); set_indices(italic,delta);
+ round_message('italic correction');
+
+@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}}
+ lig_kern[nl].b0:=255; lig_kern[nl].b1:=0;
+ lig_kern[nl].b2:=0; lig_kern[nl].b3:=0
+
+@<Make sure the ligature/kerning program ends...@>=
+begin if bchar_label<@'77777 then {make room for it}
+ begin clear_lig_kern_entry; incr(nl);
+ end; {|bchar_label| will be stored later}
+while min_nl>nl do
+ begin clear_lig_kern_entry; incr(nl);
+ end;
+if lig_kern[nl-1].b0=0 then lig_kern[nl-1].b0:=stop_flag;
+end
+
+@ It's not trivial to check for infinite loops generated by repeated
+insertion of ligature characters. But fortunately there is a nice
+algorithm for such testing, copied here from the program \.{TFtoPL}
+where it is explained further.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+
+@ @<Glo...@>=
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!hash:array[0..hash_size] of 0..66048; {$256x+y+1$ for $x\le257$ and $y\le255$}
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of 0..257;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!tt:indx; {temporary register}
+@!x_lig_cycle,@!y_lig_cycle:0..256; {problematic ligature pair}
+
+@ @<Set init...@>=
+hash_ptr:=0; y_lig_cycle:=256;
+for k:=0 to hash_size do hash[k]:=0;
+
+@ @d lig_exam==lig_kern[lig_ptr].b1
+@d lig_gen==lig_kern[lig_ptr].b3
+
+@<Check lig...@>=
+begin lig_ptr:=char_remainder[c];
+repeat if hash_input(lig_ptr,c) then
+ begin if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_exam<>bchar then
+ check_existence(lig_exam)('LIG character examined by');
+@.LIG character examined...@>
+ check_existence(lig_gen)('LIG character generated by');
+@.LIG character generated...@>
+ if lig_gen>=128 then if(c<128)or(c=256) then
+ if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true;
+ end
+ else if lig_exam<>bchar then
+ check_existence(lig_exam)('KRN character examined by');
+@.KRN character examined...@>
+ end;
+if lig_kern[lig_ptr].b0>=stop_flag then lig_ptr:=nl
+else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0;
+until lig_ptr>=nl;
+end
+
+@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made
+into a boolean function that returns |false| if the ligature command
+was masked by a previous one.
+
+@p function hash_input(@!p,@!c:indx):boolean;
+ {enter data for character |c| and command in location |p|, unless it isn't new}
+label 30; {go here for a quick exit}
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:0..255; {function value or ligature character being entered}
+@!y:0..255; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then
+ begin hash_input:=false; goto 30;@+end;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=256*c+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then
+ begin hash_input:=false; goto 30; {unused ligature command}
+ end;
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+hash_input:=true;
+30:end;
+
+@ @<Compute the command param...@>=
+y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple;
+zz:=lig_kern[p].b3;
+if t>=kern_flag then zz:=y
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ (More good stuff from \.{TFtoPL}.)
+
+@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=256*x+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:indx):indx| here.
+
+@p function f;
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=257; class[h]:=simple;
+ end; {the value 257 will break all cycles, since it's not in |hash|}
+end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@ @<Check for infinite...@>=
+if hash_ptr<hash_size then for hh:=1 to hash_ptr do
+ begin tt:=hash_list[hh];
+ if class[tt]>simple then {make sure $f$ is well defined}
+ tt:=f(tt,(hash[tt]-1)div 256,(hash[tt]-1)mod 256);
+ end;
+if(hash_ptr=hash_size)or(y_lig_cycle<256) then
+ begin if hash_ptr<hash_size then
+ begin print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=256 then print('boundary')@+else print_octal(x_lig_cycle);
+ print(' and '); print_octal(y_lig_cycle); print_ln('!');
+ end
+ else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ print_ln('All ligatures will be cleared.');
+ for c:=0 to 255 do if char_tag[c]=lig_tag then
+ begin char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+ nl:=0; bchar:=256; bchar_label:=@'77777;
+ end
+
+@ The lig/kern program may still contain references to nonexistent characters,
+if parts of that program are never used. Similarly, there may be extensible
+characters that are never used, because they were overridden by
+\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we
+must fix such errors.
+
+@d double_check_tail(#)==@t\1@>if char_wd[0]=0
+ then char_wd[0]:=sort_in(width,0);
+ print('Unused ',#,' refers to nonexistent character ');
+ print_octal(c); print_ln('!');
+ end;
+ end
+@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#;
+ if char_wd[c]=0 then if c<>bchar then
+ begin lig_kern[lig_ptr].#:=0; double_check_tail
+@d double_check_ext(#)==begin c:=exten[g].#;
+ if c>0 then if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+@d double_check_rep(#)==begin c:=exten[g].#;
+ if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+
+@<Doublecheck...@>=
+if nl>0 then for lig_ptr:=0 to nl-1 do
+ if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_kern[lig_ptr].b0<255 then
+ begin double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
+ end;
+ end
+ else double_check_lig(b1)('KRN step');
+@.Unused LIG step...@>
+@.Unused KRN step...@>
+if ne>0 then for g:=0 to ne-1 do
+ begin double_check_ext(b0)('VARCHAR TOP');
+ double_check_ext(b1)('VARCHAR MID');
+ double_check_ext(b2)('VARCHAR BOT');
+ double_check_rep(b3)('VARCHAR REP');
+@.Unused VARCHAR...@>
+ end
+
+@* The output phase.
+Now that we know how to get all of the font data correctly stored in
+\.{PLtoTF}'s memory, it only remains to write the answers out.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{TFM} file:
+
+@d out(#)==write(tfm_file,#)
+
+@ The general plan for producing \.{TFM} files is long but simple:
+
+@<Do the output@>=
+@<Compute the twelve subfile sizes@>;
+@<Output the twelve subfile sizes@>;
+@<Output the header block@>;
+@<Output the character info@>;
+@<Output the dimensions themselves@>;
+@<Output the ligature/kern program@>;
+@<Output the extensible character recipes@>;
+@<Output the parameters@>
+
+@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are.
+We already know most of these numbers; for example, the number of distinct
+widths is |memory[width]+1|, where the $+1$ accounts for the zero width that
+is always supposed to be present. But we still should compute the beginning
+and ending character codes (|bc| and |ec|), the number of header words (|lh|),
+and the total number of words in the \.{TFM} file (|lf|).
+
+@<Gl...@>=
+@!bc:byte; {the smallest character code in the font}
+@!ec:byte; {the largest character code in the font}
+@!lh:byte; {the number of words in the header block}
+@!lf:0..32767; {the number of words in the entire \.{TFM} file}
+@!not_found:boolean; {has a font character been found?}
+@!temp_width:fix_word; {width being used to compute a check sum}
+
+@ It might turn out that no characters exist at all. But \.{PLtoTF} keeps
+going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
+will be~1.
+
+@<Compute the twelve...@>=
+lh:=header_ptr div 4;@/
+not_found:=true; bc:=0;
+while not_found do
+ if (char_wd[bc]>0)or(bc=255) then not_found:=false
+ else incr(bc);
+not_found:=true; ec:=255;
+while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+if bc>ec then bc:=1;
+incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+incr(memory[italic]);@/
+@<Compute the ligature/kern program offset@>;
+lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+memory[italic]+nl+lk_offset+nk+ne+np;
+
+@ @d out_size(#)==out((#) div 256); out((#) mod 256)
+
+@<Output the twelve subfile sizes@>=
+out_size(lf); out_size(lh); out_size(bc); out_size(ec);
+out_size(memory[width]); out_size(memory[height]);
+out_size(memory[depth]); out_size(memory[italic]);
+out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np);
+
+@ The routines that follow need a few temporary variables of different types.
+
+@<Gl...@>=
+@!j:0..max_header_bytes; {index into |header_bytes|}
+@!p:pointer; {index into |memory|}
+@!q:width..italic; {runs through the list heads for dimensions}
+@!par_ptr:0..max_param_words; {runs through the parameters}
+
+@ The header block follows the subfile sizes. The necessary information all
+appears in |header_bytes|, except that the design size and the seven-bit-safe
+flag must still be set.
+
+@<Output the header block@>=
+if not check_sum_specified then @<Compute the check sum@>;
+header_bytes[design_size_loc]:=design_size div @'100000000;
+ {this works since |design_size>0|}
+header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256;
+header_bytes[design_size_loc+2]:=(design_size div 256) mod 256;
+header_bytes[design_size_loc+3]:=design_size mod 256;
+if not seven_unsafe then header_bytes[seven_flag_loc]:=128;
+for j:=0 to header_ptr-1 do out(header_bytes[j]);
+
+@ @<Compute the check sum@>=
+begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
+for c:=bc to ec do if char_wd[c]>0 then
+ begin temp_width:=memory[char_wd[c]];
+ if design_units<>unity then
+ temp_width:=round((temp_width/design_units)*1048576.0);
+ temp_width:=temp_width + (c+4)*@'20000000; {this should be positive}
+ c0:=(c0+c0+temp_width) mod 255;
+ c1:=(c1+c1+temp_width) mod 253;
+ c2:=(c2+c2+temp_width) mod 251;
+ c3:=(c3+c3+temp_width) mod 247;
+ end;
+header_bytes[check_sum_loc]:=c0;
+header_bytes[check_sum_loc+1]:=c1;
+header_bytes[check_sum_loc+2]:=c2;
+header_bytes[check_sum_loc+3]:=c3;
+end
+
+@ The next block contains packed |char_info|.
+
+@<Output the character info@>=
+index[0]:=0;
+for c:=bc to ec do
+ begin out(index[char_wd[c]]);
+ out(index[char_ht[c]]*16+index[char_dp[c]]);
+ out(index[char_ic[c]]*4+char_tag[c]);
+ out(char_remainder[c]);
+ end
+
+@ When a scaled quantity is output, we may need to divide it by |design_units|.
+The following subroutine takes care of this, using floating point arithmetic
+only if |design_units<>1.0|.
+
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if abs(x/design_units)>=16.0 then
+ begin print_ln('The relative dimension ',x/@'4000000:1:3,
+ ' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then print(' =',design_units/@'200000:1:3,
+ ' designunits');
+ print_ln(')'); x:=0;
+ end;
+if design_units<>unity then x:=round((x/design_units)*1048576.0);
+if x<0 then
+ begin out(255); x:=x+@'100000000;
+ if x<=0 then x:=1;
+ end
+else begin out(0);
+ if x>=@'100000000 then x:=@'77777777;
+ end;
+n:=x div @'200000; m:=x mod @'200000;
+out(n); out(m div 256); out(m mod 256);
+end;
+
+@ We have output the packed indices for individual characters.
+The scaled widths, heights, depths, and italic corrections are next.
+
+@<Output the dimensions themselves@>=
+for q:=width to italic do
+ begin out(0); out(0); out(0); out(0); {output the zero word}
+ p:=link[q]; {head of list}
+ while p>0 do
+ begin out_scaled(memory[p]);
+ p:=link[p];
+ end;
+ end;
+
+@ One embarrassing problem remains: The ligature/kern program might be very
+long, but the starting addresses in |char_remainder| can be at most~255.
+Therefore we need to output some indirect address information; we want to
+compute |lk_offset| so that addition of |lk_offset| to all remainders makes
+all but |lk_offset| distinct remainders less than~256.
+
+For this we need a sorted table of all relevant remainders.
+
+@<Glob...@>=
+@!label_table:array[0..256] of record
+ @!rr: -1..@'77777; {sorted label values}
+ @!cc: byte; {associated characters}
+ end;
+@!label_ptr:0..256; {index of highest entry in |label_table|}
+@!sort_ptr:0..256; {index into |label_table|}
+@!lk_offset:0..256; {smallest offset value that might work}
+@!t:0..@'77777; {label value that is being redirected}
+@!extra_loc_needed:boolean; {do we need a special word for |bchar|?}
+
+@ @<Compute the ligature/kern program offset@>=
+@<Insert all labels into |label_table|@>;
+if bchar<256 then
+ begin extra_loc_needed:=true; lk_offset:=1;
+ end
+else begin extra_loc_needed:=false; lk_offset:=0;
+ end;
+@<Find the minimum |lk_offset| and adjust all remainders@>;
+if bchar_label<@'77777 then
+ begin lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 256;
+ lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 256;
+ end
+
+@ @<Insert all labels...@>=
+label_ptr:=0; label_table[0].rr:=-1; {sentinel}
+for c:=bc to ec do if char_tag[c]=lig_tag then
+ begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+ while label_table[sort_ptr].rr>char_remainder[c] do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+ label_table[sort_ptr+1].cc:=c;
+ label_table[sort_ptr+1].rr:=char_remainder[c];
+ incr(label_ptr);
+ end
+
+@ @<Find the minimum |lk_offset| and adjust all remainders@>=
+begin sort_ptr:=label_ptr; {the largest unallocated label}
+if label_table[sort_ptr].rr+lk_offset > 255 then
+ begin lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
+ repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do
+ begin decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ end;
+ incr(lk_offset); decr(sort_ptr);
+ until lk_offset+label_table[sort_ptr].rr<256;
+ {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|}
+ end;
+if lk_offset>0 then while sort_ptr>0 do
+ begin char_remainder[label_table[sort_ptr].cc]:=
+ char_remainder[label_table[sort_ptr].cc]+lk_offset;
+ decr(sort_ptr);
+ end;
+end
+
+@ @<Output the ligature/kern program@>=
+if extra_loc_needed then {|lk_offset=1|}
+ begin out(255); out(bchar); out(0); out(0);
+ end
+else for sort_ptr:=1 to lk_offset do {output the redirection specs}
+ begin t:=label_table[label_ptr].rr;
+ if bchar<256 then
+ begin out(255); out(bchar);
+ end
+ else begin out(254); out(0);
+ end;
+ out_size(t+lk_offset);
+ repeat decr(label_ptr); until label_table[label_ptr].rr<t;
+ end;
+if nl>0 then for lig_ptr:=0 to nl-1 do
+ begin out(lig_kern[lig_ptr].b0);
+ out(lig_kern[lig_ptr].b1);
+ out(lig_kern[lig_ptr].b2);
+ out(lig_kern[lig_ptr].b3);
+ end;
+if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
+
+@ @<Output the extensible character recipes@>=
+if ne>0 then for c:=0 to ne-1 do
+ begin out(exten[c].b0);
+ out(exten[c].b1);
+ out(exten[c].b2);
+ out(exten[c].b3);
+ end;
+
+@ For our grand finale, we wind everything up by outputting the parameters.
+
+@<Output the parameters@>=
+for par_ptr:=1 to np do
+ begin if par_ptr=1 then
+ @<Output the slant (|param[1]|) without scaling@>
+ else out_scaled(param[par_ptr]);
+ end
+
+@ @<Output the slant...@>=
+begin if param[1]<0 then
+ begin param[1]:=param[1]+@'10000000000;
+ out((param[1] div @'100000000)+256-64);
+ end
+else out(param[1] div @'100000000);
+out((param[1] div @'200000) mod 256);
+out((param[1] div 256) mod 256);
+out(param[1] mod 256);
+end
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+@p procedure param_enter;
+begin @<Enter the parameter names@>;
+end;
+@#
+procedure name_enter; {enter all names and their equivalents}
+begin @<Enter all of the names...@>;
+param_enter;
+end;
+@#
+procedure read_lig_kern;
+var @!krn_ptr:0..max_kerns; {an index into |kern|}
+@!c:byte; {runs through all character codes}
+begin @<Read ligature/kern list@>;
+end;
+@#
+procedure read_char_info;
+var @!c:byte; {the char}
+begin @<Read character info list@>;
+end;
+@#
+procedure read_input;
+var @!c:byte; {header or parameter index}
+begin @<Read all the input@>;
+end;
+@#
+procedure corr_and_check;
+var @!c:0..256; {runs through all character codes}
+@!hh:0..hash_size; {an index into |hash_list|}
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!g:byte; {a character generated by the current character |c|}
+begin @<Correct and check the information@>
+end;
+
+@ Here is where \.{PLtoTF} begins and ends.
+
+@p begin initialize;@/
+name_enter;@/
+read_input; print_ln('.');@/
+corr_and_check;@/
+@<Do the output@>;
+end.
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PLtoTF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/pooltype.ch b/Build/source/texk/web2c/pooltype.ch
new file mode 100644
index 00000000000..3d54070d2d8
--- /dev/null
+++ b/Build/source/texk/web2c/pooltype.ch
@@ -0,0 +1,170 @@
+% pooltype.ch for C compilation with web2c.
+%
+% 03/23/88 (ETM) Created for use with WEB to C.
+% 11/29/89 (KB) Version released with 8-bit TeX.
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{POOL\lowercase{type} changes for C}
+@z
+
+@x [2] main program changes: no global labels, read command line.
+label 9999; {this labels the end of the program}
+@y
+@z
+@x
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@;
+ begin @<Set initial values of key variables@>@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@;
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+ @<Set initial values of key variables@>
+@z
+
+% [??] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [12] Permissiveness
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+@y
+for i:=0 to @'37 do xchr[i]:=chr(i);
+for i:=@'177 to @'377 do xchr[i]:=chr(i);
+@z
+
+@x Write errors to stderr, avoid nonlocal label.
+@d abort(#)==begin write_ln(#); goto 9999;
+ end
+@y
+@d abort(#)==begin write_ln(stderr, #); uexit(1); end
+@z
+
+@x Remove unused label from end of program; add uexit(0) call
+9999:end.
+@y
+uexit(0);
+end.
+@z
+
+@x Add pool_name variable.
+@!pool_file:packed file of text_char;
+ {the string-pool file output by \.{TANGLE}}
+@y
+@!pool_file:packed file of text_char;
+ {the string-pool file output by \.{TANGLE}}
+@!pool_name:^char;
+@z
+
+% The name of the pool file is dynamically determined. We open it at the
+% end of parse_arguments.
+@x
+reset(pool_file); xsum:=false;
+@y
+xsum:=false;
+@z
+
+@x Change single read into two reads
+read(pool_file,m,n); {read two digits of string length}
+@y
+read(pool_file,m); read(pool_file,n); {read two digits of string length}
+@z
+
+@x System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{POOLtype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 2; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ do_nothing;
+
+ end else if getopt_return_val = '?' then begin
+ usage ('pooltype');
+
+ end else if argument_is ('help') then begin
+ usage_help (POOLTYPE_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit ('This is POOLtype, Version 3.0', nil,
+ 'D.E. Knuth');
+
+ end; {Else it was just a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 1 <> argc) then begin
+ write_ln (stderr, 'pooltype: Need exactly one file argument.');
+ usage ('pooltype');
+ end;
+
+ pool_name := extend_filename (cmdline (optind), 'pool');
+ {Try opening the file here, to avoid printing the first 256 strings if
+ they give a bad filename.}
+ resetbin (pool_file, pool_name);
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+@z
diff --git a/Build/source/texk/web2c/pooltype.rc b/Build/source/texk/web2c/pooltype.rc
new file mode 100644
index 00000000000..99a4613441a
--- /dev/null
+++ b/Build/source/texk/web2c/pooltype.rc
@@ -0,0 +1,34 @@
+/* pooltype.rc: pooltype resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " pooltype 3.0"
+
+#define VER_INTERNALNAME_STR "pooltype"
+#define VER_ORIGINALFILENAME_STR "pooltype.exe"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#define VER_FILEDESCRIPTION_STR "Converts string pool files into symbolic format"
+
+#include <texlive.version>
+
+/* pooltype.rc ends here */
diff --git a/Build/source/texk/web2c/pooltype.web b/Build/source/texk/web2c/pooltype.web
new file mode 100644
index 00000000000..a7f7617abfb
--- /dev/null
+++ b/Build/source/texk/web2c/pooltype.web
@@ -0,0 +1,430 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was implemented in June 1982.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 2 (July 1983) is consistent with TeX version 0.999.
+% Version 3 (September 1989) is consistent with 8-bit TeX.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{POOL\lowercase{type}}
+\def\contentspagenumber{101}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont POOLtype} processor}
+ \vskip 15pt
+ \centerline{(Version 3, September 1989)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{POOLtype} utility program converts string pool files output
+by \.{TANGLE} into a slightly more symbolic format that may be useful
+when \.{TANGLE}d programs are being debugged.
+
+It's a pretty trivial routine, but people may want to try transporting
+this program before they get up enough courage to tackle \TeX\ itself.
+The first 256 strings are treated as \TeX\ treats them, using routines
+copied from \TeX82.
+
+@ \.{POOLtype} is written entirely in standard \PASCAL, except that it has
+to do some slightly system-dependent character code conversion on input
+and output. The input is read from |pool_file|, and the output is written
+on |output|. If the input is erroneous, the |output| file will describe
+the error.
+@^system dependencies@>
+
+@p program POOLtype(@!pool_file,@!output);
+label 9999; {this labels the end of the program}
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@;
+ begin @<Set initial values of key variables@>@/
+ end;
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* The character set.
+(The following material is copied verbatim from \TeX82.
+Thus, the same system-dependent changes should be made to both programs.)
+
+In order to make \TeX\ readily portable between a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+code that includes standard ASCII, the ``American Standard Code for
+Information Interchange.'' This conversion is done immediately when each
+character is read in. Conversely, characters are converted from ASCII to
+the user's external representation just before they are output to a
+text file.
+
+Such an internal code is relevant to users of \TeX\ primarily because it
+governs the positions of characters in the fonts. For example, the
+character `\.A' has ASCII code $65=@'101$, and when \TeX\ typesets
+this letter it specifies character number 65 in the current font.
+If that font actually has `\.A' in a different position, \TeX\ doesn't
+know what the real position is; the program that does the actual printing from
+\TeX's device-independent files is responsible for converting from ASCII to
+a particular font encoding.
+@^ASCII code@>
+
+\TeX's internal code is relevant also with respect to constants
+that begin with a reverse apostrophe; and it provides an index to the
+\.{\\catcode}, \.{\\mathcode}, \.{\\uccode}, \.{\\lccode}, and \.{\\delcode}
+tables.
+
+@ Characters of text that have been converted to \TeX's internal form
+are said to be of type |ASCII_code|, which is a subrange of the integers.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, especially in a program for typesetting;
+so the present specification of \TeX\ has been written under the assumption
+that the \PASCAL\ compiler and run-time system permit the use of text files
+with more than 64 distinguishable characters. More precisely, we assume that
+the character set contains at least the letters and symbols associated
+with ASCII codes @'40 through @'176; all of these characters are now
+available on most computer terminals.
+
+Since we are dealing with more characters than were present in the first
+\PASCAL\ compilers, we have to decide what to call the associated data
+type. Some \PASCAL s use the original name |char| for the
+characters in text files, even though there now are more than 64 such
+characters, while other \PASCAL s consider |char| to be a 64-element
+subrange of a larger data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters that are converted to and
+from |ASCII_code| when they are input and output. We shall also assume
+that |text_char| consists of the elements |chr(first_text_char)| through
+|chr(last_text_char)|, inclusive. The following definitions should be
+adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Local variables for init...@>=
+@!i:integer;
+
+@ The \TeX\ processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Glob...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ Since we are assuming that our \PASCAL\ system is able to read and
+write the visible characters of standard ASCII (although not
+necessarily using the ASCII codes to represent them), the following
+assignment statements initialize the standard part of the |xchr| array
+properly, without needing any system-dependent changes. On the other
+hand, it is possible to implement \TeX\ with less complete character
+sets, and in such cases it will be necessary to change something here.
+@^system dependencies@>
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+
+@ Some of the ASCII codes without visible characters have been given symbolic
+names in this program because they are used with a special meaning.
+
+@d null_code=@'0 {ASCII code that might disappear}
+@d carriage_return=@'15 {ASCII code used at end of line}
+@d invalid_code=@'177 {ASCII code that many systems prohibit in text files}
+
+@ The ASCII code is ``standard'' only to a certain extent, since many
+computer installations have found it advantageous to have ready access
+to more than 94 printing characters. Appendix~C of {\sl The \TeX book\/}
+gives a complete specification of the intended correspondence between
+characters and \TeX's internal representation.
+@:TeXbook}{\sl The \TeX book@>
+
+If \TeX\ is being used
+on a garden-variety \PASCAL\ for which only standard ASCII
+codes will appear in the input and output files, it doesn't really matter
+what codes are specified in |xchr[0..@'37]|, but the safest policy is to
+blank everything out by using the code shown below.
+
+However, other settings of |xchr| will make \TeX\ more friendly on
+computers that have an extended character set, so that users can type things
+like `\.^^Z' instead of `\.{\\ne}'. People with extended character sets can
+assign codes arbitrarily, giving an |xchr| equivalent to whatever
+characters the users of \TeX\ are allowed to have in their input files.
+It is best to make the codes correspond to the intended interpretations as
+shown in Appendix~C whenever possible; but this is not necessary. For
+example, in countries with an alphabet of more than 26 letters, it is
+usually best to map the additional letters into codes less than~@'40.
+To get the most ``permissive'' character set, change |' '| on the
+right of these assignment statements to |chr(i)|.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
+where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
+|j| or more; hence, standard ASCII code numbers will be used instead of
+codes below @'40 in case there is a coincidence.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
+for i:=@'200 to @'377 do xord[xchr[i]]:=i;
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+
+@* String handling.
+(The following material is copied from the \\{get\_strings\_started} procedure
+of \TeX82, with slight changes.)
+
+@<Glob...@>=
+@!k,@!l:0..255; {small indices or counters}
+@!m,@!n:text_char; {characters input from |pool_file|}
+@!s:integer; {number of strings treated so far}
+
+@ The global variable |count| keeps track of the total number of characters
+in strings.
+
+@<Glob...@>=
+@!count:integer; {how long the string pool is, so far}
+
+@ @<Set init...@>=
+count:=0;
+
+@ This is the main program, where \.{POOLtype} starts and ends.
+
+@d abort(#)==begin write_ln(#); goto 9999;
+ end
+
+@p begin initialize;@/
+@<Make the first 256 strings@>;
+s:=256;@/
+@<Read the other strings from the \.{POOL} file,
+ or give an error message and abort@>;
+write_ln('(',count:1,' characters in all.)');
+9999:end.
+
+@ @d lc_hex(#)==l:=#;
+ if l<10 then l:=l+"0" @+else l:=l-10+"a"
+
+@<Make the first 256...@>=
+for k:=0 to 255 do
+ begin write(k:3,': "'); l:=k;
+ if (@<Character |k| cannot be printed@>) then
+ begin write(xchr["^"],xchr["^"]);
+ if k<@'100 then l:=k+@'100
+ else if k<@'200 then l:=k-@'100
+ else begin lc_hex(k div 16); write(xchr[l]); lc_hex(k mod 16); incr(count);
+ end;
+ count:=count+2;
+ end;
+ if l="""" then write(xchr[l],xchr[l])
+ else write(xchr[l]);
+ incr(count); write_ln('"');
+ end
+
+@ The first 128 strings will contain 95 standard ASCII characters, and the
+other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
+unless a system-dependent change is made here. Installations that have
+an extended character set, where for example |xchr[@'32]=@t\.{\'^^Z\'}@>|,
+would like string @'32 to be the single character @'32 instead of the
+three characters @'136, @'136, @'132 (\.{\^\^Z}). On the other hand,
+even people with an extended character set will want to represent string
+@'15 by \.{\^\^M}, since @'15 is |carriage_return|; the idea is to
+produce visible strings instead of tabs or line-feeds or carriage-returns
+or bell-rings or characters that are treated anomalously in text files.
+
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+The boolean expression defined here should be |true| unless \TeX\
+internal code number~|k| corresponds to a non-troublesome visible
+symbol in the local character set. An appropriate formula for the
+extended character set recommended in {\sl The \TeX book\/} would, for
+example, be `|k in [0,@'10..@'12,@'14,@'15,@'33,@'177..@'377]|'.
+If character |k| cannot be printed, and |k<@'200|, then character |k+@'100| or
+|k-@'100| must be printable; moreover, ASCII codes |[@'41..@'46,
+@'60..@'71, @'141..@'146, @'160..@'171]| must be printable.
+Thus, at least 80 printable characters are needed.
+@:TeXbook}{\sl The \TeX book@>
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Character |k| cannot be printed@>=
+ (k<" ")or(k>"~")
+
+@ When the \.{WEB} system program called \.{TANGLE} processes a source file,
+it outputs a \PASCAL\ program and also a string pool file. The present
+program reads the latter file, where each string appears as a two-digit decimal
+length followed by the string itself, and the information is output with its
+associated index number. The strings are surrounded by double-quote marks;
+double-quotes in the string itself are repeated.
+
+@<Glob...@>=
+@!pool_file:packed file of text_char;
+ {the string-pool file output by \.{TANGLE}}
+@!xsum:boolean; {has the check sum been found?}
+
+@ @<Read the other strings...@>=
+reset(pool_file); xsum:=false;
+if eof(pool_file) then abort('! I can''t read the POOL file.');
+repeat @<Read one string, but abort if there are problems@>;
+until xsum;
+if not eof(pool_file) then abort('! There''s junk after the check sum')
+
+@ @<Read one string...@>=
+if eof(pool_file) then abort('! POOL file contained no check sum');
+read(pool_file,m,n); {read two digits of string length}
+if m<>'*' then
+ begin if (xord[m]<"0")or(xord[m]>"9")or(xord[n]<"0")or(xord[n]>"9") then
+ abort('! POOL line doesn''t begin with two digits');
+ l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
+ write(s:3,': "'); count:=count+l;
+ for k:=1 to l do
+ begin if eoln(pool_file) then
+ begin write_ln('"'); abort('! That POOL line was too short');
+ end;
+ read(pool_file,m); write(xchr[xord[m]]);
+ if xord[m]="""" then write(xchr[""""]);
+ end;
+ write_ln('"'); incr(s);
+ end
+else xsum:=true;
+read_ln(pool_file)
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{POOLtype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Indications of system dependencies appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/stamp-auto.in b/Build/source/texk/web2c/stamp-auto.in
new file mode 100644
index 00000000000..ffe8a99f2a5
--- /dev/null
+++ b/Build/source/texk/web2c/stamp-auto.in
@@ -0,0 +1 @@
+Mo Aug 22 08:26:24 CEST 2005
diff --git a/Build/source/texk/web2c/stamp-h.in b/Build/source/texk/web2c/stamp-h.in
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/stamp-h.in
diff --git a/Build/source/texk/web2c/tangle.ch b/Build/source/texk/web2c/tangle.ch
new file mode 100644
index 00000000000..3bb756e7266
--- /dev/null
+++ b/Build/source/texk/web2c/tangle.ch
@@ -0,0 +1,816 @@
+% tangle.ch for C compilation with web2c.
+%
+% 10/9/82 (HT) Original version
+% 11/29 (HT) New version, with conversion to lowercase handled properly
+% Also, new control sequence:
+% @=...text...@> Put ...text... verbatim on a line
+% by itself in the Pascal output.
+% (argument must fit on one line)
+% This control sequence facilitates putting #include "gcons.h"
+% (for example) in files meant for the pc compiler.
+% Also, changed command line usage, so that the absence of a
+% change file implies no change file, rather than one with the
+% same name as the web file, with .ch at the end.
+% 1/15/83 (HT) Changed to work with version 1.2, which incorporates the
+% above change (though unbundling the output line breaking),
+% so mainly had to remove stuff.
+% 2/17 (HT) Fixed bug that caused 0-9 in identifiers to be converted to
+% Q-Y on output.
+% 3/18 (HT) Brought up to work with Version 1.5. Added -r command line
+% flag to cause a .rpl file to be written with all the lines
+% of the .web file that were replaced because of the .ch file
+% (useful for comparing with previous .rpl files, to see if a
+% change file will still work with a new version of a .web file)
+% Also, made it write a newline just before exit.
+% 4/12 (PC) Merged with Pavel's version, including adding a call to exit()
+% at the end depending upon the value of history.
+% 4/16 (PC) Brought up to date with version 1.5 released April, 1983.
+% 6/28 (HWT) Brought up to date with version 1.7 released June, 1983.
+% With new change file format, the -r option is now unnecessary.
+% 7/17 (HWT) Brought up to date with version 2.0 released July, 1983.
+% 12/18/83 (ETM) Brought up to date with version 2.5 released November, 1983.
+% 11/07/84 (ETM) Brought up to date with version 2.6.
+% 12/15/85 (ETM) Brought up to date with version 2.8.
+% 03/07/88 (ETM) Converted for use with WEB2C
+% 01/02/89 (PAM) Cosmetic upgrade to version 2.9
+% 11/30/89 (KB) Version 4.
+% (more recent changes in the ChangeLog)
+
+@x [0] Print only changes.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{TANGLE changes for C}
+@z
+
+@x [2] Define and call parse_arguments.
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values@>@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+ @<Set initial values@>@/
+@z
+
+@x [8] Constants: increase id lengths, for TeX--XeT and tex2pdf.
+@!buf_size=100; {maximum length of input line}
+@y
+@!buf_size=3000; {maximum length of input line}
+@z
+@x
+@!max_toks=50000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+ must be less than 65536}
+@!max_names=4000; {number of identifiers, strings, module names;
+ must be less than 10240}
+@!max_texts=2000; {number of replacement texts, must be less than 10240}
+@y
+@!max_toks=60000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+ must be less than 65536}
+@!max_names=10000; {number of identifiers, strings, module names;
+ must be less than 10240}
+@!max_texts=10000; {number of replacement texts, must be less than 10240}
+@z
+
+@x
+@!stack_size=50; {number of simultaneous levels of macro expansion}
+@!max_id_length=12; {long identifiers are chopped to this length, which must
+ not exceed |line_length|}
+@!unambig_length=7; {identifiers must be unique if chopped to this length}
+ {note that 7 is more strict than \PASCAL's 8, but this can be varied}
+@y
+@!stack_size=100; {number of simultaneous levels of macro expansion}
+@!max_id_length=50; {long identifiers are chopped to this length, which must
+ not exceed |line_length|}
+@!def_unambig_length=32; {identifiers must be unique if chopped to this length}
+@z
+
+% [??] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [17] enable maximum character set
+for i:=1 to @'37 do xchr[i]:=' ';
+for i:=@'200 to @'377 do xchr[i]:=' ';
+@y
+for i:=1 to @'37 do xchr[i]:=chr(i);
+for i:=@'200 to @'377 do xchr[i]:=chr(i);
+@z
+
+@x [20] terminal output: use standard i/o
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@y
+@d term_out==stdout
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@z
+
+@x
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+@y
+@z
+
+@x [21] init terminal
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{TANGLE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal.
+@^system dependencies@>
+
+@<Set init...@>=
+ {Nothing need be done for C.}
+@z
+
+@x [22] flush terminal buffer
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == fflush(term_out) {empty the terminal output buffer}
+@z
+
+@x [24] open input files
+begin reset(web_file); reset(change_file);
+@y
+begin web_file := kpse_open_file(web_name, kpse_web_format);
+if chg_name then change_file := kpse_open_file(chg_name, kpse_web_format);
+@z
+
+@x [26] Open output files (except for the pool file).
+rewrite(Pascal_file); rewrite(pool);
+@y
+rewrite (Pascal_file, pascal_name);
+@z
+
+@x [28] Fix f^.
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+@y
+ begin buffer[limit]:=xord[getc(f)];
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do vgetc(f);
+@z
+
+@x [??] Fix `jump_out'.
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_TANGLE;
+end;
+@y
+@d jump_out==uexit(1)
+@d fatal_error(#)==begin new_line; write(stderr, #);
+ error; mark_fatal; uexit(1);
+ end
+@z
+
+@x [38] Provide for a larger `byte_mem' and `tok_mem'. Extra capacity:
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@d zz=3 {we multiply the token capacity by approximately this amount}
+@y
+@d ww=3 {we multiply the byte capacity by approximately this amount}
+@d zz=5 {we multiply the token capacity by approximately this amount}
+@z
+
+@x [38] Provide for larger than 16bit numeric macros.
+@!equiv: array [0..max_names] of sixteen_bits; {info corresponding to names}
+@y
+@!equiv: array [0..max_names] of integer; {info corresponding to names}
+@z
+
+@x [47] Provide for larger than 16bit numeric macros.
+their |equiv| value contains the corresponding numeric value plus $2^{15}$.
+@y
+their |equiv| value contains the corresponding numeric value plus $2^{30}$.
+@z
+
+@x [47] Add parametric2 macros (macros that use [] to delimit arguments).
+\yskip\hang |parametric| identifiers have been defined to be parametric macros;
+like simple identifiers, their |equiv| value points to the replacement text.
+@y
+\yskip\hang |parametric| and |parametric2| identifiers have been defined to
+be parametric macros; like simple identifiers, their |equiv| value points to
+the replacement text.
+@z
+@x
+@d parametric=3 {parametric macros have |parametric| ilk}
+@y
+@d parametric=3 {parametric macros have |parametric| ilk}
+@d parametric2=4 {second type of parametric macros have this |ilk|}
+@z
+
+@x [50] unambig_length is a variabe now
+@!chopped_id:array [0..unambig_length] of ASCII_code; {chopped identifier}
+@y
+@!chopped_id:array [0..max_id_length] of ASCII_code; {chopped identifier}
+@z
+
+@x [53] Add parametric2 macros (macros that use [] to delimit arguments).
+|numeric|, |simple|, or |parametric|.
+@y
+|numeric|, |simple|, |parametric|, or |parametric2|.
+@z
+
+@x [53] unambig_length is a variable.
+@!s:0..unambig_length; {index into |chopped_id|}
+@y
+@!s:0..max_id_length; {index into |chopped_id|}
+@z
+
+@x [58] Case smashing options/strict checking.
+ begin if buffer[i]<>"_" then
+ begin if buffer[i]>="a" then chopped_id[s]:=buffer[i]-@'40
+@y
+ begin if (buffer[i]<>"_") or (allow_underlines and not strict_mode) then
+ begin if (strict_mode or force_uppercase) and (buffer[i]>="a") then
+ chopped_id[s]:=buffer[i]-@'40
+ else if (not strict_mode and force_lowercase)
+ and (buffer[i]>="A") and (buffer[i]<="Z") then
+ chopped_id[s]:=buffer[i]+@'40
+@z
+
+@x [63] Case smashing options/strict checking.
+ if c<>"_" then
+ begin if c>="a" then c:=c-@'40; {merge lowercase with uppercase}
+@y
+ if c<>"_" or (allow_underlines and not strict_mode) then
+ begin if (strict_mode or force_uppercase) and (c>="a") then c:=c-@'40
+ else if (not strict_mode and force_lowercase)
+ and (c>="A") and (c<="Z") then
+ c:=c+@'40;
+@z
+
+@x [64] Delayed pool file opening / larger numerics.
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+ equiv[p]:=buffer[id_first+1]+@'100000
+else begin equiv[p]:=string_ptr+@'100000;
+ l:=l-double_chars-1;
+@y
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+ equiv[p]:=buffer[id_first+1]+@'10000000000
+else begin
+ {Avoid creating empty pool files.}
+ if string_ptr = 256 then begin
+ {Change |".web"| to |".pool"| and use the current directory.}
+ pool_name := basename_change_suffix (web_name, '.web', '.pool');
+ rewritebin (pool, pool_name);
+ end;
+ equiv[p]:=string_ptr+@'10000000000;
+ l:=l-double_chars-1;
+@z
+
+@x [85] Add parametric2 macros (macros that use [] to delimit arguments).
+ begin if ilk[cur_name]=parametric then
+@y
+ begin if (ilk[cur_name]=parametric) or (ilk[cur_name]=parametric2) then
+@z
+
+@x [89] Larger numerics.
+numeric: begin cur_val:=equiv[a]-@'100000; a:=number;
+@y
+numeric: begin cur_val:=equiv[a]-@'10000000000; a:=number;
+@z
+
+@x [89] Add parametric2 macros (macros that use [] to delimit arguments).
+parametric: begin @<Put a parameter on the parameter stack,
+@y
+parametric,parametric2: begin @<Put a parameter on the parameter stack,
+@z
+
+@x [90] Add parametric2 macros (macros that use [] to delimit arguments).
+if (stack_ptr=0)or(tok_mem[zo,cur_byte]<>"(") then
+@y
+if (stack_ptr=0)or((ilk[a]=parametric)and(tok_mem[zo,cur_byte]<>"("))
+ or((ilk[a]=parametric2)and(tok_mem[zo,cur_byte]<>"[")) then
+@z
+
+@x [93] Add parametric2 macros (macros that use [] to delimit arguments).
+bal:=1; incr(cur_byte); {skip the opening `\.('}
+@y
+bal:=1; incr(cur_byte); {skip the opening `\.(' or `['}
+@z
+@x
+ "(": incr(bal);
+ ")": begin decr(bal);
+@y
+ "(": if ilk[a]=parametric then incr(bal);
+ ")": if ilk[a]=parametric then begin decr(bal);
+ if bal=0 then goto done;
+ end;
+ "[": if ilk[a]=parametric2 then incr(bal);
+ "]": if ilk[a]=parametric2 then begin decr(bal);
+@z
+
+@x [105] Accept DIV, div, MOD, and mod
+ (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+ ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@|
+@^uppercase@>
+@y
+ (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+ ((out_contrib[1]="d")and(out_contrib[2]="i")and(out_contrib[3]="v")) or@|
+ ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) or@|
+ ((out_contrib[1]="m")and(out_contrib[2]="o")and(out_contrib[3]="d")) ))or@|
+@z
+
+@x [110] lowercase ids
+@^uppercase@>
+ if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+ (out_buf[out_ptr-1]="V"))or @/
+ ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+ (out_buf[out_ptr-1]="D")) then@/ goto bad_case
+@y
+ if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+ (out_buf[out_ptr-1]="V"))or @/
+ ((out_buf[out_ptr-3]="d")and(out_buf[out_ptr-2]="i")and
+ (out_buf[out_ptr-1]="v"))or @/
+ ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+ (out_buf[out_ptr-1]="D"))or @/
+ ((out_buf[out_ptr-3]="m")and(out_buf[out_ptr-2]="o")and
+ (out_buf[out_ptr-1]="d")) then@/ goto bad_case
+@z
+
+@x [114] lowercase operators (`and', `or', etc.)
+and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D";
+@^uppercase@>
+ send_out(ident,3);
+ end;
+not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T";
+ send_out(ident,3);
+ end;
+set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N";
+ send_out(ident,2);
+ end;
+or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2);
+@y
+and_sign: begin out_contrib[1]:="a"; out_contrib[2]:="n"; out_contrib[3]:="d";
+ send_out(ident,3);
+ end;
+not_sign: begin out_contrib[1]:="n"; out_contrib[2]:="o"; out_contrib[3]:="t";
+ send_out(ident,3);
+ end;
+set_element_sign: begin out_contrib[1]:="i"; out_contrib[2]:="n";
+ send_out(ident,2);
+ end;
+or_sign: begin out_contrib[1]:="o"; out_contrib[2]:="r"; send_out(ident,2);
+@z
+
+@x [116] Case smashing options.
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to uppercase,
+with underlines removed. Extremely long identifiers must be chopped.
+
+(Some \PASCAL\ compilers work with lowercase letters instead of
+uppercase. If this module of \.{TANGLE} is changed, it's also necessary
+to change from uppercase to lowercase in the modules that are
+listed in the index under ``uppercase''.)
+@^system dependencies@>
+@^uppercase@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+ #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
+ end;
+"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1);
+ end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+ while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+ begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+ if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40
+ else if out_contrib[k]="_" then decr(k);
+ end;
+ send_out(ident,k);
+ end;
+@y
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to lowercase,
+with underlines removed. Extremely long identifiers must be chopped.
+@^system dependencies@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+ #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"): begin if force_lowercase then out_contrib[1]:=cur_char+@'40
+ else out_contrib[1]:=cur_char;
+ send_out(ident,1);
+ end;
+"a",up_to("z"): begin if force_uppercase then out_contrib[1]:=cur_char-@'40
+ else out_contrib[1]:=cur_char;
+ send_out(ident,1);
+ end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+ while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+ begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+ if force_uppercase and (out_contrib[k]>="a") then
+ out_contrib[k]:=out_contrib[k]-@'40
+ else if force_lowercase and (out_contrib[k]<="Z") then
+ out_contrib[k]:=out_contrib[k]+@'40
+ else if not allow_underlines and (out_contrib[k]="_") then decr(k);
+ end;
+ send_out(ident,k);
+ end;
+@z
+
+@x [119] Stretch limits of constants to match what we set for expressions.
+ if n>=@'2000000000 then err_print('! Constant too big')
+@y
+ if n>=@'10000000000 then err_print('! Constant too big')
+@z
+@x
+ if n>=@"8000000 then err_print('! Constant too big')
+@y
+ if n>=@"40000000 then err_print('! Constant too big')
+@z
+
+@x [157] Fix casting bug
+@d add_in(#)==begin accumulator:=accumulator+next_sign*(#); next_sign:=+1;
+ end
+@y
+@d add_in(#)==begin accumulator:=accumulator+next_sign*intcast(#); next_sign:=+1;
+ end
+@z
+
+@x [157] Larger numerics.
+if abs(accumulator)>=@'100000 then
+@y
+if abs(accumulator)>=@'10000000000 then
+@z
+
+@x [157] Larger numerics.
+equiv[p]:=accumulator+@'100000; {name |p| now is defined to equal |accumulator|}
+@y
+equiv[p]:=accumulator+@'10000000000; {name |p| now is defined to equal |accumulator|}
+@z
+
+@x [158] Larger numerics.
+ add_in(equiv[q]-@'100000);
+@y
+ add_in(equiv[q]-@'10000000000);
+@z
+
+@x [165] Add parametric2 macros (macros that use [] to delimit arguments).
+ "(": incr(bal);
+ ")": if bal=0 then err_print('! Extra )')
+@.Extra )@>
+ else decr(bal);
+ "'": @<Copy a string from the buffer to |tok_mem|@>;
+ "#": if t=parametric then a:=param;
+@y
+ "(": if t=parametric then incr(bal);
+ ")": if t=parametric then if bal=0 then err_print('! Extra )')
+@.Extra )@>
+ else decr(bal);
+ "[": if t=parametric2 then incr(bal);
+ "]": if t=parametric2 then if bal=0 then err_print('! Extra ]')
+@.Extra ]@>
+ else decr(bal);
+ "'": @<Copy a string from the buffer to |tok_mem|@>;
+ "#": if (t=parametric)or(t=parametric2) then a:=param;
+@z
+
+@x [166] Add parametric2 macros (macros that use [] to delimit arguments).
+ begin if bal=1 then err_print('! Missing )')
+ else err_print('! Missing ',bal:1,' )''s');
+@.Missing n )@>
+ while bal>0 do
+ begin app_repl(")"); decr(bal);
+ end;
+ end
+@y
+ if t=parametric then begin
+ if bal=1 then err_print('! Missing )')
+ else err_print('! Missing ',bal:1,' )''s');
+@.Missing n )@>
+ while bal>0 do
+ begin app_repl(")"); decr(bal);
+ end;
+ end
+ else begin
+ if bal=1 then err_print('! Missing ]')
+ else err_print('! Missing ',bal:1,' ]''s');
+@.Missing n ]@>
+ while bal>0 do
+ begin app_repl("]"); decr(bal);
+ end;
+ end
+@z
+
+@x [173] Add parametric2 macros (macros that use [] to delimit arguments).
+ else @<If the next text is `|(#)==|', call |define_macro|
+ and |goto continue|@>;
+@y
+ else @<If the next text is `|(#)==|' or |[#]==|, call |define_macro|
+ and |goto continue|@>;
+@z
+
+@x [174] Add parametric2 macros (macros that use [] to delimit arguments).
+@ @<If the next text is `|(#)==|'...@>=
+if next_control="(" then
+ begin next_control:=get_next;
+ if next_control="#" then
+ begin next_control:=get_next;
+ if next_control=")" then
+ begin next_control:=get_next;
+ if next_control="=" then
+ begin err_print('! Use == for macros');
+@.Use == for macros@>
+ next_control:=equivalence_sign;
+ end;
+ if next_control=equivalence_sign then
+ begin define_macro(parametric); goto continue;
+ end;
+ end;
+ end;
+ end;
+@y
+@ @<If the next text is `|(#)==|'...@>=
+if next_control="(" then
+ begin next_control:=get_next;
+ if next_control="#" then
+ begin next_control:=get_next;
+ if next_control=")" then
+ begin next_control:=get_next;
+ if next_control="=" then
+ begin err_print('! Use == for macros');
+@.Use == for macros@>
+ next_control:=equivalence_sign;
+ end;
+ if next_control=equivalence_sign then
+ begin define_macro(parametric); goto continue;
+ end;
+ end;
+ end;
+ end
+else if next_control="[" then
+ begin next_control:=get_next;
+ if next_control="#" then
+ begin next_control:=get_next;
+ if next_control="]" then
+ begin next_control:=get_next;
+ if next_control="=" then
+ begin err_print('! Use == for macros');
+@.Use == for macros@>
+ next_control:=equivalence_sign;
+ end;
+ if next_control=equivalence_sign then
+ begin define_macro(parametric2); goto continue;
+ end;
+ end;
+ end;
+ end
+@z
+
+@x [179] make term_in = input
+any error stop will set |debug_cycle| to zero.
+@y
+any error stop will set |debug_cycle| to zero.
+
+@d term_in==stdin
+@z
+
+@x
+@!term_in:text_file; {the user's terminal as an input file}
+@y
+@z
+
+@x [180] remove term_in reset
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+@y
+@z
+
+@x [182] write newline just before exit; use value of |history|
+print_ln(banner); {print a ``banner line''}
+@y
+print (banner); {print a ``banner line''}
+print_ln (version_string);
+@z
+
+@x
+@<Print the job |history|@>;
+@y
+@<Print the job |history|@>;
+new_line;
+if (history <> spotless) and (history <> harmless_message)
+then uexit (1)
+else uexit (0);
+@z
+
+@x [188] System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TANGLE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 10; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+ @!len: integer;
+begin
+ @<Define the option table@>;
+ unambig_length := def_unambig_length;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('tangle');
+
+ end else if argument_is ('help') then begin
+ usage_help (TANGLE_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.E. Knuth');
+
+ end else if argument_is ('mixedcase') then begin
+ force_uppercase := false;
+ force_lowercase := false;
+
+ end else if argument_is ('uppercase') then begin
+ force_uppercase := true;
+ force_lowercase := false;
+
+ end else if argument_is ('lowercase') then begin
+ force_uppercase := false;
+ force_lowercase := true;
+
+ end else if argument_is ('underlines') then begin
+ allow_underlines := true;
+
+ end else if argument_is ('strict') then begin
+ strict_mode := true;
+
+ end else if argument_is ('loose') then begin
+ strict_mode := false;
+
+ end else if argument_is ('length') then begin
+ len := atoi(optarg);
+ if (len<=0) or (len>max_id_length) then len := max_id_length;
+ unambig_length := len;
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ write_ln (stderr, 'tangle: Need one or two file arguments.');
+ usage ('tangle');
+ end;
+
+ {Supply |".web"| and |".ch"| extensions if necessary.}
+ web_name := extend_filename (cmdline (optind), 'web');
+ if optind + 2 = argc then begin
+ chg_name := extend_filename (cmdline (optind + 1), 'ch');
+ end;
+
+ {Change |".web"| to |".p"| and use the current directory.}
+ pascal_name := basename_change_suffix (web_name, '.web', '.p');
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Use all mixed case.
+@.-mixedcase@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'mixedcase';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Use all uppercase.
+@.-uppercase@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'uppercase';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Use all lowercase.
+@.-lowercase@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'lowercase';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Allow underlines.
+@.-underlines@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'underlines';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Strict comparisions.
+@.-strict@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'strict';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Loose comparisions.
+@.-loose@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'loose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Loose comparisions.
+@.-length@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'length';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Globals...@>=
+@!web_name,@!chg_name,@!pascal_name,@!pool_name:c_string;
+@!force_uppercase,@!force_lowercase,@!allow_underlines,@!strict_mode:boolean;
+@!unambig_length:0..max_id_length;
+@z
diff --git a/Build/source/texk/web2c/tangle.rc b/Build/source/texk/web2c/tangle.rc
new file mode 100644
index 00000000000..d61cc115501
--- /dev/null
+++ b/Build/source/texk/web2c/tangle.rc
@@ -0,0 +1,34 @@
+/* afm2tfm.rc: afm2tfm resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " tangle 4.4"
+
+#define VER_INTERNALNAME_STR "tangle"
+#define VER_ORIGINALFILENAME_STR "tangle.exe"
+
+#define VER_FILEDESCRIPTION_STR "Web-to-Pascal Converter"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#include <texlive.version>
+
+/* tangle.rc ends here */
diff --git a/Build/source/texk/web2c/tangle.web b/Build/source/texk/web2c/tangle.web
new file mode 100644
index 00000000000..8fa1c395f06
--- /dev/null
+++ b/Build/source/texk/web2c/tangle.web
@@ -0,0 +1,3325 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was released in December, 1981.
+% Version 1 was released in September, 1982, with version 0 of TeX.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 1.2 introduced {:nnn} comments, added @@= and @@\ (December, 1982).
+% Version 1.4 added "history" (February, 1983).
+% Version 1.5 conformed to TeX version 0.96 and fixed @@\ (March, 1983).
+% Version 1.7 introduced the new change file format (June, 1983).
+% Version 2.0 was released in July, 1983, with version 0.999 of TeX.
+% Version 2.5 was released in November, 1983, with version 1.0 of TeX.
+% Version 2.6 fixed a bug: force-line-break after a constant (August, 1984).
+% Version 2.7 fixed the definition of check_sum_prime (May, 1985).
+% Version 2.8 fixed a bug in change_buffer movement (August, 1985).
+% Version 2.9 allows nonnumeric macros before their def (December, 1988).
+% Version 3, for Sewell's book, fixed long-line bug in input_ln (March, 1989).
+% Version 4 was major change to allow 8-bit input (September, 1989).
+% Version 4.1 conforms to ANSI standard for-loop rules (September, 1990).
+% Version 4.2 fixes stat report if phase one dies (March, 1991).
+% Version 4.3 fixes @@ bug in verbatim, catches extra } (September, 1991).
+% Version 4.4 activates debug_help on errors as advertised (February, 1993).
+% Version 4.5 prevents modno-comments from being split across lines (Dec 2002).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\def\pb{$\.|\ldots\.|$} % Pascal brackets (|...|)
+\def\v{\.{\char'174}} % vertical (|) in typewriter font
+\mathchardef\BA="3224 % double arrow
+\def\({} % kludge for alphabetizing certain module names
+
+\def\title{TANGLE}
+\def\contentspagenumber{123} % should be odd
+\def\topofcontents{\null\vfill
+ \titlefalse % include headline on the contents page
+ \def\rheader{\mainfont Appendix E\hfil \contentspagenumber}
+ \centerline{\titlefont The {\ttitlefont TANGLE} processor}
+ \vskip 15pt
+ \centerline{(Version 4.5)}
+ \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program converts a \.{WEB} file to a \PASCAL\ file. It was written
+by D. E. Knuth in September, 1981; a somewhat similar {\mc SAIL} program had
+been developed in March, 1979. Since this program describes itself, a
+bootstrapping process involving hand-translation had to be used to get started.
+
+For large \.{WEB} files one should have a large memory, since \.{TANGLE} keeps
+all the \PASCAL\ text in memory (in an abbreviated form). The program uses
+a few features of the local \PASCAL\ compiler that may need to be changed in
+other installations:
+
+\yskip\item{1)} Case statements have a default.
+\item{2)} Input-output routines may need to be adapted for use with a particular
+character set and/or for printing messages on the user's terminal.
+
+\yskip\noindent
+These features are also present in the \PASCAL\ version of \TeX, where they
+are used in a similar (but more complex) way. System-dependent portions
+of \.{TANGLE} can be identified by looking at the entries for `system
+dependencies' in the index below.
+@!@^system dependencies@>
+
+The ``banner line'' defined here should be changed whenever \.{TANGLE}
+is modified.
+
+@d banner=='This is TANGLE, Version 4.5'
+
+@ The program begins with a fairly normal header, made up of pieces that
+@^system dependencies@>
+will mostly be filled in later. The \.{WEB} input comes from files |web_file|
+and |change_file|, the \PASCAL\ output goes to file |Pascal_file|,
+and the string pool output goes to file |pool|.
+
+If it is necessary to abort the job because of a fatal error, the program
+calls the `|jump_out|' procedure, which goes to the label |end_of_TANGLE|.
+
+@d end_of_TANGLE = 9999 {go here to wrap it up}
+
+@p @t\4@>@<Compiler directives@>@/
+program TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool);
+label end_of_TANGLE; {go here to finish}
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values@>@/
+ end;
+
+@ Some of this code is optional for use when debugging only;
+such material is enclosed between the delimiters |debug| and $|gubed|$.
+Other parts, delimited by |stat| and $|tats|$, are optionally included if
+statistics about \.{TANGLE}'s memory usage are desired.
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$'
+ when gathering usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
+ when gathering usage statistics}
+@f stat==begin
+@f tats==end
+
+@ The \PASCAL\ compiler used to develop this system has ``compiler
+directives'' that can appear in comments whose first character is a dollar sign.
+In production versions of \.{TANGLE} these directives tell the compiler that
+@^system dependencies@>
+it is safe to avoid range checks and to leave out the extra code it inserts
+for the \PASCAL\ debugger's benefit, although interrupts will occur if
+there is arithmetic overflow.
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ Labels are given symbolic names by the following definitions. We insert
+the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
+procedure in which we have used the `|return|' statement defined below;
+the label `|restart|' is occasionally used at the very beginning of a
+procedure; and the label `|reswitch|' is occasionally used just prior to
+a \&{case} statement in which some cases change the conditions and we wish to
+branch to the newly applicable case.
+Loops that are set up with the \&{loop} construction defined below are
+commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
+and they are sometimes repeated by going to `|continue|'.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=31 {go here when you've found it}
+@d not_found=32 {go here when you've found something else}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@f loop == xclause
+
+@ We assume that |case| statements may include a default case that applies
+if no matching label is found. Thus, we shall use constructions like
+@^system dependencies@>
+$$\vbox{\halign{#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the compiler
+used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
+and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
+`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
+and |endcases| should be changed to agree with local conventions. (Of
+course, if no default mechanism is available, the |case| statements of
+this program must be extended by listing all remaining cases. The author
+would have taken the trouble to modify \.{TANGLE} so that such extensions
+were done automatically, if he had not wanted to encourage \PASCAL\
+compiler writers to make this important change in \PASCAL, where it belongs.)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters are set big enough to handle \TeX, so they
+should be sufficient for most applications of \.{TANGLE}.
+
+@<Constants...@>=
+@!buf_size=100; {maximum length of input line}
+@!max_bytes=45000; {|1/ww| times the number of bytes in identifiers,
+ strings, and module names; must be less than 65536}
+@!max_toks=50000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+ must be less than 65536}
+@!max_names=4000; {number of identifiers, strings, module names;
+ must be less than 10240}
+@!max_texts=2000; {number of replacement texts, must be less than 10240}
+@!hash_size=353; {should be prime}
+@!longest_name=400; {module names shouldn't be longer than this}
+@!line_length=72; {lines of \PASCAL\ output have at most this many characters}
+@!out_buf_size=144; {length of output buffer, should be twice |line_length|}
+@!stack_size=50; {number of simultaneous levels of macro expansion}
+@!max_id_length=12; {long identifiers are chopped to this length, which must
+ not exceed |line_length|}
+@!unambig_length=7; {identifiers must be unique if chopped to this length}
+ {note that 7 is more strict than \PASCAL's 8, but this can be varied}
+
+@ A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d harmless_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+@#
+@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
+@d mark_error==history:=error_message
+@d mark_fatal==history:=fatal_message
+
+@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
+
+@ @<Set init...@>=history:=spotless;
+
+@* The character set.
+One of the main goals in the design of \.{WEB} has been to make it readily
+portable between a wide variety of computers. Yet \.{WEB} by its very
+nature must use a greater variety of characters than most computer
+programs deal with, and character encoding is one of the areas in which
+existing machines differ most widely from each other.
+
+To resolve this problem, all input to \.{WEAVE} and \.{TANGLE} is converted
+to an internal eight-bit code that is essentially standard ASCII, the ``American
+Standard Code for Information Interchange.'' The conversion is done
+immediately when each character is read in. Conversely, characters are
+converted from ASCII to the user's external representation just before
+they are output. (The original ASCII code was seven bits only; \.{WEB} now
+allows eight bits in an attempt to keep up with modern times.)
+
+Such an internal code is relevant to users of \.{WEB} only because it is
+the code used for preprocessed constants like \.{"A"}. If you are writing
+a program in \.{WEB} that makes use of such one-character constants, you
+should convert your input to ASCII form, like \.{WEAVE} and \.{TANGLE} do.
+Otherwise \.{WEB}'s internal coding scheme does not affect you.
+@^ASCII code@>
+
+Here is a table of the standard visible ASCII codes:
+$$\def\:{\char\count255\global\advance\count255 by 1}
+\count255='40
+\vbox{
+\hbox{\hbox to 40pt{\it\hfill0\/\hfill}%
+\hbox to 40pt{\it\hfill1\/\hfill}%
+\hbox to 40pt{\it\hfill2\/\hfill}%
+\hbox to 40pt{\it\hfill3\/\hfill}%
+\hbox to 40pt{\it\hfill4\/\hfill}%
+\hbox to 40pt{\it\hfill5\/\hfill}%
+\hbox to 40pt{\it\hfill6\/\hfill}%
+\hbox to 40pt{\it\hfill7\/\hfill}}
+\vskip 4pt
+\hrule
+\def\^{\vrule height 10.5pt depth 4.5pt}
+\halign{\hbox to 0pt{\hskip -24pt\O{#0}\hfill}&\^
+\hbox to 40pt{\tt\hfill#\hfill\^}&
+&\hbox to 40pt{\tt\hfill#\hfill\^}\cr
+04&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+05&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+06&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+07&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+10&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+11&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+12&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+13&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+14&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+15&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+16&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+17&\:&\:&\:&\:&\:&\:&\:\cr}
+\hrule width 280pt}$$
+(Actually, of course, code @'040 is an invisible blank space.) Code @'136
+was once an upward arrow (\.{\char'13}), and code @'137 was
+once a left arrow (\.^^X), in olden times when the first draft
+of ASCII code was prepared; but \.{WEB} works with today's standard
+ASCII in which those codes represent circumflex and underline as shown.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers, a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, so \.{WEB} assumes that it is being used
+with a \PASCAL\ whose character set contains at least the characters of
+standard ASCII as listed above. Some \PASCAL\ compilers use the original
+name |char| for the data type associated with the characters in text files,
+while other \PASCAL s consider |char| to be a 64-element subrange of a larger
+data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters in the input and output
+files. We shall also assume that |text_char| consists of the elements
+|chr(first_text_char)| through |chr(last_text_char)|, inclusive. The
+following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{WEAVE} and \.{TANGLE} processors convert between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ If we assume that every system using \.{WEB} is able to read and write the
+visible characters of standard ASCII (although not necessarily using the
+ASCII codes to represent them), the following assignment statements initialize
+most of the |xchr| array properly, without needing any system-dependent
+changes. For example, the statement \.{xchr[@@\'101]:=\'A\'} that appears
+in the present \.{WEB} file might be encoded in, say, {\mc EBCDIC} code
+on the external medium on which it resides, but \.{TANGLE} will convert from
+this external code to ASCII and back again. Therefore the assignment
+statement \.{XCHR[65]:=\'A\'} will appear in the corresponding \PASCAL\ file,
+and \PASCAL\ will compile this statement so that |xchr[65]| receives the
+character \.A in the external (|char|) code. Note that it would be quite
+incorrect to say \.{xchr[@@\'101]:="A"}, because |"A"| is a constant of
+type |integer|, not |char|, and because we have $|"A"|=65$ regardless of
+the external character set.
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+xchr[0]:=' '; xchr[@'177]:=' '; {these ASCII codes are not used}
+
+@ Some of the ASCII codes below @'40 have been given symbolic names in
+\.{WEAVE} and \.{TANGLE} because they are used with a special meaning.
+
+@d and_sign=@'4 {equivalent to `\.{and}'}
+@d not_sign=@'5 {equivalent to `\.{not}'}
+@d set_element_sign=@'6 {equivalent to `\.{in}'}
+@d tab_mark=@'11 {ASCII code used as tab-skip}
+@d line_feed=@'12 {ASCII code thrown away at end of line}
+@d form_feed=@'14 {ASCII code used at end of page}
+@d carriage_return=@'15 {ASCII code used at end of line}
+@d left_arrow=@'30 {equivalent to `\.{:=}'}
+@d not_equal=@'32 {equivalent to `\.{<>}'}
+@d less_or_equal=@'34 {equivalent to `\.{<=}'}
+@d greater_or_equal=@'35 {equivalent to `\.{>=}'}
+@d equivalence_sign=@'36 {equivalent to `\.{==}'}
+@d or_sign=@'37 {equivalent to `\.{or}'}
+
+@ When we initialize the |xord| array and the remaining parts of |xchr|,
+it will be convenient to make use of an index variable, |i|.
+
+@<Local variables for init...@>=
+@!i:0..255;
+
+@ Here now is the system-dependent part of the character set.
+If \.{WEB} is being implemented on a garden-variety \PASCAL\ for which
+only standard ASCII codes will appear in the input and output files, you
+don't need to make any changes here. But if you have, for example, an extended
+character set like the one in Appendix~C of {\sl The \TeX book}, the first
+line of code in this module should be changed to
+$$\hbox{|for i:=1 to @'37 do xchr[i]:=chr(i);|}$$
+\.{WEB}'s character set is essentially identical to \TeX's, even with respect to
+characters less than @'40.
+@^system dependencies@>
+
+Changes to the present module will make \.{WEB} more friendly on computers
+that have an extended character set, so that one can type things like
+\.^^Z\ instead of \.{<>}. If you have an extended set of characters that
+are easily incorporated into text files, you can assign codes arbitrarily
+here, giving an |xchr| equivalent to whatever characters the users of
+\.{WEB} are allowed to have in their input files, provided that unsuitable
+characters do not correspond to special codes like |carriage_return|
+that are listed above.
+
+(The present file \.{TANGLE.WEB} does not contain any of the non-ASCII
+characters, because it is intended to be used with all implementations of
+\.{WEB}. It was originally created on a Stanford system that has a
+convenient extended character set, then ``sanitized'' by applying another
+program that transliterated all of the non-standard characters into
+standard equivalents.)
+
+@<Set init...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+for i:=@'200 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=" ";
+for i:=1 to @'377 do xord[xchr[i]]:=i;
+xord[' ']:=" ";
+
+@* Input and output.
+The input conventions of this program are intended to be very much like those
+of \TeX\ (except, of course, that they are much simpler, because much less
+needs to be done). Furthermore they are identical to those of \.{WEAVE}.
+Therefore people who need to make modifications to all three systems
+should be able to do so without too many headaches.
+
+We use the standard \PASCAL\ input/output procedures in several places that
+\TeX\ cannot, since \.{TANGLE} does not have to deal with files that are named
+dynamically by the user, and since there is no input from the terminal.
+
+@ Terminal output is done by writing on file |term_out|, which is assumed to
+consist of characters of type |text_char|:
+@^system dependencies@>
+
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
+@d new_line==write_ln(term_out) {start new line}
+@d print_nl(#)== {print information starting on a new line}
+ begin new_line; print(#);
+ end
+
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{TANGLE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+
+@ The |update_terminal| procedure is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ The main input comes from |web_file|; this input may be overridden
+by changes in |change_file|. (If |change_file| is empty, there are no changes.)
+
+@<Globals...@>=
+@!web_file:text_file; {primary input}
+@!change_file:text_file; {updates}
+
+@ The following code opens the input files. Since these files were listed
+in the program header, we assume that the \PASCAL\ runtime system has
+already checked that suitable file names have been given; therefore no
+additional error checking needs to be done.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read |web_file| and |change_file|}
+begin reset(web_file); reset(change_file);
+end;
+
+@ The main output goes to |Pascal_file|, and string pool constants are
+written to the |pool| file.
+
+@<Globals...@>=
+@!Pascal_file: text_file;
+@!pool: text_file;
+
+@ The following code opens |Pascal_file| and |pool|.
+Since these files were listed in the program header, we assume that the
+\PASCAL\ runtime system has checked that suitable external file names have
+been given.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(Pascal_file); rewrite(pool);
+
+@ Input goes into an array called |buffer|.
+
+@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code;
+
+@ The |input_ln| procedure brings the next line of input from the specified
+file into the |buffer| array and returns the value |true|, unless the file has
+already been entirely read, in which case it returns |false|. The conventions
+of \TeX\ are followed; i.e., |ASCII_code| numbers representing the next line
+of the file are input into |buffer[0]|, |buffer[1]|, \dots,
+|buffer[limit-1]|; trailing blanks are ignored;
+and the global variable |limit| is set to the length of the
+@^system dependencies@>
+line. The value of |limit| must be strictly less than |buf_size|.
+
+We assume that none of the |ASCII_code| values
+of |buffer[j]| for |0<=j<limit| is equal to 0, @'177, |line_feed|, |form_feed|,
+or |carriage_return|.
+
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ if final_limit>limit then final_limit:=limit;
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+
+@* Reporting errors to the user.
+The \.{TANGLE} processor operates in two phases: first it inputs the source
+file and stores a compressed representation of the program, then it produces
+the \PASCAL\ output from the compressed representation.
+
+The global variable |phase_one| tells whether we are in Phase I or not.
+
+@<Globals...@>=
+@!phase_one: boolean; {|true| in Phase I, |false| in Phase II}
+
+@ If an error is detected while we are debugging,
+we usually want to look at the contents of memory.
+A special procedure will be declared later for this purpose.
+
+@<Error handling...@>=
+@!debug @+ procedure debug_help; forward;@+ gubed
+
+@ During the first phase, syntax errors are reported to the user by saying
+$$\hbox{`|err_print('! Error message')|'},$$
+followed by `|jump_out|' if no recovery from the error is provided.
+This will print the error message followed by an indication of where the error
+was spotted in the source file. Note that no period follows the error message,
+since the error routine will automatically supply a period.
+
+Errors that are noticed during the second phase are reported to the user
+in the same fashion, but the error message will be
+followed by an indication of where the error was spotted in the output file.
+
+The actual error indications are provided by a procedure called |error|.
+
+@d err_print(#)==begin new_line; print(#); error;
+ end
+
+@<Error handling...@>=
+procedure error; {prints '\..' and location of error message}
+var j: 0..out_buf_size; {index into |out_buf|}
+@!k,@!l: 0..buf_size; {indices into |buffer|}
+begin if phase_one then @<Print error location based on input buffer@>
+else @<Print error location based on output buffer@>;
+update_terminal; mark_error;
+@!debug debug_skipped:=debug_cycle; debug_help;@+gubed
+end;
+
+@ The error locations during Phase I can be indicated by using the global
+variables |loc|, |line|, and |changing|, which tell respectively the first
+unlooked-at position in |buffer|, the current line number, and whether or not
+the current line is from |change_file| or |web_file|.
+This routine should be modified on systems whose standard text editor
+has special line-numbering conventions.
+@^system dependencies@>
+
+@<Print error location based on input buffer@>=
+begin if changing then print('. (change file ')@+else print('. (');
+print_ln('l.', line:1, ')');
+if loc>=limit then l:=limit else l:=loc;
+for k:=1 to l do
+ if buffer[k-1]=tab_mark then print(' ')
+ else print(xchr[buffer[k-1]]); {print the characters already read}
+new_line;
+for k:=1 to l do print(' '); {space out the next line}
+for k:=l+1 to limit do print(xchr[buffer[k-1]]); {print the part not yet read}
+print(' '); {this space separates the message from future asterisks}
+end
+
+@ The position of errors detected during the second phase can be indicated
+by outputting the partially-filled output buffer, which contains |out_ptr|
+entries.
+
+@<Print error location based on output...@>=
+begin print_ln('. (l.',line:1,')');
+for j:=1 to out_ptr do print(xchr[out_buf[j-1]]); {print current partial line}
+print('... '); {indicate that this information is partial}
+end
+
+@ The |jump_out| procedure just cuts across all active procedure levels
+and jumps out of the program. This is the only non-local |goto| statement
+in \.{TANGLE}. It is used when no recovery from a particular error has
+been provided.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the code that appears at label |end_of_TANGLE| should be
+copied into the |jump_out| procedure, followed by a call to a system procedure
+that terminates the program.
+
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_TANGLE;
+end;
+
+@ Sometimes the program's behavior is far different from what it should be,
+and \.{TANGLE} prints an error message that is really for the \.{TANGLE}
+maintenance person, not the user. In such cases the program says
+|confusion('indication of where we are')|.
+
+@d confusion(#)==fatal_error('! This can''t happen (',#,')')
+@.This can't happen@>
+
+@ An overflow stop occurs if \.{TANGLE}'s tables aren't large enough.
+
+@d overflow(#)==fatal_error('! Sorry, ',#,' capacity exceeded')
+@.Sorry, x capacity exceeded@>
+
+
+@* Data structures.
+Most of the user's \PASCAL\ code is packed into eight-bit integers
+in two large arrays called |byte_mem| and |tok_mem|.
+The |byte_mem| array holds the names of identifiers, strings, and modules;
+the |tok_mem| array holds the replacement texts
+for macros and modules. Allocation is sequential, since things are deleted only
+during Phase II, and only in a last-in-first-out manner.
+
+Auxiliary arrays |byte_start| and |tok_start| are used as directories to
+|byte_mem| and |tok_mem|, and the |link|, |ilk|, |equiv|, and |text_link|
+arrays give further information about names. These auxiliary arrays
+consist of sixteen-bit items.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!sixteen_bits=0..65535; {unsigned two-byte quantity}
+
+@ \.{TANGLE} has been designed to avoid the need for indices that are more
+than sixteen bits wide, so that it can be used on most computers. But
+there are programs that need more than 65536 tokens, and some programs
+even need more than 65536 bytes; \TeX\ is one of these. To get around
+this problem, a slight complication has been added to the data structures:
+|byte_mem| and |tok_mem| are two-dimensional arrays, whose first index is
+either 0 or 1. (For generality, the first index is actually allowed to run
+between 0 and |ww-1| in |byte_mem|, or between 0 and |zz-1| in |tok_mem|,
+where |ww| and |zz| are set to 2 and~3; the program will work for any
+positive values of |ww| and |zz|, and it can be simplified in obvious ways
+if |ww=1| or |zz=1|.)
+
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@d zz=3 {we multiply the token capacity by approximately this amount}
+
+@<Globals...@>=
+@!byte_mem: packed array [0..ww-1,0..max_bytes] of ASCII_code;
+ {characters of names}
+@!tok_mem: packed array [0..zz-1,0..max_toks] of eight_bits; {tokens}
+@!byte_start: array [0..max_names] of sixteen_bits; {directory into |byte_mem|}
+@!tok_start: array [0..max_texts] of sixteen_bits; {directory into |tok_mem|}
+@!link: array [0..max_names] of sixteen_bits; {hash table or tree links}
+@!ilk: array [0..max_names] of sixteen_bits; {type codes or tree links}
+@!equiv: array [0..max_names] of sixteen_bits; {info corresponding to names}
+@!text_link: array [0..max_texts] of sixteen_bits; {relates replacement texts}
+
+@ The names of identifiers are found by computing a hash address |h| and
+then looking at strings of bytes signified by |hash[h]|, |link[hash[h]]|,
+|link[link[hash[h]]]|, \dots, until either finding the desired name
+or encountering a zero.
+
+A `|name_pointer|' variable, which signifies a name, is an index into
+|byte_start|. The actual sequence of characters in the name pointed to by
+|p| appears in positions |byte_start[p]| to |byte_start[p+ww]-1|, inclusive,
+in the segment of |byte_mem| whose first index is |p mod ww|. Thus, when
+|ww=2| the even-numbered name bytes appear in |byte_mem[0,@t$*$@>]|
+and the odd-numbered ones appear in |byte_mem[1,@t$*$@>]|.
+The pointer 0 is used for undefined module names; we don't
+want to use it for the names of identifiers, since 0 stands for a null
+pointer in a linked list.
+
+Strings are treated like identifiers; the first character (a double-quote)
+distinguishes a string from an alphabetic name, but for \.{TANGLE}'s purposes
+strings behave like numeric macros. (A `string' here refers to the
+strings delimited by double-quotes that \.{TANGLE} processes. \PASCAL\
+string constants delimited by single-quote marks are not given such special
+treatment; they simply appear as sequences of characters in the \PASCAL\
+texts.) The total number of strings in the string
+pool is called |string_ptr|, and the total number of names in |byte_mem|
+is called |name_ptr|. The total number of bytes occupied in
+|byte_mem[w,@t$*$@>]| is called |byte_ptr[w]|.
+
+We usually have |byte_start[name_ptr+w]=byte_ptr[(name_ptr+w) mod ww]|
+for |0<=w<ww|, since these are the starting positions for the next |ww|
+names to be stored in |byte_mem|.
+
+@d length(#)==byte_start[#+ww]-byte_start[#] {the length of a name}
+
+@<Types...@>=
+@!name_pointer=0..max_names; {identifies a name}
+
+@ @<Global...@>=
+@!name_ptr:name_pointer; {first unused position in |byte_start|}
+@!string_ptr:name_pointer; {next number to be given to a string of length |<>1|}
+@!byte_ptr:array [0..ww-1] of 0..max_bytes;
+ {first unused position in |byte_mem|}
+@!pool_check_sum:integer; {sort of a hash for the whole string pool}
+
+@ @<Local variables for init...@>=
+@!wi: 0..ww-1; {to initialize the |byte_mem| indices}
+
+@ @<Set init...@>=
+for wi:=0 to ww-1 do
+ begin byte_start[wi]:=0; byte_ptr[wi]:=0;
+ end;
+byte_start[ww]:=0; {this makes name 0 of length zero}
+name_ptr:=1; string_ptr:=256; pool_check_sum:=271828;
+
+@ Replacement texts are stored in |tok_mem|, using similar conventions.
+A `|text_pointer|' variable is an index into |tok_start|, and the
+replacement text that corresponds to |p| runs from positions
+|tok_start[p]| to |tok_start[p+zz]-1|, inclusive, in the segment of
+|tok_mem| whose first index is |p mod zz|. Thus, when |zz=2| the
+even-numbered replacement texts appear in |tok_mem[0,@t$*$@>]| and the
+odd-numbered ones appear in |tok_mem[1,@t$*$@>]|. Furthermore,
+|text_link[p]| is used to connect pieces of text that have the same name,
+as we shall see later. The pointer 0 is used for undefined replacement
+texts.
+
+The first position of |tok_mem[z,@t$*$@>]| that is unoccupied by
+replacement text is called |tok_ptr[z]|, and the first unused location of
+|tok_start| is called |text_ptr|. We usually have the identity
+|tok_start[text_ptr+z]=tok_ptr[(text_ptr+z) mod zz]|, for |0<=z<zz|, since
+these are the starting positions for the next |zz| replacement texts to
+be stored in |tok_mem|.
+
+@<Types...@>=
+@!text_pointer=0..max_texts; {identifies a replacement text}
+
+@ It is convenient to maintain a variable |z| that is equal to |text_ptr
+mod zz|, so that we always insert tokens into segment |z| of |tok_mem|.
+
+@<Glob...@>=
+@t\hskip1em@>@!text_ptr:text_pointer; {first unused position in |tok_start|}
+@t\hskip1em@>@!tok_ptr:array[0..zz-1] of 0..max_toks;
+ {first unused position in a given segment of |tok_mem|}
+@t\hskip1em@>@!z:0..zz-1; {current segment of |tok_mem|}
+stat @!max_tok_ptr:array[0..zz-1] of 0..max_toks;
+ {largest values assumed by |tok_ptr|}
+tats
+
+@ @<Local variables for init...@>=
+@!zi:0..zz-1; {to initialize the |tok_mem| indices}
+
+@ @<Set init...@>=
+for zi:=0 to zz-1 do
+ begin tok_start[zi]:=0; tok_ptr[zi]:=0;
+ end;
+tok_start[zz]:=0; {this makes replacement text 0 of length zero}
+text_ptr:=1; z:=1 mod zz;
+
+@ Four types of identifiers are distinguished by their |ilk|:
+
+\yskip\hang |normal| identifiers will appear in the \PASCAL\ program as
+ordinary identifiers since they have not been defined to be macros; the
+corresponding value in the |equiv| array
+for such identifiers is a link in a secondary hash table that
+is used to check whether any two of them agree in their first |unambig_length|
+characters after underline symbols are removed and lowercase letters are
+changed to uppercase.
+
+\yskip\hang |numeric| identifiers have been defined to be numeric macros;
+their |equiv| value contains the corresponding numeric value plus $2^{15}$.
+Strings are treated as numeric macros.
+
+\yskip\hang |simple| identifiers have been defined to be simple macros;
+their |equiv| value points to the corresponding replacement text.
+
+\yskip\hang |parametric| identifiers have been defined to be parametric macros;
+like simple identifiers, their |equiv| value points to the replacement text.
+
+@d normal=0 {ordinary identifiers have |normal| ilk}
+@d numeric=1 {numeric macros and strings have |numeric| ilk}
+@d simple=2 {simple macros have |simple| ilk}
+@d parametric=3 {parametric macros have |parametric| ilk}
+
+@ The names of modules are stored in |byte_mem| together
+with the identifier names, but a hash table is not used for them because
+\.{TANGLE} needs to be able to recognize a module name when given a prefix of
+that name. A conventional binary seach tree is used to retrieve module names,
+with fields called |llink| and |rlink| in place of |link| and |ilk|. The
+root of this tree is |rlink[0]|. If |p| is a pointer to a module name,
+|equiv[p]| points to its replacement text, just as in simple and parametric
+macros, unless this replacement text has not yet been defined (in which case
+|equiv[p]=0|).
+
+@d llink==link {left link in binary search tree for module names}
+@d rlink==ilk {right link in binary search tree for module names}
+
+@<Set init...@>=
+rlink[0]:=0; {the binary search tree starts out with nothing in it}
+equiv[0]:=0; {the undefined module has no replacement text}
+
+@ Here is a little procedure that prints the text of a given name.
+
+@p procedure print_id(@!p:name_pointer); {print identifier or module name}
+var k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+begin if p>=name_ptr then print('IMPOSSIBLE')
+else begin w:=p mod ww;
+ for k:=byte_start[p] to byte_start[p+ww]-1 do print(xchr[byte_mem[w,k]]);
+ end;
+end;
+
+@* Searching for identifiers.
+The hash table described above is updated by the |id_lookup| procedure,
+which finds a given identifier and returns a pointer to its index in
+|byte_start|. If the identifier was not already present, it is inserted with
+a given |ilk| code; and an error message is printed if the identifier is being
+doubly defined.
+
+Because of the way \.{TANGLE}'s scanning mechanism works, it is most convenient
+to let |id_lookup| search for an identifier that is present in the |buffer|
+array. Two other global variables specify its position in the buffer: the
+first character is |buffer[id_first]|, and the last is |buffer[id_loc-1]|.
+Furthermore, if the identifier is really a string, the global variable
+|double_chars| tells how many of the characters in the buffer appear
+twice (namely \.{@@@@} and \.{""}), since this additional information makes
+it easy to calculate the true length of the string. The final double-quote
+of the string is not included in its ``identifier,'' but the first one is,
+so the string length is |id_loc-id_first-double_chars-1|.
+
+We have mentioned that |normal| identifiers belong to two hash tables,
+one for their true names as they appear in the \.{WEB} file and the other
+when they have been reduced to their first |unambig_length| characters.
+The hash tables are kept by the method of simple chaining, where the
+heads of the individual lists appear in the |hash| and |chop_hash| arrays.
+If |h| is a hash code, the primary hash table list starts at |hash[h]| and
+proceeds through |link| pointers; the secondary hash table list starts at
+|chop_hash[h]| and proceeds through |equiv| pointers. Of course, the same
+identifier will probably have two different values of |h|.
+
+The |id_lookup| procedure uses an auxiliary array called |chopped_id| to
+contain up to |unambig_length| characters of the current identifier, if
+it is necessary to compute the secondary hash code. (This array could be
+declared local to |id_lookup|, but in general we are making all array
+declarations global in this program, because some compilers and some machine
+architectures make dynamic array allocation inefficient.)
+
+@<Glob...@>=
+@!id_first:0..buf_size; {where the current identifier begins in the buffer}
+@!id_loc:0..buf_size; {just after the current identifier in the buffer}
+@!double_chars:0..buf_size; {correction to length in case of strings}
+@#
+@!hash,@!chop_hash:array [0..hash_size] of sixteen_bits; {heads of hash lists}
+@!chopped_id:array [0..unambig_length] of ASCII_code; {chopped identifier}
+
+@ Initially all the hash lists are empty.
+
+@<Local variables for init...@>=
+@!h:0..hash_size; {index into hash-head arrays}
+
+@ @<Set init...@>=
+for h:=0 to hash_size-1 do
+ begin hash[h]:=0; chop_hash[h]:=0;
+ end;
+
+@ Here now is the main procedure for finding identifiers (and strings).
+The parameter |t| is set to |normal| except when the identifier is
+a macro name that is just being defined; in the latter case, |t| will be
+|numeric|, |simple|, or |parametric|.
+
+@p function id_lookup(@!t:eight_bits):name_pointer; {finds current identifier}
+label found, not_found;
+var c:eight_bits; {byte being chopped}
+@!i:0..buf_size; {index into |buffer|}
+@!h:0..hash_size; {hash code}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!l:0..buf_size; {length of the given identifier}
+@!p,@!q:name_pointer; {where the identifier is being sought}
+@!s:0..unambig_length; {index into |chopped_id|}
+begin l:=id_loc-id_first; {compute the length}
+@<Compute the hash code |h|@>;
+@<Compute the name location |p|@>;
+if (p=name_ptr)or(t<>normal) then
+ @<Update the tables and check for possible errors@>;
+id_lookup:=p;
+end;
+
+@ A simple hash code is used: If the sequence of
+ASCII codes is $c_1c_2\ldots c_m$, its hash value will be
+$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the hash...@>=
+h:=buffer[id_first]; i:=id_first+1;
+while i<id_loc do
+ begin h:=(h+h+buffer[i]) mod hash_size; incr(i);
+ end
+
+@ If the identifier is new, it will be placed in position |p=name_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the name location...@>=
+p:=hash[h];
+while p<>0 do
+ begin if length(p)=l then
+ @<Compare name |p| with current identifier, |goto found| if equal@>;
+ p:=link[p];
+ end;
+p:=name_ptr; {the current identifier is new}
+link[p]:=hash[h]; hash[h]:=p; {insert |p| at beginning of hash list}
+found:
+
+@ @<Compare name |p|...@>=
+begin i:=id_first; k:=byte_start[p]; w:=p mod ww;
+while (i<id_loc)and(buffer[i]=byte_mem[w,k]) do
+ begin incr(i); incr(k);
+ end;
+if i=id_loc then goto found; {all characters agree}
+end
+
+@ @<Update the tables...@>=
+begin if ((p<>name_ptr)and(t<>normal)and(ilk[p]=normal)) or
+ ((p=name_ptr)and(t=normal)and(buffer[id_first]<>"""")) then
+ @<Compute the secondary hash code |h| and put the first characters
+ into the auxiliary array |chopped_id|@>;
+if p<>name_ptr then
+ @<Give double-definition error, if necessary, and change |p| to type |t|@>
+else @<Enter a new identifier into the table at position |p|@>;
+end
+
+@ The following routine, which is called into play when it is necessary to
+look at the secondary hash table, computes the same hash function as before
+(but on the chopped data), and places a zero after the chopped identifier
+in |chopped_id| to serve as a convenient sentinel.
+
+@<Compute the secondary...@>=
+begin i:=id_first; s:=0; h:=0;
+while (i<id_loc)and(s<unambig_length) do
+ begin if buffer[i]<>"_" then
+ begin if buffer[i]>="a" then chopped_id[s]:=buffer[i]-@'40
+ else chopped_id[s]:=buffer[i];
+ h:=(h+h+chopped_id[s]) mod hash_size; incr(s);
+ end;
+ incr(i);
+ end;
+chopped_id[s]:=0;
+end
+
+@ If a nonnumeric macro has appeared before it was defined, \.{TANGLE}
+will still work all right; after all, such behavior is typical of the
+replacement texts for modules, which act very much like macros.
+However, an undefined numeric macro may not be used on the right-hand
+side of another numeric macro definition, so \.{TANGLE} finds it
+simplest to make a blanket rule that numeric macros should be defined
+before they are used. The following routine gives an error message and
+also fixes up any damage that may have been caused.
+
+@<Give double...@>= {now |p<>name_ptr| and |t<>normal|}
+begin if ilk[p]=normal then
+ begin if t=numeric then err_print('! This identifier has already appeared');
+@.This identifier has already...@>
+ @<Remove |p| from secondary hash table@>;
+ end
+else err_print('! This identifier was defined before');
+@.This identifier was defined...@>
+ilk[p]:=t;
+end
+
+@ When we have to remove a secondary hash entry, because a |normal| identifier
+is changing to another |ilk|, the hash code |h| and chopped identifier have
+already been computed.
+
+@<Remove |p| from secondary...@>=
+q:=chop_hash[h];
+if q=p then chop_hash[h]:=equiv[p]
+else begin while equiv[q]<>p do q:=equiv[q];
+ equiv[q]:=equiv[p];
+ end
+
+@ The following routine could make good use of a generalized |pack| procedure
+that puts items into just part of a packed array instead of the whole thing.
+
+@<Enter a new identifier...@>=
+begin if (t=normal)and(buffer[id_first]<>"""") then
+ @<Check for ambiguity and update secondary hash@>;
+w:=name_ptr mod ww; k:=byte_ptr[w];
+if k+l>max_bytes then overflow('byte memory');
+if name_ptr>max_names-ww then overflow('name');
+i:=id_first; {get ready to move the identifier into |byte_mem|}
+while i<id_loc do
+ begin byte_mem[w,k]:=buffer[i]; incr(k); incr(i);
+ end;
+byte_ptr[w]:=k; byte_start[name_ptr+ww]:=k; incr(name_ptr);
+if buffer[id_first]<>"""" then ilk[p]:=t
+else @<Define and output a new string of the pool@>;
+end
+
+@ @<Check for ambig...@>=
+begin q:=chop_hash[h];
+while q<>0 do
+ begin @<Check if |q| conflicts with |p|@>;
+ q:=equiv[q];
+ end;
+equiv[p]:=chop_hash[h]; chop_hash[h]:=p; {put |p| at front of secondary list}
+end
+
+@ @<Check if |q| conflicts...@>=
+begin k:=byte_start[q]; s:=0; w:=q mod ww;
+while (k<byte_start[q+ww]) and (s<unambig_length) do
+ begin c:=byte_mem[w,k];
+ if c<>"_" then
+ begin if c>="a" then c:=c-@'40; {merge lowercase with uppercase}
+ if chopped_id[s]<>c then goto not_found;
+ incr(s);
+ end;
+ incr(k);
+ end;
+if (k=byte_start[q+ww])and(chopped_id[s]<>0) then goto not_found;
+print_nl('! Identifier conflict with ');
+@.Identifier conflict...@>
+for k:=byte_start[q] to byte_start[q+ww]-1 do print(xchr[byte_mem[w,k]]);
+error; q:=0; {only one conflict will be printed, since |equiv[0]=0|}
+not_found:
+end
+
+@ We compute the string pool check sum by working modulo a prime number
+that is large but not so large that overflow might occur.
+
+@d check_sum_prime==@'3777777667 {$2^{29}-73$}
+@^preprocessed strings@>
+
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+ equiv[p]:=buffer[id_first+1]+@'100000
+else begin equiv[p]:=string_ptr+@'100000;
+ l:=l-double_chars-1;
+ if l>99 then err_print('! Preprocessed string is too long');
+@.Preprocessed string is too long@>
+ incr(string_ptr);
+ write(pool,xchr["0"+l div 10],xchr["0"+l mod 10]); {output the length}
+ pool_check_sum:=pool_check_sum+pool_check_sum+l;
+ while pool_check_sum>check_sum_prime do
+ pool_check_sum:=pool_check_sum-check_sum_prime;
+ i:=id_first+1;
+ while i<id_loc do
+ begin write(pool,xchr[buffer[i]]); {output characters of string}
+ pool_check_sum:=pool_check_sum+pool_check_sum+buffer[i];
+ while pool_check_sum>check_sum_prime do
+ pool_check_sum:=pool_check_sum-check_sum_prime;
+ if (buffer[i]="""") or (buffer[i]="@@") then
+ i:=i+2 {omit second appearance of doubled character}
+ else incr(i);
+ end;
+ write_ln(pool);
+ end;
+end
+
+@* Searching for module names.
+The |mod_lookup| procedure finds the module name |mod_text[1..l]| in the
+search tree, after inserting it if necessary, and returns a pointer to
+where it was found.
+
+@<Glob...@>=
+@!mod_text:array [0..longest_name] of ASCII_code; {name being sought for}
+
+@ According to the rules of \.{WEB}, no module name
+should be a proper prefix of another, so a ``clean'' comparison should
+occur between any two names. The result of |mod_lookup| is 0 if this
+prefix condition is violated. An error message is printed when such violations
+are detected during phase two of \.{WEAVE}.
+
+@d less=0 {the first name is lexicographically less than the second}
+@d equal=1 {the first name is equal to the second}
+@d greater=2 {the first name is lexicographically greater than the second}
+@d prefix=3 {the first name is a proper prefix of the second}
+@d extension=4 {the first name is a proper extension of the second}
+
+@p function mod_lookup(@!l:sixteen_bits):name_pointer; {finds module name}
+label found;
+var c:less..extension; {comparison between two names}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {father of node |p|}
+begin c:=greater; q:=0; p:=rlink[0]; {|rlink[0]| is the root of the tree}
+while p<>0 do
+ begin @<Set \(|c| to the result of comparing the given name to
+ name |p|@>;
+ q:=p;
+ if c=less then p:=llink[q]
+ else if c=greater then p:=rlink[q]
+ else goto found;
+ end;
+@<Enter a new module name into the tree@>;
+found: if c<>equal then
+ begin err_print('! Incompatible section names'); p:=0;
+@.Incompatible module names@>
+ end;
+mod_lookup:=p;
+end;
+
+@ @<Enter a new module name...@>=
+w:=name_ptr mod ww; k:=byte_ptr[w];
+if k+l>max_bytes then overflow('byte memory');
+if name_ptr>max_names-ww then overflow('name');
+p:=name_ptr;
+if c=less then llink[q]:=p else rlink[q]:=p;
+llink[p]:=0; rlink[p]:=0; c:=equal; equiv[p]:=0;
+for j:=1 to l do byte_mem[w,k+j-1]:=mod_text[j];
+byte_ptr[w]:=k+l; byte_start[name_ptr+ww]:=k+l; incr(name_ptr);
+
+@ @<Set \(|c|...@>=
+begin k:=byte_start[p]; w:=p mod ww; c:=equal; j:=1;
+while (k<byte_start[p+ww]) and (j<=l) and (mod_text[j]=byte_mem[w,k]) do
+ begin incr(k); incr(j);
+ end;
+if k=byte_start[p+ww] then
+ if j>l then c:=equal
+ else c:=extension
+else if j>l then c:=prefix
+else if mod_text[j]<byte_mem[w,k] then c:=less
+else c:=greater;
+end
+
+@ The |prefix_lookup| procedure is supposed to find exactly one module
+name that has |mod_text[1..l]| as a prefix. Actually the algorithm silently
+accepts also the situation that some module name is a prefix of
+|mod_text[1..l]|, because the user who painstakingly typed in more than
+necessary probably doesn't want to be told about the wasted effort.
+
+@p function prefix_lookup(@!l:sixteen_bits):name_pointer; {finds name extension}
+var c:less..extension; {comparison between two names}
+@!count:0..max_names; {the number of hits}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {another place to resume the search after one branch is done}
+@!r:name_pointer; {extension found}
+begin q:=0; p:=rlink[0]; count:=0; r:=0; {begin search at root of tree}
+while p<>0 do
+ begin @<Set \(|c|...@>;
+ if c=less then p:=llink[p]
+ else if c=greater then p:=rlink[p]
+ else begin r:=p; incr(count); q:=rlink[p]; p:=llink[p];
+ end;
+ if p=0 then
+ begin p:=q; q:=0;
+ end;
+ end;
+if count<>1 then
+ if count=0 then err_print('! Name does not match')
+@.Name does not match@>
+ else err_print('! Ambiguous prefix');
+@.Ambiguous prefix@>
+prefix_lookup:=r; {the result will be 0 if there was no match}
+end;
+
+@* Tokens.
+Replacement texts, which represent \PASCAL\ code in a compressed format,
+appear in |tok_mem| as mentioned above. The codes in
+these texts are called `tokens'; some tokens occupy two consecutive
+eight-bit byte positions, and the others take just one byte.
+
+If $p>0$ points to a replacement text, |tok_start[p]| is the |tok_mem| position
+of the first eight-bit code of that text. If |text_link[p]=0|,
+this is the replacement text for a macro, otherwise it is the replacement
+text for a module. In the latter case |text_link[p]| is either equal to
+|module_flag|, which means that there is no further text for this module, or
+|text_link[p]| points to a
+continuation of this replacement text; such links are created when
+several modules have \PASCAL\ texts with the same name, and they also
+tie together all the \PASCAL\ texts of unnamed modules.
+The replacement text pointer for the first unnamed module
+appears in |text_link[0]|, and the most recent such pointer is |last_unnamed|.
+
+@d module_flag==max_texts {final |text_link| in module replacement texts}
+
+@<Glob...@>=
+@!last_unnamed:text_pointer; {most recent replacement text of unnamed module}
+
+@ @<Set init...@>= last_unnamed:=0; text_link[0]:=0;
+
+@ If the first byte of a token is less than @'200, the token occupies a
+single byte. Otherwise we make a sixteen-bit token by combining two consecutive
+bytes |a| and |b|. If |@'200<=a<@'250|, then $(a-@'200)\times2^8+b$ points
+to an identifier; if |@'250<=a<@'320|, then
+$(a-@'250)\times2^8+b$ points to a module name; otherwise, i.e., if
+|@'320<=a<@'400|, then $(a-@'320)\times2^8+b$ is the number of the module
+in which the current replacement text appears.
+
+Codes less than @'200 are 7-bit ASCII codes that represent themselves.
+In particular, a single-character identifier like `|x|' will be a one-byte
+token, while all longer identifiers will occupy two bytes.
+
+Some of the 7-bit ASCII codes will not be present, however, so we can
+use them for special purposes. The following symbolic names are used:
+
+\yskip\hang |param| denotes insertion of a parameter. This occurs only in
+the replacement texts of parametric macros, outside of single-quoted strings
+in those texts.
+
+\hang |begin_comment| denotes \.{@@\{}, which will become either
+\.{\{} or \.{[}.
+
+\hang |end_comment| denotes \.{@@\}}, which will become either
+\.{\}} or \.{]}.
+
+\hang |octal| denotes the \.{@@\'} that precedes an octal constant.
+
+\hang |hex| denotes the \.{@@"} that precedes a hexadecimal constant.
+
+\hang |check_sum| denotes the \.{@@\char'44} that denotes the string pool
+check sum.
+
+\hang |join| denotes the concatenation of adjacent items with no
+space or line breaks allowed between them (the \.{@@\&} operation of \.{WEB}).
+
+\hang |double_dot| denotes `\.{..}' in \PASCAL.
+
+\hang |verbatim| denotes the \.{@@=} that begins a verbatim \PASCAL\ string.
+It is also used for the end of the string.
+
+\hang |force_line| denotes the \.{@@\\} that forces a new line in the
+\PASCAL\ output.
+@^ASCII code@>
+
+@d param=0 {ASCII null code will not appear}
+@d verbatim=@'2 {extended ASCII alpha should not appear}
+@d force_line=@'3 {extended ASCII beta should not appear}
+@d begin_comment=@'11 {ASCII tab mark will not appear}
+@d end_comment=@'12 {ASCII line feed will not appear}
+@d octal=@'14 {ASCII form feed will not appear}
+@d hex=@'15 {ASCII carriage return will not appear}
+@d double_dot=@'40 {ASCII space will not appear except in strings}
+@d check_sum=@'175 {will not be confused with right brace}
+@d join=@'177 {ASCII delete will not appear}
+
+@ The following procedure is used to enter a two-byte value into
+|tok_mem| when a replacement text is being generated.
+
+@p procedure store_two_bytes(@!x:sixteen_bits);
+ {stores high byte, then low byte}
+begin if tok_ptr[z]+2>max_toks then overflow('token');
+tok_mem[z,tok_ptr[z]]:=x div@'400; {this could be done by a shift command}
+tok_mem[z,tok_ptr[z]+1]:=x mod@'400; {this could be done by a logical and}
+tok_ptr[z]:=tok_ptr[z]+2;
+end;
+
+@ When \.{TANGLE} is being operated in debug mode, it has a procedure to display
+a replacement text in symbolic form. This procedure has not been spruced up to
+generate a real great format, but at least the results are not as bad as
+a memory dump.
+
+@p @!debug procedure print_repl(@!p:text_pointer);
+var k:0..max_toks; {index into |tok_mem|}
+@!a: sixteen_bits; {current byte(s)}
+@!zp: 0..zz-1; {segment of |tok_mem| being accessed}
+begin if p>=text_ptr then print('BAD')
+else begin k:=tok_start[p]; zp:=p mod zz;
+ while k<tok_start[p+zz] do
+ begin a:=tok_mem[zp,k];
+ if a>=@'200 then @<Display two-byte token starting with |a|@>
+ else @<Display one-byte token |a|@>;
+ incr(k);
+ end;
+ end;
+end;
+gubed
+
+@ @<Display two-byte...@>=
+begin incr(k);
+if a<@'250 then {identifier or string}
+ begin a:=(a-@'200)*@'400+tok_mem[zp,k]; print_id(a);
+ if byte_mem[a mod ww,byte_start[a]]="""" then print('"')
+ else print(' ');
+ end
+else if a<@'320 then {module name}
+ begin print('@@<'); print_id((a-@'250)*@'400+tok_mem[zp,k]);
+ print('@@>');
+ end
+else begin a:=(a-@'320)*@'400+tok_mem[zp,k]; {module number}
+ print('@@',xchr["{"],a:1,'@@',xchr["}"]); {can't use right brace
+ between \&{debug} and \&{gubed}}
+ end;
+end
+
+@ @<Display one-byte...@>=
+case a of
+begin_comment: print('@@',xchr["{"]);
+end_comment: print('@@',xchr["}"]); {can't use right brace
+ between \&{debug} and \&{gubed}}
+octal: print('@@''');
+hex: print('@@"');
+check_sum: print('@@$');
+param: print('#');
+"@@": print('@@@@');
+verbatim: print('@@=');
+force_line: print('@@\');
+othercases print(xchr[a])
+endcases
+
+@* Stacks for output.
+Let's make sure that our data structures contain enough information to
+produce the entire \PASCAL\ program as desired, by working next on the
+algorithms that actually do produce that program.
+
+@ The output process uses a stack to keep track of what is going on at
+different ``levels'' as the macros are being expanded.
+Entries on this stack have five parts:
+
+\yskip\hang |end_field| is the |tok_mem| location where the replacement
+text of a particular level will end;
+
+\hang |byte_field| is the |tok_mem| location from which the next token
+on a particular level will be read;
+
+\hang |name_field| points to the name corresponding to a particular level;
+
+\hang |repl_field| points to the replacement text currently being read
+at a particular level;
+
+\hang |mod_field| is the module number, or zero if this is a macro.
+
+\yskip\noindent The current values of these five quantities are referred to
+quite frequently, so they are stored in a separate place instead of in
+the |stack| array. We call the current values |cur_end|, |cur_byte|,
+|cur_name|, |cur_repl|, and |cur_mod|.
+
+The global variable |stack_ptr| tells how many levels of output are
+currently in progress. The end of all output occurs when the stack is
+empty, i.e., when |stack_ptr=0|.
+
+@<Types...@>=
+@t\4@>@!output_state=record
+ @!end_field: sixteen_bits; {ending location of replacement text}
+ @!byte_field: sixteen_bits; {present location within replacement text}
+ @!name_field: name_pointer; {|byte_start| index for text being output}
+ @!repl_field: text_pointer; {|tok_start| index for text being output}
+ @!mod_field: 0..@'27777; {module number or zero if not a module}
+ end;
+
+@ @d cur_end==cur_state.end_field {current ending location in |tok_mem|}
+@d cur_byte==cur_state.byte_field {location of next output byte in |tok_mem|}
+@d cur_name==cur_state.name_field {pointer to current name being expanded}
+@d cur_repl==cur_state.repl_field {pointer to current replacement text}
+@d cur_mod==cur_state.mod_field {current module number being expanded}
+
+@<Globals...@>=
+@!cur_state : output_state; {|cur_end|, |cur_byte|, |cur_name|,
+ |cur_repl|, |cur_mod|}
+@!stack : array [1..stack_size] of output_state; {info for non-current levels}
+@!stack_ptr: 0..stack_size; {first unused location in the output state stack}
+
+@ It is convenient to keep a global variable |zo| equal to |cur_repl mod zz|.
+
+@<Glob...@>=
+@!zo:0..zz-1; {the segment of |tok_mem| from which output is coming}
+
+@ Parameters must also be stacked. They are placed in
+|tok_mem| just above the other replacement texts, and dummy parameter
+`names' are placed in |byte_start| just after the other names.
+The variables |text_ptr| and |tok_ptr[z]| essentially serve as parameter
+stack pointers during the output phase, so there is no need for a separate
+data structure to handle this problem.
+
+@ There is an implicit stack corresponding to meta-comments that are output
+via \.{@@\{} and \.{@@\}}. But this stack need not be represented in detail,
+because we only need to know whether it is empty or not. A global variable
+|brace_level| tells how many items would be on this stack if it were present.
+
+@<Globals...@>=
+@!brace_level: eight_bits; {current depth of $\.{@@\{}\ldots\.{@@\}}$ nesting}
+
+@ To get the output process started, we will perform the following
+initialization steps. We may assume that |text_link[0]| is nonzero, since it
+points to the \PASCAL\ text in the first unnamed module that generates
+code; if there are no such modules, there is nothing to output, and an
+error message will have been generated before we do any of the initialization.
+
+@<Initialize the output stacks@>=
+stack_ptr:=1; brace_level:=0; cur_name:=0; cur_repl:=text_link[0];
+zo:=cur_repl mod zz; cur_byte:=tok_start[cur_repl];
+cur_end:=tok_start[cur_repl+zz]; cur_mod:=0;
+
+@ When the replacement text for name |p| is to be inserted into the output,
+the following subroutine is called to save the old level of output and get
+the new one going.
+
+@p procedure push_level(@!p:name_pointer); {suspends the current level}
+begin if stack_ptr=stack_size then overflow('stack')
+else begin stack[stack_ptr]:=cur_state; {save |cur_end|, |cur_byte|, etc.}
+ incr(stack_ptr);
+ cur_name:=p; cur_repl:=equiv[p]; zo:=cur_repl mod zz;
+ cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz];
+ cur_mod:=0;
+ end;
+end;
+
+@ When we come to the end of a replacement text, the |pop_level| subroutine
+does the right thing: It either moves to the continuation of this replacement
+text or returns the state to the most recently stacked level. Part of this
+subroutine, which updates the parameter stack, will be given later when we
+study the parameter stack in more detail.
+
+@p procedure pop_level; {do this when |cur_byte| reaches |cur_end|}
+label exit;
+begin if text_link[cur_repl]=0 then {end of macro expansion}
+ begin if ilk[cur_name]=parametric then
+ @<Remove a parameter from the parameter stack@>;
+ end
+else if text_link[cur_repl]<module_flag then {link to a continuation}
+ begin cur_repl:=text_link[cur_repl]; {we will stay on the same level}
+ zo:=cur_repl mod zz;
+ cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz];
+ return;
+ end;
+decr(stack_ptr); {we will go down to the previous level}
+if stack_ptr>0 then
+ begin cur_state:=stack[stack_ptr]; zo:=cur_repl mod zz;
+ end;
+exit: end;
+
+@ The heart of the output procedure is the |get_output| routine, which produces
+the next token of output that is not a reference to a macro. This procedure
+handles all the stacking and unstacking that is necessary. It returns the
+value |number| if the next output has a numeric value (the value of a
+numeric macro or string), in which case |cur_val| has been set to the
+number in question. The procedure also returns the value |module_number|
+if the next output begins or ends the replacement text of some module,
+in which case |cur_val| is that module's number (if beginning) or the
+negative of that value (if ending). And it returns the value |identifier|
+if the next output is an identifier of length two or more, in which case
+|cur_val| points to that identifier name.
+
+@d number=@'200 {code returned by |get_output| when next output is numeric}
+@d module_number=@'201 {code returned by |get_output| for module numbers}
+@d identifier=@'202 {code returned by |get_output| for identifiers}
+
+@<Globals...@>=
+@!cur_val:integer; {additional information corresponding to output token}
+
+@ If |get_output| finds that no more output remains, it returns the value zero.
+
+@p function get_output:sixteen_bits; {returns next token after macro expansion}
+label restart, done, found;
+var a:sixteen_bits; {value of current byte}
+@!b:eight_bits; {byte being copied}
+@!bal:sixteen_bits; {excess of \.( versus \.) while copying a parameter}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+begin restart: if stack_ptr=0 then
+ begin a:=0; goto found;
+ end;
+if cur_byte=cur_end then
+ begin cur_val:=-cur_mod; pop_level;
+ if cur_val=0 then goto restart;
+ a:=module_number; goto found;
+ end;
+a:=tok_mem[zo,cur_byte]; incr(cur_byte);
+if a<@'200 then {one-byte token}
+ if a=param then
+ @<Start scanning current macro parameter, |goto restart|@>
+ else goto found;
+a:=(a-@'200)*@'400+tok_mem[zo,cur_byte]; incr(cur_byte);
+if a<@'24000 then {|@'24000=(@'250-@'200)*@'400|}
+ @<Expand macro |a| and |goto found|, or |goto restart| if no output found@>;
+if a<@'50000 then {|@'50000=(@'320-@'200)*@'400|}
+ @<Expand module |a-@'24000|, |goto restart|@>;
+cur_val:=a-@'50000; a:=module_number; cur_mod:=cur_val;
+found:
+@!debug if trouble_shooting then debug_help;@;@+gubed@/
+get_output:=a;
+end;
+
+@ The user may have forgotten to give any \PASCAL\ text for a module name,
+or the \PASCAL\ text may have been associated with a different name by mistake.
+
+@<Expand module |a-...@>=
+begin a:=a-@'24000;
+if equiv[a]<>0 then push_level(a)
+else if a<>0 then
+ begin print_nl('! Not present: <'); print_id(a); print('>'); error;
+@.Not present: <section name>@>
+ end;
+goto restart;
+end
+
+@ @<Expand macro ...@>=
+begin case ilk[a] of
+normal: begin cur_val:=a; a:=identifier;
+ end;
+numeric: begin cur_val:=equiv[a]-@'100000; a:=number;
+ end;
+simple: begin push_level(a); goto restart;
+ end;
+parametric: begin @<Put a parameter on the parameter stack,
+ or |goto restart| if error occurs@>;
+ push_level(a); goto restart;
+ end;
+othercases confusion('output')
+endcases;@/
+goto found;
+end
+
+@ We come now to the interesting part, the job of putting a parameter on
+the parameter stack. First we pop the stack if necessary until getting to
+a level that hasn't ended. Then the next character must be a `\.(';
+and since parentheses are balanced on each level, the entire parameter must
+be present, so we can copy it without difficulty.
+
+@<Put a parameter...@>=
+while (cur_byte=cur_end)and(stack_ptr>0) do pop_level;
+if (stack_ptr=0)or(tok_mem[zo,cur_byte]<>"(") then
+ begin print_nl('! No parameter given for '); print_id(a); error;
+@.No parameter given for macro@>
+ goto restart;
+ end;
+@<Copy the parameter into |tok_mem|@>;
+equiv[name_ptr]:=text_ptr; ilk[name_ptr]:=simple; w:=name_ptr mod ww;
+k:=byte_ptr[w];
+@!debug if k=max_bytes then overflow('byte memory');
+byte_mem[w,k]:="#"; incr(k); byte_ptr[w]:=k;
+gubed {this code has set the parameter identifier for debugging printouts}
+if name_ptr>max_names-ww then overflow('name');
+byte_start[name_ptr+ww]:=k; incr(name_ptr);
+if text_ptr>max_texts-zz then overflow('text');
+text_link[text_ptr]:=0; tok_start[text_ptr+zz]:=tok_ptr[z];
+incr(text_ptr);
+z:=text_ptr mod zz
+
+@ The |pop_level| routine undoes the effect of parameter-pushing when
+a parameter macro is finished:
+
+@<Remove a parameter...@>=
+begin decr(name_ptr); decr(text_ptr);
+z:=text_ptr mod zz;
+stat if tok_ptr[z]>max_tok_ptr[z] then max_tok_ptr[z]:=tok_ptr[z];
+tats {the maximum value of |tok_ptr| occurs just before parameter popping}
+tok_ptr[z]:=tok_start[text_ptr];
+@!debug decr(byte_ptr[name_ptr mod ww]);@+gubed
+end
+
+@ When a parameter occurs in a replacement text, we treat it as a simple
+macro in position (|name_ptr-1|):
+
+@<Start scanning...@>=
+begin push_level(name_ptr-1); goto restart;
+end
+
+@ Similarly, a |param| token encountered as we copy a parameter is converted
+into a simple macro call for |name_ptr-1|.
+Some care is needed to handle cases like \\{macro}|(#; print('#)'))|; the
+\.{\#} token will have been changed to |param| outside of strings, but we
+still must distinguish `real' parentheses from those in strings.
+
+@d app_repl(#)==begin if tok_ptr[z]=max_toks then overflow('token');
+ tok_mem[z,tok_ptr[z]]:=#; incr(tok_ptr[z]); end
+
+@<Copy the parameter...@>=
+bal:=1; incr(cur_byte); {skip the opening `\.('}
+loop@+ begin b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+ if b=param then store_two_bytes(name_ptr+@'77777)
+ else begin if b>=@'200 then
+ begin app_repl(b);
+ b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+ end
+ else case b of
+ "(": incr(bal);
+ ")": begin decr(bal);
+ if bal=0 then goto done;
+ end;
+ "'": repeat app_repl(b);
+ b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+ until b="'"; {copy string, don't change |bal|}
+ othercases do_nothing
+ endcases;
+ app_repl(b);
+ end;
+ end;
+done:
+
+@* Producing the output.
+The |get_output| routine above handles most of the complexity of output
+generation, but there are two further considerations that have a nontrivial
+effect on \.{TANGLE}'s algorithms.
+
+First, we want to make sure that the output is broken into lines not
+exceeding |line_length| characters per line, where these breaks occur at
+valid places (e.g., not in the middle of a string or a constant or an
+identifier, not between `\.<' and `\.>', not at a `\.{@@\&}' position
+where quantities are being joined together). Therefore we assemble the
+output into a buffer before deciding where the line breaks will appear.
+However, we make very little attempt to make ``logical'' line breaks that
+would enhance the readability of the output; people are supposed to read
+the input of \.{TANGLE} or the \TeX ed output of \.{WEAVE}, but not the
+tangled-up output. The only concession to readability is that a break after
+a semicolon will be made if possible, since commonly used ``pretty
+printing'' routines give better results in such cases.
+
+Second, we want to decimalize non-decimal constants, and to combine integer
+quantities that are added or subtracted, because \PASCAL\ doesn't allow
+constant expressions in subrange types or in case labels. This means we
+want to have a procedure that treats a construction like \.{(E-15+17)}
+as equivalent to `\.{(E+2)}', while also leaving `\.{(1E-15+17)}' and
+`\.{(E-15+17*y)}' untouched. Consider also `\.{-15+17.5}' versus
+`\.{-15+17..5}'. We shall not combine integers preceding or following
+\.*, \./, \.{div}, \.{mod}, or \.{@@\&}. Note that if |y| has been defined
+to equal $-2$, we must expand `\.{x*y}' into `\.{x*(-2)}'; but `\.{x-y}'
+can expand into `\.{x+2}' and we can even change `\.{x - y mod z}' to
+@^mod@>
+`\.{x + 2 mod z}' because \PASCAL\ has a nonstandard \&{mod} operation!
+
+The following solution to these problems has been adopted: An array
+|out_buf| contains characters that have been generated but not yet output,
+and there are three pointers into this array. One of these, |out_ptr|, is
+the number of characters currently in the buffer, and we will have
+|1<=out_ptr<=line_length| most of the time. The second is |break_ptr|,
+which is the largest value |<=out_ptr| such that we are definitely entitled
+to end a line by outputting the characters |out_buf[1..(break_ptr-1)]|;
+we will always have |break_ptr<=line_length|. Finally, |semi_ptr| is either
+zero or the largest known value of a legal break after a semicolon or comment
+on the current line; we will always have |semi_ptr<=break_ptr|.
+
+@<Globals...@>=
+@!out_buf: array [0..out_buf_size] of ASCII_code; {assembled characters}
+@!out_ptr: 0..out_buf_size; {first available place in |out_buf|}
+@!break_ptr: 0..out_buf_size; {last breaking place in |out_buf|}
+@!semi_ptr: 0..out_buf_size; {last semicolon breaking place in |out_buf|}
+
+@ Besides having those three pointers,
+the output process is in one of several states:
+
+\yskip\hang |num_or_id| means that the last item in the buffer is a number or
+identifier, hence a blank space or line break must be inserted if the next
+item is also a number or identifier.
+
+\yskip\hang |unbreakable| means that the last item in the buffer was followed
+by the \.{@@\&} operation that inhibits spaces between it and the next item.
+
+\yskip\hang |sign| means that the last item in the buffer is to be followed
+by \.+ or \.-, depending on whether |out_app| is positive or negative.
+
+\yskip\hang |sign_val| means that the decimal equivalent of
+$\vert|out_val|\vert$ should be appended to the buffer. If |out_val<0|,
+or if |out_val=0| and |last_sign<0|, the number should be preceded by a minus
+sign. Otherwise it should be preceded by the character |out_sign| unless
+|out_sign=0|; the |out_sign| variable is either 0 or \.{"\ "} or \.{"+"}.
+
+\yskip\hang |sign_val_sign| is like |sign_val|, but also append \.+ or \.-
+afterwards, depending on whether |out_app| is positive or negative.
+
+\yskip\hang |sign_val_val| is like |sign_val|, but also append the decimal
+equivalent of |out_app| including its sign, using |last_sign| in case
+|out_app=0|.
+
+\yskip\hang |misc| means none of the above.
+
+\yskip\noindent
+For example, the output buffer and output state run through the following
+sequence as we generate characters from `\.{(x-15+19-2)}':
+$$\vbox{\halign{$\hfil#\hfil$\quad&#\hfil&\quad\hfil#\hfil&\quad
+\hfil#\hfil&\quad\hfil#\hfil&\quad\hfil#\hfil\quad&\hfil#\hfil\cr
+output&|out_buf|&|out_state|&|out_sign|&|out_val|&|out_app|&|last_sign|\cr
+\noalign{\vskip 3pt}
+(&\.(&|misc|\cr
+x&\.{(x}&|num_or_id|\cr
+-&\.{(x}&|sign|&&&$-1$&$-1$\cr
+15&\.{(x}&|sign_val|&\.{"+"}&$-15$&&$-15$\cr
++&\.{(x}&|sign_val_sign|&\.{"+"}&$-15$&$+1$&$+1$\cr
+19&\.{(x}&|sign_val_val|&\.{"+"}&$-15$&$+19$&$+1$\cr
+-&\.{(x}&|sign_val_sign|&\.{"+"}&$+4$&$-1$&$-1$\cr
+2&\.{(x}&|sign_val_val|&\.{"+"}&$+4$&$-2$&$-2$\cr
+)&\.{(x+2)}&|misc|\cr}}$$
+At each stage we have put as much into the buffer as possible without
+knowing what is coming next. Examples like `\.{x-0.1}' indicate why
+|last_sign| is needed to associate the proper sign with an output of zero.
+
+In states |num_or_id|, |unbreakable|, and |misc| the last item in the buffer
+lies between |break_ptr| and |out_ptr-1|, inclusive; in the other states we
+have |break_ptr=out_ptr|.
+
+The numeric values assigned to |num_or_id|, etc., have been chosen to
+shorten some of the program logic; for example, the program makes use of
+the fact that |sign+2=sign_val_sign|.
+
+@d misc=0 {state associated with special characters}
+@d num_or_id=1 {state associated with numbers and identifiers}
+@d sign=2 {state associated with pending \.+ or \.-}
+@d sign_val=num_or_id+2 {state associated with pending sign and value}
+@d sign_val_sign=sign+2 {|sign_val| followed by another pending sign}
+@d sign_val_val=sign_val+2 {|sign_val| followed by another pending value}
+@d unbreakable=sign_val_val+1 {state associated with \.{@@\&}}
+
+@<Globals...@>=
+@!out_state:eight_bits; {current status of partial output}
+@!out_val,@!out_app:integer; {pending values}
+@!out_sign:ASCII_code; {sign to use if appending |out_val>=0|}
+@!last_sign:-1..+1; {sign to use if appending a zero}
+
+@ During the output process, |line| will equal the number of the next line
+to be output.
+
+@<Initialize the output buffer@>=
+out_state:=misc; out_ptr:=0; break_ptr:=0; semi_ptr:=0; out_buf[0]:=0; line:=1;
+
+@ Here is a routine that is invoked when |out_ptr>line_length|
+or when it is time to flush out the final line. The |flush_buffer| procedure
+often writes out the line up to the current |break_ptr| position, then moves the
+remaining information to the front of |out_buf|. However, it prefers to
+write only up to |semi_ptr|, if the residual line won't be too long.
+
+@d check_break==if out_ptr>line_length then flush_buffer
+
+@p procedure flush_buffer; {writes one line to output file}
+var k:0..out_buf_size; {index into |out_buf|}
+@!b:0..out_buf_size; {value of |break_ptr| upon entry}
+begin b:=break_ptr;
+if (semi_ptr<>0)and(out_ptr-semi_ptr<=line_length) then break_ptr:=semi_ptr;
+for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]);
+write_ln(Pascal_file); incr(line);
+if line mod 100 = 0 then
+ begin print('.');
+ if line mod 500 = 0 then print(line:1);
+ update_terminal; {progress report}
+ end;
+if break_ptr<out_ptr then
+ begin if out_buf[break_ptr]=" " then
+ begin incr(break_ptr); {drop space at break}
+ if break_ptr>b then b:=break_ptr;
+ end;
+ for k:=break_ptr to out_ptr-1 do out_buf[k-break_ptr]:=out_buf[k];
+ end;
+out_ptr:=out_ptr-break_ptr; break_ptr:=b-break_ptr; semi_ptr:=0;
+if out_ptr>line_length then
+ begin err_print('! Long line must be truncated'); out_ptr:=line_length;
+@.Long line must be truncated@>
+ end;
+end;
+
+@ @<Empty the last line from the buffer@>=
+break_ptr:=out_ptr; semi_ptr:=0; flush_buffer;
+if brace_level<>0 then
+ err_print('! Program ended at brace level ',brace_level:1);
+@.Program ended at brace level n@>
+
+@ Another simple and useful routine appends the decimal equivalent of
+a nonnegative integer to the output buffer.
+
+@d app(#)==begin out_buf[out_ptr]:=#; incr(out_ptr); {append a single character}
+ end
+
+@p procedure app_val(@!v:integer); {puts |v| into buffer, assumes |v>=0|}
+var k:0..out_buf_size; {index into |out_buf|}
+begin k:=out_buf_size; {first we put the digits at the very end of |out_buf|}
+repeat out_buf[k]:=v mod 10; v:=v div 10; decr(k);
+until v=0;
+repeat incr(k); app(out_buf[k]+"0");
+until k=out_buf_size; {then we append them, most significant first}
+end;
+
+@ The output states are kept up to date by the output routines, which are
+called |send_out|, |send_val|, and |send_sign|. The |send_out| procedure
+has two parameters: |t| tells the type of information being sent and
+|v| contains the information proper. Some information may also be passed
+in the array |out_contrib|.
+
+\yskip\hang If |t=misc| then |v| is a character to be output.
+
+\hang If |t=str| then |v| is the length of a string or something like `\.{<>}'
+in |out_contrib|.
+
+\hang If |t=ident| then |v| is the length of an identifier in |out_contrib|.
+
+\hang If |t=frac| then |v| is the length of a fraction and/or exponent in
+|out_contrib|.
+
+@d str=1 {|send_out| code for a string}
+@d ident=2 {|send_out| code for an identifier}
+@d frac=3 {|send_out| code for a fraction}
+
+@<Glob...@>=
+@!out_contrib:array[1..line_length] of ASCII_code; {a contribution to |out_buf|}
+
+@ A slightly subtle point in the following code is that the user may ask
+for a |join| operation (i.e., \.{@@\&}) following whatever is being sent
+out. We will see later that |join| is implemented in part by calling
+|send_out(frac,0)|.
+
+@p procedure send_out(@!t:eight_bits; @!v:sixteen_bits);
+ {outputs |v| of type |t|}
+label restart;
+var k: 0..line_length; {index into |out_contrib|}
+begin @<Get the buffer ready for appending the new information@>;
+if t<>misc then for k:=1 to v do app(out_contrib[k])
+else app(v);
+check_break;
+if (t=misc)and((v=";")or(v="}")) then
+ begin semi_ptr:=out_ptr; break_ptr:=out_ptr;
+ end;
+if t>=ident then out_state:=num_or_id {|t=ident| or |frac|}
+else out_state:=misc {|t=str| or |misc|}
+end;
+
+@ Here is where the buffer states for signs and values collapse into simpler
+states, because we are about to append something that doesn't combine with
+the previous integer constants.
+
+We use an ASCII-code trick: Since |","-1="+"| and |","+1="-"|, we have
+|","-c=@t sign of $c$@>|, when $\vert c\vert=1$.
+
+@<Get the buffer ready...@>=
+restart: case out_state of
+num_or_id: if t<>frac then
+ begin break_ptr:=out_ptr;
+ if t=ident then app(" ");
+ end;
+sign: begin app(","-out_app); check_break; break_ptr:=out_ptr;
+ end;
+sign_val,sign_val_sign: begin @<Append \(|out_val| to buffer@>;
+ out_state:=out_state-2; goto restart;
+ end;
+sign_val_val: @<Reduce |sign_val_val| to |sign_val| and |goto restart|@>;
+misc: if t<>frac then break_ptr:=out_ptr;@/
+othercases do_nothing {this is for |unbreakable| state}
+endcases
+
+@ @<Append \(|out_val|...@>=
+if (out_val<0)or((out_val=0)and(last_sign<0)) then app("-")
+else if out_sign>0 then app(out_sign);
+app_val(abs(out_val)); check_break;
+
+@ @<Reduce |sign_val_val|...@>=
+begin if (t=frac)or(@<Contribution is \.* or \./ or \.{DIV} or \.{MOD}@>) then
+ begin @<Append \(|out_val| to buffer@>;
+ out_sign:="+"; out_val:=out_app;
+ end
+else out_val:=out_val+out_app;
+out_state:=sign_val; goto restart;
+end
+
+@ @<Contribution is \.*...@>=
+((t=ident)and(v=3)and@|
+ (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+ ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@|
+@^uppercase@>
+ ((t=misc)and((v="*")or(v="/")))
+
+@ The following routine is called with $v=\pm1$ when a plus or minus sign is
+appended to the output. It extends \PASCAL\ to allow repeated signs
+(e.g., `\.{--}' is equivalent to `\.+'), rather than to give an error message.
+The signs following `\.E' in real constants are treated as part of a fraction,
+so they are not seen by this routine.
+
+@p procedure send_sign(@!v:integer);
+begin case out_state of
+sign, sign_val_sign: out_app:=out_app*v;
+sign_val:begin out_app:=v; out_state:=sign_val_sign;
+ end;
+sign_val_val: begin out_val:=out_val+out_app; out_app:=v;
+ out_state:=sign_val_sign;
+ end;
+othercases begin break_ptr:=out_ptr; out_app:=v; out_state:=sign;
+ end
+endcases;@/
+last_sign:=out_app;
+end;
+
+@ When a (signed) integer value is to be output, we call |send_val|.
+
+@d bad_case=666 {this is a label used below}
+
+@p procedure send_val(@!v:integer); {output the (signed) value |v|}
+label bad_case, {go here if we can't keep |v| in the output state}
+ exit;
+begin case out_state of
+num_or_id: begin @<If previous output was \.{DIV} or \.{MOD}, |goto bad_case|@>;
+ out_sign:=" "; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr;
+ last_sign:=+1;
+ end;
+misc: begin @<If previous output was \.* or \./, |goto bad_case|@>;
+ out_sign:=0; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr;
+ last_sign:=+1;
+ end;
+@t\4@>@<Handle cases of |send_val| when |out_state| contains a sign@>@;
+othercases goto bad_case
+endcases;@/
+return;
+bad_case: @<Append the decimal value of |v|, with parentheses if negative@>;
+exit: end;
+
+@ @<Handle cases of |send_val|...@>=
+sign: begin out_sign:="+"; out_state:=sign_val; out_val:=out_app*v;
+ end;
+sign_val: begin out_state:=sign_val_val; out_app:=v;
+ err_print('! Two numbers occurred without a sign between them');
+ end;
+sign_val_sign: begin out_state:=sign_val_val; out_app:=out_app*v;
+ end;
+sign_val_val: begin out_val:=out_val+out_app; out_app:=v;
+ err_print('! Two numbers occurred without a sign between them');
+@.Two numbers occurred...@>
+ end;
+
+@ @<If previous output was \.*...@>=
+if (out_ptr=break_ptr+1)and((out_buf[break_ptr]="*")or(out_buf[break_ptr]="/"))
+ then goto bad_case
+
+@ @<If previous output was \.{DIV}...@>=
+if (out_ptr=break_ptr+3)or
+ ((out_ptr=break_ptr+4)and(out_buf[break_ptr]=" ")) then
+@^uppercase@>
+ if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+ (out_buf[out_ptr-1]="V"))or @/
+ ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+ (out_buf[out_ptr-1]="D")) then@/ goto bad_case
+
+@ @<Append the decimal value...@>=
+if v>=0 then
+ begin if out_state=num_or_id then
+ begin break_ptr:=out_ptr; app(" ");
+ end;
+ app_val(v); check_break; out_state:=num_or_id;
+ end
+else begin app("("); app("-"); app_val(-v); app(")"); check_break;
+ out_state:=misc;
+ end
+
+@* The big output switch.
+To complete the output process, we need a routine that takes the results
+of |get_output| and feeds them to |send_out|, |send_val|, or |send_sign|.
+This procedure `|send_the_output|' will be invoked just once, as follows:
+
+@<Phase II: Output the contents of the compressed tables@>=
+if text_link[0]=0 then
+ begin print_nl('! No output was specified.'); mark_harmless;
+@.No output was specified@>
+ end
+else begin print_nl('Writing the output file'); update_terminal;@/
+ @<Initialize the output stacks@>;
+ @<Initialize the output buffer@>;
+ send_the_output;@/
+ @<Empty the last line...@>;
+ print_nl('Done.');
+ end
+
+@ A many-way switch is used to send the output:
+
+@d get_fraction=2 {this label is used below}
+
+@p procedure send_the_output;
+label get_fraction, {go here to finish scanning a real constant}
+ reswitch, continue;
+var cur_char:eight_bits; {the latest character received}
+ @!k:0..line_length; {index into |out_contrib|}
+ @!j:0..max_bytes; {index into |byte_mem|}
+ @!w:0..ww-1; {segment of |byte_mem|}
+ @!n:integer; {number being scanned}
+begin while stack_ptr>0 do
+ begin cur_char:=get_output;
+ reswitch: case cur_char of
+ 0: do_nothing; {this case might arise if output ends unexpectedly}
+ @t\4@>@<Cases related to identifiers@>@;
+ @t\4@>@<Cases related to constants, possibly leading to
+ |get_fraction| or |reswitch|@>@;
+ "+","-": send_sign(","-cur_char);
+ @t\4@>@<Cases like \.{<>} and \.{:=}@>@;
+ "'": @<Send a string, |goto reswitch|@>;
+ @<Other printable characters@>: send_out(misc,cur_char);
+ @t\4@>@<Cases involving \.{@@\{} and \.{@@\}}@>@;
+ join: begin send_out(frac,0); out_state:=unbreakable;
+ end;
+ verbatim: @<Send verbatim string@>;
+ force_line: @<Force a line break@>;
+ othercases err_print('! Can''t output ASCII code ',cur_char:1)
+@.Can't output ASCII code n@>
+ endcases;@/
+ goto continue;
+ get_fraction: @<Special code to finish real constants@>;
+ continue: end;
+end;
+
+@ @<Cases like \.{<>}...@>=
+and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D";
+@^uppercase@>
+ send_out(ident,3);
+ end;
+not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T";
+ send_out(ident,3);
+ end;
+set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N";
+ send_out(ident,2);
+ end;
+or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2);
+ end;
+left_arrow: begin out_contrib[1]:=":"; out_contrib[2]:="="; send_out(str,2);
+ end;
+not_equal: begin out_contrib[1]:="<"; out_contrib[2]:=">"; send_out(str,2);
+ end;
+less_or_equal: begin out_contrib[1]:="<"; out_contrib[2]:="="; send_out(str,2);
+ end;
+greater_or_equal: begin out_contrib[1]:=">"; out_contrib[2]:="=";
+ send_out(str,2);
+ end;
+equivalence_sign: begin out_contrib[1]:="="; out_contrib[2]:="=";
+ send_out(str,2);
+ end;
+double_dot: begin out_contrib[1]:="."; out_contrib[2]:="."; send_out(str,2);
+ end;
+
+@ Please don't ask how all of the following characters can actually get
+through \.{TANGLE} outside of strings. It seems that |""""| and |"{"|
+cannot actually occur at this point of the program, but they have
+been included just in case \.{TANGLE} changes.
+
+If \.{TANGLE} is producing code for a \PASCAL\ compiler that uses `\.{(.}'
+and `\.{.)}' instead of square brackets (e.g., on machines with {\mc EBCDIC}
+code), one should remove |"["| and |"]"| from this list and put them into
+the preceding module in the appropriate way. Similarly, some compilers
+want `\.\^' to be converted to `\.{@@}'.
+@^system dependencies@>@^EBCDIC@>
+
+@<Other printable characters@>=
+"!","""","#","$","%","&","(",")","*",",","/",":",";","<","=",">","?",
+"@@","[","\","]","^","_","`","{","|"
+
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to uppercase,
+with underlines removed. Extremely long identifiers must be chopped.
+
+(Some \PASCAL\ compilers work with lowercase letters instead of
+uppercase. If this module of \.{TANGLE} is changed, it's also necessary
+to change from uppercase to lowercase in the modules that are
+listed in the index under ``uppercase''.)
+@^system dependencies@>
+@^uppercase@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+ #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
+ end;
+"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1);
+ end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+ while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+ begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+ if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40
+ else if out_contrib[k]="_" then decr(k);
+ end;
+ send_out(ident,k);
+ end;
+
+@ After sending a string, we need to look ahead at the next character, in order
+to see if there were two consecutive single-quote marks. Afterwards we go to
+|reswitch| to process the next character.
+
+@<Send a string...@>=
+begin k:=1; out_contrib[1]:="'";
+repeat if k<line_length then incr(k);
+out_contrib[k]:=get_output;
+until (out_contrib[k]="'")or(stack_ptr=0);
+if k=line_length then err_print('! String too long');
+@.String too long@>
+send_out(str,k); cur_char:=get_output;
+if cur_char="'" then out_state:=unbreakable;
+goto reswitch;
+end
+
+@ Sending a verbatim string is similar, but we don't have to look ahead.
+
+@<Send verbatim string@>=
+begin k:=0;
+repeat if k<line_length then incr(k);
+out_contrib[k]:=get_output;
+until (out_contrib[k]=verbatim)or(stack_ptr=0);
+if k=line_length then err_print('! Verbatim string too long');
+@.Verbatim string too long@>
+send_out(str,k-1);
+end
+
+@ In order to encourage portable software, \.{TANGLE} complains
+if the constants get dangerously close to the largest value representable
+on a 32-bit computer ($2^{31}-1$).
+
+@d digits=="0","1","2","3","4","5","6","7","8","9"
+
+@<Cases related to constants...@>=
+digits: begin n:=0;
+ repeat cur_char:=cur_char-"0";
+ if n>=@'1463146314 then err_print('! Constant too big')
+@.Constant too big@>
+ else n:=10*n+cur_char;
+ cur_char:=get_output;
+ until (cur_char>"9")or(cur_char<"0");
+ send_val(n); k:=0;
+ if cur_char="e" then cur_char:="E";
+@^uppercase@>
+ if cur_char="E" then goto get_fraction
+ else goto reswitch;
+ end;
+check_sum: send_val(pool_check_sum);
+octal: begin n:=0; cur_char:="0";
+ repeat cur_char:=cur_char-"0";
+ if n>=@'2000000000 then err_print('! Constant too big')
+ else n:=8*n+cur_char;
+ cur_char:=get_output;
+ until (cur_char>"7")or(cur_char<"0");
+ send_val(n); goto reswitch;
+ end;
+hex: begin n:=0; cur_char:="0";
+ repeat if cur_char>="A" then cur_char:=cur_char+10-"A"
+ else cur_char:=cur_char-"0";
+ if n>=@"8000000 then err_print('! Constant too big')
+ else n:=16*n+cur_char;
+ cur_char:=get_output;
+ until (cur_char>"F")or(cur_char<"0")or@|
+ ((cur_char>"9")and(cur_char<"A"));
+ send_val(n); goto reswitch;
+ end;
+number: send_val(cur_val);
+".": begin k:=1; out_contrib[1]:="."; cur_char:=get_output;
+ if cur_char="." then
+ begin out_contrib[2]:="."; send_out(str,2);
+ end
+ else if (cur_char>="0")and(cur_char<="9") then goto get_fraction
+ else begin send_out(misc,"."); goto reswitch;
+ end;
+ end;
+
+@ The following code appears at label `|get_fraction|', when we want to
+scan to the end of a real constant. The first |k| characters of a fraction
+have already been placed in |out_contrib|, and |cur_char| is the next character.
+
+@<Special code...@>=
+repeat if k<line_length then incr(k);
+out_contrib[k]:=cur_char; cur_char:=get_output;
+if (out_contrib[k]="E")and((cur_char="+")or(cur_char="-")) then
+@^uppercase@>
+ begin if k<line_length then incr(k);
+ out_contrib[k]:=cur_char; cur_char:=get_output;
+ end
+else if cur_char="e" then cur_char:="E";
+until (cur_char<>"E")and((cur_char<"0")or(cur_char>"9"));
+if k=line_length then err_print('! Fraction too long');
+@.Fraction too long@>
+send_out(frac,k); goto reswitch
+
+@ Some \PASCAL\ compilers do not recognize comments in braces, so the
+comments must be delimited by `\.{(*}' and `\.{*)}'.
+@^system dependencies@>
+In such cases the statement `|out_contrib[1]:="{"|' that appears here should
+be replaced by `\ignorespaces|begin out_contrib[1]:="("; out_contrib[2]:="*";
+incr(k); end|', and a similar change should be made to
+`|out_contrib[k]:="}"|'.
+
+@<Cases involving \.{@@\{} and \.{@@\}}@>=
+begin_comment: begin if brace_level=0 then send_out(misc,"{")
+ else send_out(misc,"[");
+ incr(brace_level);
+ end;
+end_comment: if brace_level>0 then
+ begin decr(brace_level);
+ if brace_level=0 then send_out(misc,"}")
+ else send_out(misc,"]");
+ end
+ else err_print('! Extra @@}');
+@.Extra \AT!\}@>
+module_number: begin k:=2;
+ if brace_level=0 then out_contrib[1]:="{"
+ else out_contrib[1]:="[";
+ if cur_val<0 then
+ begin out_contrib[k]:=":"; cur_val:=-cur_val; incr(k);
+ end;
+ n:=10;
+ while cur_val>=n do n:=10*n;
+ repeat n:=n div 10;
+ out_contrib[k]:="0"+(cur_val div n); cur_val:=cur_val mod n; incr(k);
+ until n=1;
+ if out_contrib[2]<>":" then
+ begin out_contrib[k]:=":"; incr(k);
+ end;
+ if brace_level=0 then out_contrib[k]:="}"
+ else out_contrib[k]:="]";
+ send_out(str,k);
+ end;
+
+@ @<Force a line break@>=
+begin send_out(str,0); {normalize the buffer}
+while out_ptr>0 do
+ begin if out_ptr<=line_length then break_ptr:=out_ptr;
+ flush_buffer;
+ end;
+out_state:=misc;
+end
+
+@* Introduction to the input phase.
+We have now seen that \.{TANGLE} will be able to output the full
+\PASCAL\ program, if we can only get that program into the byte memory in
+the proper format. The input process is something like the output process
+in reverse, since we compress the text as we read it in and we expand it
+as we write it out.
+
+There are three main input routines. The most interesting is the one that gets
+the next token of a \PASCAL\ text; the other two are used to scan rapidly past
+\TeX\ text in the \.{WEB} source code. One of the latter routines will jump to
+the next token that starts with `\.{@@}', and the other skips to the end
+of a \PASCAL\ comment.
+
+@ But first we need to consider the low-level routine |get_line|
+that takes care of merging |change_file| into |web_file|. The |get_line|
+procedure also updates the line numbers for error messages.
+
+@<Globals...@>=
+@!ii:integer; {general purpose |for| loop variable in the outer block}
+@!line:integer; {the number of the current line in the current file}
+@!other_line:integer; {the number of the current line in the input file that
+ is not currently being read}
+@!temp_line:integer; {used when interchanging |line| with |other_line|}
+@!limit:0..buf_size; {the last character position occupied in the buffer}
+@!loc:0..buf_size; {the next character position to be read from the buffer}
+@!input_has_ended: boolean; {if |true|, there is no more input}
+@!changing: boolean; {if |true|, the current line is from |change_file|}
+
+@ As we change |changing| from |true| to |false| and back again, we must
+remember to swap the values of |line| and |other_line| so that the |err_print|
+routine will be sure to report the correct line number.
+
+@d change_changing==
+ changing := not changing;
+ temp_line:=other_line; other_line:=line; line:=temp_line
+ {|line @t$\null\BA\null$@> other_line|}
+
+@ When |changing| is |false|, the next line of |change_file| is kept in
+|change_buffer[0..change_limit]|, for purposes of comparison with the next
+line of |web_file|. After the change file has been completely input, we
+set |change_limit:=0|, so that no further matches will be made.
+
+@<Globals...@>=
+@!change_buffer:array[0..buf_size] of ASCII_code;
+@!change_limit:0..buf_size; {the last position occupied in |change_buffer|}
+
+@ Here's a simple function that checks if the two buffers are different.
+
+@p function lines_dont_match:boolean;
+label exit;
+var k:0..buf_size; {index into the buffers}
+begin lines_dont_match:=true;
+if change_limit<>limit then return;
+if limit>0 then
+ for k:=0 to limit-1 do if change_buffer[k]<>buffer[k] then return;
+lines_dont_match:=false;
+exit: end;
+
+@ Procedure |prime_the_change_buffer| sets |change_buffer| in preparation
+for the next matching operation. Since blank lines in the change file are
+not used for matching, we have |(change_limit=0)and not changing| if and
+only if the change file is exhausted. This procedure is called only
+when |changing| is true; hence error messages will be reported correctly.
+
+@p procedure prime_the_change_buffer;
+label continue, done, exit;
+var k:0..buf_size; {index into the buffers}
+begin change_limit:=0; {this value will be used if the change file ends}
+@<Skip over comment lines in the change file; |return| if end of file@>;
+@<Skip to the next nonblank line; |return| if end of file@>;
+@<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>;
+exit: end;
+
+@ While looking for a line that begins with \.{@@x} in the change file,
+we allow lines that begin with \.{@@}, as long as they don't begin with
+\.{@@y} or \.{@@z} (which would probably indicate that the change file is
+fouled up).
+
+@<Skip over comment lines in the change file...@>=
+loop@+ begin incr(line);
+ if not input_ln(change_file) then return;
+ if limit<2 then goto continue;
+ if buffer[0]<>"@@" then goto continue;
+ if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if buffer[1]="x" then goto done;
+ if (buffer[1]="y")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@x?');
+@.Where is the match...@>
+ end;
+continue: end;
+done:
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+repeat incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended after @@x');
+@.Change file ended...@>
+ return;
+ end;
+until limit>0;
+
+@ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>=
+begin change_limit:=limit;
+if limit>0 then for k:=0 to limit-1 do change_buffer[k]:=buffer[k];
+end
+
+@ The following procedure is used to see if the next change entry should
+go into effect; it is called only when |changing| is false.
+The idea is to test whether or not the current
+contents of |buffer| matches the current contents of |change_buffer|.
+If not, there's nothing more to do; but if so, a change is called for:
+All of the text down to the \.{@@y} is supposed to match. An error
+message is issued if any discrepancy is found. Then the procedure
+prepares to read the next line from |change_file|.
+
+@p procedure check_change; {switches to |change_file| if the buffers match}
+label exit;
+var n:integer; {the number of discrepancies found}
+@!k:0..buf_size; {index into the buffers}
+begin if lines_dont_match then return;
+n:=0;
+loop@+ begin change_changing; {now it's |true|}
+ incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended before @@y');
+@.Change file ended...@>
+ change_limit:=0; change_changing; {|false| again}
+ return;
+ end;
+ @<If the current line starts with \.{@@y},
+ report any discrepancies and |return|@>;
+ @<Move |buffer| and |limit|...@>;
+ change_changing; {now it's |false|}
+ incr(line);
+ if not input_ln(web_file) then
+ begin err_print('! WEB file ended during a change');
+@.WEB file ended...@>
+ input_has_ended:=true; return;
+ end;
+ if lines_dont_match then incr(n);
+ end;
+exit: end;
+
+@ @<If the current line starts with \.{@@y}...@>=
+if limit>1 then if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@y?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="y" then
+ begin if n>0 then
+ begin loc:=2; err_print('! Hmm... ',n:1,
+ ' of the preceding lines failed to match');
+@.Hmm... n of the preceding...@>
+ end;
+ return;
+ end;
+ end
+
+@ @<Initialize the input system@>=
+open_input; line:=0; other_line:=0;@/
+changing:=true; prime_the_change_buffer; change_changing;@/
+limit:=0; loc:=1; buffer[0]:=" "; input_has_ended:=false;
+
+@ The |get_line| procedure is called when |loc>limit|; it puts the next
+line of merged input into the buffer and updates the other variables
+appropriately. A space is placed at the right end of the line.
+
+@p procedure get_line; {inputs the next line}
+label restart;
+begin restart: if changing then
+ @<Read from |change_file| and maybe turn off |changing|@>;
+if not changing then
+ begin @<Read from |web_file| and maybe turn on |changing|@>;
+ if changing then goto restart;
+ end;
+loc:=0; buffer[limit]:=" ";
+end;
+
+@ @<Read from |web_file|...@>=
+begin incr(line);
+if not input_ln(web_file) then input_has_ended:=true
+else if limit=change_limit then
+ if buffer[0]=change_buffer[0] then
+ if change_limit>0 then check_change;
+end
+
+@ @<Read from |change_file|...@>=
+begin incr(line);
+if not input_ln(change_file) then
+ begin err_print('! Change file ended without @@z');
+@.Change file ended...@>
+ buffer[0]:="@@"; buffer[1]:="z"; limit:=2;
+ end;
+if limit>1 then {check if the change has ended}
+ if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="y") then
+ begin loc:=2; err_print('! Where is the matching @@z?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="z" then
+ begin prime_the_change_buffer; change_changing;
+ end;
+ end;
+end
+
+@ At the end of the program, we will tell the user if the change file
+had a line that didn't match any relevant line in |web_file|.
+
+@<Check that all changes have been read@>=
+if change_limit<>0 then {|changing| is false}
+ begin for ii:=0 to change_limit do buffer[ii]:=change_buffer[ii];
+ limit:=change_limit; changing:=true; line:=other_line; loc:=change_limit;
+ err_print('! Change file entry did not match');
+@.Change file entry did not match@>
+ end
+
+@ Important milestones are reached during the input phase when certain
+control codes are sensed.
+
+Control codes in \.{WEB} begin with `\.{@@}', and the next character
+identifies the code. Some of these are of interest only to \.{WEAVE},
+so \.{TANGLE} ignores them; the others are converted by \.{TANGLE} into
+internal code numbers by the |control_code| function below. The ordering
+of these internal code numbers has been chosen to simplify the program logic;
+larger numbers are given to the control codes that denote more significant
+milestones.
+
+@d ignore=0 {control code of no interest to \.{TANGLE}}
+@d control_text=@'203 {control code for `\.{@@t}', `\.{@@\^}', etc.}
+@d format=@'204 {control code for `\.{@@f}'}
+@d definition=@'205 {control code for `\.{@@d}'}
+@d begin_Pascal=@'206 {control code for `\.{@@p}'}
+@d module_name=@'207 {control code for `\.{@@<}'}
+@d new_module=@'210 {control code for `\.{@@\ }' and `\.{@@*}'}
+
+@p function control_code(@!c:ASCII_code):eight_bits; {convert |c| after \.{@@}}
+begin case c of
+"@@": control_code:="@@"; {`quoted' at sign}
+"'": control_code:=octal; {precedes octal constant}
+"""": control_code:=hex; {precedes hexadecimal constant}
+"$": control_code:=check_sum; {string pool check sum}
+" ",tab_mark: control_code:=new_module; {beginning of a new module}
+"*": begin print('*',module_count+1:1);
+ update_terminal; {print a progress report}
+ control_code:=new_module; {beginning of a new module}
+ end;
+"D","d": control_code:=definition; {macro definition}
+"F","f": control_code:=format; {format definition}
+"{": control_code:=begin_comment; {begin-comment delimiter}
+"}": control_code:=end_comment; {end-comment delimiter}
+"P","p": control_code:=begin_Pascal; {\PASCAL\ text in unnamed module}
+"T","t","^",".",":": control_code:=control_text; {control text to be ignored}
+"&": control_code:=join; {concatenate two tokens}
+"<": control_code:=module_name; {beginning of a module name}
+"=": control_code:=verbatim; {beginning of \PASCAL\ verbatim mode}
+"\": control_code:=force_line; {force a new line in \PASCAL\ output}
+othercases control_code:=ignore {ignore all other cases}
+endcases;
+end;
+
+@ The |skip_ahead| procedure reads through the input at fairly high speed
+until finding the next non-ignorable control code, which it returns.
+
+@p function skip_ahead:eight_bits; {skip to next control code}
+label done;
+var c:eight_bits; {control code found}
+begin loop begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin c:=new_module; goto done;
+ end;
+ end;
+ buffer[limit+1]:="@@";
+ while buffer[loc]<>"@@" do incr(loc);
+ if loc<=limit then
+ begin loc:=loc+2; c:=control_code(buffer[loc-1]);
+ if (c<>ignore)or(buffer[loc-1]=">") then goto done;
+ end;
+ end;
+done: skip_ahead:=c;
+end;
+
+@ The |skip_comment| procedure reads through the input at somewhat high speed
+until finding the first unmatched right brace or until coming to the end
+of the file. It ignores characters following `\.\\' characters, since all
+braces that aren't nested are supposed to be hidden in that way. For
+example, consider the process of skipping the first comment below,
+where the string containing the right brace has been typed as \.{\`\\.\\\}\'}
+in the \.{WEB} file.
+
+@p procedure skip_comment; {skips to next unmatched `\.\}'}
+label exit;
+var bal:eight_bits; {excess of left braces}
+@!c:ASCII_code; {current character}
+begin bal:=0;
+loop@+ begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin err_print('! Input ended in mid-comment');
+@.Input ended in mid-comment@>
+ return;
+ end;
+ end;
+ c:=buffer[loc]; incr(loc);
+ @<Do special things when |c="@@", "\", "{", "}"|; |return| at end@>;
+ end;
+exit:end;
+
+@ @<Do special things when |c="@@"...@>=
+if c="@@" then
+ begin c:=buffer[loc];
+ if (c<>" ")and(c<>tab_mark)and(c<>"*")and(c<>"z")and(c<>"Z") then incr(loc)
+ else begin err_print('! Section ended in mid-comment');
+@.Section ended in mid-comment@>
+ decr(loc); return;
+ end
+ end
+else if (c="\")and(buffer[loc]<>"@@") then incr(loc)
+else if c="{" then incr(bal)
+else if c="}" then
+ begin if bal=0 then return;
+ decr(bal);
+ end
+
+@* Inputting the next token.
+As stated above, \.{TANGLE}'s most interesting input procedure is the
+|get_next| routine that inputs the next token. However, the procedure
+isn't especially difficult.
+
+In most cases the tokens output by |get_next| have the form used in
+replacement texts, except that two-byte tokens are not produced.
+An identifier that isn't one letter long is represented by the
+output `|identifier|', and in such a case the global variables
+|id_first| and |id_loc| will have been set to the appropriate values
+needed by the |id_lookup| procedure. A string that begins with a
+double-quote is also considered an |identifier|, and in such a case
+the global variable |double_chars| will also have been set appropriately.
+Control codes produce the corresponding output of the |control_code|
+function above; and if that code is |module_name|, the value of |cur_module|
+will point to the |byte_start| entry for that module name.
+
+Another global variable, |scanning_hex|, is |true| during the time that
+the letters \.A through \.F should be treated as if they were digits.
+
+@<Globals...@>=
+@!cur_module: name_pointer; {name of module just scanned}
+@!scanning_hex: boolean; {are we scanning a hexadecimal constant?}
+
+@ @<Set init...@>=
+scanning_hex:=false;
+
+@ At the top level, |get_next| is a multi-way switch based on the next
+character in the input buffer. A |new_module| code is inserted at the
+very end of the input file.
+
+@p function get_next:eight_bits; {produces the next input token}
+label restart,done,found;
+var c:eight_bits; {the current character}
+@!d:eight_bits; {the next character}
+@!j,@!k:0..longest_name; {indices into |mod_text|}
+begin restart: if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin c:=new_module; goto found;
+ end;
+ end;
+c:=buffer[loc]; incr(loc);
+if scanning_hex then @<Go to |found| if |c| is a hexadecimal digit,
+ otherwise set |scanning_hex:=false|@>;
+case c of
+"A",up_to("Z"),"a",up_to("z"): @<Get an identifier@>;
+"""": @<Get a preprocessed string@>;
+"@@": @<Get control code and possible module name@>;
+@t\4@>@<Compress two-symbol combinations like `\.{:=}'@>@;
+" ",tab_mark: goto restart; {ignore spaces and tabs}
+"{": begin skip_comment; goto restart;
+ end;
+"}": begin err_print('! Extra }'); goto restart;
+@.Extra \}@>
+ end;
+othercases if c>=128 then goto restart {ignore nonstandard characters}
+ else do_nothing
+endcases;
+found:@!debug if trouble_shooting then debug_help;@;@+gubed@/
+get_next:=c;
+end;
+
+@ @<Go to |found| if |c| is a hexadecimal digit...@>=
+if ((c>="0")and(c<="9"))or((c>="A")and(c<="F")) then goto found
+else scanning_hex:=false
+
+@ Note that the following code substitutes \.{@@\{} and \.{@@\}} for the
+respective combinations `\.{(*}' and `\.{*)}'. Explicit braces should be used
+for \TeX\ comments in \PASCAL\ text.
+
+@d compress(#)==begin if loc<=limit then begin c:=#; incr(loc); end; end
+
+@<Compress two-symbol...@>=
+".": if buffer[loc]="." then compress(double_dot)
+ else if buffer[loc]=")" then compress("]");
+":": if buffer[loc]="=" then compress(left_arrow);
+"=": if buffer[loc]="=" then compress(equivalence_sign);
+">": if buffer[loc]="=" then compress(greater_or_equal);
+"<": if buffer[loc]="=" then compress(less_or_equal)
+ else if buffer[loc]=">" then compress(not_equal);
+"(": if buffer[loc]="*" then compress(begin_comment)
+ else if buffer[loc]="." then compress("[");
+"*": if buffer[loc]=")" then compress(end_comment);
+
+@ We have to look at the preceding character to make sure this isn't part
+of a real constant, before trying to find an identifier starting with
+`\.e' or `\.E'.
+
+@<Get an identifier@>=
+begin if ((c="e")or(c="E"))and(loc>1) then
+ if (buffer[loc-2]<="9")and(buffer[loc-2]>="0") then c:=0;
+if c<>0 then
+ begin decr(loc); id_first:=loc;
+ repeat incr(loc); d:=buffer[loc];
+ until ((d<"0")or((d>"9")and(d<"A"))or((d>"Z")and(d<"a"))or(d>"z")) and
+ (d<>"_");
+ if loc>id_first+1 then
+ begin c:=identifier; id_loc:=loc;
+ end;
+ end
+else c:="E"; {exponent of a real constant}
+end
+
+@ A string that starts and ends with double-quote marks is converted into
+an identifier that behaves like a numeric macro by means of the following
+piece of the program.
+@^preprocessed strings@>
+
+@<Get a preprocessed string@>=
+begin double_chars:=0; id_first:=loc-1;
+repeat d:=buffer[loc]; incr(loc);
+ if (d="""")or(d="@@") then
+ if buffer[loc]=d then
+ begin incr(loc); d:=0; incr(double_chars);
+ end
+ else begin if d="@@" then err_print('! Double @@ sign missing')
+@.Double \AT! sign missing@>
+ end
+ else if loc>limit then
+ begin err_print('! String constant didn''t end'); d:="""";
+@.String constant didn't end@>
+ end;
+until d="""";
+id_loc:=loc-1; c:=identifier;
+end
+
+@ After an \.{@@} sign has been scanned, the next character tells us
+whether there is more work to do.
+
+@<Get control code and possible module name@>=
+begin c:=control_code(buffer[loc]); incr(loc);
+if c=ignore then goto restart
+else if c=hex then scanning_hex:=true
+else if c=module_name then
+ @<Scan the \(module name and make |cur_module| point to it@>
+else if c=control_text then
+ begin repeat c:=skip_ahead;
+ until c<>"@@";
+ if buffer[loc-1]<>">" then
+ err_print('! Improper @@ within control text');
+@.Improper \AT! within control text@>
+ goto restart;
+ end;
+end
+
+@ @<Scan the \(module name...@>=
+begin @<Put module name into |mod_text[1..k]|@>;
+if k>3 then
+ begin if (mod_text[k]=".")and(mod_text[k-1]=".")and(mod_text[k-2]=".") then
+ cur_module:=prefix_lookup(k-3)
+ else cur_module:=mod_lookup(k);
+ end
+else cur_module:=mod_lookup(k);
+end
+
+@ Module names are placed into the |mod_text| array with consecutive spaces,
+tabs, and carriage-returns replaced by single spaces. There will be no
+spaces at the beginning or the end. (We set |mod_text[0]:=" "| to facilitate
+this, since the |mod_lookup| routine uses |mod_text[1]| as the first
+character of the name.)
+
+@<Set init...@>=mod_text[0]:=" ";
+
+@ @<Put module name...@>=
+k:=0;
+loop@+ begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin err_print('! Input ended in section name');
+@.Input ended in section name@>
+ goto done;
+ end;
+ end;
+ d:=buffer[loc];
+ @<If end of name, |goto done|@>;
+ incr(loc); if k<longest_name-1 then incr(k);
+ if (d=" ")or(d=tab_mark) then
+ begin d:=" "; if mod_text[k-1]=" " then decr(k);
+ end;
+ mod_text[k]:=d;
+ end;
+done: @<Check for overlong name@>;
+if (mod_text[k]=" ")and(k>0) then decr(k);
+
+@ @<If end of name,...@>=
+if d="@@" then
+ begin d:=buffer[loc+1];
+ if d=">" then
+ begin loc:=loc+2; goto done;
+ end;
+ if (d=" ")or(d=tab_mark)or(d="*") then
+ begin err_print('! Section name didn''t end'); goto done;
+@.Section name didn't end@>
+ end;
+ incr(k); mod_text[k]:="@@"; incr(loc); {now |d=buffer[loc]| again}
+ end
+
+@ @<Check for overlong name@>=
+if k>=longest_name-2 then
+ begin print_nl('! Section name too long: ');
+@.Section name too long@>
+ for j:=1 to 25 do print(xchr[mod_text[j]]);
+ print('...'); mark_harmless;
+ end
+
+@* Scanning a numeric definition.
+When \.{TANGLE} looks at the \PASCAL\ text following the `\.=' of a numeric
+macro definition, it calls on the precedure |scan_numeric(p)|, where |p|
+points to the name that is to be defined. This procedure evaluates the
+right-hand side, which must consist entirely of integer constants and
+defined numeric macros connected with \.+ and \.- signs (no parentheses).
+It also sets the global variable |next_control| to the control code that
+terminated this definition.
+
+A definition ends with the control codes |definition|, |format|, |module_name|,
+|begin_Pascal|, and |new_module|, all of which can be recognized
+by the fact that they are the largest values |get_next| can return.
+
+@d end_of_definition(#)==(#>=format)
+ {is |#| a control code ending a definition?}
+
+@<Global...@>=
+@!next_control:eight_bits; {control code waiting to be acted upon}
+
+@ The evaluation of a numeric expression makes use of two variables called the
+|accumulator| and the |next_sign|. At the beginning, |accumulator| is zero and
+|next_sign| is $+1$. When a \.+ or \.- is scanned, |next_sign| is multiplied
+by the value of that sign. When a numeric value is scanned, it is multiplied by
+|next_sign| and added to the |accumulator|, then |next_sign| is reset to $+1$.
+
+@d add_in(#)==begin accumulator:=accumulator+next_sign*(#); next_sign:=+1;
+ end
+
+@p procedure scan_numeric(@!p:name_pointer); {defines numeric macros}
+label reswitch, done;
+var accumulator:integer; {accumulates sums}
+@!next_sign:-1..+1; {sign to attach to next value}
+@!q:name_pointer; {points to identifiers being evaluated}
+@!val:integer; {constants being evaluated}
+begin @<Set \(|accumulator| to the value of the right-hand side@>;
+if abs(accumulator)>=@'100000 then
+ begin err_print('! Value too big: ',accumulator:1); accumulator:=0;
+@.Value too big@>
+ end;
+equiv[p]:=accumulator+@'100000; {name |p| now is defined to equal |accumulator|}
+end;
+
+@ @<Set \(|accumulator| to the value of the right-hand side@>=
+accumulator:=0; next_sign:=+1;
+loop@+ begin next_control:=get_next;
+ reswitch: case next_control of
+ digits: begin @<Set |val| to value of decimal constant, and
+ set |next_control| to the following token@>;
+ add_in(val); goto reswitch;
+ end;
+ octal: begin @<Set |val| to value of octal constant, and
+ set |next_control| to the following token@>;
+ add_in(val); goto reswitch;
+ end;
+ hex: begin @<Set |val| to value of hexadecimal constant, and
+ set |next_control| to the following token@>;
+ add_in(val); goto reswitch;
+ end;
+ identifier: begin q:=id_lookup(normal);
+ if ilk[q]<>numeric then
+ begin next_control:="*"; goto reswitch; {leads to error}
+ end;
+ add_in(equiv[q]-@'100000);
+ end;
+ "+": do_nothing;
+ "-": next_sign:=-next_sign;
+ format, definition, module_name, begin_Pascal, new_module: goto done;
+ ";": err_print('! Omit semicolon in numeric definition');
+@.Omit semicolon in numeric def...@>
+ othercases @<Signal error, flush rest of the definition@>
+ endcases;
+ end;
+done:
+
+@ @<Signal error, flush rest...@>=
+begin err_print('! Improper numeric definition will be flushed');
+@.Improper numeric definition...@>
+repeat next_control:=skip_ahead
+until end_of_definition(next_control);
+if next_control=module_name then
+ begin {we want to scan the module name too}
+ loc:=loc-2; next_control:=get_next;
+ end;
+accumulator:=0; goto done;
+end
+
+@ @<Set |val| to value of decimal...@>=
+val:=0;
+repeat val:=10*val+next_control-"0"; next_control:=get_next;
+until (next_control>"9")or(next_control<"0")
+
+@ @<Set |val| to value of octal...@>=
+val:=0; next_control:="0";
+repeat val:=8*val+next_control-"0"; next_control:=get_next;
+until (next_control>"7")or(next_control<"0")
+
+@ @<Set |val| to value of hex...@>=
+val:=0; next_control:="0";
+repeat if next_control>="A" then next_control:=next_control+"0"+10-"A";
+val:=16*val+next_control-"0"; next_control:=get_next;
+until (next_control>"F")or(next_control<"0")or@|
+ ((next_control>"9")and(next_control<"A"))
+
+@* Scanning a macro definition.
+The rules for generating the replacement texts corresponding to simple
+macros, parametric macros, and \PASCAL\ texts of a module are almost
+identical, so a single procedure is used for all three cases. The
+differences are that
+
+\yskip\item{a)} The sign |#| denotes a parameter only when it appears
+outside of strings in a parametric macro; otherwise it stands for the
+ASCII character |#|. (This is not used in standard \PASCAL, but some
+\PASCAL s allow, for example, `\.{/\#}' after a certain kind of file name.)
+
+\item{b)}Module names are not allowed in simple macros or parametric macros;
+in fact, the appearance of a module name terminates such macros and denotes
+the name of the current module.
+
+\item{c)}The symbols \.{@@d} and \.{@@f} and \.{@@p} are not allowed after
+module names, while they terminate macro definitions.
+
+@ Therefore there is a procedure |scan_repl| whose parameter |t| specifies
+either |simple| or |parametric| or |module_name|. After |scan_repl| has
+acted, |cur_repl_text| will point to the replacement text just generated, and
+|next_control| will contain the control code that terminated the activity.
+
+@<Globals...@>=
+@!cur_repl_text:text_pointer; {replacement text formed by |scan_repl|}
+
+@ @p procedure scan_repl(@!t:eight_bits); {creates a replacement text}
+label continue, done, found, reswitch;
+var a:sixteen_bits; {the current token}
+@!b:ASCII_code; {a character from the buffer}
+@!bal:eight_bits; {left parentheses minus right parentheses}
+begin bal:=0;
+loop@+ begin continue: a:=get_next;
+ case a of
+ "(": incr(bal);
+ ")": if bal=0 then err_print('! Extra )')
+@.Extra )@>
+ else decr(bal);
+ "'": @<Copy a string from the buffer to |tok_mem|@>;
+ "#": if t=parametric then a:=param;
+ @t\4@>@<In cases that |a| is a non-ASCII token (|identifier|,
+ |module_name|, etc.), either process it and change |a| to a byte
+ that should be stored, or |goto continue| if |a| should be ignored,
+ or |goto done| if |a| signals the end of this replacement text@>@;
+ othercases do_nothing
+ endcases;@/
+ app_repl(a); {store |a| in |tok_mem|}
+ end;
+done: next_control:=a;
+@<Make sure the parentheses balance@>;
+if text_ptr>max_texts-zz then overflow('text');
+cur_repl_text:=text_ptr; tok_start[text_ptr+zz]:=tok_ptr[z];
+incr(text_ptr);
+if z=zz-1 then z:=0@+else incr(z);
+end;
+
+@ @<Make sure the parentheses balance@>=
+if bal>0 then
+ begin if bal=1 then err_print('! Missing )')
+ else err_print('! Missing ',bal:1,' )''s');
+@.Missing n )@>
+ while bal>0 do
+ begin app_repl(")"); decr(bal);
+ end;
+ end
+
+@ @<In cases that |a| is...@>=
+identifier: begin a:=id_lookup(normal); app_repl((a div @'400)+@'200);
+ a:=a mod @'400;
+ end;
+module_name: if t<>module_name then goto done
+ else begin app_repl((cur_module div @'400)+@'250);
+ a:=cur_module mod @'400;
+ end;
+verbatim: @<Copy verbatim string from the buffer to |tok_mem|@>;
+definition, format, begin_Pascal: if t<>module_name then goto done
+ else begin err_print('! @@',xchr[buffer[loc-1]],
+@.\AT!p is ignored in Pascal text@>
+@.\AT!d is ignored in Pascal text@>
+@.\AT!f is ignored in Pascal text@>
+ ' is ignored in Pascal text'); goto continue;
+ end;
+new_module: goto done;
+
+@ @<Copy a string...@>=
+begin b:="'";
+loop@+ begin app_repl(b);
+ if b="@@" then
+ if buffer[loc]="@@" then incr(loc) {store only one \.{@@}}
+ else err_print('! You should double @@ signs in strings');
+@.You should double \AT! signs@>
+ if loc=limit then
+ begin err_print('! String didn''t end');
+@.String didn't end@>
+ buffer[loc]:="'"; buffer[loc+1]:=0;
+ end;
+ b:=buffer[loc]; incr(loc);
+ if b="'" then
+ begin if buffer[loc]<>"'" then goto found
+ else begin incr(loc); app_repl("'");
+ end;
+ end;
+ end;
+found: end {now |a| holds the final |"'"| that will be stored}
+
+@ @<Copy verbatim string...@>=
+begin app_repl(verbatim);
+buffer[limit+1]:="@@";
+reswitch: if buffer[loc]="@@" then
+ begin if loc<limit then if buffer[loc+1]="@@" then
+ begin app_repl("@@");
+ loc:=loc+2;
+ goto reswitch;
+ end;
+ end
+else begin app_repl(buffer[loc]);
+ incr(loc);
+ goto reswitch;
+ end;
+if loc>=limit then err_print('! Verbatim string didn''t end')
+@.Verbatim string didn't end@>
+else if buffer[loc+1]<>">" then
+ err_print('! You should double @@ signs in verbatim strings');
+@.You should double \AT! signs@>
+loc:=loc+2;
+end {another |verbatim| byte will be stored, since |a=verbatim|}
+
+@ The following procedure is used to define a simple or parametric macro,
+just after the `\.{==}' of its definition has been scanned.
+
+@p procedure define_macro(@!t:eight_bits);
+var p:name_pointer; {the identifier being defined}
+begin p:=id_lookup(t); scan_repl(t);@/
+equiv[p]:=cur_repl_text; text_link[cur_repl_text]:=0;
+end;
+
+@* Scanning a module.
+The |scan_module| procedure starts when `\.{@@\ }' or `\.{@@*}' has been
+sensed in the input, and it proceeds until the end of that module. It
+uses |module_count| to keep track of the current module number; with luck,
+\.{WEAVE} and \.{TANGLE} will both assign the same numbers to modules.
+
+@<Globals...@>=
+@!module_count:0..@'27777; {the current module number}
+
+@ The top level of |scan_module| is trivial.
+@p procedure scan_module;
+label continue, done, exit;
+var p:name_pointer; {module name for the current module}
+begin incr(module_count);
+@<Scan the \(definition part of the current module@>;
+@<Scan the \PASCAL\ part of the current module@>;
+exit: end;
+
+@ @<Scan the \(definition part...@>=
+next_control:=0;
+loop@+ begin continue: while next_control<=format do
+ begin next_control:=skip_ahead;
+ if next_control=module_name then
+ begin {we want to scan the module name too}
+ loc:=loc-2; next_control:=get_next;
+ end;
+ end;
+ if next_control<>definition then goto done;
+ next_control:=get_next; {get identifier name}
+ if next_control<>identifier then
+ begin err_print('! Definition flushed, must start with ',
+@.Definition flushed...@>
+ 'identifier of length > 1'); goto continue;
+ end;
+ next_control:=get_next; {get token after the identifier}
+ if next_control="=" then
+ begin scan_numeric(id_lookup(numeric)); goto continue;
+ end
+ else if next_control=equivalence_sign then
+ begin define_macro(simple); goto continue;
+ end
+ else @<If the next text is `|(#)==|', call |define_macro|
+ and |goto continue|@>;
+ err_print('! Definition flushed since it starts badly');
+@.Definition flushed...@>
+ end;
+done:
+
+@ @<If the next text is `|(#)==|'...@>=
+if next_control="(" then
+ begin next_control:=get_next;
+ if next_control="#" then
+ begin next_control:=get_next;
+ if next_control=")" then
+ begin next_control:=get_next;
+ if next_control="=" then
+ begin err_print('! Use == for macros');
+@.Use == for macros@>
+ next_control:=equivalence_sign;
+ end;
+ if next_control=equivalence_sign then
+ begin define_macro(parametric); goto continue;
+ end;
+ end;
+ end;
+ end;
+
+@ @<Scan the \PASCAL...@>=
+case next_control of
+begin_Pascal:p:=0;
+module_name: begin p:=cur_module;
+ @<Check that |=| or |==| follows this module name, otherwise |return|@>;
+ end;
+othercases return
+endcases;@/
+@<Insert the module number into |tok_mem|@>;
+scan_repl(module_name); {now |cur_repl_text| points to the replacement text}
+@<Update the data structure so that the replacement text is accessible@>;
+
+@ @<Check that |=|...@>=
+repeat next_control:=get_next;
+until next_control<>"+"; {allow optional `\.{+=}'}
+if (next_control<>"=")and(next_control<>equivalence_sign) then
+ begin err_print('! Pascal text flushed, = sign is missing');
+@.Pascal text flushed...@>
+ repeat next_control:=skip_ahead;
+ until next_control=new_module;
+ return;
+ end
+
+@ @<Insert the module number...@>=
+store_two_bytes(@'150000+module_count); {|@'150000=@'320*@'400|}
+
+@ @<Update the data...@>=
+if p=0 then {unnamed module}
+ begin text_link[last_unnamed]:=cur_repl_text; last_unnamed:=cur_repl_text;
+ end
+else if equiv[p]=0 then equiv[p]:=cur_repl_text {first module of this name}
+else begin p:=equiv[p];
+ while text_link[p]<module_flag do p:=text_link[p]; {find end of list}
+ text_link[p]:=cur_repl_text;
+ end;
+text_link[cur_repl_text]:=module_flag;
+ {mark this replacement text as a nonmacro}
+
+@* Debugging.
+The \PASCAL\ debugger with which \.{TANGLE} was developed allows breakpoints
+to be set, and variables can be read and changed, but procedures cannot be
+executed. Therefore a `|debug_help|' procedure has been inserted in the main
+loops of each phase of the program; when |ddt| and |dd| are set to appropriate
+values, symbolic printouts of various tables will appear.
+
+The idea is to set a breakpoint inside the |debug_help| routine, at the
+place of `\ignorespaces|breakpoint:|\unskip' below. Then when
+|debug_help| is to be activated, set |trouble_shooting| equal to |true|.
+The |debug_help| routine will prompt you for values of |ddt| and |dd|,
+discontinuing this when |ddt<=0|; thus you type $2n+1$ integers, ending
+with zero or a negative number. Then control either passes to the
+breakpoint, allowing you to look at and/or change variables (if you typed
+zero), or to exit the routine (if you typed a negative value).
+
+Another global variable, |debug_cycle|, can be used to skip silently
+past calls on |debug_help|. If you set |debug_cycle>1|, the program stops
+only every |debug_cycle| times |debug_help| is called; however,
+any error stop will set |debug_cycle| to zero.
+
+@<Globals...@>=
+@!debug@!trouble_shooting:boolean; {is |debug_help| wanted?}
+@!ddt:integer; {operation code for the |debug_help| routine}
+@!dd:integer; {operand in procedures performed by |debug_help|}
+@!debug_cycle:integer; {threshold for |debug_help| stopping}
+@!debug_skipped:integer; {we have skipped this many |debug_help| calls}
+@!term_in:text_file; {the user's terminal as an input file}
+gubed
+
+@ The debugging routine needs to read from the user's terminal.
+@^system dependencies@>
+@<Set init...@>=
+@!debug trouble_shooting:=true; debug_cycle:=1; debug_skipped:=0;@/
+trouble_shooting:=false; debug_cycle:=99999; {use these when it almost works}
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+gubed
+
+@ @d breakpoint=888 {place where a breakpoint is desirable}
+@^system dependencies@>
+
+@p @!debug procedure debug_help; {routine to display various things}
+label breakpoint,exit;
+var k:integer; {index into various arrays}
+begin incr(debug_skipped);
+if debug_skipped<debug_cycle then return;
+debug_skipped:=0;
+loop@+ begin print_nl('#'); update_terminal; {prompt}
+ read(term_in,ddt); {read a debug-command code}
+ if ddt<0 then return
+ else if ddt=0 then
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: ddt:=0;@\
+ end
+ else begin read(term_in,dd);
+ case ddt of
+ 1: print_id(dd);
+ 2: print_repl(dd);
+ 3: for k:=1 to dd do print(xchr[buffer[k]]);
+ 4: for k:=1 to dd do print(xchr[mod_text[k]]);
+ 5: for k:=1 to out_ptr do print(xchr[out_buf[k]]);
+ 6: for k:=1 to dd do print(xchr[out_contrib[k]]);
+ othercases print('?')
+ endcases;
+ end;
+ end;
+exit:end;
+gubed
+
+@* The main program.
+We have defined plenty of procedures, and it is time to put the last
+pieces of the puzzle in place. Here is where \.{TANGLE} starts, and where
+it ends.
+@^system dependencies@>
+
+@p begin initialize;
+@<Initialize the input system@>;
+print_ln(banner); {print a ``banner line''}
+@<Phase I: Read all the user's text and compress it into |tok_mem|@>;
+stat for ii:=0 to zz-1 do max_tok_ptr[ii]:=tok_ptr[ii];@+tats@;@/
+@<Phase II:...@>;
+end_of_TANGLE:
+if string_ptr>256 then @<Finish off the string pool file@>;
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@t\4\4@>{here files should be closed if the operating system requires it}
+@<Print the job |history|@>;
+end.
+
+@ @<Phase I:...@>=
+phase_one:=true;
+module_count:=0;
+repeat next_control:=skip_ahead;
+until next_control=new_module;
+while not input_has_ended do scan_module;
+@<Check that all changes have been read@>;
+phase_one:=false;
+
+@ @<Finish off the string pool file@>=
+begin print_nl(string_ptr-256:1, ' strings written to string pool file.');
+write(pool,'*');
+for ii:=1 to 9 do
+ begin out_buf[ii]:=pool_check_sum mod 10;
+ pool_check_sum:=pool_check_sum div 10;
+ end;
+for ii:=9 downto 1 do write(pool,xchr["0"+out_buf[ii]]);
+write_ln(pool);
+end
+
+@ @<Glob...@>=
+stat @!wo:0..ww-1; {segment of memory for which statistics are being printed}
+tats
+
+@ @<Print statistics about memory usage@>=
+print_nl('Memory usage statistics:');
+print_nl(name_ptr:1, ' names, ', text_ptr:1, ' replacement texts;');
+print_nl(byte_ptr[0]:1);
+for wo:=1 to ww-1 do print('+',byte_ptr[wo]:1);
+if phase_one then
+ for ii:=0 to zz-1 do max_tok_ptr[ii]:=tok_ptr[ii];
+print(' bytes, ', max_tok_ptr[0]:1);
+for ii:=1 to zz-1 do print('+',max_tok_ptr[ii]:1);
+print(' tokens.');
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_nl('(No errors were found.)');
+harmless_message: print_nl('(Did you see the warning message above?)');
+error_message: print_nl('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_nl('(That was a fatal error, my friend.)');
+end {there are no other cases}
+
+@* System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TANGLE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+
+@* Index.
+Here is a cross-reference table for the \.{TANGLE} processor.
+All modules in which an identifier is
+used are listed with that identifier, except that reserved words are
+indexed only when they appear in format definitions, and the appearances
+of identifiers in module names are not indexed. Underlined entries
+correspond to where the identifier was declared. Error messages and
+a few other things like ``ASCII code'' are indexed here too.
diff --git a/Build/source/texk/web2c/tangleboot.p b/Build/source/texk/web2c/tangleboot.p
new file mode 100644
index 00000000000..9aa2548877c
--- /dev/null
+++ b/Build/source/texk/web2c/tangleboot.p
@@ -0,0 +1,902 @@
+{2:}{4:}{$C-,A+,D-}{[$C+,D+]}
+{:4}program TANGLE(webfile,changefile,Pascalfile,pool);label 9999;
+const{8:}bufsize=3000;maxbytes=45000;maxtoks=60000;maxnames=10000;
+maxtexts=10000;hashsize=353;longestname=400;linelength=72;
+outbufsize=144;stacksize=100;maxidlength=50;defunambiglength=32;
+{:8}type{11:}ASCIIcode=0..255;
+{:11}{12:}textfile=packed file of ASCIIcode;{:12}{37:}eightbits=0..255;
+sixteenbits=0..65535;{:37}{39:}namepointer=0..maxnames;
+{:39}{43:}textpointer=0..maxtexts;
+{:43}{78:}outputstate=record endfield:sixteenbits;bytefield:sixteenbits;
+namefield:namepointer;replfield:textpointer;modfield:0..12287;end;
+{:78}var{9:}history:0..3;{:9}{13:}xord:array[ASCIIcode]of ASCIIcode;
+xchr:array[ASCIIcode]of ASCIIcode;{:13}{23:}webfile:textfile;
+changefile:textfile;{:23}{25:}Pascalfile:textfile;pool:textfile;
+{:25}{27:}buffer:array[0..bufsize]of ASCIIcode;
+{:27}{29:}phaseone:boolean;
+{:29}{38:}bytemem:packed array[0..2,0..maxbytes]of ASCIIcode;
+tokmem:packed array[0..4,0..maxtoks]of eightbits;
+bytestart:array[0..maxnames]of sixteenbits;
+tokstart:array[0..maxtexts]of sixteenbits;
+link:array[0..maxnames]of sixteenbits;
+ilk:array[0..maxnames]of sixteenbits;equiv:array[0..maxnames]of integer;
+textlink:array[0..maxtexts]of sixteenbits;{:38}{40:}nameptr:namepointer;
+stringptr:namepointer;byteptr:array[0..2]of 0..maxbytes;
+poolchecksum:integer;{:40}{44:}textptr:textpointer;
+tokptr:array[0..4]of 0..maxtoks;z:0..4;
+{maxtokptr:array[0..4]of 0..maxtoks;}{:44}{50:}idfirst:0..bufsize;
+idloc:0..bufsize;doublechars:0..bufsize;
+hash,chophash:array[0..hashsize]of sixteenbits;
+choppedid:array[0..maxidlength]of ASCIIcode;
+{:50}{65:}modtext:array[0..longestname]of ASCIIcode;
+{:65}{70:}lastunnamed:textpointer;{:70}{79:}curstate:outputstate;
+stack:array[1..stacksize]of outputstate;stackptr:0..stacksize;
+{:79}{80:}zo:0..4;{:80}{82:}bracelevel:eightbits;
+{:82}{86:}curval:integer;
+{:86}{94:}outbuf:array[0..outbufsize]of ASCIIcode;outptr:0..outbufsize;
+breakptr:0..outbufsize;semiptr:0..outbufsize;
+{:94}{95:}outstate:eightbits;outval,outapp:integer;outsign:ASCIIcode;
+lastsign:-1..+1;{:95}{100:}outcontrib:array[1..linelength]of ASCIIcode;
+{:100}{124:}ii:integer;line:integer;otherline:integer;templine:integer;
+limit:0..bufsize;loc:0..bufsize;inputhasended:boolean;changing:boolean;
+{:124}{126:}changebuffer:array[0..bufsize]of ASCIIcode;
+changelimit:0..bufsize;{:126}{143:}curmodule:namepointer;
+scanninghex:boolean;{:143}{156:}nextcontrol:eightbits;
+{:156}{164:}currepltext:textpointer;{:164}{171:}modulecount:0..12287;
+{:171}{179:}{troubleshooting:boolean;ddt:integer;dd:integer;
+debugcycle:integer;debugskipped:integer;}{:179}{185:}{wo:0..2;}
+{:185}{199:}webname,chgname,pascalname,poolname:cstring;
+forceuppercase,forcelowercase,allowunderlines,strictmode:boolean;
+unambiglength:0..maxidlength;{:199}{30:}{procedure debughelp;forward;}
+{:30}{31:}procedure error;var j:0..outbufsize;k,l:0..bufsize;
+begin if phaseone then{32:}begin if changing then write(stdout,
+'. (change file ')else write(stdout,'. (');
+writeln(stdout,'l.',line:1,')');if loc>=limit then l:=limit else l:=loc;
+for k:=1 to l do if buffer[k-1]=9 then write(stdout,' ')else write(
+stdout,xchr[buffer[k-1]]);writeln(stdout);
+for k:=1 to l do write(stdout,' ');
+for k:=l+1 to limit do write(stdout,xchr[buffer[k-1]]);
+write(stdout,' ');
+end{:32}else{33:}begin writeln(stdout,'. (l.',line:1,')');
+for j:=1 to outptr do write(stdout,xchr[outbuf[j-1]]);
+write(stdout,'... ');end{:33};fflush(stdout);history:=2;
+{debugskipped:=debugcycle;debughelp;}end;
+{:31}{188:}procedure parsearguments;const noptions=10;
+var longoptions:array[0..noptions]of getoptstruct;
+getoptreturnval:integer;optionindex:cinttype;currentoption:0..noptions;
+len:integer;begin{189:}currentoption:=0;
+longoptions[currentoption].name:='help';
+longoptions[currentoption].hasarg:=0;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;currentoption:=currentoption+1;
+{:189}{190:}longoptions[currentoption].name:='version';
+longoptions[currentoption].hasarg:=0;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;currentoption:=currentoption+1;
+{:190}{191:}longoptions[currentoption].name:='mixedcase';
+longoptions[currentoption].hasarg:=0;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;currentoption:=currentoption+1;
+{:191}{192:}longoptions[currentoption].name:='uppercase';
+longoptions[currentoption].hasarg:=0;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;currentoption:=currentoption+1;
+{:192}{193:}longoptions[currentoption].name:='lowercase';
+longoptions[currentoption].hasarg:=0;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;currentoption:=currentoption+1;
+{:193}{194:}longoptions[currentoption].name:='underlines';
+longoptions[currentoption].hasarg:=0;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;currentoption:=currentoption+1;
+{:194}{195:}longoptions[currentoption].name:='strict';
+longoptions[currentoption].hasarg:=0;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;currentoption:=currentoption+1;
+{:195}{196:}longoptions[currentoption].name:='loose';
+longoptions[currentoption].hasarg:=0;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;currentoption:=currentoption+1;
+{:196}{197:}longoptions[currentoption].name:='length';
+longoptions[currentoption].hasarg:=1;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;currentoption:=currentoption+1;
+{:197}{198:}longoptions[currentoption].name:=0;
+longoptions[currentoption].hasarg:=0;longoptions[currentoption].flag:=0;
+longoptions[currentoption].val:=0;{:198};
+unambiglength:=defunambiglength;
+repeat getoptreturnval:=getoptlongonly(argc,argv,'',longoptions,
+addressof(optionindex));if getoptreturnval=-1 then begin;
+end else if getoptreturnval=63 then begin usage('tangle');
+end else if(strcmp(longoptions[optionindex].name,'help')=0)then begin
+usagehelp(TANGLEHELP,nil);
+end else if(strcmp(longoptions[optionindex].name,'version')=0)then begin
+printversionandexit('This is TANGLE, Version 4.5',nil,'D.E. Knuth');
+end else if(strcmp(longoptions[optionindex].name,'mixedcase')=0)then
+begin forceuppercase:=false;forcelowercase:=false;
+end else if(strcmp(longoptions[optionindex].name,'uppercase')=0)then
+begin forceuppercase:=true;forcelowercase:=false;
+end else if(strcmp(longoptions[optionindex].name,'lowercase')=0)then
+begin forceuppercase:=false;forcelowercase:=true;
+end else if(strcmp(longoptions[optionindex].name,'underlines')=0)then
+begin allowunderlines:=true;
+end else if(strcmp(longoptions[optionindex].name,'strict')=0)then begin
+strictmode:=true;
+end else if(strcmp(longoptions[optionindex].name,'loose')=0)then begin
+strictmode:=false;
+end else if(strcmp(longoptions[optionindex].name,'length')=0)then begin
+len:=atoi(optarg);if(len<=0)or(len>maxidlength)then len:=maxidlength;
+unambiglength:=len;end;until getoptreturnval=-1;
+if(optind+1<>argc)and(optind+2<>argc)then begin writeln(stderr,
+'tangle: Need one or two file arguments.');usage('tangle');end;
+webname:=extendfilename(cmdline(optind),'web');
+if optind+2=argc then begin chgname:=extendfilename(cmdline(optind+1),
+'ch');end;pascalname:=basenamechangesuffix(webname,'.web','.p');end;
+{:188}procedure initialize;var{16:}i:0..255;{:16}{41:}wi:0..2;
+{:41}{45:}zi:0..4;{:45}{51:}h:0..hashsize;
+{:51}begin kpsesetprogname(argv[0]);parsearguments;{10:}history:=0;
+{:10}{14:}xchr[32]:=' ';xchr[33]:='!';xchr[34]:='"';xchr[35]:='#';
+xchr[36]:='$';xchr[37]:='%';xchr[38]:='&';xchr[39]:='''';xchr[40]:='(';
+xchr[41]:=')';xchr[42]:='*';xchr[43]:='+';xchr[44]:=',';xchr[45]:='-';
+xchr[46]:='.';xchr[47]:='/';xchr[48]:='0';xchr[49]:='1';xchr[50]:='2';
+xchr[51]:='3';xchr[52]:='4';xchr[53]:='5';xchr[54]:='6';xchr[55]:='7';
+xchr[56]:='8';xchr[57]:='9';xchr[58]:=':';xchr[59]:=';';xchr[60]:='<';
+xchr[61]:='=';xchr[62]:='>';xchr[63]:='?';xchr[64]:='@';xchr[65]:='A';
+xchr[66]:='B';xchr[67]:='C';xchr[68]:='D';xchr[69]:='E';xchr[70]:='F';
+xchr[71]:='G';xchr[72]:='H';xchr[73]:='I';xchr[74]:='J';xchr[75]:='K';
+xchr[76]:='L';xchr[77]:='M';xchr[78]:='N';xchr[79]:='O';xchr[80]:='P';
+xchr[81]:='Q';xchr[82]:='R';xchr[83]:='S';xchr[84]:='T';xchr[85]:='U';
+xchr[86]:='V';xchr[87]:='W';xchr[88]:='X';xchr[89]:='Y';xchr[90]:='Z';
+xchr[91]:='[';xchr[92]:='\';xchr[93]:=']';xchr[94]:='^';xchr[95]:='_';
+xchr[96]:='`';xchr[97]:='a';xchr[98]:='b';xchr[99]:='c';xchr[100]:='d';
+xchr[101]:='e';xchr[102]:='f';xchr[103]:='g';xchr[104]:='h';
+xchr[105]:='i';xchr[106]:='j';xchr[107]:='k';xchr[108]:='l';
+xchr[109]:='m';xchr[110]:='n';xchr[111]:='o';xchr[112]:='p';
+xchr[113]:='q';xchr[114]:='r';xchr[115]:='s';xchr[116]:='t';
+xchr[117]:='u';xchr[118]:='v';xchr[119]:='w';xchr[120]:='x';
+xchr[121]:='y';xchr[122]:='z';xchr[123]:='{';xchr[124]:='|';
+xchr[125]:='}';xchr[126]:='~';xchr[0]:=' ';xchr[127]:=' ';
+{:14}{17:}for i:=1 to 31 do xchr[i]:=chr(i);
+for i:=128 to 255 do xchr[i]:=chr(i);
+{:17}{18:}for i:=0 to 255 do xord[chr(i)]:=32;
+for i:=1 to 255 do xord[xchr[i]]:=i;xord[' ']:=32;
+{:18}{21:}{:21}{26:}rewrite(Pascalfile,pascalname);
+{:26}{42:}for wi:=0 to 2 do begin bytestart[wi]:=0;byteptr[wi]:=0;end;
+bytestart[3]:=0;nameptr:=1;stringptr:=256;poolchecksum:=271828;
+{:42}{46:}for zi:=0 to 4 do begin tokstart[zi]:=0;tokptr[zi]:=0;end;
+tokstart[5]:=0;textptr:=1;z:=1 mod 5;{:46}{48:}ilk[0]:=0;equiv[0]:=0;
+{:48}{52:}for h:=0 to hashsize-1 do begin hash[h]:=0;chophash[h]:=0;end;
+{:52}{71:}lastunnamed:=0;textlink[0]:=0;{:71}{144:}scanninghex:=false;
+{:144}{152:}modtext[0]:=32;{:152}{180:}{troubleshooting:=true;
+debugcycle:=1;debugskipped:=0;troubleshooting:=false;debugcycle:=99999;}
+{:180}end;{:2}{24:}procedure openinput;
+begin webfile:=kpseopenfile(webname,kpsewebformat);
+if chgname then changefile:=kpseopenfile(chgname,kpsewebformat);end;
+{:24}{28:}function inputln(var f:textfile):boolean;
+var finallimit:0..bufsize;begin limit:=0;finallimit:=0;
+if eof(f)then inputln:=false else begin while not eoln(f)do begin buffer
+[limit]:=xord[getc(f)];limit:=limit+1;
+if buffer[limit-1]<>32 then finallimit:=limit;
+if limit=bufsize then begin while not eoln(f)do vgetc(f);limit:=limit-1;
+if finallimit>limit then finallimit:=limit;begin writeln(stdout);
+write(stdout,'! Input line too long');end;loc:=0;error;end;end;
+readln(f);limit:=finallimit;inputln:=true;end;end;
+{:28}{49:}procedure printid(p:namepointer);var k:0..maxbytes;w:0..2;
+begin if p>=nameptr then write(stdout,'IMPOSSIBLE')else begin w:=p mod 3
+;
+for k:=bytestart[p]to bytestart[p+3]-1 do write(stdout,xchr[bytemem[w,k]
+]);end;end;{:49}{53:}function idlookup(t:eightbits):namepointer;
+label 31,32;var c:eightbits;i:0..bufsize;h:0..hashsize;k:0..maxbytes;
+w:0..2;l:0..bufsize;p,q:namepointer;s:0..maxidlength;
+begin l:=idloc-idfirst;{54:}h:=buffer[idfirst];i:=idfirst+1;
+while i<idloc do begin h:=(h+h+buffer[i])mod hashsize;i:=i+1;end{:54};
+{55:}p:=hash[h];
+while p<>0 do begin if bytestart[p+3]-bytestart[p]=l then{56:}begin i:=
+idfirst;k:=bytestart[p];w:=p mod 3;
+while(i<idloc)and(buffer[i]=bytemem[w,k])do begin i:=i+1;k:=k+1;end;
+if i=idloc then goto 31;end{:56};p:=link[p];end;p:=nameptr;
+link[p]:=hash[h];hash[h]:=p;31:{:55};
+if(p=nameptr)or(t<>0)then{57:}begin if((p<>nameptr)and(t<>0)and(ilk[p]=0
+))or((p=nameptr)and(t=0)and(buffer[idfirst]<>34))then{58:}begin i:=
+idfirst;s:=0;h:=0;
+while(i<idloc)and(s<unambiglength)do begin if(buffer[i]<>95)or(
+allowunderlines and not strictmode)then begin if(strictmode or
+forceuppercase)and(buffer[i]>=97)then choppedid[s]:=buffer[i]-32 else if
+(not strictmode and forcelowercase)and(buffer[i]>=65)and(buffer[i]<=90)
+then choppedid[s]:=buffer[i]+32 else choppedid[s]:=buffer[i];
+h:=(h+h+choppedid[s])mod hashsize;s:=s+1;end;i:=i+1;end;choppedid[s]:=0;
+end{:58};
+if p<>nameptr then{59:}begin if ilk[p]=0 then begin if t=1 then begin
+writeln(stdout);write(stdout,'! This identifier has already appeared');
+error;end;{60:}q:=chophash[h];
+if q=p then chophash[h]:=equiv[p]else begin while equiv[q]<>p do q:=
+equiv[q];equiv[q]:=equiv[p];end{:60};end else begin writeln(stdout);
+write(stdout,'! This identifier was defined before');error;end;
+ilk[p]:=t;
+end{:59}else{61:}begin if(t=0)and(buffer[idfirst]<>34)then{62:}begin q:=
+chophash[h];while q<>0 do begin{63:}begin k:=bytestart[q];s:=0;
+w:=q mod 3;
+while(k<bytestart[q+3])and(s<unambiglength)do begin c:=bytemem[w,k];
+if c<>95 or(allowunderlines and not strictmode)then begin if(strictmode
+or forceuppercase)and(c>=97)then c:=c-32 else if(not strictmode and
+forcelowercase)and(c>=65)and(c<=90)then c:=c+32;
+if choppedid[s]<>c then goto 32;s:=s+1;end;k:=k+1;end;
+if(k=bytestart[q+3])and(choppedid[s]<>0)then goto 32;
+begin writeln(stdout);write(stdout,'! Identifier conflict with ');end;
+for k:=bytestart[q]to bytestart[q+3]-1 do write(stdout,xchr[bytemem[w,k]
+]);error;q:=0;32:end{:63};q:=equiv[q];end;equiv[p]:=chophash[h];
+chophash[h]:=p;end{:62};w:=nameptr mod 3;k:=byteptr[w];
+if k+l>maxbytes then begin writeln(stdout);
+write(stderr,'! Sorry, ','byte memory',' capacity exceeded');error;
+history:=3;uexit(1);end;
+if nameptr>maxnames-3 then begin writeln(stdout);
+write(stderr,'! Sorry, ','name',' capacity exceeded');error;history:=3;
+uexit(1);end;i:=idfirst;while i<idloc do begin bytemem[w,k]:=buffer[i];
+k:=k+1;i:=i+1;end;byteptr[w]:=k;bytestart[nameptr+3]:=k;
+nameptr:=nameptr+1;
+if buffer[idfirst]<>34 then ilk[p]:=t else{64:}begin ilk[p]:=1;
+if l-doublechars=2 then equiv[p]:=buffer[idfirst+1]+1073741824 else
+begin if stringptr=256 then begin poolname:=basenamechangesuffix(webname
+,'.web','.pool');rewritebin(pool,poolname);end;
+equiv[p]:=stringptr+1073741824;l:=l-doublechars-1;
+if l>99 then begin writeln(stdout);
+write(stdout,'! Preprocessed string is too long');error;end;
+stringptr:=stringptr+1;write(pool,xchr[48+l div 10],xchr[48+l mod 10]);
+poolchecksum:=poolchecksum+poolchecksum+l;
+while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839;
+i:=idfirst+1;while i<idloc do begin write(pool,xchr[buffer[i]]);
+poolchecksum:=poolchecksum+poolchecksum+buffer[i];
+while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839;
+if(buffer[i]=34)or(buffer[i]=64)then i:=i+2 else i:=i+1;end;
+writeln(pool);end;end{:64};end{:61};end{:57};idlookup:=p;end;
+{:53}{66:}function modlookup(l:sixteenbits):namepointer;label 31;
+var c:0..4;j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer;
+q:namepointer;begin c:=2;q:=0;p:=ilk[0];
+while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 3;c:=1;j:=1;
+while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:=
+k+1;j:=j+1;end;
+if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3
+else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};q:=p;
+if c=0 then p:=link[q]else if c=2 then p:=ilk[q]else goto 31;end;
+{67:}w:=nameptr mod 3;k:=byteptr[w];
+if k+l>maxbytes then begin writeln(stdout);
+write(stderr,'! Sorry, ','byte memory',' capacity exceeded');error;
+history:=3;uexit(1);end;
+if nameptr>maxnames-3 then begin writeln(stdout);
+write(stderr,'! Sorry, ','name',' capacity exceeded');error;history:=3;
+uexit(1);end;p:=nameptr;if c=0 then link[q]:=p else ilk[q]:=p;
+link[p]:=0;ilk[p]:=0;c:=1;equiv[p]:=0;
+for j:=1 to l do bytemem[w,k+j-1]:=modtext[j];byteptr[w]:=k+l;
+bytestart[nameptr+3]:=k+l;nameptr:=nameptr+1;{:67};
+31:if c<>1 then begin begin writeln(stdout);
+write(stdout,'! Incompatible section names');error;end;p:=0;end;
+modlookup:=p;end;
+{:66}{69:}function prefixlookup(l:sixteenbits):namepointer;var c:0..4;
+count:0..maxnames;j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer;
+q:namepointer;r:namepointer;begin q:=0;p:=ilk[0];count:=0;r:=0;
+while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 3;c:=1;j:=1;
+while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:=
+k+1;j:=j+1;end;
+if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3
+else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};
+if c=0 then p:=link[p]else if c=2 then p:=ilk[p]else begin r:=p;
+count:=count+1;q:=ilk[p];p:=link[p];end;if p=0 then begin p:=q;q:=0;end;
+end;if count<>1 then if count=0 then begin writeln(stdout);
+write(stdout,'! Name does not match');error;
+end else begin writeln(stdout);write(stdout,'! Ambiguous prefix');error;
+end;prefixlookup:=r;end;
+{:69}{73:}procedure storetwobytes(x:sixteenbits);
+begin if tokptr[z]+2>maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=x div 256;
+tokmem[z,tokptr[z]+1]:=x mod 256;tokptr[z]:=tokptr[z]+2;end;
+{:73}{74:}{procedure printrepl(p:textpointer);var k:0..maxtoks;
+a:sixteenbits;zp:0..4;
+begin if p>=textptr then write(stdout,'BAD')else begin k:=tokstart[p];
+zp:=p mod 5;while k<tokstart[p+5]do begin a:=tokmem[zp,k];
+if a>=128 then[75:]begin k:=k+1;
+if a<168 then begin a:=(a-128)*256+tokmem[zp,k];printid(a);
+if bytemem[a mod 3,bytestart[a]]=34 then write(stdout,'"')else write(
+stdout,' ');end else if a<208 then begin write(stdout,'@<');
+printid((a-168)*256+tokmem[zp,k]);write(stdout,'@>');
+end else begin a:=(a-208)*256+tokmem[zp,k];
+write(stdout,'@',xchr[123],a:1,'@',xchr[125]);end;
+end[:75]else[76:]case a of 9:write(stdout,'@',xchr[123]);
+10:write(stdout,'@',xchr[125]);12:write(stdout,'@''');
+13:write(stdout,'@"');125:write(stdout,'@$');0:write(stdout,'#');
+64:write(stdout,'@@');2:write(stdout,'@=');3:write(stdout,'@\');
+others:write(stdout,xchr[a])end[:76];k:=k+1;end;end;end;}
+{:74}{84:}procedure pushlevel(p:namepointer);
+begin if stackptr=stacksize then begin writeln(stdout);
+write(stderr,'! Sorry, ','stack',' capacity exceeded');error;history:=3;
+uexit(1);end else begin stack[stackptr]:=curstate;stackptr:=stackptr+1;
+curstate.namefield:=p;curstate.replfield:=equiv[p];
+zo:=curstate.replfield mod 5;
+curstate.bytefield:=tokstart[curstate.replfield];
+curstate.endfield:=tokstart[curstate.replfield+5];curstate.modfield:=0;
+end;end;{:84}{85:}procedure poplevel;label 10;
+begin if textlink[curstate.replfield]=0 then begin if(ilk[curstate.
+namefield]=3)or(ilk[curstate.namefield]=4)then{91:}begin nameptr:=
+nameptr-1;textptr:=textptr-1;z:=textptr mod 5;
+{if tokptr[z]>maxtokptr[z]then maxtokptr[z]:=tokptr[z];}
+tokptr[z]:=tokstart[textptr];
+{byteptr[nameptr mod 3]:=byteptr[nameptr mod 3]-1;}end{:91};
+end else if textlink[curstate.replfield]<maxtexts then begin curstate.
+replfield:=textlink[curstate.replfield];zo:=curstate.replfield mod 5;
+curstate.bytefield:=tokstart[curstate.replfield];
+curstate.endfield:=tokstart[curstate.replfield+5];goto 10;end;
+stackptr:=stackptr-1;if stackptr>0 then begin curstate:=stack[stackptr];
+zo:=curstate.replfield mod 5;end;10:end;
+{:85}{87:}function getoutput:sixteenbits;label 20,30,31;
+var a:sixteenbits;b:eightbits;bal:sixteenbits;k:0..maxbytes;w:0..2;
+begin 20:if stackptr=0 then begin a:=0;goto 31;end;
+if curstate.bytefield=curstate.endfield then begin curval:=-curstate.
+modfield;poplevel;if curval=0 then goto 20;a:=129;goto 31;end;
+a:=tokmem[zo,curstate.bytefield];
+curstate.bytefield:=curstate.bytefield+1;
+if a<128 then if a=0 then{92:}begin pushlevel(nameptr-1);goto 20;
+end{:92}else goto 31;a:=(a-128)*256+tokmem[zo,curstate.bytefield];
+curstate.bytefield:=curstate.bytefield+1;
+if a<10240 then{89:}begin case ilk[a]of 0:begin curval:=a;a:=130;end;
+1:begin curval:=equiv[a]-1073741824;a:=128;end;2:begin pushlevel(a);
+goto 20;end;
+3,4:begin{90:}while(curstate.bytefield=curstate.endfield)and(stackptr>0)
+do poplevel;
+if(stackptr=0)or((ilk[a]=3)and(tokmem[zo,curstate.bytefield]<>40))or((
+ilk[a]=4)and(tokmem[zo,curstate.bytefield]<>91))then begin begin writeln
+(stdout);write(stdout,'! No parameter given for ');end;printid(a);error;
+goto 20;end;{93:}bal:=1;curstate.bytefield:=curstate.bytefield+1;
+while true do begin b:=tokmem[zo,curstate.bytefield];
+curstate.bytefield:=curstate.bytefield+1;
+if b=0 then storetwobytes(nameptr+32767)else begin if b>=128 then begin
+begin if tokptr[z]=maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;
+b:=tokmem[zo,curstate.bytefield];
+curstate.bytefield:=curstate.bytefield+1;
+end else case b of 40:if ilk[a]=3 then bal:=bal+1;
+41:if ilk[a]=3 then begin bal:=bal-1;if bal=0 then goto 30;end;
+91:if ilk[a]=4 then bal:=bal+1;93:if ilk[a]=4 then begin bal:=bal-1;
+if bal=0 then goto 30;end;
+39:repeat begin if tokptr[z]=maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;
+b:=tokmem[zo,curstate.bytefield];
+curstate.bytefield:=curstate.bytefield+1;until b=39;others:end;
+begin if tokptr[z]=maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;end;end;
+30:{:93};equiv[nameptr]:=textptr;ilk[nameptr]:=2;w:=nameptr mod 3;
+k:=byteptr[w];{if k=maxbytes then begin writeln(stdout);
+write(stderr,'! Sorry, ','byte memory',' capacity exceeded');error;
+history:=3;uexit(1);end;bytemem[w,k]:=35;k:=k+1;byteptr[w]:=k;}
+if nameptr>maxnames-3 then begin writeln(stdout);
+write(stderr,'! Sorry, ','name',' capacity exceeded');error;history:=3;
+uexit(1);end;bytestart[nameptr+3]:=k;nameptr:=nameptr+1;
+if textptr>maxtexts-5 then begin writeln(stdout);
+write(stderr,'! Sorry, ','text',' capacity exceeded');error;history:=3;
+uexit(1);end;textlink[textptr]:=0;tokstart[textptr+5]:=tokptr[z];
+textptr:=textptr+1;z:=textptr mod 5{:90};pushlevel(a);goto 20;end;
+others:begin writeln(stdout);
+write(stderr,'! This can''t happen (','output',')');error;history:=3;
+uexit(1);end end;goto 31;end{:89};if a<20480 then{88:}begin a:=a-10240;
+if equiv[a]<>0 then pushlevel(a)else if a<>0 then begin begin writeln(
+stdout);write(stdout,'! Not present: <');end;printid(a);
+write(stdout,'>');error;end;goto 20;end{:88};curval:=a-20480;a:=129;
+curstate.modfield:=curval;31:{if troubleshooting then debughelp;}
+getoutput:=a;end;{:87}{97:}procedure flushbuffer;var k:0..outbufsize;
+b:0..outbufsize;begin b:=breakptr;
+if(semiptr<>0)and(outptr-semiptr<=linelength)then breakptr:=semiptr;
+for k:=1 to breakptr do write(Pascalfile,xchr[outbuf[k-1]]);
+writeln(Pascalfile);line:=line+1;
+if line mod 100=0 then begin write(stdout,'.');
+if line mod 500=0 then write(stdout,line:1);fflush(stdout);end;
+if breakptr<outptr then begin if outbuf[breakptr]=32 then begin breakptr
+:=breakptr+1;if breakptr>b then b:=breakptr;end;
+for k:=breakptr to outptr-1 do outbuf[k-breakptr]:=outbuf[k];end;
+outptr:=outptr-breakptr;breakptr:=b-breakptr;semiptr:=0;
+if outptr>linelength then begin begin writeln(stdout);
+write(stdout,'! Long line must be truncated');error;end;
+outptr:=linelength;end;end;{:97}{99:}procedure appval(v:integer);
+var k:0..outbufsize;begin k:=outbufsize;repeat outbuf[k]:=v mod 10;
+v:=v div 10;k:=k-1;until v=0;repeat k:=k+1;
+begin outbuf[outptr]:=outbuf[k]+48;outptr:=outptr+1;end;
+until k=outbufsize;end;{:99}{101:}procedure sendout(t:eightbits;
+v:sixteenbits);label 20;var k:0..linelength;
+begin{102:}20:case outstate of 1:if t<>3 then begin breakptr:=outptr;
+if t=2 then begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;
+2:begin begin outbuf[outptr]:=44-outapp;outptr:=outptr+1;end;
+if outptr>linelength then flushbuffer;breakptr:=outptr;end;
+3,4:begin{103:}if(outval<0)or((outval=0)and(lastsign<0))then begin
+outbuf[outptr]:=45;outptr:=outptr+1;
+end else if outsign>0 then begin outbuf[outptr]:=outsign;
+outptr:=outptr+1;end;appval(abs(outval));
+if outptr>linelength then flushbuffer;{:103};outstate:=outstate-2;
+goto 20;end;
+5:{104:}begin if(t=3)or({105:}((t=2)and(v=3)and(((outcontrib[1]=68)and(
+outcontrib[2]=73)and(outcontrib[3]=86))or((outcontrib[1]=100)and(
+outcontrib[2]=105)and(outcontrib[3]=118))or((outcontrib[1]=77)and(
+outcontrib[2]=79)and(outcontrib[3]=68))or((outcontrib[1]=109)and(
+outcontrib[2]=111)and(outcontrib[3]=100))))or((t=0)and((v=42)or(v=47)))
+{:105})then begin{103:}if(outval<0)or((outval=0)and(lastsign<0))then
+begin outbuf[outptr]:=45;outptr:=outptr+1;
+end else if outsign>0 then begin outbuf[outptr]:=outsign;
+outptr:=outptr+1;end;appval(abs(outval));
+if outptr>linelength then flushbuffer;{:103};outsign:=43;outval:=outapp;
+end else outval:=outval+outapp;outstate:=3;goto 20;end{:104};
+0:if t<>3 then breakptr:=outptr;others:end{:102};
+if t<>0 then for k:=1 to v do begin outbuf[outptr]:=outcontrib[k];
+outptr:=outptr+1;end else begin outbuf[outptr]:=v;outptr:=outptr+1;end;
+if outptr>linelength then flushbuffer;
+if(t=0)and((v=59)or(v=125))then begin semiptr:=outptr;breakptr:=outptr;
+end;if t>=2 then outstate:=1 else outstate:=0 end;
+{:101}{106:}procedure sendsign(v:integer);
+begin case outstate of 2,4:outapp:=outapp*v;3:begin outapp:=v;
+outstate:=4;end;5:begin outval:=outval+outapp;outapp:=v;outstate:=4;end;
+others:begin breakptr:=outptr;outapp:=v;outstate:=2;end end;
+lastsign:=outapp;end;{:106}{107:}procedure sendval(v:integer);
+label 666,10;
+begin case outstate of 1:begin{110:}if(outptr=breakptr+3)or((outptr=
+breakptr+4)and(outbuf[breakptr]=32))then if((outbuf[outptr-3]=68)and(
+outbuf[outptr-2]=73)and(outbuf[outptr-1]=86))or((outbuf[outptr-3]=100)
+and(outbuf[outptr-2]=105)and(outbuf[outptr-1]=118))or((outbuf[outptr-3]=
+77)and(outbuf[outptr-2]=79)and(outbuf[outptr-1]=68))or((outbuf[outptr-3]
+=109)and(outbuf[outptr-2]=111)and(outbuf[outptr-1]=100))then goto 666
+{:110};outsign:=32;outstate:=3;outval:=v;breakptr:=outptr;lastsign:=+1;
+end;
+0:begin{109:}if(outptr=breakptr+1)and((outbuf[breakptr]=42)or(outbuf[
+breakptr]=47))then goto 666{:109};outsign:=0;outstate:=3;outval:=v;
+breakptr:=outptr;lastsign:=+1;end;{108:}2:begin outsign:=43;outstate:=3;
+outval:=outapp*v;end;3:begin outstate:=5;outapp:=v;
+begin writeln(stdout);
+write(stdout,'! Two numbers occurred without a sign between them');
+error;end;end;4:begin outstate:=5;outapp:=outapp*v;end;
+5:begin outval:=outval+outapp;outapp:=v;begin writeln(stdout);
+write(stdout,'! Two numbers occurred without a sign between them');
+error;end;end;{:108}others:goto 666 end;goto 10;
+666:{111:}if v>=0 then begin if outstate=1 then begin breakptr:=outptr;
+begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;appval(v);
+if outptr>linelength then flushbuffer;outstate:=1;
+end else begin begin outbuf[outptr]:=40;outptr:=outptr+1;end;
+begin outbuf[outptr]:=45;outptr:=outptr+1;end;appval(-v);
+begin outbuf[outptr]:=41;outptr:=outptr+1;end;
+if outptr>linelength then flushbuffer;outstate:=0;end{:111};10:end;
+{:107}{113:}procedure sendtheoutput;label 2,21,22;var curchar:eightbits;
+k:0..linelength;j:0..maxbytes;w:0..2;n:integer;
+begin while stackptr>0 do begin curchar:=getoutput;
+21:case curchar of 0:;
+{116:}65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,
+87,88,89,90:begin if forcelowercase then outcontrib[1]:=curchar+32 else
+outcontrib[1]:=curchar;sendout(2,1);end;
+97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115
+,116,117,118,119,120,121,122:begin if forceuppercase then outcontrib[1]
+:=curchar-32 else outcontrib[1]:=curchar;sendout(2,1);end;
+130:begin k:=0;j:=bytestart[curval];w:=curval mod 3;
+while(k<maxidlength)and(j<bytestart[curval+3])do begin k:=k+1;
+outcontrib[k]:=bytemem[w,j];j:=j+1;
+if forceuppercase and(outcontrib[k]>=97)then outcontrib[k]:=outcontrib[k
+]-32 else if forcelowercase and(outcontrib[k]<=90)then outcontrib[k]:=
+outcontrib[k]+32 else if not allowunderlines and(outcontrib[k]=95)then k
+:=k-1;end;sendout(2,k);end;
+{:116}{119:}48,49,50,51,52,53,54,55,56,57:begin n:=0;
+repeat curchar:=curchar-48;if n>=214748364 then begin writeln(stdout);
+write(stdout,'! Constant too big');error;end else n:=10*n+curchar;
+curchar:=getoutput;until(curchar>57)or(curchar<48);sendval(n);k:=0;
+if curchar=101 then curchar:=69;if curchar=69 then goto 2 else goto 21;
+end;125:sendval(poolchecksum);12:begin n:=0;curchar:=48;
+repeat curchar:=curchar-48;if n>=1073741824 then begin writeln(stdout);
+write(stdout,'! Constant too big');error;end else n:=8*n+curchar;
+curchar:=getoutput;until(curchar>55)or(curchar<48);sendval(n);goto 21;
+end;13:begin n:=0;curchar:=48;
+repeat if curchar>=65 then curchar:=curchar-55 else curchar:=curchar-48;
+if n>=1073741824 then begin writeln(stdout);
+write(stdout,'! Constant too big');error;end else n:=16*n+curchar;
+curchar:=getoutput;
+until(curchar>70)or(curchar<48)or((curchar>57)and(curchar<65));
+sendval(n);goto 21;end;128:sendval(curval);46:begin k:=1;
+outcontrib[1]:=46;curchar:=getoutput;
+if curchar=46 then begin outcontrib[2]:=46;sendout(1,2);
+end else if(curchar>=48)and(curchar<=57)then goto 2 else begin sendout(0
+,46);goto 21;end;end;{:119}43,45:sendsign(44-curchar);
+{114:}4:begin outcontrib[1]:=97;outcontrib[2]:=110;outcontrib[3]:=100;
+sendout(2,3);end;5:begin outcontrib[1]:=110;outcontrib[2]:=111;
+outcontrib[3]:=116;sendout(2,3);end;6:begin outcontrib[1]:=105;
+outcontrib[2]:=110;sendout(2,2);end;31:begin outcontrib[1]:=111;
+outcontrib[2]:=114;sendout(2,2);end;24:begin outcontrib[1]:=58;
+outcontrib[2]:=61;sendout(1,2);end;26:begin outcontrib[1]:=60;
+outcontrib[2]:=62;sendout(1,2);end;28:begin outcontrib[1]:=60;
+outcontrib[2]:=61;sendout(1,2);end;29:begin outcontrib[1]:=62;
+outcontrib[2]:=61;sendout(1,2);end;30:begin outcontrib[1]:=61;
+outcontrib[2]:=61;sendout(1,2);end;32:begin outcontrib[1]:=46;
+outcontrib[2]:=46;sendout(1,2);end;{:114}39:{117:}begin k:=1;
+outcontrib[1]:=39;repeat if k<linelength then k:=k+1;
+outcontrib[k]:=getoutput;until(outcontrib[k]=39)or(stackptr=0);
+if k=linelength then begin writeln(stdout);
+write(stdout,'! String too long');error;end;sendout(1,k);
+curchar:=getoutput;if curchar=39 then outstate:=6;goto 21;end{:117};
+{115:}33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,
+95,96,123,124{:115}:sendout(0,curchar);
+{121:}9:begin if bracelevel=0 then sendout(0,123)else sendout(0,91);
+bracelevel:=bracelevel+1;end;
+10:if bracelevel>0 then begin bracelevel:=bracelevel-1;
+if bracelevel=0 then sendout(0,125)else sendout(0,93);
+end else begin writeln(stdout);write(stdout,'! Extra @}');error;end;
+129:begin k:=2;
+if bracelevel=0 then outcontrib[1]:=123 else outcontrib[1]:=91;
+if curval<0 then begin outcontrib[k]:=58;curval:=-curval;k:=k+1;end;
+n:=10;while curval>=n do n:=10*n;repeat n:=n div 10;
+outcontrib[k]:=48+(curval div n);curval:=curval mod n;k:=k+1;until n=1;
+if outcontrib[2]<>58 then begin outcontrib[k]:=58;k:=k+1;end;
+if bracelevel=0 then outcontrib[k]:=125 else outcontrib[k]:=93;
+sendout(1,k);end;{:121}127:begin sendout(3,0);outstate:=6;end;
+2:{118:}begin k:=0;repeat if k<linelength then k:=k+1;
+outcontrib[k]:=getoutput;until(outcontrib[k]=2)or(stackptr=0);
+if k=linelength then begin writeln(stdout);
+write(stdout,'! Verbatim string too long');error;end;sendout(1,k-1);
+end{:118};3:{122:}begin sendout(1,0);
+while outptr>0 do begin if outptr<=linelength then breakptr:=outptr;
+flushbuffer;end;outstate:=0;end{:122};others:begin writeln(stdout);
+write(stdout,'! Can''t output ASCII code ',curchar:1);error;end end;
+goto 22;2:{120:}repeat if k<linelength then k:=k+1;
+outcontrib[k]:=curchar;curchar:=getoutput;
+if(outcontrib[k]=69)and((curchar=43)or(curchar=45))then begin if k<
+linelength then k:=k+1;outcontrib[k]:=curchar;curchar:=getoutput;
+end else if curchar=101 then curchar:=69;
+until(curchar<>69)and((curchar<48)or(curchar>57));
+if k=linelength then begin writeln(stdout);
+write(stdout,'! Fraction too long');error;end;sendout(3,k);
+goto 21{:120};22:end;end;{:113}{127:}function linesdontmatch:boolean;
+label 10;var k:0..bufsize;begin linesdontmatch:=true;
+if changelimit<>limit then goto 10;
+if limit>0 then for k:=0 to limit-1 do if changebuffer[k]<>buffer[k]then
+goto 10;linesdontmatch:=false;10:end;
+{:127}{128:}procedure primethechangebuffer;label 22,30,10;
+var k:0..bufsize;begin changelimit:=0;
+{129:}while true do begin line:=line+1;
+if not inputln(changefile)then goto 10;if limit<2 then goto 22;
+if buffer[0]<>64 then goto 22;
+if(buffer[1]>=88)and(buffer[1]<=90)then buffer[1]:=buffer[1]+32;
+if buffer[1]=120 then goto 30;
+if(buffer[1]=121)or(buffer[1]=122)then begin loc:=2;
+begin writeln(stdout);write(stdout,'! Where is the matching @x?');error;
+end;end;22:end;30:{:129};{130:}repeat line:=line+1;
+if not inputln(changefile)then begin begin writeln(stdout);
+write(stdout,'! Change file ended after @x');error;end;goto 10;end;
+until limit>0;{:130};{131:}begin changelimit:=limit;
+if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k];
+end{:131};10:end;{:128}{132:}procedure checkchange;label 10;
+var n:integer;k:0..bufsize;begin if linesdontmatch then goto 10;n:=0;
+while true do begin changing:=not changing;templine:=otherline;
+otherline:=line;line:=templine;line:=line+1;
+if not inputln(changefile)then begin begin writeln(stdout);
+write(stdout,'! Change file ended before @y');error;end;changelimit:=0;
+changing:=not changing;templine:=otherline;otherline:=line;
+line:=templine;goto 10;end;
+{133:}if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(
+buffer[1]<=90)then buffer[1]:=buffer[1]+32;
+if(buffer[1]=120)or(buffer[1]=122)then begin loc:=2;
+begin writeln(stdout);write(stdout,'! Where is the matching @y?');error;
+end;end else if buffer[1]=121 then begin if n>0 then begin loc:=2;
+begin writeln(stdout);
+write(stdout,'! Hmm... ',n:1,' of the preceding lines failed to match');
+error;end;end;goto 10;end;end{:133};{131:}begin changelimit:=limit;
+if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k];
+end{:131};changing:=not changing;templine:=otherline;otherline:=line;
+line:=templine;line:=line+1;
+if not inputln(webfile)then begin begin writeln(stdout);
+write(stdout,'! WEB file ended during a change');error;end;
+inputhasended:=true;goto 10;end;if linesdontmatch then n:=n+1;end;
+10:end;{:132}{135:}procedure getline;label 20;
+begin 20:if changing then{137:}begin line:=line+1;
+if not inputln(changefile)then begin begin writeln(stdout);
+write(stdout,'! Change file ended without @z');error;end;buffer[0]:=64;
+buffer[1]:=122;limit:=2;end;
+if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1
+]<=90)then buffer[1]:=buffer[1]+32;
+if(buffer[1]=120)or(buffer[1]=121)then begin loc:=2;
+begin writeln(stdout);write(stdout,'! Where is the matching @z?');error;
+end;end else if buffer[1]=122 then begin primethechangebuffer;
+changing:=not changing;templine:=otherline;otherline:=line;
+line:=templine;end;end;end{:137};
+if not changing then begin{136:}begin line:=line+1;
+if not inputln(webfile)then inputhasended:=true else if limit=
+changelimit then if buffer[0]=changebuffer[0]then if changelimit>0 then
+checkchange;end{:136};if changing then goto 20;end;loc:=0;
+buffer[limit]:=32;end;
+{:135}{139:}function controlcode(c:ASCIIcode):eightbits;
+begin case c of 64:controlcode:=64;39:controlcode:=12;
+34:controlcode:=13;36:controlcode:=125;32,9:controlcode:=136;
+42:begin write(stdout,'*',modulecount+1:1);fflush(stdout);
+controlcode:=136;end;68,100:controlcode:=133;70,102:controlcode:=132;
+123:controlcode:=9;125:controlcode:=10;80,112:controlcode:=134;
+84,116,94,46,58:controlcode:=131;38:controlcode:=127;
+60:controlcode:=135;61:controlcode:=2;92:controlcode:=3;
+others:controlcode:=0 end;end;{:139}{140:}function skipahead:eightbits;
+label 30;var c:eightbits;
+begin while true do begin if loc>limit then begin getline;
+if inputhasended then begin c:=136;goto 30;end;end;buffer[limit+1]:=64;
+while buffer[loc]<>64 do loc:=loc+1;if loc<=limit then begin loc:=loc+2;
+c:=controlcode(buffer[loc-1]);if(c<>0)or(buffer[loc-1]=62)then goto 30;
+end;end;30:skipahead:=c;end;{:140}{141:}procedure skipcomment;label 10;
+var bal:eightbits;c:ASCIIcode;begin bal:=0;
+while true do begin if loc>limit then begin getline;
+if inputhasended then begin begin writeln(stdout);
+write(stdout,'! Input ended in mid-comment');error;end;goto 10;end;end;
+c:=buffer[loc];loc:=loc+1;{142:}if c=64 then begin c:=buffer[loc];
+if(c<>32)and(c<>9)and(c<>42)and(c<>122)and(c<>90)then loc:=loc+1 else
+begin begin writeln(stdout);
+write(stdout,'! Section ended in mid-comment');error;end;loc:=loc-1;
+goto 10;
+end end else if(c=92)and(buffer[loc]<>64)then loc:=loc+1 else if c=123
+then bal:=bal+1 else if c=125 then begin if bal=0 then goto 10;
+bal:=bal-1;end{:142};end;10:end;{:141}{145:}function getnext:eightbits;
+label 20,30,31;var c:eightbits;d:eightbits;j,k:0..longestname;
+begin 20:if loc>limit then begin getline;
+if inputhasended then begin c:=136;goto 31;end;end;c:=buffer[loc];
+loc:=loc+1;
+if scanninghex then{146:}if((c>=48)and(c<=57))or((c>=65)and(c<=70))then
+goto 31 else scanninghex:=false{:146};
+case c of 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
+,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
+,112,113,114,115,116,117,118,119,120,121,122:{148:}begin if((c=101)or(c=
+69))and(loc>1)then if(buffer[loc-2]<=57)and(buffer[loc-2]>=48)then c:=0;
+if c<>0 then begin loc:=loc-1;idfirst:=loc;repeat loc:=loc+1;
+d:=buffer[loc];
+until((d<48)or((d>57)and(d<65))or((d>90)and(d<97))or(d>122))and(d<>95);
+if loc>idfirst+1 then begin c:=130;idloc:=loc;end;end else c:=69;
+end{:148};34:{149:}begin doublechars:=0;idfirst:=loc-1;
+repeat d:=buffer[loc];loc:=loc+1;
+if(d=34)or(d=64)then if buffer[loc]=d then begin loc:=loc+1;d:=0;
+doublechars:=doublechars+1;
+end else begin if d=64 then begin writeln(stdout);
+write(stdout,'! Double @ sign missing');error;
+end end else if loc>limit then begin begin writeln(stdout);
+write(stdout,'! String constant didn''t end');error;end;d:=34;end;
+until d=34;idloc:=loc-1;c:=130;end{:149};
+64:{150:}begin c:=controlcode(buffer[loc]);loc:=loc+1;
+if c=0 then goto 20 else if c=13 then scanninghex:=true else if c=135
+then{151:}begin{153:}k:=0;
+while true do begin if loc>limit then begin getline;
+if inputhasended then begin begin writeln(stdout);
+write(stdout,'! Input ended in section name');error;end;goto 30;end;end;
+d:=buffer[loc];{154:}if d=64 then begin d:=buffer[loc+1];
+if d=62 then begin loc:=loc+2;goto 30;end;
+if(d=32)or(d=9)or(d=42)then begin begin writeln(stdout);
+write(stdout,'! Section name didn''t end');error;end;goto 30;end;k:=k+1;
+modtext[k]:=64;loc:=loc+1;end{:154};loc:=loc+1;
+if k<longestname-1 then k:=k+1;if(d=32)or(d=9)then begin d:=32;
+if modtext[k-1]=32 then k:=k-1;end;modtext[k]:=d;end;
+30:{155:}if k>=longestname-2 then begin begin writeln(stdout);
+write(stdout,'! Section name too long: ');end;
+for j:=1 to 25 do write(stdout,xchr[modtext[j]]);write(stdout,'...');
+if history=0 then history:=1;end{:155};
+if(modtext[k]=32)and(k>0)then k:=k-1;{:153};
+if k>3 then begin if(modtext[k]=46)and(modtext[k-1]=46)and(modtext[k-2]=
+46)then curmodule:=prefixlookup(k-3)else curmodule:=modlookup(k);
+end else curmodule:=modlookup(k);
+end{:151}else if c=131 then begin repeat c:=skipahead;until c<>64;
+if buffer[loc-1]<>62 then begin writeln(stdout);
+write(stdout,'! Improper @ within control text');error;end;goto 20;end;
+end{:150};
+{147:}46:if buffer[loc]=46 then begin if loc<=limit then begin c:=32;
+loc:=loc+1;end;
+end else if buffer[loc]=41 then begin if loc<=limit then begin c:=93;
+loc:=loc+1;end;end;
+58:if buffer[loc]=61 then begin if loc<=limit then begin c:=24;
+loc:=loc+1;end;end;
+61:if buffer[loc]=61 then begin if loc<=limit then begin c:=30;
+loc:=loc+1;end;end;
+62:if buffer[loc]=61 then begin if loc<=limit then begin c:=29;
+loc:=loc+1;end;end;
+60:if buffer[loc]=61 then begin if loc<=limit then begin c:=28;
+loc:=loc+1;end;
+end else if buffer[loc]=62 then begin if loc<=limit then begin c:=26;
+loc:=loc+1;end;end;
+40:if buffer[loc]=42 then begin if loc<=limit then begin c:=9;
+loc:=loc+1;end;
+end else if buffer[loc]=46 then begin if loc<=limit then begin c:=91;
+loc:=loc+1;end;end;
+42:if buffer[loc]=41 then begin if loc<=limit then begin c:=10;
+loc:=loc+1;end;end;{:147}32,9:goto 20;123:begin skipcomment;goto 20;end;
+125:begin begin writeln(stdout);write(stdout,'! Extra }');error;end;
+goto 20;end;others:if c>=128 then goto 20 else end;
+31:{if troubleshooting then debughelp;}getnext:=c;end;
+{:145}{157:}procedure scannumeric(p:namepointer);label 21,30;
+var accumulator:integer;nextsign:-1..+1;q:namepointer;val:integer;
+begin{158:}accumulator:=0;nextsign:=+1;
+while true do begin nextcontrol:=getnext;
+21:case nextcontrol of 48,49,50,51,52,53,54,55,56,57:begin{160:}val:=0;
+repeat val:=10*val+nextcontrol-48;nextcontrol:=getnext;
+until(nextcontrol>57)or(nextcontrol<48){:160};
+begin accumulator:=accumulator+nextsign*intcast(val);nextsign:=+1;end;
+goto 21;end;12:begin{161:}val:=0;nextcontrol:=48;
+repeat val:=8*val+nextcontrol-48;nextcontrol:=getnext;
+until(nextcontrol>55)or(nextcontrol<48){:161};
+begin accumulator:=accumulator+nextsign*intcast(val);nextsign:=+1;end;
+goto 21;end;13:begin{162:}val:=0;nextcontrol:=48;
+repeat if nextcontrol>=65 then nextcontrol:=nextcontrol-7;
+val:=16*val+nextcontrol-48;nextcontrol:=getnext;
+until(nextcontrol>70)or(nextcontrol<48)or((nextcontrol>57)and(
+nextcontrol<65)){:162};
+begin accumulator:=accumulator+nextsign*intcast(val);nextsign:=+1;end;
+goto 21;end;130:begin q:=idlookup(0);
+if ilk[q]<>1 then begin nextcontrol:=42;goto 21;end;
+begin accumulator:=accumulator+nextsign*intcast(equiv[q]-1073741824);
+nextsign:=+1;end;end;43:;45:nextsign:=-nextsign;
+132,133,135,134,136:goto 30;59:begin writeln(stdout);
+write(stdout,'! Omit semicolon in numeric definition');error;end;
+others:{159:}begin begin writeln(stdout);
+write(stdout,'! Improper numeric definition will be flushed');error;end;
+repeat nextcontrol:=skipahead until(nextcontrol>=132);
+if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;end;
+accumulator:=0;goto 30;end{:159}end;end;30:{:158};
+if abs(accumulator)>=1073741824 then begin begin writeln(stdout);
+write(stdout,'! Value too big: ',accumulator:1);error;end;
+accumulator:=0;end;equiv[p]:=accumulator+1073741824;end;
+{:157}{165:}procedure scanrepl(t:eightbits);label 22,30,31,21;
+var a:sixteenbits;b:ASCIIcode;bal:eightbits;begin bal:=0;
+while true do begin 22:a:=getnext;case a of 40:if t=3 then bal:=bal+1;
+41:if t=3 then if bal=0 then begin writeln(stdout);
+write(stdout,'! Extra )');error;end else bal:=bal-1;
+91:if t=4 then bal:=bal+1;
+93:if t=4 then if bal=0 then begin writeln(stdout);
+write(stdout,'! Extra ]');error;end else bal:=bal-1;
+39:{168:}begin b:=39;
+while true do begin begin if tokptr[z]=maxtoks then begin writeln(stdout
+);write(stderr,'! Sorry, ','token',' capacity exceeded');error;
+history:=3;uexit(1);end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
+end;
+if b=64 then if buffer[loc]=64 then loc:=loc+1 else begin writeln(stdout
+);write(stdout,'! You should double @ signs in strings');error;end;
+if loc=limit then begin begin writeln(stdout);
+write(stdout,'! String didn''t end');error;end;buffer[loc]:=39;
+buffer[loc+1]:=0;end;b:=buffer[loc];loc:=loc+1;
+if b=39 then begin if buffer[loc]<>39 then goto 31 else begin loc:=loc+1
+;begin if tokptr[z]=maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=39;tokptr[z]:=tokptr[z]+1;end;end;end;
+end;31:end{:168};35:if(t=3)or(t=4)then a:=0;
+{167:}130:begin a:=idlookup(0);
+begin if tokptr[z]=maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=(a div 256)+128;
+tokptr[z]:=tokptr[z]+1;end;a:=a mod 256;end;
+135:if t<>135 then goto 30 else begin begin if tokptr[z]=maxtoks then
+begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=(curmodule div 256)+168;
+tokptr[z]:=tokptr[z]+1;end;a:=curmodule mod 256;end;
+2:{169:}begin begin if tokptr[z]=maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=2;tokptr[z]:=tokptr[z]+1;end;
+buffer[limit+1]:=64;
+21:if buffer[loc]=64 then begin if loc<limit then if buffer[loc+1]=64
+then begin begin if tokptr[z]=maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=64;tokptr[z]:=tokptr[z]+1;end;
+loc:=loc+2;goto 21;end;
+end else begin begin if tokptr[z]=maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=buffer[loc];tokptr[z]:=tokptr[z]+1;
+end;loc:=loc+1;goto 21;end;if loc>=limit then begin writeln(stdout);
+write(stdout,'! Verbatim string didn''t end');error;
+end else if buffer[loc+1]<>62 then begin writeln(stdout);
+write(stdout,'! You should double @ signs in verbatim strings');error;
+end;loc:=loc+2;end{:169};
+133,132,134:if t<>135 then goto 30 else begin begin writeln(stdout);
+write(stdout,'! @',xchr[buffer[loc-1]],' is ignored in Pascal text');
+error;end;goto 22;end;136:goto 30;{:167}others:end;
+begin if tokptr[z]=maxtoks then begin writeln(stdout);
+write(stderr,'! Sorry, ','token',' capacity exceeded');error;history:=3;
+uexit(1);end;tokmem[z,tokptr[z]]:=a;tokptr[z]:=tokptr[z]+1;end;end;
+30:nextcontrol:=a;
+{166:}if bal>0 then if t=3 then begin if bal=1 then begin writeln(stdout
+);write(stdout,'! Missing )');error;end else begin writeln(stdout);
+write(stdout,'! Missing ',bal:1,' )''s');error;end;
+while bal>0 do begin begin if tokptr[z]=maxtoks then begin writeln(
+stdout);write(stderr,'! Sorry, ','token',' capacity exceeded');error;
+history:=3;uexit(1);end;tokmem[z,tokptr[z]]:=41;tokptr[z]:=tokptr[z]+1;
+end;bal:=bal-1;end;end else begin if bal=1 then begin writeln(stdout);
+write(stdout,'! Missing ]');error;end else begin writeln(stdout);
+write(stdout,'! Missing ',bal:1,' ]''s');error;end;
+while bal>0 do begin begin if tokptr[z]=maxtoks then begin writeln(
+stdout);write(stderr,'! Sorry, ','token',' capacity exceeded');error;
+history:=3;uexit(1);end;tokmem[z,tokptr[z]]:=93;tokptr[z]:=tokptr[z]+1;
+end;bal:=bal-1;end;end{:166};
+if textptr>maxtexts-5 then begin writeln(stdout);
+write(stderr,'! Sorry, ','text',' capacity exceeded');error;history:=3;
+uexit(1);end;currepltext:=textptr;tokstart[textptr+5]:=tokptr[z];
+textptr:=textptr+1;if z=4 then z:=0 else z:=z+1;end;
+{:165}{170:}procedure definemacro(t:eightbits);var p:namepointer;
+begin p:=idlookup(t);scanrepl(t);equiv[p]:=currepltext;
+textlink[currepltext]:=0;end;{:170}{172:}procedure scanmodule;
+label 22,30,10;var p:namepointer;begin modulecount:=modulecount+1;
+{173:}nextcontrol:=0;
+while true do begin 22:while nextcontrol<=132 do begin nextcontrol:=
+skipahead;if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;
+end;end;if nextcontrol<>133 then goto 30;nextcontrol:=getnext;
+if nextcontrol<>130 then begin begin writeln(stdout);
+write(stdout,'! Definition flushed, must start with ',
+'identifier of length > 1');error;end;goto 22;end;nextcontrol:=getnext;
+if nextcontrol=61 then begin scannumeric(idlookup(1));goto 22;
+end else if nextcontrol=30 then begin definemacro(2);goto 22;
+end else{174:}if nextcontrol=40 then begin nextcontrol:=getnext;
+if nextcontrol=35 then begin nextcontrol:=getnext;
+if nextcontrol=41 then begin nextcontrol:=getnext;
+if nextcontrol=61 then begin begin writeln(stdout);
+write(stdout,'! Use == for macros');error;end;nextcontrol:=30;end;
+if nextcontrol=30 then begin definemacro(3);goto 22;end;end;end;
+end else if nextcontrol=91 then begin nextcontrol:=getnext;
+if nextcontrol=35 then begin nextcontrol:=getnext;
+if nextcontrol=93 then begin nextcontrol:=getnext;
+if nextcontrol=61 then begin begin writeln(stdout);
+write(stdout,'! Use == for macros');error;end;nextcontrol:=30;end;
+if nextcontrol=30 then begin definemacro(4);goto 22;end;end;end;
+end{:174};begin writeln(stdout);
+write(stdout,'! Definition flushed since it starts badly');error;end;
+end;30:{:173};{175:}case nextcontrol of 134:p:=0;135:begin p:=curmodule;
+{176:}repeat nextcontrol:=getnext;until nextcontrol<>43;
+if(nextcontrol<>61)and(nextcontrol<>30)then begin begin writeln(stdout);
+write(stdout,'! Pascal text flushed, = sign is missing');error;end;
+repeat nextcontrol:=skipahead;until nextcontrol=136;goto 10;end{:176};
+end;others:goto 10 end;{177:}storetwobytes(53248+modulecount);{:177};
+scanrepl(135);
+{178:}if p=0 then begin textlink[lastunnamed]:=currepltext;
+lastunnamed:=currepltext;
+end else if equiv[p]=0 then equiv[p]:=currepltext else begin p:=equiv[p]
+;while textlink[p]<maxtexts do p:=textlink[p];textlink[p]:=currepltext;
+end;textlink[currepltext]:=maxtexts;{:178};{:175};10:end;
+{:172}{181:}{procedure debughelp;label 888,10;var k:integer;
+begin debugskipped:=debugskipped+1;
+if debugskipped<debugcycle then goto 10;debugskipped:=0;
+while true do begin begin writeln(stdout);write(stdout,'#');end;
+fflush(stdout);read(stdin,ddt);
+if ddt<0 then goto 10 else if ddt=0 then begin goto 888;
+888:ddt:=0;
+end else begin read(stdin,dd);case ddt of 1:printid(dd);2:printrepl(dd);
+3:for k:=1 to dd do write(stdout,xchr[buffer[k]]);
+4:for k:=1 to dd do write(stdout,xchr[modtext[k]]);
+5:for k:=1 to outptr do write(stdout,xchr[outbuf[k]]);
+6:for k:=1 to dd do write(stdout,xchr[outcontrib[k]]);
+others:write(stdout,'?')end;end;end;10:end;}
+{:181}{182:}begin initialize;{134:}openinput;line:=0;otherline:=0;
+changing:=true;primethechangebuffer;changing:=not changing;
+templine:=otherline;otherline:=line;line:=templine;limit:=0;loc:=1;
+buffer[0]:=32;inputhasended:=false;{:134};
+write(stdout,'This is TANGLE, Version 4.5');
+writeln(stdout,versionstring);{183:}phaseone:=true;modulecount:=0;
+repeat nextcontrol:=skipahead;until nextcontrol=136;
+while not inputhasended do scanmodule;
+{138:}if changelimit<>0 then begin for ii:=0 to changelimit do buffer[ii
+]:=changebuffer[ii];limit:=changelimit;changing:=true;line:=otherline;
+loc:=changelimit;begin writeln(stdout);
+write(stdout,'! Change file entry did not match');error;end;end{:138};
+phaseone:=false;{:183};{for ii:=0 to 4 do maxtokptr[ii]:=tokptr[ii];}
+{112:}if textlink[0]=0 then begin begin writeln(stdout);
+write(stdout,'! No output was specified.');end;
+if history=0 then history:=1;end else begin begin writeln(stdout);
+write(stdout,'Writing the output file');end;fflush(stdout);
+{83:}stackptr:=1;bracelevel:=0;curstate.namefield:=0;
+curstate.replfield:=textlink[0];zo:=curstate.replfield mod 5;
+curstate.bytefield:=tokstart[curstate.replfield];
+curstate.endfield:=tokstart[curstate.replfield+5];curstate.modfield:=0;
+{:83};{96:}outstate:=0;outptr:=0;breakptr:=0;semiptr:=0;outbuf[0]:=0;
+line:=1;{:96};sendtheoutput;{98:}breakptr:=outptr;semiptr:=0;
+flushbuffer;if bracelevel<>0 then begin writeln(stdout);
+write(stdout,'! Program ended at brace level ',bracelevel:1);error;end;
+{:98};begin writeln(stdout);write(stdout,'Done.');end;end{:112};
+9999:if stringptr>256 then{184:}begin begin writeln(stdout);
+write(stdout,stringptr-256:1,' strings written to string pool file.');
+end;write(pool,'*');
+for ii:=1 to 9 do begin outbuf[ii]:=poolchecksum mod 10;
+poolchecksum:=poolchecksum div 10;end;
+for ii:=9 downto 1 do write(pool,xchr[48+outbuf[ii]]);writeln(pool);
+end{:184};{[186:]begin writeln(stdout);
+write(stdout,'Memory usage statistics:');end;begin writeln(stdout);
+write(stdout,nameptr:1,' names, ',textptr:1,' replacement texts;');end;
+begin writeln(stdout);write(stdout,byteptr[0]:1);end;
+for wo:=1 to 2 do write(stdout,'+',byteptr[wo]:1);
+if phaseone then for ii:=0 to 4 do maxtokptr[ii]:=tokptr[ii];
+write(stdout,' bytes, ',maxtokptr[0]:1);
+for ii:=1 to 4 do write(stdout,'+',maxtokptr[ii]:1);
+write(stdout,' tokens.');[:186];}
+{187:}case history of 0:begin writeln(stdout);
+write(stdout,'(No errors were found.)');end;1:begin writeln(stdout);
+write(stdout,'(Did you see the warning message above?)');end;
+2:begin writeln(stdout);
+write(stdout,'(Pardon me, but I think I spotted something wrong.)');end;
+3:begin writeln(stdout);
+write(stdout,'(That was a fatal error, my friend.)');end;end{:187};
+writeln(stdout);if(history<>0)and(history<>1)then uexit(1)else uexit(0);
+end.{:182}
diff --git a/Build/source/texk/web2c/tests/allbib.aux b/Build/source/texk/web2c/tests/allbib.aux
new file mode 100644
index 00000000000..3627220ca4d
--- /dev/null
+++ b/Build/source/texk/web2c/tests/allbib.aux
@@ -0,0 +1,3 @@
+\bibdata{tugboat,texbook2,texbook3,master,texjourn,texnique}
+\bibstyle{plain}
+\citation{*}
diff --git a/Build/source/texk/web2c/tests/allbib.tex b/Build/source/texk/web2c/tests/allbib.tex
new file mode 100644
index 00000000000..fbe7502f5be
--- /dev/null
+++ b/Build/source/texk/web2c/tests/allbib.tex
@@ -0,0 +1,13 @@
+% Test many bib files and many entries.
+%
+%\ifx\undefined\eplain \input eplain \fi
+\input btxmac
+
+\let\mbox = \hbox
+
+\bibliography{tugboat,texbook2,texbook3,master,texjourn,texnique}
+\bibliographystyle{plain}
+
+\nocite{*}
+
+\end
diff --git a/Build/source/texk/web2c/tests/apalike.bst b/Build/source/texk/web2c/tests/apalike.bst
new file mode 100644
index 00000000000..dbd41afafc1
--- /dev/null
+++ b/Build/source/texk/web2c/tests/apalike.bst
@@ -0,0 +1,1101 @@
+% BibTeX `apalike' bibliography style (24-Jan-88 version)
+% Adapted from the `alpha' style, version 0.99a; for BibTeX version 0.99a.
+% Copyright (C) 1988, all rights reserved.
+% Copying of this file is allowed, provided that if you make any changes at all
+% you name it something other than `apalike.bst'.
+% This restriction helps ensure that all copies are identical.
+% Differences between this style and `alpha' are generally heralded by a `%'.
+% The file btxbst.doc has the documentation for alpha.bst.
+%
+% This style should be used with the `apalike' LaTeX style (apalike.sty).
+% \cite's come out like "(Jones, 1986)" in the text but there are no labels
+% in the bibliography, and something like "(1986)" comes out immediately
+% after the author. Author (and editor) names appear as last name, comma,
+% initials. A `year' field is required for every entry, and so is either
+% an author (or in some cases, an editor) field or a key field.
+%
+% Editorial note:
+% Many journals require a style like `apalike', but I strongly, strongly,
+% strongly recommend that you not use it if you have a choice---use something
+% like `plain' instead. Mary-Claire van Leunen (A Handbook for Scholars,
+% Knopf, 1979) argues convincingly that a style like `plain' encourages better
+% writing than one like `apalike'. Furthermore the strongest arguments for
+% using an author-date style like `apalike'---that it's "the most practical"
+% (The Chicago Manual of Style, University of Chicago Press, thirteenth
+% edition, 1982, pages 400--401)---fall flat on their face with the new
+% computer-typesetting technology. For instance page 401 anachronistically
+% states "The chief disadvantage of [a style like `plain'] is that additions
+% or deletions cannot be made after the manuscript is typed without changing
+% numbers in both text references and list." LaTeX sidesteps the disadvantage.
+%
+% History:
+% 15-sep-86 (SK,OP) Original version, by Susan King and Oren Patashnik.
+% 10-nov-86 (OP) Truncated the sort.key$ string to the correct length
+% in bib.sort.order to eliminate error message.
+% 24-jan-88 (OP) Updated for BibTeX version 0.99a, from alpha.bst 0.99a;
+% apalike now sorts by author, then year, then title;
+% THIS `apalike' VERSION DOES NOT WORK WITH BIBTEX 0.98i.
+
+ENTRY
+ { address
+ author
+ booktitle
+ chapter
+ edition
+ editor
+ howpublished
+ institution
+ journal
+ key
+% month not used in apalike
+ note
+ number
+ organization
+ pages
+ publisher
+ school
+ series
+ title
+ type
+ volume
+ year
+ }
+ {}
+ { label extra.label sort.label }
+
+INTEGERS { output.state before.all mid.sentence after.sentence after.block }
+
+FUNCTION {init.state.consts}
+{ #0 'before.all :=
+ #1 'mid.sentence :=
+ #2 'after.sentence :=
+ #3 'after.block :=
+}
+
+STRINGS { s t }
+
+FUNCTION {output.nonnull}
+{ 's :=
+ output.state mid.sentence =
+ { ", " * write$ }
+ { output.state after.block =
+ { add.period$ write$
+ newline$
+ "\newblock " write$
+ }
+ { output.state before.all =
+ 'write$
+ { add.period$ " " * write$ }
+ if$
+ }
+ if$
+ mid.sentence 'output.state :=
+ }
+ if$
+ s
+}
+
+FUNCTION {output}
+{ duplicate$ empty$
+ 'pop$
+ 'output.nonnull
+ if$
+}
+
+FUNCTION {output.check}
+{ 't :=
+ duplicate$ empty$
+ { pop$ "empty " t * " in " * cite$ * warning$ }
+ 'output.nonnull
+ if$
+}
+
+% apalike needs this function because
+% the year has special punctuation;
+% apalike ignores the month
+FUNCTION {output.year.check}
+{ year empty$
+ { "empty year in " cite$ * warning$ }
+ { write$
+ " (" year * extra.label * ")" *
+ mid.sentence 'output.state :=
+ }
+ if$
+}
+
+FUNCTION {output.bibitem}
+{ newline$
+ "\bibitem[" write$
+ label write$
+ "]{" write$
+ cite$ write$
+ "}" write$
+ newline$
+ ""
+ before.all 'output.state :=
+}
+
+FUNCTION {fin.entry}
+{ add.period$
+ write$
+ newline$
+}
+
+FUNCTION {new.block}
+{ output.state before.all =
+ 'skip$
+ { after.block 'output.state := }
+ if$
+}
+
+FUNCTION {new.sentence}
+{ output.state after.block =
+ 'skip$
+ { output.state before.all =
+ 'skip$
+ { after.sentence 'output.state := }
+ if$
+ }
+ if$
+}
+
+FUNCTION {not}
+{ { #0 }
+ { #1 }
+ if$
+}
+
+FUNCTION {and}
+{ 'skip$
+ { pop$ #0 }
+ if$
+}
+
+FUNCTION {or}
+{ { pop$ #1 }
+ 'skip$
+ if$
+}
+
+FUNCTION {new.block.checkb}
+{ empty$
+ swap$ empty$
+ and
+ 'skip$
+ 'new.block
+ if$
+}
+
+FUNCTION {field.or.null}
+{ duplicate$ empty$
+ { pop$ "" }
+ 'skip$
+ if$
+}
+
+FUNCTION {emphasize}
+{ duplicate$ empty$
+ { pop$ "" }
+ { "{\em " swap$ * "}" * }
+ if$
+}
+
+INTEGERS { nameptr namesleft numnames }
+
+FUNCTION {format.names}
+{ 's :=
+ #1 'nameptr :=
+ s num.names$ 'numnames :=
+ numnames 'namesleft :=
+ { namesleft #0 > }
+ { s nameptr "{vv~}{ll}{, jj}{, f.}" format.name$ 't := % last name first
+ nameptr #1 >
+ { namesleft #1 >
+ { ", " * t * }
+ { numnames #2 >
+ { "," * }
+ 'skip$
+ if$
+ t "others" =
+ { " et~al." * }
+ { " and " * t * }
+ if$
+ }
+ if$
+ }
+ 't
+ if$
+ nameptr #1 + 'nameptr :=
+ namesleft #1 - 'namesleft :=
+ }
+ while$
+}
+
+FUNCTION {format.authors}
+{ author empty$
+ { "" }
+ { author format.names }
+ if$
+}
+
+FUNCTION {format.key} % this function is just for apalike
+{ empty$
+ { key field.or.null }
+ { "" }
+ if$
+}
+
+FUNCTION {format.editors}
+{ editor empty$
+ { "" }
+ { editor format.names
+ editor num.names$ #1 >
+ { ", editors" * }
+ { ", editor" * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.title}
+{ title empty$
+ { "" }
+ { title "t" change.case$ }
+ if$
+}
+
+FUNCTION {n.dashify}
+{ 't :=
+ ""
+ { t empty$ not }
+ { t #1 #1 substring$ "-" =
+ { t #1 #2 substring$ "--" = not
+ { "--" *
+ t #2 global.max$ substring$ 't :=
+ }
+ { { t #1 #1 substring$ "-" = }
+ { "-" *
+ t #2 global.max$ substring$ 't :=
+ }
+ while$
+ }
+ if$
+ }
+ { t #1 #1 substring$ *
+ t #2 global.max$ substring$ 't :=
+ }
+ if$
+ }
+ while$
+}
+
+FUNCTION {format.btitle}
+{ title emphasize
+}
+
+FUNCTION {tie.or.space.connect}
+{ duplicate$ text.length$ #3 <
+ { "~" }
+ { " " }
+ if$
+ swap$ * *
+}
+
+FUNCTION {either.or.check}
+{ empty$
+ 'pop$
+ { "can't use both " swap$ * " fields in " * cite$ * warning$ }
+ if$
+}
+
+FUNCTION {format.bvolume}
+{ volume empty$
+ { "" }
+ { "volume" volume tie.or.space.connect
+ series empty$
+ 'skip$
+ { " of " * series emphasize * }
+ if$
+ "volume and number" number either.or.check
+ }
+ if$
+}
+
+FUNCTION {format.number.series}
+{ volume empty$
+ { number empty$
+ { series field.or.null }
+ { output.state mid.sentence =
+ { "number" }
+ { "Number" }
+ if$
+ number tie.or.space.connect
+ series empty$
+ { "there's a number but no series in " cite$ * warning$ }
+ { " in " * series * }
+ if$
+ }
+ if$
+ }
+ { "" }
+ if$
+}
+
+FUNCTION {format.edition}
+{ edition empty$
+ { "" }
+ { output.state mid.sentence =
+ { edition "l" change.case$ " edition" * }
+ { edition "t" change.case$ " edition" * }
+ if$
+ }
+ if$
+}
+
+INTEGERS { multiresult }
+
+FUNCTION {multi.page.check}
+{ 't :=
+ #0 'multiresult :=
+ { multiresult not
+ t empty$ not
+ and
+ }
+ { t #1 #1 substring$
+ duplicate$ "-" =
+ swap$ duplicate$ "," =
+ swap$ "+" =
+ or or
+ { #1 'multiresult := }
+ { t #2 global.max$ substring$ 't := }
+ if$
+ }
+ while$
+ multiresult
+}
+
+FUNCTION {format.pages}
+{ pages empty$
+ { "" }
+ { pages multi.page.check
+ { "pages" pages n.dashify tie.or.space.connect }
+ { "page" pages tie.or.space.connect }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.vol.num.pages}
+{ volume field.or.null
+ number empty$
+ 'skip$
+ { "(" number * ")" * *
+ volume empty$
+ { "there's a number but no volume in " cite$ * warning$ }
+ 'skip$
+ if$
+ }
+ if$
+ pages empty$
+ 'skip$
+ { duplicate$ empty$
+ { pop$ format.pages }
+ { ":" * pages n.dashify * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.chapter.pages}
+{ chapter empty$
+ 'format.pages
+ { type empty$
+ { "chapter" }
+ { type "l" change.case$ }
+ if$
+ chapter tie.or.space.connect
+ pages empty$
+ 'skip$
+ { ", " * format.pages * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.in.ed.booktitle}
+{ booktitle empty$
+ { "" }
+ { editor empty$
+ { "In " booktitle emphasize * }
+ { "In " format.editors * ", " * booktitle emphasize * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.thesis.type}
+{ type empty$
+ 'skip$
+ { pop$
+ type "t" change.case$
+ }
+ if$
+}
+
+FUNCTION {format.tr.number}
+{ type empty$
+ { "Technical Report" }
+ 'type
+ if$
+ number empty$
+ { "t" change.case$ }
+ { number tie.or.space.connect }
+ if$
+}
+
+FUNCTION {format.article.crossref}
+{ "In" % this is for apalike
+ " \cite{" * crossref * "}" *
+}
+
+FUNCTION {format.book.crossref}
+{ volume empty$
+ { "empty volume in " cite$ * "'s crossref of " * crossref * warning$
+ "In "
+ }
+ { "Volume" volume tie.or.space.connect
+ " of " *
+ }
+ if$
+ "\cite{" * crossref * "}" * % this is for apalike
+}
+
+FUNCTION {format.incoll.inproc.crossref}
+{ "In" % this is for apalike
+ " \cite{" * crossref * "}" *
+}
+
+FUNCTION {article}
+{ output.bibitem
+ format.authors "author" output.check
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.title "title" output.check
+ new.block
+ crossref missing$
+ { journal emphasize "journal" output.check
+ format.vol.num.pages output
+ }
+ { format.article.crossref output.nonnull
+ format.pages output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {book}
+{ output.bibitem
+ author empty$
+ { format.editors "author and editor" output.check
+ editor format.key output
+ }
+ { format.authors output.nonnull
+ crossref missing$
+ { "author and editor" editor either.or.check }
+ 'skip$
+ if$
+ }
+ if$
+ output.year.check % special for apalike
+ new.block
+ format.btitle "title" output.check
+ crossref missing$
+ { format.bvolume output
+ new.block
+ format.number.series output
+ new.sentence
+ publisher "publisher" output.check
+ address output
+ }
+ { new.block
+ format.book.crossref output.nonnull
+ }
+ if$
+ format.edition output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {booklet}
+{ output.bibitem
+ format.authors output
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.title "title" output.check
+ new.block
+ howpublished output
+ address output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {inbook}
+{ output.bibitem
+ author empty$
+ { format.editors "author and editor" output.check
+ editor format.key output
+ }
+ { format.authors output.nonnull
+ crossref missing$
+ { "author and editor" editor either.or.check }
+ 'skip$
+ if$
+ }
+ if$
+ output.year.check % special for apalike
+ new.block
+ format.btitle "title" output.check
+ crossref missing$
+ { format.bvolume output
+ format.chapter.pages "chapter and pages" output.check
+ new.block
+ format.number.series output
+ new.sentence
+ publisher "publisher" output.check
+ address output
+ }
+ { format.chapter.pages "chapter and pages" output.check
+ new.block
+ format.book.crossref output.nonnull
+ }
+ if$
+ format.edition output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {incollection}
+{ output.bibitem
+ format.authors "author" output.check
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.title "title" output.check
+ new.block
+ crossref missing$
+ { format.in.ed.booktitle "booktitle" output.check
+ format.bvolume output
+ format.number.series output
+ format.chapter.pages output
+ new.sentence
+ publisher "publisher" output.check
+ address output
+ format.edition output
+ }
+ { format.incoll.inproc.crossref output.nonnull
+ format.chapter.pages output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {inproceedings}
+{ output.bibitem
+ format.authors "author" output.check
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.title "title" output.check
+ new.block
+ crossref missing$
+ { format.in.ed.booktitle "booktitle" output.check
+ format.bvolume output
+ format.number.series output
+ format.pages output
+ address output % for apalike
+ new.sentence % there's no year
+ organization output % here so things
+ publisher output % are simpler
+ }
+ { format.incoll.inproc.crossref output.nonnull
+ format.pages output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {conference} { inproceedings }
+
+FUNCTION {manual}
+{ output.bibitem
+ format.authors output
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.btitle "title" output.check
+ organization address new.block.checkb
+ organization output
+ address output
+ format.edition output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {mastersthesis}
+{ output.bibitem
+ format.authors "author" output.check
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.title "title" output.check
+ new.block
+ "Master's thesis" format.thesis.type output.nonnull
+ school "school" output.check
+ address output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {misc}
+{ output.bibitem
+ format.authors output
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.title output
+ new.block
+ howpublished output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {phdthesis}
+{ output.bibitem
+ format.authors "author" output.check
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.btitle "title" output.check
+ new.block
+ "PhD thesis" format.thesis.type output.nonnull
+ school "school" output.check
+ address output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {proceedings}
+{ output.bibitem
+ format.editors output
+ editor format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.btitle "title" output.check
+ format.bvolume output
+ format.number.series output
+ address output % for apalike
+ new.sentence % we always output
+ organization output % a nonempty organization
+ publisher output % here
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {techreport}
+{ output.bibitem
+ format.authors "author" output.check
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.title "title" output.check
+ new.block
+ format.tr.number output.nonnull
+ institution "institution" output.check
+ address output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {unpublished}
+{ output.bibitem
+ format.authors "author" output.check
+ author format.key output % special for
+ output.year.check % apalike
+ new.block
+ format.title "title" output.check
+ new.block
+ note "note" output.check
+ fin.entry
+}
+
+FUNCTION {default.type} { misc }
+
+MACRO {jan} {"January"}
+
+MACRO {feb} {"February"}
+
+MACRO {mar} {"March"}
+
+MACRO {apr} {"April"}
+
+MACRO {may} {"May"}
+
+MACRO {jun} {"June"}
+
+MACRO {jul} {"July"}
+
+MACRO {aug} {"August"}
+
+MACRO {sep} {"September"}
+
+MACRO {oct} {"October"}
+
+MACRO {nov} {"November"}
+
+MACRO {dec} {"December"}
+
+MACRO {acmcs} {"ACM Computing Surveys"}
+
+MACRO {acta} {"Acta Informatica"}
+
+MACRO {cacm} {"Communications of the ACM"}
+
+MACRO {ibmjrd} {"IBM Journal of Research and Development"}
+
+MACRO {ibmsj} {"IBM Systems Journal"}
+
+MACRO {ieeese} {"IEEE Transactions on Software Engineering"}
+
+MACRO {ieeetc} {"IEEE Transactions on Computers"}
+
+MACRO {ieeetcad}
+ {"IEEE Transactions on Computer-Aided Design of Integrated Circuits"}
+
+MACRO {ipl} {"Information Processing Letters"}
+
+MACRO {jacm} {"Journal of the ACM"}
+
+MACRO {jcss} {"Journal of Computer and System Sciences"}
+
+MACRO {scp} {"Science of Computer Programming"}
+
+MACRO {sicomp} {"SIAM Journal on Computing"}
+
+MACRO {tocs} {"ACM Transactions on Computer Systems"}
+
+MACRO {tods} {"ACM Transactions on Database Systems"}
+
+MACRO {tog} {"ACM Transactions on Graphics"}
+
+MACRO {toms} {"ACM Transactions on Mathematical Software"}
+
+MACRO {toois} {"ACM Transactions on Office Information Systems"}
+
+MACRO {toplas} {"ACM Transactions on Programming Languages and Systems"}
+
+MACRO {tcs} {"Theoretical Computer Science"}
+
+READ
+
+FUNCTION {sortify}
+{ purify$
+ "l" change.case$
+}
+
+INTEGERS { len }
+
+FUNCTION {chop.word}
+{ 's :=
+ 'len :=
+ s #1 len substring$ =
+ { s len #1 + global.max$ substring$ }
+ 's
+ if$
+}
+
+% There are three apalike cases: one person (Jones),
+% two (Jones and de~Bruijn), and more (Jones et~al.).
+% This function is much like format.crossref.editors.
+%
+FUNCTION {format.lab.names}
+{ 's :=
+ s #1 "{vv~}{ll}" format.name$
+ s num.names$ duplicate$
+ #2 >
+ { pop$ " et~al." * }
+ { #2 <
+ 'skip$
+ { s #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" =
+ { " et~al." * }
+ { " and " * s #2 "{vv~}{ll}" format.name$ * }
+ if$
+ }
+ if$
+ }
+ if$
+}
+
+FUNCTION {author.key.label}
+{ author empty$
+ { key empty$
+ { cite$ #1 #3 substring$ }
+ 'key % apalike uses the whole key
+ if$
+ }
+ { author format.lab.names }
+ if$
+}
+
+FUNCTION {author.editor.key.label}
+{ author empty$
+ { editor empty$
+ { key empty$
+ { cite$ #1 #3 substring$ }
+ 'key % apalike uses the whole key
+ if$
+ }
+ { editor format.lab.names }
+ if$
+ }
+ { author format.lab.names }
+ if$
+}
+
+FUNCTION {editor.key.label}
+{ editor empty$
+ { key empty$
+ { cite$ #1 #3 substring$ }
+ 'key % apalike uses the whole key, no organization
+ if$
+ }
+ { editor format.lab.names }
+ if$
+}
+
+FUNCTION {calc.label}
+{ type$ "book" =
+ type$ "inbook" =
+ or
+ 'author.editor.key.label
+ { type$ "proceedings" =
+ 'editor.key.label % apalike ignores organization
+ 'author.key.label % for labeling and sorting
+ if$
+ }
+ if$
+ ", " % these three lines are
+ * % for apalike, which
+ year field.or.null purify$ #-1 #4 substring$ % uses all four digits
+ *
+ 'label :=
+}
+
+FUNCTION {sort.format.names}
+{ 's :=
+ #1 'nameptr :=
+ ""
+ s num.names$ 'numnames :=
+ numnames 'namesleft :=
+ { namesleft #0 > }
+ { nameptr #1 >
+ { " " * }
+ 'skip$
+ if$ % apalike uses initials
+ s nameptr "{vv{ } }{ll{ }}{ f{ }}{ jj{ }}" format.name$ 't := % <= here
+ nameptr numnames = t "others" = and
+ { "et al" * }
+ { t sortify * }
+ if$
+ nameptr #1 + 'nameptr :=
+ namesleft #1 - 'namesleft :=
+ }
+ while$
+}
+
+FUNCTION {sort.format.title}
+{ 't :=
+ "A " #2
+ "An " #3
+ "The " #4 t chop.word
+ chop.word
+ chop.word
+ sortify
+ #1 global.max$ substring$
+}
+
+FUNCTION {author.sort}
+{ author empty$
+ { key empty$
+ { "to sort, need author or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { author sort.format.names }
+ if$
+}
+
+FUNCTION {author.editor.sort}
+{ author empty$
+ { editor empty$
+ { key empty$
+ { "to sort, need author, editor, or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { editor sort.format.names }
+ if$
+ }
+ { author sort.format.names }
+ if$
+}
+
+FUNCTION {editor.sort}
+{ editor empty$
+ { key empty$
+ { "to sort, need editor or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { editor sort.format.names }
+ if$
+}
+
+% apalike uses two sorting passes; the first one sets the
+% labels so that the `a's, `b's, etc. can be computed;
+% the second pass puts the references in "correct" order.
+% The presort function is for the first pass. It computes
+% label, sort.label, and title, and then concatenates.
+FUNCTION {presort}
+{ calc.label
+ label sortify
+ " "
+ *
+ type$ "book" =
+ type$ "inbook" =
+ or
+ 'author.editor.sort
+ { type$ "proceedings" =
+ 'editor.sort
+ 'author.sort
+ if$
+ }
+ if$
+ #1 entry.max$ substring$ % for
+ 'sort.label := % apalike
+ sort.label % style
+ *
+ " "
+ *
+ title field.or.null
+ sort.format.title
+ *
+ #1 entry.max$ substring$
+ 'sort.key$ :=
+}
+
+ITERATE {presort}
+
+SORT % by label, sort.label, title---for final label calculation
+
+STRINGS { last.label next.extra } % apalike labels are only for the text;
+
+INTEGERS { last.extra.num } % there are none in the bibliography
+
+FUNCTION {initialize.extra.label.stuff} % and hence there is no `longest.label'
+{ #0 int.to.chr$ 'last.label :=
+ "" 'next.extra :=
+ #0 'last.extra.num :=
+}
+
+FUNCTION {forward.pass}
+{ last.label label =
+ { last.extra.num #1 + 'last.extra.num :=
+ last.extra.num int.to.chr$ 'extra.label :=
+ }
+ { "a" chr.to.int$ 'last.extra.num :=
+ "" 'extra.label :=
+ label 'last.label :=
+ }
+ if$
+}
+
+FUNCTION {reverse.pass}
+{ next.extra "b" =
+ { "a" 'extra.label := }
+ 'skip$
+ if$
+ label extra.label * 'label :=
+ extra.label 'next.extra :=
+}
+
+EXECUTE {initialize.extra.label.stuff}
+
+ITERATE {forward.pass}
+
+REVERSE {reverse.pass}
+
+% Now that the label is right we sort for real,
+% on sort.label then year then title. This is
+% for the second sorting pass.
+FUNCTION {bib.sort.order}
+{ sort.label
+ " "
+ *
+ year field.or.null sortify
+ *
+ " "
+ *
+ title field.or.null
+ sort.format.title
+ *
+ #1 entry.max$ substring$
+ 'sort.key$ :=
+}
+
+ITERATE {bib.sort.order}
+
+SORT % by sort.label, year, title---giving final bibliography order
+
+FUNCTION {begin.bib}
+{ preamble$ empty$ % no \etalchar in apalike
+ 'skip$
+ { preamble$ write$ newline$ }
+ if$
+ "\begin{thebibliography}{}" write$ newline$ % no labels in apalike
+}
+
+EXECUTE {begin.bib}
+
+EXECUTE {init.state.consts}
+
+ITERATE {call.type$}
+
+FUNCTION {end.bib}
+{ newline$
+ "\end{thebibliography}" write$ newline$
+}
+
+EXECUTE {end.bib}
diff --git a/Build/source/texk/web2c/tests/batch.tex b/Build/source/texk/web2c/tests/batch.tex
new file mode 100644
index 00000000000..b2492af8e8a
--- /dev/null
+++ b/Build/source/texk/web2c/tests/batch.tex
@@ -0,0 +1,10 @@
+% This test should give no output on the terminal.
+\batchmode
+\font\test=xxx
+\errorstopmode
+\ifx\test=\nullfont
+% font not found
+\else
+% font found
+\fi
+\bye
diff --git a/Build/source/texk/web2c/tests/check.log b/Build/source/texk/web2c/tests/check.log
new file mode 100644
index 00000000000..c20f7caea3d
--- /dev/null
+++ b/Build/source/texk/web2c/tests/check.log
@@ -0,0 +1,1685 @@
+make[1]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c'
+cd ../kpathsea && make -w CC='gcc' CFLAGS='-g '
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/kpathsea'
+make[2]: Nothing to be done for `default'.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/kpathsea'
+cd lib && make -w CC='gcc' CFLAGS='-g ' LDFLAGS=''
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+make[2]: Nothing to be done for `default'.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' fixwrites
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `fixwrites' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' splitup
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `splitup' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' web2c
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `web2c' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+test -f tests/exampl.aux || \
+ cp ./tests/exampl.aux tests/exampl.aux
+TEXMFCNF=../kpathsea \
+ BSTINPUTS=./tests \
+ BIBINPUTS=./tests \
+ ./bibtex tests/exampl
+This is BibTeX, Version 0.99c (Web2C 7.5.5)
+The top-level auxiliary file: tests/exampl.aux
+The style file: apalike.bst
+Database file #1: xampl.bib
+Warning--empty author in whole-journal
+Warning--empty title in whole-journal
+Warning--empty year in booklet-minimal
+Warning--empty year in manual-minimal
+Warning--empty year in misc-minimal
+Warning--empty year in unpublished-minimal
+Warning--empty year in random-note-crossref
+(There were 7 warnings)
+CWEBINPUTS=./cwebdir ./cweave common.w
+This is CWEAVE, Version 3.64 (Web2C 7.5.5)
+*1*5*7*27*56*67*77*82
+Writing the output file...*1*5*7*27*56*67*77*82
+Writing the index...
+Done.
+(No errors were found.)
+TEXMFCNF=../kpathsea \
+ ./dvicopy ./tests/story tests/xstory.dvi
+This is DVIcopy, Version 1.5 (Web2C 7.5.5)
+Copyright (C) 1990,95 Peter Breitenlohner
+Distributed under terms of GNU General Public License
+DVI file: ' TeX output 1992.05.17:0844',
+ num=25400000, den=473628672, mag=1000.
+DVI: font 33 = cmsl10.
+DVI: font 23 = cmbx10.
+DVI: font 0 = cmr10.
+DVI: processing page 1.
+DVI: font 23 = cmbx10.
+TFM: font 1 = cmbx10.
+OUT: font 1 = cmbx10.
+DVI: font 33 = cmsl10.
+TFM: font 0 = cmsl10.
+OUT: font 0 = cmsl10.
+DVI: font 0 = cmr10.
+TFM: font 2 = cmr10.
+OUT: font 2 = cmr10.
+OUT file: 692 bytes, 1 page written.
+(No errors were found.)
+(TFMFONTS=./tests VFFONTS=./tests ./dvicopy \
+ <./tests/pplr.dvi \
+ >tests/xpplr.dvi) 2>&1
+This is DVIcopy, Version 1.5 (Web2C 7.5.5)
+Copyright (C) 1990,95 Peter Breitenlohner
+Distributed under terms of GNU General Public License
+DVI file: ' TeX output 1995.05.27:1708',
+ num=25400000, den=473628672, mag=1000.
+DVI: font 50 = pplr.
+DVI: font 36 = cmti10.
+DVI: font 31 = cmtt8.
+DVI: font 29 = cmtt10.
+DVI: font 3 = cmr7.
+DVI: font 0 = cmr10.
+DVI: processing page 1.
+DVI: font 3 = cmr7.
+TFM: font 4 = cmr7.
+OUT: font 4 = cmr7.
+DVI: font 31 = cmtt8.
+TFM: font 2 = cmtt8.
+OUT: font 2 = cmtt8.
+DVI: font 0 = cmr10.
+TFM: font 5 = cmr10.
+OUT: font 5 = cmr10.
+DVI: font 36 = cmti10.
+TFM: font 1 = cmti10.
+OUT: font 1 = cmti10.
+DVI: font 29 = cmtt10.
+TFM: font 3 = cmtt10.
+OUT: font 3 = cmtt10.
+DVI: font 50 = pplr.
+TFM: font 0 = pplr.
+OUT: font 0 = pplr.
+OUT file: 10540 bytes, 1 page written.
+(No errors were found.)
+TEXMFCNF=../kpathsea \
+ ./dvitomp ./tests/story.dvi tests/xstory.mpx
+TFMFONTS=./tests VFFONTS=./tests: \
+ ./dvitomp ./tests/ptmr
+mv ptmr.mpx tests/xptmr.mpx
+./dvitype -show-opcodes ./tests/story >tests/xstory.dvityp
+./dvitype --p=\*.\*.2 ./tests/pagenum.dvi >tests/xpagenum.typ
+TFMFONTS=./tests ./gftodvi -verbose \
+ ./tests/cmr10.600gf
+This is GFtoDVI, Version 3.0 (Web2C 7.5.5)
+[1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [11] [12] [13]
+[14] [15] [16] [17] [18] [19] [20] [21] [22] [23] [24] [25] [26]
+[27] [28] [29] [30] [31] [32] [33] [34] [35] [36] [37] [38] [39]
+[40] [41] [42] [43] [44] [45] [46] [47] [48] [49] [50] [51] [52]
+[53] [54] [55] [56] [57] [58] [59] [60] [61] [62] [63] [64] [65]
+[66] [67] [68] [69] [70] [71] [72] [73] [74] [75] [76] [77] [78]
+[79] [80] [81] [82] [83] [84] [85] [86] [87] [88] [89] [90] [91]
+[92] [93] [94] [95] [96] [97] [98] [99] [100] [101] [102] [103] [104]
+[105] [106] [107] [108] [109] [110] [111] [112] [113] [114] [115] [116] [117]
+[118] [119] [120] [121] [122] [123] [124] [125] [126] [127] [128]
+mv cmr10.dvi tests/xcmr10.dvi
+./gftopk -verbose ./tests/cmr10.600gf tests/xcmr10.pk
+This is GFtoPK, Version 2.3 (Web2C 7.5.5)
+'METAFONT output 1993.11.11:0921'
+24148 bytes packed to 11048 bytes.
+./gftopk ./tests/cmr10.600gf cmr10.pk && rm cmr10.pk
+./gftype ./tests/cmr10.600gf >tests/xcmr10.gft1
+./gftype -m -i ./tests/cmr10.600gf >tests/xcmr10.gft2
+./mft ./tests/io; mv io.tex tests/io.tex
+This is MFT, Version 2.0 (Web2C 7.5.5)
+
+(No errors were found.)
+./patgen ./tests/dict ./tests/patterns tests/xpatout \
+ ./tests/translate <./tests/patgen.in
+This is PATGEN, Version 2.3 (Web2C 7.5.5)
+left_hyphen_min = 2, right_hyphen_min = 2, 30 letters
+14 patterns read in
+pattern trie has 285 nodes, trie_max = 308, 5 outputs
+hyph_start, hyph_finish: Specify 1<=hyph_start,hyph_finish<=9 !
+hyph_start, hyph_finish: Specify 1<=hyph_start,hyph_finish<=9 !
+hyph_start, hyph_finish: Specify 1<=hyph_start,hyph_finish<=9 !
+hyph_start, hyph_finish: Specify 1<=hyph_start,hyph_finish<=9 !
+hyph_start, hyph_finish: pat_start, pat_finish: Specify 1<=pat_start<=pat_finish<=15 !
+pat_start, pat_finish: Specify 1<=pat_start<=pat_finish<=15 !
+pat_start, pat_finish: Specify 1<=pat_start<=pat_finish<=15 !
+pat_start, pat_finish: good weight, bad weight, threshold: Specify good weight, bad weight, threshold>=1 !
+good weight, bad weight, threshold: Specify good weight, bad weight, threshold>=1 !
+good weight, bad weight, threshold: Specify good weight, bad weight, threshold>=1 !
+good weight, bad weight, threshold: processing dictionary with pat_len = 2, pat_dot = 1
+
+31 good, 1 bad, 10 missed
+75.61 %, 2.44 %, 24.39 %
+32 patterns, 288 nodes in count trie, triec_max = 324
+1 good and 30 bad patterns added (more to come)
+finding 4 good and 0 bad hyphens, efficiency = 4.00
+pattern trie has 313 nodes, trie_max = 325, 10 outputs
+processing dictionary with pat_len = 2, pat_dot = 0
+
+35 good, 1 bad, 6 missed
+85.37 %, 2.44 %, 14.63 %
+28 patterns, 284 nodes in count trie, triec_max = 296
+0 good and 27 bad patterns added (more to come)
+finding 0 good and 0 bad hyphens
+pattern trie has 320 nodes, trie_max = 336, 16 outputs
+processing dictionary with pat_len = 2, pat_dot = 2
+
+35 good, 1 bad, 6 missed
+85.37 %, 2.44 %, 14.63 %
+38 patterns, 294 nodes in count trie, triec_max = 302
+0 good and 32 bad patterns added (more to come)
+finding 0 good and 0 bad hyphens
+pattern trie has 330 nodes, trie_max = 346, 22 outputs
+processing dictionary with pat_len = 3, pat_dot = 1
+
+35 good, 1 bad, 6 missed
+85.37 %, 2.44 %, 14.63 %
+1 patterns, 258 nodes in count trie, triec_max = 258
+0 good and 0 bad patterns added (more to come)
+finding 0 good and 0 bad hyphens
+pattern trie has 330 nodes, trie_max = 346, 22 outputs
+processing dictionary with pat_len = 3, pat_dot = 2
+
+35 good, 1 bad, 6 missed
+85.37 %, 2.44 %, 14.63 %
+6 patterns, 268 nodes in count trie, triec_max = 274
+0 good and 0 bad patterns added (more to come)
+finding 0 good and 0 bad hyphens
+pattern trie has 330 nodes, trie_max = 346, 22 outputs
+processing dictionary with pat_len = 3, pat_dot = 0
+
+35 good, 1 bad, 6 missed
+85.37 %, 2.44 %, 14.63 %
+3 patterns, 260 nodes in count trie, triec_max = 278
+2 good and 1 bad patterns added
+finding 6 good and 1 bad hyphens, efficiency = 2.00
+pattern trie has 333 nodes, trie_max = 346, 23 outputs
+processing dictionary with pat_len = 3, pat_dot = 3
+
+41 good, 2 bad, 0 missed
+100.00 %, 4.88 %, 0.00 %
+6 patterns, 268 nodes in count trie, triec_max = 268
+0 good and 6 bad patterns added
+finding 0 good and 0 bad hyphens
+pattern trie has 339 nodes, trie_max = 346, 24 outputs
+51 nodes and 17 outputs deleted
+total of 3 patterns at hyph_level 3
+
+pat_start, pat_finish: good weight, bad weight, threshold: processing dictionary with pat_len = 2, pat_dot = 1
+
+41 good, 2 bad, 0 missed
+100.00 %, 4.88 %, 0.00 %
+12 patterns, 268 nodes in count trie, triec_max = 269
+1 good and 10 bad patterns added (more to come)
+finding 1 good and 0 bad hyphens, efficiency = 1.00
+pattern trie has 289 nodes, trie_max = 346, 11 outputs
+processing dictionary with pat_len = 2, pat_dot = 0
+
+41 good, 1 bad, 0 missed
+100.00 %, 2.44 %, 0.00 %
+14 patterns, 270 nodes in count trie, triec_max = 300
+0 good and 13 bad patterns added (more to come)
+finding 0 good and 0 bad hyphens
+pattern trie has 299 nodes, trie_max = 346, 14 outputs
+processing dictionary with pat_len = 2, pat_dot = 2
+
+41 good, 1 bad, 0 missed
+100.00 %, 2.44 %, 0.00 %
+21 patterns, 277 nodes in count trie, triec_max = 280
+0 good and 20 bad patterns added (more to come)
+finding 0 good and 0 bad hyphens
+pattern trie has 312 nodes, trie_max = 346, 20 outputs
+processing dictionary with pat_len = 3, pat_dot = 1
+
+41 good, 1 bad, 0 missed
+100.00 %, 2.44 %, 0.00 %
+1 patterns, 258 nodes in count trie, triec_max = 258
+0 good and 0 bad patterns added (more to come)
+finding 0 good and 0 bad hyphens
+pattern trie has 312 nodes, trie_max = 346, 20 outputs
+processing dictionary with pat_len = 3, pat_dot = 2
+
+41 good, 1 bad, 0 missed
+100.00 %, 2.44 %, 0.00 %
+1 patterns, 258 nodes in count trie, triec_max = 259
+0 good and 0 bad patterns added (more to come)
+finding 0 good and 0 bad hyphens
+pattern trie has 312 nodes, trie_max = 346, 20 outputs
+processing dictionary with pat_len = 3, pat_dot = 0
+
+41 good, 1 bad, 0 missed
+100.00 %, 2.44 %, 0.00 %
+2 patterns, 259 nodes in count trie, triec_max = 278
+0 good and 1 bad patterns added (more to come)
+finding 0 good and 0 bad hyphens
+pattern trie has 312 nodes, trie_max = 346, 21 outputs
+processing dictionary with pat_len = 3, pat_dot = 3
+
+41 good, 1 bad, 0 missed
+100.00 %, 2.44 %, 0.00 %
+2 patterns, 260 nodes in count trie, triec_max = 260
+1 good and 1 bad patterns added
+finding 1 good and 0 bad hyphens, efficiency = 1.00
+pattern trie has 314 nodes, trie_max = 347, 23 outputs
+26 nodes and 14 outputs deleted
+total of 2 patterns at hyph_level 4
+hyphenate word list? writing pattmp.4
+
+41 good, 0 bad, 0 missed
+100.00 %, 0.00 %, 0.00 %
+./pktogf -verbose ./tests/cmr10.pk tests/xcmr10.600gf
+This is PKtoGF, Version 1.1
+{METAFONT output 1993.11.11:0921}
+11048 bytes unpacked to 24148 bytes.
+./pktogf ./tests/cmr10.pk && rm cmr10.gf
+./pktype ./tests/cmr10.pk >tests/xcmr10.pktyp
+./pltotf -verbose ./tests/cmr10 tests/xcmr10
+This is PLtoTF, Version 3.5 (Web2C 7.5.5)
+'000 '001 '002 '003 '004 '005 '006 '007
+'010 '011 '012 '013 '014 '015 '016 '017
+'020 '021 '022 '023 '024 '025 '026 '027
+'030 '031 '032 '033 '034 '035 '036 '037
+'040 '041 '042 '043 '044 '045 '046 '047
+'050 '051 '052 '053 '054 '055 '056 '057
+'060 '061 '062 '063 '064 '065 '066 '067
+'070 '071 '072 '073 '074 '075 '076 '077
+'100 '101 '102 '103 '104 '105 '106 '107
+'110 '111 '112 '113 '114 '115 '116 '117
+'120 '121 '122 '123 '124 '125 '126 '127
+'130 '131 '132 '133 '134 '135 '136 '137
+'140 '141 '142 '143 '144 '145 '146 '147
+'150 '151 '152 '153 '154 '155 '156 '157
+'160 '161 '162 '163 '164 '165 '166 '167
+'170 '171 '172 '173 '174 '175 '176 '177.
+./pooltype tex.pool >tests/xtexpool.typ
+./tftopl -verbose ./tests/cmr10 tests/xcmr10
+TFMFONTS=./tests ./vftovp -verbose ./tests/ptmr ptmr tests/xptmr
+10.0010.00./vptovf ./tests/ptmr tests/xptmr tests/xptmr
+./weave ./pooltype
+This is WEAVE, Version 4.4 (Web2C 7.5.5)
+*1*4*12*21*22
+Writing the output file...*1*4*12*21*22
+Writing the index...Done.
+(No errors were found.)
+rm -f trap.mf trap.base
+rm -f mftrapin.fot mftrapin.log
+rm -f mftrap.fot mftrap.log mftrap.tfm
+rm -f mftrap.pl trap.72270gf trap.typ
+ln -s ./triptrap/trap.mf . # get same filename in log
+/bin/sh -c 'TEXMFCNF=./triptrap ./mf --progname=inimf <./triptrap/mftrap1.in >mftrapin.fot'
+mv trap.log mftrapin.log
+diff ./triptrap/mftrapin.log mftrapin.log
+1c1
+< This is METAFONT, Version 2.71828 (INIMF) 23 DEC 2002 11:57
+---
+> This is METAFONT, Version 2.71828 (Web2C 7.5.5) (INIMF) 3 AUG 2005 10:50
+150c150
+< String usage 26&83 (1895&21534 still untouched)
+---
+> String usage 30&98 (6387&79485 still untouched)
+176,177c176,177
+< (preloaded base=trap 98.8.8)
+< 1113 strings of total length 20515
+---
+> (base=trap 2005.8.3)
+> 1122 strings of total length 20565
+/bin/sh -c 'TEXMFCNF=./triptrap ./mf --progname=inimf <./triptrap/mftrap2.in >mftrap.fot'
+mv trap.log mftrap.log
+mv trap.tfm mftrap.tfm
+diff ./triptrap/mftrap.fot mftrap.fot
+1,3c1,2
+< This is METAFONT, Version 2.71828 (INIMF)
+< ** &trap trap
+< (trap.mf
+---
+> This is METAFONT, Version 2.71828 (Web2C 7.5.5) (INIMF)
+> **(trap.mf
+39c38
+< String usage 42&168 (1818&17726 still untouched)
+---
+> String usage 50&202 (6301&75642 still untouched)
+diff ./triptrap/mftrap.log mftrap.log
+1c1
+< This is METAFONT, Version 2.71828 (preloaded base=trap 2002.12.23) 23 DEC 2002 11:57
+---
+> This is METAFONT, Version 2.71828 (Web2C 7.5.5) (base=trap 2005.8.3) 3 AUG 2005 10:50
+1825c1825
+< String usage 24&92 (1863&21408 still untouched)
+---
+> String usage 30&119 (6347&79310 still untouched)
+2738c2738
+< Calling BLANKRECTANGLE(100,100,0,1)
+---
+> Calling BLANKRECTANGLE(1664,1664,0,1)
+4235c4235
+< String usage 42&168 (1818&17726 still untouched)
+---
+> String usage 50&202 (6301&75642 still untouched)
+4251,4252c4251,4252
+< 69 strings out of 1887
+< 3759 string characters out of 21485
+---
+> 77 strings out of 6378
+> 3793 string characters out of 79435
+4254,4255c4254,4255
+< 289 symbolic tokens out of 2100
+< 8i,43n,14r,8p,167b stack positions out of 30i,100n,300r,150p,500b
+---
+> 289 symbolic tokens out of 9500
+> 8i,43n,14r,8p,167b stack positions out of 300i,300n,1000r,150p,500b
+4263c4263
+< out of 256w,16h,16d,64i,5000l,500k,256e,50p)
+---
+> out of 256w,16h,16d,64i,15000l,2500k,256e,60p)
+./tftopl ./mftrap.tfm mftrap.pl
+diff ./triptrap/mftrap.pl mftrap.pl
+/bin/sh -c 'TEXMFCNF=./triptrap ./gftype -m -i ./trap.72270gf >trap.typ'
+diff ./triptrap/trap.typ trap.typ
+1c1
+< This is GFtype, Version 3.1
+---
+> This is GFtype, Version 3.1 (Web2C 7.5.5)
+3c3
+< ' METAFONT output 2002.12.23:1157'
+---
+> ' METAFONT output 2005.08.03:1050'
+./mf --progname=mf '&./mf \tracingstats:=1; end.'
+This is METAFONT, Version 2.71828 (Web2C 7.5.5)
+Transcript written on mfput.log.
+./mf --progname=mf ./tests/online
+This is METAFONT, Version 2.71828 (Web2C 7.5.5)
+(./tests/online.mf [0] )
+Output written on online.2602gf (1 character, 248 bytes).
+Transcript written on online.log.
+./mf --progname=mf ./tests/one.two
+This is METAFONT, Version 2.71828 (Web2C 7.5.5)
+(./tests/one.two.mf
+one.two )
+Transcript written on one.two.log.
+./mf --progname=mf ./tests/uno.dos
+This is METAFONT, Version 2.71828 (Web2C 7.5.5)
+(./tests/uno.dos )
+Transcript written on uno.log.
+rm -f mtrap.mp mtrap.mem trapf.tfm
+rm -f mtrap.log mtrap.0 mtrap.1 writeo writeo.log writeo.2
+rm -f trap.mp trap.mpx mptrapin.fot mptrapin.log
+rm -f mptrap.fot mptrap.log mptrap.tfm
+rm -f trap.ps trap.mem trap.0 trap.5 trap.6 trap.95 trap.96 trap.97
+rm -f trap.98 trap.99 trap.100 trap.101 trap.102 trap.103 trap.104
+rm -f trap.105 trap.106 trap.107 trap.108 trap.109 trap.148
+rm -f trap.149 trap.150 trap.151 trap.197 trap.200
+rm -f mptrap.pl
+ln -s ./triptrap/mtrap.mp . # get same filename in log
+./pltotf ./triptrap/trapf.pl trapf.tfm
+/bin/sh -c 'TEXMFCNF=./triptrap ./mpost --progname=inimpost mtrap'
+This is MetaPost, Version 0.901 (Web2C 7.5.5) (INIMP)
+(mtrap.mp
+diff ./triptrap/mtrap.log mtrap.log
+1,2c1,2
+< This is MetaPost, C Version 0.64 (INIMP) 28 JAN 1998 11:18
+< **mtrap
+---
+> This is MetaPost, Version 0.901 (Web2C 7.5.5) (INIMP) 3 AUG 2005 10:50
+> **mtrap
+5c5
+< String usage 4&24 (1306&9877 now untouched)
+---
+> String usage 5&29 (1297&17816 now untouched)
+300,306c300,306
+< String usage 8&32 (1302&9869 now untouched)
+< Memory usage 109&13 (3358 still untouched)
+< String usage 10&42 (1300&9859 now untouched)
+< Memory usage 116&13 (3358 still untouched)
+< String usage 11&45 (1299&9856 now untouched)
+< Memory usage 139&56 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> String usage 9&37 (1293&17808 now untouched)
+> Memory usage 120&13 (3358 still untouched)
+> String usage 11&47 (1291&17798 now untouched)
+> Memory usage 127&13 (3358 still untouched)
+> String usage 12&50 (1290&17795 now untouched)
+> Memory usage 150&56 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+316,317c316,317
+< Memory usage 152&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 163&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+341,342c341,342
+< Memory usage 220&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 239&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+358,359c358,359
+< Memory usage 245&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 267&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+374,375c374,375
+< Memory usage 293&72 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 318&72 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+404,405c404,405
+< Memory usage 314&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 342&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+442,443c442,443
+< Memory usage 339&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 370&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+480,481c480,481
+< Memory usage 339&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 370&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+496,497c496,497
+< Memory usage 345&70 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 376&70 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+537,538c537,538
+< Memory usage 364&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 398&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+550,551c550,551
+< Memory usage 355&64 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 386&64 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+594,595c594,595
+< Memory usage 365&59 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 396&59 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+610,611c610,611
+< Memory usage 390&73 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 424&73 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+659,660c659,660
+< Memory usage 409&59 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 446&59 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+668,671c668,671
+< Memory usage 409&59 (3358 still untouched)
+< String usage 18&75 (1292&9826 now untouched)
+< Memory usage 308&13 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 446&59 (3358 still untouched)
+> String usage 19&80 (1283&17765 now untouched)
+> Memory usage 339&13 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+721,722c721,722
+< Memory usage 308&13 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 339&13 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+724,725c724,725
+< Memory usage 563&13 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 622&13 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+817,818c817,818
+< Memory usage 747&13 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 826&13 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+847,848c847,848
+< Memory usage 1003&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 1110&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+872,873c872,873
+< Memory usage 873&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 966&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+897,898c897,898
+< Memory usage 786&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 868&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+919,920c919,920
+< Memory usage 773&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 852&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+942,943c942,943
+< Memory usage 788&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 870&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+949,950c949,950
+< Memory usage 319&13 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 350&13 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+952,953c952,953
+< Memory usage 325&13 (2358 still untouched)
+< String usage 20&78 (1287&9809 now untouched)
+---
+> Memory usage 356&13 (2358 still untouched)
+> String usage 21&83 (1278&17748 now untouched)
+956c956,957
+< >> "%%Creator: MetaPost"
+---
+> >> "%%HiResBoundingBox: -36 -24 84 84"
+> >> "%%Creator: MetaPost 0.901"
+958a960
+> >> "%%BeginProlog"
+988,989c990,991
+< Memory usage 325&13 (2358 still untouched)
+< String usage 22&84 (1247&8769 now untouched)
+---
+> Memory usage 356&13 (2358 still untouched)
+> String usage 23&89 (1236&16656 now untouched)
+992,994c994,996
+< >> 40
+< Memory usage 325&13 (2358 still untouched)
+< String usage 22&84 (1206&7603 now untouched)
+---
+> >> 42
+> Memory usage 356&13 (2358 still untouched)
+> String usage 23&89 (1193&15438 now untouched)
+998,1002c1000,1008
+< >> "%%Creator: MetaPost"
+< Memory usage 325&13 (2358 still untouched)
+< String usage 24&110 (1197&7522 now untouched)
+< Memory usage 325&13 (2358 still untouched)
+< String usage 26&125 (1148&7358 now untouched)
+---
+> >> "%%HiResBoundingBox: -36 -24 84 84"
+> Memory usage 356&13 (2358 still untouched)
+> String usage 25&129 (1184&15343 now untouched)
+> write0 = `writeo'.
+>
+> write1 = `writeo.2'.
+>
+> Memory usage 356&13 (2358 still untouched)
+> String usage 27&144 (1135&15179 now untouched)
+1004c1010
+< >> "%%Pages: 1"
+---
+> >> "%%CreationDate: 2005.08.03:1050"
+1006c1012
+< >> "%*Font: trapf 9.9628 9.96265 35:c008"
+---
+> >> "%%Pages: 1"
+1008,1010c1014,1018
+< >> "%%EndProlog"
+< Memory usage 325&13 (2358 still untouched)
+< String usage 25&135 (1144&7308 now untouched)
+---
+> >> "%*Font: trapf 9.9628 9.96265 35:c008"
+> Memory usage 356&13 (2358 still untouched)
+> String usage 26&134 (1131&15135 now untouched)
+> write0 = `writeo'.
+>
+1013,1014c1021,1022
+< Memory usage 325&13 (2358 still untouched)
+< String usage 26&141 (1195&1840 now untouched)
+---
+> Memory usage 356&13 (2358 still untouched)
+> String usage 27&140 (1258&16265 now untouched)
+1038,1039c1046,1047
+< Memory usage 325&13 (2358 still untouched)
+< String usage 26&141 (1195&1840 now untouched)
+---
+> Memory usage 356&13 (2358 still untouched)
+> String usage 27&140 (1258&16265 now untouched)
+1048,1049c1056,1057
+< Memory usage 327&13 (2358 still untouched)
+< String usage 27&149 (1194&1832 now untouched)
+---
+> Memory usage 358&13 (2358 still untouched)
+> String usage 28&148 (1257&16257 now untouched)
+1097,1098c1105,1106
+< Memory usage 327&13 (2358 still untouched)
+< String usage 27&149 (1193&1824 now untouched)
+---
+> Memory usage 358&13 (2358 still untouched)
+> String usage 28&148 (1256&16249 now untouched)
+1101,1102c1109,1110
+< 32 strings out of 1310
+< 561 string characters out of 9901
+---
+> 33 strings out of 1302
+> 560 string characters out of 17845
+1104,1106c1112,1114
+< 237 symbolic tokens out of 2100
+< 5i,33n,6p,100b stack positions out of 30i,100n,150p,500b
+< 3 string compactions (moved 1368 characters, 89 strings)
+---
+> 238 symbolic tokens out of 9500
+> 5i,33n,6p,99b stack positions out of 300i,300n,1500p,500b
+> 2 string compactions (moved 880 characters, 63 strings)
+diff ./triptrap/mtrap.0 mtrap.0
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -36 -24 84 84
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+6a8
+> %%BeginProlog
+diff ./triptrap/mtrap.1 mtrap.1
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -84 -36 24 84
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+6a8
+> %%BeginProlog
+diff ./triptrap/writeo writeo
+diff ./triptrap/writeo.2 writeo.2
+ln -s ./triptrap/trap.mp .
+ln -s ./triptrap/trap.mpx .
+/bin/sh -c 'TEXMFCNF=./triptrap ./mpost --progname=inimpost <./triptrap/mptrap1.in >mptrapin.fot'
+mv trap.log mptrapin.log
+diff ./triptrap/mptrapin.log mptrapin.log
+1c1
+< This is MetaPost, C Version 0.632 (INIMP) 24 JAN 1997 11:13
+---
+> This is MetaPost, Version 0.901 (Web2C 7.5.5) (INIMP) 3 AUG 2005 10:50
+162c162
+< String usage 28&93 (1282&9362 now untouched)
+---
+> String usage 29&97 (1272&17743 now untouched)
+195,198c195,198
+< (preloaded mem=trap 97.1.24)
+< at most 1226 strings of total length 22670
+< 398 memory locations dumped; current usage is 318&68
+< 279 symbolic tokens
+---
+> (mem=trap 2005.8.3)
+> at most 1236 strings of total length 22276
+> 400 memory locations dumped; current usage is 320&68
+> 281 symbolic tokens
+/bin/sh -c 'TEXMFCNF=./triptrap ./mpost --progname=inimpost <./triptrap/mptrap2.in >mptrap.fot'
+mv trap.log mptrap.log
+mv trap.tfm mptrap.tfm
+diff ./triptrap/mptrap.fot mptrap.fot
+0a1
+> This is MetaPost, Version 0.901 (Web2C 7.5.5) (INIMP)
+34,35c35,36
+< Memory usage 2147&536 (39 still untouched)
+< String usage 73&277 (1110&5373 now untouched)
+---
+> Memory usage 2315&536 (39 still untouched)
+> String usage 74&281 (1103&13766 now untouched)
+diff ./triptrap/mptrap.log mptrap.log
+1c1
+< This is MetaPost, C Version 0.632 (preloaded mem=trap 97.1.24) 24 JAN 1997 11:13
+---
+> This is MetaPost, Version 0.901 (Web2C 7.5.5) (mem=trap 2005.8.3) 3 AUG 2005 10:50
+1621,1622c1621,1622
+< Memory usage 1178&115 (2344 still untouched)
+< String usage 22&84 (1244&9177 now untouched)
+---
+> Memory usage 1244&115 (2344 still untouched)
+> String usage 23&88 (1236&17569 now untouched)
+2612c2612
+< >> unknown path %CAPSULE1695
+---
+> >> unknown path %CAPSULE1901
+2665c2665
+< dashed (on 3 off 0) shifted 0
+---
+> dashed (on 0 off 0) shifted 0
+2816,2818c2816,2818
+< xpart %CAPSULE2512=xx
+< %CAPSULE2520=2yy-2
+< %CAPSULE2528 = 3.3333xx+3.3333
+---
+> xpart %CAPSULE2366=xx
+> %CAPSULE2374=2yy-2
+> %CAPSULE2382 = 3.3333xx+3.3333
+2877,2880c2877,2880
+< %CAPSULE2440 = 3ooo-0.01o3
+< %CAPSULE2460 = 8000o2-4000o1+1000o3+9
+< xpart %CAPSULE2536=xpart '
+< ypart %CAPSULE2536=ypart '
+---
+> %CAPSULE2294 = 3ooo-0.01o3
+> %CAPSULE2314 = 8000o2-4000o1+1000o3+9
+> xpart %CAPSULE2390=xpart '
+> ypart %CAPSULE2390=ypart '
+2883,2884c2883,2884
+< ### 4000o1 = -%CAPSULE2460+8000o2+1000o3+9
+< ### -4.87383o2 = -oo-0.0004%CAPSULE2460+0.39673o3-17.99643
+---
+> ### 4000o1 = -%CAPSULE2314+8000o2+1000o3+9
+> ### -4.87383o2 = -oo-0.0004%CAPSULE2314+0.39673o3-17.99643
+2888c2888
+< ### 0.22894o5 = -%CAPSULE2440+0.10689oo+3ooo+1.92412
+---
+> ### 0.22894o5 = -%CAPSULE2294+0.10689oo+3ooo+1.92412
+2891c2891
+< ### -alfa=-%CAPSULE2428
+---
+> ### -alfa=-%CAPSULE2282
+2893,2900c2893,2900
+< ### -%CAPSULE2428=-xpart %CAPSULE2426
+< {xpart((xpart %CAPSULE2426,0))}
+< ### -xpart %CAPSULE9=-%CAPSULE2416
+< {endgroup}
+< {(%CAPSULE2440)+(%CAPSULE2416)}
+< ### -%CAPSULE2440=-%CAPSULE2404+%CAPSULE2416
+< ### -%CAPSULE2404=-ypart %CAPSULE2402
+< ### -%CAPSULE2460=-xpart %CAPSULE2402
+---
+> ### -%CAPSULE2282=-xpart %CAPSULE2280
+> {xpart((xpart %CAPSULE2280,0))}
+> ### -xpart %CAPSULE9=-%CAPSULE2270
+> {endgroup}
+> {(%CAPSULE2294)+(%CAPSULE2270)}
+> ### -%CAPSULE2294=-%CAPSULE2258+%CAPSULE2270
+> ### -%CAPSULE2258=-ypart %CAPSULE2256
+> ### -%CAPSULE2314=-xpart %CAPSULE2256
+2905c2905
+< ### p$=-ypart %CAPSULE2368+1
+---
+> ### p$=-ypart %CAPSULE2222+1
+2907,2919c2907,2919
+< {(2/3)*((-ypart %CAPSULE2368+1,ypart %CAPSULE2368))}
+< ### ypart %CAPSULE2368=-xpart %CAPSULE2368+1
+< ### -0.66667xpart %CAPSULE2368=-xpart %CAPSULE2360
+< {-((xpart %CAPSULE2360,-xpart %CAPSULE2360+0.66667))}
+< ### xpart %CAPSULE2360=-xpart %CAPSULE2340
+< {((xpart %CAPSULE2402,ypart %CAPSULE2402))=((xpart %CAPSULE2340,-xpart %
+< CAPSULE2340-0.66667))}
+< ## xpart %CAPSULE2340=-ypart %CAPSULE2402-0.66667
+< ## xpart %CAPSULE2402=-ypart %CAPSULE2402-0.66667
+< ### ypart %CAPSULE2402=-xpart %CAPSULE2402-0.66667
+< ### -xpart %CAPSULE2402=-xpart %CAPSULE2340
+< {((xpart ',ypart '))=((xpart %CAPSULE2340,-xpart %CAPSULE2340-0.66667))}
+< ## xpart %CAPSULE2340=-ypart '-0.66667
+---
+> {(2/3)*((-ypart %CAPSULE2222+1,ypart %CAPSULE2222))}
+> ### ypart %CAPSULE2222=-xpart %CAPSULE2222+1
+> ### -0.66667xpart %CAPSULE2222=-xpart %CAPSULE2214
+> {-((xpart %CAPSULE2214,-xpart %CAPSULE2214+0.66667))}
+> ### xpart %CAPSULE2214=-xpart %CAPSULE2194
+> {((xpart %CAPSULE2256,ypart %CAPSULE2256))=((xpart %CAPSULE2194,-xpart %
+> CAPSULE2194-0.66667))}
+> ## xpart %CAPSULE2194=-ypart %CAPSULE2256-0.66667
+> ## xpart %CAPSULE2256=-ypart %CAPSULE2256-0.66667
+> ### ypart %CAPSULE2256=-xpart %CAPSULE2256-0.66667
+> ### -xpart %CAPSULE2256=-xpart %CAPSULE2194
+> {((xpart ',ypart '))=((xpart %CAPSULE2194,-xpart %CAPSULE2194-0.66667))}
+> ## xpart %CAPSULE2194=-ypart '-0.66667
+2925c2925
+< ### -ooo=-%CAPSULE2302
+---
+> ### -ooo=-%CAPSULE2156
+2927,2936c2927,2936
+< {(%CAPSULE2302)+(1)}
+< ### -%CAPSULE2302=-%CAPSULE2290+1
+< {(1/2)*(%CAPSULE2290)}
+< ### -0.5%CAPSULE2290=-%CAPSULE2282
+< {-(%CAPSULE2282)}
+< ### %CAPSULE2282=-%CAPSULE2274
+< {(2)*(%CAPSULE2274)}
+< ### -2%CAPSULE2274=-%CAPSULE2266
+< {(-0.5%CAPSULE2266-0.5)=(%CAPSULE2266)}
+< ## %CAPSULE2266=-0.33333
+---
+> {(%CAPSULE2156)+(1)}
+> ### -%CAPSULE2156=-%CAPSULE2144+1
+> {(1/2)*(%CAPSULE2144)}
+> ### -0.5%CAPSULE2144=-%CAPSULE2136
+> {-(%CAPSULE2136)}
+> ### %CAPSULE2136=-%CAPSULE2128
+> {(2)*(%CAPSULE2128)}
+> ### -2%CAPSULE2128=-%CAPSULE2120
+> {(-0.5%CAPSULE2120-0.5)=(%CAPSULE2120)}
+> ## %CAPSULE2120=-0.33333
+3509,3510c3509,3510
+< Memory usage 3017&264 (273 still untouched)
+< String usage 68&249 (1155&8794 now untouched)
+---
+> Memory usage 3275&264 (273 still untouched)
+> String usage 69&253 (1147&17186 now untouched)
+3520,3521c3520,3521
+< Memory usage 2267&264 (273 still untouched)
+< String usage 66&241 (1154&8790 now untouched)
+---
+> Memory usage 2446&264 (273 still untouched)
+> String usage 67&245 (1146&17182 now untouched)
+3990a3991,3992
+> ..(10,10)
+> ..controls (10,10) and (10,10)
+4378,4379c4380,4381
+< Memory usage 2744&607 (39 still untouched)
+< String usage 73&279 (1138&8717 now untouched)
+---
+> Memory usage 2959&607 (39 still untouched)
+> String usage 74&283 (1130&17109 now untouched)
+4384,4385c4386,4387
+< Memory usage 2704&536 (39 still untouched)
+< String usage 73&279 (1138&8717 now untouched)
+---
+> Memory usage 2919&536 (39 still untouched)
+> String usage 74&283 (1130&17109 now untouched)
+4673,4674c4675,4676
+< Memory usage 2147&536 (39 still untouched)
+< String usage 73&277 (1110&5373 now untouched)
+---
+> Memory usage 2315&536 (39 still untouched)
+> String usage 74&281 (1103&13766 now untouched)
+4739,4740c4741,4742
+< 75 strings out of 1277
+< 768 string characters out of 9330
+---
+> 76 strings out of 1268
+> 772 string characters out of 17724
+4742,4743c4744,4745
+< 337 symbolic tokens out of 2100
+< 8i,35n,8p,167b stack positions out of 30i,100n,150p,500b
+---
+> 339 symbolic tokens out of 9500
+> 8i,35n,8p,167b stack positions out of 300i,300n,1500p,500b
+4752c4754
+< out of 256w,16h,16d,64i,5000l,500k,256e,50p)
+---
+> out of 256w,16h,16d,64i,15000l,2500k,256e,50p)
+diff ./triptrap/trap.5 trap.5
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -150.99219 -2 168.99219 20.00024
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.6 trap.6
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: 3 0 6 2.25
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.148 trap.148
+2,4c2,5
+< %%BoundingBox: -5 -5 13 5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%BoundingBox: -4 -6 13 6
+> %%HiResBoundingBox: -3.5 -5.5 12.5 5.5
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.149 trap.149
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -27.5 -27.5 51.6906 36.71318
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.150 trap.150
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -5 -5 33 25
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+5a7
+> %%BeginProlog
+28c30
+< 15 10 lineto
+---
+> 10 5 lineto
+diff ./triptrap/trap.151 trap.151
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -4095.49998 -101.96362 4095.49998 261
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.197 trap.197
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -1.99254 -3.98508 7.97011 3.98506
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+6a8
+> %%BeginProlog
+diff ./triptrap/trap.200 trap.200
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -6.2132 -5.9851 36.21318 37.00375
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1050
+7a9
+> %%BeginProlog
+./tftopl ./mptrap.tfm mptrap.pl
+diff ./triptrap/mptrap.pl mptrap.pl
+./mpost --progname=mpost '&./mpost \tracingstats:=1; end.'
+This is MetaPost, Version 0.901 (Web2C 7.5.5)
+Transcript written on mpout.log.
+TEXMFCNF=../kpathsea \
+ MAKEMPX_BINDIR=`pwd`:`pwd`/mpware MPXCOMMAND=mpware/makempx \
+ ./mpost --progname=mpost ./tests/mptest
+This is MetaPost, Version 0.901 (Web2C 7.5.5)
+(./tests/mptest.mp
+* Test for string length bug:
+Length of string "^^I"
+==> 1
+Length of string "^^I"
+==> 1
+* Test for big numbers in btex...etex: )
+Transcript written on mptest.log.
+./mpost --progname=mpost ./tests/one.two
+This is MetaPost, Version 0.901 (Web2C 7.5.5)
+(./tests/one.two.mp
+one.two )
+Transcript written on one.two.log.
+./mpost --progname=mpost ./tests/uno.dos
+This is MetaPost, Version 0.901 (Web2C 7.5.5)
+(./tests/uno.dos )
+Transcript written on uno.log.
+rm -f trip.tfm trip.pl trip.tex trip.fmt tripin.fot tripin.log
+rm -f trip.fot trip.log trip.dvi trip.typ tripos.tex 8terminal.tex
+rm -rf tfm
+./pltotf ./triptrap/trip.pl trip.tfm
+./tftopl ./trip.tfm trip.pl
+diff ./triptrap/trip.pl trip.pl
+ln -s ./triptrap/trip.tex . # get same filename in log
+/bin/sh -c 'TEXMFCNF=./triptrap ./tex --progname=initex --ini <./triptrap/trip1.in >tripin.fot'
+mv trip.log tripin.log
+diff ./triptrap/tripin.log tripin.log
+1c1
+< This is TeX, Version 3.141592 (INITEX) 20 DEC 2002 20:24
+---
+> This is TeX, Version 3.141592 (Web2C 7.5.5) (INITEX) 3 AUG 2005 10:50
+3c3
+< (trip.tex
+---
+> (./trip.tex
+450,451c450,451
+< (preloaded format=trip 2002.12.20)
+< 1320 strings of total length 23539
+---
+> (format=trip 2005.8.3)
+> 1364 strings of total length 24385
+461c461
+< Hyphenation trie of length 273 has 9 ops out of 500
+---
+> Hyphenation trie of length 273 has 9 ops out of 35111
+/bin/sh -c 'TEXMFCNF=./triptrap ./tex --progname=tex <./triptrap/trip2.in >trip.fot'
+diff ./triptrap/trip.fot trip.fot
+1,3c1,2
+< This is TeX, Version 3.141592 (INITEX)
+< ** &trip trip
+< (trip.tex ##
+---
+> This is TeX, Version 3.141592 (Web2C 7.5.5)
+> **(./trip.tex ##
+diff ./triptrap/trip.log trip.log
+1c1
+< This is TeX, Version 3.141592 (preloaded format=trip 2002.12.20) 20 DEC 2002 21:28
+---
+> This is TeX, Version 3.141592 (Web2C 7.5.5) (format=trip 2005.8.3) 3 AUG 2005 10:50
+3c3
+< (trip.tex ##
+---
+> (./trip.tex ##
+58a59,62
+> \openout0 = `8terminal.tex'.
+>
+> \openout10 = `tripos.tex'.
+>
+1405c1409
+< \vbox(16383.99998+0.0)x1000.0, glue set 16342.0fil
+---
+> \vbox(16383.99998+0.0)x1000.0, glue set 16341.99998fil
+1954c1958
+< (tripos.tex
+---
+> (./tripos.tex
+2018c2022
+< \vbox(16383.99998+1.0)x100.0, glue set 16239.0fil
+---
+> \vbox(16383.99998+1.0)x100.0, glue set 16238.99998fil
+2533c2537
+< \vbox(16383.99998+0.0)x20.0, glue set 16331.0fil
+---
+> \vbox(16383.99998+0.0)x20.0, glue set 16330.99998fil
+3326c3330
+< \vbox(10000.0+2.0)x28.0, glue set 9737.58789fil
+---
+> \vbox(10000.0+2.0)x28.0, glue set 9737.58742fil
+3864c3868
+< \vbox(16383.99998+2.0)x100.0, glue set 16318.0fil
+---
+> \vbox(16383.99998+2.0)x100.0, glue set 16317.99997fil
+4034c4038
+< \vbox(16383.99998+0.0)x8236.0, glue set 16344.0fil
+---
+> \vbox(16383.99998+0.0)x8236.0, glue set 16343.99998fil
+4420c4424
+< \vbox(16383.99998+0.0)x100.0, glue set 16332.0fil
+---
+> \vbox(16383.99998+0.0)x100.0, glue set 16331.99998fil
+4742c4746
+< \vbox(16383.99998+0.0)x205.12613, glue set 16344.0fil
+---
+> \vbox(16383.99998+0.0)x205.12613, glue set 16343.99998fil
+6370c6374
+< (tripos.tex
+---
+> (./tripos.tex
+7287,7288c7291,7292
+< 47 strings out of 1674
+< 251 string characters out of 8353
+---
+> 44 strings out of 1636
+> 261 string characters out of 15615
+7290c7294
+< 372 multiletter control sequences out of 2100
+---
+> 372 multiletter control sequences out of 10000+0
+7292,7293c7296,7297
+< 2 hyphenation exceptions out of 307
+< 5i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+---
+> 1 hyphenation exception out of 659
+> 7i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+/bin/sh -c 'TEXMFCNF=./triptrap ./dvitype -output-level=2 -dpi=72.27 -page-start='*.*.*.*.*.*.*.*.*.*' trip.dvi >trip.typ'
+diff ./triptrap/trip.typ trip.typ
+1c1
+< This is DVItype, Version 3.6
+---
+> This is DVItype, Version 3.6 (Web2C 7.5.5)
+9c9
+< ' TeX output 2002.12.20:2128'
+---
+> ' TeX output 2005.08.03:1050'
+419c419
+< 1121: down4 639342208
+---
+> 1121: down4 639342177
+1087,1088c1087,1088
+< 2535: y4 203921760
+< 2540: y0 203921760
+---
+> 2535: y4 203921756
+> 2540: y0 203921756
+1215d1214
+<
+./tex --progname=tex --output-comment="`cat ./PROJECTS`" \
+ ./tests/hello 2>/dev/null \
+ && ./dvitype hello.dvi | grep olaf@infovore.xs4all.nl >/dev/null
+This is TeXk, Version 3.141592 (Web2C 7.5.5)
+ %&-line parsing enabled.
+(./tests/hello.tex [1] )
+Output written on hello.dvi (1 page, 456 bytes).
+Transcript written on hello.log.
+./tex --progname=tex ./tests/openout && grep xfoo openout.log
+This is TeXk, Version 3.141592 (Web2C 7.5.5)
+ %&-line parsing enabled.
+(./tests/openout.tex )
+No pages of output.
+Transcript written on openout.log.
+\openout0 = `xfoo.out'.
+./tex --progname=tex ./tests/one.two && ls -l one.two.log
+This is TeXk, Version 3.141592 (Web2C 7.5.5)
+ %&-line parsing enabled.
+(./tests/one.two.tex jobname = one.two )
+No pages of output.
+Transcript written on one.two.log.
+-rw-r--r-- 1 olaf olaf 190 Aug 3 10:50 one.two.log
+./tex --progname=tex ./tests/uno.dos && ls -l uno.log
+This is TeXk, Version 3.141592 (Web2C 7.5.5)
+ %&-line parsing enabled.
+(./tests/uno.dos )
+No pages of output.
+Transcript written on uno.log.
+-rw-r--r-- 1 olaf olaf 168 Aug 3 10:50 uno.log
+./tex --progname=tex ./tests/just.texi && ls -l just.log
+This is TeXk, Version 3.141592 (Web2C 7.5.5)
+ %&-line parsing enabled.
+(./tests/just.texi )
+No pages of output.
+Transcript written on just.log.
+-rw-r--r-- 1 olaf olaf 172 Aug 3 10:50 just.log
+./tex --progname=tex ./tests/batch.tex
+This is TeXk, Version 3.141592 (Web2C 7.5.5)
+ %&-line parsing enabled.
+(./tests/batch.tex
+ )
+No pages of output.
+Transcript written on batch.log.
+./tex --progname=tex --shell ./tests/write18 | grep echo
+(./tests/write18.texthis is write18 output from echo
+TEXMFCNF=../kpathsea \
+ ./tex --mltex --progname=initex --ini ./tests/mltextst
+This is TeX, Version 3.141592 (Web2C 7.5.5) (INITEX)
+MLTeX v2.2 enabled
+(./tests/mltextst.tex
+
+Test for bugs in MLTeX (1995/12/07 v1.2 [br])
+
+
+..... Ok, this is a newer MLTeX version (>= 2.0).
+
+
+..... If there will be an error "Bad metric (TFM) file",
+..... please update to the newest MLTeX version!
+
+..... Good, no "Bad metric (TFM) file" bug,
+..... seems to be the a MLTeX version > 2.01.
+
+
+...... Seems to be MLTeX version 2.2 (released Dec. 1995).
+
+Congratulations, you have a MLTeX version with all known bugs fixed.
+
+ )
+(see the transcript file for additional information)
+No pages of output.
+Transcript written on mltextst.log.
+./tex </dev/null
+This is TeXk, Version 3.141592 (Web2C 7.5.5)
+ %&-line parsing enabled.
+**
+! End of file on the terminal... why?
+PATH=`pwd`:../kpathsea:./../kpathsea:$PATH \
+ WEB2C=./../kpathsea TMPDIR=.. \
+ ./tex --progname=tex '\nonstopmode\font\foo=nonesuch\end'
+This is TeXk, Version 3.141592 (Web2C 7.5.5)
+ %&-line parsing enabled.
+
+! Font \foo=nonesuch not loadable: Metric (TFM) file not found.
+<to be read again>
+ \end
+<*> \nonstopmode\font\foo=nonesuch\end
+
+(see the transcript file for additional information)
+No pages of output.
+Transcript written on texput.log.
+rm -f trip.tfm trip.pl trip.tex trip.fmt ctripin.fot ctripin.log
+rm -f ctrip.fot ctrip.log trip.dvi ctrip.typ
+rm -f xtripin.fot xtripin.log
+rm -f xtrip.fot xtrip.log xtrip.typ
+rm -f etrip.tfm etrip.pl etrip.tex etrip.fmt etripin.fot etripin.log
+rm -f etrip.fot etrip.log etrip.dvi etrip.out etrip.typ
+rm -f tripos.tex 8terminal.tex
+rm -rf tfm
+*** TRIP test for e-TeX in compatibility mode ***.
+./pltotf ./triptrap/trip.pl trip.tfm
+./tftopl ./trip.tfm trip.pl
+diff ./triptrap/trip.pl trip.pl
+ln -s ./triptrap/trip.tex . # get same filename in log
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=einitex --ini <./triptrap/trip1.in >ctripin.fot'
+mv trip.log ctripin.log
+diff ./triptrap/tripin.log ctripin.log
+1c1
+< This is TeX, Version 3.141592 (INITEX) 20 DEC 2002 20:24
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5) (INITEX) 3 AUG 2005 10:50
+3c3
+< (trip.tex
+---
+> (./trip.tex
+450,451c450,451
+< (preloaded format=trip 2002.12.20)
+< 1320 strings of total length 23539
+---
+> (format=trip 2005.8.3)
+> 1479 strings of total length 25862
+461c461
+< Hyphenation trie of length 273 has 9 ops out of 500
+---
+> Hyphenation trie of length 273 has 9 ops out of 35111
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=etex <./triptrap/trip2.in >ctrip.fot'
+mv trip.log ctrip.log
+diff ./triptrap/trip.fot ctrip.fot
+1,3c1,2
+< This is TeX, Version 3.141592 (INITEX)
+< ** &trip trip
+< (trip.tex ##
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5)
+> **(./trip.tex ##
+diff ./triptrap/trip.log ctrip.log
+1c1
+< This is TeX, Version 3.141592 (preloaded format=trip 2002.12.20) 20 DEC 2002 21:28
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5) (format=trip 2005.8.3) 3 AUG 2005 10:50
+3c3
+< (trip.tex ##
+---
+> (./trip.tex ##
+58a59,62
+> \openout0 = `8terminal.tex'.
+>
+> \openout10 = `tripos.tex'.
+>
+1405c1409
+< \vbox(16383.99998+0.0)x1000.0, glue set 16342.0fil
+---
+> \vbox(16383.99998+0.0)x1000.0, glue set 16341.99998fil
+1954c1958
+< (tripos.tex
+---
+> (./tripos.tex
+2018c2022
+< \vbox(16383.99998+1.0)x100.0, glue set 16239.0fil
+---
+> \vbox(16383.99998+1.0)x100.0, glue set 16238.99998fil
+2533c2537
+< \vbox(16383.99998+0.0)x20.0, glue set 16331.0fil
+---
+> \vbox(16383.99998+0.0)x20.0, glue set 16330.99998fil
+3326c3330
+< \vbox(10000.0+2.0)x28.0, glue set 9737.58789fil
+---
+> \vbox(10000.0+2.0)x28.0, glue set 9737.58742fil
+3864c3868
+< \vbox(16383.99998+2.0)x100.0, glue set 16318.0fil
+---
+> \vbox(16383.99998+2.0)x100.0, glue set 16317.99997fil
+4034c4038
+< \vbox(16383.99998+0.0)x8236.0, glue set 16344.0fil
+---
+> \vbox(16383.99998+0.0)x8236.0, glue set 16343.99998fil
+4420c4424
+< \vbox(16383.99998+0.0)x100.0, glue set 16332.0fil
+---
+> \vbox(16383.99998+0.0)x100.0, glue set 16331.99998fil
+4742c4746
+< \vbox(16383.99998+0.0)x205.12613, glue set 16344.0fil
+---
+> \vbox(16383.99998+0.0)x205.12613, glue set 16343.99998fil
+6370c6374
+< (tripos.tex
+---
+> (./tripos.tex
+7287,7288c7291,7292
+< 47 strings out of 1674
+< 251 string characters out of 8353
+---
+> 44 strings out of 1821
+> 261 string characters out of 8138
+7290c7294
+< 372 multiletter control sequences out of 2100
+---
+> 372 multiletter control sequences out of 10000+0
+7292,7293c7296,7297
+< 2 hyphenation exceptions out of 307
+< 5i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+---
+> 1 hyphenation exception out of 659
+> 7i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./dvitype -output-level=2 -dpi=72.27 -page-start='*.*.*.*.*.*.*.*.*.*' trip.dvi >ctrip.typ'
+diff ./triptrap/trip.typ ctrip.typ
+1c1
+< This is DVItype, Version 3.6
+---
+> This is DVItype, Version 3.6 (Web2C 7.5.5)
+9c9
+< ' TeX output 2002.12.20:2128'
+---
+> ' TeX output 2005.08.03:1050'
+419c419
+< 1121: down4 639342208
+---
+> 1121: down4 639342177
+1087,1088c1087,1088
+< 2535: y4 203921760
+< 2540: y0 203921760
+---
+> 2535: y4 203921756
+> 2540: y0 203921756
+1215d1214
+<
+*** TRIP test for e-TeX in extended mode ***.
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=einitex --ini <./etexdir/etrip/etrip1.in >xtripin.fot'
+mv trip.log xtripin.log
+diff ctripin.log xtripin.log
+2c2,3
+< **\input trip
+---
+> entering extended mode
+> ***\input trip
+36,41d36
+< ! Bad register code (256).
+< l.29 ...{1} \toksdef\tokens=256
+< \show\errorstopmode
+< A register number must be between 0 and 255.
+< I changed this one to zero.
+<
+452,453c447,448
+< 471 memory locations dumped; current usage is 96&278
+< 341 multiletter control sequences
+---
+> 509 memory locations dumped; current usage is 134&278
+> 407 multiletter control sequences
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=etex <./etexdir/etrip/trip2.in >xtrip.fot'
+mv trip.log xtrip.log
+diff ctrip.fot xtrip.fot
+2c2,3
+< **(./trip.tex ##
+---
+> **entering extended mode
+> ## (./trip.tex
+76a78,80
+>
+> ### semi simple group (level 1) entered at line 429 (begingroup)
+> ### bottom level
+diff ctrip.log xtrip.log
+2,3c2,4
+< ** &trip trip
+< (./trip.tex ##
+---
+> entering extended mode
+> **&trip \toksdef\tokens=0 \input trip
+> (./trip.tex
+1773d1773
+< {restoring \fam=-1}
+1783d1782
+< {restoring \displayindent=0.0pt}
+1837d1835
+< {restoring \fam=-1}
+2139c2137
+< .\hbox(0.0+0.0)x0.0, shifted 50.0
+---
+> .\hbox(0.0+0.0)x0.0, shifted 50.0, display
+2142c2140
+< .\hbox(0.0+0.0)x0.0, shifted 100.0
+---
+> .\hbox(0.0+0.0)x0.0, shifted 100.0, display
+2574c2572
+< .\hbox(0.0+0.0)x15.0, glue set 0.1875, shifted 5.0
+---
+> .\hbox(0.0+0.0)x15.0, glue set 0.1875, shifted 5.0, display
+2839d2836
+< {restoring current font=\ip}
+3227d3223
+< {restoring \fam=-1}
+3376c3372
+< .\hbox(68.26251+98.15005)x19.0, glue set - 1.0, shifted 9.0
+---
+> .\hbox(68.26251+98.15005)x19.0, glue set - 1.0, shifted 9.0, display
+3561c3557
+< .\hbox(20.5+50.80002)x8.27895, shifted 19.72105
+---
+> .\hbox(20.5+50.80002)x8.27895, shifted 19.72105, display
+3770d3765
+< {restoring \fam=-1}
+3843d3837
+< {restoring \fam=-1}
+3899c3893
+< ..\hbox(12.0+4.0)x8.1778
+---
+> ..\hbox(12.0+4.0)x8.1778, display
+3921c3915
+< ..\hbox(0.0+13.00002)x-0.1778, glue set - 57.67767fil
+---
+> ..\hbox(0.0+13.00002)x-0.1778, glue set - 57.67767fil, display
+3929c3923
+< ....\hbox(7.0+1.0)x5.0, shifted 47.5
+---
+> ....\hbox(7.0+1.0)x5.0, shifted 47.5, display
+4015d4008
+< {restoring \fam=-1}
+4051c4044
+< .\hbox(0.0+0.0)x1009.0, shifted 7227.0
+---
+> .\hbox(0.0+0.0)x1009.0, shifted 7227.0, display
+4055c4048
+< .\hbox(0.0+0.0)x-7127.0, shifted 7227.0
+---
+> .\hbox(0.0+0.0)x-7127.0, shifted 7227.0, display
+7286a7280,7282
+>
+> ### semi simple group (level 1) entered at line 429 (begingroup)
+> ### bottom level
+7294c7290
+< 372 multiletter control sequences out of 10000+0
+---
+> 438 multiletter control sequences out of 10000+0
+7297c7293
+< 7i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+---
+> 7i,7n,9p,136b,40s stack positions out of 200i,40n,60p,500b,600s
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./dvitype -output-level=2 -dpi=72.27 -page-start='*.*.*.*.*.*.*.*.*.*' trip.dvi >xtrip.typ'
+diff ctrip.typ xtrip.typ
+*** e-TeX specific part of e-TRIP test ***.
+./pltotf ./etexdir/etrip/etrip.pl etrip.tfm
+./tftopl ./etrip.tfm etrip.pl
+diff ./etexdir/etrip/etrip.pl etrip.pl
+ln -s ./etexdir/etrip/etrip.tex . # get same filename in log
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=einitex --ini <./etexdir/etrip/etrip2.in >etripin.fot'
+mv etrip.log etripin.log
+diff ./etexdir/etrip/etripin.log etripin.log
+1c1
+< This is e-TeX, Version 3.141592-2.2 (INITEX) 6 SEP 2004 23:13
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5) (INITEX) 3 AUG 2005 10:50
+4c4,5
+< (etrip.tex This is the e-Trip test [2004-09-06] for e-TeX v3.141592-2.2.
+---
+> (./etrip.tex
+> This is the e-Trip test [2004-09-06] for e-TeX v3.141592-2.2.
+25,26c26,27
+< (preloaded format=etrip 2004.9.6)
+< 1435 strings of total length 24590
+---
+> (format=etrip 2005.8.3)
+> 1480 strings of total length 25893
+35c36
+< Hyphenation trie of length 434 has 12 ops out of 500
+---
+> Hyphenation trie of length 434 has 12 ops out of 35111
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./etex --progname=etex <./etexdir/etrip/etrip3.in >etrip.fot'
+diff ./etexdir/etrip/etrip.fot etrip.fot
+1,4c1,3
+< This is e-TeX, Version 3.141592-2.2 (INITEX)
+< **&etrip etrip
+< entering extended mode
+< (etrip.tex e-IniTeX: e-Trip format loaded.
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5)
+> **entering extended mode
+> (./etrip.tex e-IniTeX: e-Trip format loaded.
+46a46,47
+> \openout1 = `etrip.out'.
+>
+diff ./etexdir/etrip/etrip.log etrip.log
+1c1
+< This is e-TeX, Version 3.141592-2.2 (preloaded format=etrip 2004.9.6) 6 SEP 2004 23:13
+---
+> This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5) (format=etrip 2005.8.3) 3 AUG 2005 10:50
+4c4
+< (etrip.tex e-IniTeX: e-Trip format loaded.
+---
+> (./etrip.tex e-IniTeX: e-Trip format loaded.
+670a671,672
+> \openout1 = `etrip.out'.
+>
+672c674
+< (etrip.out) (
+---
+> (./etrip.out) (
+764c766
+< % end of outer \scantokens) (etrip.out
+---
+> % end of outer \scantokens) (./etrip.out
+4273,4274c4275,4276
+< 22 strings out of 1665
+< 132 string characters out of 8410
+---
+> 18 strings out of 1820
+> 140 string characters out of 8107
+4276c4278
+< 408 multiletter control sequences out of 2100
+---
+> 408 multiletter control sequences out of 10000+0
+4278c4280
+< 10 hyphenation exceptions out of 307
+---
+> 9 hyphenation exceptions out of 659
+diff ./etexdir/etrip/etrip.out etrip.out
+/bin/sh -c 'TEXMFCNF=./etexdir/etrip ./dvitype -output-level=2 -dpi=72.27 -page-start='*.*.*.*.*.*.*.*.*.*' etrip.dvi >etrip.typ'
+diff ./etexdir/etrip/etrip.typ etrip.typ
+1c1
+< This is DVItype, Version 3.6
+---
+> This is DVItype, Version 3.6 (Web2C 7.5.5)
+9c9
+< ' TeX output 2004.09.06:2313'
+---
+> ' TeX output 2005.08.03:1050'
+./etex --progname=etex --output-comment="`cat ./PROJECTS`" \
+ ./tests/hello 2>/dev/null \
+ && ./dvitype hello.dvi | grep olaf@infovore.xs4all.nl >/dev/null
+This is e-TeXk, Version 3.141592-2.2 (Web2C 7.5.5)
+ %&-line parsing enabled.
+entering extended mode
+(./tests/hello.tex [1] )
+Output written on hello.dvi (1 page, 456 bytes).
+Transcript written on hello.log.
+./etex --progname=etex ./tests/openout && grep xfoo openout.log
+This is e-TeXk, Version 3.141592-2.2 (Web2C 7.5.5)
+ %&-line parsing enabled.
+entering extended mode
+(./tests/openout.tex )
+No pages of output.
+Transcript written on openout.log.
+\openout0 = `xfoo.out'.
+./etex --progname=etex ./tests/one.two && ls -l one.two.log
+This is e-TeXk, Version 3.141592-2.2 (Web2C 7.5.5)
+ %&-line parsing enabled.
+entering extended mode
+(./tests/one.two.tex jobname = one.two )
+No pages of output.
+Transcript written on one.two.log.
+-rw-r--r-- 1 olaf olaf 220 Aug 3 10:50 one.two.log
+./etex --progname=etex ./tests/uno.dos && ls -l uno.log
+This is e-TeXk, Version 3.141592-2.2 (Web2C 7.5.5)
+ %&-line parsing enabled.
+entering extended mode
+(./tests/uno.dos )
+No pages of output.
+Transcript written on uno.log.
+-rw-r--r-- 1 olaf olaf 198 Aug 3 10:50 uno.log
+./etex --progname=etex ./tests/just.texi && ls -l just.log
+This is e-TeXk, Version 3.141592-2.2 (Web2C 7.5.5)
+ %&-line parsing enabled.
+entering extended mode
+(./tests/just.texi )
+No pages of output.
+Transcript written on just.log.
+-rw-r--r-- 1 olaf olaf 202 Aug 3 10:50 just.log
+./etex --progname=etex ./tests/batch.tex
+This is e-TeXk, Version 3.141592-2.2 (Web2C 7.5.5)
+ %&-line parsing enabled.
+entering extended mode
+(./tests/batch.tex
+ )
+No pages of output.
+Transcript written on batch.log.
+./etex --progname=etex --shell ./tests/write18 | grep echo
+(./tests/write18.texthis is write18 output from echo
+TEXMFCNF=../kpathsea \
+ ./etex --mltex --progname=einitex ./tests/mltextst
+This is e-TeX, Version 3.141592-2.2 (Web2C 7.5.5) (INITEX)
+MLTeX v2.2 enabled
+(./tests/mltextst.tex
+
+Test for bugs in MLTeX (1995/12/07 v1.2 [br])
+
+
+..... Ok, this is a newer MLTeX version (>= 2.0).
+
+
+..... If there will be an error "Bad metric (TFM) file",
+..... please update to the newest MLTeX version!
+
+..... Good, no "Bad metric (TFM) file" bug,
+..... seems to be the a MLTeX version > 2.01.
+
+
+...... Seems to be MLTeX version 2.2 (released Dec. 1995).
+
+Congratulations, you have a MLTeX version with all known bugs fixed.
+
+ )
+(see the transcript file for additional information)
+No pages of output.
+Transcript written on mltextst.log.
+./etex --progname=etex </dev/null
+This is e-TeXk, Version 3.141592-2.2 (Web2C 7.5.5)
+ %&-line parsing enabled.
+**
+! End of file on the terminal... why?
+PATH=`pwd`:../kpathsea:./../kpathsea:$PATH \
+ WEB2C=./../kpathsea TMPDIR=.. \
+ ./etex --progname=etex '\nonstopmode\font\foo=nonesuch\end'
+This is e-TeXk, Version 3.141592-2.2 (Web2C 7.5.5)
+ %&-line parsing enabled.
+entering extended mode
+
+! Font \foo=nonesuch not loadable: Metric (TFM) file not found.
+<to be read again>
+ \end
+<*> \nonstopmode\font\foo=nonesuch\end
+
+(see the transcript file for additional information)
+No pages of output.
+Transcript written on texput.log.
+make[1]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c'
diff --git a/Build/source/texk/web2c/tests/cmr10.600gf b/Build/source/texk/web2c/tests/cmr10.600gf
new file mode 100644
index 00000000000..d888fae96fd
--- /dev/null
+++ b/Build/source/texk/web2c/tests/cmr10.600gf
Binary files differ
diff --git a/Build/source/texk/web2c/tests/cmr10.pk b/Build/source/texk/web2c/tests/cmr10.pk
new file mode 100644
index 00000000000..32507a5d9d6
--- /dev/null
+++ b/Build/source/texk/web2c/tests/cmr10.pk
Binary files differ
diff --git a/Build/source/texk/web2c/tests/cmr10.pl b/Build/source/texk/web2c/tests/cmr10.pl
new file mode 100644
index 00000000000..29882e52925
--- /dev/null
+++ b/Build/source/texk/web2c/tests/cmr10.pl
@@ -0,0 +1,980 @@
+(FAMILY CMR)
+(FACE O 352)
+(CODINGSCHEME TEX TEXT)
+(DESIGNSIZE R 10.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM O 11374260171)
+(FONTDIMEN
+ (SLANT R 0.0)
+ (SPACE R 0.333334)
+ (STRETCH R 0.166667)
+ (SHRINK R 0.111112)
+ (XHEIGHT R 0.430555)
+ (QUAD R 1.000003)
+ (EXTRASPACE R 0.111112)
+ )
+(LIGTABLE
+ (LABEL O 40)
+ (KRN C l R -0.277779)
+ (KRN C L R -0.319446)
+ (STOP)
+ (LABEL C f)
+ (LIG C i O 14)
+ (LIG C f O 13)
+ (LIG C l O 15)
+ (KRN O 47 R 0.077779)
+ (KRN O 77 R 0.077779)
+ (KRN O 41 R 0.077779)
+ (KRN O 51 R 0.077779)
+ (KRN O 135 R 0.077779)
+ (STOP)
+ (LABEL O 13)
+ (LIG C i O 16)
+ (LIG C l O 17)
+ (KRN O 47 R 0.077779)
+ (KRN O 77 R 0.077779)
+ (KRN O 41 R 0.077779)
+ (KRN O 51 R 0.077779)
+ (KRN O 135 R 0.077779)
+ (STOP)
+ (LABEL O 140)
+ (LIG O 140 O 134)
+ (STOP)
+ (LABEL O 47)
+ (LIG O 47 O 42)
+ (KRN O 77 R 0.111112)
+ (KRN O 41 R 0.111112)
+ (STOP)
+ (LABEL O 55)
+ (LIG O 55 O 173)
+ (STOP)
+ (LABEL O 173)
+ (LIG O 55 O 174)
+ (STOP)
+ (LABEL O 41)
+ (LIG O 140 O 74)
+ (STOP)
+ (LABEL O 77)
+ (LIG O 140 O 76)
+ (STOP)
+ (LABEL C k)
+ (LABEL C v)
+ (KRN C a R -0.055555)
+ (LABEL C w)
+ (KRN C e R -0.027779)
+ (KRN C a R -0.027779)
+ (KRN C o R -0.027779)
+ (KRN C c R -0.027779)
+ (STOP)
+ (LABEL C P)
+ (KRN C A R -0.083334)
+ (LABEL C y)
+ (KRN C o R -0.027779)
+ (KRN C e R -0.027779)
+ (KRN C a R -0.027779)
+ (KRN O 56 R -0.083334)
+ (KRN O 54 R -0.083334)
+ (STOP)
+ (LABEL C F)
+ (LABEL C V)
+ (LABEL C W)
+ (KRN C o R -0.083334)
+ (KRN C e R -0.083334)
+ (KRN C u R -0.083334)
+ (KRN C r R -0.083334)
+ (KRN C a R -0.083334)
+ (KRN C A R -0.111112)
+ (LABEL C K)
+ (LABEL C X)
+ (KRN C O R -0.027779)
+ (KRN C C R -0.027779)
+ (KRN C G R -0.027779)
+ (KRN C Q R -0.027779)
+ (STOP)
+ (LABEL C T)
+ (KRN C y R -0.027779)
+ (LABEL C Y)
+ (KRN C e R -0.083334)
+ (KRN C o R -0.083334)
+ (KRN C r R -0.083334)
+ (KRN C a R -0.083334)
+ (KRN C A R -0.083334)
+ (KRN C u R -0.083334)
+ (STOP)
+ (LABEL C D)
+ (LABEL C O)
+ (KRN C X R -0.027779)
+ (KRN C W R -0.027779)
+ (KRN C A R -0.027779)
+ (KRN C V R -0.027779)
+ (KRN C Y R -0.027779)
+ (STOP)
+ (LABEL C h)
+ (LABEL C m)
+ (LABEL C n)
+ (KRN C t R -0.027779)
+ (KRN C u R -0.027779)
+ (KRN C b R -0.027779)
+ (KRN C y R -0.027779)
+ (KRN C v R -0.027779)
+ (KRN C w R -0.027779)
+ (STOP)
+ (LABEL C c)
+ (KRN C h R -0.027779)
+ (KRN C k R -0.027779)
+ (STOP)
+ (LABEL C b)
+ (LABEL C o)
+ (LABEL C p)
+ (KRN C e R 0.027779)
+ (KRN C o R 0.027779)
+ (KRN C x R -0.027779)
+ (KRN C d R 0.027779)
+ (KRN C c R 0.027779)
+ (KRN C q R 0.027779)
+ (LABEL C a)
+ (KRN C v R -0.027779)
+ (KRN C j R 0.055555)
+ (LABEL C t)
+ (KRN C y R -0.027779)
+ (LABEL C u)
+ (KRN C w R -0.027779)
+ (STOP)
+ (LABEL C A)
+ (LABEL C R)
+ (KRN C t R -0.027779)
+ (KRN C C R -0.027779)
+ (KRN C O R -0.027779)
+ (KRN C G R -0.027779)
+ (KRN C U R -0.027779)
+ (KRN C Q R -0.027779)
+ (LABEL C L)
+ (KRN C T R -0.083334)
+ (KRN C Y R -0.083334)
+ (KRN C V R -0.111112)
+ (KRN C W R -0.111112)
+ (STOP)
+ (LABEL C g)
+ (KRN C j R 0.027779)
+ (STOP)
+ (LABEL C I)
+ (KRN C I R 0.027779)
+ (STOP)
+ )
+(CHARACTER O 0
+ (CHARWD R 0.625002)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 1
+ (CHARWD R 0.833336)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 2
+ (CHARWD R 0.777781)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 3
+ (CHARWD R 0.694446)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 4
+ (CHARWD R 0.666669)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 5
+ (CHARWD R 0.750002)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 6
+ (CHARWD R 0.722224)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 7
+ (CHARWD R 0.777781)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 10
+ (CHARWD R 0.722224)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 11
+ (CHARWD R 0.777781)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 12
+ (CHARWD R 0.722224)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 13
+ (CHARWD R 0.583336)
+ (CHARHT R 0.694445)
+ (CHARIC R 0.077779)
+ (COMMENT
+ (LIG C i O 16)
+ (LIG C l O 17)
+ (KRN O 47 R 0.077779)
+ (KRN O 77 R 0.077779)
+ (KRN O 41 R 0.077779)
+ (KRN O 51 R 0.077779)
+ (KRN O 135 R 0.077779)
+ )
+ )
+(CHARACTER O 14
+ (CHARWD R 0.555557)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 15
+ (CHARWD R 0.555557)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 16
+ (CHARWD R 0.833336)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 17
+ (CHARWD R 0.833336)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 20
+ (CHARWD R 0.277779)
+ (CHARHT R 0.430555)
+ )
+(CHARACTER O 21
+ (CHARWD R 0.305557)
+ (CHARHT R 0.430555)
+ (CHARDP R 0.194445)
+ )
+(CHARACTER O 22
+ (CHARWD R 0.500002)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 23
+ (CHARWD R 0.500002)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 24
+ (CHARWD R 0.500002)
+ (CHARHT R 0.628473)
+ )
+(CHARACTER O 25
+ (CHARWD R 0.500002)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 26
+ (CHARWD R 0.500002)
+ (CHARHT R 0.567777)
+ )
+(CHARACTER O 27
+ (CHARWD R 0.750002)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 30
+ (CHARWD R 0.444446)
+ (CHARDP R 0.170138)
+ )
+(CHARACTER O 31
+ (CHARWD R 0.500003)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 32
+ (CHARWD R 0.722224)
+ (CHARHT R 0.430555)
+ )
+(CHARACTER O 33
+ (CHARWD R 0.777781)
+ (CHARHT R 0.430555)
+ )
+(CHARACTER O 34
+ (CHARWD R 0.500002)
+ (CHARHT R 0.527779)
+ (CHARDP R 0.097223)
+ )
+(CHARACTER O 35
+ (CHARWD R 0.902781)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 36
+ (CHARWD R 1.013891)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 37
+ (CHARWD R 0.777781)
+ (CHARHT R 0.731944)
+ (CHARDP R 0.048612)
+ )
+(CHARACTER O 40
+ (CHARWD R 0.277779)
+ (CHARHT R 0.430555)
+ (COMMENT
+ (KRN C l R -0.277779)
+ (KRN C L R -0.319446)
+ )
+ )
+(CHARACTER O 41
+ (CHARWD R 0.277779)
+ (CHARHT R 0.694445)
+ (COMMENT
+ (LIG O 140 O 74)
+ )
+ )
+(CHARACTER O 42
+ (CHARWD R 0.500002)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 43
+ (CHARWD R 0.833336)
+ (CHARHT R 0.694445)
+ (CHARDP R 0.194443)
+ )
+(CHARACTER O 44
+ (CHARWD R 0.500002)
+ (CHARHT R 0.75)
+ (CHARDP R 0.055555)
+ )
+(CHARACTER O 45
+ (CHARWD R 0.833336)
+ (CHARHT R 0.75)
+ (CHARDP R 0.055555)
+ )
+(CHARACTER O 46
+ (CHARWD R 0.777781)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 47
+ (CHARWD R 0.277779)
+ (CHARHT R 0.694445)
+ (COMMENT
+ (LIG O 47 O 42)
+ (KRN O 77 R 0.111112)
+ (KRN O 41 R 0.111112)
+ )
+ )
+(CHARACTER O 50
+ (CHARWD R 0.38889)
+ (CHARHT R 0.75)
+ (CHARDP R 0.25)
+ )
+(CHARACTER O 51
+ (CHARWD R 0.38889)
+ (CHARHT R 0.75)
+ (CHARDP R 0.25)
+ )
+(CHARACTER O 52
+ (CHARWD R 0.500002)
+ (CHARHT R 0.75)
+ )
+(CHARACTER O 53
+ (CHARWD R 0.777781)
+ (CHARHT R 0.583334)
+ (CHARDP R 0.083334)
+ )
+(CHARACTER O 54
+ (CHARWD R 0.277779)
+ (CHARHT R 0.105556)
+ (CHARDP R 0.194445)
+ )
+(CHARACTER O 55
+ (CHARWD R 0.333334)
+ (CHARHT R 0.430555)
+ (COMMENT
+ (LIG O 55 O 173)
+ )
+ )
+(CHARACTER O 56
+ (CHARWD R 0.277779)
+ (CHARHT R 0.105556)
+ )
+(CHARACTER O 57
+ (CHARWD R 0.500002)
+ (CHARHT R 0.75)
+ (CHARDP R 0.25)
+ )
+(CHARACTER C 0
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER C 1
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER C 2
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER C 3
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER C 4
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER C 5
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER C 6
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER C 7
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER C 8
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER C 9
+ (CHARWD R 0.500002)
+ (CHARHT R 0.644444)
+ )
+(CHARACTER O 72
+ (CHARWD R 0.277779)
+ (CHARHT R 0.430555)
+ )
+(CHARACTER O 73
+ (CHARWD R 0.277779)
+ (CHARHT R 0.430555)
+ (CHARDP R 0.194445)
+ )
+(CHARACTER O 74
+ (CHARWD R 0.277779)
+ (CHARHT R 0.5)
+ (CHARDP R 0.194445)
+ )
+(CHARACTER O 75
+ (CHARWD R 0.777781)
+ (CHARHT R 0.366875)
+ (CHARDP R -0.133125)
+ )
+(CHARACTER O 76
+ (CHARWD R 0.472224)
+ (CHARHT R 0.5)
+ (CHARDP R 0.194445)
+ )
+(CHARACTER O 77
+ (CHARWD R 0.472224)
+ (CHARHT R 0.694445)
+ (COMMENT
+ (LIG O 140 O 76)
+ )
+ )
+(CHARACTER O 100
+ (CHARWD R 0.777781)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER C A
+ (CHARWD R 0.750002)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C t R -0.027779)
+ (KRN C C R -0.027779)
+ (KRN C O R -0.027779)
+ (KRN C G R -0.027779)
+ (KRN C U R -0.027779)
+ (KRN C Q R -0.027779)
+ (KRN C T R -0.083334)
+ (KRN C Y R -0.083334)
+ (KRN C V R -0.111112)
+ (KRN C W R -0.111112)
+ )
+ )
+(CHARACTER C B
+ (CHARWD R 0.708336)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C C
+ (CHARWD R 0.722224)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C D
+ (CHARWD R 0.763891)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C X R -0.027779)
+ (KRN C W R -0.027779)
+ (KRN C A R -0.027779)
+ (KRN C V R -0.027779)
+ (KRN C Y R -0.027779)
+ )
+ )
+(CHARACTER C E
+ (CHARWD R 0.680557)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C F
+ (CHARWD R 0.652781)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C o R -0.083334)
+ (KRN C e R -0.083334)
+ (KRN C u R -0.083334)
+ (KRN C r R -0.083334)
+ (KRN C a R -0.083334)
+ (KRN C A R -0.111112)
+ (KRN C O R -0.027779)
+ (KRN C C R -0.027779)
+ (KRN C G R -0.027779)
+ (KRN C Q R -0.027779)
+ )
+ )
+(CHARACTER C G
+ (CHARWD R 0.784724)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C H
+ (CHARWD R 0.750002)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C I
+ (CHARWD R 0.361112)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C I R 0.027779)
+ )
+ )
+(CHARACTER C J
+ (CHARWD R 0.51389)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C K
+ (CHARWD R 0.777781)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C O R -0.027779)
+ (KRN C C R -0.027779)
+ (KRN C G R -0.027779)
+ (KRN C Q R -0.027779)
+ )
+ )
+(CHARACTER C L
+ (CHARWD R 0.625002)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C T R -0.083334)
+ (KRN C Y R -0.083334)
+ (KRN C V R -0.111112)
+ (KRN C W R -0.111112)
+ )
+ )
+(CHARACTER C M
+ (CHARWD R 0.916669)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C N
+ (CHARWD R 0.750002)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C O
+ (CHARWD R 0.777781)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C X R -0.027779)
+ (KRN C W R -0.027779)
+ (KRN C A R -0.027779)
+ (KRN C V R -0.027779)
+ (KRN C Y R -0.027779)
+ )
+ )
+(CHARACTER C P
+ (CHARWD R 0.680557)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C A R -0.083334)
+ (KRN C o R -0.027779)
+ (KRN C e R -0.027779)
+ (KRN C a R -0.027779)
+ (KRN O 56 R -0.083334)
+ (KRN O 54 R -0.083334)
+ )
+ )
+(CHARACTER C Q
+ (CHARWD R 0.777781)
+ (CHARHT R 0.683332)
+ (CHARDP R 0.194445)
+ )
+(CHARACTER C R
+ (CHARWD R 0.736113)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C t R -0.027779)
+ (KRN C C R -0.027779)
+ (KRN C O R -0.027779)
+ (KRN C G R -0.027779)
+ (KRN C U R -0.027779)
+ (KRN C Q R -0.027779)
+ (KRN C T R -0.083334)
+ (KRN C Y R -0.083334)
+ (KRN C V R -0.111112)
+ (KRN C W R -0.111112)
+ )
+ )
+(CHARACTER C S
+ (CHARWD R 0.555557)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C T
+ (CHARWD R 0.722224)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C y R -0.027779)
+ (KRN C e R -0.083334)
+ (KRN C o R -0.083334)
+ (KRN C r R -0.083334)
+ (KRN C a R -0.083334)
+ (KRN C A R -0.083334)
+ (KRN C u R -0.083334)
+ )
+ )
+(CHARACTER C U
+ (CHARWD R 0.750002)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER C V
+ (CHARWD R 0.750002)
+ (CHARHT R 0.683332)
+ (CHARIC R 0.013888)
+ (COMMENT
+ (KRN C o R -0.083334)
+ (KRN C e R -0.083334)
+ (KRN C u R -0.083334)
+ (KRN C r R -0.083334)
+ (KRN C a R -0.083334)
+ (KRN C A R -0.111112)
+ (KRN C O R -0.027779)
+ (KRN C C R -0.027779)
+ (KRN C G R -0.027779)
+ (KRN C Q R -0.027779)
+ )
+ )
+(CHARACTER C W
+ (CHARWD R 1.027781)
+ (CHARHT R 0.683332)
+ (CHARIC R 0.013888)
+ (COMMENT
+ (KRN C o R -0.083334)
+ (KRN C e R -0.083334)
+ (KRN C u R -0.083334)
+ (KRN C r R -0.083334)
+ (KRN C a R -0.083334)
+ (KRN C A R -0.111112)
+ (KRN C O R -0.027779)
+ (KRN C C R -0.027779)
+ (KRN C G R -0.027779)
+ (KRN C Q R -0.027779)
+ )
+ )
+(CHARACTER C X
+ (CHARWD R 0.750002)
+ (CHARHT R 0.683332)
+ (COMMENT
+ (KRN C O R -0.027779)
+ (KRN C C R -0.027779)
+ (KRN C G R -0.027779)
+ (KRN C Q R -0.027779)
+ )
+ )
+(CHARACTER C Y
+ (CHARWD R 0.750002)
+ (CHARHT R 0.683332)
+ (CHARIC R 0.025)
+ (COMMENT
+ (KRN C e R -0.083334)
+ (KRN C o R -0.083334)
+ (KRN C r R -0.083334)
+ (KRN C a R -0.083334)
+ (KRN C A R -0.083334)
+ (KRN C u R -0.083334)
+ )
+ )
+(CHARACTER C Z
+ (CHARWD R 0.611113)
+ (CHARHT R 0.683332)
+ )
+(CHARACTER O 133
+ (CHARWD R 0.277779)
+ (CHARHT R 0.75)
+ (CHARDP R 0.25)
+ )
+(CHARACTER O 134
+ (CHARWD R 0.500002)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 135
+ (CHARWD R 0.277779)
+ (CHARHT R 0.75)
+ (CHARDP R 0.25)
+ )
+(CHARACTER O 136
+ (CHARWD R 0.500002)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 137
+ (CHARWD R 0.277779)
+ (CHARHT R 0.667859)
+ )
+(CHARACTER O 140
+ (CHARWD R 0.277779)
+ (CHARHT R 0.694445)
+ (COMMENT
+ (LIG O 140 O 134)
+ )
+ )
+(CHARACTER C a
+ (CHARWD R 0.500002)
+ (CHARHT R 0.430555)
+ (COMMENT
+ (KRN C v R -0.027779)
+ (KRN C j R 0.055555)
+ (KRN C y R -0.027779)
+ (KRN C w R -0.027779)
+ )
+ )
+(CHARACTER C b
+ (CHARWD R 0.555557)
+ (CHARHT R 0.694445)
+ (COMMENT
+ (KRN C e R 0.027779)
+ (KRN C o R 0.027779)
+ (KRN C x R -0.027779)
+ (KRN C d R 0.027779)
+ (KRN C c R 0.027779)
+ (KRN C q R 0.027779)
+ (KRN C v R -0.027779)
+ (KRN C j R 0.055555)
+ (KRN C y R -0.027779)
+ (KRN C w R -0.027779)
+ )
+ )
+(CHARACTER C c
+ (CHARWD R 0.444446)
+ (CHARHT R 0.430555)
+ (COMMENT
+ (KRN C h R -0.027779)
+ (KRN C k R -0.027779)
+ )
+ )
+(CHARACTER C d
+ (CHARWD R 0.555557)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER C e
+ (CHARWD R 0.444446)
+ (CHARHT R 0.430555)
+ )
+(CHARACTER C f
+ (CHARWD R 0.305557)
+ (CHARHT R 0.694445)
+ (CHARIC R 0.077779)
+ (COMMENT
+ (LIG C i O 14)
+ (LIG C f O 13)
+ (LIG C l O 15)
+ (KRN O 47 R 0.077779)
+ (KRN O 77 R 0.077779)
+ (KRN O 41 R 0.077779)
+ (KRN O 51 R 0.077779)
+ (KRN O 135 R 0.077779)
+ )
+ )
+(CHARACTER C g
+ (CHARWD R 0.500002)
+ (CHARHT R 0.430555)
+ (CHARDP R 0.194445)
+ (CHARIC R 0.013888)
+ (COMMENT
+ (KRN C j R 0.027779)
+ )
+ )
+(CHARACTER C h
+ (CHARWD R 0.555557)
+ (CHARHT R 0.694445)
+ (COMMENT
+ (KRN C t R -0.027779)
+ (KRN C u R -0.027779)
+ (KRN C b R -0.027779)
+ (KRN C y R -0.027779)
+ (KRN C v R -0.027779)
+ (KRN C w R -0.027779)
+ )
+ )
+(CHARACTER C i
+ (CHARWD R 0.277779)
+ (CHARHT R 0.667859)
+ )
+(CHARACTER C j
+ (CHARWD R 0.305557)
+ (CHARHT R 0.667859)
+ (CHARDP R 0.194445)
+ )
+(CHARACTER C k
+ (CHARWD R 0.527781)
+ (CHARHT R 0.694445)
+ (COMMENT
+ (KRN C a R -0.055555)
+ (KRN C e R -0.027779)
+ (KRN C a R -0.027779)
+ (KRN C o R -0.027779)
+ (KRN C c R -0.027779)
+ )
+ )
+(CHARACTER C l
+ (CHARWD R 0.277779)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER C m
+ (CHARWD R 0.833336)
+ (CHARHT R 0.430555)
+ (COMMENT
+ (KRN C t R -0.027779)
+ (KRN C u R -0.027779)
+ (KRN C b R -0.027779)
+ (KRN C y R -0.027779)
+ (KRN C v R -0.027779)
+ (KRN C w R -0.027779)
+ )
+ )
+(CHARACTER C n
+ (CHARWD R 0.555557)
+ (CHARHT R 0.430555)
+ (COMMENT
+ (KRN C t R -0.027779)
+ (KRN C u R -0.027779)
+ (KRN C b R -0.027779)
+ (KRN C y R -0.027779)
+ (KRN C v R -0.027779)
+ (KRN C w R -0.027779)
+ )
+ )
+(CHARACTER C o
+ (CHARWD R 0.500002)
+ (CHARHT R 0.430555)
+ (COMMENT
+ (KRN C e R 0.027779)
+ (KRN C o R 0.027779)
+ (KRN C x R -0.027779)
+ (KRN C d R 0.027779)
+ (KRN C c R 0.027779)
+ (KRN C q R 0.027779)
+ (KRN C v R -0.027779)
+ (KRN C j R 0.055555)
+ (KRN C y R -0.027779)
+ (KRN C w R -0.027779)
+ )
+ )
+(CHARACTER C p
+ (CHARWD R 0.555557)
+ (CHARHT R 0.430555)
+ (CHARDP R 0.194445)
+ (COMMENT
+ (KRN C e R 0.027779)
+ (KRN C o R 0.027779)
+ (KRN C x R -0.027779)
+ (KRN C d R 0.027779)
+ (KRN C c R 0.027779)
+ (KRN C q R 0.027779)
+ (KRN C v R -0.027779)
+ (KRN C j R 0.055555)
+ (KRN C y R -0.027779)
+ (KRN C w R -0.027779)
+ )
+ )
+(CHARACTER C q
+ (CHARWD R 0.527779)
+ (CHARHT R 0.430555)
+ (CHARDP R 0.194445)
+ )
+(CHARACTER C r
+ (CHARWD R 0.391668)
+ (CHARHT R 0.430555)
+ )
+(CHARACTER C s
+ (CHARWD R 0.394445)
+ (CHARHT R 0.430555)
+ )
+(CHARACTER C t
+ (CHARWD R 0.38889)
+ (CHARHT R 0.61508)
+ (COMMENT
+ (KRN C y R -0.027779)
+ (KRN C w R -0.027779)
+ )
+ )
+(CHARACTER C u
+ (CHARWD R 0.555557)
+ (CHARHT R 0.430555)
+ (COMMENT
+ (KRN C w R -0.027779)
+ )
+ )
+(CHARACTER C v
+ (CHARWD R 0.527781)
+ (CHARHT R 0.430555)
+ (CHARIC R 0.013888)
+ (COMMENT
+ (KRN C a R -0.055555)
+ (KRN C e R -0.027779)
+ (KRN C a R -0.027779)
+ (KRN C o R -0.027779)
+ (KRN C c R -0.027779)
+ )
+ )
+(CHARACTER C w
+ (CHARWD R 0.722224)
+ (CHARHT R 0.430555)
+ (CHARIC R 0.013888)
+ (COMMENT
+ (KRN C e R -0.027779)
+ (KRN C a R -0.027779)
+ (KRN C o R -0.027779)
+ (KRN C c R -0.027779)
+ )
+ )
+(CHARACTER C x
+ (CHARWD R 0.527781)
+ (CHARHT R 0.430555)
+ )
+(CHARACTER C y
+ (CHARWD R 0.527781)
+ (CHARHT R 0.430555)
+ (CHARDP R 0.194445)
+ (CHARIC R 0.013888)
+ (COMMENT
+ (KRN C o R -0.027779)
+ (KRN C e R -0.027779)
+ (KRN C a R -0.027779)
+ (KRN O 56 R -0.083334)
+ (KRN O 54 R -0.083334)
+ )
+ )
+(CHARACTER C z
+ (CHARWD R 0.444446)
+ (CHARHT R 0.430555)
+ )
+(CHARACTER O 173
+ (CHARWD R 0.500002)
+ (CHARHT R 0.430555)
+ (CHARIC R 0.027779)
+ (COMMENT
+ (LIG O 55 O 174)
+ )
+ )
+(CHARACTER O 174
+ (CHARWD R 1.000003)
+ (CHARHT R 0.430555)
+ (CHARIC R 0.027779)
+ )
+(CHARACTER O 175
+ (CHARWD R 0.500002)
+ (CHARHT R 0.694445)
+ )
+(CHARACTER O 176
+ (CHARWD R 0.500002)
+ (CHARHT R 0.667859)
+ )
+(CHARACTER O 177
+ (CHARWD R 0.500002)
+ (CHARHT R 0.667859)
+ )
diff --git a/Build/source/texk/web2c/tests/cmr10.tfm b/Build/source/texk/web2c/tests/cmr10.tfm
new file mode 100644
index 00000000000..168c9544095
--- /dev/null
+++ b/Build/source/texk/web2c/tests/cmr10.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/cmr7.tfm b/Build/source/texk/web2c/tests/cmr7.tfm
new file mode 100644
index 00000000000..cbdf3614d03
--- /dev/null
+++ b/Build/source/texk/web2c/tests/cmr7.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/cmr8.tfm b/Build/source/texk/web2c/tests/cmr8.tfm
new file mode 100644
index 00000000000..98f08da077b
--- /dev/null
+++ b/Build/source/texk/web2c/tests/cmr8.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/cmti10.tfm b/Build/source/texk/web2c/tests/cmti10.tfm
new file mode 100644
index 00000000000..419af0d070d
--- /dev/null
+++ b/Build/source/texk/web2c/tests/cmti10.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/cmtt10.tfm b/Build/source/texk/web2c/tests/cmtt10.tfm
new file mode 100644
index 00000000000..12df934421b
--- /dev/null
+++ b/Build/source/texk/web2c/tests/cmtt10.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/cmtt8.tfm b/Build/source/texk/web2c/tests/cmtt8.tfm
new file mode 100644
index 00000000000..b1ad4c40e74
--- /dev/null
+++ b/Build/source/texk/web2c/tests/cmtt8.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/dict b/Build/source/texk/web2c/tests/dict
new file mode 100644
index 00000000000..9efc9df8dae
--- /dev/null
+++ b/Build/source/texk/web2c/tests/dict
@@ -0,0 +1,58 @@
+"abil-i-ty
+"ab-s`en"c`e
+"ab-str"a"ct
+ an empty line (ignored)
+1 a lone global word weight (ignored since no change)
+- a lone hyphen (ignored)
+-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa- a very long word
+-"a"c-"a-d`em-i"c- hyphens at start and end ignored
+"a"c-"c`ept
+"a"c-"c`ept-"abl`e
+"a"c-"c`ept*`e.d found and erroneous hyphens ignored
+"a"c"c-d`ef
+"a"c"c-dxy
+"a"c"cduv
+"ad"c-d`ef
+"ad"c-dxy
+"ad"cduv
+"a`e"c-duf
+"a`e"c-dxy
+"a`e"cduv
+"af"c-d`ef
+"af"c-duy
+"af"cduv
+"ag"c-d`ef
+"ag"c-dxy
+"ag"cduv
+"ah"c-d`ef
+"ah"c-dxy
+"ah"cduv
+"ai"c-duf
+"ai"c-dxy
+"ai"cduv
+"aj"c-d`ef
+"aj"c-duy
+"aj"cduv
+"ak"c-d`ef
+"ak"c-dxy
+"ak"cduv
+"al"c-d`ef
+"al"c-dxy
+"al"cduv
+"am"c-duf
+"am"c-dxy
+"am"cduv
+"an"c-d`ef
+"an"c-duy
+"an"cduv
+bg"cd`ef
+bg"cduv
+bg"cduy
+bg"cdxy
+Stra-áe
+Stra-"se
+Stra-"Se
+Stra-\ss e
+xi-tt
+xi-t
+i-tt
diff --git a/Build/source/texk/web2c/tests/eight.tex b/Build/source/texk/web2c/tests/eight.tex
new file mode 100644
index 00000000000..90bf2592d7f
--- /dev/null
+++ b/Build/source/texk/web2c/tests/eight.tex
Binary files differ
diff --git a/Build/source/texk/web2c/tests/end.tex b/Build/source/texk/web2c/tests/end.tex
new file mode 100644
index 00000000000..b32cbf35f34
--- /dev/null
+++ b/Build/source/texk/web2c/tests/end.tex
@@ -0,0 +1 @@
+\end
diff --git a/Build/source/texk/web2c/tests/exampl.aux b/Build/source/texk/web2c/tests/exampl.aux
new file mode 100644
index 00000000000..40dee813564
--- /dev/null
+++ b/Build/source/texk/web2c/tests/exampl.aux
@@ -0,0 +1,45 @@
+\bibdata{xampl}
+\@citedef{article-minimal}{Aamport, 1986a}
+\@citedef{article-full}{Aamport, 1986b}
+\@citedef{article-crossref}{Aamport, 1986c}
+\citation{whole-journal}
+\@citedef{whole-journal}{GAJ, 1986}
+\@citedef{whole-set}{Knuth, 1968}
+\@citedef{inbook-minimal}{Knuth, 1973a}
+\@citedef{inbook-full}{Knuth, 1973b}
+\@citedef{inbook-crossref}{Knuth, 1973c}
+\citation{whole-set}
+\@citedef{book-full}{Knuth, 1981a}
+\@citedef{book-minimal}{Knuth, 1981b}
+\@citedef{book-crossref}{Knuth, 1981c}
+\citation{whole-set}
+\@citedef{booklet-minimal}{Kn{v}, }
+\@citedef{booklet-full}{Knvth, 1988}
+\@citedef{incollection-minimal}{Lincoll, 1977a}
+\@citedef{incollection-full}{Lincoll, 1977b}
+\@citedef{incollection-crossref}{Lincoll, 1977c}
+\citation{whole-collection}
+\@citedef{whole-collection}{Lipcoll et\penalty \@M \ al., 1977}
+\@citedef{manual-minimal}{Manmaker, }
+\@citedef{manual-full}{Manmaker, 1986}
+\@citedef{mastersthesis-minimal}{Masterly, 1988a}
+\@citedef{mastersthesis-full}{Masterly, 1988b}
+\@citedef{misc-minimal}{Missilany, }
+\@citedef{misc-full}{Missilany, 1984}
+\@citedef{inproceedings-minimal}{Oaho et\penalty \@M \ al., 1983a}
+\@citedef{inproceedings-full}{Oaho et\penalty \@M \ al., 1983b}
+\@citedef{inproceedings-crossref}{Oaho et\penalty \@M \ al., 1983c}
+\citation{whole-proceedings}
+\@citedef{whole-proceedings}{OX{stoc}, 1983a}
+\@citedef{proceedings-minimal}{OX{stoc}, 1983b}
+\@citedef{proceedings-full}{Oz and Yannakakis, 1983}
+\@citedef{phdthesis-minimal}{Phony-Baloney, 1988a}
+\@citedef{phdthesis-full}{Phony-Baloney, 1988b}
+\@citedef{techreport-minimal}{Terrific, 1988}
+\@citedef{techreport-full}{T{{\accent 19 e}}rrific, 1988}
+\@citedef{unpublished-minimal}{{{\accent "7F U}}nderwood et\penalty \@M \ al., }
+\@citedef{unpublished-full}{{{\accent "7F U}}nderwood et\penalty \@M \ al., 1988}
+\@citedef{random-note-crossref}{Volume-2, }
+\citation{book-full}
+\bibstyle{apalike}
+\citation{*}
diff --git a/Build/source/texk/web2c/tests/exampl.tex b/Build/source/texk/web2c/tests/exampl.tex
new file mode 100644
index 00000000000..ccd514c03e8
--- /dev/null
+++ b/Build/source/texk/web2c/tests/exampl.tex
@@ -0,0 +1,13 @@
+% Test xampl.bib.
+%
+%\ifx\undefined\eplain \input eplain \fi
+\input btxmac
+
+\let\mbox = \hbox
+
+\bibliography{xampl}
+\bibliographystyle{apalike}
+
+\nocite{*}
+
+\end
diff --git a/Build/source/texk/web2c/tests/gray.tfm b/Build/source/texk/web2c/tests/gray.tfm
new file mode 100644
index 00000000000..c496d2c99ff
--- /dev/null
+++ b/Build/source/texk/web2c/tests/gray.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/hello.tex b/Build/source/texk/web2c/tests/hello.tex
new file mode 100644
index 00000000000..672f06ba6fd
--- /dev/null
+++ b/Build/source/texk/web2c/tests/hello.tex
@@ -0,0 +1,2 @@
+Hello, world.
+\end
diff --git a/Build/source/texk/web2c/tests/io.mf b/Build/source/texk/web2c/tests/io.mf
new file mode 100644
index 00000000000..58a8be68db2
--- /dev/null
+++ b/Build/source/texk/web2c/tests/io.mf
@@ -0,0 +1,23 @@
+mode_setup;
+ em#:=10pt#; cap#:=7pt#;
+ thin#:=1/3pt#; thick#:=5/6pt#;
+ o#:=1/5pt#;
+define_pixels(em,cap);
+define_blacker_pixels(thin,thick);
+define_corrected_pixels(o);
+ curve_sidebar=round 1/18em;
+beginchar("O",0.8em#,cap#,0); "The letter O";
+ penpos1(thick,10); penpos2(.1[thin,thick],90-10);
+ penpos3(thick,180+10); penpos4(thin,270-10);
+ x1l=w-x3l=curve_sidebar; x2=x4=.5w;
+ y1=.49h; y2l=-o; y3=.51h; y4l=h+o;
+ penstroke z1e{down}..z2e{right}
+ ..z3e{up}..z4e{left}..cycle;
+ penlabels(1,2,3,4); endchar;
+def test_I(expr code,trial_stem,trial_width) =
+ stem#:=trial_stem*pt#; define_blacker_pixels(stem);
+ beginchar(code,trial_width*em#,cap#,0); "The letter I";
+ penpos1(stem,15); penpos2(.9stem,12); penpos3(stem,10);
+ x1=x2=x3=.5w; y1=h; y2=.55h; y3=0; x2l:=1/6[x2l,x2];
+ penstroke z1e..z2e{down}..z3e;
+ penlabels(1,2,3); endchar; enddef;
diff --git a/Build/source/texk/web2c/tests/just.texi b/Build/source/texk/web2c/tests/just.texi
new file mode 100644
index 00000000000..bed607e0f8e
--- /dev/null
+++ b/Build/source/texk/web2c/tests/just.texi
@@ -0,0 +1,2 @@
+% Output should be on just.log, etc., not just.texi.log.
+\end
diff --git a/Build/source/texk/web2c/tests/label.mp b/Build/source/texk/web2c/tests/label.mp
new file mode 100644
index 00000000000..a56f6f85d3a
--- /dev/null
+++ b/Build/source/texk/web2c/tests/label.mp
@@ -0,0 +1,4 @@
+beginfig (0);
+label (btex Ka etex, (0,0));
+endfig;
+bye.
diff --git a/Build/source/texk/web2c/tests/label.mpx b/Build/source/texk/web2c/tests/label.mpx
new file mode 100644
index 00000000000..5fca19c59f5
--- /dev/null
+++ b/Build/source/texk/web2c/tests/label.mpx
@@ -0,0 +1,11 @@
+% Written by DVItoMP, Version 0.63 (C version REPLACE-WITH-VERSION)
+begingroup save _p,_r,_s,_n; picture _p; _p=nullpicture;
+string _n[];
+vardef _s(expr _t,_f,_m,_x,_y)=
+ addto _p also _t infont _f scaled _m shifted (_x,_y); enddef;
+_n0="cmr10";
+_s("Ka",_n0,1.00000,0.0000,0.0000);
+setbounds _p to (0,0.0000)--(12.7301,0.0000)--
+ (12.7301,6.8078)--(0,6.8078)--cycle;
+_p endgroup
+mpxbreak
diff --git a/Build/source/texk/web2c/tests/logo8.tfm b/Build/source/texk/web2c/tests/logo8.tfm
new file mode 100644
index 00000000000..67785167506
--- /dev/null
+++ b/Build/source/texk/web2c/tests/logo8.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/longtfm.tex b/Build/source/texk/web2c/tests/longtfm.tex
new file mode 100644
index 00000000000..89e0a05642a
--- /dev/null
+++ b/Build/source/texk/web2c/tests/longtfm.tex
@@ -0,0 +1,5 @@
+\font\times = Palatino-Roman at 32pt % pplr8r has to be installed
+\nopagenumbers
+\times
+This is Palatino Roman.
+\bye
diff --git a/Build/source/texk/web2c/tests/magic.tex b/Build/source/texk/web2c/tests/magic.tex
new file mode 100644
index 00000000000..c141895d690
--- /dev/null
+++ b/Build/source/texk/web2c/tests/magic.tex
@@ -0,0 +1,3 @@
+%&foo
+hello
+\bye
diff --git a/Build/source/texk/web2c/tests/memtest.tex b/Build/source/texk/web2c/tests/memtest.tex
new file mode 100644
index 00000000000..2696da447b3
--- /dev/null
+++ b/Build/source/texk/web2c/tests/memtest.tex
@@ -0,0 +1,13 @@
+%% plain tex file for testing memory overflow
+\tracingstats=2
+\newcount\cnt
+\chardef\nil=0
+\cnt=0
+\let\tempa=\relax
+\setbox\nil\hbox{}
+\def\tempb{\copy\nil}
+\def\list{\tempa}
+\def\again{\xdef\list{\list\list}\let\tempa\tempb\leavevmode\list\vfill\eject
+ \let\tempa\relax\advance\cnt1 \ifnum\cnt>19 \let\again\relax\fi\again}
+\again
+\end
diff --git a/Build/source/texk/web2c/tests/mltextst.tex b/Build/source/texk/web2c/tests/mltextst.tex
new file mode 100644
index 00000000000..d7925fea208
--- /dev/null
+++ b/Build/source/texk/web2c/tests/mltextst.tex
@@ -0,0 +1,200 @@
+% This is MLTEXTST.TEX (Version 1.2) in text format, as of Dec 07, 1995.
+% Test file to check MLTeX implementations.
+%
+% Copyright (C) 1995 by B.Raichle; all rights are reserved.
+%
+% Usage:
+%
+% Run iniTeX on this file. Do not try to use plain-TeX or LaTeX.
+% Needs the font metric files: cmr10.tfm, cmti10.tfm
+%
+%
+% Changes:
+%
+% 95/12/05 v1.0
+% - initial version
+% 95/12/06 v1.1
+% - don't show tracing output
+% - \nonstopmode and additional test for bug 2.
+% 95/12/07 v1.2
+% - added MLTeX version numbers (and release dates)
+% - added test for MLTeX version 2.2
+%
+%
+% History of MLTeX for TeX 3.x:
+%
+% 90/04/02 Version ?? (for TeX 3.0)
+% \charsublist, \charsublistmax
+% ??/??/?? Version 1.0
+% 92/02/03 Version 2 (for TeX 3.1--3.141)
+% |effective_char| uses explicit font information
+% 93/10/29 Version 2.01
+% fix \*leaders problem
+% 95/12/06 Version 2.2 (for TeX 3.14159)
+% fix font loading bug
+% fix invalid |font_info| access
+% in work Version 3.0
+% complete re-implementation
+%
+%
+\catcode`\{=1 \catcode`\}=2 \catcode`\#=6
+%
+\immediate\write16{}
+\immediate\write16{Test for bugs in MLTeX (1995/12/07 v1.2 [br])}
+\immediate\write16{}
+%
+% check for plain-TeX:
+% we have to ensure that _no_ fonts are preloaded
+\expandafter\ifx\csname active\endcsname\relax \else
+ \message{Please (Ini)TeX this file, no plain-TeX, no LaTeX!}
+ \expandafter\endinput\expandafter\end\fi
+% check for MLTeX
+\expandafter\ifx\csname charsubdef\endcsname\relax
+ \message{This test file can only be used with MLTeX!}
+ \expandafter\endinput\fi
+%
+\nonstopmode
+%%%\tracingonline=1 \tracingoutput=1 \showboxbreadth=255
+%%%\tracinglostchars=100 \tracingcharsubdef=1
+\hsize=5in
+%
+%
+% 1. Check for bug accessing the wrong character metrics:
+% (in versions before Feb 1992)
+%
+\font\tenrm=cmr10\relax
+%
+% The group is only necessary, if you want to use this
+% test in your own macros. \charsubdefmax is saved
+% explicitly for very old versions of MLTeX which have
+% an additional bug when assigning this special integer.
+\begingroup
+ \count255=\charsubdefmax
+ \charsubdefmax=256 % enable all substitutions
+ % very old versions of MLTeX will
+ \charsubdef`\i=1 `\M % substitute "i" by "M"
+ \setbox0=\hbox{\tenrm i}% <-- here
+ \dimen0=\wd0 % get width of box (either "i" or "M")
+ % get width of "i"
+ \charsubdefmax=-1 % disable all substitutions
+ \setbox0=\hbox{\tenrm i}%
+ \dimen2=\wd0 % get width of box
+ % restore former value of \charsubdefmax
+ \charsubdefmax=\count255
+\expandafter\endgroup
+\ifdim\dimen0=\dimen2\relax
+ \immediate\write16{..... Ok, this is a newer MLTeX version (>= 2.0).}
+ \immediate\write16{}
+\else
+ \immediate\write16{%
+..... This is a very old version of MLTeX < 2.0 (released before Feb. 1992)}
+ \immediate\write16{%
+..... immediately update to the newest MLTeX version!}
+ \immediate\write16{}
+ \expandafter\endinput\expandafter\end
+\fi
+%
+%
+% 2. Check for font loading bug:
+% (in versions before Dec 1995)
+%
+% - Define a \charsubdef of an existing character with
+% a non-existing base character
+%
+\charsubdef `A=`a 128
+%%%\message{now: \string\charsubdefmax=\number\charsubdefmax}
+%
+% - now load font (do not preload this font!!!!!!)
+%
+\immediate\write16{}
+\immediate\write16{..... If there will be an error "Bad metric (TFM) file",}
+\immediate\write16{..... please update to the newest MLTeX version!}
+\immediate\write16{}
+\font\test=cmti10\relax
+\begingroup
+ \setbox0=\hbox{\test A}
+\expandafter\endgroup
+\ifdim\wd0>0pt\relax \else
+ \immediate\write16{}
+ \immediate\write16{%
+..... This seems to be MLTeX version 2.0 or 2.01 (released before Dec. 1995)}
+ \immediate\write16{%
+..... this version has bugs,}
+ \immediate\write16{%
+..... please update to the newest MLTeX version!}
+ \immediate\write16{}
+ \expandafter\endinput\expandafter\end
+\fi
+\immediate\write16{..... Good, no "Bad metric (TFM) file" bug,}
+\immediate\write16{..... seems to be the a MLTeX version > 2.01.}
+%
+%
+% 3. Check for invalid |font_info| access:
+%
+\immediate\write16{}
+\font\tenrm=cmr10\relax
+%
+\setbox0=\hbox{\tenrm \char`a}\dimen1=\wd0
+\setbox0=\hbox{\tenrm \char`M}\dimen3=\wd0
+\setbox0=\hbox{\tenrm \char0}\dimen5=\wd0
+%
+\charsubdef 128=`a `a
+\setbox0=\hbox{\tenrm \char128}
+\dimen0=\wd0 % get width of `a
+%
+% Now the \charsubdef is changed using
+% an existing base character:
+\charsubdef 128=`a `M
+\setbox0=\hbox{\unhbox0}
+\dimen2=\wd0 % get width of `a or `M
+%
+% And then we remove it. MLTeX will try to access the 128th
+% entry in the |char_base| array, which is the first entry in
+% the width index array.
+% For MLTeX 2.2 this was "fixed", now it will report a warning
+% "Missing char... no substitution for ..." and MLTeX will use
+% the first character of the font.
+\charsubdefmax=-1
+\setbox0=\hbox{\unhbox0}%
+\dimen4=\wd0
+%
+%%%\message{\the\dimen0-\the\dimen1-\the\dimen2-\the\dimen3-%
+%%% \the\dimen4-\the\dimen5-}
+%
+\def\x#1\fi\fi{\fi\fi#1}
+\ifdim\dimen0=\dimen2\relax \ifdim\dimen0=\dimen4\relax
+ \immediate\write16{}
+ \immediate\write16{%
+...... Seems to be MLTeX version 3.x (unreleased),}
+ \immediate\write16{%
+...... from whom did you get this version? :-)}
+ \immediate\write16{}
+ \immediate\write16{%
+Congratulations, you have the best MLTeX version!}
+ \immediate\write16{}
+ \x{\endinput\csname end\endcsname}%
+\fi\fi
+%
+\def\x#1\fi{\fi#1}
+\ifdim\dimen4=\dimen5\relax \else
+ \immediate\write16{}
+ \immediate\write16{%
+..... Seems to be MLTeX version 2.0 or 2.01 (released before Dec. 1995)}
+ \immediate\write16{%
+..... this version has bugs,}
+ \immediate\write16{%
+..... please update to the newest MLTeX version!}
+ \immediate\write16{}
+ \expandafter\endinput\expandafter\end
+\fi
+%
+\immediate\write16{}
+\immediate\write16{%
+...... Seems to be MLTeX version 2.2 (released Dec. 1995).}
+\immediate\write16{}
+\immediate\write16{%
+Congratulations, you have a MLTeX version with all known bugs fixed.}
+\immediate\write16{}
+\end
+%
+%%% END OF FILE %%%
diff --git a/Build/source/texk/web2c/tests/mptest.mp b/Build/source/texk/web2c/tests/mptest.mp
new file mode 100644
index 00000000000..8136c5f4d98
--- /dev/null
+++ b/Build/source/texk/web2c/tests/mptest.mp
@@ -0,0 +1,45 @@
+% bug-test.mp -- Test for the presence or absence of known bugs.
+%
+% Ulrik Vieth, 1996/12/03.
+%
+
+% * String length bug: (reported to tex-implementors, 12/95)
+%
+% - if buggy, a string consisting of a single tab char |"^^I"|
+% is reported to have length 3 instead of length 1
+
+def show_length(expr s) =
+ message("Length of string " & ditto & s & ditto);
+ message("==> " & decimal(length(s)));
+enddef;
+
+message("* Test for string length bug:");
+
+string s; s=char(9);
+show_length(s);
+
+string t; t=" "; % <-- tab char
+show_length(t);
+
+
+% * 8-bit chars in |btex ... etex|: (metafont@ens.fr, 11/95)
+%
+% - if buggy, MP will complain about "Invalid character"
+%
+% (unfortunately can't assume dcr1000 is available; punt for now --karl.)
+
+%message("* Test for 8-bit chars in btex...etex:");
+%verbatimtex \font\dcr=dcr1000 etex;
+%picture p;
+%p = btex \dcr dv|DV\ etex; % <-- \"a\"o\"u\"A\"O\"U
+
+
+% * big numbers in |btex ... etex|: (metafont@ens.fr, 10/96)
+%
+% - if buggy, MP will complain about "Number too large (4096)"
+
+message("* Test for big numbers in btex...etex:");
+picture q;
+q = btex $2^{12} = 4096 \qquad 2^{15} = 32768$ etex;
+
+end.
diff --git a/Build/source/texk/web2c/tests/mptest.mpx b/Build/source/texk/web2c/tests/mptest.mpx
new file mode 100644
index 00000000000..da542167845
--- /dev/null
+++ b/Build/source/texk/web2c/tests/mptest.mpx
@@ -0,0 +1,19 @@
+% Written by DVItoMP, Version 0.64 (Web2C 7.4.7)
+begingroup save _p,_r,_s,_n; picture _p; _p=nullpicture;
+string _n[];
+vardef _s(expr _t,_f,_m,_x,_y)=
+ addto _p also _t infont _f scaled _m shifted (_x,_y); enddef;
+_n0="cmr10";
+_s("2",_n0,1.00000,0.0000,0.0000);
+_n1="cmr7";
+_s("12",_n1,1.00000,4.9813,3.6154);
+_s("=",_n0,1.00000,16.1893,0.0000);
+_s("4096",_n0,1.00000,26.7054,0.0000);
+_s("2",_n0,1.00000,66.5560,0.0000);
+_s("15",_n1,1.00000,71.5373,3.6154);
+_s("=",_n0,1.00000,82.7453,0.0000);
+_s("32768",_n0,1.00000,93.2614,0.0000);
+setbounds _p to (0,0.0000)--(118.1680,0.0000)--
+ (118.1680,8.1096)--(0,8.1096)--cycle;
+_p endgroup
+mpxbreak
diff --git a/Build/source/texk/web2c/tests/one.two.mf b/Build/source/texk/web2c/tests/one.two.mf
new file mode 100644
index 00000000000..a8e0cd32053
--- /dev/null
+++ b/Build/source/texk/web2c/tests/one.two.mf
@@ -0,0 +1,2 @@
+message jobname;
+end.
diff --git a/Build/source/texk/web2c/tests/one.two.mp b/Build/source/texk/web2c/tests/one.two.mp
new file mode 100644
index 00000000000..a8e0cd32053
--- /dev/null
+++ b/Build/source/texk/web2c/tests/one.two.mp
@@ -0,0 +1,2 @@
+message jobname;
+end.
diff --git a/Build/source/texk/web2c/tests/one.two.tex b/Build/source/texk/web2c/tests/one.two.tex
new file mode 100644
index 00000000000..6bda673c7a1
--- /dev/null
+++ b/Build/source/texk/web2c/tests/one.two.tex
@@ -0,0 +1,2 @@
+\message{jobname = \jobname}
+\bye
diff --git a/Build/source/texk/web2c/tests/online.mf b/Build/source/texk/web2c/tests/online.mf
new file mode 100644
index 00000000000..c3e045707a4
--- /dev/null
+++ b/Build/source/texk/web2c/tests/online.mf
@@ -0,0 +1,5 @@
+drawdot(35,70); showit;
+drawdot(65,70); showit;
+draw (20,40)..(50,25)..(80,40); showit;
+shipit;
+end.
diff --git a/Build/source/texk/web2c/tests/openout.mp b/Build/source/texk/web2c/tests/openout.mp
new file mode 100644
index 00000000000..e3099d2333d
--- /dev/null
+++ b/Build/source/texk/web2c/tests/openout.mp
@@ -0,0 +1,12 @@
+tracingonline := -1;
+write "hello" to "xfoo.mut";
+write EOF to "xfoo.mut";
+
+% This crashed mp in 6.96 for Ulrik, probably from openoutnameok?
+% Also problems with docstrip.
+% (Except his filenames didn't have the x's.)
+write "test" to "xopeonout";
+write EOF to "xopenout";
+write "test" to "./xopenout";
+
+bye.
diff --git a/Build/source/texk/web2c/tests/openout.tex b/Build/source/texk/web2c/tests/openout.tex
new file mode 100644
index 00000000000..5c29f39e6b8
--- /dev/null
+++ b/Build/source/texk/web2c/tests/openout.tex
@@ -0,0 +1,5 @@
+\newwrite\x
+\immediate\openout\x = xfoo.out
+\immediate\write\x{hello}
+\immediate\closeout\x
+\bye
diff --git a/Build/source/texk/web2c/tests/pagenum.dvi b/Build/source/texk/web2c/tests/pagenum.dvi
new file mode 100644
index 00000000000..c773cbda5fa
--- /dev/null
+++ b/Build/source/texk/web2c/tests/pagenum.dvi
Binary files differ
diff --git a/Build/source/texk/web2c/tests/pagenum.tex b/Build/source/texk/web2c/tests/pagenum.tex
new file mode 100644
index 00000000000..5edacc3bcf0
--- /dev/null
+++ b/Build/source/texk/web2c/tests/pagenum.tex
@@ -0,0 +1,11 @@
+page 1
+\vfil\eject
+
+\count2 = 2
+page 2.0.2
+\vfil\eject
+
+\count1 = 3
+page 3.3.2
+\bye
+
diff --git a/Build/source/texk/web2c/tests/patgen.in b/Build/source/texk/web2c/tests/patgen.in
new file mode 100644
index 00000000000..eeac43ca060
--- /dev/null
+++ b/Build/source/texk/web2c/tests/patgen.in
@@ -0,0 +1,16 @@
+0 4 error: hyph_start not positive
+10 4 error: hyph_start too big
+3 0 error: hyph_finish not positive
+3 10 error: hyph_finish too big
+3 4
+0 3 error: pat_start not positive
+2 16 error: pat_finish too big
+4 3 error: pat_finish less than pat_start
+2 3
+0 1 1 error: good weight not positive
+1 0 1 error: bad weight not positive
+1 1 0 error: threshold not positive
+1 1 1
+2 3
+1 1 1
+y
diff --git a/Build/source/texk/web2c/tests/patterns b/Build/source/texk/web2c/tests/patterns
new file mode 100644
index 00000000000..341eb40a673
--- /dev/null
+++ b/Build/source/texk/web2c/tests/patterns
@@ -0,0 +1,14 @@
+"a1d
+bg"c2
+b1s
+"c1"a
+"c1d
+1"c`e
+2du
+i1l
+i1t
+l1i
+m1i
+n2"c
+t1"a
+t1`e
diff --git a/Build/source/texk/web2c/tests/plain.mft b/Build/source/texk/web2c/tests/plain.mft
new file mode 100644
index 00000000000..06fa93e89eb
--- /dev/null
+++ b/Build/source/texk/web2c/tests/plain.mft
@@ -0,0 +1,26 @@
+%%%% MFT commands for the PLAIN base
+%%% } ( ) ]] ! ^ %%%% tokens that need no special formatting
+%%% step upto downto %%%% boldface binary operators
+%%% addto fill unfill draw undraw %%%% boldface unary operators
+%%% addto filldraw unfilldraw drawdot undrawdot erase pickup
+%%% addto exitunless stop incr decr proofrulethickness screenrule
+%%% addto define_pixels define_whole_pixels define_whole_vertical_pixels
+%%% addto define_blacker_pixels define_whole_blacker_pixels
+%%% addto define_corrected_pixels lowres_fix proofoffset penstroke
+%%% addto beginchar italcorr font_size font_slant labels
+%%% addto font_normal_space font_normal_stretch font_normal_shrink font_quad
+%%% addto font_x_height font_extra_space font_identifier font_coding_scheme
+%%% enddef endchar %%%% boldface closing
+%%% true relax mode_setup %%%% boldface nullary operators
+%%% true clearit shipit cullit openit showit clearxy clearpen
+%%% true nodisplay notransforms screenchars screenstrokes imagerules
+%%% .. ... -- --- %%%% path operators made of dots and dashes
+%%% length flex abs dir %%%% unary operators to be in roman type
+%%% length unitvector inverse ceiling round hround vround counterclockwise
+%%% length tensepath byte reflectedabout rotatedaround magstep max min
+%%% and mod dotprod intersectionpoint softjoin %%%% binary operators to be roman
+%%% ++ ** %%%% binary operators made of two special characters
+%%% penoffset goodval direction directionpoint %%%% operators that take "of"
+%%% pausing tolerance pixels_per_inch blacker o_correction %%%% internals
+%%% pausing screen_rows screen_cols currentwindow displaying
+%%% pausing pen_top pen_bot pen_lft pen_rt rt lft top bot
diff --git a/Build/source/texk/web2c/tests/pplr.dvi b/Build/source/texk/web2c/tests/pplr.dvi
new file mode 100644
index 00000000000..fc5b56748e4
--- /dev/null
+++ b/Build/source/texk/web2c/tests/pplr.dvi
Binary files differ
diff --git a/Build/source/texk/web2c/tests/pplr.tfm b/Build/source/texk/web2c/tests/pplr.tfm
new file mode 100644
index 00000000000..5c87b974424
--- /dev/null
+++ b/Build/source/texk/web2c/tests/pplr.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/ptmr.dvi b/Build/source/texk/web2c/tests/ptmr.dvi
new file mode 100644
index 00000000000..6c40cd46ec2
--- /dev/null
+++ b/Build/source/texk/web2c/tests/ptmr.dvi
Binary files differ
diff --git a/Build/source/texk/web2c/tests/ptmr.tfm b/Build/source/texk/web2c/tests/ptmr.tfm
new file mode 100644
index 00000000000..63a4eff307b
--- /dev/null
+++ b/Build/source/texk/web2c/tests/ptmr.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/ptmr.vf b/Build/source/texk/web2c/tests/ptmr.vf
new file mode 100644
index 00000000000..270148730d6
--- /dev/null
+++ b/Build/source/texk/web2c/tests/ptmr.vf
Binary files differ
diff --git a/Build/source/texk/web2c/tests/ptmr.vpl b/Build/source/texk/web2c/tests/ptmr.vpl
new file mode 100644
index 00000000000..7cf1ffe698f
--- /dev/null
+++ b/Build/source/texk/web2c/tests/ptmr.vpl
@@ -0,0 +1,2621 @@
+(VTITLE Created by afm2tfm Times-Roman -v ptmr_raw, then edited for Greek)
+(FAMILY TEX-RPTMR)
+(FACE F MRR)
+(CODINGSCHEME TEX TEXT + ADOBESTANDARDENCODING)
+(DESIGNSIZE R 10.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM O 7575461244)
+(FONTDIMEN
+ (SLANT R 0.0)
+ (SPACE R 0.25)
+ (STRETCH R 0.2)
+ (SHRINK R 0.1)
+ (XHEIGHT R 0.45)
+ (QUAD R 1.0)
+ (EXTRASPACE R 0.111)
+ )
+(MAPFONT D 0
+ (FONTNAME rptmr)
+ (FONTCHECKSUM O 30202316533)
+ (FONTAT R 1.0)
+ (FONTDSIZE R 10.0)
+ )
+(MAPFONT D 1
+ (FONTNAME rpsyr)
+ (FONTCHECKSUM O 12741765024)
+ (FONTAT R 1.0)
+ (FONTDSIZE R 10.0)
+ )
+(LIGTABLE
+ (LABEL O 40)
+ (LIG C L O 350)
+ (LIG C l O 370)
+ (STOP)
+ (LABEL O 41)
+ (LIG O 140 O 16)
+ (STOP)
+ (LABEL O 47)
+ (LIG O 47 O 272)
+ (KRN C d R -0.05)
+ (KRN C l R -0.01)
+ (KRN O 272 R 0.0)
+ (KRN O 47 R -0.074)
+ (KRN C r R -0.05)
+ (KRN C s R -0.055)
+ (KRN C t R -0.018)
+ (KRN C v R -0.05)
+ (STOP)
+ (LABEL O 54)
+ (KRN O 272 R -0.07)
+ (KRN O 47 R -0.07)
+ (STOP)
+ (LABEL O 55)
+ (LIG O 55 O 261)
+ (STOP)
+ (LABEL O 56)
+ (KRN O 272 R -0.07)
+ (KRN O 47 R -0.07)
+ (STOP)
+ (LABEL O 77)
+ (LIG O 140 O 17)
+ (STOP)
+ (LABEL C A)
+ (KRN C C R -0.04)
+ (KRN C G R -0.04)
+ (KRN C O R -0.055)
+ (KRN C Q R -0.055)
+ (KRN C T R -0.111)
+ (KRN C U R -0.055)
+ (KRN C V R -0.135)
+ (KRN C W R -0.09)
+ (KRN C Y R -0.105)
+ (KRN C p R 0.0)
+ (KRN O 272 R 0.0)
+ (KRN O 47 R -0.111)
+ (KRN C u R 0.0)
+ (KRN C v R -0.074)
+ (KRN C w R -0.092)
+ (KRN C y R -0.092)
+ (STOP)
+ (LABEL C B)
+ (KRN C A R -0.035)
+ (KRN C U R -0.01)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ (STOP)
+ (LABEL C D)
+ (KRN C A R -0.04)
+ (KRN C V R -0.04)
+ (KRN C W R -0.03)
+ (KRN C Y R -0.055)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ (STOP)
+ (LABEL C F)
+ (KRN C A R -0.074)
+ (KRN C a R -0.015)
+ (KRN O 54 R -0.08)
+ (KRN C e R 0.0)
+ (KRN C i R 0.0)
+ (KRN C o R -0.015)
+ (KRN O 56 R -0.08)
+ (KRN C r R 0.0)
+ (STOP)
+ (LABEL C G)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ (STOP)
+ (LABEL C J)
+ (KRN C A R -0.06)
+ (KRN C a R 0.0)
+ (KRN O 54 R 0.0)
+ (KRN C e R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C u R 0.0)
+ (STOP)
+ (LABEL C K)
+ (KRN C O R -0.03)
+ (KRN C e R -0.025)
+ (KRN C o R -0.035)
+ (KRN C u R -0.015)
+ (KRN C y R -0.025)
+ (STOP)
+ (LABEL C L)
+ (KRN C T R -0.092)
+ (KRN C V R -0.1)
+ (KRN C W R -0.074)
+ (KRN C Y R -0.1)
+ (KRN O 272 R 0.0)
+ (KRN O 47 R -0.092)
+ (KRN C y R -0.055)
+ (STOP)
+ (LABEL C N)
+ (KRN C A R -0.035)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ (STOP)
+ (LABEL C O)
+ (KRN C A R -0.035)
+ (KRN C T R -0.04)
+ (KRN C V R -0.05)
+ (KRN C W R -0.035)
+ (KRN C X R -0.04)
+ (KRN C Y R -0.05)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ (STOP)
+ (LABEL C P)
+ (KRN C A R -0.092)
+ (KRN C a R -0.015)
+ (KRN O 54 R -0.111)
+ (KRN C e R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R -0.111)
+ (STOP)
+ (LABEL C Q)
+ (KRN C U R -0.01)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ (STOP)
+ (LABEL C R)
+ (KRN C O R -0.04)
+ (KRN C T R -0.06)
+ (KRN C U R -0.04)
+ (KRN C V R -0.08)
+ (KRN C W R -0.055)
+ (KRN C Y R -0.065)
+ (STOP)
+ (LABEL C S)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ (STOP)
+ (LABEL C T)
+ (KRN C A R -0.093)
+ (KRN C O R -0.018)
+ (KRN C a R -0.08)
+ (KRN O 72 R -0.05)
+ (KRN O 54 R -0.074)
+ (KRN C e R -0.07)
+ (KRN C h R 0.0)
+ (KRN O 55 R -0.092)
+ (KRN C i R -0.035)
+ (KRN C o R -0.08)
+ (KRN O 56 R -0.074)
+ (KRN C r R -0.035)
+ (KRN O 73 R -0.055)
+ (KRN C u R -0.045)
+ (KRN C w R -0.08)
+ (KRN C y R -0.08)
+ (STOP)
+ (LABEL C U)
+ (KRN C A R -0.04)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ (STOP)
+ (LABEL C V)
+ (KRN C A R -0.135)
+ (KRN C G R -0.015)
+ (KRN C O R -0.04)
+ (KRN C a R -0.111)
+ (KRN O 72 R -0.074)
+ (KRN O 54 R -0.129)
+ (KRN C e R -0.111)
+ (KRN O 55 R -0.1)
+ (KRN C i R -0.06)
+ (KRN C o R -0.129)
+ (KRN O 56 R -0.129)
+ (KRN O 73 R -0.074)
+ (KRN C u R -0.075)
+ (STOP)
+ (LABEL C W)
+ (KRN C A R -0.12)
+ (KRN C O R -0.01)
+ (KRN C a R -0.08)
+ (KRN O 72 R -0.037)
+ (KRN O 54 R -0.092)
+ (KRN C e R -0.08)
+ (KRN C h R 0.0)
+ (KRN O 55 R -0.065)
+ (KRN C i R -0.04)
+ (KRN C o R -0.08)
+ (KRN O 56 R -0.092)
+ (KRN O 73 R -0.037)
+ (KRN C u R -0.05)
+ (KRN C y R -0.073)
+ (STOP)
+ (LABEL C Y)
+ (KRN C A R -0.12)
+ (KRN C O R -0.03)
+ (KRN C a R -0.1)
+ (KRN O 72 R -0.092)
+ (KRN O 54 R -0.129)
+ (KRN C e R -0.1)
+ (KRN O 55 R -0.111)
+ (KRN C i R -0.055)
+ (KRN C o R -0.11)
+ (KRN O 56 R -0.129)
+ (KRN O 73 R -0.092)
+ (KRN C u R -0.111)
+ (STOP)
+ (LABEL O 140)
+ (LIG O 140 O 252)
+ (KRN C A R -0.08)
+ (KRN O 140 R -0.074)
+ (STOP)
+ (LABEL C a)
+ (KRN C b R 0.0)
+ (KRN C g R 0.0)
+ (KRN C p R 0.0)
+ (KRN C t R 0.0)
+ (KRN C v R -0.02)
+ (KRN C w R -0.015)
+ (KRN C y R 0.0)
+ (STOP)
+ (LABEL C b)
+ (KRN C b R 0.0)
+ (KRN O 54 R 0.0)
+ (KRN C l R 0.0)
+ (KRN O 56 R -0.04)
+ (KRN C u R -0.02)
+ (KRN C v R -0.015)
+ (KRN C y R 0.0)
+ (STOP)
+ (LABEL C c)
+ (KRN O 54 R 0.0)
+ (KRN C h R 0.0)
+ (KRN C k R 0.0)
+ (KRN C l R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C y R -0.015)
+ (STOP)
+ (LABEL C d)
+ (KRN O 54 R 0.0)
+ (KRN C d R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C v R 0.0)
+ (KRN C w R 0.0)
+ (KRN C y R 0.0)
+ (STOP)
+ (LABEL C e)
+ (KRN C b R 0.0)
+ (KRN O 54 R 0.0)
+ (KRN C g R -0.015)
+ (KRN C p R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C v R -0.025)
+ (KRN C w R -0.025)
+ (KRN C x R -0.015)
+ (KRN C y R -0.015)
+ (STOP)
+ (LABEL C f)
+ (LIG C l O 257)
+ (LIG C i O 256)
+ (KRN C a R -0.01)
+ (KRN O 54 R 0.0)
+ (KRN O 20 R -0.05)
+ (KRN C e R 0.0)
+ (KRN C f R -0.025)
+ (KRN C i R -0.02)
+ (KRN C l R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN O 272 R 0.0)
+ (KRN O 47 R 0.055)
+ (STOP)
+ (LABEL C g)
+ (KRN C a R -0.005)
+ (KRN O 54 R 0.0)
+ (KRN C e R 0.0)
+ (KRN C g R 0.0)
+ (KRN C i R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C r R 0.0)
+ (KRN C y R 0.0)
+ (STOP)
+ (LABEL C h)
+ (KRN C y R -0.005)
+ (STOP)
+ (LABEL C i)
+ (KRN C v R -0.025)
+ (STOP)
+ (LABEL C k)
+ (KRN C e R -0.01)
+ (KRN C o R -0.01)
+ (KRN C y R -0.015)
+ (STOP)
+ (LABEL C l)
+ (KRN C w R -0.01)
+ (KRN C y R 0.0)
+ (STOP)
+ (LABEL C m)
+ (KRN C u R 0.0)
+ (KRN C y R 0.0)
+ (STOP)
+ (LABEL C n)
+ (KRN C u R 0.0)
+ (KRN C v R -0.04)
+ (KRN C y R -0.015)
+ (STOP)
+ (LABEL C o)
+ (KRN C g R 0.0)
+ (KRN C v R -0.015)
+ (KRN C w R -0.025)
+ (KRN C x R 0.0)
+ (KRN C y R -0.01)
+ (STOP)
+ (LABEL C p)
+ (KRN C y R -0.01)
+ (STOP)
+ (LABEL C r)
+ (KRN C a R 0.0)
+ (KRN C c R 0.0)
+ (KRN O 54 R -0.04)
+ (KRN C d R 0.0)
+ (KRN C e R 0.0)
+ (KRN C g R -0.018)
+ (KRN O 55 R -0.02)
+ (KRN C i R 0.0)
+ (KRN C k R 0.0)
+ (KRN C l R 0.0)
+ (KRN C m R 0.0)
+ (KRN C n R 0.0)
+ (KRN C o R 0.0)
+ (KRN C p R 0.0)
+ (KRN O 56 R -0.055)
+ (KRN C q R 0.0)
+ (KRN C r R 0.0)
+ (KRN C s R 0.0)
+ (KRN C t R 0.0)
+ (KRN C u R 0.0)
+ (KRN C v R 0.0)
+ (KRN C y R 0.0)
+ (STOP)
+ (LABEL C s)
+ (KRN C w R 0.0)
+ (STOP)
+ (LABEL C v)
+ (KRN C a R -0.025)
+ (KRN O 54 R -0.065)
+ (KRN C e R -0.015)
+ (KRN C o R -0.02)
+ (KRN O 56 R -0.065)
+ (STOP)
+ (LABEL C w)
+ (KRN C a R -0.01)
+ (KRN O 54 R -0.065)
+ (KRN C e R 0.0)
+ (KRN C h R 0.0)
+ (KRN C o R -0.01)
+ (KRN O 56 R -0.065)
+ (STOP)
+ (LABEL C x)
+ (KRN C e R -0.015)
+ (STOP)
+ (LABEL C y)
+ (KRN C a R 0.0)
+ (KRN O 54 R -0.065)
+ (KRN C e R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R -0.065)
+ (STOP)
+ (LABEL C z)
+ (KRN C e R 0.0)
+ (KRN C o R 0.0)
+ (STOP)
+ (LABEL O 252)
+ (KRN C A R -0.08)
+ (KRN O 140 R 0.0)
+ (STOP)
+ (LABEL O 261)
+ (LIG O 55 O 320)
+ (STOP)
+ )
+(CHARACTER O 0
+ (CHARWD R 0.603)
+ (CHARHT R 0.6995)
+ (CHARIC R 0.006)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C G)
+ )
+ )
+(CHARACTER O 1
+ (CHARWD R 0.612)
+ (CHARHT R 0.6995)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C D)
+ )
+ )
+(CHARACTER O 2
+ (CHARWD R 0.741)
+ (CHARHT R 0.6995)
+ (CHARDP R 0.008)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C Q)
+ )
+ )
+(CHARACTER O 3
+ (CHARWD R 0.686)
+ (CHARHT R 0.6995)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C L)
+ )
+ )
+(CHARACTER O 4
+ (CHARWD R 0.645)
+ (CHARHT R 0.6995)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C X)
+ )
+ )
+(CHARACTER O 5
+ (CHARWD R 0.768)
+ (CHARHT R 0.6995)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C P)
+ )
+ )
+(CHARACTER O 6
+ (CHARWD R 0.592)
+ (CHARHT R 0.6995)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C S)
+ )
+ )
+(CHARACTER O 7
+ (CHARWD R 0.62)
+ (CHARHT R 0.6995)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR O 241)
+ )
+ )
+(CHARACTER O 10
+ (CHARWD R 0.763)
+ (CHARHT R 0.6995)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C F)
+ )
+ )
+(CHARACTER O 11
+ (CHARWD R 0.795)
+ (CHARHT R 0.6995)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C Y)
+ )
+ )
+(CHARACTER O 12
+ (CHARWD R 0.768)
+ (CHARHT R 0.6995)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR C W)
+ )
+ )
+(CHARACTER O 13
+ (CHARWD R 0.603)
+ (CHARHT R 0.8965)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR O 255)
+ )
+ )
+(CHARACTER O 14
+ (CHARWD R 0.603)
+ (CHARHT R 0.8965)
+ (CHARDP R 0.008)
+ (MAP
+ (SELECTFONT D 1)
+ (SETCHAR O 257)
+ )
+ )
+(CHARACTER O 15
+ (CHARWD R 0.18)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 251)
+ )
+ )
+(CHARACTER O 16
+ (CHARWD R 0.333)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.218)
+ (MAP
+ (SETCHAR O 241)
+ )
+ )
+(CHARACTER O 17
+ (CHARWD R 0.444)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.218)
+ (MAP
+ (SETCHAR O 277)
+ )
+ )
+(CHARACTER O 20
+ (CHARWD R 0.278)
+ (CHARHT R 0.4585)
+ (MAP
+ (SETCHAR O 365)
+ )
+ )
+(CHARACTER O 22
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 23
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 24
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 317)
+ )
+ )
+(CHARACTER O 25
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 306)
+ )
+ )
+(CHARACTER O 26
+ (CHARWD R 0.333)
+ (CHARHT R 0.5905)
+ (MAP
+ (SETCHAR O 305)
+ )
+ )
+(CHARACTER O 27
+ (CHARWD R 0.333)
+ (CHARHT R 0.6995)
+ (MAP
+ (SETCHAR O 312)
+ )
+ )
+(CHARACTER O 30
+ (CHARWD R 0.333)
+ (CHARDP R 0.216)
+ (MAP
+ (SETCHAR O 313)
+ )
+ )
+(CHARACTER O 31
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR O 373)
+ )
+ )
+(CHARACTER O 32
+ (CHARWD R 0.667)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR O 361)
+ )
+ )
+(CHARACTER O 33
+ (CHARWD R 0.722)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR O 372)
+ )
+ )
+(CHARACTER O 34
+ (CHARWD R 0.5)
+ (CHARHT R 0.551)
+ (CHARDP R 0.112)
+ (MAP
+ (SETCHAR O 371)
+ )
+ )
+(CHARACTER O 35
+ (CHARWD R 0.889)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 341)
+ )
+ )
+(CHARACTER O 36
+ (CHARWD R 0.889)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR O 352)
+ )
+ )
+(CHARACTER O 37
+ (CHARWD R 0.722)
+ (CHARHT R 0.7305)
+ (CHARDP R 0.08)
+ (MAP
+ (SETCHAR O 351)
+ )
+ )
+(CHARACTER O 40
+ (CHARWD R 0.25)
+ (COMMENT
+ (LIG C L O 350)
+ (LIG C l O 370)
+ )
+ (MAP
+ (SETCHAR O 40)
+ )
+ )
+(CHARACTER O 41
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (COMMENT
+ (LIG O 140 O 16)
+ )
+ (MAP
+ (SETCHAR O 41)
+ )
+ )
+(CHARACTER O 42
+ (CHARWD R 0.408)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 42)
+ )
+ )
+(CHARACTER O 43
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 43)
+ )
+ )
+(CHARACTER O 44
+ (CHARWD R 0.5)
+ (CHARHT R 0.7305)
+ (CHARDP R 0.087)
+ (MAP
+ (SETCHAR O 44)
+ )
+ )
+(CHARACTER O 45
+ (CHARWD R 0.833)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR O 45)
+ )
+ )
+(CHARACTER O 46
+ (CHARWD R 0.778)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR O 46)
+ )
+ )
+(CHARACTER O 47
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (COMMENT
+ (LIG O 47 O 272)
+ (KRN C d R -0.05)
+ (KRN C l R -0.01)
+ (KRN O 272 R 0.0)
+ (KRN O 47 R -0.074)
+ (KRN C r R -0.05)
+ (KRN C s R -0.055)
+ (KRN C t R -0.018)
+ (KRN C v R -0.05)
+ )
+ (MAP
+ (SETCHAR O 47)
+ )
+ )
+(CHARACTER O 50
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (CHARDP R 0.179)
+ (MAP
+ (SETCHAR O 50)
+ )
+ )
+(CHARACTER O 51
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (CHARDP R 0.179)
+ (MAP
+ (SETCHAR O 51)
+ )
+ )
+(CHARACTER O 52
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 52)
+ )
+ )
+(CHARACTER O 53
+ (CHARWD R 0.564)
+ (CHARHT R 0.51)
+ (MAP
+ (SETCHAR O 53)
+ )
+ )
+(CHARACTER O 54
+ (CHARWD R 0.25)
+ (CHARHT R 0.101)
+ (CHARDP R 0.1395)
+ (COMMENT
+ (KRN O 272 R -0.07)
+ (KRN O 47 R -0.07)
+ )
+ (MAP
+ (SETCHAR O 54)
+ )
+ )
+(CHARACTER O 55
+ (CHARWD R 0.333)
+ (CHARHT R 0.2535)
+ (COMMENT
+ (LIG O 55 O 261)
+ )
+ (MAP
+ (SETCHAR O 55)
+ )
+ )
+(CHARACTER O 56
+ (CHARWD R 0.25)
+ (CHARHT R 0.101)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN O 272 R -0.07)
+ (KRN O 47 R -0.07)
+ )
+ (MAP
+ (SETCHAR O 56)
+ )
+ )
+(CHARACTER O 57
+ (CHARWD R 0.278)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (CHARIC R 0.009)
+ (MAP
+ (SETCHAR O 57)
+ )
+ )
+(CHARACTER C 0
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C 0)
+ )
+ )
+(CHARACTER C 1
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C 1)
+ )
+ )
+(CHARACTER C 2
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C 2)
+ )
+ )
+(CHARACTER C 3
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C 3)
+ )
+ )
+(CHARACTER C 4
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C 4)
+ )
+ )
+(CHARACTER C 5
+ (CHARWD R 0.5)
+ (CHARHT R 0.6995)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C 5)
+ )
+ )
+(CHARACTER C 6
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C 6)
+ )
+ )
+(CHARACTER C 7
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C 7)
+ )
+ )
+(CHARACTER C 8
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C 8)
+ )
+ )
+(CHARACTER C 9
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0205)
+ (MAP
+ (SETCHAR C 9)
+ )
+ )
+(CHARACTER O 72
+ (CHARWD R 0.278)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR O 72)
+ )
+ )
+(CHARACTER O 73
+ (CHARWD R 0.278)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.1395)
+ (MAP
+ (SETCHAR O 73)
+ )
+ )
+(CHARACTER O 74
+ (CHARWD R 0.564)
+ (CHARHT R 0.51)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR O 74)
+ )
+ )
+(CHARACTER O 75
+ (CHARWD R 0.564)
+ (CHARHT R 0.386)
+ (MAP
+ (SETCHAR O 75)
+ )
+ )
+(CHARACTER O 76
+ (CHARWD R 0.564)
+ (CHARHT R 0.51)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR O 76)
+ )
+ )
+(CHARACTER O 77
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (COMMENT
+ (LIG O 140 O 17)
+ )
+ (MAP
+ (SETCHAR O 77)
+ )
+ )
+(CHARACTER O 100
+ (CHARWD R 0.921)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR O 100)
+ )
+ )
+(CHARACTER C A
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C C R -0.04)
+ (KRN C G R -0.04)
+ (KRN C O R -0.055)
+ (KRN C Q R -0.055)
+ (KRN C T R -0.111)
+ (KRN C U R -0.055)
+ (KRN C V R -0.135)
+ (KRN C W R -0.09)
+ (KRN C Y R -0.105)
+ (KRN C p R 0.0)
+ (KRN O 272 R 0.0)
+ (KRN O 47 R -0.111)
+ (KRN C u R 0.0)
+ (KRN C v R -0.074)
+ (KRN C w R -0.092)
+ (KRN C y R -0.092)
+ )
+ (MAP
+ (SETCHAR C A)
+ )
+ )
+(CHARACTER C B
+ (CHARWD R 0.667)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C A R -0.035)
+ (KRN C U R -0.01)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ )
+ (MAP
+ (SETCHAR C B)
+ )
+ )
+(CHARACTER C C
+ (CHARWD R 0.667)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C C)
+ )
+ )
+(CHARACTER C D
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C A R -0.04)
+ (KRN C V R -0.04)
+ (KRN C W R -0.03)
+ (KRN C Y R -0.055)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ )
+ (MAP
+ (SETCHAR C D)
+ )
+ )
+(CHARACTER C E
+ (CHARWD R 0.611)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C E)
+ )
+ )
+(CHARACTER C F
+ (CHARWD R 0.556)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C A R -0.074)
+ (KRN C a R -0.015)
+ (KRN O 54 R -0.08)
+ (KRN C e R 0.0)
+ (KRN C i R 0.0)
+ (KRN C o R -0.015)
+ (KRN O 56 R -0.08)
+ (KRN C r R 0.0)
+ )
+ (MAP
+ (SETCHAR C F)
+ )
+ )
+(CHARACTER C G
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ )
+ (MAP
+ (SETCHAR C G)
+ )
+ )
+(CHARACTER C H
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C H)
+ )
+ )
+(CHARACTER C I
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C I)
+ )
+ )
+(CHARACTER C J
+ (CHARWD R 0.389)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN C A R -0.06)
+ (KRN C a R 0.0)
+ (KRN O 54 R 0.0)
+ (KRN C e R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C u R 0.0)
+ )
+ (MAP
+ (SETCHAR C J)
+ )
+ )
+(CHARACTER C K
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (CHARIC R 0.001)
+ (COMMENT
+ (KRN C O R -0.03)
+ (KRN C e R -0.025)
+ (KRN C o R -0.035)
+ (KRN C u R -0.015)
+ (KRN C y R -0.025)
+ )
+ (MAP
+ (SETCHAR C K)
+ )
+ )
+(CHARACTER C L
+ (CHARWD R 0.611)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C T R -0.092)
+ (KRN C V R -0.1)
+ (KRN C W R -0.074)
+ (KRN C Y R -0.1)
+ (KRN O 272 R 0.0)
+ (KRN O 47 R -0.092)
+ (KRN C y R -0.055)
+ )
+ (MAP
+ (SETCHAR C L)
+ )
+ )
+(CHARACTER C M
+ (CHARWD R 0.889)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C M)
+ )
+ )
+(CHARACTER C N
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN C A R -0.035)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ )
+ (MAP
+ (SETCHAR C N)
+ )
+ )
+(CHARACTER C O
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN C A R -0.035)
+ (KRN C T R -0.04)
+ (KRN C V R -0.05)
+ (KRN C W R -0.035)
+ (KRN C X R -0.04)
+ (KRN C Y R -0.05)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ )
+ (MAP
+ (SETCHAR C O)
+ )
+ )
+(CHARACTER C P
+ (CHARWD R 0.556)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C A R -0.092)
+ (KRN C a R -0.015)
+ (KRN O 54 R -0.111)
+ (KRN C e R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R -0.111)
+ )
+ (MAP
+ (SETCHAR C P)
+ )
+ )
+(CHARACTER C Q
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (CHARDP R 0.179)
+ (COMMENT
+ (KRN C U R -0.01)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ )
+ (MAP
+ (SETCHAR C Q)
+ )
+ )
+(CHARACTER C R
+ (CHARWD R 0.667)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C O R -0.04)
+ (KRN C T R -0.06)
+ (KRN C U R -0.04)
+ (KRN C V R -0.08)
+ (KRN C W R -0.055)
+ (KRN C Y R -0.065)
+ )
+ (MAP
+ (SETCHAR C R)
+ )
+ )
+(CHARACTER C S
+ (CHARWD R 0.556)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ )
+ (MAP
+ (SETCHAR C S)
+ )
+ )
+(CHARACTER C T
+ (CHARWD R 0.611)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C A R -0.093)
+ (KRN C O R -0.018)
+ (KRN C a R -0.08)
+ (KRN O 72 R -0.05)
+ (KRN O 54 R -0.074)
+ (KRN C e R -0.07)
+ (KRN C h R 0.0)
+ (KRN O 55 R -0.092)
+ (KRN C i R -0.035)
+ (KRN C o R -0.08)
+ (KRN O 56 R -0.074)
+ (KRN C r R -0.035)
+ (KRN O 73 R -0.055)
+ (KRN C u R -0.045)
+ (KRN C w R -0.08)
+ (KRN C y R -0.08)
+ )
+ (MAP
+ (SETCHAR C T)
+ )
+ )
+(CHARACTER C U
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN C A R -0.04)
+ (KRN O 54 R 0.0)
+ (KRN O 56 R 0.0)
+ )
+ (MAP
+ (SETCHAR C U)
+ )
+ )
+(CHARACTER C V
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN C A R -0.135)
+ (KRN C G R -0.015)
+ (KRN C O R -0.04)
+ (KRN C a R -0.111)
+ (KRN O 72 R -0.074)
+ (KRN O 54 R -0.129)
+ (KRN C e R -0.111)
+ (KRN O 55 R -0.1)
+ (KRN C i R -0.06)
+ (KRN C o R -0.129)
+ (KRN O 56 R -0.129)
+ (KRN O 73 R -0.074)
+ (KRN C u R -0.075)
+ )
+ (MAP
+ (SETCHAR C V)
+ )
+ )
+(CHARACTER C W
+ (CHARWD R 0.944)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN C A R -0.12)
+ (KRN C O R -0.01)
+ (KRN C a R -0.08)
+ (KRN O 72 R -0.037)
+ (KRN O 54 R -0.092)
+ (KRN C e R -0.08)
+ (KRN C h R 0.0)
+ (KRN O 55 R -0.065)
+ (KRN C i R -0.04)
+ (KRN C o R -0.08)
+ (KRN O 56 R -0.092)
+ (KRN O 73 R -0.037)
+ (KRN C u R -0.05)
+ (KRN C y R -0.073)
+ )
+ (MAP
+ (SETCHAR C W)
+ )
+ )
+(CHARACTER C X
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C X)
+ )
+ )
+(CHARACTER C Y
+ (CHARWD R 0.722)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C A R -0.12)
+ (KRN C O R -0.03)
+ (KRN C a R -0.1)
+ (KRN O 72 R -0.092)
+ (KRN O 54 R -0.129)
+ (KRN C e R -0.1)
+ (KRN O 55 R -0.111)
+ (KRN C i R -0.055)
+ (KRN C o R -0.11)
+ (KRN O 56 R -0.129)
+ (KRN O 73 R -0.092)
+ (KRN C u R -0.111)
+ )
+ (MAP
+ (SETCHAR C Y)
+ )
+ )
+(CHARACTER C Z
+ (CHARWD R 0.611)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C Z)
+ )
+ )
+(CHARACTER O 133
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (CHARDP R 0.1545)
+ (MAP
+ (SETCHAR O 133)
+ )
+ )
+(CHARACTER O 134
+ (CHARWD R 0.278)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (CHARIC R 0.009)
+ (MAP
+ (SETCHAR O 134)
+ )
+ )
+(CHARACTER O 135
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (CHARDP R 0.1545)
+ (MAP
+ (SETCHAR O 135)
+ )
+ )
+(CHARACTER O 136
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 137
+ (CHARWD R 0.5)
+ (CHARDP R 0.125)
+ (MAP
+ (SETCHAR O 137)
+ )
+ )
+(CHARACTER O 140
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (COMMENT
+ (LIG O 140 O 252)
+ (KRN C A R -0.08)
+ (KRN O 140 R -0.074)
+ )
+ (MAP
+ (SETCHAR O 140)
+ )
+ )
+(CHARACTER C a
+ (CHARWD R 0.444)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.008)
+ (COMMENT
+ (KRN C b R 0.0)
+ (KRN C g R 0.0)
+ (KRN C p R 0.0)
+ (KRN C t R 0.0)
+ (KRN C v R -0.02)
+ (KRN C w R -0.015)
+ (KRN C y R 0.0)
+ )
+ (MAP
+ (SETCHAR C a)
+ )
+ )
+(CHARACTER C b
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (COMMENT
+ (KRN C b R 0.0)
+ (KRN O 54 R 0.0)
+ (KRN C l R 0.0)
+ (KRN O 56 R -0.04)
+ (KRN C u R -0.02)
+ (KRN C v R -0.015)
+ (KRN C y R 0.0)
+ )
+ (MAP
+ (SETCHAR C b)
+ )
+ )
+(CHARACTER C c
+ (CHARWD R 0.444)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.008)
+ (COMMENT
+ (KRN O 54 R 0.0)
+ (KRN C h R 0.0)
+ (KRN C k R 0.0)
+ (KRN C l R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C y R -0.015)
+ )
+ (MAP
+ (SETCHAR C c)
+ )
+ )
+(CHARACTER C d
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (COMMENT
+ (KRN O 54 R 0.0)
+ (KRN C d R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C v R 0.0)
+ (KRN C w R 0.0)
+ (KRN C y R 0.0)
+ )
+ (MAP
+ (SETCHAR C d)
+ )
+ )
+(CHARACTER C e
+ (CHARWD R 0.444)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.008)
+ (COMMENT
+ (KRN C b R 0.0)
+ (KRN O 54 R 0.0)
+ (KRN C g R -0.015)
+ (KRN C p R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C v R -0.025)
+ (KRN C w R -0.025)
+ (KRN C x R -0.015)
+ (KRN C y R -0.015)
+ )
+ (MAP
+ (SETCHAR C e)
+ )
+ )
+(CHARACTER C f
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (CHARIC R 0.05)
+ (COMMENT
+ (LIG C l O 257)
+ (LIG C i O 256)
+ (KRN C a R -0.01)
+ (KRN O 54 R 0.0)
+ (KRN O 20 R -0.05)
+ (KRN C e R 0.0)
+ (KRN C f R -0.025)
+ (KRN C i R -0.02)
+ (KRN C l R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN O 272 R 0.0)
+ (KRN O 47 R 0.055)
+ )
+ (MAP
+ (SETCHAR C f)
+ )
+ )
+(CHARACTER C g
+ (CHARWD R 0.5)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.218)
+ (COMMENT
+ (KRN C a R -0.005)
+ (KRN O 54 R 0.0)
+ (KRN C e R 0.0)
+ (KRN C g R 0.0)
+ (KRN C i R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R 0.0)
+ (KRN C r R 0.0)
+ (KRN C y R 0.0)
+ )
+ (MAP
+ (SETCHAR C g)
+ )
+ )
+(CHARACTER C h
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C y R -0.005)
+ )
+ (MAP
+ (SETCHAR C h)
+ )
+ )
+(CHARACTER C i
+ (CHARWD R 0.278)
+ (CHARHT R 0.4585)
+ (COMMENT
+ (KRN C v R -0.025)
+ )
+ (MAP
+ (SETCHAR C i)
+ )
+ )
+(CHARACTER C j
+ (CHARWD R 0.278)
+ (CHARHT R 0.673)
+ (CHARDP R 0.218)
+ (MAP
+ (SETCHAR C j)
+ )
+ )
+(CHARACTER C k
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARIC R 0.005)
+ (COMMENT
+ (KRN C e R -0.01)
+ (KRN C o R -0.01)
+ (KRN C y R -0.015)
+ )
+ (MAP
+ (SETCHAR C k)
+ )
+ )
+(CHARACTER C l
+ (CHARWD R 0.278)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C w R -0.01)
+ (KRN C y R 0.0)
+ )
+ (MAP
+ (SETCHAR C l)
+ )
+ )
+(CHARACTER C m
+ (CHARWD R 0.778)
+ (CHARHT R 0.4585)
+ (COMMENT
+ (KRN C u R 0.0)
+ (KRN C y R 0.0)
+ )
+ (MAP
+ (SETCHAR C m)
+ )
+ )
+(CHARACTER C n
+ (CHARWD R 0.5)
+ (CHARHT R 0.4585)
+ (COMMENT
+ (KRN C u R 0.0)
+ (KRN C v R -0.04)
+ (KRN C y R -0.015)
+ )
+ (MAP
+ (SETCHAR C n)
+ )
+ )
+(CHARACTER C o
+ (CHARWD R 0.5)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.008)
+ (COMMENT
+ (KRN C g R 0.0)
+ (KRN C v R -0.015)
+ (KRN C w R -0.025)
+ (KRN C x R 0.0)
+ (KRN C y R -0.01)
+ )
+ (MAP
+ (SETCHAR C o)
+ )
+ )
+(CHARACTER C p
+ (CHARWD R 0.5)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.216)
+ (COMMENT
+ (KRN C y R -0.01)
+ )
+ (MAP
+ (SETCHAR C p)
+ )
+ )
+(CHARACTER C q
+ (CHARWD R 0.5)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.216)
+ (MAP
+ (SETCHAR C q)
+ )
+ )
+(CHARACTER C r
+ (CHARWD R 0.333)
+ (CHARHT R 0.4585)
+ (CHARIC R 0.002)
+ (COMMENT
+ (KRN C a R 0.0)
+ (KRN C c R 0.0)
+ (KRN O 54 R -0.04)
+ (KRN C d R 0.0)
+ (KRN C e R 0.0)
+ (KRN C g R -0.018)
+ (KRN O 55 R -0.02)
+ (KRN C i R 0.0)
+ (KRN C k R 0.0)
+ (KRN C l R 0.0)
+ (KRN C m R 0.0)
+ (KRN C n R 0.0)
+ (KRN C o R 0.0)
+ (KRN C p R 0.0)
+ (KRN O 56 R -0.055)
+ (KRN C q R 0.0)
+ (KRN C r R 0.0)
+ (KRN C s R 0.0)
+ (KRN C t R 0.0)
+ (KRN C u R 0.0)
+ (KRN C v R 0.0)
+ (KRN C y R 0.0)
+ )
+ (MAP
+ (SETCHAR C r)
+ )
+ )
+(CHARACTER C s
+ (CHARWD R 0.389)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.008)
+ (COMMENT
+ (KRN C w R 0.0)
+ )
+ (MAP
+ (SETCHAR C s)
+ )
+ )
+(CHARACTER C t
+ (CHARWD R 0.278)
+ (CHARHT R 0.5905)
+ (CHARDP R 0.008)
+ (CHARIC R 0.001)
+ (MAP
+ (SETCHAR C t)
+ )
+ )
+(CHARACTER C u
+ (CHARWD R 0.5)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C u)
+ )
+ )
+(CHARACTER C v
+ (CHARWD R 0.5)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN C a R -0.025)
+ (KRN O 54 R -0.065)
+ (KRN C e R -0.015)
+ (KRN C o R -0.02)
+ (KRN O 56 R -0.065)
+ )
+ (MAP
+ (SETCHAR C v)
+ )
+ )
+(CHARACTER C w
+ (CHARWD R 0.722)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.0125)
+ (COMMENT
+ (KRN C a R -0.01)
+ (KRN O 54 R -0.065)
+ (KRN C e R 0.0)
+ (KRN C h R 0.0)
+ (KRN C o R -0.01)
+ (KRN O 56 R -0.065)
+ )
+ (MAP
+ (SETCHAR C w)
+ )
+ )
+(CHARACTER C x
+ (CHARWD R 0.5)
+ (CHARHT R 0.4585)
+ (COMMENT
+ (KRN C e R -0.015)
+ )
+ (MAP
+ (SETCHAR C x)
+ )
+ )
+(CHARACTER C y
+ (CHARWD R 0.5)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.218)
+ (COMMENT
+ (KRN C a R 0.0)
+ (KRN O 54 R -0.065)
+ (KRN C e R 0.0)
+ (KRN C o R 0.0)
+ (KRN O 56 R -0.065)
+ )
+ (MAP
+ (SETCHAR C y)
+ )
+ )
+(CHARACTER C z
+ (CHARWD R 0.444)
+ (CHARHT R 0.4585)
+ (COMMENT
+ (KRN C e R 0.0)
+ (KRN C o R 0.0)
+ )
+ (MAP
+ (SETCHAR C z)
+ )
+ )
+(CHARACTER O 173
+ (CHARWD R 0.48)
+ (CHARHT R 0.673)
+ (CHARDP R 0.179)
+ (MAP
+ (SETCHAR O 173)
+ )
+ )
+(CHARACTER O 174
+ (CHARWD R 0.2)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR O 174)
+ )
+ )
+(CHARACTER O 175
+ (CHARWD R 0.48)
+ (CHARHT R 0.673)
+ (CHARDP R 0.179)
+ (MAP
+ (SETCHAR O 175)
+ )
+ )
+(CHARACTER O 176
+ (CHARWD R 0.333)
+ (CHARHT R 0.6305)
+ (MAP
+ (SETCHAR O 304)
+ )
+ )
+(CHARACTER O 177
+ (CHARWD R 0.333)
+ (CHARHT R 0.6305)
+ (MAP
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 200
+ (CHARWD R 0.469)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 136)
+ )
+ )
+(CHARACTER O 201
+ (CHARWD R 0.541)
+ (CHARHT R 0.3165)
+ (MAP
+ (SETCHAR O 176)
+ )
+ )
+(CHARACTER O 202
+ (CHARWD R 0.611)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C Z)
+ (MOVERIGHT R -0.472)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 317)
+ )
+ )
+(CHARACTER O 203
+ (CHARWD R 0.444)
+ (CHARHT R 0.4585)
+ (CHARDP R 0.216)
+ (MAP
+ (SETCHAR C c)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 313)
+ )
+ )
+(CHARACTER O 204
+ (CHARWD R 0.5)
+ (CHARHT R 0.6305)
+ (CHARDP R 0.218)
+ (MAP
+ (SETCHAR C y)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 205
+ (CHARWD R 0.444)
+ (CHARHT R 0.6305)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C a)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 304)
+ )
+ )
+(CHARACTER O 206
+ (CHARWD R 0.278)
+ (CHARHT R 0.673)
+ (CHARIC R 0.017)
+ (MAP
+ (SETCHAR O 365)
+ (MOVERIGHT R -0.305)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 207
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C e)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 210
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C e)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 211
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C e)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 212
+ (CHARWD R 0.5)
+ (CHARHT R 0.6305)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C o)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 304)
+ )
+ )
+(CHARACTER O 213
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C A)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 214
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C o)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 215
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.218)
+ (MAP
+ (SETCHAR C y)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 216
+ (CHARWD R 0.5)
+ (CHARHT R 0.6305)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C u)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 217
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C a)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 220
+ (CHARWD R 0.444)
+ (CHARHT R 0.6305)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C e)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 221
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C u)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 222
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C o)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 223
+ (CHARWD R 0.389)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C s)
+ (MOVERIGHT R -0.361)
+ (SETCHAR O 317)
+ )
+ )
+(CHARACTER O 224
+ (CHARWD R 0.333)
+ (CHARHT R 0.8425)
+ (MAP
+ (SETCHAR C I)
+ (MOVERIGHT R -0.333)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 225
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C u)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 226
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C a)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 227
+ (CHARWD R 0.5)
+ (CHARHT R 0.6305)
+ (MAP
+ (SETCHAR C n)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 304)
+ )
+ )
+(CHARACTER O 230
+ (CHARWD R 0.444)
+ (CHARHT R 0.6995)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C a)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 312)
+ )
+ )
+(CHARACTER O 231
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR C z)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 317)
+ )
+ )
+(CHARACTER O 232
+ (CHARWD R 0.333)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C I)
+ (MOVERIGHT R -0.333)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 233
+ (CHARWD R 0.722)
+ (CHARHT R 0.8425)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C N)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 304)
+ )
+ )
+(CHARACTER O 234
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C u)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 235
+ (CHARWD R 0.611)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C E)
+ (MOVERIGHT R -0.472)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 236
+ (CHARWD R 0.333)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C I)
+ (MOVERIGHT R -0.333)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 237
+ (CHARWD R 0.667)
+ (CHARHT R 0.673)
+ (CHARDP R 0.216)
+ (MAP
+ (SETCHAR C C)
+ (MOVERIGHT R -0.5)
+ (SETCHAR O 313)
+ )
+ )
+(CHARACTER O 240
+ (CHARWD R 0.722)
+ (CHARHT R 0.8425)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C O)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 241
+ (CHARWD R 0.556)
+ (CHARHT R 0.8965)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C S)
+ (MOVERIGHT R -0.444)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 317)
+ )
+ )
+(CHARACTER O 242
+ (CHARWD R 0.5)
+ (CHARHT R 0.5905)
+ (CHARDP R 0.1395)
+ (MAP
+ (SETCHAR O 242)
+ )
+ )
+(CHARACTER O 243
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR O 243)
+ )
+ )
+(CHARACTER O 244
+ (CHARWD R 0.167)
+ (CHARHT R 0.673)
+ (CHARDP R 0.0125)
+ (CHARIC R 0.164)
+ (MAP
+ (SETCHAR O 244)
+ )
+ )
+(CHARACTER O 245
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARIC R 0.012)
+ (MAP
+ (SETCHAR O 245)
+ )
+ )
+(CHARACTER O 246
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.189)
+ (MAP
+ (SETCHAR O 246)
+ )
+ )
+(CHARACTER O 247
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.1485)
+ (MAP
+ (SETCHAR O 247)
+ )
+ )
+(CHARACTER O 250
+ (CHARWD R 0.5)
+ (CHARHT R 0.5905)
+ (CHARIC R 0.022)
+ (MAP
+ (SETCHAR O 250)
+ )
+ )
+(CHARACTER O 251
+ (CHARWD R 0.611)
+ (CHARHT R 0.8425)
+ (MAP
+ (SETCHAR C E)
+ (MOVERIGHT R -0.472)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 252
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (COMMENT
+ (KRN C A R -0.08)
+ (KRN O 140 R 0.0)
+ )
+ (MAP
+ (SETCHAR O 252)
+ )
+ )
+(CHARACTER O 253
+ (CHARWD R 0.5)
+ (CHARHT R 0.416)
+ (MAP
+ (SETCHAR O 253)
+ )
+ )
+(CHARACTER O 254
+ (CHARWD R 0.333)
+ (CHARHT R 0.416)
+ (MAP
+ (SETCHAR O 254)
+ )
+ )
+(CHARACTER O 255
+ (CHARWD R 0.333)
+ (CHARHT R 0.416)
+ (MAP
+ (SETCHAR O 255)
+ )
+ )
+(CHARACTER O 256
+ (CHARWD R 0.556)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 256)
+ )
+ )
+(CHARACTER O 257
+ (CHARWD R 0.556)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 257)
+ )
+ )
+(CHARACTER O 260
+ (CHARWD R 0.333)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C I)
+ (MOVERIGHT R -0.333)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 261
+ (CHARWD R 0.5)
+ (CHARHT R 0.2535)
+ (COMMENT
+ (LIG O 55 O 320)
+ )
+ (MAP
+ (SETCHAR O 261)
+ )
+ )
+(CHARACTER O 262
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.1485)
+ (MAP
+ (SETCHAR O 262)
+ )
+ )
+(CHARACTER O 263
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.1545)
+ (MAP
+ (SETCHAR O 263)
+ )
+ )
+(CHARACTER O 264
+ (CHARWD R 0.25)
+ (CHARHT R 0.3165)
+ (MAP
+ (SETCHAR O 264)
+ )
+ )
+(CHARACTER O 265
+ (CHARWD R 0.444)
+ (CHARHT R 0.6305)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C a)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 266
+ (CHARWD R 0.453)
+ (CHARHT R 0.673)
+ (CHARDP R 0.1545)
+ (MAP
+ (SETCHAR O 266)
+ )
+ )
+(CHARACTER O 267
+ (CHARWD R 0.35)
+ (CHARHT R 0.4585)
+ (MAP
+ (SETCHAR O 267)
+ )
+ )
+(CHARACTER O 270
+ (CHARWD R 0.333)
+ (CHARHT R 0.101)
+ (CHARDP R 0.1395)
+ (MAP
+ (SETCHAR O 270)
+ )
+ )
+(CHARACTER O 271
+ (CHARWD R 0.444)
+ (CHARHT R 0.101)
+ (CHARDP R 0.1395)
+ (MAP
+ (SETCHAR O 271)
+ )
+ )
+(CHARACTER O 272
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 272)
+ )
+ )
+(CHARACTER O 273
+ (CHARWD R 0.5)
+ (CHARHT R 0.416)
+ (MAP
+ (SETCHAR O 273)
+ )
+ )
+(CHARACTER O 274
+ (CHARWD R 1.0)
+ (CHARHT R 0.101)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR O 274)
+ )
+ )
+(CHARACTER O 275
+ (CHARWD R 1.0)
+ (CHARHT R 0.6995)
+ (CHARDP R 0.0205)
+ (MAP
+ (SETCHAR O 275)
+ )
+ )
+(CHARACTER O 276
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C O)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 277
+ (CHARWD R 0.611)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C E)
+ (MOVERIGHT R -0.472)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 300
+ (CHARWD R 0.722)
+ (CHARHT R 0.8425)
+ (MAP
+ (SETCHAR C Y)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 301
+ (CHARWD R 0.722)
+ (CHARHT R 0.8425)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C O)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 304)
+ )
+ )
+(CHARACTER O 302
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C U)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 303
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C U)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 304
+ (CHARWD R 0.722)
+ (CHARHT R 0.8425)
+ (MAP
+ (SETCHAR C A)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 304)
+ )
+ )
+(CHARACTER O 305
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C U)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 306
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C O)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 307
+ (CHARWD R 0.333)
+ (CHARHT R 0.6305)
+ (MAP
+ (SETCHAR O 307)
+ )
+ )
+(CHARACTER O 310
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C A)
+ (MOVERIGHT R -0.537)
+ (MOVEDOWN R -0.187)
+ (SETCHAR O 312)
+ )
+ )
+(CHARACTER O 311
+ (CHARWD R 0.278)
+ (CHARHT R 0.6305)
+ (CHARIC R 0.01)
+ (MAP
+ (SETCHAR O 365)
+ (MOVERIGHT R -0.305)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 312
+ (CHARWD R 0.278)
+ (CHARHT R 0.673)
+ (CHARIC R 0.012)
+ (MAP
+ (SETCHAR O 365)
+ (MOVERIGHT R -0.305)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 313
+ (CHARWD R 0.444)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C a)
+ (MOVERIGHT R -0.388)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 314
+ (CHARWD R 0.722)
+ (CHARHT R 0.8425)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C U)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 315
+ (CHARWD R 0.333)
+ (CHARHT R 0.673)
+ (CHARIC R 0.044)
+ (MAP
+ (SETCHAR O 315)
+ )
+ )
+(CHARACTER O 316
+ (CHARWD R 0.333)
+ (CHARDP R 0.165)
+ (MAP
+ (SETCHAR O 316)
+ )
+ )
+(CHARACTER O 317
+ (CHARWD R 0.611)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C E)
+ (MOVERIGHT R -0.472)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 320
+ (CHARWD R 1.0)
+ (CHARHT R 0.2535)
+ (MAP
+ (SETCHAR O 320)
+ )
+ )
+(CHARACTER O 321
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C A)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 303)
+ )
+ )
+(CHARACTER O 322
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C A)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 323
+ (CHARWD R 0.5)
+ (CHARHT R 0.6305)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C o)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 324
+ (CHARWD R 0.5)
+ (CHARHT R 0.673)
+ (CHARDP R 0.008)
+ (MAP
+ (SETCHAR C o)
+ (MOVERIGHT R -0.416)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 325
+ (CHARWD R 0.278)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 365)
+ (MOVERIGHT R -0.305)
+ (SETCHAR O 301)
+ )
+ )
+(CHARACTER O 326
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (CHARDP R 0.0125)
+ (MAP
+ (SETCHAR C O)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 327
+ (CHARWD R 0.722)
+ (CHARHT R 0.8425)
+ (MAP
+ (SETCHAR C A)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 310)
+ )
+ )
+(CHARACTER O 330
+ (CHARWD R 0.722)
+ (CHARHT R 0.8965)
+ (MAP
+ (SETCHAR C Y)
+ (MOVERIGHT R -0.527)
+ (MOVEDOWN R -0.212)
+ (SETCHAR O 302)
+ )
+ )
+(CHARACTER O 343
+ (CHARWD R 0.276)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 343)
+ )
+ )
+(CHARACTER O 350
+ (CHARWD R 0.611)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 350)
+ )
+ )
+(CHARACTER O 353
+ (CHARWD R 0.31)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 353)
+ )
+ )
+(CHARACTER O 370
+ (CHARWD R 0.278)
+ (CHARHT R 0.673)
+ (MAP
+ (SETCHAR O 370)
+ )
+ )
diff --git a/Build/source/texk/web2c/tests/rpsyr.tfm b/Build/source/texk/web2c/tests/rpsyr.tfm
new file mode 100644
index 00000000000..78fcda34257
--- /dev/null
+++ b/Build/source/texk/web2c/tests/rpsyr.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/rptmr.tfm b/Build/source/texk/web2c/tests/rptmr.tfm
new file mode 100644
index 00000000000..c09c4b0ba08
--- /dev/null
+++ b/Build/source/texk/web2c/tests/rptmr.tfm
Binary files differ
diff --git a/Build/source/texk/web2c/tests/story.dvi b/Build/source/texk/web2c/tests/story.dvi
new file mode 100644
index 00000000000..e5ef75da5b7
--- /dev/null
+++ b/Build/source/texk/web2c/tests/story.dvi
Binary files differ
diff --git a/Build/source/texk/web2c/tests/testex.err b/Build/source/texk/web2c/tests/testex.err
new file mode 100644
index 00000000000..22f736a4825
--- /dev/null
+++ b/Build/source/texk/web2c/tests/testex.err
@@ -0,0 +1,5 @@
+! Error in testex1 at line 16: string does not end
+! Error in testex1 at line 17: unmatched etex
+! Error in testex1 at line 18: verbatimtex in TeX mode
+! Error in testex1 at line 19: btex in TeX mode
+! Error in testex1 at line 21: string does not end
diff --git a/Build/source/texk/web2c/tests/testex.mp b/Build/source/texk/web2c/tests/testex.mp
new file mode 100644
index 00000000000..70377116f8d
--- /dev/null
+++ b/Build/source/texk/web2c/tests/testex.mp
@@ -0,0 +1,21 @@
+MetaPost would not accept this file. It is just for
+testing mptotex.
+
+non-tex material is ignored.
+`words' like betextify and etex_plus are OK too.
+Now[]verbatimtex TeX \hsize="a0 in
+more TeX % with comments etex (That counts
+even though it follows a %-sign
+A string "even with etex or btex in it" is ignored
+TeX material such as btex$a+b$ etex is often very short. btex
+An initial newline is now ignored. etex (as of Version 0.60)
+
+Removing the initial %-sign on any of the following
+lines should cause an error:
+
+% an "unbalanced string
+% unmatched etex
+% btex verbatimtex in tex mode etex
+% btex tex text btex more text etex.
+% a non-ending verbatimtex section
+No visible "etex" here.
diff --git a/Build/source/texk/web2c/tests/testex.tex b/Build/source/texk/web2c/tests/testex.tex
new file mode 100644
index 00000000000..94b95283da0
--- /dev/null
+++ b/Build/source/texk/web2c/tests/testex.tex
@@ -0,0 +1,7 @@
+% line 6 testex.mp
+TeX \hsize="a0 inmore TeX % with comments%
+\shipout\hbox{\smash{\hbox{\hbox{% line 10 testex.mp
+$a+b$}\vrule width1sp}}}
+\shipout\hbox{\smash{\hbox{\hbox{% line 10 testex.mp
+An initial newline is now ignored.}\vrule width1sp}}}
+\end{document}
diff --git a/Build/source/texk/web2c/tests/translate b/Build/source/texk/web2c/tests/translate
new file mode 100644
index 00000000000..14244907c78
--- /dev/null
+++ b/Build/source/texk/web2c/tests/translate
@@ -0,0 +1,34 @@
+ 2 2 translate file for test
+++ these ...
+ ... are ...
+?? ... comments
+ a A
+ "a "A
+ b B
+ c C
+ "c "C
+ d D
+-e-E--
+õ`eõ`Eõõ
+ f F
+ g G
+ h H
+ i I
+ j J
+ k K
+ l L
+ m M
+ n N
+ o O
+ p P
+ q Q
+ r R
+ s S
+?\ss ?á?"s?"S?? converts `á', `"s', and `"S' into `\ss '
+ t T
+ u U
+ v V
+ w W
+ x X
+ y Y
+ z Z
diff --git a/Build/source/texk/web2c/tests/uno.dos b/Build/source/texk/web2c/tests/uno.dos
new file mode 100644
index 00000000000..18f593054be
--- /dev/null
+++ b/Build/source/texk/web2c/tests/uno.dos
@@ -0,0 +1 @@
+\bye
diff --git a/Build/source/texk/web2c/tests/write18.tex b/Build/source/texk/web2c/tests/write18.tex
new file mode 100644
index 00000000000..4a2b0ee00f9
--- /dev/null
+++ b/Build/source/texk/web2c/tests/write18.tex
@@ -0,0 +1,2 @@
+\immediate\write18{echo this is write18 output from echo}
+\bye
diff --git a/Build/source/texk/web2c/tests/xampl.bib b/Build/source/texk/web2c/tests/xampl.bib
new file mode 100644
index 00000000000..dfd1269022d
--- /dev/null
+++ b/Build/source/texk/web2c/tests/xampl.bib
@@ -0,0 +1,356 @@
+@preamble{ "\newcommand{\noopsort}[1]{} "
+ # "\newcommand{\printfirst}[2]{#1} "
+ # "\newcommand{\singleletter}[1]{#1} "
+ # "\newcommand{\switchargs}[2]{#2#1} " }
+
+@ARTICLE{article-minimal,
+ author = {L[eslie] A. Aamport},
+ title = {The Gnats and Gnus Document Preparation System},
+ journal = {\mbox{G-Animal's} Journal},
+ year = 1986,
+}
+
+@ARTICLE{article-full,
+ author = {L[eslie] A. Aamport},
+ title = {The Gnats and Gnus Document Preparation System},
+ journal = {\mbox{G-Animal's} Journal},
+ year = 1986,
+ volume = 41,
+ number = 7,
+ pages = "73+",
+ month = jul,
+ note = "This is a full ARTICLE entry",
+}
+
+The KEY field is here to override the KEY field in the journal being
+cross referenced (so is the NOTE field, in addition to its imparting
+information).
+
+@ARTICLE{article-crossref,
+ crossref = {WHOLE-JOURNAL},
+ key = "",
+ author = {L[eslie] A. Aamport},
+ title = {The Gnats and Gnus Document Preparation System},
+ pages = "73+",
+ note = "This is a cross-referencing ARTICLE entry",
+}
+
+@ARTICLE{whole-journal,
+ key = "GAJ",
+ journal = {\mbox{G-Animal's} Journal},
+ year = 1986,
+ volume = 41,
+ number = 7,
+ month = jul,
+ note = {The entire issue is devoted to gnats and gnus
+ (this entry is a cross-referenced ARTICLE (journal))},
+}
+
+@INBOOK{inbook-minimal,
+ author = "Donald E. Knuth",
+ title = "Fundamental Algorithms",
+ publisher = "Addison-Wesley",
+ year = "{\noopsort{1973b}}1973",
+ chapter = "1.2",
+}
+
+@INBOOK{inbook-full,
+ author = "Donald E. Knuth",
+ title = "Fundamental Algorithms",
+ volume = 1,
+ series = "The Art of Computer Programming",
+ publisher = "Addison-Wesley",
+ address = "Reading, Massachusetts",
+ edition = "Second",
+ month = "10~" # jan,
+ year = "{\noopsort{1973b}}1973",
+ type = "Section",
+ chapter = "1.2",
+ pages = "10--119",
+ note = "This is a full INBOOK entry",
+}
+
+@INBOOK{inbook-crossref,
+ crossref = "whole-set",
+ title = "Fundamental Algorithms",
+ volume = 1,
+ series = "The Art of Computer Programming",
+ edition = "Second",
+ year = "{\noopsort{1973b}}1973",
+ type = "Section",
+ chapter = "1.2",
+ note = "This is a cross-referencing INBOOK entry",
+}
+
+@BOOK{book-minimal,
+ author = "Donald E. Knuth",
+ title = "Seminumerical Algorithms",
+ publisher = "Addison-Wesley",
+ year = "{\noopsort{1973c}}1981",
+}
+
+@BOOK{book-full,
+ author = "Donald E. Knuth",
+ title = "Seminumerical Algorithms",
+ volume = 2,
+ series = "The Art of Computer Programming",
+ publisher = "Addison-Wesley",
+ address = "Reading, Massachusetts",
+ edition = "Second",
+ month = "10~" # jan,
+ year = "{\noopsort{1973c}}1981",
+ note = "This is a full BOOK entry",
+}
+
+@BOOK{book-crossref,
+ crossref = "whole-set",
+ title = "Seminumerical Algorithms",
+ volume = 2,
+ series = "The Art of Computer Programming",
+ edition = "Second",
+ year = "{\noopsort{1973c}}1981",
+ note = "This is a cross-referencing BOOK entry",
+}
+
+@BOOK{whole-set,
+ author = "Donald E. Knuth",
+ publisher = "Addison-Wesley",
+ title = "The Art of Computer Programming",
+ series = "Four volumes",
+ year = "{\noopsort{1973a}}{\switchargs{--90}{1968}}",
+ note = "Seven volumes planned (this is a cross-referenced set of BOOKs)",
+}
+
+@BOOKLET{booklet-minimal,
+ key = "Kn{\printfirst{v}{1987}}",
+ title = "The Programming of Computer Art",
+}
+
+@BOOKLET{booklet-full,
+ author = "Jill C. Knvth",
+ title = "The Programming of Computer Art",
+ howpublished = "Vernier Art Center",
+ address = "Stanford, California",
+ month = feb,
+ year = 1988,
+ note = "This is a full BOOKLET entry",
+}
+
+@INCOLLECTION{incollection-minimal,
+ author = "Daniel D. Lincoll",
+ title = "Semigroups of Recurrences",
+ booktitle = "High Speed Computer and Algorithm Organization",
+ publisher = "Academic Press",
+ year = 1977,
+}
+
+@INCOLLECTION{incollection-full,
+ author = "Daniel D. Lincoll",
+ title = "Semigroups of Recurrences",
+ editor = "David J. Lipcoll and D. H. Lawrie and A. H. Sameh",
+ booktitle = "High Speed Computer and Algorithm Organization",
+ number = 23,
+ series = "Fast Computers",
+ chapter = 3,
+ type = "Part",
+ pages = "179--183",
+ publisher = "Academic Press",
+ address = "New York",
+ edition = "Third",
+ month = sep,
+ year = 1977,
+ note = "This is a full INCOLLECTION entry",
+}
+
+@INCOLLECTION{incollection-crossref,
+ crossref = "whole-collection",
+ author = "Daniel D. Lincoll",
+ title = "Semigroups of Recurrences",
+ pages = "179--183",
+ note = "This is a cross-referencing INCOLLECTION entry",
+}
+
+@BOOK{whole-collection,
+ editor = "David J. Lipcoll and D. H. Lawrie and A. H. Sameh",
+ title = "High Speed Computer and Algorithm Organization",
+ booktitle = "High Speed Computer and Algorithm Organization",
+ number = 23,
+ series = "Fast Computers",
+ publisher = "Academic Press",
+ address = "New York",
+ edition = "Third",
+ month = sep,
+ year = 1977,
+ note = "This is a cross-referenced BOOK (collection) entry",
+}
+
+@MANUAL{manual-minimal,
+ key = "Manmaker",
+ title = "The Definitive Computer Manual",
+}
+
+@MANUAL{manual-full,
+ author = "Larry Manmaker",
+ title = "The Definitive Computer Manual",
+ organization = "Chips-R-Us",
+ address = "Silicon Valley",
+ edition = "Silver",
+ month = apr # "-" # may,
+ year = 1986,
+ note = "This is a full MANUAL entry",
+}
+
+@MASTERSTHESIS{mastersthesis-minimal,
+ author = "{\'{E}}douard Masterly",
+ title = "Mastering Thesis Writing",
+ school = "Stanford University",
+ year = 1988,
+}
+
+@MASTERSTHESIS{mastersthesis-full,
+ author = "{\'{E}}douard Masterly",
+ title = "Mastering Thesis Writing",
+ school = "Stanford University",
+ type = "Master's project",
+ address = "English Department",
+ month = jun # "-" # aug,
+ year = 1988,
+ note = "This is a full MASTERSTHESIS entry",
+}
+
+@MISC{misc-minimal,
+ key = "Missilany",
+ note = "This is a minimal MISC entry",
+}
+
+@MISC{misc-full,
+ author = "Joe-Bob Missilany",
+ title = "Handing out random pamphlets in airports",
+ howpublished = "Handed out at O'Hare",
+ month = oct,
+ year = 1984,
+ note = "This is a full MISC entry",
+}
+
+@STRING{STOC-key = "OX{\singleletter{stoc}}"}
+
+@STRING{ACM = "The OX Association for Computing Machinery"}
+
+@STRING{STOC = " Symposium on the Theory of Computing"}
+
+@INPROCEEDINGS{inproceedings-minimal,
+ author = "Alfred V. Oaho and Jeffrey D. Ullman and Mihalis Yannakakis",
+ title = "On Notions of Information Transfer in {VLSI} Circuits",
+ booktitle = "Proc. Fifteenth Annual ACM" # STOC,
+ year = 1983,
+}
+
+@INPROCEEDINGS{inproceedings-full,
+ author = "Alfred V. Oaho and Jeffrey D. Ullman and Mihalis Yannakakis",
+ title = "On Notions of Information Transfer in {VLSI} Circuits",
+ editor = "Wizard V. Oz and Mihalis Yannakakis",
+ booktitle = "Proc. Fifteenth Annual ACM" # STOC,
+ number = 17,
+ series = "All ACM Conferences",
+ pages = "133--139",
+ month = mar,
+ year = 1983,
+ address = "Boston",
+ organization = ACM,
+ publisher = "Academic Press",
+ note = "This is a full INPROCEDINGS entry",
+}
+
+@INPROCEEDINGS{inproceedings-crossref,
+ crossref = "whole-proceedings",
+ author = "Alfred V. Oaho and Jeffrey D. Ullman and Mihalis Yannakakis",
+ title = "On Notions of Information Transfer in {VLSI} Circuits",
+ organization = "",
+ pages = "133--139",
+ note = "This is a cross-referencing INPROCEEDINGS entry",
+}
+
+@PROCEEDINGS{proceedings-minimal,
+ key = STOC-key,
+ title = "Proc. Fifteenth Annual" # STOC,
+ year = 1983,
+}
+
+@PROCEEDINGS{proceedings-full,
+ editor = "Wizard V. Oz and Mihalis Yannakakis",
+ title = "Proc. Fifteenth Annual" # STOC,
+ number = 17,
+ series = "All ACM Conferences",
+ month = mar,
+ year = 1983,
+ address = "Boston",
+ organization = ACM,
+ publisher = "Academic Press",
+ note = "This is a full PROCEEDINGS entry",
+}
+
+@PROCEEDINGS{whole-proceedings,
+ key = STOC-key,
+ organization = ACM,
+ title = "Proc. Fifteenth Annual" # STOC,
+ address = "Boston",
+ year = 1983,
+ booktitle = "Proc. Fifteenth Annual ACM" # STOC,
+ note = "This is a cross-referenced PROCEEDINGS",
+}
+
+@PHDTHESIS{phdthesis-minimal,
+ author = "F. Phidias Phony-Baloney",
+ title = "Fighting Fire with Fire: Festooning {F}rench Phrases",
+ school = "Fanstord University",
+ year = 1988,
+}
+
+@PHDTHESIS{phdthesis-full,
+ author = "F. Phidias Phony-Baloney",
+ title = "Fighting Fire with Fire: Festooning {F}rench Phrases",
+ school = "Fanstord University",
+ type = "{PhD} Dissertation",
+ address = "Department of French",
+ month = jun # "-" # aug,
+ year = 1988,
+ note = "This is a full PHDTHESIS entry",
+}
+
+@TECHREPORT{techreport-minimal,
+ author = "Tom Terrific",
+ title = "An {$O(n \log n / \! \log\log n)$} Sorting Algorithm",
+ institution = "Fanstord University",
+ year = 1988,
+}
+
+@TECHREPORT{techreport-full,
+ author = "Tom T{\'{e}}rrific",
+ title = "An {$O(n \log n / \! \log\log n)$} Sorting Algorithm",
+ institution = "Fanstord University",
+ type = "Wishful Research Result",
+ number = "7",
+ address = "Computer Science Department, Fanstord, California",
+ month = oct,
+ year = 1988,
+ note = "This is a full TECHREPORT entry",
+}
+
+@UNPUBLISHED{unpublished-minimal,
+ author = "Ulrich {\"{U}}nderwood and Ned {\~N}et and Paul {\={P}}ot",
+ title = "Lower Bounds for Wishful Research Results",
+ note = "Talk at Fanstord University (this is a minimal UNPUBLISHED entry)",
+}
+
+@UNPUBLISHED{unpublished-full,
+ author = "Ulrich {\"{U}}nderwood and Ned {\~N}et and Paul {\={P}}ot",
+ title = "Lower Bounds for Wishful Research Results",
+ month = nov # ", " # dec,
+ year = 1988,
+ note = "Talk at Fanstord University (this is a full UNPUBLISHED entry)",
+}
+
+@MISC{random-note-crossref,
+ key = {Volume-2},
+ note = "Volume~2 is listed under Knuth \cite{book-full}"
+}
diff --git a/Build/source/texk/web2c/tex-supp-w32.ch b/Build/source/texk/web2c/tex-supp-w32.ch
new file mode 100644
index 00000000000..707bacaf7a3
--- /dev/null
+++ b/Build/source/texk/web2c/tex-supp-w32.ch
@@ -0,0 +1,86 @@
+@x
+@!file_line_error_style_p:boolean; {format error messages as file:line:error}
+@y
+@!file_line_error_style_p:boolean; {format error messages as file:line:error}
+@!halt_on_error_p:boolean; {stop at first error.}
+@!quoted_filename : boolean;
+@z
+
+@x l:1927
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+@y
+ ready_already:=0;
+ texmf_finish_job;
+ if (history <> spotless) and (history <> warning_issued) then
+@z
+
+@x l:1951
+else begin print_char("."); show_context end;
+@y
+else begin print_char("."); show_context end;
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+@z
+
+@x l:10101
+begin area_delimiter:=0; ext_delimiter:=0;
+@y
+begin area_delimiter:=0; ext_delimiter:=0;
+quoted_filename:=false;
+@z
+
+@x l:10111
+begin if stop_at_space and (c=" ") then more_name:=false
+else begin str_room(1); append_char(c); {contribute |c| to the current string}
+@y
+begin
+if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+end;
+if (c=" ") and stop_at_space and (not quoted_filename) then more_name:=false
+else begin
+ if (c="*") then c:=" "
+ else if (c="?") then c:="~";
+ str_room(1); append_char(c); {contribute |c| to the current string}
+@z
+
+@x l:10175
+begin slow_print(a); slow_print(n); slow_print(e);
+@y
+begin texmf_print_filename (a, n, e);
+@z
+
+@x l:10184
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+@x l:13060
+ print_nl("Output written on "); slow_print(output_file_name);
+@y
+ print_nl("Output written on "); texmf_print_filename(0, output_file_name, 0);
+@z
+
+@x
+begin @!{|start_here|}
+@y
+begin @!{|start_here|}
+
+ texmf_start_job;
+@z
+
+@x l:24891
+ slow_print(log_name); print_char(".");
+ end;
+@y
+ texmf_print_filename(0, log_name, 0); print_char(".");
+ end;
+@z
diff --git a/Build/source/texk/web2c/tex.ch b/Build/source/texk/web2c/tex.ch
new file mode 100644
index 00000000000..e0da76b7b89
--- /dev/null
+++ b/Build/source/texk/web2c/tex.ch
@@ -0,0 +1,5808 @@
+% tex.ch for C compilation with web2c, derived from various other change files.
+% By Tim Morgan, UC Irvine ICS Department, and many others.
+%
+% Be very careful when making changes to this file, as it is used to
+% generate TeX, e-TeX, and pdf[ex]TeX, and most changes require similar
+% changes to be made to the Omega sources.
+%
+% (05/28/86) ETM Started with TeX 2.0
+% (06/03/87) ETM Brought up to TeX 2.2
+% (09/26/87) ETM Brought up to TeX 2.3
+% (10/01/87) ETM Brought up to TeX 2.5
+% (12/21/87) ETM Brought up to TeX 2.7
+% (01/14/88) ETM Brought up to TeX 2.9
+% (02/20/88) PAM Revised format and module numbers
+% (03/01/88) ETM Eliminated some unused variables and unnecesary tests
+% (05/09/88) ETM Added yet another casting bug fix
+% (06/21/88) ETM Brought up to TeX version 2.93
+% (12/11/88) ETM Brought up to TeX version 2.94
+% (01/12/89) PAM Brought up to TeX version 2.95
+% (02/14/89) ETM Brought up to TeX version 2.96
+% (03/10/89) ETM Brought up to TeX version 2.98
+% (07/06/89) ETM Brought up to TeX version 2.991
+% (11/30/89) KB To version 2.992 (8-bit).
+% (01/10/90) SR To version 2.993.
+% (03/27/90) KY To version 3.0.
+% (more recent changes in ChangeLog)
+%
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+%
+% Includes MLTEX.CH (Version 2.2) in text format, as of Dec 17, 1995.
+% MLTeX is copyright (C) 1990-92 by Michael J. Ferguson; all rights reserved.
+% MLTeX Version 2.2 is copyright (C) 1995 by B. Raichle; all rights reserved.
+%
+% The MLTeX changes are copyrighted so that we have some chance to
+% forbid unauthorized copies; we explicitly authorize copying of
+% correct MLTeX implementations, and not of incorrect ones!
+%
+% (This means that you can use the MLTeX changes as free as you can
+% use TeX and its algorithm.)
+%
+% Copying of this file is authorized only if either
+% (1) you make absolutely no changes to your copy, including name, or
+% (2) if you do make changes, you name it to something other than
+% "mltex.ch", "char_sub.ch", or "charsub.ch".
+%
+% The module numbers in this change file refer to TEX.WEB 3.14159 as
+% of March, 1995 (published as Donald E. Knuth, TeX: The Program,
+% Volume B of Computers & Typesetting).
+
+@x [0.0] l.83 - WEAVE: print changes only.
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+@y 83
+ \def\?##1]{\hbox{Changes to \hbox to 1em{\hfil##1}.\ }}
+ }
+\let\maybe=\iffalse
+@z
+
+@x [1.2] l.185 - MLTeX: add comment about banner line change
+November 1984].
+@y
+November 1984].
+
+ML\TeX{} will add new primitives changing the behaviour of \TeX. The
+|banner| string has to be changed. We do not change the |banner|
+string, but will output an additional line to make clear that this is
+a modified \TeX{} version.
+
+@z
+
+@x [1.2] l.188
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@y
+@d TeX_banner_k=='This is TeXk, Version 3.141592' {printed when \TeX\ starts}
+@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@#
+@d banner==TeX_banner
+@d banner_k==TeX_banner_k
+@z
+
+@x [1.4] l.233 - program header
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \TeX\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+@y
+@z
+
+@x [1.4] l.243 - labels in outer block not needed
+program TEX; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+@y
+program TEX; {all file names are defined dynamically}
+@z
+
+@x [1.6] l.267 - labels in outer block not needed
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d end_of_TEX=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
+ {key control points}
+@y
+@ For Web2c, labels are not declared in the main program, but
+we still have to declare the symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d final_end=9999 {this label marks the ending of the program}
+@z
+
+% Here we change these WEB symbols, which are used much as #ifdef's
+% are in C, into something which will get translated into actual #ifdef's.
+@x [1.7] l.292 - debug..gubed, stat..tats
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==ifdef('TEXMF_DEBUG')
+@d gubed==endif('TEXMF_DEBUG')
+@z
+@x [1.7] l.297 - debug..gubed, stat..tats
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@y
+@d stat==ifdef('STAT')
+@d tats==endif('STAT')
+@z
+
+@x [1.8] Somewhat different for `init...tini'.. 310 m.8
+the codewords `$|init|\ldots|tini|$'.
+
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y 314
+the codewords `$|init|\ldots|tini|$' for declarations and by the codewords
+`$|Init|\ldots|Tini|$' for executable code. This distinction is helpful for
+implementations where a run-time switch differentiates between the two
+versions of the program.
+
+@d init==ifdef('INITEX')
+@d tini==endif('INITEX')
+@d Init==init if ini_version then begin
+@d Tini==end;@+tini
+@f Init==begin
+@f Tini==end
+@z
+
+@x [1.8] l.319 - init...tini is dynamic
+@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
+@y 318
+@!Init @<Initialize table entries (done by \.{INITEX} only)@>@;@+Tini
+@z
+
+@x [1.11] l.375 - Compile-time constants: most removed for dynamic allocation.
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TeXformats:TEX.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@y
+@d file_name_size == maxint
+@d ssup_error_line = 255
+@d ssup_max_strings == 262143
+{Larger values than 65536 cause the arrays consume much more memory.}
+@d ssup_trie_opcode == 65535
+@d ssup_trie_size == @"3FFFFF
+
+@d ssup_hyph_size == 65535 {Changing this requires changing (un)dumping!}
+@d iinf_hyphen_size == 610 {Must be not less than |hyph_prime|!}
+
+@d max_font_max=2000 {maximum number of internal fonts; this can be
+ increased, but |hash_size+max_font_max|
+ should not exceed 29000.}
+@d font_base=0 {smallest internal font number; must be
+ |>= min_quarterword|; do not change this without
+ modifying the dynamic definition of the font arrays.}
+
+
+@<Constants...@>=
+@!hash_offset=514; {smallest index in hash array, i.e., |hash_base| }
+ {Use |hash_offset=0| for compilers which cannot decrement pointers.}
+@!trie_op_size=35111; {space for ``opcodes'' in the hyphenation patterns;
+ best if relatively prime to 313, 361, and 1009.}
+@!neg_trie_op_size=-35111; {for lower |trie_op_hash| array bound;
+ must be equal to |-trie_op_size|.}
+@!min_trie_op=0; {first possible trie op code for any language}
+@!max_trie_op=ssup_trie_opcode; {largest possible trie opcode for any language}
+@!pool_name=TEXMF_POOL_NAME; {this is configurable, for the sake of ML-\TeX}
+ {string of length |file_name_size|; tells where the string pool appears}
+@!engine_name=TEXMF_ENGINE_NAME; {the name of this engine}
+@#
+@!inf_mem_bot = 0;
+@!sup_mem_bot = 1;
+
+@!inf_main_memory = 3000;
+@!sup_main_memory = 32000000;
+
+@!inf_trie_size = 8000;
+@!sup_trie_size = ssup_trie_size;
+
+@!inf_max_strings = 3000;
+@!sup_max_strings = ssup_max_strings;
+@!inf_strings_free = 100;
+@!sup_strings_free = sup_max_strings;
+
+@!inf_buf_size = 500;
+@!sup_buf_size = 300000;
+
+@!inf_nest_size = 40;
+@!sup_nest_size = 4000;
+
+@!inf_max_in_open = 6;
+@!sup_max_in_open = 127;
+
+@!inf_param_size = 60;
+@!sup_param_size = 6000;
+
+@!inf_save_size = 600;
+@!sup_save_size = 40000;
+
+@!inf_stack_size = 200;
+@!sup_stack_size = 30000;
+
+@!inf_dvi_buf_size = 800;
+@!sup_dvi_buf_size = 65536;
+
+@!inf_font_mem_size = 20000;
+@!sup_font_mem_size = 2000000;
+
+@!sup_font_max = max_font_max;
+@!inf_font_max = 50; {could be smaller, but why?}
+
+@!inf_pool_size = 32000;
+@!sup_pool_size = 40000000;
+@!inf_pool_free = 1000;
+@!sup_pool_free = sup_pool_size;
+@!inf_string_vacancies = 8000;
+@!sup_string_vacancies = sup_pool_size - 23000;
+
+@!sup_hash_extra = sup_max_strings;
+@!inf_hash_extra = 0;
+
+@!sup_hyph_size = ssup_hyph_size;
+@!inf_hyph_size = iinf_hyphen_size; {Must be not less than |hyph_prime|!}
+@z
+
+@x [1.12] l.427 - Constants that are WEB numeric macros.
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d hash_size=10000 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=8501 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions;
+ if you change this, you should also change |iinf_hyphen_size|.}
+@z
+
+@x [1.16] l.498 - Use C macros for `incr' and `decr'.
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@y
+@z
+
+% The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x [2.19] l.565 - data type text_char is 8-bit ASCII_code
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [2.20] l.579 - encTeX: global declarations
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+@y
+xchr: array [ASCII_code] of text_char;
+ { specifies conversion of output characters }
+xprn: array [ASCII_code] of ASCII_code;
+ { non zero iff character is printable }
+mubyte_read: array [ASCII_code] of pointer;
+ { non zero iff character begins the multi byte code }
+mubyte_write: array [ASCII_code] of str_number;
+ { non zero iff character expands to multi bytes in log and write files }
+mubyte_cswrite: array [0..127] of pointer;
+ { non null iff cs mod 128 expands to multi bytes in log and write files }
+mubyte_skip: integer; { the number of bytes to skip in |buffer| }
+mubyte_keep: integer; { the number of chars we need to keep unchanged }
+mubyte_skeep: integer; { saved |mubyte_keep| }
+mubyte_prefix: integer; { the type of mubyte prefix }
+mubyte_tablein: boolean; { the input side of table will be updated }
+mubyte_tableout: boolean; { the output side of table will be updated }
+mubyte_relax: boolean; { the relax prefix is used }
+mubyte_start: boolean; { we are making the token at the start of the line }
+mubyte_sstart: boolean; { saved |mubyte_start| }
+mubyte_token: pointer; { the token returned by |read_buffer| }
+mubyte_stoken: pointer; { saved first token in mubyte primitive }
+mubyte_sout: integer; { saved value of |mubyte_out| }
+mubyte_slog: integer; { saved value of |mubyte_log| }
+spec_sout: integer; { saved value of |spec_out| }
+no_convert: boolean; { conversion supressed by noconvert primitive }
+active_noconvert: boolean; { true if noconvert primitive is active }
+write_noexpanding: boolean; { true only if we need not write expansion }
+cs_converting: boolean; { true only if we need csname converting }
+special_printing: boolean; { true only if we need converting in special }
+message_printing: boolean; { true if message or errmessage prints to string }
+@z
+
+@x [2.23] l.723 - Translate characters if desired, otherwise allow them all.
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+@y
+{Initialize |xchr| to the identity mapping.}
+for i:=0 to @'37 do xchr[i]:=i;
+for i:=@'177 to @'377 do xchr[i]:=i;
+{Initialize enc\TeX\ data.}
+for i:=0 to 255 do mubyte_read[i]:=null;
+for i:=0 to 255 do mubyte_write[i]:=0;
+for i:=0 to 128 do mubyte_cswrite[i]:=null;
+mubyte_keep := 0; mubyte_start := false;
+write_noexpanding := false; cs_converting := false;
+special_printing := false; message_printing := false;
+no_convert := false; active_noconvert := false;
+@z
+
+@x [2.24] l.733 - Don't reinitialize xord.
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+@y
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+{Set |xprn| for printable ASCII, unless |eight_bit_p| is set.}
+for i:=0 to 255 do xprn[i]:=(eight_bit_p or ((i>=" ")and(i<="~")));
+
+{The idea for this dynamic translation comes from the patch by
+ Libor Skarvada \.{<libor@@informatics.muni.cz>}
+ and Petr Sojka \.{<sojka@@informatics.muni.cz>}. I didn't use any of the
+ actual code, though, preferring a more general approach.}
+
+{This updates the |xchr|, |xord|, and |xprn| arrays from the provided
+ |translate_filename|. See the function definition in \.{texmfmp.c} for
+ more comments.}
+if translate_filename then read_tcx_file;
+@z
+
+% [3.26] name_of_file is no longer an array. And change the destination
+% type to text_char, which fixes:
+%
+% Date: 19 Sep 1994 10:38:24 +0200
+% From: thorinn@diku.dk (Lars Mathiesen)
+% When echoed to the screen and in the log, character codes
+% above '177 in file names are shown wrongly (typically as ^@).
+%
+@x [3.26] l.789 - name_of_file is no longer an array
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@y
+@!name_of_file:^text_char;
+@z
+
+@x [3.27] l.794 - Do file opening in C.
+@ The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `{\bf packed array
+$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\TeX\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\TeX's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@ All of the file opening functions are defined in C.
+@z
+
+@x [3.28] l.850 - Do file closing in C.
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+These procedures should not generate error messages if a file is
+being closed before it has been successfully opened.
+
+@p procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var f:word_file); {close a word file}
+begin close(f);
+end;
+@y
+@ And all the file closing routines as well.
+@z
+
+@x [3.30] l.888 - Array size of input buffer is determined at runtime.
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@y
+@!buffer:^ASCII_code; {lines of characters being read}
+@z
+
+@x [3.31] l.933 - Do `input_ln' in C.
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+We define |input_ln| in C, for efficiency. Nevertheless we quote the module
+`Report overflow of the input buffer, and abort' here in order to make
+\.{WEAVE} happy, since part of that module is needed by e-TeX.
+
+@p @{ @<Report overflow of the input buffer, and abort@> @}
+@z
+
+% [3.32] `term_in' and `term_out' are standard input and output.
+% Declare the variables that used to be constants.
+@x [3.32] l.961 - `term_in' and `term_out' are standard input and output.
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+@y
+@d term_in==stdin {the terminal as an input file}
+@d term_out==stdout {the terminal as an output file}
+
+@<Glob...@>=
+@!init
+@!ini_version:boolean; {are we \.{INITEX}?}
+@!dump_option:boolean; {was the dump name option used?}
+@!dump_line:boolean; {was a \.{\%\AM format} line seen?}
+tini@/
+@#
+@!bound_default:integer; {temporary for setup}
+@!bound_name:^char; {temporary for setup}
+@#
+@!mem_bot:integer;{smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@!main_memory:integer; {total memory words allocated in initex}
+@!extra_mem_bot:integer; {|mem_min:=mem_bot-extra_mem_bot| except in \.{INITEX}}
+@!mem_min:integer; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!mem_top:integer; {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|,
+ equal to |mem_max| in \.{INITEX}, else not greater than |mem_max|}
+@!extra_mem_top:integer; {|mem_max:=mem_top+extra_mem_top| except in \.{INITEX}}
+@!mem_max:integer; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!error_line:integer; {width of context lines on terminal error messages}
+@!half_error_line:integer; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line:integer;
+ {width of longest text lines output; should be at least 60}
+@!max_strings:integer; {maximum number of strings; must not exceed |max_halfword|}
+@!strings_free:integer; {strings available after format loaded}
+@!string_vacancies:integer; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size:integer; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!pool_free:integer;{pool space free after format loaded}
+@!font_mem_size:integer; {number of words of |font_info| for all fonts}
+@!font_max:integer; {maximum internal font number; ok to exceed |max_quarterword|
+ and must be at most |font_base|+|max_font_max|}
+@!font_k:integer; {loop variable for initialization}
+@!hyph_size:integer; {maximun number of hyphen exceptions}
+@!trie_size:integer; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX. 50000 is
+ needed for English, German, and Portuguese.}
+@!buf_size:integer; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!stack_size:integer; {maximum number of simultaneous input sources}
+@!max_in_open:integer; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!param_size:integer; {maximum number of simultaneous macro parameters}
+@!nest_size:integer; {maximum number of semantic levels simultaneously active}
+@!save_size:integer; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@!parse_first_line_p:c_int_type; {parse the first line for options}
+@!file_line_error_style_p:c_int_type; {format messages as file:line:error}
+@!eight_bit_p:c_int_type; {make all characters printable by default}
+@!halt_on_error_p:c_int_type; {stop at first error}
+@!quoted_filename:boolean; {current filename is quoted}
+{Variables for source specials}
+@!src_specials_p : boolean;{Whether |src_specials| are enabled at all}
+@!insert_src_special_auto : boolean;
+@!insert_src_special_every_par : boolean;
+@!insert_src_special_every_parend : boolean;
+@!insert_src_special_every_cr : boolean;
+@!insert_src_special_every_math : boolean;
+@!insert_src_special_every_hbox : boolean;
+@!insert_src_special_every_vbox : boolean;
+@!insert_src_special_every_display : boolean;
+@z
+
+@x [3.33] l.964 - We don't need to open terminal files.
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+@y
+@ Here is how to open the terminal files. |t_open_out| does nothing.
+|t_open_in|, on the other hand, does the work of ``rescanning,'' or getting
+any command line arguments the user has provided. It's defined in C.
+
+@d t_open_out == {output already open for text output}
+@z
+
+@x [3.34] l.982 - Flushing output to terminal files.
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@y
+these operations can be specified with {\mc UNIX}. |update_terminal|
+does an |fflush|. |clear_terminal| is redefined
+to do nothing, since the user should control the terminal.
+@^system dependencies@>
+
+@d update_terminal == fflush (term_out)
+@d clear_terminal == do_nothing
+@z
+
+@x [3.35] l.1017 - needed for e-TeX, but differently
+@<Report overflow of the input buffer, and abort@>=
+if format_ident=0 then
+ begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+ end
+else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+@y
+Routine is implemented in C; part of module is, however, needed for e-TeX.
+
+@<Report overflow of the input buffer, and abort@>=
+ begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+@z
+
+@x [3.37] l.1055 - |init_terminal|, reading the command line.
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+@y
+@ The following program does the required initialization.
+Iff anything has been specified on the command line, then |t_open_in|
+will return with |last > first|.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+if last > first then
+ begin loc := first;
+ while (loc < last) and (buffer[loc]=' ') do incr(loc);
+ if loc < last then
+ begin init_terminal := true; goto exit;
+ end;
+ end;
+@z
+
+@x [3.37] l.1068 - |init_terminal|, output missing newline.
+ write(term_out,'! End of file on the terminal... why?');
+@y
+ write_ln(term_out,'! End of file on the terminal... why?');
+@z
+
+@x [4.38] l.1126 - Array size for string pool is determined at runtime.
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@y
+@!pool_pointer = integer; {for variables that point into |str_pool|}
+@!str_number = 0..ssup_max_strings; {for variables that point into |str_start|}
+@z
+
+@x [4.39] l.1131 - Dynamically size pool arrays.
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@!str_pool: ^packed_ASCII_code; {the characters}
+@!str_start : ^pool_pointer; {the starting pointers}
+@z
+
+@x [4.47] l.1237 - string recycling
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+@y
+@p @t\4@>@<Declare additional routines for string recycling@>@/
+
+@!init function get_strings_started:boolean; {initializes the string pool,
+@z
+
+@x [4.49] l.1272 -- Change documentation (probably needed in more places)
+would like string @'32 to be the single character @'32 instead of the
+@y
+would like string @'32 to be printed as the single character @'32
+instead of the
+@z
+
+% [4.51] Open the pool file using a path, and can't do string
+% assignments directly. (`strcpy' and `strlen' work here because
+% `pool_name' is a constant string, and thus ends in a null and doesn't
+% start with a space.)
+@x [4.51] l.1314 - Open the pool file.
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+@y
+name_length := strlen (pool_name);
+name_of_file := xmalloc_array (ASCII_code, name_length + 1);
+strcpy (stringcast(name_of_file+1), pool_name); {copy the string}
+if a_open_in (pool_file, kpse_texpool_format) then
+@z
+
+@x [4.51] l.1322 - Make `TEX.POOL' lowercase, and change how it's read.
+else bad_pool('! I can''t read TEX.POOL.')
+@y
+else bad_pool('! I can''t read ', pool_name, '; bad path?')
+@z
+@x [4.52] l.1326 - Make `TEX.POOL' lowercase, and change how it's read.
+begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.');
+@.TEX.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+@y
+begin if eof(pool_file) then bad_pool('! ', pool_name, ' has no check sum.');
+@.TEX.POOL has no check sum@>
+read(pool_file,m); read(pool_file,n); {read two digits of string length}
+@z
+@x [4.52] l.1332 - Make `TEX.POOL' lowercase, and change how it's read.
+ bad_pool('! TEX.POOL line doesn''t begin with two digits.');
+@y
+ bad_pool('! ', pool_name, ' line doesn''t begin with two digits.');
+@z
+@x [4.53] l.1354 - Make `TEX.POOL' lowercase, and change how it's read.
+ bad_pool('! TEX.POOL check sum doesn''t have nine digits.');
+@y
+ bad_pool('! ', pool_name, ' check sum doesn''t have nine digits.');
+@z
+@x [4.53] l.1360 - Make `TEX.POOL' lowercase, and change how it's read.
+done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.');
+@y
+done: if a<>@$ then
+ bad_pool('! ', pool_name, ' doesn''t match; tangle me again (or fix the path).');
+@z
+
+@x [5.54] l.1422 - error_line
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+@y
+@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for
+@z
+
+@x [5.59] l.1508FIXME -- enc\TeX\ modifications of |print|.
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+@y
+ else begin if (selector>pseudo) and (not special_printing)
+ and (not message_printing) then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; no_convert := false; return;
+ end
+ else if message_printing then
+ begin print_char(s); no_convert := false; return;
+ end;
+ if (mubyte_log>0) and (not no_convert) and (mubyte_write[s]>0) then
+ s := mubyte_write[s]
+ else if xprn[s] or special_printing then
+ begin print_char(s); no_convert := false; return; end;
+ no_convert := false;
+@z
+
+@x l.1536 -- If the ``src-specials'' feature is active, change the banner.
+wterm(banner);
+@y
+if src_specials_p or file_line_error_style_p or parse_first_line_p then
+ wterm(banner_k)
+else
+ wterm(banner);
+@z
+
+@x [5.61] l.1556 - Print rest of banner, eliminate misleading `(no format preloaded)'.
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+@y
+wterm(version_string);
+if format_ident>0 then slow_print(format_ident);
+print_ln;
+if shell_enabled_p then begin
+ wterm_ln(' \write18 enabled.')
+end;
+if src_specials_p then begin
+ wterm_ln(' Source specials enabled.')
+end;
+if file_line_error_style_p then begin
+ wterm_ln(' file:line:error style messages enabled.')
+end;
+if parse_first_line_p then begin
+ wterm_ln(' %&-line parsing enabled.')
+end;
+if translate_filename then begin
+ wterm(' (');
+ fputs(translate_filename, stdout);
+ wterm_ln(')');
+end;
+@z
+
+@x [5.71] encTeX - native buffer printing
+if last<>first then for k:=first to last-1 do print(buffer[k]);
+@y
+k:=first; while k < last do begin print_buffer(k) end;
+@z
+
+@x [6.73] l.1732 - Add unspecified_mode.
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@y
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d unspecified_mode=4 {extra value for command-line switch}
+@z
+
+@x [6.73] l.1734 - file:line:error style error messages.
+ print_nl("! "); print(#);
+@y
+ if file_line_error_style_p then print_file_line
+ else print_nl("! ");
+ print(#);
+@z
+
+
+@x [6.73] l.1738 - Add interaction_option.
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@y
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@!interaction_option:batch_mode..unspecified_mode; {set from command line}
+@z
+
+@x [6.74] l.1740 - Allow override by command line switch.
+@ @<Set init...@>=interaction:=error_stop_mode;
+@y
+@ @<Set init...@>=if interaction_option=unspecified_mode then
+ interaction:=error_stop_mode
+else
+ interaction:=interaction_option;
+@z
+
+% [6.81] Eliminate nonlocal goto, since C doesn't have them.
+% Plus, it's nicer just to do an exit with the appropriate status code
+% under Unix. We call it `uexit' because there's a WEB symbol called
+% `exit' already. We use a C macro to change `uexit' back to `exit'.
+@x [6.81] l.1852 - Eliminate nonlocal goto, since C doesn't have them.
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+@y
+@d do_final_end==begin
+ update_terminal;
+ ready_already:=0;
+ if (history <> spotless) and (history <> warning_issued) then
+ uexit(1)
+ else
+ uexit(0);
+ end
+
+@<Error hand...@>=
+procedure jump_out;
+begin
+close_files_and_terminate;
+do_final_end;
+end;
+@z
+
+@x [6.82] l.1866 - halt on error?
+print_char("."); show_context;
+@y
+print_char("."); show_context;
+if (halt_on_error_p) then begin
+ history:=fatal_error_stop; jump_out;
+end;
+@z
+
+@x [6.84] l.1888 - Implement the switch-to-editor option.
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@y
+line ready to be edited.
+We do this by calling the external procedure |call_edit| with a pointer to
+the filename, its length, and the line number.
+However, here we just set up the variables that will be used as arguments,
+since we don't want to do the switch-to-editor until after TeX has closed
+its files.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@d edit_file==input_stack[base_ptr]
+@z
+
+@x [6.84] l.1903 - Implement the switch-to-editor option.
+"E": if base_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ slow_print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+@y
+"E": if base_ptr>0 then
+ begin edit_name_start:=str_start[edit_file.name_field];
+ edit_name_length:=str_start[edit_file.name_field+1] -
+ str_start[edit_file.name_field];
+ edit_line:=line;
+ jump_out;
+@z
+
+% [7.104] `remainder' is a library routine on some systems, so change
+% its name to avoid conflicts.
+@x [7.104] l.2227 - avoid name conflicts with lib routine remainder()
+|remainder|, holds the remainder after a division.
+
+@<Glob...@>=
+@y
+|remainder|, holds the remainder after a division.
+
+@d remainder==tex_remainder
+
+@<Glob...@>=
+@z
+
+@x [7.109] l.2352 - Define glue_ratio in C.
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+@y
+@z
+
+% [8.110] Make it easy to change constants. Do not increase
+% max_quarterword without changing the memoryword structure in `texmfmem.h'.
+% If you set min_quarterword or min_halfword to a non-zero value, you have
+% to remove the definitions of qi/qo, hi/ho in this change file!
+@x [8.110] l.2405 - increase |max_halfword|
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y 2407
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|}
+@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|}
+@z
+
+@x [8.111] l.2422 - max_font_max
+if (font_base<min_quarterword)or(font_max>max_quarterword) then bad:=15;
+if font_max>font_base+256 then bad:=16;
+@y
+if (max_font_max<min_halfword)or(max_font_max>max_halfword) then bad:=15;
+if font_max>font_base+max_font_max then bad:=16;
+@z
+
+@x [8.112] l.2435 - Efficiency.
+macros are simplified in the obvious way when |min_quarterword=0|.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+macros are simplified in the obvious way when |min_quarterword=0|.
+So they have been simplified here in the obvious way.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item from a quarterword}
+@d hi(#)==# {to put a sixteen-bit item into a halfword}
+@d ho(#)==# {to take a sixteen-bit item from a halfword}
+@z
+
+% [8.113] We've put the memory structure into the include file
+% `texmf.h', since it's too hard to translate automatically.
+@x [8.113] l.2453 - data structures for main memory
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case four_choices of
+ 1: (@!int:integer);
+ 2: (@!gr:glue_ratio);
+ 3: (@!hh:two_halves);
+ 4: (@!qqqq:four_quarters);
+ end;
+@y
+@!quarterword = min_quarterword..max_quarterword;
+@!halfword = min_halfword..max_halfword;
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@=#include "texmfmem.h";@>
+@z
+
+% [9.116] Change `mem' to `zmem', so we can define mem to be a register
+% pointer to the memory array for speed.
+@x [9.116] l.2545 - definition of main memory array
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@y
+@!yzmem : ^memory_word; {the big dynamic storage area}
+@!zmem : ^memory_word; {the big dynamic storage area}
+@z
+
+% [9.127] Fix casting problem in C.
+% There are several of these. They come from the rules C uses for
+% comparing signed and unsigned quantities. Just doing the comparison
+% can result in incorrect evaluation wrt the way Pascal would do it.
+@x [9.127] l.2739 - Fix casting problem in C.
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+@y 2738
+if r>intcast(p+1) then @<Allocate from the top of node |p| and |goto found|@>;
+@z
+
+@x [10.144] l.3006 - font numbers can be >255 now.
+@p function new_ligature(@!f,@!c:quarterword; @!q:pointer):pointer;
+@y
+@p function new_ligature(@!f:internal_font_number; @!c:quarterword;
+ @!q:pointer):pointer;
+@z
+
+% [11.165] Fix the word `free' so that it doesn't conflict with the
+% standard C library routine of the same name.
+@x [11.165] l.3364 - avoid conflict with lib function free()
+are debugging.)
+@y
+are debugging.)
+
+@d free==free_arr
+@z
+
+@x [11.165] l.3367 - dummy |free| and |was_free| arrays
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [mem_min..mem_max] of boolean;
+@y
+ {The debug memory arrays have not been mallocated yet.}
+@!debug @!free: packed array [0..9] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [0..9] of boolean;
+@z
+
+@x [12.174] l.3526 - Eliminate unsigned comparisons to zero.
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+@y
+ begin if (font(p)>font_max) then
+@z
+
+@x [12.176] l.3563 - Eliminate unsigned comparisons to zero.
+@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@y
+@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)>font_max) then print_char("*")
+@z
+
+@x [12.186] l.3747 - Don't worry about strange floating point values.
+ if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
+ else if abs(g)>float_constant(20000) then
+@y 3747
+ { The Unix |pc| folks removed this restriction with a remark that
+ invalid bit patterns were vanishingly improbable, so we follow
+ their example without really understanding it.
+ |if abs(mem[p+glue_offset].int)<@'4000000 then print('?.?')|
+ |else| }
+ if fabs(g)>float_constant(20000) then
+@z
+
+
+@x [15.209] l.4165 - MLTeX: \charsubdef primitive
+@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@y
+@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+ {or \.{\\charsubdef}}
+@z
+
+% i18n fix: messages printed by print_mode in [16.211] and [46.1049]
+% can not be translated. For example, messages printed by |print_mode|
+% from [16.211] use different word order and [46.1049] use different
+% word order and words are declined.
+@x [16.211] l.4256
+begin if m>0 then
+ case m div (max_command+1) of
+ 0:print("vertical");
+ 1:print("horizontal");
+ 2:print("display math");
+ end
+else if m=0 then print("no")
+else case (-m) div (max_command+1) of
+ 0:print("internal vertical");
+ 1:print("restricted horizontal");
+ 2:print("math");
+ end;
+print(" mode");
+end;
+@y
+begin if m>0 then
+ case m div (max_command+1) of
+ 0:print("vertical mode");
+ 1:print("horizontal mode");
+ 2:print("display math mode");
+ end
+else if m=0 then print("no mode")
+else case (-m) div (max_command+1) of
+ 0:print("internal vertical mode");
+ 1:print("restricted horizontal mode");
+ 2:print("math mode");
+ end;
+end;
+
+procedure print_in_mode(@!m:integer); {prints the mode represented by |m|}
+begin if m>0 then
+ case m div (max_command+1) of
+ 0:print("' in vertical mode");
+ 1:print("' in horizontal mode");
+ 2:print("' in display math mode");
+ end
+else if m=0 then print("' in no mode")
+else case (-m) div (max_command+1) of
+ 0:print("' in internal vertical mode");
+ 1:print("' in restricted horizontal mode");
+ 2:print("' in math mode");
+ end;
+end;
+@z
+
+@x [16.213] l.4321 - texarray
+@!nest:array[0..nest_size] of list_state_record;
+@y
+@!nest:^list_state_record;
+@z
+
+@x [16.215] l.4344 - remove mem[] reference from initialize.
+prev_graf:=0; shown_mode:=0;
+@<Start a new current page@>;
+@y
+prev_graf:=0; shown_mode:=0;
+@/{The following piece of code is a copy of module 991:}
+page_contents:=empty; page_tail:=page_head; {|link(page_head):=null;|}@/
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+page_depth:=0; page_max_depth:=0;
+@z
+
+@x [16.219] l.4409 - i18n fix
+ print_int(nest[p].pg_field); print(" line");
+ if nest[p].pg_field<>1 then print_char("s");
+@y
+ print_int(nest[p].pg_field);
+ if nest[p].pg_field<>1 then print(" lines")
+ else print(" line");
+@z
+
+@x [17.220] l.4448 - MLTeX: char_sub_code_base
+paragraph shape.
+@y
+paragraph shape.
+Additionally region~4 contains the table with ML\TeX's character
+substitution definitions.
+@z
+
+@x [17.222] l.4523 - frozen_special, for source specials.
+@d frozen_null_font=frozen_control_sequence+10
+ {permanent `\.{\\nullfont}'}
+@y
+@d frozen_special=frozen_control_sequence+10
+ {permanent `\.{\\special}'}
+@d frozen_null_font=frozen_control_sequence+11
+ {permanent `\.{\\nullfont}'}
+@z
+
+@x [17.222] l.4526 - max_font_max
+@d undefined_control_sequence=frozen_null_font+257 {dummy location}
+@y
+@d undefined_control_sequence=frozen_null_font+max_font_max+1 {dummy location}
+@z
+
+@x [17.222] l.4533 - hash_extra
+for k:=active_base to undefined_control_sequence-1 do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+@y
+for k:=active_base to eqtb_top do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+@z
+
+@x [17.230] l.4725 - encTeX: xord_code_base, xchr_code_base, prn_code_base,
+@d math_font_base=cur_font_loc+1 {table of 48 math font numbers}
+@y
+@d xord_code_base=cur_font_loc+1
+@d xchr_code_base=xord_code_base+1
+@d xprn_code_base=xchr_code_base+1
+@d math_font_base=xprn_code_base+1
+@z
+
+@x [17.230] l.4731 - MLTeX: char_sub_code_base
+@d int_base=math_code_base+256 {beginning of region 5}
+@y
+@d char_sub_code_base=math_code_base+256 {table of character substitutions}
+@d int_base=char_sub_code_base+256 {beginning of region 5}
+@z
+
+@x [17.230] l.4752 - MLTeX: char_sub_code_base
+ {Note: |math_code(c)| is the true math code plus |min_halfword|}
+@y
+ {Note: |math_code(c)| is the true math code plus |min_halfword|}
+@d char_sub_code(#)==equiv(char_sub_code_base+#)
+ {Note: |char_sub_code(c)| is the true substitution info plus |min_halfword|}
+@z
+
+% MLTeX: \charsubdefmax and \tracingcharsubdef
+% encTeX: \mubytein \mubyteout \mubytelog and \specialout
+@x [17.236] l.4954
+@d int_pars=55 {total number of integer parameters}
+@y
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@#
+@d web2c_int_base=tex_int_pars {base for web2c's integer parameters}
+@d char_sub_def_min_code=web2c_int_base {smallest value in the charsubdef list}
+@d char_sub_def_max_code=web2c_int_base+1 {largest value in the charsubdef list}
+@d tracing_char_sub_def_code=web2c_int_base+2 {traces changes to a charsubdef def}
+@d mubyte_in_code=web2c_int_base+3 {if positive then reading mubytes is active}
+@d mubyte_out_code=web2c_int_base+4 {if positive then printing mubytes is active}
+@d mubyte_log_code=web2c_int_base+5 {if positive then print mubytes to log and terminal}
+@d spec_out_code=web2c_int_base+6 {if positive then print specials by mubytes}
+@d web2c_int_pars=web2c_int_base+7 {total number of web2c's integer parameters}
+@#
+@d int_pars=web2c_int_pars {total number of integer parameters}
+@z
+
+% MLTeX: \charsubdefmax and \tracingcharsubdef
+% encTeX: \mubytein \mubyteout \mubytelog and \specialout
+@x [17.236] l.5016
+@d error_context_lines==int_par(error_context_lines_code)
+@y
+@d error_context_lines==int_par(error_context_lines_code)
+@#
+@d char_sub_def_min==int_par(char_sub_def_min_code)
+@d char_sub_def_max==int_par(char_sub_def_max_code)
+@d tracing_char_sub_def==int_par(tracing_char_sub_def_code)
+@d mubyte_in==int_par(mubyte_in_code)
+@d mubyte_out==int_par(mubyte_out_code)
+@d mubyte_log==int_par(mubyte_log_code)
+@d spec_out==int_par(spec_out_code)
+@z
+
+% MLTeX: \charsubdefmax and \tracingcharsubdef
+% encTeX: \mubytein \mubyteout \mubytelog and \specialout
+@x [17.237] l.5080
+error_context_lines_code:print_esc("errorcontextlines");
+@y
+error_context_lines_code:print_esc("errorcontextlines");
+char_sub_def_min_code:print_esc("charsubdefmin");
+char_sub_def_max_code:print_esc("charsubdefmax");
+tracing_char_sub_def_code:print_esc("tracingcharsubdef");
+mubyte_in_code:print_esc("mubytein");
+mubyte_out_code:print_esc("mubyteout");
+mubyte_log_code:print_esc("mubytelog");
+spec_out_code:print_esc("specialout");
+@z
+
+% MLTeX: \charsubdefmax and \tracingcharsubdef
+% encTeX: \mubytein \mubyteout \mubytelog and \specialout
+@x [17.238] l.5200
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+@y
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+if mltex_p then
+ begin mltex_enabled_p:=true; {enable character substitution}
+ if false then {remove the if-clause to enable \.{\\charsubdefmin}}
+ primitive("charsubdefmin",assign_int,int_base+char_sub_def_min_code);@/
+@!@:char_sub_def_min_}{\.{\\charsubdefmin} primitive@>
+ primitive("charsubdefmax",assign_int,int_base+char_sub_def_max_code);@/
+@!@:char_sub_def_max_}{\.{\\charsubdefmax} primitive@>
+ primitive("tracingcharsubdef",assign_int,int_base+tracing_char_sub_def_code);@/
+@!@:tracing_char_sub_def_}{\.{\\tracingcharsubdef} primitive@>
+ end;
+if enctex_p then
+ begin enctex_enabled_p:=true;
+ primitive("mubytein",assign_int,int_base+mubyte_in_code);@/
+@!@:mubyte_in_}{\.{\\mubytein} primitive@>
+ primitive("mubyteout",assign_int,int_base+mubyte_out_code);@/
+@!@:mubyte_out_}{\.{\\mubyteout} primitive@>
+ primitive("mubytelog",assign_int,int_base+mubyte_log_code);@/
+@!@:mubyte_log_}{\.{\\mubytelog} primitive@>
+ primitive("specialout",assign_int,int_base+spec_out_code);@/
+@!@:spec_out_}{\.{\\specialout} primitive@>
+end;
+@z
+
+@x [17.240] l.5213 - MLTeX: \charsubdefmax and \tracingcharsubdef
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+@y
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+char_sub_def_min:=256; char_sub_def_max:=-1;
+{allow \.{\\charsubdef} for char 0}@/
+{|tracing_char_sub_def:=0| is already done}@/
+@z
+
+@x [17.241] l.5219 - Do `fix_date_and_time' in C.
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+It calls a macro-defined |date_and_time| routine. |date_and_time|
+in turn is a C macro, which calls |get_date_and_time|, passing
+it the addresses of the day, month, etc., so they can be set by the
+routine. |get_date_and_time| also sets up interrupt catching if that
+is conditionally compiled in the C code.
+@^system dependencies@>
+
+@d fix_date_and_time==date_and_time(time,day,month,year)
+@z
+
+@x [17.252] l.5420 - hash_extra
+else if n<glue_base then @<Show equivalent |n|, in region 1 or 2@>
+@y
+else if (n<glue_base) or ((n>eqtb_size)and(n<=eqtb_top)) then
+ @<Show equivalent |n|, in region 1 or 2@>
+@z
+
+@x [17.253] l.5435 - Change eqtb to zeqtb.
+@!eqtb:array[active_base..eqtb_size] of memory_word;
+@y
+@!zeqtb:^memory_word;
+@z
+
+@x [18.256] l.5483 - hash_extra
+@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
+ {the hash table}
+@!hash_used:pointer; {allocation pointer for |hash|}
+@y
+@!hash: ^two_halves; {the hash table}
+@!yhash: ^two_halves; {auxiliary pointer for freeing hash}
+@!hash_used:pointer; {allocation pointer for |hash|}
+@!hash_extra:pointer; {|hash_extra=hash| above |eqtb_size|}
+@!hash_top:pointer; {maximum of the hash array}
+@!eqtb_top:pointer; {maximum of the |eqtb|}
+@!hash_high:pointer; {pointer to next high hash location}
+@z
+
+@x [18.257] l.5491 - hash_extra
+next(hash_base):=0; text(hash_base):=0;
+for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base];
+@y
+@z
+
+@x [18.258] l.5495 - hash_extra
+hash_used:=frozen_control_sequence; {nothing is used}
+@y
+hash_used:=frozen_control_sequence; {nothing is used}
+hash_high:=0;
+@z
+
+@x [18.260] l.5531 - hash_extra
+@ @<Insert a new control...@>=
+begin if text(p)>0 then
+ begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until text(hash_used)=0; {search for an empty location in |hash|}
+ next(p):=hash_used; p:=hash_used;
+ end;
+@y
+@ @<Insert a new control...@>=
+begin if text(p)>0 then
+ begin if hash_high<hash_extra then
+ begin incr(hash_high);
+ next(p):=hash_high+eqtb_size; p:=hash_high+eqtb_size;
+ end
+ else begin
+ repeat if hash_is_full then overflow("hash size",hash_size+hash_extra);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until text(hash_used)=0; {search for an empty location in |hash|}
+ next(p):=hash_used; p:=hash_used;
+ end;
+ end;
+@z
+
+@x [18.262] - encTeX: control sequence to byte sequence
+@<Basic printing...@>=
+procedure print_cs(@!p:integer); {prints a purported control sequence}
+begin if p<hash_base then {single character}
+@y
+The conversion from control sequence to byte sequence for enc\TeX is
+implemented here. Of course, the simplest way is to implement an array
+of string pointers with |hash_size| length, but we assume that only a
+few control sequences will need to be converted. So |mubyte_cswrite|,
+an array with only 128 items, is used. The items point to the token
+lists. First token includes a csname number and the second points the
+string to be output. The third token includes the number of another
+csname and fourth token its pointer to the string etc. We need to do
+the sequential searching in one of the 128 token lists.
+
+@<Basic printing...@>=
+procedure print_cs(@!p:integer); {prints a purported control sequence}
+var q: pointer;
+ s: str_number;
+begin
+ if active_noconvert and (not no_convert) and
+ (eq_type(p) = let) and (equiv(p) = normal+11) then { noconvert }
+ begin
+ no_convert := true;
+ return;
+ end;
+ s := 0;
+ if cs_converting and (not no_convert) then
+ begin
+ q := mubyte_cswrite [p mod 128] ;
+ while q <> null do
+ if info (q) = p then
+ begin
+ s := info (link(q)); q := null;
+ end else q := link (link (q));
+ end;
+ no_convert := false;
+ if s > 0 then print (s)
+ else if p<hash_base then {single character}
+@z
+
+@x [18.262] l.5583 - hash_extra
+else if p>=undefined_control_sequence then print_esc("IMPOSSIBLE.")
+@y
+else if ((p>=undefined_control_sequence)and(p<=eqtb_size))or(p>eqtb_top) then
+ print_esc("IMPOSSIBLE.")
+@z
+
+@x [18.262] l.5584 - Remove more unsigned comparisons to zero.
+else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@y
+else if (text(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@z
+
+@x [18.262] - encTeX: exit label for print_cs
+ print_char(" ");
+ end;
+end;
+@y
+ print_char(" ");
+ end;
+exit: end;
+@z
+
+@x [18.265] - encTeX: \endmubyte primitive
+primitive("endcsname",end_cs_name,0);@/
+@!@:end_cs_name_}{\.{\\endcsname} primitive@>
+@y
+primitive("endcsname",end_cs_name,0);@/
+@!@:end_cs_name_}{\.{\\endcsname} primitive@>
+if enctex_p then
+begin
+ primitive("endmubyte",end_cs_name,10);@/
+@!@:end_mubyte_}{\.{\\endmubyte} primitive@>
+end;
+@z
+
+@x [18.266] - encTeX: \endmubyte primitive
+end_cs_name: print_esc("endcsname");
+@y
+end_cs_name: if chr_code = 10 then print_esc("endmubyte")
+ else print_esc("endcsname");
+@z
+
+@x [19.271] l.5872 - texarray
+@!save_stack : array[0..save_size] of memory_word;
+@y
+@!save_stack : ^memory_word;
+@z
+
+@x [19.283] l.6050 - hash_extra
+if p<int_base then
+@y
+if (p<int_base)or(p>eqtb_size) then
+@z
+
+@x [20.290] l.6158 - hash_extra
+if cs_token_flag+undefined_control_sequence>max_halfword then bad:=21;
+@y
+if cs_token_flag+eqtb_size+hash_extra>max_halfword then bad:=21;
+if (hash_offset<0)or(hash_offset>hash_base) then bad:=42;
+@z
+
+@x [22.301] l.6432 - texarray
+@!input_stack : array[0..stack_size] of in_state_record;
+@y
+@!input_stack : ^in_state_record;
+@z
+
+@x [22.304] l.6536 - texarray; additions for file:line:error style.
+@!input_file : array[1..max_in_open] of alpha_file;
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+@y
+@!input_file : ^alpha_file;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@!source_filename_stack : ^str_number;
+@!full_source_filename_stack : ^str_number;
+@z
+
+@x [22.306] l.6855 - i18n fix
+ begin print_nl("Runaway ");
+@.Runaway...@>
+ case scanner_status of
+ defining: begin print("definition"); p:=def_ref;
+ end;
+ matching: begin print("argument"); p:=temp_head;
+ end;
+ aligning: begin print("preamble"); p:=hold_head;
+ end;
+ absorbing: begin print("text"); p:=def_ref;
+ end;
+ end; {there are no other cases}
+@y
+ begin
+@.Runaway...@>
+ case scanner_status of
+ defining: begin print_nl("Runaway definition"); p:=def_ref;
+ end;
+ matching: begin print_nl("Runaway argument"); p:=temp_head;
+ end;
+ aligning: begin print_nl("Runaway preamble"); p:=hold_head;
+ end;
+ absorbing: begin print_nl("Runaway text"); p:=def_ref;
+ end;
+ end; {there are no other cases}
+@z
+
+@x [22.308] l.6701 - texarray
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+@y
+@!param_stack: ^pointer;
+ {token list pointers for parameters}
+@z
+
+@x [22.318] encTeX - native buffer printing
+if j>0 then for i:=start to j-1 do
+ begin if i=loc then set_trick_count;
+ print(buffer[i]);
+ end
+@y
+i := start; mubyte_skeep := mubyte_keep;
+mubyte_sstart := mubyte_start; mubyte_start := false;
+if j>0 then while i < j do
+begin
+ if i=loc then set_trick_count;
+ print_buffer(i);
+end;
+mubyte_keep := mubyte_skeep; mubyte_start := mubyte_sstart
+@z
+
+@x [23.328] l.7043 - keep top of source_filename_stack initialized
+incr(in_open); push_input; index:=in_open;
+@y
+incr(in_open); push_input; index:=in_open;
+source_filename_stack[index]:=0;full_source_filename_stack[index]:=0;
+@z
+
+@x [23.331] l.7071 - init source file name stacks
+begin input_ptr:=0; max_in_stack:=0;
+@y
+begin input_ptr:=0; max_in_stack:=0;
+source_filename_stack[0]:=0;full_source_filename_stack[0]:=0;
+@z
+
+@x [24.332] encTeX: insert the added functions
+appear on that line. (There might not be any tokens at all, if the
+|end_line_char| has |ignore| as its catcode.)
+@y
+appear on that line. (There might not be any tokens at all, if the
+|end_line_char| has |ignore| as its catcode.)
+
+Some additional routines used by the enc\TeX extension have to be
+declared at this point.
+
+@p @t\4@>@<Declare additional routines for enc\TeX@>@/
+@z
+
+@x [24.338] l.7164 - i18n fix
+print(" while scanning ");
+@y
+@z
+
+@x [24.339] l.7185 - i18n fix
+defining:begin print("definition"); info(p):=right_brace_token+"}";
+ end;
+matching:begin print("use"); info(p):=par_token; long_state:=outer_call;
+ end;
+aligning:begin print("preamble"); info(p):=right_brace_token+"}"; q:=p;
+ p:=get_avail; link(p):=q; info(p):=cs_token_flag+frozen_cr;
+ align_state:=-1000000;
+ end;
+absorbing:begin print("text"); info(p):=right_brace_token+"}";
+@y
+defining:begin print(" while scanning definition"); info(p):=right_brace_token+"}";
+ end;
+matching:begin print(" while scanning use"); info(p):=par_token; long_state:=outer_call;
+ end;
+aligning:begin print(" while scanning preamble"); info(p):=right_brace_token+"}"; q:=p;
+ p:=get_avail; link(p):=q; info(p):=cs_token_flag+frozen_cr;
+ align_state:=-1000000;
+ end;
+absorbing:begin print(" while scanning text"); info(p):=right_brace_token+"}";
+@z
+
+@x [24.341] - encTeX: more declarations in expand processor
+var k:0..buf_size; {an index into |buffer|}
+@!t:halfword; {a token}
+@y
+var k:0..buf_size; {an index into |buffer|}
+@!t:halfword; {a token}
+@!i,@!j: 0..buf_size; {more indexes for encTeX}
+@!mubyte_incs: boolean; {control sequence is converted by mubyte}
+@!p:pointer; {for encTeX test if noexpanding}
+@z
+
+@x [24.343] - encTeX: access the buffer via read_buffer
+ begin cur_chr:=buffer[loc]; incr(loc);
+@y
+ begin
+ { Use |k| instead of |loc| for type correctness. }
+ k := loc;
+ cur_chr := read_buffer (k);
+ loc := k; incr (loc);
+ if (mubyte_token > 0) then
+ begin
+ state := mid_line;
+ cur_cs := mubyte_token - cs_token_flag;
+ goto found;
+ end;
+@z
+
+@x [24.354] - encTeX: access the buffer via read_buffer
+else begin start_cs: k:=loc; cur_chr:=buffer[k]; cat:=cat_code(cur_chr);
+ incr(k);
+@y
+else begin start_cs:
+ mubyte_incs := false; k := loc; mubyte_skeep := mubyte_keep;
+ cur_chr := read_buffer (k); cat := cat_code (cur_chr);
+ if (mubyte_in>0) and (not mubyte_incs) and
+ ((mubyte_skip>0) or (cur_chr<>buffer[k])) then mubyte_incs := true;
+ incr (k);
+ if mubyte_token > 0 then
+ begin
+ state := mid_line;
+ cur_cs := mubyte_token - cs_token_flag;
+ goto found;
+ end;
+@z
+
+@x [24.354] - encTeX: noexpanding the marked control sequence
+ cur_cs:=single_base+buffer[loc]; incr(loc);
+ end;
+found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+if cur_cmd>=outer_call then check_outer_validity;
+@y
+ mubyte_keep := mubyte_skeep;
+ cur_cs:=single_base + read_buffer(loc); incr(loc);
+ end;
+found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+if cur_cmd>=outer_call then check_outer_validity;
+if write_noexpanding then
+begin
+ p := mubyte_cswrite [cur_cs mod 128];
+ while p <> null do
+ if info (p) = cur_cs then
+ begin
+ cur_cmd := relax; cur_chr := 256; p := null;
+ end else p := link (link (p));
+end;
+@z
+
+@x [24.356] - encTeX: access the buffer via read_buffer
+begin repeat cur_chr:=buffer[k]; cat:=cat_code(cur_chr); incr(k);
+until (cat<>letter)or(k>limit);
+@<If an expanded...@>;
+if cat<>letter then decr(k);
+ {now |k| points to first nonletter}
+if k>loc+1 then {multiletter control sequence has been scanned}
+ begin cur_cs:=id_lookup(loc,k-loc); loc:=k; goto found;
+ end;
+end
+@y
+begin
+ repeat cur_chr := read_buffer (k); cat := cat_code (cur_chr);
+ if mubyte_token>0 then cat := escape;
+ if (mubyte_in>0) and (not mubyte_incs) and (cat=letter) and
+ ((mubyte_skip>0) or (cur_chr<>buffer[k])) then mubyte_incs := true;
+ incr (k);
+ until (cat <> letter) or (k > limit);
+ @<If an expanded...@>;
+ if cat <> letter then
+ begin
+ decr (k); k := k - mubyte_skip;
+ end;
+ if k > loc + 1 then { multiletter control sequence has been scanned }
+ begin
+ if mubyte_incs then { multibyte in csname occurrs }
+ begin
+ i := loc; j := first; mubyte_keep := mubyte_skeep;
+ if j - loc + k > max_buf_stack then
+ begin
+ max_buf_stack := j - loc + k;
+ if max_buf_stack >= buf_size then
+ begin
+ max_buf_stack := buf_size;
+ overflow ("buffer size", buf_size);
+ end;
+ end;
+ while i < k do
+ begin
+ buffer [j] := read_buffer (i);
+ incr (i); incr (j);
+ end;
+ if j = first+1 then
+ cur_cs := single_base + buffer [first]
+ else
+ cur_cs := id_lookup (first, j-first);
+ end else cur_cs := id_lookup (loc, k-loc) ;
+ loc := k;
+ goto found;
+ end;
+end
+@z
+
+@x [24.357] - encTeX: noexpanding the marked control sequence
+ else check_outer_validity;
+@y
+ else check_outer_validity;
+ if write_noexpanding then
+ begin
+ p := mubyte_cswrite [cur_cs mod 128];
+ while p <> null do
+ if info (p) = cur_cs then
+ begin
+ cur_cmd := relax; cur_chr := 256; p := null;
+ end else p := link (link (p));
+ end;
+@z
+
+@x [24.363] encTeX - native buffer printing
+ if start<limit then for k:=start to limit-1 do print(buffer[k]);
+@y
+ k := start;
+ while k < limit do begin print_buffer(k) end;
+@z
+
+@x [25.372] - encTeX: we need to distinguish \endcsname and \endmubyte
+if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
+@y
+if (cur_cmd<>end_cs_name) or (cur_chr<>0) then @<Complain about missing \.{\\endcsname}@>;
+@z
+
+@x [26.414] l.8358 - encTeX: accessing xord/xchr/xprn
+if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val)
+@y
+if m=xord_code_base then scanned_result(xord[cur_val])(int_val)
+else if m=xchr_code_base then scanned_result(xchr[cur_val])(int_val)
+else if m=xprn_code_base then scanned_result(xprn[cur_val])(int_val)
+else if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val)
+@z
+
+@x [28.501] l.9747 - \eof18
+if_eof_code: begin scan_four_bit_int; b:=(read_open[cur_val]=closed);
+ end;
+@y
+if_eof_code: begin scan_four_bit_int_or_18;
+ if cur_val=18 then b:=not shell_enabled_p
+ else b:=(read_open[cur_val]=closed);
+ end;
+@z
+
+@x [29.513] l.9951 - Area and extension rules for filenames.
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@y
+@ The file names we shall deal with have the
+following structure: If the name contains `\./' or `\.:'
+(for Amiga only), the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the last
+`\..' to the end, otherwise the file extension is null.
+@z
+
+@x [29.513] l.9963 - Area and extension rules for filenames.
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+@y
+@!area_delimiter:pool_pointer; {the most recent `\./', if any}
+@!ext_delimiter:pool_pointer; {the most recent `\..', if any}
+@z
+
+@x [29.514] l.9973 - TeX area directories.
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+In C, the default paths are specified separately.
+@z
+
+@x [29.515] l.9995 - filenames: quoted
+begin area_delimiter:=0; ext_delimiter:=0;
+@y
+begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false;
+@z
+
+@x [29.516] l.9992 - filenames: more_name
+begin if c=" " then more_name:=false
+@y
+begin if (c=" ") and stop_at_space and (not quoted_filename) then
+ more_name:=false
+else if c="""" then begin
+ quoted_filename:=not quoted_filename;
+ more_name:=true;
+ end
+@z
+
+@x [29.516] l.9994 - filenames: more_name
+ if (c=">")or(c=":") then
+@y
+ if IS_DIR_SEP(c) then
+@z
+
+@x [29.516] l.9997 - filenames: more_name
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
+@y
+ else if c="." then ext_delimiter:=cur_length;
+@z
+
+@x [29.517] l.10002 - end_name: string recycling
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+@y
+@ The third.
+@^system dependencies@>
+If a string is already in the string pool, the function
+|slow_make_string| does not create a new string but returns this string
+number, thus saving string space. Because of this new property of the
+returned string number it is not possible to apply |flush_string| to
+these strings.
+
+@p procedure end_name;
+var temp_str: str_number; {result of file name cache lookups}
+@!j,@!s,@!t: pool_pointer; {running indices}
+@!must_quote:boolean; {whether we need to quote a string}
+@z
+
+@x [29.517] l.10022 - end_name: spaces in filenames
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+@y
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+str_room(6); {Room for quotes, if needed.}
+{add quotes if needed}
+if area_delimiter<>0 then begin
+ {maybe quote |cur_area|}
+ must_quote:=false;
+ s:=str_start[str_ptr];
+ t:=str_start[str_ptr]+area_delimiter;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+ if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+ area_delimiter:=area_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+ end;
+{maybe quote |cur_name|}
+s:=str_start[str_ptr]+area_delimiter;
+if ext_delimiter=0 then t:=pool_ptr else t:=str_start[str_ptr]+ext_delimiter-1;
+must_quote:=false;
+j:=s;
+while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+if must_quote then begin
+ for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+ pool_ptr:=pool_ptr+2;
+ end;
+if ext_delimiter<>0 then begin
+ {maybe quote |cur_ext|}
+ s:=str_start[str_ptr]+ext_delimiter-1;
+ t:=pool_ptr;
+ must_quote:=false;
+ j:=s;
+ while (not must_quote) and (j<>t) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+ if must_quote then begin
+ str_pool[t+1]:="""";
+ for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+ str_pool[s]:="""";
+ pool_ptr:=pool_ptr+2;
+ end;
+ end;
+@z
+
+@x [29.517] l.10011 - end_name: string recycling
+ str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+@y
+ str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
+ temp_str:=search_string(cur_area);
+ if temp_str>0 then
+ begin cur_area:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start[str_ptr+1] to pool_ptr-1 do
+ begin str_pool[j-area_delimiter]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-area_delimiter; {update |pool_ptr|}
+ end;
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=slow_make_string;
+@z
+
+@x [29.517] l.10016 - end_name: string recycling
+else begin cur_name:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+@y
+else begin cur_name:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+ decr(str_ptr); {undo extension string to look at name part}
+ temp_str:=search_string(cur_name);
+ if temp_str>0 then
+ begin cur_name:=temp_str;
+ decr(str_ptr); {no |flush_string|, |pool_ptr| will be wrong!}
+ for j:=str_start[str_ptr+1] to pool_ptr-1 do
+ begin str_pool[j-ext_delimiter+area_delimiter+1]:=str_pool[j];
+ end;
+ pool_ptr:=pool_ptr-ext_delimiter+area_delimiter+1; {update |pool_ptr|}
+ end;
+ cur_ext:=slow_make_string; {remake extension string}
+@z
+
+@x [29.518] l.10042 - print_file_name: quote if spaces in names.
+begin slow_print(a); slow_print(n); slow_print(e);
+@y
+var must_quote: boolean; {whether to quote the filename}
+@!j:pool_pointer; {index into |str_pool|}
+begin
+must_quote:=false;
+if a<>0 then begin
+ j:=str_start[a];
+ while (not must_quote) and (j<>str_start[a+1]) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if n<>0 then begin
+ j:=str_start[n];
+ while (not must_quote) and (j<>str_start[n+1]) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+if e<>0 then begin
+ j:=str_start[e];
+ while (not must_quote) and (j<>str_start[e+1]) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+ end;
+end;
+{FIXME: Alternative is to assume that any filename that has to be quoted has
+ at least one quoted component...if we pick this, a number of insertions
+ of |print_file_name| should go away.
+|must_quote|:=((|a|<>0)and(|str_pool|[|str_start|[|a|]]=""""))or
+ ((|n|<>0)and(|str_pool|[|str_start|[|n|]]=""""))or
+ ((|e|<>0)and(|str_pool|[|str_start|[|e|]]=""""));}
+if must_quote then print_char("""");
+if a<>0 then
+ for j:=str_start[a] to str_start[a+1]-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]));
+if n<>0 then
+ for j:=str_start[n] to str_start[n+1]-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]));
+if e<>0 then
+ for j:=str_start[e] to str_start[e+1]-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]));
+if must_quote then print_char("""");
+@z
+
+@x [29.519] l.10051 - have append_to_name skip quotes.
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@z
+
+% [29.519] In pack_file_name, leave room for the extra null we append at
+% the end of a filename.
+@x [29.519] l.10047 - pack_file_name, leave room for the extra null
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file:= xmalloc_array (ASCII_code, length(a)+length(n)+length(e)+1);
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
+@z
+
+@x [29.519] l.10051 - pack_file_name, append the extra null
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.520] l.10060 - filenames: default format.
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@y
+Under {\mc UNIX} we don't give the area part, instead depending
+on the path searching that will happen during file opening. Also, the
+length will be set in the main program.
+
+@d format_area_length=0 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@z
+
+@x [29.521] l.10066 - filenames: default format, where `plain.fmt' is.
+@!TEX_format_default:packed array[1..format_default_length] of char;
+
+@ @<Set init...@>=
+TEX_format_default:='TeXformats:plain.fmt';
+@y
+@!format_default_length: integer;
+@!TEX_format_default: ^char;
+
+@ We set the name of the default format file and the length of that name
+in C, instead of Pascal, since we want them to depend on the name of the
+program.
+@z
+
+@x [29.523] l.10095 - Change to pack_buffered_name as with pack_file_name.
+for j:=1 to n do append_to_name(xord[TEX_format_default[j]]);
+@y
+if name_of_file then libc_free (name_of_file);
+name_of_file := xmalloc_array (ASCII_code, n+(b-a+1)+format_ext_length+1);
+for j:=1 to n do append_to_name(xord[TEX_format_default[j]]);
+@z
+
+% @x [29.523] l.10097 - Set program name to match format.
+% for j:=a to b do append_to_name(buffer[j]);
+% @y
+% for j:=a to b do append_to_name(buffer[j]);
+% name_of_file[k+1]:=0;
+% kpse_reset_program_name(name_of_file+1);
+% @z
+
+@x [29.523] l.10100 - Change to pack_buffered_name as with pack_file_name.
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+@y
+name_of_file[name_length+1]:=0;
+@z
+
+@x [29.524] l.10118 - Format file opening: only try once, with path searching.
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(fmt_file) then goto found;
+ pack_buffered_name(format_area_length,loc,j-1);
+ {now try the system format file area}
+ if w_open_in(fmt_file) then goto found;
+@y
+ pack_buffered_name(0,loc,j-1); {Kpathsea does everything}
+ if w_open_in(fmt_file) then goto found;
+@z
+
+@x [29.524] l.10124 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
+@y
+ wterm ('Sorry, I can''t find the format `');
+ fputs (stringcast(name_of_file + 1), stdout);
+ wterm ('''; will try `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''.');
+@z
+
+@x [29.524] l.10132 - replace `PLAIN' in error messages with `default'.
+ wterm_ln('I can''t find the PLAIN format file!');
+@.I can't find PLAIN...@>
+@y
+ wterm ('I can''t find the format file `');
+ fputs (TEX_format_default + 1, stdout);
+ wterm_ln ('''!');
+@.I can't find the format...@>
+@z
+
+@x [29.525] l.10163 - make_name_string
+ make_name_string:=make_string;
+ end;
+@y
+ make_name_string:=make_string;
+ end;
+ {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to
+ match the contents of |name_of_file|.}
+ k:=1;
+ name_in_progress:=true;
+ begin_name;
+ stop_at_space:=false;
+ while (k<=name_length)and(more_name(name_of_file[k])) do
+ incr(k);
+ stop_at_space:=true;
+ end_name;
+ name_in_progress:=false;
+@z
+
+@x [29.526] l.10194 - stop scanning file name if we're at end-of-line.
+ if not more_name(cur_chr) then goto done;
+@y
+ {If |cur_chr| is a space and we're not scanning a token list, check
+ whether we're at the end of the buffer. Otherwise we end up adding
+ spurious spaces to file names in some cases.}
+ if (cur_chr=" ") and (state<>token_list) and (loc>limit) then goto done;
+ if not more_name(cur_chr) then goto done;
+@z
+
+@x [29.530] l.10245 - prompt_file_name: prevent empty filenames.
+var k:0..buf_size; {index into |buffer|}
+@y
+var k:0..buf_size; {index into |buffer|}
+@!saved_cur_name:str_number; {to catch empty terminal input}
+@z
+
+@x [29.530] l.10252 - prompt_file_name: No default extension is TeX input file.
+if e=".tex" then show_context;
+@y
+if (e=".tex") or (e="") then show_context;
+@z
+
+@x [29.530] l.10258 - prompt_file_name: prevent empty filenames.
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+@y
+saved_cur_name:=cur_name;
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+if length(cur_name)=0 then cur_name:=saved_cur_name;
+@z
+
+@x [29.532] l.10263 - avoid conflict, `logname' in <unistd.h> on some systems.
+@d ensure_dvi_open==if output_file_name=0 then
+@y
+@d log_name == texmf_log_name
+@d ensure_dvi_open==if output_file_name=0 then
+@z
+
+@x [29.534] l.10285 - Adjust for C string conventions.
+@!months:packed array [1..36] of char; {abbreviations of month names}
+@y
+@!months:^char;
+@z
+
+@x [29.534] l.10300 - Filename change for the recorder.
+if job_name=0 then job_name:="texput";
+@.texput@>
+@y
+if job_name=0 then job_name:=get_job_name("texput");
+@.texput@>
+pack_job_name(".fls");
+recorder_change_filename(stringcast(name_of_file+1));
+@z
+
+@x [29.534] l.10293 - MLTeX: add MLTeX banner after loading fmt file
+@<Print the banner line, including the date and time@>;
+@y
+@<Print the banner line, including the date and time@>;
+if mltex_enabled_p then
+ begin wlog_cr; wlog('MLTeX v2.2 enabled');
+ end;
+if enctex_enabled_p then
+ begin wlog_cr; wlog(encTeX_banner); wlog(', reencoding enabled');
+ if translate_filename then
+ begin wlog_cr;
+ wlog(' (\xordcode, \xchrcode, \xprncode overridden by TCX)');
+ end;
+ end;
+@z
+
+@x
+begin wlog(banner);
+@y
+begin
+if src_specials_p or file_line_error_style_p or parse_first_line_p
+then
+ wlog(banner_k)
+else
+ wlog(banner);
+@z
+
+@x [29.536] l.10324 - Print rest of banner.
+slow_print(format_ident); print(" ");
+@y
+wlog(version_string);
+slow_print(format_ident); print(" ");
+@z
+
+@x [29.536] l.10327 - Adjust for C string conventions.
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@y
+months := ' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@z
+
+% Print whether we're using src-specials.
+% Print TCX name if one's given.
+@x [29/536] l.10331
+end
+@y
+if shell_enabled_p then begin
+ wlog_cr;
+ wlog('\write18 enabled.')
+ end;
+if src_specials_p then begin
+ wlog_cr;
+ wlog(' Source specials enabled.')
+ end;
+if file_line_error_style_p then begin
+ wlog_cr;
+ wlog(' file:line:error style messages enabled.')
+ end;
+if parse_first_line_p then begin
+ wlog_cr;
+ wlog(' %&-line parsing enabled.');
+ end;
+if translate_filename then begin
+ wlog_cr;
+ wlog(' (');
+ fputs(translate_filename, log_file);
+ wlog(')');
+ end;
+end
+@z
+
+% [29.537] Use a path when calling a_open_in to do a \input; also, try
+% to open the file with and without the `.tex' extension, regardless of
+% whether the file already has an extension. This allows filenames like
+% `foo' and `foo.bar.tex', as well as `foo.tex' and `foo.bar'.
+@x [29.537] l.10338 - start_input
+begin scan_file_name; {set |cur_name| to desired file name}
+if cur_ext="" then cur_ext:=".tex";
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,TEX_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+@y
+var temp_str: str_number; k: integer;
+begin scan_file_name; {set |cur_name| to desired file name}
+pack_cur_name;
+loop@+begin
+ begin_file_reading; {set up |cur_file| and new level of input}
+ tex_input_type := 1; {Tell |open_input| we are \.{\\input}.}
+ {Kpathsea tries all the various ways to get the file.}
+ if open_in_name_ok(stringcast(name_of_file+1))
+ and a_open_in(cur_file, kpse_tex_format) then
+ goto done;
+@z
+
+@x [29.537] l.10348 - start_input: don't force ".tex" extension.
+ prompt_file_name("input file name",".tex");
+@y
+ prompt_file_name("input file name","");
+@z
+
+@x [29.537] l.10350 - start_input: string recycling
+done: name:=a_make_name_string(cur_file);
+@y
+done: name:=a_make_name_string(cur_file);
+source_filename_stack[in_open]:=name;
+full_source_filename_stack[in_open]:=make_full_name_string;
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+ begin temp_str:=search_string(name);
+ if temp_str>0 then
+ begin name:=temp_str; flush_string;
+ end;
+ end;
+@z
+
+@x [29.537] l.10352 - start_input: was job_name given on the command line?
+ begin job_name:=cur_name; open_log_file;
+@y
+ begin job_name:=get_job_name(cur_name); open_log_file;
+@z
+
+@x [29.537] l.10356 -
+if term_offset+length(name)>max_print_line-2 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("("); incr(open_parens); slow_print(name); update_terminal;
+@y
+if term_offset+length(full_source_filename_stack[in_open])>max_print_line-2
+then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("("); incr(open_parens);
+slow_print(full_source_filename_stack[in_open]); update_terminal;
+@z
+
+@x [29.537] l.10360 - start_input: don't return filename to string pool.
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string; name:=cur_name;
+ end;
+@y
+@z
+
+@x [30.548] l.10673 - texarray
+@!internal_font_number=font_base..font_max; {|font| in a |char_node|}
+@!font_index=0..font_mem_size; {index into |font_info|}
+@y
+@!internal_font_number=integer; {|font| in a |char_node|}
+@!font_index=integer; {index into |font_info|}
+@!nine_bits=min_quarterword..non_char;
+@z
+
+@x [30.549] l.10682 - texarray
+@!font_info:array[font_index] of memory_word;
+ {the big collection of font data}
+@!fmem_ptr:font_index; {first unused word of |font_info|}
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_check:array[internal_font_number] of four_quarters; {check sum}
+@!font_size:array[internal_font_number] of scaled; {``at'' size}
+@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
+@!font_params:array[internal_font_number] of font_index; {how many font
+ parameters are present}
+@!font_name:array[internal_font_number] of str_number; {name of the font}
+@!font_area:array[internal_font_number] of str_number; {area of the font}
+@!font_bc:array[internal_font_number] of eight_bits;
+ {beginning (smallest) character code}
+@!font_ec:array[internal_font_number] of eight_bits;
+ {ending (largest) character code}
+@!font_glue:array[internal_font_number] of pointer;
+ {glue specification for interword space, |null| if not allocated}
+@!font_used:array[internal_font_number] of boolean;
+ {has a character from this font actually appeared in the output?}
+@!hyphen_char:array[internal_font_number] of integer;
+ {current \.{\\hyphenchar} values}
+@!skew_char:array[internal_font_number] of integer;
+ {current \.{\\skewchar} values}
+@!bchar_label:array[internal_font_number] of font_index;
+ {start of |lig_kern| program for left boundary character,
+ |non_address| if there is none}
+@!font_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {right boundary character, |non_char| if there is none}
+@!font_false_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
+@y
+@!font_info: ^fmemory_word;
+ {the big collection of font data}
+@!fmem_ptr:font_index; {first unused word of |font_info|}
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_check: ^four_quarters; {check sum}
+@!font_size: ^scaled; {``at'' size}
+@!font_dsize: ^scaled; {``design'' size}
+@!font_params: ^font_index; {how many font
+ parameters are present}
+@!font_name: ^str_number; {name of the font}
+@!font_area: ^str_number; {area of the font}
+@!font_bc: ^eight_bits;
+ {beginning (smallest) character code}
+@!font_ec: ^eight_bits;
+ {ending (largest) character code}
+@!font_glue: ^pointer;
+ {glue specification for interword space, |null| if not allocated}
+@!font_used: ^boolean;
+ {has a character from this font actually appeared in the output?}
+@!hyphen_char: ^integer;
+ {current \.{\\hyphenchar} values}
+@!skew_char: ^integer;
+ {current \.{\\skewchar} values}
+@!bchar_label: ^font_index;
+ {start of |lig_kern| program for left boundary character,
+ |non_address| if there is none}
+@!font_bchar: ^nine_bits;
+ {right boundary character, |non_char| if there is none}
+@!font_false_bchar: ^nine_bits;
+ {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
+@z
+
+@x [30.550] l.10723 - texarray
+@!char_base:array[internal_font_number] of integer;
+ {base addresses for |char_info|}
+@!width_base:array[internal_font_number] of integer;
+ {base addresses for widths}
+@!height_base:array[internal_font_number] of integer;
+ {base addresses for heights}
+@!depth_base:array[internal_font_number] of integer;
+ {base addresses for depths}
+@!italic_base:array[internal_font_number] of integer;
+ {base addresses for italic corrections}
+@!lig_kern_base:array[internal_font_number] of integer;
+ {base addresses for ligature/kerning programs}
+@!kern_base:array[internal_font_number] of integer;
+ {base addresses for kerns}
+@!exten_base:array[internal_font_number] of integer;
+ {base addresses for extensible recipes}
+@!param_base:array[internal_font_number] of integer;
+ {base addresses for font parameters}
+@y
+@!char_base: ^integer;
+ {base addresses for |char_info|}
+@!width_base: ^integer;
+ {base addresses for widths}
+@!height_base: ^integer;
+ {base addresses for heights}
+@!depth_base: ^integer;
+ {base addresses for depths}
+@!italic_base: ^integer;
+ {base addresses for italic corrections}
+@!lig_kern_base: ^integer;
+ {base addresses for ligature/kerning programs}
+@!kern_base: ^integer;
+ {base addresses for kerns}
+@!exten_base: ^integer;
+ {base addresses for extensible recipes}
+@!param_base: ^integer;
+ {base addresses for font parameters}
+@z
+
+@x [30.551] l.10743 - texarray
+for k:=font_base to font_max do font_used[k]:=false;
+@y
+@z
+
+@x [30.552] l.10749 - texarray
+font_ptr:=null_font; fmem_ptr:=7;
+font_name[null_font]:="nullfont"; font_area[null_font]:="";
+hyphen_char[null_font]:="-"; skew_char[null_font]:=-1;
+bchar_label[null_font]:=non_address;
+font_bchar[null_font]:=non_char; font_false_bchar[null_font]:=non_char;
+font_bc[null_font]:=1; font_ec[null_font]:=0;
+font_size[null_font]:=0; font_dsize[null_font]:=0;
+char_base[null_font]:=0; width_base[null_font]:=0;
+height_base[null_font]:=0; depth_base[null_font]:=0;
+italic_base[null_font]:=0; lig_kern_base[null_font]:=0;
+kern_base[null_font]:=0; exten_base[null_font]:=0;
+font_glue[null_font]:=null; font_params[null_font]:=7;
+param_base[null_font]:=-1;
+for k:=0 to 6 do font_info[k].sc:=0;
+@y
+@z
+
+@x [30.554] l.10795 - MLTeX: |effective_char| in |char_info|
+as fast as possible under the circumstances.
+@^inner loop@>
+
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_info[char_base[#]+char_info_end
+@y
+as fast as possible under the circumstances.
+@^inner loop@>
+
+ML\TeX{} will assume that a character |c| exists iff either exists in
+the current font or a character substitution definition for this
+character was defined using \.{\\charsubdef}. To avoid the
+distinction between these two cases, ML\TeX{} introduces the notion
+``effective character'' of an input character |c|. If |c| exists in
+the current font, the effective character of |c| is the character |c|
+itself. If it doesn't exist but a character substitution is defined,
+the effective character of |c| is the base character defined in the
+character substitution. If there is an effective character for a
+non-existing character |c|, the ``virtual character'' |c| will get
+appended to the horizontal lists.
+
+The effective character is used within |char_info| to access
+appropriate character descriptions in the font. For example, when
+calculating the width of a box, ML\TeX{} will use the metrics of the
+effective characters. For the case of a substitution, ML\TeX{} uses
+the metrics of the base character, ignoring the metrics of the accent
+character.
+
+If character substitutions are changed, it will be possible that a
+character |c| neither exists in a font nor there is a valid character
+substitution for |c|. To handle these cases |effective_char| should
+be called with its first argument set to |true| to ensure that it
+will still return an existing character in the font. If neither |c|
+nor the substituted base character in the current character
+substitution exists, |effective_char| will output a warning and
+return the character |font_bc[f]| (which is incorrect, but can not be
+changed within the current framework).
+
+Sometimes character substitutions are unwanted, therefore the
+original definition of |char_info| can be used using the macro
+|orig_char_info|. Operations in which character substitutions should
+be avoided are, for example, loading a new font and checking the font
+metric information in this font, and character accesses in math mode.
+
+@d char_list_exists(#)==(char_sub_code(#)>hi(0))
+@d char_list_accent(#)==(ho(char_sub_code(#)) div 256)
+@d char_list_char(#)==(ho(char_sub_code(#)) mod 256)
+@#
+@d char_info_end(#)== #@=)@>].qqqq
+@d char_info(#)==
+ font_info[char_base[#]+effective_char@=(@>true,#,char_info_end
+@#
+@d orig_char_info_end(#)==#].qqqq
+@d orig_char_info(#)==font_info[char_base[#]+orig_char_info_end
+@#
+@z
+
+@x [30] m.560 l.10876 - MLTeX: |effective_char| in |char_info|
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+@y
+@p @t\4@>@<Declare additional functions for ML\TeX@>@/
+
+function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+@z
+
+@x [30.563] l.10943 - Don't use TEX_font_area.
+if aire="" then pack_file_name(nom,TEX_font_area,".tfm")
+else pack_file_name(nom,aire,".tfm");
+@y
+{|kpse_find_file| will append the |".tfm"|, and avoid searching the disk
+ before the font alias files as well.}
+pack_file_name(nom,aire,"");
+@z
+
+% [30.564] Reading the tfm file. As a special case, whenever we open a
+% tfm file, we read its first byte into `tfm_temp' right away. TeX
+% looks at `fbyte' before calling `fget', so it ends up seeing every
+% byte. This is Pascal-like I/O.
+@x [30.564] l.10956 - reading the tfm file, define fget & fbyte
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@y
+@d fget==tfm_temp:=getc(tfm_file)
+@d fbyte==tfm_temp
+@z
+
+@x [30.570] l.11064 - MLTeX: fix for bug while loading font
+ begin qw:=char_info(f)(d);
+@y
+ begin qw:=orig_char_info(f)(d);
+@z
+
+@x [30.573] l.11116 - MLTeX: fix for bug while loading font
+ qw:=char_info(f)(#); {N.B.: not |qi(#)|}
+@y
+ qw:=orig_char_info(f)(#); {N.B.: not |qi(#)|}
+@z
+
+% [32.575] We only want `eof' on the TFM file to be true if we
+% previously had EOF, not if we're at EOF now. This is like `feof', and
+% unlike our implementation of `eof' elsewhere.
+@x [32.575] l.11161 - Reading the tfm file, replace eof() by feof().
+if eof(tfm_file) then abort;
+@y
+if feof(tfm_file) then abort;
+@z
+
+@x [30.576] l.11180 - MLTeX: fix for bug while loading font
+ begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+@y
+ begin qw:=orig_char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+@z
+
+@x [30.582] l.11276 - MLTeX: call |effective_char| in |new_character|
+@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
+label exit;
+var p:pointer; {newly allocated node}
+begin if font_bc[f]<=c then if font_ec[f]>=c then
+ if char_exists(char_info(f)(qi(c))) then
+@y
+
+This allows a character node to be used if there is an equivalent
+in the |char_sub_code| list.
+
+@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
+label exit;
+var p:pointer; {newly allocated node}
+@!ec:quarterword; {effective character of |c|}
+begin ec:=effective_char(false,f,qi(c));
+if font_bc[f]<=qo(ec) then if font_ec[f]>=qo(ec) then
+ if char_exists(orig_char_info(f)(ec)) then {N.B.: not |char_info|}
+@z
+
+@x [32.592] l.11820 - font numbers can be >255 now.
+@!c,@!f:quarterword; {character and font in current |char_node|}
+@y
+ {character and font in current |char_node|}
+@!c:quarterword;
+@!f:internal_font_number;
+@z
+
+@x [32.595] l.11860 - texarray
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@!half_buf:dvi_index; {half of |dvi_buf_size|}
+@!dvi_limit:dvi_index; {end of the current half buffer}
+@!dvi_ptr:dvi_index; {the next available buffer address}
+@y
+@!dvi_buf:^eight_bits; {buffer for \.{DVI} output}
+@!half_buf:integer; {half of |dvi_buf_size|}
+@!dvi_limit:integer; {end of the current half buffer}
+@!dvi_ptr:integer; {the next available buffer address}
+@z
+
+@x [32.597] l.11886 - write_dvi done in C.
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+In C, we use a macro to call |fwrite| or |write| directly, writing all
+the bytes in one shot. Much better even than writing four
+bytes at a time.
+@z
+
+@x [32.602] l.11944 - Allow for outputting more than 256 fonts.
+begin dvi_out(fnt_def1);
+dvi_out(f-font_base-1);@/
+@y
+begin if f<=256+font_base then
+ begin dvi_out(fnt_def1);
+ dvi_out(f-font_base-1);
+ end
+else begin dvi_out(fnt_def1+1);
+ dvi_out((f-font_base-1) div @'400);
+ dvi_out((f-font_base-1) mod @'400);
+ end;
+@z
+
+@x [32.617] l.12261 - Use output_comment if the user set it. Assume it's short enough.
+ old_setting:=selector; selector:=new_string;
+@y
+if output_comment then
+ begin l:=strlen(output_comment); dvi_out(l);
+ for s:=0 to l-1 do dvi_out(output_comment[s]);
+ end
+else begin {the default code is unchanged}
+ old_setting:=selector; selector:=new_string;
+@z
+
+@x [32.617] l.12268 - Use output_comment if the user set it.
+ pool_ptr:=str_start[str_ptr]; {flush the current string}
+@y
+ pool_ptr:=str_start[str_ptr]; {flush the current string}
+end;
+@z
+
+@x [32.619] l.12294 - MLTeX: substitute character in |hlist_out|
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+@y
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p, continue, found;
+@z
+
+@x [32.620] l.12326 - MLTeX: replace virtual character in |hlist_out|
+reaching a non-|char_node|. The program uses the fact that |set_char_0=0|.
+@^inner loop@>
+@y
+reaching a non-|char_node|. The program uses the fact that |set_char_0=0|.
+
+In ML\TeX{} this part looks for the existence of a substitution
+definition for a character |c|, if |c| does not exist in the font,
+and create appropriate \.{DVI} commands. Former versions of ML\TeX{}
+have spliced appropriate character, kern, and box nodes into the
+horizontal list.
+%
+% 91/05/08 \charsubdefmax bug detected by Bernd Raichle
+Because the user can change character substitions or
+\.{\\charsubdefmax} on the fly, we have to test a again
+for valid substitutions.
+%
+% 93/10/29 \leaders bug detected by Eberhard Mattes
+(Additional it is necessary to be careful---if leaders are used
+the current hlist is normally traversed more than once!)
+@^inner loop@>
+@z
+
+@x [32.620] l.12334 - MLTeX: substitute character during |shipout|
+ if c>=qi(128) then dvi_out(set1);
+ dvi_out(qo(c));@/
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+@y
+ if font_ec[f]>=qo(c) then if font_bc[f]<=qo(c) then
+ if char_exists(orig_char_info(f)(c)) then {N.B.: not |char_info|}
+ begin if c>=qi(128) then dvi_out(set1);
+ dvi_out(qo(c));@/
+ cur_h:=cur_h+char_width(f)(orig_char_info(f)(c));
+ goto continue;
+ end;
+ if mltex_enabled_p then
+ @<Output a substitution, |goto continue| if not possible@>;
+continue:
+@z
+
+@x [32.622] l.12349 - more >256 font output stuff.
+else begin dvi_out(fnt1); dvi_out(f-font_base-1);
+ end;
+@y
+else if f<=256+font_base then
+ begin dvi_out(fnt1); dvi_out(f-font_base-1);
+ end
+else begin dvi_out(fnt1+1);
+ dvi_out((f-font_base-1) div @'400);
+ dvi_out((f-font_base-1) mod @'400);
+ end;
+@z
+
+% We output each portion of the page as we get to it, if we are using
+% IPC, so that the previewer (TeXView) can display it immediately. [SPM]
+@x [32.640] l.12690 - IPC
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+@y
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+ifdef ('IPC')
+if ipc_on>0 then
+ begin if dvi_limit=half_buf then
+ begin write_dvi(half_buf, dvi_buf_size-1);
+ flush_dvi;
+ dvi_gone:=dvi_gone+half_buf;
+ end;
+ if dvi_ptr>0 then
+ begin write_dvi(0, dvi_ptr-1);
+ flush_dvi;
+ dvi_offset:=dvi_offset+dvi_ptr; dvi_gone:=dvi_gone+dvi_ptr;
+ end;
+ dvi_ptr:=0; dvi_limit:=dvi_buf_size;
+ ipc_page(dvi_gone);
+ end;
+endif ('IPC');
+@z
+
+@x [32.642] l.12742 - Use dvi_offset instead of dvi_buf_size with IPC stuff.
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+@y
+ifdef ('IPC')
+ k:=7-((3+dvi_offset+dvi_ptr) mod 4); {the number of 223's}
+endif ('IPC')
+ifndef ('IPC')
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+endifn ('IPC')
+@z
+
+@x [32.642] l.12773 - use print_file_name
+ print_nl("Output written on "); slow_print(output_file_name);
+@y
+ print_nl("Output written on "); print_file_name(0, output_file_name, 0);
+@z
+
+@x [32.642] l.12750 - i18n fix
+ print(" ("); print_int(total_pages); print(" page");
+ if total_pages<>1 then print_char("s");
+@y
+ print(" ("); print_int(total_pages);
+ if total_pages<>1 then print(" pages")
+ else print(" page");
+@z
+
+% The MLTeX changes never dealt with the problems of character
+% substitutions in math mode. With the new additions in v2.2,
+% non-existing characters between |font_bc[f]| and |font_ec[f]|
+% can be substituted => we have to avoid this in math mode
+% (for compatibility reasons and to avoid other problems).
+%
+@x [35.708] l.13903 - MLTeX: avoid substitution in |var_delimiter|
+if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
+ begin continue: q:=char_info(g)(y);
+@y
+if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
+ begin continue: q:=orig_char_info(g)(y);
+@z
+
+@x [36.722] l.14172 - MLTeX: avoid substitution in |fetch|
+else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
+ cur_i:=char_info(cur_f)(cur_c)
+@y
+else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
+ cur_i:=orig_char_info(cur_f)(cur_c)
+@z
+
+@x [36.740] l.14486 - MLTeX: avoid substitution in |make_math_accent|
+ i:=char_info(f)(y);
+@y
+ i:=orig_char_info(f)(y);
+@z
+
+@x [36.749] l.14638 - MLTeX: avoid substitution in |make_op|
+ begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
+@y
+ begin c:=rem_byte(cur_i); i:=orig_char_info(cur_f)(c);
+@z
+
+% disabled in original tex-src-special.ch
+ @x [37.774] l.15291 - source specials
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @y
+if (insert_src_special_every_cr and head<>tail) then insert_src_special;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @z
+
+% disabled in original tex-source-special.ch
+ @x [37.799] l.15682 - source specials
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @y
+if (insert_src_special_every_cr) then insert_src_special;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+ @z
+
+@x [38.859] l.16855 - Fix a casting/expression evaluation problem.
+if abs(fit_class-fitness(r))>1 then d:=d+adj_demerits;
+@y
+if abs(intcast(fit_class)-intcast(fitness(r)))>1 then d:=d+adj_demerits;
+@z
+
+@x [39.875] l.17170 - Another casting problem.
+ begin line_diff:=line_number(r)-best_line;
+@y
+ begin line_diff:=intcast(line_number(r))-intcast(best_line);
+@z
+
+@x [42.920] l.18056 - bigtrie: allow larger hyphenation tries.
+Comparatively few different number sequences $n_0\ldots n_k$ actually occur,
+since most of the |n|'s are generally zero. Therefore the number sequences
+are encoded in such a way that |trie_op|$(z_k)$ is only one byte long.
+If |trie_op(@t$z_k$@>)<>min_quarterword|, when $p_1\ldots p_k$ has matched
+the letters in |hc[(l-k+1)..l@,]| of language |t|,
+we perform all of the required operations
+for this pattern by carrying out the following little program: Set
+|v:=trie_op(@t$z_k$@>)|. Then set |v:=v+op_start[t]|,
+|hyf[l-hyf_distance[v]]:=@tmax@>(hyf[l-hyf_distance[v]], hyf_num[v])|,
+and |v:=hyf_next[v]|; repeat, if necessary, until |v=min_quarterword|.
+@y
+The theory that comparatively few different number sequences $n_0\ldots n_k$
+actually occur, since most of the |n|'s are generally zero, seems to fail
+at least for the large German hyphenation patterns.
+Therefore the number sequences cannot any longer be encoded in such a way
+that |trie_op|$(z_k)$ is only one byte long.
+We have introduced a new constant |max_trie_op| for the maximum allowable
+hyphenation operation code value; |max_trie_op| might be different for
+\TeX\ and \.{INITEX} and must not exceed |max_halfword|.
+An opcode will occupy a halfword if |max_trie_op| exceeds |max_quarterword|
+or a quarterword otherwise.
+@^system dependencies@>
+If |trie_op(@t$z_k$@>)<>min_trie_op|, when $p_1\ldots p_k$ has matched
+the letters in |hc[(l-k+1)..l@,]| of language |t|,
+we perform all of the required operations
+for this pattern by carrying out the following little program: Set
+|v:=trie_op(@t$z_k$@>)|. Then set |v:=v+op_start[t]|,
+|hyf[l-hyf_distance[v]]:=@tmax@>(hyf[l-hyf_distance[v]], hyf_num[v])|,
+and |v:=hyf_next[v]|; repeat, if necessary, until |v=min_trie_op|.
+@z
+
+@x [42.920] l.18068 - bigtrie: allow larger hyphenation tries.
+@!trie_pointer=0..trie_size; {an index into |trie|}
+@y
+@!trie_pointer=0..ssup_trie_size; {an index into |trie|}
+@!trie_opcode=0..ssup_trie_opcode; {a trie opcode}
+@z
+
+@x [42.921] l.18070 - bigtrie: allow larger hyphenation tries.
+@ @d trie_link(#)==trie[#].rh {``downward'' link in a trie}
+@d trie_char(#)==trie[#].b1 {character matched at this trie location}
+@d trie_op(#)==trie[#].b0 {program for hyphenation at this trie location}
+@y
+@ For more than 255 trie op codes, the three fields |trie_link|, |trie_char|,
+and |trie_op| will no longer fit into one memory word; thus using web2c
+we define |trie| as three array instead of an array of records.
+The variant will be implented by reusing the opcode field later on with
+another macro.
+
+@d trie_link(#)==trie_trl[#] {``downward'' link in a trie}
+@d trie_char(#)==trie_trc[#] {character matched at this trie location}
+@d trie_op(#)==trie_tro[#] {program for hyphenation at this trie location}
+@z
+
+@x [42.921] l.18075 - bigtrie: allow larger hyphenation tries.
+@!trie:array[trie_pointer] of two_halves; {|trie_link|, |trie_char|, |trie_op|}
+@y
+{We will dynamically allocate these arrays.}
+@!trie_trl:^trie_pointer; {|trie_link|}
+@!trie_tro:^trie_pointer; {|trie_op|}
+@!trie_trc:^quarterword; {|trie_char|}
+@z
+
+@x [42.921] l.18078 - bigtrie: allow larger hyphenation tries.
+@!hyf_next:array[1..trie_op_size] of quarterword; {continuation code}
+@y
+@!hyf_next:array[1..trie_op_size] of trie_opcode; {continuation code}
+@z
+
+@x [42.923] l.18099 - bigtrie: allow larger hyphenation tries.
+ begin if trie_op(z)<>min_quarterword then
+@y
+ begin if trie_op(z)<>min_trie_op then
+@z
+
+@x [42.924] l.18112 - bigtrie: allow larger hyphenation tries.
+until v=min_quarterword;
+@y
+until v=min_trie_op;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18126 m.925
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+@y 18126
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+This is a clever scheme which saves the need for a hash link array.
+However, it is difficult to increase the size of the hyphen exception
+arrays. To make this easier, the ordered hash has been replaced by
+a simple hash, using an additional array |hyph_link|. The value
+|0| in |hyph_link[k]| means that there are no more entries corresponding
+to the specific hash chain. When |hyph_link[k]>0|, the next entry in
+the hash chain is |hyph_link[k]-1|. This value is used because the
+arrays start at |0|.
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18134 m.925
+@!hyph_pointer=0..hyph_size; {an index into the ordered hash table}
+@y 18134
+@!hyph_pointer=0..ssup_hyph_size; {index into hyphen exceptions hash table;
+ enlarging this requires changing (un)dump code}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18137 m.926
+@!hyph_word:array[hyph_pointer] of str_number; {exception words}
+@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions}
+@!hyph_count:hyph_pointer; {the number of words in the exception dictionary}
+@y 18139
+@!hyph_word: ^str_number; {exception words}
+@!hyph_list: ^pointer; {list of hyphen positions}
+@!hyph_link: ^hyph_pointer; {link array for hyphen exceptions hash table}
+@!hyph_count:integer; {the number of words in the exception dictionary}
+@!hyph_next:integer; {next free slot in hyphen exceptions hash table}
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18145 m.928
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null;
+ end;
+hyph_count:=0;
+@y 18148
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null; hyph_link[z]:=0;
+ end;
+hyph_count:=0;
+hyph_next:=hyph_prime+1; if hyph_next>hyph_size then hyph_next:=hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18163 m.930
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_size;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+not_found: decr(hn)
+@y 18170
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_prime;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ h:=hyph_link[h]; if h=0 then goto not_found;
+ decr(h);
+ end;
+not_found: decr(hn)
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18172 m.931
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)<hn then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start[k];
+ repeat if so(str_pool[u])<hc[j] then goto not_found;
+ if so(str_pool[u])>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@y 18184
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start[k];
+ repeat
+ if so(str_pool[u])<>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18274 m.939
+ begin h:=(h+h+hc[j]) mod hyph_size;
+@y 18274
+ begin h:=(h+h+hc[j]) mod hyph_prime;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18281 m.940
+@ @<Insert the \(p)pair |(s,p)|...@>=
+if hyph_count=hyph_size then overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+hyph_word[h]:=s; hyph_list[h]:=p
+@y 18290
+@ @<Insert the \(p)pair |(s,p)|...@>=
+ if hyph_next <= hyph_prime then
+ while (hyph_next>0) and (hyph_word[hyph_next-1]>0) do decr(hyph_next);
+if (hyph_count=hyph_size)or(hyph_next=0) then
+ overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if hyph_link[h]=0 then
+ begin
+ hyph_link[h]:=hyph_next;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime;
+ if hyph_next > hyph_prime then incr(hyph_next);
+ end;
+ h:=hyph_link[h]-1;
+ end;
+
+found: hyph_word[h]:=s; hyph_list[h]:=p
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 18292 m.941
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+k:=hyph_word[h];
+if length(k)<length(s) then goto found;
+if length(k)>length(s) then goto not_found;
+u:=str_start[k]; v:=str_start[s];
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start[k+1];
+found:q:=hyph_list[h]; hyph_list[h]:=p; p:=q;@/
+t:=hyph_word[h]; hyph_word[h]:=s; s:=t;
+not_found:
+@y 18303
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+{This is now a simple hash list, not an ordered one, so
+the module title is no longer descriptive.}
+k:=hyph_word[h];
+if length(k)<>length(s) then goto not_found;
+u:=str_start[k]; v:=str_start[s];
+repeat if str_pool[u]<>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start[k+1];
+{repeat hyphenation exception; flushing old data}
+flush_string; s:=hyph_word[h]; {avoid |slow_make_string|!}
+decr(hyph_count);
+{ We could also |flush_list(hyph_list[h]);|, but it interferes
+ with \.{trip.log}. }
+goto found;
+not_found:
+@z
+
+@x [43.943] l.18332 - bigtrie: Larger tries, also in documentation parts.
+|hyf_next[@t$v^\prime$@>]=min_quarterword|.
+@y
+|hyf_next[@t$v^\prime$@>]=min_trie_op|.
+@z
+
+@x [43.943] l.18336 - bigtrie: Larger tries, also in documentation parts.
+$$\hbox{|@t$v^\prime$@>:=new_trie_op(0,1,min_quarterword)|,\qquad
+@y
+$$\hbox{|@t$v^\prime$@>:=new_trie_op(0,1,min_trie_op)|,\qquad
+@z
+
+@x [43.943] l.18346 - web2c can't parse negative lower bounds in arrays. Sorry.
+@!init@! trie_op_hash:array[-trie_op_size..trie_op_size] of 0..trie_op_size;
+@y
+@!init@! trie_op_hash:array[neg_trie_op_size..trie_op_size] of 0..trie_op_size;
+@z
+
+@x [43.943] l.18348 - bigtrie: Larger hyphenation tries.
+@!trie_used:array[ASCII_code] of quarterword;
+@y
+@!trie_used:array[ASCII_code] of trie_opcode;
+@z
+
+@x [43.943] l.18352 - bigtrie: Larger hyphenation tries.
+@!trie_op_val:array[1..trie_op_size] of quarterword;
+@y
+@!trie_op_val:array[1..trie_op_size] of trie_opcode;
+@z
+
+@x [43.943] l.18355 - Dynamic trie arrays
+tini
+@y
+tini@;
+@!max_op_used:trie_opcode; {largest opcode used for any language}
+@!small_op:boolean; {flag used while dumping or undumping}
+@z
+
+@x [43.944] l.18358 - bigtrie: Larger tries, also in documentation parts.
+|new_trie_op| could return |min_quarterword| (thereby simply ignoring
+@y
+|new_trie_op| could return |min_trie_op| (thereby simply ignoring
+@z
+
+@x [43.944] l.18365 - bigtrie: Larger hyphenation tries.
+function new_trie_op(@!d,@!n:small_number;@!v:quarterword):quarterword;
+label exit;
+var h:-trie_op_size..trie_op_size; {trial hash location}
+@!u:quarterword; {trial op code}
+@y
+function new_trie_op(@!d,@!n:small_number;@!v:trie_opcode):trie_opcode;
+label exit;
+var h:neg_trie_op_size..trie_op_size; {trial hash location}
+@!u:trie_opcode; {trial op code}
+@z
+
+@x [43.944] l.18370 - Another casting problem, and use |neg_trie_op_size|.
+begin h:=abs(n+313*d+361*v+1009*cur_lang) mod (trie_op_size+trie_op_size)
+ - trie_op_size;
+@y
+begin h:=abs(intcast(n)+313*intcast(d)+361*intcast(v)+1009*intcast(cur_lang))
+ mod (trie_op_size - neg_trie_op_size)
+ + neg_trie_op_size;
+@z
+
+@x [43.944] l.18377 - bigtrie: And larger tries again.
+ if u=max_quarterword then
+ overflow("pattern memory ops per language",
+ max_quarterword-min_quarterword);
+ incr(trie_op_ptr); incr(u); trie_used[cur_lang]:=u;
+@y
+ if u=max_trie_op then
+ overflow("pattern memory ops per language",
+ max_trie_op-min_trie_op);
+ incr(trie_op_ptr); incr(u); trie_used[cur_lang]:=u;
+ if u>max_op_used then max_op_used:=u;
+@z
+
+@x [43.945] l.18399 - bigtrie: And larger tries again.
+op_start[0]:=-min_quarterword;
+@y
+op_start[0]:=-min_trie_op;
+@z
+
+@x [43.946] l.18416 - bigtrie: And larger tries again.
+for k:=0 to 255 do trie_used[k]:=min_quarterword;
+@y
+for k:=0 to 255 do trie_used[k]:=min_trie_op;
+@z
+
+@x [43.946] l.18417 - Dynamic trie arrays.
+trie_op_ptr:=0;
+@y
+max_op_used:=min_trie_op;
+trie_op_ptr:=0;
+@z
+
+@x [43.947] l.18438 - Dynamically allocate arrays, and a casting problem.
+@!init @!trie_c:packed array[trie_pointer] of packed_ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:packed array[trie_pointer] of quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:packed array[trie_pointer] of trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:packed array[trie_pointer] of trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:packed array[trie_pointer] of trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@y
+@!init @!trie_c:^packed_ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:^trie_opcode;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:^trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:^trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:^trie_pointer;
+ {used to identify equivalent subtries}
+tini
+@z
+
+@x [43.948] l.18471 - Another casting problem.
+begin h:=abs(trie_c[p]+1009*trie_o[p]+@|
+ 2718*trie_l[p]+3142*trie_r[p]) mod trie_size;
+@y
+begin h:=abs(intcast(trie_c[p])+1009*intcast(trie_o[p])+@|
+ 2718*intcast(trie_l[p])+3142*intcast(trie_r[p])) mod trie_size;
+@z
+
+@x [43.950] l.18521 - Dynamically allocate & larger tries.
+@d trie_back(#)==trie[#].lh {backward links in |trie| holes}
+@y
+@d trie_back(#)==trie_tro[#] {use the opcode field now for backward links}
+@z
+
+@x [43.590] l.18524 - Dynamically allocate & larger tries.
+@!init@!trie_taken:packed array[1..trie_size] of boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:array[ASCII_code] of trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@y
+@!init@!trie_taken: ^boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:array[ASCII_code] of trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+@z
+
+@x [43.951] l.18539 - Dynamically allocate.
+trie_not_ready:=true; trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+trie_not_ready:=true;
+@z
+
+@x [43.958] l.18634 - bigtrie: Larger tries.
+@<Move the data into |trie|@>=
+h.rh:=0; h.b0:=min_quarterword; h.b1:=min_quarterword; {|trie_link:=0|,
+ |trie_op:=min_quarterword|, |trie_char:=qi(0)|}
+@y
+@d clear_trie == {clear |trie[r]|}
+ begin trie_link(r):=0;
+ trie_op(r):=min_trie_op;
+ trie_char(r):=min_quarterword; {|trie_char:=qi(0)|}
+ end
+
+@<Move the data into |trie|@>=
+@z
+
+@x [43.958] l.18638 - bigtrie: Larger tries.
+ begin for r:=0 to 256 do trie[r]:=h;
+@y
+ begin for r:=0 to 256 do clear_trie;
+@z
+
+@x [43.958] l.18643 - bigtrie: Larger tries.
+ repeat s:=trie_link(r); trie[r]:=h; r:=s;
+@y
+ repeat s:=trie_link(r); clear_trie; r:=s;
+@z
+
+@x [43.960] l.18677 - bigtrie: Larger tries.
+@!v:quarterword; {trie op code}
+@y
+@!v:trie_opcode; {trie op code}
+@z
+
+@x [43.963] l.18749 - bigtrie: Larger tries.
+if trie_o[q]<>min_quarterword then
+@y
+if trie_o[q]<>min_trie_op then
+@z
+
+@x [43.964] l.18762 - bigtrie: Larger tries.
+trie_c[p]:=si(c); trie_o[p]:=min_quarterword;
+@y
+trie_c[p]:=si(c); trie_o[p]:=min_trie_op;
+@z
+
+@x [43.965] l.18768 - bigtrie: Larger tries.
+l:=k; v:=min_quarterword;
+@y
+l:=k; v:=min_trie_op;
+@z
+
+@x [43.966] l.18786 - bigtrie: Larger tries.
+@!h:two_halves; {template used to zero out |trie|'s holes}
+@y
+@z
+
+%%
+%% We can rewrite the original code after "main_loop_move+2" upto the
+%% "tail_append(lig_stack)" in module 1036 as
+%%
+%
+% main_loop_move+2:
+% if font_bc[main_f]<=cur_chr then
+% if cur_chr<=font_ec[main_f] then
+% begin main_i:=char_info(main_f)(cur_l);
+% if char_exists(main_i) goto main_loop_move+3;
+% end;
+% char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+% main_loop_move+3:
+% tail_append(lig_stack) {|main_loop_lookahead| is next}
+%
+%%
+%% We can use the rewritten code above to include additional MLTeX
+%% specific parts in the future. Additionally it can be used when
+%% optimizing |main_control| to minimize the call of the function
+%% |effective_char|.
+%%
+%
+%@x [46.1030] l.19977 - MLTeX: substitution in |main_control|
+% main_loop_move,main_loop_move+1,main_loop_move+2,main_loop_move_lig,
+%@y
+% main_loop_move,main_loop_move+1,main_loop_move+2,main_loop_move+3,
+% main_loop_move_lig,
+%@z
+
+@x [46.1034] l.20074 - source specials
+@<Append character |cur_chr|...@>=
+adjust_space_factor;@/
+@y
+@<Append character |cur_chr|...@>=
+if ((head=tail) and (mode>0)) then begin
+ if (insert_src_special_auto) then append_src_special;
+end;
+adjust_space_factor;@/
+@z
+
+@x [46.1036] l.20138 - MLTeX: substitution in |main_control|
+main_loop_move+2:if(cur_chr<font_bc[main_f])or(cur_chr>font_ec[main_f]) then
+@y
+main_loop_move+2:
+if(qo(effective_char(false,main_f,qi(cur_chr)))>font_ec[main_f])or
+ (qo(effective_char(false,main_f,qi(cur_chr)))<font_bc[main_f]) then
+@z
+
+@x [46.1036] l.20141 - MLTeX: substitution in |main_control|
+main_i:=char_info(main_f)(cur_l);
+@y
+main_i:=effective_char_info(main_f,cur_l);
+@z
+
+@x [46.1049] l.20407 - i18n fix, see change to [16.211]
+print("' in "); print_mode(mode);
+@y
+print_in_mode(mode);
+@z
+
+% disabled in original tex-src-special.ch
+ @x [47.1083] l.20966 - source specials
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ @y
+ if (insert_src_special_every_vbox) then insert_src_special;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ @z
+
+% disabled in original tex-src-special.ch
+ @x [47.1083] l.20969 - source specials
+ if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+ @y
+ if (insert_src_special_every_hbox) then insert_src_special;
+ if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+ @z
+
+@x [47.1091] l.21064 - source specials
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ end;
+@y
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;
+ if (insert_src_special_every_par) then insert_src_special;@+
+ end;
+@z
+
+% disabled in original tex-src-special.ch, conflicts with etex.
+ @x [47.1096] l.21121 - source specials
+ else line_break(widow_penalty);
+ @y
+ else begin
+ if (insert_src_special_every_parend) then insert_src_special;
+ line_break(widow_penalty);
+ end;
+ @z
+
+@x
+begin print_err("Extra "); print_esc("endcsname");
+@.Extra \\endcsname@>
+help1("I'm ignoring this, since I wasn't doing a \csname.");
+@y
+begin
+if cur_chr = 10 then
+begin
+ print_err("Extra "); print_esc("endmubyte");
+@.Extra \\endmubyte@>
+ help1("I'm ignoring this, since I wasn't doing a \mubyte.");
+end else begin
+ print_err("Extra "); print_esc("endcsname");
+@.Extra \\endcsname@>
+ help1("I'm ignoring this, since I wasn't doing a \csname.");
+end;
+@z
+
+@x [48.1139] l.21650 - source specials
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+if (insert_src_special_every_math) then insert_src_special;
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+
+% disabled in original tex-src-special.ch
+ @x [48.1145] l.21705 - source specials
+if every_display<>null then begin_token_list(every_display,every_display_text);
+ @y
+if (insert_src_special_every_display) then append_src_special;
+if every_display<>null then begin_token_list(every_display,every_display_text);
+ @z
+
+@x [48.1167] l.22042 - source specials
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@y
+ if (insert_src_special_every_vbox) then insert_src_special;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@z
+
+@x [49.1211] - encTeX: extra variables for \mubyte primitive
+@!p,@!q:pointer; {for temporary short-term use}
+@y
+@!p,@!q,@!r:pointer; {for temporary short-term use}
+@z
+
+@x [49.1215] l.22719 - hash_extra
+if (cur_cs=0)or(cur_cs>frozen_control_sequence) then
+@y
+if (cur_cs=0)or(cur_cs>eqtb_top)or
+ ((cur_cs>frozen_control_sequence)and(cur_cs<=eqtb_size)) then
+@z
+
+@x [49.1219] - encTeX: \mubyte and \noconvert primitives
+primitive("futurelet",let,normal+1);@/
+@!@:future_let_}{\.{\\futurelet} primitive@>
+@y
+primitive("futurelet",let,normal+1);@/
+@!@:future_let_}{\.{\\futurelet} primitive@>
+if enctex_p then
+begin
+ primitive("mubyte",let,normal+10);@/
+@!@:mubyte_}{\.{\\mubyte} primitive@>
+ primitive("noconvert",let,normal+11);@/
+@!@:noconvert_}{\.{\\noconvert} primitive@>
+end;
+@z
+
+@x [49.1220] - encTeX: \mubyte primitive
+let: if chr_code<>normal then print_esc("futurelet")@+else print_esc("let");
+@y
+let: if chr_code<>normal then
+ if chr_code = normal+10 then print_esc("mubyte")
+ else if chr_code = normal+11 then print_esc("noconvert")
+ else print_esc("futurelet")
+ else print_esc("let");
+@z
+
+@x [49.1221] - encTeX: \mubyte primitive
+let: begin n:=cur_chr;
+@y
+let: if cur_chr = normal+11 then do_nothing { noconvert primitive }
+ else if cur_chr = normal+10 then { mubyte primitive }
+ begin
+ selector:=term_and_log;
+ get_token;
+ mubyte_stoken := cur_tok;
+ if cur_tok <= cs_token_flag then mubyte_stoken := cur_tok mod 256;
+ mubyte_prefix := 60; mubyte_relax := false;
+ mubyte_tablein := true; mubyte_tableout := true;
+ get_x_token;
+ if cur_cmd = spacer then get_x_token;
+ if cur_cmd = sub_mark then
+ begin
+ mubyte_tableout := false; get_x_token;
+ if cur_cmd = sub_mark then
+ begin
+ mubyte_tableout := true; mubyte_tablein := false;
+ get_x_token;
+ end;
+ end else if (mubyte_stoken > cs_token_flag) and
+ (cur_cmd = mac_param) then
+ begin
+ mubyte_tableout := false;
+ scan_int; mubyte_prefix := cur_val; get_x_token;
+ if mubyte_prefix > 50 then mubyte_prefix := 52;
+ if mubyte_prefix <= 0 then mubyte_prefix := 51;
+ end
+ else if (mubyte_stoken > cs_token_flag) and (cur_cmd = relax) then
+ begin
+ mubyte_tableout := true; mubyte_tablein := false;
+ mubyte_relax := true; get_x_token;
+ end;
+ r := get_avail; p := r;
+ while cur_cs = 0 do begin store_new_token (cur_tok); get_x_token; end;
+ if (cur_cmd <> end_cs_name) or (cur_chr <> 10) then
+ begin
+ print_err("Missing "); print_esc("endmubyte"); print(" inserted");
+ help2("The control sequence marked <to be read again> should")@/
+("not appear in <byte sequence> between \mubyte and \endmubyte.");
+ back_error;
+ end;
+ p := link(r);
+ if (p = null) and mubyte_tablein then
+ begin
+ print_err("The empty <byte sequence>, ");
+ print_esc("mubyte"); print(" ignored");
+ help2("The <byte sequence> in")@/
+("\mubyte <token> <byte sequence>\endmubyte should not be empty.");
+ error;
+ end else begin
+ while p <> null do
+ begin
+ append_char (info(p) mod 256);
+ p := link (p);
+ end;
+ flush_list (r);
+ if (str_start [str_ptr] + 1 = pool_ptr) and
+ (str_pool [pool_ptr-1] = mubyte_stoken) then
+ begin
+ if mubyte_read [mubyte_stoken] <> null
+ and mubyte_tablein then { clearing data }
+ dispose_munode (mubyte_read [mubyte_stoken]);
+ if mubyte_tablein then mubyte_read [mubyte_stoken] := null;
+ if mubyte_tableout then mubyte_write [mubyte_stoken] := 0;
+ pool_ptr := str_start [str_ptr];
+ end else begin
+ if mubyte_tablein then mubyte_update; { updating input side }
+ if mubyte_tableout then { updating output side }
+ begin
+ if mubyte_stoken > cs_token_flag then { control sequence }
+ begin
+ dispose_mutableout (mubyte_stoken-cs_token_flag);
+ if (str_start [str_ptr] < pool_ptr) or mubyte_relax then
+ begin { store data }
+ r := mubyte_cswrite[(mubyte_stoken-cs_token_flag) mod 128];
+ p := get_avail;
+ mubyte_cswrite[(mubyte_stoken-cs_token_flag) mod 128] := p;
+ info (p) := mubyte_stoken-cs_token_flag;
+ link (p) := get_avail;
+ p := link (p);
+ if mubyte_relax then begin
+ info (p) := 0; pool_ptr := str_start [str_ptr];
+ end else info (p) := slow_make_string;
+ link (p) := r;
+ end;
+ end else begin { single character }
+ if str_start [str_ptr] = pool_ptr then
+ mubyte_write [mubyte_stoken] := 0
+ else
+ mubyte_write [mubyte_stoken] := slow_make_string;
+ end;
+ end else pool_ptr := str_start [str_ptr];
+ end;
+ end;
+ end else begin { let primitive }
+ n:=cur_chr;
+@z
+
+@x [49.1222] l.22794 - MLTeX: \charsubdef primitive
+@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+@y
+@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+@d char_sub_def_code=7 {|shorthand_def| for \.{\\charsubdef}}
+@z
+
+@x [49.1222] l.22810 - MLTeX: \charsubdef primitive
+@!@:toks_def_}{\.{\\toksdef} primitive@>
+@y
+@!@:toks_def_}{\.{\\toksdef} primitive@>
+if mltex_p then
+ begin
+ primitive("charsubdef",shorthand_def,char_sub_def_code);@/
+@!@:char_sub_def_}{\.{\\charsubdef} primitive@>
+ end;
+@z
+
+@x [49.1222] l.22820 - MLTeX: \charsubdef primitive
+ othercases print_esc("toksdef")
+@y
+ char_sub_def_code: print_esc("charsubdef");
+ othercases print_esc("toksdef")
+@z
+
+@x [49.1222] l.22833 - MLTeX: \charsubdef primitive
+shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
+@y
+shorthand_def: if cur_chr=char_sub_def_code then
+ begin scan_char_num; p:=char_sub_code_base+cur_val; scan_optional_equals;
+ scan_char_num; n:=cur_val; {accent character in substitution}
+ scan_char_num;
+ if (tracing_char_sub_def>0) then
+ begin begin_diagnostic; print_nl("New character substitution: ");
+ print_ASCII(p-char_sub_code_base); print(" = ");
+ print_ASCII(n); print_char(" ");
+ print_ASCII(cur_val); end_diagnostic(false);
+ end;
+ n:=n*256+cur_val;
+ define(p,data,hi(n));
+ if (p-char_sub_code_base)<char_sub_def_min then
+ word_define(int_base+char_sub_def_min_code,p-char_sub_code_base);
+ if (p-char_sub_code_base)>char_sub_def_max then
+ word_define(int_base+char_sub_def_max_code,p-char_sub_code_base);
+ end
+else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
+@z
+
+@x [49.1230] l.22936 - encTeX: \xordcode, \xchrcode, \xprncode primitives
+primitive("catcode",def_code,cat_code_base);
+@!@:cat_code_}{\.{\\catcode} primitive@>
+@y
+primitive("catcode",def_code,cat_code_base);
+@!@:cat_code_}{\.{\\catcode} primitive@>
+if enctex_p then
+begin
+ primitive("xordcode",def_code,xord_code_base);
+@!@:xord_code_}{\.{\\xordcode} primitive@>
+ primitive("xchrcode",def_code,xchr_code_base);
+@!@:xchr_code_}{\.{\\xchrcode} primitive@>
+ primitive("xprncode",def_code,xprn_code_base);
+@!@:xprn_code_}{\.{\\xprncode} primitive@>
+end;
+@z
+
+@x [49.1231] l.22956 - encTeX: \xordcode, \xchrcode, \xprncode primitives
+def_code: if chr_code=cat_code_base then print_esc("catcode")
+@y
+def_code: if chr_code=xord_code_base then print_esc("xordcode")
+ else if chr_code=xchr_code_base then print_esc("xchrcode")
+ else if chr_code=xprn_code_base then print_esc("xprncode")
+ else if chr_code=cat_code_base then print_esc("catcode")
+@z
+
+@x [49.1232] l.22969 - encTeX: setting a new value to xchr/xord/xprn
+ p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+@y
+ p:=cur_chr; scan_char_num;
+ if p=xord_code_base then p:=cur_val
+ else if p=xchr_code_base then p:=cur_val+256
+ else if p=xprn_code_base then p:=cur_val+512
+ else p:=p+cur_val;
+ scan_optional_equals;
+ scan_int;
+@z
+
+@x [49.1232] l.22980 - encTeX: setting a new value to xchr/xord/xprn
+ if p<math_code_base then define(p,data,cur_val)
+@y
+ if p<256 then xord[p]:=cur_val
+ else if p<512 then xchr[p-256]:=cur_val
+ else if p<768 then xprn[p-512]:=cur_val
+ else if p<math_code_base then define(p,data,cur_val)
+@z
+
+@x [49.1252] l.23230 - INI = VIR, so have to do runtime test.
+ begin @!init new_patterns; goto done;@;@+tini@/
+@y 23215
+ begin @!Init new_patterns; goto done;@;@+Tini@/
+@z
+
+% undo Knuth's change because
+% a) the string is already replaced in |scan_file_name| and therefore
+% b) the wrong string will get flushed!!!
+%
+@x [49.1260] l.23331 new_font: string recycling -- already done
+flushable_string:=str_ptr-1;
+@y
+@z
+
+% If you don't want to remove code with the following change,
+% please replace the former change by
+%
+% @x
+% flushable_string:=str_ptr-1;
+% @y
+% if cur_name=str_ptr-1 then
+% flushable_string:=str_ptr-1
+% else
+% flushable_string:=str_ptr; {number of a non-existing}
+% @z
+%
+% otherwise the wrong string will get removed by |flush_string|!!
+%
+@x [49.1260] l.23334 new_font: string recycling -- already done
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name[f];
+ end;
+ if s>0 then
+@y
+ begin if s>0 then
+@z
+
+@x [49.1265] if batchmode, mktex... scripts should be silent.
+interaction:=cur_chr;
+@y
+interaction:=cur_chr;
+if interaction = batch_mode
+then kpse_make_tex_discard_errors := 1
+else kpse_make_tex_discard_errors := 0;
+@z
+
+@x [49.1275] l.23434 - Index variable for next fragment of code.
+@!n:0..15; {stream number}
+@y
+@!n:0..15; {stream number}
+@!k:integer;
+@z
+
+@x [49.1275] l.23441 - Same stuff as for \input, this time for \openin.
+ if cur_ext="" then cur_ext:=".tex";
+ pack_cur_name;
+ if a_open_in(read_file[n]) then read_open[n]:=just_open;
+@y
+ pack_cur_name;
+ tex_input_type:=0; {Tell |open_input| we are \.{\\openin}.}
+ if open_in_name_ok(stringcast(name_of_file+1))
+ and a_open_in(read_file[n], kpse_tex_format) then
+ read_open[n]:=just_open;
+@z
+
+@x [49.1279] - encTeX: implement \noconvert
+old_setting:=selector; selector:=new_string;
+token_show(def_ref); selector:=old_setting;
+@y
+old_setting:=selector; selector:=new_string;
+message_printing := true; active_noconvert := true;
+token_show(def_ref);
+message_printing := false; active_noconvert := false;
+selector:=old_setting;
+@z
+
+% encTeX: |slow_print| is too eager to expand printed strings. To
+% selectively suppress or enable expansion (needed to \noconvert)
+% |print| will look at |message_printing|. So we bypass |slow_print|
+% and go directly to |print| instead.
+@x [49.1279] - encTeX: to handle \noconvert in messages go directly to |print|
+slow_print(s); update_terminal;
+@y
+print(s); update_terminal;
+@z
+
+@x [49.1279] - encTeX: to handle \noconvert in messages go directly to |print|
+begin print_err(""); slow_print(s);
+@y
+begin print_err(""); print(s);
+@z
+
+@x [50.1301] l.23679 - INI = VIR, so runtime test.
+format_ident:=" (INITEX)";
+@y
+if ini_version then format_ident:=" (INITEX)";
+@z
+
+% Eliminate now-unused variable `w' in `store_fmt_file'.
+% Add format_engine.
+@x [50.1302] l.23690
+@!w: four_quarters; {four ASCII codes}
+@y
+@!format_engine: ^text_char;
+@z
+
+% MLTeX: dump |mltex_p| to fmt file
+% encTeX: dump encTeX-specific data to fmt file.
+@x [50.1302] l.23694
+@<Dump constants for consistency check@>;
+@y
+@<Dump constants for consistency check@>;
+@<Dump ML\TeX-specific data@>;
+@<Dump enc\TeX-specific data@>;
+@z
+
+% Eliminate now-unused variable `w' in `load_fmt_file'.
+% Add dummies for undumping encTeX into the void.
+% Add format_engine.
+@x [50.1303] l.23722
+@!w: four_quarters; {four ASCII codes}
+@y
+@!format_engine: ^text_char;
+@!dummy_xord: ASCII_code;
+@!dummy_xchr: text_char;
+@!dummy_xprn: ASCII_code;
+@z
+
+% MLTeX: undump |mltex_enabled_p| from fmt file
+% encTeX: undump encTeX-specific data from fmt file.
+@x [50.1303] l.23694
+begin @<Undump constants for consistency check@>;
+@y
+begin @<Undump constants for consistency check@>;
+@<Undump ML\TeX-specific data@>;
+@<Undump enc\TeX-specific data@>;
+@z
+
+@x [50.1305] l.23751 - Do dumping and undumping of fmt files in C.
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+@y
+@z
+@x [1306]
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@y
+@z
+@x [still 1306] debug format file
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@y
+@d format_debug_end(#)==
+ write_ln (stderr, ' = ', #);
+ end;
+@d format_debug(#)==
+ if debug_format_file then begin
+ write (stderr, 'fmtdebug:', #);
+ format_debug_end
+@d undump_size_end_end(#)==
+ too_small(#)@+else format_debug (#)(x); undump_end_end
+@z
+
+@x [50,1307] l.23779 - texarray
+dump_int(@$);@/
+@y
+dump_int(@"57325458); {Web2C \TeX's magic constant: "W2TX"}
+{Align engine to 4 bytes with one or more trailing NUL}
+x:=strlen(engine_name);
+format_engine:=xmalloc_array(text_char,x+4);
+strcpy(format_engine, engine_name);
+for k:=x to x+3 do format_engine[k]:=0;
+x:=x+4-(x mod 4);
+dump_int(x);dump_things(format_engine[0], x);
+libc_free(format_engine);@/
+dump_int(@$);@/
+@<Dump |xord|, |xchr|, and |xprn|@>;
+dump_int(max_halfword);@/
+dump_int(hash_high);
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23784 m.1307
+dump_int(hyph_size)
+@y 23784
+dump_int(hyph_prime)
+@z
+
+@x [50.1308] l.23793 - texarray
+x:=fmt_file^.int;
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@y
+@+Init
+libc_free(font_info); libc_free(str_pool); libc_free(str_start);
+libc_free(yhash); libc_free(zeqtb); libc_free(yzmem);
+@+Tini
+undump_int(x);
+format_debug('format magic number')(x);
+if x<>@"57325458 then goto bad_fmt; {not a format file}
+undump_int(x);
+format_debug('engine name size')(x);
+if (x<0) or (x>256) then goto bad_fmt; {corrupted format file}
+format_engine:=xmalloc_array(text_char, x);
+undump_things(format_engine[0], x);
+format_engine[x-1]:=0; {force string termination, just in case}
+if strcmp(engine_name, format_engine) then
+ begin wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' was written by ', format_engine);
+ libc_free(format_engine);
+ goto bad_fmt;
+end;
+libc_free(format_engine);
+undump_int(x);
+format_debug('string pool checksum')(x);
+if x<>@$ then begin {check that strings are the same}
+ wake_up_terminal;
+ wterm_ln('---! ', stringcast(name_of_file+1), ' doesn''t match ', pool_name);
+ goto bad_fmt;
+end;
+@<Undump |xord|, |xchr|, and |xprn|@>;
+undump_int(x);
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+undump_int(hash_high);
+ if (hash_high<0)or(hash_high>sup_hash_extra) then goto bad_fmt;
+ if hash_extra<hash_high then hash_extra:=hash_high;
+ eqtb_top:=eqtb_size+hash_extra;
+ if hash_extra=0 then hash_top:=undefined_control_sequence else
+ hash_top:=eqtb_top;
+ yhash:=xmalloc_array(two_halves,1+hash_top-hash_offset);
+ hash:=yhash - hash_offset;
+ next(hash_base):=0; text(hash_base):=0;
+ for x:=hash_base+1 to hash_top do hash[x]:=hash[hash_base];
+ zeqtb:=xmalloc_array (memory_word,eqtb_top+1);
+ eqtb:=zeqtb;
+
+ eq_type(undefined_control_sequence):=undefined_cs;
+ equiv(undefined_control_sequence):=null;
+ eq_level(undefined_control_sequence):=level_zero;
+ for x:=eqtb_size+1 to eqtb_top do
+ eqtb[x]:=eqtb[undefined_control_sequence];
+@z
+
+@x [50.1308] l.23795 - texarray
+undump_int(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(x);
+if x<>mem_top then goto bad_fmt;
+@y
+undump_int(x); format_debug ('mem_bot')(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(mem_top); format_debug ('mem_top')(mem_top);
+if mem_bot+1100>mem_top then goto bad_fmt;
+
+
+head:=contrib_head; tail:=contrib_head;
+ page_tail:=page_head; {page initialization}
+
+mem_min := mem_bot - extra_mem_bot;
+mem_max := mem_top + extra_mem_top;
+
+yzmem:=xmalloc_array (memory_word, mem_max - mem_min + 1);
+zmem := yzmem - mem_min; {this pointer arithmetic fails with some compilers}
+mem := zmem;
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 23804 m.1308
+if x<>hyph_size then goto bad_fmt
+@y 23804
+if x<>hyph_prime then goto bad_fmt
+@z
+
+% [1309] Make dumping/undumping more efficient by doing whole arrays at
+% a time, via fread/fwrite in texmfmp.c.
+@x [50.1309] l.23814 - Make dumping/undumping more efficient.
+for k:=0 to str_ptr do dump_int(str_start[k]);
+k:=0;
+while k+4<pool_ptr do
+ begin dump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; dump_four_ASCII;
+@y
+dump_things(str_start[0], str_ptr+1);
+dump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1310] l.23829 - Make dumping/undumping more efficient.
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings)('max strings')(str_ptr);
+for k:=0 to str_ptr do undump(0)(pool_ptr)(str_start[k]);
+k:=0;
+while k+4<pool_ptr do
+ begin undump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; undump_four_ASCII;
+@y
+undump_size(0)(sup_pool_size-pool_free)('string pool size')(pool_ptr);
+if pool_size<pool_ptr+pool_free then
+ pool_size:=pool_ptr+pool_free;
+undump_size(0)(sup_max_strings-strings_free)('sup strings')(str_ptr);@/
+if max_strings<str_ptr+strings_free then
+ max_strings:=str_ptr+strings_free;
+str_start:=xmalloc_array(pool_pointer, max_strings);
+undump_checked_things(0, pool_ptr, str_start[0], str_ptr+1);@/
+str_pool:=xmalloc_array(packed_ASCII_code, pool_size);
+undump_things(str_pool[0], pool_ptr);
+@z
+
+@x [50.1311] l.23850 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do dump_wd(mem[k]);
+@y
+repeat dump_things(mem[p], q+2-p);
+@z
+
+@x [50.1311] l.23855 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do dump_wd(mem[k]);
+@y
+dump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1311] l.23858 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
+@y
+dump_things(mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+@x [50.1312] l.23873 - Make dumping/undumping more efficient.
+repeat for k:=p to q+1 do undump_wd(mem[k]);
+@y
+repeat undump_things(mem[p], q+2-p);
+@z
+
+@x [50.1312] l.23878 - Make dumping/undumping more efficient.
+for k:=p to lo_mem_max do undump_wd(mem[k]);
+@y
+undump_things(mem[p], lo_mem_max+1-p);
+@z
+
+@x [50.1312] l.23888 - Make dumping/undumping more efficient.
+for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
+@y
+undump_things (mem[hi_mem_min], mem_end+1-hi_mem_min);
+@z
+
+@x [50.1314] l.23899 - hash_extra, source specials
+undump(hash_base)(frozen_control_sequence)(par_loc);
+par_token:=cs_token_flag+par_loc;@/
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+@y
+undump(hash_base)(hash_top)(par_loc);
+par_token:=cs_token_flag+par_loc;@/
+undump(hash_base)(hash_top)(write_loc);@/
+@z
+
+@x [50.1315] l.23925 - Make dumping/undumping more efficient - eqtb
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+@y
+dump_things(eqtb[k], l-k);
+@z
+
+@x [50.1316] l.23944 - Make dumping/undumping more efficient - eqtb
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+@y
+dump_things(eqtb[k], l-k);
+@z
+
+@x [50.1316] l.23947 - hash_extra
+k:=j+1; dump_int(k-l);
+until k>eqtb_size
+@y
+k:=j+1; dump_int(k-l);
+until k>eqtb_size;
+if hash_high>0 then dump_things(eqtb[eqtb_size+1],hash_high);
+ {dump |hash_extra| part}
+@z
+
+@x [50.1317] l.23958 - Make dumping/undumping more efficient - eqtb
+for j:=k to k+x-1 do undump_wd(eqtb[j]);
+@y
+undump_things(eqtb[k], x);
+@z
+
+@x [50.1317] l.23960 - hash_extra
+until k>eqtb_size
+@y
+until k>eqtb_size;
+if hash_high>0 then undump_things(eqtb[eqtb_size+1],hash_high);
+ {undump |hash_extra| part}
+@z
+
+@x [50.1318] l.23968 - hash_extra
+dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used;
+@y 23968
+dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used+hash_high;
+@z
+
+@x [50.1318] l.23972 - Make dumping/undumping more efficient, hash_extra
+for p:=hash_used+1 to undefined_control_sequence-1 do dump_hh(hash[p]);
+@y
+dump_things(hash[hash_used+1], undefined_control_sequence-1-hash_used);
+if hash_high>0 then dump_things(hash[eqtb_size+1], hash_high);
+@z
+
+@x [50.1319] l.23980 - Make dumping/undumping more efficient, hash_extra
+for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]);
+@y
+undump_things (hash[hash_used+1], undefined_control_sequence-1-hash_used);
+if debug_format_file then begin
+ print_csnames (hash_base, undefined_control_sequence - 1);
+end;
+if hash_high > 0 then begin
+ undump_things (hash[eqtb_size+1], hash_high);
+ if debug_format_file then begin
+ print_csnames (eqtb_size + 1, hash_high - (eqtb_size + 1));
+ end;
+end;
+@z
+
+@x [50.1320] l.23985 - Make dumping/undumping more efficient - tfm
+for k:=0 to fmem_ptr-1 do dump_wd(font_info[k]);
+dump_int(font_ptr);
+for k:=null_font to font_ptr do
+ @<Dump the array info for internal font number |k|@>;
+@y
+dump_things(font_info[0], fmem_ptr);
+dump_int(font_ptr);
+@<Dump the array info for internal font number |k|@>;
+@z
+
+@x [50.1320] l.23991 - i18n fix
+print_int(font_ptr-font_base); print(" preloaded font");
+if font_ptr<>font_base+1 then print_char("s")
+@y
+print_int(font_ptr-font_base);
+if font_ptr<>font_base+1 then print(" preloaded fonts")
+else print(" preloaded font")
+@z
+
+@x [50.1321] l.23994 - texarray
+undump_size(7)(font_mem_size)('font mem size')(fmem_ptr);
+for k:=0 to fmem_ptr-1 do undump_wd(font_info[k]);
+undump_size(font_base)(font_max)('font max')(font_ptr);
+for k:=null_font to font_ptr do
+ @<Undump the array info for internal font number |k|@>
+@y
+undump_size(7)(sup_font_mem_size)('font mem size')(fmem_ptr);
+if fmem_ptr>font_mem_size then font_mem_size:=fmem_ptr;
+font_info:=xmalloc_array(fmemory_word, font_mem_size);
+undump_things(font_info[0], fmem_ptr);@/
+undump_size(font_base)(font_base+max_font_max)('font max')(font_ptr);
+{This undumps all of the font info, despite the name.}
+@<Undump the array info for internal font number |k|@>;
+@z
+
+% [50.1322] Dumping font_info.
+% Knuth's code writes all the information relevant to a single font
+% in the same section of the fmt file. But it's a lot faster to
+% write the arrays of information out, one whole array at a time.
+% So that's the way we handle dumping and undumping font info.
+@x [50.1322] l.24000 - Make dumping/undumping more efficient - tfm
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_qqqq(font_check[k]);
+dump_int(font_size[k]);
+dump_int(font_dsize[k]);
+dump_int(font_params[k]);@/
+dump_int(hyphen_char[k]);
+dump_int(skew_char[k]);@/
+dump_int(font_name[k]);
+dump_int(font_area[k]);@/
+dump_int(font_bc[k]);
+dump_int(font_ec[k]);@/
+dump_int(char_base[k]);
+dump_int(width_base[k]);
+dump_int(height_base[k]);@/
+dump_int(depth_base[k]);
+dump_int(italic_base[k]);
+dump_int(lig_kern_base[k]);@/
+dump_int(kern_base[k]);
+dump_int(exten_base[k]);
+dump_int(param_base[k]);@/
+dump_int(font_glue[k]);@/
+dump_int(bchar_label[k]);
+dump_int(font_bchar[k]);
+dump_int(font_false_bchar[k]);@/
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(font_name[k],font_area[k],"");
+if font_size[k]<>font_dsize[k] then
+ begin print(" at "); print_scaled(font_size[k]); print("pt");
+ end;
+end
+@y
+@ @<Dump the array info for internal font number |k|@>=
+begin
+dump_things(font_check[null_font], font_ptr+1-null_font);
+dump_things(font_size[null_font], font_ptr+1-null_font);
+dump_things(font_dsize[null_font], font_ptr+1-null_font);
+dump_things(font_params[null_font], font_ptr+1-null_font);
+dump_things(hyphen_char[null_font], font_ptr+1-null_font);
+dump_things(skew_char[null_font], font_ptr+1-null_font);
+dump_things(font_name[null_font], font_ptr+1-null_font);
+dump_things(font_area[null_font], font_ptr+1-null_font);
+dump_things(font_bc[null_font], font_ptr+1-null_font);
+dump_things(font_ec[null_font], font_ptr+1-null_font);
+dump_things(char_base[null_font], font_ptr+1-null_font);
+dump_things(width_base[null_font], font_ptr+1-null_font);
+dump_things(height_base[null_font], font_ptr+1-null_font);
+dump_things(depth_base[null_font], font_ptr+1-null_font);
+dump_things(italic_base[null_font], font_ptr+1-null_font);
+dump_things(lig_kern_base[null_font], font_ptr+1-null_font);
+dump_things(kern_base[null_font], font_ptr+1-null_font);
+dump_things(exten_base[null_font], font_ptr+1-null_font);
+dump_things(param_base[null_font], font_ptr+1-null_font);
+dump_things(font_glue[null_font], font_ptr+1-null_font);
+dump_things(bchar_label[null_font], font_ptr+1-null_font);
+dump_things(font_bchar[null_font], font_ptr+1-null_font);
+dump_things(font_false_bchar[null_font], font_ptr+1-null_font);
+for k:=null_font to font_ptr do
+ begin print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+ print_file_name(font_name[k],font_area[k],"");
+ if font_size[k]<>font_dsize[k] then
+ begin print(" at "); print_scaled(font_size[k]); print("pt");
+ end;
+ end;
+end
+@z
+
+@x [50.1322] l.24031 - Make dumping/undumping more efficient - tfm
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_qqqq(font_check[k]);@/
+undump_int(font_size[k]);
+undump_int(font_dsize[k]);
+undump(min_halfword)(max_halfword)(font_params[k]);@/
+undump_int(hyphen_char[k]);
+undump_int(skew_char[k]);@/
+undump(0)(str_ptr)(font_name[k]);
+undump(0)(str_ptr)(font_area[k]);@/
+undump(0)(255)(font_bc[k]);
+undump(0)(255)(font_ec[k]);@/
+undump_int(char_base[k]);
+undump_int(width_base[k]);
+undump_int(height_base[k]);@/
+undump_int(depth_base[k]);
+undump_int(italic_base[k]);
+undump_int(lig_kern_base[k]);@/
+undump_int(kern_base[k]);
+undump_int(exten_base[k]);
+undump_int(param_base[k]);@/
+undump(min_halfword)(lo_mem_max)(font_glue[k]);@/
+undump(0)(fmem_ptr-1)(bchar_label[k]);
+undump(min_quarterword)(non_char)(font_bchar[k]);
+undump(min_quarterword)(non_char)(font_false_bchar[k]);
+end
+@y
+@ This module should now be named `Undump all the font arrays'.
+
+@<Undump the array info for internal font number |k|@>=
+begin {Allocate the font arrays}
+font_check:=xmalloc_array(four_quarters, font_max);
+font_size:=xmalloc_array(scaled, font_max);
+font_dsize:=xmalloc_array(scaled, font_max);
+font_params:=xmalloc_array(font_index, font_max);
+font_name:=xmalloc_array(str_number, font_max);
+font_area:=xmalloc_array(str_number, font_max);
+font_bc:=xmalloc_array(eight_bits, font_max);
+font_ec:=xmalloc_array(eight_bits, font_max);
+font_glue:=xmalloc_array(halfword, font_max);
+hyphen_char:=xmalloc_array(integer, font_max);
+skew_char:=xmalloc_array(integer, font_max);
+bchar_label:=xmalloc_array(font_index, font_max);
+font_bchar:=xmalloc_array(nine_bits, font_max);
+font_false_bchar:=xmalloc_array(nine_bits, font_max);
+char_base:=xmalloc_array(integer, font_max);
+width_base:=xmalloc_array(integer, font_max);
+height_base:=xmalloc_array(integer, font_max);
+depth_base:=xmalloc_array(integer, font_max);
+italic_base:=xmalloc_array(integer, font_max);
+lig_kern_base:=xmalloc_array(integer, font_max);
+kern_base:=xmalloc_array(integer, font_max);
+exten_base:=xmalloc_array(integer, font_max);
+param_base:=xmalloc_array(integer, font_max);
+
+undump_things(font_check[null_font], font_ptr+1-null_font);
+undump_things(font_size[null_font], font_ptr+1-null_font);
+undump_things(font_dsize[null_font], font_ptr+1-null_font);
+undump_checked_things(min_halfword, max_halfword,
+ font_params[null_font], font_ptr+1-null_font);
+undump_things(hyphen_char[null_font], font_ptr+1-null_font);
+undump_things(skew_char[null_font], font_ptr+1-null_font);
+undump_upper_check_things(str_ptr, font_name[null_font], font_ptr+1-null_font);
+undump_upper_check_things(str_ptr, font_area[null_font], font_ptr+1-null_font);
+{There's no point in checking these values against the range $[0,255]$,
+ since the data type is |unsigned char|, and all values of that type are
+ in that range by definition.}
+undump_things(font_bc[null_font], font_ptr+1-null_font);
+undump_things(font_ec[null_font], font_ptr+1-null_font);
+undump_things(char_base[null_font], font_ptr+1-null_font);
+undump_things(width_base[null_font], font_ptr+1-null_font);
+undump_things(height_base[null_font], font_ptr+1-null_font);
+undump_things(depth_base[null_font], font_ptr+1-null_font);
+undump_things(italic_base[null_font], font_ptr+1-null_font);
+undump_things(lig_kern_base[null_font], font_ptr+1-null_font);
+undump_things(kern_base[null_font], font_ptr+1-null_font);
+undump_things(exten_base[null_font], font_ptr+1-null_font);
+undump_things(param_base[null_font], font_ptr+1-null_font);
+undump_checked_things(min_halfword, lo_mem_max,
+ font_glue[null_font], font_ptr+1-null_font);
+undump_checked_things(0, fmem_ptr-1,
+ bchar_label[null_font], font_ptr+1-null_font);
+undump_checked_things(min_quarterword, non_char,
+ font_bchar[null_font], font_ptr+1-null_font);
+undump_checked_things(min_quarterword, non_char,
+ font_false_bchar[null_font], font_ptr+1-null_font);
+end
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24058 m.1324
+dump_int(hyph_count);
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k); dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@y 24061
+dump_int(hyph_count);
+if hyph_next <= hyph_prime then hyph_next:=hyph_size;
+dump_int(hyph_next);{minumum value of |hyphen_size| needed}
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k+65536*hyph_link[k]);
+ {assumes number of hyphen exceptions does not exceed 65535}
+ dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+@z
+
+@x [50.1324] l.24063 - i18n fix
+print_ln; print_int(hyph_count); print(" hyphenation exception");
+if hyph_count<>1 then print_char("s");
+@y
+print_ln; print_int(hyph_count);
+if hyph_count<>1 then print(" hyphenation exceptions")
+else print(" hyphenation exception");
+@z
+
+@x [50.1324] l.24066 - Make dumping/undumping more efficient - trie
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(trie_op_ptr);
+for k:=1 to trie_op_ptr do
+ begin dump_int(hyf_distance[k]);
+ dump_int(hyf_num[k]);
+ dump_int(hyf_next[k]);
+ end;
+@y
+dump_things(trie_trl[0], trie_max+1);
+dump_things(trie_tro[0], trie_max+1);
+dump_things(trie_trc[0], trie_max+1);
+dump_int(trie_op_ptr);
+dump_things(hyf_distance[1], trie_op_ptr);
+dump_things(hyf_num[1], trie_op_ptr);
+dump_things(hyf_next[1], trie_op_ptr);
+@z
+
+@x [50.1324] l.24076 - i18n fix
+print(" has "); print_int(trie_op_ptr); print(" op");
+if trie_op_ptr<>1 then print_char("s");
+@y
+print(" has "); print_int(trie_op_ptr);
+if trie_op_ptr<>1 then print(" ops")
+else print(" op");
+@z
+
+%%%%%%%% dynamic hyph_size
+@x 24087 m.1325
+undump(0)(hyph_size)(hyph_count);
+for k:=1 to hyph_count do
+ begin undump(0)(hyph_size)(j);
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+@y 24092
+undump_size(0)(hyph_size)('hyph_size')(hyph_count);
+undump_size(hyph_prime)(hyph_size)('hyph_size')(hyph_next);
+j:=0;
+for k:=1 to hyph_count do
+ begin undump_int(j); if j<0 then goto bad_fmt;
+ if j>65535 then
+ begin hyph_next:= j div 65536; j:=j - hyph_next * 65536; end
+ else hyph_next:=0;
+ if (j>=hyph_size)or(hyph_next>hyph_size) then goto bad_fmt;
+ hyph_link[j]:=hyph_next;
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+ {|j| is now the largest occupied location in |hyph_word|}
+ incr(j);
+ if j<hyph_prime then j:=hyph_prime;
+ hyph_next:=j;
+ if hyph_next >= hyph_size then hyph_next:=hyph_prime else
+ if hyph_next >= hyph_prime then incr(hyph_next);
+@z
+
+
+@x [50.1325] l.24094 - Make dumping/undumping more efficient - trie
+for k:=0 to j do undump_hh(trie[k]);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+for k:=1 to j do
+ begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
+ undump(0)(63)(hyf_num[k]);
+ undump(min_quarterword)(max_quarterword)(hyf_next[k]);
+ end;
+@y
+{These first three haven't been allocated yet unless we're \.{INITEX};
+ we do that precisely so we don't allocate more space than necessary.}
+if not trie_trl then trie_trl:=xmalloc_array(trie_pointer,j+1);
+undump_things(trie_trl[0], j+1);
+if not trie_tro then trie_tro:=xmalloc_array(trie_pointer,j+1);
+undump_things(trie_tro[0], j+1);
+if not trie_trc then trie_trc:=xmalloc_array(quarterword, j+1);
+undump_things(trie_trc[0], j+1);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+{I'm not sure we have such a strict limitation (64) on these values, so
+ let's leave them unchecked.}
+undump_things(hyf_distance[1], j);
+undump_things(hyf_num[1], j);
+undump_upper_check_things(max_trie_op, hyf_next[1], j);
+@z
+
+@x [50.1327] l.24117 - Allow command line to override dumped value.
+undump(batch_mode)(error_stop_mode)(interaction);
+@y
+undump(batch_mode)(error_stop_mode)(interaction);
+if interaction_option<>unspecified_mode then interaction:=interaction_option;
+@z
+
+% [50.1327] As with TFM files, `eof' here means `have we previously
+% encountered the end-of-file', not `are we at the end of the file'.
+@x [50.1327] l.24120 - dumping/undumping, replace eof() by feof()
+if (x<>69069)or eof(fmt_file) then goto bad_fmt
+@y
+if (x<>69069)or feof(fmt_file) then goto bad_fmt
+@z
+
+% Eliminate probably wrong word `preloaded' from format_idents.
+@x [50.1328] l.24124
+print(" (preloaded format="); print(job_name); print_char(" ");
+@y
+print(" (format="); print(job_name); print_char(" ");
+@z
+
+@x [51.1332] l.24203 - make the main program a procedure, for eqtb hack.
+@p begin @!{|start_here|}
+@y
+@d const_chk(#)==begin if # < inf@&# then # := inf@&# else
+ if # > sup@&# then # := sup@&# end
+
+{|setup_bound_var| stuff duplicated in \.{mf.ch}.}
+@d setup_bound_var(#)==bound_default:=#; setup_bound_var_end
+@d setup_bound_var_end(#)==bound_name:=#; setup_bound_var_end_end
+@d setup_bound_var_end_end(#)==
+ setup_bound_variable(address_of(#), bound_name, bound_default);
+
+@p procedure main_body;
+begin @!{|start_here|}
+
+{Bounds that may be set from the configuration file. We want the user to
+ be able to specify the names with underscores, but \.{TANGLE} removes
+ underscores, so we're stuck giving the names twice, once as a string,
+ once as the identifier. How ugly.}
+ setup_bound_var (0)('mem_bot')(mem_bot);
+ setup_bound_var (250000)('main_memory')(main_memory);
+ {|memory_word|s for |mem| in \.{INITEX}}
+ setup_bound_var (0)('extra_mem_top')(extra_mem_top);
+ {increase high mem in \.{VIRTEX}}
+ setup_bound_var (0)('extra_mem_bot')(extra_mem_bot);
+ {increase low mem in \.{VIRTEX}}
+ setup_bound_var (100000)('pool_size')(pool_size);
+ setup_bound_var (75000)('string_vacancies')(string_vacancies);
+ setup_bound_var (5000)('pool_free')(pool_free); {min pool avail after fmt}
+ setup_bound_var (15000)('max_strings')(max_strings);
+ setup_bound_var (100)('strings_free')(strings_free);
+ setup_bound_var (100000)('font_mem_size')(font_mem_size);
+ setup_bound_var (500)('font_max')(font_max);
+ setup_bound_var (20000)('trie_size')(trie_size);
+ {if |ssup_trie_size| increases, recompile}
+ setup_bound_var (659)('hyph_size')(hyph_size);
+ setup_bound_var (3000)('buf_size')(buf_size);
+ setup_bound_var (50)('nest_size')(nest_size);
+ setup_bound_var (15)('max_in_open')(max_in_open);
+ setup_bound_var (60)('param_size')(param_size);
+ setup_bound_var (4000)('save_size')(save_size);
+ setup_bound_var (300)('stack_size')(stack_size);
+ setup_bound_var (16384)('dvi_buf_size')(dvi_buf_size);
+ setup_bound_var (79)('error_line')(error_line);
+ setup_bound_var (50)('half_error_line')(half_error_line);
+ setup_bound_var (79)('max_print_line')(max_print_line);
+ setup_bound_var (0)('hash_extra')(hash_extra);
+
+ const_chk (mem_bot);
+ const_chk (main_memory);
+@+Init
+ extra_mem_top := 0;
+ extra_mem_bot := 0;
+@+Tini
+ if extra_mem_bot>sup_main_memory then extra_mem_bot:=sup_main_memory;
+ if extra_mem_top>sup_main_memory then extra_mem_top:=sup_main_memory;
+ {|mem_top| is an index, |main_memory| a size}
+ mem_top := mem_bot + main_memory -1;
+ mem_min := mem_bot;
+ mem_max := mem_top;
+
+ {Check other constants against their sup and inf.}
+ const_chk (trie_size);
+ const_chk (hyph_size);
+ const_chk (buf_size);
+ const_chk (nest_size);
+ const_chk (max_in_open);
+ const_chk (param_size);
+ const_chk (save_size);
+ const_chk (stack_size);
+ const_chk (dvi_buf_size);
+ const_chk (pool_size);
+ const_chk (string_vacancies);
+ const_chk (pool_free);
+ const_chk (max_strings);
+ const_chk (strings_free);
+ const_chk (font_mem_size);
+ const_chk (font_max);
+ const_chk (hash_extra);
+ if error_line > ssup_error_line then error_line := ssup_error_line;
+
+ {array memory allocation}
+ buffer:=xmalloc_array (ASCII_code, buf_size);
+ nest:=xmalloc_array (list_state_record, nest_size);
+ save_stack:=xmalloc_array (memory_word, save_size);
+ input_stack:=xmalloc_array (in_state_record, stack_size);
+ input_file:=xmalloc_array (alpha_file, max_in_open);
+ line_stack:=xmalloc_array (integer, max_in_open);
+ source_filename_stack:=xmalloc_array (str_number, max_in_open);
+ full_source_filename_stack:=xmalloc_array (str_number, max_in_open);
+ param_stack:=xmalloc_array (halfword, param_size);
+ dvi_buf:=xmalloc_array (eight_bits, dvi_buf_size);
+ hyph_word :=xmalloc_array (str_number, hyph_size);
+ hyph_list :=xmalloc_array (halfword, hyph_size);
+ hyph_link :=xmalloc_array (hyph_pointer, hyph_size);
+@+Init
+ yzmem:=xmalloc_array (memory_word, mem_top - mem_bot + 1);
+ zmem := yzmem - mem_bot; {Some compilers require |mem_bot=0|}
+ eqtb_top := eqtb_size+hash_extra;
+ if hash_extra=0 then hash_top:=undefined_control_sequence else
+ hash_top:=eqtb_top;
+ yhash:=xmalloc_array (two_halves,1+hash_top-hash_offset);
+ hash:=yhash - hash_offset; {Some compilers require |hash_offset=0|}
+ next(hash_base):=0; text(hash_base):=0;
+ for hash_used:=hash_base+1 to hash_top do hash[hash_used]:=hash[hash_base];
+ zeqtb:=xmalloc_array (memory_word, eqtb_top);
+ eqtb:=zeqtb;
+
+ str_start:=xmalloc_array (pool_pointer, max_strings);
+ str_pool:=xmalloc_array (packed_ASCII_code, pool_size);
+ font_info:=xmalloc_array (fmemory_word, font_mem_size);
+@+Tini
+@z
+
+@x [51.1332] l.24215 - INI = VIR, so pool init needs runtime test
+@!init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+@y
+@!Init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+Tini@/
+@z
+
+@x [51.1332] l.24225 - main
+end_of_TEX: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+@y
+close_files_and_terminate;
+final_end: do_final_end;
+end {|main_body|};
+@z
+
+@x [51.1333] l.24254 - Print new line before termination; switch to editor if necessary.
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+@y
+ print_file_name(0, log_name, 0); print_char(".");
+ end;
+ end;
+print_ln;
+if (edit_name_start<>0) and (interaction>batch_mode) then
+ call_edit(str_pool,edit_name_start,edit_name_length,edit_line);
+@z
+
+@x [51.1334] l.24275 - hash_extra
+ wlog_ln(' ',cs_count:1,' multiletter control sequences out of ',
+ hash_size:1);@/
+@y 24276
+ wlog_ln(' ',cs_count:1,' multiletter control sequences out of ',
+ hash_size:1, '+', hash_extra:1);@/
+@z
+
+@x [51.1335] l.24335 - Only do dump if ini.
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+@y
+ begin @!Init for c:=top_mark_code to split_bot_mark_code do
+@z
+
+@x [51.1335] l.24337 - Only do dump if ini.
+ store_fmt_file; return;@+tini@/
+@y
+ store_fmt_file; return;@+Tini@/
+@z
+
+@x [51.1337] l.24361 - Handle %&format in all cases.
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+if (format_ident=0)or(buffer[loc]="&")or dump_line then
+@z
+
+@x [51.1337] l.24366 - Dynamic arrays size.
+ w_close(fmt_file);
+@y
+ w_close(fmt_file);
+ eqtb:=zeqtb;
+@z
+
+%% [51] m.1337 l.24371 - MLTeX: add. MLTeX banner after loading fmt file
+%% (MLTeX change: only "if mltex_enabled_p then ....;")
+@x [51.1337] l.24371 - Allocate hyphenation tries, do char translation, MLTeX
+fix_date_and_time;@/
+@y
+if mltex_enabled_p then
+ begin wterm_ln('MLTeX v2.2 enabled');
+ end;
+if enctex_enabled_p then
+ begin wterm(encTeX_banner); wterm_ln(', reencoding enabled.');
+ if translate_filename then begin
+ wterm_ln(' (\xordcode, \xchrcode, \xprncode overridden by TCX)');
+ end;
+ end;
+fix_date_and_time;@/
+
+@!init
+if trie_not_ready then begin {initex without format loaded}
+ trie_trl:=xmalloc_array (trie_pointer, trie_size);
+ trie_tro:=xmalloc_array (trie_pointer, trie_size);
+ trie_trc:=xmalloc_array (quarterword, trie_size);
+
+ trie_c:=xmalloc_array (packed_ASCII_code, trie_size);
+ trie_o:=xmalloc_array (trie_opcode, trie_size);
+ trie_l:=xmalloc_array (trie_pointer, trie_size);
+ trie_r:=xmalloc_array (trie_pointer, trie_size);
+ trie_hash:=xmalloc_array (trie_pointer, trie_size);
+ trie_taken:=xmalloc_array (boolean, trie_size);
+
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+
+ {Allocate and initialize font arrays}
+ font_check:=xmalloc_array(four_quarters, font_max);
+ font_size:=xmalloc_array(scaled, font_max);
+ font_dsize:=xmalloc_array(scaled, font_max);
+ font_params:=xmalloc_array(font_index, font_max);
+ font_name:=xmalloc_array(str_number, font_max);
+ font_area:=xmalloc_array(str_number, font_max);
+ font_bc:=xmalloc_array(eight_bits, font_max);
+ font_ec:=xmalloc_array(eight_bits, font_max);
+ font_glue:=xmalloc_array(halfword, font_max);
+ hyphen_char:=xmalloc_array(integer, font_max);
+ skew_char:=xmalloc_array(integer, font_max);
+ bchar_label:=xmalloc_array(font_index, font_max);
+ font_bchar:=xmalloc_array(nine_bits, font_max);
+ font_false_bchar:=xmalloc_array(nine_bits, font_max);
+ char_base:=xmalloc_array(integer, font_max);
+ width_base:=xmalloc_array(integer, font_max);
+ height_base:=xmalloc_array(integer, font_max);
+ depth_base:=xmalloc_array(integer, font_max);
+ italic_base:=xmalloc_array(integer, font_max);
+ lig_kern_base:=xmalloc_array(integer, font_max);
+ kern_base:=xmalloc_array(integer, font_max);
+ exten_base:=xmalloc_array(integer, font_max);
+ param_base:=xmalloc_array(integer, font_max);
+
+ font_ptr:=null_font; fmem_ptr:=7;
+ font_name[null_font]:="nullfont"; font_area[null_font]:="";
+ hyphen_char[null_font]:="-"; skew_char[null_font]:=-1;
+ bchar_label[null_font]:=non_address;
+ font_bchar[null_font]:=non_char; font_false_bchar[null_font]:=non_char;
+ font_bc[null_font]:=1; font_ec[null_font]:=0;
+ font_size[null_font]:=0; font_dsize[null_font]:=0;
+ char_base[null_font]:=0; width_base[null_font]:=0;
+ height_base[null_font]:=0; depth_base[null_font]:=0;
+ italic_base[null_font]:=0; lig_kern_base[null_font]:=0;
+ kern_base[null_font]:=0; exten_base[null_font]:=0;
+ font_glue[null_font]:=null; font_params[null_font]:=7;
+ param_base[null_font]:=-1;
+ for font_k:=0 to 6 do font_info[font_k].sc:=0;
+ end;
+ tini@/
+
+ font_used:=xmalloc_array (boolean, font_max);
+ for font_k:=font_base to font_max do font_used[font_k]:=false;
+@z
+
+% [52.1338] Core-dump in debugging mode on 0 input. Under Unix, it's
+% not possible to portably switch into the debugger while a program is
+% running. The best approximation is to do a core dump, then run the
+% debugger on it later.
+@x [52.1338] l.24411 - Core-dump in debugging mode on 0 input.
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+@y
+ dump_core {do something to cause a core dump}
+@z
+
+@x [52.1339] l.24429 - debug - print tfm info
+5: print_word(font_info[n]);
+@y 24397
+5: begin print_scaled(font_info[n].sc); print_char(" ");@/
+ print_int(font_info[n].qqqq.b0); print_char(":");@/
+ print_int(font_info[n].qqqq.b1); print_char(":");@/
+ print_int(font_info[n].qqqq.b2); print_char(":");@/
+ print_int(font_info[n].qqqq.b3);
+ end;
+@z
+
+@x [53.1341] - encTeX: keep track of mubyte value for \write
+@d write_stream(#) == info(#+1) {stream number (0 to 17)}
+@y
+@d write_stream(#) == type(#+1) {stream number (0 to 17)}
+@d mubyte_zero == 64
+@d write_mubyte(#) == subtype(#+1) {mubyte value + |mubyte_zero|}
+@z
+
+@x [53.1344] l.24544 - source specials
+primitive("special",extension,special_node);@/
+@y
+primitive("special",extension,special_node);@/
+text(frozen_special):="special"; eqtb[frozen_special]:=eqtb[cur_val];@/
+@z
+
+% [53.1350] (new_write_whatsit) Allow 18 as a \write stream. We never
+% refer to an actual file, though, so we don't need to change the
+% write_file or write_open arrays. We provide for disabling this at
+% runtime, for paranoids.
+@x [53.1350] l.24609 - system: Allow 18 as a \write stream.
+ else if cur_val>15 then cur_val:=16;
+@y
+ else if (cur_val>15) and (cur_val <> 18) then cur_val:=16;
+@z
+
+@x [53.1350] - encTeX: \write stores mubyte_out value
+write_stream(tail):=cur_val;
+@y
+write_stream(tail):=cur_val;
+if mubyte_out + mubyte_zero < 0 then write_mubyte(tail) := 0
+else if mubyte_out + mubyte_zero >= 2*mubyte_zero then
+ write_mubyte(tail) := 2*mubyte_zero - 1
+ else write_mubyte(tail) := mubyte_out + mubyte_zero;
+@z
+
+@x [53.1353] - encTeX: \special stores specialout and mubyteout values
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+@y
+begin new_whatsit(special_node,write_node_size);
+if spec_out + mubyte_zero < 0 then write_stream(tail) := 0
+else if spec_out + mubyte_zero >= 2*mubyte_zero then
+ write_stream(tail) := 2*mubyte_zero - 1
+ else write_stream(tail) := spec_out + mubyte_zero;
+if mubyte_out + mubyte_zero < 0 then write_mubyte(tail) := 0
+else if mubyte_out + mubyte_zero >= 2*mubyte_zero then
+ write_mubyte(tail) := 2*mubyte_zero - 1
+ else write_mubyte(tail) := mubyte_out + mubyte_zero;
+if (spec_out = 2) or (spec_out = 3) then
+ if (mubyte_out > 2) or (mubyte_out = -1) or (mubyte_out = -2) then
+ write_noexpanding := true;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+write_noexpanding := false;
+@z
+
+@x [53.1355] - encTeX: \write prints \mubyteout value
+else print_char("-");
+@y
+else print_char("-");
+if (s = "write") and (write_mubyte (p) <> mubyte_zero) then
+begin
+ print_char ("<"); print_int (write_mubyte(p)-mubyte_zero); print_char (">");
+end;
+@z
+
+@x [53.1356] - encTeX: \special prints \specialout and \mubyteout values
+special_node:begin print_esc("special");
+@y
+special_node:begin print_esc("special");
+if write_stream(p) <> mubyte_zero then
+begin
+ print_char ("<"); print_int (write_stream(p)-mubyte_zero);
+ if (write_stream(p)-mubyte_zero = 2) or
+ (write_stream(p)-mubyte_zero = 3) then
+ begin
+ print_char (":"); print_int (write_mubyte(p)-mubyte_zero);
+ end;
+ print_char (">");
+end;
+@z
+
+@x [53.1368] - encTeX: conversions in \special
+old_setting:=selector; selector:=new_string;
+@y
+old_setting:=selector; selector:=new_string;
+spec_sout := spec_out; spec_out := write_stream(p) - mubyte_zero;
+mubyte_sout := mubyte_out; mubyte_out := write_mubyte(p) - mubyte_zero;
+active_noconvert := true;
+mubyte_slog := mubyte_log;
+mubyte_log := 0;
+if (mubyte_out > 0) or (mubyte_out = -1) then mubyte_log := 1;
+if (spec_out = 2) or (spec_out = 3) then
+begin
+ if (mubyte_out > 0) or (mubyte_out = -1) then
+ begin
+ special_printing := true; mubyte_log := 1;
+ end;
+ if mubyte_out > 1 then cs_converting := true;
+end;
+@z
+
+@x [53.1368] - encTeX: conversions in \special
+for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
+@y
+if (spec_out = 1) or (spec_out = 3) then
+ for k:=str_start[str_ptr] to pool_ptr-1 do
+ str_pool[k] := si(xchr[so(str_pool[k])]);
+for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
+spec_out := spec_sout; mubyte_out := mubyte_sout; mubyte_log := mubyte_slog;
+special_printing := false; cs_converting := false;
+active_noconvert := false;
+@z
+
+@x [53.1370] l.24770 - \write18{foo} / encTeX
+begin @<Expand macros in the token list
+@y
+@!d:integer; {number of characters in incomplete current string}
+@!clobbered:boolean; {system string is ok?}
+begin
+mubyte_sout := mubyte_out; mubyte_out := write_mubyte(p) - mubyte_zero;
+if (mubyte_out > 2) or (mubyte_out = -1) or (mubyte_out = -2) then
+ write_noexpanding := true;
+@<Expand macros in the token list
+@z
+
+@x [53.1370] l.24773 - system: (write_out) \write18{foo} => system(foo).
+if write_open[j] then selector:=j
+@y
+if j=18 then selector := new_string
+else if write_open[j] then selector:=j
+@z
+
+@x [53.1370] - encTeX: conversion in parameter of \write
+token_show(def_ref); print_ln;
+@y
+active_noconvert := true;
+if mubyte_out > 1 then cs_converting := true;
+mubyte_slog := mubyte_log;
+if (mubyte_out > 0) or (mubyte_out = -1) then mubyte_log := 1
+else mubyte_log := 0;
+token_show(def_ref); print_ln;
+cs_converting := false; write_noexpanding := false;
+active_noconvert := false;
+mubyte_out := mubyte_sout; mubyte_log := mubyte_slog;
+@z
+
+% Then call system(3) on that string.
+@x [53.1370] l.24779 - system: (write_out) \write18{foo} => system(foo).
+flush_list(def_ref); selector:=old_setting;
+@y
+flush_list(def_ref);
+if j=18 then
+ begin if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ {If the log file isn't open yet, we can only send output to the terminal.
+ Calling |open_log_file| from here seems to result in bad data in the log.}
+ if not log_opened then selector:=term_only;
+ print_nl("system(");
+ for d:=0 to cur_length-1 do
+ begin {|print| gives up if passed |str_ptr|, so do it by hand.}
+ print(so(str_pool[str_start[str_ptr]+d])); {N.B.: not |print_char|}
+ end;
+ print(")...");
+ if shell_enabled_p then
+ begin str_room(1); append_char(0); {Append a null byte to the expansion.}
+ clobbered:=false;
+ for d:=0 to cur_length-1 do {Convert to external character set.}
+ begin str_pool[str_start[str_ptr]+d]:=xchr[str_pool[str_start[str_ptr]+d]];
+ if (str_pool[str_start[str_ptr]+d]=null_code)
+ and (d<cur_length-1) then clobbered:=true;
+ {minimal checking: NUL not allowed in argument string of |system|()}
+ end;
+ if clobbered then print("clobbered")
+ else begin {We have the string; run system(3). We don't have anything
+ reasonable to do with the return status, unfortunately discard it.}
+ system(stringcast(address_of(str_pool[str_start[str_ptr]])));
+ print("executed");
+ end;
+ end
+ else begin print("disabled");
+ end;
+ print_char("."); print_nl(""); print_ln;
+ pool_ptr:=str_start[str_ptr]; {erase the string}
+end;
+selector:=old_setting;
+@z
+
+@x [53.1373] Need new local.
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+@y
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+ @!old_setting:0..max_selector;
+@z
+
+@x [53.1374] Disallow certain \openout filenames, and log results.
+ while not a_open_out(write_file[j]) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+@y
+ while not open_out_name_ok(stringcast(name_of_file+1))
+ or not a_open_out(write_file[j]) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+ {If on first line of input, log file is not ready yet, so don't log.}
+ if log_opened then begin
+ old_setting:=selector;
+ if (tracing_online<=0) then
+ selector:=log_only {Show what we're doing in the log file.}
+ else selector:=term_and_log; {Show what we're doing.}
+ print_nl("\openout");
+ print_int(j);
+ print(" = `");
+ print_file_name(cur_name,cur_area,cur_ext);
+ print("'."); print_nl(""); print_ln;
+ selector:=old_setting;
+ end;
+@z
+
+@x [54.1376] l.24903 - Add editor-switch variables to globals.
+@* \[54] System-dependent changes.
+@y
+@* \[54/web2c] System-dependent changes for Web2c.
+Here are extra variables for Web2c. (This numbering of the
+system-dependent section allows easy integration of Web2c and e-\TeX, etc.)
+@^<system dependencies@>
+
+@<Glob...@>=
+@!edit_name_start: pool_pointer; {where the filename to switch to starts}
+@!edit_name_length,@!edit_line: integer; {what line to start editing at}
+@!ipc_on: c_int_type; {level of IPC action, 0 for none [default]}
+@!stop_at_space: boolean; {whether |more_name| returns false for space}
+
+@ The |edit_name_start| will be set to point into |str_pool| somewhere after
+its beginning if \TeX\ is supposed to switch to an editor on exit.
+
+@<Set init...@>=
+edit_name_start:=0;
+stop_at_space:=true;
+
+@ These are used when we regenerate the representation of the first 256
+strings.
+
+@<Global...@> =
+@!save_str_ptr: str_number;
+@!save_pool_ptr: pool_pointer;
+@!shell_enabled_p: c_int_type;
+@!output_comment: ^char;
+@!k,l: 0..255; {used by `Make the first 256 strings', etc.}
+
+@ When debugging a macro package, it can be useful to see the exact
+control sequence names in the format file. For example, if ten new
+csnames appear, it's nice to know what they are, to help pinpoint where
+they came from. (This isn't a truly ``basic'' printing procedure, but
+that's a convenient module in which to put it.)
+
+@<Basic printing procedures@> =
+procedure print_csnames (hstart:integer; hfinish:integer);
+var c,h,where:integer;
+begin
+ write_ln(stderr, 'fmtdebug:csnames from ', hstart, ' to ', hfinish, ':');
+ for h := hstart to hfinish do begin
+ if text(h) > 0 then begin {if have anything at this position}
+ for c := str_start[text(h)] to str_start[text(h) + 1] - 1
+ do begin
+ put_byte(str_pool[c], stderr); {print the characters}
+ end;
+ write_ln(stderr, '|');
+ end;
+ end;
+end;
+
+@ Are we printing extra info as we read the format file?
+
+@<Glob...@> =
+@!debug_format_file: boolean;
+
+
+@ A helper for printing file:line:error style messages. Look for a
+filename in |full_source_filename_stack|, and if we fail to find
+one fall back on the non-file:line:error style.
+
+@<Basic print...@>=
+procedure print_file_line;
+var level: 0..max_in_open;
+begin
+ level:=in_open;
+ while (level>0) and (full_source_filename_stack[level]=0) do
+ decr(level);
+ if level=0 then
+ print_nl("! ")
+ else begin
+ print_nl (""); print (full_source_filename_stack[level]); print (":");
+ if level=in_open then print_int (line)
+ else print_int (line_stack[index+1-(in_open-level)]);
+ print (": ");
+ end;
+end;
+
+@ To be able to determine whether \.{\\write18} is enabled from within
+\TeX\ we also implement \.{\\eof18}. We sort of cheat by having an
+additional route |scan_four_bit_int_or_18| which is the same as
+|scan_four_bit_int| except it also accepts the value 18.
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_four_bit_int_or_18;
+begin scan_int;
+if (cur_val<0)or((cur_val>15)and(cur_val<>18)) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ Dumping the |xord|, |xchr|, and |xprn| arrays. We dump these always
+in the format, so a TCX file loaded during format creation can set a
+default for users of the format.
+
+@<Dump |xord|, |xchr|, and |xprn|@>=
+dump_things(xord[0], 256);
+dump_things(xchr[0], 256);
+dump_things(xprn[0], 256);
+
+@ Undumping the |xord|, |xchr|, and |xprn| arrays. This code is more
+complicated, because we want to ensure that a TCX file specified on
+the command line will override whatever is in the format. Since the
+tcx file has already been loaded, that implies throwing away the data
+in the format. Also, if no |translate_filename| is given, but
+|eight_bit_p| is set we have to make all characters printable.
+
+@<Undump |xord|, |xchr|, and |xprn|@>=
+if translate_filename then begin
+ for k:=0 to 255 do undump_things(dummy_xord, 1);
+ for k:=0 to 255 do undump_things(dummy_xchr, 1);
+ for k:=0 to 255 do undump_things(dummy_xprn, 1);
+ end
+else begin
+ undump_things(xord[0], 256);
+ undump_things(xchr[0], 256);
+ undump_things(xprn[0], 256);
+ if eight_bit_p then
+ for k:=0 to 255 do
+ xprn[k]:=1;
+end;
+
+
+@* \[54/web2c-string] The string recycling routines. \TeX{} uses 2
+upto 4 {\it new\/} strings when scanning a filename in an \.{\\input},
+\.{\\openin}, or \.{\\openout} operation. These strings are normally
+lost because the reference to them are not saved after finishing the
+operation. |search_string| searches through the string pool for the
+given string and returns either 0 or the found string number.
+
+@<Declare additional routines for string recycling@>=
+function search_string(@!search:str_number):str_number;
+label found;
+var result: str_number;
+@!s: str_number; {running index}
+@!len: integer; {length of searched string}
+begin result:=0; len:=length(search);
+if len=0 then {trivial case}
+ begin result:=""; goto found;
+ end
+else begin s:=search-1; {start search with newest string below |s|; |search>1|!}
+ while s>255 do {first 256 strings depend on implementation!!}
+ begin if length(s)=len then
+ if str_eq_str(s,search) then
+ begin result:=s; goto found;
+ end;
+ decr(s);
+ end;
+ end;
+found:search_string:=result;
+end;
+
+@ The following routine is a variant of |make_string|. It searches
+the whole string pool for a string equal to the string currently built
+and returns a found string. Otherwise a new string is created and
+returned. Be cautious, you can not apply |flush_string| to a replaced
+string!
+
+@<Declare additional routines for string recycling@>=
+function slow_make_string : str_number;
+label exit;
+var s: str_number; {result of |search_string|}
+@!t: str_number; {new string}
+begin t:=make_string; s:=search_string(t);
+if s>0 then
+ begin flush_string; slow_make_string:=s; return;
+ end;
+slow_make_string:=t;
+exit:end;
+
+
+@* \[54/ML\TeX] System-dependent changes for ML\TeX.
+
+The boolean variable |mltex_p| is set by web2c according to the given
+command line option (or an entry in the configuration file) before any
+\TeX{} function is called.
+
+@<Global...@> =
+@!mltex_p: boolean;
+
+@ The boolean variable |mltex_enabled_p| is used to enable ML\TeX's
+character substitution. It is initialised to |false|. When loading
+a \.{FMT} it is set to the value of the boolean |mltex_p| saved in
+the \.{FMT} file. Additionally it is set to the value of |mltex_p|
+in Ini\TeX.
+
+@<Glob...@>=
+@!mltex_enabled_p:boolean; {enable character substitution}
+
+
+@ @<Set init...@>=
+mltex_enabled_p:=false;
+
+
+@ The function |effective_char| computes the effective character with
+respect to font information. The effective character is either the
+base character part of a character substitution definition, if the
+character does not exist in the font or the character itself.
+
+Inside |effective_char| we can not use |char_info| because the macro
+|char_info| uses |effective_char| calling this function a second time
+with the same arguments.
+
+If neither the character |c| exists in font |f| nor a character
+substitution for |c| was defined, you can not use the function value
+as a character offset in |char_info| because it will access an
+undefined or invalid |font_info| entry! Therefore inside |char_info|
+and in other places, |effective_char|'s boolean parameter |err_p| is
+set to |true| to issue a warning and return the incorrect
+replacement, but always existing character |font_bc[f]|.
+@^inner loop@>
+
+@<Declare additional functions for ML\TeX@>=
+function effective_char(@!err_p:boolean;
+ @!f:internal_font_number;@!c:quarterword):integer;
+label found;
+var base_c: integer; {or |eightbits|: replacement base character}
+@!result: integer; {or |quarterword|}
+begin result:=c; {return |c| unless it does not exist in the font}
+if not mltex_enabled_p then goto found;
+if font_ec[f]>=qo(c) then if font_bc[f]<=qo(c) then
+ if char_exists(orig_char_info(f)(c)) then {N.B.: not |char_info|(f)(c)}
+ goto found;
+if qo(c)>=char_sub_def_min then if qo(c)<=char_sub_def_max then
+ if char_list_exists(qo(c)) then
+ begin base_c:=char_list_char(qo(c));
+ result:=qi(base_c); {return |base_c|}
+ if not err_p then goto found;
+ if font_ec[f]>=base_c then if font_bc[f]<=base_c then
+ if char_exists(orig_char_info(f)(qi(base_c))) then goto found;
+ end;
+if err_p then {print error and return existing character?}
+ begin begin_diagnostic;
+ print_nl("Missing character: There is no "); print("substitution for ");
+@.Missing character@>
+ print_ASCII(qo(c)); print(" in font ");
+ slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
+ result:=qi(font_bc[f]); {N.B.: not non-existing character |c|!}
+ end;
+found: effective_char:=result;
+end;
+
+
+@ The function |effective_char_info| is equivalent to |char_info|,
+except it will return |null_character| if neither the character |c|
+exists in font |f| nor is there a substitution definition for |c|.
+(For these cases |char_info| using |effective_char| will access an
+undefined or invalid |font_info| entry. See the documentation of
+|effective_char| for more information.)
+@^inner loop@>
+
+@<Declare additional functions for ML\TeX@>=
+function effective_char_info(@!f:internal_font_number;
+ @!c:quarterword):four_quarters;
+label exit;
+var ci:four_quarters; {character information bytes for |c|}
+@!base_c:integer; {or |eightbits|: replacement base character}
+begin if not mltex_enabled_p then
+ begin effective_char_info:=orig_char_info(f)(c); return;
+ end;
+if font_ec[f]>=qo(c) then if font_bc[f]<=qo(c) then
+ begin ci:=orig_char_info(f)(c); {N.B.: not |char_info|(f)(c)}
+ if char_exists(ci) then
+ begin effective_char_info:=ci; return;
+ end;
+ end;
+if qo(c)>=char_sub_def_min then if qo(c)<=char_sub_def_max then
+ if char_list_exists(qo(c)) then
+ begin {|effective_char_info:=char_info(f)(qi(char_list_char(qo(c))));|}
+ base_c:=char_list_char(qo(c));
+ if font_ec[f]>=base_c then if font_bc[f]<=base_c then
+ begin ci:=orig_char_info(f)(qi(base_c)); {N.B.: not |char_info|(f)(c)}
+ if char_exists(ci) then
+ begin effective_char_info:=ci; return;
+ end;
+ end;
+ end;
+effective_char_info:=null_character;
+exit:end;
+
+
+@ This code is called for a virtual character |c| in |hlist_out|
+during |ship_out|. It tries to built a character substitution
+construct for |c| generating appropriate \.{DVI} code using the
+character substitution definition for this character. If a valid
+character substitution exists \.{DVI} code is created as if
+|make_accent| was used. In all other cases the status of the
+substituion for this character has been changed between the creation
+of the character node in the hlist and the output of the page---the
+created \.{DVI} code will be correct but the visual result will be
+undefined.
+
+Former ML\TeX\ versions have replaced the character node by a
+sequence of character, box, and accent kern nodes splicing them into
+the original horizontal list. This version does not do this to avoid
+a)~a memory overflow at this processing stage, b)~additional code to
+add a pointer to the previous node needed for the replacement, and
+c)~to avoid wrong code resulting in anomalies because of the use
+within a \.{\\leaders} box.
+
+@<Output a substitution, |goto continue| if not possible@>=
+ begin
+ @<Get substitution information, check it, goto |found|
+ if all is ok, otherwise goto |continue|@>;
+found: @<Print character substition tracing log@>;
+ @<Rebuild character using substitution information@>;
+ end
+
+
+@ The global variables for the code to substitute a virtual character
+can be declared as local. Nonetheless we declare them as global to
+avoid stack overflows because |hlist_out| can be called recursivly.
+
+@<Glob...@>=
+@!accent_c,@!base_c,@!replace_c:integer;
+@!ia_c,@!ib_c:four_quarters; {accent and base character information}
+@!base_slant,@!accent_slant:real; {amount of slant}
+@!base_x_height:scaled; {accent is designed for characters of this height}
+@!base_width,@!base_height:scaled; {height and width for base character}
+@!accent_width,@!accent_height:scaled; {height and width for accent}
+@!delta:scaled; {amount of right shift}
+
+
+@ Get the character substitution information in |char_sub_code| for
+the character |c|. The current code checks that the substition
+exists and is valid and all substitution characters exist in the
+font, so we can {\it not\/} substitute a character used in a
+substitution. This simplifies the code because we have not to check
+for cycles in all character substitution definitions.
+
+@<Get substitution information, check it...@>=
+ if qo(c)>=char_sub_def_min then if qo(c)<=char_sub_def_max then
+ if char_list_exists(qo(c)) then
+ begin base_c:=char_list_char(qo(c));
+ accent_c:=char_list_accent(qo(c));
+ if (font_ec[f]>=base_c) then if (font_bc[f]<=base_c) then
+ if (font_ec[f]>=accent_c) then if (font_bc[f]<=accent_c) then
+ begin ia_c:=char_info(f)(qi(accent_c));
+ ib_c:=char_info(f)(qi(base_c));
+ if char_exists(ib_c) then
+ if char_exists(ia_c) then goto found;
+ end;
+ begin_diagnostic;
+ print_nl("Missing character: Incomplete substitution ");
+@.Missing character@>
+ print_ASCII(qo(c)); print(" = "); print_ASCII(accent_c);
+ print(" "); print_ASCII(base_c); print(" in font ");
+ slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
+ goto continue;
+ end;
+ begin_diagnostic;
+ print_nl("Missing character: There is no "); print("substitution for ");
+@.Missing character@>
+ print_ASCII(qo(c)); print(" in font ");
+ slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
+ goto continue
+
+
+@ For |tracinglostchars>99| the substitution is shown in the log file.
+
+@<Print character substition tracing log@>=
+ if tracing_lost_chars>99 then
+ begin begin_diagnostic;
+ print_nl("Using character substitution: ");
+ print_ASCII(qo(c)); print(" = ");
+ print_ASCII(accent_c); print(" "); print_ASCII(base_c);
+ print(" in font "); slow_print(font_name[f]); print_char(".");
+ end_diagnostic(false);
+ end
+
+
+@ This outputs the accent and the base character given in the
+substitution. It uses code virtually identical to the |make_accent|
+procedure, but without the node creation steps.
+
+Additionally if the accent character has to be shifted vertically it
+does {\it not\/} create the same code. The original routine in
+|make_accent| and former versions of ML\TeX{} creates a box node
+resulting in |push| and |pop| operations, whereas this code simply
+produces vertical positioning operations. This can influence the
+pixel rounding algorithm in some \.{DVI} drivers---and therefore will
+probably be changed in one of the next ML\TeX{} versions.
+
+@<Rebuild character using substitution information@>=
+ base_x_height:=x_height(f);
+ base_slant:=slant(f)/float_constant(65536);
+@^real division@>
+ accent_slant:=base_slant; {slant of accent character font}
+ base_width:=char_width(f)(ib_c);
+ base_height:=char_height(f)(height_depth(ib_c));
+ accent_width:=char_width(f)(ia_c);
+ accent_height:=char_height(f)(height_depth(ia_c));
+ @/{compute necessary horizontal shift (don't forget slant)}@/
+ delta:=round((base_width-accent_width)/float_constant(2)+
+ base_height*base_slant-base_x_height*accent_slant);
+@^real multiplication@>
+@^real addition@>
+ dvi_h:=cur_h; {update |dvi_h|, similar to the last statement in module 620}
+ @/{1. For centering/horizontal shifting insert a kern node.}@/
+ cur_h:=cur_h+delta; synch_h;
+ @/{2. Then insert the accent character possibly shifted up or down.}@/
+ if ((base_height<>base_x_height) and (accent_height>0)) then
+ begin {the accent must be shifted up or down}
+ cur_v:=base_line+(base_x_height-base_height); synch_v;
+ if accent_c>=128 then dvi_out(set1);
+ dvi_out(accent_c);@/
+ cur_v:=base_line;
+ end
+ else begin synch_v;
+ if accent_c>=128 then dvi_out(set1);
+ dvi_out(accent_c);@/
+ end;
+ cur_h:=cur_h+accent_width; dvi_h:=cur_h;
+ @/{3. For centering/horizontal shifting insert another kern node.}@/
+ cur_h:=cur_h+(-accent_width-delta);
+ @/{4. Output the base character.}@/
+ synch_h; synch_v;
+ if base_c>=128 then dvi_out(set1);
+ dvi_out(base_c);@/
+ cur_h:=cur_h+base_width;
+ dvi_h:=cur_h {update of |dvi_h| is unnecessary, will be set in module 620}
+
+@ Dumping ML\TeX-related material. This is just the flag in the
+format that tells us whether ML\TeX{} is enabled.
+
+@<Dump ML\TeX-specific data@>=
+dump_int(@"4D4C5458); {ML\TeX's magic constant: "MLTX"}
+if mltex_p then dump_int(1)
+else dump_int(0);
+
+@ Undump ML\TeX-related material, which is just a flag in the format
+that tells us whether ML\TeX{} is enabled.
+
+@<Undump ML\TeX-specific data@>=
+undump_int(x); {check magic constant of ML\TeX}
+if x<>@"4D4C5458 then goto bad_fmt;
+undump_int(x); {undump |mltex_p| flag into |mltex_enabled_p|}
+if x=1 then mltex_enabled_p:=true
+else if x<>0 then goto bad_fmt;
+
+
+@* \[54/enc\TeX] System-dependent changes for enc\TeX.
+
+@d encTeX_banner == ' encTeX v. Jun. 2004'
+
+@ The boolean variable |enctex_p| is set by web2c according to the given
+command line option (or an entry in the configuration file) before any
+\TeX{} function is called.
+
+@<Global...@> =
+@!enctex_p: boolean;
+
+
+@ The boolean variable |enctex_enabled_p| is used to enable enc\TeX's
+primitives. It is initialised to |false|. When loading a \.{FMT} it
+is set to the value of the boolean |enctex_p| saved in the \.{FMT} file.
+Additionally it is set to the value of |enctex_p| in Ini\TeX.
+
+@<Glob...@>=
+@!enctex_enabled_p:boolean; {enable encTeX}
+
+
+@ @<Set init...@>=
+enctex_enabled_p:=false;
+
+
+@ Auxiliary functions/procedures for enc\TeX{} (by Petr Olsak) follow.
+These functions implement the \.{\\mubyte} code to convert
+the multibytes in |buffer| to one byte or to one control
+sequence. These functions manipulate a mubyte tree: each node of
+this tree is token list with n+1 tokens (first token consist the byte
+from the byte sequence itself and the other tokens point to the
+branches). If you travel from root of the tree to a leaf then you
+find exactly one byte sequence which we have to convert to one byte or
+control sequence. There are two variants of the leaf: the ``definitive
+end'' or the ``middle leaf'' if a longer byte sequence exists and the mubyte
+tree continues under this leaf. First variant is implemented as one
+memory word where the link part includes the token to
+which we have to convert and type part includes the number 60 (normal
+conversion) or 1..52 (insert the control sequence).
+The second variant of ``middle leaf'' is implemented as two memory words:
+first one has a type advanced by 64 and link points to the second
+word where info part includes the token to which we have to convert
+and link points to the next token list with the branches of
+the subtree.
+
+The inverse: one byte to multi byte (for log printing and \.{\\write}
+printing) is implemented via a pool. Each multibyte sequence is stored
+in a pool as a string and |mubyte_write|[{\it printed char\/}] points
+to this string.
+
+@d new_mubyte_node ==
+ link (p) := get_avail; p := link (p); info (p) := get_avail; p := info (p)
+@d subinfo (#) == subtype (#)
+
+@<Basic printing...@>=
+{ read |buffer|[|i|] and convert multibyte. |i| should have been
+ of type 0..|buf_size|, but web2c doesn't like that construct in
+ argument lists. }
+function read_buffer(var i:integer):ASCII_code;
+var p: pointer;
+ last_found: integer;
+ last_type: integer;
+begin
+ mubyte_skip := 0; mubyte_token := 0;
+ read_buffer := buffer[i];
+ if mubyte_in = 0 then
+ begin
+ if mubyte_keep > 0 then mubyte_keep := 0;
+ return ;
+ end;
+ last_found := -2;
+ if (i = start) and (not mubyte_start) then
+ begin
+ mubyte_keep := 0;
+ if (end_line_char >= 0) and (end_line_char < 256) then
+ if mubyte_read [end_line_char] <> null then
+ begin
+ mubyte_start := true; mubyte_skip := -1;
+ p := mubyte_read [end_line_char];
+ goto continue;
+ end;
+ end;
+restart:
+ mubyte_start := false;
+ if (mubyte_read [buffer[i]] = null) or (mubyte_keep > 0) then
+ begin
+ if mubyte_keep > 0 then decr (mubyte_keep);
+ return ;
+ end;
+ p := mubyte_read [buffer[i]];
+continue:
+ if type (p) >= 64 then
+ begin
+ last_type := type (p) - 64;
+ p := link (p);
+ mubyte_token := info (p); last_found := mubyte_skip;
+ end else if type (p) > 0 then
+ begin
+ last_type := type (p);
+ mubyte_token := link (p);
+ goto found;
+ end;
+ incr (mubyte_skip);
+ if i + mubyte_skip > limit then
+ begin
+ mubyte_skip := 0;
+ if mubyte_start then goto restart;
+ return;
+ end;
+ repeat
+ p := link (p);
+ if subinfo (info(p)) = buffer [i+mubyte_skip] then
+ begin
+ p := info (p); goto continue;
+ end;
+ until link (p) = null;
+ mubyte_skip := 0;
+ if mubyte_start then goto restart;
+ if last_found = -2 then return; { no found }
+ mubyte_skip := last_found;
+found:
+ if mubyte_token < 256 then { multibyte to one byte }
+ begin
+ read_buffer := mubyte_token; mubyte_token := 0;
+ i := i + mubyte_skip;
+ if mubyte_start and (i >= start) then mubyte_start := false;
+ return;
+ end else begin { multibyte to control sequence }
+ read_buffer := 0;
+ if last_type = 60 then { normal conversion }
+ i := i + mubyte_skip
+ else begin { insert control sequence }
+ decr (i); mubyte_keep := last_type;
+ if i < start then mubyte_start := true;
+ if last_type = 52 then mubyte_keep := 10000;
+ if last_type = 51 then mubyte_keep := mubyte_skip + 1;
+ mubyte_skip := -1;
+ end;
+ if mubyte_start and (i >= start) then mubyte_start := false;
+ return;
+ end;
+exit: end;
+
+@ @<Declare additional routines for enc\TeX@>=
+procedure mubyte_update; { saves new string to mubyte tree }
+var j: pool_pointer;
+ p: pointer;
+ q: pointer;
+ in_mutree: integer;
+begin
+ j := str_start [str_ptr];
+ if mubyte_read [so(str_pool[j])] = null then
+ begin
+ in_mutree := 0;
+ p := get_avail;
+ mubyte_read [so(str_pool[j])] := p;
+ subinfo (p) := so(str_pool[j]); type (p) := 0;
+ end else begin
+ in_mutree := 1;
+ p := mubyte_read [so(str_pool[j])];
+ end;
+ incr (j);
+ while j < pool_ptr do
+ begin
+ if in_mutree = 0 then
+ begin
+ new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0;
+ end else { |in_mutree| = 1 }
+ if (type (p) > 0) and (type (p) < 64) then
+ begin
+ type (p) := type (p) + 64;
+ q := link (p); link (p) := get_avail; p := link (p);
+ info (p) := q;
+ new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0;
+ in_mutree := 0;
+ end else begin
+ if type (p) >= 64 then p := link (p);
+ repeat
+ p := link (p);
+ if subinfo (info(p)) = so(str_pool[j]) then
+ begin
+ p := info (p);
+ goto continue;
+ end;
+ until link (p) = null;
+ new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0;
+ in_mutree := 0;
+ end;
+continue:
+ incr (j);
+ end;
+ if in_mutree = 1 then
+ begin
+ if type (p) = 0 then
+ begin
+ type (p) := mubyte_prefix + 64;
+ q := link (p); link (p) := get_avail; p := link (p);
+ link (p) := q; info (p) := mubyte_stoken;
+ return;
+ end;
+ if type (p) >= 64 then
+ begin
+ type (p) := mubyte_prefix + 64;
+ p := link (p); info (p) := mubyte_stoken;
+ return;
+ end;
+ end;
+ type (p) := mubyte_prefix;
+ link (p) := mubyte_stoken;
+exit: end;
+@#
+procedure dispose_munode (p: pointer); { frees a mu subtree recursivelly }
+var q: pointer;
+begin
+ if (type (p) > 0) and (type (p) < 64) then free_avail (p)
+ else begin
+ if type (p) >= 64 then
+ begin
+ q := link (p); free_avail (p); p := q;
+ end;
+ q := link (p); free_avail (p); p := q;
+ while p <> null do
+ begin
+ dispose_munode (info (p));
+ q := link (p);
+ free_avail (p);
+ p := q;
+ end;
+ end;
+end;
+@#
+procedure dispose_mutableout (cs: pointer); { frees record from out table }
+var p, q, r: pointer;
+begin
+ p := mubyte_cswrite [cs mod 128];
+ r := null;
+ while p <> null do
+ if info (p) = cs then
+ begin
+ if r <> null then link (r) := link (link (p))
+ else mubyte_cswrite[cs mod 128] := link (link (p));
+ q := link (link(p));
+ free_avail (link(p)); free_avail (p);
+ p := q;
+ end else begin
+ r := link (p); p := link (r);
+ end;
+end;
+
+@ The |print_buffer| procedure prints one character from |buffer|[|i|].
+It also increases |i| to the next character in the buffer.
+
+@<Basic printing...@>=
+{ print one char from |buffer|[|i|]. |i| should have been of type
+ 0..|buf_size|, but web2c doesn't like that construct in argument lists. }
+procedure print_buffer(var i:integer);
+var c: ASCII_code;
+begin
+ if mubyte_in = 0 then print (buffer[i]) { normal TeX }
+ else if mubyte_log > 0 then print_char (buffer[i])
+ else begin
+ c := read_buffer (i);
+ if mubyte_token > 0 then print_cs (mubyte_token-cs_token_flag)
+ else print (c);
+ end;
+ incr (i);
+end;
+
+@ Additional material to dump for enc\TeX. This includes whether
+enc\TeX is enabled, and if it is we also have to dump the \.{\\mubyte}
+arrays.
+
+@<Dump enc\TeX-specific data@>=
+dump_int(@"45435458); {enc\TeX's magic constant: "ECTX"}
+if not enctex_p then dump_int(0)
+else begin
+ dump_int(1);
+ dump_things(mubyte_read[0], 256);
+ dump_things(mubyte_write[0], 256);
+ dump_things(mubyte_cswrite[0], 128);
+end;
+
+@ Undumping the additional material we dumped for enc\TeX. This includes
+conditionally undumping the \.{\\mubyte} arrays.
+
+@<Undump enc\TeX-specific data@>=
+undump_int(x); {check magic constant of enc\TeX}
+if x<>@"45435458 then goto bad_fmt;
+undump_int(x); {undump |enctex_p| flag into |enctex_enabled_p|}
+if x=0 then enctex_enabled_p:=false
+else if x<>1 then goto bad_fmt
+else begin
+ enctex_enabled_p:=true;
+ undump_things(mubyte_read[0], 256);
+ undump_things(mubyte_write[0], 256);
+ undump_things(mubyte_cswrite[0], 128);
+end;
+
+
+@* \[54] System-dependent changes.
+@z
+
+@x [54.1379] l.24916 - extra routines
+@* \[55] Index.
+@y
+
+@ @<Declare action procedures for use by |main_control|@>=
+
+procedure insert_src_special;
+var toklist, p, q : pointer;
+begin
+ if (source_filename_stack[in_open] > 0 and is_new_source (source_filename_stack[in_open]
+, line)) then begin
+ toklist := get_avail;
+ p := toklist;
+ info(p) := cs_token_flag+frozen_special;
+ link(p) := get_avail; p := link(p);
+ info(p) := left_brace_token+"{";
+ q := str_toks (make_src_special (source_filename_stack[in_open], line));
+ link(p) := link(temp_head);
+ p := q;
+ link(p) := get_avail; p := link(p);
+ info(p) := right_brace_token+"}";
+ ins_list (toklist);
+ remember_source_info (source_filename_stack[in_open], line);
+ end;
+end;
+
+procedure append_src_special;
+var p, q : pointer;
+begin
+ if (source_filename_stack[in_open] > 0 and is_new_source (source_filename_stack[in_open]
+, line)) then begin
+ new_whatsit (special_node, write_node_size);
+ write_stream(tail) := 0;
+ def_ref := get_avail;
+ token_ref_count(def_ref) := null;
+ q := str_toks (make_src_special (source_filename_stack[in_open], line));
+ link(def_ref) := link(temp_head);
+ write_tokens(tail) := def_ref;
+ remember_source_info (source_filename_stack[in_open], line);
+ end;
+end;
+
+@ This function used to be in pdftex, but is useful in tex too.
+
+@p function get_nullstr: str_number;
+begin
+ get_nullstr := "";
+end;
+
+@* \[55] Index.
+@z
diff --git a/Build/source/texk/web2c/tex.rc b/Build/source/texk/web2c/tex.rc
new file mode 100644
index 00000000000..6e135730d97
--- /dev/null
+++ b/Build/source/texk/web2c/tex.rc
@@ -0,0 +1,37 @@
+/* tex.rc: tex resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " TeX 3.14159"
+
+#define VER_INTERNALNAME_STR "tex"
+#define VER_ORIGINALFILENAME_STR "tex.exe"
+
+#define VER_FILEDESCRIPTION_STR "TeX DLL"
+
+#define VER_LEGALCOPYRIGHT_STR "Copyright (C) 1982 by D. E. Knuth"
+#define VER_LEGALTRADEMARKS_STR "TeX is a trademark of the American Mathematical Society."
+
+#define VER_FILETYPE VFT_DLL
+
+#include <texlive.version>
+
+/* tex.rc ends here */
diff --git a/Build/source/texk/web2c/tex.web b/Build/source/texk/web2c/tex.web
new file mode 100644
index 00000000000..0eaf4dbd078
--- /dev/null
+++ b/Build/source/texk/web2c/tex.web
@@ -0,0 +1,24970 @@
+% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
+% Copying of this file is authorized only if (1) you are D. E. Knuth, or if
+% (2) you make absolutely no changes to your copy. (The WEB system provides
+% for alterations via an auxiliary file; the master file should stay intact.)
+% See Appendix H of the WEB manual for hints on how to install this program.
+% And see Appendix A of the TRIP manual for details about how to validate it.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+
+% Version 0 was released in September 1982 after it passed a variety of tests.
+% Version 1 was released in November 1983 after thorough testing.
+% Version 1.1 fixed ``disappearing font identifiers'' et alia (July 1984).
+% Version 1.2 allowed `0' in response to an error, et alia (October 1984).
+% Version 1.3 made memory allocation more flexible and local (November 1984).
+% Version 1.4 fixed accents right after line breaks, et alia (April 1985).
+% Version 1.5 fixed \the\toks after other expansion in \edefs (August 1985).
+% Version 2.0 (almost identical to 1.5) corresponds to "Volume B" (April 1986).
+% Version 2.1 corrected anomalies in discretionary breaks (January 1987).
+% Version 2.2 corrected "(Please type...)" with null \endlinechar (April 1987).
+% Version 2.3 avoided incomplete page in premature termination (August 1987).
+% Version 2.4 fixed \noaligned rules in indented displays (August 1987).
+% Version 2.5 saved cur_order when expanding tokens (September 1987).
+% Version 2.6 added 10sp slop when shipping leaders (November 1987).
+% Version 2.7 improved rounding of negative-width characters (November 1987).
+% Version 2.8 fixed weird bug if no \patterns are used (December 1987).
+% Version 2.9 made \csname\endcsname's "relax" local (December 1987).
+% Version 2.91 fixed \outer\def\a0{}\a\a bug (April 1988).
+% Version 2.92 fixed \patterns, also file names with complex macros (May 1988).
+% Version 2.93 fixed negative halving in allocator when mem_min<0 (June 1988).
+% Version 2.94 kept open_log_file from calling fatal_error (November 1988).
+% Version 2.95 solved that problem a better way (December 1988).
+% Version 2.96 corrected bug in "Infinite shrinkage" recovery (January 1989).
+% Version 2.97 corrected blunder in creating 2.95 (February 1989).
+% Version 2.98 omitted save_for_after at outer level (March 1989).
+% Version 2.99 caught $$\begingroup\halign..$$ (June 1989).
+% Version 2.991 caught .5\ifdim.6... (June 1989).
+% Version 2.992 introduced major changes for 8-bit extensions (September 1989).
+% Version 2.993 fixed a save_stack synchronization bug et alia (December 1989).
+% Version 3.0 fixed unusual displays; was more \output robust (March 1990).
+% Version 3.1 fixed nullfont, disabled \write{\the\prevgraf} (September 1990).
+% Version 3.14 fixed unprintable font names and corrected typos (March 1991).
+% Version 3.141 more of same; reconstituted ligatures better (March 1992).
+% Version 3.1415 preserved nonexplicit kerns, tidied up (February 1993).
+% Version 3.14159 allowed fontmemsize to change; bulletproofing (March 1995).
+% Version 3.141592 fixed \xleaders, glueset, weird alignments (December 2002).
+
+% A reward of $327.68 will be paid to the first finder of any remaining bug.
+
+% Although considerable effort has been expended to make the TeX program
+% correct and reliable, no warranty is implied; the author disclaims any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the author hopes that users enjoy it.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\hangg#1 {\hang\hbox{#1 }}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\def\ph{\hbox{Pascal-H}}
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+\outer\def\N#1. \[#2]#3.{\MN#1.\vfil\eject % begin starred section
+ \def\rhead{PART #2:\uppercase{#3}} % define running headline
+ \message{*\modno} % progress report
+ \edef\next{\write\cont{\Z{\?#2]#3}{\modno}{\the\pageno}}}\next
+ \ifon\startsection{\bf\ignorespaces#3.\quad}\ignorespaces}
+\let\?=\relax % we want to be able to \write a \?
+
+\def\title{\TeX82}
+\def\topofcontents{\hsize 5.5in
+ \vglue 0pt plus 1fil minus 1.5in
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+\pageno=3
+\def\glob{13} % this should be the section number of "<Global...>"
+\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
+
+@* \[1] Introduction.
+This is \TeX, a document compiler intended to produce typesetting of high
+quality.
+The \PASCAL\ program that follows is the definition of \TeX82, a standard
+@:PASCAL}{\PASCAL@>
+@!@:TeX82}{\TeX82@>
+version of \TeX\ that is designed to be highly portable so that identical output
+will be obtainable on a great variety of computers.
+
+The main purpose of the following program is to explain the algorithms of \TeX\
+as clearly as possible. As a result, the program will not necessarily be very
+efficient when a particular \PASCAL\ compiler has translated it into a
+particular machine language. However, the program has been written so that it
+can be tuned to run efficiently in a wide variety of operating environments
+by making comparatively few changes. Such flexibility is possible because
+the documentation that follows is written in the \.{WEB} language, which is
+at a higher level than \PASCAL; the preprocessing step that converts \.{WEB}
+to \PASCAL\ is able to introduce most of the necessary refinements.
+Semi-automatic translation to other languages is also feasible, because the
+program below does not make extensive use of features that are peculiar to
+\PASCAL.
+
+A large piece of software like \TeX\ has inherent complexity that cannot
+be reduced below a certain level of difficulty, although each individual
+part is fairly simple by itself. The \.{WEB} language is intended to make
+the algorithms as readable as possible, by reflecting the way the
+individual program pieces fit together and by providing the
+cross-references that connect different parts. Detailed comments about
+what is going on, and about why things were done in certain ways, have
+been liberally sprinkled throughout the program. These comments explain
+features of the implementation, but they rarely attempt to explain the
+\TeX\ language itself, since the reader is supposed to be familiar with
+{\sl The \TeX book}.
+@.WEB@>
+@:TeXbook}{\sl The \TeX book@>
+
+@ The present implementation has a long ancestry, beginning in the summer
+of~1977, when Michael~F. Plass and Frank~M. Liang designed and coded
+a prototype
+@^Plass, Michael Frederick@>
+@^Liang, Franklin Mark@>
+@^Knuth, Donald Ervin@>
+based on some specifications that the author had made in May of that year.
+This original proto\TeX\ included macro definitions and elementary
+manipulations on boxes and glue, but it did not have line-breaking,
+page-breaking, mathematical formulas, alignment routines, error recovery,
+or the present semantic nest; furthermore,
+it used character lists instead of token lists, so that a control sequence
+like \.{\\halign} was represented by a list of seven characters. A
+complete version of \TeX\ was designed and coded by the author in late
+1977 and early 1978; that program, like its prototype, was written in the
+{\mc SAIL} language, for which an excellent debugging system was
+available. Preliminary plans to convert the {\mc SAIL} code into a form
+somewhat like the present ``web'' were developed by Luis Trabb~Pardo and
+the author at the beginning of 1979, and a complete implementation was
+created by Ignacio~A. Zabala in 1979 and 1980. The \TeX82 program, which
+@^Zabala Salelles, Ignacio Andr\'es@>
+was written by the author during the latter part of 1981 and the early
+part of 1982, also incorporates ideas from the 1979 implementation of
+@^Guibas, Leonidas Ioannis@>
+@^Sedgewick, Robert@>
+@^Wyatt, Douglas Kirk@>
+\TeX\ in {\mc MESA} that was written by Leonidas Guibas, Robert Sedgewick,
+and Douglas Wyatt at the Xerox Palo Alto Research Center. Several hundred
+refinements were introduced into \TeX82 based on the experiences gained with
+the original implementations, so that essentially every part of the system
+has been substantially improved. After the appearance of ``Version 0'' in
+September 1982, this program benefited greatly from the comments of
+many other people, notably David~R. Fuchs and Howard~W. Trickey.
+A final revision in September 1989 extended the input character set to
+eight-bit codes and introduced the ability to hyphenate words from
+different languages, based on some ideas of Michael~J. Ferguson.
+@^Fuchs, David Raymond@>
+@^Trickey, Howard Wellington@>
+@^Ferguson, Michael John@>
+
+No doubt there still is plenty of room for improvement, but the author
+is firmly committed to keeping \TeX82 ``frozen'' from now on; stability
+and reliability are to be its main virtues.
+
+On the other hand, the \.{WEB} description can be extended without changing
+the core of \TeX82 itself, and the program has been designed so that such
+extensions are not extremely difficult to make.
+The |banner| string defined here should be changed whenever \TeX\
+undergoes any modifications, so that it will be clear which version of
+\TeX\ might be the guilty party when a problem arises.
+@^extensions to \TeX@>
+@^system dependencies@>
+
+If this program is changed, the resulting system should not be called
+`\TeX'; the official name `\TeX' by itself is reserved
+for software systems that are fully compatible with each other.
+A special test suite called the ``\.{TRIP} test'' is available for
+helping to determine whether a particular implementation deserves to be
+known as `\TeX' [cf.~Stanford Computer Science report CS1027,
+November 1984].
+
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+
+@ Different \PASCAL s have slightly different conventions, and the present
+@!@:PASCAL H}{\ph@>
+program expresses \TeX\ in terms of the \PASCAL\ that was
+available to the author in 1982. Constructions that apply to
+this particular compiler, which we shall call \ph, should help the
+reader see how to make an appropriate interface for other systems
+if necessary. (\ph\ is Charles Hedrick's modification of a compiler
+@^Hedrick, Charles Locke@>
+for the DECsystem-10 that was originally developed at the University of
+Hamburg; cf.\ {\sl SOFTWARE---Practice \AM\ Experience \bf6} (1976),
+29--42. The \TeX\ program below is intended to be adaptable, without
+extensive changes, to most other versions of \PASCAL, so it does not fully
+use the admirable features of \ph. Indeed, a conscious effort has been
+made here to avoid using several idiosyncratic features of standard
+\PASCAL\ itself, so that most of the code can be translated mechanically
+into other high-level languages. For example, the `\&{with}' and `\\{new}'
+features are not used, nor are pointer types, set types, or enumerated
+scalar types; there are no `\&{var}' parameters, except in the case of files;
+there are no tag fields on variant records; there are no assignments
+|real:=integer|; no procedures are declared local to other procedures.)
+
+The portions of this program that involve system-dependent code, where
+changes might be necessary because of differences between \PASCAL\ compilers
+and/or differences between
+operating systems, can be identified by looking at the sections whose
+numbers are listed under `system dependencies' in the index. Furthermore,
+the index entries for `dirty \PASCAL' list all places where the restrictions
+of \PASCAL\ have not been followed perfectly, for one reason or another.
+@!@^system dependencies@>
+@!@^dirty \PASCAL@>
+
+Incidentally, \PASCAL's standard |round| function can be problematical,
+because it disagrees with the IEEE floating-point standard.
+Many implementors have
+therefore chosen to substitute their own home-grown rounding procedure.
+
+@ The program begins with a normal \PASCAL\ program heading, whose
+components will be filled in later, using the conventions of \.{WEB}.
+@.WEB@>
+For example, the portion of the program called `\X\glob:Global
+variables\X' below will be replaced by a sequence of variable declarations
+that starts in $\section\glob$ of this documentation. In this way, we are able
+to define each individual global variable when we are prepared to
+understand what it means; we do not have to define all of the globals at
+once. Cross references in $\section\glob$, where it says ``See also
+sections \gglob, \dots,'' also make it possible to look at the set of
+all global variables, if desired. Similar remarks apply to the other
+portions of the program heading.
+
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \TeX\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+
+@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:}
+@f mtype==type {`\&{mtype}' will be equivalent to `\&{type}'}
+@f type==true {but `|type|' will not be treated as a reserved word}
+
+@p @t\4@>@<Compiler directives@>@/
+program TEX; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+mtype @<Types in the outer block@>@/
+var @<Global variables@>@/
+@#
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin @<Initialize whatever \TeX\ might access@>@;
+ end;@#
+@t\4@>@<Basic printing procedures@>@/
+@t\4@>@<Error handling procedures@>@/
+
+@ The overall \TeX\ program begins with the heading just shown, after which
+comes a bunch of procedure declarations and function declarations.
+Finally we will get to the main program, which begins with the
+comment `|start_here|'. If you want to skip down to the
+main program now, you can look up `|start_here|' in the index.
+But the author suggests that the best way to understand this program
+is to follow pretty much the order of \TeX's components as they appear in the
+\.{WEB} description you are now reading, since the present ordering is
+intended to combine the advantages of the ``bottom up'' and ``top down''
+approaches to the problem of understanding a somewhat complicated system.
+
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d end_of_TEX=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
+ {key control points}
+
+@ Some of the code below is intended to be used only when diagnosing the
+strange behavior that sometimes occurs when \TeX\ is being installed or
+when system wizards are fooling around with \TeX\ without quite knowing
+what they are doing. Such code will not normally be compiled; it is
+delimited by the codewords `$|debug|\ldots|gubed|$', with apologies
+to people who wish to preserve the purity of English.
+
+Similarly, there is some conditional code delimited by
+`$|stat|\ldots|tats|$' that is intended for use when statistics are to be
+kept about \TeX's memory usage. The |stat| $\ldots$ |tats| code also
+implements diagnostic information for \.{\\tracingparagraphs} and
+\.{\\tracingpages}.
+@^debugging@>
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+ usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+ usage statistics}
+@f stat==begin
+@f tats==end
+
+@ This program has two important variations: (1) There is a long and slow
+version called \.{INITEX}, which does the extra calculations needed to
+@.INITEX@>
+initialize \TeX's internal tables; and (2)~there is a shorter and faster
+production version, which cuts the initialization to a bare minimum.
+Parts of the program that are needed in (1) but not in (2) are delimited by
+the codewords `$|init|\ldots|tini|$'.
+
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@f init==begin
+@f tini==end
+
+@<Initialize whatever...@>=
+@<Set initial values of key variables@>@/
+@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
+
+@ If the first character of a \PASCAL\ comment is a dollar sign,
+\ph\ treats the comment as a list of ``compiler directives'' that will
+affect the translation of this program into machine language. The
+directives shown below specify full checking and inclusion of the \PASCAL\
+debugger when \TeX\ is being debugged, but they cause range checking and other
+redundant code to be eliminated when the production system is being generated.
+Arithmetic overflow will be detected in all cases.
+@^system dependencies@>
+@^Overflow in arithmetic@>
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ This \TeX\ implementation conforms to the rules of the {\sl Pascal User
+@:PASCAL}{\PASCAL@>
+@^system dependencies@>
+Manual} published by Jensen and Wirth in 1975, except where system-dependent
+@^Wirth, Niklaus@>
+@^Jensen, Kathleen@>
+code is necessary to make a useful system program, and except in another
+respect where such conformity would unnecessarily obscure the meaning
+and clutter up the code: We assume that |case| statements may include a
+default case that applies if no matching label is found. Thus, we shall use
+constructions like
+$$\vbox{\halign{\ignorespaces#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the \ph\
+compiler allows `|others|:' as a default label, and other \PASCAL s allow
+syntaxes like `\&{else}' or `\&{otherwise}' or `\\{otherwise}:', etc. The
+definitions of |othercases| and |endcases| should be changed to agree with
+local conventions. Note that no semicolon appears before |endcases| in
+this program, so the definition of |endcases| should include a semicolon
+if the compiler wants one. (Of course, if no default mechanism is
+available, the |case| statements of \TeX\ will have to be laboriously
+extended by listing all remaining cases. People who are stuck with such
+\PASCAL s have, in fact, done this, successfully but not happily!)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters can be changed at compile time to extend or
+reduce \TeX's capacity. They may have different values in \.{INITEX} and
+in production versions of \TeX.
+@.INITEX@>
+@^system dependencies@>
+
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+ error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TeXformats:TEX.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+
+@ Like the preceding parameters, the following quantities can be changed
+at compile time to extend or reduce \TeX's capacity. But if they are changed,
+it is necessary to rerun the initialization program \.{INITEX}
+@.INITEX@>
+to generate new tables for the production \TeX\ program.
+One can't simply make helter-skelter changes to the following constants,
+since certain rather complex initialization
+numbers are computed from them. They are defined here using
+\.{WEB} macros, instead of being put into \PASCAL's |const| list, in order to
+emphasize this distinction.
+
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@^system dependencies@>
+
+@ In case somebody has inadvertently made bad settings of the ``constants,''
+\TeX\ checks them using a global variable called |bad|.
+
+This is the first of many sections of \TeX\ where global variables are
+defined.
+
+@<Glob...@>=
+@!bad:integer; {is some ``constant'' wrong?}
+
+@ Later on we will say `\ignorespaces|if mem_max>=max_halfword then bad:=14|',
+or something similar. (We can't do that until |max_halfword| has been defined.)
+
+@<Check the ``constant'' values for consistency@>=
+bad:=0;
+if (half_error_line<30)or(half_error_line>error_line-15) then bad:=1;
+if max_print_line<60 then bad:=2;
+if dvi_buf_size mod 8<>0 then bad:=3;
+if mem_bot+1100>mem_top then bad:=4;
+if hash_prime>hash_size then bad:=5;
+if max_in_open>=128 then bad:=6;
+if mem_top<256+11 then bad:=7; {we will want |null_list>255|}
+
+@ Labels are given symbolic names by the following definitions, so that
+occasional |goto| statements will be meaningful. We insert the label
+`|exit|' just before the `\ignorespaces|end|\unskip' of a procedure in
+which we have used the `|return|' statement defined below; the label
+`|restart|' is occasionally used at the very beginning of a procedure; and
+the label `|reswitch|' is occasionally used just prior to a |case|
+statement in which some cases change the conditions and we wish to branch
+to the newly applicable case. Loops that are set up with the |loop|
+construction defined below are commonly exited by going to `|done|' or to
+`|found|' or to `|not_found|', and they are sometimes repeated by going to
+`|continue|'. If two or more parts of a subroutine start differently but
+end up the same, the shared code may be gathered together at
+`|common_ending|'.
+
+Incidentally, this program never declares a label that isn't actually used,
+because some fussy \PASCAL\ compilers will complain about redundant labels.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d done1=31 {like |done|, when there is more than one loop}
+@d done2=32 {for exiting the second loop in a long block}
+@d done3=33 {for exiting the third loop in a very long block}
+@d done4=34 {for exiting the fourth loop in an extremely long block}
+@d done5=35 {for exiting the fifth loop in an immense block}
+@d done6=36 {for exiting the sixth loop in a block}
+@d found=40 {go here when you've found it}
+@d found1=41 {like |found|, when there's more than one per routine}
+@d found2=42 {like |found|, when there's more than two per routine}
+@d not_found=45 {go here when you've found nothing}
+@d common_ending=50 {go here when you want to merge with another branch}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d negate(#) == #:=-# {change the sign of a variable}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@f loop == xclause
+ {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@d empty=0 {symbolic name for a null constant}
+
+@* \[2] The character set.
+In order to make \TeX\ readily portable to a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+code that includes standard ASCII, the ``American Standard Code for
+Information Interchange.'' This conversion is done immediately when each
+character is read in. Conversely, characters are converted from ASCII to
+the user's external representation just before they are output to a
+text file.
+
+Such an internal code is relevant to users of \TeX\ primarily because it
+governs the positions of characters in the fonts. For example, the
+character `\.A' has ASCII code $65=@'101$, and when \TeX\ typesets
+this letter it specifies character number 65 in the current font.
+If that font actually has `\.A' in a different position, \TeX\ doesn't
+know what the real position is; the program that does the actual printing from
+\TeX's device-independent files is responsible for converting from ASCII to
+a particular font encoding.
+@^ASCII code@>
+
+\TeX's internal code also defines the value of constants
+that begin with a reverse apostrophe; and it provides an index to the
+\.{\\catcode}, \.{\\mathcode}, \.{\\uccode}, \.{\\lccode}, and \.{\\delcode}
+tables.
+
+@ Characters of text that have been converted to \TeX's internal form
+are said to be of type |ASCII_code|, which is a subrange of the integers.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, especially in a program for typesetting;
+so the present specification of \TeX\ has been written under the assumption
+that the \PASCAL\ compiler and run-time system permit the use of text files
+with more than 64 distinguishable characters. More precisely, we assume that
+the character set contains at least the letters and symbols associated
+with ASCII codes @'40 through @'176; all of these characters are now
+available on most computer terminals.
+
+Since we are dealing with more characters than were present in the first
+\PASCAL\ compilers, we have to decide what to call the associated data
+type. Some \PASCAL s use the original name |char| for the
+characters in text files, even though there now are more than 64 such
+characters, while other \PASCAL s consider |char| to be a 64-element
+subrange of a larger data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters that are converted to and
+from |ASCII_code| when they are input and output. We shall also assume
+that |text_char| consists of the elements |chr(first_text_char)| through
+|chr(last_text_char)|, inclusive. The following definitions should be
+adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Local variables for init...@>=
+@!i:integer;
+
+@ The \TeX\ processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Glob...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ Since we are assuming that our \PASCAL\ system is able to read and
+write the visible characters of standard ASCII (although not
+necessarily using the ASCII codes to represent them), the following
+assignment statements initialize the standard part of the |xchr| array
+properly, without needing any system-dependent changes. On the other
+hand, it is possible to implement \TeX\ with less complete character
+sets, and in such cases it will be necessary to change something here.
+@^system dependencies@>
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+
+@ Some of the ASCII codes without visible characters have been given symbolic
+names in this program because they are used with a special meaning.
+
+@d null_code=@'0 {ASCII code that might disappear}
+@d carriage_return=@'15 {ASCII code used at end of line}
+@d invalid_code=@'177 {ASCII code that many systems prohibit in text files}
+
+@ The ASCII code is ``standard'' only to a certain extent, since many
+computer installations have found it advantageous to have ready access
+to more than 94 printing characters. Appendix~C of {\sl The \TeX book\/}
+gives a complete specification of the intended correspondence between
+characters and \TeX's internal representation.
+@:TeXbook}{\sl The \TeX book@>
+
+If \TeX\ is being used
+on a garden-variety \PASCAL\ for which only standard ASCII
+codes will appear in the input and output files, it doesn't really matter
+what codes are specified in |xchr[0..@'37]|, but the safest policy is to
+blank everything out by using the code shown below.
+
+However, other settings of |xchr| will make \TeX\ more friendly on
+computers that have an extended character set, so that users can type things
+like `\.^^Z' instead of `\.{\\ne}'. People with extended character sets can
+assign codes arbitrarily, giving an |xchr| equivalent to whatever
+characters the users of \TeX\ are allowed to have in their input files.
+It is best to make the codes correspond to the intended interpretations as
+shown in Appendix~C whenever possible; but this is not necessary. For
+example, in countries with an alphabet of more than 26 letters, it is
+usually best to map the additional letters into codes less than~@'40.
+To get the most ``permissive'' character set, change |' '| on the
+right of these assignment statements to |chr(i)|.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
+where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
+|j| or more; hence, standard ASCII code numbers will be used instead of
+codes below @'40 in case there is a coincidence.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
+for i:=@'200 to @'377 do xord[xchr[i]]:=i;
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+
+@* \[3] Input and output.
+The bane of portability is the fact that different operating systems treat
+input and output quite differently, perhaps because computer scientists
+have not given sufficient attention to this problem. People have felt somehow
+that input and output are not part of ``real'' programming. Well, it is true
+that some kinds of programming are more fun than others. With existing
+input/output conventions being so diverse and so messy, the only sources of
+joy in such parts of the code are the rare occasions when one can find a
+way to make the program a little less bad than it might have been. We have
+two choices, either to attack I/O now and get it over with, or to postpone
+I/O until near the end. Neither prospect is very attractive, so let's
+get it over with.
+
+The basic operations we need to do are (1)~inputting and outputting of
+text, to or from a file or the user's terminal; (2)~inputting and
+outputting of eight-bit bytes, to or from a file; (3)~instructing the
+operating system to initiate (``open'') or to terminate (``close'') input or
+output from a specified file; (4)~testing whether the end of an input
+file has been reached.
+
+\TeX\ needs to deal with two kinds of files.
+We shall use the term |alpha_file| for a file that contains textual data,
+and the term |byte_file| for a file that contains eight-bit binary information.
+These two types turn out to be the same on many computers, but
+sometimes there is a significant distinction, so we shall be careful to
+distinguish between them. Standard protocols for transferring
+such files from computer to computer, via high-speed networks, are
+now becoming available to more and more communities of users.
+
+The program actually makes use also of a third kind of file, called a
+|word_file|, when dumping and reloading base information for its own
+initialization. We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ Most of what we need to do with respect to input and output can be handled
+by the I/O facilities that are standard in \PASCAL, i.e., the routines
+called |get|, |put|, |eof|, and so on. But
+standard \PASCAL\ does not allow file variables to be associated with file
+names that are determined at run time, so it cannot be used to implement
+\TeX; some sort of extension to \PASCAL's ordinary |reset| and |rewrite|
+is crucial for our purposes. We shall assume that |name_of_file| is a variable
+of an appropriate type such that the \PASCAL\ run-time system being used to
+implement \TeX\ can open a file whose external name is specified by
+|name_of_file|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@!name_length:0..file_name_size;@/{this many characters are actually
+ relevant in |name_of_file| (the rest are blank)}
+
+@ The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `{\bf packed array
+$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
+\TeX\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\TeX's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+These procedures should not generate error messages if a file is
+being closed before it has been successfully opened.
+
+@p procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var f:word_file); {close a word file}
+begin close(f);
+end;
+
+@ Binary input and output are done with \PASCAL's ordinary |get| and |put|
+procedures, so we don't have to make any other special arrangements for
+binary~I/O. Text output is also easy to do with standard \PASCAL\ routines.
+The treatment of text input is more difficult, however, because
+of the necessary translation to |ASCII_code| values.
+\TeX's conventions should be efficient, and they should
+blend nicely with the user's operating environment.
+
+@ Input from text files is read one line at a time, using a routine called
+|input_ln|. This function is defined in terms of global variables called
+|buffer|, |first|, and |last| that will be described in detail later; for
+now, it suffices for us to know that |buffer| is an array of |ASCII_code|
+values, and that |first| and |last| are indices into this array
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@!first:0..buf_size; {the first unused position in |buffer|}
+@!last:0..buf_size; {end of the line just input to |buffer|}
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+
+@ The |input_ln| function brings the next line of input from the specified
+file into available positions of the buffer array and returns the value
+|true|, unless the file has already been entirely read, in which case it
+returns |false| and sets |last:=first|. In general, the |ASCII_code|
+numbers that represent the next line of the file are input into
+|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the
+global variable |last| is set equal to |first| plus the length of the
+line. Trailing blanks are removed from the line; thus, either |last=first|
+(in which case the line was entirely blank) or |buffer[last-1]<>" "|.
+
+An overflow error is given, however, if the normal actions of |input_ln|
+would make |last>=buf_size|; this is done so that other parts of \TeX\
+can safely look at the contents of |buffer[last+1]| without overstepping
+the bounds of the |buffer| array. Upon entry to |input_ln|, the condition
+|first<buf_size| will always hold, so that there is always room for an
+``empty'' line.
+
+The variable |max_buf_stack|, which is used to keep track of how large
+the |buf_size| parameter must be to accommodate the present job, is
+also kept up to date by |input_ln|.
+
+If the |bypass_eoln| parameter is |true|, |input_ln| will do a |get|
+before looking at the first character of the line; this skips over
+an |eoln| that was in |f^|. The procedure does not do a |get| when it
+reaches the end of the line; therefore it can be used to acquire input
+from the user's terminal as well as from ordinary text files.
+
+Standard \PASCAL\ says that a file should have |eoln| immediately
+before |eof|, but \TeX\ needs only a weaker restriction: If |eof|
+occurs in the middle of a line, the system function |eoln| should return
+a |true| result (even though |f^| will be undefined).
+
+Since the inner loop of |input_ln| is part of \TeX's ``inner loop''---each
+character of input comes in at this place---it is wise to reduce system
+overhead by making use of special routines that read in an entire array
+of characters at once, if such routines are available. The following
+code uses standard \PASCAL\ to illustrate what needs to be done, but
+finer tuning is often possible at well-developed \PASCAL\ sites.
+@^inner loop@>
+
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ @<Report overflow of the input buffer, and abort@>;
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+
+@ The user's terminal acts essentially like other files of text, except
+that it is used both for input and for output. When the terminal is
+considered an input file, the file variable is called |term_in|, and when it
+is considered an output file the file variable is |term_out|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+
+@ Sometimes it is necessary to synchronize the input/output mixture that
+happens on the user's terminal, and three system-dependent
+procedures are used for this
+purpose. The first of these, |update_terminal|, is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+The second, |clear_terminal|, is called when we wish to cancel any
+input that the user may have typed ahead (since we are about to
+issue an unexpected error message). The third, |wake_up_terminal|,
+is supposed to revive the terminal if the user has disabled it by
+some instruction to the operating system. The following macros show how
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+
+@ We need a special routine to read the first line of \TeX\ input from
+the user's terminal. This line is different because it is read before we
+have opened the transcript file; there is sort of a ``chicken and
+egg'' problem here. If the user types `\.{\\input paper}' on the first
+line, or if some macro invoked by that line does such an \.{\\input},
+the transcript file will be named `\.{paper.log}'; but if no \.{\\input}
+commands are performed during the first line of terminal input, the transcript
+file will acquire its default name `\.{texput.log}'. (The transcript file
+will not contain error messages generated by the first line before the
+first \.{\\input} command.)
+@.texput@>
+
+The first line is even more special if we are lucky enough to have an operating
+system that treats \TeX\ differently from a run-of-the-mill \PASCAL\ object
+program. It's nice to let the user start running a \TeX\ job by typing
+a command line like `\.{tex paper}'; in such a case, \TeX\ will operate
+as if the first line of input were `\.{paper}', i.e., the first line will
+consist of the remainder of the command line, after the part that invoked
+\TeX.
+
+The first line is special also because it may be read before \TeX\ has
+input a format file. In such cases, normal error messages cannot yet
+be given. The following code uses concepts that will be explained later.
+(If the \PASCAL\ compiler does not support non-local |@!goto|\unskip, the
+@^system dependencies@>
+statement `|goto final_end|' should be replaced by something that
+quietly terminates the program.)
+
+@<Report overflow of the input buffer, and abort@>=
+if format_ident=0 then
+ begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+ end
+else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+
+@ Different systems have different ways to get started. But regardless of
+what conventions are adopted, the routine that initializes the terminal
+should satisfy the following specifications:
+
+\yskip\textindent{1)}It should open file |term_in| for input from the
+ terminal. (The file |term_out| will already be open for output to the
+ terminal.)
+
+\textindent{2)}If the user has given a command line, this line should be
+ considered the first line of terminal input. Otherwise the
+ user should be prompted with `\.{**}', and the first line of input
+ should be whatever is typed in response.
+
+\textindent{3)}The first line of input, which might or might not be a
+ command line, should appear in locations |first| to |last-1| of the
+ |buffer| array.
+
+\textindent{4)}The global variable |loc| should be set so that the
+ character to be read next by \TeX\ is in |buffer[loc]|. This
+ character should not be blank, and we should have |loc<last|.
+
+\yskip\noindent(It may be necessary to prompt the user several times
+before a non-blank line comes in. The prompt is `\.{**}' instead of the
+later `\.*' because the meaning is slightly different: `\.{\\input}' need
+not be typed immediately after~`\.{**}'.)
+
+@d loc==cur_input.loc_field {location of first unread character in |buffer|}
+
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+
+@* \[4] String handling.
+Control sequence names and diagnostic messages are variable-length strings
+of eight-bit characters. Since \PASCAL\ does not have a well-developed string
+mechanism, \TeX\ does all of its string processing by homegrown methods.
+
+Elaborate facilities for dynamic strings are not needed, so all of the
+necessary operations can be handled with a simple data structure.
+The array |str_pool| contains all of the (eight-bit) ASCII codes in all
+of the strings, and the array |str_start| contains indices of the starting
+points of each string. Strings are referred to by integer numbers, so that
+string number |s| comprises the characters |str_pool[j]| for
+|str_start[s]<=j<str_start[s+1]|. Additional integer variables
+|pool_ptr| and |str_ptr| indicate the number of entries used so far
+in |str_pool| and |str_start|, respectively; locations
+|str_pool[pool_ptr]| and |str_start[str_ptr]| are
+ready for the next string to be allocated.
+
+String numbers 0 to 255 are reserved for strings that correspond to single
+ASCII characters. This is in accordance with the conventions of \.{WEB},
+@.WEB@>
+which converts single-character strings into the ASCII code number of the
+single character involved, while it converts other strings into integers
+and builds a string pool file. Thus, when the string constant \.{"."} appears
+in the program below, \.{WEB} converts it into the integer 46, which is the
+ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"}
+into some integer greater than~255. String number 46 will presumably be the
+single character `\..'; but some ASCII codes have no standard visible
+representation, and \TeX\ sometimes needs to be able to print an arbitrary
+ASCII character, so the first 256 strings are used to specify exactly what
+should be printed for each of the 256 possibilities.
+
+Elements of the |str_pool| array must be ASCII codes that can actually
+be printed; i.e., they must have an |xchr| equivalent in the local
+character set. (This restriction applies only to preloaded strings,
+not to those generated dynamically by the user.)
+
+Some \PASCAL\ compilers won't pack integers into a single byte unless the
+integers lie in the range |-128..127|. To accommodate such systems
+we access the string pool only via macros that can easily be redefined.
+
+@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
+@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..255; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@!pool_ptr : pool_pointer; {first unused position in |str_pool|}
+@!str_ptr : str_number; {number of the current string being created}
+@!init_pool_ptr : pool_pointer; {the starting value of |pool_ptr|}
+@!init_str_ptr : str_number; {the starting value of |str_ptr|}
+
+@ Several of the elementary string operations are performed using \.{WEB}
+macros instead of \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a string.
+@.WEB@>
+
+@d length(#)==(str_start[#+1]-str_start[#]) {the number of characters
+ in string number \#}
+
+@ The length of the current string is called |cur_length|:
+
+@d cur_length == (pool_ptr - str_start[str_ptr])
+
+@ Strings are created by appending character codes to |str_pool|.
+The |append_char| macro, defined here, does not check to see if the
+value of |pool_ptr| has gotten too high; this test is supposed to be
+made before |append_char| is used. There is also a |flush_char|
+macro, which erases the last character appended.
+
+To test if there is room to append |l| more characters to |str_pool|,
+we shall write |str_room(l)|, which aborts \TeX\ and gives an
+apologetic error message if there isn't enough room.
+
+@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
+begin str_pool[pool_ptr]:=si(#); incr(pool_ptr);
+end
+@d flush_char == decr(pool_ptr) {forget the last character in the pool}
+@d str_room(#) == {make sure that the pool hasn't overflowed}
+ begin if pool_ptr+# > pool_size then
+ overflow("pool size",pool_size-init_pool_ptr);
+@:TeX capacity exceeded pool size}{\quad pool size@>
+ end
+
+@ Once a sequence of characters has been appended to |str_pool|, it
+officially becomes a string when the function |make_string| is called.
+This function returns the identification number of the new string as its
+value.
+
+@p function make_string : str_number; {current string enters the pool}
+begin if str_ptr=max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+incr(str_ptr); str_start[str_ptr]:=pool_ptr;
+make_string:=str_ptr-1;
+end;
+
+@ To destroy the most recently made string, we say |flush_string|.
+
+@d flush_string==begin decr(str_ptr); pool_ptr:=str_start[str_ptr];
+ end
+
+@ The following subroutine compares string |s| with another string of the
+same length that appears in |buffer| starting at position |k|;
+the result is |true| if and only if the strings are equal.
+Empirical tests indicate that |str_eq_buf| is used in such a way that
+it tends to return |true| about 80 percent of the time.
+
+@p function str_eq_buf(@!s:str_number;@!k:integer):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j: pool_pointer; {running index}
+@!result: boolean; {result of comparison}
+begin j:=str_start[s];
+while j<str_start[s+1] do
+ begin if so(str_pool[j])<>buffer[k] then
+ begin result:=false; goto not_found;
+ end;
+ incr(j); incr(k);
+ end;
+result:=true;
+not_found: str_eq_buf:=result;
+end;
+
+@ Here is a similar routine, but it compares two strings in the string pool,
+and it does not assume that they have the same length.
+
+@p function str_eq_str(@!s,@!t:str_number):boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j,@!k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin result:=false;
+if length(s)<>length(t) then goto not_found;
+j:=str_start[s]; k:=str_start[t];
+while j<str_start[s+1] do
+ begin if str_pool[j]<>str_pool[k] then goto not_found;
+ incr(j); incr(k);
+ end;
+result:=true;
+not_found: str_eq_str:=result;
+end;
+
+@ The initial values of |str_pool|, |str_start|, |pool_ptr|,
+and |str_ptr| are computed by the \.{INITEX} program, based in part
+on the information that \.{WEB} has output while processing \TeX.
+@.INITEX@>
+@^string pool@>
+
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+ but returns |false| if something goes wrong}
+label done,exit;
+var k,@!l:0..255; {small indices or counters}
+@!m,@!n:text_char; {characters input from |pool_file|}
+@!g:str_number; {garbage}
+@!a:integer; {accumulator for check sum}
+@!c:boolean; {check sum has been checked}
+begin pool_ptr:=0; str_ptr:=0; str_start[0]:=0;
+@<Make the first 256 strings@>;
+@<Read the other strings from the \.{TEX.POOL} file and return |true|,
+ or give an error message and return |false|@>;
+exit:end;
+tini
+
+@ @d app_lc_hex(#)==l:=#;
+ if l<10 then append_char(l+"0")@+else append_char(l-10+"a")
+
+@<Make the first 256...@>=
+for k:=0 to 255 do
+ begin if (@<Character |k| cannot be printed@>) then
+ begin append_char("^"); append_char("^");
+ if k<@'100 then append_char(k+@'100)
+ else if k<@'200 then append_char(k-@'100)
+ else begin app_lc_hex(k div 16); app_lc_hex(k mod 16);
+ end;
+ end
+ else append_char(k);
+ g:=make_string;
+ end
+
+@ The first 128 strings will contain 95 standard ASCII characters, and the
+other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
+unless a system-dependent change is made here. Installations that have
+an extended character set, where for example |xchr[@'32]=@t\.{\'^^Z\'}@>|,
+would like string @'32 to be the single character @'32 instead of the
+three characters @'136, @'136, @'132 (\.{\^\^Z}). On the other hand,
+even people with an extended character set will want to represent string
+@'15 by \.{\^\^M}, since @'15 is |carriage_return|; the idea is to
+produce visible strings instead of tabs or line-feeds or carriage-returns
+or bell-rings or characters that are treated anomalously in text files.
+
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+The boolean expression defined here should be |true| unless \TeX\
+internal code number~|k| corresponds to a non-troublesome visible
+symbol in the local character set. An appropriate formula for the
+extended character set recommended in {\sl The \TeX book\/} would, for
+example, be `|k in [0,@'10..@'12,@'14,@'15,@'33,@'177..@'377]|'.
+If character |k| cannot be printed, and |k<@'200|, then character |k+@'100| or
+|k-@'100| must be printable; moreover, ASCII codes |[@'41..@'46,
+@'60..@'71, @'141..@'146, @'160..@'171]| must be printable.
+Thus, at least 80 printable characters are needed.
+@:TeXbook}{\sl The \TeX book@>
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Character |k| cannot be printed@>=
+ (k<" ")or(k>"~")
+
+@ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{TEX.PAS} and also a string pool file called \.{TEX.POOL}. The \.{INITEX}
+@.WEB@>@.INITEX@>
+program reads the latter file, where each string appears as a two-digit decimal
+length followed by the string itself, and the information is recorded in
+\TeX's string memory.
+
+@<Glob...@>=
+@!init @!pool_file:alpha_file; {the string-pool file output by \.{TANGLE}}
+tini
+
+@ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#);
+ a_close(pool_file); get_strings_started:=false; return;
+ end
+@<Read the other strings...@>=
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+ begin c:=false;
+ repeat @<Read one string, but return |false| if the
+ string memory space is getting too tight for comfort@>;
+ until c;
+ a_close(pool_file); get_strings_started:=true;
+ end
+else bad_pool('! I can''t read TEX.POOL.')
+@.I can't read TEX.POOL@>
+
+@ @<Read one string...@>=
+begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.');
+@.TEX.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+if m='*' then @<Check the pool check sum@>
+else begin if (xord[m]<"0")or(xord[m]>"9")or@|
+ (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL line doesn''t begin with two digits.');
+@.TEX.POOL line doesn't...@>
+ l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(xord[m]);
+ end;
+ read_ln(pool_file); g:=make_string;
+ end;
+end
+
+@ The \.{WEB} operation \.{@@\$} denotes the value that should be at the
+end of this \.{TEX.POOL} file; any other value means that the wrong pool
+file has been loaded.
+@^check sum@>
+
+@<Check the pool check sum@>=
+begin a:=0; k:=1;
+loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL check sum doesn''t have nine digits.');
+@.TEX.POOL check sum...@>
+ a:=10*a+xord[n]-"0";
+ if k=9 then goto done;
+ incr(k); read(pool_file,n);
+ end;
+done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.');
+@.TEX.POOL doesn't match@>
+c:=true;
+end
+
+@* \[5] On-line and off-line printing.
+Messages that are sent to a user's terminal and to the transcript-log file
+are produced by several `|print|' procedures. These procedures will
+direct their output to a variety of places, based on the setting of
+the global variable |selector|, which has the following possible
+values:
+
+\yskip
+\hang |term_and_log|, the normal setting, prints on the terminal and on the
+ transcript file.
+
+\hang |log_only|, prints only on the transcript file.
+
+\hang |term_only|, prints only on the terminal.
+
+\hang |no_print|, doesn't print at all. This is used only in rare cases
+ before the transcript file is open.
+
+\hang |pseudo|, puts output into a cyclic buffer that is used
+ by the |show_context| routine; when we get to that routine we shall discuss
+ the reasoning behind this curious mode.
+
+\hang |new_string|, appends the output to the current string in the
+ string pool.
+
+\hang 0 to 15, prints on one of the sixteen files for \.{\\write} output.
+
+\yskip
+\noindent The symbolic names `|term_and_log|', etc., have been assigned
+numeric codes that satisfy the convenient relations |no_print+1=term_only|,
+|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|.
+
+Three additional global variables, |tally| and |term_offset| and
+|file_offset|, record the number of characters that have been printed
+since they were most recently cleared to zero. We use |tally| to record
+the length of (possibly very long) stretches of printing; |term_offset|
+and |file_offset|, on the other hand, keep track of how many characters
+have appeared so far on the current line that has been output to the
+terminal or to the transcript file, respectively.
+
+@d no_print=16 {|selector| setting that makes data disappear}
+@d term_only=17 {printing is destined for the terminal only}
+@d log_only=18 {printing is destined for the transcript file only}
+@d term_and_log=19 {normal |selector| setting}
+@d pseudo=20 {special |selector| setting for |show_context|}
+@d new_string=21 {printing is deflected to the string pool}
+@d max_selector=21 {highest selector setting}
+
+@<Glob...@>=
+@!log_file : alpha_file; {transcript of \TeX\ session}
+@!selector : 0..max_selector; {where to print a message}
+@!dig : array[0..22] of 0..15; {digits in a number being output}
+@!tally : integer; {the number of characters recently printed}
+@!term_offset : 0..max_print_line;
+ {the number of characters on the current terminal line}
+@!file_offset : 0..max_print_line;
+ {the number of characters on the current file line}
+@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
+ pseudoprinting}
+@!trick_count: integer; {threshold for pseudoprinting, explained later}
+@!first_count: integer; {another variable for pseudoprinting}
+
+@ @<Initialize the output routines@>=
+selector:=term_only; tally:=0; term_offset:=0; file_offset:=0;
+
+@ Macro abbreviations for output to the terminal and to the log file are
+defined here for convenience. Some systems need special conventions
+for terminal output, and it is possible to adhere to those conventions
+by changing |wterm|, |wterm_ln|, and |wterm_cr| in this section.
+@^system dependencies@>
+
+@d wterm(#)==write(term_out,#)
+@d wterm_ln(#)==write_ln(term_out,#)
+@d wterm_cr==write_ln(term_out)
+@d wlog(#)==write(log_file,#)
+@d wlog_ln(#)==write_ln(log_file,#)
+@d wlog_cr==write_ln(log_file)
+
+@ To end a line of text output, we call |print_ln|.
+
+@<Basic print...@>=
+procedure print_ln; {prints an end-of-line}
+begin case selector of
+term_and_log: begin wterm_cr; wlog_cr;
+ term_offset:=0; file_offset:=0;
+ end;
+log_only: begin wlog_cr; file_offset:=0;
+ end;
+term_only: begin wterm_cr; term_offset:=0;
+ end;
+no_print,pseudo,new_string: do_nothing;
+othercases write_ln(write_file[selector])
+endcases;@/
+end; {|tally| is not affected}
+
+@ The |print_char| procedure sends one character to the desired destination,
+using the |xchr| array to map it into an external character compatible with
+|input_ln|. All printing comes through |print_ln| or |print_char|.
+
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+case selector of
+term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin wlog(xchr[s]); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin wterm(xchr[s]); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+othercases write(write_file[selector],xchr[s])
+endcases;@/
+incr(tally);
+exit:end;
+
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<256 then
+ if s<0 then s:="???" {can't happen}
+ else begin if selector>pseudo then
+ begin print_char(s); return; {internal strings are not expanded}
+ end;
+ if (@<Character |s| is the current new-line character@>) then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ nl:=new_line_char; new_line_char:=-1;
+ {temporarily disable new-line character}
+ j:=str_start[s];
+ while j<str_start[s+1] do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+ new_line_char:=nl; return;
+ end;
+j:=str_start[s];
+while j<str_start[s+1] do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+exit:end;
+
+@ Control sequence names, file names, and strings constructed with
+\.{\\string} might contain |ASCII_code| values that can't
+be printed using |print_char|. Therefore we use |slow_print| for them:
+
+@<Basic print...@>=
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<256) then print(s)
+else begin j:=str_start[s];
+ while j<str_start[s+1] do
+ begin print(so(str_pool[j])); incr(j);
+ end;
+ end;
+end;
+
+@ Here is the very first thing that \TeX\ prints: a headline that identifies
+the version number and format package. The |term_offset| variable is temporarily
+incorrect, but the discrepancy is not serious since we assume that the banner
+and format identifier together will occupy at most |max_print_line|
+character positions.
+
+@<Initialize the output...@>=
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+update_terminal;
+
+@ The procedure |print_nl| is like |print|, but it makes sure that the
+string appears at the beginning of a new line.
+
+@<Basic print...@>=
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+ ((file_offset>0)and(selector>=log_only)) then print_ln;
+print(s);
+end;
+
+@ The procedure |print_esc| prints a string that is preceded by
+the user's escape character (which is usually a backslash).
+
+@<Basic print...@>=
+procedure print_esc(@!s:str_number); {prints escape character, then |s|}
+var c:integer; {the escape character code}
+begin @<Set variable |c| to the current escape character@>;
+if c>=0 then if c<256 then print(c);
+slow_print(s);
+end;
+
+@ An array of digits in the range |0..15| is printed by |print_the_digs|.
+
+@<Basic print...@>=
+procedure print_the_digs(@!k:eight_bits);
+ {prints |dig[k-1]|$\,\ldots\,$|dig[0]|}
+begin while k>0 do
+ begin decr(k);
+ if dig[k]<10 then print_char("0"+dig[k])
+ else print_char("A"-10+dig[k]);
+ end;
+end;
+
+@ The following procedure, which prints out the decimal representation of a
+given integer |n|, has been written carefully so that it works properly
+if |n=0| or if |(-n)| would cause overflow. It does not apply |mod| or |div|
+to negative arguments, since such operations are not implemented consistently
+by all \PASCAL\ compilers.
+
+@<Basic print...@>=
+procedure print_int(@!n:integer); {prints an integer in decimal form}
+var k:0..23; {index to current digit; we assume that $|n|<10^{23}$}
+@!m:integer; {used to negate |n| in possibly dangerous cases}
+begin k:=0;
+if n<0 then
+ begin print_char("-");
+ if n>-100000000 then negate(n)
+ else begin m:=-1-n; n:=m div 10; m:=(m mod 10)+1; k:=1;
+ if m<10 then dig[0]:=m
+ else begin dig[0]:=0; incr(n);
+ end;
+ end;
+ end;
+repeat dig[k]:=n mod 10; n:=n div 10; incr(k);
+until n=0;
+print_the_digs(k);
+end;
+
+@ Here is a trivial procedure to print two digits; it is usually called with
+a parameter in the range |0<=n<=99|.
+
+@p procedure print_two(@!n:integer); {prints two least significant digits}
+begin n:=abs(n) mod 100; print_char("0"+(n div 10));
+print_char("0"+(n mod 10));
+end;
+
+@ Hexadecimal printing of nonnegative integers is accomplished by |print_hex|.
+
+@p procedure print_hex(@!n:integer);
+ {prints a positive integer in hexadecimal form}
+var k:0..22; {index to current digit; we assume that $0\L n<16^{22}$}
+begin k:=0; print_char("""");
+repeat dig[k]:=n mod 16; n:=n div 16; incr(k);
+until n=0;
+print_the_digs(k);
+end;
+
+@ Old versions of \TeX\ needed a procedure called |print_ASCII| whose function
+is now subsumed by |print|. We retain the old name here as a possible aid to
+future software arch\ae ologists.
+
+@d print_ASCII == print
+
+@ Roman numerals are produced by the |print_roman_int| routine. Readers
+who like puzzles might enjoy trying to figure out how this tricky code
+works; therefore no explanation will be given. Notice that 1990 yields
+\.{mcmxc}, not \.{mxm}.
+
+@p procedure print_roman_int(@!n:integer);
+label exit;
+var j,@!k: pool_pointer; {mysterious indices into |str_pool|}
+@!u,@!v: nonnegative_integer; {mysterious numbers}
+begin j:=str_start["m2d5c2l5x2v5i"]; v:=1000;
+loop@+ begin while n>=v do
+ begin print_char(so(str_pool[j])); n:=n-v;
+ end;
+ if n<=0 then return; {nonpositive input produces no output}
+ k:=j+2; u:=v div (so(str_pool[k-1])-"0");
+ if str_pool[k-1]=si("2") then
+ begin k:=k+2; u:=u div (so(str_pool[k-1])-"0");
+ end;
+ if n+u>=v then
+ begin print_char(so(str_pool[k])); n:=n+u;
+ end
+ else begin j:=j+2; v:=v div (so(str_pool[j-1])-"0");
+ end;
+ end;
+exit:end;
+
+@ The |print| subroutine will not print a string that is still being
+created. The following procedure will.
+
+@p procedure print_current_string; {prints a yet-unmade string}
+var j:pool_pointer; {points to current character code}
+begin j:=str_start[str_ptr];
+while j<pool_ptr do
+ begin print_char(so(str_pool[j])); incr(j);
+ end;
+end;
+
+@ Here is a procedure that asks the user to type a line of input,
+assuming that the |selector| setting is either |term_only| or |term_and_log|.
+The input is placed into locations |first| through |last-1| of the
+|buffer| array, and echoed on the transcript file if appropriate.
+
+This procedure is never called when |interaction<scroll_mode|.
+
+@d prompt_input(#)==begin wake_up_terminal; print(#); term_input;
+ end {prints a string and gets a line of input}
+
+@p procedure term_input; {gets a line from the terminal}
+var k:0..buf_size; {index into |buffer|}
+begin update_terminal; {now the user sees the prompt for sure}
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@.End of file on the terminal@>
+term_offset:=0; {the user's line ended with \<\rm return>}
+decr(selector); {prepare to echo the input}
+if last<>first then for k:=first to last-1 do print(buffer[k]);
+print_ln; incr(selector); {restore previous status}
+end;
+
+@* \[6] Reporting errors.
+When something anomalous is detected, \TeX\ typically does something like this:
+$$\vbox{\halign{#\hfil\cr
+|print_err("Something anomalous has been detected");|\cr
+|help3("This is the first line of my offer to help.")|\cr
+|("This is the second line. I'm trying to")|\cr
+|("explain the best way for you to proceed.");|\cr
+|error;|\cr}}$$
+A two-line help message would be given using |help2|, etc.; these informal
+helps should use simple vocabulary that complements the words used in the
+official error message that was printed. (Outside the U.S.A., the help
+messages should preferably be translated into the local vernacular. Each
+line of help is at most 60 characters long, in the present implementation,
+so that |max_print_line| will not be exceeded.)
+
+The |print_err| procedure supplies a `\.!' before the official message,
+and makes sure that the terminal is awake if a stop is going to occur.
+The |error| procedure supplies a `\..' after the official message, then it
+shows the location of the error; and if |interaction=error_stop_mode|,
+it also enters into a dialog with the user, during which time the help
+message may be printed.
+@^system dependencies@>
+
+@ The global variable |interaction| has four settings, representing increasing
+amounts of user interaction:
+
+@d batch_mode=0 {omits all stops and omits terminal output}
+@d nonstop_mode=1 {omits all stops}
+@d scroll_mode=2 {omits error stops}
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal;
+ print_nl("! "); print(#);
+ end
+
+@<Glob...@>=
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+
+@ @<Set init...@>=interaction:=error_stop_mode;
+
+@ \TeX\ is careful not to call |error| when the print |selector| setting
+might be unusual. The only possible values of |selector| at the time of
+error messages are
+
+\yskip\hang|no_print| (when |interaction=batch_mode|
+ and |log_file| not yet open);
+
+\hang|term_only| (when |interaction>batch_mode| and |log_file| not yet open);
+
+\hang|log_only| (when |interaction=batch_mode| and |log_file| is open);
+
+\hang|term_and_log| (when |interaction>batch_mode| and |log_file| is open).
+
+@<Initialize the print |selector| based on |interaction|@>=
+if interaction=batch_mode then selector:=no_print@+else selector:=term_only
+
+@ A global variable |deletions_allowed| is set |false| if the |get_next|
+routine is active when |error| is called; this ensures that |get_next|
+and related routines like |get_token| will never be called recursively.
+A similar interlock is provided by |set_box_allowed|.
+@^recursion@>
+
+The global variable |history| records the worst level of error that
+has been detected. It has four possible values: |spotless|, |warning_issued|,
+|error_message_issued|, and |fatal_error_stop|.
+
+Another global variable, |error_count|, is increased by one when an
+|error| occurs without an interactive dialog, and it is reset to zero at
+the end of every paragraph. If |error_count| reaches 100, \TeX\ decides
+that there is no point in continuing further.
+
+@d spotless=0 {|history| value when nothing has been amiss yet}
+@d warning_issued=1 {|history| value when |begin_diagnostic| has been called}
+@d error_message_issued=2 {|history| value when |error| has been called}
+@d fatal_error_stop=3 {|history| value when termination was premature}
+
+@<Glob...@>=
+@!deletions_allowed:boolean; {is it safe for |error| to call |get_token|?}
+@!set_box_allowed:boolean; {is it safe to do a \.{\\setbox} assignment?}
+@!history:spotless..fatal_error_stop; {has the source input been clean so far?}
+@!error_count:-1..100; {the number of scrolled errors since the
+ last paragraph ended}
+
+@ The value of |history| is initially |fatal_error_stop|, but it will
+be changed to |spotless| if \TeX\ survives the initialization process.
+
+@<Set init...@>=
+deletions_allowed:=true; set_box_allowed:=true;
+error_count:=0; {|history| is initialized elsewhere}
+
+@ Since errors can be detected almost anywhere in \TeX, we want to declare the
+error procedures near the beginning of the program. But the error procedures
+in turn use some other procedures, which need to be declared |forward|
+before we get to |error| itself.
+
+It is possible for |error| to be called recursively if some error arises
+when |get_token| is being used to delete a token, and/or if some fatal error
+occurs while \TeX\ is trying to fix a non-fatal one. But such recursion
+@^recursion@>
+is never more than two levels deep.
+
+@<Error handling...@>=
+procedure@?normalize_selector; forward;@t\2@>@/
+procedure@?get_token; forward;@t\2@>@/
+procedure@?term_input; forward;@t\2@>@/
+procedure@?show_context; forward;@t\2@>@/
+procedure@?begin_file_reading; forward;@t\2@>@/
+procedure@?open_log_file; forward;@t\2@>@/
+procedure@?close_files_and_terminate; forward;@t\2@>@/
+procedure@?clear_for_error_prompt; forward;@t\2@>@/
+procedure@?give_err_help; forward;@t\2@>@/
+@t\4\hskip-\fontdimen2\font@>@;@+@!debug@+procedure@?debug_help;
+ forward;@;@+gubed
+
+@ Individual lines of help are recorded in the array |help_line|, which
+contains entries in positions |0..(help_ptr-1)|. They should be printed
+in reverse order, i.e., with |help_line[0]| appearing last.
+
+@d hlp1(#)==help_line[0]:=#;@+end
+@d hlp2(#)==help_line[1]:=#; hlp1
+@d hlp3(#)==help_line[2]:=#; hlp2
+@d hlp4(#)==help_line[3]:=#; hlp3
+@d hlp5(#)==help_line[4]:=#; hlp4
+@d hlp6(#)==help_line[5]:=#; hlp5
+@d help0==help_ptr:=0 {sometimes there might be no help}
+@d help1==@+begin help_ptr:=1; hlp1 {use this with one help line}
+@d help2==@+begin help_ptr:=2; hlp2 {use this with two help lines}
+@d help3==@+begin help_ptr:=3; hlp3 {use this with three help lines}
+@d help4==@+begin help_ptr:=4; hlp4 {use this with four help lines}
+@d help5==@+begin help_ptr:=5; hlp5 {use this with five help lines}
+@d help6==@+begin help_ptr:=6; hlp6 {use this with six help lines}
+
+@<Glob...@>=
+@!help_line:array[0..5] of str_number; {helps for the next |error|}
+@!help_ptr:0..6; {the number of help lines present}
+@!use_err_help:boolean; {should the |err_help| list be shown?}
+
+@ @<Set init...@>=
+help_ptr:=0; use_err_help:=false;
+
+@ The |jump_out| procedure just cuts across all active procedure levels and
+goes to |end_of_TEX|. This is the only nontrivial |@!goto| statement in the
+whole program. It is used when there is no recovery from a particular error.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the body of |jump_out| should simply be
+`|close_files_and_terminate|;\thinspace' followed by a call on some system
+procedure that quietly terminates the program.
+
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+
+@ Here now is the general |error| routine.
+
+@<Error hand...@>=
+procedure error; {completes the job of error reporting}
+label continue,exit;
+var c:ASCII_code; {what the user types}
+@!s1,@!s2,@!s3,@!s4:integer;
+ {used to save global variables when deleting tokens}
+begin if history<error_message_issued then history:=error_message_issued;
+print_char("."); show_context;
+if interaction=error_stop_mode then @<Get user's advice and |return|@>;
+incr(error_count);
+if error_count=100 then
+ begin print_nl("(That makes 100 errors; please try again.)");
+@.That makes 100 errors...@>
+ history:=fatal_error_stop; jump_out;
+ end;
+@<Put help message on the transcript file@>;
+exit:end;
+
+@ @<Get user's advice...@>=
+loop@+begin continue: clear_for_error_prompt; prompt_input("? ");
+@.?\relax@>
+ if last=first then return;
+ c:=buffer[first];
+ if c>="a" then c:=c+"A"-"a"; {convert to uppercase}
+ @<Interpret code |c| and |return| if done@>;
+ end
+
+@ It is desirable to provide an `\.E' option here that gives the user
+an easy way to return from \TeX\ to the system editor, with the offending
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+
+@<Interpret code |c| and |return| if done@>=
+case c of
+"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then
+ @<Delete \(c)|c-"0"| tokens and |goto continue|@>;
+@t\4\4@>@;@+@!debug "D": begin debug_help; goto continue;@+end;@+gubed@/
+"E": if base_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ slow_print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+ end;
+"H": @<Print the help information and |goto continue|@>;
+"I":@<Introduce new material from the terminal and |return|@>;
+"Q","R","S":@<Change the interaction level and |return|@>;
+"X":begin interaction:=scroll_mode; jump_out;
+ end;
+othercases do_nothing
+endcases;@/
+@<Print the menu of available options@>
+
+@ @<Print the menu...@>=
+begin print("Type <return> to proceed, S to scroll future error messages,");@/
+@.Type <return> to proceed...@>
+print_nl("R to run without stopping, Q to run quietly,");@/
+print_nl("I to insert something, ");
+if base_ptr>0 then print("E to edit your file,");
+if deletions_allowed then
+ print_nl("1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
+print_nl("H for help, X to quit.");
+end
+
+@ Here the author of \TeX\ apologizes for making use of the numerical
+relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings
+|batch_mode|, |nonstop_mode|, |scroll_mode|.
+@^Knuth, Donald Ervin@>
+
+@<Change the interaction...@>=
+begin error_count:=0; interaction:=batch_mode+c-"Q";
+print("OK, entering ");
+case c of
+"Q":begin print_esc("batchmode"); decr(selector);
+ end;
+"R":print_esc("nonstopmode");
+"S":print_esc("scrollmode");
+end; {there are no other cases}
+print("..."); print_ln; update_terminal; return;
+end
+
+@ When the following code is executed, |buffer[(first+1)..(last-1)]| may
+contain the material inserted by the user; otherwise another prompt will
+be given. In order to understand this part of the program fully, you need
+to be familiar with \TeX's input stacks.
+
+@<Introduce new material...@>=
+begin begin_file_reading; {enter a new syntactic level for terminal input}
+{now |state=mid_line|, so an initial blank space will count as a blank}
+if last>first+1 then
+ begin loc:=first+1; buffer[first]:=" ";
+ end
+else begin prompt_input("insert>"); loc:=first;
+@.insert>@>
+ end;
+first:=last;
+cur_input.limit_field:=last-1; {no |end_line_char| ends this line}
+return;
+end
+
+@ We allow deletion of up to 99 tokens at a time.
+
+@<Delete \(c)|c-"0"| tokens...@>=
+begin s1:=cur_tok; s2:=cur_cmd; s3:=cur_chr; s4:=align_state;
+align_state:=1000000; OK_to_interrupt:=false;
+if (last>first+1) and (buffer[first+1]>="0")and(buffer[first+1]<="9") then
+ c:=c*10+buffer[first+1]-"0"*11
+else c:=c-"0";
+while c>0 do
+ begin get_token; {one-level recursive call of |error| is possible}
+ decr(c);
+ end;
+cur_tok:=s1; cur_cmd:=s2; cur_chr:=s3; align_state:=s4; OK_to_interrupt:=true;
+help2("I have just deleted some text, as you asked.")@/
+("You can now delete more, or insert, or whatever.");
+show_context; goto continue;
+end
+
+@ @<Print the help info...@>=
+begin if use_err_help then
+ begin give_err_help; use_err_help:=false;
+ end
+else begin if help_ptr=0 then
+ help2("Sorry, I don't know how to help in this situation.")@/
+ @t\kern1em@>("Maybe you should try asking a human?");
+ repeat decr(help_ptr); print(help_line[help_ptr]); print_ln;
+ until help_ptr=0;
+ end;
+help4("Sorry, I already gave what help I could...")@/
+ ("Maybe you should try asking a human?")@/
+ ("An error might have occurred before I noticed any problems.")@/
+ ("``If all else fails, read the instructions.''");@/
+goto continue;
+end
+
+@ @<Put help message on the transcript file@>=
+if interaction>batch_mode then decr(selector); {avoid terminal output}
+if use_err_help then
+ begin print_ln; give_err_help;
+ end
+else while help_ptr>0 do
+ begin decr(help_ptr); print_nl(help_line[help_ptr]);
+ end;
+print_ln;
+if interaction>batch_mode then incr(selector); {re-enable terminal output}
+print_ln
+
+@ A dozen or so error messages end with a parenthesized integer, so we
+save a teeny bit of program space by declaring the following procedure:
+
+@p procedure int_error(@!n:integer);
+begin print(" ("); print_int(n); print_char(")"); error;
+end;
+
+@ In anomalous cases, the print selector might be in an unknown state;
+the following subroutine is called to fix things just enough to keep
+running a bit longer.
+
+@p procedure normalize_selector;
+begin if log_opened then selector:=term_and_log
+else selector:=term_only;
+if job_name=0 then open_log_file;
+if interaction=batch_mode then decr(selector);
+end;
+
+@ The following procedure prints \TeX's last words before dying.
+
+@d succumb==begin if interaction=error_stop_mode then
+ interaction:=scroll_mode; {no more interaction}
+ if log_opened then error;
+ @!debug if interaction>batch_mode then debug_help;@+gubed@;@/
+ history:=fatal_error_stop; jump_out; {irrecoverable error}
+ end
+
+@<Error hand...@>=
+procedure fatal_error(@!s:str_number); {prints |s|, and that's it}
+begin normalize_selector;@/
+print_err("Emergency stop"); help1(s); succumb;
+@.Emergency stop@>
+end;
+
+@ Here is the most dreaded error message.
+
+@<Error hand...@>=
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("TeX capacity exceeded, sorry [");
+@.TeX capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+ ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+
+@ The program might sometime run completely amok, at which point there is
+no choice but to stop. If no previous error has been detected, that's bad
+news; a message is printed that is really intended for the \TeX\
+maintenance person instead of the user (unless the user has been
+particularly diabolical). The index entries for `this can't happen' may
+help to pinpoint the problem.
+@^dry rot@>
+
+@<Error hand...@>=
+procedure confusion(@!s:str_number);
+ {consistency check violated; |s| tells where}
+begin normalize_selector;
+if history<error_message_issued then
+ begin print_err("This can't happen ("); print(s); print_char(")");
+@.This can't happen@>
+ help1("I'm broken. Please show this to someone who can fix can fix");
+ end
+else begin print_err("I can't go on meeting you like this");
+@.I can't go on...@>
+ help2("One of your faux pas seems to have wounded me deeply...")@/
+ ("in fact, I'm barely conscious. Please fix it and try again.");
+ end;
+succumb;
+end;
+
+@ Users occasionally want to interrupt \TeX\ while it's running.
+If the \PASCAL\ runtime system allows this, one can implement
+a routine that sets the global variable |interrupt| to some nonzero value
+when such an interrupt is signalled. Otherwise there is probably at least
+a way to make |interrupt| nonzero using the \PASCAL\ debugger.
+@^system dependencies@>
+@^debugging@>
+
+@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
+ end
+
+@<Global...@>=
+@!interrupt:integer; {should \TeX\ pause for instructions?}
+@!OK_to_interrupt:boolean; {should interrupts be observed?}
+
+@ @<Set init...@>=
+interrupt:=0; OK_to_interrupt:=true;
+
+@ When an interrupt has been detected, the program goes into its
+highest interaction level and lets the user have nearly the full flexibility of
+the |error| routine. \TeX\ checks for interrupts only at times when it is
+safe to do this.
+
+@p procedure pause_for_instructions;
+begin if OK_to_interrupt then
+ begin interaction:=error_stop_mode;
+ if (selector=log_only)or(selector=no_print) then
+ incr(selector);
+ print_err("Interruption");
+@.Interruption@>
+ help3("You rang?")@/
+ ("Try to insert some instructions for me (e.g.,`I\showlists'),")@/
+ ("unless you just want to quit by typing `X'.");
+ deletions_allowed:=false; error; deletions_allowed:=true;
+ interrupt:=0;
+ end;
+end;
+
+@* \[7] Arithmetic with scaled dimensions.
+The principal computations performed by \TeX\ are done entirely in terms of
+integers less than $2^{31}$ in magnitude; and divisions are done only when both
+dividend and divisor are nonnegative. Thus, the arithmetic specified in this
+program can be carried out in exactly the same way on a wide variety of
+computers, including some small ones. Why? Because the arithmetic
+calculations need to be spelled out precisely in order to guarantee that
+\TeX\ will produce identical output on different machines. If some
+quantities were rounded differently in different implementations, we would
+find that line breaks and even page breaks might occur in different places.
+Hence the arithmetic of \TeX\ has been designed with care, and systems that
+claim to be implementations of \TeX82 should follow precisely the
+@:TeX82}{\TeX82@>
+calculations as they appear in the present program.
+
+(Actually there are three places where \TeX\ uses |div| with a possibly negative
+numerator. These are harmless; see |div| in the index. Also if the user
+sets the \.{\\time} or the \.{\\year} to a negative value, some diagnostic
+information will involve negative-numerator division. The same remarks
+apply for |mod| as well as for |div|.)
+
+@ Here is a routine that calculates half of an integer, using an
+unambiguous convention with respect to signed odd numbers.
+
+@p function half(@!x:integer):integer;
+begin if odd(x) then half:=(x+1) div 2
+else half:=x @!div 2;
+end;
+
+@ Fixed-point arithmetic is done on {\sl scaled integers\/} that are multiples
+of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit
+positions from the right end of a binary computer word.
+
+@d unity == @'200000 {$2^{16}$, represents 1.00000}
+@d two == @'400000 {$2^{17}$, represents 2.00000}
+
+@<Types...@>=
+@!scaled = integer; {this type is used for scaled integers}
+@!nonnegative_integer=0..@'17777777777; {$0\L x<2^{31}$}
+@!small_number=0..63; {this type is self-explanatory}
+
+@ The following function is used to create a scaled integer from a given decimal
+fraction $(.d_0d_1\ldots d_{k-1})$, where |0<=k<=17|. The digit $d_i$ is
+given in |dig[i]|, and the calculation produces a correctly rounded result.
+
+@p function round_decimals(@!k:small_number) : scaled;
+ {converts a decimal fraction}
+var a:integer; {the accumulator}
+begin a:=0;
+while k>0 do
+ begin decr(k); a:=(a+dig[k]*two) div 10;
+ end;
+round_decimals:=(a+1) div 2;
+end;
+
+@ Conversely, here is a procedure analogous to |print_int|. If the output
+of this procedure is subsequently read by \TeX\ and converted by the
+|round_decimals| routine above, it turns out that the original value will
+be reproduced exactly; the ``simplest'' such decimal number is output,
+but there is always at least one digit following the decimal point.
+
+The invariant relation in the \&{repeat} loop is that a sequence of
+decimal digits yet to be printed will yield the original number if and only if
+they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$.
+We can stop if and only if $f=0$ satisfies this condition; the loop will
+terminate before $s$ can possibly become zero.
+
+@p procedure print_scaled(@!s:scaled); {prints scaled real, rounded to five
+ digits}
+var delta:scaled; {amount of allowable inaccuracy}
+begin if s<0 then
+ begin print_char("-"); negate(s); {print the sign, if negative}
+ end;
+print_int(s div unity); {print the integer part}
+print_char(".");
+s:=10*(s mod unity)+5; delta:=10;
+repeat if delta>unity then s:=s+@'100000-50000; {round the last digit}
+print_char("0"+(s div unity)); s:=10*(s mod unity); delta:=delta*10;
+until s<=delta;
+end;
+
+@ Physical sizes that a \TeX\ user specifies for portions of documents are
+represented internally as scaled points. Thus, if we define an `sp' (scaled
+@^sp@>
+point) as a unit equal to $2^{-16}$ printer's points, every dimension
+inside of \TeX\ is an integer number of sp. There are exactly
+4,736,286.72 sp per inch. Users are not allowed to specify dimensions
+larger than $2^{30}-1$ sp, which is a distance of about 18.892 feet (5.7583
+meters); two such quantities can be added without overflow on a 32-bit
+computer.
+
+The present implementation of \TeX\ does not check for overflow when
+@^Overflow in arithmetic@>
+dimensions are added or subtracted. This could be done by inserting a
+few dozen tests of the form `\ignorespaces|if x>=@'10000000000 then
+@t\\{report\_overflow}@>|', but the chance of overflow is so remote that
+such tests do not seem worthwhile.
+
+\TeX\ needs to do only a few arithmetic operations on scaled quantities,
+other than addition and subtraction, and the following subroutines do most of
+the work. A single computation might use several subroutine calls, and it is
+desirable to avoid producing multiple error messages in case of arithmetic
+overflow; so the routines set the global variable |arith_error| to |true|
+instead of reporting errors directly to the user. Another global variable,
+|remainder|, holds the remainder after a division.
+
+@<Glob...@>=
+@!arith_error:boolean; {has arithmetic overflow occurred recently?}
+@!remainder:scaled; {amount subtracted to get an exact division}
+
+@ The first arithmetical subroutine we need computes $nx+y$, where |x|
+and~|y| are |scaled| and |n| is an integer. We will also use it to
+multiply integers.
+
+@d nx_plus_y(#)==mult_and_add(#,@'7777777777)
+@d mult_integers(#)==mult_and_add(#,0,@'17777777777)
+
+@p function mult_and_add(@!n:integer;@!x,@!y,@!max_answer:scaled):scaled;
+begin if n<0 then
+ begin negate(x); negate(n);
+ end;
+if n=0 then mult_and_add:=y
+else if ((x<=(max_answer-y) div n)and(-x<=(max_answer+y) div n)) then
+ mult_and_add:=n*x+y
+else begin arith_error:=true; mult_and_add:=0;
+ end;
+end;
+
+@ We also need to divide scaled dimensions by integers.
+
+@p function x_over_n(@!x:scaled;@!n:integer):scaled;
+var negative:boolean; {should |remainder| be negated?}
+begin negative:=false;
+if n=0 then
+ begin arith_error:=true; x_over_n:=0; remainder:=x;
+ end
+else begin if n<0 then
+ begin negate(x); negate(n); negative:=true;
+ end;
+ if x>=0 then
+ begin x_over_n:=x div n; remainder:=x mod n;
+ end
+ else begin x_over_n:=-((-x) div n); remainder:=-((-x) mod n);
+ end;
+ end;
+if negative then negate(remainder);
+end;
+
+@ Then comes the multiplication of a scaled number by a fraction |n/d|,
+where |n| and |d| are nonnegative integers |<=@t$2^{16}$@>| and |d| is
+positive. It would be too dangerous to multiply by~|n| and then divide
+by~|d|, in separate operations, since overflow might well occur; and it
+would be too inaccurate to divide by |d| and then multiply by |n|. Hence
+this subroutine simulates 1.5-precision arithmetic.
+
+@p function xn_over_d(@!x:scaled; @!n,@!d:integer):scaled;
+var positive:boolean; {was |x>=0|?}
+@!t,@!u,@!v:nonnegative_integer; {intermediate quantities}
+begin if x>=0 then positive:=true
+else begin negate(x); positive:=false;
+ end;
+t:=(x mod @'100000)*n;
+u:=(x div @'100000)*n+(t div @'100000);
+v:=(u mod d)*@'100000 + (t mod @'100000);
+if u div d>=@'100000 then arith_error:=true
+else u:=@'100000*(u div d) + (v div d);
+if positive then
+ begin xn_over_d:=u; remainder:=v mod d;
+ end
+else begin xn_over_d:=-u; remainder:=-(v mod d);
+ end;
+end;
+
+@ The next subroutine is used to compute the ``badness'' of glue, when a
+total~|t| is supposed to be made from amounts that sum to~|s|. According
+to {\sl The \TeX book}, the badness of this situation is $100(t/s)^3$;
+however, badness is simply a heuristic, so we need not squeeze out the
+last drop of accuracy when computing it. All we really want is an
+approximation that has similar properties.
+@:TeXbook}{\sl The \TeX book@>
+
+The actual method used to compute the badness is easier to read from the
+program than to describe in words. It produces an integer value that is a
+reasonably close approximation to $100(t/s)^3$, and all implementations
+of \TeX\ should use precisely this method. Any badness of $2^{13}$ or more is
+treated as infinitely bad, and represented by 10000.
+
+It is not difficult to prove that $$\hbox{|badness(t+1,s)>=badness(t,s)
+>=badness(t,s+1)|}.$$ The badness function defined here is capable of
+computing at most 1095 distinct values, but that is plenty.
+
+@d inf_bad = 10000 {infinitely bad value}
+
+@p function badness(@!t,@!s:scaled):halfword; {compute badness, given |t>=0|}
+var r:integer; {approximation to $\alpha t/s$, where $\alpha^3\approx
+ 100\cdot2^{18}$}
+begin if t=0 then badness:=0
+else if s<=0 then badness:=inf_bad
+else begin if t<=7230584 then r:=(t*297) div s {$297^3=99.94\times2^{18}$}
+ else if s>=1663497 then r:=t div (s div 297)
+ else r:=t;
+ if r>1290 then badness:=inf_bad {$1290^3<2^{31}<1291^3$}
+ else badness:=(r*r*r+@'400000) div @'1000000;
+ end; {that was $r^3/2^{18}$, rounded to the nearest integer}
+end;
+
+@ When \TeX\ ``packages'' a list into a box, it needs to calculate the
+proportionality ratio by which the glue inside the box should stretch
+or shrink. This calculation does not affect \TeX's decision making,
+so the precise details of rounding, etc., in the glue calculation are not
+of critical importance for the consistency of results on different computers.
+
+We shall use the type |glue_ratio| for such proportionality ratios.
+A glue ratio should take the same amount of memory as an
+|integer| (usually 32 bits) if it is to blend smoothly with \TeX's
+other data structures. Thus |glue_ratio| should be equivalent to
+|short_real| in some implementations of \PASCAL. Alternatively,
+it is possible to deal with glue ratios using nothing but fixed-point
+arithmetic; see {\sl TUGboat \bf3},1 (March 1982), 10--27. (But the
+routines cited there must be modified to allow negative glue ratios.)
+@^system dependencies@>
+
+@d set_glue_ratio_zero(#) == #:=0.0 {store the representation of zero ratio}
+@d set_glue_ratio_one(#) == #:=1.0 {store the representation of unit ratio}
+@d float(#) == # {convert from |glue_ratio| to type |real|}
+@d unfloat(#) == # {convert from |real| to type |glue_ratio|}
+@d float_constant(#) == #.0 {convert |integer| constant to |real|}
+
+@<Types...@>=
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+
+@* \[8] Packed data.
+In order to make efficient use of storage space, \TeX\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a (signed) |glue_ratio|, or a small number of
+fields that are one half or one quarter of the size used for storing
+integers.
+
+If |x| is a variable of type |memory_word|, it contains up to four
+fields that can be referred to as follows:
+$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr
+|x|&.|int|&(an |integer|)\cr
+|x|&.|sc|\qquad&(a |scaled| integer)\cr
+|x|&.|gr|&(a |glue_ratio|)\cr
+|x.hh.lh|, |x.hh|&.|rh|&(two halfword fields)\cr
+|x.hh.b0|, |x.hh.b1|, |x.hh|&.|rh|&(two quarterword fields, one halfword
+ field)\cr
+|x.qqqq.b0|, |x.qqqq.b1|, |x.qqqq|&.|b2|, |x.qqqq.b3|\hskip-100pt
+ &\qquad\qquad\qquad(four quarterword fields)\cr}}$$
+This is somewhat cumbersome to write, and not very readable either, but
+macros will be used to make the notation shorter and more transparent.
+The \PASCAL\ code below gives a formal definition of |memory_word| and
+its subsidiary types, using packed variant records. \TeX\ makes no
+assumptions about the relative positions of the fields within a word.
+
+Since we are assuming 32-bit integers, a halfword must contain at least
+16 bits, and a quarterword must contain at least 8 bits.
+@^system dependencies@>
+But it doesn't hurt to have more bits; for example, with enough 36-bit
+words you might be able to have |mem_max| as large as 262142, which is
+eight times as much memory as anybody had during the first four years of
+\TeX's existence.
+
+N.B.: Valuable memory space will be dreadfully wasted unless \TeX\ is compiled
+by a \PASCAL\ that packs all of the |memory_word| variants into
+the space of a single integer. This means, for example, that |glue_ratio|
+words should be |short_real| instead of |real| on some computers. Some
+\PASCAL\ compilers will pack an integer whose subrange is `|0..255|' into
+an eight-bit field, but others insist on allocating space for an additional
+sign bit; on such systems you can get 256 values into a quarterword only
+if the subrange is `|-128..127|'.
+
+The present implementation tries to accommodate as many variations as possible,
+so it makes few assumptions. If integers having the subrange
+`|min_quarterword..max_quarterword|' can be packed into a quarterword,
+and if integers having the subrange `|min_halfword..max_halfword|'
+can be packed into a halfword, everything should work satisfactorily.
+
+It is usually most efficient to have |min_quarterword=min_halfword=0|,
+so one should try to achieve this unless it causes a severe problem.
+The values defined here are recommended for most 32-bit computers.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+
+@ Here are the inequalities that the quarterword and halfword values
+must satisfy (or rather, the inequalities that they mustn't satisfy):
+
+@<Check the ``constant''...@>=
+init if (mem_min<>mem_bot)or(mem_max<>mem_top) then bad:=10;@+tini@;@/
+if (mem_min>mem_bot)or(mem_max<mem_top) then bad:=10;
+if (min_quarterword>0)or(max_quarterword<127) then bad:=11;
+if (min_halfword>0)or(max_halfword<32767) then bad:=12;
+if (min_quarterword<min_halfword)or@|
+ (max_quarterword>max_halfword) then bad:=13;
+if (mem_min<min_halfword)or(mem_max>=max_halfword)or@|
+ (mem_bot-mem_min>max_halfword+1) then bad:=14;
+if (font_base<min_quarterword)or(font_max>max_quarterword) then bad:=15;
+if font_max>font_base+256 then bad:=16;
+if (save_size>max_halfword)or(max_strings>max_halfword) then bad:=17;
+if buf_size>max_halfword then bad:=18;
+if max_quarterword-min_quarterword<255 then bad:=19;
+
+@ The operation of adding or subtracting |min_quarterword| occurs quite
+frequently in \TeX, so it is convenient to abbreviate this operation
+by using the macros |qi| and |qo| for input and output to and from
+quarterword format.
+
+The inner loop of \TeX\ will run faster with respect to compilers
+that don't optimize expressions like `|x+0|' and `|x-0|', if these
+macros are simplified in the obvious way when |min_quarterword=0|.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+
+@ The reader should study the following definitions closely:
+@^system dependencies@>
+
+@d sc==int {|scaled| data is equivalent to |integer|}
+
+@<Types...@>=
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@!two_halves = packed record@;@/
+ @!rh:halfword;
+ case two_choices of
+ 1: (@!lh:halfword);
+ 2: (@!b0:quarterword; @!b1:quarterword);
+ end;
+@!four_quarters = packed record@;@/
+ @!b0:quarterword;
+ @!b1:quarterword;
+ @!b2:quarterword;
+ @!b3:quarterword;
+ end;
+@!memory_word = record@;@/
+ case four_choices of
+ 1: (@!int:integer);
+ 2: (@!gr:glue_ratio);
+ 3: (@!hh:two_halves);
+ 4: (@!qqqq:four_quarters);
+ end;
+@!word_file = file of memory_word;
+
+@ When debugging, we may want to print a |memory_word| without knowing
+what type it is; so we print it in all modes.
+@^dirty \PASCAL@>@^debugging@>
+
+@p @!debug procedure print_word(@!w:memory_word);
+ {prints |w| in all ways}
+begin print_int(w.int); print_char(" ");@/
+print_scaled(w.sc); print_char(" ");@/
+print_scaled(round(unity*float(w.gr))); print_ln;@/
+@^real multiplication@>
+print_int(w.hh.lh); print_char("="); print_int(w.hh.b0); print_char(":");
+print_int(w.hh.b1); print_char(";"); print_int(w.hh.rh); print_char(" ");@/
+print_int(w.qqqq.b0); print_char(":"); print_int(w.qqqq.b1); print_char(":");
+print_int(w.qqqq.b2); print_char(":"); print_int(w.qqqq.b3);
+end;
+gubed
+
+@* \[9] Dynamic memory allocation.
+The \TeX\ system does nearly all of its own memory allocation, so that it
+can readily be transported into environments that do not have automatic
+facilities for strings, garbage collection, etc., and so that it can be in
+control of what error messages the user receives. The dynamic storage
+requirements of \TeX\ are handled by providing a large array |mem| in
+which consecutive blocks of words are used as nodes by the \TeX\ routines.
+
+Pointer variables are indices into this array, or into another array
+called |eqtb| that will be explained later. A pointer variable might
+also be a special flag that lies outside the bounds of |mem|, so we
+allow pointers to assume any |halfword| value. The minimum halfword
+value represents a null pointer. \TeX\ does not assume that |mem[null]| exists.
+
+@d pointer==halfword {a flag or a location in |mem| or |eqtb|}
+@d null==min_halfword {the null pointer}
+
+@<Glob...@>=
+@!temp_ptr:pointer; {a pointer variable for occasional emergency use}
+
+@ The |mem| array is divided into two regions that are allocated separately,
+but the dividing line between these two regions is not fixed; they grow
+together until finding their ``natural'' size in a particular job.
+Locations less than or equal to |lo_mem_max| are used for storing
+variable-length records consisting of two or more words each. This region
+is maintained using an algorithm similar to the one described in exercise
+2.5--19 of {\sl The Art of Computer Programming}. However, no size field
+appears in the allocated nodes; the program is responsible for knowing the
+relevant size when a node is freed. Locations greater than or equal to
+|hi_mem_min| are used for storing one-word records; a conventional
+\.{AVAIL} stack is used for allocation in this region.
+
+Locations of |mem| between |mem_bot| and |mem_top| may be dumped as part
+of preloaded format files, by the \.{INITEX} preprocessor.
+@.INITEX@>
+Production versions of \TeX\ may extend the memory at both ends in order to
+provide more space; locations between |mem_min| and |mem_bot| are always
+used for variable-size nodes, and locations between |mem_top| and |mem_max|
+are always used for single-word nodes.
+
+The key pointers that govern |mem| allocation have a prescribed order:
+$$\advance\thickmuskip-2mu
+\hbox{|null<=mem_min<=mem_bot<lo_mem_max<
+ hi_mem_min<mem_top<=mem_end<=mem_max|.}$$
+
+Empirical tests show that the present implementation of \TeX\ tends to
+spend about 9\pct! of its running time allocating nodes, and about 6\pct!
+deallocating them after their use.
+
+@<Glob...@>=
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@!lo_mem_max : pointer; {the largest location of variable-size memory in use}
+@!hi_mem_min : pointer; {the smallest location of one-word memory in use}
+
+@ In order to study the memory requirements of particular applications, it
+is possible to prepare a version of \TeX\ that keeps track of current and
+maximum memory usage. When code between the delimiters |@!stat| $\ldots$
+|tats| is not ``commented out,'' \TeX\ will run a bit slower but it will
+report these statistics when |tracing_stats| is sufficiently large.
+
+@<Glob...@>=
+@!var_used, @!dyn_used : integer; {how much memory is in use}
+
+@ Let's consider the one-word memory region first, since it's the
+simplest. The pointer variable |mem_end| holds the highest-numbered location
+of |mem| that has ever been used. The free locations of |mem| that
+occur between |hi_mem_min| and |mem_end|, inclusive, are of type
+|two_halves|, and we write |info(p)| and |link(p)| for the |lh|
+and |rh| fields of |mem[p]| when it is of this type. The single-word
+free locations form a linked list
+$$|avail|,\;\hbox{|link(avail)|},\;\hbox{|link(link(avail))|},\;\ldots$$
+terminated by |null|.
+
+@d link(#) == mem[#].hh.rh {the |link| field of a memory word}
+@d info(#) == mem[#].hh.lh {the |info| field of a memory word}
+
+@<Glob...@>=
+@!avail : pointer; {head of the list of available one-word nodes}
+@!mem_end : pointer; {the last one-word node used in |mem|}
+
+@ If memory is exhausted, it might mean that the user has forgotten
+a right brace. We will define some procedures later that try to help
+pinpoint the trouble.
+
+@p @<Declare the procedure called |show_token_list|@>@/
+@<Declare the procedure called |runaway|@>
+
+@ The function |get_avail| returns a pointer to a new one-word node whose
+|link| field is null. However, \TeX\ will halt if there is no more room left.
+@^inner loop@>
+
+If the available-space list is empty, i.e., if |avail=null|,
+we try first to increase |mem_end|. If that cannot be done, i.e., if
+|mem_end=mem_max|, we try to decrease |hi_mem_min|. If that cannot be
+done, i.e., if |hi_mem_min=lo_mem_max+1|, we have to quit.
+
+@p function get_avail : pointer; {single-word node allocation}
+var p:pointer; {the new node being got}
+begin p:=avail; {get top location in the |avail| stack}
+if p<>null then avail:=link(avail) {and pop it off}
+else if mem_end<mem_max then {or go into virgin territory}
+ begin incr(mem_end); p:=mem_end;
+ end
+else begin decr(hi_mem_min); p:=hi_mem_min;
+ if hi_mem_min<=lo_mem_max then
+ begin runaway; {if memory is exhausted, display possible runaway text}
+ overflow("main memory size",mem_max+1-mem_min);
+ {quit; all one-word nodes are busy}
+@:TeX capacity exceeded main memory size}{\quad main memory size@>
+ end;
+ end;
+link(p):=null; {provide an oft-desired initialization of the new node}
+@!stat incr(dyn_used);@+tats@;{maintain statistics}
+get_avail:=p;
+end;
+
+@ Conversely, a one-word node is recycled by calling |free_avail|.
+This routine is part of \TeX's ``inner loop,'' so we want it to be fast.
+@^inner loop@>
+
+@d free_avail(#)== {single-word node liberation}
+ begin link(#):=avail; avail:=#;
+ @!stat decr(dyn_used);@+tats@/
+ end
+
+@ There's also a |fast_get_avail| routine, which saves the procedure-call
+overhead at the expense of extra programming. This routine is used in
+the places that would otherwise account for the most calls of |get_avail|.
+@^inner loop@>
+
+@d fast_get_avail(#)==@t@>@;@/
+ begin #:=avail; {avoid |get_avail| if possible, to save time}
+ if #=null then #:=get_avail
+ else begin avail:=link(#); link(#):=null;
+ @!stat incr(dyn_used);@+tats@/
+ end;
+ end
+
+@ The procedure |flush_list(p)| frees an entire linked list of
+one-word nodes that starts at position |p|.
+@^inner loop@>
+
+@p procedure flush_list(@!p:pointer); {makes list of single-word nodes
+ available}
+var @!q,@!r:pointer; {list traversers}
+begin if p<>null then
+ begin r:=p;
+ repeat q:=r; r:=link(r); @!stat decr(dyn_used);@+tats@/
+ until r=null; {now |q| is the last node on the list}
+ link(q):=avail; avail:=p;
+ end;
+end;
+
+@ The available-space list that keeps track of the variable-size portion
+of |mem| is a nonempty, doubly-linked circular list of empty nodes,
+pointed to by the roving pointer |rover|.
+
+Each empty node has size 2 or more; the first word contains the special
+value |max_halfword| in its |link| field and the size in its |info| field;
+the second word contains the two pointers for double linking.
+
+Each nonempty node also has size 2 or more. Its first word is of type
+|two_halves|\kern-1pt, and its |link| field is never equal to |max_halfword|.
+Otherwise there is complete flexibility with respect to the contents
+of its other fields and its other words.
+
+(We require |mem_max<max_halfword| because terrible things can happen
+when |max_halfword| appears in the |link| field of a nonempty node.)
+
+@d empty_flag == max_halfword {the |link| of an empty variable-size node}
+@d is_empty(#) == (link(#)=empty_flag) {tests for empty node}
+@d node_size == info {the size field in empty variable-size nodes}
+@d llink(#) == info(#+1) {left link in doubly-linked list of empty nodes}
+@d rlink(#) == link(#+1) {right link in doubly-linked list of empty nodes}
+
+@<Glob...@>=
+@!rover : pointer; {points to some node in the list of empties}
+
+@ A call to |get_node| with argument |s| returns a pointer to a new node
+of size~|s|, which must be 2~or more. The |link| field of the first word
+of this new node is set to null. An overflow stop occurs if no suitable
+space exists.
+
+If |get_node| is called with $s=2^{30}$, it simply merges adjacent free
+areas and returns the value |max_halfword|.
+
+@p function get_node(@!s:integer):pointer; {variable-size node allocation}
+label found,exit,restart;
+var p:pointer; {the node currently under inspection}
+@!q:pointer; {the node physically after node |p|}
+@!r:integer; {the newly allocated node, or a candidate for this honor}
+@!t:integer; {temporary register}
+begin restart: p:=rover; {start at some free node in the ring}
+repeat @<Try to allocate within node |p| and its physical successors,
+ and |goto found| if allocation was possible@>;
+@^inner loop@>
+p:=rlink(p); {move to the next node in the ring}
+until p=rover; {repeat until the whole list has been traversed}
+if s=@'10000000000 then
+ begin get_node:=max_halfword; return;
+ end;
+if lo_mem_max+2<hi_mem_min then if lo_mem_max+2<=mem_bot+max_halfword then
+ @<Grow more variable-size memory and |goto restart|@>;
+overflow("main memory size",mem_max+1-mem_min);
+ {sorry, nothing satisfactory is left}
+@:TeX capacity exceeded main memory size}{\quad main memory size@>
+found: link(r):=null; {this node is now nonempty}
+@!stat var_used:=var_used+s; {maintain usage statistics}
+tats@;@/
+get_node:=r;
+exit:end;
+
+@ The lower part of |mem| grows by 1000 words at a time, unless
+we are very close to going under. When it grows, we simply link
+a new node into the available-space list. This method of controlled
+growth helps to keep the |mem| usage consecutive when \TeX\ is
+implemented on ``virtual memory'' systems.
+@^virtual memory@>
+
+@<Grow more variable-size memory and |goto restart|@>=
+begin if hi_mem_min-lo_mem_max>=1998 then t:=lo_mem_max+1000
+else t:=lo_mem_max+1+(hi_mem_min-lo_mem_max) div 2;
+ {|lo_mem_max+2<=t<hi_mem_min|}
+p:=llink(rover); q:=lo_mem_max; rlink(p):=q; llink(rover):=q;@/
+if t>mem_bot+max_halfword then t:=mem_bot+max_halfword;
+rlink(q):=rover; llink(q):=p; link(q):=empty_flag; node_size(q):=t-lo_mem_max;@/
+lo_mem_max:=t; link(lo_mem_max):=null; info(lo_mem_max):=null;
+rover:=q; goto restart;
+end
+
+@ Empirical tests show that the routine in this section performs a
+node-merging operation about 0.75 times per allocation, on the average,
+after which it finds that |r>p+1| about 95\pct! of the time.
+
+@<Try to allocate...@>=
+q:=p+node_size(p); {find the physical successor}
+@^inner loop@>
+while is_empty(q) do {merge node |p| with node |q|}
+ begin t:=rlink(q);
+ if q=rover then rover:=t;
+ llink(t):=llink(q); rlink(llink(q)):=t;@/
+ q:=q+node_size(q);
+ end;
+r:=q-s;
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+if r=p then if rlink(p)<>p then
+ @<Allocate entire node |p| and |goto found|@>;
+node_size(p):=q-p {reset the size in case it grew}
+
+@ @<Allocate from the top...@>=
+begin node_size(p):=r-p; {store the remaining size}
+@^inner loop@>
+rover:=p; {start searching here next time}
+goto found;
+end
+
+@ Here we delete node |p| from the ring, and let |rover| rove around.
+
+@<Allocate entire...@>=
+begin rover:=rlink(p); t:=llink(p);
+llink(rover):=t; rlink(t):=rover;
+goto found;
+end
+
+@ Conversely, when some variable-size node |p| of size |s| is no longer needed,
+the operation |free_node(p,s)| will make its words available, by inserting
+|p| as a new empty node just before where |rover| now points.
+@^inner loop@>
+
+@p procedure free_node(@!p:pointer; @!s:halfword); {variable-size node
+ liberation}
+var q:pointer; {|llink(rover)|}
+begin node_size(p):=s; link(p):=empty_flag;
+q:=llink(rover); llink(p):=q; rlink(p):=rover; {set both links}
+llink(rover):=p; rlink(q):=p; {insert |p| into the ring}
+@!stat var_used:=var_used-s;@+tats@;{maintain statistics}
+end;
+
+@ Just before \.{INITEX} writes out the memory, it sorts the doubly linked
+available space list. The list is probably very short at such times, so a
+simple insertion sort is used. The smallest available location will be
+pointed to by |rover|, the next-smallest by |rlink(rover)|, etc.
+
+@p @!init procedure sort_avail; {sorts the available variable-size nodes
+ by location}
+var p,@!q,@!r: pointer; {indices into |mem|}
+@!old_rover:pointer; {initial |rover| setting}
+begin p:=get_node(@'10000000000); {merge adjacent free areas}
+p:=rlink(rover); rlink(rover):=max_halfword; old_rover:=rover;
+while p<>old_rover do @<Sort \(p)|p| into the list starting at |rover|
+ and advance |p| to |rlink(p)|@>;
+p:=rover;
+while rlink(p)<>max_halfword do
+ begin llink(rlink(p)):=p; p:=rlink(p);
+ end;
+rlink(p):=rover; llink(rover):=p;
+end;
+tini
+
+@ The following |while| loop is guaranteed to
+terminate, since the list that starts at
+|rover| ends with |max_halfword| during the sorting procedure.
+
+@<Sort \(p)|p|...@>=
+if p<rover then
+ begin q:=p; p:=rlink(q); rlink(q):=rover; rover:=q;
+ end
+else begin q:=rover;
+ while rlink(q)<p do q:=rlink(q);
+ r:=rlink(p); rlink(p):=rlink(q); rlink(q):=p; p:=r;
+ end
+
+@* \[10] Data structures for boxes and their friends.
+From the computer's standpoint, \TeX's chief mission is to create
+horizontal and vertical lists. We shall now investigate how the elements
+of these lists are represented internally as nodes in the dynamic memory.
+
+A horizontal or vertical list is linked together by |link| fields in
+the first word of each node. Individual nodes represent boxes, glue,
+penalties, or special things like discretionary hyphens; because of this
+variety, some nodes are longer than others, and we must distinguish different
+kinds of nodes. We do this by putting a `|type|' field in the first word,
+together with the link and an optional `|subtype|'.
+
+@d type(#) == mem[#].hh.b0 {identifies what kind of node this is}
+@d subtype(#) == mem[#].hh.b1 {secondary identification in some cases}
+
+@ A |@!char_node|, which represents a single character, is the most important
+kind of node because it accounts for the vast majority of all boxes.
+Special precautions are therefore taken to ensure that a |char_node| does
+not take up much memory space. Every such node is one word long, and in fact
+it is identifiable by this property, since other kinds of nodes have at least
+two words, and they appear in |mem| locations less than |hi_mem_min|.
+This makes it possible to omit the |type| field in a |char_node|, leaving
+us room for two bytes that identify a |font| and a |character| within
+that font.
+
+Note that the format of a |char_node| allows for up to 256 different
+fonts and up to 256 characters per font; but most implementations will
+probably limit the total number of fonts to fewer than 75 per job,
+and most fonts will stick to characters whose codes are
+less than 128 (since higher codes
+are more difficult to access on most keyboards).
+
+Extensions of \TeX\ intended for oriental languages will need even more
+than $256\times256$ possible characters, when we consider different sizes
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+and styles of type. It is suggested that Chinese and Japanese fonts be
+handled by representing such characters in two consecutive |char_node|
+entries: The first of these has |font=font_base|, and its |link| points
+to the second;
+the second identifies the font and the character dimensions.
+The saving feature about oriental characters is that most of them have
+the same box dimensions. The |character| field of the first |char_node|
+is a ``\\{charext}'' that distinguishes between graphic symbols whose
+dimensions are identical for typesetting purposes. (See the \MF\ manual.)
+Such an extension of \TeX\ would not be difficult; further details are
+left to the reader.
+
+In order to make sure that the |character| code fits in a quarterword,
+\TeX\ adds the quantity |min_quarterword| to the actual code.
+
+Character nodes appear only in horizontal lists, never in vertical lists.
+
+@d is_char_node(#) == (#>=hi_mem_min)
+ {does the argument point to a |char_node|?}
+@d font == type {the font code in a |char_node|}
+@d character == subtype {the character code in a |char_node|}
+
+@ An |hlist_node| stands for a box that was made from a horizontal list.
+Each |hlist_node| is seven words long, and contains the following fields
+(in addition to the mandatory |type| and |link|, which we shall not
+mention explicitly when discussing the other node types): The |height| and
+|width| and |depth| are scaled integers denoting the dimensions of the
+box. There is also a |shift_amount| field, a scaled integer indicating
+how much this box should be lowered (if it appears in a horizontal list),
+or how much it should be moved to the right (if it appears in a vertical
+list). There is a |list_ptr| field, which points to the beginning of the
+list from which this box was fabricated; if |list_ptr| is |null|, the box
+is empty. Finally, there are three fields that represent the setting of
+the glue: |glue_set(p)| is a word of type |glue_ratio| that represents
+the proportionality constant for glue setting; |glue_sign(p)| is
+|stretching| or |shrinking| or |normal| depending on whether or not the
+glue should stretch or shrink or remain rigid; and |glue_order(p)|
+specifies the order of infinity to which glue setting applies (|normal|,
+|fil|, |fill|, or |filll|). The |subtype| field is not used.
+
+@d hlist_node=0 {|type| of hlist nodes}
+@d box_node_size=7 {number of words to allocate for a box node}
+@d width_offset=1 {position of |width| field in a box node}
+@d depth_offset=2 {position of |depth| field in a box node}
+@d height_offset=3 {position of |height| field in a box node}
+@d width(#) == mem[#+width_offset].sc {width of the box, in sp}
+@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp}
+@d height(#) == mem[#+height_offset].sc {height of the box, in sp}
+@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp}
+@d list_offset=5 {position of |list_ptr| field in a box node}
+@d list_ptr(#) == link(#+list_offset) {beginning of the list inside the box}
+@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
+@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
+@d normal=0 {the most common case when several cases are named}
+@d stretching = 1 {glue setting applies to the stretch components}
+@d shrinking = 2 {glue setting applies to the shrink components}
+@d glue_offset = 6 {position of |glue_set| in a box node}
+@d glue_set(#) == mem[#+glue_offset].gr
+ {a word of type |glue_ratio| for glue setting}
+
+@ The |new_null_box| function returns a pointer to an |hlist_node| in
+which all subfields have the values corresponding to `\.{\\hbox\{\}}'.
+The |subtype| field is set to |min_quarterword|, since that's the desired
+|span_count| value if this |hlist_node| is changed to an |unset_node|.
+
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+new_null_box:=p;
+end;
+
+@ A |vlist_node| is like an |hlist_node| in all respects except that it
+contains a vertical list.
+
+@d vlist_node=1 {|type| of vlist nodes}
+
+@ A |rule_node| stands for a solid black rectangle; it has |width|,
+|depth|, and |height| fields just as in an |hlist_node|. However, if
+any of these dimensions is $-2^{30}$, the actual value will be determined
+by running the rule up to the boundary of the innermost enclosing box.
+This is called a ``running dimension.'' The |width| is never running in
+an hlist; the |height| and |depth| are never running in a~vlist.
+
+@d rule_node=2 {|type| of rule nodes}
+@d rule_node_size=4 {number of words to allocate for a rule node}
+@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
+@d is_running(#) == (#=null_flag) {tests for a running dimension}
+
+@ A new rule node is delivered by the |new_rule| function. It
+makes all the dimensions ``running,'' so you have to change the
+ones that are not allowed to run.
+
+@p function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+new_rule:=p;
+end;
+
+@ Insertions are represented by |ins_node| records, where the |subtype|
+indicates the corresponding box number. For example, `\.{\\insert 250}'
+leads to an |ins_node| whose |subtype| is |250+min_quarterword|.
+The |height| field of an |ins_node| is slightly misnamed; it actually holds
+the natural height plus depth of the vertical list being inserted.
+The |depth| field holds the |split_max_depth| to be used in case this
+insertion is split, and the |split_top_ptr| points to the corresponding
+|split_top_skip|. The |float_cost| field holds the |floating_penalty| that
+will be used if this insertion floats to a subsequent page after a
+split insertion of the same class. There is one more field, the
+|ins_ptr|, which points to the beginning of the vlist for the insertion.
+
+@d ins_node=3 {|type| of insertion nodes}
+@d ins_node_size=5 {number of words to allocate for an insertion}
+@d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used}
+@d ins_ptr(#)==info(#+4) {the vertical list to be inserted}
+@d split_top_ptr(#)==link(#+4) {the |split_top_skip| to be used}
+
+@ A |mark_node| has a |mark_ptr| field that points to the reference count
+of a token list that contains the user's \.{\\mark} text.
+This field occupies a full word instead of a halfword, because
+there's nothing to put in the other halfword; it is easier in \PASCAL\ to
+use the full word than to risk leaving garbage in the unused half.
+
+@d mark_node=4 {|type| of a mark node}
+@d small_node_size=2 {number of words to allocate for most node types}
+@d mark_ptr(#)==mem[#+1].int {head of the token list for a mark}
+
+@ An |adjust_node|, which occurs only in horizontal lists,
+specifies material that will be moved out into the surrounding
+vertical list; i.e., it is used to implement \TeX's `\.{\\vadjust}'
+operation. The |adjust_ptr| field points to the vlist containing this
+material.
+
+@d adjust_node=5 {|type| of an adjust node}
+@d adjust_ptr==mark_ptr {vertical list to be moved out of horizontal list}
+
+@ A |ligature_node|, which occurs only in horizontal lists, specifies
+a character that was fabricated from the interaction of two or more
+actual characters. The second word of the node, which is called the
+|lig_char| word, contains |font| and |character| fields just as in a
+|char_node|. The characters that generated the ligature have not been
+forgotten, since they are needed for diagnostic messages and for
+hyphenation; the |lig_ptr| field points to a linked list of character
+nodes for all original characters that have been deleted. (This list
+might be empty if the characters that generated the ligature were
+retained in other nodes.)
+
+The |subtype| field is 0, plus 2 and/or 1 if the original source of the
+ligature included implicit left and/or right boundaries.
+
+@d ligature_node=6 {|type| of a ligature node}
+@d lig_char(#)==#+1 {the word where the ligature is to be found}
+@d lig_ptr(#)==link(lig_char(#)) {the list of characters}
+
+@ The |new_ligature| function creates a ligature node having given
+contents of the |font|, |character|, and |lig_ptr| fields. We also have
+a |new_lig_item| function, which returns a two-word node having a given
+|character| field. Such nodes are used for temporary processing as ligatures
+are being created.
+
+@p function new_ligature(@!f,@!c:quarterword; @!q:pointer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=ligature_node;
+font(lig_char(p)):=f; character(lig_char(p)):=c; lig_ptr(p):=q;
+subtype(p):=0; new_ligature:=p;
+end;
+@#
+function new_lig_item(@!c:quarterword):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); character(p):=c; lig_ptr(p):=null;
+new_lig_item:=p;
+end;
+
+@ A |disc_node|, which occurs only in horizontal lists, specifies a
+``dis\-cretion\-ary'' line break. If such a break occurs at node |p|, the text
+that starts at |pre_break(p)| will precede the break, the text that starts at
+|post_break(p)| will follow the break, and text that appears in the next
+|replace_count(p)| nodes will be ignored. For example, an ordinary
+discretionary hyphen, indicated by `\.{\\-}', yields a |disc_node| with
+|pre_break| pointing to a |char_node| containing a hyphen, |post_break=null|,
+and |replace_count=0|. All three of the discretionary texts must be
+lists that consist entirely of character, kern, box, rule, and ligature nodes.
+
+If |pre_break(p)=null|, the |ex_hyphen_penalty| will be charged for this
+break. Otherwise the |hyphen_penalty| will be charged. The texts will
+actually be substituted into the list by the line-breaking algorithm if it
+decides to make the break, and the discretionary node will disappear at
+that time; thus, the output routine sees only discretionaries that were
+not chosen.
+
+@d disc_node=7 {|type| of a discretionary node}
+@d replace_count==subtype {how many subsequent nodes to replace}
+@d pre_break==llink {text that precedes a discretionary break}
+@d post_break==rlink {text that follows a discretionary break}
+
+@p function new_disc:pointer; {creates an empty |disc_node|}
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=disc_node;
+replace_count(p):=0; pre_break(p):=null; post_break(p):=null;
+new_disc:=p;
+end;
+
+@ A |whatsit_node| is a wild card reserved for extensions to \TeX. The
+|subtype| field in its first word says what `\\{whatsit}' it is, and
+implicitly determines the node size (which must be 2 or more) and the
+format of the remaining words. When a |whatsit_node| is encountered
+in a list, special actions are invoked; knowledgeable people who are
+careful not to mess up the rest of \TeX\ are able to make \TeX\ do new
+things by adding code at the end of the program. For example, there
+might be a `\TeX nicolor' extension to specify different colors of ink,
+@^extensions to \TeX@>
+and the whatsit node might contain the desired parameters.
+
+The present implementation of \TeX\ treats the features associated with
+`\.{\\write}' and `\.{\\special}' as if they were extensions, in order to
+illustrate how such routines might be coded. We shall defer further
+discussion of extensions until the end of this program.
+
+@d whatsit_node=8 {|type| of special extension nodes}
+
+@ A |math_node|, which occurs only in horizontal lists, appears before and
+after mathematical formulas. The |subtype| field is |before| before the
+formula and |after| after it. There is a |width| field, which represents
+the amount of surrounding space inserted by \.{\\mathsurround}.
+
+@d math_node=9 {|type| of a math node}
+@d before=0 {|subtype| for math node that introduces a formula}
+@d after=1 {|subtype| for math node that winds up a formula}
+
+@p function new_math(@!w:scaled;@!s:small_number):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=math_node;
+subtype(p):=s; width(p):=w; new_math:=p;
+end;
+
+@ \TeX\ makes use of the fact that |hlist_node|, |vlist_node|,
+|rule_node|, |ins_node|, |mark_node|, |adjust_node|, |ligature_node|,
+|disc_node|, |whatsit_node|, and |math_node| are at the low end of the
+type codes, by permitting a break at glue in a list if and only if the
+|type| of the previous node is less than |math_node|. Furthermore, a
+node is discarded after a break if its type is |math_node| or~more.
+
+@d precedes_break(#)==(type(#)<math_node)
+@d non_discardable(#)==(type(#)<math_node)
+
+@ A |glue_node| represents glue in a list. However, it is really only
+a pointer to a separate glue specification, since \TeX\ makes use of the
+fact that many essentially identical nodes of glue are usually present.
+If |p| points to a |glue_node|, |glue_ptr(p)| points to
+another packet of words that specify the stretch and shrink components, etc.
+
+Glue nodes also serve to represent leaders; the |subtype| is used to
+distinguish between ordinary glue (which is called |normal|) and the three
+kinds of leaders (which are called |a_leaders|, |c_leaders|, and |x_leaders|).
+The |leader_ptr| field points to a rule node or to a box node containing the
+leaders; it is set to |null| in ordinary glue nodes.
+
+Many kinds of glue are computed from \TeX's ``skip'' parameters, and
+it is helpful to know which parameter has led to a particular glue node.
+Therefore the |subtype| is set to indicate the source of glue, whenever
+it originated as a parameter. We will be defining symbolic names for the
+parameter numbers later (e.g., |line_skip_code=0|, |baseline_skip_code=1|,
+etc.); it suffices for now to say that the |subtype| of parametric glue
+will be the same as the parameter number, plus~one.
+
+In math formulas there are two more possibilities for the |subtype| in a
+glue node: |mu_glue| denotes an \.{\\mskip} (where the units are scaled \.{mu}
+instead of scaled \.{pt}); and |cond_math_glue| denotes the `\.{\\nonscript}'
+feature that cancels the glue node immediately following if it appears
+in a subscript.
+
+@d glue_node=10 {|type| of node that points to a glue specification}
+@d cond_math_glue=98 {special |subtype| to suppress glue in the next node}
+@d mu_glue=99 {|subtype| for math glue}
+@d a_leaders=100 {|subtype| for aligned leaders}
+@d c_leaders=101 {|subtype| for centered leaders}
+@d x_leaders=102 {|subtype| for expanded leaders}
+@d glue_ptr==llink {pointer to a glue specification}
+@d leader_ptr==rlink {pointer to box or rule node for leaders}
+
+@ A glue specification has a halfword reference count in its first word,
+@^reference counts@>
+representing |null| plus the number of glue nodes that point to it (less one).
+Note that the reference count appears in the same position as
+the |link| field in list nodes; this is the field that is initialized
+to |null| when a node is allocated, and it is also the field that is flagged
+by |empty_flag| in empty nodes.
+
+Glue specifications also contain three |scaled| fields, for the |width|,
+|stretch|, and |shrink| dimensions. Finally, there are two one-byte
+fields called |stretch_order| and |shrink_order|; these contain the
+orders of infinity (|normal|, |fil|, |fill|, or |filll|)
+corresponding to the stretch and shrink values.
+
+@d glue_spec_size=4 {number of words to allocate for a glue specification}
+@d glue_ref_count(#) == link(#) {reference count of a glue specification}
+@d stretch(#) == mem[#+2].sc {the stretchability of this glob of glue}
+@d shrink(#) == mem[#+3].sc {the shrinkability of this glob of glue}
+@d stretch_order == type {order of infinity for stretching}
+@d shrink_order == subtype {order of infinity for shrinking}
+@d fil=1 {first-order infinity}
+@d fill=2 {second-order infinity}
+@d filll=3 {third-order infinity}
+
+@<Types...@>=
+@!glue_ord=normal..filll; {infinity to the 0, 1, 2, or 3 power}
+
+@ Here is a function that returns a pointer to a copy of a glue spec.
+The reference count in the copy is |null|, because there is assumed
+to be exactly one reference to the new specification.
+
+@p function new_spec(@!p:pointer):pointer; {duplicates a glue specification}
+var q:pointer; {the new spec}
+begin q:=get_node(glue_spec_size);@/
+mem[q]:=mem[p]; glue_ref_count(q):=null;@/
+width(q):=width(p); stretch(q):=stretch(p); shrink(q):=shrink(p);
+new_spec:=q;
+end;
+
+@ And here's a function that creates a glue node for a given parameter
+identified by its code number; for example,
+|new_param_glue(line_skip_code)| returns a pointer to a glue node for the
+current \.{\\lineskip}.
+
+@p function new_param_glue(@!n:small_number):pointer;
+var p:pointer; {the new node}
+@!q:pointer; {the glue specification}
+begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=n+1;
+leader_ptr(p):=null;@/
+q:=@<Current |mem| equivalent of glue parameter number |n|@>@t@>;
+glue_ptr(p):=q; incr(glue_ref_count(q));
+new_param_glue:=p;
+end;
+
+@ Glue nodes that are more or less anonymous are created by |new_glue|,
+whose argument points to a glue specification.
+
+@p function new_glue(@!q:pointer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=normal;
+leader_ptr(p):=null; glue_ptr(p):=q; incr(glue_ref_count(q));
+new_glue:=p;
+end;
+
+@ Still another subroutine is needed: this one is sort of a combination
+of |new_param_glue| and |new_glue|. It creates a glue node for one of
+the current glue parameters, but it makes a fresh copy of the glue
+specification, since that specification will probably be subject to change,
+while the parameter will stay put. The global variable |temp_ptr| is
+set to the address of the new spec.
+
+@p function new_skip_param(@!n:small_number):pointer;
+var p:pointer; {the new node}
+begin temp_ptr:=new_spec(@<Current |mem| equivalent of glue parameter...@>);
+p:=new_glue(temp_ptr); glue_ref_count(temp_ptr):=null; subtype(p):=n+1;
+new_skip_param:=p;
+end;
+
+@ A |kern_node| has a |width| field to specify a (normally negative)
+amount of spacing. This spacing correction appears in horizontal lists
+between letters like A and V when the font designer said that it looks
+better to move them closer together or further apart. A kern node can
+also appear in a vertical list, when its `|width|' denotes additional
+spacing in the vertical direction. The |subtype| is either |normal| (for
+kerns inserted from font information or math mode calculations) or |explicit|
+(for kerns inserted from \.{\\kern} and \.{\\/} commands) or |acc_kern|
+(for kerns inserted from non-math accents) or |mu_glue| (for kerns
+inserted from \.{\\mkern} specifications in math formulas).
+
+@d kern_node=11 {|type| of a kern node}
+@d explicit=1 {|subtype| of kern nodes from \.{\\kern} and \.{\\/}}
+@d acc_kern=2 {|subtype| of kern nodes from accents}
+
+@ The |new_kern| function creates a kern node having a given width.
+
+@p function new_kern(@!w:scaled):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=kern_node;
+subtype(p):=normal;
+width(p):=w;
+new_kern:=p;
+end;
+
+@ A |penalty_node| specifies the penalty associated with line or page
+breaking, in its |penalty| field. This field is a fullword integer, but
+the full range of integer values is not used: Any penalty |>=10000| is
+treated as infinity, and no break will be allowed for such high values.
+Similarly, any penalty |<=-10000| is treated as negative infinity, and a
+break will be forced.
+
+@d penalty_node=12 {|type| of a penalty node}
+@d inf_penalty=inf_bad {``infinite'' penalty value}
+@d eject_penalty=-inf_penalty {``negatively infinite'' penalty value}
+@d penalty(#) == mem[#+1].int {the added cost of breaking a list here}
+
+@ Anyone who has been reading the last few sections of the program will
+be able to guess what comes next.
+
+@p function new_penalty(@!m:integer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=penalty_node;
+subtype(p):=0; {the |subtype| is not used}
+penalty(p):=m; new_penalty:=p;
+end;
+
+@ You might think that we have introduced enough node types by now. Well,
+almost, but there is one more: An |unset_node| has nearly the same format
+as an |hlist_node| or |vlist_node|; it is used for entries in \.{\\halign}
+or \.{\\valign} that are not yet in their final form, since the box
+dimensions are their ``natural'' sizes before any glue adjustment has been
+made. The |glue_set| word is not present; instead, we have a |glue_stretch|
+field, which contains the total stretch of order |glue_order| that is
+present in the hlist or vlist being boxed.
+Similarly, the |shift_amount| field is replaced by a |glue_shrink| field,
+containing the total shrink of order |glue_sign| that is present.
+The |subtype| field is called |span_count|; an unset box typically
+contains the data for |qo(span_count)+1| columns.
+Unset nodes will be changed to box nodes when alignment is completed.
+
+@d unset_node=13 {|type| for an unset node}
+@d glue_stretch(#)==mem[#+glue_offset].sc {total stretch in an unset node}
+@d glue_shrink==shift_amount {total shrink in an unset node}
+@d span_count==subtype {indicates the number of spanned columns}
+
+@ In fact, there are still more types coming. When we get to math formula
+processing we will see that a |style_node| has |type=14|; and a number
+of larger type codes will also be defined, for use in math mode only.
+
+@ Warning: If any changes are made to these data structure layouts, such as
+changing any of the node sizes or even reordering the words of nodes,
+the |copy_node_list| procedure and the memory initialization code
+below may have to be changed. Such potentially dangerous parts of the
+program are listed in the index under `data structure assumptions'.
+@!@^data structure assumptions@>
+However, other references to the nodes are made symbolically in terms of
+the \.{WEB} macro definitions above, so that format changes will leave
+\TeX's other algorithms intact.
+@^system dependencies@>
+
+@* \[11] Memory layout.
+Some areas of |mem| are dedicated to fixed usage, since static allocation is
+more efficient than dynamic allocation when we can get away with it. For
+example, locations |mem_bot| to |mem_bot+3| are always used to store the
+specification for glue that is `\.{0pt plus 0pt minus 0pt}'. The
+following macro definitions accomplish the static allocation by giving
+symbolic names to the fixed positions. Static variable-size nodes appear
+in locations |mem_bot| through |lo_mem_stat_max|, and static single-word nodes
+appear in locations |hi_mem_stat_min| through |mem_top|, inclusive. It is
+harmless to let |lig_trick| and |garbage| share the same location of |mem|.
+
+@d zero_glue==mem_bot {specification for \.{0pt plus 0pt minus 0pt}}
+@d fil_glue==zero_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
+@d fill_glue==fil_glue+glue_spec_size {\.{0pt plus 1fill minus 0pt}}
+@d ss_glue==fill_glue+glue_spec_size {\.{0pt plus 1fil minus 1fil}}
+@d fil_neg_glue==ss_glue+glue_spec_size {\.{0pt plus -1fil minus 0pt}}
+@d lo_mem_stat_max==fil_neg_glue+glue_spec_size-1 {largest statically
+ allocated word in the variable-size |mem|}
+@#
+@d page_ins_head==mem_top {list of insertion data for current page}
+@d contrib_head==mem_top-1 {vlist of items not yet on current page}
+@d page_head==mem_top-2 {vlist for current page}
+@d temp_head==mem_top-3 {head of a temporary list of some kind}
+@d hold_head==mem_top-4 {head of a temporary list of another kind}
+@d adjust_head==mem_top-5 {head of adjustment list returned by |hpack|}
+@d active==mem_top-7 {head of active list in |line_break|, needs two words}
+@d align_head==mem_top-8 {head of preamble list for alignments}
+@d end_span==mem_top-9 {tail of spanned-width lists}
+@d omit_template==mem_top-10 {a constant token list}
+@d null_list==mem_top-11 {permanently empty list}
+@d lig_trick==mem_top-12 {a ligature masquerading as a |char_node|}
+@d garbage==mem_top-12 {used for scrap information}
+@d backup_head==mem_top-13 {head of token list built by |scan_keyword|}
+@d hi_mem_stat_min==mem_top-13 {smallest statically allocated word in
+ the one-word |mem|}
+@d hi_mem_stat_usage=14 {the number of one-word nodes always present}
+
+@ The following code gets |mem| off to a good start, when \TeX\ is
+initializing itself the slow~way.
+
+@<Local variables for init...@>=
+@!k:integer; {index into |mem|, |eqtb|, etc.}
+
+@ @<Initialize table entries...@>=
+for k:=mem_bot+1 to lo_mem_stat_max do mem[k].sc:=0;
+ {all glue dimensions are zeroed}
+@^data structure assumptions@>
+k:=mem_bot;@+while k<=lo_mem_stat_max do
+ {set first words of glue specifications}
+ begin glue_ref_count(k):=null+1;
+ stretch_order(k):=normal; shrink_order(k):=normal;
+ k:=k+glue_spec_size;
+ end;
+stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
+stretch(fill_glue):=unity; stretch_order(fill_glue):=fill;@/
+stretch(ss_glue):=unity; stretch_order(ss_glue):=fil;@/
+shrink(ss_glue):=unity; shrink_order(ss_glue):=fil;@/
+stretch(fil_neg_glue):=-unity; stretch_order(fil_neg_glue):=fil;@/
+rover:=lo_mem_stat_max+1;
+link(rover):=empty_flag; {now initialize the dynamic memory}
+node_size(rover):=1000; {which is a 1000-word available node}
+llink(rover):=rover; rlink(rover):=rover;@/
+lo_mem_max:=rover+1000; link(lo_mem_max):=null; info(lo_mem_max):=null;@/
+for k:=hi_mem_stat_min to mem_top do
+ mem[k]:=mem[lo_mem_max]; {clear list heads}
+@<Initialize the special list heads and constant nodes@>;
+avail:=null; mem_end:=mem_top;
+hi_mem_min:=hi_mem_stat_min; {initialize the one-word memory}
+var_used:=lo_mem_stat_max+1-mem_bot; dyn_used:=hi_mem_stat_usage;
+ {initialize statistics}
+
+@ If \TeX\ is extended improperly, the |mem| array might get screwed up.
+For example, some pointers might be wrong, or some ``dead'' nodes might not
+have been freed when the last reference to them disappeared. Procedures
+|check_mem| and |search_mem| are available to help diagnose such
+problems. These procedures make use of two arrays called |free| and
+|was_free| that are present only if \TeX's debugging routines have
+been included. (You may want to decrease the size of |mem| while you
+@^debugging@>
+are debugging.)
+
+@<Glob...@>=
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [mem_min..mem_max] of boolean;
+ {previously free cells}
+@t\hskip10pt@>@!was_mem_end,@!was_lo_max,@!was_hi_min: pointer;
+ {previous |mem_end|, |lo_mem_max|, and |hi_mem_min|}
+@t\hskip10pt@>@!panicking:boolean; {do we want to check memory constantly?}
+gubed
+
+@ @<Set initial...@>=
+@!debug was_mem_end:=mem_min; {indicate that everything was previously free}
+was_lo_max:=mem_min; was_hi_min:=mem_max;
+panicking:=false;
+gubed
+
+@ Procedure |check_mem| makes sure that the available space lists of
+|mem| are well formed, and it optionally prints out all locations
+that are reserved now but were free the last time this procedure was called.
+
+@p @!debug procedure check_mem(@!print_locs : boolean);
+label done1,done2; {loop exits}
+var p,@!q:pointer; {current locations of interest in |mem|}
+@!clobbered:boolean; {is something amiss?}
+begin for p:=mem_min to lo_mem_max do free[p]:=false; {you can probably
+ do this faster}
+for p:=hi_mem_min to mem_end do free[p]:=false; {ditto}
+@<Check single-word |avail| list@>;
+@<Check variable-size |avail| list@>;
+@<Check flags of unavailable nodes@>;
+if print_locs then @<Print newly busy locations@>;
+for p:=mem_min to lo_mem_max do was_free[p]:=free[p];
+for p:=hi_mem_min to mem_end do was_free[p]:=free[p];
+ {|was_free:=free| might be faster}
+was_mem_end:=mem_end; was_lo_max:=lo_mem_max; was_hi_min:=hi_mem_min;
+end;
+gubed
+
+@ @<Check single-word...@>=
+p:=avail; q:=null; clobbered:=false;
+while p<>null do
+ begin if (p>mem_end)or(p<hi_mem_min) then clobbered:=true
+ else if free[p] then clobbered:=true;
+ if clobbered then
+ begin print_nl("AVAIL list clobbered at ");
+@.AVAIL list clobbered...@>
+ print_int(q); goto done1;
+ end;
+ free[p]:=true; q:=p; p:=link(q);
+ end;
+done1:
+
+@ @<Check variable-size...@>=
+p:=rover; q:=null; clobbered:=false;
+repeat if (p>=lo_mem_max)or(p<mem_min) then clobbered:=true
+ else if (rlink(p)>=lo_mem_max)or(rlink(p)<mem_min) then clobbered:=true
+ else if not(is_empty(p))or(node_size(p)<2)or@|
+ (p+node_size(p)>lo_mem_max)or@| (llink(rlink(p))<>p) then clobbered:=true;
+ if clobbered then
+ begin print_nl("Double-AVAIL list clobbered at ");
+ print_int(q); goto done2;
+ end;
+for q:=p to p+node_size(p)-1 do {mark all locations free}
+ begin if free[q] then
+ begin print_nl("Doubly free location at ");
+@.Doubly free location...@>
+ print_int(q); goto done2;
+ end;
+ free[q]:=true;
+ end;
+q:=p; p:=rlink(p);
+until p=rover;
+done2:
+
+@ @<Check flags...@>=
+p:=mem_min;
+while p<=lo_mem_max do {node |p| should not be empty}
+ begin if is_empty(p) then
+ begin print_nl("Bad flag at "); print_int(p);
+@.Bad flag...@>
+ end;
+ while (p<=lo_mem_max) and not free[p] do incr(p);
+ while (p<=lo_mem_max) and free[p] do incr(p);
+ end
+
+@ @<Print newly busy...@>=
+begin print_nl("New busy locs:");
+for p:=mem_min to lo_mem_max do
+ if not free[p] and ((p>was_lo_max) or was_free[p]) then
+ begin print_char(" "); print_int(p);
+ end;
+for p:=hi_mem_min to mem_end do
+ if not free[p] and
+ ((p<was_hi_min) or (p>was_mem_end) or was_free[p]) then
+ begin print_char(" "); print_int(p);
+ end;
+end
+
+@ The |search_mem| procedure attempts to answer the question ``Who points
+to node~|p|?'' In doing so, it fetches |link| and |info| fields of |mem|
+that might not be of type |two_halves|. Strictly speaking, this is
+@^dirty \PASCAL@>
+undefined in \PASCAL, and it can lead to ``false drops'' (words that seem to
+point to |p| purely by coincidence). But for debugging purposes, we want
+to rule out the places that do {\sl not\/} point to |p|, so a few false
+drops are tolerable.
+
+@p @!debug procedure search_mem(@!p:pointer); {look for pointers to |p|}
+var q:integer; {current position being searched}
+begin for q:=mem_min to lo_mem_max do
+ begin if link(q)=p then
+ begin print_nl("LINK("); print_int(q); print_char(")");
+ end;
+ if info(q)=p then
+ begin print_nl("INFO("); print_int(q); print_char(")");
+ end;
+ end;
+for q:=hi_mem_min to mem_end do
+ begin if link(q)=p then
+ begin print_nl("LINK("); print_int(q); print_char(")");
+ end;
+ if info(q)=p then
+ begin print_nl("INFO("); print_int(q); print_char(")");
+ end;
+ end;
+@<Search |eqtb| for equivalents equal to |p|@>;
+@<Search |save_stack| for equivalents that point to |p|@>;
+@<Search |hyph_list| for pointers to |p|@>;
+end;
+gubed
+
+@* \[12] Displaying boxes.
+We can reinforce our knowledge of the data structures just introduced
+by considering two procedures that display a list in symbolic form.
+The first of these, called |short_display|, is used in ``overfull box''
+messages to give the top-level description of a list. The other one,
+called |show_node_list|, prints a detailed description of exactly what
+is in the data structure.
+
+The philosophy of |short_display| is to ignore the fine points about exactly
+what is inside boxes, except that ligatures and discretionary breaks are
+expanded. As a result, |short_display| is a recursive procedure, but the
+recursion is never more than one level deep.
+@^recursion@>
+
+A global variable |font_in_short_display| keeps track of the font code that
+is assumed to be present when |short_display| begins; deviations from this
+font will be printed.
+
+@<Glob...@>=
+@!font_in_short_display:integer; {an internal font number}
+
+@ Boxes, rules, inserts, whatsits, marks, and things in general that are
+sort of ``complicated'' are indicated only by printing `\.{[]}'.
+
+@p procedure short_display(@!p:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+begin while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ print_ASCII(qo(character(p)));
+ end;
+ end
+ else @<Print a short indication of the contents of node |p|@>;
+ p:=link(p);
+ end;
+end;
+
+@ @<Print a short indication of the contents of node |p|@>=
+case type(p) of
+hlist_node,vlist_node,ins_node,whatsit_node,mark_node,adjust_node,
+ unset_node: print("[]");
+rule_node: print_char("|");
+glue_node: if glue_ptr(p)<>zero_glue then print_char(" ");
+math_node: print_char("$");
+ligature_node: short_display(lig_ptr(p));
+disc_node: begin short_display(pre_break(p));
+ short_display(post_break(p));@/
+ n:=replace_count(p);
+ while n>0 do
+ begin if link(p)<>null then p:=link(p);
+ decr(n);
+ end;
+ end;
+othercases do_nothing
+endcases
+
+@ The |show_node_list| routine requires some auxiliary subroutines: one to
+print a font-and-character combination, one to print a token list without
+its reference count, and one to print a rule dimension.
+
+@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+begin if p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); print_ASCII(qo(character(p)));
+ end;
+end;
+@#
+procedure print_mark(@!p:integer); {prints token list data in braces}
+begin print_char("{");
+if (p<hi_mem_min)or(p>mem_end) then print_esc("CLOBBERED.")
+else show_token_list(link(p),null,max_print_line-10);
+print_char("}");
+end;
+@#
+procedure print_rule_dimen(@!d:scaled); {prints dimension in rule node}
+begin if is_running(d) then print_char("*") else print_scaled(d);
+@.*\relax@>
+end;
+
+@ Then there is a subroutine that prints glue stretch and shrink, possibly
+followed by the name of finite units:
+
+@p procedure print_glue(@!d:scaled;@!order:integer;@!s:str_number);
+ {prints a glue component}
+begin print_scaled(d);
+if (order<normal)or(order>filll) then print("foul")
+else if order>normal then
+ begin print("fil");
+ while order>fil do
+ begin print_char("l"); decr(order);
+ end;
+ end
+else if s<>0 then print(s);
+end;
+
+@ The next subroutine prints a whole glue specification.
+
+@p procedure print_spec(@!p:integer;@!s:str_number);
+ {prints a glue specification}
+begin if (p<mem_min)or(p>=lo_mem_max) then print_char("*")
+@.*\relax@>
+else begin print_scaled(width(p));
+ if s<>0 then print(s);
+ if stretch(p)<>0 then
+ begin print(" plus "); print_glue(stretch(p),stretch_order(p),s);
+ end;
+ if shrink(p)<>0 then
+ begin print(" minus "); print_glue(shrink(p),shrink_order(p),s);
+ end;
+ end;
+end;
+
+@ We also need to declare some procedures that appear later in this
+documentation.
+
+@p @<Declare procedures needed for displaying the elements of mlists@>@;
+@<Declare the procedure called |print_skip_param|@>
+
+@ Since boxes can be inside of boxes, |show_node_list| is inherently recursive,
+@^recursion@>
+up to a given maximum number of levels. The history of nesting is indicated
+by the current string, which will be printed at the beginning of each line;
+the length of this string, namely |cur_length|, is the depth of nesting.
+
+Recursive calls on |show_node_list| therefore use the following pattern:
+
+@d node_list_display(#)==
+ begin append_char("."); show_node_list(#); flush_char;
+ end {|str_room| need not be checked; see |show_box| below}
+
+@ A global variable called |depth_threshold| is used to record the maximum
+depth of nesting for which |show_node_list| will show information. If we
+have |depth_threshold=0|, for example, only the top level information will
+be given and no sublists will be traversed. Another global variable, called
+|breadth_max|, tells the maximum number of items to show at each level;
+|breadth_max| had better be positive, or you won't see anything.
+
+@<Glob...@>=
+@!depth_threshold : integer; {maximum nesting depth in box displays}
+@!breadth_max : integer; {maximum number of items shown at the same list level}
+
+@ Now we are ready for |show_node_list| itself. This procedure has been
+written to be ``extra robust'' in the sense that it should not crash or get
+into a loop even if the data structures have been messed up by bugs in
+the rest of the program. You can safely call its parent routine
+|show_box(p)| for arbitrary values of |p| when you are debugging \TeX.
+However, in the presence of bad data, the procedure may
+@^dirty \PASCAL@>@^debugging@>
+fetch a |memory_word| whose variant is different from the way it was stored;
+for example, it might try to read |mem[p].hh| when |mem[p]|
+contains a scaled integer, if |p| is a pointer that has been
+clobbered or chosen at random.
+
+@p procedure show_node_list(@!p:integer); {prints a node list symbolically}
+label exit;
+var n:integer; {the number of items already printed at this level}
+@!g:real; {a glue ratio, as a floating point number}
+begin if cur_length>depth_threshold then
+ begin if p>null then print(" []");
+ {indicate that there's been some truncation}
+ return;
+ end;
+n:=0;
+while p>mem_min do
+ begin print_ln; print_current_string; {display the nesting history}
+ if p>mem_end then {pointer out of range}
+ begin print("Bad link, display aborted."); return;
+@.Bad link...@>
+ end;
+ incr(n); if n>breadth_max then {time to stop}
+ begin print("etc."); return;
+@.etc@>
+ end;
+ @<Display node |p|@>;
+ p:=link(p);
+ end;
+exit:
+end;
+
+@ @<Display node |p|@>=
+if is_char_node(p) then print_font_and_char(p)
+else case type(p) of
+ hlist_node,vlist_node,unset_node: @<Display box |p|@>;
+ rule_node: @<Display rule |p|@>;
+ ins_node: @<Display insertion |p|@>;
+ whatsit_node: @<Display the whatsit node |p|@>;
+ glue_node: @<Display glue |p|@>;
+ kern_node: @<Display kern |p|@>;
+ math_node: @<Display math node |p|@>;
+ ligature_node: @<Display ligature |p|@>;
+ penalty_node: @<Display penalty |p|@>;
+ disc_node: @<Display discretionary |p|@>;
+ mark_node: @<Display mark |p|@>;
+ adjust_node: @<Display adjustment |p|@>;
+ @t\4@>@<Cases of |show_node_list| that arise in mlists only@>@;
+ othercases print("Unknown node type!")
+ endcases
+
+@ @<Display box |p|@>=
+begin if type(p)=hlist_node then print_esc("h")
+else if type(p)=vlist_node then print_esc("v")
+else print_esc("unset");
+print("box("); print_scaled(height(p)); print_char("+");
+print_scaled(depth(p)); print(")x"); print_scaled(width(p));
+if type(p)=unset_node then
+ @<Display special fields of the unset node |p|@>
+else begin @<Display the value of |glue_set(p)|@>;
+ if shift_amount(p)<>0 then
+ begin print(", shifted "); print_scaled(shift_amount(p));
+ end;
+ end;
+node_list_display(list_ptr(p)); {recursive call}
+end
+
+@ @<Display special fields of the unset node |p|@>=
+begin if span_count(p)<>min_quarterword then
+ begin print(" ("); print_int(qo(span_count(p))+1);
+ print(" columns)");
+ end;
+if glue_stretch(p)<>0 then
+ begin print(", stretch "); print_glue(glue_stretch(p),glue_order(p),0);
+ end;
+if glue_shrink(p)<>0 then
+ begin print(", shrink "); print_glue(glue_shrink(p),glue_sign(p),0);
+ end;
+end
+
+@ The code will have to change in this place if |glue_ratio| is
+a structured type instead of an ordinary |real|. Note that this routine
+should avoid arithmetic errors even if the |glue_set| field holds an
+arbitrary random value. The following code assumes that a properly
+formed nonzero |real| number has absolute value $2^{20}$ or more when
+it is regarded as an integer; this precaution was adequate to prevent
+floating point underflow on the author's computer.
+@^system dependencies@>
+@^dirty \PASCAL@>
+
+@<Display the value of |glue_set(p)|@>=
+g:=float(glue_set(p));
+if (g<>float_constant(0))and(glue_sign(p)<>normal) then
+ begin print(", glue set ");
+ if glue_sign(p)=shrinking then print("- ");
+ if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
+ else if abs(g)>float_constant(20000) then
+ begin if g>float_constant(0) then print_char(">")
+ else print("< -");
+ print_glue(20000*unity,glue_order(p),0);
+ end
+ else print_glue(round(unity*g),glue_order(p),0);
+@^real multiplication@>
+ end
+
+@ @<Display rule |p|@>=
+begin print_esc("rule("); print_rule_dimen(height(p)); print_char("+");
+print_rule_dimen(depth(p)); print(")x"); print_rule_dimen(width(p));
+end
+
+@ @<Display insertion |p|@>=
+begin print_esc("insert"); print_int(qo(subtype(p)));
+print(", natural size "); print_scaled(height(p));
+print("; split("); print_spec(split_top_ptr(p),0);
+print_char(","); print_scaled(depth(p));
+print("); float cost "); print_int(float_cost(p));
+node_list_display(ins_ptr(p)); {recursive call}
+end
+
+@ @<Display glue |p|@>=
+if subtype(p)>=a_leaders then @<Display leaders |p|@>
+else begin print_esc("glue");
+ if subtype(p)<>normal then
+ begin print_char("(");
+ if subtype(p)<cond_math_glue then
+ print_skip_param(subtype(p)-1)
+ else if subtype(p)=cond_math_glue then print_esc("nonscript")
+ else print_esc("mskip");
+ print_char(")");
+ end;
+ if subtype(p)<>cond_math_glue then
+ begin print_char(" ");
+ if subtype(p)<cond_math_glue then print_spec(glue_ptr(p),0)
+ else print_spec(glue_ptr(p),"mu");
+ end;
+ end
+
+@ @<Display leaders |p|@>=
+begin print_esc("");
+if subtype(p)=c_leaders then print_char("c")
+else if subtype(p)=x_leaders then print_char("x");
+print("leaders "); print_spec(glue_ptr(p),0);
+node_list_display(leader_ptr(p)); {recursive call}
+end
+
+@ An ``explicit'' kern value is indicated implicitly by an explicit space.
+
+@<Display kern |p|@>=
+if subtype(p)<>mu_glue then
+ begin print_esc("kern");
+ if subtype(p)<>normal then print_char(" ");
+ print_scaled(width(p));
+ if subtype(p)=acc_kern then print(" (for accent)");
+@.for accent@>
+ end
+else begin print_esc("mkern"); print_scaled(width(p)); print("mu");
+ end
+
+@ @<Display math node |p|@>=
+begin print_esc("math");
+if subtype(p)=before then print("on")
+else print("off");
+if width(p)<>0 then
+ begin print(", surrounded "); print_scaled(width(p));
+ end;
+end
+
+@ @<Display ligature |p|@>=
+begin print_font_and_char(lig_char(p)); print(" (ligature ");
+if subtype(p)>1 then print_char("|");
+font_in_short_display:=font(lig_char(p)); short_display(lig_ptr(p));
+if odd(subtype(p)) then print_char("|");
+print_char(")");
+end
+
+@ @<Display penalty |p|@>=
+begin print_esc("penalty "); print_int(penalty(p));
+end
+
+@ The |post_break| list of a discretionary node is indicated by a prefixed
+`\.{\char'174}' instead of the `\..' before the |pre_break| list.
+
+@<Display discretionary |p|@>=
+begin print_esc("discretionary");
+if replace_count(p)>0 then
+ begin print(" replacing "); print_int(replace_count(p));
+ end;
+node_list_display(pre_break(p)); {recursive call}
+append_char("|"); show_node_list(post_break(p)); flush_char; {recursive call}
+end
+
+@ @<Display mark |p|@>=
+begin print_esc("mark"); print_mark(mark_ptr(p));
+end
+
+@ @<Display adjustment |p|@>=
+begin print_esc("vadjust"); node_list_display(adjust_ptr(p)); {recursive call}
+end
+
+@ The recursive machinery is started by calling |show_box|.
+@^recursion@>
+
+@p procedure show_box(@!p:pointer);
+begin @<Assign the values |depth_threshold:=show_box_depth| and
+ |breadth_max:=show_box_breadth|@>;
+if breadth_max<=0 then breadth_max:=5;
+if pool_ptr+depth_threshold>=pool_size then
+ depth_threshold:=pool_size-pool_ptr-1;
+ {now there's enough room for prefix string}
+show_node_list(p); {the show starts at |p|}
+print_ln;
+end;
+
+@* \[13] Destroying boxes.
+When we are done with a node list, we are obliged to return it to free
+storage, including all of its sublists. The recursive procedure
+|flush_node_list| does this for us.
+
+@ First, however, we shall consider two non-recursive procedures that do
+simpler tasks. The first of these, |delete_token_ref|, is called when
+a pointer to a token list's reference count is being removed. This means
+that the token list should disappear if the reference count was |null|,
+otherwise the count should be decreased by one.
+@^reference counts@>
+
+@d token_ref_count(#) == info(#) {reference count preceding a token list}
+
+@p procedure delete_token_ref(@!p:pointer); {|p| points to the reference count
+ of a token list that is losing one reference}
+begin if token_ref_count(p)=null then flush_list(p)
+else decr(token_ref_count(p));
+end;
+
+@ Similarly, |delete_glue_ref| is called when a pointer to a glue
+specification is being withdrawn.
+@^reference counts@>
+@d fast_delete_glue_ref(#)==@t@>@;@/
+ begin if glue_ref_count(#)=null then free_node(#,glue_spec_size)
+ else decr(glue_ref_count(#));
+ end
+
+@p procedure delete_glue_ref(@!p:pointer); {|p| points to a glue specification}
+fast_delete_glue_ref(p);
+
+@ Now we are ready to delete any node list, recursively.
+In practice, the nodes deleted are usually charnodes (about 2/3 of the time),
+and they are glue nodes in about half of the remaining cases.
+@^recursion@>
+
+@p procedure flush_node_list(@!p:pointer); {erase list of nodes starting at |p|}
+label done; {go here when node |p| has been freed}
+var q:pointer; {successor to node |p|}
+begin while p<>null do
+@^inner loop@>
+ begin q:=link(p);
+ if is_char_node(p) then free_avail(p)
+ else begin case type(p) of
+ hlist_node,vlist_node,unset_node: begin flush_node_list(list_ptr(p));
+ free_node(p,box_node_size); goto done;
+ end;
+ rule_node: begin free_node(p,rule_node_size); goto done;
+ end;
+ ins_node: begin flush_node_list(ins_ptr(p));
+ delete_glue_ref(split_top_ptr(p));
+ free_node(p,ins_node_size); goto done;
+ end;
+ whatsit_node: @<Wipe out the whatsit node |p| and |goto done|@>;
+ glue_node: begin fast_delete_glue_ref(glue_ptr(p));
+ if leader_ptr(p)<>null then flush_node_list(leader_ptr(p));
+ end;
+ kern_node,math_node,penalty_node: do_nothing;
+ ligature_node: flush_node_list(lig_ptr(p));
+ mark_node: delete_token_ref(mark_ptr(p));
+ disc_node: begin flush_node_list(pre_break(p));
+ flush_node_list(post_break(p));
+ end;
+ adjust_node: flush_node_list(adjust_ptr(p));
+ @t\4@>@<Cases of |flush_node_list| that arise in mlists only@>@;
+ othercases confusion("flushing")
+@:this can't happen flushing}{\quad flushing@>
+ endcases;@/
+ free_node(p,small_node_size);
+ done:end;
+ p:=q;
+ end;
+end;
+
+@* \[14] Copying boxes.
+Another recursive operation that acts on boxes is sometimes needed: The
+procedure |copy_node_list| returns a pointer to another node list that has
+the same structure and meaning as the original. Note that since glue
+specifications and token lists have reference counts, we need not make
+copies of them. Reference counts can never get too large to fit in a
+halfword, since each pointer to a node is in a different memory address,
+and the total number of memory addresses fits in a halfword.
+@^recursion@>
+@^reference counts@>
+
+(Well, there actually are also references from outside |mem|; if the
+|save_stack| is made arbitrarily large, it would theoretically be possible
+to break \TeX\ by overflowing a reference count. But who would want to do that?)
+
+@d add_token_ref(#)==incr(token_ref_count(#)) {new reference to a token list}
+@d add_glue_ref(#)==incr(glue_ref_count(#)) {new reference to a glue spec}
+
+@ The copying procedure copies words en masse without bothering
+to look at their individual fields. If the node format changes---for
+example, if the size is altered, or if some link field is moved to another
+relative position---then this code may need to be changed too.
+@^data structure assumptions@>
+
+@p function copy_node_list(@!p:pointer):pointer; {makes a duplicate of the
+ node list that starts at |p| and returns a pointer to the new list}
+var h:pointer; {temporary head of copied list}
+@!q:pointer; {previous position in new list}
+@!r:pointer; {current node being fabricated for new list}
+@!words:0..5; {number of words remaining to be copied}
+begin h:=get_avail; q:=h;
+while p<>null do
+ begin @<Make a copy of node |p| in node |r|@>;
+ link(q):=r; q:=r; p:=link(p);
+ end;
+link(q):=null; q:=link(h); free_avail(h);
+copy_node_list:=q;
+end;
+
+@ @<Make a copy of node |p|...@>=
+words:=1; {this setting occurs in more branches than any other}
+if is_char_node(p) then r:=get_avail
+else @<Case statement to copy different types and set |words| to the number
+ of initial words not yet copied@>;
+while words>0 do
+ begin decr(words); mem[r+words]:=mem[p+words];
+ end
+
+@ @<Case statement to copy...@>=
+case type(p) of
+hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size);
+ mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
+ list_ptr(r):=copy_node_list(list_ptr(p)); {this affects |mem[r+5]|}
+ words:=5;
+ end;
+rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size;
+ end;
+ins_node: begin r:=get_node(ins_node_size); mem[r+4]:=mem[p+4];
+ add_glue_ref(split_top_ptr(p));
+ ins_ptr(r):=copy_node_list(ins_ptr(p)); {this affects |mem[r+4]|}
+ words:=ins_node_size-1;
+ end;
+whatsit_node:@<Make a partial copy of the whatsit node |p| and make |r|
+ point to it; set |words| to the number of initial words not yet copied@>;
+glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p));
+ glue_ptr(r):=glue_ptr(p); leader_ptr(r):=copy_node_list(leader_ptr(p));
+ end;
+kern_node,math_node,penalty_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+ligature_node: begin r:=get_node(small_node_size);
+ mem[lig_char(r)]:=mem[lig_char(p)]; {copy |font| and |character|}
+ lig_ptr(r):=copy_node_list(lig_ptr(p));
+ end;
+disc_node: begin r:=get_node(small_node_size);
+ pre_break(r):=copy_node_list(pre_break(p));
+ post_break(r):=copy_node_list(post_break(p));
+ end;
+mark_node: begin r:=get_node(small_node_size); add_token_ref(mark_ptr(p));
+ words:=small_node_size;
+ end;
+adjust_node: begin r:=get_node(small_node_size);
+ adjust_ptr(r):=copy_node_list(adjust_ptr(p));
+ end; {|words=1=small_node_size-1|}
+othercases confusion("copying")
+@:this can't happen copying}{\quad copying@>
+endcases
+
+@* \[15] The command codes.
+Before we can go any further, we need to define symbolic names for the internal
+code numbers that represent the various commands obeyed by \TeX. These codes
+are somewhat arbitrary, but not completely so. For example, the command
+codes for character types are fixed by the language, since a user says,
+e.g., `\.{\\catcode \`\\\${} = 3}' to make \.{\char'44} a math delimiter,
+and the command code |math_shift| is equal to~3. Some other codes have
+been made adjacent so that |case| statements in the program need not consider
+cases that are widely spaced, or so that |case| statements can be replaced
+by |if| statements.
+
+At any rate, here is the list, for future reference. First come the
+``catcode'' commands, several of which share their numeric codes with
+ordinary commands when the catcode cannot emerge from \TeX's scanning routine.
+
+@d escape=0 {escape delimiter (called \.\\ in {\sl The \TeX book\/})}
+@:TeXbook}{\sl The \TeX book@>
+@d relax=0 {do nothing ( \.{\\relax} )}
+@d left_brace=1 {beginning of a group ( \.\{ )}
+@d right_brace=2 {ending of a group ( \.\} )}
+@d math_shift=3 {mathematics shift character ( \.\$ )}
+@d tab_mark=4 {alignment delimiter ( \.\&, \.{\\span} )}
+@d car_ret=5 {end of line ( |carriage_return|, \.{\\cr}, \.{\\crcr} )}
+@d out_param=5 {output a macro parameter}
+@d mac_param=6 {macro parameter symbol ( \.\# )}
+@d sup_mark=7 {superscript ( \.{\char'136} )}
+@d sub_mark=8 {subscript ( \.{\char'137} )}
+@d ignore=9 {characters to ignore ( \.{\^\^@@} )}
+@d endv=9 {end of \<v_j> list in alignment template}
+@d spacer=10 {characters equivalent to blank space ( \.{\ } )}
+@d letter=11 {characters regarded as letters ( \.{A..Z}, \.{a..z} )}
+@d other_char=12 {none of the special character types}
+@d active_char=13 {characters that invoke macros ( \.{\char`\~} )}
+@d par_end=13 {end of paragraph ( \.{\\par} )}
+@d match=13 {match a macro parameter}
+@d comment=14 {characters that introduce comments ( \.\% )}
+@d end_match=14 {end of parameters to macro}
+@d stop=14 {end of job ( \.{\\end}, \.{\\dump} )}
+@d invalid_char=15 {characters that shouldn't appear ( \.{\^\^?} )}
+@d delim_num=15 {specify delimiter numerically ( \.{\\delimiter} )}
+@d max_char_code=15 {largest catcode for individual characters}
+
+@ Next are the ordinary run-of-the-mill command codes. Codes that are
+|min_internal| or more represent internal quantities that might be
+expanded by `\.{\\the}'.
+
+@d char_num=16 {character specified numerically ( \.{\\char} )}
+@d math_char_num=17 {explicit math code ( \.{\\mathchar} )}
+@d mark=18 {mark definition ( \.{\\mark} )}
+@d xray=19 {peek inside of \TeX\ ( \.{\\show}, \.{\\showbox}, etc.~)}
+@d make_box=20 {make a box ( \.{\\box}, \.{\\copy}, \.{\\hbox}, etc.~)}
+@d hmove=21 {horizontal motion ( \.{\\moveleft}, \.{\\moveright} )}
+@d vmove=22 {vertical motion ( \.{\\raise}, \.{\\lower} )}
+@d un_hbox=23 {unglue a box ( \.{\\unhbox}, \.{\\unhcopy} )}
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+@d remove_item=25 {nullify last item ( \.{\\unpenalty},
+ \.{\\unkern}, \.{\\unskip} )}
+@d hskip=26 {horizontal glue ( \.{\\hskip}, \.{\\hfil}, etc.~)}
+@d vskip=27 {vertical glue ( \.{\\vskip}, \.{\\vfil}, etc.~)}
+@d mskip=28 {math glue ( \.{\\mskip} )}
+@d kern=29 {fixed space ( \.{\\kern})}
+@d mkern=30 {math kern ( \.{\\mkern} )}
+@d leader_ship=31 {use a box ( \.{\\shipout}, \.{\\leaders}, etc.~)}
+@d halign=32 {horizontal table alignment ( \.{\\halign} )}
+@d valign=33 {vertical table alignment ( \.{\\valign} )}
+@d no_align=34 {temporary escape from alignment ( \.{\\noalign} )}
+@d vrule=35 {vertical rule ( \.{\\vrule} )}
+@d hrule=36 {horizontal rule ( \.{\\hrule} )}
+@d insert=37 {vlist inserted in box ( \.{\\insert} )}
+@d vadjust=38 {vlist inserted in enclosing paragraph ( \.{\\vadjust} )}
+@d ignore_spaces=39 {gobble |spacer| tokens ( \.{\\ignorespaces} )}
+@d after_assignment=40 {save till assignment is done ( \.{\\afterassignment} )}
+@d after_group=41 {save till group is done ( \.{\\aftergroup} )}
+@d break_penalty=42 {additional badness ( \.{\\penalty} )}
+@d start_par=43 {begin paragraph ( \.{\\indent}, \.{\\noindent} )}
+@d ital_corr=44 {italic correction ( \.{\\/} )}
+@d accent=45 {attach accent in text ( \.{\\accent} )}
+@d math_accent=46 {attach accent in math ( \.{\\mathaccent} )}
+@d discretionary=47 {discretionary texts ( \.{\\-}, \.{\\discretionary} )}
+@d eq_no=48 {equation number ( \.{\\eqno}, \.{\\leqno} )}
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+@d math_comp=50 {component of formula ( \.{\\mathbin}, etc.~)}
+@d limit_switch=51 {diddle limit conventions ( \.{\\displaylimits}, etc.~)}
+@d above=52 {generalized fraction ( \.{\\above}, \.{\\atop}, etc.~)}
+@d math_style=53 {style specification ( \.{\\displaystyle}, etc.~)}
+@d math_choice=54 {choice specification ( \.{\\mathchoice} )}
+@d non_script=55 {conditional math glue ( \.{\\nonscript} )}
+@d vcenter=56 {vertically center a vbox ( \.{\\vcenter} )}
+@d case_shift=57 {force specific case ( \.{\\lowercase}, \.{\\uppercase}~)}
+@d message=58 {send to user ( \.{\\message}, \.{\\errmessage} )}
+@d extension=59 {extensions to \TeX\ ( \.{\\write}, \.{\\special}, etc.~)}
+@d in_stream=60 {files for reading ( \.{\\openin}, \.{\\closein} )}
+@d begin_group=61 {begin local grouping ( \.{\\begingroup} )}
+@d end_group=62 {end local grouping ( \.{\\endgroup} )}
+@d omit=63 {omit alignment template ( \.{\\omit} )}
+@d ex_space=64 {explicit space ( \.{\\\ } )}
+@d no_boundary=65 {suppress boundary ligatures ( \.{\\noboundary} )}
+@d radical=66 {square root and similar signs ( \.{\\radical} )}
+@d end_cs_name=67 {end control sequence ( \.{\\endcsname} )}
+@d min_internal=68 {the smallest code that can follow \.{\\the}}
+@d char_given=68 {character code defined by \.{\\chardef}}
+@d math_given=69 {math code defined by \.{\\mathchardef}}
+@d last_item=70 {most recent item ( \.{\\lastpenalty},
+ \.{\\lastkern}, \.{\\lastskip} )}
+@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}}
+
+@ The next codes are special; they all relate to mode-independent
+assignment of values to \TeX's internal registers or tables.
+Codes that are |max_internal| or less represent internal quantities
+that might be expanded by `\.{\\the}'.
+
+@d toks_register=71 {token list register ( \.{\\toks} )}
+@d assign_toks=72 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
+@d assign_int=73 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
+@d assign_dimen=74 {user-defined length ( \.{\\hsize}, etc.~)}
+@d assign_glue=75 {user-defined glue ( \.{\\baselineskip}, etc.~)}
+@d assign_mu_glue=76 {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
+@d assign_font_dimen=77 {user-defined font dimension ( \.{\\fontdimen} )}
+@d assign_font_int=78 {user-defined font integer ( \.{\\hyphenchar},
+ \.{\\skewchar} )}
+@d set_aux=79 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
+@d set_prev_graf=80 {specify state info ( \.{\\prevgraf} )}
+@d set_page_dimen=81 {specify state info ( \.{\\pagegoal}, etc.~)}
+@d set_page_int=82 {specify state info ( \.{\\deadcycles},
+ \.{\\insertpenalties} )}
+@d set_box_dimen=83 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
+@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
+@d def_code=85 {define a character code ( \.{\\catcode}, etc.~)}
+@d def_family=86 {declare math fonts ( \.{\\textfont}, etc.~)}
+@d set_font=87 {set current font ( font identifiers )}
+@d def_font=88 {define a font file ( \.{\\font} )}
+@d register=89 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d max_internal=89 {the largest code that can follow \.{\\the}}
+@d advance=90 {advance a register or parameter ( \.{\\advance} )}
+@d multiply=91 {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=92 {divide a register or parameter ( \.{\\divide} )}
+@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=94 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
+@d def=97 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=98 {set a box ( \.{\\setbox} )}
+@d hyph_data=99 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d max_command=100 {the largest command code seen at |big_switch|}
+
+@ The remaining command codes are extra special, since they cannot get through
+\TeX's scanner to the main control routine. They have been given values higher
+than |max_command| so that their special nature is easily discernible.
+The ``expandable'' commands come first.
+
+@d undefined_cs=max_command+1 {initial state of most |eq_type| fields}
+@d expand_after=max_command+2 {special expansion ( \.{\\expandafter} )}
+@d no_expand=max_command+3 {special nonexpansion ( \.{\\noexpand} )}
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+@d if_test=max_command+5 {conditional text ( \.{\\if}, \.{\\ifcase}, etc.~)}
+@d fi_or_else=max_command+6 {delimiters for conditionals ( \.{\\else}, etc.~)}
+@d cs_name=max_command+7 {make a control sequence from tokens ( \.{\\csname} )}
+@d convert=max_command+8 {convert to text ( \.{\\number}, \.{\\string}, etc.~)}
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+@d top_bot_mark=max_command+10 {inserted mark ( \.{\\topmark}, etc.~)}
+@d call=max_command+11 {non-long, non-outer control sequence}
+@d long_call=max_command+12 {long, non-outer control sequence}
+@d outer_call=max_command+13 {non-long, outer control sequence}
+@d long_outer_call=max_command+14 {long, outer control sequence}
+@d end_template=max_command+15 {end of an alignment template}
+@d dont_expand=max_command+16 {the following token was marked by \.{\\noexpand}}
+@d glue_ref=max_command+17 {the equivalent points to a glue specification}
+@d shape_ref=max_command+18 {the equivalent points to a parshape specification}
+@d box_ref=max_command+19 {the equivalent points to a box node, or is |null|}
+@d data=max_command+20 {the equivalent is simply a halfword number}
+
+@* \[16] The semantic nest.
+\TeX\ is typically in the midst of building many lists at once. For example,
+when a math formula is being processed, \TeX\ is in math mode and
+working on an mlist; this formula has temporarily interrupted \TeX\ from
+being in horizontal mode and building the hlist of a paragraph; and this
+paragraph has temporarily interrupted \TeX\ from being in vertical mode
+and building the vlist for the next page of a document. Similarly, when a
+\.{\\vbox} occurs inside of an \.{\\hbox}, \TeX\ is temporarily
+interrupted from working in restricted horizontal mode, and it enters
+internal vertical mode. The ``semantic nest'' is a stack that
+keeps track of what lists and modes are currently suspended.
+
+At each level of processing we are in one of six modes:
+
+\yskip\hang|vmode| stands for vertical mode (the page builder);
+
+\hang|hmode| stands for horizontal mode (the paragraph builder);
+
+\hang|mmode| stands for displayed formula mode;
+
+\hang|-vmode| stands for internal vertical mode (e.g., in a \.{\\vbox});
+
+\hang|-hmode| stands for restricted horizontal mode (e.g., in an \.{\\hbox});
+
+\hang|-mmode| stands for math formula mode (not displayed).
+
+\yskip\noindent The mode is temporarily set to zero while processing \.{\\write}
+texts in the |ship_out| routine.
+
+Numeric values are assigned to |vmode|, |hmode|, and |mmode| so that
+\TeX's ``big semantic switch'' can select the appropriate thing to
+do by computing the value |abs(mode)+cur_cmd|, where |mode| is the current
+mode and |cur_cmd| is the current command code.
+
+@d vmode=1 {vertical mode}
+@d hmode=vmode+max_command+1 {horizontal mode}
+@d mmode=hmode+max_command+1 {math mode}
+
+@p procedure print_mode(@!m:integer); {prints the mode represented by |m|}
+begin if m>0 then
+ case m div (max_command+1) of
+ 0:print("vertical");
+ 1:print("horizontal");
+ 2:print("display math");
+ end
+else if m=0 then print("no")
+else case (-m) div (max_command+1) of
+ 0:print("internal vertical");
+ 1:print("restricted horizontal");
+ 2:print("math");
+ end;
+print(" mode");
+end;
+
+@ The state of affairs at any semantic level can be represented by
+five values:
+
+\yskip\hang|mode| is the number representing the semantic mode, as
+just explained.
+
+\yskip\hang|head| is a |pointer| to a list head for the list being built;
+|link(head)| therefore points to the first element of the list, or
+to |null| if the list is empty.
+
+\yskip\hang|tail| is a |pointer| to the final node of the list being
+built; thus, |tail=head| if and only if the list is empty.
+
+\yskip\hang|prev_graf| is the number of lines of the current paragraph that
+have already been put into the present vertical list.
+
+\yskip\hang|aux| is an auxiliary |memory_word| that gives further information
+that is needed to characterize the situation.
+
+\yskip\noindent
+In vertical mode, |aux| is also known as |prev_depth|; it is the scaled
+value representing the depth of the previous box, for use in baseline
+calculations, or it is |<=-1000|pt if the next box on the vertical list is to
+be exempt from baseline calculations. In horizontal mode, |aux| is also
+known as |space_factor| and |clang|; it holds the current space factor used in
+spacing calculations, and the current language used for hyphenation.
+(The value of |clang| is undefined in restricted horizontal mode.)
+In math mode, |aux| is also known as |incompleat_noad|; if
+not |null|, it points to a record that represents the numerator of a
+generalized fraction for which the denominator is currently being formed
+in the current list.
+
+There is also a sixth quantity, |mode_line|, which correlates
+the semantic nest with the user's input; |mode_line| contains the source
+line number at which the current level of nesting was entered. The negative
+of this line number is the |mode_line| at the level of the
+user's output routine.
+
+In horizontal mode, the |prev_graf| field is used for initial language data.
+
+The semantic nest is an array called |nest| that holds the |mode|, |head|,
+|tail|, |prev_graf|, |aux|, and |mode_line| values for all semantic levels
+below the currently active one. Information about the currently active
+level is kept in the global quantities |mode|, |head|, |tail|, |prev_graf|,
+|aux|, and |mode_line|, which live in a \PASCAL\ record that is ready to
+be pushed onto |nest| if necessary.
+
+@d ignore_depth==-65536000 {|prev_depth| value that is ignored}
+
+@<Types...@>=
+@!list_state_record=record@!mode_field:-mmode..mmode;@+
+ @!head_field,@!tail_field: pointer;
+ @!pg_field,@!ml_field: integer;@+
+ @!aux_field: memory_word;
+ end;
+
+@ @d mode==cur_list.mode_field {current mode}
+@d head==cur_list.head_field {header node of current list}
+@d tail==cur_list.tail_field {final node on current list}
+@d prev_graf==cur_list.pg_field {number of paragraph lines accumulated}
+@d aux==cur_list.aux_field {auxiliary data about the current list}
+@d prev_depth==aux.sc {the name of |aux| in vertical mode}
+@d space_factor==aux.hh.lh {part of |aux| in horizontal mode}
+@d clang==aux.hh.rh {the other part of |aux| in horizontal mode}
+@d incompleat_noad==aux.int {the name of |aux| in math mode}
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+
+@<Glob...@>=
+@!nest:array[0..nest_size] of list_state_record;
+@!nest_ptr:0..nest_size; {first unused location of |nest|}
+@!max_nest_stack:0..nest_size; {maximum of |nest_ptr| when pushing}
+@!cur_list:list_state_record; {the ``top'' semantic state}
+@!shown_mode:-mmode..mmode; {most recent mode shown by \.{\\tracingcommands}}
+
+@ Here is a common way to make the current list grow:
+
+@d tail_append(#)==begin link(tail):=#; tail:=link(tail);
+ end
+
+@ We will see later that the vertical list at the bottom semantic level is split
+into two parts; the ``current page'' runs from |page_head| to |page_tail|,
+and the ``contribution list'' runs from |contrib_head| to |tail| of
+semantic level zero. The idea is that contributions are first formed in
+vertical mode, then ``contributed'' to the current page (during which time
+the page-breaking decisions are made). For now, we don't need to know
+any more details about the page-building process.
+
+@<Set init...@>=
+nest_ptr:=0; max_nest_stack:=0;
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+prev_depth:=ignore_depth; mode_line:=0;
+prev_graf:=0; shown_mode:=0;
+@<Start a new current page@>;
+
+@ When \TeX's work on one level is interrupted, the state is saved by
+calling |push_nest|. This routine changes |head| and |tail| so that
+a new (empty) list is begun; it does not change |mode| or |aux|.
+
+@p procedure push_nest; {enter a new semantic level, save the old}
+begin if nest_ptr>max_nest_stack then
+ begin max_nest_stack:=nest_ptr;
+ if nest_ptr=nest_size then overflow("semantic nest size",nest_size);
+@:TeX capacity exceeded semantic nest size}{\quad semantic nest size@>
+ end;
+nest[nest_ptr]:=cur_list; {stack the record}
+incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+end;
+
+@ Conversely, when \TeX\ is finished on the current level, the former
+state is restored by calling |pop_nest|. This routine will never be
+called at the lowest semantic level, nor will it be called unless |head|
+is a node that should be returned to free memory.
+
+@p procedure pop_nest; {leave a semantic level, re-enter the old}
+begin free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+end;
+
+@ Here is a procedure that displays what \TeX\ is working on, at all levels.
+
+@p procedure@?print_totals; forward;@t\2@>
+procedure show_activities;
+var p:0..nest_size; {index into |nest|}
+@!m:-mmode..mmode; {mode}
+@!a:memory_word; {auxiliary}
+@!q,@!r:pointer; {for showing the current page}
+@!t:integer; {ditto}
+begin nest[nest_ptr]:=cur_list; {put the top level into the array}
+print_nl(""); print_ln;
+for p:=nest_ptr downto 0 do
+ begin m:=nest[p].mode_field; a:=nest[p].aux_field;
+ print_nl("### "); print_mode(m);
+ print(" entered at line "); print_int(abs(nest[p].ml_field));
+ if m=hmode then if nest[p].pg_field <> @'40600000 then
+ begin print(" (language"); print_int(nest[p].pg_field mod @'200000);
+ print(":hyphenmin"); print_int(nest[p].pg_field div @'20000000);
+ print_char(","); print_int((nest[p].pg_field div @'200000) mod @'100);
+ print_char(")");
+ end;
+ if nest[p].ml_field<0 then print(" (\output routine)");
+ if p=0 then
+ begin @<Show the status of the current page@>;
+ if link(contrib_head)<>null then
+ print_nl("### recent contributions:");
+ end;
+ show_box(link(nest[p].head_field));
+ @<Show the auxiliary field, |a|@>;
+ end;
+end;
+
+@ @<Show the auxiliary...@>=
+case abs(m) div (max_command+1) of
+0: begin print_nl("prevdepth ");
+ if a.sc<=ignore_depth then print("ignored")
+ else print_scaled(a.sc);
+ if nest[p].pg_field<>0 then
+ begin print(", prevgraf ");
+ print_int(nest[p].pg_field); print(" line");
+ if nest[p].pg_field<>1 then print_char("s");
+ end;
+ end;
+1: begin print_nl("spacefactor "); print_int(a.hh.lh);
+ if m>0 then@+ if a.hh.rh>0 then
+ begin print(", current language "); print_int(a.hh.rh);@+
+ end;
+ end;
+2: if a.int<>null then
+ begin print("this will be denominator of:"); show_box(a.int);@+
+ end;
+end {there are no other cases}
+
+@* \[17] The table of equivalents.
+Now that we have studied the data structures for \TeX's semantic routines,
+we ought to consider the data structures used by its syntactic routines. In
+other words, our next concern will be
+the tables that \TeX\ looks at when it is scanning
+what the user has written.
+
+The biggest and most important such table is called |eqtb|. It holds the
+current ``equivalents'' of things; i.e., it explains what things mean
+or what their current values are, for all quantities that are subject to
+the nesting structure provided by \TeX's grouping mechanism. There are six
+parts to |eqtb|:
+
+\yskip\hangg 1) |eqtb[active_base..(hash_base-1)]| holds the current
+equivalents of single-character control sequences.
+
+\yskip\hangg 2) |eqtb[hash_base..(glue_base-1)]| holds the current
+equivalents of multiletter control sequences.
+
+\yskip\hangg 3) |eqtb[glue_base..(local_base-1)]| holds the current
+equivalents of glue parameters like the current baselineskip.
+
+\yskip\hangg 4) |eqtb[local_base..(int_base-1)]| holds the current
+equivalents of local halfword quantities like the current box registers,
+the current ``catcodes,'' the current font, and a pointer to the current
+paragraph shape.
+
+\yskip\hangg 5) |eqtb[int_base..(dimen_base-1)]| holds the current
+equivalents of fullword integer parameters like the current hyphenation
+penalty.
+
+\yskip\hangg 6) |eqtb[dimen_base..eqtb_size]| holds the current equivalents
+of fullword dimension parameters like the current hsize or amount of
+hanging indentation.
+
+\yskip\noindent Note that, for example, the current amount of
+baselineskip glue is determined by the setting of a particular location
+in region~3 of |eqtb|, while the current meaning of the control sequence
+`\.{\\baselineskip}' (which might have been changed by \.{\\def} or
+\.{\\let}) appears in region~2.
+
+@ Each entry in |eqtb| is a |memory_word|. Most of these words are of type
+|two_halves|, and subdivided into three fields:
+
+\yskip\hangg 1) The |eq_level| (a quarterword) is the level of grouping at
+which this equivalent was defined. If the level is |level_zero|, the
+equivalent has never been defined; |level_one| refers to the outer level
+(outside of all groups), and this level is also used for global
+definitions that never go away. Higher levels are for equivalents that
+will disappear at the end of their group. @^global definitions@>
+
+\yskip\hangg 2) The |eq_type| (another quarterword) specifies what kind of
+entry this is. There are many types, since each \TeX\ primitive like
+\.{\\hbox}, \.{\\def}, etc., has its own special code. The list of
+command codes above includes all possible settings of the |eq_type| field.
+
+\yskip\hangg 3) The |equiv| (a halfword) is the current equivalent value.
+This may be a font number, a pointer into |mem|, or a variety of other
+things.
+
+@d eq_level_field(#)==#.hh.b1
+@d eq_type_field(#)==#.hh.b0
+@d equiv_field(#)==#.hh.rh
+@d eq_level(#)==eq_level_field(eqtb[#]) {level of definition}
+@d eq_type(#)==eq_type_field(eqtb[#]) {command code for equivalent}
+@d equiv(#)==equiv_field(eqtb[#]) {equivalent value}
+@d level_zero=min_quarterword {level for undefined quantities}
+@d level_one=level_zero+1 {outermost level for defined quantities}
+
+@ Many locations in |eqtb| have symbolic names. The purpose of the next
+paragraphs is to define these names, and to set up the initial values of the
+equivalents.
+
+In the first region we have 256 equivalents for ``active characters'' that
+act as control sequences, followed by 256 equivalents for single-character
+control sequences.
+
+Then comes region~2, which corresponds to the hash table that we will
+define later. The maximum address in this region is used for a dummy
+control sequence that is perpetually undefined. There also are several
+locations for control sequences that are perpetually defined
+(since they are used in error recovery).
+
+@d active_base=1 {beginning of region 1, for active character equivalents}
+@d single_base=active_base+256 {equivalents of one-character control sequences}
+@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}}
+@d hash_base=null_cs+1 {beginning of region 2, for the hash table}
+@d frozen_control_sequence=hash_base+hash_size {for error recovery}
+@d frozen_protection=frozen_control_sequence {inaccessible but definable}
+@d frozen_cr=frozen_control_sequence+1 {permanent `\.{\\cr}'}
+@d frozen_end_group=frozen_control_sequence+2 {permanent `\.{\\endgroup}'}
+@d frozen_right=frozen_control_sequence+3 {permanent `\.{\\right}'}
+@d frozen_fi=frozen_control_sequence+4 {permanent `\.{\\fi}'}
+@d frozen_end_template=frozen_control_sequence+5 {permanent `\.{\\endtemplate}'}
+@d frozen_endv=frozen_control_sequence+6 {second permanent `\.{\\endtemplate}'}
+@d frozen_relax=frozen_control_sequence+7 {permanent `\.{\\relax}'}
+@d end_write=frozen_control_sequence+8 {permanent `\.{\\endwrite}'}
+@d frozen_dont_expand=frozen_control_sequence+9
+ {permanent `\.{\\notexpanded:}'}
+@d frozen_null_font=frozen_control_sequence+10
+ {permanent `\.{\\nullfont}'}
+@d font_id_base=frozen_null_font-font_base
+ {begins table of 257 permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+257 {dummy location}
+@d glue_base=undefined_control_sequence+1 {beginning of region 3}
+
+@<Initialize table entries...@>=
+eq_type(undefined_control_sequence):=undefined_cs;
+equiv(undefined_control_sequence):=null;
+eq_level(undefined_control_sequence):=level_zero;
+for k:=active_base to undefined_control_sequence-1 do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+
+@ Here is a routine that displays the current meaning of an |eqtb| entry
+in region 1 or~2. (Similar routines for the other regions will appear
+below.)
+
+@<Show equivalent |n|, in region 1 or 2@>=
+begin sprint_cs(n); print_char("="); print_cmd_chr(eq_type(n),equiv(n));
+if eq_type(n)>=call then
+ begin print_char(":"); show_token_list(link(equiv(n)),null,32);
+ end;
+end
+
+@ Region 3 of |eqtb| contains the 256 \.{\\skip} registers, as well as the
+glue parameters defined here. It is important that the ``muskip''
+parameters have larger numbers than the others.
+
+@d line_skip_code=0 {interline glue if |baseline_skip| is infeasible}
+@d baseline_skip_code=1 {desired glue between baselines}
+@d par_skip_code=2 {extra glue just above a paragraph}
+@d above_display_skip_code=3 {extra glue just above displayed math}
+@d below_display_skip_code=4 {extra glue just below displayed math}
+@d above_display_short_skip_code=5
+ {glue above displayed math following short lines}
+@d below_display_short_skip_code=6
+ {glue below displayed math following short lines}
+@d left_skip_code=7 {glue at left of justified lines}
+@d right_skip_code=8 {glue at right of justified lines}
+@d top_skip_code=9 {glue at top of main pages}
+@d split_top_skip_code=10 {glue at top of split pages}
+@d tab_skip_code=11 {glue between aligned entries}
+@d space_skip_code=12 {glue between words (if not |zero_glue|)}
+@d xspace_skip_code=13 {glue after sentences (if not |zero_glue|)}
+@d par_fill_skip_code=14 {glue on last line of paragraph}
+@d thin_mu_skip_code=15 {thin space in math formula}
+@d med_mu_skip_code=16 {medium space in math formula}
+@d thick_mu_skip_code=17 {thick space in math formula}
+@d glue_pars=18 {total number of glue parameters}
+@d skip_base=glue_base+glue_pars {table of 256 ``skip'' registers}
+@d mu_skip_base=skip_base+256 {table of 256 ``muskip'' registers}
+@d local_base=mu_skip_base+256 {beginning of region 4}
+@#
+@d skip(#)==equiv(skip_base+#) {|mem| location of glue specification}
+@d mu_skip(#)==equiv(mu_skip_base+#) {|mem| location of math glue spec}
+@d glue_par(#)==equiv(glue_base+#) {|mem| location of glue specification}
+@d line_skip==glue_par(line_skip_code)
+@d baseline_skip==glue_par(baseline_skip_code)
+@d par_skip==glue_par(par_skip_code)
+@d above_display_skip==glue_par(above_display_skip_code)
+@d below_display_skip==glue_par(below_display_skip_code)
+@d above_display_short_skip==glue_par(above_display_short_skip_code)
+@d below_display_short_skip==glue_par(below_display_short_skip_code)
+@d left_skip==glue_par(left_skip_code)
+@d right_skip==glue_par(right_skip_code)
+@d top_skip==glue_par(top_skip_code)
+@d split_top_skip==glue_par(split_top_skip_code)
+@d tab_skip==glue_par(tab_skip_code)
+@d space_skip==glue_par(space_skip_code)
+@d xspace_skip==glue_par(xspace_skip_code)
+@d par_fill_skip==glue_par(par_fill_skip_code)
+@d thin_mu_skip==glue_par(thin_mu_skip_code)
+@d med_mu_skip==glue_par(med_mu_skip_code)
+@d thick_mu_skip==glue_par(thick_mu_skip_code)
+
+@<Current |mem| equivalent of glue parameter number |n|@>=glue_par(n)
+
+@ Sometimes we need to convert \TeX's internal code numbers into symbolic
+form. The |print_skip_param| routine gives the symbolic name of a glue
+parameter.
+
+@<Declare the procedure called |print_skip_param|@>=
+procedure print_skip_param(@!n:integer);
+begin case n of
+line_skip_code: print_esc("lineskip");
+baseline_skip_code: print_esc("baselineskip");
+par_skip_code: print_esc("parskip");
+above_display_skip_code: print_esc("abovedisplayskip");
+below_display_skip_code: print_esc("belowdisplayskip");
+above_display_short_skip_code: print_esc("abovedisplayshortskip");
+below_display_short_skip_code: print_esc("belowdisplayshortskip");
+left_skip_code: print_esc("leftskip");
+right_skip_code: print_esc("rightskip");
+top_skip_code: print_esc("topskip");
+split_top_skip_code: print_esc("splittopskip");
+tab_skip_code: print_esc("tabskip");
+space_skip_code: print_esc("spaceskip");
+xspace_skip_code: print_esc("xspaceskip");
+par_fill_skip_code: print_esc("parfillskip");
+thin_mu_skip_code: print_esc("thinmuskip");
+med_mu_skip_code: print_esc("medmuskip");
+thick_mu_skip_code: print_esc("thickmuskip");
+othercases print("[unknown glue parameter!]")
+endcases;
+end;
+
+@ The symbolic names for glue parameters are put into \TeX's hash table
+by using the routine called |primitive|, defined below. Let us enter them
+now, so that we don't have to list all those parameter names anywhere else.
+
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("lineskip",assign_glue,glue_base+line_skip_code);@/
+@!@:line_skip_}{\.{\\lineskip} primitive@>
+primitive("baselineskip",assign_glue,glue_base+baseline_skip_code);@/
+@!@:baseline_skip_}{\.{\\baselineskip} primitive@>
+primitive("parskip",assign_glue,glue_base+par_skip_code);@/
+@!@:par_skip_}{\.{\\parskip} primitive@>
+primitive("abovedisplayskip",assign_glue,glue_base+above_display_skip_code);@/
+@!@:above_display_skip_}{\.{\\abovedisplayskip} primitive@>
+primitive("belowdisplayskip",assign_glue,glue_base+below_display_skip_code);@/
+@!@:below_display_skip_}{\.{\\belowdisplayskip} primitive@>
+primitive("abovedisplayshortskip",
+ assign_glue,glue_base+above_display_short_skip_code);@/
+@!@:above_display_short_skip_}{\.{\\abovedisplayshortskip} primitive@>
+primitive("belowdisplayshortskip",
+ assign_glue,glue_base+below_display_short_skip_code);@/
+@!@:below_display_short_skip_}{\.{\\belowdisplayshortskip} primitive@>
+primitive("leftskip",assign_glue,glue_base+left_skip_code);@/
+@!@:left_skip_}{\.{\\leftskip} primitive@>
+primitive("rightskip",assign_glue,glue_base+right_skip_code);@/
+@!@:right_skip_}{\.{\\rightskip} primitive@>
+primitive("topskip",assign_glue,glue_base+top_skip_code);@/
+@!@:top_skip_}{\.{\\topskip} primitive@>
+primitive("splittopskip",assign_glue,glue_base+split_top_skip_code);@/
+@!@:split_top_skip_}{\.{\\splittopskip} primitive@>
+primitive("tabskip",assign_glue,glue_base+tab_skip_code);@/
+@!@:tab_skip_}{\.{\\tabskip} primitive@>
+primitive("spaceskip",assign_glue,glue_base+space_skip_code);@/
+@!@:space_skip_}{\.{\\spaceskip} primitive@>
+primitive("xspaceskip",assign_glue,glue_base+xspace_skip_code);@/
+@!@:xspace_skip_}{\.{\\xspaceskip} primitive@>
+primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/
+@!@:par_fill_skip_}{\.{\\parfillskip} primitive@>
+primitive("thinmuskip",assign_mu_glue,glue_base+thin_mu_skip_code);@/
+@!@:thin_mu_skip_}{\.{\\thinmuskip} primitive@>
+primitive("medmuskip",assign_mu_glue,glue_base+med_mu_skip_code);@/
+@!@:med_mu_skip_}{\.{\\medmuskip} primitive@>
+primitive("thickmuskip",assign_mu_glue,glue_base+thick_mu_skip_code);@/
+@!@:thick_mu_skip_}{\.{\\thickmuskip} primitive@>
+
+@ @<Cases of |print_cmd_chr| for symbolic printing of primitives@>=
+assign_glue,assign_mu_glue: if chr_code<skip_base then
+ print_skip_param(chr_code-glue_base)
+ else if chr_code<mu_skip_base then
+ begin print_esc("skip"); print_int(chr_code-skip_base);
+ end
+ else begin print_esc("muskip"); print_int(chr_code-mu_skip_base);
+ end;
+
+@ All glue parameters and registers are initially `\.{0pt plus0pt minus0pt}'.
+
+@<Initialize table entries...@>=
+equiv(glue_base):=zero_glue; eq_level(glue_base):=level_one;
+eq_type(glue_base):=glue_ref;
+for k:=glue_base+1 to local_base-1 do eqtb[k]:=eqtb[glue_base];
+glue_ref_count(zero_glue):=glue_ref_count(zero_glue)+local_base-glue_base;
+
+@ @<Show equivalent |n|, in region 3@>=
+if n<skip_base then
+ begin print_skip_param(n-glue_base); print_char("=");
+ if n<glue_base+thin_mu_skip_code then print_spec(equiv(n),"pt")
+ else print_spec(equiv(n),"mu");
+ end
+else if n<mu_skip_base then
+ begin print_esc("skip"); print_int(n-skip_base); print_char("=");
+ print_spec(equiv(n),"pt");
+ end
+else begin print_esc("muskip"); print_int(n-mu_skip_base); print_char("=");
+ print_spec(equiv(n),"mu");
+ end
+
+@ Region 4 of |eqtb| contains the local quantities defined here. The
+bulk of this region is taken up by five tables that are indexed by eight-bit
+characters; these tables are important to both the syntactic and semantic
+portions of \TeX. There are also a bunch of special things like font and
+token parameters, as well as the tables of \.{\\toks} and \.{\\box}
+registers.
+
+@d par_shape_loc=local_base {specifies paragraph shape}
+@d output_routine_loc=local_base+1 {points to token list for \.{\\output}}
+@d every_par_loc=local_base+2 {points to token list for \.{\\everypar}}
+@d every_math_loc=local_base+3 {points to token list for \.{\\everymath}}
+@d every_display_loc=local_base+4 {points to token list for \.{\\everydisplay}}
+@d every_hbox_loc=local_base+5 {points to token list for \.{\\everyhbox}}
+@d every_vbox_loc=local_base+6 {points to token list for \.{\\everyvbox}}
+@d every_job_loc=local_base+7 {points to token list for \.{\\everyjob}}
+@d every_cr_loc=local_base+8 {points to token list for \.{\\everycr}}
+@d err_help_loc=local_base+9 {points to token list for \.{\\errhelp}}
+@d toks_base=local_base+10 {table of 256 token list registers}
+@d box_base=toks_base+256 {table of 256 box registers}
+@d cur_font_loc=box_base+256 {internal font number outside math mode}
+@d math_font_base=cur_font_loc+1 {table of 48 math font numbers}
+@d cat_code_base=math_font_base+48
+ {table of 256 command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings}
+@d uc_code_base=lc_code_base+256 {table of 256 uppercase mappings}
+@d sf_code_base=uc_code_base+256 {table of 256 spacefactor mappings}
+@d math_code_base=sf_code_base+256 {table of 256 math mode mappings}
+@d int_base=math_code_base+256 {beginning of region 5}
+@#
+@d par_shape_ptr==equiv(par_shape_loc)
+@d output_routine==equiv(output_routine_loc)
+@d every_par==equiv(every_par_loc)
+@d every_math==equiv(every_math_loc)
+@d every_display==equiv(every_display_loc)
+@d every_hbox==equiv(every_hbox_loc)
+@d every_vbox==equiv(every_vbox_loc)
+@d every_job==equiv(every_job_loc)
+@d every_cr==equiv(every_cr_loc)
+@d err_help==equiv(err_help_loc)
+@d toks(#)==equiv(toks_base+#)
+@d box(#)==equiv(box_base+#)
+@d cur_font==equiv(cur_font_loc)
+@d fam_fnt(#)==equiv(math_font_base+#)
+@d cat_code(#)==equiv(cat_code_base+#)
+@d lc_code(#)==equiv(lc_code_base+#)
+@d uc_code(#)==equiv(uc_code_base+#)
+@d sf_code(#)==equiv(sf_code_base+#)
+@d math_code(#)==equiv(math_code_base+#)
+ {Note: |math_code(c)| is the true math code plus |min_halfword|}
+
+@<Put each...@>=
+primitive("output",assign_toks,output_routine_loc);
+@!@:output_}{\.{\\output} primitive@>
+primitive("everypar",assign_toks,every_par_loc);
+@!@:every_par_}{\.{\\everypar} primitive@>
+primitive("everymath",assign_toks,every_math_loc);
+@!@:every_math_}{\.{\\everymath} primitive@>
+primitive("everydisplay",assign_toks,every_display_loc);
+@!@:every_display_}{\.{\\everydisplay} primitive@>
+primitive("everyhbox",assign_toks,every_hbox_loc);
+@!@:every_hbox_}{\.{\\everyhbox} primitive@>
+primitive("everyvbox",assign_toks,every_vbox_loc);
+@!@:every_vbox_}{\.{\\everyvbox} primitive@>
+primitive("everyjob",assign_toks,every_job_loc);
+@!@:every_job_}{\.{\\everyjob} primitive@>
+primitive("everycr",assign_toks,every_cr_loc);
+@!@:every_cr_}{\.{\\everycr} primitive@>
+primitive("errhelp",assign_toks,err_help_loc);
+@!@:err_help_}{\.{\\errhelp} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+assign_toks: if chr_code>=toks_base then
+ begin print_esc("toks"); print_int(chr_code-toks_base);
+ end
+else case chr_code of
+ output_routine_loc: print_esc("output");
+ every_par_loc: print_esc("everypar");
+ every_math_loc: print_esc("everymath");
+ every_display_loc: print_esc("everydisplay");
+ every_hbox_loc: print_esc("everyhbox");
+ every_vbox_loc: print_esc("everyvbox");
+ every_job_loc: print_esc("everyjob");
+ every_cr_loc: print_esc("everycr");
+ othercases print_esc("errhelp")
+ endcases;
+
+@ We initialize most things to null or undefined values. An undefined font
+is represented by the internal code |font_base|.
+
+However, the character code tables are given initial values based on the
+conventional interpretation of ASCII code. These initial values should
+not be changed when \TeX\ is adapted for use with non-English languages;
+all changes to the initialization conventions should be made in format
+packages, not in \TeX\ itself, so that global interchange of formats is
+possible.
+
+@d null_font==font_base
+@d var_code==@'70000 {math code meaning ``use the current family''}
+
+@<Initialize table entries...@>=
+par_shape_ptr:=null; eq_type(par_shape_loc):=shape_ref;
+eq_level(par_shape_loc):=level_one;@/
+for k:=output_routine_loc to toks_base+255 do
+ eqtb[k]:=eqtb[undefined_control_sequence];
+box(0):=null; eq_type(box_base):=box_ref; eq_level(box_base):=level_one;
+for k:=box_base+1 to box_base+255 do eqtb[k]:=eqtb[box_base];
+cur_font:=null_font; eq_type(cur_font_loc):=data;
+eq_level(cur_font_loc):=level_one;@/
+for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc];
+equiv(cat_code_base):=0; eq_type(cat_code_base):=data;
+eq_level(cat_code_base):=level_one;@/
+for k:=cat_code_base+1 to int_base-1 do eqtb[k]:=eqtb[cat_code_base];
+for k:=0 to 255 do
+ begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000;
+ end;
+cat_code(carriage_return):=car_ret; cat_code(" "):=spacer;
+cat_code("\"):=escape; cat_code("%"):=comment;
+cat_code(invalid_code):=invalid_char; cat_code(null_code):=ignore;
+for k:="0" to "9" do math_code(k):=hi(k+var_code);
+for k:="A" to "Z" do
+ begin cat_code(k):=letter; cat_code(k+"a"-"A"):=letter;@/
+ math_code(k):=hi(k+var_code+@"100);
+ math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/
+ lc_code(k):=k+"a"-"A"; lc_code(k+"a"-"A"):=k+"a"-"A";@/
+ uc_code(k):=k; uc_code(k+"a"-"A"):=k;@/
+ sf_code(k):=999;
+ end;
+
+@ @<Show equivalent |n|, in region 4@>=
+if n=par_shape_loc then
+ begin print_esc("parshape"); print_char("=");
+ if par_shape_ptr=null then print_char("0")
+ else print_int(info(par_shape_ptr));
+ end
+else if n<toks_base then
+ begin print_cmd_chr(assign_toks,n); print_char("=");
+ if equiv(n)<>null then show_token_list(link(equiv(n)),null,32);
+ end
+else if n<box_base then
+ begin print_esc("toks"); print_int(n-toks_base); print_char("=");
+ if equiv(n)<>null then show_token_list(link(equiv(n)),null,32);
+ end
+else if n<cur_font_loc then
+ begin print_esc("box"); print_int(n-box_base); print_char("=");
+ if equiv(n)=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(equiv(n));
+ end;
+ end
+else if n<cat_code_base then @<Show the font identifier in |eqtb[n]|@>
+else @<Show the halfword code in |eqtb[n]|@>
+
+@ @<Show the font identifier in |eqtb[n]|@>=
+begin if n=cur_font_loc then print("current font")
+else if n<math_font_base+16 then
+ begin print_esc("textfont"); print_int(n-math_font_base);
+ end
+else if n<math_font_base+32 then
+ begin print_esc("scriptfont"); print_int(n-math_font_base-16);
+ end
+else begin print_esc("scriptscriptfont"); print_int(n-math_font_base-32);
+ end;
+print_char("=");@/
+print_esc(hash[font_id_base+equiv(n)].rh);
+ {that's |font_id_text(equiv(n))|}
+end
+
+@ @<Show the halfword code in |eqtb[n]|@>=
+if n<math_code_base then
+ begin if n<lc_code_base then
+ begin print_esc("catcode"); print_int(n-cat_code_base);
+ end
+ else if n<uc_code_base then
+ begin print_esc("lccode"); print_int(n-lc_code_base);
+ end
+ else if n<sf_code_base then
+ begin print_esc("uccode"); print_int(n-uc_code_base);
+ end
+ else begin print_esc("sfcode"); print_int(n-sf_code_base);
+ end;
+ print_char("="); print_int(equiv(n));
+ end
+else begin print_esc("mathcode"); print_int(n-math_code_base);
+ print_char("="); print_int(ho(equiv(n)));
+ end
+
+@ Region 5 of |eqtb| contains the integer parameters and registers defined
+here, as well as the |del_code| table. The latter table differs from the
+|cat_code..math_code| tables that precede it, since delimiter codes are
+fullword integers while the other kinds of codes occupy at most a
+halfword. This is what makes region~5 different from region~4. We will
+store the |eq_level| information in an auxiliary array of quarterwords
+that will be defined later.
+
+@d pretolerance_code=0 {badness tolerance before hyphenation}
+@d tolerance_code=1 {badness tolerance after hyphenation}
+@d line_penalty_code=2 {added to the badness of every line}
+@d hyphen_penalty_code=3 {penalty for break after discretionary hyphen}
+@d ex_hyphen_penalty_code=4 {penalty for break after explicit hyphen}
+@d club_penalty_code=5 {penalty for creating a club line}
+@d widow_penalty_code=6 {penalty for creating a widow line}
+@d display_widow_penalty_code=7 {ditto, just before a display}
+@d broken_penalty_code=8 {penalty for breaking a page at a broken line}
+@d bin_op_penalty_code=9 {penalty for breaking after a binary operation}
+@d rel_penalty_code=10 {penalty for breaking after a relation}
+@d pre_display_penalty_code=11
+ {penalty for breaking just before a displayed formula}
+@d post_display_penalty_code=12
+ {penalty for breaking just after a displayed formula}
+@d inter_line_penalty_code=13 {additional penalty between lines}
+@d double_hyphen_demerits_code=14 {demerits for double hyphen break}
+@d final_hyphen_demerits_code=15 {demerits for final hyphen break}
+@d adj_demerits_code=16 {demerits for adjacent incompatible lines}
+@d mag_code=17 {magnification ratio}
+@d delimiter_factor_code=18 {ratio for variable-size delimiters}
+@d looseness_code=19 {change in number of lines for a paragraph}
+@d time_code=20 {current time of day}
+@d day_code=21 {current day of the month}
+@d month_code=22 {current month of the year}
+@d year_code=23 {current year of our Lord}
+@d show_box_breadth_code=24 {nodes per level in |show_box|}
+@d show_box_depth_code=25 {maximum level in |show_box|}
+@d hbadness_code=26 {hboxes exceeding this badness will be shown by |hpack|}
+@d vbadness_code=27 {vboxes exceeding this badness will be shown by |vpack|}
+@d pausing_code=28 {pause after each line is read from a file}
+@d tracing_online_code=29 {show diagnostic output on terminal}
+@d tracing_macros_code=30 {show macros as they are being expanded}
+@d tracing_stats_code=31 {show memory usage if \TeX\ knows it}
+@d tracing_paragraphs_code=32 {show line-break calculations}
+@d tracing_pages_code=33 {show page-break calculations}
+@d tracing_output_code=34 {show boxes when they are shipped out}
+@d tracing_lost_chars_code=35 {show characters that aren't in the font}
+@d tracing_commands_code=36 {show command codes at |big_switch|}
+@d tracing_restores_code=37 {show equivalents when they are restored}
+@d uc_hyph_code=38 {hyphenate words beginning with a capital letter}
+@d output_penalty_code=39 {penalty found at current page break}
+@d max_dead_cycles_code=40 {bound on consecutive dead cycles of output}
+@d hang_after_code=41 {hanging indentation changes after this many lines}
+@d floating_penalty_code=42 {penalty for insertions heldover after a split}
+@d global_defs_code=43 {override \.{\\global} specifications}
+@d cur_fam_code=44 {current family}
+@d escape_char_code=45 {escape character for token output}
+@d default_hyphen_char_code=46 {value of \.{\\hyphenchar} when a font is loaded}
+@d default_skew_char_code=47 {value of \.{\\skewchar} when a font is loaded}
+@d end_line_char_code=48 {character placed at the right end of the buffer}
+@d new_line_char_code=49 {character that prints as |print_ln|}
+@d language_code=50 {current hyphenation table}
+@d left_hyphen_min_code=51 {minimum left hyphenation fragment size}
+@d right_hyphen_min_code=52 {minimum right hyphenation fragment size}
+@d holding_inserts_code=53 {do not remove insertion nodes from \.{\\box255}}
+@d error_context_lines_code=54 {maximum intermediate line pairs shown}
+@d int_pars=55 {total number of integer parameters}
+@d count_base=int_base+int_pars {256 user \.{\\count} registers}
+@d del_code_base=count_base+256 {256 delimiter code mappings}
+@d dimen_base=del_code_base+256 {beginning of region 6}
+@#
+@d del_code(#)==eqtb[del_code_base+#].int
+@d count(#)==eqtb[count_base+#].int
+@d int_par(#)==eqtb[int_base+#].int {an integer parameter}
+@d pretolerance==int_par(pretolerance_code)
+@d tolerance==int_par(tolerance_code)
+@d line_penalty==int_par(line_penalty_code)
+@d hyphen_penalty==int_par(hyphen_penalty_code)
+@d ex_hyphen_penalty==int_par(ex_hyphen_penalty_code)
+@d club_penalty==int_par(club_penalty_code)
+@d widow_penalty==int_par(widow_penalty_code)
+@d display_widow_penalty==int_par(display_widow_penalty_code)
+@d broken_penalty==int_par(broken_penalty_code)
+@d bin_op_penalty==int_par(bin_op_penalty_code)
+@d rel_penalty==int_par(rel_penalty_code)
+@d pre_display_penalty==int_par(pre_display_penalty_code)
+@d post_display_penalty==int_par(post_display_penalty_code)
+@d inter_line_penalty==int_par(inter_line_penalty_code)
+@d double_hyphen_demerits==int_par(double_hyphen_demerits_code)
+@d final_hyphen_demerits==int_par(final_hyphen_demerits_code)
+@d adj_demerits==int_par(adj_demerits_code)
+@d mag==int_par(mag_code)
+@d delimiter_factor==int_par(delimiter_factor_code)
+@d looseness==int_par(looseness_code)
+@d time==int_par(time_code)
+@d day==int_par(day_code)
+@d month==int_par(month_code)
+@d year==int_par(year_code)
+@d show_box_breadth==int_par(show_box_breadth_code)
+@d show_box_depth==int_par(show_box_depth_code)
+@d hbadness==int_par(hbadness_code)
+@d vbadness==int_par(vbadness_code)
+@d pausing==int_par(pausing_code)
+@d tracing_online==int_par(tracing_online_code)
+@d tracing_macros==int_par(tracing_macros_code)
+@d tracing_stats==int_par(tracing_stats_code)
+@d tracing_paragraphs==int_par(tracing_paragraphs_code)
+@d tracing_pages==int_par(tracing_pages_code)
+@d tracing_output==int_par(tracing_output_code)
+@d tracing_lost_chars==int_par(tracing_lost_chars_code)
+@d tracing_commands==int_par(tracing_commands_code)
+@d tracing_restores==int_par(tracing_restores_code)
+@d uc_hyph==int_par(uc_hyph_code)
+@d output_penalty==int_par(output_penalty_code)
+@d max_dead_cycles==int_par(max_dead_cycles_code)
+@d hang_after==int_par(hang_after_code)
+@d floating_penalty==int_par(floating_penalty_code)
+@d global_defs==int_par(global_defs_code)
+@d cur_fam==int_par(cur_fam_code)
+@d escape_char==int_par(escape_char_code)
+@d default_hyphen_char==int_par(default_hyphen_char_code)
+@d default_skew_char==int_par(default_skew_char_code)
+@d end_line_char==int_par(end_line_char_code)
+@d new_line_char==int_par(new_line_char_code)
+@d language==int_par(language_code)
+@d left_hyphen_min==int_par(left_hyphen_min_code)
+@d right_hyphen_min==int_par(right_hyphen_min_code)
+@d holding_inserts==int_par(holding_inserts_code)
+@d error_context_lines==int_par(error_context_lines_code)
+
+@<Assign the values |depth_threshold:=show_box_depth|...@>=
+depth_threshold:=show_box_depth;
+breadth_max:=show_box_breadth
+
+@ We can print the symbolic name of an integer parameter as follows.
+
+@p procedure print_param(@!n:integer);
+begin case n of
+pretolerance_code:print_esc("pretolerance");
+tolerance_code:print_esc("tolerance");
+line_penalty_code:print_esc("linepenalty");
+hyphen_penalty_code:print_esc("hyphenpenalty");
+ex_hyphen_penalty_code:print_esc("exhyphenpenalty");
+club_penalty_code:print_esc("clubpenalty");
+widow_penalty_code:print_esc("widowpenalty");
+display_widow_penalty_code:print_esc("displaywidowpenalty");
+broken_penalty_code:print_esc("brokenpenalty");
+bin_op_penalty_code:print_esc("binoppenalty");
+rel_penalty_code:print_esc("relpenalty");
+pre_display_penalty_code:print_esc("predisplaypenalty");
+post_display_penalty_code:print_esc("postdisplaypenalty");
+inter_line_penalty_code:print_esc("interlinepenalty");
+double_hyphen_demerits_code:print_esc("doublehyphendemerits");
+final_hyphen_demerits_code:print_esc("finalhyphendemerits");
+adj_demerits_code:print_esc("adjdemerits");
+mag_code:print_esc("mag");
+delimiter_factor_code:print_esc("delimiterfactor");
+looseness_code:print_esc("looseness");
+time_code:print_esc("time");
+day_code:print_esc("day");
+month_code:print_esc("month");
+year_code:print_esc("year");
+show_box_breadth_code:print_esc("showboxbreadth");
+show_box_depth_code:print_esc("showboxdepth");
+hbadness_code:print_esc("hbadness");
+vbadness_code:print_esc("vbadness");
+pausing_code:print_esc("pausing");
+tracing_online_code:print_esc("tracingonline");
+tracing_macros_code:print_esc("tracingmacros");
+tracing_stats_code:print_esc("tracingstats");
+tracing_paragraphs_code:print_esc("tracingparagraphs");
+tracing_pages_code:print_esc("tracingpages");
+tracing_output_code:print_esc("tracingoutput");
+tracing_lost_chars_code:print_esc("tracinglostchars");
+tracing_commands_code:print_esc("tracingcommands");
+tracing_restores_code:print_esc("tracingrestores");
+uc_hyph_code:print_esc("uchyph");
+output_penalty_code:print_esc("outputpenalty");
+max_dead_cycles_code:print_esc("maxdeadcycles");
+hang_after_code:print_esc("hangafter");
+floating_penalty_code:print_esc("floatingpenalty");
+global_defs_code:print_esc("globaldefs");
+cur_fam_code:print_esc("fam");
+escape_char_code:print_esc("escapechar");
+default_hyphen_char_code:print_esc("defaulthyphenchar");
+default_skew_char_code:print_esc("defaultskewchar");
+end_line_char_code:print_esc("endlinechar");
+new_line_char_code:print_esc("newlinechar");
+language_code:print_esc("language");
+left_hyphen_min_code:print_esc("lefthyphenmin");
+right_hyphen_min_code:print_esc("righthyphenmin");
+holding_inserts_code:print_esc("holdinginserts");
+error_context_lines_code:print_esc("errorcontextlines");
+othercases print("[unknown integer parameter!]")
+endcases;
+end;
+
+@ The integer parameter names must be entered into the hash table.
+
+@<Put each...@>=
+primitive("pretolerance",assign_int,int_base+pretolerance_code);@/
+@!@:pretolerance_}{\.{\\pretolerance} primitive@>
+primitive("tolerance",assign_int,int_base+tolerance_code);@/
+@!@:tolerance_}{\.{\\tolerance} primitive@>
+primitive("linepenalty",assign_int,int_base+line_penalty_code);@/
+@!@:line_penalty_}{\.{\\linepenalty} primitive@>
+primitive("hyphenpenalty",assign_int,int_base+hyphen_penalty_code);@/
+@!@:hyphen_penalty_}{\.{\\hyphenpenalty} primitive@>
+primitive("exhyphenpenalty",assign_int,int_base+ex_hyphen_penalty_code);@/
+@!@:ex_hyphen_penalty_}{\.{\\exhyphenpenalty} primitive@>
+primitive("clubpenalty",assign_int,int_base+club_penalty_code);@/
+@!@:club_penalty_}{\.{\\clubpenalty} primitive@>
+primitive("widowpenalty",assign_int,int_base+widow_penalty_code);@/
+@!@:widow_penalty_}{\.{\\widowpenalty} primitive@>
+primitive("displaywidowpenalty",
+ assign_int,int_base+display_widow_penalty_code);@/
+@!@:display_widow_penalty_}{\.{\\displaywidowpenalty} primitive@>
+primitive("brokenpenalty",assign_int,int_base+broken_penalty_code);@/
+@!@:broken_penalty_}{\.{\\brokenpenalty} primitive@>
+primitive("binoppenalty",assign_int,int_base+bin_op_penalty_code);@/
+@!@:bin_op_penalty_}{\.{\\binoppenalty} primitive@>
+primitive("relpenalty",assign_int,int_base+rel_penalty_code);@/
+@!@:rel_penalty_}{\.{\\relpenalty} primitive@>
+primitive("predisplaypenalty",assign_int,int_base+pre_display_penalty_code);@/
+@!@:pre_display_penalty_}{\.{\\predisplaypenalty} primitive@>
+primitive("postdisplaypenalty",assign_int,int_base+post_display_penalty_code);@/
+@!@:post_display_penalty_}{\.{\\postdisplaypenalty} primitive@>
+primitive("interlinepenalty",assign_int,int_base+inter_line_penalty_code);@/
+@!@:inter_line_penalty_}{\.{\\interlinepenalty} primitive@>
+primitive("doublehyphendemerits",
+ assign_int,int_base+double_hyphen_demerits_code);@/
+@!@:double_hyphen_demerits_}{\.{\\doublehyphendemerits} primitive@>
+primitive("finalhyphendemerits",
+ assign_int,int_base+final_hyphen_demerits_code);@/
+@!@:final_hyphen_demerits_}{\.{\\finalhyphendemerits} primitive@>
+primitive("adjdemerits",assign_int,int_base+adj_demerits_code);@/
+@!@:adj_demerits_}{\.{\\adjdemerits} primitive@>
+primitive("mag",assign_int,int_base+mag_code);@/
+@!@:mag_}{\.{\\mag} primitive@>
+primitive("delimiterfactor",assign_int,int_base+delimiter_factor_code);@/
+@!@:delimiter_factor_}{\.{\\delimiterfactor} primitive@>
+primitive("looseness",assign_int,int_base+looseness_code);@/
+@!@:looseness_}{\.{\\looseness} primitive@>
+primitive("time",assign_int,int_base+time_code);@/
+@!@:time_}{\.{\\time} primitive@>
+primitive("day",assign_int,int_base+day_code);@/
+@!@:day_}{\.{\\day} primitive@>
+primitive("month",assign_int,int_base+month_code);@/
+@!@:month_}{\.{\\month} primitive@>
+primitive("year",assign_int,int_base+year_code);@/
+@!@:year_}{\.{\\year} primitive@>
+primitive("showboxbreadth",assign_int,int_base+show_box_breadth_code);@/
+@!@:show_box_breadth_}{\.{\\showboxbreadth} primitive@>
+primitive("showboxdepth",assign_int,int_base+show_box_depth_code);@/
+@!@:show_box_depth_}{\.{\\showboxdepth} primitive@>
+primitive("hbadness",assign_int,int_base+hbadness_code);@/
+@!@:hbadness_}{\.{\\hbadness} primitive@>
+primitive("vbadness",assign_int,int_base+vbadness_code);@/
+@!@:vbadness_}{\.{\\vbadness} primitive@>
+primitive("pausing",assign_int,int_base+pausing_code);@/
+@!@:pausing_}{\.{\\pausing} primitive@>
+primitive("tracingonline",assign_int,int_base+tracing_online_code);@/
+@!@:tracing_online_}{\.{\\tracingonline} primitive@>
+primitive("tracingmacros",assign_int,int_base+tracing_macros_code);@/
+@!@:tracing_macros_}{\.{\\tracingmacros} primitive@>
+primitive("tracingstats",assign_int,int_base+tracing_stats_code);@/
+@!@:tracing_stats_}{\.{\\tracingstats} primitive@>
+primitive("tracingparagraphs",assign_int,int_base+tracing_paragraphs_code);@/
+@!@:tracing_paragraphs_}{\.{\\tracingparagraphs} primitive@>
+primitive("tracingpages",assign_int,int_base+tracing_pages_code);@/
+@!@:tracing_pages_}{\.{\\tracingpages} primitive@>
+primitive("tracingoutput",assign_int,int_base+tracing_output_code);@/
+@!@:tracing_output_}{\.{\\tracingoutput} primitive@>
+primitive("tracinglostchars",assign_int,int_base+tracing_lost_chars_code);@/
+@!@:tracing_lost_chars_}{\.{\\tracinglostchars} primitive@>
+primitive("tracingcommands",assign_int,int_base+tracing_commands_code);@/
+@!@:tracing_commands_}{\.{\\tracingcommands} primitive@>
+primitive("tracingrestores",assign_int,int_base+tracing_restores_code);@/
+@!@:tracing_restores_}{\.{\\tracingrestores} primitive@>
+primitive("uchyph",assign_int,int_base+uc_hyph_code);@/
+@!@:uc_hyph_}{\.{\\uchyph} primitive@>
+primitive("outputpenalty",assign_int,int_base+output_penalty_code);@/
+@!@:output_penalty_}{\.{\\outputpenalty} primitive@>
+primitive("maxdeadcycles",assign_int,int_base+max_dead_cycles_code);@/
+@!@:max_dead_cycles_}{\.{\\maxdeadcycles} primitive@>
+primitive("hangafter",assign_int,int_base+hang_after_code);@/
+@!@:hang_after_}{\.{\\hangafter} primitive@>
+primitive("floatingpenalty",assign_int,int_base+floating_penalty_code);@/
+@!@:floating_penalty_}{\.{\\floatingpenalty} primitive@>
+primitive("globaldefs",assign_int,int_base+global_defs_code);@/
+@!@:global_defs_}{\.{\\globaldefs} primitive@>
+primitive("fam",assign_int,int_base+cur_fam_code);@/
+@!@:fam_}{\.{\\fam} primitive@>
+primitive("escapechar",assign_int,int_base+escape_char_code);@/
+@!@:escape_char_}{\.{\\escapechar} primitive@>
+primitive("defaulthyphenchar",assign_int,int_base+default_hyphen_char_code);@/
+@!@:default_hyphen_char_}{\.{\\defaulthyphenchar} primitive@>
+primitive("defaultskewchar",assign_int,int_base+default_skew_char_code);@/
+@!@:default_skew_char_}{\.{\\defaultskewchar} primitive@>
+primitive("endlinechar",assign_int,int_base+end_line_char_code);@/
+@!@:end_line_char_}{\.{\\endlinechar} primitive@>
+primitive("newlinechar",assign_int,int_base+new_line_char_code);@/
+@!@:new_line_char_}{\.{\\newlinechar} primitive@>
+primitive("language",assign_int,int_base+language_code);@/
+@!@:language_}{\.{\\language} primitive@>
+primitive("lefthyphenmin",assign_int,int_base+left_hyphen_min_code);@/
+@!@:left_hyphen_min_}{\.{\\lefthyphenmin} primitive@>
+primitive("righthyphenmin",assign_int,int_base+right_hyphen_min_code);@/
+@!@:right_hyphen_min_}{\.{\\righthyphenmin} primitive@>
+primitive("holdinginserts",assign_int,int_base+holding_inserts_code);@/
+@!@:holding_inserts_}{\.{\\holdinginserts} primitive@>
+primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+assign_int: if chr_code<count_base then print_param(chr_code-int_base)
+ else begin print_esc("count"); print_int(chr_code-count_base);
+ end;
+
+@ The integer parameters should really be initialized by a macro package;
+the following initialization does the minimum to keep \TeX\ from
+complete failure.
+@^null delimiter@>
+
+@<Initialize table entries...@>=
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
+escape_char:="\"; end_line_char:=carriage_return;
+for k:=0 to 255 do del_code(k):=-1;
+del_code("."):=0; {this null delimiter is used in error recovery}
+
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+
+@ @<Show equivalent |n|, in region 5@>=
+begin if n<count_base then print_param(n-int_base)
+else if n<del_code_base then
+ begin print_esc("count"); print_int(n-count_base);
+ end
+else begin print_esc("delcode"); print_int(n-del_code_base);
+ end;
+print_char("="); print_int(eqtb[n].int);
+end
+
+@ @<Set variable |c| to the current escape character@>=c:=escape_char
+
+@ @<Character |s| is the current new-line character@>=s=new_line_char
+
+@ \TeX\ is occasionally supposed to print diagnostic information that
+goes only into the transcript file, unless |tracing_online| is positive.
+Here are two routines that adjust the destination of print commands:
+
+@p procedure begin_diagnostic; {prepare to do some tracing}
+begin old_setting:=selector;
+if (tracing_online<=0)and(selector=term_and_log) then
+ begin decr(selector);
+ if history=spotless then history:=warning_issued;
+ end;
+end;
+@#
+procedure end_diagnostic(@!blank_line:boolean);
+ {restore proper conditions after tracing}
+begin print_nl("");
+if blank_line then print_ln;
+selector:=old_setting;
+end;
+
+@ Of course we had better declare another global variable, if the previous
+routines are going to work.
+
+@<Glob...@>=
+@!old_setting:0..max_selector;
+
+@ The final region of |eqtb| contains the dimension parameters defined
+here, and the 256 \.{\\dimen} registers.
+
+@d par_indent_code=0 {indentation of paragraphs}
+@d math_surround_code=1 {space around math in text}
+@d line_skip_limit_code=2 {threshold for |line_skip| instead of |baseline_skip|}
+@d hsize_code=3 {line width in horizontal mode}
+@d vsize_code=4 {page height in vertical mode}
+@d max_depth_code=5 {maximum depth of boxes on main pages}
+@d split_max_depth_code=6 {maximum depth of boxes on split pages}
+@d box_max_depth_code=7 {maximum depth of explicit vboxes}
+@d hfuzz_code=8 {tolerance for overfull hbox messages}
+@d vfuzz_code=9 {tolerance for overfull vbox messages}
+@d delimiter_shortfall_code=10 {maximum amount uncovered by variable delimiters}
+@d null_delimiter_space_code=11 {blank space in null delimiters}
+@d script_space_code=12 {extra space after subscript or superscript}
+@d pre_display_size_code=13 {length of text preceding a display}
+@d display_width_code=14 {length of line for displayed equation}
+@d display_indent_code=15 {indentation of line for displayed equation}
+@d overfull_rule_code=16 {width of rule that identifies overfull hboxes}
+@d hang_indent_code=17 {amount of hanging indentation}
+@d h_offset_code=18 {amount of horizontal offset when shipping pages out}
+@d v_offset_code=19 {amount of vertical offset when shipping pages out}
+@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking}
+@d dimen_pars=21 {total number of dimension parameters}
+@d scaled_base=dimen_base+dimen_pars
+ {table of 256 user-defined \.{\\dimen} registers}
+@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|}
+@#
+@d dimen(#)==eqtb[scaled_base+#].sc
+@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity}
+@d par_indent==dimen_par(par_indent_code)
+@d math_surround==dimen_par(math_surround_code)
+@d line_skip_limit==dimen_par(line_skip_limit_code)
+@d hsize==dimen_par(hsize_code)
+@d vsize==dimen_par(vsize_code)
+@d max_depth==dimen_par(max_depth_code)
+@d split_max_depth==dimen_par(split_max_depth_code)
+@d box_max_depth==dimen_par(box_max_depth_code)
+@d hfuzz==dimen_par(hfuzz_code)
+@d vfuzz==dimen_par(vfuzz_code)
+@d delimiter_shortfall==dimen_par(delimiter_shortfall_code)
+@d null_delimiter_space==dimen_par(null_delimiter_space_code)
+@d script_space==dimen_par(script_space_code)
+@d pre_display_size==dimen_par(pre_display_size_code)
+@d display_width==dimen_par(display_width_code)
+@d display_indent==dimen_par(display_indent_code)
+@d overfull_rule==dimen_par(overfull_rule_code)
+@d hang_indent==dimen_par(hang_indent_code)
+@d h_offset==dimen_par(h_offset_code)
+@d v_offset==dimen_par(v_offset_code)
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+
+@p procedure print_length_param(@!n:integer);
+begin case n of
+par_indent_code:print_esc("parindent");
+math_surround_code:print_esc("mathsurround");
+line_skip_limit_code:print_esc("lineskiplimit");
+hsize_code:print_esc("hsize");
+vsize_code:print_esc("vsize");
+max_depth_code:print_esc("maxdepth");
+split_max_depth_code:print_esc("splitmaxdepth");
+box_max_depth_code:print_esc("boxmaxdepth");
+hfuzz_code:print_esc("hfuzz");
+vfuzz_code:print_esc("vfuzz");
+delimiter_shortfall_code:print_esc("delimitershortfall");
+null_delimiter_space_code:print_esc("nulldelimiterspace");
+script_space_code:print_esc("scriptspace");
+pre_display_size_code:print_esc("predisplaysize");
+display_width_code:print_esc("displaywidth");
+display_indent_code:print_esc("displayindent");
+overfull_rule_code:print_esc("overfullrule");
+hang_indent_code:print_esc("hangindent");
+h_offset_code:print_esc("hoffset");
+v_offset_code:print_esc("voffset");
+emergency_stretch_code:print_esc("emergencystretch");
+othercases print("[unknown dimen parameter!]")
+endcases;
+end;
+
+@ @<Put each...@>=
+primitive("parindent",assign_dimen,dimen_base+par_indent_code);@/
+@!@:par_indent_}{\.{\\parindent} primitive@>
+primitive("mathsurround",assign_dimen,dimen_base+math_surround_code);@/
+@!@:math_surround_}{\.{\\mathsurround} primitive@>
+primitive("lineskiplimit",assign_dimen,dimen_base+line_skip_limit_code);@/
+@!@:line_skip_limit_}{\.{\\lineskiplimit} primitive@>
+primitive("hsize",assign_dimen,dimen_base+hsize_code);@/
+@!@:hsize_}{\.{\\hsize} primitive@>
+primitive("vsize",assign_dimen,dimen_base+vsize_code);@/
+@!@:vsize_}{\.{\\vsize} primitive@>
+primitive("maxdepth",assign_dimen,dimen_base+max_depth_code);@/
+@!@:max_depth_}{\.{\\maxdepth} primitive@>
+primitive("splitmaxdepth",assign_dimen,dimen_base+split_max_depth_code);@/
+@!@:split_max_depth_}{\.{\\splitmaxdepth} primitive@>
+primitive("boxmaxdepth",assign_dimen,dimen_base+box_max_depth_code);@/
+@!@:box_max_depth_}{\.{\\boxmaxdepth} primitive@>
+primitive("hfuzz",assign_dimen,dimen_base+hfuzz_code);@/
+@!@:hfuzz_}{\.{\\hfuzz} primitive@>
+primitive("vfuzz",assign_dimen,dimen_base+vfuzz_code);@/
+@!@:vfuzz_}{\.{\\vfuzz} primitive@>
+primitive("delimitershortfall",
+ assign_dimen,dimen_base+delimiter_shortfall_code);@/
+@!@:delimiter_shortfall_}{\.{\\delimitershortfall} primitive@>
+primitive("nulldelimiterspace",
+ assign_dimen,dimen_base+null_delimiter_space_code);@/
+@!@:null_delimiter_space_}{\.{\\nulldelimiterspace} primitive@>
+primitive("scriptspace",assign_dimen,dimen_base+script_space_code);@/
+@!@:script_space_}{\.{\\scriptspace} primitive@>
+primitive("predisplaysize",assign_dimen,dimen_base+pre_display_size_code);@/
+@!@:pre_display_size_}{\.{\\predisplaysize} primitive@>
+primitive("displaywidth",assign_dimen,dimen_base+display_width_code);@/
+@!@:display_width_}{\.{\\displaywidth} primitive@>
+primitive("displayindent",assign_dimen,dimen_base+display_indent_code);@/
+@!@:display_indent_}{\.{\\displayindent} primitive@>
+primitive("overfullrule",assign_dimen,dimen_base+overfull_rule_code);@/
+@!@:overfull_rule_}{\.{\\overfullrule} primitive@>
+primitive("hangindent",assign_dimen,dimen_base+hang_indent_code);@/
+@!@:hang_indent_}{\.{\\hangindent} primitive@>
+primitive("hoffset",assign_dimen,dimen_base+h_offset_code);@/
+@!@:h_offset_}{\.{\\hoffset} primitive@>
+primitive("voffset",assign_dimen,dimen_base+v_offset_code);@/
+@!@:v_offset_}{\.{\\voffset} primitive@>
+primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/
+@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+assign_dimen: if chr_code<scaled_base then
+ print_length_param(chr_code-dimen_base)
+ else begin print_esc("dimen"); print_int(chr_code-scaled_base);
+ end;
+
+@ @<Initialize table entries...@>=
+for k:=dimen_base to eqtb_size do eqtb[k].sc:=0;
+
+@ @<Show equivalent |n|, in region 6@>=
+begin if n<scaled_base then print_length_param(n-dimen_base)
+else begin print_esc("dimen"); print_int(n-scaled_base);
+ end;
+print_char("="); print_scaled(eqtb[n].sc); print("pt");
+end
+
+@ Here is a procedure that displays the contents of |eqtb[n]|
+symbolically.
+
+@p@t\4@>@<Declare the procedure called |print_cmd_chr|@>@;@/
+@!stat procedure show_eqtb(@!n:pointer);
+begin if n<active_base then print_char("?") {this can't happen}
+else if n<glue_base then @<Show equivalent |n|, in region 1 or 2@>
+else if n<local_base then @<Show equivalent |n|, in region 3@>
+else if n<int_base then @<Show equivalent |n|, in region 4@>
+else if n<dimen_base then @<Show equivalent |n|, in region 5@>
+else if n<=eqtb_size then @<Show equivalent |n|, in region 6@>
+else print_char("?"); {this can't happen either}
+end;
+tats
+
+@ The last two regions of |eqtb| have fullword values instead of the
+three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary,
+but \TeX\ needs to store the |eq_level| information in another array
+called |xeq_level|.
+
+@<Glob...@>=
+@!eqtb:array[active_base..eqtb_size] of memory_word;
+@!xeq_level:array[int_base..eqtb_size] of quarterword;
+
+@ @<Set init...@>=
+for k:=int_base to eqtb_size do xeq_level[k]:=level_one;
+
+@ When the debugging routine |search_mem| is looking for pointers having a
+given value, it is interested only in regions 1 to~3 of~|eqtb|, and in the
+first part of region~4.
+
+@<Search |eqtb| for equivalents equal to |p|@>=
+for q:=active_base to box_base+255 do
+ begin if equiv(q)=p then
+ begin print_nl("EQUIV("); print_int(q); print_char(")");
+ end;
+ end
+
+@* \[18] The hash table.
+Control sequences are stored and retrieved by means of a fairly standard hash
+table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C
+in {\sl The Art of Computer Programming\/}). Once a control sequence enters the
+table, it is never removed, because there are complicated situations
+involving \.{\\gdef} where the removal of a control sequence at the end of
+a group would be a mistake preventable only by the introduction of a
+complicated reference-count mechanism.
+
+The actual sequence of letters forming a control sequence identifier is
+stored in the |str_pool| array together with all the other strings. An
+auxiliary array |hash| consists of items with two halfword fields per
+word. The first of these, called |next(p)|, points to the next identifier
+belonging to the same coalesced list as the identifier corresponding to~|p|;
+and the other, called |text(p)|, points to the |str_start| entry for
+|p|'s identifier. If position~|p| of the hash table is empty, we have
+|text(p)=0|; if position |p| is either empty or the end of a coalesced
+hash list, we have |next(p)=0|. An auxiliary pointer variable called
+|hash_used| is maintained in such a way that all locations |p>=hash_used|
+are nonempty. The global variable |cs_count| tells how many multiletter
+control sequences have been defined, if statistics are being kept.
+
+A global boolean variable called |no_new_control_sequence| is set to
+|true| during the time that new hash table entries are forbidden.
+
+@d next(#) == hash[#].lh {link for coalesced lists}
+@d text(#) == hash[#].rh {string number for control sequence name}
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name}
+
+@<Glob...@>=
+@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
+ {the hash table}
+@!hash_used:pointer; {allocation pointer for |hash|}
+@!no_new_control_sequence:boolean; {are new identifiers legal?}
+@!cs_count:integer; {total number of known identifiers}
+
+@ @<Set init...@>=
+no_new_control_sequence:=true; {new identifiers are usually forbidden}
+next(hash_base):=0; text(hash_base):=0;
+for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base];
+
+@ @<Initialize table entries...@>=
+hash_used:=frozen_control_sequence; {nothing is used}
+cs_count:=0;
+eq_type(frozen_dont_expand):=dont_expand;
+text(frozen_dont_expand):="notexpanded:";
+@.notexpanded:@>
+
+@ Here is the subroutine that searches the hash table for an identifier
+that matches a given string of length |l>1| appearing in |buffer[j..
+(j+l-1)]|. If the identifier is found, the corresponding hash table address
+is returned. Otherwise, if the global variable |no_new_control_sequence|
+is |true|, the dummy address |undefined_control_sequence| is returned.
+Otherwise the identifier is inserted into the hash table and its location
+is returned.
+
+@p function id_lookup(@!j,@!l:integer):pointer; {search the hash table}
+label found; {go here if you found it}
+var h:integer; {hash code}
+@!d:integer; {number of characters in incomplete current string}
+@!p:pointer; {index in |hash| array}
+@!k:pointer; {index in |buffer| array}
+begin @<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+begin if text(p)>0 then if length(text(p))=l then
+ if str_eq_buf(text(p),j) then goto found;
+ if next(p)=0 then
+ begin if no_new_control_sequence then
+ p:=undefined_control_sequence
+ else @<Insert a new control sequence after |p|, then make
+ |p| point to it@>;
+ goto found;
+ end;
+ p:=next(p);
+ end;
+found: id_lookup:=p;
+end;
+
+@ @<Insert a new control...@>=
+begin if text(p)>0 then
+ begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+ decr(hash_used);
+ until text(hash_used)=0; {search for an empty location in |hash|}
+ next(p):=hash_used; p:=hash_used;
+ end;
+str_room(l); d:=cur_length;
+while pool_ptr>str_start[str_ptr] do
+ begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr];
+ end; {move current string up to make room for another}
+for k:=j to j+l-1 do append_char(buffer[k]);
+text(p):=make_string; pool_ptr:=pool_ptr+d;
+@!stat incr(cs_count);@+tats@;@/
+end
+
+@ The value of |hash_prime| should be roughly 85\pct! of |hash_size|, and it
+should be a prime number. The theory of hashing tells us to expect fewer
+than two table probes, on the average, when the search is successful.
+[See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983), 231--258.]
+@^Vitter, Jeffrey Scott@>
+
+@<Compute the hash code |h|@>=
+h:=buffer[j];
+for k:=j+1 to j+l-1 do
+ begin h:=h+h+buffer[k];
+ while h>=hash_prime do h:=h-hash_prime;
+ end
+
+@ Single-character control sequences do not need to be looked up in a hash
+table, since we can use the character code itself as a direct address.
+The procedure |print_cs| prints the name of a control sequence, given
+a pointer to its address in |eqtb|. A space is printed after the name
+unless it is a single nonletter or an active character. This procedure
+might be invoked with invalid data, so it is ``extra robust.'' The
+individual characters must be printed one at a time using |print|, since
+they may be unprintable.
+
+@<Basic printing...@>=
+procedure print_cs(@!p:integer); {prints a purported control sequence}
+begin if p<hash_base then {single character}
+ if p>=single_base then
+ if p=null_cs then
+ begin print_esc("csname"); print_esc("endcsname");
+ end
+ else begin print_esc(p-single_base);
+ if cat_code(p-single_base)=letter then print_char(" ");
+ end
+ else if p<active_base then print_esc("IMPOSSIBLE.")
+@.IMPOSSIBLE@>
+ else print(p-active_base)
+else if p>=undefined_control_sequence then print_esc("IMPOSSIBLE.")
+else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@.NONEXISTENT@>
+else begin print_esc(text(p));
+ print_char(" ");
+ end;
+end;
+
+@ Here is a similar procedure; it avoids the error checks, and it never
+prints a space after the control sequence.
+
+@<Basic printing procedures@>=
+procedure sprint_cs(@!p:pointer); {prints a control sequence}
+begin if p<hash_base then
+ if p<single_base then print(p-active_base)
+ else if p<null_cs then print_esc(p-single_base)
+ else begin print_esc("csname"); print_esc("endcsname");
+ end
+else print_esc(text(p));
+end;
+
+@ We need to put \TeX's ``primitive'' control sequences into the hash
+table, together with their command code (which will be the |eq_type|)
+and an operand (which will be the |equiv|). The |primitive| procedure
+does this, in a way that no \TeX\ user can. The global value |cur_val|
+contains the new |eqtb| pointer after |primitive| has acted.
+
+@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
+var k:pool_pointer; {index into |str_pool|}
+@!j:small_number; {index into |buffer|}
+@!l:small_number; {length of the string}
+begin if s<256 then cur_val:=s+single_base
+else begin k:=str_start[s]; l:=str_start[s+1]-k;
+ {we will move |s| into the (empty) |buffer|}
+ for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]);
+ cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|}
+ flush_string; text(cur_val):=s; {we don't want to have the string twice}
+ end;
+eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o;
+end;
+tini
+
+@ Many of \TeX's primitives need no |equiv|, since they are identifiable
+by their |eq_type| alone. These primitives are loaded into the hash table
+as follows:
+
+@<Put each of \TeX's primitives into the hash table@>=
+primitive(" ",ex_space,0);@/
+@!@:Single-character primitives /}{\quad\.{\\\ }@>
+primitive("/",ital_corr,0);@/
+@!@:Single-character primitives /}{\quad\.{\\/}@>
+primitive("accent",accent,0);@/
+@!@:accent_}{\.{\\accent} primitive@>
+primitive("advance",advance,0);@/
+@!@:advance_}{\.{\\advance} primitive@>
+primitive("afterassignment",after_assignment,0);@/
+@!@:after_assignment_}{\.{\\afterassignment} primitive@>
+primitive("aftergroup",after_group,0);@/
+@!@:after_group_}{\.{\\aftergroup} primitive@>
+primitive("begingroup",begin_group,0);@/
+@!@:begin_group_}{\.{\\begingroup} primitive@>
+primitive("char",char_num,0);@/
+@!@:char_}{\.{\\char} primitive@>
+primitive("csname",cs_name,0);@/
+@!@:cs_name_}{\.{\\csname} primitive@>
+primitive("delimiter",delim_num,0);@/
+@!@:delimiter_}{\.{\\delimiter} primitive@>
+primitive("divide",divide,0);@/
+@!@:divide_}{\.{\\divide} primitive@>
+primitive("endcsname",end_cs_name,0);@/
+@!@:end_cs_name_}{\.{\\endcsname} primitive@>
+primitive("endgroup",end_group,0);
+@!@:end_group_}{\.{\\endgroup} primitive@>
+text(frozen_end_group):="endgroup"; eqtb[frozen_end_group]:=eqtb[cur_val];@/
+primitive("expandafter",expand_after,0);@/
+@!@:expand_after_}{\.{\\expandafter} primitive@>
+primitive("font",def_font,0);@/
+@!@:font_}{\.{\\font} primitive@>
+primitive("fontdimen",assign_font_dimen,0);@/
+@!@:font_dimen_}{\.{\\fontdimen} primitive@>
+primitive("halign",halign,0);@/
+@!@:halign_}{\.{\\halign} primitive@>
+primitive("hrule",hrule,0);@/
+@!@:hrule_}{\.{\\hrule} primitive@>
+primitive("ignorespaces",ignore_spaces,0);@/
+@!@:ignore_spaces_}{\.{\\ignorespaces} primitive@>
+primitive("insert",insert,0);@/
+@!@:insert_}{\.{\\insert} primitive@>
+primitive("mark",mark,0);@/
+@!@:mark_}{\.{\\mark} primitive@>
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("mathchar",math_char_num,0);@/
+@!@:math_char_}{\.{\\mathchar} primitive@>
+primitive("mathchoice",math_choice,0);@/
+@!@:math_choice_}{\.{\\mathchoice} primitive@>
+primitive("multiply",multiply,0);@/
+@!@:multiply_}{\.{\\multiply} primitive@>
+primitive("noalign",no_align,0);@/
+@!@:no_align_}{\.{\\noalign} primitive@>
+primitive("noboundary",no_boundary,0);@/
+@!@:no_boundary_}{\.{\\noboundary} primitive@>
+primitive("noexpand",no_expand,0);@/
+@!@:no_expand_}{\.{\\noexpand} primitive@>
+primitive("nonscript",non_script,0);@/
+@!@:non_script_}{\.{\\nonscript} primitive@>
+primitive("omit",omit,0);@/
+@!@:omit_}{\.{\\omit} primitive@>
+primitive("parshape",set_shape,0);@/
+@!@:par_shape_}{\.{\\parshape} primitive@>
+primitive("penalty",break_penalty,0);@/
+@!@:penalty_}{\.{\\penalty} primitive@>
+primitive("prevgraf",set_prev_graf,0);@/
+@!@:prev_graf_}{\.{\\prevgraf} primitive@>
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+primitive("read",read_to_cs,0);@/
+@!@:read_}{\.{\\read} primitive@>
+primitive("relax",relax,256); {cf.\ |scan_file_name|}
+@!@:relax_}{\.{\\relax} primitive@>
+text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/
+primitive("setbox",set_box,0);@/
+@!@:set_box_}{\.{\\setbox} primitive@>
+primitive("the",the,0);@/
+@!@:the_}{\.{\\the} primitive@>
+primitive("toks",toks_register,0);@/
+@!@:toks_}{\.{\\toks} primitive@>
+primitive("vadjust",vadjust,0);@/
+@!@:vadjust_}{\.{\\vadjust} primitive@>
+primitive("valign",valign,0);@/
+@!@:valign_}{\.{\\valign} primitive@>
+primitive("vcenter",vcenter,0);@/
+@!@:vcenter_}{\.{\\vcenter} primitive@>
+primitive("vrule",vrule,0);@/
+@!@:vrule_}{\.{\\vrule} primitive@>
+
+@ Each primitive has a corresponding inverse, so that it is possible to
+display the cryptic numeric contents of |eqtb| in symbolic form.
+Every call of |primitive| in this program is therefore accompanied by some
+straightforward code that forms part of the |print_cmd_chr| routine
+below.
+
+@<Cases of |print_cmd_chr|...@>=
+accent: print_esc("accent");
+advance: print_esc("advance");
+after_assignment: print_esc("afterassignment");
+after_group: print_esc("aftergroup");
+assign_font_dimen: print_esc("fontdimen");
+begin_group: print_esc("begingroup");
+break_penalty: print_esc("penalty");
+char_num: print_esc("char");
+cs_name: print_esc("csname");
+def_font: print_esc("font");
+delim_num: print_esc("delimiter");
+divide: print_esc("divide");
+end_cs_name: print_esc("endcsname");
+end_group: print_esc("endgroup");
+ex_space: print_esc(" ");
+expand_after: print_esc("expandafter");
+halign: print_esc("halign");
+hrule: print_esc("hrule");
+ignore_spaces: print_esc("ignorespaces");
+insert: print_esc("insert");
+ital_corr: print_esc("/");
+mark: print_esc("mark");
+math_accent: print_esc("mathaccent");
+math_char_num: print_esc("mathchar");
+math_choice: print_esc("mathchoice");
+multiply: print_esc("multiply");
+no_align: print_esc("noalign");
+no_boundary:print_esc("noboundary");
+no_expand: print_esc("noexpand");
+non_script: print_esc("nonscript");
+omit: print_esc("omit");
+radical: print_esc("radical");
+read_to_cs: print_esc("read");
+relax: print_esc("relax");
+set_box: print_esc("setbox");
+set_prev_graf: print_esc("prevgraf");
+set_shape: print_esc("parshape");
+the: print_esc("the");
+toks_register: print_esc("toks");
+vadjust: print_esc("vadjust");
+valign: print_esc("valign");
+vcenter: print_esc("vcenter");
+vrule: print_esc("vrule");
+
+@ We will deal with the other primitives later, at some point in the program
+where their |eq_type| and |equiv| values are more meaningful. For example,
+the primitives for math mode will be loaded when we consider the routines
+that deal with formulas. It is easy to find where each particular
+primitive was treated by looking in the index at the end; for example, the
+section where |"radical"| entered |eqtb| is listed under `\.{\\radical}
+primitive'. (Primitives consisting of a single nonalphabetic character,
+@!like `\.{\\/}', are listed under `Single-character primitives'.)
+@!@^Single-character primitives@>
+
+Meanwhile, this is a convenient place to catch up on something we were unable
+to do before the hash table was defined:
+
+@<Print the font identifier for |font(p)|@>=
+print_esc(font_id_text(font(p)))
+
+@* \[19] Saving and restoring equivalents.
+The nested structure provided by `$\.{\char'173}\ldots\.{\char'175}$' groups
+in \TeX\ means that |eqtb| entries valid in outer groups should be saved
+and restored later if they are overridden inside the braces. When a new |eqtb|
+value is being assigned, the program therefore checks to see if the previous
+entry belongs to an outer level. In such a case, the old value is placed
+on the |save_stack| just before the new value enters |eqtb|. At the
+end of a grouping level, i.e., when the right brace is sensed, the
+|save_stack| is used to restore the outer values, and the inner ones are
+destroyed.
+
+Entries on the |save_stack| are of type |memory_word|. The top item on
+this stack is |save_stack[p]|, where |p=save_ptr-1|; it contains three
+fields called |save_type|, |save_level|, and |save_index|, and it is
+interpreted in one of four ways:
+
+\yskip\hangg 1) If |save_type(p)=restore_old_value|, then
+|save_index(p)| is a location in |eqtb| whose current value should
+be destroyed at the end of the current group and replaced by |save_stack[p-1]|.
+Furthermore if |save_index(p)>=int_base|, then |save_level(p)|
+should replace the corresponding entry in |xeq_level|.
+
+\yskip\hangg 2) If |save_type(p)=restore_zero|, then |save_index(p)|
+is a location in |eqtb| whose current value should be destroyed at the end
+of the current group, when it should be
+replaced by the current value of |eqtb[undefined_control_sequence]|.
+
+\yskip\hangg 3) If |save_type(p)=insert_token|, then |save_index(p)|
+is a token that should be inserted into \TeX's input when the current
+group ends.
+
+\yskip\hangg 4) If |save_type(p)=level_boundary|, then |save_level(p)|
+is a code explaining what kind of group we were previously in, and
+|save_index(p)| points to the level boundary word at the bottom of
+the entries for that group.
+
+@d save_type(#)==save_stack[#].hh.b0 {classifies a |save_stack| entry}
+@d save_level(#)==save_stack[#].hh.b1
+ {saved level for regions 5 and 6, or group code}
+@d save_index(#)==save_stack[#].hh.rh
+ {|eqtb| location or |save_stack| location}
+@d restore_old_value=0 {|save_type| when a value should be restored later}
+@d restore_zero=1 {|save_type| when an undefined entry should be restored}
+@d insert_token=2 {|save_type| when a token is being saved for later use}
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+
+@ Here are the group codes that are used to discriminate between different
+kinds of groups. They allow \TeX\ to decide what special actions, if any,
+should be performed when a group ends.
+\def\grp{\.{\char'173...\char'175}}
+
+Some groups are not supposed to be ended by right braces. For example,
+the `\.\$' that begins a math formula causes a |math_shift_group| to
+be started, and this should be terminated by a matching `\.\$'. Similarly,
+a group that starts with \.{\\left} should end with \.{\\right}, and
+one that starts with \.{\\begingroup} should end with \.{\\endgroup}.
+
+@d bottom_level=0 {group code for the outside world}
+@d simple_group=1 {group code for local structure only}
+@d hbox_group=2 {code for `\.{\\hbox}\grp'}
+@d adjusted_hbox_group=3 {code for `\.{\\hbox}\grp' in vertical mode}
+@d vbox_group=4 {code for `\.{\\vbox}\grp'}
+@d vtop_group=5 {code for `\.{\\vtop}\grp'}
+@d align_group=6 {code for `\.{\\halign}\grp', `\.{\\valign}\grp'}
+@d no_align_group=7 {code for `\.{\\noalign}\grp'}
+@d output_group=8 {code for output routine}
+@d math_group=9 {code for, e.g, `\.{\char'136}\grp'}
+@d disc_group=10 {code for `\.{\\discretionary}\grp\grp\grp'}
+@d insert_group=11 {code for `\.{\\insert}\grp', `\.{\\vadjust}\grp'}
+@d vcenter_group=12 {code for `\.{\\vcenter}\grp'}
+@d math_choice_group=13 {code for `\.{\\mathchoice}\grp\grp\grp\grp'}
+@d semi_simple_group=14 {code for `\.{\\begingroup...\\endgroup}'}
+@d math_shift_group=15 {code for `\.{\$...\$}'}
+@d math_left_group=16 {code for `\.{\\left...\\right}'}
+@d max_group_code=16
+
+@<Types...@>=
+@!group_code=0..max_group_code; {|save_level| for a level boundary}
+
+@ The global variable |cur_group| keeps track of what sort of group we are
+currently in. Another global variable, |cur_boundary|, points to the
+topmost |level_boundary| word. And |cur_level| is the current depth of
+nesting. The routines are designed to preserve the condition that no entry
+in the |save_stack| or in |eqtb| ever has a level greater than |cur_level|.
+
+@ @<Glob...@>=
+@!save_stack : array[0..save_size] of memory_word;
+@!save_ptr : 0..save_size; {first unused entry on |save_stack|}
+@!max_save_stack:0..save_size; {maximum usage of save stack}
+@!cur_level: quarterword; {current nesting level for groups}
+@!cur_group: group_code; {current group type}
+@!cur_boundary: 0..save_size; {where the current level begins}
+
+@ At this time it might be a good idea for the reader to review the introduction
+to |eqtb| that was given above just before the long lists of parameter names.
+Recall that the ``outer level'' of the program is |level_one|, since
+undefined control sequences are assumed to be ``defined'' at |level_zero|.
+
+@<Set init...@>=
+save_ptr:=0; cur_level:=level_one; cur_group:=bottom_level; cur_boundary:=0;
+max_save_stack:=0;
+
+@ The following macro is used to test if there is room for up to six more
+entries on |save_stack|. By making a conservative test like this, we can
+get by with testing for overflow in only a few places.
+
+@d check_full_save_stack==if save_ptr>max_save_stack then
+ begin max_save_stack:=save_ptr;
+ if max_save_stack>save_size-6 then overflow("save size",save_size);
+@:TeX capacity exceeded save size}{\quad save size@>
+ end
+
+@ Procedure |new_save_level| is called when a group begins. The
+argument is a group identification code like `|hbox_group|'. After
+calling this routine, it is safe to put five more entries on |save_stack|.
+
+In some cases integer-valued items are placed onto the
+|save_stack| just below a |level_boundary| word, because this is a
+convenient place to keep information that is supposed to ``pop up'' just
+when the group has finished.
+For example, when `\.{\\hbox to 100pt}\grp' is being treated, the 100pt
+dimension is stored on |save_stack| just before |new_save_level| is
+called.
+
+We use the notation |saved(k)| to stand for an integer item that
+appears in location |save_ptr+k| of the save stack.
+
+@d saved(#)==save_stack[save_ptr+#].int
+
+@p procedure new_save_level(@!c:group_code); {begin a new level of grouping}
+begin check_full_save_stack;
+save_type(save_ptr):=level_boundary; save_level(save_ptr):=cur_group;
+save_index(save_ptr):=cur_boundary;
+if cur_level=max_quarterword then overflow("grouping levels",
+@:TeX capacity exceeded grouping levels}{\quad grouping levels@>
+ max_quarterword-min_quarterword);
+ {quit if |(cur_level+1)| is too big to be stored in |eqtb|}
+cur_boundary:=save_ptr; incr(cur_level); incr(save_ptr); cur_group:=c;
+end;
+
+@ Just before an entry of |eqtb| is changed, the following procedure should
+be called to update the other data structures properly. It is important
+to keep in mind that reference counts in |mem| include references from
+within |save_stack|, so these counts must be handled carefully.
+@^reference counts@>
+
+@p procedure eq_destroy(@!w:memory_word); {gets ready to forget |w|}
+var q:pointer; {|equiv| field of |w|}
+begin case eq_type_field(w) of
+call,long_call,outer_call,long_outer_call: delete_token_ref(equiv_field(w));
+glue_ref: delete_glue_ref(equiv_field(w));
+shape_ref: begin q:=equiv_field(w); {we need to free a \.{\\parshape} block}
+ if q<>null then free_node(q,info(q)+info(q)+1);
+ end; {such a block is |2n+1| words long, where |n=info(q)|}
+box_ref: flush_node_list(equiv_field(w));
+othercases do_nothing
+endcases;
+end;
+
+@ To save a value of |eqtb[p]| that was established at level |l|, we
+can use the following subroutine.
+
+@p procedure eq_save(@!p:pointer;@!l:quarterword); {saves |eqtb[p]|}
+begin check_full_save_stack;
+if l=level_zero then save_type(save_ptr):=restore_zero
+else begin save_stack[save_ptr]:=eqtb[p]; incr(save_ptr);
+ save_type(save_ptr):=restore_old_value;
+ end;
+save_level(save_ptr):=l; save_index(save_ptr):=p; incr(save_ptr);
+end;
+
+@ The procedure |eq_define| defines an |eqtb| entry having specified
+|eq_type| and |equiv| fields, and saves the former value if appropriate.
+This procedure is used only for entries in the first four regions of |eqtb|,
+i.e., only for entries that have |eq_type| and |equiv| fields.
+After calling this routine, it is safe to put four more entries on
+|save_stack|, provided that there was room for four more entries before
+the call, since |eq_save| makes the necessary test.
+
+@p procedure eq_define(@!p:pointer;@!t:quarterword;@!e:halfword);
+ {new data for |eqtb|}
+begin if eq_level(p)=cur_level then eq_destroy(eqtb[p])
+else if cur_level>level_one then eq_save(p,eq_level(p));
+eq_level(p):=cur_level; eq_type(p):=t; equiv(p):=e;
+end;
+
+@ The counterpart of |eq_define| for the remaining (fullword) positions in
+|eqtb| is called |eq_word_define|. Since |xeq_level[p]>=level_one| for all
+|p|, a `|restore_zero|' will never be used in this case.
+
+@p procedure eq_word_define(@!p:pointer;@!w:integer);
+begin if xeq_level[p]<>cur_level then
+ begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level;
+ end;
+eqtb[p].int:=w;
+end;
+
+@ The |eq_define| and |eq_word_define| routines take care of local definitions.
+@^global definitions@>
+Global definitions are done in almost the same way, but there is no need
+to save old values, and the new value is associated with |level_one|.
+
+@p procedure geq_define(@!p:pointer;@!t:quarterword;@!e:halfword);
+ {global |eq_define|}
+begin eq_destroy(eqtb[p]);
+eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
+end;
+@#
+procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
+begin eqtb[p].int:=w; xeq_level[p]:=level_one;
+end;
+
+@ Subroutine |save_for_after| puts a token on the stack for save-keeping.
+
+@p procedure save_for_after(@!t:halfword);
+begin if cur_level>level_one then
+ begin check_full_save_stack;
+ save_type(save_ptr):=insert_token; save_level(save_ptr):=level_zero;
+ save_index(save_ptr):=t; incr(save_ptr);
+ end;
+end;
+
+@ The |unsave| routine goes the other way, taking items off of |save_stack|.
+This routine takes care of restoration when a level ends; everything
+belonging to the topmost group is cleared off of the save stack.
+
+@p@t\4@>@<Declare the procedure called |restore_trace|@>@;@/
+procedure@?back_input; forward; @t\2@>
+procedure unsave; {pops the top level off the save stack}
+label done;
+var p:pointer; {position to be restored}
+@!l:quarterword; {saved level, if in fullword regions of |eqtb|}
+@!t:halfword; {saved value of |cur_tok|}
+begin if cur_level>level_one then
+ begin decr(cur_level);
+ @<Clear off top level from |save_stack|@>;
+ end
+else confusion("curlevel"); {|unsave| is not used when |cur_group=bottom_level|}
+@:this can't happen curlevel}{\quad curlevel@>
+end;
+
+@ @<Clear off...@>=
+loop@+begin decr(save_ptr);
+ if save_type(save_ptr)=level_boundary then goto done;
+ p:=save_index(save_ptr);
+ if save_type(save_ptr)=insert_token then
+ @<Insert token |p| into \TeX's input@>
+ else begin if save_type(save_ptr)=restore_old_value then
+ begin l:=save_level(save_ptr); decr(save_ptr);
+ end
+ else save_stack[save_ptr]:=eqtb[undefined_control_sequence];
+ @<Store \(s)|save_stack[save_ptr]| in |eqtb[p]|, unless
+ |eqtb[p]| holds a global value@>;
+ end;
+ end;
+done: cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr)
+
+@ A global definition, which sets the level to |level_one|,
+@^global definitions@>
+will not be undone by |unsave|. If at least one global definition of
+|eqtb[p]| has been carried out within the group that just ended, the
+last such definition will therefore survive.
+
+@<Store \(s)|save...@>=
+if p<int_base then
+ if eq_level(p)=level_one then
+ begin eq_destroy(save_stack[save_ptr]); {destroy the saved value}
+ @!stat if tracing_restores>0 then restore_trace(p,"retaining");@+tats@;@/
+ end
+ else begin eq_destroy(eqtb[p]); {destroy the current value}
+ eqtb[p]:=save_stack[save_ptr]; {restore the saved value}
+ @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+ end
+else if xeq_level[p]<>level_one then
+ begin eqtb[p]:=save_stack[save_ptr]; xeq_level[p]:=l;
+ @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+ end
+else begin
+ @!stat if tracing_restores>0 then restore_trace(p,"retaining");@+tats@;@/
+ end
+
+@ @<Declare the procedure called |restore_trace|@>=
+@!stat procedure restore_trace(@!p:pointer;@!s:str_number);
+ {|eqtb[p]| has just been restored or retained}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+show_eqtb(p); print_char("}");
+end_diagnostic(false);
+end;
+tats
+
+@ When looking for possible pointers to a memory location, it is helpful
+to look for references from |eqtb| that might be waiting on the
+save stack. Of course, we might find spurious pointers too; but this
+routine is merely an aid when debugging, and at such times we are
+grateful for any scraps of information, even if they prove to be irrelevant.
+@^dirty \PASCAL@>
+
+@<Search |save_stack| for equivalents that point to |p|@>=
+if save_ptr>0 then for q:=0 to save_ptr-1 do
+ begin if equiv_field(save_stack[q])=p then
+ begin print_nl("SAVE("); print_int(q); print_char(")");
+ end;
+ end
+
+@ Most of the parameters kept in |eqtb| can be changed freely, but there's
+an exception: The magnification should not be used with two different
+values during any \TeX\ job, since a single magnification is applied to an
+entire run. The global variable |mag_set| is set to the current magnification
+whenever it becomes necessary to ``freeze'' it at a particular value.
+
+@<Glob...@>=
+@!mag_set:integer; {if nonzero, this magnification should be used henceforth}
+
+@ @<Set init...@>=
+mag_set:=0;
+
+@ The |prepare_mag| subroutine is called whenever \TeX\ wants to use |mag|
+for magnification.
+
+@p procedure prepare_mag;
+begin if (mag_set>0)and(mag<>mag_set) then
+ begin print_err("Incompatible magnification ("); print_int(mag);
+@.Incompatible magnification@>
+ print(");"); print_nl(" the previous value will be retained");
+ help2("I can handle only one magnification ratio per job. So I've")@/
+ ("reverted to the magnification you used earlier on this run.");@/
+ int_error(mag_set);
+ geq_word_define(int_base+mag_code,mag_set); {|mag:=mag_set|}
+ end;
+if (mag<=0)or(mag>32768) then
+ begin print_err("Illegal magnification has been changed to 1000");@/
+@.Illegal magnification...@>
+ help1("The magnification ratio must be between 1 and 32768.");
+ int_error(mag); geq_word_define(int_base+mag_code,1000);
+ end;
+mag_set:=mag;
+end;
+
+@* \[20] Token lists.
+A \TeX\ token is either a character or a control sequence, and it is
+@^token@>
+represented internally in one of two ways: (1)~A character whose ASCII
+code number is |c| and whose command code is |m| is represented as the
+number $2^8m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{12}-1$@>| is larger than
+$2^8m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|;
+thus, a token fits comfortably in a halfword.
+
+A token |t| represents a |left_brace| command if and only if
+|t<left_brace_limit|; it represents a |right_brace| command if and only if
+we have |left_brace_limit<=t<right_brace_limit|; and it represents a |match| or
+|end_match| command if and only if |match_token<=t<=end_match_token|.
+The following definitions take care of these token-oriented constants
+and a few others.
+
+@d cs_token_flag==@'7777 {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~256, less~1}
+@d left_brace_token=@'0400 {$2^8\cdot|left_brace|$}
+@d left_brace_limit=@'1000 {$2^8\cdot(|left_brace|+1)$}
+@d right_brace_token=@'1000 {$2^8\cdot|right_brace|$}
+@d right_brace_limit=@'1400 {$2^8\cdot(|right_brace|+1)$}
+@d math_shift_token=@'1400 {$2^8\cdot|math_shift|$}
+@d tab_token=@'2000 {$2^8\cdot|tab_mark|$}
+@d out_param_token=@'2400 {$2^8\cdot|out_param|$}
+@d space_token=@'5040 {$2^8\cdot|spacer|+|" "|$}
+@d letter_token=@'5400 {$2^8\cdot|letter|$}
+@d other_token=@'6000 {$2^8\cdot|other_char|$}
+@d match_token=@'6400 {$2^8\cdot|match|$}
+@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
+
+@ @<Check the ``constant''...@>=
+if cs_token_flag+undefined_control_sequence>max_halfword then bad:=21;
+
+@ A token list is a singly linked list of one-word nodes in |mem|, where
+each word contains a token and a link. Macro definitions, output-routine
+definitions, marks, \.{\\write} texts, and a few other things
+are remembered by \TeX\ in the form
+of token lists, usually preceded by a node with a reference count in its
+|token_ref_count| field. The token stored in location |p| is called
+|info(p)|.
+
+Three special commands appear in the token lists of macro definitions.
+When |m=match|, it means that \TeX\ should scan a parameter
+for the current macro; when |m=end_match|, it means that parameter
+matching should end and \TeX\ should start reading the macro text; and
+when |m=out_param|, it means that \TeX\ should insert parameter
+number |c| into the text at this point.
+
+The enclosing \.{\char'173} and \.{\char'175} characters of a macro
+definition are omitted, but the final right brace of an output routine
+is included at the end of its token list.
+
+Here is an example macro definition that illustrates these conventions.
+After \TeX\ processes the text
+$$\.{\\def\\mac a\#1\#2 \\b \{\#1\\-a \#\#1\#2 \#2\}}$$
+the definition of \.{\\mac} is represented as a token list containing
+$$\def\,{\hskip2pt}
+\vbox{\halign{\hfil#\hfil\cr
+(reference count), |letter|\,\.a, |match|\,\#, |match|\,\#, |spacer|\,\.\ ,
+\.{\\b}, |end_match|,\cr
+|out_param|\,1, \.{\\-}, |letter|\,\.a, |spacer|\,\.\ , |mac_param|\,\#,
+|other_char|\,\.1,\cr
+|out_param|\,2, |spacer|\,\.\ , |out_param|\,2.\cr}}$$
+The procedure |scan_toks| builds such token lists, and |macro_call|
+does the parameter matching.
+@^reference counts@>
+
+Examples such as
+$$\.{\\def\\m\{\\def\\m\{a\}\ b\}}$$
+explain why reference counts would be needed even if \TeX\ had no \.{\\let}
+operation: When the token list for \.{\\m} is being read, the redefinition of
+\.{\\m} changes the |eqtb| entry before the token list has been fully
+consumed, so we dare not simply destroy a token list when its
+control sequence is being redefined.
+
+If the parameter-matching part of a definition ends with `\.{\#\{}',
+the corresponding token list will have `\.\{' just before the `|end_match|'
+and also at the very end. The first `\.\{' is used to delimit the parameter; the
+second one keeps the first from disappearing.
+
+@ The procedure |show_token_list|, which prints a symbolic form of
+the token list that starts at a given node |p|, illustrates these
+conventions. The token list being displayed should not begin with a reference
+count. However, the procedure is intended to be robust, so that if the
+memory links are awry or if |p| is not really a pointer to a token list,
+nothing catastrophic will happen.
+
+An additional parameter |q| is also given; this parameter is either null
+or it points to a node in the token list where a certain magic computation
+takes place that will be explained later. (Basically, |q| is non-null when
+we are printing the two-line context information at the time of an error
+message; |q| marks the place corresponding to where the second line
+should begin.)
+
+For example, if |p| points to the node containing the first \.a in the
+token list above, then |show_token_list| will print the string
+$$\hbox{`\.{a\#1\#2\ \\b\ ->\#1\\-a\ \#\#1\#2\ \#2}';}$$
+and if |q| points to the node containing the second \.a,
+the magic computation will be performed just before the second \.a is printed.
+
+The generation will stop, and `\.{\\ETC.}' will be printed, if the length
+of printing exceeds a given limit~|l|. Anomalous entries are printed in the
+form of control sequences that are not followed by a blank space, e.g.,
+`\.{\\BAD.}'; this cannot be confused with actual control sequences because
+a real control sequence named \.{BAD} would come out `\.{\\BAD\ }'.
+
+@<Declare the procedure called |show_token_list|@>=
+procedure show_token_list(@!p,@!q:integer;@!l:integer);
+label exit;
+var m,@!c:integer; {pieces of a token}
+@!match_chr:ASCII_code; {character used in a `|match|'}
+@!n:ASCII_code; {the highest parameter number, as an ASCII digit}
+begin match_chr:="#"; n:="0"; tally:=0;
+while (p<>null) and (tally<l) do
+ begin if p=q then @<Do magic computation@>;
+ @<Display token |p|, and |return| if there are problems@>;
+ p:=link(p);
+ end;
+if p<>null then print_esc("ETC.");
+@.ETC@>
+exit:
+end;
+
+@ @<Display token |p|...@>=
+if (p<hi_mem_min) or (p>mem_end) then
+ begin print_esc("CLOBBERED."); return;
+@.CLOBBERED@>
+ end;
+if info(p)>=cs_token_flag then print_cs(info(p)-cs_token_flag)
+else begin m:=info(p) div @'400; c:=info(p) mod @'400;
+ if info(p)<0 then print_esc("BAD.")
+@.BAD@>
+ else @<Display the token $(|m|,|c|)$@>;
+ end
+
+@ The procedure usually ``learns'' the character code used for macro
+parameters by seeing one in a |match| command before it runs into any
+|out_param| commands.
+
+@<Display the token ...@>=
+case m of
+left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer,
+ letter,other_char: print(c);
+mac_param: begin print(c); print(c);
+ end;
+out_param: begin print(match_chr);
+ if c<=9 then print_char(c+"0")
+ else begin print_char("!"); return;
+ end;
+ end;
+match: begin match_chr:=c; print(c); incr(n); print_char(n);
+ if n>"9" then return;
+ end;
+end_match: print("->");
+@.->@>
+othercases print_esc("BAD.")
+@.BAD@>
+endcases
+
+@ Here's the way we sometimes want to display a token list, given a pointer
+to its reference count; the pointer may be null.
+
+@p procedure token_show(@!p:pointer);
+begin if p<>null then show_token_list(link(p),null,10000000);
+end;
+
+@ The |print_meaning| subroutine displays |cur_cmd| and |cur_chr| in
+symbolic form, including the expansion of a macro or mark.
+
+@p procedure print_meaning;
+begin print_cmd_chr(cur_cmd,cur_chr);
+if cur_cmd>=call then
+ begin print_char(":"); print_ln; token_show(cur_chr);
+ end
+else if cur_cmd=top_bot_mark then
+ begin print_char(":"); print_ln;
+ token_show(cur_mark[cur_chr]);
+ end;
+end;
+
+@* \[21] Introduction to the syntactic routines.
+Let's pause a moment now and try to look at the Big Picture.
+The \TeX\ program consists of three main parts: syntactic routines,
+semantic routines, and output routines. The chief purpose of the
+syntactic routines is to deliver the user's input to the semantic routines,
+one token at a time. The semantic routines act as an interpreter
+responding to these tokens, which may be regarded as commands. And the
+output routines are periodically called on to convert box-and-glue
+lists into a compact set of instructions that will be sent
+to a typesetter. We have discussed the basic data structures and utility
+routines of \TeX, so we are good and ready to plunge into the real activity by
+considering the syntactic routines.
+
+Our current goal is to come to grips with the |get_next| procedure,
+which is the keystone of \TeX's input mechanism. Each call of |get_next|
+sets the value of three variables |cur_cmd|, |cur_chr|, and |cur_cs|,
+representing the next input token.
+$$\vbox{\halign{#\hfil\cr
+ \hbox{|cur_cmd| denotes a command code from the long list of codes
+ given above;}\cr
+ \hbox{|cur_chr| denotes a character code or other modifier of the command
+ code;}\cr
+ \hbox{|cur_cs| is the |eqtb| location of the current control sequence,}\cr
+ \hbox{\qquad if the current token was a control sequence,
+ otherwise it's zero.}\cr}}$$
+Underlying this external behavior of |get_next| is all the machinery
+necessary to convert from character files to tokens. At a given time we
+may be only partially finished with the reading of several files (for
+which \.{\\input} was specified), and partially finished with the expansion
+of some user-defined macros and/or some macro parameters, and partially
+finished with the generation of some text in a template for \.{\\halign},
+and so on. When reading a character file, special characters must be
+classified as math delimiters, etc.; comments and extra blank spaces must
+be removed, paragraphs must be recognized, and control sequences must be
+found in the hash table. Furthermore there are occasions in which the
+scanning routines have looked ahead for a word like `\.{plus}' but only
+part of that word was found, hence a few characters must be put back
+into the input and scanned again.
+
+To handle these situations, which might all be present simultaneously,
+\TeX\ uses various stacks that hold information about the incomplete
+activities, and there is a finite state control for each level of the
+input mechanism. These stacks record the current state of an implicitly
+recursive process, but the |get_next| procedure is not recursive.
+Therefore it will not be difficult to translate these algorithms into
+low-level languages that do not support recursion.
+
+@<Glob...@>=
+@!cur_cmd: eight_bits; {current command set by |get_next|}
+@!cur_chr: halfword; {operand of current command}
+@!cur_cs: pointer; {control sequence found here, zero if none found}
+@!cur_tok: halfword; {packed representative of |cur_cmd| and |cur_chr|}
+
+@ The |print_cmd_chr| routine prints a symbolic interpretation of a
+command code and its modifier. This is used in certain `\.{You can\'t}'
+error messages, and in the implementation of diagnostic routines like
+\.{\\show}.
+
+The body of |print_cmd_chr| is a rather tedious listing of print
+commands, and most of it is essentially an inverse to the |primitive|
+routine that enters a \TeX\ primitive into |eqtb|. Therefore much of
+this procedure appears elsewhere in the program,
+together with the corresponding |primitive| calls.
+
+@d chr_cmd(#)==begin print(#); print_ASCII(chr_code);
+ end
+
+@<Declare the procedure called |print_cmd_chr|@>=
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+begin case cmd of
+left_brace: chr_cmd("begin-group character ");
+right_brace: chr_cmd("end-group character ");
+math_shift: chr_cmd("math shift character ");
+mac_param: chr_cmd("macro parameter character ");
+sup_mark: chr_cmd("superscript character ");
+sub_mark: chr_cmd("subscript character ");
+endv: print("end of alignment template");
+spacer: chr_cmd("blank space ");
+letter: chr_cmd("the letter ");
+other_char: chr_cmd("the character ");
+@t\4@>@<Cases of |print_cmd_chr| for symbolic printing of primitives@>@/
+othercases print("[unknown command code!]")
+endcases;
+end;
+
+@ Here is a procedure that displays the current command.
+
+@p procedure show_cur_cmd_chr;
+begin begin_diagnostic; print_nl("{");
+if mode<>shown_mode then
+ begin print_mode(mode); print(": "); shown_mode:=mode;
+ end;
+print_cmd_chr(cur_cmd,cur_chr); print_char("}");
+end_diagnostic(false);
+end;
+
+@* \[22] Input stacks and states.
+This implementation of
+\TeX\ uses two different conventions for representing sequential stacks.
+@^stack conventions@>@^conventions for representing stacks@>
+
+\yskip\hangg 1) If there is frequent access to the top entry, and if the
+stack is essentially never empty, then the top entry is kept in a global
+variable (even better would be a machine register), and the other entries
+appear in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the
+semantic stack described above is handled this way, and so is the input
+stack that we are about to study.
+
+\yskip\hangg 2) If there is infrequent top access, the entire stack contents
+are in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the |save_stack|
+is treated this way, as we have seen.
+
+\yskip\noindent
+The state of \TeX's input mechanism appears in the input stack, whose
+entries are records with six fields, called |state|, |index|, |start|, |loc|,
+|limit|, and |name|. This stack is maintained with
+convention~(1), so it is declared in the following way:
+
+@<Types...@>=
+@!in_state_record = record
+ @!state_field, @!index_field: quarterword;
+ @!start_field,@!loc_field, @!limit_field, @!name_field: halfword;
+ end;
+
+@ @<Glob...@>=
+@!input_stack : array[0..stack_size] of in_state_record;
+@!input_ptr : 0..stack_size; {first unused location of |input_stack|}
+@!max_in_stack: 0..stack_size; {largest value of |input_ptr| when pushing}
+@!cur_input : in_state_record;
+ {the ``top'' input state, according to convention (1)}
+
+@ We've already defined the special variable |loc==cur_input.loc_field|
+in our discussion of basic input-output routines. The other components of
+|cur_input| are defined in the same way:
+
+@d state==cur_input.state_field {current scanner state}
+@d index==cur_input.index_field {reference for buffer information}
+@d start==cur_input.start_field {starting position in |buffer|}
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d name==cur_input.name_field {name of the current file}
+
+@ Let's look more closely now at the control variables
+(|state|,~|index|,~|start|,~|loc|,~|limit|,~|name|),
+assuming that \TeX\ is reading a line of characters that have been input
+from some file or from the user's terminal. There is an array called
+|buffer| that acts as a stack of all lines of characters that are
+currently being read from files, including all lines on subsidiary
+levels of the input stack that are not yet completed. \TeX\ will return to
+the other lines when it is finished with the present input file.
+
+(Incidentally, on a machine with byte-oriented addressing, it might be
+appropriate to combine |buffer| with the |str_pool| array,
+letting the buffer entries grow downward from the top of the string pool
+and checking that these two tables don't bump into each other.)
+
+The line we are currently working on begins in position |start| of the
+buffer; the next character we are about to read is |buffer[loc]|; and
+|limit| is the location of the last character present. If |loc>limit|,
+the line has been completely read. Usually |buffer[limit]| is the
+|end_line_char|, denoting the end of a line, but this is not
+true if the current line is an insertion that was entered on the user's
+terminal in response to an error message.
+
+The |name| variable is a string number that designates the name of
+the current file, if we are reading a text file. It is zero if we
+are reading from the terminal; it is |n+1| if we are reading from
+input stream |n|, where |0<=n<=16|. (Input stream 16 stands for
+an invalid stream number; in such cases the input is actually from
+the terminal, under control of the procedure |read_toks|.)
+
+The |state| variable has one of three values, when we are scanning such
+files:
+$$\baselineskip 15pt\vbox{\halign{#\hfil\cr
+1) |state=mid_line| is the normal state.\cr
+2) |state=skip_blanks| is like |mid_line|, but blanks are ignored.\cr
+3) |state=new_line| is the state at the beginning of a line.\cr}}$$
+These state values are assigned numeric codes so that if we add the state
+code to the next character's command code, we get distinct values. For
+example, `|mid_line+spacer|' stands for the case that a blank
+space character occurs in the middle of a line when it is not being
+ignored; after this case is processed, the next value of |state| will
+be |skip_blanks|.
+
+@d mid_line=1 {|state| code when scanning a line of characters}
+@d skip_blanks=2+max_char_code {|state| code when ignoring blanks}
+@d new_line=3+max_char_code+max_char_code {|state| code at start of line}
+
+@ Additional information about the current line is available via the
+|index| variable, which counts how many lines of characters are present
+in the buffer below the current level. We have |index=0| when reading
+from the terminal and prompting the user for each line; then if the user types,
+e.g., `\.{\\input paper}', we will have |index=1| while reading
+the file \.{paper.tex}. However, it does not follow that |index| is the
+same as the input stack pointer, since many of the levels on the input
+stack may come from token lists. For example, the instruction `\.{\\input
+paper}' might occur in a token list.
+
+The global variable |in_open| is equal to the |index|
+value of the highest non-token-list level. Thus, the number of partially read
+lines in the buffer is |in_open+1|, and we have |in_open=index|
+when we are not reading a token list.
+
+If we are not currently reading from the terminal, or from an input
+stream, we are reading from the file variable |input_file[index]|. We use
+the notation |terminal_input| as a convenient abbreviation for |name=0|,
+and |cur_file| as an abbreviation for |input_file[index]|.
+
+The global variable |line| contains the line number in the topmost
+open file, for use in error messages. If we are not reading from
+the terminal, |line_stack[index]| holds the line number for the
+enclosing level, so that |line| can be restored when the current
+file has been read. Line numbers should never be negative, since the
+negative of the current line number is used to identify the user's output
+routine in the |mode_line| field of the semantic nest entries.
+
+If more information about the input state is needed, it can be
+included in small arrays like those shown here. For example,
+the current page or segment number in the input file might be
+put into a variable |@!page|, maintained for enclosing levels in
+`\ignorespaces|@!page_stack:array[1..max_in_open] of integer|\unskip'
+by analogy with |line_stack|.
+@^system dependencies@>
+
+@d terminal_input==(name=0) {are we reading from the terminal?}
+@d cur_file==input_file[index] {the current |alpha_file| variable}
+
+@<Glob...@>=
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : array[1..max_in_open] of alpha_file;
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+
+@ Users of \TeX\ sometimes forget to balance left and right braces properly,
+and one of the ways \TeX\ tries to spot such errors is by considering an
+input file as broken into subfiles by control sequences that
+are declared to be \.{\\outer}.
+
+A variable called |scanner_status| tells \TeX\ whether or not to complain
+when a subfile ends. This variable has six possible values:
+
+\yskip\hang|normal|, means that a subfile can safely end here without incident.
+
+\yskip\hang|skipping|, means that a subfile can safely end here, but not a file,
+because we're reading past some conditional text that was not selected.
+
+\yskip\hang|defining|, means that a subfile shouldn't end now because a
+macro is being defined.
+
+\yskip\hang|matching|, means that a subfile shouldn't end now because a
+macro is being used and we are searching for the end of its arguments.
+
+\yskip\hang|aligning|, means that a subfile shouldn't end now because we are
+not finished with the preamble of an \.{\\halign} or \.{\\valign}.
+
+\yskip\hang|absorbing|, means that a subfile shouldn't end now because we are
+reading a balanced token list for \.{\\message}, \.{\\write}, etc.
+
+\yskip\noindent
+If the |scanner_status| is not |normal|, the variable |warning_index| points
+to the |eqtb| location for the relevant control sequence name to print
+in an error message.
+
+@d skipping=1 {|scanner_status| when passing conditional text}
+@d defining=2 {|scanner_status| when reading a macro definition}
+@d matching=3 {|scanner_status| when reading macro arguments}
+@d aligning=4 {|scanner_status| when reading an alignment preamble}
+@d absorbing=5 {|scanner_status| when reading a balanced text}
+
+@<Glob...@>=
+@!scanner_status : normal..absorbing; {can a subfile end now?}
+@!warning_index : pointer; {identifier relevant to non-|normal| scanner status}
+@!def_ref : pointer; {reference count of token list being defined}
+
+@ Here is a procedure that uses |scanner_status| to print a warning message
+when a subfile has ended, and at certain other crucial times:
+
+@<Declare the procedure called |runaway|@>=
+procedure runaway;
+var p:pointer; {head of runaway list}
+begin if scanner_status>skipping then
+ begin print_nl("Runaway ");
+@.Runaway...@>
+ case scanner_status of
+ defining: begin print("definition"); p:=def_ref;
+ end;
+ matching: begin print("argument"); p:=temp_head;
+ end;
+ aligning: begin print("preamble"); p:=hold_head;
+ end;
+ absorbing: begin print("text"); p:=def_ref;
+ end;
+ end; {there are no other cases}
+ print_char("?");print_ln; show_token_list(link(p),null,error_line-10);
+ end;
+end;
+
+@ However, all this discussion about input state really applies only to the
+case that we are inputting from a file. There is another important case,
+namely when we are currently getting input from a token list. In this case
+|state=token_list|, and the conventions about the other state variables
+are different:
+
+\yskip\hang|loc| is a pointer to the current node in the token list, i.e.,
+the node that will be read next. If |loc=null|, the token list has been
+fully read.
+
+\yskip\hang|start| points to the first node of the token list; this node
+may or may not contain a reference count, depending on the type of token
+list involved.
+
+\yskip\hang|token_type|, which takes the place of |index| in the
+discussion above, is a code number that explains what kind of token list
+is being scanned.
+
+\yskip\hang|name| points to the |eqtb| address of the control sequence
+being expanded, if the current token list is a macro.
+
+\yskip\hang|param_start|, which takes the place of |limit|, tells where
+the parameters of the current macro begin in the |param_stack|, if the
+current token list is a macro.
+
+\yskip\noindent The |token_type| can take several values, depending on
+where the current token list came from:
+
+\yskip\hang|parameter|, if a parameter is being scanned;
+
+\hang|u_template|, if the \<u_j> part of an alignment
+template is being scanned;
+
+\hang|v_template|, if the \<v_j> part of an alignment
+template is being scanned;
+
+\hang|backed_up|, if the token list being scanned has been inserted as
+`to be read again'.
+
+\hang|inserted|, if the token list being scanned has been inserted as
+the text expansion of a \.{\\count} or similar variable;
+
+\hang|macro|, if a user-defined control sequence is being scanned;
+
+\hang|output_text|, if an \.{\\output} routine is being scanned;
+
+\hang|every_par_text|, if the text of \.{\\everypar} is being scanned;
+
+\hang|every_math_text|, if the text of \.{\\everymath} is being scanned;
+
+\hang|every_display_text|, if the text of \.{\\everydisplay} is being scanned;
+
+\hang|every_hbox_text|, if the text of \.{\\everyhbox} is being scanned;
+
+\hang|every_vbox_text|, if the text of \.{\\everyvbox} is being scanned;
+
+\hang|every_job_text|, if the text of \.{\\everyjob} is being scanned;
+
+\hang|every_cr_text|, if the text of \.{\\everycr} is being scanned;
+
+\hang|mark_text|, if the text of a \.{\\mark} is being scanned;
+
+\hang|write_text|, if the text of a \.{\\write} is being scanned.
+
+\yskip\noindent
+The codes for |output_text|, |every_par_text|, etc., are equal to a constant
+plus the corresponding codes for token list parameters |output_routine_loc|,
+|every_par_loc|, etc. The token list begins with a reference count if and
+only if |token_type>=macro|.
+@^reference counts@>
+
+@d token_list=0 {|state| code when scanning a token list}
+@d token_type==index {type of current token list}
+@d param_start==limit {base of macro parameters in |param_stack|}
+@d parameter=0 {|token_type| code for parameter}
+@d u_template=1 {|token_type| code for \<u_j> template}
+@d v_template=2 {|token_type| code for \<v_j> template}
+@d backed_up=3 {|token_type| code for text to be reread}
+@d inserted=4 {|token_type| code for inserted texts}
+@d macro=5 {|token_type| code for defined control sequences}
+@d output_text=6 {|token_type| code for output routines}
+@d every_par_text=7 {|token_type| code for \.{\\everypar}}
+@d every_math_text=8 {|token_type| code for \.{\\everymath}}
+@d every_display_text=9 {|token_type| code for \.{\\everydisplay}}
+@d every_hbox_text=10 {|token_type| code for \.{\\everyhbox}}
+@d every_vbox_text=11 {|token_type| code for \.{\\everyvbox}}
+@d every_job_text=12 {|token_type| code for \.{\\everyjob}}
+@d every_cr_text=13 {|token_type| code for \.{\\everycr}}
+@d mark_text=14 {|token_type| code for \.{\\topmark}, etc.}
+@d write_text=15 {|token_type| code for \.{\\write}}
+
+@ The |param_stack| is an auxiliary array used to hold pointers to the token
+lists for parameters at the current level and subsidiary levels of input.
+This stack is maintained with convention (2), and it grows at a different
+rate from the others.
+
+@<Glob...@>=
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+@!param_ptr:0..param_size; {first unused entry in |param_stack|}
+@!max_param_stack:integer;
+ {largest value of |param_ptr|, will be |<=param_size+9|}
+
+@ The input routines must also interact with the processing of
+\.{\\halign} and \.{\\valign}, since the appearance of tab marks and
+\.{\\cr} in certain places is supposed to trigger the beginning of special
+\<v_j> template text in the scanner. This magic is accomplished by an
+|align_state| variable that is increased by~1 when a `\.{\char'173}' is
+scanned and decreased by~1 when a `\.{\char'175}' is scanned. The |align_state|
+is nonzero during the \<u_j> template, after which it is set to zero; the
+\<v_j> template begins when a tab mark or \.{\\cr} occurs at a time that
+|align_state=0|.
+
+@<Glob...@>=
+@!align_state:integer; {group level with respect to current alignment}
+
+@ Thus, the ``current input state'' can be very complicated indeed; there
+can be many levels and each level can arise in a variety of ways. The
+|show_context| procedure, which is used by \TeX's error-reporting routine to
+print out the current input state on all levels down to the most recent
+line of characters from an input file, illustrates most of these conventions.
+The global variable |base_ptr| contains the lowest level that was
+displayed by this procedure.
+
+@<Glob...@>=
+@!base_ptr:0..stack_size; {shallowest level shown by |show_context|}
+
+@ The status at each level is indicated by printing two lines, where the first
+line indicates what was read so far and the second line shows what remains
+to be read. The context is cropped, if necessary, so that the first line
+contains at most |half_error_line| characters, and the second contains
+at most |error_line|. Non-current input levels whose |token_type| is
+`|backed_up|' are shown only if they have not been fully read.
+
+@p procedure show_context; {prints where the scanner is}
+label done;
+var old_setting:0..max_selector; {saved |selector| setting}
+@!nn:integer; {number of contexts shown so far, less one}
+@!bottom_line:boolean; {have we reached the final context to be shown?}
+@<Local variables for formatting calculations@>@/
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+ {store current state}
+nn:=-1; bottom_line:=false;
+loop@+begin cur_input:=input_stack[base_ptr]; {enter into the context}
+ if (state<>token_list) then
+ if (name>17) or (base_ptr=0) then bottom_line:=true;
+ if (base_ptr=input_ptr)or bottom_line or(nn<error_context_lines) then
+ @<Display the current context@>
+ else if nn=error_context_lines then
+ begin print_nl("..."); incr(nn); {omitted if |error_context_lines<0|}
+ end;
+ if bottom_line then goto done;
+ decr(base_ptr);
+ end;
+done: cur_input:=input_stack[input_ptr]; {restore original state}
+end;
+
+@ @<Display the current context@>=
+begin if (base_ptr=input_ptr) or (state<>token_list) or
+ (token_type<>backed_up) or (loc<>null) then
+ {we omit backed-up token lists that have already been read}
+ begin tally:=0; {get ready to count characters}
+ old_setting:=selector;
+ if state<>token_list then
+ begin @<Print location of current line@>;
+ @<Pseudoprint the line@>;
+ end
+ else begin @<Print type of token list@>;
+ @<Pseudoprint the token list@>;
+ end;
+ selector:=old_setting; {stop pseudoprinting}
+ @<Print two lines using the tricky pseudoprinted information@>;
+ incr(nn);
+ end;
+end
+
+@ This routine should be changed, if necessary, to give the best possible
+indication of where the current line resides in the input file.
+For example, on some systems it is best to print both a page and line number.
+@^system dependencies@>
+
+@<Print location of current line@>=
+if name<=17 then
+ if terminal_input then
+ if base_ptr=0 then print_nl("<*>") else print_nl("<insert> ")
+ else begin print_nl("<read ");
+ if name=17 then print_char("*")@+else print_int(name-1);
+@.*\relax@>
+ print_char(">");
+ end
+else begin print_nl("l."); print_int(line);
+ end;
+print_char(" ")
+
+@ @<Print type of token list@>=
+case token_type of
+parameter: print_nl("<argument> ");
+u_template,v_template: print_nl("<template> ");
+backed_up: if loc=null then print_nl("<recently read> ")
+ else print_nl("<to be read again> ");
+inserted: print_nl("<inserted text> ");
+macro: begin print_ln; print_cs(name);
+ end;
+output_text: print_nl("<output> ");
+every_par_text: print_nl("<everypar> ");
+every_math_text: print_nl("<everymath> ");
+every_display_text: print_nl("<everydisplay> ");
+every_hbox_text: print_nl("<everyhbox> ");
+every_vbox_text: print_nl("<everyvbox> ");
+every_job_text: print_nl("<everyjob> ");
+every_cr_text: print_nl("<everycr> ");
+mark_text: print_nl("<mark> ");
+write_text: print_nl("<write> ");
+othercases print_nl("?") {this should never happen}
+endcases
+
+@ Here it is necessary to explain a little trick. We don't want to store a long
+string that corresponds to a token list, because that string might take up
+lots of memory; and we are printing during a time when an error message is
+being given, so we dare not do anything that might overflow one of \TeX's
+tables. So `pseudoprinting' is the answer: We enter a mode of printing
+that stores characters into a buffer of length |error_line|, where character
+$k+1$ is placed into \hbox{|trick_buf[k mod error_line]|} if
+|k<trick_count|, otherwise character |k| is dropped. Initially we set
+|tally:=0| and |trick_count:=1000000|; then when we reach the
+point where transition from line 1 to line 2 should occur, we
+set |first_count:=tally| and |trick_count:=@tmax@>(error_line,
+tally+1+error_line-half_error_line)|. At the end of the
+pseudoprinting, the values of |first_count|, |tally|, and
+|trick_count| give us all the information we need to print the two lines,
+and all of the necessary text is in |trick_buf|.
+
+Namely, let |l| be the length of the descriptive information that appears
+on the first line. The length of the context information gathered for that
+line is |k=first_count|, and the length of the context information
+gathered for line~2 is $m=\min(|tally|, |trick_count|)-k$. If |l+k<=h|,
+where |h=half_error_line|, we print |trick_buf[0..k-1]| after the
+descriptive information on line~1, and set |n:=l+k|; here |n| is the
+length of line~1. If $l+k>h$, some cropping is necessary, so we set |n:=h|
+and print `\.{...}' followed by
+$$\hbox{|trick_buf[(l+k-h+3)..k-1]|,}$$
+where subscripts of |trick_buf| are circular modulo |error_line|. The
+second line consists of |n|~spaces followed by |trick_buf[k..(k+m-1)]|,
+unless |n+m>error_line|; in the latter case, further cropping is done.
+This is easier to program than to explain.
+
+@<Local variables for formatting...@>=
+@!i:0..buf_size; {index into |buffer|}
+@!j:0..buf_size; {end of current line in |buffer|}
+@!l:0..half_error_line; {length of descriptive information on line 1}
+@!m:integer; {context information gathered for line 2}
+@!n:0..error_line; {length of line 1}
+@!p: integer; {starting or ending place in |trick_buf|}
+@!q: integer; {temporary index}
+
+@ The following code sets up the print routines so that they will gather
+the desired information.
+
+@d begin_pseudoprint==
+ begin l:=tally; tally:=0; selector:=pseudo;
+ trick_count:=1000000;
+ end
+@d set_trick_count==
+ begin first_count:=tally;
+ trick_count:=tally+1+error_line-half_error_line;
+ if trick_count<error_line then trick_count:=error_line;
+ end
+
+@ And the following code uses the information after it has been gathered.
+
+@<Print two lines using the tricky pseudoprinted information@>=
+if trick_count=1000000 then set_trick_count;
+ {|set_trick_count| must be performed}
+if tally<trick_count then m:=tally-first_count
+else m:=trick_count-first_count; {context on line 2}
+if l+first_count<=half_error_line then
+ begin p:=0; n:=l+first_count;
+ end
+else begin print("..."); p:=l+first_count-half_error_line+3;
+ n:=half_error_line;
+ end;
+for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]);
+print_ln;
+for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2}
+if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3);
+for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]);
+if m+n>error_line then print("...")
+
+@ But the trick is distracting us from our current goal, which is to
+understand the input state. So let's concentrate on the data structures that
+are being pseudoprinted as we finish up the |show_context| procedure.
+
+@<Pseudoprint the line@>=
+begin_pseudoprint;
+if buffer[limit]=end_line_char then j:=limit
+else j:=limit+1; {determine the effective end of the line}
+if j>0 then for i:=start to j-1 do
+ begin if i=loc then set_trick_count;
+ print(buffer[i]);
+ end
+
+@ @<Pseudoprint the token list@>=
+begin_pseudoprint;
+if token_type<macro then show_token_list(start,loc,100000)
+else show_token_list(link(start),loc,100000) {avoid reference count}
+
+@ Here is the missing piece of |show_token_list| that is activated when the
+token beginning line~2 is about to be shown:
+
+@<Do magic computation@>=set_trick_count
+
+@* \[23] Maintaining the input stacks.
+The following subroutines change the input status in commonly needed ways.
+
+First comes |push_input|, which stores the current state and creates a
+new level (having, initially, the same properties as the old).
+
+@d push_input==@t@> {enter a new input level, save the old}
+ begin if input_ptr>max_in_stack then
+ begin max_in_stack:=input_ptr;
+ if input_ptr=stack_size then overflow("input stack size",stack_size);
+@:TeX capacity exceeded input stack size}{\quad input stack size@>
+ end;
+ input_stack[input_ptr]:=cur_input; {stack the record}
+ incr(input_ptr);
+ end
+
+@ And of course what goes up must come down.
+
+@d pop_input==@t@> {leave an input level, re-enter the old}
+ begin decr(input_ptr); cur_input:=input_stack[input_ptr];
+ end
+
+@ Here is a procedure that starts a new level of token-list input, given
+a token list |p| and its type |t|. If |t=macro|, the calling routine should
+set |name| and |loc|.
+
+@d back_list(#)==begin_token_list(#,backed_up) {backs up a simple token list}
+@d ins_list(#)==begin_token_list(#,inserted) {inserts a simple token list}
+
+@p procedure begin_token_list(@!p:pointer;@!t:quarterword);
+begin push_input; state:=token_list; start:=p; token_type:=t;
+if t>=macro then {the token list starts with a reference count}
+ begin add_token_ref(p);
+ if t=macro then param_start:=param_ptr
+ else begin loc:=link(p);
+ if tracing_macros>1 then
+ begin begin_diagnostic; print_nl("");
+ case t of
+ mark_text:print_esc("mark");
+ write_text:print_esc("write");
+ othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc)
+ endcases;@/
+ print("->"); token_show(p); end_diagnostic(false);
+ end;
+ end;
+ end
+else loc:=p;
+end;
+
+@ When a token list has been fully scanned, the following computations
+should be done as we leave that level of input. The |token_type| tends
+to be equal to either |backed_up| or |inserted| about 2/3 of the time.
+@^inner loop@>
+
+@p procedure end_token_list; {leave a token-list input level}
+begin if token_type>=backed_up then {token list to be deleted}
+ begin if token_type<=inserted then flush_list(start)
+ else begin delete_token_ref(start); {update reference count}
+ if token_type=macro then {parameters must be flushed}
+ while param_ptr>param_start do
+ begin decr(param_ptr);
+ flush_list(param_stack[param_ptr]);
+ end;
+ end;
+ end
+else if token_type=u_template then
+ if align_state>500000 then align_state:=0
+ else fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+pop_input;
+check_interrupt;
+end;
+
+@ Sometimes \TeX\ has read too far and wants to ``unscan'' what it has
+seen. The |back_input| procedure takes care of this by putting the token
+just scanned back into the input stream, ready to be read again. This
+procedure can be used only if |cur_tok| represents the token to be
+replaced. Some applications of \TeX\ use this procedure a lot,
+so it has been slightly optimized for speed.
+@^inner loop@>
+
+@p procedure back_input; {undoes one token of input}
+var p:pointer; {a token list of length one}
+begin while (state=token_list)and(loc=null)and(token_type<>v_template) do
+ end_token_list; {conserve stack space}
+p:=get_avail; info(p):=cur_tok;
+if cur_tok<right_brace_limit then
+ if cur_tok<left_brace_limit then decr(align_state)
+ else incr(align_state);
+push_input; state:=token_list; start:=p; token_type:=backed_up;
+loc:=p; {that was |back_list(p)|, without procedure overhead}
+end;
+
+@ @<Insert token |p| into \TeX's input@>=
+begin t:=cur_tok; cur_tok:=p; back_input; cur_tok:=t;
+end
+
+@ The |back_error| routine is used when we want to replace an offending token
+just before issuing an error message. This routine, like |back_input|,
+requires that |cur_tok| has been set. We disable interrupts during the
+call of |back_input| so that the help message won't be lost.
+
+@p procedure back_error; {back up one token and call |error|}
+begin OK_to_interrupt:=false; back_input; OK_to_interrupt:=true; error;
+end;
+@#
+procedure ins_error; {back up one inserted token and call |error|}
+begin OK_to_interrupt:=false; back_input; token_type:=inserted;
+OK_to_interrupt:=true; error;
+end;
+
+@ The |begin_file_reading| procedure starts a new level of input for lines
+of characters to be read from a file, or as an insertion from the
+terminal. It does not take care of opening the file, nor does it set |loc|
+or |limit| or |line|.
+@^system dependencies@>
+
+@p procedure begin_file_reading;
+begin if in_open=max_in_open then overflow("text input levels",max_in_open);
+@:TeX capacity exceeded text input levels}{\quad text input levels@>
+if first=buf_size then overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+incr(in_open); push_input; index:=in_open;
+line_stack[index]:=line; start:=first; state:=mid_line;
+name:=0; {|terminal_input| is now |true|}
+end;
+
+@ Conversely, the variables must be downdated when such a level of input
+is finished:
+
+@p procedure end_file_reading;
+begin first:=start; line:=line_stack[index];
+if name>17 then a_close(cur_file); {forget it}
+pop_input; decr(in_open);
+end;
+
+@ In order to keep the stack from overflowing during a long sequence of
+inserted `\.{\\show}' commands, the following routine removes completed
+error-inserted lines from memory.
+
+@p procedure clear_for_error_prompt;
+begin while (state<>token_list)and terminal_input and@|
+ (input_ptr>0)and(loc>limit) do end_file_reading;
+print_ln; clear_terminal;
+end;
+
+@ To get \TeX's whole input mechanism going, we perform the following
+actions.
+
+@<Initialize the input routines@>=
+begin input_ptr:=0; max_in_stack:=0;
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+param_ptr:=0; max_param_stack:=0;
+first:=buf_size; repeat buffer[first]:=0; decr(first); until first=0;
+scanner_status:=normal; warning_index:=null; first:=1;
+state:=new_line; start:=1; index:=0; line:=0; name:=0;
+force_eof:=false;
+align_state:=1000000;@/
+if not init_terminal then goto final_end;
+limit:=last; first:=last+1; {|init_terminal| has set |loc| and |last|}
+end
+
+@* \[24] Getting the next token.
+The heart of \TeX's input mechanism is the |get_next| procedure, which
+we shall develop in the next few sections of the program. Perhaps we
+shouldn't actually call it the ``heart,'' however, because it really acts
+as \TeX's eyes and mouth, reading the source files and gobbling them up.
+And it also helps \TeX\ to regurgitate stored token lists that are to be
+processed again.
+@^eyes and mouth@>
+
+The main duty of |get_next| is to input one token and to set |cur_cmd|
+and |cur_chr| to that token's command code and modifier. Furthermore, if
+the input token is a control sequence, the |eqtb| location of that control
+sequence is stored in |cur_cs|; otherwise |cur_cs| is set to zero.
+
+Underlying this simple description is a certain amount of complexity
+because of all the cases that need to be handled.
+However, the inner loop of |get_next| is reasonably short and fast.
+
+When |get_next| is asked to get the next token of a \.{\\read} line,
+it sets |cur_cmd=cur_chr=cur_cs=0| in the case that no more tokens
+appear on that line. (There might not be any tokens at all, if the
+|end_line_char| has |ignore| as its catcode.)
+
+@ The value of |par_loc| is the |eqtb| address of `\.{\\par}'. This quantity
+is needed because a blank line of input is supposed to be exactly equivalent
+to the appearance of \.{\\par}; we must set |cur_cs:=par_loc|
+when detecting a blank line.
+
+@<Glob...@>=
+@!par_loc:pointer; {location of `\.{\\par}' in |eqtb|}
+@!par_token:halfword; {token representing `\.{\\par}'}
+
+@ @<Put each...@>=
+primitive("par",par_end,256); {cf. |scan_file_name|}
+@!@:par_}{\.{\\par} primitive@>
+par_loc:=cur_val; par_token:=cs_token_flag+par_loc;
+
+@ @<Cases of |print_cmd_chr|...@>=
+par_end:print_esc("par");
+
+@ Before getting into |get_next|, let's consider the subroutine that
+is called when an `\.{\\outer}' control sequence has been scanned or
+when the end of a file has been reached. These two cases are distinguished
+by |cur_cs|, which is zero at the end of a file.
+
+@p procedure check_outer_validity;
+var p:pointer; {points to inserted token list}
+@!q:pointer; {auxiliary pointer}
+begin if scanner_status<>normal then
+ begin deletions_allowed:=false;
+ @<Back up an outer control sequence so that it can be reread@>;
+ if scanner_status>skipping then
+ @<Tell the user what has run away and try to recover@>
+ else begin print_err("Incomplete "); print_cmd_chr(if_test,cur_if);
+@.Incomplete \\if...@>
+ print("; all text was ignored after line "); print_int(skip_line);
+ help3("A forbidden control sequence occurred in skipped text.")@/
+ ("This kind of error happens when you say `\if...' and forget")@/
+ ("the matching `\fi'. I've inserted a `\fi'; this might work.");
+ if cur_cs<>0 then cur_cs:=0
+ else help_line[2]:=@|
+ "The file ended while I was skipping conditional text.";
+ cur_tok:=cs_token_flag+frozen_fi; ins_error;
+ end;
+ deletions_allowed:=true;
+ end;
+end;
+
+@ An outer control sequence that occurs in a \.{\\read} will not be reread,
+since the error recovery for \.{\\read} is not very powerful.
+
+@<Back up an outer control sequence so that it can be reread@>=
+if cur_cs<>0 then
+ begin if (state=token_list)or(name<1)or(name>17) then
+ begin p:=get_avail; info(p):=cs_token_flag+cur_cs;
+ back_list(p); {prepare to read the control sequence again}
+ end;
+ cur_cmd:=spacer; cur_chr:=" "; {replace it by a space}
+ end
+
+@ @<Tell the user what has run away...@>=
+begin runaway; {print a definition, argument, or preamble}
+if cur_cs=0 then print_err("File ended")
+@.File ended while scanning...@>
+else begin cur_cs:=0; print_err("Forbidden control sequence found");
+@.Forbidden control sequence...@>
+ end;
+print(" while scanning ");
+@<Print either `\.{definition}' or `\.{use}' or `\.{preamble}' or `\.{text}',
+ and insert tokens that should lead to recovery@>;
+print(" of "); sprint_cs(warning_index);
+help4("I suspect you have forgotten a `}', causing me")@/
+("to read past where you wanted me to stop.")@/
+("I'll try to recover; but if the error is serious,")@/
+("you'd better type `E' or `X' now and fix your file.");@/
+error;
+end
+
+@ The recovery procedure can't be fully understood without knowing more
+about the \TeX\ routines that should be aborted, but we can sketch the
+ideas here: For a runaway definition we will insert a right brace; for a
+runaway preamble, we will insert a special \.{\\cr} token and a right
+brace; and for a runaway argument, we will set |long_state| to
+|outer_call| and insert \.{\\par}.
+
+@<Print either `\.{definition}' or ...@>=
+p:=get_avail;
+case scanner_status of
+defining:begin print("definition"); info(p):=right_brace_token+"}";
+ end;
+matching:begin print("use"); info(p):=par_token; long_state:=outer_call;
+ end;
+aligning:begin print("preamble"); info(p):=right_brace_token+"}"; q:=p;
+ p:=get_avail; link(p):=q; info(p):=cs_token_flag+frozen_cr;
+ align_state:=-1000000;
+ end;
+absorbing:begin print("text"); info(p):=right_brace_token+"}";
+ end;
+end; {there are no other cases}
+ins_list(p)
+
+@ We need to mention a procedure here that may be called by |get_next|.
+
+@p procedure@?firm_up_the_line; forward;
+
+@ Now we're ready to take the plunge into |get_next| itself. Parts of
+this routine are executed more often than any other instructions of \TeX.
+@^mastication@>@^inner loop@>
+
+@d switch=25 {a label in |get_next|}
+@d start_cs=26 {another}
+
+@p procedure get_next; {sets |cur_cmd|, |cur_chr|, |cur_cs| to next token}
+label restart, {go here to get the next input token}
+ switch, {go here to eat the next character from a file}
+ reswitch, {go here to digest it again}
+ start_cs, {go here to start looking for a control sequence}
+ found, {go here when a control sequence has been found}
+ exit; {go here when the next input token has been got}
+var k:0..buf_size; {an index into |buffer|}
+@!t:halfword; {a token}
+@!cat:0..15; {|cat_code(cur_chr)|, usually}
+@!c,@!cc:ASCII_code; {constituents of a possible expanded code}
+@!d:2..3; {number of excess characters in an expanded code}
+begin restart: cur_cs:=0;
+if state<>token_list then
+@<Input from external file, |goto restart| if no input found@>
+else @<Input from token list, |goto restart| if end of list or
+ if a parameter needs to be expanded@>;
+@<If an alignment entry has just ended, take appropriate action@>;
+exit:end;
+
+@ An alignment entry ends when a tab or \.{\\cr} occurs, provided that the
+current level of braces is the same as the level that was present at the
+beginning of that alignment entry; i.e., provided that |align_state| has
+returned to the value it had after the \<u_j> template for that entry.
+@^inner loop@>
+
+@<If an alignment entry has just ended, take appropriate action@>=
+if cur_cmd<=car_ret then if cur_cmd>=tab_mark then if align_state=0 then
+ @<Insert the \(v)\<v_j> template and |goto restart|@>
+
+@ @<Input from external file, |goto restart| if no input found@>=
+@^inner loop@>
+begin switch: if loc<=limit then {current line not yet finished}
+ begin cur_chr:=buffer[loc]; incr(loc);
+ reswitch: cur_cmd:=cat_code(cur_chr);
+ @<Change state if necessary, and |goto switch| if the
+ current character should be ignored,
+ or |goto reswitch| if the current character
+ changes to another@>;
+ end
+else begin state:=new_line;@/
+ @<Move to next line of file,
+ or |goto restart| if there is no next line,
+ or |return| if a \.{\\read} line has finished@>;
+ check_interrupt;
+ goto switch;
+ end;
+end
+
+@ The following 48-way switch accomplishes the scanning quickly, assuming
+that a decent \PASCAL\ compiler has translated the code. Note that the numeric
+values for |mid_line|, |skip_blanks|, and |new_line| are spaced
+apart from each other by |max_char_code+1|, so we can add a character's
+command code to the state to get a single number that characterizes both.
+
+@d any_state_plus(#) == mid_line+#,skip_blanks+#,new_line+#
+
+@<Change state if necessary...@>=
+case state+cur_cmd of
+@<Cases where character is ignored@>: goto switch;
+any_state_plus(escape): @<Scan a control sequence
+ and set |state:=skip_blanks| or |mid_line|@>;
+any_state_plus(active_char): @<Process an active-character control sequence
+ and set |state:=mid_line|@>;
+any_state_plus(sup_mark): @<If this |sup_mark| starts an expanded character
+ like~\.{\^\^A} or~\.{\^\^df}, then |goto reswitch|,
+ otherwise set |state:=mid_line|@>;
+any_state_plus(invalid_char): @<Decry the invalid character and
+ |goto restart|@>;
+@t\4@>@<Handle situations involving spaces, braces, changes of state@>@;
+othercases do_nothing
+endcases
+
+@ @<Cases where character is ignored@>=
+any_state_plus(ignore),skip_blanks+spacer,new_line+spacer
+
+@ We go to |restart| instead of to |switch|, because |state| might equal
+|token_list| after the error has been dealt with
+(cf.\ |clear_for_error_prompt|).
+
+@<Decry the invalid...@>=
+begin print_err("Text line contains an invalid character");
+@.Text line contains...@>
+help2("A funny symbol that I can't read has just been input.")@/
+("Continue, and I'll forget that it ever happened.");@/
+deletions_allowed:=false; error; deletions_allowed:=true;
+goto restart;
+end
+
+@ @d add_delims_to(#)==#+math_shift,#+tab_mark,#+mac_param,
+ #+sub_mark,#+letter,#+other_char
+
+@<Handle situations involving spaces, braces, changes of state@>=
+mid_line+spacer:@<Enter |skip_blanks| state, emit a space@>;
+mid_line+car_ret:@<Finish line, emit a space@>;
+skip_blanks+car_ret,any_state_plus(comment):
+ @<Finish line, |goto switch|@>;
+new_line+car_ret:@<Finish line, emit a \.{\\par}@>;
+mid_line+left_brace: incr(align_state);
+skip_blanks+left_brace,new_line+left_brace: begin
+ state:=mid_line; incr(align_state);
+ end;
+mid_line+right_brace: decr(align_state);
+skip_blanks+right_brace,new_line+right_brace: begin
+ state:=mid_line; decr(align_state);
+ end;
+add_delims_to(skip_blanks),add_delims_to(new_line): state:=mid_line;
+
+@ When a character of type |spacer| gets through, its character code is
+changed to $\.{"\ "}=@'40$. This means that the ASCII codes for tab and space,
+and for the space inserted at the end of a line, will
+be treated alike when macro parameters are being matched. We do this
+since such characters are indistinguishable on most computer terminal displays.
+
+@<Finish line, emit a space@>=
+begin loc:=limit+1; cur_cmd:=spacer; cur_chr:=" ";
+end
+
+@ The following code is performed only when |cur_cmd=spacer|.
+
+@<Enter |skip_blanks| state, emit a space@>=
+begin state:=skip_blanks; cur_chr:=" ";
+end
+
+@ @<Finish line, |goto switch|@>=
+begin loc:=limit+1; goto switch;
+end
+
+@ @<Finish line, emit a \.{\\par}@>=
+begin loc:=limit+1; cur_cs:=par_loc; cur_cmd:=eq_type(cur_cs);
+cur_chr:=equiv(cur_cs);
+if cur_cmd>=outer_call then check_outer_validity;
+end
+
+@ Notice that a code like \.{\^\^8} becomes \.x if not followed by a hex digit.
+
+@d is_hex(#)==(((#>="0")and(#<="9"))or((#>="a")and(#<="f")))
+@d hex_to_cur_chr==
+ if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
+ if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
+ else cur_chr:=16*cur_chr+cc-"a"+10
+
+@<If this |sup_mark| starts an expanded character...@>=
+begin if cur_chr=buffer[loc] then if loc<limit then
+ begin c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
+ begin loc:=loc+2;
+ if is_hex(c) then if loc<=limit then
+ begin cc:=buffer[loc]; @+if is_hex(cc) then
+ begin incr(loc); hex_to_cur_chr; goto reswitch;
+ end;
+ end;
+ if c<@'100 then cur_chr:=c+@'100 @+else cur_chr:=c-@'100;
+ goto reswitch;
+ end;
+ end;
+state:=mid_line;
+end
+
+@ @<Process an active-character...@>=
+begin cur_cs:=cur_chr+active_base;
+cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); state:=mid_line;
+if cur_cmd>=outer_call then check_outer_validity;
+end
+
+@ Control sequence names are scanned only when they appear in some line of
+a file; once they have been scanned the first time, their |eqtb| location
+serves as a unique identification, so \TeX\ doesn't need to refer to the
+original name any more except when it prints the equivalent in symbolic form.
+
+The program that scans a control sequence has been written carefully
+in order to avoid the blowups that might otherwise occur if a malicious
+user tried something like `\.{\\catcode\'15=0}'. The algorithm might
+look at |buffer[limit+1]|, but it never looks at |buffer[limit+2]|.
+
+If expanded characters like `\.{\^\^A}' or `\.{\^\^df}'
+appear in or just following
+a control sequence name, they are converted to single characters in the
+buffer and the process is repeated, slowly but surely.
+
+@<Scan a control...@>=
+begin if loc>limit then cur_cs:=null_cs {|state| is irrelevant in this case}
+else begin start_cs: k:=loc; cur_chr:=buffer[k]; cat:=cat_code(cur_chr);
+ incr(k);
+ if cat=letter then state:=skip_blanks
+ else if cat=spacer then state:=skip_blanks
+ else state:=mid_line;
+ if (cat=letter)and(k<=limit) then
+ @<Scan ahead in the buffer until finding a nonletter;
+ if an expanded code is encountered, reduce it
+ and |goto start_cs|; otherwise if a multiletter control
+ sequence is found, adjust |cur_cs| and |loc|, and
+ |goto found|@>
+ else @<If an expanded code is present, reduce it and |goto start_cs|@>;
+ cur_cs:=single_base+buffer[loc]; incr(loc);
+ end;
+found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+if cur_cmd>=outer_call then check_outer_validity;
+end
+
+@ Whenever we reach the following piece of code, we will have
+|cur_chr=buffer[k-1]| and |k<=limit+1| and |cat=cat_code(cur_chr)|. If an
+expanded code like \.{\^\^A} or \.{\^\^df} appears in |buffer[(k-1)..(k+1)]|
+or |buffer[(k-1)..(k+2)]|, we
+will store the corresponding code in |buffer[k-1]| and shift the rest of
+the buffer left two or three places.
+
+@<If an expanded...@>=
+begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
+ begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
+ begin d:=2;
+ if is_hex(c) then @+if k+2<=limit then
+ begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
+ end;
+ if d>2 then
+ begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
+ end
+ else if c<@'100 then buffer[k-1]:=c+@'100
+ else buffer[k-1]:=c-@'100;
+ limit:=limit-d; first:=first-d;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end;
+ end;
+end
+
+@ @<Scan ahead in the buffer...@>=
+begin repeat cur_chr:=buffer[k]; cat:=cat_code(cur_chr); incr(k);
+until (cat<>letter)or(k>limit);
+@<If an expanded...@>;
+if cat<>letter then decr(k);
+ {now |k| points to first nonletter}
+if k>loc+1 then {multiletter control sequence has been scanned}
+ begin cur_cs:=id_lookup(loc,k-loc); loc:=k; goto found;
+ end;
+end
+
+@ Let's consider now what happens when |get_next| is looking at a token list.
+
+@<Input from token list, |goto restart| if end of list or
+ if a parameter needs to be expanded@>=
+if loc<>null then {list not exhausted}
+@^inner loop@>
+ begin t:=info(loc); loc:=link(loc); {move to next}
+ if t>=cs_token_flag then {a control sequence token}
+ begin cur_cs:=t-cs_token_flag;
+ cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+ if cur_cmd>=outer_call then
+ if cur_cmd=dont_expand then
+ @<Get the next token, suppressing expansion@>
+ else check_outer_validity;
+ end
+ else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400;
+ case cur_cmd of
+ left_brace: incr(align_state);
+ right_brace: decr(align_state);
+ out_param: @<Insert macro parameter and |goto restart|@>;
+ othercases do_nothing
+ endcases;
+ end;
+ end
+else begin {we are done with this token list}
+ end_token_list; goto restart; {resume previous level}
+ end
+
+@ The present point in the program is reached only when the |expand|
+routine has inserted a special marker into the input. In this special
+case, |info(loc)| is known to be a control sequence token, and |link(loc)=null|.
+
+@d no_expand_flag=257 {this characterizes a special variant of |relax|}
+
+@<Get the next token, suppressing expansion@>=
+begin cur_cs:=info(loc)-cs_token_flag; loc:=null;@/
+cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+if cur_cmd>max_command then
+ begin cur_cmd:=relax; cur_chr:=no_expand_flag;
+ end;
+end
+
+@ @<Insert macro parameter...@>=
+begin begin_token_list(param_stack[param_start+cur_chr-1],parameter);
+goto restart;
+end
+
+@ All of the easy branches of |get_next| have now been taken care of.
+There is one more branch.
+
+@d end_line_char_inactive == (end_line_char<0)or(end_line_char>255)
+
+@<Move to next line of file, or |goto restart|...@>=
+if name>17 then @<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>
+else begin if not terminal_input then {\.{\\read} line has ended}
+ begin cur_cmd:=0; cur_chr:=0; return;
+ end;
+ if input_ptr>0 then {text was inserted during error recovery}
+ begin end_file_reading; goto restart; {resume previous level}
+ end;
+ if selector<log_only then open_log_file;
+ if interaction>nonstop_mode then
+ begin if end_line_char_inactive then incr(limit);
+ if limit=start then {previous line was empty}
+ print_nl("(Please type a command or say `\end')");
+@.Please type...@>
+ print_ln; first:=start;
+ prompt_input("*"); {input on-line into |buffer|}
+@.*\relax@>
+ limit:=last;
+ if end_line_char_inactive then decr(limit)
+ else buffer[limit]:=end_line_char;
+ first:=limit+1;
+ loc:=start;
+ end
+ else fatal_error("*** (job aborted, no legal \end found)");
+@.job aborted@>
+ {nonstop mode, which is intended for overnight batch processing,
+ never waits for on-line input}
+ end
+
+@ The global variable |force_eof| is normally |false|; it is set |true|
+by an \.{\\endinput} command.
+
+@<Glob...@>=
+@!force_eof:boolean; {should the next \.{\\input} be aborted early?}
+
+@ @<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>=
+begin incr(line); first:=start;
+if not force_eof then
+ begin if input_ln(cur_file,true) then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else force_eof:=true;
+ end;
+if force_eof then
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ force_eof:=false;
+ end_file_reading; {resume previous level}
+ check_outer_validity; goto restart;
+ end;
+if end_line_char_inactive then decr(limit)
+else buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start; {ready to read}
+end
+
+@ If the user has set the |pausing| parameter to some positive value,
+and if nonstop mode has not been selected, each line of input is displayed
+on the terminal and the transcript file, followed by `\.{=>}'.
+\TeX\ waits for a response. If the response is simply |carriage_return|, the
+line is accepted as it stands, otherwise the line typed is
+used instead of the line in the file.
+
+@p procedure firm_up_the_line;
+var k:0..buf_size; {an index into |buffer|}
+begin limit:=last;
+if pausing>0 then if interaction>nonstop_mode then
+ begin wake_up_terminal; print_ln;
+ if start<limit then for k:=start to limit-1 do print(buffer[k]);
+ first:=limit; prompt_input("=>"); {wait for user response}
+@.=>@>
+ if last>first then
+ begin for k:=first to last-1 do {move line down in buffer}
+ buffer[k+start-first]:=buffer[k];
+ limit:=start+last-first;
+ end;
+ end;
+end;
+
+@ Since |get_next| is used so frequently in \TeX, it is convenient
+to define three related procedures that do a little more:
+
+\yskip\hang|get_token| not only sets |cur_cmd| and |cur_chr|, it
+also sets |cur_tok|, a packed halfword version of the current token.
+
+\yskip\hang|get_x_token|, meaning ``get an expanded token,'' is like
+|get_token|, but if the current token turns out to be a user-defined
+control sequence (i.e., a macro call), or a conditional,
+or something like \.{\\topmark} or \.{\\expandafter} or \.{\\csname},
+it is eliminated from the input by beginning the expansion of the macro
+or the evaluation of the conditional.
+
+\yskip\hang|x_token| is like |get_x_token| except that it assumes that
+|get_next| has already been called.
+
+\yskip\noindent
+In fact, these three procedures account for {\sl all\/} uses of |get_next|,
+except for two places in the ``inner loop'' when |cur_tok| need not be set,
+and except when the arguments to \.{\\ifx} are being scanned.
+
+@ No new control sequences will be defined except during a call of
+|get_token|, or when \.{\\csname} compresses a token list, because
+|no_new_control_sequence| is always |true| at other times.
+
+@p procedure get_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|}
+begin no_new_control_sequence:=false; get_next; no_new_control_sequence:=true;
+@^inner loop@>
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+else cur_tok:=cs_token_flag+cur_cs;
+end;
+
+@* \[25] Expanding the next token.
+Only a dozen or so command codes |>max_command| can possibly be returned by
+|get_next|; in increasing order, they are |undefined_cs|, |expand_after|,
+|no_expand|, |input|, |if_test|, |fi_or_else|, |cs_name|, |convert|, |the|,
+|top_bot_mark|, |call|, |long_call|, |outer_call|, |long_outer_call|, and
+|end_template|.{\emergencystretch=40pt\par}
+
+The |expand| subroutine is used when |cur_cmd>max_command|. It removes a
+``call'' or a conditional or one of the other special operations just
+listed. It follows that |expand| might invoke itself recursively. In all
+cases, |expand| destroys the current token, but it sets things up so that
+the next |get_next| will deliver the appropriate next token. The value of
+|cur_tok| need not be known when |expand| is called.
+
+Since several of the basic scanning routines communicate via global variables,
+their values are saved as local variables of |expand| so that
+recursive calls don't invalidate them.
+@^recursion@>
+
+@p@t\4@>@<Declare the procedure called |macro_call|@>@;@/
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+procedure@?pass_text; forward;@t\2@>
+procedure@?start_input; forward;@t\2@>
+procedure@?conditional; forward;@t\2@>
+procedure@?get_x_token; forward;@t\2@>
+procedure@?conv_toks; forward;@t\2@>
+procedure@?ins_the_toks; forward;@t\2@>
+procedure expand;
+var t:halfword; {token that is being ``expanded after''}
+@!p,@!q,@!r:pointer; {for list manipulation}
+@!j:0..buf_size; {index into |buffer|}
+@!cv_backup:integer; {to save the global quantity |cur_val|}
+@!cvl_backup,@!radix_backup,@!co_backup:small_number;
+ {to save |cur_val_level|, etc.}
+@!backup_backup:pointer; {to save |link(backup_head)|}
+@!save_scanner_status:small_number; {temporary storage of |scanner_status|}
+begin cv_backup:=cur_val; cvl_backup:=cur_val_level; radix_backup:=radix;
+co_backup:=cur_order; backup_backup:=link(backup_head);
+if cur_cmd<call then @<Expand a nonmacro@>
+else if cur_cmd<end_template then macro_call
+else @<Insert a token containing |frozen_endv|@>;
+cur_val:=cv_backup; cur_val_level:=cvl_backup; radix:=radix_backup;
+cur_order:=co_backup; link(backup_head):=backup_backup;
+end;
+
+@ @<Expand a nonmacro@>=
+begin if tracing_commands>1 then show_cur_cmd_chr;
+case cur_cmd of
+top_bot_mark:@<Insert the \(a)appropriate mark text into the scanner@>;
+expand_after:@<Expand the token after the next token@>;
+no_expand:@<Suppress expansion of the next token@>;
+cs_name:@<Manufacture a control sequence name@>;
+convert:conv_toks; {this procedure is discussed in Part 27 below}
+the:ins_the_toks; {this procedure is discussed in Part 27 below}
+if_test:conditional; {this procedure is discussed in Part 28 below}
+fi_or_else:@<Terminate the current conditional and skip to \.{\\fi}@>;
+input:@<Initiate or terminate input from a file@>;
+othercases @<Complain about an undefined macro@>
+endcases;
+end
+
+@ It takes only a little shuffling to do what \TeX\ calls \.{\\expandafter}.
+
+@<Expand the token after...@>=
+begin get_token; t:=cur_tok; get_token;
+if cur_cmd>max_command then expand@+else back_input;
+cur_tok:=t; back_input;
+end
+
+@ The implementation of \.{\\noexpand} is a bit trickier, because it is
+necessary to insert a special `|dont_expand|' marker into \TeX's reading
+mechanism. This special marker is processed by |get_next|, but it does
+not slow down the inner loop.
+
+Since \.{\\outer} macros might arise here, we must also
+clear the |scanner_status| temporarily.
+
+@<Suppress expansion...@>=
+begin save_scanner_status:=scanner_status; scanner_status:=normal;
+get_token; scanner_status:=save_scanner_status; t:=cur_tok;
+back_input; {now |start| and |loc| point to the backed-up token |t|}
+if t>=cs_token_flag then
+ begin p:=get_avail; info(p):=cs_token_flag+frozen_dont_expand;
+ link(p):=loc; start:=p; loc:=p;
+ end;
+end
+
+@ @<Complain about an undefined macro@>=
+begin print_err("Undefined control sequence");
+@.Undefined control sequence@>
+help5("The control sequence at the end of the top line")@/
+("of your error message was never \def'ed. If you have")@/
+("misspelled it (e.g., `\hobx'), type `I' and the correct")@/
+("spelling (e.g., `I\hbox'). Otherwise just continue,")@/
+("and I'll forget about whatever was undefined.");
+error;
+end
+
+@ The |expand| procedure and some other routines that construct token
+lists find it convenient to use the following macros, which are valid only if
+the variables |p| and |q| are reserved for token-list building.
+
+@d store_new_token(#)==begin q:=get_avail; link(p):=q; info(q):=#;
+ p:=q; {|link(p)| is |null|}
+ end
+@d fast_store_new_token(#)==begin fast_get_avail(q); link(p):=q; info(q):=#;
+ p:=q; {|link(p)| is |null|}
+ end
+
+@ @<Manufacture a control...@>=
+begin r:=get_avail; p:=r; {head of the list of characters}
+repeat get_x_token;
+if cur_cs=0 then store_new_token(cur_tok);
+until cur_cs<>0;
+if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
+@<Look up the characters of list |r| in the hash table, and set |cur_cs|@>;
+flush_list(r);
+if eq_type(cur_cs)=undefined_cs then
+ begin eq_define(cur_cs,relax,256); {N.B.: The |save_stack| might change}
+ end; {the control sequence will now match `\.{\\relax}'}
+cur_tok:=cur_cs+cs_token_flag; back_input;
+end
+
+@ @<Complain about missing \.{\\endcsname}@>=
+begin print_err("Missing "); print_esc("endcsname"); print(" inserted");
+@.Missing \\endcsname...@>
+help2("The control sequence marked <to be read again> should")@/
+ ("not appear between \csname and \endcsname.");
+back_error;
+end
+
+@ @<Look up the characters of list |r| in the hash table...@>=
+j:=first; p:=link(r);
+while p<>null do
+ begin if j>=max_buf_stack then
+ begin max_buf_stack:=j+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[j]:=info(p) mod @'400; incr(j); p:=link(p);
+ end;
+if j>first+1 then
+ begin no_new_control_sequence:=false; cur_cs:=id_lookup(first,j-first);
+ no_new_control_sequence:=true;
+ end
+else if j=first then cur_cs:=null_cs {the list is empty}
+else cur_cs:=single_base+buffer[first] {the list has length one}
+
+@ An |end_template| command is effectively changed to an |endv| command
+by the following code. (The reason for this is discussed below; the
+|frozen_end_template| at the end of the template has passed the
+|check_outer_validity| test, so its mission of error detection has been
+accomplished.)
+
+@<Insert a token containing |frozen_endv|@>=
+begin cur_tok:=cs_token_flag+frozen_endv; back_input;
+end
+
+@ The processing of \.{\\input} involves the |start_input| subroutine,
+which will be declared later; the processing of \.{\\endinput} is trivial.
+
+@<Put each...@>=
+primitive("input",input,0);@/
+@!@:input_}{\.{\\input} primitive@>
+primitive("endinput",input,1);@/
+@!@:end_input_}{\.{\\endinput} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+input: if chr_code=0 then print_esc("input")@+else print_esc("endinput");
+
+@ @<Initiate or terminate input...@>=
+if cur_chr>0 then force_eof:=true
+else if name_in_progress then insert_relax
+else start_input
+
+@ Sometimes the expansion looks too far ahead, so we want to insert
+a harmless \.{\\relax} into the user's input.
+
+@<Declare the procedure called |insert_relax|@>=
+procedure insert_relax;
+begin cur_tok:=cs_token_flag+cur_cs; back_input;
+cur_tok:=cs_token_flag+frozen_relax; back_input; token_type:=inserted;
+end;
+
+@ Here is a recursive procedure that is \TeX's usual way to get the
+next token of input. It has been slightly optimized to take account of
+common cases.
+
+@p procedure get_x_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
+ and expands macros}
+label restart,done;
+begin restart: get_next;
+@^inner loop@>
+if cur_cmd<=max_command then goto done;
+if cur_cmd>=call then
+ if cur_cmd<end_template then macro_call
+ else begin cur_cs:=frozen_endv; cur_cmd:=endv;
+ goto done; {|cur_chr=null_list|}
+ end
+else expand;
+goto restart;
+done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+else cur_tok:=cs_token_flag+cur_cs;
+end;
+
+@ The |get_x_token| procedure is equivalent to two consecutive
+procedure calls: |get_next; x_token|.
+
+@p procedure x_token; {|get_x_token| without the initial |get_next|}
+begin while cur_cmd>max_command do
+ begin expand;
+ get_next;
+ end;
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+else cur_tok:=cs_token_flag+cur_cs;
+end;
+
+@ A control sequence that has been \.{\\def}'ed by the user is expanded by
+\TeX's |macro_call| procedure.
+
+Before we get into the details of |macro_call|, however, let's consider the
+treatment of primitives like \.{\\topmark}, since they are essentially
+macros without parameters. The token lists for such marks are kept in a
+global array of five pointers; we refer to the individual entries of this
+array by symbolic names |top_mark|, etc. The value of |top_mark| is either
+|null| or a pointer to the reference count of a token list.
+
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@d first_mark_code=1 {the first mark between |top_mark| and |bot_mark|}
+@d bot_mark_code=2 {the mark in effect at the current page break}
+@d split_first_mark_code=3 {the first mark found by \.{\\vsplit}}
+@d split_bot_mark_code=4 {the last mark found by \.{\\vsplit}}
+@d top_mark==cur_mark[top_mark_code]
+@d first_mark==cur_mark[first_mark_code]
+@d bot_mark==cur_mark[bot_mark_code]
+@d split_first_mark==cur_mark[split_first_mark_code]
+@d split_bot_mark==cur_mark[split_bot_mark_code]
+
+@<Glob...@>=
+@!cur_mark:array[top_mark_code..split_bot_mark_code] of pointer;
+ {token lists for marks}
+
+@ @<Set init...@>=
+top_mark:=null; first_mark:=null; bot_mark:=null;
+split_first_mark:=null; split_bot_mark:=null;
+
+@ @<Put each...@>=
+primitive("topmark",top_bot_mark,top_mark_code);
+@!@:top_mark_}{\.{\\topmark} primitive@>
+primitive("firstmark",top_bot_mark,first_mark_code);
+@!@:first_mark_}{\.{\\firstmark} primitive@>
+primitive("botmark",top_bot_mark,bot_mark_code);
+@!@:bot_mark_}{\.{\\botmark} primitive@>
+primitive("splitfirstmark",top_bot_mark,split_first_mark_code);
+@!@:split_first_mark_}{\.{\\splitfirstmark} primitive@>
+primitive("splitbotmark",top_bot_mark,split_bot_mark_code);
+@!@:split_bot_mark_}{\.{\\splitbotmark} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+top_bot_mark: case chr_code of
+ first_mark_code: print_esc("firstmark");
+ bot_mark_code: print_esc("botmark");
+ split_first_mark_code: print_esc("splitfirstmark");
+ split_bot_mark_code: print_esc("splitbotmark");
+ othercases print_esc("topmark")
+ endcases;
+
+@ The following code is activated when |cur_cmd=top_bot_mark| and
+when |cur_chr| is a code like |top_mark_code|.
+
+@<Insert the \(a)appropriate mark text into the scanner@>=
+begin if cur_mark[cur_chr]<>null then
+ begin_token_list(cur_mark[cur_chr],mark_text);
+end
+
+@ Now let's consider |macro_call| itself, which is invoked when \TeX\ is
+scanning a control sequence whose |cur_cmd| is either |call|, |long_call|,
+|outer_call|, or |long_outer_call|. The control sequence definition
+appears in the token list whose reference count is in location |cur_chr|
+of |mem|.
+
+The global variable |long_state| will be set to |call| or to |long_call|,
+depending on whether or not the control sequence disallows \.{\\par}
+in its parameters. The |get_next| routine will set |long_state| to
+|outer_call| and emit \.{\\par}, if a file ends or if an \.{\\outer}
+control sequence occurs in the midst of an argument.
+
+@<Glob...@>=
+@!long_state:call..long_outer_call; {governs the acceptance of \.{\\par}}
+
+@ The parameters, if any, must be scanned before the macro is expanded.
+Parameters are token lists without reference counts. They are placed on
+an auxiliary stack called |pstack| while they are being scanned, since
+the |param_stack| may be losing entries during the matching process.
+(Note that |param_stack| can't be gaining entries, since |macro_call| is
+the only routine that puts anything onto |param_stack|, and it
+is not recursive.)
+
+@<Glob...@>=
+@!pstack:array[0..8] of pointer; {arguments supplied to a macro}
+
+@ After parameter scanning is complete, the parameters are moved to the
+|param_stack|. Then the macro body is fed to the scanner; in other words,
+|macro_call| places the defined text of the control sequence at the
+top of\/ \TeX's input stack, so that |get_next| will proceed to read it
+next.
+
+The global variable |cur_cs| contains the |eqtb| address of the control sequence
+being expanded, when |macro_call| begins. If this control sequence has not been
+declared \.{\\long}, i.e., if its command code in the |eq_type| field is
+not |long_call| or |long_outer_call|, its parameters are not allowed to contain
+the control sequence \.{\\par}. If an illegal \.{\\par} appears, the macro
+call is aborted, and the \.{\\par} will be rescanned.
+
+@<Declare the procedure called |macro_call|@>=
+procedure macro_call; {invokes a user-defined control sequence}
+label exit, continue, done, done1, found;
+var r:pointer; {current node in the macro's token list}
+@!p:pointer; {current node in parameter token list being built}
+@!q:pointer; {new node being put into the token list}
+@!s:pointer; {backup pointer for parameter matching}
+@!t:pointer; {cycle pointer for backup recovery}
+@!u,@!v:pointer; {auxiliary pointers for backup recovery}
+@!rbrace_ptr:pointer; {one step before the last |right_brace| token}
+@!n:small_number; {the number of parameters scanned}
+@!unbalance:halfword; {unmatched left braces in current parameter}
+@!m:halfword; {the number of tokens or groups (usually)}
+@!ref_count:pointer; {start of the token list}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!save_warning_index:pointer; {|warning_index| upon entry}
+@!match_chr:ASCII_code; {character used in parameter}
+begin save_scanner_status:=scanner_status; save_warning_index:=warning_index;
+warning_index:=cur_cs; ref_count:=cur_chr; r:=link(ref_count); n:=0;
+if tracing_macros>0 then @<Show the text of the macro being expanded@>;
+if info(r)<>end_match_token then
+ @<Scan the parameters and make |link(r)| point to the macro body; but
+ |return| if an illegal \.{\\par} is detected@>;
+@<Feed the macro body and its parameters to the scanner@>;
+exit:scanner_status:=save_scanner_status; warning_index:=save_warning_index;
+end;
+
+@ Before we put a new token list on the input stack, it is wise to clean off
+all token lists that have recently been depleted. Then a user macro that ends
+with a call to itself will not require unbounded stack space.
+
+@<Feed the macro body and its parameters to the scanner@>=
+while (state=token_list)and(loc=null)and(token_type<>v_template) do
+ end_token_list; {conserve stack space}
+begin_token_list(ref_count,macro); name:=warning_index; loc:=link(r);
+if n>0 then
+ begin if param_ptr+n>max_param_stack then
+ begin max_param_stack:=param_ptr+n;
+ if max_param_stack>param_size then
+ overflow("parameter stack size",param_size);
+@:TeX capacity exceeded parameter stack size}{\quad parameter stack size@>
+ end;
+ for m:=0 to n-1 do param_stack[param_ptr+m]:=pstack[m];
+ param_ptr:=param_ptr+n;
+ end
+
+@ At this point, the reader will find it advisable to review the explanation
+of token list format that was presented earlier, since many aspects of that
+format are of importance chiefly in the |macro_call| routine.
+
+The token list might begin with a string of compulsory tokens before the
+first |match| or |end_match|. In that case the macro name is supposed to be
+followed by those tokens; the following program will set |s=null| to
+represent this restriction. Otherwise |s| will be set to the first token of
+a string that will delimit the next parameter.
+
+@<Scan the parameters and make |link(r)| point to the macro body...@>=
+begin scanner_status:=matching; unbalance:=0;
+long_state:=eq_type(cur_cs);
+if long_state>=outer_call then long_state:=long_state-2;
+repeat link(temp_head):=null;
+if (info(r)>match_token+255)or(info(r)<match_token) then s:=null
+else begin match_chr:=info(r)-match_token; s:=link(r); r:=s;
+ p:=temp_head; m:=0;
+ end;
+@<Scan a parameter until its delimiter string has been found; or, if |s=null|,
+ simply scan the delimiter string@>;@/
+{now |info(r)| is a token whose command code is either |match| or |end_match|}
+until info(r)=end_match_token;
+end
+
+@ If |info(r)| is a |match| or |end_match| command, it cannot be equal to
+any token found by |get_token|. Therefore an undelimited parameter---i.e.,
+a |match| that is immediately followed by |match| or |end_match|---will
+always fail the test `|cur_tok=info(r)|' in the following algorithm.
+
+@<Scan a parameter until its delimiter string has been found; or, ...@>=
+continue: get_token; {set |cur_tok| to the next token of input}
+if cur_tok=info(r) then
+ @<Advance \(r)|r|; |goto found| if the parameter delimiter has been
+ fully matched, otherwise |goto continue|@>;
+@<Contribute the recently matched tokens to the current parameter, and
+ |goto continue| if a partial match is still in effect;
+ but abort if |s=null|@>;
+if cur_tok=par_token then if long_state<>long_call then
+ @<Report a runaway argument and abort@>;
+if cur_tok<right_brace_limit then
+ if cur_tok<left_brace_limit then
+ @<Contribute an entire group to the current parameter@>
+ else @<Report an extra right brace and |goto continue|@>
+else @<Store the current token, but |goto continue| if it is
+ a blank space that would become an undelimited parameter@>;
+incr(m);
+if info(r)>end_match_token then goto continue;
+if info(r)<match_token then goto continue;
+found: if s<>null then @<Tidy up the parameter just scanned, and tuck it away@>
+
+@ @<Store the current token, but |goto continue| if it is...@>=
+begin if cur_tok=space_token then
+ if info(r)<=end_match_token then
+ if info(r)>=match_token then goto continue;
+store_new_token(cur_tok);
+end
+
+@ A slightly subtle point arises here: When the parameter delimiter ends
+with `\.{\#\{}', the token list will have a left brace both before and
+after the |end_match|\kern-.4pt. Only one of these should affect the
+|align_state|, but both will be scanned, so we must make a correction.
+
+@<Advance \(r)|r|; |goto found| if the parameter delimiter has been fully...@>=
+begin r:=link(r);
+if (info(r)>=match_token)and(info(r)<=end_match_token) then
+ begin if cur_tok<left_brace_limit then decr(align_state);
+ goto found;
+ end
+else goto continue;
+end
+
+@ @<Report an extra right brace and |goto continue|@>=
+begin back_input; print_err("Argument of "); sprint_cs(warning_index);
+@.Argument of \\x has...@>
+print(" has an extra }");
+help6("I've run across a `}' that doesn't seem to match anything.")@/
+ ("For example, `\def\a#1{...}' and `\a}' would produce")@/
+ ("this error. If you simply proceed now, the `\par' that")@/
+ ("I've just inserted will cause me to report a runaway")@/
+ ("argument that might be the root of the problem. But if")@/
+ ("your `}' was spurious, just type `2' and it will go away.");
+incr(align_state); long_state:=call; cur_tok:=par_token; ins_error;
+end {a white lie; the \.{\\par} won't always trigger a runaway}
+
+@ If |long_state=outer_call|, a runaway argument has already been reported.
+
+@<Report a runaway argument and abort@>=
+begin if long_state=call then
+ begin runaway; print_err("Paragraph ended before ");
+@.Paragraph ended before...@>
+ sprint_cs(warning_index); print(" was complete");
+ help3("I suspect you've forgotten a `}', causing me to apply this")@/
+ ("control sequence to too much text. How can we recover?")@/
+ ("My plan is to forget the whole thing and hope for the best.");
+ back_error;
+ end;
+pstack[n]:=link(temp_head); align_state:=align_state-unbalance;
+for m:=0 to n do flush_list(pstack[m]);
+return;
+end
+
+@ When the following code becomes active, we have matched tokens from |s| to
+the predecessor of |r|, and we have found that |cur_tok<>info(r)|. An
+interesting situation now presents itself: If the parameter is to be
+delimited by a string such as `\.{ab}', and if we have scanned `\.{aa}',
+we want to contribute one `\.a' to the current parameter and resume
+looking for a `\.b'. The program must account for such partial matches and
+for others that can be quite complex. But most of the time we have |s=r|
+and nothing needs to be done.
+
+Incidentally, it is possible for \.{\\par} tokens to sneak in to certain
+parameters of non-\.{\\long} macros. For example, consider a case like
+`\.{\\def\\a\#1\\par!\{...\}}' where the first \.{\\par} is not followed
+by an exclamation point. In such situations it does not seem appropriate
+to prohibit the \.{\\par}, so \TeX\ keeps quiet about this bending of
+the rules.
+
+@<Contribute the recently matched tokens to the current parameter...@>=
+if s<>r then
+ if s=null then @<Report an improper use of the macro and abort@>
+ else begin t:=s;
+ repeat store_new_token(info(t)); incr(m); u:=link(t); v:=s;
+ loop@+ begin if u=r then
+ if cur_tok<>info(v) then goto done
+ else begin r:=link(v); goto continue;
+ end;
+ if info(u)<>info(v) then goto done;
+ u:=link(u); v:=link(v);
+ end;
+ done: t:=link(t);
+ until t=r;
+ r:=s; {at this point, no tokens are recently matched}
+ end
+
+@ @<Report an improper use...@>=
+begin print_err("Use of "); sprint_cs(warning_index);
+@.Use of x doesn't match...@>
+print(" doesn't match its definition");
+help4("If you say, e.g., `\def\a1{...}', then you must always")@/
+ ("put `1' after `\a', since control sequence names are")@/
+ ("made up of letters only. The macro here has not been")@/
+ ("followed by the required stuff, so I'm ignoring it.");
+error; return;
+end
+
+@ @<Contribute an entire group to the current parameter@>=
+begin unbalance:=1;
+@^inner loop@>
+loop@+ begin fast_store_new_token(cur_tok); get_token;
+ if cur_tok=par_token then if long_state<>long_call then
+ @<Report a runaway argument and abort@>;
+ if cur_tok<right_brace_limit then
+ if cur_tok<left_brace_limit then incr(unbalance)
+ else begin decr(unbalance);
+ if unbalance=0 then goto done1;
+ end;
+ end;
+done1: rbrace_ptr:=p; store_new_token(cur_tok);
+end
+
+@ If the parameter consists of a single group enclosed in braces, we must
+strip off the enclosing braces. That's why |rbrace_ptr| was introduced.
+
+@<Tidy up the parameter just scanned, and tuck it away@>=
+begin if (m=1)and(info(p)<right_brace_limit)and(p<>temp_head) then
+ begin link(rbrace_ptr):=null; free_avail(p);
+ p:=link(temp_head); pstack[n]:=link(p); free_avail(p);
+ end
+else pstack[n]:=link(temp_head);
+incr(n);
+if tracing_macros>0 then
+ begin begin_diagnostic; print_nl(match_chr); print_int(n);
+ print("<-"); show_token_list(pstack[n-1],null,1000);
+ end_diagnostic(false);
+ end;
+end
+
+@ @<Show the text of the macro being expanded@>=
+begin begin_diagnostic; print_ln; print_cs(warning_index);
+token_show(ref_count); end_diagnostic(false);
+end
+
+@* \[26] Basic scanning subroutines.
+Let's turn now to some procedures that \TeX\ calls upon frequently to digest
+certain kinds of patterns in the input. Most of these are quite simple;
+some are quite elaborate. Almost all of the routines call |get_x_token|,
+which can cause them to be invoked recursively.
+@^stomach@>
+@^recursion@>
+
+@ The |scan_left_brace| routine is called when a left brace is supposed to be
+the next non-blank token. (The term ``left brace'' means, more precisely,
+a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |left_brace|.
+
+@p procedure scan_left_brace; {reads a mandatory |left_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>left_brace then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ help4("A left brace was mandatory here, so I've put one in.")@/
+ ("You might want to delete and/or insert some corrections")@/
+ ("so that I will find a matching right brace soon.")@/
+ ("(If you're confused by all this, try typing `I}' now.)");
+ back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
+ cur_chr:="{"; incr(align_state);
+ end;
+end;
+
+@ @<Get the next non-blank non-relax non-call token@>=
+repeat get_x_token;
+until (cur_cmd<>spacer)and(cur_cmd<>relax)
+
+@ The |scan_optional_equals| routine looks for an optional `\.=' sign preceded
+by optional spaces; `\.{\\relax}' is not ignored here.
+
+@p procedure scan_optional_equals;
+begin @<Get the next non-blank non-call token@>;
+if cur_tok<>other_token+"=" then back_input;
+end;
+
+@ @<Get the next non-blank non-call token@>=
+repeat get_x_token;
+until cur_cmd<>spacer
+
+@ In case you are getting bored, here is a slightly less trivial routine:
+Given a string of lowercase letters, like `\.{pt}' or `\.{plus}' or
+`\.{width}', the |scan_keyword| routine checks to see whether the next
+tokens of input match this string. The match must be exact, except that
+uppercase letters will match their lowercase counterparts; uppercase
+equivalents are determined by subtracting |"a"-"A"|, rather than using the
+|uc_code| table, since \TeX\ uses this routine only for its own limited
+set of keywords.
+
+If a match is found, the characters are effectively removed from the input
+and |true| is returned. Otherwise |false| is returned, and the input
+is left essentially unchanged (except for the fact that some macros
+may have been expanded, etc.).
+@^inner loop@>
+
+@p function scan_keyword(@!s:str_number):boolean; {look for a given string}
+label exit;
+var p:pointer; {tail of the backup list}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!k:pool_pointer; {index into |str_pool|}
+begin p:=backup_head; link(p):=null; k:=str_start[s];
+while k<str_start[s+1] do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=so(str_pool[k]))or(cur_chr=so(str_pool[k])-"a"+"A")) then
+ begin store_new_token(cur_tok); incr(k);
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+flush_list(link(backup_head)); scan_keyword:=true;
+exit:end;
+
+@ Here is a procedure that sounds an alarm when mu and non-mu units
+are being switched.
+
+@p procedure mu_error;
+begin print_err("Incompatible glue units");
+@.Incompatible glue units@>
+help1("I'm going to assume that 1mu=1pt when they're mixed.");
+error;
+end;
+
+@ The next routine `|scan_something_internal|' is used to fetch internal
+numeric quantities like `\.{\\hsize}', and also to handle the `\.{\\the}'
+when expanding constructions like `\.{\\the\\toks0}' and
+`\.{\\the\\baselineskip}'. Soon we will be considering the |scan_int|
+procedure, which calls |scan_something_internal|; on the other hand,
+|scan_something_internal| also calls |scan_int|, for constructions like
+`\.{\\catcode\`\\\$}' or `\.{\\fontdimen} \.3 \.{\\ff}'. So we
+have to declare |scan_int| as a |forward| procedure. A few other
+procedures are also declared at this point.
+
+@p procedure@?scan_int; forward; {scans an integer value}
+@t\4\4@>@<Declare procedures that scan restricted classes of integers@>@;
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+
+@ \TeX\ doesn't know exactly what to expect when |scan_something_internal|
+begins. For example, an integer or dimension or glue value could occur
+immediately after `\.{\\hskip}'; and one can even say \.{\\the} with
+respect to token lists in constructions like
+`\.{\\xdef\\o\{\\the\\output\}}'. On the other hand, only integers are
+allowed after a construction like `\.{\\count}'. To handle the various
+possibilities, |scan_something_internal| has a |level| parameter, which
+tells the ``highest'' kind of quantity that |scan_something_internal| is
+allowed to produce. Six levels are distinguished, namely |int_val|,
+|dimen_val|, |glue_val|, |mu_val|, |ident_val|, and |tok_val|.
+
+The output of |scan_something_internal| (and of the other routines
+|scan_int|, |scan_dimen|, and |scan_glue| below) is put into the global
+variable |cur_val|, and its level is put into |cur_val_level|. The highest
+values of |cur_val_level| are special: |mu_val| is used only when
+|cur_val| points to something in a ``muskip'' register, or to one of the
+three parameters \.{\\thinmuskip}, \.{\\medmuskip}, \.{\\thickmuskip};
+|ident_val| is used only when |cur_val| points to a font identifier;
+|tok_val| is used only when |cur_val| points to |null| or to the reference
+count of a token list. The last two cases are allowed only when
+|scan_something_internal| is called with |level=tok_val|.
+
+If the output is glue, |cur_val| will point to a glue specification, and
+the reference count of that glue will have been updated to reflect this
+reference; if the output is a nonempty token list, |cur_val| will point to
+its reference count, but in this case the count will not have been updated.
+Otherwise |cur_val| will contain the integer or scaled value in question.
+
+@d int_val=0 {integer values}
+@d dimen_val=1 {dimension values}
+@d glue_val=2 {glue specifications}
+@d mu_val=3 {math glue specifications}
+@d ident_val=4 {font identifier}
+@d tok_val=5 {token lists}
+
+@<Glob...@>=
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val_level:int_val..tok_val; {the ``level'' of this value}
+
+@ The hash table is initialized with `\.{\\count}', `\.{\\dimen}', `\.{\\skip}',
+and `\.{\\muskip}' all having |register| as their command code; they are
+distinguished by the |chr_code|, which is either |int_val|, |dimen_val|,
+|glue_val|, or |mu_val|.
+
+@<Put each...@>=
+primitive("count",register,int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mu_val);
+@!@:mu_skip_}{\.{\\muskip} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+register: if chr_code=int_val then print_esc("count")
+ else if chr_code=dimen_val then print_esc("dimen")
+ else if chr_code=glue_val then print_esc("skip")
+ else print_esc("muskip");
+
+@ OK, we're ready for |scan_something_internal| itself. A second parameter,
+|negative|, is set |true| if the value that is found should be negated.
+It is assumed that |cur_cmd| and |cur_chr| represent the first token of
+the internal quantity to be scanned; an error will be signalled if
+|cur_cmd<min_internal| or |cur_cmd>max_internal|.
+
+@d scanned_result_end(#)==cur_val_level:=#;@+end
+@d scanned_result(#)==@+begin cur_val:=#;scanned_result_end
+
+@p procedure scan_something_internal(@!level:small_number;@!negative:boolean);
+ {fetch an internal parameter}
+var m:halfword; {|chr_code| part of the operand token}
+@!p:0..nest_size; {index into |nest|}
+begin m:=cur_chr;
+case cur_cmd of
+def_code: @<Fetch a character code from some table@>;
+toks_register,assign_toks,def_family,set_font,def_font: @<Fetch a token list or
+ font identifier, provided that |level=tok_val|@>;
+assign_int: scanned_result(eqtb[m].int)(int_val);
+assign_dimen: scanned_result(eqtb[m].sc)(dimen_val);
+assign_glue: scanned_result(equiv(m))(glue_val);
+assign_mu_glue: scanned_result(equiv(m))(mu_val);
+set_aux: @<Fetch the |space_factor| or the |prev_depth|@>;
+set_prev_graf: @<Fetch the |prev_graf|@>;
+set_page_int:@<Fetch the |dead_cycles| or the |insert_penalties|@>;
+set_page_dimen: @<Fetch something on the |page_so_far|@>;
+set_shape: @<Fetch the |par_shape| size@>;
+set_box_dimen: @<Fetch a box dimension@>;
+char_given,math_given: scanned_result(cur_chr)(int_val);
+assign_font_dimen: @<Fetch a font dimension@>;
+assign_font_int: @<Fetch a font integer@>;
+register: @<Fetch a register@>;
+last_item: @<Fetch an item in the current node, if appropriate@>;
+othercases @<Complain that \.{\\the} can't do this; give zero result@>
+endcases;@/
+while cur_val_level>level do @<Convert \(c)|cur_val| to a lower level@>;
+@<Fix the reference count, if any, and negate |cur_val| if |negative|@>;
+end;
+
+@ @<Fetch a character code from some table@>=
+begin scan_char_num;
+if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val)
+else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else scanned_result(eqtb[m+cur_val].int)(int_val);
+end
+
+@ @<Fetch a token list...@>=
+if level<>tok_val then
+ begin print_err("Missing number, treated as zero");
+@.Missing number...@>
+ help3("A number should have been here; I inserted `0'.")@/
+ ("(If you can't figure out why I needed to see a number,")@/
+ ("look up `weird error' in the index to The TeXbook.)");
+@:TeXbook}{\sl The \TeX book@>
+ back_error; scanned_result(0)(dimen_val);
+ end
+else if cur_cmd<=assign_toks then
+ begin if cur_cmd<assign_toks then {|cur_cmd=toks_register|}
+ begin scan_eight_bit_int; m:=toks_base+cur_val;
+ end;
+ scanned_result(equiv(m))(tok_val);
+ end
+else begin back_input; scan_font_ident;
+ scanned_result(font_id_base+cur_val)(ident_val);
+ end
+
+@ Users refer to `\.{\\the\\spacefactor}' only in horizontal
+mode, and to `\.{\\the\\prevdepth}' only in vertical mode; so we put the
+associated mode in the modifier part of the |set_aux| command.
+The |set_page_int| command has modifier 0 or 1, for `\.{\\deadcycles}' and
+`\.{\\insertpenalties}', respectively. The |set_box_dimen| command is
+modified by either |width_offset|, |height_offset|, or |depth_offset|.
+And the |last_item| command is modified by either |int_val|, |dimen_val|,
+|glue_val|, |input_line_no_code|, or |badness_code|.
+
+@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+
+@<Put each...@>=
+primitive("spacefactor",set_aux,hmode);
+@!@:space_factor_}{\.{\\spacefactor} primitive@>
+primitive("prevdepth",set_aux,vmode);@/
+@!@:prev_depth_}{\.{\\prevdepth} primitive@>
+primitive("deadcycles",set_page_int,0);
+@!@:dead_cycles_}{\.{\\deadcycles} primitive@>
+primitive("insertpenalties",set_page_int,1);
+@!@:insert_penalties_}{\.{\\insertpenalties} primitive@>
+primitive("wd",set_box_dimen,width_offset);
+@!@:wd_}{\.{\\wd} primitive@>
+primitive("ht",set_box_dimen,height_offset);
+@!@:ht_}{\.{\\ht} primitive@>
+primitive("dp",set_box_dimen,depth_offset);
+@!@:dp_}{\.{\\dp} primitive@>
+primitive("lastpenalty",last_item,int_val);
+@!@:last_penalty_}{\.{\\lastpenalty} primitive@>
+primitive("lastkern",last_item,dimen_val);
+@!@:last_kern_}{\.{\\lastkern} primitive@>
+primitive("lastskip",last_item,glue_val);
+@!@:last_skip_}{\.{\\lastskip} primitive@>
+primitive("inputlineno",last_item,input_line_no_code);
+@!@:input_line_no_}{\.{\\inputlineno} primitive@>
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_aux: if chr_code=vmode then print_esc("prevdepth")
+@+else print_esc("spacefactor");
+set_page_int: if chr_code=0 then print_esc("deadcycles")
+@+else print_esc("insertpenalties");
+set_box_dimen: if chr_code=width_offset then print_esc("wd")
+else if chr_code=height_offset then print_esc("ht")
+else print_esc("dp");
+last_item: case chr_code of
+ int_val: print_esc("lastpenalty");
+ dimen_val: print_esc("lastkern");
+ glue_val: print_esc("lastskip");
+ input_line_no_code: print_esc("inputlineno");
+ othercases print_esc("badness")
+ endcases;
+
+@ @<Fetch the |space_factor| or the |prev_depth|@>=
+if abs(mode)<>m then
+ begin print_err("Improper "); print_cmd_chr(set_aux,m);
+@.Improper \\spacefactor@>
+@.Improper \\prevdepth@>
+ help4("You can refer to \spacefactor only in horizontal mode;")@/
+ ("you can refer to \prevdepth only in vertical mode; and")@/
+ ("neither of these is meaningful inside \write. So")@/
+ ("I'm forgetting what you said and using zero instead.");
+ error;
+ if level<>tok_val then scanned_result(0)(dimen_val)
+ else scanned_result(0)(int_val);
+ end
+else if m=vmode then
+ begin cur_val:=prev_depth; cur_val_level:=dimen_val;
+ end
+else begin cur_val:=space_factor; cur_val_level:=int_val;
+ end
+
+@ @<Fetch the |dead_cycles| or the |insert_penalties|@>=
+begin if m=0 then cur_val:=dead_cycles@+else cur_val:=insert_penalties;
+cur_val_level:=int_val;
+end
+
+@ @<Fetch a box dimension@>=
+begin scan_eight_bit_int;
+if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc;
+cur_val_level:=dimen_val;
+end
+
+@ Inside an \.{\\output} routine, a user may wish to look at the page totals
+that were present at the moment when output was triggered.
+
+@d max_dimen==@'7777777777 {$2^{30}-1$}
+
+@<Fetch something on the |page_so_far|@>=
+begin if (page_contents=empty) and (not output_active) then
+ if m=0 then cur_val:=max_dimen@+else cur_val:=0
+else cur_val:=page_so_far[m];
+cur_val_level:=dimen_val;
+end
+
+@ @<Fetch the |prev_graf|@>=
+if mode=0 then scanned_result(0)(int_val) {|prev_graf=0| within \.{\\write}}
+else begin nest[nest_ptr]:=cur_list; p:=nest_ptr;
+ while abs(nest[p].mode_field)<>vmode do decr(p);
+ scanned_result(nest[p].pg_field)(int_val);
+ end
+
+@ @<Fetch the |par_shape| size@>=
+begin if par_shape_ptr=null then cur_val:=0
+else cur_val:=info(par_shape_ptr);
+cur_val_level:=int_val;
+end
+
+@ Here is where \.{\\lastpenalty}, \.{\\lastkern}, and \.{\\lastskip} are
+implemented. The reference count for \.{\\lastskip} will be updated later.
+
+We also handle \.{\\inputlineno} and \.{\\badness} here, because they are
+legal in similar contexts.
+
+@<Fetch an item in the current node...@>=
+if cur_chr>glue_val then
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+ cur_val_level:=int_val;
+ end
+else begin if cur_chr=glue_val then cur_val:=zero_glue@+else cur_val:=0;
+ cur_val_level:=cur_chr;
+ if not is_char_node(tail)and(mode<>0) then
+ case cur_chr of
+ int_val: if type(tail)=penalty_node then cur_val:=penalty(tail);
+ dimen_val: if type(tail)=kern_node then cur_val:=width(tail);
+ glue_val: if type(tail)=glue_node then
+ begin cur_val:=glue_ptr(tail);
+ if subtype(tail)=mu_glue then cur_val_level:=mu_val;
+ end;
+ end {there are no other cases}
+ else if (mode=vmode)and(tail=head) then
+ case cur_chr of
+ int_val: cur_val:=last_penalty;
+ dimen_val: cur_val:=last_kern;
+ glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+ end; {there are no other cases}
+ end
+
+@ @<Fetch a font dimension@>=
+begin find_font_dimen(false); font_info[fmem_ptr].sc:=0;
+scanned_result(font_info[cur_val].sc)(dimen_val);
+end
+
+@ @<Fetch a font integer@>=
+begin scan_font_ident;
+if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+else scanned_result(skew_char[cur_val])(int_val);
+end
+
+@ @<Fetch a register@>=
+begin scan_eight_bit_int;
+case m of
+int_val:cur_val:=count(cur_val);
+dimen_val:cur_val:=dimen(cur_val);
+glue_val: cur_val:=skip(cur_val);
+mu_val: cur_val:=mu_skip(cur_val);
+end; {there are no other cases}
+cur_val_level:=m;
+end
+
+@ @<Complain that \.{\\the} can't do this; give zero result@>=
+begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr);
+@.You can't use x after ...@>
+print("' after "); print_esc("the");
+help1("I'm forgetting what you said and using zero instead.");
+error;
+if level<>tok_val then scanned_result(0)(dimen_val)
+else scanned_result(0)(int_val);
+end
+
+@ When a |glue_val| changes to a |dimen_val|, we use the width component
+of the glue; there is no need to decrease the reference count, since it
+has not yet been increased. When a |dimen_val| changes to an |int_val|,
+we use scaled points so that the value doesn't actually change. And when a
+|mu_val| changes to a |glue_val|, the value doesn't change either.
+
+@<Convert \(c)|cur_val| to a lower level@>=
+begin if cur_val_level=glue_val then cur_val:=width(cur_val)
+else if cur_val_level=mu_val then mu_error;
+decr(cur_val_level);
+end
+
+@ If |cur_val| points to a glue specification at this point, the reference
+count for the glue does not yet include the reference by |cur_val|.
+If |negative| is |true|, |cur_val_level| is known to be |<=mu_val|.
+
+@<Fix the reference count, if any, ...@>=
+if negative then
+ if cur_val_level>=glue_val then
+ begin cur_val:=new_spec(cur_val);
+ @<Negate all three glue components of |cur_val|@>;
+ end
+ else negate(cur_val)
+else if (cur_val_level>=glue_val)and(cur_val_level<=mu_val) then
+ add_glue_ref(cur_val)
+
+@ @<Negate all three...@>=
+begin negate(width(cur_val));
+negate(stretch(cur_val));
+negate(shrink(cur_val));
+end
+
+@ Our next goal is to write the |scan_int| procedure, which scans anything that
+\TeX\ treats as an integer. But first we might as well look at some simple
+applications of |scan_int| that have already been made inside of
+|scan_something_internal|.
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_eight_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2("A register number must be between 0 and 255.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_char_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad character code");
+@.Bad character code@>
+ help2("A character number must be between 0 and 255.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ While we're at it, we might as well deal with similar routines that
+will be needed later.
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>15) then
+ begin print_err("Bad number");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 15,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+ begin print_err("Bad mathchar");
+@.Bad mathchar@>
+ help2("A mathchar number must be between 0 and 32767.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_twenty_seven_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+ begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+ help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ An integer number can be preceded by any number of spaces and `\.+' or
+`\.-' signs. Then comes either a decimal constant (i.e., radix 10), an
+octal constant (i.e., radix 8, preceded by~\.\'), a hexadecimal constant
+(radix 16, preceded by~\."), an alphabetic constant (preceded by~\.\`), or
+an internal variable. After scanning is complete,
+|cur_val| will contain the answer, which must be at most
+$2^{31}-1=2147483647$ in absolute value. The value of |radix| is set to
+10, 8, or 16 in the cases of decimal, octal, or hexadecimal constants,
+otherwise |radix| is set to zero. An optional space follows a constant.
+
+@d octal_token=other_token+"'" {apostrophe, indicates an octal constant}
+@d hex_token=other_token+"""" {double quote, indicates a hex constant}
+@d alpha_token=other_token+"`" {reverse apostrophe, precedes alpha constants}
+@d point_token=other_token+"." {decimal point}
+@d continental_point_token=other_token+"," {decimal point, Eurostyle}
+
+@<Glob...@>=
+@!radix:small_number; {|scan_int| sets this to 8, 10, 16, or zero}
+
+@ We initialize the following global variables just in case |expand|
+comes into action before any of the basic scanning routines has assigned
+them a value.
+
+@<Set init...@>=
+cur_val:=0; cur_val_level:=int_val; radix:=0; cur_order:=0;
+
+@ The |scan_int| routine is used also to scan the integer part of a
+fraction; for example, the `\.3' in `\.{3.14159}' will be found by
+|scan_int|. The |scan_dimen| routine assumes that |cur_tok=point_token|
+after the integer part of such a fraction has been scanned by |scan_int|,
+and that the decimal point has been backed up to be scanned again.
+
+@p procedure scan_int; {sets |cur_val| to an integer}
+label done;
+var negative:boolean; {should the answer be negated?}
+@!m:integer; {|@t$2^{31}$@> div radix|, the threshold of danger}
+@!d:small_number; {the digit just scanned}
+@!vacuous:boolean; {have no digits appeared?}
+@!OK_so_far:boolean; {has an error message been issued?}
+begin radix:=0; OK_so_far:=true;@/
+@<Get the next non-blank non-sign token; set |negative| appropriately@>;
+if cur_tok=alpha_token then @<Scan an alphabetic character code into |cur_val|@>
+else if (cur_cmd>=min_internal)and(cur_cmd<=max_internal) then
+ scan_something_internal(int_val,false)
+else @<Scan a numeric constant@>;
+if negative then negate(cur_val);
+end;
+
+@ @<Get the next non-blank non-sign token...@>=
+negative:=false;
+repeat @<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"-" then
+ begin negative := not negative; cur_tok:=other_token+"+";
+ end;
+until cur_tok<>other_token+"+"
+
+@ A space is ignored after an alphabetic character constant, so that
+such constants behave like numeric ones.
+
+@<Scan an alphabetic character code into |cur_val|@>=
+begin get_token; {suppress macro expansion}
+if cur_tok<cs_token_flag then
+ begin cur_val:=cur_chr;
+ if cur_cmd<=right_brace then
+ if cur_cmd=right_brace then incr(align_state)
+ else decr(align_state);
+ end
+else if cur_tok<cs_token_flag+single_base then
+ cur_val:=cur_tok-cs_token_flag-active_base
+else cur_val:=cur_tok-cs_token_flag-single_base;
+if cur_val>255 then
+ begin print_err("Improper alphabetic constant");
+@.Improper alphabetic constant@>
+ help2("A one-character control sequence belongs after a ` mark.")@/
+ ("So I'm essentially inserting \0 here.");
+ cur_val:="0"; back_error;
+ end
+else @<Scan an optional space@>;
+end
+
+@ @<Scan an optional space@>=
+begin get_x_token; if cur_cmd<>spacer then back_input;
+end
+
+@ @<Scan a numeric constant@>=
+begin radix:=10; m:=214748364;
+if cur_tok=octal_token then
+ begin radix:=8; m:=@'2000000000; get_x_token;
+ end
+else if cur_tok=hex_token then
+ begin radix:=16; m:=@'1000000000; get_x_token;
+ end;
+vacuous:=true; cur_val:=0;@/
+@<Accumulate the constant until |cur_tok| is not a suitable digit@>;
+if vacuous then @<Express astonishment that no number was here@>
+else if cur_cmd<>spacer then back_input;
+end
+
+@ @d infinity==@'17777777777 {the largest positive value that \TeX\ knows}
+@d zero_token=other_token+"0" {zero, the smallest digit}
+@d A_token=letter_token+"A" {the smallest special hex digit}
+@d other_A_token=other_token+"A" {special hex digit of type |other_char|}
+
+@<Accumulate the constant...@>=
+loop@+ begin if (cur_tok<zero_token+radix)and(cur_tok>=zero_token)and
+ (cur_tok<=zero_token+9) then d:=cur_tok-zero_token
+ else if radix=16 then
+ if (cur_tok<=A_token+5)and(cur_tok>=A_token) then d:=cur_tok-A_token+10
+ else if (cur_tok<=other_A_token+5)and(cur_tok>=other_A_token) then
+ d:=cur_tok-other_A_token+10
+ else goto done
+ else goto done;
+ vacuous:=false;
+ if (cur_val>=m)and((cur_val>m)or(d>7)or(radix<>10)) then
+ begin if OK_so_far then
+ begin print_err("Number too big");
+@.Number too big@>
+ help2("I can only go up to 2147483647='17777777777=""7FFFFFFF,")@/
+ ("so I'm using that number instead of yours.");
+ error; cur_val:=infinity; OK_so_far:=false;
+ end;
+ end
+ else cur_val:=cur_val*radix+d;
+ get_x_token;
+ end;
+done:
+
+@ @<Express astonishment...@>=
+begin print_err("Missing number, treated as zero");
+@.Missing number...@>
+help3("A number should have been here; I inserted `0'.")@/
+ ("(If you can't figure out why I needed to see a number,")@/
+ ("look up `weird error' in the index to The TeXbook.)");
+@:TeXbook}{\sl The \TeX book@>
+back_error;
+end
+
+@ The |scan_dimen| routine is similar to |scan_int|, but it sets |cur_val| to
+a |scaled| value, i.e., an integral number of sp. One of its main tasks
+is therefore to interpret the abbreviations for various kinds of units and
+to convert measurements to scaled points.
+
+There are three parameters: |mu| is |true| if the finite units must be
+`\.{mu}', while |mu| is |false| if `\.{mu}' units are disallowed;
+|inf| is |true| if the infinite units `\.{fil}', `\.{fill}', `\.{filll}'
+are permitted; and |shortcut| is |true| if |cur_val| already contains
+an integer and only the units need to be considered.
+
+The order of infinity that was found in the case of infinite glue is returned
+in the global variable |cur_order|.
+
+@<Glob...@>=
+@!cur_order:glue_ord; {order of infinity found by |scan_dimen|}
+
+@ Constructions like `\.{-\'77 pt}' are legal dimensions, so |scan_dimen|
+may begin with |scan_int|. This explains why it is convenient to use
+|scan_int| also for the integer part of a decimal fraction.
+
+Several branches of |scan_dimen| work with |cur_val| as an integer and
+with an auxiliary fraction |f|, so that the actual quantity of interest is
+$|cur_val|+|f|/2^{16}$. At the end of the routine, this ``unpacked''
+representation is put into the single word |cur_val|, which suddenly
+switches significance from |integer| to |scaled|.
+
+@d attach_fraction=88 {go here to pack |cur_val| and |f| into |cur_val|}
+@d attach_sign=89 {go here when |cur_val| is correct except perhaps for sign}
+@d scan_normal_dimen==scan_dimen(false,false,false)
+
+@p procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean);
+ {sets |cur_val| to a dimension}
+label done, done1, done2, found, not_found, attach_fraction, attach_sign;
+var negative:boolean; {should the answer be negated?}
+@!f:integer; {numerator of a fraction whose denominator is $2^{16}$}
+@<Local variables for dimension calculations@>@;
+begin f:=0; arith_error:=false; cur_order:=normal; negative:=false;
+if not shortcut then
+ begin @<Get the next non-blank non-sign...@>;
+ if (cur_cmd>=min_internal)and(cur_cmd<=max_internal) then
+ @<Fetch an internal dimension and |goto attach_sign|,
+ or fetch an internal integer@>
+ else begin back_input;
+ if cur_tok=continental_point_token then cur_tok:=point_token;
+ if cur_tok<>point_token then scan_int
+ else begin radix:=10; cur_val:=0;
+ end;
+ if cur_tok=continental_point_token then cur_tok:=point_token;
+ if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>;
+ end;
+ end;
+if cur_val<0 then {in this case |f=0|}
+ begin negative := not negative; negate(cur_val);
+ end;
+@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$, where there
+ are |x| sp per unit; |goto attach_sign| if the units are internal@>;
+@<Scan an optional space@>;
+attach_sign: if arith_error or(abs(cur_val)>=@'10000000000) then
+ @<Report that this dimension is out of range@>;
+if negative then negate(cur_val);
+end;
+
+@ @<Fetch an internal dimension and |goto attach_sign|...@>=
+if mu then
+ begin scan_something_internal(mu_val,false);
+ @<Coerce glue to a dimension@>;
+ if cur_val_level=mu_val then goto attach_sign;
+ if cur_val_level<>int_val then mu_error;
+ end
+else begin scan_something_internal(dimen_val,false);
+ if cur_val_level=dimen_val then goto attach_sign;
+ end
+
+@ @<Local variables for dimension calculations@>=
+@!num,@!denom:1..65536; {conversion ratio for the scanned units}
+@!k,@!kk:small_number; {number of digits in a decimal fraction}
+@!p,@!q:pointer; {top of decimal digit stack}
+@!v:scaled; {an internal dimension}
+@!save_cur_val:integer; {temporary storage of |cur_val|}
+
+@ The following code is executed when |scan_something_internal| was
+called asking for |mu_val|, when we really wanted a ``mudimen'' instead
+of ``muglue.''
+
+@<Coerce glue to a dimension@>=
+if cur_val_level>=glue_val then
+ begin v:=width(cur_val); delete_glue_ref(cur_val); cur_val:=v;
+ end
+
+@ When the following code is executed, we have |cur_tok=point_token|, but this
+token has been backed up using |back_input|; we must first discard it.
+
+It turns out that a decimal point all by itself is equivalent to `\.{0.0}'.
+Let's hope people don't use that fact.
+
+@<Scan decimal fraction@>=
+begin k:=0; p:=null; get_token; {|point_token| is being re-scanned}
+loop@+ begin get_x_token;
+ if (cur_tok>zero_token+9)or(cur_tok<zero_token) then goto done1;
+ if k<17 then {digits for |k>=17| cannot affect the result}
+ begin q:=get_avail; link(q):=p; info(q):=cur_tok-zero_token;
+ p:=q; incr(k);
+ end;
+ end;
+done1: for kk:=k downto 1 do
+ begin dig[kk-1]:=info(p); q:=p; p:=link(p); free_avail(q);
+ end;
+f:=round_decimals(k);
+if cur_cmd<>spacer then back_input;
+end
+
+@ Now comes the harder part: At this point in the program, |cur_val| is a
+nonnegative integer and $f/2^{16}$ is a nonnegative fraction less than 1;
+we want to multiply the sum of these two quantities by the appropriate
+factor, based on the specified units, in order to produce a |scaled|
+result, and we want to do the calculation with fixed point arithmetic that
+does not overflow.
+
+@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$...@>=
+if inf then @<Scan for \(f)\.{fil} units; |goto attach_fraction| if found@>;
+@<Scan for \(u)units that are internal dimensions;
+ |goto attach_sign| with |cur_val| set if found@>;
+if mu then @<Scan for \(m)\.{mu} units and |goto attach_fraction|@>;
+if scan_keyword("true") then @<Adjust \(f)for the magnification ratio@>;
+@.true@>
+if scan_keyword("pt") then goto attach_fraction; {the easy case}
+@.pt@>
+@<Scan for \(a)all other units and adjust |cur_val| and |f| accordingly;
+ |goto done| in the case of scaled points@>;
+attach_fraction: if cur_val>=@'40000 then arith_error:=true
+else cur_val:=cur_val*unity+f;
+done:
+
+@ A specification like `\.{filllll}' or `\.{fill L L L}' will lead to two
+error messages (one for each additional keyword \.{"l"}).
+
+@<Scan for \(f)\.{fil} units...@>=
+if scan_keyword("fil") then
+@.fil@>
+ begin cur_order:=fil;
+ while scan_keyword("l") do
+ begin if cur_order=filll then
+ begin print_err("Illegal unit of measure (");
+@.Illegal unit of measure@>
+ print("replaced by filll)");
+ help1("I dddon't go any higher than filll."); error;
+ end
+ else incr(cur_order);
+ end;
+ goto attach_fraction;
+ end
+
+@ @<Scan for \(u)units that are internal dimensions...@>=
+save_cur_val:=cur_val;
+@<Get the next non-blank non-call...@>;
+if (cur_cmd<min_internal)or(cur_cmd>max_internal) then back_input
+else begin if mu then
+ begin scan_something_internal(mu_val,false); @<Coerce glue...@>;
+ if cur_val_level<>mu_val then mu_error;
+ end
+ else scan_something_internal(dimen_val,false);
+ v:=cur_val; goto found;
+ end;
+if mu then goto not_found;
+if scan_keyword("em") then v:=(@<The em width for |cur_font|@>)
+@.em@>
+else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>)
+@.ex@>
+else goto not_found;
+@<Scan an optional space@>;
+found:cur_val:=nx_plus_y(save_cur_val,v,xn_over_d(v,f,@'200000));
+goto attach_sign;
+not_found:
+
+@ @<Scan for \(m)\.{mu} units and |goto attach_fraction|@>=
+if scan_keyword("mu") then goto attach_fraction
+@.mu@>
+else begin print_err("Illegal unit of measure ("); print("mu inserted)");
+@.Illegal unit of measure@>
+ help4("The unit of measurement in math glue must be mu.")@/
+ ("To recover gracefully from this error, it's best to")@/
+ ("delete the erroneous units; e.g., type `2' to delete")@/
+ ("two letters. (See Chapter 27 of The TeXbook.)");
+@:TeXbook}{\sl The \TeX book@>
+ error; goto attach_fraction;
+ end
+
+@ @<Adjust \(f)for the magnification ratio@>=
+begin prepare_mag;
+if mag<>1000 then
+ begin cur_val:=xn_over_d(cur_val,1000,mag);
+ f:=(1000*f+@'200000*remainder) div mag;
+ cur_val:=cur_val+(f div @'200000); f:=f mod @'200000;
+ end;
+end
+
+@ The necessary conversion factors can all be specified exactly as
+fractions whose numerator and denominator are 32768 or less.
+According to the definitions here, $\rm2660\,dd\approx1000.33297\,mm$;
+this agrees well with the value $\rm1000.333\,mm$ cited by Bosshard
+@^Bosshard, Hans Rudolf@>
+in {\sl Technische Grundlagen zur Satzherstellung\/} (Bern, 1980).
+
+@d set_conversion_end(#)== denom:=#; end
+@d set_conversion(#)==@+begin num:=#; set_conversion_end
+
+@<Scan for \(a)all other units and adjust |cur_val| and |f|...@>=
+if scan_keyword("in") then set_conversion(7227)(100)
+@.in@>
+else if scan_keyword("pc") then set_conversion(12)(1)
+@.pc@>
+else if scan_keyword("cm") then set_conversion(7227)(254)
+@.cm@>
+else if scan_keyword("mm") then set_conversion(7227)(2540)
+@.mm@>
+else if scan_keyword("bp") then set_conversion(7227)(7200)
+@.bp@>
+else if scan_keyword("dd") then set_conversion(1238)(1157)
+@.dd@>
+else if scan_keyword("cc") then set_conversion(14856)(1157)
+@.cc@>
+else if scan_keyword("sp") then goto done
+@.sp@>
+else @<Complain about unknown unit and |goto done2|@>;
+cur_val:=xn_over_d(cur_val,num,denom);
+f:=(num*f+@'200000*remainder) div denom;@/
+cur_val:=cur_val+(f div @'200000); f:=f mod @'200000;
+done2:
+
+@ @<Complain about unknown unit...@>=
+begin print_err("Illegal unit of measure ("); print("pt inserted)");
+@.Illegal unit of measure@>
+help6("Dimensions can be in units of em, ex, in, pt, pc,")@/
+ ("cm, mm, dd, cc, bp, or sp; but yours is a new one!")@/
+ ("I'll assume that you meant to say pt, for printer's points.")@/
+ ("To recover gracefully from this error, it's best to")@/
+ ("delete the erroneous units; e.g., type `2' to delete")@/
+ ("two letters. (See Chapter 27 of The TeXbook.)");
+@:TeXbook}{\sl The \TeX book@>
+error; goto done2;
+end
+
+
+@ @<Report that this dimension is out of range@>=
+begin print_err("Dimension too large");
+@.Dimension too large@>
+help2("I can't work with sizes bigger than about 19 feet.")@/
+ ("Continue and I'll use the largest value I can.");@/
+error; cur_val:=max_dimen; arith_error:=false;
+end
+
+@ The final member of \TeX's value-scanning trio is |scan_glue|, which
+makes |cur_val| point to a glue specification. The reference count of that
+glue spec will take account of the fact that |cur_val| is pointing to~it.
+
+The |level| parameter should be either |glue_val| or |mu_val|.
+
+Since |scan_dimen| was so much more complex than |scan_int|, we might expect
+|scan_glue| to be even worse. But fortunately, it is very simple, since
+most of the work has already been done.
+
+@p procedure scan_glue(@!level:small_number);
+ {sets |cur_val| to a glue spec pointer}
+label exit;
+var negative:boolean; {should the answer be negated?}
+@!q:pointer; {new glue specification}
+@!mu:boolean; {does |level=mu_val|?}
+begin mu:=(level=mu_val); @<Get the next non-blank non-sign...@>;
+if (cur_cmd>=min_internal)and(cur_cmd<=max_internal) then
+ begin scan_something_internal(level,negative);
+ if cur_val_level>=glue_val then
+ begin if cur_val_level<>level then mu_error;
+ return;
+ end;
+ if cur_val_level=int_val then scan_dimen(mu,false,true)
+ else if level=mu_val then mu_error;
+ end
+else begin back_input; scan_dimen(mu,false,false);
+ if negative then negate(cur_val);
+ end;
+@<Create a new glue specification whose width is |cur_val|; scan for its
+ stretch and shrink components@>;
+exit:end;
+
+@ @<Create a new glue specification whose width is |cur_val|...@>=
+q:=new_spec(zero_glue); width(q):=cur_val;
+if scan_keyword("plus") then
+@.plus@>
+ begin scan_dimen(mu,true,false);
+ stretch(q):=cur_val; stretch_order(q):=cur_order;
+ end;
+if scan_keyword("minus") then
+@.minus@>
+ begin scan_dimen(mu,true,false);
+ shrink(q):=cur_val; shrink_order(q):=cur_order;
+ end;
+cur_val:=q
+
+@ Here's a similar procedure that returns a pointer to a rule node. This
+routine is called just after \TeX\ has seen \.{\\hrule} or \.{\\vrule};
+therefore |cur_cmd| will be either |hrule| or |vrule|. The idea is to store
+the default rule dimensions in the node, then to override them if
+`\.{height}' or `\.{width}' or `\.{depth}' specifications are
+found (in any order).
+
+@d default_rule=26214 {0.4\thinspace pt}
+
+@p function scan_rule_spec:pointer;
+label reswitch;
+var q:pointer; {the rule node being created}
+begin q:=new_rule; {|width|, |depth|, and |height| all equal |null_flag| now}
+if cur_cmd=vrule then width(q):=default_rule
+else begin height(q):=default_rule; depth(q):=0;
+ end;
+reswitch: if scan_keyword("width") then
+@.width@>
+ begin scan_normal_dimen; width(q):=cur_val; goto reswitch;
+ end;
+if scan_keyword("height") then
+@.height@>
+ begin scan_normal_dimen; height(q):=cur_val; goto reswitch;
+ end;
+if scan_keyword("depth") then
+@.depth@>
+ begin scan_normal_dimen; depth(q):=cur_val; goto reswitch;
+ end;
+scan_rule_spec:=q;
+end;
+
+@* \[27] Building token lists.
+The token lists for macros and for other things like \.{\\mark} and \.{\\output}
+and \.{\\write} are produced by a procedure called |scan_toks|.
+
+Before we get into the details of |scan_toks|, let's consider a much
+simpler task, that of converting the current string into a token list.
+The |str_toks| function does this; it classifies spaces as type |spacer|
+and everything else as type |other_char|.
+
+The token list created by |str_toks| begins at |link(temp_head)| and ends
+at the value |p| that is returned. (If |p=temp_head|, the list is empty.)
+
+@p function str_toks(@!b:pool_pointer):pointer;
+ {changes the string |str_pool[b..pool_ptr]| to a token list}
+var p:pointer; {tail of the token list}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!t:halfword; {token being appended}
+@!k:pool_pointer; {index into |str_pool|}
+begin str_room(1);
+p:=temp_head; link(p):=null; k:=b;
+while k<pool_ptr do
+ begin t:=so(str_pool[k]);
+ if t=" " then t:=space_token
+ else t:=other_token+t;
+ fast_store_new_token(t);
+ incr(k);
+ end;
+pool_ptr:=b; str_toks:=p;
+end;
+
+@ The main reason for wanting |str_toks| is the next function,
+|the_toks|, which has similar input/output characteristics.
+
+This procedure is supposed to scan something like `\.{\\skip\\count12}',
+i.e., whatever can follow `\.{\\the}', and it constructs a token list
+containing something like `\.{-3.0pt minus 0.5fill}'.
+
+@p function the_toks:pointer;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!p,@!q,@!r:pointer; {used for copying a token list}
+@!b:pool_pointer; {base of temporary string}
+begin get_x_token; scan_something_internal(tok_val,false);
+if cur_val_level>=ident_val then @<Copy the token list@>
+else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
+ case cur_val_level of
+ int_val:print_int(cur_val);
+ dimen_val:begin print_scaled(cur_val); print("pt");
+ end;
+ glue_val: begin print_spec(cur_val,"pt"); delete_glue_ref(cur_val);
+ end;
+ mu_val: begin print_spec(cur_val,"mu"); delete_glue_ref(cur_val);
+ end;
+ end; {there are no other cases}
+ selector:=old_setting; the_toks:=str_toks(b);
+ end;
+end;
+
+@ @<Copy the token list@>=
+begin p:=temp_head; link(p):=null;
+if cur_val_level=ident_val then store_new_token(cs_token_flag+cur_val)
+else if cur_val<>null then
+ begin r:=link(cur_val); {do not copy the reference count}
+ while r<>null do
+ begin fast_store_new_token(info(r)); r:=link(r);
+ end;
+ end;
+the_toks:=p;
+end
+
+@ Here's part of the |expand| subroutine that we are now ready to complete:
+
+@p procedure ins_the_toks;
+begin link(garbage):=the_toks; ins_list(link(temp_head));
+end;
+
+@ The primitives \.{\\number}, \.{\\romannumeral}, \.{\\string}, \.{\\meaning},
+\.{\\fontname}, and \.{\\jobname} are defined as follows.
+
+@d number_code=0 {command code for \.{\\number}}
+@d roman_numeral_code=1 {command code for \.{\\romannumeral}}
+@d string_code=2 {command code for \.{\\string}}
+@d meaning_code=3 {command code for \.{\\meaning}}
+@d font_name_code=4 {command code for \.{\\fontname}}
+@d job_name_code=5 {command code for \.{\\jobname}}
+
+@<Put each...@>=
+primitive("number",convert,number_code);@/
+@!@:number_}{\.{\\number} primitive@>
+primitive("romannumeral",convert,roman_numeral_code);@/
+@!@:roman_numeral_}{\.{\\romannumeral} primitive@>
+primitive("string",convert,string_code);@/
+@!@:string_}{\.{\\string} primitive@>
+primitive("meaning",convert,meaning_code);@/
+@!@:meaning_}{\.{\\meaning} primitive@>
+primitive("fontname",convert,font_name_code);@/
+@!@:font_name_}{\.{\\fontname} primitive@>
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+convert: case chr_code of
+ number_code: print_esc("number");
+ roman_numeral_code: print_esc("romannumeral");
+ string_code: print_esc("string");
+ meaning_code: print_esc("meaning");
+ font_name_code: print_esc("fontname");
+ othercases print_esc("jobname")
+ endcases;
+
+@ The procedure |conv_toks| uses |str_toks| to insert the token list
+for |convert| functions into the scanner; `\.{\\outer}' control sequences
+are allowed to follow `\.{\\string}' and `\.{\\meaning}'.
+
+@p procedure conv_toks;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!c:number_code..job_name_code; {desired type of conversion}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!b:pool_pointer; {base of temporary string}
+begin c:=cur_chr; @<Scan the argument for command |c|@>;
+old_setting:=selector; selector:=new_string; b:=pool_ptr;
+@<Print the result of command |c|@>;
+selector:=old_setting; link(garbage):=str_toks(b); ins_list(link(temp_head));
+end;
+
+@ @<Scan the argument for command |c|@>=
+case c of
+number_code,roman_numeral_code: scan_int;
+string_code, meaning_code: begin save_scanner_status:=scanner_status;
+ scanner_status:=normal; get_token; scanner_status:=save_scanner_status;
+ end;
+font_name_code: scan_font_ident;
+job_name_code: if job_name=0 then open_log_file;
+end {there are no other cases}
+
+@ @<Print the result of command |c|@>=
+case c of
+number_code: print_int(cur_val);
+roman_numeral_code: print_roman_int(cur_val);
+string_code:if cur_cs<>0 then sprint_cs(cur_cs)
+ else print_char(cur_chr);
+meaning_code: print_meaning;
+font_name_code: begin print(font_name[cur_val]);
+ if font_size[cur_val]<>font_dsize[cur_val] then
+ begin print(" at "); print_scaled(font_size[cur_val]);
+ print("pt");
+ end;
+ end;
+job_name_code: print(job_name);
+end {there are no other cases}
+
+@ Now we can't postpone the difficulties any longer; we must bravely tackle
+|scan_toks|. This function returns a pointer to the tail of a new token
+list, and it also makes |def_ref| point to the reference count at the
+head of that list.
+
+There are two boolean parameters, |macro_def| and |xpand|. If |macro_def|
+is true, the goal is to create the token list for a macro definition;
+otherwise the goal is to create the token list for some other \TeX\
+primitive: \.{\\mark}, \.{\\output}, \.{\\everypar}, \.{\\lowercase},
+\.{\\uppercase}, \.{\\message}, \.{\\errmessage}, \.{\\write}, or
+\.{\\special}. In the latter cases a left brace must be scanned next; this
+left brace will not be part of the token list, nor will the matching right
+brace that comes at the end. If |xpand| is false, the token list will
+simply be copied from the input using |get_token|. Otherwise all expandable
+tokens will be expanded until unexpandable tokens are left, except that
+the results of expanding `\.{\\the}' are not expanded further.
+If both |macro_def| and |xpand| are true, the expansion applies
+only to the macro body (i.e., to the material following the first
+|left_brace| character).
+
+The value of |cur_cs| when |scan_toks| begins should be the |eqtb|
+address of the control sequence to display in ``runaway'' error
+messages.
+
+@p function scan_toks(@!macro_def,@!xpand:boolean):pointer;
+label found,done,done1,done2;
+var t:halfword; {token representing the highest parameter number}
+@!s:halfword; {saved token}
+@!p:pointer; {tail of the token list being built}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!unbalance:halfword; {number of unmatched left braces}
+@!hash_brace:halfword; {possible `\.{\#\{}' token}
+begin if macro_def then scanner_status:=defining
+@+else scanner_status:=absorbing;
+warning_index:=cur_cs; def_ref:=get_avail; token_ref_count(def_ref):=null;
+p:=def_ref; hash_brace:=0; t:=zero_token;
+if macro_def then @<Scan and build the parameter part of the macro definition@>
+else scan_left_brace; {remove the compulsory left brace}
+@<Scan and build the body of the token list; |goto found| when finished@>;
+found: scanner_status:=normal;
+if hash_brace<>0 then store_new_token(hash_brace);
+scan_toks:=p;
+end;
+
+@ @<Scan and build the parameter part...@>=
+begin loop begin get_token; {set |cur_cmd|, |cur_chr|, |cur_tok|}
+ if cur_tok<right_brace_limit then goto done1;
+ if cur_cmd=mac_param then
+ @<If the next character is a parameter number, make |cur_tok|
+ a |match| token; but if it is a left brace, store
+ `|left_brace|, |end_match|', set |hash_brace|, and |goto done|@>;
+ store_new_token(cur_tok);
+ end;
+done1: store_new_token(end_match_token);
+if cur_cmd=right_brace then
+ @<Express shock at the missing left brace; |goto found|@>;
+done: end
+
+@ @<Express shock...@>=
+begin print_err("Missing { inserted"); incr(align_state);
+@.Missing \{ inserted@>
+help2("Where was the left brace? You said something like `\def\a}',")@/
+ ("which I'm going to interpret as `\def\a{}'."); error; goto found;
+end
+
+@ @<If the next character is a parameter number...@>=
+begin s:=match_token+cur_chr; get_token;
+if cur_cmd=left_brace then
+ begin hash_brace:=cur_tok;
+ store_new_token(cur_tok); store_new_token(end_match_token);
+ goto done;
+ end;
+if t=zero_token+9 then
+ begin print_err("You already have nine parameters");
+@.You already have nine...@>
+ help1("I'm going to ignore the # sign you just used."); error;
+ end
+else begin incr(t);
+ if cur_tok<>t then
+ begin print_err("Parameters must be numbered consecutively");
+@.Parameters...consecutively@>
+ help2("I've inserted the digit you should have used after the #.")@/
+ ("Type `1' to delete what you did use."); back_error;
+ end;
+ cur_tok:=s;
+ end;
+end
+
+@ @<Scan and build the body of the token list; |goto found| when finished@>=
+unbalance:=1;
+loop@+ begin if xpand then @<Expand the next part of the input@>
+ else get_token;
+ if cur_tok<right_brace_limit then
+ if cur_cmd<right_brace then incr(unbalance)
+ else begin decr(unbalance);
+ if unbalance=0 then goto found;
+ end
+ else if cur_cmd=mac_param then
+ if macro_def then @<Look for parameter number or \.{\#\#}@>;
+ store_new_token(cur_tok);
+ end
+
+@ Here we insert an entire token list created by |the_toks| without
+expanding it further.
+
+@<Expand the next part of the input@>=
+begin loop begin get_next;
+ if cur_cmd<=max_command then goto done2;
+ if cur_cmd<>the then expand
+ else begin q:=the_toks;
+ if link(temp_head)<>null then
+ begin link(p):=link(temp_head); p:=q;
+ end;
+ end;
+ end;
+done2: x_token
+end
+
+@ @<Look for parameter number...@>=
+begin s:=cur_tok;
+if xpand then get_x_token else get_token;
+if cur_cmd<>mac_param then
+ if (cur_tok<=zero_token)or(cur_tok>t) then
+ begin print_err("Illegal parameter number in definition of ");
+@.Illegal parameter number...@>
+ sprint_cs(warning_index);
+ help3("You meant to type ## instead of #, right?")@/
+ ("Or maybe a } was forgotten somewhere earlier, and things")@/
+ ("are all screwed up? I'm going to assume that you meant ##.");
+ back_error; cur_tok:=s;
+ end
+ else cur_tok:=out_param_token-"0"+cur_chr;
+end
+
+@ Another way to create a token list is via the \.{\\read} command. The
+sixteen files potentially usable for reading appear in the following
+global variables. The value of |read_open[n]| will be |closed| if
+stream number |n| has not been opened or if it has been fully read;
+|just_open| if an \.{\\openin} but not a \.{\\read} has been done;
+and |normal| if it is open and ready to read the next line.
+
+@d closed=2 {not open, or at end of file}
+@d just_open=1 {newly opened, first line not yet read}
+
+@<Glob...@>=
+@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
+@!read_open:array[0..16] of normal..closed; {state of |read_file[n]|}
+
+@ @<Set init...@>=
+for k:=0 to 16 do read_open[k]:=closed;
+
+@ The |read_toks| procedure constructs a token list like that for any
+macro definition, and makes |cur_val| point to it. Parameter |r| points
+to the control sequence that will receive this token list.
+
+@p procedure read_toks(@!n:integer;@!r:pointer);
+label done;
+var p:pointer; {tail of the token list}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!s:integer; {saved value of |align_state|}
+@!m:small_number; {stream number}
+begin scanner_status:=defining; warning_index:=r;
+def_ref:=get_avail; token_ref_count(def_ref):=null;
+p:=def_ref; {the reference count}
+store_new_token(end_match_token);
+if (n<0)or(n>15) then m:=16@+else m:=n;
+s:=align_state; align_state:=1000000; {disable tab marks, etc.}
+repeat @<Input and store tokens from the next line of the file@>;
+until align_state=1000000;
+cur_val:=def_ref; scanner_status:=normal; align_state:=s;
+end;
+
+@ @<Input and store tokens from the next line of the file@>=
+begin_file_reading; name:=m+1;
+if read_open[m]=closed then @<Input for \.{\\read} from the terminal@>
+else if read_open[m]=just_open then @<Input the first line of |read_file[m]|@>
+else @<Input the next line of |read_file[m]|@>;
+limit:=last;
+if end_line_char_inactive then decr(limit)
+else buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start; state:=new_line;@/
+loop@+ begin get_token;
+ if cur_tok=0 then goto done;
+ {|cur_cmd=cur_chr=0| will occur at the end of the line}
+ if align_state<1000000 then {unmatched `\.\}' aborts the line}
+ begin repeat get_token; until cur_tok=0;
+ align_state:=1000000; goto done;
+ end;
+ store_new_token(cur_tok);
+ end;
+done: end_file_reading
+
+@ Here we input on-line into the |buffer| array, prompting the user explicitly
+if |n>=0|. The value of |n| is set negative so that additional prompts
+will not be given in the case of multi-line input.
+
+@<Input for \.{\\read} from the terminal@>=
+if interaction>nonstop_mode then
+ if n<0 then prompt_input("")
+ else begin wake_up_terminal;
+ print_ln; sprint_cs(r); prompt_input("="); n:=-1;
+ end
+else fatal_error("*** (cannot \read from terminal in nonstop modes)")
+@.cannot \\read@>
+
+@ The first line of a file must be treated specially, since |input_ln|
+must be told not to start with |get|.
+@^system dependencies@>
+
+@<Input the first line of |read_file[m]|@>=
+if input_ln(read_file[m],false) then read_open[m]:=normal
+else begin a_close(read_file[m]); read_open[m]:=closed;
+ end
+
+@ An empty line is appended at the end of a |read_file|.
+@^empty line at end of file@>
+
+@<Input the next line of |read_file[m]|@>=
+begin if not input_ln(read_file[m],true) then
+ begin a_close(read_file[m]); read_open[m]:=closed;
+ if align_state<>1000000 then
+ begin runaway;
+ print_err("File ended within "); print_esc("read");
+@.File ended within \\read@>
+ help1("This \read has unbalanced braces.");
+ align_state:=1000000; error;
+ end;
+ end;
+end
+
+@* \[28] Conditional processing.
+We consider now the way \TeX\ handles various kinds of \.{\\if} commands.
+
+@d if_char_code=0 { `\.{\\if}' }
+@d if_cat_code=1 { `\.{\\ifcat}' }
+@d if_int_code=2 { `\.{\\ifnum}' }
+@d if_dim_code=3 { `\.{\\ifdim}' }
+@d if_odd_code=4 { `\.{\\ifodd}' }
+@d if_vmode_code=5 { `\.{\\ifvmode}' }
+@d if_hmode_code=6 { `\.{\\ifhmode}' }
+@d if_mmode_code=7 { `\.{\\ifmmode}' }
+@d if_inner_code=8 { `\.{\\ifinner}' }
+@d if_void_code=9 { `\.{\\ifvoid}' }
+@d if_hbox_code=10 { `\.{\\ifhbox}' }
+@d if_vbox_code=11 { `\.{\\ifvbox}' }
+@d ifx_code=12 { `\.{\\ifx}' }
+@d if_eof_code=13 { `\.{\\ifeof}' }
+@d if_true_code=14 { `\.{\\iftrue}' }
+@d if_false_code=15 { `\.{\\iffalse}' }
+@d if_case_code=16 { `\.{\\ifcase}' }
+
+@<Put each...@>=
+primitive("if",if_test,if_char_code);
+@!@:if_char_}{\.{\\if} primitive@>
+primitive("ifcat",if_test,if_cat_code);
+@!@:if_cat_code_}{\.{\\ifcat} primitive@>
+primitive("ifnum",if_test,if_int_code);
+@!@:if_int_}{\.{\\ifnum} primitive@>
+primitive("ifdim",if_test,if_dim_code);
+@!@:if_dim_}{\.{\\ifdim} primitive@>
+primitive("ifodd",if_test,if_odd_code);
+@!@:if_odd_}{\.{\\ifodd} primitive@>
+primitive("ifvmode",if_test,if_vmode_code);
+@!@:if_vmode_}{\.{\\ifvmode} primitive@>
+primitive("ifhmode",if_test,if_hmode_code);
+@!@:if_hmode_}{\.{\\ifhmode} primitive@>
+primitive("ifmmode",if_test,if_mmode_code);
+@!@:if_mmode_}{\.{\\ifmmode} primitive@>
+primitive("ifinner",if_test,if_inner_code);
+@!@:if_inner_}{\.{\\ifinner} primitive@>
+primitive("ifvoid",if_test,if_void_code);
+@!@:if_void_}{\.{\\ifvoid} primitive@>
+primitive("ifhbox",if_test,if_hbox_code);
+@!@:if_hbox_}{\.{\\ifhbox} primitive@>
+primitive("ifvbox",if_test,if_vbox_code);
+@!@:if_vbox_}{\.{\\ifvbox} primitive@>
+primitive("ifx",if_test,ifx_code);
+@!@:ifx_}{\.{\\ifx} primitive@>
+primitive("ifeof",if_test,if_eof_code);
+@!@:if_eof_}{\.{\\ifeof} primitive@>
+primitive("iftrue",if_test,if_true_code);
+@!@:if_true_}{\.{\\iftrue} primitive@>
+primitive("iffalse",if_test,if_false_code);
+@!@:if_false_}{\.{\\iffalse} primitive@>
+primitive("ifcase",if_test,if_case_code);
+@!@:if_case_}{\.{\\ifcase} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+if_test: case chr_code of
+ if_cat_code:print_esc("ifcat");
+ if_int_code:print_esc("ifnum");
+ if_dim_code:print_esc("ifdim");
+ if_odd_code:print_esc("ifodd");
+ if_vmode_code:print_esc("ifvmode");
+ if_hmode_code:print_esc("ifhmode");
+ if_mmode_code:print_esc("ifmmode");
+ if_inner_code:print_esc("ifinner");
+ if_void_code:print_esc("ifvoid");
+ if_hbox_code:print_esc("ifhbox");
+ if_vbox_code:print_esc("ifvbox");
+ ifx_code:print_esc("ifx");
+ if_eof_code:print_esc("ifeof");
+ if_true_code:print_esc("iftrue");
+ if_false_code:print_esc("iffalse");
+ if_case_code:print_esc("ifcase");
+ othercases print_esc("if")
+ endcases;
+
+@ Conditions can be inside conditions, and this nesting has a stack
+that is independent of the |save_stack|.
+
+Four global variables represent the top of the condition stack:
+|cond_ptr| points to pushed-down entries, if any; |if_limit| specifies
+the largest code of a |fi_or_else| command that is syntactically legal;
+|cur_if| is the name of the current type of conditional; and |if_line|
+is the line number at which it began.
+
+If no conditions are currently in progress, the condition stack has the
+special state |cond_ptr=null|, |if_limit=normal|, |cur_if=0|, |if_line=0|.
+Otherwise |cond_ptr| points to a two-word node; the |type|, |subtype|, and
+|link| fields of the first word contain |if_limit|, |cur_if|, and
+|cond_ptr| at the next level, and the second word contains the
+corresponding |if_line|.
+
+@d if_node_size=2 {number of words in stack entry for conditionals}
+@d if_line_field(#)==mem[#+1].int
+@d if_code=1 {code for \.{\\if...} being evaluated}
+@d fi_code=2 {code for \.{\\fi}}
+@d else_code=3 {code for \.{\\else}}
+@d or_code=4 {code for \.{\\or}}
+
+@<Glob...@>=
+@!cond_ptr:pointer; {top of the condition stack}
+@!if_limit:normal..or_code; {upper bound on |fi_or_else| codes}
+@!cur_if:small_number; {type of conditional being worked on}
+@!if_line:integer; {line where that conditional began}
+
+@ @<Set init...@>=
+cond_ptr:=null; if_limit:=normal; cur_if:=0; if_line:=0;
+
+@ @<Put each...@>=
+primitive("fi",fi_or_else,fi_code);
+@!@:fi_}{\.{\\fi} primitive@>
+text(frozen_fi):="fi"; eqtb[frozen_fi]:=eqtb[cur_val];
+primitive("or",fi_or_else,or_code);
+@!@:or_}{\.{\\or} primitive@>
+primitive("else",fi_or_else,else_code);
+@!@:else_}{\.{\\else} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+fi_or_else: if chr_code=fi_code then print_esc("fi")
+ else if chr_code=or_code then print_esc("or")
+ else print_esc("else");
+
+@ When we skip conditional text, we keep track of the line number
+where skipping began, for use in error messages.
+
+@<Glob...@>=
+@!skip_line:integer; {skipping began here}
+
+@ Here is a procedure that ignores text until coming to an \.{\\or},
+\.{\\else}, or \.{\\fi} at level zero of $\.{\\if}\ldots\.{\\fi}$
+nesting. After it has acted, |cur_chr| will indicate the token that
+was found, but |cur_tok| will not be set (because this makes the
+procedure run faster).
+
+@p procedure pass_text;
+label done;
+var l:integer; {level of $\.{\\if}\ldots\.{\\fi}$ nesting}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+begin save_scanner_status:=scanner_status; scanner_status:=skipping; l:=0;
+skip_line:=line;
+loop@+ begin get_next;
+ if cur_cmd=fi_or_else then
+ begin if l=0 then goto done;
+ if cur_chr=fi_code then decr(l);
+ end
+ else if cur_cmd=if_test then incr(l);
+ end;
+done: scanner_status:=save_scanner_status;
+end;
+
+@ When we begin to process a new \.{\\if}, we set |if_limit:=if_code|; then
+if\/ \.{\\or} or \.{\\else} or \.{\\fi} occurs before the current \.{\\if}
+condition has been evaluated, \.{\\relax} will be inserted.
+For example, a sequence of commands like `\.{\\ifvoid1\\else...\\fi}'
+would otherwise require something after the `\.1'.
+
+@<Push the condition stack@>=
+begin p:=get_node(if_node_size); link(p):=cond_ptr; type(p):=if_limit;
+subtype(p):=cur_if; if_line_field(p):=if_line;
+cond_ptr:=p; cur_if:=cur_chr; if_limit:=if_code; if_line:=line;
+end
+
+@ @<Pop the condition stack@>=
+begin p:=cond_ptr; if_line:=if_line_field(p);
+cur_if:=subtype(p); if_limit:=type(p); cond_ptr:=link(p);
+free_node(p,if_node_size);
+end
+
+@ Here's a procedure that changes the |if_limit| code corresponding to
+a given value of |cond_ptr|.
+
+@p procedure change_if_limit(@!l:small_number;@!p:pointer);
+label exit;
+var q:pointer;
+begin if p=cond_ptr then if_limit:=l {that's the easy case}
+else begin q:=cond_ptr;
+ loop@+ begin if q=null then confusion("if");
+@:this can't happen if}{\quad if@>
+ if link(q)=p then
+ begin type(q):=l; return;
+ end;
+ q:=link(q);
+ end;
+ end;
+exit:end;
+
+@ A condition is started when the |expand| procedure encounters
+an |if_test| command; in that case |expand| reduces to |conditional|,
+which is a recursive procedure.
+@^recursion@>
+
+@p procedure conditional;
+label exit,common_ending;
+var b:boolean; {is the condition true?}
+@!r:"<"..">"; {relation to be evaluated}
+@!m,@!n:integer; {to be tested against the second operand}
+@!p,@!q:pointer; {for traversing token lists in \.{\\ifx} tests}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!save_cond_ptr:pointer; {|cond_ptr| corresponding to this conditional}
+@!this_if:small_number; {type of this conditional}
+begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+if tracing_commands>1 then @<Display the value of |b|@>;
+if b then
+ begin change_if_limit(else_code,save_cond_ptr);
+ return; {wait for \.{\\else} or \.{\\fi}}
+ end;
+@<Skip to \.{\\else} or \.{\\fi}, then |goto common_ending|@>;
+common_ending: if cur_chr=fi_code then @<Pop the condition stack@>
+else if_limit:=fi_code; {wait for \.{\\fi}}
+exit:end;
+
+@ In a construction like `\.{\\if\\iftrue abc\\else d\\fi}', the first
+\.{\\else} that we come to after learning that the \.{\\if} is false is
+not the \.{\\else} we're looking for. Hence the following curious
+logic is needed.
+
+@ @<Skip to \.{\\else} or \.{\\fi}...@>=
+loop@+ begin pass_text;
+ if cond_ptr=save_cond_ptr then
+ begin if cur_chr<>or_code then goto common_ending;
+ print_err("Extra "); print_esc("or");
+@.Extra \\or@>
+ help1("I'm ignoring this; it doesn't match any \if.");
+ error;
+ end
+ else if cur_chr=fi_code then @<Pop the condition stack@>;
+ end
+
+@ @<Either process \.{\\ifcase} or set |b|...@>=
+case this_if of
+if_char_code, if_cat_code: @<Test if two characters match@>;
+if_int_code, if_dim_code: @<Test relation between integers or dimensions@>;
+if_odd_code: @<Test if an integer is odd@>;
+if_vmode_code: b:=(abs(mode)=vmode);
+if_hmode_code: b:=(abs(mode)=hmode);
+if_mmode_code: b:=(abs(mode)=mmode);
+if_inner_code: b:=(mode<0);
+if_void_code, if_hbox_code, if_vbox_code: @<Test box register status@>;
+ifx_code: @<Test if two tokens match@>;
+if_eof_code: begin scan_four_bit_int; b:=(read_open[cur_val]=closed);
+ end;
+if_true_code: b:=true;
+if_false_code: b:=false;
+if_case_code: @<Select the appropriate case
+ and |return| or |goto common_ending|@>;
+end {there are no other cases}
+
+@ @<Display the value of |b|@>=
+begin begin_diagnostic;
+if b then print("{true}")@+else print("{false}");
+end_diagnostic(false);
+end
+
+@ Here we use the fact that |"<"|, |"="|, and |">"| are consecutive ASCII
+codes.
+@^ASCII code@>
+
+@<Test relation between integers or dimensions@>=
+begin if this_if=if_int_code then scan_int@+else scan_normal_dimen;
+n:=cur_val; @<Get the next non-blank non-call...@>;
+if (cur_tok>=other_token+"<")and(cur_tok<=other_token+">") then
+ r:=cur_tok-other_token
+else begin print_err("Missing = inserted for ");
+@.Missing = inserted@>
+ print_cmd_chr(if_test,this_if);
+ help1("I was expecting to see `<', `=', or `>'. Didn't.");
+ back_error; r:="=";
+ end;
+if this_if=if_int_code then scan_int@+else scan_normal_dimen;
+case r of
+"<": b:=(n<cur_val);
+"=": b:=(n=cur_val);
+">": b:=(n>cur_val);
+end;
+end
+
+@ @<Test if an integer is odd@>=
+begin scan_int; b:=odd(cur_val);
+end
+
+@ @<Test box register status@>=
+begin scan_eight_bit_int; p:=box(cur_val);
+if this_if=if_void_code then b:=(p=null)
+else if p=null then b:=false
+else if this_if=if_hbox_code then b:=(type(p)=hlist_node)
+else b:=(type(p)=vlist_node);
+end
+
+@ An active character will be treated as category 13 following
+\.{\\if\\noexpand} or following \.{\\ifcat\\noexpand}. We use the fact that
+active characters have the smallest tokens, among all control sequences.
+
+@d get_x_token_or_active_char==@t@>@;
+ begin get_x_token;
+ if cur_cmd=relax then if cur_chr=no_expand_flag then
+ begin cur_cmd:=active_char;
+ cur_chr:=cur_tok-cs_token_flag-active_base;
+ end;
+ end
+
+@<Test if two characters match@>=
+begin get_x_token_or_active_char;
+if (cur_cmd>active_char)or(cur_chr>255) then {not a character}
+ begin m:=relax; n:=256;
+ end
+else begin m:=cur_cmd; n:=cur_chr;
+ end;
+get_x_token_or_active_char;
+if (cur_cmd>active_char)or(cur_chr>255) then
+ begin cur_cmd:=relax; cur_chr:=256;
+ end;
+if this_if=if_char_code then b:=(n=cur_chr)@+else b:=(m=cur_cmd);
+end
+
+@ Note that `\.{\\ifx}' will declare two macros different if one is \\{long}
+or \\{outer} and the other isn't, even though the texts of the macros are
+the same.
+
+We need to reset |scanner_status|, since \.{\\outer} control sequences
+are allowed, but we might be scanning a macro definition or preamble.
+
+@<Test if two tokens match@>=
+begin save_scanner_status:=scanner_status; scanner_status:=normal;
+get_next; n:=cur_cs; p:=cur_cmd; q:=cur_chr;
+get_next; if cur_cmd<>p then b:=false
+else if cur_cmd<call then b:=(cur_chr=q)
+else @<Test if two macro texts match@>;
+scanner_status:=save_scanner_status;
+end
+
+@ Note also that `\.{\\ifx}' decides that macros \.{\\a} and \.{\\b} are
+different in examples like this:
+$$\vbox{\halign{\.{#}\hfil&\qquad\.{#}\hfil\cr
+ {}\\def\\a\{\\c\}&
+ {}\\def\\c\{\}\cr
+ {}\\def\\b\{\\d\}&
+ {}\\def\\d\{\}\cr}}$$
+
+@<Test if two macro texts match@>=
+begin p:=link(cur_chr); q:=link(equiv(n)); {omit reference counts}
+if p=q then b:=true
+else begin while (p<>null)and(q<>null) do
+ if info(p)<>info(q) then p:=null
+ else begin p:=link(p); q:=link(q);
+ end;
+ b:=((p=null)and(q=null));
+ end;
+end
+
+@ @<Select the appropriate case and |return| or |goto common_ending|@>=
+begin scan_int; n:=cur_val; {|n| is the number of cases to pass}
+if tracing_commands>1 then
+ begin begin_diagnostic; print("{case "); print_int(n); print_char("}");
+ end_diagnostic(false);
+ end;
+while n<>0 do
+ begin pass_text;
+ if cond_ptr=save_cond_ptr then
+ if cur_chr=or_code then decr(n)
+ else goto common_ending
+ else if cur_chr=fi_code then @<Pop the condition stack@>;
+ end;
+change_if_limit(or_code,save_cond_ptr);
+return; {wait for \.{\\or}, \.{\\else}, or \.{\\fi}}
+end
+
+@ The processing of conditionals is complete except for the following
+code, which is actually part of |expand|. It comes into play when
+\.{\\or}, \.{\\else}, or \.{\\fi} is scanned.
+
+@<Terminate the current conditional and skip to \.{\\fi}@>=
+if cur_chr>if_limit then
+ if if_limit=if_code then insert_relax {condition not yet evaluated}
+ else begin print_err("Extra "); print_cmd_chr(fi_or_else,cur_chr);
+@.Extra \\or@>
+@.Extra \\else@>
+@.Extra \\fi@>
+ help1("I'm ignoring this; it doesn't match any \if.");
+ error;
+ end
+else begin while cur_chr<>fi_code do pass_text; {skip to \.{\\fi}}
+ @<Pop the condition stack@>;
+ end
+
+@* \[29] File names.
+It's time now to fret about file names. Besides the fact that different
+operating systems treat files in different ways, we must cope with the
+fact that completely different naming conventions are used by different
+groups of people. The following programs show what is required for one
+particular operating system; similar routines for other systems are not
+difficult to devise.
+@^fingers@>
+@^system dependencies@>
+
+\TeX\ assumes that a file name has three parts: the name proper; its
+``extension''; and a ``file area'' where it is found in an external file
+system. The extension of an input file or a write file is assumed to be
+`\.{.tex}' unless otherwise specified; it is `\.{.log}' on the
+transcript file that records each run of \TeX; it is `\.{.tfm}' on the font
+metric files that describe characters in the fonts \TeX\ uses; it is
+`\.{.dvi}' on the output files that specify typesetting information; and it
+is `\.{.fmt}' on the format files written by \.{INITEX} to initialize \TeX.
+The file area can be arbitrary on input files, but files are usually
+output to the user's current area. If an input file cannot be
+found on the specified area, \TeX\ will look for it on a special system
+area; this special area is intended for commonly used input files like
+\.{webmac.tex}.
+
+Simple uses of \TeX\ refer only to file names that have no explicit
+extension or area. For example, a person usually says `\.{\\input} \.{paper}'
+or `\.{\\font\\tenrm} \.= \.{helvetica}' instead of `\.{\\input}
+\.{paper.new}' or `\.{\\font\\tenrm} \.= \.{<csd.knuth>test}'. Simple file
+names are best, because they make the \TeX\ source files portable;
+whenever a file name consists entirely of letters and digits, it should be
+treated in the same way by all implementations of \TeX. However, users
+need the ability to refer to other files in their environment, especially
+when responding to error messages concerning unopenable files; therefore
+we want to let them use the syntax that appears in their favorite
+operating system.
+
+The following procedures don't allow spaces to be part of
+file names; but some users seem to like names that are spaced-out.
+System-dependent changes to allow such things should probably
+be made with reluctance, and only when an entire file name that
+includes spaces is ``quoted'' somehow.
+
+@ In order to isolate the system-dependent aspects of file names, the
+@^system dependencies@>
+system-independent parts of \TeX\ are expressed in terms
+of three system-dependent
+procedures called |begin_name|, |more_name|, and |end_name|. In
+essence, if the user-specified characters of the file name are $c_1\ldots c_n$,
+the system-independent driver program does the operations
+$$|begin_name|;\,|more_name|(c_1);\,\ldots\,;|more_name|(c_n);
+\,|end_name|.$$
+These three procedures communicate with each other via global variables.
+Afterwards the file name will appear in the string pool as three strings
+called |cur_name|\penalty10000\hskip-.05em,
+|cur_area|, and |cur_ext|; the latter two are null (i.e.,
+|""|), unless they were explicitly specified by the user.
+
+Actually the situation is slightly more complicated, because \TeX\ needs
+to know when the file name ends. The |more_name| routine is a function
+(with side effects) that returns |true| on the calls |more_name|$(c_1)$,
+\dots, |more_name|$(c_{n-1})$. The final call |more_name|$(c_n)$
+returns |false|; or, it returns |true| and the token following $c_n$ is
+something like `\.{\\hbox}' (i.e., not a character). In other words,
+|more_name| is supposed to return |true| unless it is sure that the
+file name has been completely scanned; and |end_name| is supposed to be able
+to finish the assembly of |cur_name|, |cur_area|, and |cur_ext| regardless of
+whether $|more_name|(c_n)$ returned |true| or |false|.
+
+@<Glob...@>=
+@!cur_name:str_number; {name of file just scanned}
+@!cur_area:str_number; {file area just scanned, or \.{""}}
+@!cur_ext:str_number; {file extension just scanned, or \.{""}}
+
+@ The file names we shall deal with for illustrative purposes have the
+following structure: If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null. If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters:
+
+@<Glob...@>=
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+
+@ Input files that can't be found in the user's area may appear in a standard
+system area called |TEX_area|. Font metric files whose areas are not given
+explicitly are assumed to appear in a standard system area called
+|TEX_font_area|. These system area names will, of course, vary from place
+to place.
+@^system dependencies@>
+
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+
+@ Here now is the first of the system-dependent routines for file name scanning.
+@^system dependencies@>
+
+@p procedure begin_name;
+begin area_delimiter:=0; ext_delimiter:=0;
+end;
+
+@ And here's the second. The string pool might change as the file name is
+being scanned, since a new \.{\\csname} might be entered; therefore we keep
+|area_delimiter| and |ext_delimiter| relative to the beginning of the current
+string, instead of assigning an absolute address like |pool_ptr| to them.
+@^system dependencies@>
+
+@p function more_name(@!c:ASCII_code):boolean;
+begin if c=" " then more_name:=false
+else begin str_room(1); append_char(c); {contribute |c| to the current string}
+ if (c=">")or(c=":") then
+ begin area_delimiter:=cur_length; ext_delimiter:=0;
+ end
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
+ more_name:=true;
+ end;
+end;
+
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+if area_delimiter=0 then cur_area:=""
+else begin cur_area:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr;
+ str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
+ incr(str_ptr); cur_ext:=make_string;
+ end;
+end;
+
+@ Conversely, here is a routine that takes three strings and prints a file
+name that might have produced them. (The routine is system dependent, because
+some operating systems put the file area last instead of first.)
+@^system dependencies@>
+
+@<Basic printing...@>=
+procedure print_file_name(@!n,@!a,@!e:integer);
+begin slow_print(a); slow_print(n); slow_print(e);
+end;
+
+@ Another system-dependent routine is needed to convert three internal
+\TeX\ strings
+into the |name_of_file| value that is used to open files. The present code
+allows both lowercase and uppercase letters in the file name.
+@^system dependencies@>
+
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[n] to str_start[n+1]-1 do append_to_name(so(str_pool[j]));
+for j:=str_start[e] to str_start[e+1]-1 do append_to_name(so(str_pool[j]));
+if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+end;
+
+@ A messier routine is also needed, since format file names must be scanned
+before \TeX's string mechanism has been initialized. We shall use the
+global variable |TEX_format_default| to supply the text for default system areas
+and extensions related to format files.
+@^system dependencies@>
+
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+
+@<Glob...@>=
+@!TEX_format_default:packed array[1..format_default_length] of char;
+
+@ @<Set init...@>=
+TEX_format_default:='TeXformats:plain.fmt';
+@.TeXformats@>
+@.plain@>
+@^system dependencies@>
+
+@ @<Check the ``constant'' values for consistency@>=
+if format_default_length>file_name_size then bad:=31;
+
+@ Here is the messy routine that was just mentioned. It sets |name_of_file|
+from the first |n| characters of |TEX_format_default|, followed by
+|buffer[a..b]|, followed by the last |format_ext_length| characters of
+|TEX_format_default|.
+
+We dare not give error messages here, since \TeX\ calls this routine before
+the |error| routine is ready to roll. Instead, we simply drop excess characters,
+since the error will be detected in another way when a strange file name
+isn't found.
+@^system dependencies@>
+
+@p procedure pack_buffered_name(@!n:small_number;@!a,@!b:integer);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:integer; {index into |buffer| or |TEX_format_default|}
+begin if n+b-a+1+format_ext_length>file_name_size then
+ b:=a+file_name_size-n-1-format_ext_length;
+k:=0;
+for j:=1 to n do append_to_name(xord[TEX_format_default[j]]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=format_default_length-format_ext_length+1 to format_default_length do
+ append_to_name(xord[TEX_format_default[j]]);
+if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
+end;
+
+@ Here is the only place we use |pack_buffered_name|. This part of the program
+becomes active when a ``virgin'' \TeX\ is trying to get going, just after
+the preliminary initialization, or when the user is substituting another
+format file by typing `\.\&' after the initial `\.{**}' prompt. The buffer
+contains the first line of input in |buffer[loc..(last-1)]|, where
+|loc<last| and |buffer[loc]<>" "|.
+
+@<Declare the function called |open_fmt_file|@>=
+function open_fmt_file:boolean;
+label found,exit;
+var j:0..buf_size; {the first space after the format file name}
+begin j:=loc;
+if buffer[loc]="&" then
+ begin incr(loc); j:=loc; buffer[last]:=" ";
+ while buffer[j]<>" " do incr(j);
+ pack_buffered_name(0,loc,j-1); {try first without the system file area}
+ if w_open_in(fmt_file) then goto found;
+ pack_buffered_name(format_area_length,loc,j-1);
+ {now try the system format file area}
+ if w_open_in(fmt_file) then goto found;
+ wake_up_terminal;
+ wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
+@.Sorry, I can't find...@>
+ update_terminal;
+ end;
+ {now pull out all the stops: try for the system \.{plain} file}
+pack_buffered_name(format_default_length-format_ext_length,1,0);
+if not w_open_in(fmt_file) then
+ begin wake_up_terminal;
+ wterm_ln('I can''t find the PLAIN format file!');
+@.I can't find PLAIN...@>
+@.plain@>
+ open_fmt_file:=false; return;
+ end;
+found:loc:=j; open_fmt_file:=true;
+exit:end;
+
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine,
+which simply makes a \TeX\ string from the value of |name_of_file|, should
+ideally be changed to deduce the full name of file~|f|, which is the file
+most recently opened, if it is possible to do this in a \PASCAL\ program.
+@^system dependencies@>
+
+This routine might be called after string memory has overflowed, hence
+we dare not use `|str_room|'.
+
+@p function make_name_string:str_number;
+var k:1..file_name_size; {index into |name_of_file|}
+begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or
+ (cur_length>0) then
+ make_name_string:="?"
+else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+ make_name_string:=make_string;
+ end;
+end;
+function a_make_name_string(var f:alpha_file):str_number;
+begin a_make_name_string:=make_name_string;
+end;
+function b_make_name_string(var f:byte_file):str_number;
+begin b_make_name_string:=make_name_string;
+end;
+function w_make_name_string(var f:word_file):str_number;
+begin w_make_name_string:=make_name_string;
+end;
+
+@ Now let's consider the ``driver''
+routines by which \TeX\ deals with file names
+in a system-independent manner. First comes a procedure that looks for a
+file name in the input by calling |get_x_token| for the information.
+
+@p procedure scan_file_name;
+label done;
+begin name_in_progress:=true; begin_name;
+@<Get the next non-blank non-call...@>;
+loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character}
+ begin back_input; goto done;
+ end;
+ if not more_name(cur_chr) then goto done;
+ get_x_token;
+ end;
+done: end_name; name_in_progress:=false;
+end;
+
+@ The global variable |name_in_progress| is used to prevent recursive
+use of |scan_file_name|, since the |begin_name| and other procedures
+communicate via global variables. Recursion would arise only by
+devious tricks like `\.{\\input\\input f}'; such attempts at sabotage
+must be thwarted. Furthermore, |name_in_progress| prevents \.{\\input}
+@^recursion@>
+from being initiated when a font size specification is being scanned.
+
+Another global variable, |job_name|, contains the file name that was first
+\.{\\input} by the user. This name is extended by `\.{.log}' and `\.{.dvi}'
+and `\.{.fmt}' in the names of \TeX's output files.
+
+@<Glob...@>=
+@!name_in_progress:boolean; {is a file name being scanned?}
+@!job_name:str_number; {principal file name}
+@!log_opened:boolean; {has the transcript file been opened?}
+
+@ Initially |job_name=0|; it becomes nonzero as soon as the true name is known.
+We have |job_name=0| if and only if the `\.{log}' file has not been opened,
+except of course for a short time just after |job_name| has become nonzero.
+
+@<Initialize the output...@>=
+job_name:=0; name_in_progress:=false; log_opened:=false;
+
+@ Here is a routine that manufactures the output file names, assuming that
+|job_name<>0|. It ignores and changes the current settings of |cur_area|
+and |cur_ext|.
+
+@d pack_cur_name==pack_file_name(cur_name,cur_area,cur_ext)
+
+@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".dvi"|, or
+ |format_extension|}
+begin cur_area:=""; cur_ext:=s;
+cur_name:=job_name; pack_cur_name;
+end;
+
+@ If some trouble arises when \TeX\ tries to open a file, the following
+routine calls upon the user to supply another file name. Parameter~|s|
+is used in the error message to identify the type of file; parameter~|e|
+is the default extension if none is given. Upon exit from the routine,
+variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are
+ready for another attempt at file opening.
+
+@p procedure prompt_file_name(@!s,@!e:str_number);
+label done;
+var k:0..buf_size; {index into |buffer|}
+begin if interaction=scroll_mode then wake_up_terminal;
+if s="input file name" then print_err("I can't find file `")
+@.I can't find file x@>
+else print_err("I can't write on file `");
+@.I can't write on file x@>
+print_file_name(cur_name,cur_area,cur_ext); print("'.");
+if e=".tex" then show_context;
+print_nl("Please type another "); print(s);
+@.Please type...@>
+if interaction<scroll_mode then
+ fatal_error("*** (job aborted, file error in nonstop mode)");
+@.job aborted, file error...@>
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+pack_cur_name;
+end;
+
+@ @<Scan file name in the buffer@>=
+begin begin_name; k:=first;
+while (buffer[k]=" ")and(k<last) do incr(k);
+loop@+ begin if k=last then goto done;
+ if not more_name(buffer[k]) then goto done;
+ incr(k);
+ end;
+done:end_name;
+end
+
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d ensure_dvi_open==if output_file_name=0 then
+ begin if job_name=0 then open_log_file;
+ pack_job_name(".dvi");
+ while not b_open_out(dvi_file) do
+ prompt_file_name("file name for output",".dvi");
+ output_file_name:=b_make_name_string(dvi_file);
+ end
+
+@<Glob...@>=
+@!dvi_file: byte_file; {the device-independent output goes here}
+@!output_file_name: str_number; {full name of the output file}
+@!log_name:str_number; {full name of the log file}
+
+@ @<Initialize the output...@>=output_file_name:=0;
+
+@ The |open_log_file| routine is used to open the transcript file and to help
+it catch up to what has previously been printed on the terminal.
+
+@p procedure open_log_file;
+var old_setting:0..max_selector; {previous |selector| setting}
+@!k:0..buf_size; {index into |months| and |buffer|}
+@!l:0..buf_size; {end of first input line}
+@!months:packed array [1..36] of char; {abbreviations of month names}
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+@.texput@>
+pack_job_name(".log");
+while not a_open_out(log_file) do @<Try to get a different log file name@>;
+log_name:=a_make_name_string(log_file);
+selector:=log_only; log_opened:=true;
+@<Print the banner line, including the date and time@>;
+input_stack[input_ptr]:=cur_input; {make sure bottom level is in memory}
+print_nl("**");
+@.**@>
+l:=input_stack[0].limit_field; {last position of first line}
+if buffer[l]=end_line_char then decr(l);
+for k:=1 to l do print(buffer[k]);
+print_ln; {now the transcript file contains the first line of input}
+selector:=old_setting+2; {|log_only| or |term_and_log|}
+end;
+
+@ Sometimes |open_log_file| is called at awkward moments when \TeX\ is
+unable to print error messages or even to |show_context|.
+The |prompt_file_name| routine can result in a |fatal_error|, but the |error|
+routine will not be invoked because |log_opened| will be false.
+
+The normal idea of |batch_mode| is that nothing at all should be written
+on the terminal. However, in the unusual case that
+no log file could be opened, we make an exception and allow
+an explanatory message to be seen.
+
+Incidentally, the program always refers to the log file as a `\.{transcript
+file}', because some systems cannot use the extension `\.{.log}' for
+this file.
+
+@<Try to get a different log file name@>=
+begin selector:=term_only;
+prompt_file_name("transcript file name",".log");
+end
+
+@ @<Print the banner...@>=
+begin wlog(banner);
+slow_print(format_ident); print(" ");
+print_int(day); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+for k:=3*month-2 to 3*month do wlog(months[k]);
+print_char(" "); print_int(year); print_char(" ");
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+end
+
+@ Let's turn now to the procedure that is used to initiate file reading
+when an `\.{\\input}' command is being processed.
+
+@p procedure start_input; {\TeX\ will \.{\\input} something}
+label done;
+begin scan_file_name; {set |cur_name| to desired file name}
+if cur_ext="" then cur_ext:=".tex";
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,TEX_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+ end_file_reading; {remove the level that didn't work}
+ prompt_file_name("input file name",".tex");
+ end;
+done: name:=a_make_name_string(cur_file);
+if job_name=0 then
+ begin job_name:=cur_name; open_log_file;
+ end; {|open_log_file| doesn't |show_context|, so |limit|
+ and |loc| needn't be set to meaningful values yet}
+if term_offset+length(name)>max_print_line-2 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("("); incr(open_parens); slow_print(name); update_terminal;
+state:=new_line;
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string; name:=cur_name;
+ end;
+@<Read the first line of the new file@>;
+end;
+
+@ Here we have to remember to tell the |input_ln| routine not to
+start with a |get|. If the file is empty, it is considered to
+contain a single blank line.
+@^system dependencies@>
+@^empty line at end of file@>
+
+@<Read the first line...@>=
+begin line:=1;
+if input_ln(cur_file,false) then do_nothing;
+firm_up_the_line;
+if end_line_char_inactive then decr(limit)
+else buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start;
+end
+
+@* \[30] Font metric data.
+\TeX\ gets its knowledge about fonts from font metric files, also called
+\.{TFM} files; the `\.T' in `\.{TFM}' stands for \TeX,
+but other programs know about them too.
+@:TFM files}{\.{TFM} files@>
+@^font metric files@>
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of 4, we could
+also regard the file as a sequence of 32-bit words, but \TeX\ uses the
+byte interpretation. The format of \.{TFM} files was designed by
+Lyle Ramshaw in 1980. The intent is to convey a lot of different kinds
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+@<Glob...@>=
+@!tfm_file:byte_file;
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|lf|&length of the entire file, in words;\cr
+|lh|&length of the header data, in words;\cr
+|bc|&smallest character code in the font;\cr
+|ec|&largest character code in the font;\cr
+|nw|&number of words in the width table;\cr
+|nh|&number of words in the height table;\cr
+|nd|&number of words in the depth table;\cr
+|ni|&number of words in the italic correction table;\cr
+|nl|&number of words in the lig/kern table;\cr
+|nk|&number of words in the kern table;\cr
+|ne|&number of words in the extensible character table;\cr
+|np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
+header&|[0..lh-1]@t\\{stuff}@>|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but two of
+the |fix_word| values must lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+|header[0]| and |header[1]|, whose meaning is explained below.
+Additional header information of use to other software routines might
+also be included, but \TeX82 does not need to know about such details.
+For example, 16 more words of header information are in use at the Xerox
+Palo Alto Research Center; the first ten specify the character coding
+scheme used (e.g., `\.{XEROX text}' or `\.{TeX math symbols}'), the next five
+give the font identifier (e.g., `\.{HELVETICA}' or `\.{CMSY}'), and the
+last gives the ``face byte.'' The program that converts \.{DVI} files
+to Xerox printing format gets this information by looking at the \.{TFM}
+file, which it needs to read anyway because of other information that
+is not explicitly repeated in \.{DVI}~format.
+
+\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into
+the \.{DVI} output file. Later on when the \.{DVI} file is printed,
+possibly on another computer, the actual font that gets used is supposed
+to have a check sum that agrees with the one in the \.{TFM} file used by
+\TeX. In this way, users will be warned about potential incompatibilities.
+(However, if the check sum is zero in either the font file or the \.{TFM}
+file, no check is made.) The actual relation between this check sum and
+the rest of the \.{TFM} file is not important; the check sum is simply an
+identification number with the property that incompatible fonts almost
+always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of
+the font, in units of \TeX\ points. This number must be at least 1.0; it is
+fairly arbitrary, but usually the design size is 10.0 for a ``10 point''
+font, i.e., a font that was designed to look best at a 10-point size,
+whatever that really means. When a \TeX\ user asks for a font
+`\.{at} $\delta$ \.{pt}', the effect is to override the design size
+and replace it by $\delta$, and to multiply the $x$ and~$y$ coordinates
+of the points in the font image by a factor of $\delta$ divided by the
+design size. {\sl All other dimensions in the\/ \.{TFM} file are
+|fix_word|\kern-1pt\ numbers in design-size units}, with the exception of
+|param[1]| (which denotes the slant ratio). Thus, for example, the value
+of |param[6]|, which defines the \.{em} unit, is often the |fix_word| value
+$2^{20}=1.0$, since many fonts have a design size equal to one em.
+The other dimensions must be less than 16 design-size units in absolute
+value; thus, |header[1]| and |param[1]| are the only |fix_word|
+entries in the whole \.{TFM} file whose first byte might be something
+besides 0 or 255.
+
+@ Next comes the |char_info| array, which contains one |@!char_info_word|
+per character. Each word in this part of the file contains six fields
+packed into four bytes as follows.
+
+\yskip\hang first byte: |@!width_index| (8 bits)\par
+\hang second byte: |@!height_index| (4 bits) times 16, plus |@!depth_index|
+ (4~bits)\par
+\hang third byte: |@!italic_index| (6 bits) times 4, plus |@!tag|
+ (2~bits)\par
+\hang fourth byte: |@!remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is \\{width}|[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+@!@^italic correction@>
+The italic correction of a character has two different uses.
+(a)~In ordinary text, the italic correction is added to the width only if
+the \TeX\ user specifies `\.{\\/}' after the character.
+(b)~In math formulas, the italic correction is always added to the width,
+except with respect to the positioning of subscripts.
+
+Incidentally, the relation $\\{width}[0]=\\{height}[0]=\\{depth}[0]=
+\\{italic}[0]=0$ should always hold, so that an index of zero implies a
+value of zero. The |width_index| should never be zero unless the
+character does not exist in the font, since a character is valid if and
+only if it lies between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hangg|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hangg|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at position |remainder| in the |lig_kern| array.\par
+\hangg|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain. The
+|remainder| field gives the character code of the next larger character.\par
+\hangg|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|@!exten[remainder]|.\par
+\yskip\noindent
+Characters with |tag=2| and |tag=3| are treated as characters with |tag=0|
+unless they are used in special circumstances in math formulas. For example,
+the \.{\\sum} operation looks for a |list_tag|, and the \.{\\left}
+operation looks for both |list_tag| and |ext_tag|.
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word in this array is a
+|@!lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+ step if the byte is 128 or more, otherwise the next step is obtained by
+ skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+ then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+ a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must satisfy
+the condition
+$$\hbox{|256*op_byte+remainder<nl|.}$$
+If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+or kerning command is performed.
+
+@d stop_flag==qi(128) {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag==qi(128) {op code for a kern step}
+@d skip_byte(#)==#.b0
+@d next_char(#)==#.b1
+@d op_byte(#)==#.b2
+@d rem_byte(#)==#.b3
+
+@ Extensible characters are specified by an |@!extensible_recipe|, which
+consists of four bytes called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this
+order). These bytes are the character codes of individual pieces used to
+build up a large symbol. If |top|, |mid|, or |bot| are zero, they are not
+present in the built-up result. For example, an extensible vertical line is
+like an extensible bracket, except that the top and bottom pieces are missing.
+
+Let $T$, $M$, $B$, and $R$ denote the respective pieces, or an empty box
+if the piece isn't present. Then the extensible characters have the form
+$TR^kMR^kB$ from top to bottom, for some |k>=0|, unless $M$ is absent;
+in the latter case we can have $TR^kB$ for both even and odd values of~|k|.
+The width of the extensible character is the width of $R$; and the
+height-plus-depth is the sum of the individual height-plus-depths of the
+components used, since the pieces are butted together in a vertical list.
+
+@d ext_top(#)==#.b0 {|top| piece in a recipe}
+@d ext_mid(#)==#.b1 {|mid| piece in a recipe}
+@d ext_bot(#)==#.b2 {|bot| piece in a recipe}
+@d ext_rep(#)==#.b3 {|rep| piece in a recipe}
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it's the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character |" "| in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the size of one ex in the font; it is also
+the height of letters for which accents don't have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+\yskip\noindent
+If fewer than seven parameters are present, \TeX\ sets the missing parameters
+to zero. Fonts used for math symbols are required to have
+additional parameter information, which is explained later.
+
+@d slant_code=1
+@d space_code=2
+@d space_stretch_code=3
+@d space_shrink_code=4
+@d x_height_code=5
+@d quad_code=6
+@d extra_space_code=7
+
+@ So that is what \.{TFM} files hold. Since \TeX\ has to absorb such information
+about lots of fonts, it stores most of the data in a large array called
+|font_info|. Each item of |font_info| is a |memory_word|; the |fix_word|
+data gets converted into |scaled| entries, while everything else goes into
+words of type |four_quarters|.
+
+When the user defines \.{\\font\\f}, say, \TeX\ assigns an internal number
+to the user's font~\.{\\f}. Adding this number to |font_id_base| gives the
+|eqtb| location of a ``frozen'' control sequence that will always select
+the font.
+
+@<Types...@>=
+@!internal_font_number=font_base..font_max; {|font| in a |char_node|}
+@!font_index=0..font_mem_size; {index into |font_info|}
+
+@ Here now is the (rather formidable) array of font arrays.
+
+@d non_char==qi(256) {a |halfword| code that can't match a real character}
+@d non_address=0 {a spurious |bchar_label|}
+
+@<Glob...@>=
+@!font_info:array[font_index] of memory_word;
+ {the big collection of font data}
+@!fmem_ptr:font_index; {first unused word of |font_info|}
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_check:array[internal_font_number] of four_quarters; {check sum}
+@!font_size:array[internal_font_number] of scaled; {``at'' size}
+@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
+@!font_params:array[internal_font_number] of font_index; {how many font
+ parameters are present}
+@!font_name:array[internal_font_number] of str_number; {name of the font}
+@!font_area:array[internal_font_number] of str_number; {area of the font}
+@!font_bc:array[internal_font_number] of eight_bits;
+ {beginning (smallest) character code}
+@!font_ec:array[internal_font_number] of eight_bits;
+ {ending (largest) character code}
+@!font_glue:array[internal_font_number] of pointer;
+ {glue specification for interword space, |null| if not allocated}
+@!font_used:array[internal_font_number] of boolean;
+ {has a character from this font actually appeared in the output?}
+@!hyphen_char:array[internal_font_number] of integer;
+ {current \.{\\hyphenchar} values}
+@!skew_char:array[internal_font_number] of integer;
+ {current \.{\\skewchar} values}
+@!bchar_label:array[internal_font_number] of font_index;
+ {start of |lig_kern| program for left boundary character,
+ |non_address| if there is none}
+@!font_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {right boundary character, |non_char| if there is none}
+@!font_false_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
+
+@ Besides the arrays just enumerated, we have directory arrays that make it
+easy to get at the individual entries in |font_info|. For example, the
+|char_info| data for character |c| in font |f| will be in
+|font_info[char_base[f]+c].qqqq|; and if |w| is the |width_index|
+part of this word (the |b0| field), the width of the character is
+|font_info[width_base[f]+w].sc|. (These formulas assume that
+|min_quarterword| has already been added to |c| and to |w|, since \TeX\
+stores its quarterwords that way.)
+
+@<Glob...@>=
+@!char_base:array[internal_font_number] of integer;
+ {base addresses for |char_info|}
+@!width_base:array[internal_font_number] of integer;
+ {base addresses for widths}
+@!height_base:array[internal_font_number] of integer;
+ {base addresses for heights}
+@!depth_base:array[internal_font_number] of integer;
+ {base addresses for depths}
+@!italic_base:array[internal_font_number] of integer;
+ {base addresses for italic corrections}
+@!lig_kern_base:array[internal_font_number] of integer;
+ {base addresses for ligature/kerning programs}
+@!kern_base:array[internal_font_number] of integer;
+ {base addresses for kerns}
+@!exten_base:array[internal_font_number] of integer;
+ {base addresses for extensible recipes}
+@!param_base:array[internal_font_number] of integer;
+ {base addresses for font parameters}
+
+@ @<Set init...@>=
+for k:=font_base to font_max do font_used[k]:=false;
+
+@ \TeX\ always knows at least one font, namely the null font. It has no
+characters, and its seven parameters are all equal to zero.
+
+@<Initialize table...@>=
+font_ptr:=null_font; fmem_ptr:=7;
+font_name[null_font]:="nullfont"; font_area[null_font]:="";
+hyphen_char[null_font]:="-"; skew_char[null_font]:=-1;
+bchar_label[null_font]:=non_address;
+font_bchar[null_font]:=non_char; font_false_bchar[null_font]:=non_char;
+font_bc[null_font]:=1; font_ec[null_font]:=0;
+font_size[null_font]:=0; font_dsize[null_font]:=0;
+char_base[null_font]:=0; width_base[null_font]:=0;
+height_base[null_font]:=0; depth_base[null_font]:=0;
+italic_base[null_font]:=0; lig_kern_base[null_font]:=0;
+kern_base[null_font]:=0; exten_base[null_font]:=0;
+font_glue[null_font]:=null; font_params[null_font]:=7;
+param_base[null_font]:=-1;
+for k:=0 to 6 do font_info[k].sc:=0;
+
+@ @<Put each...@>=
+primitive("nullfont",set_font,null_font);
+@!@:null_font_}{\.{\\nullfont} primitive@>
+text(frozen_null_font):="nullfont"; eqtb[frozen_null_font]:=eqtb[cur_val];
+
+@ Of course we want to define macros that suppress the detail of how font
+information is actually packed, so that we don't have to write things like
+$$\hbox{|font_info[width_base[f]+font_info[char_base[f]+c].qqqq.b0].sc|}$$
+too often. The \.{WEB} definitions here make |char_info(f)(c)| the
+|four_quarters| word of font information corresponding to character
+|c| of font |f|. If |q| is such a word, |char_width(f)(q)| will be
+the character's width; hence the long formula above is at least
+abbreviated to
+$$\hbox{|char_width(f)(char_info(f)(c))|.}$$
+Usually, of course, we will fetch |q| first and look at several of its
+fields at the same time.
+
+The italic correction of a character will be denoted by
+|char_italic(f)(q)|, so it is analogous to |char_width|. But we will get
+at the height and depth in a slightly different way, since we usually want
+to compute both height and depth if we want either one. The value of
+|height_depth(q)| will be the 8-bit quantity
+$$b=|height_index|\times16+|depth_index|,$$ and if |b| is such a byte we
+will write |char_height(f)(b)| and |char_depth(f)(b)| for the height and
+depth of the character |c| for which |q=char_info(f)(c)|. Got that?
+
+The tag field will be called |char_tag(q)|; the remainder byte will be
+called |rem_byte(q)|, using a macro that we have already defined above.
+
+Access to a character's |width|, |height|, |depth|, and |tag| fields is
+part of \TeX's inner loop, so we want these macros to produce code that is
+as fast as possible under the circumstances.
+@^inner loop@>
+
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_info[char_base[#]+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_info[width_base[#]+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 4].sc
+@d char_italic(#)==font_info[italic_base[#]+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 16].sc
+@d char_height(#)==font_info[height_base[#]+char_height_end
+@d char_depth_end(#)==(#) mod 16].sc
+@d char_depth(#)==font_info[depth_base[#]+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+
+@ The global variable |null_character| is set up to be a word of
+|char_info| for a character that doesn't exist. Such a word provides a
+convenient way to deal with erroneous situations.
+
+@<Glob...@>=
+@!null_character:four_quarters; {nonexistent character information}
+
+@ @<Set init...@>=
+null_character.b0:=min_quarterword; null_character.b1:=min_quarterword;
+null_character.b2:=min_quarterword; null_character.b3:=min_quarterword;
+
+@ Here are some macros that help process ligatures and kerns.
+We write |char_kern(f)(j)| to find the amount of kerning specified by
+kerning command~|j| in font~|f|. If |j| is the |char_info| for a character
+with a ligature/kern program, the first instruction of that program is either
+|i=font_info[lig_kern_start(f)(j)]| or |font_info[lig_kern_restart(f)(i)]|,
+depending on whether or not |skip_byte(i)<=stop_flag|.
+
+The constant |kern_base_offset| should be simplified, for \PASCAL\ compilers
+that do not do local optimization.
+@^system dependencies@>
+
+@d char_kern_end(#)==256*op_byte(#)+rem_byte(#)].sc
+@d char_kern(#)==font_info[kern_base[#]+char_kern_end
+@d kern_base_offset==256*(128+min_quarterword)
+@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program}
+@d lig_kern_restart_end(#)==256*op_byte(#)+rem_byte(#)+32768-kern_base_offset
+@d lig_kern_restart(#)==lig_kern_base[#]+lig_kern_restart_end
+
+@ Font parameters are referred to as |slant(f)|, |space(f)|, etc.
+
+@d param_end(#)==param_base[#]].sc
+@d param(#)==font_info[#+param_end
+@d slant==param(slant_code) {slant to the right, per unit distance upward}
+@d space==param(space_code) {normal space between words}
+@d space_stretch==param(space_stretch_code) {stretch between words}
+@d space_shrink==param(space_shrink_code) {shrink between words}
+@d x_height==param(x_height_code) {one ex}
+@d quad==param(quad_code) {one em}
+@d extra_space==param(extra_space_code) {additional space at end of sentence}
+
+@<The em width for |cur_font|@>=quad(cur_font)
+
+@ @<The x-height for |cur_font|@>=x_height(cur_font)
+
+@ \TeX\ checks the information of a \.{TFM} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. The somewhat tedious subroutine that does this
+is called |read_font_info|. It has four parameters: the user font
+identifier~|u|, the file name and area strings |nom| and |aire|, and the
+``at'' size~|s|. If |s|~is negative, it's the negative of a scale factor
+to be applied to the design size; |s=-1000| is the normal case.
+Otherwise |s| will be substituted for the design size; in this
+case, |s| must be positive and less than $2048\rm\,pt$
+(i.e., it must be less than $2^{27}$ when considered as an integer).
+
+The subroutine opens and closes a global file variable called |tfm_file|.
+It returns the value of the internal font number that was just loaded.
+If an error is detected, an error message is issued and no font
+information is stored; |null_font| is returned in this case.
+
+@d bad_tfm=11 {label for |read_font_info|}
+@d abort==goto bad_tfm {do this when the \.{TFM} data is wrong}
+
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled):internal_font_number; {input a \.{TFM} file}
+label done,bad_tfm,not_found;
+var k:font_index; {index into |font_info|}
+@!file_opened:boolean; {was |tfm_file| successfully opened?}
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np:halfword;
+ {sizes of subfiles}
+@!f:internal_font_number; {the new font's number}
+@!g:internal_font_number; {the number to return}
+@!a,@!b,@!c,@!d:eight_bits; {byte variables}
+@!qw:four_quarters;@!sw:scaled; {accumulators}
+@!bch_label:integer; {left boundary start location, or infinity}
+@!bchar:0..256; {right boundary character, or 256}
+@!z:scaled; {the design size or the ``at'' size}
+@!alpha:integer;@!beta:1..16;
+ {auxiliary quantities used in fixed-point multiplication}
+begin g:=null_font;@/
+@<Read and check the font data; |abort| if the \.{TFM} file is
+ malformed; if there's no room for this font, say so and |goto
+ done|; otherwise |incr(font_ptr)| and |goto done|@>;
+bad_tfm: @<Report that the font won't be loaded@>;
+done: if file_opened then b_close(tfm_file);
+read_font_info:=g;
+end;
+
+@ There are programs called \.{TFtoPL} and \.{PLtoTF} that convert
+between the \.{TFM} format and a symbolic property-list format
+that can be easily edited. These programs contain extensive
+diagnostic information, so \TeX\ does not have to bother giving
+precise details about why it rejects a particular \.{TFM} file.
+@.TFtoPL@> @.PLtoTF@>
+
+@d start_font_error_message==print_err("Font "); sprint_cs(u);
+ print_char("="); print_file_name(nom,aire,"");
+ if s>=0 then
+ begin print(" at "); print_scaled(s); print("pt");
+ end
+ else if s<>-1000 then
+ begin print(" scaled "); print_int(-s);
+ end
+
+@<Report that the font won't be loaded@>=
+start_font_error_message;
+@.Font x=xx not loadable...@>
+if file_opened then print(" not loadable: Bad metric (TFM) file")
+else print(" not loadable: Metric (TFM) file not found");
+help5("I wasn't able to read the size data for this font,")@/
+("so I will ignore the font specification.")@/
+("[Wizards can fix TFM files using TFtoPL/PLtoTF.]")@/
+("You might try inserting a different font spec;")@/
+("e.g., type `I\font<same font id>=<substitute font name>'.");
+error
+
+@ @<Read and check...@>=
+@<Open |tfm_file| for input@>;
+@<Read the {\.{TFM}} size fields@>;
+@<Use size fields to allocate font information@>;
+@<Read the {\.{TFM}} header@>;
+@<Read character data@>;
+@<Read box dimensions@>;
+@<Read ligature/kern program@>;
+@<Read extensible character recipes@>;
+@<Read font parameters@>;
+@<Make final adjustments and |goto done|@>
+
+@ @<Open |tfm_file| for input@>=
+file_opened:=false;
+if aire="" then pack_file_name(nom,TEX_font_area,".tfm")
+else pack_file_name(nom,aire,".tfm");
+if not b_open_in(tfm_file) then abort;
+file_opened:=true
+
+@ Note: A malformed \.{TFM} file might be shorter than it claims to be;
+thus |eof(tfm_file)| might be true when |read_font_info| refers to
+|tfm_file^| or when it says |get(tfm_file)|. If such circumstances
+cause system error messages, you will have to defeat them somehow,
+for example by defining |fget| to be `\ignorespaces|begin get(tfm_file);|
+|if eof(tfm_file) then abort; end|\unskip'.
+@^system dependencies@>
+
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@d read_sixteen(#)==begin #:=fbyte;
+ if #>127 then abort;
+ fget; #:=#*@'400+fbyte;
+ end
+@d store_four_quarters(#)==begin fget; a:=fbyte; qw.b0:=qi(a);
+ fget; b:=fbyte; qw.b1:=qi(b);
+ fget; c:=fbyte; qw.b2:=qi(c);
+ fget; d:=fbyte; qw.b3:=qi(d);
+ #:=qw;
+ end
+
+@ @<Read the {\.{TFM}} size fields@>=
+begin read_sixteen(lf);
+fget; read_sixteen(lh);
+fget; read_sixteen(bc);
+fget; read_sixteen(ec);
+if (bc>ec+1)or(ec>255) then abort;
+if bc>255 then {|bc=256| and |ec=255|}
+ begin bc:=1; ec:=0;
+ end;
+fget; read_sixteen(nw);
+fget; read_sixteen(nh);
+fget; read_sixteen(nd);
+fget; read_sixteen(ni);
+fget; read_sixteen(nl);
+fget; read_sixteen(nk);
+fget; read_sixteen(ne);
+fget; read_sixteen(np);
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort;
+end
+
+@ The preliminary settings of the index-offset variables |char_base|,
+|width_base|, |lig_kern_base|, |kern_base|, and |exten_base| will be
+corrected later by subtracting |min_quarterword| from them; and we will
+subtract 1 from |param_base| too. It's best to forget about such anomalies
+until later.
+
+@<Use size fields to allocate font information@>=
+lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
+if np<7 then lf:=lf+7-np; {at least seven parameters will appear}
+if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then
+ @<Apologize for not loading the font, |goto done|@>;
+f:=font_ptr+1;
+char_base[f]:=fmem_ptr-bc;
+width_base[f]:=char_base[f]+ec+1;
+height_base[f]:=width_base[f]+nw;
+depth_base[f]:=height_base[f]+nh;
+italic_base[f]:=depth_base[f]+nd;
+lig_kern_base[f]:=italic_base[f]+ni;
+kern_base[f]:=lig_kern_base[f]+nl-kern_base_offset;
+exten_base[f]:=kern_base[f]+kern_base_offset+nk;
+param_base[f]:=exten_base[f]+ne
+
+@ @<Apologize for not loading...@>=
+begin start_font_error_message;
+print(" not loaded: Not enough room left");
+@.Font x=xx not loaded...@>
+help4("I'm afraid I won't be able to make use of this font,")@/
+("because my memory for character-size data is too small.")@/
+("If you're really stuck, ask a wizard to enlarge me.")@/
+("Or maybe try `I\font<same font id>=<name of loaded font>'.");
+error; goto done;
+end
+
+@ Only the first two words of the header are needed by \TeX82.
+
+@<Read the {\.{TFM}} header@>=
+begin if lh<2 then abort;
+store_four_quarters(font_check[f]);
+fget; read_sixteen(z); {this rejects a negative design size}
+fget; z:=z*@'400+fbyte; fget; z:=(z*@'20)+(fbyte div@'20);
+if z<unity then abort;
+while lh>2 do
+ begin fget;fget;fget;fget;decr(lh); {ignore the rest of the header}
+ end;
+font_dsize[f]:=z;
+if s<>-1000 then
+ if s>=0 then z:=s
+ else z:=xn_over_d(z,-s,1000);
+font_size[f]:=z;
+end
+
+@ @<Read character data@>=
+for k:=fmem_ptr to width_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if (a>=nw)or(b div @'20>=nh)or(b mod @'20>=nd)or
+ (c div 4>=ni) then abort;
+ case c mod 4 of
+ lig_tag: if d>=nl then abort;
+ ext_tag: if d>=ne then abort;
+ list_tag: @<Check for charlist cycle@>;
+ othercases do_nothing {|no_tag|}
+ endcases;
+ end
+
+@ We want to make sure that there is no cycle of characters linked together
+by |list_tag| entries, since such a cycle would get \TeX\ into an endless
+loop. If such a cycle exists, the routine here detects it when processing
+the largest character code in the cycle.
+
+@d check_byte_range(#)==begin if (#<bc)or(#>ec) then abort@+end
+@d current_character_being_worked_on==k+bc-fmem_ptr
+
+@<Check for charlist cycle@>=
+begin check_byte_range(d);
+while d<current_character_being_worked_on do
+ begin qw:=char_info(f)(d);
+ {N.B.: not |qi(d)|, since |char_base[f]| hasn't been adjusted yet}
+ if char_tag(qw)<>list_tag then goto not_found;
+ d:=qo(rem_byte(qw)); {next character on the list}
+ end;
+if d=current_character_being_worked_on then abort; {yes, there's a cycle}
+not_found:end
+
+@ A |fix_word| whose four bytes are $(a,b,c,d)$ from left to right represents
+the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+(No other choices of |a| are allowed, since the magnitude of a number in
+design-size units must be less than 16.) We want to multiply this
+quantity by the integer~|z|, which is known to be less than $2^{27}$.
+If $|z|<2^{23}$, the individual multiplications $b\cdot z$,
+$c\cdot z$, $d\cdot z$ cannot overflow; otherwise we will divide |z| by 2,
+4, 8, or 16, to obtain a multiplier less than $2^{23}$, and we can
+compensate for this later. If |z| has thereby been replaced by
+$|z|^\prime=|z|/2^e$, let $\beta=2^{4-e}$; we shall compute
+$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$
+if $a=0$, or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
+This calculation must be done exactly, in order to guarantee portability
+of \TeX\ between computers.
+
+@d store_scaled(#)==begin fget; a:=fbyte; fget; b:=fbyte;
+ fget; c:=fbyte; fget; d:=fbyte;@/
+ sw:=(((((d*z)div@'400)+(c*z))div@'400)+(b*z))div beta;
+ if a=0 then #:=sw@+else if a=255 then #:=sw-alpha@+else abort;
+ end
+
+@<Read box dimensions@>=
+begin @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>;
+for k:=width_base[f] to lig_kern_base[f]-1 do
+ store_scaled(font_info[k].sc);
+if font_info[width_base[f]].sc<>0 then abort; {\\{width}[0] must be zero}
+if font_info[height_base[f]].sc<>0 then abort; {\\{height}[0] must be zero}
+if font_info[depth_base[f]].sc<>0 then abort; {\\{depth}[0] must be zero}
+if font_info[italic_base[f]].sc<>0 then abort; {\\{italic}[0] must be zero}
+end
+
+@ @<Replace |z|...@>=
+begin alpha:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; alpha:=alpha+alpha;
+ end;
+beta:=256 div alpha; alpha:=alpha*z;
+end
+
+@ @d check_existence(#)==@t@>@;@/
+ begin check_byte_range(#);
+ qw:=char_info(f)(#); {N.B.: not |qi(#)|}
+ if not char_exists(qw) then abort;
+ end
+
+@<Read ligature/kern program@>=
+bch_label:=@'77777; bchar:=256;
+if nl>0 then
+ begin for k:=lig_kern_base[f] to kern_base[f]+kern_base_offset-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if a>128 then
+ begin if 256*c+d>=nl then abort;
+ if a=255 then if k=lig_kern_base[f] then bchar:=b;
+ end
+ else begin if b<>bchar then check_existence(b);
+ if c<128 then check_existence(d) {check ligature}
+ else if 256*(c-128)+d>=nk then abort; {check kern}
+ if a<128 then if k-lig_kern_base[f]+a+1>=nl then abort;
+ end;
+ end;
+ if a=255 then bch_label:=256*c+d;
+ end;
+for k:=kern_base[f]+kern_base_offset to exten_base[f]-1 do
+ store_scaled(font_info[k].sc);
+
+@ @<Read extensible character recipes@>=
+for k:=exten_base[f] to param_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if a<>0 then check_existence(a);
+ if b<>0 then check_existence(b);
+ if c<>0 then check_existence(c);
+ check_existence(d);
+ end
+
+@ We check to see that the \.{TFM} file doesn't end prematurely; but
+no error message is given for files having more than |lf| words.
+
+@<Read font parameters@>=
+begin for k:=1 to np do
+ if k=1 then {the |slant| parameter is a pure number}
+ begin fget; sw:=fbyte; if sw>127 then sw:=sw-256;
+ fget; sw:=sw*@'400+fbyte; fget; sw:=sw*@'400+fbyte;
+ fget; font_info[param_base[f]].sc:=
+ (sw*@'20)+(fbyte div@'20);
+ end
+ else store_scaled(font_info[param_base[f]+k-1].sc);
+if eof(tfm_file) then abort;
+for k:=np+1 to 7 do font_info[param_base[f]+k-1].sc:=0;
+end
+
+@ Now to wrap it up, we have checked all the necessary things about the \.{TFM}
+file, and all we need to do is put the finishing touches on the data for
+the new font.
+
+@d adjust(#)==#[f]:=qo(#[f])
+ {correct for the excess |min_quarterword| that was added}
+
+@<Make final adjustments...@>=
+if np>=7 then font_params[f]:=np@+else font_params[f]:=7;
+hyphen_char[f]:=default_hyphen_char; skew_char[f]:=default_skew_char;
+if bch_label<nl then bchar_label[f]:=bch_label+lig_kern_base[f]
+else bchar_label[f]:=non_address;
+font_bchar[f]:=qi(bchar);
+font_false_bchar[f]:=qi(bchar);
+if bchar<=ec then if bchar>=bc then
+ begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+ if char_exists(qw) then font_false_bchar[f]:=non_char;
+ end;
+font_name[f]:=nom;
+font_area[f]:=aire;
+font_bc[f]:=bc; font_ec[f]:=ec; font_glue[f]:=null;
+adjust(char_base); adjust(width_base); adjust(lig_kern_base);
+adjust(kern_base); adjust(exten_base);
+decr(param_base[f]);
+fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; goto done
+
+@ Before we forget about the format of these tables, let's deal with two
+of \TeX's basic scanning routines related to font information.
+
+@<Declare procedures that scan font-related stuff@>=
+procedure scan_font_ident;
+var f:internal_font_number;
+@!m:halfword;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=def_font then f:=cur_font
+else if cur_cmd=set_font then f:=cur_chr
+else if cur_cmd=def_family then
+ begin m:=cur_chr; scan_four_bit_int; f:=equiv(m+cur_val);
+ end
+else begin print_err("Missing font identifier");
+@.Missing font identifier@>
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \font.");
+ back_error; f:=null_font;
+ end;
+cur_val:=f;
+end;
+
+@ The following routine is used to implement `\.{\\fontdimen} |n| |f|'.
+The boolean parameter |writing| is set |true| if the calling program
+intends to change the parameter value.
+
+@<Declare procedures that scan font-related stuff@>=
+procedure find_font_dimen(@!writing:boolean);
+ {sets |cur_val| to |font_info| location}
+var f:internal_font_number;
+@!n:integer; {the parameter number}
+begin scan_int; n:=cur_val; scan_font_ident; f:=cur_val;
+if n<=0 then cur_val:=fmem_ptr
+else begin if writing and(n<=space_shrink_code)and@|
+ (n>=space_code)and(font_glue[f]<>null) then
+ begin delete_glue_ref(font_glue[f]);
+ font_glue[f]:=null;
+ end;
+ if n>font_params[f] then
+ if f<font_ptr then cur_val:=fmem_ptr
+ else @<Increase the number of parameters in the last font@>
+ else cur_val:=n+param_base[f];
+ end;
+@<Issue an error message if |cur_val=fmem_ptr|@>;
+end;
+
+@ @<Issue an error message if |cur_val=fmem_ptr|@>=
+if cur_val=fmem_ptr then
+ begin print_err("Font "); print_esc(font_id_text(f));
+ print(" has only "); print_int(font_params[f]);
+ print(" fontdimen parameters");
+@.Font x has only...@>
+ help2("To increase the number of font parameters, you must")@/
+ ("use \fontdimen immediately after the \font is loaded.");
+ error;
+ end
+
+@ @<Increase the number of parameters...@>=
+begin repeat if fmem_ptr=font_mem_size then
+ overflow("font memory",font_mem_size);
+@:TeX capacity exceeded font memory}{\quad font memory@>
+font_info[fmem_ptr].sc:=0; incr(fmem_ptr); incr(font_params[f]);
+until n=font_params[f];
+cur_val:=fmem_ptr-1; {this equals |param_base[f]+font_params[f]|}
+end
+
+@ When \TeX\ wants to typeset a character that doesn't exist, the
+character node is not created; thus the output routine can assume
+that characters exist when it sees them. The following procedure
+prints a warning message unless the user has suppressed it.
+
+@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits);
+begin if tracing_lost_chars>0 then
+ begin begin_diagnostic;
+ print_nl("Missing character: There is no ");
+@.Missing character@>
+ print_ASCII(c); print(" in font ");
+ slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
+ end;
+end;
+
+@ Here is a function that returns a pointer to a character node for a
+given character in a given font. If that character doesn't exist,
+|null| is returned instead.
+
+@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
+label exit;
+var p:pointer; {newly allocated node}
+begin if font_bc[f]<=c then if font_ec[f]>=c then
+ if char_exists(char_info(f)(qi(c))) then
+ begin p:=get_avail; font(p):=f; character(p):=qi(c);
+ new_character:=p; return;
+ end;
+char_warning(f,c);
+new_character:=null;
+exit:end;
+
+@* \[31] Device-independent file format.
+The most important output produced by a run of \TeX\ is the ``device
+independent'' (\.{DVI}) file that specifies where characters and rules
+are to appear on printed pages. The form of these files was designed by
+David R. Fuchs in 1979. Almost any reasonable typesetting device can be
+@^Fuchs, David Raymond@>
+@:DVI_files}{\.{DVI} files@>
+driven by a program that takes \.{DVI} files as input, and dozens of such
+\.{DVI}-to-whatever programs have been written. Thus, it is possible to
+print the output of \TeX\ on many different kinds of equipment, using \TeX\
+as a device-independent ``front end.''
+
+A \.{DVI} file is a stream of 8-bit bytes, which may be regarded as a
+series of commands in a machine-like language. The first byte of each command
+is the operation code, and this code is followed by zero or more bytes
+that provide parameters to the command. The parameters themselves may consist
+of several consecutive bytes; for example, the `|set_rule|' command has two
+parameters, each of which is four bytes long. Parameters are usually
+regarded as nonnegative integers; but four-byte-long parameters,
+and shorter parameters that denote distances, can be
+either positive or negative. Such parameters are given in two's complement
+notation. For example, a two-byte-long distance parameter has a value between
+$-2^{15}$ and $2^{15}-1$. As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order.
+
+A \.{DVI} file consists of a ``preamble,'' followed by a sequence of one
+or more ``pages,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that define the dimensions used in the
+file; this must come first. Each ``page'' consists of a |bop| command,
+followed by any number of other commands that tell where characters are to
+be placed on a physical page, followed by an |eop| command. The pages
+appear in the order that \TeX\ generated them. If we ignore |nop| commands
+and \\{fnt\_def} commands (which are allowed between any two commands in
+the file), each |eop| command is immediately followed by a |bop| command,
+or by a |post| command; in the latter case, there are no more pages in the
+file, and the remaining bytes form the postamble. Further details about
+the postamble will be explained later.
+
+Some parameters in \.{DVI} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first byte is number~0, then comes number~1, and so on. For example,
+one of the parameters of a |bop| command points to the previous |bop|;
+this makes it feasible to read the pages in backwards order, in case the
+results are being directed to a device that stacks its output face up.
+Suppose the preamble of a \.{DVI} file occupies bytes 0 to 99. Now if the
+first page occupies bytes 100 to 999, say, and if the second
+page occupies bytes 1000 to 1999, then the |bop| that starts in byte 1000
+points to 100 and the |bop| that starts in byte 2000 points to 1000. (The
+very first |bop|, i.e., the one starting in byte 100, has a pointer of~$-1$.)
+
+@ The \.{DVI} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+implicit instead of explicit. When a \.{DVI}-reading program reads the
+commands for a page, it keeps track of several quantities: (a)~The current
+font |f| is an integer; this value is changed only
+by \\{fnt} and \\{fnt\_num} commands. (b)~The current position on the page
+is given by two numbers called the horizontal and vertical coordinates,
+|h| and |v|. Both coordinates are zero at the upper left corner of the page;
+moving to the right corresponds to increasing the horizontal coordinate, and
+moving down corresponds to increasing the vertical coordinate. Thus, the
+coordinates are essentially Cartesian, except that vertical directions are
+flipped; the Cartesian version of |(h,v)| would be |(h,-v)|. (c)~The
+current spacing amounts are given by four numbers |w|, |x|, |y|, and |z|,
+where |w| and~|x| are used for horizontal spacing and where |y| and~|z|
+are used for vertical spacing. (d)~There is a stack containing
+|(h,v,w,x,y,z)| values; the \.{DVI} commands |push| and |pop| are used to
+change the current level of operation. Note that the current font~|f| is
+not pushed and popped; the stack contains only information about
+positioning.
+
+The values of |h|, |v|, |w|, |x|, |y|, and |z| are signed integers having up
+to 32 bits, including the sign. Since they represent physical distances,
+there is a small unit of measurement such that increasing |h| by~1 means
+moving a certain tiny distance to the right. The actual unit of
+measurement is variable, as explained below; \TeX\ sets things up so that
+its \.{DVI} output is in sp units, i.e., scaled points, in agreement with
+all the |scaled| dimensions in \TeX's data structures.
+
+@ Here is a list of all the commands that may appear in a \.{DVI} file. Each
+command is specified by its symbolic name (e.g., |bop|), its opcode byte
+(e.g., 139), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|p[4]|' means that parameter |p| is four bytes long.
+
+\yskip\hang|set_char_0| 0. Typeset character number~0 from font~|f|
+such that the reference point of the character is at |(h,v)|. Then
+increase |h| by the width of that character. Note that a character may
+have zero or negative width, so one cannot be sure that |h| will advance
+after this command; but |h| usually does increase.
+
+\yskip\hang\\{set\_char\_1} through \\{set\_char\_127} (opcodes 1 to 127).
+Do the operations of |set_char_0|; but use the character whose number
+matches the opcode, instead of character~0.
+
+\yskip\hang|set1| 128 |c[1]|. Same as |set_char_0|, except that character
+number~|c| is typeset. \TeX82 uses this command for characters in the
+range |128<=c<256|.
+
+\yskip\hang|@!set2| 129 |c[2]|. Same as |set1|, except that |c|~is two
+bytes long, so it is in the range |0<=c<65536|. \TeX82 never uses this
+command, but it should come in handy for extensions of \TeX\ that deal
+with oriental languages.
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+\yskip\hang|@!set3| 130 |c[3]|. Same as |set1|, except that |c|~is three
+bytes long, so it can be as large as $2^{24}-1$. Not even the Chinese
+language has this many characters, but this command might prove useful
+in some yet unforeseen extension.
+
+\yskip\hang|@!set4| 131 |c[4]|. Same as |set1|, except that |c|~is four
+bytes long. Imagine that.
+
+\yskip\hang|set_rule| 132 |a[4]| |b[4]|. Typeset a solid black rectangle
+of height~|a| and width~|b|, with its bottom left corner at |(h,v)|. Then
+set |h:=h+b|. If either |a<=0| or |b<=0|, nothing should be typeset. Note
+that if |b<0|, the value of |h| will decrease even though nothing else happens.
+See below for details about how to typeset rules so that consistency with
+\MF\ is guaranteed.
+
+\yskip\hang|@!put1| 133 |c[1]|. Typeset character number~|c| from font~|f|
+such that the reference point of the character is at |(h,v)|. (The `put'
+commands are exactly like the `set' commands, except that they simply put out a
+character or a rule without moving the reference point afterwards.)
+
+\yskip\hang|@!put2| 134 |c[2]|. Same as |set2|, except that |h| is not changed.
+
+\yskip\hang|@!put3| 135 |c[3]|. Same as |set3|, except that |h| is not changed.
+
+\yskip\hang|@!put4| 136 |c[4]|. Same as |set4|, except that |h| is not changed.
+
+\yskip\hang|put_rule| 137 |a[4]| |b[4]|. Same as |set_rule|, except that
+|h| is not changed.
+
+\yskip\hang|nop| 138. No operation, do nothing. Any number of |nop|'s
+may occur between \.{DVI} commands, but a |nop| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|bop| 139 $c_0[4]$ $c_1[4]$ $\ldots$ $c_9[4]$ $p[4]$. Beginning
+of a page: Set |(h,v,w,x,y,z):=(0,0,0,0,0,0)| and set the stack empty. Set
+the current font |f| to an undefined value. The ten $c_i$ parameters hold
+the values of \.{\\count0} $\ldots$ \.{\\count9} in \TeX\ at the time
+\.{\\shipout} was invoked for this page; they can be used to identify
+pages, if a user wants to print only part of a \.{DVI} file. The parameter
+|p| points to the previous |bop| in the file; the first
+|bop| has $p=-1$.
+
+\yskip\hang|eop| 140. End of page: Print what you have read since the
+previous |bop|. At this point the stack should be empty. (The \.{DVI}-reading
+programs that drive most output devices will have kept a buffer of the
+material that appears on the page that has just ended. This material is
+largely, but not entirely, in order by |v| coordinate and (for fixed |v|) by
+|h|~coordinate; so it usually needs to be sorted into some order that is
+appropriate for the device in question.)
+
+\yskip\hang|push| 141. Push the current values of |(h,v,w,x,y,z)| onto the
+top of the stack; do not change any of these values. Note that |f| is
+not pushed.
+
+\yskip\hang|pop| 142. Pop the top six values off of the stack and assign
+them respectively to |(h,v,w,x,y,z)|. The number of pops should never
+exceed the number of pushes, since it would be highly embarrassing if the
+stack were empty at the time of a |pop| command.
+
+\yskip\hang|right1| 143 |b[1]|. Set |h:=h+b|, i.e., move right |b| units.
+The parameter is a signed number in two's complement notation, |-128<=b<128|;
+if |b<0|, the reference point moves left.
+
+\yskip\hang|right2| 144 |b[2]|. Same as |right1|, except that |b| is a
+two-byte quantity in the range |-32768<=b<32768|.
+
+\yskip\hang|right3| 145 |b[3]|. Same as |right1|, except that |b| is a
+three-byte quantity in the range |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|right4| 146 |b[4]|. Same as |right1|, except that |b| is a
+four-byte quantity in the range |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|w0| 147. Set |h:=h+w|; i.e., move right |w| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|w| gets particular values.
+
+\yskip\hang|w1| 148 |b[1]|. Set |w:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |w|~spacing and moves right by |b|.
+
+\yskip\hang|@!w2| 149 |b[2]|. Same as |w1|, but |b| is two bytes long,
+|-32768<=b<32768|.
+
+\yskip\hang|@!w3| 150 |b[3]|. Same as |w1|, but |b| is three bytes long,
+|@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|@!w4| 151 |b[4]|. Same as |w1|, but |b| is four bytes long,
+|@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|x0| 152. Set |h:=h+x|; i.e., move right |x| units. The `|x|'
+commands are like the `|w|' commands except that they involve |x| instead
+of |w|.
+
+\yskip\hang|x1| 153 |b[1]|. Set |x:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |x|~spacing and moves right by |b|.
+
+\yskip\hang|@!x2| 154 |b[2]|. Same as |x1|, but |b| is two bytes long,
+|-32768<=b<32768|.
+
+\yskip\hang|@!x3| 155 |b[3]|. Same as |x1|, but |b| is three bytes long,
+|@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|@!x4| 156 |b[4]|. Same as |x1|, but |b| is four bytes long,
+|@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|down1| 157 |a[1]|. Set |v:=v+a|, i.e., move down |a| units.
+The parameter is a signed number in two's complement notation, |-128<=a<128|;
+if |a<0|, the reference point moves up.
+
+\yskip\hang|@!down2| 158 |a[2]|. Same as |down1|, except that |a| is a
+two-byte quantity in the range |-32768<=a<32768|.
+
+\yskip\hang|@!down3| 159 |a[3]|. Same as |down1|, except that |a| is a
+three-byte quantity in the range |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|@!down4| 160 |a[4]|. Same as |down1|, except that |a| is a
+four-byte quantity in the range |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|y0| 161. Set |v:=v+y|; i.e., move down |y| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|y| gets particular values.
+
+\yskip\hang|y1| 162 |a[1]|. Set |y:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |y|~spacing and moves down by |a|.
+
+\yskip\hang|@!y2| 163 |a[2]|. Same as |y1|, but |a| is two bytes long,
+|-32768<=a<32768|.
+
+\yskip\hang|@!y3| 164 |a[3]|. Same as |y1|, but |a| is three bytes long,
+|@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|@!y4| 165 |a[4]|. Same as |y1|, but |a| is four bytes long,
+|@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|z0| 166. Set |v:=v+z|; i.e., move down |z| units. The `|z|' commands
+are like the `|y|' commands except that they involve |z| instead of |y|.
+
+\yskip\hang|z1| 167 |a[1]|. Set |z:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |z|~spacing and moves down by |a|.
+
+\yskip\hang|@!z2| 168 |a[2]|. Same as |z1|, but |a| is two bytes long,
+|-32768<=a<32768|.
+
+\yskip\hang|@!z3| 169 |a[3]|. Same as |z1|, but |a| is three bytes long,
+|@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|@!z4| 170 |a[4]|. Same as |z1|, but |a| is four bytes long,
+|@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|fnt_num_0| 171. Set |f:=0|. Font 0 must previously have been
+defined by a \\{fnt\_def} instruction, as explained below.
+
+\yskip\hang\\{fnt\_num\_1} through \\{fnt\_num\_63} (opcodes 172 to 234). Set
+|f:=1|, \dots, \hbox{|f:=63|}, respectively.
+
+\yskip\hang|fnt1| 235 |k[1]|. Set |f:=k|. \TeX82 uses this command for font
+numbers in the range |64<=k<256|.
+
+\yskip\hang|@!fnt2| 236 |k[2]|. Same as |fnt1|, except that |k|~is two
+bytes long, so it is in the range |0<=k<65536|. \TeX82 never generates this
+command, but large font numbers may prove useful for specifications of
+color or texture, or they may be used for special fonts that have fixed
+numbers in some external coding scheme.
+
+\yskip\hang|@!fnt3| 237 |k[3]|. Same as |fnt1|, except that |k|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|@!fnt4| 238 |k[4]|. Same as |fnt1|, except that |k|~is four
+bytes long; this is for the really big font numbers (and for the negative ones).
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |nop| unless special \.{DVI}-reading
+programs are being used. \TeX82 generates |xxx1| when a short enough
+\.{\\special} appears, setting |k| to the number of bytes being sent. It
+is recommended that |x| be a string having the form of a keyword followed
+by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|@!xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be ridiculously
+large. \TeX82 uses |xxx4| when sending a string of length 256 or more.
+
+\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<256|; font definitions will be explained shortly.
+
+\yskip\hang|@!fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<65536|.
+
+\yskip\hang|@!fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|@!fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
+
+\yskip\hang|pre| 247 |i[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameters |i|, |num|, |den|, |mag|, |k|, and |x| are explained below.
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@ @d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+
+@ The preamble contains basic information about the file as a whole. As
+stated above, there are six parameters:
+$$\hbox{|@!i[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
+The |i| byte identifies \.{DVI} format; currently this byte is always set
+to~2. (The value |i=3| is currently used for an extended format that
+allows a mixture of right-to-left and left-to-right typesetting.
+Some day we will set |i=4|, when \.{DVI} format makes another
+incompatible change---perhaps in the year 2048.)
+
+The next two parameters, |num| and |den|, are positive integers that define
+the units of measurement; they are the numerator and denominator of a
+fraction by which all dimensions in the \.{DVI} file could be multiplied
+in order to get lengths in units of $10^{-7}$ meters. Since $\rm 7227{pt} =
+254{cm}$, and since \TeX\ works with scaled points where there are $2^{16}$
+sp in a point, \TeX\ sets
+$|num|/|den|=(254\cdot10^5)/(7227\cdot2^{16})=25400000/473628672$.
+@^sp@>
+
+The |mag| parameter is what \TeX\ calls \.{\\mag}, i.e., 1000 times the
+desired magnification. The actual fraction by which dimensions are
+multiplied is therefore $|mag|\cdot|num|/1000|den|$. Note that if a \TeX\
+source document does not call for any `\.{true}' dimensions, and if you
+change it only by specifying a different \.{\\mag} setting, the \.{DVI}
+file that \TeX\ creates will be completely unchanged except for the value
+of |mag| in the preamble and postamble. (Fancy \.{DVI}-reading programs allow
+users to override the |mag|~setting when a \.{DVI} file is being printed.)
+
+Finally, |k| and |x| allow the \.{DVI} writer to include a comment, which is not
+interpreted further. The length of comment |x| is |k|, where |0<=k<256|.
+
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+
+@ Font definitions for a given font number |k| contain further parameters
+$$\hbox{|c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.}$$
+The four-byte value |c| is the check sum that \TeX\ found in the \.{TFM}
+file for this font; |c| should match the check sum of the font found by
+programs that read this \.{DVI} file.
+@^check sum@>
+
+Parameter |s| contains a fixed-point scale factor that is applied to
+the character widths in font |k|; font dimensions in \.{TFM} files and
+other font files are relative to this quantity, which is called the
+``at size'' elsewhere in this documentation. The value of |s| is
+always positive and less than $2^{27}$. It is given in the same units
+as the other \.{DVI} dimensions, i.e., in sp when \TeX82 has made the
+file. Parameter |d| is similar to |s|; it is the ``design size,'' and
+(like~|s|) it is given in \.{DVI} units. Thus, font |k| is to be used
+at $|mag|\cdot s/1000d$ times its normal size.
+
+The remaining part of a font definition gives the external name of the font,
+which is an ASCII string of length |a+l|. The number |a| is the length
+of the ``area'' or directory, and |l| is the length of the font name itself;
+the standard local system font area is supposed to be used when |a=0|.
+The |n| field contains the area in its first |a| bytes.
+
+Font definitions must appear before the first use of a particular font number.
+Once font |k| is defined, it must not be defined again; however, we
+shall see below that font definitions appear in the postamble as well as
+in the pages, so in this sense each font number is defined exactly twice,
+if at all. Like |nop| commands, font definitions can
+appear before the first |bop|, or between an |eop| and a |bop|.
+
+@ Sometimes it is desirable to make horizontal or vertical rules line up
+precisely with certain features in characters of a font. It is possible to
+guarantee the correct matching between \.{DVI} output and the characters
+generated by \MF\ by adhering to the following principles: (1)~The \MF\
+characters should be positioned so that a bottom edge or left edge that is
+supposed to line up with the bottom or left edge of a rule appears at the
+reference point, i.e., in row~0 and column~0 of the \MF\ raster. This
+ensures that the position of the rule will not be rounded differently when
+the pixel size is not a perfect multiple of the units of measurement in
+the \.{DVI} file. (2)~A typeset rule of height $a>0$ and width $b>0$
+should be equivalent to a \MF-generated character having black pixels in
+precisely those raster positions whose \MF\ coordinates satisfy
+|0<=x<@t$\alpha$@>b| and |0<=y<@t$\alpha$@>a|, where $\alpha$ is the number
+of pixels per \.{DVI} unit.
+@:METAFONT}{\MF@>
+@^alignment of rules with characters@>
+@^rules aligning with characters@>
+
+@ The last page in a \.{DVI} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \TeX\ has
+accumulated about the file, making it possible to print subsets of the data
+with reasonable efficiency. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |num[4]| |den[4]| |mag[4]| |l[4]| |u[4]| |s[2]| |t[2]|\cr
+ $\langle\,$font definitions$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the final |bop| in the file. The next three
+parameters, |num|, |den|, and |mag|, are duplicates of the quantities that
+appeared in the preamble.
+
+Parameters |l| and |u| give respectively the height-plus-depth of the tallest
+page and the width of the widest page, in the same units as other dimensions
+of the file. These numbers might be used by a \.{DVI}-reading program to
+position individual ``pages'' on large sheets of film or paper; however,
+the standard convention for output on normal size paper is to position each
+page so that the upper left-hand corner is exactly one inch from the left
+and the top. Experience has shown that it is unwise to design \.{DVI}-to-printer
+software that attempts cleverly to center the output; a fixed position of
+the upper left corner is easiest for users to understand and to work with.
+Therefore |l| and~|u| are often ignored.
+
+Parameter |s| is the maximum stack depth (i.e., the largest excess of
+|push| commands over |pop| commands) needed to process this file. Then
+comes |t|, the total number of pages (|bop| commands) present.
+
+The postamble continues with font definitions, which are any number of
+\\{fnt\_def} commands as described above, possibly interspersed with |nop|
+commands. Each font number that is used in the \.{DVI} file must be defined
+exactly twice: Once before it is first selected by a \\{fnt} command, and once
+in the postamble.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the font definitions, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~2, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \TeX\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{DVI} file makes it feasible for
+\.{DVI}-reading programs to find the postamble first, on most computers,
+even though \TeX\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{DVI} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{DVI} reader can discover all the information needed for typesetting the
+pages. Note that it is also possible to skip through the \.{DVI} file at
+reasonably high speed to locate a particular page, if that proves
+desirable. This saves a lot of time, since \.{DVI} files used in production
+jobs tend to be large.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{DVI}
+format has been designed to work most efficiently with modern operating systems.
+But if \.{DVI} files have to be processed under the restrictions of standard
+\PASCAL, one can simply read them from front to back, since the necessary
+header information is present in the preamble and in the font definitions.
+(The |l| and |u| and |s| and |t| parameters, which appear only in the
+postamble, are ``frills'' that are handy but not absolutely necessary.)
+
+@* \[32] Shipping pages out.
+After considering \TeX's eyes and stomach, we come now to the bowels.
+@^bowels@>
+
+The |ship_out| procedure is given a pointer to a box; its mission is
+to describe that box in \.{DVI} form, outputting a ``page'' to |dvi_file|.
+The \.{DVI} coordinates $(h,v)=(0,0)$ should correspond to the upper left
+corner of the box being shipped.
+
+Since boxes can be inside of boxes inside of boxes, the main work of
+|ship_out| is done by two mutually recursive routines, |hlist_out|
+and |vlist_out|, which traverse the hlists and vlists inside of horizontal
+and vertical boxes.
+
+As individual pages are being processed, we need to accumulate
+information about the entire set of pages, since such statistics must be
+reported in the postamble. The global variables |total_pages|, |max_v|,
+|max_h|, |max_push|, and |last_bop| are used to record this information.
+
+The variable |doing_leaders| is |true| while leaders are being output.
+The variable |dead_cycles| contains the number of times an output routine
+has been initiated since the last |ship_out|.
+
+A few additional global variables are also defined here for use in
+|vlist_out| and |hlist_out|. They could have been local variables, but
+that would waste stack space when boxes are deeply nested, since the
+values of these variables are not needed during recursive calls.
+@^recursion@>
+
+@<Glob...@>=
+@!total_pages:integer; {the number of pages that have been shipped out}
+@!max_v:scaled; {maximum height-plus-depth of pages shipped so far}
+@!max_h:scaled; {maximum width of pages shipped so far}
+@!max_push:integer; {deepest nesting of |push| commands encountered so far}
+@!last_bop:integer; {location of previous |bop| in the \.{DVI} output}
+@!dead_cycles:integer; {recent outputs that didn't ship anything out}
+@!doing_leaders:boolean; {are we inside a leader box?}
+@#
+@!c,@!f:quarterword; {character and font in current |char_node|}
+@!rule_ht,@!rule_dp,@!rule_wd:scaled; {size of current rule being output}
+@!g:pointer; {current glue specification}
+@!lq,@!lr:integer; {quantities used in calculations for leaders}
+
+@ @<Set init...@>=
+total_pages:=0; max_v:=0; max_h:=0; max_push:=0; last_bop:=-1;
+doing_leaders:=false; dead_cycles:=0; cur_s:=-1;
+
+@ The \.{DVI} bytes are output to a buffer instead of being written directly
+to the output file. This makes it possible to reduce the overhead of
+subroutine calls, thereby measurably speeding up the computation, since
+output of \.{DVI} bytes is part of \TeX's inner loop. And it has another
+advantage as well, since we can change instructions in the buffer in order to
+make the output more compact. For example, a `|down2|' command can be
+changed to a `|y2|', thereby making a subsequent `|y0|' command possible,
+saving two bytes.
+
+The output buffer is divided into two parts of equal size; the bytes found
+in |dvi_buf[0..half_buf-1]| constitute the first half, and those in
+|dvi_buf[half_buf..dvi_buf_size-1]| constitute the second. The global
+variable |dvi_ptr| points to the position that will receive the next
+output byte. When |dvi_ptr| reaches |dvi_limit|, which is always equal
+to one of the two values |half_buf| or |dvi_buf_size|, the half buffer that
+is about to be invaded next is sent to the output and |dvi_limit| is
+changed to its other value. Thus, there is always at least a half buffer's
+worth of information present, except at the very beginning of the job.
+
+Bytes of the \.{DVI} file are numbered sequentially starting with 0;
+the next byte to be generated will be number |dvi_offset+dvi_ptr|.
+A byte is present in the buffer only if its number is |>=dvi_gone|.
+
+@<Types...@>=
+@!dvi_index=0..dvi_buf_size; {an index into the output buffer}
+
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+
+@<Glob...@>=
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@!half_buf:dvi_index; {half of |dvi_buf_size|}
+@!dvi_limit:dvi_index; {end of the current half buffer}
+@!dvi_ptr:dvi_index; {the next available buffer address}
+@!dvi_offset:integer; {|dvi_buf_size| times the number of times the
+ output buffer has been fully emptied}
+@!dvi_gone:integer; {the number of bytes already output to |dvi_file|}
+
+@ Initially the buffer is all in one piece; we will output half of it only
+after it first fills up.
+
+@<Set init...@>=
+half_buf:=dvi_buf_size div 2; dvi_limit:=dvi_buf_size; dvi_ptr:=0;
+dvi_offset:=0; dvi_gone:=0;
+
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write_dvi(a,b)|. For best results, this procedure should be optimized to
+run as fast as possible on each particular system, since it is part of
+\TeX's inner loop. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_dvi(a,b)| is called; therefore it is possible on
+many machines to use efficient methods to pack four bytes per word and to
+output an array of words with one system call.
+@^system dependencies@>
+@^inner loop@>
+@^defecation@>
+
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+
+@ To put a byte in the buffer without paying the cost of invoking a procedure
+each time, we use the macro |dvi_out|.
+
+@d dvi_out(#)==@+begin dvi_buf[dvi_ptr]:=#; incr(dvi_ptr);
+ if dvi_ptr=dvi_limit then dvi_swap;
+ end
+
+@p procedure dvi_swap; {outputs half of the buffer}
+begin if dvi_limit=dvi_buf_size then
+ begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
+ dvi_offset:=dvi_offset+dvi_buf_size; dvi_ptr:=0;
+ end
+else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
+ end;
+dvi_gone:=dvi_gone+half_buf;
+end;
+
+@ Here is how we clean out the buffer when \TeX\ is all through; |dvi_ptr|
+will be a multiple of~4.
+
+@<Empty the last bytes out of |dvi_buf|@>=
+if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
+if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
+
+@ The |dvi_four| procedure outputs four bytes in two's complement notation,
+without risking arithmetic overflow.
+
+@p procedure dvi_four(@!x:integer);
+begin if x>=0 then dvi_out(x div @'100000000)
+else begin x:=x+@'10000000000;
+ x:=x+@'10000000000;
+ dvi_out((x div @'100000000) + 128);
+ end;
+x:=x mod @'100000000; dvi_out(x div @'200000);
+x:=x mod @'200000; dvi_out(x div @'400);
+dvi_out(x mod @'400);
+end;
+
+@ A mild optimization of the output is performed by the |dvi_pop|
+routine, which issues a |pop| unless it is possible to cancel a
+`|push| |pop|' pair. The parameter to |dvi_pop| is the byte address
+following the old |push| that matches the new |pop|.
+
+@p procedure dvi_pop(@!l:integer);
+begin if (l=dvi_offset+dvi_ptr)and(dvi_ptr>0) then decr(dvi_ptr)
+else dvi_out(pop);
+end;
+
+@ Here's a procedure that outputs a font definition. Since \TeX82 uses at
+most 256 different fonts per job, |fnt_def1| is always used as the command code.
+
+@p procedure dvi_font_def(@!f:internal_font_number);
+var k:pool_pointer; {index into |str_pool|}
+begin dvi_out(fnt_def1);
+dvi_out(f-font_base-1);@/
+dvi_out(qo(font_check[f].b0));
+dvi_out(qo(font_check[f].b1));
+dvi_out(qo(font_check[f].b2));
+dvi_out(qo(font_check[f].b3));@/
+dvi_four(font_size[f]);
+dvi_four(font_dsize[f]);@/
+dvi_out(length(font_area[f]));
+dvi_out(length(font_name[f]));
+@<Output the font name whose internal number is |f|@>;
+end;
+
+@ @<Output the font name whose internal number is |f|@>=
+for k:=str_start[font_area[f]] to str_start[font_area[f]+1]-1 do
+ dvi_out(so(str_pool[k]));
+for k:=str_start[font_name[f]] to str_start[font_name[f]+1]-1 do
+ dvi_out(so(str_pool[k]))
+
+@ Versions of \TeX\ intended for small computers might well choose to omit
+the ideas in the next few parts of this program, since it is not really
+necessary to optimize the \.{DVI} code by making use of the |w0|, |x0|,
+|y0|, and |z0| commands. Furthermore, the algorithm that we are about to
+describe does not pretend to give an optimum reduction in the length
+of the \.{DVI} code; after all, speed is more important than compactness.
+But the method is surprisingly effective, and it takes comparatively little
+time.
+
+We can best understand the basic idea by first considering a simpler problem
+that has the same essential characteristics. Given a sequence of digits,
+say $3\,1\,4\,1\,5\,9\,2\,6\,5\,3\,5\,8\,9$, we want to assign subscripts
+$d$, $y$, or $z$ to each digit so as to maximize the number of ``$y$-hits''
+and ``$z$-hits''; a $y$-hit is an instance of two appearances of the same
+digit with the subscript $y$, where no $y$'s intervene between the two
+appearances, and a $z$-hit is defined similarly. For example, the sequence
+above could be decorated with subscripts as follows:
+$$3_z\,1_y\,4_d\,1_y\,5_y\,9_d\,2_d\,6_d\,5_y\,3_z\,5_y\,8_d\,9_d.$$
+There are three $y$-hits ($1_y\ldots1_y$ and $5_y\ldots5_y\ldots5_y$) and
+one $z$-hit ($3_z\ldots3_z$); there are no $d$-hits, since the two appearances
+of $9_d$ have $d$'s between them, but we don't count $d$-hits so it doesn't
+matter how many there are. These subscripts are analogous to the \.{DVI}
+commands called \\{down}, $y$, and $z$, and the digits are analogous to
+different amounts of vertical motion; a $y$-hit or $z$-hit corresponds to
+the opportunity to use the one-byte commands |y0| or |z0| in a \.{DVI} file.
+
+\TeX's method of assigning subscripts works like this: Append a new digit,
+say $\delta$, to the right of the sequence. Now look back through the
+sequence until one of the following things happens: (a)~You see
+$\delta_y$ or $\delta_z$, and this was the first time you encountered a
+$y$ or $z$ subscript, respectively. Then assign $y$ or $z$ to the new
+$\delta$; you have scored a hit. (b)~You see $\delta_d$, and no $y$
+subscripts have been encountered so far during this search. Then change
+the previous $\delta_d$ to $\delta_y$ (this corresponds to changing a
+command in the output buffer), and assign $y$ to the new $\delta$; it's
+another hit. (c)~You see $\delta_d$, and a $y$ subscript has been seen
+but not a $z$. Change the previous $\delta_d$ to $\delta_z$ and assign
+$z$ to the new $\delta$. (d)~You encounter both $y$ and $z$ subscripts
+before encountering a suitable $\delta$, or you scan all the way to the
+front of the sequence. Assign $d$ to the new $\delta$; this assignment may
+be changed later.
+
+The subscripts $3_z\,1_y\,4_d\ldots\,$ in the example above were, in fact,
+produced by this procedure, as the reader can verify. (Go ahead and try it.)
+
+@ In order to implement such an idea, \TeX\ maintains a stack of pointers
+to the \\{down}, $y$, and $z$ commands that have been generated for the
+current page. And there is a similar stack for \\{right}, |w|, and |x|
+commands. These stacks are called the down stack and right stack, and their
+top elements are maintained in the variables |down_ptr| and |right_ptr|.
+
+Each entry in these stacks contains four fields: The |width| field is
+the amount of motion down or to the right; the |location| field is the
+byte number of the \.{DVI} command in question (including the appropriate
+|dvi_offset|); the |link| field points to the next item below this one
+on the stack; and the |info| field encodes the options for possible change
+in the \.{DVI} command.
+
+@d movement_node_size=3 {number of words per entry in the down and right stacks}
+@d location(#)==mem[#+2].int {\.{DVI} byte number for a movement command}
+
+@<Glob...@>=
+@!down_ptr,@!right_ptr:pointer; {heads of the down and right stacks}
+
+@ @<Set init...@>=
+down_ptr:=null; right_ptr:=null;
+
+@ Here is a subroutine that produces a \.{DVI} command for some specified
+downward or rightward motion. It has two parameters: |w| is the amount
+of motion, and |o| is either |down1| or |right1|. We use the fact that
+the command codes have convenient arithmetic properties: |y1-down1=w1-right1|
+and |z1-down1=x1-right1|.
+
+@p procedure movement(@!w:scaled;@!o:eight_bits);
+label exit,found,not_found,2,1;
+var mstate:small_number; {have we seen a |y| or |z|?}
+@!p,@!q:pointer; {current and top nodes on the stack}
+@!k:integer; {index into |dvi_buf|, modulo |dvi_buf_size|}
+begin q:=get_node(movement_node_size); {new node for the top of the stack}
+width(q):=w; location(q):=dvi_offset+dvi_ptr;
+if o=down1 then
+ begin link(q):=down_ptr; down_ptr:=q;
+ end
+else begin link(q):=right_ptr; right_ptr:=q;
+ end;
+@<Look at the other stack entries until deciding what sort of \.{DVI} command
+ to generate; |goto found| if node |p| is a ``hit''@>;
+@<Generate a |down| or |right| command for |w| and |return|@>;
+found: @<Generate a |y0| or |z0| command in order to reuse a previous
+ appearance of~|w|@>;
+exit:end;
+
+@ The |info| fields in the entries of the down stack or the right stack
+have six possible settings: |y_here| or |z_here| mean that the \.{DVI}
+command refers to |y| or |z|, respectively (or to |w| or |x|, in the
+case of horizontal motion); |yz_OK| means that the \.{DVI} command is
+\\{down} (or \\{right}) but can be changed to either |y| or |z| (or
+to either |w| or |x|); |y_OK| means that it is \\{down} and can be changed
+to |y| but not |z|; |z_OK| is similar; and |d_fixed| means it must stay
+\\{down}.
+
+The four settings |yz_OK|, |y_OK|, |z_OK|, |d_fixed| would not need to
+be distinguished from each other if we were simply solving the
+digit-subscripting problem mentioned above. But in \TeX's case there is
+a complication because of the nested structure of |push| and |pop|
+commands. Suppose we add parentheses to the digit-subscripting problem,
+redefining hits so that $\delta_y\ldots \delta_y$ is a hit if all $y$'s between
+the $\delta$'s are enclosed in properly nested parentheses, and if the
+parenthesis level of the right-hand $\delta_y$ is deeper than or equal to
+that of the left-hand one. Thus, `(' and `)' correspond to `|push|'
+and `|pop|'. Now if we want to assign a subscript to the final 1 in the
+sequence
+$$2_y\,7_d\,1_d\,(\,8_z\,2_y\,8_z\,)\,1$$
+we cannot change the previous $1_d$ to $1_y$, since that would invalidate
+the $2_y\ldots2_y$ hit. But we can change it to $1_z$, scoring a hit
+since the intervening $8_z$'s are enclosed in parentheses.
+
+The program below removes movement nodes that are introduced after a |push|,
+before it outputs the corresponding |pop|.
+
+@d y_here=1 {|info| when the movement entry points to a |y| command}
+@d z_here=2 {|info| when the movement entry points to a |z| command}
+@d yz_OK=3 {|info| corresponding to an unconstrained \\{down} command}
+@d y_OK=4 {|info| corresponding to a \\{down} that can't become a |z|}
+@d z_OK=5 {|info| corresponding to a \\{down} that can't become a |y|}
+@d d_fixed=6 {|info| corresponding to a \\{down} that can't change}
+
+@ When the |movement| procedure gets to the label |found|, the value of
+|info(p)| will be either |y_here| or |z_here|. If it is, say, |y_here|,
+the procedure generates a |y0| command (or a |w0| command), and marks
+all |info| fields between |q| and |p| so that |y| is not OK in that range.
+
+@<Generate a |y0| or |z0| command...@>=
+info(q):=info(p);
+if info(q)=y_here then
+ begin dvi_out(o+y0-down1); {|y0| or |w0|}
+ while link(q)<>p do
+ begin q:=link(q);
+ case info(q) of
+ yz_OK: info(q):=z_OK;
+ y_OK: info(q):=d_fixed;
+ othercases do_nothing
+ endcases;
+ end;
+ end
+else begin dvi_out(o+z0-down1); {|z0| or |x0|}
+ while link(q)<>p do
+ begin q:=link(q);
+ case info(q) of
+ yz_OK: info(q):=y_OK;
+ z_OK: info(q):=d_fixed;
+ othercases do_nothing
+ endcases;
+ end;
+ end
+
+@ @<Generate a |down| or |right|...@>=
+info(q):=yz_OK;
+if abs(w)>=@'40000000 then
+ begin dvi_out(o+3); {|down4| or |right4|}
+ dvi_four(w); return;
+ end;
+if abs(w)>=@'100000 then
+ begin dvi_out(o+2); {|down3| or |right3|}
+ if w<0 then w:=w+@'100000000;
+ dvi_out(w div @'200000); w:=w mod @'200000; goto 2;
+ end;
+if abs(w)>=@'200 then
+ begin dvi_out(o+1); {|down2| or |right2|}
+ if w<0 then w:=w+@'200000;
+ goto 2;
+ end;
+dvi_out(o); {|down1| or |right1|}
+if w<0 then w:=w+@'400;
+goto 1;
+2: dvi_out(w div @'400);
+1: dvi_out(w mod @'400); return
+
+@ As we search through the stack, we are in one of three states,
+|y_seen|, |z_seen|, or |none_seen|, depending on whether we have
+encountered |y_here| or |z_here| nodes. These states are encoded as
+multiples of 6, so that they can be added to the |info| fields for quick
+decision-making.
+@^inner loop@>
+
+@d none_seen=0 {no |y_here| or |z_here| nodes have been encountered yet}
+@d y_seen=6 {we have seen |y_here| but not |z_here|}
+@d z_seen=12 {we have seen |z_here| but not |y_here|}
+
+@<Look at the other stack entries until deciding...@>=
+p:=link(q); mstate:=none_seen;
+while p<>null do
+ begin if width(p)=w then @<Consider a node with matching width;
+ |goto found| if it's a hit@>
+ else case mstate+info(p) of
+ none_seen+y_here: mstate:=y_seen;
+ none_seen+z_here: mstate:=z_seen;
+ y_seen+z_here,z_seen+y_here: goto not_found;
+ othercases do_nothing
+ endcases;
+ p:=link(p);
+ end;
+not_found:
+
+@ We might find a valid hit in a |y| or |z| byte that is already gone
+from the buffer. But we can't change bytes that are gone forever; ``the
+moving finger writes, $\ldots\,\,$.''
+
+@<Consider a node with matching width...@>=
+case mstate+info(p) of
+none_seen+yz_OK,none_seen+y_OK,z_seen+yz_OK,z_seen+y_OK:@t@>@;@/
+ if location(p)<dvi_gone then goto not_found
+ else @<Change buffered instruction to |y| or |w| and |goto found|@>;
+none_seen+z_OK,y_seen+yz_OK,y_seen+z_OK:@t@>@;@/
+ if location(p)<dvi_gone then goto not_found
+ else @<Change buffered instruction to |z| or |x| and |goto found|@>;
+none_seen+y_here,none_seen+z_here,y_seen+z_here,z_seen+y_here: goto found;
+othercases do_nothing
+endcases
+
+@ @<Change buffered instruction to |y| or |w| and |goto found|@>=
+begin k:=location(p)-dvi_offset;
+if k<0 then k:=k+dvi_buf_size;
+dvi_buf[k]:=dvi_buf[k]+y1-down1;
+info(p):=y_here; goto found;
+end
+
+@ @<Change buffered instruction to |z| or |x| and |goto found|@>=
+begin k:=location(p)-dvi_offset;
+if k<0 then k:=k+dvi_buf_size;
+dvi_buf[k]:=dvi_buf[k]+z1-down1;
+info(p):=z_here; goto found;
+end
+
+@ In case you are wondering when all the movement nodes are removed from
+\TeX's memory, the answer is that they are recycled just before
+|hlist_out| and |vlist_out| finish outputting a box. This restores the
+down and right stacks to the state they were in before the box was output,
+except that some |info|'s may have become more restrictive.
+
+@p procedure prune_movements(@!l:integer);
+ {delete movement nodes with |location>=l|}
+label done,exit;
+var p:pointer; {node being deleted}
+begin while down_ptr<>null do
+ begin if location(down_ptr)<l then goto done;
+ p:=down_ptr; down_ptr:=link(p); free_node(p,movement_node_size);
+ end;
+done: while right_ptr<>null do
+ begin if location(right_ptr)<l then return;
+ p:=right_ptr; right_ptr:=link(p); free_node(p,movement_node_size);
+ end;
+exit:end;
+
+@ The actual distances by which we want to move might be computed as the
+sum of several separate movements. For example, there might be several
+glue nodes in succession, or we might want to move right by the width of
+some box plus some amount of glue. More importantly, the baselineskip
+distances are computed in terms of glue together with the depth and
+height of adjacent boxes, and we want the \.{DVI} file to lump these
+three quantities together into a single motion.
+
+Therefore, \TeX\ maintains two pairs of global variables: |dvi_h| and |dvi_v|
+are the |h| and |v| coordinates corresponding to the commands actually
+output to the \.{DVI} file, while |cur_h| and |cur_v| are the coordinates
+corresponding to the current state of the output routines. Coordinate
+changes will accumulate in |cur_h| and |cur_v| without being reflected
+in the output, until such a change becomes necessary or desirable; we
+can call the |movement| procedure whenever we want to make |dvi_h=cur_h|
+or |dvi_v=cur_v|.
+
+The current font reflected in the \.{DVI} output is called |dvi_f|;
+there is no need for a `\\{cur\_f}' variable.
+
+The depth of nesting of |hlist_out| and |vlist_out| is called |cur_s|;
+this is essentially the depth of |push| commands in the \.{DVI} output.
+
+@d synch_h==if cur_h<>dvi_h then
+ begin movement(cur_h-dvi_h,right1); dvi_h:=cur_h;
+ end
+@d synch_v==if cur_v<>dvi_v then
+ begin movement(cur_v-dvi_v,down1); dvi_v:=cur_v;
+ end
+
+@<Glob...@>=
+@!dvi_h,@!dvi_v:scaled; {a \.{DVI} reader program thinks we are here}
+@!cur_h,@!cur_v:scaled; {\TeX\ thinks we are here}
+@!dvi_f:internal_font_number; {the current font}
+@!cur_s:integer; {current depth of output box nesting, initially $-1$}
+
+@ @<Initialize variables as |ship_out| begins@>=
+dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
+ensure_dvi_open;
+if total_pages=0 then
+ begin dvi_out(pre); dvi_out(id_byte); {output the preamble}
+@^preamble of \.{DVI} file@>
+ dvi_four(25400000); dvi_four(473628672); {conversion ratio for sp}
+ prepare_mag; dvi_four(mag); {magnification factor is frozen}
+ old_setting:=selector; selector:=new_string;
+ print(" TeX output "); print_int(year); print_char(".");
+ print_two(month); print_char("."); print_two(day);
+ print_char(":"); print_two(time div 60);
+ print_two(time mod 60);
+ selector:=old_setting; dvi_out(cur_length);
+ for s:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[s]));
+ pool_ptr:=str_start[str_ptr]; {flush the current string}
+ end
+
+@ When |hlist_out| is called, its duty is to output the box represented
+by the |hlist_node| pointed to by |temp_ptr|. The reference point of that
+box has coordinates |(cur_h,cur_v)|.
+
+Similarly, when |vlist_out| is called, its duty is to output the box represented
+by the |vlist_node| pointed to by |temp_ptr|. The reference point of that
+box has coordinates |(cur_h,cur_v)|.
+@^recursion@>
+
+@p procedure@?vlist_out; forward; {|hlist_out| and |vlist_out| are mutually
+ recursive}
+
+@ The recursive procedures |hlist_out| and |vlist_out| each have local variables
+|save_h| and |save_v| to hold the values of |dvi_h| and |dvi_v| just before
+entering a new level of recursion. In effect, the values of |save_h| and
+|save_v| on \TeX's run-time stack correspond to the values of |h| and |v|
+that a \.{DVI}-reading program will push onto its coordinate stack.
+
+@d move_past=13 {go to this label when advancing past glue or a rule}
+@d fin_rule=14 {go to this label to finish processing a rule}
+@d next_p=15 {go to this label when finished with node |p|}
+
+@p @t\4@>@<Declare procedures needed in |hlist_out|, |vlist_out|@>@t@>@/
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+@!left_edge: scaled; {the left coordinate for this box}
+@!save_h,@!save_v: scaled; {what |dvi_h| and |dvi_v| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p:pointer; {current position in the hlist}
+@!save_loc:integer; {\.{DVI} byte location upon entry}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_wd:scaled; {width of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {left edge of sub-box, or right edge of leader space}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+end;
+
+@ We ought to give special care to the efficiency of one part of |hlist_out|,
+since it belongs to \TeX's inner loop. When a |char_node| is encountered,
+we save a little time by processing several nodes in succession until
+reaching a non-|char_node|. The program uses the fact that |set_char_0=0|.
+@^inner loop@>
+
+@<Output node |p| for |hlist_out|...@>=
+reswitch: if is_char_node(p) then
+ begin synch_h; synch_v;
+ repeat f:=font(p); c:=character(p);
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+ if c>=qi(128) then dvi_out(set1);
+ dvi_out(qo(c));@/
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+ p:=link(p);
+ until not is_char_node(p);
+ dvi_h:=cur_h;
+ end
+else @<Output the non-|char_node| |p| for |hlist_out|
+ and move to the next node@>
+
+@ @<Change font |dvi_f| to |f|@>=
+begin if not font_used[f] then
+ begin dvi_font_def(f); font_used[f]:=true;
+ end;
+if f<=64+font_base then dvi_out(f-font_base-1+fnt_num_0)
+else begin dvi_out(fnt1); dvi_out(f-font_base-1);
+ end;
+dvi_f:=f;
+end
+
+@ @<Output the non-|char_node| |p| for |hlist_out|...@>=
+begin case type(p) of
+hlist_node,vlist_node:@<Output a box in an hlist@>;
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in an hlist@>;
+glue_node: @<Move right or output leaders@>;
+kern_node,math_node:cur_h:=cur_h+width(p);
+ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>;
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<Output a rule in an hlist@>;
+move_past: cur_h:=cur_h+rule_wd;
+next_p:p:=link(p);
+end
+
+@ @<Output a box in an hlist@>=
+if list_ptr(p)=null then cur_h:=cur_h+width(p)
+else begin save_h:=dvi_h; save_v:=dvi_v;
+ cur_v:=base_line+shift_amount(p); {shift the box down}
+ temp_ptr:=p; edge:=cur_h;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge+width(p); cur_v:=base_line;
+ end
+
+@ @<Output a rule in an hlist@>=
+if is_running(rule_ht) then rule_ht:=height(this_box);
+if is_running(rule_dp) then rule_dp:=depth(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+ begin synch_h; cur_v:=base_line+rule_dp; synch_v;
+ dvi_out(set_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+ cur_v:=base_line; dvi_h:=dvi_h+rule_wd;
+ end
+
+@ @d billion==float_constant(1000000000)
+@d vet_glue(#)== glue_temp:=#;
+ if glue_temp>billion then
+ glue_temp:=billion
+ else if glue_temp<-billion then
+ glue_temp:=-billion
+
+@<Move right or output leaders@>=
+begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
+if g_sign<>normal then
+ begin if g_sign=stretching then
+ begin if stretch_order(g)=g_order then
+ begin cur_glue:=cur_glue+stretch(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+ cur_g:=round(glue_temp);
+ end;
+ end
+ else if shrink_order(g)=g_order then
+ begin cur_glue:=cur_glue-shrink(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+ cur_g:=round(glue_temp);
+ end;
+ end;
+rule_wd:=rule_wd+cur_g;
+if subtype(p)>=a_leaders then
+ @<Output leaders in an hlist, |goto fin_rule| if a rule
+ or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<Output leaders in an hlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+ begin rule_ht:=height(leader_box); rule_dp:=depth(leader_box);
+ goto fin_rule;
+ end;
+leader_wd:=width(leader_box);
+if (leader_wd>0)and(rule_wd>0) then
+ begin rule_wd:=rule_wd+10; {compensate for floating-point rounding}
+ edge:=cur_h+rule_wd; lx:=0;
+ @<Let |cur_h| be the position of the first box, and set |leader_wd+lx|
+ to the spacing between corresponding parts of boxes@>;
+ while cur_h+leader_wd<=edge do
+ @<Output a leader box at |cur_h|,
+ then advance |cur_h| by |leader_wd+lx|@>;
+ cur_h:=edge-10; goto next_p;
+ end;
+end
+
+@ The calculations related to leaders require a bit of care. First, in the
+case of |a_leaders| (aligned leaders), we want to move |cur_h| to
+|left_edge| plus the smallest multiple of |leader_wd| for which the result
+is not less than the current value of |cur_h|; i.e., |cur_h| should become
+$|left_edge|+|leader_wd|\times\lceil
+(|cur_h|-|left_edge|)/|leader_wd|\rceil$. The program here should work in
+all cases even though some implementations of \PASCAL\ give nonstandard
+results for the |div| operation when |cur_h| is less than |left_edge|.
+
+In the case of |c_leaders| (centered leaders), we want to increase |cur_h|
+by half of the excess space not occupied by the leaders; and in the
+case of |x_leaders| (expanded leaders) we increase |cur_h|
+by $1/(q+1)$ of this excess space, where $q$ is the number of times the
+leader box will be replicated. Slight inaccuracies in the division might
+accumulate; half of this rounding error is placed at each end of the leaders.
+
+@<Let |cur_h| be the position of the first box, ...@>=
+if subtype(p)=a_leaders then
+ begin save_h:=cur_h;
+ cur_h:=left_edge+leader_wd*((cur_h-left_edge)@!div leader_wd);
+ if cur_h<save_h then cur_h:=cur_h+leader_wd;
+ end
+else begin lq:=rule_wd div leader_wd; {the number of box copies}
+ lr:=rule_wd mod leader_wd; {the remaining space}
+ if subtype(p)=c_leaders then cur_h:=cur_h+(lr div 2)
+ else begin lx:=lr div (lq+1);
+ cur_h:=cur_h+((lr-(lq-1)*lx) div 2);
+ end;
+ end
+
+@ The `\\{synch}' operations here are intended to decrease the number of
+bytes needed to specify horizontal and vertical motion in the \.{DVI} output.
+
+@<Output a leader box at |cur_h|, ...@>=
+begin cur_v:=base_line+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/
+synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_v:=save_v; dvi_h:=save_h; cur_v:=base_line;
+cur_h:=save_h+leader_wd+lx;
+end
+
+@ The |vlist_out| routine is similar to |hlist_out|, but a bit simpler.
+
+@p procedure vlist_out; {output a |vlist_node| box}
+label move_past, fin_rule, next_p;
+var left_edge: scaled; {the left coordinate for this box}
+@!top_edge: scaled; {the top coordinate for this box}
+@!save_h,@!save_v: scaled; {what |dvi_h| and |dvi_v| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p:pointer; {current position in the vlist}
+@!save_loc:integer; {\.{DVI} byte location upon entry}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_ht:scaled; {height of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {bottom boundary of leader space}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box);
+top_edge:=cur_v;
+while p<>null do @<Output node |p| for |vlist_out| and move to the next node,
+ maintaining the condition |cur_h=left_edge|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+end;
+
+@ @<Output node |p| for |vlist_out|...@>=
+begin if is_char_node(p) then confusion("vlistout")
+@:this can't happen vlistout}{\quad vlistout@>
+else @<Output the non-|char_node| |p| for |vlist_out|@>;
+next_p:p:=link(p);
+end
+
+@ @<Output the non-|char_node| |p| for |vlist_out|@>=
+begin case type(p) of
+hlist_node,vlist_node:@<Output a box in a vlist@>;
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in a vlist@>;
+glue_node: @<Move down or output leaders@>;
+kern_node:cur_v:=cur_v+width(p);
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<Output a rule in a vlist, |goto next_p|@>;
+move_past: cur_v:=cur_v+rule_ht;
+end
+
+@ The |synch_v| here allows the \.{DVI} output to use one-byte commands
+for adjusting |v| in most cases, since the baselineskip distance will
+usually be constant.
+
+@<Output a box in a vlist@>=
+if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
+else begin cur_v:=cur_v+height(p); synch_v;
+ save_h:=dvi_h; save_v:=dvi_v;
+ cur_h:=left_edge+shift_amount(p); {shift the box right}
+ temp_ptr:=p;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_v:=save_v+depth(p); cur_h:=left_edge;
+ end
+
+@ @<Output a rule in a vlist...@>=
+if is_running(rule_wd) then rule_wd:=width(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+cur_v:=cur_v+rule_ht;
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+ begin synch_h; synch_v;
+ dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+ end;
+goto next_p
+
+@ @<Move down or output leaders@>=
+begin g:=glue_ptr(p); rule_ht:=width(g)-cur_g;
+if g_sign<>normal then
+ begin if g_sign=stretching then
+ begin if stretch_order(g)=g_order then
+ begin cur_glue:=cur_glue+stretch(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+ cur_g:=round(glue_temp);
+ end;
+ end
+ else if shrink_order(g)=g_order then
+ begin cur_glue:=cur_glue-shrink(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+ cur_g:=round(glue_temp);
+ end;
+ end;
+rule_ht:=rule_ht+cur_g;
+if subtype(p)>=a_leaders then
+ @<Output leaders in a vlist, |goto fin_rule| if a rule
+ or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<Output leaders in a vlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+ begin rule_wd:=width(leader_box); rule_dp:=0;
+ goto fin_rule;
+ end;
+leader_ht:=height(leader_box)+depth(leader_box);
+if (leader_ht>0)and(rule_ht>0) then
+ begin rule_ht:=rule_ht+10; {compensate for floating-point rounding}
+ edge:=cur_v+rule_ht; lx:=0;
+ @<Let |cur_v| be the position of the first box, and set |leader_ht+lx|
+ to the spacing between corresponding parts of boxes@>;
+ while cur_v+leader_ht<=edge do
+ @<Output a leader box at |cur_v|,
+ then advance |cur_v| by |leader_ht+lx|@>;
+ cur_v:=edge-10; goto next_p;
+ end;
+end
+
+@ @<Let |cur_v| be the position of the first box, ...@>=
+if subtype(p)=a_leaders then
+ begin save_v:=cur_v;
+ cur_v:=top_edge+leader_ht*((cur_v-top_edge)@!div leader_ht);
+ if cur_v<save_v then cur_v:=cur_v+leader_ht;
+ end
+else begin lq:=rule_ht div leader_ht; {the number of box copies}
+ lr:=rule_ht mod leader_ht; {the remaining space}
+ if subtype(p)=c_leaders then cur_v:=cur_v+(lr div 2)
+ else begin lx:=lr div (lq+1);
+ cur_v:=cur_v+((lr-(lq-1)*lx) div 2);
+ end;
+ end
+
+@ When we reach this part of the program, |cur_v| indicates the top of a
+leader box, not its baseline.
+
+@<Output a leader box at |cur_v|, ...@>=
+begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/
+cur_v:=cur_v+height(leader_box); synch_v; save_v:=dvi_v;
+temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_v:=save_v; dvi_h:=save_h; cur_h:=left_edge;
+cur_v:=save_v-height(leader_box)+leader_ht+lx;
+end
+
+@ The |hlist_out| and |vlist_out| procedures are now complete, so we are
+ready for the |ship_out| routine that gets them started in the first place.
+
+@p procedure ship_out(@!p:pointer); {output the box |p|}
+label done;
+var page_loc:integer; {location of the current |bop|}
+@!j,@!k:0..9; {indices to first ten count registers}
+@!s:pool_pointer; {index into |str_pool|}
+@!old_setting:0..max_selector; {saved |selector| setting}
+begin if tracing_output>0 then
+ begin print_nl(""); print_ln;
+ print("Completed box being shipped out");
+@.Completed box...@>
+ end;
+if term_offset>max_print_line-9 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+print_char("["); j:=9;
+while (count(j)=0)and(j>0) do decr(j);
+for k:=0 to j do
+ begin print_int(count(k));
+ if k<j then print_char(".");
+ end;
+update_terminal;
+if tracing_output>0 then
+ begin print_char("]");
+ begin_diagnostic; show_box(p); end_diagnostic(true);
+ end;
+@<Ship box |p| out@>;
+if tracing_output<=0 then print_char("]");
+dead_cycles:=0;
+update_terminal; {progress report}
+@<Flush the box from memory, showing statistics if requested@>;
+end;
+
+@ @<Flush the box from memory, showing statistics if requested@>=
+@!stat if tracing_stats>1 then
+ begin print_nl("Memory usage before: ");
+@.Memory usage...@>
+ print_int(var_used); print_char("&");
+ print_int(dyn_used); print_char(";");
+ end;
+tats@/
+flush_node_list(p);
+@!stat if tracing_stats>1 then
+ begin print(" after: ");
+ print_int(var_used); print_char("&");
+ print_int(dyn_used); print("; still untouched: ");
+ print_int(hi_mem_min-lo_mem_max-1); print_ln;
+ end;
+tats
+
+@ @<Ship box |p| out@>=
+@<Update the values of |max_h| and |max_v|; but if the page is too large,
+ |goto done|@>;
+@<Initialize variables as |ship_out| begins@>;
+page_loc:=dvi_offset+dvi_ptr;
+dvi_out(bop);
+for k:=0 to 9 do dvi_four(count(k));
+dvi_four(last_bop); last_bop:=page_loc;
+cur_v:=height(p)+v_offset; temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+done:
+
+@ Sometimes the user will generate a huge page because other error messages
+are being ignored. Such pages are not output to the \.{dvi} file, since they
+may confuse the printing software.
+
+@<Update the values of |max_h| and |max_v|; but if the page is too large...@>=
+if (height(p)>max_dimen)or@|(depth(p)>max_dimen)or@|
+ (height(p)+depth(p)+v_offset>max_dimen)or@|
+ (width(p)+h_offset>max_dimen) then
+ begin print_err("Huge page cannot be shipped out");
+@.Huge page...@>
+ help2("The page just created is more than 18 feet tall or")@/
+ ("more than 18 feet wide, so I suspect something went wrong.");
+ error;
+ if tracing_output<=0 then
+ begin begin_diagnostic;
+ print_nl("The following box has been deleted:");
+@.The following...deleted@>
+ show_box(p);
+ end_diagnostic(true);
+ end;
+ goto done;
+ end;
+if height(p)+depth(p)+v_offset>max_v then max_v:=height(p)+depth(p)+v_offset;
+if width(p)+h_offset>max_h then max_h:=width(p)+h_offset
+
+@ At the end of the program, we must finish things off by writing the
+post\-amble. If |total_pages=0|, the \.{DVI} file was never opened.
+If |total_pages>=65536|, the \.{DVI} file will lie.
+
+An integer variable |k| will be declared for use by this routine.
+
+@<Finish the \.{DVI} file@>=
+while cur_s>-1 do
+ begin if cur_s>0 then dvi_out(pop)
+ else begin dvi_out(eop); incr(total_pages);
+ end;
+ decr(cur_s);
+ end;
+if total_pages=0 then print_nl("No pages of output.")
+@.No pages of output@>
+else begin dvi_out(post); {beginning of the postamble}
+ dvi_four(last_bop); last_bop:=dvi_offset+dvi_ptr-5; {|post| location}
+ dvi_four(25400000); dvi_four(473628672); {conversion ratio for sp}
+ prepare_mag; dvi_four(mag); {magnification factor}
+ dvi_four(max_v); dvi_four(max_h);@/
+ dvi_out(max_push div 256); dvi_out(max_push mod 256);@/
+ dvi_out((total_pages div 256) mod 256); dvi_out(total_pages mod 256);@/
+ @<Output the font definitions for all fonts that were used@>;
+ dvi_out(post_post); dvi_four(last_bop); dvi_out(id_byte);@/
+ k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+ while k>0 do
+ begin dvi_out(223); decr(k);
+ end;
+ @<Empty the last bytes out of |dvi_buf|@>;
+ print_nl("Output written on "); slow_print(output_file_name);
+@.Output written on x@>
+ print(" ("); print_int(total_pages); print(" page");
+ if total_pages<>1 then print_char("s");
+ print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
+ b_close(dvi_file);
+ end
+
+@ @<Output the font definitions...@>=
+while font_ptr>font_base do
+ begin if font_used[font_ptr] then dvi_font_def(font_ptr);
+ decr(font_ptr);
+ end
+
+@* \[33] Packaging.
+We're essentially done with the parts of \TeX\ that are concerned with
+the input (|get_next|) and the output (|ship_out|). So it's time to
+get heavily into the remaining part, which does the real work of typesetting.
+
+After lists are constructed, \TeX\ wraps them up and puts them into boxes.
+Two major subroutines are given the responsibility for this task: |hpack|
+applies to horizontal lists (hlists) and |vpack| applies to vertical lists
+(vlists). The main duty of |hpack| and |vpack| is to compute the dimensions
+of the resulting boxes, and to adjust the glue if one of those dimensions
+is pre-specified. The computed sizes normally enclose all of the material
+inside the new box; but some items may stick out if negative glue is used,
+if the box is overfull, or if a \.{\\vbox} includes other boxes that have
+been shifted left.
+
+The subroutine call |hpack(p,w,m)| returns a pointer to an |hlist_node|
+for a box containing the hlist that starts at |p|. Parameter |w| specifies
+a width; and parameter |m| is either `|exactly|' or `|additional|'. Thus,
+|hpack(p,w,exactly)| produces a box whose width is exactly |w|, while
+|hpack(p,w,additional)| yields a box whose width is the natural width plus
+|w|. It is convenient to define a macro called `|natural|' to cover the
+most common case, so that we can say |hpack(p,natural)| to get a box that
+has the natural width of list |p|.
+
+Similarly, |vpack(p,w,m)| returns a pointer to a |vlist_node| for a
+box containing the vlist that starts at |p|. In this case |w| represents
+a height instead of a width; the parameter |m| is interpreted as in |hpack|.
+
+@d exactly=0 {a box dimension is pre-specified}
+@d additional=1 {a box dimension is increased from the natural one}
+@d natural==0,additional {shorthand for parameters to |hpack| and |vpack|}
+
+@ The parameters to |hpack| and |vpack| correspond to \TeX's primitives
+like `\.{\\hbox} \.{to} \.{300pt}', `\.{\\hbox} \.{spread} \.{10pt}'; note
+that `\.{\\hbox}' with no dimension following it is equivalent to
+`\.{\\hbox} \.{spread} \.{0pt}'. The |scan_spec| subroutine scans such
+constructions in the user's input, including the mandatory left brace that
+follows them, and it puts the specification onto |save_stack| so that the
+desired box can later be obtained by executing the following code:
+$$\vbox{\halign{#\hfil\cr
+|save_ptr:=save_ptr-2;|\cr
+|hpack(p,saved(1),saved(0)).|\cr}}$$
+Special care is necessary to ensure that the special |save_stack| codes
+are placed just below the new group code, because scanning can change
+|save_stack| when \.{\\csname} appears.
+
+@p procedure scan_spec(@!c:group_code;@!three_codes:boolean);
+ {scans a box specification and left brace}
+label found;
+var @!s:integer; {temporarily saved value}
+@!spec_code:exactly..additional;
+begin if three_codes then s:=saved(0);
+if scan_keyword("to") then spec_code:=exactly
+@.to@>
+else if scan_keyword("spread") then spec_code:=additional
+@.spread@>
+else begin spec_code:=additional; cur_val:=0;
+ goto found;
+ end;
+scan_normal_dimen;
+found: if three_codes then
+ begin saved(0):=s; incr(save_ptr);
+ end;
+saved(0):=spec_code; saved(1):=cur_val; save_ptr:=save_ptr+2;
+new_save_level(c); scan_left_brace;
+end;
+
+@ To figure out the glue setting, |hpack| and |vpack| determine how much
+stretchability and shrinkability are present, considering all four orders
+of infinity. The highest order of infinity that has a nonzero coefficient
+is then used as if no other orders were present.
+
+For example, suppose that the given list contains six glue nodes with
+the respective stretchabilities 3pt, 8fill, 5fil, 6pt, $-3$fil, $-8$fill.
+Then the total is essentially 2fil; and if a total additional space of 6pt
+is to be achieved by stretching, the actual amounts of stretch will be
+0pt, 0pt, 15pt, 0pt, $-9$pt, and 0pt, since only `fil' glue will be
+considered. (The `fill' glue is therefore not really stretching infinitely
+with respect to `fil'; nobody would actually want that to happen.)
+
+The arrays |total_stretch| and |total_shrink| are used to determine how much
+glue of each kind is present. A global variable |last_badness| is used
+to implement \.{\\badness}.
+
+@<Glob...@>=
+@!total_stretch, @!total_shrink: array[glue_ord] of scaled;
+ {glue found by |hpack| or |vpack|}
+@!last_badness:integer; {badness of the most recently packaged box}
+
+@ If the global variable |adjust_tail| is non-null, the |hpack| routine
+also removes all occurrences of |ins_node|, |mark_node|, and |adjust_node|
+items and appends the resulting material onto the list that ends at
+location |adjust_tail|.
+
+@< Glob...@>=
+@!adjust_tail:pointer; {tail of adjustment list}
+
+@ @<Set init...@>=adjust_tail:=null; last_badness:=0;
+
+@ Here now is |hpack|, which contains few if any surprises.
+
+@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+label reswitch, common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!q:pointer; {trails behind |p|}
+@!h,@!d,@!x:scaled; {height, depth, and natural width}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+@!f:internal_font_number; {the font in a |char_node|}
+@!i:four_quarters; {font information about a |char_node|}
+@!hd:eight_bits; {height and depth indices for a character}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+subtype(r):=min_quarterword; shift_amount(r):=0;
+q:=r+list_offset; link(q):=p;@/
+h:=0; @<Clear dimensions to zero@>;
+while p<>null do @<Examine node |p| in the hlist, taking account of its effect
+ on the dimensions of the new box, or moving it to the adjustment list;
+ then advance |p| to the next node@>;
+if adjust_tail<>null then link(adjust_tail):=null;
+height(r):=h; depth(r):=d;@/
+@<Determine the value of |width(r)| and the appropriate glue setting;
+ then |return| or |goto common_ending|@>;
+common_ending: @<Finish issuing a diagnostic message
+ for an overfull or underfull hbox@>;
+exit: hpack:=r;
+end;
+
+@ @<Clear dimensions to zero@>=
+d:=0; x:=0;
+total_stretch[normal]:=0; total_shrink[normal]:=0;
+total_stretch[fil]:=0; total_shrink[fil]:=0;
+total_stretch[fill]:=0; total_shrink[fill]:=0;
+total_stretch[filll]:=0; total_shrink[filll]:=0
+
+@ @<Examine node |p| in the hlist, taking account of its effect...@>=
+@^inner loop@>
+begin reswitch: while is_char_node(p) do
+ @<Incorporate character dimensions into the dimensions of
+ the hbox that will contain~it, then move to the next node@>;
+if p<>null then
+ begin case type(p) of
+ hlist_node,vlist_node,rule_node,unset_node:
+ @<Incorporate box dimensions into the dimensions of
+ the hbox that will contain~it@>;
+ ins_node,mark_node,adjust_node: if adjust_tail<>null then
+ @<Transfer node |p| to the adjustment list@>;
+ whatsit_node:@<Incorporate a whatsit node into an hbox@>;
+ glue_node:@<Incorporate glue into the horizontal totals@>;
+ kern_node,math_node: x:=x+width(p);
+ ligature_node: @<Make node |p| look like a |char_node|
+ and |goto reswitch|@>;
+ othercases do_nothing
+ endcases;@/
+ p:=link(p);
+ end;
+end
+
+
+@ @<Make node |p| look like a |char_node| and |goto reswitch|@>=
+begin mem[lig_trick]:=mem[lig_char(p)]; link(lig_trick):=link(p);
+p:=lig_trick; goto reswitch;
+end
+
+@ The code here implicitly uses the fact that running dimensions are
+indicated by |null_flag|, which will be ignored in the calculations
+because it is a highly negative number.
+
+@<Incorporate box dimensions into the dimensions of the hbox...@>=
+begin x:=x+width(p);
+if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+if height(p)-s>h then h:=height(p)-s;
+if depth(p)+s>d then d:=depth(p)+s;
+end
+
+@ The following code is part of \TeX's inner loop; i.e., adding another
+character of text to the user's input will cause each of these instructions
+to be exercised one more time.
+@^inner loop@>
+
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+x:=x+char_width(f)(i);@/
+s:=char_height(f)(hd);@+if s>h then h:=s;
+s:=char_depth(f)(hd);@+if s>d then d:=s;
+p:=link(p);
+end
+
+@ Although node |q| is not necessarily the immediate predecessor of node |p|,
+it always points to some node in the list preceding |p|. Thus, we can delete
+nodes by moving |q| when necessary. The algorithm takes linear time, and the
+extra computation does not intrude on the inner loop unless it is necessary
+to make a deletion.
+@^inner loop@>
+
+@<Transfer node |p| to the adjustment list@>=
+begin while link(q)<>p do q:=link(q);
+if type(p)=adjust_node then
+ begin link(adjust_tail):=adjust_ptr(p);
+ while link(adjust_tail)<>null do adjust_tail:=link(adjust_tail);
+ p:=link(p); free_node(link(q),small_node_size);
+ end
+else begin link(adjust_tail):=p; adjust_tail:=p; p:=link(p);
+ end;
+link(q):=p; p:=q;
+end
+
+@ @<Incorporate glue into the horizontal totals@>=
+begin g:=glue_ptr(p); x:=x+width(g);@/
+o:=stretch_order(g); total_stretch[o]:=total_stretch[o]+stretch(g);
+o:=shrink_order(g); total_shrink[o]:=total_shrink[o]+shrink(g);
+if subtype(p)>=a_leaders then
+ begin g:=leader_ptr(p);
+ if height(g)>h then h:=height(g);
+ if depth(g)>d then d:=depth(g);
+ end;
+end
+
+@ When we get to the present part of the program, |x| is the natural width
+of the box being packaged.
+
+@<Determine the value of |width(r)| and the appropriate glue setting...@>=
+if m=additional then w:=x+w;
+width(r):=w; x:=w-x; {now |x| is the excess to be made up}
+if x=0 then
+ begin glue_sign(r):=normal; glue_order(r):=normal;
+ set_glue_ratio_zero(glue_set(r));
+ return;
+ end
+else if x>0 then @<Determine horizontal glue stretch setting, then |return|
+ or \hbox{|goto common_ending|}@>
+else @<Determine horizontal glue shrink setting, then |return|
+ or \hbox{|goto common_ending|}@>
+
+@ @<Determine horizontal glue stretch setting...@>=
+begin @<Determine the stretch order@>;
+glue_order(r):=o; glue_sign(r):=stretching;
+if total_stretch[o]<>0 then glue_set(r):=unfloat(x/total_stretch[o])
+@^real division@>
+else begin glue_sign(r):=normal;
+ set_glue_ratio_zero(glue_set(r)); {there's nothing to stretch}
+ end;
+if o=normal then if list_ptr(r)<>null then
+ @<Report an underfull hbox and |goto common_ending|, if this box
+ is sufficiently bad@>;
+return;
+end
+
+@ @<Determine the stretch order@>=
+if total_stretch[filll]<>0 then o:=filll
+else if total_stretch[fill]<>0 then o:=fill
+else if total_stretch[fil]<>0 then o:=fil
+else o:=normal
+
+@ @<Report an underfull hbox and |goto common_ending|, if...@>=
+begin last_badness:=badness(x,total_stretch[normal]);
+if last_badness>hbadness then
+ begin print_ln;
+ if last_badness>100 then print_nl("Underfull")@+else print_nl("Loose");
+ print(" \hbox (badness "); print_int(last_badness);
+@.Underfull \\hbox...@>
+@.Loose \\hbox...@>
+ goto common_ending;
+ end;
+end
+
+@ In order to provide a decent indication of where an overfull or underfull
+box originated, we use a global variable |pack_begin_line| that is
+set nonzero only when |hpack| is being called by the paragraph builder
+or the alignment finishing routine.
+
+@<Glob...@>=
+@!pack_begin_line:integer; {source file line where the current paragraph
+ or alignment began; a negative value denotes alignment}
+
+@ @<Set init...@>=
+pack_begin_line:=0;
+
+@ @<Finish issuing a diagnostic message for an overfull or underfull hbox@>=
+if output_active then print(") has occurred while \output is active")
+else begin if pack_begin_line<>0 then
+ begin if pack_begin_line>0 then print(") in paragraph at lines ")
+ else print(") in alignment at lines ");
+ print_int(abs(pack_begin_line));
+ print("--");
+ end
+ else print(") detected at line ");
+ print_int(line);
+ end;
+print_ln;@/
+font_in_short_display:=null_font; short_display(list_ptr(r)); print_ln;@/
+begin_diagnostic; show_box(r); end_diagnostic(true)
+
+@ @<Determine horizontal glue shrink setting...@>=
+begin @<Determine the shrink order@>;
+glue_order(r):=o; glue_sign(r):=shrinking;
+if total_shrink[o]<>0 then glue_set(r):=unfloat((-x)/total_shrink[o])
+@^real division@>
+else begin glue_sign(r):=normal;
+ set_glue_ratio_zero(glue_set(r)); {there's nothing to shrink}
+ end;
+if (total_shrink[o]<-x)and(o=normal)and(list_ptr(r)<>null) then
+ begin last_badness:=1000000;
+ set_glue_ratio_one(glue_set(r)); {use the maximum shrinkage}
+ @<Report an overfull hbox and |goto common_ending|, if this box
+ is sufficiently bad@>;
+ end
+else if o=normal then if list_ptr(r)<>null then
+ @<Report a tight hbox and |goto common_ending|, if this box
+ is sufficiently bad@>;
+return;
+end
+
+@ @<Determine the shrink order@>=
+if total_shrink[filll]<>0 then o:=filll
+else if total_shrink[fill]<>0 then o:=fill
+else if total_shrink[fil]<>0 then o:=fil
+else o:=normal
+
+@ @<Report an overfull hbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
+ begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
+ begin while link(q)<>null do q:=link(q);
+ link(q):=new_rule;
+ width(link(q)):=overfull_rule;
+ end;
+ print_ln; print_nl("Overfull \hbox (");
+@.Overfull \\hbox...@>
+ print_scaled(-x-total_shrink[normal]); print("pt too wide");
+ goto common_ending;
+ end
+
+@ @<Report a tight hbox and |goto common_ending|, if...@>=
+begin last_badness:=badness(-x,total_shrink[normal]);
+if last_badness>hbadness then
+ begin print_ln; print_nl("Tight \hbox (badness "); print_int(last_badness);
+@.Tight \\hbox...@>
+ goto common_ending;
+ end;
+end
+
+@ The |vpack| subroutine is actually a special case of a slightly more
+general routine called |vpackage|, which has four parameters. The fourth
+parameter, which is |max_dimen| in the case of |vpack|, specifies the
+maximum depth of the page box that is constructed. The depth is first
+computed by the normal rules; if it exceeds this limit, the reference
+point is simply moved down until the limiting depth is attained.
+
+@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth}
+
+@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled):
+ pointer;
+label common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!w,@!d,@!x:scaled; {width, depth, and natural height}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
+subtype(r):=min_quarterword; shift_amount(r):=0;
+list_ptr(r):=p;@/
+w:=0; @<Clear dimensions to zero@>;
+while p<>null do @<Examine node |p| in the vlist, taking account of its effect
+ on the dimensions of the new box; then advance |p| to the next node@>;
+width(r):=w;
+if d>l then
+ begin x:=x+d-l; depth(r):=l;
+ end
+else depth(r):=d;
+@<Determine the value of |height(r)| and the appropriate glue setting;
+ then |return| or |goto common_ending|@>;
+common_ending: @<Finish issuing a diagnostic message
+ for an overfull or underfull vbox@>;
+exit: vpackage:=r;
+end;
+
+@ @<Examine node |p| in the vlist, taking account of its effect...@>=
+begin if is_char_node(p) then confusion("vpack")
+@:this can't happen vpack}{\quad vpack@>
+else case type(p) of
+ hlist_node,vlist_node,rule_node,unset_node:
+ @<Incorporate box dimensions into the dimensions of
+ the vbox that will contain~it@>;
+ whatsit_node:@<Incorporate a whatsit node into a vbox@>;
+ glue_node: @<Incorporate glue into the vertical totals@>;
+ kern_node: begin x:=x+d+width(p); d:=0;
+ end;
+ othercases do_nothing
+ endcases;
+p:=link(p);
+end
+
+@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
+begin x:=x+d+height(p); d:=depth(p);
+if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+if width(p)+s>w then w:=width(p)+s;
+end
+
+@ @<Incorporate glue into the vertical totals@>=
+begin x:=x+d; d:=0;@/
+g:=glue_ptr(p); x:=x+width(g);@/
+o:=stretch_order(g); total_stretch[o]:=total_stretch[o]+stretch(g);
+o:=shrink_order(g); total_shrink[o]:=total_shrink[o]+shrink(g);
+if subtype(p)>=a_leaders then
+ begin g:=leader_ptr(p);
+ if width(g)>w then w:=width(g);
+ end;
+end
+
+@ When we get to the present part of the program, |x| is the natural height
+of the box being packaged.
+
+@<Determine the value of |height(r)| and the appropriate glue setting...@>=
+if m=additional then h:=x+h;
+height(r):=h; x:=h-x; {now |x| is the excess to be made up}
+if x=0 then
+ begin glue_sign(r):=normal; glue_order(r):=normal;
+ set_glue_ratio_zero(glue_set(r));
+ return;
+ end
+else if x>0 then @<Determine vertical glue stretch setting, then |return|
+ or \hbox{|goto common_ending|}@>
+else @<Determine vertical glue shrink setting, then |return|
+ or \hbox{|goto common_ending|}@>
+
+@ @<Determine vertical glue stretch setting...@>=
+begin @<Determine the stretch order@>;
+glue_order(r):=o; glue_sign(r):=stretching;
+if total_stretch[o]<>0 then glue_set(r):=unfloat(x/total_stretch[o])
+@^real division@>
+else begin glue_sign(r):=normal;
+ set_glue_ratio_zero(glue_set(r)); {there's nothing to stretch}
+ end;
+if o=normal then if list_ptr(r)<>null then
+ @<Report an underfull vbox and |goto common_ending|, if this box
+ is sufficiently bad@>;
+return;
+end
+
+@ @<Report an underfull vbox and |goto common_ending|, if...@>=
+begin last_badness:=badness(x,total_stretch[normal]);
+if last_badness>vbadness then
+ begin print_ln;
+ if last_badness>100 then print_nl("Underfull")@+else print_nl("Loose");
+ print(" \vbox (badness "); print_int(last_badness);
+@.Underfull \\vbox...@>
+@.Loose \\vbox...@>
+ goto common_ending;
+ end;
+end
+
+@ @<Finish issuing a diagnostic message for an overfull or underfull vbox@>=
+if output_active then print(") has occurred while \output is active")
+else begin if pack_begin_line<>0 then {it's actually negative}
+ begin print(") in alignment at lines ");
+ print_int(abs(pack_begin_line));
+ print("--");
+ end
+ else print(") detected at line ");
+ print_int(line);
+ print_ln;@/
+ end;
+begin_diagnostic; show_box(r); end_diagnostic(true)
+
+@ @<Determine vertical glue shrink setting...@>=
+begin @<Determine the shrink order@>;
+glue_order(r):=o; glue_sign(r):=shrinking;
+if total_shrink[o]<>0 then glue_set(r):=unfloat((-x)/total_shrink[o])
+@^real division@>
+else begin glue_sign(r):=normal;
+ set_glue_ratio_zero(glue_set(r)); {there's nothing to shrink}
+ end;
+if (total_shrink[o]<-x)and(o=normal)and(list_ptr(r)<>null) then
+ begin last_badness:=1000000;
+ set_glue_ratio_one(glue_set(r)); {use the maximum shrinkage}
+ @<Report an overfull vbox and |goto common_ending|, if this box
+ is sufficiently bad@>;
+ end
+else if o=normal then if list_ptr(r)<>null then
+ @<Report a tight vbox and |goto common_ending|, if this box
+ is sufficiently bad@>;
+return;
+end
+
+@ @<Report an overfull vbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>vfuzz)or(vbadness<100) then
+ begin print_ln; print_nl("Overfull \vbox (");
+@.Overfull \\vbox...@>
+ print_scaled(-x-total_shrink[normal]); print("pt too high");
+ goto common_ending;
+ end
+
+@ @<Report a tight vbox and |goto common_ending|, if...@>=
+begin last_badness:=badness(-x,total_shrink[normal]);
+if last_badness>vbadness then
+ begin print_ln; print_nl("Tight \vbox (badness "); print_int(last_badness);
+@.Tight \\vbox...@>
+ goto common_ending;
+ end;
+end
+
+@ When a box is being appended to the current vertical list, the
+baselineskip calculation is handled by the |append_to_vlist| routine.
+
+@p procedure append_to_vlist(@!b:pointer);
+var d:scaled; {deficiency of space between baselines}
+@!p:pointer; {a new glue specification}
+begin if prev_depth>ignore_depth then
+ begin d:=width(baseline_skip)-prev_depth-height(b);
+ if d<line_skip_limit then p:=new_param_glue(line_skip_code)
+ else begin p:=new_skip_param(baseline_skip_code);
+ width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
+ end;
+ link(tail):=p; tail:=p;
+ end;
+link(tail):=b; tail:=b; prev_depth:=depth(b);
+end;
+
+@* \[34] Data structures for math mode.
+When \TeX\ reads a formula that is enclosed between \.\$'s, it constructs an
+{\sl mlist}, which is essentially a tree structure representing that
+formula. An mlist is a linear sequence of items, but we can regard it as
+a tree structure because mlists can appear within mlists. For example, many
+of the entries can be subscripted or superscripted, and such ``scripts''
+are mlists in their own right.
+
+An entire formula is parsed into such a tree before any of the actual
+typesetting is done, because the current style of type is usually not
+known until the formula has been fully scanned. For example, when the
+formula `\.{\$a+b \\over c+d\$}' is being read, there is no way to tell
+that `\.{a+b}' will be in script size until `\.{\\over}' has appeared.
+
+During the scanning process, each element of the mlist being built is
+classified as a relation, a binary operator, an open parenthesis, etc.,
+or as a construct like `\.{\\sqrt}' that must be built up. This classification
+appears in the mlist data structure.
+
+After a formula has been fully scanned, the mlist is converted to an hlist
+so that it can be incorporated into the surrounding text. This conversion is
+controlled by a recursive procedure that decides all of the appropriate
+styles by a ``top-down'' process starting at the outermost level and working
+in towards the subformulas. The formula is ultimately pasted together using
+combinations of horizontal and vertical boxes, with glue and penalty nodes
+inserted as necessary.
+
+An mlist is represented internally as a linked list consisting chiefly
+of ``noads'' (pronounced ``no-adds''), to distinguish them from the somewhat
+similar ``nodes'' in hlists and vlists. Certain kinds of ordinary nodes are
+allowed to appear in mlists together with the noads; \TeX\ tells the difference
+by means of the |type| field, since a noad's |type| is always greater than
+that of a node. An mlist does not contain character nodes, hlist nodes, vlist
+nodes, math nodes, ligature nodes,
+or unset nodes; in particular, each mlist item appears in the
+variable-size part of |mem|, so the |type| field is always present.
+
+@ Each noad is four or more words long. The first word contains the |type|
+and |subtype| and |link| fields that are already so familiar to us; the
+second, third, and fourth words are called the noad's |nucleus|, |subscr|,
+and |supscr| fields.
+
+Consider, for example, the simple formula `\.{\$x\^2\$}', which would be
+parsed into an mlist containing a single element called an |ord_noad|.
+The |nucleus| of this noad is a representation of `\.x', the |subscr| is
+empty, and the |supscr| is a representation of `\.2'.
+
+The |nucleus|, |subscr|, and |supscr| fields are further broken into
+subfields. If |p| points to a noad, and if |q| is one of its principal
+fields (e.g., |q=subscr(p)|), there are several possibilities for the
+subfields, depending on the |math_type| of |q|.
+
+\yskip\hang|math_type(q)=math_char| means that |fam(q)| refers to one of
+the sixteen font families, and |character(q)| is the number of a character
+within a font of that family, as in a character node.
+
+\yskip\hang|math_type(q)=math_text_char| is similar, but the character is
+unsubscripted and unsuperscripted and it is followed immediately by another
+character from the same font. (This |math_type| setting appears only
+briefly during the processing; it is used to suppress unwanted italic
+corrections.)
+
+\yskip\hang|math_type(q)=empty| indicates a field with no value (the
+corresponding attribute of noad |p| is not present).
+
+\yskip\hang|math_type(q)=sub_box| means that |info(q)| points to a box
+node (either an |hlist_node| or a |vlist_node|) that should be used as the
+value of the field. The |shift_amount| in the subsidiary box node is the
+amount by which that box will be shifted downward.
+
+\yskip\hang|math_type(q)=sub_mlist| means that |info(q)| points to
+an mlist; the mlist must be converted to an hlist in order to obtain
+the value of this field.
+
+\yskip\noindent In the latter case, we might have |info(q)=null|. This
+is not the same as |math_type(q)=empty|; for example, `\.{\$P\_\{\}\$}'
+and `\.{\$P\$}' produce different results (the former will not have the
+``italic correction'' added to the width of |P|, but the ``script skip''
+will be added).
+
+The definitions of subfields given here are evidently wasteful of space,
+since a halfword is being used for the |math_type| although only three
+bits would be needed. However, there are hardly ever many noads present at
+once, since they are soon converted to nodes that take up even more space,
+so we can afford to represent them in whatever way simplifies the
+programming.
+
+@d noad_size=4 {number of words in a normal noad}
+@d nucleus(#)==#+1 {the |nucleus| field of a noad}
+@d supscr(#)==#+2 {the |supscr| field of a noad}
+@d subscr(#)==#+3 {the |subscr| field of a noad}
+@d math_type==link {a |halfword| in |mem|}
+@d fam==font {a |quarterword| in |mem|}
+@d math_char=1 {|math_type| when the attribute is simple}
+@d sub_box=2 {|math_type| when the attribute is a box}
+@d sub_mlist=3 {|math_type| when the attribute is a formula}
+@d math_text_char=4 {|math_type| when italic correction is dubious}
+
+@ Each portion of a formula is classified as Ord, Op, Bin, Rel, Ope,
+Clo, Pun, or Inn, for purposes of spacing and line breaking. An
+|ord_noad|, |op_noad|, |bin_noad|, |rel_noad|, |open_noad|, |close_noad|,
+|punct_noad|, or |inner_noad| is used to represent portions of the various
+types. For example, an `\.=' sign in a formula leads to the creation of a
+|rel_noad| whose |nucleus| field is a representation of an equals sign
+(usually |fam=0|, |character=@'75|). A formula preceded by \.{\\mathrel}
+also results in a |rel_noad|. When a |rel_noad| is followed by an
+|op_noad|, say, and possibly separated by one or more ordinary nodes (not
+noads), \TeX\ will insert a penalty node (with the current |rel_penalty|)
+just after the formula that corresponds to the |rel_noad|, unless there
+already was a penalty immediately following; and a ``thick space'' will be
+inserted just before the formula that corresponds to the |op_noad|.
+
+A noad of type |ord_noad|, |op_noad|, \dots, |inner_noad| usually
+has a |subtype=normal|. The only exception is that an |op_noad| might
+have |subtype=limits| or |no_limits|, if the normal positioning of
+limits has been overridden for this operator.
+
+@d ord_noad=unset_node+3 {|type| of a noad classified Ord}
+@d op_noad=ord_noad+1 {|type| of a noad classified Op}
+@d bin_noad=ord_noad+2 {|type| of a noad classified Bin}
+@d rel_noad=ord_noad+3 {|type| of a noad classified Rel}
+@d open_noad=ord_noad+4 {|type| of a noad classified Ope}
+@d close_noad=ord_noad+5 {|type| of a noad classified Clo}
+@d punct_noad=ord_noad+6 {|type| of a noad classified Pun}
+@d inner_noad=ord_noad+7 {|type| of a noad classified Inn}
+@d limits=1 {|subtype| of |op_noad| whose scripts are to be above, below}
+@d no_limits=2 {|subtype| of |op_noad| whose scripts are to be normal}
+
+@ A |radical_noad| is five words long; the fifth word is the |left_delimiter|
+field, which usually represents a square root sign.
+
+A |fraction_noad| is six words long; it has a |right_delimiter| field
+as well as a |left_delimiter|.
+
+Delimiter fields are of type |four_quarters|, and they have four subfields
+called |small_fam|, |small_char|, |large_fam|, |large_char|. These subfields
+represent variable-size delimiters by giving the ``small'' and ``large''
+starting characters, as explained in Chapter~17 of {\sl The \TeX book}.
+@:TeXbook}{\sl The \TeX book@>
+
+A |fraction_noad| is actually quite different from all other noads. Not
+only does it have six words, it has |thickness|, |denominator|, and
+|numerator| fields instead of |nucleus|, |subscr|, and |supscr|. The
+|thickness| is a scaled value that tells how thick to make a fraction
+rule; however, the special value |default_code| is used to stand for the
+|default_rule_thickness| of the current size. The |numerator| and
+|denominator| point to mlists that define a fraction; we always have
+$$\hbox{|math_type(numerator)=math_type(denominator)=sub_mlist|}.$$ The
+|left_delimiter| and |right_delimiter| fields specify delimiters that will
+be placed at the left and right of the fraction. In this way, a
+|fraction_noad| is able to represent all of \TeX's operators \.{\\over},
+\.{\\atop}, \.{\\above}, \.{\\overwithdelims}, \.{\\atopwithdelims}, and
+ \.{\\abovewithdelims}.
+
+@d left_delimiter(#)==#+4 {first delimiter field of a noad}
+@d right_delimiter(#)==#+5 {second delimiter field of a fraction noad}
+@d radical_noad=inner_noad+1 {|type| of a noad for square roots}
+@d radical_noad_size=5 {number of |mem| words in a radical noad}
+@d fraction_noad=radical_noad+1 {|type| of a noad for generalized fractions}
+@d fraction_noad_size=6 {number of |mem| words in a fraction noad}
+@d small_fam(#)==mem[#].qqqq.b0 {|fam| for ``small'' delimiter}
+@d small_char(#)==mem[#].qqqq.b1 {|character| for ``small'' delimiter}
+@d large_fam(#)==mem[#].qqqq.b2 {|fam| for ``large'' delimiter}
+@d large_char(#)==mem[#].qqqq.b3 {|character| for ``large'' delimiter}
+@d thickness==width {|thickness| field in a fraction noad}
+@d default_code==@'10000000000 {denotes |default_rule_thickness|}
+@d numerator==supscr {|numerator| field in a fraction noad}
+@d denominator==subscr {|denominator| field in a fraction noad}
+
+@ The global variable |empty_field| is set up for initialization of empty
+fields in new noads. Similarly, |null_delimiter| is for the initialization
+of delimiter fields.
+
+@<Glob...@>=
+@!empty_field:two_halves;
+@!null_delimiter:four_quarters;
+
+@ @<Set init...@>=
+empty_field.rh:=empty; empty_field.lh:=null;@/
+null_delimiter.b0:=0; null_delimiter.b1:=min_quarterword;@/
+null_delimiter.b2:=0; null_delimiter.b3:=min_quarterword;
+
+@ The |new_noad| function creates an |ord_noad| that is completely null.
+
+@p function new_noad:pointer;
+var p:pointer;
+begin p:=get_node(noad_size);
+type(p):=ord_noad; subtype(p):=normal;
+mem[nucleus(p)].hh:=empty_field;
+mem[subscr(p)].hh:=empty_field;
+mem[supscr(p)].hh:=empty_field;
+new_noad:=p;
+end;
+
+@ A few more kinds of noads will complete the set: An |under_noad| has its
+nucleus underlined; an |over_noad| has it overlined. An |accent_noad| places
+an accent over its nucleus; the accent character appears as
+|fam(accent_chr(p))| and |character(accent_chr(p))|. A |vcenter_noad|
+centers its nucleus vertically with respect to the axis of the formula;
+in such noads we always have |math_type(nucleus(p))=sub_box|.
+
+And finally, we have |left_noad| and |right_noad| types, to implement
+\TeX's \.{\\left} and \.{\\right}. The |nucleus| of such noads is
+replaced by a |delimiter| field; thus, for example, `\.{\\left(}' produces
+a |left_noad| such that |delimiter(p)| holds the family and character
+codes for all left parentheses. A |left_noad| never appears in an mlist
+except as the first element, and a |right_noad| never appears in an mlist
+except as the last element; furthermore, we either have both a |left_noad|
+and a |right_noad|, or neither one is present. The |subscr| and |supscr|
+fields are always |empty| in a |left_noad| and a |right_noad|.
+
+@d under_noad=fraction_noad+1 {|type| of a noad for underlining}
+@d over_noad=under_noad+1 {|type| of a noad for overlining}
+@d accent_noad=over_noad+1 {|type| of a noad for accented subformulas}
+@d accent_noad_size=5 {number of |mem| words in an accent noad}
+@d accent_chr(#)==#+4 {the |accent_chr| field of an accent noad}
+@d vcenter_noad=accent_noad+1 {|type| of a noad for \.{\\vcenter}}
+@d left_noad=vcenter_noad+1 {|type| of a noad for \.{\\left}}
+@d right_noad=left_noad+1 {|type| of a noad for \.{\\right}}
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@d scripts_allowed(#)==(type(#)>=ord_noad)and(type(#)<left_noad)
+
+@ Math formulas can also contain instructions like \.{\\textstyle} that
+override \TeX's normal style rules. A |style_node| is inserted into the
+data structure to record such instructions; it is three words long, so it
+is considered a node instead of a noad. The |subtype| is either |display_style|
+or |text_style| or |script_style| or |script_script_style|. The
+second and third words of a |style_node| are not used, but they are
+present because a |choice_node| is converted to a |style_node|.
+
+\TeX\ uses even numbers 0, 2, 4, 6 to encode the basic styles
+|display_style|, \dots, |script_script_style|, and adds~1 to get the
+``cramped'' versions of these styles. This gives a numerical order that
+is backwards from the convention of Appendix~G in {\sl The \TeX book\/};
+i.e., a smaller style has a larger numerical value.
+@:TeXbook}{\sl The \TeX book@>
+
+@d style_node=unset_node+1 {|type| of a style node}
+@d style_node_size=3 {number of words in a style node}
+@d display_style=0 {|subtype| for \.{\\displaystyle}}
+@d text_style=2 {|subtype| for \.{\\textstyle}}
+@d script_style=4 {|subtype| for \.{\\scriptstyle}}
+@d script_script_style=6 {|subtype| for \.{\\scriptscriptstyle}}
+@d cramped=1 {add this to an uncramped style if you want to cramp it}
+
+@p function new_style(@!s:small_number):pointer; {create a style node}
+var p:pointer; {the new node}
+begin p:=get_node(style_node_size); type(p):=style_node;
+subtype(p):=s; width(p):=0; depth(p):=0; {the |width| and |depth| are not used}
+new_style:=p;
+end;
+
+@ Finally, the \.{\\mathchoice} primitive creates a |choice_node|, which
+has special subfields |display_mlist|, |text_mlist|, |script_mlist|,
+and |script_script_mlist| pointing to the mlists for each style.
+
+@d choice_node=unset_node+2 {|type| of a choice node}
+@d display_mlist(#)==info(#+1) {mlist to be used in display style}
+@d text_mlist(#)==link(#+1) {mlist to be used in text style}
+@d script_mlist(#)==info(#+2) {mlist to be used in script style}
+@d script_script_mlist(#)==link(#+2) {mlist to be used in scriptscript style}
+
+@p function new_choice:pointer; {create a choice node}
+var p:pointer; {the new node}
+begin p:=get_node(style_node_size); type(p):=choice_node;
+subtype(p):=0; {the |subtype| is not used}
+display_mlist(p):=null; text_mlist(p):=null; script_mlist(p):=null;
+script_script_mlist(p):=null;
+new_choice:=p;
+end;
+
+@ Let's consider now the previously unwritten part of |show_node_list|
+that displays the things that can only be present in mlists; this
+program illustrates how to access the data structures just defined.
+
+In the context of the following program, |p| points to a node or noad that
+should be displayed, and the current string contains the ``recursion history''
+that leads to this point. The recursion history consists of a dot for each
+outer level in which |p| is subsidiary to some node, or in which |p| is
+subsidiary to the |nucleus| field of some noad; the dot is replaced by
+`\.\_' or `\.\^' or `\./' or `\.\\' if |p| is descended from the |subscr|
+or |supscr| or |denominator| or |numerator| fields of noads. For example,
+the current string would be `\.{.\^.\_/}' if |p| points to the |ord_noad| for
+|x| in the (ridiculous) formula
+`\.{\$\\sqrt\{a\^\{\\mathinner\{b\_\{c\\over x+y\}\}\}\}\$}'.
+
+@<Cases of |show_node_list| that arise...@>=
+style_node:print_style(subtype(p));
+choice_node:@<Display choice node |p|@>;
+ord_noad,op_noad,bin_noad,rel_noad,open_noad,close_noad,punct_noad,inner_noad,
+ radical_noad,over_noad,under_noad,vcenter_noad,accent_noad,
+ left_noad,right_noad:@<Display normal noad |p|@>;
+fraction_noad:@<Display fraction noad |p|@>;
+
+@ Here are some simple routines used in the display of noads.
+
+@<Declare procedures needed for displaying the elements of mlists@>=
+procedure print_fam_and_char(@!p:pointer); {prints family and character}
+begin print_esc("fam"); print_int(fam(p)); print_char(" ");
+print_ASCII(qo(character(p)));
+end;
+@#
+procedure print_delimiter(@!p:pointer); {prints a delimiter as 24-bit hex value}
+var a:integer; {accumulator}
+begin a:=small_fam(p)*256+qo(small_char(p));
+a:=a*@"1000+large_fam(p)*256+qo(large_char(p));
+if a<0 then print_int(a) {this should never happen}
+else print_hex(a);
+end;
+
+@ The next subroutine will descend to another level of recursion when a
+subsidiary mlist needs to be displayed. The parameter |c| indicates what
+character is to become part of the recursion history. An empty mlist is
+distinguished from a field with |math_type(p)=empty|, because these are
+not equivalent (as explained above).
+@^recursion@>
+
+@<Declare procedures needed for displaying...@>=
+procedure@?show_info; forward;@t\2@>@?{|show_node_list(info(temp_ptr))|}
+procedure print_subsidiary_data(@!p:pointer;@!c:ASCII_code);
+ {display a noad field}
+begin if cur_length>=depth_threshold then
+ begin if math_type(p)<>empty then print(" []");
+ end
+else begin append_char(c); {include |c| in the recursion history}
+ temp_ptr:=p; {prepare for |show_info| if recursion is needed}
+ case math_type(p) of
+ math_char: begin print_ln; print_current_string; print_fam_and_char(p);
+ end;
+ sub_box: show_info; {recursive call}
+ sub_mlist: if info(p)=null then
+ begin print_ln; print_current_string; print("{}");
+ end
+ else show_info; {recursive call}
+ othercases do_nothing {|empty|}
+ endcases;@/
+ flush_char; {remove |c| from the recursion history}
+ end;
+end;
+
+@ The inelegant introduction of |show_info| in the code above seems better
+than the alternative of using \PASCAL's strange |forward| declaration for a
+procedure with parameters. The \PASCAL\ convention about dropping parameters
+from a post-|forward| procedure is, frankly, so intolerable to the author
+of \TeX\ that he would rather stoop to communication via a global temporary
+variable. (A similar stoopidity occurred with respect to |hlist_out| and
+|vlist_out| above, and it will occur with respect to |mlist_to_hlist| below.)
+@^Knuth, Donald Ervin@>
+@:PASCAL}{\PASCAL@>
+
+@p procedure show_info; {the reader will kindly forgive this}
+begin show_node_list(info(temp_ptr));
+end;
+
+@ @<Declare procedures needed for displaying...@>=
+procedure print_style(@!c:integer);
+begin case c div 2 of
+0: print_esc("displaystyle"); {|display_style=0|}
+1: print_esc("textstyle"); {|text_style=2|}
+2: print_esc("scriptstyle"); {|script_style=4|}
+3: print_esc("scriptscriptstyle"); {|script_script_style=6|}
+othercases print("Unknown style!")
+endcases;
+end;
+
+@ @<Display choice node |p|@>=
+begin print_esc("mathchoice");
+append_char("D"); show_node_list(display_mlist(p)); flush_char;
+append_char("T"); show_node_list(text_mlist(p)); flush_char;
+append_char("S"); show_node_list(script_mlist(p)); flush_char;
+append_char("s"); show_node_list(script_script_mlist(p)); flush_char;
+end
+
+@ @<Display normal noad |p|@>=
+begin case type(p) of
+ord_noad: print_esc("mathord");
+op_noad: print_esc("mathop");
+bin_noad: print_esc("mathbin");
+rel_noad: print_esc("mathrel");
+open_noad: print_esc("mathopen");
+close_noad: print_esc("mathclose");
+punct_noad: print_esc("mathpunct");
+inner_noad: print_esc("mathinner");
+over_noad: print_esc("overline");
+under_noad: print_esc("underline");
+vcenter_noad: print_esc("vcenter");
+radical_noad: begin print_esc("radical"); print_delimiter(left_delimiter(p));
+ end;
+accent_noad: begin print_esc("accent"); print_fam_and_char(accent_chr(p));
+ end;
+left_noad: begin print_esc("left"); print_delimiter(nucleus(p));
+ end;
+right_noad: begin print_esc("right"); print_delimiter(nucleus(p));
+ end;
+end;
+if subtype(p)<>normal then
+ if subtype(p)=limits then print_esc("limits")
+ else print_esc("nolimits");
+if type(p)<left_noad then print_subsidiary_data(nucleus(p),".");
+print_subsidiary_data(supscr(p),"^");
+print_subsidiary_data(subscr(p),"_");
+end
+
+@ @<Display fraction noad |p|@>=
+begin print_esc("fraction, thickness ");
+if thickness(p)=default_code then print("= default")
+else print_scaled(thickness(p));
+if (small_fam(left_delimiter(p))<>0)or@+
+ (small_char(left_delimiter(p))<>min_quarterword)or@|
+ (large_fam(left_delimiter(p))<>0)or@|
+ (large_char(left_delimiter(p))<>min_quarterword) then
+ begin print(", left-delimiter "); print_delimiter(left_delimiter(p));
+ end;
+if (small_fam(right_delimiter(p))<>0)or@|
+ (small_char(right_delimiter(p))<>min_quarterword)or@|
+ (large_fam(right_delimiter(p))<>0)or@|
+ (large_char(right_delimiter(p))<>min_quarterword) then
+ begin print(", right-delimiter "); print_delimiter(right_delimiter(p));
+ end;
+print_subsidiary_data(numerator(p),"\");
+print_subsidiary_data(denominator(p),"/");
+end
+
+@ That which can be displayed can also be destroyed.
+
+@<Cases of |flush_node_list| that arise...@>=
+style_node: begin free_node(p,style_node_size); goto done;
+ end;
+choice_node:begin flush_node_list(display_mlist(p));
+ flush_node_list(text_mlist(p));
+ flush_node_list(script_mlist(p));
+ flush_node_list(script_script_mlist(p));
+ free_node(p,style_node_size); goto done;
+ end;
+ord_noad,op_noad,bin_noad,rel_noad,open_noad,close_noad,punct_noad,inner_noad,
+ radical_noad,over_noad,under_noad,vcenter_noad,accent_noad:@t@>@;@/
+ begin if math_type(nucleus(p))>=sub_box then
+ flush_node_list(info(nucleus(p)));
+ if math_type(supscr(p))>=sub_box then
+ flush_node_list(info(supscr(p)));
+ if math_type(subscr(p))>=sub_box then
+ flush_node_list(info(subscr(p)));
+ if type(p)=radical_noad then free_node(p,radical_noad_size)
+ else if type(p)=accent_noad then free_node(p,accent_noad_size)
+ else free_node(p,noad_size);
+ goto done;
+ end;
+left_noad,right_noad: begin free_node(p,noad_size); goto done;
+ end;
+fraction_noad: begin flush_node_list(info(numerator(p)));
+ flush_node_list(info(denominator(p)));
+ free_node(p,fraction_noad_size); goto done;
+ end;
+
+@* \[35] Subroutines for math mode.
+In order to convert mlists to hlists, i.e., noads to nodes, we need several
+subroutines that are conveniently dealt with now.
+
+Let us first introduce the macros that make it easy to get at the parameters and
+other font information. A size code, which is a multiple of 16, is added to a
+family number to get an index into the table of internal font numbers
+for each combination of family and size. (Be alert: Size codes get
+larger as the type gets smaller.)
+
+@d text_size=0 {size code for the largest size in a family}
+@d script_size=16 {size code for the medium size in a family}
+@d script_script_size=32 {size code for the smallest size in a family}
+
+@<Basic printing procedures@>=
+procedure print_size(@!s:integer);
+begin if s=0 then print_esc("textfont")
+else if s=script_size then print_esc("scriptfont")
+else print_esc("scriptscriptfont");
+end;
+
+@ Before an mlist is converted to an hlist, \TeX\ makes sure that
+the fonts in family~2 have enough parameters to be math-symbol
+fonts, and that the fonts in family~3 have enough parameters to be
+math-extension fonts. The math-symbol parameters are referred to by using the
+following macros, which take a size code as their parameter; for example,
+|num1(cur_size)| gives the value of the |num1| parameter for the current size.
+@^parameters for symbols@>
+@^font parameters@>
+
+@d mathsy_end(#)==fam_fnt(2+#)]].sc
+@d mathsy(#)==font_info[#+param_base[mathsy_end
+@d math_x_height==mathsy(5) {height of `\.x'}
+@d math_quad==mathsy(6) {\.{18mu}}
+@d num1==mathsy(8) {numerator shift-up in display styles}
+@d num2==mathsy(9) {numerator shift-up in non-display, non-\.{\\atop}}
+@d num3==mathsy(10) {numerator shift-up in non-display \.{\\atop}}
+@d denom1==mathsy(11) {denominator shift-down in display styles}
+@d denom2==mathsy(12) {denominator shift-down in non-display styles}
+@d sup1==mathsy(13) {superscript shift-up in uncramped display style}
+@d sup2==mathsy(14) {superscript shift-up in uncramped non-display}
+@d sup3==mathsy(15) {superscript shift-up in cramped styles}
+@d sub1==mathsy(16) {subscript shift-down if superscript is absent}
+@d sub2==mathsy(17) {subscript shift-down if superscript is present}
+@d sup_drop==mathsy(18) {superscript baseline below top of large box}
+@d sub_drop==mathsy(19) {subscript baseline below bottom of large box}
+@d delim1==mathsy(20) {size of \.{\\atopwithdelims} delimiters
+ in display styles}
+@d delim2==mathsy(21) {size of \.{\\atopwithdelims} delimiters in non-displays}
+@d axis_height==mathsy(22) {height of fraction lines above the baseline}
+@d total_mathsy_params=22
+
+@ The math-extension parameters have similar macros, but the size code is
+omitted (since it is always |cur_size| when we refer to such parameters).
+@^parameters for symbols@>
+@^font parameters@>
+
+@d mathex(#)==font_info[#+param_base[fam_fnt(3+cur_size)]].sc
+@d default_rule_thickness==mathex(8) {thickness of \.{\\over} bars}
+@d big_op_spacing1==mathex(9) {minimum clearance above a displayed op}
+@d big_op_spacing2==mathex(10) {minimum clearance below a displayed op}
+@d big_op_spacing3==mathex(11) {minimum baselineskip above displayed op}
+@d big_op_spacing4==mathex(12) {minimum baselineskip below displayed op}
+@d big_op_spacing5==mathex(13) {padding above and below displayed limits}
+@d total_mathex_params=13
+
+@ We also need to compute the change in style between mlists and their
+subsidiaries. The following macros define the subsidiary style for
+an overlined nucleus (|cramped_style|), for a subscript or a superscript
+(|sub_style| or |sup_style|), or for a numerator or denominator (|num_style|
+or |denom_style|).
+
+@d cramped_style(#)==2*(# div 2)+cramped {cramp the style}
+@d sub_style(#)==2*(# div 4)+script_style+cramped {smaller and cramped}
+@d sup_style(#)==2*(# div 4)+script_style+(# mod 2) {smaller}
+@d num_style(#)==#+2-2*(# div 6) {smaller unless already script-script}
+@d denom_style(#)==2*(# div 2)+cramped+2-2*(# div 6) {smaller, cramped}
+
+@ When the style changes, the following piece of program computes associated
+information:
+
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
+begin if cur_style<script_style then cur_size:=text_size
+else cur_size:=16*((cur_style-text_style) div 2);
+cur_mu:=x_over_n(math_quad(cur_size),18);
+end
+
+@ Here is a function that returns a pointer to a rule node having a given
+thickness |t|. The rule will extend horizontally to the boundary of the vlist
+that eventually contains it.
+
+@p function fraction_rule(@!t:scaled):pointer;
+ {construct the bar for a fraction}
+var p:pointer; {the new node}
+begin p:=new_rule; height(p):=t; depth(p):=0; fraction_rule:=p;
+end;
+
+@ The |overbar| function returns a pointer to a vlist box that consists of
+a given box |b|, above which has been placed a kern of height |k| under a
+fraction rule of thickness |t| under additional space of height |t|.
+
+@p function overbar(@!b:pointer;@!k,@!t:scaled):pointer;
+var p,@!q:pointer; {nodes being constructed}
+begin p:=new_kern(k); link(p):=b; q:=fraction_rule(t); link(q):=p;
+p:=new_kern(t); link(p):=q; overbar:=vpack(p,natural);
+end;
+
+@ The |var_delimiter| function, which finds or constructs a sufficiently
+large delimiter, is the most interesting of the auxiliary functions that
+currently concern us. Given a pointer |d| to a delimiter field in some noad,
+together with a size code |s| and a vertical distance |v|, this function
+returns a pointer to a box that contains the smallest variant of |d| whose
+height plus depth is |v| or more. (And if no variant is large enough, it
+returns the largest available variant.) In particular, this routine will
+construct arbitrarily large delimiters from extensible components, if
+|d| leads to such characters.
+
+The value returned is a box whose |shift_amount| has been set so that
+the box is vertically centered with respect to the axis in the given size.
+If a built-up symbol is returned, the height of the box before shifting
+will be the height of its topmost component.
+
+@p@t\4@>@<Declare subprocedures for |var_delimiter|@>
+function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer;
+label found,continue;
+var b:pointer; {the box that will be constructed}
+@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
+@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
+@!m,@!n: integer; {the number of extensible pieces}
+@!u: scaled; {height-plus-depth of a tentative character}
+@!w: scaled; {largest height-plus-depth so far}
+@!q: four_quarters; {character info}
+@!hd: eight_bits; {height-depth byte}
+@!r: four_quarters; {extensible pieces}
+@!z: small_number; {runs through font family members}
+@!large_attempt: boolean; {are we trying the ``large'' variant?}
+begin f:=null_font; w:=0; large_attempt:=false;
+z:=small_fam(d); x:=small_char(d);
+loop@+ begin @<Look at the variants of |(z,x)|; set |f| and |c| whenever
+ a better character is found; |goto found| as soon as a
+ large enough variant is encountered@>;
+ if large_attempt then goto found; {there were none large enough}
+ large_attempt:=true; z:=large_fam(d); x:=large_char(d);
+ end;
+found: if f<>null_font then
+ @<Make variable |b| point to a box for |(f,c)|@>
+else begin b:=new_null_box;
+ width(b):=null_delimiter_space; {use this width if no delimiter was found}
+ end;
+shift_amount(b):=half(height(b)-depth(b)) - axis_height(s);
+var_delimiter:=b;
+end;
+
+@ The search process is complicated slightly by the facts that some of the
+characters might not be present in some of the fonts, and they might not
+be probed in increasing order of height.
+
+@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
+if (z<>0)or(x<>min_quarterword) then
+ begin z:=z+s+16;
+ repeat z:=z-16; g:=fam_fnt(z);
+ if g<>null_font then
+ @<Look at the list of characters starting with |x| in
+ font |g|; set |f| and |c| whenever
+ a better character is found; |goto found| as soon as a
+ large enough variant is encountered@>;
+ until z<16;
+ end
+
+@ @<Look at the list of characters starting with |x|...@>=
+begin y:=x;
+if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
+ begin continue: q:=char_info(g)(y);
+ if char_exists(q) then
+ begin if char_tag(q)=ext_tag then
+ begin f:=g; c:=y; goto found;
+ end;
+ hd:=height_depth(q);
+ u:=char_height(g)(hd)+char_depth(g)(hd);
+ if u>w then
+ begin f:=g; c:=y; w:=u;
+ if u>=v then goto found;
+ end;
+ if char_tag(q)=list_tag then
+ begin y:=rem_byte(q); goto continue;
+ end;
+ end;
+ end;
+end
+
+@ Here is a subroutine that creates a new box, whose list contains a
+single character, and whose width includes the italic correction for
+that character. The height or depth of the box will be negative, if
+the height or depth of the character is negative; thus, this routine
+may deliver a slightly different result than |hpack| would produce.
+
+@<Declare subprocedures for |var_delimiter|@>=
+function char_box(@!f:internal_font_number;@!c:quarterword):pointer;
+var q:four_quarters;
+@!hd:eight_bits; {|height_depth| byte}
+@!b,@!p:pointer; {the new box and its character node}
+begin q:=char_info(f)(c); hd:=height_depth(q);
+b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
+height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
+p:=get_avail; character(p):=c; font(p):=f; list_ptr(b):=p; char_box:=b;
+end;
+
+@ When the following code is executed, |char_tag(q)| will be equal to
+|ext_tag| if and only if a built-up symbol is supposed to be returned.
+
+@<Make variable |b| point to a box for |(f,c)|@>=
+if char_tag(q)=ext_tag then
+ @<Construct an extensible character in a new box |b|,
+ using recipe |rem_byte(q)| and font |f|@>
+else b:=char_box(f,c)
+
+@ When we build an extensible character, it's handy to have the
+following subroutine, which puts a given character on top
+of the characters already in box |b|:
+
+@<Declare subprocedures for |var_delimiter|@>=
+procedure stack_into_box(@!b:pointer;@!f:internal_font_number;
+ @!c:quarterword);
+var p:pointer; {new node placed into |b|}
+begin p:=char_box(f,c); link(p):=list_ptr(b); list_ptr(b):=p;
+height(b):=height(p);
+end;
+
+@ Another handy subroutine computes the height plus depth of
+a given character:
+
+@<Declare subprocedures for |var_delimiter|@>=
+function height_plus_depth(@!f:internal_font_number;@!c:quarterword):scaled;
+var q:four_quarters;
+@!hd:eight_bits; {|height_depth| byte}
+begin q:=char_info(f)(c); hd:=height_depth(q);
+height_plus_depth:=char_height(f)(hd)+char_depth(f)(hd);
+end;
+
+@ @<Construct an extensible...@>=
+begin b:=new_null_box;
+type(b):=vlist_node;
+r:=font_info[exten_base[f]+rem_byte(q)].qqqq;@/
+@<Compute the minimum suitable height, |w|, and the corresponding
+ number of extension steps, |n|; also set |width(b)|@>;
+c:=ext_bot(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+c:=ext_rep(r);
+for m:=1 to n do stack_into_box(b,f,c);
+c:=ext_mid(r);
+if c<>min_quarterword then
+ begin stack_into_box(b,f,c); c:=ext_rep(r);
+ for m:=1 to n do stack_into_box(b,f,c);
+ end;
+c:=ext_top(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+depth(b):=w-height(b);
+end
+
+@ The width of an extensible character is the width of the repeatable
+module. If this module does not have positive height plus depth,
+we don't use any copies of it, otherwise we use as few as possible
+(in groups of two if there is a middle part).
+
+@<Compute the minimum suitable height, |w|, and...@>=
+c:=ext_rep(r); u:=height_plus_depth(f,c);
+w:=0; q:=char_info(f)(c); width(b):=char_width(f)(q)+char_italic(f)(q);@/
+c:=ext_bot(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_mid(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_top(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+n:=0;
+if u>0 then while w<v do
+ begin w:=w+u; incr(n);
+ if ext_mid(r)<>min_quarterword then w:=w+u;
+ end
+
+@ The next subroutine is much simpler; it is used for numerators and
+denominators of fractions as well as for displayed operators and
+their limits above and below. It takes a given box~|b| and
+changes it so that the new box is centered in a box of width~|w|.
+The centering is done by putting \.{\\hss} glue at the left and right
+of the list inside |b|, then packaging the new box; thus, the
+actual box might not really be centered, if it already contains
+infinite glue.
+
+The given box might contain a single character whose italic correction
+has been added to the width of the box; in this case a compensating
+kern is inserted.
+
+@p function rebox(@!b:pointer;@!w:scaled):pointer;
+var p:pointer; {temporary register for list manipulation}
+@!f:internal_font_number; {font in a one-character box}
+@!v:scaled; {width of a character without italic correction}
+begin if (width(b)<>w)and(list_ptr(b)<>null) then
+ begin if type(b)=vlist_node then b:=hpack(b,natural);
+ p:=list_ptr(b);
+ if (is_char_node(p))and(link(p)=null) then
+ begin f:=font(p); v:=char_width(f)(char_info(f)(character(p)));
+ if v<>width(b) then link(p):=new_kern(width(b)-v);
+ end;
+ free_node(b,box_node_size);
+ b:=new_glue(ss_glue); link(b):=p;
+ while link(p)<>null do p:=link(p);
+ link(p):=new_glue(ss_glue);
+ rebox:=hpack(b,w,exactly);
+ end
+else begin width(b):=w; rebox:=b;
+ end;
+end;
+
+@ Here is a subroutine that creates a new glue specification from another
+one that is expressed in `\.{mu}', given the value of the math unit.
+
+@d mu_mult(#)==nx_plus_y(n,#,xn_over_d(#,f,@'200000))
+
+@p function math_glue(@!g:pointer;@!m:scaled):pointer;
+var p:pointer; {the new glue specification}
+@!n:integer; {integer part of |m|}
+@!f:scaled; {fraction part of |m|}
+begin n:=x_over_n(m,@'200000); f:=remainder;@/
+if f<0 then
+ begin decr(n); f:=f+@'200000;
+ end;
+p:=get_node(glue_spec_size);
+width(p):=mu_mult(width(g)); {convert \.{mu} to \.{pt}}
+stretch_order(p):=stretch_order(g);
+if stretch_order(p)=normal then stretch(p):=mu_mult(stretch(g))
+else stretch(p):=stretch(g);
+shrink_order(p):=shrink_order(g);
+if shrink_order(p)=normal then shrink(p):=mu_mult(shrink(g))
+else shrink(p):=shrink(g);
+math_glue:=p;
+end;
+
+@ The |math_kern| subroutine removes |mu_glue| from a kern node, given
+the value of the math unit.
+
+@p procedure math_kern(@!p:pointer;@!m:scaled);
+var @!n:integer; {integer part of |m|}
+@!f:scaled; {fraction part of |m|}
+begin if subtype(p)=mu_glue then
+ begin n:=x_over_n(m,@'200000); f:=remainder;@/
+ if f<0 then
+ begin decr(n); f:=f+@'200000;
+ end;
+ width(p):=mu_mult(width(p)); subtype(p):=explicit;
+ end;
+end;
+
+@ Sometimes it is necessary to destroy an mlist. The following
+subroutine empties the current list, assuming that |abs(mode)=mmode|.
+
+@p procedure flush_math;
+begin flush_node_list(link(head)); flush_node_list(incompleat_noad);
+link(head):=null; tail:=head; incompleat_noad:=null;
+end;
+
+@* \[36] Typesetting math formulas.
+\TeX's most important routine for dealing with formulas is called
+|mlist_to_hlist|. After a formula has been scanned and represented as an
+mlist, this routine converts it to an hlist that can be placed into a box
+or incorporated into the text of a paragraph. There are three implicit
+parameters, passed in global variables: |cur_mlist| points to the first
+node or noad in the given mlist (and it might be |null|); |cur_style| is a
+style code; and |mlist_penalties| is |true| if penalty nodes for potential
+line breaks are to be inserted into the resulting hlist. After
+|mlist_to_hlist| has acted, |link(temp_head)| points to the translated hlist.
+
+Since mlists can be inside mlists, the procedure is recursive. And since this
+is not part of \TeX's inner loop, the program has been written in a manner
+that stresses compactness over efficiency.
+@^recursion@>
+
+@<Glob...@>=
+@!cur_mlist:pointer; {beginning of mlist to be translated}
+@!cur_style:small_number; {style code at current place in the list}
+@!cur_size:small_number; {size code corresponding to |cur_style|}
+@!cur_mu:scaled; {the math unit width corresponding to |cur_size|}
+@!mlist_penalties:boolean; {should |mlist_to_hlist| insert penalties?}
+
+@ The recursion in |mlist_to_hlist| is due primarily to a subroutine
+called |clean_box| that puts a given noad field into a box using a given
+math style; |mlist_to_hlist| can call |clean_box|, which can call
+|mlist_to_hlist|.
+@^recursion@>
+
+The box returned by |clean_box| is ``clean'' in the
+sense that its |shift_amount| is zero.
+
+@p procedure@?mlist_to_hlist; forward;@t\2@>@/
+function clean_box(@!p:pointer;@!s:small_number):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:small_number; {|cur_style| to be restored}
+@!x:pointer; {box to be returned}
+@!r:pointer; {temporary pointer}
+begin case math_type(p) of
+math_char: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p];
+ end;
+sub_box: begin q:=info(p); goto found;
+ end;
+sub_mlist: cur_mlist:=info(p);
+othercases begin q:=new_null_box; goto found;
+ end
+endcases;@/
+save_style:=cur_style; cur_style:=s; mlist_penalties:=false;@/
+mlist_to_hlist; q:=link(temp_head); {recursive call}
+cur_style:=save_style; {restore the style}
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+found: if is_char_node(q)or(q=null) then x:=hpack(q,natural)
+ else if (link(q)=null)and(type(q)<=vlist_node)and(shift_amount(q)=0) then
+ x:=q {it's already clean}
+ else x:=hpack(q,natural);
+@<Simplify a trivial box@>;
+clean_box:=x;
+end;
+
+@ Here we save memory space in a common case.
+
+@<Simplify a trivial box@>=
+q:=list_ptr(x);
+if is_char_node(q) then
+ begin r:=link(q);
+ if r<>null then if link(r)=null then if not is_char_node(r) then
+ if type(r)=kern_node then {unneeded italic correction}
+ begin free_node(r,small_node_size); link(q):=null;
+ end;
+ end
+
+@ It is convenient to have a procedure that converts a |math_char|
+field to an ``unpacked'' form. The |fetch| routine sets |cur_f|, |cur_c|,
+and |cur_i| to the font code, character code, and character information bytes of
+a given noad field. It also takes care of issuing error messages for
+nonexistent characters; in such cases, |char_exists(cur_i)| will be |false|
+after |fetch| has acted, and the field will also have been reset to |empty|.
+
+@p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|}
+begin cur_c:=character(a); cur_f:=fam_fnt(fam(a)+cur_size);
+if cur_f=null_font then
+ @<Complain about an undefined family and set |cur_i| null@>
+else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
+ cur_i:=char_info(cur_f)(cur_c)
+ else cur_i:=null_character;
+ if not(char_exists(cur_i)) then
+ begin char_warning(cur_f,qo(cur_c));
+ math_type(a):=empty;
+ end;
+ end;
+end;
+
+@ @<Complain about an undefined family...@>=
+begin print_err(""); print_size(cur_size); print_char(" ");
+print_int(fam(a)); print(" is undefined (character ");
+print_ASCII(qo(cur_c)); print_char(")");
+help4("Somewhere in the math formula just ended, you used the")@/
+("stated character from an undefined font family. For example,")@/
+("plain TeX doesn't allow \it or \sl in subscripts. Proceed,")@/
+("and I'll try to forget that I needed that character.");
+error; cur_i:=null_character; math_type(a):=empty;
+end
+
+@ The outputs of |fetch| are placed in global variables.
+
+@<Glob...@>=
+@!cur_f:internal_font_number; {the |font| field of a |math_char|}
+@!cur_c:quarterword; {the |character| field of a |math_char|}
+@!cur_i:four_quarters; {the |char_info| of a |math_char|,
+ or a lig/kern instruction}
+
+@ We need to do a lot of different things, so |mlist_to_hlist| makes two
+passes over the given mlist.
+
+The first pass does most of the processing: It removes ``mu'' spacing from
+glue, it recursively evaluates all subsidiary mlists so that only the
+top-level mlist remains to be handled, it puts fractions and square roots
+and such things into boxes, it attaches subscripts and superscripts, and
+it computes the overall height and depth of the top-level mlist so that
+the size of delimiters for a |left_noad| and a |right_noad| will be known.
+The hlist resulting from each noad is recorded in that noad's |new_hlist|
+field, an integer field that replaces the |nucleus| or |thickness|.
+@^recursion@>
+
+The second pass eliminates all noads and inserts the correct glue and
+penalties between nodes.
+
+@d new_hlist(#)==mem[nucleus(#)].int {the translation of an mlist}
+
+@ Here is the overall plan of |mlist_to_hlist|, and the list of its
+local variables.
+
+@d done_with_noad=80 {go here when a noad has been fully translated}
+@d done_with_node=81 {go here when a node has been fully converted}
+@d check_dimensions=82 {go here to update |max_h| and |max_d|}
+@d delete_q=83 {go here to delete |q| and move to the next node}
+
+@p@t\4@>@<Declare math construction procedures@>
+procedure mlist_to_hlist;
+label reswitch, check_dimensions, done_with_noad, done_with_node, delete_q,
+ done;
+var mlist:pointer; {beginning of the given list}
+@!penalties:boolean; {should penalty nodes be inserted?}
+@!style:small_number; {the given style}
+@!save_style:small_number; {holds |cur_style| during recursion}
+@!q:pointer; {runs through the mlist}
+@!r:pointer; {the most recent noad preceding |q|}
+@!r_type:small_number; {the |type| of noad |r|, or |op_noad| if |r=null|}
+@!t:small_number; {the effective |type| of noad |q| during the second pass}
+@!p,@!x,@!y,@!z: pointer; {temporary registers for list construction}
+@!pen:integer; {a penalty to be inserted}
+@!s:small_number; {the size of a noad to be deleted}
+@!max_h,@!max_d:scaled; {maximum height and depth of the list translated so far}
+@!delta:scaled; {offset between subscript and superscript}
+begin mlist:=cur_mlist; penalties:=mlist_penalties;
+style:=cur_style; {tuck global parameters away as local variables}
+q:=mlist; r:=null; r_type:=op_noad; max_h:=0; max_d:=0;
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+while q<>null do @<Process node-or-noad |q| as much as possible in preparation
+ for the second pass of |mlist_to_hlist|, then move to the next
+ item in the mlist@>;
+@<Convert \(a)a final |bin_noad| to an |ord_noad|@>;
+@<Make a second pass over the mlist, removing all noads and inserting the
+ proper spacing and penalties@>;
+end;
+
+@ We use the fact that no character nodes appear in an mlist, hence
+the field |type(q)| is always present.
+
+@<Process node-or-noad...@>=
+begin @<Do first-pass processing based on |type(q)|; |goto done_with_noad|
+ if a noad has been fully processed, |goto check_dimensions| if it
+ has been translated into |new_hlist(q)|, or |goto done_with_node|
+ if a node has been fully processed@>;
+check_dimensions: z:=hpack(new_hlist(q),natural);
+if height(z)>max_h then max_h:=height(z);
+if depth(z)>max_d then max_d:=depth(z);
+free_node(z,box_node_size);
+done_with_noad: r:=q; r_type:=type(r);
+done_with_node: q:=link(q);
+end
+
+@ One of the things we must do on the first pass is change a |bin_noad| to
+an |ord_noad| if the |bin_noad| is not in the context of a binary operator.
+The values of |r| and |r_type| make this fairly easy.
+
+@<Do first-pass processing...@>=
+reswitch: delta:=0;
+case type(q) of
+bin_noad: case r_type of
+ bin_noad,op_noad,rel_noad,open_noad,punct_noad,left_noad:
+ begin type(q):=ord_noad; goto reswitch;
+ end;
+ othercases do_nothing
+ endcases;
+rel_noad,close_noad,punct_noad,right_noad: begin@t@>@;@/
+ @<Convert \(a)a final |bin_noad| to an |ord_noad|@>;
+ if type(q)=right_noad then goto done_with_noad;
+ end;
+@t\4@>@<Cases for noads that can follow a |bin_noad|@>@;
+@t\4@>@<Cases for nodes that can appear in an mlist, after which we
+ |goto done_with_node|@>@;
+othercases confusion("mlist1")
+@:this can't happen mlist1}{\quad mlist1@>
+endcases;@/
+@<Convert \(n)|nucleus(q)| to an hlist and attach the sub/superscripts@>
+
+@ @<Convert \(a)a final |bin_noad| to an |ord_noad|@>=
+if r_type=bin_noad then type(r):=ord_noad
+
+@ @<Cases for nodes that can appear in an mlist...@>=
+style_node: begin cur_style:=subtype(q);
+ @<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+ goto done_with_node;
+ end;
+choice_node: @<Change this node to a style node followed by the correct choice,
+ then |goto done_with_node|@>;
+ins_node,mark_node,adjust_node,
+ whatsit_node,penalty_node,disc_node: goto done_with_node;
+rule_node: begin if height(q)>max_h then max_h:=height(q);
+ if depth(q)>max_d then max_d:=depth(q); goto done_with_node;
+ end;
+glue_node: begin @<Convert \(m)math glue to ordinary glue@>;
+ goto done_with_node;
+ end;
+kern_node: begin math_kern(q,cur_mu); goto done_with_node;
+ end;
+
+@ @d choose_mlist(#)==begin p:=#(q); #(q):=null;@+end
+
+@<Change this node to a style node...@>=
+begin case cur_style div 2 of
+0: choose_mlist(display_mlist); {|display_style=0|}
+1: choose_mlist(text_mlist); {|text_style=2|}
+2: choose_mlist(script_mlist); {|script_style=4|}
+3: choose_mlist(script_script_mlist); {|script_script_style=6|}
+end; {there are no other cases}
+flush_node_list(display_mlist(q));
+flush_node_list(text_mlist(q));
+flush_node_list(script_mlist(q));
+flush_node_list(script_script_mlist(q));@/
+type(q):=style_node; subtype(q):=cur_style; width(q):=0; depth(q):=0;
+if p<>null then
+ begin z:=link(q); link(q):=p;
+ while link(p)<>null do p:=link(p);
+ link(p):=z;
+ end;
+goto done_with_node;
+end
+
+@ Conditional math glue (`\.{\\nonscript}') results in a |glue_node|
+pointing to |zero_glue|, with |subtype(q)=cond_math_glue|; in such a case
+the node following will be eliminated if it is a glue or kern node and if the
+current size is different from |text_size|. Unconditional math glue
+(`\.{\\muskip}') is converted to normal glue by multiplying the dimensions
+by |cur_mu|.
+@!@:non_script_}{\.{\\nonscript} primitive@>
+
+@<Convert \(m)math glue to ordinary glue@>=
+if subtype(q)=mu_glue then
+ begin x:=glue_ptr(q);
+ y:=math_glue(x,cur_mu); delete_glue_ref(x); glue_ptr(q):=y;
+ subtype(q):=normal;
+ end
+else if (cur_size<>text_size)and(subtype(q)=cond_math_glue) then
+ begin p:=link(q);
+ if p<>null then if (type(p)=glue_node)or(type(p)=kern_node) then
+ begin link(q):=link(p); link(p):=null; flush_node_list(p);
+ end;
+ end
+
+@ @<Cases for noads that can follow a |bin_noad|@>=
+left_noad: goto done_with_noad;
+fraction_noad: begin make_fraction(q); goto check_dimensions;
+ end;
+op_noad: begin delta:=make_op(q);
+ if subtype(q)=limits then goto check_dimensions;
+ end;
+ord_noad: make_ord(q);
+open_noad,inner_noad: do_nothing;
+radical_noad: make_radical(q);
+over_noad: make_over(q);
+under_noad: make_under(q);
+accent_noad: make_math_accent(q);
+vcenter_noad: make_vcenter(q);
+
+@ Most of the actual construction work of |mlist_to_hlist| is done
+by procedures with names
+like |make_fraction|, |make_radical|, etc. To illustrate
+the general setup of such procedures, let's begin with a couple of
+simple ones.
+
+@<Declare math...@>=
+procedure make_over(@!q:pointer);
+begin info(nucleus(q)):=@|
+ overbar(clean_box(nucleus(q),cramped_style(cur_style)),@|
+ 3*default_rule_thickness,default_rule_thickness);
+math_type(nucleus(q)):=sub_box;
+end;
+
+@ @<Declare math...@>=
+procedure make_under(@!q:pointer);
+var p,@!x,@!y: pointer; {temporary registers for box construction}
+@!delta:scaled; {overall height plus depth}
+begin x:=clean_box(nucleus(q),cur_style);
+p:=new_kern(3*default_rule_thickness); link(x):=p;
+link(p):=fraction_rule(default_rule_thickness);
+y:=vpack(x,natural);
+delta:=height(y)+depth(y)+default_rule_thickness;
+height(y):=height(x); depth(y):=delta-height(y);
+info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+end;
+
+@ @<Declare math...@>=
+procedure make_vcenter(@!q:pointer);
+var v:pointer; {the box that should be centered vertically}
+@!delta:scaled; {its height plus depth}
+begin v:=info(nucleus(q));
+if type(v)<>vlist_node then confusion("vcenter");
+@:this can't happen vcenter}{\quad vcenter@>
+delta:=height(v)+depth(v);
+height(v):=axis_height(cur_size)+half(delta);
+depth(v):=delta-height(v);
+end;
+
+@ According to the rules in the \.{DVI} file specifications, we ensure alignment
+@^square roots@>
+between a square root sign and the rule above its nucleus by assuming that the
+baseline of the square-root symbol is the same as the bottom of the rule. The
+height of the square-root symbol will be the thickness of the rule, and the
+depth of the square-root symbol should exceed or equal the height-plus-depth
+of the nucleus plus a certain minimum clearance~|clr|. The symbol will be
+placed so that the actual clearance is |clr| plus half the excess.
+
+@<Declare math...@>=
+procedure make_radical(@!q:pointer);
+var x,@!y:pointer; {temporary registers for box construction}
+@!delta,@!clr:scaled; {dimensions involved in the calculation}
+begin x:=clean_box(nucleus(q),cramped_style(cur_style));
+if cur_style<text_style then {display style}
+ clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
+else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
+ end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
+ default_rule_thickness);
+delta:=depth(y)-(height(x)+depth(x)+clr);
+if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
+shift_amount(y):=-(height(x)+clr);
+link(y):=overbar(x,clr,height(y));
+info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box;
+end;
+
+@ Slants are not considered when placing accents in math mode. The accenter is
+centered over the accentee, and the accent width is treated as zero with
+respect to the size of the final box.
+
+@<Declare math...@>=
+procedure make_math_accent(@!q:pointer);
+label done,done1;
+var p,@!x,@!y:pointer; {temporary registers for box construction}
+@!a:integer; {address of lig/kern instruction}
+@!c:quarterword; {accent character}
+@!f:internal_font_number; {its font}
+@!i:four_quarters; {its |char_info|}
+@!s:scaled; {amount to skew the accent to the right}
+@!h:scaled; {height of character being accented}
+@!delta:scaled; {space to remove between accent and accentee}
+@!w:scaled; {width of the accentee, not including sub/superscripts}
+begin fetch(accent_chr(q));
+if char_exists(cur_i) then
+ begin i:=cur_i; c:=cur_c; f:=cur_f;@/
+ @<Compute the amount of skew@>;
+ x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
+ @<Switch to a larger accent if available and appropriate@>;
+ if h<x_height(f) then delta:=h@+else delta:=x_height(f);
+ if (math_type(supscr(q))<>empty)or(math_type(subscr(q))<>empty) then
+ if math_type(nucleus(q))=math_char then
+ @<Swap the subscript and superscript into box |x|@>;
+ y:=char_box(f,c);
+ shift_amount(y):=s+half(w-width(y));
+ width(y):=0; p:=new_kern(-delta); link(p):=x; link(y):=p;
+ y:=vpack(y,natural); width(y):=width(x);
+ if height(y)<h then @<Make the height of box |y| equal to |h|@>;
+ info(nucleus(q)):=y;
+ math_type(nucleus(q)):=sub_box;
+ end;
+end;
+
+@ @<Make the height of box |y|...@>=
+begin p:=new_kern(h-height(y)); link(p):=list_ptr(y); list_ptr(y):=p;
+height(y):=h;
+end
+
+@ @<Switch to a larger accent if available and appropriate@>=
+loop@+ begin if char_tag(i)<>list_tag then goto done;
+ y:=rem_byte(i);
+ i:=char_info(f)(y);
+ if not char_exists(i) then goto done;
+ if char_width(f)(i)>w then goto done;
+ c:=y;
+ end;
+done:
+
+@ @<Compute the amount of skew@>=
+s:=0;
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin if qo(next_char(cur_i))=skew_char[cur_f] then
+ begin if op_byte(cur_i)>=kern_flag then
+ if skip_byte(cur_i)<=stop_flag then s:=char_kern(cur_f)(cur_i);
+ goto done1;
+ end;
+ if skip_byte(cur_i)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+ end;
+ end;
+ end;
+done1:
+
+@ @<Swap the subscript and superscript into box |x|@>=
+begin flush_node_list(x); x:=new_noad;
+mem[nucleus(x)]:=mem[nucleus(q)];
+mem[supscr(x)]:=mem[supscr(q)];
+mem[subscr(x)]:=mem[subscr(q)];@/
+mem[supscr(q)].hh:=empty_field;
+mem[subscr(q)].hh:=empty_field;@/
+math_type(nucleus(q)):=sub_mlist; info(nucleus(q)):=x;
+x:=clean_box(nucleus(q),cur_style); delta:=delta+height(x)-h; h:=height(x);
+end
+
+@ The |make_fraction| procedure is a bit different because it sets
+|new_hlist(q)| directly rather than making a sub-box.
+
+@<Declare math...@>=
+procedure make_fraction(@!q:pointer);
+var p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!delta,@!delta1,@!delta2,@!shift_up,@!shift_down,@!clr:scaled;
+ {dimensions for box calculations}
+begin if thickness(q)=default_code then thickness(q):=default_rule_thickness;
+@<Create equal-width boxes |x| and |z| for the numerator and denominator,
+ and compute the default amounts |shift_up| and |shift_down| by which they
+ are displaced from the baseline@>;
+if thickness(q)=0 then @<Adjust \(s)|shift_up| and |shift_down| for the case
+ of no fraction line@>
+else @<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>;
+@<Construct a vlist box for the fraction, according to |shift_up| and
+ |shift_down|@>;
+@<Put the \(f)fraction into a box with its delimiters, and make |new_hlist(q)|
+ point to it@>;
+end;
+
+@ @<Create equal-width boxes |x| and |z| for the numerator and denom...@>=
+x:=clean_box(numerator(q),num_style(cur_style));
+z:=clean_box(denominator(q),denom_style(cur_style));
+if width(x)<width(z) then x:=rebox(x,width(z))
+else z:=rebox(z,width(x));
+if cur_style<text_style then {display style}
+ begin shift_up:=num1(cur_size); shift_down:=denom1(cur_size);
+ end
+else begin shift_down:=denom2(cur_size);
+ if thickness(q)<>0 then shift_up:=num2(cur_size)
+ else shift_up:=num3(cur_size);
+ end
+
+@ The numerator and denominator must be separated by a certain minimum
+clearance, called |clr| in the following program. The difference between
+|clr| and the actual clearance is |2delta|.
+
+@<Adjust \(s)|shift_up| and |shift_down| for the case of no fraction line@>=
+begin if cur_style<text_style then clr:=7*default_rule_thickness
+else clr:=3*default_rule_thickness;
+delta:=half(clr-((shift_up-depth(x))-(height(z)-shift_down)));
+if delta>0 then
+ begin shift_up:=shift_up+delta;
+ shift_down:=shift_down+delta;
+ end;
+end
+
+@ In the case of a fraction line, the minimum clearance depends on the actual
+thickness of the line.
+
+@<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>=
+begin if cur_style<text_style then clr:=3*thickness(q)
+else clr:=thickness(q);
+delta:=half(thickness(q));
+delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
+delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
+if delta1>0 then shift_up:=shift_up+delta1;
+if delta2>0 then shift_down:=shift_down+delta2;
+end
+
+@ @<Construct a vlist box for the fraction...@>=
+v:=new_null_box; type(v):=vlist_node;
+height(v):=shift_up+height(x); depth(v):=depth(z)+shift_down;
+width(v):=width(x); {this also equals |width(z)|}
+if thickness(q)=0 then
+ begin p:=new_kern((shift_up-depth(x))-(height(z)-shift_down));
+ link(p):=z;
+ end
+else begin y:=fraction_rule(thickness(q));@/
+ p:=new_kern((axis_height(cur_size)-delta)-@|(height(z)-shift_down));@/
+ link(y):=p; link(p):=z;@/
+ p:=new_kern((shift_up-depth(x))-(axis_height(cur_size)+delta));
+ link(p):=y;
+ end;
+link(x):=p; list_ptr(v):=x
+
+@ @<Put the \(f)fraction into a box with its delimiters...@>=
+if cur_style<text_style then delta:=delim1(cur_size)
+else delta:=delim2(cur_size);
+x:=var_delimiter(left_delimiter(q), cur_size, delta); link(x):=v;@/
+z:=var_delimiter(right_delimiter(q), cur_size, delta); link(v):=z;@/
+new_hlist(q):=hpack(x,natural)
+
+@ If the nucleus of an |op_noad| is a single character, it is to be
+centered vertically with respect to the axis, after first being enlarged
+(via a character list in the font) if we are in display style. The normal
+convention for placing displayed limits is to put them above and below the
+operator in display style.
+
+The italic correction is removed from the character if there is a subscript
+and the limits are not being displayed. The |make_op|
+routine returns the value that should be used as an offset between
+subscript and superscript.
+
+After |make_op| has acted, |subtype(q)| will be |limits| if and only if
+the limits have been set above and below the operator. In that case,
+|new_hlist(q)| will already contain the desired final box.
+
+@<Declare math...@>=
+function make_op(@!q:pointer):scaled;
+var delta:scaled; {offset between subscript and superscript}
+@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!c:quarterword;@+@!i:four_quarters; {registers for character examination}
+@!shift_up,@!shift_down:scaled; {dimensions for box calculation}
+begin if (subtype(q)=normal)and(cur_style<text_style) then
+ subtype(q):=limits;
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+ if (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger}
+ begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
+ if char_exists(i) then
+ begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c;
+ end;
+ end;
+ delta:=char_italic(cur_f)(cur_i); x:=clean_box(nucleus(q),cur_style);
+ if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then
+ width(x):=width(x)-delta; {remove italic correction}
+ shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size);
+ {center vertically}
+ math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x;
+ end
+else delta:=0;
+if subtype(q)=limits then
+ @<Construct a box with limits above and below it, skewed by |delta|@>;
+make_op:=delta;
+end;
+
+@ The following program builds a vlist box |v| for displayed limits. The
+width of the box is not affected by the fact that the limits may be skewed.
+
+@<Construct a box with limits above and below it...@>=
+begin x:=clean_box(supscr(q),sup_style(cur_style));
+y:=clean_box(nucleus(q),cur_style);
+z:=clean_box(subscr(q),sub_style(cur_style));
+v:=new_null_box; type(v):=vlist_node; width(v):=width(y);
+if width(x)>width(v) then width(v):=width(x);
+if width(z)>width(v) then width(v):=width(z);
+x:=rebox(x,width(v)); y:=rebox(y,width(v)); z:=rebox(z,width(v));@/
+shift_amount(x):=half(delta); shift_amount(z):=-shift_amount(x);
+height(v):=height(y); depth(v):=depth(y);
+@<Attach the limits to |y| and adjust |height(v)|, |depth(v)| to
+ account for their presence@>;
+new_hlist(q):=v;
+end
+
+@ We use |shift_up| and |shift_down| in the following program for the
+amount of glue between the displayed operator |y| and its limits |x| and
+|z|. The vlist inside box |v| will consist of |x| followed by |y| followed
+by |z|, with kern nodes for the spaces between and around them.
+
+@<Attach the limits to |y| and adjust |height(v)|, |depth(v)|...@>=
+if math_type(supscr(q))=empty then
+ begin free_node(x,box_node_size); list_ptr(v):=y;
+ end
+else begin shift_up:=big_op_spacing3-depth(x);
+ if shift_up<big_op_spacing1 then shift_up:=big_op_spacing1;
+ p:=new_kern(shift_up); link(p):=y; link(x):=p;@/
+ p:=new_kern(big_op_spacing5); link(p):=x; list_ptr(v):=p;
+ height(v):=height(v)+big_op_spacing5+height(x)+depth(x)+shift_up;
+ end;
+if math_type(subscr(q))=empty then free_node(z,box_node_size)
+else begin shift_down:=big_op_spacing4-height(z);
+ if shift_down<big_op_spacing2 then shift_down:=big_op_spacing2;
+ p:=new_kern(shift_down); link(y):=p; link(p):=z;@/
+ p:=new_kern(big_op_spacing5); link(z):=p;
+ depth(v):=depth(v)+big_op_spacing5+height(z)+depth(z)+shift_down;
+ end
+
+@ A ligature found in a math formula does not create a |ligature_node|, because
+there is no question of hyphenation afterwards; the ligature will simply be
+stored in an ordinary |char_node|, after residing in an |ord_noad|.
+
+The |math_type| is converted to |math_text_char| here if we would not want to
+apply an italic correction to the current character unless it belongs
+to a math font (i.e., a font with |space=0|).
+
+No boundary characters enter into these ligatures.
+
+@<Declare math...@>=
+procedure make_ord(@!q:pointer);
+label restart,exit;
+var a:integer; {address of lig/kern instruction}
+@!p,@!r:pointer; {temporary registers for list manipulation}
+begin restart:@t@>@;@/
+if math_type(subscr(q))=empty then if math_type(supscr(q))=empty then
+ if math_type(nucleus(q))=math_char then
+ begin p:=link(q);
+ if p<>null then if (type(p)>=ord_noad)and(type(p)<=punct_noad) then
+ if math_type(nucleus(p))=math_char then
+ if fam(nucleus(p))=fam(nucleus(q)) then
+ begin math_type(nucleus(q)):=math_text_char;
+ fetch(nucleus(q));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_c:=character(nucleus(p));
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach
+ the kern after~|q|; or if it is a ligature with |cur_c|, combine
+ noads |q| and~|p| appropriately; then |return| if the cursor has
+ moved past a noad, or |goto restart|@>;
+ if skip_byte(cur_i)>=stop_flag then return;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+ end;
+ end;
+ end;
+ end;
+exit:end;
+
+@ Note that a ligature between an |ord_noad| and another kind of noad
+is replaced by an |ord_noad|, when the two noads collapse into one.
+But we could make a parenthesis (say) change shape when it follows
+certain letters. Presumably a font designer will define such
+ligatures only when this convention makes sense.
+
+\chardef\?='174 % vertical line to indicate character retention
+
+@<If instruction |cur_i| is a kern with |cur_c|, ...@>=
+if next_char(cur_i)=cur_c then if skip_byte(cur_i)<=stop_flag then
+ if op_byte(cur_i)>=kern_flag then
+ begin p:=new_kern(char_kern(cur_f)(cur_i));
+ link(p):=link(q); link(q):=p; return;
+ end
+ else begin check_interrupt; {allow a way out of infinite ligature loop}
+ case op_byte(cur_i) of
+ qi(1),qi(5): character(nucleus(q)):=rem_byte(cur_i); {\.{=:\?}, \.{=:\?>}}
+ qi(2),qi(6): character(nucleus(p)):=rem_byte(cur_i); {\.{\?=:}, \.{\?=:>}}
+ qi(3),qi(7),qi(11):begin r:=new_noad; {\.{\?=:\?}, \.{\?=:\?>}, \.{\?=:\?>>}}
+ character(nucleus(r)):=rem_byte(cur_i);
+ fam(nucleus(r)):=fam(nucleus(q));@/
+ link(q):=r; link(r):=p;
+ if op_byte(cur_i)<qi(11) then math_type(nucleus(r)):=math_char
+ else math_type(nucleus(r)):=math_text_char; {prevent combination}
+ end;
+ othercases begin link(q):=link(p);
+ character(nucleus(q)):=rem_byte(cur_i); {\.{=:}}
+ mem[subscr(q)]:=mem[subscr(p)]; mem[supscr(q)]:=mem[supscr(p)];@/
+ free_node(p,noad_size);
+ end
+ endcases;
+ if op_byte(cur_i)>qi(3) then return;
+ math_type(nucleus(q)):=math_char; goto restart;
+ end
+
+@ When we get to the following part of the program, we have ``fallen through''
+from cases that did not lead to |check_dimensions| or |done_with_noad| or
+|done_with_node|. Thus, |q|~points to a noad whose nucleus may need to be
+converted to an hlist, and whose subscripts and superscripts need to be
+appended if they are present.
+
+If |nucleus(q)| is not a |math_char|, the variable |delta| is the amount
+by which a superscript should be moved right with respect to a subscript
+when both are present.
+@^subscripts@>
+@^superscripts@>
+
+@<Convert \(n)|nucleus(q)| to an hlist and attach the sub/superscripts@>=
+case math_type(nucleus(q)) of
+math_char, math_text_char:
+ @<Create a character node |p| for |nucleus(q)|, possibly followed
+ by a kern node for the italic correction, and set |delta| to the
+ italic correction if a subscript is present@>;
+empty: p:=null;
+sub_box: p:=info(nucleus(q));
+sub_mlist: begin cur_mlist:=info(nucleus(q)); save_style:=cur_style;
+ mlist_penalties:=false; mlist_to_hlist; {recursive call}
+@^recursion@>
+ cur_style:=save_style; @<Set up the values...@>;
+ p:=hpack(link(temp_head),natural);
+ end;
+othercases confusion("mlist2")
+@:this can't happen mlist2}{\quad mlist2@>
+endcases;@/
+new_hlist(q):=p;
+if (math_type(subscr(q))=empty)and(math_type(supscr(q))=empty) then
+ goto check_dimensions;
+make_scripts(q,delta)
+
+@ @<Create a character node |p| for |nucleus(q)|...@>=
+begin fetch(nucleus(q));
+if char_exists(cur_i) then
+ begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c));
+ if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then
+ delta:=0; {no italic correction in mid-word of text font}
+ if (math_type(subscr(q))=empty)and(delta<>0) then
+ begin link(p):=new_kern(delta); delta:=0;
+ end;
+ end
+else p:=null;
+end
+
+@ The purpose of |make_scripts(q,delta)| is to attach the subscript and/or
+superscript of noad |q| to the list that starts at |new_hlist(q)|,
+given that subscript and superscript aren't both empty. The superscript
+will appear to the right of the subscript by a given distance |delta|.
+
+We set |shift_down| and |shift_up| to the minimum amounts to shift the
+baseline of subscripts and superscripts based on the given nucleus.
+
+@<Declare math...@>=
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:small_number; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural);
+ if cur_style<script_style then t:=script_size@+else t:=script_script_size;
+ shift_up:=height(z)-sup_drop(t);
+ shift_down:=depth(z)+sub_drop(t);
+ free_node(z,box_node_size);
+ end;
+if math_type(supscr(q))=empty then
+ @<Construct a subscript box |x| when there is no superscript@>
+else begin @<Construct a superscript box |x|@>;
+ if math_type(subscr(q))=empty then shift_amount(x):=-shift_up
+ else @<Construct a sub/superscript combination box |x|, with the
+ superscript offset by |delta|@>;
+ end;
+if new_hlist(q)=null then new_hlist(q):=x
+else begin p:=new_hlist(q);
+ while link(p)<>null do p:=link(p);
+ link(p):=x;
+ end;
+end;
+
+@ When there is a subscript without a superscript, the top of the subscript
+should not exceed the baseline plus four-fifths of the x-height.
+
+@<Construct a subscript box |x| when there is no superscript@>=
+begin x:=clean_box(subscr(q),sub_style(cur_style));
+width(x):=width(x)+script_space;
+if shift_down<sub1(cur_size) then shift_down:=sub1(cur_size);
+clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5);
+if shift_down<clr then shift_down:=clr;
+shift_amount(x):=shift_down;
+end
+
+@ The bottom of a superscript should never descend below the baseline plus
+one-fourth of the x-height.
+
+@<Construct a superscript box |x|@>=
+begin x:=clean_box(supscr(q),sup_style(cur_style));
+width(x):=width(x)+script_space;
+if odd(cur_style) then clr:=sup3(cur_size)
+else if cur_style<text_style then clr:=sup1(cur_size)
+else clr:=sup2(cur_size);
+if shift_up<clr then shift_up:=clr;
+clr:=depth(x)+(abs(math_x_height(cur_size)) div 4);
+if shift_up<clr then shift_up:=clr;
+end
+
+@ When both subscript and superscript are present, the subscript must be
+separated from the superscript by at least four times |default_rule_thickness|.
+If this condition would be violated, the subscript moves down, after which
+both subscript and superscript move up so that the bottom of the superscript
+is at least as high as the baseline plus four-fifths of the x-height.
+
+@<Construct a sub/superscript combination box |x|...@>=
+begin y:=clean_box(subscr(q),sub_style(cur_style));
+width(y):=width(y)+script_space;
+if shift_down<sub2(cur_size) then shift_down:=sub2(cur_size);
+clr:=4*default_rule_thickness-
+ ((shift_up-depth(x))-(height(y)-shift_down));
+if clr>0 then
+ begin shift_down:=shift_down+clr;
+ clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x));
+ if clr>0 then
+ begin shift_up:=shift_up+clr;
+ shift_down:=shift_down-clr;
+ end;
+ end;
+shift_amount(x):=delta; {superscript is |delta| to the right of the subscript}
+p:=new_kern((shift_up-depth(x))-(height(y)-shift_down)); link(x):=p; link(p):=y;
+x:=vpack(x,natural); shift_amount(x):=shift_down;
+end
+
+@ We have now tied up all the loose ends of the first pass of |mlist_to_hlist|.
+The second pass simply goes through and hooks everything together with the
+proper glue and penalties. It also handles the |left_noad| and |right_noad| that
+might be present, since |max_h| and |max_d| are now known. Variable |p| points
+to a node at the current end of the final hlist.
+
+@<Make a second pass over the mlist, ...@>=
+p:=temp_head; link(p):=null; q:=mlist; r_type:=0; cur_style:=style;
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+while q<>null do
+ begin @<If node |q| is a style node, change the style and |goto delete_q|;
+ otherwise if it is not a noad, put it into the hlist,
+ advance |q|, and |goto done|; otherwise set |s| to the size
+ of noad |q|, set |t| to the associated type (|ord_noad..
+ inner_noad|), and set |pen| to the associated penalty@>;
+ @<Append inter-element spacing based on |r_type| and |t|@>;
+ @<Append any |new_hlist| entries for |q|, and any appropriate penalties@>;
+ r_type:=t;
+ delete_q: r:=q; q:=link(q); free_node(r,s);
+ done: end
+
+@ Just before doing the big |case| switch in the second pass, the program
+sets up default values so that most of the branches are short.
+
+@<If node |q| is a style node, change the style...@>=
+t:=ord_noad; s:=noad_size; pen:=inf_penalty;
+case type(q) of
+op_noad,open_noad,close_noad,punct_noad,inner_noad: t:=type(q);
+bin_noad: begin t:=bin_noad; pen:=bin_op_penalty;
+ end;
+rel_noad: begin t:=rel_noad; pen:=rel_penalty;
+ end;
+ord_noad,vcenter_noad,over_noad,under_noad: do_nothing;
+radical_noad: s:=radical_noad_size;
+accent_noad: s:=accent_noad_size;
+fraction_noad: begin t:=inner_noad; s:=fraction_noad_size;
+ end;
+left_noad,right_noad: t:=make_left_right(q,style,max_d,max_h);
+style_node: @<Change the current style and |goto delete_q|@>;
+whatsit_node,penalty_node,rule_node,disc_node,adjust_node,ins_node,mark_node,
+ glue_node,kern_node:@t@>@;@/
+ begin link(p):=q; p:=q; q:=link(q); link(p):=null; goto done;
+ end;
+othercases confusion("mlist3")
+@:this can't happen mlist3}{\quad mlist3@>
+endcases
+
+@ The |make_left_right| function constructs a left or right delimiter of
+the required size and returns the value |open_noad| or |close_noad|. The
+|right_noad| and |left_noad| will both be based on the original |style|,
+so they will have consistent sizes.
+
+We use the fact that |right_noad-left_noad=close_noad-open_noad|.
+
+@<Declare math...@>=
+function make_left_right(@!q:pointer;@!style:small_number;
+ @!max_d,@!max_h:scaled):small_number;
+var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
+begin if style<script_style then cur_size:=text_size
+else cur_size:=16*((style-text_style) div 2);
+delta2:=max_d+axis_height(cur_size);
+delta1:=max_h+max_d-delta2;
+if delta2>delta1 then delta1:=delta2; {|delta1| is max distance from axis}
+delta:=(delta1 div 500)*delimiter_factor;
+delta2:=delta1+delta1-delimiter_shortfall;
+if delta<delta2 then delta:=delta2;
+new_hlist(q):=var_delimiter(delimiter(q),cur_size,delta);
+make_left_right:=type(q)-(left_noad-open_noad); {|open_noad| or |close_noad|}
+end;
+
+@ @<Change the current style and |goto delete_q|@>=
+begin cur_style:=subtype(q); s:=style_node_size;
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+goto delete_q;
+end
+
+@ The inter-element spacing in math formulas depends on a $8\times8$ table that
+\TeX\ preloads as a 64-digit string. The elements of this string have the
+following significance:
+$$\vbox{\halign{#\hfil\cr
+\.0 means no space;\cr
+\.1 means a conditional thin space (\.{\\nonscript\\mskip\\thinmuskip});\cr
+\.2 means a thin space (\.{\\mskip\\thinmuskip});\cr
+\.3 means a conditional medium space
+ (\.{\\nonscript\\mskip\\medmuskip});\cr
+\.4 means a conditional thick space
+ (\.{\\nonscript\\mskip\\thickmuskip});\cr
+\.* means an impossible case.\cr}}$$
+This is all pretty cryptic, but {\sl The \TeX book\/} explains what is
+supposed to happen, and the string makes it happen.
+@:TeXbook}{\sl The \TeX book@>
+
+A global variable |magic_offset| is computed so that if |a| and |b| are
+in the range |ord_noad..inner_noad|, then |str_pool[a*8+b+magic_offset]|
+is the digit for spacing between noad types |a| and |b|.
+
+If \PASCAL\ had provided a good way to preload constant arrays, this part of
+the program would not have been so strange.
+@:PASCAL}{\PASCAL@>
+
+@d math_spacing=@;@/
+@t\hskip-35pt@>
+"0234000122*4000133**3**344*0400400*000000234000111*1111112341011"
+@t$ \hskip-35pt$@>
+
+@<Glob...@>=
+@!magic_offset:integer; {used to find inter-element spacing}
+
+@ @<Compute the magic offset@>=
+magic_offset:=str_start[math_spacing]-9*ord_noad
+
+@ @<Append inter-element spacing based on |r_type| and |t|@>=
+if r_type>0 then {not the first noad}
+ begin case so(str_pool[r_type*8+t+magic_offset]) of
+ "0": x:=0;
+ "1": if cur_style<script_style then x:=thin_mu_skip_code@+else x:=0;
+ "2": x:=thin_mu_skip_code;
+ "3": if cur_style<script_style then x:=med_mu_skip_code@+else x:=0;
+ "4": if cur_style<script_style then x:=thick_mu_skip_code@+else x:=0;
+ othercases confusion("mlist4")
+@:this can't happen mlist4}{\quad mlist4@>
+ endcases;
+ if x<>0 then
+ begin y:=math_glue(glue_par(x),cur_mu);
+ z:=new_glue(y); glue_ref_count(y):=null; link(p):=z; p:=z;@/
+ subtype(z):=x+1; {store a symbolic subtype}
+ end;
+ end
+
+@ We insert a penalty node after the hlist entries of noad |q| if |pen|
+is not an ``infinite'' penalty, and if the node immediately following |q|
+is not a penalty node or a |rel_noad| or absent entirely.
+
+@<Append any |new_hlist| entries for |q|, and any appropriate penalties@>=
+if new_hlist(q)<>null then
+ begin link(p):=new_hlist(q);
+ repeat p:=link(p);
+ until link(p)=null;
+ end;
+if penalties then if link(q)<>null then if pen<inf_penalty then
+ begin r_type:=type(link(q));
+ if r_type<>penalty_node then if r_type<>rel_noad then
+ begin z:=new_penalty(pen); link(p):=z; p:=z;
+ end;
+ end
+
+@* \[37] Alignment.
+It's sort of a miracle whenever \.{\\halign} and \.{\\valign} work, because
+they cut across so many of the control structures of \TeX.
+
+Therefore the
+present page is probably not the best place for a beginner to start reading
+this program; it is better to master everything else first.
+
+Let us focus our thoughts on an example of what the input might be, in order
+to get some idea about how the alignment miracle happens. The example doesn't
+do anything useful, but it is sufficiently general to indicate all of the
+special cases that must be dealt with; please do not be disturbed by its
+apparent complexity and meaninglessness.
+$$\vbox{\halign{\.{#}\hfil\cr
+{}\\tabskip 2pt plus 3pt\cr
+{}\\halign to 300pt\{u1\#v1\&\cr
+\hskip 50pt\\tabskip 1pt plus 1fil u2\#v2\&\cr
+\hskip 50pt u3\#v3\\cr\cr
+\hskip 25pt a1\&\\omit a2\&\\vrule\\cr\cr
+\hskip 25pt \\noalign\{\\vskip 3pt\}\cr
+\hskip 25pt b1\\span b2\\cr\cr
+\hskip 25pt \\omit\&c2\\span\\omit\\cr\}\cr}}$$
+Here's what happens:
+
+\yskip
+(0) When `\.{\\halign to 300pt\{}' is scanned, the |scan_spec| routine
+places the 300pt dimension onto the |save_stack|, and an |align_group|
+code is placed above it. This will make it possible to complete the alignment
+when the matching `\.\}' is found.
+
+(1) The preamble is scanned next. Macros in the preamble are not expanded,
+@^preamble@>
+except as part of a tabskip specification. For example, if \.{u2} had been
+a macro in the preamble above, it would have been expanded, since \TeX\
+must look for `\.{minus...}' as part of the tabskip glue. A ``preamble list''
+is constructed based on the user's preamble; in our case it contains the
+following seven items:
+$$\vbox{\halign{\.{#}\hfil\qquad&(#)\hfil\cr
+{}\\glue 2pt plus 3pt&the tabskip preceding column 1\cr
+{}\\alignrecord, width $-\infty$&preamble info for column 1\cr
+{}\\glue 2pt plus 3pt&the tabskip between columns 1 and 2\cr
+{}\\alignrecord, width $-\infty$&preamble info for column 2\cr
+{}\\glue 1pt plus 1fil&the tabskip between columns 2 and 3\cr
+{}\\alignrecord, width $-\infty$&preamble info for column 3\cr
+{}\\glue 1pt plus 1fil&the tabskip following column 3\cr}}$$
+These ``alignrecord'' entries have the same size as an |unset_node|,
+since they will later be converted into such nodes. However, at the
+moment they have no |type| or |subtype| fields; they have |info| fields
+instead, and these |info| fields are initially set to the value |end_span|,
+for reasons explained below. Furthermore, the alignrecord nodes have no
+|height| or |depth| fields; these are renamed |u_part| and |v_part|,
+and they point to token lists for the templates of the alignment.
+For example, the |u_part| field in the first alignrecord points to the
+token list `\.{u1}', i.e., the template preceding the `\.\#' for column~1.
+
+(2) \TeX\ now looks at what follows the \.{\\cr} that ended the preamble.
+It is not `\.{\\noalign}' or `\.{\\omit}', so this input is put back to
+be read again, and the template `\.{u1}' is fed to the scanner. Just
+before reading `\.{u1}', \TeX\ goes into restricted horizontal mode.
+Just after reading `\.{u1}', \TeX\ will see `\.{a1}', and then (when the
+{\.\&} is sensed) \TeX\ will see `\.{v1}'. Then \TeX\ scans an |endv|
+token, indicating the end of a column. At this point an |unset_node| is
+created, containing the contents of the current hlist (i.e., `\.{u1a1v1}').
+The natural width of this unset node replaces the |width| field of the
+alignrecord for column~1; in general, the alignrecords will record the
+maximum natural width that has occurred so far in a given column.
+
+(3) Since `\.{\\omit}' follows the `\.\&', the templates for column~2
+are now bypassed. Again \TeX\ goes into restricted horizontal mode and
+makes an |unset_node| from the resulting hlist; but this time the
+hlist contains simply `\.{a2}'. The natural width of the new unset box
+is remembered in the |width| field of the alignrecord for column~2.
+
+(4) A third |unset_node| is created for column 3, using essentially the
+mechanism that worked for column~1; this unset box contains `\.{u3\\vrule
+v3}'. The vertical rule in this case has running dimensions that will later
+extend to the height and depth of the whole first row, since each |unset_node|
+in a row will eventually inherit the height and depth of its enclosing box.
+
+(5) The first row has now ended; it is made into a single unset box
+comprising the following seven items:
+$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 1 column: u1a1v1\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 1 column: a2\cr
+{}\\glue 1pt plus 1fil\cr
+{}\\unsetbox for 1 column: u3\\vrule v3\cr
+{}\\glue 1pt plus 1fil\cr}}$$
+The width of this unset row is unimportant, but it has the correct height
+and depth, so the correct baselineskip glue will be computed as the row
+is inserted into a vertical list.
+
+(6) Since `\.{\\noalign}' follows the current \.{\\cr}, \TeX\ appends
+additional material (in this case \.{\\vskip 3pt}) to the vertical list.
+While processing this material, \TeX\ will be in internal vertical
+mode, and |no_align_group| will be on |save_stack|.
+
+(7) The next row produces an unset box that looks like this:
+$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 2 columns: u1b1v1u2b2v2\cr
+{}\\glue 1pt plus 1fil\cr
+{}\\unsetbox for 1 column: {\rm(empty)}\cr
+{}\\glue 1pt plus 1fil\cr}}$$
+The natural width of the unset box that spans columns 1~and~2 is stored
+in a ``span node,'' which we will explain later; the |info| field of the
+alignrecord for column~1 now points to the new span node, and the |info|
+of the span node points to |end_span|.
+
+(8) The final row produces the unset box
+$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 1 column: {\rm(empty)}\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 2 columns: u2c2v2\cr
+{}\\glue 1pt plus 1fil\cr}}$$
+A new span node is attached to the alignrecord for column 2.
+
+(9) The last step is to compute the true column widths and to change all the
+unset boxes to hboxes, appending the whole works to the vertical list that
+encloses the \.{\\halign}. The rules for deciding on the final widths of
+each unset column box will be explained below.
+
+\yskip\noindent
+Note that as \.{\\halign} is being processed, we fearlessly give up control
+to the rest of \TeX. At critical junctures, an alignment routine is
+called upon to step in and do some little action, but most of the time
+these routines just lurk in the background. It's something like
+post-hypnotic suggestion.
+
+@ We have mentioned that alignrecords contain no |height| or |depth| fields.
+Their |glue_sign| and |glue_order| are pre-empted as well, since it
+is necessary to store information about what to do when a template ends.
+This information is called the |extra_info| field.
+
+@d u_part(#)==mem[#+height_offset].int {pointer to \<u_j> token list}
+@d v_part(#)==mem[#+depth_offset].int {pointer to \<v_j> token list}
+@d extra_info(#)==info(#+list_offset) {info to remember during template}
+
+@ Alignments can occur within alignments, so a small stack is used to access
+the alignrecord information. At each level we have a |preamble| pointer,
+indicating the beginning of the preamble list; a |cur_align| pointer,
+indicating the current position in the preamble list; a |cur_span| pointer,
+indicating the value of |cur_align| at the beginning of a sequence of
+spanned columns; a |cur_loop| pointer, indicating the tabskip glue before
+an alignrecord that should be copied next if the current list is extended;
+and the |align_state| variable, which indicates the nesting of braces so
+that \.{\\cr} and \.{\\span} and tab marks are properly intercepted.
+There also are pointers |cur_head| and |cur_tail| to the head and tail
+of a list of adjustments being moved out from horizontal mode to
+vertical~mode.
+
+The current values of these seven quantities appear in global variables;
+when they have to be pushed down, they are stored in 5-word nodes, and
+|align_ptr| points to the topmost such node.
+
+@d preamble==link(align_head) {the current preamble list}
+@d align_stack_node_size=5 {number of |mem| words to save alignment states}
+
+@<Glob...@>=
+@!cur_align:pointer; {current position in preamble list}
+@!cur_span:pointer; {start of currently spanned columns in preamble list}
+@!cur_loop:pointer; {place to copy when extending a periodic preamble}
+@!align_ptr:pointer; {most recently pushed-down alignment stack node}
+@!cur_head,@!cur_tail:pointer; {adjustment list pointers}
+
+@ The |align_state| and |preamble| variables are initialized elsewhere.
+
+@<Set init...@>=
+align_ptr:=null; cur_align:=null; cur_span:=null; cur_loop:=null;
+cur_head:=null; cur_tail:=null;
+
+@ Alignment stack maintenance is handled by a pair of trivial routines
+called |push_alignment| and |pop_alignment|.
+
+@p procedure push_alignment;
+var p:pointer; {the new alignment stack node}
+begin p:=get_node(align_stack_node_size);
+link(p):=align_ptr; info(p):=cur_align;
+llink(p):=preamble; rlink(p):=cur_span;
+mem[p+2].int:=cur_loop; mem[p+3].int:=align_state;
+info(p+4):=cur_head; link(p+4):=cur_tail;
+align_ptr:=p;
+cur_head:=get_avail;
+end;
+@#
+procedure pop_alignment;
+var p:pointer; {the top alignment stack node}
+begin free_avail(cur_head);
+p:=align_ptr;
+cur_tail:=link(p+4); cur_head:=info(p+4);
+align_state:=mem[p+3].int; cur_loop:=mem[p+2].int;
+cur_span:=rlink(p); preamble:=llink(p);
+cur_align:=info(p); align_ptr:=link(p);
+free_node(p,align_stack_node_size);
+end;
+
+@ \TeX\ has eight procedures that govern alignments: |init_align| and
+|fin_align| are used at the very beginning and the very end; |init_row| and
+|fin_row| are used at the beginning and end of individual rows; |init_span|
+is used at the beginning of a sequence of spanned columns (possibly involving
+only one column); |init_col| and |fin_col| are used at the beginning and
+end of individual columns; and |align_peek| is used after \.{\\cr} to see
+whether the next item is \.{\\noalign}.
+
+We shall consider these routines in the order they are first used during
+the course of a complete \.{\\halign}, namely |init_align|, |align_peek|,
+|init_row|, |init_span|, |init_col|, |fin_col|, |fin_row|, |fin_align|.
+
+@ When \.{\\halign} or \.{\\valign} has been scanned in an appropriate
+mode, \TeX\ calls |init_align|, whose task is to get everything off to a
+good start. This mostly involves scanning the preamble and putting its
+information into the preamble list.
+@^preamble@>
+
+@p @t\4@>@<Declare the procedure called |get_preamble_token|@>@t@>@/
+procedure@?align_peek; forward;@t\2@>@/
+procedure@?normal_paragraph; forward;@t\2@>@/
+procedure init_align;
+label done, done1, done2, continue;
+var save_cs_ptr:pointer; {|warning_index| value for error messages}
+@!p:pointer; {for short-term temporary use}
+begin save_cs_ptr:=cur_cs; {\.{\\halign} or \.{\\valign}, usually}
+push_alignment; align_state:=-1000000; {enter a new alignment level}
+@<Check for improper alignment in displayed math@>;
+push_nest; {enter a new semantic level}
+@<Change current mode to |-vmode| for \.{\\halign}, |-hmode| for \.{\\valign}@>;
+scan_spec(align_group,false);@/
+@<Scan the preamble and record it in the |preamble| list@>;
+new_save_level(align_group);
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+align_peek; {look for \.{\\noalign} or \.{\\omit}}
+end;
+
+@ In vertical modes, |prev_depth| already has the correct value. But
+if we are in |mmode| (displayed formula mode), we reach out to the
+enclosing vertical mode for the |prev_depth| value that produces the
+correct baseline calculations.
+
+@<Change current mode...@>=
+if mode=mmode then
+ begin mode:=-vmode; prev_depth:=nest[nest_ptr-2].aux_field.sc;
+ end
+else if mode>0 then negate(mode)
+
+@ When \.{\\halign} is used as a displayed formula, there should be
+no other pieces of mlists present.
+
+@<Check for improper alignment in displayed math@>=
+if (mode=mmode)and((tail<>head)or(incompleat_noad<>null)) then
+ begin print_err("Improper "); print_esc("halign"); print(" inside $$'s");
+@.Improper \\halign...@>
+ help3("Displays can use special alignments (like \eqalignno)")@/
+ ("only if nothing but the alignment itself is between $$'s.")@/
+ ("So I've deleted the formulas that preceded this alignment.");
+ error; flush_math;
+ end
+
+@ @<Scan the preamble and record it in the |preamble| list@>=
+preamble:=null; cur_align:=align_head; cur_loop:=null; scanner_status:=aligning;
+warning_index:=save_cs_ptr; align_state:=-1000000;
+ {at this point, |cur_cmd=left_brace|}
+loop@+ begin @<Append the current tabskip glue to the preamble list@>;
+ if cur_cmd=car_ret then goto done; {\.{\\cr} ends the preamble}
+ @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|,
+ looking for changes in the tabskip glue; append an
+ alignrecord to the preamble list@>;
+ end;
+done: scanner_status:=normal
+
+@ @<Append the current tabskip glue to the preamble list@>=
+link(cur_align):=new_param_glue(tab_skip_code);
+cur_align:=link(cur_align)
+
+@ @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|...@>=
+@<Scan the template \<u_j>, putting the resulting token list in |hold_head|@>;
+link(cur_align):=new_null_box; cur_align:=link(cur_align); {a new alignrecord}
+info(cur_align):=end_span; width(cur_align):=null_flag;
+u_part(cur_align):=link(hold_head);
+@<Scan the template \<v_j>, putting the resulting token list in |hold_head|@>;
+v_part(cur_align):=link(hold_head)
+
+@ We enter `\.{\\span}' into |eqtb| with |tab_mark| as its command code,
+and with |span_code| as the command modifier. This makes \TeX\ interpret it
+essentially the same as an alignment delimiter like `\.\&', yet it is
+recognizably different when we need to distinguish it from a normal delimiter.
+It also turns out to be useful to give a special |cr_code| to `\.{\\cr}',
+and an even larger |cr_cr_code| to `\.{\\crcr}'.
+
+The end of a template is represented by two ``frozen'' control sequences
+called \.{\\endtemplate}. The first has the command code |end_template|, which
+is |>outer_call|, so it will not easily disappear in the presence of errors.
+The |get_x_token| routine converts the first into the second, which has |endv|
+as its command code.
+
+@d span_code=256 {distinct from any character}
+@d cr_code=257 {distinct from |span_code| and from any character}
+@d cr_cr_code=cr_code+1 {this distinguishes \.{\\crcr} from \.{\\cr}}
+@d end_template_token==cs_token_flag+frozen_end_template
+
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("span",tab_mark,span_code);@/
+@!@:span_}{\.{\\span} primitive@>
+primitive("cr",car_ret,cr_code);
+@!@:cr_}{\.{\\cr} primitive@>
+text(frozen_cr):="cr"; eqtb[frozen_cr]:=eqtb[cur_val];@/
+primitive("crcr",car_ret,cr_cr_code);
+@!@:cr_cr_}{\.{\\crcr} primitive@>
+text(frozen_end_template):="endtemplate"; text(frozen_endv):="endtemplate";
+eq_type(frozen_endv):=endv; equiv(frozen_endv):=null_list;
+eq_level(frozen_endv):=level_one;@/
+eqtb[frozen_end_template]:=eqtb[frozen_endv];
+eq_type(frozen_end_template):=end_template;
+
+@ @<Cases of |print_cmd_chr|...@>=
+tab_mark: if chr_code=span_code then print_esc("span")
+ else chr_cmd("alignment tab character ");
+car_ret: if chr_code=cr_code then print_esc("cr")
+ else print_esc("crcr");
+
+@ The preamble is copied directly, except that \.{\\tabskip} causes a change
+to the tabskip glue, thereby possibly expanding macros that immediately
+follow it. An appearance of \.{\\span} also causes such an expansion.
+
+Note that if the preamble contains `\.{\\global\\tabskip}', the `\.{\\global}'
+token survives in the preamble and the `\.{\\tabskip}' defines new
+tabskip glue (locally).
+
+@<Declare the procedure called |get_preamble_token|@>=
+procedure get_preamble_token;
+label restart;
+begin restart: get_token;
+while (cur_chr=span_code)and(cur_cmd=tab_mark) do
+ begin get_token; {this token will be expanded once}
+ if cur_cmd>max_command then
+ begin expand; get_token;
+ end;
+ end;
+if cur_cmd=endv then
+ fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+if (cur_cmd=assign_glue)and(cur_chr=glue_base+tab_skip_code) then
+ begin scan_optional_equals; scan_glue(glue_val);
+ if global_defs>0 then geq_define(glue_base+tab_skip_code,glue_ref,cur_val)
+ else eq_define(glue_base+tab_skip_code,glue_ref,cur_val);
+ goto restart;
+ end;
+end;
+
+@ Spaces are eliminated from the beginning of a template.
+
+@<Scan the template \<u_j>...@>=
+p:=hold_head; link(p):=null;
+loop@+ begin get_preamble_token;
+ if cur_cmd=mac_param then goto done1;
+ if (cur_cmd<=car_ret)and(cur_cmd>=tab_mark)and(align_state=-1000000) then
+ if (p=hold_head)and(cur_loop=null)and(cur_cmd=tab_mark)
+ then cur_loop:=cur_align
+ else begin print_err("Missing # inserted in alignment preamble");
+@.Missing \# inserted...@>
+ help3("There should be exactly one # between &'s, when an")@/
+ ("\halign or \valign is being set up. In this case you had")@/
+ ("none, so I've put one in; maybe that will work.");
+ back_error; goto done1;
+ end
+ else if (cur_cmd<>spacer)or(p<>hold_head) then
+ begin link(p):=get_avail; p:=link(p); info(p):=cur_tok;
+ end;
+ end;
+done1:
+
+@ @<Scan the template \<v_j>...@>=
+p:=hold_head; link(p):=null;
+loop@+ begin continue: get_preamble_token;
+ if (cur_cmd<=car_ret)and(cur_cmd>=tab_mark)and(align_state=-1000000) then
+ goto done2;
+ if cur_cmd=mac_param then
+ begin print_err("Only one # is allowed per tab");
+@.Only one \# is allowed...@>
+ help3("There should be exactly one # between &'s, when an")@/
+ ("\halign or \valign is being set up. In this case you had")@/
+ ("more than one, so I'm ignoring all but the first.");
+ error; goto continue;
+ end;
+ link(p):=get_avail; p:=link(p); info(p):=cur_tok;
+ end;
+done2: link(p):=get_avail; p:=link(p);
+info(p):=end_template_token {put \.{\\endtemplate} at the end}
+
+@ The tricky part about alignments is getting the templates into the
+scanner at the right time, and recovering control when a row or column
+is finished.
+
+We usually begin a row after each \.{\\cr} has been sensed, unless that
+\.{\\cr} is followed by \.{\\noalign} or by the right brace that terminates
+the alignment. The |align_peek| routine is used to look ahead and do
+the right thing; it either gets a new row started, or gets a \.{\\noalign}
+started, or finishes off the alignment.
+
+@<Declare the procedure called |align_peek|@>=
+procedure align_peek;
+label restart;
+begin restart: align_state:=1000000; @<Get the next non-blank non-call token@>;
+if cur_cmd=no_align then
+ begin scan_left_brace; new_save_level(no_align_group);
+ if mode=-vmode then normal_paragraph;
+ end
+else if cur_cmd=right_brace then fin_align
+else if (cur_cmd=car_ret)and(cur_chr=cr_cr_code) then
+ goto restart {ignore \.{\\crcr}}
+else begin init_row; {start a new row}
+ init_col; {start a new column and replace what we peeked at}
+ end;
+end;
+
+@ To start a row (i.e., a `row' that rhymes with `dough' but not with `bough'),
+we enter a new semantic level, copy the first tabskip glue, and change
+from internal vertical mode to restricted horizontal mode or vice versa.
+The |space_factor| and |prev_depth| are not used on this semantic level,
+but we clear them to zero just to be tidy.
+
+@p @t\4@>@<Declare the procedure called |init_span|@>@t@>@/
+procedure init_row;
+begin push_nest; mode:=(-hmode-vmode)-mode;
+if mode=-hmode then space_factor:=0 @+else prev_depth:=0;
+tail_append(new_glue(glue_ptr(preamble)));
+subtype(tail):=tab_skip_code+1;@/
+cur_align:=link(preamble); cur_tail:=cur_head; init_span(cur_align);
+end;
+
+@ The parameter to |init_span| is a pointer to the alignrecord where the
+next column or group of columns will begin. A new semantic level is
+entered, so that the columns will generate a list for subsequent packaging.
+
+@<Declare the procedure called |init_span|@>=
+procedure init_span(@!p:pointer);
+begin push_nest;
+if mode=-hmode then space_factor:=1000
+else begin prev_depth:=ignore_depth; normal_paragraph;
+ end;
+cur_span:=p;
+end;
+
+@ When a column begins, we assume that |cur_cmd| is either |omit| or else
+the current token should be put back into the input until the \<u_j>
+template has been scanned. (Note that |cur_cmd| might be |tab_mark| or
+|car_ret|.) We also assume that |align_state| is approximately 1000000 at
+this time. We remain in the same mode, and start the template if it is
+called for.
+
+@p procedure init_col;
+begin extra_info(cur_align):=cur_cmd;
+if cur_cmd=omit then align_state:=0
+else begin back_input; begin_token_list(u_part(cur_align),u_template);
+ end; {now |align_state=1000000|}
+end;
+
+@ The scanner sets |align_state| to zero when the \<u_j> template ends. When
+a subsequent \.{\\cr} or \.{\\span} or tab mark occurs with |align_state=0|,
+the scanner activates the following code, which fires up the \<v_j> template.
+We need to remember the |cur_chr|, which is either |cr_cr_code|, |cr_code|,
+|span_code|, or a character code, depending on how the column text has ended.
+
+This part of the program had better not be activated when the preamble
+to another alignment is being scanned, or when no alignment preamble is active.
+
+@<Insert the \(v)\<v_j>...@>=
+begin if (scanner_status=aligning) or (cur_align=null) then
+ fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+cur_cmd:=extra_info(cur_align); extra_info(cur_align):=cur_chr;
+if cur_cmd=omit then begin_token_list(omit_template,v_template)
+else begin_token_list(v_part(cur_align),v_template);
+align_state:=1000000; goto restart;
+end
+
+@ The token list |omit_template| just referred to is a constant token
+list that contains the special control sequence \.{\\endtemplate} only.
+
+@<Initialize the special...@>=
+info(omit_template):=end_template_token; {|link(omit_template)=null|}
+
+@ When the |endv| command at the end of a \<v_j> template comes through the
+scanner, things really start to happen; and it is the |fin_col| routine
+that makes them happen. This routine returns |true| if a row as well as a
+column has been finished.
+
+@p function fin_col:boolean;
+label exit;
+var p:pointer; {the alignrecord after the current one}
+@!q,@!r:pointer; {temporary pointers for list manipulation}
+@!s:pointer; {a new span node}
+@!u:pointer; {a new unset box}
+@!w:scaled; {natural width}
+@!o:glue_ord; {order of infinity}
+@!n:halfword; {span counter}
+begin if cur_align=null then confusion("endv");
+q:=link(cur_align);@+if q=null then confusion("endv");
+@:this can't happen endv}{\quad endv@>
+if align_state<500000 then
+ fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+p:=link(q);
+@<If the preamble list has been traversed, check that the row has ended@>;
+if extra_info(cur_align)<>span_code then
+ begin unsave; new_save_level(align_group);@/
+ @<Package an unset box for the current column and record its width@>;
+ @<Copy the tabskip glue between columns@>;
+ if extra_info(cur_align)>=cr_code then
+ begin fin_col:=true; return;
+ end;
+ init_span(p);
+ end;
+align_state:=1000000; @<Get the next non-blank non-call token@>;
+cur_align:=p;
+init_col; fin_col:=false;
+exit: end;
+
+@ @<If the preamble list has been traversed, check that the row has ended@>=
+if (p=null)and(extra_info(cur_align)<cr_code) then
+ if cur_loop<>null then @<Lengthen the preamble periodically@>
+ else begin print_err("Extra alignment tab has been changed to ");
+@.Extra alignment tab...@>
+ print_esc("cr");
+ help3("You have given more \span or & marks than there were")@/
+ ("in the preamble to the \halign or \valign now in progress.")@/
+ ("So I'll assume that you meant to type \cr instead.");
+ extra_info(cur_align):=cr_code; error;
+ end
+
+@ @<Lengthen the preamble...@>=
+begin link(q):=new_null_box; p:=link(q); {a new alignrecord}
+info(p):=end_span; width(p):=null_flag; cur_loop:=link(cur_loop);
+@<Copy the templates from node |cur_loop| into node |p|@>;
+cur_loop:=link(cur_loop);
+link(p):=new_glue(glue_ptr(cur_loop));
+end
+
+@ @<Copy the templates from node |cur_loop| into node |p|@>=
+q:=hold_head; r:=u_part(cur_loop);
+while r<>null do
+ begin link(q):=get_avail; q:=link(q); info(q):=info(r); r:=link(r);
+ end;
+link(q):=null; u_part(p):=link(hold_head);
+q:=hold_head; r:=v_part(cur_loop);
+while r<>null do
+ begin link(q):=get_avail; q:=link(q); info(q):=info(r); r:=link(r);
+ end;
+link(q):=null; v_part(p):=link(hold_head)
+
+@ @<Copy the tabskip glue...@>=
+tail_append(new_glue(glue_ptr(link(cur_align))));
+subtype(tail):=tab_skip_code+1
+
+@ @<Package an unset...@>=
+begin if mode=-hmode then
+ begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u);
+ cur_tail:=adjust_tail; adjust_tail:=null;
+ end
+else begin u:=vpackage(link(head),natural,0); w:=height(u);
+ end;
+n:=min_quarterword; {this represents a span count of 1}
+if cur_span<>cur_align then @<Update width entry for spanned columns@>
+else if w>width(cur_align) then width(cur_align):=w;
+type(u):=unset_node; span_count(u):=n;@/
+@<Determine the stretch order@>;
+glue_order(u):=o; glue_stretch(u):=total_stretch[o];@/
+@<Determine the shrink order@>;
+glue_sign(u):=o; glue_shrink(u):=total_shrink[o];@/
+pop_nest; link(tail):=u; tail:=u;
+end
+
+@ A span node is a 2-word record containing |width|, |info|, and |link|
+fields. The |link| field is not really a link, it indicates the number of
+spanned columns; the |info| field points to a span node for the same
+starting column, having a greater extent of spanning, or to |end_span|,
+which has the largest possible |link| field; the |width| field holds the
+largest natural width corresponding to a particular set of spanned columns.
+
+A list of the maximum widths so far, for spanned columns starting at a
+given column, begins with the |info| field of the alignrecord for that
+column.
+
+@d span_node_size=2 {number of |mem| words for a span node}
+
+@<Initialize the special list heads...@>=
+link(end_span):=max_quarterword+1; info(end_span):=null;
+
+@ @<Update width entry for spanned columns@>=
+begin q:=cur_span;
+repeat incr(n); q:=link(link(q));
+until q=cur_align;
+if n>max_quarterword then confusion("256 spans"); {this can happen, but won't}
+@^system dependencies@>
+@:this can't happen 256 spans}{\quad 256 spans@>
+q:=cur_span; while link(info(q))<n do q:=info(q);
+if link(info(q))>n then
+ begin s:=get_node(span_node_size); info(s):=info(q); link(s):=n;
+ info(q):=s; width(s):=w;
+ end
+else if width(info(q))<w then width(info(q)):=w;
+end
+
+@ At the end of a row, we append an unset box to the current vlist (for
+\.{\\halign}) or the current hlist (for \.{\\valign}). This unset box
+contains the unset boxes for the columns, separated by the tabskip glue.
+Everything will be set later.
+
+@p procedure fin_row;
+var p:pointer; {the new unset box}
+begin if mode=-hmode then
+ begin p:=hpack(link(head),natural);
+ pop_nest; append_to_vlist(p);
+ if cur_head<>cur_tail then
+ begin link(tail):=link(cur_head); tail:=cur_tail;
+ end;
+ end
+else begin p:=vpack(link(head),natural); pop_nest;
+ link(tail):=p; tail:=p; space_factor:=1000;
+ end;
+type(p):=unset_node; glue_stretch(p):=0;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+align_peek;
+end; {note that |glue_shrink(p)=0| since |glue_shrink==shift_amount|}
+
+@ Finally, we will reach the end of the alignment, and we can breathe a
+sigh of relief that memory hasn't overflowed. All the unset boxes will now be
+set so that the columns line up, taking due account of spanned columns.
+
+@p procedure@?do_assignments; forward;@t\2@>@/
+procedure@?resume_after_display; forward;@t\2@>@/
+procedure@?build_page; forward;@t\2@>@/
+procedure fin_align;
+var @!p,@!q,@!r,@!s,@!u,@!v: pointer; {registers for the list operations}
+@!t,@!w:scaled; {width of column}
+@!o:scaled; {shift offset for unset boxes}
+@!n:halfword; {matching span amount}
+@!rule_save:scaled; {temporary storage for |overfull_rule|}
+@!aux_save:memory_word; {temporary storage for |aux|}
+begin if cur_group<>align_group then confusion("align1");
+@:this can't happen align}{\quad align@>
+unsave; {that |align_group| was for individual entries}
+if cur_group<>align_group then confusion("align0");
+unsave; {that |align_group| was for the whole alignment}
+if nest[nest_ptr-1].mode_field=mmode then o:=display_indent
+ else o:=0;
+@<Go through the preamble list, determining the column widths and
+ changing the alignrecords to dummy unset boxes@>;
+@<Package the preamble list, to determine the actual tabskip glue amounts,
+ and let |p| point to this prototype box@>;
+@<Set the glue in all the unset boxes of the current list@>;
+flush_node_list(p); pop_alignment;
+@<Insert the \(c)current list into its environment@>;
+end;@/
+@t\4@>@<Declare the procedure called |align_peek|@>
+
+@ It's time now to dismantle the preamble list and to compute the column
+widths. Let $w_{ij}$ be the maximum of the natural widths of all entries
+that span columns $i$ through $j$, inclusive. The alignrecord for column~$i$
+contains $w_{ii}$ in its |width| field, and there is also a linked list of
+the nonzero $w_{ij}$ for increasing $j$, accessible via the |info| field;
+these span nodes contain the value $j-i-1+|min_quarterword|$ in their
+|link| fields. The values of $w_{ii}$ were initialized to |null_flag|, which
+we regard as $-\infty$.
+
+The final column widths are defined by the formula
+$$w_j=\max_{1\L i\L j}\biggl( w_{ij}-\sum_{i\L k<j}(t_k+w_k)\biggr),$$
+where $t_k$ is the natural width of the tabskip glue between columns
+$k$ and~$k+1$. However, if $w_{ij}=-\infty$ for all |i| in the range
+|1<=i<=j| (i.e., if every entry that involved column~|j| also involved
+column~|j+1|), we let $w_j=0$, and we zero out the tabskip glue after
+column~|j|.
+
+\TeX\ computes these values by using the following scheme: First $w_1=w_{11}$.
+Then replace $w_{2j}$ by $\max(w_{2j},w_{1j}-t_1-w_1)$, for all $j>1$.
+Then $w_2=w_{22}$. Then replace $w_{3j}$ by $\max(w_{3j},w_{2j}-t_2-w_2)$
+for all $j>2$; and so on. If any $w_j$ turns out to be $-\infty$, its
+value is changed to zero and so is the next tabskip.
+
+@<Go through the preamble list,...@>=
+q:=link(preamble);
+repeat flush_list(u_part(q)); flush_list(v_part(q));
+p:=link(link(q));
+if width(q)=null_flag then
+ @<Nullify |width(q)| and the tabskip glue following this column@>;
+if info(q)<>end_span then
+ @<Merge the widths in the span nodes of |q| with those of |p|,
+ destroying the span nodes of |q|@>;
+type(q):=unset_node; span_count(q):=min_quarterword; height(q):=0;
+depth(q):=0; glue_order(q):=normal; glue_sign(q):=normal;
+glue_stretch(q):=0; glue_shrink(q):=0; q:=p;
+until q=null
+
+@ @<Nullify |width(q)| and the tabskip glue following this column@>=
+begin width(q):=0; r:=link(q); s:=glue_ptr(r);
+if s<>zero_glue then
+ begin add_glue_ref(zero_glue); delete_glue_ref(s);
+ glue_ptr(r):=zero_glue;
+ end;
+end
+
+@ Merging of two span-node lists is a typical exercise in the manipulation of
+linearly linked data structures. The essential invariant in the following
+|repeat| loop is that we want to dispense with node |r|, in |q|'s list,
+and |u| is its successor; all nodes of |p|'s list up to and including |s|
+have been processed, and the successor of |s| matches |r| or precedes |r|
+or follows |r|, according as |link(r)=n| or |link(r)>n| or |link(r)<n|.
+
+@<Merge the widths...@>=
+begin t:=width(q)+width(glue_ptr(link(q)));
+r:=info(q); s:=end_span; info(s):=p; n:=min_quarterword+1;
+repeat width(r):=width(r)-t; u:=info(r);
+while link(r)>n do
+ begin s:=info(s); n:=link(info(s))+1;
+ end;
+if link(r)<n then
+ begin info(r):=info(s); info(s):=r; decr(link(r)); s:=r;
+ end
+else begin if width(r)>width(info(s)) then width(info(s)):=width(r);
+ free_node(r,span_node_size);
+ end;
+r:=u;
+until r=end_span;
+end
+
+@ Now the preamble list has been converted to a list of alternating unset
+boxes and tabskip glue, where the box widths are equal to the final
+column sizes. In case of \.{\\valign}, we change the widths to heights,
+so that a correct error message will be produced if the alignment is
+overfull or underfull.
+
+@<Package the preamble list...@>=
+save_ptr:=save_ptr-2; pack_begin_line:=-mode_line;
+if mode=-vmode then
+ begin rule_save:=overfull_rule;
+ overfull_rule:=0; {prevent rule from being packaged}
+ p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save;
+ end
+else begin q:=link(preamble);
+ repeat height(q):=width(q); width(q):=0; q:=link(link(q));
+ until q=null;
+ p:=vpack(preamble,saved(1),saved(0));
+ q:=link(preamble);
+ repeat width(q):=height(q); height(q):=0; q:=link(link(q));
+ until q=null;
+ end;
+pack_begin_line:=0
+
+@ @<Set the glue in all the unset...@>=
+q:=link(head); s:=head;
+while q<>null do
+ begin if not is_char_node(q) then
+ if type(q)=unset_node then
+ @<Set the unset box |q| and the unset boxes in it@>
+ else if type(q)=rule_node then
+ @<Make the running dimensions in rule |q| extend to the
+ boundaries of the alignment@>;
+ s:=q; q:=link(q);
+ end
+
+@ @<Make the running dimensions in rule |q| extend...@>=
+begin if is_running(width(q)) then width(q):=width(p);
+if is_running(height(q)) then height(q):=height(p);
+if is_running(depth(q)) then depth(q):=depth(p);
+if o<>0 then
+ begin r:=link(q); link(q):=null; q:=hpack(q,natural);
+ shift_amount(q):=o; link(q):=r; link(s):=q;
+ end;
+end
+
+@ The unset box |q| represents a row that contains one or more unset boxes,
+depending on how soon \.{\\cr} occurred in that row.
+
+@<Set the unset box |q| and the unset boxes in it@>=
+begin if mode=-vmode then
+ begin type(q):=hlist_node; width(q):=width(p);
+ end
+else begin type(q):=vlist_node; height(q):=height(p);
+ end;
+glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p);
+glue_set(q):=glue_set(p); shift_amount(q):=o;
+r:=link(list_ptr(q)); s:=link(list_ptr(p));
+repeat @<Set the glue in node |r| and change it from an unset node@>;
+r:=link(link(r)); s:=link(link(s));
+until r=null;
+end
+
+@ A box made from spanned columns will be followed by tabskip glue nodes and
+by empty boxes as if there were no spanning. This permits perfect alignment
+of subsequent entries, and it prevents values that depend on floating point
+arithmetic from entering into the dimensions of any boxes.
+
+@<Set the glue in node |r|...@>=
+n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+while n>min_quarterword do
+ begin decr(n);
+ @<Append tabskip glue and an empty box to list |u|,
+ and update |s| and |t| as the prototype nodes are passed@>;
+ end;
+if mode=-vmode then
+ @<Make the unset node |r| into an |hlist_node| of width |w|,
+ setting the glue as if the width were |t|@>
+else @<Make the unset node |r| into a |vlist_node| of height |w|,
+ setting the glue as if the height were |t|@>;
+shift_amount(r):=0;
+if u<>hold_head then {append blank boxes to account for spanned nodes}
+ begin link(u):=link(r); link(r):=link(hold_head); r:=u;
+ end
+
+@ @<Append tabskip glue and an empty box to list |u|...@>=
+s:=link(s); v:=glue_ptr(s); link(u):=new_glue(v); u:=link(u);
+subtype(u):=tab_skip_code+1; t:=t+width(v);
+if glue_sign(p)=stretching then
+ begin if stretch_order(v)=glue_order(p) then
+ t:=t+round(float(glue_set(p))*stretch(v));
+@^real multiplication@>
+ end
+else if glue_sign(p)=shrinking then
+ begin if shrink_order(v)=glue_order(p) then
+ t:=t-round(float(glue_set(p))*shrink(v));
+ end;
+s:=link(s); link(u):=new_null_box; u:=link(u); t:=t+width(s);
+if mode=-vmode then width(u):=width(s)@+else
+ begin type(u):=vlist_node; height(u):=width(s);
+ end
+
+@ @<Make the unset node |r| into an |hlist_node| of width |w|...@>=
+begin height(r):=height(q); depth(r):=depth(q);
+if t=width(r) then
+ begin glue_sign(r):=normal; glue_order(r):=normal;
+ set_glue_ratio_zero(glue_set(r));
+ end
+else if t>width(r) then
+ begin glue_sign(r):=stretching;
+ if glue_stretch(r)=0 then set_glue_ratio_zero(glue_set(r))
+ else glue_set(r):=unfloat((t-width(r))/glue_stretch(r));
+@^real division@>
+ end
+else begin glue_order(r):=glue_sign(r); glue_sign(r):=shrinking;
+ if glue_shrink(r)=0 then set_glue_ratio_zero(glue_set(r))
+ else if (glue_order(r)=normal)and(width(r)-t>glue_shrink(r)) then
+ set_glue_ratio_one(glue_set(r))
+ else glue_set(r):=unfloat((width(r)-t)/glue_shrink(r));
+ end;
+width(r):=w; type(r):=hlist_node;
+end
+
+@ @<Make the unset node |r| into a |vlist_node| of height |w|...@>=
+begin width(r):=width(q);
+if t=height(r) then
+ begin glue_sign(r):=normal; glue_order(r):=normal;
+ set_glue_ratio_zero(glue_set(r));
+ end
+else if t>height(r) then
+ begin glue_sign(r):=stretching;
+ if glue_stretch(r)=0 then set_glue_ratio_zero(glue_set(r))
+ else glue_set(r):=unfloat((t-height(r))/glue_stretch(r));
+@^real division@>
+ end
+else begin glue_order(r):=glue_sign(r); glue_sign(r):=shrinking;
+ if glue_shrink(r)=0 then set_glue_ratio_zero(glue_set(r))
+ else if (glue_order(r)=normal)and(height(r)-t>glue_shrink(r)) then
+ set_glue_ratio_one(glue_set(r))
+ else glue_set(r):=unfloat((height(r)-t)/glue_shrink(r));
+ end;
+height(r):=w; type(r):=vlist_node;
+end
+
+@ We now have a completed alignment, in the list that starts at |head|
+and ends at |tail|. This list will be merged with the one that encloses
+it. (In case the enclosing mode is |mmode|, for displayed formulas,
+we will need to insert glue before and after the display; that part of the
+program will be deferred until we're more familiar with such operations.)
+
+In horizontal mode, the |clang| part of |aux| is undefined; an over-cautious
+\PASCAL\ runtime system may complain about this.
+@^dirty \PASCAL@>
+
+@<Insert the \(c)current list into its environment@>=
+aux_save:=aux; p:=link(head); q:=tail; pop_nest;
+if mode=mmode then @<Finish an alignment in a display@>
+else begin aux:=aux_save; link(tail):=p;
+ if p<>null then tail:=q;
+ if mode=vmode then build_page;
+ end
+
+@* \[38] Breaking paragraphs into lines.
+We come now to what is probably the most interesting algorithm of \TeX:
+the mechanism for choosing the ``best possible'' breakpoints that yield
+the individual lines of a paragraph. \TeX's line-breaking algorithm takes
+a given horizontal list and converts it to a sequence of boxes that are
+appended to the current vertical list. In the course of doing this, it
+creates a special data structure containing three kinds of records that are
+not used elsewhere in \TeX. Such nodes are created while a paragraph is
+being processed, and they are destroyed afterwards; thus, the other parts
+of \TeX\ do not need to know anything about how line-breaking is done.
+
+The method used here is based on an approach devised by Michael F. Plass and
+@^Plass, Michael Frederick@>
+@^Knuth, Donald Ervin@>
+the author in 1977, subsequently generalized and improved by the same two
+people in 1980. A detailed discussion appears in {\sl SOFTWARE---Practice
+\AM\ Experience \bf11} (1981), 1119--1184, where it is shown that the
+line-breaking problem can be regarded as a special case of the problem of
+computing the shortest path in an acyclic network. The cited paper includes
+numerous examples and describes the history of line breaking as it has been
+practiced by printers through the ages. The present implementation adds two
+new ideas to the algorithm of 1980: memory space requirements are considerably
+reduced by using smaller records for inactive nodes than for active ones,
+and arithmetic overflow is avoided by using ``delta distances'' instead of
+keeping track of the total distance from the beginning of the paragraph to the
+current point.
+
+@ The |line_break| procedure should be invoked only in horizontal mode; it
+leaves that mode and places its output into the current vlist of the
+enclosing vertical mode (or internal vertical mode).
+There is one explicit parameter: |final_widow_penalty| is the amount of
+additional penalty to be inserted before the final line of the paragraph.
+
+There are also a number of implicit parameters: The hlist to be broken
+starts at |link(head)|, and it is nonempty. The value of |prev_graf| in the
+enclosing semantic level tells where the paragraph should begin in the
+sequence of line numbers, in case hanging indentation or \.{\\parshape}
+are in use; |prev_graf| is zero unless this paragraph is being continued
+after a displayed formula. Other implicit parameters, such as the
+|par_shape_ptr| and various penalties to use for hyphenation, etc., appear
+in |eqtb|.
+
+After |line_break| has acted, it will have updated the current vlist and the
+value of |prev_graf|. Furthermore, the global variable |just_box| will
+point to the final box created by |line_break|, so that the width of this
+line can be ascertained when it is necessary to decide whether to use
+|above_display_skip| or |above_display_short_skip| before a displayed formula.
+
+@<Glob...@>=
+@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
+
+@ Since |line_break| is a rather lengthy procedure---sort of a small world unto
+itself---we must build it up little by little, somewhat more cautiously
+than we have done with the simpler procedures of \TeX. Here is the
+general outline.
+
+@p@t\4@>@<Declare subprocedures for |line_break|@>
+procedure line_break(@!final_widow_penalty:integer);
+label done,done1,done2,done3,done4,done5,continue;
+var @<Local variables for line breaking@>@;
+begin pack_begin_line:=mode_line; {this is for over/underfull box messages}
+@<Get ready to start line breaking@>;
+@<Find optimal breakpoints@>;
+@<Break the paragraph at the chosen breakpoints, justify the resulting lines
+to the correct widths, and append them to the current vertical list@>;
+@<Clean up the memory by removing the break nodes@>;
+pack_begin_line:=0;
+end;
+
+@ The first task is to move the list from |head| to |temp_head| and go
+into the enclosing semantic level. We also append the \.{\\parfillskip}
+glue to the end of the paragraph, removing a space (or other glue node) if
+it was there, since spaces usually precede blank lines and instances of
+`\.{\$\$}'. The |par_fill_skip| is preceded by an infinite penalty, so
+it will never be considered as a potential breakpoint.
+
+This code assumes that a |glue_node| and a |penalty_node| occupy the
+same number of |mem|~words.
+@^data structure assumptions@>
+
+@<Get ready to start...@>=
+link(temp_head):=link(head);
+if is_char_node(tail) then tail_append(new_penalty(inf_penalty))
+else if type(tail)<>glue_node then tail_append(new_penalty(inf_penalty))
+else begin type(tail):=penalty_node; delete_glue_ref(glue_ptr(tail));
+ flush_node_list(leader_ptr(tail)); penalty(tail):=inf_penalty;
+ end;
+link(tail):=new_param_glue(par_fill_skip_code);
+init_cur_lang:=prev_graf mod @'200000;
+init_l_hyf:=prev_graf div @'20000000;
+init_r_hyf:=(prev_graf div @'200000) mod @'100;
+pop_nest;
+
+@ When looking for optimal line breaks, \TeX\ creates a ``break node'' for
+each break that is {\sl feasible}, in the sense that there is a way to end
+a line at the given place without requiring any line to stretch more than
+a given tolerance. A break node is characterized by three things: the position
+of the break (which is a pointer to a |glue_node|, |math_node|, |penalty_node|,
+or |disc_node|); the ordinal number of the line that will follow this
+breakpoint; and the fitness classification of the line that has just
+ended, i.e., |tight_fit|, |decent_fit|, |loose_fit|, or |very_loose_fit|.
+
+@d tight_fit=3 {fitness classification for lines shrinking 0.5 to 1.0 of their
+ shrinkability}
+@d loose_fit=1 {fitness classification for lines stretching 0.5 to 1.0 of their
+ stretchability}
+@d very_loose_fit=0 {fitness classification for lines stretching more than
+ their stretchability}
+@d decent_fit=2 {fitness classification for all other lines}
+
+@ The algorithm essentially determines the best possible way to achieve
+each feasible combination of position, line, and fitness. Thus, it answers
+questions like, ``What is the best way to break the opening part of the
+paragraph so that the fourth line is a tight line ending at such-and-such
+a place?'' However, the fact that all lines are to be the same length
+after a certain point makes it possible to regard all sufficiently large
+line numbers as equivalent, when the looseness parameter is zero, and this
+makes it possible for the algorithm to save space and time.
+
+An ``active node'' and a ``passive node'' are created in |mem| for each
+feasible breakpoint that needs to be considered. Active nodes are three
+words long and passive nodes are two words long. We need active nodes only
+for breakpoints near the place in the paragraph that is currently being
+examined, so they are recycled within a comparatively short time after
+they are created.
+
+@ An active node for a given breakpoint contains six fields:
+
+\yskip\hang|link| points to the next node in the list of active nodes; the
+last active node has |link=last_active|.
+
+\yskip\hang|break_node| points to the passive node associated with this
+breakpoint.
+
+\yskip\hang|line_number| is the number of the line that follows this
+breakpoint.
+
+\yskip\hang|fitness| is the fitness classification of the line ending at this
+breakpoint.
+
+\yskip\hang|type| is either |hyphenated| or |unhyphenated|, depending on
+whether this breakpoint is a |disc_node|.
+
+\yskip\hang|total_demerits| is the minimum possible sum of demerits over all
+lines leading from the beginning of the paragraph to this breakpoint.
+
+\yskip\noindent
+The value of |link(active)| points to the first active node on a linked list
+of all currently active nodes. This list is in order by |line_number|,
+except that nodes with |line_number>easy_line| may be in any order relative
+to each other.
+
+@d active_node_size=3 {number of words in active nodes}
+@d fitness==subtype {|very_loose_fit..tight_fit| on final line for this break}
+@d break_node==rlink {pointer to the corresponding passive node}
+@d line_number==llink {line that begins at this breakpoint}
+@d total_demerits(#)==mem[#+2].int {the quantity that \TeX\ minimizes}
+@d unhyphenated=0 {the |type| of a normal active break node}
+@d hyphenated=1 {the |type| of an active node that breaks at a |disc_node|}
+@d last_active==active {the active list ends where it begins}
+
+@ @<Initialize the special list heads...@>=
+type(last_active):=hyphenated; line_number(last_active):=max_halfword;
+subtype(last_active):=0; {the |subtype| is never examined by the algorithm}
+
+@ The passive node for a given breakpoint contains only four fields:
+
+\yskip\hang|link| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+\yskip\hang|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+\yskip\hang|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+\yskip\hang|serial| is equal to |n| if this passive node is the |n|th
+one created during the current pass. (This field is used only when
+printing out detailed statistics about the line-breaking calculations.)
+
+\yskip\noindent
+There is a global variable called |passive| that points to the most
+recently created passive node. Another global variable, |printed_node|,
+is used to help print out the paragraph when detailed information about
+the line-breaking computation is being displayed.
+
+@d passive_node_size=2 {number of words in passive nodes}
+@d cur_break==rlink {in passive node, points to position of this breakpoint}
+@d prev_break==llink {points to passive node that should precede this one}
+@d serial==info {serial number for symbolic identification}
+
+@<Glob...@>=
+@!passive:pointer; {most recent node on passive list}
+@!printed_node:pointer; {most recent node that has been printed}
+@!pass_number:halfword; {the number of passive nodes allocated on this pass}
+
+@ The active list also contains ``delta'' nodes that help the algorithm
+compute the badness of individual lines. Such nodes appear only between two
+active nodes, and they have |type=delta_node|. If |p| and |r| are active nodes
+and if |q| is a delta node between them, so that |link(p)=q| and |link(q)=r|,
+then |q| tells the space difference between lines in the horizontal list that
+start after breakpoint |p| and lines that start after breakpoint |r|. In
+other words, if we know the length of the line that starts after |p| and
+ends at our current position, then the corresponding length of the line that
+starts after |r| is obtained by adding the amounts in node~|q|. A delta node
+contains six scaled numbers, since it must record the net change in glue
+stretchability with respect to all orders of infinity. The natural width
+difference appears in |mem[q+1].sc|; the stretch differences in units of
+pt, fil, fill, and filll appear in |mem[q+2..q+5].sc|; and the shrink difference
+appears in |mem[q+6].sc|. The |subtype| field of a delta node is not used.
+
+@d delta_node_size=7 {number of words in a delta node}
+@d delta_node=2 {|type| field in a delta node}
+
+@ As the algorithm runs, it maintains a set of six delta-like registers
+for the length of the line following the first active breakpoint to the
+current position in the given hlist. When it makes a pass through the
+active list, it also maintains a similar set of six registers for the
+length following the active breakpoint of current interest. A third set
+holds the length of an empty line (namely, the sum of \.{\\leftskip} and
+\.{\\rightskip}); and a fourth set is used to create new delta nodes.
+
+When we pass a delta node we want to do operations like
+$$\hbox{\ignorespaces|for
+k:=1 to 6 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
+want to do this without the overhead of |for| loops. The |do_all_six|
+macro makes such six-tuples convenient.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6)
+
+@<Glo...@>=
+@!active_width:array[1..6] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..6] of scaled; {distance from current active node}
+@!background:array[1..6] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..6] of scaled; {length being computed after current break}
+
+@ Let's state the principles of the delta nodes more precisely and concisely,
+so that the following programs will be less obscure. For each legal
+breakpoint~|p| in the paragraph, we define two quantities $\alpha(p)$ and
+$\beta(p)$ such that the length of material in a line from breakpoint~|p|
+to breakpoint~|q| is $\gamma+\beta(q)-\alpha(p)$, for some fixed $\gamma$.
+Intuitively, $\alpha(p)$ and $\beta(q)$ are the total length of material from
+the beginning of the paragraph to a point ``after'' a break at |p| and to a
+point ``before'' a break at |q|; and $\gamma$ is the width of an empty line,
+namely the length contributed by \.{\\leftskip} and \.{\\rightskip}.
+
+Suppose, for example, that the paragraph consists entirely of alternating
+boxes and glue skips; let the boxes have widths $x_1\ldots x_n$ and
+let the skips have widths $y_1\ldots y_n$, so that the paragraph can be
+represented by $x_1y_1\ldots x_ny_n$. Let $p_i$ be the legal breakpoint
+at $y_i$; then $\alpha(p_i)=x_1+y_1+\cdots+x_i+y_i$, and $\beta(p_i)=
+x_1+y_1+\cdots+x_i$. To check this, note that the length of material from
+$p_2$ to $p_5$, say, is $\gamma+x_3+y_3+x_4+y_4+x_5=\gamma+\beta(p_5)
+-\alpha(p_2)$.
+
+The quantities $\alpha$, $\beta$, $\gamma$ involve glue stretchability and
+shrinkability as well as a natural width. If we were to compute $\alpha(p)$
+and $\beta(p)$ for each |p|, we would need multiple precision arithmetic, and
+the multiprecise numbers would have to be kept in the active nodes.
+\TeX\ avoids this problem by working entirely with relative differences
+or ``deltas.'' Suppose, for example, that the active list contains
+$a_1\,\delta_1\,a_2\,\delta_2\,a_3$, where the |a|'s are active breakpoints
+and the $\delta$'s are delta nodes. Then $\delta_1=\alpha(a_1)-\alpha(a_2)$
+and $\delta_2=\alpha(a_2)-\alpha(a_3)$. If the line breaking algorithm is
+currently positioned at some other breakpoint |p|, the |active_width| array
+contains the value $\gamma+\beta(p)-\alpha(a_1)$. If we are scanning through
+the list of active nodes and considering a tentative line that runs from
+$a_2$ to~|p|, say, the |cur_active_width| array will contain the value
+$\gamma+\beta(p)-\alpha(a_2)$. Thus, when we move from $a_2$ to $a_3$,
+we want to add $\alpha(a_2)-\alpha(a_3)$ to |cur_active_width|; and this
+is just $\delta_2$, which appears in the active list between $a_2$ and
+$a_3$. The |background| array contains $\gamma$. The |break_width| array
+will be used to calculate values of new delta nodes when the active
+list is being updated.
+
+@ Glue nodes in a horizontal list that is being paragraphed are not supposed to
+include ``infinite'' shrinkability; that is why the algorithm maintains
+four registers for stretching but only one for shrinking. If the user tries to
+introduce infinite shrinkability, the shrinkability will be reset to finite
+and an error message will be issued. A boolean variable |no_shrink_error_yet|
+prevents this error message from appearing more than once per paragraph.
+
+@d check_shrinkage(#)==if (shrink_order(#)<>normal)and(shrink(#)<>0) then
+ begin #:=finite_shrink(#);
+ end
+
+@<Glob...@>=
+@!no_shrink_error_yet:boolean; {have we complained about infinite shrinkage?}
+
+@ @<Declare subprocedures for |line_break|@>=
+function finite_shrink(@!p:pointer):pointer; {recovers from infinite shrinkage}
+var q:pointer; {new glue specification}
+begin if no_shrink_error_yet then
+ begin no_shrink_error_yet:=false;
+ print_err("Infinite glue shrinkage found in a paragraph");
+@.Infinite glue shrinkage...@>
+ help5("The paragraph just ended includes some glue that has")@/
+ ("infinite shrinkability, e.g., `\hskip 0pt minus 1fil'.")@/
+ ("Such glue doesn't belong there---it allows a paragraph")@/
+ ("of any length to fit on one line. But it's safe to proceed,")@/
+ ("since the offensive shrinkability has been made finite.");
+ error;
+ end;
+q:=new_spec(p); shrink_order(q):=normal;
+delete_glue_ref(p); finite_shrink:=q;
+end;
+
+@ @<Get ready to start...@>=
+no_shrink_error_yet:=true;@/
+check_shrinkage(left_skip); check_shrinkage(right_skip);@/
+q:=left_skip; r:=right_skip; background[1]:=width(q)+width(r);@/
+background[2]:=0; background[3]:=0; background[4]:=0; background[5]:=0;@/
+background[2+stretch_order(q)]:=stretch(q);@/
+background[2+stretch_order(r)]:=@|background[2+stretch_order(r)]+stretch(r);@/
+background[6]:=shrink(q)+shrink(r);
+
+@ A pointer variable |cur_p| runs through the given horizontal list as we look
+for breakpoints. This variable is global, since it is used both by |line_break|
+and by its subprocedure |try_break|.
+
+Another global variable called |threshold| is used to determine the feasibility
+of individual lines: breakpoints are feasible if there is a way to reach
+them without creating lines whose badness exceeds |threshold|. (The
+badness is compared to |threshold| before penalties are added, so that
+penalty values do not affect the feasibility of breakpoints, except that
+no break is allowed when the penalty is 10000 or more.) If |threshold|
+is 10000 or more, all legal breaks are considered feasible, since the
+|badness| function specified above never returns a value greater than~10000.
+
+Up to three passes might be made through the paragraph in an attempt to find at
+least one set of feasible breakpoints. On the first pass, we have
+|threshold=pretolerance| and |second_pass=final_pass=false|.
+If this pass fails to find a
+feasible solution, |threshold| is set to |tolerance|, |second_pass| is set
+|true|, and an attempt is made to hyphenate as many words as possible.
+If that fails too, we add |emergency_stretch| to the background
+stretchability and set |final_pass=true|.
+
+@<Glob...@>=
+@!cur_p:pointer; {the current breakpoint under consideration}
+@!second_pass:boolean; {is this our second attempt to break this paragraph?}
+@!final_pass:boolean; {is this our final attempt to break this paragraph?}
+@!threshold:integer; {maximum badness on feasible lines}
+
+@ The heart of the line-breaking procedure is `|try_break|', a subroutine
+that tests if the current breakpoint |cur_p| is feasible, by running
+through the active list to see what lines of text can be made from active
+nodes to~|cur_p|. If feasible breaks are possible, new break nodes are
+created. If |cur_p| is too far from an active node, that node is
+deactivated.
+
+The parameter |pi| to |try_break| is the penalty associated
+with a break at |cur_p|; we have |pi=eject_penalty| if the break is forced,
+and |pi=inf_penalty| if the break is illegal.
+
+The other parameter, |break_type|, is set to |hyphenated| or |unhyphenated|,
+depending on whether or not the current break is at a |disc_node|. The
+end of a paragraph is also regarded as `|hyphenated|'; this case is
+distinguishable by the condition |cur_p=null|.
+
+@d copy_to_cur_active(#)==cur_active_width[#]:=active_width[#]
+@d deactivate=60 {go here when node |r| should be deactivated}
+
+@<Declare subprocedures for |line_break|@>=
+procedure try_break(@!pi:integer;@!break_type:small_number);
+label exit,done,done1,continue,deactivate;
+var r:pointer; {runs through the active list}
+@!prev_r:pointer; {stays a step behind |r|}
+@!old_l:halfword; {maximum line number in current equivalence class of lines}
+@!no_break_yet:boolean; {have we found a feasible break at |cur_p|?}
+@<Other local variables for |try_break|@>@;
+begin @<Make sure that |pi| is in the proper range@>;
+no_break_yet:=true; prev_r:=active; old_l:=0;
+do_all_six(copy_to_cur_active);
+loop@+ begin continue: r:=link(prev_r);
+ @<If node |r| is of type |delta_node|, update |cur_active_width|,
+ set |prev_r| and |prev_prev_r|, then |goto continue|@>;
+ @<If a line number class has ended, create new active nodes for
+ the best feasible breaks in that class; then |return|
+ if |r=last_active|, otherwise compute the new |line_width|@>;
+ @<Consider the demerits for a line from |r| to |cur_p|;
+ deactivate node |r| if it should no longer be active;
+ then |goto continue| if a line from |r| to |cur_p| is infeasible,
+ otherwise record a new feasible break@>;
+ end;
+exit: @!stat @<Update the value of |printed_node| for
+ symbolic displays@>@+tats@;
+end;
+
+@ @<Other local variables for |try_break|@>=
+@!prev_prev_r:pointer; {a step behind |prev_r|, if |type(prev_r)=delta_node|}
+@!s:pointer; {runs through nodes ahead of |cur_p|}
+@!q:pointer; {points to a new node being created}
+@!v:pointer; {points to a glue specification or a node ahead of |cur_p|}
+@!t:integer; {node count, if |cur_p| is a discretionary node}
+@!f:internal_font_number; {used in character width calculation}
+@!l:halfword; {line number of current active node}
+@!node_r_stays_active:boolean; {should node |r| remain in the active list?}
+@!line_width:scaled; {the current line will be justified to this width}
+@!fit_class:very_loose_fit..tight_fit; {possible fitness class of test line}
+@!b:halfword; {badness of test line}
+@!d:integer; {demerits of test line}
+@!artificial_demerits:boolean; {has |d| been forced to zero?}
+@!save_link:pointer; {temporarily holds value of |link(cur_p)|}
+@!shortfall:scaled; {used in badness calculations}
+
+@ @<Make sure that |pi| is in the proper range@>=
+if abs(pi)>=inf_penalty then
+ if pi>0 then return {this breakpoint is inhibited by infinite penalty}
+ else pi:=eject_penalty {this breakpoint will be forced}
+
+@ The following code uses the fact that |type(last_active)<>delta_node|.
+
+@d update_width(#)==@|
+ cur_active_width[#]:=cur_active_width[#]+mem[r+#].sc
+
+@<If node |r|...@>=
+@^inner loop@>
+if type(r)=delta_node then
+ begin do_all_six(update_width);
+ prev_prev_r:=prev_r; prev_r:=r; goto continue;
+ end
+
+@ As we consider various ways to end a line at |cur_p|, in a given line number
+class, we keep track of the best total demerits known, in an array with
+one entry for each of the fitness classifications. For example,
+|minimal_demerits[tight_fit]| contains the fewest total demerits of feasible
+line breaks ending at |cur_p| with a |tight_fit| line; |best_place[tight_fit]|
+points to the passive node for the break before~|cur_p| that achieves such
+an optimum; and |best_pl_line[tight_fit]| is the |line_number| field in the
+active node corresponding to |best_place[tight_fit]|. When no feasible break
+sequence is known, the |minimal_demerits| entries will be equal to
+|awful_bad|, which is $2^{30}-1$. Another variable, |minimum_demerits|,
+keeps track of the smallest value in the |minimal_demerits| array.
+
+@d awful_bad==@'7777777777 {more than a billion demerits}
+
+@<Global...@>=
+@!minimal_demerits:array[very_loose_fit..tight_fit] of integer; {best total
+ demerits known for current line class and position, given the fitness}
+@!minimum_demerits:integer; {best total demerits known for current line class
+ and position}
+@!best_place:array[very_loose_fit..tight_fit] of pointer; {how to achieve
+ |minimal_demerits|}
+@!best_pl_line:array[very_loose_fit..tight_fit] of halfword; {corresponding
+ line number}
+
+@ @<Get ready to start...@>=
+minimum_demerits:=awful_bad;
+minimal_demerits[tight_fit]:=awful_bad;
+minimal_demerits[decent_fit]:=awful_bad;
+minimal_demerits[loose_fit]:=awful_bad;
+minimal_demerits[very_loose_fit]:=awful_bad;
+
+@ The first part of the following code is part of \TeX's inner loop, so
+we don't want to waste any time. The current active node, namely node |r|,
+contains the line number that will be considered next. At the end of the
+list we have arranged the data structure so that |r=last_active| and
+|line_number(last_active)>old_l|.
+@^inner loop@>
+
+@<If a line number class...@>=
+begin l:=line_number(r);
+if l>old_l then
+ begin {now we are no longer in the inner loop}
+ if (minimum_demerits<awful_bad)and@|
+ ((old_l<>easy_line)or(r=last_active)) then
+ @<Create new active nodes for the best feasible breaks
+ just found@>;
+ if r=last_active then return;
+ @<Compute the new line width@>;
+ end;
+end
+
+@ It is not necessary to create new active nodes having |minimal_demerits|
+greater than
+|minimum_demerits+abs(adj_demerits)|, since such active nodes will never
+be chosen in the final paragraph breaks. This observation allows us to
+omit a substantial number of feasible breakpoints from further consideration.
+
+@<Create new active nodes...@>=
+begin if no_break_yet then @<Compute the values of |break_width|@>;
+@<Insert a delta node to prepare for breaks at |cur_p|@>;
+if abs(adj_demerits)>=awful_bad-minimum_demerits then
+ minimum_demerits:=awful_bad-1
+else minimum_demerits:=minimum_demerits+abs(adj_demerits);
+for fit_class:=very_loose_fit to tight_fit do
+ begin if minimal_demerits[fit_class]<=minimum_demerits then
+ @<Insert a new active node
+ from |best_place[fit_class]| to |cur_p|@>;
+ minimal_demerits[fit_class]:=awful_bad;
+ end;
+minimum_demerits:=awful_bad;
+@<Insert a delta node to prepare for the next active node@>;
+end
+
+@ When we insert a new active node for a break at |cur_p|, suppose this
+new node is to be placed just before active node |a|; then we essentially
+want to insert `$\delta\,|cur_p|\,\delta^\prime$' before |a|, where
+$\delta=\alpha(a)-\alpha(|cur_p|)$ and $\delta^\prime=\alpha(|cur_p|)-\alpha(a)$
+in the notation explained above. The |cur_active_width| array now holds
+$\gamma+\beta(|cur_p|)-\alpha(a)$; so $\delta$ can be obtained by
+subtracting |cur_active_width| from the quantity $\gamma+\beta(|cur_p|)-
+\alpha(|cur_p|)$. The latter quantity can be regarded as the length of a
+line ``from |cur_p| to |cur_p|''; we call it the |break_width| at |cur_p|.
+
+The |break_width| is usually negative, since it consists of the background
+(which is normally zero) minus the width of nodes following~|cur_p| that are
+eliminated after a break. If, for example, node |cur_p| is a glue node, the
+width of this glue is subtracted from the background; and we also look
+ahead to eliminate all subsequent glue and penalty and kern and math
+nodes, subtracting their widths as well.
+
+Kern nodes do not disappear at a line break unless they are |explicit|.
+
+@d set_break_width_to_background(#)==break_width[#]:=background[#]
+
+@<Compute the values of |break...@>=
+begin no_break_yet:=false; do_all_six(set_break_width_to_background);
+s:=cur_p;
+if break_type>unhyphenated then if cur_p<>null then
+ @<Compute the discretionary |break_width| values@>;
+while s<>null do
+ begin if is_char_node(s) then goto done;
+ case type(s) of
+ glue_node:@<Subtract glue from |break_width|@>;
+ penalty_node: do_nothing;
+ math_node: break_width[1]:=break_width[1]-width(s);
+ kern_node: if subtype(s)<>explicit then goto done
+ else break_width[1]:=break_width[1]-width(s);
+ othercases goto done
+ endcases;@/
+ s:=link(s);
+ end;
+done: end
+
+@ @<Subtract glue from |break...@>=
+begin v:=glue_ptr(s); break_width[1]:=break_width[1]-width(v);
+break_width[2+stretch_order(v)]:=break_width[2+stretch_order(v)]-stretch(v);
+break_width[6]:=break_width[6]-shrink(v);
+end
+
+@ When |cur_p| is a discretionary break, the length of a line ``from |cur_p| to
+|cur_p|'' has to be defined properly so that the other calculations work out.
+Suppose that the pre-break text at |cur_p| has length $l_0$, the post-break
+text has length $l_1$, and the replacement text has length |l|. Suppose
+also that |q| is the node following the replacement text. Then length of a
+line from |cur_p| to |q| will be computed as $\gamma+\beta(q)-\alpha(|cur_p|)$,
+where $\beta(q)=\beta(|cur_p|)-l_0+l$. The actual length will be the background
+plus $l_1$, so the length from |cur_p| to |cur_p| should be $\gamma+l_0+l_1-l$.
+If the post-break text of the discretionary is empty, a break may also
+discard~|q|; in that unusual case we subtract the length of~|q| and any
+other nodes that will be discarded after the discretionary break.
+
+The value of $l_0$ need not be computed, since |line_break| will put
+it into the global variable |disc_width| before calling |try_break|.
+
+@<Glob...@>=
+@!disc_width:scaled; {the length of discretionary material preceding a break}
+
+@ @<Compute the discretionary |break...@>=
+begin t:=replace_count(cur_p); v:=cur_p; s:=post_break(cur_p);
+while t>0 do
+ begin decr(t); v:=link(v);
+ @<Subtract the width of node |v| from |break_width|@>;
+ end;
+while s<>null do
+ begin @<Add the width of node |s| to |break_width|@>;
+ s:=link(s);
+ end;
+break_width[1]:=break_width[1]+disc_width;
+if post_break(cur_p)=null then s:=link(v);
+ {nodes may be discardable after the break}
+end
+
+@ Replacement texts and discretionary texts are supposed to contain
+only character nodes, kern nodes, ligature nodes, and box or rule nodes.
+
+@<Subtract the width of node |v|...@>=
+if is_char_node(v) then
+ begin f:=font(v);
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+else case type(v) of
+ ligature_node: begin f:=font(lig_char(v));@/
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]-width(v);
+ othercases confusion("disc1")
+@:this can't happen disc1}{\quad disc1@>
+ endcases
+
+@ @<Add the width of node |s| to |b...@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]+width(s);
+ othercases confusion("disc2")
+@:this can't happen disc2}{\quad disc2@>
+ endcases
+
+@ We use the fact that |type(active)<>delta_node|.
+
+@d convert_to_break_width(#)==@|
+ mem[prev_r+#].sc:=@|@t\hskip10pt@>mem[prev_r+#].sc
+ -cur_active_width[#]+break_width[#]
+@d store_break_width(#)==active_width[#]:=break_width[#]
+@d new_delta_to_break_width(#)==@|
+ mem[q+#].sc:=break_width[#]-cur_active_width[#]
+
+@<Insert a delta node to prepare for breaks at |cur_p|@>=
+if type(prev_r)=delta_node then {modify an existing delta node}
+ begin do_all_six(convert_to_break_width);
+ end
+else if prev_r=active then {no delta node needed at the beginning}
+ begin do_all_six(store_break_width);
+ end
+else begin q:=get_node(delta_node_size); link(q):=r; type(q):=delta_node;@/
+ subtype(q):=0; {the |subtype| is not used}
+ do_all_six(new_delta_to_break_width);
+ link(prev_r):=q; prev_prev_r:=prev_r; prev_r:=q;
+ end
+
+@ When the following code is performed, we will have just inserted at
+least one active node before |r|, so |type(prev_r)<>delta_node|.
+
+@d new_delta_from_break_width(#)==@|mem[q+#].sc:=
+ cur_active_width[#]-break_width[#]
+
+@<Insert a delta node to prepare for the next active node@>=
+if r<>last_active then
+ begin q:=get_node(delta_node_size); link(q):=r; type(q):=delta_node;@/
+ subtype(q):=0; {the |subtype| is not used}
+ do_all_six(new_delta_from_break_width);
+ link(prev_r):=q; prev_prev_r:=prev_r; prev_r:=q;
+ end
+
+@ When we create an active node, we also create the corresponding
+passive node.
+
+@<Insert a new active node from |best_place[fit_class]| to |cur_p|@>=
+begin q:=get_node(passive_node_size);
+link(q):=passive; passive:=q; cur_break(q):=cur_p;
+@!stat incr(pass_number); serial(q):=pass_number;@+tats@;@/
+prev_break(q):=best_place[fit_class];@/
+q:=get_node(active_node_size); break_node(q):=passive;
+line_number(q):=best_pl_line[fit_class]+1;
+fitness(q):=fit_class; type(q):=break_type;
+total_demerits(q):=minimal_demerits[fit_class];
+link(q):=r; link(prev_r):=q; prev_r:=q;
+@!stat if tracing_paragraphs>0 then
+ @<Print a symbolic description of the new break node@>;
+tats@;@/
+end
+
+@ @<Print a symbolic description of the new break node@>=
+begin print_nl("@@@@"); print_int(serial(passive));
+@.\AT!\AT!@>
+print(": line "); print_int(line_number(q)-1);
+print_char("."); print_int(fit_class);
+if break_type=hyphenated then print_char("-");
+print(" t="); print_int(total_demerits(q));
+print(" -> @@@@");
+if prev_break(passive)=null then print_char("0")
+else print_int(serial(prev_break(passive)));
+end
+
+@ The length of lines depends on whether the user has specified
+\.{\\parshape} or \.{\\hangindent}. If |par_shape_ptr| is not null, it
+points to a $(2n+1)$-word record in |mem|, where the |info| in the first
+word contains the value of |n|, and the other $2n$ words contain the left
+margins and line lengths for the first |n| lines of the paragraph; the
+specifications for line |n| apply to all subsequent lines. If
+|par_shape_ptr=null|, the shape of the paragraph depends on the value of
+|n=hang_after|; if |n>=0|, hanging indentation takes place on lines |n+1|,
+|n+2|, \dots, otherwise it takes place on lines 1, \dots, $\vert
+n\vert$. When hanging indentation is active, the left margin is
+|hang_indent|, if |hang_indent>=0|, else it is 0; the line length is
+$|hsize|-\vert|hang_indent|\vert$. The normal setting is
+|par_shape_ptr=null|, |hang_after=1|, and |hang_indent=0|.
+Note that if |hang_indent=0|, the value of |hang_after| is irrelevant.
+@^length of lines@> @^hanging indentation@>
+
+@<Glob...@>=
+@!easy_line:halfword; {line numbers |>easy_line| are equivalent in break nodes}
+@!last_special_line:halfword; {line numbers |>last_special_line| all have
+ the same width}
+@!first_width:scaled; {the width of all lines |<=last_special_line|, if
+ no \.{\\parshape} has been specified}
+@!second_width:scaled; {the width of all lines |>last_special_line|}
+@!first_indent:scaled; {left margin to go with |first_width|}
+@!second_indent:scaled; {left margin to go with |second_width|}
+
+@ We compute the values of |easy_line| and the other local variables relating
+to line length when the |line_break| procedure is initializing itself.
+
+@<Get ready to start...@>=
+if par_shape_ptr=null then
+ if hang_indent=0 then
+ begin last_special_line:=0; second_width:=hsize;
+ second_indent:=0;
+ end
+ else @<Set line length parameters in preparation for hanging indentation@>
+else begin last_special_line:=info(par_shape_ptr)-1;
+ second_width:=mem[par_shape_ptr+2*(last_special_line+1)].sc;
+ second_indent:=mem[par_shape_ptr+2*last_special_line+1].sc;
+ end;
+if looseness=0 then easy_line:=last_special_line
+else easy_line:=max_halfword
+
+@ @<Set line length parameters in preparation for hanging indentation@>=
+begin last_special_line:=abs(hang_after);
+if hang_after<0 then
+ begin first_width:=hsize-abs(hang_indent);
+ if hang_indent>=0 then first_indent:=hang_indent
+ else first_indent:=0;
+ second_width:=hsize; second_indent:=0;
+ end
+else begin first_width:=hsize; first_indent:=0;
+ second_width:=hsize-abs(hang_indent);
+ if hang_indent>=0 then second_indent:=hang_indent
+ else second_indent:=0;
+ end;
+end
+
+@ When we come to the following code, we have just encountered the first
+active node~|r| whose |line_number| field contains |l|. Thus we want to
+compute the length of the $l\mskip1mu$th line of the current paragraph. Furthermore,
+we want to set |old_l| to the last number in the class of line numbers
+equivalent to~|l|.
+
+@<Compute the new line width@>=
+if l>easy_line then
+ begin line_width:=second_width; old_l:=max_halfword-1;
+ end
+else begin old_l:=l;
+ if l>last_special_line then line_width:=second_width
+ else if par_shape_ptr=null then line_width:=first_width
+ else line_width:=mem[par_shape_ptr+2*l@,].sc;
+ end
+
+@ The remaining part of |try_break| deals with the calculation of
+demerits for a break from |r| to |cur_p|.
+
+The first thing to do is calculate the badness, |b|. This value will always
+be between zero and |inf_bad+1|; the latter value occurs only in the
+case of lines from |r| to |cur_p| that cannot shrink enough to fit the necessary
+width. In such cases, node |r| will be deactivated.
+We also deactivate node~|r| when a break at~|cur_p| is forced, since future
+breaks must go through a forced break.
+
+@<Consider the demerits for a line from |r| to |cur_p|...@>=
+begin artificial_demerits:=false;@/
+@^inner loop@>
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+if shortfall>0 then
+ @<Set the value of |b| to the badness for stretching the line,
+ and compute the corresponding |fit_class|@>
+else @<Set the value of |b| to the badness for shrinking the line,
+ and compute the corresponding |fit_class|@>;
+if (b>inf_bad)or(pi=eject_penalty) then
+ @<Prepare to deactivate node~|r|, and |goto deactivate| unless
+ there is a reason to consider lines of text from |r| to |cur_p|@>
+else begin prev_r:=r;
+ if b>threshold then goto continue;
+ node_r_stays_active:=true;
+ end;
+@<Record a new feasible break@>;
+if node_r_stays_active then goto continue; {|prev_r| has been set to |r|}
+deactivate: @<Deactivate node |r|@>;
+end
+
+@ When a line must stretch, the available stretchability can be found in the
+subarray |cur_active_width[2..5]|, in units of points, fil, fill, and filll.
+
+The present section is part of \TeX's inner loop, and it is most often performed
+when the badness is infinite; therefore it is worth while to make a quick
+test for large width excess and small stretchability, before calling the
+|badness| subroutine.
+@^inner loop@>
+
+@<Set the value of |b| to the badness for stretching...@>=
+if (cur_active_width[3]<>0)or(cur_active_width[4]<>0)or@|
+ (cur_active_width[5]<>0) then
+ begin b:=0; fit_class:=decent_fit; {infinite stretch}
+ end
+else begin if shortfall>7230584 then if cur_active_width[2]<1663497 then
+ begin b:=inf_bad; fit_class:=very_loose_fit; goto done1;
+ end;
+ b:=badness(shortfall,cur_active_width[2]);
+ if b>12 then
+ if b>99 then fit_class:=very_loose_fit
+ else fit_class:=loose_fit
+ else fit_class:=decent_fit;
+ done1:
+ end
+
+@ Shrinkability is never infinite in a paragraph;
+we can shrink the line from |r| to |cur_p| by at most |cur_active_width[6]|.
+
+@<Set the value of |b| to the badness for shrinking...@>=
+begin if -shortfall>cur_active_width[6] then b:=inf_bad+1
+else b:=badness(-shortfall,cur_active_width[6]);
+if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
+end
+
+@ During the final pass, we dare not lose all active nodes, lest we lose
+touch with the line breaks already found. The code shown here makes sure
+that such a catastrophe does not happen, by permitting overfull boxes as
+a last resort. This particular part of \TeX\ was a source of several subtle
+bugs before the correct program logic was finally discovered; readers
+who seek to ``improve'' \TeX\ should therefore think thrice before daring
+to make any changes here.
+@^overfull boxes@>
+
+@<Prepare to deactivate node~|r|, and |goto deactivate| unless...@>=
+begin if final_pass and (minimum_demerits=awful_bad) and@|
+ (link(r)=last_active) and
+ (prev_r=active) then
+ artificial_demerits:=true {set demerits zero, this break is forced}
+else if b>threshold then goto deactivate;
+node_r_stays_active:=false;
+end
+
+@ When we get to this part of the code, the line from |r| to |cur_p| is
+feasible, its badness is~|b|, and its fitness classification is |fit_class|.
+We don't want to make an active node for this break yet, but we will
+compute the total demerits and record them in the |minimal_demerits| array,
+if such a break is the current champion among all ways to get to |cur_p|
+in a given line-number class and fitness class.
+
+@<Record a new feasible break@>=
+if artificial_demerits then d:=0
+else @<Compute the demerits, |d|, from |r| to |cur_p|@>;
+@!stat if tracing_paragraphs>0 then
+ @<Print a symbolic description of this feasible break@>;
+tats@;@/
+d:=d+total_demerits(r); {this is the minimum total demerits
+ from the beginning to |cur_p| via |r|}
+if d<=minimal_demerits[fit_class] then
+ begin minimal_demerits[fit_class]:=d;
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+ if d<minimum_demerits then minimum_demerits:=d;
+ end
+
+@ @<Print a symbolic description of this feasible break@>=
+begin if printed_node<>cur_p then
+ @<Print the list between |printed_node| and |cur_p|,
+ then set |printed_node:=cur_p|@>;
+print_nl("@@");
+@.\AT!@>
+if cur_p=null then print_esc("par")
+else if type(cur_p)<>glue_node then
+ begin if type(cur_p)=penalty_node then print_esc("penalty")
+ else if type(cur_p)=disc_node then print_esc("discretionary")
+ else if type(cur_p)=kern_node then print_esc("kern")
+ else print_esc("math");
+ end;
+print(" via @@@@");
+if break_node(r)=null then print_char("0")
+else print_int(serial(break_node(r)));
+print(" b=");
+if b>inf_bad then print_char("*")@+else print_int(b);
+@.*\relax@>
+print(" p="); print_int(pi); print(" d=");
+if artificial_demerits then print_char("*")@+else print_int(d);
+end
+
+@ @<Print the list between |printed_node| and |cur_p|...@>=
+begin print_nl("");
+if cur_p=null then short_display(link(printed_node))
+else begin save_link:=link(cur_p);
+ link(cur_p):=null; print_nl(""); short_display(link(printed_node));
+ link(cur_p):=save_link;
+ end;
+printed_node:=cur_p;
+end
+
+@ When the data for a discretionary break is being displayed, we will have
+printed the |pre_break| and |post_break| lists; we want to skip over the
+third list, so that the discretionary data will not appear twice. The
+following code is performed at the very end of |try_break|.
+
+@<Update the value of |printed_node|...@>=
+if cur_p=printed_node then if cur_p<>null then if type(cur_p)=disc_node then
+ begin t:=replace_count(cur_p);
+ while t>0 do
+ begin decr(t); printed_node:=link(printed_node);
+ end;
+ end
+
+@ @<Compute the demerits, |d|, from |r| to |cur_p|@>=
+begin d:=line_penalty+b;
+if abs(d)>=10000 then d:=100000000@+else d:=d*d;
+if pi<>0 then
+ if pi>0 then d:=d+pi*pi
+ else if pi>eject_penalty then d:=d-pi*pi;
+if (break_type=hyphenated)and(type(r)=hyphenated) then
+ if cur_p<>null then d:=d+double_hyphen_demerits
+ else d:=d+final_hyphen_demerits;
+if abs(fit_class-fitness(r))>1 then d:=d+adj_demerits;
+end
+
+@ When an active node disappears, we must delete an adjacent delta node if the
+active node was at the beginning or the end of the active list, or if it
+was surrounded by delta nodes. We also must preserve the property that
+|cur_active_width| represents the length of material from |link(prev_r)|
+to~|cur_p|.
+
+@d combine_two_deltas(#)==@|mem[prev_r+#].sc:=mem[prev_r+#].sc+mem[r+#].sc
+@d downdate_width(#)==@|cur_active_width[#]:=cur_active_width[#]-
+ mem[prev_r+#].sc
+
+@<Deactivate node |r|@>=
+link(prev_r):=link(r); free_node(r,active_node_size);
+if prev_r=active then @<Update the active widths, since the first active
+ node has been deleted@>
+else if type(prev_r)=delta_node then
+ begin r:=link(prev_r);
+ if r=last_active then
+ begin do_all_six(downdate_width);
+ link(prev_prev_r):=last_active;
+ free_node(prev_r,delta_node_size); prev_r:=prev_prev_r;
+ end
+ else if type(r)=delta_node then
+ begin do_all_six(update_width);
+ do_all_six(combine_two_deltas);
+ link(prev_r):=link(r); free_node(r,delta_node_size);
+ end;
+ end
+
+@ The following code uses the fact that |type(last_active)<>delta_node|. If the
+active list has just become empty, we do not need to update the
+|active_width| array, since it will be initialized when an active
+node is next inserted.
+
+@d update_active(#)==active_width[#]:=active_width[#]+mem[r+#].sc
+
+@<Update the active widths,...@>=
+begin r:=link(active);
+if type(r)=delta_node then
+ begin do_all_six(update_active);
+ do_all_six(copy_to_cur_active);
+ link(active):=link(r); free_node(r,delta_node_size);
+ end;
+end
+
+@* \[39] Breaking paragraphs into lines, continued.
+So far we have gotten a little way into the |line_break| routine, having
+covered its important |try_break| subroutine. Now let's consider the
+rest of the process.
+
+The main loop of |line_break| traverses the given hlist,
+starting at |link(temp_head)|, and calls |try_break| at each legal
+breakpoint. A variable called |auto_breaking| is set to true except
+within math formulas, since glue nodes are not legal breakpoints when
+they appear in formulas.
+
+The current node of interest in the hlist is pointed to by |cur_p|. Another
+variable, |prev_p|, is usually one step behind |cur_p|, but the real
+meaning of |prev_p| is this: If |type(cur_p)=glue_node| then |cur_p| is a legal
+breakpoint if and only if |auto_breaking| is true and |prev_p| does not
+point to a glue node, penalty node, explicit kern node, or math node.
+
+The following declarations provide for a few other local variables that are
+used in special calculations.
+
+@<Local variables for line breaking@>=
+@!auto_breaking:boolean; {is node |cur_p| outside a formula?}
+@!prev_p:pointer; {helps to determine when glue nodes are breakpoints}
+@!q,@!r,@!s,@!prev_s:pointer; {miscellaneous nodes of temporary interest}
+@!f:internal_font_number; {used when calculating character widths}
+
+@ The `\ignorespaces|loop|\unskip' in the following code is performed at most
+thrice per call of |line_break|, since it is actually a pass over the
+entire paragraph.
+
+@<Find optimal breakpoints@>=
+threshold:=pretolerance;
+if threshold>=0 then
+ begin @!stat if tracing_paragraphs>0 then
+ begin begin_diagnostic; print_nl("@@firstpass");@+end;@;@+tats@;@/
+ second_pass:=false; final_pass:=false;
+ end
+else begin threshold:=tolerance; second_pass:=true;
+ final_pass:=(emergency_stretch<=0);
+ @!stat if tracing_paragraphs>0 then begin_diagnostic;@+tats@;
+ end;
+loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
+ if second_pass then @<Initialize for hyphenating a paragraph@>;
+ @<Create an active breakpoint representing the beginning of the paragraph@>;
+ cur_p:=link(temp_head); auto_breaking:=true;@/
+ prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
+ while (cur_p<>null)and(link(active)<>last_active) do
+ @<Call |try_break| if |cur_p| is a legal breakpoint;
+ on the second pass, also try to hyphenate the next
+ word, if |cur_p| is a glue node;
+ then advance |cur_p| to the next node of the paragraph
+ that could possibly be a legal breakpoint@>;
+ if cur_p=null then
+ @<Try the final line break at the end of the paragraph,
+ and |goto done| if the desired breakpoints have been found@>;
+ @<Clean up the memory by removing the break nodes@>;
+ if not second_pass then
+ begin@!stat if tracing_paragraphs>0 then print_nl("@@secondpass");@;@+tats@/
+ threshold:=tolerance; second_pass:=true; final_pass:=(emergency_stretch<=0);
+ end {if at first you don't succeed, \dots}
+ else begin @!stat if tracing_paragraphs>0 then
+ print_nl("@@emergencypass");@;@+tats@/
+ background[2]:=background[2]+emergency_stretch; final_pass:=true;
+ end;
+ end;
+done: @!stat if tracing_paragraphs>0 then
+ begin end_diagnostic(true); normalize_selector;
+ end;@+tats@/
+
+@ The active node that represents the starting point does not need a
+corresponding passive node.
+
+@d store_background(#)==active_width[#]:=background[#]
+
+@<Create an active breakpoint representing the beginning of the paragraph@>=
+q:=get_node(active_node_size);
+type(q):=unhyphenated; fitness(q):=decent_fit;
+link(q):=last_active; break_node(q):=null;
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+do_all_six(store_background);@/
+passive:=null; printed_node:=temp_head; pass_number:=0;
+font_in_short_display:=null_font
+
+@ @<Clean...@>=
+q:=link(active);
+while q<>last_active do
+ begin cur_p:=link(q);
+ if type(q)=delta_node then free_node(q,delta_node_size)
+ else free_node(q,active_node_size);
+ q:=cur_p;
+ end;
+q:=passive;
+while q<>null do
+ begin cur_p:=link(q);
+ free_node(q,passive_node_size);
+ q:=cur_p;
+ end
+
+@ Here is the main switch in the |line_break| routine, where legal breaks
+are determined. As we move through the hlist, we need to keep the |active_width|
+array up to date, so that the badness of individual lines is readily calculated
+by |try_break|. It is convenient to use the short name |act_width| for
+the component of active width that represents real width as opposed to glue.
+
+@d act_width==active_width[1] {length from first active node to current node}
+@d kern_break==begin if not is_char_node(link(cur_p)) and auto_breaking then
+ if type(link(cur_p))=glue_node then try_break(0,unhyphenated);
+ act_width:=act_width+width(cur_p);
+ end
+
+@<Call |try_break| if |cur_p| is a legal breakpoint...@>=
+begin if is_char_node(cur_p) then
+ @<Advance \(c)|cur_p| to the node following the present
+ string of characters@>;
+case type(cur_p) of
+hlist_node,vlist_node,rule_node: act_width:=act_width+width(cur_p);
+whatsit_node: @<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>;
+glue_node: begin @<If node |cur_p| is a legal breakpoint, call |try_break|;
+ then update the active widths by including the glue in |glue_ptr(cur_p)|@>;
+ if second_pass and auto_breaking then
+ @<Try to hyphenate the following word@>;
+ end;
+kern_node: if subtype(cur_p)=explicit then kern_break
+ else act_width:=act_width+width(cur_p);
+ligature_node: begin f:=font(lig_char(cur_p));
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+ end;
+disc_node: @<Try to break after a discretionary fragment, then |goto done5|@>;
+math_node: begin auto_breaking:=(subtype(cur_p)=after); kern_break;
+ end;
+penalty_node: try_break(penalty(cur_p),unhyphenated);
+mark_node,ins_node,adjust_node: do_nothing;
+othercases confusion("paragraph")
+@:this can't happen paragraph}{\quad paragraph@>
+endcases;@/
+prev_p:=cur_p; cur_p:=link(cur_p);
+done5:end
+
+@ The code that passes over the characters of words in a paragraph is
+part of \TeX's inner loop, so it has been streamlined for speed. We use
+the fact that `\.{\\parfillskip}' glue appears at the end of each paragraph;
+it is therefore unnecessary to check if |link(cur_p)=null| when |cur_p| is a
+character node.
+@^inner loop@>
+
+@<Advance \(c)|cur_p| to the node following the present string...@>=
+begin prev_p:=cur_p;
+repeat f:=font(cur_p);
+act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+cur_p:=link(cur_p);
+until not is_char_node(cur_p);
+end
+
+@ When node |cur_p| is a glue node, we look at |prev_p| to see whether or not
+a breakpoint is legal at |cur_p|, as explained above.
+
+@<If node |cur_p| is a legal breakpoint, call...@>=
+if auto_breaking then
+ begin if is_char_node(prev_p) then try_break(0,unhyphenated)
+ else if precedes_break(prev_p) then try_break(0,unhyphenated)
+ else if (type(prev_p)=kern_node)and(subtype(prev_p)<>explicit) then
+ try_break(0,unhyphenated);
+ end;
+check_shrinkage(glue_ptr(cur_p)); q:=glue_ptr(cur_p);
+act_width:=act_width+width(q);@|
+active_width[2+stretch_order(q)]:=@|
+ active_width[2+stretch_order(q)]+stretch(q);@/
+active_width[6]:=active_width[6]+shrink(q)
+
+@ The following code knows that discretionary texts contain
+only character nodes, kern nodes, box nodes, rule nodes, and ligature nodes.
+
+@<Try to break after a discretionary fragment...@>=
+begin s:=pre_break(cur_p); disc_width:=0;
+if s=null then try_break(ex_hyphen_penalty,hyphenated)
+else begin repeat @<Add the width of node |s| to |disc_width|@>;
+ s:=link(s);
+ until s=null;
+ act_width:=act_width+disc_width;
+ try_break(hyphen_penalty,hyphenated);
+ act_width:=act_width-disc_width;
+ end;
+r:=replace_count(cur_p); s:=link(cur_p);
+while r>0 do
+ begin @<Add the width of node |s| to |act_width|@>;
+ decr(r); s:=link(s);
+ end;
+prev_p:=cur_p; cur_p:=s; goto done5;
+end
+
+@ @<Add the width of node |s| to |disc_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ disc_width:=disc_width+width(s);
+ othercases confusion("disc3")
+@:this can't happen disc3}{\quad disc3@>
+ endcases
+
+@ @<Add the width of node |s| to |act_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ act_width:=act_width+width(s);
+ othercases confusion("disc4")
+@:this can't happen disc4}{\quad disc4@>
+ endcases
+
+@ The forced line break at the paragraph's end will reduce the list of
+breakpoints so that all active nodes represent breaks at |cur_p=null|.
+On the first pass, we insist on finding an active node that has the
+correct ``looseness.'' On the final pass, there will be at least one active
+node, and we will match the desired looseness as well as we can.
+
+The global variable |best_bet| will be set to the active node for the best
+way to break the paragraph, and a few other variables are used to
+help determine what is best.
+
+@<Glob...@>=
+@!best_bet:pointer; {use this passive node and its predecessors}
+@!fewest_demerits:integer; {the demerits associated with |best_bet|}
+@!best_line:halfword; {line number following the last line of the new paragraph}
+@!actual_looseness:integer; {the difference between |line_number(best_bet)|
+ and the optimum |best_line|}
+@!line_diff:integer; {the difference between the current line number and
+ the optimum |best_line|}
+
+@ @<Try the final line break at the end of the paragraph...@>=
+begin try_break(eject_penalty,hyphenated);
+if link(active)<>last_active then
+ begin @<Find an active node with fewest demerits@>;
+ if looseness=0 then goto done;
+ @<Find the best active node for the desired looseness@>;
+ if (actual_looseness=looseness)or final_pass then goto done;
+ end;
+end
+
+@ @<Find an active node...@>=
+r:=link(active); fewest_demerits:=awful_bad;
+repeat if type(r)<>delta_node then if total_demerits(r)<fewest_demerits then
+ begin fewest_demerits:=total_demerits(r); best_bet:=r;
+ end;
+r:=link(r);
+until r=last_active;
+best_line:=line_number(best_bet)
+
+@ The adjustment for a desired looseness is a slightly more complicated
+version of the loop just considered. Note that if a paragraph is broken
+into segments by displayed equations, each segment will be subject to the
+looseness calculation, independently of the other segments.
+
+@<Find the best active node...@>=
+begin r:=link(active); actual_looseness:=0;
+repeat if type(r)<>delta_node then
+ begin line_diff:=line_number(r)-best_line;
+ if ((line_diff<actual_looseness)and(looseness<=line_diff))or@|
+ ((line_diff>actual_looseness)and(looseness>=line_diff)) then
+ begin best_bet:=r; actual_looseness:=line_diff;
+ fewest_demerits:=total_demerits(r);
+ end
+ else if (line_diff=actual_looseness)and@|
+ (total_demerits(r)<fewest_demerits) then
+ begin best_bet:=r; fewest_demerits:=total_demerits(r);
+ end;
+ end;
+r:=link(r);
+until r=last_active;
+best_line:=line_number(best_bet);
+end
+
+@ Once the best sequence of breakpoints has been found (hurray), we call on the
+procedure |post_line_break| to finish the remainder of the work.
+(By introducing this subprocedure, we are able to keep |line_break|
+from getting extremely long.)
+
+@<Break the paragraph at the chosen...@>=
+post_line_break(final_widow_penalty)
+
+@ The total number of lines that will be set by |post_line_break|
+is |best_line-prev_graf-1|. The last breakpoint is specified by
+|break_node(best_bet)|, and this passive node points to the other breakpoints
+via the |prev_break| links. The finishing-up phase starts by linking the
+relevant passive nodes in forward order, changing |prev_break| to
+|next_break|. (The |next_break| fields actually reside in the same memory
+space as the |prev_break| fields did, but we give them a new name because
+of their new significance.) Then the lines are justified, one by one.
+
+@d next_break==prev_break {new name for |prev_break| after links are reversed}
+
+@<Declare subprocedures for |line_break|@>=
+procedure post_line_break(@!final_widow_penalty:integer);
+label done,done1;
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@!disc_break:boolean; {was the current break at a discretionary node?}
+@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
+@!cur_width:scaled; {width of line number |cur_line|}
+@!cur_indent:scaled; {left margin of line number |cur_line|}
+@!t:quarterword; {used for replacement counts in discretionary nodes}
+@!pen:integer; {use when calculating penalties between lines}
+@!cur_line: halfword; {the current line number being justified}
+begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+ first breakpoint@>;
+cur_line:=prev_graf+1;
+repeat @<Justify the line ending at breakpoint |cur_p|, and append it to the
+ current vertical list, together with associated penalties and other
+ insertions@>;
+incr(cur_line); cur_p:=next_break(cur_p);
+if cur_p<>null then if not post_disc_break then
+ @<Prune unwanted nodes at the beginning of the next line@>;
+until cur_p=null;
+if (cur_line<>best_line)or(link(temp_head)<>null) then
+ confusion("line breaking");
+@:this can't happen line breaking}{\quad line breaking@>
+prev_graf:=best_line-1;
+end;
+
+@ The job of reversing links in a list is conveniently regarded as the job
+of taking items off one stack and putting them on another. In this case we
+take them off a stack pointed to by |q| and having |prev_break| fields;
+we put them on a stack pointed to by |cur_p| and having |next_break| fields.
+Node |r| is the passive node being moved from stack to stack.
+
+@<Reverse the links of the relevant passive nodes...@>=
+q:=break_node(best_bet); cur_p:=null;
+repeat r:=q; q:=prev_break(q); next_break(r):=cur_p; cur_p:=r;
+until q=null
+
+@ Glue and penalty and kern and math nodes are deleted at the beginning of
+a line, except in the anomalous case that the node to be deleted is actually
+one of the chosen breakpoints. Otherwise
+the pruning done here is designed to match
+the lookahead computation in |try_break|, where the |break_width| values
+are computed for non-discretionary breakpoints.
+
+@<Prune unwanted nodes at the beginning of the next line@>=
+begin r:=temp_head;
+loop@+ begin q:=link(r);
+ if q=cur_break(cur_p) then goto done1;
+ {|cur_break(cur_p)| is the next breakpoint}
+ {now |q| cannot be |null|}
+ if is_char_node(q) then goto done1;
+ if non_discardable(q) then goto done1;
+ if type(q)=kern_node then if subtype(q)<>explicit then goto done1;
+ r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
+ end;
+done1: if r<>temp_head then
+ begin link(r):=null; flush_node_list(link(temp_head));
+ link(temp_head):=q;
+ end;
+end
+
+@ The current line to be justified appears in a horizontal list starting
+at |link(temp_head)| and ending at |cur_break(cur_p)|. If |cur_break(cur_p)| is
+a glue node, we reset the glue to equal the |right_skip| glue; otherwise
+we append the |right_skip| glue at the right. If |cur_break(cur_p)| is a
+discretionary node, we modify the list so that the discretionary break
+is compulsory, and we set |disc_break| to |true|. We also append
+the |left_skip| glue at the left of the line, unless it is zero.
+
+@<Justify the line ending at breakpoint |cur_p|, and append it...@>=
+@<Modify the end of the line to reflect the nature of the break and to include
+ \.{\\rightskip}; also set the proper value of |disc_break|@>;
+@<Put the \(l)\.{\\leftskip} glue at the left and detach this line@>;
+@<Call the packaging subroutine, setting |just_box| to the justified box@>;
+@<Append the new box to the current vertical list, followed by the list of
+ special nodes taken out of the box by the packager@>;
+@<Append a penalty node, if a nonzero penalty is appropriate@>
+
+@ At the end of the following code, |q| will point to the final node on the
+list about to be justified.
+
+@<Modify the end of the line...@>=
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+if q<>null then {|q| cannot be a |char_node|}
+ if type(q)=glue_node then
+ begin delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+done:
+
+@ @<Change discretionary to compulsory...@>=
+begin t:=replace_count(q);
+@<Destroy the |t| nodes following |q|, and
+ make |r| point to the following node@>;
+if post_break(q)<>null then @<Transplant the post-break list@>;
+if pre_break(q)<>null then @<Transplant the pre-break list@>;
+link(q):=r; disc_break:=true;
+end
+
+@ @<Destroy the |t| nodes following |q|...@>=
+if t=0 then r:=link(q)
+else begin r:=q;
+ while t>1 do
+ begin r:=link(r); decr(t);
+ end;
+ s:=link(r);
+ r:=link(s); link(s):=null;
+ flush_node_list(link(q)); replace_count(q):=0;
+ end
+
+@ We move the post-break list from inside node |q| to the main list by
+re\-attaching it just before the present node |r|, then resetting |r|.
+
+@<Transplant the post-break list@>=
+begin s:=post_break(q);
+while link(s)<>null do s:=link(s);
+link(s):=r; r:=post_break(q); post_break(q):=null; post_disc_break:=true;
+end
+
+@ We move the pre-break list from inside node |q| to the main list by
+re\-attaching it just after the present node |q|, then resetting |q|.
+
+@<Transplant the pre-break list@>=
+begin s:=pre_break(q); link(q):=s;
+while link(s)<>null do s:=link(s);
+pre_break(q):=null; q:=s;
+end
+
+@ @<Put the \(r)\.{\\rightskip} glue after node |q|@>=
+r:=new_param_glue(right_skip_code); link(r):=link(q); link(q):=r; q:=r
+
+@ The following code begins with |q| at the end of the list to be
+justified. It ends with |q| at the beginning of that list, and with
+|link(temp_head)| pointing to the remainder of the paragraph, if any.
+
+@<Put the \(l)\.{\\leftskip} glue at the left...@>=
+r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
+if left_skip<>zero_glue then
+ begin r:=new_param_glue(left_skip_code);
+ link(r):=q; q:=r;
+ end
+
+@ @<Append the new box to the current vertical list...@>=
+append_to_vlist(just_box);
+if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+adjust_tail:=null
+
+@ Now |q| points to the hlist that represents the current line of the
+paragraph. We need to compute the appropriate line width, pack the
+line into a box of this size, and shift the box by the appropriate
+amount of indentation.
+
+@<Call the packaging subroutine...@>=
+if cur_line>last_special_line then
+ begin cur_width:=second_width; cur_indent:=second_indent;
+ end
+else if par_shape_ptr=null then
+ begin cur_width:=first_width; cur_indent:=first_indent;
+ end
+else begin cur_width:=mem[par_shape_ptr+2*cur_line].sc;
+ cur_indent:=mem[par_shape_ptr+2*cur_line-1].sc;
+ end;
+adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly);
+shift_amount(just_box):=cur_indent
+
+@ Penalties between the lines of a paragraph come from club and widow lines,
+from the |inter_line_penalty| parameter, and from lines that end at
+discretionary breaks. Breaking between lines of a two-line paragraph gets
+both club-line and widow-line penalties. The local variable |pen| will
+be set to the sum of all relevant penalties for the current line, except
+that the final line is never penalized.
+
+@<Append a penalty node, if a nonzero penalty is appropriate@>=
+if cur_line+1<>best_line then
+ begin pen:=inter_line_penalty;
+ if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if cur_line+2=best_line then pen:=pen+final_widow_penalty;
+ if disc_break then pen:=pen+broken_penalty;
+ if pen<>0 then
+ begin r:=new_penalty(pen);
+ link(tail):=r; tail:=r;
+ end;
+ end
+
+@* \[40] Pre-hyphenation.
+When the line-breaking routine is unable to find a feasible sequence of
+breakpoints, it makes a second pass over the paragraph, attempting to
+hyphenate the hyphenatable words. The goal of hyphenation is to insert
+discretionary material into the paragraph so that there are more
+potential places to break.
+
+The general rules for hyphenation are somewhat complex and technical,
+because we want to be able to hyphenate words that are preceded or
+followed by punctuation marks, and because we want the rules to work
+for languages other than English. We also must contend with the fact
+that hyphens might radically alter the ligature and kerning structure
+of a word.
+
+A sequence of characters will be considered for hyphenation only if it
+belongs to a ``potentially hyphenatable part'' of the current paragraph.
+This is a sequence of nodes $p_0p_1\ldots p_m$ where $p_0$ is a glue node,
+$p_1\ldots p_{m-1}$ are either character or ligature or whatsit or
+implicit kern nodes, and $p_m$ is a glue or penalty or insertion or adjust
+or mark or whatsit or explicit kern node. (Therefore hyphenation is
+disabled by boxes, math formulas, and discretionary nodes already inserted
+by the user.) The ligature nodes among $p_1\ldots p_{m-1}$ are effectively
+expanded into the original non-ligature characters; the kern nodes and
+whatsits are ignored. Each character |c| is now classified as either a
+nonletter (if |lc_code(c)=0|), a lowercase letter (if
+|lc_code(c)=c|), or an uppercase letter (otherwise); an uppercase letter
+is treated as if it were |lc_code(c)| for purposes of hyphenation. The
+characters generated by $p_1\ldots p_{m-1}$ may begin with nonletters; let
+$c_1$ be the first letter that is not in the middle of a ligature. Whatsit
+nodes preceding $c_1$ are ignored; a whatsit found after $c_1$ will be the
+terminating node $p_m$. All characters that do not have the same font as
+$c_1$ will be treated as nonletters. The |hyphen_char| for that font
+must be between 0 and 255, otherwise hyphenation will not be attempted.
+\TeX\ looks ahead for as many consecutive letters $c_1\ldots c_n$ as
+possible; however, |n| must be less than 64, so a character that would
+otherwise be $c_{64}$ is effectively not a letter. Furthermore $c_n$ must
+not be in the middle of a ligature. In this way we obtain a string of
+letters $c_1\ldots c_n$ that are generated by nodes $p_a\ldots p_b$, where
+|1<=a<=b+1<=m|. If |n>=l_hyf+r_hyf|, this string qualifies for hyphenation;
+however, |uc_hyph| must be positive, if $c_1$ is uppercase.
+
+The hyphenation process takes place in three stages. First, the candidate
+sequence $c_1\ldots c_n$ is found; then potential positions for hyphens
+are determined by referring to hyphenation tables; and finally, the nodes
+$p_a\ldots p_b$ are replaced by a new sequence of nodes that includes the
+discretionary breaks found.
+
+Fortunately, we do not have to do all this calculation very often, because
+of the way it has been taken out of \TeX's inner loop. For example, when
+the second edition of the author's 700-page book {\sl Seminumerical
+Algorithms} was typeset by \TeX, only about 1.2 hyphenations needed to be
+@^Knuth, Donald Ervin@>
+tried per paragraph, since the line breaking algorithm needed to use two
+passes on only about 5 per cent of the paragraphs.
+
+@<Initialize for hyphenating...@>=
+begin @!init if trie_not_ready then init_trie;@+tini@;@/
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+end
+
+@ The letters $c_1\ldots c_n$ that are candidates for hyphenation are placed
+into an array called |hc|; the number |n| is placed into |hn|; pointers to
+nodes $p_{a-1}$ and~$p_b$ in the description above are placed into variables
+|ha| and |hb|; and the font number is placed into |hf|.
+
+@<Glob...@>=
+@!hc:array[0..65] of 0..256; {word to be hyphenated}
+@!hn:small_number; {the number of positions occupied in |hc|}
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@!hf:internal_font_number; {font number of the letters in |hc|}
+@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase}
+@!hyf_char:integer; {hyphen character of the relevant font}
+@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest}
+@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
+@!hyf_bchar:halfword; {boundary character after $c_n$}
+
+@ Hyphenation routines need a few more local variables.
+
+@<Local variables for line...@>=
+@!j:small_number; {an index into |hc| or |hu|}
+@!c:0..255; {character being considered for hyphenation}
+
+@ When the following code is activated, the |line_break| procedure is in its
+second pass, and |cur_p| points to a glue node.
+
+@<Try to hyphenate...@>=
+begin prev_s:=cur_p; s:=link(prev_s);
+if s<>null then
+ begin @<Skip to node |ha|, or |goto done1| if no hyphenation
+ should be attempted@>;
+ if l_hyf+r_hyf>63 then goto done1;
+ @<Skip to node |hb|, putting letters into |hu| and |hc|@>;
+ @<Check that the nodes following |hb| permit hyphenation and that at least
+ |l_hyf+r_hyf| letters have been found, otherwise |goto done1|@>;
+ hyphenate;
+ end;
+done1: end
+
+@ @<Declare subprocedures for |line_break|@>=
+@t\4@>@<Declare the function called |reconstitute|@>
+procedure hyphenate;
+label common_ending,done,found,found1,found2,not_found,exit;
+var @<Local variables for hyphenation@>@;
+begin @<Find hyphen locations for the word in |hc|, or |return|@>;
+@<If no hyphens were found, |return|@>;
+@<Replace nodes |ha..hb| by a sequence of nodes that includes
+ the discretionary hyphens@>;
+exit:end;
+
+@ The first thing we need to do is find the node |ha| just before the
+first letter.
+
+@<Skip to node |ha|, or |goto done1|...@>=
+loop@+ begin if is_char_node(s) then
+ begin c:=qo(character(s)); hf:=font(s);
+ end
+ else if type(s)=ligature_node then
+ if lig_ptr(s)=null then goto continue
+ else begin q:=lig_ptr(s); c:=qo(character(q)); hf:=font(q);
+ end
+ else if (type(s)=kern_node)and(subtype(s)=normal) then goto continue
+ else if type(s)=whatsit_node then
+ begin @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
+ goto continue;
+ end
+ else goto done1;
+ if lc_code(c)<>0 then
+ if (lc_code(c)=c)or(uc_hyph>0) then goto done2
+ else goto done1;
+continue: prev_s:=s; s:=link(prev_s);
+ end;
+done2: hyf_char:=hyphen_char[hf];
+if hyf_char<0 then goto done1;
+if hyf_char>255 then goto done1;
+ha:=prev_s
+
+@ The word to be hyphenated is now moved to the |hu| and |hc| arrays.
+
+@<Skip to node |hb|, putting letters...@>=
+hn:=0;
+loop@+ begin if is_char_node(s) then
+ begin if font(s)<>hf then goto done3;
+ hyf_bchar:=character(s); c:=qo(hyf_bchar);
+ if lc_code(c)=0 then goto done3;
+ if hn=63 then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=lc_code(c); hyf_bchar:=non_char;
+ end
+ else if type(s)=ligature_node then
+ @<Move the characters of a ligature node to |hu| and |hc|;
+ but |goto done3| if they are not all letters@>
+ else if (type(s)=kern_node)and(subtype(s)=normal) then
+ begin hb:=s;
+ hyf_bchar:=font_bchar[hf];
+ end
+ else goto done3;
+ s:=link(s);
+ end;
+done3:
+
+@ We let |j| be the index of the character being stored when a ligature node
+is being expanded, since we do not want to advance |hn| until we are sure
+that the entire ligature consists of letters. Note that it is possible
+to get to |done3| with |hn=0| and |hb| not set to any value.
+
+@<Move the characters of a ligature node to |hu| and |hc|...@>=
+begin if font(lig_char(s))<>hf then goto done3;
+j:=hn; q:=lig_ptr(s);@+if q>null then hyf_bchar:=character(q);
+while q>null do
+ begin c:=qo(character(q));
+ if lc_code(c)=0 then goto done3;
+ if j=63 then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=lc_code(c);@/
+ q:=link(q);
+ end;
+hb:=s; hn:=j;
+if odd(subtype(s)) then hyf_bchar:=font_bchar[hf]@+else hyf_bchar:=non_char;
+end
+
+@ @<Check that the nodes following |hb| permit hyphenation...@>=
+if hn<l_hyf+r_hyf then goto done1; {|l_hyf| and |r_hyf| are |>=1|}
+loop@+ begin if not(is_char_node(s)) then
+ case type(s) of
+ ligature_node: do_nothing;
+ kern_node: if subtype(s)<>normal then goto done4;
+ whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node:
+ goto done4;
+ othercases goto done1
+ endcases;
+ s:=link(s);
+ end;
+done4:
+
+@* \[41] Post-hyphenation.
+If a hyphen may be inserted between |hc[j]| and |hc[j+1]|, the hyphenation
+procedure will set |hyf[j]| to some small odd number. But before we look
+at \TeX's hyphenation procedure, which is independent of the rest of the
+line-breaking algorithm, let us consider what we will do with the hyphens
+it finds, since it is better to work on this part of the program before
+forgetting what |ha| and |hb|, etc., are all about.
+
+@<Glob...@>=
+@!hyf:array [0..64] of 0..9; {odd values indicate discretionary hyphens}
+@!init_list:pointer; {list of punctuation characters preceding the word}
+@!init_lig:boolean; {does |init_list| represent a ligature?}
+@!init_lft:boolean; {if so, did the ligature involve a left boundary?}
+
+@ @<Local variables for hyphenation@>=
+@!i,@!j,@!l:0..65; {indices into |hc| or |hu|}
+@!q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@!bchar:halfword; {right boundary character of hyphenated word, or |non_char|}
+
+@ \TeX\ will never insert a hyphen that has fewer than
+\.{\\lefthyphenmin} letters before it or fewer than
+\.{\\righthyphenmin} after it; hence, a short word has
+comparatively little chance of being hyphenated. If no hyphens have
+been found, we can save time by not having to make any changes to the
+paragraph.
+
+@<If no hyphens were found, |return|@>=
+for j:=l_hyf to hn-r_hyf do if odd(hyf[j]) then goto found1;
+return;
+found1:
+
+@ If hyphens are in fact going to be inserted, \TeX\ first deletes the
+subsequence of nodes between |ha| and~|hb|. An attempt is made to
+preserve the effect that implicit boundary characters and punctuation marks
+had on ligatures inside the hyphenated word, by storing a left boundary or
+preceding character in |hu[0]| and by storing a possible right boundary
+in |bchar|. We set |j:=0| if |hu[0]| is to be part of the reconstruction;
+otherwise |j:=1|.
+The variable |s| will point to the tail of the current hlist, and
+|q| will point to the node following |hb|, so that
+things can be hooked up after we reconstitute the hyphenated word.
+
+@<Replace nodes |ha..hb| by a sequence of nodes...@>=
+q:=link(hb); link(hb):=null; r:=link(ha); link(ha):=null; bchar:=hyf_bchar;
+if is_char_node(ha) then
+ if font(ha)<>hf then goto found2
+ else begin init_list:=ha; init_lig:=false; hu[0]:=qo(character(ha));
+ end
+else if type(ha)=ligature_node then
+ if font(lig_char(ha))<>hf then goto found2
+ else begin init_list:=lig_ptr(ha); init_lig:=true; init_lft:=(subtype(ha)>1);
+ hu[0]:=qo(character(lig_char(ha)));
+ if init_list=null then if init_lft then
+ begin hu[0]:=256; init_lig:=false;
+ end; {in this case a ligature will be reconstructed from scratch}
+ free_node(ha,small_node_size);
+ end
+else begin {no punctuation found; look for left boundary}
+ if not is_char_node(r) then if type(r)=ligature_node then
+ if subtype(r)>1 then goto found2;
+ j:=1; s:=ha; init_list:=null; goto common_ending;
+ end;
+s:=cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|}
+while link(s)<>ha do s:=link(s);
+j:=0; goto common_ending;
+found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null;
+common_ending: flush_node_list(r);
+@<Reconstitute nodes for the hyphenated word, inserting discretionary hyphens@>;
+flush_list(init_list)
+
+@ We must now face the fact that the battle is not over, even though the
+{\def\!{\kern-1pt}%
+hyphens have been found: The process of reconstituting a word can be nontrivial
+because ligatures might change when a hyphen is present. {\sl The \TeX book\/}
+discusses the difficulties of the word ``difficult'', and
+the discretionary material surrounding a
+hyphen can be considerably more complex than that. Suppose
+\.{abcdef} is a word in a font for which the only ligatures are \.{b\!c},
+\.{c\!d}, \.{d\!e}, and \.{e\!f}. If this word permits hyphenation
+between \.b and \.c, the two patterns with and without hyphenation are
+$\.a\,\.b\,\.-\,\.{c\!d}\,\.{e\!f}$ and $\.a\,\.{b\!c}\,\.{d\!e}\,\.f$.
+Thus the insertion of a hyphen might cause effects to ripple arbitrarily
+far into the rest of the word. A further complication arises if additional
+hyphens appear together with such rippling, e.g., if the word in the
+example just given could also be hyphenated between \.c and \.d; \TeX\
+avoids this by simply ignoring the additional hyphens in such weird cases.}
+
+Still further complications arise in the presence of ligatures that do not
+delete the original characters. When punctuation precedes the word being
+hyphenated, \TeX's method is not perfect under all possible scenarios,
+because punctuation marks and letters can propagate information back and forth.
+For example, suppose the original pre-hyphenation pair
+\.{*a} changes to \.{*y} via a \.{\?=:} ligature, which changes to \.{xy}
+via a \.{=:\?} ligature; if $p_{a-1}=\.x$ and $p_a=\.y$, the reconstitution
+procedure isn't smart enough to obtain \.{xy} again. In such cases the
+font designer should include a ligature that goes from \.{xa} to \.{xy}.
+
+@ The processing is facilitated by a subroutine called |reconstitute|. Given
+a string of characters $x_j\ldots x_n$, there is a smallest index $m\ge j$
+such that the ``translation'' of $x_j\ldots x_n$ by ligatures and kerning
+has the form $y_1\ldots y_t$ followed by the translation of $x_{m+1}\ldots x_n$,
+where $y_1\ldots y_t$ is some nonempty sequence of character, ligature, and
+kern nodes. We call $x_j\ldots x_m$ a ``cut prefix'' of $x_j\ldots x_n$.
+For example, if $x_1x_2x_3=\.{fly}$, and if the font contains `fl' as a
+ligature and a kern between `fl' and `y', then $m=2$, $t=2$, and $y_1$ will
+be a ligature node for `fl' followed by an appropriate kern node~$y_2$.
+In the most common case, $x_j$~forms no ligature with $x_{j+1}$ and we
+simply have $m=j$, $y_1=x_j$. If $m<n$ we can repeat the procedure on
+$x_{m+1}\ldots x_n$ until the entire translation has been found.
+
+The |reconstitute| function returns the integer $m$ and puts the nodes
+$y_1\ldots y_t$ into a linked list starting at |link(hold_head)|,
+getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=256$,
+we consider $x_j$ to be an implicit left boundary character; in this
+case |j| must be strictly less than~|n|. There is a
+parameter |bchar|, which is either 256 or an implicit right boundary character
+assumed to be present just following~$x_n$. (The value |hu[n+1]| is never
+explicitly examined, but the algorithm imagines that |bchar| is there.)
+
+If there exists an index |k| in the range $j\le k\le m$ such that |hyf[k]|
+is odd and such that the result of |reconstitute| would have been different
+if $x_{k+1}$ had been |hchar|, then |reconstitute| sets |hyphen_passed|
+to the smallest such~|k|. Otherwise it sets |hyphen_passed| to zero.
+
+A special convention is used in the case |j=0|: Then we assume that the
+translation of |hu[0]| appears in a special list of charnodes starting at
+|init_list|; moreover, if |init_lig| is |true|, then |hu[0]| will be
+a ligature character, involving a left boundary if |init_lft| is |true|.
+This facility is provided for cases when a hyphenated
+word is preceded by punctuation (like single or double quotes) that might
+affect the translation of the beginning of the word.
+
+@<Glob...@>=
+@!hyphen_passed:small_number; {first hyphen in a ligature, if any}
+
+@ @<Declare the function called |reconstitute|@>=
+function reconstitute(@!j,@!n:small_number;@!bchar,@!hchar:halfword):
+ small_number;
+label continue,done;
+var @!p:pointer; {temporary register for list manipulation}
+@!t:pointer; {a node being appended to}
+@!q:four_quarters; {character information or a lig/kern instruction}
+@!cur_rh:halfword; {hyphen character for ligature testing}
+@!test_char:halfword; {hyphen or other character for ligature testing}
+@!w:scaled; {amount of kerning}
+@!k:font_index; {position of current lig/kern instruction}
+begin hyphen_passed:=0; t:=hold_head; w:=0; link(hold_head):=null;
+ {at this point |ligature_present=lft_hit=rt_hit=false|}
+@<Set up data structures with the cursor following position |j|@>;
+continue:@<If there's a ligature or kern at the cursor position, update the data
+ structures, possibly advancing~|j|; continue until the cursor moves@>;
+@<Append a ligature and/or kern to the translation;
+ |goto continue| if the stack of inserted ligatures is nonempty@>;
+reconstitute:=j;
+end;
+
+@ The reconstitution procedure shares many of the global data structures
+by which \TeX\ has processed the words before they were hyphenated.
+There is an implied ``cursor'' between characters |cur_l| and |cur_r|;
+these characters will be tested for possible ligature activity. If
+|ligature_present| then |cur_l| is a ligature character formed from the
+original characters following |cur_q| in the current translation list.
+There is a ``ligature stack'' between the cursor and character |j+1|,
+consisting of pseudo-ligature nodes linked together by their |link| fields.
+This stack is normally empty unless a ligature command has created a new
+character that will need to be processed later. A pseudo-ligature is
+a special node having a |character| field that represents a potential
+ligature and a |lig_ptr| field that points to a |char_node| or is |null|.
+We have
+$$|cur_r|=\cases{|character(lig_stack)|,&if |lig_stack>null|;\cr
+ |qi(hu[j+1])|,&if |lig_stack=null| and |j<n|;\cr
+ bchar,&if |lig_stack=null| and |j=n|.\cr}$$
+
+@<Glob...@>=
+@!cur_l,@!cur_r:halfword; {characters before and after the cursor}
+@!cur_q:pointer; {where a ligature should be detached}
+@!lig_stack:pointer; {unfinished business to the right of the cursor}
+@!ligature_present:boolean; {should a ligature node be made for |cur_l|?}
+@!lft_hit,@!rt_hit:boolean; {did we hit a ligature with a boundary character?}
+
+@ @d append_charnode_to_t(#)== begin link(t):=get_avail; t:=link(t);
+ font(t):=hf; character(t):=#;
+ end
+@d set_cur_r==begin if j<n then cur_r:=qi(hu[j+1])@+else cur_r:=bchar;
+ if odd(hyf[j]) then cur_rh:=hchar@+else cur_rh:=non_char;
+ end
+
+@<Set up data structures with the cursor following position |j|@>=
+cur_l:=qi(hu[j]); cur_q:=t;
+if j=0 then
+ begin ligature_present:=init_lig; p:=init_list;
+ if ligature_present then lft_hit:=init_lft;
+ while p>null do
+ begin append_charnode_to_t(character(p)); p:=link(p);
+ end;
+ end
+else if cur_l<non_char then append_charnode_to_t(cur_l);
+lig_stack:=null; set_cur_r
+
+@ We may want to look at the lig/kern program twice, once for a hyphen
+and once for a normal letter. (The hyphen might appear after the letter
+in the program, so we'd better not try to look for both at once.)
+
+@<If there's a ligature or kern at the cursor position, update...@>=
+if cur_l=non_char then
+ begin k:=bchar_label[hf];
+ if k=non_address then goto done@+else q:=font_info[k].qqqq;
+ end
+else begin q:=char_info(hf)(cur_l);
+ if char_tag(q)<>lig_tag then goto done;
+ k:=lig_kern_start(hf)(q); q:=font_info[k].qqqq;
+ if skip_byte(q)>stop_flag then
+ begin k:=lig_kern_restart(hf)(q); q:=font_info[k].qqqq;
+ end;
+ end; {now |k| is the starting address of the lig/kern program}
+if cur_rh<non_char then test_char:=cur_rh@+else test_char:=cur_r;
+loop@+begin if next_char(q)=test_char then if skip_byte(q)<=stop_flag then
+ if cur_rh<non_char then
+ begin hyphen_passed:=j; hchar:=non_char; cur_rh:=non_char;
+ goto continue;
+ end
+ else begin if hchar<non_char then if odd(hyf[j]) then
+ begin hyphen_passed:=j; hchar:=non_char;
+ end;
+ if op_byte(q)<kern_flag then
+ @<Carry out a ligature replacement, updating the cursor structure
+ and possibly advancing~|j|; |goto continue| if the cursor doesn't
+ advance, otherwise |goto done|@>;
+ w:=char_kern(hf)(q); goto done; {this kern will be inserted below}
+ end;
+ if skip_byte(q)>=stop_flag then
+ if cur_rh=non_char then goto done
+ else begin cur_rh:=non_char; goto continue;
+ end;
+ k:=k+qo(skip_byte(q))+1; q:=font_info[k].qqqq;
+ end;
+done:
+
+@ @d wrap_lig(#)==if ligature_present then
+ begin p:=new_ligature(hf,cur_l,link(cur_q));
+ if lft_hit then
+ begin subtype(p):=2; lft_hit:=false;
+ end;
+ if # then if lig_stack=null then
+ begin incr(subtype(p)); rt_hit:=false;
+ end;
+ link(cur_q):=p; t:=p; ligature_present:=false;
+ end
+@d pop_lig_stack==begin if lig_ptr(lig_stack)>null then
+ begin link(t):=lig_ptr(lig_stack); {this is a charnode for |hu[j+1]|}
+ t:=link(t); incr(j);
+ end;
+ p:=lig_stack; lig_stack:=link(p); free_node(p,small_node_size);
+ if lig_stack=null then set_cur_r@+else cur_r:=character(lig_stack);
+ end {if |lig_stack| isn't |null| we have |cur_rh=non_char|}
+
+@<Append a ligature and/or kern to the translation...@>=
+wrap_lig(rt_hit);
+if w<>0 then
+ begin link(t):=new_kern(w); t:=link(t); w:=0;
+ end;
+if lig_stack>null then
+ begin cur_q:=t; cur_l:=character(lig_stack); ligature_present:=true;
+ pop_lig_stack; goto continue;
+ end
+
+@ @<Carry out a ligature replacement, updating the cursor structure...@>=
+begin if cur_l=non_char then lft_hit:=true;
+if j=n then if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(q) of
+qi(1),qi(5):begin cur_l:=rem_byte(q); {\.{=:\?}, \.{=:\?>}}
+ ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_byte(q); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack>null then character(lig_stack):=cur_r
+ else begin lig_stack:=new_lig_item(cur_r);
+ if j=n then bchar:=non_char
+ else begin p:=get_avail; lig_ptr(lig_stack):=p;
+ character(p):=qi(hu[j+1]); font(p):=hf;
+ end;
+ end;
+ end;
+qi(3):begin cur_r:=rem_byte(q); {\.{\?=:\?}}
+ p:=lig_stack; lig_stack:=new_lig_item(cur_r); link(lig_stack):=p;
+ end;
+qi(7),qi(11):begin wrap_lig(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=t; cur_l:=rem_byte(q); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_byte(q); ligature_present:=true; {\.{=:}}
+ if lig_stack>null then pop_lig_stack
+ else if j=n then goto done
+ else begin append_charnode_to_t(cur_r); incr(j); set_cur_r;
+ end;
+ end
+endcases;
+if op_byte(q)>qi(4) then if op_byte(q)<>qi(7) then goto done;
+goto continue;
+end
+
+@ Okay, we're ready to insert the potential hyphenations that were found.
+When the following program is executed, we want to append the word
+|hu[1..hn]| after node |ha|, and node |q| should be appended to the result.
+During this process, the variable |i| will be a temporary
+index into |hu|; the variable |j| will be an index to our current position
+in |hu|; the variable |l| will be the counterpart of |j|, in a discretionary
+branch; the variable |r| will point to new nodes being created; and
+we need a few new local variables:
+
+@<Local variables for hyph...@>=
+@!major_tail,@!minor_tail:pointer; {the end of lists in the main and
+ discretionary branches being reconstructed}
+@!c:ASCII_code; {character temporarily replaced by a hyphen}
+@!c_loc:0..63; {where that character came from}
+@!r_count:integer; {replacement count for discretionary}
+@!hyf_node:pointer; {the hyphen, if it exists}
+
+@ When the following code is performed, |hyf[0]| and |hyf[hn]| will be zero.
+
+@<Reconstitute nodes for the hyphenated word...@>=
+repeat l:=j; j:=reconstitute(j,hn,bchar,qi(hyf_char))+1;
+if hyphen_passed=0 then
+ begin link(s):=link(hold_head);
+ while link(s)>null do s:=link(s);
+ if odd(hyf[j-1]) then
+ begin l:=j; hyphen_passed:=j-1; link(hold_head):=null;
+ end;
+ end;
+if hyphen_passed>0 then
+ @<Create and append a discretionary node as an alternative to the
+ unhyphenated word, and continue to develop both branches until they
+ become equivalent@>;
+until j>hn;
+link(s):=q
+
+@ In this repeat loop we will insert another discretionary if |hyf[j-1]| is
+odd, when both branches of the previous discretionary end at position |j-1|.
+Strictly speaking, we aren't justified in doing this, because we don't know
+that a hyphen after |j-1| is truly independent of those branches. But in almost
+all applications we would rather not lose a potentially valuable hyphenation
+point. (Consider the word `difficult', where the letter `c' is in position |j|.)
+
+@d advance_major_tail==begin major_tail:=link(major_tail); incr(r_count);
+ end
+
+@<Create and append a discretionary node as an alternative...@>=
+repeat r:=get_node(small_node_size);
+link(r):=link(hold_head); type(r):=disc_node;
+major_tail:=r; r_count:=0;
+while link(major_tail)>null do advance_major_tail;
+i:=hyphen_passed; hyf[i]:=0;
+@<Put the \(c)characters |hu[l..i]| and a hyphen into |pre_break(r)|@>;
+@<Put the \(c)characters |hu[i+1..@,]| into |post_break(r)|, appending to this
+ list and to |major_tail| until synchronization has been achieved@>;
+@<Move pointer |s| to the end of the current list, and set |replace_count(r)|
+ appropriately@>;
+hyphen_passed:=j-1; link(hold_head):=null;
+until not odd(hyf[j-1])
+
+@ The new hyphen might combine with the previous character via ligature
+or kern. At this point we have |l-1<=i<j| and |i<hn|.
+
+@<Put the \(c)characters |hu[l..i]| and a hyphen into |pre_break(r)|@>=
+minor_tail:=null; pre_break(r):=null; hyf_node:=new_character(hf,hyf_char);
+if hyf_node<>null then
+ begin incr(i); c:=hu[i]; hu[i]:=hyf_char; free_avail(hyf_node);
+ end;
+while l<=i do
+ begin l:=reconstitute(l,i,font_bchar[hf],non_char)+1;
+ if link(hold_head)>null then
+ begin if minor_tail=null then pre_break(r):=link(hold_head)
+ else link(minor_tail):=link(hold_head);
+ minor_tail:=link(hold_head);
+ while link(minor_tail)>null do minor_tail:=link(minor_tail);
+ end;
+ end;
+if hyf_node<>null then
+ begin hu[i]:=c; {restore the character in the hyphen position}
+ l:=i; decr(i);
+ end
+
+@ The synchronization algorithm begins with |l=i+1<=j|.
+
+@<Put the \(c)characters |hu[i+1..@,]| into |post_break(r)|...@>=
+minor_tail:=null; post_break(r):=null; c_loc:=0;
+if bchar_label[hf]<>non_address then {put left boundary at beginning of new line}
+ begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256;
+ end;
+while l<j do
+ begin repeat l:=reconstitute(l,hn,bchar,non_char)+1;
+ if c_loc>0 then
+ begin hu[c_loc]:=c; c_loc:=0;
+ end;
+ if link(hold_head)>null then
+ begin if minor_tail=null then post_break(r):=link(hold_head)
+ else link(minor_tail):=link(hold_head);
+ minor_tail:=link(hold_head);
+ while link(minor_tail)>null do minor_tail:=link(minor_tail);
+ end;
+ until l>=j;
+ while l>j do
+ @<Append characters of |hu[j..@,]| to |major_tail|, advancing~|j|@>;
+ end
+
+@ @<Append characters of |hu[j..@,]|...@>=
+begin j:=reconstitute(j,hn,bchar,non_char)+1;
+link(major_tail):=link(hold_head);
+while link(major_tail)>null do advance_major_tail;
+end
+
+@ Ligature insertion can cause a word to grow exponentially in size. Therefore
+we must test the size of |r_count| here, even though the hyphenated text
+was at most 63 characters long.
+
+@<Move pointer |s| to the end of the current list...@>=
+if r_count>127 then {we have to forget the discretionary hyphen}
+ begin link(s):=link(r); link(r):=null; flush_node_list(r);
+ end
+else begin link(s):=r; replace_count(r):=r_count;
+ end;
+s:=major_tail
+
+@* \[42] Hyphenation.
+When a word |hc[1..hn]| has been set up to contain a candidate for hyphenation,
+\TeX\ first looks to see if it is in the user's exception dictionary. If not,
+hyphens are inserted based on patterns that appear within the given word,
+using an algorithm due to Frank~M. Liang.
+@^Liang, Franklin Mark@>
+
+Let's consider Liang's method first, since it is much more interesting than the
+exception-lookup routine. The algorithm begins by setting |hyf[j]| to zero
+for all |j|, and invalid characters are inserted into |hc[0]|
+and |hc[hn+1]| to serve as delimiters. Then a reasonably fast method is
+used to see which of a given set of patterns occurs in the word
+|hc[0..(hn+1)]|. Each pattern $p_1\ldots p_k$ of length |k| has an associated
+sequence of |k+1| numbers $n_0\ldots n_k$; and if the pattern occurs in
+|hc[(j+1)..(j+k)]|, \TeX\ will set |hyf[j+i]:=@tmax@>(hyf[j+i],@t$n_i$@>)| for
+|0<=i<=k|. After this has been done for each pattern that occurs, a
+discretionary hyphen will be inserted between |hc[j]| and |hc[j+1]| when
+|hyf[j]| is odd, as we have already seen.
+
+The set of patterns $p_1\ldots p_k$ and associated numbers $n_0\ldots n_k$
+depends, of course, on the language whose words are being hyphenated, and
+on the degree of hyphenation that is desired. A method for finding
+appropriate |p|'s and |n|'s, from a given dictionary of words and acceptable
+hyphenations, is discussed in Liang's Ph.D. thesis (Stanford University,
+1983); \TeX\ simply starts with the patterns and works from there.
+
+@ The patterns are stored in a compact table that is also efficient for
+retrieval, using a variant of ``trie memory'' [cf.\ {\sl The Art of
+Computer Programming \bf3} (1973), 481--505]. We can find each pattern
+$p_1\ldots p_k$ by letting $z_0$ be one greater than the relevant language
+index and then, for |1<=i<=k|,
+setting |@t$z_i$@>:=trie_link@t$(z_{i-1})+p_i$@>|; the pattern will be
+identified by the number $z_k$. Since all the pattern information is
+packed together into a single |trie_link| array, it is necessary to
+prevent confusion between the data from inequivalent patterns, so another
+table is provided such that |trie_char@t$(z_i)=p_i$@>| for all |i|. There
+is also a table |trie_op|$(z_k)$ to identify the numbers $n_0\ldots n_k$
+associated with $p_1\ldots p_k$.
+
+Comparatively few different number sequences $n_0\ldots n_k$ actually occur,
+since most of the |n|'s are generally zero. Therefore the number sequences
+are encoded in such a way that |trie_op|$(z_k)$ is only one byte long.
+If |trie_op(@t$z_k$@>)<>min_quarterword|, when $p_1\ldots p_k$ has matched
+the letters in |hc[(l-k+1)..l@,]| of language |t|,
+we perform all of the required operations
+for this pattern by carrying out the following little program: Set
+|v:=trie_op(@t$z_k$@>)|. Then set |v:=v+op_start[t]|,
+|hyf[l-hyf_distance[v]]:=@tmax@>(hyf[l-hyf_distance[v]], hyf_num[v])|,
+and |v:=hyf_next[v]|; repeat, if necessary, until |v=min_quarterword|.
+
+@<Types...@>=
+@!trie_pointer=0..trie_size; {an index into |trie|}
+
+@ @d trie_link(#)==trie[#].rh {``downward'' link in a trie}
+@d trie_char(#)==trie[#].b1 {character matched at this trie location}
+@d trie_op(#)==trie[#].b0 {program for hyphenation at this trie location}
+
+@<Glob...@>=
+@!trie:array[trie_pointer] of two_halves; {|trie_link|, |trie_char|, |trie_op|}
+@!hyf_distance:array[1..trie_op_size] of small_number; {position |k-j| of $n_j$}
+@!hyf_num:array[1..trie_op_size] of small_number; {value of $n_j$}
+@!hyf_next:array[1..trie_op_size] of quarterword; {continuation code}
+@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language}
+
+@ @<Local variables for hyph...@>=
+@!z:trie_pointer; {an index into |trie|}
+@!v:integer; {an index into |hyf_distance|, etc.}
+
+@ Assuming that these auxiliary tables have been set up properly, the
+hyphenation algorithm is quite short. In the following code we set |hc[hn+2]|
+to the impossible value 256, in order to guarantee that |hc[hn+3]| will
+never be fetched.
+
+@<Find hyphen locations for the word in |hc|...@>=
+for j:=0 to hn do hyf[j]:=0;
+@<Look for the word |hc[1..hn]| in the exception table, and |goto found| (with
+ |hyf| containing the hyphens) if an entry is found@>;
+if trie_char(cur_lang+1)<>qi(cur_lang) then return; {no patterns for |cur_lang|}
+hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters}
+for j:=0 to hn-r_hyf+1 do
+ begin z:=trie_link(cur_lang+1)+hc[j]; l:=j;
+ while hc[l]=qo(trie_char(z)) do
+ begin if trie_op(z)<>min_quarterword then
+ @<Store \(m)maximum values in the |hyf| table@>;
+ incr(l); z:=trie_link(z)+hc[l];
+ end;
+ end;
+found: for j:=0 to l_hyf-1 do hyf[j]:=0;
+for j:=0 to r_hyf-1 do hyf[hn-j]:=0
+
+@ @<Store \(m)maximum values in the |hyf| table@>=
+begin v:=trie_op(z);
+repeat v:=v+op_start[cur_lang]; i:=l-hyf_distance[v];
+if hyf_num[v]>hyf[i] then hyf[i]:=hyf_num[v];
+v:=hyf_next[v];
+until v=min_quarterword;
+end
+
+@ The exception table that is built by \TeX's \.{\\hyphenation} primitive is
+organized as an ordered hash table [cf.\ Amble and Knuth, {\sl The Computer
+@^Amble, Ole@> @^Knuth, Donald Ervin@>
+Journal\/ \bf17} (1974), 135--142] using linear probing. If $\alpha$ and
+$\beta$ are words, we will say that $\alpha<\beta$ if $\vert\alpha\vert<
+\vert\beta\vert$ or if $\vert\alpha\vert=\vert\beta\vert$ and
+$\alpha$ is lexicographically smaller than $\beta$. (The notation $\vert
+\alpha\vert$ stands for the length of $\alpha$.) The idea of ordered hashing
+is to arrange the table so that a given word $\alpha$ can be sought by computing
+a hash address $h=h(\alpha)$ and then looking in table positions |h|, |h-1|,
+\dots, until encountering the first word $\L\alpha$. If this word is
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+
+The words in the table point to lists in |mem| that specify hyphen positions
+in their |info| fields. The list for $c_1\ldots c_n$ contains the number |k| if
+the word $c_1\ldots c_n$ has a discretionary hyphen between $c_k$ and
+$c_{k+1}$.
+
+@<Types...@>=
+@!hyph_pointer=0..hyph_size; {an index into the ordered hash table}
+
+@ @<Glob...@>=
+@!hyph_word:array[hyph_pointer] of str_number; {exception words}
+@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions}
+@!hyph_count:hyph_pointer; {the number of words in the exception dictionary}
+
+@ @<Local variables for init...@>=
+@!z:hyph_pointer; {runs through the exception dictionary}
+
+@ @<Set init...@>=
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null;
+ end;
+hyph_count:=0;
+
+@ The algorithm for exception lookup is quite simple, as soon as we have
+a few more local variables to work with.
+
+@<Local variables for hyph...@>=
+@!h:hyph_pointer; {an index into |hyph_word| and |hyph_list|}
+@!k:str_number; {an index into |str_start|}
+@!u:pool_pointer; {an index into |str_pool|}
+
+@ First we compute the hash code |h|, then we search until we either
+find the word or we don't. Words from different languages are kept
+separate by appending the language code to the string.
+
+@<Look for the word |hc[1...@>=
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_size;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+not_found: decr(hn)
+
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)<hn then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start[k];
+ repeat if so(str_pool[u])<hc[j] then goto not_found;
+ if so(str_pool[u])>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+
+@ @<Insert hyphens as specified...@>=
+s:=hyph_list[h];
+while s<>null do
+ begin hyf[info(s)]:=1; s:=link(s);
+ end
+
+@ @<Search |hyph_list| for pointers to |p|@>=
+for q:=0 to hyph_size do
+ begin if hyph_list[q]=p then
+ begin print_nl("HYPH("); print_int(q); print_char(")");
+ end;
+ end
+
+@ We have now completed the hyphenation routine, so the |line_break| procedure
+is finished at last. Since the hyphenation exception table is fresh in our
+minds, it's a good time to deal with the routine that adds new entries to it.
+
+When \TeX\ has scanned `\.{\\hyphenation}', it calls on a procedure named
+|new_hyph_exceptions| to do the right thing.
+
+@d set_cur_lang==if language<=0 then cur_lang:=0
+ else if language>255 then cur_lang:=0
+ else cur_lang:=language
+
+@p procedure new_hyph_exceptions; {enters new exceptions}
+label reswitch, exit, found, not_found;
+var n:0..64; {length of current word; not always a |small_number|}
+@!j:0..64; {an index into |hc|}
+@!h:hyph_pointer; {an index into |hyph_word| and |hyph_list|}
+@!k:str_number; {an index into |str_start|}
+@!p:pointer; {head of a list of hyphen positions}
+@!q:pointer; {used when creating a new node for list |p|}
+@!s,@!t:str_number; {strings being compared or stored}
+@!u,@!v:pool_pointer; {indices into |str_pool|}
+begin scan_left_brace; {a left brace must follow \.{\\hyphenation}}
+set_cur_lang;
+@<Enter as many hyphenation exceptions as are listed,
+until coming to a right brace; then |return|@>;
+exit:end;
+
+@ @<Enter as many...@>=
+n:=0; p:=null;
+loop@+ begin get_x_token;
+ reswitch: case cur_cmd of
+ letter,other_char,char_given:@<Append a new letter or hyphen@>;
+ char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+ spacer,right_brace: begin if n>1 then @<Enter a hyphenation exception@>;
+ if cur_cmd=right_brace then return;
+ n:=0; p:=null;
+ end;
+ othercases @<Give improper \.{\\hyphenation} error@>
+ endcases;
+ end
+
+@ @<Give improper \.{\\hyph...@>=
+begin print_err("Improper "); print_esc("hyphenation");
+@.Improper \\hyphenation...@>
+ print(" will be flushed");
+help2("Hyphenation exceptions must contain only letters")@/
+ ("and hyphens. But continue; I'll forgive and forget.");
+error;
+end
+
+@ @<Append a new letter or hyphen@>=
+if cur_chr="-" then @<Append the value |n| to list |p|@>
+else begin if lc_code(cur_chr)=0 then
+ begin print_err("Not a letter");
+@.Not a letter@>
+ help2("Letters in \hyphenation words must have \lccode>0.")@/
+ ("Proceed; I'll ignore the character I just read.");
+ error;
+ end
+ else if n<63 then
+ begin incr(n); hc[n]:=lc_code(cur_chr);
+ end;
+ end
+
+@ @<Append the value |n| to list |p|@>=
+begin if n<63 then
+ begin q:=get_avail; link(q):=p; info(q):=n; p:=q;
+ end;
+end
+
+@ @<Enter a hyphenation exception@>=
+begin incr(n); hc[n]:=cur_lang; str_room(n); h:=0;
+for j:=1 to n do
+ begin h:=(h+h+hc[j]) mod hyph_size;
+ append_char(hc[j]);
+ end;
+s:=make_string;
+@<Insert the \(p)pair |(s,p)| into the exception table@>;
+end
+
+@ @<Insert the \(p)pair |(s,p)|...@>=
+if hyph_count=hyph_size then overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+hyph_word[h]:=s; hyph_list[h]:=p
+
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+k:=hyph_word[h];
+if length(k)<length(s) then goto found;
+if length(k)>length(s) then goto not_found;
+u:=str_start[k]; v:=str_start[s];
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start[k+1];
+found:q:=hyph_list[h]; hyph_list[h]:=p; p:=q;@/
+t:=hyph_word[h]; hyph_word[h]:=s; s:=t;
+not_found:
+
+@* \[43] Initializing the hyphenation tables.
+The trie for \TeX's hyphenation algorithm is built from a sequence of
+patterns following a \.{\\patterns} specification. Such a specification
+is allowed only in \.{INITEX}, since the extra memory for auxiliary tables
+and for the initialization program itself would only clutter up the
+production version of \TeX\ with a lot of deadwood.
+
+The first step is to build a trie that is linked, instead of packed
+into sequential storage, so that insertions are readily made.
+After all patterns have been processed, \.{INITEX}
+compresses the linked trie by identifying common subtries. Finally the
+trie is packed into the efficient sequential form that the hyphenation
+algorithm actually uses.
+
+@<Declare subprocedures for |line_break|@>=
+@!init @<Declare procedures for preprocessing hyphenation patterns@>@;
+tini
+
+@ Before we discuss trie building in detail, let's consider the simpler
+problem of creating the |hyf_distance|, |hyf_num|, and |hyf_next| arrays.
+
+Suppose, for example, that \TeX\ reads the pattern `\.{ab2cde1}'. This is
+a pattern of length 5, with $n_0\ldots n_5=0\,0\,2\,0\,0\,1$ in the
+notation above. We want the corresponding |trie_op| code |v| to have
+|hyf_distance[v]=3|, |hyf_num[v]=2|, and |hyf_next[v]=@t$v^\prime$@>|,
+where the auxiliary |trie_op| code $v^\prime$ has
+|hyf_distance[@t$v^\prime$@>]=0|, |hyf_num[@t$v^\prime$@>]=1|, and
+|hyf_next[@t$v^\prime$@>]=min_quarterword|.
+
+\TeX\ computes an appropriate value |v| with the |new_trie_op| subroutine
+below, by setting
+$$\hbox{|@t$v^\prime$@>:=new_trie_op(0,1,min_quarterword)|,\qquad
+|v:=new_trie_op(3,2,@t$v^\prime$@>)|.}$$
+This subroutine looks up its three
+parameters in a special hash table, assigning a new value only if these
+three have not appeared before for the current language.
+
+The hash table is called |trie_op_hash|, and the number of entries it contains
+is |trie_op_ptr|.
+
+@<Glob...@>=
+@!init@! trie_op_hash:array[-trie_op_size..trie_op_size] of 0..trie_op_size;
+ {trie op codes for quadruples}
+@!trie_used:array[ASCII_code] of quarterword;
+ {largest opcode used so far for this language}
+@!trie_op_lang:array[1..trie_op_size] of ASCII_code;
+ {language part of a hashed quadruple}
+@!trie_op_val:array[1..trie_op_size] of quarterword;
+ {opcode corresponding to a hashed quadruple}
+@!trie_op_ptr:0..trie_op_size; {number of stored ops so far}
+tini
+
+@ It's tempting to remove the |overflow| stops in the following procedure;
+|new_trie_op| could return |min_quarterword| (thereby simply ignoring
+part of a hyphenation pattern) instead of aborting the job. However, that would
+lead to different hyphenation results on different installations of \TeX\
+using the same patterns. The |overflow| stops are necessary for portability
+of patterns.
+
+@<Declare procedures for preprocessing hyph...@>=
+function new_trie_op(@!d,@!n:small_number;@!v:quarterword):quarterword;
+label exit;
+var h:-trie_op_size..trie_op_size; {trial hash location}
+@!u:quarterword; {trial op code}
+@!l:0..trie_op_size; {pointer to stored data}
+begin h:=abs(n+313*d+361*v+1009*cur_lang) mod (trie_op_size+trie_op_size)
+ - trie_op_size;
+loop@+ begin l:=trie_op_hash[h];
+ if l=0 then {empty position found for a new op}
+ begin if trie_op_ptr=trie_op_size then
+ overflow("pattern memory ops",trie_op_size);
+ u:=trie_used[cur_lang];
+ if u=max_quarterword then
+ overflow("pattern memory ops per language",
+ max_quarterword-min_quarterword);
+ incr(trie_op_ptr); incr(u); trie_used[cur_lang]:=u;
+ hyf_distance[trie_op_ptr]:=d;
+ hyf_num[trie_op_ptr]:=n; hyf_next[trie_op_ptr]:=v;
+ trie_op_lang[trie_op_ptr]:=cur_lang; trie_op_hash[h]:=trie_op_ptr;
+ trie_op_val[trie_op_ptr]:=u; new_trie_op:=u; return;
+ end;
+ if (hyf_distance[l]=d)and(hyf_num[l]=n)and(hyf_next[l]=v)
+ and(trie_op_lang[l]=cur_lang) then
+ begin new_trie_op:=trie_op_val[l]; return;
+ end;
+ if h>-trie_op_size then decr(h)@+else h:=trie_op_size;
+ end;
+exit:end;
+
+@ After |new_trie_op| has compressed the necessary opcode information,
+plenty of information is available to unscramble the data into the
+final form needed by our hyphenation algorithm.
+
+@<Sort \(t)the hyphenation op tables into proper order@>=
+op_start[0]:=-min_quarterword;
+for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
+for j:=1 to trie_op_ptr do
+ trie_op_hash[j]:=op_start[trie_op_lang[j]]+trie_op_val[j]; {destination}
+for j:=1 to trie_op_ptr do while trie_op_hash[j]>j do
+ begin k:=trie_op_hash[j];@/
+ t:=hyf_distance[k]; hyf_distance[k]:=hyf_distance[j]; hyf_distance[j]:=t;@/
+ t:=hyf_num[k]; hyf_num[k]:=hyf_num[j]; hyf_num[j]:=t;@/
+ t:=hyf_next[k]; hyf_next[k]:=hyf_next[j]; hyf_next[j]:=t;@/
+ trie_op_hash[j]:=trie_op_hash[k]; trie_op_hash[k]:=k;
+ end
+
+@ Before we forget how to initialize the data structures that have been
+mentioned so far, let's write down the code that gets them started.
+
+@<Initialize table entries...@>=
+for k:=-trie_op_size to trie_op_size do trie_op_hash[k]:=0;
+for k:=0 to 255 do trie_used[k]:=min_quarterword;
+trie_op_ptr:=0;
+
+@ The linked trie that is used to preprocess hyphenation patterns appears
+in several global arrays. Each node represents an instruction of the form
+``if you see character |c|, then perform operation |o|, move to the
+next character, and go to node |l|; otherwise go to node |r|.''
+The four quantities |c|, |o|, |l|, and |r| are stored in four arrays
+|trie_c|, |trie_o|, |trie_l|, and |trie_r|. The root of the trie
+is |trie_l[0]|, and the number of nodes is |trie_ptr|. Null trie
+pointers are represented by zero. To initialize the trie, we simply
+set |trie_l[0]| and |trie_ptr| to zero. We also set |trie_c[0]| to some
+arbitrary value, since the algorithm may access it.
+
+The algorithms maintain the condition
+$$\hbox{|trie_c[trie_r[z]]>trie_c[z]|\qquad
+whenever |z<>0| and |trie_r[z]<>0|};$$ in other words, sibling nodes are
+ordered by their |c| fields.
+
+@d trie_root==trie_l[0] {root of the linked trie}
+
+@<Glob...@>=
+@!init @!trie_c:packed array[trie_pointer] of packed_ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:packed array[trie_pointer] of quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:packed array[trie_pointer] of trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:packed array[trie_pointer] of trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:packed array[trie_pointer] of trie_pointer;
+ {used to identify equivalent subtries}
+tini
+
+@ Let us suppose that a linked trie has already been constructed.
+Experience shows that we can often reduce its size by recognizing common
+subtries; therefore another hash table is introduced for this purpose,
+somewhat similar to |trie_op_hash|. The new hash table will be
+initialized to zero.
+
+The function |trie_node(p)| returns |p| if |p| is distinct from other nodes
+that it has seen, otherwise it returns the number of the first equivalent
+node that it has seen.
+
+Notice that we might make subtries equivalent even if they correspond to
+patterns for different languages, in which the trie ops might mean quite
+different things. That's perfectly all right.
+
+@<Declare procedures for preprocessing hyph...@>=
+function trie_node(@!p:trie_pointer):trie_pointer; {converts
+ to a canonical form}
+label exit;
+var h:trie_pointer; {trial hash location}
+@!q:trie_pointer; {trial trie node}
+begin h:=abs(trie_c[p]+1009*trie_o[p]+@|
+ 2718*trie_l[p]+3142*trie_r[p]) mod trie_size;
+loop@+ begin q:=trie_hash[h];
+ if q=0 then
+ begin trie_hash[h]:=p; trie_node:=p; return;
+ end;
+ if (trie_c[q]=trie_c[p])and(trie_o[q]=trie_o[p])and@|
+ (trie_l[q]=trie_l[p])and(trie_r[q]=trie_r[p]) then
+ begin trie_node:=q; return;
+ end;
+ if h>0 then decr(h)@+else h:=trie_size;
+ end;
+exit:end;
+
+@ A neat recursive procedure is now able to compress a trie by
+traversing it and applying |trie_node| to its nodes in ``bottom up''
+fashion. We will compress the entire trie by clearing |trie_hash| to
+zero and then saying `|trie_root:=compress_trie(trie_root)|'.
+@^recursion@>
+
+@<Declare procedures for preprocessing hyph...@>=
+function compress_trie(@!p:trie_pointer):trie_pointer;
+begin if p=0 then compress_trie:=0
+else begin trie_l[p]:=compress_trie(trie_l[p]);
+ trie_r[p]:=compress_trie(trie_r[p]);
+ compress_trie:=trie_node(p);
+ end;
+end;
+
+@ The compressed trie will be packed into the |trie| array using a
+``top-down first-fit'' procedure. This is a little tricky, so the reader
+should pay close attention: The |trie_hash| array is cleared to zero
+again and renamed |trie_ref| for this phase of the operation; later on,
+|trie_ref[p]| will be nonzero only if the linked trie node |p| is the
+smallest character
+in a family and if the characters |c| of that family have been allocated to
+locations |trie_ref[p]+c| in the |trie| array. Locations of |trie| that
+are in use will have |trie_link=0|, while the unused holes in |trie|
+will be doubly linked with |trie_link| pointing to the next larger vacant
+location and |trie_back| pointing to the next smaller one. This double
+linking will have been carried out only as far as |trie_max|, where
+|trie_max| is the largest index of |trie| that will be needed.
+To save time at the low end of the trie, we maintain array entries
+|trie_min[c]| pointing to the smallest hole that is greater than~|c|.
+Another array |trie_taken| tells whether or not a given location is
+equal to |trie_ref[p]| for some |p|; this array is used to ensure that
+distinct nodes in the compressed trie will have distinct |trie_ref|
+entries.
+
+@d trie_ref==trie_hash {where linked trie families go into |trie|}
+@d trie_back(#)==trie[#].lh {backward links in |trie| holes}
+
+@<Glob...@>=
+@!init@!trie_taken:packed array[1..trie_size] of boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:array[ASCII_code] of trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+
+@ Each time \.{\\patterns} appears, it contributes further patterns to
+the future trie, which will be built only when hyphenation is attempted or
+when a format file is dumped. The boolean variable |trie_not_ready|
+will change to |false| when the trie is compressed; this will disable
+further patterns.
+
+@<Initialize table entries...@>=
+trie_not_ready:=true; trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+
+@ Here is how the trie-compression data structures are initialized.
+If storage is tight, it would be possible to overlap |trie_op_hash|,
+|trie_op_lang|, and |trie_op_val| with |trie|, |trie_hash|, and |trie_taken|,
+because we finish with the former just before we need the latter.
+
+@<Get ready to compress the trie@>=
+@<Sort \(t)the hyphenation...@>;
+for p:=0 to trie_size do trie_hash[p]:=0;
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+for p:=0 to trie_ptr do trie_ref[p]:=0;
+for p:=0 to 255 do trie_min[p]:=p+1;
+trie_link(0):=1; trie_max:=0
+
+@ The |first_fit| procedure finds the smallest hole |z| in |trie| such that
+a trie family starting at a given node |p| will fit into vacant positions
+starting at |z|. If |c=trie_c[p]|, this means that location |z-c| must
+not already be taken by some other family, and that |z-c+@t$c^\prime$@>|
+must be vacant for all characters $c^\prime$ in the family. The procedure
+sets |trie_ref[p]| to |z-c| when the first fit has been found.
+
+@<Declare procedures for preprocessing hyph...@>=
+procedure first_fit(@!p:trie_pointer); {packs a family into |trie|}
+label not_found,found;
+var h:trie_pointer; {candidate for |trie_ref[p]|}
+@!z:trie_pointer; {runs through holes}
+@!q:trie_pointer; {runs through the family starting at |p|}
+@!c:ASCII_code; {smallest character in the family}
+@!l,@!r:trie_pointer; {left and right neighbors}
+@!ll:1..256; {upper limit of |trie_min| updating}
+begin c:=so(trie_c[p]);
+z:=trie_min[c]; {get the first conceivably good hole}
+loop@+ begin h:=z-c;@/
+ @<Ensure that |trie_max>=h+256|@>;
+ if trie_taken[h] then goto not_found;
+ @<If all characters of the family fit relative to |h|, then
+ |goto found|,\30\ otherwise |goto not_found|@>;
+ not_found: z:=trie_link(z); {move to the next hole}
+ end;
+found: @<Pack the family into |trie| relative to |h|@>;
+end;
+
+@ By making sure that |trie_max| is at least |h+256|, we can be sure that
+|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
+never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
+
+@<Ensure that |trie_max>=h+256|@>=
+if trie_max<h+256 then
+ begin if trie_size<=h+256 then overflow("pattern memory",trie_size);
+@:TeX capacity exceeded pattern memory}{\quad pattern memory@>
+ repeat incr(trie_max); trie_taken[trie_max]:=false;
+ trie_link(trie_max):=trie_max+1; trie_back(trie_max):=trie_max-1;
+ until trie_max=h+256;
+ end
+
+@ @<If all characters of the family fit relative to |h|...@>=
+q:=trie_r[p];
+while q>0 do
+ begin if trie_link(h+so(trie_c[q]))=0 then goto not_found;
+ q:=trie_r[q];
+ end;
+goto found
+
+@ @<Pack the family into |trie| relative to |h|@>=
+trie_taken[h]:=true; trie_ref[p]:=h; q:=p;
+repeat z:=h+so(trie_c[q]); l:=trie_back(z); r:=trie_link(z);
+trie_back(r):=l; trie_link(l):=r; trie_link(z):=0;
+if l<256 then
+ begin if z<256 then ll:=z @+else ll:=256;
+ repeat trie_min[l]:=r; incr(l);
+ until l=ll;
+ end;
+q:=trie_r[q];
+until q=0
+
+@ To pack the entire linked trie, we use the following recursive procedure.
+@^recursion@>
+
+@<Declare procedures for preprocessing hyph...@>=
+procedure trie_pack(@!p:trie_pointer); {pack subtries of a family}
+var q:trie_pointer; {a local variable that need not be saved on recursive calls}
+begin repeat q:=trie_l[p];
+if (q>0)and(trie_ref[q]=0) then
+ begin first_fit(q); trie_pack(q);
+ end;
+p:=trie_r[p];
+until p=0;
+end;
+
+@ When the whole trie has been allocated into the sequential table, we
+must go through it once again so that |trie| contains the correct
+information. Null pointers in the linked trie will be represented by the
+value~0, which properly implements an ``empty'' family.
+
+@<Move the data into |trie|@>=
+h.rh:=0; h.b0:=min_quarterword; h.b1:=min_quarterword; {|trie_link:=0|,
+ |trie_op:=min_quarterword|, |trie_char:=qi(0)|}
+if trie_root=0 then {no patterns were given}
+ begin for r:=0 to 256 do trie[r]:=h;
+ trie_max:=256;
+ end
+else begin trie_fix(trie_root); {this fixes the non-holes in |trie|}
+ r:=0; {now we will zero out all the holes}
+ repeat s:=trie_link(r); trie[r]:=h; r:=s;
+ until r>trie_max;
+ end;
+trie_char(0):=qi("?"); {make |trie_char(c)<>c| for all |c|}
+
+@ The fixing-up procedure is, of course, recursive. Since the linked trie
+usually has overlapping subtries, the same data may be moved several
+times; but that causes no harm, and at most as much work is done as it
+took to build the uncompressed trie.
+@^recursion@>
+
+@<Declare procedures for preprocessing hyph...@>=
+procedure trie_fix(@!p:trie_pointer); {moves |p| and its siblings into |trie|}
+var q:trie_pointer; {a local variable that need not be saved on recursive calls}
+@!c:ASCII_code; {another one that need not be saved}
+@!z:trie_pointer; {|trie| reference; this local variable must be saved}
+begin z:=trie_ref[p];
+repeat q:=trie_l[p]; c:=so(trie_c[p]);
+trie_link(z+c):=trie_ref[q]; trie_char(z+c):=qi(c); trie_op(z+c):=trie_o[p];
+if q>0 then trie_fix(q);
+p:=trie_r[p];
+until p=0;
+end;
+
+@ Now let's go back to the easier problem, of building the linked
+trie. When \.{INITEX} has scanned the `\.{\\patterns}' control
+sequence, it calls on |new_patterns| to do the right thing.
+
+@<Declare procedures for preprocessing hyph...@>=
+procedure new_patterns; {initializes the hyphenation pattern data}
+label done, done1;
+var k,@!l:0..64; {indices into |hc| and |hyf|;
+ not always in |small_number| range}
+@!digit_sensed:boolean; {should the next digit be treated as a letter?}
+@!v:quarterword; {trie op code}
+@!p,@!q:trie_pointer; {nodes of trie traversed during insertion}
+@!first_child:boolean; {is |p=trie_l[q]|?}
+@!c:ASCII_code; {character being inserted}
+begin if trie_not_ready then
+ begin set_cur_lang; scan_left_brace; {a left brace must follow \.{\\patterns}}
+ @<Enter all of the patterns into a linked trie, until coming to a right
+ brace@>;
+ end
+else begin print_err("Too late for "); print_esc("patterns");
+ help1("All patterns must be given before typesetting begins.");
+ error; link(garbage):=scan_toks(false,false); flush_list(def_ref);
+ end;
+end;
+
+@ Novices are not supposed to be using \.{\\patterns}, so the error
+messages are terse. (Note that all error messages appear in \TeX's string
+pool, even if they are used only by \.{INITEX}.)
+
+@<Enter all of the patterns into a linked trie...@>=
+k:=0; hyf[0]:=0; digit_sensed:=false;
+loop@+ begin get_x_token;
+ case cur_cmd of
+ letter,other_char:@<Append a new letter or a hyphen level@>;
+ spacer,right_brace: begin if k>0 then
+ @<Insert a new pattern into the linked trie@>;
+ if cur_cmd=right_brace then goto done;
+ k:=0; hyf[0]:=0; digit_sensed:=false;
+ end;
+ othercases begin print_err("Bad "); print_esc("patterns");
+@.Bad \\patterns@>
+ help1("(See Appendix H.)"); error;
+ end
+ endcases;
+ end;
+done:
+
+@ @<Append a new letter or a hyphen level@>=
+if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
+ begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter}
+ else begin cur_chr:=lc_code(cur_chr);
+ if cur_chr=0 then
+ begin print_err("Nonletter");
+@.Nonletter@>
+ help1("(See Appendix H.)"); error;
+ end;
+ end;
+ if k<63 then
+ begin incr(k); hc[k]:=cur_chr; hyf[k]:=0; digit_sensed:=false;
+ end;
+ end
+else if k<63 then
+ begin hyf[k]:=cur_chr-"0"; digit_sensed:=true;
+ end
+
+@ When the following code comes into play, the pattern $p_1\ldots p_k$
+appears in |hc[1..k]|, and the corresponding sequence of numbers $n_0\ldots
+n_k$ appears in |hyf[0..k]|.
+
+@<Insert a new pattern into the linked trie@>=
+begin @<Compute the trie op code, |v|, and set |l:=0|@>;
+q:=0; hc[0]:=cur_lang;
+while l<=k do
+ begin c:=hc[l]; incr(l); p:=trie_l[q]; first_child:=true;
+ while (p>0)and(c>so(trie_c[p])) do
+ begin q:=p; p:=trie_r[q]; first_child:=false;
+ end;
+ if (p=0)or(c<so(trie_c[p])) then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>;
+ q:=p; {now node |q| represents $p_1\ldots p_{l-1}$}
+ end;
+if trie_o[q]<>min_quarterword then
+ begin print_err("Duplicate pattern");
+@.Duplicate pattern@>
+ help1("(See Appendix H.)"); error;
+ end;
+trie_o[q]:=v;
+end
+
+@ @<Insert a new trie node between |q| and |p|...@>=
+begin if trie_ptr=trie_size then overflow("pattern memory",trie_size);
+@:TeX capacity exceeded pattern memory}{\quad pattern memory@>
+incr(trie_ptr); trie_r[trie_ptr]:=p; p:=trie_ptr; trie_l[p]:=0;
+if first_child then trie_l[q]:=p@+else trie_r[q]:=p;
+trie_c[p]:=si(c); trie_o[p]:=min_quarterword;
+end
+
+@ @<Compute the trie op code, |v|...@>=
+if hc[1]=0 then hyf[0]:=0;
+if hc[k]=0 then hyf[k]:=0;
+l:=k; v:=min_quarterword;
+loop@+ begin if hyf[l]<>0 then v:=new_trie_op(k-l,hyf[l],v);
+ if l>0 then decr(l)@+else goto done1;
+ end;
+done1:
+
+@ Finally we put everything together: Here is how the trie gets to its
+final, efficient form.
+The following packing routine is rigged so that the root of the linked
+tree gets mapped into location 1 of |trie|, as required by the hyphenation
+algorithm. This happens because the first call of |first_fit| will
+``take'' location~1.
+
+@<Declare procedures for preprocessing hyphenation patterns@>=
+procedure init_trie;
+var @!p:trie_pointer; {pointer for initialization}
+@!j,@!k,@!t:integer; {all-purpose registers for initialization}
+@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
+@!h:two_halves; {template used to zero out |trie|'s holes}
+begin @<Get ready to compress the trie@>;
+if trie_root<>0 then
+ begin first_fit(trie_root); trie_pack(trie_root);
+ end;
+@<Move the data into |trie|@>;
+trie_not_ready:=false;
+end;
+
+@* \[44] Breaking vertical lists into pages.
+The |vsplit| procedure, which implements \TeX's \.{\\vsplit} operation,
+is considerably simpler than |line_break| because it doesn't have to
+worry about hyphenation, and because its mission is to discover a single
+break instead of an optimum sequence of breakpoints. But before we get
+into the details of |vsplit|, we need to consider a few more basic things.
+
+@ A subroutine called |prune_page_top| takes a pointer to a vlist and
+returns a pointer to a modified vlist in which all glue, kern, and penalty nodes
+have been deleted before the first box or rule node. However, the first
+box or rule is actually preceded by a newly created glue node designed so that
+the topmost baseline will be at distance |split_top_skip| from the top,
+whenever this is possible without backspacing.
+
+In this routine and those that follow, we make use of the fact that a
+vertical list contains no character nodes, hence the |type| field exists
+for each node in the list.
+@^data structure assumptions@>
+
+@p function prune_page_top(@!p:pointer):pointer; {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q:pointer; {temporary variable for list manipulation}
+begin prev_p:=temp_head; link(temp_head):=p;
+while p<>null do
+ case type(p) of
+ hlist_node,vlist_node,rule_node:@<Insert glue for |split_top_skip|
+ and set~|p:=null|@>;
+ whatsit_node,mark_node,ins_node: begin prev_p:=p; p:=link(prev_p);
+ end;
+ glue_node,kern_node,penalty_node: begin q:=p; p:=link(q); link(q):=null;
+ link(prev_p):=p; flush_node_list(q);
+ end;
+ othercases confusion("pruning")
+@:this can't happen pruning}{\quad pruning@>
+ endcases;
+prune_page_top:=link(temp_head);
+end;
+
+@ @<Insert glue for |split_top_skip|...@>=
+begin q:=new_skip_param(split_top_skip_code); link(prev_p):=q; link(q):=p;
+ {now |temp_ptr=glue_ptr(q)|}
+if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+else width(temp_ptr):=0;
+p:=null;
+end
+
+@ The next subroutine finds the best place to break a given vertical list
+so as to obtain a box of height~|h|, with maximum depth~|d|.
+A pointer to the beginning of the vertical list is given,
+and a pointer to the optimum breakpoint is returned. The list is effectively
+followed by a forced break, i.e., a penalty node with the |eject_penalty|;
+if the best break occurs at this artificial node, the value |null| is returned.
+
+An array of six |scaled| distances is used to keep track of the height
+from the beginning of the list to the current place, just as in |line_break|.
+In fact, we use one of the same arrays, only changing its name to reflect
+its new significance.
+
+@d active_height==active_width {new name for the six distance variables}
+@d cur_height==active_height[1] {the natural height}
+@d set_height_zero(#)==active_height[#]:=0 {initialize the height to zero}
+@#
+@d update_heights=90 {go here to record glue in the |active_height| table}
+
+@p function vert_break(@!p:pointer; @!h,@!d:scaled):pointer;
+ {finds optimum page break}
+label done,not_found,update_heights;
+var prev_p:pointer; {if |p| is a glue node, |type(prev_p)| determines
+ whether |p| is a legal breakpoint}
+@!q,@!r:pointer; {glue specifications}
+@!pi:integer; {penalty value}
+@!b:integer; {badness at a trial breakpoint}
+@!least_cost:integer; {the smallest badness plus penalties found so far}
+@!best_place:pointer; {the most recent break that leads to |least_cost|}
+@!prev_dp:scaled; {depth of previous box in the list}
+@!t:small_number; {|type| of the node following a kern}
+begin prev_p:=p; {an initial glue node is not a legal breakpoint}
+least_cost:=awful_bad; do_all_six(set_height_zero); prev_dp:=0;
+loop@+ begin @<If node |p| is a legal breakpoint, check if this break is
+ the best known, and |goto done| if |p| is null or
+ if the page-so-far is already too full to accept more stuff@>;
+ prev_p:=p; p:=link(prev_p);
+ end;
+done: vert_break:=best_place;
+end;
+
+@ A global variable |best_height_plus_depth| will be set to the natural size
+of the box that corresponds to the optimum breakpoint found by |vert_break|.
+(This value is used by the insertion-splitting algorithm of the page builder.)
+
+@<Glob...@>=
+@!best_height_plus_depth:scaled; {height of the best box, without stretching or
+ shrinking}
+
+@ A subtle point to be noted here is that the maximum depth~|d| might be
+negative, so |cur_height| and |prev_dp| might need to be corrected even
+after a glue or kern node.
+
+@<If node |p| is a legal breakpoint, check...@>=
+if p=null then pi:=eject_penalty
+else @<Use node |p| to update the current height and depth measurements;
+ if this node is not a legal breakpoint, |goto not_found|
+ or |update_heights|,
+ otherwise set |pi| to the associated penalty at the break@>;
+@<Check if node |p| is a new champion breakpoint; then \(go)|goto done|
+ if |p| is a forced break or if the page-so-far is already too full@>;
+if (type(p)<glue_node)or(type(p)>kern_node) then goto not_found;
+update_heights: @<Update the current height and depth measurements with
+ respect to a glue or kern node~|p|@>;
+not_found: if prev_dp>d then
+ begin cur_height:=cur_height+prev_dp-d;
+ prev_dp:=d;
+ end;
+
+@ @<Use node |p| to update the current height and depth measurements...@>=
+case type(p) of
+hlist_node,vlist_node,rule_node: begin@t@>@;@/
+ cur_height:=cur_height+prev_dp+height(p); prev_dp:=depth(p);
+ goto not_found;
+ end;
+whatsit_node:@<Process whatsit |p| in |vert_break| loop, |goto not_found|@>;
+glue_node: if precedes_break(prev_p) then pi:=0
+ else goto update_heights;
+kern_node: begin if link(p)=null then t:=penalty_node
+ else t:=type(link(p));
+ if t=glue_node then pi:=0@+else goto update_heights;
+ end;
+penalty_node: pi:=penalty(p);
+mark_node,ins_node: goto not_found;
+othercases confusion("vertbreak")
+@:this can't happen vertbreak}{\quad vertbreak@>
+endcases
+
+@ @d deplorable==100000 {more than |inf_bad|, but less than |awful_bad|}
+
+@<Check if node |p| is a new champion breakpoint; then \(go)...@>=
+if pi<inf_penalty then
+ begin @<Compute the badness, |b|, using |awful_bad|
+ if the box is too full@>;
+ if b<awful_bad then
+ if pi<=eject_penalty then b:=pi
+ else if b<inf_bad then b:=b+pi
+ else b:=deplorable;
+ if b<=least_cost then
+ begin best_place:=p; least_cost:=b;
+ best_height_plus_depth:=cur_height+prev_dp;
+ end;
+ if (b=awful_bad)or(pi<=eject_penalty) then goto done;
+ end
+
+@ @<Compute the badness, |b|, using |awful_bad| if the box is too full@>=
+if cur_height<h then
+ if (active_height[3]<>0) or (active_height[4]<>0) or
+ (active_height[5]<>0) then b:=0
+ else b:=badness(h-cur_height,active_height[2])
+else if cur_height-h>active_height[6] then b:=awful_bad
+else b:=badness(cur_height-h,active_height[6])
+
+@ Vertical lists that are subject to the |vert_break| procedure should not
+contain infinite shrinkability, since that would permit any amount of
+information to ``fit'' on one page.
+
+@<Update the current height and depth measurements with...@>=
+if type(p)=kern_node then q:=p
+else begin q:=glue_ptr(p);
+ active_height[2+stretch_order(q)]:=@|
+ active_height[2+stretch_order(q)]+stretch(q);@/
+ active_height[6]:=active_height[6]+shrink(q);
+ if (shrink_order(q)<>normal)and(shrink(q)<>0) then
+ begin@t@>@;@/
+ print_err("Infinite glue shrinkage found in box being split");@/
+@.Infinite glue shrinkage...@>
+ help4("The box you are \vsplitting contains some infinitely")@/
+ ("shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'.")@/
+ ("Such glue doesn't belong there; but you can safely proceed,")@/
+ ("since the offensive shrinkability has been made finite.");
+ error; r:=new_spec(q); shrink_order(r):=normal; delete_glue_ref(q);
+ glue_ptr(p):=r; q:=r;
+ end;
+ end;
+cur_height:=cur_height+prev_dp+width(q); prev_dp:=0
+
+@ Now we are ready to consider |vsplit| itself. Most of
+its work is accomplished by the two subroutines that we have just considered.
+
+Given the number of a vlist box |n|, and given a desired page height |h|,
+the |vsplit| function finds the best initial segment of the vlist and
+returns a box for a page of height~|h|. The remainder of the vlist, if
+any, replaces the original box, after removing glue and penalties and
+adjusting for |split_top_skip|. Mark nodes in the split-off box are used to
+set the values of |split_first_mark| and |split_bot_mark|; we use the
+fact that |split_first_mark=null| if and only if |split_bot_mark=null|.
+
+The original box becomes ``void'' if and only if it has been entirely
+extracted. The extracted box is ``void'' if and only if the original
+box was void (or if it was, erroneously, an hlist box).
+
+@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
+ {extracts a page of height |h| from box |n|}
+label exit,done;
+var v:pointer; {the box to be split}
+p:pointer; {runs through the vlist}
+q:pointer; {points to where the break occurs}
+begin v:=box(n);
+if split_first_mark<>null then
+ begin delete_token_ref(split_first_mark); split_first_mark:=null;
+ delete_token_ref(split_bot_mark); split_bot_mark:=null;
+ end;
+@<Dispense with trivial cases of void or bad boxes@>;
+q:=vert_break(list_ptr(v),h,split_max_depth);
+@<Look at all the marks in nodes before the break, and set the final
+ link to |null| at the break@>;
+q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
+if q=null then box(n):=null {the |eq_level| of the box stays the same}
+else box(n):=vpack(q,natural);
+vsplit:=vpackage(p,h,exactly,split_max_depth);
+exit: end;
+
+@ @<Dispense with trivial cases of void or bad boxes@>=
+if v=null then
+ begin vsplit:=null; return;
+ end;
+if type(v)<>vlist_node then
+ begin print_err(""); print_esc("vsplit"); print(" needs a ");
+ print_esc("vbox");
+@:vsplit_}{\.{\\vsplit needs a \\vbox}@>
+ help2("The box you are trying to split is an \hbox.")@/
+ ("I can't split such a box, so I'll leave it alone.");
+ error; vsplit:=null; return;
+ end
+
+@ It's possible that the box begins with a penalty node that is the
+``best'' break, so we must be careful to handle this special case correctly.
+
+@<Look at all the marks...@>=
+p:=list_ptr(v);
+if p=q then list_ptr(v):=null
+else loop@+begin if type(p)=mark_node then
+ if split_first_mark=null then
+ begin split_first_mark:=mark_ptr(p);
+ split_bot_mark:=split_first_mark;
+ token_ref_count(split_first_mark):=@|
+ token_ref_count(split_first_mark)+2;
+ end
+ else begin delete_token_ref(split_bot_mark);
+ split_bot_mark:=mark_ptr(p);
+ add_token_ref(split_bot_mark);
+ end;
+ if link(p)=q then
+ begin link(p):=null; goto done;
+ end;
+ p:=link(p);
+ end;
+done:
+
+@* \[45] The page builder.
+When \TeX\ appends new material to its main vlist in vertical mode, it uses
+a method something like |vsplit| to decide where a page ends, except that
+the calculations are done ``on line'' as new items come in.
+The main complication in this process is that insertions must be put
+into their boxes and removed from the vlist, in a more-or-less optimum manner.
+
+We shall use the term ``current page'' for that part of the main vlist that
+is being considered as a candidate for being broken off and sent to the
+user's output routine. The current page starts at |link(page_head)|, and
+it ends at |page_tail|. We have |page_head=page_tail| if this list is empty.
+@^current page@>
+
+Utter chaos would reign if the user kept changing page specifications
+while a page is being constructed, so the page builder keeps the pertinent
+specifications frozen as soon as the page receives its first box or
+insertion. The global variable |page_contents| is |empty| when the
+current page contains only mark nodes and content-less whatsit nodes; it
+is |inserts_only| if the page contains only insertion nodes in addition to
+marks and whatsits. Glue nodes, kern nodes, and penalty nodes are
+discarded until a box or rule node appears, at which time |page_contents|
+changes to |box_there|. As soon as |page_contents| becomes non-|empty|,
+the current |vsize| and |max_depth| are squirreled away into |page_goal|
+and |page_max_depth|; the latter values will be used until the page has
+been forwarded to the user's output routine. The \.{\\topskip} adjustment
+is made when |page_contents| changes to |box_there|.
+
+Although |page_goal| starts out equal to |vsize|, it is decreased by the
+scaled natural height-plus-depth of the insertions considered so far, and by
+the \.{\\skip} corrections for those insertions. Therefore it represents
+the size into which the non-inserted material should fit, assuming that
+all insertions in the current page have been made.
+
+The global variables |best_page_break| and |least_page_cost| correspond
+respectively to the local variables |best_place| and |least_cost| in the
+|vert_break| routine that we have already studied; i.e., they record the
+location and value of the best place currently known for breaking the
+current page. The value of |page_goal| at the time of the best break is
+stored in |best_size|.
+
+@d inserts_only=1
+ {|page_contents| when an insert node has been contributed, but no boxes}
+@d box_there=2 {|page_contents| when a box or rule has been contributed}
+
+@<Glob...@>=
+@!page_tail:pointer; {the final node on the current page}
+@!page_contents:empty..box_there; {what is on the current page so far?}
+@!page_max_depth:scaled; {maximum box depth on page being built}
+@!best_page_break:pointer; {break here to get the best page known so far}
+@!least_page_cost:integer; {the score for this currently best page}
+@!best_size:scaled; {its |page_goal|}
+
+@ The page builder has another data structure to keep track of insertions.
+This is a list of four-word nodes, starting and ending at |page_ins_head|.
+That is, the first element of the list is node |r@t$_1$@>=link(page_ins_head)|;
+node $r_j$ is followed by |r@t$_{j+1}$@>=link(r@t$_j$@>)|; and if there are
+|n| items we have |r@t$_{n+1}$@>=page_ins_head|. The |subtype| field of
+each node in this list refers to an insertion number; for example, `\.{\\insert
+250}' would correspond to a node whose |subtype| is |qi(250)|
+(the same as the |subtype| field of the relevant |ins_node|). These |subtype|
+fields are in increasing order, and |subtype(page_ins_head)=
+qi(255)|, so |page_ins_head| serves as a convenient sentinel
+at the end of the list. A record is present for each insertion number that
+appears in the current page.
+
+The |type| field in these nodes distinguishes two possibilities that
+might occur as we look ahead before deciding on the optimum page break.
+If |type(r)=inserting|, then |height(r)| contains the total of the
+height-plus-depth dimensions of the box and all its inserts seen so far.
+If |type(r)=split_up|, then no more insertions will be made into this box,
+because at least one previous insertion was too big to fit on the current
+page; |broken_ptr(r)| points to the node where that insertion will be
+split, if \TeX\ decides to split it, |broken_ins(r)| points to the
+insertion node that was tentatively split, and |height(r)| includes also the
+natural height plus depth of the part that would be split off.
+
+In both cases, |last_ins_ptr(r)| points to the last |ins_node|
+encountered for box |qo(subtype(r))| that would be at least partially
+inserted on the next page; and |best_ins_ptr(r)| points to the last
+such |ins_node| that should actually be inserted, to get the page with
+minimum badness among all page breaks considered so far. We have
+|best_ins_ptr(r)=null| if and only if no insertion for this box should
+be made to produce this optimum page.
+
+The data structure definitions here use the fact that the |@!height| field
+appears in the fourth word of a box node.
+@^data structure assumptions@>
+
+@d page_ins_node_size=4 {number of words for a page insertion node}
+@d inserting=0 {an insertion class that has not yet overflowed}
+@d split_up=1 {an overflowed insertion class}
+@d broken_ptr(#)==link(#+1)
+ {an insertion for this class will break here if anywhere}
+@d broken_ins(#)==info(#+1) {this insertion might break at |broken_ptr|}
+@d last_ins_ptr(#)==link(#+2) {the most recent insertion for this |subtype|}
+@d best_ins_ptr(#)==info(#+2) {the optimum most recent insertion}
+
+@<Initialize the special list heads...@>=
+subtype(page_ins_head):=qi(255);
+type(page_ins_head):=split_up; link(page_ins_head):=page_ins_head;
+
+@ An array |page_so_far| records the heights and depths of everything
+on the current page. This array contains six |scaled| numbers, like the
+similar arrays already considered in |line_break| and |vert_break|; and it
+also contains |page_goal| and |page_depth|, since these values are
+all accessible to the user via |set_page_dimen| commands. The
+value of |page_so_far[1]| is also called |page_total|. The stretch
+and shrink components of the \.{\\skip} corrections for each insertion are
+included in |page_so_far|, but the natural space components of these
+corrections are not, since they have been subtracted from |page_goal|.
+
+The variable |page_depth| records the depth of the current page; it has been
+adjusted so that it is at most |page_max_depth|. The variable
+|last_glue| points to the glue specification of the most recent node
+contributed from the contribution list, if this was a glue node; otherwise
+|last_glue=max_halfword|. (If the contribution list is nonempty,
+however, the value of |last_glue| is not necessarily accurate.)
+The variables |last_penalty| and |last_kern| are similar. And
+finally, |insert_penalties| holds the sum of the penalties associated with
+all split and floating insertions.
+
+@d page_goal==page_so_far[0] {desired height of information on page being built}
+@d page_total==page_so_far[1] {height of the current page}
+@d page_shrink==page_so_far[6] {shrinkability of the current page}
+@d page_depth==page_so_far[7] {depth of the current page}
+
+@<Glob...@>=
+@!page_so_far:array [0..7] of scaled; {height and glue of the current page}
+@!last_glue:pointer; {used to implement \.{\\lastskip}}
+@!last_penalty:integer; {used to implement \.{\\lastpenalty}}
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@!insert_penalties:integer; {sum of the penalties for held-over insertions}
+
+@ @<Put each...@>=
+primitive("pagegoal",set_page_dimen,0);
+@!@:page_goal_}{\.{\\pagegoal} primitive@>
+primitive("pagetotal",set_page_dimen,1);
+@!@:page_total_}{\.{\\pagetotal} primitive@>
+primitive("pagestretch",set_page_dimen,2);
+@!@:page_stretch_}{\.{\\pagestretch} primitive@>
+primitive("pagefilstretch",set_page_dimen,3);
+@!@:page_fil_stretch_}{\.{\\pagefilstretch} primitive@>
+primitive("pagefillstretch",set_page_dimen,4);
+@!@:page_fill_stretch_}{\.{\\pagefillstretch} primitive@>
+primitive("pagefilllstretch",set_page_dimen,5);
+@!@:page_filll_stretch_}{\.{\\pagefilllstretch} primitive@>
+primitive("pageshrink",set_page_dimen,6);
+@!@:page_shrink_}{\.{\\pageshrink} primitive@>
+primitive("pagedepth",set_page_dimen,7);
+@!@:page_depth_}{\.{\\pagedepth} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_page_dimen: case chr_code of
+0: print_esc("pagegoal");
+1: print_esc("pagetotal");
+2: print_esc("pagestretch");
+3: print_esc("pagefilstretch");
+4: print_esc("pagefillstretch");
+5: print_esc("pagefilllstretch");
+6: print_esc("pageshrink");
+othercases print_esc("pagedepth")
+endcases;
+
+@ @d print_plus_end(#)==print(#);@+end
+@d print_plus(#)==if page_so_far[#]<>0 then
+ begin print(" plus "); print_scaled(page_so_far[#]); print_plus_end
+
+@p procedure print_totals;
+begin print_scaled(page_total);
+print_plus(2)("");
+print_plus(3)("fil");
+print_plus(4)("fill");
+print_plus(5)("filll");
+if page_shrink<>0 then
+ begin print(" minus "); print_scaled(page_shrink);
+ end;
+end;
+
+@ @<Show the status of the current page@>=
+if page_head<>page_tail then
+ begin print_nl("### current page:");
+ if output_active then print(" (held over for next output)");
+@.held over for next output@>
+ show_box(link(page_head));
+ if page_contents>empty then
+ begin print_nl("total height "); print_totals;
+@:total_height}{\.{total height}@>
+ print_nl(" goal height "); print_scaled(page_goal);
+@.goal height@>
+ r:=link(page_ins_head);
+ while r<>page_ins_head do
+ begin print_ln; print_esc("insert"); t:=qo(subtype(r));
+ print_int(t); print(" adds ");
+ t:=x_over_n(height(r),1000)*count(t); print_scaled(t);
+ if type(r)=split_up then
+ begin q:=page_head; t:=0;
+ repeat q:=link(q);
+ if (type(q)=ins_node)and(subtype(q)=subtype(r)) then incr(t);
+ until q=broken_ins(r);
+ print(", #"); print_int(t); print(" might split");
+ end;
+ r:=link(r);
+ end;
+ end;
+ end
+
+@ Here is a procedure that is called when the |page_contents| is changing
+from |empty| to |inserts_only| or |box_there|.
+
+@d set_page_so_far_zero(#)==page_so_far[#]:=0
+
+@p procedure freeze_page_specs(@!s:small_number);
+begin page_contents:=s;
+page_goal:=vsize; page_max_depth:=max_depth;
+page_depth:=0; do_all_six(set_page_so_far_zero);
+least_page_cost:=awful_bad;
+@!stat if tracing_pages>0 then
+ begin begin_diagnostic;
+ print_nl("%% goal height="); print_scaled(page_goal);
+@.goal height@>
+ print(", max depth="); print_scaled(page_max_depth);
+ end_diagnostic(false);
+ end;@;@+tats@;@/
+end;
+
+@ Pages are built by appending nodes to the current list in \TeX's
+vertical mode, which is at the outermost level of the semantic nest. This
+vlist is split into two parts; the ``current page'' that we have been
+talking so much about already, and the ``contribution list'' that receives
+new nodes as they are created. The current page contains everything that
+the page builder has accounted for in its data structures, as described
+above, while the contribution list contains other things that have been
+generated by other parts of \TeX\ but have not yet been
+seen by the page builder.
+The contribution list starts at |link(contrib_head)|, and it ends at the
+current node in \TeX's vertical mode.
+
+When \TeX\ has appended new material in vertical mode, it calls the procedure
+|build_page|, which tries to catch up by moving nodes from the contribution
+list to the current page. This procedure will succeed in its goal of
+emptying the contribution list, unless a page break is discovered, i.e.,
+unless the current page has grown to the point where the optimum next
+page break has been determined. In the latter case, the nodes after the
+optimum break will go back onto the contribution list, and control will
+effectively pass to the user's output routine.
+
+We make |type(page_head)=glue_node|, so that an initial glue node on
+the current page will not be considered a valid breakpoint.
+
+@<Initialize the special list...@>=
+type(page_head):=glue_node; subtype(page_head):=normal;
+
+@ The global variable |output_active| is true during the time the
+user's output routine is driving \TeX.
+
+@<Glob...@>=
+@!output_active:boolean; {are we in the midst of an output routine?}
+
+@ @<Set init...@>=
+output_active:=false; insert_penalties:=0;
+
+@ The page builder is ready to start a fresh page if we initialize
+the following state variables. (However, the page insertion list is initialized
+elsewhere.)
+
+@<Start a new current page@>=
+page_contents:=empty; page_tail:=page_head; link(page_head):=null;@/
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+page_depth:=0; page_max_depth:=0
+
+@ At certain times box 255 is supposed to be void (i.e., |null|),
+or an insertion box is supposed to be ready to accept a vertical list.
+If not, an error message is printed, and the following subroutine
+flushes the unwanted contents, reporting them to the user.
+
+@p procedure box_error(@!n:eight_bits);
+begin error; begin_diagnostic;
+print_nl("The following box has been deleted:");
+@.The following...deleted@>
+show_box(box(n)); end_diagnostic(true);
+flush_node_list(box(n)); box(n):=null;
+end;
+
+@ The following procedure guarantees that a given box register
+does not contain an \.{\\hbox}.
+
+@p procedure ensure_vbox(@!n:eight_bits);
+var p:pointer; {the box register contents}
+begin p:=box(n);
+if p<>null then if type(p)=hlist_node then
+ begin print_err("Insertions can only be added to a vbox");
+@.Insertions can only...@>
+ help3("Tut tut: You're trying to \insert into a")@/
+ ("\box register that now contains an \hbox.")@/
+ ("Proceed, and I'll discard its present contents.");
+ box_error(n);
+ end;
+end;
+
+@ \TeX\ is not always in vertical mode at the time |build_page|
+is called; the current mode reflects what \TeX\ should return to, after
+the contribution list has been emptied. A call on |build_page| should
+be immediately followed by `|goto big_switch|', which is \TeX's central
+control point.
+
+@d contribute=80 {go here to link a node into the current page}
+
+@p @t\4@>@<Declare the procedure called |fire_up|@>@;@/
+procedure build_page; {append contributions to the current page}
+label exit,done,done1,continue,contribute,update_heights;
+var p:pointer; {the node being appended}
+@!q,@!r:pointer; {nodes being examined}
+@!b,@!c:integer; {badness and cost of current page}
+@!pi:integer; {penalty to be added to the badness}
+@!n:min_quarterword..255; {insertion box number}
+@!delta,@!h,@!w:scaled; {sizes used for insertion calculations}
+begin if (link(contrib_head)=null)or output_active then return;
+repeat continue: p:=link(contrib_head);@/
+@<Update the values of |last_glue|, |last_penalty|, and |last_kern|@>;
+@<Move node |p| to the current page; if it is time for a page break,
+ put the nodes following the break back onto the contribution list,
+ and |return| to the user's output routine if there is one@>;
+until link(contrib_head)=null;
+@<Make the contribution list empty by setting its tail to |contrib_head|@>;
+exit:end;
+
+@ @d contrib_tail==nest[0].tail_field {tail of the contribution list}
+
+@<Make the contribution list empty...@>=
+if nest_ptr=0 then tail:=contrib_head {vertical mode}
+else contrib_tail:=contrib_head {other modes}
+
+@ @<Update the values of |last_glue|...@>=
+if last_glue<>max_halfword then delete_glue_ref(last_glue);
+last_penalty:=0; last_kern:=0;
+if type(p)=glue_node then
+ begin last_glue:=glue_ptr(p); add_glue_ref(last_glue);
+ end
+else begin last_glue:=max_halfword;
+ if type(p)=penalty_node then last_penalty:=penalty(p)
+ else if type(p)=kern_node then last_kern:=width(p);
+ end
+
+@ The code here is an example of a many-way switch into routines that
+merge together in different places. Some people call this unstructured
+programming, but the author doesn't see much wrong with it, as long as
+@^Knuth, Donald Ervin@>
+the various labels have a well-understood meaning.
+
+@<Move node |p| to the current page; ...@>=
+@<If the current page is empty and node |p| is to be deleted, |goto done1|;
+ otherwise use node |p| to update the state of the current page;
+ if this node is an insertion, |goto contribute|; otherwise if this node
+ is not a legal breakpoint, |goto contribute| or |update_heights|;
+ otherwise set |pi| to the penalty associated with this breakpoint@>;
+@<Check if node |p| is a new champion breakpoint; then \(if)if it is time for
+ a page break, prepare for output, and either fire up the user's
+ output routine and |return| or ship out the page and |goto done|@>;
+if (type(p)<glue_node)or(type(p)>kern_node) then goto contribute;
+update_heights:@<Update the current page measurements with respect to the
+ glue or kern specified by node~|p|@>;
+contribute: @<Make sure that |page_max_depth| is not exceeded@>;
+@<Link node |p| into the current page and |goto done|@>;
+done1:@<Recycle node |p|@>;
+done:
+
+@ @<Link node |p| into the current page and |goto done|@>=
+link(page_tail):=p; page_tail:=p;
+link(contrib_head):=link(p); link(p):=null; goto done
+
+@ @<Recycle node |p|@>=
+link(contrib_head):=link(p); link(p):=null; flush_node_list(p)
+
+@ The title of this section is already so long, it seems best to avoid
+making it more accurate but still longer, by mentioning the fact that a
+kern node at the end of the contribution list will not be contributed until
+we know its successor.
+
+@<If the current page is empty...@>=
+case type(p) of
+hlist_node,vlist_node,rule_node: if page_contents<box_there then
+ @<Initialize the current page, insert the \.{\\topskip} glue
+ ahead of |p|, and |goto continue|@>
+ else @<Prepare to move a box or rule node to the current page,
+ then |goto contribute|@>;
+whatsit_node: @<Prepare to move whatsit |p| to the current page,
+ then |goto contribute|@>;
+glue_node: if page_contents<box_there then goto done1
+ else if precedes_break(page_tail) then pi:=0
+ else goto update_heights;
+kern_node: if page_contents<box_there then goto done1
+ else if link(p)=null then return
+ else if type(link(p))=glue_node then pi:=0
+ else goto update_heights;
+penalty_node: if page_contents<box_there then goto done1@+else pi:=penalty(p);
+mark_node: goto contribute;
+ins_node: @<Append an insertion to the current page and |goto contribute|@>;
+othercases confusion("page")
+@:this can't happen page}{\quad page@>
+endcases
+
+@ @<Initialize the current page, insert the \.{\\topskip} glue...@>=
+begin if page_contents=empty then freeze_page_specs(box_there)
+else page_contents:=box_there;
+q:=new_skip_param(top_skip_code); {now |temp_ptr=glue_ptr(q)|}
+if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+else width(temp_ptr):=0;
+link(q):=p; link(contrib_head):=q; goto continue;
+end
+
+@ @<Prepare to move a box or rule node to the current page...@>=
+begin page_total:=page_total+page_depth+height(p);
+page_depth:=depth(p);
+goto contribute;
+end
+
+@ @<Make sure that |page_max_depth| is not exceeded@>=
+if page_depth>page_max_depth then
+ begin page_total:=@|
+ page_total+page_depth-page_max_depth;@/
+ page_depth:=page_max_depth;
+ end;
+
+@ @<Update the current page measurements with respect to the glue...@>=
+if type(p)=kern_node then q:=p
+else begin q:=glue_ptr(p);
+ page_so_far[2+stretch_order(q)]:=@|
+ page_so_far[2+stretch_order(q)]+stretch(q);@/
+ page_shrink:=page_shrink+shrink(q);
+ if (shrink_order(q)<>normal)and(shrink(q)<>0) then
+ begin@t@>@;@/
+ print_err("Infinite glue shrinkage found on current page");@/
+@.Infinite glue shrinkage...@>
+ help4("The page about to be output contains some infinitely")@/
+ ("shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'.")@/
+ ("Such glue doesn't belong there; but you can safely proceed,")@/
+ ("since the offensive shrinkability has been made finite.");
+ error;
+ r:=new_spec(q); shrink_order(r):=normal; delete_glue_ref(q);
+ glue_ptr(p):=r; q:=r;
+ end;
+ end;
+page_total:=page_total+page_depth+width(q); page_depth:=0
+
+@ @<Check if node |p| is a new champion breakpoint; then \(if)...@>=
+if pi<inf_penalty then
+ begin @<Compute the badness, |b|, of the current page,
+ using |awful_bad| if the box is too full@>;
+ if b<awful_bad then
+ if pi<=eject_penalty then c:=pi
+ else if b<inf_bad then c:=b+pi+insert_penalties
+ else c:=deplorable
+ else c:=b;
+ if insert_penalties>=10000 then c:=awful_bad;
+ @!stat if tracing_pages>0 then @<Display the page break cost@>;@+tats@;@/
+ if c<=least_page_cost then
+ begin best_page_break:=p; best_size:=page_goal;
+ least_page_cost:=c;
+ r:=link(page_ins_head);
+ while r<>page_ins_head do
+ begin best_ins_ptr(r):=last_ins_ptr(r);
+ r:=link(r);
+ end;
+ end;
+ if (c=awful_bad)or(pi<=eject_penalty) then
+ begin fire_up(p); {output the current page at the best place}
+ if output_active then return; {user's output routine will act}
+ goto done; {the page has been shipped out by default output routine}
+ end;
+ end
+
+@ @<Display the page break cost@>=
+begin begin_diagnostic; print_nl("%");
+print(" t="); print_totals;@/
+print(" g="); print_scaled(page_goal);@/
+print(" b=");
+if b=awful_bad then print_char("*")@+else print_int(b);
+@.*\relax@>
+print(" p="); print_int(pi);
+print(" c=");
+if c=awful_bad then print_char("*")@+else print_int(c);
+if c<=least_page_cost then print_char("#");
+end_diagnostic(false);
+end
+
+@ @<Compute the badness, |b|, of the current page...@>=
+if page_total<page_goal then
+ if (page_so_far[3]<>0) or (page_so_far[4]<>0) or@|
+ (page_so_far[5]<>0) then b:=0
+ else b:=badness(page_goal-page_total,page_so_far[2])
+else if page_total-page_goal>page_shrink then b:=awful_bad
+else b:=badness(page_total-page_goal,page_shrink)
+
+@ @<Append an insertion to the current page and |goto contribute|@>=
+begin if page_contents=empty then freeze_page_specs(inserts_only);
+n:=subtype(p); r:=page_ins_head;
+while n>=subtype(link(r)) do r:=link(r);
+n:=qo(n);
+if subtype(r)<>qi(n) then
+ @<Create a page insertion node with |subtype(r)=qi(n)|, and
+ include the glue correction for box |n| in the
+ current page state@>;
+if type(r)=split_up then insert_penalties:=insert_penalties+float_cost(p)
+else begin last_ins_ptr(r):=p;
+ delta:=page_goal-page_total-page_depth+page_shrink;
+ {this much room is left if we shrink the maximum}
+ if count(n)=1000 then h:=height(p)
+ else h:=x_over_n(height(p),1000)*count(n); {this much room is needed}
+ if ((h<=0)or(h<=delta))and(height(p)+height(r)<=dimen(n)) then
+ begin page_goal:=page_goal-h; height(r):=height(r)+height(p);
+ end
+ else @<Find the best way to split the insertion, and change
+ |type(r)| to |split_up|@>;
+ end;
+goto contribute;
+end
+
+@ We take note of the value of \.{\\skip} |n| and the height plus depth
+of \.{\\box}~|n| only when the first \.{\\insert}~|n| node is
+encountered for a new page. A user who changes the contents of \.{\\box}~|n|
+after that first \.{\\insert}~|n| had better be either extremely careful
+or extremely lucky, or both.
+
+@<Create a page insertion node...@>=
+begin q:=get_node(page_ins_node_size); link(q):=link(r); link(r):=q; r:=q;
+subtype(r):=qi(n); type(r):=inserting; ensure_vbox(n);
+if box(n)=null then height(r):=0
+else height(r):=height(box(n))+depth(box(n));
+best_ins_ptr(r):=null;@/
+q:=skip(n);
+if count(n)=1000 then h:=height(r)
+else h:=x_over_n(height(r),1000)*count(n);
+page_goal:=page_goal-h-width(q);@/
+page_so_far[2+stretch_order(q)]:=@|page_so_far[2+stretch_order(q)]+stretch(q);@/
+page_shrink:=page_shrink+shrink(q);
+if (shrink_order(q)<>normal)and(shrink(q)<>0) then
+ begin print_err("Infinite glue shrinkage inserted from "); print_esc("skip");
+@.Infinite glue shrinkage...@>
+ print_int(n);
+ help3("The correction glue for page breaking with insertions")@/
+ ("must have finite shrinkability. But you may proceed,")@/
+ ("since the offensive shrinkability has been made finite.");
+ error;
+ end;
+end
+
+@ Here is the code that will split a long footnote between pages, in an
+emergency. The current situation deserves to be recapitulated: Node |p|
+is an insertion into box |n|; the insertion will not fit, in its entirety,
+either because it would make the total contents of box |n| greater than
+\.{\\dimen} |n|, or because it would make the incremental amount of growth
+|h| greater than the available space |delta|, or both. (This amount |h| has
+been weighted by the insertion scaling factor, i.e., by \.{\\count} |n|
+over 1000.) Now we will choose the best way to break the vlist of the
+insertion, using the same criteria as in the \.{\\vsplit} operation.
+
+@<Find the best way to split the insertion...@>=
+begin if count(n)<=0 then w:=max_dimen
+else begin w:=page_goal-page_total-page_depth;
+ if count(n)<>1000 then w:=x_over_n(w,count(n))*1000;
+ end;
+if w>dimen(n)-height(r) then w:=dimen(n)-height(r);
+q:=vert_break(ins_ptr(p),w,depth(p));
+height(r):=height(r)+best_height_plus_depth;
+@!stat if tracing_pages>0 then @<Display the insertion split cost@>;@+tats@;@/
+if count(n)<>1000 then
+ best_height_plus_depth:=x_over_n(best_height_plus_depth,1000)*count(n);
+page_goal:=page_goal-best_height_plus_depth;
+type(r):=split_up; broken_ptr(r):=q; broken_ins(r):=p;
+if q=null then insert_penalties:=insert_penalties+eject_penalty
+else if type(q)=penalty_node then insert_penalties:=insert_penalties+penalty(q);
+end
+
+@ @<Display the insertion split cost@>=
+begin begin_diagnostic; print_nl("% split"); print_int(n);
+@.split@>
+print(" to "); print_scaled(w);
+print_char(","); print_scaled(best_height_plus_depth);@/
+print(" p=");
+if q=null then print_int(eject_penalty)
+else if type(q)=penalty_node then print_int(penalty(q))
+else print_char("0");
+end_diagnostic(false);
+end
+
+@ When the page builder has looked at as much material as could appear before
+the next page break, it makes its decision. The break that gave minimum
+badness will be used to put a completed ``page'' into box 255, with insertions
+appended to their other boxes.
+
+We also set the values of |top_mark|, |first_mark|, and |bot_mark|. The
+program uses the fact that |bot_mark<>null| implies |first_mark<>null|;
+it also knows that |bot_mark=null| implies |top_mark=first_mark=null|.
+
+The |fire_up| subroutine prepares to output the current page at the best
+place; then it fires up the user's output routine, if there is one,
+or it simply ships out the page. There is one parameter, |c|, which represents
+the node that was being contributed to the page when the decision to
+force an output was made.
+
+@<Declare the procedure called |fire_up|@>=
+procedure fire_up(@!c:pointer);
+label exit;
+var p,@!q,@!r,@!s:pointer; {nodes being examined and/or changed}
+@!prev_p:pointer; {predecessor of |p|}
+@!n:min_quarterword..255; {insertion box number}
+@!wait:boolean; {should the present insertion be held over?}
+@!save_vbadness:integer; {saved value of |vbadness|}
+@!save_vfuzz: scaled; {saved value of |vfuzz|}
+@!save_split_top_skip: pointer; {saved value of |split_top_skip|}
+begin @<Set the value of |output_penalty|@>;
+if bot_mark<>null then
+ begin if top_mark<>null then delete_token_ref(top_mark);
+ top_mark:=bot_mark; add_token_ref(top_mark);
+ delete_token_ref(first_mark); first_mark:=null;
+ end;
+@<Put the \(o)optimal current page into box 255, update |first_mark| and
+ |bot_mark|, append insertions to their boxes, and put the
+ remaining nodes back on the contribution list@>;
+if (top_mark<>null)and(first_mark=null) then
+ begin first_mark:=top_mark; add_token_ref(top_mark);
+ end;
+if output_routine<>null then
+ if dead_cycles>=max_dead_cycles then
+ @<Explain that too many dead cycles have occurred in a row@>
+ else @<Fire up the user's output routine and |return|@>;
+@<Perform the default output routine@>;
+exit:end;
+
+@ @<Set the value of |output_penalty|@>=
+if type(best_page_break)=penalty_node then
+ begin geq_word_define(int_base+output_penalty_code,penalty(best_page_break));
+ penalty(best_page_break):=inf_penalty;
+ end
+else geq_word_define(int_base+output_penalty_code,inf_penalty)
+
+@ As the page is finally being prepared for output,
+pointer |p| runs through the vlist, with |prev_p| trailing behind;
+pointer |q| is the tail of a list of insertions that
+are being held over for a subsequent page.
+
+@<Put the \(o)optimal current page into box 255...@>=
+if c=best_page_break then best_page_break:=null; {|c| not yet linked in}
+@<Ensure that box 255 is empty before output@>;
+insert_penalties:=0; {this will count the number of insertions held over}
+save_split_top_skip:=split_top_skip;
+if holding_inserts<=0 then
+ @<Prepare all the boxes involved in insertions to act as queues@>;
+q:=hold_head; link(q):=null; prev_p:=page_head; p:=link(prev_p);
+while p<>best_page_break do
+ begin if type(p)=ins_node then
+ begin if holding_inserts<=0 then
+ @<Either insert the material specified by node |p| into the
+ appropriate box, or hold it for the next page;
+ also delete node |p| from the current page@>;
+ end
+ else if type(p)=mark_node then @<Update the values of
+ |first_mark| and |bot_mark|@>;
+ prev_p:=p; p:=link(prev_p);
+ end;
+split_top_skip:=save_split_top_skip;
+@<Break the current page at node |p|, put it in box~255,
+ and put the remaining nodes on the contribution list@>;
+@<Delete \(t)the page-insertion nodes@>
+
+@ @<Ensure that box 255 is empty before output@>=
+if box(255)<>null then
+ begin print_err(""); print_esc("box"); print("255 is not void");
+@:box255}{\.{\\box255 is not void}@>
+ help2("You shouldn't use \box255 except in \output routines.")@/
+ ("Proceed, and I'll discard its present contents.");
+ box_error(255);
+ end
+
+@ @<Update the values of |first_mark| and |bot_mark|@>=
+begin if first_mark=null then
+ begin first_mark:=mark_ptr(p);
+ add_token_ref(first_mark);
+ end;
+if bot_mark<>null then delete_token_ref(bot_mark);
+bot_mark:=mark_ptr(p); add_token_ref(bot_mark);
+end
+
+@ When the following code is executed, the current page runs from node
+|link(page_head)| to node |prev_p|, and the nodes from |p| to |page_tail|
+are to be placed back at the front of the contribution list. Furthermore
+the heldover insertions appear in a list from |link(hold_head)| to |q|; we
+will put them into the current page list for safekeeping while the user's
+output routine is active. We might have |q=hold_head|; and |p=null| if
+and only if |prev_p=page_tail|. Error messages are suppressed within
+|vpackage|, since the box might appear to be overfull or underfull simply
+because the stretch and shrink from the \.{\\skip} registers for inserts
+are not actually present in the box.
+
+@<Break the current page at node |p|, put it...@>=
+if p<>null then
+ begin if link(contrib_head)=null then
+ if nest_ptr=0 then tail:=page_tail
+ else contrib_tail:=page_tail;
+ link(page_tail):=link(contrib_head);
+ link(contrib_head):=p;
+ link(prev_p):=null;
+ end;
+save_vbadness:=vbadness; vbadness:=inf_bad;
+save_vfuzz:=vfuzz; vfuzz:=max_dimen; {inhibit error messages}
+box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth);
+vbadness:=save_vbadness; vfuzz:=save_vfuzz;
+if last_glue<>max_halfword then delete_glue_ref(last_glue);
+@<Start a new current page@>; {this sets |last_glue:=max_halfword|}
+if q<>hold_head then
+ begin link(page_head):=link(hold_head); page_tail:=q;
+ end
+
+@ If many insertions are supposed to go into the same box, we want to know
+the position of the last node in that box, so that we don't need to waste time
+when linking further information into it. The |last_ins_ptr| fields of the
+page insertion nodes are therefore used for this purpose during the
+packaging phase.
+
+@<Prepare all the boxes involved in insertions to act as queues@>=
+begin r:=link(page_ins_head);
+while r<>page_ins_head do
+ begin if best_ins_ptr(r)<>null then
+ begin n:=qo(subtype(r)); ensure_vbox(n);
+ if box(n)=null then box(n):=new_null_box;
+ p:=box(n)+list_offset;
+ while link(p)<>null do p:=link(p);
+ last_ins_ptr(r):=p;
+ end;
+ r:=link(r);
+ end;
+end
+
+@ @<Delete \(t)the page-insertion nodes@>=
+r:=link(page_ins_head);
+while r<>page_ins_head do
+ begin q:=link(r); free_node(r,page_ins_node_size); r:=q;
+ end;
+link(page_ins_head):=page_ins_head
+
+@ We will set |best_ins_ptr:=null| and package the box corresponding to
+insertion node~|r|, just after making the final insertion into that box.
+If this final insertion is `|split_up|', the remainder after splitting
+and pruning (if any) will be carried over to the next page.
+
+@<Either insert the material specified by node |p| into...@>=
+begin r:=link(page_ins_head);
+while subtype(r)<>subtype(p) do r:=link(r);
+if best_ins_ptr(r)=null then wait:=true
+else begin wait:=false; s:=last_ins_ptr(r); link(s):=ins_ptr(p);
+ if best_ins_ptr(r)=p then
+ @<Wrap up the box specified by node |r|, splitting node |p| if
+ called for; set |wait:=true| if node |p| holds a remainder after
+ splitting@>
+ else begin while link(s)<>null do s:=link(s);
+ last_ins_ptr(r):=s;
+ end;
+ end;
+@<Either append the insertion node |p| after node |q|, and remove it
+ from the current page, or delete |node(p)|@>;
+end
+
+@ @<Wrap up the box specified by node |r|, splitting node |p| if...@>=
+begin if type(r)=split_up then
+ if (broken_ins(r)=p)and(broken_ptr(r)<>null) then
+ begin while link(s)<>broken_ptr(r) do s:=link(s);
+ link(s):=null;
+ split_top_skip:=split_top_ptr(p);
+ ins_ptr(p):=prune_page_top(broken_ptr(r));
+ if ins_ptr(p)<>null then
+ begin temp_ptr:=vpack(ins_ptr(p),natural);
+ height(p):=height(temp_ptr)+depth(temp_ptr);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+box(n):=vpack(temp_ptr,natural);
+end
+
+@ @<Either append the insertion node |p|...@>=
+link(prev_p):=link(p); link(p):=null;
+if wait then
+ begin link(q):=p; q:=p; incr(insert_penalties);
+ end
+else begin delete_glue_ref(split_top_ptr(p));
+ free_node(p,ins_node_size);
+ end;
+p:=prev_p
+
+@ The list of heldover insertions, running from |link(page_head)| to
+|page_tail|, must be moved to the contribution list when the user has
+specified no output routine.
+
+@<Perform the default output routine@>=
+begin if link(page_head)<>null then
+ begin if link(contrib_head)=null then
+ if nest_ptr=0 then tail:=page_tail@+else contrib_tail:=page_tail
+ else link(page_tail):=link(contrib_head);
+ link(contrib_head):=link(page_head);
+ link(page_head):=null; page_tail:=page_head;
+ end;
+ship_out(box(255)); box(255):=null;
+end
+
+@ @<Explain that too many dead cycles have occurred in a row@>=
+begin print_err("Output loop---"); print_int(dead_cycles);
+@.Output loop...@>
+print(" consecutive dead cycles");
+help3("I've concluded that your \output is awry; it never does a")@/
+("\shipout, so I'm shipping \box255 out myself. Next time")@/
+("increase \maxdeadcycles if you want me to be more patient!"); error;
+end
+
+@ @<Fire up the user's output routine and |return|@>=
+begin output_active:=true;
+incr(dead_cycles);
+push_nest; mode:=-vmode; prev_depth:=ignore_depth; mode_line:=-line;
+begin_token_list(output_routine,output_text);
+new_save_level(output_group); normal_paragraph;
+scan_left_brace;
+return;
+end
+
+@ When the user's output routine finishes, it has constructed a vlist
+in internal vertical mode, and \TeX\ will do the following:
+
+@<Resume the page builder after an output routine has come to an end@>=
+begin if (loc<>null) or
+ ((token_type<>output_text)and(token_type<>backed_up)) then
+ @<Recover from an unbalanced output routine@>;
+end_token_list; {conserve stack space in case more outputs are triggered}
+end_graf; unsave; output_active:=false; insert_penalties:=0;@/
+@<Ensure that box 255 is empty after output@>;
+if tail<>head then {current list goes after heldover insertions}
+ begin link(page_tail):=link(head);
+ page_tail:=tail;
+ end;
+if link(page_head)<>null then {and both go before heldover contributions}
+ begin if link(contrib_head)=null then contrib_tail:=page_tail;
+ link(page_tail):=link(contrib_head);
+ link(contrib_head):=link(page_head);
+ link(page_head):=null; page_tail:=page_head;
+ end;
+pop_nest; build_page;
+end
+
+@ @<Recover from an unbalanced output routine@>=
+begin print_err("Unbalanced output routine");
+@.Unbalanced output routine@>
+help2("Your sneaky output routine has problematic {'s and/or }'s.")@/
+("I can't handle that very well; good luck."); error;
+repeat get_token;
+until loc=null;
+end {loops forever if reading from a file, since |null=min_halfword<=0|}
+
+@ @<Ensure that box 255 is empty after output@>=
+if box(255)<>null then
+ begin print_err("Output routine didn't use all of ");
+ print_esc("box"); print_int(255);
+@.Output routine didn't use...@>
+ help3("Your \output commands should empty \box255,")@/
+ ("e.g., by saying `\shipout\box255'.")@/
+ ("Proceed; I'll discard its present contents.");
+ box_error(255);
+ end
+
+@* \[46] The chief executive.
+We come now to the |main_control| routine, which contains the master
+switch that causes all the various pieces of \TeX\ to do their things,
+in the right order.
+
+In a sense, this is the grand climax of the program: It applies all the
+tools that we have worked so hard to construct. In another sense, this is
+the messiest part of the program: It necessarily refers to other pieces
+of code all over the place, so that a person can't fully understand what is
+going on without paging back and forth to be reminded of conventions that
+are defined elsewhere. We are now at the hub of the web, the central nervous
+system that touches most of the other parts and ties them together.
+@^brain@>
+
+The structure of |main_control| itself is quite simple. There's a label
+called |big_switch|, at which point the next token of input is fetched
+using |get_x_token|. Then the program branches at high speed into one of
+about 100 possible directions, based on the value of the current
+mode and the newly fetched command code; the sum |abs(mode)+cur_cmd|
+indicates what to do next. For example, the case `|vmode+letter|' arises
+when a letter occurs in vertical mode (or internal vertical mode); this
+case leads to instructions that initialize a new paragraph and enter
+horizontal mode.
+
+The big |case| statement that contains this multiway switch has been labeled
+|reswitch|, so that the program can |goto reswitch| when the next token
+has already been fetched. Most of the cases are quite short; they call
+an ``action procedure'' that does the work for that case, and then they
+either |goto reswitch| or they ``fall through'' to the end of the |case|
+statement, which returns control back to |big_switch|. Thus, |main_control|
+is not an extremely large procedure, in spite of the multiplicity of things
+it must do; it is small enough to be handled by \PASCAL\ compilers that put
+severe restrictions on procedure size.
+@!@^action procedure@>
+
+One case is singled out for special treatment, because it accounts for most
+of \TeX's activities in typical applications. The process of reading simple
+text and converting it into |char_node| records, while looking for ligatures
+and kerns, is part of \TeX's ``inner loop''; the whole program runs
+efficiently when its inner loop is fast, so this part has been written
+with particular care.
+
+@ We shall concentrate first on the inner loop of |main_control|, deferring
+consideration of the other cases until later.
+@^inner loop@>
+
+@d big_switch=60 {go here to branch on the next token of input}
+@d main_loop=70 {go here to typeset a string of consecutive characters}
+@d main_loop_wrapup=80 {go here to finish a character or ligature}
+@d main_loop_move=90 {go here to advance the ligature cursor}
+@d main_loop_move_lig=95 {same, when advancing past a generated ligature}
+@d main_loop_lookahead=100 {go here to bring in another character, if any}
+@d main_lig_loop=110 {go here to check for ligatures or kerning}
+@d append_normal_space=120 {go here to append a normal space between words}
+
+@p @t\4@>@<Declare action procedures for use by |main_control|@>@;
+@t\4@>@<Declare the procedure called |handle_right_brace|@>@;
+procedure main_control; {governs \TeX's activities}
+label big_switch,reswitch,main_loop,main_loop_wrapup,
+ main_loop_move,main_loop_move+1,main_loop_move+2,main_loop_move_lig,
+ main_loop_lookahead,main_loop_lookahead+1,
+ main_lig_loop,main_lig_loop+1,main_lig_loop+2,
+ append_normal_space,exit;
+var@!t:integer; {general-purpose temporary variable}
+begin if every_job<>null then begin_token_list(every_job,every_job_text);
+big_switch: get_x_token;@/
+reswitch: @<Give diagnostic information, if requested@>;
+case abs(mode)+cur_cmd of
+hmode+letter,hmode+other_char,hmode+char_given: goto main_loop;
+hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end;
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+hmode+spacer: if space_factor=1000 then goto append_normal_space
+ else app_space;
+hmode+ex_space,mmode+ex_space: goto append_normal_space;
+@t\4@>@<Cases of |main_control| that are not part of the inner loop@>@;
+end; {of the big |case| statement}
+goto big_switch;
+main_loop:@<Append character |cur_chr| and the following characters (if~any)
+ to the current hlist in the current font; |goto reswitch| when
+ a non-character has been fetched@>;
+append_normal_space:@<Append a normal inter-word space to the current list,
+ then |goto big_switch|@>;
+exit:end;
+
+@ When a new token has just been fetched at |big_switch|, we have an
+ideal place to monitor \TeX's activity.
+@^debugging@>
+
+@<Give diagnostic information, if requested@>=
+if interrupt<>0 then if OK_to_interrupt then
+ begin back_input; check_interrupt; goto big_switch;
+ end;
+@!debug if panicking then check_mem(false);@+@;@+gubed
+if tracing_commands>0 then show_cur_cmd_chr
+
+@ The following part of the program was first written in a structured
+manner, according to the philosophy that ``premature optimization is
+the root of all evil.'' Then it was rearranged into pieces of
+spaghetti so that the most common actions could proceed with little or
+no redundancy.
+
+The original unoptimized form of this algorithm resembles the
+|reconstitute| procedure, which was described earlier in connection with
+hyphenation. Again we have an implied ``cursor'' between characters
+|cur_l| and |cur_r|. The main difference is that the |lig_stack| can now
+contain a charnode as well as pseudo-ligatures; that stack is now
+usually nonempty, because the next character of input (if any) has been
+appended to it. In |main_control| we have
+$$|cur_r|=\cases{|character(lig_stack)|,&if |lig_stack>null|;\cr
+ |font_bchar[cur_font]|,&otherwise;\cr}$$
+except when |character(lig_stack)=font_false_bchar[cur_font]|.
+Several additional global variables are needed.
+
+@<Glob...@>=
+@!main_f:internal_font_number; {the current font}
+@!main_i:four_quarters; {character information bytes for |cur_l|}
+@!main_j:four_quarters; {ligature/kern command}
+@!main_k:font_index; {index into |font_info|}
+@!main_p:pointer; {temporary register for list manipulation}
+@!main_s:integer; {space factor value}
+@!bchar:halfword; {right boundary character of current font, or |non_char|}
+@!false_bchar:halfword; {nonexistent character matching |bchar|, or |non_char|}
+@!cancel_boundary:boolean; {should the left boundary be ignored?}
+@!ins_disc:boolean; {should we insert a discretionary node?}
+
+@ The boolean variables of the main loop are normally false, and always reset
+to false before the loop is left. That saves us the extra work of initializing
+each time.
+
+@<Set init...@>=
+ligature_present:=false; cancel_boundary:=false; lft_hit:=false; rt_hit:=false;
+ins_disc:=false;
+
+@ We leave the |space_factor| unchanged if |sf_code(cur_chr)=0|; otherwise we
+set it equal to |sf_code(cur_chr)|, except that it should never change
+from a value less than 1000 to a value exceeding 1000. The most common
+case is |sf_code(cur_chr)=1000|, so we want that case to be fast.
+
+The overall structure of the main loop is presented here. Some program labels
+are inside the individual sections.
+
+@d adjust_space_factor==@t@>@;@/
+ main_s:=sf_code(cur_chr);
+ if main_s=1000 then space_factor:=1000
+ else if main_s<1000 then
+ begin if main_s>0 then space_factor:=main_s;
+ end
+ else if space_factor<1000 then space_factor:=1000
+ else space_factor:=main_s
+
+@<Append character |cur_chr|...@>=
+adjust_space_factor;@/
+main_f:=cur_font;
+bchar:=font_bchar[main_f]; false_bchar:=font_false_bchar[main_f];
+if mode>0 then if language<>clang then fix_language;
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+character(lig_stack):=cur_l;@/
+cur_q:=tail;
+if cancel_boundary then
+ begin cancel_boundary:=false; main_k:=non_address;
+ end
+else main_k:=bchar_label[main_f];
+if main_k=non_address then goto main_loop_move+2; {no left boundary processing}
+cur_r:=cur_l; cur_l:=non_char;
+goto main_lig_loop+1; {begin with cursor after left boundary}
+@#
+main_loop_wrapup:@<Make a ligature node, if |ligature_present|;
+ insert a null discretionary, if appropriate@>;
+main_loop_move:@<If the cursor is immediately followed by the right boundary,
+ |goto reswitch|; if it's followed by an invalid character, |goto big_switch|;
+ otherwise move the cursor one step to the right and |goto main_lig_loop|@>;
+main_loop_lookahead:@<Look ahead for another character, or leave |lig_stack|
+ empty if there's none there@>;
+main_lig_loop:@<If there's a ligature/kern command relevant to |cur_l| and
+ |cur_r|, adjust the text appropriately; exit to |main_loop_wrapup|@>;
+main_loop_move_lig:@<Move the cursor past a pseudo-ligature, then
+ |goto main_loop_lookahead| or |main_lig_loop|@>
+
+@ If the current horizontal list is empty, the reference to |character(tail)|
+here is not strictly legal, since |tail| will be a node freshly returned by
+|get_avail|. But this should cause no problem on most implementations, and we
+do want the inner loop to be fast.
+@^dirty \PASCAL@>
+
+A discretionary break is not inserted for an explicit hyphen when we are in
+restricted horizontal mode. In particular, this avoids putting discretionary
+nodes inside of other discretionaries.
+
+@d pack_lig(#)== {the parameter is either |rt_hit| or |false|}
+ begin main_p:=new_ligature(main_f,cur_l,link(cur_q));
+ if lft_hit then
+ begin subtype(main_p):=2; lft_hit:=false;
+ end;
+ if # then if lig_stack=null then
+ begin incr(subtype(main_p)); rt_hit:=false;
+ end;
+ link(cur_q):=main_p; tail:=main_p; ligature_present:=false;
+ end
+
+@d wrapup(#)==if cur_l<non_char then
+ begin if character(tail)=qi(hyphen_char[main_f]) then if link(cur_q)>null then
+ ins_disc:=true;
+ if ligature_present then pack_lig(#);
+ if ins_disc then
+ begin ins_disc:=false;
+ if mode>0 then tail_append(new_disc);
+ end;
+ end
+
+@<Make a ligature node, if |ligature_present|;...@>=
+wrapup(rt_hit)
+
+@ @<If the cursor is immediately followed by the right boundary...@>=
+if lig_stack=null then goto reswitch;
+cur_q:=tail; cur_l:=character(lig_stack);
+main_loop_move+1:if not is_char_node(lig_stack) then goto main_loop_move_lig;
+main_loop_move+2:if(cur_chr<font_bc[main_f])or(cur_chr>font_ec[main_f]) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+main_i:=char_info(main_f)(cur_l);
+if not char_exists(main_i) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+tail_append(lig_stack) {|main_loop_lookahead| is next}
+
+@ Here we are at |main_loop_move_lig|.
+When we begin this code we have |cur_q=tail| and |cur_l=character(lig_stack)|.
+
+@<Move the cursor past a pseudo-ligature...@>=
+main_p:=lig_ptr(lig_stack);
+if main_p>null then tail_append(main_p);
+temp_ptr:=lig_stack; lig_stack:=link(temp_ptr);
+free_node(temp_ptr,small_node_size);
+main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+if lig_stack=null then
+ if main_p>null then goto main_loop_lookahead
+ else cur_r:=bchar
+else cur_r:=character(lig_stack);
+goto main_lig_loop
+
+@ The result of \.{\\char} can participate in a ligature or kern, so we must
+look ahead for it.
+
+@<Look ahead for another character...@>=
+get_next; {set only |cur_cmd| and |cur_chr|, for speed}
+if cur_cmd=letter then goto main_loop_lookahead+1;
+if cur_cmd=other_char then goto main_loop_lookahead+1;
+if cur_cmd=char_given then goto main_loop_lookahead+1;
+x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|}
+if cur_cmd=letter then goto main_loop_lookahead+1;
+if cur_cmd=other_char then goto main_loop_lookahead+1;
+if cur_cmd=char_given then goto main_loop_lookahead+1;
+if cur_cmd=char_num then
+ begin scan_char_num; cur_chr:=cur_val; goto main_loop_lookahead+1;
+ end;
+if cur_cmd=no_boundary then bchar:=non_char;
+cur_r:=bchar; lig_stack:=null; goto main_lig_loop;
+main_loop_lookahead+1: adjust_space_factor;
+fast_get_avail(lig_stack); font(lig_stack):=main_f;
+cur_r:=qi(cur_chr); character(lig_stack):=cur_r;
+if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures}
+
+@ Even though comparatively few characters have a lig/kern program, several
+of the instructions here count as part of \TeX's inner loop, since a
+@^inner loop@>
+potentially long sequential search must be performed. For example, tests with
+Computer Modern Roman showed that about 40 per cent of all characters
+actually encountered in practice had a lig/kern program, and that about four
+lig/kern commands were investigated for every such character.
+
+At the beginning of this code we have |main_i=char_info(main_f)(cur_l)|.
+
+@<If there's a ligature/kern command...@>=
+if char_tag(main_i)<>lig_tag then goto main_loop_wrapup;
+main_k:=lig_kern_start(main_f)(main_i); main_j:=font_info[main_k].qqqq;
+if skip_byte(main_j)<=stop_flag then goto main_lig_loop+2;
+main_k:=lig_kern_restart(main_f)(main_j);
+main_lig_loop+1:main_j:=font_info[main_k].qqqq;
+main_lig_loop+2:if next_char(main_j)=cur_r then
+ if skip_byte(main_j)<=stop_flag then
+ @<Do ligature or kern command, returning to |main_lig_loop|
+ or |main_loop_wrapup| or |main_loop_move|@>;
+if skip_byte(main_j)=qi(0) then incr(main_k)
+else begin if skip_byte(main_j)>=stop_flag then goto main_loop_wrapup;
+ main_k:=main_k+qo(skip_byte(main_j))+1;
+ end;
+goto main_lig_loop+1
+
+@ When a ligature or kern instruction matches a character, we know from
+|read_font_info| that the character exists in the font, even though we
+haven't verified its existence in the normal way.
+
+This section could be made into a subroutine, if the code inside
+|main_control| needs to be shortened.
+
+\chardef\?='174 % vertical line to indicate character retention
+
+@<Do ligature or kern command...@>=
+begin if op_byte(main_j)>=kern_flag then
+ begin wrapup(rt_hit);
+ tail_append(new_kern(char_kern(main_f)(main_j))); goto main_loop_move;
+ end;
+if cur_l=non_char then lft_hit:=true
+else if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(main_j) of
+qi(1),qi(5):begin cur_l:=rem_byte(main_j); {\.{=:\?}, \.{=:\?>}}
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_byte(main_j); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack=null then {right boundary character is being consumed}
+ begin lig_stack:=new_lig_item(cur_r); bchar:=non_char;
+ end
+ else if is_char_node(lig_stack) then {|link(lig_stack)=null|}
+ begin main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ lig_ptr(lig_stack):=main_p;
+ end
+ else character(lig_stack):=cur_r;
+ end;
+qi(3):begin cur_r:=rem_byte(main_j); {\.{\?=:\?}}
+ main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ link(lig_stack):=main_p;
+ end;
+qi(7),qi(11):begin wrapup(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=tail; cur_l:=rem_byte(main_j);
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_byte(main_j); ligature_present:=true; {\.{=:}}
+ if lig_stack=null then goto main_loop_wrapup
+ else goto main_loop_move+1;
+ end
+endcases;
+if op_byte(main_j)>qi(4) then
+ if op_byte(main_j)<>qi(7) then goto main_loop_wrapup;
+if cur_l<non_char then goto main_lig_loop;
+main_k:=bchar_label[main_f]; goto main_lig_loop+1;
+end
+
+@ The occurrence of blank spaces is almost part of \TeX's inner loop,
+@^inner loop@>
+since we usually encounter about one space for every five non-blank characters.
+Therefore |main_control| gives second-highest priority to ordinary spaces.
+
+When a glue parameter like \.{\\spaceskip} is set to `\.{0pt}', we will
+see to it later that the corresponding glue specification is precisely
+|zero_glue|, not merely a pointer to some specification that happens
+to be full of zeroes. Therefore it is simple to test whether a glue parameter
+is zero or~not.
+
+@<Append a normal inter-word space...@>=
+if space_skip=zero_glue then
+ begin @<Find the glue specification, |main_p|, for
+ text spaces in the current font@>;
+ temp_ptr:=new_glue(main_p);
+ end
+else temp_ptr:=new_param_glue(space_skip_code);
+link(tail):=temp_ptr; tail:=temp_ptr;
+goto big_switch
+
+@ Having |font_glue| allocated for each text font saves both time and memory.
+If any of the three spacing parameters are subsequently changed by the
+use of \.{\\fontdimen}, the |find_font_dimen| procedure deallocates the
+|font_glue| specification allocated here.
+
+@<Find the glue specification...@>=
+begin main_p:=font_glue[cur_font];
+if main_p=null then
+ begin main_p:=new_spec(zero_glue); main_k:=param_base[cur_font]+space_code;
+ width(main_p):=font_info[main_k].sc; {that's |space(cur_font)|}
+ stretch(main_p):=font_info[main_k+1].sc; {and |space_stretch(cur_font)|}
+ shrink(main_p):=font_info[main_k+2].sc; {and |space_shrink(cur_font)|}
+ font_glue[cur_font]:=main_p;
+ end;
+end
+
+@ @<Declare act...@>=
+procedure app_space; {handle spaces when |space_factor<>1000|}
+var@!q:pointer; {glue node}
+begin if (space_factor>=2000)and(xspace_skip<>zero_glue) then
+ q:=new_param_glue(xspace_skip_code)
+else begin if space_skip<>zero_glue then main_p:=space_skip
+ else @<Find the glue specification...@>;
+ main_p:=new_spec(main_p);
+ @<Modify the glue specification in |main_p| according to the space factor@>;
+ q:=new_glue(main_p); glue_ref_count(main_p):=null;
+ end;
+link(tail):=q; tail:=q;
+end;
+
+@ @<Modify the glue specification in |main_p| according to the space factor@>=
+if space_factor>=2000 then width(main_p):=width(main_p)+extra_space(cur_font);
+stretch(main_p):=xn_over_d(stretch(main_p),space_factor,1000);
+shrink(main_p):=xn_over_d(shrink(main_p),1000,space_factor)
+
+@ Whew---that covers the main loop. We can now proceed at a leisurely
+pace through the other combinations of possibilities.
+
+@d any_mode(#)==vmode+#,hmode+#,mmode+# {for mode-independent commands}
+
+@<Cases of |main_control| that are not part of the inner loop@>=
+any_mode(relax),vmode+spacer,mmode+spacer,mmode+no_boundary:do_nothing;
+any_mode(ignore_spaces): begin @<Get the next non-blank non-call...@>;
+ goto reswitch;
+ end;
+vmode+stop: if its_all_over then return; {this is the only way out}
+@t\4@>@<Forbidden cases detected in |main_control|@>@+@,any_mode(mac_param):
+ report_illegal_case;
+@<Math-only cases in non-math modes, or vice versa@>: insert_dollar_sign;
+@t\4@>@<Cases of |main_control| that build boxes and lists@>@;
+@t\4@>@<Cases of |main_control| that don't depend on |mode|@>@;
+@t\4@>@<Cases of |main_control| that are for extensions to \TeX@>@;
+
+@ Here is a list of cases where the user has probably gotten into or out of math
+mode by mistake. \TeX\ will insert a dollar sign and rescan the current token.
+
+@d non_math(#)==vmode+#,hmode+#
+
+@<Math-only cases in non-math modes...@>=
+non_math(sup_mark), non_math(sub_mark), non_math(math_char_num),
+non_math(math_given), non_math(math_comp), non_math(delim_num),
+non_math(left_right), non_math(above), non_math(radical),
+non_math(math_style), non_math(math_choice), non_math(vcenter),
+non_math(non_script), non_math(mkern), non_math(limit_switch),
+non_math(mskip), non_math(math_accent),
+mmode+endv, mmode+par_end, mmode+stop, mmode+vskip, mmode+un_vbox,
+mmode+valign, mmode+hrule
+
+@ @<Declare action...@>=
+procedure insert_dollar_sign;
+begin back_input; cur_tok:=math_shift_token+"$";
+print_err("Missing $ inserted");
+@.Missing \$ inserted@>
+help2("I've inserted a begin-math/end-math symbol since I think")@/
+("you left one out. Proceed, with fingers crossed."); ins_error;
+end;
+
+@ When erroneous situations arise, \TeX\ usually issues an error message
+specific to the particular error. For example, `\.{\\noalign}' should
+not appear in any mode, since it is recognized by the |align_peek| routine
+in all of its legitimate appearances; a special error message is given
+when `\.{\\noalign}' occurs elsewhere. But sometimes the most appropriate
+error message is simply that the user is not allowed to do what he or she
+has attempted. For example, `\.{\\moveleft}' is allowed only in vertical mode,
+and `\.{\\lower}' only in non-vertical modes. Such cases are enumerated
+here and in the other sections referred to under `See also \dots.'
+
+@<Forbidden cases...@>=
+vmode+vmove,hmode+hmove,mmode+hmove,any_mode(last_item),
+
+@ The `|you_cant|' procedure prints a line saying that the current command
+is illegal in the current mode; it identifies these things symbolically.
+
+@<Declare action...@>=
+procedure you_cant;
+begin print_err("You can't use `");
+@.You can't use x in y mode@>
+print_cmd_chr(cur_cmd,cur_chr);
+print("' in "); print_mode(mode);
+end;
+
+@ @<Declare act...@>=
+procedure report_illegal_case;
+begin you_cant;
+help4("Sorry, but I'm not programmed to handle this case;")@/
+("I'll just pretend that you didn't ask for it.")@/
+("If you're in the wrong mode, you might be able to")@/
+("return to the right one by typing `I}' or `I$' or `I\par'.");@/
+error;
+end;
+
+@ Some operations are allowed only in privileged modes, i.e., in cases
+that |mode>0|. The |privileged| function is used to detect violations
+of this rule; it issues an error message and returns |false| if the
+current |mode| is negative.
+
+@<Declare act...@>=
+function privileged:boolean;
+begin if mode>0 then privileged:=true
+else begin report_illegal_case; privileged:=false;
+ end;
+end;
+
+@ Either \.{\\dump} or \.{\\end} will cause |main_control| to enter the
+endgame, since both of them have `|stop|' as their command code.
+
+@<Put each...@>=
+primitive("end",stop,0);@/
+@!@:end_}{\.{\\end} primitive@>
+primitive("dump",stop,1);@/
+@!@:dump_}{\.{\\dump} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+stop:if chr_code=1 then print_esc("dump")@+else print_esc("end");
+
+@ We don't want to leave |main_control| immediately when a |stop| command
+is sensed, because it may be necessary to invoke an \.{\\output} routine
+several times before things really grind to a halt. (The output routine
+might even say `\.{\\gdef\\end\{...\}}', to prolong the life of the job.)
+Therefore |its_all_over| is |true| only when the current page
+and contribution list are empty, and when the last output was not a
+``dead cycle.''
+
+@<Declare act...@>=
+function its_all_over:boolean; {do this when \.{\\end} or \.{\\dump} occurs}
+label exit;
+begin if privileged then
+ begin if (page_head=page_tail)and(head=tail)and(dead_cycles=0) then
+ begin its_all_over:=true; return;
+ end;
+ back_input; {we will try to end again after ejecting residual material}
+ tail_append(new_null_box);
+ width(tail):=hsize;
+ tail_append(new_glue(fill_glue));
+ tail_append(new_penalty(-@'10000000000));@/
+ build_page; {append \.{\\hbox to \\hsize\{\}\\vfill\\penalty-'10000000000}}
+ end;
+its_all_over:=false;
+exit:end;
+
+@* \[47] Building boxes and lists.
+The most important parts of |main_control| are concerned with \TeX's
+chief mission of box-making. We need to control the activities that put
+entries on vlists and hlists, as well as the activities that convert
+those lists into boxes. All of the necessary machinery has already been
+developed; it remains for us to ``push the buttons'' at the right times.
+
+@ As an introduction to these routines, let's consider one of the simplest
+cases: What happens when `\.{\\hrule}' occurs in vertical mode, or
+`\.{\\vrule}' in horizontal mode or math mode? The code in |main_control|
+is short, since the |scan_rule_spec| routine already does most of what is
+required; thus, there is no need for a special action procedure.
+
+Note that baselineskip calculations are disabled after a rule in vertical
+mode, by setting |prev_depth:=ignore_depth|.
+
+@<Cases of |main_control| that build...@>=
+vmode+hrule,hmode+vrule,mmode+vrule: begin tail_append(scan_rule_spec);
+ if abs(mode)=vmode then prev_depth:=ignore_depth
+ else if abs(mode)=hmode then space_factor:=1000;
+ end;
+
+@ The processing of things like \.{\\hskip} and \.{\\vskip} is slightly
+more complicated. But the code in |main_control| is very short, since
+it simply calls on the action routine |append_glue|. Similarly, \.{\\kern}
+activates |append_kern|.
+
+@<Cases of |main_control| that build...@>=
+vmode+vskip,hmode+hskip,mmode+hskip,mmode+mskip: append_glue;
+any_mode(kern),mmode+mkern: append_kern;
+
+@ The |hskip| and |vskip| command codes are used for control sequences
+like \.{\\hss} and \.{\\vfil} as well as for \.{\\hskip} and \.{\\vskip}.
+The difference is in the value of |cur_chr|.
+
+@d fil_code=0 {identifies \.{\\hfil} and \.{\\vfil}}
+@d fill_code=1 {identifies \.{\\hfill} and \.{\\vfill}}
+@d ss_code=2 {identifies \.{\\hss} and \.{\\vss}}
+@d fil_neg_code=3 {identifies \.{\\hfilneg} and \.{\\vfilneg}}
+@d skip_code=4 {identifies \.{\\hskip} and \.{\\vskip}}
+@d mskip_code=5 {identifies \.{\\mskip}}
+
+@<Put each...@>=
+primitive("hskip",hskip,skip_code);@/
+@!@:hskip_}{\.{\\hskip} primitive@>
+primitive("hfil",hskip,fil_code);
+@!@:hfil_}{\.{\\hfil} primitive@>
+primitive("hfill",hskip,fill_code);@/
+@!@:hfill_}{\.{\\hfill} primitive@>
+primitive("hss",hskip,ss_code);
+@!@:hss_}{\.{\\hss} primitive@>
+primitive("hfilneg",hskip,fil_neg_code);@/
+@!@:hfil_neg_}{\.{\\hfilneg} primitive@>
+primitive("vskip",vskip,skip_code);@/
+@!@:vskip_}{\.{\\vskip} primitive@>
+primitive("vfil",vskip,fil_code);
+@!@:vfil_}{\.{\\vfil} primitive@>
+primitive("vfill",vskip,fill_code);@/
+@!@:vfill_}{\.{\\vfill} primitive@>
+primitive("vss",vskip,ss_code);
+@!@:vss_}{\.{\\vss} primitive@>
+primitive("vfilneg",vskip,fil_neg_code);@/
+@!@:vfil_neg_}{\.{\\vfilneg} primitive@>
+primitive("mskip",mskip,mskip_code);@/
+@!@:mskip_}{\.{\\mskip} primitive@>
+primitive("kern",kern,explicit);
+@!@:kern_}{\.{\\kern} primitive@>
+primitive("mkern",mkern,mu_glue);@/
+@!@:mkern_}{\.{\\mkern} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+hskip: case chr_code of
+ skip_code:print_esc("hskip");
+ fil_code:print_esc("hfil");
+ fill_code:print_esc("hfill");
+ ss_code:print_esc("hss");
+ othercases print_esc("hfilneg")
+ endcases;
+vskip: case chr_code of
+ skip_code:print_esc("vskip");
+ fil_code:print_esc("vfil");
+ fill_code:print_esc("vfill");
+ ss_code:print_esc("vss");
+ othercases print_esc("vfilneg")
+ endcases;
+mskip: print_esc("mskip");
+kern: print_esc("kern");
+mkern: print_esc("mkern");
+
+@ All the work relating to glue creation has been relegated to the
+following subroutine. It does not call |build_page|, because it is
+used in at least one place where that would be a mistake.
+
+@<Declare action...@>=
+procedure append_glue;
+var s:small_number; {modifier of skip command}
+begin s:=cur_chr;
+case s of
+fil_code: cur_val:=fil_glue;
+fill_code: cur_val:=fill_glue;
+ss_code: cur_val:=ss_glue;
+fil_neg_code: cur_val:=fil_neg_glue;
+skip_code: scan_glue(glue_val);
+mskip_code: scan_glue(mu_val);
+end; {now |cur_val| points to the glue specification}
+tail_append(new_glue(cur_val));
+if s>=skip_code then
+ begin decr(glue_ref_count(cur_val));
+ if s>skip_code then subtype(tail):=mu_glue;
+ end;
+end;
+
+@ @<Declare act...@>=
+procedure append_kern;
+var s:quarterword; {|subtype| of the kern node}
+begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
+tail_append(new_kern(cur_val)); subtype(tail):=s;
+end;
+
+@ Many of the actions related to box-making are triggered by the appearance
+of braces in the input. For example, when the user says `\.{\\hbox}
+\.{to} \.{100pt\{$\langle\,\hbox{hlist}\,\rangle$\}}' in vertical mode,
+the information about the box size (100pt, |exactly|) is put onto |save_stack|
+with a level boundary word just above it, and |cur_group:=adjusted_hbox_group|;
+\TeX\ enters restricted horizontal mode to process the hlist. The right
+brace eventually causes |save_stack| to be restored to its former state,
+at which time the information about the box size (100pt, |exactly|) is
+available once again; a box is packaged and we leave restricted horizontal
+mode, appending the new box to the current list of the enclosing mode
+(in this case to the current list of vertical mode), followed by any
+vertical adjustments that were removed from the box by |hpack|.
+
+The next few sections of the program are therefore concerned with the
+treatment of left and right curly braces.
+
+@ If a left brace occurs in the middle of a page or paragraph, it simply
+introduces a new level of grouping, and the matching right brace will not have
+such a drastic effect. Such grouping affects neither the mode nor the
+current list.
+
+@<Cases of |main_control| that build...@>=
+non_math(left_brace): new_save_level(simple_group);
+any_mode(begin_group): new_save_level(semi_simple_group);
+any_mode(end_group): if cur_group=semi_simple_group then unsave
+ else off_save;
+
+@ We have to deal with errors in which braces and such things are not
+properly nested. Sometimes the user makes an error of commission by
+inserting an extra symbol, but sometimes the user makes an error of omission.
+\TeX\ can't always tell one from the other, so it makes a guess and tries
+to avoid getting into a loop.
+
+The |off_save| routine is called when the current group code is wrong. It tries
+to insert something into the user's input that will help clean off
+the top level.
+
+@<Declare act...@>=
+procedure off_save;
+var p:pointer; {inserted token}
+begin if cur_group=bottom_level then
+ @<Drop current token and complain that it was unmatched@>
+else begin back_input; p:=get_avail; link(temp_head):=p;
+ print_err("Missing ");
+ @<Prepare to insert a token that matches |cur_group|,
+ and print what it is@>;
+ print(" inserted"); ins_list(link(temp_head));
+ help5("I've inserted something that you may have forgotten.")@/
+ ("(See the <inserted text> above.)")@/
+ ("With luck, this will get me unwedged. But if you")@/
+ ("really didn't forget anything, try typing `2' now; then")@/
+ ("my insertion and my current dilemma will both disappear.");
+ error;
+ end;
+end;
+
+@ At this point, |link(temp_head)=p|, a pointer to an empty one-word node.
+
+@<Prepare to insert a token that matches |cur_group|...@>=
+case cur_group of
+semi_simple_group: begin info(p):=cs_token_flag+frozen_end_group;
+ print_esc("endgroup");
+@.Missing \\endgroup inserted@>
+ end;
+math_shift_group: begin info(p):=math_shift_token+"$"; print_char("$");
+@.Missing \$ inserted@>
+ end;
+math_left_group: begin info(p):=cs_token_flag+frozen_right; link(p):=get_avail;
+ p:=link(p); info(p):=other_token+"."; print_esc("right.");
+@.Missing \\right\hbox{.} inserted@>
+@^null delimiter@>
+ end;
+othercases begin info(p):=right_brace_token+"}"; print_char("}");
+@.Missing \} inserted@>
+ end
+endcases
+
+@ @<Drop current token and complain that it was unmatched@>=
+begin print_err("Extra "); print_cmd_chr(cur_cmd,cur_chr);
+@.Extra x@>
+help1("Things are pretty mixed up, but I think the worst is over.");@/
+error;
+end
+
+@ The routine for a |right_brace| character branches into many subcases,
+since a variety of things may happen, depending on |cur_group|. Some
+types of groups are not supposed to be ended by a right brace; error
+messages are given in hopes of pinpointing the problem. Most branches
+of this routine will be filled in later, when we are ready to understand
+them; meanwhile, we must prepare ourselves to deal with such errors.
+
+@<Cases of |main_control| that build...@>=
+any_mode(right_brace): handle_right_brace;
+
+@ @<Declare the procedure called |handle_right_brace|@>=
+procedure handle_right_brace;
+var p,@!q:pointer; {for short-term use}
+@!d:scaled; {holds |split_max_depth| in |insert_group|}
+@!f:integer; {holds |floating_penalty| in |insert_group|}
+begin case cur_group of
+simple_group: unsave;
+bottom_level: begin print_err("Too many }'s");
+@.Too many \}'s@>
+ help2("You've closed more groups than you opened.")@/
+ ("Such booboos are generally harmless, so keep going."); error;
+ end;
+semi_simple_group,math_shift_group,math_left_group: extra_right_brace;
+@t\4@>@<Cases of |handle_right_brace| where a |right_brace| triggers
+ a delayed action@>@;
+othercases confusion("rightbrace")
+@:this can't happen rightbrace}{\quad rightbrace@>
+endcases;
+end;
+
+@ @<Declare act...@>=
+procedure extra_right_brace;
+begin print_err("Extra }, or forgotten ");
+@.Extra \}, or forgotten x@>
+case cur_group of
+semi_simple_group: print_esc("endgroup");
+math_shift_group: print_char("$");
+math_left_group: print_esc("right");
+end;@/
+help5("I've deleted a group-closing symbol because it seems to be")@/
+("spurious, as in `$x}$'. But perhaps the } is legitimate and")@/
+("you forgot something else, as in `\hbox{$x}'. In such cases")@/
+("the way to recover is to insert both the forgotten and the")@/
+("deleted material, e.g., by typing `I$}'."); error;
+incr(align_state);
+end;
+
+@ Here is where we clear the parameters that are supposed to revert to their
+default values after every paragraph and when internal vertical mode is entered.
+
+@<Declare act...@>=
+procedure normal_paragraph;
+begin if looseness<>0 then eq_word_define(int_base+looseness_code,0);
+if hang_indent<>0 then eq_word_define(dimen_base+hang_indent_code,0);
+if hang_after<>1 then eq_word_define(int_base+hang_after_code,1);
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+end;
+
+@ Now let's turn to the question of how \.{\\hbox} is treated. We actually
+need to consider also a slightly larger context, since constructions like
+`\.{\\setbox3=}\penalty0\.{\\hbox...}' and
+`\.{\\leaders}\penalty0\.{\\hbox...}' and
+`\.{\\lower3.8pt\\hbox...}'
+are supposed to invoke quite
+different actions after the box has been packaged. Conversely,
+constructions like `\.{\\setbox3=}' can be followed by a variety of
+different kinds of boxes, and we would like to encode such things in an
+efficient way.
+
+In other words, there are two problems: To represent the context of a box,
+and to represent its type.
+
+The first problem is solved by putting a ``context code'' on the |save_stack|,
+just below the two entries that give the dimensions produced by |scan_spec|.
+The context code is either a (signed) shift amount, or it is a large
+integer |>=box_flag|, where |box_flag=@t$2^{30}$@>|. Codes |box_flag| through
+|box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}';
+codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox255}';
+code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513|
+through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}',
+and `\.{\\xleaders}'.
+
+The second problem is solved by giving the command code |make_box| to all
+control sequences that produce a box, and by using the following |chr_code|
+values to distinguish between them: |box_code|, |copy_code|, |last_box_code|,
+|vsplit_code|, |vtop_code|, |vtop_code+vmode|, and |vtop_code+hmode|,
+where the latter two are used denote \.{\\vbox} and \.{\\hbox}, respectively.
+
+@d box_flag==@'10000000000 {context code for `\.{\\setbox0}'}
+@d ship_out_flag==box_flag+512 {context code for `\.{\\shipout}'}
+@d leader_flag==box_flag+513 {context code for `\.{\\leaders}'}
+@d box_code=0 {|chr_code| for `\.{\\box}'}
+@d copy_code=1 {|chr_code| for `\.{\\copy}'}
+@d last_box_code=2 {|chr_code| for `\.{\\lastbox}'}
+@d vsplit_code=3 {|chr_code| for `\.{\\vsplit}'}
+@d vtop_code=4 {|chr_code| for `\.{\\vtop}'}
+
+@<Put each...@>=
+primitive("moveleft",hmove,1);
+@!@:move_left_}{\.{\\moveleft} primitive@>
+primitive("moveright",hmove,0);@/
+@!@:move_right_}{\.{\\moveright} primitive@>
+primitive("raise",vmove,1);
+@!@:raise_}{\.{\\raise} primitive@>
+primitive("lower",vmove,0);
+@!@:lower_}{\.{\\lower} primitive@>
+@#
+primitive("box",make_box,box_code);
+@!@:box_}{\.{\\box} primitive@>
+primitive("copy",make_box,copy_code);
+@!@:copy_}{\.{\\copy} primitive@>
+primitive("lastbox",make_box,last_box_code);
+@!@:last_box_}{\.{\\lastbox} primitive@>
+primitive("vsplit",make_box,vsplit_code);
+@!@:vsplit_}{\.{\\vsplit} primitive@>
+primitive("vtop",make_box,vtop_code);@/
+@!@:vtop_}{\.{\\vtop} primitive@>
+primitive("vbox",make_box,vtop_code+vmode);
+@!@:vbox_}{\.{\\vbox} primitive@>
+primitive("hbox",make_box,vtop_code+hmode);@/
+@!@:hbox_}{\.{\\hbox} primitive@>
+primitive("shipout",leader_ship,a_leaders-1); {|ship_out_flag=leader_flag-1|}
+@!@:ship_out_}{\.{\\shipout} primitive@>
+primitive("leaders",leader_ship,a_leaders);
+@!@:leaders_}{\.{\\leaders} primitive@>
+primitive("cleaders",leader_ship,c_leaders);
+@!@:c_leaders_}{\.{\\cleaders} primitive@>
+primitive("xleaders",leader_ship,x_leaders);
+@!@:x_leaders_}{\.{\\xleaders} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+hmove: if chr_code=1 then print_esc("moveleft")@+else print_esc("moveright");
+vmove: if chr_code=1 then print_esc("raise")@+else print_esc("lower");
+make_box: case chr_code of
+ box_code: print_esc("box");
+ copy_code: print_esc("copy");
+ last_box_code: print_esc("lastbox");
+ vsplit_code: print_esc("vsplit");
+ vtop_code: print_esc("vtop");
+ vtop_code+vmode: print_esc("vbox");
+ othercases print_esc("hbox")
+ endcases;
+leader_ship: if chr_code=a_leaders then print_esc("leaders")
+ else if chr_code=c_leaders then print_esc("cleaders")
+ else if chr_code=x_leaders then print_esc("xleaders")
+ else print_esc("shipout");
+
+@ Constructions that require a box are started by calling |scan_box| with
+a specified context code. The |scan_box| routine verifies
+that a |make_box| command comes next and then it calls |begin_box|.
+
+@<Cases of |main_control| that build...@>=
+vmode+hmove,hmode+vmove,mmode+vmove: begin t:=cur_chr;
+ scan_normal_dimen;
+ if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
+ end;
+any_mode(leader_ship): scan_box(leader_flag-a_leaders+cur_chr);
+any_mode(make_box): begin_box(0);
+
+@ The global variable |cur_box| will point to a newly-made box. If the box
+is void, we will have |cur_box=null|. Otherwise we will have
+|type(cur_box)=hlist_node| or |vlist_node| or |rule_node|; the |rule_node|
+case can occur only with leaders.
+
+@<Glob...@>=
+@!cur_box:pointer; {box to be placed into its context}
+
+@ The |box_end| procedure does the right thing with |cur_box|, if
+|box_context| represents the context as explained above.
+
+@<Declare act...@>=
+procedure box_end(@!box_context:integer);
+var p:pointer; {|ord_noad| for new box in math mode}
+begin if box_context<box_flag then @<Append box |cur_box| to the current list,
+ shifted by |box_context|@>
+else if box_context<ship_out_flag then @<Store \(c)|cur_box| in a box register@>
+else if cur_box<>null then
+ if box_context>ship_out_flag then @<Append a new leader node that
+ uses |cur_box|@>
+ else ship_out(cur_box);
+end;
+
+@ The global variable |adjust_tail| will be non-null if and only if the
+current box might include adjustments that should be appended to the
+current vertical list.
+
+@<Append box |cur_box| to the current...@>=
+begin if cur_box<>null then
+ begin shift_amount(cur_box):=box_context;
+ if abs(mode)=vmode then
+ begin append_to_vlist(cur_box);
+ if adjust_tail<>null then
+ begin if adjust_head<>adjust_tail then
+ begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ end;
+ adjust_tail:=null;
+ end;
+ if mode>0 then build_page;
+ end
+ else begin if abs(mode)=hmode then space_factor:=1000
+ else begin p:=new_noad;
+ math_type(nucleus(p)):=sub_box;
+ info(nucleus(p)):=cur_box; cur_box:=p;
+ end;
+ link(tail):=cur_box; tail:=cur_box;
+ end;
+ end;
+end
+
+@ @<Store \(c)|cur_box| in a box register@>=
+if box_context<box_flag+256 then
+ eq_define(box_base-box_flag+box_context,box_ref,cur_box)
+else geq_define(box_base-box_flag-256+box_context,box_ref,cur_box)
+
+@ @<Append a new leader node ...@>=
+begin @<Get the next non-blank non-relax...@>;
+if ((cur_cmd=hskip)and(abs(mode)<>vmode))or@|
+ ((cur_cmd=vskip)and(abs(mode)=vmode))or@|
+ ((cur_cmd=mskip)and(abs(mode)=mmode)) then
+ begin append_glue; subtype(tail):=box_context-(leader_flag-a_leaders);
+ leader_ptr(tail):=cur_box;
+ end
+else begin print_err("Leaders not followed by proper glue");
+@.Leaders not followed by...@>
+ help3("You should say `\leaders <box or rule><hskip or vskip>'.")@/
+ ("I found the <box or rule>, but there's no suitable")@/
+ ("<hskip or vskip>, so I'm ignoring these leaders."); back_error;
+ flush_node_list(cur_box);
+ end;
+end
+
+@ Now that we can see what eventually happens to boxes, we can consider
+the first steps in their creation. The |begin_box| routine is called when
+|box_context| is a context specification, |cur_chr| specifies the type of
+box desired, and |cur_cmd=make_box|.
+
+@<Declare act...@>=
+procedure begin_box(@!box_context:integer);
+label exit, done;
+var @!p,@!q:pointer; {run through the current list}
+@!m:quarterword; {the length of a replacement list}
+@!k:halfword; {0 or |vmode| or |hmode|}
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
+ box(cur_val):=null; {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
+ end;
+last_box_code: @<If the current list ends with a box node, delete it from
+ the list and make |cur_box| point to it; otherwise set |cur_box:=null|@>;
+vsplit_code: @<Split off part of a vertical box, make |cur_box| point to it@>;
+othercases @<Initiate the construction of an hbox or vbox, then |return|@>
+endcases;@/
+box_end(box_context); {in simple cases, we use the box immediately}
+exit:end;
+
+@ Note that the condition |not is_char_node(tail)| implies that |head<>tail|,
+since |head| is a one-word node.
+
+@<If the current list ends with a box node, delete it...@>=
+begin cur_box:=null;
+if abs(mode)=mmode then
+ begin you_cant; help1("Sorry; this \lastbox will be void."); error;
+ end
+else if (mode=vmode)and(head=tail) then
+ begin you_cant;
+ help2("Sorry...I usually can't take things from the current page.")@/
+ ("This \lastbox will therefore be void."); error;
+ end
+else begin if not is_char_node(tail) then
+ if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+ @<Remove the last box, unless it's part of a discretionary@>;
+ end;
+end
+
+@ @<Remove the last box...@>=
+begin q:=head;
+repeat p:=q;
+if not is_char_node(q) then if type(q)=disc_node then
+ begin for m:=1 to replace_count(q) do p:=link(p);
+ if p=tail then goto done;
+ end;
+q:=link(p);
+until q=tail;
+cur_box:=tail; shift_amount(cur_box):=0;
+tail:=p; link(p):=null;
+done:end
+
+@ Here we deal with things like `\.{\\vsplit 13 to 100pt}'.
+
+@<Split off part of a vertical box, make |cur_box| point to it@>=
+begin scan_eight_bit_int; n:=cur_val;
+if not scan_keyword("to") then
+@.to@>
+ begin print_err("Missing `to' inserted");
+@.Missing `to' inserted@>
+ help2("I'm working on `\vsplit<box number> to <dimen>';")@/
+ ("will look for the <dimen> next."); error;
+ end;
+scan_normal_dimen;
+cur_box:=vsplit(n,cur_val);
+end
+
+@ Here is where we enter restricted horizontal mode or internal vertical
+mode, in order to make a box.
+
+@<Initiate the construction of an hbox or vbox, then |return|@>=
+begin k:=cur_chr-vtop_code; saved(0):=box_context;
+if k=hmode then
+ if (box_context<box_flag)and(abs(mode)=vmode) then
+ scan_spec(adjusted_hbox_group,true)
+ else scan_spec(hbox_group,true)
+else begin if k=vmode then scan_spec(vbox_group,true)
+ else begin scan_spec(vtop_group,true); k:=vmode;
+ end;
+ normal_paragraph;
+ end;
+push_nest; mode:=-k;
+if k=vmode then
+ begin prev_depth:=ignore_depth;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ end
+else begin space_factor:=1000;
+ if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+ end;
+return;
+end
+
+@ @<Declare act...@>=
+procedure scan_box(@!box_context:integer);
+ {the next input should specify a box or perhaps a rule}
+begin @<Get the next non-blank non-relax...@>;
+if cur_cmd=make_box then begin_box(box_context)
+else if (box_context>=leader_flag)and((cur_cmd=hrule)or(cur_cmd=vrule)) then
+ begin cur_box:=scan_rule_spec; box_end(box_context);
+ end
+else begin@t@>@;@/
+ print_err("A <box> was supposed to be here");@/
+@.A <box> was supposed to...@>
+ help3("I was expecting to see \hbox or \vbox or \copy or \box or")@/
+ ("something like that. So you might find something missing in")@/
+ ("your output. But keep trying; you can fix this later."); back_error;
+ end;
+end;
+
+@ When the right brace occurs at the end of an \.{\\hbox} or \.{\\vbox} or
+\.{\\vtop} construction, the |package| routine comes into action. We might
+also have to finish a paragraph that hasn't ended.
+
+@<Cases of |handle...@>=
+hbox_group: package(0);
+adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0);
+ end;
+vbox_group: begin end_graf; package(0);
+ end;
+vtop_group: begin end_graf; package(vtop_code);
+ end;
+
+@ @<Declare action...@>=
+procedure package(@!c:small_number);
+var h:scaled; {height of box}
+@!p:pointer; {first node in a box}
+@!d:scaled; {max depth}
+begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3;
+if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
+else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
+ if c=vtop_code then @<Readjust the height and depth of |cur_box|,
+ for \.{\\vtop}@>;
+ end;
+pop_nest; box_end(saved(0));
+end;
+
+@ The height of a `\.{\\vtop}' box is inherited from the first item on its list,
+if that item is an |hlist_node|, |vlist_node|, or |rule_node|; otherwise
+the \.{\\vtop} height is zero.
+
+
+@<Readjust the height...@>=
+begin h:=0; p:=list_ptr(cur_box);
+if p<>null then if type(p)<=rule_node then h:=height(p);
+depth(cur_box):=depth(cur_box)-h+height(cur_box); height(cur_box):=h;
+end
+
+@ A paragraph begins when horizontal-mode material occurs in vertical mode,
+or when the paragraph is explicitly started by `\.{\\indent}' or
+`\.{\\noindent}'.
+
+@<Put each...@>=
+primitive("indent",start_par,1);
+@!@:indent_}{\.{\\indent} primitive@>
+primitive("noindent",start_par,0);
+@!@:no_indent_}{\.{\\noindent} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+start_par: if chr_code=0 then print_esc("noindent")@+ else print_esc("indent");
+
+@ @<Cases of |main_control| that build...@>=
+vmode+start_par: new_graf(cur_chr>0);
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+ vmode+math_shift,vmode+un_hbox,vmode+vrule,
+ vmode+accent,vmode+discretionary,vmode+hskip,vmode+valign,
+ vmode+ex_space,vmode+no_boundary:@t@>@;@/
+ begin back_input; new_graf(true);
+ end;
+
+@ @<Declare act...@>=
+function norm_min(@!h:integer):small_number;
+begin if h<=0 then norm_min:=1@+else if h>=63 then norm_min:=63@+
+else norm_min:=h;
+end;
+@#
+procedure new_graf(@!indented:boolean);
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ end;
+if every_par<>null then begin_token_list(every_par,every_par_text);
+if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
+end;
+
+@ @<Cases of |main_control| that build...@>=
+hmode+start_par,mmode+start_par: indent_in_hmode;
+
+@ @<Declare act...@>=
+procedure indent_in_hmode;
+var p,@!q:pointer;
+begin if cur_chr>0 then {\.{\\indent}}
+ begin p:=new_null_box; width(p):=par_indent;
+ if abs(mode)=hmode then space_factor:=1000
+ else begin q:=new_noad; math_type(nucleus(q)):=sub_box;
+ info(nucleus(q)):=p; p:=q;
+ end;
+ tail_append(p);
+ end;
+end;
+
+@ A paragraph ends when a |par_end| command is sensed, or when we are in
+horizontal mode when reaching the right brace of vertical-mode routines
+like \.{\\vbox}, \.{\\insert}, or \.{\\output}.
+
+@<Cases of |main_control| that build...@>=
+vmode+par_end: begin normal_paragraph;
+ if mode>0 then build_page;
+ end;
+hmode+par_end: begin if align_state<0 then off_save; {this tries to
+ recover from an alignment that didn't end properly}
+ end_graf; {this takes us to the enclosing mode, if |mode>0|}
+ if mode=vmode then build_page;
+ end;
+hmode+stop,hmode+vskip,hmode+hrule,hmode+un_vbox,hmode+halign: head_for_vmode;
+
+@ @<Declare act...@>=
+procedure head_for_vmode;
+begin if mode<0 then
+ if cur_cmd<>hrule then off_save
+ else begin print_err("You can't use `");
+ print_esc("hrule"); print("' here except with leaders");
+@.You can't use \\hrule...@>
+ help2("To put a horizontal rule in an hbox or an alignment,")@/
+ ("you should use \leaders or \hrulefill (see The TeXbook).");
+ error;
+ end
+else begin back_input; cur_tok:=par_token; back_input; token_type:=inserted;
+ end;
+end;
+
+@ @<Declare act...@>=
+procedure end_graf;
+begin if mode=hmode then
+ begin if head=tail then pop_nest {null paragraphs are ignored}
+ else line_break(widow_penalty);
+ normal_paragraph;
+ error_count:=0;
+ end;
+end;
+
+@ Insertion and adjustment and mark nodes are constructed by the following
+pieces of the program.
+
+@<Cases of |main_control| that build...@>=
+any_mode(insert),hmode+vadjust,mmode+vadjust: begin_insert_or_adjust;
+any_mode(mark): make_mark;
+
+@ @<Forbidden...@>=
+vmode+vadjust,
+
+@ @<Declare act...@>=
+procedure begin_insert_or_adjust;
+begin if cur_cmd=vadjust then cur_val:=255
+else begin scan_eight_bit_int;
+ if cur_val=255 then
+ begin print_err("You can't "); print_esc("insert"); print_int(255);
+@.You can't \\insert255@>
+ help1("I'm changing to \insert0; box 255 is special.");
+ error; cur_val:=0;
+ end;
+ end;
+saved(0):=cur_val; incr(save_ptr);
+new_save_level(insert_group); scan_left_brace; normal_paragraph;
+push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+end;
+
+@ @<Cases of |handle...@>=
+insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q);
+ d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr);
+ {now |saved(0)| is the insertion number, or 255 for |vadjust|}
+ p:=vpack(link(head),natural); pop_nest;
+ if saved(0)<255 then
+ begin tail_append(get_node(ins_node_size));
+ type(tail):=ins_node; subtype(tail):=qi(saved(0));
+ height(tail):=height(p)+depth(p); ins_ptr(tail):=list_ptr(p);
+ split_top_ptr(tail):=q; depth(tail):=d; float_cost(tail):=f;
+ end
+ else begin tail_append(get_node(small_node_size));
+ type(tail):=adjust_node;@/
+ subtype(tail):=0; {the |subtype| is not used}
+ adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q);
+ end;
+ free_node(p,box_node_size);
+ if nest_ptr=0 then build_page;
+ end;
+output_group: @<Resume the page builder...@>;
+
+@ @<Declare act...@>=
+procedure make_mark;
+var p:pointer; {new node}
+begin p:=scan_toks(false,true); p:=get_node(small_node_size);
+type(p):=mark_node; subtype(p):=0; {the |subtype| is not used}
+mark_ptr(p):=def_ref; link(tail):=p; tail:=p;
+end;
+
+@ Penalty nodes get into a list via the |break_penalty| command.
+@^penalties@>
+
+@<Cases of |main_control| that build...@>=
+any_mode(break_penalty): append_penalty;
+
+@ @<Declare action...@>=
+procedure append_penalty;
+begin scan_int; tail_append(new_penalty(cur_val));
+if mode=vmode then build_page;
+end;
+
+@ The |remove_item| command removes a penalty, kern, or glue node if it
+appears at the tail of the current list, using a brute-force linear scan.
+Like \.{\\lastbox}, this command is not allowed in vertical mode (except
+internal vertical mode), since the current list in vertical mode is sent
+to the page builder. But if we happen to be able to implement it in
+vertical mode, we do.
+
+@<Cases of |main_control| that build...@>=
+any_mode(remove_item): delete_last;
+
+@ When |delete_last| is called, |cur_chr| is the |type| of node that
+will be deleted, if present.
+
+@<Declare action...@>=
+procedure delete_last;
+label exit;
+var @!p,@!q:pointer; {run through the current list}
+@!m:quarterword; {the length of a replacement list}
+begin if (mode=vmode)and(tail=head) then
+ @<Apologize for inability to do the operation now,
+ unless \.{\\unskip} follows non-glue@>
+else begin if not is_char_node(tail) then if type(tail)=cur_chr then
+ begin q:=head;
+ repeat p:=q;
+ if not is_char_node(q) then if type(q)=disc_node then
+ begin for m:=1 to replace_count(q) do p:=link(p);
+ if p=tail then return;
+ end;
+ q:=link(p);
+ until q=tail;
+ link(p):=null; flush_node_list(tail); tail:=p;
+ end;
+ end;
+exit:end;
+
+@ @<Apologize for inability to do the operation...@>=
+begin if (cur_chr<>glue_node)or(last_glue<>max_halfword) then
+ begin you_cant;
+ help2("Sorry...I usually can't take things from the current page.")@/
+ ("Try `I\vskip-\lastskip' instead.");
+ if cur_chr=kern_node then help_line[0]:=
+ ("Try `I\kern-\lastkern' instead.")
+ else if cur_chr<>glue_node then help_line[0]:=@|
+ ("Perhaps you can make the output routine do it.");
+ error;
+ end;
+end
+
+@ @<Put each...@>=
+primitive("unpenalty",remove_item,penalty_node);@/
+@!@:un_penalty_}{\.{\\unpenalty} primitive@>
+primitive("unkern",remove_item,kern_node);@/
+@!@:un_kern_}{\.{\\unkern} primitive@>
+primitive("unskip",remove_item,glue_node);@/
+@!@:un_skip_}{\.{\\unskip} primitive@>
+primitive("unhbox",un_hbox,box_code);@/
+@!@:un_hbox_}{\.{\\unhbox} primitive@>
+primitive("unhcopy",un_hbox,copy_code);@/
+@!@:un_hcopy_}{\.{\\unhcopy} primitive@>
+primitive("unvbox",un_vbox,box_code);@/
+@!@:un_vbox_}{\.{\\unvbox} primitive@>
+primitive("unvcopy",un_vbox,copy_code);@/
+@!@:un_vcopy_}{\.{\\unvcopy} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+remove_item: if chr_code=glue_node then print_esc("unskip")
+ else if chr_code=kern_node then print_esc("unkern")
+ else print_esc("unpenalty");
+un_hbox: if chr_code=copy_code then print_esc("unhcopy")
+ else print_esc("unhbox");
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+ else print_esc("unvbox");
+
+@ The |un_hbox| and |un_vbox| commands unwrap one of the 256 current boxes.
+
+@<Cases of |main_control| that build...@>=
+vmode+un_vbox,hmode+un_hbox,mmode+un_hbox: unpackage;
+
+@ @<Declare act...@>=
+procedure unpackage;
+label exit;
+var p:pointer; {the box}
+@!c:box_code..copy_code; {should we copy?}
+begin c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
+if p=null then return;
+if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@|
+ ((abs(mode)=hmode)and(type(p)<>hlist_node)) then
+ begin print_err("Incompatible list can't be unboxed");
+@.Incompatible list...@>
+ help3("Sorry, Pandora. (You sneaky devil.)")@/
+ ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/
+ ("And I can't open any boxes in math mode.");@/
+ error; return;
+ end;
+if c=copy_code then link(tail):=copy_node_list(list_ptr(p))
+else begin link(tail):=list_ptr(p); box(cur_val):=null;
+ free_node(p,box_node_size);
+ end;
+while link(tail)<>null do tail:=link(tail);
+exit:end;
+
+@ @<Forbidden...@>=vmode+ital_corr,
+
+@ Italic corrections are converted to kern nodes when the |ital_corr| command
+follows a character. In math mode the same effect is achieved by appending
+a kern of zero here, since italic corrections are supplied later.
+
+@<Cases of |main_control| that build...@>=
+hmode+ital_corr: append_italic_correction;
+mmode+ital_corr: tail_append(new_kern(0));
+
+@ @<Declare act...@>=
+procedure append_italic_correction;
+label exit;
+var p:pointer; {|char_node| at the tail of the current list}
+@!f:internal_font_number; {the font in the |char_node|}
+begin if tail<>head then
+ begin if is_char_node(tail) then p:=tail
+ else if type(tail)=ligature_node then p:=lig_char(tail)
+ else return;
+ f:=font(p);
+ tail_append(new_kern(char_italic(f)(char_info(f)(character(p)))));
+ subtype(tail):=explicit;
+ end;
+exit:end;
+
+@ Discretionary nodes are easy in the common case `\.{\\-}', but in the
+general case we must process three braces full of items.
+
+@<Put each...@>=
+primitive("-",discretionary,1);
+@!@:Single-character primitives -}{\quad\.{\\-}@>
+primitive("discretionary",discretionary,0);
+@!@:discretionary_}{\.{\\discretionary} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+discretionary: if chr_code=1 then
+ print_esc("-")@+else print_esc("discretionary");
+
+@ @<Cases of |main_control| that build...@>=
+hmode+discretionary,mmode+discretionary: append_discretionary;
+
+@ The space factor does not change when we append a discretionary node,
+but it starts out as 1000 in the subsidiary lists.
+
+@<Declare act...@>=
+procedure append_discretionary;
+var c:integer; {hyphen character}
+begin tail_append(new_disc);
+if cur_chr=1 then
+ begin c:=hyphen_char[cur_font];
+ if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c);
+ end
+else begin incr(save_ptr); saved(-1):=0; new_save_level(disc_group);
+ scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
+ end;
+end;
+
+@ The three discretionary lists are constructed somewhat as if they were
+hboxes. A~subroutine called |build_discretionary| handles the transitions.
+(This is sort of fun.)
+
+@<Cases of |handle...@>=
+disc_group: build_discretionary;
+
+@ @<Declare act...@>=
+procedure build_discretionary;
+label done,exit;
+var p,@!q:pointer; {for link manipulation}
+@!n:integer; {length of discretionary list}
+begin unsave;
+@<Prune the current list, if necessary, until it contains only
+ |char_node|, |kern_node|, |hlist_node|, |vlist_node|, |rule_node|,
+ and |ligature_node| items; set |n| to the length of the list,
+ and set |q| to the list's tail@>;
+p:=link(head); pop_nest;
+case saved(-1) of
+0:pre_break(tail):=p;
+1:post_break(tail):=p;
+2:@<Attach list |p| to the current list, and record its length;
+ then finish up and |return|@>;
+end; {there are no other cases}
+incr(saved(-1)); new_save_level(disc_group); scan_left_brace;
+push_nest; mode:=-hmode; space_factor:=1000;
+exit:end;
+
+@ @<Attach list |p| to the current...@>=
+begin if (n>0)and(abs(mode)=mmode) then
+ begin print_err("Illegal math "); print_esc("discretionary");
+@.Illegal math \\disc...@>
+ help2("Sorry: The third part of a discretionary break must be")@/
+ ("empty, in math formulas. I had to delete your third part.");
+ flush_node_list(p); n:=0; error;
+ end
+else link(tail):=p;
+if n<=max_quarterword then replace_count(tail):=n
+else begin print_err("Discretionary list is too long");
+@.Discretionary list is too long@>
+ help2("Wow---I never thought anybody would tweak me here.")@/
+ ("You can't seriously need such a huge discretionary list?");
+ error;
+ end;
+if n>0 then tail:=q;
+decr(save_ptr); return;
+end
+
+@ During this loop, |p=link(q)| and there are |n| items preceding |p|.
+
+@<Prune the current list, if necessary...@>=
+q:=head; p:=link(q); n:=0;
+while p<>null do
+ begin if not is_char_node(p) then if type(p)>rule_node then
+ if type(p)<>kern_node then if type(p)<>ligature_node then
+ begin print_err("Improper discretionary list");
+@.Improper discretionary list@>
+ help1("Discretionary lists must contain only boxes and kerns.");@/
+ error;
+ begin_diagnostic;
+ print_nl("The following discretionary sublist has been deleted:");
+@.The following...deleted@>
+ show_box(p);
+ end_diagnostic(true);
+ flush_node_list(p); link(q):=null; goto done;
+ end;
+ q:=p; p:=link(q); incr(n);
+ end;
+done:
+
+@ We need only one more thing to complete the horizontal mode routines, namely
+the \.{\\accent} primitive.
+
+@<Cases of |main_control| that build...@>=
+hmode+accent: make_accent;
+
+@ The positioning of accents is straightforward but tedious. Given an accent
+of width |a|, designed for characters of height |x| and slant |s|;
+and given a character of width |w|, height |h|, and slant |t|: We will shift
+the accent down by |x-h|, and we will insert kern nodes that have the effect of
+centering the accent over the character and shifting the accent to the
+right by $\delta={1\over2}(w-a)+h\cdot t-x\cdot s$. If either character is
+absent from the font, we will simply use the other, without shifting.
+
+@<Declare act...@>=
+procedure make_accent;
+var s,@!t: real; {amount of slant}
+@!p,@!q,@!r:pointer; {character, box, and kern nodes}
+@!f:internal_font_number; {relevant font}
+@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above}
+@!i:four_quarters; {character information}
+begin scan_char_num; f:=cur_font; p:=new_character(f,cur_val);
+if p<>null then
+ begin x:=x_height(f); s:=slant(f)/float_constant(65536);
+@^real division@>
+ a:=char_width(f)(char_info(f)(character(p)));@/
+ do_assignments;@/
+ @<Create a character node |q| for the next character,
+ but set |q:=null| if problems arise@>;
+ if q<>null then @<Append the accent with appropriate kerns,
+ then set |p:=q|@>;
+ link(tail):=p; tail:=p; space_factor:=1000;
+ end;
+end;
+
+@ @<Create a character node |q| for the next...@>=
+q:=null; f:=cur_font;
+if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
+ q:=new_character(f,cur_chr)
+else if cur_cmd=char_num then
+ begin scan_char_num; q:=new_character(f,cur_val);
+ end
+else back_input
+
+@ The kern nodes appended here must be distinguished from other kerns, lest
+they be wiped away by the hyphenation algorithm or by a previous line break.
+
+The two kerns are computed with (machine-dependent) |real| arithmetic, but
+their sum is machine-independent; the net effect is machine-independent,
+because the user cannot remove these nodes nor access them via \.{\\lastkern}.
+
+@<Append the accent with appropriate kerns...@>=
+begin t:=slant(f)/float_constant(65536);
+@^real division@>
+i:=char_info(f)(character(q));
+w:=char_width(f)(i); h:=char_height(f)(height_depth(i));
+if h<>x then {the accent must be shifted up or down}
+ begin p:=hpack(p,natural); shift_amount(p):=x-h;
+ end;
+delta:=round((w-a)/float_constant(2)+h*t-x*s);
+@^real multiplication@>
+@^real addition@>
+r:=new_kern(delta); subtype(r):=acc_kern; link(tail):=r; link(r):=p;
+tail:=new_kern(-a-delta); subtype(tail):=acc_kern; link(p):=tail; p:=q;
+end
+
+@ When `\.{\\cr}' or `\.{\\span}' or a tab mark comes through the scanner
+into |main_control|, it might be that the user has foolishly inserted
+one of them into something that has nothing to do with alignment. But it is
+far more likely that a left brace or right brace has been omitted, since
+|get_next| takes actions appropriate to alignment only when `\.{\\cr}'
+or `\.{\\span}' or tab marks occur with |align_state=0|. The following
+program attempts to make an appropriate recovery.
+
+@<Cases of |main_control| that build...@>=
+any_mode(car_ret), any_mode(tab_mark): align_error;
+any_mode(no_align): no_align_error;
+any_mode(omit): omit_error;
+
+@ @<Declare act...@>=
+procedure align_error;
+begin if abs(align_state)>2 then
+ @<Express consternation over the fact that no alignment is in progress@>
+else begin back_input;
+ if align_state<0 then
+ begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+ incr(align_state); cur_tok:=left_brace_token+"{";
+ end
+ else begin print_err("Missing } inserted");
+@.Missing \} inserted@>
+ decr(align_state); cur_tok:=right_brace_token+"}";
+ end;
+ help3("I've put in what seems to be necessary to fix")@/
+ ("the current column of the current alignment.")@/
+ ("Try to go on, since this might almost work."); ins_error;
+ end;
+end;
+
+@ @<Express consternation...@>=
+begin print_err("Misplaced "); print_cmd_chr(cur_cmd,cur_chr);
+@.Misplaced \&@>
+@.Misplaced \\span@>
+@.Misplaced \\cr@>
+if cur_tok=tab_token+"&" then
+ begin help6("I can't figure out why you would want to use a tab mark")@/
+ ("here. If you just want an ampersand, the remedy is")@/
+ ("simple: Just type `I\&' now. But if some right brace")@/
+ ("up above has ended a previous alignment prematurely,")@/
+ ("you're probably due for more error messages, and you")@/
+ ("might try typing `S' now just to see what is salvageable.");
+ end
+else begin help5("I can't figure out why you would want to use a tab mark")@/
+ ("or \cr or \span just now. If something like a right brace")@/
+ ("up above has ended a previous alignment prematurely,")@/
+ ("you're probably due for more error messages, and you")@/
+ ("might try typing `S' now just to see what is salvageable.");
+ end;
+error;
+end
+
+@ The help messages here contain a little white lie, since \.{\\noalign}
+and \.{\\omit} are allowed also after `\.{\\noalign\{...\}}'.
+
+@<Declare act...@>=
+procedure no_align_error;
+begin print_err("Misplaced "); print_esc("noalign");
+@.Misplaced \\noalign@>
+help2("I expect to see \noalign only after the \cr of")@/
+ ("an alignment. Proceed, and I'll ignore this case."); error;
+end;
+procedure omit_error;
+begin print_err("Misplaced "); print_esc("omit");
+@.Misplaced \\omit@>
+help2("I expect to see \omit only after tab marks or the \cr of")@/
+ ("an alignment. Proceed, and I'll ignore this case."); error;
+end;
+
+@ We've now covered most of the abuses of \.{\\halign} and \.{\\valign}.
+Let's take a look at what happens when they are used correctly.
+
+@<Cases of |main_control| that build...@>=
+vmode+halign,hmode+valign:init_align;
+mmode+halign: if privileged then
+ if cur_group=math_shift_group then init_align
+ else off_save;
+vmode+endv,hmode+endv: do_endv;
+
+@ An |align_group| code is supposed to remain on the |save_stack|
+during an entire alignment, until |fin_align| removes it.
+
+A devious user might force an |endv| command to occur just about anywhere;
+we must defeat such hacks.
+
+@<Declare act...@>=
+procedure do_endv;
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+while (input_stack[base_ptr].index_field<>v_template) and
+ (input_stack[base_ptr].loc_field=null) and
+ (input_stack[base_ptr].state_field=token_list) do decr(base_ptr);
+if (input_stack[base_ptr].index_field<>v_template) or
+ (input_stack[base_ptr].loc_field<>null) or
+ (input_stack[base_ptr].state_field<>token_list) then
+ fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+ if cur_group=align_group then
+ begin end_graf;
+ if fin_col then fin_row;
+ end
+else off_save;
+end;
+
+@ @<Cases of |handle_right_brace|...@>=
+align_group: begin back_input; cur_tok:=cs_token_flag+frozen_cr;
+ print_err("Missing "); print_esc("cr"); print(" inserted");
+@.Missing \\cr inserted@>
+ help1("I'm guessing that you meant to end an alignment here.");
+ ins_error;
+ end;
+
+@ @<Cases of |handle_right_brace|...@>=
+no_align_group: begin end_graf; unsave; align_peek;
+ end;
+
+@ Finally, \.{\\endcsname} is not supposed to get through to |main_control|.
+
+@<Cases of |main_control| that build...@>=
+any_mode(end_cs_name): cs_error;
+
+@ @<Declare act...@>=
+procedure cs_error;
+begin print_err("Extra "); print_esc("endcsname");
+@.Extra \\endcsname@>
+help1("I'm ignoring this, since I wasn't doing a \csname.");
+error;
+end;
+
+@* \[48] Building math lists.
+The routines that \TeX\ uses to create mlists are similar to those we have
+just seen for the generation of hlists and vlists. But it is necessary to
+make ``noads'' as well as nodes, so the reader should review the
+discussion of math mode data structures before trying to make sense out of
+the following program.
+
+Here is a little routine that needs to be done whenever a subformula
+is about to be processed. The parameter is a code like |math_group|.
+
+@<Declare act...@>=
+procedure push_math(@!c:group_code);
+begin push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
+end;
+
+@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
+|math_shift| character) is scanned. We must check to see whether this
+`\.\$' is immediately followed by another, in case display math mode is
+called for.
+
+@<Cases of |main_control| that build...@>=
+hmode+math_shift:init_math;
+
+@ @<Declare act...@>=
+procedure init_math;
+label reswitch,found,not_found,done;
+var w:scaled; {new or partial |pre_display_size|}
+@!l:scaled; {new |display_width|}
+@!s:scaled; {new |display_indent|}
+@!p:pointer; {current node when calculating |pre_display_size|}
+@!q:pointer; {glue specification when calculating |pre_display_size|}
+@!f:internal_font_number; {font in current |char_node|}
+@!n:integer; {scope of paragraph shape specification}
+@!v:scaled; {|w| plus possible glue amount}
+@!d:scaled; {increment to |v|}
+begin get_token; {|get_x_token| would fail on \.{\\ifmmode}\thinspace!}
+if (cur_cmd=math_shift)and(mode>0) then @<Go into display math mode@>
+else begin back_input; @<Go into ordinary math mode@>;
+ end;
+end;
+
+@ @<Go into ordinary math mode@>=
+begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+if every_math<>null then begin_token_list(every_math,every_math_text);
+end
+
+@ We get into ordinary math mode from display math mode when `\.{\\eqno}' or
+`\.{\\leqno}' appears. In such cases |cur_chr| will be 0 or~1, respectively;
+the value of |cur_chr| is placed onto |save_stack| for safe keeping.
+
+@<Cases of |main_control| that build...@>=
+mmode+eq_no: if privileged then
+ if cur_group=math_shift_group then start_eq_no
+ else off_save;
+
+@ @<Put each...@>=
+primitive("eqno",eq_no,0);
+@!@:eq_no_}{\.{\\eqno} primitive@>
+primitive("leqno",eq_no,1);
+@!@:leq_no_}{\.{\\leqno} primitive@>
+
+@ When \TeX\ is in display math mode, |cur_group=math_shift_group|,
+so it is not necessary for the |start_eq_no| procedure to test for
+this condition.
+
+@<Declare act...@>=
+procedure start_eq_no;
+begin saved(0):=cur_chr; incr(save_ptr);
+@<Go into ordinary math mode@>;
+end;
+
+@ @<Cases of |print_cmd_chr|...@>=
+eq_no:if chr_code=1 then print_esc("leqno")@+else print_esc("eqno");
+
+@ @<Forbidden...@>=non_math(eq_no),
+
+@ When we enter display math mode, we need to call |line_break| to
+process the partial paragraph that has just been interrupted by the
+display. Then we can set the proper values of |display_width| and
+|display_indent| and |pre_display_size|.
+
+@<Go into display math mode@>=
+begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+ begin pop_nest; w:=-max_dimen;
+ end
+else begin line_break(display_widow_penalty);@/
+ @<Calculate the natural width, |w|, by which the characters of the
+ final line extend to the right of the reference point,
+ plus two ems; or set |w:=max_dimen| if the non-blank information
+ on that line is affected by stretching or shrinking@>;
+ end;
+{now we are in vertical mode, working on the list that will contain the display}
+@<Calculate the length, |l|, and the shift amount, |s|, of the display lines@>;
+push_math(math_shift_group); mode:=mmode;
+eq_word_define(int_base+cur_fam_code,-1);@/
+eq_word_define(dimen_base+pre_display_size_code,w);
+eq_word_define(dimen_base+display_width_code,l);
+eq_word_define(dimen_base+display_indent_code,s);
+if every_display<>null then begin_token_list(every_display,every_display_text);
+if nest_ptr=1 then build_page;
+end
+
+@ @<Calculate the natural width, |w|, by which...@>=
+v:=shift_amount(just_box)+2*quad(cur_font); w:=-max_dimen;
+p:=list_ptr(just_box);
+while p<>null do
+ begin @<Let |d| be the natural width of node |p|;
+ if the node is ``visible,'' |goto found|;
+ if the node is glue that stretches or shrinks, set |v:=max_dimen|@>;
+ if v<max_dimen then v:=v+d;
+ goto not_found;
+ found: if v<max_dimen then
+ begin v:=v+d; w:=v;
+ end
+ else begin w:=max_dimen; goto done;
+ end;
+ not_found: p:=link(p);
+ end;
+done:
+
+@ @<Let |d| be the natural width of node |p|...@>=
+reswitch: if is_char_node(p) then
+ begin f:=font(p); d:=char_width(f)(char_info(f)(character(p)));
+ goto found;
+ end;
+case type(p) of
+hlist_node,vlist_node,rule_node: begin d:=width(p); goto found;
+ end;
+ligature_node:@<Make node |p| look like a |char_node|...@>;
+kern_node,math_node: d:=width(p);
+glue_node:@<Let |d| be the natural width of this glue; if stretching
+ or shrinking, set |v:=max_dimen|; |goto found| in the case of leaders@>;
+whatsit_node: @<Let |d| be the width of the whatsit |p|@>;
+othercases d:=0
+endcases
+
+@ We need to be careful that |w|, |v|, and |d| do not depend on any |glue_set|
+values, since such values are subject to system-dependent rounding.
+System-dependent numbers are not allowed to infiltrate parameters like
+|pre_display_size|, since \TeX82 is supposed to make the same decisions on all
+machines.
+
+@<Let |d| be the natural width of this glue...@>=
+begin q:=glue_ptr(p); d:=width(q);
+if glue_sign(just_box)=stretching then
+ begin if (glue_order(just_box)=stretch_order(q))and@|
+ (stretch(q)<>0) then
+ v:=max_dimen;
+ end
+else if glue_sign(just_box)=shrinking then
+ begin if (glue_order(just_box)=shrink_order(q))and@|
+ (shrink(q)<>0) then
+ v:=max_dimen;
+ end;
+if subtype(p)>=a_leaders then goto found;
+end
+
+@ A displayed equation is considered to be three lines long, so we
+calculate the length and offset of line number |prev_graf+2|.
+
+@<Calculate the length, |l|, ...@>=
+if par_shape_ptr=null then
+ if (hang_indent<>0)and@|
+ (((hang_after>=0)and(prev_graf+2>hang_after))or@|
+ (prev_graf+1<-hang_after)) then
+ begin l:=hsize-abs(hang_indent);
+ if hang_indent>0 then s:=hang_indent@+else s:=0;
+ end
+ else begin l:=hsize; s:=0;
+ end
+else begin n:=info(par_shape_ptr);
+ if prev_graf+2>=n then p:=par_shape_ptr+2*n
+ else p:=par_shape_ptr+2*(prev_graf+2);
+ s:=mem[p-1].sc; l:=mem[p].sc;
+ end
+
+@ Subformulas of math formulas cause a new level of math mode to be entered,
+on the semantic nest as well as the save stack. These subformulas arise in
+several ways: (1)~A left brace by itself indicates the beginning of a
+subformula that will be put into a box, thereby freezing its glue and
+preventing line breaks. (2)~A subscript or superscript is treated as a
+subformula if it is not a single character; the same applies to
+the nucleus of things like \.{\\underline}. (3)~The \.{\\left} primitive
+initiates a subformula that will be terminated by a matching \.{\\right}.
+The group codes placed on |save_stack| in these three cases are
+|math_group|, |math_group|, and |math_left_group|, respectively.
+
+Here is the code that handles case (1); the other cases are not quite as
+trivial, so we shall consider them later.
+
+@<Cases of |main_control| that build...@>=
+mmode+left_brace: begin tail_append(new_noad);
+ back_input; scan_math(nucleus(tail));
+ end;
+
+@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are
+broken down into subfields called |math_type| and either |info| or
+|(fam,character)|. The job of |scan_math| is to figure out what to place
+in one of these principal fields; it looks at the subformula that
+comes next in the input, and places an encoding of that subformula
+into a given word of |mem|.
+
+@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
+
+@<Declare act...@>=
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:case cur_cmd of
+letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
+ end;
+math_given: c:=cur_chr;
+delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod 256);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div 256) mod 16;
+exit:end;
+
+@ An active character that is an |outer_call| is allowed here.
+
+@<Treat |cur_chr|...@>=
+begin cur_cs:=cur_chr+active_base;
+cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+x_token; back_input;
+end
+
+@ The pointer |p| is placed on |save_stack| while a complex subformula
+is being scanned.
+
+@<Scan a subformula...@>=
+begin back_input; scan_left_brace;@/
+saved(0):=p; incr(save_ptr); push_math(math_group); return;
+end
+
+@ The simplest math formula is, of course, `\.{\${ }\$}', when no noads are
+generated. The next simplest cases involve a single character, e.g.,
+`\.{\$x\$}'. Even though such cases may not seem to be very interesting,
+the reader can perhaps understand how happy the author was when `\.{\$x\$}'
+was first properly typeset by \TeX. The code in this section was used.
+@^Knuth, Donald Ervin@>
+
+@<Cases of |main_control| that build...@>=
+mmode+letter,mmode+other_char,mmode+char_given:
+ set_math_char(ho(math_code(cur_chr)));
+mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
+ set_math_char(ho(math_code(cur_chr)));
+ end;
+mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val);
+ end;
+mmode+math_given: set_math_char(cur_chr);
+mmode+delim_num: begin scan_twenty_seven_bit_int;
+ set_math_char(cur_val div @'10000);
+ end;
+
+@ The |set_math_char| procedure creates a new noad appropriate to a given
+math code, and appends it to the current mlist. However, if the math code
+is sufficiently large, the |cur_chr| is treated as an active character and
+nothing is appended.
+
+@<Declare act...@>=
+procedure set_math_char(@!c:integer);
+var p:pointer; {the new noad}
+begin if c>=@'100000 then
+ @<Treat |cur_chr|...@>
+else begin p:=new_noad; math_type(nucleus(p)):=math_char;
+ character(nucleus(p)):=qi(c mod 256);
+ fam(nucleus(p)):=(c div 256) mod 16;
+ if c>=var_code then
+ begin if fam_in_range then fam(nucleus(p)):=cur_fam;
+ type(p):=ord_noad;
+ end
+ else type(p):=ord_noad+(c div @'10000);
+ link(tail):=p; tail:=p;
+ end;
+end;
+
+@ Primitive math operators like \.{\\mathop} and \.{\\underline} are given
+the command code |math_comp|, supplemented by the noad type that they
+generate.
+
+@<Put each...@>=
+primitive("mathord",math_comp,ord_noad);
+@!@:math_ord_}{\.{\\mathord} primitive@>
+primitive("mathop",math_comp,op_noad);
+@!@:math_op_}{\.{\\mathop} primitive@>
+primitive("mathbin",math_comp,bin_noad);
+@!@:math_bin_}{\.{\\mathbin} primitive@>
+primitive("mathrel",math_comp,rel_noad);
+@!@:math_rel_}{\.{\\mathrel} primitive@>
+primitive("mathopen",math_comp,open_noad);
+@!@:math_open_}{\.{\\mathopen} primitive@>
+primitive("mathclose",math_comp,close_noad);
+@!@:math_close_}{\.{\\mathclose} primitive@>
+primitive("mathpunct",math_comp,punct_noad);
+@!@:math_punct_}{\.{\\mathpunct} primitive@>
+primitive("mathinner",math_comp,inner_noad);
+@!@:math_inner_}{\.{\\mathinner} primitive@>
+primitive("underline",math_comp,under_noad);
+@!@:underline_}{\.{\\underline} primitive@>
+primitive("overline",math_comp,over_noad);@/
+@!@:overline_}{\.{\\overline} primitive@>
+primitive("displaylimits",limit_switch,normal);
+@!@:display_limits_}{\.{\\displaylimits} primitive@>
+primitive("limits",limit_switch,limits);
+@!@:limits_}{\.{\\limits} primitive@>
+primitive("nolimits",limit_switch,no_limits);
+@!@:no_limits_}{\.{\\nolimits} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+math_comp: case chr_code of
+ ord_noad: print_esc("mathord");
+ op_noad: print_esc("mathop");
+ bin_noad: print_esc("mathbin");
+ rel_noad: print_esc("mathrel");
+ open_noad: print_esc("mathopen");
+ close_noad: print_esc("mathclose");
+ punct_noad: print_esc("mathpunct");
+ inner_noad: print_esc("mathinner");
+ under_noad: print_esc("underline");
+ othercases print_esc("overline")
+ endcases;
+limit_switch: if chr_code=limits then print_esc("limits")
+ else if chr_code=no_limits then print_esc("nolimits")
+ else print_esc("displaylimits");
+
+@ @<Cases of |main_control| that build...@>=
+mmode+math_comp: begin tail_append(new_noad);
+ type(tail):=cur_chr; scan_math(nucleus(tail));
+ end;
+mmode+limit_switch: math_limit_switch;
+
+@ @<Declare act...@>=
+procedure math_limit_switch;
+label exit;
+begin if head<>tail then if type(tail)=op_noad then
+ begin subtype(tail):=cur_chr; return;
+ end;
+print_err("Limit controls must follow a math operator");
+@.Limit controls must follow...@>
+help1("I'm ignoring this misplaced \limits or \nolimits command."); error;
+exit:end;
+
+@ Delimiter fields of noads are filled in by the |scan_delimiter| routine.
+The first parameter of this procedure is the |mem| address where the
+delimiter is to be placed; the second tells if this delimiter follows
+\.{\\radical} or not.
+
+@<Declare act...@>=
+procedure scan_delimiter(@!p:pointer;@!r:boolean);
+begin if r then scan_twenty_seven_bit_int
+else begin @<Get the next non-blank non-relax...@>;
+ case cur_cmd of
+ letter,other_char: cur_val:=del_code(cur_chr);
+ delim_num: scan_twenty_seven_bit_int;
+ othercases cur_val:=-1
+ endcases;
+ end;
+if cur_val<0 then @<Report that an invalid delimiter code is being changed
+ to null; set~|cur_val:=0|@>;
+small_fam(p):=(cur_val div @'4000000) mod 16;
+small_char(p):=qi((cur_val div @'10000) mod 256);
+large_fam(p):=(cur_val div 256) mod 16;
+large_char(p):=qi(cur_val mod 256);
+end;
+
+@ @<Report that an invalid delimiter...@>=
+begin print_err("Missing delimiter (. inserted)");
+@.Missing delimiter...@>
+help6("I was expecting to see something like `(' or `\{' or")@/
+ ("`\}' here. If you typed, e.g., `{' instead of `\{', you")@/
+ ("should probably delete the `{' by typing `1' now, so that")@/
+ ("braces don't get unbalanced. Otherwise just proceed.")@/
+ ("Acceptable delimiters are characters whose \delcode is")@/
+ ("nonnegative, or you can use `\delimiter <delimiter code>'.");
+back_error; cur_val:=0;
+end
+
+@ @<Cases of |main_control| that build...@>=
+mmode+radical:math_radical;
+
+@ @<Declare act...@>=
+procedure math_radical;
+begin tail_append(get_node(radical_noad_size));
+type(tail):=radical_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+scan_delimiter(left_delimiter(tail),true); scan_math(nucleus(tail));
+end;
+
+@ @<Cases of |main_control| that build...@>=
+mmode+accent,mmode+math_accent:math_ac;
+
+@ @<Declare act...@>=
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+math_type(accent_chr(tail)):=math_char;
+scan_fifteen_bit_int;
+character(accent_chr(tail)):=qi(cur_val mod 256);
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
+scan_math(nucleus(tail));
+end;
+
+@ @<Complain that the user should have said \.{\\mathaccent}@>=
+begin print_err("Please use "); print_esc("mathaccent");
+print(" for accents in math mode");
+@.Please use \\mathaccent...@>
+help2("I'm changing \accent to \mathaccent here; wish me luck.")@/
+ ("(Accents are not the same in formulas as they are in text.)");
+error;
+end
+
+@ @<Cases of |main_control| that build...@>=
+mmode+vcenter: begin scan_spec(vcenter_group,false); normal_paragraph;
+ push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+ if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+ end;
+
+@ @<Cases of |handle...@>=
+vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-2;
+ p:=vpack(link(head),saved(1),saved(0)); pop_nest;
+ tail_append(new_noad); type(tail):=vcenter_noad;
+ math_type(nucleus(tail)):=sub_box; info(nucleus(tail)):=p;
+ end;
+
+@ The routine that inserts a |style_node| holds no surprises.
+
+@<Put each...@>=
+primitive("displaystyle",math_style,display_style);
+@!@:display_style_}{\.{\\displaystyle} primitive@>
+primitive("textstyle",math_style,text_style);
+@!@:text_style_}{\.{\\textstyle} primitive@>
+primitive("scriptstyle",math_style,script_style);
+@!@:script_style_}{\.{\\scriptstyle} primitive@>
+primitive("scriptscriptstyle",math_style,script_script_style);
+@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+math_style: print_style(chr_code);
+
+@ @<Cases of |main_control| that build...@>=
+mmode+math_style: tail_append(new_style(cur_chr));
+mmode+non_script: begin tail_append(new_glue(zero_glue));
+ subtype(tail):=cond_math_glue;
+ end;
+mmode+math_choice: append_choices;
+
+@ The routine that scans the four mlists of a \.{\\mathchoice} is very
+much like the routine that builds discretionary nodes.
+
+@<Declare act...@>=
+procedure append_choices;
+begin tail_append(new_choice); incr(save_ptr); saved(-1):=0;
+push_math(math_choice_group); scan_left_brace;
+end;
+
+@ @<Cases of |handle_right_brace|...@>=
+math_choice_group: build_choices;
+
+@ @<Declare act...@>=
+@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
+procedure build_choices;
+label exit;
+var p:pointer; {the current mlist}
+begin unsave; p:=fin_mlist(null);
+case saved(-1) of
+0:display_mlist(tail):=p;
+1:text_mlist(tail):=p;
+2:script_mlist(tail):=p;
+3:begin script_script_mlist(tail):=p; decr(save_ptr); return;
+ end;
+end; {there are no other cases}
+incr(saved(-1)); push_math(math_choice_group); scan_left_brace;
+exit:end;
+
+@ Subscripts and superscripts are attached to the previous nucleus by the
+@^superscripts@>@^subscripts@>
+action procedure called |sub_sup|. We use the facts that |sub_mark=sup_mark+1|
+and |subscr(p)=supscr(p)+1|.
+
+@<Cases of |main_control| that build...@>=
+mmode+sub_mark,mmode+sup_mark: sub_sup;
+
+@ @<Declare act...@>=
+procedure sub_sup;
+var t:small_number; {type of previous sub/superscript}
+@!p:pointer; {field to be filled by |scan_math|}
+begin t:=empty; p:=null;
+if tail<>head then if scripts_allowed(tail) then
+ begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+ t:=math_type(p);
+ end;
+if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
+scan_math(p);
+end;
+
+@ @<Insert a dummy...@>=
+begin tail_append(new_noad);
+p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+if t<>empty then
+ begin if cur_cmd=sup_mark then
+ begin print_err("Double superscript");
+@.Double superscript@>
+ help1("I treat `x^1^2' essentially like `x^1{}^2'.");
+ end
+ else begin print_err("Double subscript");
+@.Double subscript@>
+ help1("I treat `x_1_2' essentially like `x_1{}_2'.");
+ end;
+ error;
+ end;
+end
+
+@ An operation like `\.{\\over}' causes the current mlist to go into a
+state of suspended animation: |incompleat_noad| points to a |fraction_noad|
+that contains the mlist-so-far as its numerator, while the denominator
+is yet to come. Finally when the mlist is finished, the denominator will
+go into the incompleat fraction noad, and that noad will become the
+whole formula, unless it is surrounded by `\.{\\left}' and `\.{\\right}'
+delimiters.
+
+@d above_code=0 { `\.{\\above}' }
+@d over_code=1 { `\.{\\over}' }
+@d atop_code=2 { `\.{\\atop}' }
+@d delimited_code=3 { `\.{\\abovewithdelims}', etc.}
+
+@<Put each...@>=
+primitive("above",above,above_code);@/
+@!@:above_}{\.{\\above} primitive@>
+primitive("over",above,over_code);@/
+@!@:over_}{\.{\\over} primitive@>
+primitive("atop",above,atop_code);@/
+@!@:atop_}{\.{\\atop} primitive@>
+primitive("abovewithdelims",above,delimited_code+above_code);@/
+@!@:above_with_delims_}{\.{\\abovewithdelims} primitive@>
+primitive("overwithdelims",above,delimited_code+over_code);@/
+@!@:over_with_delims_}{\.{\\overwithdelims} primitive@>
+primitive("atopwithdelims",above,delimited_code+atop_code);
+@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+above: case chr_code of
+ over_code:print_esc("over");
+ atop_code:print_esc("atop");
+ delimited_code+above_code:print_esc("abovewithdelims");
+ delimited_code+over_code:print_esc("overwithdelims");
+ delimited_code+atop_code:print_esc("atopwithdelims");
+ othercases print_esc("above")
+ endcases;
+
+@ @<Cases of |main_control| that build...@>=
+mmode+above: math_fraction;
+
+@ @<Declare act...@>=
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+if incompleat_noad<>null then
+ @<Ignore the fraction operation and complain about this ambiguous case@>
+else begin incompleat_noad:=get_node(fraction_noad_size);
+ type(incompleat_noad):=fraction_noad;
+ subtype(incompleat_noad):=normal;
+ math_type(numerator(incompleat_noad)):=sub_mlist;
+ info(numerator(incompleat_noad)):=link(head);
+ mem[denominator(incompleat_noad)].hh:=empty_field;
+ mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
+ mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
+ link(head):=null; tail:=head;
+ @<Use code |c| to distinguish between generalized fractions@>;
+ end;
+end;
+
+@ @<Use code |c|...@>=
+if c>=delimited_code then
+ begin scan_delimiter(left_delimiter(incompleat_noad),false);
+ scan_delimiter(right_delimiter(incompleat_noad),false);
+ end;
+case c mod delimited_code of
+above_code: begin scan_normal_dimen;
+ thickness(incompleat_noad):=cur_val;
+ end;
+over_code: thickness(incompleat_noad):=default_code;
+atop_code: thickness(incompleat_noad):=0;
+end {there are no other cases}
+
+@ @<Ignore the fraction...@>=
+begin if c>=delimited_code then
+ begin scan_delimiter(garbage,false); scan_delimiter(garbage,false);
+ end;
+if c mod delimited_code=above_code then scan_normal_dimen;
+print_err("Ambiguous; you need another { and }");
+@.Ambiguous...@>
+help3("I'm ignoring this fraction specification, since I don't")@/
+ ("know whether a construction like `x \over y \over z'")@/
+ ("means `{x \over y} \over z' or `x \over {y \over z}'.");
+error;
+end
+
+@ At the end of a math formula or subformula, the |fin_mlist| routine is
+called upon to return a pointer to the newly completed mlist, and to
+pop the nest back to the enclosing semantic level. The parameter to
+|fin_mlist|, if not null, points to a |right_noad| that ends the
+current mlist; this |right_noad| has not yet been appended.
+
+@<Declare the function called |fin_mlist|@>=
+function fin_mlist(@!p:pointer):pointer;
+var q:pointer; {the mlist to return}
+begin if incompleat_noad<>null then @<Compleat the incompleat noad@>
+else begin link(tail):=p; q:=link(head);
+ end;
+pop_nest; fin_mlist:=q;
+end;
+
+@ @<Compleat...@>=
+begin math_type(denominator(incompleat_noad)):=sub_mlist;
+info(denominator(incompleat_noad)):=link(head);
+if p=null then q:=incompleat_noad
+else begin q:=info(numerator(incompleat_noad));
+ if type(q)<>left_noad then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(q);
+ link(q):=incompleat_noad; link(incompleat_noad):=p;
+ end;
+end
+
+@ Now at last we're ready to see what happens when a right brace occurs
+in a math formula. Two special cases are simplified here: Braces are effectively
+removed when they surround a single Ord without sub/superscripts, or when they
+surround an accent that is the nucleus of an Ord atom.
+
+@<Cases of |handle...@>=
+math_group: begin unsave; decr(save_ptr);@/
+ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
+ if p<>null then if link(p)=null then
+ if type(p)=ord_noad then
+ begin if math_type(subscr(p))=empty then
+ if math_type(supscr(p))=empty then
+ begin mem[saved(0)].hh:=mem[nucleus(p)].hh;
+ free_node(p,noad_size);
+ end;
+ end
+ else if type(p)=accent_noad then if saved(0)=nucleus(tail) then
+ if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>;
+ end;
+
+@ @<Replace the tail...@>=
+begin q:=head; while link(q)<>tail do q:=link(q);
+link(q):=p; free_node(tail,noad_size); tail:=p;
+end
+
+@ We have dealt with all constructions of math mode except `\.{\\left}' and
+`\.{\\right}', so the picture is completed by the following sections of
+the program.
+
+@<Put each...@>=
+primitive("left",left_right,left_noad);
+@!@:left_}{\.{\\left} primitive@>
+primitive("right",left_right,right_noad);
+@!@:right_}{\.{\\right} primitive@>
+text(frozen_right):="right"; eqtb[frozen_right]:=eqtb[cur_val];
+
+@ @<Cases of |print_cmd_chr|...@>=
+left_right: if chr_code=left_noad then print_esc("left")
+else print_esc("right");
+
+@ @<Cases of |main_control| that build...@>=
+mmode+left_right: math_left_right;
+
+@ @<Declare act...@>=
+procedure math_left_right;
+var t:small_number; {|left_noad| or |right_noad|}
+@!p:pointer; {new noad}
+begin t:=cur_chr;
+if (t=right_noad)and(cur_group<>math_left_group) then
+ @<Try to recover from mismatched \.{\\right}@>
+else begin p:=new_noad; type(p):=t;
+ scan_delimiter(delimiter(p),false);
+ if t=left_noad then
+ begin push_math(math_left_group); link(head):=p; tail:=p;
+ end
+ else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
+ tail_append(new_noad); type(tail):=inner_noad;
+ math_type(nucleus(tail)):=sub_mlist;
+ info(nucleus(tail)):=p;
+ end;
+ end;
+end;
+
+@ @<Try to recover from mismatch...@>=
+begin if cur_group=math_shift_group then
+ begin scan_delimiter(garbage,false);
+ print_err("Extra "); print_esc("right");
+@.Extra \\right.@>
+ help1("I'm ignoring a \right that had no matching \left.");
+ error;
+ end
+else off_save;
+end
+
+@ Here is the only way out of math mode.
+
+@<Cases of |main_control| that build...@>=
+mmode+math_shift: if cur_group=math_shift_group then after_math
+ else off_save;
+
+@ @<Declare act...@>=
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+ begin @<Check that another \.\$ follows@>;
+ cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+ mlist_to_hlist; a:=hpack(link(temp_head),natural);
+ unsave; decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+ danger:=false;
+ @<Check that the necessary fonts for math symbols are present;
+ if not, flush the current math lists and set |danger:=true|@>;
+ m:=mode; p:=fin_mlist(null);
+ end
+else a:=null;
+if m<0 then @<Finish math in text@>
+else begin if a=null then @<Check that another \.\$ follows@>;
+ @<Finish displayed math@>;
+ end;
+end;
+
+@ @<Check that the necessary fonts...@>=
+if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@|
+ (font_params[fam_fnt(2+script_size)]<total_mathsy_params)or@|
+ (font_params[fam_fnt(2+script_script_size)]<total_mathsy_params) then
+ begin print_err("Math formula deleted: Insufficient symbol fonts");@/
+@.Math formula deleted...@>
+ help3("Sorry, but I can't typeset math unless \textfont 2")@/
+ ("and \scriptfont 2 and \scriptscriptfont 2 have all")@/
+ ("the \fontdimen values needed in math symbol fonts.");
+ error; flush_math; danger:=true;
+ end
+else if (font_params[fam_fnt(3+text_size)]<total_mathex_params)or@|
+ (font_params[fam_fnt(3+script_size)]<total_mathex_params)or@|
+ (font_params[fam_fnt(3+script_script_size)]<total_mathex_params) then
+ begin print_err("Math formula deleted: Insufficient extension fonts");@/
+ help3("Sorry, but I can't typeset math unless \textfont 3")@/
+ ("and \scriptfont 3 and \scriptscriptfont 3 have all")@/
+ ("the \fontdimen values needed in math extension fonts.");
+ error; flush_math; danger:=true;
+ end
+
+@ The |unsave| is done after everything else here; hence an appearance of
+`\.{\\mathsurround}' inside of `\.{\$...\$}' affects the spacing at these
+particular \.\$'s. This is consistent with the conventions of
+`\.{\$\$...\$\$}', since `\.{\\abovedisplayskip}' inside a display affects the
+space above that display.
+
+@<Finish math in text@>=
+begin tail_append(new_math(math_surround,before));
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+tail_append(new_math(math_surround,after));
+space_factor:=1000; unsave;
+end
+
+@ \TeX\ gets to the following part of the program when the first `\.\$' ending
+a display has been scanned.
+
+@<Check that another \.\$ follows@>=
+begin get_x_token;
+if cur_cmd<>math_shift then
+ begin print_err("Display math should end with $$");
+@.Display math...with \$\$@>
+ help2("The `$' that I just saw supposedly matches a previous `$$'.")@/
+ ("So I shall assume that you typed `$$' both times.");
+ back_error;
+ end;
+end
+
+@ We have saved the worst for last: The fussiest part of math mode processing
+occurs when a displayed formula is being centered and placed with an optional
+equation number.
+
+@<Local variables for finishing...@>=
+@!b:pointer; {box containing the equation}
+@!w:scaled; {width of the equation}
+@!z:scaled; {width of the line}
+@!e:scaled; {width of equation number}
+@!q:scaled; {width of equation number plus space to separate from equation}
+@!d:scaled; {displacement of equation in the line}
+@!s:scaled; {move the line right this much}
+@!g1,@!g2:small_number; {glue parameter codes for before and after}
+@!r:pointer; {kern node used to position the display}
+@!t:pointer; {tail of adjustment list}
+
+@ At this time |p| points to the mlist for the formula; |a| is either
+|null| or it points to a box containing the equation number; and we are in
+vertical mode (or internal vertical mode).
+
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+mlist_to_hlist; p:=link(temp_head);@/
+adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b);
+t:=adjust_tail; adjust_tail:=null;@/
+w:=width(b); z:=display_width; s:=display_indent;
+if (a=null)or danger then
+ begin e:=0; q:=0;
+ end
+else begin e:=width(a); q:=e+math_quad(text_size);
+ end;
+if w+q>z then
+ @<Squeeze the equation as much as possible; if there is an equation
+ number that should go on a separate line by itself,
+ set~|e:=0|@>;
+@<Determine the displacement, |d|, of the left edge of the equation, with
+ respect to the line size |z|, assuming that |l=false|@>;
+@<Append the glue or equation number preceding the display@>;
+@<Append the display and perhaps also the equation number@>;
+@<Append the glue or equation number following the display@>;
+resume_after_display
+
+@ @<Declare act...@>=
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+unsave; prev_graf:=prev_graf+3;
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<Scan an optional space@>;
+if nest_ptr=1 then build_page;
+end;
+
+@ The user can force the equation number to go on a separate line
+by causing its width to be zero.
+
+@<Squeeze the equation as much as possible...@>=
+begin if (e<>0)and((w-total_shrink[normal]+q<=z)or@|
+ (total_shrink[fil]<>0)or(total_shrink[fill]<>0)or
+ (total_shrink[filll]<>0)) then
+ begin free_node(b,box_node_size);
+ b:=hpack(p,z-q,exactly);
+ end
+else begin e:=0;
+ if w>z then
+ begin free_node(b,box_node_size);
+ b:=hpack(p,z,exactly);
+ end;
+ end;
+w:=width(b);
+end
+
+@ We try first to center the display without regard to the existence of
+the equation number. If that would make it too close (where ``too close''
+means that the space between display and equation number is less than the
+width of the equation number), we either center it in the remaining space
+or move it as far from the equation number as possible. The latter alternative
+is taken only if the display begins with glue, since we assume that the
+user put glue there to control the spacing precisely.
+
+@<Determine the displacement, |d|, of the left edge of the equation...@>=
+d:=half(z-w);
+if (e>0)and(d<2*e) then {too close}
+ begin d:=half(z-w-e);
+ if p<>null then if not is_char_node(p) then if type(p)=glue_node then d:=0;
+ end
+
+@ If the equation number is set on a line by itself, either before or
+after the formula, we append an infinite penalty so that no page break will
+separate the display from its number; and we use the same size and
+displacement for all three potential lines of the display, even though
+`\.{\\parshape}' may specify them differently.
+
+@<Append the glue or equation number preceding the display@>=
+tail_append(new_penalty(pre_display_penalty));@/
+if (d+s<=pre_display_size)or l then {not enough clearance}
+ begin g1:=above_display_skip_code; g2:=below_display_skip_code;
+ end
+else begin g1:=above_display_short_skip_code;
+ g2:=below_display_short_skip_code;
+ end;
+if l and(e=0) then {it follows that |type(a)=hlist_node|}
+ begin shift_amount(a):=s; append_to_vlist(a);
+ tail_append(new_penalty(inf_penalty));
+ end
+else tail_append(new_param_glue(g1))
+
+@ @<Append the display and perhaps also the equation number@>=
+if e<>0 then
+ begin r:=new_kern(z-w-e-d);
+ if l then
+ begin link(a):=r; link(r):=b; b:=a; d:=0;
+ end
+ else begin link(b):=r; link(r):=a;
+ end;
+ b:=hpack(b,natural);
+ end;
+shift_amount(b):=s+d; append_to_vlist(b)
+
+@ @<Append the glue or equation number following the display@>=
+if (a<>null)and(e=0)and not l then
+ begin tail_append(new_penalty(inf_penalty));
+ shift_amount(a):=s+z-width(a);
+ append_to_vlist(a);
+ g2:=0;
+ end;
+if t<>adjust_head then {migrating material comes after equation number}
+ begin link(tail):=link(adjust_head); tail:=t;
+ end;
+tail_append(new_penalty(post_display_penalty));
+if g2>0 then tail_append(new_param_glue(g2))
+
+@ When \.{\\halign} appears in a display, the alignment routines operate
+essentially as they do in vertical mode. Then the following program is
+activated, with |p| and |q| pointing to the beginning and end of the
+resulting list, and with |aux_save| holding the |prev_depth| value.
+
+@<Finish an alignment in a display@>=
+begin do_assignments;
+if cur_cmd<>math_shift then @<Pontificate about improper alignment in display@>
+else @<Check that another \.\$ follows@>;
+pop_nest;
+tail_append(new_penalty(pre_display_penalty));
+tail_append(new_param_glue(above_display_skip_code));
+link(tail):=p;
+if p<>null then tail:=q;
+tail_append(new_penalty(post_display_penalty));
+tail_append(new_param_glue(below_display_skip_code));
+prev_depth:=aux_save.sc; resume_after_display;
+end
+
+@ @<Pontificate...@>=
+begin print_err("Missing $$ inserted");
+@.Missing {\$\$} inserted@>
+help2("Displays can use special alignments (like \eqalignno)")@/
+ ("only if nothing but the alignment itself is between $$'s.");
+back_error;
+end
+
+@* \[49] Mode-independent processing.
+The long |main_control| procedure has now been fully specified, except for
+certain activities that are independent of the current mode. These activities
+do not change the current vlist or hlist or mlist; if they change anything,
+it is the value of a parameter or the meaning of a control sequence.
+
+Assignments to values in |eqtb| can be global or local. Furthermore, a
+control sequence can be defined to be `\.{\\long}' or `\.{\\outer}', and
+it might or might not be expanded. The prefixes `\.{\\global}', `\.{\\long}',
+and `\.{\\outer}' can occur in any order. Therefore we assign binary numeric
+codes, making it possible to accumulate the union of all specified prefixes
+by adding the corresponding codes. (\PASCAL's |set| operations could also
+have been used.)
+
+@<Put each...@>=
+primitive("long",prefix,1);
+@!@:long_}{\.{\\long} primitive@>
+primitive("outer",prefix,2);
+@!@:outer_}{\.{\\outer} primitive@>
+primitive("global",prefix,4);
+@!@:global_}{\.{\\global} primitive@>
+primitive("def",def,0);
+@!@:def_}{\.{\\def} primitive@>
+primitive("gdef",def,1);
+@!@:gdef_}{\.{\\gdef} primitive@>
+primitive("edef",def,2);
+@!@:edef_}{\.{\\edef} primitive@>
+primitive("xdef",def,3);
+@!@:xdef_}{\.{\\xdef} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+prefix: if chr_code=1 then print_esc("long")
+ else if chr_code=2 then print_esc("outer")
+ else print_esc("global");
+def: if chr_code=0 then print_esc("def")
+ else if chr_code=1 then print_esc("gdef")
+ else if chr_code=2 then print_esc("edef")
+ else print_esc("xdef");
+
+@ Every prefix, and every command code that might or might not be prefixed,
+calls the action procedure |prefixed_command|. This routine accumulates
+a sequence of prefixes until coming to a non-prefix, then it carries out
+the command.
+
+@<Cases of |main_control| that don't...@>=
+any_mode(toks_register),
+any_mode(assign_toks),
+any_mode(assign_int),
+any_mode(assign_dimen),
+any_mode(assign_glue),
+any_mode(assign_mu_glue),
+any_mode(assign_font_dimen),
+any_mode(assign_font_int),
+any_mode(set_aux),
+any_mode(set_prev_graf),
+any_mode(set_page_dimen),
+any_mode(set_page_int),
+any_mode(set_box_dimen),
+any_mode(set_shape),
+any_mode(def_code),
+any_mode(def_family),
+any_mode(set_font),
+any_mode(def_font),
+any_mode(register),
+any_mode(advance),
+any_mode(multiply),
+any_mode(divide),
+any_mode(prefix),
+any_mode(let),
+any_mode(shorthand_def),
+any_mode(read_to_cs),
+any_mode(def),
+any_mode(set_box),
+any_mode(hyph_data),
+any_mode(set_interaction):prefixed_command;
+
+@ If the user says, e.g., `\.{\\global\\global}', the redundancy is
+silently accepted.
+
+@<Declare act...@>=
+@t\4@>@<Declare subprocedures for |prefixed_command|@>@t@>@;@/
+procedure prefixed_command;
+label done,exit;
+var a:small_number; {accumulated prefix codes so far}
+@!f:internal_font_number; {identifies a font}
+@!j:halfword; {index into a \.{\\parshape} specification}
+@!k:font_index; {index into |font_info|}
+@!p,@!q:pointer; {for temporary short-term use}
+@!n:integer; {ditto}
+@!e:boolean; {should a definition be expanded? or was \.{\\let} not done?}
+begin a:=0;
+while cur_cmd=prefix do
+ begin if not odd(a div cur_chr) then a:=a+cur_chr;
+ @<Get the next non-blank non-relax...@>;
+ if cur_cmd<=max_non_prefixed_command then
+ @<Discard erroneous prefixes and |return|@>;
+ end;
+@<Discard the prefixes \.{\\long} and \.{\\outer} if they are irrelevant@>;
+@<Adjust \(f)for the setting of \.{\\globaldefs}@>;
+case cur_cmd of
+@t\4@>@<Assignments@>@;
+othercases confusion("prefix")
+@:this can't happen prefix}{\quad prefix@>
+endcases;
+done: @<Insert a token saved by \.{\\afterassignment}, if any@>;
+exit:end;
+
+@ @<Discard erroneous...@>=
+begin print_err("You can't use a prefix with `");
+@.You can't use a prefix with x@>
+print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+help1("I'll pretend you didn't say \long or \outer or \global.");
+back_error; return;
+end
+
+@ @<Discard the prefixes...@>=
+if (cur_cmd<>def)and(a mod 4<>0) then
+ begin print_err("You can't use `"); print_esc("long"); print("' or `");
+ print_esc("outer"); print("' with `");
+@.You can't use \\long...@>
+ print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+ help1("I'll pretend you didn't say \long or \outer here.");
+ error;
+ end
+
+@ The previous routine does not have to adjust |a| so that |a mod 4=0|,
+since the following routines test for the \.{\\global} prefix as follows.
+
+@d global==(a>=4)
+@d define(#)==if global then geq_define(#)@+else eq_define(#)
+@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
+
+@<Adjust \(f)for the setting of \.{\\globaldefs}@>=
+if global_defs<>0 then
+ if global_defs<0 then
+ begin if global then a:=a-4;
+ end
+ else begin if not global then a:=a+4;
+ end
+
+@ When a control sequence is to be defined, by \.{\\def} or \.{\\let} or
+something similar, the |get_r_token| routine will substitute a special
+control sequence for a token that is not redefinable.
+
+@<Declare subprocedures for |prefixed_command|@>=
+procedure get_r_token;
+label restart;
+begin restart: repeat get_token;
+until cur_tok<>space_token;
+if (cur_cs=0)or(cur_cs>frozen_control_sequence) then
+ begin print_err("Missing control sequence inserted");
+@.Missing control...@>
+ help5("Please don't say `\def cs{...}', say `\def\cs{...}'.")@/
+ ("I've inserted an inaccessible control sequence so that your")@/
+ ("definition will be completed without mixing me up too badly.")@/
+ ("You can recover graciously from this error, if you're")@/
+ ("careful; see exercise 27.2 in The TeXbook.");
+@:TeXbook}{\sl The \TeX book@>
+ if cur_cs=0 then back_input;
+ cur_tok:=cs_token_flag+frozen_protection; ins_error; goto restart;
+ end;
+end;
+
+@ @<Initialize table entries...@>=
+text(frozen_protection):="inaccessible";
+
+@ Here's an example of the way many of the following routines operate.
+(Unfortunately, they aren't all as simple as this.)
+
+@<Assignments@>=
+set_font: define(cur_font_loc,data,cur_chr);
+
+@ When a |def| command has been scanned,
+|cur_chr| is odd if the definition is supposed to be global, and
+|cur_chr>=2| if the definition is supposed to be expanded.
+
+@<Assignments@>=
+def: begin if odd(cur_chr)and not global and(global_defs>=0) then a:=a+4;
+ e:=(cur_chr>=2); get_r_token; p:=cur_cs;
+ q:=scan_toks(true,e); define(p,call+(a mod 4),def_ref);
+ end;
+
+@ Both \.{\\let} and \.{\\futurelet} share the command code |let|.
+
+@<Put each...@>=
+primitive("let",let,normal);@/
+@!@:let_}{\.{\\let} primitive@>
+primitive("futurelet",let,normal+1);@/
+@!@:future_let_}{\.{\\futurelet} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+let: if chr_code<>normal then print_esc("futurelet")@+else print_esc("let");
+
+@ @<Assignments@>=
+let: begin n:=cur_chr;
+ get_r_token; p:=cur_cs;
+ if n=normal then
+ begin repeat get_token;
+ until cur_cmd<>spacer;
+ if cur_tok=other_token+"=" then
+ begin get_token;
+ if cur_cmd=spacer then get_token;
+ end;
+ end
+ else begin get_token; q:=cur_tok; get_token; back_input;
+ cur_tok:=q; back_input; {look ahead, then back up}
+ end; {note that |back_input| doesn't affect |cur_cmd|, |cur_chr|}
+ if cur_cmd>=call then add_token_ref(cur_chr);
+ define(p,cur_cmd,cur_chr);
+ end;
+
+@ A \.{\\chardef} creates a control sequence whose |cmd| is |char_given|;
+a \.{\\mathchardef} creates a control sequence whose |cmd| is |math_given|;
+and the corresponding |chr| is the character code or math code. A \.{\\countdef}
+or \.{\\dimendef} or \.{\\skipdef} or \.{\\muskipdef} creates a control
+sequence whose |cmd| is |assign_int| or \dots\ or |assign_mu_glue|, and the
+corresponding |chr| is the |eqtb| location of the internal register in question.
+
+@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
+@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
+@d count_def_code=2 {|shorthand_def| for \.{\\countdef}}
+@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
+@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
+@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
+@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+
+@<Put each...@>=
+primitive("chardef",shorthand_def,char_def_code);@/
+@!@:char_def_}{\.{\\chardef} primitive@>
+primitive("mathchardef",shorthand_def,math_char_def_code);@/
+@!@:math_char_def_}{\.{\\mathchardef} primitive@>
+primitive("countdef",shorthand_def,count_def_code);@/
+@!@:count_def_}{\.{\\countdef} primitive@>
+primitive("dimendef",shorthand_def,dimen_def_code);@/
+@!@:dimen_def_}{\.{\\dimendef} primitive@>
+primitive("skipdef",shorthand_def,skip_def_code);@/
+@!@:skip_def_}{\.{\\skipdef} primitive@>
+primitive("muskipdef",shorthand_def,mu_skip_def_code);@/
+@!@:mu_skip_def_}{\.{\\muskipdef} primitive@>
+primitive("toksdef",shorthand_def,toks_def_code);@/
+@!@:toks_def_}{\.{\\toksdef} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+shorthand_def: case chr_code of
+ char_def_code: print_esc("chardef");
+ math_char_def_code: print_esc("mathchardef");
+ count_def_code: print_esc("countdef");
+ dimen_def_code: print_esc("dimendef");
+ skip_def_code: print_esc("skipdef");
+ mu_skip_def_code: print_esc("muskipdef");
+ othercases print_esc("toksdef")
+ endcases;
+char_given: begin print_esc("char"); print_hex(chr_code);
+ end;
+math_given: begin print_esc("mathchar"); print_hex(chr_code);
+ end;
+
+@ We temporarily define |p| to be |relax|, so that an occurrence of |p|
+while scanning the definition will simply stop the scanning instead of
+producing an ``undefined control sequence'' error or expanding the
+previous meaning. This allows, for instance, `\.{\\chardef\\foo=123\\foo}'.
+
+@<Assignments@>=
+shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
+ scan_optional_equals;
+ case n of
+ char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
+ end;
+ othercases begin scan_eight_bit_int;
+ case n of
+ count_def_code: define(p,assign_int,count_base+cur_val);
+ dimen_def_code: define(p,assign_dimen,scaled_base+cur_val);
+ skip_def_code: define(p,assign_glue,skip_base+cur_val);
+ mu_skip_def_code: define(p,assign_mu_glue,mu_skip_base+cur_val);
+ toks_def_code: define(p,assign_toks,toks_base+cur_val);
+ end; {there are no other cases}
+ end
+ endcases;
+ end;
+
+@ @<Assignments@>=
+read_to_cs: begin scan_int; n:=cur_val;
+ if not scan_keyword("to") then
+ begin print_err("Missing `to' inserted");
+@.Missing `to'...@>
+ help2("You should have said `\read<number> to \cs'.")@/
+ ("I'm going to look for the \cs now."); error;
+ end;
+ get_r_token;
+ p:=cur_cs; read_toks(n,p); define(p,call,cur_val);
+ end;
+
+@ The token-list parameters, \.{\\output} and \.{\\everypar}, etc., receive
+their values in the following way. (For safety's sake, we place an
+enclosing pair of braces around an \.{\\output} list.)
+
+@<Assignments@>=
+toks_register,assign_toks: begin q:=cur_cs;
+ if cur_cmd=toks_register then
+ begin scan_eight_bit_int; p:=toks_base+cur_val;
+ end
+ else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+ scan_optional_equals;
+ @<Get the next non-blank non-relax non-call token@>;
+ if cur_cmd<>left_brace then @<If the right-hand side is a token parameter
+ or token register, finish the assignment and |goto done|@>;
+ back_input; cur_cs:=q; q:=scan_toks(false,false);
+ if link(def_ref)=null then {empty list: revert to the default}
+ begin define(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if p=output_routine_loc then {enclose in curlies}
+ begin link(q):=get_avail; q:=link(q);
+ info(q):=right_brace_token+"}";
+ q:=get_avail; info(q):=left_brace_token+"{";
+ link(q):=link(def_ref); link(def_ref):=q;
+ end;
+ define(p,call,def_ref);
+ end;
+ end;
+
+@ @<If the right-hand side is a token parameter...@>=
+begin if cur_cmd=toks_register then
+ begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+ end;
+if cur_cmd=assign_toks then
+ begin q:=equiv(cur_chr);
+ if q=null then define(p,undefined_cs,null)
+ else begin add_token_ref(q); define(p,call,q);
+ end;
+ goto done;
+ end;
+end
+
+@ Similar routines are used to assign values to the numeric parameters.
+
+@<Assignments@>=
+assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
+ word_define(p,cur_val);
+ end;
+assign_dimen: begin p:=cur_chr; scan_optional_equals;
+ scan_normal_dimen; word_define(p,cur_val);
+ end;
+assign_glue,assign_mu_glue: begin p:=cur_chr; n:=cur_cmd; scan_optional_equals;
+ if n=assign_mu_glue then scan_glue(mu_val)@+else scan_glue(glue_val);
+ trap_zero_glue;
+ define(p,glue_ref,cur_val);
+ end;
+
+@ When a glue register or parameter becomes zero, it will always point to
+|zero_glue| because of the following procedure. (Exception: The tabskip
+glue isn't trapped while preambles are being scanned.)
+
+@<Declare subprocedures for |prefixed_command|@>=
+procedure trap_zero_glue;
+begin if (width(cur_val)=0)and(stretch(cur_val)=0)and(shrink(cur_val)=0) then
+ begin add_glue_ref(zero_glue);
+ delete_glue_ref(cur_val); cur_val:=zero_glue;
+ end;
+end;
+
+@ The various character code tables are changed by the |def_code| commands,
+and the font families are declared by |def_family|.
+
+@<Put each...@>=
+primitive("catcode",def_code,cat_code_base);
+@!@:cat_code_}{\.{\\catcode} primitive@>
+primitive("mathcode",def_code,math_code_base);
+@!@:math_code_}{\.{\\mathcode} primitive@>
+primitive("lccode",def_code,lc_code_base);
+@!@:lc_code_}{\.{\\lccode} primitive@>
+primitive("uccode",def_code,uc_code_base);
+@!@:uc_code_}{\.{\\uccode} primitive@>
+primitive("sfcode",def_code,sf_code_base);
+@!@:sf_code_}{\.{\\sfcode} primitive@>
+primitive("delcode",def_code,del_code_base);
+@!@:del_code_}{\.{\\delcode} primitive@>
+primitive("textfont",def_family,math_font_base);
+@!@:text_font_}{\.{\\textfont} primitive@>
+primitive("scriptfont",def_family,math_font_base+script_size);
+@!@:script_font_}{\.{\\scriptfont} primitive@>
+primitive("scriptscriptfont",def_family,math_font_base+script_script_size);
+@!@:script_script_font_}{\.{\\scriptscriptfont} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+def_code: if chr_code=cat_code_base then print_esc("catcode")
+ else if chr_code=math_code_base then print_esc("mathcode")
+ else if chr_code=lc_code_base then print_esc("lccode")
+ else if chr_code=uc_code_base then print_esc("uccode")
+ else if chr_code=sf_code_base then print_esc("sfcode")
+ else print_esc("delcode");
+def_family: print_size(chr_code-math_font_base);
+
+@ The different types of code values have different legal ranges; the
+following program is careful to check each case properly.
+
+@<Assignments@>=
+def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
+ p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+ if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
+ begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+ if p<del_code_base then print("), should be in the range 0..")
+ else print("), should be at most ");
+ print_int(n);
+ help1("I'm going to use 0 instead of that illegal code value.");@/
+ error; cur_val:=0;
+ end;
+ if p<math_code_base then define(p,data,cur_val)
+ else if p<del_code_base then define(p,data,hi(cur_val))
+ else word_define(p,cur_val);
+ end;
+
+@ @<Let |n| be the largest...@>=
+if cur_chr=cat_code_base then n:=max_char_code
+else if cur_chr=math_code_base then n:=@'100000
+else if cur_chr=sf_code_base then n:=@'77777
+else if cur_chr=del_code_base then n:=@'77777777
+else n:=255
+
+@ @<Assignments@>=
+def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val;
+ scan_optional_equals; scan_font_ident; define(p,data,cur_val);
+ end;
+
+@ Next we consider changes to \TeX's numeric registers.
+
+@<Assignments@>=
+register,advance,multiply,divide: do_register_command(a);
+
+@ We use the fact that |register<advance<multiply<divide|.
+
+@<Declare subprocedures for |prefixed_command|@>=
+procedure do_register_command(@!a:small_number);
+label found,exit;
+var l,@!q,@!r,@!s:pointer; {for list manipulation}
+@!p:int_val..mu_val; {type of register involved}
+begin q:=cur_cmd;
+@<Compute the register location |l| and its type |p|; but |return| if invalid@>;
+if q=register then scan_optional_equals
+else if scan_keyword("by") then do_nothing; {optional `\.{by}'}
+arith_error:=false;
+if q<multiply then @<Compute result of |register| or
+ |advance|, put it in |cur_val|@>
+else @<Compute result of |multiply| or |divide|, put it in |cur_val|@>;
+if arith_error then
+ begin print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+ help2("I can't carry out that multiplication or division,")@/
+ ("since the result is out of range.");
+ error; return;
+ end;
+if p<glue_val then word_define(l,cur_val)
+else begin trap_zero_glue; define(l,glue_ref,cur_val);
+ end;
+exit: end;
+
+@ Here we use the fact that the consecutive codes |int_val...mu_val| and
+|assign_int..assign_mu_glue| correspond to each other nicely.
+
+@<Compute the register location |l| and its type |p|...@>=
+begin if q<>register then
+ begin get_x_token;
+ if (cur_cmd>=assign_int)and(cur_cmd<=assign_mu_glue) then
+ begin l:=cur_chr; p:=cur_cmd-assign_int; goto found;
+ end;
+ if cur_cmd<>register then
+ begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr);
+@.You can't use x after ...@>
+ print("' after "); print_cmd_chr(q,0);
+ help1("I'm forgetting what you said and not changing anything.");
+ error; return;
+ end;
+ end;
+p:=cur_chr; scan_eight_bit_int;
+case p of
+int_val: l:=cur_val+count_base;
+dimen_val: l:=cur_val+scaled_base;
+glue_val: l:=cur_val+skip_base;
+mu_val: l:=cur_val+mu_skip_base;
+end; {there are no other cases}
+end;
+found:
+
+@ @<Compute result of |register| or |advance|...@>=
+if p<glue_val then
+ begin if p=int_val then scan_int@+else scan_normal_dimen;
+ if q=advance then cur_val:=cur_val+eqtb[l].int;
+ end
+else begin scan_glue(p);
+ if q=advance then @<Compute the sum of two glue specs@>;
+ end
+
+@ @<Compute the sum of two glue specs@>=
+begin q:=new_spec(cur_val); r:=equiv(l);
+delete_glue_ref(cur_val);
+width(q):=width(q)+width(r);
+if stretch(q)=0 then stretch_order(q):=normal;
+if stretch_order(q)=stretch_order(r) then stretch(q):=stretch(q)+stretch(r)
+else if (stretch_order(q)<stretch_order(r))and(stretch(r)<>0) then
+ begin stretch(q):=stretch(r); stretch_order(q):=stretch_order(r);
+ end;
+if shrink(q)=0 then shrink_order(q):=normal;
+if shrink_order(q)=shrink_order(r) then shrink(q):=shrink(q)+shrink(r)
+else if (shrink_order(q)<shrink_order(r))and(shrink(r)<>0) then
+ begin shrink(q):=shrink(r); shrink_order(q):=shrink_order(r);
+ end;
+cur_val:=q;
+end
+
+@ @<Compute result of |multiply| or |divide|...@>=
+begin scan_int;
+if p<glue_val then
+ if q=multiply then
+ if p=int_val then cur_val:=mult_integers(eqtb[l].int,cur_val)
+ else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0)
+ else cur_val:=x_over_n(eqtb[l].int,cur_val)
+else begin s:=equiv(l); r:=new_spec(s);
+ if q=multiply then
+ begin width(r):=nx_plus_y(width(s),cur_val,0);
+ stretch(r):=nx_plus_y(stretch(s),cur_val,0);
+ shrink(r):=nx_plus_y(shrink(s),cur_val,0);
+ end
+ else begin width(r):=x_over_n(width(s),cur_val);
+ stretch(r):=x_over_n(stretch(s),cur_val);
+ shrink(r):=x_over_n(shrink(s),cur_val);
+ end;
+ cur_val:=r;
+ end;
+end
+
+@ The processing of boxes is somewhat different, because we may need
+to scan and create an entire box before we actually change the value of the old
+one.
+
+@<Assignments@>=
+set_box: begin scan_eight_bit_int;
+ if global then n:=256+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+ else begin print_err("Improper "); print_esc("setbox");
+@.Improper \\setbox@>
+ help2("Sorry, \setbox is not allowed after \halign in a display,")@/
+ ("or between \accent and an accented character."); error;
+ end;
+ end;
+
+@ The |space_factor| or |prev_depth| settings are changed when a |set_aux|
+command is sensed. Similarly, |prev_graf| is changed in the presence of
+|set_prev_graf|, and |dead_cycles| or |insert_penalties| in the presence of
+|set_page_int|. These definitions are always global.
+
+When some dimension of a box register is changed, the change isn't exactly
+global; but \TeX\ does not look at the \.{\\global} switch.
+
+@<Assignments@>=
+set_aux:alter_aux;
+set_prev_graf:alter_prev_graf;
+set_page_dimen:alter_page_so_far;
+set_page_int:alter_integer;
+set_box_dimen:alter_box_dimen;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_aux;
+var c:halfword; {|hmode| or |vmode|}
+begin if cur_chr<>abs(mode) then report_illegal_case
+else begin c:=cur_chr; scan_optional_equals;
+ if c=vmode then
+ begin scan_normal_dimen; prev_depth:=cur_val;
+ end
+ else begin scan_int;
+ if (cur_val<=0)or(cur_val>32767) then
+ begin print_err("Bad space factor");
+@.Bad space factor@>
+ help1("I allow only values in the range 1..32767 here.");
+ int_error(cur_val);
+ end
+ else space_factor:=cur_val;
+ end;
+ end;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_prev_graf;
+var p:0..nest_size; {index into |nest|}
+begin nest[nest_ptr]:=cur_list; p:=nest_ptr;
+while abs(nest[p].mode_field)<>vmode do decr(p);
+scan_optional_equals; scan_int;
+if cur_val<0 then
+ begin print_err("Bad "); print_esc("prevgraf");
+@.Bad \\prevgraf@>
+ help1("I allow only nonnegative values here.");
+ int_error(cur_val);
+ end
+else begin nest[p].pg_field:=cur_val; cur_list:=nest[nest_ptr];
+ end;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_page_so_far;
+var c:0..7; {index into |page_so_far|}
+begin c:=cur_chr; scan_optional_equals; scan_normal_dimen;
+page_so_far[c]:=cur_val;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_integer;
+var c:0..1; {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+else insert_penalties:=cur_val;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_box_dimen;
+var c:small_number; {|width_offset| or |height_offset| or |depth_offset|}
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then mem[box(b)+c].sc:=cur_val;
+end;
+
+@ Paragraph shapes are set up in the obvious way.
+
+@<Assignments@>=
+set_shape: begin scan_optional_equals; scan_int; n:=cur_val;
+ if n<=0 then p:=null
+ else begin p:=get_node(2*n+1); info(p):=n;
+ for j:=1 to n do
+ begin scan_normal_dimen;
+ mem[p+2*j-1].sc:=cur_val; {indentation}
+ scan_normal_dimen;
+ mem[p+2*j].sc:=cur_val; {width}
+ end;
+ end;
+ define(par_shape_loc,shape_ref,p);
+ end;
+
+@ Here's something that isn't quite so obvious. It guarantees that
+|info(par_shape_ptr)| can hold any positive~|n| for which |get_node(2*n+1)|
+doesn't overflow the memory capacity.
+
+@<Check the ``constant''...@>=
+if 2*max_halfword<mem_top-mem_min then bad:=41;
+
+@ New hyphenation data is loaded by the |hyph_data| command.
+
+@<Put each...@>=
+primitive("hyphenation",hyph_data,0);
+@!@:hyphenation_}{\.{\\hyphenation} primitive@>
+primitive("patterns",hyph_data,1);
+@!@:patterns_}{\.{\\patterns} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+hyph_data: if chr_code=1 then print_esc("patterns")
+ else print_esc("hyphenation");
+
+@ @<Assignments@>=
+hyph_data: if cur_chr=1 then
+ begin @!init new_patterns; goto done;@;@+tini@/
+ print_err("Patterns can be loaded only by INITEX");
+@.Patterns can be...@>
+ help0; error;
+ repeat get_token; until cur_cmd=right_brace; {flush the patterns}
+ return;
+ end
+ else begin new_hyph_exceptions; goto done;
+ end;
+
+@ All of \TeX's parameters are kept in |eqtb| except the font information,
+the interaction mode, and the hyphenation tables; these are strictly global.
+
+@<Assignments@>=
+assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen; font_info[k].sc:=cur_val;
+ end;
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
+ end;
+
+@ @<Put each...@>=
+primitive("hyphenchar",assign_font_int,0);
+@!@:hyphen_char_}{\.{\\hyphenchar} primitive@>
+primitive("skewchar",assign_font_int,1);
+@!@:skew_char_}{\.{\\skewchar} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+assign_font_int: if chr_code=0 then print_esc("hyphenchar")
+ else print_esc("skewchar");
+
+@ Here is where the information for a new font gets loaded.
+
+@<Assignments@>=
+def_font: new_font(a);
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_font(@!a:small_number);
+label common_ending;
+var u:pointer; {user's font identifier}
+@!s:scaled; {stated ``at'' size, or negative of scaled magnification}
+@!f:internal_font_number; {runs through existing fonts}
+@!t:str_number; {name for the frozen font identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+@!flushable_string:str_number; {string not yet referenced}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+else if u>=single_base then
+ if u=null_cs then t:="FONT"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("FONT"); print(u-active_base); selector:=old_setting;
+@.FONTx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_font,null_font); scan_optional_equals; scan_file_name;
+@<Scan the font size specification@>;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s);
+common_ending: equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
+end;
+
+@ @<Scan the font size specification@>=
+name_in_progress:=true; {this keeps |cur_name| from being changed}
+if scan_keyword("at") then @<Put the \(p)(positive) `at' size into |s|@>
+@.at@>
+else if scan_keyword("scaled") then
+@.scaled@>
+ begin scan_int; s:=-cur_val;
+ if (cur_val<=0)or(cur_val>32768) then
+ begin print_err("Illegal magnification has been changed to 1000");@/
+@.Illegal magnification...@>
+ help1("The magnification ratio must be between 1 and 32768.");
+ int_error(cur_val); s:=-1000;
+ end;
+ end
+else s:=-1000;
+name_in_progress:=false
+
+@ @<Put the \(p)(positive) `at' size into |s|@>=
+begin scan_normal_dimen; s:=cur_val;
+if (s<=0)or(s>=@'1000000000) then
+ begin print_err("Improper `at' size (");
+ print_scaled(s); print("pt), replaced by 10pt");
+@.Improper `at' size...@>
+ help2("I can only handle fonts at positive sizes that are")@/
+ ("less than 2048pt, so I've changed what you said to 10pt.");
+ error; s:=10*unity;
+ end;
+end
+
+@ When the user gives a new identifier to a font that was previously loaded,
+the new name becomes the font identifier of record. Font names `\.{xyz}' and
+`\.{XYZ}' are considered to be different.
+
+@<If this font has already been loaded...@>=
+flushable_string:=str_ptr-1;
+for f:=font_base+1 to font_ptr do
+ if str_eq_str(font_name[f],cur_name)and str_eq_str(font_area[f],cur_area) then
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name[f];
+ end;
+ if s>0 then
+ begin if s=font_size[f] then goto common_ending;
+ end
+ else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
+ goto common_ending;
+ end
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_font:begin print("select font "); slow_print(font_name[chr_code]);
+ if font_size[chr_code]<>font_dsize[chr_code] then
+ begin print(" at "); print_scaled(font_size[chr_code]);
+ print("pt");
+ end;
+ end;
+
+@ @<Put each...@>=
+primitive("batchmode",set_interaction,batch_mode);
+@!@:batch_mode_}{\.{\\batchmode} primitive@>
+primitive("nonstopmode",set_interaction,nonstop_mode);
+@!@:nonstop_mode_}{\.{\\nonstopmode} primitive@>
+primitive("scrollmode",set_interaction,scroll_mode);
+@!@:scroll_mode_}{\.{\\scrollmode} primitive@>
+primitive("errorstopmode",set_interaction,error_stop_mode);
+@!@:error_stop_mode_}{\.{\\errorstopmode} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_interaction: case chr_code of
+ batch_mode: print_esc("batchmode");
+ nonstop_mode: print_esc("nonstopmode");
+ scroll_mode: print_esc("scrollmode");
+ othercases print_esc("errorstopmode")
+ endcases;
+
+@ @<Assignments@>=
+set_interaction: new_interaction;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_interaction;
+begin print_ln;
+interaction:=cur_chr;
+@<Initialize the print |selector| based on |interaction|@>;
+if log_opened then selector:=selector+2;
+end;
+
+@ The \.{\\afterassignment} command puts a token into the global
+variable |after_token|. This global variable is examined just after
+every assignment has been performed.
+
+@<Glob...@>=
+@!after_token:halfword; {zero, or a saved token}
+
+@ @<Set init...@>=
+after_token:=0;
+
+@ @<Cases of |main_control| that don't...@>=
+any_mode(after_assignment):begin get_token; after_token:=cur_tok;
+ end;
+
+@ @<Insert a token saved by \.{\\afterassignment}, if any@>=
+if after_token<>0 then
+ begin cur_tok:=after_token; back_input; after_token:=0;
+ end
+
+@ Here is a procedure that might be called `Get the next non-blank non-relax
+non-call non-assignment token'.
+
+@<Declare act...@>=
+procedure do_assignments;
+label exit;
+begin loop begin @<Get the next non-blank non-relax...@>;
+ if cur_cmd<=max_non_prefixed_command then return;
+ set_box_allowed:=false; prefixed_command; set_box_allowed:=true;
+ end;
+exit:end;
+
+@ @<Cases of |main_control| that don't...@>=
+any_mode(after_group):begin get_token; save_for_after(cur_tok);
+ end;
+
+@ Files for \.{\\read} are opened and closed by the |in_stream| command.
+
+@<Put each...@>=
+primitive("openin",in_stream,1);
+@!@:open_in_}{\.{\\openin} primitive@>
+primitive("closein",in_stream,0);
+@!@:close_in_}{\.{\\closein} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+in_stream: if chr_code=0 then print_esc("closein")
+ else print_esc("openin");
+
+@ @<Cases of |main_control| that don't...@>=
+any_mode(in_stream): open_or_close_in;
+
+@ @<Declare act...@>=
+procedure open_or_close_in;
+var c:0..1; {1 for \.{\\openin}, 0 for \.{\\closein}}
+@!n:0..15; {stream number}
+begin c:=cur_chr; scan_four_bit_int; n:=cur_val;
+if read_open[n]<>closed then
+ begin a_close(read_file[n]); read_open[n]:=closed;
+ end;
+if c<>0 then
+ begin scan_optional_equals; scan_file_name;
+ if cur_ext="" then cur_ext:=".tex";
+ pack_cur_name;
+ if a_open_in(read_file[n]) then read_open[n]:=just_open;
+ end;
+end;
+
+@ The user can issue messages to the terminal, regardless of the
+current mode.
+
+@<Cases of |main_control| that don't...@>=
+any_mode(message):issue_message;
+
+@ @<Put each...@>=
+primitive("message",message,0);
+@!@:message_}{\.{\\message} primitive@>
+primitive("errmessage",message,1);
+@!@:err_message_}{\.{\\errmessage} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+message: if chr_code=0 then print_esc("message")
+ else print_esc("errmessage");
+
+@ @<Declare act...@>=
+procedure issue_message;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!c:0..1; {identifies \.{\\message} and \.{\\errmessage}}
+@!s:str_number; {the message}
+begin c:=cur_chr; link(garbage):=scan_toks(false,true);
+old_setting:=selector; selector:=new_string;
+token_show(def_ref); selector:=old_setting;
+flush_list(def_ref);
+str_room(1); s:=make_string;
+if c=0 then @<Print string |s| on the terminal@>
+else @<Print string |s| as an error message@>;
+flush_string;
+end;
+
+@ @<Print string |s| on the terminal@>=
+begin if term_offset+length(s)>max_print_line-2 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+slow_print(s); update_terminal;
+end
+
+@ If \.{\\errmessage} occurs often in |scroll_mode|, without user-defined
+\.{\\errhelp}, we don't want to give a long help message each time. So we
+give a verbose explanation only once.
+
+@<Glob...@>=
+@!long_help_seen:boolean; {has the long \.{\\errmessage} help been used?}
+
+@ @<Set init...@>=long_help_seen:=false;
+
+@ @<Print string |s| as an error message@>=
+begin print_err(""); slow_print(s);
+if err_help<>null then use_err_help:=true
+else if long_help_seen then help1("(That was another \errmessage.)")
+else begin if interaction<error_stop_mode then long_help_seen:=true;
+ help4("This error message was generated by an \errmessage")@/
+ ("command, so I can't give any explicit help.")@/
+ ("Pretend that you're Hercule Poirot: Examine all clues,")@/
+@^Poirot, Hercule@>
+ ("and deduce the truth by order and method.");
+ end;
+error; use_err_help:=false;
+end
+
+@ The |error| routine calls on |give_err_help| if help is requested from
+the |err_help| parameter.
+
+@p procedure give_err_help;
+begin token_show(err_help);
+end;
+
+@ The \.{\\uppercase} and \.{\\lowercase} commands are implemented by
+building a token list and then changing the cases of the letters in it.
+
+@<Cases of |main_control| that don't...@>=
+any_mode(case_shift):shift_case;
+
+@ @<Put each...@>=
+primitive("lowercase",case_shift,lc_code_base);
+@!@:lowercase_}{\.{\\lowercase} primitive@>
+primitive("uppercase",case_shift,uc_code_base);
+@!@:uppercase_}{\.{\\uppercase} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+case_shift:if chr_code=lc_code_base then print_esc("lowercase")
+ else print_esc("uppercase");
+
+@ @<Declare act...@>=
+procedure shift_case;
+var b:pointer; {|lc_code_base| or |uc_code_base|}
+@!p:pointer; {runs through the token list}
+@!t:halfword; {token}
+@!c:eight_bits; {character code}
+begin b:=cur_chr; p:=scan_toks(false,false); p:=link(def_ref);
+while p<>null do
+ begin @<Change the case of the token in |p|, if a change is appropriate@>;
+ p:=link(p);
+ end;
+back_list(link(def_ref)); free_avail(def_ref); {omit reference count}
+end;
+
+@ When the case of a |chr_code| changes, we don't change the |cmd|.
+We also change active characters, using the fact that
+|cs_token_flag+active_base| is a multiple of~256.
+@^data structure assumptions@>
+
+@<Change the case of the token in |p|, if a change is appropriate@>=
+t:=info(p);
+if t<cs_token_flag+single_base then
+ begin c:=t mod 256;
+ if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c);
+ end
+
+@ We come finally to the last pieces missing from |main_control|, namely the
+`\.{\\show}' commands that are useful when debugging.
+
+@<Cases of |main_control| that don't...@>=
+any_mode(xray): show_whatever;
+
+@ @d show_code=0 { \.{\\show} }
+@d show_box_code=1 { \.{\\showbox} }
+@d show_the_code=2 { \.{\\showthe} }
+@d show_lists=3 { \.{\\showlists} }
+
+@<Put each...@>=
+primitive("show",xray,show_code);
+@!@:show_}{\.{\\show} primitive@>
+primitive("showbox",xray,show_box_code);
+@!@:show_box_}{\.{\\showbox} primitive@>
+primitive("showthe",xray,show_the_code);
+@!@:show_the_}{\.{\\showthe} primitive@>
+primitive("showlists",xray,show_lists);
+@!@:show_lists_}{\.{\\showlists} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+xray: case chr_code of
+ show_box_code:print_esc("showbox");
+ show_the_code:print_esc("showthe");
+ show_lists:print_esc("showlists");
+ othercases print_esc("show")
+ endcases;
+
+@ @<Declare act...@>=
+procedure show_whatever;
+label common_ending;
+var p:pointer; {tail of a token list to show}
+begin case cur_chr of
+show_lists: begin begin_diagnostic; show_activities;
+ end;
+show_box_code: @<Show the current contents of a box@>;
+show_code: @<Show the current meaning of a token, then |goto common_ending|@>;
+othercases @<Show the current value of some parameter or register,
+ then |goto common_ending|@>
+endcases;@/
+@<Complete a potentially long \.{\\show} command@>;
+common_ending: if interaction<error_stop_mode then
+ begin help0; decr(error_count);
+ end
+else if tracing_online>0 then
+ begin@t@>@;@/
+ help3("This isn't an error message; I'm just \showing something.")@/
+ ("Type `I\show...' to show more (e.g., \show\cs,")@/
+ ("\showthe\count10, \showbox255, \showlists).");
+ end
+else begin@t@>@;@/
+ help5("This isn't an error message; I'm just \showing something.")@/
+ ("Type `I\show...' to show more (e.g., \show\cs,")@/
+ ("\showthe\count10, \showbox255, \showlists).")@/
+ ("And type `I\tracingonline=1\show...' to show boxes and")@/
+ ("lists on your terminal as well as in the transcript file.");
+ end;
+error;
+end;
+
+@ @<Show the current meaning of a token...@>=
+begin get_token;
+if interaction=error_stop_mode then wake_up_terminal;
+print_nl("> ");
+if cur_cs<>0 then
+ begin sprint_cs(cur_cs); print_char("=");
+ end;
+print_meaning; goto common_ending;
+end
+
+@ @<Cases of |print_cmd_chr|...@>=
+undefined_cs: print("undefined");
+call: print("macro");
+long_call: print_esc("long macro");
+outer_call: print_esc("outer macro");
+long_outer_call: begin print_esc("long"); print_esc("outer macro");
+ end;
+end_template: print_esc("outer endtemplate");
+
+@ @<Show the current contents of a box@>=
+begin scan_eight_bit_int; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+end
+
+@ @<Show the current value of some parameter...@>=
+begin p:=the_toks;
+if interaction=error_stop_mode then wake_up_terminal;
+print_nl("> "); token_show(temp_head);
+flush_list(link(temp_head)); goto common_ending;
+end
+
+@ @<Complete a potentially long \.{\\show} command@>=
+end_diagnostic(true); print_err("OK");
+@.OK@>
+if selector=term_and_log then if tracing_online<=0 then
+ begin selector:=term_only; print(" (see the transcript file)");
+ selector:=term_and_log;
+ end
+
+@* \[50] Dumping and undumping the tables.
+After \.{INITEX} has seen a collection of fonts and macros, it
+can write all the necessary information on an auxiliary file so
+that production versions of \TeX\ are able to initialize their
+memory at high speed. The present section of the program takes
+care of such output and input. We shall consider simultaneously
+the processes of storing and restoring,
+so that the inverse relation between them is clear.
+@.INITEX@>
+
+The global variable |format_ident| is a string that is printed right
+after the |banner| line when \TeX\ is ready to start. For \.{INITEX} this
+string says simply `\.{(INITEX)}'; for other versions of \TeX\ it says,
+for example, `\.{(preloaded format=plain 82.11.19)}', showing the year,
+month, and day that the format file was created. We have |format_ident=0|
+before \TeX's tables are loaded.
+
+@<Glob...@>=
+@!format_ident:str_number;
+
+@ @<Set init...@>=
+format_ident:=0;
+
+@ @<Initialize table entries...@>=
+format_ident:=" (INITEX)";
+
+@ @<Declare act...@>=
+@!init procedure store_fmt_file;
+label found1,found2,done1,done2;
+var j,@!k,@!l:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something to dump}
+@!w: four_quarters; {four ASCII codes}
+begin @<If dumping is not allowed, abort@>;
+@<Create the |format_ident|, open the format file,
+ and inform the user that dumping has begun@>;
+@<Dump constants for consistency check@>;
+@<Dump the string pool@>;
+@<Dump the dynamic memory@>;
+@<Dump the table of equivalents@>;
+@<Dump the font information@>;
+@<Dump the hyphenation tables@>;
+@<Dump a couple more things and the closing check word@>;
+@<Close the format file@>;
+end;
+tini
+
+@ Corresponding to the procedure that dumps a format file, we have a function
+that reads one in. The function returns |false| if the dumped format is
+incompatible with the present \TeX\ table sizes, etc.
+
+@d bad_fmt=6666 {go here if the format file is unacceptable}
+@d too_small(#)==begin wake_up_terminal;
+ wterm_ln('---! Must increase the ',#);
+@.Must increase the x@>
+ goto bad_fmt;
+ end
+
+@p @t\4@>@<Declare the function called |open_fmt_file|@>@;
+function load_fmt_file:boolean;
+label bad_fmt,exit;
+var j,@!k:integer; {all-purpose indices}
+@!p,@!q: pointer; {all-purpose pointers}
+@!x: integer; {something undumped}
+@!w: four_quarters; {four ASCII codes}
+begin @<Undump constants for consistency check@>;
+@<Undump the string pool@>;
+@<Undump the dynamic memory@>;
+@<Undump the table of equivalents@>;
+@<Undump the font information@>;
+@<Undump the hyphenation tables@>;
+@<Undump a couple more things and the closing check word@>;
+load_fmt_file:=true; return; {it worked!}
+bad_fmt: wake_up_terminal;
+ wterm_ln('(Fatal format file error; I''m stymied)');
+@.Fatal format file error@>
+load_fmt_file:=false;
+exit:end;
+
+@ The user is not allowed to dump a format file unless |save_ptr=0|.
+This condition implies that |cur_level=level_one|, hence
+the |xeq_level| array is constant and it need not be dumped.
+
+@<If dumping is not allowed, abort@>=
+if save_ptr<>0 then
+ begin print_err("You can't dump inside a group");
+@.You can't dump...@>
+ help1("`{...\dump}' is a no-no."); succumb;
+ end
+
+@ Format files consist of |memory_word| items, and we use the following
+macros to dump words of different types:
+
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+
+@<Glob...@>=
+@!fmt_file:word_file; {for input or output of format information}
+
+@ The inverse macros are slightly more complicated, since we need to check
+the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
+read an integer value |x| that is supposed to be in the range |a<=x<=b|.
+
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@d undump_end_end(#)==#:=x;@+end
+@d undump_end(#)==(x>#) then goto bad_fmt@+else undump_end_end
+@d undump(#)==begin undump_int(x); if (x<#) or undump_end
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@d undump_size_end(#)==if x># then undump_size_end_end
+@d undump_size(#)==begin undump_int(x);
+ if x<# then goto bad_fmt; undump_size_end
+
+@ The next few sections of the program should make it clear how we use the
+dump/undump macros.
+
+@<Dump constants for consistency check@>=
+dump_int(@$);@/
+dump_int(mem_bot);@/
+dump_int(mem_top);@/
+dump_int(eqtb_size);@/
+dump_int(hash_prime);@/
+dump_int(hyph_size)
+
+@ Sections of a \.{WEB} program that are ``commented out'' still contribute
+strings to the string pool; therefore \.{INITEX} and \TeX\ will have
+the same strings. (And it is, of course, a good thing that they do.)
+@.WEB@>
+@^string pool@>
+
+@<Undump constants for consistency check@>=
+x:=fmt_file^.int;
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+undump_int(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(x);
+if x<>mem_top then goto bad_fmt;
+undump_int(x);
+if x<>eqtb_size then goto bad_fmt;
+undump_int(x);
+if x<>hash_prime then goto bad_fmt;
+undump_int(x);
+if x<>hyph_size then goto bad_fmt
+
+@ @d dump_four_ASCII==
+ w.b0:=qi(so(str_pool[k])); w.b1:=qi(so(str_pool[k+1]));
+ w.b2:=qi(so(str_pool[k+2])); w.b3:=qi(so(str_pool[k+3]));
+ dump_qqqq(w)
+
+@<Dump the string pool@>=
+dump_int(pool_ptr);
+dump_int(str_ptr);
+for k:=0 to str_ptr do dump_int(str_start[k]);
+k:=0;
+while k+4<pool_ptr do
+ begin dump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; dump_four_ASCII;
+print_ln; print_int(str_ptr); print(" strings of total length ");
+print_int(pool_ptr)
+
+@ @d undump_four_ASCII==
+ undump_qqqq(w);
+ str_pool[k]:=si(qo(w.b0)); str_pool[k+1]:=si(qo(w.b1));
+ str_pool[k+2]:=si(qo(w.b2)); str_pool[k+3]:=si(qo(w.b3))
+
+@<Undump the string pool@>=
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings)('max strings')(str_ptr);
+for k:=0 to str_ptr do undump(0)(pool_ptr)(str_start[k]);
+k:=0;
+while k+4<pool_ptr do
+ begin undump_four_ASCII; k:=k+4;
+ end;
+k:=pool_ptr-4; undump_four_ASCII;
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr
+
+@ By sorting the list of available spaces in the variable-size portion of
+|mem|, we are usually able to get by without having to dump very much
+of the dynamic memory.
+
+We recompute |var_used| and |dyn_used|, so that \.{INITEX} dumps valid
+information even when it has not been gathering statistics.
+
+@<Dump the dynamic memory@>=
+sort_avail; var_used:=0;
+dump_int(lo_mem_max); dump_int(rover);
+p:=mem_bot; q:=rover; x:=0;
+repeat for k:=p to q+1 do dump_wd(mem[k]);
+x:=x+q+2-p; var_used:=var_used+q-p;
+p:=q+node_size(q); q:=rlink(q);
+until q=rover;
+var_used:=var_used+lo_mem_max-p; dyn_used:=mem_end+1-hi_mem_min;@/
+for k:=p to lo_mem_max do dump_wd(mem[k]);
+x:=x+lo_mem_max+1-p;
+dump_int(hi_mem_min); dump_int(avail);
+for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
+x:=x+mem_end+1-hi_mem_min;
+p:=avail;
+while p<>null do
+ begin decr(dyn_used); p:=link(p);
+ end;
+dump_int(var_used); dump_int(dyn_used);
+print_ln; print_int(x);
+print(" memory locations dumped; current usage is ");
+print_int(var_used); print_char("&"); print_int(dyn_used)
+
+@ @<Undump the dynamic memory@>=
+undump(lo_mem_stat_max+1000)(hi_mem_stat_min-1)(lo_mem_max);
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+p:=mem_bot; q:=rover;
+repeat for k:=p to q+1 do undump_wd(mem[k]);
+p:=q+node_size(q);
+if (p>lo_mem_max)or((q>=rlink(q))and(rlink(q)<>rover)) then goto bad_fmt;
+q:=rlink(q);
+until q=rover;
+for k:=p to lo_mem_max do undump_wd(mem[k]);
+if mem_min<mem_bot-2 then {make more low memory available}
+ begin p:=llink(rover); q:=mem_min+1;
+ link(mem_min):=null; info(mem_min):=null; {we don't use the bottom word}
+ rlink(p):=q; llink(rover):=q;@/
+ rlink(q):=rover; llink(q):=p; link(q):=empty_flag;
+ node_size(q):=mem_bot-q;
+ end;
+undump(lo_mem_max+1)(hi_mem_stat_min)(hi_mem_min);
+undump(null)(mem_top)(avail); mem_end:=mem_top;
+for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
+undump_int(var_used); undump_int(dyn_used)
+
+@ @<Dump the table of equivalents@>=
+@<Dump regions 1 to 4 of |eqtb|@>;
+@<Dump regions 5 and 6 of |eqtb|@>;
+dump_int(par_loc); dump_int(write_loc);@/
+@<Dump the hash table@>
+
+@ @<Undump the table of equivalents@>=
+@<Undump regions 1 to 6 of |eqtb|@>;
+undump(hash_base)(frozen_control_sequence)(par_loc);
+par_token:=cs_token_flag+par_loc;@/
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+@<Undump the hash table@>
+
+@ The table of equivalents usually contains repeated information, so we dump it
+in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the
+format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra
+copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$.
+
+@<Dump regions 1 to 4 of |eqtb|@>=
+k:=active_base;
+repeat j:=k;
+while j<int_base-1 do
+ begin if (equiv(j)=equiv(j+1))and(eq_type(j)=eq_type(j+1))and@|
+ (eq_level(j)=eq_level(j+1)) then goto found1;
+ incr(j);
+ end;
+l:=int_base; goto done1; {|j=int_base-1|}
+found1: incr(j); l:=j;
+while j<int_base-1 do
+ begin if (equiv(j)<>equiv(j+1))or(eq_type(j)<>eq_type(j+1))or@|
+ (eq_level(j)<>eq_level(j+1)) then goto done1;
+ incr(j);
+ end;
+done1:dump_int(l-k);
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+k:=j+1; dump_int(k-l);
+until k=int_base
+
+@ @<Dump regions 5 and 6 of |eqtb|@>=
+repeat j:=k;
+while j<eqtb_size do
+ begin if eqtb[j].int=eqtb[j+1].int then goto found2;
+ incr(j);
+ end;
+l:=eqtb_size+1; goto done2; {|j=eqtb_size|}
+found2: incr(j); l:=j;
+while j<eqtb_size do
+ begin if eqtb[j].int<>eqtb[j+1].int then goto done2;
+ incr(j);
+ end;
+done2:dump_int(l-k);
+while k<l do
+ begin dump_wd(eqtb[k]); incr(k);
+ end;
+k:=j+1; dump_int(k-l);
+until k>eqtb_size
+
+@ @<Undump regions 1 to 6 of |eqtb|@>=
+k:=active_base;
+repeat undump_int(x);
+if (x<1)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do undump_wd(eqtb[j]);
+k:=k+x;
+undump_int(x);
+if (x<0)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do eqtb[j]:=eqtb[k-1];
+k:=k+x;
+until k>eqtb_size
+
+@ A different scheme is used to compress the hash table, since its lower
+region is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output
+two words, |p| and |hash[p]|. The hash table is, of course, densely packed
+for |p>=hash_used|, so the remaining entries are output in a~block.
+
+@<Dump the hash table@>=
+dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used;
+for p:=hash_base to hash_used do if text(p)<>0 then
+ begin dump_int(p); dump_hh(hash[p]); incr(cs_count);
+ end;
+for p:=hash_used+1 to undefined_control_sequence-1 do dump_hh(hash[p]);
+dump_int(cs_count);@/
+print_ln; print_int(cs_count); print(" multiletter control sequences")
+
+@ @<Undump the hash table@>=
+undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1;
+repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]);
+until p=hash_used;
+for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]);
+undump_int(cs_count)
+
+@ @<Dump the font information@>=
+dump_int(fmem_ptr);
+for k:=0 to fmem_ptr-1 do dump_wd(font_info[k]);
+dump_int(font_ptr);
+for k:=null_font to font_ptr do
+ @<Dump the array info for internal font number |k|@>;
+print_ln; print_int(fmem_ptr-7); print(" words of font info for ");
+print_int(font_ptr-font_base); print(" preloaded font");
+if font_ptr<>font_base+1 then print_char("s")
+
+@ @<Undump the font information@>=
+undump_size(7)(font_mem_size)('font mem size')(fmem_ptr);
+for k:=0 to fmem_ptr-1 do undump_wd(font_info[k]);
+undump_size(font_base)(font_max)('font max')(font_ptr);
+for k:=null_font to font_ptr do
+ @<Undump the array info for internal font number |k|@>
+
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_qqqq(font_check[k]);
+dump_int(font_size[k]);
+dump_int(font_dsize[k]);
+dump_int(font_params[k]);@/
+dump_int(hyphen_char[k]);
+dump_int(skew_char[k]);@/
+dump_int(font_name[k]);
+dump_int(font_area[k]);@/
+dump_int(font_bc[k]);
+dump_int(font_ec[k]);@/
+dump_int(char_base[k]);
+dump_int(width_base[k]);
+dump_int(height_base[k]);@/
+dump_int(depth_base[k]);
+dump_int(italic_base[k]);
+dump_int(lig_kern_base[k]);@/
+dump_int(kern_base[k]);
+dump_int(exten_base[k]);
+dump_int(param_base[k]);@/
+dump_int(font_glue[k]);@/
+dump_int(bchar_label[k]);
+dump_int(font_bchar[k]);
+dump_int(font_false_bchar[k]);@/
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(font_name[k],font_area[k],"");
+if font_size[k]<>font_dsize[k] then
+ begin print(" at "); print_scaled(font_size[k]); print("pt");
+ end;
+end
+
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_qqqq(font_check[k]);@/
+undump_int(font_size[k]);
+undump_int(font_dsize[k]);
+undump(min_halfword)(max_halfword)(font_params[k]);@/
+undump_int(hyphen_char[k]);
+undump_int(skew_char[k]);@/
+undump(0)(str_ptr)(font_name[k]);
+undump(0)(str_ptr)(font_area[k]);@/
+undump(0)(255)(font_bc[k]);
+undump(0)(255)(font_ec[k]);@/
+undump_int(char_base[k]);
+undump_int(width_base[k]);
+undump_int(height_base[k]);@/
+undump_int(depth_base[k]);
+undump_int(italic_base[k]);
+undump_int(lig_kern_base[k]);@/
+undump_int(kern_base[k]);
+undump_int(exten_base[k]);
+undump_int(param_base[k]);@/
+undump(min_halfword)(lo_mem_max)(font_glue[k]);@/
+undump(0)(fmem_ptr-1)(bchar_label[k]);
+undump(min_quarterword)(non_char)(font_bchar[k]);
+undump(min_quarterword)(non_char)(font_false_bchar[k]);
+end
+
+@ @<Dump the hyphenation tables@>=
+dump_int(hyph_count);
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k); dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+print_ln; print_int(hyph_count); print(" hyphenation exception");
+if hyph_count<>1 then print_char("s");
+if trie_not_ready then init_trie;
+dump_int(trie_max);
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(trie_op_ptr);
+for k:=1 to trie_op_ptr do
+ begin dump_int(hyf_distance[k]);
+ dump_int(hyf_num[k]);
+ dump_int(hyf_next[k]);
+ end;
+print_nl("Hyphenation trie of length "); print_int(trie_max);
+@.Hyphenation trie...@>
+print(" has "); print_int(trie_op_ptr); print(" op");
+if trie_op_ptr<>1 then print_char("s");
+print(" out of "); print_int(trie_op_size);
+for k:=255 downto 0 do if trie_used[k]>min_quarterword then
+ begin print_nl(" "); print_int(qo(trie_used[k]));
+ print(" for language "); print_int(k);
+ dump_int(k); dump_int(qo(trie_used[k]));
+ end
+
+@ Only ``nonempty'' parts of |op_start| need to be restored.
+
+@<Undump the hyphenation tables@>=
+undump(0)(hyph_size)(hyph_count);
+for k:=1 to hyph_count do
+ begin undump(0)(hyph_size)(j);
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+for k:=0 to j do undump_hh(trie[k]);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+for k:=1 to j do
+ begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
+ undump(0)(63)(hyf_num[k]);
+ undump(min_quarterword)(max_quarterword)(hyf_next[k]);
+ end;
+init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/
+k:=256;
+while j>0 do
+ begin undump(0)(k-1)(k); undump(1)(j)(x);@+init trie_used[k]:=qi(x);@+tini@;@/
+ j:=j-x; op_start[k]:=qo(j);
+ end;
+@!init trie_not_ready:=false @+tini
+
+@ We have already printed a lot of statistics, so we set |tracing_stats:=0|
+to prevent them from appearing again.
+
+@<Dump a couple more things and the closing check word@>=
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+tracing_stats:=0
+
+@ @<Undump a couple more things and the closing check word@>=
+undump(batch_mode)(error_stop_mode)(interaction);
+undump(0)(str_ptr)(format_ident);
+undump_int(x);
+if (x<>69069)or eof(fmt_file) then goto bad_fmt
+
+@ @<Create the |format_ident|...@>=
+selector:=new_string;
+print(" (preloaded format="); print(job_name); print_char(" ");
+print_int(year); print_char(".");
+print_int(month); print_char("."); print_int(day); print_char(")");
+if interaction=batch_mode then selector:=log_only
+else selector:=term_and_log;
+str_room(1);
+format_ident:=make_string;
+pack_job_name(format_extension);
+while not w_open_out(fmt_file) do
+ prompt_file_name("format file name",format_extension);
+print_nl("Beginning to dump on file ");
+@.Beginning to dump...@>
+slow_print(w_make_name_string(fmt_file)); flush_string;
+print_nl(""); slow_print(format_ident)
+
+@ @<Close the format file@>=
+w_close(fmt_file)
+
+@* \[51] The main program.
+This is it: the part of \TeX\ that executes all those procedures we have
+written.
+
+Well---almost. Let's leave space for a few more routines that we may
+have forgotten.
+
+@p @<Last-minute procedures@>
+
+@ We have noted that there are two versions of \TeX82. One, called \.{INITEX},
+@.INITEX@>
+has to be run first; it initializes everything from scratch, without
+reading a format file, and it has the capability of dumping a format file.
+The other one is called `\.{VIRTEX}'; it is a ``virgin'' program that needs
+@.VIRTEX@>
+to input a format file in order to get started. \.{VIRTEX} typically has
+more memory capacity than \.{INITEX}, because it does not need the space
+consumed by the auxiliary hyphenation tables and the numerous calls on
+|primitive|, etc.
+
+The \.{VIRTEX} program cannot read a format file instantaneously, of course;
+the best implementations therefore allow for production versions of \TeX\ that
+not only avoid the loading routine for \PASCAL\ object code, they also have
+a format file pre-loaded. This is impossible to do if we stick to standard
+\PASCAL; but there is a simple way to fool many systems into avoiding the
+initialization, as follows:\quad(1)~We declare a global integer variable
+called |ready_already|. The probability is negligible that this
+variable holds any particular value like 314159 when \.{VIRTEX} is first
+loaded.\quad(2)~After we have read in a format file and initialized
+everything, we set |ready_already:=314159|.\quad(3)~Soon \.{VIRTEX}
+will print `\.*', waiting for more input; and at this point we
+interrupt the program and save its core image in some form that the
+operating system can reload speedily.\quad(4)~When that core image is
+activated, the program starts again at the beginning; but now
+|ready_already=314159| and all the other global variables have
+their initial values too. The former chastity has vanished!
+
+In other words, if we allow ourselves to test the condition
+|ready_already=314159|, before |ready_already| has been
+assigned a value, we can avoid the lengthy initialization. Dirty tricks
+rarely pay off so handsomely.
+@^dirty \PASCAL@>
+@^system dependencies@>
+
+On systems that allow such preloading, the standard program called \.{TeX}
+should be the one that has \.{plain} format preloaded, since that agrees
+with {\sl The \TeX book}. Other versions, e.g., \.{AmSTeX}, should also
+@:TeXbook}{\sl The \TeX book@>
+@.AmSTeX@>
+@.plain@>
+be provided for commonly used formats.
+
+@<Glob...@>=
+@!ready_already:integer; {a sacrifice of purity for economy}
+
+@ Now this is really it: \TeX\ starts and ends here.
+
+The initial test involving |ready_already| should be deleted if the
+\PASCAL\ runtime system is smart enough to detect such a ``mistake.''
+@^system dependencies@>
+
+@p begin @!{|start_here|}
+history:=fatal_error_stop; {in case we quit during initialization}
+t_open_out; {open the terminal for output}
+if ready_already=314159 then goto start_of_TEX;
+@<Check the ``constant'' values...@>@;
+if bad>0 then
+ begin wterm_ln('Ouch---my internal constants have been clobbered!',
+ '---case ',bad:1);
+@.Ouch...clobbered@>
+ goto final_end;
+ end;
+initialize; {set global variables to their starting values}
+@!init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+ready_already:=314159;
+start_of_TEX: @<Initialize the output routines@>;
+@<Get the first line of input and prepare to start@>;
+history:=spotless; {ready to go!}
+main_control; {come to life}
+final_cleanup; {prepare for death}
+end_of_TEX: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+
+@ Here we do whatever is needed to complete \TeX's job gracefully on the
+local operating system. The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+|str_room| or |make_string| at this time, because a call on |overflow|
+might lead to an infinite loop.
+@^system dependencies@>
+
+Actually there's one way to get error messages, via |prepare_mag|;
+but that can't cause infinite recursion.
+@^recursion@>
+
+This program doesn't bother to close the input files that may still be open.
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+if log_opened then
+ begin wlog_cr; a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+@.Transcript written...@>
+ slow_print(log_name); print_char(".");
+ end;
+ end;
+end;
+
+@ The present section goes directly to the log file instead of using
+|print| commands, because there's no need for these strings to take
+up |str_pool| memory when a non-{\bf stat} version of \TeX\ is being used.
+
+@<Output statistics...@>=
+if log_opened then
+ begin wlog_ln(' ');
+ wlog_ln('Here is how much of TeX''s memory',' you used:');
+@.Here is how much...@>
+ wlog(' ',str_ptr-init_str_ptr:1,' string');
+ if str_ptr<>init_str_ptr+1 then wlog('s');
+ wlog_ln(' out of ', max_strings-init_str_ptr:1);@/
+ wlog_ln(' ',pool_ptr-init_pool_ptr:1,' string characters out of ',
+ pool_size-init_pool_ptr:1);@/
+ wlog_ln(' ',lo_mem_max-mem_min+mem_end-hi_mem_min+2:1,@|
+ ' words of memory out of ',mem_end+1-mem_min:1);@/
+ wlog_ln(' ',cs_count:1,' multiletter control sequences out of ',
+ hash_size:1);@/
+ wlog(' ',fmem_ptr:1,' words of font info for ',
+ font_ptr-font_base:1,' font');
+ if font_ptr<>font_base+1 then wlog('s');
+ wlog_ln(', out of ',font_mem_size:1,' for ',font_max-font_base:1);@/
+ wlog(' ',hyph_count:1,' hyphenation exception');
+ if hyph_count<>1 then wlog('s');
+ wlog_ln(' out of ',hyph_size:1);@/
+ wlog_ln(' ',max_in_stack:1,'i,',max_nest_stack:1,'n,',@|
+ max_param_stack:1,'p,',@|
+ max_buf_stack+1:1,'b,',@|
+ max_save_stack+6:1,'s stack positions out of ',@|
+ stack_size:1,'i,',
+ nest_size:1,'n,',
+ param_size:1,'p,',
+ buf_size:1,'b,',
+ save_size:1,'s');
+ end
+
+@ We get to the |final_cleanup| routine when \.{\\end} or \.{\\dump} has
+been scanned and |its_all_over|\kern-2pt.
+
+@<Last-minute...@>=
+procedure final_cleanup;
+label exit;
+var c:small_number; {0 for \.{\\end}, 1 for \.{\\dump}}
+begin c:=cur_chr;
+if job_name=0 then open_log_file;
+while input_ptr>0 do
+ if state=token_list then end_token_list@+else end_file_reading;
+while open_parens>0 do
+ begin print(" )"); decr(open_parens);
+ end;
+if cur_level>level_one then
+ begin print_nl("("); print_esc("end occurred ");
+ print("inside a group at level ");
+@:end_}{\.{(\\end occurred...)}@>
+ print_int(cur_level-level_one); print_char(")");
+ end;
+while cond_ptr<>null do
+ begin print_nl("("); print_esc("end occurred ");
+ print("when "); print_cmd_chr(if_test,cur_if);
+ if if_line<>0 then
+ begin print(" on line "); print_int(if_line);
+ end;
+ print(" was incomplete)");
+ if_line:=if_line_field(cond_ptr);
+ cur_if:=subtype(cond_ptr); temp_ptr:=cond_ptr;
+ cond_ptr:=link(cond_ptr); free_node(temp_ptr,if_node_size);
+ end;
+if history<>spotless then
+ if ((history=warning_issued)or(interaction<error_stop_mode)) then
+ if selector=term_and_log then
+ begin selector:=term_only;
+ print_nl("(see the transcript file for additional information)");
+@.see the transcript file...@>
+ selector:=term_and_log;
+ end;
+if c=1 then
+ begin @!init for c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ store_fmt_file; return;@+tini@/
+ print_nl("(\dump is performed only by INITEX)"); return;
+@:dump_}{\.{\\dump...only by INITEX}@>
+ end;
+exit:end;
+
+@ @<Last-minute...@>=
+@!init procedure init_prim; {initialize all the primitives}
+begin no_new_control_sequence:=false;
+@<Put each...@>;
+no_new_control_sequence:=true;
+end;
+tini
+
+@ When we begin the following code, \TeX's tables may still contain garbage;
+the strings might not even be present. Thus we must proceed cautiously to get
+bootstrapped in.
+
+But when we finish this part of the program, \TeX\ is ready to call on the
+|main_control| routine to do its work.
+
+@<Get the first line...@>=
+begin @<Initialize the input routines@>;
+if (format_ident=0)or(buffer[loc]="&") then
+ begin if format_ident<>0 then initialize; {erase preloaded format}
+ if not open_fmt_file then goto final_end;
+ if not load_fmt_file then
+ begin w_close(fmt_file); goto final_end;
+ end;
+ w_close(fmt_file);
+ while (loc<limit)and(buffer[loc]=" ") do incr(loc);
+ end;
+if end_line_char_inactive then decr(limit)
+else buffer[limit]:=end_line_char;
+fix_date_and_time;@/
+@<Compute the magic offset@>;
+@<Initialize the print |selector|...@>;
+if (loc<limit)and(cat_code(buffer[loc])<>escape) then start_input;
+ {\.{\\input} assumed}
+end
+
+@* \[52] Debugging.
+Once \TeX\ is working, you should be able to diagnose most errors with
+the \.{\\show} commands and other diagnostic features. But for the initial
+stages of debugging, and for the revelation of really deep mysteries, you
+can compile \TeX\ with a few more aids, including the \PASCAL\ runtime
+checks and its debugger. An additional routine called |debug_help|
+will also come into play when you type `\.D' after an error message;
+|debug_help| also occurs just before a fatal error causes \TeX\ to succumb.
+@^debugging@>
+@^system dependencies@>
+
+The interface to |debug_help| is primitive, but it is good enough when used
+with a \PASCAL\ debugger that allows you to set breakpoints and to read
+variables and change their values. After getting the prompt `\.{debug \#}', you
+type either a negative number (this exits |debug_help|), or zero (this
+goes to a location where you can set a breakpoint, thereby entering into
+dialog with the \PASCAL\ debugger), or a positive number |m| followed by
+an argument |n|. The meaning of |m| and |n| will be clear from the
+program below. (If |m=13|, there is an additional argument, |l|.)
+@.debug \#@>
+
+@d breakpoint=888 {place where a breakpoint is desirable}
+
+@<Last-minute...@>=
+@!debug procedure debug_help; {routine to display various things}
+label breakpoint,exit;
+var k,@!l,@!m,@!n:integer;
+begin loop begin wake_up_terminal;
+ print_nl("debug # (-1 to exit):"); update_terminal;
+@.debug \#@>
+ read(term_in,m);
+ if m<0 then return
+ else if m=0 then
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: m:=0; @{'BREAKPOINT'@}@\
+ end
+ else begin read(term_in,n);
+ case m of
+ @t\4@>@<Numbered cases for |debug_help|@>@;
+ othercases print("?")
+ endcases;
+ end;
+ end;
+exit:end;
+gubed
+
+@ @<Numbered cases...@>=
+1: print_word(mem[n]); {display |mem[n]| in all forms}
+2: print_int(info(n));
+3: print_int(link(n));
+4: print_word(eqtb[n]);
+5: print_word(font_info[n]);
+6: print_word(save_stack[n]);
+7: show_box(n);
+ {show a box, abbreviated by |show_box_depth| and |show_box_breadth|}
+8: begin breadth_max:=10000; depth_threshold:=pool_size-pool_ptr-10;
+ show_node_list(n); {show a box in its entirety}
+ end;
+9: show_token_list(n,null,1000);
+10: slow_print(n);
+11: check_mem(n>0); {check wellformedness; print new busy locations if |n>0|}
+12: search_mem(n); {look for pointers to |n|}
+13: begin read(term_in,l); print_cmd_chr(n,l);
+ end;
+14: for k:=0 to n do print(buffer[k]);
+15: begin font_in_short_display:=null_font; short_display(n);
+ end;
+16: panicking:=not panicking;
+
+@* \[53] Extensions.
+The program above includes a bunch of ``hooks'' that allow further
+capabilities to be added without upsetting \TeX's basic structure.
+Most of these hooks are concerned with ``whatsit'' nodes, which are
+intended to be used for special purposes; whenever a new extension to
+\TeX\ involves a new kind of whatsit node, a corresponding change needs
+to be made to the routines below that deal with such nodes,
+but it will usually be unnecessary to make many changes to the
+other parts of this program.
+
+In order to demonstrate how extensions can be made, we shall treat
+`\.{\\write}', `\.{\\openout}', `\.{\\closeout}', `\.{\\immediate}',
+`\.{\\special}', and `\.{\\setlanguage}' as if they were extensions.
+These commands are actually primitives of \TeX, and they should
+appear in all implementations of the system; but let's try to imagine
+that they aren't. Then the program below illustrates how a person
+could add them.
+
+Sometimes, of course, an extension will require changes to \TeX\ itself;
+no system of hooks could be complete enough for all conceivable extensions.
+The features associated with `\.{\\write}' are almost all confined to the
+following paragraphs, but there are small parts of the |print_ln| and
+|print_char| procedures that were introduced specifically to \.{\\write}
+characters. Furthermore one of the token lists recognized by the scanner
+is a |write_text|; and there are a few other miscellaneous places where we
+have already provided for some aspect of \.{\\write}. The goal of a \TeX\
+extender should be to minimize alterations to the standard parts of the
+program, and to avoid them completely if possible. He or she should also
+be quite sure that there's no easy way to accomplish the desired goals
+with the standard features that \TeX\ already has. ``Think thrice before
+extending,'' because that may save a lot of work, and it will also keep
+incompatible extensions of \TeX\ from proliferating.
+@^system dependencies@>
+@^extensions to \TeX@>
+
+@ First let's consider the format of whatsit nodes that are used to represent
+the data associated with \.{\\write} and its relatives. Recall that a whatsit
+has |type=whatsit_node|, and the |subtype| is supposed to distinguish
+different kinds of whatsits. Each node occupies two or more words; the
+exact number is immaterial, as long as it is readily determined from the
+|subtype| or other data.
+
+We shall introduce five |subtype| values here, corresponding to the
+control sequences \.{\\openout}, \.{\\write}, \.{\\closeout}, \.{\\special}, and
+\.{\\setlanguage}. The second word of I/O whatsits has a |write_stream| field
+that identifies the write-stream number (0 to 15, or 16 for out-of-range and
+positive, or 17 for out-of-range and negative).
+In the case of \.{\\write} and \.{\\special}, there is also a field that
+points to the reference count of a token list that should be sent. In the
+case of \.{\\openout}, we need three words and three auxiliary subfields
+to hold the string numbers for name, area, and extension.
+
+@d write_node_size=2 {number of words in a write/whatsit node}
+@d open_node_size=3 {number of words in an open/whatsit node}
+@d open_node=0 {|subtype| in whatsits that represent files to \.{\\openout}}
+@d write_node=1 {|subtype| in whatsits that represent things to \.{\\write}}
+@d close_node=2 {|subtype| in whatsits that represent streams to \.{\\closeout}}
+@d special_node=3 {|subtype| in whatsits that represent \.{\\special} things}
+@d language_node=4 {|subtype| in whatsits that change the current language}
+@d what_lang(#)==link(#+1) {language number, in the range |0..255|}
+@d what_lhm(#)==type(#+1) {minimum left fragment, in the range |1..63|}
+@d what_rhm(#)==subtype(#+1) {minimum right fragment, in the range |1..63|}
+@d write_tokens(#) == link(#+1) {reference count of token list to write}
+@d write_stream(#) == info(#+1) {stream number (0 to 17)}
+@d open_name(#) == link(#+1) {string number of file name to open}
+@d open_area(#) == info(#+2) {string number of file area for |open_name|}
+@d open_ext(#) == link(#+2) {string number of file extension for |open_name|}
+
+@ The sixteen possible \.{\\write} streams are represented by the |write_file|
+array. The |j|th file is open if and only if |write_open[j]=true|. The last
+two streams are special; |write_open[16]| represents a stream number
+greater than 15, while |write_open[17]| represents a negative stream number,
+and both of these variables are always |false|.
+
+@<Glob...@>=
+@!write_file:array[0..15] of alpha_file;
+@!write_open:array[0..17] of boolean;
+
+@ @<Set init...@>=
+for k:=0 to 17 do write_open[k]:=false;
+
+@ Extensions might introduce new command codes; but it's best to use
+|extension| with a modifier, whenever possible, so that |main_control|
+stays the same.
+
+@d immediate_code=4 {command modifier for \.{\\immediate}}
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+
+@<Put each...@>=
+primitive("openout",extension,open_node);@/
+@!@:open_out_}{\.{\\openout} primitive@>
+primitive("write",extension,write_node); write_loc:=cur_val;@/
+@!@:write_}{\.{\\write} primitive@>
+primitive("closeout",extension,close_node);@/
+@!@:close_out_}{\.{\\closeout} primitive@>
+primitive("special",extension,special_node);@/
+@!@:special_}{\.{\\special} primitive@>
+primitive("immediate",extension,immediate_code);@/
+@!@:immediate_}{\.{\\immediate} primitive@>
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+
+@ The variable |write_loc| just introduced is used to provide an
+appropriate error message in case of ``runaway'' write texts.
+
+@<Glob...@>=
+@!write_loc:pointer; {|eqtb| address of \.{\\write}}
+
+@ @<Cases of |print_cmd_chr|...@>=
+extension: case chr_code of
+ open_node:print_esc("openout");
+ write_node:print_esc("write");
+ close_node:print_esc("closeout");
+ special_node:print_esc("special");
+ immediate_code:print_esc("immediate");
+ set_language_code:print_esc("setlanguage");
+ othercases print("[unknown extension!]")
+ endcases;
+
+@ When an |extension| command occurs in |main_control|, in any mode,
+the |do_extension| routine is called.
+
+@<Cases of |main_control| that are for extensions...@>=
+any_mode(extension):do_extension;
+
+@ @<Declare act...@>=
+@t\4@>@<Declare procedures needed in |do_extension|@>@;
+procedure do_extension;
+var i,@!j,@!k:integer; {all-purpose integers}
+@!p,@!q,@!r:pointer; {all-purpose pointers}
+begin case cur_chr of
+open_node:@<Implement \.{\\openout}@>;
+write_node:@<Implement \.{\\write}@>;
+close_node:@<Implement \.{\\closeout}@>;
+special_node:@<Implement \.{\\special}@>;
+immediate_code:@<Implement \.{\\immediate}@>;
+set_language_code:@<Implement \.{\\setlanguage}@>;
+othercases confusion("ext1")
+@:this can't happen ext1}{\quad ext1@>
+endcases;
+end;
+
+@ Here is a subroutine that creates a whatsit node having a given |subtype|
+and a given number of words. It initializes only the first word of the whatsit,
+and appends it to the current list.
+
+@<Declare procedures needed in |do_extension|@>=
+procedure new_whatsit(@!s:small_number;@!w:small_number);
+var p:pointer; {the new node}
+begin p:=get_node(w); type(p):=whatsit_node; subtype(p):=s;
+link(tail):=p; tail:=p;
+end;
+
+@ The next subroutine uses |cur_chr| to decide what sort of whatsit is
+involved, and also inserts a |write_stream| number.
+
+@<Declare procedures needed in |do_ext...@>=
+procedure new_write_whatsit(@!w:small_number);
+begin new_whatsit(cur_chr,w);
+if w<>write_node_size then scan_four_bit_int
+else begin scan_int;
+ if cur_val<0 then cur_val:=17
+ else if cur_val>15 then cur_val:=16;
+ end;
+write_stream(tail):=cur_val;
+end;
+
+@ @<Implement \.{\\openout}@>=
+begin new_write_whatsit(open_node_size);
+scan_optional_equals; scan_file_name;@/
+open_name(tail):=cur_name; open_area(tail):=cur_area; open_ext(tail):=cur_ext;
+end
+
+@ When `\.{\\write 12\{...\}}' appears, we scan the token list `\.{\{...\}}'
+without expanding its macros; the macros will be expanded later when this
+token list is rescanned.
+
+@<Implement \.{\\write}@>=
+begin k:=cur_cs; new_write_whatsit(write_node_size);@/
+cur_cs:=k; p:=scan_toks(false,false); write_tokens(tail):=def_ref;
+end
+
+@ @<Implement \.{\\closeout}@>=
+begin new_write_whatsit(write_node_size); write_tokens(tail):=null;
+end
+
+@ When `\.{\\special\{...\}}' appears, we expand the macros in the token
+list as in \.{\\xdef} and \.{\\mark}.
+
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+
+@ Each new type of node that appears in our data structure must be capable
+of being displayed, copied, destroyed, and so on. The routines that we
+need for write-oriented whatsits are somewhat like those for mark nodes;
+other extensions might, of course, involve more subtlety here.
+
+@<Basic printing...@>=
+procedure print_write_whatsit(@!s:str_number;@!p:pointer);
+begin print_esc(s);
+if write_stream(p)<16 then print_int(write_stream(p))
+else if write_stream(p)=16 then print_char("*")
+@.*\relax@>
+else print_char("-");
+end;
+
+@ @<Display the whatsit...@>=
+case subtype(p) of
+open_node:begin print_write_whatsit("openout",p);
+ print_char("="); print_file_name(open_name(p),open_area(p),open_ext(p));
+ end;
+write_node:begin print_write_whatsit("write",p);
+ print_mark(write_tokens(p));
+ end;
+close_node:print_write_whatsit("closeout",p);
+special_node:begin print_esc("special");
+ print_mark(write_tokens(p));
+ end;
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+othercases print("whatsit?")
+endcases
+
+@ @<Make a partial copy of the whatsit...@>=
+case subtype(p) of
+open_node: begin r:=get_node(open_node_size); words:=open_node_size;
+ end;
+write_node,special_node: begin r:=get_node(write_node_size);
+ add_token_ref(write_tokens(p)); words:=write_node_size;
+ end;
+close_node,language_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+othercases confusion("ext2")
+@:this can't happen ext2}{\quad ext2@>
+endcases
+
+@ @<Wipe out the whatsit...@>=
+begin case subtype(p) of
+open_node: free_node(p,open_node_size);
+write_node,special_node: begin delete_token_ref(write_tokens(p));
+ free_node(p,write_node_size); goto done;
+ end;
+close_node,language_node: free_node(p,small_node_size);
+othercases confusion("ext3")
+@:this can't happen ext3}{\quad ext3@>
+endcases;@/
+goto done;
+end
+
+@ @<Incorporate a whatsit node into a vbox@>=do_nothing
+
+@ @<Incorporate a whatsit node into an hbox@>=do_nothing
+
+@ @<Let |d| be the width of the whatsit |p|@>=d:=0
+
+@ @d adv_past(#)==@+if subtype(#)=language_node then
+ begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);@+end
+
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p)
+
+@ @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+
+adv_past(s)
+
+@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
+goto contribute
+
+@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
+goto not_found
+
+@ @<Output the whatsit node |p| in a vlist@>=
+out_what(p)
+
+@ @<Output the whatsit node |p| in an hlist@>=
+out_what(p)
+
+@ After all this preliminary shuffling, we come finally to the routines
+that actually send out the requested data. Let's do \.{\\special} first
+(it's easier).
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+procedure special_out(@!p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+@!k:pool_pointer; {index into |str_pool|}
+begin synch_h; synch_v;@/
+old_setting:=selector; selector:=new_string;
+show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
+selector:=old_setting;
+str_room(1);
+if cur_length<256 then
+ begin dvi_out(xxx1); dvi_out(cur_length);
+ end
+else begin dvi_out(xxx4); dvi_four(cur_length);
+ end;
+for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
+pool_ptr:=str_start[str_ptr]; {erase the string}
+end;
+
+@ To write a token list, we must run it through \TeX's scanner, expanding
+macros and \.{\\the} and \.{\\number}, etc. This might cause runaways,
+if a delimited macro parameter isn't matched, and runaways would be
+extremely confusing since we are calling on \TeX's scanner in the middle
+of a \.{\\shipout} command. Therefore we will put a dummy control sequence as
+a ``stopper,'' right after the token list. This control sequence is
+artificially defined to be \.{\\outer}.
+@:end_write_}{\.{\\endwrite}@>
+
+@<Initialize table...@>=
+text(end_write):="endwrite"; eq_level(end_write):=level_one;
+eq_type(end_write):=outer_call; equiv(end_write):=null;
+
+@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+procedure write_out(@!p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+@!old_mode:integer; {saved |mode|}
+@!j:small_number; {write stream number}
+@!q,@!r:pointer; {temporary variables for list manipulation}
+begin @<Expand macros in the token list
+ and make |link(def_ref)| point to the result@>;
+old_setting:=selector; j:=write_stream(p);
+if write_open[j] then selector:=j
+else begin {write to the terminal if file isn't open}
+ if (j=17)and(selector=term_and_log) then selector:=log_only;
+ print_nl("");
+ end;
+token_show(def_ref); print_ln;
+flush_list(def_ref); selector:=old_setting;
+end;
+
+@ The final line of this routine is slightly subtle; at least, the author
+didn't think about it until getting burnt! There is a used-up token list
+@^Knuth, Donald Ervin@>
+on the stack, namely the one that contained |end_write_token|. (We
+insert this artificial `\.{\\endwrite}' to prevent runaways, as explained
+above.) If it were not removed, and if there were numerous writes on a
+single page, the stack would overflow.
+
+@d end_write_token==cs_token_flag+end_write
+
+@<Expand macros in the token list and...@>=
+q:=get_avail; info(q):=right_brace_token+"}";@/
+r:=get_avail; link(q):=r; info(r):=end_write_token; ins_list(q);@/
+begin_token_list(write_tokens(p),write_text);@/
+q:=get_avail; info(q):=left_brace_token+"{"; ins_list(q);
+{now we're ready to scan
+ `\.\{$\langle\,$token list$\,\rangle$\.{\} \\endwrite}'}
+old_mode:=mode; mode:=0;
+ {disable \.{\\prevdepth}, \.{\\spacefactor}, \.{\\lastskip}, \.{\\prevgraf}}
+cur_cs:=write_loc; q:=scan_toks(false,true); {expand macros, etc.}
+get_token;@+if cur_tok<>end_write_token then
+ @<Recover from an unbalanced write command@>;
+mode:=old_mode;
+end_token_list {conserve stack space}
+
+@ @<Recover from an unbalanced write command@>=
+begin print_err("Unbalanced write command");
+@.Unbalanced write...@>
+help2("On this page there's a \write with fewer real {'s than }'s.")@/
+("I can't handle that very well; good luck."); error;
+repeat get_token;
+until cur_tok=end_write_token;
+end
+
+@ The |out_what| procedure takes care of outputting whatsit nodes for
+|vlist_out| and |hlist_out|\kern-.3pt.
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+begin case subtype(p) of
+open_node,write_node,close_node:@<Do some work that has been queued up
+ for \.{\\write}@>;
+special_node:special_out(p);
+language_node:do_nothing;
+othercases confusion("ext4")
+@:this can't happen ext4}{\quad ext4@>
+endcases;
+end;
+
+@ We don't implement \.{\\write} inside of leaders. (The reason is that
+the number of times a leader box appears might be different in different
+implementations, due to machine-dependent rounding in the glue calculations.)
+@^leaders@>
+
+@<Do some work that has been queued up...@>=
+if not doing_leaders then
+ begin j:=write_stream(p);
+ if subtype(p)=write_node then write_out(p)
+ else begin if write_open[j] then a_close(write_file[j]);
+ if subtype(p)=close_node then write_open[j]:=false
+ else if j<16 then
+ begin cur_name:=open_name(p); cur_area:=open_area(p);
+ cur_ext:=open_ext(p);
+ if cur_ext="" then cur_ext:=".tex";
+ pack_cur_name;
+ while not a_open_out(write_file[j]) do
+ prompt_file_name("output file name",".tex");
+ write_open[j]:=true;
+ end;
+ end;
+ end
+
+@ The presence of `\.{\\immediate}' causes the |do_extension| procedure
+to descend to one level of recursion. Nothing happens unless \.{\\immediate}
+is followed by `\.{\\openout}', `\.{\\write}', or `\.{\\closeout}'.
+@^recursion@>
+
+@<Implement \.{\\immediate}@>=
+begin get_x_token;
+if (cur_cmd=extension)and(cur_chr<=close_node) then
+ begin p:=tail; do_extension; {append a whatsit node}
+ out_what(tail); {do the action immediately}
+ flush_node_list(tail); tail:=p; link(p):=null;
+ end
+else back_input;
+end
+
+@ The \.{\\language} extension is somewhat different.
+We need a subroutine that comes into play when a character of
+a non-|clang| language is being appended to the current paragraph.
+
+@<Declare action...@>=
+procedure fix_language;
+var @!l:ASCII_code; {the new current language}
+begin if language<=0 then l:=0
+else if language>255 then l:=0
+else l:=language;
+if l<>clang then
+ begin new_whatsit(language_node,small_node_size);
+ what_lang(tail):=l; clang:=l;@/
+ what_lhm(tail):=norm_min(left_hyphen_min);
+ what_rhm(tail):=norm_min(right_hyphen_min);
+ end;
+end;
+
+@ @<Implement \.{\\setlanguage}@>=
+if abs(mode)<>hmode then report_illegal_case
+else begin new_whatsit(language_node,small_node_size);
+ scan_int;
+ if cur_val<=0 then clang:=0
+ else if cur_val>255 then clang:=0
+ else clang:=cur_val;
+ what_lang(tail):=clang;
+ what_lhm(tail):=norm_min(left_hyphen_min);
+ what_rhm(tail):=norm_min(right_hyphen_min);
+ end
+
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+
+@* \[54] System-dependent changes.
+This section should be replaced, if necessary, by any special
+modifications of the program
+that are necessary to make \TeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* \[55] Index.
+Here is where you can find all uses of each identifier in the program,
+with underlined entries pointing to where the identifier was defined.
+If the identifier is only one letter long, however, you get to see only
+the underlined entries. {\sl All references are to section numbers instead of
+page numbers.}
+
+This index also lists error messages and other aspects of the program
+that you might want to look up some day. For example, the entry
+for ``system dependencies'' lists all sections that should receive
+special attention from people who are installing \TeX\ in a new
+operating environment. A list of various things that can't happen appears
+under ``this can't happen''. Approximately 40 sections are listed under
+``inner loop''; these account for about 60\pct! of \TeX's running time,
+exclusive of input and output.
diff --git a/Build/source/texk/web2c/texmfmem.h b/Build/source/texk/web2c/texmfmem.h
new file mode 100644
index 00000000000..32c41e08215
--- /dev/null
+++ b/Build/source/texk/web2c/texmfmem.h
@@ -0,0 +1,250 @@
+/* texmfmem.h: the memory_word type, which is too hard to translate
+ automatically from Pascal. We have to make sure the byte-swapping
+ that the (un)dumping routines do suffices to put things in the right
+ place in memory.
+
+ A memory_word can be broken up into a `twohalves' or a
+ `fourquarters', and a `twohalves' can be further broken up. Here is
+ a picture. ..._M = most significant byte, ..._L = least significant
+ byte.
+
+ The halfword fields are four bytes if we are building a big TeX or MF;
+ this leads to further complications:
+
+ BigEndian:
+ twohalves.v: RH_MM RH_ML RH_LM RH_LL LH_MM LH_ML LH_LM LH_LL
+ twohalves.u: ---------JUNK---------- B0 B1
+ fourquarters: B0 B1 B2 B3
+
+ LittleEndian:
+ twohalves.v: LH_LL LH_LM LH_ML LH_MM RH_LL RH_LM RH_ML RH_MM
+ twohalves.u: B1 B0
+ fourquarters: ---------JUNK---------- B3 B2 B1 B0
+
+ I guess TeX and Metafont never refer to the B1 and B0 in the
+ fourquarters structure as the B1 and B0 in the twohalves.u structure.
+
+ The B0 and B1 fields are declared short instead of quarterword,
+ because they are used in character nodes to store a font number and a
+ character. If left as a quarterword (which is a single byte), we
+ couldn't support more than 256 fonts. (If shorts aren't two bytes,
+ this will lose.)
+
+ In the old four-byte memory structure (something more needs to be
+ done to handle >256 fonts):
+
+ If BigEndian:
+ twohalves.v: RH_M RH_L LH_M LH_L
+ twohalves.u: JNK1 JNK2 B0 B1
+ fourquarters: B0 B1 B2 B3
+
+ If LittleEndian:
+ twohalves.v: LH_L LH_M RH_L RH_M
+ twohalves.u: B1 B0 JNK1 JNK2
+ fourquarters: B3 B2 B1 B0
+
+ In Omega, quarterwords are two octets, so the picture becomes simpler:
+
+ BigEndian:
+ twohalves.v: RH_MM RH_ML RH_LM RH_LL LH_MM LH_ML LH_LM LH_LL
+ twohalves.u: ---------JUNK---------- ----B0----- ----B1-----
+ fourquarters: ----B0----- ----B1----- ----B2----- ----B3-----
+ twoints: ---------CINT0--------- ---------CINT1---------
+
+ LittleEndian:
+ twohalves.v: LH_LL LH_LM LH_ML LH_MM RH_LL RH_LM RH_ML RH_MM
+ twohalves.u: ----B1----- ----B0-----
+ fourquarters: ----B3----- ----B2----- ----B1----- ----B0-----
+ twoints: ---------CINT1--------- ---------CINT0---------
+
+ This file can't be part of texmf.h, because texmf.h gets included by
+ {tex,mf,mp}d.h before the `halfword' etc. types are defined. So we
+ include it from the change file instead.
+*/
+
+/* Omega is sufficiently different to separate the definition. */
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+
+typedef union
+{
+ struct
+ {
+#ifdef WORDS_BIGENDIAN
+ halfword RH, LH;
+#else
+ halfword LH, RH;
+#endif
+ } v;
+
+ struct
+ { /* Make B0,B1 overlap the most significant bytes of LH. */
+#ifdef WORDS_BIGENDIAN
+ halfword junk;
+ short B0, B1;
+#else /* not WORDS_BIGENDIAN */
+ /* If 32-bit memory words, have to do something. */
+#if defined (SMALLTeX) || defined (SMALLMF) || defined (SMALLMP)
+ fixme
+#else
+ short B1, B0;
+#endif /* big memory words */
+#endif /* LittleEndian */
+ } u;
+} twohalves;
+
+typedef struct
+{
+ struct
+ {
+#ifdef WORDS_BIGENDIAN
+ quarterword B0, B1, B2, B3;
+#else
+ quarterword B3, B2, B1, B0;
+#endif
+ } u;
+} fourquarters;
+
+typedef union
+{
+#ifdef TeX
+ glueratio gr;
+ twohalves hh;
+#else
+ twohalves hhfield;
+#endif
+#ifdef WORDS_BIGENDIAN
+ integer cint;
+ fourquarters qqqq;
+#else /* not WORDS_BIGENDIAN */
+ struct
+ {
+#if defined (TeX) && !defined (SMALLTeX) || defined (MF) && !defined (SMALLMF) || defined (MP) && !defined (SMALLMP)
+ halfword junk;
+#endif /* big {TeX,MF,MP} */
+ integer CINT;
+ } u;
+
+ struct
+ {
+#if defined (TeX) && !defined (SMALLTeX) || defined (MF) && !defined (SMALLMF) || defined (MP) && !defined (SMALLMP)
+ halfword junk;
+#endif /* big {TeX,MF,MP} */
+ fourquarters QQQQ;
+ } v;
+#endif /* not WORDS_BIGENDIAN */
+} memoryword;
+
+
+/* fmemory_word for font_list; needs to be only four bytes. This saves
+ significant space in the .fmt files. */
+
+typedef union
+{
+#ifdef WORDS_BIGENDIAN
+ integer cint;
+ fourquarters qqqq;
+#else /* not WORDS_BIGENDIAN */
+ struct
+ {
+ integer CINT;
+ } u;
+
+ struct
+ {
+ fourquarters QQQQ;
+ } v;
+#endif /* not WORDS_BIGENDIAN */
+} fmemoryword;
+
+/* To keep the original structure accesses working, we must go through
+ the extra names C forced us to introduce. */
+#define b0 u.B0
+#define b1 u.B1
+#define b2 u.B2
+#define b3 u.B3
+
+#define rh v.RH
+#define lhfield v.LH
+
+#ifndef WORDS_BIGENDIAN
+#define cint u.CINT
+#define qqqq v.QQQQ
+#endif
+
+#else /* Omega || eOmega || Aleph */
+
+typedef union
+{
+ struct
+ {
+#ifdef WORDS_BIGENDIAN
+ halfword RH, LH;
+#else
+ halfword LH, RH;
+#endif
+ } v;
+
+ struct
+ { /* Make B0,B1 overlap the most significant bytes of LH. */
+#ifdef WORDS_BIGENDIAN
+ halfword junk;
+ quarterword B0, B1;
+#else /* not WORDS_BIGENDIAN */
+ /* If 32-bit memory words, have to do something. */
+#if defined (SMALLTeX) || defined (SMALLMF) || defined (SMALLMP)
+ fixme
+#else
+ quarterword B1, B0;
+#endif /* big memory words */
+#endif /* LittleEndian */
+ } u;
+} twohalves;
+
+typedef struct
+{
+ struct
+ {
+#ifdef WORDS_BIGENDIAN
+ quarterword B0, B1, B2, B3;
+#else
+ quarterword B3, B2, B1, B0;
+#endif
+ } u;
+} fourquarters;
+
+typedef struct
+{
+#ifdef WORDS_BIGENDIAN
+ integer CINT0, CINT1;
+#else
+ integer CINT1, CINT0;
+#endif
+} twoints;
+
+typedef struct
+{
+ glueratio GLUE;
+} glues;
+
+typedef union
+{
+ twohalves hh;
+ fourquarters qqqq;
+ twoints ii;
+ glues gg;
+} memoryword;
+
+#define b0 u.B0
+#define b1 u.B1
+#define b2 u.B2
+#define b3 u.B3
+
+#define rh v.RH
+#define lhfield v.LH
+
+#define cint ii.CINT0
+#define cint1 ii.CINT1
+
+#define gr gg.GLUE
+
+#endif /* Omega || eOmega || Aleph */
diff --git a/Build/source/texk/web2c/texmfmp-help.h b/Build/source/texk/web2c/texmfmp-help.h
new file mode 100644
index 00000000000..c0c4525a1e4
--- /dev/null
+++ b/Build/source/texk/web2c/texmfmp-help.h
@@ -0,0 +1,509 @@
+/* The help messages for TeX & MF family of programs.
+
+Copyright 2001-05 Olaf Weber.
+Copyright 1995, 96 Karl Berry.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef TEXMFMP_HELP
+#define TEXMFMP_HELP
+
+#ifdef Aleph
+const_string ALEPHHELP[] = {
+ "Usage: aleph [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
+ " or: aleph [OPTION]... \\FIRST-LINE",
+ " or: aleph [OPTION]... &FMT ARGS",
+ " Run Aleph on TEXNAME, usually creating TEXNAME.dvi.",
+ " Any remaining COMMANDS are processed as Aleph input, after TEXNAME is read.",
+ " If the first line of TEXNAME is %&FMT, and FMT is an existing .fmt file,",
+ " use it. Else use `NAME.fmt', where NAME is the program invocation name,",
+ " most commonly `aleph'.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " interpret all non-option arguments as a line of Aleph input.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the FMT to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ "-etex enable e-TeX extensions",
+ "[-no]-file-line-error disable/enable file:line:error style messages",
+ "-fmt=FMTNAME use FMTNAME instead of program name or a %& line",
+ "-halt-on-error stop processing at the first error",
+ "-ini be inialeph, for dumping formats; this is implicitly",
+ " true if the program name is `inialeph'",
+ "-interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/",
+ " scrollmode/errorstopmode)",
+#ifdef IPC
+ "-ipc send DVI output to a socket as well as the usual",
+ " output file",
+ "-ipc-start as -ipc, and also start the server at the other end",
+#endif /* IPC */
+ "-jobname=STRING set the job name to STRING",
+ "-kpathsea-debug=NUMBER set path searching debugging flags according to the",
+ " bits of NUMBER",
+ "[-no]-mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)",
+ "-output-comment=STRING use STRING for DVI file comment instead of date",
+ "-output-directory=DIR use DIR as the directory to write files to",
+ "[-no]-parse-first-line disable/enable parsing of the first line of the",
+ " input file",
+ "-progname=STRING set program (and fmt) name to STRING",
+ "-recorder enable filename recorder (always on)",
+ "[-no]-shell-escape disable/enable \\write18{SHELL COMMAND}",
+ "-src-specials insert source specials into the DVI file",
+ "-src-specials=WHERE insert source specials in certain places of",
+ " the DVI file. WHERE is a comma-separated value",
+ " list: cr display hbox math par parend vbox",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* Aleph */
+
+#ifdef eTeX
+const_string ETEXHELP[] = {
+ "Usage: etex [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
+ " or: etex [OPTION]... \\FIRST-LINE",
+ " or: etex [OPTION]... &FMT ARGS",
+ " Run e-TeX on TEXNAME, usually creating TEXNAME.dvi.",
+ " Any remaining COMMANDS are processed as e-TeX input, after TEXNAME is read.",
+ " If the first line of TEXNAME is %&FMT, and FMT is an existing .fmt file,",
+ " use it. Else use `NAME.fmt', where NAME is the program invocation name,",
+ " most commonly `etex'.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " interpret all non-option arguments as a line of e-TeX input.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the FMT to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ "-enc enable encTeX extensions such as \\mubyte",
+ "-etex enable e-TeX extensions",
+ "[-no]-file-line-error disable/enable file:line:error style messages",
+ "-fmt=FMTNAME use FMTNAME instead of program name or a %& line",
+ "-halt-on-error stop processing at the first error",
+ "-ini be einitex, for dumping formats; this is implicitly",
+ " true if the program name is `einitex'",
+ "-interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/",
+ " scrollmode/errorstopmode)",
+#ifdef IPC
+ "-ipc send DVI output to a socket as well as the usual",
+ " output file",
+ "-ipc-start as -ipc, and also start the server at the other end",
+#endif /* IPC */
+ "-jobname=STRING set the job name to STRING",
+ "-kpathsea-debug=NUMBER set path searching debugging flags according to",
+ " the bits of NUMBER",
+ "[-no]-mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)",
+ "-mltex enable MLTeX extensions such as \\charsubdef",
+ "-output-comment=STRING use STRING for DVI file comment instead of date",
+ "-output-directory=DIR use DIR as the directory to write files to",
+ "[-no]-parse-first-line disable/enable parsing of the first line of the",
+ " input file",
+ "-progname=STRING set program (and fmt) name to STRING",
+ "-recorder enable filename recorder",
+ "[-no]-shell-escape disable/enable \\write18{SHELL COMMAND}",
+ "-src-specials insert source specials into the DVI file",
+ "-src-specials=WHERE insert source specials in certain places of",
+ " the DVI file. WHERE is a comma-separated value",
+ " list: cr display hbox math par parend vbox",
+ "-translate-file=TCXNAME use the TCX file TCXNAME",
+ "-8bit make all characters printable by default",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* eTeX */
+
+#ifdef MF
+const_string MFHELP[] = {
+ "Usage: mf [OPTION]... [MFNAME[.mf]] [COMMANDS]",
+ " or: mf [OPTION]... \\FIRST-LINE",
+ " or: mf [OPTION]... &BASE ARGS",
+ " Run Metafont on MFNAME, usually creating MFNAME.tfm and MFNAME.NNNNgf,",
+ " where NNNN is the resolution of the specified mode (2602 by default).",
+ " Any following COMMANDS are processed as Metafont input,",
+ " after MFNAME is read.",
+ " If the first line of MFNAME is %&BASE, and BASE is an existing .base file,",
+ " use it. Else use `NAME.base', where NAME is the program invocation name,",
+ " most commonly `mf'.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " interpret all non-option arguments as a line of Metafont input.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the BASE to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ "-base=BASENAME use BASENAME instead of program name or a %& line",
+ "[-no]-file-line-error disable/enable file:line:error style messages",
+ "-halt-on-error stop processing at the first error",
+ "-ini be inimf, for dumping bases; this is implicitly",
+ " true if the program name is `inimf'",
+ "-interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/",
+ " scrollmode/errorstopmode)",
+ "-jobname=STRING set the job name to STRING",
+ "-kpathsea-debug=NUMBER set path searching debugging flags according to",
+ " the bits of NUMBER",
+ "[-no]-mktex=FMT disable/enable mktexFMT generation (FMT=mf)",
+ "-output-directory=DIR use DIR as the directory to write files to",
+ "[-no]-parse-first-line disable/enable parsing of the first line of the",
+ " input file",
+ "-progname=STRING set program (and base) name to STRING",
+ "-recorder enable filename recorder",
+ "-translate-file=TCXNAME use the TCX file TCXNAME",
+ "-8bit make all characters printable by default",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* MF */
+
+#ifdef MP
+const_string MPHELP[] = {
+ "Usage: mpost [OPTION]... [MPNAME[.mp]] [COMMANDS]",
+ " or: mpost [OPTION]... \\FIRST-LINE",
+ " or: mpost [OPTION]... &MEM ARGS",
+ " Run MetaPost on MPNAME, usually creating MPNAME.NNN (and perhaps",
+ " MPNAME.tfm), where NNN are the character numbers generated.",
+ " Any remaining COMMANDS are processed as MetaPost input,",
+ " after MPNAME is read.",
+ " If the first line of MPNAME is %&MEM, and MEM is an existing .mem file,",
+ " use it. Else use `NAME.mem', where NAME is the program invocation name,",
+ " most commonly `mp'.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " interpret all non-option arguments as a line of MetaPost input.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the MEM to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ "[-no]-file-line-error disable/enable file:line:error style messages",
+ "-halt-on-error stop processing at the first error",
+ "-ini be inimpost, for dumping mems; this is implicitly",
+ " true if the program name is `inimpost'",
+ "-interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/",
+ " scrollmode/errorstopmode)",
+ "-jobname=STRING set the job name to STRING",
+ "-kpathsea-debug=NUMBER set path searching debugging flags according to",
+ " the bits of NUMBER",
+ "-mem=MEMNAME use MEMNAME instead of program name or a %& line",
+ "-output-directory=DIR use DIR as the directory to write files to",
+ "[-no]-parse-first-line disable/enable parsing of the first line of the",
+ " input file",
+ "-progname=STRING set program (and mem) name to STRING",
+ "-recorder enable filename recorder",
+ "-tex=TEXPROGRAM use TEXPROGRAM for text labels.",
+ "-translate-file=TCXNAME use the TCX file TCXNAME",
+ "-8bit make all characters printable by default",
+ "-T, -troff set the prologues variable, use `makempx -troff'",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* MP */
+
+#ifdef Omega
+const_string OMEGAHELP[] = {
+ "Usage: omega [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
+ " or: omega [OPTION]... \\FIRST-LINE",
+ " or: omega [OPTION]... &FMT ARGS",
+ " Run Omega on TEXNAME, usually creating TEXNAME.dvi.",
+ " Any remaining COMMANDS are processed as Omega input, after TEXNAME is read.",
+ " If the first line of TEXNAME is %&FMT, and FMT is an existing .fmt file,",
+ " use it. Else use `NAME.fmt', where NAME is the program invocation name,",
+ " most commonly `omega'.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " interpret all non-option arguments as a line of Omega input.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the FMT to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ "[-no]-file-line-error disable/enable file:line:error style messages",
+ "-fmt=FMTNAME use FMTNAME instead of program name or a %& line",
+ "-halt-on-error stop processing at the first error",
+ "-ini be iniomega, for dumping formats; this is implicitly",
+ " true if the program name is `iniomega'",
+ "-interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/",
+ " scrollmode/errorstopmode)",
+#ifdef IPC
+ "-ipc send DVI output to a socket as well as the usual",
+ " output file",
+ "-ipc-start as -ipc, and also start the server at the other end",
+#endif /* IPC */
+ "-jobname=STRING set the job name to STRING",
+ "-kpathsea-debug=NUMBER set path searching debugging flags according to",
+ " the bits of NUMBER",
+ "[-no]-mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)",
+ "-output-comment=STRING use STRING for DVI file comment instead of date",
+ "-output-directory=DIR use DIR as the directory to write files to",
+ "[-no]-parse-first-line disable/enable parsing of the first line of the",
+ " input file",
+ "-progname=STRING set program (and fmt) name to STRING",
+ "-recorder enable filename recorder (always on)",
+ "[-no]-shell-escape disable/enable \\write18{SHELL COMMAND}",
+ "-src-specials insert source specials into the DVI file",
+ "-src-specials=WHERE insert source specials in certain places of",
+ " the DVI file. WHERE is a comma-separated value",
+ " list: cr display hbox math par parend vbox",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* Omega */
+
+#ifdef eOmega
+const_string EOMEGAHELP[] = {
+ "Usage: eomega [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
+ " or: eomega [OPTION]... \\FIRST-LINE",
+ " or: eomega [OPTION]... &FMT ARGS",
+ " Run e-Omega on TEXNAME, usually creating TEXNAME.dvi.",
+ " Any remaining COMMANDS are processed as e-Omega input, after TEXNAME is read.",
+ " If the first line of TEXNAME is %&FMT, and FMT is an existing .fmt file,",
+ " use it. Else use `NAME.fmt', where NAME is the program invocation name,",
+ " most commonly `eomega'.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " interpret all non-option arguments as a line of e-Omega input.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the FMT to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ "[-no]-file-line-error disable/enable file:line:error style messages",
+ "-fmt=FMTNAME use FMTNAME instead of program name or a %& line",
+ "-halt-on-error stop processing at the first error",
+ "-ini be inieomega, for dumping formats; this is implicitly",
+ " true if the program name is `inieomega'",
+ "-interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/",
+ " scrollmode/errorstopmode)",
+#ifdef IPC
+ "-ipc send DVI output to a socket as well as the usual",
+ " output file",
+ "-ipc-start as -ipc, and also start the server at the other end",
+#endif /* IPC */
+ "-jobname=STRING set the job name to STRING",
+ "-kpathsea-debug=NUMBER set path searching debugging flags according to",
+ " the bits of NUMBER",
+ "[-no]-mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)",
+ "-output-comment=STRING use STRING for DVI file comment instead of date",
+ "-output-directory=DIR use DIR as the directory to write files to",
+ "[-no]-parse-first-line disable/enable parsing of the first line of the",
+ " input file",
+ "-progname=STRING set program (and fmt) name to STRING",
+ "-recorder enable filename recorder (always on)",
+ "[-no]-shell-escape disable/enable \\write18{SHELL COMMAND}",
+ "-src-specials insert source specials into the DVI file",
+ "-src-specials=WHERE insert source specials in certain places of",
+ " the DVI file. WHERE is a comma-separated value",
+ " list: cr display hbox math par parend vbox",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* eOmega */
+
+#ifdef pdfTeX
+const_string PDFTEXHELP[] = {
+ "Usage: pdftex [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
+ " or: pdftex [OPTION]... \\FIRST-LINE",
+ " or: pdftex [OPTION]... &FMT ARGS",
+ " Run pdfTeX on TEXNAME, usually creating TEXNAME.pdf.",
+ " Any remaining COMMANDS are processed as pdfTeX input, after TEXNAME is read.",
+ " If the first line of TEXNAME is %&FMT, and FMT is an existing .fmt file,",
+ " use it. Else use `NAME.fmt', where NAME is the program invocation name,",
+ " most commonly `pdftex'.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " interpret all non-option arguments as a line of pdfTeX input.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the FMT to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ "-enc enable encTeX extensions such as \\mubyte",
+ "[-no]-file-line-error disable/enable file:line:error style messages",
+ "-fmt=FMTNAME use FMTNAME instead of program name or a %& line",
+ "-halt-on-error stop processing at the first error",
+ "-ini be pdfinitex, for dumping formats; this is implicitly",
+ " true if the program name is `pdfinitex'",
+ "-interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/",
+ " scrollmode/errorstopmode)",
+#ifdef IPC
+ "-ipc send DVI output to a socket as well as the usual",
+ " output file",
+ "-ipc-start as -ipc, and also start the server at the other end",
+#endif /* IPC */
+ "-jobname=STRING set the job name to STRING",
+ "-kpathsea-debug=NUMBER set path searching debugging flags according to",
+ " the bits of NUMBER",
+ "[-no]-mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)",
+ "-mltex enable MLTeX extensions such as \\charsubdef",
+ "-output-comment=STRING use STRING for DVI file comment instead of date",
+ " (no effect for PDF)",
+ "-output-directory=DIR use DIR as the directory to write files to",
+ "-output-format=FORMAT use FORMAT for job output; FORMAT is `dvi' or `pdf'",
+ "[-no]-parse-first-line disable/enable parsing of the first line of the",
+ " input file",
+ "-progname=STRING set program (and fmt) name to STRING",
+ "-recorder enable filename recorder",
+ "[-no]-shell-escape disable/enable \\write18{SHELL COMMAND}",
+ "-src-specials insert source specials into the DVI file",
+ "-src-specials=WHERE insert source specials in certain places of",
+ " the DVI file. WHERE is a comma-separated value",
+ " list: cr display hbox math par parend vbox",
+ "-translate-file=TCXNAME use the TCX file TCXNAME",
+ "-8bit make all characters printable by default",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* pdfTeX */
+
+#ifdef pdfeTeX
+const_string PDFETEXHELP[] = {
+ "Usage: pdfetex [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
+ " or: pdfetex [OPTION]... \\FIRST-LINE",
+ " or: pdfetex [OPTION]... &FMT ARGS",
+ " Run pdfeTeX on TEXNAME, usually creating TEXNAME.pdf.",
+ " Any remaining COMMANDS are processed as pdfeTeX input, after TEXNAME is read.",
+ " If the first line of TEXNAME is %&FMT, and FMT is an existing .fmt file,",
+ " use it. Else use `NAME.fmt', where NAME is the program invocation name,",
+ " most commonly `pdfetex'.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " interpret all non-option arguments as a line of pdfeTeX input.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the FMT to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ "-enc enable encTeX extensions such as \\mubyte",
+ "-etex enable e-TeX extensions",
+ "[-no]-file-line-error disable/enable file:line:error style messages",
+ "-fmt=FMTNAME use FMTNAME instead of program name or a %& line",
+ "-halt-on-error stop processing at the first error",
+ "-ini be pdfeinitex, for dumping formats; this is implicitly",
+ " true if the program name is `pdfeinitex'",
+ "-interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/",
+ " scrollmode/errorstopmode)",
+#ifdef IPC
+ "-ipc send DVI output to a socket as well as the usual",
+ " output file",
+ "-ipc-start as -ipc, and also start the server at the other end",
+#endif /* IPC */
+ "-jobname=STRING set the job name to STRING",
+ "-kpathsea-debug=NUMBER set path searching debugging flags according to",
+ " the bits of NUMBER",
+ "[-no]-mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)",
+ "-mltex enable MLTeX extensions such as \\charsubdef",
+ "-output-comment=STRING use STRING for DVI file comment instead of date",
+ " (no effect for PDF)",
+ "-output-directory=DIR use DIR as the directory to write files to",
+ "-output-format=FORMAT use FORMAT for job output; FORMAT is `dvi' or `pdf'",
+ "[-no]-parse-first-line disable/enable parsing of the first line of the",
+ " input file",
+ "-progname=STRING set program (and fmt) name to STRING",
+ "-recorder enable filename recorder",
+ "[-no]-shell-escape disable/enable \\write18{SHELL COMMAND}",
+ "-src-specials insert source specials into the DVI file",
+ "-src-specials=WHERE insert source specials in certain places of",
+ " the DVI file. WHERE is a comma-separated value",
+ " list: cr display hbox math par parend vbox",
+ "-translate-file=TCXNAME use the TCX file TCXNAME",
+ "-8bit make all characters printable by default",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* pdfeTeX */
+
+#ifdef TeX
+const_string TEXHELP[] = {
+ "Usage: tex [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
+ " or: tex [OPTION]... \\FIRST-LINE",
+ " or: tex [OPTION]... &FMT ARGS",
+ " Run TeX on TEXNAME, usually creating TEXNAME.dvi.",
+ " Any remaining COMMANDS are processed as TeX input, after TEXNAME is read.",
+ " If the first line of TEXNAME is %&FMT, and FMT is an existing .fmt file,",
+ " use it. Else use `NAME.fmt', where NAME is the program invocation name,",
+ " most commonly `tex'.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " interpret all non-option arguments as a line of TeX input.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the FMT to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ "-enc enable encTeX extensions such as \\mubyte",
+ "[-no]-file-line-error disable/enable file:line:error style messages",
+ "-fmt=FMTNAME use FMTNAME instead of program name or a %& line",
+ "-halt-on-error stop processing at the first error",
+ "-ini be initex, for dumping formats; this is implicitly",
+ " true if the program name is `initex'",
+ "-interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/",
+ " scrollmode/errorstopmode)",
+#ifdef IPC
+ "-ipc send DVI output to a socket as well as the usual",
+ " output file",
+ "-ipc-start as -ipc, and also start the server at the other end",
+#endif /* IPC */
+ "-jobname=STRING set the job name to STRING",
+ "-kpathsea-debug=NUMBER set path searching debugging flags according to",
+ " the bits of NUMBER",
+ "[-no]-mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)",
+ "-mltex enable MLTeX extensions such as \\charsubdef",
+ "-output-comment=STRING use STRING for DVI file comment instead of date",
+ "-output-directory=DIR use DIR as the directory to write files to",
+ "[-no]-parse-first-line disable/enable parsing of the first line of the",
+ " input file",
+ "-progname=STRING set program (and fmt) name to STRING",
+ "-recorder enable filename recorder",
+ "[-no]-shell-escape disable/enable \\write18{SHELL COMMAND}",
+ "-src-specials insert source specials into the DVI file",
+ "-src-specials=WHERE insert source specials in certain places of",
+ " the DVI file. WHERE is a comma-separated value",
+ " list: cr display hbox math par parend vbox",
+ "-translate-file=TCXNAME use the TCX file TCXNAME",
+ "-8bit make all characters printable by default",
+ "-help display this help and exit",
+ "-version output version information and exit",
+ NULL
+};
+#endif /* TeX */
+#endif /* TEXMFMP_HELP */
diff --git a/Build/source/texk/web2c/texmfmp.h b/Build/source/texk/web2c/texmfmp.h
new file mode 100644
index 00000000000..45fca14d140
--- /dev/null
+++ b/Build/source/texk/web2c/texmfmp.h
@@ -0,0 +1,286 @@
+/* texmf.h: Main include file for TeX and Metafont in C. This file is
+ included by {tex,mf}d.h, which is the first include in the C files
+ output by web2c. */
+
+#include "cpascal.h"
+#include <kpathsea/c-pathch.h> /* for IS_DIR_SEP, used in the change files */
+#include <kpathsea/tex-make.h> /* for kpse_make_tex_discard_errors */
+
+/* If we have these macros, use them, as they provide a better guide to
+ the endianess when cross-compiling. */
+#if defined (BYTE_ORDER) && defined (BIG_ENDIAN) && defined (LITTLE_ENDIAN)
+#ifdef WORDS_BIGENDIAN
+#undef WORDS_BIGENDIAN
+#endif
+#if BYTE_ORDER == BIG_ENDIAN
+#define WORDS_BIGENDIAN
+#endif
+#endif
+/* More of the same, but now NeXT-specific. */
+#ifdef NeXT
+#ifdef WORDS_BIGENDIAN
+#undef WORDS_BIGENDIAN
+#endif
+#ifdef __BIG_ENDIAN__
+#define WORDS_BIGENDIAN
+#endif
+#endif
+
+/* Some things are the same except for the name. */
+#ifdef TeX
+#if defined (pdfeTeX)
+#define TEXMFPOOLNAME "pdfetex.pool"
+#define TEXMFENGINENAME "pdfetex"
+#elif defined (pdfTeX)
+#define TEXMFPOOLNAME "pdftex.pool"
+#define TEXMFENGINENAME "pdftex"
+#elif defined (eTeX)
+#define TEXMFPOOLNAME "etex.pool"
+#define TEXMFENGINENAME "etex"
+#elif defined (Omega)
+#define TEXMFPOOLNAME "omega.pool"
+#define TEXMFENGINENAME "omega"
+#elif defined (eOmega)
+#define TEXMFPOOLNAME "eomega.pool"
+#define TEXMFENGINENAME "eomega"
+#elif defined (Aleph)
+#define TEXMFPOOLNAME "aleph.pool"
+#define TEXMFENGINENAME "aleph"
+#else
+#define TEXMFPOOLNAME "tex.pool"
+#define TEXMFENGINENAME "tex"
+#endif
+#define DUMP_FILE fmtfile
+#define DUMP_FORMAT kpse_fmt_format
+#define writedvi write_out
+#define flushdvi flush_out
+#define OUT_FILE dvifile
+#define OUT_BUF dvibuf
+#endif /* TeX */
+#ifdef MF
+#define TEXMFPOOLNAME "mf.pool"
+#define TEXMFENGINENAME "metafont"
+#define DUMP_FILE basefile
+#define DUMP_FORMAT kpse_base_format
+#define writegf write_out
+#define OUT_FILE gffile
+#define OUT_BUF gfbuf
+#endif /* MF */
+#ifdef MP
+#define TEXMFPOOLNAME "mp.pool"
+#define TEXMFENGINENAME "metapost"
+#define DUMP_FILE memfile
+#define DUMP_FORMAT kpse_mem_format
+#endif /* MP */
+
+/* Restore underscores. */
+#define kpsedvipsconfigformat kpse_dvips_config_format
+#define kpsefontmapformat kpse_fontmap_format
+#define kpsemfpoolformat kpse_mfpool_format
+#define kpsempformat kpse_mp_format
+#define kpsemppoolformat kpse_mppool_format
+#define kpsetexpoolformat kpse_texpool_format
+#define kpsetexformat kpse_tex_format
+
+/* Hacks for TeX that are better not to #ifdef, see texmfmp.c. */
+extern int tfmtemp, texinputtype;
+
+/* TeX, MF and MetaPost use this. */
+extern boolean openinnameok P1H(const_string);
+extern boolean openoutnameok P1H(const_string);
+
+/* All but the Omega family use this. */
+#if !defined(Omega) && !defined(eOmega) && !defined(Aleph)
+extern void readtcxfile P1H(void);
+extern string translate_filename;
+#define translatefilename translate_filename
+#endif
+
+#ifdef TeX
+/* The type `glueratio' should be a floating point type which won't
+ unnecessarily increase the size of the memoryword structure. This is
+ the basic requirement. On most machines, if you're building a
+ normal-sized TeX, then glueratio must probably meet the following
+ restriction: sizeof(glueratio) <= sizeof(integer). Usually, then,
+ glueratio must be `float'. But if you build a big TeX, you can (on
+ most machines) and should make it `double' to avoid loss of precision
+ and conversions to and from double during calculations. (All this
+ also goes for Metafont.) Furthermore, if you have enough memory, it
+ won't hurt to have this defined to be `double' for running the
+ trip/trap tests.
+
+ This type is set automatically to `float' by configure if a small TeX
+ is built. */
+#ifndef GLUERATIO_TYPE
+#define GLUERATIO_TYPE double
+#endif
+typedef GLUERATIO_TYPE glueratio;
+
+#if defined(__DJGPP__) && defined (IPC)
+#undef IPC
+#endif
+
+#ifdef IPC
+extern void ipcpage P1H(int);
+#endif /* IPC */
+#endif /* TeX */
+
+/* How to output to the GF or DVI file. */
+#define write_out(a, b) \
+ if (fwrite ((char *) &OUT_BUF[a], sizeof (OUT_BUF[a]), \
+ (int) ((b) - (a) + 1), OUT_FILE) \
+ != (int) ((b) - (a) + 1)) \
+ FATAL_PERROR ("fwrite");
+
+#define flush_out() fflush (OUT_FILE)
+
+/* Used to write to a TFM file. */
+#define put2bytes(f, h) do { \
+ integer v = (integer) (h); putbyte (v >> 8, f); putbyte (v & 0xff, f); \
+ } while (0)
+#define put4bytes(f, w) do { \
+ integer v = (integer) (w); \
+ putbyte (v >> 24, f); putbyte (v >> 16, f); \
+ putbyte (v >> 8, f); putbyte (v & 0xff, f); \
+ } while (0)
+
+/* Read a line of input as quickly as possible. */
+#define inputln(stream, flag) input_line (stream)
+extern boolean input_line P1H(FILE *);
+
+/* This routine has to return four values. */
+#define dateandtime(i,j,k,l) get_date_and_time (&(i), &(j), &(k), &(l))
+extern void get_date_and_time P4H(integer *, integer *, integer *, integer *);
+
+/* Get high-res time info. */
+#define secondsandmicros(i,j) get_seconds_and_micros (&(i), &(j))
+extern void get_seconds_and_micros P2H(integer *, integer *);
+
+/* This routine has to return a scaled value. */
+extern integer getrandomseed P1H(void);
+
+/* Copy command-line arguments into the buffer, despite the name. */
+extern void topenin P1H(void);
+
+/* Can't prototype this since it uses poolpointer and ASCIIcode, which
+ are defined later in mfd.h, and mfd.h uses stuff from here. */
+/* Therefore the department of ugly hacks decided to move this declaration
+ to the *coerce.h files. */
+/* extern void calledit (); */
+
+/* Set an array size from texmf.cnf. */
+extern void setupboundvariable P3H(integer *, const_string, integer);
+
+/* `bopenin' (and out) is used only for reading (and writing) .tfm
+ files; `wopenin' (and out) only for dump files. The filenames are
+ passed in as a global variable, `nameoffile'. */
+#define bopenin(f) open_input (&(f), kpse_tfm_format, FOPEN_RBIN_MODE)
+#define ocpopenin(f) open_input (&(f), kpse_ocp_format, FOPEN_RBIN_MODE)
+#define ofmopenin(f) open_input (&(f), kpse_ofm_format, FOPEN_RBIN_MODE)
+#define bopenout(f) open_output (&(f), FOPEN_WBIN_MODE)
+#define bclose aclose
+#define wopenin(f) open_input (&(f), DUMP_FORMAT, FOPEN_RBIN_MODE)
+#define wopenout bopenout
+#define wclose aclose
+
+/* Used in tex.ch (section 1338) to get a core dump in debugging mode. */
+#ifdef unix
+#define dumpcore abort
+#else
+#define dumpcore uexit (1)
+#endif
+
+#ifdef MP
+extern boolean callmakempx P2H(string, string);
+#endif
+
+#ifdef MF
+extern boolean initscreen P1H(void);
+extern void updatescreen P1H(void);
+/* Can't prototype these for same reason as `calledit' above. */
+#if 0 /* Therefore the real declaration is found in the coerce.h files. */
+extern void blankrectangle (/*screencol, screencol, screenrow, screenrow*/);
+extern void paintrow (/*screenrow, pixelcolor, transspec, screencol*/);
+#endif
+#endif /* MF */
+
+/* (Un)dumping. These are called from the change file. */
+#define dumpthings(base, len) \
+ do_dump ((char *) &(base), sizeof (base), (int) (len), DUMP_FILE)
+#define undumpthings(base, len) \
+ do_undump ((char *) &(base), sizeof (base), (int) (len), DUMP_FILE)
+
+/* Like do_undump, but check each value against LOW and HIGH. The
+ slowdown isn't significant, and this improves the chances of
+ detecting incompatible format files. In fact, Knuth himself noted
+ this problem with Web2c some years ago, so it seems worth fixing. We
+ can't make this a subroutine because then we lose the type of BASE. */
+#define undumpcheckedthings(low, high, base, len) \
+ do { \
+ unsigned i; \
+ undumpthings (base, len); \
+ for (i = 0; i < (len); i++) { \
+ if ((&(base))[i] < (low) || (&(base))[i] > (high)) { \
+ FATAL5 ("Item %u (=%ld) of .fmt array at %lx <%ld or >%ld", \
+ i, (integer) (&(base))[i], (unsigned long) &(base), \
+ (integer) low, (integer) high); \
+ } \
+ } \
+ } while (0)
+
+/* Like undump_checked_things, but only check the upper value. We use
+ this when the base type is unsigned, and thus all the values will be
+ greater than zero by definition. */
+#define undumpuppercheckthings(high, base, len) \
+ do { \
+ unsigned i; \
+ undumpthings (base, len); \
+ for (i = 0; i < (len); i++) { \
+ if ((&(base))[i] > (high)) { \
+ FATAL4 ("Item %u (=%ld) of .fmt array at %lx >%ld", \
+ i, (integer) (&(base))[i], (unsigned long) &(base), \
+ (integer) high); \
+ } \
+ } \
+ } while (0)
+
+/* We define the routines to do the actual work in texmf.c. */
+extern void do_dump P4H(char *, int, int, FILE *);
+extern void do_undump P4H(char *, int, int, FILE *);
+
+/* Use the above for all the other dumping and undumping. */
+#define generic_dump(x) dumpthings (x, 1)
+#define generic_undump(x) undumpthings (x, 1)
+
+#define dumpwd generic_dump
+#define dumphh generic_dump
+#define dumpqqqq generic_dump
+#define undumpwd generic_undump
+#define undumphh generic_undump
+#define undumpqqqq generic_undump
+
+/* `dump_int' is called with constant integers, so we put them into a
+ variable first. */
+#define dumpint(x) \
+ do \
+ { \
+ integer x_val = (x); \
+ generic_dump (x_val); \
+ } \
+ while (0)
+
+/* web2c/regfix puts variables in the format file loading into
+ registers. Some compilers aren't willing to take addresses of such
+ variables. So we must kludge. */
+#if defined(REGFIX) || defined(WIN32)
+#define undumpint(x) \
+ do \
+ { \
+ integer x_val; \
+ generic_undump (x_val); \
+ x = x_val; \
+ } \
+ while (0)
+#else
+#define undumpint generic_undump
+#endif
diff --git a/Build/source/texk/web2c/tftopl.ch b/Build/source/texk/web2c/tftopl.ch
new file mode 100644
index 00000000000..405c6265c6f
--- /dev/null
+++ b/Build/source/texk/web2c/tftopl.ch
@@ -0,0 +1,439 @@
+% tftopl.ch for C compilation with web2c.
+%
+% 04/04/83 (PC) Original version, made to work with version 1.0 of TFtoPL,
+% released with version 0.96 of TeX in February, 1983.
+% 04/16/83 (PC) Brought up to version 1.0 released with version 0.97 of TeX
+% in April, 1983.
+% 06/30/83 (HWT) Revised changefile format, for use with version 1.7 Tangle.
+% 07/28/83 (HWT) Brought up to version 2
+% 11/21/83 (HWT) Brought up to version 2.1
+% 03/24/84 (HWT) Brought up to version 2.2
+% 07/12/84 (HWT) Brought up to version 2.3
+% 07/05/87 (ETM) Brought up to version 2.5
+% 03/22/88 (ETM) Converted for use with WEB to C.
+% 11/30/89 (KB) Version 3.
+% 01/16/90 (SR) Version 3.1.
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{TF\lowercase{to}PL changes for C}
+@z
+
+@x [2] Print all terminal output on stderr, so the pl can be sent to stdout.
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@y
+@d print(#)==write(stderr,#)
+@d print_ln(#)==write_ln(stderr,#)
+@z
+
+% [2] Fix files in program statement. We need to tell web2c about one
+% special variable. Perhaps it would be better to allow @define's
+% anywhere in a source file, but that seemed just as painful as this.
+@x
+@p program TFtoPL(@!tfm_file,@!pl_file,@!output);
+@y
+@p
+{Tangle doesn't recognize @@ when it's right after the \.=.}
+@\@= @@define var tfm;@>@\
+program TFtoPL(@!tfm_file,@!pl_file,@!output);
+@z
+
+@x [still 2] Don't print banner until later (and unless verbose).
+procedure initialize; {this procedure gets things started properly}
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ begin
+ kpse_set_progname (argv[0]);
+ kpse_init_prog ('TFTOPL', 0, nil, nil);
+ {We |xrealloc| when we know how big the file is. The 1000 comes
+ from the negative lower bound.}
+ tfm_file_array := cast_to_byte_pointer (xmalloc (1003));
+ parse_arguments;
+@z
+
+@x [5] Increase sizes to match vptovf.
+@!tfm_size=30000; {maximum length of |tfm| data, in bytes}
+@!lig_size=5000; {maximum length of |lig_kern| program, in words}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@y
+@!tfm_size=150000; {maximum length of |tfm| data, in bytes}
+@!lig_size=32510; {maximum length of |lig_kern| program, in words ($<2^{15}$)}
+@!hash_size=32579; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@z
+
+@x [7] Open the TFM file.
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file);
+@y
+@ On some systems you may have to do something special to read a
+packed file of bytes. With C under Unix, we just open the file by name
+and read characters from it.
+
+@<Set init...@>=
+tfm_file := kpse_open_file (tfm_name, kpse_tfm_format);
+if verbose then begin
+ print (banner);
+ print_ln (version_string);
+end;
+@z
+
+@x [17] Open the PL file.
+@ @<Set init...@>=
+rewrite(pl_file);
+@y
+@ If an explicit filename isn't given, we write to |stdout|.
+
+@<Set init...@>=
+if optind + 1 = argc then begin
+ pl_file := stdout;
+end else begin
+ pl_name := extend_filename (cmdline (optind + 1), 'pl');
+ rewrite (pl_file, pl_name);
+end;
+@z
+
+@x [18,19] Make |tfm| be dynamically allocated, and rename `index'.
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!index=0..tfm_size; {address of a byte in |tfm|}
+
+@ @<Glob...@>=
+@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
+@y
+@d index == index_type
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!index=integer; {address of a byte in |tfm|}
+
+@ @<Glob...@>=
+{Kludge here to define |tfm| as a macro which takes care of the negative
+ lower bound. We've defined |tfm| for the benefit of web2c above.}
+@=#define tfm (tfmfilearray + 1001);@>@\
+@!tfm_file_array: pointer_to_byte; {the input data all goes here}
+@z
+
+@x [20] Allow arbitrarily large input files.
+if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+@y
+tfm_file_array
+ := cast_to_byte_pointer (xrealloc (tfm_file_array, 4 * lf - 1 + 1002));
+@z
+
+% [20] Both nl and lig_size are in words, so the multiplication is not
+% needed. Found by "C.M. Connelly" <c@eskimo.com> and
+% Melissa O'Neill <oneill@cs.sfu.ca>
+@x
+if nl>4*lig_size then
+@y
+if nl>lig_size then
+@z
+
+% [27, 28] Change strings to C char pointers. The Pascal strings are
+% indexed starting at 1, so we pad with a blank.
+@x
+@!ASCII_04,@!ASCII_10,@!ASCII_14: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+@y
+@!ASCII_04,@!ASCII_10,@!ASCII_14: c_string;
+ {strings for output in the user's external character set}
+@!ASCII_all: packed array[0..256] of char;
+@!MBL_string,@!RI_string,@!RCE_string: c_string;
+ {handy string constants for |face| codes}
+@z
+
+@x
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+@y
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+strcpy (ASCII_all, ASCII_04);
+strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
+strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/
+MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE';
+@z
+
+% [38] How we output the character code depends on |charcode_format|.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+begin if font_type>vanilla then
+ begin tfm[0]:=c; out_octal(0,1)
+ end
+else if (c>="0")and(c<="9") then
+ out(' C ',c-"0":1)
+else if (c>="A")and(c<="Z") then
+ out(' C ',ASCII_10[c-"A"+2])
+else if (c>="a")and(c<="z") then
+ out(' C ',ASCII_14[c-"a"+2])
+else begin tfm[0]:=c; out_octal(0,1);
+@y
+begin if (font_type > vanilla) or (charcode_format = charcode_octal) then
+ begin tfm[0]:=c; out_octal(0,1)
+ end
+else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~")
+ and (c <> "(") and (c <> ")") then
+ out(' C ', ASCII_all[c - " " + 1])
+{default case, use \.C only for letters and digits}
+else if (c>="0")and(c<="9") then
+ out(' C ',c-"0":1)
+else if (c>="A")and(c<="Z") then
+ out(' C ',ASCII_10[c-"A"+2])
+else if (c>="a")and(c<="z") then
+ out(' C ',ASCII_14[c-"a"+2])
+else begin tfm[0]:=c; out_octal(0,1);
+@z
+
+% [39] Don't output the face code as an integer.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ out(MBL_string[1+(b mod 3)]);
+ out(RI_string[1+s]);
+ out(RCE_string[1+(b div 3)]);
+@y
+ put_byte(MBL_string[1+(b mod 3)], pl_file);
+ put_byte(RI_string[1+s], pl_file);
+ put_byte(RCE_string[1+(b div 3)], pl_file);
+@z
+
+@x [40] Force 32-bit constant arithmetic for 16-bit machines.
+f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
+@y
+f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
+@z
+
+% [78] No progress reports unless verbose.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ incr(chars_on_line);
+ end;
+ print_octal(c); {progress report}
+@y
+ if verbose then incr(chars_on_line);
+ end;
+ if verbose then print_octal(c); {progress report}
+@z
+
+% [89] Change the name of the variable `class', since AIX 3.1's <math.h>
+% defines a function by that name.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d pending=4 {$f(x,y)$ is being evaluated}
+@y
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+@d class == class_var
+@z
+
+% [90] Change name of the function `f'.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ r:=f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);
+@y
+ r:=f_fn(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);
+@z
+
+% [94] web2c can't handle these mutually recursive procedures.
+% But let's do a fake definition of f here, so that it gets into web2c's
+% symbol table. We also have to change the name, because there is also a
+% variable named `f', and some C compilers can't deal with that.
+@x
+@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+@y
+@p
+ifdef('notdef')
+function f_fn(@!h,@!x,@!y:index):index; begin end;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+endif('notdef')
+@z
+@x
+else eval:=f(h,x,y);
+@y
+else eval:=f_fn(h,x,y);
+@z
+
+% [95] The real definition of f.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p function f;
+@y
+@p function f_fn(@!h,@!x,@!y:index):index;
+@z
+@x
+f:=lig_z[h];
+@y
+f_fn:=lig_z[h];
+@z
+
+% [99] No final newline unless verbose.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+do_characters; print_ln('.');@/
+@y
+do_characters; if verbose then print_ln('.');@/
+@z
+
+@x [100] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TFtoPL} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 4; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('tftopl');
+
+ end else if argument_is ('help') then begin
+ usage_help (TFTOPL_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.E. Knuth');
+
+ end else if argument_is ('charcode-format') then begin
+ if strcmp (optarg, 'ascii') = 0 then
+ charcode_format := charcode_ascii
+ else if strcmp (optarg, 'octal') = 0 then
+ charcode_format := charcode_octal
+ else
+ print_ln ('Bad character code format', optarg, '.');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ print_ln ('tftopl: Need one or two file arguments.');
+ usage ('tftopl');
+ end;
+
+ tfm_name := cmdline (optind);
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+@.-verbose@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@
+@<Initialize the option...@> =
+verbose := false;
+
+@ This option changes how we output character codes.
+@.-charcode-format@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'charcode-format';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ We use an ``enumerated'' type to store the information.
+
+@<Type...@> =
+@!charcode_format_type = charcode_ascii..charcode_default;
+
+@
+@<Const...@> =
+@!charcode_ascii = 0;
+@!charcode_octal = 1;
+@!charcode_default = 2;
+
+@
+@<Global...@> =
+@!charcode_format: charcode_format_type;
+
+@ It starts off as the default, that is, we output letters and digits as
+ASCII characters, everything else in octal.
+
+@<Initialize the option...@> =
+charcode_format := charcode_default;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!tfm_name, @!pl_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/tftopl.rc b/Build/source/texk/web2c/tftopl.rc
new file mode 100644
index 00000000000..53c8223fac3
--- /dev/null
+++ b/Build/source/texk/web2c/tftopl.rc
@@ -0,0 +1,34 @@
+/* tftopl.rc: tftopl resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " tftopl 3.1"
+
+#define VER_INTERNALNAME_STR "tftopl"
+#define VER_ORIGINALFILENAME_STR "tftopl.exe"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#define VER_FILEDESCRIPTION_STR "TFM-to-PL converter"
+
+#include <texlive.version>
+
+/* tftopl.rc ends here */
diff --git a/Build/source/texk/web2c/tftopl.web b/Build/source/texk/web2c/tftopl.web
new file mode 100644
index 00000000000..188d15629dd
--- /dev/null
+++ b/Build/source/texk/web2c/tftopl.web
@@ -0,0 +1,1591 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was implemented in January 1982.
+% In February 1982 a new restriction on ligature steps was added.
+% In June 1982 the routines were divided into smaller pieces for IBM people,
+% and the result was designated "Version 1" in September 1982.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 2 (July 1983) was released with TeX version 0.999.
+% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN.
+% Version 2.2 (February 1984) simplified decimal fraction output.
+% Version 2.3 (May 1984) fixed a bug when lh=17.
+% Version 2.4 (July 1984) fixed a bug involving unused ligature code.
+% Version 2.5 (September 1985) updated the standard codingscheme names.
+% Version 3 (October 1989) introduced new ligature capabilities.
+% Version 3.1 (November 1989) renamed z[] to lig_z[] for better portability.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{TF\lowercase{to}PL}
+\def\contentspagenumber{201}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont TFtoPL} processor}
+ \vskip 15pt
+ \centerline{(Version 3.1, November 1989)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{TFtoPL} utility program converts \TeX\ font metric (``\.{TFM}'')
+files into equivalent property-list (``\.{PL}'') files. It also
+makes a thorough check of the given \.{TFM} file, using essentially the
+same algorithm as \TeX. Thus if \TeX\ complains that a \.{TFM}
+file is ``bad,'' this program will pinpoint the source or sources of
+badness. A \.{PL} file output by this program can be edited with
+a normal text editor, and the result can be converted back to \.{TFM}
+format using the companion program \.{PLtoTF}.
+
+The first \.{TFtoPL} program was designed by Leo Guibas in the summer of
+1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw
+also had a significant effect on the evolution of the present code.
+
+Extensions for an enhanced ligature mechanism were added by the author in 1989.
+
+The |banner| string defined here should be changed whenever \.{TFtoPL}
+gets modified.
+
+@d banner=='This is TFtoPL, Version 3.1' {printed when the program starts}
+
+@ This program is written entirely in standard \PASCAL, except that
+it occasionally has lower case letters in strings that are output.
+Such letters can be converted to upper case if necessary. The input is read
+from |tfm_file|, and the output is written on |pl_file|; error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program TFtoPL(@!tfm_file,@!pl_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{TFtoPL}'s capacity.
+
+@<Constants...@>=
+@!tfm_size=30000; {maximum length of |tfm| data, in bytes}
+@!lig_size=5000; {maximum length of |lig_kern| program, in words}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* Font metric data.
+The idea behind \.{TFM} files is that typesetting routines like \TeX\
+need a compact way to store the relevant information about several
+dozen fonts, and computer centers need a compact way to store the
+relevant information about several hundred fonts. \.{TFM} files are
+compact, and most of the information they contain is highly relevant,
+so they provide a solution to the problem.
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of 4, we could
+also regard the file as a sequence of 32-bit words; but \TeX\ uses the
+byte interpretation, and so does \.{TFtoPL}. Note that the bytes
+are considered to be unsigned numbers.
+
+@<Glob...@>=
+@!tfm_file:packed file of 0..255;
+
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file);
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|@!lf|&length of the entire file, in words;\cr
+|@!lh|&length of the header data, in words;\cr
+|@!bc|&smallest character code in the font;\cr
+|@!ec|&largest character code in the font;\cr
+|@!nw|&number of words in the width table;\cr
+|@!nh|&number of words in the height table;\cr
+|@!nd|&number of words in the depth table;\cr
+|@!ni|&number of words in the italic correction table;\cr
+|@!nl|&number of words in the lig/kern table;\cr
+|@!nk|&number of words in the kern table;\cr
+|@!ne|&number of words in the extensible character table;\cr
+|@!np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+|ne<=256|, and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+
+@<Glob...@>=
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np:0..@'77777;
+ {subfile sizes}
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
+header&|[0..lh-1]stuff|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but one of
+the |fix_word| values will lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+and for \.{TFM} files to be used with Xerox printing software it must
+contain at least 18 words, allocated as described below. When different
+kinds of devices need to be interfaced, it may be necessary to add further
+words to the header block.
+
+\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the
+\.{DVI} output file whenever it uses the font. Later on when the \.{DVI}
+file is printed, possibly on another computer, the actual font that gets
+used is supposed to have a check sum that agrees with the one in the
+\.{TFM} file used by \TeX. In this way, users will be warned about
+potential incompatibilities. (However, if the check sum is zero in either
+the font file or the \.{TFM} file, no check is made.) The actual relation
+between this check sum and the rest of the \.{TFM} file is not important;
+the check sum is simply an identification number with the property that
+incompatible fonts almost always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of the
+font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number
+must be at least 1.0; it is fairly arbitrary, but usually the design size
+is 10.0 for a ``10 point'' font, i.e., a font that was designed to look
+best at a 10-point size, whatever that really means. When a \TeX\ user
+asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the
+design size and replace it by $\delta$, and to multiply the $x$ and~$y$
+coordinates of the points in the font image by a factor of $\delta$
+divided by the design size. {\sl All other dimensions in the\/\ \.{TFM}
+file are |fix_word|\kern-1pt\ numbers in design-size units.} Thus, for example,
+the value of |param[6]|, one \.{em} or \.{\\quad}, is often the |fix_word|
+value $2^{20}=1.0$, since many fonts have a design size equal to one em.
+The other dimensions must be less than 16 design-size units in absolute
+value; thus, |header[1]| and |param[1]| are the only |fix_word| entries in
+the whole \.{TFM} file whose first byte might be something besides 0 or
+255. @^design size@>
+
+\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify
+the character coding scheme. The first byte, which must be between 0 and
+39, is the number of subsequent ASCII bytes actually relevant in this
+string, which is intended to specify what character-code-to-symbol
+convention is present in the font. Examples are \.{ASCII} for standard
+ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math
+extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for
+special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case
+when there is no information. Parentheses should not appear in this name.
+(Such a string is said to be in {\mc BCPL} format.)
+@^coding scheme@>
+
+\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the
+font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format.
+This field is also known as the ``font identifier.''
+@^family name@>
+@^font identifier@>
+
+\yskip\hang|header[17]|, if present, contains a first byte called the
+|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte
+called the |face|. If the value of the fourth byte is less than 18, it has
+the following interpretation as a ``weight, slope, and expansion'': Add 0
+or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to
+0 or 6 or 12 (for regular or condensed or extended). For example, 13 is
+0+1+12, so it represents medium italic extended. A three-letter code
+(e.g., \.{MIE}) can be used for such |face| data.
+
+\yskip\hang|header[18..@twhatever@>]| might also be present; the individual
+words are simply called |header[18]|, |header[19]|, etc., at the moment.
+
+@ Next comes the |char_info| array, which contains one |char_info_word|
+per character. Each |char_info_word| contains six fields packed into
+four bytes as follows.
+
+\yskip\hang first byte: |width_index| (8 bits)\par
+\hang second byte: |height_index| (4 bits) times 16, plus |depth_index|
+ (4~bits)\par
+\hang third byte: |italic_index| (6 bits) times 4, plus |tag|
+ (2~bits)\par
+\hang fourth byte: |remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is |width[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation |width[0]=height[0]=depth[0]=italic[0]=0|
+should always hold, so that an index of zero implies a value of zero.
+The |width_index| should never be zero unless the character does
+not exist in the font, since a character is valid if and only if it lies
+between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at |lig_kern[remainder]|.\par
+\hang|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain. The
+|remainder| field gives the character code of the next larger character.\par
+\hang|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|exten[remainder]|.\par
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word is a
+|lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+ step if the byte is 128 or more, otherwise the next step is obtained by
+ skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+ then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+ a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+Notice that if $a=0$ and $b=1$, the current character is unchanged; if
+$a=b$ and $c=1$, the current character is changed but the next character is
+unchanged. \.{TFtoPL} will check to see that infinite loops are avoided.
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must have
+|256*op_byte+remainder<nl|. If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+command is performed.
+
+@d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@ Extensible characters are specified by an |extensible_recipe|,
+which consists of four bytes called |top|, |mid|,
+|bot|, and |rep| (in this order). These bytes are the character codes
+of individual pieces used to build up a large symbol.
+If |top|, |mid|, or |bot| are zero,
+they are not present in the built-up result. For example, an extensible
+vertical line is like an extensible bracket, except that the top and
+bottom pieces are missing.
+
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=@!slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it's the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character |" "| in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the height of letters for which accents don't
+have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+When the character coding scheme is \.{TeX math symbols}, the font is
+supposed to have 15 additional parameters called |num1|, |num2|, |num3|,
+|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|,
+|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the
+character coding scheme is \.{TeX math extension}, the font is supposed to
+have six additional parameters called |default_rule_thickness| and
+|big_op_spacing1| through |big_op_spacing5|.
+
+@ So that is what \.{TFM} files hold. The next question is, ``What about
+\.{PL} files?'' A complete answer to that question appears in the
+documentation of the companion program, \.{PLtoTF}, so it will not
+be repeated here. Suffice it to say that a \.{PL} file is an ordinary
+\PASCAL\ text file, and that the output of \.{TFtoPL} uses only a
+subset of the possible constructions that might appear in a \.{PL} file.
+Furthermore, hardly anybody really wants to look at the formal
+definition of \.{PL} format, because it is almost self-explanatory when
+you see an example or two.
+
+@<Glob...@>=
+@!pl_file:text;
+
+@ @<Set init...@>=
+rewrite(pl_file);
+
+@* Unpacked representation.
+The first thing \.{TFtoPL} does is read the entire |tfm_file| into an array of
+bytes, |tfm[0..(4*lf-1)]|.
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!index=0..tfm_size; {address of a byte in |tfm|}
+
+@ @<Glob...@>=
+@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
+ {the negative addresses avoid range checks for invalid characters}
+
+@ The input may, of course, be all screwed up and not a \.{TFM} file
+at all. So we begin cautiously.
+
+@d abort(#)==begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a TFM?');
+ goto final_end;
+ end
+
+@<Read the whole input file@>=
+read(tfm_file,tfm[0]);
+if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
+@.The first byte...@>
+if eof(tfm_file) then abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
+if lf=0 then
+ abort('The file claims to have length zero, but that''s impossible!');
+@.The file claims...@>
+if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+for tfm_ptr:=2 to 4*lf-1 do
+ begin if eof(tfm_file) then
+ abort('The file has fewer bytes than it claims!');
+@.The file has fewer bytes...@>
+ read(tfm_file,tfm[tfm_ptr]);
+ end;
+if not eof(tfm_file) then
+ begin print_ln('There''s some extra junk at the end of the TFM file,');
+@.There's some extra junk...@>
+ print_ln('but I''ll proceed as if it weren''t there.');
+ end
+
+@ After the file has been read successfully, we look at the subfile sizes
+to see if they check out.
+
+@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then
+ abort('One of the subfile sizes is negative!');
+@.One of the subfile sizes...@>
+ #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1];
+ tfm_ptr:=tfm_ptr+2;
+ end
+
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>=
+begin tfm_ptr:=2;@/
+eval_two_bytes(lh);
+eval_two_bytes(bc);
+eval_two_bytes(ec);
+eval_two_bytes(nw);
+eval_two_bytes(nh);
+eval_two_bytes(nd);
+eval_two_bytes(ni);
+eval_two_bytes(nl);
+eval_two_bytes(nk);
+eval_two_bytes(ne);
+eval_two_bytes(np);
+if lh<2 then abort('The header length is only ',lh:1,'!');
+@.The header length...@>
+if nl>4*lig_size then
+ abort('The lig/kern program is longer than I can handle!');
+@.The lig/kern program...@>
+if (bc>ec+1)or(ec>255) then abort('The character code range ',
+@.The character code range...@>
+ bc:1,'..',ec:1,'is illegal!');
+if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
+ abort('Incomplete subfiles for character dimensions!');
+@.Incomplete subfiles...@>
+if ne>256 then abort('There are ',ne:1,' extensible recipes!');
+@.There are ... recipes@>
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then
+ abort('Subfile sizes don''t add up to the stated total!');
+@.Subfile sizes don't add up...@>
+end
+
+@ Once the input data successfully passes these basic checks,
+\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion
+to \.{PL} format will take place. Access to the various subfiles
+is facilitated by computing the following base addresses. For example,
+the |char_info| for character |c| will start in location
+|4*(char_base+c)| of the |tfm| array.
+
+@<Globals...@>=
+@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base,
+@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
+ {base addresses for the subfiles}
+
+@ @<Compute the base addresses@>=
+begin char_base:=6+lh-bc;
+width_base:=char_base+ec+1;
+height_base:=width_base+nw;
+depth_base:=height_base+nh;
+italic_base:=depth_base+nd;
+lig_kern_base:=italic_base+ni;
+kern_base:=lig_kern_base+nl;
+exten_base:=kern_base+nk;
+param_base:=exten_base+ne-1;
+end
+
+@ Of course we want to define macros that suppress the detail of how the
+font information is actually encoded. Each word will be referred to by
+the |tfm| index of its first byte. For example, if |c| is a character
+code between |bc| and |ec|, then |tfm[char_info(c)]| will be the
+first byte of its |char_info|, i.e., the |width_index|; furthermore
+|width(c)| will point to the |fix_word| for |c|'s width.
+
+@d check_sum=24
+@d design_size=check_sum+4
+@d scheme=design_size+4
+@d family=scheme+40
+@d random_word=family+20
+@d char_info(#)==4*(char_base+#)
+@d width_index(#)==tfm[char_info(#)]
+@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0))
+@d height_index(#)==(tfm[char_info(#)+1] div 16)
+@d depth_index(#)==(tfm[char_info(#)+1] mod 16)
+@d italic_index(#)==(tfm[char_info(#)+2] div 4)
+@d tag(#)==(tfm[char_info(#)+2] mod 4)
+@d reset_tag(#)==tfm[char_info(#)+2]:=4*italic_index(#)+no_tag
+@d remainder(#)==tfm[char_info(#)+3]
+@d width(#)==4*(width_base+width_index(#))
+@d height(#)==4*(height_base+height_index(#))
+@d depth(#)==4*(depth_base+depth_index(#))
+@d italic(#)==4*(italic_base+italic_index(#))
+@d exten(#)==4*(exten_base+remainder(#))
+@d lig_step(#)==4*(lig_kern_base+(#))
+@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
+@d param(#)==4*(param_base+#) {likewise}
+
+@ One of the things we would like to do is take cognizance of fonts whose
+character coding scheme is \.{TeX math symbols} or \.{TeX math extension};
+we will set the |font_type| variable to one of the three choices
+|vanilla|, |mathsy|, or |mathex|.
+
+@d vanilla=0 {not a special scheme}
+@d mathsy=1 {\.{TeX math symbols} scheme}
+@d mathex=2 {\.{TeX math extension} scheme}
+
+@<Glob...@>=
+@!font_type:vanilla..mathex; {is this font special?}
+
+@* Basic output subroutines.
+Let us now define some procedures that will reduce the rest of \.{TFtoPL}'s
+work to a triviality.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{PL} file:
+
+@d out(#)==write(pl_file,#)
+
+@ In order to stick to standard \PASCAL, we use three strings called
+|ASCII_04|, |ASCII_10|, and |ASCII_14|, in terms of which we can do the
+appropriate conversion of ASCII codes. Three other little strings are
+used to produce |face| codes like \.{MIE}.
+
+@<Glob...@>=
+@!ASCII_04,@!ASCII_10,@!ASCII_14: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+
+@ @<Set init...@>=
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+
+@ The array |dig| will hold a sequence of digits to be output.
+
+@<Glob...@>=
+@!dig:array[0..11] of 0..9;
+
+@ Here, in fact, are two procedures that output |dig[j-1]|$\,\ldots\,$|dig[0]|,
+given $j>0$.
+
+@p procedure out_digs(j:integer); {outputs |j| digits}
+begin repeat decr(j); out(dig[j]:1);
+until j=0;
+end;
+@#
+procedure print_digs(j:integer); {prints |j| digits}
+begin repeat decr(j); print(dig[j]:1);
+until j=0;
+end;
+
+@ The |print_octal| procedure indicates how |print_digs| can be used.
+Since this procedure is used only to print character codes, it always
+produces three digits.
+
+@p procedure print_octal(c:byte); {prints octal value of |c|}
+var j:0..2; {index into |dig|}
+begin print(''''); {an apostrophe indicates the octal notation}
+for j:=0 to 2 do
+ begin dig[j]:=c mod 8; c:=c div 8;
+ end;
+print_digs(3);
+end;
+
+@ A \.{PL} file has nested parentheses, and we want to format the output
+so that its structure is clear. The |level| variable keeps track of the
+depth of nesting.
+
+@<Glob...@>=
+@!level:0..5;
+
+@ @<Set init...@>=
+level:=0;
+
+@ Three simple procedures suffice to produce the desired structure in the
+output.
+
+@p procedure out_ln; {finishes one line, indents the next}
+var l:0..5;
+begin write_ln(pl_file);
+for l:=1 to level do out(' ');
+end;
+@#
+procedure left; {outputs a left parenthesis}
+begin incr(level); out('(');
+end;
+@#
+procedure right; {outputs a right parenthesis and finishes a line}
+begin decr(level); out(')'); out_ln;
+end;
+
+@ The value associated with a property can be output in a variety of
+ways. For example, we might want to output a {\mc BCPL} string that
+begins in |tfm[k]|:
+
+@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space}
+var l:0..39; {the number of bytes remaining}
+begin out(' '); l:=tfm[k];
+while l>0 do
+ begin incr(k); decr(l);
+ case tfm[k] div @'40 of
+ 1: out(ASCII_04[1+(tfm[k] mod @'40)]);
+ 2: out(ASCII_10[1+(tfm[k] mod @'40)]);
+ 3: out(ASCII_14[1+(tfm[k] mod @'40)]);
+ end;
+ end;
+end;
+
+@ The property value might also be a sequence of |l| bytes, beginning
+in |tfm[k]|, that we would like to output in octal notation.
+The following procedure assumes that |l<=4|, but larger values of |l|
+could be handled easily by enlarging the |dig| array and increasing
+the upper bounds on |b| and |j|.
+
+@p procedure out_octal(@!k,@!l:index); {outputs |l| bytes in octal}
+var a:0..@'1777; {accumulator for bits not yet output}
+@!b:0..32; {the number of significant bits in |a|}
+@!j:0..11; {the number of digits of output}
+begin out(' O '); {specify octal format}
+a:=0; b:=0; j:=0;
+while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>;
+while (a>0)or(j=0) do
+ begin dig[j]:=a mod 8; a:=a div 8; incr(j);
+ end;
+out_digs(j);
+end;
+
+@ @<Reduce \(1)|l|...@>=
+begin decr(l);
+if tfm[k+l]<>0 then
+ begin while b>2 do
+ begin dig[j]:=a mod 8; a:=a div 8; b:=b-3; incr(j);
+ end;
+ case b of
+ 0: a:=tfm[k+l];
+ 1:a:=a+2*tfm[k+l];
+ 2:a:=a+4*tfm[k+l];
+ end;
+ end;
+b:=b+8;
+end
+
+@ The property value may be a character, which is output in octal
+unless it is a letter or a digit. This procedure is the only place
+where a lowercase letter will be output to the \.{PL} file.
+@^system dependencies@>
+
+@p procedure out_char(@!c:byte); {outputs a character}
+begin if font_type>vanilla then
+ begin tfm[0]:=c; out_octal(0,1)
+ end
+else if (c>="0")and(c<="9") then
+ out(' C ',c-"0":1)
+else if (c>="A")and(c<="Z") then
+ out(' C ',ASCII_10[c-"A"+2])
+else if (c>="a")and(c<="z") then
+ out(' C ',ASCII_14[c-"a"+2])
+else begin tfm[0]:=c; out_octal(0,1);
+ end;
+end;
+
+@ The property value might be a ``face'' byte, which is output in the
+curious code mentioned earlier, provided that it is less than 18.
+
+@p procedure out_face(@!k:index); {outputs a |face|}
+var s:0..1; {the slope}
+@!b:0..8; {the weight and expansion}
+begin if tfm[k]>=18 then out_octal(k,1)
+else begin out(' F '); {specify face-code format}
+ s:=tfm[k] mod 2; b:=tfm[k] div 2;
+ out(MBL_string[1+(b mod 3)]);
+ out(RI_string[1+s]);
+ out(RCE_string[1+(b div 3)]);
+ end;
+end;
+
+@ And finally, the value might be a |fix_word|, which is output in
+decimal notation with just enough decimal places for \.{PLtoTF}
+to recover every bit of the given |fix_word|.
+
+All of the numbers involved in the intermediate calculations of
+this procedure will be nonnegative and less than $10\cdot2^{24}$.
+
+@p procedure out_fix(@!k:index); {outputs a |fix_word|}
+var a:0..@'7777; {accumulator for the integer part}
+@!f:integer; {accumulator for the fraction part}
+@!j:0..12; {index into |dig|}
+@!delta:integer; {amount if allowable inaccuracy}
+begin out(' R '); {specify real format}
+a:=(tfm[k]*16)+(tfm[k+1] div 16);
+f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
+if a>@'3777 then @<Reduce \(2)negative to positive@>;
+@<Output the integer part, |a|, in decimal notation@>;
+@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>;
+end;
+
+@ The following code outputs at least one digit even if |a=0|.
+
+@<Output the integer...@>=
+begin j:=0;
+repeat dig[j]:=a mod 10; a:=a div 10; incr(j);
+until a=0;
+out_digs(j);
+end
+
+@ And the following code outputs at least one digit to the right
+of the decimal point.
+
+@<Output the fraction...@>=
+begin out('.'); f:=10*f+5; delta:=10;
+repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2);
+out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10;
+until f<=delta;
+end;
+
+@ @<Reduce \(2)negative to positive@>=
+begin out('-'); a:=@'10000-a;
+if f>0 then
+ begin f:=@'4000000-f; decr(a);
+ end;
+end
+
+@* Doing it.
+\TeX\ checks the information of a \.{TFM} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. And when it finds something wrong, it justs
+calls the file ``bad,'' without identifying the nature of the problem,
+since \.{TFM} files are supposed to be good almost all of the time.
+
+Of course, a bad file shows up every now and again, and that's where
+\.{TFtoPL} comes in. This program wants to catch at least as many errors as
+\TeX\ does, and to give informative error messages besides.
+All of the errors are corrected, so that the \.{PL} output will
+be correct (unless, of course, the \.{TFM} file was so loused up
+that no attempt is being made to fathom it).
+
+@ Just before each character is processed, its code is printed in octal
+notation. Up to eight such codes appear on a line; so we have a variable
+to keep track of how many are currently there. We also keep track of
+whether or not any errors have had to be corrected.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+@!perfect:boolean; {was the file free of errors?}
+
+@ @<Set init...@>=
+chars_on_line:=0;@/
+perfect:=true; {innocent until proved guilty}
+
+@ Error messages are given with the help of the |bad| and |range_error|
+and |bad_char| macros:
+
+@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print_ln('Bad TFM file: ',#);
+ end
+@.Bad TFM file@>
+@d range_error(#)==begin perfect:=false; print_ln(' ');
+ print(#,' index for character ');
+ print_octal(c); print_ln(' is too large;');
+ print_ln('so I reset it to zero.');
+ end
+@d bad_char_tail(#)==print_octal(#); print_ln('.');
+ end
+@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad TFM file: ',#,' nonexistent character ');
+ bad_char_tail
+@d correct_bad_char_tail(#)==print_octal(tfm[#]); print_ln('.'); tfm[#]:=bc;
+ end
+@d correct_bad_char(#)== begin perfect:=false;
+ if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad TFM file: ',#,' nonexistent character ');
+ correct_bad_char_tail
+
+@<Glob...@>=
+@!i:0..@'77777; {an index to words of a subfile}
+@!c:0..256; {a random character}
+@!d:0..3; {byte number in a word}
+@!k:index; {a random index}
+@!r:0..65535; {a random two-byte value}
+@!count:0..127; {for when we need to enumerate a small set}
+
+@ There are a lot of simple things to do, and they have to be done one
+at a time, so we might as well get down to business. The first things
+that \.{TFtoPL} will put into the \.{PL} file appear in the header part.
+
+@<Do the header@>=
+begin font_type:=vanilla;
+if lh>=12 then
+ begin @<Set the true |font_type|@>;
+ if lh>=17 then
+ begin @<Output the family name@>;
+ if lh>=18 then @<Output the rest of the header@>;
+ end;
+ @<Output the character coding scheme@>;
+ end;
+@<Output the design size@>;
+@<Output the check sum@>;
+@<Output the |seven_bit_safe_flag|@>;
+end
+
+@ @<Output the check sum@>=
+left; out('CHECKSUM'); out_octal(check_sum,4);
+right
+
+@ Incorrect design sizes are changed to 10 points.
+
+@d bad_design(#)==begin bad('Design size ',#,'!');
+@.Design size wrong@>
+ print_ln('I''ve set it to 10 points.');
+ out(' D 10');
+ end
+
+@ @<Output the design size@>=
+left; out('DESIGNSIZE');
+if tfm[design_size]>127 then bad_design('negative')
+else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then
+ bad_design('too small')
+else out_fix(design_size);
+right;
+out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln;
+out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln
+@.DESIGNSIZE IS IN POINTS@>
+
+@ Since we have to check two different {\mc BCPL} strings for validity,
+we might as well write a subroutine to make the check.
+
+@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|}
+var j:index; {runs through the string}
+@!c:byte; {character being checked}
+begin if tfm[k]>=l then
+ begin bad('String is too long; I''ve shortened it drastically.');
+@.String is too long...@>
+ tfm[k]:=1;
+ end;
+for j:=k+1 to k+tfm[k] do
+ begin c:=tfm[j];
+ if (c="(")or(c=")") then
+ begin bad('Parenthesis in string has been changed to slash.');
+@.Parenthesis...changed to slash@>
+ tfm[j]:="/";
+ end
+ else if (c<" ")or(c>"~") then
+ begin bad('Nonstandard ASCII code has been blotted out.');
+@.Nonstandard ASCII code...@>
+ tfm[j]:="?";
+ end
+ else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters}
+ end;
+end;
+
+@ The |font_type| starts out |vanilla|; possibly we need to reset it.
+
+@<Set the true |font_type|@>=
+begin check_BCPL(scheme,40);
+if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@|
+ (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@|
+ (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@|
+ (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@|
+ (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then
+ begin if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy
+ else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex;
+ end;
+end
+
+@ @<Output the character coding scheme@>=
+left; out('CODINGSCHEME');
+out_BCPL(scheme);
+right
+
+@ @<Output the family name@>=
+left; out('FAMILY');
+check_BCPL(family,20);
+out_BCPL(family);
+right
+
+@ @<Output the rest of the header@>=
+begin left; out('FACE'); out_face(random_word+3); right;
+for i:=18 to lh-1 do
+ begin left; out('HEADER D ',i:1);
+ out_octal(check_sum+4*i,@,4); right;
+ end;
+end
+
+@ This program does not check to see if the |seven_bit_safe_flag| has the
+correct setting, i.e., if it really reflects the seven-bit-safety of
+the \.{TFM} file; the stated value is merely put into the \.{PL} file.
+The \.{PLtoTF} program will store a correct value and give a warning
+message if a file falsely claims to be safe.
+
+@<Output the |seven_bit_safe_flag|@>=
+if (lh>17) and (tfm[random_word]>127) then
+ begin left; out('SEVENBITSAFEFLAG TRUE'); right;
+ end
+
+@ The next thing to take care of is the list of parameters.
+
+@<Do the parameters@>=
+if np>0 then
+ begin left; out('FONTDIMEN'); out_ln;
+ for i:=1 to np do @<Check and output the $i$th parameter@>;
+ right;
+ end;
+@<Check to see if |np| is complete for this font type@>;
+
+@ @<Check to see if |np|...@>=
+if (font_type=mathsy)and(np<>22) then
+ print_ln('Unusual number of fontdimen parameters for a math symbols font (',
+@.Unusual number of fontdimen...@>
+ np:1,' not 22).')
+else if (font_type=mathex)and(np<>13) then
+ print_ln('Unusual number of fontdimen parameters for an extension font (',
+ np:1,' not 13).')
+
+@ All |fix_word| values except the design size and the first parameter
+will be checked to make sure that they are less than 16.0 in magnitude,
+using the |check_fix| macro:
+
+@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;');
+ print_ln('I have set it to zero.');
+ end
+@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then
+ begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0;
+ check_fix_tail
+
+@<Check and output the $i$th parameter@>=
+begin left;
+if i=1 then out('SLANT') {this parameter is not checked}
+else begin check_fix(param(i))('Parameter');@/
+@.Parameter n is too big@>
+ @<Output the name of parameter $i$@>;
+ end;
+out_fix(param(i)); right;
+end
+
+@ @<Output the name...@>=
+if i<=7 then case i of
+ 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK');
+ 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end
+else if (i<=22)and(font_type=mathsy) then case i of
+ 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3');
+ 11:out('DENOM1');@+12:out('DENOM2');
+ 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3');
+ 16:out('SUB1');@+17:out('SUB2');
+ 18:out('SUPDROP');@+19:out('SUBDROP');
+ 20:out('DELIM1');@+21:out('DELIM2');
+ 22:out('AXISHEIGHT')@+end
+else if (i<=13)and(font_type=mathex) then
+ if i=8 then out('DEFAULTRULETHICKNESS')
+ else out('BIGOPSPACING',i-8:1)
+else out('PARAMETER D ',i:1)
+
+@ We need to check the range of all the remaining |fix_word| values,
+and to make sure that |width[0]=0|, etc.
+
+@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0)
+
+@<Check the |fix_word| entries@>=
+if nonzero_fix(4*width_base) then bad('width[0] should be zero.');
+@.should be zero@>
+if nonzero_fix(4*height_base) then bad('height[0] should be zero.');
+if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.');
+if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.');
+for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width');
+@.Width n is too big@>
+for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height');
+@.Height n is too big@>
+for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth');
+@.Depth n is too big@>
+for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction');
+@.Italic correction n is too big@>
+if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
+@.Kern n is too big@>
+
+@ The ligature/kerning program comes next. Before we can put it out in
+\.{PL} format, we need to make a table of ``labels'' that will be inserted
+into the program. For each character |c| whose |tag| is |lig_tag| and
+whose starting address is |r|, we will store the pair |(c,r)| in the
+|label_table| array. If there's a boundary-char program starting at~|r|,
+we also store the pair |(256,r)|.
+This array is sorted by its second components, using the
+simple method of straight insertion.
+
+@<Glob...@>=
+@!label_table:array[0..258] of record@t@>@/@!cc:0..256;@!rr:0..lig_size;end;
+@!label_ptr: 0..257; {the largest entry in |label_table|}
+@!sort_ptr:0..257; {index into |label_table|}
+@!boundary_char:0..256; {boundary character, or 256 if none}
+@!bchar_label:0..@'77777; {beginning of boundary character program}
+
+@ @<Set init...@>=
+boundary_char:=256; bchar_label:=@'77777;@/
+label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
+
+@ We'll also identify and remove inaccessible program steps, using the
+|activity| array.
+
+@d unreachable=0 {a program step not known to be reachable}
+@d pass_through=1 {a program step passed through on initialization}
+@d accessible=2 {a program step that can be relevant}
+
+@<Glob...@>=
+@!activity:array[0..lig_size] of unreachable..accessible;
+@!ai,@!acti:0..lig_size; {indices into |activity|}
+
+@ @<Do the ligatures and kerns@>=
+if nl>0 then
+ begin for ai:=0 to nl-1 do activity[ai]:=unreachable;
+ @<Check for a boundary char@>;
+ end;
+@<Build the label table@>;
+if nl>0 then
+ begin left; out('LIGTABLE'); out_ln;@/
+ @<Compute the |activity| array@>;
+ @<Output and correct the ligature/kern program@>;
+ right;
+ @<Check for ligature cycles@>;
+ end
+
+@ We build the label table even when |nl=0|, because this catches errors
+that would not otherwise be detected.
+
+@<Build...@>=
+for c:=bc to ec do if tag(c)=lig_tag then
+ begin r:=remainder(c);
+ if r<nl then
+ begin if tfm[lig_step(r)]>stop_flag then
+ begin r:=256*tfm[lig_step(r)+2]+tfm[lig_step(r)+3];
+ if r<nl then if activity[remainder(c)]=unreachable then
+ activity[remainder(c)]:=pass_through;
+ end;
+ end;
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for character '); print_octal(c);
+ print_ln(' is too large;'); print_ln('so I removed it.'); reset_tag(c);
+@.Ligature/kern starting index...@>
+ end
+ else @<Insert |(c,r)| into |label_table|@>;
+ end;
+label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end}
+
+@ @<Insert |(c,r)|...@>=
+begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+while label_table[sort_ptr].rr>r do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+label_table[sort_ptr+1].cc:=c;
+label_table[sort_ptr+1].rr:=r; {fill the hole}
+incr(label_ptr); activity[r]:=accessible;
+end
+
+@ @<Check for a bound...@>=
+if tfm[lig_step(0)]=255 then
+ begin left; out('BOUNDARYCHAR');
+ boundary_char:=tfm[lig_step(0)+1]; out_char(boundary_char); right;
+ activity[0]:=pass_through;
+ end;
+if tfm[lig_step(nl-1)]=255 then
+ begin r:=256*tfm[lig_step(nl-1)+2]+tfm[lig_step(nl-1)+3];
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for boundarychar is too large;');
+ print_ln('so I removed it.');
+@.Ligature/kern starting index...@>
+ end
+ else begin label_ptr:=1; label_table[1].cc:=256; label_table[1].rr:=r;
+ bchar_label:=r; activity[r]:=accessible;
+ end;
+ activity[nl-1]:=pass_through;
+ end
+
+@ @<Compute the |activity| array@>=
+for ai:=0 to nl-1 do if activity[ai]=accessible then
+ begin r:=tfm[lig_step(ai)];
+ if r<stop_flag then
+ begin r:=r+ai+1;
+ if r>=nl then
+ begin bad('Ligature/kern step ',ai:1,' skips too far;');
+@.Lig...skips too far@>
+ print_ln('I made it stop.'); tfm[lig_step(ai)]:=stop_flag;
+ end
+ else activity[r]:=accessible;
+ end;
+ end
+
+@ We ignore |pass_through| items, which don't need to be mentioned in
+the \.{PL} file.
+
+@<Output and correct the ligature...@>=
+sort_ptr:=1; {point to the next label that will be needed}
+for acti:=0 to nl-1 do if activity[acti]<>pass_through then
+ begin i:=acti; @<Take care of commenting out unreachable steps@>;
+ @<Output any labels for step $i$@>;
+ @<Output step $i$ of the ligature/kern program@>;
+ end;
+if level=2 then right {the final step was unreachable}
+
+@ @<Output any labels...@>=
+while i=label_table[sort_ptr].rr do
+ begin left; out('LABEL');
+ if label_table[sort_ptr].cc=256 then out(' BOUNDARYCHAR')
+ else out_char(label_table[sort_ptr].cc);
+ right; incr(sort_ptr);
+ end
+
+@ @<Take care of commenting out...@>=
+if activity[i]=unreachable then
+ begin if level=1 then
+ begin left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
+ end
+ end
+else if level=2 then right
+
+@ @<Output step $i$...@>=
+begin k:=lig_step(i);
+if tfm[k]>stop_flag then
+ begin if 256*tfm[k+2]+tfm[k+3]>=nl then
+ bad('Ligature unconditional stop command address is too big.');
+@.Ligature unconditional stop...@>
+ end
+else if tfm[k+2]>=kern_flag then @<Output a kern step@>
+else @<Output a ligature step@>;
+if tfm[k]>0 then
+ if level=1 then @<Output either \.{SKIP} or \.{STOP}@>;
+end
+
+@ The \.{SKIP} command is a bit tricky, because we will be omitting all
+inaccessible commands.
+
+@<Output either...@>=
+begin if tfm[k]>=stop_flag then out('(STOP)')
+else begin count:=0;
+ for ai:=i+1 to i+tfm[k] do if activity[ai]=accessible then incr(count);
+ out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares}
+ end;
+out_ln;
+end
+
+@ @<Output a kern step@>=
+begin if nonexistent(tfm[k+1]) then if tfm[k+1]<>boundary_char then
+ correct_bad_char('Kern step for')(k+1);
+@.Kern step for nonexistent...@>
+left; out('KRN'); out_char(tfm[k+1]);
+r:=256*(tfm[k+2]-kern_flag)+tfm[k+3];
+if r>=nk then
+ begin bad('Kern index too large.');
+@.Kern index too large@>
+ out(' R 0.0');
+ end
+else out_fix(kern(r));
+right;
+end
+
+@ @<Output a ligature step@>=
+begin if nonexistent(tfm[k+1]) then if tfm[k+1]<>boundary_char then
+ correct_bad_char('Ligature step for')(k+1);
+@.Ligature step for nonexistent...@>
+if nonexistent(tfm[k+3]) then
+ correct_bad_char('Ligature step produces the')(k+3);
+@.Ligature step produces...@>
+left; r:=tfm[k+2];
+if (r=4)or((r>7)and(r<>11)) then
+ begin print_ln('Ligature step with nonstandard code changed to LIG');
+ r:=0; tfm[k+2]:=0;
+ end;
+if r mod 4>1 then out('/');
+out('LIG');
+if odd(r) then out('/');
+while r>3 do
+ begin out('>'); r:=r-4;
+ end;
+out_char(tfm[k+1]); out_char(tfm[k+3]); right;
+end
+
+@ The last thing on \.{TFtoPL}'s agenda is to go through the
+list of |char_info| and spew out the information about each individual
+character.
+
+@<Do the characters@>=
+sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments}
+for c:=bc to ec do if width_index(c)>0 then
+ begin if chars_on_line=8 then
+ begin print_ln(' '); chars_on_line:=1;
+ end
+ else begin if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+ print_octal(c); {progress report}
+ left; out('CHARACTER'); out_char(c); out_ln;
+ @<Output the character's width@>;
+ if height_index(c)>0 then @<Output the character's height@>;
+ if depth_index(c)>0 then @<Output the character's depth@>;
+ if italic_index(c)>0 then @<Output the italic correction@>;
+ case tag(c) of
+ no_tag: do_nothing;
+ lig_tag: @<Output the applicable part of the ligature/kern
+ program as a comment@>;
+ list_tag: @<Output the character link unless there is a problem@>;
+ ext_tag: @<Output an extensible character recipe@>;
+ end; {there are no other cases}
+ right;
+ end
+
+@ @<Output the character's width@>=
+begin left; out('CHARWD');
+if width_index(c)>=nw then range_error('Width')
+else out_fix(width(c));
+right;
+end
+
+@ @<Output the character's height@>=
+if height_index(c)>=nh then range_error('Height')
+@.Height index for char...@>
+else begin left; out('CHARHT'); out_fix(height(c)); right;
+ end
+
+@ @<Output the character's depth@>=
+if depth_index(c)>=nd then range_error('Depth')
+@.Depth index for char@>
+else begin left; out('CHARDP'); out_fix(depth(c)); right;
+ end
+
+@ @<Output the italic correction@>=
+if italic_index(c)>=ni then range_error('Italic correction')
+@.Italic correction index for char...@>
+else begin left; out('CHARIC'); out_fix(italic(c)); right;
+ end
+
+@ @<Output the applicable part of the ligature...@>=
+begin left; out('COMMENT'); out_ln;@/
+i:=remainder(c); r:=lig_step(i);
+if tfm[r]>stop_flag then i:=256*tfm[r+2]+tfm[r+3];
+repeat @<Output step...@>;
+if tfm[k]>=stop_flag then i:=nl
+else i:=i+1+tfm[k];
+until i>=nl;
+right;
+end
+
+@ We want to make sure that there is no cycle of characters linked together
+by |list_tag| entries, since such a cycle would get \TeX\ into an endless
+loop. If such a cycle exists, the routine here detects it when processing
+the largest character code in the cycle.
+
+@<Output the character link unless there is a problem@>=
+begin r:=remainder(c);
+if nonexistent(r) then
+ begin bad_char('Character list link to')(r); reset_tag(c);
+@.Character list link...@>
+ end
+else begin while (r<c)and(tag(r)=list_tag) do r:=remainder(r);
+ if r=c then
+ begin bad('Cycle in a character list!');
+@.Cycle in a character list@>
+ print('Character '); print_octal(c);
+ print_ln(' now ends the list.');
+ reset_tag(c);
+ end
+ else begin left; out('NEXTLARGER'); out_char(remainder(c));
+ right;
+ end;
+ end;
+end
+
+@ @<Output an extensible character recipe@>=
+if remainder(c)>=ne then
+ begin range_error('Extensible'); reset_tag(c);
+@.Extensible index for char@>
+ end
+else begin left; out('VARCHAR'); out_ln;
+ @<Output the extensible pieces that exist@>;
+ right;
+ end
+
+@ @<Output the extensible pieces that...@>=
+for k:=0 to 3 do if (k=3)or(tfm[exten(c)+k]>0) then
+ begin left;
+ case k of
+ 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
+ if nonexistent(tfm[exten(c)+k]) then out_char(c)
+ else out_char(tfm[exten(c)+k]);
+ right;
+ end
+
+@ Some of the extensible recipes may not actually be used, but \TeX\ will
+complain about them anyway if they refer to nonexistent characters.
+Therefore \.{TFtoPL} must check them too.
+
+@<Check the extensible recipes@>=
+if ne>0 then for c:=0 to ne-1 do for d:=0 to 3 do
+ begin k:=4*(exten_base+c)+d;
+ if (tfm[k]>0)or(d=3) then
+ begin if nonexistent(tfm[k]) then
+ begin bad_char('Extensible recipe involves the')(tfm[k]);
+@.Extensible recipe involves...@>
+ if d<3 then tfm[k]:=0;
+ end;
+ end;
+ end
+
+@* Checking for ligature loops.
+We have programmed almost everything but the most interesting calculation of
+all, which has been saved for last as a special treat. \TeX's extended ligature
+mechanism allows unwary users to specify sequences of ligature replacements
+that never terminate. For example, the pair of commands
+$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$
+alternately replaces character $x$ by character $y$ and vice versa. A similar
+loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and
+ \.{(LIG/ $z$ $x$)} occurs in the program for $y$.
+
+More complicated loops are also possible. For example, suppose the ligature
+programs for $x$ and $y$ are
+$$\vcenter{\halign{#\hfil\cr
+\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr
+\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$
+then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$,
+\dots, ad infinitum.
+
+@ To detect such loops, \.{TFtoPL} attempts to evaluate the function
+$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as
+follows: If the current character is $x$ and the next character is
+$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor
+first moves past $y$, the character immediately to its left is
+$f(x,y)$. This function is defined if and only if no infinite loop is
+generated when the cursor is between $x$ and~$y$.
+
+The function $f(x,y)$ can be defined recursively. It turns out that all pairs
+$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$; this
+happens if there's no ligature between $x$ and $y$, or in the cases
+\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a
+\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$;
+then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to
+either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted
+ligature character.
+
+The first two of these classes can be merged; we can also consider
+$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated.
+For technical reasons we allow $x$ to be 256 (for the boundary character
+at the left) or 257 (in cases when an error has been detected).
+
+For each pair $(x,y)$ having a ligature program step, we store
+$(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+@<Glob...@>=
+@!hash:array[0..hash_size] of 0..66048; {$256x+y+1$ for $x\le257$ and $y\le255$}
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of 0..257;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!x_lig_cycle,@!y_lig_cycle:0..256; {problematic ligature pair}
+
+@ @<Check for ligature cycles@>=
+hash_ptr:=0; y_lig_cycle:=256;
+for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table}
+for c:=bc to ec do if tag(c)=lig_tag then
+ begin i:=remainder(c);
+ if tfm[lig_step(i)]>stop_flag then
+ i:=256*tfm[lig_step(i)+2]+tfm[lig_step(i)+3];
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if bchar_label<nl then
+ begin c:=256; i:=bchar_label;
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if hash_ptr=hash_size then
+ begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ goto final_end;
+ end;
+for hh:=1 to hash_ptr do
+ begin r:=hash_list[hh];
+ if class[r]>simple then {make sure $f$ is defined}
+ r:=f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);
+ end;
+if y_lig_cycle<256 then
+ begin print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=256 then print('boundary')@+else print_octal(x_lig_cycle);
+ print(' and '); print_octal(y_lig_cycle); print_ln('!');
+ out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
+ end
+
+@ @<Enter data for character $c$...@>=
+repeat hash_input; k:=tfm[lig_step(i)];
+if k>=stop_flag then i:=nl
+else i:=i+1+k;
+until i>=nl
+
+@ We use an ``ordered hash table'' with linear probing, because such a table
+is efficient when the lookup of a random key tends to be unsuccessful.
+
+@p procedure hash_input; {enter data for character |c| and command |i|}
+label 30; {go here for a quick exit}
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:0..255; {function value or ligature character being entered}
+@!y:0..255; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then goto 30;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=256*c+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then goto 30; {unused ligature command}
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+30:end;
+
+@ We must store kern commands as well as ligature commands, because the former
+might make the latter inapplicable.
+
+@<Compute the command param...@>=
+k:=lig_step(i); y:=tfm[k+1]; t:=tfm[k+2]; cc:=simple; zz:=tfm[k+3];
+if t>=kern_flag then zz:=y
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures.
+Kind of a neat algorithm, generalizing a depth-first search.
+
+@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=256*x+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:index):index| here.
+
+@p function f;
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=257; class[h]:=simple;
+ end; {the value 257 will break all cycles, since it's not in |hash|}
+end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+First comes the |organize| procedure, which reads the input data and
+gets ready for subsequent events. If something goes wrong, the routine
+returns |false|.
+
+@p function organize:boolean;
+label final_end, 30;
+var tfm_ptr:index; {an index into |tfm|}
+begin @<Read the whole input file@>;@/
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;@/
+@<Compute the base addresses@>;@/
+organize:=true; goto 30;
+final_end: organize:=false;
+30: end;
+
+@ Next we do the simple things.
+
+@p procedure do_simple_things;
+var i:0..@'77777; {an index to words of a subfile}
+begin @<Do the header@>;@/
+@<Do the parameters@>;@/
+@<Check the |fix_word| entries@>@/
+end;
+
+@ And then there's a routine for individual characters.
+
+@p procedure do_characters;
+var @!c:byte; {character being done}
+@!k:index; {a random index}
+@!ai:0..lig_size; {index into |activity|}
+begin @<Do the characters@>;@/
+end;
+
+@ Here is where \.{TFtoPL} begins and ends.
+@p begin initialize;@/
+if not organize then goto final_end;
+do_simple_things;@/
+@<Do the ligatures and kerns@>;
+@<Check the extensible recipes@>;
+do_characters; print_ln('.');@/
+if level<>0 then print_ln('This program isn''t working!');
+@.This program isn't working@>
+if not perfect then
+ out('(COMMENT THE TFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)');
+@.THE TFM FILE WAS BAD...@>
+final_end:end.
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TFtoPL} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/tiedir/MANIFEST b/Build/source/texk/web2c/tiedir/MANIFEST
new file mode 100644
index 00000000000..b2dc9ed29cc
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/MANIFEST
@@ -0,0 +1,21 @@
+README guess what, but read it before proceeding
+MANIFEST this list of files
+
+Makefile.cweb UN*X Makefile to create tie from the sources
+ (requires a working ctangle processor for source changes)
+tie.w the source of tie, written in CWEB
+tie.c a pretangled version of tie.w
+
+tie.tie a small test suite (master)
+tie.cf1 with several change files
+tie.cf2
+tie.cf3
+tie.chf.gen the supposed to be generated merged change file
+tie.master.gen the supposed to be generated new master file
+
+tiedoc.tex a short introduction on tie (LaTeX source)
+
+tie.1 a UN*X style man page for tie
+tie.1.dvi a `groff'ed version on man page tie.1
+tie.1.nroffed an `nroff'ed version of man page tie.1, backspaces
+ for underlining or overstriking removed
diff --git a/Build/source/texk/web2c/tiedir/Makefile.cweb b/Build/source/texk/web2c/tiedir/Makefile.cweb
new file mode 100644
index 00000000000..09320188459
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/Makefile.cweb
@@ -0,0 +1,38 @@
+#
+# Makefile for tie distribution - 21 Dec 92
+#
+# This file makes TIE and needs ctangle from cweb distribution.
+# Try `touch tie.c' first, if you don't have ctangle.
+#
+
+CTANGLE=ctangle
+BINDIR=.
+TIE=$(BINDIR)/tie
+
+CFLAGS=
+LDFLAGS=-s
+
+default: tie
+
+
+# TIE
+tie.o: tie.c
+
+tie: tie.o
+ $(CC) $(LDFLAGS) $(CFLAGS) -o $(TIE) tie.o
+
+tie.c: tie.w
+ $(CTANGLE) tie
+
+
+clean:
+ rm -f tie.o tie.outc tie.outm tie.tex tie.log tie.toc tiedoc.log
+
+veryclean: clean
+ rm -f $(BINDIR)/tie tie.dvi tiedoc.dvi tiedoc.aux
+
+ttest: $(TIE)
+ $(TIE) -c tie.outc tie.tie tie.cf?
+ diff tie.outc tie.chf.gen
+ $(TIE) -m tie.outm tie.tie tie.cf?
+ diff tie.outm tie.master.gen
diff --git a/Build/source/texk/web2c/tiedir/README b/Build/source/texk/web2c/tiedir/README
new file mode 100644
index 00000000000..1b3bb7be0de
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/README
@@ -0,0 +1,58 @@
+This is the README file of the `tie' distribution.
+ The current version is 2.4.
+ This file was created on 18 Dec 92.
+ This file was updated on 15 Jul 93.
+
+
+SUBJECT:
+
+`Tie' is a program which was first developed to allow WEB programmers
+(be it Pascal-, C- or any other WEB) to add more than one change file
+to their programs.
+
+ But it can be used to create new versions of the WEB file with
+incorporated changes as well. This feature does not depend on any
+special WEB dialect, nor on using WEB at all, as the only controls to
+be interpreted are the change requests in the change files (delimited
+by @x, @y and @z).
+ This makes `tie' also usable for any other language, or even data
+files. See the documentation tiedoc.tex and the example file tie.tie.
+
+ Actually, this gives a second file update mechanism besides `patch'.
+Whereas patch relies on line numbers and/or precise contexts produced
+by diff, tie depends on the order of changes and on a an amount of
+context lines determined manually.
+
+
+REQUIREMENTS:
+
+This version of `tie' is written in CWEB. To preprocess and compile
+the source you will need a working `ctangle'.
+ A pretangled tie.c is supplied which has been compiled successfully
+on a variety of workstations using either the manufacturer supplied
+C compiler in the K&R or ANSI version, or gcc (version 1.40).
+ Please note, that the CWEB by Silvio Levy and Donald E. Knuth must
+be at least at version 2.8, to process and compile `tie' without
+problems.
+
+
+DISTRIBUTION:
+
+The reference version of tie may be retrieved by anonymous ftp from
+
+ ftp.th-darmstadt.de [130.83.55.75]
+ directory pub/programming/literate-programming/Tools
+ file tie-<version>.tar.Z
+
+where <version> is the most current version number.
+ See the source file tie.w for details of the distribution policy.
+
+
+BUGS/ENHANCEMENTS:
+
+If you detect bugs in the implementation of `tie' or have
+suggestions to enhance functionality or improve portability,
+please send a message to
+
+ Klaus Guntermann <guntermann@iti.informatik.th-darmstadt.de>
+
diff --git a/Build/source/texk/web2c/tiedir/tie-w2c.ch b/Build/source/texk/web2c/tiedir/tie-w2c.ch
new file mode 100644
index 00000000000..6dfa043b38b
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie-w2c.ch
@@ -0,0 +1,109 @@
+% Changes to adapt tie to web2c.
+% Copyright 2001 by Olaf Weber
+% This file is in the Public Domain.
+
+@x Already in cpascal.h.
+@d incr(v) v+=1 /* increase a variable by unity */
+@d decr(v) v-=1 /* decrease a variable by unity */
+@y
+@z
+
+@x
+@ Furthermore we include the additional types |boolean| and |string|.
+@d false 0
+@d true 1
+@<Global types@>=
+typedef int boolean;
+typedef char* string;
+@y
+@ Furthermore we include the additional types |boolean| and |string|.
+/* boolean, false, true; string; all from cpascal.h */
+@z
+
+@x -- we need more input files.
+#define max_file_index 9
+/* we don't think that anyone needs more than 9 change files,
+@y
+#define max_file_index 32
+/* we don't think that anyone needs more than 32 change files,
+@z
+
+@x -- add to global includes.
+#include <stdio.h>
+@y
+#include "cpascal.h"
+#include <stdio.h>
+/* Also redefine usage to avoid clash with function from lib. */
+#define usage tieusage
+@z
+
+@x
+void get_line(i)
+ file_index i;
+@y
+void get_line P1C(file_index, i)
+@z
+
+@x
+void err_loc(i) /* prints location of error */
+ int i;
+@y
+void err_loc P1C(int, i) /* prints location of error */
+@z
+
+@x
+boolean lines_dont_match(i,j)
+ file_index i,j;
+@y
+boolean lines_dont_match P2C(file_index, i, file_index, j)
+@z
+
+@x
+void init_change_file(i,b)
+ file_index i; boolean b;
+@y
+void init_change_file P2C(file_index, i, boolean, b)
+@z
+
+@x
+void put_line(j)
+ file_index j;
+@y
+void put_line P1C(file_index, j)
+@z
+
+@x
+boolean e_of_ch_module(i)
+ file_index i;
+@y
+boolean e_of_ch_module P1C(file_index, i)
+@z
+
+@x
+boolean e_of_ch_preamble(i)
+ file_index i;
+@y
+boolean e_of_ch_preamble P1C(file_index, i)
+@z
+
+@x
+void usage()
+@y
+void usage P1H(void)
+@z
+
+@x
+main(argc,argv)
+ int argc; string *argv;
+@y
+int main P2C(int, argc, string *, argv)
+@z
+
+@x
+ print_ln(banner); /* print a ``banner line'' */
+ print_ln(copyright); /* include the copyright notice */
+@y
+ print(banner); /* print a ``banner line'' */
+ print_ln(versionstring); /* Web2C version */
+ print_ln(copyright); /* include the copyright notice */
+@z
diff --git a/Build/source/texk/web2c/tiedir/tie.1 b/Build/source/texk/web2c/tiedir/tie.1
new file mode 100644
index 00000000000..13d132d8ed6
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.1
@@ -0,0 +1,39 @@
+.TH TIE 1L 9/24/92
+.SH NAME
+tie \- merge or apply WEB change files
+.SH SYNOPSIS
+.B tie
+.B \-c|\-m
+.I outputfile masterfile changefile...
+
+.SH DESCRIPTION
+The
+.I tie
+program is used to process multiple change files used with the WEB
+system for literate programming. The WEB programs allow to apply
+patches to a source file (the
+.IR masterfile )
+by means of a number of change files (often only a single change file
+is allowed).
+.I Tie
+can be used to either merge up to nine change files into a single one
+or to apply the changes to the
+.I masterfile
+in order to create a new one. Output of either the new change file or
+the patched master file goes into
+.I outputfile.
+.SS OPTIONS
+.TP
+.B \-c
+Create a single change file from the given
+.I changefiles.
+.TP
+.B \-m
+Create a new master file by applying the given
+.I changefiles.
+.SH "SEE ALSO"
+.br
+web(1), cweb(1l).
+.SH "AUTHOR"
+Klaus Guntermann, TH Darmstadt, Institut f. Theoretische Informatik. Man page
+by Joachim Schnitter, TH Darmstadt, Phys. Chemie I.
diff --git a/Build/source/texk/web2c/tiedir/tie.1.dvi b/Build/source/texk/web2c/tiedir/tie.1.dvi
new file mode 100644
index 00000000000..75beacafbc8
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.1.dvi
Binary files differ
diff --git a/Build/source/texk/web2c/tiedir/tie.1.nroffed b/Build/source/texk/web2c/tiedir/tie.1.nroffed
new file mode 100644
index 00000000000..3701bd617ba
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.1.nroffed
@@ -0,0 +1,66 @@
+
+
+
+ TIE(1L) (9/24/92) TIE(1L)
+
+
+
+ NAME
+ tie - merge or apply WEB change files
+
+ SYNOPSIS
+ tie -c|-m outputfile masterfile changefile1 [ ...
+ changefile9 ]
+
+
+ DESCRIPTION
+ The tie program is used to process multiple change files
+ used with the WEB system for literate programming. The
+ WEB programs allow to apply patches to a source file (the
+ masterfile) by means of a number of change files (often
+ only a single change file is allowed). Tie can be used to
+ either merge up to nine change files into a single one or to
+ apply the changes to the masterfile in order to create a new
+ one. Output of either the new change file or the patched
+ master file goes into outputfile.
+
+ OPTIONS
+ -c Create a single change file from the given masterfile.
+
+ -m Create a new master file by applying the given
+ changefiles.
+
+ SEE ALSO
+ web(1), cweb(1l).
+
+ AUTHOR
+ Klaus Guntermann, TH Darmstadt, Institut f. Theoretische
+ Informatik. Man page by Joachim Schnitter, TH Darmstadt,
+ Phys. Chemie I.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Page 1 (printed 12/17/92)
+
+
+
diff --git a/Build/source/texk/web2c/tiedir/tie.c b/Build/source/texk/web2c/tiedir/tie.c
new file mode 100644
index 00000000000..ccf39c03c63
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.c
@@ -0,0 +1,920 @@
+#define banner "This is TIE, CWEB Version 2.4."
+#define copyright \
+"Copyright (c) 1989,1992 by THD/ITI. All rights reserved." \
+ \
+
+#define incr(v)v+= 1
+#define decr(v)v-= 1
+#define loop while(1)
+#define do_nothing
+#define false 0
+#define true 1
+#define spotless 0
+#define troublesome 1
+#define fatal 2 \
+
+#define first_text_char 0
+#define last_text_char 255 \
+
+#define map_xchr(c)(text_char)(c) \
+
+#define map_xord(c)(ASCII_Code)(c) \
+ \
+
+#define tab_mark 9
+#define nl_mark 10
+#define form_feed 12 \
+ \
+
+#define term_out stdout
+#define print(a)fprintf(term_out,a)
+#define print2(a,b)fprintf(term_out,a,b)
+#define print3(a,b,c)fprintf(term_out,a,b,c)
+#define print_c(v)fputc(v,term_out);
+#define new_line(v)fputc('\n',v)
+#define term_new_line new_line(term_out) \
+
+#define print_ln(v){fprintf(term_out,v);term_new_line;} \
+
+#define print2_ln(a,b){print2(a,b);term_new_line;}
+#define print3_ln(a,b,c){print3(a,b,c);term_new_line;} \
+
+#define print_nl(v){term_new_line;print(v);} \
+
+#define print2_nl(a,b){term_new_line;print2(a,b);} \
+ \
+
+#define update_terminal fflush(term_out) \
+ \
+ \
+ \
+ \
+
+#define error_loc(m)err_loc(m);history= troublesome;}
+#define err_print(m){print_nl(m);error_loc \
+
+#define fatal_error(m){ \
+print(m);print_c('.');history= fatal; \
+term_new_line;jump_out(); \
+} \
+ \
+
+#define jump_out()exit(1) \
+ \
+ \
+ \
+ \
+
+#define none (max_file_index+1) \
+
+/*2:*/
+#line 112 "tie.w"
+
+/*15:*/
+#line 478 "tie.w"
+
+#include <stdio.h>
+
+
+/*:15*//*16:*/
+#line 486 "tie.w"
+
+#ifdef __STDC__
+#include <stdlib.h>
+#else
+#include <malloc.h>
+#endif
+
+/*:16*/
+#line 113 "tie.w"
+
+/*5:*/
+#line 142 "tie.w"
+
+#define buf_size 512
+#define max_file_index 9
+
+
+
+
+/*:5*/
+#line 114 "tie.w"
+
+/*4:*/
+#line 133 "tie.w"
+
+typedef int boolean;
+typedef char*string;
+
+
+/*:4*//*7:*/
+#line 224 "tie.w"
+
+#define max_ASCII (126+1)
+typedef unsigned char ASCII_Code;
+
+
+
+/*:7*//*8:*/
+#line 250 "tie.w"
+
+typedef unsigned char text_char;
+typedef FILE*text_file;
+
+
+/*:8*//*18:*/
+#line 529 "tie.w"
+
+#define search 0
+#define test 1
+#define reading 2
+#define ignore 3
+typedef int in_file_modes;
+#define unknown 0
+#define master 1
+#define chf 2
+typedef int file_types;
+
+
+/*:18*//*19:*/
+#line 547 "tie.w"
+
+#define normal 0
+#define pre 1
+#define post 2
+typedef int out_md_type;
+
+
+/*:19*//*20:*/
+#line 557 "tie.w"
+
+typedef int buffer_index;
+typedef int file_index;
+
+
+/*:20*//*21:*/
+#line 566 "tie.w"
+
+typedef struct _idsc{
+string name_of_file;
+ASCII_Code buffer[buf_size];
+in_file_modes mode;
+long line;
+file_types type_of_file;
+buffer_index limit;
+text_file the_file;
+}input_description;
+
+
+/*:21*/
+#line 115 "tie.w"
+
+/*6:*/
+#line 159 "tie.w"
+
+static int history= spotless;
+
+
+
+/*:6*//*9:*/
+#line 270 "tie.w"
+
+static ASCII_Code xord[last_text_char+1];
+
+static text_char xchr[max_ASCII+1];
+
+
+
+/*:9*//*22:*/
+#line 582 "tie.w"
+
+static file_index actual_input,test_input,no_ch;
+static file_types prod_chf= unknown;
+static out_md_type out_mode;
+
+
+/*:22*//*23:*/
+#line 594 "tie.w"
+
+static input_description*input_organization[max_file_index+1];
+
+
+
+
+
+/*:23*//*26:*/
+#line 641 "tie.w"
+
+static boolean input_has_ended= false;
+
+
+/*:26*//*35:*/
+#line 801 "tie.w"
+
+static text_file out_file;
+static string out_name;
+
+
+/*:35*/
+#line 116 "tie.w"
+
+/*31:*/
+#line 744 "tie.w"
+
+void err_loc(i)
+int i;
+{
+print3_ln(" (file %s, l.%ld).",
+input_organization[i]->name_of_file,
+input_organization[i]->line);
+}
+
+
+/*:31*/
+#line 117 "tie.w"
+
+/*24:*/
+#line 616 "tie.w"
+
+void get_line(i)
+file_index i;
+{register input_description*inp_desc= input_organization[i];
+if(inp_desc->mode==ignore)return;
+if(feof(inp_desc->the_file))
+/*25:*/
+#line 630 "tie.w"
+
+{
+inp_desc->mode= ignore;
+inp_desc->limit= -1;
+if(inp_desc->type_of_file==master)input_has_ended= true;
+return;
+}
+
+
+/*:25*/
+#line 622 "tie.w"
+
+/*27:*/
+#line 655 "tie.w"
+
+{int final_limit;
+int c;
+/*28:*/
+#line 679 "tie.w"
+
+incr(inp_desc->line);
+if(inp_desc->type_of_file==master&&inp_desc->line%100==0){
+if(inp_desc->line%500==0)print2("%ld",inp_desc->line);
+else print_c('.');
+update_terminal;
+}
+
+
+/*:28*/
+#line 659 "tie.w"
+
+inp_desc->limit= final_limit= 0;
+while(inp_desc->limit<buf_size){
+c= fgetc(inp_desc->the_file);
+/*29:*/
+#line 696 "tie.w"
+
+if(c==EOF){
+if(inp_desc->limit<=0){
+inp_desc->mode= ignore;
+inp_desc->limit= -1;
+if(inp_desc->type_of_file==master)input_has_ended= true;
+return;
+}else{
+c= nl_mark;
+break;
+}
+}
+
+
+/*:29*/
+#line 664 "tie.w"
+
+inp_desc->buffer[inp_desc->limit++]= c= map_xord(c);
+if(c==nl_mark)break;
+if(c!=32&&c!=tab_mark)
+final_limit= inp_desc->limit;
+}
+/*30:*/
+#line 712 "tie.w"
+
+if(c!=nl_mark){
+err_print("! Input line too long")(i);
+
+while((c= fgetc(inp_desc->the_file))!=EOF&&map_xord(c)!=nl_mark)
+do_nothing;
+}
+
+
+
+
+
+/*:30*/
+#line 670 "tie.w"
+
+inp_desc->limit= final_limit;
+}
+
+
+/*:27*/
+#line 623 "tie.w"
+
+}
+
+
+/*:24*//*38:*/
+#line 850 "tie.w"
+
+boolean lines_dont_match(i,j)
+file_index i,j;
+{
+buffer_index k,lmt;
+if(input_organization[i]->limit!=input_organization[j]->limit)
+return(true);
+lmt= input_organization[i]->limit;
+for(k= 0;k<lmt;k++)
+if(input_organization[i]->buffer[k]!=input_organization[j]->buffer[k])
+return(true);
+return(false);
+}
+
+
+/*:38*//*39:*/
+#line 871 "tie.w"
+
+void init_change_file(i,b)
+file_index i;boolean b;
+{register input_description*inp_desc= input_organization[i];
+/*40:*/
+#line 885 "tie.w"
+
+loop{ASCII_Code c;
+get_line(i);
+if(inp_desc->mode==ignore)return;
+if(inp_desc->limit<2)continue;
+if(inp_desc->buffer[0]!=64)continue;
+c= inp_desc->buffer[1];
+if(c>=88&&c<=90)
+c+= 122-90;
+if(c==120)break;
+if(c==121||c==122)
+if(b)
+err_print("! Where is the matching @x?")(i);
+
+}
+
+
+/*:40*/
+#line 875 "tie.w"
+
+/*41:*/
+#line 904 "tie.w"
+
+do{
+get_line(i);
+if(inp_desc->mode==ignore){
+err_print("! Change file ended after @x")(i);
+
+return;
+}
+}while(inp_desc->limit<=0);
+
+
+/*:41*/
+#line 876 "tie.w"
+
+}
+
+
+/*:39*//*42:*/
+#line 918 "tie.w"
+
+void put_line(j)
+file_index j;
+{buffer_index i;
+buffer_index lmt;
+ASCII_Code*p;
+lmt= input_organization[j]->limit;
+p= input_organization[j]->buffer;
+for(i= 0;i<lmt;i++)fputc(map_xchr(*p++),out_file);
+new_line(out_file);
+}
+
+
+/*:42*//*43:*/
+#line 934 "tie.w"
+
+boolean e_of_ch_module(i)
+file_index i;
+{register input_description*inp_desc= input_organization[i];
+if(inp_desc->limit<0){
+print_nl("! At the end of change file missing @z ");
+
+print2("%s",input_organization[i]->name_of_file);
+term_new_line;
+return(true);
+}else if(inp_desc->limit>=2)if(inp_desc->buffer[0]==64&&
+(inp_desc->buffer[1]==90||inp_desc->buffer[1]==122))
+return(true);
+return(false);
+}
+
+
+/*:43*//*44:*/
+#line 954 "tie.w"
+
+boolean e_of_ch_preamble(i)
+file_index i;
+{register input_description*inp_desc= input_organization[i];
+if(inp_desc->limit>=2&&inp_desc->buffer[0]==64)
+if(inp_desc->buffer[1]==89||inp_desc->buffer[1]==121)return(true);
+return(false);
+}
+
+
+
+/*:44*//*55:*/
+#line 1157 "tie.w"
+
+void usage()
+{
+print("Usage: tie -[mc] outfile master changefile(s)");
+term_new_line;
+jump_out();
+}
+
+
+/*:55*/
+#line 118 "tie.w"
+
+/*59:*/
+#line 1235 "tie.w"
+
+main(argc,argv)
+int argc;string*argv;
+{{/*12:*/
+#line 408 "tie.w"
+
+int i;
+
+
+/*:12*/
+#line 1238 "tie.w"
+
+/*10:*/
+#line 296 "tie.w"
+
+xchr[32]= ' ';
+xchr[33]= '!';
+xchr[34]= '\"';
+xchr[35]= '#';
+xchr[36]= '$';
+xchr[37]= '%';
+xchr[38]= '&';
+xchr[39]= '\'';
+xchr[40]= '(';
+xchr[41]= ')';
+xchr[42]= '*';
+xchr[43]= '+';
+xchr[44]= ',';
+xchr[45]= '-';
+xchr[46]= '.';
+xchr[47]= '/';
+xchr[48]= '0';
+xchr[49]= '1';
+xchr[50]= '2';
+xchr[51]= '3';
+xchr[52]= '4';
+xchr[53]= '5';
+xchr[54]= '6';
+xchr[55]= '7';
+xchr[56]= '8';
+xchr[57]= '9';
+xchr[58]= ':';
+xchr[59]= ';';
+xchr[60]= '<';
+xchr[61]= '=';
+xchr[62]= '>';
+xchr[63]= '?';
+xchr[64]= '@';
+xchr[65]= 'A';
+xchr[66]= 'B';
+xchr[67]= 'C';
+xchr[68]= 'D';
+xchr[69]= 'E';
+xchr[70]= 'F';
+xchr[71]= 'G';
+xchr[72]= 'H';
+xchr[73]= 'I';
+xchr[74]= 'J';
+xchr[75]= 'K';
+xchr[76]= 'L';
+xchr[77]= 'M';
+xchr[78]= 'N';
+xchr[79]= 'O';
+xchr[80]= 'P';
+xchr[81]= 'Q';
+xchr[82]= 'R';
+xchr[83]= 'S';
+xchr[84]= 'T';
+xchr[85]= 'U';
+xchr[86]= 'V';
+xchr[87]= 'W';
+xchr[88]= 'X';
+xchr[89]= 'Y';
+xchr[90]= 'Z';
+xchr[91]= '[';
+xchr[92]= '\\';
+xchr[93]= ']';
+xchr[94]= '^';
+xchr[95]= '_';
+xchr[96]= '`';
+xchr[97]= 'a';
+xchr[98]= 'b';
+xchr[99]= 'c';
+xchr[100]= 'd';
+xchr[101]= 'e';
+xchr[102]= 'f';
+xchr[103]= 'g';
+xchr[104]= 'h';
+xchr[105]= 'i';
+xchr[106]= 'j';
+xchr[107]= 'k';
+xchr[108]= 'l';
+xchr[109]= 'm';
+xchr[110]= 'n';
+xchr[111]= 'o';
+xchr[112]= 'p';
+xchr[113]= 'q';
+xchr[114]= 'r';
+xchr[115]= 's';
+xchr[116]= 't';
+xchr[117]= 'u';
+xchr[118]= 'v';
+xchr[119]= 'w';
+xchr[120]= 'x';
+xchr[121]= 'y';
+xchr[122]= 'z';
+xchr[123]= '{';
+xchr[124]= '|';
+xchr[125]= '}';
+xchr[126]= '~';
+xchr[0]= ' ';xchr[0x7F]= ' ';
+
+
+/*:10*//*13:*/
+#line 429 "tie.w"
+
+for(i= 1;i<32;xchr[i++]= ' ');
+xchr[tab_mark]= '\t';
+xchr[form_feed]= '\f';
+xchr[nl_mark]= '\n';
+
+
+/*:13*//*14:*/
+#line 440 "tie.w"
+
+for(i= first_text_char;i<=last_text_char;xord[i++]= 32)do_nothing;
+for(i= 1;i<=126;i++)xord[xchr[i]]= i;
+
+
+
+
+
+/*:14*/
+#line 1239 "tie.w"
+
+}
+print_ln(banner);
+print_ln(copyright);
+actual_input= 0;
+out_mode= normal;
+/*56:*/
+#line 1177 "tie.w"
+
+{int act_arg;
+if(argc<5||argc>max_file_index+4-1)usage();
+no_ch= -1;
+for(act_arg= 1;act_arg<argc;act_arg++){
+if(argv[act_arg][0]=='-')/*57:*/
+#line 1195 "tie.w"
+
+if(prod_chf!=unknown)usage();
+else
+switch(argv[act_arg][1]){
+case'c':
+case'C':prod_chf= chf;break;
+case'm':
+case'M':prod_chf= master;break;
+default:usage();
+}
+
+
+/*:57*/
+#line 1182 "tie.w"
+
+else/*58:*/
+#line 1211 "tie.w"
+
+{if(no_ch==(-1)){
+out_name= argv[act_arg];
+}else{register input_description*inp_desc;
+inp_desc= (input_description*)
+malloc(sizeof(input_description));
+if(inp_desc==NULL)
+fatal_error("! No memory for descriptor");
+
+inp_desc->mode= search;
+inp_desc->line= 0;
+inp_desc->type_of_file= chf;
+inp_desc->limit= 0;
+inp_desc->name_of_file= argv[act_arg];
+input_organization[no_ch]= inp_desc;
+}
+incr(no_ch);
+}
+
+
+/*:58*/
+#line 1183 "tie.w"
+
+}
+if(no_ch<=0||prod_chf==unknown)usage();
+}
+
+
+/*:56*/
+#line 1245 "tie.w"
+
+/*34:*/
+#line 788 "tie.w"
+
+{
+out_file= fopen(out_name,"w");
+if(out_file==NULL){
+fatal_error("! Could not open/create output file");
+
+}
+}
+
+
+/*:34*/
+#line 1246 "tie.w"
+
+/*36:*/
+#line 809 "tie.w"
+
+{input_organization[0]->the_file=
+fopen(input_organization[0]->name_of_file,"r");
+if(input_organization[0]->the_file==NULL)
+fatal_error("! Could not open master file");
+
+print2("(%s)",input_organization[0]->name_of_file);
+term_new_line;
+input_organization[0]->type_of_file= master;
+get_line(0);
+}
+
+/*:36*/
+#line 1247 "tie.w"
+
+/*37:*/
+#line 825 "tie.w"
+
+{file_index i;
+i= 1;
+while(i<no_ch){
+input_organization[i]->the_file=
+fopen(input_organization[i]->name_of_file,"r");
+if(input_organization[i]->the_file==NULL)
+fatal_error("!Could not open change file");
+
+print2("(%s)",input_organization[i]->name_of_file);
+term_new_line;
+init_change_file(i,true);
+incr(i);
+}
+}
+
+
+
+
+
+/*:37*/
+#line 1248 "tie.w"
+
+/*53:*/
+#line 1128 "tie.w"
+
+actual_input= 0;
+input_has_ended= false;
+while(input_has_ended==false||actual_input!=0)
+/*45:*/
+#line 970 "tie.w"
+
+{file_index test_file;
+/*46:*/
+#line 985 "tie.w"
+
+{register input_description*inp_desc;
+while(actual_input>0&&e_of_ch_module(actual_input)){
+inp_desc= input_organization[actual_input];
+if(inp_desc->type_of_file==master){
+
+fatal_error("! This can't happen: change file is master file");
+
+}
+inp_desc->mode= search;
+init_change_file(actual_input,true);
+while((input_organization[actual_input]->mode!=reading
+&&actual_input>0))decr(actual_input);
+}
+}
+
+
+/*:46*/
+#line 972 "tie.w"
+
+if(input_has_ended&&actual_input==0)break;
+/*47:*/
+#line 1009 "tie.w"
+
+test_input= none;
+test_file= actual_input;
+while(test_input==none&&test_file<no_ch-1){
+incr(test_file);
+switch(input_organization[test_file]->mode){
+case search:if(lines_dont_match(actual_input,test_file)==false){
+input_organization[test_file]->mode= test;
+test_input= test_file;
+}
+break;
+case test:if(lines_dont_match(actual_input,test_file)==true){
+
+input_organization[test_file]->mode= search;
+err_print("! Sections do not match")(actual_input);
+
+err_loc(test_file);
+init_change_file(test_file,false);
+}else test_input= test_file;
+break;
+case reading:do_nothing;
+break;
+case ignore:do_nothing;
+break;
+}
+}
+
+
+/*:47*/
+#line 974 "tie.w"
+
+/*48:*/
+#line 1043 "tie.w"
+
+if(prod_chf==chf){
+loop{
+/*49:*/
+#line 1057 "tie.w"
+
+if(out_mode==normal){
+if(test_input!=none){
+fputc(map_xchr(64),out_file);fputc(map_xchr(120),out_file);
+new_line(out_file);
+out_mode= pre;
+}else break;
+}
+
+
+/*:49*/
+#line 1046 "tie.w"
+
+/*50:*/
+#line 1071 "tie.w"
+
+
+if(out_mode==pre){
+if(test_input==none){
+fputc(map_xchr(64),out_file);fputc(map_xchr(121),out_file);
+new_line(out_file);
+out_mode= post;
+}else{
+if(input_organization[actual_input]->type_of_file==master)
+put_line(actual_input);
+break;
+}
+}
+
+
+/*:50*/
+#line 1047 "tie.w"
+
+/*51:*/
+#line 1092 "tie.w"
+
+if(out_mode==post){
+if(input_organization[actual_input]->type_of_file==chf){
+if(test_input==none)put_line(actual_input);
+break;
+}else{
+fputc(map_xchr(64),out_file);fputc(map_xchr(122),out_file);
+new_line(out_file);
+new_line(out_file);
+out_mode= normal;
+}
+}
+
+
+/*:51*/
+#line 1048 "tie.w"
+
+}
+}else
+if(test_input==none)put_line(actual_input);
+
+
+/*:48*/
+#line 975 "tie.w"
+
+/*52:*/
+#line 1109 "tie.w"
+
+get_line(actual_input);
+if(test_input!=none){
+get_line(test_input);
+if(e_of_ch_preamble(test_input)==true){
+get_line(test_input);
+input_organization[test_input]->mode= reading;
+actual_input= test_input;
+test_input= none;
+}
+}
+
+
+/*:52*/
+#line 976 "tie.w"
+
+}
+
+
+/*:45*/
+#line 1132 "tie.w"
+
+if(out_mode==post){
+fputc(map_xchr(64),out_file);fputc(map_xchr(122),out_file);
+new_line(out_file);
+}
+
+
+/*:53*/
+#line 1249 "tie.w"
+
+/*54:*/
+#line 1143 "tie.w"
+
+{file_index i;
+for(i= 1;i<no_ch;i++){
+if(input_organization[i]->mode!=ignore)
+err_print("! Change file entry did not match")(i);
+
+}
+}
+
+
+/*:54*/
+#line 1250 "tie.w"
+
+/*60:*/
+#line 1261 "tie.w"
+
+{string msg;
+switch(history){
+case spotless:msg= "No errors were found";break;
+case troublesome:msg= "Pardon me, but I think I spotted something wrong.";
+break;
+case fatal:msg= "That was a fatal error, my friend";break;
+}
+print2_nl("(%s.)",msg);term_new_line;
+exit(history==spotless?0:1);
+}
+
+
+
+
+
+/*:60*/
+#line 1251 "tie.w"
+
+}
+
+/*:59*/
+#line 119 "tie.w"
+
+
+/*:2*/
diff --git a/Build/source/texk/web2c/tiedir/tie.cf1 b/Build/source/texk/web2c/tiedir/tie.cf1
new file mode 100644
index 00000000000..5b1165435c9
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.cf1
@@ -0,0 +1,14 @@
+@x
+line 2
+line 3
+@y
+changed line 2
+changed line 3
+inserted line
+@z
+
+@x
+line 7
+@y
+changed line 7
+@z
diff --git a/Build/source/texk/web2c/tiedir/tie.cf2 b/Build/source/texk/web2c/tiedir/tie.cf2
new file mode 100644
index 00000000000..386bc375876
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.cf2
@@ -0,0 +1,19 @@
+@x
+line 1
+changed line 2
+changed line 3
+inserted line
+line 4
+@y
+final line 2
+final line 3
+changed line 4
+@z
+
+@x
+changed line 7
+line 8
+@y
+final line 7
+final line 8
+@z
diff --git a/Build/source/texk/web2c/tiedir/tie.cf3 b/Build/source/texk/web2c/tiedir/tie.cf3
new file mode 100644
index 00000000000..6c0e2458daf
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.cf3
@@ -0,0 +1,5 @@
+@x
+changed line 4
+@y
+final line 4
+@z
diff --git a/Build/source/texk/web2c/tiedir/tie.chf.gen b/Build/source/texk/web2c/tiedir/tie.chf.gen
new file mode 100644
index 00000000000..f0b0130957a
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.chf.gen
@@ -0,0 +1,19 @@
+@x
+line 1
+line 2
+line 3
+line 4
+@y
+final line 2
+final line 3
+final line 4
+@z
+
+@x
+line 7
+line 8
+@y
+final line 7
+final line 8
+@z
+
diff --git a/Build/source/texk/web2c/tiedir/tie.master.gen b/Build/source/texk/web2c/tiedir/tie.master.gen
new file mode 100644
index 00000000000..e25e93b82d9
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.master.gen
@@ -0,0 +1,14 @@
+final line 2
+final line 3
+final line 4
+line 5
+line 6
+final line 7
+final line 8
+line 9
+line 10
+The character set:
+abcdefghijklmnopqrstuvwxyz
+ABCDEFGHIJKLMNOPQRSTUVWXYZ
+=!"#$%&/()?'`^~|-+[]{}@\;:
+ 0123456789<>.,*_
diff --git a/Build/source/texk/web2c/tiedir/tie.rc b/Build/source/texk/web2c/tiedir/tie.rc
new file mode 100644
index 00000000000..6c5830d4cd4
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.rc
@@ -0,0 +1,34 @@
+/* tie.rc: tie resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " tie 2.4"
+
+#define VER_INTERNALNAME_STR "tie"
+#define VER_ORIGINALFILENAME_STR "tie.exe"
+
+#define VER_FILEDESCRIPTION_STR "Merges change files to master web file"
+
+#define VER_LEGALCOPYRIGHT_STR " Copyright (c) 1989,1992 by THD/ITI."
+
+#include <texlive.version>
+
+/* tie.rc ends here */
diff --git a/Build/source/texk/web2c/tiedir/tie.tie b/Build/source/texk/web2c/tiedir/tie.tie
new file mode 100644
index 00000000000..59c1d4c0a23
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.tie
@@ -0,0 +1,15 @@
+line 1
+line 2
+line 3
+line 4
+line 5
+line 6
+line 7
+line 8
+line 9
+line 10
+The character set:
+abcdefghijklmnopqrstuvwxyz
+ABCDEFGHIJKLMNOPQRSTUVWXYZ
+=!"#$%&/()?'`^~|-+[]{}@\;:
+ 0123456789<>.,*_
diff --git a/Build/source/texk/web2c/tiedir/tie.w b/Build/source/texk/web2c/tiedir/tie.w
new file mode 100644
index 00000000000..5aa6abf87d1
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tie.w
@@ -0,0 +1,1297 @@
+% This is TIE.W as of 17 Dec 92
+%---------------------------------------------------------
+% Copyright (c) 1989,1992 by THD/ITI.
+% All rights reserved.
+%
+% This program is distributed WITHOUT ANY WARRANTY, express or implied.
+%
+% Permission is granted to make and distribute verbatim copies of this
+% program provided that the copyright notice and this permission notice
+% are preserved on all copies.
+%
+% Permission is granted to copy and distribute modified versions of this
+% program under the conditions for verbatim copying, provided that the
+% entire resulting derived work is distributed under the terms of a
+% permission notice identical to this one.
+%
+%
+% Version 1.7 was built alike TIE.WEB Version 1.6 (89-01-27)
+% but used a command line interface only
+% Version 2.0 was revised to include optional tab expansion (89-02-01)
+% Version 2.1 deleted WEB relicts. (-js) (89-10-25)
+% Version 2.2 repaired replacing strategy (89-11-27)
+% Version 2.3 was slightly modified to be processed with the
+% cweb by Levy&Knuth.
+% also repaired loop control for end of changes test (92-09-24)
+% Version 2.4 included <stdlib.h> instead of <malloc.h> when
+% used with ANSI-C (92-12-17)
+%
+
+% Here is TeX material that gets inserted after \input cwebmac
+
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\mc=cmr9
+\def\PASCAL{Pascal}
+\def\Cl{{\rm C}}
+\def\ASCII{{\mc ASCII}}
+
+\def\title{TIE}
+\def\topofcontents{\null\vfill
+ \centerline{\titlefont The {\ttitlefont TIE} processor}
+ \vskip 15pt
+ \centerline{(CWEB Version 2.4)}
+ \vfill}
+\def\botofcontents{
+\null\vfill
+\item{$\copyright$}1989, 1992
+ by Technische Hochschule Darmstadt,\hfill\break
+Fachbereich Informatik, Institut f\"ur Theoretische Informatik\hfill\break
+All rights reserved.\hfill\break
+This program is distributed WITHOUT ANY WARRANTY, express or implied.
+\hfill\break
+Permission is granted to make and distribute verbatim copies of this
+program provided that the copyright notice and this permission notice
+are preserved on all copies.
+\hfill\break
+Permission is granted to copy and distribute modified versions of this
+program under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+}
+
+
+
+
+
+@* Introduction.
+
+\noindent Whenever a programmer wants to change a given
+\.{WEB} or \.{CWEB} program (referred to as a \.{WEB} program throughout
+this program) because of system dependencies, she or he will
+create a new change file. In addition there may be a second
+change file to modify system independent modules of the
+program. But the \.{WEB} file cannot be tangled and weaved
+with more than one change file simultaneously. Therefore,
+we introduce the present program to merge a \.{WEB} file and
+several change files producing a new \.{WEB} file. Since
+the input files are tied together, the program is called
+\.{TIE}. Furthermore, the program can be used to merge
+several change files giving a new single change file. This
+method seems to be more important because it doesn't modify
+the original source file. The use of \.{TIE} can be
+expanded to other programming languages since this processor
+only knows about the structure of change files and does not
+interpret the master file at all.
+
+The program \.{TIE} has to read lines from several input
+files to bring them in some special ordering. For this
+purpose an algorithm is used which looks a little bit
+complicated. But the method used only needs one buffer line
+for each input file. Thus the storage requirement of
+\.{TIE} does not depend on the input data.
+
+The program is written in \Cl\ and uses only few features of a
+particular environment that may need to be changed in other
+installations.
+E.g.\ it will not use the |enum| type declarations.
+The changes needed may refer to the access of the command line
+if this can be not supported by any \Cl\ compiler.
+
+The ``banner line'' defined here should be changed whenever
+\.{TIE} is modified. This program is put into the public
+domain. Nevertheless the copyright notice must not be
+replaced or modified.
+
+@d banner "This is TIE, CWEB Version 2.4."
+@d copyright
+ "Copyright (c) 1989,1992 by THD/ITI. All rights reserved."
+
+
+@ The main outline of the program is given in the next section.
+This can be used more or less for any \Cl\ program.
+@c
+@<Global |#include|s@>@;
+@<Global constants@>@;
+@<Global types@>@;
+@<Global variables@>@;
+@<Error handling functions@>@;
+@<Internal functions@>@;
+@<The main function@>@;
+
+@ Here are some macros for common programming idioms.
+
+@d incr(v) v+=1 /* increase a variable by unity */
+@d decr(v) v-=1 /* decrease a variable by unity */
+@d loop @+ while (1)@+ /* repeat over and over until a |break| happens */
+@d do_nothing /* empty statement */
+@f loop while
+
+
+@ Furthermore we include the additional types |boolean| and |string|.
+@d false 0
+@d true 1
+@<Global types@>=
+typedef int boolean;
+typedef char* string;
+
+
+@ The following parameters should be sufficient for most
+applications of \.{TIE}.
+@^system dependencies@>
+
+@<Global constants@>=
+#define buf_size 512 /* maximum length of one input line */
+#define max_file_index 9
+/* we don't think that anyone needs more than 9 change files,
+ but \dots\ just change it */
+
+
+@ We introduce a history variable that allows us to set a
+return code if the operating system can use it.
+First we introduce the coded values for the history.
+This variable must be initialized.
+(We do this even if the value given may be the default for
+variables, just to document the need for the initial value.)
+@d spotless 0
+@d troublesome 1
+@d fatal 2
+
+@<Global variables@>=
+static int history=spotless;
+
+
+
+@* The character set.
+
+\noindent One of the main goals in the design of \.{TIE} has
+been to make it readily portable between a wide variety of
+computers. Yet \.{TIE} by its very nature must use a
+greater variety of characters than most computer programs
+deal with, and character encoding is one of the areas in
+which existing machines differ most widely from each other.
+
+To resolve this problem, all input to \.{TIE} is converted to an
+internal seven-bit code that is essentially standard \ASCII{}, the
+``American Standard Code for Information Interchange.'' The conversion
+is done immediately when each character is read in. Conversely,
+characters are converted from \ASCII{} to the user's external
+representation just before they are output. But the algorithm is
+prepared for the usage of eight-bit data.
+
+\noindent Here is a table of the standard visible \ASCII{} codes:
+$$\def\:{\char\count255\global\advance\count255 by 1}
+\count255='40
+\vbox{
+\hbox{\hbox to 40pt{\it\hfill0\/\hfill}%
+\hbox to 40pt{\it\hfill1\/\hfill}%
+\hbox to 40pt{\it\hfill2\/\hfill}%
+\hbox to 40pt{\it\hfill3\/\hfill}%
+\hbox to 40pt{\it\hfill4\/\hfill}%
+\hbox to 40pt{\it\hfill5\/\hfill}%
+\hbox to 40pt{\it\hfill6\/\hfill}%
+\hbox to 40pt{\it\hfill7\/\hfill}}
+\vskip 4pt
+\hrule
+\def\^{\vrule height 10.5pt depth 4.5pt}
+\halign{\hbox to 0pt{\hskip -24pt\O{#0}\hfill}&\^
+\hbox to 40pt{\tt\hfill#\hfill\^}&
+&\hbox to 40pt{\tt\hfill#\hfill\^}\cr
+04&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+05&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+06&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+07&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+10&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+11&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+12&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+13&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+14&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+15&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+16&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+17&\:&\:&\:&\:&\:&\:&\:\cr}
+\hrule width 280pt}$$
+(Actually, of course, code |040| is an invisible blank space.) Code |0136|
+was once an upward arrow (\.{\char'13}), and code |0137| was
+once a left arrow (\.^^X), in olden times when the first draft
+of ASCII code was prepared; but \.{TIE} works with today's standard
+ASCII in which those codes represent circumflex and underline as shown.
+The maximum value used is also defined, it must be changed if an
+extended \ASCII{} is used.
+
+If the \Cl\ compiler is not able to process \&{unsigned char}'s, you
+should define |ASCII_Code| as \&{short}.
+@^system dependencies@>
+
+@<Global types@>=
+#define max_ASCII (@'~'+1)
+typedef unsigned char ASCII_Code;
+ /* eight-bit numbers, a subrange of the integers */
+
+
+@ \Cl\ was first implemented on a machine that uses the
+\ASCII{} representation for characters. But to make it readily
+available also for other machines (big brother is watching?)\
+we add a conversion that may be undone for most installations.
+\.{TIE} assumes that it is being used
+with a character set that contains at least the
+characters of standard \ASCII{} as listed above.
+
+In order to accommodate this difference, we shall use the
+name |text_char| to stand for the data type of the
+characters in the input and output files. We shall also
+assume that |text_char| consists of the elements
+|first_text_char| through |last_text_char|,
+inclusive. The following definitions should be adjusted if
+necessary.
+@^system dependencies@>
+
+@d first_text_char 0 /* ordinal number of the smallest element of |text_char|*/
+@d last_text_char 255 /* ordinal number of the largest element of |text_char|*/
+
+@<Global types@>=
+typedef unsigned char text_char; /* the data type of characters in text files */
+typedef FILE* text_file;
+
+
+@ The \.{TIE} processor converts between \ASCII{} code and
+the user's external character set by means of arrays |xord|
+and |xchr| that are analogous to \PASCAL's |ord| and |chr|
+functions.
+
+The mapping may be disabled by changing the following macro
+definitions to just a cast. If your \Cl\ compiler does not support
+\&{unsigned char}'s, you should incorporate a binary and with |0xff|.
+@^system dependencies@>
+
+@d map_xchr(c) (text_char)(c)
+ /* change this to |xchr[c]| on non \ASCII{} machines */
+@d map_xord(c) (ASCII_Code)(c)
+ /* change this to |xord[c]| on non \ASCII{} machines */
+
+@<Global variables@>=
+static ASCII_Code xord[last_text_char+1];
+ /* specifies conversion of input characters */
+static text_char xchr[max_ASCII+1];
+ /* specifies conversion of output characters */
+
+
+@ If we assume that every system using \.{WEB} is able to
+read and write the visible characters of standard \ASCII{}
+(although not necessarily using the \ASCII{} codes to
+represent them), the following assignment statements
+initialize most of the |xchr| array properly, without
+needing any system-dependent changes. For example, the
+statement |xchr[@'A']='A'| that appears in the present
+\.{WEB} file might be encoded in, say, {\mc EBCDIC} code on
+the external medium on which it resides, but \.{CTANGLE} will
+convert from this external code to \ASCII{} and back again.
+Therefore the assignment statement |xchr[65]='A'| will
+appear in the corresponding \Cl\ file, and \Cl\ will
+compile this statement so that |xchr[65]| receives the
+character \.A in the external code. Note that it
+would be quite incorrect to say |xchr[@'A']=@'A'|, because
+|@'A'| is a constant of type |int| not \&{char}, and
+because we have |@'A'==65| regardless of the external
+character set.
+
+@<Set initial values@>=
+xchr[@' ']=' ';
+xchr[@'!']='!';
+xchr[@'\"']='\"';
+xchr[@'#']='#';@/
+xchr[@'$']='$';
+xchr[@'%']='%';
+xchr[@'&']='&';
+xchr[@'\'']='\'';@/
+xchr[@'(']='(';
+xchr[@')']=')';
+xchr[@'*']='*';
+xchr[@'+']='+';@/
+xchr[@',']=',';
+xchr[@'-']='-';
+xchr[@'.']='.';
+xchr[@'/']='/';@/
+xchr[@'0']='0';
+xchr[@'1']='1';
+xchr[@'2']='2';
+xchr[@'3']='3';@/
+xchr[@'4']='4';
+xchr[@'5']='5';
+xchr[@'6']='6';
+xchr[@'7']='7';@/
+xchr[@'8']='8';
+xchr[@'9']='9';
+xchr[@':']=':';
+xchr[@';']=';';@/
+xchr[@'<']='<';
+xchr[@'=']='=';
+xchr[@'>']='>';
+xchr[@'?']='?';@/
+xchr[@'@@']='@@';
+xchr[@'A']='A';
+xchr[@'B']='B';
+xchr[@'C']='C';@/
+xchr[@'D']='D';
+xchr[@'E']='E';
+xchr[@'F']='F';
+xchr[@'G']='G';@/
+xchr[@'H']='H';
+xchr[@'I']='I';
+xchr[@'J']='J';
+xchr[@'K']='K';@/
+xchr[@'L']='L';
+xchr[@'M']='M';
+xchr[@'N']='N';
+xchr[@'O']='O';@/
+xchr[@'P']='P';
+xchr[@'Q']='Q';
+xchr[@'R']='R';
+xchr[@'S']='S';@/
+xchr[@'T']='T';
+xchr[@'U']='U';
+xchr[@'V']='V';
+xchr[@'W']='W';@/
+xchr[@'X']='X';
+xchr[@'Y']='Y';
+xchr[@'Z']='Z';
+xchr[@'[']='[';@/
+xchr[@'\\']='\\';
+xchr[@']']=']';
+xchr[@'^']='^';
+xchr[@'_']='_';@/
+xchr[@'`']='`';
+xchr[@'a']='a';
+xchr[@'b']='b';
+xchr[@'c']='c';@/
+xchr[@'d']='d';
+xchr[@'e']='e';
+xchr[@'f']='f';
+xchr[@'g']='g';@/
+xchr[@'h']='h';
+xchr[@'i']='i';
+xchr[@'j']='j';
+xchr[@'k']='k';@/
+xchr[@'l']='l';
+xchr[@'m']='m';
+xchr[@'n']='n';
+xchr[@'o']='o';@/
+xchr[@'p']='p';
+xchr[@'q']='q';
+xchr[@'r']='r';
+xchr[@'s']='s';@/
+xchr[@'t']='t';
+xchr[@'u']='u';
+xchr[@'v']='v';
+xchr[@'w']='w';@/
+xchr[@'x']='x';
+xchr[@'y']='y';
+xchr[@'z']='z';
+xchr[@'{']='{';@/
+xchr[@'|']='|';
+xchr[@'}']='}';
+xchr[@'~']='~';@/
+xchr[0]=' '; xchr[0x7F]=' '; /* these \ASCII{} codes are not used */
+
+
+@ Some of the \ASCII{} codes below |0x20| have been given a
+symbolic name in \.{TIE} because they are used with a special
+meaning.
+
+@d tab_mark @'\t' /* \ASCII{} code used as tab-skip */
+@d nl_mark @'\n' /* \ASCII{} code used as line end marker */
+@d form_feed @'\f' /* \ASCII{} code used as page eject */
+
+
+@ When we initialize the |xord| array and the remaining
+parts of |xchr|, it will be convenient to make use of an
+index variable, |i|.
+
+@<Local variables for initialisation@>=
+int i;
+
+
+@ Here now is the system-dependent part of the character
+set. If \.{TIE} is being implemented on a garden-variety
+\Cl\ for which only standard \ASCII{} codes will appear
+in the input and output files, you don't need to make any
+changes here.
+@^system dependencies@>
+
+Changes to the present module will make \.{TIE} more
+friendly on computers that have an extended character set,
+so that one can type things like \.^^Z. If you have an
+extended set of characters that are easily incorporated into
+text files, you can assign codes arbitrarily here, giving an
+|xchr| equivalent to whatever characters the users of
+\.{TIE} are allowed to have in their input files, provided
+that unsuitable characters do not correspond to special
+codes like |tab_mark| that are listed above.
+
+@<Set init...@>=
+for (i=1;i<@' ';xchr[i++]=' ');
+xchr[tab_mark]='\t';
+xchr[form_feed]='\f';
+xchr[nl_mark]='\n';
+
+
+@ The following system-independent code makes the |xord|
+array contain a suitable inverse to the information in
+|xchr|.
+
+@<Set init...@>=
+for ( i=first_text_char ; i<=last_text_char ; xord[i++]=@' ' ) do_nothing;
+for ( i=1 ; i<=@'~' ; i++ ) xord[xchr[i]] = i;
+
+
+
+
+
+@* Input and output.
+
+\noindent Output for the user is done by writing on file |term_out|,
+which is assumed to consist of characters of type \&{text\_char}. It
+should be linked to |stdout| usually. Terminal input is not needed in
+this version of \.{TIE}. |stdin| and |stdout| are predefined if we
+include the \.{stdio.h} definitions. Although I/O redirection for
+|stdout| is usually available you may lead output to another file if
+you change the definition of |term_out|. Also we define some macros
+for terminating an output line and writing strings to the user.
+
+@^system dependencies@>
+@d term_out stdout
+@d print(a) fprintf(term_out,a) /* `|print|' means write on the terminal */
+@d print2(a,b) fprintf(term_out,a,b) /* same with two arguments */
+@d print3(a,b,c) fprintf(term_out,a,b,c) /* same with three arguments */
+@d print_c(v) fputc(v,term_out); /* print a single character */
+@d new_line(v) fputc('\n',v) /* start new line */
+@d term_new_line new_line(term_out)
+ /* start new line of the terminal */
+@d print_ln(v) {fprintf(term_out,v);term_new_line;}
+ /* `|print|' and then start new line */
+@d print2_ln(a,b) {print2(a,b);term_new_line;} /* same with two arguments */
+@d print3_ln(a,b,c) {print3(a,b,c);term_new_line;}
+ /* same with three arguments */
+@d print_nl(v) {term_new_line; print(v);}
+ /* print information starting on a new line */
+@d print2_nl(a,b) {term_new_line; print2(a,b);}
+ /* same for two arguments */
+
+@<Global |#include|s@>=
+#include <stdio.h>
+
+
+@ And we need dynamic memory allocation.
+This should cause no trouble in any \Cl\ program.
+@^system dependencies@>
+
+@<Global |#include|s@>=
+#ifdef __STDC__
+#include <stdlib.h>
+#else
+#include <malloc.h>
+#endif
+
+@ The |update_terminal| function is called when we want to
+make sure that everything we have output to the terminal so
+far has actually left the computer's internal buffers and
+been sent.
+@^system dependencies@>
+
+@d update_terminal fflush(term_out) /* empty the terminal output buffer */
+
+
+
+
+
+@* Data structures.
+
+\noindent The multiple input files (master file and change
+files) are treated the same way. To organize the
+simultaneous usage of several input files, we introduce the
+data type \&{in\_file\_modes}.
+
+The mode |search| indicates that \.{TIE} searches for a
+match of the input line with any line of an input file in
+|reading| mode. |test| is used whenever a match is found
+and it has to be tested if the next input lines do match
+also. |reading| describes that the lines can be read without
+any check for matching other lines. |ignore| denotes
+that the file cannot be used. This may happen because an
+error has been detected or because the end of the file has
+been found.
+
+\leavevmode |file_types| is used to describe whether a file
+is a master file or a change file. The value |unknown| is added
+to this type to set an initial mode for the output file.
+This enables us to check whether any option was used to select
+the kind of output. (this would even be necessary if we
+would assume a default action for missing options.)
+
+@<Global types@>=
+#define search 0
+#define test 1
+#define reading 2
+#define ignore 3
+typedef int in_file_modes; /* should be |enum(search,test,reading,ignore)| */
+#define unknown 0
+#define master 1
+#define chf 2
+typedef int file_types; /* should be |enum(unknown,master,chf)| */
+
+
+@ A variable of type |out_md_type| will tell us in what state the output
+change file is during processing. |normal| will be the state, when we
+did not yet start a change, |pre| will be set when we write the lines
+to be changes and |post| will indicate that the replacement lines are
+written.
+
+@<Global types@>=
+#define normal 0
+#define pre 1
+#define post 2
+typedef int out_md_type; /* should be |enum(normal,pre,post)| */
+
+
+@ Two more types will indicate variables used as an index into either
+the file buffer or the file table.
+
+@<Global types@>=
+typedef int buffer_index; /* |-1..buf_size| */
+typedef int file_index; /* |-1..max_file_index+1| */
+
+
+@ The following data structure joins all informations needed to use
+these input files.
+%`line' is a normal identifier throughout this program
+@f line dummy
+@<Global types@>=
+typedef struct _idsc{
+ string name_of_file;
+ ASCII_Code buffer[buf_size];
+ in_file_modes mode;
+ long line;
+ file_types type_of_file;
+ buffer_index limit;
+ text_file the_file;
+ } input_description;
+
+
+@ These data types are used in the global variable section.
+They refer to the files in action, the number of change files,
+the mode of operation and the current output state.
+
+@<Global variables@>=
+static file_index actual_input,test_input,no_ch;
+static file_types prod_chf=unknown;
+static out_md_type out_mode;
+
+
+@ All input files (including the master file) are recorded
+in the following structure.
+Mostly the components are accessed through a local pointer variable.
+This corresponds to \PASCAL's \&{with}-statement
+and results in a one-time-computation of the index expression.
+
+@<Global variables@>=
+static input_description *input_organization[max_file_index+1];
+
+
+
+
+
+@* File I/O.
+
+\noindent The basic function |get_line| can be used to get a line from
+an input file. The line is stored in the |buffer| part of the
+descriptor. The components |limit| and |line| are updated. If the
+end of the file is reached |mode| is set to |ignore|. On some systems
+it might be useful to replace tab characters by a proper number of
+spaces since several editors used to create change files insert tab
+characters into a source file not under control of the user. So it
+might be a problem to create a matching change file.
+@^tab character expansion@>
+
+We define |get_line| to read a line from a file specified by
+the corresponding file descriptor.
+
+@<Internal functions@>=
+void get_line(i)
+ file_index i;
+{register input_description *inp_desc=input_organization[i];
+ if (inp_desc->mode==ignore) return;
+ if (feof(inp_desc->the_file))
+ @<Handle end of file and return@>@;
+ @<Get line into buffer@>@;
+}
+
+
+@ End of file is special if this file is the master file.
+Then we set the global flag variable |input_has_ended|.
+
+@<Handle end of file ...@>=
+{
+ inp_desc->mode=ignore;
+ inp_desc->limit=-1; /* mark end-of-file */
+ if (inp_desc->type_of_file==master) input_has_ended=true;
+ return;
+}
+
+
+@ This variable must be declared for global access.
+
+@<Global variables@>=
+static boolean input_has_ended=false;
+
+
+@ Lines must fit into the buffer completely.
+We read all characters sequentially until an end of line is found
+(but do not forget to check for |EOF|!).
+Too long input lines will be truncated.
+This will result in a damaged output if they occur in the
+replacement part of a change file, or in an incomplerte check if the
+matching part is concerned.
+Tab character expansion might be done here.
+@^tab character expansion@>
+
+@<Get line into buffer@>=
+{int final_limit; /* used to delete trailing spaces */
+ int c; /* the actual character read */
+ @<Increment the line number and print a progess report at
+ certain times@>@;
+ inp_desc->limit=final_limit=0;
+ while (inp_desc->limit<buf_size) {
+ c=fgetc(inp_desc->the_file);
+ @<Check |c| for |EOF|, |return| if line was empty, otherwise
+ |break| to process last line@>@;
+ inp_desc->buffer[inp_desc->limit++]=c=map_xord(c);
+ if (c==nl_mark) break; /* end of line found */
+ if (c!=@' ' && c!=tab_mark)
+ final_limit=inp_desc->limit;
+ }
+ @<Test for truncated line, skip to end of line@>@;
+ inp_desc->limit=final_limit;
+}
+
+
+@ This section does what its name says. Every 100 lines
+in the master file we print a dot, every 500 lines the number
+of lines is shown.
+
+@<Increment the line number and print ...@>=
+incr(inp_desc->line);
+if (inp_desc->type_of_file==master && inp_desc->line % 100==0) {
+ if (inp_desc->line % 500 == 0) print2("%ld",inp_desc->line);
+ else print_c('.');
+ update_terminal;
+}
+
+
+@ There may be incomplete lines of the editor used does
+not make sure that the last character before end of file
+is an end of line. In such a case we must process the
+final line. Of the current line is empty, we just can \&{return}.
+Note that this test must be done {\sl before} the character read
+is translated.
+@^system dependencies@>
+
+@<Check |c| for |EOF|...@>=
+ if (c==EOF) {
+ if (inp_desc->limit<=0) {
+ inp_desc->mode=ignore;
+ inp_desc->limit=-1; /* mark end-of-file */
+ if (inp_desc->type_of_file==master) input_has_ended=true;
+ return;
+ } else { /* add end of line mark */
+ c=nl_mark;
+ break;
+ }
+ }
+
+
+@ If the line is truncated we must skip the rest
+(and still watch for |EOF|!).
+@<Test for truncated line, skip to end of line@>=
+if (c!=nl_mark) {
+ err_print("! Input line too long")(i);
+@.Input line too long@>
+ while ( (c=fgetc(inp_desc->the_file)) != EOF && map_xord(c) != nl_mark )
+ do_nothing; /* skip to end */
+ }
+
+
+
+
+
+@* Reporting errors to the user.
+
+\noindent There may be errors if a line in a given change
+file does not match a line in the master file or a
+replacement in a previous change file. Such errors are
+reported to the user by saying
+$$
+ \hbox{|err_print("! Error message")(file_no)|;}
+$$
+where |file_no| is the number of the file which is concerned by the
+error. Please note that no trailing dot is supplied by the error
+message because it is appended by |err_print|.
+
+This function is implemented as a macro. It gives a message and an
+indication of the offending file. The actions to determine the error
+location are provided by a function called |err_loc|.
+
+@d error_loc(m) err_loc(m); history=troublesome; @+ }
+@d err_print(m) { @+ print_nl(m); error_loc
+
+@<Error handling...@>=
+void err_loc(i) /* prints location of error */
+ int i;
+{
+ print3_ln(" (file %s, l.%ld).",
+ input_organization[i]->name_of_file,
+ input_organization[i]->line);
+}
+
+
+@ Non recoverable errors are handled by calling |fatal_error| that
+outputs a message and then calls `|jump_out|'. |err_print| will print
+the error message followed by an indication of where the error was
+spotted in the source files. |fatal_error| cannot state any files
+because the problem is usually to access these.
+
+@d fatal_error(m) {
+ print(m); print_c('.'); history=fatal;
+ term_new_line; jump_out();
+ }
+
+
+@ |jump_out| just cuts across all active procedure levels and jumps
+out of the program. It is used when no recovery from a particular
+error has been provided. The return code from this program should be
+regarded by the caller.
+
+@d jump_out() exit(1)
+
+
+
+
+
+@* Handling multiple change files.
+
+\noindent In the standard version we take the name of the
+files from the command line.
+It is assumed that filenames can be used as given in the
+command line without changes.
+
+First there are some sections to open all files.
+If a file is not accessible, the run will be aborted.
+Otherwise the name of the open file will be displayed.
+
+@<Prepare the output file@>=
+{
+ out_file=fopen(out_name,"w");
+ if (out_file==NULL) {
+ fatal_error("! Could not open/create output file");
+@.Could not open/create output file@>
+ }
+}
+
+
+@ The name of the file and the file desciptor are stored in
+global variables.
+
+@<Global variables@>=
+static text_file out_file;
+static string out_name;
+
+
+@ For the master file we start just reading its first line
+into the buffer, if we could open it.
+
+@<Get the master file started@>=
+{ input_organization[0]->the_file=
+ fopen(input_organization[0]->name_of_file,"r");
+ if (input_organization[0]->the_file==NULL)
+ fatal_error("! Could not open master file");
+@.Could not open master file@>
+ print2("(%s)",input_organization[0]->name_of_file);
+ term_new_line;
+ input_organization[0]->type_of_file=master;
+ get_line(0);
+}
+
+@ For the change files we must skip the comment part and
+see, whether we can find any change in it.
+This is done by |init_change_file|.
+
+@<Prepare the change files@>=
+{file_index i;
+ i=1;
+ while (i<no_ch) {
+ input_organization[i]->the_file=
+ fopen(input_organization[i]->name_of_file,"r");
+ if (input_organization[i]->the_file==NULL)
+ fatal_error("!Could not open change file");
+@.Could not open change file@>
+ print2("(%s)",input_organization[i]->name_of_file);
+ term_new_line;
+ init_change_file(i,true);
+ incr(i);
+ }
+}
+
+
+
+
+
+@*Input/output organization.
+
+\noindent Here's a simple function that checks if two lines
+are different.
+
+@<Internal functions@>=
+boolean lines_dont_match(i,j)
+ file_index i,j;
+{
+ buffer_index k,lmt;
+ if (input_organization[i]->limit != input_organization[j]->limit)
+ return(true);
+ lmt=input_organization[i]->limit;
+ for ( k=0 ; k<lmt ; k++ )
+ if (input_organization[i]->buffer[k] != input_organization[j]->buffer[k])
+ return(true);
+ return(false);
+}
+
+
+@ Function |init_change_file(i,b)| is used to ignore all
+lines of the input file with index |i| until the next change
+module is found. The boolean parameter |b| indicates
+whether we do not want to see \.{@@x} or \.{@@y} entries during
+our skip.
+
+@<Internal functions@>=
+void init_change_file(i,b)
+ file_index i; boolean b;
+{register input_description *inp_desc=input_organization[i];
+ @<Skip over comment lines; |return| if end of file@>@;
+ @<Skip to the next nonblank line; |return| if end of file@>@;
+}
+
+
+@ While looking for a line that begins with \.{@@x} in the
+change file, we allow lines that begin with \.{@@}, as long
+as they don't begin with \.{@@y} or \.{@@z} (which would
+probably indicate that the change file is fouled up).
+
+@<Skip over comment lines...@>=
+loop@+ {ASCII_Code c;
+ get_line(i);
+ if (inp_desc->mode==ignore) return;
+ if (inp_desc->limit<2) continue;
+ if (inp_desc->buffer[0] != @'@@') continue;
+ c=inp_desc->buffer[1];
+ if (c>=@'X' && c<=@'Z')
+ c+=@'z'-@'Z'; /*lowercasify*/
+ if (c==@'x') break;
+ if (c==@'y' || c==@'z')
+ if (b) /* scanning for start of change */
+ err_print("! Where is the matching @@x?")(i);
+@.Where is the match...@>
+}
+
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+do{
+ get_line(i);
+ if (inp_desc->mode==ignore) {
+ err_print("! Change file ended after @@x")(i);
+@.Change file ended...@>
+ return;
+ }
+} while (inp_desc->limit<=0);
+
+
+@ The |put_line| function is used to write a line from
+input buffer |j| to the output file.
+
+@<Internal functions@>=
+void put_line(j)
+ file_index j;
+{buffer_index i; /* index into the buffer */
+ buffer_index lmt; /* line length */
+ ASCII_Code *p; /* output pointer */
+ lmt=input_organization[j]->limit;
+ p=input_organization[j]->buffer;
+ for (i=0;i<lmt;i++) fputc(map_xchr(*p++),out_file);
+ new_line(out_file);
+}
+
+
+@ The function |e_of_ch_module| returns true if the input
+line from file |i| starts with \.{@@z}.
+
+@<Internal functions@>=
+boolean e_of_ch_module(i)
+ file_index i;
+{register input_description *inp_desc=input_organization[i];
+ if (inp_desc->limit<0) {
+ print_nl("! At the end of change file missing @@z ");
+@.At the end of change file...@>
+ print2("%s",input_organization[i]->name_of_file);
+ term_new_line;
+ return(true);
+ } else if (inp_desc->limit>=2) if (inp_desc->buffer[0]==@'@@' &&
+ (inp_desc->buffer[1]==@'Z' || inp_desc->buffer[1]==@'z'))
+ return(true);
+ return(false);
+}
+
+
+@ The function |e_of_ch_preamble| returns |true| if the input
+line from file |i| starts with \.{@@y}.
+
+@<Internal functions@>=
+boolean e_of_ch_preamble(i)
+ file_index i;
+{register input_description *inp_desc=input_organization[i];
+ if (inp_desc->limit>=2 && inp_desc->buffer[0]==@'@@')
+ if (inp_desc->buffer[1]==@'Y'||inp_desc->buffer[1]==@'y') return(true);
+ return(false);
+}
+
+
+
+@ To process the input file the next section
+reads a line of the actual input file and updates the
+|input_organization| for all files with index |test_file| greater
+|actual_input|.
+
+@<Process a line, |break| when end of source reached@>=
+{file_index test_file;
+ @<Check the current files for any ends of changes@>@;
+ if (input_has_ended && actual_input==0) break; /* all done */
+ @<Scan all other files for changes to be done@>@;
+ @<Handle output@>@;
+ @<Step to next line@>@;
+}
+
+
+@ Any of the current change files may have reached the end of change.
+In such a case intermediate lines must be skipped and the next start
+of change is to be found. This may make a change file inactive if
+it reaches end of file.
+
+@<Check the...@>=
+{register input_description *inp_desc;
+while (actual_input>0 && e_of_ch_module(actual_input)) {
+ inp_desc=input_organization[actual_input];
+ if (inp_desc->type_of_file==master) {
+ /* emergency exit, everything mixed up!*/
+ fatal_error("! This can't happen: change file is master file");
+@.This can't happen...@>
+ }
+ inp_desc->mode=search;
+ init_change_file(actual_input,true);
+ while ((input_organization[actual_input]->mode!=reading
+ && actual_input>0)) decr(actual_input);
+}
+}
+
+
+@ Now we will set |test_input| to the file that has another match
+for the current line. This depends on the state of the other
+change files. If no other file matches, |actual_input| refers to
+a line to write and |test_input| ist set to |none|.
+
+@d none (max_file_index+1)
+
+@<Scan all other files...@>=
+test_input=none;
+test_file=actual_input;
+while (test_input==none && test_file<no_ch-1){
+ incr(test_file);
+ switch (input_organization[test_file]->mode) {
+ case search: if (lines_dont_match(actual_input,test_file)==false) {
+ input_organization[test_file]->mode=test;
+ test_input=test_file;
+ }
+ break;
+ case test: if (lines_dont_match(actual_input, test_file)==true) {
+ /* error, sections do not match */
+ input_organization[test_file]->mode=search;
+ err_print("! Sections do not match")(actual_input);
+@.Sections do not match@>
+ err_loc(test_file);
+ init_change_file(test_file,false);
+ } else test_input=test_file;
+ break;
+ case reading: do_nothing; /* this can't happen */
+ break;
+ case ignore: do_nothing; /* nothing to do */
+ break;
+ }
+}
+
+
+@ For the output we must distinguish whether we create a new change
+file or a new master file. The change file creation needs some closer
+inspection because we may be before a change, in the pattern part or
+in the replacement part. For a master file we have to write the line
+from the current actual input.
+
+@<Handle output@>=
+if (prod_chf==chf) {
+ loop @+ {
+ @<Test for normal, |break| when done@>@;
+ @<Test for pre, |break| when done@>@;
+ @<Test for post, |break| when done@>@;
+ }
+} else
+if (test_input==none) put_line(actual_input);
+
+
+@ Check whether we have to start a change file entry.
+Without a match nothing must be done.
+
+@<Test for normal...@>=
+if (out_mode==normal) {
+ if (test_input!=none) {
+ fputc(map_xchr(@'@@'),out_file); fputc(map_xchr(@'x'),out_file);
+ new_line(out_file);
+ out_mode=pre;
+ } else break;
+}
+
+
+@ Check whether we have to start the replacement text.
+This is the case when we have no more matching line.
+Otherwise the master file source line must be copied to the
+change file.
+@<Test for pre...@>=
+
+ if (out_mode==pre) {
+ if (test_input==none) {
+ fputc(map_xchr(@'@@'),out_file); fputc(map_xchr(@'y'),out_file);
+ new_line(out_file);
+ out_mode=post;
+ } else {
+ if (input_organization[actual_input]->type_of_file==master)
+ put_line(actual_input);
+ break;
+ }
+ }
+
+
+@ Check whether an entry from a change file is complete.
+If the current change was a change for a change file in effect,
+then this change file line must be written.
+If the actual input has been reset to the master file we
+can finish this change.
+
+@<Test for post...@>=
+ if (out_mode==post) {
+ if (input_organization[actual_input]->type_of_file==chf) {
+ if (test_input==none) put_line(actual_input);
+ break;
+ } else {
+ fputc(map_xchr(@'@@'),out_file); fputc(map_xchr(@'z'),out_file);
+ new_line(out_file);
+ new_line(out_file);
+ out_mode=normal;
+ }
+ }
+
+
+@ If we had a change, we must proceed in the actual file
+to be changed and in the change file in effect.
+
+@<Step to next line@>=
+get_line(actual_input);
+if (test_input!=none) {
+ get_line(test_input);
+ if (e_of_ch_preamble(test_input)==true) {
+ get_line(test_input); /* update current changing file */
+ input_organization[test_input]->mode=reading;
+ actual_input=test_input;
+ test_input=none;
+ }
+}
+
+
+@ To create the new output file we have to scan the whole
+master file and all changes in effect when it ends.
+At the very end it is wise to check for all changes
+to have completed--in case the last line of the master file
+was to be changed.
+
+@<Process the input@>=
+actual_input=0;
+input_has_ended=false;
+while (input_has_ended==false||actual_input!=0)
+ @<Process a line...@>@;
+if (out_mode==post) { /* last line has been changed */
+ fputc(map_xchr(@'@@'),out_file); fputc(map_xchr(@'z'),out_file);
+ new_line(out_file);
+ }
+
+
+@ At the end of the program, we will tell the user if the
+change file had a line that didn't match any relevant line
+in the master file or any of the change files.
+
+@<Check that all changes have been read@>=
+{file_index i;
+for (i=1;i<no_ch;i++) {/* all change files */
+ if (input_organization[i]->mode!=ignore)
+ err_print("! Change file entry did not match")(i);
+@.Change file entry ...@>
+ }
+}
+
+
+@ We want to tell the user about our command line options. This is
+done by the |usage()| function. It contains merely the necessary
+print statement and exits afterwards.
+
+@<Intern...@>=
+void usage()
+{
+ print("Usage: tie -[mc] outfile master changefile(s)");
+ term_new_line;
+ jump_out();
+}
+
+
+@ We must scan through the list of parameters, given in |argv|. The
+number is in |argc|. We must pay attention to the flag parameter. We
+need at least 5~parameters and can handle up to |max_file_index|
+change files. The names fo the file parameters will be inserted into
+the structure of |input_organization|. The first file is special. It
+indicates the output file. When we allow flags at any position, we
+must find out which name is for what purpose. The master file is
+already part of the |input_organization| structure (index~0). As long
+as the number of files found (counted in |no_ch|) is |-1| we have not
+yet found the output file name.
+
+@<Scan the parameters@>=
+{int act_arg;
+ if ( argc < 5 || argc > max_file_index+4-1 ) usage();
+ no_ch = -1; /* fill this part of |input_organization| */
+ for ( act_arg=1 ; act_arg<argc ; act_arg++ ) {
+ if (argv[act_arg][0]=='-') @<Set a flag@>@;
+ else @<Get a file name@>@;
+ }
+ if (no_ch<=0|| prod_chf==unknown) usage();
+}
+
+
+@ The flag is about to determine the processing mode.
+We must make sure that this flag has not been set before.
+Further flags might be introduced to avoid/force overwriting of
+output files.
+Currently we just have to set the processing flag properly.
+
+@<Set a flag@>=
+if (prod_chf!=unknown) usage();
+else
+ switch (argv[act_arg][1]) {
+ case 'c':
+ case 'C': prod_chf=chf; break;
+ case 'm':
+ case 'M': prod_chf=master; break;
+ default: usage();
+ }
+
+
+@ We have to distinguish whether this is the very first file name
+(known if |no_ch==(-1)|) or if the next element of |input_organization|
+must be filled.
+
+@<Get a file name@>=
+{ if (no_ch==(-1)) {
+ out_name=argv[act_arg];
+ } else { register input_description *inp_desc;
+ inp_desc=(input_description *)
+ malloc(sizeof(input_description));
+ if (inp_desc==NULL)
+ fatal_error("! No memory for descriptor");
+@.No memory for descriptor@>
+ inp_desc->mode=search;
+ inp_desc->line=0;
+ inp_desc->type_of_file=chf;
+ inp_desc->limit=0;
+ inp_desc->name_of_file=argv[act_arg];
+ input_organization[no_ch]=inp_desc;
+ }
+ incr(no_ch);
+}
+
+
+@* The main program.
+
+\noindent Here is where \.{TIE} starts, and where it ends.
+
+@<The main function@>=
+main(argc,argv)
+ int argc; string *argv;
+{{@<Local variables for initialisation@>@;
+ @<Set initial...@>@;
+ }
+ print_ln(banner); /* print a ``banner line'' */
+ print_ln(copyright); /* include the copyright notice */
+ actual_input=0;
+ out_mode=normal;
+ @<Scan the parameters@>@;
+ @<Prepare the output file@>@;
+ @<Get the master file started@>@;
+ @<Prepare the change files@>@;
+ @<Process the input@>@;
+ @<Check that all changes have been read@>@;
+ @<Print the job |history|@>@;
+}
+
+@ We want to pass the |history| value to the operating system so that
+it can be used to govern whether or not other programs are started.
+Additionaly we report the history to the user, although this may not
+be ``{\mc UNIX}'' style---but we are in best companion: \.{WEB} and
+\TeX{} do the same.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+{string msg;
+ switch (history) {
+ case spotless: msg="No errors were found"; break;
+ case troublesome: msg="Pardon me, but I think I spotted something wrong.";
+ break;
+ case fatal: msg="That was a fatal error, my friend"; break;
+ } /* there are no other cases */
+ print2_nl("(%s.)",msg); term_new_line;
+ exit ( history == spotless ? 0 : 1 );
+}
+
+
+
+
+
+@* System-dependent changes.
+
+\noindent This section should be replaced, if necessary, by
+changes to the program that are necessary to make \.{TIE}
+work at a particular installation. It is usually best to
+design your change file so that all changes to previous
+modules preserve the module numbering; then everybody's
+version will be consistent with the printed program. More
+extensive changes, which introduce new modules, can be
+inserted here; then only the index itself will get a new
+module number.
+@^system dependencies@>
+
+
+
+
+
+@* Index.
+
+\noindent Here is the cross-reference table for the \.{TIE}
+processor.
diff --git a/Build/source/texk/web2c/tiedir/tiedoc.tex b/Build/source/texk/web2c/tiedir/tiedoc.tex
new file mode 100644
index 00000000000..40cb9198ac1
--- /dev/null
+++ b/Build/source/texk/web2c/tiedir/tiedoc.tex
@@ -0,0 +1,176 @@
+% tiedoc.tex 26 Oct 89
+%------------------------
+
+% 89-10-26 js: changed description of user interface which was altered
+% in the rewrite of TIE in CWEB.
+% 88-12-?? kg: first release
+
+
+
+\documentstyle{article}
+
+\let\mc=\small
+\def\TANGLE{{\tt TANGLE}}
+\def\TIE{{\tt TIE}}
+\def\WEAVE{{\tt WEAVE}}
+\def\WEB{{\tt WEB}}
+\def\CWEB{{\mc CWEB}}
+\def\PASCAL{Pascal}
+
+
+\begin{document}
+
+\title{The \TIE{} Processor}
+\author{Klaus Guntermann\\
+TH Darmstadt\\
+Fachbereich Informatik\\
+Institut f\"ur Theoretische Informatik}
+\date{October 1989}
+
+\maketitle
+
+
+
+\section{Introduction}
+
+To install a program on a computer usually
+system dependent changes are needed.
+The systems of the \WEB{} family allows to describe these changes in a
+so called change file.
+To incorporate the changes into the program \TANGLE\ processes
+the original source file and inserts the changes into the proper places.
+
+Sometimes it is good practice to develop a set of change files to be able to
+distinguish between different changes like
+program enhancements, bug fixes, system dependent changes
+and output device dependent modifications.
+Additionally this allows combinations of changes that can be used with a set of
+programs that share some common features.
+
+The processors \TANGLE\ and \WEAVE\ can handle only one change file.
+The combination of change files is done best in another preprocessing step.
+\TIE\ is able to create either a new master file or a single change file that
+comprises the effect of all change files.
+
+Since \TIE\ does not know anything about \WEB\ programs but only about the
+structure of change files, it is possible to use this program for other
+programming languages as well.
+You just pretend that you want to create a new master file and \TIE\ will go
+and insert all the changes from your change files.
+
+
+
+\section{Application}
+
+The current version of \TIE\ accepts a master file and up to 9 change files.
+Because in general it is important to use the changes in their proper sequence
+the order of the files must be chosen carefully.
+
+\TIE{} must be called with at least 4~parameters:
+%
+\begin{enumerate}
+
+\item either the option {\tt -c\/} or {\tt -m}. This option controls if
+a change file or a master file is created.
+
+\item the name of the output file.
+
+\item the name of the master file.
+
+\item the name(s) of the change file(s). At least one must be present.
+
+\end{enumerate}
+
+The multiple change files are used as if the single change files were
+merged into the master files step by step. Thus more than 9 change
+files might be incorporated by repeated application of \TIE. Of
+course you may change the constant {\it max\_file\_index\/} in \TIE{}
+which defines the maximum number of change files, too.
+
+Please note that even when multiple change files are processed each of
+the files is read only once. For each of the change files and for the
+master file there is only one line in memory at a time (neglecting
+operating system buffering). Thus the storage requirement of \TIE\
+does not depend on the size of the change files or the size of a
+single changed section.
+
+
+\newpage
+
+
+\def\eof{$\langle${\mc EOF}$\rangle$}
+\tabcolsep=1em
+
+
+\section{Example}
+
+To illustrate the actions \TIE\ performs you may inspect the following
+example that exercises some of the border line cases.
+
+\begin{center}
+\begin{tabular}{llll}
+\multicolumn1{c}{\sc Master}&
+ \multicolumn1{c}{\tt CF1}&
+ \multicolumn1{c}{\tt CF2}&
+ \multicolumn1{c}{\tt CF3}\\[1pt]
+\hline
+line 1 &@x &@x &@x\\
+line 2 &line 2 &line 1 &changed line 4\\
+line 3 &line 3 &changed line 2 &@y\\
+line 4 &@y &changed line 3 &final line 4\\
+line 5 &changed line 2 &inserted line &@z\\
+line 6 &changed line 3 &line 4 &\eof\\
+line 7 &inserted line &@y\\
+line 8 &@z &final line 2\\
+line 9 & &final line 3\\
+line 10 &@x &changed line 4\\
+\eof &line 7 &@z\\
+ &@y\\
+ &changed line 7 &@x\\
+ &@z &changed line 7\\
+ &\eof &line 8\\
+ & &@y\\
+ & &final line 7\\
+ & &final line 8\\
+ & &@z\\
+ & &\eof\\
+\end{tabular}
+\end{center}
+
+
+\newpage
+
+
+Using these input files and running \TIE\ twice to create a new master
+file and a new change file will result in the following output files:
+
+\begin{center}
+\begin{tabular}{ll}
+\multicolumn1{c}{\sc Master}&
+ \multicolumn1{c}{\sc Change}\\[1pt]
+\hline
+final line 2 &@x\\
+final line 3 &line 1\\
+final line 4 &line 2\\
+line 5 &line 3\\
+line 6 &line 4\\
+final line 7 &@y\\
+final line 8 &final line 2\\
+line 9 &final line 3\\
+line 10 &final line 4\\
+\eof &@z\\
+ &\\
+ &@x\\
+ &line 7\\
+ &line 8\\
+ &@y\\
+ &final line 7\\
+ &final line 8\\
+ &@z\\
+ &\eof\\
+\end{tabular}
+\end{center}
+
+
+
+\end{document}
diff --git a/Build/source/texk/web2c/triptrap/README b/Build/source/texk/web2c/triptrap/README
new file mode 100644
index 00000000000..a129fb893a9
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/README
@@ -0,0 +1,96 @@
+web2c/triptrap -- The trip and trap tests are Knuth's torture tests for
+TeX and Metafont. The MetaPost test is also named `trap', so I've
+renamed the conflicting files to `mftrap...' and `mptrap...'. (The
+contents of all files remain absolutely unaltered, of course.)
+
+The tests are exercised in the web2c distribution via `make trip trap mptrap'
+(from the top-level or web2c/ directories). They do not and cannot
+exercise the path searching capabilities; for that, a few ``normal''
+test runs before and after installation should suffice.
+
+{trip,mftrap,mptrap}.diffs -- show the diffs from Knuth's originals as
+generated on my development machine. tripman.tex, trapman.tex, and
+mptrap.readme explain precisely what is and is not acceptable.
+Generally, for trap and MetaPost trap, dates and times, a number of
+ constants and one call to BLANKRECTANGLE will be different.
+For trip, again some constants will be different. The floating point
+ numbers in glue set ratios may be slightly different (but all the box
+ dimensions must be the same), and the y* and down* commands in the
+ trip.dvi file may be somewhat different. The hyphenation exceptions
+ are different because the exception routine now does not count
+ identical hyphenations separately, i.e., \hyphenation{a-a a-a} only
+ generates one exception in the table. See the messages below for why
+ this is a good/necessary thing (if the hyphenation exception table is
+ to be dynamic at all).
+
+texmf.cnf -- sets up various constants the way the tests want them. Not
+all constants can be changed, alas, but this suffices to avoid building
+a separate binary just to run the tests.
+
+*.in -- fed to the programs as standard input, to avoid manual intervention.
+
+All the other files are test sources and output.
+It's a mistake to change them.
+
+
+About the hyphenation exception thing:
+
+Date: Mon, 1 Apr 96 11:04:29 BST
+From: wgs@maths.ucd.ie (Wayne G. Sullivan)
+To: kb@cs.umb.edu (K. Berry)
+Subject: Re: hyph_size +1
+
+Upon consideration I found another change needed for dynamic hyph_size.
+Actually, it is one I used earlier but removed for the sake of the trip.log.
+Knuth's treatment of hyhpenation exceptions has an unpleasant "feature"
+in that if the same "word" is given in \hyphenation{...}, the code does not
+replace the existing entry, but adds a new entry which comes before all
+other entries of the specific "word" (which includes the language code
+as its last "letter"), so that the earlier entries are inaccessible. The
+point is that the exceptions table retains useless data.
+Try this with the current version of TeX:
+ \hyphenation{ab ab ab ab ... ab ab}
+Use any word you like for "ab" so long as it has at least two letters. With
+\tracingstats>0, you get lots of hyphen exceptions, but only the last for
+"ab" is accessible. I could copy this behavior using a simple hash code,
+but it seems [pointless]. Instead, when a word is repeated in "\hyphenation"
+the new code simply replaces the old entry, so no extra space in the
+exception tables is consumed. Since there is no way to recover the previous
+entry for a hyphenation exception which has been superseded, I can see no
+point in keeping the old data. The location of hyphens is kept as a linked
+list in TeX's mem array. This data for a superseded hyphenation exception
+could also be flushed, but it makes more differences in trip.log because
+the memory stats are different. These entries are unlikely to consume much
+space, so there is little harm in leaving them.
+
+Anyway the additional change needed corresponds to the following:
+
+diff -c tex.ch.old tex.ch
+*** tex.ch.old Fri Mar 29 17:25:28 1996
+--- tex.ch Mon Apr 1 10:08:54 1996
+***************
+*** 2177,2182 ****
+--- 2177,2183 ----
+ until u=str_start[k+1];
+ {repeat hyphenation exception; flushing old data}
+ flush_string; s:=hyph_word[h]; {avoid |slow_make_string|!}
++ decr(hyph_count);
+ { We could also |flush_list(hyph_list[h]);|, but it interferes
+ with the trip.log. }
+ goto found;
+
+Thus it is only additional change is to decrement the hyph_count when a
+repeat hyphenation exception is encountered. This is really essential only
+for the "ini" version. The reason is to know exactly how many hyphenation
+exceptions to undump. The change might as well be included in all versions,
+because it handles repeated hyphenation exceptions in a more efficient way
+than the original code. I checked through trip.tex. There is only one word
+included in hyphenation exceptions, but it is given two different hyphenations.
+Thus the original trip.log states 2 hyphenation exceptions, while the one
+using simple hashing shows only 1 -- the single exception has been entered
+twice.
+
+[...]
+
+Wayne
+
diff --git a/Build/source/texk/web2c/triptrap/mftrap.diffs b/Build/source/texk/web2c/triptrap/mftrap.diffs
new file mode 100644
index 00000000000..b8051bcfb3a
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mftrap.diffs
@@ -0,0 +1,100 @@
+make[1]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c'
+cd lib && make -w CC='gcc' CFLAGS='-g ' LDFLAGS=''
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+make[2]: Nothing to be done for `default'.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' fixwrites
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `fixwrites' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' splitup
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `splitup' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' web2c
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `web2c' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+rm -f trap.mf trap.base
+rm -f mftrapin.fot mftrapin.log
+rm -f mftrap.fot mftrap.log mftrap.tfm
+rm -f mftrap.pl trap.72270gf trap.typ
+ln -s ./triptrap/trap.mf . # get same filename in log
+/bin/sh -c 'TEXMFCNF=./triptrap ./mf --progname=inimf <./triptrap/mftrap1.in >mftrapin.fot'
+mv trap.log mftrapin.log
+diff ./triptrap/mftrapin.log mftrapin.log
+1c1
+< This is METAFONT, Version 2.71828 (INIMF) 23 DEC 2002 11:57
+---
+> This is METAFONT, Version 2.71828 (Web2C 7.5.5) (INIMF) 3 AUG 2005 10:46
+150c150
+< String usage 26&83 (1895&21534 still untouched)
+---
+> String usage 30&98 (6387&79485 still untouched)
+176,177c176,177
+< (preloaded base=trap 98.8.8)
+< 1113 strings of total length 20515
+---
+> (base=trap 2005.8.3)
+> 1122 strings of total length 20565
+/bin/sh -c 'TEXMFCNF=./triptrap ./mf --progname=inimf <./triptrap/mftrap2.in >mftrap.fot'
+mv trap.log mftrap.log
+mv trap.tfm mftrap.tfm
+diff ./triptrap/mftrap.fot mftrap.fot
+1,3c1,2
+< This is METAFONT, Version 2.71828 (INIMF)
+< ** &trap trap
+< (trap.mf
+---
+> This is METAFONT, Version 2.71828 (Web2C 7.5.5) (INIMF)
+> **(trap.mf
+39c38
+< String usage 42&168 (1818&17726 still untouched)
+---
+> String usage 50&202 (6301&75642 still untouched)
+diff ./triptrap/mftrap.log mftrap.log
+1c1
+< This is METAFONT, Version 2.71828 (preloaded base=trap 2002.12.23) 23 DEC 2002 11:57
+---
+> This is METAFONT, Version 2.71828 (Web2C 7.5.5) (base=trap 2005.8.3) 3 AUG 2005 10:46
+1825c1825
+< String usage 24&92 (1863&21408 still untouched)
+---
+> String usage 30&119 (6347&79310 still untouched)
+2738c2738
+< Calling BLANKRECTANGLE(100,100,0,1)
+---
+> Calling BLANKRECTANGLE(1664,1664,0,1)
+4235c4235
+< String usage 42&168 (1818&17726 still untouched)
+---
+> String usage 50&202 (6301&75642 still untouched)
+4251,4252c4251,4252
+< 69 strings out of 1887
+< 3759 string characters out of 21485
+---
+> 77 strings out of 6378
+> 3793 string characters out of 79435
+4254,4255c4254,4255
+< 289 symbolic tokens out of 2100
+< 8i,43n,14r,8p,167b stack positions out of 30i,100n,300r,150p,500b
+---
+> 289 symbolic tokens out of 9500
+> 8i,43n,14r,8p,167b stack positions out of 300i,300n,1000r,150p,500b
+4263c4263
+< out of 256w,16h,16d,64i,5000l,500k,256e,50p)
+---
+> out of 256w,16h,16d,64i,15000l,2500k,256e,60p)
+./tftopl ./mftrap.tfm mftrap.pl
+diff ./triptrap/mftrap.pl mftrap.pl
+/bin/sh -c 'TEXMFCNF=./triptrap ./gftype -m -i ./trap.72270gf >trap.typ'
+diff ./triptrap/trap.typ trap.typ
+1c1
+< This is GFtype, Version 3.1
+---
+> This is GFtype, Version 3.1 (Web2C 7.5.5)
+3c3
+< ' METAFONT output 2002.12.23:1157'
+---
+> ' METAFONT output 2005.08.03:1046'
+make[1]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c'
diff --git a/Build/source/texk/web2c/triptrap/mftrap.fot b/Build/source/texk/web2c/triptrap/mftrap.fot
new file mode 100644
index 00000000000..c4eb700c4c7
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mftrap.fot
@@ -0,0 +1,59 @@
+This is METAFONT, Version 2.71828 (INIMF)
+** &trap trap
+(trap.mf
+\*//*\trap\pass2!
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+l.21 ...t next=\; delimiters ^~7
+ ! fi
+! Extra tokens will be flushed.
+<to be read again>
+ !
+l.21 ... next=\; delimiters ^~7!
+ fi
+! Forbidden token found while scanning to the end of the statement.
+<inserted text>
+ ;
+<to be read again>
+ \
+l.22 next\
+ ; % the second pass will now compute silently; the ...
+
+hello again^^_
+>> pen (see the transcript file)
+>> path (see the transcript file)
+>> path (see the transcript file)
+>> path (see the transcript file)
+f<expr>->let)=];let[=(;show._
+(EXPR0)<-xx
+{let}
+{let}
+{show}
+>> _1
+{showdependencies}
+xpart '=-ypart '-0.66667
+{qq:=pen}
+{showstats}
+Memory usage 1476&588 (104 still untouched)
+String usage 42&168 (1818&17726 still untouched)
+{[repeat the loop]}
+! A group begun on line 163 never ended.
+<to be read again>
+ endtext
+l.163 ... showstats; bye endtext
+
+{endgroup}
+ )
+(end occurred when else on line 93 was incomplete)
+(end occurred when if on line 36 was incomplete)
+(end occurred when elseif on line 21 was incomplete)
+(see the transcript file for additional information)
+(illegal design size has been changed to 128pt)
+(some chardp values had to be adjusted by as much as 0.5pt)
+(local label 0:: was missing)
+(local label 5:: was missing)
+(4 font metric dimensions had to be decreased)
+Font metrics written on trap.tfm.
+Output written on trap.72270gf (5 characters, 1028 bytes).
+Transcript written on trap.log.
diff --git a/Build/source/texk/web2c/triptrap/mftrap.log b/Build/source/texk/web2c/triptrap/mftrap.log
new file mode 100644
index 00000000000..23bf114c633
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mftrap.log
@@ -0,0 +1,4266 @@
+This is METAFONT, Version 2.71828 (preloaded base=trap 2002.12.23) 23 DEC 2002 11:57
+** &trap trap
+(trap.mf
+{if}
+{known(0)}
+{not(true)}
+{false}
+{known("")}
+{true}
+
+/*\`'@#->begingroup.message(SUFFIX1)&str(SUFFIX0)&jobname&char.ASCII'`&s
+tr(SUFFIX2)!endgroup
+(SUFFIX0)<-/*\
+(SUFFIX1)<-`'
+(SUFFIX2)<-pass2
+{begingroup}
+{message}
+
+`'->begingroup'`endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-`'
+{begingroup}
+
+'`->"\*/"
+{endgroup}
+{("\*/")&("/*\")}
+{jobname}
+{("\*//*\")&("trap")}
+
+'`->"\*/"
+{ASCII("\*/")}
+{char(92)}
+{("\*//*\trap")&("\")}
+{("\*//*\trap\")&("pass2!")}
+
+\*//*\trap\pass2!
+{endgroup}
+{outer}
+{let}
+{delimiters}
+
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+l.21 ...t next=\; delimiters ^~7
+ ! fi
+Sorry: You can't redefine a number, string, or expr.
+I've inserted an inaccessible symbol so that your
+definition will be completed without mixing me up too badly.
+
+! Extra tokens will be flushed.
+<to be read again>
+ !
+l.21 ... next=\; delimiters ^~7!
+ fi
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+! Forbidden token found while scanning to the end of the statement.
+<inserted text>
+ ;
+<to be read again>
+ \
+l.22 next\
+ ; % the second pass will now compute silently; the ...
+A previous error seems to have propagated,
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{\}
+{batchmode}
+
+! An expression can't begin with `endgroup'.
+<inserted text>
+ 0
+<to be read again>
+ endgroup
+l.23 batchmode; ^~7,endgroup
+ pausing:=1; exitif p exitif bool...
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+! Missing ` INACCESSIBLE' has been inserted.
+<to be read again>
+ endgroup
+l.23 batchmode; ^~7,endgroup
+ pausing:=1; exitif p exitif bool...
+I found no right delimiter to match a left one. So I've
+put one in, behind the scenes; this may fix the problem.
+
+! Extra `endgroup'.
+<recently read> endgroup
+
+l.23 batchmode; ^~7,endgroup
+ pausing:=1; exitif p exitif bool...
+I'm not currently working on a `begingroup',
+so I had better not try to end anything.
+
+{pausing:=1}
+{exitif}
+{exitif}
+{pencircle}
+{endfor}
+! Extra `endfor'.
+l.23 ...ean pen pencircle endfor
+
+I'm not currently working on a for loop,
+so I had better not try to end anything.
+
+{scantokens}
+{begingroup}
+{message}
+{char(0)}
+{("^^@")&("watch this")}
+^^@watch this
+{-(1)}
+{char(-1)}
+{("pair p[],';")&("^^ff")}
+{endgroup}
+{pen(future pen)}
+{boolean(true)}
+{true}
+! No loop is in progress.
+<to be read again>
+ pair
+<scantokens> pair
+ p[],';^^ff
+<to be read again>
+ path
+l.25 path
+ p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(...
+Why say `exitif' when there's nothing to exit from?
+
+>> p
+! Undefined condition will be treated as `false'.
+<to be read again>
+ pair
+<scantokens> pair
+ p[],';^^ff
+<to be read again>
+ path
+l.25 path
+ p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(...
+The expression shown above should have had a definite
+true-or-false value. I'm changing it to `false'.
+
+{false}
+! Missing `;' has been inserted.
+<to be read again>
+ pair
+<scantokens> pair
+ p[],';^^ff
+<to be read again>
+ path
+l.25 path
+ p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(...
+After `exitif <boolean exp>' I expect to see a semicolon.
+I shall pretend that one was there.
+
+{pair}
+! Text line contains an invalid character.
+<scantokens> pair p[],';^^ff
+
+<to be read again>
+ path
+l.25 path
+ p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(...
+A funny symbol that I can't read has just been input.
+Continue, and I'll forget that it ever happened.
+
+{path}
+{-(2)}
+{-(1)}
+{turningnumber((xpart ',ypart '))}
+Path at line 25, before choices:
+(1,-2){curl 1}
+ ..(2,-1)
+ ..(2.5,0.5)
+ ..(1,2)
+ ..{curl 1}(0,2.5)
+
+Path at line 25, after choices:
+(1,-2)..controls (1.37755,-1.71404) and (1.71404,-1.37755)
+ ..(2,-1)..controls (2.33353,-0.55965) and (2.59729,-0.04124)
+ ..(2.5,0.5)..controls (2.36812,1.23369) and (1.6712,1.65662)
+ ..(1,2)..controls (0.66821,2.16974) and (0.33485,2.33641)
+ ..(0,2.5)
+
+{(unknown path qw)=(path)}
+{numeric}
+! Enormous number has been reduced.
+l.26 ...[$] ]]=10000000000000000
+ ; "this string constant is in...
+I can't handle numbers bigger than about 4095.99998;
+so I've changed your constant to that maximum amount.
+
+{(p[[ [-1] ]])=(4095.99998)}
+## p[[ [-1] ]]=4095.99998
+! Incomplete string token has been flushed.
+l.26 ...g constant is incomplete
+
+Strings should finish on the same line as they began.
+I've deleted the partial string; you might want to
+insert another by typing, e.g., `I"new string"'.
+
+{string}
+! Declared variable conflicts with previous vardef.
+<to be read again>
+ ,
+l.27 string foo[]p,
+ p~if true:[]; p~000=char34&char200&char34;
+You can't use, e.g., `numeric foo[]' after `vardef foo'.
+Proceed, and I'll ignore the illegal redeclaration.
+
+{if}
+{true}
+{true}
+{char(34)}
+{char(200)}
+{(""")&("^^c8")}
+{char(34)}
+{(""^^c8")&(""")}
+{(unknown string p~0)=(""^^c8"")}
+{boolean}
+{fi}
+{showvariable}
+boolean.boolean=unknown boolean
+! OK.
+l.28 ...n; showvariable boolean;
+ def\\= =end enddef;
+
+{def}
+{picture}
+{show}
+{scantokens}
+{length("^^c8")}
+>> 1
+! OK.
+<recently read> ;
+
+l.29 ...w length scantokens p~0;
+
+
+{pen}
+! Illegal suffix of declared variable will be flushed.
+<to be read again>
+ [
+<to be read again>
+ "a"
+l.30 pen p~[]~,q["a"
+ ,qq; p~1~=q=pencircle scaled mexp(-3016.5...
+Variables in declarations must consist entirely of
+names and collective subscripts, e.g., `x[]a'.
+Are you trying to use a reserved word in a variable name?
+I'm going to discard the junk I found here,
+up to the next comma or the end of the declaration.
+
+{pencircle}
+{-(3016.57654)}
+{mexp(-3016.57654)}
+{(future pen)scaled(0)}
+Pen polygon at line 30 (newly created):
+(0.5,0)
+ .. (0,0.5)
+ .. (-0.5,0)
+ .. (0,-0.5)
+ .. cycle
+
+{(unknown pen q)=(pen)}
+{(unknown pen p~1~)=(pen)}
+{transform}
+! Illegal suffix of declared variable will be flushed.
+<to be read again>
+ 0
+l.31 transform p,pp0
+ ; if p=p:qq=makepen((1,0)..cycle) xscaled...
+Variables in declarations must consist entirely of
+names and collective subscripts, e.g., `x[]a'.
+Explicit subscripts like `x15a' aren't permitted.
+I'm going to discard the junk I found here,
+up to the next comma or the end of the declaration.
+
+{if}
+{((xpart p,ypart p,xxpart p,xypart p,yxpart p,yypart p))=((xpart p,ypart
+ p,xxpart p,xypart p,yxpart p,yypart p))}
+{true}
+Path at line 31, before choices:
+(1,0)
+ ..cycle
+
+Path at line 31, after choices:
+(1,0)..controls (1,0) and (1,0)
+ ..cycle
+
+{makepen(path)}
+{hex("1000")}
+! Number too large (4096).
+<to be read again>
+ ;
+l.31 ...cle) xscaled hex "1000";
+ fi
+I have trouble with numbers greater than 4095; watch out.
+
+{(future pen)xscaled(4096)}
+! Pen too large.
+<to be read again>
+ ;
+l.31 ...cle) xscaled hex "1000";
+ fi
+The cycle you specified has a coordinate of 4095.5 or more.
+So I've replaced it by the trivial path `(0,0)..cycle'.
+
+Pen polygon at line 31 (newly created):
+(0,0)
+ .. cycle
+
+{(unknown pen qq)=(pen)}
+{fi}
+Path at line 32, before choices:
+(0,0)
+ ..(1,0)
+ ..(0,1)
+ ..(0,0)
+ ..(1,0)
+ ..(0,1)
+ ..cycle
+
+Path at line 32, after choices:
+(0,0)..controls (0.29056,-0.29056) and (0.75859,-0.30772)
+ ..(1,0)..controls (1.51964,0.66237) and (0.66237,1.51964)
+ ..(0,1)..controls (-0.30772,0.75859) and (-0.29056,0.29056)
+ ..(0,0)..controls (0.29056,-0.29056) and (0.75859,-0.30772)
+ ..(1,0)..controls (1.51964,0.66237) and (0.66237,1.51964)
+ ..(0,1)..controls (-0.30772,0.75859) and (-0.29056,0.29056)
+ ..cycle
+
+{makepen(path)}
+! Pen cycle must be convex.
+<to be read again>
+ ;
+l.32 ...)..(1,0)..(0,1)..cycle);
+
+The cycle you specified either has consecutive equal points
+or turns right or turns through more than 360 degrees.
+So I've replaced it by the trivial path `(0,0)..cycle'.
+
+Pen polygon at line 32 (newly created):
+(0,0)
+ .. cycle
+
+{qq:=pen}
+{vardef}
+! Missing parameter type; `expr' will be assumed.
+<to be read again>
+ )
+l.33 ...ext suffix a,b endtext()
+ )suffix@=show #@; p.a.b() end...
+You should've had `expr' or `suffix' or `text' here.
+
+{expandafter}
+{\}
+{let}
+
+\\->=end
+{outer}
+{pencircle}
+{(future pen)scaled(4.5)}
+{(future pen)yscaled(2)}
+Pen polygon at line 34 (newly created):
+(0.5,-4.5)
+ .. (1,-4)
+ .. (2,-2.5)
+ .. (2.5,0)
+ .. (2,2.5)
+ .. (1,4)
+ .. (0.5,4.5)
+ .. (-0.5,4.5)
+ .. (-1,4)
+ .. (-2,2.5)
+ .. (-2.5,0)
+ .. (-2,-2.5)
+ .. (-1,-4)
+ .. (-0.5,-4.5)
+ .. cycle
+
+{qq:=pen}
+{((6,12))-((xpart p7,ypart p7))}
+{((0,1))transformed((xpart p,ypart p,xxpart p,xypart p,yxpart p,yypart p
+))}
+{(x)-(x)}
+{(2)/(0)}
+>> 2
+! Division by zero.
+<to be read again>
+ ,
+l.35 ...)transformed p=(2/(x-x),
+ 3/0)transformed p;
+You're trying to divide the quantity shown above the error
+message by zero. I'm going to divide it by one instead.
+
+! Division by zero.
+l.35 ...ansformed p=(2/(x-x),3/0
+ )transformed p;
+I'll pretend that you meant to divide by 1.
+
+{((2,3))transformed((xpart p,ypart p,xxpart p,xypart p,yxpart p,yypart p
+))}
+{((linearform,linearform))=((linearform,linearform))}
+## yxpart p=-yypart p
+## xxpart p=-xypart p
+{((-xpart p7+6,-ypart p7+12))=((linearform,linearform))}
+## ypart p7=-ypart p-yypart p+12
+## xpart p7=-xpart p-xypart p+6
+{\}
+{if}
+{string(unknown string p~[-1])}
+{true}
+{(p0.1 0.2)-(p0.1 0.2)}
+! The token `endtext' is no longer a right delimiter.
+l.36 ...1.2-p.1.199999,1 endtext
+ transformed p;
+Strange: This token has lost its former meaning!
+I'll read it as a right delimiter this time;
+but watch out, I'll probably miss it later.
+
+{((0,1))transformed((xpart p,ypart p,-xypart p,xypart p,-yypart p,yypart
+ p))}
+{((linearform,linearform))=((linearform,linearform))}
+## ypart p=-yypart p+6
+#### ypart p7=6
+## xpart p=-xypart p+3
+#### xpart p7=3
+{(unknown path p1 2p)=((3,6))}
+{showstopping:=0}
+{showvariable}
+p=(-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p)
+p[]=pair
+p[][]=numeric
+p[][]p=unknown path
+p[][]p~=macro:(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup ETC.
+p[]~=unknown boolean
+p~=path
+p~[]=unknown string
+p~[]~=unknown pen
+p~[]~[][]=unknown picture
+p~[-1]=unknown string p~[-1]
+p~0=""^^c8""
+p~1~=pen
+p[[ [] ]]=numeric
+p[[ [-1] ]]=4095.99998
+p0.1 0.2=p0.1 0.2
+p1 2p=path
+p7=(3,6)
+{((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))=((-xy
+part p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))}
+{let}
+{let}
+{xxpart((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))
+}
+{(-xypart p)+(0.002)}
+{yxpart((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))
+}
+{((xpart p2,ypart p2))-((xpart p1,ypart p1))}
+{(1)*((linearform,linearform))}
+{((xpart p1,ypart p1))+((linearform,linearform))}
+{(y)+(0.00002)}
+{yypart((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))
+}
+{xypart((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))
+}
+{((5,y))=((yypart p,xypart p))}
+## y=xypart p
+## yypart p=5
+#### ypart p=1
+#### yxpart p=-5
+{((5,xypart p+0.00002))=((5,xypart p))}
+{((xpart p2,ypart p2))=((5,xypart p))}
+## ypart p2=xypart p
+## xpart p2=5
+{((-xypart p+0.002,-5))=((5,xypart p))}
+## xypart p=-5
+#### ypart p2=-5
+#### y=-5
+#### xpart p=8
+#### xxpart p=5
+! Inconsistent equation (off by -0.002).
+<to be read again>
+ ;
+l.38 ...,y)=(yypart p,xypart p);
+
+The equation I just read contradicts what was said before.
+But don't worry; continue and I'll just ignore it.
+
+Path at line 39, before choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+ ..cycle
+
+Path at line 39, after choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)..controls (17.52783,8.54388) and (-15.45978,-4.12262)
+ ..cycle
+
+{reverse(path)}
+{(path)transformed((8,1,5,-5,-5,5))}
+{(path)=(unknown path p2 3p)}
+
+p1 2p~(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup.show(SUFFIX0);p(SUFF
+IX2)(SUFFIX3)((EXPR4)endgroup
+(SUFFIX0)<-p1 2p
+(SUFFIX1)<-~
+(SUFFIX2)<-
+(SUFFIX3)<-2 3p~
+! A primary expression can't begin with `right delimiter that matches ('
+.
+<inserted text>
+ 0
+<to be read again>
+ )
+l.40 ...000000001]2p~(,[2]3p~,-)
+ =p~1~2[pausing];
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+{-(0)}
+(EXPR4)<-0
+(SUFFIX5)<-
+{begingroup}
+{show}
+>> Path at line 40:
+(3,6)
+
+
+p2 3p~(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup.show(SUFFIX0);p(SUFF
+IX2)(SUFFIX3)((EXPR4)endgroup
+(SUFFIX0)<-p2 3p
+(SUFFIX1)<-~
+! Missing `,' has been inserted.
+<to be read again>
+ (0)
+p1 2p~->...IX2)(SUFFIX3)((EXPR4)
+ endgroup
+<to be read again>
+ =
+l.40 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I've finished reading a macro argument and am about to
+read another; the arguments weren't delimited correctly.
+You might want to delete some tokens before continuing.
+
+(SUFFIX2)<-
+! Missing `,' has been inserted.
+<to be read again>
+ (0)
+p1 2p~->...IX2)(SUFFIX3)((EXPR4)
+ endgroup
+<to be read again>
+ =
+l.40 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I've finished reading a macro argument and am about to
+read another; the arguments weren't delimited correctly.
+You might want to delete some tokens before continuing.
+
+(SUFFIX3)<-
+! Missing `)' has been inserted.
+<to be read again>
+ endgroup
+<to be read again>
+ =
+l.40 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I've gotten to the end of the macro parameter list.
+You might want to delete some tokens before continuing.
+
+(EXPR4)<-0
+(SUFFIX5)<-
+{begingroup}
+{show}
+>> Path at line 40:
+(8,1)..controls (-48.68579,57.68579) and (52.91974,-43.91974)
+ ..(28,-19)..controls (-7,16) and (63,-54)
+ ..cycle
+
+>> (8,1,5,-5,-5,5)
+! Isolated expression.
+<to be read again>
+ (
+p2 3p~->...;p(SUFFIX2)(SUFFIX3)(
+ (EXPR4)endgroup
+<to be read again>
+ endgroup
+<to be read again>
+ =
+l.40 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I couldn't find an `=' or `:=' after the
+expression that is shown above this error message,
+so I guess I'll just ignore it and carry on.
+
+! Extra tokens will be flushed.
+<to be read again>
+ (
+p2 3p~->...;p(SUFFIX2)(SUFFIX3)(
+ (EXPR4)endgroup
+<to be read again>
+ endgroup
+<to be read again>
+ =
+l.40 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+{endgroup}
+{endgroup}
+{(vacuous)=(unknown picture p~1~2 1)}
+>> vacuous
+>> unknown picture p~1~2 1
+! Equation cannot be performed (vacuous=unknown picture).
+<to be read again>
+ ;
+l.40 ...2]3p~,-)=p~1~2[pausing];
+
+I'm sorry, but I don't know how to make such things equal.
+(See the two expressions just above the error message.)
+
+{vardef}
+Runaway definition?
+if.p(SUFFIX1)(SUFFIX1)=(SUFFIX1)(SUFFIX1)p.fi
+! Forbidden token found while scanning the definition of p~[].
+<inserted text>
+ enddef
+<to be read again>
+ ;
+l.41 ...iary t:=if p@ @=@ @p fi;
+ vardef p[][]p~[]=BAD; inner ;;
+I suspect you have forgotten an `enddef',
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{vardef}
+! This variable already starts with a macro.
+l.41 ...@p fi; vardef p[][]p~[]=
+ BAD; inner ;;
+After `vardef a' you can't say `vardef a.b'.
+So I'll have to discard this definition.
+
+Runaway definition?
+BAD
+! Forbidden token found while scanning the definition of a bad variable.
+<inserted text>
+ enddef
+<to be read again>
+ ;
+l.41 ...i; vardef p[][]p~[]=BAD;
+ inner ;;
+I suspect you have forgotten an `enddef',
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{inner}
+{show}
+{-(2)}
+
+p~[-2]@#<tertiary>->begingroup.if.p(SUFFIX1)(SUFFIX1)=(SUFFIX1)(SUFFIX1)
+p.fi.endgroup
+(SUFFIX0)<-p~
+(SUFFIX1)<-[-2]
+(SUFFIX2)<-~
+! A tertiary expression can't begin with `['.
+<inserted text>
+ 0
+<to be read again>
+ [
+<to be read again>
+ (3000)
+<to be read again>
+ ,
+l.42 show p~[-2]~[3000,
+ x]++4000>path p3; showvariable p,P;
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+{(x)-(3000)}
+{(0)*(x-3000)}
+{(3000)+(0)}
+{(3000)++(4000)}
+(EXPR3)<-4999.99998
+{begingroup}
+{if}
+{(p[-2][-2])=(-2)}
+>> p[-2][-2]+2
+! Unknown relation will be considered false.
+<to be read again>
+ [-2]
+p~[-2]->...1)=(SUFFIX1)(SUFFIX1)
+ p.fi.endgroup
+<to be read again>
+ >
+l.42 show p~[-2]~[3000,x]++4000>
+ path p3; showvariable p,P;
+Oh dear. I can't decide if the expression above is positive,
+negative, or zero. So this comparison test won't be `true'.
+
+{false}
+! Missing `:' has been inserted.
+<to be read again>
+ [-2]
+p~[-2]->...1)=(SUFFIX1)(SUFFIX1)
+ p.fi.endgroup
+<to be read again>
+ >
+l.42 show p~[-2]~[3000,x]++4000>
+ path p3; showvariable p,P;
+There should've been a colon after the condition.
+I shall pretend that one was there.
+
+{endgroup}
+{path((xpart p3,ypart p3))}
+{(vacuous)>(false)}
+>> vacuous
+>> false
+! Not implemented: (vacuous)>(boolean).
+<to be read again>
+ ;
+l.42 ...~[3000,x]++4000>path p3;
+ showvariable p,P;
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+>> false
+{showvariable}
+p=(8,1,5,-5,-5,5)
+p[]=pair
+p[][]=numeric
+p[][]p=unknown path
+p[][]p~=macro:(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup ETC.
+p[]~=unknown boolean
+p~=path
+p~[]@#=macro:<tertiary>->begingroup.if.p(SUFFIX1)(SUFFIX1) ETC.
+p[[ [] ]]=numeric
+p[[ [-1] ]]=4095.99998
+p[-2][-2]=p[-2][-2]
+p0.1 0.2=p0.1 0.2
+p1=(xpart p1,ypart p1)
+p1 2p=path
+p2=(5,-5)
+p2 3p=path
+p3=(xpart p3,ypart p3)
+p7=(3,6)
+> P=tag
+{numeric}
+{(2)*(alpha)}
+{(p3~)=(2alpha)}
+## alpha=0.5p3~
+{(1)/(-1)}
+{(3)*(beta)}
+{(p[-1]~)=(3beta)}
+## beta=0.33333p[-1]~
+{begingroup}
+{save}
+{showvariable}
+> p=tag
+{(3)*(0.33333(SAVED)p[-1]~)}
+{((SAVED)p[-1]~)=(1)}
+## (SAVED)p[-1]~=1
+#### beta=0.33333
+{restoring p}
+{endgroup}
+{showvariable}
+p=(8,1,5,-5,-5,5)
+p[]=pair
+p[][]=numeric
+p[][]p=unknown path
+p[][]p~=macro:(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup ETC.
+p[]~=numeric
+p~=path
+p~[]@#=macro:<tertiary>->begingroup.if.p(SUFFIX1)(SUFFIX1) ETC.
+p[[ [] ]]=numeric
+p[[ [-1] ]]=4095.99998
+p[-2][-2]=p[-2][-2]
+p[-1]~=1
+p0.1 0.2=p0.1 0.2
+p1=(xpart p1,ypart p1)
+p1 2p=path
+p2=(5,-5)
+p2 3p=path
+p3=(xpart p3,ypart p3)
+p3~=p3~
+p7=(3,6)
+{def}
+{def}
+! Missing `=' has been inserted.
+<to be read again>
+ false
+l.45 ...enddef;def!primary!false
+ ):!fi enddef;
+The next thing in this `def' should have been `=',
+because I've already looked at the definition heading.
+But don't worry; I'll pretend that an equals sign
+was present. Everything from here to `enddef'
+will be the replacement text of this macro.
+
+{def}
+{(path)scaled(-1)}
+Path at line 46, before choices:
+(1,-2)..controls (1.37755,-1.71404) and (1.71404,-1.37755)
+ ..(2,-1)..controls (2.33353,-0.55965) and (2.59729,-0.04124)
+ ..(2.5,0.5)..controls (2.36812,1.23369) and (1.6712,1.65662)
+ ..(1,2)..controls (0.66821,2.16974) and (0.33485,2.33641)
+ ..(0,2.5)
+ ..(-1,2)..controls (-1.37755,1.71404) and (-1.71404,1.37755)
+ ..(-2,1)..controls (-2.33353,0.55965) and (-2.59729,0.04124)
+ ..(-2.5,-0.5)..controls (-2.36812,-1.23369) and (-1.6712,-1.65662)
+ ..(-1,-2)..controls (-0.66821,-2.16974) and (-0.33485,-2.33641)
+ ..(0,-2.5)
+ ..cycle
+
+Path at line 46, after choices:
+(1,-2)..controls (1.37755,-1.71404) and (1.71404,-1.37755)
+ ..(2,-1)..controls (2.33353,-0.55965) and (2.59729,-0.04124)
+ ..(2.5,0.5)..controls (2.36812,1.23369) and (1.6712,1.65662)
+ ..(1,2)..controls (0.66821,2.16974) and (0.33485,2.33641)
+ ..(0,2.5)..controls (-0.37186,2.68167) and (-0.668,2.25146)
+ ..(-1,2)..controls (-1.37755,1.71404) and (-1.71404,1.37755)
+ ..(-2,1)..controls (-2.33353,0.55965) and (-2.59729,0.04124)
+ ..(-2.5,-0.5)..controls (-2.36812,-1.23369) and (-1.6712,-1.65662)
+ ..(-1,-2)..controls (-0.66821,-2.16974) and (-0.33485,-2.33641)
+ ..(0,-2.5)..controls (0.37186,-2.68167) and (0.668,-2.25146)
+ ..cycle
+
+{makepen(path)}
+Pen polygon at line 46 (newly created):
+(1,-2)
+ .. (2,-1)
+ .. (2.5,0.5)
+ .. (1,2)
+ .. (0,2.5)
+ .. (-1,2)
+ .. (-2,1)
+ .. (-2.5,-0.5)
+ .. (-1,-2)
+ .. (0,-2.5)
+ .. cycle
+
+{qq:=pen}
+{primarydef}
+{secondarydef}
+
+//<expr>->
+
+//<expr>->
+{pencircle}
+{length(path)}
+{(future pen)slanted(1)}
+{((3,6))-((5,-5))}
+
+_aa__<secondary>->if(true
+{(0.1)*(15)}
+{odd(1.50009)}
+{not(false)}
+{known((8,1,5,-5,-5,5))}
+{(true)and(true)}
+(EXPR0)<-true
+{if}
+{true}
+
+!<primary>->false):(EXPR0)fi
+(EXPR0)<-(5,-5)
+{false}
+{(true)or(false)}
+{true}
+{fi}
+{-((5,-5))}
+{-((5,-5))}
+{+(1)}
+{-(1)}
+>> -1
+! Improper curl has been replaced by 1.
+<to be read again>
+ )
+l.51 {curl- +1)
+ ..tension atleast1..cycle sqrt2++sqrt2***[[]];
+A curl must be a known, nonnegative number.
+
+! Missing `}' has been inserted.
+<to be read again>
+ )
+l.51 {curl- +1)
+ ..tension atleast1..cycle sqrt2++sqrt2***[[]];
+I've scanned a direction spec for part of a path,
+so a right brace should have come next.
+I shall pretend that one was there.
+
+Path at line 51, before choices:
+(-5,5)
+
+Path at line 51, after choices:
+(-5,5)
+
+Path at line 51, before choices:
+(3,6)..controls (5,-5) and (-5,5)
+ ..(-5,5)..tension atleast1
+ ..{2896.30943,-2896.30934}cycle
+
+Path at line 51, after choices:
+(3,6)..controls (5,-5) and (-5,5)
+ ..(-5,5)..controls (-3.29726,7.86205) and (0.64516,8.35484)
+ ..cycle
+
+! Missing `)' has been inserted.
+<to be read again>
+ sqrt
+l.51 ...ion atleast1..cycle sqrt
+ 2++sqrt2***[[]];
+I found no right delimiter to match a left one. So I've
+put one in, behind the scenes; this may fix the problem.
+
+{((-2,11))subpath(path)}
+{reverse(path)}
+{makepen(path)}
+
+**->[[show(EXPR0)*(EXPR1)]]
+(EXPR0)<-future pen
+(EXPR1)<-future pen
+{begingroup}
+{show}
+{(future pen)*(future pen)}
+>> future pen
+>> future pen
+! Not implemented: (future pen)*(future pen).
+<to be read again>
+ ]]
+<to be read again>
+ sqrt
+l.51 ...ion atleast1..cycle sqrt
+ 2++sqrt2***[[]];
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+! Pen path must be a cycle.
+<to be read again>
+ ]]
+<to be read again>
+ sqrt
+l.51 ...ion atleast1..cycle sqrt
+ 2++sqrt2***[[]];
+I can't make a pen from the given path.
+So I've replaced it by the trivial path `(0,0)..cycle'.
+
+>> Pen polygon at line 51:
+(0,0)
+ .. cycle
+
+{endgroup}
+(EXPR0)<-vacuous
+{sqrt(2)}
+{sqrt(2)}
+{(1.41422)++(1.41422)}
+{begingroup}
+{endgroup}
+
+***->expandafter(EXPR1)scantokens"**oct"(EXPR0)
+(EXPR0)<-2
+(EXPR1)<-vacuous
+{expandafter}
+{scantokens}
+{oct(2)}
+>> 2
+! Not implemented: oct(known numeric).
+<to be read again>
+ ;
+l.51 ...cle sqrt2++sqrt2***[[]];
+
+I'm afraid I don't know how to apply that operation to that
+particular type. Continue, and I'll simply return the
+argument (shown above) as the result of the operation.
+
+
+**->[[show(EXPR0)*(EXPR1)]]
+(EXPR0)<-vacuous
+(EXPR1)<-2
+{begingroup}
+{show}
+{(vacuous)*(2)}
+>> vacuous
+>> 2
+! Not implemented: (vacuous)*(known numeric).
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.51 ...cle sqrt2++sqrt2***[[]];
+
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+>> 2
+{endgroup}
+(EXPR0)<-vacuous
+{begingroup}
+{interim}
+{-(20.5)}
+{charcode:=-20.5}
+{proofing:=-20.5}
+{-(2048)}
+{chardp:=-2048}
+{shipout}
+{nullpicture}
+! Enormous chardp has been reduced.
+<to be read again>
+ ]]
+l.52 ...48;shipout nullpicture]]
+ ;
+Font metric dimensions must be less than 2048pt.
+
+{restoring proofing=0}
+{endgroup}
+{if}
+{-(275.50002)}
+{charexists(-275.50002)}
+{known(unknown path p0 0p)}
+{(true)>(false)}
+{known(path)}
+{(true)=(true)}
+{true}
+{randomseed}
+! Missing `:=' has been inserted.
+<to be read again>
+ charcode
+l.53 ... p~: randomseed charcode
+ ; fi
+Always say `randomseed:=<numeric expression>'.
+
+{randomseed:=-20.5}
+{fi}
+{randomseed}
+>> "goof"
+! Unknown value will be ignored.
+<to be read again>
+ ;
+l.54 randomseed:="goof";
+ a[($,18++1+-+18),(2,3)]=b[(3,2),(1,$);
+Your expression was too random for me to handle,
+so I won't change the random seed just now.
+
+{(18)++(1)}
+{(18.02776)+-+(18)}
+{((2,3))-((-1,1))}
+{(a)*((3,2))}
+{((-1,1))+((3a,2a))}
+! Missing `]' has been inserted.
+<to be read again>
+ ;
+l.54 ...8),(2,3)]=b[(3,2),(1,$);
+
+I've scanned an expression of the form `a[b,c',
+so a right bracket should have come next.
+I shall pretend that one was there.
+
+{((1,-1))-((3,2))}
+{(b)*((-2,-3))}
+{((3,2))+((-2b,-3b))}
+{((3a-1,2a+1))=((-2b+3,-3b+2))}
+## b=-0.66667a+0.33333
+## a=2
+#### b=-1
+{show}
+{(^)+(1)}
+{(~)+(2)}
+{-(1)}
+{((^+1,~+2))slanted(-1)}
+{-(2)}
+{((linearform,~+2))yscaled(-2)}
+{-((3,4))}
+{((linearform,-2~-4))zscaled((-3,-4))}
+>> (-5~-3^-13,10~-4^+16)
+{((xpart pp,ypart pp,xxpart pp,xypart pp,yxpart pp,yypart pp))xscaled(9)
+}
+{((8,1,5,-5,-5,5))transformed((9xpart pp,ypart pp,9xxpart pp,9xypart pp,
+yxpart pp,yypart pp))}
+>> (9xpart pp+72xxpart pp+9xypart pp,ypart pp+8yxpart pp+yypart pp,45xxp
+art pp-45xypart pp,-45xxpart pp+45xypart pp,5yxpart pp-5yypart pp,-5yxpa
+rt pp+5yypart pp)
+{((xpart pp,ypart pp,xxpart pp,xypart pp,yxpart pp,yypart pp))shifted((1
+,2))}
+{((8,1,5,-5,-5,5))transformed((8,1,5,-5,-5,5))}
+{((xpart pp+1,ypart pp+2,xxpart pp,xypart pp,yxpart pp,yypart pp))transf
+ormed((43,-34,50,-50,-50,50))}
+>> (50xpart pp-50ypart pp-7,-50xpart pp+50ypart pp+16,50xxpart pp-50yxpa
+rt pp,50xypart pp-50yypart pp,-50xxpart pp+50yxpart pp,-50xypart pp+50yy
+part pp)
+{(2)-(1)}
+{(_0)*(1)}
+{(1)+(_0)}
+{-(_0+1)}
+>> -_0-1
+{show}
+{normaldeviate}
+{-(-2048)}
+{uniformdeviate(2048)}
+{angle((-0.41438,761.67789))}
+{cosd(90.03117)}
+{(200)*(-0.00055)}
+{mexp(-0.10986)}
+{sqrt(0.99957)}
+{mlog(0.99979)}
+{sind(-0.05469)}
+{floor(-0.00096)}
+>> -1
+{string}
+{(unknown string s2)=(unknown string s4)}
+{(unknown string s1)=(unknown string s2)}
+{(unknown string s3)=(unknown string s5)}
+{(unknown string s2)=(unknown string s4)}
+! Redundant equation.
+<to be read again>
+ ;
+l.58 ... s1=s2=s4; s3=s5; s1=s2;
+ if s1<=s4<>(s1<>s3):show[[ch...
+I already knew that this equation was true.
+But perhaps no harm has been done; let's continue.
+
+{if}
+{(unknown string s2)<=(unknown string s1)}
+{(unknown string s2)<>(unknown string s5)}
+>> unknown string s2
+>> unknown string s5
+! Unknown relation will be considered false.
+<to be read again>
+ )
+l.58 ...=s2; if s1<=s4<>(s1<>s3)
+ :show[[char34=s2:=s3]]fi;
+The quantities shown above have not been equated.
+
+{(true)<>(false)}
+{true}
+{show}
+{begingroup}
+{char(34)}
+{s2:=unknown string s5}
+{(""")=(unknown string s2)}
+{endgroup}
+{fi}
+>> vacuous
+{(0.1)point(path)}
+{begingroup}
+{pencircle}
+Pen polygon at line 59 (newly created):
+(0.5,0)
+ .. (0,0.5)
+ .. (-0.5,0)
+ .. (0,-0.5)
+ .. cycle
+
+{endgroup}
+{((3.24413,0.64801))penoffset(pen)}
+{((0,-0.5))rotated(540)}
+{((0,0.5))/(0.33333)}
+{-(1.5)}
+! Paths don't touch; `&' will be changed to `..'.
+<to be read again>
+ )
+l.60 ...tcontrol-1.5of(p~&cycle)
+ -precontrol1/2of p~(p~)=s1:=s...
+When you join paths `p&q', the ending point of p
+must be exactly equal to the starting point of q.
+So I'm going to pretend that you said `p..q' instead.
+
+Path at line 60, before choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+ ..cycle
+
+Path at line 60, after choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)..controls (17.52783,8.54388) and (-15.45978,-4.12262)
+ ..cycle
+
+{(-1.5)postcontrol(path)}
+{(0.5)precontrol(path)}
+{((-2.75,-5))-((3.75,-1))}
+! Missing `of' has been inserted for directiontime.
+<to be read again>
+ (
+l.60 ...cle)-precontrol1/2of p~(
+ p~)=s1:=s4:=s4;
+I've got the first argument; will look now for the other.
+
+{((-6.5,-4))directiontime(path)}
+{decimal(0.5)}
+{((0,1.50003))substring("0.5")}
+{s4:=unknown string s1}
+{s1:=unknown string s4}
+{("0.")=(unknown string s1)}
+{path}
+{length(" ")}
+! Missing `,' has been inserted.
+<to be read again>
+ }
+l.61 ...p~[]; p~1=p2{length" "}
+ &cycle; p~1=p2=p~0; p2..contr...
+I've got the x coordinate of a path direction;
+will look for the y coordinate next.
+
+! An expression can't begin with `}'.
+<inserted text>
+ 0
+<to be read again>
+ }
+l.61 ...p~[]; p~1=p2{length" "}
+ &cycle; p~1=p2=p~0; p2..contr...
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+Path at line 61, before choices:
+(5,-5){4096,0}
+ ..{4096,0}cycle
+
+Path at line 61, after choices:
+(5,-5)..controls (5,-5) and (5,-5)
+ ..cycle
+
+{(unknown path p~1)=(path)}
+{((5,-5))=(unknown path p~0)}
+{(path)=(path)}
+! Redundant or inconsistent equation.
+<to be read again>
+ ;
+l.61 ..." "}&cycle; p~1=p2=p~0;
+ p2..controls-p2..cycle=p~2;(p7
+An equation between already-known quantities can't help.
+But don't worry; continue and I'll just ignore it.
+
+{-((5,-5))}
+Path at line 61, before choices:
+(5,-5)..controls (-5,5) and (-5,5)
+ ..cycle
+
+Path at line 61, after choices:
+(5,-5)..controls (-5,5) and (-5,5)
+ ..cycle
+
+{(path)=(unknown path p~2)}
+{length(path)}
+Path at line 62, before choices:
+(3,6)..tension 1.2
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)
+ ..(5,-5)..controls (-5,5) and (-5,5)
+ ..(5,-5){0,4096}..tension 1 and atleast1
+ ..cycle
+
+Path at line 62, after choices:
+(3,6)..controls (-3.01212,4.82085) and (-1.0424,-6.01257)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (-5,5) and (-5,5)
+ ..(5,-5)..controls (5,0.02791) and (4.99951,6.39217)
+ ..cycle
+
+>> x
+! Improper tension has been set to 1.
+<to be read again>
+ ..
+l.63 x..
+ {curl1}-p7{curl hex "IsBad"}..tension.75and.74999..p...
+The expression above should have been a number >=3/4.
+
+{-((3,6))}
+{hex("IsBad")}
+>> "IsBad"
+! String contains illegal digits.
+<to be read again>
+ }
+l.63 ...l1}-p7{curl hex "IsBad"}
+ ..tension.75and.74999..p2{0,1...
+I zeroed out characters that weren't hex digits.
+
+>> 0.74998
+! Improper tension has been set to 1.
+<to be read again>
+ ..
+l.63 ...}..tension.75and.74999..
+ p2{0,1}&p2{_,'}..cycle:=p
+The expression above should have been a number >=3/4.
+
+>> _
+! Undefined x coordinate has been replaced by 0.
+<to be read again>
+ ,
+l.63 ...and.74999..p2{0,1}&p2{_,
+ '}..cycle:=p
+I need a `known' x value for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+>> (xpart ',ypart ')
+! Undefined y coordinate has been replaced by 0.
+<to be read again>
+ }
+l.63 ...d.74999..p2{0,1}&p2{_,'}
+ ..cycle:=p
+I need a `known' y value for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+Path at line 63, before choices:
+(3,6)..controls (-3.01212,4.82085) and (-1.0424,-6.01257)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (-5,5) and (-5,5)
+ ..(5,-5)..controls (5,0.02791) and (4.99951,6.39217)
+ ..(3,6)
+ ..{curl 1}(-3,-6){curl 2989}..tension 0.75 and 1
+ ..{0,4096}(5,-5){curl 1}
+ ..cycle
+
+Path at line 63, after choices:
+(3,6)..controls (-3.01212,4.82085) and (-1.0424,-6.01257)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (-5,5) and (-5,5)
+ ..(5,-5)..controls (5,0.02791) and (4.99951,6.39217)
+ ..(3,6)..controls (-2.44821,4.93144) and (-5.41408,-1.00029)
+ ..(-3,-6)..controls (-3.70045,-12.19485) and (5,-11.61679)
+ ..(5,-5)..controls (12.45406,-3.75087) and (10.41669,7.45464)
+ ..cycle
+
+>> path
+! Improper `:=' will be changed to `='.
+l.63 ...p2{0,1}&p2{_,'}..cycle:=
+ p
+I didn't find a variable name at the left of the `:=',
+so I'm going to pretend that you said `=' instead.
+
+{(path)=(unknown path p~4)}
+{-(9)}
+{((3.5001,7.00002))subpath(path)}
+{((-9,9))subpath(path)}
+{(path)=(unknown path p~6)}
+{show}
+>> Path at line 65:
+(-2.5,2.5)..controls (-2.49893,2.49893) and (0.00107,-0.00107)
+ ..(5,-5)..controls (5,0.02791) and (4.99951,6.39217)
+ ..(3,6)..controls (-2.44821,4.93144) and (-5.41408,-1.00029)
+ ..(-3,-6)..controls (-3.70045,-12.19485) and (5,-11.61679)
+ ..(5,-5)..controls (5.0001,-4.99998) and (5.00021,-4.99997)
+ ..(5.00032,-4.99995)
+
+{((1,2))directiontime(path)}
+>> 1
+{-(1.00002)}
+{((1,-1.00002))directiontime(path)}
+>> 3.24937
+Path at line 66, before choices:
+(0,0)..controls (1,1) and (0,1)
+ ..(1,0)
+
+Path at line 66, after choices:
+(0,0)..controls (1,1) and (0,1)
+ ..(1,0)
+
+{(unknown path p~3)=(path)}
+{show}
+Path at line 66, before choices:
+(5,-5){-2896.30943,-2896.30934}
+ ..{1831.78674,3663.57385}cycle
+
+Path at line 66, after choices:
+(5,-5)..controls (5,-5) and (5,-5)
+ ..cycle
+
+>> Path at line 66:
+(5,-5)..controls (5,-5) and (5,-5)
+ ..cycle
+
+{((0.31416,1))subpath(path)}
+{((1,1))directiontime(path)}
+{(1)-(0.31416)}
+{(0.27097)*(0.68584)}
+{(0.31416)+(0.18584)}
+>> 0.5
+{((0,0.25))subpath(path)}
+{((0.25,1))subpath(path)}
+Path at line 68, before choices:
+(0,0)..controls (0.25,0.25) and (0.375,0.4375)
+ ..(0.4375,0.5625)..controls (0.625,0.9375) and (0.25,0.75)
+ ..(1,0)
+
+Path at line 68, after choices:
+(0,0)..controls (0.25,0.25) and (0.375,0.4375)
+ ..(0.4375,0.5625)..controls (0.625,0.9375) and (0.25,0.75)
+ ..(1,0)
+
+! Missing `endtext' has been inserted.
+<to be read again>
+ ;
+l.68 ...~3)shifted begintext1,0;
+
+I found no right delimiter to match a left one. So I've
+put one in, behind the scenes; this may fix the problem.
+
+{(path)shifted((1,0))}
+{(unknown path p~5)=(path)}
+{(2/3)*((xpart ',ypart '))}
+{((0.66667xpart ',0.66667ypart '))zscaled((xpart ',ypart '))}
+>> (0,0,xpart ',-ypart ',ypart ',xpart ')
+! Transform components aren't all known.
+<to be read again>
+ {
+l.69 p~3:=2/3'zscaled'{
+ p~3}..controls(2,2/3(3))and penoffset(...
+I'm unable to apply a partially specified transformation
+except to a fully known pair or transform.
+Proceed, and I'll omit the transformation.
+
+>> 0.66667xpart '
+! Undefined x coordinate has been replaced by 0.
+<to be read again>
+ {
+l.69 p~3:=2/3'zscaled'{
+ p~3}..controls(2,2/3(3))and penoffset(...
+I need a `known' x value for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+>> 0.66667ypart '
+! Undefined y coordinate has been replaced by 0.
+<to be read again>
+ {
+l.69 p~3:=2/3'zscaled'{
+ p~3}..controls(2,2/3(3))and penoffset(...
+I need a `known' y value for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+>> path
+! Undefined coordinates have been replaced by (0,0).
+<to be read again>
+ }
+l.69 p~3:=2/3'zscaled'{p~3}
+ ..controls(2,2/3(3))and penoffset(...
+I need x and y numbers for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+{(2/3)*(3)}
+{(1/2)*(x)}
+{((0.5x,-5))penoffset((0,1))}
+>> (0.5x,-5)
+>> (0,1)
+! Not implemented: penoffset(unknown pair)of(pair).
+<to be read again>
+ (
+l.69 ...enoffset(1/2x,y)of(0,1)(
+ 1,0);
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+! Missing `..' has been inserted.
+<to be read again>
+ (
+l.69 ...enoffset(1/2x,y)of(0,1)(
+ 1,0);
+A path join command should end with two dots.
+
+Path at line 69, before choices:
+(0,0)..controls (2,2) and (0,1)
+ ..(1,0)
+
+Path at line 69, after choices:
+(0,0)..controls (2,2) and (0,1)
+ ..(1,0)
+
+{p~3:=path}
+{show}
+{reverse(path)}
+{(path)intersectiontimes(path)}
+>> (0.17227,0.28339)
+{(0.17227)point(path)}
+>> (0.71329,0.78188)
+{(1)-(0.28339)}
+{(0.71661)point(path)}
+>> (0.7133,0.78189)
+{show}
+{(path)shifted((0.01,0))}
+{(path)intersectiontimes(path)}
+{xpart((1.47693,1.18973))}
+{(1.47693)point(path)}
+{(path)shifted((0.01,0))}
+{(path)intersectiontimes(path)}
+{ypart((1.47693,1.18973))}
+{(1.18973)point(path)}
+{((1.50499,0.71521))-((1.495,0.71521))}
+>> (0.01,0)
+{begingroup}
+{interim}
+{tracingedges:=1}
+{-(1)}
+{-(1.00002)}
+{(-1)+-+(-1.00002)}
+! Pythagorean subtraction 1+-+1.00002 has been replaced by 0.
+l.73 ...es:=1; e[-1+-+ -1.00001]
+ =nullpicture; addto e1 also[[
+Since I don't take square roots of negative numbers,
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{nullpicture}
+{(unknown picture e0)=(picture)}
+{addto}
+{begingroup}
+{addto}
+{(path)scaled(3)}
+Path at line 74, before subdivision into octants:
+(3,0)..controls (3.75,0.75) and (4.125,1.3125)
+ ..(4.3125,1.6875)..controls (4.875,2.8125) and (3.75,2.25)
+ ..(6,0)..controls (3.75,2.25) and (4.875,2.8125)
+ ..(4.3125,1.6875)..controls (4.125,1.3125) and (3.75,0.75)
+ ..cycle
+
+Cycle spec at line 74, after subdivision:
+(3,0) % beginning in octant `NNE'
+ ..controls (3.75,0.75) and (4.125,1.3125)
+ ..(4.3125,1.6875) % segment 0
+ ..controls (4.5,2.0625) and (4.5,2.25)
+ ..(4.5,2.25) % segment 1
+% entering octant `NNW'
+% entering octant `WNW'
+% entering octant `WSW'
+% entering octant `SSW'
+% entering octant `SSE'
+ ..controls (4.5,2.25) and (4.5,1.5)
+ ..(6,0) % segment 1
+% entering octant `ESE'
+% entering octant `ENE'
+% entering octant `NNE'
+% entering octant `NNW'
+ ..controls (4.5,1.5) and (4.5,2.25)
+ ..(4.5,2.25) % segment 2
+% entering octant `WNW'
+% entering octant `WSW'
+% entering octant `SSW'
+ ..controls (4.5,2.25) and (4.5,2.0625)
+ ..(4.3125,1.6875) % segment 2
+ ..controls (4.125,1.3125) and (3.75,0.75)
+ ..(3,0) % segment 3
+% entering octant `SSE'
+% entering octant `ESE'
+% entering octant `ENE'
+ & cycle
+
+Tracing edges at line 74: (weight 1)
+(4,0)(4,1)(5,1)(5,3)(4,3)(4,1)(5,1)(5,0)(6,0)(6,1)(5,1)(5,3)
+(4,3)(4,1)(3,1)(3,0).
+
+{(unknown picture e1)=(unknown picture e2)}
+{(picture)=(unknown picture e1)}
+{cull}
+{nullpicture}
+{endgroup}
+{show}
+{-(4095)}
+{(picture)shifted((4089,-4095))}
+>> Edge structure at line 75:
+row -4093: | 4093+ 4094-
+row -4094: | 4093+ 4094-
+row -4095: | 4092+ 4093- 4094+ 4095-
+
+{-(4095)}
+{(picture)shifted((-4095,4092))}
+{-(3)}
+{(picture)shifted((-3,0))}
+>> Edge structure at line 75:
+row 4094: -4094+ -4093- -4094+ -4093- |
+row 4093: -4094+ -4093- -4094+ -4093- |
+row 4092: -4095+ -4092- -4093+ -4094- |
+
+{-(4095)}
+{(picture)shifted((4089,-4095))}
+! Too far to shift.
+<to be read again>
+ ]]
+l.76 e2 shifted(4089,-4095)]]
+ ;addto e1 also e2 shifted(-2,$)...
+I can't shift the picture as requested---it would
+make some coordinates too large or too small.
+Proceed, and I'll omit the transformation.
+
+>> Edge structure at line 76:
+row 2: 4+ 5- 4+ 5- |
+row 1: 4+ 5- 4+ 5- |
+row 0: 3+ 6- 5+ 4- |
+
+{restoring tracingedges=32767.99998}
+{endgroup}
+{addto}
+{-(2)}
+{(picture)shifted((-2,-1))}
+{-(4)}
+{(picture)shifted((-4,-1))}
+{e1:=picture}
+{addto}
+{(picture)rotated(89.999)}
+! That transformation is too hard.
+<to be read again>
+ +
+l.77 ...e0 also e1rotated89.999+
+ e1scaled$; show e0 xscaled-10...
+I can apply complicated transformations to paths,
+but I can only do integer operations on pictures.
+Proceed, and I'll omit the transformation.
+
+{(picture)scaled(-1)}
+{(picture)+(picture)}
+{show}
+{-(10)}
+{(picture)xscaled(-10)}
+{(picture)yscaled(2)}
+{(picture)xscaled(82)}
+! Scaled picture would be too big.
+<to be read again>
+ yscaled
+l.78 yscaled
+ 683;addto e1 doublepath (0,9) withweight-3 withwe...
+I can't xscale the picture as requested---it would
+make some coordinates too large or too small.
+Proceed, and I'll omit the transformation.
+
+{(picture)yscaled(683)}
+! Scaled picture would be too big.
+<to be read again>
+ ;
+l.78 yscaled683;
+ addto e1 doublepath (0,9) withweight-3 withwe...
+I can't yscale the picture as requested---it would
+make some coordinates too large or too small.
+Proceed, and I'll omit the transformation.
+
+>> Edge structure at line 78:
+row 5: -40- -50+ -40- -50+ |
+row 4: -40- -50+ -40- -50+ |
+row 3: -30+ 0- -10+ -20- -40- -50+ -40- -50+ | -10+ 0-
+row 2: -30+ 0- -10+ -20- -40- -50+ -40- -50+ | -10+ 0-
+row 1: 20- 10+ 20- 10+ -20+ -10- -20+ -10- -30- -60+ -50- -40+ |
+ -10+ -10+ 0- 0- 10+ 20-
+row 0: 20- 10+ 20- 10+ -20+ -10- -20+ -10- -30- -60+ -50- -40+ |
+ -10+ -10+ 0- 0- 10+ 20-
+row -1: 20- 10+ 20- 10+ -20+ -10- -20+ -10- | -20+ -10- 0+ 0+ 10-
+ 10-
+row -2: 20- 10+ 20- 10+ -20+ -10- -20+ -10- | -20+ -10- 0+ 0+ 10-
+ 10-
+row -3: 30- 0+ 10- 20+ | 0+ 10-
+row -4: 30- 0+ 10- 20+ | 0+ 10-
+
+{addto}
+{-(3)}
+{turningnumber(path)}
+! Weight must be -3, -2, -1, +1, +2, or +3.
+<to be read again>
+ withpen
+l.79 withpen
+ pencircle xscaled(oct"180"++1) rotated-angle(64...
+I'll ignore the bad `with' clause and look for another.
+
+{pencircle}
+{oct("180")}
+>> "180"
+! String contains illegal digits.
+<to be read again>
+ ++
+l.79 ...ircle xscaled(oct"180"++
+ 1) rotated-angle(64,$) shifte...
+I zeroed out characters that weren't in the range 0..7.
+
+{(64)++(1)}
+{(future pen)xscaled(64.00781)}
+{angle((64,-1))}
+{-(-0.89517)}
+{(future pen)rotated(0.89517)}
+{(future pen)shifted((9,8))}
+Pen polygon at line 80 (newly created):
+(9,7.5)
+ .. (37.5,8)
+ .. (41,8.5)
+ .. (9,8.5)
+ .. (-19.5,8)
+ .. (-23,7.5)
+ .. cycle
+
+Path at line 80, before choices:
+(-1,-1){curl 1}
+ ..(1,0)
+ ..(1,1)
+ ..(-1,0)
+ ..{curl 1}cycle
+
+Path at line 80, after choices:
+(-1,-1)..controls (-0.18568,-1.14464) and (0.62712,-0.73824)
+ ..(1,0)..controls (1.16457,0.32584) and (1.21637,0.71506)
+ ..(1,1)..controls (0.46898,1.69931) and (-0.7587,1.2167)
+ ..(-1,0)..controls (-1.06546,-0.33012) and (-1.06546,-0.66988)
+ ..cycle
+
+{makepen(path)}
+{(future pen)xscaled(4095.49998)}
+Pen polygon at line 80 (newly created):
+(4095.49998,0)
+ .. (4095.49998,1)
+ .. (-4095.49998,0)
+ .. (-4095.49998,-1)
+ .. cycle
+
+Path at line 80, before subdivision into octants:
+(0,9)..controls (0,9) and (0,9)
+ ..cycle
+
+! Curve out of range.
+<to be read again>
+ ;
+l.80 ...cycle)xscaled4095.49999;
+
+At least one of the coordinates in the path I'm about to
+digitize was really huge (potentially bigger than 4095).
+So I've cut it back to the maximum size.
+The results will probably be pretty wild.
+
+Cycle spec at line 80, after subdivision:
+(0,0) % beginning in octant `ENE'
+% entering octant `NNE'
+% entering octant `NNW'
+% entering octant `WNW'
+% entering octant `WSW'
+% entering octant `SSW'
+% entering octant `SSE'
+% entering octant `ESE'
+ & cycle
+
+Tracing edges at line 80: (weight -3)
+@ Octant ENE (2 offsets), from (-4095.49998,-1) to (4095.49998,0)
+@ transition line 0, from (-4095.49998,-1) to (-4095.49998,-1)
+@ transition line 1, from (-4095.49998,-1) to (4095.49998,0)
+@ transition line 2, from (4095.49998,0) to (4095.49998,0)
+(0,-1)
+@ Octant NNE (1 offset), from (4095.49998,0) to (4095.49998,1)
+@ transition line 2, from (4095.49998,0) to (4095.49998,0)
+@ transition line 1, from (4095.49998,0) to (4095.49998,1)
+(0,0)(4095,0)
+@ Octant NNW (0 offsets), from (4095.49998,1) to (4095.49998,1)
+@ transition line 0, from (4095.49998,1) to (4095.49998,1)
+@ Octant WNW (0 offsets), from (4095.49998,1) to (4095.49998,1)
+@ transition line 1, from (4095.49998,1) to (4095.49998,1)
+@ Octant WSW (2 offsets), from (4095.49998,1) to (-4095.49998,0)
+@ transition line 0, from (4095.49998,1) to (4095.49998,1)
+@ transition line 1, from (4095.49998,1) to (-4095.49998,0)
+@ transition line 2, from (-4095.49998,0) to (-4095.49998,0)
+(4095,1)(0,1)
+@ Octant SSW (1 offset), from (-4095.49998,0) to (-4095.49998,-1)
+@ transition line 2, from (-4095.49998,0) to (-4095.49998,0)
+@ transition line 1, from (-4095.49998,0) to (-4095.49998,-1)
+(0,0)(-4095,0)
+@ Octant SSE (0 offsets), from (-4095.49998,-1) to (-4095.49998,-1)
+@ transition line 0, from (-4095.49998,-1) to (-4095.49998,-1)
+@ Octant ESE (0 offsets), from (-4095.49998,-1) to (-4095.49998,-1)
+@ transition line 1, from (-4095.49998,-1) to (-4095.49998,-1)
+(-4095,-1).
+
+{show}
+>> Edge structure at line 81:
+row 1: | 0+ 1-
+row 0: 0--- 4095+++ -2+ -1- -2+ -1- | 0+ 1-
+row -1: -4095--- 0+++ -2+ -1- -2+ -1- | -1+ 0- 1+ 2-
+row -2: -3+ 0- -1+ -2- |
+
+{totalweight(picture)}
+>> -0.37476
+{charcode:=5}
+{chardp:=5}
+{-(1.5)}
+{xoffset:=-1.5}
+{shipout}
+[5]
+Edge structure at line 81 (just shipped out):
+row 1: | -1+ 0-
+row 0: | -3+ -3+ -2- -2- -1--- -1+ 0- 4094+++
+row -1: | -4096--- -3+ -3+ -2- -2- -2+ -1- -1+++ 0+ 1-
+row -2: | -4+ -3- -2+ -1-
+
+{showstats}
+Memory usage 1084&202 (749 still untouched)
+String usage 24&92 (1863&21408 still untouched)
+{addto}
+{(path)yscaled(0.01666)}
+Path at line 82, before subdivision into octants:
+(0,0)..controls (15,0.06665) and (-15,-0.19995)
+ ..(4,0)..controls (-15,-0.19995) and (15,0.06665)
+ ..cycle
+
+Cycle spec at line 82, after subdivision:
+(0,0) % beginning in octant `ENE'
+ ..controls (1.74272,0.00775) and (2.87802,0.01099)
+ ..(3.55333,0.01099) % segment 0
+% entering octant `ESE'
+ ..controls (4.12251,0.01099) and (4.36491,0.00868)
+ ..(4.36877,0.00482) % segment 0
+% entering octant `SSE'
+ ..controls (4.3688,0.00479) and (4.36882,0.00476)
+ ..(4.36882,0.00473) % segment 0
+% entering octant `SSW'
+ ..controls (4.36882,0.0047) and (4.3688,0.00467)
+ ..(4.36877,0.00464) % segment 0
+% entering octant `WSW'
+ ..controls (4.34875,-0.01538) and (-1.88759,-0.07579)
+ ..(-2.48894,-0.07579) % segment 0
+% entering octant `WNW'
+ ..controls (-2.5191,-0.07579) and (-2.5351,-0.07564)
+ ..(-2.53542,-0.07532) % segment 0
+% entering octant `NNW'
+% entering octant `NNE'
+% entering octant `ENE'
+ ..controls (-2.53209,-0.07199) and (-0.88672,-0.05144)
+ ..(4,0) % segment 0
+% entering octant `NNE'
+% entering octant `NNW'
+% entering octant `WNW'
+% entering octant `WSW'
+ ..controls (-0.88672,-0.05144) and (-2.5321,-0.072)
+ ..(-2.53542,-0.07532) % segment 1
+% entering octant `SSW'
+% entering octant `SSE'
+% entering octant `ESE'
+ ..controls (-2.53511,-0.07562) and (-2.5191,-0.07579)
+ ..(-2.48894,-0.07579) % segment 1
+% entering octant `ENE'
+ ..controls (-1.88759,-0.07579) and (4.34877,-0.01537)
+ ..(4.36877,0.00464) % segment 1
+% entering octant `NNE'
+ ..controls (4.3688,0.00467) and (4.36882,0.0047)
+ ..(4.36882,0.00473) % segment 1
+% entering octant `NNW'
+ ..controls (4.36882,0.00476) and (4.3688,0.00479)
+ ..(4.36877,0.00482) % segment 1
+% entering octant `WNW'
+ ..controls (4.36491,0.00868) and (4.12251,0.01099)
+ ..(3.55333,0.01099) % segment 1
+% entering octant `WSW'
+ ..controls (2.87802,0.01099) and (1.74272,0.00775)
+ ..(0,0) % segment 1
+% entering octant `SSW'
+% entering octant `SSE'
+% entering octant `ESE'
+ & cycle
+
+Tracing edges at line 82: (weight 1)
+(No new edges added.)
+
+{(picture)yscaled(0)}
+{e3:=picture}
+{autorounding:=2}
+{addto}
+Path at line 83, before choices:
+(0.5,0){curl 1}
+ ..{curl 1}(3.5,1.5)
+
+Path at line 83, after choices:
+(0.5,0)..controls (1.5,0.5) and (2.5,1)
+ ..(3.5,1.5)
+
+Path at line 83, before subdivision into octants:
+(0.5,0)..controls (1.5,0.5) and (2.5,1)
+ ..(3.5,1.5)..controls (2.5,1) and (1.5,0.5)
+ ..cycle
+
+Cycle spec at line 83, after subdivision and double autorounding:
+(0.5,0) % beginning in octant `ENE'
+ ..controls (1.5,0.5) and (2.5,1)
+ ..(3.5,1.5) % segment 0
+% entering octant `NNE'
+% entering octant `NNW'
+% entering octant `WNW'
+% entering octant `WSW'
+ ..controls (2.5,1) and (1.5,0.5)
+ ..(0.5,0) % segment 1
+% entering octant `SSW'
+% entering octant `SSE'
+% entering octant `ESE'
+ & cycle
+
+Tracing edges at line 83: (weight 2)
+(2,0)(2,1)(4,1)(4,2)(4,1)(2,1)(2,0).
+
+{tracingspecs:=0}
+Path at line 84, before choices:
+(1,1)
+ ..cycle
+
+Path at line 84, after choices:
+(1,1)..controls (1,1) and (1,1)
+ ..cycle
+
+{makepen(path)}
+{(future pen)yscaled(1.5)}
+Pen polygon at line 84 (newly created):
+(1,1.5)
+ .. cycle
+
+{q:=pen}
+{((-1,yy))rotated((8,1,5,-5,-5,5))}
+>> (8,1,5,-5,-5,5)
+! Improper transformation argument.
+<to be read again>
+ {
+l.85 p~8=(($,yy)rotated p{
+ 0,1}..{0,$}(1,0){0,$}..cycle)scaled...
+The expression shown above has the wrong type,
+so I can't transform anything using it.
+Proceed, and I'll omit the transformation.
+
+>> yy
+! Undefined y coordinate has been replaced by 0.
+<to be read again>
+ {
+l.85 p~8=(($,yy)rotated p{
+ 0,1}..{0,$}(1,0){0,$}..cycle)scaled...
+I need a `known' y value for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+Path at line 85, before choices:
+(-1,0){0,4096}
+ ..{0,-4096}(1,0){0,-4096}
+ ..{0,4096}cycle
+
+Path at line 85, after choices:
+(-1,0)..controls (-1,1.33333) and (1,1.33333)
+ ..(1,0)..controls (1,-1.33333) and (-1,-1.33333)
+ ..cycle
+
+{(path)scaled(2)}
+{(path)shifted((1000.49,9))}
+{(unknown path p~8)=(path)}
+{turningcheck:=1}
+{addto}
+>> (8,1,5,-5,-5,5)
+! Improper type.
+<to be read again>
+ withpen
+l.86 ...n q withweight p withpen
+ cycle p;
+Next time say `withweight <known numeric expression>';
+I'll ignore the bad `with' clause and look for another.
+
+{cycle((8,1,5,-5,-5,5))}
+>> false
+! Improper type.
+<to be read again>
+ ;
+l.86 ...eight p withpen cycle p;
+
+Next time say `withpen <known pen expression>';
+I'll ignore the bad `with' clause and look for another.
+
+Tracing edges at line 86: (weight 1)
+@ Octant NNE (0 offsets), from (999,10.5) to (999.15451,11.65451)
+@ transition line 1, from (999.15451,11.65451) to (999.15451,11.65451)
+(999,11)
+@ Octant ENE (0 offsets), from (999.15451,11.65451) to (1001,12)
+@ transition line 0, from (999.15451,11.65451) to (999.15451,11.65451)
+@ Octant ESE (0 offsets), from (1001,12) to (1002.8455,11.6545)
+@ transition line 1, from (1002.8455,11.6545) to (1002.8455,11.6545)
+@ Octant SSE (0 offsets), from (1002.8455,11.6545) to (1003,10.5)
+@ transition line 0, from (1002.8455,11.6545) to (1002.8455,11.6545)
+(999,12)(1003,12)
+@ Octant SSW (0 offsets), from (1003,10.5) to (1002.84549,9.34549)
+@ transition line 1, from (1002.84549,9.34549) to (1002.84549,9.34549)
+@ Octant WSW (0 offsets), from (1002.84549,9.34549) to (1001,9)
+@ transition line 0, from (1002.84549,9.34549) to (1002.84549,9.34549)
+@ Octant WNW (0 offsets), from (1001,9) to (999.1545,9.3455)
+@ transition line 1, from (999.1545,9.3455) to (999.1545,9.3455)
+@ Octant NNW (0 offsets), from (999.1545,9.3455) to (999,10.5)
+@ transition line 0, from (999.1545,9.3455) to (999.1545,9.3455)
+(1003,9)(999,9)(999,11).
+
+Tracing edges at line 86: (weight 1)
+@ Octant SSE (0 offsets), from (999,10.5) to (999.15451,9.34549)
+@ transition line 0, from (999,10.5) to (999,10.5)
+(999,11)
+@ Octant ESE (0 offsets), from (999.15451,9.34549) to (1001,9)
+@ transition line 1, from (1001,9) to (1001,9)
+@ Octant ENE (0 offsets), from (1001,9) to (1002.8455,9.3455)
+@ transition line 0, from (1001,9) to (1001,9)
+@ Octant NNE (0 offsets), from (1002.8455,9.3455) to (1003,10.5)
+@ transition line 1, from (1003,10.5) to (1003,10.5)
+(999,9)(1003,9)
+@ Octant NNW (0 offsets), from (1003,10.5) to (1002.84549,11.65451)
+@ transition line 0, from (1003,10.5) to (1003,10.5)
+@ Octant WNW (0 offsets), from (1002.84549,11.65451) to (1001,12)
+@ transition line 1, from (1001,12) to (1001,12)
+@ Octant WSW (0 offsets), from (1001,12) to (999.1545,11.6545)
+@ transition line 0, from (1001,12) to (1001,12)
+@ Octant SSW (0 offsets), from (999.1545,11.6545) to (999,10.5)
+@ transition line 1, from (999,10.5) to (999,10.5)
+(1003,12)(999,12)(999,11).
+
+{begingroup}
+{interim}
+{(xx)=(0.1)}
+## xx=0.1
+{autorounding:=0.1}
+{addto}
+Tracing edges at line 87: (weight -2)
+@ Octant NNE (0 offsets), from (999,10.5) to (999.38197,11.42706)
+@ transition line 1, from (999.38197,11.42706) to (999.38197,11.42706)
+@ Octant ENE (0 offsets), from (999.38197,11.42706) to (1001,12)
+@ transition line 0, from (999.38197,11.42706) to (999.38197,11.42706)
+(999,11)
+@ Octant ESE (0 offsets), from (1001,12) to (1002.61804,11.42705)
+@ transition line 1, from (1002.61804,11.42705) to (1002.61804,11.42705)
+(999,12)(1003,12)
+@ Octant SSE (0 offsets), from (1002.61804,11.42705) to (1003,10.5)
+@ transition line 0, from (1002.61804,11.42705) to (1002.61804,11.42705)
+@ Octant SSW (0 offsets), from (1003,10.5) to (1002.61803,9.57294)
+@ transition line 1, from (1002.61803,9.57294) to (1002.61803,9.57294)
+@ Octant WSW (0 offsets), from (1002.61803,9.57294) to (1001,9)
+@ transition line 0, from (1002.61803,9.57294) to (1002.61803,9.57294)
+@ Octant WNW (0 offsets), from (1001,9) to (999.38196,9.57295)
+@ transition line 1, from (999.38196,9.57295) to (999.38196,9.57295)
+(1003,9)(999,9)
+@ Octant NNW (0 offsets), from (999.38196,9.57295) to (999,10.5)
+@ transition line 0, from (999.38196,9.57295) to (999.38196,9.57295)
+(999,11).
+
+{restoring autorounding=2}
+{endgroup}
+{-(14.5)}
+{charext:=-14.5}
+{chardp:=-14.5}
+{chardx:=-14.5}
+{shipout}
+{-(picture)}
+{(picture)-(picture)}
+{-(picture)}
+{turningnumber(path)}
+{(6)*(-1)}
+{(picture)shifted((0,-6))}
+{(picture)+(picture)}
+[5.-14]
+Edge structure at line 88 (just shipped out):
+row 11: | 998- 998+ 998++ 1002-- 1002- 1002+
+row 10: | 998- 998+ 998++ 1002-- 1002- 1002+
+row 9: | 998- 998+ 998++ 1002-- 1002- 1002+
+row 5: | 998- 998+ 998++ 1002-- 1002- 1002+
+row 4: | 998- 998+ 998++ 1002-- 1002- 1002+
+row 3: | 998- 998+ 998++ 1002-- 1002- 1002+
+row 2: | 3+ 3+ 3+ 3+ 4- 4- 4- 4-
+row 1: | -1+ -1+ 0- 0- 1+ 2- 3+ 3+ 3+ 3+ 4- 4- 4- 4-
+row 0: | -3+ -3+ -3+ -2- -2- -2- -1+ -1+ 0- 0- 0+ 0+ 1- 1- 2+ 2+
+ 3- 3- 4+ 4+ 5- 5-
+row -1: | -3+ -3+ -2- -2- -2+ -2+ -1- -1- 0+ 0+ 0+ 1- 1- 1-
+row -2: | -4+ -3- -2+ -2+ -1- -1-
+row -4: | 3+ 3+ 4- 4-
+row -5: | 3+ 3+ 4- 4-
+row -6: | 2+ 3- 4+ 5-
+
+Path at line 89, before choices:
+(0,0){curl 1}
+ ..(1,0.5)
+ ..(5,1.5)
+ ..(7,2.5)
+ ..(12,3.5)
+ ..{curl 1}(13,4)
+
+Path at line 89, after choices:
+(0,0)..controls (0.3153,0.20053) and (0.6504,0.36807)
+ ..(1,0.5)..controls (2.29114,0.98723) and (3.72412,0.97192)
+ ..(5,1.5)..controls (5.68967,1.78545) and (6.30771,2.22081)
+ ..(7,2.5)..controls (8.58867,3.1407) and (10.3946,2.90645)
+ ..(12,3.5)..controls (12.3506,3.62962) and (12.68594,3.7973)
+ ..(13,4)
+
+{(unknown path p~9)=(path)}
+{addto}
+Tracing edges at line 89: (weight 1)
+(1,0)(1,1)(5,1)(5,2)(7,2)(7,3)(12,3)(12,4)(12,3)(7,3)(7,2)(5,2)
+(5,1)(1,1)(1,0).
+
+{smoothing:=1}
+{addto}
+Tracing edges at line 90: (weight 1)
+(1,0)(1,1)(4,1)(4,2)(8,2)(8,3)(12,3)(12,4)(12,3)(8,3)(8,2)(4,2)
+(4,1)(1,1)(1,0).
+
+{addto}
+{-(4095)}
+Path at line 91, before choices:
+(-4095,0){curl 1}..tension 0.75 and 999
+ ..{curl 1}(0,2)
+
+Path at line 91, after choices:
+(-4095,0)..controls (-2275,0.88889) and (-1.36636,1.99933)
+ ..(0,2)
+
+Tracing edges at line 91: (weight 1)
+(-3071,0)(-3071,1)(-1024,1)(-1024,2)(-1024,1)(-3071,1)(-3071,0).
+
+{show}
+{-(90)}
+{(picture)rotated(-90)}
+>> Edge structure at line 91:
+
+{(picture)+(picture)}
+{(90)*(-1)}
+{(picture)rotated(-90)}
+{(picture)rotated(90)}
+>> Edge structure at line 91:
+row 2: | 4+++ 4+ 5--- 5-
+row 1: | 0+++ 0+ 1--- 1- 2++ 3-- 4+++ 4+ 5--- 5-
+row 0: | -2+++ -2+++ -1--- -1--- 0+++ 0+ 2--- 2- 3++ 4-- 5++ 6--
+row -1: | -2+++ -2+ 0--- 0- 1+++ 1+++ 2--- 2---
+row -2: | -3++ -2-- -1+++ -1+ 0--- 0-
+
+{if}
+{if}
+{elseif}
+! Missing `:' has been inserted.
+<inserted text>
+ :
+<to be read again>
+ elseif
+l.92 if "a" if "ab">"b" elseif
+ path reverse (3,4): >="aa":foo...
+
+{("ab")>("b")}
+{false}
+{reverse((3,4))}
+{path(path)}
+{true}
+{("a")>=("aa")}
+{false}
+{if}
+{((xpart ',ypart '))-((1,yy))}
+{((xpart '-1,linearform))<((xpart ',ypart '))}
+{true}
+{fi}
+{else}
+! Extra else.
+l.93 ... if '-(1,yy)<': :fi else
+ def dup text t=[[t;save endd...
+I'm ignoring this; it doesn't match any if.
+
+{def}
+{def}
+{def}
+
+||<tertiary>->show.substring(EXPR0)of("a"
+(EXPR0)<-(2,-1)
+{show}
+{("a")&("bc")}
+{((2,-1))substring("abc")}
+>> "ba"
+{tertiarydef}
+{def}
+{show}
+{((23.3,4.5))subpath(path)}
+Path at line 100, before choices:
+(0,0){curl 2}
+ ..(13,4)..controls (12.84297,3.89865) and (12.68063,3.80606)
+ ..(12.51372,3.72261){curl 3}
+ ..{curl 4}(-1,-1){curl 4}
+ ..{curl 2}cycle
+
+Path at line 100, after choices:
+(0,0)..controls (-40.15552,-36.7088) and (58.71173,33.50317)
+ ..(13,4)..controls (12.84297,3.89865) and (12.68063,3.80606)
+ ..(12.51372,3.72261)..controls (8.00914,2.1484) and (3.50458,0.5742)
+ ..(-1,-1)..controls (-0.66667,-0.66667) and (-0.33333,-0.33333)
+ ..cycle
+
+>> Path at line 100:
+(0,0)..controls (-40.15552,-36.7088) and (58.71173,33.50317)
+ ..(13,4)..controls (12.84297,3.89865) and (12.68063,3.80606)
+ ..(12.51372,3.72261)..controls (8.00914,2.1484) and (3.50458,0.5742)
+ ..(-1,-1)..controls (-0.66667,-0.66667) and (-0.33333,-0.33333)
+ ..cycle
+
+{numspecial}
+{(2)+(3)}
+
+++->[[dup.showtoken(EXPR0);]];def.x.expr.z.of(EXPR1)=z.enddef;texts(x=((
+EXPR1)+0)(EXPR1)+(EXPR1))("xx",foo((EXPR0)))=0]]
+(EXPR0)<-path
+(EXPR1)<-5
+{begingroup}
+
+dup<text>->[[(TEXT0);save
+(TEXT0)<-showtoken(path)
+{begingroup}
+{showtoken}
+> (path)
+{save}
+{restoring ;}
+{endgroup}
+{def}
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+++->...]];def.x.expr.z.of(EXPR1)
+ =z.enddef;texts(x=((EXPR1)+0)...
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+Sorry: You can't redefine a number, string, or expr.
+I've inserted an inaccessible symbol so that your
+definition will be completed without mixing me up too badly.
+
+
+texts(TEXT0)(TEXT1)<expr>->for.n:=,for.n"yy":n,length.if.false:endfor(TE
+XT1),(TEXT0),:if.string.n:forsuffixes.n=foo1,[foo(n)],':show(TEXT0),(TEX
+T1)|(n;exitif.not('<='+((EXPR2),yy))endfor.for.m= :+endfor.for.m=alpha.s
+tep-1.1 3$:+m.endfor.fi.endfor
+(TEXT0)<-x=((5)+0)(5)+(5)
+(TEXT1)<-"xx",foo((path))
+(EXPR2)<-0
+{for}
+{for}
+! Missing `=' has been inserted.
+<to be read again>
+ "yy"
+texts->for.n:=,for.n"yy"
+ :n,length.if.false:endfor(TEXT1),(TEX...
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+The next thing in this loop should have been `=' or `:='.
+But don't worry; I'll pretend that an equals sign
+was present, and I'll look for the values next.
+
+{loop value="yy"}
+{if}
+{false}
+{false}
+! Incomplete if; all text was ignored after line 100.
+<inserted text>
+ fi
+<to be read again>
+ ENDFOR
+<for("yy")> ....if.false: ENDFOR
+
+texts->...length.if.false:endfor
+ (TEXT1),(TEXT0),:if.string.n:...
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+A forbidden `outer' token occurred in skipped text.
+This kind of error happens when you say `if...' and forget
+the matching `fi'. I've inserted a `fi'; this might work.
+
+{[repeat the loop]}
+{length("xx")}
+
+foo(TEXT2)->begingroup(TEXT2)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-foo
+(TEXT2)<-(path)
+{begingroup}
+{endgroup}
+
+x<expr>of<primary>->(EXPR0)
+{(5)+(0)}
+(EXPR0)<-5
+! Missing `of' has been inserted for x.
+<to be read again>
+ (5)
+<argument> x=((5)+0)(5)
+ +(5)
+texts->...:endfor(TEXT1),(TEXT0)
+ ,:if.string.n:forsuffixes.n=f...
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+I've got the first argument; will look now for the other.
+
+(EXPR1)<-5
+{(5)+(5)}
+{loop value="yy"}
+{if}
+{string("yy")}
+{true}
+{forsuffixes}
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+<for("yy")> ...orsuffixes(EXPR0)
+ =foo1,[foo((EXPR0))],':show.x...
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+Sorry: You can't redefine a number, string, or expr.
+I've inserted an inaccessible symbol so that your
+definition will be completed without mixing me up too badly.
+
+
+foo(TEXT2)->begingroup(TEXT2)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-foo
+(TEXT2)<-("yy")
+{begingroup}
+{endgroup}
+>> "yy"
+! Improper subscript has been replaced by zero.
+<for("yy")> ...o1,[foo((EXPR0))]
+ ,':show.x=((5)+0)(5)+(5),"xx"...
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+A bracketed subscript must have a known numeric value;
+unfortunately, what I found was the value that appears just
+above this error message. So I'll try a zero subscript.
+
+{loop value=foo1}
+{show}
+
+x<expr>of<primary>->(EXPR0)
+{(5)+(0)}
+(EXPR0)<-5
+! Missing `of' has been inserted for x.
+<to be read again>
+ (5)
+<for(foo1)> show.x=((5)+0)(5)
+ +(5),"xx",foo((path))|(("yy");ex...
+<for("yy")> ...'+((0),yy))endfor
+ .for.m= :+endfor.for.m=alpha....
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+I've got the first argument; will look now for the other.
+
+(EXPR1)<-5
+{(5)+(5)}
+>> 10
+>> "xx"
+foo(TEXT2)->begingroup(TEXT2)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-foo
+(TEXT2)<-(path)
+{begingroup}
+{endgroup}
+
+|<suffix>->,(SUFFIX0)
+! Missing `)' has been inserted.
+<to be read again>
+ ("yy")
+<for(foo1)> ...o((path))|(("yy")
+ ;exitif.not('<='+((0),yy)) EN...
+<for("yy")> ...'+((0),yy))endfor
+ .for.m= :+endfor.for.m=alpha....
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+I've gotten to the end of the macro parameter list.
+You might want to delete some tokens before continuing.
+
+(SUFFIX0)<-
+>> Path at line 100:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+
+>> "yy"
+{exitif}
+{((xpart ',ypart '))+((0,yy))}
+{((xpart ',ypart '))<=((xpart ',linearform))}
+>> -yy
+! Unknown relation will be considered false.
+<to be read again>
+ )
+<for(foo1)> ...ot('<='+((0),yy))
+ ENDFOR
+<for("yy")> ...'+((0),yy))endfor
+ .for.m= :+endfor.for.m=alpha....
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+Oh dear. I can't decide if the expression above is positive,
+negative, or zero. So this comparison test won't be `true'.
+
+{[repeat the loop]}
+{loop value=0}
+{not(false)}
+{true}
+{for}
+{for}
+>> 0.5p3~
+! Improper initial value has been replaced by 0.
+<to be read again>
+ step
+<for("yy")> ....for.m=alpha.step
+ -1.1 3$:+m.endfor.fi ENDFOR
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+When you say `for x=a step b until c',
+the initial value `a' and the step size `b'
+and the final value `c' must have known numeric values.
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{-(1.1)}
+! Missing `until' has been inserted.
+<to be read again>
+ 3
+<for("yy")> ...=alpha.step-1.1 3
+ $:+m.endfor.fi ENDFOR
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.100 ...cle;numspecial p~++2+3;
+ [[
+I assume you meant to say `until' after `step'.
+So I'll look for the final value and colon next.
+
+{(3)*(-1)}
+{loop value=0}
+{[repeat the loop]}
+{loop value=-1.1}
+{+(0)}
+{[repeat the loop]}
+{loop value=-2.20001}
+{(0)+(-1.1)}
+{[repeat the loop]}
+{fi}
+{[repeat the loop]}
+{loop value=2}
+{if}
+{string(2)}
+{false}
+{[repeat the loop]}
+{loop value=path}
+{if}
+{string(path)}
+{false}
+{[repeat the loop]}
+{loop value=10}
+{if}
+{string(10)}
+{false}
+{[repeat the loop]}
+{(-1.1)+(-2.20001)}
+{endgroup}
+{begingroup}
+{let}
+{save}
+{def}
+{def}
+
+texts->input
+{input}
+(trap.mf
+if->endinput?
+{endinput}
+{if}
+{known(0)}
+{not(true)}
+{false}
+)
+! Incomplete if; all text was ignored after line 2.
+<inserted text>
+ fi
+l.101 ...input enddef;texts trap
+ ]];
+The file ended while I was skipping conditional text.
+This kind of error happens when you say `if...' and forget
+the matching `fi'. I've inserted a `fi'; this might work.
+
+{restoring \}
+{restoring if}
+{endgroup}
+
+dup<text>->[[(TEXT0);save
+Runaway text?
+[[def.texts.secondary.x=primarydef.y++y=x@y.enddef;showtoken ETC.
+! Forbidden token found while scanning a text argument.
+<inserted text>
+ endgroup
+<to be read again>
+ \
+l.102 ...showtoken++;x enddef]]\
+ ;
+It seems that a right delimiter was left out,
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+(TEXT0)<-[[def.texts.secondary.x=primarydef.y++y=x@y.enddef;showtoken++;
+x.enddef]]
+{begingroup}
+{begingroup}
+{def}
+{endgroup}
+{save}
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+<to be read again>
+ \
+l.102 ...showtoken++;x enddef]]\
+ ;
+Sorry: You can't redefine my error-recovery tokens.
+I've inserted an inaccessible symbol so that your
+definition will be completed without mixing me up too badly.
+
+{\}
+{proofing:=1}
+
+texts<secondary>->primarydef.y++y=(EXPR0)@y.enddef;showtoken++;(EXPR0)
+(EXPR0)<-"a"
+{primarydef}
+{showtoken}
+> ++=primarydef'd macro:
+("a")@(EXPR1)
+{("a")&("b")}
+ab
+texts<secondary>->primarydef.y++y=(EXPR0)@y.enddef;showtoken++;(EXPR0)
+{(1.00002)*(a1)}
+{-(1.00002a1)}
+(EXPR0)<--1.00002a1
+{primarydef}
+{showtoken}
+> ++=primarydef'd macro:
+(-1.00002a1)@(EXPR1)
+{(a2)+(a3)}
+{(linearform)+(a4)}
+{(linearform)+(a5)}
+{(linearform)+(a6)}
+{-(linearform)}
+{(-1.00002a1)=(linearform)}
+## a1=0.99998a6+0.99998a5+0.99998a4+0.99998a3+0.99998a2
+{-((a3,a2))}
+{((-a3,-a2))/(0.99998)}
+{(a4)+(a5)}
+{begingroup}
+{showdependencies}
+a1=0.99998a6+0.99998a5+0.99998a4+0.99998a3+0.99998a2
+alpha=0.5p3~
+{endgroup}
+{(linearform)+(a6)}
+{(a3)+(a4)}
+{(linearform)+(a5)}
+{(linearform)+(a6)}
+{-((linearform,linearform))}
+{((-1.00002a3,-1.00002a2))=((linearform,linearform))}
+## a2=0.99998a6+0.99998a5+0.99998a4+0.99998a3
+## a3=0.99998a6+0.99998a5+0.99998a4
+{restoring INACCESSIBLE}
+{endgroup}
+{(1.00002)*(0.25a4*4)}
+{(0.25a4*4)+(1)}
+{(0.25a5*4)+(0.25a6*4)}
+{(0.25a4*4+1)=(linearform)}
+## a4*4=0.99998a6*4+0.99998a5*4-3.99994
+{(0.9)*(0.5p3~)}
+{(0.45p3~)+(7)}
+{alpha:=0.45p3~+7}
+## alpha=0.45p3~+7
+{showdependencies}
+alpha=0.45p3~+7
+a4=0.25a6*4+0.25a5*4-0.99998
+a3=0.49998a6*4+0.49998a5*4-0.99997
+a2=0.99997a6*4+0.99997a5*4-1.99992
+a1=1.99992a6*4+1.99992a5*4-3.99982
+{(0.66667)-(0.25a6*4)}
+{(0.25a6*4)=(-0.25a6*4+0.66667)}
+## a6*4=1.33334
+{(0.25a5*4)=(0.33333)}
+## a5*4=1.33331
+#### a4=-0.33333
+#### a3=0.33333
+#### a2=0.66664
+#### a1=1.33328
+{cull}
+{(4)*(0.33333)}
+{chardp:=27}
+{charcode:=27}
+{openwindow}
+! Improper `openwindow'.
+<to be read again>
+ ;
+l.107 ...) to (0,0) at "whoops";
+ addto p; shipout p; cull p;
+Say `openwindow k from (r0,c0) to (r1,c1) at (x,y)',
+where all quantities are known and k is between 0 and 15.
+
+{addto}
+>> (8,1,5,-5,-5,5)
+! Not a suitable variable.
+<to be read again>
+ ;
+l.107 ...) at "whoops"; addto p;
+ shipout p; cull p;
+At this point I needed to see the name of a picture variable.
+(Or perhaps you have indeed presented me with one; I might
+have missed it, if it wasn't followed by the proper token.)
+So I'll not change anything just now.
+
+{shipout}
+! Variable p is the wrong type (transform).
+<to be read again>
+ ;
+l.107 ...s"; addto p; shipout p;
+ cull p;
+I was looking for a "known" picture variable.
+So I'll not change anything just now.
+
+{cull}
+>> (8,1,5,-5,-5,5)
+! Not a suitable variable.
+<to be read again>
+ ;
+l.107 ...o p; shipout p; cull p;
+
+At this point I needed to see the name of a picture variable.
+(Or perhaps you have indeed presented me with one; I might
+have missed it, if it wasn't followed by the proper token.)
+So I'll not change anything just now.
+
+{openwindow}
+{-(0.5)}
+
+Calling BLANKRECTANGLE(0,0,0,0)
+Calling UPDATESCREEN
+{special}
+>> (8,1,5,-5,-5,5)
+! Unsuitable expression.
+<to be read again>
+ ;
+l.108 ...$) at (0,0); special p;
+ numspecial "p";
+The expression shown above has the wrong type to be output.
+
+{numspecial}
+>> "p"
+! Unsuitable expression.
+<to be read again>
+ ;
+l.108 ...cial p; numspecial "p";
+
+The expression shown above has the wrong type to be output.
+
+{openwindow}
+{(32)*(1024)}
+! Arithmetic overflow.
+l.109 ....49999 from (0,32*1024)
+ to (1,31*1057) at (0,0); shi...
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+{(31)*(1057)}
+
+Calling BLANKRECTANGLE(100,100,0,1)
+Calling UPDATESCREEN
+{shipout}
+[27.-14]
+Edge structure at line 109 (just shipped out):
+row 0: | -3++ -2-- -1++ 4094--
+row -1: | -4096++ -3-- -2++ -1--
+
+{openwindow}
+Path at line 110, before choices:
+(0,0)
+
+Path at line 110, after choices:
+(0,0)
+
+{length(path)}
+
+Calling BLANKRECTANGLE(0,2,0,4)
+Calling UPDATESCREEN
+{openwindow}
+{length((-1,0))}
+{-(5)}
+
+Calling BLANKRECTANGLE(1,10,1,3)
+Calling UPDATESCREEN
+{display}
+{nullpicture}
+>> picture
+! Not a suitable variable.
+<to be read again>
+ ;
+l.112 display nullpicture;
+ display p inwindow 3; display p in...
+At this point I needed to see the name of a picture variable.
+(Or perhaps you have indeed presented me with one; I might
+have missed it, if it wasn't followed by the proper token.)
+So I'll not change anything just now.
+
+{display}
+>> 3
+! Bad window number.
+<to be read again>
+ ;
+l.112 ...; display p inwindow 3;
+ display p inwindow 6;
+It should be the number of an open window.
+
+{display}
+! Variable p is the wrong type (transform).
+<to be read again>
+ ;
+l.112 ...; display p inwindow 6;
+
+I was looking for a "known" picture variable.
+So I'll not change anything just now.
+
+{display}
+
+Calling BLANKRECTANGLE(1,10,1,3)
+Calling PAINTROW(2,1;4,5,6,10)
+Calling UPDATESCREEN
+{cull}
+! Enormous number has been reduced.
+l.113 ...opping (0.1,4095.999999
+ ) withweight 3.5
+I can't handle numbers bigger than about 4095.99998;
+so I've changed your constant to that maximum amount.
+
+! Weight must be -3, -2, -1, +1, +2, or +3.
+<to be read again>
+ withweight
+l.114 withweight
+ -3.5; display e0 inwindow 5.5; addto e0 also ...
+I'll ignore the bad `with' clause and look for another.
+
+{-(3.5)}
+! Bad culling amounts.
+<to be read again>
+ ;
+l.114 withweight-3.5;
+ display e0 inwindow 5.5; addto e0 also ...
+Always cull by known amounts that exclude 0.
+
+{display}
+
+Calling BLANKRECTANGLE(1,10,1,3)
+Calling PAINTROW(2,1;4,5,6,8,9,10)
+Calling PAINTROW(1,1;6,7,8,9)
+Calling UPDATESCREEN
+{addto}
+>> (8,1,5,-5,-5,5)
+! Improper `addto'.
+<to be read again>
+ ;
+l.114 ...w 5.5; addto e0 also p;
+ addto e0 contour 0;
+This expression should have specified a known picture.
+So I'll not change anything just now.
+
+{addto}
+>> 0
+! Improper `addto'.
+<to be read again>
+ ;
+l.114 ... p; addto e0 contour 0;
+
+This expression should have been a known path.
+So I'll not change anything just now.
+
+{display}
+
+Calling BLANKRECTANGLE(0,2,0,4)
+Calling PAINTROW(2,1;0,1)
+Calling PAINTROW(1,1;0,1)
+Calling PAINTROW(0,1;1,2)
+Calling UPDATESCREEN
+{addto}
+! Not a cycle.
+<to be read again>
+ ;
+l.115 ...; addto e0 contour p~9;
+
+That contour should have ended with `..cycle' or `&cycle'.
+So I'll not change anything just now.
+
+{display}
+{(3)+(3)}
+
+Calling BLANKRECTANGLE(1,10,1,3)
+Calling PAINTROW(2,1;4,5,6,10)
+Calling UPDATESCREEN
+{display}
+{begingroup}
+{vardef}
+{endgroup}
+! Variable e0e0 has been obliterated.
+<to be read again>
+ ;
+l.116 ...vardef e[]e=enddef;6]];
+
+It seems you did a nasty thing---probably by accident,
+but nevertheless you nearly hornswoggled me...
+While I was evaluating the right-hand side of this
+command, something happened, and the left-hand side
+is no longer a variable! So I won't change anything.
+
+{addto}
+{display}
+Calling PAINTROW(1,1;0,1,2)
+Calling PAINTROW(0,0;0,1,2)
+Calling UPDATESCREEN
+{ligtable}
+{display}
+{display}
+Calling UPDATESCREEN
+{show}
+{begingroup}
+{interim}
+{tracingcommands:=0}
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"g"
+(TEXT1)<-=:|
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"h":"i"
+(TEXT1)<-|=:
+! Character h is already in a ligtable.
+<to be read again>
+ :
+<argument> "h":
+ "i"
+lig->...;ligtable(TEXT0):(TEXT0)
+ (TEXT1)0,skipto255;boundarych...
+l.119 ...=:|); lig("h":"i")(|=:)
+ ;
+It's not legal to label a character more than once.
+So I'll not change anything just now.
+
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"j"
+(TEXT1)<-|=:>
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"k"
+(TEXT1)<-=:|>
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"l"
+(TEXT1)<-|=:|>
+{restoring tracingcommands=2.1}
+{endgroup}
+>> vacuous
+{begingroup}
+{let}
+{vardef}
+{endgroup}
+! Variable c.a1 has been obliterated.
+<to be read again>
+ ;
+l.121 ...;vardef b=enddef;1]] ];
+ ligtable"m":0=:0,skipto5;
+It seems you did a nasty thing---probably by accident,
+but nevertheless you nearly hornswoggled me...
+While I was evaluating the suffix of this variable,
+something was redefined, and it's no longer a variable!
+In order to get back on my feet, I've inserted `0' instead.
+
+{b1:=0}
+! Variable b1 has been obliterated.
+<to be read again>
+ ;
+l.121 ...;vardef b=enddef;1]] ];
+ ligtable"m":0=:0,skipto5;
+It seems you did a nasty thing---probably by accident,
+but nevertheless you nearly hornswoggled me...
+While I was evaluating the right-hand side of this
+command, something happened, and the left-hand side
+is no longer a variable! So I won't change anything.
+
+{ligtable}
+! A statement can't begin with `skipto'.
+<to be read again>
+ !!
+l.122 !!
+ ; errhelp 0; errmessage "Be like Jane";
+I was looking for the beginning of a new statement.
+If you just proceed without changing anything, I'll ignore
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+! Extra tokens will be flushed.
+<to be read again>
+ !!
+l.122 !!
+ ; errhelp 0; errmessage "Be like Jane";
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+{errhelp}
+>> 0
+! Not a string.
+<to be read again>
+ ;
+l.122 !!; errhelp 0;
+ errmessage "Be like Jane";
+A message should be a known string expression.
+
+{errmessage}
+! Be like Jane.
+<to be read again>
+ ;
+l.122 ...message "Be like Jane";
+
+This error message was generated by an `errmessage'
+command, so I can't give any explicit help.
+Pretend that you're Miss Marple: Examine all clues,
+and deduce the truth by inspired guesses.
+
+{errhelp}
+{errmessage}
+! .
+<to be read again>
+ ;
+l.123 ...e%%%lp%"; errmessage"";
+ errhelp ""; errmessage "Anot...
+He%
+lp
+
+
+{errhelp}
+{errmessage}
+! Another.
+<to be read again>
+ ;
+l.123 ...; errmessage "Another";
+
+(That was another `errmessage'.)
+
+{headerbyte}
+>> 0
+! Improper location.
+<to be read again>
+ ;
+l.124 headerbyte 0;
+ headerbyte(48.5)substring(-9,9)of"long"; ...
+I was looking for a known, positive number.
+For safety's sake I'll ignore the present command.
+
+{headerbyte}
+! Missing `:' has been inserted.
+<to be read again>
+ substring
+l.124 ...aderbyte(48.5)substring
+ (-9,9)of"long"; for\=0:\
+A colon should follow a headerbyte or fontinfo location.
+
+{-(9)}
+{((-9,9))substring("long")}
+>> "long"
+! Invalid code has been replaced by 0.
+<to be read again>
+ ;
+l.124 ...ubstring(-9,9)of"long";
+ for\=0:\
+I was looking for a number between 0 and 255, or for a
+string of length 1. Didn't find it; will use 0 instead.
+
+{for}
+Runaway loop?
+! Forbidden token found while scanning the text of a for loop.
+<inserted text>
+ endfor
+<to be read again>
+ \
+l.124 ...-9,9)of"long"; for\=0:\
+
+I suspect you have forgotten an `endfor',
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{loop value=0}
+{[repeat the loop]}
+{\}
+{headerbyte}
+{(2)*(0.33333)}
+{fontdimen}
+{(2)*(0.33333)}
+>> "q"
+! Improper font parameter.
+<to be read again>
+ ;
+l.125 ..."; fontdimen 9:2a6,"q";
+ fontdimen 1:2048;
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{fontdimen}
+{fontmaking:=1}
+{extensible}
+! Missing `:' has been inserted.
+<to be read again>
+ 5
+l.126 ...king:=1; extensible 5 5
+ ,"c"255.5,"d"; charlist 0:5:"...
+I'm processing `extensible c: t,m,b,r'.
+
+! Missing `,' has been inserted.
+<to be read again>
+ 255.5
+l.126 ...extensible 5 5,"c"255.5
+ ,"d"; charlist 0:5:"a":"d";
+I'm processing `extensible c: t,m,b,r'.
+
+>> 255.5
+! Invalid code has been replaced by 0.
+<to be read again>
+ ,
+l.126 ...xtensible 5 5,"c"255.5,
+ "d"; charlist 0:5:"a":"d";
+I was looking for a number between 0 and 255, or for a
+string of length 1. Didn't find it; will use 0 instead.
+
+{charlist}
+! Character code 5 is already extensible.
+<to be read again>
+ :
+l.126 ...,"d"; charlist 0:5:"a":
+ "d";
+It's not legal to label a character more than once.
+So I'll not change anything just now.
+
+{ligtable}
+! Too far to skip.
+l.127 ligtable255:255::
+ "a"=:"b","d" kern -2048,"c":0:99.5:"e"...
+At most 127 lig/kern steps can separate skipto1 from 1::.
+
+{-(2048)}
+! Character code 0 is already in a charlist.
+<to be read again>
+ :
+l.127 ...","d" kern -2048,"c":0:
+ 99.5:"e"|=:|"f",0kern';
+It's not legal to label a character more than once.
+So I'll not change anything just now.
+
+>> (xpart ',ypart ')
+! Improper kern.
+<to be read again>
+ ;
+l.127 ...99.5:"e"|=:|"f",0kern';
+
+The amount of kern should be a known numeric value.
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{ligtable}
+! Character code 5 is already extensible.
+<to be read again>
+ :
+l.128 ligtable 5:
+ 0; def clear(text x)=interim x:=$ enddef; cl...
+It's not legal to label a character more than once.
+So I'll not change anything just now.
+
+! Illegal ligtable step.
+<to be read again>
+ ;
+l.128 ligtable 5:0;
+ def clear(text x)=interim x:=$ enddef; cl...
+I was looking for `=:' or `kern' here.
+
+{def}
+
+clear(TEXT0)->interim(TEXT0):=$
+(TEXT0)<-hppp
+{interim}
+{hppp:=-1}
+{(0)=(0)}
+! Redundant equation.
+<to be read again>
+ ;
+l.128 ...f; clear(hppp); vppp=0;
+
+I already knew that this equation was true.
+But perhaps no harm has been done; let's continue.
+
+{begingroup}
+
+clear(TEXT0)->interim(TEXT0):=$
+(TEXT0)<-tracingmacros
+{interim}
+{tracingmacros:=-1}
+{interim}
+{tracingcommands:=-1}
+Runaway text?
+tracingoutput
+! Forbidden token found while scanning a text argument.
+<inserted text>
+ )
+<to be read again>
+ \
+l.129 ...); clear(tracingoutput\
+ ;
+It seems that a right delimiter was left out,
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{restoring proofing=1}
+{restoring tracingoutput=1}
+{restoring tracingcommands=2.1}
+{restoring tracingmacros=1}
+{endgroup}
+{def}
+{def}
+{addto}
+Path at line 139, before choices:
+(0,0){4096,0}
+ ..{4096,0}(1,0){0,-4096}
+ ..{0,4096}cycle
+
+Path at line 139, after choices:
+(0,0)..controls (0.33333,0) and (0.66667,0)
+ ..(1,0)..controls (1,-0.66667) and (0,-0.66667)
+ ..cycle
+
+> 0 ENE 1 (ESE SSE) SSW WSW WNW NNW 0 (NNE)
+! Backwards path (turning number is negative).
+<to be read again>
+ ;
+l.139 ....{0,1}cycle withpen qq;
+
+The path doesn't have a counterclockwise orientation,
+so I'll probably have trouble drawing it.
+(See Chapter 27 of The METAFONTbook for more help.)
+
+Tracing edges at line 139: (weight 1)
+@ Octant ENE (2 offsets), from (2.5,-0.5) to (1.5,-2)
+@ retrograde line from (2.5,-0.5) to (0.5,-2)
+(3,0)(3,-1)(1,-1)
+@ transition line 0, from (0.5,-2) to (0.5,-2)
+@ transition line 1, from (1.5,-2) to (2.5,-1.5)
+@ transition line 2, from (2.5,-1.5) to (3.5,-0.5)
+(1,-2)(3,-2)(3,-1)(4,-1)
+@ retrograde line from (3.5,-0.5) to (1.5,-2)
+(4,0)(4,-1)(2,-1)
+@ Octant ESE (2 offsets), from (1.5,-2) to (-1,0)
+@ retrograde line from (1.5,-2) to (-1,0)
+(2,-2)(1,-2)(1,-1)(0,-1)
+@ transition line 3, from (-1,0) to (0.5,-1.5)
+@ transition line 2, from (0.5,-1.5) to (1.5,-2)
+@ transition line 1, from (1.5,-2) to (1.5,-2)
+(0,0)(0,-1)(1,-1)
+@ retrograde line from (1.5,-2) to (-1,0)
+(1,-2)(1,-1)(0,-1)
+@ Octant SSE (0 offsets), from (-1,0) to (-1,0)
+@ transition line 0, from (-1,0) to (-1,0)
+@ Octant SSW (2 offsets), from (-1,0) to (-0.82407,0.67593)
+@ retrograde line from (-1,0) to (-0.5,1.5)
+(0,0)(-1,0)(-1,1)(0,1)
+@ transition line 3, from (-0.5,1.5) to (-0.5,1.5)
+@ transition line 2, from (-0.5,1.5) to (-1,0)
+@ transition line 1, from (-1.06265,-0.39499) to (-0.56265,1.10501)
+@ transition line 2, from (-0.82407,0.67593) to (-1.32407,-0.82407)
+@ transition line 1, from (-1.32407,-0.82407) to (-1.32407,-0.82407)
+(0,2)(0,1)(-1,1)
+@ retrograde line from (-1.32407,-0.82407) to (-0.82407,0.67593)
+(-1,-1)
+@ Octant WSW (2 offsets), from (-0.82407,0.67593) to (1,2)
+@ retrograde line from (-0.82407,0.67593) to (1.17593,2.17593)
+(-1,1)(0,1)
+@ transition line 0, from (1.17593,2.17593) to (1.17593,2.17593)
+@ transition line 1, from (1.17593,2.17593) to (0.17593,1.67593)
+@ transition line 2, from (0,1.5) to (-1,0.5)
+(0,2)
+@ retrograde line from (-1,0.5) to (1,2)
+(0,1)
+@ Octant WNW (2 offsets), from (1,2) to (3.32407,0.17593)
+@ retrograde line from (1,2) to (3.5,0)
+(0,2)(2,2)(2,1)(3,1)
+@ transition line 3, from (3.5,0) to (2,1.5)
+@ transition line 2, from (1.82407,1.67593) to (0.82407,2.17593)
+@ transition line 1, from (0.82407,2.17593) to (0.82407,2.17593)
+(3,0)(3,1)(2,1)
+@ retrograde line from (0.82407,2.17593) to (3.32407,0.17593)
+(2,2)(2,1)(3,1)
+@ Octant NNW (0 offsets), from (3.32407,0.17593) to (3,1)
+@ transition line 0, from (3.32407,0.17593) to (3.32407,0.17593)
+(3,0)
+@ Octant NNE (2 offsets), from (3,1) to (2.5,-0.5)
+@ retrograde line from (3,1) to (2.5,-0.5)
+(3,1)
+@ transition line 3, from (2.5,-0.5) to (2.5,-0.5)
+@ transition line 2, from (2.5,-0.5) to (3,1)
+@ transition line 1, from (3,1) to (3,1)
+(3,0)
+@ retrograde line from (3,1) to (2.5,-0.5)
+(3,1)(3,0).
+
+
+f(SUFFIX0)(EXPR1)(EXPR2)(TEXT3)->numeric.w;show(EXPR1);addto(SUFFIX0)con
+tour(0,0)..(2,0)..(1,$)..(1,1)..cycle.withpen.qq;addto(SUFFIX0)doublepat
+h(0,0){1,1}..{2,1}(2,1)withpen.qq;addto(SUFFIX0)doublepath(($,$){1,0}..(
+1,1){1,0})scaled0.5withpen.nullpen;cull(SUFFIX0)keeping(4,4)withweight1.
+5;
+! Missing `]' has been inserted.
+<to be read again>
+ ,
+l.140 f(e[3,
+ w); g(e3,transformed p,penoffset-(1,1.3)of(pencir...
+I've seen a `[' and a subscript value, in a suffix,
+so a right bracket should have come next.
+I shall pretend that one was there.
+
+(SUFFIX0)<-e3
+(EXPR1)<-unknown path w
+! Missing argument to f.
+<to be read again>
+ ;
+l.140 f(e[3,w);
+ g(e3,transformed p,penoffset-(1,1.3)of(pencir...
+That macro has more parameters than you thought.
+I'll continue by pretending that each missing argument
+is either zero or null.
+
+(EXPR2)<-0
+! Missing argument to f.
+<to be read again>
+ ;
+l.140 f(e[3,w);
+ g(e3,transformed p,penoffset-(1,1.3)of(pencir...
+That macro has more parameters than you thought.
+I'll continue by pretending that each missing argument
+is either zero or null.
+
+(TEXT3)<-
+{numeric}
+{show}
+>> unknown path %CAPSULE1615
+{addto}
+Path at line 140, before choices:
+(0,0)
+ ..(2,0)
+ ..(1,-1)
+ ..(1,1)
+ ..cycle
+
+Path at line 140, after choices:
+(0,0)..controls (0.56189,-0.5286) and (1.43811,0.5286)
+ ..(2,0)..controls (2.70831,-0.66634) and (1.66634,-1.70831)
+ ..(1,-1)..controls (0.4714,-0.43811) and (1.5286,0.43811)
+ ..(1,1)..controls (0.33366,1.70831) and (-0.70831,0.66634)
+ ..cycle
+
+> 0 ESE ENE ESE 1 SSE SSW WSW WNW NNW 2 NNE NNW 3 WNW WSW SSW SSE ESE 0
+! Strange path (turning number is zero).
+<to be read again>
+ ;
+f->.....(1,1)..cycle.withpen.qq;
+ addto(SUFFIX0)doublepath(0,0)...
+<to be read again>
+ ;
+l.140 f(e[3,w);
+ g(e3,transformed p,penoffset-(1,1.3)of(pencir...
+The path doesn't have a counterclockwise orientation,
+so I'll probably have trouble drawing it.
+(See Chapter 27 of The METAFONTbook for more help.)
+
+Tracing edges at line 140: (weight 1)
+@ Octant ENE (2 offsets), from (0.26321,-2.6526) to (1.73679,-2.34741)
+@ transition line 0, from (0.26321,-2.6526) to (0.26321,-2.6526)
+@ transition line 1, from (1.73679,-2.34741) to (2.73679,-1.84741)
+@ transition line 2, from (2.73679,-1.84741) to (3.73679,-0.84741)
+(1,-3)(1,-2)(3,-2)
+@ retrograde line from (3.73679,-0.84741) to (1.73679,-2.34741)
+(3,-1)
+@ Octant ESE (2 offsets), from (1.73679,-2.34741) to (-0.25465,-0.56029)
+@ retrograde line from (1.73679,-2.34741) to (-0.76321,-0.34741)
+(3,-2)(1,-2)(1,-1)(-1,-1)
+@ transition line 3, from (-0.76321,-0.34741) to (0.73679,-1.84741)
+@ transition line 2, from (0.73679,-1.84741) to (1.73679,-2.34741)
+@ transition line 1, from (2.05333,-2.41772) to (1.05333,-1.91772)
+@ transition line 2, from (1.24535,-2.06029) to (2.24535,-2.56029)
+@ transition line 1, from (2.24535,-2.56029) to (2.24535,-2.56029)
+(-1,0)(-1,-1)(0,-1)(0,-2)(2,-2)
+@ retrograde line from (2.24535,-2.56029) to (-0.25465,-0.56029)
+(2,-3)(2,-2)(1,-2)
+@ Octant SSE (0 offsets), from (-0.25465,-0.56029) to (0,-1.13196)
+@ transition line 0, from (-0.25465,-0.56029) to (-0.25465,-0.56029)
+@ Octant SSW (2 offsets), from (0,-1.13196) to (0.25,-0.25)
+@ retrograde line from (0,-1.13196) to (0.5,0.36804)
+(1,-1)(0,-1)
+@ transition line 3, from (0.5,0.36804) to (0.5,0.36804)
+@ transition line 2, from (0.5,0.36804) to (0,-1.13196)
+@ transition line 1, from (-0.04594,-1.41693) to (0.45406,0.08307)
+@ transition line 2, from (0.25,-0.25) to (-0.25,-1.75)
+@ transition line 1, from (-0.25,-1.75) to (-0.25,-1.75)
+(0,0)
+@ retrograde line from (-0.25,-1.75) to (0.25,-0.25)
+(0,-2)
+@ Octant WSW (2 offsets), from (0.25,-0.25) to (1.63197,1)
+@ retrograde line from (0.25,-0.25) to (2.25,1.25)
+(0,0)(1,0)
+@ transition line 0, from (2.25,1.25) to (2.25,1.25)
+@ transition line 1, from (2.25,1.25) to (1.25,0.75)
+@ transition line 2, from (1.03186,0.59352) to (2.03186,1.09352)
+@ transition line 1, from (1.63197,1) to (0.63197,0.5)
+@ transition line 2, from (0.63197,0.5) to (-0.36803,-0.5)
+(1,1)
+@ retrograde line from (-0.36803,-0.5) to (1.63197,1)
+(1,0)
+@ Octant WNW (2 offsets), from (1.63197,1) to (3.56024,-0.74529)
+@ retrograde line from (1.63197,1) to (4.13197,-1)
+(1,1)(2,1)(2,0)(4,0)
+@ transition line 3, from (4.13197,-1) to (2.63197,0.5)
+@ transition line 2, from (2.63197,0.5) to (1.63197,1)
+@ transition line 1, from (1.29863,1.07983) to (2.29863,0.57983)
+@ transition line 2, from (2.06024,0.75471) to (1.06024,1.25471)
+@ transition line 1, from (1.06024,1.25471) to (1.06024,1.25471)
+(4,-1)(4,0)(3,0)
+@ retrograde line from (1.06024,1.25471) to (3.56024,-0.74529)
+(3,1)(2,1)(2,0)(3,0)
+@ Octant NNW (0 offsets), from (3.56024,-0.74529) to (3.3474,-0.23679)
+@ transition line 0, from (3.56024,-0.74529) to (3.56024,-0.74529)
+(3,-1)
+@ Octant NNE (2 offsets), from (3.3474,-0.23679) to (3.65259,1.23679)
+@ retrograde line from (3.3474,-0.23679) to (2.8474,-1.73679)
+(3,0)
+@ transition line 3, from (2.8474,-1.73679) to (2.8474,-1.73679)
+@ transition line 2, from (2.8474,-1.73679) to (3.3474,-0.23679)
+@ transition line 1, from (3.65259,1.23679) to (3.65259,1.23679)
+(3,-2)
+@ Octant NNW (0 offsets), from (3.65259,1.23679) to (3.43976,1.74529)
+@ transition line 0, from (3.65259,1.23679) to (3.65259,1.23679)
+(3,1)(4,1)
+@ Octant WNW (2 offsets), from (3.43976,1.74529) to (0.36803,4)
+@ transition line 3, from (3.43976,1.74529) to (1.93976,3.24529)
+@ transition line 2, from (1.70137,3.42017) to (0.70137,3.92017)
+@ transition line 1, from (0.36803,4) to (0.36803,4)
+(4,2)(3,2)(3,3)(2,3)
+@ Octant WSW (2 offsets), from (0.36803,4) to (-2.25,2.25)
+@ transition line 0, from (0.36803,4) to (0.36803,4)
+@ transition line 1, from (-0.03186,3.90648) to (-1.03186,3.40648)
+@ transition line 2, from (-1.25,3.25) to (-2.25,2.25)
+(2,4)(-1,4)(-1,3)(-2,3)
+@ Octant SSW (2 offsets), from (-2.25,2.25) to (-3,0.13196)
+@ transition line 3, from (-2.25,2.25) to (-2.25,2.25)
+@ transition line 2, from (-2.45406,1.91695) to (-2.95406,0.41695)
+@ transition line 1, from (-3,0.13196) to (-3,0.13196)
+(-2,2)(-3,2)
+@ Octant SSE (0 offsets), from (-3,0.13196) to (-2.74533,-0.43973)
+@ transition line 0, from (-3,0.13196) to (-3,0.13196)
+@ Octant ESE (2 offsets), from (-2.74533,-0.43973) to (0.26321,-2.6526)
+@ transition line 3, from (-2.74533,-0.43973) to (-1.24533,-1.93973)
+@ transition line 2, from (-1.05331,-2.08229) to (-0.05331,-2.58229)
+@ transition line 1, from (0.26321,-2.6526) to (0.26321,-2.6526)
+(-3,-1)(-2,-1)(-2,-2)(0,-2)(0,-3).
+
+{addto}
+Path at line 140, before choices:
+(0,0){2896.30943,2896.30934}
+ ..{3663.57385,1831.78674}(2,1)
+
+Path at line 140, after choices:
+(0,0)..controls (0.53566,0.53566) and (1.32689,0.66344)
+ ..(2,1)
+
+Tracing edges at line 140: (weight 1)
+@ Octant ENE (2 offsets), from (0,-2.5) to (4,0)
+@ transition line 0, from (0,-2.5) to (0,-2.5)
+@ transition line 1, from (0,-2.5) to (1,-2)
+@ transition line 2, from (1.607,-1.57747) to (0.607,-2.07747)
+@ transition line 1, from (2,-1.5) to (3,-1)
+@ transition line 2, from (3,-1) to (4,0)
+(2,-2)(2,-1)(4,-1)
+@ Octant NNE (2 offsets), from (4,0) to (4.5,1.5)
+@ transition line 3, from (4,0) to (4,0)
+@ transition line 2, from (4,0) to (4.5,1.5)
+@ transition line 1, from (4.5,1.5) to (4.5,1.5)
+(4,1)(5,1)
+@ Octant NNW (0 offsets), from (4.5,1.5) to (4.5,1.5)
+@ transition line 0, from (4.5,1.5) to (4.5,1.5)
+@ Octant WNW (2 offsets), from (4.5,1.5) to (2,3.5)
+@ transition line 3, from (4.5,1.5) to (3,3)
+@ transition line 2, from (3,3) to (2,3.5)
+@ transition line 1, from (2,3.5) to (2,3.5)
+(5,2)(4,2)(4,3)(2,3)
+@ Octant WSW (2 offsets), from (2,3.5) to (-2,1)
+@ transition line 0, from (2,3.5) to (2,3.5)
+@ transition line 1, from (0.607,2.92253) to (-0.393,2.42253)
+@ transition line 2, from (-1,2) to (-2,1)
+(2,4)(2,3)(0,3)(0,2)(-1,2)
+@ Octant SSW (2 offsets), from (-2,1) to (-2.5,-0.5)
+@ transition line 3, from (-2,1) to (-2,1)
+@ transition line 2, from (-2,1) to (-2.5,-0.5)
+@ transition line 1, from (-2.5,-0.5) to (-2.5,-0.5)
+(-1,1)(-2,1)
+@ Octant SSE (0 offsets), from (-2.5,-0.5) to (-2.5,-0.5)
+@ transition line 0, from (-2.5,-0.5) to (-2.5,-0.5)
+@ Octant ESE (2 offsets), from (-2.5,-0.5) to (0,-2.5)
+@ transition line 3, from (-2.5,-0.5) to (-1,-2)
+@ transition line 2, from (-1,-2) to (0,-2.5)
+@ transition line 1, from (0,-2.5) to (0,-2.5)
+(-2,-1)(-1,-1)(-1,-2).
+
+{addto}
+Path at line 140, before choices:
+(-1,-1){4096,0}
+ ..{4096,0}(1,1)
+
+Path at line 140, after choices:
+(-1,-1)..controls (0.10457,-1) and (-0.10457,1)
+ ..(1,1)
+
+{(path)scaled(0.5)}
+{nullpen}
+Tracing edges at line 140: (weight 1)
+(0,0)(0,1)(0,0).
+
+{cull}
+
+g(SUFFIX0)->show(SUFFIX0)
+(SUFFIX0)<-e3
+! Too many arguments to g;
+ Missing `)' has been inserted.
+l.140 f(e[3,w); g(e3,
+ transformed p,penoffset-(1,1.3)of(pencir...
+I'm going to assume that the comma I just read was a
+right delimiter, and then I'll begin expanding the macro.
+You might want to delete some tokens before continuing.
+
+{show}
+{(picture)transformed((8,1,5,-5,-5,5))}
+>> Edge structure at line 140:
+
+{-((1,1.3))}
+{pencircle}
+{(future pen)scaled(20)}
+{-(0.5)}
+{(future pen)yscaled(-0.5)}
+Pen polygon at line 140 (newly created):
+(1.5,-5)
+ .. (4.5,-4.5)
+ .. (6,-4)
+ .. (8,-3)
+ .. (9.5,-1.5)
+ .. (10,-0.5)
+ .. (10,0.5)
+ .. (9.5,1.5)
+ .. (8,3)
+ .. (6,4)
+ .. (4.5,4.5)
+ .. (1.5,5)
+ .. (-1.5,5)
+ .. (-4.5,4.5)
+ .. (-6,4)
+ .. (-8,3)
+ .. (-9.5,1.5)
+ .. (-10,0.5)
+ .. (-10,-0.5)
+ .. (-9.5,-1.5)
+ .. (-8,-3)
+ .. (-6,-4)
+ .. (-4.5,-4.5)
+ .. (-1.5,-5)
+ .. cycle
+
+{((-1,-1.3))penoffset(pen)}
+>> (-9.5,1.5)
+Path at line 141, before choices:
+(0,0)..controls (1,1) and (-1,1)
+ ..(3,0)
+
+Path at line 141, after choices:
+(0,0)..controls (1,1) and (-1,1)
+ ..(3,0)
+
+{((0,1))directiontime(path)}
+>> 0.33333
+{(3.14159)point(path)}
+{((3.14159,4))subpath(path)}
+{((7.68668,2.72437))intersectiontimes(path)}
+>> (0,0)
+Path at line 143, before choices:
+(-1,1.1){curl 1}
+ ..{curl 1}(1,-1)
+
+Path at line 143, after choices:
+(-1,1.1)..controls (-0.33333,0.40001) and (0.33333,-0.3)
+ ..(1,-1)
+
+{(-1)precontrol((0,0))}
+{(path)intersectiontimes((0,0))}
+>> (-1,-1)
+{addto}
+{-(4094.99998)}
+{-(0.00002)}
+Path at line 144, before choices:
+(-4094.99998,0){curl 1}
+ ..{curl 1}(4094.99998,-0.00002)
+
+Path at line 144, after choices:
+(-4094.99998,0)..controls (-1365,0) and (1365,-0.00002)
+ ..(4094.99998,-0.00002)
+
+{pencircle}
+{(0)penoffset(future pen)}
+Pen polygon at line 145 (newly created):
+(0.5,0)
+ .. (0,0.5)
+ .. (-0.5,0)
+ .. (0,-0.5)
+ .. cycle
+
+>> 0
+>> pen
+! Not implemented: penoffset(known numeric)of(pen).
+<to be read again>
+ ;
+l.145 pencircle;
+ addto e3 also e3 shifted (0,257); ,"flushed ...
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+Tracing edges at line 145: (weight 1)
+@ Octant ESE (1 offset), from (-4095.49998,0) to (4094.99998,-0.50002)
+@ transition line 2, from (-4095.49998,0) to (-4094.99998,-0.5)
+@ transition line 1, from (4094.99998,-0.50002) to (4094.99998,-0.50002)
+(-4095,0)
+@ Octant ENE (1 offset), from (4094.99998,-0.50002) to (4095.49998,-0.00
+002)
+@ transition line 0, from (4094.99998,-0.50002) to (4094.99998,-0.50002)
+@ transition line 1, from (4094.99998,-0.50002) to (4095.49998,-0.00002)
+(-4095,-1)(4095,-1)
+@ Octant NNE (0 offsets), from (4095.49998,-0.00002) to (4095.49998,-0.0
+0002)
+@ transition line 1, from (4095.49998,-0.00002) to (4095.49998,-0.00002)
+@ Octant NNW (0 offsets), from (4095.49998,-0.00002) to (4095.49998,-0.0
+0002)
+@ transition line 0, from (4095.49998,-0.00002) to (4095.49998,-0.00002)
+@ Octant WNW (1 offset), from (4095.49998,-0.00002) to (-4094.99998,0.5)
+@ transition line 2, from (4095.49998,-0.00002) to (4094.99998,0.49998)
+@ transition line 1, from (-4094.99998,0.5) to (-4094.99998,0.5)
+(4095,0)(-4095,0)
+@ Octant WSW (1 offset), from (-4094.99998,0.5) to (-4095.49998,0)
+@ transition line 0, from (-4094.99998,0.5) to (-4094.99998,0.5)
+@ transition line 1, from (-4094.99998,0.5) to (-4095.49998,0)
+(-4095,1)
+@ Octant SSW (0 offsets), from (-4095.49998,0) to (-4095.49998,0)
+@ transition line 1, from (-4095.49998,0) to (-4095.49998,0)
+@ Octant SSE (0 offsets), from (-4095.49998,0) to (-4095.49998,0)
+@ transition line 0, from (-4095.49998,0) to (-4095.49998,0)
+(-4095,0).
+
+{addto}
+{(picture)shifted((0,257))}
+! A statement can't begin with `,'.
+<to be read again>
+ ,
+l.145 ...o e3 shifted (0,257); ,
+ "flushed with pride"; numeric...
+I was looking for the beginning of a new statement.
+If you just proceed without changing anything, I'll ignore
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+! Extra tokens will be flushed.
+<to be read again>
+ ,
+l.145 ...o e3 shifted (0,257); ,
+ "flushed with pride"; numeric...
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+{numeric}
+{def}
+
+f(EXPR0)(EXPR1)(EXPR2)->showdependencies;tracingcapsules:=1;showdependen
+cies;show1/3(3,6)*(((EXPR0)+(EXPR1))+((EXPR1)-(EXPR0))),(1,1)/sqrt2zscal
+ed((EXPR0)+1,(EXPR0)+2)-((EXPR0)+1,(EXPR0)+2)rotated45,(0,1)zscaled(1,(E
+XPR1)+2)-(1,(EXPR1)+2)rotated90
+{(xx)+(1)}
+{(xx+1)/(0.3)}
+(EXPR0)<-3.3333xx+3.3333
+{(yy)-(1)}
+{(yy-1)/(0.5)}
+(EXPR1)<-2yy-2
+(EXPR2)<-(xx,0)
+{showdependencies}
+alpha=0.45p3~+7
+{tracingcapsules:=1}
+{showdependencies}
+xpart %CAPSULE1359=xx
+%CAPSULE1367=2yy-2
+%CAPSULE1375 = 3.3333xx+3.3333
+alpha=0.45p3~+7
+{show}
+{(1/3)*((3,6))}
+{(3.3333xx+3.3333)+(2yy-2)}
+{(2yy-2)-(3.3333xx+3.3333)}
+{(linearform)+(linearform)}
+{((1,2))*(4yy-4)}
+>> (4yy-4,8yy-8)
+{sqrt(2)}
+{((1,1))/(1.41422)}
+{(3.3333xx+3.3333)+(1)}
+{(3.3333xx+3.3333)+(2)}
+{((0.7071,0.7071))zscaled((3.3333xx+4.3333,3.3333xx+5.3333))}
+{(3.3333xx+3.3333)+(1)}
+{(3.3333xx+3.3333)+(2)}
+{((3.3333xx+4.3333,3.3333xx+5.3333))rotated(45)}
+{((-0.7071,4.71399xx+6.83531))-((-0.7071,4.71399xx+6.83531))}
+>> (0,0)
+{(2yy-2)+(2)}
+{((0,1))zscaled((1,2yy))}
+{(2yy-2)+(2)}
+{((1,2yy))rotated(90)}
+{((-2yy,1))-((-2yy,1))}
+>> (0,0)
+{(1000)*(o3)}
+{(o1)-(o2)}
+{(4000)*(linearform)}
+{(1000o3)-(linearform)}
+{(4000)*(o2)}
+{(linearform)+(4000o2)}
+{(linearform)+(9)}
+{(0.01)*(o3)}
+{-(0.01o3)}
+{(3)*(ooo)}
+{(-0.01o3)+(3ooo)}
+{begingroup}
+{(o2)+(o4)}
+{(linearform)+(o5)}
+{(linearform)-(20)}
+{(9/10)*(linearform)}
+{(oo)=(linearform)}
+## oo=0.9o5+0.9o4+0.9o2-18
+{(0.5)*(o2)}
+{(o1)+(0.5o2)}
+{(8/9)*(linearform)}
+{(o5)=(linearform)}
+## o5=0.44444o2+0.88889o1
+{(o4)=(linearform)}
+## o4=0.44444o2+0.88889o1
+{(0.0001)*(o2)}
+{-(0.0001o2)}
+{(o6)=(-0.0001o2)}
+## o6=-0.0001o2
+{showdependencies}
+o6=-0.0001o2
+o4=0.44444o2+0.88889o1
+o5=0.44444o2+0.88889o1
+oo=1.7o2+1.6o1-18
+%CAPSULE382 = 3ooo-0.01o3
+xpart %CAPSULE1049 = 8000o2-4000o1+1000o3+9
+xpart %CAPSULE1383=xpart '
+ypart %CAPSULE1383=ypart '
+alpha=0.45p3~+7
+{numeric}
+### 4000o1 = -xpart %CAPSULE1049+8000o2+1000o3+9
+### -4.87383o2 = -oo-0.0004xpart %CAPSULE1049+0.39673o3-17.99643
+#### o6=-0.00027
+### -0.04366o3 = -o4+0.46689oo+8.40439
+### -o4 = -o5
+### 0.22894o5 = -%CAPSULE382+0.10689oo+3ooo+1.92412
+{begingroup}
+{pair}
+### -alfa=-xpart %CAPSULE1494
+{endgroup}
+{xpart((xpart %CAPSULE1494,0))}
+### -xpart %CAPSULE17=-%CAPSULE1176
+{endgroup}
+{(%CAPSULE382)+(%CAPSULE1176)}
+### -%CAPSULE382=-%CAPSULE1893+%CAPSULE1176
+### -%CAPSULE1893=-ypart %CAPSULE1049
+{begingroup}
+{save}
+{(1)-(p$)}
+{restoring p}
+### p$=-ypart %CAPSULE604+1
+{endgroup}
+{(2/3)*((-ypart %CAPSULE604+1,ypart %CAPSULE604))}
+### ypart %CAPSULE604=-xpart %CAPSULE604+1
+### -0.66667xpart %CAPSULE604=-xpart %CAPSULE1889
+{-((xpart %CAPSULE1889,-xpart %CAPSULE1889+0.66667))}
+### xpart %CAPSULE1889=-xpart %CAPSULE1172
+{((xpart %CAPSULE1049,ypart %CAPSULE1049))=((xpart %CAPSULE1172,-xpart %
+CAPSULE1172-0.66667))}
+## xpart %CAPSULE1172=-ypart %CAPSULE1049-0.66667
+## ypart %CAPSULE1049=-xpart %CAPSULE1049-0.66667
+### -xpart %CAPSULE1049=-xpart %CAPSULE1172
+{((xpart ',ypart '))=((xpart %CAPSULE1172,-xpart %CAPSULE1172-0.66667))}
+## xpart %CAPSULE1172=-ypart '-0.66667
+## xpart '=-ypart '-0.66667
+{begingroup}
+{(0.5)*(ooo)}
+{begingroup}
+{numeric}
+### -ooo=-%CAPSULE1494
+{endgroup}
+{(%CAPSULE1494)+(1)}
+### -%CAPSULE1494=-%CAPSULE1350+1
+{(1/2)*(%CAPSULE1350)}
+### -0.5%CAPSULE1350=-%CAPSULE1367
+{-(%CAPSULE1367)}
+### %CAPSULE1367=-%CAPSULE1893
+{(2)*(%CAPSULE1893)}
+### -2%CAPSULE1893=-%CAPSULE1885
+{(-0.5%CAPSULE1885-0.5)=(%CAPSULE1885)}
+## %CAPSULE1885=-0.33333
+{(oo)=(-0.33333)}
+## oo=-0.33333
+{endgroup}
+{(4000)*(-0.33333)}
+{yoffset:=-1333.31299}
+{xoffset:=-1333.31299}
+{for}
+{sqrt(-1)}
+! Square root of -1 has been replaced by 0.
+l.153 for @=angle(sqrt$,
+ mlog$):charext:=uniformdeviate$;charh...
+Since I don't take square roots of negative numbers,
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{mlog(-1)}
+! Logarithm of -1 has been replaced by 0.
+l.153 for @=angle(sqrt$,mlog$)
+ :charext:=uniformdeviate$;charh...
+Since I don't take logs of non-positive numbers,
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{angle((0,0))}
+! angle(0,0) is taken as zero.
+l.153 for @=angle(sqrt$,mlog$):
+ charext:=uniformdeviate$;charh...
+The `angle' between two identical points is undefined.
+I'm zeroing this one. Proceed, with fingers crossed.
+
+Runaway loop?
+charext:=uniformdeviate$;charht:=2048;granularity:=-8; ETC.
+! Forbidden token found while scanning the text of a for loop.
+<inserted text>
+ endfor
+<to be read again>
+ endtext
+l.163 ... showstats; bye endtext
+
+I suspect you have forgotten an `endfor',
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{loop value=0}
+{uniformdeviate(-1)}
+{charext:=-0.00507}
+{charht:=2048}
+{-(8)}
+{granularity:=-8}
+{addto}
+{-(100)}
+{-(99)}
+Path at line 163, before choices:
+(0,-100)..tension 500
+ ..(100,-99)..tension 3000
+ ..cycle
+
+Path at line 163, after choices:
+(0,-100)..controls (-36.92659,-103.51175) and (136.98943,-101.7726)
+ ..(100,-99)..controls (99.9889,-98.99916) and (0.01108,-99.99895)
+ ..cycle
+
+Tracing edges at line 163: (weight 1)
+(-3,-101)(-3,-102)(71,-102)(71,-101)(99,-101)(99,-100)(103,-100)
+(103,-99)(48,-99)(48,-100)(-7,-100)(-7,-101).
+
+{tracingoutput:=0}
+{shipout}
+! Enormous charht has been reduced.
+<to be read again>
+ ;
+<for(0)> ...=(EXPR0);shipout.e3;
+ special"bye";interim.char99="...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.163 ... showstats; bye endtext
+
+Font metric dimensions must be less than 2048pt.
+
+[109]
+{special}
+{interim}
+! The token `char' isn't an internal quantity.
+<to be read again>
+ char
+<for(0)> ...al"bye";interim.char
+ 99="c";true=false;[[clear(tra...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.163 ... showstats; bye endtext
+
+Something like `tracingonline' should follow `interim'.
+
+{char(99)}
+{("c")=("c")}
+! Redundant equation.
+<to be read again>
+ ;
+<for(0)> ...;interim.char99="c";
+ true=false;[[clear(tracingcom...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.163 ... showstats; bye endtext
+
+I already knew that this equation was true.
+But perhaps no harm has been done; let's continue.
+
+{true}
+{false}
+{(true)=(false)}
+! Inconsistent equation.
+<to be read again>
+ ;
+<for(0)> ...ar99="c";true=false;
+ [[clear(tracingcommands);char...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.163 ... showstats; bye endtext
+
+The equation I just read contradicts what was said before.
+But don't worry; continue and I'll just ignore it.
+
+{begingroup}
+
+clear(TEXT0)->interim(TEXT0):=$
+(TEXT0)<-tracingcommands
+{interim}
+{tracingcommands:=-1}
+! Enormous charht has been reduced.
+<to be read again>
+ ;
+<for(0)> ...shipout+nullpicture;
+ "careful"for.for=(EXPR0)step2...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.163 ... showstats; bye endtext
+
+Font metric dimensions must be less than 2048pt.
+
+[0]
+careful METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT M
+ETAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT M
+ETAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT M
+ETAFONT METAFONT METAFONT METAFONT
+{restoring tracingcommands=2.1}
+{endgroup}
+{scrollmode}
+
+{char(31)}
+{("hello again")&("^^_")}
+hello again^^_
+{save}
+### -0.45p3~=-alpha+7
+{-(0.043)}
+{fillin:=-0.043}
+{def}
+{begingroup}
+{tracingspecs:=1}
+{show}
+{nullpen}
+
+>> Pen polygon at line 163:
+(0,0)
+ .. cycle
+
+{makepath(pen)}
+
+>> Path at line 163:
+(1,-2)..controls (1,-2) and (2,-1)
+ ..(2,-1)..controls (2,-1) and (2.5,0.5)
+ ..(2.5,0.5)..controls (2.5,0.5) and (1,2)
+ ..(1,2)..controls (1,2) and (0,2.5)
+ ..(0,2.5)..controls (0,2.5) and (-1,2)
+ ..(-1,2)..controls (-1,2) and (-2,1)
+ ..(-2,1)..controls (-2,1) and (-2.5,-0.5)
+ ..(-2.5,-0.5)..controls (-2.5,-0.5) and (-1,-2)
+ ..(-1,-2)..controls (-1,-2) and (0,-2.5)
+ ..(0,-2.5)..controls (0,-2.5) and (1,-2)
+ ..cycle
+
+{(pen)rotated(1)}
+Pen polygon at line 163 (newly created):
+(0.97366,1.51723)
+ .. cycle
+
+{makepath(pen)}
+
+>> Path at line 163:
+(0.97366,1.51723)..controls (0.97366,1.51723) and (0.97366,1.51723)
+ ..cycle
+
+{pencircle}
+{makepath(future pen)}
+Pen polygon at line 163 (newly created):
+(0.5,-0.5)
+ .. (0.5,0.5)
+ .. (-0.5,0.5)
+ .. (-0.5,-0.5)
+ .. cycle
+
+{(path)rotated(-1)}
+
+>> Path at line 163:
+(0.4912,-0.50865)..controls (0.4912,-0.50865) and (0.50865,0.4912)
+ ..(0.50865,0.4912)..controls (0.50865,0.4912) and (-0.4912,0.50865)
+ ..(-0.4912,0.50865)..controls (-0.4912,0.50865) and (-0.50865,-0.4912)
+ ..(-0.50865,-0.4912)..controls (-0.50865,-0.4912) and (0.4912,-0.50865)
+ ..cycle
+
+{addto}
+Path at line 163, before choices:
+(0,2){0,-4096}
+ ..{0,-4096}(0,1){0,-4096}
+ ..{4096,0}(3,0){4096,0}
+ ..{4096,0}(4,0){4096,0}
+ ..{0,-4096}cycle
+
+Path at line 163, after choices:
+(0,2)..controls (0,1.66667) and (0,1.33333)
+ ..(0,1)..controls (0,-0.20886) and (1.63324,0)
+ ..(3,0)..controls (3.33333,0) and (3.66667,0)
+ ..(4,0)..controls (13.63031,0) and (0,10.64238)
+ ..cycle
+
+Path at line 163, before choices:
+(0,0)
+ ..(5,2.9)
+ ..(4,3)
+ ..cycle
+
+Path at line 163, after choices:
+(0,0)..controls (0.9363,-8.0181) and (11.81119,0.07109)
+ ..(5,2.9)..controls (4.68596,3.03043) and (4.33879,3.02028)
+ ..(4,3)..controls (1.86353,2.87216) and (-0.21431,1.83528)
+ ..cycle
+
+{makepen(path)}
+Pen polygon at line 163 (newly created):
+(5,2.9)
+ .. (4,3)
+ .. (0,0)
+ .. cycle
+
+Path at line 163, before subdivision into octants:
+(0,2)..controls (0,1.66667) and (0,1.33333)
+ ..(0,1)..controls (0,-0.20886) and (1.63324,0)
+ ..(3,0)..controls (3.33333,0) and (3.66667,0)
+ ..(4,0)..controls (13.63031,0) and (0,10.64238)
+ ..cycle
+
+Cycle spec at line 163, after subdivision and double autorounding:
+(1.5,0.00272) % beginning in octant `SSE'
+ ..controls (1.5,-0.49254) and (1.63411,-0.82727)
+ ..(1.8592,-1.05237) % segment 1
+% entering octant `ESE'
+ ..controls (2.23936,-1.43253) and (2.87909,-1.5)
+ ..(3.57066,-1.5) % segment 1
+% entering octant `ENE'
+ ..controls (3.95114,-1.5) and (4.3473,-1.47957)
+ ..(4.72458,-1.47957) % segment 1
+ ..controls (5.08287,-1.47957) and (5.44116,-1.47957)
+ ..(5.79944,-1.47957) % segment 2
+ ..controls (7.35368,-1.47957) and (8.34424,-1.12393)
+ ..(8.90538,-0.56279) % segment 3
+% entering octant `NNE'
+ ..controls (9.31982,-0.14835) and (9.5,0.37819)
+ ..(9.5,0.95631) % segment 3
+% entering octant `NNW'
+ ..controls (9.5,2.00116) and (8.61821,3.4318)
+ ..(7.41951,4.6305) % segment 3
+% entering octant `WNW'
+ ..controls (6.32909,5.72092) and (5.11603,6.5)
+ ..(4.2104,6.5) % segment 3
+% entering octant `WSW'
+ ..controls (3.64668,6.5) and (3.12122,6.31134)
+ ..(2.68588,5.876) % segment 3
+% entering octant `SSW'
+ ..controls (1.97163,5.16176) and (1.5,3.78351)
+ ..(1.5,1.485) % segment 3
+ ..controls (1.5,0.99092) and (1.5,0.49681)
+ ..(1.5,0.00272) % segment 0
+ & cycle
+
+Tracing edges at line 163: (weight 1)
+@ Octant SSE (0 offsets), from (1.5,0.00272) to (1.8592,-1.05237)
+@ transition line 0, from (1.5,0.00272) to (1.5,0.00272)
+(2,0)
+@ Octant ESE (0 offsets), from (1.8592,-1.05237) to (3.57066,-1.5)
+@ transition line 1, from (3.57066,-1.5) to (3.57066,-1.5)
+@ Octant ENE (2 offsets), from (3.57066,-1.5) to (13.90538,2.3372)
+@ transition line 0, from (3.57066,-1.5) to (3.57066,-1.5)
+@ transition line 1, from (8.41534,-0.93503) to (13.41534,1.96497)
+@ transition line 2, from (13.90538,2.3372) to (13.90538,2.3372)
+(2,-1)(9,-1)(9,0)(11,0)(11,1)(13,1)
+@ Octant NNE (0 offsets), from (13.90538,2.3372) to (14.5,3.85631)
+@ transition line 1, from (14.5,3.85631) to (14.5,3.85631)
+(13,2)(14,2)
+@ Octant NNW (0 offsets), from (14.5,3.85631) to (12.41951,7.53049)
+@ transition line 0, from (14.5,3.85631) to (14.5,3.85631)
+(14,6)(13,6)(13,7)(12,7)
+@ Octant WNW (2 offsets), from (12.41951,7.53049) to (8.2104,9.5)
+@ transition line 3, from (12.41951,7.53049) to (12.41951,7.53049)
+@ transition line 2, from (9.38113,9.39124) to (8.38113,9.49124)
+@ transition line 1, from (8.2104,9.5) to (8.2104,9.5)
+(12,8)(11,8)(11,9)(8,9)
+@ Octant WSW (2 offsets), from (8.2104,9.5) to (2.68588,5.876)
+@ transition line 0, from (8.2104,9.5) to (8.2104,9.5)
+@ transition line 1, from (6.92668,9.08539) to (2.92668,6.08539)
+@ transition line 2, from (2.68588,5.876) to (2.68588,5.876)
+(8,10)(8,9)(6,9)(6,8)(5,8)(5,7)(3,7)
+@ Octant SSW (0 offsets), from (2.68588,5.876) to (1.5,0.00272)
+@ transition line 1, from (1.5,0.00272) to (1.5,0.00272)
+(3,6)(2,6)(2,0).
+
+Path at line 163, before subdivision into octants:
+(0,2)..controls (0,10.64238) and (13.63031,0)
+ ..(4,0)..controls (3.66667,0) and (3.33333,0)
+ ..(3,0)..controls (1.63324,0) and (0,-0.20886)
+ ..(0,1)..controls (0,1.33333) and (0,1.66667)
+ ..cycle
+
+Cycle spec at line 163, after subdivision and double autorounding:
+(2.68588,5.876) % beginning in octant `ENE'
+ ..controls (3.12122,6.31134) and (3.64668,6.5)
+ ..(4.2104,6.5) % segment 0
+% entering octant `ESE'
+ ..controls (5.11603,6.5) and (6.32909,5.72092)
+ ..(7.41953,4.63048) % segment 0
+% entering octant `SSE'
+ ..controls (8.61824,3.43176) and (9.5,2.00116)
+ ..(9.5,0.95631) % segment 0
+% entering octant `SSW'
+ ..controls (9.5,0.37819) and (9.31982,-0.14835)
+ ..(8.90538,-0.56279) % segment 0
+% entering octant `WSW'
+ ..controls (8.34425,-1.12392) and (7.35368,-1.47957)
+ ..(5.79944,-1.47957) % segment 0
+ ..controls (5.44116,-1.47957) and (5.08287,-1.47957)
+ ..(4.72458,-1.47957) % segment 1
+ ..controls (4.3473,-1.47957) and (3.95114,-1.5)
+ ..(3.57066,-1.5) % segment 2
+% entering octant `WNW'
+ ..controls (2.87909,-1.5) and (2.23936,-1.43253)
+ ..(1.85919,-1.05235) % segment 2
+% entering octant `NNW'
+ ..controls (1.6341,-0.82726) and (1.5,-0.49254)
+ ..(1.5,0.00272) % segment 2
+% entering octant `NNE'
+ ..controls (1.5,0.49681) and (1.5,0.99092)
+ ..(1.5,1.485) % segment 3
+ ..controls (1.5,3.78351) and (1.97165,5.16177)
+ ..(2.68588,5.876) % segment 0
+ & cycle
+
+Tracing edges at line 163: (weight 1)
+@ Octant ENE (2 offsets), from (7.68588,8.776) to (4.2104,6.5)
+@ retrograde line from (7.68588,8.776) to (2.68588,5.876)
+(7,9)(7,8)(5,8)(5,7)(4,7)
+@ transition line 0, from (2.68588,5.876) to (2.68588,5.876)
+@ transition line 1, from (2.68588,5.876) to (7.68588,8.776)
+@ transition line 2, from (8.13123,9.12088) to (3.13123,6.22089)
+@ transition line 1, from (4.2104,6.5) to (9.2104,9.4)
+@ transition line 2, from (9.2104,9.4) to (9.2104,9.4)
+(4,6)(4,7)(6,7)(6,8)(8,8)
+@ retrograde line from (9.2104,9.4) to (4.2104,6.5)
+(8,9)(8,8)(6,8)
+@ Octant ESE (0 offsets), from (4.2104,6.5) to (7.41953,4.63048)
+@ transition line 1, from (7.41953,4.63048) to (7.41953,4.63048)
+(6,7)(4,7)(4,6)(6,6)
+@ Octant SSE (0 offsets), from (7.41953,4.63048) to (9.5,0.95631)
+@ transition line 0, from (7.41953,4.63048) to (7.41953,4.63048)
+(6,5)(8,5)(8,3)(9,3)
+@ Octant SSW (0 offsets), from (9.5,0.95631) to (8.90538,-0.56279)
+@ transition line 1, from (8.90538,-0.56279) to (8.90538,-0.56279)
+@ Octant WSW (2 offsets), from (8.90538,-0.56279) to (7.57066,1.5)
+@ retrograde line from (8.90538,-0.56279) to (12.90538,2.43721)
+(9,-1)(9,0)(10,0)(10,1)(12,1)
+@ transition line 0, from (12.90538,2.43721) to (12.90538,2.43721)
+@ transition line 1, from (12.90538,2.43721) to (8.90538,-0.56279)
+@ transition line 2, from (8.6665,-0.76936) to (12.6665,2.23064)
+@ transition line 1, from (7.57066,1.5) to (3.57066,-1.5)
+@ transition line 2, from (3.57066,-1.5) to (3.57066,-1.5)
+(12,2)(8,2)(8,1)(6,1)(6,0)(5,0)
+@ retrograde line from (3.57066,-1.5) to (7.57066,1.5)
+(5,-1)(5,0)(6,0)(6,1)(8,1)
+@ Octant WNW (2 offsets), from (7.57066,1.5) to (6.85919,1.84764)
+@ retrograde line from (7.57066,1.5) to (8.57066,1.4)
+(8,2)
+@ transition line 3, from (8.57066,1.4) to (8.57066,1.4)
+@ transition line 2, from (8.57066,1.4) to (7.57066,1.5)
+@ transition line 1, from (6.95764,1.52585) to (7.95764,1.42584)
+@ transition line 2, from (6.85919,1.84764) to (5.85919,1.94765)
+@ transition line 1, from (5.85919,1.94765) to (5.85919,1.94765)
+(8,1)
+@ retrograde line from (5.85919,1.94765) to (6.85919,1.84764)
+@ Octant NNW (0 offsets), from (6.85919,1.84764) to (6.5,2.90271)
+@ transition line 0, from (6.85919,1.84764) to (6.85919,1.84764)
+(8,2)(7,2)
+@ Octant NNE (0 offsets), from (6.5,2.90271) to (7.68588,8.776)
+@ transition line 1, from (7.68588,8.776) to (7.68588,8.776)
+(7,9).
+
+{tracingonline:=1}
+
+f<expr>->let)=];let[=(;show._
+(EXPR0)<-xx
+{let}
+{let}
+{show}
+>> _1
+{showdependencies}
+xpart '=-ypart '-0.66667
+{qq:=pen}
+{showstats}
+Memory usage 1476&588 (104 still untouched)
+String usage 42&168 (1818&17726 still untouched)
+{[repeat the loop]}
+! A group begun on line 163 never ended.
+<to be read again>
+ endtext
+l.163 ... showstats; bye endtext
+
+I saw a `begingroup' back there that hasn't been matched
+by `endgroup'. So I've inserted `endgroup' now.
+
+{endgroup}
+ )
+(end occurred when else on line 93 was incomplete)
+(end occurred when if on line 36 was incomplete)
+(end occurred when elseif on line 21 was incomplete)
+Here is how much of METAFONT's memory you used:
+ 69 strings out of 1887
+ 3759 string characters out of 21485
+ 2897 words of memory out of 3001
+ 289 symbolic tokens out of 2100
+ 8i,43n,14r,8p,167b stack positions out of 30i,100n,300r,150p,500b
+
+(illegal design size has been changed to 128pt)
+(some chardp values had to be adjusted by as much as 0.5pt)
+(local label 0:: was missing)
+(local label 5:: was missing)
+(4 font metric dimensions had to be decreased)
+(You used 3w,2h,16d,2i,312l,301k,1e,10p metric file positions
+ out of 256w,16h,16d,64i,5000l,500k,256e,50p)
+
+Font metrics written on trap.tfm.
+Output written on trap.72270gf (5 characters, 1028 bytes).
diff --git a/Build/source/texk/web2c/triptrap/mftrap.pl b/Build/source/texk/web2c/triptrap/mftrap.pl
new file mode 100644
index 00000000000..bae32a41fb4
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mftrap.pl
@@ -0,0 +1,490 @@
+(CODINGSCHEME Q)
+(DESIGNSIZE R 128.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM O 5546464252)
+(FONTDIMEN
+ (SLANT R 2047.999999)
+ (SPACE R 0.0)
+ (STRETCH R 0.0)
+ (SHRINK R 0.0)
+ (XHEIGHT R 0.0)
+ (QUAD R 0.0)
+ (EXTRASPACE R 0.0)
+ (PARAMETER D 8 R 0.0)
+ (PARAMETER D 9 R 0.005208)
+ (PARAMETER D 10 R 0.0)
+ )
+(BOUNDARYCHAR O 377)
+(LIGTABLE
+ (COMMENT THIS PART OF THE PROGRAM IS NEVER USED!
+ )
+ (LABEL BOUNDARYCHAR)
+ (/LIG/>> O 377 O 0)
+ (KRN O 0 R 0.0)
+ (KRN O 0 R 0.0078125)
+ (KRN O 0 R 0.015625)
+ (KRN O 0 R 0.0234375)
+ (KRN O 0 R 0.03125)
+ (KRN O 0 R 0.0390625)
+ (KRN O 0 R 0.046875)
+ (KRN O 0 R 0.0546875)
+ (KRN O 0 R 0.0625)
+ (KRN O 0 R 0.0703125)
+ (KRN O 0 R 0.078125)
+ (KRN O 0 R 0.0859375)
+ (KRN O 0 R 0.09375)
+ (KRN O 0 R 0.1015625)
+ (KRN O 0 R 0.109375)
+ (KRN O 0 R 0.1171875)
+ (KRN O 0 R 0.125)
+ (KRN O 0 R 0.1328125)
+ (KRN O 0 R 0.140625)
+ (KRN O 0 R 0.1484375)
+ (KRN O 0 R 0.15625)
+ (KRN O 0 R 0.1640625)
+ (KRN O 0 R 0.171875)
+ (KRN O 0 R 0.1796875)
+ (KRN O 0 R 0.1875)
+ (KRN O 0 R 0.1953125)
+ (KRN O 0 R 0.203125)
+ (KRN O 0 R 0.2109375)
+ (KRN O 0 R 0.21875)
+ (KRN O 0 R 0.2265625)
+ (KRN O 0 R 0.234375)
+ (KRN O 0 R 0.2421875)
+ (KRN O 0 R 0.25)
+ (KRN O 0 R 0.2578125)
+ (KRN O 0 R 0.265625)
+ (KRN O 0 R 0.2734375)
+ (KRN O 0 R 0.28125)
+ (KRN O 0 R 0.2890625)
+ (KRN O 0 R 0.296875)
+ (KRN O 0 R 0.3046875)
+ (KRN O 0 R 0.3125)
+ (KRN O 0 R 0.3203125)
+ (KRN O 0 R 0.328125)
+ (KRN O 0 R 0.3359375)
+ (KRN O 0 R 0.34375)
+ (KRN O 0 R 0.3515625)
+ (KRN O 0 R 0.359375)
+ (KRN O 0 R 0.3671875)
+ (KRN O 0 R 0.375)
+ (KRN O 0 R 0.3828125)
+ (KRN O 0 R 0.390625)
+ (KRN O 0 R 0.3984375)
+ (KRN O 0 R 0.40625)
+ (KRN O 0 R 0.4140625)
+ (KRN O 0 R 0.421875)
+ (KRN O 0 R 0.4296875)
+ (KRN O 0 R 0.4375)
+ (KRN O 0 R 0.4453125)
+ (KRN O 0 R 0.453125)
+ (KRN O 0 R 0.4609375)
+ (SKIP D 1)
+ (LABEL C g)
+ (LIG/ C g O 0)
+ (STOP)
+ (KRN O 0 R 0.400782)
+ (KRN O 0 R 0.408594)
+ (KRN O 0 R 0.416407)
+ (KRN O 0 R 0.424219)
+ (KRN O 0 R 0.432032)
+ (KRN O 0 R 0.439844)
+ (KRN O 0 R 0.447657)
+ (KRN O 0 R 0.455469)
+ (KRN O 0 R 0.463282)
+ (KRN O 0 R 0.471094)
+ (KRN O 0 R 0.478907)
+ (KRN O 0 R 0.486719)
+ (KRN O 0 R 0.494532)
+ (KRN O 0 R 0.502344)
+ (KRN O 0 R 0.510157)
+ (KRN O 0 R 0.517969)
+ (KRN O 0 R 0.525782)
+ (KRN O 0 R 0.533594)
+ (KRN O 0 R 0.541407)
+ (KRN O 0 R 0.549219)
+ (KRN O 0 R 0.557032)
+ (KRN O 0 R 0.564844)
+ (KRN O 0 R 0.572657)
+ (KRN O 0 R 0.580469)
+ (KRN O 0 R 0.588282)
+ (KRN O 0 R 0.596094)
+ (KRN O 0 R 0.603907)
+ (KRN O 0 R 0.611719)
+ (KRN O 0 R 0.619532)
+ (KRN O 0 R 0.627344)
+ (KRN O 0 R 0.635157)
+ (KRN O 0 R 0.642969)
+ (KRN O 0 R 0.650782)
+ (KRN O 0 R 0.658594)
+ (KRN O 0 R 0.666407)
+ (KRN O 0 R 0.674219)
+ (KRN O 0 R 0.682032)
+ (KRN O 0 R 0.689844)
+ (KRN O 0 R 0.697657)
+ (KRN O 0 R 0.705469)
+ (KRN O 0 R 0.713282)
+ (KRN O 0 R 0.721094)
+ (KRN O 0 R 0.728907)
+ (KRN O 0 R 0.736719)
+ (KRN O 0 R 0.744532)
+ (KRN O 0 R 0.752344)
+ (KRN O 0 R 0.760157)
+ (KRN O 0 R 0.767969)
+ (KRN O 0 R 0.775782)
+ (KRN O 0 R 0.783594)
+ (KRN O 0 R 0.791407)
+ (KRN O 0 R 0.799219)
+ (KRN O 0 R 0.807032)
+ (KRN O 0 R 0.814844)
+ (KRN O 0 R 0.822657)
+ (KRN O 0 R 0.830469)
+ (KRN O 0 R 0.838282)
+ (KRN O 0 R 0.846094)
+ (KRN O 0 R 0.853907)
+ (KRN O 0 R 0.861719)
+ (SKIP D 1)
+ (LABEL C h)
+ (LABEL C i)
+ (/LIG C i O 0)
+ (STOP)
+ (KRN O 0 R 0.801562)
+ (KRN O 0 R 0.809375)
+ (KRN O 0 R 0.817187)
+ (KRN O 0 R 0.825)
+ (KRN O 0 R 0.832812)
+ (KRN O 0 R 0.840625)
+ (KRN O 0 R 0.848437)
+ (KRN O 0 R 0.85625)
+ (KRN O 0 R 0.864062)
+ (KRN O 0 R 0.871875)
+ (KRN O 0 R 0.879687)
+ (KRN O 0 R 0.8875)
+ (KRN O 0 R 0.895312)
+ (KRN O 0 R 0.903125)
+ (KRN O 0 R 0.910937)
+ (KRN O 0 R 0.91875)
+ (KRN O 0 R 0.926562)
+ (KRN O 0 R 0.934375)
+ (KRN O 0 R 0.942187)
+ (KRN O 0 R 0.95)
+ (KRN O 0 R 0.957812)
+ (KRN O 0 R 0.965625)
+ (KRN O 0 R 0.973437)
+ (KRN O 0 R 0.98125)
+ (KRN O 0 R 0.989062)
+ (KRN O 0 R 0.996875)
+ (KRN O 0 R 1.004687)
+ (KRN O 0 R 1.0125)
+ (KRN O 0 R 1.020312)
+ (KRN O 0 R 1.028125)
+ (KRN O 0 R 1.035937)
+ (KRN O 0 R 1.04375)
+ (KRN O 0 R 1.051562)
+ (KRN O 0 R 1.059375)
+ (KRN O 0 R 1.067187)
+ (KRN O 0 R 1.075)
+ (KRN O 0 R 1.082812)
+ (KRN O 0 R 1.090625)
+ (KRN O 0 R 1.098437)
+ (KRN O 0 R 1.10625)
+ (KRN O 0 R 1.114062)
+ (KRN O 0 R 1.121875)
+ (KRN O 0 R 1.129687)
+ (KRN O 0 R 1.1375)
+ (KRN O 0 R 1.145312)
+ (KRN O 0 R 1.153125)
+ (KRN O 0 R 1.160937)
+ (KRN O 0 R 1.16875)
+ (KRN O 0 R 1.176562)
+ (KRN O 0 R 1.184375)
+ (KRN O 0 R 1.192187)
+ (KRN O 0 R 1.2)
+ (KRN O 0 R 1.207812)
+ (KRN O 0 R 1.215625)
+ (KRN O 0 R 1.223437)
+ (KRN O 0 R 1.23125)
+ (KRN O 0 R 1.239062)
+ (KRN O 0 R 1.246875)
+ (KRN O 0 R 1.254687)
+ (KRN O 0 R 1.2625)
+ (SKIP D 1)
+ (LABEL C j)
+ (/LIG> C j O 0)
+ (SKIP D 123)
+ (KRN O 0 R 1.202344)
+ (KRN O 0 R 1.210156)
+ (KRN O 0 R 1.217969)
+ (KRN O 0 R 1.225781)
+ (KRN O 0 R 1.233594)
+ (KRN O 0 R 1.241406)
+ (KRN O 0 R 1.249219)
+ (KRN O 0 R 1.257031)
+ (KRN O 0 R 1.264844)
+ (KRN O 0 R 1.272656)
+ (KRN O 0 R 1.280469)
+ (KRN O 0 R 1.288281)
+ (KRN O 0 R 1.296094)
+ (KRN O 0 R 1.303906)
+ (KRN O 0 R 1.311719)
+ (KRN O 0 R 1.319531)
+ (KRN O 0 R 1.327344)
+ (KRN O 0 R 1.335156)
+ (KRN O 0 R 1.342969)
+ (KRN O 0 R 1.350781)
+ (KRN O 0 R 1.358594)
+ (KRN O 0 R 1.366406)
+ (KRN O 0 R 1.374219)
+ (KRN O 0 R 1.382031)
+ (KRN O 0 R 1.389844)
+ (KRN O 0 R 1.397656)
+ (KRN O 0 R 1.405469)
+ (KRN O 0 R 1.413281)
+ (KRN O 0 R 1.421094)
+ (KRN O 0 R 1.428906)
+ (KRN O 0 R 1.436719)
+ (KRN O 0 R 1.444531)
+ (KRN O 0 R 1.452344)
+ (KRN O 0 R 1.460156)
+ (KRN O 0 R 1.467969)
+ (KRN O 0 R 1.475781)
+ (KRN O 0 R 1.483594)
+ (KRN O 0 R 1.491406)
+ (KRN O 0 R 1.499219)
+ (KRN O 0 R 1.507031)
+ (KRN O 0 R 1.514844)
+ (KRN O 0 R 1.522656)
+ (KRN O 0 R 1.530469)
+ (KRN O 0 R 1.538281)
+ (KRN O 0 R 1.546094)
+ (KRN O 0 R 1.553906)
+ (KRN O 0 R 1.561719)
+ (KRN O 0 R 1.569531)
+ (KRN O 0 R 1.577344)
+ (KRN O 0 R 1.585156)
+ (KRN O 0 R 1.592969)
+ (KRN O 0 R 1.600781)
+ (KRN O 0 R 1.608594)
+ (KRN O 0 R 1.616406)
+ (KRN O 0 R 1.624219)
+ (KRN O 0 R 1.632031)
+ (KRN O 0 R 1.639844)
+ (KRN O 0 R 1.647656)
+ (KRN O 0 R 1.655469)
+ (KRN O 0 R 1.663281)
+ (SKIP D 1)
+ (LABEL C k)
+ (LIG/> C k O 0)
+ (SKIP D 62)
+ (KRN O 0 R 1.603125)
+ (KRN O 0 R 1.610937)
+ (KRN O 0 R 1.61875)
+ (KRN O 0 R 1.626562)
+ (KRN O 0 R 1.634375)
+ (KRN O 0 R 1.642187)
+ (KRN O 0 R 1.65)
+ (KRN O 0 R 1.657812)
+ (KRN O 0 R 1.665625)
+ (KRN O 0 R 1.673437)
+ (KRN O 0 R 1.68125)
+ (KRN O 0 R 1.689062)
+ (KRN O 0 R 1.696875)
+ (KRN O 0 R 1.704687)
+ (KRN O 0 R 1.7125)
+ (KRN O 0 R 1.720312)
+ (KRN O 0 R 1.728125)
+ (KRN O 0 R 1.735937)
+ (KRN O 0 R 1.74375)
+ (KRN O 0 R 1.751562)
+ (KRN O 0 R 1.759375)
+ (KRN O 0 R 1.767187)
+ (KRN O 0 R 1.775)
+ (KRN O 0 R 1.782812)
+ (KRN O 0 R 1.790625)
+ (KRN O 0 R 1.798437)
+ (KRN O 0 R 1.80625)
+ (KRN O 0 R 1.814062)
+ (KRN O 0 R 1.821875)
+ (KRN O 0 R 1.829687)
+ (KRN O 0 R 1.8375)
+ (KRN O 0 R 1.845312)
+ (KRN O 0 R 1.853125)
+ (KRN O 0 R 1.860937)
+ (KRN O 0 R 1.86875)
+ (KRN O 0 R 1.876562)
+ (KRN O 0 R 1.884375)
+ (KRN O 0 R 1.892187)
+ (KRN O 0 R 1.9)
+ (KRN O 0 R 1.907812)
+ (KRN O 0 R 1.915625)
+ (KRN O 0 R 1.923437)
+ (KRN O 0 R 1.93125)
+ (KRN O 0 R 1.939062)
+ (KRN O 0 R 1.946875)
+ (KRN O 0 R 1.954687)
+ (KRN O 0 R 1.9625)
+ (KRN O 0 R 1.970312)
+ (KRN O 0 R 1.978125)
+ (KRN O 0 R 1.985937)
+ (KRN O 0 R 1.99375)
+ (KRN O 0 R 2.001562)
+ (KRN O 0 R 2.009375)
+ (KRN O 0 R 2.017187)
+ (KRN O 0 R 2.025)
+ (KRN O 0 R 2.032812)
+ (KRN O 0 R 2.040625)
+ (KRN O 0 R 2.048437)
+ (KRN O 0 R 2.05625)
+ (KRN O 0 R 2.064062)
+ (STOP)
+ (LABEL C l)
+ (/LIG/> C l O 0)
+ (SKIP D 1)
+ (LABEL C m)
+ (LIG O 0 O 0)
+ (STOP)
+ (LIG C a C b)
+ (KRN C d R -15.999999)
+ (LABEL C c)
+ (LABEL C d)
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ (STOP)
+ (COMMENT THIS PART OF THE PROGRAM IS NEVER USED!
+ )
+ )
+(CHARACTER O 0
+ (CHARWD R 2.0)
+ (CHARHT R 15.999999)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ (NEXTLARGER O 5)
+ )
+(CHARACTER O 5
+ (CHARWD R 0.0)
+ (CHARDP R -0.113281)
+ (VARCHAR
+ (TOP O 5)
+ (MID C c)
+ (REP C d)
+ )
+ )
+(CHARACTER O 33
+ (CHARWD R 0.0)
+ (CHARDP R 0.2109375)
+ )
+(CHARACTER O 137
+ (CHARWD R 0.0)
+ (CHARDP R 0.1015625)
+ )
+(CHARACTER O 140
+ (CHARWD R 0.0)
+ (CHARDP R 0.089844)
+ )
+(CHARACTER C a
+ (CHARWD R 0.0)
+ (NEXTLARGER C d)
+ )
+(CHARACTER C b
+ (CHARWD R 0.0)
+ (CHARDP R 0.1640625)
+ )
+(CHARACTER C c
+ (CHARWD R 0.0)
+ (CHARDP R -0.011719)
+ (COMMENT
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C d
+ (CHARWD R 0.0)
+ (CHARDP R 0.1328125)
+ (COMMENT
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C e
+ (CHARWD R 0.0)
+ (CHARDP R 0.089844)
+ )
+(CHARACTER C f
+ (CHARWD R 0.0)
+ (CHARDP R 0.0234375)
+ )
+(CHARACTER C g
+ (CHARWD R 0.0)
+ (CHARDP R -0.011719)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (LIG/ C g O 0)
+ )
+ )
+(CHARACTER C h
+ (CHARWD R 0.0)
+ (CHARDP R 0.1953125)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (/LIG C i O 0)
+ )
+ )
+(CHARACTER C i
+ (CHARWD R 0.0)
+ (CHARDP R 0.2421875)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (/LIG C i O 0)
+ )
+ )
+(CHARACTER C j
+ (CHARWD R 0.0)
+ (CHARDP R 0.1484375)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (/LIG> C j O 0)
+ (LIG C a C b)
+ (KRN C d R -15.999999)
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C k
+ (CHARWD R 0.0)
+ (CHARDP R 0.0546875)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (LIG/> C k O 0)
+ (LIG C a C b)
+ (KRN C d R -15.999999)
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C l
+ (CHARWD R 2.0)
+ (CHARDP R 0.1796875)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (/LIG/> C l O 0)
+ (LIG C a C b)
+ (KRN C d R -15.999999)
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C m
+ (CHARWD R 2.0)
+ (CHARHT R 15.999999)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (LIG O 0 O 0)
+ )
+ )
+(CHARACTER O 354
+ (CHARWD R 0.0)
+ (CHARDP R -15.999999)
+ )
diff --git a/Build/source/texk/web2c/triptrap/mftrap1.in b/Build/source/texk/web2c/triptrap/mftrap1.in
new file mode 100644
index 00000000000..1e7b96cab35
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mftrap1.in
@@ -0,0 +1,3 @@
+
+\input trap
+
diff --git a/Build/source/texk/web2c/triptrap/mftrap2.in b/Build/source/texk/web2c/triptrap/mftrap2.in
new file mode 100644
index 00000000000..d3dba8ac65d
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mftrap2.in
@@ -0,0 +1 @@
+ &trap trap
diff --git a/Build/source/texk/web2c/triptrap/mftrapin.log b/Build/source/texk/web2c/triptrap/mftrapin.log
new file mode 100644
index 00000000000..f7740f9de91
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mftrapin.log
@@ -0,0 +1,179 @@
+This is METAFONT, Version 2.71828 (INIMF) 23 DEC 2002 11:57
+**\input trap
+(trap.mf
+>> << == >> ::: ||`` ''--!! ??## && @@ $$[[]]{{ }}((5.5 0.5))
+>> ".."
+! Not implemented: (unknown numeric)++(string).
+<to be read again>
+ ;
+l.4 ...}} . (( 5.5.5 )) ++ "..";
+
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+..
+! Missing `=' has been inserted.
+<to be read again>
+ ,
+l.5 begingroup save =; let=,
+ ; save,; newinternal $=,; let )...
+You should have said `let symbol = something'.
+But don't worry; I'll pretend that an equals sign
+was present. The next token I read will be `something'.
+
+> errorstopmode=errorstopmode
+> readstring=readstring
+> 2
+> "2"
+> ,=,
+> (=tag
+> )=,
+<< == >> ::: ||`` ''--!! ??## && @@ $$[[]]{{ }}(([][]))=numeric
+<< == >> ::: ||`` ''--!! ??## && @@ $$[[]]{{ }}((5.5 0.5))=<< == >> :::
+||`` ''--!! ??## && @@ $$[[]]{{ }}((5.5 0.5))
+> year=month
+! OK.
+l.6 ...ring,2,"2",,,(,),<<,year;
+
+
+! Missing `:' has been inserted.
+<to be read again>
+ ;
+l.8 ...not cycle "":1.1 forever;
+ fi;
+The next thing in this loop should have been a `:'.
+So I'll pretend that a colon was present;
+everything from here to `endfor' will be iterated.
+
+{fi}
+{exitif}
+{[repeat the loop]}
+{false}
+{fi}
+{exitif}
+{[repeat the loop]}
+{(2.1)>(2)}
+{true}
+{tracingcommands:=2.1}
+{showtoken}
+> |=:|>=|=:|>
+! OK.
+l.9 ... endfor; showtoken |=:|>;
+
+
+! Arithmetic overflow.
+l.10 tracingedges:=1/.00001
+ ; tracingequations:=$+1; p~=trac...
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+{tracingedges:=32767.99998}
+{(0)+(1)}
+{tracingequations:=1}
+{(32767.99998)+(0.00002)}
+! Arithmetic overflow.
+l.10 ... p~=tracingedges+.00001;
+
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+{(p~)=(32767.99998)}
+## p~=32767.99998
+{interim}
+{tracingmacros:=1}
+{tracingoutput:=1}
+{warningcheck:=1}
+{tracingstats:=1}
+{tracingchoices:=1}
+{tracingpens:=1}
+{tracingspecs:=1}
+{ASCII("")}
+{$:=-1}
+{$:=x}
+>> x
+! Internal quantity `$' must receive a known value.
+<to be read again>
+ ;
+l.12 ...os:=1; $:=ASCII""; $:=x;
+ p~:=p~;
+I can't set an internal quantity to anything but a known
+numeric value, so I'll have to ignore this assignment.
+
+{p~:=32767.99998}
+## p~=32767.99998
+! Value is too large (32767.99998).
+l.12 ...:=ASCII""; $:=x; p~:=p~;
+
+The equation I just processed has given some variable
+a value of 4096 or more. Continue and I'll try to cope
+with that big value; but it might be dangerous.
+(Set warningcheck:=0 to suppress this message.)
+
+{delimiters}
+{delimiters}
+{vardef}
+{def}
+
+foo(TEXT2)->begingroup(TEXT2)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-foo
+(TEXT2)<-interim.proofing:=(-0.5;shipout.nullpicture;special"3"
+{begingroup}
+{interim}
+{-(0.5)}
+! Missing `)' has been inserted.
+<to be read again>
+ ;
+<argument> ...m.proofing:=(-0.5;
+ shipout.nullpicture;special"3"
+foo->begingroup(TEXT2)
+ endgroup
+l.16 ...ture; special"3" endtext
+ ;
+I found no right delimiter to match a left one. So I've
+put one in, behind the scenes; this may fix the problem.
+
+{proofing:=-0.5}
+{shipout}
+{nullpicture}
+{special}
+{restoring proofing=0}
+{endgroup}
+{for}
+{showstats}
+Memory usage 291&41 (1922 still untouched)
+String usage 26&83 (1895&21534 still untouched)
+! OK.
+l.17 ...ing:fi endfor showstats;
+ let!!=skipto;
+
+{let}
+{path}
+{-(15)}
+{-(12)}
+Path at line 18, before choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+
+Path at line 18, after choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+
+{(unknown path p~)=(path)}
+{everyjob}
+{vardef}
+{let}
+{vardef}
+{def}
+{elseif}
+ )
+Beginning to dump on file trap.base
+ (preloaded base=trap 98.8.8)
+1113 strings of total length 20515
+395 memory locations dumped; current usage is 317&67
+265 symbolic tokens
diff --git a/Build/source/texk/web2c/triptrap/mptrap.diffs b/Build/source/texk/web2c/triptrap/mptrap.diffs
new file mode 100644
index 00000000000..cf317039f39
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mptrap.diffs
@@ -0,0 +1,621 @@
+make[1]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c'
+cd lib && make -w CC='gcc' CFLAGS='-g ' LDFLAGS=''
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+make[2]: Nothing to be done for `default'.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' fixwrites
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `fixwrites' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' splitup
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `splitup' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' web2c
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `web2c' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+rm -f mtrap.mp mtrap.mem trapf.tfm
+rm -f mtrap.log mtrap.0 mtrap.1 writeo writeo.log writeo.2
+rm -f trap.mp trap.mpx mptrapin.fot mptrapin.log
+rm -f mptrap.fot mptrap.log mptrap.tfm
+rm -f trap.ps trap.mem trap.0 trap.5 trap.6 trap.95 trap.96 trap.97
+rm -f trap.98 trap.99 trap.100 trap.101 trap.102 trap.103 trap.104
+rm -f trap.105 trap.106 trap.107 trap.108 trap.109 trap.148
+rm -f trap.149 trap.150 trap.151 trap.197 trap.200
+rm -f mptrap.pl
+ln -s ./triptrap/mtrap.mp . # get same filename in log
+./pltotf ./triptrap/trapf.pl trapf.tfm
+/bin/sh -c 'TEXMFCNF=./triptrap ./mpost --progname=inimpost mtrap'
+This is MetaPost, Version 0.901 (Web2C 7.5.5) (INIMP)
+(mtrap.mp
+diff ./triptrap/mtrap.log mtrap.log
+1,2c1,2
+< This is MetaPost, C Version 0.64 (INIMP) 28 JAN 1998 11:18
+< **mtrap
+---
+> This is MetaPost, Version 0.901 (Web2C 7.5.5) (INIMP) 3 AUG 2005 10:46
+> **mtrap
+5c5
+< String usage 4&24 (1306&9877 now untouched)
+---
+> String usage 5&29 (1297&17816 now untouched)
+300,306c300,306
+< String usage 8&32 (1302&9869 now untouched)
+< Memory usage 109&13 (3358 still untouched)
+< String usage 10&42 (1300&9859 now untouched)
+< Memory usage 116&13 (3358 still untouched)
+< String usage 11&45 (1299&9856 now untouched)
+< Memory usage 139&56 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> String usage 9&37 (1293&17808 now untouched)
+> Memory usage 120&13 (3358 still untouched)
+> String usage 11&47 (1291&17798 now untouched)
+> Memory usage 127&13 (3358 still untouched)
+> String usage 12&50 (1290&17795 now untouched)
+> Memory usage 150&56 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+316,317c316,317
+< Memory usage 152&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 163&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+341,342c341,342
+< Memory usage 220&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 239&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+358,359c358,359
+< Memory usage 245&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 267&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+374,375c374,375
+< Memory usage 293&72 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 318&72 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+404,405c404,405
+< Memory usage 314&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 342&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+442,443c442,443
+< Memory usage 339&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 370&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+480,481c480,481
+< Memory usage 339&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 370&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+496,497c496,497
+< Memory usage 345&70 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 376&70 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+537,538c537,538
+< Memory usage 364&59 (3358 still untouched)
+< String usage 14&51 (1296&9850 now untouched)
+---
+> Memory usage 398&59 (3358 still untouched)
+> String usage 15&56 (1287&17789 now untouched)
+550,551c550,551
+< Memory usage 355&64 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 386&64 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+594,595c594,595
+< Memory usage 365&59 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 396&59 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+610,611c610,611
+< Memory usage 390&73 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 424&73 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+659,660c659,660
+< Memory usage 409&59 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 446&59 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+668,671c668,671
+< Memory usage 409&59 (3358 still untouched)
+< String usage 18&75 (1292&9826 now untouched)
+< Memory usage 308&13 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 446&59 (3358 still untouched)
+> String usage 19&80 (1283&17765 now untouched)
+> Memory usage 339&13 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+721,722c721,722
+< Memory usage 308&13 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 339&13 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+724,725c724,725
+< Memory usage 563&13 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 622&13 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+817,818c817,818
+< Memory usage 747&13 (3358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 826&13 (3358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+847,848c847,848
+< Memory usage 1003&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 1110&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+872,873c872,873
+< Memory usage 873&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 966&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+897,898c897,898
+< Memory usage 786&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 868&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+919,920c919,920
+< Memory usage 773&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 852&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+942,943c942,943
+< Memory usage 788&85 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 870&85 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+949,950c949,950
+< Memory usage 319&13 (2358 still untouched)
+< String usage 17&64 (1293&9837 now untouched)
+---
+> Memory usage 350&13 (2358 still untouched)
+> String usage 18&69 (1284&17776 now untouched)
+952,953c952,953
+< Memory usage 325&13 (2358 still untouched)
+< String usage 20&78 (1287&9809 now untouched)
+---
+> Memory usage 356&13 (2358 still untouched)
+> String usage 21&83 (1278&17748 now untouched)
+956c956,957
+< >> "%%Creator: MetaPost"
+---
+> >> "%%HiResBoundingBox: -36 -24 84 84"
+> >> "%%Creator: MetaPost 0.901"
+958a960
+> >> "%%BeginProlog"
+988,989c990,991
+< Memory usage 325&13 (2358 still untouched)
+< String usage 22&84 (1247&8769 now untouched)
+---
+> Memory usage 356&13 (2358 still untouched)
+> String usage 23&89 (1236&16656 now untouched)
+992,994c994,996
+< >> 40
+< Memory usage 325&13 (2358 still untouched)
+< String usage 22&84 (1206&7603 now untouched)
+---
+> >> 42
+> Memory usage 356&13 (2358 still untouched)
+> String usage 23&89 (1193&15438 now untouched)
+998,1002c1000,1008
+< >> "%%Creator: MetaPost"
+< Memory usage 325&13 (2358 still untouched)
+< String usage 24&110 (1197&7522 now untouched)
+< Memory usage 325&13 (2358 still untouched)
+< String usage 26&125 (1148&7358 now untouched)
+---
+> >> "%%HiResBoundingBox: -36 -24 84 84"
+> Memory usage 356&13 (2358 still untouched)
+> String usage 25&129 (1184&15343 now untouched)
+> write0 = `writeo'.
+>
+> write1 = `writeo.2'.
+>
+> Memory usage 356&13 (2358 still untouched)
+> String usage 27&144 (1135&15179 now untouched)
+1004c1010
+< >> "%%Pages: 1"
+---
+> >> "%%CreationDate: 2005.08.03:1046"
+1006c1012
+< >> "%*Font: trapf 9.9628 9.96265 35:c008"
+---
+> >> "%%Pages: 1"
+1008,1010c1014,1018
+< >> "%%EndProlog"
+< Memory usage 325&13 (2358 still untouched)
+< String usage 25&135 (1144&7308 now untouched)
+---
+> >> "%*Font: trapf 9.9628 9.96265 35:c008"
+> Memory usage 356&13 (2358 still untouched)
+> String usage 26&134 (1131&15135 now untouched)
+> write0 = `writeo'.
+>
+1013,1014c1021,1022
+< Memory usage 325&13 (2358 still untouched)
+< String usage 26&141 (1195&1840 now untouched)
+---
+> Memory usage 356&13 (2358 still untouched)
+> String usage 27&140 (1258&16265 now untouched)
+1038,1039c1046,1047
+< Memory usage 325&13 (2358 still untouched)
+< String usage 26&141 (1195&1840 now untouched)
+---
+> Memory usage 356&13 (2358 still untouched)
+> String usage 27&140 (1258&16265 now untouched)
+1048,1049c1056,1057
+< Memory usage 327&13 (2358 still untouched)
+< String usage 27&149 (1194&1832 now untouched)
+---
+> Memory usage 358&13 (2358 still untouched)
+> String usage 28&148 (1257&16257 now untouched)
+1097,1098c1105,1106
+< Memory usage 327&13 (2358 still untouched)
+< String usage 27&149 (1193&1824 now untouched)
+---
+> Memory usage 358&13 (2358 still untouched)
+> String usage 28&148 (1256&16249 now untouched)
+1101,1102c1109,1110
+< 32 strings out of 1310
+< 561 string characters out of 9901
+---
+> 33 strings out of 1302
+> 560 string characters out of 17845
+1104,1106c1112,1114
+< 237 symbolic tokens out of 2100
+< 5i,33n,6p,100b stack positions out of 30i,100n,150p,500b
+< 3 string compactions (moved 1368 characters, 89 strings)
+---
+> 238 symbolic tokens out of 9500
+> 5i,33n,6p,99b stack positions out of 300i,300n,1500p,500b
+> 2 string compactions (moved 880 characters, 63 strings)
+diff ./triptrap/mtrap.0 mtrap.0
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -36 -24 84 84
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+6a8
+> %%BeginProlog
+diff ./triptrap/mtrap.1 mtrap.1
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -84 -36 24 84
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+6a8
+> %%BeginProlog
+diff ./triptrap/writeo writeo
+diff ./triptrap/writeo.2 writeo.2
+ln -s ./triptrap/trap.mp .
+ln -s ./triptrap/trap.mpx .
+/bin/sh -c 'TEXMFCNF=./triptrap ./mpost --progname=inimpost <./triptrap/mptrap1.in >mptrapin.fot'
+mv trap.log mptrapin.log
+diff ./triptrap/mptrapin.log mptrapin.log
+1c1
+< This is MetaPost, C Version 0.632 (INIMP) 24 JAN 1997 11:13
+---
+> This is MetaPost, Version 0.901 (Web2C 7.5.5) (INIMP) 3 AUG 2005 10:46
+162c162
+< String usage 28&93 (1282&9362 now untouched)
+---
+> String usage 29&97 (1272&17743 now untouched)
+195,198c195,198
+< (preloaded mem=trap 97.1.24)
+< at most 1226 strings of total length 22670
+< 398 memory locations dumped; current usage is 318&68
+< 279 symbolic tokens
+---
+> (mem=trap 2005.8.3)
+> at most 1236 strings of total length 22276
+> 400 memory locations dumped; current usage is 320&68
+> 281 symbolic tokens
+/bin/sh -c 'TEXMFCNF=./triptrap ./mpost --progname=inimpost <./triptrap/mptrap2.in >mptrap.fot'
+mv trap.log mptrap.log
+mv trap.tfm mptrap.tfm
+diff ./triptrap/mptrap.fot mptrap.fot
+0a1
+> This is MetaPost, Version 0.901 (Web2C 7.5.5) (INIMP)
+34,35c35,36
+< Memory usage 2147&536 (39 still untouched)
+< String usage 73&277 (1110&5373 now untouched)
+---
+> Memory usage 2315&536 (39 still untouched)
+> String usage 74&281 (1103&13766 now untouched)
+diff ./triptrap/mptrap.log mptrap.log
+1c1
+< This is MetaPost, C Version 0.632 (preloaded mem=trap 97.1.24) 24 JAN 1997 11:13
+---
+> This is MetaPost, Version 0.901 (Web2C 7.5.5) (mem=trap 2005.8.3) 3 AUG 2005 10:46
+1621,1622c1621,1622
+< Memory usage 1178&115 (2344 still untouched)
+< String usage 22&84 (1244&9177 now untouched)
+---
+> Memory usage 1244&115 (2344 still untouched)
+> String usage 23&88 (1236&17569 now untouched)
+2612c2612
+< >> unknown path %CAPSULE1695
+---
+> >> unknown path %CAPSULE1901
+2665c2665
+< dashed (on 3 off 0) shifted 0
+---
+> dashed (on 0 off 0) shifted 0
+2816,2818c2816,2818
+< xpart %CAPSULE2512=xx
+< %CAPSULE2520=2yy-2
+< %CAPSULE2528 = 3.3333xx+3.3333
+---
+> xpart %CAPSULE2366=xx
+> %CAPSULE2374=2yy-2
+> %CAPSULE2382 = 3.3333xx+3.3333
+2877,2880c2877,2880
+< %CAPSULE2440 = 3ooo-0.01o3
+< %CAPSULE2460 = 8000o2-4000o1+1000o3+9
+< xpart %CAPSULE2536=xpart '
+< ypart %CAPSULE2536=ypart '
+---
+> %CAPSULE2294 = 3ooo-0.01o3
+> %CAPSULE2314 = 8000o2-4000o1+1000o3+9
+> xpart %CAPSULE2390=xpart '
+> ypart %CAPSULE2390=ypart '
+2883,2884c2883,2884
+< ### 4000o1 = -%CAPSULE2460+8000o2+1000o3+9
+< ### -4.87383o2 = -oo-0.0004%CAPSULE2460+0.39673o3-17.99643
+---
+> ### 4000o1 = -%CAPSULE2314+8000o2+1000o3+9
+> ### -4.87383o2 = -oo-0.0004%CAPSULE2314+0.39673o3-17.99643
+2888c2888
+< ### 0.22894o5 = -%CAPSULE2440+0.10689oo+3ooo+1.92412
+---
+> ### 0.22894o5 = -%CAPSULE2294+0.10689oo+3ooo+1.92412
+2891c2891
+< ### -alfa=-%CAPSULE2428
+---
+> ### -alfa=-%CAPSULE2282
+2893,2900c2893,2900
+< ### -%CAPSULE2428=-xpart %CAPSULE2426
+< {xpart((xpart %CAPSULE2426,0))}
+< ### -xpart %CAPSULE9=-%CAPSULE2416
+< {endgroup}
+< {(%CAPSULE2440)+(%CAPSULE2416)}
+< ### -%CAPSULE2440=-%CAPSULE2404+%CAPSULE2416
+< ### -%CAPSULE2404=-ypart %CAPSULE2402
+< ### -%CAPSULE2460=-xpart %CAPSULE2402
+---
+> ### -%CAPSULE2282=-xpart %CAPSULE2280
+> {xpart((xpart %CAPSULE2280,0))}
+> ### -xpart %CAPSULE9=-%CAPSULE2270
+> {endgroup}
+> {(%CAPSULE2294)+(%CAPSULE2270)}
+> ### -%CAPSULE2294=-%CAPSULE2258+%CAPSULE2270
+> ### -%CAPSULE2258=-ypart %CAPSULE2256
+> ### -%CAPSULE2314=-xpart %CAPSULE2256
+2905c2905
+< ### p$=-ypart %CAPSULE2368+1
+---
+> ### p$=-ypart %CAPSULE2222+1
+2907,2919c2907,2919
+< {(2/3)*((-ypart %CAPSULE2368+1,ypart %CAPSULE2368))}
+< ### ypart %CAPSULE2368=-xpart %CAPSULE2368+1
+< ### -0.66667xpart %CAPSULE2368=-xpart %CAPSULE2360
+< {-((xpart %CAPSULE2360,-xpart %CAPSULE2360+0.66667))}
+< ### xpart %CAPSULE2360=-xpart %CAPSULE2340
+< {((xpart %CAPSULE2402,ypart %CAPSULE2402))=((xpart %CAPSULE2340,-xpart %
+< CAPSULE2340-0.66667))}
+< ## xpart %CAPSULE2340=-ypart %CAPSULE2402-0.66667
+< ## xpart %CAPSULE2402=-ypart %CAPSULE2402-0.66667
+< ### ypart %CAPSULE2402=-xpart %CAPSULE2402-0.66667
+< ### -xpart %CAPSULE2402=-xpart %CAPSULE2340
+< {((xpart ',ypart '))=((xpart %CAPSULE2340,-xpart %CAPSULE2340-0.66667))}
+< ## xpart %CAPSULE2340=-ypart '-0.66667
+---
+> {(2/3)*((-ypart %CAPSULE2222+1,ypart %CAPSULE2222))}
+> ### ypart %CAPSULE2222=-xpart %CAPSULE2222+1
+> ### -0.66667xpart %CAPSULE2222=-xpart %CAPSULE2214
+> {-((xpart %CAPSULE2214,-xpart %CAPSULE2214+0.66667))}
+> ### xpart %CAPSULE2214=-xpart %CAPSULE2194
+> {((xpart %CAPSULE2256,ypart %CAPSULE2256))=((xpart %CAPSULE2194,-xpart %
+> CAPSULE2194-0.66667))}
+> ## xpart %CAPSULE2194=-ypart %CAPSULE2256-0.66667
+> ## xpart %CAPSULE2256=-ypart %CAPSULE2256-0.66667
+> ### ypart %CAPSULE2256=-xpart %CAPSULE2256-0.66667
+> ### -xpart %CAPSULE2256=-xpart %CAPSULE2194
+> {((xpart ',ypart '))=((xpart %CAPSULE2194,-xpart %CAPSULE2194-0.66667))}
+> ## xpart %CAPSULE2194=-ypart '-0.66667
+2925c2925
+< ### -ooo=-%CAPSULE2302
+---
+> ### -ooo=-%CAPSULE2156
+2927,2936c2927,2936
+< {(%CAPSULE2302)+(1)}
+< ### -%CAPSULE2302=-%CAPSULE2290+1
+< {(1/2)*(%CAPSULE2290)}
+< ### -0.5%CAPSULE2290=-%CAPSULE2282
+< {-(%CAPSULE2282)}
+< ### %CAPSULE2282=-%CAPSULE2274
+< {(2)*(%CAPSULE2274)}
+< ### -2%CAPSULE2274=-%CAPSULE2266
+< {(-0.5%CAPSULE2266-0.5)=(%CAPSULE2266)}
+< ## %CAPSULE2266=-0.33333
+---
+> {(%CAPSULE2156)+(1)}
+> ### -%CAPSULE2156=-%CAPSULE2144+1
+> {(1/2)*(%CAPSULE2144)}
+> ### -0.5%CAPSULE2144=-%CAPSULE2136
+> {-(%CAPSULE2136)}
+> ### %CAPSULE2136=-%CAPSULE2128
+> {(2)*(%CAPSULE2128)}
+> ### -2%CAPSULE2128=-%CAPSULE2120
+> {(-0.5%CAPSULE2120-0.5)=(%CAPSULE2120)}
+> ## %CAPSULE2120=-0.33333
+3509,3510c3509,3510
+< Memory usage 3017&264 (273 still untouched)
+< String usage 68&249 (1155&8794 now untouched)
+---
+> Memory usage 3275&264 (273 still untouched)
+> String usage 69&253 (1147&17186 now untouched)
+3520,3521c3520,3521
+< Memory usage 2267&264 (273 still untouched)
+< String usage 66&241 (1154&8790 now untouched)
+---
+> Memory usage 2446&264 (273 still untouched)
+> String usage 67&245 (1146&17182 now untouched)
+3990a3991,3992
+> ..(10,10)
+> ..controls (10,10) and (10,10)
+4378,4379c4380,4381
+< Memory usage 2744&607 (39 still untouched)
+< String usage 73&279 (1138&8717 now untouched)
+---
+> Memory usage 2959&607 (39 still untouched)
+> String usage 74&283 (1130&17109 now untouched)
+4384,4385c4386,4387
+< Memory usage 2704&536 (39 still untouched)
+< String usage 73&279 (1138&8717 now untouched)
+---
+> Memory usage 2919&536 (39 still untouched)
+> String usage 74&283 (1130&17109 now untouched)
+4673,4674c4675,4676
+< Memory usage 2147&536 (39 still untouched)
+< String usage 73&277 (1110&5373 now untouched)
+---
+> Memory usage 2315&536 (39 still untouched)
+> String usage 74&281 (1103&13766 now untouched)
+4739,4740c4741,4742
+< 75 strings out of 1277
+< 768 string characters out of 9330
+---
+> 76 strings out of 1268
+> 772 string characters out of 17724
+4742,4743c4744,4745
+< 337 symbolic tokens out of 2100
+< 8i,35n,8p,167b stack positions out of 30i,100n,150p,500b
+---
+> 339 symbolic tokens out of 9500
+> 8i,35n,8p,167b stack positions out of 300i,300n,1500p,500b
+4752c4754
+< out of 256w,16h,16d,64i,5000l,500k,256e,50p)
+---
+> out of 256w,16h,16d,64i,15000l,2500k,256e,50p)
+diff ./triptrap/trap.5 trap.5
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -150.99219 -2 168.99219 20.00024
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.6 trap.6
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: 3 0 6 2.25
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.148 trap.148
+2,4c2,5
+< %%BoundingBox: -5 -5 13 5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%BoundingBox: -4 -6 13 6
+> %%HiResBoundingBox: -3.5 -5.5 12.5 5.5
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.149 trap.149
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -27.5 -27.5 51.6906 36.71318
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.150 trap.150
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -5 -5 33 25
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+5a7
+> %%BeginProlog
+28c30
+< 15 10 lineto
+---
+> 10 5 lineto
+diff ./triptrap/trap.151 trap.151
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -4095.49998 -101.96362 4095.49998 261
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+5a7
+> %%BeginProlog
+diff ./triptrap/trap.197 trap.197
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -1.99254 -3.98508 7.97011 3.98506
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+6a8
+> %%BeginProlog
+diff ./triptrap/trap.200 trap.200
+3,4c3,5
+< %%Creator: MetaPost
+< %%CreationDate: 1998.01.28:1118
+---
+> %%HiResBoundingBox: -6.2132 -5.9851 36.21318 37.00375
+> %%Creator: MetaPost 0.901
+> %%CreationDate: 2005.08.03:1046
+7a9
+> %%BeginProlog
+./tftopl ./mptrap.tfm mptrap.pl
+diff ./triptrap/mptrap.pl mptrap.pl
+make[1]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c'
diff --git a/Build/source/texk/web2c/triptrap/mptrap.fot b/Build/source/texk/web2c/triptrap/mptrap.fot
new file mode 100644
index 00000000000..dd115f1982d
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mptrap.fot
@@ -0,0 +1,82 @@
+**(trap.mp
+\*//*\trap\pass2!
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+l.22 ...t next=\; delimiters ^~7
+ ! fi
+! Extra tokens will be flushed.
+<to be read again>
+ !
+l.22 ... next=\; delimiters ^~7!
+ fi
+! Forbidden token found while scanning to the end of the statement.
+<inserted text>
+ ;
+<to be read again>
+ \
+l.23 next\
+ ; % the second pass will now compute silently; the ...
+
+hello again^^_
+{tracingonline:=1}
+
+f<expr>->let)=];let[=(;show._
+(EXPR0)<-xx
+{let}
+{let}
+{show}
+>> _1
+{showdependencies}
+xpart '=-ypart '-0.66667
+{qq:=pen}
+{showstats}
+Memory usage 2147&536 (39 still untouched)
+String usage 73&277 (1110&5373 now untouched)
+{[repeat the loop]}
+>> bye
+! Isolated expression.
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+! Extra tokens will be flushed.
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+! Forbidden token found while scanning to the end of the statement.
+<inserted text>
+ ;
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+{show}
+)
+*! An expression can't begin with `end'.
+<inserted text>
+ 0
+<to be read again>
+ end
+<*> end
+
+>> 0
+! A group begun on line 206 never ended.
+<to be read again>
+ end
+<*> end
+
+{endgroup}
+(end occurred when else on line 88 was incomplete)
+(end occurred when if on line 37 was incomplete)
+(end occurred when elseif on line 22 was incomplete)
+(see the transcript file for additional information)
+(illegal design size has been changed to 128pt)
+(some chardp values had to be adjusted by as much as 0.5pt)
+(local label 0:: was missing)
+(local label 5:: was missing)
+(4 font metric dimensions had to be decreased)
+Font metrics written on trap.tfm.
+25 output files written: trap.ps .. trap.200
+Transcript written on trap.log.
diff --git a/Build/source/texk/web2c/triptrap/mptrap.log b/Build/source/texk/web2c/triptrap/mptrap.log
new file mode 100644
index 00000000000..147992a44a0
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mptrap.log
@@ -0,0 +1,4755 @@
+This is MetaPost, C Version 0.632 (preloaded mem=trap 97.1.24) 24 JAN 1997 11:13
+** &trap trap
+(trap.mp
+{if}
+{known(0)}
+{not(true)}
+{false}
+{known("")}
+{true}
+
+/*\`'@#->begingroup.message(SUFFIX1)&str(SUFFIX0)&jobname&char.ASCII'`&s
+tr(SUFFIX2)!endgroup
+(SUFFIX0)<-/*\
+(SUFFIX1)<-`'
+(SUFFIX2)<-pass2
+{begingroup}
+{message}
+
+`'->begingroup'`endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-`'
+{begingroup}
+
+'`->"\*/"
+{endgroup}
+{("\*/")&("/*\")}
+{jobname}
+{("\*//*\")&("trap")}
+
+'`->"\*/"
+{ASCII("\*/")}
+{char(92)}
+{("\*//*\trap")&("\")}
+{("\*//*\trap\")&("pass2!")}
+
+\*//*\trap\pass2!
+{endgroup}
+{nonstopmode}
+
+{outer}
+{let}
+{delimiters}
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+l.22 ...t next=\; delimiters ^~7
+ ! fi
+Sorry: You can't redefine a number, string, or expr.
+I've inserted an inaccessible symbol so that your
+definition will be completed without mixing me up too badly.
+
+! Extra tokens will be flushed.
+<to be read again>
+ !
+l.22 ... next=\; delimiters ^~7!
+ fi
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+! Forbidden token found while scanning to the end of the statement.
+<inserted text>
+ ;
+<to be read again>
+ \
+l.23 next\
+ ; % the second pass will now compute silently; the ...
+A previous error seems to have propagated,
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{\}
+{batchmode}
+
+! An expression can't begin with `endgroup'.
+<inserted text>
+ 0
+<to be read again>
+ endgroup
+l.24 batchmode; ^~7,endgroup
+ pausing:=1; exitif p exitif bool...
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+! Missing ` INACCESSIBLE' has been inserted.
+<to be read again>
+ endgroup
+l.24 batchmode; ^~7,endgroup
+ pausing:=1; exitif p exitif bool...
+I found no right delimiter to match a left one. So I've
+put one in, behind the scenes; this may fix the problem.
+
+! Extra `endgroup'.
+<recently read> endgroup
+
+l.24 batchmode; ^~7,endgroup
+ pausing:=1; exitif p exitif bool...
+I'm not currently working on a `begingroup',
+so I had better not try to end anything.
+
+{pausing:=1}
+{exitif}
+{exitif}
+{pencircle}
+{endfor}
+! Extra `endfor'.
+l.24 ...ean pen pencircle endfor
+
+I'm not currently working on a for loop,
+so I had better not try to end anything.
+
+{scantokens}
+{begingroup}
+{message}
+{char(0)}
+{("^^@")&("watch this")}
+^^@watch this
+{-(1)}
+{char(-1)}
+{("pair p[],';")&("^^ff")}
+{endgroup}
+{pen(pen)}
+{boolean(true)}
+{true}
+! No loop is in progress.
+<to be read again>
+ pair
+<scantokens> pair
+ p[],';^^ff
+<to be read again>
+ path
+l.26 path
+ p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(...
+Why say `exitif' when there's nothing to exit from?
+
+>> p
+! Undefined condition will be treated as `false'.
+<to be read again>
+ pair
+<scantokens> pair
+ p[],';^^ff
+<to be read again>
+ path
+l.26 path
+ p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(...
+The expression shown above should have had a definite
+true-or-false value. I'm changing it to `false'.
+
+{false}
+! Missing `;' has been inserted.
+<to be read again>
+ pair
+<scantokens> pair
+ p[],';^^ff
+<to be read again>
+ path
+l.26 path
+ p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(...
+After `exitif <boolean exp>' I expect to see a semicolon.
+I shall pretend that one was there.
+
+{pair}
+! Text line contains an invalid character.
+<scantokens> pair p[],';^^ff
+
+<to be read again>
+ path
+l.26 path
+ p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(...
+A funny symbol that I can't read has just been input.
+Continue, and I'll forget that it ever happened.
+
+{path}
+{-(2)}
+{-(1)}
+{turningnumber((xpart ',ypart '))}
+Path at line 26, before choices:
+(1,-2){curl 1}
+ ..(2,-1)
+ ..(2.5,0.5)
+ ..(1,2)
+ ..{curl 1}(0,2.5)
+
+Path at line 26, after choices:
+(1,-2)..controls (1.37755,-1.71404) and (1.71404,-1.37755)
+ ..(2,-1)..controls (2.33353,-0.55965) and (2.59729,-0.04124)
+ ..(2.5,0.5)..controls (2.36812,1.23369) and (1.6712,1.65662)
+ ..(1,2)..controls (0.66821,2.16974) and (0.33485,2.33641)
+ ..(0,2.5)
+
+{(unknown path qw)=(path)}
+{numeric}
+! Enormous number has been reduced.
+l.27 ...[$] ]]=10000000000000000
+ ; "this string constant is in...
+I can't handle numbers bigger than 32767.99998;
+so I've changed your constant to that maximum amount.
+
+{(p[[ [-1] ]])=(32767.99998)}
+## p[[ [-1] ]]=32767.99998
+! Value is too large (32767.99998).
+l.27 ...$] ]]=10000000000000000;
+ "this string constant is inc...
+The equation I just processed has given some variable
+a value of 4096 or more. Continue and I'll try to cope
+with that big value; but it might be dangerous.
+(Set warningcheck:=0 to suppress this message.)
+
+! Incomplete string token has been flushed.
+l.27 ...g constant is incomplete
+
+Strings should finish on the same line as they began.
+I've deleted the partial string; you might want to
+insert another by typing, e.g., `I"new string"'.
+
+{string}
+! Declared variable conflicts with previous vardef.
+<to be read again>
+ ,
+l.28 string foo[]p,
+ p~if true:[];
+You can't use, e.g., `numeric foo[]' after `vardef foo'.
+Proceed, and I'll ignore the illegal redeclaration.
+
+{if}
+{true}
+{true}
+{boolean}
+{fi}
+{showvariable}
+boolean.boolean=unknown boolean
+! OK.
+l.29 ...n; showvariable boolean;
+
+
+{inner}
+{def}
+{outer}
+{picture}
+{pen}
+! Illegal suffix of declared variable will be flushed.
+<to be read again>
+ [
+<to be read again>
+ "a"
+l.31 pen p~[]~,q["a"
+ ,qq; p~1~=q=pencircle scaled mexp(-3016.5...
+Variables in declarations must consist entirely of
+names and collective subscripts, e.g., `x[]a'.
+Are you trying to use a reserved word in a variable name?
+I'm going to discard the junk I found here,
+up to the next comma or the end of the declaration.
+
+{pencircle}
+{-(3016.57654)}
+{mexp(-3016.57654)}
+{(pen)scaled(0)}
+{(unknown pen q)=(pen)}
+{(unknown pen p~1~)=(pen)}
+{transform}
+! Illegal suffix of declared variable will be flushed.
+<to be read again>
+ 0
+l.32 transform p,pp0
+ ; if p=p:qq=makepen((7,0)..cycle) xscaled...
+Variables in declarations must consist entirely of
+names and collective subscripts, e.g., `x[]a'.
+Explicit subscripts like `x15a' aren't permitted.
+I'm going to discard the junk I found here,
+up to the next comma or the end of the declaration.
+
+{if}
+{((xpart p,ypart p,xxpart p,xypart p,yxpart p,yypart p))=((xpart p,ypart
+ p,xxpart p,xypart p,yxpart p,yypart p))}
+{true}
+Path at line 32, before choices:
+(7,0)
+ ..cycle
+
+Path at line 32, after choices:
+(7,0)..controls (7,0) and (7,0)
+ ..cycle
+
+{makepen(path)}
+{hex("1000")}
+! Number too large (4096).
+<to be read again>
+ ;
+l.32 ...cle) xscaled hex "1000";
+ show qq;fi
+I have trouble with numbers greater than 4095; watch out.
+(Set warningcheck:=0 to suppress this message.)
+
+{(pen)xscaled(4096)}
+{(unknown pen qq)=(pen)}
+{show}
+>> Pen at line 32:
+pencircle transformed (28672,0,0,0,0,0)
+
+! OK.
+l.32 ...aled hex "1000";show qq;
+ fi
+
+{fi}
+Path at line 33, before choices:
+(4,1)
+ ..(1,2)
+ ..(5,3)
+ ..(3,2)
+ ..(1,1)
+ ..(0,1)
+ ..(1,0)
+ ..cycle
+
+Path at line 33, after choices:
+(4,1)..controls (3.72015,2.36482) and (1.84834,1.36037)
+ ..(1,2)..controls (-5.16994,6.65202) and (8.52596,9.85889)
+ ..(5,3)..controls (4.6365,2.29291) and (3.69041,2.34465)
+ ..(3,2)..controls (2.30983,1.65547) and (1.78375,0.86862)
+ ..(1,1)..controls (0.63611,1.06099) and (0.23091,1.28844)
+ ..(0,1)..controls (-0.3216,0.5983) and (0.24828,0.12357)
+ ..(1,0)..controls (2.58165,-0.25998) and (4.23677,-0.15471)
+ ..cycle
+
+{makepen(path)}
+{qq:=pen}
+{show}
+>> Pen at line 33:
+(0,1)
+ .. (1,0)
+ .. (4,1)
+ .. (5,3)
+ .. (1,2)
+ .. cycle
+
+! OK.
+l.33 .....(1,0)..cycle);show qq;
+
+
+{vardef}
+! Missing parameter type; `expr' will be assumed.
+<to be read again>
+ )
+l.34 ...ext suffix a,b endtext()
+ )suffix@=show #@; p.a.b() end...
+You should've had `expr' or `suffix' or `text' here.
+
+{expandafter}
+{\}
+{let}
+
+\\->=show
+{outer}
+{((6,12))-((xpart p7,ypart p7))}
+{((0,1))transformed((xpart p,ypart p,xxpart p,xypart p,yxpart p,yypart p
+))}
+{(x)-(x)}
+{(2)/(0)}
+>> 2
+! Division by zero.
+<to be read again>
+ ,
+l.36 ...)transformed p=(2/(x-x),
+ 3/0)transformed p;
+You're trying to divide the quantity shown above the error
+message by zero. I'm going to divide it by one instead.
+
+! Division by zero.
+l.36 ...ansformed p=(2/(x-x),3/0
+ )transformed p;
+I'll pretend that you meant to divide by 1.
+
+{((2,3))transformed((xpart p,ypart p,xxpart p,xypart p,yxpart p,yypart p
+))}
+{((linearform,linearform))=((linearform,linearform))}
+## yxpart p=-yypart p
+## xxpart p=-xypart p
+{((-xpart p7+6,-ypart p7+12))=((linearform,linearform))}
+## ypart p7=-ypart p-yypart p+12
+## xpart p7=-xpart p-xypart p+6
+{\}
+{if}
+{string(unknown string p~[-1])}
+{true}
+{(p0.1 0.2)-(p0.1 0.2)}
+! The token `endtext' is no longer a right delimiter.
+l.37 ...1.2-p.1.199999,1 endtext
+ transformed p;
+Strange: This token has lost its former meaning!
+I'll read it as a right delimiter this time;
+but watch out, I'll probably miss it later.
+
+{((0,1))transformed((xpart p,ypart p,-xypart p,xypart p,-yypart p,yypart
+ p))}
+{((linearform,linearform))=((linearform,linearform))}
+## ypart p=-yypart p+6
+#### ypart p7=6
+## xpart p=-xypart p+3
+#### xpart p7=3
+{(unknown path p1 2p)=((3,6))}
+{showstopping:=0}
+{showvariable}
+p=(-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p)
+p[]=pair
+p[][]=numeric
+p[][]p=unknown path
+p[][]p~=macro:(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup ETC.
+p[]~=unknown boolean
+p~=path
+p~[]=unknown string
+p~[]~=unknown pen
+p~[]~[][]=unknown picture
+p~[-1]=unknown string p~[-1]
+p~1~=pen
+p[[ [] ]]=numeric
+p[[ [-1] ]]=32767.99998
+p0.1 0.2=p0.1 0.2
+p1 2p=path
+p7=(3,6)
+{((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))=((-xy
+part p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))}
+{let}
+{let}
+{xxpart((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))
+}
+{(-xypart p)+(0.002)}
+{yxpart((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))
+}
+{((xpart p2,ypart p2))-((xpart p1,ypart p1))}
+{(1)*((linearform,linearform))}
+{((xpart p1,ypart p1))+((linearform,linearform))}
+{(y)+(0.00002)}
+{yypart((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))
+}
+{xypart((-xypart p+3,-yypart p+6,-xypart p,xypart p,-yypart p,yypart p))
+}
+{((5,y))=((yypart p,xypart p))}
+## y=xypart p
+## yypart p=5
+#### ypart p=1
+#### yxpart p=-5
+{((5,xypart p+0.00002))=((5,xypart p))}
+{((xpart p2,ypart p2))=((5,xypart p))}
+## ypart p2=xypart p
+## xpart p2=5
+{((-xypart p+0.002,-5))=((5,xypart p))}
+## xypart p=-5
+#### ypart p2=-5
+#### y=-5
+#### xpart p=8
+#### xxpart p=5
+! Inconsistent equation (off by -0.002).
+<to be read again>
+ ;
+l.39 ...,y)=(yypart p,xypart p);
+
+The equation I just read contradicts what was said before.
+But don't worry; continue and I'll just ignore it.
+
+Path at line 40, before choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+ ..cycle
+
+Path at line 40, after choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)..controls (17.52783,8.54388) and (-15.45978,-4.12262)
+ ..cycle
+
+{reverse(path)}
+{(path)transformed((8,1,5,-5,-5,5))}
+{(path)=(unknown path p2 3p)}
+
+p1 2p~(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup.show(SUFFIX0);p(SUFF
+IX2)(SUFFIX3)((EXPR4)endgroup
+(SUFFIX0)<-p1 2p
+(SUFFIX1)<-~
+(SUFFIX2)<-
+(SUFFIX3)<-2 3p~
+! A primary expression can't begin with `right delimiter that matches ('
+.
+<inserted text>
+ 0
+<to be read again>
+ )
+l.41 ...000000001]2p~(,[2]3p~,-)
+ =p~1~2[pausing];
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+{-(0)}
+(EXPR4)<-0
+(SUFFIX5)<-
+{begingroup}
+{show}
+>> Path at line 41:
+(3,6)
+
+
+p2 3p~(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup.show(SUFFIX0);p(SUFF
+IX2)(SUFFIX3)((EXPR4)endgroup
+(SUFFIX0)<-p2 3p
+(SUFFIX1)<-~
+! Missing `,' has been inserted.
+<to be read again>
+ (0)
+p1 2p~->...IX2)(SUFFIX3)((EXPR4)
+ endgroup
+<to be read again>
+ =
+l.41 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I've finished reading a macro argument and am about to
+read another; the arguments weren't delimited correctly.
+You might want to delete some tokens before continuing.
+
+(SUFFIX2)<-
+! Missing `,' has been inserted.
+<to be read again>
+ (0)
+p1 2p~->...IX2)(SUFFIX3)((EXPR4)
+ endgroup
+<to be read again>
+ =
+l.41 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I've finished reading a macro argument and am about to
+read another; the arguments weren't delimited correctly.
+You might want to delete some tokens before continuing.
+
+(SUFFIX3)<-
+! Missing `)' has been inserted.
+<to be read again>
+ endgroup
+<to be read again>
+ =
+l.41 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I've gotten to the end of the macro parameter list.
+You might want to delete some tokens before continuing.
+
+(EXPR4)<-0
+(SUFFIX5)<-
+{begingroup}
+{show}
+>> Path at line 41:
+(8,1)..controls (-48.68579,57.68579) and (52.91974,-43.91974)
+ ..(28,-19)..controls (-7,16) and (63,-54)
+ ..cycle
+
+>> (8,1,5,-5,-5,5)
+! Isolated expression.
+<to be read again>
+ (
+p2 3p~->...;p(SUFFIX2)(SUFFIX3)(
+ (EXPR4)endgroup
+<to be read again>
+ endgroup
+<to be read again>
+ =
+l.41 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I couldn't find an `=' or `:=' after the
+expression that is shown above this error message,
+so I guess I'll just ignore it and carry on.
+
+! Extra tokens will be flushed.
+<to be read again>
+ (
+p2 3p~->...;p(SUFFIX2)(SUFFIX3)(
+ (EXPR4)endgroup
+<to be read again>
+ endgroup
+<to be read again>
+ =
+l.41 ...00000001]2p~(,[2]3p~,-)=
+ p~1~2[pausing];
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+{endgroup}
+{endgroup}
+{(vacuous)=(unknown picture p~1~2 1)}
+>> vacuous
+>> unknown picture p~1~2 1
+! Equation cannot be performed (vacuous=unknown picture).
+<to be read again>
+ ;
+l.41 ...2]3p~,-)=p~1~2[pausing];
+
+I'm sorry, but I don't know how to make such things equal.
+(See the two expressions just above the error message.)
+
+{vardef}
+Runaway definition?
+if.p(SUFFIX1)(SUFFIX1)=(SUFFIX1)(SUFFIX1)p.fi
+! Forbidden token found while scanning the definition of p~[].
+<inserted text>
+ enddef
+<to be read again>
+ ;
+l.42 ...iary t:=if p@ @=@ @p fi;
+ vardef p[][]p~[]=BAD; inner ;;
+I suspect you have forgotten an `enddef',
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{vardef}
+! This variable already starts with a macro.
+l.42 ...@p fi; vardef p[][]p~[]=
+ BAD; inner ;;
+After `vardef a' you can't say `vardef a.b'.
+So I'll have to discard this definition.
+
+Runaway definition?
+BAD
+! Forbidden token found while scanning the definition of a bad variable.
+<inserted text>
+ enddef
+<to be read again>
+ ;
+l.42 ...i; vardef p[][]p~[]=BAD;
+ inner ;;
+I suspect you have forgotten an `enddef',
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{inner}
+{show}
+{-(2)}
+
+p~[-2]@#<tertiary>->begingroup.if.p(SUFFIX1)(SUFFIX1)=(SUFFIX1)(SUFFIX1)
+p.fi.endgroup
+(SUFFIX0)<-p~
+(SUFFIX1)<-[-2]
+(SUFFIX2)<-~
+! A tertiary expression can't begin with `['.
+<inserted text>
+ 0
+<to be read again>
+ [
+<to be read again>
+ (3000)
+<to be read again>
+ ,
+l.43 show p~[-2]~[3000,
+ x]++4000>path p3; showvariable p,P;
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+{(x)-(3000)}
+{(0)*(x-3000)}
+{(3000)+(0)}
+{(3000)++(4000)}
+(EXPR3)<-4999.99998
+{begingroup}
+{if}
+{(p[-2][-2])=(-2)}
+>> p[-2][-2]+2
+! Unknown relation will be considered false.
+<to be read again>
+ [-2]
+p~[-2]->...1)=(SUFFIX1)(SUFFIX1)
+ p.fi.endgroup
+<to be read again>
+ >
+l.43 show p~[-2]~[3000,x]++4000>
+ path p3; showvariable p,P;
+Oh dear. I can't decide if the expression above is positive,
+negative, or zero. So this comparison test won't be `true'.
+
+{false}
+! Missing `:' has been inserted.
+<to be read again>
+ [-2]
+p~[-2]->...1)=(SUFFIX1)(SUFFIX1)
+ p.fi.endgroup
+<to be read again>
+ >
+l.43 show p~[-2]~[3000,x]++4000>
+ path p3; showvariable p,P;
+There should've been a colon after the condition.
+I shall pretend that one was there.
+
+{endgroup}
+{path((xpart p3,ypart p3))}
+{(vacuous)>(false)}
+>> vacuous
+>> false
+! Not implemented: (vacuous)>(boolean).
+<to be read again>
+ ;
+l.43 ...~[3000,x]++4000>path p3;
+ showvariable p,P;
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+>> false
+{showvariable}
+p=(8,1,5,-5,-5,5)
+p[]=pair
+p[][]=numeric
+p[][]p=unknown path
+p[][]p~=macro:(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup ETC.
+p[]~=unknown boolean
+p~=path
+p~[]@#=macro:<tertiary>->begingroup.if.p(SUFFIX1)(SUFFIX1) ETC.
+p[[ [] ]]=numeric
+p[[ [-1] ]]=32767.99998
+p[-2][-2]=p[-2][-2]
+p0.1 0.2=p0.1 0.2
+p1=(xpart p1,ypart p1)
+p1 2p=path
+p2=(5,-5)
+p2 3p=path
+p3=(xpart p3,ypart p3)
+p7=(3,6)
+> P=tag
+{numeric}
+{(2)*(alpha)}
+{(p3~)=(2alpha)}
+## alpha=0.5p3~
+{(1)/(-1)}
+{(3)*(beta)}
+{(p[-1]~)=(3beta)}
+## beta=0.33333p[-1]~
+{begingroup}
+{save}
+{showvariable}
+> p=tag
+{(3)*(0.33333(SAVED)p[-1]~)}
+{((SAVED)p[-1]~)=(1)}
+## (SAVED)p[-1]~=1
+#### beta=0.33333
+{restoring p}
+{endgroup}
+{showvariable}
+p=(8,1,5,-5,-5,5)
+p[]=pair
+p[][]=numeric
+p[][]p=unknown path
+p[][]p~=macro:(SUFFIX2)(SUFFIX3)(EXPR4)<suffix>->begingroup ETC.
+p[]~=numeric
+p~=path
+p~[]@#=macro:<tertiary>->begingroup.if.p(SUFFIX1)(SUFFIX1) ETC.
+p[[ [] ]]=numeric
+p[[ [-1] ]]=32767.99998
+p[-2][-2]=p[-2][-2]
+p[-1]~=1
+p0.1 0.2=p0.1 0.2
+p1=(xpart p1,ypart p1)
+p1 2p=path
+p2=(5,-5)
+p2 3p=path
+p3=(xpart p3,ypart p3)
+p3~=p3~
+p7=(3,6)
+{def}
+{def}
+! Missing `=' has been inserted.
+<to be read again>
+ false
+l.46 ...enddef;def!primary!false
+ ):!fi enddef;
+The next thing in this `def' should have been `=',
+because I've already looked at the definition heading.
+But don't worry; I'll pretend that an equals sign
+was present. Everything from here to `enddef'
+will be the replacement text of this macro.
+
+{def}
+{(path)scaled(-1)}
+Path at line 47, before choices:
+(1,-2)..controls (1.37755,-1.71404) and (1.71404,-1.37755)
+ ..(2,-1)..controls (2.33353,-0.55965) and (2.59729,-0.04124)
+ ..(2.5,0.5)..controls (2.36812,1.23369) and (1.6712,1.65662)
+ ..(1,2)..controls (0.66821,2.16974) and (0.33485,2.33641)
+ ..(0,2.5)
+ ..(-1,2)..controls (-1.37755,1.71404) and (-1.71404,1.37755)
+ ..(-2,1)..controls (-2.33353,0.55965) and (-2.59729,0.04124)
+ ..(-2.5,-0.5)..controls (-2.36812,-1.23369) and (-1.6712,-1.65662)
+ ..(-1,-2)..controls (-0.66821,-2.16974) and (-0.33485,-2.33641)
+ ..(0,-2.5)
+ ..cycle
+
+Path at line 47, after choices:
+(1,-2)..controls (1.37755,-1.71404) and (1.71404,-1.37755)
+ ..(2,-1)..controls (2.33353,-0.55965) and (2.59729,-0.04124)
+ ..(2.5,0.5)..controls (2.36812,1.23369) and (1.6712,1.65662)
+ ..(1,2)..controls (0.66821,2.16974) and (0.33485,2.33641)
+ ..(0,2.5)..controls (-0.37186,2.68167) and (-0.668,2.25146)
+ ..(-1,2)..controls (-1.37755,1.71404) and (-1.71404,1.37755)
+ ..(-2,1)..controls (-2.33353,0.55965) and (-2.59729,0.04124)
+ ..(-2.5,-0.5)..controls (-2.36812,-1.23369) and (-1.6712,-1.65662)
+ ..(-1,-2)..controls (-0.66821,-2.16974) and (-0.33485,-2.33641)
+ ..(0,-2.5)..controls (0.37186,-2.68167) and (0.668,-2.25146)
+ ..cycle
+
+{makepen(path)}
+{qq:=pen}
+{show}
+>> Pen at line 48:
+(-2.5,-0.5)
+ .. (-1,-2)
+ .. (0,-2.5)
+ .. (1,-2)
+ .. (2,-1)
+ .. (2.5,0.5)
+ .. (1,2)
+ .. (0,2.5)
+ .. (-1,2)
+ .. (-2,1)
+ .. cycle
+
+{primarydef}
+{secondarydef}
+
+//<expr>->
+
+//<expr>->
+{pencircle}
+{length(path)}
+{(pen)slanted(1)}
+{((3,6))-((5,-5))}
+
+_aa__<secondary>->if(true
+{(0.1)*(15)}
+{odd(1.50009)}
+{not(false)}
+{known((8,1,5,-5,-5,5))}
+{(true)and(true)}
+(EXPR0)<-true
+{if}
+{true}
+
+!<primary>->false):(EXPR0)fi
+(EXPR0)<-(5,-5)
+{false}
+{(true)or(false)}
+{true}
+{fi}
+{-((5,-5))}
+{-((5,-5))}
+{+(1)}
+{-(1)}
+>> -1
+! Improper curl has been replaced by 1.
+<to be read again>
+ )
+l.52 {curl- +1)
+ ..tension atleast1..cycle sqrt2++sqrt2***[[]];
+A curl must be a known, nonnegative number.
+
+! Missing `}' has been inserted.
+<to be read again>
+ )
+l.52 {curl- +1)
+ ..tension atleast1..cycle sqrt2++sqrt2***[[]];
+I've scanned a direction spec for part of a path,
+so a right brace should have come next.
+I shall pretend that one was there.
+
+Path at line 52, before choices:
+(-5,5)
+
+Path at line 52, after choices:
+(-5,5)
+
+Path at line 52, before choices:
+(3,6)..controls (5,-5) and (-5,5)
+ ..(-5,5)..tension atleast1
+ ..{2896.30943,-2896.30934}cycle
+
+Path at line 52, after choices:
+(3,6)..controls (5,-5) and (-5,5)
+ ..(-5,5)..controls (-3.29726,7.86205) and (0.64516,8.35484)
+ ..cycle
+
+! Missing `)' has been inserted.
+<to be read again>
+ sqrt
+l.52 ...ion atleast1..cycle sqrt
+ 2++sqrt2***[[]];
+I found no right delimiter to match a left one. So I've
+put one in, behind the scenes; this may fix the problem.
+
+{((-2,11))subpath(path)}
+{reverse(path)}
+{makepen(path)}
+
+**->[[show(EXPR0)*(EXPR1)]]
+(EXPR0)<-pen
+(EXPR1)<-pen
+{begingroup}
+{show}
+{(pen)*(pen)}
+>> pen
+>> pen
+! Not implemented: (pen)*(pen).
+<to be read again>
+ ]]
+<to be read again>
+ sqrt
+l.52 ...ion atleast1..cycle sqrt
+ 2++sqrt2***[[]];
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+>> Pen at line 52:
+(-5,5)
+ .. (3,6)
+ .. cycle
+
+{endgroup}
+(EXPR0)<-vacuous
+{sqrt(2)}
+{sqrt(2)}
+{(1.41422)++(1.41422)}
+{begingroup}
+{endgroup}
+
+***->expandafter(EXPR1)scantokens"**oct"(EXPR0)
+(EXPR0)<-2
+(EXPR1)<-vacuous
+{expandafter}
+{scantokens}
+{oct(2)}
+>> 2
+! Not implemented: oct(known numeric).
+<to be read again>
+ ;
+l.52 ...cle sqrt2++sqrt2***[[]];
+
+I'm afraid I don't know how to apply that operation to that
+particular type. Continue, and I'll simply return the
+argument (shown above) as the result of the operation.
+
+
+**->[[show(EXPR0)*(EXPR1)]]
+(EXPR0)<-vacuous
+(EXPR1)<-2
+{begingroup}
+{show}
+{(vacuous)*(2)}
+>> vacuous
+>> 2
+! Not implemented: (vacuous)*(known numeric).
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.52 ...cle sqrt2++sqrt2***[[]];
+
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+>> 2
+{endgroup}
+(EXPR0)<-vacuous
+{-(20.5)}
+{charcode:=-20.5}
+{-(2048)}
+{chardp:=-2048}
+{shipout}
+{nullpicture}
+! Enormous chardp has been reduced.
+<to be read again>
+ ;
+l.53 ...048;shipout nullpicture;
+
+Font metric dimensions must be less than 2048pt.
+
+[]
+Edge structure at line 53 (just shipped out):
+End edges
+
+{if}
+{-(275.50002)}
+{charexists(-275.50002)}
+{known(unknown path p0 0p)}
+{(true)>(false)}
+{known(path)}
+{(true)=(true)}
+{true}
+{randomseed}
+! Missing `:=' has been inserted.
+<to be read again>
+ charcode
+l.54 ... p~: randomseed charcode
+ ; fi
+Always say `randomseed:=<numeric expression>'.
+
+{randomseed:=-20.5}
+{fi}
+{randomseed}
+>> "goof"
+! Unknown value will be ignored.
+<to be read again>
+ ;
+l.55 randomseed:="goof";
+ a[($,18++1+-+18),(2,3)]=b[(3,2),(1,$);
+Your expression was too random for me to handle,
+so I won't change the random seed just now.
+
+{(18)++(1)}
+{(18.02776)+-+(18)}
+{((2,3))-((-1,1))}
+{(a)*((3,2))}
+{((-1,1))+((3a,2a))}
+! Missing `]' has been inserted.
+<to be read again>
+ ;
+l.55 ...8),(2,3)]=b[(3,2),(1,$);
+
+I've scanned an expression of the form `a[b,c',
+so a right bracket should have come next.
+I shall pretend that one was there.
+
+{((1,-1))-((3,2))}
+{(b)*((-2,-3))}
+{((3,2))+((-2b,-3b))}
+{((3a-1,2a+1))=((-2b+3,-3b+2))}
+## b=-0.66667a+0.33333
+## a=2
+#### b=-1
+{show}
+{(^)+(1)}
+{(~)+(2)}
+{-(1)}
+{((^+1,~+2))slanted(-1)}
+{-(2)}
+{((linearform,~+2))yscaled(-2)}
+{-((3,4))}
+{((linearform,-2~-4))zscaled((-3,-4))}
+>> (-5~-3^-13,10~-4^+16)
+{((xpart pp,ypart pp,xxpart pp,xypart pp,yxpart pp,yypart pp))xscaled(9)
+}
+{((8,1,5,-5,-5,5))transformed((9xpart pp,ypart pp,9xxpart pp,9xypart pp,
+yxpart pp,yypart pp))}
+>> (9xpart pp+72xxpart pp+9xypart pp,ypart pp+8yxpart pp+yypart pp,45xxp
+art pp-45xypart pp,-45xxpart pp+45xypart pp,5yxpart pp-5yypart pp,-5yxpa
+rt pp+5yypart pp)
+{((xpart pp,ypart pp,xxpart pp,xypart pp,yxpart pp,yypart pp))shifted((1
+,2))}
+{((8,1,5,-5,-5,5))transformed((8,1,5,-5,-5,5))}
+{((xpart pp+1,ypart pp+2,xxpart pp,xypart pp,yxpart pp,yypart pp))transf
+ormed((43,-34,50,-50,-50,50))}
+>> (50xpart pp-50ypart pp-7,-50xpart pp+50ypart pp+16,50xxpart pp-50yxpa
+rt pp,50xypart pp-50yypart pp,-50xxpart pp+50yxpart pp,-50xypart pp+50yy
+part pp)
+{(2)-(1)}
+{(_0)*(1)}
+{(1)+(_0)}
+{-(_0+1)}
+>> -_0-1
+{show}
+{normaldeviate}
+{-(-2048)}
+{uniformdeviate(2048)}
+{angle((-0.41438,761.67789))}
+{cosd(90.03117)}
+{(200)*(-0.00055)}
+{mexp(-0.10986)}
+{sqrt(0.99957)}
+{mlog(0.99979)}
+{sind(-0.05469)}
+{floor(-0.00096)}
+>> -1
+{string}
+{(unknown string s2)=(unknown string s4)}
+{(unknown string s1)=(unknown string s2)}
+{(unknown string s3)=(unknown string s5)}
+{(unknown string s2)=(unknown string s4)}
+! Redundant equation.
+<to be read again>
+ ;
+l.59 ... s1=s2=s4; s3=s5; s1=s2;
+ if s1<=s4<>(s1<>s3):show[[ch...
+I already knew that this equation was true.
+But perhaps no harm has been done; let's continue.
+
+{if}
+{(unknown string s2)<=(unknown string s1)}
+{(unknown string s2)<>(unknown string s5)}
+>> unknown string s2
+>> unknown string s5
+! Unknown relation will be considered false.
+<to be read again>
+ )
+l.59 ...=s2; if s1<=s4<>(s1<>s3)
+ :show[[char34=s2:=s3]]fi;
+The quantities shown above have not been equated.
+
+{(true)<>(false)}
+{true}
+{show}
+{begingroup}
+{char(34)}
+{s2:=unknown string s5}
+{(""")=(unknown string s2)}
+{endgroup}
+{fi}
+>> vacuous
+{(0.1)point(path)}
+{begingroup}
+{pencircle}
+{endgroup}
+{((3.24413,0.64801))penoffset(pen)}
+{((0.09795,-0.49031))rotated(540)}
+{((-0.09795,0.49031))/(0.33333)}
+{-(1.5)}
+! Paths don't touch; `&' will be changed to `..'.
+<to be read again>
+ )
+l.61 ...tcontrol-1.5of(p~&cycle)
+ -precontrol1/2of p~(p~)=s1:=s...
+When you join paths `p&q', the ending point of p
+must be exactly equal to the starting point of q.
+So I'm going to pretend that you said `p..q' instead.
+
+Path at line 61, before choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+ ..cycle
+
+Path at line 61, after choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)..controls (17.52783,8.54388) and (-15.45978,-4.12262)
+ ..cycle
+
+{(-1.5)postcontrol(path)}
+{(0.5)precontrol(path)}
+{((-2.75,-5))-((3.75,-1))}
+! Missing `of' has been inserted for directiontime.
+<to be read again>
+ (
+l.61 ...cle)-precontrol1/2of p~(
+ p~)=s1:=s4:=s4;
+I've got the first argument; will look now for the other.
+
+{((-6.5,-4))directiontime(path)}
+{decimal(0.5)}
+{((-0.29384,1.47095))substring("0.5")}
+{s4:=unknown string s1}
+{s1:=unknown string s4}
+{("0")=(unknown string s1)}
+{path}
+{length(" ")}
+! Missing `,' has been inserted.
+<to be read again>
+ }
+l.62 ...p~[]; p~1=p2{length" "}
+ &cycle; p~1=p2=p~0; p2..contr...
+I've got the x coordinate of a path direction;
+will look for the y coordinate next.
+
+! An expression can't begin with `}'.
+<inserted text>
+ 0
+<to be read again>
+ }
+l.62 ...p~[]; p~1=p2{length" "}
+ &cycle; p~1=p2=p~0; p2..contr...
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+Path at line 62, before choices:
+(5,-5){4096,0}
+ ..{4096,0}cycle
+
+Path at line 62, after choices:
+(5,-5)..controls (5,-5) and (5,-5)
+ ..cycle
+
+{(unknown path p~1)=(path)}
+{((5,-5))=(unknown path p~0)}
+{(path)=(path)}
+! Redundant or inconsistent equation.
+<to be read again>
+ ;
+l.62 ..." "}&cycle; p~1=p2=p~0;
+ p2..controls-p2..cycle=p~2;(p7
+An equation between already-known quantities can't help.
+But don't worry; continue and I'll just ignore it.
+
+{-((5,-5))}
+Path at line 62, before choices:
+(5,-5)..controls (-5,5) and (-5,5)
+ ..cycle
+
+Path at line 62, after choices:
+(5,-5)..controls (-5,5) and (-5,5)
+ ..cycle
+
+{(path)=(unknown path p~2)}
+{length(path)}
+Path at line 63, before choices:
+(3,6)..tension 1.2
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)
+ ..(5,-5)..controls (-5,5) and (-5,5)
+ ..(5,-5){0,4096}..tension 1 and atleast1
+ ..cycle
+
+Path at line 63, after choices:
+(3,6)..controls (-3.01212,4.82085) and (-1.0424,-6.01257)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (-5,5) and (-5,5)
+ ..(5,-5)..controls (5,0.02791) and (4.99951,6.39217)
+ ..cycle
+
+>> x
+! Improper tension has been set to 1.
+<to be read again>
+ ..
+l.64 x..
+ {curl1}-p7{curl hex "IsBad"}..tension.75and.74999..p...
+The expression above should have been a number >=3/4.
+
+{-((3,6))}
+{hex("IsBad")}
+>> "IsBad"
+! String contains illegal digits.
+<to be read again>
+ }
+l.64 ...l1}-p7{curl hex "IsBad"}
+ ..tension.75and.74999..p2{0,1...
+I zeroed out characters that weren't hex digits.
+
+>> 0.74998
+! Improper tension has been set to 1.
+<to be read again>
+ ..
+l.64 ...}..tension.75and.74999..
+ p2{0,1}&p2{_,'}..cycle:=p
+The expression above should have been a number >=3/4.
+
+>> _
+! Undefined x coordinate has been replaced by 0.
+<to be read again>
+ ,
+l.64 ...and.74999..p2{0,1}&p2{_,
+ '}..cycle:=p
+I need a `known' x value for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+>> (xpart ',ypart ')
+! Undefined y coordinate has been replaced by 0.
+<to be read again>
+ }
+l.64 ...d.74999..p2{0,1}&p2{_,'}
+ ..cycle:=p
+I need a `known' y value for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+Path at line 64, before choices:
+(3,6)..controls (-3.01212,4.82085) and (-1.0424,-6.01257)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (-5,5) and (-5,5)
+ ..(5,-5)..controls (5,0.02791) and (4.99951,6.39217)
+ ..(3,6)
+ ..{curl 1}(-3,-6){curl 2989}..tension 0.75 and 1
+ ..{0,4096}(5,-5){curl 1}
+ ..cycle
+
+Path at line 64, after choices:
+(3,6)..controls (-3.01212,4.82085) and (-1.0424,-6.01257)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (5,-5) and (5,-5)
+ ..(5,-5)..controls (-5,5) and (-5,5)
+ ..(5,-5)..controls (5,0.02791) and (4.99951,6.39217)
+ ..(3,6)..controls (-2.44821,4.93144) and (-5.41408,-1.00029)
+ ..(-3,-6)..controls (-3.70045,-12.19485) and (5,-11.61679)
+ ..(5,-5)..controls (12.45406,-3.75087) and (10.41669,7.45464)
+ ..cycle
+
+>> path
+! Improper `:=' will be changed to `='.
+l.64 ...p2{0,1}&p2{_,'}..cycle:=
+ p
+I didn't find a variable name at the left of the `:=',
+so I'm going to pretend that you said `=' instead.
+
+{(path)=(unknown path p~4)}
+{-(9)}
+{((3.5001,7.00002))subpath(path)}
+{((-9,9))subpath(path)}
+{(path)=(unknown path p~6)}
+{show}
+>> Path at line 66:
+(-2.5,2.5)..controls (-2.49893,2.49893) and (0.00107,-0.00107)
+ ..(5,-5)..controls (5,0.02791) and (4.99951,6.39217)
+ ..(3,6)..controls (-2.44821,4.93144) and (-5.41408,-1.00029)
+ ..(-3,-6)..controls (-3.70045,-12.19485) and (5,-11.61679)
+ ..(5,-5)..controls (5.0001,-4.99998) and (5.00021,-4.99997)
+ ..(5.00032,-4.99995)
+
+{((1,2))directiontime(path)}
+>> 1
+{-(1.00002)}
+{((1,-1.00002))directiontime(path)}
+>> 3.24937
+Path at line 67, before choices:
+(0,0)..controls (1,1) and (0,1)
+ ..(1,0)
+
+Path at line 67, after choices:
+(0,0)..controls (1,1) and (0,1)
+ ..(1,0)
+
+{(unknown path p~3)=(path)}
+{show}
+Path at line 67, before choices:
+(5,-5){-2896.30943,-2896.30934}
+ ..{1831.78674,3663.57385}cycle
+
+Path at line 67, after choices:
+(5,-5)..controls (5,-5) and (5,-5)
+ ..cycle
+
+>> Path at line 67:
+(5,-5)..controls (5,-5) and (5,-5)
+ ..cycle
+
+{((0.31416,1))subpath(path)}
+{((1,1))directiontime(path)}
+{(1)-(0.31416)}
+{(0.27097)*(0.68584)}
+{(0.31416)+(0.18584)}
+>> 0.5
+{((0,0.25))subpath(path)}
+{((0.25,1))subpath(path)}
+Path at line 69, before choices:
+(0,0)..controls (0.25,0.25) and (0.375,0.4375)
+ ..(0.4375,0.5625)..controls (0.625,0.9375) and (0.25,0.75)
+ ..(1,0)
+
+Path at line 69, after choices:
+(0,0)..controls (0.25,0.25) and (0.375,0.4375)
+ ..(0.4375,0.5625)..controls (0.625,0.9375) and (0.25,0.75)
+ ..(1,0)
+
+! Missing `endtext' has been inserted.
+<to be read again>
+ ;
+l.69 ...~3)shifted begintext1,0;
+
+I found no right delimiter to match a left one. So I've
+put one in, behind the scenes; this may fix the problem.
+
+{(path)shifted((1,0))}
+{(unknown path p~5)=(path)}
+{(2/3)*((xpart ',ypart '))}
+{((0.66667xpart ',0.66667ypart '))zscaled((xpart ',ypart '))}
+>> (0,0,xpart ',-ypart ',ypart ',xpart ')
+! Transform components aren't all known.
+<to be read again>
+ {
+l.70 p~3:=2/3'zscaled'{
+ p~3}..controls(2,2/3(3))and penoffset(...
+I'm unable to apply a partially specified transformation
+except to a fully known pair or transform.
+Proceed, and I'll omit the transformation.
+
+>> 0.66667xpart '
+! Undefined x coordinate has been replaced by 0.
+<to be read again>
+ {
+l.70 p~3:=2/3'zscaled'{
+ p~3}..controls(2,2/3(3))and penoffset(...
+I need a `known' x value for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+>> 0.66667ypart '
+! Undefined y coordinate has been replaced by 0.
+<to be read again>
+ {
+l.70 p~3:=2/3'zscaled'{
+ p~3}..controls(2,2/3(3))and penoffset(...
+I need a `known' y value for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+>> path
+! Undefined coordinates have been replaced by (0,0).
+<to be read again>
+ }
+l.70 p~3:=2/3'zscaled'{p~3}
+ ..controls(2,2/3(3))and penoffset(...
+I need x and y numbers for this part of the path.
+The value I found (see above) was no good;
+so I'll try to keep going by using zero instead.
+(Chapter 27 of The METAFONTbook explains that
+you might want to type `I ???' now.)
+
+{(2/3)*(3)}
+{(1/2)*(x)}
+{((0.5x,-5))penoffset((0,1))}
+>> (0.5x,-5)
+>> (0,1)
+! Not implemented: penoffset(unknown pair)of(pair).
+<to be read again>
+ (
+l.70 ...enoffset(1/2x,y)of(0,1)(
+ 1,0);
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+! Missing `..' has been inserted.
+<to be read again>
+ (
+l.70 ...enoffset(1/2x,y)of(0,1)(
+ 1,0);
+A path join command should end with two dots.
+
+Path at line 70, before choices:
+(0,0)..controls (2,2) and (0,1)
+ ..(1,0)
+
+Path at line 70, after choices:
+(0,0)..controls (2,2) and (0,1)
+ ..(1,0)
+
+{p~3:=path}
+{show}
+{reverse(path)}
+{(path)intersectiontimes(path)}
+>> (0.17227,0.28339)
+{(0.17227)point(path)}
+>> (0.71329,0.78188)
+{(1)-(0.28339)}
+{(0.71661)point(path)}
+>> (0.7133,0.78189)
+{show}
+{(path)shifted((0.01,0))}
+{(path)intersectiontimes(path)}
+{xpart((1.47693,1.18973))}
+{(1.47693)point(path)}
+{(path)shifted((0.01,0))}
+{(path)intersectiontimes(path)}
+{ypart((1.47693,1.18973))}
+{(1.18973)point(path)}
+{((1.50499,0.71521))-((1.495,0.71521))}
+>> (0.01,0)
+{begingroup}
+{-(1)}
+{-(1.00002)}
+{(-1)+-+(-1.00002)}
+! Pythagorean subtraction 1+-+1.00002 has been replaced by 0.
+l.74 [[ e[-1+-+ -1.00001]
+ =nullpicture; addto e1 also[[
+Since I don't take square roots of negative numbers,
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{nullpicture}
+{(unknown picture e0)=(picture)}
+{addto}
+{begingroup}
+{addto}
+{(path)scaled(3)}
+{(unknown picture e1)=(unknown picture e2)}
+{(picture)=(unknown picture e1)}
+{nullpicture}
+{endgroup}
+{show}
+>> Edge structure at line 76:
+Filled pen stroke :
+(3,0)..controls (3.75,0.75) and (4.125,1.3125)
+ ..(4.3125,1.6875)..controls (4.875,2.8125) and (3.75,2.25)
+ ..(6,0)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+End edges
+
+{-(3)}
+{(picture)shifted((-3,0))}
+>> Edge structure at line 76:
+Filled pen stroke :
+(0,0)..controls (0.75,0.75) and (1.125,1.3125)
+ ..(1.3125,1.6875)..controls (1.875,2.8125) and (0.75,2.25)
+ ..(3,0)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+End edges
+
+{endgroup}
+{addto}
+{-(2)}
+{(picture)shifted((-2,-1))}
+{-(4)}
+{(picture)shifted((-4,-1))}
+{e1:=picture}
+{addto}
+{turningnumber(path)}
+{oct("180")}
+>> "180"
+! String contains illegal digits.
+<to be read again>
+ ++
+l.79 ...en qq xscaled(oct"180"++
+ 1) rotated-angle(64,$) shifte...
+I zeroed out characters that weren't in the range 0..7.
+
+{(64)++(1)}
+{(pen)xscaled(64.00781)}
+{angle((64,-1))}
+{-(-0.89517)}
+{(pen)rotated(0.89517)}
+{(pen)shifted((9,8))}
+{show}
+>> Edge structure at line 80:
+Filled pen stroke :
+(-1,-1)..controls (-0.25,-0.25) and (0.125,0.3125)
+ ..(0.3125,0.6875)..controls (0.875,1.8125) and (-0.25,1.25)
+ ..(2,-1)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+Filled pen stroke :
+(-3,-2)..controls (-2.25,-1.25) and (-1.875,-0.6875)
+ ..(-1.6875,-0.3125)..controls (-1.125,0.8125) and (-2.25,0.25)
+ ..(0,-2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+Filled pen stroke colored (0.4,1,0):
+(0,9)
+butt ends, mitered joins limited 1 with pen
+(-150.99219,4.99976)
+ .. (-54.96875,5.00012)
+ .. (9.03906,5.5003)
+ .. (73.03125,7.00037)
+ .. (137.01563,9.00037)
+ .. (168.99219,11.00024)
+ .. (72.96875,10.99988)
+ .. (8.96094,10.4997)
+ .. (-55.03125,8.99963)
+ .. (-119.01563,6.99963)
+ .. cycle
+End edges
+
+{charcode:=5}
+{chardp:=5}
+{-(1.5)}
+{xoffset:=-1.5}
+## xoffset=-1.5
+{shipout}
+[5
+Envelope spec at line 80:
+(0,9) % beginning with offset (-150.99219,4.99976)
+ ..controls (0,9) and (0,9)
+ ..(0,9) % counterclockwise to offset (-150.99219,4.99976)
+ & cycle
+
+]
+Edge structure at line 80 (just shipped out):
+Filled pen stroke :
+(-1,-1)..controls (-0.25,-0.25) and (0.125,0.3125)
+ ..(0.3125,0.6875)..controls (0.875,1.8125) and (-0.25,1.25)
+ ..(2,-1)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+Filled pen stroke :
+(-3,-2)..controls (-2.25,-1.25) and (-1.875,-0.6875)
+ ..(-1.6875,-0.3125)..controls (-1.125,0.8125) and (-2.25,0.25)
+ ..(0,-2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+Filled pen stroke colored (0.4,1,0):
+(0,9)
+butt ends, mitered joins limited 1 with pen
+(-150.99219,4.99976)
+ .. (-54.96875,5.00012)
+ .. (9.03906,5.5003)
+ .. (73.03125,7.00037)
+ .. (137.01563,9.00037)
+ .. (168.99219,11.00024)
+ .. (72.96875,10.99988)
+ .. (8.96094,10.4997)
+ .. (-55.03125,8.99963)
+ .. (-119.01563,6.99963)
+ .. cycle
+End edges
+
+{nullpicture}
+{(unknown picture e3)=(picture)}
+{showstats}
+Memory usage 1178&115 (2344 still untouched)
+String usage 22&84 (1244&9177 now untouched)
+{addto}
+Path at line 81, before choices:
+(0.5,0){curl 1}
+ ..{curl 1}(3.5,1.5)
+
+Path at line 81, after choices:
+(0.5,0)..controls (1.5,0.5) and (2.5,1)
+ ..(3.5,1.5)
+
+Path at line 82, before choices:
+(1,1)
+ ..cycle
+
+Path at line 82, after choices:
+(1,1)..controls (1,1) and (1,1)
+ ..cycle
+
+{makepen(path)}
+{(pen)yscaled(1.5)}
+{q:=pen}
+{-(14.5)}
+{charext:=-14.5}
+{chardp:=-14.5}
+{chardx:=-14.5}
+## chardx=-14.5
+{charcode:=6}
+{shipout}
+[6]
+Edge structure at line 83 (just shipped out):
+Filled pen stroke :
+(3,0)..controls (3.75,0.75) and (4.125,1.3125)
+ ..(4.3125,1.6875)..controls (4.875,2.8125) and (3.75,2.25)
+ ..(6,0)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+End edges
+
+Path at line 84, before choices:
+(0,0){curl 1}
+ ..(1,0.5)
+ ..(5,1.5)
+ ..(7,2.5)
+ ..(12,3.5)
+ ..{curl 1}(13,4)
+
+Path at line 84, after choices:
+(0,0)..controls (0.3153,0.20053) and (0.6504,0.36807)
+ ..(1,0.5)..controls (2.29114,0.98723) and (3.72412,0.97192)
+ ..(5,1.5)..controls (5.68967,1.78545) and (6.30771,2.22081)
+ ..(7,2.5)..controls (8.58867,3.1407) and (10.3946,2.90645)
+ ..(12,3.5)..controls (12.3506,3.62962) and (12.68594,3.7973)
+ ..(13,4)
+
+{(unknown path p~9)=(path)}
+{addto}
+{addto}
+! A primary expression can't begin with `doublepath'.
+<inserted text>
+ 0
+<to be read again>
+ doublepath
+l.85 addto doublepath
+ (-4095,0)..tension
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+>> 0
+! Not a suitable variable.
+<to be read again>
+ doublepath
+l.85 addto doublepath
+ (-4095,0)..tension
+At this point I needed to see the name of a picture variable.
+(Or perhaps you have indeed presented me with one; I might
+have missed it, if it wasn't followed by the proper token.)
+So I'll not change anything just now.
+
+! Extra tokens will be flushed.
+<to be read again>
+ doublepath
+l.85 addto doublepath
+ (-4095,0)..tension
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+{show}
+{-(90)}
+{(picture)rotated(-90)}
+>> Edge structure at line 86:
+Filled pen stroke :
+(0,-0.5)..controls (0.5,-1.5) and (1,-2.5)
+ ..(1.5,-3.5)
+dashed (on 3 off 0) shifted 0
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+Filled pen stroke :
+(0,0)..controls (0.20053,-0.3153) and (0.36807,-0.6504)
+ ..(0.5,-1)..controls (0.98723,-2.29114) and (0.97192,-3.72412)
+ ..(1.5,-5)..controls (1.78545,-5.68967) and (2.22081,-6.30771)
+ ..(2.5,-7)..controls (3.1407,-8.58867) and (2.90645,-10.3946)
+ ..(3.5,-12)..controls (3.62962,-12.3506) and (3.7973,-12.68594)
+ ..(4,-13)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+End edges
+
+{if}
+{if}
+{elseif}
+! Missing `:' has been inserted.
+<inserted text>
+ :
+<to be read again>
+ elseif
+l.87 if "a" if "ab">"b" elseif
+ path reverse (3,4): >="aa":foo...
+
+{("ab")>("b")}
+{false}
+{reverse((3,4))}
+{path(path)}
+{true}
+{("a")>=("aa")}
+{false}
+{if}
+{((xpart ',ypart '))-((1,yy))}
+{((xpart '-1,linearform))<((xpart ',ypart '))}
+{true}
+{fi}
+{else}
+! Extra else.
+l.88 ... if '-(1,yy)<': :fi else
+ def dup text t=[[t;save endd...
+I'm ignoring this; it doesn't match any if.
+
+{def}
+{def}
+{def}
+
+||<tertiary>->show.substring(EXPR0)of("a"
+(EXPR0)<-(2,-1)
+{show}
+{("a")&("bc")}
+{((2,-1))substring("abc")}
+>> "ba"
+{tertiarydef}
+{def}
+{show}
+{((23.3,4.5))subpath(path)}
+Path at line 95, before choices:
+(0,0){curl 2}
+ ..(13,4)..controls (12.84297,3.89865) and (12.68063,3.80606)
+ ..(12.51372,3.72261){curl 3}
+ ..{curl 4}(-1,-1){curl 4}
+ ..{curl 2}cycle
+
+Path at line 95, after choices:
+(0,0)..controls (-40.15552,-36.7088) and (58.71173,33.50317)
+ ..(13,4)..controls (12.84297,3.89865) and (12.68063,3.80606)
+ ..(12.51372,3.72261)..controls (8.00914,2.1484) and (3.50458,0.5742)
+ ..(-1,-1)..controls (-0.66667,-0.66667) and (-0.33333,-0.33333)
+ ..cycle
+
+>> Path at line 95:
+(0,0)..controls (-40.15552,-36.7088) and (58.71173,33.50317)
+ ..(13,4)..controls (12.84297,3.89865) and (12.68063,3.80606)
+ ..(12.51372,3.72261)..controls (8.00914,2.1484) and (3.50458,0.5742)
+ ..(-1,-1)..controls (-0.66667,-0.66667) and (-0.33333,-0.33333)
+ ..cycle
+
+{(2)+(3)}
+
+++->[[dup.showtoken(EXPR0);]];def.x.expr.z.of(EXPR1)=z.enddef;texts(x=((
+EXPR1)+0)(EXPR1)+(EXPR1))("xx",foo((EXPR0)))=0]]
+(EXPR0)<-path
+(EXPR1)<-5
+{begingroup}
+
+dup<text>->[[(TEXT0);save
+(TEXT0)<-showtoken(path)
+{begingroup}
+{showtoken}
+> (path)
+{save}
+{restoring ;}
+{endgroup}
+{def}
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+++->...]];def.x.expr.z.of(EXPR1)
+ =z.enddef;texts(x=((EXPR1)+0)...
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+Sorry: You can't redefine a number, string, or expr.
+I've inserted an inaccessible symbol so that your
+definition will be completed without mixing me up too badly.
+
+
+texts(TEXT0)(TEXT1)<expr>->for.n:=,for.n"yy":n,length.if.false:endfor(TE
+XT1),(TEXT0),:if.string.n:forsuffixes.n=foo1,[foo(n)],':show(TEXT0),(TEX
+T1)|(n;exitif.not('<='+((EXPR2),yy))endfor.for.m= :+endfor.for.m=alpha.s
+tep-1.1 3$:+m.endfor.fi.endfor
+(TEXT0)<-x=((5)+0)(5)+(5)
+(TEXT1)<-"xx",foo((path))
+(EXPR2)<-0
+{for}
+{for}
+! Missing `=' has been inserted.
+<to be read again>
+ "yy"
+texts->for.n:=,for.n"yy"
+ :n,length.if.false:endfor(TEXT1),(TEX...
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+The next thing in this loop should have been `=' or `:='.
+But don't worry; I'll pretend that an equals sign
+was present, and I'll look for the values next.
+
+{loop value="yy"}
+{if}
+{false}
+{false}
+! Incomplete if; all text was ignored after line 95.
+<inserted text>
+ fi
+<to be read again>
+ ENDFOR
+<for("yy")> ....if.false: ENDFOR
+
+texts->...length.if.false:endfor
+ (TEXT1),(TEXT0),:if.string.n:...
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+A forbidden `outer' token occurred in skipped text.
+This kind of error happens when you say `if...' and forget
+the matching `fi'. I've inserted a `fi'; this might work.
+
+{[repeat the loop]}
+{length("xx")}
+
+foo(TEXT2)->begingroup(TEXT2)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-foo
+(TEXT2)<-(path)
+{begingroup}
+{endgroup}
+
+x<expr>of<primary>->(EXPR0)
+{(5)+(0)}
+(EXPR0)<-5
+! Missing `of' has been inserted for x.
+<to be read again>
+ (5)
+<argument> x=((5)+0)(5)
+ +(5)
+texts->...:endfor(TEXT1),(TEXT0)
+ ,:if.string.n:forsuffixes.n=f...
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+I've got the first argument; will look now for the other.
+
+(EXPR1)<-5
+{(5)+(5)}
+{loop value="yy"}
+{if}
+{string("yy")}
+{true}
+{forsuffixes}
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+<for("yy")> ...orsuffixes(EXPR0)
+ =foo1,[foo((EXPR0))],':show.x...
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+Sorry: You can't redefine a number, string, or expr.
+I've inserted an inaccessible symbol so that your
+definition will be completed without mixing me up too badly.
+
+
+foo(TEXT2)->begingroup(TEXT2)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-foo
+(TEXT2)<-("yy")
+{begingroup}
+{endgroup}
+>> "yy"
+! Improper subscript has been replaced by zero.
+<for("yy")> ...o1,[foo((EXPR0))]
+ ,':show.x=((5)+0)(5)+(5),"xx"...
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+A bracketed subscript must have a known numeric value;
+unfortunately, what I found was the value that appears just
+above this error message. So I'll try a zero subscript.
+
+{loop value=foo1}
+{show}
+
+x<expr>of<primary>->(EXPR0)
+{(5)+(0)}
+(EXPR0)<-5
+! Missing `of' has been inserted for x.
+<to be read again>
+ (5)
+<for(foo1)> show.x=((5)+0)(5)
+ +(5),"xx",foo((path))|(("yy");ex...
+<for("yy")> ...'+((0),yy))endfor
+ .for.m= :+endfor.for.m=alpha....
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+I've got the first argument; will look now for the other.
+
+(EXPR1)<-5
+{(5)+(5)}
+>> 10
+>> "xx"
+foo(TEXT2)->begingroup(TEXT2)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-foo
+(TEXT2)<-(path)
+{begingroup}
+{endgroup}
+
+|<suffix>->,(SUFFIX0)
+! Missing `)' has been inserted.
+<to be read again>
+ ("yy")
+<for(foo1)> ...o((path))|(("yy")
+ ;exitif.not('<='+((0),yy)) EN...
+<for("yy")> ...'+((0),yy))endfor
+ .for.m= :+endfor.for.m=alpha....
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+I've gotten to the end of the macro parameter list.
+You might want to delete some tokens before continuing.
+
+(SUFFIX0)<-
+>> Path at line 95:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+
+>> "yy"
+{exitif}
+{((xpart ',ypart '))+((0,yy))}
+{((xpart ',ypart '))<=((xpart ',linearform))}
+>> -yy
+! Unknown relation will be considered false.
+<to be read again>
+ )
+<for(foo1)> ...ot('<='+((0),yy))
+ ENDFOR
+<for("yy")> ...'+((0),yy))endfor
+ .for.m= :+endfor.for.m=alpha....
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+Oh dear. I can't decide if the expression above is positive,
+negative, or zero. So this comparison test won't be `true'.
+
+{[repeat the loop]}
+{loop value=0}
+{not(false)}
+{true}
+{for}
+{for}
+>> 0.5p3~
+! Improper initial value has been replaced by 0.
+<to be read again>
+ step
+<for("yy")> ....for.m=alpha.step
+ -1.1 3$:+m.endfor.fi ENDFOR
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+When you say `for x=a step b until c',
+the initial value `a' and the step size `b'
+and the final value `c' must have known numeric values.
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{-(1.1)}
+! Missing `until' has been inserted.
+<to be read again>
+ 3
+<for("yy")> ...=alpha.step-1.1 3
+ $:+m.endfor.fi ENDFOR
+texts->...3$:+m.endfor.fi.endfor
+
+<to be read again>
+ ]]
+<to be read again>
+ ;
+l.95 ...rl4}..cycle;zzz=p~++2+3;
+ [[
+I assume you meant to say `until' after `step'.
+So I'll look for the final value and colon next.
+
+{(3)*(-1)}
+{loop value=0}
+{[repeat the loop]}
+{loop value=-1.1}
+{+(0)}
+{[repeat the loop]}
+{loop value=-2.20001}
+{(0)+(-1.1)}
+{[repeat the loop]}
+{fi}
+{[repeat the loop]}
+{loop value=2}
+{if}
+{string(2)}
+{false}
+{[repeat the loop]}
+{loop value=path}
+{if}
+{string(path)}
+{false}
+{[repeat the loop]}
+{loop value=10}
+{if}
+{string(10)}
+{false}
+{[repeat the loop]}
+{(-1.1)+(-2.20001)}
+{endgroup}
+{(zzz)=(-3.30002)}
+## zzz=-3.30002
+{begingroup}
+{let}
+{save}
+{def}
+{def}
+
+texts->input
+{input}
+(trap.mp
+if->endinput?
+{endinput}
+{if}
+{known(0)}
+{not(true)}
+{false}
+)
+! Incomplete if; all text was ignored after line 2.
+<inserted text>
+ fi
+l.96 ...=input enddef;texts trap
+ ]];
+The file ended while I was skipping conditional text.
+This kind of error happens when you say `if...' and forget
+the matching `fi'. I've inserted a `fi'; this might work.
+
+{restoring \}
+{restoring if}
+{endgroup}
+
+dup<text>->[[(TEXT0);save
+Runaway text?
+[[def.texts.secondary.x=primarydef.y++y=x@y.enddef;showtoken ETC.
+! Forbidden token found while scanning a text argument.
+<inserted text>
+ endgroup
+<to be read again>
+ \
+l.97 ... showtoken++;x enddef]]\
+ ;
+It seems that a right delimiter was left out,
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+(TEXT0)<-[[def.texts.secondary.x=primarydef.y++y=x@y.enddef;showtoken++;
+x.enddef]]
+{begingroup}
+{begingroup}
+{def}
+{endgroup}
+{save}
+! Missing symbolic token inserted.
+<inserted text>
+ INACCESSIBLE
+<to be read again>
+ \
+l.97 ... showtoken++;x enddef]]\
+ ;
+Sorry: You can't redefine my error-recovery tokens.
+I've inserted an inaccessible symbol so that your
+definition will be completed without mixing me up too badly.
+
+{\}
+
+texts<secondary>->primarydef.y++y=(EXPR0)@y.enddef;showtoken++;(EXPR0)
+(EXPR0)<-"a"
+{primarydef}
+{showtoken}
+> ++=primarydef'd macro:
+("a")@(EXPR1)
+{("a")&("b")}
+ab
+texts<secondary>->primarydef.y++y=(EXPR0)@y.enddef;showtoken++;(EXPR0)
+{(1.00002)*(a1)}
+{-(1.00002a1)}
+(EXPR0)<--1.00002a1
+{primarydef}
+{showtoken}
+> ++=primarydef'd macro:
+(-1.00002a1)@(EXPR1)
+{(a2)+(a3)}
+{(linearform)+(a4)}
+{(linearform)+(a5)}
+{(linearform)+(a6)}
+{-(linearform)}
+{(-1.00002a1)=(linearform)}
+## a1=0.99998a6+0.99998a5+0.99998a4+0.99998a3+0.99998a2
+{-((a3,a2))}
+{((-a3,-a2))/(0.99998)}
+{(a4)+(a5)}
+{begingroup}
+{showdependencies}
+a1=0.99998a6+0.99998a5+0.99998a4+0.99998a3+0.99998a2
+alpha=0.5p3~
+{endgroup}
+{(linearform)+(a6)}
+{(a3)+(a4)}
+{(linearform)+(a5)}
+{(linearform)+(a6)}
+{-((linearform,linearform))}
+{((-1.00002a3,-1.00002a2))=((linearform,linearform))}
+## a2=0.99998a6+0.99998a5+0.99998a4+0.99998a3
+## a3=0.99998a6+0.99998a5+0.99998a4
+{restoring INACCESSIBLE}
+{endgroup}
+{(1.00002)*(0.25a4*4)}
+{(0.25a4*4)+(1)}
+{(0.25a5*4)+(0.25a6*4)}
+{(0.25a4*4+1)=(linearform)}
+## a4*4=0.99998a6*4+0.99998a5*4-3.99994
+{(0.9)*(0.5p3~)}
+{(0.45p3~)+(7)}
+{alpha:=0.45p3~+7}
+## alpha=0.45p3~+7
+{showdependencies}
+alpha=0.45p3~+7
+a4=0.25a6*4+0.25a5*4-0.99998
+a3=0.49998a6*4+0.49998a5*4-0.99997
+a2=0.99997a6*4+0.99997a5*4-1.99992
+a1=1.99992a6*4+1.99992a5*4-3.99982
+{(0.66667)-(0.25a6*4)}
+{(0.25a6*4)=(-0.25a6*4+0.66667)}
+## a6*4=1.33334
+{(0.25a5*4)=(0.33333)}
+## a5*4=1.33331
+#### a4=-0.33333
+#### a3=0.33333
+#### a2=0.66664
+#### a1=1.33328
+{chardp:=27}
+{charcode:=27}
+{(3.1)=(aaz)}
+## aaz=3.1
+{show}
+>> 3.1
+{ligtable}
+{show}
+{begingroup}
+{interim}
+{tracingcommands:=0}
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"g"
+(TEXT1)<-=:|
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"h":"i"
+(TEXT1)<-|=:
+! Character h is already in a ligtable.
+<to be read again>
+ :
+<argument> "h":
+ "i"
+lig->...;ligtable(TEXT0):(TEXT0)
+ (TEXT1)0,skipto255;boundarych...
+l.102 ...=:|); lig("h":"i")(|=:)
+ ;
+It's not legal to label a character more than once.
+So I'll not change anything just now.
+
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"j"
+(TEXT1)<-|=:>
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"k"
+(TEXT1)<-=:|>
+
+lig(TEXT0)(TEXT1)->ligtable0::for*=1step1until60:0kern.boundarychar+*,en
+dfor.skipto0;ligtable(TEXT0):(TEXT0)(TEXT1)0,skipto255;boundarychar:=bou
+ndarychar+51.29999
+(TEXT0)<-"l"
+(TEXT1)<-|=:|>
+{restoring tracingcommands=2.1}
+{endgroup}
+>> vacuous
+{begingroup}
+{let}
+{vardef}
+{endgroup}
+! Variable c.a1 has been obliterated.
+<to be read again>
+ ;
+l.104 ...;vardef b=enddef;1]] ];
+ ligtable"m":0=:0,skipto5;
+It seems you did a nasty thing---probably by accident,
+but nevertheless you nearly hornswoggled me...
+While I was evaluating the suffix of this variable,
+something was redefined, and it's no longer a variable!
+In order to get back on my feet, I've inserted `0' instead.
+
+{b1:=0}
+! Variable b1 has been obliterated.
+<to be read again>
+ ;
+l.104 ...;vardef b=enddef;1]] ];
+ ligtable"m":0=:0,skipto5;
+It seems you did a nasty thing---probably by accident,
+but nevertheless you nearly hornswoggled me...
+While I was evaluating the right-hand side of this
+command, something happened, and the left-hand side
+is no longer a variable! So I won't change anything.
+
+{ligtable}
+! A statement can't begin with `skipto'.
+<to be read again>
+ !!
+l.105 !!
+ ; errhelp 0; errmessage "Be like Jane";
+I was looking for the beginning of a new statement.
+If you just proceed without changing anything, I'll ignore
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+! Extra tokens will be flushed.
+<to be read again>
+ !!
+l.105 !!
+ ; errhelp 0; errmessage "Be like Jane";
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+{errhelp}
+>> 0
+! Not a string.
+<to be read again>
+ ;
+l.105 !!; errhelp 0;
+ errmessage "Be like Jane";
+A message should be a known string expression.
+
+{errmessage}
+! Be like Jane.
+<to be read again>
+ ;
+l.105 ...message "Be like Jane";
+
+This error message was generated by an `errmessage'
+command, so I can't give any explicit help.
+Pretend that you're Miss Marple: Examine all clues,
+and deduce the truth by inspired guesses.
+
+{errhelp}
+{errmessage}
+! .
+<to be read again>
+ ;
+l.106 ...e%%%lp%"; errmessage"";
+ errhelp ""; errmessage "Anot...
+He%
+lp
+
+
+{errhelp}
+{errmessage}
+! Another.
+<to be read again>
+ ;
+l.106 ...; errmessage "Another";
+
+(That was another `errmessage'.)
+
+{headerbyte}
+>> 0
+! Improper location.
+<to be read again>
+ ;
+l.107 headerbyte 0;
+ headerbyte(48.5)substring(-9,9)of"long"; ...
+I was looking for a known, positive number.
+For safety's sake I'll ignore the present command.
+
+{headerbyte}
+! Missing `:' has been inserted.
+<to be read again>
+ substring
+l.107 ...aderbyte(48.5)substring
+ (-9,9)of"long"; for\=0:\
+A colon should follow a headerbyte or fontinfo location.
+
+{-(9)}
+{((-9,9))substring("long")}
+>> "long"
+! Invalid code has been replaced by 0.
+<to be read again>
+ ;
+l.107 ...ubstring(-9,9)of"long";
+ for\=0:\
+I was looking for a number between 0 and 255, or for a
+string of length 1. Didn't find it; will use 0 instead.
+
+{for}
+Runaway loop?
+! Forbidden token found while scanning the text of a for loop.
+<inserted text>
+ endfor
+<to be read again>
+ \
+l.107 ...-9,9)of"long"; for\=0:\
+
+I suspect you have forgotten an `endfor',
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{loop value=0}
+{[repeat the loop]}
+{\}
+{headerbyte}
+{(2)*(0.33333)}
+{fontdimen}
+{(2)*(0.33333)}
+>> "q"
+! Improper font parameter.
+<to be read again>
+ ;
+l.108 ..."; fontdimen 9:2a6,"q";
+ fontdimen 1:2048;
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{fontdimen}
+{fontmaking:=1}
+{extensible}
+! Missing `:' has been inserted.
+<to be read again>
+ 5
+l.109 ...king:=1; extensible 5 5
+ ,"c"255.5,"d"; charlist 0:5:"...
+I'm processing `extensible c: t,m,b,r'.
+
+! Missing `,' has been inserted.
+<to be read again>
+ 255.5
+l.109 ...extensible 5 5,"c"255.5
+ ,"d"; charlist 0:5:"a":"d";
+I'm processing `extensible c: t,m,b,r'.
+
+>> 255.5
+! Invalid code has been replaced by 0.
+<to be read again>
+ ,
+l.109 ...xtensible 5 5,"c"255.5,
+ "d"; charlist 0:5:"a":"d";
+I was looking for a number between 0 and 255, or for a
+string of length 1. Didn't find it; will use 0 instead.
+
+{charlist}
+! Character code 5 is already extensible.
+<to be read again>
+ :
+l.109 ...,"d"; charlist 0:5:"a":
+ "d";
+It's not legal to label a character more than once.
+So I'll not change anything just now.
+
+{ligtable}
+! Too far to skip.
+l.110 ligtable255:255::
+ "a"=:"b","d" kern -2048,"c":0:99.5:"e"...
+At most 127 lig/kern steps can separate skipto1 from 1::.
+
+{-(2048)}
+! Character code 0 is already in a charlist.
+<to be read again>
+ :
+l.110 ...","d" kern -2048,"c":0:
+ 99.5:"e"|=:|"f",0kern';
+It's not legal to label a character more than once.
+So I'll not change anything just now.
+
+>> (xpart ',ypart ')
+! Improper kern.
+<to be read again>
+ ;
+l.110 ...99.5:"e"|=:|"f",0kern';
+
+The amount of kern should be a known numeric value.
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{ligtable}
+! Character code 5 is already extensible.
+<to be read again>
+ :
+l.111 ligtable 5:
+ 0; def clear(text x)=interim x:=$ enddef; cl...
+It's not legal to label a character more than once.
+So I'll not change anything just now.
+
+! Illegal ligtable step.
+<to be read again>
+ ;
+l.111 ligtable 5:0;
+ def clear(text x)=interim x:=$ enddef; cl...
+I was looking for `=:' or `kern' here.
+
+{def}
+
+clear(TEXT0)->interim(TEXT0):=$
+(TEXT0)<-hppp
+{interim}
+! The token `hppp' isn't an internal quantity.
+<to be read again>
+ hppp
+clear->interim(TEXT0)
+ :=$
+l.111 ...:=$ enddef; clear(hppp)
+ ; vppp=0;
+Something like `tracingonline' should follow `interim'.
+
+{hppp:=-1}
+## hppp=-1
+{(vppp)=(0)}
+## vppp=0
+{begingroup}
+
+clear(TEXT0)->interim(TEXT0):=$
+(TEXT0)<-tracingmacros
+{interim}
+{tracingmacros:=-1}
+{interim}
+{tracingcommands:=-1}
+Runaway text?
+tracingoutput
+! Forbidden token found while scanning a text argument.
+<inserted text>
+ )
+<to be read again>
+ \
+l.112 ...); clear(tracingoutput\
+ ;
+It seems that a right delimiter was left out,
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+[95] [96] [97] [98] [99] [100] [101] [102] [103] [104] [105] [106] [107]
+## chardy=6
+[108] [109]
+{restoring tracingoutput=1}
+{restoring tracingcommands=2.1}
+{restoring tracingmacros=1}
+{endgroup}
+{def}
+{def}
+{addto}
+Path at line 122, before choices:
+(0,0){4096,0}
+ ..{4096,0}(1,0){0,-4096}
+ ..{0,4096}cycle
+
+Path at line 122, after choices:
+(0,0)..controls (0.33333,0) and (0.66667,0)
+ ..(1,0)..controls (1,-0.66667) and (0,-0.66667)
+ ..cycle
+
+
+f(SUFFIX0)(EXPR1)(EXPR2)(TEXT3)->numeric.w;show(EXPR1);addto(SUFFIX0)con
+tour(0,0)..(2,0)..(1,$)..(1,1)..cycle.withpen.qq;addto(SUFFIX0)doublepat
+h(0,0){1,1}..{2,1}(2,1)withpen.qq;addto(SUFFIX0)doublepath(($,$){1,0}..(
+1,1){1,0})scaled0.5withpen.nullpen;
+! Missing `]' has been inserted.
+<to be read again>
+ ,
+l.123 f(e[3,
+ w); g(e3,transformed p,penoffset-(1,1.3)of(pencir...
+I've seen a `[' and a subscript value, in a suffix,
+so a right bracket should have come next.
+I shall pretend that one was there.
+
+(SUFFIX0)<-e3
+(EXPR1)<-unknown path w
+! Missing argument to f.
+<to be read again>
+ ;
+l.123 f(e[3,w);
+ g(e3,transformed p,penoffset-(1,1.3)of(pencir...
+That macro has more parameters than you thought.
+I'll continue by pretending that each missing argument
+is either zero or null.
+
+(EXPR2)<-0
+! Missing argument to f.
+<to be read again>
+ ;
+l.123 f(e[3,w);
+ g(e3,transformed p,penoffset-(1,1.3)of(pencir...
+That macro has more parameters than you thought.
+I'll continue by pretending that each missing argument
+is either zero or null.
+
+(TEXT3)<-
+{numeric}
+{show}
+>> unknown path %CAPSULE1695
+{addto}
+Path at line 123, before choices:
+(0,0)
+ ..(2,0)
+ ..(1,-1)
+ ..(1,1)
+ ..cycle
+
+Path at line 123, after choices:
+(0,0)..controls (0.56189,-0.5286) and (1.43811,0.5286)
+ ..(2,0)..controls (2.70831,-0.66634) and (1.66634,-1.70831)
+ ..(1,-1)..controls (0.4714,-0.43811) and (1.5286,0.43811)
+ ..(1,1)..controls (0.33366,1.70831) and (-0.70831,0.66634)
+ ..cycle
+
+{addto}
+Path at line 123, before choices:
+(0,0){2896.30943,2896.30934}
+ ..{3663.57385,1831.78674}(2,1)
+
+Path at line 123, after choices:
+(0,0)..controls (0.53566,0.53566) and (1.32689,0.66344)
+ ..(2,1)
+
+{addto}
+Path at line 123, before choices:
+(-1,-1){4096,0}
+ ..{4096,0}(1,1)
+
+Path at line 123, after choices:
+(-1,-1)..controls (0.10457,-1) and (-0.10457,1)
+ ..(1,1)
+
+{(path)scaled(0.5)}
+{nullpen}
+
+g(SUFFIX0)->show(SUFFIX0)
+(SUFFIX0)<-e3
+! Too many arguments to g;
+ Missing `)' has been inserted.
+l.123 f(e[3,w); g(e3,
+ transformed p,penoffset-(1,1.3)of(pencir...
+I'm going to assume that the comma I just read was a
+right delimiter, and then I'll begin expanding the macro.
+You might want to delete some tokens before continuing.
+
+{show}
+{(picture)transformed((8,1,5,-5,-5,5))}
+>> Edge structure at line 123:
+Filled pen stroke :
+(10.5,-1.5)..controls (13,-4) and (15.5,-6.5)
+ ..(18,-9)
+dashed (on 3 off 0) shifted 0
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+Filled pen stroke :
+(8,1)..controls (8.57388,0.42612) and (9.41167,-0.41167)
+ ..(10.5,-1.5)..controls (14.51955,-5.51955) and (21.76099,-12.76099)
+ ..(25.5,-16.5)..controls (27.5211,-18.5211) and (28.4345,-19.4345)
+ ..(30.5,-21.5)..controls (35.23984,-26.23984) and (45.4408,-36.4408)
+ ..(50.5,-41.5)..controls (51.60489,-42.60489) and (52.4432,-43.4432)
+ ..(53,-44)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+Filled contour :
+(8,1)..controls (13.45242,-4.45242) and (12.54758,-3.54758)
+ ..(18,-9)..controls (24.87325,-15.87325) and (24.87325,-15.87325)
+ ..(18,-9)..controls (12.54758,-3.54758) and (13.45242,-4.45242)
+ ..(8,1)..controls (1.12675,7.87325) and (1.12675,7.87325)
+ ..cycle
+mitered joins limited 1 with pen
+(-10,10)
+ .. (5,-5)
+ .. (12.5,-12.5)
+ .. (15,-15)
+ .. (15,-15)
+ .. (10,-10)
+ .. (-5,5)
+ .. (-12.5,12.5)
+ .. (-15,15)
+ .. (-15,15)
+ .. cycle
+Filled pen stroke :
+(8,1)..controls (8,1) and (11.31726,-2.31726)
+ ..(13,-4)
+butt ends, mitered joins limited 1 with pen
+(-10,10)
+ .. (5,-5)
+ .. (12.5,-12.5)
+ .. (15,-15)
+ .. (15,-15)
+ .. (10,-10)
+ .. (-5,5)
+ .. (-12.5,12.5)
+ .. (-15,15)
+ .. (-15,15)
+ .. cycle
+Filled pen stroke :
+(8,1)..controls (10.76146,-1.76146) and (5.23854,3.76146)
+ ..(8,1)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+End edges
+
+{-((1,1.3))}
+{pencircle}
+{(pen)scaled(20)}
+{-(0.5)}
+{(pen)yscaled(-0.5)}
+{((-1,-1.3))penoffset(pen)}
+>> (-9.33345,1.79489)
+Path at line 124, before choices:
+(0,0)..controls (1,1) and (-1,1)
+ ..(3,0)
+
+Path at line 124, after choices:
+(0,0)..controls (1,1) and (-1,1)
+ ..(3,0)
+
+{((0,1))directiontime(path)}
+>> 0.33333
+{(3.14159)point(path)}
+{((3.14159,4))subpath(path)}
+{((7.68668,2.72437))intersectiontimes(path)}
+>> (0,0)
+Path at line 126, before choices:
+(-1,1.1){curl 1}
+ ..{curl 1}(1,-1)
+
+Path at line 126, after choices:
+(-1,1.1)..controls (-0.33333,0.40001) and (0.33333,-0.3)
+ ..(1,-1)
+
+{(-1)precontrol((0,0))}
+{(path)intersectiontimes((0,0))}
+>> (-1,-1)
+{addto}
+{-(4094.99998)}
+{-(0.00002)}
+Path at line 127, before choices:
+(-4094.99998,0){curl 1}
+ ..{curl 1}(4094.99998,-0.00002)
+
+Path at line 127, after choices:
+(-4094.99998,0)..controls (-1365,0) and (1365,-0.00002)
+ ..(4094.99998,-0.00002)
+
+{pencircle}
+{(0)penoffset(pen)}
+>> 0
+>> pen
+! Not implemented: penoffset(known numeric)of(pen).
+<to be read again>
+ ;
+l.128 pencircle;
+ addto e3 also e3 shifted (0,257); ,"flushed ...
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+{addto}
+{(picture)shifted((0,257))}
+! A statement can't begin with `,'.
+<to be read again>
+ ,
+l.128 ...o e3 shifted (0,257); ,
+ "flushed with pride"; numeric...
+I was looking for the beginning of a new statement.
+If you just proceed without changing anything, I'll ignore
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+! Extra tokens will be flushed.
+<to be read again>
+ ,
+l.128 ...o e3 shifted (0,257); ,
+ "flushed with pride"; numeric...
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+{numeric}
+{def}
+
+f(EXPR0)(EXPR1)(EXPR2)->showdependencies;tracingcapsules:=1;showdependen
+cies;show1/3(3,6)*(((EXPR0)+(EXPR1))+((EXPR1)-(EXPR0))),(1,1)/sqrt2zscal
+ed((EXPR0)+1,(EXPR0)+2)-((EXPR0)+1,(EXPR0)+2)rotated45,(0,1)zscaled(1,(E
+XPR1)+2)-(1,(EXPR1)+2)rotated90
+{(xx)+(1)}
+{(xx+1)/(0.3)}
+(EXPR0)<-3.3333xx+3.3333
+{(yy)-(1)}
+{(yy-1)/(0.5)}
+(EXPR1)<-2yy-2
+(EXPR2)<-(xx,0)
+{showdependencies}
+alpha=0.45p3~+7
+{tracingcapsules:=1}
+{showdependencies}
+xpart %CAPSULE2512=xx
+%CAPSULE2520=2yy-2
+%CAPSULE2528 = 3.3333xx+3.3333
+alpha=0.45p3~+7
+{show}
+{(1/3)*((3,6))}
+{(3.3333xx+3.3333)+(2yy-2)}
+{(2yy-2)-(3.3333xx+3.3333)}
+{(linearform)+(linearform)}
+{((1,2))*(4yy-4)}
+>> (4yy-4,8yy-8)
+{sqrt(2)}
+{((1,1))/(1.41422)}
+{(3.3333xx+3.3333)+(1)}
+{(3.3333xx+3.3333)+(2)}
+{((0.7071,0.7071))zscaled((3.3333xx+4.3333,3.3333xx+5.3333))}
+{(3.3333xx+3.3333)+(1)}
+{(3.3333xx+3.3333)+(2)}
+{((3.3333xx+4.3333,3.3333xx+5.3333))rotated(45)}
+{((-0.7071,4.71399xx+6.83531))-((-0.7071,4.71399xx+6.83531))}
+>> (0,0)
+{(2yy-2)+(2)}
+{((0,1))zscaled((1,2yy))}
+{(2yy-2)+(2)}
+{((1,2yy))rotated(90)}
+{((-2yy,1))-((-2yy,1))}
+>> (0,0)
+{(1000)*(o3)}
+{(o1)-(o2)}
+{(4000)*(linearform)}
+{(1000o3)-(linearform)}
+{(4000)*(o2)}
+{(linearform)+(4000o2)}
+{(linearform)+(9)}
+{(0.01)*(o3)}
+{-(0.01o3)}
+{(3)*(ooo)}
+{(-0.01o3)+(3ooo)}
+{begingroup}
+{(o2)+(o4)}
+{(linearform)+(o5)}
+{(linearform)-(20)}
+{(9/10)*(linearform)}
+{(oo)=(linearform)}
+## oo=0.9o5+0.9o4+0.9o2-18
+{(0.5)*(o2)}
+{(o1)+(0.5o2)}
+{(8/9)*(linearform)}
+{(o5)=(linearform)}
+## o5=0.44444o2+0.88889o1
+{(o4)=(linearform)}
+## o4=0.44444o2+0.88889o1
+{(0.0001)*(o2)}
+{-(0.0001o2)}
+{(o6)=(-0.0001o2)}
+## o6=-0.0001o2
+{showdependencies}
+o6=-0.0001o2
+o4=0.44444o2+0.88889o1
+o5=0.44444o2+0.88889o1
+oo=1.7o2+1.6o1-18
+%CAPSULE2440 = 3ooo-0.01o3
+%CAPSULE2460 = 8000o2-4000o1+1000o3+9
+xpart %CAPSULE2536=xpart '
+ypart %CAPSULE2536=ypart '
+alpha=0.45p3~+7
+{numeric}
+### 4000o1 = -%CAPSULE2460+8000o2+1000o3+9
+### -4.87383o2 = -oo-0.0004%CAPSULE2460+0.39673o3-17.99643
+#### o6=-0.00027
+### -0.04366o3 = -o4+0.46689oo+8.40439
+### -o4 = -o5
+### 0.22894o5 = -%CAPSULE2440+0.10689oo+3ooo+1.92412
+{begingroup}
+{pair}
+### -alfa=-%CAPSULE2428
+{endgroup}
+### -%CAPSULE2428=-xpart %CAPSULE2426
+{xpart((xpart %CAPSULE2426,0))}
+### -xpart %CAPSULE9=-%CAPSULE2416
+{endgroup}
+{(%CAPSULE2440)+(%CAPSULE2416)}
+### -%CAPSULE2440=-%CAPSULE2404+%CAPSULE2416
+### -%CAPSULE2404=-ypart %CAPSULE2402
+### -%CAPSULE2460=-xpart %CAPSULE2402
+{begingroup}
+{save}
+{(1)-(p$)}
+{restoring p}
+### p$=-ypart %CAPSULE2368+1
+{endgroup}
+{(2/3)*((-ypart %CAPSULE2368+1,ypart %CAPSULE2368))}
+### ypart %CAPSULE2368=-xpart %CAPSULE2368+1
+### -0.66667xpart %CAPSULE2368=-xpart %CAPSULE2360
+{-((xpart %CAPSULE2360,-xpart %CAPSULE2360+0.66667))}
+### xpart %CAPSULE2360=-xpart %CAPSULE2340
+{((xpart %CAPSULE2402,ypart %CAPSULE2402))=((xpart %CAPSULE2340,-xpart %
+CAPSULE2340-0.66667))}
+## xpart %CAPSULE2340=-ypart %CAPSULE2402-0.66667
+## xpart %CAPSULE2402=-ypart %CAPSULE2402-0.66667
+### ypart %CAPSULE2402=-xpart %CAPSULE2402-0.66667
+### -xpart %CAPSULE2402=-xpart %CAPSULE2340
+{((xpart ',ypart '))=((xpart %CAPSULE2340,-xpart %CAPSULE2340-0.66667))}
+## xpart %CAPSULE2340=-ypart '-0.66667
+## xpart '=-ypart '-0.66667
+{begingroup}
+{(0.5)*(ooo)}
+{begingroup}
+{numeric}
+### -ooo=-%CAPSULE2302
+{endgroup}
+{(%CAPSULE2302)+(1)}
+### -%CAPSULE2302=-%CAPSULE2290+1
+{(1/2)*(%CAPSULE2290)}
+### -0.5%CAPSULE2290=-%CAPSULE2282
+{-(%CAPSULE2282)}
+### %CAPSULE2282=-%CAPSULE2274
+{(2)*(%CAPSULE2274)}
+### -2%CAPSULE2274=-%CAPSULE2266
+{(-0.5%CAPSULE2266-0.5)=(%CAPSULE2266)}
+## %CAPSULE2266=-0.33333
+{(oo)=(-0.33333)}
+## oo=-0.33333
+{endgroup}
+{(4000)*(-0.33333)}
+{yoffset:=-1333.31299}
+## yoffset=-1333.31299
+{xoffset:=-1333.31299}
+## xoffset=-1333.31299
+{addto}
+
+foo(TEXT2)->begingroup(TEXT2)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-foo
+! Missing argument to foo.
+<to be read again>
+ contour
+l.136 addto foo contour
+ begingroup vardef foo=enddef; (0,0).....
+That macro has more parameters than you thought.
+I'll continue by pretending that each missing argument
+is either zero or null.
+
+(TEXT2)<-
+{begingroup}
+{endgroup}
+>> vacuous
+! Not a suitable variable.
+<to be read again>
+ contour
+l.136 addto foo contour
+ begingroup vardef foo=enddef; (0,0).....
+At this point I needed to see the name of a picture variable.
+(Or perhaps you have indeed presented me with one; I might
+have missed it, if it wasn't followed by the proper token.)
+So I'll not change anything just now.
+
+! Extra tokens will be flushed.
+<to be read again>
+ contour
+l.136 addto foo contour
+ begingroup vardef foo=enddef; (0,0).....
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+Path at line 136, before choices:
+(0,0)
+ ..cycle
+
+Path at line 136, after choices:
+(0,0)..controls (0,0) and (0,0)
+ ..cycle
+
+! Extra `endgroup'.
+l.136 ...; (0,0)..cycle endgroup
+ ;
+I'm not currently working on a `begingroup',
+so I had better not try to end anything.
+
+{(unknown path p~7)=(unknown path p~8)}
+{-(1)}
+Path at line 137, before choices:
+(0,0){-2896.30943,2896.30934}
+ ..{curl 1}(30,0)
+
+Path at line 137, after choices:
+(0,0)..controls (-48.28429,48.28426) and (78.28429,48.28426)
+ ..(30,0)
+
+{p~8:=path}
+{show}
+>> Path at line 137:
+(0,0)..controls (-48.28429,48.28426) and (78.28429,48.28426)
+ ..(30,0)
+
+{-(1)}
+{((0,-1))directiontime(path)}
+>> 0.83456
+{show}
+{((1,0))directiontime(path)}
+>> -1
+{-(1)}
+{-(1)}
+! Missing `}' has been inserted.
+<to be read again>
+ )
+l.139 ...(0,0){1,0}..(0,0){0,-1)
+ ..cycle);
+I've scanned a direction spec for part of a path,
+so a right brace should have come next.
+I shall pretend that one was there.
+
+Path at line 139, before choices:
+(0,0){4096,0}
+ ..{0,-4096}(0,0)
+
+Path at line 139, after choices:
+(0,0)..controls (0,0) and (0,0)
+ ..(0,0)
+
+{((1,-1))directiontime(path)}
+>> 0
+! Extra tokens will be flushed.
+<to be read again>
+ ..
+l.139 ...,0){1,0}..(0,0){0,-1)..
+ cycle);
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+{nullpicture}
+{(unknown picture e4)=(picture)}
+{(unknown picture e9)=(picture)}
+{addto}
+{addto}
+! Picture is too complicated to use as a dash pattern.
+<to be read again>
+ ;
+l.141 ...ublepath p~8 dashed e4;
+ e9:=nullpicture;
+When you say `dashed p', every path in p should be monotone
+in x and there must be no overlapping. This failed
+so I'll just make it a solid line instead.
+
+{nullpicture}
+{e9:=picture}
+{nullpicture}
+{e4:=picture}
+{addto}
+Path at line 142, before choices:
+(1,1){curl 1}
+ ..{curl 1}(4,1)
+
+Path at line 142, after choices:
+(1,1)..controls (2,1) and (3,1)
+ ..(4,1)
+
+{addto}
+{nullpicture}
+{e9:=picture}
+{addto}
+{pencircle}
+{makepath(pen)}
+{-(2)}
+{(picture)scaled(-2)}
+{show}
+>> Edge structure at line 144:
+Filled pen stroke :
+(1,1)..controls (2,1) and (3,1)
+ ..(4,1)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+Filled pen stroke :
+(0.5,0)..controls (0.5,0.13261) and (0.44731,0.25978)
+ ..(0.35355,0.35355)..controls (0.25978,0.44731) and (0.13261,0.5)
+ ..(0,0.5)..controls (-0.13261,0.5) and (-0.25978,0.44731)
+ ..(-0.35355,0.35355)..controls (-0.44731,0.25978) and (-0.5,0.13261)
+ ..(-0.5,0)..controls (-0.5,-0.13261) and (-0.44731,-0.25978)
+ ..(-0.35355,-0.35355)..controls (-0.25978,-0.44731) and (-0.13261,-0.5)
+ ..(0,-0.5)..controls (0.13261,-0.5) and (0.25978,-0.44731)
+ ..(0.35355,-0.35355)..controls (0.44731,-0.25978) and (0.5,-0.13261)
+ ..cycle
+dashed (on 6 off 0) shifted -2
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,0)
+End edges
+
+{nullpicture}
+{(unknown picture e5)=(picture)}
+{e4:=picture}
+{addto}
+{-(4)}
+{-(3)}
+{-(2)}
+{-(2.7)}
+Path at line 145, before choices:
+(-4,-3){curl 1}..tension 2
+ ..{curl 1}(-2,-2.7)
+
+Path at line 145, after choices:
+(-4,-3)..controls (-3.66667,-2.95) and (-2.33333,-2.75)
+ ..(-2,-2.7)
+
+{addto}
+{(path)shifted((0,4))}
+{(path)scaled(3)}
+{show}
+{llcorner(picture)}
+>> (0.5,9.5)
+{nullpicture}
+{e6:=picture}
+{addto}
+Path at line 149, before choices:
+(0,0){curl 1}
+ ..{curl 1}(30,0)
+
+Path at line 149, after choices:
+(0,0)..controls (10,0) and (20,0)
+ ..(30,0)
+
+{pencircle}
+{makepath(pen)}
+>> path
+! Improper type.
+<to be read again>
+ dashed
+l.150 dashed
+ e5 withpen pencircle scaled2 dashed e5shifted(0,...
+Next time say `dashed <known picture expression>';
+I'll ignore the bad `with' clause and look for another.
+
+{pencircle}
+{(pen)scaled(2)}
+{-(11)}
+{(picture)shifted((0,-11))}
+{pencircle}
+{show}
+>> Edge structure at line 151:
+Filled pen stroke :
+(0,0)..controls (10,0) and (20,0)
+ ..(30,0)
+dashed (on 2 off 1) shifted -1
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+End edges
+
+{def}
+{(path)rotated(90)}
+{-(1)}
+{(path)xscaled(-1)}
+Path at line 152, before choices:
+(0,0)..controls (48.28426,-48.28429) and (48.28426,78.28429)
+ ..(0,30)
+ ..cycle
+
+Path at line 152, after choices:
+(0,0)..controls (48.28426,-48.28429) and (48.28426,78.28429)
+ ..(0,30)..controls (-8.28427,21.71573) and (-8.28427,8.28427)
+ ..cycle
+
+{p~7:=path}
+{linecap:=2}
+{linejoin:=1}
+{nullpicture}
+{(picture)=(picture)}
+! Redundant or inconsistent equation.
+<to be read again>
+ ;
+l.153 e6=nullpicture;
+ addto e6 doublepath p~8 dashed e5 withp...
+An equation between already-known quantities can't help.
+But don't worry; continue and I'll just ignore it.
+
+{addto}
+{pencircle}
+{clip}
+{addto}
+{begingroup}
+{save}
+{picture}
+{nullpicture}
+{(unknown picture _p)=(picture)}
+{string}
+{vardef}
+{(unknown string _n0)=("trapf")}
+
+_s(EXPR2)(EXPR3)(EXPR4)(EXPR5)(EXPR6)->begingroup.addto._p.also(EXPR2)in
+font(EXPR3)scaled(EXPR4)shifted((EXPR5),(EXPR6));endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-_s
+(EXPR2)<-"Aqua"
+(EXPR3)<-"trapf"
+(EXPR4)<-1
+(EXPR5)<-0
+(EXPR6)<-0
+{begingroup}
+{addto}
+{("Aqua")infont("trapf")}
+{(picture)scaled(1)}
+{(picture)shifted((0,0))}
+{endgroup}
+{interim}
+{linecap:=0}
+{vardef}
+
+_r(EXPR2)(EXPR3)->begingroup.addto._p.doublepath(EXPR2)withpen.pencircle
+.scaled(EXPR3)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-_r
+{-(3.9851)}
+Path at line 11, before choices:
+(8.1693,-3.9851){curl 1}
+ ..{curl 1}(8.1693,15.9402)
+
+Path at line 11, after choices:
+(8.1693,-3.9851)..controls (8.1693,2.65666) and (8.1693,9.29843)
+ ..(8.1693,15.9402)
+
+(EXPR2)<-path
+(EXPR3)<-0.3985
+{begingroup}
+{addto}
+{pencircle}
+{(pen)scaled(0.3985)}
+{endgroup}
+{(unknown string _n1)=("trapf")}
+
+_s(EXPR2)(EXPR3)(EXPR4)(EXPR5)(EXPR6)->begingroup.addto._p.also(EXPR2)in
+font(EXPR3)scaled(EXPR4)shifted((EXPR5),(EXPR6));endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-_s
+(EXPR2)<-"Brass"
+(EXPR3)<-"trapf"
+(EXPR4)<-2
+(EXPR5)<-8.3686
+(EXPR6)<-0
+{begingroup}
+{addto}
+{("Brass")infont("trapf")}
+{(picture)scaled(2)}
+{(picture)shifted((8.3686,0))}
+{endgroup}
+{setbounds}
+{-(3.9851)}
+
+--->{curl1}..{curl1}
+{-(3.9851)}
+
+--->{curl1}..{curl1}
+
+--->{curl1}..{curl1}
+
+--->{curl1}..{curl1}
+Path at line 15, before choices:
+(0,-3.9851){curl 1}
+ ..{curl 1}(18.3313,-3.9851){curl 1}
+ ..{curl 1}(18.3313,15.9402){curl 1}
+ ..{curl 1}(0,15.9402){curl 1}
+ ..{curl 1}cycle
+
+Path at line 15, after choices:
+(0,-3.9851)..controls (6.11043,-3.9851) and (12.22087,-3.9851)
+ ..(18.3313,-3.9851)..controls (18.3313,2.65666) and (18.3313,9.29843)
+ ..(18.3313,15.9402)..controls (12.22087,15.9402) and (6.11043,15.9402)
+ ..(0,15.9402)..controls (0,9.29843) and (0,2.65666)
+ ..cycle
+
+{restoring linecap=2}
+{restoring _n}
+{restoring _s}
+{restoring _r}
+{restoring _p}
+{endgroup}
+{-(2)}
+{(picture)shifted((0,-2))}
+{addto}
+Path at line 155, before choices:
+(1,0){curl 1}
+ ..{curl 1}(2,1)
+
+Path at line 155, after choices:
+(1,0)..controls (1.33333,0.33333) and (1.66667,0.66667)
+ ..(2,1)
+
+{addto}
+{(0.5)*((1,1,1))}
+{pencircle}
+{(pen)xscaled(2)}
+{(pen)rotated(45)}
+{addto}
+{begingroup}
+{save}
+{picture}
+{nullpicture}
+{(unknown picture _p)=(picture)}
+{string}
+{vardef}
+{(unknown string _n0)=("trapf")}
+
+_s(EXPR2)(EXPR3)(EXPR4)(EXPR5)(EXPR6)->begingroup.addto._p.also(EXPR2)in
+font(EXPR3)scaled(EXPR4)shifted((EXPR5),(EXPR6));endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-_s
+(EXPR2)<-"ast"
+(EXPR3)<-"trapf"
+(EXPR4)<-1
+(EXPR5)<-0
+(EXPR6)<-0
+{begingroup}
+{addto}
+{("ast")infont("trapf")}
+{(picture)scaled(1)}
+{(picture)shifted((0,0))}
+{endgroup}
+{setbounds}
+{-(0.9963)}
+
+--->{curl1}..{curl1}
+{-(0.9963)}
+
+--->{curl1}..{curl1}
+
+--->{curl1}..{curl1}
+
+--->{curl1}..{curl1}
+Path at line 25, before choices:
+(0,-0.9963){curl 1}
+ ..{curl 1}(1.9925,-0.9963){curl 1}
+ ..{curl 1}(1.9925,6.9738){curl 1}
+ ..{curl 1}(0,6.9738){curl 1}
+ ..{curl 1}cycle
+
+Path at line 25, after choices:
+(0,-0.9963)..controls (0.66417,-0.9963) and (1.32832,-0.9963)
+ ..(1.9925,-0.9963)..controls (1.9925,1.6604) and (1.9925,4.3171)
+ ..(1.9925,6.9738)..controls (1.32832,6.9738) and (0.66417,6.9738)
+ ..(0,6.9738)..controls (0,4.3171) and (0,1.6604)
+ ..cycle
+
+{restoring _n}
+{restoring _s}
+{restoring _r}
+{restoring _p}
+{endgroup}
+{(picture)shifted((0,10))}
+{show}
+>> Edge structure at line 158:
+clipping path:
+(0,0)..controls (48.28426,-48.28429) and (48.28426,78.28429)
+ ..(0,30)..controls (-8.28427,21.71573) and (-8.28427,8.28427)
+ ..cycle
+Filled pen stroke :
+(0,0)..controls (10,0) and (20,0)
+ ..(30,0)
+dashed (on 2 off 1) shifted -1
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+Filled pen stroke :
+(0,0)..controls (-48.28429,48.28426) and (78.28429,48.28426)
+ ..(30,0)
+dashed (on 1 off 1 on 1 off 9) shifted -9
+square ends, round joins with pen
+pencircle transformed (0,0,1,0,0,1)
+stop clipping
+setbounds path:
+(0,-5.9851)..controls (6.11043,-5.9851) and (12.22087,-5.9851)
+ ..(18.3313,-5.9851)..controls (18.3313,0.65666) and (18.3313,7.29843)
+ ..(18.3313,13.9402)..controls (12.22087,13.9402) and (6.11043,13.9402)
+ ..(0,13.9402)..controls (0,7.29843) and (0,0.65666)
+ ..cycle
+"Aqua" infont "trapf"
+transformed (0,-2,1,0,0,1)
+Filled pen stroke :
+(8.1693,-5.9851)..controls (8.1693,0.65666) and (8.1693,7.29843)
+ ..(8.1693,13.9402)
+butt ends, round joins with pen
+pencircle transformed (0,0,0.3985,0,0,0.3985)
+"Brass" infont "trapf"
+transformed (8.3686,-2,2,0,0,2)
+end of setbounds
+Filled pen stroke :
+(1,0)..controls (1.33333,0.33333) and (1.66667,0.66667)
+ ..(2,1)
+square ends, round joins with pen
+pencircle transformed (0,0,0,0,0,0)
+End edges
+
+{lrcorner(picture)}
+>> (36.21318,-5.9851)
+{ulcorner(picture)}
+>> (-6.2132,37.00375)
+{charcode:=200}
+{shipout}
+[200
+Envelope spec at line 158:
+(3,12) % beginning with offset (2,-1)
+ ..controls (3.75,12.75) and (4.125,13.3125)
+ ..(4.3125,13.6875)
+ ..controls (4.375,13.8125) and (4.41667,13.91667)
+ ..(4.44444,14) % counterclockwise to offset (2.5,0.5)
+ ..controls (4.5,14.16667) and (4.5,14.25)
+ ..(4.5,14.25) % clockwise to offset (-2.5,-0.5)
+ ..controls (4.5,14.25) and (4.5,13.5)
+ ..(6,12) % counterclockwise to offset (2.5,0.5)
+ ..controls (4.5,13.5) and (4.5,14.25)
+ ..(4.5,14.25) % counterclockwise to offset (-2.5,-0.5)
+ ..controls (4.5,14.25) and (4.5,14.16667)
+ ..(4.44444,14) % clockwise to offset (-2,1)
+ ..controls (4.41667,13.91667) and (4.375,13.8125)
+ ..(4.3125,13.6875)
+ ..controls (4.125,13.3125) and (3.75,12.75)
+ ..(3,12) % counterclockwise to offset (2,-1)
+ & cycle
+
+]
+Edge structure at line 158 (just shipped out):
+Filled pen stroke :
+(3,12)..controls (3.75,12.75) and (4.125,13.3125)
+ ..(4.3125,13.6875)..controls (4.875,14.8125) and (3.75,14.25)
+ ..(6,12)
+dashed (on 2 off 1) shifted -1 (this will be ignored)
+butt ends, mitered joins limited 1 with pen
+(-2.5,-0.5)
+ .. (-1,-2)
+ .. (0,-2.5)
+ .. (1,-2)
+ .. (2,-1)
+ .. (2.5,0.5)
+ .. (1,2)
+ .. (0,2.5)
+ .. (-1,2)
+ .. (-2,1)
+ .. cycle
+clipping path:
+(0,0)..controls (48.28426,-48.28429) and (48.28426,78.28429)
+ ..(0,30)..controls (-8.28427,21.71573) and (-8.28427,8.28427)
+ ..cycle
+Filled pen stroke colored (0.5,0.5,0.5):
+(0,0)..controls (10,0) and (20,0)
+ ..(30,0)
+dashed (on 2 off 1) shifted -1
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1.41422,-0.7071,1.41422,0.7071)
+Filled pen stroke colored (0.5,0.5,0.5):
+(0,0)..controls (-48.28429,48.28426) and (78.28429,48.28426)
+ ..(30,0)
+dashed (on 2 off 1) shifted -1
+square ends, round joins with pen
+pencircle transformed (0,0,1.41422,-0.7071,1.41422,0.7071)
+stop clipping
+setbounds path:
+(0,-5.9851)..controls (6.11043,-5.9851) and (12.22087,-5.9851)
+ ..(18.3313,-5.9851)..controls (18.3313,0.65666) and (18.3313,7.29843)
+ ..(18.3313,13.9402)..controls (12.22087,13.9402) and (6.11043,13.9402)
+ ..(0,13.9402)..controls (0,7.29843) and (0,0.65666)
+ ..cycle
+"Aqua" infont "trapf"
+colored (0.5,0.5,0.5)transformed (0,-2,1,0,0,1)
+Filled pen stroke colored (0.5,0.5,0.5):
+(8.1693,-5.9851)..controls (8.1693,0.65666) and (8.1693,7.29843)
+ ..(8.1693,13.9402)
+dashed (on 2 off 1) shifted -1
+butt ends, round joins with pen
+pencircle transformed (0,0,1.41422,-0.7071,1.41422,0.7071)
+"Brass" infont "trapf"
+colored (0.5,0.5,0.5)transformed (8.3686,-2,2,0,0,2)
+end of setbounds
+Filled pen stroke colored (0.5,0.5,0.5):
+(1,0)..controls (1.33333,0.33333) and (1.66667,0.66667)
+ ..(2,1)
+dashed (on 2 off 1) shifted -1
+square ends, round joins with pen
+pencircle transformed (0,0,1.41422,-0.7071,1.41422,0.7071)
+setbounds path:
+(0,9.0037)..controls (0.66417,9.0037) and (1.32832,9.0037)
+ ..(1.9925,9.0037)..controls (1.9925,11.6604) and (1.9925,14.3171)
+ ..(1.9925,16.9738)..controls (1.32832,16.9738) and (0.66417,16.9738)
+ ..(0,16.9738)..controls (0,14.3171) and (0,11.6604)
+ ..cycle
+"ast" infont "trapf"
+transformed (0,10,1,0,0,1)
+end of setbounds
+End edges
+
+{showstats}
+Memory usage 3017&264 (273 still untouched)
+String usage 68&249 (1155&8794 now untouched)
+{("curb")infont("trapf")}
+Missing character: There is no c in font trapf!
+{-(0.5)}
+{(picture)slanted(-0.5)}
+{-(1)}
+{(picture)scaled(-1)}
+{e6:=picture}
+{e5:=picture}
+{showstats}
+Memory usage 2267&264 (273 still untouched)
+String usage 66&241 (1154&8790 now untouched)
+{show}
+{pencircle}
+{((0,0))penoffset(pen)}
+>> (0,0)
+{llcorner(picture)}
+>> (-3.98508,-7.97011)
+{urcorner(picture)}
+>> (3.98506,1.99254)
+{(picture)rotated(90)}
+{(picture)shifted("oops")}
+>> "oops"
+! Improper transformation argument.
+<to be read again>
+ ;
+l.161 ...ated 90 shifted "oops";
+ show llcorner e5, urcorner e5;
+The expression shown above has the wrong type,
+so I can't transform anything using it.
+Proceed, and I'll omit the transformation.
+
+{e5:=picture}
+{show}
+{llcorner(picture)}
+>> (-1.99254,-3.98508)
+{urcorner(picture)}
+>> (7.97011,3.98506)
+{show}
+{char(220)}
+{("^^dc")infont("trapf")}
+Missing character: There is no ^^dc in font trapf!
+{urcorner(picture)}
+>> (0,0)
+{makepath(pen)}
+>> Path at line 162:
+(-2.5,-0.5)..controls (-2.5,-0.5) and (-1,-2)
+ ..(-1,-2)..controls (-1,-2) and (0,-2.5)
+ ..(0,-2.5)..controls (0,-2.5) and (1,-2)
+ ..(1,-2)..controls (1,-2) and (2,-1)
+ ..(2,-1)..controls (2,-1) and (2.5,0.5)
+ ..(2.5,0.5)..controls (2.5,0.5) and (1,2)
+ ..(1,2)..controls (1,2) and (0,2.5)
+ ..(0,2.5)..controls (0,2.5) and (-1,2)
+ ..(-1,2)..controls (-1,2) and (-2,1)
+ ..(-2,1)..controls (-2,1) and (-2.5,-0.5)
+ ..cycle
+
+{show}
+{-(2)}
+{-(1)}
+{((-2,-1))subpath(path)}
+>> Path at line 163:
+(0,0)
+
+{pencircle}
+{makepath(pen)}
+{((9,10))subpath(path)}
+>> Path at line 163:
+(0.35355,0.35355)..controls (0.25978,0.44731) and (0.13261,0.5)
+ ..(0,0.5)
+
+{("hi")infont("qw99z")}
+! Font qw99z not usable: TFM file not found.
+l.164 "hi" infont "qw99z";
+ special "ij"="ij"; show substring(...
+I wasn't able to read the size data for this font so this
+`infont' operation won't produce anything. If the font name
+is right, you might ask an expert to make a TFM file
+
+Missing character: There is no h in font !
+Missing character: There is no i in font !
+>> picture
+! Isolated expression.
+<to be read again>
+ ;
+l.164 "hi" infont "qw99z";
+ special "ij"="ij"; show substring(...
+I couldn't find an `=' or `:=' after the
+expression that is shown above this error message,
+so I guess I'll just ignore it and carry on.
+
+{special}
+{("ij")=("ij")}
+>> true
+! Unsuitable expression.
+<to be read again>
+ ;
+l.164 ...9z"; special "ij"="ij";
+ show substring(-2,-1)of"abc";
+Only known strings are allowed for output as specials.
+
+{show}
+{-(2)}
+{-(1)}
+{((-2,-1))substring("abc")}
+>> ""
+{addto}
+{begingroup}
+{endgroup}
+>> vacuous
+! Improper `addto'.
+<to be read again>
+ ;
+l.165 addto e5 contour [[ ]];
+ addto e5 contour true; pausing:...
+This expression should have specified a known path.
+So I'll not change anything just now.
+
+{addto}
+{true}
+>> true
+! Improper `addto'.
+<to be read again>
+ ;
+l.165 ... addto e5 contour true;
+ pausing:=0;prologues:=1;
+This expression should have specified a known path.
+So I'll not change anything just now.
+
+{pausing:=0}
+{prologues:=1}
+{charcode:=197}
+{shipout}
+[197]
+Edge structure at line 166 (just shipped out):
+"curb" infont "trapf"
+transformed (0,0,0,1,-1,0.5)
+End edges
+
+{-(1)}
+{-(1)}
+Path at line 167, before choices:
+(0,0){2881.87209,2910.67511}..tension atleast1
+ ..{4096,0}(1,1){-2896.30943,2896.30934}
+ ..{2896.30943,-2896.30934}(2,0)
+
+Path at line 167, after choices:
+(0,0)..controls (0.3493,0.3528) and (0.99011,1)
+ ..(1,1)..controls (0.12732,1.87268) and (1.46066,0.53934)
+ ..(2,0)
+
+{(unknown path p~10)=(path)}
+{prologues:=0}
+{for}
+{-(1)}
+{-(1)}
+{loop value=(-1,1)}
+{show}
+{((-1,1))directiontime(path)}
+>> 1
+{[repeat the loop]}
+{loop value=(1,-1)}
+{show}
+{((1,-1))directiontime(path)}
+>> 1.2355
+{[repeat the loop]}
+{loop value=(0,0)}
+{show}
+{((0,0))directiontime(path)}
+>> 0
+{[repeat the loop]}
+{linecap:=1}
+{linejoin:=1}
+{nullpicture}
+{e5:=picture}
+{addto}
+{pencircle}
+{(pen)scaled(10)}
+{makepath(pen)}
+{pencircle}
+{(pen)shifted((2,0))}
+{addto}
+Path at line 171, before choices:
+(0,0){curl 1}
+ ..{curl 1}(12,0)
+
+Path at line 171, after choices:
+(0,0)..controls (4,0) and (8,0)
+ ..(12,0)
+
+{pencircle}
+{(pen)yscaled(3)}
+{charcode:=148}
+{shipout}
+[148]
+Edge structure at line 171 (just shipped out):
+Filled contour :
+(5,0)..controls (5,1.32608) and (4.47322,2.59785)
+ ..(3.53554,3.53554)..controls (2.59785,4.47322) and (1.32608,5)
+ ..(0,5)..controls (-1.32608,5) and (-2.59785,4.47322)
+ ..(-3.53554,3.53554)..controls (-4.47322,2.59785) and (-5,1.32608)
+ ..(-5,0)..controls (-5,-1.32608) and (-4.47322,-2.59785)
+ ..(-3.53554,-3.53554)..controls (-2.59785,-4.47322) and (-1.32608,-5)
+ ..(0,-5)..controls (1.32608,-5) and (2.59785,-4.47322)
+ ..(3.53554,-3.53554)..controls (4.47322,-2.59785) and (5,-1.32608)
+ ..cycle
+round joins with pen
+pencircle transformed (2,0,1,0,0,1)
+Filled pen stroke :
+(0,0)..controls (4,0) and (8,0)
+ ..(12,0)
+round ends, round joins with pen
+pencircle transformed (0,0,1,0,0,3)
+End edges
+
+{nullpicture}
+{e5:=picture}
+{clip}
+! An expression can't begin with `;'.
+<inserted text>
+ 0
+<to be read again>
+ ;
+l.172 ...llpicture; clip p~8 to;
+ clip e5 to e4; clip e5 to p~...
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+! Variable p~8 is the wrong type (path).
+<to be read again>
+ ;
+l.172 ...llpicture; clip p~8 to;
+ clip e5 to e4; clip e5 to p~...
+I was looking for a "known" picture variable.
+So I'll not change anything just now.
+
+{clip}
+>> picture
+! Improper `clip'.
+<to be read again>
+ ;
+l.172 ... p~8 to; clip e5 to e4;
+ clip e5 to p~8; clip e5 to p~7;
+This expression should have specified a known path.
+So I'll not change anything just now.
+
+{clip}
+! Not a cycle.
+<to be read again>
+ ;
+l.172 ... to e4; clip e5 to p~8;
+ clip e5 to p~7;
+That contour should have ended with `..cycle' or `&cycle'.
+So I'll not change anything just now.
+
+{clip}
+{addto}
+{pencircle}
+{(pen)scaled(50)}
+{makepath(pen)}
+{addto}
+{pencircle}
+{(pen)xscaled(2)}
+{addto}
+{pencircle}
+{addto}
+{(path)shifted((10,0))}
+{(picture)scaled(1)}
+{pencircle}
+{charcode:=149}
+{shipout}
+[149
+Envelope spec at line 177:
+(25,0) % beginning with offset (2.5,0.5)
+ ..controls (25,6.63042) and (22.36609,12.98926)
+ ..(17.67767,17.67767) % counterclockwise to offset (1,2)
+ ..controls (15.7597,19.59564) and (13.56218,21.16978)
+ ..(11.18088,22.36044) % counterclockwise to offset (0,2.5)
+ ..controls (7.74117,24.08029) and (3.918,25)
+ ..(0,25)
+ ..controls (-3.918,25) and (-7.74117,24.08029)
+ ..(-11.18088,22.36044) % counterclockwise to offset (-1,2)
+ ..controls (-13.56218,21.16978) and (-15.7597,19.59564)
+ ..(-17.67767,17.67767) % counterclockwise to offset (-2,1)
+ ..controls (-20.44812,14.90723) and (-22.50117,11.55353)
+ ..(-23.71729,7.90517) % counterclockwise to offset (-2.5,-0.5)
+ ..controls (-24.5592,5.37941) and (-25,2.71243)
+ ..(-25,0)
+ ..controls (-25,-6.63042) and (-22.36609,-12.98926)
+ ..(-17.67767,-17.67767) % counterclockwise to offset (-1,-2)
+ ..controls (-15.7597,-19.59564) and (-13.56218,-21.16978)
+ ..(-11.18088,-22.36044) % counterclockwise to offset (0,-2.5)
+ ..controls (-7.74117,-24.08029) and (-3.918,-25)
+ ..(0,-25)
+ ..controls (3.918,-25) and (7.74117,-24.08029)
+ ..(11.18088,-22.36044) % counterclockwise to offset (1,-2)
+ ..controls (13.56218,-21.16978) and (15.7597,-19.59564)
+ ..(17.67767,-17.67767) % counterclockwise to offset (2,-1)
+ ..controls (20.44812,-14.90723) and (22.50117,-11.55353)
+ ..(23.71729,-7.90517) % counterclockwise to offset (2.5,0.5)
+ ..controls (24.5592,-5.37941) and (25,-2.71243)
+ ..(25,0) % counterclockwise to offset (-2.5,-0.5)
+ ..controls (25,-2.71243) and (24.5592,-5.37941)
+ ..(23.71729,-7.90517) % clockwise to offset (-2,1)
+ ..controls (22.50117,-11.55353) and (20.44812,-14.90723)
+ ..(17.67767,-17.67767) % clockwise to offset (-1,2)
+ ..controls (15.7597,-19.59564) and (13.56218,-21.16978)
+ ..(11.18088,-22.36044) % clockwise to offset (0,2.5)
+ ..controls (7.74117,-24.08029) and (3.918,-25)
+ ..(0,-25)
+ ..controls (-3.918,-25) and (-7.74117,-24.08029)
+ ..(-11.18088,-22.36044) % clockwise to offset (1,2)
+ ..controls (-13.56218,-21.16978) and (-15.7597,-19.59564)
+ ..(-17.67767,-17.67767) % clockwise to offset (2.5,0.5)
+ ..controls (-22.36609,-12.98926) and (-25,-6.63042)
+ ..(-25,0)
+ ..controls (-25,2.71243) and (-24.5592,5.37941)
+ ..(-23.71729,7.90517) % clockwise to offset (2,-1)
+ ..controls (-22.50117,11.55353) and (-20.44812,14.90723)
+ ..(-17.67767,17.67767) % clockwise to offset (1,-2)
+ ..controls (-15.7597,19.59564) and (-13.56218,21.16978)
+ ..(-11.18088,22.36044) % clockwise to offset (0,-2.5)
+ ..controls (-7.74117,24.08029) and (-3.918,25)
+ ..(0,25)
+ ..controls (3.918,25) and (7.74117,24.08029)
+ ..(11.18088,22.36044) % clockwise to offset (-1,-2)
+ ..controls (13.56218,21.16978) and (15.7597,19.59564)
+ ..(17.67767,17.67767) % clockwise to offset (-2.5,-0.5)
+ ..controls (22.36609,12.98926) and (25,6.63042)
+ ..(25,0) % counterclockwise to offset (2.5,0.5)
+ & cycle
+
+]
+Edge structure at line 177 (just shipped out):
+clipping path:
+(0,0)..controls (48.28426,-48.28429) and (48.28426,78.28429)
+ ..(0,30)..controls (-8.28427,21.71573) and (-8.28427,8.28427)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(25,0)..controls (25,6.63042) and (22.36609,12.98926)
+ ..(17.67767,17.67767)..controls (12.98926,22.36609) and (6.63042,25)
+ ..(0,25)..controls (-6.63042,25) and (-12.98926,22.36609)
+ ..(-17.67767,17.67767)..controls (-22.36609,12.98926) and (-25,6.63042)
+ ..(-25,0)..controls (-25,-6.63042) and (-22.36609,-12.98926)
+ ..(-17.67767,-17.67767)..controls (-12.98926,-22.36609) and (-6.63042,-
+25)
+ ..(0,-25)..controls (6.63042,-25) and (12.98926,-22.36609)
+ ..(17.67767,-17.67767)..controls (22.36609,-12.98926) and (25,-6.63042)
+ ..cycle
+round ends, round joins with pen
+(-2.5,-0.5)
+ .. (-1,-2)
+ .. (0,-2.5)
+ .. (1,-2)
+ .. (2,-1)
+ .. (2.5,0.5)
+ .. (1,2)
+ .. (0,2.5)
+ .. (-1,2)
+ .. (-2,1)
+ .. cycle
+Filled pen stroke :
+(0,0)..controls (-48.28429,48.28426) and (78.28429,48.28426)
+ ..(30,0)
+dashed (on 2 off 1) shifted -1
+round ends, round joins with pen
+pencircle transformed (0,0,2,0,0,1)
+Filled pen stroke :
+(0,0)..controls (-48.28429,48.28426) and (78.28429,48.28426)
+ ..(30,0)
+dashed (on 2 off 1) shifted -1
+round ends, round joins with pen
+pencircle transformed (0,0,1,0,0,1)
+Filled pen stroke :
+(10,0)..controls (-38.28429,48.28426) and (88.28429,48.28426)
+ ..(40,0)
+dashed (on 2 off 1) shifted -1
+round ends, round joins with pen
+pencircle transformed (0,0,1,0,0,1)
+End edges
+
+{addto}
+>> 3
+! Not a suitable variable.
+<to be read again>
+ ;
+l.177 ...; shipout e5; addto 3;
+ addto p~8 contour p~7;
+At this point I needed to see the name of a picture variable.
+(Or perhaps you have indeed presented me with one; I might
+have missed it, if it wasn't followed by the proper token.)
+So I'll not change anything just now.
+
+{addto}
+! Variable p~8 is the wrong type (path).
+<to be read again>
+ ;
+l.177 ... addto p~8 contour p~7;
+
+I was looking for a "known" picture variable.
+So I'll not change anything just now.
+
+{nullpicture}
+{e5:=picture}
+{linecap:=2}
+{linejoin:=0}
+{miterlimit:=10}
+{addto}
+Path at line 179, before choices:
+(10,5)
+ ..cycle
+
+Path at line 179, after choices:
+(10,5)..controls (10,5) and (10,5)
+ ..cycle
+
+{addto}
+Path at line 180, before choices:
+(5,10){curl 1}
+ ..{curl 1}(5,15)
+
+Path at line 180, after choices:
+(5,10)..controls (5,11.66667) and (5,13.33333)
+ ..(5,15)
+
+{addto}
+Path at line 182, before choices:
+(0,0)..controls (10,10) and (10,10)
+ ..(10,10)
+ ..{curl 1}(0,20){curl 1}
+ ..{curl 1}(30,10)
+
+Path at line 182, after choices:
+(0,0)..controls (10,10) and (10,10)
+ ..(10,10)..controls (6.66667,13.33333) and (3.33333,16.66667)
+ ..(0,20)..controls (10,16.66667) and (20,13.33333)
+ ..(30,10)
+
+{-(5)}
+Path at line 182, before choices:
+(0,-5)
+ ..(0,5)
+ ..cycle
+
+Path at line 182, after choices:
+(0,-5)..controls (6.66667,-5) and (6.66667,5)
+ ..(0,5)..controls (-6.66667,5) and (-6.66667,-5)
+ ..cycle
+
+{makepen(path)}
+{charcode:=150}
+{prologues:=1}
+{shipout}
+[150
+Envelope spec at line 182:
+(10,5) % beginning with offset (-2.5,-0.5)
+ ..controls (10,5) and (10,5)
+ ..(10,5) % counterclockwise to offset (-2.5,-0.5)
+ & cycle
+
+Envelope spec at line 182:
+(10,5) % beginning with offset (-2.5,-0.5)
+ ..controls (10,5) and (10,5)
+ ..(10,5) % counterclockwise to offset (-2.5,-0.5)
+ & cycle
+
+Envelope spec at line 182:
+(5,10) % beginning with offset (2.5,0.5)
+ ..controls (5,11.66667) and (5,13.33333)
+ ..(5,15) % counterclockwise to offset (-2.5,-0.5)
+ ..controls (5,13.33333) and (5,11.66667)
+ ..(5,10) % counterclockwise to offset (2.5,0.5)
+ & cycle
+
+Envelope spec at line 182:
+(0,0) % beginning with offset (0,-5)
+ ..controls (10,10) and (10,10)
+ ..(10,10) % counterclockwise to offset (0,5)
+ ..controls (6.66667,13.33333) and (3.33333,16.66667)
+ ..(0,20) % clockwise to offset (0,-5)
+ ..controls (10,16.66667) and (20,13.33333)
+ ..(30,10) % counterclockwise to offset (0,5)
+ ..controls (20,13.33333) and (10,16.66667)
+ ..(0,20) % counterclockwise to offset (0,-5)
+ ..controls (3.33333,16.66667) and (6.66667,13.33333)
+ ..(10,10) % clockwise to offset (0,5)
+ ..controls (10,10) and (10,10)
+ ..(0,0) % counterclockwise to offset (0,-5)
+ & cycle
+
+]
+Edge structure at line 182 (just shipped out):
+Filled contour :
+(10,5)..controls (10,5) and (10,5)
+ ..cycle
+mitered joins limited 10 with pen
+(-2.5,-0.5)
+ .. (-1,-2)
+ .. (0,-2.5)
+ .. (1,-2)
+ .. (2,-1)
+ .. (2.5,0.5)
+ .. (1,2)
+ .. (0,2.5)
+ .. (-1,2)
+ .. (-2,1)
+ .. cycle
+Filled pen stroke :
+(5,10)..controls (5,11.66667) and (5,13.33333)
+ ..(5,15)
+square ends, mitered joins limited 10 with pen
+(-2.5,-0.5)
+ .. (-1,-2)
+ .. (0,-2.5)
+ .. (1,-2)
+ .. (2,-1)
+ .. (2.5,0.5)
+ .. (1,2)
+ .. (0,2.5)
+ .. (-1,2)
+ .. (-2,1)
+ .. cycle
+Filled pen stroke :
+(0,0)..controls (10,10) and (10,10)
+ ..(10,10)..controls (6.66667,13.33333) and (3.33333,16.66667)
+ ..(0,20)..controls (10,16.66667) and (20,13.33333)
+ ..(30,10)
+square ends, mitered joins limited 10 with pen
+(0,-5)
+ .. (0,5)
+ .. cycle
+End edges
+
+{for}
+{sqrt(-1)}
+! Square root of -1 has been replaced by 0.
+l.183 for @=angle(sqrt$,
+ mlog$):charext:=uniformdeviate$;charh...
+Since I don't take square roots of negative numbers,
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{mlog(-1)}
+! Logarithm of -1 has been replaced by 0.
+l.183 for @=angle(sqrt$,mlog$)
+ :charext:=uniformdeviate$;charh...
+Since I don't take logs of non-positive numbers,
+I'm zeroing this one. Proceed, with fingers crossed.
+
+{angle((0,0))}
+! angle(0,0) is taken as zero.
+l.183 for @=angle(sqrt$,mlog$):
+ charext:=uniformdeviate$;charh...
+The `angle' between two identical points is undefined.
+I'm zeroing this one. Proceed, with fingers crossed.
+
+Runaway loop?
+charext:=uniformdeviate$;charht:=2048;addto.e3contour( ETC.
+! Forbidden token found while scanning the text of a for loop.
+<inserted text>
+ endfor
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+I suspect you have forgotten an `endfor',
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{loop value=0}
+{uniformdeviate(-1)}
+{charext:=-0.00507}
+{charht:=2048}
+{addto}
+{-(100)}
+{-(99)}
+Path at line 206, before choices:
+(0,-100)..tension 500
+ ..(100,-99)..tension 3000
+ ..cycle
+
+Path at line 206, after choices:
+(0,-100)..controls (-36.92659,-103.51175) and (136.98943,-101.7726)
+ ..(100,-99)..controls (99.9889,-98.99916) and (0.01108,-99.99895)
+ ..cycle
+
+{tracingoutput:=0}
+{special}
+{charcode:=151}
+{shipout}
+! Enormous charht has been reduced.
+<to be read again>
+ ;
+<for(0)> ...ode:=151;shipout.e3;
+ interim.char99="c";true=false...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+Font metric dimensions must be less than 2048pt.
+
+[151
+Envelope spec at line 206:
+(0,0) % beginning with offset (-1,-2)
+ ..controls (0.04324,-0.04068) and (0.08835,-0.07198)
+ ..(0.13504,-0.09532) % counterclockwise to offset (0,-2.5)
+ ..controls (0.64822,-0.3519) and (1.35178,0.35191)
+ ..(1.86496,0.09532) % clockwise to offset (-1,-2)
+ ..controls (1.91165,0.07198) and (1.95676,0.04068)
+ ..(2,0)
+ ..controls (2.00706,-0.00664) and (2.01395,-0.01332)
+ ..(2.02066,-0.02003) % clockwise to offset (-2.5,-0.5)
+ ..controls (2.2398,-0.23918) and (2.27596,-0.49583)
+ ..(2.2023,-0.71681) % clockwise to offset (-2,1)
+ ..controls (2.16501,-0.82869) and (2.09958,-0.93141)
+ ..(2.01549,-1.0155) % clockwise to offset (-1,2)
+ ..controls (1.95589,-1.0751) and (1.88692,-1.12534)
+ ..(1.81195,-1.16281) % clockwise to offset (0,2.5)
+ ..controls (1.63397,-1.2518) and (1.42226,-1.26889)
+ ..(1.22209,-1.16881) % clockwise to offset (1,2)
+ ..controls (1.15273,-1.13412) and (1.08475,-1.08539)
+ ..(1.02003,-1.02068) % clockwise to offset (2.5,0.5)
+ ..controls (1.01332,-1.01396) and (1.00664,-1.00706)
+ ..(1,-1)
+ ..controls (0.78389,-0.77028) and (0.83284,-0.488)
+ ..(0.93013,-0.19617) % clockwise to offset (2,-1)
+ ..controls (0.97351,-0.06602) and (1.0265,0.06602)
+ ..(1.06989,0.19617) % counterclockwise to offset (2.5,0.5)
+ ..controls (1.16716,0.488) and (1.21611,0.77028)
+ ..(1,1)
+ ..controls (0.99336,1.00706) and (0.98668,1.01395)
+ ..(0.97997,1.02066) % counterclockwise to offset (1,2)
+ ..controls (0.91525,1.08537) and (0.84727,1.13412)
+ ..(0.77791,1.16881) % counterclockwise to offset (0,2.5)
+ ..controls (0.57773,1.26889) and (0.36601,1.2518)
+ ..(0.18803,1.16281) % counterclockwise to offset (-1,2)
+ ..controls (0.11307,1.12534) and (0.0441,1.0751)
+ ..(-0.0155,1.0155) % counterclockwise to offset (-2,1)
+ ..controls (-0.09958,0.93141) and (-0.16502,0.82869)
+ ..(-0.20232,0.71681) % counterclockwise to offset (-2.5,-0.5)
+ ..controls (-0.27597,0.49583) and (-0.2398,0.2392)
+ ..(-0.02066,0.02003) % counterclockwise to offset (-1,-2)
+ ..controls (-0.01395,0.01332) and (-0.00706,0.00664)
+ ..(0,0)
+ & cycle
+
+Envelope spec at line 206:
+(0,0) % beginning with offset (1,2)
+ ..controls (-0.00706,0.00664) and (-0.01395,0.01332)
+ ..(-0.02066,0.02003) % clockwise to offset (2.5,0.5)
+ ..controls (-0.2398,0.23918) and (-0.27596,0.49583)
+ ..(-0.2023,0.71681) % clockwise to offset (2,-1)
+ ..controls (-0.16501,0.82869) and (-0.09958,0.93141)
+ ..(-0.01549,1.0155) % clockwise to offset (1,-2)
+ ..controls (0.04411,1.0751) and (0.11308,1.12534)
+ ..(0.18805,1.16281) % clockwise to offset (0,-2.5)
+ ..controls (0.36603,1.2518) and (0.57774,1.26889)
+ ..(0.77791,1.16881) % clockwise to offset (-1,-2)
+ ..controls (0.84727,1.13412) and (0.91525,1.08539)
+ ..(0.97997,1.02068) % clockwise to offset (-2.5,-0.5)
+ ..controls (0.98668,1.01396) and (0.99336,1.00706)
+ ..(1,1)
+ ..controls (1.21611,0.77028) and (1.16716,0.488)
+ ..(1.06987,0.19617) % clockwise to offset (-2,1)
+ ..controls (1.02649,0.06602) and (0.9735,-0.06602)
+ ..(0.93011,-0.19617) % counterclockwise to offset (-2.5,-0.5)
+ ..controls (0.83284,-0.488) and (0.78389,-0.77028)
+ ..(1,-1)
+ ..controls (1.00664,-1.00706) and (1.01332,-1.01395)
+ ..(1.02003,-1.02066) % counterclockwise to offset (-1,-2)
+ ..controls (1.08475,-1.08537) and (1.15273,-1.13412)
+ ..(1.22209,-1.16881) % counterclockwise to offset (0,-2.5)
+ ..controls (1.42227,-1.26889) and (1.63399,-1.2518)
+ ..(1.81197,-1.16281) % counterclockwise to offset (1,-2)
+ ..controls (1.88693,-1.12534) and (1.9559,-1.0751)
+ ..(2.0155,-1.0155) % counterclockwise to offset (2,-1)
+ ..controls (2.09958,-0.93141) and (2.16502,-0.82869)
+ ..(2.20232,-0.71681) % counterclockwise to offset (2.5,0.5)
+ ..controls (2.27597,-0.49583) and (2.2398,-0.2392)
+ ..(2.02066,-0.02003) % counterclockwise to offset (1,2)
+ ..controls (2.01395,-0.01332) and (2.00706,-0.00664)
+ ..(2,0)
+ ..controls (1.95676,0.04068) and (1.91165,0.07198)
+ ..(1.86496,0.09532) % counterclockwise to offset (0,2.5)
+ ..controls (1.35178,0.3519) and (0.64822,-0.35191)
+ ..(0.13504,-0.09532) % clockwise to offset (1,2)
+ ..controls (0.08835,-0.07198) and (0.04324,-0.04068)
+ ..(0,0)
+ & cycle
+
+Envelope spec at line 206:
+(0,0) % beginning with offset (1,-2)
+ ..controls (0.17854,0.17854) and (0.38548,0.31178)
+ ..(0.60698,0.42253) % clockwise to offset (0,-2.5)
+ ..controls (1.04999,0.64404) and (1.55122,0.77562)
+ ..(1.99995,1) % counterclockwise to offset (1,-2)
+ ..controls (1.99997,1) and (1.99998,1)
+ ..(2,1) % counterclockwise to offset (-1,2)
+ ..controls (1.99998,1) and (1.99997,1)
+ ..(1.99995,1) % clockwise to offset (0,2.5)
+ ..controls (1.55122,0.77562) and (1.05,0.64404)
+ ..(0.607,0.42253) % counterclockwise to offset (-1,2)
+ ..controls (0.3855,0.31178) and (0.17856,0.17856)
+ ..(0,0) % counterclockwise to offset (1,-2)
+ & cycle
+
+Envelope spec at line 206:
+(0,257) % beginning with offset (-1,-2)
+ ..controls (0.04324,256.95932) and (0.08835,256.92802)
+ ..(0.13504,256.90468) % counterclockwise to offset (0,-2.5)
+ ..controls (0.64822,256.6481) and (1.35178,257.35191)
+ ..(1.86496,257.09532) % clockwise to offset (-1,-2)
+ ..controls (1.91165,257.07198) and (1.95676,257.04068)
+ ..(2,257)
+ ..controls (2.00706,256.99336) and (2.01395,256.98668)
+ ..(2.02066,256.97997) % clockwise to offset (-2.5,-0.5)
+ ..controls (2.2398,256.76082) and (2.27596,256.50417)
+ ..(2.2023,256.28319) % clockwise to offset (-2,1)
+ ..controls (2.16501,256.17131) and (2.09958,256.06859)
+ ..(2.01549,255.9845) % clockwise to offset (-1,2)
+ ..controls (1.95589,255.9249) and (1.88692,255.87466)
+ ..(1.81195,255.83719) % clockwise to offset (0,2.5)
+ ..controls (1.63397,255.7482) and (1.42226,255.73111)
+ ..(1.22209,255.83119) % clockwise to offset (1,2)
+ ..controls (1.15273,255.86588) and (1.08475,255.91461)
+ ..(1.02003,255.97932) % clockwise to offset (2.5,0.5)
+ ..controls (1.01332,255.98604) and (1.00664,255.99294)
+ ..(1,256)
+ ..controls (0.78389,256.22972) and (0.83284,256.512)
+ ..(0.93013,256.80383) % clockwise to offset (2,-1)
+ ..controls (0.97351,256.93398) and (1.0265,257.06602)
+ ..(1.06989,257.19617) % counterclockwise to offset (2.5,0.5)
+ ..controls (1.16716,257.488) and (1.21611,257.77028)
+ ..(1,258)
+ ..controls (0.99336,258.00706) and (0.98668,258.01395)
+ ..(0.97997,258.02066) % counterclockwise to offset (1,2)
+ ..controls (0.91525,258.08537) and (0.84727,258.13412)
+ ..(0.77791,258.16881) % counterclockwise to offset (0,2.5)
+ ..controls (0.57773,258.26889) and (0.36601,258.2518)
+ ..(0.18803,258.16281) % counterclockwise to offset (-1,2)
+ ..controls (0.11307,258.12534) and (0.0441,258.0751)
+ ..(-0.0155,258.0155) % counterclockwise to offset (-2,1)
+ ..controls (-0.09958,257.93141) and (-0.16502,257.82869)
+ ..(-0.20232,257.71681) % counterclockwise to offset (-2.5,-0.5)
+ ..controls (-0.27597,257.49583) and (-0.2398,257.2392)
+ ..(-0.02066,257.02003) % counterclockwise to offset (-1,-2)
+ ..controls (-0.01395,257.01332) and (-0.00706,257.00664)
+ ..(0,257)
+ & cycle
+
+Envelope spec at line 206:
+(0,257) % beginning with offset (1,2)
+ ..controls (-0.00706,257.00664) and (-0.01395,257.01332)
+ ..(-0.02066,257.02003) % clockwise to offset (2.5,0.5)
+ ..controls (-0.2398,257.23918) and (-0.27596,257.49583)
+ ..(-0.2023,257.71681) % clockwise to offset (2,-1)
+ ..controls (-0.16501,257.82869) and (-0.09958,257.93141)
+ ..(-0.01549,258.0155) % clockwise to offset (1,-2)
+ ..controls (0.04411,258.0751) and (0.11308,258.12534)
+ ..(0.18805,258.16281) % clockwise to offset (0,-2.5)
+ ..controls (0.36603,258.2518) and (0.57774,258.26889)
+ ..(0.77791,258.16881) % clockwise to offset (-1,-2)
+ ..controls (0.84727,258.13412) and (0.91525,258.08539)
+ ..(0.97997,258.02068) % clockwise to offset (-2.5,-0.5)
+ ..controls (0.98668,258.01396) and (0.99336,258.00706)
+ ..(1,258)
+ ..controls (1.21611,257.77028) and (1.16716,257.488)
+ ..(1.06987,257.19617) % clockwise to offset (-2,1)
+ ..controls (1.02649,257.06602) and (0.9735,256.93398)
+ ..(0.93011,256.80383) % counterclockwise to offset (-2.5,-0.5)
+ ..controls (0.83284,256.512) and (0.78389,256.22972)
+ ..(1,256)
+ ..controls (1.00664,255.99294) and (1.01332,255.98605)
+ ..(1.02003,255.97934) % counterclockwise to offset (-1,-2)
+ ..controls (1.08475,255.91463) and (1.15273,255.86588)
+ ..(1.22209,255.83119) % counterclockwise to offset (0,-2.5)
+ ..controls (1.42227,255.73111) and (1.63399,255.7482)
+ ..(1.81197,255.83719) % counterclockwise to offset (1,-2)
+ ..controls (1.88693,255.87466) and (1.9559,255.9249)
+ ..(2.0155,255.9845) % counterclockwise to offset (2,-1)
+ ..controls (2.09958,256.06859) and (2.16502,256.17131)
+ ..(2.20232,256.28319) % counterclockwise to offset (2.5,0.5)
+ ..controls (2.27597,256.50417) and (2.2398,256.7608)
+ ..(2.02066,256.97997) % counterclockwise to offset (1,2)
+ ..controls (2.01395,256.98668) and (2.00706,256.99336)
+ ..(2,257)
+ ..controls (1.95676,257.04068) and (1.91165,257.07198)
+ ..(1.86496,257.09532) % counterclockwise to offset (0,2.5)
+ ..controls (1.35178,257.3519) and (0.64822,256.64809)
+ ..(0.13504,256.90468) % clockwise to offset (1,2)
+ ..controls (0.08835,256.92802) and (0.04324,256.95932)
+ ..(0,257)
+ & cycle
+
+Envelope spec at line 206:
+(0,257) % beginning with offset (1,-2)
+ ..controls (0.17854,257.17854) and (0.38548,257.31178)
+ ..(0.60698,257.42253) % clockwise to offset (0,-2.5)
+ ..controls (1.04999,257.64404) and (1.55122,257.77562)
+ ..(1.99995,258) % counterclockwise to offset (1,-2)
+ ..controls (1.99997,258) and (1.99998,258)
+ ..(2,258) % counterclockwise to offset (-1,2)
+ ..controls (1.99998,258) and (1.99997,258)
+ ..(1.99995,258) % clockwise to offset (0,2.5)
+ ..controls (1.55122,257.77562) and (1.05,257.64404)
+ ..(0.607,257.42253) % counterclockwise to offset (-1,2)
+ ..controls (0.3855,257.31178) and (0.17856,257.17856)
+ ..(0,257) % counterclockwise to offset (1,-2)
+ & cycle
+
+]
+{interim}
+! The token `char' isn't an internal quantity.
+<to be read again>
+ char
+<for(0)> ...pout.e3;interim.char
+ 99="c";true=false;show.penoff...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+Something like `tracingonline' should follow `interim'.
+
+{char(99)}
+{("c")=("c")}
+! Redundant equation.
+<to be read again>
+ ;
+<for(0)> ...;interim.char99="c";
+ true=false;show.penoffset(2,1...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+I already knew that this equation was true.
+But perhaps no harm has been done; let's continue.
+
+{true}
+{false}
+{(true)=(false)}
+! Inconsistent equation.
+<to be read again>
+ ;
+<for(0)> ...ar99="c";true=false;
+ show.penoffset(2,1)of.qq;show...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+The equation I just read contradicts what was said before.
+But don't worry; continue and I'll just ignore it.
+
+{show}
+{((2,1))penoffset(pen)}
+>> (0,-2.5)
+{showstats}
+Memory usage 2744&607 (39 still untouched)
+String usage 73&279 (1138&8717 now untouched)
+{let}
+{showtoken}
+> f=tag
+{showstats}
+Memory usage 2704&536 (39 still untouched)
+String usage 73&279 (1138&8717 now untouched)
+{nullpicture}
+{(unknown picture e17)=(picture)}
+{addto}
+{-(4)}
+{-(5)}
+Path at line 206, before choices:
+(-4,-5){curl 1}
+ ..{curl 1}(6,5)
+
+Path at line 206, after choices:
+(-4,-5)..controls (-0.66667,-1.66667) and (2.66667,1.66667)
+ ..(6,5)
+
+{setbounds}
+{pencircle}
+{(pen)scaled(9)}
+{makepath(pen)}
+{show}
+{llcorner(picture)}
+>> (-4.5,-4.5)
+{urcorner(picture)}
+>> (4.5,4.5)
+{addto}
+{-(5)}
+{-(5)}
+{(picture)shifted((-5,-5))}
+{show}
+{llcorner(picture)}
+>> (-9.5,-9.5)
+{truecorners:=2}
+{show}
+{llcorner(picture)}
+>> (-9,-10)
+{-(1)}
+{truecorners:=-1}
+{setbounds}
+{pencircle}
+{(pen)xscaled(19)}
+{makepath(pen)}
+{addto}
+{-(5)}
+{-(10)}
+{(picture)shifted((-5,-10))}
+{show}
+{llcorner(picture)}
+>> (-14.5,-10.5)
+>> Edge structure at line 206:
+Filled contour :
+(10,5)..controls (10,5) and (10,5)
+ ..cycle
+mitered joins limited 10 with pen
+(-2.5,-0.5)
+ .. (-1,-2)
+ .. (0,-2.5)
+ .. (1,-2)
+ .. (2,-1)
+ .. (2.5,0.5)
+ .. (1,2)
+ .. (0,2.5)
+ .. (-1,2)
+ .. (-2,1)
+ .. cycle
+Filled pen stroke :
+(5,10)..controls (5,11.66667) and (5,13.33333)
+ ..(5,15)
+square ends, mitered joins limited 10 with pen
+(-2.5,-0.5)
+ .. (-1,-2)
+ .. (0,-2.5)
+ .. (1,-2)
+ .. (2,-1)
+ .. (2.5,0.5)
+ .. (1,2)
+ .. (0,2.5)
+ .. (-1,2)
+ .. (-2,1)
+ .. cycle
+Filled pen stroke :
+(0,0)..controls (10,10) and (10,10)
+ ..(10,10)..controls (6.66667,13.33333) and (3.33333,16.66667)
+ ..(0,20)..controls (10,16.66667) and (20,13.33333)
+ ..(30,10)
+square ends, mitered joins limited 10 with pen
+(0,-5)
+ .. (0,5)
+ .. cycle
+setbounds path:
+(-0.5,-5)..controls (-0.5,-3.80652) and (-0.9741,-2.66194)
+ ..(-1.81802,-1.81802)..controls (-2.66194,-0.9741) and (-3.80652,-0.5)
+ ..(-5,-0.5)..controls (-6.19348,-0.5) and (-7.33806,-0.9741)
+ ..(-8.18198,-1.81802)..controls (-9.0259,-2.66194) and (-9.5,-3.80652)
+ ..(-9.5,-5)..controls (-9.5,-6.19348) and (-9.0259,-7.33806)
+ ..(-8.18198,-8.18198)..controls (-7.33806,-9.0259) and (-6.19348,-9.5)
+ ..(-5,-9.5)..controls (-3.80652,-9.5) and (-2.66194,-9.0259)
+ ..(-1.81802,-8.18198)..controls (-0.9741,-7.33806) and (-0.5,-6.19348)
+ ..cycle
+Filled pen stroke :
+(-9,-10)..controls (-5.66667,-6.66667) and (-2.33333,-3.33333)
+ ..(1,0)
+square ends, mitered joins limited 10 with pen
+pencircle transformed (0,0,0,0,0,0)
+end of setbounds
+setbounds path:
+(4.5,-10)..controls (4.5,-9.86739) and (3.49911,-9.74022)
+ ..(1.71751,-9.64645)..controls (-0.06409,-9.55269) and (-2.48044,-9.5)
+ ..(-5,-9.5)..controls (-7.51956,-9.5) and (-9.93591,-9.55269)
+ ..(-11.71751,-9.64645)..controls (-13.49911,-9.74022) and (-14.5,-9.867
+39)
+ ..(-14.5,-10)..controls (-14.5,-10.13261) and (-13.49911,-10.25978)
+ ..(-11.71751,-10.35355)..controls (-9.93591,-10.44731) and (-7.51956,-1
+0.5)
+ ..(-5,-10.5)..controls (-2.48044,-10.5) and (-0.06409,-10.44731)
+ ..(1.71751,-10.35355)..controls (3.49911,-10.25978) and (4.5,-10.13261)
+ ..cycle
+setbounds path:
+(-0.5,-10)..controls (-0.5,-8.80652) and (-0.9741,-7.66194)
+ ..(-1.81802,-6.81802)..controls (-2.66194,-5.9741) and (-3.80652,-5.5)
+ ..(-5,-5.5)..controls (-6.19348,-5.5) and (-7.33806,-5.9741)
+ ..(-8.18198,-6.81802)..controls (-9.0259,-7.66194) and (-9.5,-8.80652)
+ ..(-9.5,-10)..controls (-9.5,-11.19348) and (-9.0259,-12.33806)
+ ..(-8.18198,-13.18198)..controls (-7.33806,-14.0259) and (-6.19348,-14.
+5)
+ ..(-5,-14.5)..controls (-3.80652,-14.5) and (-2.66194,-14.0259)
+ ..(-1.81802,-13.18198)..controls (-0.9741,-12.33806) and (-0.5,-11.1934
+8)
+ ..cycle
+Filled pen stroke :
+(-9,-15)..controls (-5.66667,-11.66667) and (-2.33333,-8.33333)
+ ..(1,-5)
+square ends, mitered joins limited 10 with pen
+pencircle transformed (0,0,0,0,0,0)
+end of setbounds
+end of setbounds
+End edges
+
+{pencircle}
+{urcorner(pen)}
+>> (0.5,0.5)
+{nullpicture}
+{e5:=picture}
+{path}
+{pencircle}
+{(pen)scaled(100)}
+{makepath(pen)}
+{(unknown path ap1)=(path)}
+{-(14)}
+{-(7)}
+Path at line 206, before choices:
+(2,-14)..controls (14,-7) and (14,7)
+ ..(2,14)
+
+Path at line 206, after choices:
+(2,-14)..controls (14,-7) and (14,7)
+ ..(2,14)
+
+{(unknown path ap2)=(path)}
+{-(50)}
+{-(50)}
+Path at line 206, before choices:
+(-50,0)..controls (-50,0) and (-50,0)
+ ..(50,0)
+
+Path at line 206, after choices:
+(-50,0)..controls (-50,0) and (-50,0)
+ ..(50,0)
+
+{(unknown path ap3)=(path)}
+{show}
+{(path)scaled(1000)}
+{arclength(path)}
+! Arithmetic overflow.
+<for(0)> ...ngth(ap2scaled1000),
+ arclength(ap3scaled200);show....
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+{(path)scaled(200)}
+{arclength(path)}
+! Arithmetic overflow.
+<for(0)> ...ength(ap3scaled200);
+ show.arclength.ap1,arclength....
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+{show}
+{arclength(path)}
+>> 314.15979
+{arclength(path)}
+>> 34.88
+{show}
+{(6.4)arctime(path)}
+>> 0.4
+{(37)arctime(path)}
+{((0,0.7179))subpath(path)}
+{arclength(path)}
+>> 36.99847
+{show}
+{-(1000)}
+{(-1000)arctime(path)}
+>> -25.46454
+{-(3)}
+{(-3)arctime(path)}
+>> 0
+{(path)scaled(0.00002)}
+{(314)arctime(path)}
+! Arithmetic overflow.
+<for(0)> ...f(ap1scaled0.00002);
+ [[clear(tracingcommands);char...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+{begingroup}
+
+clear(TEXT0)->interim(TEXT0):=$
+(TEXT0)<-tracingcommands
+{interim}
+{tracingcommands:=-1}
+! Enormous charht has been reduced.
+<to be read again>
+ ;
+<for(0)> ...shipout.nullpicture;
+ "careful"for.for=(EXPR0)step2...
+<inserted text> endfor
+
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+Font metric dimensions must be less than 2048pt.
+
+[0]
+careful METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT M
+ETAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT M
+ETAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT M
+ETAFONT METAFONT METAFONT METAFONT
+{restoring tracingcommands=2.1}
+{endgroup}
+{scrollmode}
+
+{char(31)}
+{("hello again")&("^^_")}
+hello again^^_
+{save}
+### -0.45p3~=-alpha+7
+{def}
+{begingroup}
+{tracingonline:=1}
+
+{tracingonline:=1}
+
+f<expr>->let)=];let[=(;show._
+(EXPR0)<-xx
+{let}
+{let}
+{show}
+>> _1
+{showdependencies}
+xpart '=-ypart '-0.66667
+{qq:=pen}
+{showstats}
+Memory usage 2147&536 (39 still untouched)
+String usage 73&277 (1110&5373 now untouched)
+{[repeat the loop]}
+>> bye
+! Isolated expression.
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+I couldn't find an `=' or `:=' after the
+expression that is shown above this error message,
+so I guess I'll just ignore it and carry on.
+
+! Extra tokens will be flushed.
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+! Forbidden token found while scanning to the end of the statement.
+<inserted text>
+ ;
+<to be read again>
+ endtext
+l.206 ... showstats; bye endtext
+
+A previous error seems to have propagated,
+causing me to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+{show}
+)
+*end
+! An expression can't begin with `end'.
+<inserted text>
+ 0
+<to be read again>
+ end
+<*> end
+
+I'm afraid I need some sort of value in order to continue,
+so I've tentatively inserted `0'. You may want to
+delete this zero and insert something else;
+see Chapter 27 of The METAFONTbook for an example.
+
+>> 0
+! A group begun on line 206 never ended.
+<to be read again>
+ end
+<*> end
+
+I saw a `begingroup' back there that hasn't been matched
+by `endgroup'. So I've inserted `endgroup' now.
+
+{endgroup}
+(end occurred when else on line 88 was incomplete)
+(end occurred when if on line 37 was incomplete)
+(end occurred when elseif on line 22 was incomplete)
+Here is how much of MetaPost's memory you used:
+ 75 strings out of 1277
+ 768 string characters out of 9330
+ 4462 words of memory out of 4501
+ 337 symbolic tokens out of 2100
+ 8i,35n,8p,167b stack positions out of 30i,100n,150p,500b
+ 0 string compactions (moved 0 characters, 0 strings)
+
+(illegal design size has been changed to 128pt)
+(some chardp values had to be adjusted by as much as 0.5pt)
+(local label 0:: was missing)
+(local label 5:: was missing)
+(4 font metric dimensions had to be decreased)
+(You used 3w,2h,16d,2i,312l,301k,1e,10p metric file positions
+ out of 256w,16h,16d,64i,5000l,500k,256e,50p)
+
+Font metrics written on trap.tfm.
+25 output files written: trap.ps .. trap.200
diff --git a/Build/source/texk/web2c/triptrap/mptrap.pl b/Build/source/texk/web2c/triptrap/mptrap.pl
new file mode 100644
index 00000000000..9664eb98128
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mptrap.pl
@@ -0,0 +1,520 @@
+(CODINGSCHEME Q)
+(DESIGNSIZE R 128.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM O 3745422316)
+(FONTDIMEN
+ (SLANT R 2047.999999)
+ (SPACE R 0.0)
+ (STRETCH R 0.0)
+ (SHRINK R 0.0)
+ (XHEIGHT R 0.0)
+ (QUAD R 0.0)
+ (EXTRASPACE R 0.0)
+ (PARAMETER D 8 R 0.0)
+ (PARAMETER D 9 R 0.005208)
+ (PARAMETER D 10 R 0.0)
+ )
+(BOUNDARYCHAR O 377)
+(LIGTABLE
+ (COMMENT THIS PART OF THE PROGRAM IS NEVER USED!
+ )
+ (LABEL BOUNDARYCHAR)
+ (/LIG/>> O 377 O 0)
+ (KRN O 0 R 0.0)
+ (KRN O 0 R 0.0078125)
+ (KRN O 0 R 0.015625)
+ (KRN O 0 R 0.0234375)
+ (KRN O 0 R 0.03125)
+ (KRN O 0 R 0.0390625)
+ (KRN O 0 R 0.046875)
+ (KRN O 0 R 0.0546875)
+ (KRN O 0 R 0.0625)
+ (KRN O 0 R 0.0703125)
+ (KRN O 0 R 0.078125)
+ (KRN O 0 R 0.0859375)
+ (KRN O 0 R 0.09375)
+ (KRN O 0 R 0.1015625)
+ (KRN O 0 R 0.109375)
+ (KRN O 0 R 0.1171875)
+ (KRN O 0 R 0.125)
+ (KRN O 0 R 0.1328125)
+ (KRN O 0 R 0.140625)
+ (KRN O 0 R 0.1484375)
+ (KRN O 0 R 0.15625)
+ (KRN O 0 R 0.1640625)
+ (KRN O 0 R 0.171875)
+ (KRN O 0 R 0.1796875)
+ (KRN O 0 R 0.1875)
+ (KRN O 0 R 0.1953125)
+ (KRN O 0 R 0.203125)
+ (KRN O 0 R 0.2109375)
+ (KRN O 0 R 0.21875)
+ (KRN O 0 R 0.2265625)
+ (KRN O 0 R 0.234375)
+ (KRN O 0 R 0.2421875)
+ (KRN O 0 R 0.25)
+ (KRN O 0 R 0.2578125)
+ (KRN O 0 R 0.265625)
+ (KRN O 0 R 0.2734375)
+ (KRN O 0 R 0.28125)
+ (KRN O 0 R 0.2890625)
+ (KRN O 0 R 0.296875)
+ (KRN O 0 R 0.3046875)
+ (KRN O 0 R 0.3125)
+ (KRN O 0 R 0.3203125)
+ (KRN O 0 R 0.328125)
+ (KRN O 0 R 0.3359375)
+ (KRN O 0 R 0.34375)
+ (KRN O 0 R 0.3515625)
+ (KRN O 0 R 0.359375)
+ (KRN O 0 R 0.3671875)
+ (KRN O 0 R 0.375)
+ (KRN O 0 R 0.3828125)
+ (KRN O 0 R 0.390625)
+ (KRN O 0 R 0.3984375)
+ (KRN O 0 R 0.40625)
+ (KRN O 0 R 0.4140625)
+ (KRN O 0 R 0.421875)
+ (KRN O 0 R 0.4296875)
+ (KRN O 0 R 0.4375)
+ (KRN O 0 R 0.4453125)
+ (KRN O 0 R 0.453125)
+ (KRN O 0 R 0.4609375)
+ (SKIP D 1)
+ (LABEL C g)
+ (LIG/ C g O 0)
+ (STOP)
+ (KRN O 0 R 0.400782)
+ (KRN O 0 R 0.408594)
+ (KRN O 0 R 0.416407)
+ (KRN O 0 R 0.424219)
+ (KRN O 0 R 0.432032)
+ (KRN O 0 R 0.439844)
+ (KRN O 0 R 0.447657)
+ (KRN O 0 R 0.455469)
+ (KRN O 0 R 0.463282)
+ (KRN O 0 R 0.471094)
+ (KRN O 0 R 0.478907)
+ (KRN O 0 R 0.486719)
+ (KRN O 0 R 0.494532)
+ (KRN O 0 R 0.502344)
+ (KRN O 0 R 0.510157)
+ (KRN O 0 R 0.517969)
+ (KRN O 0 R 0.525782)
+ (KRN O 0 R 0.533594)
+ (KRN O 0 R 0.541407)
+ (KRN O 0 R 0.549219)
+ (KRN O 0 R 0.557032)
+ (KRN O 0 R 0.564844)
+ (KRN O 0 R 0.572657)
+ (KRN O 0 R 0.580469)
+ (KRN O 0 R 0.588282)
+ (KRN O 0 R 0.596094)
+ (KRN O 0 R 0.603907)
+ (KRN O 0 R 0.611719)
+ (KRN O 0 R 0.619532)
+ (KRN O 0 R 0.627344)
+ (KRN O 0 R 0.635157)
+ (KRN O 0 R 0.642969)
+ (KRN O 0 R 0.650782)
+ (KRN O 0 R 0.658594)
+ (KRN O 0 R 0.666407)
+ (KRN O 0 R 0.674219)
+ (KRN O 0 R 0.682032)
+ (KRN O 0 R 0.689844)
+ (KRN O 0 R 0.697657)
+ (KRN O 0 R 0.705469)
+ (KRN O 0 R 0.713282)
+ (KRN O 0 R 0.721094)
+ (KRN O 0 R 0.728907)
+ (KRN O 0 R 0.736719)
+ (KRN O 0 R 0.744532)
+ (KRN O 0 R 0.752344)
+ (KRN O 0 R 0.760157)
+ (KRN O 0 R 0.767969)
+ (KRN O 0 R 0.775782)
+ (KRN O 0 R 0.783594)
+ (KRN O 0 R 0.791407)
+ (KRN O 0 R 0.799219)
+ (KRN O 0 R 0.807032)
+ (KRN O 0 R 0.814844)
+ (KRN O 0 R 0.822657)
+ (KRN O 0 R 0.830469)
+ (KRN O 0 R 0.838282)
+ (KRN O 0 R 0.846094)
+ (KRN O 0 R 0.853907)
+ (KRN O 0 R 0.861719)
+ (SKIP D 1)
+ (LABEL C h)
+ (LABEL C i)
+ (/LIG C i O 0)
+ (STOP)
+ (KRN O 0 R 0.801562)
+ (KRN O 0 R 0.809375)
+ (KRN O 0 R 0.817187)
+ (KRN O 0 R 0.825)
+ (KRN O 0 R 0.832812)
+ (KRN O 0 R 0.840625)
+ (KRN O 0 R 0.848437)
+ (KRN O 0 R 0.85625)
+ (KRN O 0 R 0.864062)
+ (KRN O 0 R 0.871875)
+ (KRN O 0 R 0.879687)
+ (KRN O 0 R 0.8875)
+ (KRN O 0 R 0.895312)
+ (KRN O 0 R 0.903125)
+ (KRN O 0 R 0.910937)
+ (KRN O 0 R 0.91875)
+ (KRN O 0 R 0.926562)
+ (KRN O 0 R 0.934375)
+ (KRN O 0 R 0.942187)
+ (KRN O 0 R 0.95)
+ (KRN O 0 R 0.957812)
+ (KRN O 0 R 0.965625)
+ (KRN O 0 R 0.973437)
+ (KRN O 0 R 0.98125)
+ (KRN O 0 R 0.989062)
+ (KRN O 0 R 0.996875)
+ (KRN O 0 R 1.004687)
+ (KRN O 0 R 1.0125)
+ (KRN O 0 R 1.020312)
+ (KRN O 0 R 1.028125)
+ (KRN O 0 R 1.035937)
+ (KRN O 0 R 1.04375)
+ (KRN O 0 R 1.051562)
+ (KRN O 0 R 1.059375)
+ (KRN O 0 R 1.067187)
+ (KRN O 0 R 1.075)
+ (KRN O 0 R 1.082812)
+ (KRN O 0 R 1.090625)
+ (KRN O 0 R 1.098437)
+ (KRN O 0 R 1.10625)
+ (KRN O 0 R 1.114062)
+ (KRN O 0 R 1.121875)
+ (KRN O 0 R 1.129687)
+ (KRN O 0 R 1.1375)
+ (KRN O 0 R 1.145312)
+ (KRN O 0 R 1.153125)
+ (KRN O 0 R 1.160937)
+ (KRN O 0 R 1.16875)
+ (KRN O 0 R 1.176562)
+ (KRN O 0 R 1.184375)
+ (KRN O 0 R 1.192187)
+ (KRN O 0 R 1.2)
+ (KRN O 0 R 1.207812)
+ (KRN O 0 R 1.215625)
+ (KRN O 0 R 1.223437)
+ (KRN O 0 R 1.23125)
+ (KRN O 0 R 1.239062)
+ (KRN O 0 R 1.246875)
+ (KRN O 0 R 1.254687)
+ (KRN O 0 R 1.2625)
+ (SKIP D 1)
+ (LABEL C j)
+ (/LIG> C j O 0)
+ (SKIP D 123)
+ (KRN O 0 R 1.202344)
+ (KRN O 0 R 1.210156)
+ (KRN O 0 R 1.217969)
+ (KRN O 0 R 1.225781)
+ (KRN O 0 R 1.233594)
+ (KRN O 0 R 1.241406)
+ (KRN O 0 R 1.249219)
+ (KRN O 0 R 1.257031)
+ (KRN O 0 R 1.264844)
+ (KRN O 0 R 1.272656)
+ (KRN O 0 R 1.280469)
+ (KRN O 0 R 1.288281)
+ (KRN O 0 R 1.296094)
+ (KRN O 0 R 1.303906)
+ (KRN O 0 R 1.311719)
+ (KRN O 0 R 1.319531)
+ (KRN O 0 R 1.327344)
+ (KRN O 0 R 1.335156)
+ (KRN O 0 R 1.342969)
+ (KRN O 0 R 1.350781)
+ (KRN O 0 R 1.358594)
+ (KRN O 0 R 1.366406)
+ (KRN O 0 R 1.374219)
+ (KRN O 0 R 1.382031)
+ (KRN O 0 R 1.389844)
+ (KRN O 0 R 1.397656)
+ (KRN O 0 R 1.405469)
+ (KRN O 0 R 1.413281)
+ (KRN O 0 R 1.421094)
+ (KRN O 0 R 1.428906)
+ (KRN O 0 R 1.436719)
+ (KRN O 0 R 1.444531)
+ (KRN O 0 R 1.452344)
+ (KRN O 0 R 1.460156)
+ (KRN O 0 R 1.467969)
+ (KRN O 0 R 1.475781)
+ (KRN O 0 R 1.483594)
+ (KRN O 0 R 1.491406)
+ (KRN O 0 R 1.499219)
+ (KRN O 0 R 1.507031)
+ (KRN O 0 R 1.514844)
+ (KRN O 0 R 1.522656)
+ (KRN O 0 R 1.530469)
+ (KRN O 0 R 1.538281)
+ (KRN O 0 R 1.546094)
+ (KRN O 0 R 1.553906)
+ (KRN O 0 R 1.561719)
+ (KRN O 0 R 1.569531)
+ (KRN O 0 R 1.577344)
+ (KRN O 0 R 1.585156)
+ (KRN O 0 R 1.592969)
+ (KRN O 0 R 1.600781)
+ (KRN O 0 R 1.608594)
+ (KRN O 0 R 1.616406)
+ (KRN O 0 R 1.624219)
+ (KRN O 0 R 1.632031)
+ (KRN O 0 R 1.639844)
+ (KRN O 0 R 1.647656)
+ (KRN O 0 R 1.655469)
+ (KRN O 0 R 1.663281)
+ (SKIP D 1)
+ (LABEL C k)
+ (LIG/> C k O 0)
+ (SKIP D 62)
+ (KRN O 0 R 1.603125)
+ (KRN O 0 R 1.610937)
+ (KRN O 0 R 1.61875)
+ (KRN O 0 R 1.626562)
+ (KRN O 0 R 1.634375)
+ (KRN O 0 R 1.642187)
+ (KRN O 0 R 1.65)
+ (KRN O 0 R 1.657812)
+ (KRN O 0 R 1.665625)
+ (KRN O 0 R 1.673437)
+ (KRN O 0 R 1.68125)
+ (KRN O 0 R 1.689062)
+ (KRN O 0 R 1.696875)
+ (KRN O 0 R 1.704687)
+ (KRN O 0 R 1.7125)
+ (KRN O 0 R 1.720312)
+ (KRN O 0 R 1.728125)
+ (KRN O 0 R 1.735937)
+ (KRN O 0 R 1.74375)
+ (KRN O 0 R 1.751562)
+ (KRN O 0 R 1.759375)
+ (KRN O 0 R 1.767187)
+ (KRN O 0 R 1.775)
+ (KRN O 0 R 1.782812)
+ (KRN O 0 R 1.790625)
+ (KRN O 0 R 1.798437)
+ (KRN O 0 R 1.80625)
+ (KRN O 0 R 1.814062)
+ (KRN O 0 R 1.821875)
+ (KRN O 0 R 1.829687)
+ (KRN O 0 R 1.8375)
+ (KRN O 0 R 1.845312)
+ (KRN O 0 R 1.853125)
+ (KRN O 0 R 1.860937)
+ (KRN O 0 R 1.86875)
+ (KRN O 0 R 1.876562)
+ (KRN O 0 R 1.884375)
+ (KRN O 0 R 1.892187)
+ (KRN O 0 R 1.9)
+ (KRN O 0 R 1.907812)
+ (KRN O 0 R 1.915625)
+ (KRN O 0 R 1.923437)
+ (KRN O 0 R 1.93125)
+ (KRN O 0 R 1.939062)
+ (KRN O 0 R 1.946875)
+ (KRN O 0 R 1.954687)
+ (KRN O 0 R 1.9625)
+ (KRN O 0 R 1.970312)
+ (KRN O 0 R 1.978125)
+ (KRN O 0 R 1.985937)
+ (KRN O 0 R 1.99375)
+ (KRN O 0 R 2.001562)
+ (KRN O 0 R 2.009375)
+ (KRN O 0 R 2.017187)
+ (KRN O 0 R 2.025)
+ (KRN O 0 R 2.032812)
+ (KRN O 0 R 2.040625)
+ (KRN O 0 R 2.048437)
+ (KRN O 0 R 2.05625)
+ (KRN O 0 R 2.064062)
+ (STOP)
+ (LABEL C l)
+ (/LIG/> C l O 0)
+ (SKIP D 1)
+ (LABEL C m)
+ (LIG O 0 O 0)
+ (STOP)
+ (LIG C a C b)
+ (KRN C d R -15.999999)
+ (LABEL C c)
+ (LABEL C d)
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ (STOP)
+ (COMMENT THIS PART OF THE PROGRAM IS NEVER USED!
+ )
+ )
+(CHARACTER O 0
+ (CHARWD R 2.0)
+ (CHARHT R 15.999999)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ (NEXTLARGER O 5)
+ )
+(CHARACTER O 5
+ (CHARWD R 0.0)
+ (CHARDP R 0.0390625)
+ (VARCHAR
+ (TOP O 5)
+ (MID C c)
+ (REP C d)
+ )
+ )
+(CHARACTER O 6
+ (CHARWD R 0.0)
+ (CHARDP R -0.113281)
+ )
+(CHARACTER O 137
+ (CHARWD R 0.0)
+ (CHARDP R 0.1015625)
+ )
+(CHARACTER O 140
+ (CHARWD R 0.0)
+ (CHARDP R 0.089844)
+ )
+(CHARACTER C a
+ (CHARWD R 0.0)
+ (NEXTLARGER C d)
+ )
+(CHARACTER C b
+ (CHARWD R 0.0)
+ (CHARDP R 0.1640625)
+ )
+(CHARACTER C c
+ (CHARWD R 0.0)
+ (CHARDP R -0.011719)
+ (COMMENT
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C d
+ (CHARWD R 0.0)
+ (CHARDP R 0.1328125)
+ (COMMENT
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C e
+ (CHARWD R 0.0)
+ (CHARDP R 0.089844)
+ )
+(CHARACTER C f
+ (CHARWD R 0.0)
+ (CHARDP R 0.0234375)
+ )
+(CHARACTER C g
+ (CHARWD R 0.0)
+ (CHARDP R -0.011719)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (LIG/ C g O 0)
+ )
+ )
+(CHARACTER C h
+ (CHARWD R 0.0)
+ (CHARDP R 0.1953125)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (/LIG C i O 0)
+ )
+ )
+(CHARACTER C i
+ (CHARWD R 0.0)
+ (CHARDP R 0.2421875)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (/LIG C i O 0)
+ )
+ )
+(CHARACTER C j
+ (CHARWD R 0.0)
+ (CHARDP R 0.1484375)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (/LIG> C j O 0)
+ (LIG C a C b)
+ (KRN C d R -15.999999)
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C k
+ (CHARWD R 0.0)
+ (CHARDP R 0.0546875)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (LIG/> C k O 0)
+ (LIG C a C b)
+ (KRN C d R -15.999999)
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C l
+ (CHARWD R 2.0)
+ (CHARDP R 0.1796875)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (/LIG/> C l O 0)
+ (LIG C a C b)
+ (KRN C d R -15.999999)
+ (/LIG/ C e C f)
+ (KRN O 0 R 0.0)
+ )
+ )
+(CHARACTER C m
+ (CHARWD R 2.0)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ (COMMENT
+ (LIG O 0 O 0)
+ )
+ )
+(CHARACTER O 224
+ (CHARWD R 2.0)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ )
+(CHARACTER O 225
+ (CHARWD R 2.0)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ )
+(CHARACTER O 226
+ (CHARWD R 2.0)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ )
+(CHARACTER O 227
+ (CHARWD R 2.0)
+ (CHARHT R 15.999999)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ )
+(CHARACTER O 305
+ (CHARWD R 2.0)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ )
+(CHARACTER O 310
+ (CHARWD R 2.0)
+ (CHARDP R 0.234375)
+ (CHARIC R -7.8125)
+ )
+(CHARACTER O 354
+ (CHARWD R 0.0)
+ (CHARDP R -15.999999)
+ )
diff --git a/Build/source/texk/web2c/triptrap/mptrap.readme b/Build/source/texk/web2c/triptrap/mptrap.readme
new file mode 100644
index 00000000000..c616da724f0
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mptrap.readme
@@ -0,0 +1,50 @@
+The `trap' test for MetaPost is analogous to the similarly named test for
+METAFONT. It requires a special version of inimp with the following constant
+settings:
+ mem_max = 4500+mem_min
+ error_line = 64
+ half_error_line = 32
+ max_print_line = 72
+ mem_top = 4500+mem_min
+The other parameters max_internal, buf_size, etc. are not very important but
+should be left at the values given in mp.web if possible.
+
+The trap test uses mtrap.mp trap.mp, trap.mpx, and trapf.tfm. These four files
+should be in the current directory when running the trap test; the other files in
+this directory should be saved for comparison purposes. Be sure that trap.mpx
+is written more recently than trap.mp so that MetaPost does not try to
+regenerate trap.mpx.
+
+Run the special inimp on mtrap.mp. It should generate mtrap.log, mtrap.0,
+mtrap.1, writeo, and writeo.2. They should almost match the corresponding files
+in this directory except that mtrap.log can have the `allowable differences'
+listed below. (The other output files can only differ in their `%%CreationDate'
+lines.)
+
+Run the special inimp and give it the contents of trap1.in as terminal input.
+This should produce lots of error messages and write a binary file `trap.mem'.
+The resulting trap.log should almost match the trapin.log in this directory.
+
+Now run the special inimp again and give it the contents of trap2.in as terminal
+input. The terminal output should almost match trap.fot and the other files
+written should almost match the versions in this directory. Run the binary
+output file trap.tfm through tftopl and compare the resulting trap.pl with the
+one in this directory.
+
+ Allowable differences
+1. trap.log, trap.ps, and the output files with numeric extensions all contain
+ lines that give the time and date.
+
+2. The capacity values printed out at the end depend on the parameters buf_size,
+ stack_size, etc.
+
+3. The strings `now untouched' statistics may differ due to changes in the
+ number of characters in the date on the first line of the log file. All the
+ string statistics will change if you alter ../mp.ch in a way that changes the
+ string pool.
+
+4. If integer division with negative numbers does not truncate toward zero in
+ your implementation, numeric results will be rounded differently.
+
+5. If for some reason you alter the storage allocation code ../mp.web or ../mp.ch
+ this will change the memory usage statistics and the capsule numbers.
diff --git a/Build/source/texk/web2c/triptrap/mptrap1.in b/Build/source/texk/web2c/triptrap/mptrap1.in
new file mode 100644
index 00000000000..6ecd06836dc
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mptrap1.in
@@ -0,0 +1,3 @@
+
+\input trap
+dump
diff --git a/Build/source/texk/web2c/triptrap/mptrap2.in b/Build/source/texk/web2c/triptrap/mptrap2.in
new file mode 100644
index 00000000000..07f5d4fa469
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mptrap2.in
@@ -0,0 +1,2 @@
+ &trap trap
+end
diff --git a/Build/source/texk/web2c/triptrap/mptrapin.log b/Build/source/texk/web2c/triptrap/mptrapin.log
new file mode 100644
index 00000000000..7642b4ffa0c
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mptrapin.log
@@ -0,0 +1,198 @@
+This is MetaPost, C Version 0.632 (INIMP) 24 JAN 1997 11:13
+**\input trap
+(trap.mp
+>> << == >> ::: ||`` ''--!! ??## && @@ $$[[]]{{ }}((5.5 0.5))
+>> ".."
+! Not implemented: (unknown numeric)++(string).
+<to be read again>
+ ;
+l.4 ...}} . (( 5.5.5 )) ++ "..";
+
+I'm afraid I don't know how to apply that operation to that
+combination of types. Continue, and I'll return the second
+argument (see above) as the result of the operation.
+
+..
+! Missing `=' has been inserted.
+<to be read again>
+ ,
+l.5 begingroup save =; let=,
+ ; save,; newinternal $=,; let )...
+You should have said `let symbol = something'.
+But don't worry; I'll pretend that an equals sign
+was present. The next token I read will be `something'.
+
+> errorstopmode=errorstopmode
+> readstring=readstring
+> 2
+> "2"
+> ,=,
+> (=tag
+> )=,
+<< == >> ::: ||`` ''--!! ??## && @@ $$[[]]{{ }}(([][]))=numeric
+<< == >> ::: ||`` ''--!! ??## && @@ $$[[]]{{ }}((5.5 0.5))=<< == >> :::
+||`` ''--!! ??## && @@ $$[[]]{{ }}((5.5 0.5))
+> year=month
+! OK.
+l.6 ...ring,2,"2",,,(,),<<,year;
+
+
+! Missing `:' has been inserted.
+<to be read again>
+ ;
+l.8 ...not cycle "":1.1 forever;
+ fi;
+The next thing in this loop should have been a `:'.
+So I'll pretend that a colon was present;
+everything from here to `endfor' will be iterated.
+
+{fi}
+{exitif}
+{[repeat the loop]}
+{false}
+{fi}
+{exitif}
+{[repeat the loop]}
+{(2.1)>(2)}
+{true}
+{tracingcommands:=2.1}
+{showtoken}
+> |=:|>=|=:|>
+! OK.
+l.9 ... endfor; showtoken |=:|>;
+
+
+! Arithmetic overflow.
+l.10 ...acinglostchars:=1/.00001
+ ; tracingequations:=$+1; p~=t...
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+{tracinglostchars:=32767.99998}
+{(0)+(1)}
+{tracingequations:=1}
+{(32767.99998)+(0.00002)}
+! Arithmetic overflow.
+l.10 ...tracinglostchars+.00001;
+
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+{(p~)=(32767.99998)}
+## p~=32767.99998
+{interim}
+{tracingmacros:=1}
+{tracingoutput:=1}
+{warningcheck:=1}
+{tracingstats:=1}
+{tracingchoices:=1}
+{tracingspecs:=1}
+{ASCII("")}
+{$:=-1}
+{$:=x}
+>> x
+! Internal quantity `$' must receive a known value.
+<to be read again>
+ ;
+l.12 ...os:=1; $:=ASCII""; $:=x;
+ p~:=p~;
+I can't set an internal quantity to anything but a known
+numeric value, so I'll have to ignore this assignment.
+
+{p~:=32767.99998}
+## p~=32767.99998
+! Value is too large (32767.99998).
+l.12 ...:=ASCII""; $:=x; p~:=p~;
+
+The equation I just processed has given some variable
+a value of 4096 or more. Continue and I'll try to cope
+with that big value; but it might be dangerous.
+(Set warningcheck:=0 to suppress this message.)
+
+{delimiters}
+{delimiters}
+{vardef}
+{def}
+
+foo(TEXT2)->begingroup(TEXT2)endgroup
+(SUFFIX0)<-
+(SUFFIX1)<-foo
+(TEXT2)<-interim.tracinglostchars:=(0.5;show.urcorner("flubo"infont"trap
+f"),2+2
+{begingroup}
+{interim}
+! Missing `)' has been inserted.
+<to be read again>
+ ;
+<argument> ...nglostchars:=(0.5;
+ show.urcorner("flubo"infont"t...
+foo->begingroup(TEXT2)
+ endgroup
+l.17 ),2+2endtext
+ ; for n=tracingspecs step 1 until $:fi end...
+I found no right delimiter to match a left one. So I've
+put one in, behind the scenes; this may fix the problem.
+
+{tracinglostchars:=0.5}
+{show}
+{("flubo")infont("trapf")}
+Missing character: There is no f in font trapf!
+Missing character: There is no l in font trapf!
+Missing character: There is no o in font trapf!
+{urcorner(picture)}
+>> (2.9888,7.97011)
+{(2)+(2)}
+
+>> 4
+! OK.
+<to be read again>
+ endgroup
+l.17 ),2+2endtext
+ ; for n=tracingspecs step 1 until $:fi end...
+
+{restoring tracinglostchars=32767.99998}
+{endgroup}
+{for}
+{showstats}
+Memory usage 292&42 (3418 still untouched)
+String usage 28&93 (1282&9362 now untouched)
+! OK.
+l.17 ...l $:fi endfor showstats;
+
+
+{let}
+{path}
+{-(15)}
+{-(12)}
+Path at line 18, before choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+
+Path at line 18, after choices:
+(0,0)..controls (15,4) and (-15,-12)
+ ..(4,0)
+
+{(unknown path p~)=(path)}
+{everyjob}
+{vardef}
+{let}
+{vardef}
+{def}
+{begingroup}
+{errorstopmode}
+
+{endgroup}
+{elseif}
+{endinput}
+{\}
+)
+*dump
+Beginning to dump on file trap.mem
+ (preloaded mem=trap 97.1.24)
+at most 1226 strings of total length 22670
+398 memory locations dumped; current usage is 318&68
+279 symbolic tokens
diff --git a/Build/source/texk/web2c/triptrap/mtrap.0 b/Build/source/texk/web2c/triptrap/mtrap.0
new file mode 100644
index 00000000000..dacbb18fd9b
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mtrap.0
@@ -0,0 +1,35 @@
+%!PS
+%%BoundingBox: -36 -24 84 84
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%*Font: trapf 9.9628 9.96265 35:c008
+%%EndProlog
+%%Page: 1 1
+gsave newpath 50 0 moveto
+50 13.26082 44.73216 25.97853 35.35535 35.35535 curveto
+25.97853 44.73216 13.26082 50 0 50 curveto
+-13.26082 50 -25.97853 44.73216 -35.35535 35.35535 curveto
+-44.73216 25.97853 -50 13.26082 -50 0 curveto
+-50 -13.26082 -44.73216 -25.97853 -35.35535 -35.35535 curveto
+-25.97853 -44.73216 -13.26082 -50 0 -50 curveto
+13.26082 -50 25.97853 -44.73216 35.35535 -35.35535 curveto
+44.73216 -25.97853 50 -13.26082 50 0 curveto closepath clip
+grestore
+ 0 setgray 0 1 dtransform truncate idtransform setlinewidth pop
+ [] 0 setdash 0 setlinecap 0 setlinejoin 1 setmiterlimit
+newpath 1 1 moveto
+3 2 lineto stroke
+ 0.4 setgray
+newpath -36 -24 moveto
+84 -24 lineto
+0 84 lineto
+ closepath fill
+ 0 setgray
+gsave [0.86601 0.5 -0.5 0.86601 2 3 ] concat 0 0 moveto
+(A56) trapf 9.9628 fshow grestore
+gsave newpath 4 5 moveto
+8 1 lineto
+0.00064 1 scale stroke grestore
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/mtrap.1 b/Build/source/texk/web2c/triptrap/mtrap.1
new file mode 100644
index 00000000000..27b3253f355
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mtrap.1
@@ -0,0 +1,39 @@
+%!PS-Adobe-3.0 EPSF-3.0
+%%BoundingBox: -84 -36 24 84
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%%DocumentFonts: trapf
+ /trapf /trapf def
+/fshow {exch findfont exch scalefont setfont show}bind def
+%%EndProlog
+%%Page: 1 1
+gsave newpath 0 50 moveto
+-13.26082 50 -25.97853 44.73216 -35.35535 35.35535 curveto
+-44.73216 25.97853 -50 13.26082 -50 0 curveto
+-50 -13.26082 -44.73216 -25.97853 -35.35535 -35.35535 curveto
+-25.97853 -44.73216 -13.26082 -50 0 -50 curveto
+13.26082 -50 25.97853 -44.73216 35.35535 -35.35535 curveto
+44.73216 -25.97853 50 -13.26082 50 0 curveto
+50 13.26082 44.73216 25.97853 35.35535 35.35535 curveto
+25.97853 44.73216 13.26082 50 0 50 curveto closepath clip
+grestore
+ 0 setgray 1
+ 0 dtransform exch truncate exch idtransform pop setlinewidth
+ [] 0 setdash 0 setlinecap 0 setlinejoin 1 setmiterlimit
+gsave newpath -1 1 moveto
+-2 3 lineto
+[0 1 -1 0 0 0] concat stroke grestore
+ 0.4 setgray
+newpath 24 -36 moveto
+24 84 lineto
+-84 0 lineto
+ closepath fill
+ 0 setgray
+gsave [-0.5 0.86601 -0.86601 -0.5 -3 2 ] concat 0 0 moveto
+(A56) trapf 9.9628 fshow grestore
+gsave newpath -5 4 moveto
+-1 8 lineto
+[0 -0.00064 -1 0 0 0] concat stroke grestore
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/mtrap.log b/Build/source/texk/web2c/triptrap/mtrap.log
new file mode 100644
index 00000000000..171792f0bc8
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mtrap.log
@@ -0,0 +1,1108 @@
+This is MetaPost, C Version 0.64 (INIMP) 28 JAN 1998 11:18
+**mtrap
+(mtrap.mp
+Memory usage 28&13 (3463 still untouched)
+String usage 4&24 (1306&9877 now untouched)
+>> 7629.39453
+>> -7629.39453
+>> 166.74463
+>> -166.74463
+>> -166.74463
+>> 166.74463
+>> 3584.5974
+>> 1
+>> -1
+>> -1
+>> 1
+>> 7629.39455
+>> -7629.39455
+>> 7629.39455
+>> -7629.39455
+>> 7629.39455
+>> -7629.39455
+>> 7629.39453
+>> -7629.39453
+! Arithmetic overflow.
+TS->...roup.show(EXPR2)*(EXPR3),
+ (-(EXPR2))*(EXPR3),(EXPR2)*(-...
+l.24 TS(13107.20000)(2.50000)
+ ; % p*q=2^47-2^15 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(-(EXPR2))*(EXPR3),
+ (EXPR2)*(-(EXPR3)),(-(EXPR2))...
+l.24 TS(13107.20000)(2.50000)
+ ; % p*q=2^47-2^15 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(EXPR2)*(-(EXPR3)),
+ (-(EXPR2))*(-(EXPR3))endgroup
+l.24 TS(13107.20000)(2.50000)
+ ; % p*q=2^47-2^15 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR2))*(-(EXPR3))endgroup
+
+l.24 TS(13107.20000)(2.50000)
+ ; % p*q=2^47-2^15 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+! Arithmetic overflow.
+TS->...roup.show(EXPR2)*(EXPR3),
+ (-(EXPR2))*(EXPR3),(EXPR2)*(-...
+l.25 TS(124.77580)(262.61502)
+ ; % p*q=2^47-2^15+6 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(-(EXPR2))*(EXPR3),
+ (EXPR2)*(-(EXPR3)),(-(EXPR2))...
+l.25 TS(124.77580)(262.61502)
+ ; % p*q=2^47-2^15+6 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(EXPR2)*(-(EXPR3)),
+ (-(EXPR2))*(-(EXPR3))endgroup
+l.25 TS(124.77580)(262.61502)
+ ; % p*q=2^47-2^15+6 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR2))*(-(EXPR3))endgroup
+
+l.25 TS(124.77580)(262.61502)
+ ; % p*q=2^47-2^15+6 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+>> 32767.99998
+>> -32767.99998
+>> -32767.99998
+>> 32767.99998
+! Arithmetic overflow.
+TS->...roup.show(EXPR2)*(EXPR3),
+ (-(EXPR2))*(EXPR3),(EXPR2)*(-...
+l.27 TS(64.03127)(511.75000)
+ ; % p*q=2^47-2^14 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(-(EXPR2))*(EXPR3),
+ (EXPR2)*(-(EXPR3)),(-(EXPR2))...
+l.27 TS(64.03127)(511.75000)
+ ; % p*q=2^47-2^14 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(EXPR2)*(-(EXPR3)),
+ (-(EXPR2))*(-(EXPR3))endgroup
+l.27 TS(64.03127)(511.75000)
+ ; % p*q=2^47-2^14 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR2))*(-(EXPR3))endgroup
+
+l.27 TS(64.03127)(511.75000)
+ ; % p*q=2^47-2^14 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+! Arithmetic overflow.
+TS->...roup.show(EXPR2)*(EXPR3),
+ (-(EXPR2))*(EXPR3),(EXPR2)*(-...
+l.28 TS(39.46178)(830.37315)
+ ; % p*q=2^47-2^14+1 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(-(EXPR2))*(EXPR3),
+ (EXPR2)*(-(EXPR3)),(-(EXPR2))...
+l.28 TS(39.46178)(830.37315)
+ ; % p*q=2^47-2^14+1 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(EXPR2)*(-(EXPR3)),
+ (-(EXPR2))*(-(EXPR3))endgroup
+l.28 TS(39.46178)(830.37315)
+ ; % p*q=2^47-2^14+1 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR2))*(-(EXPR3))endgroup
+
+l.28 TS(39.46178)(830.37315)
+ ; % p*q=2^47-2^14+1 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+! Arithmetic overflow.
+TS->...roup.show(EXPR2)*(EXPR3),
+ (-(EXPR2))*(EXPR3),(EXPR2)*(-...
+l.29 TS(1207.05434)(27.14708)
+ ; % p*q=2^47-2^14-1 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(-(EXPR2))*(EXPR3),
+ (EXPR2)*(-(EXPR3)),(-(EXPR2))...
+l.29 TS(1207.05434)(27.14708)
+ ; % p*q=2^47-2^14-1 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR3),(EXPR2)*(-(EXPR3)),
+ (-(EXPR2))*(-(EXPR3))endgroup
+l.29 TS(1207.05434)(27.14708)
+ ; % p*q=2^47-2^14-1 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> -32767.99998
+! Arithmetic overflow.
+TS->...XPR2))*(-(EXPR3))endgroup
+
+l.29 TS(1207.05434)(27.14708)
+ ; % p*q=2^47-2^14-1 => *
+Uh, oh. A little while ago one of the quantities that I was
+computing got too large, so I'm afraid your answers will be
+somewhat askew. You'll probably have to adopt different
+tactics next time. But I shall try to carry on anyway.
+
+>> 32767.99998
+>> 32767.99998
+>> -32767.99998
+>> -32767.99998
+>> 32767.99998
+>> 32767.99998
+>> -32767.99998
+>> -32767.99998
+>> 32767.99998
+>> 32767.99998
+>> -32767.99998
+>> -32767.99998
+>> 32767.99998
+>> 7629.39455
+>> -7629.39455
+>> -7629.39455
+>> 7629.39455
+>> 7629.39455
+>> -7629.39455
+>> -7629.39455
+>> 7629.39455
+>> 7629.39453
+>> -7629.39453
+>> -7629.39453
+>> 7629.39453
+>> 8
+>> -8
+>> 1.86264
+>> -1.86264
+>> 3814.69728
+>> 2500.19531
+>> 3041.84044
+>> 2052.74315
+>> 7629.39455
+>> -7629.39455
+>> -7629.39455
+>> 7629.39455
+>> 91.60707
+>> -91.60707
+>> -91.60707
+>> 91.60707
+>> 38.63344
+>> -38.63344
+>> -38.63344
+>> 38.63344
+>> 360.31036
+>> -360.31036
+>> -360.31036
+>> 360.31036
+>> 32767
+>> 16394
+Memory usage 28&13 (3358 still untouched)
+String usage 8&32 (1302&9869 now untouched)
+Memory usage 109&13 (3358 still untouched)
+String usage 10&42 (1300&9859 now untouched)
+Memory usage 116&13 (3358 still untouched)
+String usage 11&45 (1299&9856 now untouched)
+Memory usage 139&56 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> Edge structure at line 71:
+End edges
+
+>> false
+>> false
+>> false
+>> false
+>> false
+>> 0
+Memory usage 152&59 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> Edge structure at line 73:
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+End edges
+
+>> false
+>> false
+>> false
+>> true
+>> false
+>> 0
+Memory usage 220&59 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> Edge structure at line 75:
+setbounds path:
+(-3,-2)..controls (0.33333,-2) and (3.66667,-2)
+ ..(7,-2)..controls (4.66667,1) and (2.33333,4)
+ ..(0,7)..controls (-1,4) and (-2,1)
+ ..cycle
+end of setbounds
+End edges
+
+>> false
+>> false
+>> false
+>> false
+>> true
+>> 0
+Memory usage 245&59 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> Edge structure at line 76:
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+End edges
+
+>> true
+>> false
+>> false
+>> false
+>> false
+>> 1
+Memory usage 293&72 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> Edge structure at line 78:
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+End edges
+
+>> false
+>> false
+>> false
+>> true
+>> false
+>> 2
+Memory usage 314&59 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> (0.5,2.5)
+>> (3.5,0.5)
+>> Edge structure at line 81:
+setbounds path:
+(2,-3)..controls (2,0.33333) and (2,3.66667)
+ ..(2,7)..controls (-1,4.66667) and (-4,2.33333)
+ ..(-7,0)..controls (-4,-1) and (-1,-2)
+ ..cycle
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+end of setbounds
+End edges
+
+>> false
+>> false
+>> false
+>> false
+>> true
+>> 2
+Memory usage 339&59 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> (-7,-3)
+>> (2,7)
+>> Edge structure at line 82:
+setbounds path:
+(2,-3)..controls (2,0.33333) and (2,3.66667)
+ ..(2,7)..controls (-1,4.66667) and (-4,2.33333)
+ ..(-7,0)..controls (-4,-1) and (-1,-2)
+ ..cycle
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+end of setbounds
+End edges
+
+>> false
+>> false
+>> false
+>> false
+>> true
+>> 2
+Memory usage 339&59 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> Edge structure at line 83:
+Filled contour colored (0.4,0.4,0.4):
+(-36,-24)..controls (3.99994,-24) and (44.00006,-24)
+ ..(84,-24)..controls (56.00006,12) and (27.99994,48)
+ ..(0,84)..controls (-12,48) and (-24,12)
+ ..cycle
+End edges
+
+>> false
+>> true
+>> false
+>> false
+>> false
+>> 1
+Memory usage 345&70 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> Edge structure at line 85:
+setbounds path:
+(2,-3)..controls (2,0.33333) and (2,3.66667)
+ ..(2,7)..controls (-1,4.66667) and (-4,2.33333)
+ ..(-7,0)..controls (-4,-1) and (-1,-2)
+ ..cycle
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+end of setbounds
+Filled contour colored (0.4,0.4,0.4):
+(-36,-24)..controls (3.99994,-24) and (44.00006,-24)
+ ..(84,-24)..controls (56.00006,12) and (27.99994,48)
+ ..(0,84)..controls (-12,48) and (-24,12)
+ ..cycle
+End edges
+
+>> false
+>> false
+>> false
+>> false
+>> true
+>> 2
+Memory usage 364&59 (3358 still untouched)
+String usage 14&51 (1296&9850 now untouched)
+>> Edge structure at line 86:
+"A56" infont "trapf"
+transformed (0,0,1,0,0,1)
+End edges
+
+>> false
+>> false
+>> true
+>> false
+>> false
+>> 1
+Memory usage 355&64 (3358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> Edge structure at line 88:
+setbounds path:
+(2,-3)..controls (2,0.33333) and (2,3.66667)
+ ..(2,7)..controls (-1,4.66667) and (-4,2.33333)
+ ..(-7,0)..controls (-4,-1) and (-1,-2)
+ ..cycle
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+end of setbounds
+Filled contour colored (0.4,0.4,0.4):
+(-36,-24)..controls (3.99994,-24) and (44.00006,-24)
+ ..(84,-24)..controls (56.00006,12) and (27.99994,48)
+ ..(0,84)..controls (-12,48) and (-24,12)
+ ..cycle
+
+"A56" infont "trapf"
+transformed (2,3,0.86603,-0.5,0.5,0.86603)
+End edges
+
+>> false
+>> false
+>> false
+>> false
+>> true
+>> 3
+Memory usage 365&59 (3358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> Edge structure at line 89:
+Filled pen stroke :
+(4,5)..controls (5.33333,3.66667) and (6.66667,2.33333)
+ ..(8,1)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,1)
+End edges
+
+>> true
+>> false
+>> false
+>> false
+>> false
+>> 1
+Memory usage 390&73 (3358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> Edge structure at line 91:
+setbounds path:
+(2,-3)..controls (2,0.33333) and (2,3.66667)
+ ..(2,7)..controls (-1,4.66667) and (-4,2.33333)
+ ..(-7,0)..controls (-4,-1) and (-1,-2)
+ ..cycle
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+end of setbounds
+Filled contour colored (0.4,0.4,0.4):
+(-36,-24)..controls (3.99994,-24) and (44.00006,-24)
+ ..(84,-24)..controls (56.00006,12) and (27.99994,48)
+ ..(0,84)..controls (-12,48) and (-24,12)
+ ..cycle
+
+"A56" infont "trapf"
+transformed (2,3,0.86603,-0.5,0.5,0.86603)
+Filled pen stroke :
+(4,5)..controls (5.33333,3.66667) and (6.66667,2.33333)
+ ..(8,1)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,1)
+End edges
+
+>> false
+>> false
+>> false
+>> false
+>> true
+>> 4
+Memory usage 409&59 (3358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> "non-picture"
+>> false
+>> false
+>> false
+>> false
+>> false
+>> 11
+Memory usage 409&59 (3358 still untouched)
+String usage 18&75 (1292&9826 now untouched)
+Memory usage 308&13 (3358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> Edge structure at line 96:
+setbounds path:
+(2,-3)..controls (2,0.33333) and (2,3.66667)
+ ..(2,7)..controls (-1,4.66667) and (-4,2.33333)
+ ..(-7,0)..controls (-4,-1) and (-1,-2)
+ ..cycle
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+end of setbounds
+End edges
+
+>> Edge structure at line 96:
+Filled contour colored (0.4,0.4,0.4):
+(-36,-24)..controls (3.99994,-24) and (44.00006,-24)
+ ..(84,-24)..controls (56.00006,12) and (27.99994,48)
+ ..(0,84)..controls (-12,48) and (-24,12)
+ ..cycle
+End edges
+
+>> Edge structure at line 96:
+"A56" infont "trapf"
+transformed (2,3,0.86603,-0.5,0.5,0.86603)
+End edges
+
+>> Edge structure at line 96:
+Filled pen stroke :
+(4,5)..controls (5.33333,3.66667) and (6.66667,2.33333)
+ ..(8,1)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,1)
+End edges
+
+Memory usage 308&13 (3358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> 4
+Memory usage 563&13 (3358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> Edge structure at line 104:
+clipping path:
+(5,5)..controls (5,6.32608) and (4.47322,7.59785)
+ ..(3.53554,8.53554)..controls (2.59785,9.47322) and (1.32608,10)
+ ..(0,10)..controls (-1.32608,10) and (-2.59785,9.47322)
+ ..(-3.53554,8.53554)..controls (-4.47322,7.59785) and (-5,6.32608)
+ ..(-5,5)..controls (-5,3.67392) and (-4.47322,2.40215)
+ ..(-3.53554,1.46446)..controls (-2.59785,0.52678) and (-1.32608,0)
+ ..(0,0)..controls (1.32608,0) and (2.59785,0.52678)
+ ..(3.53554,1.46446)..controls (4.47322,2.40215) and (5,3.67392)
+ ..cycle
+setbounds path:
+(2,-3)..controls (2,0.33333) and (2,3.66667)
+ ..(2,7)..controls (-1,4.66667) and (-4,2.33333)
+ ..(-7,0)..controls (-4,-1) and (-1,-2)
+ ..cycle
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+end of setbounds
+Filled contour colored (0.4,0.4,0.4):
+(-36,-24)..controls (3.99994,-24) and (44.00006,-24)
+ ..(84,-24)..controls (56.00006,12) and (27.99994,48)
+ ..(0,84)..controls (-12,48) and (-24,12)
+ ..cycle
+
+"A56" infont "trapf"
+transformed (2,3,0.86603,-0.5,0.5,0.86603)
+Filled pen stroke :
+(4,5)..controls (5.33333,3.66667) and (6.66667,2.33333)
+ ..(8,1)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,1)
+stop clipping
+setbounds path:
+(2,-3)..controls (2,0.33333) and (2,3.66667)
+ ..(2,7)..controls (-1,4.66667) and (-4,2.33333)
+ ..(-7,0)..controls (-4,-1) and (-1,-2)
+ ..cycle
+clipping path:
+(50,0)..controls (50,13.26082) and (44.73216,25.97853)
+ ..(35.35535,35.35535)..controls (25.97853,44.73216) and (13.26082,50)
+ ..(0,50)..controls (-13.26082,50) and (-25.97853,44.73216)
+ ..(-35.35535,35.35535)..controls (-44.73216,25.97853) and (-50,13.26082
+)
+ ..(-50,0)..controls (-50,-13.26082) and (-44.73216,-25.97853)
+ ..(-35.35535,-35.35535)..controls (-25.97853,-44.73216) and (-13.26082,
+-50)
+ ..(0,-50)..controls (13.26082,-50) and (25.97853,-44.73216)
+ ..(35.35535,-35.35535)..controls (44.73216,-25.97853) and (50,-13.26082
+)
+ ..cycle
+stop clipping
+Filled pen stroke :
+(1,1)..controls (1.66667,1.33333) and (2.33333,1.66667)
+ ..(3,2)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,1,0,0,1)
+end of setbounds
+Filled contour colored (0.4,0.4,0.4):
+(-36,-24)..controls (3.99994,-24) and (44.00006,-24)
+ ..(84,-24)..controls (56.00006,12) and (27.99994,48)
+ ..(0,84)..controls (-12,48) and (-24,12)
+ ..cycle
+
+"A56" infont "trapf"
+transformed (2,3,0.86603,-0.5,0.5,0.86603)
+Filled pen stroke :
+(4,5)..controls (5.33333,3.66667) and (6.66667,2.33333)
+ ..(8,1)
+butt ends, mitered joins limited 1 with pen
+pencircle transformed (0,0,0,0,0,1)
+End edges
+
+>> 5
+Memory usage 747&13 (3358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> false
+>> false
+>> false
+>> true
+>> false
+>> Path at line 112:
+(5,5)..controls (5,6.32608) and (4.47322,7.59785)
+ ..(3.53554,8.53554)..controls (2.59785,9.47322) and (1.32608,10)
+ ..(0,10)..controls (-1.32608,10) and (-2.59785,9.47322)
+ ..(-3.53554,8.53554)..controls (-4.47322,7.59785) and (-5,6.32608)
+ ..(-5,5)..controls (-5,3.67392) and (-4.47322,2.40215)
+ ..(-3.53554,1.46446)..controls (-2.59785,0.52678) and (-1.32608,0)
+ ..(0,0)..controls (1.32608,0) and (2.59785,0.52678)
+ ..(3.53554,1.46446)..controls (4.47322,2.40215) and (5,3.67392)
+ ..cycle
+
+>> Pen at line 112:
+pencircle transformed (0,0,0,0,0,0)
+
+>> Edge structure at line 112:
+End edges
+
+>> ""
+>> ""
+>> (0,0,0)
+>> (0,0)
+>> (0,0)
+>> (0,0)
+Memory usage 1003&85 (2358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> false
+>> false
+>> false
+>> false
+>> true
+>> Path at line 112:
+(2,-3)..controls (2,0.33333) and (2,3.66667)
+ ..(2,7)..controls (-1,4.66667) and (-4,2.33333)
+ ..(-7,0)..controls (-4,-1) and (-1,-2)
+ ..cycle
+
+>> Pen at line 112:
+pencircle transformed (0,0,0,0,0,0)
+
+>> Edge structure at line 112:
+End edges
+
+>> ""
+>> ""
+>> (0,0,0)
+>> (0,0)
+>> (0,0)
+>> (0,0)
+Memory usage 873&85 (2358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> false
+>> true
+>> false
+>> false
+>> false
+>> Path at line 112:
+(-36,-24)..controls (3.99994,-24) and (44.00006,-24)
+ ..(84,-24)..controls (56.00006,12) and (27.99994,48)
+ ..(0,84)..controls (-12,48) and (-24,12)
+ ..cycle
+
+>> Pen at line 112:
+pencircle transformed (0,0,0,0,0,0)
+
+>> Edge structure at line 112:
+End edges
+
+>> ""
+>> ""
+>> (0.4,0.4,0.4)
+>> (0,0)
+>> (0,0)
+>> (0,0)
+Memory usage 786&85 (2358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> false
+>> false
+>> true
+>> false
+>> false
+>> Path at line 112:
+(0,0)
+
+>> Pen at line 112:
+pencircle transformed (0,0,0,0,0,0)
+
+>> Edge structure at line 112:
+End edges
+
+>> "trapf"
+>> "A56"
+>> (0,0,0)
+>> (2,3)
+>> (0.86603,0.5)
+>> (-0.5,0.86603)
+Memory usage 773&85 (2358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> true
+>> false
+>> false
+>> false
+>> false
+>> Path at line 112:
+(4,5)..controls (5.33333,3.66667) and (6.66667,2.33333)
+ ..(8,1)
+
+>> Pen at line 112:
+pencircle transformed (0,0,0,0,0,1)
+
+>> Edge structure at line 112:
+End edges
+
+>> ""
+>> ""
+>> (0,0,0)
+>> (0,0)
+>> (0,0)
+>> (0,0)
+Memory usage 788&85 (2358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+>> Edge structure at line 116:
+"B34" infont "trapf"
+transformed (0,0,1,0,0,1)
+End edges
+
+Memory usage 319&13 (2358 still untouched)
+String usage 17&64 (1293&9837 now untouched)
+[0] [1]
+Memory usage 325&13 (2358 still untouched)
+String usage 20&78 (1287&9809 now untouched)
+>> "%!PS"
+>> "%%BoundingBox: -36 -24 84 84"
+>> "%%Creator: MetaPost"
+>> "%%Pages: 1"
+>> "%*Font: trapf 9.9628 9.96265 35:c008"
+>> "%%EndProlog"
+>> "%%Page: 1 1"
+>> "gsave newpath 50 0 moveto"
+>> "50 13.26082 44.73216 25.97853 35.35535 35.35535 curveto"
+>> "25.97853 44.73216 13.26082 50 0 50 curveto"
+>> "-13.26082 50 -25.97853 44.73216 -35.35535 35.35535 curveto"
+>> "-44.73216 25.97853 -50 13.26082 -50 0 curveto"
+>> "-50 -13.26082 -44.73216 -25.97853 -35.35535 -35.35535 curveto"
+>> "-25.97853 -44.73216 -13.26082 -50 0 -50 curveto"
+>> "13.26082 -50 25.97853 -44.73216 35.35535 -35.35535 curveto"
+>> "44.73216 -25.97853 50 -13.26082 50 0 curveto closepath clip"
+>> "grestore"
+>> " 0 setgray 0 1 dtransform truncate idtransform setlinewidth pop"
+>> " [] 0 setdash 0 setlinecap 0 setlinejoin 1 setmiterlimit"
+>> "newpath 1 1 moveto"
+>> "3 2 lineto stroke"
+>> " 0.4 setgray"
+>> "newpath -36 -24 moveto"
+>> "84 -24 lineto"
+>> "0 84 lineto"
+>> " closepath fill"
+>> " 0 setgray"
+>> "gsave [0.86601 0.5 -0.5 0.86601 2 3 ] concat 0 0 moveto"
+>> "(A56) trapf 9.9628 fshow grestore"
+>> "gsave newpath 4 5 moveto"
+>> "8 1 lineto"
+>> "0.00064 1 scale stroke grestore"
+>> "showpage"
+>> "%%EOF"
+Memory usage 325&13 (2358 still untouched)
+String usage 22&84 (1247&8769 now untouched)
+>> "%!PS-Adobe-3.0 EPSF-3.0"
+>> "%%BoundingBox: -84 -36 24 84"
+>> 40
+Memory usage 325&13 (2358 still untouched)
+String usage 22&84 (1206&7603 now untouched)
+>> "^^@"
+>> "%!PS"
+>> "%%BoundingBox: -36 -24 84 84"
+>> "%%Creator: MetaPost"
+Memory usage 325&13 (2358 still untouched)
+String usage 24&110 (1197&7522 now untouched)
+Memory usage 325&13 (2358 still untouched)
+String usage 26&125 (1148&7358 now untouched)
+>> "1 1"
+>> "%%Pages: 1"
+>> "2 4"
+>> "%*Font: trapf 9.9628 9.96265 35:c008"
+>> "3 9"
+>> "%%EndProlog"
+Memory usage 325&13 (2358 still untouched)
+String usage 25&135 (1144&7308 now untouched)
+{randomseed:=4.34294}
+>> "bbbbbbbbadadbbbbbbbbadadbbbbbbbbadadbbbbbbbbadadbbbbbbbbadad"
+Memory usage 325&13 (2358 still untouched)
+String usage 26&141 (1195&1840 now untouched)
+! Number is too large (12000).
+l.185 n = 12000
+ ; show n;
+It is at least 4096. Continue and I'll try to cope
+with that big value; but it might be dangerous.
+(Set warningcheck:=0 to suppress this message.)
+
+! Value is too large (12000).
+l.185 n = 12000;
+ show n;
+The equation I just processed has given some variable
+a value of 4096 or more. Continue and I'll try to cope
+with that big value; but it might be dangerous.
+(Set warningcheck:=0 to suppress this message.)
+
+>> 12000
+! Enormous number has been reduced.
+l.187 n:= 40000
+ ; show n;
+I can't handle numbers bigger than 32767.99998;
+so I've changed your constant to that maximum amount.
+
+>> 32767.99998
+Memory usage 325&13 (2358 still untouched)
+String usage 26&141 (1195&1840 now untouched)
+>> triangle
+! Improper iteration spec has been replaced by nullpicture.
+<to be read again>
+ :
+l.191 for x within triangle:
+ show x; endfor
+When you say `for x in p', p must be a known picture.
+
+Memory usage 327&13 (2358 still untouched)
+String usage 27&149 (1194&1832 now untouched)
+>> path
+! Not a string.
+<to be read again>
+ to
+l.193 write triang to
+ "writeo";
+The text to be written should be a known string expression
+
+! Extra tokens will be flushed.
+<to be read again>
+ to
+l.193 write triang to
+ "writeo";
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+! Missing `to' clause.
+<to be read again>
+ "writeo"
+l.194 write "triangle" "writeo"
+ ;
+A write command should end with `to <filename>'
+
+! Extra tokens will be flushed.
+<to be read again>
+ "writeo"
+l.194 write "triangle" "writeo"
+ ;
+I've just read as much of that statement as I could fathom,
+so a semicolon should have been next. It's very puzzling...
+but I'll try to get myself back together, by ignoring
+everything up to the next `;'. Please insert a semicolon
+now in front of anything that you don't want me to delete.
+(See Chapter 27 of The METAFONTbook for an example.)
+
+>> path
+! Not a string.
+<to be read again>
+ ;
+l.195 ...e "triangle" to triang;
+
+I can't write to that file name. It isn't a known string
+
+Memory usage 327&13 (2358 still untouched)
+String usage 27&149 (1193&1824 now untouched)
+>> "%%BoundingBox: -36 -24 84 84" )
+Here is how much of MetaPost's memory you used:
+ 32 strings out of 1310
+ 561 string characters out of 9901
+ 2143 words of memory out of 4501
+ 237 symbolic tokens out of 2100
+ 5i,33n,6p,100b stack positions out of 30i,100n,150p,500b
+ 3 string compactions (moved 1368 characters, 89 strings)
+
+2 output files written: mtrap.0 .. mtrap.1
diff --git a/Build/source/texk/web2c/triptrap/mtrap.mp b/Build/source/texk/web2c/triptrap/mtrap.mp
new file mode 100644
index 00000000000..617a68cc2f5
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/mtrap.mp
@@ -0,0 +1,202 @@
+batchmode;
+delimiters ();
+def -- = {curl 1}..{curl 1} enddef;
+showstats;
+
+begingroup
+save MF, TF, MS, TS;
+interim warningcheck:=0;
+
+vardef MF(text p)(text q) = show p/q (4096) enddef;
+vardef TF(text p)(text q) = show p/4096 (q), p/4096 (-q) enddef;
+vardef MS(expr p, q) = show p/q, (-p)/q, p/(-q), (-p)/(-q) enddef;
+vardef TS(expr p, q) = show p*q, (-p)*q, p*(-q), (-p)*(-q) enddef;
+
+% Hard cases for arithmetic routines (taken from mp/mathtest.c)
+TF(1618.00821)(19313.86989); % p*q=(10^9+1)*2^27-6 => 7629.39453
+TS(12.91296)(12.91296); % => 166.74463
+MF(4793.68996)(5477.58977); % => 3584.59740
+MS(12.91296)(12.91296); % => 1.00000
+TF(2048.00000)(15258.78908); % p*q=(10^9+1)*2^27 => 7629.39455
+TF(2644.17595)(11818.42685); % p*q=(10^9+1)*2^27+2 => 7629.39455
+TF(1164.89432)(26826.46791); % p*q=(10^9+1)*2^27+2^14+2 => 7629.39455
+TF(3310.94371)(9438.39665); % p*q=(10^9+1)*2^27-2^14-3 => 7629.39453
+TS(13107.20000)(2.50000); % p*q=2^47-2^15 => *
+TS(124.77580)(262.61502); % p*q=2^47-2^15+6 => *
+TS(1038.61232)(31.54979); % p*q=2^47-2^15-1 => 32767.99998
+TS(64.03127)(511.75000); % p*q=2^47-2^14 => *
+TS(39.46178)(830.37315); % p*q=2^47-2^14+1 => *
+TS(1207.05434)(27.14708); % p*q=2^47-2^14-1 => *
+TS(7.25000)(4519.72414); % p*q=2^47-3*2^14 => 32767.99998
+TS(215.31056)(152.18947); % p*q=2^47-3*2^14+1 => 32767.99998
+TS(14833.24916)(2.20909); % p*q=2^47-3*2^14-1 => 32767.99998
+TS(339.62500)(22.46417); % p*q=(10^9+1)*2^15 => 7629.39455
+TS(47.62218)(160.20676); % p*q=(10^9+1)*2^15+2 => 7629.39455
+TS(74.64186)(102.21335); % p*q=(10^9+1)*2^15-2 => 7629.39453
+TF(2.50000)(13107.20000); % p*q=2^47-2^15 => 8.00000
+TF(47.62218)(160.20676); % p*q=(10^9+1)*2^15+2 => 1.86264
+MF(7629.39455)(8192.00000); % 2^29*p+q=2q*(5*10^8+1)+0 => 3814.69728
+MF(15258.78906)(24998.04695); % 2^29*p+q=2q*(163852801)-5 => 2500.19531
+MF(15258.78906)(20546.77141); % 2^29*p+q=2q*(199350055)+1 => 3041.84044
+MF(15258.78906)(30447.06313); % 2^29*p+q=2q*(134528575)+2^14-5 => 2052.74315
+MS(15258.78908)(2.00000); % 2^17*p+q=2q*(5*10^8+1)+0 => 7629.39455
+MS(15258.78906)(166.56779); % 2^17*p+q=2q*(6003562)-1 => 91.60707
+MS(15258.78906)(394.96335); % 2^17*p+q=2q*(2531881)+2 => 38.63344
+MS(15258.78906)(42.34901); % 2^17*p+q=2q*(23613301)-2^14-1 => 360.31036
+show oct "77777", hex "400a";
+endgroup;
+
+showstats;
+path triang, circ;
+triang = (-3,-2)--(7,-2)--(0,7)--cycle;
+circ = makepath(pencircle shifted (0,.5) scaled 10);
+showstats;
+
+picture pic, pic[];
+showstats;
+begingroup
+save sh, dr;
+vardef sh expr p =
+ show p, stroked p, filled p, textual p, clipped p, bounded p, length p;
+ showstats;
+enddef;
+vardef dr text t =
+ pp3:=nullpicture;
+ addto pp3 t;
+ sh pp3;
+enddef;
+save pp; picture pp[];
+showstats;
+pic = pp2 = nullpicture;
+sh pic;
+clip pic to makepath(pencircle scaled 100);
+sh pic; % clipped
+setbounds pp2 to triang;
+sh pp2; % bounded()
+dr doublepath (1,1)--(3,2) withpen pencircle; % stroked
+addto pic also pp3;
+sh pic; % clipped(), stroked
+show ulcorner pic, lrcorner pic;
+setbounds pic to triang rotated 90;
+sh pic; show llcorner pic, urcorner pic;
+sh pic; % bounded(clipped(), stroked)
+dr contour triang scaled 12 withcolor (.4,.4,.4); % filled
+addto pic also pp3;
+sh pic; % bounded(clipped(), stroked), filled
+dr also "A56" infont "trapf"; % text
+addto pic also pp3 rotated 30 shifted (2,3);
+sh pic; % bounded(clipped(), stroked), filled, textual
+dr doublepath (4,5)--(8,1) withpen pencircle xscaled 0;
+addto pic also pp3;
+sh pic; % bounded(clipped(), stroked), filled, textual, stroked
+sh "non-picture";
+endgroup;
+
+showstats;
+for p within pic: show p; endfor
+
+showstats;
+pic1 := pic;
+clip pic1 to circ;
+show length pic1;
+showstats;
+addto pic1 also pic dashed nullpicture;
+show pic1, length pic1;
+showstats;
+for p within pic1:
+ show stroked p, filled p, textual p, clipped p, bounded p;
+ show pathpart p, penpart p, dashpart p, fontpart p, textpart p;
+ show (redpart p, greenpart p, bluepart p);
+ show (xpart p, ypart p), (xxpart p, yxpart p), (xypart p, yypart p);
+ showstats;
+endfor
+pic1 := nullpicture;
+
+for p within nullpicture: show p; endfor
+for p within "B34" infont "trapf": show p; endfor
+showstats;
+
+shipout pic;
+charcode:=1;
+prologues:=1;
+shipout pic rotated 90;
+
+
+string s,EOF;
+EOF=char 0;
+numeric n;
+n = 0;
+showstats;
+forever: n:=n+1;
+ s:= readfrom "mtrap.0";
+ exitif (s=EOF) or (n>300);
+ if substring (0,14) of s<>"%%CreationDate": show s; fi
+endfor
+
+numeric n;
+n = 0;
+showstats;
+forever: n:=n+1;
+ s := readfrom "mtrap.1";
+ if n<=2: show s; fi
+ exitif (s=EOF) or (n>300);
+endfor
+show n;
+
+showstats;
+show readfrom "mtrap.17";
+for n=1 step 1 until 3:
+ s := readfrom "mtrap.0"; show s;
+endfor
+
+showstats;
+for i=1 step 1 until 10:
+ write decimal i & " " & decimal(i*i) to "writeo";
+ write substring(0,i) of " " & "*" to "writeo.2";
+endfor
+showstats;
+
+write EOF to "writeo";
+s:=readfrom "mtrap.0"; % Ignore creation date
+for i=1 step 1 until 3:
+ show readfrom "writeo", readfrom "mtrap.0";
+endfor
+showstats;
+
+write "Clobbered." to "writeo";
+
+tracingstats:=1;
+begingroup % Force string pool compaction
+save s; string s[];
+s0="a"; s1="b"; s2="c"; s3="d";
+randomseed:=4.34294;
+for i=1 step 1 until 200:
+ s[floor uniformdeviate 4] := substring (0,60) of
+ (s[floor uniformdeviate 4] & s[floor uniformdeviate 4]);
+endfor
+show s1;
+endgroup;
+showstats;
+
+
+begingroup
+numeric n;
+interim warningcheck:=1;
+n = 12000; show n;
+interim warningcheck:=0;
+n:= 40000; show n;
+endgroup;
+
+showstats;
+for x within triangle: show x; endfor
+showstats;
+write triang to "writeo";
+write "triangle" "writeo";
+write "triangle" to triang;
+showstats;
+
+closefrom "mtrap.0";
+string s; s=readfrom "mtrap.0";
+show readfrom "mtrap.0"; % should be 2nd line, not 5th line
+
+end
diff --git a/Build/source/texk/web2c/triptrap/texmf.cnf b/Build/source/texk/web2c/triptrap/texmf.cnf
new file mode 100644
index 00000000000..5682426c764
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/texmf.cnf
@@ -0,0 +1,91 @@
+% triptrap/texmf.cnf -- configuration for the trip and trap tests.
+
+% These values apply to all the programs, and they are necessary for any
+% kind of reasonable diff.
+error_line = 64
+half_error_line = 32
+max_print_line = 72
+
+% TeX, Metafont, and MetaPost.
+mem_bot.tex = 1
+main_memory.tex = 3000
+main_memory.mf = 3001
+main_memory.mpost = 4501
+
+% In case you happen to run an ini* link by hand.
+mem_bot.initex = 1
+main_memory.initex = 3000
+main_memory.inimf = 3001
+main_memory.inimpost = 4501
+
+% Actually, Metafont currently ignores the settings for max_strings,
+% string_vacancies and pool_size specified here, but it doesn't hurt
+% to supply the correct values, just in case this changes one day.
+
+max_strings.tex = 3000
+max_strings.mf = 2000
+max_strings.mpost = 2500
+
+% In case you happen to run an ini* link by hand.
+max_strings.initex = 3000
+max_strings.inimf = 2000
+max_strings.inimpost = 2500
+
+string_vacancies = 8000
+pool_size = 40000
+
+% TeX only.
+font_mem_size = 20000
+font_max = 75
+stack_size = 200
+nest_size = 40
+buf_size = 500
+save_size = 600
+dvi_buf_size = 800
+% Although hyph_size is settable, it can't be <hyph_prime, which is 607,
+% and the original trip setting is 307, so no point in changing the default.
+
+% Metafont only.
+gf_buf_size = 8 % trapman.tex says to use this.
+MFTERM = trap % get the right screen output
+% trapman.tex says these values will help reduce the diffs, but it
+% actually only gives us one extra hunk (a BLANKRECTANGLE), so they
+% don't seem worth dynamicizing.
+%screen_width = 100
+%screen_depth = 200
+
+% MetaPost only. Turn off callmakempx, i.e., makempx,
+% since we can only test tex and dvitomp, and we'll test those in other
+% places anyway. (mpto fails because of the unending string constant
+% check in trap.mp.)
+MPXCOMMAND = 0
+
+% Avoid running any MakeTeX* program.
+MAKETEXTFM = 0
+MAKETEXTEX = 0
+MAKETEXMF = 0
+
+% Avoid reading any texfonts.map:
+TEXFONTMAPS = triptrap
+
+% Search paths.
+% trip.tex:
+TEXINPUTS = .
+% trap.mf:
+MFINPUTS = .
+% trap.mp, mtrap.mp:
+MPINPUTS = .
+% trip.tfm, trap.tfm, trapf.tfm:
+TFMFONTS = .
+% trip.fmt:
+TEXFORMATS = .
+% trap.base:
+MFBASES = .
+% trap.mem:
+MPMEMS = .
+% tex.pool:
+TEXPOOL = .
+% mf.pool:
+MFPOOL = .
+% mp.pool:
+MPPOOL = .
diff --git a/Build/source/texk/web2c/triptrap/trap.148 b/Build/source/texk/web2c/triptrap/trap.148
new file mode 100644
index 00000000000..50091a53692
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.148
@@ -0,0 +1,25 @@
+%!PS
+%%BoundingBox: -5 -5 13 5
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%%EndProlog
+%%Page: 1 1
+ 0 1 dtransform truncate idtransform setlinewidth pop [] 0 setdash
+ 1 setlinejoin 1 setmiterlimit
+gsave 2 0 translate newpath 5 0 moveto
+5 1.32608 4.47322 2.59785 3.53554 3.53554 curveto
+2.59785 4.47322 1.32608 5 0 5 curveto
+-1.32608 5 -2.59785 4.47322 -3.53554 3.53554 curveto
+-4.47322 2.59785 -5 1.32608 -5 0 curveto
+-5 -1.32608 -4.47322 -2.59785 -3.53554 -3.53554 curveto
+-2.59785 -4.47322 -1.32608 -5 0 -5 curveto
+1.32608 -5 2.59785 -4.47322 3.53554 -3.53554 curveto
+4.47322 -2.59785 5 -1.32608 5 0 curveto closepath
+gsave fill grestore stroke grestore
+ 0 3 dtransform truncate idtransform setlinewidth pop 1 setlinecap
+gsave newpath 0 0 moveto
+12 0 lineto
+0.33333 1 scale stroke grestore
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/trap.149 b/Build/source/texk/web2c/triptrap/trap.149
new file mode 100644
index 00000000000..10665caedd8
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.149
@@ -0,0 +1,85 @@
+%!PS
+%%BoundingBox: -28 -28 52 37
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%%EndProlog
+%%Page: 1 1
+gsave newpath 0 0 moveto
+48.28426 -48.28429 48.28426 78.28429 0 30 curveto
+-8.28427 21.71573 -8.28427 8.28427 0 0 curveto closepath clip
+grestore
+ 0 setgray
+newpath 22.5 -0.5 moveto
+24 -2 lineto
+25 -2.5 lineto
+26 -2 lineto
+27 -1 lineto
+27.5 0.5 lineto
+27.5 7.13042 24.86609 13.48926 20.17767 18.17767 curveto
+18.67767 19.67767 lineto
+16.7597 21.59564 14.56218 23.16978 12.18088 24.36044 curveto
+11.18088 24.86044 lineto
+7.74117 26.58029 3.918 27.5 0 27.5 curveto
+-3.918 27.5 -7.74117 26.58029 -11.18088 24.86044 curveto
+-12.18088 24.36044 lineto
+-14.56218 23.16978 -16.7597 21.59564 -18.67767 19.67767 curveto
+-19.67767 18.67767 lineto
+-22.44812 15.90723 -24.50117 12.55353 -25.71729 8.90517 curveto
+-26.21729 7.40517 lineto
+-27.0592 4.87941 -27.5 2.21243 -27.5 -0.5 curveto
+-27.5 -7.13042 -24.86609 -13.48926 -20.17767 -18.17767 curveto
+-18.67767 -19.67767 lineto
+-16.7597 -21.59564 -14.56218 -23.16978 -12.18088 -24.36044 curveto
+-11.18088 -24.86044 lineto
+-7.74117 -26.58029 -3.918 -27.5 0 -27.5 curveto
+3.918 -27.5 7.74117 -26.58029 11.18088 -24.86044 curveto
+12.18088 -24.36044 lineto
+14.56218 -23.16978 16.7597 -21.59564 18.67767 -19.67767 curveto
+19.67767 -18.67767 lineto
+22.44812 -15.90723 24.50117 -12.55353 25.71729 -8.90517 curveto
+26.21729 -7.40517 lineto
+27.0592 -4.87941 27.5 -2.21243 27.5 0.5 curveto
+26 2 lineto
+25 2.5 lineto
+24 2 lineto
+23 1 lineto
+22.5 -0.5 lineto
+22.5 -3.21243 22.0592 -5.87941 21.21729 -8.40517 curveto
+21.71729 -6.90517 lineto
+20.50117 -10.55353 18.44812 -13.90723 15.67767 -16.67767 curveto
+16.67767 -15.67767 lineto
+14.7597 -17.59564 12.56218 -19.16978 10.18088 -20.36044 curveto
+11.18088 -19.86044 lineto
+7.74117 -21.58029 3.918 -22.5 0 -22.5 curveto
+-3.918 -22.5 -7.74117 -21.58029 -11.18088 -19.86044 curveto
+-10.18088 -20.36044 lineto
+-12.56218 -19.16978 -14.7597 -17.59564 -16.67767 -15.67767 curveto
+-15.17767 -17.17767 lineto
+-19.86609 -12.48926 -22.5 -6.13042 -22.5 0.5 curveto
+-22.5 3.21243 -22.0592 5.87941 -21.21729 8.40517 curveto
+-21.71729 6.90517 lineto
+-20.50117 10.55353 -18.44812 13.90723 -15.67767 16.67767 curveto
+-16.67767 15.67767 lineto
+-14.7597 17.59564 -12.56218 19.16978 -10.18088 20.36044 curveto
+-11.18088 19.86044 lineto
+-7.74117 21.58029 -3.918 22.5 0 22.5 curveto
+3.918 22.5 7.74117 21.58029 11.18088 19.86044 curveto
+10.18088 20.36044 lineto
+12.56218 19.16978 14.7597 17.59564 16.67767 15.67767 curveto
+15.17767 17.17767 lineto
+19.86609 12.48926 22.5 6.13042 22.5 -0.5 curveto closepath fill
+ 2 0 dtransform exch truncate exch idtransform pop setlinewidth
+ [2.82843 1.41422 ] 1.41422 setdash 1 setlinecap 1 setlinejoin
+ 1 setmiterlimit
+gsave newpath 0 0 moveto
+-48.28429 48.28426 78.28429 48.28426 30 0 curveto
+1 0.5 scale stroke grestore
+ 0 1 dtransform truncate idtransform setlinewidth pop
+ [2 1 ] 1 setdash
+newpath 0 0 moveto
+-48.28429 48.28426 78.28429 48.28426 30 0 curveto stroke
+newpath 10 0 moveto
+-38.28429 48.28426 88.28429 48.28426 40 0 curveto stroke
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/trap.150 b/Build/source/texk/web2c/triptrap/trap.150
new file mode 100644
index 00000000000..14487408340
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.150
@@ -0,0 +1,43 @@
+%!PS-Adobe-3.0 EPSF-3.0
+%%BoundingBox: -5 -5 33 25
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%%EndProlog
+%%Page: 1 1
+newpath 7.5 4.5 moveto
+7.5 4.5 lineto
+ closepath fill
+newpath 7.5 4.5 moveto
+7.5 4.5 lineto
+ closepath fill
+newpath 2.5 9.5 moveto
+2.5 7 lineto
+7.5 8 lineto
+7.5 10.5 lineto
+7.5 15.5 lineto
+7.5 18 lineto
+2.5 17 lineto
+2.5 14.5 lineto
+ closepath fill
+newpath 0 5 moveto
+0 5 lineto
+0 -5 lineto
+0 -5 lineto
+10 5 10 5 10 5 curveto
+15 10 lineto
+10 15 lineto
+0 25 lineto
+0 15 lineto
+30 5 lineto
+30 5 lineto
+30 15 lineto
+30 15 lineto
+0 25 lineto
+-15 30 lineto
+0 15 lineto
+10 5 lineto
+10 15 lineto
+10 15 10 15 0 5 curveto closepath fill
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/trap.151 b/Build/source/texk/web2c/triptrap/trap.151
new file mode 100644
index 00000000000..2fa5a522e98
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.151
@@ -0,0 +1,219 @@
+%!PS-Adobe-3.0 EPSF-3.0
+%%BoundingBox: -4096 -102 4096 261
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%%EndProlog
+%%Page: 1 1
+bye
+ 0 0 dtransform truncate idtransform setlinewidth pop
+ [3 0 ] 0 setdash 0 setlinecap 0 setlinejoin 1 setmiterlimit
+newpath 0.5 0 moveto
+3.5 1.5 lineto stroke
+ [] 0 setdash
+newpath 0 0 moveto
+0.3153 0.20053 0.6504 0.36807 1 0.5 curveto
+2.29114 0.98723 3.72412 0.97192 5 1.5 curveto
+5.68967 1.78545 6.30771 2.22081 7 2.5 curveto
+8.58867 3.1407 10.3946 2.90645 12 3.5 curveto
+12.3506 3.62962 12.68594 3.7973 13 4 curveto stroke
+newpath -1 -2 moveto
+-0.95676 -2.04068 -0.91165 -2.07198 -0.86496 -2.09532 curveto
+0.13504 -2.59532 lineto
+0.64822 -2.8519 1.35178 -2.14809 1.86496 -2.40468 curveto
+0.86496 -1.90468 lineto
+0.91165 -1.92802 0.95676 -1.95932 1 -2 curveto
+1.02066 -2.02003 lineto
+-0.47934 -0.52003 lineto
+-0.2602 -0.73918 -0.22404 -0.99583 -0.2977 -1.21681 curveto
+0.2023 0.28319 lineto
+0.16501 0.17131 0.09958 0.06859 0.01549 -0.0155 curveto
+1.01549 0.9845 lineto
+0.95589 0.9249 0.88692 0.87466 0.81195 0.83719 curveto
+1.81195 1.33719 lineto
+1.63397 1.2482 1.42226 1.23111 1.22209 1.33119 curveto
+2.22209 0.83119 lineto
+2.15273 0.86588 2.08475 0.91461 2.02003 0.97932 curveto
+3.52003 -0.52068 lineto
+3.5 -0.5 lineto
+3.28389 -0.27028 3.33284 0.012 3.43013 0.30383 curveto
+2.93013 -1.19617 lineto
+2.97351 -1.06602 3.0265 -0.93398 3.06989 -0.80383 curveto
+3.56989 0.69617 lineto
+3.66716 0.988 3.71611 1.27028 3.5 1.5 curveto
+3.47997 1.52066 lineto
+1.97997 3.02066 lineto
+1.91525 3.08537 1.84727 3.13412 1.77791 3.16881 curveto
+0.77791 3.66881 lineto
+0.57773 3.76889 0.36601 3.7518 0.18803 3.66281 curveto
+-0.81197 3.16281 lineto
+-0.88693 3.12534 -0.9559 3.0751 -1.0155 3.0155 curveto
+-2.0155 2.0155 lineto
+-2.09958 1.93141 -2.16502 1.82869 -2.20232 1.71681 curveto
+-2.70232 0.21681 lineto
+-2.77597 -0.00417 -2.7398 -0.2608 -2.52066 -0.47997 curveto
+-1.02066 -1.97997 lineto
+ closepath fill
+newpath 1 2 moveto
+0.97934 2.02003 lineto
+2.47934 0.52003 lineto
+2.2602 0.73918 2.22404 0.99583 2.2977 1.21681 curveto
+1.7977 -0.28319 lineto
+1.83499 -0.17131 1.90042 -0.06859 1.98451 0.0155 curveto
+0.98451 -0.9845 lineto
+1.04411 -0.9249 1.11308 -0.87466 1.18805 -0.83719 curveto
+0.18805 -1.33719 lineto
+0.36603 -1.2482 0.57774 -1.23111 0.77791 -1.33119 curveto
+-0.22209 -0.83119 lineto
+-0.15273 -0.86588 -0.08475 -0.91461 -0.02003 -0.97932 curveto
+-1.52003 0.52068 lineto
+-1.5 0.5 lineto
+-1.28389 0.27028 -1.33284 -0.012 -1.43013 -0.30383 curveto
+-0.93013 1.19617 lineto
+-0.97351 1.06602 -1.0265 0.93398 -1.06989 0.80383 curveto
+-1.56989 -0.69617 lineto
+-1.66716 -0.988 -1.71611 -1.27028 -1.5 -1.5 curveto
+-1.47997 -1.52066 lineto
+0.02003 -3.02066 lineto
+0.08475 -3.08537 0.15273 -3.13412 0.22209 -3.16881 curveto
+1.22209 -3.66881 lineto
+1.42227 -3.76889 1.63399 -3.7518 1.81197 -3.66281 curveto
+2.81197 -3.16281 lineto
+2.88693 -3.12534 2.9559 -3.0751 3.0155 -3.0155 curveto
+4.0155 -2.0155 lineto
+4.09958 -1.93141 4.16502 -1.82869 4.20232 -1.71681 curveto
+4.70232 -0.21681 lineto
+4.77597 0.00417 4.7398 0.2608 4.52066 0.47997 curveto
+3.02066 1.97997 lineto
+3 2 lineto
+2.95676 2.04068 2.91165 2.07198 2.86496 2.09532 curveto
+1.86496 2.59532 lineto
+1.35178 2.8519 0.64822 2.14809 0.13504 2.40468 curveto
+1.13504 1.90468 lineto
+1.08835 1.92802 1.04324 1.95932 1 2 curveto closepath fill
+newpath -1 2 moveto
+1 -2 lineto
+1.17854 -1.82146 1.38548 -1.68822 1.60698 -1.57747 curveto
+0.60698 -2.07747 lineto
+1.04999 -1.85596 1.55122 -1.72438 1.99995 -1.5 curveto
+2.99995 -1 lineto
+3 -1 lineto
+1 3 lineto
+0.99995 3 lineto
+1.99995 3.5 lineto
+1.55122 3.27562 1.05 3.14404 0.607 2.92253 curveto
+-0.393 2.42253 lineto
+-0.6145 2.31178 -0.82144 2.17856 -1 2 curveto closepath fill
+newpath -0.5 -0.5 moveto
+0.05229 -0.5 -0.05229 0.5 0.5 0.5 curveto stroke
+ 0 1 dtransform truncate idtransform setlinewidth pop
+newpath -4094.99998 0 moveto
+4094.99998 -0.00002 lineto stroke
+ 0 0 dtransform truncate idtransform setlinewidth pop
+ [3 0 ] 0 setdash
+newpath 0.5 257 moveto
+3.5 258.5 lineto stroke
+ [] 0 setdash
+newpath 0 257 moveto
+0.3153 257.20053 0.6504 257.36807 1 257.5 curveto
+2.29114 257.98723 3.72412 257.97192 5 258.5 curveto
+5.68967 258.78545 6.30771 259.22081 7 259.5 curveto
+8.58867 260.1407 10.3946 259.90645 12 260.5 curveto
+12.3506 260.62962 12.68594 260.7973 13 261 curveto stroke
+newpath -1 255 moveto
+-0.95676 254.95932 -0.91165 254.92802 -0.86496 254.90468 curveto
+0.13504 254.40468 lineto
+0.64822 254.1481 1.35178 254.85191 1.86496 254.59532 curveto
+0.86496 255.09532 lineto
+0.91165 255.07198 0.95676 255.04068 1 255 curveto
+1.02066 254.97997 lineto
+-0.47934 256.47997 lineto
+-0.2602 256.26082 -0.22404 256.00417 -0.2977 255.78319 curveto
+0.2023 257.28319 lineto
+0.16501 257.17131 0.09958 257.06859 0.01549 256.9845 curveto
+1.01549 257.9845 lineto
+0.95589 257.9249 0.88692 257.87466 0.81195 257.83719 curveto
+1.81195 258.33719 lineto
+1.63397 258.2482 1.42226 258.23111 1.22209 258.33119 curveto
+2.22209 257.83119 lineto
+2.15273 257.86588 2.08475 257.91461 2.02003 257.97932 curveto
+3.52003 256.47932 lineto
+3.5 256.5 lineto
+3.28389 256.72972 3.33284 257.012 3.43013 257.30383 curveto
+2.93013 255.80383 lineto
+2.97351 255.93398 3.0265 256.06602 3.06989 256.19617 curveto
+3.56989 257.69617 lineto
+3.66716 257.988 3.71611 258.27028 3.5 258.5 curveto
+3.47997 258.52066 lineto
+1.97997 260.02066 lineto
+1.91525 260.08537 1.84727 260.13412 1.77791 260.16881 curveto
+0.77791 260.66881 lineto
+0.57773 260.76889 0.36601 260.7518 0.18803 260.66281 curveto
+-0.81197 260.16281 lineto
+-0.88693 260.12534 -0.9559 260.0751 -1.0155 260.0155 curveto
+-2.0155 259.0155 lineto
+-2.09958 258.93141 -2.16502 258.82869 -2.20232 258.71681 curveto
+-2.70232 257.21681 lineto
+-2.77597 256.99583 -2.7398 256.7392 -2.52066 256.52003 curveto
+-1.02066 255.02003 lineto
+ closepath fill
+newpath 1 259 moveto
+0.97934 259.02003 lineto
+2.47934 257.52003 lineto
+2.2602 257.73918 2.22404 257.99583 2.2977 258.21681 curveto
+1.7977 256.71681 lineto
+1.83499 256.82869 1.90042 256.93141 1.98451 257.0155 curveto
+0.98451 256.0155 lineto
+1.04411 256.0751 1.11308 256.12534 1.18805 256.16281 curveto
+0.18805 255.66281 lineto
+0.36603 255.7518 0.57774 255.76889 0.77791 255.66881 curveto
+-0.22209 256.16881 lineto
+-0.15273 256.13412 -0.08475 256.08539 -0.02003 256.02068 curveto
+-1.52003 257.52068 lineto
+-1.5 257.5 lineto
+-1.28389 257.27028 -1.33284 256.988 -1.43013 256.69617 curveto
+-0.93013 258.19617 lineto
+-0.97351 258.06602 -1.0265 257.93398 -1.06989 257.80383 curveto
+-1.56989 256.30383 lineto
+-1.66716 256.012 -1.71611 255.72972 -1.5 255.5 curveto
+-1.47997 255.47934 lineto
+0.02003 253.97934 lineto
+0.08475 253.91463 0.15273 253.86588 0.22209 253.83119 curveto
+1.22209 253.33119 lineto
+1.42227 253.23111 1.63399 253.2482 1.81197 253.33719 curveto
+2.81197 253.83719 lineto
+2.88693 253.87466 2.9559 253.9249 3.0155 253.9845 curveto
+4.0155 254.9845 lineto
+4.09958 255.06859 4.16502 255.17131 4.20232 255.28319 curveto
+4.70232 256.78319 lineto
+4.77597 257.00417 4.7398 257.2608 4.52066 257.47997 curveto
+3.02066 258.97997 lineto
+3 259 lineto
+2.95676 259.04068 2.91165 259.07198 2.86496 259.09532 curveto
+1.86496 259.59532 lineto
+1.35178 259.8519 0.64822 259.14809 0.13504 259.40468 curveto
+1.13504 258.90468 lineto
+1.08835 258.92802 1.04324 258.95932 1 259 curveto closepath fill
+newpath -1 259 moveto
+1 255 lineto
+1.17854 255.17854 1.38548 255.31178 1.60698 255.42253 curveto
+0.60698 254.92253 lineto
+1.04999 255.14404 1.55122 255.27562 1.99995 255.5 curveto
+2.99995 256 lineto
+3 256 lineto
+1 260 lineto
+0.99995 260 lineto
+1.99995 260.5 lineto
+1.55122 260.27562 1.05 260.14404 0.607 259.92253 curveto
+-0.393 259.42253 lineto
+-0.6145 259.31178 -0.82144 259.17856 -1 259 curveto closepath fill
+newpath -0.5 256.5 moveto
+0.05229 256.5 -0.05229 257.5 0.5 257.5 curveto stroke
+ 0 1 dtransform truncate idtransform setlinewidth pop
+newpath -4094.99998 257 moveto
+4094.99998 256.99998 lineto stroke
+newpath 0 -100 moveto
+-36.92659 -103.51175 136.98943 -101.7726 100 -99 curveto
+99.9889 -98.99916 0.01108 -99.99895 0 -100 curveto closepath fill
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/trap.197 b/Build/source/texk/web2c/triptrap/trap.197
new file mode 100644
index 00000000000..438b63467fb
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.197
@@ -0,0 +1,14 @@
+%!PS-Adobe-3.0 EPSF-3.0
+%%BoundingBox: -2 -4 8 4
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%%DocumentFonts: trapf
+ /trapf /trapf def
+/fshow {exch findfont exch scalefont setfont show}bind def
+%%EndProlog
+%%Page: 1 1
+gsave [0 -0.9428 0.9428 0.4714 0 0 ] concat 0 0 moveto
+(curb) trapf 10.56706 fshow grestore
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/trap.200 b/Build/source/texk/web2c/triptrap/trap.200
new file mode 100644
index 00000000000..e8143846e83
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.200
@@ -0,0 +1,58 @@
+%!PS
+%%BoundingBox: -7 -6 37 38
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%*Font: trapf 9.96265 9.96265 41:800000008000b8
+%*Font: trapf 19.9253 9.96265 42:800000010000c
+%%EndProlog
+%%Page: 1 1
+newpath 1 13 moveto
+5 11 lineto
+5.75 11.75 6.125 12.3125 6.3125 12.6875 curveto
+6.375 12.8125 6.41667 12.91667 6.44444 13 curveto
+6.94444 14.5 lineto
+7 14.66667 7 14.75 7 14.75 curveto
+2 13.75 lineto
+2 13.75 2 13 3.5 11.5 curveto
+8.5 12.5 lineto
+7 14 7 14.75 7 14.75 curveto
+2 13.75 lineto
+2 13.75 2 13.66667 1.94444 13.5 curveto
+2.44444 15 lineto
+2.41667 14.91667 2.375 14.8125 2.3125 14.6875 curveto
+2.125 14.3125 1.75 13.75 1 13 curveto closepath fill
+gsave newpath 0 0 moveto
+48.28426 -48.28429 48.28426 78.28429 0 30 curveto
+-8.28427 21.71573 -8.28427 8.28427 0 0 curveto closepath clip
+ 0.5 setgray 0 1.58115 dtransform truncate idtransform setlinewidth pop
+ [2.23608 1.11804 ] 1.11804 setdash 0 setlinecap 0 setlinejoin
+ 1 setmiterlimit
+gsave newpath 0 0 moveto
+30 0 lineto
+[0.89442 0.89442 -0.4472 0.4472 0 0] concat stroke grestore
+ 2 setlinecap 1 setlinejoin
+gsave newpath 0 0 moveto
+-48.28429 48.28426 78.28429 48.28426 30 0 curveto
+[0.89442 0.89442 -0.4472 0.4472 0 0] concat stroke grestore
+grestore
+ 0.5 setgray
+0 -2 moveto
+(Aqua) trapf 9.96265 fshow
+ 1.58115 0 dtransform exch truncate exch idtransform pop setlinewidth
+ [2.23608 1.11804 ] 1.11804 setdash 0 setlinecap 1 setlinejoin
+ 1 setmiterlimit
+gsave newpath 8.1693 -5.9851 moveto
+8.1693 13.9402 lineto
+[0.89442 0.89442 -0.4472 0.4472 0 0] concat stroke grestore
+8.3686 -2 moveto
+(Brass) trapf 19.9253 fshow
+ 0 1.58115 dtransform truncate idtransform setlinewidth pop 2 setlinecap
+gsave newpath 1 0 moveto
+2 1 lineto
+[0.89442 0.89442 -0.4472 0.4472 0 0] concat stroke grestore
+ 0 setgray
+0 10 moveto
+(ast) trapf 9.96265 fshow
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/trap.5 b/Build/source/texk/web2c/triptrap/trap.5
new file mode 100644
index 00000000000..749eaf76c69
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.5
@@ -0,0 +1,21 @@
+%!PS
+%%BoundingBox: -151 -2 169 21
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%%EndProlog
+%%Page: 1 1
+ 0 0 dtransform truncate idtransform setlinewidth pop [] 0 setdash
+ 0 setlinecap 0 setlinejoin 1 setmiterlimit
+newpath -1 -1 moveto
+-0.25 -0.25 0.125 0.3125 0.3125 0.6875 curveto
+0.875 1.8125 -0.25 1.25 2 -1 curveto stroke
+newpath -3 -2 moveto
+-2.25 -1.25 -1.875 -0.6875 -1.6875 -0.3125 curveto
+-1.125 0.8125 -2.25 0.25 0 -2 curveto stroke
+ 0.4 1 0 setrgbcolor
+newpath -150.99219 13.99976 moveto
+-150.99219 13.99976 lineto
+ closepath fill
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/trap.6 b/Build/source/texk/web2c/triptrap/trap.6
new file mode 100644
index 00000000000..569f2d0936d
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.6
@@ -0,0 +1,14 @@
+%!PS
+%%BoundingBox: 3 0 6 3
+%%Creator: MetaPost
+%%CreationDate: 1998.01.28:1118
+%%Pages: 1
+%%EndProlog
+%%Page: 1 1
+ 0 0 dtransform truncate idtransform setlinewidth pop [] 0 setdash
+ 0 setlinecap 0 setlinejoin 1 setmiterlimit
+newpath 3 0 moveto
+3.75 0.75 4.125 1.3125 4.3125 1.6875 curveto
+4.875 2.8125 3.75 2.25 6 0 curveto stroke
+showpage
+%%EOF
diff --git a/Build/source/texk/web2c/triptrap/trap.mf b/Build/source/texk/web2c/triptrap/trap.mf
new file mode 100644
index 00000000000..adf4d7bd48b
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.mf
@@ -0,0 +1,170 @@
+% This is a diabolical test file for MF84. Don't get stuck.
+if not known inimf: .inimf.=.0. % next lines are skipped if format loaded
+ inimf; nonstopmode; tracingtitles:=day; showstopping:=year; hppp:=1000;
+ << == >> ::: || `` '' -- !! ?? ## && @@ $$ [[ ]] {{ }} . (( 5.5.5 )) ++ "..";
+ begingroup save =; let=,; save,; newinternal $=,; let ):=, endgroup;
+ let year=month; showvariable errorstopmode,readstring,2,"2",,,(,),<<,year;
+ tracingrestores:=tracingcommands:=.00000762939453125; % that's 2^(-17)
+ if tracingcommands>0:tracingcommands:=if not cycle "":1.1 forever;fi;
+ tracingcommands:=2.1 exitif tracingcommands>2 endfor; showtoken |=:|>;
+ tracingedges:=1/.00001; tracingequations:=$+1; p~=tracingedges+.00001;
+ interim tracingspecs:=tracingpens:=tracingchoices:=tracingstats:=
+ warningcheck:=tracingoutput:=tracingmacros:=1; $:=ASCII""; $:=x; p~:=p~;
+ delimiters (); delimiters begintext endtext; vardef foo(text t)=t enddef;
+ def lig(text t,|)=ligtable0::for *=1step1until60:0kern boundarychar+*,endfor
+ skipto0;ligtable t:t|0,skipto255;boundarychar:=boundarychar+51.29999enddef;
+ foo begintext interim proofing:=(-.5; shipout nullpicture; special"3" endtext;
+ for n=tracingpens step 1 until proofing:fi endfor showstats; let!!=skipto;
+ path p~; p~=(0,0)..controls (15,4) and (-15,-12)..(4,0); everyjob /*\;;
+ vardef /*\`'@#=message @ & str#@ &jobname&char ASCII'`&str@#!enddef;
+ let next=dump; vardef `'='` enddef; def '`="\*/" enddef;
+elseif known"": `'pass[2.]; outer\; let next=\; delimiters ^~7! fi
+next\; % the second pass will now compute silently; the first pass will halt
+batchmode; ^~7,endgroup pausing:=1; exitif p exitif boolean pen pencircle endfor
+scantokens begingroup message char0&"watch this"; "pair p[],';"&char-1endgroup
+path p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(turningnumber',2.5);
+numeric p[][]; p[[ [$] ]]=10000000000000000; "this string constant is incomplete
+string foo[]p,p~if true:[]; p~000=char34&char200&char34;
+boolean p[]~,boolean fi.boolean; showvariable boolean; def\\= =end enddef;
+picture e[]e[], e[], p~[]~[][]; show length scantokens p~0;
+pen p~[]~,q["a",qq; p~1~=q=pencircle scaled mexp(-3016.57654);
+transform p,pp0; if p=p:qq=makepen((1,0)..cycle) xscaled hex "1000";fi
+qq:=makepen((0,0)..(1,0)..(0,1)..(0,0)..(1,0)..(0,1)..cycle);
+vardef p[][]p~ begintext suffix a,b endtext())suffix@=show #@; p.a.b() enddef;
+expandafter let\endtext\\; outer endtext,\,;;qq:=pencircle scaled 4.5 yscaled 2;
+(6,12)-p7=(0,1)transformed p=(2/(x-x),3/0)transformed p;
+p1\2p=p007=begintext if string p~[$]: p.1.2-p.1.199999,1 endtext transformed p;
+showstopping:=0;showvariable p; p=p; let [[=begingroup; let ]]=endgroup;
+(xxpart p+.002,yxpart p)=1[p1,p2]=(5,y+.00001)=(5,y)=(yypart p,xypart p);
+reverse(p~..cycle) transformed p=p2. 3.p;
+p[000000000001]2p~(,[2]3p~,-)=p~1~2[pausing];
+vardef p~[]@# tertiary t:=if p@ @=@ @p fi; vardef p[][]p~[]=BAD; inner ;;
+show p~[-2]~[3000,x]++4000>path p3; showvariable p,P;
+numeric p[]~; p3~=2alpha; p[1/$]~=3beta;
+begingroup save p; showvariable p; 3beta=1]]; showvariable p;
+def//expr;=enddef;def!primary!false):!fi enddef;
+def _aa__ secondary _a_=if(true enddef; qq:=makepen(qw..(qw scaled$)..cycle);
+primarydef _**__=[[show _*__]] enddef;
+secondarydef _***__=expandafter __ scantokens"**oct"_ enddef;
+// //pencircle slanted length p~**makepen reverse subpath p7-p2 of
+ (p7{p2}..controls _aa__ not odd.1(15) and known p or !p2and-p2..{1,1}(-p2
+ {curl- +1)..tension atleast1..cycle sqrt2++sqrt2***[[]];
+[[interim proofing:=charcode:=-20.5;chardp:=-2048;shipout nullpicture]];
+if charexists -275.50002>known p0 0p=known p~: randomseed charcode; fi
+randomseed:="goof"; a[($,18++1+-+18),(2,3)]=b[(3,2),(1,$);
+show (^+1,~+2) slanted-1 yscaled-2 zscaled-(3,4), p transformed(pp xscaled 9),
+ pp shifted (1,2) transformed(p transformed p), -_[0][1,2]; show
+floor sind mlog sqrt mexp200cosd angle(normaldeviate,uniformdeviate-chardp);
+string s[]; s1=s2=s4; s3=s5; s1=s2; if s1<=s4<>(s1<>s3):show[[char34=s2:=s3]]fi;
+substring penoffset point.1of.p~of[[pencircle]]rotated1080/2/1/3of decimal
+ directiontime postcontrol-1.5of(p~&cycle)-precontrol1/2of p~(p~)=s1:=s4:=s4;
+path p~[]; p~1=p2{length" "}&cycle; p~1=p2=p~0; p2..controls-p2..cycle=p~2;(p7
+..tension1.2..p~[length p~2]..p~2&{0,1}p2..tension1and atleast1..cycle)..tension
+ x..{curl1}-p7{curl hex "IsBad"}..tension.75and.74999..p2{0,1}&p2{_,'}..cycle:=p
+ ~4; subpath(-9,9)of subpath(3.5001,7.00001)of p~4=p~6;
+show p~6, directiontime(1,2) of p~6, directiontime(1,-1.00001) of p~6;
+p~3=(0,0)..controls (1,1) and (0,1)..(1,0); show p2..p2{p7}&{$,$}cycle,
+ (directiontime(1,1) of subpath(.314159,1) of p~3)[.314159,1];
+p~5=(subpath(0,.25)of p~3&subpath(.25,1)of p~3)shifted begintext1,0;
+p~3:=2/3'zscaled'{p~3}..controls(2,2/3(3))and penoffset(1/2x,y)of(0,1)(1,0);
+show p~3 intersectiontimes reverse p~3, point.17227 of p~3, point1-.28339of p~3;
+show point xpart(p~5 intersectiontimes p~5 shifted (.01,0))of p~5-
+ point ypart(p~5 intersectiontimes p~5 shifted (.01,0))of p~5;
+[[interim tracingedges:=1; e[-1+-+ -1.00001]=nullpicture; addto e1 also[[
+addto e0 doublepath p~5 scaled 3 withpen q; e0=e1=e2; cull e1 dropping (0,.1);
+nullpicture]];show e1 shifted(4089,-4095), e2 shifted(-4095,4092)shifted (-3,0),
+e2 shifted(4089,-4095)]];addto e1 also e2 shifted(-2,$); e1:=e1 shifted(-4,$);
+addto e0 also e1rotated89.999+e1scaled$; show e0 xscaled-10 yscaled2 xscaled82
+yscaled683;addto e1 doublepath (0,9) withweight-3 withweight turningnumber p~6
+ withpen pencircle xscaled(oct"180"++1) rotated-angle(64,$) shifted (9,8)
+ withpen makepen(($,$)..(1,0)..(1,1)..($,0)..($,$)&cycle)xscaled4095.49999;
+show e1, totalweight e1; chardp:=charcode:=5; xoffset:=-1.5; shipout e1;
+showstats; addto e2doublepath p~ yscaled1/60; e3:=e2 yscaled 0;
+autorounding:=2; addto e3doublepath(.5,0)..(3.5,1.5)withweight2;
+tracingspecs:=0; q:=makepen((1,1)..cycle) yscaled 1.5;
+p~8=(($,yy)rotated p{0,1}..{0,$}(1,0){0,$}..cycle)scaled2shifted(1000.49,9);
+turningcheck:=1;addto e2doublepath p~8 withpen q withweight p withpen cycle p;
+[[interim autorounding:=xx=.1; addto e2 contour p~8 withpen q withweight2]];
+chardx:=chardp:=charext:=-14.5;shipout-(-e0-e2)+e2shifted(0,6turningnumber p~8);
+p~9=(0,0)..(1,.5)..(5,1.5)..(7,2.5)..(12,3.5)..(13,4);addto e3 doublepath p~9;
+smoothing:=1; addto e3 doublepath p~9; addto e3 doublepath (-4095,0)..tension
+3/4 and 999..(0,2); show e3 rotated-90, (e0+e0) rotated90$ rotated90;
+if "a" if "ab">"b" elseif path reverse (3,4): >="aa":foo elseif fi "bar"
+else if '-(1,yy)<': :fi else def dup text t=[[t;save enddef;def|suffix$=,$
+enddef; def||tertiary p=show substring p of("a" enddef;||(2,$)&"bc");
+tertiarydef x++y=[[dup showtoken x;]];def quote x expr z of y=z enddef;
+ texts(quote x=(y+0)y+y)("xx",foo(x))=0]] enddef; def texts(text t,tt)expr?=
+ for n:=,for n"yy":n,length if false:endfor tt,t,:if string n:forsuffixes n=
+ foo1,[foo(n)],':show t,tt|(n;exitif not('<='+(?,yy)) endfor for m= :+endfor
+ for m=alpha step-1.1 3$: +m endfor fi endfor enddef; show (0,0){curl2}..
+ subpath(23.3,4.5)of p~9{curl3}..($,$){curl4}..cycle;numspecial p~++2+3;[[
+let?=if;save if,\;def if=endinput?enddef;def texts=input enddef;texts trap ]];
+dup[[def texts secondary x=primarydef y++y=x@y enddef; showtoken++;x enddef]]\;
+proofing:=1;texts:="a"&"b";% strings "yy" and "ab" no longer appear in memory
+texts-1.00001a1=-(a2+a3+a4+a5+a6);-(a3,a2)/.99999=-(a4+a5+[[showdependencies;
+a6]],a3+a4+a5+a6)]]; 1.00001a4+1=a5+a6; alpha:=.9alpha+7; showdependencies;
+a5=a6=2/3-a6; cull e1 dropping($,4a5)withweight1.5; charcode:=chardp:=27;
+openwindow 3 from (0,0) to (0,0) at "whoops"; addto p; shipout p; cull p;
+openwindow -.5 from ($,$) to ($,$) at (0,0); special p; numspecial "p";
+openwindow 15.49999 from (0,32*1024) to (1,31*1057) at (0,0); shipout e1;
+openwindow 5 from (0,length((0,0){0,0})) to (4,2) at ($,1);
+openwindow 6 from (length($,0),1) to (3,10) at (-5,2);
+display nullpicture; display p inwindow 3; display p inwindow 6;
+display e1 inwindow 6; cull e0 dropping (0.1,4095.999999) withweight 3.5
+withweight-3.5; display e0 inwindow 5.5; addto e0 also p; addto e0 contour 0;
+display e0 inwindow 5.49999; addto e0 contour p~9;
+display e1 inwindow 3+3; display e0e0 inwindow[[vardef e[]e=enddef;6]];
+addto e0 also e1; display e0 inwindow 5; ligtable||:255|=:|>>0,skipto0;
+display e1 inwindow 15; display e1 inwindow 6;
+show [[interim tracingcommands:=0; lig("g")(=:|); lig("h":"i")(|=:);
+lig("j")(|=:>);lig("k")(=:|>); lig("l")(|=:|>)]];
+b1:=c.a[ [[let c=++;vardef b=enddef;1]] ]; ligtable"m":0=:0,skipto5;
+!!; errhelp 0; errmessage "Be like Jane";
+errhelp "He%%%lp%"; errmessage""; errhelp ""; errmessage "Another";
+headerbyte 0; headerbyte(48.5)substring(-9,9)of"long"; for\=0:\
+headerbyte 9:2a6,"q"; fontdimen 9:2a6,"q"; fontdimen 1:2048;
+fontmaking:=1; extensible 5 5,"c"255.5,"d"; charlist 0:5:"a":"d";
+ligtable255:255::"a"=:"b","d" kern -2048,"c":0:99.5:"e"|=:|"f",0kern';
+ligtable 5:0; def clear(text x)=interim x:=$ enddef; clear(hppp); vppp=0;
+[[clear(tracingmacros); clear(tracingcommands); clear(tracingoutput\;
+ clear(proofing);designsize:=.99999;charcode:=ASCII char-418.5;vppp:=designsize;
+ def dp expr d = charcode:=charcode+1; chardp:=d; shipout nullpicture enddef;
+ dp 13; dp 12; dp 0; dp 21; dp -2; dp 17; dp 11; dp 3; charic:=-1000; dp -1;
+ dp 25; dp 31; dp 19; dp 7; charwd:=256; chardy:=6; dp 23; dp 30]];
+def f(suffix@@)(expr a,b)(text t)=numeric w; show a; % wipes out the old w
+addto @@ contour (0,0)..(2,0)..(1,$)..(1,1)..cycle withpen qq; % strange path
+addto @@ doublepath (0,0){1,1}..{2,1}(2,1) withpen qq; % carefully chosen
+addto @@ doublepath(($,$){1,0}..(1,1){1,0})scaled.5 withpen nullpen;
+cull @@ keeping (4,4) withweight1.5; enddef; def g(suffix$)=show $ enddef;
+addto e0 contour (0,0){1,0}..{1,0}(1,0){0,$}..{0,1}cycle withpen qq;
+f(e[3,w); g(e3,transformed p,penoffset-(1,1.3)of(pencircle scaled20 yscaled-.5),
+ directiontime (0,1) of ((0,0)..controls(1,1)and($,1)..(3,0)),
+ point 3.14159 of p~9 intersectiontimes subpath (3.14159,4) of p~9,
+ (($,1.1)..(1,$)) intersectiontimes precontrol$ of (0,0);
+addto e3 doublepath(-4094.99998,0)..(4094.99998,-.00001) withpen penoffset 0 of
+pencircle; addto e3 also e3 shifted (0,257); ,"flushed with pride"; numeric xx;
+def f(expr x,y,z)=showdependencies;tracingcapsules:=1;showdependencies;show
+ 1/3(3,6)*((x+y)+(y-x)), (1,1)/sqrt2 zscaled (x+1,x+2) - (x+1,x+2) rotated 45,
+ (0,1) zscaled (1,y+2)-(1,y+2) rotated 90 enddef; f((xx+1)/.3,(yy-1)/.5,(xx,0));
+'=(1000o3-4000(o1-o2)+4000o2+9,-.01o3+3ooo+
+ [[oo=9/10(o2+o4+o5-20);o4=o5=8/9(o1+.5o2); o6=-.0001o2;showdependencies;
+ numeric o[];xpart(alfa,[[pair alfa;0]])]])=-2/3[[save p;(p$,1-p$)]];
+xoffset:=yoffset:=4000[[oo=.5ooo=2*-1/2(ooo+[[numeric ooo;1]]);oo]];
+for @=angle(sqrt$,mlog$):charext:=uniformdeviate$;charht:=2048;granularity:=-8;
+addto e3 contour (0,-100)..tension 500..(100,-99)..tension 3000..cycle;
+tracingoutput:=@; shipout e3; special "bye"; interim char 99 = "c"; true=false;
+[[clear(tracingcommands); charcode:=ASCII char 269-13; shipout+nullpicture;
+"careful" quote for for = @ step 200 until 2*2600: &" METAFONT" endfor;]];
+scrollmode; "hello again"&char31; save p; fillin:=-.043;
+def f expr x=let )=]; let [=(; show _ enddef; begingroup tracingspecs:=1;
+show nullpen, makepath.qq, makepath(q rotated1), makepath pencircle rotated $;
+addto e0 doublepath (0,2){0,$}..{0,$}(0,1)..{1,0}(3,0)..(4,0){1,0}..cycle
+ withpen makepen((0,0)..(5,2.9)..(4,3)..cycle); tracingonline:=1; f xx[1);
+showdependencies; qq:=q; showstats; bye endtext
+% things not tested:
+% interaction (error insertion/deletion, interrupts, \pausing, files not there)
+% date, time; initialization of random number generator without randomseed
+% system-dependent parsing of file names, areas, extensions
+% certain error messages, especially fatal ones
+% things that can't happen in INIMF
+% unusual cases of fixed-point arithmetic
diff --git a/Build/source/texk/web2c/triptrap/trap.mp b/Build/source/texk/web2c/triptrap/trap.mp
new file mode 100644
index 00000000000..92e1a55c05e
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.mp
@@ -0,0 +1,215 @@
+% This is a test file for MetaPost analogous to trap.mf
+if not known inimp: .inimp.=.0. % next lines are skipped if format loaded
+ inimp; nonstopmode; tracingtitles:=day; showstopping:=year;
+ << == >> ::: || `` '' -- !! ?? ## && @@ $$ [[ ]] {{ }} . (( 5.5.5 )) ++ "..";
+ begingroup save =; let=,; save,; newinternal $=,; let ):=, endgroup;
+ let year=month; showvariable errorstopmode,readstring,2,"2",,,(,),<<,year;
+ tracingrestores:=tracingcommands:=.00000762939453125; % that's 2^(-17)
+ if tracingcommands>0:tracingcommands:=if not cycle "":1.1 forever;fi;
+ tracingcommands:=2.1 exitif tracingcommands>2 endfor; showtoken |=:|>;
+ tracinglostchars:=1/.00001; tracingequations:=$+1; p~=tracinglostchars+.00001;
+ interim tracingspecs:=tracingchoices:=tracingstats:=
+ warningcheck:=tracingoutput:=tracingmacros:=1; $:=ASCII""; $:=x; p~:=p~;
+ delimiters (); delimiters begintext endtext; vardef foo(text t)=t enddef;
+ def lig(text t,|)=ligtable0::for *=1step1until60:0kern boundarychar+*,endfor
+ skipto0;ligtable t:t|0,skipto255;boundarychar:=boundarychar+51.29999enddef;
+ foo begintext interim tracinglostchars:=(.5;show urcorner("flubo"infont"trapf"
+ ),2+2endtext; for n=tracingspecs step 1 until $:fi endfor showstats;
+ let!!=skipto; path p~; p~=(0,0)..controls (15,4) and (-15,-12)..(4,0);
+ everyjob /*\;; vardef /*\`'@#=message @ & str#@ &jobname&char ASCII'`&str@#!
+ enddef;let next=endinput;vardef `'='` enddef;def '`="\*/"enddef;
+ begingroup errorstopmode; endgroup;
+elseif known"": `'pass[2.]; nonstopmode; outer\; let next=\; delimiters ^~7! fi
+next\; % the second pass will now compute silently; the first pass will halt
+batchmode; ^~7,endgroup pausing:=1; exitif p exitif boolean pen pencircle endfor
+scantokens begingroup message char0&"watch this"; "pair p[],';"&char-1endgroup
+path p[][]p,w,qw; qw=(1,-2)..(2,-1)..(2.5,0.5)..(1,2)..(turningnumber',2.5);
+numeric p[][]; p[[ [$] ]]=10000000000000000; "this string constant is incomplete
+string foo[]p,p~if true:[];
+boolean p[]~,boolean fi.boolean; showvariable boolean;
+inner \; def\\= =show enddef; outer \; picture e[]e[], e[], p~[]~[][];
+pen p~[]~,q["a",qq; p~1~=q=pencircle scaled mexp(-3016.57654);
+transform p,pp0; if p=p:qq=makepen((7,0)..cycle) xscaled hex "1000";show qq;fi
+qq:=makepen((4,1)..(1,2)..(5,3)..(3,2)..(1,1)..(0,1)..(1,0)..cycle);show qq;
+vardef p[][]p~ begintext suffix a,b endtext())suffix@=show #@; p.a.b() enddef;
+expandafter let\endtext\\; outer endtext,\,;;
+(6,12)-p7=(0,1)transformed p=(2/(x-x),3/0)transformed p;
+p1\2p=p007=begintext if string p~[$]: p.1.2-p.1.199999,1 endtext transformed p;
+showstopping:=0;showvariable p; p=p; let [[=begingroup; let ]]=endgroup;
+(xxpart p+.002,yxpart p)=1[p1,p2]=(5,y+.00001)=(5,y)=(yypart p,xypart p);
+reverse(p~..cycle) transformed p=p2. 3.p;
+p[000000000001]2p~(,[2]3p~,-)=p~1~2[pausing];
+vardef p~[]@# tertiary t:=if p@ @=@ @p fi; vardef p[][]p~[]=BAD; inner ;;
+show p~[-2]~[3000,x]++4000>path p3; showvariable p,P;
+numeric p[]~; p3~=2alpha; p[1/$]~=3beta;
+begingroup save p; showvariable p; 3beta=1]]; showvariable p;
+def//expr;=enddef;def!primary!false):!fi enddef;
+def _aa__ secondary _a_=if(true enddef; qq:=makepen(qw..(qw scaled$)..cycle);
+show qq; primarydef _**__=[[show _*__]] enddef;
+secondarydef _***__=expandafter __ scantokens"**oct"_ enddef;
+// //pencircle slanted length p~**makepen reverse subpath p7-p2 of
+ (p7{p2}..controls _aa__ not odd.1(15) and known p or !p2and-p2..{1,1}(-p2
+ {curl- +1)..tension atleast1..cycle sqrt2++sqrt2***[[]];
+charcode:=-20.5;chardp:=-2048;shipout nullpicture;
+if charexists -275.50002>known p0 0p=known p~: randomseed charcode; fi
+randomseed:="goof"; a[($,18++1+-+18),(2,3)]=b[(3,2),(1,$);
+show (^+1,~+2) slanted-1 yscaled-2 zscaled-(3,4), p transformed(pp xscaled 9),
+ pp shifted (1,2) transformed(p transformed p), -_[0][1,2]; show
+floor sind mlog sqrt mexp200cosd angle(normaldeviate,uniformdeviate-chardp);
+string s[]; s1=s2=s4; s3=s5; s1=s2; if s1<=s4<>(s1<>s3):show[[char34=s2:=s3]]fi;
+substring penoffset point.1of.p~of[[pencircle]]rotated1080/2/1/3of decimal
+ directiontime postcontrol-1.5of(p~&cycle)-precontrol1/2of p~(p~)=s1:=s4:=s4;
+path p~[]; p~1=p2{length" "}&cycle; p~1=p2=p~0; p2..controls-p2..cycle=p~2;(p7
+..tension1.2..p~[length p~2]..p~2&{0,1}p2..tension1and atleast1..cycle)..tension
+ x..{curl1}-p7{curl hex "IsBad"}..tension.75and.74999..p2{0,1}&p2{_,'}..cycle:=p
+ ~4; subpath(-9,9)of subpath(3.5001,7.00001)of p~4=p~6;
+show p~6, directiontime(1,2) of p~6, directiontime(1,-1.00001) of p~6;
+p~3=(0,0)..controls (1,1) and (0,1)..(1,0); show p2..p2{p7}&{$,$}cycle,
+ (directiontime(1,1) of subpath(.314159,1) of p~3)[.314159,1];
+p~5=(subpath(0,.25)of p~3&subpath(.25,1)of p~3)shifted begintext1,0;
+p~3:=2/3'zscaled'{p~3}..controls(2,2/3(3))and penoffset(1/2x,y)of(0,1)(1,0);
+show p~3 intersectiontimes reverse p~3, point.17227 of p~3, point1-.28339of p~3;
+show point xpart(p~5 intersectiontimes p~5 shifted (.01,0))of p~5-
+ point ypart(p~5 intersectiontimes p~5 shifted (.01,0))of p~5;
+[[ e[-1+-+ -1.00001]=nullpicture; addto e1 also[[
+addto e0 doublepath p~5 scaled 3 withpen q; e0=e1=e2;
+nullpicture]];show e1, e2 shifted (-3,0) ]];
+addto e1 also e2 shifted(-2,$); e1:=e1 shifted(-4,$);
+addto e1 doublepath (0,9) withcolor(.4,turningnumber p~4,0)
+ withpen qq xscaled(oct"180"++1) rotated-angle(64,$) shifted (9,8);
+show e1; chardp:=charcode:=5; xoffset:=-1.5; shipout e1; e3=nullpicture;
+showstats; addto e3doublepath(.5,0)..(3.5,1.5)dashed e0;
+ q:=makepen((1,1)..cycle) yscaled 1.5;
+chardx:=chardp:=charext:=-14.5;charcode:=6;shipout e2;
+p~9=(0,0)..(1,.5)..(5,1.5)..(7,2.5)..(12,3.5)..(13,4);addto e3 doublepath p~9;
+addto doublepath (-4095,0)..tension
+3/4 and 999..(0,2); show e3 rotated-90;
+if "a" if "ab">"b" elseif path reverse (3,4): >="aa":foo elseif fi "bar"
+else if '-(1,yy)<': :fi else def dup text t=[[t;save enddef;def|suffix$=,$
+enddef; def||tertiary p=show substring p of("a" enddef;||(2,$)&"bc");
+tertiarydef x++y=[[dup showtoken x;]];def quote x expr z of y=z enddef;
+ texts(quote x=(y+0)y+y)("xx",foo(x))=0]] enddef; def texts(text t,tt)expr?=
+ for n:=,for n"yy":n,length if false:endfor tt,t,:if string n:forsuffixes n=
+ foo1,[foo(n)],':show t,tt|(n;exitif not('<='+(?,yy)) endfor for m= :+endfor
+ for m=alpha step-1.1 3$: +m endfor fi endfor enddef; show (0,0){curl2}..
+ subpath(23.3,4.5)of p~9{curl3}..($,$){curl4}..cycle;zzz=p~++2+3;[[
+let?=if;save if,\;def if=endinput?enddef;def texts=input enddef;texts trap ]];
+dup[[def texts secondary x=primarydef y++y=x@y enddef; showtoken++;x enddef]]\;
+texts:="a"&"b";% strings "yy" and "ab" no longer appear in memory
+texts-1.00001a1=-(a2+a3+a4+a5+a6);-(a3,a2)/.99999=-(a4+a5+[[showdependencies;
+a6]],a3+a4+a5+a6)]]; 1.00001a4+1=a5+a6; alpha:=.9alpha+7; showdependencies;
+a5=a6=2/3-a6; charcode:=chardp:=27; 3.1=aaz; show aaz; ligtable||:255|=:|>>0,
+skipto0; show [[interim tracingcommands:=0; lig("g")(=:|); lig("h":"i")(|=:);
+lig("j")(|=:>);lig("k")(=:|>); lig("l")(|=:|>)]];
+b1:=c.a[ [[let c=++;vardef b=enddef;1]] ]; ligtable"m":0=:0,skipto5;
+!!; errhelp 0; errmessage "Be like Jane";
+errhelp "He%%%lp%"; errmessage""; errhelp ""; errmessage "Another";
+headerbyte 0; headerbyte(48.5)substring(-9,9)of"long"; for\=0:\
+headerbyte 9:2a6,"q"; fontdimen 9:2a6,"q"; fontdimen 1:2048;
+fontmaking:=1; extensible 5 5,"c"255.5,"d"; charlist 0:5:"a":"d";
+ligtable255:255::"a"=:"b","d" kern -2048,"c":0:99.5:"e"|=:|"f",0kern';
+ligtable 5:0; def clear(text x)=interim x:=$ enddef; clear(hppp); vppp=0;
+[[clear(tracingmacros); clear(tracingcommands); clear(tracingoutput\;
+ designsize:=.99999;charcode:=ASCII char-418.5;
+ def dp expr d = charcode:=charcode+1; chardp:=d; shipout nullpicture enddef;
+ dp 13; dp 12; dp 0; dp 21; dp -2; dp 17; dp 11; dp 3; charic:=-1000; dp -1;
+ dp 25; dp 31; dp 19; dp 7; charwd:=256; chardy:=6; dp 23; dp 30]];
+def f(suffix@@)(expr a,b)(text t)=numeric w; show a; % wipes out the old w
+addto @@ contour (0,0)..(2,0)..(1,$)..(1,1)..cycle withpen qq; % strange path
+addto @@ doublepath (0,0){1,1}..{2,1}(2,1) withpen qq; % carefully chosen
+addto @@ doublepath(($,$){1,0}..(1,1){1,0})scaled.5 withpen nullpen;
+enddef; def g(suffix$)=show $ enddef;
+addto e0 contour (0,0){1,0}..{1,0}(1,0){0,$}..{0,1}cycle withpen qq;
+f(e[3,w); g(e3,transformed p,penoffset-(1,1.3)of(pencircle scaled20 yscaled-.5),
+ directiontime (0,1) of ((0,0)..controls(1,1)and($,1)..(3,0)),
+ point 3.14159 of p~9 intersectiontimes subpath (3.14159,4) of p~9,
+ (($,1.1)..(1,$)) intersectiontimes precontrol$ of (0,0);
+addto e3 doublepath(-4094.99998,0)..(4094.99998,-.00001) withpen penoffset 0 of
+pencircle; addto e3 also e3 shifted (0,257); ,"flushed with pride"; numeric xx;
+def f(expr x,y,z)=showdependencies;tracingcapsules:=1;showdependencies;show
+ 1/3(3,6)*((x+y)+(y-x)), (1,1)/sqrt2 zscaled (x+1,x+2) - (x+1,x+2) rotated 45,
+ (0,1) zscaled (1,y+2)-(1,y+2) rotated 90 enddef; f((xx+1)/.3,(yy-1)/.5,(xx,0));
+'=(1000o3-4000(o1-o2)+4000o2+9,-.01o3+3ooo+
+ [[oo=9/10(o2+o4+o5-20);o4=o5=8/9(o1+.5o2); o6=-.0001o2;showdependencies;
+ numeric o[];xpart(alfa,[[pair alfa;0]])]])=-2/3[[save p;(p$,1-p$)]];
+xoffset:=yoffset:=4000[[oo=.5ooo=2*-1/2(ooo+[[numeric ooo;1]]);oo]];
+addto foo contour begingroup vardef foo=enddef; (0,0)..cycle endgroup;
+p~7=p~8; p~8:=(0,0){-1,1}..(30,0); show p~8, directiontime (0,-1)of p~8;
+show directiontime (1,0) of p~9, directiontime(1,-1)
+of ((0,0){1,0}..(0,0){0,-1)..cycle);
+e9=e4=nullpicture; addto e4 doublepath p~8;
+addto e9 doublepath p~8 dashed e4; e9:=nullpicture;
+e4:=nullpicture; addto e4 doublepath(1,1)..(4,1);
+addto e9 doublepath p~8 dashed e4; e9:=nullpicture;
+addto e4 doublepath makepath pencircle dashed e4 scaled -2; show e4;
+e4:=e5=nullpicture; addto e4 doublepath (-4,-3)..tension 2..(-2,-2.7);
+addto e5 doublepath p~5 shifted (0,4) scaled 3 dashed e4 withpen qq;
+show llcorner e5; verbatimtex \font\tra=trapf at 10pt
+ \font\trb=trapf at 20pt % TeX comment only!" etex
+e6:=nullpicture; addto e6 doublepath (0,0)..(30,0) dashed makepath pencircle
+dashed e5 withpen pencircle scaled2 dashed e5shifted(0,-11)
+withpen pencircle; show e6; def -- = {curl1}..{curl1}enddef;
+p~7 := p~8 rotated 90 xscaled -1 .. cycle; linecap:=2; linejoin:=1;
+e6=nullpicture; addto e6 doublepath p~8 dashed e5 withpen pencircle;
+clip e6 to p~7; addto e6 also btex \tra Aqua \vrule\trb Brass etex
+ shifted(0,-2); addto e6 doublepath (1,0)..(2,1); addto e5 also
+ e6 withcolor .5*(1,1,1) dashed e4 withpen pencircle xscaled 2 rotated 45;
+addto e5 also btex \tra mast etex shifted(0,10);
+show e6, lrcorner e5, ulcorner e5; charcode:=200; shipout e5;
+showstats; e5:=e6:="curb"infont"trapf" slanted-.5 scaled-1; showstats;
+show penoffset(0,0)of pencircle, llcorner e5, urcorner e5;
+e5:=e5 rotated 90 shifted "oops"; show llcorner e5, urcorner e5;
+show urcorner (char220 infont "trapf"), makepath qq;
+show subpath(-2,-1)of p~8, subpath(9,10)of makepath pencircle;
+"hi" infont "qw99z"; special "ij"="ij"; show substring(-2,-1)of"abc";
+addto e5 contour [[ ]]; addto e5 contour true; pausing:=0;prologues:=1;
+charcode:=197; shipout e5; p~10=(0,0){1,1.01}..tension atleast 1..{1,0}
+(1,1){-1,1}..(2,0){1,-1}; prologues:=0; for d=(-1,1),(1,-1),(0,0):
+show directiontime d of p~10; endfor linejoin:=linecap:=1;
+e5:=nullpicture; addto e5 contour makepath(pencircle scaled 10)
+withpen pencircle shifted(2,0); addto e5 doublepath (0,0)..(12,0)
+withpen pencircle yscaled 3; charcode:=148; shipout e5;
+e5:=nullpicture; clip p~8 to; clip e5 to e4; clip e5 to p~8; clip e5 to p~7;
+addto e5 doublepath makepath(pencircle scaled 50) withpen qq;
+addto e5 doublepath p~8 withpen pencircle xscaled 2 dashed e4;
+addto e5 doublepath p~8 withpen pencircle dashed e4;
+addto e5 doublepath p~8 shifted (10,0) dashed e4 scaled 1 withpen pencircle;
+charcode:=149; shipout e5; addto 3; addto p~8 contour p~7;
+e5:=nullpicture; linecap:=2; linejoin:=0; miterlimit:=10;
+addto e5 contour (10,5)..cycle withpen qq;
+addto e5 doublepath (5,10)..(5,15) withpen qq;
+addto e5 doublepath (0,0)..controls(10,10)..(10,10)..(0,20){curl1}..(30,10)
+withpen makepen((0,-5)..(0,5)..cycle); charcode:=150; prologues:=1; shipout e5;
+for @=angle(sqrt$,mlog$):charext:=uniformdeviate$;charht:=2048;
+addto e3 contour (0,-100)..tension 500..(100,-99)..tension 3000..cycle;
+tracingoutput:=@; special "bye"; charcode:=151; shipout e3;
+interim char 99 = "c"; true=false; show penoffset (2,1) of qq;
+showstats; let f=faz; showtoken f; showstats;
+e17=nullpicture; addto e17 doublepath (-4,-5)..(6,5);
+setbounds e17 to makepath(pencircle scaled 9); show llcorner e17, urcorner e17;
+addto e5 also e17 shifted (-5,-5); show llcorner e5; truecorners:=2;
+show llcorner e5; truecorners:=-1;
+setbounds e17 to makepath(pencircle xscaled 19);
+addto e5 also e17 shifted(-5,-10); show llcorner e5, e5, urcorner pencircle;
+e5:=nullpicture; path ap[];
+ap1=makepath(pencircle scaled 100);
+ap2=(2,-14)..controls (14,-7) and (14,7)..(2,14);
+ap3=(-50,0)..controls (-50,0) .. (50,0);
+show arclength (ap2 scaled 1000), arclength(ap3 scaled 200);
+show arclength ap1, arclength ap2;
+show arctime 6.4 of ap3, arclength subpath(0,arctime 37 of ap3) of ap3;
+show arctime -1000 of ap1, arctime -3 of ap2, arctime314 of (ap1 scaled .00001);
+[[clear(tracingcommands); charcode:=ASCII char 269-13; shipout nullpicture;
+"careful" quote for for = @ step 200 until 2*2600: &" METAFONT" endfor;]];
+scrollmode; "hello again"&char31; save p;
+def f expr x=let )=]; let [=(; show _ enddef; begingroup tracingonline:=1;
+tracingonline:=1; f xx[1); showdependencies; qq:=q; showstats; bye endtext
+% things not tested:
+% interaction (error insertion/deletion, interrupts, \pausing, files not there)
+% date, time; initialization of random number generator without randomseed
+% system-dependent parsing of file names, areas, extensions
+% certain error messages, especially fatal ones
+% things that can't happen in INIMP
+% unusual cases of fixed-point arithmetic
+% certain other unusual cases, especially when something similar is tested
+% most events that trigger string pool compaction
diff --git a/Build/source/texk/web2c/triptrap/trap.mpx b/Build/source/texk/web2c/triptrap/trap.mpx
new file mode 100644
index 00000000000..1529948d569
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.mpx
@@ -0,0 +1,27 @@
+% Written by DVItoMP, C Version 0.60
+begingroup save _p,_r,_s,_n; picture _p; _p=nullpicture;
+string _n[];
+vardef _s(expr _t,_f,_m,_x,_y)=
+ addto _p also _t infont _f scaled _m shifted (_x,_y); enddef;
+_n0="trapf";
+_s("Aqua",_n0,1.00000,0.0000,0.0000);
+interim linecap:=0;
+vardef _r(expr _a,_w) =
+ addto _p doublepath _a withpen pencircle scaled _w enddef;
+_r((8.1693,-3.9851)..(8.1693,15.9402), 0.3985);
+_n1="trapf";
+_s("Brass",_n1,2.00000,8.3686,0.0000);
+setbounds _p to (0,-3.9851)--(18.3313,-3.9851)--
+ (18.3313,15.9402)--(0,15.9402)--cycle;
+_p endgroup
+mpxbreak
+begingroup save _p,_r,_s,_n; picture _p; _p=nullpicture;
+string _n[];
+vardef _s(expr _t,_f,_m,_x,_y)=
+ addto _p also _t infont _f scaled _m shifted (_x,_y); enddef;
+_n0="trapf";
+_s("ast",_n0,1.00000,0.0000,0.0000);
+setbounds _p to (0,-0.9963)--(1.9925,-0.9963)--
+ (1.9925,6.9738)--(0,6.9738)--cycle;
+_p endgroup
+mpxbreak
diff --git a/Build/source/texk/web2c/triptrap/trap.typ b/Build/source/texk/web2c/triptrap/trap.typ
new file mode 100644
index 00000000000..134766ec4f1
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trap.typ
@@ -0,0 +1,210 @@
+This is GFtype, Version 3.1
+Options selected: Mnemonic output = true; pixel output = true.
+' METAFONT output 2002.12.23:1157'
+
+35: beginning of char 5: -4096<=m<=4094 -2<=n<=1
+(initially n=1) paint (4095)1
+64: skip0 0 (n=0) paint (4093)1
+69: skip0 0 (n=-1) paint (4096)1
+74: skip0 0 (n=-2) paint (4092)1(1)1
+81: eoc
+(The character is too large to be displayed in full.)
+.<--This pixel's lower left corner is at (-4096,2) in METAFONT coordinates
+
+
+
+
+.<--This pixel's upper left corner is at (-4096,-2) in METAFONT coordinates
+
+82: beginning of char 5 with extension -14: -4<=m<=1002 -6<=n<=11
+(previous character with the same code started at byte 35)
+(initially n=11) paint (1002)4
+111: skip0 0 (n=10) paint (1002)4
+116: skip0 0 (n=9) paint (1002)4
+121: skip1 3 (n=5) paint (1002)4
+127: skip0 0 (n=4) paint (1002)4
+132: skip0 0 (n=3) paint (1002)4
+137: newrow 7 (n=2) paint 1
+139: newrow 3 (n=1) paint 1(1)1(1)1
+145: newrow 1 (n=0) paint 1(1)2(1)1(1)1
+153: newrow 1 (n=-1) paint 2(1)1
+157: newrow 0 (n=-2) paint 1(1)1
+161: skip1 1 (n=-4) paint (7)1
+165: newrow 7 (n=-5) paint 1
+167: newrow 6 (n=-6) paint 1(1)1
+171: eoc
+(The character is too large to be displayed in full.)
+.<--This pixel's lower left corner is at (-4,12) in METAFONT coordinates
+
+
+
+
+
+
+
+
+
+ *
+ * * *
+ * ** * *
+ ** *
+* *
+
+ *
+ *
+ * *
+.<--This pixel's upper left corner is at (-4,-6) in METAFONT coordinates
+
+172: yyy -216270 (-3.30002)
+177: xxx 'title ab'
+187: xxx 'xoffset'
+196: yyy -65536 (-1)
+201: beginning of char 27 with extension -14: -4096<=m<=4094 -1<=n<=0
+(initially n=0) paint (4093)1(1)4095
+234: newrow 0 (n=-1) paint 4093(1)1
+240: eoc
+(The character is too large to be displayed in full.)
+.<--This pixel's lower left corner is at (-4096,1) in METAFONT coordinates
+
+********************************************************************************
+.<--This pixel's upper left corner is at (-4096,-1) in METAFONT coordinates
+
+241: xxx 'xoffset'
+250: yyy -87359488 (-1333)
+255: xxx 'yoffset'
+264: yyy -87359488 (-1333)
+269: beginning of char 109: -5428<=m<=2762 -1435<=n<=-1077
+(initially n=-1077) paint (0)8190
+298: skip2 256 (n=-1334) paint (0)8190
+305: skip1 98 (n=-1433) paint (4143)55
+311: skip0 0 (n=-1434) paint (4088)106
+317: skip0 0 (n=-1435) paint (4092)74
+323: eoc
+(The character is too large to be displayed in full.)
+.<--This pixel's lower left corner is at (-5428,-1076) in METAFONT coordinates
+********************************************************************************
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+.<--This pixel's upper left corner is at (-5428,-1156) in METAFONT coordinates
+
+324: xxx 'bye'
+329: xxx 'xoffset'
+338: yyy -87359488 (-1333)
+343: xxx 'yoffset'
+352: yyy -87359488 (-1333)
+357: beginning of char 0: 0<=m<=0 0<=n<=0
+(initially n=0)
+363: eoc
+(The character is entirely blank.)
+
+364: xxx 'title careful METAFONT METAFONT METAFONT METAFONT METAFONT METAF
+ONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT ME
+TAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT METAFONT
+ METAFONT METAFONT METAFONT METAFONT'
+624: xxx 'title hello again?'
+624: ! non-ASCII character in xxx command!
+
+Postamble starts at byte 644, after special info at byte 364.
+design size = 134217728 (128pt)
+check sum = 765094058
+hppp = -65536 (-1)
+vppp = 65535 (0.99998)
+min m = -5428, max m = 4094
+min n = -1435, max n = 11
+Character 0: dx -950272 (-14.5), dy 393216 (6), width 2097152 (-256), loc 324
+Character 5: dx -950272 (-14.5), width 0 (0), loc 82
+Character 27: dx -950272 (-14.5), width 0 (0), loc 172
+Character 95: dx -950272 (-14.5), width 0 (0), loc -1
+Character 96: dx -950272 (-14.5), width 0 (0), loc -1
+Character 97: dx -950272 (-14.5), width 0 (0), loc -1
+Character 98: dx -950272 (-14.5), width 0 (0), loc -1
+Character 99: dx -950272 (-14.5), width 0 (0), loc -1
+Character 100: dx -950272 (-14.5), width 0 (0), loc -1
+Character 101: dx -950272 (-14.5), width 0 (0), loc -1
+Character 102: dx -950272 (-14.5), width 0 (0), loc -1
+Character 103: dx -950272 (-14.5), width 0 (0), loc -1
+Character 104: dx -950272 (-14.5), width 0 (0), loc -1
+Character 105: dx -950272 (-14.5), width 0 (0), loc -1
+Character 106: dx -950272 (-14.5), width 0 (0), loc -1
+Character 107: dx -950272 (-14.5), width 0 (0), loc -1
+Character 108: dx -950272 (-14.5), dy 393216 (6), width 2097152 (-256), loc -1
+Character 109: dx -950272 (-14.5), dy 393216 (6), width 2097152 (-256), loc 241
+Character 236: dx 0 (0), width 0 (0), loc -1
+The file had 5 characters altogether.
diff --git a/Build/source/texk/web2c/triptrap/trapf.pl b/Build/source/texk/web2c/triptrap/trapf.pl
new file mode 100644
index 00000000000..6c7c9a2a43d
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trapf.pl
@@ -0,0 +1,105 @@
+(FAMILY UNSPECIFIED)
+(FACE F MRR)
+(CODINGSCHEME MP TEST: NOT A REAL FONT)
+(DESIGNSIZE R 10.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM O 0)
+(FONTDIMEN
+ (SLANT R -2.0)
+ (SPACE R 0.400001)
+ (STRETCH R 0.200001)
+ (SHRINK R 0.1)
+ (XHEIGHT R 0.45)
+ (QUAD R 1.0)
+ (EXTRASPACE R 0.200001)
+ )
+(CHARACTER O 0
+ (CHARWD R 0.700001)
+ (CHARHT R -0.1)
+ (CHARDP R 0.200001)
+ )
+(CHARACTER O 55
+ (CHARWD R -0.5)
+ )
+(CHARACTER O 57
+ (CHARWD R 0.1)
+ )
+(CHARACTER C 1
+ (CHARWD R 0.0)
+ )
+(CHARACTER C 2
+ (CHARWD R 0.0)
+ )
+(CHARACTER C 3
+ (CHARWD R 0.0)
+ )
+(CHARACTER C 4
+ (CHARWD R 0.0)
+ )
+(CHARACTER C 5
+ (CHARWD R 0.0)
+ )
+(CHARACTER C 6
+ (CHARWD R 0.0)
+ )
+(CHARACTER C 7
+ (CHARWD R 0.0)
+ )
+(CHARACTER C A
+ (CHARWD R 0.200001)
+ (CHARHT R 0.700001)
+ (CHARDP R 0.1)
+ (CHARIC R 0.1)
+ )
+(CHARACTER C B
+ (CHARWD R 0.3)
+ (CHARHT R 0.8)
+ (CHARDP R 0.200001)
+ )
+(CHARACTER C C
+ (CHARWD R 0.400001)
+ )
+(CHARACTER C M
+ (CHARWD R 0.6)
+ (CHARIC R 0.200001)
+ (VARCHAR
+ (MID C A)
+ (BOT C B)
+ (REP O 0)
+ )
+ )
+(CHARACTER C a
+ (CHARWD R 0.200001)
+ (CHARHT R 0.700001)
+ (CHARDP R 0.1)
+ (CHARIC R 0.1)
+ (NEXTLARGER O 202)
+ )
+(CHARACTER C b
+ (CHARWD R 0.3)
+ (CHARHT R 0.8)
+ (CHARDP R 0.200001)
+ (NEXTLARGER C M)
+ )
+(CHARACTER C p
+ (CHARWD R 0.0)
+ )
+(CHARACTER C q
+ (CHARWD R 0.0)
+ )
+(CHARACTER C r
+ (CHARWD R 0.0)
+ )
+(CHARACTER C s
+ (CHARWD R 0.0)
+ )
+(CHARACTER C t
+ (CHARWD R 0.0)
+ )
+(CHARACTER C u
+ (CHARWD R 0.0)
+ )
+(CHARACTER O 202
+ (CHARWD R 0.400001)
+ )
diff --git a/Build/source/texk/web2c/triptrap/trapman.tex b/Build/source/texk/web2c/triptrap/trapman.tex
new file mode 100644
index 00000000000..7968c6e44ea
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trapman.tex
@@ -0,0 +1,400 @@
+% The TRAP manual: How to validate MF --- last updated by D E Knuth on 4 Dec 89
+\font\eighttt= cmtt8
+\font\eightrm= cmr8
+\font\titlefont=cmssdc10 at 40pt
+\let\mc=\eightrm
+\font\logo=manfnt % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\rm
+\let\mainfont=\tenrm
+
+\def\.#1{\hbox{\tt#1}}
+\def\\#1{\hbox{\it#1\/\hskip.05em}} % italic type for identifiers
+
+\parskip 2pt plus 1pt
+\baselineskip 12pt plus .25pt
+
+\def\verbatim#1{\begingroup \frenchspacing
+ \def\do##1{\catcode`##1=12 } \dospecials
+ \parskip 0pt \parindent 0pt
+ \catcode`\ =\active \catcode`\^^M=\active
+ \tt \def\par{\ \endgraf} \obeylines \obeyspaces
+ \input #1 \endgroup}
+% a blank line will be typeset at the end of the file;
+% if you're unlucky it will appear on a page by itself!
+{\obeyspaces\global\let =\ }
+
+\output{\shipout\box255\global\advance\pageno by 1} % for the title page only
+\null
+\vfill
+\centerline{\titlefont A Torture Test}
+\vskip8pt
+\centerline{\titlefont for \logo ()*+,-.*}
+\vskip 24pt
+\centerline{by Donald E. Knuth}
+\centerline{Stanford University}
+\vskip 6pt
+\centerline{({\sl Version 2, January 1990\/})}
+\vfill
+\centerline{\vbox{\hsize 4in
+\noindent Programs that claim to be implementations of \MF84 are
+supposed to be able to process the test routine contained in this
+report, producing the outputs contained in this report.}}
+\vskip 24pt
+{\baselineskip 9pt
+\eightrm\noindent
+The preparation of this report was supported in part by the National Science
+Foundation under grants IST-8201926 and MCS-8300984,
+and by the System Development Foundation.
+{\logo opqrstuq} is a trademark of Addison-Wesley Publishing Company.
+
+
+}\pageno=0\eject
+
+\output{\shipout\vbox{ % for subsequent pages
+ \baselineskip0pt\lineskip0pt
+ \hbox to\hsize{\strut
+ \ifodd\pageno \hfil\eightrm\firstmark\hfil
+ \mainfont\the\pageno
+ \else\mainfont\the\pageno\hfil
+ \eightrm\firstmark\hfil\fi}
+ \vskip 10pt
+ \box255}
+ \global\advance\pageno by 1}
+\let\runninghead=\mark
+\outer\def\section#1.{\noindent{\bf#1.}\quad
+ \runninghead{\uppercase{#1} }\ignorespaces}
+
+\section Introduction.
+People often think that their programs are ``debugged'' when large applications
+have been run successfully. But system programmers know that a typical large
+application tends to use at most about 50 per cent of the instructions
+in a typical compiler. Although the other half of the code---which tends
+to be the ``harder half''---might be riddled with errors, the system seems
+to be working quite impressively until an unusual case shows up on the
+next day. And on the following day another error manifests itself, and so on;
+months or years go by before certain parts of the compiler are even
+activated, much less tested in combination with other portions of the system,
+if user applications provide the only tests.
+
+How then shall we go about testing a compiler? Ideally we would like to
+have a formal proof of correctness, certified by a computer.
+This would give us a lot of confidence,
+although of course the formal verification program might itself be incorrect.
+A more serious drawback of automatic verification is that the formal
+specifications of the compiler are likely to be wrong, since they aren't
+much easier to write than the compiler itself. Alternatively, we can
+substitute an informal proof of correctness: The programmer writes his or
+her code in a structured manner and checks that appropriate relations
+remain invariant, etc. This helps greatly to reduce errors, but it cannot
+be expected to remove them completely; the task of checking a large
+system is sufficiently formidable that human beings cannot do it without
+making at least a few slips here and there.
+
+Thus, we have seen that test programs are unsatisfactory if they are simply
+large user applications; yet some sort of test program is needed because
+proofs of correctness aren't adequate either. People have proposed schemes
+for constructing test data automatically from a program text, but such
+approaches run the risk of circularity, since they cannot assume that a
+given program has the right structure.
+
+I have been having good luck with a somewhat different approach,
+first used in 1960 to debug an {\mc ALGOL} compiler. The idea is to
+construct a test file that is about as different from a typical user
+application as could be imagined. Instead of testing things that people
+normally want to do, the file tests complicated things that people would
+never dare to think of, and it embeds these complexities in still
+more arcane constructions. Instead of trying to make the compiler do the
+right thing, the goal is to make it fail (until the bugs have all been found).
+
+To write such a fiendish test routine, one simply gets into a nasty frame
+of mind and tries to do everything in the unexpected way. Parameters
+that are normally positive are set negative or zero; borderline cases
+are pushed to the limit; deliberate errors are made in hopes that the
+compiler will not be able to recover properly from them.
+
+A user's application tends to exercise 50\%\ of a compiler's logic,
+but my first fiendish tests tend to improve this to about 90\%. As the
+next step I generally make use of frequency-counting software to identify
+the instructions that have still not been called upon. Then I add ever more
+fiendishness to the test routine, until more than 99\%\ of the code
+has been used at least once. (The remaining bits are things that
+can occur only if the source program is really huge, or if certain
+fatal errors are detected; or they are cases so similar to other well-tested
+things that there can be little doubt of their validity.)
+
+Of course, this is not guaranteed to work. But my experience in 1960 was
+that only two bugs were ever found in that {\mc ALGOL} compiler after it
+correctly translated that original fiendish test. And one of those bugs
+was actually present in the results of the test; I simply had failed to
+notice that the output was incorrect. Similar experiences occurred later
+during the 60s and 70s, with respect to a few assemblers, compilers,
+and simulators that I wrote.
+
+This method of debugging, combined with the methodology of structured
+programming and informal proofs (otherwise known as careful desk checking),
+leads to greater reliability of production software than any other
+method I know. Therefore I have used it in developing \MF84, and the
+main bulk of this report is simply a presentation of the test program
+that was used to get the bugs out of \MF.
+
+Such a test file is useful also after a program has been debugged, since
+it can be used to give some assurance that subsequent modifications don't
+mess things up.
+
+The test file is called \.{TRAP.MF}, because of my warped sense of humor:
+\MF's companion system, \TeX, has a similar test file called \.{TRIP}, and I
+couldn't help thinking about Billy Goat Gruff and the story of ``trip,
+trap, trip, trap.''
+
+The contents of this test file are so remote from what people actually
+do with \MF, I feel apologetic if I have to explain the correct
+translation of \.{TRAP.MF}; nobody really cares about most of the
+nitty-gritty rules that are involved. Yet I believe \.{TRAP} exemplifies
+the sort of test program that has outstanding diagnostic ability, as
+explained above.
+
+If somebody claims to have a correct implementation of \MF, I will not
+believe it until I see that \.{TRAP.MF} is translated properly.
+I propose, in fact, that a program must meet two criteria before it
+can justifiably be called \MF: (1)~The person who wrote it must be
+happy with the way it works at his or her installation; and (2)~the
+program must produce the correct results from \.{TRAP.MF}.
+
+\MF\ is in the public domain, and its algorithms are published;
+I've done this since I do not want to discourage its use by placing
+proprietary restrictions on the software. However, I don't want
+faulty imitations to masquerade as \MF\ processors, since users
+want \MF\ to produce identical results on different machines.
+Hence I am planning to do whatever I can to suppress any systems that
+call themselves \MF\ without meeting conditions (1) and~(2).
+I have copyrighted the programs so that I have some chance to forbid
+unauthorized copies; I explicitly authorize copying of correct
+\MF\ implementations, and not of incorrect ones!
+
+The remainder of this report consists of appendices, whose contents ought
+to be described briefly here:
+
+Appendix A explains in detail how to carry out a test of \MF, given
+a tape that contains copies of the other appendices.
+
+Appendix B is \.{TRAP.MF}, the fiendish test file that has already
+been mentioned. People who think that they understand \MF\ are challenged
+to see if they know what \MF\ is supposed to do with this file.
+People who know only a little about \MF\ might still find it
+interesting to study Appendix~B, just to get some insights into the
+methodology advocated here.
+
+Appendix C is \.{TRAPIN.LOG}, a correct transcript file \.{TRAP.LOG}
+that results if \.{INIMF} is applied to \.{TRAP.MF}. (\.{INIMF} is
+the name of a version of \MF\ that does certain initializations;
+this run of \.{INIMF} also creates a binary base file called \.{TRAP.BASE}.)
+
+Appendix D is a correct transcript file \.{TRAP.LOG} that results if
+\.{INIMF} or any other version of \MF\ is applied to \.{TRAP.MF}
+with base file \.{TRAP.BASE}.
+
+Appendix E is \.{TRAP.TYP}, the symbolic version of a correct output
+file \.{TRAP.72270GF} that was produced at the same time as the \.{TRAP.LOG}
+file of Appendix~D.
+
+Appendix F is \.{TRAP.PL}, the symbolic version of a correct output
+file \.{TRAP.TFM} that was produced at the same time as the \.{TRAP.LOG}
+file of Appendix~D.
+
+Appendix G is \.{TRAP.FOT}, an abbreviated version of Appendix D that
+appears on the user's terminal during the run that produces \.{TRAP.LOG},
+\.{TRAP.72270GF}, and \.{TRAP.TFM}.
+
+The debugging of \MF\ and the testing of the adequacy of \.{TRAP.MF}
+could not have been done nearly as well as reported here except for
+the magnificent software support provided by my colleague David R. Fuchs.
+In particular, he extended our local Pascal compiler so that
+frequency counting and a number of other important features were added
+to its online debugging abilities.
+
+The method of testing advocated here has one chief difficulty that deserves
+comment: I had to verify by hand that \MF\ did the right things
+to \.{TRAP.MF}. This took many hours, and perhaps I have missed
+something (as I did in 1960); I must confess that I have not checked
+every single number in Appendices D, E, and~F. However, I'm willing to pay
+$\$$81.92 to the first finder of any remaining bug in \MF, and I will
+be surprised if that bug doesn't show up also in one of these appendices.
+
+\vfill\eject
+
+\section Appendix A: How to test \MF.
+
+\item{0.} Let's assume that you have a tape containing \.{TRAP.MF},
+\.{TRAPIN.LOG}, \.{TRAP.LOG}, \.{TRAP.TYP}, \.{TRAP.PL}, and \.{TRAP.FOT},
+as in Appendices B, C, D, E, F, and~G. Furthermore, let's suppose that you
+have a working \.{WEB} system, and that you have working programs
+\.{TFtoPL} and \.{GFtype}, as described in the \TeX ware and \MF ware reports.
+
+\item{1.} Prepare a version of \.{INIMF}. (This means that your \.{WEB}
+change file should have {\bf init} and {\bf tini} defined to be null.)
+The {\bf debug} and {\bf gubed} macros should be null, in order to
+activate special printouts that occur when $\\{tracingedges}>1.0$.
+The {\bf stat} and {\bf tats} macros should also be null, so that
+statistics are kept. Set \\{mem\_top} and \\{mem\_max} to 3000
+(or to \\{mem\_min} plus 3000, if \\{mem\_min} isn't zero),
+for purposes of this test version.
+Also set $\\{error\_line}=64$, $\\{half\_error\_line}=32$,
+$\\{max\_print\_line}=72$, $\\{screen\_width}=100$, and
+$\\{screen\_depth}=200$; these parameters affect many of the lines of
+the test output, so your job will be much easier if you use the same
+settings that were used to produce Appendix~E. Also (if possible) set
+$\\{gf\_buf\_size}=8$, since this tests more parts of the program.
+You probably should also use the ``normal'' settings of other parameters
+found in \.{MF.WEB} (e.g., $\\{max\_internal}=100$, $\\{buf\_size}=500$,
+etc.), since these show up in a few lines of the test output. Finally,
+change \MF's screen-display routines by putting the following simple lines
+in the change file:
+$$\vbox{\halign{\tt#\hfil\cr
+\char`\@x Screen routines:\cr
+begin init\char`\_screen:=false;\cr
+\char`\@y\cr
+begin init\char`\_screen:=true;
+ \char`\{screen instructions will be logged\char`\}\cr
+\char`\@z\cr}}$$
+None of the other screen routines (\\{update\_screen}, \\{blank\_rectangle},
+\\{paint\_row}) should be changed in any way; the effect will be to have
+\MF's actions recorded in the transcript files instead of on the screen,
+in a machine-independent way.
+
+\item{2.} Run the \.{INIMF} prepared in step 1. In response to the first
+`\.{**}' prompt, type carriage return (thus getting another `\.{**}').
+Then type `\.{\char`\\input trap}'. You should get an output that matches
+the file \.{TRAPIN.LOG} (Appendix~C). Don't be alarmed by the error
+messages that you see, unless they are different from those in Appendix~C.
+
+\def\sp{{\char'40}}
+\item{3.} Run \.{INIMF} again. This time type `\.{\sp\&trap\sp\sp trap\sp}'.
+(The spaces in this input help to check certain parts of \MF\ that
+aren't otherwise used.) You should get outputs \.{TRAP.LOG}, \.{TRAP.72270GF},
+and \.{TRAP.TFM}.
+Furthermore, your terminal should receive output that matches \.{TRAP.FOT}
+(Appendix~G). During the middle part of this test, however, the terminal
+will not be getting output, because \.{batchmode} is being
+tested; don't worry if nothing seems to be happening for a while---nothing
+is supposed to.
+
+\item{4.} Compare the \.{TRAP.LOG} file from step 3 with the ``master''
+\.{TRAP.LOG} file of step~0. (Let's hope you put that master file in a
+safe place so that it wouldn't be clobbered.) There should be perfect
+agreement between these files except in the following respects:
+
+\itemitem{a)} The dates and possibly the file names will
+naturally be different.
+
+\itemitem{b)} If you had different values for \\{stack\_size}, \\{buf\_size},
+etc., the corresponding capacity values will be different when they
+are printed out at the end.
+
+\itemitem{c)} Help messages may be different; indeed, the author encourages
+non-English help messages in versions of \MF\ for people who don't
+understand English as well as some other language.
+
+\itemitem{d)} The total number and length of strings at the end and/or
+``still untouched'' may well be different.
+
+\itemitem{e)} If your \MF\ uses a different memory allocation or
+packing scheme, the memory usage statistics may change.
+
+\itemitem{f)} If you use a different storage allocation scheme, the
+capsule numbers will probably be different, but the order of variables
+should be unchanged when dependent variables are shown. \MF\ should also
+choose the same variables to be dependent.
+
+\itemitem{g)} If your computer handles integer division of negative operands
+in a nonstandard way, you may get results that are rounded differently.
+Although \TeX\ is careful to be machine-independent in this regard,
+\MF\ is not, because integer divisions are present in so many places.
+
+\item{5.} Use \.{GFtype} to convert your file \.{TRAP.72270GF} to a file
+\.{TRAP.TYP}. (Both of \.{GFtype}'s options, i.e., mnemonic output and image
+output, should be enabled so that you get the maximum amount of output.)
+The resulting file should agree with the master \.{TRAP.TYP} file of step~0,
+assuming that your \.{GFtype} has the ``normal'' values of compile-time
+constants ($\\{top\_pixel}=69$, etc.).
+
+\item{6.} Use \.{TFtoPL} to convert your file \.{TRAP.TFM} to a file
+\.{TRAP.PL}. The resulting file should agree with the master \.{TRAP.PL}
+file of step~0.
+
+\item{7.} You might also wish to test \.{TRAP} with other versions of
+\MF\ (i.e., \.{VIRMF} or a production version with another base file
+preloaded). It should work unless \MF's primitives have been redefined in
+the base file. However, this step isn't essential, since all the code of
+\.{VIRMF} appears in \.{INIMF}; you probably won't catch any more errors
+this way, unless they would already become obvious from normal use of
+the~system.
+
+\vfill\eject
+
+\section Appendix B: The \.{TRAP.MF} file.
+The contents of the test routine are prefixed here with line numbers, for
+ease in comparing this file with the error messages printed later; the
+line numbers aren't actually present.
+\runninghead{APPENDIX B: \.{TRAP.MF} (CONTINUED)}
+
+\vskip 8pt
+\begingroup\count255=0
+\everypar{\global\advance\count255 by 1
+ \hbox to 20pt{\sevenrm\hfil\the\count255\ \ }}
+\verbatim{trap.mf}
+\endgroup
+\vfill\eject
+
+\section Appendix C: The \.{TRAPIN.LOG} file.
+When \.{INIMF} makes the \.{TRAP.BASE} file, it also creates a file called
+\.{TRAP.LOG} that looks like this.
+\runninghead{APPENDIX C: \.{TRAPIN.LOG} (CONTINUED)}
+
+\vskip8pt
+\verbatim{trapin.log}
+\vfill\eject
+
+\section Appendix D: The \.{TRAP.LOG} file.
+Here is the major output of the \.{TRAP} test; it is generated by running
+\.{INIMF} and loading \.{TRAP.BASE}, then reading \.{TRAP.MF}.
+\runninghead{APPENDIX D: \.{TRAP.LOG} (CONTINUED)}
+
+{\let\tt=\eighttt\leftskip 1in\baselineskip 9pt plus .1pt minus .1pt
+\vskip8pt
+\verbatim{trap.log}
+}
+\vfill\eject
+
+\section Appendix E: The \.{TRAP.TYP} file.
+Here is another major component of the test. It shows the output of \.{GFtype}
+applied to the file \.{TRAP.72270GF} that is created at the same time
+Appendix D was produced.
+\runninghead{APPENDIX E: \.{TRAP.TYP} (CONTINUED)}
+
+{\let\tt=\eighttt\leftskip 1in\baselineskip 9pt plus .1pt minus .1pt
+\vskip8pt
+\verbatim{trap.typ}
+}
+\vfill\eject
+
+\section Appendix F: The \.{TRAP.PL} file.
+In this case we have the output of \.{TFtoPL}
+applied to the file \.{TRAP.TFM} that is created at the same time
+Appendix D was produced.
+\runninghead{APPENDIX F: \.{TRAP.PL} (CONTINUED)}
+
+{\let\tt=\eighttt\leftskip 1in\baselineskip 9pt plus .1pt minus .1pt
+\vskip8pt
+\verbatim{trap.pl}
+}
+\vfill\eject
+
+\section Appendix G: The \.{TRAP.FOT} file.
+This shows what appeared on the terminal while Appendix D was being produced.
+\runninghead{APPENDIX G: \.{TRAP.FOT} (CONTINUED)}
+
+\vskip8pt
+\verbatim{trap.fot}
+
+\vfill\end
diff --git a/Build/source/texk/web2c/triptrap/trip.diffs b/Build/source/texk/web2c/triptrap/trip.diffs
new file mode 100644
index 00000000000..1bfd68deec3
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trip.diffs
@@ -0,0 +1,147 @@
+make[1]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c'
+cd lib && make -w CC='gcc' CFLAGS='-g ' LDFLAGS=''
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+make[2]: Nothing to be done for `default'.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/lib'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' fixwrites
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `fixwrites' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' splitup
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `splitup' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+cd web2c && make -w CC='gcc' CFLAGS='-g ' LDFLAGS='' web2c
+make[2]: Entering directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+make[2]: `web2c' is up to date.
+make[2]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c/web2c'
+rm -f trip.tfm trip.pl trip.tex trip.fmt tripin.fot tripin.log
+rm -f trip.fot trip.log trip.dvi trip.typ tripos.tex 8terminal.tex
+rm -rf tfm
+./pltotf ./triptrap/trip.pl trip.tfm
+./tftopl ./trip.tfm trip.pl
+diff ./triptrap/trip.pl trip.pl
+ln -s ./triptrap/trip.tex . # get same filename in log
+/bin/sh -c 'TEXMFCNF=./triptrap ./tex --progname=initex --ini <./triptrap/trip1.in >tripin.fot'
+mv trip.log tripin.log
+diff ./triptrap/tripin.log tripin.log
+1c1
+< This is TeX, Version 3.141592 (INITEX) 20 DEC 2002 20:24
+---
+> This is TeX, Version 3.141592 (Web2C 7.5.5) (INITEX) 3 AUG 2005 10:46
+3c3
+< (trip.tex
+---
+> (./trip.tex
+450,451c450,451
+< (preloaded format=trip 2002.12.20)
+< 1320 strings of total length 23539
+---
+> (format=trip 2005.8.3)
+> 1364 strings of total length 24385
+461c461
+< Hyphenation trie of length 273 has 9 ops out of 500
+---
+> Hyphenation trie of length 273 has 9 ops out of 35111
+/bin/sh -c 'TEXMFCNF=./triptrap ./tex --progname=tex <./triptrap/trip2.in >trip.fot'
+diff ./triptrap/trip.fot trip.fot
+1,3c1,2
+< This is TeX, Version 3.141592 (INITEX)
+< ** &trip trip
+< (trip.tex ##
+---
+> This is TeX, Version 3.141592 (Web2C 7.5.5)
+> **(./trip.tex ##
+diff ./triptrap/trip.log trip.log
+1c1
+< This is TeX, Version 3.141592 (preloaded format=trip 2002.12.20) 20 DEC 2002 21:28
+---
+> This is TeX, Version 3.141592 (Web2C 7.5.5) (format=trip 2005.8.3) 3 AUG 2005 10:46
+3c3
+< (trip.tex ##
+---
+> (./trip.tex ##
+58a59,62
+> \openout0 = `8terminal.tex'.
+>
+> \openout10 = `tripos.tex'.
+>
+1405c1409
+< \vbox(16383.99998+0.0)x1000.0, glue set 16342.0fil
+---
+> \vbox(16383.99998+0.0)x1000.0, glue set 16341.99998fil
+1954c1958
+< (tripos.tex
+---
+> (./tripos.tex
+2018c2022
+< \vbox(16383.99998+1.0)x100.0, glue set 16239.0fil
+---
+> \vbox(16383.99998+1.0)x100.0, glue set 16238.99998fil
+2533c2537
+< \vbox(16383.99998+0.0)x20.0, glue set 16331.0fil
+---
+> \vbox(16383.99998+0.0)x20.0, glue set 16330.99998fil
+3326c3330
+< \vbox(10000.0+2.0)x28.0, glue set 9737.58789fil
+---
+> \vbox(10000.0+2.0)x28.0, glue set 9737.58742fil
+3864c3868
+< \vbox(16383.99998+2.0)x100.0, glue set 16318.0fil
+---
+> \vbox(16383.99998+2.0)x100.0, glue set 16317.99997fil
+4034c4038
+< \vbox(16383.99998+0.0)x8236.0, glue set 16344.0fil
+---
+> \vbox(16383.99998+0.0)x8236.0, glue set 16343.99998fil
+4420c4424
+< \vbox(16383.99998+0.0)x100.0, glue set 16332.0fil
+---
+> \vbox(16383.99998+0.0)x100.0, glue set 16331.99998fil
+4742c4746
+< \vbox(16383.99998+0.0)x205.12613, glue set 16344.0fil
+---
+> \vbox(16383.99998+0.0)x205.12613, glue set 16343.99998fil
+6370c6374
+< (tripos.tex
+---
+> (./tripos.tex
+7287,7288c7291,7292
+< 47 strings out of 1674
+< 251 string characters out of 8353
+---
+> 44 strings out of 1636
+> 261 string characters out of 15615
+7290c7294
+< 372 multiletter control sequences out of 2100
+---
+> 372 multiletter control sequences out of 10000+0
+7292,7293c7296,7297
+< 2 hyphenation exceptions out of 307
+< 5i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+---
+> 1 hyphenation exception out of 659
+> 7i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+/bin/sh -c 'TEXMFCNF=./triptrap ./dvitype -output-level=2 -dpi=72.27 -page-start='*.*.*.*.*.*.*.*.*.*' trip.dvi >trip.typ'
+diff ./triptrap/trip.typ trip.typ
+1c1
+< This is DVItype, Version 3.6
+---
+> This is DVItype, Version 3.6 (Web2C 7.5.5)
+9c9
+< ' TeX output 2002.12.20:2128'
+---
+> ' TeX output 2005.08.03:1046'
+419c419
+< 1121: down4 639342208
+---
+> 1121: down4 639342177
+1087,1088c1087,1088
+< 2535: y4 203921760
+< 2540: y0 203921760
+---
+> 2535: y4 203921756
+> 2540: y0 203921756
+1215d1214
+<
+make[1]: Leaving directory `/home/olaf/web2c/src/texk/texk/web2c'
diff --git a/Build/source/texk/web2c/triptrap/trip.fot b/Build/source/texk/web2c/triptrap/trip.fot
new file mode 100644
index 00000000000..6a2fcb3753a
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trip.fot
@@ -0,0 +1,83 @@
+This is TeX, Version 3.141592 (INITEX)
+** &trip trip
+(trip.tex ##
+! Bad number (-7).
+<to be read again>
+ 8
+l.94 \openout-'78
+ terminal \openout10=tr\romannumeral1 \gobble...
+
+Completed box being shipped out [0.0.0.0.11]
+! Missing number, treated as zero.
+<to be read again>
+ {
+...
+l.106 \penalty-10000
+ % now we'll compute silently for awhile,...
+Memory usage before: 159&313; after: 102&278; still untouched: 1613
+
+! OK (see the transcript file).
+l.441 ...se unbal}\fi}\showlists
+ \tracingonline1%
+{|escapechar}
+{^^?global}
+{^^?global}
+{end}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+{end-group character }}
+{retaining escapechar=256}
+> 3.
+<output> {showthe deadcycles
+ global advance countz by1global ...
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+! You can't use `end' in internal vertical mode.
+<recently read> end
+
+<output> ...cal {}unvbox 255end
+ rb }
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+! Unbalanced output routine.
+<output> ... {}unvbox 255end rb
+ }
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+! Output loop---3 consecutive dead cycles.
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+
+Completed box being shipped out [-1.2.-1118806.0.11.196608.327680.157286
+4.1073741823]
+! Unbalanced write command.
+<write> if 01{else unbal}fi
+
+<inserted text>
+ }endwrite
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+Memory usage before: 334&431; after: 292&418; still untouched: 175
+ )
+(end occurred inside a group at level 1)
+(end occurred when if on line 442 was incomplete)
+(end occurred when ifcase on line 419 was incomplete)
+(end occurred when iftrue on line 413 was incomplete)
+(see the transcript file for additional information)
+Output written on trip.dvi (16 pages, 2920 bytes).
+Transcript written on trip.log.
diff --git a/Build/source/texk/web2c/triptrap/trip.log b/Build/source/texk/web2c/triptrap/trip.log
new file mode 100644
index 00000000000..ad152dd13ab
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trip.log
@@ -0,0 +1,7295 @@
+This is TeX, Version 3.141592 (preloaded format=trip 2002.12.20) 20 DEC 2002 21:28
+** &trip trip
+(trip.tex ##
+{vertical mode: \tracingrestores}
+{\write}
+{blank space }
+{\openout}
+
+! Bad number (-7).
+<to be read again>
+ 8
+l.94 \openout-'78
+ terminal \openout10=tr\romannumeral1 \gobble...
+Since I expected to read a number between 0 and 15,
+I changed this one to zero.
+
+{\openout}
+{\romannumeral}
+{\write}
+{blank space }
+{\write}
+{blank space }
+{\write}
+{blank space }
+{\vsize}
+{\vbadness}
+{\topskip}
+{\penalty}
+{\maxdepth}
+{\tracingoutput}
+{\moveleft}
+%% goal height=2000.0, max depth=2.0
+% t=0.0 g=2000.0 b=10000 p=0 c=100000#
+{\moveright}
+{restricted horizontal mode: \vrule}
+{end-group character }}
+% t=20.0 plus 1.0fil g=2000.0 b=0 p=0 c=0#
+{vertical mode: blank space }
+{\penalty}
+% t=48.0 plus 41.0 plus 1.0fil g=2000.0 b=0 p=-10000 c=-10000#
+
+Completed box being shipped out [0.0.0.0.11]
+\vbox(2000.0+2.0)x21.0, glue set 1952.0fil
+.\write-{log file only\the \prevgraf }
+.\openout0=8terminal
+.\openout10=tripos
+.\write10{}
+.\write10{\uppercase {\number {\outputpenalty }}}
+.\write10{[\uppercase {\romannumeral -\the \outputpenalty }[}
+.\glue(\topskip) 9.6 plus 1.0fil
+.\vbox(10.4+0.0)x-2.0, shifted -20.0
+..\rule(0.4+0.0)x*
+..\glue 10.0 plus 5.0filll
+.\glue(\baselineskip) 10.0 plus 41.0
+.\hbox(0.0+20.0)x1.0, shifted 20.0
+..\rule(-19.0+20.0)x1.0
+
+log file only0
+{no mode: \number}
+
+! Missing number, treated as zero.
+<to be read again>
+ {
+...
+l.106 \penalty-10000
+ % now we'll compute silently for awhile,...
+A number should have been here; I inserted `0'.
+(If you can't figure out why I needed to see a number,
+look up `weird error' in the index to The TeXbook.)
+
+{\romannumeral}
+{\the}
+Memory usage before: 159&313; after: 102&278; still untouched: 1613
+{vertical mode: \batchmode}
+
+{\output}
+{blank space }
+{\setbox}
+{internal vertical mode: end-group character }}
+{vertical mode: blank space }
+{\dimen}
+{begin-group character {}
+{\output}
+{blank space }
+{\insert}
+{internal vertical mode: \def}
+{blank space }
+{\vskip}
+{\baselineskip}
+{\lineskip}
+{\vbox}
+{end-group character }}
+{\penalty}
+{\vbox}
+{end-group character }}
+{\penalty}
+{\vbox}
+{end-group character }}
+{\penalty}
+{end-group character }}
+{restoring \lineskip=0.0pt plus 40.0pt}
+{restoring \baselineskip=10.0pt plus 41.0pt}
+{restoring \box=\box}
+%% goal height=2000.0, max depth=2.0
+! Insertions can only be added to a vbox.
+l.125 }
+ % since \dimen100=803pt<3*267.7pt, the insertion ...
+Tut tut: You're trying to \insert into a
+\box register that now contains an \hbox.
+Proceed, and I'll discard its present contents.
+
+The following box has been deleted:
+\hbox(7.0+1.0)x2.0
+.\rip A
+
+! Infinite glue shrinkage inserted from \skip100.
+l.125 }
+ % since \dimen100=803pt<3*267.7pt, the insertion ...
+The correction glue for page breaking with insertions
+must have finite shrinkability. But you may proceed,
+since the offensive shrinkability has been made finite.
+
+% split100 to 803.0,267.7 p=-101
+{vertical mode: blank space }
+{\topskip}
+{\vbox}
+{internal vertical mode: end-group character }}
+% t=0.0 plus 3.0filll minus 9.0 g=1470.63013 b=0 p=0 c=-101#
+{vertical mode: blank space }
+{\insertpenalties}
+{\penalty}
+{\cleaders}
+{restricted horizontal mode: \lower}
+{internal vertical mode: end-group character }}
+{restricted horizontal mode: blank space }
+{\leaders}
+{\cleaders}
+{the letter A}
+{end-group character }}
+{\leaders}
+{the letter A}
+{end-group character }}
+{\xleaders}
+{the letter A}
+{end-group character }}
+{\write}
+{blank space }
+{end-group character }}
+{vertical mode: \mark}
+{blank space }
+{the letter A}
+% t=1050.0 plus 44.0 plus 3.0filll minus 19.0 g=1470.63013 b=0 p=0 c=-50
+{horizontal mode: the letter A}
+{\insert}
+{internal vertical mode: \baselineskip}
+{\splittopskip}
+{\hbox}
+{restricted horizontal mode: \vadjust}
+{internal vertical mode: \penalty}
+{end-group character }}
+{restricted horizontal mode: end-group character }}
+{internal vertical mode: \hbox}
+{restricted horizontal mode: end-group character }}
+{internal vertical mode: end-group character }}
+{restoring \splittopskip=1.0pt plus 43.0pt}
+{restoring \baselineskip=10.0pt plus 41.0pt}
+{horizontal mode: \showthe}
+> 1050.0pt.
+<everypar> ...howthe \pagetotal
+ \showthe \pagegoal \advance \...
+...
+l.140 A
+ AA\everypar=\errhelp % because of previous \everypar...
+
+{\showthe}
+> 1470.63013pt.
+<everypar> ...showthe \pagegoal
+ \advance \count 15by1\mark {\...
+...
+l.140 A
+ AA\everypar=\errhelp % because of previous \everypar...
+
+{\advance}
+{\mark}
+{\splitmaxdepth}
+{\par}
+@firstpass
+@secondpass
+[]\rip A[][]
+@\par via @@0 b=* p=-10000 d=*
+@@1: line 1.3- t=0 -> @@0
+
+
+Overfull \hbox (2.0pt too wide) in paragraph at lines 140--140
+[]\rip A|
+
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+
+{vertical mode: the letter A}
+% t=1060.0 plus 127.0 plus 8.0filll minus 27.0 g=1255.43756 b=0 p=0 c=-5
+0
+{horizontal mode: the letter A}
+{\insert}
+{internal vertical mode: \baselineskip}
+{\splittopskip}
+{\hbox}
+{restricted horizontal mode: \vadjust}
+{internal vertical mode: \penalty}
+{end-group character }}
+{restricted horizontal mode: end-group character }}
+{internal vertical mode: \hbox}
+{restricted horizontal mode: end-group character }}
+{internal vertical mode: end-group character }}
+{restoring \splittopskip=1.0pt plus 43.0pt}
+{restoring \baselineskip=10.0pt plus 41.0pt}
+{horizontal mode: \showthe}
+> 1061.0pt.
+<everypar> ...howthe \pagetotal
+ \showthe \pagegoal \advance \...
+...
+l.140 AA
+ A\everypar=\errhelp % because of previous \everypar...
+
+{\showthe}
+> 1255.43756pt.
+<everypar> ...showthe \pagegoal
+ \advance \count 15by1\mark {\...
+...
+l.140 AA
+ A\everypar=\errhelp % because of previous \everypar...
+
+{\advance}
+{\mark}
+{\splitmaxdepth}
+{\par}
+@firstpass
+@secondpass
+[]\rip A[][]
+@\par via @@0 b=* p=-10000 d=*
+@@1: line 1.3- t=0 -> @@0
+
+
+Overfull \hbox (2.0pt too wide) in paragraph at lines 140--140
+[]\rip A|
+
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+
+{vertical mode: the letter A}
+% t=1070.0 plus 210.0 plus 8.0filll minus 35.0 g=1055.44061 b=7 p=0 c=-4
+3
+{horizontal mode: the letter A}
+{\insert}
+{internal vertical mode: \baselineskip}
+{\splittopskip}
+{\hbox}
+{restricted horizontal mode: \vadjust}
+{internal vertical mode: \penalty}
+{end-group character }}
+{restricted horizontal mode: end-group character }}
+{internal vertical mode: \hbox}
+{restricted horizontal mode: end-group character }}
+{internal vertical mode: end-group character }}
+{restoring \splittopskip=1.0pt plus 43.0pt}
+{restoring \baselineskip=10.0pt plus 41.0pt}
+{horizontal mode: \showthe}
+> 1071.0pt.
+<everypar> ...howthe \pagetotal
+ \showthe \pagegoal \advance \...
+...
+l.140 AAA
+ \everypar=\errhelp % because of previous \everypar...
+
+{\showthe}
+> 1055.44061pt.
+<everypar> ...showthe \pagegoal
+ \advance \count 15by1\mark {\...
+...
+l.140 AAA
+ \everypar=\errhelp % because of previous \everypar...
+
+{\advance}
+{\mark}
+{\splitmaxdepth}
+{\par}
+@firstpass
+@secondpass
+[]\rip A[][]
+@\par via @@0 b=* p=-10000 d=*
+@@1: line 1.3- t=0 -> @@0
+
+
+Overfull \hbox (2.0pt too wide) in paragraph at lines 140--140
+[]\rip A|
+
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+
+% split200 to -51.11694,0.0 p=999
+{vertical mode: \everypar}
+{\kern}
+{the letter A}
+% t=1080.0 plus 293.0 plus 8.0filll minus 43.0 g=1055.44061 b=18 p=0 c=9
+67
+{horizontal mode: the letter A}
+{\hfill}
+{\vadjust}
+{internal vertical mode: \newlinechar}
+{\special}
+{\penalty}
+{end-group character }}
+{restoring \newlinechar=0}
+{horizontal mode: \penalty}
+{the letter A}
+{\par}
+@firstpass
+@secondpass
+[]\rip A
+@ via @@0 b=* p=0 d=*
+@@1: line 1.3 t=0 -> @@0
+[]
+@\penalty via @@1 b=0 p=-10000 d=*
+@@2: line 2.2 t=0 -> @@1
+A
+@\par via @@2 b=* p=-10000 d=*
+@@3: line 3.3- t=0 -> @@2
+
+
+Overfull \hbox (2.0pt too wide) in paragraph at lines 145--148
+[]\rip A|
+
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+
+
+Overfull \hbox (2.0pt too wide) in paragraph at lines 145--148
+\rip A|
+
+\hbox(7.0+1.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+
+% t=1040.0 plus 376.0 plus 8.0filll minus 51.0 g=1055.44061 b=0 p=0 c=94
+9
+% t=1050.0 plus 417.0 plus 8.0filll minus 51.0 g=1055.44061 b=0 p=-5000
+c=-4051#
+{vertical mode: \insert}
+{internal vertical mode: \vskip}
+{\floatingpenalty}
+{end-group character }}
+{restoring \floatingpenalty=100}
+{vertical mode: \pagefilstretch}
+{\showthe}
+> 952.
+l.149 ...showthe\insertpenalties
+ \penalty99999999\showlists
+
+{\penalty}
+{\showlists}
+
+### vertical mode entered at line 0
+### current page:
+\insert100, natural size 803.09999; split(1.0 plus 43.0,-2.0); float cos
+t 100
+.\glue 0.0 plus 1.0fil
+.\vbox(267.7+0.0)x0.0
+.\penalty -101
+.\glue(\lineskip) 0.0 minus 0.4
+.\vbox(267.7+0.0)x0.0
+.\penalty -100
+.\glue(\lineskip) 0.0 minus 0.4
+.\vbox(267.7+0.0)x0.0
+.\penalty -1000
+\glue(\topskip) 0.0 plus 44.0
+\vbox(1000.0+0.0)x0.0
+\penalty 12345
+\cleaders 50.0 minus 10.0
+.\hbox(15.0+2.0)x45.0
+..\vbox(17.0+0.0)x0.0, shifted 2.0
+..\glue 4.0 plus 2.0 minus 1.0
+..\leaders 10.0
+...\rule(0.4+0.0)x*
+..\cleaders 9.0
+...\hbox(7.0+1.0)x2.0
+....\rip A
+..\leaders 9.0
+...\hbox(7.0+1.0)x2.0
+....\rip A
+..\xleaders 9.0
+...\hbox(7.0+1.0)x2.0
+....\rip A
+..\write*{\help }
+..\glue 4.0 plus 2.0 minus 1.0
+\mark{alpha}
+\glue(\parskip) 0.0 plus 42.0 minus 8.0
+\glue(\baselineskip) 3.0 plus 41.0
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\insert200, natural size 400.0; split(0.0,-2.0); float cost 100
+.\hbox(0.0+0.0)x0.0
+.\penalty 999
+.\glue(\baselineskip) 400.0
+.\hbox(0.0+0.0)x-10.0
+\mark{1}
+\glue(\parskip) 0.0 plus 42.0 minus 8.0
+\glue(\baselineskip) 2.0 plus 41.0
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\insert200, natural size 400.0; split(1.0,-1.0); float cost 100
+.\hbox(0.0+0.0)x0.0
+.\penalty 999
+.\glue(\baselineskip) 400.0
+.\hbox(0.0+0.0)x-10.0
+\mark{2}
+\glue(\parskip) 0.0 plus 42.0 minus 8.0
+\glue(\baselineskip) 2.0 plus 41.0
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\insert200, natural size 400.0; split(2.0,-1.0); float cost 100
+.\hbox(0.0+0.0)x0.0
+.\penalty 999
+.\glue(\baselineskip) 400.0
+.\hbox(0.0+0.0)x-10.0
+\mark{3}
+\kern -50.0
+\glue(\parskip) 0.0 plus 42.0 minus 8.0
+\glue(\baselineskip) 2.0 plus 41.0
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\glue(\baselineskip) 9.0 plus 41.0
+\hbox(0.0+0.0)x0.0
+.\penalty -1000000000
+.\glue(\rightskip) 0.0
+\special{^^80-1000.0pt}
+\penalty -5000
+\glue(\baselineskip) 3.0 plus 41.0
+\hbox(7.0+1.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\insert200, natural size 10000.0; split(1.0 plus 43.0,-1.0); float cost
+3
+.\glue 10000.0
+\penalty 99999999
+total height 1060.0 plus 458.0 plus -1.0fil plus 8.0filll minus 51.0
+ goal height 1055.44061
+\insert100 adds 535.36987, #1 might split
+\insert200 adds 405.19714, #3 might split
+prevdepth 1.0, prevgraf 3 lines
+
+! OK.
+<recently read> \showlists
+
+l.149 ...nalty99999999\showlists
+
+
+{\showthe}
+> 8.0pt.
+l.150 ...howthe\pagefilllstretch
+ \vskip 1000pt\penalty-333\hbo...
+
+{\vskip}
+{\penalty}
+% t=2061.0 plus 458.0 plus -1.0fil plus 8.0filll minus 51.0 g=1055.44061
+ b=* p=-333 c=*
+! \box255 is not void.
+<to be read again>
+ \hbox
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+You shouldn't use \box255 except in \output routines.
+Proceed, and I'll discard its present contents.
+
+The following box has been deleted:
+\vbox(0.0+0.0)x0.0
+
+{internal vertical mode: \dimen}
+{\count}
+{\global}
+{\ifnum}
+{true}
+{\global}
+{\unvbox}
+{\penalty}
+{\else}
+{\message}
+{\topmark}
+{\firstmark}
+{\botmark}
+{\splitfirstmark}
+{\splitbotmark}
+:alpha:3::
+{end-group character }}
+{restoring \count5=0}
+{restoring \dimen9=0.0pt}
+%% goal height=2000.0, max depth=2.0
+! Infinite glue shrinkage inserted from \skip100.
+<to be read again>
+ \hbox
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+The correction glue for page breaking with insertions
+must have finite shrinkability. But you may proceed,
+since the offensive shrinkability has been made finite.
+
+% split100 to 803.0,267.7 p=-101
+% t=0.0 plus 3.0filll minus 9.0 g=1470.63013 b=0 p=0 c=-101#
+% t=1050.0 plus 44.0 plus 3.0filll minus 19.0 g=1470.63013 b=0 p=0 c=-10
+1#
+% t=1060.0 plus 127.0 plus 8.0filll minus 27.0 g=1255.43756 b=0 p=0 c=-1
+01#
+% t=1070.0 plus 210.0 plus 8.0filll minus 35.0 g=1055.44061 b=7 p=0 c=-9
+4
+% split200 to -51.11694,0.0 p=999
+% t=1080.0 plus 293.0 plus 8.0filll minus 43.0 g=1055.44061 b=18 p=0 c=9
+16
+% t=1040.0 plus 376.0 plus 8.0filll minus 51.0 g=1055.44061 b=0 p=0 c=89
+8
+% t=1050.0 plus 417.0 plus 8.0filll minus 51.0 g=1055.44061 b=0 p=-5000
+c=-4102#
+% t=2061.0 plus 458.0 plus 8.0filll minus 51.0 g=1055.44061 b=* p=-333 c
+=*
+{\dimen}
+{\count}
+{\global}
+{\ifnum}
+{false}
+{\setbox}
+{\shipout}
+{restricted horizontal mode: \box}
+{\box}
+{\vsplit}
+
+Overfull \vbox (986.0pt too high) has occurred while \output is active
+\vbox(55.0+-1.0)x45.0, glue set - 1.0
+.\glue(\topskip) 0.0 plus 44.0
+.\vbox(1000.0+0.0)x0.0
+.\penalty 12345
+.\cleaders 50.0 minus 10.0
+..\hbox(15.0+2.0)x45.0
+...\vbox(17.0+0.0)x0.0, shifted 2.0
+...\glue 4.0 plus 2.0 minus 1.0
+...\leaders 10.0
+....\rule(0.4+0.0)x*
+...\cleaders 9.0
+....\hbox(7.0+1.0)x2.0
+.....\rip A
+...\leaders 9.0
+....\hbox(7.0+1.0)x2.0
+.....\rip A
+...\xleaders 9.0
+....\hbox(7.0+1.0)x2.0
+.....\rip A
+...\write*{\help }
+...\glue 4.0 plus 2.0 minus 1.0
+.\mark{alpha}
+
+{end-group character }}
+
+Completed box being shipped out [-5000.0.0.0.11.53110374]
+\hbox(810.4+0.0)x45.0
+.\vbox(267.7+0.0)x0.0
+..\glue 0.0 plus 1.0fil
+..\vbox(267.7+0.0)x0.0
+.\vbox(810.4+0.0)x0.0
+..\rule(0.4+0.0)x*
+..\glue 10.0 plus 5.0filll
+..\hbox(0.0+0.0)x0.0
+..\penalty 999
+..\glue(\baselineskip) 400.0
+..\hbox(0.0+0.0)x-10.0
+..\hbox(0.0+0.0)x0.0
+..\penalty 999
+..\glue(\baselineskip) 400.0
+..\hbox(0.0+0.0)x-10.0
+..\hbox(0.0+0.0)x0.0
+.\vbox(55.0+-1.0)x45.0, glue set - 1.0
+..\glue(\topskip) 0.0 plus 44.0
+..\vbox(1000.0+0.0)x0.0
+..\penalty 12345
+..\cleaders 50.0 minus 10.0
+...\hbox(15.0+2.0)x45.0
+....\vbox(17.0+0.0)x0.0, shifted 2.0
+....\glue 4.0 plus 2.0 minus 1.0
+....\leaders 10.0
+.....\rule(0.4+0.0)x*
+....\cleaders 9.0
+.....\hbox(7.0+1.0)x2.0
+......\rip A
+....\leaders 9.0
+.....\hbox(7.0+1.0)x2.0
+......\rip A
+....\xleaders 9.0
+.....\hbox(7.0+1.0)x2.0
+......\rip A
+....\write*{\help }
+....\glue 4.0 plus 2.0 minus 1.0
+..\mark{alpha}
+
+Memory usage before: 747&484; after: 581&481; still untouched: 1492
+{internal vertical mode: blank space }
+{\unvcopy}
+{\showlists}
+
+### internal vertical mode entered at line 150 (\output routine)
+\glue(\splittopskip) 0.0 plus 43.0
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\mark{1}
+\glue(\parskip) 0.0 plus 42.0 minus 8.0
+\glue(\baselineskip) 2.0 plus 41.0
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\mark{2}
+\glue(\parskip) 0.0 plus 42.0 minus 8.0
+\glue(\baselineskip) 2.0 plus 41.0
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\mark{3}
+\kern -50.0
+\glue(\parskip) 0.0 plus 42.0 minus 8.0
+\glue(\baselineskip) 2.0 plus 41.0
+\hbox(7.0+1.0)x0.0
+.\hbox(0.0+0.0)x0.0
+.\rip A
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\glue(\baselineskip) 9.0 plus 41.0
+\hbox(0.0+0.0)x0.0
+.\penalty -1000000000
+.\glue(\rightskip) 0.0
+\special{^^80-1000.0pt}
+prevdepth ignored
+### vertical mode entered at line 0
+### current page: (held over for next output)
+\insert100, natural size 535.4; split(1.0 plus 43.0,-2.0); float cost 10
+0
+.\glue(\splittopskip) 0.0 plus 43.0
+.\vbox(267.7+0.0)x0.0
+.\penalty -100
+.\glue(\lineskip) 0.0 minus 0.4
+.\vbox(267.7+0.0)x0.0
+.\penalty -1000
+\insert200, natural size 2.0; split(2.0,-1.0); float cost 100
+.\glue(\splittopskip) 2.0
+.\hbox(0.0+0.0)x-10.0
+### recent contributions:
+\penalty 10000
+\penalty 10000
+\glue(\baselineskip) 3.0 plus 41.0
+\hbox(7.0+1.0)x0.0
+.\rip A
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0
+.\rule(*+*)x5.0
+\insert200, natural size 10000.0; split(1.0 plus 43.0,-1.0); float cost
+3
+.\glue 10000.0
+\penalty 99999999
+\glue 1000.0
+\penalty -333
+prevdepth 1.0, prevgraf 3 lines
+
+! OK.
+<recently read> \showlists
+
+...
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+
+{\showthe}
+> 2.
+<output> ...he \insertpenalties
+ \showthe \pageshrink \globald...
+...
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+
+{\showthe}
+> 51.0pt.
+<output> ...showthe \pageshrink
+ \globaldefs 1\halign {##\tabs...
+...
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+
+{\globaldefs}
+{\halign}
+{blank space }
+{\showboxdepth}
+{\showboxbreadth}
+{\fi}
+{\message}
+{\topmark}
+{\firstmark}
+{\botmark}
+{\splitfirstmark}
+{\splitbotmark}
+3:alpha:3:alpha:alpha
+{end-group character }}
+{restoring \globaldefs=0}
+{restoring \box255=
+\vbox(1055.44061+0.0)x45.0, glue set 0.01305 []}
+{restoring \count5=0}
+{restoring \dimen9=0.0pt}
+! Output routine didn't use all of \box255.
+<to be read again>
+ \hbox
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+Your \output commands should empty \box255,
+e.g., by saying `\shipout\box255'.
+Proceed; I'll discard its present contents.
+
+The following box has been deleted:
+\vbox(1055.44061+0.0)x45.0, glue set 0.01305
+.\glue(\topskip) 0.0 plus 44.0
+.\vbox(1000.0+0.0)x0.0
+.etc.
+
+%% goal height=2000.0, max depth=2.0
+! Infinite glue shrinkage inserted from \skip100.
+<to be read again>
+ \hbox
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+The correction glue for page breaking with insertions
+must have finite shrinkability. But you may proceed,
+since the offensive shrinkability has been made finite.
+
+% t=0.0 plus 8.0filll minus 9.0 g=924.23029 b=0 p=0 c=0#
+% t=7.0 plus 44.0 plus 8.0filll minus 9.0 g=924.23029 b=0 p=0 c=0#
+% t=17.0 plus 127.0 plus 8.0filll minus 17.0 g=924.23029 b=0 p=0 c=0#
+% t=27.0 plus 210.0 plus 8.0filll minus 25.0 g=924.23029 b=0 p=0 c=0#
+% t=-13.0 plus 293.0 plus 8.0filll minus 33.0 g=924.23029 b=0 p=0 c=0#
+% split200 to 1832.4585,10000.0 p=-10000
+% t=1008.0 plus 375.0 plus 8.0filll minus 33.0 g=-4075.76971 b=* p=-333
+c=*
+{\dimen}
+{\count}
+{\global}
+{\ifnum}
+{false}
+{\setbox}
+{\shipout}
+{restricted horizontal mode: \box}
+{\box}
+{\vsplit}
+{end-group character }}
+
+Completed box being shipped out [10000.0.0.0.11.131072]
+\hbox(535.4+0.0)x0.0
+.\vbox(535.4+0.0)x0.0 []
+.\vbox(2.0+0.0)x0.0 []
+.etc.
+
+Memory usage before: 475&470; after: 290&466; still untouched: 1473
+{internal vertical mode: blank space }
+{\unvcopy}
+{\showlists}
+
+### internal vertical mode entered at line 150 (\output routine)
+prevdepth ignored
+### vertical mode entered at line 0
+### recent contributions:
+\glue(\baselineskip) 9.0 plus 41.0
+\hbox(0.0+0.0)x0.0
+.\penalty -1000000000
+.\glue(\rightskip) 0.0
+etc.
+prevdepth 1.0, prevgraf 3 lines
+
+! OK.
+<recently read> \showlists
+
+...
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+
+{\showthe}
+> 0.
+<output> ...he \insertpenalties
+ \showthe \pageshrink \globald...
+...
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+
+{\showthe}
+> 33.0pt.
+<output> ...showthe \pageshrink
+ \globaldefs 1\halign {##\tabs...
+...
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+
+{\globaldefs}
+{\halign}
+{blank space }
+{\showboxdepth}
+{\showboxbreadth}
+{\fi}
+{\message}
+{\topmark}
+{\firstmark}
+{\botmark}
+{\splitfirstmark}
+{\splitbotmark}
+3:1:3:1:3
+{end-group character }}
+{restoring \globaldefs=0}
+{restoring \box255=
+\vbox(924.23029+1.0)x0.0, glue set 3.19875 []}
+{restoring \count5=0}
+{restoring \dimen9=0.0pt}
+! Output routine didn't use all of \box255.
+<to be read again>
+ \hbox
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+Your \output commands should empty \box255,
+e.g., by saying `\shipout\box255'.
+Proceed; I'll discard its present contents.
+
+The following box has been deleted:
+\vbox(924.23029+1.0)x0.0, glue set 3.19875
+.\glue(\topskip) 0.0 plus 44.0
+.\hbox(7.0+1.0)x0.0 []
+.etc.
+
+%% goal height=2000.0, max depth=2.0
+% split200 to 3955.99365,10000.0 p=-10000
+% t=1012.0 plus 85.0 plus 5.0filll g=-3010.0 b=* p=-333 c=*#
+{\dimen}
+{\count}
+{\global}
+{\ifnum}
+{false}
+{\setbox}
+{\shipout}
+{restricted horizontal mode: \box}
+{\box}
+{\vsplit}
+
+Overfull \vbox (958.0pt too high) has occurred while \output is active
+\vbox(55.0+-1.0)x0.0
+.\glue(\topskip) 1.0 plus 44.0
+.\hbox(0.0+0.0)x0.0 []
+.etc.
+
+{end-group character }}
+
+Completed box being shipped out [-333.0.0.0.11.655360000]
+\hbox(10000.0+0.0)x0.0
+.\vbox(10000.0+0.0)x0.0 []
+.\vbox(55.0+-1.0)x0.0 []
+
+Memory usage before: 218&459; after: 149&458; still untouched: 1473
+{internal vertical mode: blank space }
+{\unvcopy}
+{\showlists}
+
+### internal vertical mode entered at line 150 (\output routine)
+prevdepth ignored
+### vertical mode entered at line 0
+### recent contributions:
+\penalty 10000
+prevdepth 1.0, prevgraf 3 lines
+
+! OK.
+<recently read> \showlists
+
+...
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+
+{\showthe}
+> 0.
+<output> ...he \insertpenalties
+ \showthe \pageshrink \globald...
+...
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+
+{\showthe}
+> 0.0pt.
+<output> ...showthe \pageshrink
+ \globaldefs 1\halign {##\tabs...
+...
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+
+{\globaldefs}
+{\halign}
+{blank space }
+{\showboxdepth}
+{\showboxbreadth}
+{\fi}
+{\message}
+{\topmark}
+{\firstmark}
+{\botmark}
+{\splitfirstmark}
+{\splitbotmark}
+3:3:3::
+{end-group character }}
+{restoring \globaldefs=0}
+{restoring \box255=
+\vbox(-3010.0+0.0)x0.0 []}
+{restoring \count5=0}
+{restoring \dimen9=0.0pt}
+! Output routine didn't use all of \box255.
+<to be read again>
+ \hbox
+l.150 ...1000pt\penalty-333\hbox
+ to 23pt{} % output now
+Your \output commands should empty \box255,
+e.g., by saying `\shipout\box255'.
+Proceed; I'll discard its present contents.
+
+The following box has been deleted:
+\vbox(-3010.0+0.0)x0.0
+.\glue(\topskip) 1.0 plus 44.0
+.\hbox(0.0+0.0)x0.0 []
+.etc.
+
+{vertical mode: \hbox}
+{restricted horizontal mode: end-group character }}
+%% goal height=2000.0, max depth=2.0
+{vertical mode: blank space }
+{\vsize}
+{\global}
+! Dimension too large.
+l.151 ...83.99999237060546875pt
+ % page size \approx infinity
+I can't work with sizes bigger than about 19 feet.
+Continue and I'll use the largest value I can.
+
+{end-group character }}
+{retaining \vsize=16383.99998pt}
+{restoring \everypar=A\insert 200{\baselineskip 400pt\ETC.}
+{restoring \splitmaxdepth=-2.0pt}
+{restoring \count15=0}
+{restoring \topskip=20.0pt plus 1.0fil}
+{restoring \output={\tracingcommands 0\showthe \outputpenalty \ETC.}
+{blank space }
+{begin-group character {}
+{\tracingoutput}
+{\tracingstats}
+{\shipout}
+{restricted horizontal mode: \closeout}
+{\closeout}
+{end-group character }}
+[-333.0.0.0.11]
+{vertical mode: end-group character }}
+{restoring \tracingstats=4}
+{restoring \tracingoutput=1}
+{blank space }
+{\showthe}
+> A\insert 200{\baselineskip 400pt\splittopskip \count 15pt\hbox {\vadju
+st {\penalty 999}}\hbox to -10pt{}}\showthe \pagetotal \showthe \pagegoa
+l \advance \count 15by1\mark {\the \count 15}\splitmaxdepth -1pt \paR \g
+obble .
+l.154 \showthe\everypar
+
+
+{\everypar}
+{\showthe}
+> .
+l.155 ...ypar{}\showthe\everypar
+
+
+{\def}
+{blank space }
+{\tracingmacros}
+{\def}
+{blank space }
+{\let}
+{\dimendef}
+{\dimen222}
+{\ifdim}
+{true}
+{\fi}
+{\ifdim}
+
+\t 12#101001{->-.#1pt{
+#1<-01001010
+{true}
+{begin-group character {}
+{\relax}
+{end-group character }}
+{\else}
+{\count0}
+{\ifodd}
+{true}
+{\advance}
+{\fi}
+{\penalty}
+% t=1.0 plus 44.0 g=2000.0 b=10000 p=-12345 c=-12345#
+{internal vertical mode: \tracingcommands}
+> -12345.
+<output> ...wthe \outputpenalty
+ \showboxbreadth 9999 \showbox...
+l.164 \penalty -12345
+ % output the remaining stuff
+
+
+Completed box being shipped out [-2.0.0.0.11]
+\vbox(2000.0+0.0)x23.0, glue set 45.43182
+.\glue(\topskip) 1.0 plus 44.0
+.\hbox(0.0+0.0)x23.0
+
+Memory usage before: 118&328; after: 102&328; still untouched: 1473
+{restoring \box254=void}
+{restoring \hoffset=0.0pt}
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{vertical mode: \tracingmacros}
+{\adjdemerits}
+{\linepenalty}
+{\def}
+{blank space }
+{\valign}
+{horizontal mode: \valign}
+{restricted horizontal mode: \spacefactor}
+{\global}
+{end-group character }}
+{blank space }
+{\vrule}
+{begin-group character {}
+{blank space }
+{end-group character }}
+{end-group character }}
+{internal vertical mode: \baselineskip}
+{\global}
+{\global}
+{\rightskip}
+{\global}
+{\setbox}
+
+\1#1->\hbox to#1pt{}
+#1<-2
+{restricted horizontal mode: end-group character }}
+{internal vertical mode: blank space }
+{\noindent}
+{horizontal mode: \copy}
+{\hskip}
+{\copy}
+{\hskip}
+{\lower}
+
+\1#1->\hbox to#1pt{}
+#1<-1
+{restricted horizontal mode: end-group character }}
+{horizontal mode: \hskip}
+{\copy}
+{\hskip}
+{\box}
+{end of alignment template}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+[]
+@ via @@0 b=51 p=0 d=2704
+@ via @@1 b=10000 p=0 d=100000000
+@@2: line 1.1 t=2704 -> @@0
+[]
+@ via @@0 b=30 p=0 d=961
+@ via @@1 b=10000 p=0 d=100000000
+@ via @@2 b=10000 p=0 d=100000000
+@@3: line 1.3 t=961 -> @@0
+[]
+@ via @@2 b=10000 p=0 d=100000000
+@ via @@3 b=10000 p=0 d=100000782
+@@4: line 2.0 t=100001743 -> @@3
+[]
+@\par via @@2 b=0 p=-10000 d=1
+@\par via @@3 b=30 p=-10000 d=1743
+@\par via @@4 b=10000 p=-10000 d=100000000
+@@5: line 2.1- t=2704 -> @@3
+@@6: line 2.2- t=2705 -> @@2
+
+
+Tight \hbox (badness 30) in paragraph at lines 183--183
+ [] [] []
+
+\hbox(0.0+2.0)x13.0, glue set - 0.66667
+.\glue(\leftskip) 4.0
+.\hbox(0.0+0.0)x2.0
+.etc.
+
+
+Loose \hbox (badness 30) in paragraph at lines 183--183
+ [] []
+
+\hbox(0.0+0.0)x13.0, glue set 0.66667
+.\glue(\leftskip) 4.0
+.\hbox(0.0+0.0)x2.0
+.etc.
+
+{restoring \box2=void}
+{restoring \rightskip=0.0pt}
+{restoring \baselineskip=10.0pt plus 41.0pt}
+{internal vertical mode: \baselineskip}
+{\global}
+{\global}
+{\rightskip}
+{\global}
+{\setbox}
+
+\1#1->\hbox to#1pt{}
+#1<-2
+{restricted horizontal mode: end-group character }}
+{internal vertical mode: blank space }
+{\noindent}
+{horizontal mode: \copy}
+{\hskip}
+{\copy}
+{\hskip}
+{\lower}
+
+\1#1->\hbox to#1pt{}
+#1<-1
+{restricted horizontal mode: end-group character }}
+{horizontal mode: \hskip}
+{\copy}
+{\hskip}
+{\box}
+{\adjdemerits}
+{end of alignment template}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000784
+@@1: line 1.0 t=100000784 -> @@0
+[]
+@ via @@0 b=51 p=0 d=2704
+@ via @@1 b=10000 p=0 d=100000000
+@@2: line 1.1 t=2704 -> @@0
+[]
+@ via @@0 b=30 p=0 d=961
+@ via @@1 b=10000 p=0 d=100000000
+@ via @@2 b=10000 p=0 d=100000000
+@@3: line 1.3 t=961 -> @@0
+[]
+@ via @@2 b=10000 p=0 d=100000000
+@ via @@3 b=10000 p=0 d=100000784
+@@4: line 2.0 t=100001745 -> @@3
+[]
+@\par via @@2 b=0 p=-10000 d=1
+@\par via @@3 b=30 p=-10000 d=1745
+@\par via @@4 b=10000 p=-10000 d=100000000
+@@5: line 2.1- t=2706 -> @@3
+@@6: line 2.2- t=2705 -> @@2
+
+
+Loose \hbox (badness 51) in paragraph at lines 184--184
+ [] []
+
+\hbox(0.0+0.0)x13.0, glue set 0.8
+.\glue(\leftskip) 4.0
+.\hbox(0.0+0.0)x2.0
+.etc.
+
+{restoring \adjdemerits=782}
+{restoring \box2=void}
+{restoring \rightskip=0.0pt}
+{restoring \baselineskip=10.0pt plus 41.0pt}
+{internal vertical mode: \baselineskip}
+{\global}
+{\global}
+{\rightskip}
+{\global}
+{\setbox}
+
+\1#1->\hbox to#1pt{}
+#1<-2
+{restricted horizontal mode: end-group character }}
+{internal vertical mode: blank space }
+{\noindent}
+{horizontal mode: \copy}
+{\hskip}
+{\copy}
+{\hskip}
+{\lower}
+
+\1#1->\hbox to#1pt{}
+#1<-1
+{restricted horizontal mode: end-group character }}
+{horizontal mode: \hskip}
+{\copy}
+{\hskip}
+{\box}
+{\linepenalty}
+{\hbadness}
+{end of alignment template}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+[]
+@ via @@0 b=51 p=0 d=2809
+@ via @@1 b=10000 p=0 d=100000000
+@@2: line 1.1 t=2809 -> @@0
+[]
+@ via @@0 b=30 p=0 d=1024
+@ via @@1 b=10000 p=0 d=100000000
+@ via @@2 b=10000 p=0 d=100000000
+@@3: line 1.3 t=1024 -> @@0
+[]
+@ via @@2 b=10000 p=0 d=100000000
+@ via @@3 b=10000 p=0 d=100000782
+@@4: line 2.0 t=100001806 -> @@3
+[]
+@\par via @@2 b=0 p=-10000 d=4
+@\par via @@3 b=30 p=-10000 d=1806
+@\par via @@4 b=10000 p=-10000 d=100000000
+@@5: line 2.1- t=2830 -> @@3
+@@6: line 2.2- t=2813 -> @@2
+
+{restoring \hbadness=0}
+{restoring \linepenalty=1}
+{restoring \box2=void}
+{restoring \rightskip=0.0pt}
+{restoring \baselineskip=10.0pt plus 41.0pt}
+{restricted horizontal mode: blank space }
+{\spacefactor}
+{end-group character }}
+{horizontal mode: \message}
+1
+{blank space }
+{begin-group character {}
+{\hsize}
+{\par}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+|
+@ via @@0 b=10000 p=0 d=100000782
+@ via @@1 b=10000 p=0 d=100000000
+@@2: line 1.0 t=100000782 -> @@0
+[][][]
+@ via @@0 b=10000 p=0 d=100000782
+@ via @@1 b=10000 p=0 d=100000000
+@ via @@2 b=10000 p=0 d=100000000
+@@3: line 1.0 t=100000782 -> @@0
+@\par via @@0 b=10000 p=-10000 d=100000782
+@\par via @@1 b=10000 p=-10000 d=100000000
+@\par via @@2 b=10000 p=-10000 d=100000000
+@\par via @@3 b=10000 p=-10000 d=100000000
+@@4: line 1.0- t=100000782 -> @@0
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 171--187
+ [] | [][][]
+
+\hbox(22.0+0.0)x1000.0, glue set 237.5
+.\glue(\leftskip) 4.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+%% goal height=16383.99998, max depth=2.0
+{vertical mode: \parindent}
+{\indent}
+% t=22.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{horizontal mode: end-group character }}
+{restoring \parindent=0.0pt}
+{restoring \hsize=13.0pt}
+{\leftskip}
+{\def}
+{\noindent}
+{\indent}
+{\hbox}
+{restricted horizontal mode: \hskip}
+{end-group character }}
+
+Underfull \hbox (badness 10000) detected at line 188
+
+
+\hbox(0.0+0.0)x2.0, glue set -1.99255
+.\glue 0.0 plus -1.00374
+
+{horizontal mode: \discretionary}
+
+\?->\vrule width-2pt \hbox spread2pt{}
+{restricted horizontal mode: \vrule}
+{\hbox}
+{end-group character }}
+{the letter A}
+{end-group character }}
+
+\?->\vrule width-2pt \hbox spread2pt{}
+{\vrule}
+{\hbox}
+{end-group character }}
+{the letter B}
+{end-group character }}
+
+\?->\vrule width-2pt \hbox spread2pt{}
+{\vrule}
+{\hbox}
+{end-group character }}
+{the character /}
+{\kern}
+{end-group character }}
+{horizontal mode: \unkern}
+{\showthe}
+> 2.0pt.
+l.190 \showthe\lastkern
+ \vbox{\hrule width 6pt} \par % should ...
+
+{\vbox}
+{internal vertical mode: \hrule}
+{end-group character }}
+{horizontal mode: blank space }
+{\par}
+@firstpass
+[][][]|[]\rip AAAB|[]B-
+@\discretionary via @@0 b=0 p=88 d=7745
+@@1: line 1.2- t=7745 -> @@0
+[]
+@\par via @@1 b=0 p=-10000 d=100001
+@@2: line 2.2- t=107746 -> @@1
+
+% t=32.0 plus 83.0 plus 1.0fil minus 8.0 g=16383.99998 b=0 p=162 c=162
+{vertical mode: \penalty}
+% t=42.0 plus 124.0 plus 1.0fil minus 8.0 g=16383.99998 b=0 p=-22222 c=-
+22222#
+\output->{\tracingcommands 0\showthe \outputpenalty \showboxbreadth 9999
+ \showboxdepth 9999 \hoffset 1sp {\setbox 254=\box 255\shipout \ifvbox 2
+\ifhbox 254 \error \fi 54\copy 25\fi 4} \ifvoid 254\relax \else \error \
+fi }
+{internal vertical mode: \tracingcommands}
+> -22222.
+<output> ...wthe \outputpenalty
+ \showboxbreadth 9999 \showbox...
+l.191 \penalty-22222
+ % end of demerits test, hyphenation is next
+
+
+Completed box being shipped out [-2.0.0.0.11]
+\vbox(16383.99998+0.0)x1000.0, glue set 16342.0fil
+.\glue(\topskip) 0.0 plus 1.0fil
+.\hbox(22.0+0.0)x1000.0, glue set 237.5
+..\glue(\leftskip) 4.0
+..\hbox(0.0+0.0)x0.0
+..\glue(\xspaceskip) -1.0
+..\rule(22.0+0.0)x0.0
+..\glue 4.0 plus 2.0 minus 1.0
+..\vbox(22.0+0.0)x13.0
+...\glue(\tabskip) 0.0 plus 40.0
+...\vbox(22.0+0.0)x13.0, glue set 2.0
+....\hbox(0.0+2.0)x13.0, glue set - 0.66667
+.....\glue(\leftskip) 4.0
+.....\hbox(0.0+0.0)x2.0
+.....\glue 2.0 plus 5.0 minus 1.0
+.....\hbox(0.0+0.0)x2.0
+.....\glue 5.0 minus 2.0
+.....\hbox(0.0+0.0)x1.0, shifted 2.0
+.....\glue(\rightskip) -1.0
+....\penalty 125
+....\glue(\baselineskip) 18.0 plus 1.0
+....\hbox(0.0+0.0)x13.0, glue set 0.66667
+.....\glue(\leftskip) 4.0
+.....\hbox(0.0+0.0)x2.0
+.....\glue 2.0 plus 6.0
+.....\hbox(0.0+0.0)x2.0
+.....\penalty 10000
+.....\glue(\parfillskip) 0.0
+.....\glue(\rightskip) -1.0
+...\glue(\tabskip) 0.0 plus 40.0
+..\vbox(22.0+0.0)x13.0
+...\glue(\tabskip) 0.0 plus 40.0
+...\vbox(22.0+0.0)x13.0
+....\hbox(0.0+0.0)x13.0, glue set 0.8
+.....\glue(\leftskip) 4.0
+.....\hbox(0.0+0.0)x2.0
+.....\glue 2.0 plus 5.0 minus 1.0
+.....\hbox(0.0+0.0)x2.0
+.....\glue(\rightskip) -1.0
+....\penalty 125
+....\glue(\baselineskip) 20.0 plus 1.0
+....\hbox(0.0+2.0)x13.0
+.....\glue(\leftskip) 4.0
+.....\hbox(0.0+0.0)x1.0, shifted 2.0
+.....\glue 3.0
+.....\hbox(0.0+0.0)x2.0
+.....\glue 2.0 plus 6.0
+.....\hbox(0.0+0.0)x2.0
+.....\penalty 10000
+.....\glue(\parfillskip) 0.0
+.....\glue(\rightskip) -1.0
+...\glue(\tabskip) 0.0 plus 40.0
+..\vbox(22.0+0.0)x13.0
+...\glue(\tabskip) 0.0 plus 40.0
+...\vbox(22.0+0.0)x13.0
+....\hbox(0.0+0.0)x13.0, glue set 0.8
+.....\glue(\leftskip) 4.0
+.....\hbox(0.0+0.0)x2.0
+.....\glue 2.0 plus 5.0 minus 1.0
+.....\hbox(0.0+0.0)x2.0
+.....\glue(\rightskip) -1.0
+....\penalty 125
+....\glue(\baselineskip) 20.0 plus 1.0
+....\hbox(0.0+2.0)x13.0
+.....\glue(\leftskip) 4.0
+.....\hbox(0.0+0.0)x1.0, shifted 2.0
+.....\glue 3.0
+.....\hbox(0.0+0.0)x2.0
+.....\glue 2.0 plus 6.0
+.....\hbox(0.0+0.0)x2.0
+.....\penalty 10000
+.....\glue(\parfillskip) 0.0
+.....\glue(\rightskip) -1.0
+...\glue(\tabskip) 0.0 plus 40.0
+..\glue 4.0 plus 2.0 minus 1.0
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\glue(\parskip) 0.0 plus 42.0 minus 8.0
+.\glue(\baselineskip) 2.0 plus 41.0
+.\hbox(8.0+2.0)x13.0
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x1.0
+..\hbox(0.0+0.0)x0.0
+..\hbox(0.0+0.0)x2.0, glue set -1.99255
+...\glue 0.0 plus -1.00374
+..\discretionary
+..\rule(*+*)x-2.0
+..\hbox(0.0+0.0)x2.0
+..\rip A (ligature AAA)
+..\kern2.0
+..\rip B
+..\glue(\rightskip) 0.0
+.\penalty 162
+.\glue(\baselineskip) 7.6 plus 41.0
+.\hbox(0.4+0.0)x13.0
+..\glue(\leftskip) 3.0
+..\rule(*+*)x-2.0
+..\hbox(0.0+0.0)x2.0
+..\rip C (ligature B-)
+..\vbox(0.4+0.0)x6.0
+...\rule(0.4+0.0)x6.0
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+
+Memory usage before: 990&376; after: 584&370; still untouched: 735
+{restoring \box254=void}
+{restoring \hoffset=0.0pt}
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{vertical mode: \looseness}
+{\uchyph}
+{\hsize}
+{the letter A}
+{horizontal mode: the letter A}
+{blank space }
+{the character /}
+{\vadjust}
+{internal vertical mode: \uchyph}
+{\ }
+{horizontal mode: \ }
+{the letter B}
+{end-group character }}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+\rip BBBBBB
+@\par via @@0 b=10000 p=-10000 d=100000782
+@\par via @@1 b=10000 p=-10000 d=100000000
+@@2: line 1.0- t=100000782 -> @@0
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 200--200
+ [] \rip BBBBBB
+
+\hbox(7.0+1.0)x100.0, glue set 41.5
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{restoring \uchyph=1}
+{restoring \looseness=-10}
+{\vadjust}
+{internal vertical mode: \ }
+{horizontal mode: \ }
+{\closeout}
+{the letter B}
+{end-group character }}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+[]\rip BB-
+@\discretionary via @@0 b=10000 p=88 d=100008526
+@\discretionary via @@1 b=10000 p=88 d=100007744
+@@2: line 1.0- t=100008526 -> @@0
+B-BBB
+@\discretionary via @@0 b=10000 p=88 d=100008526
+@\discretionary via @@1 b=10000 p=88 d=100007744
+@\discretionary via @@2 b=10000 p=88 d=100008744
+@@3: line 1.0- t=100008526 -> @@0
+@\par via @@0 b=10000 p=-10000 d=100000782
+@\par via @@1 b=10000 p=-10000 d=100000000
+@\par via @@2 b=10000 p=-10000 d=100100000
+@\par via @@3 b=10000 p=-10000 d=100100000
+@@4: line 1.0- t=100000782 -> @@0
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 201--201
+ [] []\rip BB-B-BBB
+
+\hbox(7.0+1.0)x100.0, glue set 41.5
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{restoring \looseness=-10}
+{begin-group character {}
+{\hyphenchar}
+{end-group character }}
+{\hyphenation}
+{\vadjust}
+{internal vertical mode: \ }
+{horizontal mode: \ }
+{the letter B}
+{\kern}
+{the letter B}
+{end-group character }}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+\rip BBBCBBB
+@\discretionary via @@0 b=10000 p=88 d=100008526
+@\discretionary via @@1 b=10000 p=88 d=100007744
+@@2: line 1.0- t=100008526 -> @@0
+B
+@\par via @@0 b=10000 p=-10000 d=100000782
+@\par via @@1 b=10000 p=-10000 d=100000000
+@\par via @@2 b=10000 p=-10000 d=100100000
+@@3: line 1.0- t=100000782 -> @@0
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 202--202
+ [] \rip BBBCBBBB
+
+\hbox(8.0+2.0)x100.0, glue set 40.0
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{restoring \looseness=-10}
+{\hyphenchar}
+{\vadjust}
+{internal vertical mode: \def}
+{\ }
+{horizontal mode: \ }
+{\pretolerance}
+{the letter B}
+
+\B ->B
+{end-group character }}
+@firstpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+\rip BBBBBB
+@\par via @@0 b=10000 p=-10000 d=100000782
+@\par via @@1 b=10000 p=-10000 d=100000000
+@@2: line 1.0- t=100000782 -> @@0
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 203--203
+ [] \rip BBBBBB
+
+\hbox(7.0+1.0)x100.0, glue set 41.5
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{restoring \pretolerance=0}
+{restoring \B=undefined}
+{restoring \looseness=-10}
+{blank space }
+{\par}
+@firstpass
+@secondpass
+[]\rip A
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+/AA-
+@\discretionary via @@0 b=10000 p=88 d=100008526
+@@2: line 1.0- t=100008526 -> @@0
+@\discretionary via @@1 b=10000 p=88 d=100007744
+@@3: line 2.0- t=200008526 -> @@1
+B-BBB
+@\discretionary via @@0 b=10000 p=88 d=100008526
+@@4: line 1.0- t=100008526 -> @@0
+@\discretionary via @@2 b=10000 p=88 d=100008744
+@\discretionary via @@1 b=10000 p=88 d=100007744
+@@5: line 2.0- t=200008526 -> @@1
+@\discretionary via @@3 b=10000 p=88 d=100008744
+@@6: line 3.0- t=300017270 -> @@3
+-
+@\discretionary via @@0 b=10000 p=88 d=100008526
+@@7: line 1.0- t=100008526 -> @@0
+@\discretionary via @@4 b=10000 p=88 d=100008744
+@\discretionary via @@2 b=10000 p=88 d=100008744
+@\discretionary via @@1 b=10000 p=88 d=100007744
+@@8: line 2.0- t=200008526 -> @@1
+@\discretionary via @@5 b=10000 p=88 d=100008744
+@\discretionary via @@3 b=10000 p=88 d=100008744
+@@9: line 3.0- t=300017270 -> @@3
+@\discretionary via @@6 b=10000 p=88 d=100008744
+@@10: line 4.0- t=400026014 -> @@6
+C-A
+@\discretionary via @@0 b=10000 p=88 d=100008526
+@@11: line 1.0- t=100008526 -> @@0
+@\discretionary via @@7 b=10000 p=88 d=100008744
+@\discretionary via @@4 b=10000 p=88 d=100008744
+@\discretionary via @@2 b=10000 p=88 d=100008744
+@\discretionary via @@1 b=10000 p=88 d=100007744
+@@12: line 2.0- t=200008526 -> @@1
+@\discretionary via @@8 b=10000 p=88 d=100008744
+@\discretionary via @@5 b=10000 p=88 d=100008744
+@\discretionary via @@3 b=10000 p=88 d=100008744
+@@13: line 3.0- t=300017270 -> @@3
+@\discretionary via @@9 b=10000 p=88 d=100008744
+@\discretionary via @@6 b=10000 p=88 d=100008744
+@@14: line 4.0- t=400026014 -> @@6
+@\discretionary via @@10 b=10000 p=88 d=100008744
+@@15: line 5.0- t=500034758 -> @@10
+CAC//[][][][]
+@\par via @@0 b=10000 p=-10000 d=100000782
+@@16: line 1.0- t=100000782 -> @@0
+@\par via @@11 b=10000 p=-10000 d=100100000
+@\par via @@7 b=10000 p=-10000 d=100100000
+@\par via @@4 b=10000 p=-10000 d=100100000
+@\par via @@2 b=10000 p=-10000 d=100100000
+@\par via @@1 b=10000 p=-10000 d=100000000
+@@17: line 2.0- t=200000782 -> @@1
+@\par via @@12 b=10000 p=-10000 d=100100000
+@\par via @@8 b=10000 p=-10000 d=100100000
+@\par via @@5 b=10000 p=-10000 d=100100000
+@\par via @@3 b=10000 p=-10000 d=100100000
+@@18: line 3.0- t=300108526 -> @@3
+@\par via @@13 b=10000 p=-10000 d=100100000
+@\par via @@9 b=10000 p=-10000 d=100100000
+@\par via @@6 b=10000 p=-10000 d=100100000
+@@19: line 4.0- t=400117270 -> @@6
+@\par via @@14 b=10000 p=-10000 d=100100000
+@\par via @@10 b=10000 p=-10000 d=100100000
+@@20: line 5.0- t=500126014 -> @@10
+@\par via @@15 b=10000 p=-10000 d=100100000
+@@21: line 6.0- t=600134758 -> @@15
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 195--204
+ []\rip A /AA-B-BBB-C-ACAC//
+
+\hbox(8.0+2.0)x100.0, glue set 33.53377
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+%% goal height=16383.99998, max depth=2.0
+{vertical mode: \hbox}
+{restricted horizontal mode: \sfcode}
+{the letter A}
+{blank space }
+{the letter a}
+{blank space }
+{end-group character }}
+{restoring \sfcode66=999}
+% t=55.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{vertical mode: \noindent}
+% t=64.0 plus 41.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{horizontal mode: \scriptscriptfont}
+{math shift character $}
+{display math mode: \eqno}
+{math mode: superscript character ^}
+{end-group character }}
+{math shift character $}
+! Math formula deleted: Insufficient extension fonts.
+l.206 $$\eqno^{}$
+ \scriptfont3=\rip\fontdimen2\smalltrip=0pt
+Sorry, but I can't typeset math unless \textfont 3
+and \scriptfont 3 and \scriptscriptfont 3 have all
+the \fontdimen values needed in math extension fonts.
+
+! Display math should end with $$.
+<to be read again>
+ \scriptfont
+l.206 $$\eqno^{}$\scriptfont
+ 3=\rip\fontdimen2\smalltrip=0pt
+The `$' that I just saw supposedly matches a previous `$$'.
+So I shall assume that you typed `$$' both times.
+
+{restoring \fam=-1}
+! Math formula deleted: Insufficient extension fonts.
+<to be read again>
+ \scriptfont
+l.206 $$\eqno^{}$\scriptfont
+ 3=\rip\fontdimen2\smalltrip=0pt
+Sorry, but I can't typeset math unless \textfont 3
+and \scriptfont 3 and \scriptscriptfont 3 have all
+the \fontdimen values needed in math extension fonts.
+
+{restoring \displayindent=0.0pt}
+{restoring \displaywidth=0.0pt}
+{restoring \predisplaysize=0.0pt}
+{restoring \fam=0}
+% t=66.0 plus 83.0 plus 1.0fil minus 8.0 g=16383.99998 b=0 p=0 c=0#
+% t=85.0 plus 210.0 plus 1.0fil minus 811.0 g=16383.99998 b=0 p=0 c=0#
+{horizontal mode: \scriptfont}
+{\fontdimen}
+{begin-group character {}
+{\rightskip}
+{\looseness}
+{\spaceskip}
+{the letter A}
+{\spacefactor}
+{\discretionary}
+{restricted horizontal mode: end-group character }}
+{\kern}
+{the character -}
+{end-group character }}
+{the letter B}
+{\kern}
+{end-group character }}
+{horizontal mode: blank space }
+{the letter C}
+{math shift character $}
+{math mode: blank space }
+{\scriptfont}
+{\mathsurround}
+{math shift character $}
+! Math formula deleted: Insufficient symbol fonts.
+<recently read> $
+
+l.210 \mathsurround143pt$
+ C $\mathsurround40pt$$\mathsurrou...
+Sorry, but I can't typeset math unless \textfont 2
+and \scriptfont 2 and \scriptscriptfont 2 have all
+the \fontdimen values needed in math symbol fonts.
+
+{restoring \mathsurround=0.0pt}
+{restoring \scriptfont2=\smalltrip}
+{restoring \fam=0}
+{horizontal mode: blank space }
+{the letter C}
+{blank space }
+{math shift character $}
+{math mode: \mathsurround}
+{math shift character $}
+{restoring \mathsurround=0.0pt}
+{restoring \fam=0}
+{horizontal mode: math shift character $}
+{math mode: \mathsurround}
+{\hbox}
+{restricted horizontal mode: math shift character $}
+{math mode: math shift character $}
+{restoring \fam=-1}
+{restricted horizontal mode: end-group character }}
+{math mode: math shift character $}
+{restoring \mathsurround=0.0pt}
+{restoring \fam=0}
+{horizontal mode: \par}
+! Infinite glue shrinkage found in a paragraph.
+l.210 ...round60pt\hbox{$$}$\par
+ }
+The paragraph just ended includes some glue that has
+infinite shrinkability, e.g., `\hskip 0pt minus 1fil'.
+Such glue doesn't belong there---it allows a paragraph
+of any length to fit on one line. But it's safe to proceed,
+since the offensive shrinkability has been made finite.
+
+@firstpass
+@secondpass
+\rip A-
+@\discretionary via @@0 b=76 p=89 d=13850
+@@1: line 4.1- t=13850 -> @@0
+
+@ via @@0 b=65 p=0 d=4356
+@@2: line 4.1 t=4356 -> @@0
+@ via @@1 b=91 p=0 d=8464
+@@3: line 5.1 t=22314 -> @@1
+C$$
+@\math via @@0 b=17 p=0 d=324
+@@4: line 4.3 t=324 -> @@0
+@\math via @@2 b=12 p=0 d=169
+@\math via @@1 b=9 p=0 d=100
+@@5: line 5.2 t=4525 -> @@2
+@\math via @@3 b=12 p=0 d=169
+@@6: line 6.2 t=22483 -> @@3
+ C
+@ via @@4 b=71 p=0 d=5966
+@@7: line 5.1 t=6290 -> @@4
+@ via @@5 b=71 p=0 d=5184
+@@8: line 6.1 t=9709 -> @@5
+@ via @@6 b=71 p=0 d=5184
+@@9: line 7.1 t=27667 -> @@6
+$$$[]$
+@\par via @@7 b=57 p=-10000 d=4146
+@@10: line 6.3- t=10436 -> @@7
+@\par via @@8 b=57 p=-10000 d=4146
+@@11: line 7.3- t=13855 -> @@8
+@\par via @@9 b=57 p=-10000 d=4146
+@@12: line 8.3- t=31813 -> @@9
+
+
+Loose \hbox (badness 76) in paragraph at lines 206--210
+ \rip A
+
+\hbox(7.0+1.0)x100.0, glue set 0.91347
+.\glue(\leftskip) 3.0
+.\rip A
+.etc.
+
+
+Loose \hbox (badness 91) in paragraph at lines 206--210
+ \rip -
+
+\hbox(0.0+0.0)x100.0, glue set 0.97116
+.\glue(\leftskip) 3.0
+.\kern 2.0
+.etc.
+
+
+Tight \hbox (badness 12) in paragraph at lines 206--210
+ \rip C$$
+
+\hbox(0.0+0.0)x100.0, glue set - 0.5
+.\glue(\leftskip) 3.0
+.\rip C
+.etc.
+
+
+Loose \hbox (badness 71) in paragraph at lines 206--210
+ \rip C
+
+\hbox(0.0+0.0)x100.0, glue set 0.89423
+.\glue(\leftskip) 3.0
+.\rip C
+.etc.
+
+
+Tight \hbox (badness 57) in paragraph at lines 206--210
+ []$
+
+\hbox(0.0+0.0)x100.0, glue set - 0.83
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x120.0 []
+.etc.
+
+% t=95.0 plus 251.0 plus 1.0fil minus 811.0 g=16383.99998 b=0 p=37 c=37
+% t=105.0 plus 292.0 plus 1.0fil minus 811.0 g=16383.99998 b=0 p=-125 c=
+-125#
+% t=115.0 plus 333.0 plus 1.0fil minus 811.0 g=16383.99998 b=0 p=-125 c=
+-125#
+% t=125.0 plus 374.0 plus 1.0fil minus 811.0 g=16383.99998 b=0 p=0 c=0
+{vertical mode: end-group character }}
+{restoring \spaceskip=0.0pt}
+{restoring \looseness=0}
+{restoring \rightskip=0.0pt}
+{blank space }
+{\uccode}
+{\font}
+{\input}
+! Font \mumble=mumble not loadable: Metric (TFM) file not found.
+<to be read again>
+ \relax
+...
+l.211 ...ont\mumble=mumble\input
+ tripos % "AAAAAAAAAA"+errors
+I wasn't able to read the size data for this font,
+so I will ignore the font specification.
+[Wizards can fix TFM files using TFtoPL/PLtoTF.]
+You might try inserting a different font spec;
+e.g., type `I\font<same font id>=<substitute font name>'.
+
+{\relax}
+{\input}
+(tripos.tex
+{\par}
+{\uppercase}
+{the character 0}
+% t=135.0 plus 415.0 plus 1.0fil minus 811.0 g=16383.99998 b=0 p=0 c=0
+{horizontal mode: the character 0}
+Missing character: There is no 0 in font trip!
+{begin-group character {}
+{\outputpenalty}
+! Missing number, treated as zero.
+<to be read again>
+ }
+l.2 ...case {0{\outputpenalty }}
+
+A number should have been here; I inserted `0'.
+(If you can't figure out why I needed to see a number,
+look up `weird error' in the index to The TeXbook.)
+
+{end-group character }}
+{restoring \outputpenalty=-22222}
+{blank space }
+{the character [}
+Missing character: There is no [ in font trip!
+{\uppercase}
+{the letter A}
+Missing character: There is no [ in font trip!
+{blank space }
+)
+{\par}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+\rip AAAAAAAAAA
+@\par via @@0 b=10000 p=-10000 d=100000782
+@\par via @@1 b=10000 p=-10000 d=100000000
+@@2: line 1.0- t=100000782 -> @@0
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 2--212
+ [] \rip AAAAAAAAAA
+
+\hbox(7.0+1.0)x100.0, glue set 45.5
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{vertical mode: \penalty}
+% t=145.0 plus 498.0 plus 1.0fil minus 819.0 g=16383.99998 b=0 p=-33333
+c=-33333#
+\output->{\tracingcommands 0\showthe \outputpenalty \showboxbreadth 9999
+ \showboxdepth 9999 \hoffset 1sp {\setbox 254=\box 255\shipout \ifvbox 2
+\ifhbox 254 \error \fi 54\copy 25\fi 4} \ifvoid 254\relax \else \error \
+fi }
+{internal vertical mode: \tracingcommands}
+> -33333.
+<output> ...wthe \outputpenalty
+ \showboxbreadth 9999 \showbox...
+l.212 \par\penalty-33333
+ % end hyphenation, math is next
+
+
+Completed box being shipped out [-2.0.0.0.11]
+\vbox(16383.99998+1.0)x100.0, glue set 16239.0fil
+.\glue(\topskip) 12.0 plus 1.0fil
+.\hbox(8.0+2.0)x100.0, glue set 33.53377
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x0.0
+..\rip A
+..\glue 4.0 plus 1.99799 minus 1.00099
+..\rip /
+..\kern1.0
+..\discretionary replacing 2
+...\rip A (ligature AA)
+...\kern3.0
+...\rip -
+..\rip A (ligature AA)
+..\kern2.0
+..\discretionary replacing 3
+...\rip C (ligature B-)
+..|\rip A (ligature BB)
+..|\kern2.0
+..|\rip B
+..|\kern4.0
+..\rip A (ligature BB)
+..\kern2.0
+..\rip A (ligature BB)
+..\discretionary
+...\rip -
+..\discretionary replacing 1
+...\rip C
+...\rip -
+..|\rip A
+..\rip ^^82 (ligature CA)
+..\rip ^^82 (ligature CA)
+..\rip B (ligature C/)
+..\rip /
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\hbox(7.0+1.0)x100.0, glue set 41.5
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x0.0
+..\glue 4.0 plus 2.0 minus 1.0
+..\rip A (ligature BB)
+..\kern2.0
+..\rip A (ligature BB)
+..\kern2.0
+..\rip A (ligature BB)
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\hbox(7.0+1.0)x100.0, glue set 41.5
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x0.0
+..\glue 4.0 plus 2.0 minus 1.0
+..\closeout1
+..\discretionary replacing 2
+...\rip A (ligature BB)
+...\kern3.0
+...\rip -
+..\rip A (ligature BB)
+..\kern2.0
+..\discretionary replacing 3
+...\rip C (ligature B-)
+..|\rip A (ligature BB)
+..|\kern2.0
+..|\rip B
+..\rip A (ligature BB)
+..\kern2.0
+..\rip A (ligature BB)
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\hbox(8.0+2.0)x100.0, glue set 40.0
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x0.0
+..\glue 4.0 plus 2.0 minus 1.0
+..\rip A (ligature BB)
+..\kern2.0
+..\discretionary replacing 3
+...\rip B
+...\kern4.0
+...\rip C
+..|\rip A (ligature BB)
+..|\kern2.0
+..|\rip B
+..\rip A (ligature BB)
+..\kern2.0
+..\rip A (ligature BB)
+..\kern 0.0
+..\rip B
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\hbox(7.0+1.0)x100.0, glue set 41.5
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x0.0
+..\glue 4.0 plus 2.0 minus 1.0
+..\rip A (ligature BB)
+..\kern2.0
+..\rip A (ligature BB)
+..\kern2.0
+..\rip A (ligature BB)
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\glue(\baselineskip) 0.0 plus 41.0
+.\hbox(8.0+2.0)x20.0
+..\rip A
+..\kern2.0
+..\rip B
+..\glue 4.0 plus 2.0 minus 1.0
+..\rip a
+..\rip B
+..\glue 4.0 plus 2.46799 minus 0.81036
+.\glue(\parskip) 0.0 plus 42.0 minus 8.0
+.\penalty 0
+.\glue(\abovedisplayshortskip) 1.0 plus 45.0 minus 803.0
+.\glue(\baselineskip) 8.0 plus 41.0
+.\hbox(0.0+0.0)x0.0, shifted 50.0
+.\penalty 10000
+.\glue(\baselineskip) 10.0 plus 41.0
+.\hbox(0.0+0.0)x0.0, shifted 100.0
+.\penalty 0
+.\glue(\baselineskip) 3.0 plus 41.0
+.\hbox(7.0+1.0)x100.0, glue set 0.91347
+..\glue(\leftskip) 3.0
+..\rip A
+..\discretionary
+..\glue(\rightskip) 0.0 plus 104.0 minus 100.0
+.\penalty 37
+.\glue(\baselineskip) 9.0 plus 41.0
+.\hbox(0.0+0.0)x100.0, glue set 0.97116
+..\glue(\leftskip) 3.0
+..\kern 2.0
+..\kern-1.00002
+..\rip -
+..\glue(\rightskip) 0.0 plus 104.0 minus 100.0
+.\penalty -125
+.\glue(\baselineskip) 10.0 plus 41.0
+.\hbox(0.0+0.0)x100.0, glue set - 0.5
+..\glue(\leftskip) 3.0
+..\rip C
+..\mathon, surrounded 143.0
+..\mathoff
+..\glue(\rightskip) 0.0 plus 104.0 minus 100.0
+.\penalty -125
+.\glue(\baselineskip) 10.0 plus 41.0
+.\hbox(0.0+0.0)x100.0, glue set 0.89423
+..\glue(\leftskip) 3.0
+..\rip C
+..\glue(\rightskip) 0.0 plus 104.0 minus 100.0
+.\glue(\baselineskip) 10.0 plus 41.0
+.\hbox(0.0+0.0)x100.0, glue set - 0.83
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x120.0
+...\mathon, surrounded 60.0
+...\mathoff, surrounded 60.0
+..\mathoff, surrounded 60.0
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0 plus 104.0 minus 100.0
+.\glue(\parskip) 0.0 plus 42.0 minus 8.0
+.\glue(\baselineskip) 3.0 plus 41.0
+.\hbox(7.0+1.0)x100.0, glue set 45.5
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x0.0
+..\glue 4.0 plus 2.0 minus 1.0
+..\rip A (ligature AAAAAAAAAA)
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+
+Memory usage before: 950&531; after: 546&448; still untouched: 706
+{restoring \box254=void}
+{restoring \hoffset=0.0pt}
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{vertical mode: begin-group character {}
+{\catcode}
+{\font}
+! Improper `at' size (0.0pt), replaced by 10pt.
+<to be read again>
+ \font
+l.213 ... \font?xyzzy at0pt\font
+ ? xyzzy scaled1?} % nonexistent
+I can only handle fonts at positive sizes that are
+less than 2048pt, so I've changed what you said to 10pt.
+
+! Font ?=xyzzy at 10.0pt not loadable: Metric (TFM) file not found.
+<to be read again>
+ \font
+l.213 ... \font?xyzzy at0pt\font
+ ? xyzzy scaled1?} % nonexistent
+I wasn't able to read the size data for this font,
+so I will ignore the font specification.
+[Wizards can fix TFM files using TFtoPL/PLtoTF.]
+You might try inserting a different font spec;
+e.g., type `I\font<same font id>=<substitute font name>'.
+
+{\font}
+! Font ?=xyzzy scaled 1 not loadable: Metric (TFM) file not found.
+<to be read again>
+ ?
+l.213 ...t\font ? xyzzy scaled1?
+ } % nonexistent
+I wasn't able to read the size data for this font,
+so I will ignore the font specification.
+[Wizards can fix TFM files using TFtoPL/PLtoTF.]
+You might try inserting a different font spec;
+e.g., type `I\font<same font id>=<substitute font name>'.
+
+{select font nullfont}
+{end-group character }}
+{restoring current font=\rip}
+{restoring ?=undefined}
+{restoring \catcode63=12}
+{blank space }
+{\font}
+{\font}
+! Improper `at' size (-10.0pt), replaced by 10pt.
+l.215 \font\ip trip at -10pt
+ % through the looking glass
+I can only handle fonts at positive sizes that are
+less than 2048pt, so I've changed what you said to 10pt.
+
+{\showthe}
+! You can't use `math shift character $' after \the.
+l.216 \showthe$
+
+I'm forgetting what you said and using zero instead.
+
+> 0.
+l.216 \showthe$
+
+
+{blank space }
+{\showthe}
+> \ip .
+<recently read> \font
+
+l.217 \showthe\font
+
+
+{\message}
+{\fontname}
+trip
+{blank space }
+{select font trip}
+{\textfont}
+{\scriptfont}
+{\scriptscriptfont}
+{\def}
+{blank space }
+{begin-group character {}
+{\tracingmacros}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{\global}
+{end-group character }}
+{restoring \tracingmacros=4}
+{blank space }
+{\mathcode}
+{\mathcode}
+{\delcode}
+{\catcode}
+{\catcode}
+{\mathcode}
+{\mathcode}
+{\def}
+{begin-group character {}
+{\catcode}
+{\global}
+{end-group character }}
+{restoring \catcode122=11}
+{blank space }
+{\parshape}
+
+\a ->1pt 11.0pt2pt 12.0pt3pt 13.0pt4pt 14.0pt5pt 15.0pt6pt 16.0pt7pt 17.
+0pt8pt 18.0pt9pt 19.0pt10pt 20.0pt
+{\chardef}
+{\hangindent}
+{\hangafter}
+{\begingroup}
+{\looseness}
+{\rightskip}
+{\-}
+{horizontal mode: \-}
+{the character -}
+{\-}
+{the character -}
+{\-}
+{blank space }
+{math shift character $}
+@firstpass
+[]\ip -
+@\discretionary via @@0 b=0 p=88 d=7745
+@@1: line 1.2- t=7745 -> @@0
+-
+@\discretionary via @@0 b=0 p=89 d=7922
+@@2: line 1.2- t=7922 -> @@0
+@\discretionary via @@1 b=0 p=89 d=8922
+@@3: line 2.2- t=16667 -> @@1
+-
+@\discretionary via @@0 b=0 p=88 d=7745
+@@4: line 1.2- t=7745 -> @@0
+@\discretionary via @@2 b=0 p=88 d=8745
+@\discretionary via @@1 b=0 p=88 d=8745
+@@5: line 2.2- t=16490 -> @@1
+@\discretionary via @@3 b=0 p=88 d=8745
+@@6: line 3.2- t=25412 -> @@3
+-
+-
+@\discretionary via @@0 b=0 p=89 d=7922
+@@7: line 1.2- t=7922 -> @@0
+@\discretionary via @@4 b=0 p=89 d=8922
+@\discretionary via @@2 b=0 p=89 d=8922
+@\discretionary via @@1 b=0 p=89 d=8922
+@@8: line 2.2- t=16667 -> @@1
+@\discretionary via @@5 b=0 p=89 d=8922
+@\discretionary via @@3 b=0 p=89 d=8922
+@@9: line 3.2- t=25412 -> @@5
+@\discretionary via @@6 b=0 p=89 d=8922
+@@10: line 4.2- t=34334 -> @@6
+A-
+@\discretionary via @@0 b=0 p=88 d=7745
+@@11: line 1.2- t=7745 -> @@0
+@\discretionary via @@7 b=0 p=88 d=8745
+@\discretionary via @@4 b=0 p=88 d=8745
+@\discretionary via @@2 b=0 p=88 d=8745
+@\discretionary via @@1 b=0 p=88 d=8745
+@@12: line 2.2- t=16490 -> @@1
+@\discretionary via @@8 b=0 p=88 d=8745
+@\discretionary via @@5 b=0 p=88 d=8745
+@\discretionary via @@3 b=0 p=88 d=8745
+@@13: line 3.2- t=25235 -> @@5
+@\discretionary via @@9 b=0 p=88 d=8745
+@\discretionary via @@6 b=0 p=88 d=8745
+@@14: line 4.2- t=34157 -> @@6
+@\discretionary via @@10 b=0 p=88 d=8745
+@@15: line 5.2- t=43079 -> @@10
+@\par via @@0 b=0 p=-10000 d=1
+@@16: line 1.2- t=1 -> @@0
+@\par via @@11 b=0 p=-10000 d=100001
+@\par via @@7 b=0 p=-10000 d=100001
+@\par via @@4 b=0 p=-10000 d=100001
+@\par via @@2 b=0 p=-10000 d=100001
+@\par via @@1 b=0 p=-10000 d=100001
+@@17: line 2.2- t=107746 -> @@1
+@\par via @@12 b=0 p=-10000 d=100001
+@\par via @@8 b=0 p=-10000 d=100001
+@\par via @@5 b=0 p=-10000 d=100001
+@\par via @@3 b=0 p=-10000 d=100001
+@@18: line 3.2- t=116491 -> @@5
+@\par via @@13 b=0 p=-10000 d=100001
+@\par via @@9 b=0 p=-10000 d=100001
+@\par via @@6 b=0 p=-10000 d=100001
+@@19: line 4.2- t=125236 -> @@13
+@\par via @@14 b=0 p=-10000 d=100001
+@\par via @@10 b=0 p=-10000 d=100001
+@@20: line 5.2- t=134158 -> @@14
+@\par via @@15 b=0 p=-10000 d=100001
+@@21: line 6.2- t=143080 -> @@15
+
+%% goal height=16383.99998, max depth=2.0
+% t=20.0 plus 1.0fil g=16383.99998 b=0 p=37 c=37#
+% t=30.0 plus 41.0 plus 1.0fil g=16383.99998 b=0 p=-213 c=-213#
+{display math mode: \number}
+{\the}
+! Improper alphabetic constant.
+<to be read again>
+ \relax
+l.249 ...mber\the\delcode`\relax
+ \over{{{}}}}\pagestretch=-1\p...
+A one-character control sequence belongs after a ` mark.
+So I'm essentially inserting \0 here.
+
+{the character -}
+{the character 1}
+{\relax}
+{\over}
+{begin-group character {}
+{math mode: begin-group character {}
+{begin-group character {}
+{end-group character }}
+{end-group character }}
+{end-group character }}
+{display math mode: end-group character }}
+! Extra }, or forgotten $.
+l.249 ...code`\relax\over{{{}}}}
+ \pagestretch=-1\pagetotal\sho...
+I've deleted a group-closing symbol because it seems to be
+spurious, as in `$x}$'. But perhaps the } is legitimate and
+you forgot something else, as in `\hbox{$x}'. In such cases
+the way to recover is to insert both the forgotten and the
+deleted material, e.g., by typing `I$}'.
+
+{\pagestretch}
+{\showlists}
+
+### display math mode entered at line 249
+\mathord
+.{}
+this will be denominator of:
+\fraction, thickness = default
+\\mathord []
+\\mathord []
+### vertical mode entered at line 0
+### current page:
+\glue(\topskip) 20.0 plus 1.0fil
+\hbox(0.0+0.0)x11.0, glue set 1.3fil, shifted 1.0
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+etc.
+total height 40.0 plus -40.0 plus 1.0fil
+ goal height 16383.99998
+prevdepth 1.0, prevgraf 3 lines
+
+! OK.
+l.249 ...=-1\pagetotal\showlists
+
+
+{\begingroup}
+{\halign}
+! Missing \endgroup inserted.
+<inserted text>
+ \endgroup
+...
+l.250 \begingroup\halign
+ to\the\displaywidth{#&#\crcr\crcr\cr...
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{\endgroup}
+{\halign}
+! Improper \halign inside $$'s.
+<recently read> \halign
+
+l.250 \begingroup\halign
+ to\the\displaywidth{#&#\crcr\crcr\cr...
+Displays can use special alignments (like \eqalignno)
+only if nothing but the alignment itself is between $$'s.
+So I've deleted the formulas that preceded this alignment.
+
+{internal vertical mode: \the}
+{restricted horizontal mode: end of alignment template}
+
+Loose \hbox (badness 1) in alignment at lines 250--250
+ [] []
+
+\hbox(0.0+0.0)x15.0, glue set 0.1875
+.\glue(\tabskip) 0.0 plus 40.0
+.\unsetbox(0.0+0.0)x0.0
+.etc.
+
+! Missing number, treated as zero.
+<to be read again>
+ =
+l.253 ...aysize* \global\setbox=
+
+A number should have been here; I inserted `0'.
+(If you can't figure out why I needed to see a number,
+look up `weird error' in the index to The TeXbook.)
+
+! Improper \setbox.
+<recently read> =
+
+l.253 ...aysize* \global\setbox=
+
+Sorry, \setbox is not allowed after \halign in a display,
+or between \accent and an accented character.
+
+! Missing $$ inserted.
+<to be read again>
+ \eqno
+l.254 \eqno
+ % another error (actually causes two error messag...
+Displays can use special alignments (like \eqalignno)
+only if nothing but the alignment itself is between $$'s.
+
+{restoring \predisplaypenalty=0}
+{restoring \displayindent=0.0pt}
+{restoring \displaywidth=0.0pt}
+{restoring \predisplaysize=0.0pt}
+{restoring \fam=0}
+% t=40.0 plus -40.0 plus 1.0fil g=16383.99998 b=0 p=101 c=101
+% t=53.0 plus 1.0 plus 1.0fil g=16383.99998 b=0 p=-1179647 c=-1179647#
+\output->{\tracingcommands 0\showthe \outputpenalty \showboxbreadth 9999
+ \showboxdepth 9999 \hoffset 1sp {\setbox 254=\box 255\shipout \ifvbox 2
+\ifhbox 254 \error \fi 54\copy 25\fi 4} \ifvoid 254\relax \else \error \
+fi }
+{internal vertical mode: \tracingcommands}
+> -1179647.
+<output> ...wthe \outputpenalty
+ \showboxbreadth 9999 \showbox...
+...
+l.254 \eqno
+ % another error (actually causes two error messag...
+
+
+Completed box being shipped out [-2.0.0.0.11.0.327680]
+\vbox(16383.99998+0.0)x20.0, glue set 16331.0fil
+.\glue(\topskip) 20.0 plus 1.0fil
+.\hbox(0.0+0.0)x11.0, glue set 1.3fil, shifted 1.0
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x0.0
+..\discretionary
+..\ip -
+..\glue(\rightskip) 0.0 plus 10.0fil minus 0.00002
+.\penalty 37
+.\glue(\baselineskip) 10.0 plus 41.0
+.\hbox(0.0+0.0)x12.0, glue set 2.0fil, shifted 2.0
+..\glue(\leftskip) 3.0
+..\kern-1.00002
+..\ip -
+..\discretionary
+..\discretionary
+..\ip -
+..\glue(\rightskip) 0.0 plus 10.0fil minus 0.00002
+.\penalty -213
+.\glue(\baselineskip) 3.0 plus 41.0
+.\hbox(7.0+1.0)x13.0, glue set 1.8fil, shifted 3.0
+..\glue(\leftskip) 3.0
+..\kern-1.00002
+..\ip - (ligature -
+)
+..\ip -
+..\discretionary
+..\kern1.0
+..\ip A
+..\discretionary
+...\ip -
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0 plus 10.0fil minus 0.00002
+.\penalty 101
+.\glue(\abovedisplayskip) 3.0
+.\glue(\baselineskip) 9.0 plus 41.0
+.\hbox(0.0+0.0)x15.0, glue set 0.1875, shifted 5.0
+..\glue(\tabskip) 0.0 plus 40.0
+..\hbox(0.0+0.0)x0.0
+..\glue(\tabskip) 0.0 plus 40.0
+
+Memory usage before: 339&413; after: 236&405; still untouched: 706
+{restoring \box254=void}
+{restoring \hoffset=0.0pt}
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{restoring \parshape=10}
+{restoring \hangafter=-12}
+{restoring \hangindent=-10.0pt}
+{restoring \looseness=2}
+{horizontal mode: \eqno}
+! You can't use `\eqno' in horizontal mode.
+<recently read> \eqno
+
+l.254 \eqno
+ % another error (actually causes two error messag...
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+{\looseness}
+{math shift character $}
+{math mode: \right}
+! Missing delimiter (. inserted).
+<to be read again>
+ \mathchardef
+l.256 $\right\relax\mathchardef
+ \minus="322D % locally \minus ...
+I was expecting to see something like `(' or `\{' or
+`\}' here. If you typed, e.g., `{' instead of `\{', you
+should probably delete the `{' by typing `1' now, so that
+braces don't get unbalanced. Otherwise just proceed.
+Acceptable delimiters are characters whose \delcode is
+nonnegative, or you can use `\delimiter <delimiter code>'.
+
+! Extra \right.
+<to be read again>
+ \mathchardef
+l.256 $\right\relax\mathchardef
+ \minus="322D % locally \minus ...
+I'm ignoring a \right that had no matching \left.
+
+{\mathchardef}
+{\left}
+{the letter A}
+{\over}
+{the letter A}
+{\abovewithdelims}
+! Missing delimiter (. inserted).
+<to be read again>
+ ?
+l.257 ...ver A\abovewithdelims.?
+ \right(+\mskip1A\minus=A+\pen...
+I was expecting to see something like `(' or `\{' or
+`\}' here. If you typed, e.g., `{' instead of `\{', you
+should probably delete the `{' by typing `1' now, so that
+braces don't get unbalanced. Otherwise just proceed.
+Acceptable delimiters are characters whose \delcode is
+nonnegative, or you can use `\delimiter <delimiter code>'.
+
+! Missing number, treated as zero.
+<to be read again>
+ ?
+l.257 ...ver A\abovewithdelims.?
+ \right(+\mskip1A\minus=A+\pen...
+A number should have been here; I inserted `0'.
+(If you can't figure out why I needed to see a number,
+look up `weird error' in the index to The TeXbook.)
+
+! Illegal unit of measure (pt inserted).
+<to be read again>
+ ?
+l.257 ...ver A\abovewithdelims.?
+ \right(+\mskip1A\minus=A+\pen...
+Dimensions can be in units of em, ex, in, pt, pc,
+cm, mm, dd, cc, bp, or sp; but yours is a new one!
+I'll assume that you meant to say pt, for printer's points.
+To recover gracefully from this error, it's best to
+delete the erroneous units; e.g., type `2' to delete
+two letters. (See Chapter 27 of The TeXbook.)
+
+! Ambiguous; you need another { and }.
+<to be read again>
+ ?
+l.257 ...ver A\abovewithdelims.?
+ \right(+\mskip1A\minus=A+\pen...
+I'm ignoring this fraction specification, since I don't
+know whether a construction like `x \over y \over z'
+means `{x \over y} \over z' or `x \over {y \over z}'.
+
+{the character ?}
+{\right}
+
+(->\delimiter "4162362
+{the character +}
+{\mskip}
+! Illegal unit of measure (mu inserted).
+<to be read again>
+ A
+l.257 ...elims.?\right(+\mskip1A
+ \minus=A+\penalty+1000A
+The unit of measurement in math glue must be mu.
+To recover gracefully from this error, it's best to
+delete the erroneous units; e.g., type `2' to delete
+two letters. (See Chapter 27 of The TeXbook.)
+
+{the letter A}
+{\mathchar"322D}
+{the character =}
+{the letter A}
+{the character +}
+{\penalty}
+{the letter A}
+{blank space }
+{\relpenalty}
+{\binoppenalty}
+{\mathsurround}
+{math shift character $}
+! \scriptfont 0 is undefined (character ?).
+<recently read> $
+
+l.260 \mathsurround.11em$
+ \x % this formula goes on line 7
+Somewhere in the math formula just ended, you used the
+stated character from an undefined font family. For example,
+plain TeX doesn't allow \it or \sl in subscripts. Proceed,
+and I'll try to forget that I needed that character.
+
+{restoring \mathsurround=0.0pt}
+{restoring \binoppenalty=0}
+{restoring \relpenalty=0}
+{restoring \minus=\mathchar"232D}
+{restoring \fam=0}
+{horizontal mode: \char"C8}
+Missing character: There is no ^^c8 in font trip!
+{math shift character $}
+@firstpass
+$[] \ip /
+@\penalty via @@0 b=0 p=-3333 d=-11108888
+@@1: line 7.2 t=-11108888 -> @@0
+ A \smalltrip --
+@\penalty via @@0 b=0 p=-2222 d=-4937283
+@@2: line 7.2 t=-4937283 -> @@0
+@\penalty via @@1 b=0 p=-2222 d=-4937283
+@@3: line 8.2 t=-16046171 -> @@1
+ \ip A /
+@\penalty via @@0 b=0 p=1000 d=1000001
+@@4: line 7.2 t=1000001 -> @@0
+@\penalty via @@2 b=0 p=1000 d=1000001
+@\penalty via @@1 b=0 p=1000 d=1000001
+@@5: line 8.2 t=-10108887 -> @@1
+@\penalty via @@3 b=0 p=1000 d=1000001
+@@6: line 9.2 t=-15046170 -> @@3
+ A$
+@\par via @@0 b=0 p=-10000 d=1
+@@7: line 7.2- t=1 -> @@0
+@\par via @@4 b=0 p=-10000 d=1
+@\par via @@2 b=0 p=-10000 d=1
+@\par via @@1 b=0 p=-10000 d=1
+@@8: line 8.2- t=-11108887 -> @@1
+@\par via @@5 b=0 p=-10000 d=1
+@\par via @@3 b=0 p=-10000 d=1
+@@9: line 9.2- t=-16046170 -> @@3
+@\par via @@6 b=0 p=-10000 d=1
+@@10: line 10.2- t=-15046169 -> @@6
+
+%% goal height=16383.99998, max depth=2.0
+{display math mode: blank space }
+{\vadjust}
+{internal vertical mode: \penalty}
+{end-group character }}
+{restoring \parshape=10}
+{restoring \hangafter=-12}
+{restoring \hangindent=-10.0pt}
+{restoring \looseness=-2}
+{display math mode: \mkern}
+{\the}
+{the character 7}
+{\prevgraf}
+{\insert}
+! You can't \insert255.
+<to be read again>
+ {
+l.262 ...\prevgraf=8 \insert255{
+ \penalty999}
+I'm changing to \insert0; box 255 is special.
+
+{internal vertical mode: \penalty}
+{end-group character }}
+{restoring \parshape=10}
+{restoring \hangafter=-12}
+{restoring \hangindent=-10.0pt}
+{restoring \looseness=-2}
+{display math mode: blank space }
+{\char"C8}
+{\vcenter}
+{internal vertical mode: end-group character }}
+{restoring \parshape=10}
+{restoring \hangafter=-12}
+{restoring \hangindent=-10.0pt}
+{restoring \looseness=-2}
+{display math mode: blank space }
+{begin-group character {}
+{math mode: \mathaccent}
+{the letter A}
+{end-group character }}
+{end-group character }}
+{display math mode: subscript character |}
+{blank space }
+{superscript character ^}
+{math mode: \raise}
+{restricted horizontal mode: the letter a}
+{end-group character }}
+{math mode: \displaystyle}
+{\char}
+{\textstyle}
+{end-group character }}
+{display math mode: blank space }
+{\overline}
+{math mode: superscript character ^}
+{blank space }
+{the letter A}
+{subscript character |}
+{\mathinner}
+{end-group character }}
+{superscript character ^}
+{the letter A}
+{blank space }
+{\mathchar}
+{\char}
+{subscript character ^^A}
+{\mathaccent}
+{\mathop}
+{blank space }
+{\mathbin}
+{blank space }
+{\mathopen}
+{blank space }
+{\mathpunct}
+{\mathclose}
+{blank space }
+{\mathrel}
+{blank space }
+{\global}
+{\mathaccent}
+{\fam}
+{the letter A}
+{the character 9}
+{\the}
+! Bad number (-1).
+<to be read again>
+ }
+l.269 ...the\scriptscriptfont-1}
+ }}}}
+Since I expected to read a number between 0 and 15,
+I changed this one to zero.
+
+{select font trip}
+{end-group character }}
+{restoring current font=\ip}
+{restoring \fam=-1}
+{end-group character }}
+{end-group character }}
+{end-group character }}
+{end-group character }}
+{display math mode: blank space }
+{\mathop}
+{superscript character ^}
+{\mathop}
+{\nolimits}
+{\limits}
+{subscript character |}
+{blank space }
+{\mathord}
+! Missing { inserted.
+<to be read again>
+ \radical
+l.272 \mathord \radical
+ "161 % missing { will be inserted
+A left brace was mandatory here, so I've put one in.
+You might want to delete and/or insert some corrections
+so that I will find a matching right brace soon.
+(If you're confused by all this, try typing `I}' now.)
+
+{math mode: \radical}
+{\textstyle}
+{\radical}
+{\left}
+
+(->\delimiter "4162362
+{\scriptscriptstyle}
+{\mathop}
+{\underline}
+{blank space }
+{the letter A}
+{\atop}
+{\displaystyle}
+{the letter A}
+{subscript character |}
+{the letter A}
+{\hfil}
+{\over}
+{the letter B}
+{\nonscript}
+{\kern}
+{end-group character }}
+{superscript character ^}
+{end-group character }}
+{end-group character }}
+{blank space }
+{\nolimits}
+{subscript character |}
+{\mathop}
+{\nonscript}
+{\textstyle}
+{\nonscript}
+{\mskip}
+{\showthe}
+> 9.0mu minus 1.0fil.
+l.276 \showthe\lastskip
+ B\abovewithdelims(.2pt\displa...
+
+{the letter B}
+{\abovewithdelims}
+
+(->\delimiter "4162362
+{\displaylimits}
+! Limit controls must follow a math operator.
+<recently read> \displaylimits
+
+l.276 ...lims(.2pt\displaylimits
+ }^z
+I'm ignoring this misplaced \limits or \nolimits command.
+
+{end-group character }}
+{superscript character ^}
+
+z->\delimiter "4162362
+{blank space }
+{\discretionary}
+{restricted horizontal mode: \showthe}
+> 1000.
+l.277 ...ry{\showthe\spacefactor
+ -}{\smalltrip A\hss}{\smalltr...
+
+{the character -}
+{end-group character }}
+{select font trip at 5.0pt}
+{the letter A}
+{\hss}
+{end-group character }}
+{restoring current font=\ip}
+! Improper discretionary list.
+l.277 ...tor-}{\smalltrip A\hss}
+ {\smalltrip A}
+Discretionary lists must contain only boxes and kerns.
+
+The following discretionary sublist has been deleted:
+\glue 0.0 plus 1.0fil minus 1.0fil
+
+{select font trip at 5.0pt}
+{the letter A}
+{end-group character }}
+{restoring current font=\ip}
+! Illegal math \discretionary.
+l.277 ...ip A\hss}{\smalltrip A}
+
+Sorry: The third part of a discretionary break must be
+empty, in math formulas. I had to delete your third part.
+
+{math mode: blank space }
+{\right}
+{the letter A}
+{end-group character }}
+{end-group character }}
+{end-group character }}
+{display math mode: blank space }
+{\let}
+{\aftergroup}
+{\eqno}
+{math mode: \aftergroup}
+{\scriptstyle}
+{\mathchar"232D}
+
+(->\delimiter "4162362
+{\delimiter}
+{\mathpunct}
+{the letter A}
+{the letter A}
+{end-group character }}
+{blank space }
+{subscript character |}
+{the letter B}
+{\fam}
+{the character -}
+{end-group character }}
+{restoring \fam=-1}
+{superscript character ^}
+{\hbox}
+{restricted horizontal mode: the letter A}
+{end-group character }}
+{math mode: end-group character }}
+{begin-group character {}
+{\above}
+{begin-group character {}
+{the letter v}
+{\overwithdelims}
+{blank space }
+{\displaystyle}
+{begin-group character {}
+{the letter p}
+{the letter q}
+{\atopwithdelims}
+
+(->\delimiter "4162362
+
+(->\delimiter "4162362
+{\vrule}
+{end-group character }}
+{end-group character }}
+{blank space }
+{\show}
+> \penalty=\mathchar"232D.
+l.284 \show\penalty
+ \showlonglists
+
+
+\showlonglists ->{\tracingcommands 0\pagefillstretch -1\dimen 100 \showb
+oxbreadth 9999 \showboxdepth 9999 \showlists \pagegoal =10000pt}
+{begin-group character {}
+{\tracingcommands}
+
+### math mode entered at line 284
+### math mode entered at line 282
+\mathord
+.\fraction, thickness = default
+.\\mathord
+.\.\fam1 v
+./\displaystyle
+./\mathord
+./.\fraction, thickness 0.0, left-delimiter "162362, right-delimiter "16
+2362
+./.\\mathord
+./.\.\fam1 p
+./.\\mathrel
+./.\.\fam1 q
+././\rule(9.0+*)x0.4
+\mathord
+this will be denominator of:
+\fraction, thickness 9.0
+\{}
+### math mode entered at line 280
+\scriptstyle
+\mathbin
+.\fam3 -
+\mathopen
+.\fam1 b
+\mathpunct
+.\mathord
+..\fam1 A
+.\mathord
+..\fam1 A
+^\hbox(7.0+1.0)x2.0
+^.\ip A
+_\mathord
+_.\fam1 B
+_\mathord
+_.\fam0 -
+\mathord
+### display math mode entered at line 261
+\vadjust
+.\penalty 7
+\mkern-9.0mu
+\mathord
+.\fam0 7
+\insert0, natural size 0.0; split(1.0 plus 43.0,-2.0); float cost 100
+.\penalty 999
+\mathord
+.\fam0 ^^c8
+\vcenter
+.\vbox(-2.0+0.0)x0.0
+\accent\fam3 -
+.\fam1 A
+^\mathord
+^.\hbox(7.0+1.0)x2.0, shifted -2.0
+^..\ip a
+^\displaystyle
+^\mathbin
+^.\fam1 /
+^\textstyle
+_\fam0 -
+\overline
+.\mathord
+.^\fam1 A
+.\mathord
+..\fam1 A
+._\fam3 -
+.\mathinner
+..{}
+.^\mathord
+.^.\fam1 A
+.^\mathord
+.^.\fam1 A
+.^\mathord
+.^.\fam1 B
+.^_\accent\fam1 a
+.^_.\mathop
+.^_..\fam1 A
+.^_.\mathbin
+.^_..\fam1 A
+.^_.\mathopen
+.^_..\fam1 A
+.^_.\mathpunct
+.^_..\fam1 A
+.^_.\mathclose
+.^_..\fam1 A
+.^_.\mathrel
+.^_..\fam1 A
+.^_.\accent\fam1 a
+.^_..\mathord
+.^_...\fam13 A
+.^_..\mathord
+.^_...\fam13 9
+\mathop
+.\fam1 B
+^\fam1 C
+\mathop\limits
+.\fam1 b
+_\fam1 C
+\mathord
+.\radical"161
+..\textstyle
+..\radical"282382
+...\mathinner
+....\left"162362
+....\scriptscriptstyle
+....\mathop\nolimits
+.....\underline
+......\fraction, thickness 0.0
+......\\mathord
+......\.\fam1 A
+....../\displaystyle
+....../\mathord
+....../.\fam1 A
+....../^\fam2 -
+....../_\fraction, thickness = default
+....../_\\mathord
+....../_\.\fam1 A
+....../_\\glue 0.0 plus 1.0fil
+....../_/\mathord
+....../_/.\fam1 B
+....../_/\glue(\nonscript)
+....../_/\kern 1.0
+....^\fam1 b
+...._\fraction, thickness 2.0, left-delimiter "162362
+...._\\mathop
+...._\.\fam3
+...._\\glue(\nonscript)
+...._\\textstyle
+...._\\glue(\nonscript)
+...._\\glue(\mskip) 9.0mu minus 1.0fil
+...._\\mathord
+...._\.\fam1 B
+...._/{}
+....\discretionary
+.....\kern-1.00002
+.....\ip -
+....|\smalltrip A
+....\right"161361
+...\mathord
+....\fam1 A
+### vertical mode entered at line 0
+### current page:
+\glue(\topskip) 7.3 plus 1.0fil
+\hbox(12.7+3.7)x17.0, glue set 0.17223fil, shifted 7.0
+.\glue(\leftskip) 3.0
+.\mathon, surrounded 1.1
+.\hbox(12.7+3.7)x4.80002
+..\hbox(0.0+0.0)x0.1, shifted -7.0
+..\hbox(12.7+3.7)x1.70001
+...\hbox(0.0+0.0)x0.1, shifted -7.0
+...\vbox(12.7+3.7)x1.5
+....\hbox(3.5+0.5)x1.5
+.....\smalltrip A
+....\kern1.2
+....\rule(1.0+0.0)x*
+....\kern6.2
+....\hbox(3.5+0.5)x1.5
+.....\smalltrip A
+...\hbox(0.0+0.0)x0.1, shifted -7.0
+..\hbox(8.0+2.0)x3.0, shifted -4.0
+...\ip b
+.\glue(\medmuskip) 0.55554 minus 0.83331
+.\ip /
+.\penalty -3333
+.\glue 0.27777
+.\glue(\medmuskip) 0.55554 minus 0.83331
+.\ip A
+.\kern1.0
+.\glue(\thickmuskip) -1.11108
+.\smalltrip -
+.\smalltrip -
+.\penalty -2222
+.\glue(\thickmuskip) -1.11108
+.\ip A
+.\glue(\medmuskip) 0.55554 minus 0.83331
+.\ip /
+.\penalty 1000
+.\glue(\medmuskip) 0.55554 minus 0.83331
+.\ip A
+.\kern1.0
+.\mathoff, surrounded 1.1
+.\penalty 10000
+.\glue(\parfillskip) 0.0
+.\glue(\rightskip) 0.0 plus 10.0fil minus 0.00002
+total height 21.7 plus 1.0fil plus -803.0fill
+ goal height 16383.99998
+prevdepth 3.7, prevgraf 8 lines
+
+! OK.
+\showlonglists ...99 \showlists
+ \pagegoal =10000pt}
+l.284 ...\penalty \showlonglists
+
+
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{math shift character $}
+! Missing } inserted.
+<inserted text>
+ }
+...
+l.285 $
+ \expandafter$\csname!\endcsname % end of hairy displ...
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+{math shift character $}
+{display math mode: \expandafter}
+{\csname}
+Missing character: There is no v in font trip!
+{restoring \!=undefined}
+{restoring \fam=-1}
+! \textfont 0 is undefined (character 7).
+<to be read again>
+ \relax
+...
+l.285 ...fter$\csname!\endcsname
+ % end of hairy display, miss...
+Somewhere in the math formula just ended, you used the
+stated character from an undefined font family. For example,
+plain TeX doesn't allow \it or \sl in subscripts. Proceed,
+and I'll try to forget that I needed that character.
+
+! \textfont 0 is undefined (character ^^c8).
+<to be read again>
+ \relax
+...
+l.285 ...fter$\csname!\endcsname
+ % end of hairy display, miss...
+Somewhere in the math formula just ended, you used the
+stated character from an undefined font family. For example,
+plain TeX doesn't allow \it or \sl in subscripts. Proceed,
+and I'll try to forget that I needed that character.
+
+! \scriptfont 0 is undefined (character -).
+<to be read again>
+ \relax
+...
+l.285 ...fter$\csname!\endcsname
+ % end of hairy display, miss...
+Somewhere in the math formula just ended, you used the
+stated character from an undefined font family. For example,
+plain TeX doesn't allow \it or \sl in subscripts. Proceed,
+and I'll try to forget that I needed that character.
+
+! \scriptscriptfont 13 is undefined (character A).
+<to be read again>
+ \relax
+...
+l.285 ...fter$\csname!\endcsname
+ % end of hairy display, miss...
+Somewhere in the math formula just ended, you used the
+stated character from an undefined font family. For example,
+plain TeX doesn't allow \it or \sl in subscripts. Proceed,
+and I'll try to forget that I needed that character.
+
+! \scriptscriptfont 13 is undefined (character 9).
+<to be read again>
+ \relax
+...
+l.285 ...fter$\csname!\endcsname
+ % end of hairy display, miss...
+Somewhere in the math formula just ended, you used the
+stated character from an undefined font family. For example,
+plain TeX doesn't allow \it or \sl in subscripts. Proceed,
+and I'll try to forget that I needed that character.
+
+Missing character: There is no in font trip!
+
+Overfull \hbox (48.4746pt too wide) detected at line 285
+[][][] [] [] []|
+
+\hbox(68.26251+98.15005)x19.0, glue set - 1.0
+.\kern -2.49994
+.\vbox(6.0+-8.0)x0.0
+.etc.
+
+{restoring \penalty=\penalty}
+{restoring \displayindent=0.0pt}
+{restoring \displaywidth=0.0pt}
+{restoring \predisplaysize=0.0pt}
+{restoring \fam=0}
+{horizontal mode: \expandafter}
+{undefined}
+! Undefined control sequence.
+<recently read> \!
+
+l.285 ...fter$\csname!\endcsname
+ % end of hairy display, miss...
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+% t=21.7 plus 1.0fil plus -803.0fill g=10000.0 b=0 p=0 c=0#
+% t=262.41258 plus 80.0 plus 1.0fil plus -803.0fill g=10000.0 b=0 p=7 c=
+7
+% t=262.41258 plus 80.0 plus 1.0fil plus -803.0fill g=10000.0 b=0 p=-117
+9647 c=-1179647#
+\output->{\tracingcommands 0\showthe \outputpenalty \showboxbreadth 9999
+ \showboxdepth 9999 \hoffset 1sp {\setbox 254=\box 255\shipout \ifvbox 2
+\ifhbox 254 \error \fi 54\copy 25\fi 4} \ifvoid 254\relax \else \error \
+fi }
+{internal vertical mode: \tracingcommands}
+> -1179647.
+<output> ...wthe \outputpenalty
+ \showboxbreadth 9999 \showbox...
+...
+l.285 ...fter$\csname!\endcsname
+ % end of hairy display, miss...
+
+
+Completed box being shipped out [-2.0.0.0.11.0.327680]
+\vbox(10000.0+2.0)x28.0, glue set 9737.58789fil
+.\glue(\topskip) 7.3 plus 1.0fil
+.\hbox(12.7+3.7)x17.0, glue set 0.17223fil, shifted 7.0
+..\glue(\leftskip) 3.0
+..\mathon, surrounded 1.1
+..\hbox(12.7+3.7)x4.80002
+...\hbox(0.0+0.0)x0.1, shifted -7.0
+...\hbox(12.7+3.7)x1.70001
+....\hbox(0.0+0.0)x0.1, shifted -7.0
+....\vbox(12.7+3.7)x1.5
+.....\hbox(3.5+0.5)x1.5
+......\smalltrip A
+.....\kern1.2
+.....\rule(1.0+0.0)x*
+.....\kern6.2
+.....\hbox(3.5+0.5)x1.5
+......\smalltrip A
+....\hbox(0.0+0.0)x0.1, shifted -7.0
+...\hbox(8.0+2.0)x3.0, shifted -4.0
+....\ip b
+..\glue(\medmuskip) 0.55554 minus 0.83331
+..\ip /
+..\penalty -3333
+..\glue 0.27777
+..\glue(\medmuskip) 0.55554 minus 0.83331
+..\ip A
+..\kern1.0
+..\glue(\thickmuskip) -1.11108
+..\smalltrip -
+..\smalltrip -
+..\penalty -2222
+..\glue(\thickmuskip) -1.11108
+..\ip A
+..\glue(\medmuskip) 0.55554 minus 0.83331
+..\ip /
+..\penalty 1000
+..\glue(\medmuskip) 0.55554 minus 0.83331
+..\ip A
+..\kern1.0
+..\mathoff, surrounded 1.1
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0 plus 10.0fil minus 0.00002
+.\penalty 0
+.\glue(\abovedisplayskip) 3.0
+.\glue(\lineskip) 0.0 plus 40.0
+.\hbox(68.26251+98.15005)x19.0, glue set - 1.0, shifted 9.0
+..\kern -2.49994
+..\vbox(6.0+-8.0)x0.0
+..\vbox(17.1+4.2)x5.99
+...\kern17.1
+...\hbox(0.0+0.0)x0.0, shifted 8.5
+....\bigtr
+p -
+...\kern-17.1
+...\hbox(17.1+4.2)x5.99
+....\ip A
+....\vbox(21.3+0.0)x3.99, shifted 4.2
+.....\hbox(9.0+0.0)x2.99, shifted 1.0
+......\hbox(7.0+1.0)x2.0, shifted -2.0
+.......\ip a
+......\ip /
+.....\kern12.3
+.....\hbox(0.0+0.0)x-0.01
+..\vbox(25.76251+4.1)x15.0156
+...\kern1.0
+...\rule(1.0+0.0)x*
+...\kern3.0
+...\hbox(20.76251+4.1)x15.0156
+....\hbox(3.5+0.5)x1.49, shifted -8.3
+.....\smalltrip A
+....\ip A
+....\hbox(0.0+0.0)x-5.01, shifted 4.1
+.....\ip -
+....\glue(\thinmuskip) 0.27777 plus 2.0fill minus 0.83331
+....\hbox(0.0+0.0)x0.0
+....\hbox(4.0+16.20003)x16.25781, shifted -16.76251
+.....\smalltrip A
+.....\kern0.5
+.....\kern1.0
+.....\smalltrip B
+.....\vbox(16.00002+2.0)x12.2678, shifted 14.20003
+......\kern8.99998
+......\hbox(0.0+0.0)x0.0, shifted 2.1389
+.......\bigtr
+p ^^82
+......\kern-8.99998
+......\hbox(16.00002+2.0)x12.2778
+.......\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+........\bigtr
+p A
+.......\glue(\thinmuskip) 0.27777 plus 2.0fill minus 0.83331
+.......\bigtr
+p A
+.......\kern2.0
+.......\vbox(16.00002+0.0)x0.0
+........\hbox(14.00002+2.0)x0.0, shifted -3.0
+.........\bigtr
+p a
+........\kern0.0
+........\hbox(0.0+0.0)x0.0
+..\glue(\thinmuskip) 0.27777 plus 2.0fill minus 0.83331
+..\vbox(28.0+0.0)x3.0
+...\kern10.0
+...\hbox(0.0+0.0)x3.0, glue set 0.5fil
+....\glue 0.0 plus 1.0fil minus 1.0fil
+....\smalltrip C
+....\glue 0.0 plus 1.0fil minus 1.0fil
+...\kern6.0
+...\hbox(12.0+0.0)x3.0
+....\hbox(8.0+2.0)x3.0, shifted -4.0
+.....\ip B
+..\glue(\thinmuskip) 0.27777 plus 2.0fill minus 0.83331
+..\vbox(7.0+18.0)x8.0
+...\hbox(7.0+0.0)x8.0
+....\hbox(0.0+0.0)x8.0, shifted -7.0
+.....\ip M
+...\kern8.0
+...\hbox(0.0+0.0)x8.0, glue set 3.0fil, shifted -1.0
+....\glue 0.0 plus 1.0fil minus 1.0fil
+....\smalltrip C
+....\glue 0.0 plus 1.0fil minus 1.0fil
+...\kern10.0
+..\glue(\thinmuskip) 0.27777 plus 2.0fill minus 0.83331
+..\hbox(68.26251+98.15005)x39.63556
+...\hbox(68.26251+98.15005)x39.63556
+....\hbox(7.0+1.0)x3.0, shifted -54.26251
+.....\ip a
+....\vbox(68.26251+98.15005)x36.63556
+.....\kern7.0
+.....\rule(7.0+0.0)x*
+.....\kern1.56248
+.....\hbox(52.70003+98.15005)x36.63556
+......\hbox(0.0+0.0)x0.1, shifted -52.70003
+......\vbox(52.70003+98.15005)x36.53555
+.......\kern0.0
+.......\rule(0.0+0.0)x*
+.......\kern1.25
+.......\hbox(51.45003+98.15005)x36.53555
+........\hbox(51.45003+98.15005)x33.25778
+.........\vbox(-1.00002+22.99995)x7.0, shifted -18.99998
+..........\hbox(-1.00002+2.0)x7.0
+...........\ip
+
+..........\hbox(-1.00002+2.0)x7.0
+...........\ip
+
+..........\hbox(7.0+1.0)x3.0
+...........\ip A
+..........\hbox(-1.00002+2.0)x7.0
+...........\ip
+
+..........\hbox(-1.00002+2.0)x7.0
+...........\ip
+
+..........\hbox(8.0+2.0)x3.0
+...........\ip B
+.........\hbox(35.75003+94.55006)x8.39005
+..........\vbox(35.75003+94.55006)x8.39005
+...........\hbox(35.75003+49.05003)x8.39005
+............\hbox(0.0+0.0)x0.1, shifted -7.0
+............\vbox(35.75003+49.05003)x8.19003
+.............\hbox(14.00002+2.0)x8.19003, glue set 1.09502fil
+..............\glue 0.0 plus 1.0fil minus 1.0fil
+..............\bigtr
+p A
+..............\kern2.0
+..............\glue 0.0 plus 1.0fil minus 1.0fil
+.............\kern27.30002
+.............\hbox(8.1+33.40002)x8.19003
+..............\ip A
+..............\vbox(27.75002+13.75002)x6.19003, shifted 19.65001
+...............\hbox(0.0+0.0)x-2.51, shifted 1.0
+................\smalltrip -
+...............\kern4.0
+...............\hbox(23.75002+13.75002)x6.19003
+................\hbox(0.0+0.0)x0.1, shifted -7.0
+................\vbox(23.75002+13.75002)x6.00002
+.................\hbox(14.00002+2.0)x6.00002
+..................\bigtr
+p A
+..................\kern2.0
+..................\glue 0.0 plus 1.0fil
+.................\kern0.5
+.................\rule(0.5+0.0)x*
+.................\kern0.5
+.................\hbox(16.0+4.00002)x6.00002, glue set 0.00002fil
+..................\glue 0.0 plus 1.0fil minus 1.0fil
+..................\bigtr
+p B
+..................\glue(\nonscript)
+..................\glue 0.0 plus 1.0fil minus 1.0fil
+................\hbox(0.0+0.0)x0.1, shifted -7.0
+............\hbox(0.0+0.0)x0.1, shifted -7.0
+...........\kern27.30002
+...........\rule(9.1+0.0)x*
+.........\vbox(146.40009+3.2)x11.86772, shifted 94.95006
+..........\hbox(16.0+4.00002)x5.99
+...........\bigtr
+p b
+..........\kern106.40007
+..........\hbox(20.0+3.2)x11.86772
+...........\hbox(16.0+4.00002)x6.0, shifted -1.0
+............\bigtr
+p b
+...........\vbox(20.0+3.2)x5.77771
+............\hbox(8.0+2.0)x5.77771
+.............\hbox(0.0+0.0)x0.0, shifted -7.0
+.............\glue(\nonscript)
+.............\glue(\nonscript)
+.............\glue 2.49994 minus 1.0fil
+.............\glue(\thinmuskip) 0.27777 plus 2.0fill minus 0.83331
+.............\ip B
+............\kern2.0
+............\rule(2.0+0.0)x*
+............\kern9.2
+............\hbox(0.0+0.0)x5.77771
+...........\hbox(0.0+0.0)x0.1, shifted -7.0
+.........\discretionary
+..........\kern-1.00002
+..........\ip -
+.........|\smalltrip A
+.........\hbox(14.00002+2.0)x6.00002, shifted -0.99998
+..........\bigtr
+p a
+........\glue(\thinmuskip) 0.27777 plus 2.0fill minus 0.83331
+........\ip A
+........\kern1.0
+..\rule(*+*)x5.0
+.\penalty 10000
+.\glue(\lineskip) 0.0 plus 40.0
+.\hbox(20.5+50.80002)x8.27895, shifted 19.72105
+..\ip -
+..\smalltrip b
+..\hbox(3.5+0.5)x1.5
+...\smalltrip A
+...\kern0.5
+..\vbox(26.0+4.00002)x1.99, shifted 10.8
+...\hbox(7.0+1.0)x1.99
+....\ip A
+...\kern2.0
+...\hbox(16.0+4.00002)x0.99
+....\bigtr
+p B
+....\ip -
+..\hbox(20.5+50.80002)x8.28894
+...\hbox(20.5+50.80002)x8.28894
+....\hbox(0.0+0.0)x0.1, shifted -7.0
+....\vbox(20.5+50.80002)x8.08893
+.....\hbox(0.0+0.0)x8.08893
+.....\kern9.0
+.....\rule(9.0+0.0)x*
+.....\kern9.0
+.....\hbox(20.65001+23.65001)x8.08893
+......\hbox(20.65001+23.65001)x8.08893
+.......\hbox(20.65001+23.65001)x8.08893
+........\hbox(0.0+0.0)x0.1, shifted -7.0
+........\vbox(20.65001+23.65001)x7.88892
+.........\hbox(0.0+0.0)x7.88892
+.........\kern9.1
+.........\rule(9.1+0.0)x*
+.........\kern9.1
+.........\hbox(12.0+5.0)x7.88892
+..........\hbox(12.0+5.0)x7.88892
+...........\hbox(8.0+2.0)x3.0, shifted -4.0
+............\ip b
+...........\vbox(11.0+5.0)x1.88892
+............\hbox(0.0+0.0)x1.88892
+.............\ip p
+.............\ip t
+.............\ip s
+.............\ip q
+.............\ip t
+.............\kern3.0
+.............\ip q
+.............\ip p
+.............\glue(\thickmuskip) -1.11108
+.............\ip u
+............\kern7.0
+............\hbox(9.0+0.0)x1.88892, glue set 0.74446fil
+.............\glue 0.0 plus 1.0fil minus 1.0fil
+.............\rule(9.0+*)x0.4
+.............\glue 0.0 plus 1.0fil minus 1.0fil
+...........\hbox(8.0+2.0)x3.0, shifted -4.0
+............\ip b
+........\hbox(0.0+0.0)x0.1, shifted -7.0
+......\hbox(0.0+0.0)x0.0
+....\hbox(0.0+0.0)x0.1, shifted -7.0
+.\penalty 7
+
+Memory usage before: 2170&521; after: 1181&459; still untouched: 175
+{restoring \box254=void}
+{restoring \hoffset=0.0pt}
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{restoring \parshape=10}
+{restoring \hangafter=-12}
+{restoring \hangindent=-10.0pt}
+{restoring \looseness=-2}
+{horizontal mode: \relax}
+{\parshape}
+{\leftskip}
+{\spacefactor}
+{\raise}
+{restricted horizontal mode: \special}
+{blank space }
+{end-group character }}
+{horizontal mode: blank space }
+{\penalty}
+{\showbox}
+> \box0=
+\vbox(0.0+0.0)x0.0
+.\penalty 999
+
+! OK.
+<to be read again>
+ \spacefactor
+l.289 \showbox0\spacefactor
+ =0
+
+{\spacefactor}
+! Bad space factor (0).
+l.289 \showbox0\spacefactor=0
+
+I allow only values in the range 1..32767 here.
+
+{\write}
+{\par}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 12.0 t=100000782 -> @@0
+@\penalty via @@0 b=10000 p=-10000 d=100000782
+@@2: line 12.0 t=100000782 -> @@0
+@\penalty via @@1 b=10000 p=-10000 d=100000000
+@@3: line 13.0 t=200000782 -> @@1
+[]
+@\par via @@2 b=10000 p=-10000 d=100000000
+@@4: line 13.0- t=200000782 -> @@2
+@\par via @@3 b=10000 p=-10000 d=100000000
+@@5: line 14.0- t=300000782 -> @@3
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 285--290
+ []
+
+\hbox(1.0+0.0)x90.0, glue set 41.0
+.\glue(\leftskip) 0.0 plus -10.0fil
+.\hbox(0.0+0.0)x4.0, shifted -1.0 []
+.etc.
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 285--290
+ []
+
+\hbox(0.0+0.0)x100.0
+.\glue(\leftskip) 0.0 plus -10.0fil
+.\write10{\the \spacefactor }
+.etc.
+
+%% goal height=16383.99998, max depth=2.0
+% t=20.0 plus 1.0fil g=16383.99998 b=0 p=125 c=125#
+{vertical mode: end-group character }}
+! Extra }, or forgotten \endgroup.
+l.291 }
+ % this fails to match \begingroup
+I've deleted a group-closing symbol because it seems to be
+spurious, as in `$x}$'. But perhaps the } is legitimate and
+you forgot something else, as in `\hbox{$x}'. In such cases
+the way to recover is to insert both the forgotten and the
+deleted material, e.g., by typing `I$}'.
+
+{blank space }
+{\aftergroup}
+{\aftergroup}
+{\endgroup}
+{restoring \hangafter=-12}
+{restoring \hangindent=-10.0pt}
+{restoring \leftskip=3.0pt}
+{restoring \parshape=10}
+{restoring \rightskip=0.0pt}
+{restoring \looseness=0}
+{\lccode}
+{\mark}
+! Improper \spacefactor.
+l.293 \mark{\the\spacefactor
+ } % \spacefactor: not in vertical...
+You can refer to \spacefactor only in horizontal mode;
+you can refer to \prevdepth only in vertical mode; and
+neither of these is meaningful inside \write. So
+I'm forgetting what you said and using zero instead.
+
+{blank space }
+{math shift character $}
+% t=30.0 plus 41.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{horizontal mode: math shift character $}
+@firstpass
+@secondpass
+[]
+@\par via @@0 b=10000 p=-10000 d=*
+@@1: line 1.0- t=0 -> @@0
+
+
+Underfull \hbox (badness 10000) in paragraph at lines 294--294
+ []
+
+\hbox(0.0+0.0)x11.0
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{display math mode: \global}
+{\mskip}
+{\catcode}
+{\catcode}
+{\the}
+{\def}
+{blank space }
+{\vtop}
+{internal vertical mode: \everydisplay}
+{\vbox}
+{end-group character }}
+{\noindent}
+{horizontal mode: math shift character $}
+\everydisplay->\global
+{display math mode: \global}
+{\lowercase}
+{the letter a}
+{the letter a}
+
+j->\relax
+{\relax}
+{math shift character $}
+{internal vertical mode: \ifvmode}
+{true}
+{restoring \displayindent=3.0pt}
+{restoring \displaywidth=13.0pt}
+{restoring \predisplaysize=24.0pt}
+{restoring \fam=-1}
+{horizontal mode: \fi}
+{end-group character }}
+{restoring \everydisplay=}
+{restoring \parshape=10}
+{restoring \hangafter=-12}
+{restoring \hangindent=-10.0pt}
+{display math mode: \hss}
+{\leqno}
+{math mode: \mathchardef}
+! Missing control sequence inserted.
+<inserted text>
+ \inaccessible
+...
+l.298 \leqno\mathchardef A
+ \/\left(\over\left(\global\errorcon...
+Please don't say `\def cs{...}', say `\def\cs{...}'.
+I've inserted an inaccessible control sequence so that your
+definition will be completed without mixing me up too badly.
+You can recover graciously from this error, if you're
+careful; see exercise 27.2 in The TeXbook.
+
+! Missing number, treated as zero.
+<to be read again>
+ A
+l.298 \leqno\mathchardef A
+ \/\left(\over\left(\global\errorcon...
+A number should have been here; I inserted `0'.
+(If you can't figure out why I needed to see a number,
+look up `weird error' in the index to The TeXbook.)
+
+{the letter A}
+{\/}
+{\left}
+
+(->\delimiter "4162362
+{\over}
+{\left}
+
+(->\delimiter "4162362
+{\global}
+{math shift character $}
+! Missing \right. inserted.
+<inserted text>
+ \right .
+<to be read again>
+ $
+l.298 ...bal\errorcontextlines5$
+ $
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{\right}
+{math shift character $}
+! Missing \right. inserted.
+<inserted text>
+ \right .
+<to be read again>
+ $
+l.298 ...bal\errorcontextlines5$
+ $
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{\right}
+{math shift character $}
+{restoring \inaccessible=undefined}
+{restoring \fam=-1}
+{restoring j=undefined}
+{restoring \catcode106=11}
+{restoring \catcode74=11}
+{restoring \displayindent=0.0pt}
+{restoring \displaywidth=0.0pt}
+{restoring \predisplaysize=0.0pt}
+{restoring \fam=0}
+% t=40.0 plus 124.0 plus 1.0fil minus 8.0 g=16383.99998 b=0 p=0 c=0#
+% t=66.00002 plus 164.0 plus 1.0fil minus 8.0 g=16383.99998 b=0 p=-11796
+47 c=-1179647#
+\output->{\tracingcommands 0\showthe \outputpenalty \showboxbreadth 9999
+ \showboxdepth 9999 \hoffset 1sp {\setbox 254=\box 255\shipout \ifvbox 2
+\ifhbox 254 \error \fi 54\copy 25\fi 4} \ifvoid 254\relax \else \error \
+fi }
+{internal vertical mode: \tracingcommands}
+> -1179647.
+<output> ...wthe \outputpenalty
+ \showboxbreadth 9999 \showbox...
+l.298 ...al\errorcontextlines5$$
+
+
+
+Completed box being shipped out [-2.0.0.0.11.0.327680.1572864.0.-1073741
+823]
+\vbox(16383.99998+2.0)x100.0, glue set 16318.0fil
+.\glue(\topskip) 19.0 plus 1.0fil
+.\hbox(1.0+0.0)x90.0, glue set 41.0
+..\glue(\leftskip) 0.0 plus -10.0fil
+..\hbox(0.0+0.0)x4.0, shifted -1.0
+...\special{-12}
+...\glue 4.0 plus 2.0 minus 1.0
+..\glue 4.0 plus 2.0 minus 1.0
+..\penalty -10000
+..\glue(\rightskip) 0.0 plus 10.0fil minus 0.00002
+.\penalty 125
+.\glue(\baselineskip) 10.0 plus 41.0
+.\hbox(0.0+0.0)x100.0
+..\glue(\leftskip) 0.0 plus -10.0fil
+..\write10{\the \spacefactor }
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0 plus 10.0fil minus 0.00002
+.\mark{0}
+.\glue(\parskip) 0.0 plus 42.0 minus 8.0
+.\glue(\baselineskip) 10.0 plus 41.0
+.\hbox(0.0+0.0)x11.0, shifted 1.0
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x0.0
+..\penalty 10000
+..\glue(\parfillskip) 0.0
+..\glue(\rightskip) 0.0
+.\penalty 0
+.\glue(\abovedisplayskip) 3.0
+.\glue(\lineskip) 0.0 plus 40.0
+.\hbox(12.0+13.00002)x13.0, shifted 3.0
+..\hbox(12.0+4.0)x8.1778
+...\ip A
+...\kern1.0
+...\kern0.0
+...\glue(\thinmuskip) 0.27777 plus 2.0fill minus 0.83331
+...\hbox(12.0+4.0)x4.90002
+....\hbox(8.0+2.0)x3.0, shifted -4.0
+.....\ip b
+....\hbox(9.2+4.0)x1.80002
+.....\hbox(0.0+0.0)x0.1, shifted -7.0
+.....\vbox(9.2+4.0)x1.6
+......\hbox(0.0+0.0)x1.6
+......\kern1.7
+......\rule(1.0+0.0)x*
+......\kern1.0
+......\hbox(9.5+0.0)x1.6
+.......\hbox(4.0+1.0)x1.5, shifted -5.5
+........\smalltrip b
+.......\hbox(0.0+0.0)x0.1, shifted -7.0
+.....\hbox(0.0+0.0)x0.1, shifted -7.0
+....\hbox(0.0+0.0)x0.1, shifted -7.0
+..\kern5.0
+..\hbox(0.0+13.00002)x-0.1778, glue set - 57.67767fil
+...\glue 4.99988 minus 4.99988
+...\vbox(-0.00002+13.00002)x52.5, glue set - 0.00247
+....\vbox(-0.00002+0.0)x0.0
+....\glue(\parskip) 0.0 plus 42.0 minus 8.0
+....\penalty 0
+....\glue(\abovedisplayshortskip) 1.0 plus 45.0 minus 803.0
+....\glue(\baselineskip) 3.0 plus 41.0
+....\hbox(7.0+1.0)x5.0, shifted 47.5
+.....\ip a
+.....\ip a
+.....\kern1.0
+....\penalty -1179647
+....\glue(\belowdisplayshortskip) 3.0 plus 46.0
+...\glue 0.0 plus 1.0fil minus 1.0fil
+
+\write->\the \spacefactor
+! Improper \spacefactor.
+<write> \the \spacefactor
+
+<inserted text>
+ }\endwrite
+<to be read again>
+ }
+<output> ...\fi 54\copy 25\fi 4}
+ \ifvoid 254\relax \else \err...
+l.298 ...al\errorcontextlines5$$
+
+You can refer to \spacefactor only in horizontal mode;
+you can refer to \prevdepth only in vertical mode; and
+neither of these is meaningful inside \write. So
+I'm forgetting what you said and using zero instead.
+
+0
+Memory usage before: 640&415; after: 397&410; still untouched: 175
+{restoring \box254=void}
+{restoring \hoffset=0.0pt}
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{restoring \parshape=10}
+{restoring \hangafter=-12}
+{restoring \hangindent=-10.0pt}
+{horizontal mode: \par}
+{vertical mode: \hangindent}
+{\par}
+{\showthe}
+> 0.0pt.
+l.300 ...\par\showthe\hangindent
+ \hangindent 254cm
+
+{\hangindent}
+{\parfillskip}
+{\fontdimen}
+{\the}
+{\the}
+{the character 0}
+{horizontal mode: the character 0}
+Missing character: There is no 0 in font trip!
+{the letter A}
+{blank space }
+{\char}
+{math shift character $}
+@firstpass
+@secondpass
+[]\ip A
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+^^82
+@\par via @@0 b=62 p=-10000 d=3969
+@@2: line 1.1- t=3969 -> @@0
+
+
+Loose \hbox (badness 62) in paragraph at lines 302--303
+ []\ip A ^^82
+
+\hbox(7.0+1.0)x100.0, glue set 0.85295
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+%% goal height=16383.99998, max depth=2.0
+{display math mode: \global}
+{\leqno}
+{math mode: \kern}
+{math shift character $}
+! Display math should end with $$.
+<to be read again>
+ \par
+l.303 ...e\leqno\kern1009pt$\par
+
+The `$' that I just saw supposedly matches a previous `$$'.
+So I shall assume that you typed `$$' both times.
+
+{restoring \fam=-1}
+{restoring \displayindent=0.0pt}
+{restoring \displaywidth=0.0pt}
+{restoring \predisplaysize=0.0pt}
+{restoring \fam=0}
+% t=20.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+% t=40.0 plus 82.0 plus 1.0fil g=16383.99998 b=0 p=-1179647 c=-1179647#
+\output->{\tracingcommands 0\showthe \outputpenalty \showboxbreadth 9999
+ \showboxdepth 9999 \hoffset 1sp {\setbox 254=\box 255\shipout \ifvbox 2
+\ifhbox 254 \error \fi 54\copy 25\fi 4} \ifvoid 254\relax \else \error \
+fi }
+{internal vertical mode: \tracingcommands}
+> -1179647.
+<output> ...wthe \outputpenalty
+ \showboxbreadth 9999 \showbox...
+<to be read again>
+ \par
+l.303 ...e\leqno\kern1009pt$\par
+
+
+
+Completed box being shipped out [-2.0.0.0.11.0.327680.1572864.1073741823
+.-1073741823]
+\vbox(16383.99998+0.0)x8236.0, glue set 16344.0fil
+.\glue(\topskip) 13.0 plus 1.0fil
+.\hbox(7.0+1.0)x100.0, glue set 0.85295
+..\glue(\leftskip) 3.0
+..\hbox(0.0+0.0)x0.0
+..\ip A
+..\glue 4.0 plus 1.99799 minus 1.00099
+..\ip ^^82
+..\penalty 10000
+..\glue(\parfillskip) 0.0 plus 100.0
+..\glue(\rightskip) 0.0
+.\penalty 0
+.\glue(\baselineskip) 9.0 plus 41.0
+.\hbox(0.0+0.0)x1009.0, shifted 7227.0
+..\kern 1009.0
+.\penalty 10000
+.\glue(\baselineskip) 10.0 plus 41.0
+.\hbox(0.0+0.0)x-7127.0, shifted 7227.0
+
+Memory usage before: 235&401; after: 178&399; still untouched: 175
+{restoring \box254=void}
+{restoring \hoffset=0.0pt}
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{restoring \hangindent=7227.0pt}
+{horizontal mode: \par}
+{vertical mode: \showlists}
+
+### vertical mode entered at line 0
+prevdepth 0.0, prevgraf 4 lines
+
+! OK.
+l.304 \showlists
+ {\catcode`!13\global\everyhbox{\def!{}}}
+
+{begin-group character {}
+{\catcode}
+{\global}
+{end-group character }}
+{restoring \catcode33=12}
+{blank space }
+{\count}
+{\baselineskip}
+{begin-group character {}
+{\sfcode}
+{\vfuzz}
+{\everyvbox}
+{\vbox}
+\everyvbox->
+{internal vertical mode: blank space }
+{\hsize}
+{\tolerance}
+{the letter A}
+{horizontal mode: the letter A}
+{blank space }
+{the letter A}
+{blank space }
+{the letter A}
+{blank space }
+{the letter A}
+{blank space }
+{the letter A}
+{\clubpenalty}
+{\par}
+@firstpass
+@secondpass
+[]\ip A A A
+@ via @@0 b=* p=0 d=*
+@@1: line 1.3 t=0 -> @@0
+A A
+@\par via @@1 b=12 p=-10000 d=*
+@@2: line 2.2- t=0 -> @@1
+
+
+Overfull \hbox (3.0pt too wide) in paragraph at lines 308--308
+ []\ip A A A|
+
+\hbox(7.0+1.0)x10.0, glue set - 1.0
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+
+Tight \hbox (badness 12) in paragraph at lines 308--308
+ \ip A A
+
+\hbox(7.0+1.0)x10.0, glue set - 0.5
+.\glue(\leftskip) 3.0
+.\ip A
+.etc.
+
+{internal vertical mode: \hbadness}
+{\hfuzz}
+{the letter A}
+{horizontal mode: the letter A}
+{blank space }
+{the letter A}
+{blank space }
+{the letter A}
+{blank space }
+{the letter A}
+{blank space }
+{the letter A}
+{\leaders}
+{\par}
+@firstpass
+@secondpass
+[]\ip A A A
+@ via @@0 b=* p=0 d=*
+@@1: line 1.3 t=0 -> @@0
+A A
+@\par via @@1 b=12 p=-10000 d=*
+@@2: line 2.2- t=0 -> @@1
+
+{internal vertical mode: end-group character }}
+{restoring \hfuzz=0.0pt}
+{restoring \hbadness=0}
+{restoring \clubpenalty=125}
+{restoring \tolerance=10000}
+{restoring \hsize=100.0pt}
+
+Overfull \vbox (18.0pt too high) detected at line 309
+
+\vbox(11.0+1.0)x10.0, glue set - 1.0
+.\hbox(7.0+1.0)x10.0, glue set - 1.0 []
+.\penalty 10000
+.etc.
+
+%% goal height=16383.99998, max depth=2.0
+{vertical mode: blank space }
+{\message}
+1000000
+{end-group character }}
+{restoring \everyvbox=}
+{restoring \vfuzz=0.0pt}
+{restoring \sfcode65=999}
+{blank space }
+{\vbox}
+{internal vertical mode: \hbadness}
+{\hfuzz}
+{\hbox}
+\everyhbox->\def !{}
+{restricted horizontal mode: \def}
+{\hskip}
+{end-group character }}
+{restoring !=undefined}
+
+Overfull \hbox (1.0pt too wide) detected at line 311
+
+
+\hbox(0.0+0.0)x0.0, glue set - 1.0
+.\glue 10.0 minus 9.0
+
+{internal vertical mode: blank space }
+{\hbadness}
+{\hbox}
+\everyhbox->\def !{}
+{restricted horizontal mode: \def}
+{\hskip}
+{end-group character }}
+{restoring !=undefined}
+
+Underfull \hbox (badness 101) detected at line 312
+
+
+\hbox(0.0+0.0)x10.03749, glue set 1.00375
+.\glue 0.0 plus 10.0
+
+{internal vertical mode: \tracingcommands}
+{\message}
+101
+{end-group character }}
+{restoring \tracingcommands=2}
+{restoring \hfuzz=0.0pt}
+{restoring \hbadness=0}
+% t=20.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{vertical mode: \lineskiplimit}
+{\everyhbox}
+{blank space }
+{\def}
+{blank space }
+{\dimendef}
+{\dimen}
+{\vbox}
+{internal vertical mode: \tracinglostchars}
+{the letter A}
+{horizontal mode: the letter A}
+{\/}
+
+\space ->
+{blank space }
+
+\space ->
+{blank space }
+{\ignorespaces}
+
+\space ->
+
+\space ->
+{the letter J}
+{blank space }
+{\vskip}
+{\par}
+@firstpass
+@secondpass
+[]\ip A
+@\kern via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+
+@\par via @@0 b=56 p=-10000 d=3249
+@\par via @@1 b=10000 p=-10000 d=100000000
+@@2: line 1.1- t=3249 -> @@0
+
+
+Loose \hbox (badness 56) in paragraph at lines 315--316
+ []\ip A
+
+\hbox(7.0+1.0)x100.0, glue set 0.82695
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{internal vertical mode: \vskip}
+{\moveleft}
+{\boxmaxdepth}
+{\mark}
+{end-group character }}
+{restoring \boxmaxdepth=1000.0pt}
+
+Underfull \vbox (badness 10000) detected at line 316
+
+\vbox(10.0+-1.0)x0.0
+.\mark{vii}
+
+{\vskip}
+{\unskip}
+{\setbox}
+{\showthe}
+> -1.0pt.
+l.317 ...astbox\showthe\lastskip
+ % \lastskip=-1pt (\baselines...
+
+{\unskip}
+{\vskip}
+{\kern}
+{\penalty}
+{\showbox}
+> \box22=
+\vbox(10.0+-1.0)x0.0
+.\mark{vii}
+
+! OK.
+<to be read again>
+ }
+l.318 ...lty\lastkern\showbox22}
+
+
+{end-group character }}
+{restoring \box22=void}
+{restoring \tracinglostchars=2}
+
+Underfull \vbox (badness 10000) detected at line 318
+
+\vbox(11.0+0.0)x100.0
+.\hbox(7.0+1.0)x100.0, glue set 0.82695 []
+.\glue 2.0
+.etc.
+
+% t=31.0 plus 40.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{vertical mode: blank space }
+{\showbox}
+> \box22=void
+
+! OK.
+<to be read again>
+ \kern
+l.319 \showbox22\kern
+ 3pt\message{\the\lastkern}\unkern
+
+{\kern}
+{\message}
+3.0pt
+{\unkern}
+{\show}
+> \botmark=\botmark:
+0.
+l.320 \show\botmark
+ \catcode`;13\def;{\setbox`; }
+
+{\catcode}
+{\def}
+{blank space }
+{\lineskiplimit}
+
+\space ->
+
+\space ->
+{blank space }
+{\count}
+{\vbox}
+
+\space ->
+{internal vertical mode: \accent}
+{horizontal mode: \accent}
+Missing character: There is no ^^c8 in font trip!
+
+\space ->
+{blank space }
+{\accent}
+
+\space ->
+
+;->\setbox `;
+! Improper \setbox.
+<to be read again>
+ \char
+l.322 ...2 \def\^^M{\ } ; \char
+ '101
+Sorry, \setbox is not allowed after \halign in a display,
+or between \accent and an accented character.
+
+{the letter A}
+{\ }
+{\fontdimen}
+{\ }
+{\spaceskip}
+
+\^^M->\
+{\ }
+{\vskip}
+{\par}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+[]\ip AA
+@ via @@0 b=10000 p=0 d=100000782
+@ via @@1 b=10000 p=0 d=100000000
+@@2: line 1.0 t=100000782 -> @@0
+
+@\par via @@0 b=44 p=-10000 d=2025
+@\par via @@1 b=54 p=-10000 d=3025
+@\par via @@2 b=10000 p=-10000 d=100000000
+@@3: line 1.1- t=2025 -> @@0
+
+
+Loose \hbox (badness 44) in paragraph at lines 322--324
+ [] []\ip AA
+
+\hbox(10.50002+1.0)x100.0, glue set 0.76414
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{internal vertical mode: \vskip}
+{end-group character }}
+{restoring \spaceskip=0.0pt}
+{restoring \^^M=undefined}
+
+Overfull \vbox (0.50002pt too high) detected at line 324
+
+\vbox(11.0+0.0)x100.0, glue set - 1.0
+.\hbox(10.50002+1.0)x100.0, glue set 0.76414 []
+.\glue 10.0 minus 10.0
+
+% t=41.0 plus 40.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{vertical mode: blank space }
+{\penalty}
+% t=52.0 plus 80.0 plus 1.0fil g=16383.99998 b=0 p=-2147483647 c=-214748
+3647#
+\output->{\tracingcommands 0\showthe \outputpenalty \showboxbreadth 9999
+ \showboxdepth 9999 \hoffset 1sp {\setbox 254=\box 255\shipout \ifvbox 2
+\ifhbox 254 \error \fi 54\copy 25\fi 4} \ifvoid 254\relax \else \error \
+fi }
+{internal vertical mode: \tracingcommands}
+> -2147483647.
+<output> ...wthe \outputpenalty
+ \showboxbreadth 9999 \showbox...
+l.325 \penalty-2147483647
+ % that's the largest value TeX will...
+
+
+Completed box being shipped out [-2.0.0.0.11.196608.327680.1572864.10737
+41823]
+\vbox(16383.99998+0.0)x100.0, glue set 16332.0fil
+.\glue(\topskip) 9.0 plus 1.0fil
+.\vbox(11.0+1.0)x10.0, glue set - 1.0
+..\hbox(7.0+1.0)x10.0, glue set - 1.0
+...\glue(\leftskip) 3.0
+...\hbox(0.0+0.0)x0.0
+...\ip A
+...\glue 4.0 plus 1.0 minus 2.0
+...\ip A
+...\glue 4.0 plus 1.0 minus 2.0
+...\ip A
+...\glue(\rightskip) 0.0
+...\rule(*+*)x5.0
+..\penalty 10000
+..\glue(\baselineskip) 2.0
+..\hbox(7.0+1.0)x10.0, glue set - 0.5
+...\glue(\leftskip) 3.0
+...\ip A
+...\glue 4.0 plus 1.0 minus 2.0
+...\ip A
+...\penalty 10000
+...\glue(\parfillskip) 0.0 plus 100.0
+...\glue(\rightskip) 0.0
+..\glue(\parskip) 0.0 plus 42.0 minus 8.0
+..\glue(\baselineskip) 2.0
+..\hbox(7.0+1.0)x10.0, glue set - 1.0
+...\glue(\leftskip) 3.0
+...\hbox(0.0+0.0)x0.0
+...\ip A
+...\glue 4.0 plus 1.0 minus 2.0
+...\ip A
+...\glue 4.0 plus 1.0 minus 2.0
+...\ip A
+...\glue(\rightskip) 0.0
+..\penalty 10000
+..\glue(\baselineskip) 2.0
+..\hbox(7.0+1.0)x10.0, glue set - 0.5
+...\glue(\leftskip) 3.0
+...\ip A
+...\glue 4.0 plus 1.0 minus 2.0
+...\ip A
+...\penalty 10000
+...\glue(\parfillskip) 0.0 plus 100.0
+...\glue(\rightskip) 0.0
+.\glue(\lineskip) 0.0 plus 40.0
+.\vbox(10.0+0.0)x10.03749
+..\hbox(0.0+0.0)x0.0, glue set - 1.0
+...\glue 10.0 minus 9.0
+..\glue(\baselineskip) 10.0
+..\hbox(0.0+0.0)x10.03749, glue set 1.00375
+...\glue 0.0 plus 10.0
+.\glue(\baselineskip) -1.0
+.\vbox(11.0+0.0)x100.0
+..\hbox(7.0+1.0)x100.0, glue set 0.82695
+...\glue(\leftskip) 3.0
+...\hbox(0.0+0.0)x0.0
+...\ip A
+...\kern 1.0
+...\glue 4.0 plus 1.99799 minus 1.00099
+...\glue 4.0 plus 1.99799 minus 1.00099
+...\penalty 10000
+...\glue(\parfillskip) 0.0 plus 100.0
+...\glue(\rightskip) 0.0
+..\glue 2.0
+..\glue -2.0
+..\kern 0.0
+..\penalty 0
+.\glue(\lineskip) 0.0 plus 40.0
+.\vbox(11.0+0.0)x100.0, glue set - 1.0
+..\hbox(10.50002+1.0)x100.0, glue set 0.76414
+...\glue(\leftskip) 3.0
+...\hbox(0.0+0.0)x0.0
+...\glue 4.0 plus 2.0 minus 1.0
+...\kern -5.50003 (for accent)
+...\hbox(8.0+2.0)x3.0, shifted -2.50002
+....\ip B
+...\kern 2.50003 (for accent)
+...\ip A
+...\ip A
+...\glue 4.0 plus 2.0 minus 1.0
+...\glue 4.0 plus 2.0 minus 88.0
+...\penalty 10000
+...\glue(\parfillskip) 0.0 plus 100.0
+...\glue(\rightskip) 0.0
+..\glue 10.0 minus 10.0
+
+Memory usage before: 651&432; after: 417&418; still untouched: 175
+{restoring \box254=void}
+{restoring \hoffset=0.0pt}
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{vertical mode: \penalty}
+! Number too big.
+l.326 \penalty-2147483648
+ % see?
+I can only go up to 2147483647='17777777777="7FFFFFFF,
+so I'm using that number instead of yours.
+
+{\tabskip}
+{\let}
+{\count}
+{begin-group character {}
+{\errhelp}
+{\errmessage}
+! .
+l.328 ...l is lost}\errmessage{}
+ }
+all is lost
+
+{end-group character }}
+{restoring \errhelp=}
+{blank space }
+{\def}
+{blank space }
+{\looseness}
+{\setbox}
+{internal vertical mode: \vskip}
+{end-group character }}
+{restoring \looseness=-1}
+{vertical mode: blank space }
+{\halign}
+{internal vertical mode: \iftrue}
+{true}
+{\else}
+
+\d #1\d ->#1#1
+#1<-##
+! Only one # is allowed per tab.
+<argument> ##
+
+\d #1\d ->#1#1
+
+l.333 ...7200bp minus 4\wd4\d#\d
+ \cr % \d#\d becomes (erroneou...
+There should be exactly one # between &'s, when an
+\halign or \valign is being set up. In this case you had
+more than one, so I'm ignoring all but the first.
+
+{restricted horizontal mode: \global}
+{\spaceskip}
+{\def}
+{\def}
+{\expandafter}
+
+\A ->B
+
+\xx ->\global \gdef \A {\global \count \count 1=####\cr \omit \cr \tabsk
+ip }
+{\global}
+{the letter B}
+{end of alignment template}
+{\vbox}
+{internal vertical mode: \halign}
+
+\A ->\global \count \count 1=##\cr \omit \cr \tabskip
+{restricted horizontal mode: end of alignment template}
+{\global}
+{end of alignment template}
+{restoring \tabskip=4.49998pt plus 7227.0pt}
+{internal vertical mode: the letter A}
+{horizontal mode: the letter A}
+{end-group character }}
+@firstpass
+@secondpass
+[]\ip AA
+@\par via @@0 b=86 p=-10000 d=*
+@@1: line 1.1- t=0 -> @@0
+
+
+Loose \hbox (badness 86) in paragraph at lines 337--337
+ []\ip AA
+
+\hbox(7.0+1.0)x100.0, glue set 0.95
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{restoring \looseness=-1}
+{restricted horizontal mode: blank space }
+{end of alignment template}
+{restoring \xx=undefined}
+{retaining \A=macro:->\global \count \count 1=##\cr \ETC.}
+{restoring \spaceskip=0.0pt}
+{\valign}
+{internal vertical mode: the letter A}
+{horizontal mode: the letter A}
+Missing character: There is no } in font trip!
+{end of alignment template}
+@firstpass
+@secondpass
+[]\ip A
+@\par via @@0 b=86 p=-10000 d=*
+@@1: line 1.1- t=0 -> @@0
+
+
+Loose \hbox (badness 86) in paragraph at lines 337--337
+ []\ip A
+
+\hbox(7.0+1.0)x100.0, glue set 0.95
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{internal vertical mode: end of alignment template}
+{restoring \looseness=-1}
+{begin-group character {}
+{blank space }
+{end-group character }}
+{end of alignment template}
+{end of alignment template}
+{restoring \looseness=-1}
+
+Overfull \vbox (21.99997pt too high) in alignment at lines 337--337
+
+\vbox(-5.0+0.0)x0.0
+.\glue(\tabskip) 4.49998 plus 7227.0
+.\unsetbox(0.0+0.0)x0.0
+.etc.
+
+{restricted horizontal mode: end of alignment template}
+{\global}
+{\fontname}
+{\romannumeral}
+{blank space }
+{\lccode}
+
+\A ->\uppercase { \message {trip at 5.0pt\ip mix}\lowercase {vq}}
+{\uppercase}
+{blank space }
+{\message}
+TRIP AT 5.0PT\ip AIX
+{\lowercase}
+{the letter v}
+Missing character: There is no v in font trip!
+{the letter b}
+{blank space }
+{end of alignment template}
+{math shift character $}
+{math mode: math shift character $}
+{restoring \fam=0}
+{restricted horizontal mode: end of alignment template}
+
+\A ->\uppercase { \message {trip at 5.0pt\ip mix}\lowercase {vq}}
+{\hss}
+{\uppercase}
+{blank space }
+{\message}
+TRIP AT 5.0PT\ip AIX
+{\lowercase}
+{the letter v}
+Missing character: There is no v in font trip!
+{the letter b}
+{blank space }
+{end of alignment template}
+{restoring \lccode81=113}
+{\show}
+> \A=macro:
+->\uppercase { \message {trip at 5.0pt\ip mix}\lowercase {vq}} .
+<template> \A
+ \endtemplate
+l.340 ...\omit$$\span\A&\show\cr
+ \omit\cr
+
+{end of alignment template}
+{end of alignment template}
+{internal vertical mode: \global}
+{\errmessage}
+! \count 2=-1118806.
+<recently read> }
+
+l.341 ...ge{\count2=\the\count2}
+ }
+This error message was generated by an \errmessage
+command, so I can't give any explicit help.
+Pretend that you're Hercule Poirot: Examine all clues,
+and deduce the truth by order and method.
+
+{end-group character }}
+{restoring \looseness=-1}
+{restricted horizontal mode: \mark}
+{end of alignment template}
+{\mark}
+{end of alignment template}
+{restoring \tabskip=0.0154pt minus 3.21002pt}
+
+Tight \hbox (badness 12) in alignment at lines 331--342
+ [] [] [] []
+
+\hbox(0.0+0.0)x205.12613, glue set - 0.5
+.\glue(\tabskip) 0.0154 minus 3.21002
+.\unsetbox(0.0+0.0)x0.0
+.etc.
+
+%% goal height=16383.99998, max depth=2.0
+% t=20.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+% t=30.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+% t=40.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{vertical mode: blank space }
+{\errmessage}
+! \prevdepth =0.0pt.
+l.343 ...evdepth=\the\prevdepth}
+
+(That was another \errmessage.)
+
+{blank space }
+{\penalty}
+% t=40.0 plus 40.0 plus 1.0fil g=16383.99998 b=0 p=-88888 c=-88888#
+\output->{\tracingcommands 0\showthe \outputpenalty \showboxbreadth 9999
+ \showboxdepth 9999 \hoffset 1sp {\setbox 254=\box 255\shipout \ifvbox 2
+\ifhbox 254 \error \fi 54\copy 25\fi 4} \ifvoid 254\relax \else \error \
+fi }
+{internal vertical mode: \tracingcommands}
+> -88888.
+<output> ...wthe \outputpenalty
+ \showboxbreadth 9999 \showbox...
+l.344 \penalty-88888
+ % end alignment test, now miscellaneous ...
+
+
+Completed box being shipped out [-2.2.-1118806.0.11.196608.327680.157286
+4.1073741823]
+\vbox(16383.99998+0.0)x205.12613, glue set 16344.0fil
+.\glue(\topskip) 0.0 plus 1.0fil
+.\hbox(20.0+2.0)x205.12613, glue set - 0.5
+..\glue(\tabskip) 0.0154 minus 3.21002
+..\hbox(20.0+2.0)x0.0, glue set - 1.0
+...\ip B
+...\vbox(20.0+1.0)x100.0
+....\hbox(0.0+0.0)x0.0, glue set 0.00174
+.....\glue(\tabskip) 4.49998 plus 7227.0
+.....\hbox(0.0+0.0)x0.0
+.....\glue(\tabskip) -17.07162
+....\glue(\baselineskip) 10.0
+....\hbox(0.0+0.0)x0.0, glue set 0.00174
+.....\glue(\tabskip) 4.49998 plus 7227.0
+.....\hbox(0.0+0.0)x0.0
+.....\glue(\tabskip) -17.07162
+....\glue(\parskip) 0.0 plus 42.0 minus 8.0
+....\glue(\baselineskip) 3.0
+....\hbox(7.0+1.0)x100.0, glue set 0.95
+.....\glue(\leftskip) 3.0
+.....\hbox(0.0+0.0)x0.0
+.....\ip A (ligature AA)
+.....\penalty 10000
+.....\glue(\parfillskip) 0.0 plus 100.0
+.....\glue(\rightskip) 0.0
+...\glue(\spaceskip) 4.0 minus 0.00002
+..\glue(\tabskip) 0.0154 minus 3.21002
+..\hbox(0.0+0.0)x106.9846
+..\glue(\tabskip) 0.0154 minus 3.21002
+..\hbox(20.0+2.0)x100.0
+...\vbox(-5.0+0.0)x100.0
+....\glue(\tabskip) 4.49998 plus 7227.0
+....\vbox(0.0+0.0)x100.0
+.....\hbox(7.0+1.0)x100.0, glue set 0.95
+......\glue(\leftskip) 3.0
+......\hbox(0.0+0.0)x0.0
+......\ip A
+......\penalty 10000
+......\glue(\parfillskip) 0.0 plus 100.0
+......\glue(\rightskip) 0.0
+....\glue(\tabskip) 0.0
+....\vbox(8.0+0.0)x0.0
+....\glue(\tabskip) 4.49998 plus 7227.0
+...\vbox(-5.0+0.0)x0.0
+....\glue(\tabskip) 4.49998 plus 7227.0
+....\vbox(0.0+0.0)x0.0
+....\glue(\tabskip) 0.0
+....\vbox(8.0+0.0)x0.0
+....\glue(\tabskip) 4.49998 plus 7227.0
+..\glue(\tabskip) 4.49998 plus 7227.0
+.\glue(\baselineskip) 0.0
+.\hbox(8.0+2.0)x205.12613, glue set - 0.5
+..\glue(\tabskip) 0.0154 minus 3.21002
+..\hbox(8.0+2.0)x0.0, glue set 177.80537fil
+...\glue 4.0 plus 2.0 minus 88.0
+...\glue 4.0 plus 2.0 minus 88.0
+...\ip b
+...\glue 4.0 plus 2.0 minus 88.0
+...\mathon
+...\mathoff
+...\glue 0.0 plus 1.0fil minus 1.0fil
+...\glue 4.0 plus 2.0 minus 88.0
+...\ip b
+...\glue 4.0 plus 2.0 minus 88.0
+..\glue(\tabskip) 0.0154 minus 3.21002
+..\hbox(0.0+0.0)x106.9846
+..\glue(\tabskip) 0.0154 minus 3.21002
+..\hbox(0.0+0.0)x100.0
+..\glue(\tabskip) 4.49998 plus 7227.0
+..\hbox(8.0+2.0)x0.0
+..\glue(\tabskip) 0.0154 minus 3.21002
+.\glue(\baselineskip) 8.0
+.\hbox(0.0+0.0)x205.12613, glue set - 0.5
+..\glue(\tabskip) 0.0154 minus 3.21002
+..\hbox(0.0+0.0)x0.0
+..\glue(\tabskip) 0.0154 minus 3.21002
+.\glue(\lineskip) 0.0 plus 40.0
+.\hbox(0.0+0.0)x205.12613, glue set - 0.5
+..\glue(\tabskip) 0.0154 minus 3.21002
+..\hbox(0.0+0.0)x0.0
+..\glue(\tabskip) 0.0154 minus 3.21002
+..\hbox(0.0+0.0)x106.9846
+..\glue(\tabskip) 0.0154 minus 3.21002
+.\mark{a}
+.\mark{b}
+
+Memory usage before: 776&458; after: 464&452; still untouched: 175
+{restoring \box254=void}
+{restoring \hoffset=0.0pt}
+{restoring \showboxdepth=1}
+{restoring \showboxbreadth=2}
+{restoring \tracingcommands=2}
+{restoring \looseness=-1}
+{vertical mode: \newlinechar}
+{\global}
+!
+ou can't use a prefix with `\unskip'.
+<to be read again>
+ \unskip
+l.345 ...inechar`
+\global\unskip
+ \show^^
+\newlinechar\lastpena...
+I'll pretend you didn't say \long or \outer or \global.
+
+{\unskip}
+{\show}
+> the character ^^Y.
+l.345 ...
+\global\unskip\show^^
+
+ \newlinechar\lastpenalty\unpe...
+
+{\newlinechar}
+{\unpenalty}
+! You can't use `\unpenalty' in vertical mode.
+l.345 ...r\lastpenalty\unpenalty
+ \unkern
+Sorry...I usually can't take things from the current page.
+Perhaps you can make the output routine do it.
+
+{\unkern}
+! You can't use `\unkern' in vertical mode.
+l.345 ...enalty\unpenalty\unkern
+
+Sorry...I usually can't take things from the current page.
+Try `I\kern-\lastkern' instead.
+
+{\lastbox}
+! You can't use `\lastbox' in vertical mode.
+l.346 \lastbox
+ \penalty5\message{\the\lastpenalty\the\newlinec...
+Sorry...I usually can't take things from the current page.
+This \lastbox will therefore be void.
+
+{\penalty}
+{\message}
+510000
+{\textfont}
+! Bad number (16).
+<to be read again>
+ =
+l.346 ...ewlinechar}\textfont16=
+ \relax
+Since I expected to read a number between 0 and 15,
+I changed this one to zero.
+
+! Missing font identifier.
+<to be read again>
+ \relax
+l.346 ...char}\textfont16=\relax
+
+I was looking for a control sequence whose
+current meaning has been defined by \font.
+
+{\relax}
+{\outer}
+! Missing control sequence inserted.
+<inserted text>
+ \inaccessible
+<to be read again>
+ {
+l.347 \outer\def{
+ }?
+Please don't say `\def cs{...}', say `\def\cs{...}'.
+I've inserted an inaccessible control sequence so that your
+definition will be completed without mixing me up too badly.
+You can recover graciously from this error, if you're
+careful; see exercise 27.2 in The TeXbook.
+
+{the character ?}
+{horizontal mode: the character ?}
+Missing character: There is no ? in font trip!
+{blank space }
+{\dimen}
+{\showthe}
+> -16383.99998pt.
+l.348 ...77777sp\showthe\dimen5
+ % this should be OK
+
+{\dimen}
+! Dimension too large.
+<to be read again>
+ \showthe
+l.349 \dimen6=-'40000pt\showthe
+ \dimen6 % this should overflow
+I can't work with sizes bigger than about 19 feet.
+Continue and I'll use the largest value I can.
+
+{\showthe}
+> -16383.99998pt.
+l.349 ...40000pt\showthe\dimen6
+ % this should overflow
+
+{\dimen}
+{\showthe}
+> -8355.74998pt.
+l.350 ...\dimen5\showthe\dimen7
+ \multiply\dimen7 2\showthe\di...
+
+{\multiply}
+! Arithmetic overflow.
+<to be read again>
+ \showthe
+l.350 ...ltiply\dimen7 2\showthe
+ \dimen7
+I can't carry out that multiplication or division,
+since the result is out of range.
+
+{\showthe}
+> -8355.74998pt.
+l.350 ...dimen7 2\showthe\dimen7
+
+
+{undefined}
+! Undefined control sequence.
+l.351 \a^^@^^@a
+ @ % an undefined control sequence followed by ...
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+! Text line contains an invalid character.
+l.351 \a^^@^^@a@
+ % an undefined control sequence followed by ...
+A funny symbol that I can't read has just been input.
+Continue, and I'll forget that it ever happened.
+
+{begin-group character {}
+{\aftergroup}
+{\aftergroup}
+{\gdef}
+{blank space }
+{\def}
+{blank space }
+
+\b ->\c
+
+\c ->
+{end-group character }}
+{restoring \c=undefined}
+
+\gobble #1->
+#1<-\c
+{blank space }
+{\def}
+{blank space }
+{\outer}
+{\toks0}
+Runaway text?
+! Forbidden control sequence found while scanning text of \tokens.
+<inserted text>
+ }
+<to be read again>
+ \a^^@^^@a
+l.354 ...ar#2{}\tokens{\a^^@^^@a
+ \par!
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+
+\a^^@^^@a #1\par #2->
+#1<-
+#2<-!
+{blank space }
+{\long}
+{blank space }
+{\outer}
+! Parameters must be numbered consecutively.
+<to be read again>
+ 8
+l.356 ...ef\lo#1#2U3#4#5#6#7#8#8
+ #9#{\relax}
+I've inserted the digit you should have used after the #.
+Type `1' to delete what you did use.
+
+! You already have nine parameters.
+l.356 ...\lo#1#2U3#4#5#6#7#8#8#9
+ #{\relax}
+I'm going to ignore the # sign you just used.
+
+{blank space }
+{\ifcase}
+{case 1}
+
+\l #1->
+#1<-\par
+
+\b #1\par ->
+Runaway argument?
+{
+! Paragraph ended before \b was complete.
+<to be read again>
+ \par
+l.357 ...defined\or\l\par\b{\par
+ % occurrence of \par aborts \b
+I suspect you've forgotten a `}', causing me to apply this
+control sequence to too much text. How can we recover?
+My plan is to forget the whole thing and hope for the best.
+
+{\par}
+@firstpass
+@secondpass
+[]
+@ via @@0 b=10000 p=0 d=100000782
+@@1: line 1.0 t=100000782 -> @@0
+
+@\par via @@0 b=22 p=-10000 d=529
+@@2: line 1.1- t=529 -> @@0
+@\par via @@1 b=10000 p=-10000 d=100000000
+@@3: line 2.0- t=200000782 -> @@1
+
+
+Loose \hbox (badness 22) in paragraph at lines 347--357
+ []
+
+\hbox(0.0+0.0)x100.0, glue set 0.60527
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+%% goal height=16383.99998, max depth=2.0
+
+\b #1\par ->
+#1<-\l \undefined
+{vertical mode: \else}
+{\ifcase}
+{\iftrue}
+{true}
+{case -1}
+{\ifcase}
+{\fi}
+{case 5}
+{\fi}
+{\catcode}
+{\let}
+{\def}
+{blank space }
+{\halign}
+{internal vertical mode: \ifcase}
+{case 3}
+! Incomplete \ifcase; all text was ignored after line 363.
+<inserted text>
+ \fi
+<to be read again>
+ \lo
+l.363 \^^C{{\span\ifcase3 \lo
+ #\cr............89{}\cr} % runaw...
+A forbidden control sequence occurred in skipped text.
+This kind of error happens when you say `\if...' and forget
+the matching `\fi'. I've inserted a `\fi'; this might work.
+
+Runaway preamble?
+{
+! Forbidden control sequence found while scanning preamble of \^^C.
+<inserted text>
+ \cr }
+<to be read again>
+ \lo
+l.363 \^^C{{\span\ifcase3 \lo
+ #\cr............89{}\cr} % runaw...
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+! Missing # inserted in alignment preamble.
+<to be read again>
+ \cr
+<inserted text> \cr
+ }
+<to be read again>
+ \lo
+l.363 \^^C{{\span\ifcase3 \lo
+ #\cr............89{}\cr} % runaw...
+There should be exactly one # between &'s, when an
+\halign or \valign is being set up. In this case you had
+none, so I've put one in; maybe that will work.
+
+
+\lo #1#2U3#4#5#6#7#8#989{->\relax {
+#1<-##
+#2<-\cr
+U3<-.
+#4<-.
+#5<-.
+#6<-.
+#7<-.
+#8<-.
+#9<-......
+{vertical mode: \relax}
+{begin-group character {}
+{end-group character }}
+{\cr}
+! Misplaced \cr.
+l.363 ...#\cr............89{}\cr
+ } % runaway preamble?
+I can't figure out why you would want to use a tab mark
+or \cr or \span just now. If something like a right brace
+up above has ended a previous alignment prematurely,
+you're probably due for more error messages, and you
+might try typing `S' now just to see what is salvageable.
+
+{end-group character }}
+! Too many }'s.
+l.363 ...\cr............89{}\cr}
+ % runaway preamble?
+You've closed more groups than you opened.
+Such booboos are generally harmless, so keep going.
+
+{blank space }
+{\def}
+! Illegal parameter number in definition of \a.
+<to be read again>
+ 2
+l.364 \def\a^^C1{\d#1\d\l{#2
+ }\l#1\par\a^^@^^@a#1\par# % runaw...
+You meant to type ## instead of #, right?
+Or maybe a } was forgotten somewhere earlier, and things
+are all screwed up? I'm going to assume that you meant ##.
+
+Runaway definition?
+^^C1->\d ^^C1\d \l {##2}\l ^^C1\par
+! Forbidden control sequence found while scanning definition of \a.
+<inserted text>
+ }
+<to be read again>
+ \a^^@^^@a
+l.364 ...\l{#2}\l#1\par\a^^@^^@a
+ #1\par# % runaway in definiti...
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+
+\a^^@^^@a #1\par #2->
+#1<-##1
+#2<-##
+{blank space }
+{\xdef}
+
+\d #1\d ->#1#1
+#1<-##1
+
+\l #1->
+#1<-##2
+
+\l #1->
+#1<-##
+Runaway definition?
+^^C1->^^C1^^C11\par
+! Forbidden control sequence found while scanning definition of \a.
+<inserted text>
+ }
+<to be read again>
+ \a^^@^^@a
+l.365 ...\l{#2}\l#1\par\a^^@^^@a
+ #1\par# % runaway in definiti...
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+
+\a^^@^^@a #1\par #2->
+#1<-##1
+#2<-##
+{blank space }
+
+\T 12#101001{->-.#1pt{
+Runaway argument?
+! Forbidden control sequence found while scanning use of \T.
+<inserted text>
+ \par
+<to be read again>
+ \a^^@^^@a
+l.366 \T^^?a^^@^^@a
+ \par{\lo\par % runaway in use
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+! Use of \T doesn't match its definition.
+<inserted text>
+ \par
+<to be read again>
+ \a^^@^^@a
+l.366 \T^^?a^^@^^@a
+ \par{\lo\par % runaway in use
+If you say, e.g., `\def\a1{...}', then you must always
+put `1' after `\a', since control sequence names are
+made up of letters only. The macro here has not been
+followed by the required stuff, so I'm ignoring it.
+
+{\par}
+
+\a^^@^^@a #1\par #2->
+#1<-
+Runaway argument?
+{
+! Forbidden control sequence found while scanning use of \a^^@^^@a.
+<inserted text>
+ \par
+<to be read again>
+ \lo
+l.366 \T^^?a^^@^^@a\par{\lo
+ \par % runaway in use
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+
+\lo #1#2U3#4#5#6#7#8#989{->\relax {
+#1<-\par
+Runaway argument?
+! Forbidden control sequence found while scanning use of \lo.
+<inserted text>
+ \par
+<to be read again>
+ \lo
+l.367 \lo
+ \par\par\par P \par\par\par\par\par\par89{} \muski...
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+
+\lo #1#2U3#4#5#6#7#8#989{->\relax {
+#1<-\par
+#2<-\par
+U3<-\par
+#4<-P
+#5<-\par
+#6<-\par
+#7<-\par
+#8<-\par
+#9<-\par \par
+{\relax}
+{begin-group character {}
+{end-group character }}
+{blank space }
+{\muskip}
+{\muskipdef}
+{\muskip3}
+{\showthe}
+> 5.0mu plus 4.0mu minus 2.0mu.
+l.368 ....5\shmip \showthe\shmip
+
+
+{begin-group character {}
+{\advance}
+! Incompatible glue units.
+l.369 {\advance\shmip by \shkip
+ \endlinechar-1
+I'm going to assume that 1mu=1pt when they're mixed.
+
+{\endlinechar}
+{\divide}
+{\endlinechar}
+{\global}
+{\showthe}
+> 0.0mu minus -0.00003fil.
+l.372 \showthe\shmip
+
+
+{end-group character }}
+{restoring \endlinechar=13}
+{retaining \muskip3=0.0mu minus -0.00003fil}
+{\divide}
+! Arithmetic overflow.
+l.374 By ^^p
+ \toks1={\a\test}
+I can't carry out that multiplication or division,
+since the result is out of range.
+
+{\toks}
+{blank space }
+{superscript character ^}
+! Missing $ inserted.
+<inserted text>
+ $
+<to be read again>
+ ^
+l.375 ^
+ \leaders\vrule\mskip\shmip M\leaders\hrule\nonscript\h...
+I've inserted a begin-math/end-math symbol since I think
+you left one out. Proceed, with fingers crossed.
+
+{math shift character $}
+% t=20.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{horizontal mode: math shift character $}
+{math mode: superscript character ^}
+! Missing { inserted.
+<to be read again>
+ \leaders
+l.375 ^\leaders
+ \vrule\mskip\shmip M\leaders\hrule\nonscript\h...
+A left brace was mandatory here, so I've put one in.
+You might want to delete and/or insert some corrections
+so that I will find a matching right brace soon.
+(If you're confused by all this, try typing `I}' now.)
+
+{\leaders}
+{the letter M}
+{\leaders}
+! Leaders not followed by proper glue.
+<to be read again>
+ \nonscript
+l.375 ...leaders\hrule\nonscript
+ \hskip\thinmuskip
+You should say `\leaders <box or rule><hskip or vskip>'.
+I found the <box or rule>, but there's no suitable
+<hskip or vskip>, so I'm ignoring these leaders.
+
+{\nonscript}
+{\hskip}
+! Incompatible glue units.
+l.375 ...script\hskip\thinmuskip
+
+I'm going to assume that 1mu=1pt when they're mixed.
+
+{\par}
+! Missing $ inserted.
+<inserted text>
+ $
+<to be read again>
+ \par
+l.376
+
+I've inserted a begin-math/end-math symbol since I think
+you left one out. Proceed, with fingers crossed.
+
+{math shift character $}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ $
+<to be read again>
+ \par
+l.376
+
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+{math shift character $}
+{restoring \fam=0}
+{horizontal mode: \par}
+@firstpass
+@secondpass
+[]$[]$
+@\par via @@0 b=80 p=-10000 d=*
+@@1: line 1.1- t=0 -> @@0
+
+
+Loose \hbox (badness 80) in paragraph at lines 375--376
+ []$[]$
+
+\hbox(8.2+0.0)x100.0, glue set 0.9301
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{vertical mode: begin-group character {}
+{\setbox}
+{restricted horizontal mode: \vfill}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ \vfill
+l.377 {\setbox3\hbox{\vfill
+ \vsplit 3 0pt}
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+{vertical mode: \vfill}
+{\vsplit}
+! Missing `to' inserted.
+<to be read again>
+ 0
+l.377 ...\hbox{\vfill\vsplit 3 0
+ pt}
+I'm working on `\vsplit<box number> to <dimen>';
+will look for the <dimen> next.
+
+! \vsplit needs a \vbox.
+<to be read again>
+ }
+l.377 ...ox{\vfill\vsplit 3 0pt}
+
+The box you are trying to split is an \hbox.
+I can't split such a box, so I'll leave it alone.
+
+{end-group character }}
+{restoring \box3=
+\vbox(0.0+-8.53581)x0.0 []}
+{blank space }
+{\def}
+! Parameters must be numbered consecutively.
+<to be read again>
+ 2
+l.378 \def\a#2
+ {}
+I've inserted the digit you should have used after the #.
+Type `1' to delete what you did use.
+
+{blank space }
+{\show}
+> the letter A.
+l.379 \show A
+
+
+{blank space }
+{\show}
+> \a^^@^^@a=\outer macro:
+#1\par #2->.
+l.380 \show\a^^@^^@a
+
+
+{\show}
+> (=macro:
+->\delimiter "4162362 .
+l.381 \show (
+
+
+{blank space }
+{\message}
+{\meaning}
+{\noexpand}
+\long\outer macro:#1#2U3#4#5#6#7#8#989{->\relax {\lo
+{blank space }
+{\show}
+> \^^C=\halign.
+l.383 \show\^^C
+
+
+{blank space }
+{\show}
+> \batchmode=\batchmode.
+l.384 \show\batchmode
+
+
+{\show}
+> \error=undefined.
+l.385 \show\error
+
+
+{\showthe}
+> {\tracingcommands 0\showthe \outputpenalty \showboxbreadth 9999 \showb
+oxdepth 9999 \hoffset 1sp {\setbox 254=\box 255\shipout \ifvbox 2\ifhbox
+ 254 \error \fi 54\copy 25\fi 4} \ifvoid 254\relax \else \error \fi }.
+l.386 \showthe\output
+
+
+{\showthe}
+> 1.0mu plus 2.0fill minus 3.0mu.
+l.387 \showthe\thinmuskip
+
+
+{\showthe}
+> -2.0pt.
+<recently read> \enorm
+
+l.388 \showthe\fontdimen1\enorm
+
+
+{\ifx}
+{false}
+{\par}
+% t=30.0 plus 42.0 plus 1.0fil minus 8.0 g=16383.99998 b=0 p=0 c=0#
+{\if}
+{\else}
+{true}
+{\else}
+{\fi}
+{\ifdim}
+{\iftrue}
+{true}
+! Missing = inserted for \ifdim.
+<to be read again>
+ 1
+l.390 \ifdim72p\iftrue t1
+ i\fi n\fi\fi \message{\jobname\ifx\l...
+I was expecting to see `<', `=', or `>'. Didn't.
+
+{\fi}
+{\fi}
+{false}
+{\fi}
+! Extra \fi.
+l.390 ...p\iftrue t1i\fi n\fi\fi
+ \message{\jobname\ifx\lo\lo ...
+I'm ignoring this; it doesn't match any \if.
+
+{\message}
+{\jobname}
+{\ifx}
+{true}
+tripOK
+{\fi}
+{\hangindent}
+{begin-group character {}
+{\if}
+{true}
+{blank space }
+{\prevgraf}
+{\if}
+{false}
+! Bad \prevgraf (-1).
+<to be read again>
+ \relax
+l.392 ...f 0123\error\else\relax
+ \fi\else\error\fi
+I allow only nonnegative values here.
+
+{\relax}
+{\fi}
+{\else}
+{\prevgraf}
+{\global}
+{end-group character }}
+{\showthe}
+> 2.
+l.393 ...er=2}\showthe\hangafter
+ \showthe\prevgraf
+
+{\showthe}
+> 1.
+l.393 ...gafter\showthe\prevgraf
+
+
+{\char}
+{horizontal mode: \char}
+Missing character: There is no ^^83 in font trip!
+{\showthe}
+> 0.
+l.394 \char'203\showthe\prevgraf
+ $\indent\mark{twain}
+
+{math shift character $}
+{math mode: \indent}
+{\mark}
+{blank space }
+{\setbox}
+{restricted horizontal mode: \vrule}
+{end-group character }}
+{math mode: alignment tab character &}
+! Misplaced alignment tab character &.
+l.395 \setbox3\hbox{\vrule}&
+ \moveleft\lastbox % can't do that...
+I can't figure out why you would want to use a tab mark
+here. If you just want an ampersand, the remedy is
+simple: Just type `I\&' now. But if some right brace
+up above has ended a previous alignment prematurely,
+you're probably due for more error messages, and you
+might try typing `S' now just to see what is salvageable.
+
+{\moveleft}
+! You can't use `\moveleft' in math mode.
+l.395 ...\hbox{\vrule}&\moveleft
+ \lastbox % can't do that in m...
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+{\lastbox}
+! You can't use `\lastbox' in math mode.
+l.395 ...rule}&\moveleft\lastbox
+ % can't do that in math mode
+Sorry; this \lastbox will be void.
+
+{\unhbox}
+{\unhcopy}
+! Incompatible list can't be unboxed.
+<to be read again>
+ \accent
+l.396 \unhbox234\unhcopy3\accent
+ \x\vfill\vfil\vfilneg\vss % \...
+Sorry, Pandora. (You sneaky devil.)
+I refuse to unbox an \hbox in vertical mode or vice versa.
+And I can't open any boxes in math mode.
+
+{\accent}
+! Please use \mathaccent for accents in math mode.
+<recently read> \accent
+
+l.396 \unhbox234\unhcopy3\accent
+ \x\vfill\vfil\vfilneg\vss % \...
+I'm changing \accent to \mathaccent here; wish me luck.
+(Accents are not the same in formulas as they are in text.)
+
+! Missing { inserted.
+<to be read again>
+ \vfill
+l.396 ...unhcopy3\accent\x\vfill
+ \vfil\vfilneg\vss % \vfill ex...
+A left brace was mandatory here, so I've put one in.
+You might want to delete and/or insert some corrections
+so that I will find a matching right brace soon.
+(If you're confused by all this, try typing `I}' now.)
+
+{\vfill}
+! Missing $ inserted.
+<inserted text>
+ $
+<to be read again>
+ \vfill
+l.396 ...unhcopy3\accent\x\vfill
+ \vfil\vfilneg\vss % \vfill ex...
+I've inserted a begin-math/end-math symbol since I think
+you left one out. Proceed, with fingers crossed.
+
+{math shift character $}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ $
+<to be read again>
+ \vfill
+l.396 ...unhcopy3\accent\x\vfill
+ \vfil\vfilneg\vss % \vfill ex...
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+{math shift character $}
+! \textfont 0 is undefined (character ^^c8).
+<recently read> $
+
+<to be read again>
+ \vfill
+l.396 ...unhcopy3\accent\x\vfill
+ \vfil\vfilneg\vss % \vfill ex...
+Somewhere in the math formula just ended, you used the
+stated character from an undefined font family. For example,
+plain TeX doesn't allow \it or \sl in subscripts. Proceed,
+and I'll try to forget that I needed that character.
+
+{restoring \box3=
+\vbox(0.0+-8.53581)x0.0 []}
+{restoring \fam=0}
+{horizontal mode: \vfill}
+{\par}
+@firstpass
+@secondpass
+[]$[][][]$
+@\par via @@0 b=91 p=-10000 d=*
+@@1: line 1.1- t=0 -> @@0
+
+
+Loose \hbox (badness 91) in paragraph at lines 394--396
+ []$[][]$
+
+\hbox(0.0+0.0)x100.0, glue set 0.97
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{vertical mode: \vfill}
+{\vfil}
+{\vfilneg}
+{\vss}
+{\def}
+! Missing { inserted.
+l.397 \def\a}
+ {\let\a\xyzzy\csname a\endcsname}
+Where was the left brace? You said something like `\def\a}',
+which I'm going to interpret as `\def\a{}'.
+
+{begin-group character {}
+{\let}
+{\csname}
+{\relax}
+{end-group character }}
+{restoring \a=macro:->}
+{blank space }
+{\def}
+{\def}
+{\let}
+{\def}
+{blank space }
+{\ifx}
+{false}
+{\expandafter}
+
+\b ->\a \c
+{\ifx}
+{true}
+{\ifinner}
+{false}
+{\relax}
+{\fi}
+{\else}
+{\fi}
+{\ifvmode}
+{true}
+{math shift character $}
+% t=40.0 plus 84.0 plus 1.0fil plus 1.0fill minus 16.0 g=16383.99998 b=0
+ p=0 c=0#
+! Infinite glue shrinkage found on current page.
+<to be read again>
+ $
+l.402 \ifvmode$
+ \ifmmode\hbox tt\ifhmode\hfilneg\else\error\fi...
+The page about to be output contains some infinitely
+shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'.
+Such glue doesn't belong there; but you can safely proceed,
+since the offensive shrinkability has been made finite.
+
+{horizontal mode: math shift character $}
+{math mode: \ifmmode}
+{true}
+{\hbox}
+! Missing { inserted.
+<to be read again>
+ t
+<to be read again>
+ t
+l.402 \ifvmode$\ifmmode\hbox tt
+ \ifhmode\hfilneg\else\error\fi...
+A left brace was mandatory here, so I've put one in.
+You might want to delete and/or insert some corrections
+so that I will find a matching right brace soon.
+(If you're confused by all this, try typing `I}' now.)
+
+{restricted horizontal mode: the letter t}
+{\ifhmode}
+{true}
+{\hfilneg}
+{\else}
+{end-group character }}
+{math mode: math shift character $}
+{restoring \fam=0}
+{horizontal mode: \fi}
+{\fi}
+{\noalign}
+! Misplaced \noalign.
+l.403 \noalign
+ \omit\endcsname % these are extra
+I expect to see \noalign only after the \cr of
+an alignment. Proceed, and I'll ignore this case.
+
+{\omit}
+! Misplaced \omit.
+l.403 \noalign\omit
+ \endcsname % these are extra
+I expect to see \omit only after tab marks or the \cr of
+an alignment. Proceed, and I'll ignore this case.
+
+{\endcsname}
+! Extra \endcsname.
+l.403 \noalign\omit\endcsname
+ % these are extra
+I'm ignoring this, since I wasn't doing a \csname.
+
+{\fontdimen}
+! Missing font identifier.
+<to be read again>
+ =
+l.404 \fontdimen 1000=
+ 20\varunit\showthe\fontdimen1000\trip\l...
+I was looking for a control sequence whose
+current meaning has been defined by \font.
+
+! Font \FONT? has only 12 fontdimen parameters.
+<to be read again>
+ =
+l.404 \fontdimen 1000=
+ 20\varunit\showthe\fontdimen1000\trip\l...
+To increase the number of font parameters, you must
+use \fontdimen immediately after the \font is loaded.
+
+{\showthe}
+! Font \ip has only 13 fontdimen parameters.
+<recently read> \trip
+
+l.404 ...wthe\fontdimen1000\trip
+ \let\PAR=\par
+To increase the number of font parameters, you must
+use \fontdimen immediately after the \font is loaded.
+
+> 0.0pt.
+<recently read> \trip
+
+l.404 ...wthe\fontdimen1000\trip
+ \let\PAR=\par
+
+{\let}
+{\gdef}
+{\expandafter}
+{\csname}
+{\ifx}
+{true}
+{\mag}
+
+\par ->\relax \PAR
+{\relax}
+{\par}
+@firstpass
+@secondpass
+[]$[]$
+@\par via @@0 b=91 p=-10000 d=*
+@@1: line 1.1- t=0 -> @@0
+
+
+Loose \hbox (badness 91) in paragraph at lines 402--406
+ []$[]$
+
+\hbox(0.0+0.0)x100.0, glue set 0.97
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{vertical mode: \fi}
+{\noindent}
+% t=50.0 plus 126.0 plus 2.0fil plus 2.0fill minus 25.0 g=16383.99998 b=
+0 p=0 c=0#
+{horizontal mode: begin-group character {}
+{\halign}
+
+\par ->\relax \PAR
+{\relax}
+{\par}
+{vertical mode: \halign}
+! Incompatible magnification (1999);
+ the previous value will be retained (2000).
+l.407 ...indent{\halign to 1true
+ mm\expandafter{\csname#\endcs...
+I can handle only one magnification ratio per job. So I've
+reverted to the magnification you used earlier on this run.
+
+{internal vertical mode: \expandafter}
+{\csname}
+{restricted horizontal mode: \relax}
+{\global}
+{undefined}
+! Undefined control sequence.
+<recently read> \foo
+
+<to be read again>
+ \endtemplate
+<template> \endtemplate
+
+l.408 ...bal\futurelet\endt\foo&
+ \show\endt&$&&&.}
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+{end of alignment template}
+{\show}
+> \endt=\outer endtemplate:
+.
+l.408 ...let\endt\foo&\show\endt
+ &$&&&.}
+
+{end of alignment template}
+
+\l #1->
+#1<-$
+{end of alignment template}
+! Extra alignment tab has been changed to \cr.
+<template> }\endtemplate
+
+l.408 ...\endt\foo&\show\endt&$&
+ &&.}
+You have given more \span or & marks than there were
+in the preamble to the \halign or \valign now in progress.
+So I'll assume that you meant to type \cr instead.
+
+{\relax}
+{end of alignment template}
+{end of alignment template}
+
+\l #1->
+#1<-.
+{blank space }
+
+\par ->\relax \PAR
+{\relax}
+{\par}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ \PAR
+l.409
+
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+! Missing \cr inserted.
+<inserted text>
+ \cr
+<to be read again>
+ }
+<to be read again>
+ \PAR
+l.409
+
+I'm guessing that you meant to end an alignment here.
+
+{\cr}
+! Missing { inserted.
+<inserted text>
+ {
+<to be read again>
+ \cr
+<to be read again>
+ }
+<to be read again>
+ \PAR
+l.409
+
+I've put in what seems to be necessary to fix
+the current column of the current alignment.
+Try to go on, since this might almost work.
+
+{begin-group character {}
+{end-group character }}
+{end of alignment template}
+
+Tight \hbox (badness 1) in alignment at lines 407--409
+ [] [] []
+
+\hbox(0.0+0.0)x1.42262, glue set - 0.20552
+.\glue(\tabskip) 0.0154 minus 3.21002
+.\unsetbox(0.0+0.0)x0.0
+.etc.
+
+% t=60.0 plus 168.0 plus 2.0fil plus 2.0fill minus 33.0 g=16383.99998 b=
+0 p=0 c=0#
+{vertical mode: \par}
+{\hbox}
+{restricted horizontal mode: \/}
+{\hrule}
+! You can't use `\hrule' here except with leaders.
+l.410 \hbox{\/\hrule
+ \textfont3=\enorm\prevdepth\advance\xspac...
+To put a horizontal rule in an hbox or an alignment,
+you should use \leaders or \hrulefill (see The TeXbook).
+
+{\textfont}
+{\prevdepth}
+! You can't use `\prevdepth' in restricted horizontal mode.
+l.410 ...tfont3=\enorm\prevdepth
+ \advance\xspaceskip by-\xspac...
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+{\advance}
+{\spacefactor}
+{begin-group character {}
+{blank space }
+{end-group character }}
+{\everymath}
+{\fontdimen}
+{math shift character $}
+\everymath->\radical "3
+{math mode: \radical}
+{end-group character }}
+{\delimiterfactor}
+{\left}
+
+(->\delimiter "4162362
+{the letter A}
+{the letter a}
+{\right}
+{math shift character $}
+{restoring \delimiterfactor=10}
+{restoring \fam=0}
+{restricted horizontal mode: the letter A}
+{\/}
+{end-group character }}
+{restoring \everymath=}
+{restoring \xspaceskip=-1.0pt}
+{restoring \textfont3=\bigtr^^@p}
+% t=70.0 plus 168.0 plus 2.0fil plus 2.0fill minus 33.0 g=16383.99998 b=
+0 p=0 c=0#
+{vertical mode: blank space }
+{\openin}
+{\closein}
+{\iftrue}
+{true}
+{begin-group character {}
+{\ifeof}
+{true}
+{\openin}
+! Bad number (100).
+l.413 ...e{\ifeof 15\openin 100
+ tripos
+Since I expected to read a number between 0 and 15,
+I changed this one to zero.
+
+{\def}
+{blank space }
+{\catcode}
+{\catcode}
+{\outer}
+
+\loop ->\ifeof 0\let \loop =\relax \else {\global \read 0to \a }\show \a
+ \fi \loop
+{\ifeof}
+{false}
+{begin-group character {}
+{\global}
+{end-group character }}
+{\show}
+> \a=macro:
+->\par .
+\loop ...\read 0to \a }\show \a
+ \fi \loop
+l.415 ...er\def\uppercase{}\loop
+ }\else\fi
+
+{\fi}
+
+\loop ->\ifeof 0\let \loop =\relax \else {\global \read 0to \a }\show \a
+ \fi \loop
+{\ifeof}
+{false}
+{begin-group character {}
+{\global}
+Runaway definition?
+->
+! Forbidden control sequence found while scanning definition of \a.
+<inserted text>
+ }
+<read 0> \uppercase
+ {0{\outputpenalty }}
+\loop ... {\global \read 0to \a
+ }\show \a \fi \loop
+l.415 ...er\def\uppercase{}\loop
+ }\else\fi
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+! Text line contains an invalid character.
+<read 0> \uppercase {0
+ {\outputpenalty }}
+\loop ... {\global \read 0to \a
+ }\show \a \fi \loop
+l.415 ...er\def\uppercase{}\loop
+ }\else\fi
+A funny symbol that I can't read has just been input.
+Continue, and I'll forget that it ever happened.
+
+{end-group character }}
+{\show}
+> \a=macro:
+-> .
+\loop ...\read 0to \a }\show \a
+ \fi \loop
+l.415 ...er\def\uppercase{}\loop
+ }\else\fi
+
+{\fi}
+
+\loop ->\ifeof 0\let \loop =\relax \else {\global \read 0to \a }\show \a
+ \fi \loop
+{\ifeof}
+{false}
+{begin-group character {}
+{\global}
+Runaway definition?
+->[
+! Forbidden control sequence found while scanning definition of \a.
+<inserted text>
+ }
+<read 0> [\uppercase
+ {mmmmmmmmmm}[
+\loop ... {\global \read 0to \a
+ }\show \a \fi \loop
+l.415 ...er\def\uppercase{}\loop
+ }\else\fi
+I suspect you have forgotten a `}', causing me
+to read past where you wanted me to stop.
+I'll try to recover; but if the error is serious,
+you'd better type `E' or `X' now and fix your file.
+
+Runaway definition?
+->[ }{mmmmmmmmmm}[
+! File ended within \read.
+<read 0>
+
+\loop ... {\global \read 0to \a
+ }\show \a \fi \loop
+l.415 ...er\def\uppercase{}\loop
+ }\else\fi
+This \read has unbalanced braces.
+
+{end-group character }}
+{\show}
+> \a=macro:
+->[ }{mmmmmmmmmm}[ \par .
+\loop ...\read 0to \a }\show \a
+ \fi \loop
+l.415 ...er\def\uppercase{}\loop
+ }\else\fi
+
+{\fi}
+
+\loop ->\ifeof 0\let \loop =\relax \else {\global \read 0to \a }\show \a
+ \fi \loop
+{\ifeof}
+{true}
+{\let}
+{\else}
+{\relax}
+{end-group character }}
+{restoring \uppercase=\uppercase}
+{restoring \catcode91=12}
+{restoring \catcode48=12}
+{restoring \loop=undefined}
+{\else}
+{end-group character }}
+{restoring \#=undefined}
+{\def}
+
+\test #1->\let \test =
+#1<-.
+{\let}
+{\show}
+> \test=blank space .
+l.416 ...est= }\test. \show\test
+
+
+{\def}
+{blank space }
+{\pretolerance}
+{\toks0}
+{\unhbox}
+% t=3754.40189 plus 208.0 plus 2.0fil plus 2.0fill minus 33.0 g=16383.99
+998 b=0 p=0 c=0#
+{horizontal mode: \unhbox}
+
+\par ->\relax \PAR
+{\relax}
+{\par}
+[]
+@\par via @@0 b=91 p=-10000 d=*
+@@1: line 1.1- t=0 -> @@0
+
+
+Loose \hbox (badness 91) in paragraph at lines 418--418
+ []
+
+\hbox(0.0+0.0)x100.0, glue set 0.97
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{vertical mode: \everycr}
+{blank space }
+{\the}
+
+\a #1->\ifcat #1 \message \ifx #1 {\iffalse \fi \the \tokens \fi \fi }
+#1<-\test
+{\ifcat}
+{true}
+{\message}
+{\ifx}
+{true}
+{\iffalse}
+{false}
+{\fi}
+{\fi}
+\a \test
+{\ifcase}
+{\or}
+{case 1}
+{\ifeof}
+{\fi}
+! Missing number, treated as zero.
+<to be read again>
+ \relax
+<to be read again>
+ \fi
+l.419 ...ens\ifcase1\or\ifeof\fi
+ \def\stopinput{\error\let\inp...
+A number should have been here; I inserted `0'.
+(If you can't figure out why I needed to see a number,
+look up `weird error' in the index to The TeXbook.)
+
+{true}
+{\relax}
+{\fi}
+{\def}
+{blank space }
+{\let}
+{\let}
+{\halign}
+{internal vertical mode: \iffalse}
+{false}
+\everycr->\noalign {\penalty 97}
+{\penalty}
+{end-group character }}
+{restricted horizontal mode: \cr}
+! Misplaced \cr.
+<template> \cr
+
+<to be read again>
+ \cr
+l.420 ...cr#&\ifnum0=`{\fi\cr\cr
+ }
+I can't figure out why you would want to use a tab mark
+or \cr or \span just now. If something like a right brace
+up above has ended a previous alignment prematurely,
+you're probably due for more error messages, and you
+might try typing `S' now just to see what is salvageable.
+
+{alignment tab character &}
+! Misplaced alignment tab character &.
+<template> &
+ \ifnum 0=`{\fi \endtemplate
+l.420 ...cr#&\ifnum0=`{\fi\cr\cr
+ }
+I can't figure out why you would want to use a tab mark
+here. If you just want an ampersand, the remedy is
+simple: Just type `I\&' now. But if some right brace
+up above has ended a previous alignment prematurely,
+you're probably due for more error messages, and you
+might try typing `S' now just to see what is salvageable.
+
+{\ifnum}
+{\fi}
+{false}
+{end of alignment template}
+\everycr->\noalign {\penalty 97}
+{internal vertical mode: \penalty}
+{end-group character }}
+% t=3756.40189 plus 290.0 plus 2.0fil plus 2.0fill minus 41.0 g=16383.99
+998 b=0 p=97 c=97
+% t=3766.40189 plus 290.0 plus 2.0fil plus 2.0fill minus 41.0 g=16383.99
+998 b=0 p=97 c=97
+{vertical mode: blank space }
+{\let}
+{\def}
+{\def}
+
+\unbalanced ->\halign \lb
+{\halign}
+\everycr->\noalign {\penalty 97}
+{internal vertical mode: \penalty}
+{end-group character }}
+{restricted horizontal mode: \relax}
+{\expandafter}
+{\expandafter}
+{\expandafter}
+{\expandafter}
+{\expandafter}
+{\expandafter}
+{\expandafter}
+
+\trap #1->
+#1<-\endtemplate
+{undefined}
+! Undefined control sequence.
+<recently read> \err
+
+<to be read again>
+ \endt
+<template> \endtemplate
+
+l.422 ...rr\e\e\e\endt\e\trap\cr
+ \noexpand\cr}
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+{end of alignment template}
+\everycr->\noalign {\penalty 97}
+{internal vertical mode: \penalty}
+{end-group character }}
+{\noexpand}
+{restricted horizontal mode: end of alignment template}
+\everycr->\noalign {\penalty 97}
+{internal vertical mode: \penalty}
+{end-group character }}
+% t=3766.40189 plus 290.0 plus 2.0fil plus 2.0fill minus 41.0 g=16383.99
+998 b=0 p=97 c=97
+% t=3776.40189 plus 290.0 plus 2.0fil plus 2.0fill minus 41.0 g=16383.99
+998 b=0 p=97 c=97
+% t=3786.40189 plus 290.0 plus 2.0fil plus 2.0fill minus 41.0 g=16383.99
+998 b=0 p=97 c=97
+{vertical mode: blank space }
+
+\par ->\relax \PAR
+{\relax}
+{\par}
+{\expandafter}
+{\input}
+{\endinput}
+{\input}
+(tripos.tex
+\stopinput ->\error \let \input \die
+{undefined}
+! Undefined control sequence.
+\stopinput ->\error
+ \let \input \die
+l.1
+
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+{\let}
+
+\par ->\relax \PAR
+{\relax}
+{\par}
+)
+{\relax}
+{undefined}
+! Undefined control sequence.
+<recently read> \input
+
+l.424 ...t tripos\endinput\input
+ % one line of tripos
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+{\setbox}
+{internal vertical mode: \hbox}
+{restricted horizontal mode: \hbox}
+{\vadjust}
+{internal vertical mode: the letter A}
+{horizontal mode: the letter A}
+{end-group character }}
+[]\ip A
+@\par via @@0 b=86 p=-10000 d=*
+@@1: line 1.1- t=0 -> @@0
+
+
+Loose \hbox (badness 86) in paragraph at lines 425--425
+ []\ip A
+
+\hbox(7.0+1.0)x100.0, glue set 0.95
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{restricted horizontal mode: end-group character }}
+{end-group character }}
+{internal vertical mode: end-group character }}
+
+Underfull \vbox (badness 10000) detected at line 425
+
+\vbox(8192.0+0.0)x0.0
+.\hbox(0.0+0.0)x0.0 []
+
+{vertical mode: \vrule}
+{horizontal mode: \vrule}
+{\unhbox}
+! Incompatible list can't be unboxed.
+<to be read again>
+ \hrule
+l.425 ...}}\vrule\unhbox10\hrule
+
+Sorry, Pandora. (You sneaky devil.)
+I refuse to unbox an \hbox in vertical mode or vice versa.
+And I can't open any boxes in math mode.
+
+{\hrule}
+
+\par ->\relax \PAR
+{\relax}
+{\par}
+[]|
+@\par via @@0 b=89 p=-10000 d=*
+@@1: line 1.1- t=0 -> @@0
+
+
+Loose \hbox (badness 89) in paragraph at lines 425--425
+ []|
+
+\hbox(0.0+0.0)x100.0, glue set 0.966
+.\glue(\leftskip) 3.0
+.\hbox(0.0+0.0)x0.0
+.etc.
+
+{vertical mode: \hrule}
+{\output}
+{\futurelet}
+{\maxdeadcycles}
+{\show}
+> \dump=the character =.
+l.427 ...xdeadcycles=3\show\dump
+
+
+{\catcode}
+{\catcode}
+{\expandafter}
+{\csname}
+{\let}
+{\relax}
+
+\csname\endcsname{->{
+! Use of \csname\endcsname doesn't match its definition.
+l.429 \relax
+ \catcode`\qq1qM=13 \defqqM{\relax}#\begingroup{\s...
+If you say, e.g., `\def\a1{...}', then you must always
+put `1' after `\a', since control sequence names are
+made up of letters only. The macro here has not been
+followed by the required stuff, so I'm ignoring it.
+
+{\catcode}
+{\def}
+{macro parameter character #}
+! You can't use `macro parameter character #' in vertical mode.
+l.429 ...^^M=13 \def^^M{\relax}#
+ \begingroup{\showboxdepth=4\s...
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+{\begingroup}
+{begin-group character {}
+{\showboxdepth}
+{\showbox}
+> \box10=
+\vbox(8192.0+0.0)x0.0
+.\hbox(0.0+0.0)x0.0
+..\hbox(0.0+0.0)x0.0
+...\vadjust
+....\hbox(7.0+1.0)x100.0, glue set 0.95 []
+
+! OK.
+<to be read again>
+ }
+l.429 ...owboxdepth=4\showbox10}
+
+
+{end-group character }}
+{restoring \showboxdepth=1}
+
+^^M->\relax
+{\relax}
+
+^^M->\relax
+{\relax}
+{\long}
+{\immediate}
+\write->\string \caution \l
+{no mode: \string}
+
+\l #1\l ->#1
+! Argument of \l has an extra }.
+<inserted text>
+ \par
+<to be read again>
+ }
+<inserted text> }
+ \endwrite
+l.431 ...e10{\string\caution \l}
+ % living dangerously
+I've run across a `}' that doesn't seem to match anything.
+For example, `\def\a#1{...}' and `\a}' would produce
+this error. If you simply proceed now, the `\par' that
+I've just inserted will cause me to report a runaway
+argument that might be the root of the problem. But if
+your `}' was spurious, just type `2' and it will go away.
+
+Runaway argument?
+! Paragraph ended before \l was complete.
+<to be read again>
+ \par
+<to be read again>
+ }
+<inserted text> }
+ \endwrite
+l.431 ...e10{\string\caution \l}
+ % living dangerously
+I suspect you've forgotten a `}', causing me to apply this
+control sequence to too much text. How can we recover?
+My plan is to forget the whole thing and hope for the best.
+
+
+\par ->\relax \PAR
+\caution\relax \PAR
+{vertical mode: blank space }
+{\escapechar}
+{|tracingoutput}
+{|shipout}
+{internal vertical mode: |copy}
+{|box}
+{end-group character }}
+[-2.2.-1118806.0.11.196608.327680.1572864.1073741823
+! Huge page cannot be shipped out.
+<recently read> }
+
+l.432 ...ox{\copy10qq5e^5cbox10}
+
+The page just created is more than 18 feet tall or
+more than 18 feet wide, so I suspect something went wrong.
+
+The following box has been deleted:
+|vbox(16384.0+0.0)x0.0
+.|vbox(8192.0+0.0)x0.0 []
+.|glue(|lineskip) 0.0 plus 40.0
+.etc.
+
+]
+Memory usage before: 819&428; after: 720&426; still untouched: 175
+
+^^M->|relax
+{vertical mode: |relax}
+{|setbox}
+{restricted horizontal mode: |fontdimen}
+{|afterassignment}
+{|advance}
+! You can't use `|prevdepth' after |advance.
+l.434 ...relax\advance\prevdepth
+ \afterassignment\relax\future...
+I'm forgetting what you said and not changing anything.
+
+{|relax}
+{|afterassignment}
+{|futurelet}
+{|relax}
+
+^^M->|relax
+{|relax}
+{|message}
+{|noexpand}
+{|meaning}
+|l |long macro:#1|l ->#166
+{|vbox}
+{internal vertical mode: |hyphenchar}
+{|-}
+{horizontal mode: |-}
+{| }
+{the letter B}
+
+|par ->|relax |PAR
+{|relax}
+{|par}
+[]
+@|discretionary via @@0 b=10000 p=89 d=100008703
+@@1: line 1.0- t=100008703 -> @@0
+
+@ via @@0 b=10000 p=0 d=100000782
+@ via @@1 b=10000 p=0 d=100000000
+@@2: line 1.0 t=100000782 -> @@0
+|ip BBBBBB
+@|par via @@0 b=62 p=-10000 d=3969
+@|par via @@1 b=66 p=-10000 d=104489
+@|par via @@2 b=66 p=-10000 d=4489
+@@3: line 1.1- t=3969 -> @@0
+
+
+Loose \hbox (badness 62) in paragraph at lines 436--436
+ [] |ip BBBBBB
+
+|hbox(7.0+1.0)x100.0, glue set 0.85294
+.|glue(|leftskip) 3.0
+.|hbox(0.0+0.0)x0.0
+.etc.
+
+{internal vertical mode: |hyphenchar}
+{|-}
+{horizontal mode: |-}
+Missing character: There is no ? in font trip!
+{| }
+{the letter B}
+{end-group character }}
+[]
+@|discretionary via @@0 b=10000 p=89 d=100008703
+@@1: line 1.0- t=100008703 -> @@0
+
+@ via @@0 b=10000 p=0 d=100000782
+@ via @@1 b=10000 p=0 d=100000000
+@@2: line 1.0 t=100000782 -> @@0
+Missing character: There is no ? in font trip!
+|ip BBBBBB
+@|discretionary via @@0 b=10000 p=88 d=100008526
+@|discretionary via @@1 b=10000 p=88 d=100008744
+@|discretionary via @@2 b=10000 p=88 d=100007744
+@@3: line 1.0- t=100008526 -> @@0
+
+@|par via @@0 b=62 p=-10000 d=3969
+@|par via @@1 b=66 p=-10000 d=104489
+@|par via @@2 b=66 p=-10000 d=4489
+@|par via @@3 b=73 p=-10000 d=105476
+@@4: line 1.1- t=3969 -> @@0
+
+
+Loose \hbox (badness 62) in paragraph at lines 436--436
+ [] |ip BBBBBB
+
+|hbox(7.0+1.0)x100.0, glue set 0.85294
+.|glue(|leftskip) 3.0
+.|hbox(0.0+0.0)x0.0
+.etc.
+
+{restricted horizontal mode: |if}
+{|expandafter}
+
+|dol ->$
+{|noexpand}
+{true}
+{|fi}
+{|expandafter}
+{|noexpand}
+{|expandafter}
+{|noexpand}
+{undefined}
+! Undefined control sequence.
+<recently read> |undefined
+
+<to be read again>
+ |notexpanded: |expandafter
+l.437 ...ed\noexpand\expandafter
+ %
+The control sequence at the end of the top line
+of your error message was never \def'ed. If you have
+misspelled it (e.g., `\hobx'), type `I' and the correct
+spelling (e.g., `I\hbox'). Otherwise just continue,
+and I'll forget about whatever was undefined.
+
+{|relax}
+{math shift character $}
+{math mode: |begingroup}
+{|mathop}
+{|vbox}
+{internal vertical mode: |vss}
+{end-group character }}
+{math mode: end-group character }}
+{|limits}
+{superscript character ^}
+! Missing { inserted.
+<to be read again>
+ |mathchoice
+l.438 ...ss}}\limits^\mathchoice
+ {}a}{A|{}}{\mathchoice}
+A left brace was mandatory here, so I've put one in.
+You might want to delete and/or insert some corrections
+so that I will find a matching right brace soon.
+(If you're confused by all this, try typing `I}' now.)
+
+{|mathchoice}
+{end-group character }}
+! Missing { inserted.
+<to be read again>
+ a
+l.438 ...}\limits^\mathchoice{}a
+ }{A|{}}{\mathchoice}
+A left brace was mandatory here, so I've put one in.
+You might want to delete and/or insert some corrections
+so that I will find a matching right brace soon.
+(If you're confused by all this, try typing `I}' now.)
+
+{the letter a}
+{end-group character }}
+{the letter A}
+{subscript character |}
+{end-group character }}
+{end-group character }}
+{|mathchoice}
+! Missing { inserted.
+<to be read again>
+ }
+l.438 ...{}a}{A|{}}{\mathchoice}
+
+A left brace was mandatory here, so I've put one in.
+You might want to delete and/or insert some corrections
+so that I will find a matching right brace soon.
+(If you're confused by all this, try typing `I}' now.)
+
+{end-group character }}
+
+^^M->|relax
+{end-group character }}
+{|relax}
+{begin-group character {}
+{end-group character }}
+{begin-group character {}
+{the letter B}
+{|over}
+{end-group character }}
+{|endgroup}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ |endgroup
+l.439 ...elax{}{B\over}\endgroup
+ \showlonglists$}\showboxbread...
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+! Missing { inserted.
+<to be read again>
+ |endgroup
+l.439 ...elax{}{B\over}\endgroup
+ \showlonglists$}\showboxbread...
+A left brace was mandatory here, so I've put one in.
+You might want to delete and/or insert some corrections
+so that I will find a matching right brace soon.
+(If you're confused by all this, try typing `I}' now.)
+
+{|endgroup}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ |endgroup
+l.439 ...elax{}{B\over}\endgroup
+ \showlonglists$}\showboxbread...
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+{|endgroup}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ |endgroup
+l.439 ...elax{}{B\over}\endgroup
+ \showlonglists$}\showboxbread...
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+{|endgroup}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ |endgroup
+l.439 ...elax{}{B\over}\endgroup
+ \showlonglists$}\showboxbread...
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+{|endgroup}
+
+|showlonglists ->{|tracingcommands 0|pagefillstretch -1|dimen 100 |showb
+oxbreadth 9999 |showboxdepth 9999 |showlists |pagegoal =10000pt}
+{begin-group character {}
+{|tracingcommands}
+
+### math mode entered at line 439
+### math mode entered at line 438
+|mathop|limits
+.|vbox(0.0+0.0)x0.0
+..|glue 0.0 plus 1.0fil minus 1.0fil
+^|mathchoice
+^T|mathord
+^T.|fam1 a
+^S|mathord
+^S.|fam1 A
+^S_{}
+^s|mathchoice
+^sS|mathord
+^sS.{}
+^sS|mathord
+^sS.|fraction, thickness = default
+^sS.\|mathord
+^sS.\.|fam1 B
+^sS./{}
+|mathord
+### restricted horizontal mode entered at line 433
+|vbox(17.0+1.0)x100.0
+.|hbox(7.0+1.0)x100.0, glue set 0.85294
+..|glue(|leftskip) 3.0
+..|hbox(0.0+0.0)x0.0
+..|discretionary
+..|glue 0.0 plus 2.0 minus 88.0
+..|ip A (ligature BB)
+..|kern2.0
+..|ip A (ligature BB)
+..|kern2.0
+..|ip A (ligature BB)
+..|penalty 10000
+..|glue(|parfillskip) 0.0 plus 100.0
+..|glue(|rightskip) 0.0
+.|glue(|parskip) 0.0 plus 42.0 minus 8.0
+.|glue(|baselineskip) 2.0
+.|hbox(7.0+1.0)x100.0, glue set 0.85294
+..|glue(|leftskip) 3.0
+..|hbox(0.0+0.0)x0.0
+..|discretionary
+..|glue 0.0 plus 2.0 minus 88.0
+..|ip A (ligature BB)
+..|kern2.0
+..|discretionary replacing 3
+...|ip B
+..||ip A (ligature BB)
+..||kern2.0
+..||ip B
+..|ip A (ligature BB)
+..|kern2.0
+..|ip A (ligature BB)
+..|penalty 10000
+..|glue(|parfillskip) 0.0 plus 100.0
+..|glue(|rightskip) 0.0
+spacefactor 1000
+### vertical mode entered at line 0
+### current page:
+|glue(|topskip) 20.0 plus 1.0fil
+|hbox(0.0+0.0)x100.0, glue set 0.60527
+.|glue(|leftskip) 3.0
+.|hbox(0.0+0.0)x0.0
+.|glue 4.0 plus 2.0 minus 88.0
+.|glue 4.0 plus 2.0 minus 88.0
+.|glue 4.0 plus 2.0 minus 88.0
+.|glue 4.0 plus 2.0 minus 88.0
+.|glue 4.0 plus 2.0 minus 88.0
+.|glue 4.0 plus 2.0 minus 88.0
+.|glue 4.0 plus 2.0 minus 88.0
+.|penalty 10000
+.|glue(|parfillskip) 0.0 plus 100.0
+.|glue(|rightskip) 0.0
+|glue(|parskip) 0.0 plus 42.0 minus 8.0
+|glue(|baselineskip) 1.8
+|hbox(8.2+0.0)x100.0, glue set 0.9301
+.|glue(|leftskip) 3.0
+.|hbox(0.0+0.0)x0.0
+.|mathon
+.|hbox(0.0+0.0)x3.99, shifted -8.2
+..|leaders 0.0 minus -0.00003fil
+...|rule(*+*)x0.4
+..|smalltrip M
+..|kern1.0
+..|glue(|nonscript)
+.|mathoff
+.|penalty 10000
+.|glue(|parfillskip) 0.0 plus 100.0
+.|glue(|rightskip) 0.0
+|glue 0.0 plus 1.0fill
+|glue(|parskip) 0.0 plus 42.0 minus 8.0
+|glue(|baselineskip) 10.0
+|hbox(0.0+0.0)x100.0, glue set 0.97
+.|glue(|leftskip) 3.0
+.|hbox(0.0+0.0)x0.0
+.|mathon
+.|hbox(0.0+0.0)x0.0
+.|hbox(0.0+0.0)x0.0
+.|mathoff
+.|penalty 10000
+.|glue(|parfillskip) 0.0 plus 100.0
+.|glue(|rightskip) 0.0
+|mark{twain}
+|glue 0.0 plus 1.0fill
+|glue 0.0 plus 1.0fil
+|glue 0.0 plus -1.0fil
+|glue 0.0 plus 1.0fil minus 1.0
+|glue(|parskip) 0.0 plus 42.0 minus 8.0
+|glue(|baselineskip) 10.0
+|hbox(0.0+0.0)x100.0, glue set 0.97
+.|glue(|leftskip) 3.0
+.|hbox(0.0+0.0)x0.0
+.|mathon
+.|hbox(0.0+0.0)x0.0
+..|ip t
+..|ip t
+..|glue 0.0 plus -1.0fil
+.|mathoff
+.|penalty 10000
+.|glue(|parfillskip) 0.0 plus 100.0
+.|glue(|rightskip) 0.0
+|glue(|parskip) 0.0 plus 42.0 minus 8.0
+|glue(|baselineskip) 10.0
+|hbox(0.0+0.0)x1.42262, glue set - 0.20552
+.|glue(|tabskip) 0.0154 minus 3.21002
+.|hbox(0.0+0.0)x0.0
+.|glue(|tabskip) 0.0154 minus 3.21002
+.|hbox(0.0+0.0)x0.0
+.|glue(|tabskip) 0.0154 minus 3.21002
+.|hbox(0.0+0.0)x4.0
+.|glue(|tabskip) 0.0154 minus 3.21002
+|glue(|baselineskip) 10.0
+|hbox(0.0+0.0)x1.42262, glue set - 0.20552
+.|glue(|tabskip) 0.0154 minus 3.21002
+.|hbox(0.0+0.0)x0.0
+.|glue(|tabskip) 0.0154 minus 3.21002
+.|hbox(0.0+0.0)x0.0
+.|glue(|tabskip) 0.0154 minus 3.21002
+.|hbox(0.0+0.0)x4.0
+..|glue 4.0 plus 2.0 minus 88.0
+.|glue(|tabskip) 0.0154 minus 3.21002
+|glue(|lineskip) 0.0 plus 40.0
+|hbox(3545.60136+140.80052)x2070.00168
+.|glue 6.0 plus 4.0 minus 44.0
+.|mathon
+.|hbox(3545.60136+140.80052)x614.40031
+..|hbox(1638.40019+409.6015)x614.40031, shifted -268.80098
+...|enorm b
+..|vbox(3545.60136+0.0)x0.0
+...|kern1638.40019
+...|rule(1638.40019+0.0)x*
+...|kern268.80098
+...|hbox(0.0+0.0)x0.0
+.|glue(|thinmuskip) -0.00002 plus 2.0fill minus -0.00005
+.|hbox(109.40036+95.40038)x1446.60138
+..|vbox(-1.00002+26.9999)x7.0, shifted -20.99995
+...|hbox(-1.00002+2.0)x7.0
+....|ip ^^@
+...|hbox(-1.00002+2.0)x7.0
+....|ip ^^@
+...|hbox(-1.00002+2.0)x7.0
+....|ip ^^@
+...|hbox(-1.00002+2.0)x7.0
+....|ip ^^@
+...|hbox(7.0+1.0)x3.0
+....|ip A
+...|hbox(-1.00002+2.0)x7.0
+....|ip ^^@
+...|hbox(-1.00002+2.0)x7.0
+....|ip ^^@
+...|hbox(-1.00002+2.0)x7.0
+....|ip ^^@
+...|hbox(-1.00002+2.0)x7.0
+....|ip ^^@
+...|hbox(8.0+2.0)x3.0
+....|ip B
+..|ip A
+..|kern1.0
+..|ip a
+..|kern1.0
+..|hbox(-204.80077+409.6015)x1433.60138, shifted -314.20113
+...|enorm ^^@
+.|mathoff
+.|ip A (ligature AA)
+.|kern 1.0
+|glue(|parskip) 0.0 plus 42.0 minus 8.0
+|glue(|lineskip) 0.0 plus 40.0
+|hbox(0.0+0.0)x100.0, glue set 0.97
+.|glue(|leftskip) 3.0
+.|hbox(0.0+0.0)x0.0
+.|penalty 10000
+.|glue(|parfillskip) 0.0 plus 100.0
+.|glue(|rightskip) 0.0
+|penalty 97
+|glue(|baselineskip) 10.0
+|hbox(0.0+0.0)x0.03079
+.|glue(|tabskip) 0.0154 minus 3.21002
+.|hbox(0.0+0.0)x0.0
+.|glue(|tabskip) 0.0154 minus 3.21002
+|penalty 97
+|penalty 97
+|glue(|baselineskip) 10.0
+|hbox(0.0+0.0)x0.03079
+.|glue(|tabskip) 0.0154 minus 3.21002
+.|hbox(0.0+0.0)x0.0
+.|glue(|tabskip) 0.0154 minus 3.21002
+|penalty 97
+|glue(|baselineskip) 10.0
+|hbox(0.0+0.0)x0.03079
+.|glue(|tabskip) 0.0154 minus 3.21002
+.|hbox(0.0+0.0)x0.0
+.|glue(|tabskip) 0.0154 minus 3.21002
+|penalty 97
+|glue(|parskip) 0.0 plus 42.0 minus 8.0
+|glue(|baselineskip) 10.0
+|hbox(0.0+0.0)x100.0, glue set 0.966
+.|glue(|leftskip) 3.0
+.|hbox(0.0+0.0)x0.0
+.|rule(*+*)x0.4
+.|penalty 10000
+.|glue(|parfillskip) 0.0 plus 100.0
+.|glue(|rightskip) 0.0
+total height 3796.40189 plus 332.0 plus 2.0fil plus -803.0fill minus 49.
+0
+ goal height 16383.99998
+### recent contributions:
+|rule(0.4+0.0)x*
+prevdepth ignored, prevgraf 1 line
+
+! OK.
+|showlonglists ...99 |showlists
+ |pagegoal =10000pt}
+l.439 ...\endgroup\showlonglists
+ $}\showboxbreadth9\showboxdepth9
+
+{restoring |showboxdepth=1}
+{restoring |showboxbreadth=2}
+{restoring |tracingcommands=2}
+{math shift character $}
+{restoring |fam=0}
+{restricted horizontal mode: end-group character }}
+{restoring |x=|char"C8}
+{vertical mode: |showboxbreadth}
+{|showboxdepth}
+
+^^M->|relax
+{|relax}
+{|showbox}
+> \box9=
+|hbox(19.6+1.0)x100.98999
+.|vbox(17.0+1.0)x100.0
+..|hbox(7.0+1.0)x100.0, glue set 0.85294
+...|glue(|leftskip) 3.0
+...|hbox(0.0+0.0)x0.0
+...|discretionary
+...|glue 0.0 plus 2.0 minus 88.0
+...|ip A (ligature BB)
+...|kern2.0
+...|ip A (ligature BB)
+...|kern2.0
+...|ip A (ligature BB)
+...etc.
+..|glue(|parskip) 0.0 plus 42.0 minus 8.0
+..|glue(|baselineskip) 2.0
+..|hbox(7.0+1.0)x100.0, glue set 0.85294
+...|glue(|leftskip) 3.0
+...|hbox(0.0+0.0)x0.0
+...|discretionary
+...|glue 0.0 plus 2.0 minus 88.0
+...|ip A (ligature BB)
+...|kern2.0
+...|discretionary replacing 3
+....|ip B
+...||ip A (ligature BB)
+...||kern2.0
+...||ip B
+...|ip A (ligature BB)
+...|kern2.0
+...etc.
+.|mathon
+.|vbox(19.6+0.0)x0.99
+..|kern10.0
+..|hbox(3.5+4.1)x0.99
+...|smalltrip A
+...|hbox(0.0+0.0)x-0.01, shifted 4.1
+..|kern2.0
+..|hbox(0.0+0.0)x0.99, glue set 0.49501fil
+...|glue 0.0 plus 1.0fil minus 1.0fil
+...|vbox(0.0+0.0)x0.0
+....|glue 0.0 plus 1.0fil minus 1.0fil
+...|glue 0.0 plus 1.0fil minus 1.0fil
+.|glue(|thinmuskip) -0.00002 plus 2.0fill minus -0.00005
+.|hbox(0.0+0.0)x0.0
+.|mathoff
+
+! OK.
+<to be read again>
+ |PAR
+l.440 \showbox9\PAR
+ {\output{}\penalty-10001\deadcycles=2}\scr...
+
+{|par}
+{begin-group character {}
+{|output}
+{|penalty}
+% t=3796.80188 plus 332.0 plus 2.0fil plus -803.0fill minus 49.0 g=10000
+.0 b=0 p=-10001 c=-10001#
+[-2.2.-1118806.0.11.196608.327680.1572864.1073741823]
+Memory usage before: 895&439; after: 290&420; still untouched: 175
+{|deadcycles}
+{end-group character }}
+{restoring |output={|showthe |deadcycles |global |advance |ETC.}
+{|scrollmode}
+
+{|hbox}
+{restricted horizontal mode: |write}
+{|showlists}
+
+### restricted horizontal mode entered at line 441
+|write-{|if 01{|else unbal}|fi }
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth ignored, prevgraf 1 line
+
+! OK.
+l.441 ...se unbal}\fi}\showlists
+ \tracingonline1%
+
+{|tracingonline}
+{|escapechar}
+{^^?global}
+{^^?global}
+{end}
+! Missing } inserted.
+<inserted text>
+ }
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+I've inserted something that you may have forgotten.
+(See the <inserted text> above.)
+With luck, this will get me unwedged. But if you
+really didn't forget anything, try typing `2' now; then
+my insertion and my current dilemma will both disappear.
+
+{end-group character }}
+{retaining escapechar=256}
+{restoring tracingonline=0}
+%% goal height=16383.99998, max depth=2.0
+{vertical mode: end}
+% t=20.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+% t=20.0 plus 1.0fil plus 1.0fill g=16383.99998 b=0 p=-1073741824 c=-107
+3741824#
+output->{showthe deadcycles global advance countz by1global globaldefs -
+1 gdef local {}unvbox 255end rb }
+{internal vertical mode: showthe}
+> 3.
+<output> {showthe deadcycles
+ global advance countz by1global ...
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+
+{global}
+{global}
+{gdef}
+{unvbox}
+{end}
+! You can't use `end' in internal vertical mode.
+<recently read> end
+
+<output> ...cal {}unvbox 255end
+ rb }
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+{end-group character }}
+! Unbalanced output routine.
+<output> ... {}unvbox 255end rb
+ }
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+Your sneaky output routine has problematic {'s and/or }'s.
+I can't handle that very well; good luck.
+
+{restoring local=undefined}
+%% goal height=16383.99998, max depth=2.0
+% t=20.0 plus 1.0fil g=16383.99998 b=0 p=0 c=0#
+{vertical mode: end}
+% t=20.0 plus 1.0fil plus 1.0fill g=16383.99998 b=0 p=0 c=0#
+% t=20.0 plus 1.0fil plus 2.0fill g=16383.99998 b=0 p=-1073741824 c=-107
+3741824#
+! Output loop---3 consecutive dead cycles.
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+I've concluded that your \output is awry; it never does a
+\shipout, so I'm shipping \box255 out myself. Next time
+increase \maxdeadcycles if you want me to be more patient!
+
+
+Completed box being shipped out [-1.2.-1118806.0.11.196608.327680.157286
+4.1073741823]
+vbox(16383.99998+0.0)x100.0, glue set 8182.0fill
+.glue(topskip) 20.0 plus 1.0fil
+.hbox(0.0+0.0)x0.0
+..write-{if 01{else unbal}fi }
+.hbox(0.0+0.0)x100.0
+.glue 0.0 plus 1.0fill
+.penalty 10000
+.hbox(0.0+0.0)x100.0
+.glue 0.0 plus 1.0fill
+
+write->if 01{else unbal}fi
+{no mode: if}
+{false}
+
+! Unbalanced write command.
+<write> if 01{else unbal}fi
+
+<inserted text>
+ }endwrite
+<to be read again>
+ end
+l.442 ...lobal\escapechar256\end
+
+On this page there's a \write with fewer real {'s than }'s.
+I can't handle that very well; good luck.
+
+unbal
+Memory usage before: 334&431; after: 292&418; still untouched: 175
+{vertical mode: end}
+ )
+(end occurred inside a group at level 1)
+(end occurred when if on line 442 was incomplete)
+(end occurred when ifcase on line 419 was incomplete)
+(end occurred when iftrue on line 413 was incomplete)
+Here is how much of TeX's memory you used:
+ 47 strings out of 1674
+ 251 string characters out of 8353
+ 2825 words of memory out of 3000
+ 372 multiletter control sequences out of 2100
+ 3041 words of font info for 4 fonts, out of 20000 for 75
+ 2 hyphenation exceptions out of 307
+ 5i,7n,9p,113b,38s stack positions out of 200i,40n,60p,500b,600s
+
+Output written on trip.dvi (16 pages, 2920 bytes).
diff --git a/Build/source/texk/web2c/triptrap/trip.pl b/Build/source/texk/web2c/triptrap/trip.pl
new file mode 100644
index 00000000000..6a38a92316b
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trip.pl
@@ -0,0 +1,833 @@
+(FAMILY UNSPECIFIED)
+(FACE F MRR)
+(CODINGSCHEME TEX TEST: NOT A REAL FONT)
+(DESIGNSIZE R 10.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM O 32107654321)
+(FONTDIMEN
+ (SLANT R -2.0)
+ (SPACE R 0.400001)
+ (STRETCH R 0.200001)
+ (SHRINK R 0.1)
+ (XHEIGHT R 0.45)
+ (QUAD R 1.0)
+ (EXTRASPACE R 0.200001)
+ (PARAMETER D 8 R 0.05)
+ (PARAMETER D 9 R 0.1)
+ (PARAMETER D 10 R 0.200001)
+ (PARAMETER D 11 R 0.3)
+ (PARAMETER D 12 R 0.400001)
+ (PARAMETER D 13 R 0.5)
+ )
+(BOUNDARYCHAR C Z)
+(LIGTABLE
+ (LABEL C t)
+ (KRN O 0 R -1.0)
+ (KRN O 0 R -0.01)
+ (KRN O 0 R -0.02)
+ (KRN O 0 R -0.03)
+ (KRN O 0 R -0.04)
+ (KRN O 0 R -0.05)
+ (KRN O 0 R -0.06)
+ (KRN O 0 R -0.07)
+ (KRN O 0 R -0.08)
+ (KRN O 0 R -0.09)
+ (KRN O 0 R -0.1)
+ (KRN O 0 R -0.11)
+ (KRN O 0 R -0.12)
+ (KRN O 0 R -0.13)
+ (KRN O 0 R -0.14)
+ (KRN O 0 R -0.15)
+ (KRN O 0 R -0.16)
+ (KRN O 0 R -0.17)
+ (KRN O 0 R -0.18)
+ (KRN O 0 R -0.19)
+ (KRN O 0 R -0.2)
+ (KRN O 0 R -0.21)
+ (KRN O 0 R -0.22)
+ (KRN O 0 R -0.23)
+ (KRN O 0 R -0.24)
+ (KRN O 0 R -0.25)
+ (KRN O 0 R -0.26)
+ (KRN O 0 R -0.27)
+ (KRN O 0 R -0.28)
+ (KRN O 0 R -0.29)
+ (KRN O 0 R -0.3)
+ (KRN O 0 R -0.31)
+ (KRN O 0 R -0.32)
+ (KRN O 0 R -0.33)
+ (KRN O 0 R -0.34)
+ (KRN O 0 R -0.35)
+ (KRN O 0 R -0.36)
+ (KRN O 0 R -0.37)
+ (KRN O 0 R -0.38)
+ (KRN O 0 R -0.39)
+ (KRN O 0 R -0.4)
+ (KRN O 0 R -0.41)
+ (KRN O 0 R -0.42)
+ (KRN O 0 R -0.43)
+ (KRN O 0 R -0.44)
+ (KRN O 0 R -0.45)
+ (KRN O 0 R -0.46)
+ (KRN O 0 R -0.47)
+ (KRN O 0 R -0.48)
+ (KRN O 0 R -0.49)
+ (KRN O 0 R -0.5)
+ (KRN O 0 R -0.51)
+ (KRN O 0 R -0.52)
+ (KRN O 0 R -0.53)
+ (KRN O 0 R -0.54)
+ (KRN O 0 R -0.55)
+ (KRN O 0 R -0.56)
+ (KRN O 0 R -0.57)
+ (KRN O 0 R -0.58)
+ (KRN O 0 R -0.59)
+ (KRN O 0 R -0.6)
+ (KRN O 0 R -0.61)
+ (KRN O 0 R -0.62)
+ (KRN O 0 R -0.63)
+ (KRN O 0 R -0.64)
+ (KRN O 0 R -0.65)
+ (KRN O 0 R -0.66)
+ (KRN O 0 R -0.67)
+ (KRN O 0 R -0.68)
+ (KRN O 0 R -0.69)
+ (KRN O 0 R -0.7)
+ (KRN O 0 R -0.71)
+ (KRN O 0 R -0.72)
+ (KRN O 0 R -0.73)
+ (KRN O 0 R -0.74)
+ (KRN O 0 R -0.75)
+ (KRN O 0 R -0.76)
+ (KRN O 0 R -0.77)
+ (KRN O 0 R -0.78)
+ (KRN O 0 R -0.79)
+ (KRN O 0 R -0.8)
+ (KRN O 0 R -0.81)
+ (KRN O 0 R -0.82)
+ (KRN O 0 R -0.83)
+ (KRN O 0 R -0.84)
+ (KRN O 0 R -0.85)
+ (KRN O 0 R -0.86)
+ (KRN O 0 R -0.87)
+ (KRN O 0 R -0.88)
+ (KRN O 0 R -0.89)
+ (KRN O 0 R -0.9)
+ (KRN O 0 R -0.91)
+ (KRN O 0 R -0.92)
+ (KRN O 0 R -0.93)
+ (KRN O 0 R -0.94)
+ (KRN O 0 R -0.95)
+ (KRN O 0 R -0.96)
+ (KRN O 0 R -0.97)
+ (KRN O 0 R -0.98)
+ (KRN O 0 R -0.99)
+ (KRN O 0 R -1.0)
+ (KRN O 0 R -1.01)
+ (KRN O 0 R -1.02)
+ (KRN O 0 R -1.03)
+ (KRN O 0 R -1.04)
+ (KRN O 0 R -1.05)
+ (KRN O 0 R -1.06)
+ (KRN O 0 R -1.07)
+ (KRN O 0 R -1.08)
+ (KRN O 0 R -1.09)
+ (KRN O 0 R -1.1)
+ (KRN O 0 R -1.11)
+ (KRN O 0 R -1.12)
+ (KRN O 0 R -1.13)
+ (KRN O 0 R -1.14)
+ (KRN O 0 R -1.15)
+ (KRN O 0 R -1.16)
+ (KRN O 0 R -1.17)
+ (KRN O 0 R -1.18)
+ (KRN O 0 R -1.19)
+ (KRN O 0 R -1.2)
+ (KRN O 0 R -1.21)
+ (KRN O 0 R -1.22)
+ (KRN O 0 R -1.23)
+ (KRN O 0 R -1.24)
+ (KRN O 0 R -1.25)
+ (KRN O 0 R -1.26)
+ (KRN O 0 R -1.27)
+ (KRN O 0 R -1.28)
+ (KRN O 0 R -1.29)
+ (KRN O 0 R -1.3)
+ (KRN O 0 R -1.31)
+ (KRN O 0 R -1.32)
+ (KRN O 0 R -1.33)
+ (KRN O 0 R -1.34)
+ (KRN O 0 R -1.35)
+ (KRN O 0 R -1.36)
+ (KRN O 0 R -1.37)
+ (KRN O 0 R -1.38)
+ (KRN O 0 R -1.39)
+ (KRN O 0 R -1.4)
+ (KRN O 0 R -1.41)
+ (KRN O 0 R -1.42)
+ (KRN O 0 R -1.43)
+ (KRN O 0 R -1.44)
+ (KRN O 0 R -1.45)
+ (KRN O 0 R -1.46)
+ (KRN O 0 R -1.47)
+ (KRN O 0 R -1.48)
+ (KRN O 0 R -1.49)
+ (KRN O 0 R -1.5)
+ (KRN O 0 R -1.51)
+ (KRN O 0 R -1.52)
+ (KRN O 0 R -1.53)
+ (KRN O 0 R -1.54)
+ (KRN O 0 R -1.55)
+ (KRN O 0 R -1.56)
+ (KRN O 0 R -1.57)
+ (KRN O 0 R -1.58)
+ (KRN O 0 R -1.59)
+ (KRN O 0 R -1.6)
+ (KRN O 0 R -1.61)
+ (KRN O 0 R -1.62)
+ (KRN O 0 R -1.63)
+ (KRN O 0 R -1.64)
+ (KRN O 0 R -1.65)
+ (KRN O 0 R -1.66)
+ (KRN O 0 R -1.67)
+ (KRN O 0 R -1.68)
+ (KRN O 0 R -1.69)
+ (KRN O 0 R -1.7)
+ (KRN O 0 R -1.71)
+ (KRN O 0 R -1.72)
+ (KRN O 0 R -1.73)
+ (KRN O 0 R -1.74)
+ (KRN O 0 R -1.75)
+ (KRN O 0 R -1.76)
+ (KRN O 0 R -1.77)
+ (KRN O 0 R -1.78)
+ (KRN O 0 R -1.79)
+ (KRN O 0 R -1.8)
+ (KRN O 0 R -1.81)
+ (KRN O 0 R -1.82)
+ (KRN O 0 R -1.83)
+ (KRN O 0 R -1.84)
+ (KRN O 0 R -1.85)
+ (KRN O 0 R -1.86)
+ (KRN O 0 R -1.87)
+ (KRN O 0 R -1.88)
+ (KRN O 0 R -1.89)
+ (KRN O 0 R -1.9)
+ (KRN O 0 R -1.91)
+ (KRN O 0 R -1.92)
+ (KRN O 0 R -1.93)
+ (KRN O 0 R -1.94)
+ (KRN O 0 R -1.95)
+ (KRN O 0 R -1.96)
+ (KRN O 0 R -1.97)
+ (KRN O 0 R -1.98)
+ (KRN O 0 R -1.99)
+ (KRN O 0 R -2.0)
+ (KRN O 0 R -2.01)
+ (KRN O 0 R -2.02)
+ (KRN O 0 R -2.03)
+ (KRN O 0 R -2.04)
+ (KRN O 0 R -2.05)
+ (KRN O 0 R -2.06)
+ (KRN O 0 R -2.07)
+ (KRN O 0 R -2.08)
+ (KRN O 0 R -2.09)
+ (KRN O 0 R -2.1)
+ (KRN O 0 R -2.11)
+ (KRN O 0 R -2.12)
+ (KRN O 0 R -2.13)
+ (KRN O 0 R -2.14)
+ (KRN O 0 R -2.15)
+ (KRN O 0 R -2.16)
+ (KRN O 0 R -2.17)
+ (KRN O 0 R -2.18)
+ (KRN O 0 R -2.19)
+ (KRN O 0 R -2.2)
+ (KRN O 0 R -2.21)
+ (KRN O 0 R -2.22)
+ (KRN O 0 R -2.23)
+ (KRN O 0 R -2.24)
+ (KRN O 0 R -2.25)
+ (KRN O 0 R -2.26)
+ (KRN O 0 R -2.27)
+ (KRN O 0 R -2.28)
+ (KRN O 0 R -2.29)
+ (KRN O 0 R -2.3)
+ (SKIP D 3)
+ (LABEL O 55)
+ (LIG O 0 O 55)
+ (/LIG> C q C p)
+ (LABEL O 57)
+ (KRN C A R 0.1)
+ (STOP)
+ (KRN O 0 R -2.31)
+ (KRN O 0 R -2.32)
+ (KRN O 0 R -2.33)
+ (KRN O 0 R -2.34)
+ (KRN O 0 R -2.35)
+ (KRN O 0 R -2.36)
+ (KRN O 0 R -2.37)
+ (KRN O 0 R -2.38)
+ (KRN O 0 R -2.39)
+ (KRN O 0 R -2.4)
+ (KRN O 0 R -2.41)
+ (KRN O 0 R -2.42)
+ (KRN O 0 R -2.43)
+ (KRN O 0 R -2.44)
+ (KRN O 0 R -2.45)
+ (KRN O 0 R -2.46)
+ (KRN O 0 R -2.47)
+ (KRN O 0 R -2.48)
+ (KRN O 0 R -2.49)
+ (KRN O 0 R -2.5)
+ (KRN O 0 R -2.51)
+ (KRN O 0 R -2.52)
+ (KRN O 0 R -2.53)
+ (KRN O 0 R -2.54)
+ (KRN O 0 R -2.55)
+ (KRN O 0 R -2.56)
+ (KRN O 0 R -2.57)
+ (/LIG/>> C r C s)
+ (SKIP D 9)
+ (LABEL C p)
+ (/LIG/ C q C r)
+ (/LIG/> C r C t)
+ (LIG C t C t)
+ (STOP)
+ (LABEL C q)
+ (/LIG/ C u C p)
+ (/LIG/ C s C r)
+ (KRN C t R 0.1)
+ (/LIG> C r C t)
+ (SKIP D 2)
+ (LABEL C r)
+ (LIG/ C u C q)
+ (/LIG C q C u)
+ (STOP)
+ (/LIG/ C p C s)
+ (KRN C s R 0.3)
+ (STOP)
+ (LABEL C s)
+ (LIG/> C p C q)
+ (KRN C r R 0.1)
+ (STOP)
+ (LABEL C u)
+ (/LIG C Z C p)
+ (LIG C p C r)
+ (STOP)
+ (LABEL BOUNDARYCHAR)
+ (LIG/ C q C q)
+ (/LIG C 1 C 5)
+ (KRN O 55 R -0.1)
+ (STOP)
+ (LABEL C 1)
+ (/LIG/ C 1 C 2)
+ (/LIG/ C 2 C 3)
+ (/LIG> O 55 C 1)
+ (SKIP D 1)
+ (LABEL C 2)
+ (/LIG/ C 1 C 3)
+ (/LIG/ C 3 C 4)
+ (SKIP D 2)
+ (LABEL C 3)
+ (/LIG/ C 1 C 4)
+ (/LIG/ C 2 C 4)
+ (/LIG/ C 4 C 5)
+ (SKIP D 3)
+ (LABEL C 4)
+ (/LIG/ C 1 C 5)
+ (/LIG/ C 2 C 5)
+ (/LIG/ C 3 C 5)
+ (/LIG/ C 5 C 6)
+ (SKIP D 4)
+ (LABEL C 5)
+ (/LIG/ C 1 C 6)
+ (/LIG/ C 2 C 6)
+ (/LIG/ C 3 C 6)
+ (/LIG/ C 4 C 6)
+ (/LIG/ C 6 C 7)
+ (SKIP D 5)
+ (LABEL C 6)
+ (/LIG/ C 1 C 7)
+ (/LIG/ C 2 C 7)
+ (/LIG/ C 3 C 7)
+ (/LIG/ C 4 C 7)
+ (/LIG/ C 5 C 7)
+ (/LIG/>> C Z C 7)
+ (STOP)
+ (LABEL C 7)
+ (KRN C Z R 0.1)
+ (LABEL C A)
+ (LIG C A C A)
+ (KRN C B R 0.200001)
+ (KRN O 55 R 0.3)
+ (KRN C 1 R -0.200001)
+ (STOP)
+ (LABEL C B)
+ (LIG C B C A)
+ (LIG O 55 C C)
+ (KRN C C R 0.400001)
+ (STOP)
+ (LABEL C C)
+ (LIG C A O 202)
+ (LIG O 57 C B)
+ (STOP)
+ )
+(CHARACTER O 0
+ (CHARWD R 0.700001)
+ (CHARHT R -0.1)
+ (CHARDP R 0.200001)
+ )
+(CHARACTER O 55
+ (CHARWD R -0.5)
+ (COMMENT
+ (LIG O 0 O 55)
+ (/LIG> C q C p)
+ (KRN C A R 0.1)
+ )
+ )
+(CHARACTER O 57
+ (CHARWD R 0.1)
+ (COMMENT
+ (KRN C A R 0.1)
+ )
+ )
+(CHARACTER C 1
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 2)
+ (/LIG/ C 2 C 3)
+ (/LIG> O 55 C 1)
+ (/LIG/ C 3 C 4)
+ (/LIG/ C 4 C 5)
+ (/LIG/ C 5 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 2
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 3)
+ (/LIG/ C 3 C 4)
+ (/LIG/ C 4 C 5)
+ (/LIG/ C 5 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 3
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 4)
+ (/LIG/ C 2 C 4)
+ (/LIG/ C 4 C 5)
+ (/LIG/ C 5 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 4
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 5)
+ (/LIG/ C 2 C 5)
+ (/LIG/ C 3 C 5)
+ (/LIG/ C 5 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 5
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 6)
+ (/LIG/ C 2 C 6)
+ (/LIG/ C 3 C 6)
+ (/LIG/ C 4 C 6)
+ (/LIG/ C 6 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 6
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C 1 C 7)
+ (/LIG/ C 2 C 7)
+ (/LIG/ C 3 C 7)
+ (/LIG/ C 4 C 7)
+ (/LIG/ C 5 C 7)
+ (/LIG/>> C Z C 7)
+ )
+ )
+(CHARACTER C 7
+ (CHARWD R 0.0)
+ (COMMENT
+ (KRN C Z R 0.1)
+ (LIG C A C A)
+ (KRN C B R 0.200001)
+ (KRN O 55 R 0.3)
+ (KRN C 1 R -0.200001)
+ )
+ )
+(CHARACTER C A
+ (CHARWD R 0.200001)
+ (CHARHT R 0.700001)
+ (CHARDP R 0.1)
+ (CHARIC R 0.1)
+ (COMMENT
+ (LIG C A C A)
+ (KRN C B R 0.200001)
+ (KRN O 55 R 0.3)
+ (KRN C 1 R -0.200001)
+ )
+ )
+(CHARACTER C B
+ (CHARWD R 0.3)
+ (CHARHT R 0.8)
+ (CHARDP R 0.200001)
+ (COMMENT
+ (LIG C B C A)
+ (LIG O 55 C C)
+ (KRN C C R 0.400001)
+ )
+ )
+(CHARACTER C C
+ (CHARWD R 0.400001)
+ (COMMENT
+ (LIG C A O 202)
+ (LIG O 57 C B)
+ )
+ )
+(CHARACTER C M
+ (CHARWD R 0.6)
+ (CHARIC R 0.200001)
+ (VARCHAR
+ (MID C A)
+ (BOT C B)
+ (REP O 0)
+ )
+ )
+(CHARACTER C a
+ (CHARWD R 0.200001)
+ (CHARHT R 0.700001)
+ (CHARDP R 0.1)
+ (CHARIC R 0.1)
+ (NEXTLARGER O 202)
+ )
+(CHARACTER C b
+ (CHARWD R 0.3)
+ (CHARHT R 0.8)
+ (CHARDP R 0.200001)
+ (NEXTLARGER C M)
+ )
+(CHARACTER C p
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C q C r)
+ (/LIG/> C r C t)
+ (LIG C t C t)
+ )
+ )
+(CHARACTER C q
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG/ C u C p)
+ (/LIG/ C s C r)
+ (KRN C t R 0.1)
+ (/LIG> C r C t)
+ (/LIG/ C p C s)
+ (KRN C s R 0.3)
+ )
+ )
+(CHARACTER C r
+ (CHARWD R 0.0)
+ (COMMENT
+ (LIG/ C u C q)
+ (/LIG C q C u)
+ )
+ )
+(CHARACTER C s
+ (CHARWD R 0.0)
+ (COMMENT
+ (LIG/> C p C q)
+ (KRN C r R 0.1)
+ )
+ )
+(CHARACTER C t
+ (CHARWD R 0.0)
+ (COMMENT
+ (KRN O 0 R -1.0)
+ (KRN O 0 R -0.01)
+ (KRN O 0 R -0.02)
+ (KRN O 0 R -0.03)
+ (KRN O 0 R -0.04)
+ (KRN O 0 R -0.05)
+ (KRN O 0 R -0.06)
+ (KRN O 0 R -0.07)
+ (KRN O 0 R -0.08)
+ (KRN O 0 R -0.09)
+ (KRN O 0 R -0.1)
+ (KRN O 0 R -0.11)
+ (KRN O 0 R -0.12)
+ (KRN O 0 R -0.13)
+ (KRN O 0 R -0.14)
+ (KRN O 0 R -0.15)
+ (KRN O 0 R -0.16)
+ (KRN O 0 R -0.17)
+ (KRN O 0 R -0.18)
+ (KRN O 0 R -0.19)
+ (KRN O 0 R -0.2)
+ (KRN O 0 R -0.21)
+ (KRN O 0 R -0.22)
+ (KRN O 0 R -0.23)
+ (KRN O 0 R -0.24)
+ (KRN O 0 R -0.25)
+ (KRN O 0 R -0.26)
+ (KRN O 0 R -0.27)
+ (KRN O 0 R -0.28)
+ (KRN O 0 R -0.29)
+ (KRN O 0 R -0.3)
+ (KRN O 0 R -0.31)
+ (KRN O 0 R -0.32)
+ (KRN O 0 R -0.33)
+ (KRN O 0 R -0.34)
+ (KRN O 0 R -0.35)
+ (KRN O 0 R -0.36)
+ (KRN O 0 R -0.37)
+ (KRN O 0 R -0.38)
+ (KRN O 0 R -0.39)
+ (KRN O 0 R -0.4)
+ (KRN O 0 R -0.41)
+ (KRN O 0 R -0.42)
+ (KRN O 0 R -0.43)
+ (KRN O 0 R -0.44)
+ (KRN O 0 R -0.45)
+ (KRN O 0 R -0.46)
+ (KRN O 0 R -0.47)
+ (KRN O 0 R -0.48)
+ (KRN O 0 R -0.49)
+ (KRN O 0 R -0.5)
+ (KRN O 0 R -0.51)
+ (KRN O 0 R -0.52)
+ (KRN O 0 R -0.53)
+ (KRN O 0 R -0.54)
+ (KRN O 0 R -0.55)
+ (KRN O 0 R -0.56)
+ (KRN O 0 R -0.57)
+ (KRN O 0 R -0.58)
+ (KRN O 0 R -0.59)
+ (KRN O 0 R -0.6)
+ (KRN O 0 R -0.61)
+ (KRN O 0 R -0.62)
+ (KRN O 0 R -0.63)
+ (KRN O 0 R -0.64)
+ (KRN O 0 R -0.65)
+ (KRN O 0 R -0.66)
+ (KRN O 0 R -0.67)
+ (KRN O 0 R -0.68)
+ (KRN O 0 R -0.69)
+ (KRN O 0 R -0.7)
+ (KRN O 0 R -0.71)
+ (KRN O 0 R -0.72)
+ (KRN O 0 R -0.73)
+ (KRN O 0 R -0.74)
+ (KRN O 0 R -0.75)
+ (KRN O 0 R -0.76)
+ (KRN O 0 R -0.77)
+ (KRN O 0 R -0.78)
+ (KRN O 0 R -0.79)
+ (KRN O 0 R -0.8)
+ (KRN O 0 R -0.81)
+ (KRN O 0 R -0.82)
+ (KRN O 0 R -0.83)
+ (KRN O 0 R -0.84)
+ (KRN O 0 R -0.85)
+ (KRN O 0 R -0.86)
+ (KRN O 0 R -0.87)
+ (KRN O 0 R -0.88)
+ (KRN O 0 R -0.89)
+ (KRN O 0 R -0.9)
+ (KRN O 0 R -0.91)
+ (KRN O 0 R -0.92)
+ (KRN O 0 R -0.93)
+ (KRN O 0 R -0.94)
+ (KRN O 0 R -0.95)
+ (KRN O 0 R -0.96)
+ (KRN O 0 R -0.97)
+ (KRN O 0 R -0.98)
+ (KRN O 0 R -0.99)
+ (KRN O 0 R -1.0)
+ (KRN O 0 R -1.01)
+ (KRN O 0 R -1.02)
+ (KRN O 0 R -1.03)
+ (KRN O 0 R -1.04)
+ (KRN O 0 R -1.05)
+ (KRN O 0 R -1.06)
+ (KRN O 0 R -1.07)
+ (KRN O 0 R -1.08)
+ (KRN O 0 R -1.09)
+ (KRN O 0 R -1.1)
+ (KRN O 0 R -1.11)
+ (KRN O 0 R -1.12)
+ (KRN O 0 R -1.13)
+ (KRN O 0 R -1.14)
+ (KRN O 0 R -1.15)
+ (KRN O 0 R -1.16)
+ (KRN O 0 R -1.17)
+ (KRN O 0 R -1.18)
+ (KRN O 0 R -1.19)
+ (KRN O 0 R -1.2)
+ (KRN O 0 R -1.21)
+ (KRN O 0 R -1.22)
+ (KRN O 0 R -1.23)
+ (KRN O 0 R -1.24)
+ (KRN O 0 R -1.25)
+ (KRN O 0 R -1.26)
+ (KRN O 0 R -1.27)
+ (KRN O 0 R -1.28)
+ (KRN O 0 R -1.29)
+ (KRN O 0 R -1.3)
+ (KRN O 0 R -1.31)
+ (KRN O 0 R -1.32)
+ (KRN O 0 R -1.33)
+ (KRN O 0 R -1.34)
+ (KRN O 0 R -1.35)
+ (KRN O 0 R -1.36)
+ (KRN O 0 R -1.37)
+ (KRN O 0 R -1.38)
+ (KRN O 0 R -1.39)
+ (KRN O 0 R -1.4)
+ (KRN O 0 R -1.41)
+ (KRN O 0 R -1.42)
+ (KRN O 0 R -1.43)
+ (KRN O 0 R -1.44)
+ (KRN O 0 R -1.45)
+ (KRN O 0 R -1.46)
+ (KRN O 0 R -1.47)
+ (KRN O 0 R -1.48)
+ (KRN O 0 R -1.49)
+ (KRN O 0 R -1.5)
+ (KRN O 0 R -1.51)
+ (KRN O 0 R -1.52)
+ (KRN O 0 R -1.53)
+ (KRN O 0 R -1.54)
+ (KRN O 0 R -1.55)
+ (KRN O 0 R -1.56)
+ (KRN O 0 R -1.57)
+ (KRN O 0 R -1.58)
+ (KRN O 0 R -1.59)
+ (KRN O 0 R -1.6)
+ (KRN O 0 R -1.61)
+ (KRN O 0 R -1.62)
+ (KRN O 0 R -1.63)
+ (KRN O 0 R -1.64)
+ (KRN O 0 R -1.65)
+ (KRN O 0 R -1.66)
+ (KRN O 0 R -1.67)
+ (KRN O 0 R -1.68)
+ (KRN O 0 R -1.69)
+ (KRN O 0 R -1.7)
+ (KRN O 0 R -1.71)
+ (KRN O 0 R -1.72)
+ (KRN O 0 R -1.73)
+ (KRN O 0 R -1.74)
+ (KRN O 0 R -1.75)
+ (KRN O 0 R -1.76)
+ (KRN O 0 R -1.77)
+ (KRN O 0 R -1.78)
+ (KRN O 0 R -1.79)
+ (KRN O 0 R -1.8)
+ (KRN O 0 R -1.81)
+ (KRN O 0 R -1.82)
+ (KRN O 0 R -1.83)
+ (KRN O 0 R -1.84)
+ (KRN O 0 R -1.85)
+ (KRN O 0 R -1.86)
+ (KRN O 0 R -1.87)
+ (KRN O 0 R -1.88)
+ (KRN O 0 R -1.89)
+ (KRN O 0 R -1.9)
+ (KRN O 0 R -1.91)
+ (KRN O 0 R -1.92)
+ (KRN O 0 R -1.93)
+ (KRN O 0 R -1.94)
+ (KRN O 0 R -1.95)
+ (KRN O 0 R -1.96)
+ (KRN O 0 R -1.97)
+ (KRN O 0 R -1.98)
+ (KRN O 0 R -1.99)
+ (KRN O 0 R -2.0)
+ (KRN O 0 R -2.01)
+ (KRN O 0 R -2.02)
+ (KRN O 0 R -2.03)
+ (KRN O 0 R -2.04)
+ (KRN O 0 R -2.05)
+ (KRN O 0 R -2.06)
+ (KRN O 0 R -2.07)
+ (KRN O 0 R -2.08)
+ (KRN O 0 R -2.09)
+ (KRN O 0 R -2.1)
+ (KRN O 0 R -2.11)
+ (KRN O 0 R -2.12)
+ (KRN O 0 R -2.13)
+ (KRN O 0 R -2.14)
+ (KRN O 0 R -2.15)
+ (KRN O 0 R -2.16)
+ (KRN O 0 R -2.17)
+ (KRN O 0 R -2.18)
+ (KRN O 0 R -2.19)
+ (KRN O 0 R -2.2)
+ (KRN O 0 R -2.21)
+ (KRN O 0 R -2.22)
+ (KRN O 0 R -2.23)
+ (KRN O 0 R -2.24)
+ (KRN O 0 R -2.25)
+ (KRN O 0 R -2.26)
+ (KRN O 0 R -2.27)
+ (KRN O 0 R -2.28)
+ (KRN O 0 R -2.29)
+ (KRN O 0 R -2.3)
+ (KRN O 0 R -2.31)
+ (KRN O 0 R -2.32)
+ (KRN O 0 R -2.33)
+ (KRN O 0 R -2.34)
+ (KRN O 0 R -2.35)
+ (KRN O 0 R -2.36)
+ (KRN O 0 R -2.37)
+ (KRN O 0 R -2.38)
+ (KRN O 0 R -2.39)
+ (KRN O 0 R -2.4)
+ (KRN O 0 R -2.41)
+ (KRN O 0 R -2.42)
+ (KRN O 0 R -2.43)
+ (KRN O 0 R -2.44)
+ (KRN O 0 R -2.45)
+ (KRN O 0 R -2.46)
+ (KRN O 0 R -2.47)
+ (KRN O 0 R -2.48)
+ (KRN O 0 R -2.49)
+ (KRN O 0 R -2.5)
+ (KRN O 0 R -2.51)
+ (KRN O 0 R -2.52)
+ (KRN O 0 R -2.53)
+ (KRN O 0 R -2.54)
+ (KRN O 0 R -2.55)
+ (KRN O 0 R -2.56)
+ (KRN O 0 R -2.57)
+ (/LIG/>> C r C s)
+ (/LIG/ C p C s)
+ (KRN C s R 0.3)
+ )
+ )
+(CHARACTER C u
+ (CHARWD R 0.0)
+ (COMMENT
+ (/LIG C Z C p)
+ (LIG C p C r)
+ )
+ )
+(CHARACTER O 202
+ (CHARWD R 0.400001)
+ )
diff --git a/Build/source/texk/web2c/triptrap/trip.tex b/Build/source/texk/web2c/triptrap/trip.tex
new file mode 100644
index 00000000000..a9205e52d5e
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trip.tex
@@ -0,0 +1,448 @@
+% This is a diabolical test file for TeX82. Watch your step.
+\immediate\catcode `{ = 1 \endlinechar=13
+\catcode `} = 2
+\catcode `$ = 3 {\catcode`$13\gdef\dol{$}}
+\catcode `& = 4
+\let\paR=\par
+\let\%=\relax
+\outer\xdef\par{\catcode `\% 14}
+ % this line should change % from type 5 to type 14
+\let\par=\paR \defaulthyphenchar=`- \defaultskewchar=256
+\ifx\initex\undefined \def\initex{} % next lines are skipped if format loaded
+ \catcode `# = 6 \catcode `U=\catcode`# % # for parameters
+ \catcode `^ = 7 \catcode `| = 8 % ^ for superscripts and | for subscripts
+ \catcode `~ = 9 % ~ will be ignored
+ \catcode `* = 10 % * will be like a space
+ \catcode `E = 12 % E is not a letter
+ \catcode`\@ = 15 % @ will be invalid
+ \catcode `^^A = 0008 % this is another way to get a subscript
+ \catcode `\^^@ = 11 % a strange letter will be allowed
+ \catcode `\^^? = \badness % and so will a strange escape delimiter
+ \fontdimen12\nullfont=13pt % give the null font more parameters
+ \font\trip = trip\relax % see TRIP.PL for details of this font
+ ^^?trip \font\smalltrip=trip scaled 500 % this will be our symbols font
+ \global\fontdimen22\smalltrip 7pt % the axis height
+ \textfont2=\smalltrip \scriptfont2 \smalltrip \scriptscriptfont2 \smalltrip
+ \nonstopmode\lccode256-0\mathchardef\a="8000\def\a{ SCALED 3~2769}
+ \font\rip=trip\a % font \rip will be the same as \trip
+ \skewchar\rip=`B \countdef\countz % \countz will be \count0
+ \def\on{1} \toksdef\tokens=256 \show\errorstopmode
+ \showthe\font \showthe\pageshrink \showthe\pagegoal
+ \font\bigtr^^@p=trip at20pt\textfont3=\bigtr^^@p % this will be extension font
+ \skip200 = 10pt plUs5fil\ifdim\hsize<\hsize\fi lllminus 0 fill
+ \setbox200=\vbox{\hrule\vskip\skip200} \wd200-2pt \setbox100=\hbox{A}
+ \skipdef\shkip100\shkip -18pt plus\catcode`\}fil minus 10fil
+ \advance\shkip by \skip200 \dimen33=3pt \count33=-\dimen33
+ \divide\shkip by \count33
+ \multiply\shkip by \count33 % so \skip100=-6pt plus 3filll minus 9fil
+ \count200 -5 \multiply\count200 by -100 % \count200 is 500
+ \count100=1000000 \divide\count100 by \count200 % \count100 is 2000
+ \dimen100=,00152587890625in % (100/65536)in = 7227sp
+ \multiply\dimen100 by 65536 \divide\dimen100 by 9 % \dimen100 is 803pt
+ \lineskip 0pt plus 40pt
+ \baselineskip=10pt plus 41pt
+ \parskip -0pt plus 42pt minus 8pt
+ \splittopskip 1pt plus 43pt
+ \splitmaxdepth -2pt \boxmaxdepth 1000pt
+ \belowdisplayskip 3pt plus 44pt minus\baselineskip \abovedisplayskip3pt
+ \abovedisplayshortskip 1pt plus 45pt minus\dimen100
+ \belowdisplayshortskip -\count33sp plus 46pt
+ \global\mathchardef\minus"232D % mathbin, family 3, character "2D (-)
+ \thinmuskip 1mu plus 2fill minus 3mu
+ \medmuskip 2mu minus 3mu
+ \thickmuskip -4mu
+ \def\gobble#1{} \floatingpenalty 100 \holdinginserts1
+ \everypar{A\insert200{\baselineskip400pt\splittopskip\count15pt\hbox{\vadjust
+ {\penalty999}}\hbox to -10pt{}}\showthe\pagetotal\showthe\pagegoal
+ \advance\count15by1\mark{\the\count15}\splitmaxdepth-1pt
+ \paR\gobble} % this aborts every paragraph abruptly
+ \def\weird#1{\csname\expandafter\gobble\string#1 \string\csname\endcsname}
+ \message{\the\output\weird\one on line \the\inputlineno}
+ \hyphenpenalty 88 \exhyphenpenalty 89 \badness
+ \clubpenalty 125 \widowpenalty 125 \displaywidowpenalty -125
+ \brokenpenalty 37
+ \interlinepenalty -125
+ \doublehyphendemerits 1000
+ \finalhyphendemerits 100000
+ \mag 2000 \righthyphenmin=1000000000
+ \delimiterfactor 10 \delimitershortfall 190pt
+ \showboxbreadth 55 \showboxdepth 9999 \chardef\nul0\def\0{\nul}
+ \tracingstats=4 \tracinglostchars=2 \tracingparagraphs\day \tracingpages\year
+ \chardef\?=`b \lccode`A=1 \let\^^bbb \hyphenchar\trip=1
+ \language-1\hyphenation\relax{b-\?-\char`b -\^^bb-^^62-^^" -t- }\lccode`149
+ {\everypar{\parindent\\\looseness-1}\skipdef\\8\language\?\\.01014pt\patterns
+ {0111}\emergencystretch9pt\language255\patterns{\the\\} % \patterns{.01015pt}
+ {\language256\patterns{0111 \?50AA1b3 *1AcA. bb bb1 0B2B0 b1c}} % *==space
+ \pretolerance-1\setbox0=\hbox{11}\setbox0=\hbox{\hbadness100\valign{#\cr
+ \hskip-9pt7A\righthyphenmin0\setlanguage\?\unhbox0{*\language`b11\noboundary}
+ 1Z1pts\patterns{q9q} -\0qq \showlists{\language\?\noboundary111}%
+ \hyphenchar\rip=`-\cr}}\patterns{toolate}\showbox0}
+ \showboxbreadth 9999\lefthyphenmin=2\righthyphenmin=3
+ \nulldelimiterspace --+.1pt \mathcode`q="3171
+ \scriptspace\if00-0.\fi\ifnum'\ifnum10=10 12="\fi
+ A 01p\ifdim1,0pt<`^^Abpt\fi\fi % this boils down to -0.01pt
+ \overfullrule 5pt \voffset-2pt
+ \def\sh{\ifnum\count4>10\else\dimen5=\count4pt
+ \advance\dimen5 by 10pt
+ \xdef\a{\a\the\count4pt \the\dimen5}
+ \advance\count4 by 1 \sh\fi}
+ \count4=1 \def\a{} \sh % \def\a{1pt 11pt 2pt 12pt ... 10pt 20pt}
+ \let\next=\dump \everyjob{\message{#}}
+\else\let\next=\relax\fi
+\next % if no format was preloaded, this will dump the trip.fmt file and halt
+\tracingcommands2\tracingrestores+2\write-1{log file only\the\prevgraf}
+\openout-'78terminal \openout10=tr\romannumeral1 \gobble\newcs pos
+\write10{} % writing three lines on tripos.tex (the first line is empty)
+\write10{\uppercase{\number{\outputpenalty}}} % 0{\outputpenalty} + error
+\write10{[\uppercase{\romannumeral-\the\outputpenalty}[} % "mmmmmmmmmm" (-10000)
+\vsize 2000pt
+\vbadness=1
+\topskip 20pt plus 1fil
+\penalty -12345 % this will be ignored since the page is still empty
+\maxdepth=2pt
+\tracingoutput\on
+\moveleft20pt\copy200
+\moveright20pt\hbox{\vrule depth20pt height-19pt width1pt}
+\penalty-10000 % now we'll compute silently for awhile, after default output
+\batchmode\output={\tracingcommands0\showthe\outputpenalty
+ \showboxbreadth 9999 \showboxdepth 9999 \hoffset1sp
+ {\setbox 254=\box255\shipout\ifvbox2\ifhbox254 \error\fi54\copy25\fi4}
+ \ifvoid 254\relax\else\error\fi
+ }
+\setbox255\vbox{}
+\dimen200=10000pt
+{\output{\dimen 9=\ht200\count5=\dimen9\global\countz=\outputpenalty
+ \ifnum\holdinginserts>0\global\holdinginserts0\unvbox255\penalty\countz
+ \else\setbox255\copy255 % at end of group, \box255 reverts to former value
+ \shipout\hbox{\box100\box200\vsplit 255 to 55pt}
+ \unvcopy255\showlists\showthe\insertpenalties\showthe\pageshrink
+ \globaldefs1\halign{#\tabskip\lineskip\cr}
+ \showboxdepth1\showboxbreadth2\fi
+ \message{\topmark:\firstmark:\botmark:\splitfirstmark:\splitbotmark}}
+ \insert100{\def\box{\vbox to 267.7pt{}} \vskip0pt plus 1fil
+ \baselineskip 0pt \lineskip 0pt minus .4pt
+ \box \penalty-101 \box \penalty-100 \box \penalty-1000
+ } % since \dimen100=803pt<3*267.7pt, the insertion splits;
+ % and the natural height+depth of the split-off part is 267.7pt;
+ % now since \count100=2000,
+ % this insertion adds about 535.4pt to the current page
+ \topskip1pt plus 44pt
+ \vbox spread 1000pt{} % beginning of new page
+ \insertpenalties=-50\penalty12345
+ \cleaders\hbox{\lower2pt\vbox to 17pt{}
+ \leaders\hrule\hskip10pt
+ \cleaders\hbox{A}\hskip 9pt % the A is 2pt wide
+ \leaders\hbox{A}\hskip 9pt
+ \xleaders\hbox{A}\hskip 9pt
+ \write111{\help} % \write will be ignored in leaders
+ }\vskip50pt minus 10pt
+ \mark{alpha}
+ AAA\everypar=\errhelp % because of previous \everypar, this makes 3 paragraphs
+ % and each paragraph consists of A\insert 200{400pt of stuff}\mark{n}
+ % but \count200=500 so the inserts are rated 200pt each
+ % so the third insertion will be split
+ \kern-50pt
+ A\hfill\vadjust{\newlinechar128\special{^^80\the\prevdepth}\penalty-5000}%
+ \penalty-1000000000 % forces line break in paragraph
+ % this is not the end of paragraph
+ A\par\insert200{\vskip10000pt\floatingpenalty3}% this insert will be held over
+ \pagefilstretch-1pt\showthe\insertpenalties\penalty99999999\showlists
+ \showthe\pagefilllstretch\vskip 1000pt\penalty-333\hbox to 23pt{} % output now
+ \vsize.pt\global\vsize=16383.99999237060546875pt % page size \approx infinity
+ } % now we revert to the former output routine
+{\tracingoutput-2\tracingstats1\shipout\hbox{\closeout10\closeout-10}}
+\showthe\everypar
+\everypar{}\showthe\everypar
+\def\showlonglists{{\tracingcommands0\pagefillstretch-1\dimen100
+ \showboxbreadth 9999 \showboxdepth 9999 \showlists \pagegoal=10000pt}}
+\tracingmacros=1
+\def\t12#101001#{-.#1pt} \let\T=\t
+\dimendef\varunit=222\varunit=+1,001\ifdim.5\mag>0cc0\fi1pt
+\ifdim -0.01001\varunit=\t120100101001001{\relax}\else\error\fi
+\countz=-1
+\ifodd\count0\advance\countz by -1\fi
+\penalty -12345 % output the remaining stuff
+\tracingmacros\tracingstats % the next part tests line-break computations
+% the two competing ways to set the paragraph have respective demerits
+% (30+l)^2+(30+l)^2+a and (51+l)^2+l^2, where a=adjdemerits, l=linepenalty
+\adjdemerits=782
+\linepenalty=1
+\def\1#1{\hbox to#1pt{}}
+\valign{\baselineskip20ptplus1pt\global\parfillskip0pt
+ \global\global\leftskip4pt
+ \rightskip-1pt
+ \global\hsize13pt
+ \setbox2\12
+ \noindent\copy2\hskip2pt plus5pt minus1pt
+ \copy2\hskip5pt minus2pt
+ \lower2pt\11\hskip3pt % this affects depth of the second line
+ \copy2 \hskip2pt plus.5pc
+ \box2#\cr
+ \noalign{\spacefactor=2000\global\xspaceskip=-1pt}
+ \noalign{ \vrule width0pt{ }}
+ \cr % set that paragraph with a=782, l=1 (demerits 2704 vs 2705)
+ \adjdemerits=784 \cr % increase a, so the second alternative is better
+ \linepenalty=2\hbadness=51\cr % increase l by 1, suppress diagnostic typeout
+ \noalign{ \spacefactor=1}}\message{\the\spacefactor}
+{\hsize1000pt\par\parindent1pt\indent}\leftskip3pt\def\?{\vrule width-2pt
+ \hbox spread2pt{}}\noindent\indent\hbox spread2pt{\hskip0pt plus-1bp}%
+\discretionary{\?AAAB}{\?B-}{\?/A\kern2pt}\unkern % the widths are 7pt, 4pt, 6pt
+\showthe\lastkern\vbox{\hrule width 6pt} \par % should set with nothing overfull
+\penalty-22222 % end of demerits test, hyphenation is next
+\looseness-10
+\uchyph=1
+\hsize 100pt
+A /A\char`A BBBBCACAC//% that becomes /k[AA]k[BB]k[BB][CA][CA][C/]/,
+ % where [] means a ligature and k means a kern.
+ % the word "aabbbbcaca" should be hyphenated to "aa1b3b2b2b1c1aca",
+ % which becomes {[AA]k-||[AA]k}{B-|[BB]kBk|[BB][BB]}{-||}{C-|A|[CA]}[CA]
+ % if I use the notation {x|y|z} for \discretionary{x}{y}{z}.
+\vadjust{\uchyph=0\ BBBBBB}% underfull box will show no hyphens
+\vadjust{\ \closeout1BBBBBB}{\hyphenchar\trip`C}% this time we get hyphens
+\hyphenation{BbB-BbB}\vadjust{\ BBBBBB\kern0ptB}% different hyphens
+\hyphenchar\rip`-\vadjust{\def\B{B}\ \pretolerance10000 B\B BBBB} % no hyphens
+
+\hbox{\sfcode`B=1234AB aB }\noindent \scriptscriptfont3 \smalltrip
+$$\eqno^{}$\scriptfont3=\rip\fontdimen2\smalltrip=0pt
+{\rightskip0pt plus 104pt minus 100fil
+ \looseness 5 \spaceskip 4pt plus 2pt minus 1fil
+ A\spacefactor32767\discretionary{}{\kern2pt-}{B\kern2pt} C$ \scriptfont2=\trip
+ \mathsurround143pt$ C $\mathsurround40pt$$\mathsurround60pt\hbox{$$}$\par}
+\uccode`m=`A\font\mumble=mumble\input tripos % "AAAAAAAAAA"+errors
+\par\penalty-33333 % end hyphenation, math is next
+{\catcode`?=13 \font?xyzzy at0pt\font ? xyzzy scaled1?} % nonexistent
+\font\enorm=trip at 2047.999992370605468749999 pt
+\font\ip trip at -10pt % through the looking glass
+\showthe$
+\showthe\font
+\message{\fontname\ip}
+\rip
+\textfont1=\font \scriptfont1=\smalltrip \scriptscriptfont1=\bigtr^^@p % [sick]
+\def\symbolpar #1*#2*#3*{\global\fontdimen#1\smalltrip = #3 pt}
+{\tracingmacros-1
+ \symbolpar8 num1 9.1
+ \symbolpar9 num2 9.2
+ \symbolpar10 num3 9.3
+ \symbolpar11 denom1 3.1
+ \symbolpar12 denom2 3.2
+ \symbolpar13 sup1 8.1
+ \symbolpar"E sup2 8.2
+ \symbolpar15 sup3 8.3
+ \symbolpar16 sub1 4.1
+ \symbolpar17 sub2 4.2
+ \symbolpar18 supdrop 0.3
+ \symbolpar19 subdrop 0.4
+ \symbolpar20 delim1 10
+ \symbolpar21 delim2 20
+ }
+\mathcode`+='20457 % mathbin, family 1, character '57 (/)
+\mathcode`=="322D % mathrel, family 2, character "2D (-)
+\delcode`["161361 % small (family 1, character "61 (a)), large (3,"61)
+\catcode`(=13 \catcode`(=13 \mathcode`y"7320\mathcode`z"8000
+\def({\delimiter"4162362 }{\catcode`z=13\global\let z=(}
+\parshape 10 \a \chardef\x200
+\hangindent- \parshape pt\hangafter-12% \parshape will take precedence
+\begingroup
+\looseness 2
+\rightskip 0pt plus 10fil minus 1sp
+\--\--\char-0-A\- % this makes lines 1 to 3
+$$\number\the\delcode`\relax\over{{{}}}}\pagestretch=-1\pagetotal\showlists
+\begingroup\halign to\the\displaywidth{#&#\crcr\crcr\cr} % makes lines 4--6
+\global\count6=\displayindent
+\predisplaypenalty=101
+\global\postdisplaypenalty-\predisplaysize* \global\setbox=
+\eqno % another error (actually causes two error messages and inserts $$)
+\looseness-2
+$\right\relax\mathchardef\minus="322D % locally \minus is the same as =
+\left.A\over A\abovewithdelims.?\right(+\mskip1A\minus=A+\penalty+1000A
+\relpenalty-2222
+\binoppenalty-3333
+\mathsurround.11em$\x % this formula goes on line 7
+$$ % here we begin a hairy display that covers lines 8 to 10
+\vadjust{\penalty7}\mkern-9mu\the\prevgraf \prevgraf=8 \insert255{\penalty999}
+\x\vcenter spread-2pt{} {\mathaccent"32D {A}}|-
+^{\raise 2pt\hbox{a}\displaystyle\char`+\textstyle}
+\overline{^A A|\minus\mathinner{}^
+ {A \mathchar"141 \char`B^^A{\mathaccent"7161
+ {\mathop A \mathbin A \mathopen A \mathpunct A\mathclose A \mathrel A
+ \global\scriptscriptfont0=\trip
+ \mathaccent"161 {\fam13A9\the\scriptscriptfont-1}}}}}
+\mathop\char`B^\mathchar"143
+\mathop b\nolimits\limits|C
+\mathord \radical"161 % missing { will be inserted
+ {\textstyle\radical"282382{\left(\scriptscriptstyle\mathop{\underline{
+ A\atop\displaystyle A|{A\hfil\over B\nonscript\kern1pt}^=}}
+ \nolimits|{\mathop y\nonscript\textstyle\nonscript\mskip9mu minus1fil
+ \showthe\lastskip B\abovewithdelims(.2pt\displaylimits}^z
+ \discretionary{\showthe\spacefactor-}{\smalltrip A\hss}{\smalltrip A}
+ \right[A}}}
+\let\penalty=\minus \aftergroup\expandafter
+\eqno\aftergroup\relax\scriptstyle\penalty % reader, be alert
+(\mathpunct{AA}
+|{B\fam1-}^{\hbox{A}}{\above9pt{v\overwithdelims..
+ \displaystyle{pq\atopwithdelims((\vrule height 9pt}}
+ \show\penalty \showlonglists
+ $\expandafter$\csname!\endcsname % end of hairy display, missing } inserted
+\parshape=-1 % now the hanging indentation is relevant
+\leftskip \parshape pt plus -10fil
+\spacefactor1\raise1pt\hbox{\special{\the\hangafter} } \penalty-10000
+\showbox0\spacefactor=0
+\write10{\the\spacefactor}\par % it's illegal to \write the space factor
+} % this fails to match \begingroup
+\aftergroup\lccode\aftergroup`\endgroup A`a % this restores \parshape
+\mark{\the\spacefactor} % \spacefactor: not in vertical mode
+$$\global\count7=\predisplaysize
+\mskip18mu minus 18mu \catcode`J=13 \catcode`j=\the\catcode`J \def j{\relax}
+\vtop to\displaywidth{\everydisplay{\global}\vbox to -1sp{}\noindent$$
+ \count9=\predisplaysize\lowercase{AaJ}$\ifvmode$\fi}\hss
+\leqno\mathchardef A\/\left(\over\left(\global\errorcontextlines5$$
+
+\hangindent1pt\par\showthe\hangindent\hangindent 254cm
+\parfillskip 0pt plus 100pt \fontdimen6\the\scriptfont2=-19sp
+\the\fam % begins a paragraph, but there's no 0 in the font
+A \char'202$$\global\count8=\predisplaysize\leqno\kern1009pt$\par
+\showlists {\catcode`!13\global\everyhbox{\def!{}}}
+\count5=\lastskip % \lastskip=3pt (\belowdisplayskip)
+\baselineskip 10pt
+{\sfcode`A=500\vfuzz18pt\everyvbox{ }% overfull \vbox won't be shown: 37-8=11+18
+ \vbox to 11pt{\hsize 10pt\tolerance 1 A A A A A\clubpenalty10000\par
+ \hbadness100\hfuzz 3pt A A A A A\leaders\vrule\hskip5pt\par}
+ \message{\the\badness}}
+\vbox to 10pt{\hbadness 99\hfuzz1pt\hbox to 0pt{\hskip 10pt minus 9pt}
+ \hbadness100\hbox to 10bp{\hskip 0pt plus 10pt}\tracingcommands1
+ \if\the\badness\fi\message{\the\badness}}\lineskiplimit-1pt\everyhbox{}
+\def\space{ } \dimendef\df=188 \dimen188=1pt
+\vbox to 11pt{\tracinglostchars-9 A\/\space\space\ignorespaces\space\space J
+ \vskip2pt\moveleft1pt\vbox to10pt{\boxmaxdepth=-1pt\mark{vii}}\vskip3pt
+ \unskip\setbox22=\lastbox\showthe\lastskip % \lastskip=-1pt (\baselineskip)
+ \unskip\vskip-\lastskip\kern\lastkern\penalty\lastkern\showbox22}
+\showbox22\kern3pt\message{\the\lastkern}\unkern
+\show\botmark \catcode`;13\def;{\setbox`; }
+\lineskiplimit-0.9999 \space\df\space\count9 0
+\vbox\space to 11pt{\accent\x\space\accent\space"42 \def\^^M{\ } ; \char'101
+ A\ \fontdimen 4 \trip = 88 pt\ \spaceskip 2 pt \
+ \vskip 10pt minus 10pt}
+\penalty-2147483647 % that's the largest value TeX will scan
+\penalty-2147483648 % see?
+\tabskip 1009.9sp minus .25cc % and now for alignment tests
+\let\A=\relax\count1=2{\errhelp{all is lost}\errmessage{}}
+\def\d#1\d{#1#1} \looseness-1
+\setbox3=\vtop{\vskip-3mm} % this box has a depth of -3mm
+\halign spread-12.truedd{&#\span\iftrue\A\span\else\span\fi\span&
+ \vbox{\halign to 0pt{\t2\dp3\A\crcr}#A}
+ &\hss\tabskip1ex plus7200bp minus 4\wd4\d#\d\cr % \d#\d becomes (erroneous) ##
+ \global\let\t=\tabskip \spaceskip=4pt minus 1sp
+ \def\A{B}\def\xx{\global\gdef\A{\global\count\count1=####\cr
+ \omit\cr\tabskip}}\expandafter\xx\span % please don't ask what this does
+ A&\omit\valign to -5pt{#&#\cr A\char`}\span\cr{ }\span\cr}\cr
+ \global\edef\A{\uppercase{
+ \message{\fontname\smalltrip\the\font\romannumeral1009}\lowercase{vq}} }
+ \lccode`Q=`b \span\omit$$\span\A&\show\cr\omit\cr
+ \noalign{\global\prevdepth20pt\errmessage{\count2=\the\count2}}
+ \omit\mark{a}&\omit\mark{b}\cr} % \count2 was set to -6mm=-1118806sp
+\errmessage{\prevdepth=\the\prevdepth}
+\penalty-88888 % end alignment test, now miscellaneous error messages
+\newlinechar`Y\global\unskip\show^^Y\newlinechar\lastpenalty\unpenalty\unkern
+\lastbox\penalty5\message{\the\lastpenalty\the\newlinechar}\textfont16=\relax
+\outer\def{}?
+\dimen5=-'7777777777sp\showthe\dimen5 % this should be OK
+\dimen6=-'40000pt\showthe\dimen6 % this should overflow
+\dimen7=.51\dimen5\showthe\dimen7 \multiply\dimen7 2\showthe\dimen7
+\a^^@^^@a@ % an undefined control sequence followed by invalid character
+{\aftergroup\gobble\aftergroup\c\gdef\b{\c} \def\c{} \b} % \c undefined
+\def\b#1\par{}
+\outer\gdef\a^^@^^@a#1\par#2{}\tokens{\a^^@^^@a\par!
+\long\gdef\l#1{}
+\outer\global\long\edef\lo#1#2U3#4#5#6#7#8#8#9#{\relax}
+\ifcase 1 \undefined\or\l\par\b{\par % occurrence of \par aborts \b
+\b{\l\undefined}\par\else\b{\par}\fi % but not there!
+\ifcase\iftrue-1a\else\fi \ifcase0\fi\else\ifcase5\fi\fi
+\catcode`^^C = 6 % another parameter symbol
+\let\^^C=\halign
+\def\^^@^^C{}
+\^^C{{\span\ifcase3 \lo#\cr............89{}\cr} % runaway preamble?
+\def\a^^C1{\d#1\d\l{#2}\l#1\par\a^^@^^@a#1\par# % runaway in definition; #2 bad
+\xdef\a^^C1{\d#1\d\l{#2}\l#1\par\a^^@^^@a#1\par# % runaway in definition; #2 OK!
+\T^^?a^^@^^@a\par{\lo\par % runaway in use
+\lo\par\par\par P \par\par\par\par\par\par89{} \muskip3=-\thickmuskip
+\muskipdef\shmip=3 \shmip=5mu plus \muskip3minus.5\shmip \showthe\shmip
+{\advance\shmip by \shkip\endlinechar-1
+\divide\shmip by \shkip\endlinechar`}
+\global\multiply\shmip by 2
+\showthe\shmip
+\div^^)de\count88
+By ^^p \toks1={\a\test}
+^\leaders\vrule\mskip\shmip M\leaders\hrule\nonscript\hskip\thinmuskip
+
+{\setbox3\hbox{\vfill\vsplit 3 0pt}
+\def\a#2{}
+\show A
+\show\a^^@^^@a
+\show (
+\message{\meaning\lo\noexpand\lo}
+\show\^^C
+\show\batchmode
+\show\error
+\showthe\output
+\showthe\thinmuskip
+\showthe\fontdimen1\enorm
+\ifx T\span\else\par\if\span\else\else\else\fi\fi
+\ifdim72p\iftrue t1i\fi n\fi\fi \message{\jobname\ifx\lo\lo OK}\fi
+\hangindent 2pt
+{\if 11 \prevgraf=-1\if 0123\error\else\relax\fi\else\error\fi
+ \prevgraf1\global\hangafter=2}\showthe\hangafter\showthe\prevgraf
+\char'203\showthe\prevgraf$\indent\mark{twain}
+\setbox3\hbox{\vrule}&\moveleft\lastbox % can't do that in math mode
+\unhbox234\unhcopy3\accent\x\vfill\vfil\vfilneg\vss % \vfill exits, \vss bad
+\def\a}{\let\a\xyzzy\csname a\endcsname}
+\def\a{ab
+
+ \c}\def\b{ab*\par\c}\let\c\b \def\b{\a\c} \ifx\a\ifx \.
+\else\expandafter\ifx\b \ifinner\error\else\relax\fi\else\error\fi\fi
+\ifvmode$\ifmmode\hbox tt\ifhmode\hfilneg\else\error\fi}$\fi\fi % missing {
+\noalign\omit\endcsname % these are extra
+\fontdimen 1000=20\varunit\showthe\fontdimen1000\trip\let\PAR=\par
+\gdef\par{\relax\PAR}\expandafter\ifx\csname xyzzy\endcsname\relax \mag=1999
+
+\fi\noindent{\halign to 1truemm\expandafter{\csname#\endcsname#&#&\l{#}\cr
+ \global\futurelet\endt\foo&\show\endt&$&&&.}
+
+\hbox{\/\hrule\textfont3=\enorm\prevdepth\advance\xspaceskip by-\xspaceskip
+ \spacefactor2000{ }\everymath{\radical"3}\fontdimen2\rip=0pt
+ $62{}\delimiterfactor1600\left(Aa\right\delimiter"300$AA\/}
+\openin 15 tripos\closein 15\iftrue{\ifeof 15\openin 100 tripos
+ \def\loop{\ifeof 0\let\loop=\relax\else{\global\read0to \a}\show\a\fi\loop}
+ \catcode`015\catcode`[1\outer\def\uppercase{}\loop}\else\fi
+}\def\test#1{\let\test= }\test. \show\test
+\def\a#1{\ifcat#1 \message\ifx#1 {\iffalse\fi\the\tokens\fi\fi}}
+\pretolerance-1\tokens\toks1\unhbox16\par\everycr{\noalign{\penalty97}}
+\the\tokens\ifcase1\or\ifeof\fi\def\stopinput{\error\let\input\die}
+\let\lb={\let\rb=}\halign\relax{\span\iffalse}\fi\cr#&\ifnum0=`{\fi\cr\cr}
+\let\e\expandafter\def\trap#1{}\def\unbalanced{\halign\lb}\unbalanced#\cr
+ \relax\e\e\e\err\e\e\e\endt\e\trap\cr\noexpand\cr}
+
+\expandafter\stopinput\input tripos\endinput\input % one line of tripos
+\setbox10=\vbox to8192pt{\hbox{\hbox{\vadjust{A}}}}\vrule\unhbox10\hrule
+\output{\showthe\deadcycles\global\advance\countz by1\global\globaldefs-1
+ \gdef\local{}\unvbox255\end\rb}\futurelet\dump\maxdeadcycles=3\show\dump
+\catcode`q=7 \catcode`\qqM=0 \expandafter\let\csname^^Mendcsname=\^^@\relax
+\relax\catcode`\qq1qM=13 \defqqM{\relax}#\begingroup{\showboxdepth=4\showbox10}
+
+\long\def\l#1\l{#1}\immediate\write10{\string\caution \l} % living dangerously
+\escapechar`|\tracingoutput0\shipout\vbox{\copy10qq5e^5cbox10}
+\setbox9\hbox{\fontdimen8\rip 0pt % \over becomes \atop in \scriptstyle
+ \afterassignment\relax\advance\prevdepth\afterassignment\relax\futurelet\x
+ \message{\noexpand\l\meaning\l\the\skewchar\ip}\vbox{\hyphenchar\ip-1%
+ \-\ BBBBBB\par\hyphenchar\ip`?\-\ BBBBBB}\if$\expandafter\noexpand\dol\fi%
+ \expandafter\expandafter\noexpand\undefined\noexpand\expandafter%
+ $\begingroup\mathop{\vbox{\vss}}\limits^\mathchoice{}a}{A|{}}{\mathchoice}
+ {}{\relax{}{B\over}\endgroup\showlonglists$}\showboxbreadth9\showboxdepth9
+\showbox9\PAR{\output{}\penalty-10001\deadcycles=2}\scrollmode%
+\hbox{\write-100000{\if01{\else unbal}\fi}\showlists\tracingonline1%
+\escapechar127\global\tracingoutput1\global\escapechar256\end
+% things not tested:
+% interaction (error insertion/deletion, interrupts, \pausing, files not there)
+% system-dependent parsing of file names, areas, extensions
+% certain error messages, especially fatal ones
+% things that can't happen in INITEX
+% unusual cases of fixed-point arithmetic
diff --git a/Build/source/texk/web2c/triptrap/trip.typ b/Build/source/texk/web2c/triptrap/trip.typ
new file mode 100644
index 00000000000..dbbc07ded00
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trip.typ
@@ -0,0 +1,1215 @@
+This is DVItype, Version 3.6
+Options selected:
+ Starting page = *.*.*.*.*.*.*.*.*.*
+ Maximum number of pages = 1000000
+ Output level = 2 (mnemonics)
+ Resolution = 72.27000000 pixels per inch
+numerator/denominator=25400000/473628672
+magnification=2000; 0.00003052 pixels per DVI unit
+' TeX output 2002.12.20:2128'
+
+42: beginning of page 0.0.0.0.11.0.0.0.0.0
+87: down4 129105920
+92: down3 655360
+96: push
+97: right3 1310720
+[ ]
+101: down3 1310720
+105: setrule height 65536, width 65536
+114: pop
+115: eop
+
+116: beginning of page -5000.0.0.0.11.53110374.0.0.0.0
+161: push
+162: down4 116090475
+167: push
+168: right3 262144
+[ ]
+172: setrule height 26214, width 655360
+181: right3 32773
+[ ]
+185: push
+186: fntdef1 0: trip---loaded at size 655360 DVI units
+ (this font is magnified 200%)
+206: fntnum0
+207: setchar65
+[A]
+208: pop
+209: w3 131072
+[ ]
+213: push
+214: setchar65
+[A]
+215: pop
+216: w0 131072
+[ ]
+217: push
+218: setchar65
+[A]
+219: pop
+220: w0 131072
+[ ]
+221: push
+222: setchar65
+[A]
+223: pop
+224: right3 229371
+[ ]
+228: push
+229: setchar65
+[A]
+230: pop
+231: w0 131072
+[ ]
+232: push
+233: setchar65
+[A]
+234: pop
+235: w0 131072
+[ ]
+236: push
+237: setchar65
+[A]
+238: pop
+239: w0 131072
+[ ]
+240: push
+241: setchar65
+[A]
+242: pop
+243: w3 144181
+[ ]
+247: push
+248: setchar65
+[A]
+249: pop
+250: w0 144181
+[ ]
+251: push
+252: setchar65
+[A]
+253: pop
+254: w0 144181
+[ ]
+255: push
+256: setchar65
+[A]
+257: pop
+258: w0 144181
+[ ]
+259: push
+260: setchar65
+[A]
+261: pop
+262: pop
+263: down3 1114112
+267: push
+268: right3 262144
+[ ]
+272: setrule height 26214, width 655360
+281: right3 32773
+285: push
+286: setchar65
+[A]
+287: pop
+288: w3 131072
+[ ]
+292: push
+293: setchar65
+[A]
+294: pop
+295: w0 131072
+[ ]
+296: push
+297: setchar65
+[A]
+298: pop
+299: w0 131072
+[ ]
+300: push
+301: setchar65
+[A]
+302: pop
+303: right3 229371
+[ ]
+307: push
+308: setchar65
+[A]
+309: pop
+310: w0 131072
+[ ]
+311: push
+312: setchar65
+[A]
+313: pop
+314: w0 131072
+[ ]
+315: push
+316: setchar65
+[A]
+317: pop
+318: w0 131072
+[ ]
+319: push
+320: setchar65
+[A]
+321: pop
+322: w3 144181
+[ ]
+326: push
+327: setchar65
+[A]
+328: pop
+329: w0 144181
+[ ]
+330: push
+331: setchar65
+[A]
+332: pop
+333: w0 144181
+[ ]
+334: push
+335: setchar65
+[A]
+336: pop
+337: w0 144181
+[ ]
+338: push
+339: setchar65
+[A]
+340: pop
+341: pop
+342: pop
+343: eop
+
+344: beginning of page 10000.0.0.0.11.131072.0.0.0.0
+389: push
+390: down4 32460719
+395: push
+396: fntnum0
+397: setchar65
+[A]
+398: down3 65536
+402: setrule height 524288, width 327680
+411: pop
+412: y3 1880637
+416: push
+417: setchar65
+[A]
+418: down3 65536
+422: setrule height 524288, width 327680
+431: pop
+432: y0 1880637
+433: push
+434: setchar65
+[A]
+435: down3 65536
+439: setrule height 524288, width 327680
+448: pop
+449: down3 -1396163
+453: push
+454: setchar65
+[A]
+455: down3 65536
+459: setrule height 524288, width 327680
+468: pop
+469: pop
+470: eop
+
+471: beginning of page -333.0.0.0.11.655360000.0.0.0.0
+516: push
+517: down4 651689984
+522: xxx '?-1000.0pt' non-ASCII character in xxx command!
+534: down3 655360
+538: push
+539: fntnum0
+540: setchar65
+[A]
+541: down3 65536
+545: setrule height 524288, width 327680
+554: pop
+555: pop
+556: eop
+
+557: beginning of page -333.0.0.0.11.0.0.0.0.0
+602: eop
+
+603: beginning of page -2.0.0.0.11.0.0.0.0.0
+648: eop
+
+649: beginning of page -2.0.0.0.11.0.0.0.0.0
+694: down4 1001310720
+699: push
+700: push
+701: push
+702: down3 -1441792
+706: down3 1441792
+710: pop
+711: pop
+712: push
+713: push
+714: down3 -1441792
+718: down3 1310720
+722: pop
+723: pop
+724: push
+725: push
+726: down3 -1441792
+730: down3 1310720
+734: pop
+735: pop
+736: pop
+737: y3 655360
+741: push
+742: right3 393217
+[ ]
+746: fntnum0
+747: setchar65
+748: right3 131072
+752: setchar66
+[A B]
+753: pop
+754: y0 655360
+755: push
+756: right3 196609
+760: setchar67
+[ C]
+761: push
+762: putrule height 26214, width 393216
+771: pop
+772: pop
+773: eop
+
+774: beginning of page -2.0.0.0.11.0.0.0.0.0
+819: down4 1001179648
+824: push
+825: right3 196609
+[ ]
+829: fntnum0
+830: setchar65
+831: right3 4653056
+835: setchar47
+836: right3 65536
+840: setchar65
+841: w3 131072
+845: setchar65
+846: w0 131072
+847: setchar65
+[A /A A A]
+848: set1 130
+850: set1 130
+852: setchar66
+853: setchar47
+[B/]
+854: pop
+855: y3 589824
+859: push
+860: right3 5898241
+864: setchar65
+865: w3 131072
+869: setchar65
+870: w0 131072
+871: setchar65
+[ A A A]
+872: pop
+873: down3 524288
+877: push
+878: right3 5898241
+882: setchar65
+883: w3 131072
+887: setchar65
+888: w0 131072
+889: setchar65
+[ A A A]
+890: pop
+891: y0 589824
+892: push
+893: right3 5701633
+897: setchar65
+898: w3 131072
+902: setchar65
+903: w0 131072
+904: setchar65
+905: setchar66
+[ A A AB]
+906: pop
+907: y0 589824
+908: push
+909: right3 5898241
+913: setchar65
+914: w3 131072
+918: setchar65
+919: w0 131072
+920: setchar65
+[ A A A]
+921: pop
+922: y0 589824
+923: push
+924: right1 1
+926: setchar65
+927: right3 131072
+931: setchar66
+932: right3 262144
+936: setchar97
+937: setchar66
+[A B aB]
+938: pop
+939: down3 2031616
+943: push
+944: right3 196609
+948: setchar65
+[ A]
+949: pop
+950: y3 655360
+954: push
+955: right3 262144
+959: setchar45
+[ -]
+960: pop
+961: y0 655360
+962: push
+963: right3 196609
+967: setchar67
+[ C]
+968: pop
+969: y0 655360
+970: push
+971: right3 196609
+975: setchar67
+[ C]
+976: pop
+977: y0 655360
+978: y0 655360
+979: push
+980: right3 6422529
+984: setchar65
+[ A]
+985: pop
+986: eop
+
+987: beginning of page -2.0.0.0.11.0.327680.0.0.0
+1032: down4 1001179648
+1037: push
+1038: right3 262145
+[ ]
+1042: fntnum0
+1043: setchar45
+[-]
+1044: pop
+1045: y3 655360
+1049: push
+1050: right3 262144
+1054: setchar45
+1055: setchar45
+[ --]
+1056: pop
+1057: y0 655360
+1058: push
+1059: right3 327680
+1063: setchar45
+1064: setchar45
+1065: right3 65536
+1069: setchar65
+[ --A]
+1070: pop
+1071: down3 851968
+1075: eop
+
+1076: beginning of page -2.0.0.0.11.0.327680.0.0.0
+1121: down4 639342208
+1126: push
+1127: push
+1128: push
+1129: push
+1130: down3 -602931
+1134: push
+1135: right3 740559
+[ ]
+1139: fntdef1 1: trip---loaded at size 327680 DVI units
+1159: fntnum1
+1160: setchar65
+[A]
+1161: pop
+1162: right3 740559
+[ ]
+1166: down3 176947
+1170: putrule height 65536, width 98304
+1179: down3 635699
+1183: push
+1184: setchar65
+[A]
+1185: pop
+1186: pop
+1187: pop
+1188: push
+1189: right3 845417
+[ ]
+1193: down3 -262144
+1197: fntnum0
+1198: setchar98
+[b]
+1199: pop
+1200: pop
+1201: right3 1078433
+1205: setchar47
+1206: right3 54612
+1210: setchar65
+1211: right2 -7280
+[ /A]
+1214: fntnum1
+1215: setchar45
+1216: setchar45
+1217: right3 -72816
+[--]
+1221: fntnum0
+1222: setchar65
+1223: w3 36408
+1227: setchar47
+1228: w0 36408
+1229: setchar65
+[A/A]
+1230: pop
+1231: down3 4912743
+1235: push
+1236: push
+1237: push
+1238: right3 983045
+[ ]
+1242: fntdef1 2: trip---loaded at size 1310720 DVI units
+ (this font is magnified 400%)
+1262: fntnum2
+1263: setchar45
+[-]
+1264: pop
+1265: push
+1266: right3 425989
+[ ]
+1270: fntnum0
+1271: setchar65
+[A]
+1272: push
+1273: down3 -530842
+1277: push
+1278: push
+1279: right3 65536
+1283: down3 -131072
+1287: setchar97
+[a]
+1288: pop
+1289: right3 196608
+1293: setchar47
+[ /]
+1294: pop
+1295: pop
+1296: pop
+1297: pop
+1298: push
+1299: right3 818550
+[ ]
+1303: down3 -1557300
+1307: putrule height 65536, width 984062
+1316: down3 1557300
+1320: push
+1321: push
+1322: down3 -543949
+1326: fntnum1
+1327: setchar65
+[A]
+1328: pop
+1329: right3 97649
+[ ]
+1333: fntnum0
+1334: setchar65
+[A]
+1335: push
+1336: down3 268698
+1340: setchar45
+[-]
+1341: pop
+1342: push
+1343: right3 -310131
+1347: down3 -1098548
+1351: fntnum1
+1352: setchar65
+1353: right3 98304
+1357: setchar66
+[A B]
+1358: push
+1359: down3 471859
+1363: push
+1364: right3 140175
+[ ]
+1368: fntnum2
+1369: set1 130
+1371: pop
+1372: down3 458754
+1376: push
+1377: push
+1378: down3 -65535
+1382: setchar65
+[A]
+1383: pop
+1384: right3 411421
+1388: setchar65
+[ A]
+1389: push
+1390: down3 -131072
+1394: push
+1395: right3 -65536
+1399: setchar97
+[a]
+1400: pop
+1401: pop
+1402: pop
+1403: pop
+1404: pop
+1405: pop
+1406: pop
+1407: push
+1408: down3 -1179648
+1412: push
+1413: right3 1798972
+[ ]
+1417: fntnum1
+1418: setchar67
+[C]
+1419: pop
+1420: down3 1179648
+1424: push
+1425: push
+1426: right3 1766204
+[ ]
+1430: down3 -262144
+1434: fntnum0
+1435: setchar66
+[B]
+1436: pop
+1437: pop
+1438: pop
+1439: push
+1440: push
+1441: push
+1442: right3 1926404
+[ ]
+1446: down3 -458752
+1450: setchar77
+[M]
+1451: pop
+1452: pop
+1453: down3 524288
+1457: push
+1458: right3 2057476
+[ ]
+1462: fntnum1
+1463: setchar67
+[C]
+1464: pop
+1465: pop
+1466: push
+1467: push
+1468: push
+1469: right3 2414284
+[ ]
+1473: down3 -3556148
+1477: fntnum0
+1478: setchar97
+[a]
+1479: pop
+1480: push
+1481: right3 2610892
+[ ]
+1485: down3 -3556148
+1489: putrule height 458752, width 2400948
+1498: down3 3556148
+1502: push
+1503: push
+1504: push
+1505: push
+1506: push
+1507: down3 -1245183
+1511: push
+1512: right2 6554
+1515: setchar0
+1516: pop
+1517: y3 65535
+1521: push
+1522: right2 6554
+1525: setchar0
+1526: pop
+1527: down3 589824
+1531: push
+1532: right2 6554
+1535: setchar65
+[A]
+1536: pop
+1537: down1 -1
+1539: push
+1540: right2 6554
+1543: setchar0
+1544: pop
+1545: y0 65535
+1546: push
+1547: right2 6554
+1550: setchar0
+1551: pop
+1552: down3 655360
+1556: push
+1557: right2 6554
+1560: setchar66
+[B]
+1561: pop
+1562: pop
+1563: push
+1564: push
+1565: push
+1566: push
+1567: down3 -1425409
+1571: push
+1572: right3 543623
+[ ]
+1576: fntnum2
+1577: setchar65
+[A]
+1578: pop
+1579: down3 2451048
+1583: push
+1584: right3 471860
+[ ]
+1588: fntnum0
+1589: setchar65
+[A]
+1590: push
+1591: down3 -530842
+1595: push
+1596: right3 65536
+1600: fntnum1
+1601: setchar45
+[-]
+1602: pop
+1603: down3 1818625
+1607: push
+1608: push
+1609: down3 -638976
+1613: push
+1614: right2 6554
+1617: fntnum2
+1618: setchar65
+[A]
+1619: pop
+1620: right2 6554
+1623: down3 196608
+1627: putrule height 32768, width 393217
+1636: down3 1081344
+1640: push
+1641: right1 1
+1643: setchar66
+[B]
+1644: pop
+1645: pop
+1646: pop
+1647: pop
+1648: pop
+1649: pop
+1650: pop
+1651: right3 465306
+[ ]
+1655: down3 5600055
+1659: putrule height 596378, width 549850
+1668: pop
+1669: pop
+1670: push
+1671: down3 -2323253
+1675: push
+1676: right3 1015156
+1680: setchar98
+[ b]
+1681: pop
+1682: down4 8545900
+1687: push
+1688: push
+1689: right3 1015156
+[ ]
+1693: down3 -65536
+1697: setchar98
+[b]
+1698: pop
+1699: push
+1700: down3 -786432
+1704: push
+1705: right3 1590412
+[ ]
+1709: fntnum0
+1710: setchar66
+[B]
+1711: pop
+1712: right3 1408372
+[ ]
+1716: down3 393216
+1720: putrule height 131072, width 378648
+1729: pop
+1730: pop
+1731: pop
+1732: push
+1733: right3 1792919
+[ ]
+1737: down3 -65535
+1741: fntnum2
+1742: setchar97
+[a]
+1743: pop
+1744: pop
+1745: right3 2204340
+[ ]
+1749: fntnum0
+1750: setchar65
+[A]
+1751: pop
+1752: pop
+1753: pop
+1754: pop
+1755: pop
+1756: pop
+1757: right3 5011840
+[ ]
+1761: down3 6432362
+1765: setrule height 10906014, width 327680
+1774: pop
+1775: down3 7775850
+1779: push
+1780: right3 1292440
+1784: setchar45
+[ -]
+1785: fntnum1
+1786: setchar98
+[b]
+1787: push
+1788: setchar65
+[A]
+1789: pop
+1790: push
+1791: down3 -537395
+1795: push
+1796: right3 98304
+[ ]
+1800: fntnum0
+1801: setchar65
+[A]
+1802: pop
+1803: down3 1245184
+1807: push
+1808: right3 98304
+1812: fntnum2
+1813: setchar66
+[B]
+1814: fntnum0
+1815: setchar45
+[-]
+1816: pop
+1817: pop
+1818: push
+1819: push
+1820: push
+1821: right3 235275
+[ ]
+1825: down3 -163840
+1829: putrule height 589824, width 530116
+1838: down3 1943143
+1842: push
+1843: push
+1844: push
+1845: push
+1846: right2 6554
+1849: down3 -160563
+1853: putrule height 596378, width 517008
+1862: down3 1382810
+1866: push
+1867: push
+1868: push
+1869: down3 -262144
+1873: setchar98
+[b]
+1874: pop
+1875: push
+1876: down3 -720896
+1880: push
+1881: w3 196608
+1885: setchar112
+1886: setchar116
+1887: setchar115
+1888: setchar113
+1889: setchar116
+1890: w0 196608
+1891: setchar113
+1892: setchar112
+1893: right3 -72816
+1897: setchar117
+[ ptsqt qpu]
+1898: pop
+1899: down3 1048576
+1903: push
+1904: right3 245397
+[ ]
+1908: setrule height 589824, width 26214
+1917: pop
+1918: pop
+1919: push
+1920: right3 320400
+[ ]
+1924: down3 -262144
+1928: setchar98
+[b]
+1929: pop
+1930: pop
+1931: pop
+1932: pop
+1933: pop
+1934: pop
+1935: pop
+1936: pop
+1937: pop
+1938: pop
+1939: pop
+1940: eop
+
+1941: beginning of page -2.0.0.0.11.0.327680.1572864.0.-1073741823
+1986: down4 1001179648
+1991: push
+1992: push
+1993: right1 1
+[ ]
+1995: down3 -65536
+1999: xxx '-12'
+2004: pop
+2005: pop
+2006: y3 655360
+2010: y0 655360
+2011: down3 983040
+2015: push
+2016: push
+2017: right3 196609
+[ ]
+2021: fntnum0
+2022: setchar65
+[A]
+2023: push
+2024: push
+2025: right3 83740
+2029: down3 -262144
+2033: setchar98
+[b]
+2034: pop
+2035: push
+2036: push
+2037: right3 286902
+[ ]
+2041: down3 -425984
+2045: putrule height 65536, width 104858
+2054: down3 688128
+2058: push
+2059: push
+2060: down3 -360448
+2064: fntnum1
+2065: setchar98
+[b]
+2066: pop
+2067: pop
+2068: pop
+2069: pop
+2070: pop
+2071: pop
+2072: push
+2073: push
+2074: down3 589825
+2078: push
+2079: right3 4500861
+[ ]
+2083: fntnum0
+2084: setchar97
+2085: setchar97
+[aa]
+2086: pop
+2087: pop
+2088: pop
+2089: pop
+2090: eop
+
+2091: beginning of page -2.0.0.0.11.0.327680.1572864.1073741823.-1073741823
+2136: down4 1001179648
+2141: push
+2142: right3 196609
+[ ]
+2146: fntnum0
+2147: setchar65
+2148: right3 373830
+[A ]
+2152: set1 130
+2154: pop
+2155: down3 655360
+2159: eop
+
+2160: beginning of page -2.0.0.0.11.196608.327680.1572864.1073741823.0
+2205: down4 1001179648
+2210: push
+2211: down3 -262144
+2215: push
+2216: right3 196609
+[ ]
+2220: fntnum0
+2221: setchar65
+2222: w3 131072
+2226: setchar65
+2227: w0 131072
+2228: setchar65
+[A A A]
+2229: down3 65536
+2233: setrule height 524288, width 327680
+2242: pop
+2243: y3 655360
+2247: push
+2248: right3 196609
+2252: setchar65
+2253: right3 196608
+2257: setchar65
+[ A A]
+2258: pop
+2259: down3 131072
+2263: push
+2264: right3 196609
+2268: setchar65
+2269: w3 131072
+2273: setchar65
+2274: w0 131072
+2275: setchar65
+[ A A A]
+2276: pop
+2277: y0 655360
+2278: push
+2279: right3 196609
+2283: setchar65
+2284: right3 196608
+2288: setchar65
+[ A A]
+2289: pop
+2290: pop
+2291: y3 720896
+2295: push
+2296: down3 -655360
+2300: down3 655360
+2304: pop
+2305: down3 655360
+2309: push
+2310: down3 -262144
+2314: push
+2315: right3 196609
+2319: setchar65
+[ A]
+2320: pop
+2321: pop
+2322: y0 720896
+2323: push
+2324: down2 -32767
+2327: push
+2328: push
+2329: right3 198462
+[ ]
+2333: down3 -163841
+2337: setchar66
+[B]
+2338: pop
+2339: right3 558912
+2343: setchar65
+2344: setchar65
+[ AA]
+2345: pop
+2346: pop
+2347: eop
+
+2348: beginning of page -2.2.-1118806.0.11.196608.327680.1572864.1073741823.0
+2393: down4 1001179648
+2398: push
+2399: push
+2400: right3 -104176
+[ ]
+2404: fntnum0
+2405: setchar66
+[B]
+2406: push
+2407: down3 -1310720
+2411: y3 655360
+2415: y0 655360
+2416: push
+2417: right3 196608
+2421: setchar65
+[ A]
+2422: pop
+2423: pop
+2424: pop
+2425: push
+2426: push
+2427: down3 622591
+2431: push
+2432: down3 458752
+2436: push
+2437: right3 6895421
+2441: setchar65
+[ A]
+2442: pop
+2443: pop
+2444: pop
+2445: pop
+2446: pop
+2447: y3 655360
+2451: push
+2452: push
+2453: right3 420112
+2457: setchar98
+2458: right4 12176941
+2463: setchar98
+[ b b]
+2464: pop
+2465: pop
+2466: y0 655360
+2467: eop
+
+2468: beginning of page -2.2.-1118806.0.11.196608.327680.1572864.1073741823.0
+2513: down3 1179648
+2517: z3 655360
+2521: push
+2522: push
+2523: right3 196608
+[ ]
+2527: down3 -537395
+2531: fntnum1
+2532: setchar77
+[M]
+2533: pop
+2534: pop
+2535: y4 203921760
+2540: y0 203921760
+2541: push
+2542: push
+2543: right3 196608
+[ ]
+2547: fntnum0
+2548: setchar116
+2549: setchar116
+[tt]
+2550: pop
+2551: pop
+2552: z0 655360
+2553: z0 655360
+2554: down4 232364531
+2559: push
+2560: push
+2561: push
+2562: right3 393216
+[ ]
+2566: down4 -17616141
+2571: fntdef1 3: trip---loaded at size 134217727 DVI units
+ (this font is magnified 40960%)
+2591: fntnum3
+2592: setchar98
+[b]
+2593: pop
+2594: pop
+2595: push
+2596: push
+2597: down3 -1376253
+2601: push
+2602: right4 40658554
+[ ]
+2607: fntnum0
+2608: setchar0
+2609: pop
+2610: y3 65535
+2614: push
+2615: right4 40658554
+[ ]
+2620: setchar0
+2621: pop
+2622: y0 65535
+2623: push
+2624: right4 40658554
+[ ]
+2629: setchar0
+2630: pop
+2631: y0 65535
+2632: push
+2633: right4 40658554
+[ ]
+2638: setchar0
+2639: pop
+2640: down3 589824
+2644: push
+2645: right4 40658554
+2650: setchar65
+[ A]
+2651: pop
+2652: down1 -1
+2654: push
+2655: right4 40658554
+[ ]
+2660: setchar0
+2661: pop
+2662: y0 65535
+2663: push
+2664: right4 40658554
+[ ]
+2669: setchar0
+2670: pop
+2671: y0 65535
+2672: push
+2673: right4 40658554
+[ ]
+2678: setchar0
+2679: pop
+2680: y0 65535
+2681: push
+2682: right4 40658554
+[ ]
+2687: setchar0
+2688: pop
+2689: z0 655360
+2690: push
+2691: right4 40658554
+2696: setchar66
+[ B]
+2697: pop
+2698: pop
+2699: right4 41117306
+2704: setchar65
+2705: w3 65536
+2709: setchar97
+[ Aa]
+2710: push
+2711: w0 65536
+2712: down4 -20591485
+2717: fntnum3
+2718: setchar0
+2719: pop
+2720: pop
+2721: right4 135463022
+[ ]
+2726: fntnum0
+2727: setchar65
+[A]
+2728: pop
+2729: down4 9227503
+2734: z0 655360
+2735: z0 655360
+2736: z0 655360
+2737: z0 655360
+2738: down2 26214
+2741: putrule height 26214, width 135659630
+2750: eop
+
+2751: beginning of page -1.2.-1118806.0.11.196608.327680.1572864.1073741823.0
+2796: down3 1179648
+2800: eop
+Postamble starts at byte 2801.
+maxv=1073741823, maxh=539754497, maxstackdepth=17, totalpages=16
+Font 3: trip scaled 409600
+Font 2: trip scaled 4000
+Font 1: trip
+Font 0: trip scaled 2000
+
diff --git a/Build/source/texk/web2c/triptrap/trip1.in b/Build/source/texk/web2c/triptrap/trip1.in
new file mode 100644
index 00000000000..a93fd916c04
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trip1.in
@@ -0,0 +1,2 @@
+
+\input trip
diff --git a/Build/source/texk/web2c/triptrap/trip2.in b/Build/source/texk/web2c/triptrap/trip2.in
new file mode 100644
index 00000000000..205d5cd6504
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/trip2.in
@@ -0,0 +1 @@
+ &trip trip
diff --git a/Build/source/texk/web2c/triptrap/tripin.log b/Build/source/texk/web2c/triptrap/tripin.log
new file mode 100644
index 00000000000..0688b4eb919
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/tripin.log
@@ -0,0 +1,465 @@
+This is TeX, Version 3.141592 (INITEX) 20 DEC 2002 20:24
+**\input trip
+(trip.tex
+! Bad character code (256).
+<to be read again>
+ -
+l.26 \nonstopmode\lccode256-
+ 0\mathchardef\a="8000\def\a{ SC...
+A character number must be between 0 and 255.
+I changed this one to zero.
+
+! Bad mathchar (32768).
+<to be read again>
+ \def
+l.26 ...\mathchardef\a="8000\def
+ \a{ SCALED 3~2769}
+A mathchar number must be between 0 and 32767.
+I changed this one to zero.
+
+! Illegal magnification has been changed to 1000 (32769).
+<to be read again>
+ \skewchar
+l.28 \skewchar
+ \rip=`B \countdef\countz % \countz will be \c...
+The magnification ratio must be between 1 and 32768.
+
+! Missing number, treated as zero.
+<to be read again>
+ \def
+l.29 \def
+ \on{1} \toksdef\tokens=256 \show\errorstopmode
+A number should have been here; I inserted `0'.
+(If you can't figure out why I needed to see a number,
+look up `weird error' in the index to The TeXbook.)
+
+! Bad register code (256).
+l.29 ...{1} \toksdef\tokens=256
+ \show\errorstopmode
+A register number must be between 0 and 255.
+I changed this one to zero.
+
+> \errorstopmode=\errorstopmode.
+l.29 ...=256 \show\errorstopmode
+
+
+> \rip .
+<recently read> \font
+
+l.30 \showthe\font
+ \showthe\pageshrink \showthe\pagegoal
+
+> 0.0pt.
+l.30 ...font \showthe\pageshrink
+ \showthe\pagegoal
+
+> 16383.99998pt.
+l.30 ...shrink \showthe\pagegoal
+
+
+! Illegal unit of measure (replaced by filll).
+l.32 ...fdim\hsize<\hsize\fi lll
+ minus 0 fill
+I dddon't go any higher than filll.
+
+\one \csname on line 60
+! You can't use `\badness' in vertical mode.
+l.61 ...yphenpenalty 89 \badness
+
+Sorry, but I'm not programmed to handle this case;
+I'll just pretend that you didn't ask for it.
+If you're in the wrong mode, you might be able to
+return to the right one by typing `I}' or `I$' or `I\par'.
+
+! Bad \patterns.
+l.75 ...uage256\patterns{0111 \?
+ 50AA1b3 *1AcA. bb bb1 0B2B0 b...
+(See Appendix H.)
+
+! Nonletter.
+l.75 ...ge256\patterns{0111 \?50
+ AA1b3 *1AcA. bb bb1 0B2B0 b1c...
+(See Appendix H.)
+
+! Duplicate pattern.
+l.75 ...1b3 *1AcA. bb bb1 0B2B0
+ b1c}} % *==space
+(See Appendix H.)
+
+Missing character: There is no Z in font trip!
+
+### horizontal mode entered at line 77 (language255:hyphenmin1,63)
+\hbox(0.0+0.0)x0.0
+\glue -9.0
+\rip A (ligature 7A)
+\setlanguage98 (hyphenmin 1,1)
+\rip 5 (ligature |1)
+\rip 7 (ligature )
+\rip 6 (ligature )
+\rip 7 (ligature )
+\kern-2.00002
+\rip 1
+\rip 7 (ligature |)
+\glue 4.0 plus 1.99799 minus 1.00099
+\rip 5 (ligature |1)
+\rip 7 (ligature )
+\rip 6 (ligature )
+\rip 7 (ligature )
+\kern-2.00002
+\rip 1
+\glue 4.0 plus 2.0 minus 1.0
+\setlanguage255 (hyphenmin 1,1)
+\rip 5 (ligature |1)
+\rip 5 (ligature |1)
+\rip t (ligature pt)
+\kern3.0
+\rip s
+\glue 4.0 plus 2.0 minus 1.0
+\kern-1.00002
+\rip - (ligature -
+)
+\rip p (ligature q)
+\rip t (ligature )
+\rip s (ligature )
+\rip q (ligature )
+\rip t (ligature )
+\kern3.0
+\rip q (ligature )
+\rip p (ligature )
+\rip r (ligature q|)
+\glue 4.0 plus 2.0 minus 1.0
+spacefactor 1000, current language 255
+### internal vertical mode entered at line 77
+prevdepth ignored
+### internal vertical mode entered at line 77
+\glue(\tabskip) 0.0
+prevdepth 0.0
+### restricted horizontal mode entered at line 76
+spacefactor 1000
+### restricted horizontal mode entered at line 76
+spacefactor 1000
+### vertical mode entered at line 0
+prevdepth ignored
+
+! OK.
+l.78 ...ns{q9q} -\0qq \showlists
+ {\language\?\noboundary111}%
+
+[]
+@ via @@0 b=0 p=0 d=0
+@@1: line 1.2 t=0 -> @@0
+\rip 7A[]1-1
+@\discretionary via @@0 b=10000 p=88 d=100007744
+@@2: line 1.0- t=100007744 -> @@0
+@\discretionary via @@1 b=10000 p=88 d=100007744
+@@3: line 2.0- t=100007744 -> @@1
+
+@ via @@0 b=10000 p=0 d=100000000
+@@4: line 1.0 t=100000000 -> @@0
+@ via @@2 b=0 p=0 d=0
+@ via @@1 b=10000 p=0 d=100000000
+@@5: line 2.0 t=100000000 -> @@1
+@ via @@3 b=0 p=0 d=0
+@@6: line 3.2 t=100007744 -> @@3
+1-1
+@\discretionary via @@0 b=10000 p=88 d=100007744
+@@7: line 1.0- t=100007744 -> @@0
+@\discretionary via @@4 b=10000 p=88 d=100007744
+@\discretionary via @@2 b=12 p=88 d=8888
+@\discretionary via @@1 b=12 p=88 d=7888
+@@8: line 2.2- t=7888 -> @@1
+@\discretionary via @@5 b=10000 p=88 d=100007744
+@\discretionary via @@3 b=12 p=88 d=8888
+@@9: line 3.2- t=100016632 -> @@3
+@\discretionary via @@6 b=10000 p=88 d=100007744
+@@10: line 4.0- t=200015488 -> @@6
+
+@ via @@0 b=4291 p=0 d=18412681
+@@11: line 1.0 t=18412681 -> @@0
+@ via @@7 b=0 p=0 d=0
+@ via @@4 b=10000 p=0 d=100000000
+@@12: line 2.2 t=100007744 -> @@7
+@ via @@8 b=0 p=0 d=0
+@ via @@5 b=10000 p=0 d=100000000
+@@13: line 3.2 t=7888 -> @@8
+@ via @@9 b=0 p=0 d=0
+@ via @@6 b=10000 p=0 d=100000000
+@@14: line 4.2 t=100016632 -> @@9
+@ via @@10 b=0 p=0 d=0
+@@15: line 5.2 t=200015488 -> @@10
+[]11-
+@\discretionary via @@0 b=195 p=88 d=45769
+@@16: line 1.0- t=45769 -> @@0
+@\discretionary via @@11 b=10000 p=88 d=100007744
+@\discretionary via @@4 b=0 p=88 d=7744
+@@17: line 2.2- t=100007744 -> @@4
+@\discretionary via @@12 b=10000 p=88 d=100007744
+@\discretionary via @@5 b=0 p=88 d=7744
+@@18: line 3.2- t=100007744 -> @@5
+@\discretionary via @@13 b=10000 p=88 d=100007744
+@\discretionary via @@6 b=0 p=88 d=7744
+@@19: line 4.2- t=100015488 -> @@6
+@\discretionary via @@14 b=10000 p=88 d=100007744
+@@20: line 5.0- t=200024376 -> @@14
+@\discretionary via @@15 b=10000 p=88 d=100007744
+@@21: line 6.0- t=300023232 -> @@15
+pts
+@ via @@0 b=12 p=0 d=144
+@@22: line 1.2 t=144 -> @@0
+-
+q-q
+@\discretionary via @@0 b=336 p=88 d=120640
+@@23: line 1.0- t=120640 -> @@0
+@\discretionary via @@22 b=10000 p=88 d=100007744
+@@24: line 2.0- t=100007888 -> @@22
+
+@ via @@0 b=0 p=0 d=0
+@@25: line 1.2 t=0 -> @@0
+@ via @@23 b=0 p=0 d=0
+@ via @@22 b=10000 p=0 d=100000000
+@@26: line 2.2 t=120640 -> @@23
+@ via @@24 b=0 p=0 d=0
+@@27: line 3.2 t=100007888 -> @@24
+[]11-1
+@\discretionary via @@0 b=42 p=88 d=9508
+@@28: line 1.1- t=9508 -> @@0
+@\discretionary via @@25 b=10000 p=88 d=100007744
+@\discretionary via @@23 b=1558 p=88 d=2436108
+@\discretionary via @@22 b=6396 p=88 d=40916560
+@@29: line 2.0- t=2556748 -> @@23
+@\discretionary via @@26 b=10000 p=88 d=100007744
+@\discretionary via @@24 b=1558 p=88 d=2436108
+@@30: line 3.0- t=100128384 -> @@26
+@\discretionary via @@27 b=10000 p=88 d=100007744
+@@31: line 4.0- t=200015632 -> @@27
+@\par via @@0 b=0 p=-10000 d=0
+@@32: line 1.2- t=0 -> @@0
+@\par via @@28 b=0 p=-10000 d=100000
+@\par via @@25 b=10000 p=-10000 d=100000000
+@\par via @@23 b=0 p=-10000 d=100000
+@\par via @@22 b=336 p=-10000 d=112896
+@@33: line 2.2- t=109508 -> @@28
+@\par via @@29 b=0 p=-10000 d=100000
+@\par via @@26 b=10000 p=-10000 d=100000000
+@\par via @@24 b=0 p=-10000 d=100000
+@@34: line 3.2- t=2656748 -> @@29
+@\par via @@30 b=0 p=-10000 d=100000
+@\par via @@27 b=10000 p=-10000 d=100000000
+@@35: line 4.2- t=100228384 -> @@30
+@\par via @@31 b=0 p=-10000 d=100000
+@@36: line 5.2- t=200115632 -> @@31
+@emergencypass
+[]
+@ via @@0 b=0 p=0 d=0
+@@1: line 1.2 t=0 -> @@0
+\rip 7A[]1-1
+@\discretionary via @@0 b=237 p=88 d=63913
+@@2: line 1.0- t=63913 -> @@0
+@\discretionary via @@1 b=4 p=88 d=7760
+@@3: line 2.2- t=7760 -> @@1
+
+@ via @@0 b=100 p=0 d=10000
+@@4: line 1.0 t=10000 -> @@0
+@ via @@2 b=0 p=0 d=0
+@ via @@1 b=0 p=0 d=0
+@@5: line 2.2 t=0 -> @@1
+@ via @@3 b=0 p=0 d=0
+@@6: line 3.2 t=7760 -> @@3
+1-1
+@\discretionary via @@0 b=75 p=88 d=13369
+@@7: line 1.1- t=13369 -> @@0
+@\discretionary via @@4 b=17 p=88 d=8033
+@\discretionary via @@2 b=0 p=88 d=8744
+@\discretionary via @@1 b=0 p=88 d=7744
+@@8: line 2.2- t=7744 -> @@1
+@\discretionary via @@5 b=17 p=88 d=8033
+@\discretionary via @@3 b=0 p=88 d=8744
+@@9: line 3.1- t=8033 -> @@5
+@\discretionary via @@6 b=17 p=88 d=8033
+@@10: line 4.1- t=15793 -> @@6
+
+@ via @@0 b=26 p=0 d=676
+@@11: line 1.1 t=676 -> @@0
+@ via @@7 b=0 p=0 d=0
+@ via @@4 b=1 p=0 d=1
+@@12: line 2.2 t=10001 -> @@4
+@ via @@8 b=0 p=0 d=0
+@ via @@5 b=1 p=0 d=1
+@@13: line 3.2 t=1 -> @@5
+@ via @@9 b=0 p=0 d=0
+@ via @@6 b=1 p=0 d=1
+@@14: line 4.2 t=7761 -> @@6
+@ via @@10 b=0 p=0 d=0
+@@15: line 5.2 t=15793 -> @@10
+[]11-
+@\discretionary via @@0 b=6 p=88 d=7780
+@@16: line 1.2- t=7780 -> @@0
+@\discretionary via @@11 b=1 p=88 d=7745
+@\discretionary via @@4 b=0 p=88 d=7744
+@@17: line 2.2- t=8421 -> @@11
+@\discretionary via @@12 b=1 p=88 d=7745
+@\discretionary via @@5 b=0 p=88 d=7744
+@@18: line 3.2- t=7744 -> @@5
+@\discretionary via @@13 b=1 p=88 d=7745
+@\discretionary via @@6 b=0 p=88 d=7744
+@@19: line 4.2- t=7746 -> @@13
+@\discretionary via @@14 b=1 p=88 d=7745
+@@20: line 5.2- t=15506 -> @@14
+@\discretionary via @@15 b=1 p=88 d=7745
+@@21: line 6.2- t=23538 -> @@15
+pts
+@ via @@0 b=0 p=0 d=0
+@@22: line 1.2 t=0 -> @@0
+-
+q-q
+@\discretionary via @@0 b=22 p=88 d=8228
+@@23: line 1.1- t=8228 -> @@0
+@\discretionary via @@22 b=182 p=88 d=40868
+@@24: line 2.0- t=40868 -> @@22
+
+@ via @@0 b=0 p=0 d=0
+@@25: line 1.2 t=0 -> @@0
+@ via @@23 b=0 p=0 d=0
+@ via @@22 b=4 p=0 d=16
+@@26: line 2.2 t=16 -> @@22
+@ via @@24 b=0 p=0 d=0
+@@27: line 3.2 t=40868 -> @@24
+[]11-1
+@\discretionary via @@0 b=4 p=88 d=7760
+@@28: line 1.2- t=7760 -> @@0
+@\discretionary via @@25 b=100 p=88 d=17744
+@\discretionary via @@23 b=9 p=88 d=8825
+@\discretionary via @@22 b=38 p=88 d=9188
+@@29: line 2.1- t=9188 -> @@22
+@\discretionary via @@26 b=100 p=88 d=17744
+@\discretionary via @@24 b=9 p=88 d=8825
+@@30: line 3.0- t=17760 -> @@26
+@\discretionary via @@27 b=100 p=88 d=17744
+@@31: line 4.0- t=58612 -> @@27
+@\par via @@0 b=0 p=-10000 d=0
+@@32: line 1.2- t=0 -> @@0
+@\par via @@28 b=0 p=-10000 d=100000
+@\par via @@25 b=9 p=-10000 d=81
+@\par via @@23 b=0 p=-10000 d=100000
+@\par via @@22 b=2 p=-10000 d=4
+@@33: line 2.2- t=4 -> @@22
+@\par via @@29 b=0 p=-10000 d=100000
+@\par via @@26 b=9 p=-10000 d=81
+@\par via @@24 b=0 p=-10000 d=100000
+@@34: line 3.2- t=97 -> @@26
+@\par via @@30 b=0 p=-10000 d=100000
+@\par via @@27 b=9 p=-10000 d=81
+@@35: line 4.2- t=40949 -> @@27
+@\par via @@31 b=0 p=-10000 d=100000
+@@36: line 5.2- t=158612 -> @@31
+
+! Too late for \patterns.
+l.79 ...har\rip=`-\cr}}\patterns
+ {toolate}\showbox0}
+All patterns must be given before typesetting begins.
+
+> \box0=
+\hbox(8.0+0.0)x0.0
+.\vbox(8.0+0.0)x0.0
+..\glue(\tabskip) 0.0
+..\vbox(8.0+0.0)x0.0
+...\hbox(7.0+1.0)x0.0, glue set 0.12505
+....\hbox(0.0+0.0)x0.0
+....\glue -9.0
+....\rip A (ligature 7A)
+....\setlanguage98 (hyphenmin 1,1)
+....\discretionary replacing 7
+.....\rip 5 (ligature |1)
+.....\rip -
+....|\rip 5 (ligature |1)
+....|\rip 7 (ligature |)
+....\rip 5 (ligature |1)
+....\rip 7 (ligature )
+....\rip 6 (ligature )
+....\rip 7 (ligature )
+....\kern-2.00002
+....\rip 1
+....\rip 7 (ligature |)
+....\glue 4.0 plus 1.99799 minus 1.00099
+....\discretionary replacing 6
+.....\rip 5 (ligature |1)
+.....\rip -
+....|\rip 5 (ligature |1)
+....\rip 5 (ligature |1)
+....\rip 7 (ligature )
+....\rip 6 (ligature )
+....\rip 7 (ligature )
+....\kern-2.00002
+....\rip 1
+....\glue 4.0 plus 2.0 minus 1.0
+....\setlanguage255 (hyphenmin 1,1)
+....\rip 5 (ligature |1)
+....\rip 7 (ligature )
+....\rip 6 (ligature )
+....\rip 7 (ligature )
+....\kern-2.00002
+....\discretionary replacing 1
+.....\rip 1
+.....\rip 1 (ligature -)
+.....\rip 7 (ligature |)
+....\rip 1
+....\rip t (ligature pt)
+....\kern3.0
+....\rip s
+....\glue 4.0 plus 2.0 minus 1.0
+....\kern-1.00002
+....\discretionary replacing 10
+.....\rip - (ligature -
+)
+.....\rip p (ligature q)
+.....\rip -
+....|\rip q (ligature |)
+....|\rip q
+....\rip - (ligature -
+)
+....\rip p (ligature q)
+....\rip t (ligature )
+....\rip s (ligature )
+....\rip q (ligature )
+....\rip t (ligature )
+....\kern3.0
+....\rip q (ligature )
+....\rip p (ligature )
+....\rip r (ligature q|)
+....\glue 4.0 plus 2.0 minus 1.0
+....\setlanguage98 (hyphenmin 1,1)
+....\rip 1
+....\rip 7 (ligature )
+....\rip 6 (ligature )
+....\rip 7 (ligature )
+....\rip 5 (ligature )
+....\rip 7 (ligature )
+....\rip 6 (ligature )
+....\rip 7 (ligature )
+....etc.
+..\glue(\tabskip) 0.0
+
+! OK.
+<to be read again>
+ }
+l.79 ...terns{toolate}\showbox0}
+
+
+ )
+Beginning to dump on file trip.fmt
+ (preloaded format=trip 2002.12.20)
+1320 strings of total length 23539
+471 memory locations dumped; current usage is 96&278
+341 multiletter control sequences
+\font\nullfont=nullfont
+\font\rip=trip
+\font\smalltrip=trip at 5.0pt
+\font\bigtr
+p=trip at 20.0pt
+2279 words of font info for 3 preloaded fonts
+1 hyphenation exception
+Hyphenation trie of length 273 has 9 ops out of 500
+ 2 for language 255
+ 1 for language 98
+ 6 for language 0
+No pages of output.
diff --git a/Build/source/texk/web2c/triptrap/tripman.tex b/Build/source/texk/web2c/triptrap/tripman.tex
new file mode 100644
index 00000000000..7634c8c9e78
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/tripman.tex
@@ -0,0 +1,413 @@
+% The TRIP manual: How to validate TeX --- last updated by D E Knuth on 4 Dec 89
+\font\eighttt= cmtt8
+\font\eightrm= cmr8
+\font\titlefont= cmr7 scaled\magstep5
+\let\mc=\eightrm
+\rm
+\let\mainfont=\tenrm
+
+\def\.#1{\hbox{\tt#1}}
+\def\\#1{\hbox{\it#1\/\hskip.05em}} % italic type for identifiers
+
+\parskip 2pt plus 1pt
+\baselineskip 12pt plus .25pt
+
+\def\verbatim#1{\begingroup \frenchspacing
+ \def\do##1{\catcode`##1=12 } \dospecials
+ \parskip 0pt \parindent 0pt
+ \catcode`\ =\active \catcode`\^^M=\active
+ \tt \def\par{\ \endgraf} \obeylines \obeyspaces
+ \input #1 \endgroup}
+% a blank line will be typeset at the end of the file;
+% if you're unlucky it will appear on a page by itself!
+{\obeyspaces\global\let =\ }
+
+\output{\shipout\box255\global\advance\pageno by 1} % for the title page only
+\null
+\vfill
+\centerline{\titlefont A torture test for \TeX}
+\vskip 18pt
+\centerline{by Donald E. Knuth}
+\centerline{Stanford University}
+\vskip 6pt
+\centerline{({\sl Version 3, January 1990\/})}
+\vfill
+\centerline{\vbox{\hsize 4in
+\noindent Programs that claim to be implementations of \TeX82 are
+supposed to be able to process the test routine contained in this
+report, producing the outputs contained in this report.}}
+\vskip 24pt
+{\baselineskip 9pt
+\eightrm\noindent
+The preparation of this report was supported in part by the National Science
+Foundation under grants IST-8201926 and MCS-8300984,
+and by the System Development Foundation.
+`\TeX' is a trademark of the American Mathematical Society.
+
+}\pageno=0\eject
+
+\output{\shipout\vbox{ % for subsequent pages
+ \baselineskip0pt\lineskip0pt
+ \hbox to\hsize{\strut
+ \ifodd\pageno \hfil\eightrm\firstmark\hfil
+ \mainfont\the\pageno
+ \else\mainfont\the\pageno\hfil
+ \eightrm\firstmark\hfil\fi}
+ \vskip 10pt
+ \box255}
+ \global\advance\pageno by 1}
+\let\runninghead=\mark
+\outer\def\section#1.{\noindent{\bf#1.}\quad
+ \runninghead{\uppercase{#1} }\ignorespaces}
+
+\section Introduction.
+People often think that their programs are ``debugged'' when large applications
+have been run successfully. But system programmers know that a typical large
+application tends to use at most about 50 per cent of the instructions
+in a typical compiler. Although the other half of the code---which tends
+to be the ``harder half''---might be riddled with errors, the system seems
+to be working quite impressively until an unusual case shows up on the
+next day. And on the following day another error manifests itself, and so on;
+months or years go by before certain parts of the compiler are even
+activated, much less tested in combination with other portions of the system,
+if user applications provide the only tests.
+
+How then shall we go about testing a compiler? Ideally we would like to
+have a formal proof of correctness, certified by a computer.
+This would give us a lot of confidence,
+although of course the formal verification program might itself be incorrect.
+A more serious drawback of automatic verification is that the formal
+specifications of the compiler are likely to be wrong, since they aren't
+much easier to write than the compiler itself. Alternatively, we can
+substitute an informal proof of correctness: The programmer writes his or
+her code in a structured manner and checks that appropriate relations
+remain invariant, etc. This helps greatly to reduce errors, but it cannot
+be expected to remove them completely; the task of checking a large
+system is sufficiently formidable that human beings cannot do it without
+making at least a few slips here and there.
+
+Thus, we have seen that test programs are unsatisfactory if they are simply
+large user applications; yet some sort of test program is needed because
+proofs of correctness aren't adequate either. People have proposed schemes
+for constructing test data automatically from a program text, but such
+approaches run the risk of circularity, since they cannot assume that a
+given program has the right structure.
+
+I have been having good luck with a somewhat different approach,
+first used in 1960 to debug an {\mc ALGOL} compiler. The idea is to
+construct a test file that is about as different from a typical user
+application as could be imagined. Instead of testing things that people
+normally want to do, the file tests complicated things that people would
+never dare to think of, and it embeds these complexities in still
+more arcane constructions. Instead of trying to make the compiler do the
+right thing, the goal is to make it fail (until the bugs have all been found).
+
+To write such a fiendish test routine, one simply gets into a nasty frame
+of mind and tries to do everything in the unexpected way. Parameters
+that are normally positive are set negative or zero; borderline cases
+are pushed to the limit; deliberate errors are made in hopes that the
+compiler will not be able to recover properly from them.
+
+A user's application tends to exercise 50\%\ of a compiler's logic,
+but my first fiendish tests tend to improve this to about 90\%. As the
+next step I generally make use of frequency-counting software to identify
+the instructions that have still not been called upon. Then I add ever more
+fiendishness to the test routine, until more than 99\%\ of the code
+has been used at least once. (The remaining bits are things that
+can occur only if the source program is really huge, or if certain
+fatal errors are detected; or they are cases so similar to other well-tested
+things that there can be little doubt of their validity.)
+
+Of course, this is not guaranteed to work. But my experience in 1960 was
+that only two bugs were ever found in that {\mc ALGOL} compiler after it
+correctly translated that original fiendish test. And one of those bugs
+was actually present in the results of the test; I simply had failed to
+notice that the output was incorrect. Similar experiences occurred later
+during the 60s and 70s, with respect to a few assemblers, compilers,
+and simulators that I wrote.
+
+This method of debugging, combined with the methodology of structured
+programming and informal proofs (otherwise known as careful desk checking),
+leads to greater reliability of production software than any other
+method I know. Therefore I have used it in developing \TeX82, and the
+main bulk of this report is simply a presentation of the test program
+that was used to get the bugs out of \TeX.
+
+Such a test file is useful also after a program has been debugged, since
+it can be used to give some assurance that subsequent modifications don't
+mess things up.
+
+The test file is called \.{TRIP.TEX}, because of my warped sense of humor:
+\TeX\ is pronounced ``techhh'', so the name reminded me of a
+triptych (and besides, I wanted to take a trip through the program while
+tripping it up, etc.).
+
+The contents of this test file are so remote from what people actually
+do with \TeX, I feel apologetic if I have to explain the correct
+translation of \.{TRIP.TEX}; nobody really cares about most of the
+nitty-gritty rules that are involved. Yet I believe \.{TRIP} exemplifies
+the sort of test program that has outstanding diagnostic ability, as
+explained above.
+
+If somebody claims to have a correct implementation of \TeX, I will not
+believe it until I see that \.{TRIP.TEX} is translated properly.
+I propose, in fact, that a program must meet two criteria before it
+can justifiably be called \TeX: (1)~The person who wrote it must be
+happy with the way it works at his or her installation; and (2)~the
+program must produce the correct results from \.{TRIP.TEX}.
+
+\TeX\ is in the public domain, and its algorithms are published;
+I've done this since I do not want to discourage its use by placing
+proprietary restrictions on the software. However, I don't want
+faulty imitations to masquerade as \TeX\ processors, since users
+want \TeX\ to produce identical results on different machines.
+Hence I am planning to do whatever I can to suppress any systems that
+call themselves \TeX\ without meeting conditions (1) and~(2).
+I have copyrighted the programs so that I have some chance to forbid
+unauthorized copies; I explicitly authorize copying of correct
+\TeX\ implementations, and not of incorrect ones!
+
+The remainder of this report consists of appendices, whose contents ought
+to be described briefly here:
+
+Appendix A explains in detail how to carry out a test of \TeX, given
+a tape that contains copies of the other appendices.
+
+Appendix B is \.{TRIP.TEX}, the fiendish test file that has already
+been mentioned. People who think that they understand \TeX\ are challenged
+to see if they know what \TeX\ is supposed to do with this file.
+People who know only a little about \TeX\ might still find it
+interesting to study Appendix~B, just to get some insights into the
+methodology advocated here.
+
+Appendix C is \.{TRIP.PL}, the property-list description of a
+special font called \.{trip}. This is the only font used by \.{TRIP.TEX}.
+There are no graphic characters associated with \.{trip} that could
+possibly be printed; indeed, \.{TRIP.PL} describes the properties of a font
+that is as weird as the ``document'' described by \.{TRIP.TEX}.
+
+Appendix D is \.{TRIPIN.LOG}, a correct transcript file \.{TRIP.LOG}
+that results if \.{INITEX} is applied to \.{TRIP.TEX}. (\.{INITEX} is
+the name of a version of \TeX\ that does certain initializations;
+this run of \.{INITEX} also creates a binary format file called \.{TRIP.FMT}.)
+
+Appendix E is a correct transcript file \.{TRIP.LOG} that results if
+\.{INITEX} or any other version of \TeX\ is applied to \.{TRIP.TEX}
+with format \.{TRIP.FMT}.
+
+Appendix F is \.{TRIP.TYP}, the symbolic version of a correct output
+file \.{TRIP.DVI} that was produced at the same time as the \.{TRIP.LOG}
+file of Appendix~E.
+
+Appendix G is \.{TRIPOS.TEX}, a short file written out and read in
+by \TeX\ when it processes \.{TRIP.TEX}.
+
+Appendix H is \.{TRIP.FOT}, an abbreviated version of Appendix E that
+appears on the user's terminal during the run that produces \.{TRIP.LOG}
+and \.{TRIP.DVI}.
+
+The debugging of \TeX\ and the testing of the adequacy of \.{TRIP.TEX}
+could not have been done nearly as well as reported here except for
+the magnificent software support provided by my colleague David R. Fuchs.
+In particular, he extended our local Pascal compiler so that
+frequency counting and a number of other important features were added
+to its online debugging abilities.
+
+The method of testing advocated here has one chief difficulty that deserves
+comment: I had to verify by hand that \TeX\ did the right things
+to \.{TRIP.TEX}. This took many hours, and perhaps I have missed
+something (as I did in 1960); I must confess that I have not checked
+every single number in Appendices E and~F. However, I'm willing to pay
+\$327.68 to the first finder of any remaining bug in \TeX, and I will
+be surprised if that bug doesn't show up also in Appendix~E. (I plan to
+write a technical report about all of the errors ultimately found in \TeX; that
+report will tell whether any bugs are discovered between now and~then!)
+
+\vfill\eject
+
+\section Appendix A: How to test \TeX.
+
+\item{0.} Let's assume that you have a tape containing \.{TRIP.TEX},
+\.{TRIP.PL}, \.{TRIPIN.LOG}, \.{TRIP.LOG}, \.{TRIP.TYP}, and \.{TRIP.FOT},
+as in Appendices B, C, D, E, F, and~G. Furthermore, let's suppose that you
+have a working \.{WEB} system, and that you have working programs \.{TFtoPL},
+\.{PLtoTF}, \.{DVItype}, as described in the \TeX ware report.
+
+\item{1.} Use \.{PLtoTF} to convert \.{TRIP.PL} into \.{TRIP.TFM}.
+Then use \.{TFtoPL} to convert \.{TRIP.TFM} into \.{TMP.PL}. Check that
+\.{TMP.PL} is identical to \.{TRIP.PL} (this is a partial test of \.{PLtoTF}
+and \.{TFtoPL}). Install \.{TRIP.TFM} in the standard file area for
+\TeX\ font metric files.
+
+\item{2.} Prepare a special version of \.{INITEX}. (This means that your \.{WEB}
+change file should have {\bf init} and {\bf tini} defined to be null.)
+The {\bf stat} and {\bf tats} macros should also be null, so that
+statistics are kept and other special features are enabled. Set
+\\{mem\_min} and \\{mem\_bot} equal to~1, and set \\{mem\_top} and
+\\{mem\_max} equal to~3000, for purposes of this test version. Also set
+$\\{error\_line}=64$, $\\{half\_error\_line}=32$, and
+$\\{max\_print\_line}=72$; these parameters affect many of the lines of
+the test output, so your job will be much easier if you use the same
+settings that were used to produce Appendix~E. You probably should also
+use the ``normal'' settings of other parameters found in \.{TEX.WEB}
+(e.g., $\\{stack\_size}=200$, $\\{font\_max}=75$, etc.), since these show
+up in a few lines of the test output. Your test version should not
+change the default definition of unprintable characters (\S49 of the program).
+
+\item{3.} Run the \.{INITEX} prepared in step 2. In response to the first
+`\.{**}' prompt, type carriage return (thus getting another `\.{**}').
+Then type `\.{\char`\\input trip}'. You should get an output that matches
+the file \.{TRIPIN.LOG} (Appendix~D). Don't be alarmed by the error
+messages that you see, unless they are different from those in Appendix~D.
+
+\def\sp{{\char'40}}
+\item{4.} Run \.{INITEX} again. This time type `\.{\sp\&trip\sp\sp trip\sp}'.
+(The spaces in this input help to check certain parts of \TeX\ that
+aren't otherwise used.) You should get outputs \.{TRIP.LOG}, \.{TRIP.DVI},
+and \.{TRIPOS.TEX}; there will also be an empty file \.{8TERMINAL.TEX}.
+Furthermore, your terminal should receive output that matches \.{TRIP.FOT}
+(Appendix~H). During the middle part of this test, however, the terminal
+will not be getting output, because \.{\char'134batchmode} is being
+tested; don't worry if nothing seems to be happening for a while---nothing
+is supposed to.
+
+\item{5.} Compare the \.{TRIP.LOG} file from step 4 with the ``master''
+\.{TRIP.LOG} file of step~0. (Let's hope you put that master file in a
+safe place so that it wouldn't be clobbered.) There should be perfect
+agreement between these files except in the following respects:
+
+\itemitem{a)} The dates and possibly the file names will
+naturally be different.
+
+\itemitem{b)} Glue settings in the displays of \TeX\ boxes are subject
+to system-dependent rounding, so slight deviations are permissible. However,
+such deviations apply only to the `\.{glue set}' values that appear at the
+end of an \.{\char'134hbox} or \.{\char'134vbox} line;
+all other numbers should agree exactly, since they are computed with
+integer arithmetic in a prescribed system-independent manner.
+
+\itemitem{c)} The amount of space in kerns that are marked ``for accent''
+are, similarly, subject to system-dependent rounding.
+
+\itemitem{d)} If you had different values for \\{stack\_size}, \\{buf\_size},
+etc., the corresponding capacity values will be different when they
+are printed out at the end.
+
+\itemitem{e)} Help messages may be different; indeed, the author encourages
+non-English help messages in versions of \TeX\ for people who don't
+understand English as well as some other language.
+
+\itemitem{f)} The total number and length of strings at the end may well
+be different.
+
+\itemitem{g)} If your \TeX\ uses a different memory allocation or
+packing scheme or \.{DVI} output logic, the memory usage statistics may change.
+
+\item{6.} Use \.{DVItype} to convert your file \.{TRIP.DVI} to a file
+\.{TRIP.TYP}. The following options should be set when using \.{DVItype}:
+$$\vbox{\halign{#\hfil&\hfil#\cr
+Output level = 2\cr
+Starting page = \.{*.*.*.*.*.*.*.*.*.*}\hskip-20pt\cr
+Number of pages = 1000000&(this is the default)\cr
+Resolution = 7227/100&(this is one point per pixel)\cr
+New magnification = 0&(this is the default)\cr}}$$
+The resulting file should agree with the master \.{TRIP.TYP} file of step~0,
+except that some of the values might be a little off due to floating-point
+rounding discrepancies. Furthermore there may be differences between
+`\\{right}' and `\\w' and `\\x' commands, and between `\\{down}' and `\\y'
+and `\\z'; the key thing is that all characters and rules and \\{xxx}'s should
+be in almost the same positions as specified in Appendix~F.
+(If your \.{DVI}-writing routines differ substantially from those in
+\.{TEX.WEB}, you may want to write a \.{DVIcompare} program that
+detects any substantive differences between two given \.{DVI} files. Such
+a routine would be of general use besides.
+On the other hand, if you have set \\{dvi\_buf\_size} to 800, then your
+\.{DVI} file should be virtually identical to the one supplied.)
+
+\item{7.} You might also wish to test \.{TRIP} with other versions of
+\TeX\ (i.e., \.{VIRTEX} or a production version with other fonts and
+macros preloaded). It should work unless \TeX's primitives have been
+redefined. However, this step isn't essential, since all the code of
+\.{VIRTEX} appears in \.{INITEX}; you probably won't catch any more errors
+this way, unless they would already become obvious from normal use of
+the~system.
+
+\vfill\eject
+
+\section Appendix B: The \.{TRIP.TEX} file.
+The contents of the test routine are prefixed here with line numbers, for
+ease in comparing this file with the error messages printed later; the
+line numbers aren't actually present.
+\runninghead{APPENDIX B: \.{TRIP.TEX} (CONTINUED)}
+
+\vskip 8pt
+\begingroup\count255=0
+\everypar{\global\advance\count255 by 1
+ \hbox to 20pt{\sevenrm\hfil\the\count255\ \ }}
+\verbatim{trip.tex}
+\endgroup
+\vfill\eject
+
+\section Appendix C: The \.{TRIP.PL} file.
+The ``font'' defined here has only a few characters, but they include all
+the complexities that \TeX\ must deal with: ligatures, kerns,
+lists of characters, and extensible characters. Some of the dimensions
+are negative, just to make things worse yet. (The format of property-list
+files like this is explained in the documentation to \.{PLtoTF}, in
+the \TeX ware report.)
+\runninghead{APPENDIX C: \.{TRIP.PL} (CONTINUED)}
+
+\vskip8pt
+\verbatim{trip.pl}
+\vfill\eject
+
+\section Appendix D: The \.{TRIPIN.LOG} file.
+When \.{INITEX} makes the \.{TRIP.FMT} file, it also creates a file called
+\.{TRIP.LOG} that looks like this.
+\runninghead{APPENDIX D: \.{TRIPIN.LOG} (CONTINUED)}
+
+\vskip8pt
+\verbatim{tripin.log}
+\vfill\eject
+
+\section Appendix E: The \.{TRIP.LOG} file.
+Here is the major output of the \.{TRIP} test; it is generated by running
+\.{INITEX} and loading \.{TRIP.FMT}, then reading \.{TRIP.TEX}.
+\runninghead{APPENDIX E: \.{TRIP.LOG} (CONTINUED)}
+
+{\let\tt=\eighttt\leftskip 1in\baselineskip 9pt plus .1pt minus .1pt
+\vskip8pt
+\verbatim{trip.log}
+}
+\vfill\eject
+
+\section Appendix F: The \.{TRIP.TYP} file.
+Here is another major component of the test. It shows the output of \.{DVItype}
+applied to the file \.{TRIP.DVI} that was created at the same time
+Appendix E was produced.
+\runninghead{APPENDIX F: \.{TRIP.TYP} (CONTINUED)}
+
+{\let\tt=\eighttt\leftskip 1in\baselineskip 9pt plus .1pt minus .1pt
+\vskip8pt
+\verbatim{trip.typ}
+}
+\vfill\eject
+
+\section Appendix G: The \.{TRIPOS.TEX} file.
+This short file was written out once and read in twice, during the time
+Appendix E was being produced. There are only three lines, the first of
+which is blank.
+\runninghead{APPENDIX G: \.{TRIPOS.TEX} (CONTINUED)}
+
+\vskip8pt
+\verbatim{tripos.tex}
+\vfill\eject
+
+\section Appendix H: The \.{TRIP.FOT} file.
+This shows what appeared on the terminal while Appendix E was being produced.
+\runninghead{APPENDIX H: \.{TRIP.FOT} (CONTINUED)}
+
+\vskip8pt
+\verbatim{trip.fot}
+
+\vfill\end
diff --git a/Build/source/texk/web2c/triptrap/tripos.tex b/Build/source/texk/web2c/triptrap/tripos.tex
new file mode 100644
index 00000000000..a0e25a24d8e
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/tripos.tex
@@ -0,0 +1,3 @@
+
+\uppercase {0{\outputpenalty }}
+[\uppercase {mmmmmmmmmm}[
diff --git a/Build/source/texk/web2c/triptrap/writeo b/Build/source/texk/web2c/triptrap/writeo
new file mode 100644
index 00000000000..1e2617f7450
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/writeo
@@ -0,0 +1 @@
+Clobbered.
diff --git a/Build/source/texk/web2c/triptrap/writeo.2 b/Build/source/texk/web2c/triptrap/writeo.2
new file mode 100644
index 00000000000..e38139b2e83
--- /dev/null
+++ b/Build/source/texk/web2c/triptrap/writeo.2
@@ -0,0 +1,10 @@
+ *
+ *
+ *
+ *
+ *
+ *
+ *
+ *
+ *
+ *
diff --git a/Build/source/texk/web2c/vftovp.ch b/Build/source/texk/web2c/vftovp.ch
new file mode 100644
index 00000000000..fe7728b8887
--- /dev/null
+++ b/Build/source/texk/web2c/vftovp.ch
@@ -0,0 +1,654 @@
+% vftovp.ch for C compilation with web2c.
+% Written by kb@cs.umb.edu.
+% This file is in the public domain.
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{VF$\,$\lowercase{to}$\,$VP changes for C}
+@z
+
+@x [2] All terminal output goes to stderr, so we can dump the vpl on stdout.
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@y
+@d print(#)==write(stderr,#)
+@d print_ln(#)==write_ln(stderr,#)
+@z
+
+@x still [2] Set up for path reading.
+procedure initialize; {this procedure gets things started properly}
+ var @!k:integer; {all-purpose index for initialization}
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @!k:integer; {all-purpose index for initialization}
+ begin
+ kpse_set_progname (argv[0]);
+ kpse_init_prog ('VFTOVP', 0, nil, nil);
+ parse_arguments;
+@z
+
+% [4] No name_length.
+% Also, AIX defines `class' in <math.h>, so let's take this opportunity to
+% define that away.
+% And increase several constants.
+@x
+@<Constants...@>=
+@!tfm_size=30000; {maximum length of |tfm| data, in bytes}
+@!vf_size=10000; {maximum length of |vf| data, in bytes}
+@!max_fonts=300; {maximum number of local fonts in the |vf| file}
+@!lig_size=5000; {maximum length of |lig_kern| program, in words}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@!name_length=50; {a file name shouldn't be longer than this}
+@!max_stack=50; {maximum depth of \.{DVI} stack in character packets}
+@y
+@d class == class_var
+@<Constants...@>=
+@!tfm_size=150000; {maximum length of |tfm| data, in bytes}
+@!vf_size=100000; {maximum length of |vf| data, in bytes}
+@!max_fonts=300; {maximum number of local fonts in the |vf| file}
+@!lig_size=32510; {maximum length of |lig_kern| program, in words}
+@!hash_size=32579; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@!max_stack=100; {maximum depth of \.{DVI} stack in character packets}
+@z
+
+@x [11] Open the files.
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file); reset(vf_file);
+@y
+@ We don't have to do anything special to read a packed file of bytes,
+but we do want to use environment variables to find the input files.
+@^system dependencies@>
+
+@<Set init...@>=
+{See comments at |kpse_find_vf| in \.{kpathsea/tex-file.h} for why we
+ don't use it.}
+vf_file := kpse_open_file (vf_name, kpse_vf_format);
+tfm_file := kpse_open_file (tfm_name, kpse_tfm_format);
+
+if verbose then begin
+ print (banner);
+ print_ln (version_string);
+end;
+@z
+
+@x [21] Open VPL file.
+@ @<Set init...@>=
+rewrite(vpl_file);
+@y
+@ If an explicit filename isn't given, we write to |stdout|.
+
+@<Set init...@>=
+if optind + 3 > argc then begin
+ vpl_file := stdout;
+end else begin
+ vpl_name := extend_filename (cmdline (optind + 2), 'vpl');
+ rewrite (vpl_file, vpl_name);
+end;
+@z
+
+% [24] `index' is not a good choice of identifier in C.
+@x
+@<Types...@>=
+@!index=0..tfm_size; {address of a byte in |tfm|}
+@y
+@d index == index_type
+
+@<Types...@>=
+@!index=0..tfm_size; {address of a byte in |tfm|}
+@z
+
+% [24] abort() should cause a bad exit code.
+@x
+@d abort(#)==begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a TFM?');
+ goto final_end;
+ end
+@y
+@d abort(#)==begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a TFM?');
+ uexit(1);
+ end
+@z
+
+% [25] Both nl and lig_size are in words, so the multiplication is not
+% needed. Found by "C.M. Connelly" <c@eskimo.com> and
+% Melissa O'Neill <oneill@cs.sfu.ca>
+@x
+if nl>4*lig_size then
+@y
+if nl>lig_size then
+@z
+
+% [31] Ditto for vf_abort.
+@x
+@d vf_abort(#)==
+ begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a VF?');
+ goto final_end;
+ end
+@y
+@d vf_abort(#)==
+ begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a VF?');
+ uexit(1);
+ end
+@z
+
+@x [32] Be quiet if not -verbose.
+for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
+print_ln(' '); count:=0;
+@y
+if verbose then begin
+ for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
+ print_ln(' ');
+end;
+count:=0;
+@z
+
+@x [35] Be quiet if not -verbose.
+@<Print the name of the local font@>;
+@y
+if verbose then begin
+ @<Print the name of the local font@>;
+end;
+@z
+
+@x [36] Output of real numbers.
+print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2,
+ 'pt')
+@y
+print(' at ');
+print_real((((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize, 2, 2);
+print_ln('pt')
+@z
+
+@x [37] No arbitrary max on cur_name.
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+@!cur_name:^char; {external tfm name}
+@z
+
+@x [39] Open another TFM file.
+reset(tfm_file,cur_name);
+@^system dependencies@>
+if eof(tfm_file) then
+ print_ln('---not loaded, TFM file can''t be opened!')
+@.TFM file can\'t be opened@>
+else begin font_bc:=0; font_ec:=256; {will cause error if not modified soon}
+@y
+tfm_name := kpse_find_tfm (cur_name);
+if not tfm_name then
+ print_ln('---not loaded, TFM file ', stringcast(cur_name),
+ ' can''t be opened!')
+@.TFM file can\'t be opened@>
+else begin
+ resetbin (tfm_file, tfm_name);
+ font_bc:=0; font_ec:=256; {will cause error if not modified soon}
+@z
+
+@x [39] Better diagnostics.
+ if font_ec>255 then print_ln('---not loaded, bad TFM file!')
+@.bad TFM file@>
+@y
+ if font_ec>255 then
+ print_ln('---not loaded, bad TFM file ', stringcast(tfm_name), '!')
+@.bad TFM file@>
+@z
+
+@x [39] Better diagnostics.
+ print_ln('---trouble is brewing, TFM file ended too soon!');
+@.trouble is brewing...@>
+ end;
+@y
+ print_ln('---trouble is brewing, TFM file ', stringcast(tfm_name),
+ ' ended too soon!');
+@.trouble is brewing...@>
+ free(tfm_name);
+ end;
+free(cur_name);
+@z
+
+@x [40] Be quiet if not -verbose.
+ begin print_ln('Check sum in VF file being replaced by TFM check sum');
+@y
+ begin
+ if verbose then
+ print_ln('Check sum in VF file being replaced by TFM check sum');
+@z
+
+@x [42] Remove initialization of now-defunct array.
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+@y
+@ (No initialization to be done. Keep this module to preserve numbering.)
+@z
+
+@x [44] Don't append `.tfm' here, and keep lowercase.
+for k:=1 to name_length do cur_name[k]:=' ';
+if a=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_start[font_ptr]+14 to vf_ptr-1 do
+ begin incr(r);
+ if r+4>name_length then vf_abort('Font name too long for me!');
+@.Font name too long for me@>
+ if (vf[k]>="a")and(vf[k]<="z") then
+ cur_name[r]:=xchr[vf[k]-@'40]
+ else cur_name[r]:=xchr[vf[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+@y
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. We do not impose an arbitrary limit
+on the filename length.
+@^system dependencies@>
+
+@d name_start == (font_start[font_ptr] + 14)
+@d name_end == vf_ptr
+
+@<Move font name into the |cur_name| string@>=
+r := name_end - name_start;
+cur_name := xmalloc_array (char, r);
+{|strncpy| might be faster, but it's probably a good idea to keep the
+ |xchr| translation.}
+for k := name_start to name_end do begin
+ cur_name[k - name_start] := xchr[vf[k]];
+end;
+cur_name[r] := 0; {Append null byte since this is C.}
+@z
+
+@x [49] Change strings to C char pointers, so we can initialize them.
+@!ASCII_04,@!ASCII_10,@!ASCII_14: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!xchr:packed array [0..255] of char;
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+@y
+@!ASCII_04,@!ASCII_10,@!ASCII_14: c_string;
+ {strings for output in the user's external character set}
+@!xchr:packed array [0..255] of char;
+@!MBL_string,@!RI_string,@!RCE_string: c_string;
+ {handy string constants for |face| codes}
+@z
+
+@x [50] The Pascal strings are indexed starting at 1, so we pad with a blank.
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/
+@y
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~?';@/
+@z
+
+@x
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+@y
+MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE';
+@z
+
+% [60] How we output the character code depends on |charcode_format|.
+@x
+begin if font_type>vanilla then
+ begin tfm[0]:=c; out_octal(0,1)
+ end
+else if ((c>="0")and(c<="9"))or@|
+ ((c>="A")and(c<="Z"))or@|
+ ((c>="a")and(c<="z")) then out(' C ',xchr[c])
+else begin tfm[0]:=c; out_octal(0,1);
+ end;
+@y
+begin if (font_type > vanilla) or (charcode_format = charcode_octal) then
+ begin tfm[0]:=c; out_octal(0,1)
+ end
+else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~")
+ and (c <> "(") and (c <> ")") then
+ out(' C ', xchr[c])
+{default case, use \.C only for letters and digits}
+else if ((c>="0")and(c<="9"))or@|
+ ((c>="A")and(c<="Z"))or@|
+ ((c>="a")and(c<="z")) then out(' C ',xchr[c])
+else begin tfm[0]:=c; out_octal(0,1);
+ end;
+@z
+
+% [61] Don't output the face code as an integer.
+@x
+ out(MBL_string[1+(b mod 3)]);
+ out(RI_string[1+s]);
+ out(RCE_string[1+(b div 3)]);
+@y
+ put_byte(MBL_string[1+(b mod 3)], vpl_file);
+ put_byte(RI_string[1+s], vpl_file);
+ put_byte(RCE_string[1+(b div 3)], vpl_file);
+@z
+
+@x [62] Force 32-bit constant arithmetic for 16-bit machines.
+f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
+@y
+f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
+@z
+
+% [100] No progress reports unless verbose.
+@x
+ incr(chars_on_line);
+ end;
+ print_octal(c); {progress report}
+@y
+ if verbose then incr(chars_on_line); {keep |chars_on_line = 0|}
+ end;
+ if verbose then print_octal(c); {progress report}
+@z
+
+% [112] No nonlocal goto's.
+@x
+ begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ goto final_end;
+@y
+ begin
+ print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ uexit(1);
+@z
+
+% still [112] We can't have a function named `f', because of the local
+% variable in do_simple_things. It would be better, but harder, to fix
+% web2c.
+@x
+ r:=f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);
+@y
+ r:=lig_f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);
+@z
+
+@x
+ out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
+@y
+ out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); uexit(1);
+@z
+
+% [116] web2c can't handle these mutually recursive procedures.
+% But let's do a fake definition of f here, so that it gets into web2c's
+% symbol table...
+@x
+@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+@y
+@p
+ifdef('notdef')
+function lig_f(@!h,@!x,@!y:index):index; begin end;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+endif('notdef')
+@z
+
+@x
+else eval:=f(h,x,y);
+@y
+else eval:=lig_f(h,x,y);
+@z
+
+@x [117] ... and then really define it now.
+@p function f;
+@y
+@p function lig_f(@!h,@!x,@!y:index):index;
+@z
+
+@x
+f:=lig_z[h];
+@y
+lig_f:=lig_z[h];
+@z
+
+@x [124] Some cc's can't handle 136 case labels.
+ begin o:=vf[vf_ptr]; incr(vf_ptr);
+ case o of
+ @<Cases of \.{DVI} instructions that can appear in character packets@>@;
+@y
+ begin o:=vf[vf_ptr]; incr(vf_ptr);
+ if ((o<=set_char_0+127))or
+ ((o>=set1)and(o<=set1+3))or((o>=put1)and(o<=put1+3)) then
+begin if o>=set1 then
+ if o>=put1 then c:=get_bytes(o-put1+1,false)
+ else c:=get_bytes(o-set1+1,false)
+ else c:=o;
+ if f=font_ptr then
+ bad_vf('Character ',c:1,' in undeclared font will be ignored')
+@.Character...will be ignored@>
+ else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+ k:=font_chars[f];@+while vf[k]<>c do incr(k);
+ if k=font_start[f+1]-1 then
+ bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
+ else begin if o>=put1 then out('(PUSH)');
+ left; out('SETCHAR'); out_char(c);
+ if o>=put1 then out(')(POP');
+ right;
+ end;
+ end;
+ end
+ else case o of
+ @<Cases of \.{DVI} instructions that can appear in character packets@>
+@z
+
+@x [125] `signed' is a reserved word in ANSI C.
+@p function get_bytes(@!k:integer;@!signed:boolean):integer;
+@y
+@d signed == is_signed {|signed| is a reserved word in ANSI C}
+@p function get_bytes(@!k:integer;@!signed:boolean):integer;
+@z
+
+@x [126] No nonlocal goto's.
+ begin print_ln('Stack overflow!'); goto final_end;
+@y
+ begin print_ln('Stack overflow!'); uexit(1);
+@z
+
+@x [129] This code moved outside the case statement
+@ Before we typeset a character we make sure that it exists.
+
+@<Cases...@>=
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
+ four_cases(set1),four_cases(put1):begin if o>=set1 then
+ if o>=put1 then c:=get_bytes(o-put1+1,false)
+ else c:=get_bytes(o-set1+1,false)
+ else c:=o;
+ if f=font_ptr then
+ bad_vf('Character ',c:1,' in undeclared font will be ignored')
+@.Character...will be ignored@>
+ else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+ k:=font_chars[f];@+while vf[k]<>c do incr(k);
+ if k=font_start[f+1]-1 then
+ bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
+ else begin if o>=put1 then out('(PUSH)');
+ left; out('SETCHAR'); out_char(c);
+ if o>=put1 then out(')(POP');
+ right;
+ end;
+ end;
+ end;
+@y
+@ Before we typeset a character we make sure that it exists.
+(These cases moved outside the case statement, section 124.)
+@z
+
+@x [134] No final newline unless verbose.
+print_ln('.');@/
+@y
+if verbose then print_ln('.');@/
+@z
+
+@x [134] Add newline to BAD VF/TFM comment.
+ out('SO THE DATA HAS BEEN CHANGED!)');
+@y
+ out('SO THE DATA HAS BEEN CHANGED!)'); out_ln;
+@z
+
+
+@x [135] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{VFtoVP} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 4; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+ end else if getopt_return_val = "?" then begin
+ usage ('vftovp');
+
+ end else if argument_is ('help') then begin
+ usage_help (VFTOVP_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.E. Knuth');
+
+ end else if argument_is ('charcode-format') then begin
+ if strcmp (optarg, 'ascii') = 0 then
+ charcode_format := charcode_ascii
+ else if strcmp (optarg, 'octal') = 0 then
+ charcode_format := charcode_octal
+ else
+ print_ln ('Bad character code format', optarg, '.');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one two three remaining arguments.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc)
+ and (optind + 3 <> argc) then begin
+ print_ln ('vftovp: Need one to three file arguments.');
+ usage ('vftovp');
+ end;
+
+ vf_name := cmdline (optind);
+ if optind + 2 <= argc then begin
+ tfm_name := cmdline (optind + 1); {The user specified the TFM name.}
+ end else begin
+ {User did not specify TFM name; default it from the VF name.}
+ tfm_name := basename_change_suffix (vf_name, '.vf', '.tfm');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+@.-verbose@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@ The global variable |verbose| determines whether or not we print
+progress information.
+
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@ It starts off |false|.
+
+@<Initialize the option...@> =
+verbose := false;
+
+@ Here is an option to change how we output character codes.
+@.-charcode-format@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'charcode-format';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ We use an ``enumerated'' type to store the information.
+
+@<Type...@> =
+@!charcode_format_type = charcode_ascii..charcode_default;
+
+@
+@<Const...@> =
+@!charcode_ascii = 0;
+@!charcode_octal = 1;
+@!charcode_default = 2;
+
+@
+@<Global...@> =
+@!charcode_format: charcode_format_type;
+
+@ It starts off as the default, that is, we output letters and digits as
+ASCII characters, everything else in octal.
+
+@<Initialize the option...@> =
+charcode_format := charcode_default;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!vf_name, @!tfm_name, @!vpl_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/vftovp.rc b/Build/source/texk/web2c/vftovp.rc
new file mode 100644
index 00000000000..3c8e106cb0d
--- /dev/null
+++ b/Build/source/texk/web2c/vftovp.rc
@@ -0,0 +1,34 @@
+/* vftovp.rc: vftovp resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " vftovp 1.2"
+
+#define VER_INTERNALNAME_STR "vftovp"
+#define VER_ORIGINALFILENAME_STR "vftovp.exe"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#define VER_FILEDESCRIPTION_STR "VF-to-VP file converter"
+
+#include <texlive.version>
+
+/* vftovp.rc ends here */
diff --git a/Build/source/texk/web2c/vftovp.web b/Build/source/texk/web2c/vftovp.web
new file mode 100644
index 00000000000..73c0024ccf6
--- /dev/null
+++ b/Build/source/texk/web2c/vftovp.web
@@ -0,0 +1,2368 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was implemented in December 1989.
+% Version 1.1 fixed problems of strict Pascal (April 1990).
+% Version 1.2 fixed various bugs found by Peter Breitenlohner (September 1990).
+% Version 1.3 made out_as_fix tell the truth in overflow cases (Dec 2002).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{VF\lowercase{to}VP}
+\def\contentspagenumber{101}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont VFtoVP} processor}
+ \vskip 15pt
+ \centerline{(Version 1.3, December 2002)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this program
+ was supported in part by the National Science
+ Foundation and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{VFtoVP} utility program converts a virtual font (``\.{VF}'') file
+and its associated \TeX\ font metric (``\.{TFM}'')
+file into an equivalent virtual-property-list (``\.{VPL}'') file. It also
+makes a thorough check of the given files, using algorithms that are
+essentially the same as those used by
+\.{DVI} device drivers and by \TeX. Thus if \TeX\ or a \.{DVI} driver
+complains that a \.{TFM} or \.{VF}
+file is ``bad,'' this program will pinpoint the source or sources of
+badness. A \.{VPL} file output by this program can be edited with
+a normal text editor, and the result can be converted back to \.{VF} and \.{TFM}
+format using the companion program \.{VPtoVF}.
+
+\indent\.{VFtoVP} is an extended version of the program \.{TFtoPL}, which
+is part of the standard \TeX ware library.
+The idea of a virtual font was inspired by the work of David R. Fuchs
+@^Fuchs, David Raymond@>
+who designed a similar set of conventions in 1984 while developing a
+device driver for ArborText, Inc. He wrote a somewhat similar program
+called \.{AMFtoXPL}.
+
+The |banner| string defined here should be changed whenever \.{VFtoVP}
+gets modified.
+
+@d banner=='This is VFtoVP, Version 1.3' {printed when the program starts}
+
+@ This program is written entirely in standard \PASCAL, except that
+it occasionally has lower case letters in strings that are output.
+Such letters can be converted to upper case if necessary. The input is read
+from |vf_file| and |tfm_file|; the output is written on |vpl_file|.
+Error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program VFtoVP(@!vf_file,@!tfm_file,@!vpl_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @!k:integer; {all-purpose index for initialization}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{VFtoVP}'s capacity.
+
+@<Constants...@>=
+@!tfm_size=30000; {maximum length of |tfm| data, in bytes}
+@!vf_size=10000; {maximum length of |vf| data, in bytes}
+@!max_fonts=300; {maximum number of local fonts in the |vf| file}
+@!lig_size=5000; {maximum length of |lig_kern| program, in words}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@!name_length=50; {a file name shouldn't be longer than this}
+@!max_stack=50; {maximum depth of \.{DVI} stack in character packets}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+@d exit=10 {go here to leave a procedure}
+@d not_found=45 {go here when you've found nothing}
+@d return==goto exit {terminate a procedure call}
+@f return==nil
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+
+@* Virtual fonts. The idea behind \.{VF} files is that a general
+interface mechanism is needed to switch between the myriad font
+layouts provided by different suppliers of typesetting equipment.
+Without such a mechanism, people must go to great lengths writing
+inscrutable macros whenever they want to use typesetting conventions
+based on one font layout in connection with actual fonts that have
+another layout. This puts an extra burden on the typesetting system,
+interfering with the other things it needs to do (like kerning,
+hyphenation, and ligature formation).
+
+These difficulties go away when we have a ``virtual font,''
+i.e., a font that exists in a logical sense but not a physical sense.
+A typesetting system like \TeX\ can do its job without knowing where the
+actual characters come from; a device driver can then do its job by
+letting a \.{VF} file tell what actual characters correspond to the
+characters \TeX\ imagined were present. The actual characters
+can be shifted and/or magnified and/or combined with other characters
+from many different fonts. A virtual font can even make use of characters
+from virtual fonts, including itself.
+
+Virtual fonts also allow convenient character substitutions for proofreading
+purposes, when fonts designed for one output device are unavailable on another.
+
+@ A \.{VF} file is organized as a stream of 8-bit bytes, using conventions
+borrowed from \.{DVI} and \.{PK} files. Thus, a device driver that knows
+about \.{DVI} and \.{PK} format will already
+contain most of the mechanisms necessary to process \.{VF} files.
+We shall assume that \.{DVI} format is understood; the conventions in the
+\.{DVI} documentation (see, for example, {\sl \TeX: The Program}, part 31)
+are adopted here to define \.{VF} format.
+
+A preamble
+appears at the beginning, followed by a sequence of character definitions,
+followed by a postamble. More precisely, the first byte of every \.{VF} file
+must be the first byte of the following ``preamble command'':
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]| |cs[4]| |ds[4]|.
+Here |i| is the identification byte of \.{VF}, currently 202. The string
+|x| is merely a comment, usually indicating the source of the \.{VF} file.
+Parameters |cs| and |ds| are respectively the check sum and the design size
+of the virtual font; they should match the first two words in the header of
+the \.{TFM} file, as described below.
+
+\yskip
+After the |pre| command, the preamble continues with font definitions;
+every font needed to specify ``actual'' characters in later
+\\{set\_char} commands is defined here. The font definitions are
+exactly the same in \.{VF} files as they are in \.{DVI} files, except
+that the scaled size |s| is relative and the design size |d| is absolute:
+
+\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<256|.
+
+\yskip\hang|@!fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<65536|.
+
+\yskip\hang|@!fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|@!fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
+
+\yskip\noindent
+These font numbers |k| are ``local''; they have no relation to font numbers
+defined in the \.{DVI} file that uses this virtual font. The dimension~|s|,
+which represents the scaled size of the local font being defined,
+is a |fix_word| relative to the design size of the virtual font.
+Thus if the local font is to be used at the same size
+as the design size of the virtual font itself, |s| will be the
+integer value $2^{20}$. The value of |s| must be positive and less than
+$2^{24}$ (thus less than 16 when considered as a |fix_word|).
+The dimension~|d| is a |fix_word| in units of printer's points; hence it
+is identical to the design size found in the corresponding \.{TFM} file.
+
+@d id_byte=202
+
+@<Glob...@>=
+@!vf_file:packed file of byte;
+
+@ The preamble is followed by zero or more character packets, where each
+character packet begins with a byte that is $<243$. Character packets have
+two formats, one long and one short:
+
+\yskip\hang|long_char| 242 |pl[4]| |cc[4]| |tfm[4]| |dvi[pl]|. This long form
+specifies a virtual character in the general case.
+
+\yskip\hang|short_char0..short_char241|
+|pl[1]| |cc[1]| |tfm[3]| |dvi[pl]|. This short form specifies a
+virtual character in the common case
+when |0<=pl<242| and |0<=cc<256| and $0\le|tfm|<2^{24}$.
+
+\yskip\noindent
+Here |pl| denotes the packet length following the |tfm| value; |cc| is
+the character code; and |tfm| is the character width copied from the
+\.{TFM} file for this virtual font. There should be at most one character
+packet having any given |cc| code.
+
+The |dvi| bytes are a sequence of complete \.{DVI} commands, properly
+nested with respect to |push| and |pop|. All \.{DVI} operations are
+permitted except |bop|, |eop|, and commands with opcodes |>=243|.
+Font selection commands (|fnt_num0| through |fnt4|) must refer to fonts
+defined in the preamble.
+
+Dimensions that appear in the \.{DVI} instructions are analogous to
+|fix_word| quantities; i.e., they are integer multiples of $2^{-20}$ times
+the design size of the virtual font. For example, if the virtual font
+has design size $10\,$pt, the \.{DVI} command to move down $5\,$pt
+would be a \\{down} instruction with parameter $2^{19}$. The virtual font
+itself might be used at a different size, say $12\,$pt; then that
+\\{down} instruction would move down $6\,$pt instead. Each dimension
+must be less than $2^{24}$ in absolute value.
+
+Device drivers processing \.{VF} files treat the sequences of |dvi| bytes
+as subroutines or macros, implicitly enclosing them with |push| and |pop|.
+Each subroutine begins with |w=x=y=z=0|, and with current font~|f| the
+number of the first-defined in the preamble (undefined if there's no
+such font). After the |dvi| commands have been
+performed, the |h| and~|v| position registers of \.{DVI} format and the
+current font~|f| are restored to their former values;
+then, if the subroutine has been invoked by a \\{set\_char} or \\{set}
+command, |h|~is increased by the \.{TFM} width
+(properly scaled)---just as if a simple character had been typeset.
+
+@d long_char=242 {\.{VF} command for general character packet}
+@d set_char_0=0 {\.{DVI} command to typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d improper_DVI_for_VF==139,140,243,244,245,246,247,248,249,250,251,252,
+ 253,254,255
+
+@ The character packets are followed by a trivial postamble, consisting of
+one or more bytes all equal to |post| (248). The total number of bytes
+in the file should be a multiple of~4.
+
+@* Font metric data.
+The idea behind \.{TFM} files is that typesetting routines like \TeX\
+need a compact way to store the relevant information about several
+dozen fonts, and computer centers need a compact way to store the
+relevant information about several hundred fonts. \.{TFM} files are
+compact, and most of the information they contain is highly relevant,
+so they provide a solution to the problem.
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of 4, we could
+also regard the file as a sequence of 32-bit words; but \TeX\ uses the
+byte interpretation, and so does \.{VFtoVP}. Note that the bytes
+are considered to be unsigned numbers.
+
+@<Glob...@>=
+@!tfm_file:packed file of byte;
+
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file); reset(vf_file);
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|@!lf|&length of the entire file, in words;\cr
+|@!lh|&length of the header data, in words;\cr
+|@!bc|&smallest character code in the font;\cr
+|@!ec|&largest character code in the font;\cr
+|@!nw|&number of words in the width table;\cr
+|@!nh|&number of words in the height table;\cr
+|@!nd|&number of words in the depth table;\cr
+|@!ni|&number of words in the italic correction table;\cr
+|@!nl|&number of words in the lig/kern table;\cr
+|@!nk|&number of words in the kern table;\cr
+|@!ne|&number of words in the extensible character table;\cr
+|@!np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+|ne<=256|, and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+
+@<Glob...@>=
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np:0..@'77777;
+ {subfile sizes}
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
+header&|[0..lh-1]stuff|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but one of
+the |fix_word| values will lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+and for \.{TFM} files to be used with Xerox printing software it must
+contain at least 18 words, allocated as described below. When different
+kinds of devices need to be interfaced, it may be necessary to add further
+words to the header block.
+
+\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the
+\.{DVI} output file whenever it uses the font. Later on when the \.{DVI}
+file is printed, possibly on another computer, the actual font that gets
+used is supposed to have a check sum that agrees with the one in the
+\.{TFM} file used by \TeX. In this way, users will be warned about
+potential incompatibilities. (However, if the check sum is zero in either
+the font file or the \.{TFM} file, no check is made.) The actual relation
+between this check sum and the rest of the \.{TFM} file is not important;
+the check sum is simply an identification number with the property that
+incompatible fonts almost always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of the
+font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number
+must be at least 1.0; it is fairly arbitrary, but usually the design size
+is 10.0 for a ``10 point'' font, i.e., a font that was designed to look
+best at a 10-point size, whatever that really means. When a \TeX\ user
+asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the
+design size and replace it by $\delta$, and to multiply the $x$ and~$y$
+coordinates of the points in the font image by a factor of $\delta$
+divided by the design size. {\sl All other dimensions in the\/\ \.{TFM}
+file are |fix_word|\kern-1pt\ numbers in design-size units.} Thus, for example,
+the value of |param[6]|, one \.{em} or \.{\\quad}, is often the |fix_word|
+value $2^{20}=1.0$, since many fonts have a design size equal to one em.
+The other dimensions must be less than 16 design-size units in absolute
+value; thus, |header[1]| and |param[1]| are the only |fix_word| entries in
+the whole \.{TFM} file whose first byte might be something besides 0 or
+255. @^design size@>
+
+\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify
+the character coding scheme. The first byte, which must be between 0 and
+39, is the number of subsequent ASCII bytes actually relevant in this
+string, which is intended to specify what character-code-to-symbol
+convention is present in the font. Examples are \.{ASCII} for standard
+ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math
+extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for
+special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case
+when there is no information. Parentheses should not appear in this name.
+(Such a string is said to be in {\mc BCPL} format.)
+@^coding scheme@>
+
+\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the
+font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format.
+This field is also known as the ``font identifier.''
+@^family name@>
+@^font identifier@>
+
+\yskip\hang|header[17]|, if present, contains a first byte called the
+|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte
+called the |face|. If the value of the fourth byte is less than 18, it has
+the following interpretation as a ``weight, slope, and expansion'': Add 0
+or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to
+0 or 6 or 12 (for regular or condensed or extended). For example, 13 is
+0+1+12, so it represents medium italic extended. A three-letter code
+(e.g., \.{MIE}) can be used for such |face| data.
+
+\yskip\hang|header[18..@twhatever@>]| might also be present; the individual
+words are simply called |header[18]|, |header[19]|, etc., at the moment.
+
+@ Next comes the |char_info| array, which contains one |char_info_word|
+per character. Each |char_info_word| contains six fields packed into
+four bytes as follows.
+
+\yskip\hang first byte: |width_index| (8 bits)\par
+\hang second byte: |height_index| (4 bits) times 16, plus |depth_index|
+ (4~bits)\par
+\hang third byte: |italic_index| (6 bits) times 4, plus |tag|
+ (2~bits)\par
+\hang fourth byte: |remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is |width[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation |width[0]=height[0]=depth[0]=italic[0]=0|
+should always hold, so that an index of zero implies a value of zero.
+The |width_index| should never be zero unless the character does
+not exist in the font, since a character is valid if and only if it lies
+between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at |lig_kern[remainder]|.\par
+\hang|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain. The
+|remainder| field gives the character code of the next larger character.\par
+\hang|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|exten[remainder]|.\par
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word is a
+|lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+ step if the byte is 128 or more, otherwise the next step is obtained by
+ skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+ then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+ a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+Notice that if $a=0$ and $b=1$, the current character is unchanged; if
+$a=b$ and $c=1$, the current character is changed but the next character is
+unchanged. \.{VFtoVP} will check to see that infinite loops are avoided.
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must have
+|256*op_byte+remainder<nl|. If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+command is performed.
+
+@d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@ Extensible characters are specified by an |extensible_recipe|,
+which consists of four bytes called |top|, |mid|,
+|bot|, and |rep| (in this order). These bytes are the character codes
+of individual pieces used to build up a large symbol.
+If |top|, |mid|, or |bot| are zero,
+they are not present in the built-up result. For example, an extensible
+vertical line is like an extensible bracket, except that the top and
+bottom pieces are missing.
+
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=@!slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it's the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character |" "| in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the height of letters for which accents don't
+have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+When the character coding scheme is \.{TeX math symbols}, the font is
+supposed to have 15 additional parameters called |num1|, |num2|, |num3|,
+|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|,
+|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the
+character coding scheme is \.{TeX math extension}, the font is supposed to
+have six additional parameters called |default_rule_thickness| and
+|big_op_spacing1| through |big_op_spacing5|.
+
+@ So that is what \.{TFM} files hold. The next question is, ``What about
+\.{VPL} files?'' A complete answer to that question appears in the
+documentation of the companion program, \.{VPtoVF}, so it will not
+be repeated here. Suffice it to say that a \.{VPL} file is an ordinary
+\PASCAL\ text file, and that the output of \.{VFtoVP} uses only a
+subset of the possible constructions that might appear in a \.{VPL} file.
+Furthermore, hardly anybody really wants to look at the formal
+definition of \.{VPL} format, because it is almost self-explanatory when
+you see an example or two.
+
+@<Glob...@>=
+@!vpl_file:text;
+
+@ @<Set init...@>=
+rewrite(vpl_file);
+
+@* Unpacking the TFM file.
+The first thing \.{VFtoVP} does is read the entire |tfm_file| into an array of
+bytes, |tfm[0..(4*lf-1)]|.
+
+@<Types...@>=
+@!index=0..tfm_size; {address of a byte in |tfm|}
+
+@ @<Glob...@>=
+@!tfm:array [-1000..tfm_size] of byte; {the \.{TFM} input data all goes here}
+ {the negative addresses avoid range checks for invalid characters}
+
+@ The input may, of course, be all screwed up and not a \.{TFM} file
+at all. So we begin cautiously.
+
+@d abort(#)==begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a TFM?');
+ goto final_end;
+ end
+
+@<Read the whole \.{TFM} file@>=
+read(tfm_file,tfm[0]);
+if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
+@.The first byte...@>
+if eof(tfm_file) then abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
+if lf=0 then
+ abort('The file claims to have length zero, but that''s impossible!');
+@.The file claims...@>
+if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+for tfm_ptr:=2 to 4*lf-1 do
+ begin if eof(tfm_file) then
+ abort('The file has fewer bytes than it claims!');
+@.The file has fewer bytes...@>
+ read(tfm_file,tfm[tfm_ptr]);
+ end;
+if not eof(tfm_file) then
+ begin print_ln('There''s some extra junk at the end of the TFM file,');
+@.There's some extra junk...@>
+ print_ln('but I''ll proceed as if it weren''t there.');
+ end
+
+@ After the file has been read successfully, we look at the subfile sizes
+to see if they check out.
+
+@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then
+ abort('One of the subfile sizes is negative!');
+@.One of the subfile sizes...@>
+ #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1];
+ tfm_ptr:=tfm_ptr+2;
+ end
+
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>=
+begin tfm_ptr:=2;@/
+eval_two_bytes(lh);
+eval_two_bytes(bc);
+eval_two_bytes(ec);
+eval_two_bytes(nw);
+eval_two_bytes(nh);
+eval_two_bytes(nd);
+eval_two_bytes(ni);
+eval_two_bytes(nl);
+eval_two_bytes(nk);
+eval_two_bytes(ne);
+eval_two_bytes(np);
+if lh<2 then abort('The header length is only ',lh:1,'!');
+@.The header length...@>
+if nl>4*lig_size then
+ abort('The lig/kern program is longer than I can handle!');
+@.The lig/kern program...@>
+if (bc>ec+1)or(ec>255) then abort('The character code range ',
+@.The character code range...@>
+ bc:1,'..',ec:1,'is illegal!');
+if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
+ abort('Incomplete subfiles for character dimensions!');
+@.Incomplete subfiles...@>
+if ne>256 then abort('There are ',ne:1,' extensible recipes!');
+@.There are ... recipes@>
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then
+ abort('Subfile sizes don''t add up to the stated total!');
+@.Subfile sizes don't add up...@>
+end
+
+@ Once the input data successfully passes these basic checks,
+\.{VFtoVP} believes that it is a \.{TFM} file, and the conversion
+to \.{VPL} format will take place. Access to the various subfiles
+is facilitated by computing the following base addresses. For example,
+the |char_info| for character |c| will start in location
+|4*(char_base+c)| of the |tfm| array.
+
+@<Globals...@>=
+@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base,
+@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
+ {base addresses for the subfiles}
+
+@ @<Compute the base addresses@>=
+begin char_base:=6+lh-bc;
+width_base:=char_base+ec+1;
+height_base:=width_base+nw;
+depth_base:=height_base+nh;
+italic_base:=depth_base+nd;
+lig_kern_base:=italic_base+ni;
+kern_base:=lig_kern_base+nl;
+exten_base:=kern_base+nk;
+param_base:=exten_base+ne-1;
+end
+
+@ Of course we want to define macros that suppress the detail of how the
+font information is actually encoded. Each word will be referred to by
+the |tfm| index of its first byte. For example, if |c| is a character
+code between |bc| and |ec|, then |tfm[char_info(c)]| will be the
+first byte of its |char_info|, i.e., the |width_index|; furthermore
+|width(c)| will point to the |fix_word| for |c|'s width.
+
+@d check_sum=24
+@d design_size=check_sum+4
+@d scheme=design_size+4
+@d family=scheme+40
+@d random_word=family+20
+@d char_info(#)==4*(char_base+#)
+@d width_index(#)==tfm[char_info(#)]
+@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0))
+@d height_index(#)==(tfm[char_info(#)+1] div 16)
+@d depth_index(#)==(tfm[char_info(#)+1] mod 16)
+@d italic_index(#)==(tfm[char_info(#)+2] div 4)
+@d tag(#)==(tfm[char_info(#)+2] mod 4)
+@d reset_tag(#)==tfm[char_info(#)+2]:=4*italic_index(#)+no_tag
+@d remainder(#)==tfm[char_info(#)+3]
+@d width(#)==4*(width_base+width_index(#))
+@d height(#)==4*(height_base+height_index(#))
+@d depth(#)==4*(depth_base+depth_index(#))
+@d italic(#)==4*(italic_base+italic_index(#))
+@d exten(#)==4*(exten_base+remainder(#))
+@d lig_step(#)==4*(lig_kern_base+(#))
+@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
+@d param(#)==4*(param_base+#) {likewise}
+
+@ One of the things we would like to do is take cognizance of fonts whose
+character coding scheme is \.{TeX math symbols} or \.{TeX math extension};
+we will set the |font_type| variable to one of the three choices
+|vanilla|, |mathsy|, or |mathex|.
+
+@d vanilla=0 {not a special scheme}
+@d mathsy=1 {\.{TeX math symbols} scheme}
+@d mathex=2 {\.{TeX math extension} scheme}
+
+@<Glob...@>=
+@!font_type:vanilla..mathex; {is this font special?}
+
+@* Unpacking the VF file.
+Once the \.{TFM} file has been brought into memory, \.{VFtoVP} completes
+the input phase by reading the \.{VF} information into another array of bytes.
+In this case we don't store all the data; we check the redundant bytes
+for consistency with their \.{TFM} counterparts, and we partially decode
+the packets.
+
+@<Glob...@>=
+@!vf:array[0..vf_size] of byte; {the \.{VF} input data goes here}
+@!font_number:array[0..max_fonts] of integer; {local font numbers}
+@!font_start,@!font_chars:array[0..max_fonts] of 0..vf_size; {font info}
+@!font_ptr:0..max_fonts; {number of local fonts}
+@!packet_start,@!packet_end:array[byte] of 0..vf_size;
+ {character packet boundaries}
+@!packet_found:boolean; {at least one packet has appeared}
+@!temp_byte:byte;@+@!count:integer; {registers for simple calculations}
+@!real_dsize:real; {the design size, converted to floating point}
+@!pl:integer; {packet length}
+@!vf_ptr:0..vf_size; {first unused location in |vf|}
+@!vf_count:integer; {number of bytes read from |vf_file|}
+
+@ Again we cautiously verify that we've been given decent data.
+
+@d read_vf(#)==read(vf_file,#)
+@d vf_abort(#)==
+ begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a VF?');
+ goto final_end;
+ end
+
+@<Read the whole \.{VF} file@>=
+read_vf(temp_byte);
+if temp_byte<>pre then vf_abort('The first byte isn''t `pre''!');
+@.The first byte...@>
+@<Read the preamble command@>;
+@<Read and store the font definitions and character packets@>;
+@<Read and verify the postamble@>
+
+@ @d vf_store(#)==@t@>@;@/
+ if vf_ptr+#>=vf_size then vf_abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+ for k:=vf_ptr to vf_ptr+#-1 do
+ begin if eof(vf_file) then vf_abort('The file ended prematurely!');
+@.The file ended prematurely@>
+ read_vf(vf[k]);
+ end;
+ vf_count:=vf_count+#; vf_ptr:=vf_ptr+#
+
+@<Read the preamble command@>=
+if eof(vf_file) then vf_abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read_vf(temp_byte);
+if temp_byte<>id_byte then vf_abort('Wrong VF version number in second byte!');
+@.Wrong VF version...@>
+if eof(vf_file) then vf_abort('The input file is only two bytes long!');
+read_vf(temp_byte); {read the length of introductory comment}
+vf_count:=11; vf_ptr:=0; vf_store(temp_byte);
+for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
+print_ln(' '); count:=0;
+for k:=0 to 7 do
+ begin if eof(vf_file) then vf_abort('The file ended prematurely!');
+@.The file ended prematurely@>
+ read_vf(temp_byte);
+ if temp_byte=tfm[check_sum+k] then incr(count);
+ end;
+real_dsize:=(((tfm[design_size]*256+tfm[design_size+1])*256+tfm[design_size+2])
+ *256+tfm[design_size+3])/@'4000000;
+if count<>8 then
+ begin print_ln('Check sum and/or design size mismatch.');
+@.Check sum...mismatch@>
+ print_ln('Data from TFM file will be assumed correct.');
+ end
+
+@ @<Read and store the font definitions and character packets@>=
+for k:=0 to 255 do packet_start[k]:=vf_size;
+font_ptr:=0; packet_found:=false; font_start[0]:=vf_ptr;
+repeat if eof(vf_file) then
+ begin print_ln('File ended without a postamble!'); temp_byte:=post;
+@.File ended without a postamble@>
+ end
+else begin read_vf(temp_byte); incr(vf_count);
+ if temp_byte<>post then
+ if temp_byte>long_char then @<Read and store a font definition@>
+ else @<Read and store a character packet@>;
+ end;
+until temp_byte=post
+
+@ @<Read and verify the postamble@>=
+while (temp_byte=post)and not eof(vf_file) do
+ begin read_vf(temp_byte); incr(vf_count);
+ end;
+if not eof(vf_file) then
+ begin print_ln('There''s some extra junk at the end of the VF file.');
+@.There's some extra junk...@>
+ print_ln('I''ll proceed as if it weren''t there.');
+ end;
+if vf_count mod 4 <> 0 then
+ print_ln('VF data not a multiple of 4 bytes')
+@.VF data not a multiple of 4 bytes@>
+
+@ @<Read and store a font definition@>=
+begin if packet_found or(temp_byte>=pre) then
+ vf_abort('Illegal byte ',temp_byte:1,' at beginning of character packet!');
+@.Illegal byte...@>
+font_number[font_ptr]:=vf_read(temp_byte-fnt_def1+1);
+if font_ptr=max_fonts then vf_abort('I can''t handle that many fonts!');
+@.I can't handle that many fonts@>
+vf_store(14); {|c[4]| |s[4]| |d[4]| |a[1]| |l[1]|}
+if vf[vf_ptr-10]>0 then {|s| is negative or exceeds $2^{24}-1$}
+ vf_abort('Mapped font size is too big!');
+@.Mapped font size...big@>
+a:=vf[vf_ptr-2]; l:=vf[vf_ptr-1]; vf_store(a+l); {|n[a+l]|}
+@<Print the name of the local font@>;
+@<Read the local font's \.{TFM} file and record the characters it contains@>;
+incr(font_ptr); font_start[font_ptr]:=vf_ptr;
+end
+
+@ The font area may need to be separated from the font name on some systems.
+Here we simply reproduce the font area and font name (with no space
+or punctuation between them).
+@^system dependencies@>
+
+@<Print the name...@>=
+print('MAPFONT ',font_ptr:1,': ');
+for k:=font_start[font_ptr]+14 to vf_ptr-1 do print(xchr[vf[k]]);
+k:=font_start[font_ptr]+5;
+print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2,
+ 'pt')
+
+@ Now we must read in another \.{TFM} file. But this time we needn't be so
+careful, because we merely want to discover which characters are present.
+The next few sections of the program are copied pretty much verbatim from
+\.{DVItype}, so that system-dependent modifications can be copied from existing
+software.
+
+It turns out to be convenient to read four bytes at a time, when we are
+inputting from the local \.{TFM} files. The input goes into global variables
+|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3|
+the fourth.
+
+@<Glob...@>=
+@!a:integer; {length of the area/directory spec}
+@!l:integer; {length of the font name proper}
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!b0,@!b1,@!b2,@!b3: byte; {four bytes input at once}
+@!font_lh:0..@'77777; {header length of current local font}
+@!font_bc,@!font_ec:0..@'77777; {character range of current local font}
+
+@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
+four bytes in the current \.{TFM} file.
+@^system dependencies@>
+
+@d read_tfm(#)==if eof(tfm_file) then #:=0@+else read(tfm_file,#)
+
+@p procedure read_tfm_word;
+begin read_tfm(b0); read_tfm(b1);
+read_tfm(b2); read_tfm(b3);
+end;
+
+@ We use the |vf| array to store a list of all valid characters in the
+local font, beginning at location |font_chars[f]|.
+
+@<Read the local font's \.{TFM} file...@>=
+font_chars[font_ptr]:=vf_ptr;
+@<Move font name into the |cur_name| string@>;
+reset(tfm_file,cur_name);
+@^system dependencies@>
+if eof(tfm_file) then
+ print_ln('---not loaded, TFM file can''t be opened!')
+@.TFM file can\'t be opened@>
+else begin font_bc:=0; font_ec:=256; {will cause error if not modified soon}
+ read_tfm_word;
+ if b2<128 then
+ begin font_lh:=b2*256+b3; read_tfm_word;
+ if (b0<128) and (b2<128) then
+ begin font_bc:=b0*256+b1; font_ec:=b2*256+b3;
+ end;
+ end;
+ if font_bc<=font_ec then
+ if font_ec>255 then print_ln('---not loaded, bad TFM file!')
+@.bad TFM file@>
+ else begin for k:=0 to 3+font_lh do
+ begin read_tfm_word;
+ if k=4 then @<Check the check sum@>;
+ if k=5 then @<Check the design size@>;
+ end;
+ for k:=font_bc to font_ec do
+ begin read_tfm_word;
+ if b0>0 then {character |k| exists in the font}
+ begin vf[vf_ptr]:=k; incr(vf_ptr);
+ if vf_ptr=vf_size then vf_abort('I''m out of VF memory!');
+@.I'm out of VF memory@>
+ end;
+ end;
+ end;
+ if eof(tfm_file) then
+ print_ln('---trouble is brewing, TFM file ended too soon!');
+@.trouble is brewing...@>
+ end;
+incr(vf_ptr) {leave space for character search later}
+
+@ @<Check the check sum@>=
+if b0+b1+b2+b3>0 then
+ if(b0<>vf[font_start[font_ptr]])or@|
+ (b1<>vf[font_start[font_ptr]+1])or@|
+ (b2<>vf[font_start[font_ptr]+2])or@|
+ (b3<>vf[font_start[font_ptr]+3]) then
+ begin print_ln('Check sum in VF file being replaced by TFM check sum');
+@.Check sum...replaced...@>
+ vf[font_start[font_ptr]]:=b0;
+ vf[font_start[font_ptr]+1]:=b1;
+ vf[font_start[font_ptr]+2]:=b2;
+ vf[font_start[font_ptr]+3]:=b3;
+ end
+
+@ @<Check the design size@>=
+if(b0<>vf[font_start[font_ptr]+8])or@|
+ (b1<>vf[font_start[font_ptr]+9])or@|
+ (b2<>vf[font_start[font_ptr]+10])or@|
+ (b3<>vf[font_start[font_ptr]+11]) then
+ begin print_ln('Design size in VF file being replaced by TFM design size');
+@.Design size...replaced...@>
+ vf[font_start[font_ptr]+8]:=b0;
+ vf[font_start[font_ptr]+9]:=b1;
+ vf[font_start[font_ptr]+10]:=b2;
+ vf[font_start[font_ptr]+11]:=b3;
+ end
+
+@ If no font directory has been specified, \.{DVI}-reading software
+is supposed to use the default font directory, which is a
+system-dependent place where the standard fonts are kept.
+The string variable |default_directory| contains the name of this area.
+@^system dependencies@>
+
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@^system dependencies@>
+
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if a=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_start[font_ptr]+14 to vf_ptr-1 do
+ begin incr(r);
+ if r+4>name_length then vf_abort('Font name too long for me!');
+@.Font name too long for me@>
+ if (vf[k]>="a")and(vf[k]<="z") then
+ cur_name[r]:=xchr[vf[k]-@'40]
+ else cur_name[r]:=xchr[vf[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+
+
+@ It's convenient to have a subroutine
+that reads a |k|-byte number from |vf_file|.
+
+@d get_vf(#)==if eof(vf_file) then #:=0 @+else read_vf(#)
+
+@p function vf_read(@!k:integer):integer; {actually |1<=k<=4|}
+var @!b:byte; {input byte}
+@!a:integer; {accumulator}
+begin vf_count:=vf_count+k; get_vf(b); a:=b;
+if k=4 then if b>=128 then a:=a-256; {4-byte numbers are signed}
+while k>1 do
+ begin get_vf(b);
+ a:=256*a+b; decr(k);
+ end;
+vf_read:=a;
+end;
+
+@ The \.{VF} format supports arbitrary 4-byte character codes,
+but \.{VPL} format presently does not.
+Therefore we give up if the character code is
+not between 0 and~255.
+
+After more experience is gained with present-day \.{VPL} files, the
+best way to extend them to arbitrary character codes will become clear;
+the extensions to \.{VFtoVP} and \.{VPtoVF} should not be difficult.
+
+@<Read and store a character packet@>=
+begin if temp_byte=long_char then
+ begin pl:=vf_read(4); c:=vf_read(4); count:=vf_read(4);
+ {|pl[4]| |cc[4]| |tfm[4]|}
+ end
+else begin pl:=temp_byte; c:=vf_read(1); count:=vf_read(3);
+ {|pl[1]| |cc[1]| |tfm[3]|}
+ end;
+if nonexistent(c) then vf_abort('Character ',c:1,' does not exist!');
+@.Character c does not exist@>
+if packet_start[c]<vf_size then
+ print_ln('Discarding earlier packet for character ',c:1);
+@.Discarding earlier packet...@>
+if count<>tfm_width(c) then
+ print_ln('Incorrect TFM width for character ',c:1,' in VF file');
+@.Incorrect TFM width...@>
+if pl<0 then vf_abort('Negative packet length!');
+@.Negative packet length@>
+packet_start[c]:=vf_ptr; vf_store(pl); packet_end[c]:=vf_ptr-1;
+packet_found:=true;
+end
+
+@ The preceding code requires a simple subroutine that evaluates \.{TFM} data.
+
+@p function tfm_width(@!c:byte):integer;
+var @!a:integer; {accumulator}
+@!k:index; {index into |tfm|}
+begin k:=width(c); {we assume that character |c| exists}
+a:=tfm[k];
+if a>=128 then a:=a-256;
+tfm_width:=((256*a+tfm[k+1])*256+tfm[k+2])*256+tfm[k+3];
+end;
+
+@* Basic output subroutines.
+Let us now define some procedures that will reduce the rest of \.{VFtoVP}'s
+work to a triviality.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{VPL} file:
+
+@d out(#)==write(vpl_file,#)
+
+@ In order to stick to standard \PASCAL, we use an |xchr| array to do
+appropriate conversion of ASCII codes. Three other little strings are
+used to produce |face| codes like \.{MIE}.
+
+@<Glob...@>=
+@!ASCII_04,@!ASCII_10,@!ASCII_14: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!xchr:packed array [0..255] of char;
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+
+@ @<Set init...@>=
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/
+for k:=0 to 255 do xchr[k]:='?';
+for k:=0 to @'37 do
+ begin xchr[k+@'40]:=ASCII_04[k+1];
+ xchr[k+@'100]:=ASCII_10[k+1];
+ xchr[k+@'140]:=ASCII_14[k+1];
+ end;
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+
+@ The array |dig| will hold a sequence of digits to be output.
+
+@<Glob...@>=
+@!dig:array[0..11] of 0..9;
+
+@ Here, in fact, are two procedures that output |dig[j-1]|$\,\ldots\,$|dig[0]|,
+given $j>0$.
+
+@p procedure out_digs(j:integer); {outputs |j| digits}
+begin repeat decr(j); out(dig[j]:1);
+until j=0;
+end;
+@#
+procedure print_digs(j:integer); {prints |j| digits}
+begin repeat decr(j); print(dig[j]:1);
+until j=0;
+end;
+
+@ The |print_octal| procedure indicates how |print_digs| can be used.
+Since this procedure is used only to print character codes, it always
+produces three digits.
+
+@p procedure print_octal(c:byte); {prints octal value of |c|}
+var j:0..2; {index into |dig|}
+begin print(''''); {an apostrophe indicates the octal notation}
+for j:=0 to 2 do
+ begin dig[j]:=c mod 8; c:=c div 8;
+ end;
+print_digs(3);
+end;
+
+@ A \.{VPL} file has nested parentheses, and we want to format the output
+so that its structure is clear. The |level| variable keeps track of the
+depth of nesting.
+
+@<Glob...@>=
+@!level:0..5;
+
+@ @<Set init...@>=
+level:=0;
+
+@ Three simple procedures suffice to produce the desired structure in the
+output.
+
+@p procedure out_ln; {finishes one line, indents the next}
+var l:0..5;
+begin write_ln(vpl_file);
+for l:=1 to level do out(' ');
+end;
+@#
+procedure left; {outputs a left parenthesis}
+begin incr(level); out('(');
+end;
+@#
+procedure right; {outputs a right parenthesis and finishes a line}
+begin decr(level); out(')'); out_ln;
+end;
+
+@ The value associated with a property can be output in a variety of
+ways. For example, we might want to output a {\mc BCPL} string that
+begins in |tfm[k]|:
+
+@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space}
+var l:0..39; {the number of bytes remaining}
+begin out(' '); l:=tfm[k];
+while l>0 do
+ begin incr(k); decr(l); out(xchr[tfm[k]]);
+ end;
+end;
+
+@ The property value might also be a sequence of |l| bytes, beginning
+in |tfm[k]|, that we would like to output in octal notation.
+The following procedure assumes that |l<=4|, but larger values of |l|
+could be handled easily by enlarging the |dig| array and increasing
+the upper bounds on |b| and |j|.
+
+@p procedure out_octal(@!k,@!l:index); {outputs |l| bytes in octal}
+var a:0..@'1777; {accumulator for bits not yet output}
+@!b:0..32; {the number of significant bits in |a|}
+@!j:0..11; {the number of digits of output}
+begin out(' O '); {specify octal format}
+a:=0; b:=0; j:=0;
+while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>;
+while (a>0)or(j=0) do
+ begin dig[j]:=a mod 8; a:=a div 8; incr(j);
+ end;
+out_digs(j);
+end;
+
+@ @<Reduce \(1)|l|...@>=
+begin decr(l);
+if tfm[k+l]<>0 then
+ begin while b>2 do
+ begin dig[j]:=a mod 8; a:=a div 8; b:=b-3; incr(j);
+ end;
+ case b of
+ 0: a:=tfm[k+l];
+ 1:a:=a+2*tfm[k+l];
+ 2:a:=a+4*tfm[k+l];
+ end;
+ end;
+b:=b+8;
+end
+
+@ The property value may be a character, which is output in octal
+unless it is a letter or a digit.
+@^system dependencies@>
+
+@p procedure out_char(@!c:byte); {outputs a character}
+begin if font_type>vanilla then
+ begin tfm[0]:=c; out_octal(0,1)
+ end
+else if ((c>="0")and(c<="9"))or@|
+ ((c>="A")and(c<="Z"))or@|
+ ((c>="a")and(c<="z")) then out(' C ',xchr[c])
+else begin tfm[0]:=c; out_octal(0,1);
+ end;
+end;
+
+@ The property value might be a ``face'' byte, which is output in the
+curious code mentioned earlier, provided that it is less than 18.
+
+@p procedure out_face(@!k:index); {outputs a |face|}
+var s:0..1; {the slope}
+@!b:0..8; {the weight and expansion}
+begin if tfm[k]>=18 then out_octal(k,1)
+else begin out(' F '); {specify face-code format}
+ s:=tfm[k] mod 2; b:=tfm[k] div 2;
+ out(MBL_string[1+(b mod 3)]);
+ out(RI_string[1+s]);
+ out(RCE_string[1+(b div 3)]);
+ end;
+end;
+
+@ And finally, the value might be a |fix_word|, which is output in
+decimal notation with just enough decimal places for \.{VPtoVF}
+to recover every bit of the given |fix_word|.
+
+All of the numbers involved in the intermediate calculations of
+this procedure will be nonnegative and less than $10\cdot2^{24}$.
+
+@p procedure out_fix(@!k:index); {outputs a |fix_word|}
+var a:0..@'7777; {accumulator for the integer part}
+@!f:integer; {accumulator for the fraction part}
+@!j:0..12; {index into |dig|}
+@!delta:integer; {amount if allowable inaccuracy}
+begin out(' R '); {specify real format}
+a:=(tfm[k]*16)+(tfm[k+1] div 16);
+f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
+if a>@'3777 then @<Reduce \(2)negative to positive@>;
+@<Output the integer part, |a|, in decimal notation@>;
+@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>;
+end;
+
+@ The following code outputs at least one digit even if |a=0|.
+
+@<Output the integer...@>=
+begin j:=0;
+repeat dig[j]:=a mod 10; a:=a div 10; incr(j);
+until a=0;
+out_digs(j);
+end
+
+@ And the following code outputs at least one digit to the right
+of the decimal point.
+
+@<Output the fraction...@>=
+begin out('.'); f:=10*f+5; delta:=10;
+repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2);
+out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10;
+until f<=delta;
+end;
+
+@ @<Reduce \(2)negative to positive@>=
+begin out('-'); a:=@'10000-a;
+if f>0 then
+ begin f:=@'4000000-f; decr(a);
+ end;
+end
+
+@* Outputting the TFM info.
+\TeX\ checks the information of a \.{TFM} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. And when it finds something wrong, it justs
+calls the file ``bad,'' without identifying the nature of the problem,
+since \.{TFM} files are supposed to be good almost all of the time.
+
+Of course, a bad file shows up every now and again, and that's where
+\.{VFtoVP} comes in. This program wants to catch at least as many errors as
+\TeX\ does, and to give informative error messages besides.
+All of the errors are corrected, so that the \.{VPL} output will
+be correct (unless, of course, the \.{TFM} file was so loused up
+that no attempt is being made to fathom it).
+
+@ Just before each character is processed, its code is printed in octal
+notation. Up to eight such codes appear on a line; so we have a variable
+to keep track of how many are currently there. We also keep track of
+whether or not any errors have had to be corrected.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+@!perfect:boolean; {was the file free of errors?}
+
+@ @<Set init...@>=
+chars_on_line:=0;@/
+perfect:=true; {innocent until proved guilty}
+
+@ Error messages are given with the help of the |bad| and |range_error|
+and |bad_char| macros:
+
+@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print_ln('Bad TFM file: ',#);
+ end
+@.Bad TFM file@>
+@d range_error(#)==begin perfect:=false; print_ln(' ');
+ print(#,' index for character ');
+ print_octal(c); print_ln(' is too large;');
+ print_ln('so I reset it to zero.');
+ end
+@d bad_char_tail(#)==print_octal(#); print_ln('.');
+ end
+@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad TFM file: ',#,' nonexistent character ');
+ bad_char_tail
+@d correct_bad_char_tail(#)==print_octal(tfm[#]); print_ln('.'); tfm[#]:=bc;
+ end
+@d correct_bad_char(#)== begin perfect:=false;
+ if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad TFM file: ',#,' nonexistent character ');
+ correct_bad_char_tail
+
+@<Glob...@>=
+@!i:0..@'77777; {an index to words of a subfile}
+@!c:0..256; {a random character}
+@!d:0..3; {byte number in a word}
+@!k:index; {a random index}
+@!r:0..65535; {a random two-byte value}
+
+@ There are a lot of simple things to do, and they have to be done one
+at a time, so we might as well get down to business. The first things
+that \.{VFtoVP} will put into the \.{VPL} file appear in the header part.
+
+@<Do the header@>=
+begin font_type:=vanilla;
+if lh>=12 then
+ begin @<Set the true |font_type|@>;
+ if lh>=17 then
+ begin @<Output the family name@>;
+ if lh>=18 then @<Output the rest of the header@>;
+ end;
+ @<Output the character coding scheme@>;
+ end;
+@<Output the design size@>;
+@<Output the check sum@>;
+@<Output the |seven_bit_safe_flag|@>;
+end
+
+@ @<Output the check sum@>=
+left; out('CHECKSUM'); out_octal(check_sum,4);
+right
+
+@ Incorrect design sizes are changed to 10 points.
+
+@d bad_design(#)==begin bad('Design size ',#,'!');
+@.Design size wrong@>
+ print_ln('I''ve set it to 10 points.');
+ out(' D 10');
+ end
+
+@ @<Output the design size@>=
+left; out('DESIGNSIZE');
+if tfm[design_size]>127 then bad_design('negative')
+else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then
+ bad_design('too small')
+else out_fix(design_size);
+right;
+out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln;
+out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln
+@.DESIGNSIZE IS IN POINTS@>
+
+@ Since we have to check two different {\mc BCPL} strings for validity,
+we might as well write a subroutine to make the check.
+
+@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|}
+var j:index; {runs through the string}
+@!c:byte; {character being checked}
+begin if tfm[k]>=l then
+ begin bad('String is too long; I''ve shortened it drastically.');
+@.String is too long...@>
+ tfm[k]:=1;
+ end;
+for j:=k+1 to k+tfm[k] do
+ begin c:=tfm[j];
+ if (c="(")or(c=")") then
+ begin bad('Parenthesis in string has been changed to slash.');
+@.Parenthesis...changed to slash@>
+ tfm[j]:="/";
+ end
+ else if (c<" ")or(c>"~") then
+ begin bad('Nonstandard ASCII code has been blotted out.');
+@.Nonstandard ASCII code...@>
+ tfm[j]:="?";
+ end
+ else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters}
+ end;
+end;
+
+@ The |font_type| starts out |vanilla|; possibly we need to reset it.
+
+@<Set the true |font_type|@>=
+begin check_BCPL(scheme,40);
+if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@|
+ (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@|
+ (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@|
+ (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@|
+ (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then
+ begin if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy
+ else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex;
+ end;
+end
+
+@ @<Output the character coding scheme@>=
+left; out('CODINGSCHEME');
+out_BCPL(scheme);
+right
+
+@ @<Output the family name@>=
+left; out('FAMILY');
+check_BCPL(family,20);
+out_BCPL(family);
+right
+
+@ @<Output the rest of the header@>=
+begin left; out('FACE'); out_face(random_word+3); right;
+for i:=18 to lh-1 do
+ begin left; out('HEADER D ',i:1);
+ out_octal(check_sum+4*i,@,4); right;
+ end;
+end
+
+@ This program does not check to see if the |seven_bit_safe_flag| has the
+correct setting, i.e., if it really reflects the seven-bit-safety of
+the \.{TFM} file; the stated value is merely put into the \.{VPL} file.
+The \.{VPtoVF} program will store a correct value and give a warning
+message if a file falsely claims to be safe.
+
+@<Output the |seven_bit_safe_flag|@>=
+if (lh>17) and (tfm[random_word]>127) then
+ begin left; out('SEVENBITSAFEFLAG TRUE'); right;
+ end
+
+@ The next thing to take care of is the list of parameters.
+
+@<Do the parameters@>=
+if np>0 then
+ begin left; out('FONTDIMEN'); out_ln;
+ for i:=1 to np do @<Check and output the $i$th parameter@>;
+ right;
+ end;
+@<Check to see if |np| is complete for this font type@>;
+
+@ @<Check to see if |np|...@>=
+if (font_type=mathsy)and(np<>22) then
+ print_ln('Unusual number of fontdimen parameters for a math symbols font (',
+@.Unusual number of fontdimen...@>
+ np:1,' not 22).')
+else if (font_type=mathex)and(np<>13) then
+ print_ln('Unusual number of fontdimen parameters for an extension font (',
+ np:1,' not 13).')
+
+@ All |fix_word| values except the design size and the first parameter
+will be checked to make sure that they are less than 16.0 in magnitude,
+using the |check_fix| macro:
+
+@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;');
+ print_ln('I have set it to zero.');
+ end
+@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then
+ begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0;
+ check_fix_tail
+
+@<Check and output the $i$th parameter@>=
+begin left;
+if i=1 then out('SLANT') {this parameter is not checked}
+else begin check_fix(param(i))('Parameter');@/
+@.Parameter n is too big@>
+ @<Output the name of parameter $i$@>;
+ end;
+out_fix(param(i)); right;
+end
+
+@ @<Output the name...@>=
+if i<=7 then case i of
+ 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK');
+ 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end
+else if (i<=22)and(font_type=mathsy) then case i of
+ 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3');
+ 11:out('DENOM1');@+12:out('DENOM2');
+ 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3');
+ 16:out('SUB1');@+17:out('SUB2');
+ 18:out('SUPDROP');@+19:out('SUBDROP');
+ 20:out('DELIM1');@+21:out('DELIM2');
+ 22:out('AXISHEIGHT')@+end
+else if (i<=13)and(font_type=mathex) then
+ if i=8 then out('DEFAULTRULETHICKNESS')
+ else out('BIGOPSPACING',i-8:1)
+else out('PARAMETER D ',i:1)
+
+@ We need to check the range of all the remaining |fix_word| values,
+and to make sure that |width[0]=0|, etc.
+
+@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0)
+
+@<Check the |fix_word| entries@>=
+if nonzero_fix(4*width_base) then bad('width[0] should be zero.');
+@.should be zero@>
+if nonzero_fix(4*height_base) then bad('height[0] should be zero.');
+if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.');
+if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.');
+for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width');
+@.Width n is too big@>
+for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height');
+@.Height n is too big@>
+for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth');
+@.Depth n is too big@>
+for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction');
+@.Italic correction n is too big@>
+if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
+@.Kern n is too big@>
+
+@ The ligature/kerning program comes next. Before we can put it out in
+\.{VPL} format, we need to make a table of ``labels'' that will be inserted
+into the program. For each character |c| whose |tag| is |lig_tag| and
+whose starting address is |r|, we will store the pair |(c,r)| in the
+|label_table| array. If there's a boundary-char program starting at~|r|,
+we also store the pair |(256,r)|.
+This array is sorted by its second components, using the
+simple method of straight insertion.
+
+@<Glob...@>=
+@!label_table:array[0..258] of record@t@>@/@!cc:0..256;@!rr:0..lig_size;end;
+@!label_ptr: 0..257; {the largest entry in |label_table|}
+@!sort_ptr:0..257; {index into |label_table|}
+@!boundary_char:0..256; {boundary character, or 256 if none}
+@!bchar_label:0..@'77777; {beginning of boundary character program}
+
+@ @<Set init...@>=
+boundary_char:=256; bchar_label:=@'77777;@/
+label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
+
+@ We'll also identify and remove inaccessible program steps, using the
+|activity| array.
+
+@d unreachable=0 {a program step not known to be reachable}
+@d pass_through=1 {a program step passed through on initialization}
+@d accessible=2 {a program step that can be relevant}
+
+@<Glob...@>=
+@!activity:array[0..lig_size] of unreachable..accessible;
+@!ai,@!acti:0..lig_size; {indices into |activity|}
+
+@ @<Do the ligatures and kerns@>=
+if nl>0 then
+ begin for ai:=0 to nl-1 do activity[ai]:=unreachable;
+ @<Check for a boundary char@>;
+ end;
+@<Build the label table@>;
+if nl>0 then
+ begin left; out('LIGTABLE'); out_ln;@/
+ @<Compute the |activity| array@>;
+ @<Output and correct the ligature/kern program@>;
+ right;
+ @<Check for ligature cycles@>;
+ end
+
+@ We build the label table even when |nl=0|, because this catches errors
+that would not otherwise be detected.
+
+@<Build...@>=
+for c:=bc to ec do if tag(c)=lig_tag then
+ begin r:=remainder(c);
+ if r<nl then
+ begin if tfm[lig_step(r)]>stop_flag then
+ begin r:=256*tfm[lig_step(r)+2]+tfm[lig_step(r)+3];
+ if r<nl then if activity[remainder(c)]=unreachable then
+ activity[remainder(c)]:=pass_through;
+ end;
+ end;
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for character '); print_octal(c);
+ print_ln(' is too large;'); print_ln('so I removed it.'); reset_tag(c);
+@.Ligature/kern starting index...@>
+ end
+ else @<Insert |(c,r)| into |label_table|@>;
+ end;
+label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end}
+
+@ @<Insert |(c,r)|...@>=
+begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+while label_table[sort_ptr].rr>r do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+label_table[sort_ptr+1].cc:=c;
+label_table[sort_ptr+1].rr:=r; {fill the hole}
+incr(label_ptr); activity[r]:=accessible;
+end
+
+@ @<Check for a bound...@>=
+if tfm[lig_step(0)]=255 then
+ begin left; out('BOUNDARYCHAR');
+ boundary_char:=tfm[lig_step(0)+1]; out_char(boundary_char); right;
+ activity[0]:=pass_through;
+ end;
+if tfm[lig_step(nl-1)]=255 then
+ begin r:=256*tfm[lig_step(nl-1)+2]+tfm[lig_step(nl-1)+3];
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for boundarychar is too large;');
+ print_ln('so I removed it.');
+@.Ligature/kern starting index...@>
+ end
+ else begin label_ptr:=1; label_table[1].cc:=256; label_table[1].rr:=r;
+ bchar_label:=r; activity[r]:=accessible;
+ end;
+ activity[nl-1]:=pass_through;
+ end
+
+@ @<Compute the |activity| array@>=
+for ai:=0 to nl-1 do if activity[ai]=accessible then
+ begin r:=tfm[lig_step(ai)];
+ if r<stop_flag then
+ begin r:=r+ai+1;
+ if r>=nl then
+ begin bad('Ligature/kern step ',ai:1,' skips too far;');
+@.Lig...skips too far@>
+ print_ln('I made it stop.'); tfm[lig_step(ai)]:=stop_flag;
+ end
+ else activity[r]:=accessible;
+ end;
+ end
+
+@ We ignore |pass_through| items, which don't need to be mentioned in
+the \.{VPL} file.
+
+@<Output and correct the ligature...@>=
+sort_ptr:=1; {point to the next label that will be needed}
+for acti:=0 to nl-1 do if activity[acti]<>pass_through then
+ begin i:=acti; @<Take care of commenting out unreachable steps@>;
+ @<Output any labels for step $i$@>;
+ @<Output step $i$ of the ligature/kern program@>;
+ end;
+if level=2 then right {the final step was unreachable}
+
+@ @<Output any labels...@>=
+while i=label_table[sort_ptr].rr do
+ begin left; out('LABEL');
+ if label_table[sort_ptr].cc=256 then out(' BOUNDARYCHAR')
+ else out_char(label_table[sort_ptr].cc);
+ right; incr(sort_ptr);
+ end
+
+@ @<Take care of commenting out...@>=
+if activity[i]=unreachable then
+ begin if level=1 then
+ begin left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
+ end
+ end
+else if level=2 then right
+
+@ @<Output step $i$...@>=
+begin k:=lig_step(i);
+if tfm[k]>stop_flag then
+ begin if 256*tfm[k+2]+tfm[k+3]>=nl then
+ bad('Ligature unconditional stop command address is too big.');
+@.Ligature unconditional stop...@>
+ end
+else if tfm[k+2]>=kern_flag then @<Output a kern step@>
+else @<Output a ligature step@>;
+if tfm[k]>0 then
+ if level=1 then @<Output either \.{SKIP} or \.{STOP}@>;
+end
+
+@ The \.{SKIP} command is a bit tricky, because we will be omitting all
+inaccessible commands.
+
+@<Output either...@>=
+begin if tfm[k]>=stop_flag then out('(STOP)')
+else begin count:=0;
+ for ai:=i+1 to i+tfm[k] do if activity[ai]=accessible then incr(count);
+ out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares}
+ end;
+out_ln;
+end
+
+@ @<Output a kern step@>=
+begin if nonexistent(tfm[k+1]) then if tfm[k+1]<>boundary_char then
+ correct_bad_char('Kern step for')(k+1);
+@.Kern step for nonexistent...@>
+left; out('KRN'); out_char(tfm[k+1]);
+r:=256*(tfm[k+2]-kern_flag)+tfm[k+3];
+if r>=nk then
+ begin bad('Kern index too large.');
+@.Kern index too large@>
+ out(' R 0.0');
+ end
+else out_fix(kern(r));
+right;
+end
+
+@ @<Output a ligature step@>=
+begin if nonexistent(tfm[k+1]) then if tfm[k+1]<>boundary_char then
+ correct_bad_char('Ligature step for')(k+1);
+@.Ligature step for nonexistent...@>
+if nonexistent(tfm[k+3]) then
+ correct_bad_char('Ligature step produces the')(k+3);
+@.Ligature step produces...@>
+left; r:=tfm[k+2];
+if (r=4)or((r>7)and(r<>11)) then
+ begin print_ln('Ligature step with nonstandard code changed to LIG');
+ r:=0; tfm[k+2]:=0;
+ end;
+if r mod 4>1 then out('/');
+out('LIG');
+if odd(r) then out('/');
+while r>3 do
+ begin out('>'); r:=r-4;
+ end;
+out_char(tfm[k+1]); out_char(tfm[k+3]); right;
+end
+
+@ The last thing on \.{VFtoVP}'s agenda is to go through the
+list of |char_info| and spew out the information about each individual
+character.
+
+@<Do the characters@>=
+sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments}
+for c:=bc to ec do if width_index(c)>0 then
+ begin if chars_on_line=8 then
+ begin print_ln(' '); chars_on_line:=1;
+ end
+ else begin if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+ print_octal(c); {progress report}
+ left; out('CHARACTER'); out_char(c); out_ln;
+ @<Output the character's width@>;
+ if height_index(c)>0 then @<Output the character's height@>;
+ if depth_index(c)>0 then @<Output the character's depth@>;
+ if italic_index(c)>0 then @<Output the italic correction@>;
+ case tag(c) of
+ no_tag: do_nothing;
+ lig_tag: @<Output the applicable part of the ligature/kern
+ program as a comment@>;
+ list_tag: @<Output the character link unless there is a problem@>;
+ ext_tag: @<Output an extensible character recipe@>;
+ end;@/
+ if not do_map(c) then goto final_end;
+ right;
+ end
+
+@ @<Output the character's width@>=
+begin left; out('CHARWD');
+if width_index(c)>=nw then range_error('Width')
+else out_fix(width(c));
+right;
+end
+
+@ @<Output the character's height@>=
+if height_index(c)>=nh then range_error('Height')
+@.Height index for char...@>
+else begin left; out('CHARHT'); out_fix(height(c)); right;
+ end
+
+@ @<Output the character's depth@>=
+if depth_index(c)>=nd then range_error('Depth')
+@.Depth index for char@>
+else begin left; out('CHARDP'); out_fix(depth(c)); right;
+ end
+
+@ @<Output the italic correction@>=
+if italic_index(c)>=ni then range_error('Italic correction')
+@.Italic correction index for char...@>
+else begin left; out('CHARIC'); out_fix(italic(c)); right;
+ end
+
+@ @<Output the applicable part of the ligature...@>=
+begin left; out('COMMENT'); out_ln;@/
+i:=remainder(c); r:=lig_step(i);
+if tfm[r]>stop_flag then i:=256*tfm[r+2]+tfm[r+3];
+repeat @<Output step...@>;
+if tfm[k]>=stop_flag then i:=nl
+else i:=i+1+tfm[k];
+until i>=nl;
+right;
+end
+
+@ We want to make sure that there is no cycle of characters linked together
+by |list_tag| entries, since such a cycle would get \TeX\ into an endless
+loop. If such a cycle exists, the routine here detects it when processing
+the largest character code in the cycle.
+
+@<Output the character link unless there is a problem@>=
+begin r:=remainder(c);
+if nonexistent(r) then
+ begin bad_char('Character list link to')(r); reset_tag(c);
+@.Character list link...@>
+ end
+else begin while (r<c)and(tag(r)=list_tag) do r:=remainder(r);
+ if r=c then
+ begin bad('Cycle in a character list!');
+@.Cycle in a character list@>
+ print('Character '); print_octal(c);
+ print_ln(' now ends the list.');
+ reset_tag(c);
+ end
+ else begin left; out('NEXTLARGER'); out_char(remainder(c));
+ right;
+ end;
+ end;
+end
+
+@ @<Output an extensible character recipe@>=
+if remainder(c)>=ne then
+ begin range_error('Extensible'); reset_tag(c);
+@.Extensible index for char@>
+ end
+else begin left; out('VARCHAR'); out_ln;
+ @<Output the extensible pieces that exist@>;
+ right;
+ end
+
+@ @<Output the extensible pieces that...@>=
+for k:=0 to 3 do if (k=3)or(tfm[exten(c)+k]>0) then
+ begin left;
+ case k of
+ 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
+ if nonexistent(tfm[exten(c)+k]) then out_char(c)
+ else out_char(tfm[exten(c)+k]);
+ right;
+ end
+
+@ Some of the extensible recipes may not actually be used, but \TeX\ will
+complain about them anyway if they refer to nonexistent characters.
+Therefore \.{VFtoVP} must check them too.
+
+@<Check the extensible recipes@>=
+if ne>0 then for c:=0 to ne-1 do for d:=0 to 3 do
+ begin k:=4*(exten_base+c)+d;
+ if (tfm[k]>0)or(d=3) then
+ begin if nonexistent(tfm[k]) then
+ begin bad_char('Extensible recipe involves the')(tfm[k]);
+@.Extensible recipe involves...@>
+ if d<3 then tfm[k]:=0;
+ end;
+ end;
+ end
+
+@* Checking for ligature loops.
+We have programmed almost everything but the most interesting calculation of
+all, which has been saved for last as a special treat. \TeX's extended ligature
+mechanism allows unwary users to specify sequences of ligature replacements
+that never terminate. For example, the pair of commands
+$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$
+alternately replaces character $x$ by character $y$ and vice versa. A similar
+loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and
+ \.{(LIG/ $z$ $x$)} occurs in the program for $y$.
+
+More complicated loops are also possible. For example, suppose the ligature
+programs for $x$ and $y$ are
+$$\vcenter{\halign{#\hfil\cr
+\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr
+\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$
+then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$,
+\dots, ad infinitum.
+
+@ To detect such loops, \.{VFtoVP} attempts to evaluate the function
+$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as
+follows: If the current character is $x$ and the next character is
+$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor
+first moves past $y$, the character immediately to its left is
+$f(x,y)$. This function is defined if and only if no infinite loop is
+generated when the cursor is between $x$ and~$y$.
+
+The function $f(x,y)$ can be defined recursively. It turns out that all pairs
+$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$; this
+happens if there's no ligature between $x$ and $y$, or in the cases
+\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a
+\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$;
+then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to
+either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted
+ligature character.
+
+The first two of these classes can be merged; we can also consider
+$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated.
+For technical reasons we allow $x$ to be 256 (for the boundary character
+at the left) or 257 (in cases when an error has been detected).
+
+For each pair $(x,y)$ having a ligature program step, we store
+$(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+@<Glob...@>=
+@!hash:array[0..hash_size] of 0..66048; {$256x+y+1$ for $x\le257$ and $y\le255$}
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of 0..257;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!x_lig_cycle,@!y_lig_cycle:0..256; {problematic ligature pair}
+
+@ @<Check for ligature cycles@>=
+hash_ptr:=0; y_lig_cycle:=256;
+for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table}
+for c:=bc to ec do if tag(c)=lig_tag then
+ begin i:=remainder(c);
+ if tfm[lig_step(i)]>stop_flag then
+ i:=256*tfm[lig_step(i)+2]+tfm[lig_step(i)+3];
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if bchar_label<nl then
+ begin c:=256; i:=bchar_label;
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if hash_ptr=hash_size then
+ begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ goto final_end;
+ end;
+for hh:=1 to hash_ptr do
+ begin r:=hash_list[hh];
+ if class[r]>simple then {make sure $f$ is defined}
+ r:=f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);
+ end;
+if y_lig_cycle<256 then
+ begin print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=256 then print('boundary')@+else print_octal(x_lig_cycle);
+ print(' and '); print_octal(y_lig_cycle); print_ln('!');
+ out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
+ end
+
+@ @<Enter data for character $c$...@>=
+repeat hash_input; k:=tfm[lig_step(i)];
+if k>=stop_flag then i:=nl
+else i:=i+1+k;
+until i>=nl
+
+@ We use an ``ordered hash table'' with linear probing, because such a table
+is efficient when the lookup of a random key tends to be unsuccessful.
+
+@p procedure hash_input; {enter data for character |c| and command |i|}
+label exit;
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:0..255; {function value or ligature character being entered}
+@!y:0..255; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then return;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=256*c+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then return; {unused ligature command}
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+exit:end;
+
+@ We must store kern commands as well as ligature commands, because the former
+might make the latter inapplicable.
+
+@<Compute the command param...@>=
+k:=lig_step(i); y:=tfm[k+1]; t:=tfm[k+2]; cc:=simple; zz:=tfm[k+3];
+if t>=kern_flag then zz:=y
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures.
+Kind of a neat algorithm, generalizing a depth-first search.
+
+@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=256*x+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:index):index| here.
+
+@p function f;
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=257; class[h]:=simple;
+ end; {the value 257 will break all cycles, since it's not in |hash|}
+end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@* Outputting the VF info.
+The routines we've used for output from the |tfm| array have counterparts
+for output from |vf|. One difference is that the string outputs from |vf|
+need to be checked for balanced parentheses. The |string_balance| routine
+tests the string of length~|l| that starts at location~|k|.
+
+@p function string_balance(@!k,@!l:integer):boolean;
+label not_found,exit;
+var @!j,@!bal:integer;
+begin if l>0 then if vf[k]=" " then goto not_found;
+ {a leading blank is considered unbalanced}
+bal:=0;
+for j:=k to k+l-1 do
+ begin if (vf[j]<" ")or(vf[j]>=127) then goto not_found;
+ if vf[j]="(" then incr(bal)
+ else if vf[j]=")" then
+ if bal=0 then goto not_found else decr(bal);
+ end;
+if bal>0 then goto not_found;
+string_balance:=true; return;
+not_found:string_balance:=false;
+exit:end;
+
+@ @d bad_vf(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print_ln('Bad VF file: ',#);
+ end
+@.Bad VF file@>
+
+@<Do the virtual font title@>=
+if string_balance(0,font_start[0]) then
+ begin left; out('VTITLE ');
+ for k:=0 to font_start[0]-1 do out(xchr[vf[k]]);
+ right;
+ end
+else bad_vf('Title is not a balanced ASCII string')
+@.Title is not balanced@>
+
+@ We can re-use some code by moving |fix_word| data to |tfm|, using the
+fact that the design size has already been output.
+
+@p procedure out_as_fix(@!x:integer);
+var @!k:1..3;
+begin if abs(x)>=@'100000000 then
+ begin bad_vf('Oversize dimension has been reset to zero.');
+@.Oversize dimension...@>
+ x:=0;
+ end;
+if x>=0 then tfm[design_size]:=0
+else begin tfm[design_size]:=255; x:=x+@'100000000;
+ end;
+for k:=3 downto 1 do
+ begin tfm[design_size+k]:=x mod 256; x:=x div 256;
+ end;
+out_fix(design_size);
+end;
+
+@ @<Do the local fonts@>=
+for f:=0 to font_ptr-1 do
+ begin left; out('MAPFONT D ',f:1); out_ln;
+ @<Output the font area and name@>;
+ for k:=0 to 11 do tfm[k]:=vf[font_start[f]+k];
+ if tfm[0]+tfm[1]+tfm[2]+tfm[3]>0 then
+ begin left; out('FONTCHECKSUM'); out_octal(0,4); right;
+ end;
+ left; out('FONTAT'); out_fix(4); right;
+ left; out('FONTDSIZE'); out_fix(8); right; right;
+ end
+
+@ @<Output the font area and name@>=
+a:=vf[font_start[f]+12]; l:=vf[font_start[f]+13];
+if a>0 then
+ if not string_balance(font_start[f]+14,a) then
+ bad_vf('Improper font area will be ignored')
+@.Improper font area@>
+ else begin left; out('FONTAREA ');
+ for k:=font_start[f]+14 to font_start[f]+a+13 do out(xchr[vf[k]]);
+ right;
+ end;
+if (l=0)or not string_balance(font_start[f]+14+a,l) then
+ bad_vf('Improper font name will be ignored')
+@.Improper font name@>
+else begin left; out('FONTNAME ');
+ for k:=font_start[f]+14+a to font_start[f]+a+l+13 do out(xchr[vf[k]]);
+ right;
+ end
+
+@ Now we get to the interesting part of \.{VF} output, where \.{DVI}
+commands are translated into symbolic form. The \.{VPL} language is a subset
+of \.{DVI}, so we sometimes need to output semantic equivalents of
+the commands instead of producing a literal translation. This causes a
+small but tolerable loss of efficiency. We need to simulate the stack
+used by \.{DVI}-reading software.
+
+@<Glob...@>=
+@!top:0..max_stack; {\.{DVI} stack pointer}
+@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of integer;
+ {stacked values of \.{DVI} registers |w|, |x|, |y|, |z|}
+@!vf_limit:0..vf_size; {the current packet ends here}
+@!o:byte; {the current opcode}
+
+@ @<Do the packet for character |c|@>=
+if packet_start[c]=vf_size then
+ bad_vf('Missing packet for character ',c:1)
+@.Missing packet@>
+else begin left; out('MAP'); out_ln;
+ top:=0; wstack[0]:=0; xstack[0]:=0; ystack[0]:=0; zstack[0]:=0;
+ vf_ptr:=packet_start[c]; vf_limit:=packet_end[c]+1; f:=0;
+ while vf_ptr<vf_limit do
+ begin o:=vf[vf_ptr]; incr(vf_ptr);
+ case o of
+ @<Cases of \.{DVI} instructions that can appear in character packets@>@;
+ improper_DVI_for_VF: bad_vf('Illegal DVI code ',o:1,' will be ignored');
+ end; {there are no other cases}
+ end;
+ if top>0 then
+ begin bad_vf('More pushes than pops!');
+@.More pushes than pops@>
+ repeat out('(POP)'); decr(top);@+until top=0;
+ end;
+ right;
+ end
+
+@ A procedure called |get_bytes| helps fetch the parameters of \.{DVI} commands.
+
+@p function get_bytes(@!k:integer;@!signed:boolean):integer;
+var @!a:integer; {accumulator}
+begin if vf_ptr+k>vf_limit then
+ begin bad_vf('Packet ended prematurely'); k:=vf_limit-vf_ptr;
+ end;
+a:=vf[vf_ptr];
+if (k=4) or signed then
+ if a>=128 then a:=a-256;
+incr(vf_ptr);
+while k>1 do
+ begin a:=a*256+vf[vf_ptr]; incr(vf_ptr); decr(k);
+ end;
+get_bytes:=a;
+end;
+
+@ Let's look at the simplest cases first, in order to get some experience.
+
+@d four_cases(#)==#,#+1,#+2,#+3
+@d eight_cases(#)==four_cases(#),four_cases(#+4)
+@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
+@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
+@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
+
+@<Cases...@>=
+nop:do_nothing;
+push:begin if top=max_stack then
+ begin print_ln('Stack overflow!'); goto final_end;
+@.Stack overflow@>
+ end;
+ incr(top); wstack[top]:=wstack[top-1]; xstack[top]:=xstack[top-1];
+ ystack[top]:=ystack[top-1]; zstack[top]:=zstack[top-1]; out('(PUSH)');
+ out_ln;
+ end;
+pop:if top=0 then bad_vf('More pops than pushes!')
+@.More pops than pushes@>
+ else begin decr(top); out('(POP)'); out_ln;
+ end;
+set_rule,put_rule:begin if o=put_rule then out('(PUSH)');
+ left; out('SETRULE'); out_as_fix(get_bytes(4,true));
+ out_as_fix(get_bytes(4,true));
+ if o=put_rule then out(')(POP');
+ right;
+ end;
+
+@ Horizontal and vertical motions become \.{RIGHT} and \.{DOWN} in \.{VPL}
+lingo.
+
+@<Cases...@>=
+four_cases(right1):begin out('(MOVERIGHT');
+ out_as_fix(get_bytes(o-right1+1,true));
+ out(')'); out_ln;@+end;
+w0,four_cases(w1):begin if o<>w0 then wstack[top]:=get_bytes(o-w1+1,true);
+ out('(MOVERIGHT'); out_as_fix(wstack[top]); out(')'); out_ln;@+end;
+x0,four_cases(x1):begin if o<>x0 then xstack[top]:=get_bytes(o-x1+1,true);
+ out('(MOVERIGHT'); out_as_fix(xstack[top]); out(')'); out_ln;@+end;
+four_cases(down1):begin out('(MOVEDOWN'); out_as_fix(get_bytes(o-down1+1,true));
+ out(')'); out_ln;@+end;
+y0,four_cases(y1):begin if o<>y0 then ystack[top]:=get_bytes(o-y1+1,true);
+ out('(MOVEDOWN'); out_as_fix(ystack[top]); out(')'); out_ln;@+end;
+z0,four_cases(z1):begin if o<>z0 then zstack[top]:=get_bytes(o-z1+1,true);
+ out('(MOVEDOWN'); out_as_fix(zstack[top]); out(')'); out_ln;@+end;
+
+@ Variable |f| always refers to the current font. If |f=font_ptr|, it's
+a font that hasn't been defined (so its characters will be ignored).
+
+@<Cases...@>=
+sixty_four_cases(fnt_num_0),four_cases(fnt1):begin f:=0;
+ if o>=fnt1 then font_number[font_ptr]:=get_bytes(o-fnt1+1,false)
+ else font_number[font_ptr]:=o-fnt_num_0;
+ while font_number[f]<>font_number[font_ptr] do incr(f);
+ if f=font_ptr then bad_vf('Undeclared font selected')
+@.Undeclared font selected@>
+ else begin out('(SELECTFONT D ',f:1,')'); out_ln;
+ end;
+ end;
+
+@ Before we typeset a character we make sure that it exists.
+
+@<Cases...@>=
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
+ four_cases(set1),four_cases(put1):begin if o>=set1 then
+ if o>=put1 then c:=get_bytes(o-put1+1,false)
+ else c:=get_bytes(o-set1+1,false)
+ else c:=o;
+ if f=font_ptr then
+ bad_vf('Character ',c:1,' in undeclared font will be ignored')
+@.Character...will be ignored@>
+ else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+ k:=font_chars[f];@+while vf[k]<>c do incr(k);
+ if k=font_start[f+1]-1 then
+ bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
+ else begin if o>=put1 then out('(PUSH)');
+ left; out('SETCHAR'); out_char(c);
+ if o>=put1 then out(')(POP');
+ right;
+ end;
+ end;
+ end;
+
+@ The ``special'' commands are the only ones remaining to be dealt with.
+We use a hexadecimal
+output in the general case, if a simple string would be inadequate.
+
+@d out_hex(#)==begin a:=#;
+ if a<10 then out(a:1)
+ else out(xchr[a-10+"A"]);
+ end
+
+@<Cases...@>=
+four_cases(xxx1):begin k:=get_bytes(o-xxx1+1,false);
+ if k<0 then bad_vf('String of negative length!')
+ else begin left;
+ if k+vf_ptr>vf_limit then
+ begin bad_vf('Special command truncated to packet length');
+ k:=vf_limit-vf_ptr;
+ end;
+ if (k>64)or not string_balance(vf_ptr,k) then
+ begin out('SPECIALHEX ');
+ while k>0 do
+ begin if k mod 32=0 then out_ln
+ else if k mod 4=0 then out(' ');
+ out_hex(vf[vf_ptr] div 16); out_hex(vf[vf_ptr] mod 16);
+ incr(vf_ptr); decr(k);
+ end;
+ end
+ else begin out('SPECIAL ');
+ while k>0 do
+ begin out(xchr[vf[vf_ptr]]); incr(vf_ptr); decr(k);
+ end;
+ end;
+ right;
+ end;
+ end;
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+First come the |vf_input| and |organize| procedures, which read the input data
+and get ready for subsequent events. If something goes wrong, the routines
+return |false|.
+
+@p function vf_input:boolean;
+label final_end, exit;
+var vf_ptr:0..vf_size; {an index into |vf|}
+@!k:integer; {all-purpose index}
+@!c:integer; {character code}
+begin @<Read the whole \.{VF} file@>;
+vf_input:=true; return;
+final_end: vf_input:=false;
+exit: end;
+@#
+function organize:boolean;
+label final_end, exit;
+var tfm_ptr:index; {an index into |tfm|}
+begin @<Read the whole \.{TFM} file@>;
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;
+@<Compute the base addresses@>;
+organize:=vf_input; return;
+final_end: organize:=false;
+exit: end;
+
+@ Next we do the simple things.
+
+@p procedure do_simple_things;
+var i:0..@'77777; {an index to words of a subfile}
+@!f:0..vf_size; {local font number}
+@!k:integer; {all-purpose index}
+begin @<Do the virtual font title@>;
+@<Do the header@>;
+@<Do the parameters@>;
+@<Do the local fonts@>;
+@<Check the |fix_word| entries@>;
+end;
+
+@ And then there's a routine for individual characters.
+
+@p function do_map(@!c:byte):boolean;
+label final_end,exit;
+var @!k:integer;
+@!f:0..vf_size; {current font number}
+begin @<Do the packet for character |c|@>;
+do_map:=true; return;
+final_end: do_map:=false;
+exit:end;
+@#
+function do_characters:boolean;
+label final_end, exit;
+var @!c:byte; {character being done}
+@!k:index; {a random index}
+@!ai:0..lig_size; {index into |activity|}
+begin @<Do the characters@>;@/
+do_characters:=true; return;
+final_end: do_characters:=false;
+exit:end;
+
+@ Here is where \.{VFtoVP} begins and ends.
+@p begin initialize;@/
+if not organize then goto final_end;
+do_simple_things;@/
+@<Do the ligatures and kerns@>;
+@<Check the extensible recipes@>;
+if not do_characters then goto final_end;
+print_ln('.');@/
+if level<>0 then print_ln('This program isn''t working!');
+@.This program isn't working@>
+if not perfect then
+ begin out('(COMMENT THE TFM AND/OR VF FILE WAS BAD, ');
+ out('SO THE DATA HAS BEEN CHANGED!)');
+ write_ln(vpl_file);
+ end;
+@.THE TFM AND/OR VF FILE WAS BAD...@>
+final_end:end.
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{VFtoVP} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/vptovf.ch b/Build/source/texk/web2c/vptovf.ch
new file mode 100644
index 00000000000..667d0e59a87
--- /dev/null
+++ b/Build/source/texk/web2c/vptovf.ch
@@ -0,0 +1,301 @@
+% vptovf.ch for C compilation with web2c.
+
+@x [0] WEAVE: print changes only.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{VP$\,$\lowercase{to}$\,$VF changes for C}
+@z
+
+@x [2] Print the banner later.
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+@z
+
+@x [3] Increase constants.
+@!buf_size=60; {length of lines displayed in error messages}
+@!max_header_bytes=100; {four times the maximum number of words allowed in
+ the \.{TFM} file header block, must be 1024 or less}
+@!vf_size=10000; {maximum length of |vf| data, in bytes}
+@!max_stack=100; {maximum depth of simulated \.{DVI} stack}
+@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed}
+@!max_lig_steps=5000;
+ {maximum length of ligature program, must be at most $32767-257=32510$}
+@!max_kerns=500; {the maximum number of distinct kern values}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@y
+@!buf_size=3000; {length of lines displayed in error messages}
+@!max_header_bytes=1000; {four times the maximum number of words allowed in
+ the \.{TFM} file header block, must be 1024 or less}
+@!vf_size=100000; {maximum length of |vf| data, in bytes}
+@!max_stack=100; {maximum depth of simulated \.{DVI} stack}
+@!max_param_words=300; {the maximum number of \.{fontdimen} parameters allowed}
+@!max_lig_steps=32510;
+ {maximum length of ligature program, must be at most $32767-257=32510$}
+@!max_kerns=5000; {the maximum number of distinct kern values}
+@!hash_size=32579; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+@z
+
+@x [6] Open VPL file.
+reset(vpl_file);
+@y
+reset (vpl_file, vpl_name);
+if verbose then begin
+ print (banner);
+ print_ln (version_string);
+end;
+@z
+
+@x [22] Open output files.
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(vf_file); rewrite(tfm_file);
+@y
+@ On some systems you may have to do something special to write a
+packed file of bytes.
+@^system dependencies@>
+
+@<Set init...@>=
+rewritebin (vf_file, vf_name);
+rewritebin (tfm_file, tfm_name);
+@z
+
+% [89] `index' is not a good choice for an identifier on Unix systems.
+% Neither is `class', on AIX.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+|k|th element of its list.
+@y
+|k|th element of its list.
+
+@d index == index_var
+@d class == class_var
+@z
+
+@x [118] No output unless verbose.
+@<Print |c| in octal notation@>;
+@y
+if verbose then @<Print |c| in octal notation@>;
+@z
+
+@x [144] Output of real numbers.
+@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
+@.I had to round...@>
+ #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
+@y
+@ @d round_message(#)==if delta>0 then begin print('I had to round some ',
+@.I had to round...@>
+ #,'s by '); print_real((((delta+1) div 2)/@'4000000),1,7);
+ print_ln(' units.'); end
+@z
+
+@x [152] Fix up the mutually recursive procedures a la pltotf.
+@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+@y
+@p
+ifdef('notdef')
+function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+endif('notdef')
+@z
+
+@x [153] Finish fixing up f.
+@p function f;
+@y
+@p function f(@!h,@!x,@!y:indx):indx;
+@z
+
+@x [156] Change TFM-byte output to fix ranges.
+@d out(#)==write(tfm_file,#)
+@y
+@d out(#)==putbyte(#,tfm_file)
+@z
+
+@x [165] Fix output of reals.
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if abs(x/design_units)>=16.0 then
+ begin print_ln('The relative dimension ',x/@'4000000:1:3,
+ ' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then print(' =',design_units/@'200000:1:3,
+ ' designunits');
+@y
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if fabs(x/design_units)>=16.0 then
+ begin print('The relative dimension ');
+ print_real(x/@'4000000,1,3);
+ print_ln(' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then begin print(' =');
+ print_real(design_units/@'200000,1,3);
+ print(' designunits');
+ end;
+@z
+
+% [141] char_remainder[c] is unsigned, and label_table[sort_ptr].rr
+% might be -1, and if -1 is coerced to being unsigned, it will be bigger
+% than anything else.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ while label_table[sort_ptr].rr>char_remainder[c] do
+@y
+ while label_table[sort_ptr].rr>intcast(char_remainder[c]) do
+@z
+
+@x [175] Change VF-byte output to fix ranges.
+@d vout(#)==write(vf_file,#)
+@y
+@d vout(#)==putbyte(#,vf_file)
+@z
+
+@x [181] Be quiet unless verbose.
+read_input; print_ln('.');@/
+@y
+read_input;
+if verbose then print_ln('.');
+@z
+
+@x [182] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{VPtoVF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 3; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Initialize the option variables@>;
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('vptovf'); {|getopt| has already given an error message.}
+
+ end else if argument_is ('help') then begin
+ usage_help (VPTOVF_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.E. Knuth');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.
+ We must have one to three remaining arguments.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc)
+ and (optind + 3 <> argc) then begin
+ write_ln (stderr, 'vptovf: Need one to three file arguments.');
+ usage ('vptovf');
+ end;
+
+ vpl_name := extend_filename (cmdline (optind), 'vpl');
+
+ if optind + 2 <= argc then begin
+ {Specified one or both of the output files.}
+ vf_name := extend_filename (cmdline (optind + 1), 'vf');
+ if optind + 3 <= argc then begin {Both.}
+ tfm_name := extend_filename (cmdline (optind + 2), 'tfm');
+ end else begin {Just one.}
+ tfm_name := extend_filename (cmdline (optind + 1), 'tfm');
+ end;
+ end else begin {Neither.}
+ vf_name := basename_change_suffix (vpl_name, '.vpl', '.vf');
+ tfm_name := basename_change_suffix (vpl_name, '.vpl', '.tfm');
+ end;
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Print progress information?
+@.-verbose@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'verbose';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (verbose);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@ The global variable |verbose| determines whether or not we print
+progress information.
+
+@<Glob...@> =
+@!verbose: c_int_type;
+
+@ It starts off |false|.
+
+@<Initialize the option...@> =
+verbose := false;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!vpl_name, @!tfm_name, @!vf_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/vptovf.rc b/Build/source/texk/web2c/vptovf.rc
new file mode 100644
index 00000000000..c1697d51f89
--- /dev/null
+++ b/Build/source/texk/web2c/vptovf.rc
@@ -0,0 +1,34 @@
+/* vptovf.rc: vptovf resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " vptovf 1.5"
+
+#define VER_INTERNALNAME_STR "vptovf"
+#define VER_ORIGINALFILENAME_STR "vptovf.exe"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#define VER_FILEDESCRIPTION_STR "VP-to-VF file converter"
+
+#include <texlive.version>
+
+/* vptovf.rc ends here */
diff --git a/Build/source/texk/web2c/vptovf.web b/Build/source/texk/web2c/vptovf.web
new file mode 100644
index 00000000000..b5d6aff66d6
--- /dev/null
+++ b/Build/source/texk/web2c/vptovf.web
@@ -0,0 +1,3177 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was implemented in December 1989.
+% Version 1.1 fixed some for-loop indices for stricter Pascal (April 1990).
+% Version 1.2 fixed `nonexistent char 0' bug, and a bit more (September 1990).
+% Version 1.3 has more robust `out_scaled' (March 1991).
+% Version 1.4 (March 1995) initialized lk_step_ended (Armin K\"ollner).
+% Version 1.5 (August 1998) corrected vf_fix(0) (Wayne Sullivan).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=logo10 % for the METAFONT logo
+\def\MF{{\logo METAFONT}}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{VP\lowercase{to}VF}
+\def\contentspagenumber{201}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont VPtoVF} processor}
+ \vskip 15pt
+ \centerline{(Version 1.5, August 1998)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this program
+ was supported in part by the National Science
+ Foundation and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{VPtoVF} utility program converts virtual-property-list (``\.{VPL}'')
+files into an equivalent pair of files called a virtual font (``\.{VF}'') file
+and a \TeX\ font metric (``\.{TFM}'') file. It also makes a thorough check
+of the given \.{VPL} file, so that the \.{VF} file should be acceptable to
+device drivers and the \.{TFM} file should be acceptable to \TeX.
+
+\indent\.{VPtoVF} is an extended version of the program \.{PLtoTF}, which
+is part of the standard \TeX ware library.
+The idea of a virtual font was inspired by the work of David R. Fuchs
+@^Fuchs, David Raymond@>
+who designed a similar set of conventions in 1984 while developing a
+device driver for ArborText, Inc. He wrote a somewhat similar program
+called \.{PLFONT}.
+
+The |banner| string defined here should be changed whenever \.{VPtoVF}
+gets modified.
+
+@d banner=='This is VPtoVF, Version 1.5' {printed when the program starts}
+
+@ This program is written entirely in standard \PASCAL, except that
+it has to do some slightly system-dependent character code conversion
+on input. Furthermore, lower case letters are used in error messages;
+they could be converted to upper case if necessary. The input is read
+from |vpl_file|, and the output is written on |vf_file| and |tfm_file|;
+error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program VPtoVF(@!vpl_file,@!vf_file,@!tfm_file,@!output);
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{VPtoVF}'s capacity.
+
+@<Constants...@>=
+@!buf_size=60; {length of lines displayed in error messages}
+@!max_header_bytes=100; {four times the maximum number of words allowed in
+ the \.{TFM} file header block, must be 1024 or less}
+@!vf_size=10000; {maximum length of |vf| data, in bytes}
+@!max_stack=100; {maximum depth of simulated \.{DVI} stack}
+@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed}
+@!max_lig_steps=5000;
+ {maximum length of ligature program, must be at most $32767-257=32510$}
+@!max_kerns=500; {the maximum number of distinct kern values}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* Property list description of font metric data.
+The idea behind \.{VPL} files is that precise details about fonts, i.e., the
+facts that are needed by typesetting routines like \TeX, sometimes have to
+be supplied by hand. The nested property-list format provides a reasonably
+convenient way to do this.
+
+A good deal of computation is necessary to parse and process a
+\.{VPL} file, so it would be inappropriate for \TeX\ itself to do this
+every time it loads a font. \TeX\ deals only with the compact descriptions
+of font metric data that appear in \.{TFM} files. Such data is so compact,
+however, it is almost impossible for anybody but a computer to read it.
+
+Device drivers also need a compact way to describe mappings from \TeX's idea
+of a font to the actual characters a device can produce. They can do this
+conveniently when given a packed sequence of bytes called a \.{VF} file.
+
+The purpose of \.{VPtoVF} is to convert from a human-oriented file of text
+to computer-oriented files of binary numbers. There's a companion program,
+\.{VFtoVP}, which goes the other way.
+
+@<Glob...@>=
+@!vpl_file:text;
+
+@ @<Set init...@>=
+reset(vpl_file);
+
+@ A \.{VPL} file is like a \.{PL} file with a few extra features, so we
+can begin to define it by reviewing the definition of \.{PL} files. The
+material in the next few sections is copied from the program \.{PLtoTF}.
+
+A \.{PL} file is a list of entries of the form
+$$\.{(PROPERTYNAME VALUE)}$$
+where the property name is one of a finite set of names understood by
+this program, and the value may itself in turn be a property list.
+The idea is best understood by looking at an example, so let's consider
+a fragment of the \.{PL} file for a hypothetical font.
+$$\vbox{\halign{\.{#}\hfil\cr
+(FAMILY NOVA)\cr
+(FACE F MIE)\cr
+(CODINGSCHEME ASCII)\cr
+(DESIGNSIZE D 10)\cr
+(DESIGNUNITS D 18)\cr
+(COMMENT A COMMENT IS IGNORED)\cr
+(COMMENT (EXCEPT THIS ONE ISN'T))\cr
+(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr
+\qquad\qquad IT SAYS IT ISN'T))\cr
+(FONTDIMEN\cr
+\qquad (SLANT R -.25)\cr
+\qquad (SPACE D 6)\cr
+\qquad (SHRINK D 2)\cr
+\qquad (STRETCH D 3)\cr
+\qquad (XHEIGHT R 10.55)\cr
+\qquad (QUAD D 18)\cr
+\qquad )\cr
+(LIGTABLE\cr
+\qquad (LABEL C f)\cr
+\qquad (LIG C f O 200)\cr
+\qquad (SKIP D 1)\cr
+\qquad (LABEL O 200)\cr
+\qquad (LIG C i O 201)\cr
+\qquad (KRN O 51 R 1.5)\cr
+\qquad (/LIG C ? C f)\cr
+\qquad (STOP)\cr
+\qquad )\cr
+(CHARACTER C f\cr
+\qquad (CHARWD D 6)\cr
+\qquad (CHARHT R 13.5)\cr
+\qquad (CHARIC R 1.5)\cr
+\qquad )\cr}}$$
+This example says that the font whose metric information is being described
+belongs to the hypothetical
+\.{NOVA} family; its face code is medium italic extended;
+and the characters appear in ASCII code positions. The design size is 10 points,
+and all other sizes in this \.{PL} file are given in units such that 18 units
+equals the design size. The font is slanted with a slope of $-.25$ (hence the
+letters actually slant backward---perhaps that is why the family name is
+\.{NOVA}). The normal space between words is 6 units (i.e., one third of
+the 18-unit design size), with glue that shrinks by 2 units or stretches by 3.
+The letters for which accents don't need to be raised or lowered are 10.55
+units high, and one em equals 18 units.
+
+The example ligature table is a bit trickier. It specifies that the
+letter \.f followed by another \.f is changed to code @'200, while
+code @'200 followed by \.i is changed to @'201; presumably codes @'200
+and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases
+\.f and @'200, if the following character is the code @'51 (which is a
+right parenthesis), an additional 1.5 units of space should be inserted
+before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or
+\.{KRN} command, which in this case is the second \.{LIG}; in this way
+two different ligature/kern programs can come together.)
+Finally, if either \.f or @'200 is followed by a question mark,
+the question mark is replaced by \.f and the ligature program is
+started over. (Thus, the character pair `\.{f?}' would actually become
+the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To
+avoid this restart procedure, the \.{/LIG} command could be replaced
+by \.{/LIG>}; then `\.{f?}' would become `f\kern0ptf' and `\.{f?f}'
+would become `f\kern0ptff'.)
+
+Character \.f itself is 6 units wide and 13.5 units tall, in this example.
+Its depth is zero (since \.{CHARDP} is not given), and its italic correction
+is 1.5 units.
+
+@ The example above illustrates most of the features found in \.{PL} files.
+Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a
+string as their value; this string continues until the first unmatched
+right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT}
+and \.{LABEL}, take a number as their value. This number can be expressed in
+a variety of ways, indicated by a prefixed code; \.D stands for decimal,
+\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and
+\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as
+their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and
+\.{CHARACTER}, have more complicated values that involve property lists.
+
+A property name is supposed to be used only in an appropriate property
+list. For example, \.{CHARWD} shouldn't occur on the outer level or
+within \.{FONTDIMEN}.
+
+The individual property-and-value pairs in a property list can appear in
+any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the example
+above, although the \.{TFM} file always puts the stretch parameter first.
+One could even give the information about characters like `\.f' before
+specifying the number of units in the design size, or before specifying the
+ligature and kerning table. However, the \.{LIGTABLE} itself is an exception
+to this rule; the individual elements of the \.{LIGTABLE} property list
+can be reordered only to a certain extent without changing the meaning
+of that table.
+
+If property-and-value pairs are omitted, a default value is used. For example,
+we have already noted that the default for \.{CHARDP} is zero. The default
+for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated
+below.
+
+If the same property name is used more than once, \.{VPtoVF} will not notice
+the discrepancy; it simply uses the final value given. Once again, however, the
+\.{LIGTABLE} is an exception to this rule; \.{VPtoVF} will complain if there
+is more than one label for some character. And of course many of the
+entries in the \.{LIGTABLE} property list have the same property name.
+
+@ A \.{VPL} file also includes information about how to create each character,
+by typesetting characters from other fonts and/or by drawing lines, etc.
+Such information is the value of the `\.{MAP}' property, which can be
+illustrated as follows:
+$$\vbox{\halign{\.{#}\hfil\cr
+(MAPFONT D 0 (FONTNAME Times-Roman))\cr
+(MAPFONT D 1 (FONTNAME Symbol))\cr
+(MAPFONT D 2 (FONTNAME cmr10)(FONTAT D 20))\cr
+(CHARACTER O 0 (MAP (SELECTFONT D 1)(SETCHAR C G)))\cr
+(CHARACTER O 76 (MAP (SETCHAR O 277)))\cr
+(CHARACTER D 197 (MAP\cr
+\qquad(PUSH)(SETCHAR C A)(POP)\cr
+\qquad(MOVEUP R 0.937)(MOVERIGHT R 1.5)(SETCHAR O 312)))\cr
+(CHARACTER O 200 (MAP (MOVEDOWN R 2.1)(SETRULE R 1 R 8)))\cr
+(CHARACTER O 201 (MAP\cr
+\qquad (SPECIAL ps: /SaveGray currentgray def .5 setgray)\cr
+\qquad (SELECTFONT D 2)(SETCHAR C A)\cr
+\qquad (SPECIAL ps: SaveGray setgray)))\cr
+}}$$
+(These specifications appear in addition to the conventional \.{PL}
+information. The \.{MAP} attribute can be mixed in with other attributes
+like \.{CHARWD} or it can be given separately.)
+
+In this example, the virtual font is composed of characters that can be
+fabricated from three actual fonts, `\.{Times-Roman}',
+`\.{Symbol}', and `\.{cmr10} \.{at} \.{20\\u}' (where \.{\\u}
+is the unit size in this \.{VPL} file). Character |@'0| is typeset as
+a `G' from the symbol font. Character |@'76| is typeset as character |@'277|
+from the ordinary Times font. (If no other font is selected, font
+number~0 is the default. If no \.{MAP} attribute is given, the default map
+is a character of the same number in the default font.)
+
+Character 197 (decimal) is more interesting: First an A is typeset (in the
+default font Times), and this is enclosed by \.{PUSH} and \.{POP} so that
+the original position is restored. Then the accent character |@'312| is
+typeset, after moving up .937 units and right 1.5 units.
+
+To typeset character |@'200| in this virtual font, we move down 2.1 units,
+then typeset a rule that is 1 unit high and 8 units wide.
+
+Finally, to typeset character |@'201|, we do something that requires a
+special ability to interpret PostScript commands; this example
+sets the PostScript ``color'' to 50\char`\%\ gray and typesets an `A'
+from \.{cmr10} \.{at} \.{20\\u} in that color.
+
+In general, the \.{MAP} attribute of a virtual character can be any sequence
+of typesetting commands that might appear in a page of a \.{DVI} file.
+A single character might map into an entire page.
+
+@ But instead of relying on a hypothetical example, let's consider a complete
+grammar for \.{VPL} files, beginning with the (unchanged) grammatical rules
+for \.{PL} files. At the outer level, the following property names
+are valid in any \.{PL} file:
+
+\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a
+nonnegative integer less than $2^{32}$, is used to identify a particular
+version of a font; it should match the check sum value stored with the font
+itself. An explicit check sum of zero is used to bypass
+check sum testing. If no checksum is specified in the \.{VPL} file,
+\.{VPtoVF} will compute the checksum that \MF\ would compute from the
+same data.
+
+\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which
+should be a real number in the range |1.0<=x<2048|, represents the default
+amount by which all quantities will be scaled if the font is not loaded
+with an `\.{at}' specification. For example, if one says
+`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM}
+file is ignored and effectively replaced by 15 points; but if one simply
+says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is
+always in units of printer's points.
+
+\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value
+should be a positive real number; it says how many units equals the design
+size (or the eventual `\.{at}' size, if the font is being scaled). For
+example, suppose you have a font that has been digitized with 600 pixels per
+em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}'
+if you wanted to give all of your measurements in units of pixels.
+
+\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 40.
+It identifies the correspondence between the numeric codes and font characters.
+(\TeX\ ignores this information, but other software programs make use of it.)
+
+\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 20.
+It identifies the name of the family to which this font belongs, e.g.,
+`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for
+example, when converting \.{DVI} files to \.{PRESS} files for Xerox
+equipment.)
+
+\yskip\hang\.{FACE} (one-byte value). This number, which must lie between
+0 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its
+family. For example, bold italic condensed fonts might have the same family name
+as light roman extended fonts, differing only in their face byte. (\TeX\
+ignores this information; but it is needed, for example, when converting
+\.{DVI} files to \.{PRESS} files for Xerox equipment.)
+
+\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The
+value should start with either `\.T' (true) or `\.F' (false). If true, character
+codes less than 128 cannot lead to codes of 128 or more via ligatures or
+charlists or extensible characters. (\TeX82 ignores this flag, but older
+versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.)
+\.{VPtoVF} computes the correct value of this flag and gives an error message
+only if a claimed ``true'' value is incorrect.
+
+\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value).
+The one-byte value should be between 18 and a maximum limit that can be
+raised or lowered depending on the compile-time setting of |max_header_bytes|.
+The four-byte value goes into the header word whose index is the one-byte
+value; for example, to set |header[18]:=1|, one may write
+`\.{(HEADER D 18 O 1)}'. This notation is used for header information that
+is presently unnamed. (\TeX\ ignores it.)
+
+\yskip\hang\.{FONTDIMEN} (property list value). See below for the names
+allowed in this property list.
+
+\yskip\hang\.{LIGTABLE} (property list value). See below for the rules
+about this special kind of property list.
+
+\yskip\hang\.{BOUNDARYCHAR} (one-byte value). If this character appears in
+a \.{LIGTABLE} command, it matches ``end of word'' as well as itself.
+If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs
+within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning.
+
+\yskip\hang\.{CHARACTER}. The value is a one-byte integer followed by
+a property list. The integer represents the number of a character that is
+present in the font; the property list of a character is defined below.
+The default is an empty property list.
+
+@ Numeric property list values can be given in various forms identified by
+a prefixed letter.
+
+\yskip\hang\.C denotes an ASCII character, which should be a standard visible
+character that is not a parenthesis. The numeric value will therefore be
+between @'41 and @'176 but not @'50 or @'51.
+
+\yskip\hang\.D denotes an unsigned decimal integer, which must be
+less than $2^{32}$, i.e., at most `\.{D 4294967295}'.
+
+\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes
+are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC},
+\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE},
+\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively.
+
+\yskip\hang\.O denotes an unsigned octal integer, which must be less than
+$2^{32}$, i.e., at most `\.{O 37777777777}'.
+
+\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than
+$2^{32}$, i.e., at most `\.{H FFFFFFFF}'.
+
+\yskip\hang\.R denotes a real number in decimal notation, optionally preceded
+by a `\.+' or `\.-' sign, and optionally including a decimal point. The
+absolute value must be less than 2048.
+
+@ The property names allowed in a \.{FONTDIMEN} property list correspond to
+various \TeX\ parameters, each of which has a (real) numeric value. All
+of the parameters except \.{SLANT} are in design units. The admissible
+names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT},
+\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1},
+\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP},
+\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters
+1~to~22. The alternate names \.{DEFAULTRULETHICKNESS},
+\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3},
+\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters
+8 to 13.
+
+The notation `\.{PARAMETER} $n$' provides another way to specify the
+$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way
+to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive
+and less than |max_param_words|.
+
+@ The elements of a \.{CHARACTER} property list can be of six different types.
+
+\yskip\hang\.{CHARWD} (real value) denotes the character's width in
+design units.
+
+\yskip\hang\.{CHARHT} (real value) denotes the character's height in
+design units.
+
+\yskip\hang\.{CHARDP} (real value) denotes the character's depth in
+design units.
+
+\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in
+design units.
+
+\yskip\hang\.{NEXTLARGER} (one-byte value), specifies the character that
+follows the present one in a ``charlist.'' The value must be the number of a
+character in the font, and there must be no infinite cycles of supposedly
+larger and larger characters.
+
+\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character.
+This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot
+both be used within the same \.{CHARACTER} list.
+
+\yskip\noindent
+The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID},
+\.{BOT} or \.{REP}; the values are integers, which must be zero or the number
+of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means
+that the corresponding piece of the extensible character is absent. A nonzero
+value, or a \.{REP} value of zero, denotes the character code used to make
+up the top, middle, bottom, or replicated piece of an extensible character.
+
+@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a
+program in a simple command language that \TeX\ uses for ligatures and kerns.
+If several \.{LIGTABLE} lists appear, they are effectively concatenated into
+a single list.
+
+\yskip\hang\.{LABEL} (one-byte value) means that the program for the
+stated character value starts here. The integer must be the number of a
+character in the font; its \.{CHARACTER} property list must not have a
+\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step
+must follow.
+
+\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for
+beginning-of-word ligatures starts here.
+
+\yskip\hang\.{LIG} (two one-byte values). The instruction `\.{(LIG} $c$ $r$\.)'
+means, ``If the next character is $c$, then insert character~$r$ and
+possibly delete the current character and/or~$c$;
+otherwise go on to the next instruction.''
+Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately
+preceded or followed by a slash, and then immediately followed by \.>
+characters not exceeding the number of slashes. Thus there are eight
+possible forms:
+$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil
+\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$
+The slashes specify retention of the left or right original character; the
+\.> signs specify passing over the result without further ligature processing.
+
+\yskip\hang\.{KRN} (a one-byte value and a real value). The instruction
+`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert
+a blank space of width $r$ between the current character character and $c$;
+otherwise go on to the next intruction.'' The value of $r$, which is in
+design units, is often negative. Character code $c$ must exist
+in the font.
+
+\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
+It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL}
+or \.{STOP} or \.{SKIP}.
+
+\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies
+continuation of a ligature/kern program after the specified number of \.{LIG}
+or \.{KRN} steps has been skipped over. The number of subsequent \.{LIG} and
+\.{KRN} instructions must therefore exceed this specified amount.
+
+@ In addition to all these possibilities, the property name \.{COMMENT} is
+allowed in any property list. Such comments are ignored.
+
+@ So that is what \.{PL} files hold. In a \.{VPL} file additional
+properties are recognized; two of these are valid on the outermost level:
+
+\yskip\hang\.{VTITLE} (string value, default is empty). The value will be
+reproduced at the beginning of the \.{VF} file (and printed on the terminal
+by \.{VFtoVP} when it examines that file).
+
+\yskip\hang\.{MAPFONT}. The value is a nonnegative integer followed by
+a property list. The integer represents an identifying number for fonts
+used in \.{MAP} attributes. The property list, which identifies the font and
+relative size, is defined below.
+
+\yskip\noindent
+And one additional ``virtual property'' is valid within a \.{CHARACTER}:
+
+\yskip\hang\.{MAP}. The value is a property list consisting of typesetting
+commands. Default is the single command \.{SETCHAR}~$c$, where $c$ is
+the current character number.
+
+@ The elements of a \.{MAPFONT} property list can be of the following types.
+
+\yskip\hang\.{FONTNAME} (string value, default is \.{NULL}).
+This is the font's identifying name.
+
+\yskip\hang\.{FONTAREA} (string value, default is empty). If the font appears
+in a nonstandard directory, according to local conventions, the directory
+name is given here. (This is system dependent, just as in \.{DVI} files.)
+
+\yskip\hang\.{FONTCHECKSUM} (four-byte value, default is zero). This value,
+which should be a nonnegative integer less than $2^{32}$, can be used to
+check that the font being referred to matches the intended font. If nonzero,
+it should equal the \.{CHECKSUM} parameter in that font.
+
+\yskip\hang\.{FONTAT} (numeric value, default is the \.{DESIGNUNITS} of the
+present virtual font). This value is relative to the design units of
+the present virtual font, hence it will be scaled when the virtual
+font is magnified or reduced. It represents the value that will
+effectively replace the design size of the font being referred to,
+so that all characters will be scaled appropriately.
+
+\yskip\hang\.{FONTDSIZE} (numeric value, default is 10). This value is
+absolute, in units of printer's points. It should equal the \.{DESIGNSIZE}
+parameter in the font being referred to.
+
+\yskip\noindent
+If any of the
+string values contain parentheses, the parentheses must be balanced. Leading
+blanks are removed from the strings, but trailing blanks are not.
+
+@ Finally, the elements of a \.{MAP} property list are an ordered sequence
+of typesetting commands chosen from among the following:
+
+\yskip\hang\.{SELECTFONT} (four-byte integer value). The value must be the
+number of a previously defined \.{MAPFONT}. This font (or more precisely, the
+final font that is mapped to that code number, if two \.{MAPFONT} properties
+happen to specify the same code) will be used in subsequent \.{SETCHAR}
+instructions until overridden by another \.{SELECTFONT}. The first-specified
+\.{MAPFONT} is implicitly selected before the first \.{SELECTFONT} in every
+character's map.
+
+\yskip\hang\.{SETCHAR} (one-byte integer value). There must be a character of
+this number in the currently selected font. (\.{VPtoVF} doesn't check that
+the character is valid, but \.{VFtoVP} does.) That character is typeset at the
+current position, and the typesetter moves right by the \.{CHARWD} in
+that character's \.{TFM} file.
+
+\yskip\hang\.{SETRULE} (two real values). The first value specifies height,
+the second specifies width, in design units. If both height and width are
+positive, a rule is typeset at the current position. Then the typesetter
+moves right, by the specified width.
+
+\yskip\hang\.{MOVERIGHT}, \.{MOVELEFT}, \.{MOVEUP}, \.{MOVEDOWN} (real
+value). The typesetter moves its current position
+by the number of design units specified.
+
+\yskip\hang\.{PUSH}. The current typesetter position is remembered, to
+be restored on a subsequent \.{POP}.
+
+\yskip\hang\.{POP}. The current typesetter position is reset to where it
+was on the most recent unmatched \.{PUSH}. The \.{PUSH} and \.{POP}
+commands in any \.{MAP} must be properly nested like balanced parentheses.
+
+\yskip\hang\.{SPECIAL} (string value). The subsequent characters, starting
+with the first nonblank and ending just before the first `\.)' that has no
+matching `\.(', are interpreted according to local conventions with the
+same system-dependent meaning as a `special' (\\{xxx}) command
+in a \.{DVI} file.
+
+\yskip\hang\.{SPECIALHEX} (hexadecimal string value). The subsequent
+nonblank characters before the next `\.)' must consist entirely of
+hexadecimal digits, and they must contain an even number of such digits.
+Each pair of hex digits specifies a byte, and this string of bytes is
+treated just as the value of a \.{SPECIAL}. (This convention permits
+arbitrary byte strings to be represented in an ordinary text file.)
+
+@ Virtual font mapping is a recursive process, like macro expansion.
+Thus, a \.{MAPFONT} might
+specify another virtual font, whose characters are themselves mapped to
+other fonts. As an example of this possibility, consider the
+following curious file called \.{recurse.vpl}, which defines a
+virtual font that is self-contained and self-referential:
+$$\vbox{\halign{\.{#}\cr
+(VTITLE Example of recursion)\cr
+(MAPFONT D 0 (FONTNAME recurse)(FONTAT D 2))\cr
+(CHARACTER C A (CHARWD D 1)(CHARHT D 1)(MAP (SETRULE D 1 D 1)))\cr
+(CHARACTER C B (CHARWD D 2)(CHARHT D 2)(MAP (SETCHAR C A)))\cr
+(CHARACTER C C (CHARWD D 4)(CHARHT D 4)(MAP (SETCHAR C B)))\cr
+}}$$
+The design size is 10 points (the default), hence the character \.A
+in font \.{recurse} is a $10\times10$ point black square. Character \.B
+is typeset as character \.A in \.{recurse} {scaled} {2000}, hence it
+is a $20\times20$ point black square. And character \.C is typeset as
+character \.{B} in \.{recurse} {scaled} {2000}, hence its size is
+$40\times40$.
+
+Users are responsible for making sure that infinite recursion doesn't happen.
+
+@ So that is what \.{VPL} files hold. From these rules,
+you can guess (correctly) that \.{VPtoVF} operates in four main stages.
+First it assigns the default values to all properties; then it scans
+through the \.{VPL} file, changing property values as new ones are seen; then
+it checks the information and corrects any problems; and finally it outputs
+the \.{VF} and \.{TFM} files.
+
+@ The next question is, ``What are \.{VF} and
+\.{TFM} files?'' A complete answer to that question appears in the
+documentation of the companion programs, \.{VFtoVP} and
+\.{TFtoPL}, so the details will not
+be repeated here. Suffice it to say that a \.{VF} or
+\.{TFM} file stores all of the
+relevant font information in a sequence of 8-bit bytes. The number of
+bytes is always a multiple of 4, so we could regard the files
+as sequences of 32-bit words; but \TeX\ uses the byte interpretation,
+and so does \.{VPtoVF}. Note that the bytes are considered to be unsigned
+numbers.
+
+@<Glob...@>=
+@!vf_file:packed file of 0..255;
+@!tfm_file:packed file of 0..255;
+
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(vf_file); rewrite(tfm_file);
+
+@* Basic input routines.
+For the purposes of this program, a |byte| is an unsigned eight-bit quantity,
+and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes
+correspond to one-character constants like \.{"A"} in \.{WEB} language.
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!ASCII_code=@'40..@'177; {standard ASCII code numbers}
+
+@ One of the things \.{VPtoVF} has to do is convert characters of strings
+to ASCII form, since that is the code used for the family name and the
+coding scheme in a \.{TFM} file. An array |xord| is used to do the
+conversion from |char|; the method below should work with little or no change
+on most \PASCAL\ systems.
+@^system dependencies@>
+
+@d first_ord=0 {ordinal number of the smallest element of |char|}
+@d last_ord=127 {ordinal number of the largest element of |char|}
+
+@<Global...@>=
+@!xord:array[char] of ASCII_code; {conversion table}
+
+@ @<Local variables for init...@>=
+@!k:integer; {all-purpose initialization index}
+
+@ Characters that should not appear in \.{VPL} files (except in comments)
+are mapped into @'177.
+
+@d invalid_code=@'177 {code deserving an error message}
+
+@<Set init...@>=
+for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code;
+xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#";
+xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'";
+xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=",";
+xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1";
+xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6";
+xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";";
+xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?";
+xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C";
+xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H";
+xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M";
+xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R";
+xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W";
+xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\";
+xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a";
+xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f";
+xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k";
+xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p";
+xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u";
+xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z";
+xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~";
+
+@ In order to help catch errors of badly nested parentheses, \.{VPtoVF}
+assumes that the user will begin each line with a number of blank spaces equal
+to some constant times the number of open parentheses at the beginning of
+that line. However, the program doesn't know in advance what the constant
+is, nor does it want to print an error message on every line for a user
+who has followed no consistent pattern of indentation.
+
+Therefore the following strategy is adopted: If the user has been consistent
+with indentation for ten or more lines, an indentation error will be
+reported. The constant of indentation is reset on every line that should
+have nonzero indentation.
+
+@<Glob...@>=
+@!line:integer; {the number of the current line}
+@!good_indent:integer; {the number of lines since the last bad indentation}
+@!indent: integer; {the number of spaces per open parenthesis, zero if unknown}
+@!level: integer; {the current number of open parentheses}
+
+@ @<Set init...@>=
+line:=0; good_indent:=0; indent:=0; level:=0;
+
+@ The input need not really be broken into lines of any maximum length, and
+we could read it character by character without any buffering. But we shall
+place it into a small buffer so that offending lines can be displayed in error
+messages.
+
+@<Glob...@>=
+@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer
+ at end-of-line marks?}
+@!limit:0..buf_size; {position of the last character present in the buffer}
+@!loc:0..buf_size; {position of the last character read in the buffer}
+@!buffer:array[1..buf_size] of char;
+@!input_has_ended:boolean; {there is no more input to read}
+
+@ @<Set init...@>=
+limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false;
+
+@ Just before each \.{CHARACTER} property list is evaluated, the character
+code is printed in octal notation. Up to eight such codes appear on a line;
+so we have a variable to keep track of how many are currently there.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+
+@ @<Set init...@>=
+chars_on_line:=0;
+
+@ The following routine prints an error message and an indication of
+where the error was detected. The error message should not include any
+final punctuation, since this procedure supplies its own.
+
+@d err_print(#)==begin if chars_on_line>0 then print_ln(' ');
+ print(#); show_error_context;
+ end
+
+@p procedure show_error_context; {prints the current scanner location}
+var k:0..buf_size; {an index into |buffer|}
+begin print_ln(' (line ',line:1,').');
+if not left_ln then print('...');
+for k:=1 to loc do print(buffer[k]); {print the characters already scanned}
+print_ln(' ');
+if not left_ln then print(' ');
+for k:=1 to loc do print(' '); {space out the second line}
+for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen}
+if right_ln then print_ln(' ')@+else print_ln('...');
+chars_on_line:=0;
+end;
+
+@ Here is a procedure that does the right thing when we are done
+reading the present contents of the buffer. It keeps |buffer[buf_size]|
+empty, in order to avoid range errors on certain \PASCAL\ compilers.
+
+An infinite sequence of right parentheses is placed at the end of the
+file, so that the program is sure to get out of whatever level of nesting
+it is in.
+
+On some systems it is desirable to modify this code so that tab marks
+in the buffer are replaced by blank spaces. (Simply setting
+|xord[chr(@'11)]:=" "| would not work; for example, two-line
+error messages would not come out properly aligned.)
+@^system dependencies@>
+
+@p procedure fill_buffer;
+begin left_ln:=right_ln; limit:=0; loc:=0;
+if left_ln then
+ begin if line>0 then read_ln(vpl_file);
+ incr(line);
+ end;
+if eof(vpl_file) then
+ begin limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
+ end
+else begin while (limit<buf_size-1)and(not eoln(vpl_file)) do
+ begin incr(limit); read(vpl_file,buffer[limit]);
+ end;
+ buffer[limit+1]:=' '; right_ln:=eoln(vpl_file);
+ if left_ln then @<Set |loc| to the number of leading blanks in
+ the buffer, and check the indentation@>;
+ end;
+end;
+
+@ The interesting part about |fill_buffer| is the part that learns what
+indentation conventions the user is following, if any.
+
+@d bad_indent(#)==begin if good_indent>=10 then err_print(#);
+ good_indent:=0; indent:=0;
+ end
+
+@<Set |loc|...@>=
+begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
+if loc<limit then
+ begin if level=0 then
+ if loc=0 then incr(good_indent)
+ else bad_indent('Warning: Indented line occurred at level zero')
+@.Warning: Indented line...@>
+ else if indent=0 then
+ if loc mod level=0 then
+ begin indent:=loc div level; good_indent:=1;
+ end
+ else good_indent:=0
+ else if indent*level=loc then incr(good_indent)
+ else bad_indent('Warning: Inconsistent indentation; ',
+@.Warning: Inconsistent indentation...@>
+ 'you are at parenthesis level ',level:1);
+ end;
+end
+
+@* Basic scanning routines.
+The global variable |cur_char| holds the ASCII code corresponding to the
+character most recently read from the input buffer, or to a character that
+has been substituted for the real one.
+
+@<Global...@>=
+@!cur_char:ASCII_code; {we have just read this}
+
+@ Here is a procedure that sets |cur_char| to an ASCII code for the
+next character of input, if that character is a letter or digit or slash
+or \.>. Otherwise
+it sets |cur_char:=" "|, and the input system will be poised to reread the
+character that was rejected, whether or not it was a space.
+Lower case letters are converted to upper case.
+
+@p procedure get_keyword_char;
+begin while (loc=limit)and(not right_ln) do fill_buffer;
+if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
+else begin cur_char:=xord[buffer[loc+1]];
+ if cur_char>="a" then cur_char:=cur_char-@'40;
+ if ((cur_char>="0")and(cur_char<="9")) then incr(loc)
+ else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc)
+ else if cur_char="/" then incr(loc)
+ else if cur_char=">" then incr(loc)
+ else cur_char:=" ";
+ end;
+end;
+
+@ The following procedure sets |cur_char| to the next character code,
+and converts lower case to upper case. If the character is a left or
+right parenthesis, it will not be ``digested''; the character will
+be read again and again, until the calling routine does something
+like `|incr(loc)|' to get past it. Such special treatment of parentheses
+insures that the structural information they contain won't be lost in
+the midst of other error recovery operations.
+
+@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc);
+ end {undoes the effect of |get_next|}
+
+@p procedure get_next; {sets |cur_char| to next, balks at parentheses}
+begin while loc=limit do fill_buffer;
+incr(loc); cur_char:=xord[buffer[loc]];
+if cur_char>="a" then
+ if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
+ else begin if cur_char=invalid_code then
+ begin err_print('Illegal character in the file');
+@.Illegal character...@>
+ cur_char:="?";
+ end;
+ end
+else if (cur_char<=")")and(cur_char>="(") then decr(loc);
+end;
+
+@ Here's a procedure that scans a hexadecimal digit or a right parenthesis.
+
+@p function get_hex:byte;
+var @!a:integer; {partial result}
+begin repeat get_next;
+until cur_char<>" ";
+a:=cur_char-")";
+if a>0 then
+ begin a:=cur_char-"0";
+ if cur_char>"9" then
+ if cur_char<"A" then a:=-1 else a:=cur_char-"A"+10;
+ end;
+if (a<0)or(a>15) then
+ begin err_print('Illegal hexadecimal digit'); get_hex:=0;
+@.Illegal hexadecimal digit@>
+ end
+else get_hex:=a;
+end;
+
+@ The next procedure is used to ignore the text of a comment, or to pass over
+erroneous material. As such, it has the privilege of passing parentheses.
+It stops after the first right parenthesis that drops the level below
+the level in force when the procedure was called.
+
+@p procedure skip_to_end_of_item;
+var l:integer; {initial value of |level|}
+begin l:=level;
+while level>=l do
+ begin while loc=limit do fill_buffer;
+ incr(loc);
+ if buffer[loc]=')' then decr(level)
+ else if buffer[loc]='(' then incr(level);
+ end;
+if input_has_ended then err_print('File ended unexpectedly: No closing ")"');
+@.File ended unexpectedly...@>
+cur_char:=" "; {now the right parenthesis has been read and digested}
+end;
+
+@ A similar procedure copies the bytes remaining in an item. The copied bytes
+go into an array |vf| that we'll declare later. Leading blanks are ignored.
+
+@d vf_store(#)==
+ begin vf[vf_ptr]:=#;
+ if vf_ptr=vf_size then err_print('I''m out of memory---increase my vfsize!')
+@.I'm out of memory...@>
+ else incr(vf_ptr);
+ end
+
+@p procedure copy_to_end_of_item;
+label 30;
+var l:integer; {initial value of |level|}
+@!nonblank_found:boolean; {have we seen a nonblank character yet?}
+begin l:=level; nonblank_found:=false;
+while true do
+ begin while loc=limit do fill_buffer;
+ if buffer[loc+1]=')' then
+ if level=l then goto 30@+else decr(level);
+ incr(loc);
+ if buffer[loc]='(' then incr(level);
+ if buffer[loc]<>' ' then nonblank_found:=true;
+ if nonblank_found then
+ if xord[buffer[loc]]=invalid_code then
+ begin err_print('Illegal character in the file');
+@.Illegal character...@>
+ vf_store("?");
+ end
+ else vf_store(xord[buffer[loc]]);
+ end;
+30:end;
+
+@ Sometimes we merely want to skip past characters in the input until we
+reach a left or a right parenthesis. For example, we do this whenever we
+have finished scanning a property value and we hope that a right parenthesis
+is next (except for possible blank spaces).
+
+@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")")
+@d skip_error(#)==begin err_print(#); skip_to_paren;
+ end {this gets to the right parenthesis if something goes wrong}
+@d flush_error(#)==begin err_print(#); skip_to_end_of_item;
+ end {this gets past the right parenthesis if something goes wrong}
+
+@ After a property value has been scanned, we want to move just past the
+right parenthesis that should come next in the input (except for possible
+blank spaces).
+
+@p procedure finish_the_property; {do this when the value has been scanned}
+begin while cur_char=" " do get_next;
+if cur_char<>")" then err_print('Junk after property value will be ignored');
+@.Junk after property value...@>
+skip_to_end_of_item;
+end;
+
+@* Scanning property names.
+We have to figure out the meaning of names that appear in the \.{VPL} file,
+by looking them up in a dictionary of known keywords. Keyword number $n$
+appears in locations |start[n]| through |start[n+1]-1| of an array called
+|dictionary|.
+
+@d max_name_index=100 {upper bound on the number of keywords}
+@d max_letters=666 {upper bound on the total length of all keywords}
+
+@<Global...@>=
+@!start:array[1..max_name_index] of 0..max_letters;
+@!dictionary:array[0..max_letters] of ASCII_code;
+@!start_ptr:0..max_name_index; {the first available place in |start|}
+@!dict_ptr:0..max_letters; {the first available place in |dictionary|}
+
+@ @<Set init...@>=
+start_ptr:=1; start[1]:=0; dict_ptr:=0;
+
+@ When we are looking for a name, we put it into the |cur_name| array.
+When we have found it, the corresponding |start| index will go into
+the global variable |name_ptr|.
+
+@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}}
+
+@<Glob...@>=
+@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up}
+@!name_length:0..longest_name; {its length}
+@!name_ptr:0..max_name_index; {its ordinal number in the dictionary}
+
+@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L
+in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary
+operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]|
+points into the |start| array.
+
+@d hash_prime=141 {size of the hash table}
+
+@<Glob...@>=
+@!nhash:array[0..hash_prime-1] of 0..max_name_index;
+@!cur_hash:0..hash_prime-1; {current position in the hash table}
+
+@ @<Local...@>=
+@!h:0..hash_prime-1; {runs through the hash table}
+
+@ @<Set init...@>=
+for h:=0 to hash_prime-1 do nhash[h]:=0;
+
+@ Since there is no chance of the hash table overflowing, the procedure
+is very simple. After |lookup| has done its work, |cur_hash| will point
+to the place where the given name was found, or where it should be inserted.
+
+@p procedure lookup; {finds |cur_name| in the dictionary}
+var k:0..longest_name; {index into |cur_name|}
+@!j:0..max_letters; {index into |dictionary|}
+@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement}
+begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
+not_found:=true;
+while not_found do
+ begin if cur_hash=0 then cur_hash:=hash_prime-1@+else decr(cur_hash);
+ if nhash[cur_hash]=0 then not_found:=false
+ else begin j:=start[nhash[cur_hash]];
+ if start[nhash[cur_hash]+1]=j+name_length then
+ begin not_found:=false;
+ for k:=1 to name_length do
+ if dictionary[j+k-1]<>cur_name[k] then not_found:=true;
+ end;
+ end;
+ end;
+name_ptr:=nhash[cur_hash];
+end;
+
+@ @<Compute the hash...@>=
+cur_hash:=cur_name[1];
+for k:=2 to name_length do
+ cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime
+
+@ The ``meaning'' of the keyword that begins at |start[k]| in the
+dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given
+symbolic meanings by the following definitions.
+
+@d comment_code=0
+@d check_sum_code=1
+@d design_size_code=2
+@d design_units_code=3
+@d coding_scheme_code=4
+@d family_code=5
+@d face_code=6
+@d seven_bit_safe_flag_code=7
+@d header_code= 8
+@d font_dimen_code=9
+@d lig_table_code=10
+@d boundary_char_code=11
+@d virtual_title_code=12
+@d map_font_code=13
+@d character_code=14
+@d font_name_code=20
+@d font_area_code=21
+@d font_checksum_code=22
+@d font_at_code=23
+@d font_dsize_code=24
+@d parameter_code=30
+@d char_info_code=60
+@d width=1
+@d height=2
+@d depth=3
+@d italic=4
+@d char_wd_code=char_info_code+width
+@d char_ht_code=char_info_code+height
+@d char_dp_code=char_info_code+depth
+@d char_ic_code=char_info_code+italic
+@d next_larger_code=65
+@d map_code=66
+@d var_char_code=67
+@d select_font_code=80
+@d set_char_code=81
+@d set_rule_code=82
+@d move_right_code=83
+@d move_down_code=85
+@d push_code=87
+@d pop_code=88
+@d special_code=89
+@d special_hex_code=90
+@d label_code=100
+@d stop_code=101
+@d skip_code=102
+@d krn_code=103
+@d lig_code=104
+
+@<Glo...@>=
+@!equiv:array[0..max_name_index] of byte;
+@!cur_code:byte; {equivalent most recently found in |equiv|}
+
+@ We have to get the keywords into the hash table and into the dictionary in
+the first place (sigh). The procedure that does this has the desired
+|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing
+for the initialization, the keyword being initialized is placed into the
+last positions of |cur_name|, instead of the first positions.
+
+@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary}
+var k:0..longest_name;
+begin for k:=1 to name_length do
+ cur_name[k]:=cur_name[k+longest_name-name_length];
+{now the name has been shifted into the correct position}
+lookup; {this sets |cur_hash| to the proper insertion place}
+nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v;
+for k:=1 to name_length do
+ begin dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr);
+ end;
+incr(start_ptr); start[start_ptr]:=dict_ptr;
+end;
+
+@ Here are the macros to load a name of up to 20 letters into the
+dictionary. For example, the macro |load5| is used for five-letter keywords.
+
+@d tail(#)==enter_name(#)
+@d t20(#)==cur_name[20]:=#;tail
+@d t19(#)==cur_name[19]:=#;t20
+@d t18(#)==cur_name[18]:=#;t19
+@d t17(#)==cur_name[17]:=#;t18
+@d t16(#)==cur_name[16]:=#;t17
+@d t15(#)==cur_name[15]:=#;t16
+@d t14(#)==cur_name[14]:=#;t15
+@d t13(#)==cur_name[13]:=#;t14
+@d t12(#)==cur_name[12]:=#;t13
+@d t11(#)==cur_name[11]:=#;t12
+@d t10(#)==cur_name[10]:=#;t11
+@d t9(#)==cur_name[9]:=#;t10
+@d t8(#)==cur_name[8]:=#;t9
+@d t7(#)==cur_name[7]:=#;t8
+@d t6(#)==cur_name[6]:=#;t7
+@d t5(#)==cur_name[5]:=#;t6
+@d t4(#)==cur_name[4]:=#;t5
+@d t3(#)==cur_name[3]:=#;t4
+@d t2(#)==cur_name[2]:=#;t3
+@d t1(#)==cur_name[1]:=#;t2
+@d load3==name_length:=3;t18
+@d load4==name_length:=4;t17
+@d load5==name_length:=5;t16
+@d load6==name_length:=6;t15
+@d load7==name_length:=7;t14
+@d load8==name_length:=8;t13
+@d load9==name_length:=9;t12
+@d load10==name_length:=10;t11
+@d load11==name_length:=11;t10
+@d load12==name_length:=12;t9
+@d load13==name_length:=13;t8
+@d load14==name_length:=14;t7
+@d load15==name_length:=15;t6
+@d load16==name_length:=16;t5
+@d load17==name_length:=17;t4
+@d load18==name_length:=18;t3
+@d load19==name_length:=19;t2
+@d load20==name_length:=20;t1
+
+@ (Thank goodness for keyboard macros in the text editor used to create this
+\.{WEB} file.)
+
+@<Enter all the \.{PL} names and their equivalents,
+ except the parameter names@>=
+equiv[0]:=comment_code; {this is used after unknown keywords}
+load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/
+load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/
+load11("D")("E")("S")("I")("G")("N")
+ ("U")("N")("I")("T")("S")(design_units_code);@/
+load12("C")("O")("D")("I")("N")("G")
+ ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/
+load6("F")("A")("M")("I")("L")("Y")(family_code);@/
+load4("F")("A")("C")("E")(face_code);@/
+load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@>
+ ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/
+load6("H")("E")("A")("D")("E")("R")(header_code);@/
+load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/
+load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/
+load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R")
+ (boundary_char_code);@/
+load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/
+load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/
+load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/
+load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/
+load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/
+load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/
+load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/
+load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/
+load3("T")("O")("P")(var_char_code+1);@/
+load3("M")("I")("D")(var_char_code+2);@/
+load3("B")("O")("T")(var_char_code+3);@/
+load3("R")("E")("P")(var_char_code+4);@/
+load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format}
+load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/
+load5("L")("A")("B")("E")("L")(label_code);@/
+load4("S")("T")("O")("P")(stop_code);@/
+load4("S")("K")("I")("P")(skip_code);@/
+load3("K")("R")("N")(krn_code);@/
+load3("L")("I")("G")(lig_code);@/
+load4("/")("L")("I")("G")(lig_code+2);@/
+load5("/")("L")("I")("G")(">")(lig_code+6);@/
+load4("L")("I")("G")("/")(lig_code+1);@/
+load5("L")("I")("G")("/")(">")(lig_code+5);@/
+load5("/")("L")("I")("G")("/")(lig_code+3);@/
+load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/
+load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/
+
+@ \.{VPL} files may contain the following in addition to the \.{PL} names.
+
+@<Enter all the \.{VPL} names@>=
+load6("V")("T")("I")("T")("L")("E")(virtual_title_code);@/
+load7("M")("A")("P")("F")("O")("N")("T")(map_font_code);@/
+load3("M")("A")("P")(map_code);@/
+load8("F")("O")("N")("T")("N")("A")("M")("E")(font_name_code);@/
+load8("F")("O")("N")("T")("A")("R")("E")("A")(font_area_code);@/
+load12("F")("O")("N")("T")
+ ("C")("H")("E")("C")("K")("S")("U")("M")(font_checksum_code);@/
+load6("F")("O")("N")("T")("A")("T")(font_at_code);@/
+load9("F")("O")("N")("T")("D")("S")("I")("Z")("E")(font_dsize_code);@/
+load10("S")("E")("L")("E")("C")("T")("F")("O")("N")("T")(select_font_code);@/
+load7("S")("E")("T")("C")("H")("A")("R")(set_char_code);@/
+load7("S")("E")("T")("R")("U")("L")("E")(set_rule_code);@/
+load9("M")("O")("V")("E")("R")("I")("G")("H")("T")(move_right_code);@/
+load8("M")("O")("V")("E")("L")("E")("F")("T")(move_right_code+1);@/
+load8("M")("O")("V")("E")("D")("O")("W")("N")(move_down_code);@/
+load6("M")("O")("V")("E")("U")("P")(move_down_code+1);@/
+load4("P")("U")("S")("H")(push_code);@/
+load3("P")("O")("P")(pop_code);@/
+load7("S")("P")("E")("C")("I")("A")("L")(special_code);@/
+load10("S")("P")("E")("C")("I")("A")("L")("H")("E")("X")(special_hex_code);@/
+
+@ @<Enter the parameter names@>=
+load5("S")("L")("A")("N")("T")(parameter_code+1);@/
+load5("S")("P")("A")("C")("E")(parameter_code+2);@/
+load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/
+load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/
+load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/
+load4("Q")("U")("A")("D")(parameter_code+6);@/
+load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/
+load4("N")("U")("M")("1")(parameter_code+8);@/
+load4("N")("U")("M")("2")(parameter_code+9);@/
+load4("N")("U")("M")("3")(parameter_code+10);@/
+load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/
+load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/
+load4("S")("U")("P")("1")(parameter_code+13);@/
+load4("S")("U")("P")("2")(parameter_code+14);@/
+load4("S")("U")("P")("3")(parameter_code+15);@/
+load4("S")("U")("B")("1")(parameter_code+16);@/
+load4("S")("U")("B")("2")(parameter_code+17);@/
+load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/
+load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/
+load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/
+load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/
+load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/
+load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@>
+ ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/
+
+@ When a left parenthesis has been scanned, the following routine
+is used to interpret the keyword that follows, and to store the
+equivalent value in |cur_code|.
+
+@p procedure get_name;
+begin incr(loc); incr(level); {pass the left parenthesis}
+cur_char:=" ";
+while cur_char=" " do get_next;
+if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character}
+name_length:=0; get_keyword_char; {prepare to scan the name}
+while cur_char<>" " do
+ begin if name_length=longest_name then cur_name[1]:="X" {force error}
+ else incr(name_length);
+ cur_name[name_length]:=cur_char;
+ get_keyword_char;
+ end;
+lookup;
+if name_ptr=0 then err_print('Sorry, I don''t know that property name');
+@.Sorry, I don't know...@>
+cur_code:=equiv[name_ptr];
+end;
+
+@* Scanning numeric data.
+The next thing we need is a trio of subroutines to read the one-byte,
+four-byte, and real numbers that may appear as property values.
+These subroutines are careful to stick to numbers between $-2^{31}$
+and $2^{31}-1$, inclusive, so that a computer with two's complement
+32-bit arithmetic will not be interrupted by overflow.
+
+@ The first number scanner, which returns a one-byte value, surely has
+no problems of arithmetic overflow.
+
+@p function get_byte:byte; {scans a one-byte property value}
+var acc:integer; {an accumulator}
+@!t:ASCII_code; {the type of value to be scanned}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+t:=cur_char; acc:=0;
+repeat get_next;
+until cur_char<>" "; {skip the blanks after the type code}
+if t="C" then @<Scan an ASCII character code@>
+else if t="D" then @<Scan a small decimal number@>
+else if t="O" then @<Scan a small octal number@>
+else if t="H" then @<Scan a small hexadecimal number@>
+else if t="F" then @<Scan a face code@>
+else skip_error('You need "C" or "D" or "O" or "H" or "F" here');
+@.You need "C" or "D" ...here@>
+cur_char:=" "; get_byte:=acc;
+end;
+
+@ The |get_next| routine converts lower case to upper case, but it leaves
+the character in the buffer, so we can unconvert it.
+
+@<Scan an ASCII...@>=
+if (cur_char>=@'41)and(cur_char<=@'176)and
+ ((cur_char<"(")or(cur_char>")")) then
+ acc:=xord[buffer[loc]]
+else skip_error('"C" value must be standard ASCII and not a paren')
+@:C value}\.{"C" value must be...@>
+
+@ @<Scan a small dec...@>=
+begin while (cur_char>="0")and(cur_char<="9") do
+ begin acc:=acc*10+cur_char-"0";
+ if acc>255 then
+ begin skip_error('This value shouldn''t exceed 255');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small oct...@>=
+begin while (cur_char>="0")and(cur_char<="7") do
+ begin acc:=acc*8+cur_char-"0";
+ if acc>255 then
+ begin skip_error('This value shouldn''t exceed ''377');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small hex...@>=
+begin while ((cur_char>="0")and(cur_char<="9"))or
+ ((cur_char>="A")and(cur_char<="F")) do
+ begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+ acc:=acc*16+cur_char-"0";
+ if acc>255 then
+ begin skip_error('This value shouldn''t exceed "FF');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a face...@>=
+begin if cur_char="B" then acc:=2
+else if cur_char="L" then acc:=4
+else if cur_char<>"M" then acc:=18;
+get_next;
+if cur_char="I" then incr(acc)
+else if cur_char<>"R" then acc:=18;
+get_next;
+if cur_char="C" then acc:=acc+6
+else if cur_char="E" then acc:=acc+12
+else if cur_char<>"R" then acc:=18;
+if acc>=18 then
+ begin skip_error('Illegal face code, I changed it to MRR');
+@.Illegal face code...@>
+ acc:=0;
+ end;
+end
+
+@ The routine that scans a four-byte value puts its output into |cur_bytes|,
+which is a record containing (yes, you guessed it) four bytes.
+
+@<Types...@>=
+@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end;
+
+@ @d c0==cur_bytes.b0
+@d c1==cur_bytes.b1
+@d c2==cur_bytes.b2
+@d c3==cur_bytes.b3
+
+@<Glob...@>=
+@!cur_bytes:four_bytes; {a four-byte accumulator}
+@!zero_bytes:four_bytes; {four bytes all zero}
+
+@ @<Set init...@>=
+zero_bytes.b0:=0; zero_bytes.b1:=0; zero_bytes.b2:=0; zero_bytes.b3:=0;
+
+@ Since the |get_four_bytes| routine is used very infrequently, no attempt
+has been made to make it fast; we only want it to work.
+
+@p procedure get_four_bytes; {scans an unsigned constant and sets |four_bytes|}
+var c:integer; {local two-byte accumulator}
+@!r:integer; {radix}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+r:=0; cur_bytes:=zero_bytes; {start with the accumulator zero}
+if cur_char="H" then r:=16
+else if cur_char="O" then r:=8
+else if cur_char="D" then r:=10
+else skip_error('Decimal ("D"), octal ("O"), or hex ("H") value needed here');
+@.Decimal ("D"), octal ("O"), or hex...@>
+if r>0 then
+ begin repeat get_next;
+ until cur_char<>" "; {skip the blanks after the type code}
+ while ((cur_char>="0")and(cur_char<="9"))or@|
+ ((cur_char>="A")and(cur_char<="F")) do
+ @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>;
+ end;
+end;
+
+@ @<Multiply by |r|...@>=
+begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+if cur_char>="0"+r then skip_error('Illegal digit')
+@.Illegal digit@>
+else begin c:=c3*r+cur_char-"0"; c3:=c mod 256;@/
+ c:=c2*r+c div 256; c2:=c mod 256;@/
+ c:=c1*r+c div 256; c1:=c mod 256;@/
+ c:=c0*r+c div 256;
+ if c<256 then c0:=c
+ else begin cur_bytes:=zero_bytes;
+ if r=8 then
+ skip_error('Sorry, the maximum octal value is O 37777777777')
+@.Sorry, the maximum...@>
+ else if r=10 then
+ skip_error('Sorry, the maximum decimal value is D 4294967295')
+ else skip_error('Sorry, the maximum hex value is H FFFFFFFF');
+ end;
+ get_next;
+ end;
+end
+
+@ The remaining scanning routine is the most interesting. It scans a real
+constant and returns the nearest |fix_word| approximation to that constant.
+A |fix_word| is a 32-bit integer that represents a real value that
+has been multiplied by $2^{20}$. Since \.{VPtoVF} restricts the magnitude
+of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$.
+
+@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0}
+
+@<Types...@>=
+@!fix_word=integer; {a scaled real value with 20 bits of fraction}
+
+@ When a real value is desired, we might as well treat `\.D' and `\.R'
+formats as if they were identical.
+
+@p function get_fix:fix_word; {scans a real property value}
+var negative:boolean; {was there a minus sign?}
+@!acc:integer; {an accumulator}
+@!int_part:integer; {the integer part}
+@!j:0..7; {the number of decimal places stored}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+negative:=false; acc:=0; {start with the accumulators zero}
+if (cur_char<>"R")and(cur_char<>"D") then
+ skip_error('An "R" or "D" value is needed here')
+@.An "R" or "D" ... needed here@>
+else begin @<Scan the blanks and/or signs after the type code@>;
+ while (cur_char>="0") and (cur_char<="9") do
+ @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>;
+ int_part:=acc; acc:=0;
+ if cur_char="." then @<Scan the fraction part and put it in |acc|@>;
+ if (acc>=unity)and(int_part=2047) then
+ skip_error('Real constants must be less than 2048')
+@.Real constants must be...@>
+ else acc:=int_part*unity+acc;
+ end;
+if negative then get_fix:=-acc@+else get_fix:=acc;
+end;
+
+@ @<Scan the blanks...@>=
+repeat get_next;
+if cur_char="-" then
+ begin cur_char:=" "; negative:=true;
+ end
+else if cur_char="+" then cur_char:=" ";
+until cur_char<>" "
+
+@ @<Multiply by 10...@>=
+begin acc:=acc*10+cur_char-"0";
+if acc>=2048 then
+ begin skip_error('Real constants must be less than 2048');
+@.Real constants must be...@>
+ acc:=0; cur_char:=" ";
+ end
+else get_next;
+end
+
+@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven
+of the digits $d_j$. A correct result is obtained if we first compute
+$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which
+$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
+
+@<Glob...@>=
+@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$}
+
+@ @<Scan the frac...@>=
+begin j:=0; get_next;
+while (cur_char>="0")and(cur_char<="9") do
+ begin if j<7 then
+ begin incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
+ end;
+ get_next;
+ end;
+acc:=0;
+while j>0 do
+ begin acc:=fraction_digits[j]+(acc div 10); decr(j);
+ end;
+acc:=(acc+10) div 20;
+end
+
+@* Storing the property values.
+When property values have been found, they are squirreled away in a bunch
+of arrays. The header information is unpacked into bytes in an array
+called |header_bytes|. The ligature/kerning program is stored in an array
+of type |four_bytes|.
+Another |four_bytes| array holds the specifications of extensible characters.
+The kerns and parameters are stored in separate arrays of |fix_word| values.
+Virtual font data goes into an array |vf| of single-byte values.
+
+We maintain information about at most 256 local fonts. (If this is inadequate,
+several arrays need to be made longer and we need to output font definitions
+that go beyond |fnt1| and |fnt_def1| in the \.{VF} file.)
+
+Instead of storing the design size in the header array, we will keep it
+in a |fix_word| variable until the last minute. The number of units in the
+design size is also kept in a |fix_word|.
+
+@<Glob...@>=
+@!header_bytes:array[header_index] of byte; {the header block}
+@!header_ptr:header_index; {the number of header bytes in use}
+@!design_size:fix_word; {the design size}
+@!design_units:fix_word; {reciprocal of the scaling factor}
+@!frozen_du:boolean; {have we used |design_units| irrevocably?}
+@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?}
+@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program}
+@!nl:0..32767; {the number of ligature/kern instructions so far}
+@!min_nl:0..32767; {the final value of |nl| must be at least this}
+@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts}
+@!nk:0..max_kerns; {the number of entries of |kern|}
+@!exten:array[0..255] of four_bytes; {extensible character specs}
+@!ne:0..256; {the number of extensible characters}
+@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters}
+@!np:0..max_param_words; {the largest parameter set nonzero}
+@!check_sum_specified:boolean; {did the user name the check sum?}
+@!bchar:0..256; {the right boundary character, or 256 if unspecified}
+@!vf:array[0..vf_size] of byte; {stored bytes for \.{VF} file}
+@!vf_ptr:0..vf_size; {first unused location in |vf|}
+@!vtitle_start:0..vf_size; {starting location of \.{VTITLE} string}
+@!vtitle_length:byte; {length of \.{VTITLE} string}
+@!packet_start:array[byte] of 0..vf_size;
+ {beginning location of character packet}
+@!packet_length:array[byte] of integer; {length of character packet}
+@!font_ptr:0..256; {number of distinct local fonts seen}
+@!cur_font:0..256; {number of the current local font}
+@!fname_start:array[byte] of 0..vf_size; {beginning of local font name}
+@!fname_length:array[byte] of byte; {length of local font name}
+@!farea_start:array[byte] of 0..vf_size; {beginning of local font area}
+@!farea_length:array[byte] of byte; {length of local font area}
+@!font_checksum:array[byte] of four_bytes; {local font checksum}
+@!font_number:array[0..256] of four_bytes; {local font id number}
+@!font_at:array[byte] of fix_word; {local font ``at size''}
+@!font_dsize:array[byte] of fix_word; {local font design size}
+
+@ @<Types...@>=
+@!header_index=0..max_header_bytes;
+@!indx=0..@'77777;
+
+@ @<Local...@>=
+@!d:header_index; {an index into |header_bytes|}
+
+@ We start by setting up the default values.
+
+@d check_sum_loc=0
+@d design_size_loc=4
+@d coding_scheme_loc=8
+@d family_loc=coding_scheme_loc+40
+@d seven_flag_loc=family_loc+20
+@d face_loc=seven_flag_loc+3
+
+@<Set init...@>=
+for d:=0 to 18*4-1 do header_bytes[d]:=0;
+header_bytes[8]:=11; header_bytes[9]:="U";
+header_bytes[10]:="N";
+header_bytes[11]:="S";
+header_bytes[12]:="P";
+header_bytes[13]:="E";
+header_bytes[14]:="C";
+header_bytes[15]:="I";
+header_bytes[16]:="F";
+header_bytes[17]:="I";
+header_bytes[18]:="E";
+header_bytes[19]:="D";
+@.UNSPECIFIED@>
+for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40];
+design_size:=10*unity; design_units:=unity; frozen_du:=false;
+seven_bit_safe_flag:=false;@/
+header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/
+check_sum_specified:=false; bchar:=256;@/
+vf_ptr:=0; vtitle_start:=0; vtitle_length:=0; font_ptr:=0;
+for k:=0 to 255 do packet_start[k]:=vf_size;
+for k:=0 to 127 do packet_length[k]:=1;
+for k:=128 to 255 do packet_length[k]:=2;
+
+@ Most of the dimensions, however, go into the |memory| array. There are
+at most 257 widths, 257 heights, 257 depths, and 257 italic corrections,
+since the value 0 is required but it need not be used. So |memory| has room
+for 1028 entries, each of which is a |fix_word|. An auxiliary table called
+|link| is used to link these words together in linear lists, so that
+sorting and other operations can be done conveniently.
+
+We also add four ``list head'' words to the |memory| and |link| arrays;
+these are in locations |width| through |italic|, i.e., 1 through 4.
+For example, |link[height]| points to the smallest element in
+the sorted list of distinct heights that have appeared so far, and
+|memory[height]| is the number of distinct heights.
+
+@d mem_size=1028+4 {number of nonzero memory addresses}
+
+@<Types...@>=
+@!pointer=0..mem_size; {an index into memory}
+
+@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain
+pointers to the |memory| array entries where the corresponding dimensions
+appear. Two other arrays, |char_tag| and |char_remainder|, hold
+the other information that \.{TFM} files pack into a |char_info_word|.
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+@d bchar_label==char_remainder[256]
+ {beginning of ligature program for left boundary}
+
+@<Glob...@>=
+@!memory:array[pointer] of fix_word; {character dimensions and kerns}
+@!mem_ptr:pointer; {largest |memory| word in use}
+@!link:array[pointer] of pointer; {to make lists of |memory| items}
+@!char_wd:array[byte] of pointer; {pointers to the widths}
+@!char_ht:array[byte] of pointer; {pointers to the heights}
+@!char_dp:array[byte] of pointer; {pointers to the depths}
+@!char_ic:array[byte] of pointer; {pointers to italic corrections}
+@!char_tag:array[byte] of no_tag..ext_tag; {character tags}
+@!char_remainder:array[0..256] of 0..65535; {pointers to ligature labels,
+ next larger characters, or extensible characters}
+
+@ @<Local...@>=
+@!c:byte; {runs through all character codes}
+
+@ @<Set init...@>=
+bchar_label:=@'77777;
+for c:=0 to 255 do
+ begin char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
+ char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists}
+memory[width]:=0; link[width]:=0; {width list is empty}
+memory[height]:=0; link[height]:=0; {height list is empty}
+memory[depth]:=0; link[depth]:=0; {depth list is empty}
+memory[italic]:=0; link[italic]:=0; {italic list is empty}
+mem_ptr:=italic;
+
+@ As an example of these data structures, let us consider the simple
+routine that inserts a potentially new element into one of the dimension
+lists. The first parameter indicates the list head (i.e., |h=width| for
+the width list, etc.); the second parameter is the value that is to be
+inserted into the list if it is not already present. The procedure
+returns the value of the location where the dimension appears in |memory|.
+The fact that |memory[0]| is larger than any legal dimension makes the
+algorithm particularly short.
+
+We do have to handle two somewhat subtle situations. A width of zero must be
+put into the list, so that a zero-width character in the font will not appear
+to be nonexistent (i.e., so that its |char_wd| index will not be zero), but
+this does not need to be done for heights, depths, or italic corrections.
+Furthermore, it is necessary to test for memory overflow even though we
+have provided room for the maximum number of different dimensions in any
+legal font, since the \.{VPL} file might foolishly give any number of
+different sizes to the same character.
+
+@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list}
+var p:pointer; {the current node of interest}
+begin if (d=0)and(h<>width) then sort_in:=0
+else begin p:=h;
+ while d>=memory[link[p]] do p:=link[p];
+ if (d=memory[p])and(p<>h) then sort_in:=p
+ else if mem_ptr=mem_size then
+ begin err_print('Memory overflow: more than 1028 widths, etc');
+@.Memory overflow...@>
+ print_ln('Congratulations! It''s hard to make this error.');
+ sort_in:=p;
+ end
+ else begin incr(mem_ptr); memory[mem_ptr]:=d;
+ link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]);
+ sort_in:=mem_ptr;
+ end;
+ end;
+end;
+
+@ When these lists of dimensions are eventually written to the \.{TFM}
+file, we may have to do some rounding of values, because the \.{TFM} file
+allows at most 256 widths, 16 heights, 16 depths, and 64 italic
+corrections. The following procedure takes a given list head |h| and a
+given dimension |d|, and returns the minimum $m$ such that the elements of
+the list can be covered by $m$ intervals of width $d$. It also sets
+|next_d| to the smallest value $d^\prime>d$ such that the covering found
+by this procedure would be different. In particular, if $d=0$ it computes
+the number of elements of the list, and sets |next_d| to the smallest
+distance between two list elements. (The covering by intervals of width
+|next_d| is not guaranteed to have fewer than $m$ elements, but in practice
+this seems to happen most of the time.)
+
+@<Glob...@>=
+@!next_d:fix_word; {the next larger interval that is worth trying}
+
+@ Once again we can make good use of the fact that |memory[0]| is ``infinite.''
+
+@p function min_cover(@!h:pointer;@!d:fix_word):integer;
+var p:pointer; {the current node of interest}
+@!l:fix_word; {the least element covered by the current interval}
+@!m:integer; {the current size of the cover being generated}
+begin m:=0; p:=link[h]; next_d:=memory[0];
+while p<>0 do
+ begin incr(m); l:=memory[p];
+ while memory[link[p]]<=l+d do p:=link[p];
+ p:=link[p];
+ if memory[p]-l<next_d then next_d:=memory[p]-l;
+ end;
+min_cover:=m;
+end;
+
+@ The following procedure uses |min_cover| to determine the smallest $d$
+such that a given list can be covered with at most a given number of
+intervals.
+
+@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round}
+var d:fix_word; {the current trial interval length}
+@!k:integer; {the size of a minimum cover}
+begin if memory[h]>m then
+ begin excess:=memory[h]-m;
+ k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|}
+ repeat d:=d+d; k:=min_cover(h,d);
+ until k<=m; {first we ascend rapidly until finding the range}
+ d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps}
+ while k>m do
+ begin d:=next_d; k:=min_cover(h,d);
+ end;
+ shorten:=d;
+ end
+else shorten:=0;
+end;
+
+@ When we are nearly ready to output the \.{TFM} file, we will set
+|index[p]:=k| if the dimension in |memory[p]| is being rounded to the
+|k|th element of its list.
+
+@<Glob...@>=
+@!index:array[pointer] of byte;
+@!excess:byte; {number of words to remove, if list is being shortened}
+
+@ Here is the procedure that sets the |index| values. It also shortens
+the list so that there is only one element per covering interval;
+the remaining elements are the midpoints of their clusters.
+
+@p procedure set_indices(@!h:pointer;@!d:fix_word); {reduces and indexes a list}
+var p:pointer; {the current node of interest}
+@!q:pointer; {trails one step behind |p|}
+@!m:byte; {index number of nodes in the current interval}
+@!l:fix_word; {least value in the current interval}
+begin q:=h; p:=link[q]; m:=0;
+while p<>0 do
+ begin incr(m); l:=memory[p]; index[p]:=m;
+ while memory[link[p]]<=l+d do
+ begin p:=link[p]; index[p]:=m; decr(excess);
+ if excess=0 then d:=0;
+ end;
+ link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p];
+ end;
+memory[h]:=m;
+end;
+
+@* The input phase.
+We're ready now to read and parse the \.{VPL} file, storing property
+values as we go.
+
+@<Glob...@>=
+@!c:byte; {the current character or byte being processed}
+@!x:fix_word; {current dimension of interest}
+@!k:integer; {general-purpose index}
+
+@ @<Read all the input@>=
+cur_char:=" ";
+repeat while cur_char=" " do get_next;
+if cur_char="(" then @<Read a font property value@>
+else if (cur_char=")")and not input_has_ended then
+ begin err_print('Extra right parenthesis');
+ incr(loc); cur_char:=" ";
+ end
+@.Extra right parenthesis@>
+else if not input_has_ended then junk_error;
+until input_has_ended
+
+@ The |junk_error| routine just referred to is called when something
+appears in the forbidden area between properties of a property list.
+
+@p procedure junk_error; {gets past no man's land}
+begin err_print('There''s junk here that is not in parentheses');
+@.There's junk here...@>
+skip_to_paren;
+end;
+
+@ For each font property, we are supposed to read the data from the
+left parenthesis that is the current value of |cur_char| to the right
+parenthesis that matches it in the input. The main complication is
+to recover with reasonable grace from various error conditions that might arise.
+
+@<Read a font property value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code>character_code then
+ flush_error('This property name doesn''t belong on the outer level')
+@.This property name doesn't belong...@>
+else begin @<Read the font property value specified by |cur_code|@>;
+ finish_the_property;
+ end;
+end
+
+@ @<Read the font property value spec...@>=
+case cur_code of
+check_sum_code: begin check_sum_specified:=true; read_four_bytes(check_sum_loc);
+ end;
+design_size_code: @<Read the design size@>;
+design_units_code: @<Read the design units@>;
+coding_scheme_code: read_BCPL(coding_scheme_loc,40);
+family_code: read_BCPL(family_loc,20);
+face_code:header_bytes[face_loc]:=get_byte;
+seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
+header_code: @<Read an indexed header word@>;
+font_dimen_code: @<Read font parameter list@>;
+lig_table_code: read_lig_kern;
+boundary_char_code: bchar:=get_byte;
+virtual_title_code: begin vtitle_start:=vf_ptr; copy_to_end_of_item;
+ if vf_ptr>vtitle_start+255 then
+ begin err_print('VTITLE clipped to 255 characters'); vtitle_length:=255;
+@.VTITLE clipped...@>
+ end
+ else vtitle_length:=vf_ptr-vtitle_start;
+ end;
+map_font_code:@<Read a local font list@>;
+character_code: read_char_info;
+end
+
+@ The |case| statement just given makes use of three subroutines that we
+haven't defined yet. The first of these puts a 32-bit octal quantity
+into four specified bytes of the header block.
+
+@p procedure read_four_bytes(l:header_index);
+begin get_four_bytes;
+header_bytes[l]:=c0;
+header_bytes[l+1]:=c1;
+header_bytes[l+2]:=c2;
+header_bytes[l+3]:=c3;
+end;
+
+@ The second little procedure is used to scan a string and to store it in
+the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed
+to contain at most |n| bytes, including the first byte (which holds the
+length of the rest of the string).
+
+@p procedure read_BCPL(l:header_index;n:byte);
+var k:header_index;
+begin k:=l;
+while cur_char=" " do get_next;
+while (cur_char<>"(")and(cur_char<>")") do
+ begin if k<l+n then incr(k);
+ if k<l+n then header_bytes[k]:=cur_char;
+ get_next;
+ end;
+if k=l+n then
+ begin err_print('String is too long; its first ',n-1:1,
+@.String is too long...@>
+ ' characters will be kept'); decr(k);
+ end;
+header_bytes[l]:=k-l;
+while k<l+n-1 do {tidy up the remaining bytes by setting them to nulls}
+ begin incr(k); header_bytes[k]:=0;
+ end;
+end;
+
+@ @<Read the design size@>=
+begin next_d:=get_fix;
+if next_d<unity then
+ err_print('The design size must be at least 1')
+@.The design size must...@>
+else design_size:=next_d;
+end
+
+@ @<Read the design units@>=
+begin next_d:=get_fix;
+if next_d<=0 then
+ err_print('The number of units per design size must be positive')
+@.The number of units...@>
+else if frozen_du then
+ err_print('Sorry, it''s too late to change the design units')
+@.Sorry, it's too late...@>
+else design_units:=next_d;
+end
+
+@ @<Read the seven-bit-safe...@>=
+begin while cur_char=" " do get_next;
+if cur_char="T" then seven_bit_safe_flag:=true
+else if cur_char="F" then seven_bit_safe_flag:=false
+else err_print('The flag value should be "TRUE" or "FALSE"');
+@.The flag value should be...@>
+skip_to_paren;
+end
+
+@ @<Read an indexed header word@>=
+begin c:=get_byte;
+if c<18 then skip_error('HEADER indices should be 18 or more')
+@.HEADER indices...@>
+else if 4*c+4>max_header_bytes then
+ skip_error('This HEADER index is too big for my present table size')
+@.This HEADER index is too big...@>
+else begin while header_ptr<4*c+4 do
+ begin header_bytes[header_ptr]:=0; incr(header_ptr);
+ end;
+ read_four_bytes(4*c);
+ end;
+end
+
+@ The remaining kinds of font property values that need to be read are
+those that involve property lists on higher levels. Each of these has a
+loop similar to the one that was used at level zero. Then we put the
+right parenthesis back so that `|finish_the_property|' will be happy;
+there is probably a more elegant way to do this.
+
+@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")";
+ end
+
+@<Read font parameter list@>=
+begin while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a parameter value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a parameter value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
+ flush_error('This property name doesn''t belong in a FONTDIMEN list')
+@.This property name doesn't belong...@>
+else begin if cur_code=parameter_code then c:=get_byte
+ else c:=cur_code-parameter_code;
+ if c=0 then flush_error('PARAMETER index must not be zero')
+@.PARAMETER index must not...@>
+ else if c>max_param_words then
+ flush_error('This PARAMETER index is too big for my present table size')
+@.This PARAMETER index is too big...@>
+ else begin while np<c do
+ begin incr(np); param[np]:=0;
+ end;
+ param[c]:=get_fix;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @d numbers_differ==(font_number[cur_font].b3<>font_number[font_ptr].b3)or@|
+(font_number[cur_font].b2<>font_number[font_ptr].b2)or@|
+(font_number[cur_font].b1<>font_number[font_ptr].b1)or@|
+(font_number[cur_font].b0<>font_number[font_ptr].b0)
+
+@<Read a local font list@>=
+begin get_four_bytes; font_number[font_ptr]:=cur_bytes; cur_font:=0;
+while numbers_differ do incr(cur_font);
+if cur_font=font_ptr then {it's a new font number}
+ if font_ptr<256 then @<Initialize a new local font@>
+ else err_print('I can handle only 256 different mapfonts');
+@.I can handle only 256...@>
+if cur_font=font_ptr then skip_to_end_of_item
+else while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a local font property@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Initialize a new local font@>=
+begin incr(font_ptr);
+fname_start[cur_font]:=vf_size; fname_length[cur_font]:=4; {\.{NULL}}
+farea_start[cur_font]:=vf_size; farea_length[cur_font]:=0;
+font_checksum[cur_font]:=zero_bytes;
+font_at[cur_font]:=@'4000000; {denotes design size of this virtual font}
+font_dsize[cur_font]:=@'50000000; {the |fix_word| for 10}
+end
+
+@ @<Read a local font property@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<font_name_code)or(cur_code>font_dsize_code) then
+ flush_error('This property name doesn''t belong in a MAPFONT list')
+@.This property name doesn't belong...@>
+else begin case cur_code of
+ font_name_code:@<Read a local font name@>;
+ font_area_code:@<Read a local font area@>;
+ font_checksum_code:begin get_four_bytes; font_checksum[cur_font]:=cur_bytes;
+ end;
+ font_at_code: begin frozen_du:=true;
+ if design_units=unity then font_at[cur_font]:=get_fix
+ else font_at[cur_font]:=round((get_fix/design_units)*1048576.0);
+ end;
+ font_dsize_code:font_dsize[cur_font]:=get_fix;
+ end; {there are no other cases}
+ finish_the_property;
+ end;
+end
+
+@ @<Read a local font name@>=
+begin fname_start[cur_font]:=vf_ptr; copy_to_end_of_item;
+if vf_ptr>fname_start[cur_font]+255 then
+ begin err_print('FONTNAME clipped to 255 characters');
+@.FONTNAME clipped...@>
+ fname_length[cur_font]:=255;
+ end
+else fname_length[cur_font]:=vf_ptr-fname_start[cur_font];
+end
+
+@ @<Read a local font area@>=
+begin farea_start[cur_font]:=vf_ptr; copy_to_end_of_item;
+if vf_ptr>farea_start[cur_font]+255 then
+ begin err_print('FONTAREA clipped to 255 characters');
+@.FONTAREA clipped...@>
+ farea_length[cur_font]:=255;
+ end
+else farea_length[cur_font]:=vf_ptr-farea_start[cur_font];
+end
+
+@ @<Read ligature/kern list@>=
+begin lk_step_ended:=false;
+while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a ligature/kern command@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a ligature/kern command@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<label_code then
+ flush_error('This property name doesn''t belong in a LIGTABLE list')
+@.This property name doesn't belong...@>
+else begin case cur_code of
+ label_code:@<Read a label step@>;
+ stop_code:@<Read a stop step@>;
+ skip_code:@<Read a skip step@>;
+ krn_code:@<Read a kerning step@>;
+ lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,lig_code+7,
+ lig_code+11:@<Read a ligature step@>;
+ end; {there are no other cases |>=label_code|}
+ finish_the_property;
+ end;
+end
+
+@ When a character is about to be tagged, we call the following
+procedure so that an error message is given in case of multiple tags.
+
+@p procedure check_tag(c:byte); {print error if |c| already tagged}
+begin case char_tag[c] of
+no_tag: do_nothing;
+lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
+@.This character already...@>
+list_tag: err_print('This character already has a NEXTLARGER spec');
+ext_tag: err_print('This character already has a VARCHAR spec');
+end;
+end;
+
+@ @<Read a label step@>=
+begin while cur_char=" " do get_next;
+if cur_char="B" then
+ begin bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
+ end
+else begin backup; c:=get_byte;
+ check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
+ end;
+if min_nl<=nl then min_nl:=nl+1;
+lk_step_ended:=false;
+end
+
+@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@<Globals...@>=
+@!lk_step_ended:boolean;
+ {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?}
+@!krn_ptr:0..max_kerns; {an index into |kern|}
+
+@ @<Read a stop step@>=
+if not lk_step_ended then
+ err_print('STOP must follow LIG or KRN')
+@.STOP must follow LIG or KRN@>
+else begin lig_kern[nl-1].b0:=stop_flag; lk_step_ended:=false;
+ end
+
+@ @<Read a skip step@>=
+if not lk_step_ended then
+ err_print('SKIP must follow LIG or KRN')
+@.SKIP must follow LIG or KRN@>
+else begin c:=get_byte;
+ if c>=128 then err_print('Maximum SKIP amount is 127')
+@.Maximum SKIP amount...@>
+ else if nl+c>=max_lig_steps then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+ else begin lig_kern[nl-1].b0:=c;
+ if min_nl<=nl+c then min_nl:=nl+c+1;
+ end;
+ lk_step_ended:=false;
+ end
+
+@ @<Read a ligature step@>=
+begin lig_kern[nl].b0:=0;
+lig_kern[nl].b2:=cur_code-lig_code;
+lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b3:=get_byte;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read a kerning step@>=
+begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
+kern[nk]:=get_fix; krn_ptr:=0;
+while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
+if krn_ptr=nk then
+ begin if nk<max_kerns then incr(nk)
+ else begin err_print('Sorry, too many different kerns for me to handle');
+@.Sorry, too many different kerns...@>
+ decr(krn_ptr);
+ end;
+ end;
+lig_kern[nl].b2:=kern_flag+(krn_ptr div 256);
+lig_kern[nl].b3:=krn_ptr mod 256;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ Finally we come to the part of \.{VPtoVF}'s input mechanism
+that is used most, the processing of individual character data.
+
+@<Read character info list@>=
+begin c:=get_byte; {read the character code that is being specified}
+@<Print |c| in octal notation@>;
+while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a character property@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
+finish_inner_property_list;
+end
+
+@ @<Read a character prop...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<char_wd_code)or(cur_code>var_char_code) then
+ flush_error('This property name doesn''t belong in a CHARACTER list')
+@.This property name doesn't belong...@>
+else begin case cur_code of
+ char_wd_code:char_wd[c]:=sort_in(width,get_fix);
+ char_ht_code:char_ht[c]:=sort_in(height,get_fix);
+ char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
+ char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
+ next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
+ char_remainder[c]:=get_byte;
+ end;
+ map_code:read_packet(c);
+ var_char_code:@<Read an extensible recipe for |c|@>;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ @<Read an extensible r...@>=
+begin if ne=256 then
+ err_print('At most 256 VARCHAR specs are allowed')
+@.At most 256 VARCHAR specs...@>
+else begin check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
+ exten[ne]:=zero_bytes;
+ while level=2 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an extensible piece@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ incr(ne);
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an extensible p...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then
+ flush_error('This property name doesn''t belong in a VARCHAR list')
+@.This property name doesn't belong...@>
+else begin case cur_code-(var_char_code+1) of
+ 0:exten[ne].b0:=get_byte;
+ 1:exten[ne].b1:=get_byte;
+ 2:exten[ne].b2:=get_byte;
+ 3:exten[ne].b3:=get_byte;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@* Assembling the mappings.
+Each \.{MAP} property is a sequence of \.{DVI} instructions, for which
+we need to know some of the opcodes.
+
+@d set_char_0=0 {\.{DVI} command to typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+
+@ We keep stacks of movement values, in order to optimize the \.{DVI} code
+in simple cases.
+
+@<Glob...@>=
+@!hstack:array[0..max_stack] of 0..2; {number of known horizontal movements}
+@!vstack:array[0..max_stack] of 0..2; {number of known vertical movements}
+@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of fix_word;
+@!stack_ptr:0..max_stack;
+
+@ The packet is built by straightforward assembly of \.{DVI} instructions.
+
+@p @<Declare the |vf_fix| procedure@>@;@/
+procedure read_packet(@!c:byte);
+var @!cc:byte; {character being typeset}
+@!x:fix_word; {movement}
+@!h,@!v:0..2; {top of |hstack| and |vstack|}
+@!special_start:0..vf_size; {location of |xxx1| command}
+@!k:0..vf_size; {loop index}
+begin packet_start[c]:=vf_ptr; stack_ptr:=0; h:=0; v:=0;
+cur_font:=0;
+while level=2 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read and assemble a list of \.{DVI} commands@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+while stack_ptr>0 do
+ begin err_print('Missing POP supplied');
+@.Missing POP supplied@>
+ vf_store(pop); decr(stack_ptr);
+ end;
+packet_length[c]:=vf_ptr-packet_start[c];
+finish_inner_property_list;
+end;
+
+@ @<Read and assemble a list of \.{DVI}...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<select_font_code)or(cur_code>special_hex_code) then
+ flush_error('This property name doesn''t belong in a MAP list')
+@.This property name doesn't belong...@>
+else begin case cur_code of
+ select_font_code:@<Assemble a font selection@>;
+ set_char_code:@<Assemble a typesetting instruction@>;
+ set_rule_code:@<Assemble a rulesetting instruction@>;
+ move_right_code,move_right_code+1:@<Assemble a horizontal movement@>;
+ move_down_code,move_down_code+1:@<Assemble a vertical movement@>;
+ push_code:@<Assemble a stack push@>;
+ pop_code:@<Assemble a stack pop@>;
+ special_code,special_hex_code:@<Assemble a special command@>;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ @<Assemble a font selection@>=
+begin get_four_bytes; font_number[font_ptr]:=cur_bytes;
+cur_font:=0;
+while numbers_differ do incr(cur_font);
+if cur_font=font_ptr then err_print('Undefined MAPFONT cannot be selected')
+@.Undefined MAPFONT...@>
+else if cur_font<64 then vf_store(fnt_num_0+cur_font)
+else begin vf_store(fnt1); vf_store(cur_font);
+ end;
+end
+
+@ @<Assemble a typesetting instruction@>=
+if cur_font=font_ptr then
+ err_print('Character cannot be typeset in undefined font')
+@.Character cannot be typeset...@>
+else begin cc:=get_byte;
+ if cc>=128 then vf_store(set1);
+ vf_store(cc);
+ end
+
+@ Here's a procedure that converts a |fix_word| to a sequence of
+\.{DVI} bytes.
+
+@<Declare the |vf_fix|...@>=
+procedure vf_fix(@!opcode:byte;@!x:fix_word);
+var negative:boolean;
+@!k:0..4; {number of bytes to typeset}
+@!t:integer; {threshold}
+begin frozen_du:=true;
+if design_units<>unity then x:=round((x/design_units)*1048576.0);
+if x>=0 then negative:=false
+else begin negative:=true; x:=-1-x;@+end;
+if opcode=0 then
+ begin k:=4; t:=@'100000000;@+end
+else begin t:=127; k:=1;
+ while x>t do
+ begin t:=256*t+255; incr(k);
+ end;
+ vf_store(opcode+k-1); t:=t div 128 +1;
+ end;
+repeat if negative then
+ begin vf_store(255-(x div t)); negative:=false;
+ x:=(x div t)*t+t-1-x;
+ end
+else vf_store((x div t) mod 256);
+decr(k); t:=t div 256;
+until k=0;
+end;
+
+@ @<Assemble a rulesetting instruction@>=
+begin vf_store(set_rule); vf_fix(0,get_fix); vf_fix(0,get_fix);
+end
+
+@ @<Assemble a horizontal movement@>=
+begin if cur_code=move_right_code then x:=get_fix@+else x:=-get_fix;
+if h=0 then
+ begin wstack[stack_ptr]:=x; h:=1; vf_fix(w1,x);@+end
+else if x=wstack[stack_ptr] then vf_store(w0)
+else if h=1 then
+ begin xstack[stack_ptr]:=x; h:=2; vf_fix(x1,x);@+end
+else if x=xstack[stack_ptr] then vf_store(x0)
+else vf_fix(right1,x);
+end
+
+@ @<Assemble a vertical movement@>=
+begin if cur_code=move_down_code then x:=get_fix@+else x:=-get_fix;
+if v=0 then
+ begin ystack[stack_ptr]:=x; v:=1; vf_fix(y1,x);@+end
+else if x=ystack[stack_ptr] then vf_store(y0)
+else if v=1 then
+ begin zstack[stack_ptr]:=x; v:=2; vf_fix(z1,x);@+end
+else if x=zstack[stack_ptr] then vf_store(z0)
+else vf_fix(down1,x);
+end
+
+@ @<Assemble a stack push@>=
+if stack_ptr=max_stack then {too pushy}
+ err_print('Don''t push so much---stack is full!')
+@.Don't push so much...@>
+else begin vf_store(push); hstack[stack_ptr]:=h; vstack[stack_ptr]:=v;
+ incr(stack_ptr); h:=0; v:=0;
+ end
+
+@ @<Assemble a stack pop@>=
+if stack_ptr=0 then
+ err_print('Empty stack cannot be popped')
+@.Empty stack...@>
+else begin vf_store(pop); decr(stack_ptr);
+ h:=hstack[stack_ptr]; v:=vstack[stack_ptr];
+ end
+
+@ @<Assemble a special command@>=
+begin vf_store(xxx1); vf_store(0); {dummy length}
+special_start:=vf_ptr;
+if cur_code=special_code then copy_to_end_of_item
+else begin repeat x:=get_hex;
+ if cur_char>")" then vf_store(x*16+get_hex);
+ until cur_char<=")";
+ end;
+if vf_ptr-special_start>255 then @<Convert |xxx1| command to |xxx4|@>
+else vf[special_start-1]:=vf_ptr-special_start;
+end
+
+@ @<Convert |xxx1|...@>=
+if vf_ptr+3>vf_size then
+ begin err_print('Special command being clipped---no room left!');
+@.Special command being clipped...@>
+ vf_ptr:=special_start+255; vf[special_start-1]:=255;
+ end
+else begin for k:=vf_ptr downto special_start do vf[k+3]:=vf[k];
+ x:=vf_ptr-special_start; vf_ptr:=vf_ptr+3;
+ vf[special_start-2]:=xxx4;
+ vf[special_start-1]:=x div @'100000000;
+ vf[special_start]:=(x div @'200000) mod 256;
+ vf[special_start+1]:=(x div @'400) mod 256;
+ vf[special_start+2]:=x mod 256;
+ end
+
+@ The input routine is now complete except for the following code,
+which prints a progress report as the file is being read.
+
+@p procedure print_octal(c:byte); {prints three octal digits}
+begin print('''',(c div 64):1,((c div 8) mod 8):1,(c mod 8):1);
+end;
+
+@ @<Print |c| in octal...@>=
+begin if chars_on_line=8 then
+ begin print_ln(' '); chars_on_line:=1;
+ end
+else begin if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+print_octal(c); {progress report}
+end
+
+@* The checking and massaging phase.
+Once the whole \.{VPL} file has been read in, we must check it for consistency
+and correct any errors. This process consists mainly of running through
+the characters that exist and seeing if they refer to characters that
+don't exist. We also compute the true value of |seven_unsafe|; we make sure
+that the charlists and ligature programs contain no loops; and we
+shorten the lists of widths, heights, depths, and italic corrections,
+if necessary, to keep from exceeding the required maximum sizes.
+
+@<Glob...@>=
+@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?}
+
+@ @<Correct and check the information@>=
+if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>;
+seven_unsafe:=false;
+for c:=0 to 255 do if char_wd[c]<>0 then
+ @<For all characters |g| generated by |c|,
+ make sure that |char_wd[g]| is nonzero, and
+ set |seven_unsafe| if |c<128<=g|@>;
+if bchar_label<@'77777 then
+ begin c:=256; @<Check ligature program of |c|@>;
+ end;
+if seven_bit_safe_flag and seven_unsafe then
+ print_ln('The font is not really seven-bit-safe!');
+@.The font is not...safe@>
+@<Check for infinite ligature loops@>;
+@<Doublecheck the lig/kern commands and the extensible recipes@>;
+for c:=0 to 255 do
+ @<Make sure that |c| is not the largest element of a charlist cycle@>;
+@<Put the width, height, depth, and italic lists into final form@>
+
+@ The checking that we need in several places is accomplished by three
+macros that are only slightly tricky.
+
+@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0);
+ print(#,' '); print_octal(c);
+ print_ln(' had no CHARACTER spec.');
+ end;
+ end
+@d check_existence_and_safety(#)==begin g:=#;
+ if (g>=128)and(c<128) then seven_unsafe:=true;
+ if char_wd[g]=0 then existence_tail
+@d check_existence(#)==begin g:=#;
+ if char_wd[g]=0 then existence_tail
+
+@<For all characters |g| generated by |c|...@>=
+case char_tag[c] of
+no_tag: do_nothing;
+lig_tag: @<Check ligature program of |c|@>;
+list_tag: check_existence_and_safety(char_remainder[c])
+ ('The character NEXTLARGER than');
+@.The character NEXTLARGER...@>
+ext_tag:@<Check the pieces of |exten[c]|@>;
+end
+
+@ @<Check the pieces...@>=
+begin if exten[char_remainder[c]].b0>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b0)
+ ('TOP piece of character');
+@.TOP piece of character...@>
+if exten[char_remainder[c]].b1>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b1)
+ ('MID piece of character');
+@.MID piece of character...@>
+if exten[char_remainder[c]].b2>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b2)
+ ('BOT piece of character');
+@.BOT piece of character...@>
+check_existence_and_safety(exten[char_remainder[c]].b3)
+ ('REP piece of character');
+@.REP piece of character...@>
+end
+
+@ @<Make sure that |c| is not the largest element of a charlist cycle@>=
+if char_tag[c]=list_tag then
+ begin g:=char_remainder[c];
+ while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g];
+ if g=c then
+ begin char_tag[c]:=no_tag;
+ print('A cycle of NEXTLARGER characters has been broken at ');
+@.A cycle of NEXTLARGER...@>
+ print_octal(c); print_ln('.');
+ end;
+ end
+
+@ @<Glob...@>=
+@!delta:fix_word; {size of the intervals needed for rounding}
+
+@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
+@.I had to round...@>
+ #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
+
+@<Put the width, height, depth, and italic lists into final form@>=
+delta:=shorten(width,255); set_indices(width,delta); round_message('width');@/
+delta:=shorten(height,15); set_indices(height,delta); round_message('height');@/
+delta:=shorten(depth,15); set_indices(depth,delta); round_message('depth');@/
+delta:=shorten(italic,63); set_indices(italic,delta);
+ round_message('italic correction');
+
+@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}}
+ lig_kern[nl].b0:=255; lig_kern[nl].b1:=0;
+ lig_kern[nl].b2:=0; lig_kern[nl].b3:=0
+
+@<Make sure the ligature/kerning program ends...@>=
+begin if bchar_label<@'77777 then {make room for it}
+ begin clear_lig_kern_entry; incr(nl);
+ end; {|bchar_label| will be stored later}
+while min_nl>nl do
+ begin clear_lig_kern_entry; incr(nl);
+ end;
+if lig_kern[nl-1].b0=0 then lig_kern[nl-1].b0:=stop_flag;
+end
+
+@ It's not trivial to check for infinite loops generated by repeated
+insertion of ligature characters. But fortunately there is a nice
+algorithm for such testing, copied here from the program \.{TFtoPL}
+where it is explained further.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+
+@ @<Glo...@>=
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!hash:array[0..hash_size] of 0..66048; {$256x+y+1$ for $x\le257$ and $y\le255$}
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of 0..257;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!tt:indx; {temporary register}
+@!x_lig_cycle,@!y_lig_cycle:0..256; {problematic ligature pair}
+
+@ @<Set init...@>=
+hash_ptr:=0; y_lig_cycle:=256;
+for k:=0 to hash_size do hash[k]:=0;
+
+@ @d lig_exam==lig_kern[lig_ptr].b1
+@d lig_gen==lig_kern[lig_ptr].b3
+
+@<Check lig...@>=
+begin lig_ptr:=char_remainder[c];
+repeat if hash_input(lig_ptr,c) then
+ begin if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_exam<>bchar then
+ check_existence(lig_exam)('LIG character examined by');
+@.LIG character examined...@>
+ check_existence(lig_gen)('LIG character generated by');
+@.LIG character generated...@>
+ if lig_gen>=128 then if(c<128)or(c=256) then
+ if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true;
+ end
+ else if lig_exam<>bchar then
+ check_existence(lig_exam)('KRN character examined by');
+@.KRN character examined...@>
+ end;
+if lig_kern[lig_ptr].b0>=stop_flag then lig_ptr:=nl
+else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0;
+until lig_ptr>=nl;
+end
+
+@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made
+into a boolean function that returns |false| if the ligature command
+was masked by a previous one.
+
+@p function hash_input(@!p,@!c:indx):boolean;
+ {enter data for character |c| and command in location |p|, unless it isn't new}
+label 30; {go here for a quick exit}
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:0..255; {function value or ligature character being entered}
+@!y:0..255; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then
+ begin hash_input:=false; goto 30;@+end;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=256*c+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then
+ begin hash_input:=false; goto 30; {unused ligature command}
+ end;
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+hash_input:=true;
+30:end;
+
+@ @<Compute the command param...@>=
+y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple;
+zz:=lig_kern[p].b3;
+if t>=kern_flag then zz:=y
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ (More good stuff from \.{TFtoPL}.)
+
+@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=256*x+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:indx):indx| here.
+
+@p function f;
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=257; class[h]:=simple;
+ end; {the value 257 will break all cycles, since it's not in |hash|}
+end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@ @<Check for infinite...@>=
+if hash_ptr<hash_size then for hh:=1 to hash_ptr do
+ begin tt:=hash_list[hh];
+ if class[tt]>simple then {make sure $f$ is well defined}
+ tt:=f(tt,(hash[tt]-1)div 256,(hash[tt]-1)mod 256);
+ end;
+if(hash_ptr=hash_size)or(y_lig_cycle<256) then
+ begin if hash_ptr<hash_size then
+ begin print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=256 then print('boundary')@+else print_octal(x_lig_cycle);
+ print(' and '); print_octal(y_lig_cycle); print_ln('!');
+ end
+ else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ print_ln('All ligatures will be cleared.');
+ for c:=0 to 255 do if char_tag[c]=lig_tag then
+ begin char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+ nl:=0; bchar:=256; bchar_label:=@'77777;
+ end
+
+@ The lig/kern program may still contain references to nonexistent characters,
+if parts of that program are never used. Similarly, there may be extensible
+characters that are never used, because they were overridden by
+\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we
+must fix such errors.
+
+@d double_check_tail(#)==@t\1@>if char_wd[0]=0
+ then char_wd[0]:=sort_in(width,0);
+ print('Unused ',#,' refers to nonexistent character ');
+ print_octal(c); print_ln('!');
+ end;
+ end
+@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#;
+ if char_wd[c]=0 then if c<>bchar then
+ begin lig_kern[lig_ptr].#:=0; double_check_tail
+@d double_check_ext(#)==begin c:=exten[g].#;
+ if c>0 then if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+@d double_check_rep(#)==begin c:=exten[g].#;
+ if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+
+@<Doublecheck...@>=
+if nl>0 then for lig_ptr:=0 to nl-1 do
+ if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_kern[lig_ptr].b0<255 then
+ begin double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
+ end;
+ end
+ else double_check_lig(b1)('KRN step');
+@.Unused LIG step...@>
+@.Unused KRN step...@>
+if ne>0 then for g:=0 to ne-1 do
+ begin double_check_ext(b0)('VARCHAR TOP');
+ double_check_ext(b1)('VARCHAR MID');
+ double_check_ext(b2)('VARCHAR BOT');
+ double_check_rep(b3)('VARCHAR REP');
+@.Unused VARCHAR...@>
+ end
+
+@* The TFM output phase.
+Now that we know how to get all of the font data correctly stored in
+\.{VPtoVF}'s memory, it only remains to write the answers out.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{TFM} file:
+
+@d out(#)==write(tfm_file,#)
+
+@ The general plan for producing \.{TFM} files is long but simple:
+
+@<Do the \.{TFM} output@>=
+@<Compute the twelve subfile sizes@>;
+@<Output the twelve subfile sizes@>;
+@<Output the header block@>;
+@<Output the character info@>;
+@<Output the dimensions themselves@>;
+@<Output the ligature/kern program@>;
+@<Output the extensible character recipes@>;
+@<Output the parameters@>
+
+@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are.
+We already know most of these numbers; for example, the number of distinct
+widths is |memory[width]+1|, where the $+1$ accounts for the zero width that
+is always supposed to be present. But we still should compute the beginning
+and ending character codes (|bc| and |ec|), the number of header words (|lh|),
+and the total number of words in the \.{TFM} file (|lf|).
+
+@<Gl...@>=
+@!bc:byte; {the smallest character code in the font}
+@!ec:byte; {the largest character code in the font}
+@!lh:byte; {the number of words in the header block}
+@!lf:0..32767; {the number of words in the entire \.{TFM} file}
+@!not_found:boolean; {has a font character been found?}
+@!temp_width:fix_word; {width being used to compute a check sum}
+
+@ It might turn out that no characters exist at all. But \.{VPtoVF} keeps
+going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
+will be~1.
+
+@<Compute the twelve...@>=
+lh:=header_ptr div 4;@/
+not_found:=true; bc:=0;
+while not_found do
+ if (char_wd[bc]>0)or(bc=255) then not_found:=false
+ else incr(bc);
+not_found:=true; ec:=255;
+while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+if bc>ec then bc:=1;
+incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+incr(memory[italic]);@/
+@<Compute the ligature/kern program offset@>;
+lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+memory[italic]+nl+lk_offset+nk+ne+np;
+
+@ @d out_size(#)==out((#) div 256); out((#) mod 256)
+
+@<Output the twelve subfile sizes@>=
+out_size(lf); out_size(lh); out_size(bc); out_size(ec);
+out_size(memory[width]); out_size(memory[height]);
+out_size(memory[depth]); out_size(memory[italic]);
+out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np);
+
+@ The routines that follow need a few temporary variables of different types.
+
+@<Gl...@>=
+@!j:0..max_header_bytes; {index into |header_bytes|}
+@!p:pointer; {index into |memory|}
+@!q:width..italic; {runs through the list heads for dimensions}
+@!par_ptr:0..max_param_words; {runs through the parameters}
+
+@ The header block follows the subfile sizes. The necessary information all
+appears in |header_bytes|, except that the design size and the seven-bit-safe
+flag must still be set.
+
+@<Output the header block@>=
+if not check_sum_specified then @<Compute the check sum@>;
+header_bytes[design_size_loc]:=design_size div @'100000000;
+ {this works since |design_size>0|}
+header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256;
+header_bytes[design_size_loc+2]:=(design_size div 256) mod 256;
+header_bytes[design_size_loc+3]:=design_size mod 256;
+if not seven_unsafe then header_bytes[seven_flag_loc]:=128;
+for j:=0 to header_ptr-1 do out(header_bytes[j]);
+
+@ @<Compute the check sum@>=
+begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
+for c:=bc to ec do if char_wd[c]>0 then
+ begin temp_width:=memory[char_wd[c]];
+ if design_units<>unity then
+ temp_width:=round((temp_width/design_units)*1048576.0);
+ temp_width:=temp_width + (c+4)*@'20000000; {this should be positive}
+ c0:=(c0+c0+temp_width) mod 255;
+ c1:=(c1+c1+temp_width) mod 253;
+ c2:=(c2+c2+temp_width) mod 251;
+ c3:=(c3+c3+temp_width) mod 247;
+ end;
+header_bytes[check_sum_loc]:=c0;
+header_bytes[check_sum_loc+1]:=c1;
+header_bytes[check_sum_loc+2]:=c2;
+header_bytes[check_sum_loc+3]:=c3;
+end
+
+@ The next block contains packed |char_info|.
+
+@<Output the character info@>=
+index[0]:=0;
+for c:=bc to ec do
+ begin out(index[char_wd[c]]);
+ out(index[char_ht[c]]*16+index[char_dp[c]]);
+ out(index[char_ic[c]]*4+char_tag[c]);
+ out(char_remainder[c]);
+ end
+
+@ When a scaled quantity is output, we may need to divide it by |design_units|.
+The following subroutine takes care of this, using floating point arithmetic
+only if |design_units<>1.0|.
+
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if abs(x/design_units)>=16.0 then
+ begin print_ln('The relative dimension ',x/@'4000000:1:3,
+ ' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then print(' =',design_units/@'200000:1:3,
+ ' designunits');
+ print_ln(')'); x:=0;
+ end;
+if design_units<>unity then x:=round((x/design_units)*1048576.0);
+if x<0 then
+ begin out(255); x:=x+@'100000000;
+ if x<=0 then x:=1;
+ end
+else begin out(0);
+ if x>=@'100000000 then x:=@'77777777;
+ end;
+n:=x div @'200000; m:=x mod @'200000;
+out(n); out(m div 256); out(m mod 256);
+end;
+
+@ We have output the packed indices for individual characters.
+The scaled widths, heights, depths, and italic corrections are next.
+
+@<Output the dimensions themselves@>=
+for q:=width to italic do
+ begin out(0); out(0); out(0); out(0); {output the zero word}
+ p:=link[q]; {head of list}
+ while p>0 do
+ begin out_scaled(memory[p]);
+ p:=link[p];
+ end;
+ end;
+
+@ One embarrassing problem remains: The ligature/kern program might be very
+long, but the starting addresses in |char_remainder| can be at most~255.
+Therefore we need to output some indirect address information; we want to
+compute |lk_offset| so that addition of |lk_offset| to all remainders makes
+all but |lk_offset| distinct remainders less than~256.
+
+For this we need a sorted table of all relevant remainders.
+
+@<Glob...@>=
+@!label_table:array[0..256] of record
+ @!rr: -1..@'77777; {sorted label values}
+ @!cc: byte; {associated characters}
+ end;
+@!label_ptr:0..256; {index of highest entry in |label_table|}
+@!sort_ptr:0..256; {index into |label_table|}
+@!lk_offset:0..256; {smallest offset value that might work}
+@!t:0..@'77777; {label value that is being redirected}
+@!extra_loc_needed:boolean; {do we need a special word for |bchar|?}
+
+@ @<Compute the ligature/kern program offset@>=
+@<Insert all labels into |label_table|@>;
+if bchar<256 then
+ begin extra_loc_needed:=true; lk_offset:=1;
+ end
+else begin extra_loc_needed:=false; lk_offset:=0;
+ end;
+@<Find the minimum |lk_offset| and adjust all remainders@>;
+if bchar_label<@'77777 then
+ begin lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 256;
+ lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 256;
+ end
+
+@ @<Insert all labels...@>=
+label_ptr:=0; label_table[0].rr:=-1; {sentinel}
+for c:=bc to ec do if char_tag[c]=lig_tag then
+ begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+ while label_table[sort_ptr].rr>char_remainder[c] do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+ label_table[sort_ptr+1].cc:=c;
+ label_table[sort_ptr+1].rr:=char_remainder[c];
+ incr(label_ptr);
+ end
+
+@ @<Find the minimum |lk_offset| and adjust all remainders@>=
+begin sort_ptr:=label_ptr; {the largest unallocated label}
+if label_table[sort_ptr].rr+lk_offset > 255 then
+ begin lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
+ repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do
+ begin decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ end;
+ incr(lk_offset); decr(sort_ptr);
+ until lk_offset+label_table[sort_ptr].rr<256;
+ {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|}
+ end;
+if lk_offset>0 then while sort_ptr>0 do
+ begin char_remainder[label_table[sort_ptr].cc]:=
+ char_remainder[label_table[sort_ptr].cc]+lk_offset;
+ decr(sort_ptr);
+ end;
+end
+
+@ @<Output the ligature/kern program@>=
+if extra_loc_needed then {|lk_offset=1|}
+ begin out(255); out(bchar); out(0); out(0);
+ end
+else for sort_ptr:=1 to lk_offset do {output the redirection specs}
+ begin t:=label_table[label_ptr].rr;
+ if bchar<256 then
+ begin out(255); out(bchar);
+ end
+ else begin out(254); out(0);
+ end;
+ out_size(t+lk_offset);
+ repeat decr(label_ptr); until label_table[label_ptr].rr<t;
+ end;
+if nl>0 then for lig_ptr:=0 to nl-1 do
+ begin out(lig_kern[lig_ptr].b0);
+ out(lig_kern[lig_ptr].b1);
+ out(lig_kern[lig_ptr].b2);
+ out(lig_kern[lig_ptr].b3);
+ end;
+if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
+
+@ @<Output the extensible character recipes@>=
+if ne>0 then for c:=0 to ne-1 do
+ begin out(exten[c].b0);
+ out(exten[c].b1);
+ out(exten[c].b2);
+ out(exten[c].b3);
+ end;
+
+@ For our grand finale, we wind everything up by outputting the parameters.
+
+@<Output the parameters@>=
+for par_ptr:=1 to np do
+ begin if par_ptr=1 then
+ @<Output the slant (|param[1]|) without scaling@>
+ else out_scaled(param[par_ptr]);
+ end
+
+@ @<Output the slant...@>=
+begin if param[1]<0 then
+ begin param[1]:=param[1]+@'10000000000;
+ out((param[1] div @'100000000)+256-64);
+ end
+else out(param[1] div @'100000000);
+out((param[1] div @'200000) mod 256);
+out((param[1] div 256) mod 256);
+out(param[1] mod 256);
+end
+
+@* The VF output phase.
+Output to |vf_file| is considerably simpler.
+
+@d id_byte=202 {current version of \.{VF} format}
+@d vout(#)==write(vf_file,#)
+
+@<Glob...@>=
+@!vcount:integer; {number of bytes written to |vf_file|}
+
+@ We need a routine to output integers as four bytes. Negative values
+will never be less than $-2^{24}$.
+
+@p procedure vout_int(@!x:integer);
+begin if x>=0 then vout(x div @'100000000)
+else begin vout(255); x:=x+@'100000000;
+ end;
+vout((x div @'200000) mod 256);
+vout((x div @'400) mod 256); vout(x mod 256);
+end;
+
+@ @<Do the \.{VF} output@>=
+vout(pre); vout(id_byte); vout(vtitle_length);
+for k:=0 to vtitle_length-1 do vout(vf[vtitle_start+k]);
+for k:=check_sum_loc to design_size_loc+3 do vout(header_bytes[k]);
+vcount:=vtitle_length+11;
+for cur_font:=0 to font_ptr-1 do @<Output a local font definition@>;
+for c:=bc to ec do if char_wd[c]>0 then
+ @<Output a packet for character |c|@>;
+repeat vout(post); incr(vcount);
+until vcount mod 4 = 0
+
+@ @<Output a local font definition@>=
+begin vout(fnt_def1); vout(cur_font);@/
+vout(font_checksum[cur_font].b0);
+vout(font_checksum[cur_font].b1);
+vout(font_checksum[cur_font].b2);
+vout(font_checksum[cur_font].b3);
+vout_int(font_at[cur_font]);
+vout_int(font_dsize[cur_font]);
+vout(farea_length[cur_font]);
+vout(fname_length[cur_font]);
+for k:=0 to farea_length[cur_font]-1 do vout(vf[farea_start[cur_font]+k]);
+if fname_start[cur_font]=vf_size then
+ begin vout("N"); vout("U"); vout("L"); vout("L");
+ end
+else for k:=0 to fname_length[cur_font]-1 do vout(vf[fname_start[cur_font]+k]);
+vcount:=vcount+12+farea_length[cur_font]+fname_length[cur_font];
+end
+
+@ @<Output a packet for character |c|@>=
+begin x:=memory[char_wd[c]];
+if design_units<>unity then x:=round((x/design_units)*1048576.0);
+if (packet_length[c]>241)or(x<0)or(x>=@'100000000) then
+ begin vout(242); vout_int(packet_length[c]); vout_int(c); vout_int(x);
+ vcount:=vcount+13+packet_length[c];
+ end
+else begin vout(packet_length[c]); vout(c); vout(x div @'200000);
+ vout((x div @'400) mod 256); vout(x mod 256);
+ vcount:=vcount+5+packet_length[c];
+ end;
+if packet_start[c]=vf_size then
+ begin if c>=128 then vout(set1);
+ vout(c);
+ end
+else for k:=0 to packet_length[c]-1 do vout(vf[packet_start[c]+k]);
+end
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+@p procedure param_enter;
+begin @<Enter the parameter names@>;
+end;
+@#
+procedure vpl_enter;
+begin @<Enter all the \.{VPL} names@>;
+end;
+@#
+procedure name_enter; {enter all names and their equivalents}
+begin @<Enter all the \.{PL} names...@>;
+vpl_enter; param_enter;
+end;
+@#
+procedure read_lig_kern;
+var @!krn_ptr:0..max_kerns; {an index into |kern|}
+@!c:byte; {runs through all character codes}
+begin @<Read ligature/kern list@>;
+end;
+@#
+procedure read_char_info;
+var @!c:byte; {the char}
+begin @<Read character info list@>;
+end;
+@#
+procedure read_input;
+var @!c:byte; {header or parameter index}
+begin @<Read all the input@>;
+end;
+@#
+procedure corr_and_check;
+var @!c:0..256; {runs through all character codes}
+@!hh:0..hash_size; {an index into |hash_list|}
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!g:byte; {a character generated by the current character |c|}
+begin @<Correct and check the information@>
+end;
+@#
+procedure vf_output;
+var @!c:byte; {runs through all character codes}
+@!cur_font:0..256; {runs through all local fonts}
+@!k:integer; {loop index}
+begin @<Do the \.{VF} output@>;
+end;
+
+@ Here is where \.{VPtoVF} begins and ends.
+
+@p begin initialize;@/
+name_enter;@/
+read_input; print_ln('.');@/
+corr_and_check;@/
+@<Do the \.{TFM} output@>;
+vf_output;
+end.
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{VPtoVF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/weave.ch b/Build/source/texk/web2c/weave.ch
new file mode 100644
index 00000000000..29c82379612
--- /dev/null
+++ b/Build/source/texk/web2c/weave.ch
@@ -0,0 +1,430 @@
+% weave.ch for C compilation using web2c.
+%
+% 11/29/82 HWT Original version. This modifies weave to allow a new
+% control sequence:
+% @=...text...@> Put ...text... verbatim on a line
+% by itself in the Pascal output.
+% (argument must fit on one line)
+% This control sequence facilitates putting #include "gcons.h"
+% (for example) in files meant for the pc compiler.
+% Also, there is a command line option, -c, which means that
+% only the modules affected by the change file are to generate
+% TeX output. (All the limbo stuff still goes to the output
+% file, as does the index and table of contents.)
+% 2/12/83 HWT Brought up for use with version 1.3. Uses Knuth's new
+% control sequences for verbatim Pascal (as above, without
+% the "on one line" part), and the force_line (@\) primitive.
+% Also, he added stuff to keep track of changed modules, and
+% output enough information that macros can choose only to
+% print changed modules. This isn't as efficient as my
+% implementation because I avoided outputting the text for
+% non-changed modules altogether, but this feature won't be
+% used too often (just for TeX and TeXware), so Knuth's
+% solution is accepted.
+% The change file changes that used
+% to implement these features have been removed.
+% There is a -x flag to cause WEAVE to omit cross referencing
+% of identifiers, and index and T.of.C. processing.
+% This, too, is unnecessary, for one could simply redefine some
+% WEB macros to avoid the printing, but there are only a couple
+% of easy changes, so they have been made.
+% 2/18 HWT Increased stack size to 400 (not for TeX-related programs).
+% 3/18 HWT Brought up for Version 1.5. Made it print newline at end of
+% run.
+% 4/13 PC Merged with Pavel's version, including adding a call to
+% exit() at the end of the program, based upon the value of
+% `history'.
+% 4/16 PC Brought up to version 1.5 released with TeX 0.97 in April 1983
+% 6/29 HWT Brought up to version 1.7 released with TeX 0.99 in June 1983,
+% introducing a new change file format
+% 7/17 HWT Brought up to version 2.0 released with TeX 0.999 in July 1983
+% 7/29 HWT Brought up to version 2.1
+% 11/17 HWT Brought up to version 2.4 released with TeX 1.0. Made
+% changes to use C routines for I/O, for speedup.
+% 1/31 HWT Brought up to version 2.6
+% 12/15/85 ETM Brought up to version 2.8
+% 03/15/88 ETM Converted for use with WEB to C, and for version 2.9 of Weave.
+% 11/30/89 KB Version 4.
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{WEAVE changes for C}
+@z
+
+@x [2] No global labels, define and call parse_arguments.
+label end_of_WEAVE; {go here to finish}
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values@>@/
+@y
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Define |parse_arguments|@>
+@<Error handling procedures@>@/
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin
+ kpse_set_progname (argv[0]);
+ parse_arguments;
+ @<Set initial values@>@/
+@z
+
+@x [8] Increase constants for tex2pdf, etc.
+@!max_bytes=45000; {|1/ww| times the number of bytes in identifiers,
+ index entries, and module names; must be less than 65536}
+@!max_names=5000; {number of identifiers, index entries, and module names;
+ must be less than 10240}
+@y
+@!max_bytes=65530; {|1/ww| times the number of bytes in identifiers,
+ index entries, and module names; must be less than 65536}
+@!max_names=10220; {number of identifiers, index entries, and module names;
+ must be less than 10240}
+@z
+@x
+@!buf_size=100; {maximum length of input line}
+@y
+@!buf_size=3000; {maximum length of input line}
+@z
+@x
+@!max_refs=30000; {number of cross references; must be less than 65536}
+@!max_toks=30000; {number of symbols in \PASCAL\ texts being parsed;
+ must be less than 65536}
+@!max_texts=2000; {number of phrases in \PASCAL\ texts being parsed;
+ must be less than 10240}
+@!max_scraps=1000; {number of tokens in \PASCAL\ texts being parsed}
+@!stack_size=200; {number of simultaneous output levels}
+@y
+@!max_refs=65000; {number of cross references; must be less than 65536}
+@!max_toks=65000; {number of symbols in \PASCAL\ texts being parsed;
+ must be less than 65536}
+@!max_texts=10000; {number of phrases in \PASCAL\ texts being parsed;
+ must be less than 10240}
+@!max_scraps=10000; {number of tokens in \PASCAL\ texts being parsed}
+@!stack_size=2000; {number of simultaneous output levels}
+@z
+
+% [??] The text_char type is used as an array index into xord. The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [17] enable maximum character set
+for i:=1 to @'37 do xchr[i]:=' ';
+for i:=@'200 to @'377 do xchr[i]:=' ';
+@y
+for i:=1 to @'37 do xchr[i]:=chr(i);
+for i:=@'200 to @'377 do xchr[i]:=chr(i);
+@z
+
+@x [20] Terminal I/O.
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@y
+@d term_out==stdout
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@z
+
+@x
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+@y
+@z
+
+@x [21] Don't initialize the terminal.
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{TANGLE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal.
+@^system dependencies@>
+
+@<Set init...@>=
+{nothing need be done}
+@z
+
+@x [22] `break' is `fflush'.
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == fflush(term_out) {empty the terminal output buffer}
+@z
+
+@x [24] Open input files.
+@ The following code opens the input files. Since these files were listed
+in the program header, we assume that the \PASCAL\ runtime system has
+already checked that suitable file names have been given; therefore no
+additional error checking needs to be done. We will see below that
+\.{WEAVE} reads through the entire input twice.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read |web_file| and |change_file|}
+begin reset(web_file); reset(change_file);
+end;
+@y
+@ The following code opens the input files.
+This is called after the filename variables have been set appropriately.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read |web_file| and |change_file|}
+begin web_file := kpse_open_file(web_name, kpse_web_format);
+ if chg_name then change_file := kpse_open_file(chg_name, kpse_web_format);
+end;
+@z
+
+@x [26] Opening the .tex file.
+rewrite(tex_file);
+@y
+rewrite(tex_file,tex_name);
+@z
+
+@x [28] web2c doesn't understand f^.
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+@y
+ begin buffer[limit]:=xord[getc(f)];
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do vgetc(f);
+@z
+
+@x [??] Fix jump_out
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_WEAVE;
+end;
+@y
+@d fatal_error(#)==begin new_line; write(stderr, #);
+ error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@t\4\4@>{here files should be closed if the operating system requires it}
+ @<Print the job |history|@>;
+ new_line;
+ if (history <> spotless) and (history <> harmless_message) then
+ uexit(1)
+ else
+ uexit(0);
+end;
+@z
+
+@x [50] don't enter xrefs if no_xref set
+@d append_xref(#)==if xref_ptr=max_refs then overflow('cross reference')
+ else begin incr(xref_ptr); num(xref_ptr):=#;
+ end
+
+@p procedure new_xref(@!p:name_pointer);
+label exit;
+var q:xref_number; {pointer to previous cross reference}
+@!m,@!n: sixteen_bits; {new and previous cross-reference value}
+begin if (reserved(p)or(byte_start[p]+1=byte_start[p+ww]))and
+@y
+If the user has sent the |no_xref| flag (the -x option of the command line),
+then it is unnecessary to keep track of cross references for identifers.
+If one were careful, one could probably make more changes around module
+100 to avoid a lot of identifier looking up.
+
+@d append_xref(#)==if xref_ptr=max_refs then overflow('cross reference')
+ else begin incr(xref_ptr); num(xref_ptr):=#;
+ end
+
+@p procedure new_xref(@!p:name_pointer);
+label exit;
+var q:xref_number; {pointer to previous cross-reference}
+@!m,@!n: sixteen_bits; {new and previous cross-reference value}
+begin if no_xref then return;
+if (reserved(p)or(byte_start[p]+1=byte_start[p+ww]))and
+@z
+
+@x [239] omit index and module names if no_xref set
+@<Phase III: Output the cross-reference index@>=
+@y
+If the user has set the |no_xref| flag (the -x option on the command line),
+just finish off the page, omitting the index, module name list, and table of
+contents.
+
+@<Phase III: Output the cross-reference index@>=
+if no_xref then begin
+ finish_line;
+ out("\"); out5("v")("f")("i")("l")("l");
+ out4("\")("e")("n")("d");
+ finish_line;
+ end
+else begin
+@z
+
+@x
+print('Done.');
+@y
+end;
+print('Done.');
+@z
+
+@x [258] term_in == stdin, when debugging.
+any error stop will set |debug_cycle| to zero.
+@y
+any error stop will set |debug_cycle| to zero.
+
+@d term_in==stdin
+@z
+
+@x
+@!term_in:text_file; {the user's terminal as an input file}
+@y
+@z
+
+@x [259] Take out reset(term_in)
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+@y
+@z
+
+@x [261] print newline at end of run and exit based upon value of history
+print_ln(banner); {print a ``banner line''}
+@y
+print (banner); {print a ``banner line''}
+print_ln (version_string);
+@z
+
+@x
+end_of_WEAVE:
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@t\4\4@>{here files should be closed if the operating system requires it}
+@<Print the job |history|@>;
+end.
+@y
+jump_out;
+end.
+@z
+
+@x [264] System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{WEAVE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 4; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+ @!getopt_return_val: integer;
+ @!option_index: c_int_type;
+ @!current_option: 0..n_options;
+begin
+ @<Define the option table@>;
+ repeat
+ getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+ address_of (option_index));
+ if getopt_return_val = -1 then begin
+ {End of arguments; we exit the loop below.} ;
+
+ end else if getopt_return_val = "?" then begin
+ usage ('weave');
+
+ end else if argument_is ('help') then begin
+ usage_help (WEAVE_HELP, nil);
+
+ end else if argument_is ('version') then begin
+ print_version_and_exit (banner, nil, 'D.E. Knuth');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+ until getopt_return_val = -1;
+
+ {Now |optind| is the index of first non-option on the command line.}
+ if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+ write_ln (stderr, 'weave: Need one or two file arguments.');
+ usage ('weave');
+ end;
+
+ {Supply |".web"| and |".ch"| extensions if necessary.}
+ web_name := extend_filename (cmdline (optind), 'web');
+ if optind + 2 = argc then begin
+ chg_name := extend_filename (cmdline (optind + 1), 'ch');
+ end;
+
+ {Change |".web"| to |".tex"| and use the current directory.}
+ tex_name := basename_change_suffix (web_name, '.web', '.tex');
+end;
+
+@ Here are the options we allow. The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Omit cross-referencing?
+@.-x@>
+
+@<Define the option...@> =
+long_options[current_option].name := char_to_string ('x');
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := address_of (no_xref);
+long_options[current_option].val := 1;
+incr (current_option);
+
+@
+@<Global...@> =
+@!no_xref:c_int_type;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Global...@> =
+@!web_name,@!chg_name,@!tex_name:c_string;
+@z
diff --git a/Build/source/texk/web2c/weave.rc b/Build/source/texk/web2c/weave.rc
new file mode 100644
index 00000000000..fd2c728493d
--- /dev/null
+++ b/Build/source/texk/web2c/weave.rc
@@ -0,0 +1,34 @@
+/* weave.rc: weave resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " weave 4.4"
+
+#define VER_INTERNALNAME_STR "weave"
+#define VER_ORIGINALFILENAME_STR "weave.exe"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#define VER_FILEDESCRIPTION_STR "Web-to-TeX converter"
+
+#include <texlive.version>
+
+/* weave.rc ends here */
diff --git a/Build/source/texk/web2c/weave.web b/Build/source/texk/web2c/weave.web
new file mode 100644
index 00000000000..c1785c35cf9
--- /dev/null
+++ b/Build/source/texk/web2c/weave.web
@@ -0,0 +1,4904 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was released in December, 1981.
+% Version 1 was released in September, 1982, with version 0 of TeX.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 1.1 changed "_" to "\_" if not within an identifier (November, 1982).
+% Version 1.2 added @@= and @@\ and marked changed modules (December, 1982).
+% Version 1.3 marked and indexed changed modules better (January, 1983).
+% Version 1.4 added "history" (February, 1983).
+% Version 1.5 conformed to TeX version 0.96 (March, 1983).
+% Version 1.6 conformed to TeX version 0.98 (May, 1983).
+% Version 1.7 introduced the new change file format (June, 1983).
+% Version 2 was released in July, 1983, with version 0.999 of TeX.
+% Version 2.1 corrected a bug in changed_module reckoning (August, 1983).
+% Version 2.2 corrected it better (August, 1983).
+% Version 2.3 starts the output with \input webmac (August, 1983).
+% Version 2.4 fixed a bug in compress(#) (September, 1983).
+% Version 2.5 cleared xrefswitch after module names (November, 1983).
+% Version 2.6 fixed a bug in declaration of trans array (January, 1984).
+% Version 2.7 fixed a bug in real constants (August, 1984).
+% Version 2.8 fixed a bug in change_buffer movement (August, 1985).
+% Version 2.9 increased max_refs and max_toks to 30000 each (January, 1987).
+% Version 3, for Sewell's book, fixed long-line bug in input_ln (March, 1989).
+% Version 3.1 fixed a bug for programs with only one module (April, 1989).
+% Version 4 was major change to allow 8-bit input (September, 1989).
+% Version 4.1, for Breitenlohner, avoids English-only output (March, 1990).
+% Version 4.2 conforms to ANSI standard for-loop rules (September, 1990).
+% Version 4.3 catches extra } in input (Breitenlohner, September, 1991).
+% Version 4.4 corrects changed_module logic, %-overflow (January, 1992).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\def\pb{$\.|\ldots\.|$} % Pascal brackets (|...|)
+\def\v{\.{\char'174}} % vertical (|) in typewriter font
+\def\dleft{[\![} \def\dright{]\!]} % double brackets
+\mathchardef\RA="3221 % right arrow
+\mathchardef\BA="3224 % double arrow
+\def\({} % kludge for alphabetizing certain module names
+
+\def\title{WEAVE}
+\def\contentspagenumber{15} % should be odd
+\def\topofcontents{\null\vfill
+ \titlefalse % include headline on the contents page
+ \def\rheader{\mainfont Appendix D\hfil \contentspagenumber}
+ \centerline{\titlefont The {\ttitlefont WEAVE} processor}
+ \vskip 15pt
+ \centerline{(Version 4.4)}
+ \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program converts a \.{WEB} file to a \TeX\ file. It was written
+by D. E. Knuth in October, 1981; a somewhat similar {\mc SAIL} program had
+been developed in March, 1979, although the earlier program used a top-down
+parsing method that is quite different from the present scheme.
+
+The code uses a few features of the local \PASCAL\ compiler that may need
+to be changed in other installations:
+
+\yskip\item{1)} Case statements have a default.
+\item{2)} Input-output routines may need to be adapted for use with a particular
+character set and/or for printing messages on the user's terminal.
+
+\yskip\noindent
+These features are also present in the \PASCAL\ version of \TeX, where they
+are used in a similar (but more complex) way. System-dependent portions
+of \.{WEAVE} can be identified by looking at the entries for `system
+dependencies' in the index below.
+@!@^system dependencies@>
+
+The ``banner line'' defined here should be changed whenever \.{WEAVE}
+is modified.
+
+@d banner=='This is WEAVE, Version 4.4'
+
+@ The program begins with a fairly normal header, made up of pieces that
+@^system dependencies@>
+will mostly be filled in later. The \.{WEB} input comes from files |web_file|
+and |change_file|, and the \TeX\ output goes to file |tex_file|.
+
+If it is necessary to abort the job because of a fatal error, the program
+calls the `|jump_out|' procedure, which goes to the label |end_of_WEAVE|.
+
+@d end_of_WEAVE = 9999 {go here to wrap it up}
+
+@p @t\4@>@<Compiler directives@>@/
+program WEAVE(@!web_file,@!change_file,@!tex_file);
+label end_of_WEAVE; {go here to finish}
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values@>@/
+ end;
+
+@ Some of this code is optional for use when debugging only;
+such material is enclosed between the delimiters |debug| and $|gubed|$.
+Other parts, delimited by |stat| and $|tats|$, are optionally included
+if statistics about \.{WEAVE}'s memory usage are desired.
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$'
+ when gathering usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
+ when gathering usage statistics}
+@f stat==begin
+@f tats==end
+
+@ The \PASCAL\ compiler used to develop this system has ``compiler
+directives'' that can appear in comments whose first character is a dollar sign.
+In production versions of \.{WEAVE} these directives tell the compiler that
+@^system dependencies@>
+it is safe to avoid range checks and to leave out the extra code it inserts
+for the \PASCAL\ debugger's benefit, although interrupts will occur if
+there is arithmetic overflow.
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ Labels are given symbolic names by the following definitions. We insert
+the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
+procedure in which we have used the `|return|' statement defined below;
+the label `|restart|' is occasionally used at the very beginning of a
+procedure; and the label `|reswitch|' is occasionally used just prior to
+a \&{case} statement in which some cases change the conditions and we wish to
+branch to the newly applicable case.
+Loops that are set up with the \&{loop} construction defined below are
+commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
+and they are sometimes repeated by going to `|continue|'.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=31 {go here when you've found it}
+@d not_found=32 {go here when you've found something else}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@f loop == xclause
+
+@ We assume that |case| statements may include a default case that applies
+if no matching label is found. Thus, we shall use constructions like
+@^system dependencies@>
+$$\vbox{\halign{#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the compiler
+used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
+and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
+`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
+and |endcases| should be changed to agree with local conventions.
+(Of course, if no default mechanism is available, the |case| statements of
+this program must be extended by listing all remaining cases.)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters are set big enough to handle \TeX, so they
+should be sufficient for most applications of \.{WEAVE}.
+
+@<Constants...@>=
+@!max_bytes=45000; {|1/ww| times the number of bytes in identifiers,
+ index entries, and module names; must be less than 65536}
+@!max_names=5000; {number of identifiers, index entries, and module names;
+ must be less than 10240}
+@!max_modules=2000;{greater than the total number of modules}
+@!hash_size=353; {should be prime}
+@!buf_size=100; {maximum length of input line}
+@!longest_name=400; {module names shouldn't be longer than this}
+@!long_buf_size=500; {|buf_size+longest_name|}
+@!line_length=80; {lines of \TeX\ output have at most this many characters,
+ should be less than 256}
+@!max_refs=30000; {number of cross references; must be less than 65536}
+@!max_toks=30000; {number of symbols in \PASCAL\ texts being parsed;
+ must be less than 65536}
+@!max_texts=2000; {number of phrases in \PASCAL\ texts being parsed;
+ must be less than 10240}
+@!max_scraps=1000; {number of tokens in \PASCAL\ texts being parsed}
+@!stack_size=200; {number of simultaneous output levels}
+
+@ A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d harmless_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+@#
+@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
+@d mark_error==history:=error_message
+@d mark_fatal==history:=fatal_message
+
+@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
+
+@ @<Set init...@>=history:=spotless;
+
+@* The character set.
+One of the main goals in the design of \.{WEB} has been to make it readily
+portable between a wide variety of computers. Yet \.{WEB} by its very
+nature must use a greater variety of characters than most computer
+programs deal with, and character encoding is one of the areas in which
+existing machines differ most widely from each other.
+
+To resolve this problem, all input to \.{WEAVE} and \.{TANGLE} is
+converted to an internal eight-bit code that is essentially standard
+ASCII, the ``American Standard Code for Information Interchange.''
+The conversion is done immediately when each character is read in.
+Conversely, characters are converted from ASCII to the user's external
+representation just before they are output. (The original ASCII code
+was seven bits only; \.{WEB} now allows eight bits in an attempt to
+keep up with modern times.)
+
+Such an internal code is relevant to users of \.{WEB} only because it is
+the code used for preprocessed constants like \.{"A"}. If you are writing
+a program in \.{WEB} that makes use of such one-character constants, you
+should convert your input to ASCII form, like \.{WEAVE} and \.{TANGLE} do.
+Otherwise \.{WEB}'s internal coding scheme does not affect you.
+@^ASCII code@>
+
+Here is a table of the standard visible ASCII codes:
+$$\def\:{\char\count255\global\advance\count255 by 1}
+\count255='40
+\vbox{
+\hbox{\hbox to 40pt{\it\hfill0\/\hfill}%
+\hbox to 40pt{\it\hfill1\/\hfill}%
+\hbox to 40pt{\it\hfill2\/\hfill}%
+\hbox to 40pt{\it\hfill3\/\hfill}%
+\hbox to 40pt{\it\hfill4\/\hfill}%
+\hbox to 40pt{\it\hfill5\/\hfill}%
+\hbox to 40pt{\it\hfill6\/\hfill}%
+\hbox to 40pt{\it\hfill7\/\hfill}}
+\vskip 4pt
+\hrule
+\def\^{\vrule height 10.5pt depth 4.5pt}
+\halign{\hbox to 0pt{\hskip -24pt\O{#0}\hfill}&\^
+\hbox to 40pt{\tt\hfill#\hfill\^}&
+&\hbox to 40pt{\tt\hfill#\hfill\^}\cr
+04&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+05&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+06&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+07&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+10&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+11&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+12&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+13&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+14&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+15&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+16&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+17&\:&\:&\:&\:&\:&\:&\:\cr}
+\hrule width 280pt}$$
+(Actually, of course, code @'040 is an invisible blank space.) Code @'136
+was once an upward arrow (\.{\char'13}), and code @'137 was
+once a left arrow (\.^^X), in olden times when the first draft
+of ASCII code was prepared; but \.{WEB} works with today's standard
+ASCII in which those codes represent circumflex and underline as shown.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers, a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, so \.{WEB} assumes that it is being used
+with a \PASCAL\ whose character set contains at least the characters of
+standard ASCII as listed above. Some \PASCAL\ compilers use the original
+name |char| for the data type associated with the characters in text files,
+while other \PASCAL s consider |char| to be a 64-element subrange of a larger
+data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters in the input and output
+files. We shall also assume that |text_char| consists of the elements
+|chr(first_text_char)| through |chr(last_text_char)|, inclusive. The
+following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{WEAVE} and \.{TANGLE} processors convert between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ If we assume that every system using \.{WEB} is able to read and write the
+visible characters of standard ASCII (although not necessarily using the
+ASCII codes to represent them), the following assignment statements initialize
+most of the |xchr| array properly, without needing any system-dependent
+changes. For example, the statement \.{xchr[@@\'101]:=\'A\'} that appears
+in the present \.{WEB} file might be encoded in, say, {\mc EBCDIC} code
+on the external medium on which it resides, but \.{TANGLE} will convert from
+this external code to ASCII and back again. Therefore the assignment
+statement \.{XCHR[65]:=\'A\'} will appear in the corresponding \PASCAL\ file,
+and \PASCAL\ will compile this statement so that |xchr[65]| receives the
+character \.A in the external (|char|) code. Note that it would be quite
+incorrect to say \.{xchr[@@\'101]:="A"}, because |"A"| is a constant of
+type |integer|, not |char|, and because we have $|"A"|=65$ regardless of
+the external character set.
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+xchr[0]:=' '; xchr[@'177]:=' '; {these ASCII codes are not used}
+
+@ Some of the ASCII codes below @'40 have been given symbolic names in
+\.{WEAVE} and \.{TANGLE} because they are used with a special meaning.
+
+@d and_sign=@'4 {equivalent to `\.{and}'}
+@d not_sign=@'5 {equivalent to `\.{not}'}
+@d set_element_sign=@'6 {equivalent to `\.{in}'}
+@d tab_mark=@'11 {ASCII code used as tab-skip}
+@d line_feed=@'12 {ASCII code thrown away at end of line}
+@d form_feed=@'14 {ASCII code used at end of page}
+@d carriage_return=@'15 {ASCII code used at end of line}
+@d left_arrow=@'30 {equivalent to `\.{:=}'}
+@d not_equal=@'32 {equivalent to `\.{<>}'}
+@d less_or_equal=@'34 {equivalent to `\.{<=}'}
+@d greater_or_equal=@'35 {equivalent to `\.{>=}'}
+@d equivalence_sign=@'36 {equivalent to `\.{==}'}
+@d or_sign=@'37 {equivalent to `\.{or}'}
+
+@ When we initialize the |xord| array and the remaining parts of |xchr|,
+it will be convenient to make use of an index variable, |i|.
+
+@<Local variables for init...@>=
+@!i:0..255;
+
+@ Here now is the system-dependent part of the character set.
+If \.{WEB} is being implemented on a garden-variety \PASCAL\ for which
+only standard ASCII codes will appear in the input and output files, you
+don't need to make any changes here. But if you have, for example, an extended
+character set like the one in Appendix~C of {\sl The \TeX book}, the first
+line of code in this module should be changed to
+$$\hbox{|for i:=1 to @'37 do xchr[i]:=chr(i);|}$$
+\.{WEB}'s character set is essentially identical to \TeX's, even with respect to
+characters less than @'40.
+@^system dependencies@>
+
+Changes to the present module will make \.{WEB} more friendly on computers
+that have an extended character set, so that one can type things like
+\.^^Z\ instead of \.{<>}. If you have an extended set of characters that
+are easily incorporated into text files, you can assign codes arbitrarily
+here, giving an |xchr| equivalent to whatever characters the users of
+\.{WEB} are allowed to have in their input files, provided that unsuitable
+characters do not correspond to special codes like |carriage_return|
+that are listed above.
+
+(The present file \.{WEAVE.WEB} does not contain any of the non-ASCII
+characters, because it is intended to be used with all implementations of
+\.{WEB}. It was originally created on a Stanford system that has a
+convenient extended character set, then ``sanitized'' by applying another
+program that transliterated all of the non-standard characters into
+standard equivalents.)
+
+@<Set init...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+for i:=@'200 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=" ";
+for i:=1 to @'377 do xord[xchr[i]]:=i;
+xord[' ']:=" ";
+
+@* Input and output.
+The input conventions of this program are intended to be very much like those
+of \TeX\ (except, of course, that they are much simpler, because much less
+needs to be done). Furthermore they are identical to those of \.{TANGLE}.
+Therefore people who need to make modifications to all three systems
+should be able to do so without too many headaches.
+
+We use the standard \PASCAL\ input/output procedures in several places that
+\TeX\ cannot, since \.{WEAVE} does not have to deal with files that are named
+dynamically by the user, and since there is no input from the terminal.
+
+@ Terminal output is done by writing on file |term_out|, which is assumed to
+consist of characters of type |text_char|:
+@^system dependencies@>
+
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
+@d new_line==write_ln(term_out) {start new line}
+@d print_nl(#)== {print information starting on a new line}
+ begin new_line; print(#);
+ end
+
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{TANGLE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+
+@ The |update_terminal| procedure is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ The main input comes from |web_file|; this input may be overridden
+by changes in |change_file|. (If |change_file| is empty, there are no changes.)
+
+@<Globals...@>=
+@!web_file:text_file; {primary input}
+@!change_file:text_file; {updates}
+
+@ The following code opens the input files. Since these files were listed
+in the program header, we assume that the \PASCAL\ runtime system has
+already checked that suitable file names have been given; therefore no
+additional error checking needs to be done. We will see below that
+\.{WEAVE} reads through the entire input twice.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read |web_file| and |change_file|}
+begin reset(web_file); reset(change_file);
+end;
+
+@ The main output goes to |tex_file|.
+
+@<Globals...@>=
+@!tex_file: text_file;
+
+@ The following code opens |tex_file|.
+Since this file was listed in the program header, we assume that the
+\PASCAL\ runtime system has checked that a suitable external file name has
+been given.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(tex_file);
+
+@ Input goes into an array called |buffer|.
+
+@<Globals...@>=@!buffer: array[0..long_buf_size] of ASCII_code;
+
+@ The |input_ln| procedure brings the next line of input from the specified
+file into the |buffer| array and returns the value |true|, unless the file has
+already been entirely read, in which case it returns |false|. The conventions
+of \TeX\ are followed; i.e., |ASCII_code| numbers representing the next line
+of the file are input into |buffer[0]|, |buffer[1]|, \dots,
+|buffer[limit-1]|; trailing blanks are ignored;
+and the global variable |limit| is set to the length of the
+@^system dependencies@>
+line. The value of |limit| must be strictly less than |buf_size|.
+
+We assume that none of the |ASCII_code| values
+of |buffer[j]| for |0<=j<limit| is equal to 0, @'177, |line_feed|, |form_feed|,
+or |carriage_return|. Since |buf_size| is strictly less than |long_buf_size|,
+some of \.{WEAVE}'s routines use the fact that it is safe to refer to
+|buffer[limit+2]| without overstepping the bounds of the array.
+
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ if final_limit>limit then final_limit:=limit;
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+
+@* Reporting errors to the user.
+The \.{WEAVE} processor operates in three phases: first it inputs the source
+file and stores cross-reference data, then it inputs the source once again and
+produces the \TeX\ output file, and finally it sorts and outputs the index.
+
+The global variables |phase_one| and |phase_three| tell which Phase we are in.
+
+@<Globals...@>=
+@!phase_one: boolean; {|true| in Phase I, |false| in Phases II and III}
+@!phase_three: boolean; {|true| in Phase III, |false| in Phases I and II}
+
+@ If an error is detected while we are debugging,
+we usually want to look at the contents of memory.
+A special procedure will be declared later for this purpose.
+
+@<Error handling...@>=
+@!debug@+ procedure debug_help; forward;@+gubed
+
+@ The command `|err_print('! Error message')|' will report a syntax error to
+the user, by printing the error message at the beginning of a new line and
+then giving an indication of where the error was spotted in the source file.
+Note that no period follows the error message, since the error routine
+will automatically supply a period.
+
+The actual error indications are provided by a procedure called |error|.
+However, error messages are not actually reported during phase one,
+since errors detected on the first pass will be detected again
+during the second.
+
+@d err_print(#)==
+ begin if not phase_one then
+ begin new_line; print(#); error;
+ end;
+ end
+
+@<Error handling...@>=
+procedure error; {prints `\..' and location of error message}
+var@!k,@!l: 0..long_buf_size; {indices into |buffer|}
+begin @<Print error location based on input buffer@>;
+update_terminal; mark_error;
+@!debug debug_skipped:=debug_cycle;debug_help;@+gubed
+end;
+
+@ The error locations can be indicated by using the global variables
+|loc|, |line|, and |changing|, which tell respectively the first
+unlooked-at position in |buffer|, the current line number, and whether or not
+the current line is from |change_file| or |web_file|.
+This routine should be modified on systems whose standard text editor
+has special line-numbering conventions.
+@^system dependencies@>
+
+@<Print error location based on input buffer@>=
+begin if changing then print('. (change file ')@+else print('. (');
+print_ln('l.', line:1, ')');
+if loc>=limit then l:=limit else l:=loc;
+for k:=1 to l do
+ if buffer[k-1]=tab_mark then print(' ')
+ else print(xchr[buffer[k-1]]); {print the characters already read}
+new_line;
+for k:=1 to l do print(' '); {space out the next line}
+for k:=l+1 to limit do print(xchr[buffer[k-1]]); {print the part not yet read}
+if buffer[limit]="|" then print(xchr["|"]);
+ {end of \PASCAL\ text in module names}
+print(' '); {this space separates the message from future asterisks}
+end
+
+@ The |jump_out| procedure just cuts across all active procedure levels
+and jumps out of the program. This is the only non-local \&{goto} statement
+in \.{WEAVE}. It is used when no recovery from a particular error has
+been provided.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the code that appears at label |end_of_WEAVE| should be
+copied into the |jump_out| procedure, followed by a call to a system procedure
+that terminates the program.
+
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_WEAVE;
+end;
+
+@ Sometimes the program's behavior is far different from what it should be,
+and \.{WEAVE} prints an error message that is really for the \.{WEAVE}
+maintenance person, not the user. In such cases the program says
+|confusion('indication of where we are')|.
+
+@d confusion(#)==fatal_error('! This can''t happen (',#,')')
+@.This can't happen@>
+
+@ An overflow stop occurs if \.{WEAVE}'s tables aren't large enough.
+
+@d overflow(#)==fatal_error('! Sorry, ',#,' capacity exceeded')
+@.Sorry, x capacity exceeded@>
+
+@* Data structures.
+During the first phase of its processing, \.{WEAVE} puts identifier names,
+index entries, and module names into the large |byte_mem| array, which is
+packed with eight-bit integers. Allocation is sequential, since names are
+never deleted.
+
+An auxiliary array |byte_start| is used as a directory for |byte_mem|,
+and the |link|, |ilk|, and |xref| arrays give further information about names.
+These auxiliary arrays consist of sixteen-bit items.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!sixteen_bits=0..65535; {unsigned two-byte quantity}
+
+@ \.{WEAVE} has been designed to avoid the need for indices that are more
+than sixteen bits wide, so that it can be used on most computers. But
+there are programs that need more than 65536 bytes; \TeX\ is one of these.
+To get around this problem, a slight complication has been added to the
+data structures: |byte_mem| is a two-dimensional array, whose first index
+is either 0 or 1. (For generality, the first index is actually allowed to
+run between 0 and |ww-1|, where |ww| is defined to be 2; the program will
+work for any positive value of |ww|, and it can be simplified in obvious
+ways if |ww=1|.)
+
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+
+@<Globals...@>=
+@!byte_mem: packed array [0..ww-1,0..max_bytes] of ASCII_code;
+ {characters of names}
+@!byte_start: array [0..max_names] of sixteen_bits; {directory into |byte_mem|}
+@!link: array [0..max_names] of sixteen_bits; {hash table or tree links}
+@!ilk: array [0..max_names] of sixteen_bits; {type codes or tree links}
+@!xref: array [0..max_names] of sixteen_bits; {heads of cross-reference lists}
+
+@ The names of identifiers are found by computing a hash address |h| and
+then looking at strings of bytes signified by |hash[h]|, |link[hash[h]]|,
+|link[link[hash[h]]]|, \dots, until either finding the desired name
+or encountering a zero.
+
+A `|name_pointer|' variable, which signifies a name, is an index into
+|byte_start|. The actual sequence of characters in the name pointed to by
+|p| appears in positions |byte_start[p]| to |byte_start[p+ww]-1|, inclusive,
+in the segment of |byte_mem| whose first index is |p mod ww|. Thus, when
+|ww=2| the even-numbered name bytes appear in |byte_mem[0,@t$*$@>]|
+and the odd-numbered ones appear in |byte_mem[1,@t$*$@>]|.
+The pointer 0 is used for undefined module names; we don't
+want to use it for the names of identifiers, since 0 stands for a null
+pointer in a linked list.
+
+We usually have |byte_start[name_ptr+w]=byte_ptr[(name_ptr+w) mod ww]|
+for |0<=w<ww|, since these are the starting positions for the next |ww|
+names to be stored in |byte_mem|.
+
+@d length(#)==byte_start[#+ww]-byte_start[#] {the length of a name}
+
+@<Types...@>=
+@!name_pointer=0..max_names; {identifies a name}
+
+@ @<Global...@>=
+@!name_ptr:name_pointer; {first unused position in |byte_start|}
+@!byte_ptr:array [0..ww-1] of 0..max_bytes;
+ {first unused position in |byte_mem|}
+
+@ @<Local variables for init...@>=
+@!wi: 0..ww-1; {to initialize the |byte_mem| indices}
+
+@ @<Set init...@>=
+for wi:=0 to ww-1 do
+ begin byte_start[wi]:=0; byte_ptr[wi]:=0;
+ end;
+byte_start[ww]:=0; {this makes name 0 of length zero}
+name_ptr:=1;
+
+@ Several types of identifiers are distinguished by their |ilk|:
+
+\yskip\hang |normal| identifiers are part of the \PASCAL\ program and
+will appear in italic type.
+
+\yskip\hang |roman| identifiers are index entries that appear after
+\.{@@\^} in the \.{WEB} file.
+
+\yskip\hang |wildcard| identifiers are index entries that appear after
+\.{@@:} in the \.{WEB} file.
+
+\yskip\hang |typewriter| identifiers are index entries that appear after
+\.{@@.} in the \.{WEB} file.
+
+\yskip\hang |array_like|, |begin_like|, \dots, |var_like|
+identifiers are \PASCAL\ reserved words whose |ilk| explains how they are
+to be treated when \PASCAL\ code is being formatted.
+
+\yskip\hang Finally, if |c| is an ASCII code, an |ilk| equal to
+|char_like+c| denotes a reserved word that will be converted to character
+|c|.
+
+@d normal=0 {ordinary identifiers have |normal| ilk}
+@d roman=1 {normal index entries have |roman| ilk}
+@d wildcard=2 {user-formatted index entries have |wildcard| ilk}
+@d typewriter=3 {`typewriter type' entries have |typewriter| ilk}
+@d reserved(#)==(ilk[#]>typewriter) {tells if a name is a reserved word}
+@d array_like=4 {\&{array}, \&{file}, \&{set}}
+@d begin_like=5 {\&{begin}}
+@d case_like=6 {\&{case}}
+@d const_like=7 {\&{const}, \&{label}, \&{type}}
+@d div_like=8 {\&{div}, \&{mod}}
+@d do_like=9 {\&{do}, \&{of}, \&{then}}
+@d else_like=10 {\&{else}}
+@d end_like=11 {\&{end}}
+@d for_like=12 {\&{for}, \&{while}, \&{with}}
+@d goto_like=13 {\&{goto}, \&{packed}}
+@d if_like=14 {\&{if}}
+@d in_like=15 {\&{in}}
+@d nil_like=16 {\&{nil}}
+@d proc_like=17 {\&{function}, \&{procedure}, \&{program}}
+@d record_like=18 {\&{record}}
+@d repeat_like=19 {\&{repeat}}
+@d to_like=20 {\&{downto}, \&{to}}
+@d until_like=21 {\&{until}}
+@d var_like=22 {\&{var}}
+@d loop_like=23 {\&{loop}, \&{xclause}}
+@d char_like=24 {\&{and}, \&{or}, \&{not}, \&{in}}
+
+@ The names of modules are stored in |byte_mem| together
+with the identifier names, but a hash table is not used for them because
+\.{WEAVE} needs to be able to recognize a module name when given a prefix of
+that name. A conventional binary seach tree is used to retrieve module names,
+with fields called |llink| and |rlink| in place of |link| and |ilk|. The
+root of this tree is |rlink[0]|.
+
+@d llink==link {left link in binary search tree for module names}
+@d rlink==ilk {right link in binary search tree for module names}
+@d root==rlink[0] {the root of the binary search tree for module names}
+
+@<Set init...@>=
+root:=0; {the binary search tree starts out with nothing in it}
+
+@ Here is a little procedure that prints the text of a given name on the
+user's terminal.
+
+@p procedure print_id(@!p:name_pointer); {print identifier or module name}
+var k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {row of |byte_mem|}
+begin if p>=name_ptr then print('IMPOSSIBLE')
+else begin w:=p mod ww;
+ for k:=byte_start[p] to byte_start[p+ww]-1 do
+ print(xchr[byte_mem[w,k]]);
+ end;
+end;
+
+@ We keep track of the current module number in
+|module_count|, which is the total number of modules that have started.
+Modules which have been altered by a change file entry
+have their |changed_module| flag turned on during the first phase.
+
+@<Globals...@>=
+@!module_count:0..max_modules; {the current module number}
+@!changed_module: packed array [0..max_modules] of boolean; {is it changed?}
+@!change_exists: boolean; {has any module changed?}
+
+@ The other large memory area in \.{WEAVE} keeps the cross-reference data.
+All uses of the name |p| are recorded in a linked list beginning at
+|xref[p]|, which points into the |xmem| array. Entries in |xmem| consist
+of two sixteen-bit items per word, called the |num| and |xlink| fields.
+If |x| is an index into |xmem|, reached from name |p|, the value of |num(x)|
+is either a module number where |p| is used, or it is |def_flag| plus a
+module number where |p| is defined; and |xlink(x)| points to the next such
+cross reference for |p|, if any. This list of cross references is in
+decreasing order by module number. The current number of cross references
+is |xref_ptr|.
+
+The global variable |xref_switch| is set either to |def_flag| or to zero,
+depending on whether the next cross reference to an identifier is to be
+underlined or not in the index. This switch is set to |def_flag| when
+\.{@@!} or \.{@@d} or \.{@@f} is scanned, and it is cleared to zero when
+the next identifier or index entry cross reference has been made. Similarly,
+the global variable |mod_xref_switch| is either |def_flag| or zero, depending
+on whether a module name is being defined or used.
+
+@d num(#)==xmem[#].num_field
+@d xlink(#)==xmem[#].xlink_field
+@d def_flag=10240 {must be strictly larger than |max_modules|}
+
+@ @<Types...@>=
+@!xref_number=0..max_refs;
+
+@ @<Globals...@>=
+@!xmem:array[xref_number] of packed record@t@>@/
+ @!num_field: sixteen_bits; {module number plus zero or |def_flag|}
+ @!xlink_field: sixteen_bits; {pointer to the previous cross reference}
+ end;
+@!xref_ptr:xref_number; {the largest occupied position in |xmem|}
+@!xref_switch,@!mod_xref_switch:0..def_flag; {either zero or |def_flag|}
+
+@ @<Set init...@>=xref_ptr:=0; xref_switch:=0; mod_xref_switch:=0; num(0):=0;
+xref[0]:=0; {cross references to undefined modules}
+
+@ A new cross reference for an identifier is formed by calling |new_xref|,
+which discards duplicate entries and ignores non-underlined references
+to one-letter identifiers or \PASCAL's reserved words.
+
+@d append_xref(#)==if xref_ptr=max_refs then overflow('cross reference')
+ else begin incr(xref_ptr); num(xref_ptr):=#;
+ end
+
+@p procedure new_xref(@!p:name_pointer);
+label exit;
+var q:xref_number; {pointer to previous cross reference}
+@!m,@!n: sixteen_bits; {new and previous cross-reference value}
+begin if (reserved(p)or(byte_start[p]+1=byte_start[p+ww]))and
+ (xref_switch=0) then return;
+m:=module_count+xref_switch; xref_switch:=0; q:=xref[p];
+if q>0 then
+ begin n:=num(q);
+ if (n=m)or(n=m+def_flag) then return
+ else if m=n+def_flag then
+ begin num(q):=m; return;
+ end;
+ end;
+append_xref(m); xlink(xref_ptr):=q; xref[p]:=xref_ptr;
+exit: end;
+
+@ The cross reference lists for module names are slightly different. Suppose
+that a module name is defined in modules $m_1$, \dots, $m_k$ and used in
+modules $n_1$, \dots, $n_l$. Then its list will contain $m_1+|def_flag|$,
+$m_k+|def_flag|$, \dots, $m_2+|def_flag|$, $n_l$, \dots, $n_1$, in
+this order. After Phase II, however, the order will be
+$m_1+|def_flag|$, \dots, $m_k+|def_flag|$, $n_1$, \dots, $n_l$.
+
+@p procedure new_mod_xref(@!p:name_pointer);
+var q,@!r:xref_number; {pointers to previous cross references}
+begin q:=xref[p]; r:=0;
+if q>0 then
+ begin if mod_xref_switch=0 then while num(q)>=def_flag do
+ begin r:=q; q:=xlink(q);
+ end
+ else if num(q)>=def_flag then
+ begin r:=q; q:=xlink(q);
+ end;
+ end;
+append_xref(module_count+mod_xref_switch); xlink(xref_ptr):=q;
+mod_xref_switch:=0;
+if r=0 then xref[p]:=xref_ptr
+else xlink(r):=xref_ptr;
+end;
+
+@ A third large area of memory is used for sixteen-bit `tokens', which appear
+in short lists similar to the strings of characters in |byte_mem|. Token lists
+are used to contain the result of \PASCAL\ code translated into \TeX\ form;
+further details about them will be explained later. A |text_pointer| variable
+is an index into |tok_start|.
+
+@<Types...@>=
+@!text_pointer=0..max_texts; {identifies a token list}
+
+@ The first position of |tok_mem|
+that is unoccupied by replacement text is called |tok_ptr|, and the first
+unused location of |tok_start| is called |text_ptr|.
+Thus, we usually have |tok_start[text_ptr]=tok_ptr|.
+
+@<Glob...@>=
+@t\hskip1em@>@!tok_mem: packed array [0..max_toks] of sixteen_bits; {tokens}
+@t\hskip1em@>@!tok_start: array [text_pointer] of sixteen_bits;
+ {directory into |tok_mem|}
+@t\hskip1em@>@!text_ptr:text_pointer; {first unused position in |tok_start|}
+@t\hskip1em@>@!tok_ptr:0..max_toks; {first unused position in |tok_mem|}
+stat@!max_tok_ptr,@!max_txt_ptr:0..max_toks; {largest values occurring}
+tats
+
+@ @<Set init...@>=
+tok_ptr:=1; text_ptr:=1; tok_start[0]:=1; tok_start[1]:=1;
+stat max_tok_ptr:=1; max_txt_ptr:=1;@+tats
+
+@* Searching for identifiers.
+The hash table described above is updated by the |id_lookup| procedure,
+which finds a given identifier and returns a pointer to its index in
+|byte_start|. The identifier is supposed to match character by character
+and it is also supposed to have a given |ilk| code; the same name may be
+present more than once if it is supposed to appear in the index with
+different typesetting conventions.
+If the identifier was not already present, it is inserted into the table.
+
+Because of the way \.{WEAVE}'s scanning mechanism works, it is most convenient
+to let |id_lookup| search for an identifier that is present in the |buffer|
+array. Two other global variables specify its position in the buffer: the
+first character is |buffer[id_first]|, and the last is |buffer[id_loc-1]|.
+
+@<Glob...@>=
+@!id_first:0..long_buf_size; {where the current identifier begins in the buffer}
+@!id_loc:0..long_buf_size; {just after the current identifier in the buffer}
+@#
+@!hash:array [0..hash_size] of sixteen_bits; {heads of hash lists}
+
+@ Initially all the hash lists are empty.
+
+@<Local variables for init...@>=
+@!h:0..hash_size; {index into hash-head array}
+
+@ @<Set init...@>=
+for h:=0 to hash_size-1 do hash[h]:=0;
+
+@ Here now is the main procedure for finding identifiers (and index
+entries). The parameter |t| is set to the desired |ilk| code. The
+identifier must either have |ilk=t|, or we must have
+|t=normal| and the identifier must be a reserved word.
+
+@p function id_lookup(@!t:eight_bits):name_pointer; {finds current identifier}
+label found;
+var i:0..long_buf_size; {index into |buffer|}
+@!h:0..hash_size; {hash code}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {row of |byte_mem|}
+@!l:0..long_buf_size; {length of the given identifier}
+@!p:name_pointer; {where the identifier is being sought}
+begin l:=id_loc-id_first; {compute the length}
+@<Compute the hash code |h|@>;
+@<Compute the name location |p|@>;
+if p=name_ptr then @<Enter a new name into the table at position |p|@>;
+id_lookup:=p;
+end;
+
+@ A simple hash code is used: If the sequence of
+ASCII codes is $c_1c_2\ldots c_m$, its hash value will be
+$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the hash...@>=
+h:=buffer[id_first]; i:=id_first+1;
+while i<id_loc do
+ begin h:=(h+h+buffer[i]) mod hash_size; incr(i);
+ end
+
+@ If the identifier is new, it will be placed in position |p=name_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the name location...@>=
+p:=hash[h];
+while p<>0 do
+ begin if (length(p)=l)and((ilk[p]=t)or((t=normal)and reserved(p))) then
+ @<Compare name |p| with current identifier,
+ |goto found| if equal@>;
+ p:=link[p];
+ end;
+p:=name_ptr; {the current identifier is new}
+link[p]:=hash[h]; hash[h]:=p; {insert |p| at beginning of hash list}
+found:
+
+@ @<Compare name |p|...@>=
+begin i:=id_first; k:=byte_start[p]; w:=p mod ww;
+while (i<id_loc)and(buffer[i]=byte_mem[w,k]) do
+ begin incr(i); incr(k);
+ end;
+if i=id_loc then goto found; {all characters agree}
+end
+
+@ When we begin the following segment of the program, |p=name_ptr|.
+
+@<Enter a new name...@>=
+begin w:=name_ptr mod ww;
+if byte_ptr[w]+l>max_bytes then overflow('byte memory');
+if name_ptr+ww>max_names then overflow('name');
+i:=id_first; k:=byte_ptr[w]; {get ready to move the identifier into |byte_mem|}
+while i<id_loc do
+ begin byte_mem[w,k]:=buffer[i]; incr(k); incr(i);
+ end;
+byte_ptr[w]:=k; byte_start[name_ptr+ww]:=k; incr(name_ptr);
+ilk[p]:=t; xref[p]:=0;
+end
+
+@* Initializing the table of reserved words.
+We have to get \PASCAL's reserved words into the hash table, and the
+simplest way to do this is to insert them every time \.{WEAVE} is run.
+A few macros permit us to do the initialization with a compact program.
+
+@d sid9(#)==buffer[9]:=#;cur_name:=id_lookup
+@d sid8(#)==buffer[8]:=#;sid9
+@d sid7(#)==buffer[7]:=#;sid8
+@d sid6(#)==buffer[6]:=#;sid7
+@d sid5(#)==buffer[5]:=#;sid6
+@d sid4(#)==buffer[4]:=#;sid5
+@d sid3(#)==buffer[3]:=#;sid4
+@d sid2(#)==buffer[2]:=#;sid3
+@d sid1(#)==buffer[1]:=#;sid2
+@d id2==id_first:=8; sid8
+@d id3==id_first:=7; sid7
+@d id4==id_first:=6; sid6
+@d id5==id_first:=5; sid5
+@d id6==id_first:=4; sid4
+@d id7==id_first:=3; sid3
+@d id8==id_first:=2; sid2
+@d id9==id_first:=1; sid1
+
+@<Globals...@>=
+@!cur_name:name_pointer; {points to the identifier just inserted}
+
+@ The intended use of the macros above might not be immediately obvious,
+but the riddle is answered by the following:
+
+@<Store all the reserved words@>=
+id_loc:=10;@/
+id3("a")("n")("d")(char_like+and_sign);@/
+id5("a")("r")("r")("a")("y")(array_like);@/
+id5("b")("e")("g")("i")("n")(begin_like);@/
+id4("c")("a")("s")("e")(case_like);@/
+id5("c")("o")("n")("s")("t")(const_like);@/
+id3("d")("i")("v")(div_like);@/
+id2("d")("o")(do_like);@/
+id6("d")("o")("w")("n")("t")("o")(to_like);@/
+id4("e")("l")("s")("e")(else_like);@/
+id3("e")("n")("d")(end_like);@/
+id4("f")("i")("l")("e")(array_like);@/
+id3("f")("o")("r")(for_like);@/
+id8("f")("u")("n")("c")("t")("i")("o")("n")(proc_like);@/
+id4("g")("o")("t")("o")(goto_like);@/
+id2("i")("f")(if_like);@/
+id2("i")("n")(char_like+set_element_sign);@/
+id5("l")("a")("b")("e")("l")(const_like);@/
+id3("m")("o")("d")(div_like);@/
+id3("n")("i")("l")(nil_like);@/
+id3("n")("o")("t")(char_like+not_sign);@/
+id2("o")("f")(do_like);@/
+id2("o")("r")(char_like+or_sign);@/
+id6("p")("a")("c")("k")("e")("d")(goto_like);@/
+id9("p")("r")("o")("c")("e")("d")("u")("r")("e")(proc_like);@/
+id7("p")("r")("o")("g")("r")("a")("m")(proc_like);@/
+id6("r")("e")("c")("o")("r")("d")(record_like);@/
+id6("r")("e")("p")("e")("a")("t")(repeat_like);@/
+id3("s")("e")("t")(array_like);@/
+id4("t")("h")("e")("n")(do_like);@/
+id2("t")("o")(to_like);@/
+id4("t")("y")("p")("e")(const_like);@/
+id5("u")("n")("t")("i")("l")(until_like);@/
+id3("v")("a")("r")(var_like);@/
+id5("w")("h")("i")("l")("e")(for_like);@/
+id4("w")("i")("t")("h")(for_like);@/
+id7("x")("c")("l")("a")("u")("s")("e")(loop_like);@/
+
+@* Searching for module names.
+The |mod_lookup| procedure finds the module name |mod_text[1..l]| in the
+search tree, after inserting it if necessary, and returns a pointer to
+where it was found.
+
+@<Glob...@>=
+@!mod_text:array [0..longest_name] of ASCII_code; {name being sought for}
+
+@ According to the rules of \.{WEB}, no module name
+should be a proper prefix of another, so a ``clean'' comparison should
+occur between any two names. The result of |mod_lookup| is 0 if this
+prefix condition is violated. An error message is printed when such violations
+are detected during phase two of \.{WEAVE}.
+
+@d less=0 {the first name is lexicographically less than the second}
+@d equal=1 {the first name is equal to the second}
+@d greater=2 {the first name is lexicographically greater than the second}
+@d prefix=3 {the first name is a proper prefix of the second}
+@d extension=4 {the first name is a proper extension of the second}
+
+@p function mod_lookup(@!l:sixteen_bits):name_pointer; {finds module name}
+label found;
+var c:less..extension; {comparison between two names}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {row of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {father of node |p|}
+begin c:=greater; q:=0; p:=root;
+while p<>0 do
+ begin @<Set variable |c| to the result of comparing the given name
+ to name |p|@>;
+ q:=p;
+ if c=less then p:=llink[q]
+ else if c=greater then p:=rlink[q]
+ else goto found;
+ end;
+@<Enter a new module name into the tree@>;
+found: if c<>equal then
+ begin err_print('! Incompatible section names'); p:=0;
+@.Incompatible section names@>
+ end;
+mod_lookup:=p;
+end;
+
+@ @<Enter a new module name...@>=
+w:=name_ptr mod ww; k:=byte_ptr[w];
+if k+l>max_bytes then overflow('byte memory');
+if name_ptr>max_names-ww then overflow('name');
+p:=name_ptr;
+if c=less then llink[q]:=p else rlink[q]:=p;
+llink[p]:=0; rlink[p]:=0; xref[p]:=0; c:=equal;
+for j:=1 to l do byte_mem[w,k+j-1]:=mod_text[j];
+byte_ptr[w]:=k+l; byte_start[name_ptr+ww]:=k+l; incr(name_ptr);
+
+@ @<Set variable |c|...@>=
+begin k:=byte_start[p]; w:=p mod ww; c:=equal; j:=1;
+while (k<byte_start[p+ww]) and (j<=l) and (mod_text[j]=byte_mem[w,k]) do
+ begin incr(k); incr(j);
+ end;
+if k=byte_start[p+ww] then
+ if j>l then c:=equal
+ else c:=extension
+else if j>l then c:=prefix
+else if mod_text[j]<byte_mem[w,k] then c:=less
+else c:=greater;
+end
+
+@ The |prefix_lookup| procedure is supposed to find exactly one module
+name that has |mod_text[1..l]| as a prefix. Actually the algorithm
+silently accepts also the situation that some module name is a prefix of
+|mod_text[1..l]|, because the user who painstakingly typed in more than
+necessary probably doesn't want to be told about the wasted effort.
+
+Recall that error messages are not printed during phase one. It is
+possible that the |prefix_lookup| procedure will fail on the first pass,
+because there is no match, yet the second pass might detect no error if a
+matching module name has occurred after the offending prefix. In such a
+case the cross-reference information will be incorrect and \.{WEAVE} will
+report no error. However, such a mistake will be detected by the
+\.{TANGLE} processor.
+
+@p function prefix_lookup(@!l:sixteen_bits):name_pointer; {finds name extension}
+var c:less..extension; {comparison between two names}
+@!count:0..max_names; {the number of hits}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {row of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {another place to resume the search after one branch is done}
+@!r:name_pointer; {extension found}
+begin q:=0; p:=root; count:=0; r:=0; {begin search at root of tree}
+while p<>0 do
+ begin @<Set variable |c| to the result of comparing...@>;
+ if c=less then p:=llink[p]
+ else if c=greater then p:=rlink[p]
+ else begin r:=p; incr(count); q:=rlink[p]; p:=llink[p];
+ end;
+ if p=0 then
+ begin p:=q; q:=0;
+ end;
+ end;
+if count<>1 then
+ if count=0 then err_print('! Name does not match')
+@.Name does not match@>
+ else err_print('! Ambiguous prefix');
+@.Ambiguous prefix@>
+prefix_lookup:=r; {the result will be 0 if there was no match}
+end;
+
+@* Lexical scanning.
+Let us now consider the subroutines that read the \.{WEB} source file
+and break it into meaningful units. There are four such procedures:
+One simply skips to the next `\.{@@\ }' or `\.{@@*}' that begins a
+module; another passes over the \TeX\ text at the beginning of a
+module; the third passes over the \TeX\ text in a \PASCAL\ comment;
+and the last, which is the most interesting, gets the next token of
+a \PASCAL\ text.
+
+@ But first we need to consider the low-level routine |get_line|
+that takes care of merging |change_file| into |web_file|. The |get_line|
+procedure also updates the line numbers for error messages.
+
+@<Globals...@>=
+@!ii:integer; {general purpose |for| loop variable in the outer block}
+@!line:integer; {the number of the current line in the current file}
+@!other_line:integer; {the number of the current line in the input file that
+ is not currently being read}
+@!temp_line:integer; {used when interchanging |line| with |other_line|}
+@!limit:0..long_buf_size; {the last character position occupied in the buffer}
+@!loc:0..long_buf_size; {the next character position to be read from the buffer}
+@!input_has_ended: boolean; {if |true|, there is no more input}
+@!changing: boolean; {if |true|, the current line is from |change_file|}
+@!change_pending: boolean; {if |true|, the current change is not yet
+ recorded in |changed_module[module_count]|}
+
+@ As we change |changing| from |true| to |false| and back again, we must
+remember to swap the values of |line| and |other_line| so that the |err_print|
+routine will be sure to report the correct line number.
+
+@d change_changing==
+ changing := not changing;
+ temp_line:=other_line; other_line:=line; line:=temp_line
+ {|line @t$\null\BA\null$@> other_line|}
+
+@ When |changing| is |false|, the next line of |change_file| is kept in
+|change_buffer[0..change_limit]|, for purposes of comparison with the next
+line of |web_file|. After the change file has been completely input, we
+set |change_limit:=0|, so that no further matches will be made.
+
+@<Globals...@>=
+@!change_buffer:array[0..buf_size] of ASCII_code;
+@!change_limit:0..buf_size; {the last position occupied in |change_buffer|}
+
+@ Here's a simple function that checks if the two buffers are different.
+
+@p function lines_dont_match:boolean;
+label exit;
+var k:0..buf_size; {index into the buffers}
+begin lines_dont_match:=true;
+if change_limit<>limit then return;
+if limit>0 then
+ for k:=0 to limit-1 do if change_buffer[k]<>buffer[k] then return;
+lines_dont_match:=false;
+exit: end;
+
+@ Procedure |prime_the_change_buffer| sets |change_buffer| in preparation
+for the next matching operation. Since blank lines in the change file are
+not used for matching, we have |(change_limit=0)and not changing| if and
+only if the change file is exhausted. This procedure is called only
+when |changing| is true; hence error messages will be reported correctly.
+
+@p procedure prime_the_change_buffer;
+label continue, done, exit;
+var k:0..buf_size; {index into the buffers}
+begin change_limit:=0; {this value will be used if the change file ends}
+@<Skip over comment lines in the change file; |return| if end of file@>;
+@<Skip to the next nonblank line; |return| if end of file@>;
+@<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>;
+exit: end;
+
+@ While looking for a line that begins with \.{@@x} in the change file,
+we allow lines that begin with \.{@@}, as long as they don't begin with
+\.{@@y} or \.{@@z} (which would probably indicate that the change file is
+fouled up).
+
+@<Skip over comment lines in the change file...@>=
+loop@+ begin incr(line);
+ if not input_ln(change_file) then return;
+ if limit<2 then goto continue;
+ if buffer[0]<>"@@" then goto continue;
+ if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if buffer[1]="x" then goto done;
+ if (buffer[1]="y")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@x?');
+@.Where is the match...@>
+ end;
+continue: end;
+done:
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+repeat incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended after @@x');
+@.Change file ended...@>
+ return;
+ end;
+until limit>0;
+
+@ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>=
+begin change_limit:=limit;
+if limit>0 then for k:=0 to limit-1 do change_buffer[k]:=buffer[k];
+end
+
+@ The following procedure is used to see if the next change entry should
+go into effect; it is called only when |changing| is false.
+The idea is to test whether or not the current
+contents of |buffer| matches the current contents of |change_buffer|.
+If not, there's nothing more to do; but if so, a change is called for:
+All of the text down to the \.{@@y} is supposed to match. An error
+message is issued if any discrepancy is found. Then the procedure
+prepares to read the next line from |change_file|.
+
+When a match is found, the current module is marked as changed unless
+the first line after the \.{@@x} and after the \.{@@y} both start with
+either |'@@*'| or |'@@ '| (possibly preceded by whitespace).
+
+@d if_module_start_then_make_change_pending(#)==
+ loc:=0; buffer[limit]:="!";
+ while (buffer[loc]=" ")or(buffer[loc]=tab_mark) do incr(loc);
+ buffer[limit]:=" ";
+ if buffer[loc]="@@" then
+ if (buffer[loc+1]="*") or
+ (buffer[loc+1]=" ") or (buffer[loc+1]=tab_mark) then
+ change_pending:=#
+
+@p procedure check_change; {switches to |change_file| if the buffers match}
+label exit;
+var n:integer; {the number of discrepancies found}
+@!k:0..buf_size; {index into the buffers}
+begin if lines_dont_match then return;
+change_pending:=false;
+if not changed_module[module_count] then
+ begin if_module_start_then_make_change_pending(true);
+ if not change_pending then changed_module[module_count]:=true;
+ end;
+n:=0;
+loop@+ begin change_changing; {now it's |true|}
+ incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended before @@y');
+@.Change file ended...@>
+ change_limit:=0; change_changing; {|false| again}
+ return;
+ end;
+ @<If the current line starts with \.{@@y},
+ report any discrepancies and |return|@>;
+ @<Move |buffer| and |limit|...@>;
+ change_changing; {now it's |false|}
+ incr(line);
+ if not input_ln(web_file) then
+ begin err_print('! WEB file ended during a change');
+@.WEB file ended...@>
+ input_has_ended:=true; return;
+ end;
+ if lines_dont_match then incr(n);
+ end;
+exit: end;
+
+@ @<If the current line starts with \.{@@y}...@>=
+if limit>1 then if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@y?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="y" then
+ begin if n>0 then
+ begin loc:=2; err_print('! Hmm... ',n:1,
+ ' of the preceding lines failed to match');
+@.Hmm... n of the preceding...@>
+ end;
+ return;
+ end;
+ end
+
+@ The |reset_input| procedure, which gets \.{WEAVE} ready to read the
+user's \.{WEB} input, is used at the beginning of phases one and two.
+
+@p procedure reset_input;
+begin open_input; line:=0; other_line:=0;@/
+changing:=true; prime_the_change_buffer; change_changing;@/
+limit:=0; loc:=1; buffer[0]:=" "; input_has_ended:=false;
+end;
+
+@ The |get_line| procedure is called when |loc>limit|; it puts the next
+line of merged input into the buffer and updates the other variables
+appropriately. A space is placed at the right end of the line.
+
+@p procedure get_line; {inputs the next line}
+label restart;
+begin restart:if changing then
+ @<Read from |change_file| and maybe turn off |changing|@>;
+if not changing then
+ begin @<Read from |web_file| and maybe turn on |changing|@>;
+ if changing then goto restart;
+ end;
+loc:=0; buffer[limit]:=" ";
+end;
+
+@ @<Read from |web_file|...@>=
+begin incr(line);
+if not input_ln(web_file) then input_has_ended:=true
+else if limit=change_limit then
+ if buffer[0]=change_buffer[0] then
+ if change_limit>0 then check_change;
+end
+
+@ @<Read from |change_file|...@>=
+begin incr(line);
+if not input_ln(change_file) then
+ begin err_print('! Change file ended without @@z');
+@.Change file ended...@>
+ buffer[0]:="@@"; buffer[1]:="z"; limit:=2;
+ end;
+if limit>0 then {check if the change has ended}
+ begin if change_pending then
+ begin if_module_start_then_make_change_pending(false);
+ if change_pending then
+ begin changed_module[module_count]:=true; change_pending:=false;
+ end;
+ end;
+ buffer[limit]:=" ";
+ if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="y") then
+ begin loc:=2; err_print('! Where is the matching @@z?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="z" then
+ begin prime_the_change_buffer; change_changing;
+ end;
+ end;
+ end;
+end
+
+@ At the end of the program, we will tell the user if the change file
+had a line that didn't match any relevant line in |web_file|.
+
+@<Check that all changes have been read@>=
+if change_limit<>0 then {|changing| is false}
+ begin for ii:=0 to change_limit do buffer[ii]:=change_buffer[ii];
+ limit:=change_limit; changing:=true; line:=other_line; loc:=change_limit;
+ err_print('! Change file entry did not match');
+@.Change file entry did not match@>
+ end
+
+@ Control codes in \.{WEB}, which begin with `\.{@@}', are converted
+into a numeric code designed to simplify \.{WEAVE}'s logic; for example,
+larger numbers are given to the control codes that denote more significant
+milestones, and the code of |new_module| should be the largest of
+all. Some of these numeric control codes take the place of ASCII
+control codes that will not otherwise appear in the output of the
+scanning routines.
+@^ASCII code@>
+
+@d ignore=0 {control code of no interest to \.{WEAVE}}
+@d verbatim=@'2 {extended ASCII alpha will not appear}
+@d force_line=@'3 {extended ASCII beta will not appear}
+@d begin_comment=@'11 {ASCII tab mark will not appear}
+@d end_comment=@'12 {ASCII line feed will not appear}
+@d octal=@'14 {ASCII form feed will not appear}
+@d hex=@'15 {ASCII carriage return will not appear}
+@d double_dot=@'40 {ASCII space will not appear except in strings}
+@d no_underline=@'175 {this code will be intercepted without confusion}
+@d underline=@'176 {this code will be intercepted without confusion}
+@d param=@'177 {ASCII delete will not appear}
+@d xref_roman=@'203 {control code for `\.{@@\^}'}
+@d xref_wildcard=@'204 {control code for `\.{@@:}'}
+@d xref_typewriter=@'205 {control code for `\.{@@.}'}
+@d TeX_string=@'206 {control code for `\.{@@t}'}
+@d check_sum=@'207 {control code for `\.{@@\$}'}
+@d join=@'210 {control code for `\.{@@\&}'}
+@d thin_space=@'211 {control code for `\.{@@,}'}
+@d math_break=@'212 {control code for `\.{@@\char'174}'}
+@d line_break=@'213 {control code for `\.{@@/}'}
+@d big_line_break=@'214 {control code for `\.{@@\#}'}
+@d no_line_break=@'215 {control code for `\.{@@+}'}
+@d pseudo_semi=@'216 {control code for `\.{@@;}'}
+@d format=@'217 {control code for `\.{@@f}'}
+@d definition=@'220 {control code for `\.{@@d}'}
+@d begin_Pascal=@'221 {control code for `\.{@@p}'}
+@d module_name=@'222 {control code for `\.{@@<}'}
+@d new_module=@'223 {control code for `\.{@@\ }' and `\.{@@*}'}
+
+@ Control codes are converted from ASCII to \.{WEAVE}'s internal
+representation by the |control_code| routine.
+
+@p function control_code(@!c:ASCII_code):eight_bits; {convert |c|
+ after \.{@@}}
+begin case c of
+"@@": control_code:="@@"; {`quoted' at sign}
+"'": control_code:=octal; {precedes octal constant}
+"""": control_code:=hex; {precedes hexadecimal constant}
+"$": control_code:=check_sum; {precedes check sum constant}
+" ",tab_mark,"*": control_code:=new_module; {beginning of a new module}
+"=": control_code:=verbatim;
+"\": control_code:=force_line;
+"D","d": control_code:=definition; {macro definition}
+"F","f": control_code:=format; {format definition}
+"{": control_code:=begin_comment; {begin-comment delimiter}
+"}": control_code:=end_comment; {end-comment delimiter}
+"P","p": control_code:=begin_Pascal; {\PASCAL\ text in unnamed module}
+"&": control_code:=join; {concatenate two tokens}
+"<": control_code:=module_name; {beginning of a module name}
+">": begin err_print('! Extra @@>'); control_code:=ignore;
+@.Extra \AT!>@>
+ end; {end of module name should not be discovered in this way}
+"T","t": control_code:=TeX_string; {\TeX\ box within \PASCAL}
+"!": control_code:=underline; {set definition flag}
+"?": control_code:=no_underline; {reset definition flag}
+"^": control_code:=xref_roman; {index entry to be typeset normally}
+":": control_code:=xref_wildcard; {index entry to be in user format}
+".": control_code:=xref_typewriter; {index entry to be in typewriter type}
+",": control_code:=thin_space; {puts extra space in \PASCAL\ format}
+"|": control_code:=math_break; {allows a break in a formula}
+"/": control_code:=line_break; {forces end-of-line in \PASCAL\ format}
+"#": control_code:=big_line_break; {forces end-of-line and some space besides}
+"+": control_code:=no_line_break; {cancels end-of-line down to single space}
+";": control_code:=pseudo_semi; {acts like a semicolon, but is invisible}
+@t\4@>@<Special control codes allowed only when debugging@>@;
+othercases begin err_print('! Unknown control code'); control_code:=ignore;
+@.Unknown control code@>
+ end
+endcases;
+end;
+
+@ If \.{WEAVE} is compiled with debugging commands, one can write
+\.{@@2}, \.{@@1}, and \.{@@0} to turn tracing fully on, partly on,
+and off, respectively.
+@.\AT!2@>
+@.\AT!1@>
+
+@<Special control codes...@>=
+@!debug@t@>@/
+"0","1","2": begin tracing:=c-"0"; control_code:=ignore;
+ end;
+gubed
+
+@ The |skip_limbo| routine is used on the first pass to skip through
+portions of the input that are not in any modules, i.e., that precede
+the first module. After this procedure has been called, the value of
+|input_has_ended| will tell whether or not a new module has
+actually been found.
+
+@p procedure skip_limbo; {skip to next module}
+label exit;
+var c:ASCII_code; {character following \.{@@}}
+begin loop if loc>limit then
+ begin get_line;
+ if input_has_ended then return;
+ end
+ else begin buffer[limit+1]:="@@";
+ while buffer[loc]<>"@@" do incr(loc);
+ if loc<=limit then
+ begin loc:=loc+2; c:=buffer[loc-1];
+ if (c=" ")or(c=tab_mark)or(c="*") then return;
+ end;
+ end;
+exit: end;
+
+@ The |skip_TeX| routine is used on the first pass to skip through
+the \TeX\ code at the beginning of a module. It returns the next
+control code or `\v' found in the input. A |new_module| is
+assumed to exist at the very end of the file.
+
+@p function skip_TeX: eight_bits; {skip past pure \TeX\ code}
+label done;
+var c:eight_bits; {control code found}
+begin loop begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin c:=new_module; goto done;
+ end;
+ end;
+ buffer[limit+1]:="@@";
+ repeat c:=buffer[loc]; incr(loc);
+ if c="|" then goto done;
+ until c="@@";
+ if loc<=limit then
+ begin c:=control_code(buffer[loc]); incr(loc); goto done;
+ end;
+ end;
+done:skip_TeX:=c;
+end;
+
+@ The |skip_comment| routine is used on the first pass to skip
+through \TeX\ code in \PASCAL\ comments. The |bal| parameter
+tells how many left braces are assumed to have been scanned when
+this routine is called, and the procedure returns a corresponding
+value of |bal| at the point that scanning has stopped. Scanning
+stops either at a `\v' that introduces \PASCAL\ text,
+in which case the returned value is positive, or it stops at the
+end of the comment, in which case the returned value is zero.
+The scanning also stops in anomalous situations when the comment
+doesn't end or when it contains an illegal use of \.{@@}.
+One should call |skip_comment(1)| when beginning to scan a comment.
+
+@p function skip_comment(@!bal:eight_bits):eight_bits; {skips \TeX\
+ code in comments}
+label done;
+var c:ASCII_code; {the current character}
+begin loop begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin bal:=0; goto done;
+ end; {an error message will occur in phase two}
+ end;
+ c:=buffer[loc]; incr(loc);
+ if c="|" then goto done;
+ @<Do special things when |c="@@", "\", "{", "}"|; |goto done| at end@>;
+ end;
+done: skip_comment:=bal;
+end;
+
+@ @<Do special things when |c="@@"...@>=
+if c="@@" then
+ begin c:=buffer[loc];
+ if (c<>" ")and(c<>tab_mark)and(c<>"*") then incr(loc)
+ else begin decr(loc); bal:=0; goto done;
+ end {an error message will occur in phase two}
+ end
+else if (c="\")and(buffer[loc]<>"@@") then incr(loc)
+else if c="{" then incr(bal)
+else if c="}" then
+ begin decr(bal);
+ if bal=0 then goto done;
+ end
+
+@* Inputting the next token.
+As stated above, \.{WEAVE}'s most interesting lexical scanning routine is the
+|get_next| function that inputs the next token of \PASCAL\ input. However,
+|get_next| is not especially complicated.
+
+The result of |get_next| is either an ASCII code for some special character,
+or it is a special code representing a pair of characters (e.g., `\.{:=}'
+or `\.{..}'), or it is the numeric value computed by the |control_code|
+procedure, or it is one of the following special codes:
+
+\yskip\hang |exponent|: The `\.E' in a real constant.
+
+\yskip\hang |identifier|: In this case the global variables |id_first|
+and |id_loc| will have been set to the appropriate values needed by the
+|id_lookup| routine.
+
+\yskip\hang |string|: In this case the global variables |id_first| and
+|id_loc| will have been set to the beginning and ending-plus-one locations
+in the buffer. The string ends with the first reappearance of its initial
+delimiter; thus, for example, $$\.{\'This isn\'\'t a single string\'}$$
+will be treated as two consecutive strings, the first being \.{\'This
+isn\'}.
+
+\yskip\noindent Furthermore, some of the control codes cause
+|get_next| to take additional actions:
+
+\yskip\hang |xref_roman|, |xref_wildcard|,
+|xref_typewriter|, |TeX_string|: The values of
+|id_first| and |id_loc| will be set so that the string in question appears
+in |buffer[id_first..(id_loc-1)]|.
+
+\yskip\hang |module_name|: In this case the global variable |cur_module| will
+point to the |byte_start| entry for the module name that has just been scanned.
+
+\yskip\noindent If |get_next| sees `\.{@@!}' or `\.{@@?}',
+it sets |xref_switch| to |def_flag| or zero and goes on to the next token.
+
+A global variable called |scanning_hex| is set |true| during the time that
+the letters \.A through \.F should be treated as if they were digits.
+
+@d exponent=@'200 {\.E or \.e following a digit}
+@d string=@'201 {\PASCAL\ string or \.{WEB} precomputed string}
+@d identifier=@'202 {\PASCAL\ identifier or reserved word}
+
+@<Globals...@>=
+@!cur_module: name_pointer; {name of module just scanned}
+@!scanning_hex: boolean; {are we scanning a hexadecimal constant?}
+
+@ @<Set init...@>=
+scanning_hex:=false;
+
+@ As one might expect, |get_next| consists mostly of a big switch
+that branches to the various special cases that can arise.
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+ #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@p function get_next:eight_bits; {produces the next input token}
+label restart,done,found;
+var c:eight_bits; {the current character}
+@!d:eight_bits; {the next character}
+@!j,@!k:0..longest_name; {indices into |mod_text|}
+begin restart: if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin c:=new_module; goto found;
+ end;
+ end;
+c:=buffer[loc]; incr(loc);
+if scanning_hex then @<Go to |found| if |c| is a hexadecimal digit,
+ otherwise set |scanning_hex:=false|@>;
+case c of
+"A",up_to("Z"),"a",up_to("z"): @<Get an identifier@>;
+"'","""": @<Get a string@>;
+"@@": @<Get control code and possible module name@>;
+@t\4@>@<Compress two-symbol combinations like `\.{:=}'@>@;
+" ",tab_mark: goto restart; {ignore spaces and tabs}
+"}": begin err_print('! Extra }'); goto restart;
+@.Extra \}@>
+ end;
+othercases if c>=128 then goto restart {ignore nonstandard characters}
+ else do_nothing
+endcases;
+found:@!debug if trouble_shooting then debug_help;@;@+gubed@/
+get_next:=c;
+end;
+
+@ @<Go to |found| if |c| is a hexadecimal digit...@>=
+if ((c>="0")and(c<="9"))or((c>="A")and(c<="F")) then goto found
+else scanning_hex:=false
+
+@ Note that the following code substitutes \.{@@\{} and \.{@@\}} for the
+respective combinations `\.{(*}' and `\.{*)}'. Explicit braces should be used
+for \TeX\ comments in \PASCAL\ text.
+
+@d compress(#)==begin if loc<=limit then begin c:=#; incr(loc); end; end
+
+@<Compress two-symbol...@>=
+".": if buffer[loc]="." then compress(double_dot)
+ else if buffer[loc]=")" then compress("]");
+":": if buffer[loc]="=" then compress(left_arrow);
+"=": if buffer[loc]="=" then compress(equivalence_sign);
+">": if buffer[loc]="=" then compress(greater_or_equal);
+"<": if buffer[loc]="=" then compress(less_or_equal)
+ else if buffer[loc]=">" then compress(not_equal);
+"(": if buffer[loc]="*" then compress(begin_comment)
+ else if buffer[loc]="." then compress("[");
+"*": if buffer[loc]=")" then compress(end_comment);
+
+@ @<Get an identifier@>=
+begin if ((c="E")or(c="e"))and(loc>1) then
+ if (buffer[loc-2]<="9")and(buffer[loc-2]>="0") then c:=exponent;
+if c<>exponent then
+ begin decr(loc); id_first:=loc;
+ repeat incr(loc); d:=buffer[loc];
+ until ((d<"0")or((d>"9")and(d<"A"))or((d>"Z")and(d<"a"))or(d>"z"))and(d<>"_");
+ c:=identifier; id_loc:=loc;
+ end;
+end
+
+@ A string that starts and ends with single or double quote marks is
+scanned by the following piece of the program.
+
+@<Get a string@>=
+begin id_first:=loc-1;
+repeat d:=buffer[loc]; incr(loc);
+if loc>limit then
+ begin err_print('! String constant didn''t end');
+@.String constant didn't end@>
+ loc:=limit; d:=c;
+ end;
+until d=c;
+id_loc:=loc; c:=string;
+end
+
+@ After an \.{@@} sign has been scanned, the next character tells us
+whether there is more work to do.
+
+@<Get control code and possible module name@>=
+begin c:=control_code(buffer[loc]); incr(loc);
+if c=underline then
+ begin xref_switch:=def_flag; goto restart;
+ end
+else if c=no_underline then
+ begin xref_switch:=0; goto restart;
+ end
+else if (c<=TeX_string)and(c>=xref_roman) then
+ @<Scan to the next \.{@@>}@>
+else if c=hex then scanning_hex:=true
+else if c=module_name then
+ @<Scan the module name and make |cur_module| point to it@>
+else if c=verbatim then @<Scan a verbatim string@>;
+end
+
+@ The occurrence of a module name sets |xref_switch| to zero,
+because the module name might (for example) follow \&{var}.
+
+@<Scan the module name...@>=
+begin @<Put module name into |mod_text[1..k]|@>;
+if k>3 then
+ begin if (mod_text[k]=".")and(mod_text[k-1]=".")and(mod_text[k-2]=".") then
+ cur_module:=prefix_lookup(k-3)
+ else cur_module:=mod_lookup(k);
+ end
+else cur_module:=mod_lookup(k);
+xref_switch:=0;
+end
+
+@ Module names are placed into the |mod_text| array with consecutive spaces,
+tabs, and carriage-returns replaced by single spaces. There will be no
+spaces at the beginning or the end. (We set |mod_text[0]:=" "| to facilitate
+this, since the |mod_lookup| routine uses |mod_text[1]| as the first
+character of the name.)
+
+@<Set init...@>=mod_text[0]:=" ";
+
+@ @<Put module name...@>=
+k:=0;
+loop@+ begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin err_print('! Input ended in section name');
+@.Input ended in section name@>
+ loc:=1; goto done;
+ end;
+ end;
+ d:=buffer[loc];
+ @<If end of name, |goto done|@>;
+ incr(loc); if k<longest_name-1 then incr(k);
+ if (d=" ")or(d=tab_mark) then
+ begin d:=" "; if mod_text[k-1]=" " then decr(k);
+ end;
+ mod_text[k]:=d;
+ end;
+done: @<Check for overlong name@>;
+if (mod_text[k]=" ")and(k>0) then decr(k)
+
+@ @<If end of name,...@>=
+if d="@@" then
+ begin d:=buffer[loc+1];
+ if d=">" then
+ begin loc:=loc+2; goto done;
+ end;
+ if (d=" ")or(d=tab_mark)or(d="*") then
+ begin err_print('! Section name didn''t end'); goto done;
+@.Section name didn't end@>
+ end;
+ incr(k); mod_text[k]:="@@"; incr(loc); {now |d=buffer[loc]| again}
+ end
+
+@ @<Check for overlong name@>=
+if k>=longest_name-2 then
+ begin print_nl('! Section name too long: ');
+@.Section name too long@>
+ for j:=1 to 25 do print(xchr[mod_text[j]]);
+ print('...'); mark_harmless;
+ end
+
+@ @<Scan to the next...@>=
+begin id_first:=loc; buffer[limit+1]:="@@";
+while buffer[loc]<>"@@" do incr(loc);
+id_loc:=loc;
+if loc>limit then
+ begin err_print('! Control text didn''t end'); loc:=limit;
+@.Control text didn't end@>
+ end
+else begin loc:=loc+2;
+ if buffer[loc-1]<>">" then
+ err_print('! Control codes are forbidden in control text');
+@.Control codes are forbidden...@>
+ end;
+end
+
+@ A verbatim \PASCAL\ string will be treated like ordinary strings, but
+with no surrounding delimiters. At the present point in the program we
+have |buffer[loc-1]=verbatim|; we must set |id_first| to the beginning
+of the string itself, and |id_loc| to its ending-plus-one location in the
+buffer. We also set |loc| to the position just after the ending delimiter.
+
+@<Scan a verbatim string@>=
+begin id_first:=loc; incr(loc);
+buffer[limit+1]:="@@"; buffer[limit+2]:=">";
+while (buffer[loc]<>"@@")or(buffer[loc+1]<>">") do incr(loc);
+if loc>=limit then err_print('! Verbatim string didn''t end');
+@.Verbatim string didn't end@>
+id_loc:=loc; loc:=loc+2;
+end
+
+@* Phase one processing.
+We now have accumulated enough subroutines to make it possible to carry out
+\.{WEAVE}'s first pass over the source file. If everything works right,
+both phase one and phase two of \.{WEAVE} will assign the same numbers to
+modules, and these numbers will agree with what \.{TANGLE} does.
+
+The global variable |next_control| often contains the most recent output of
+|get_next|; in interesting cases, this will be the control code that
+ended a module or part of a module.
+
+@<Glob...@>=@!next_control:eight_bits; {control code waiting to be acting upon}
+
+@ The overall processing strategy in phase one has the following
+straightforward outline.
+
+@<Phase I: Read all the user's text and store the cross references@>=
+phase_one:=true; phase_three:=false;
+reset_input;
+module_count:=0; skip_limbo; change_exists:=false;
+while not input_has_ended do
+ @<Store cross reference data for the current module@>;
+changed_module[module_count]:=change_exists;
+ {the index changes if anything does}
+phase_one:=false; {prepare for second phase}
+@<Print error messages about unused or undefined module names@>;
+
+@ @<Store cross reference data...@>=
+begin incr(module_count);
+if module_count=max_modules then overflow('section number');
+changed_module[module_count]:=changing;
+ {it will become |true| if any line changes}
+if buffer[loc-1]="*" then
+ begin print('*',module_count:1);
+ update_terminal; {print a progress report}
+ end;
+@<Store cross references in the \TeX\ part of a module@>;
+@<Store cross references in the \(definition part of a module@>;
+@<Store cross references in the \PASCAL\ part of a module@>;
+if changed_module[module_count] then change_exists:=true;
+end
+
+@ The |Pascal_xref| subroutine stores references to identifiers in
+\PASCAL\ text material beginning with the current value of |next_control|
+and continuing until |next_control| is `\.\{' or `\v', or until the next
+``milestone'' is passed (i.e., |next_control>=format|). If
+|next_control>=format| when |Pascal_xref| is called, nothing will happen;
+but if |next_control="|"| upon entry, the procedure assumes that this is
+the `\v' preceding \PASCAL\ text that is to be processed.
+
+The program uses the fact that our internal code numbers satisfy
+the relations |xref_roman=identifier+roman| and |xref_wildcard=identifier
++wildcard| and |xref_typewriter=identifier+
+typewriter| and |normal=0|. An implied `\.{@@!}' is inserted after
+\&{function}, \&{procedure}, \&{program}, and \&{var}.
+
+@p procedure Pascal_xref; {makes cross references for \PASCAL\ identifiers}
+label exit;
+var p:name_pointer; {a referenced name}
+begin while next_control<format do
+ begin if (next_control>=identifier)and
+ (next_control<=xref_typewriter) then
+ begin p:=id_lookup(next_control-identifier); new_xref(p);
+ if (ilk[p]=proc_like)or(ilk[p]=var_like) then
+ xref_switch:=def_flag; {implied `\.{@@!}'}
+ end;
+ next_control:=get_next;
+ if (next_control="|")or(next_control="{") then return;
+ end;
+exit:end;
+
+@ The |outer_xref| subroutine is like |Pascal_xref| but it begins
+with |next_control<>"|"| and ends with |next_control>=format|. Thus, it
+handles \PASCAL\ text with embedded comments.
+
+@p procedure outer_xref; {extension of |Pascal_xref|}
+var bal:eight_bits; {brace level in comment}
+begin while next_control<format do
+ if next_control<>"{" then Pascal_xref
+ else begin bal:=skip_comment(1); next_control:="|";
+ while bal>0 do
+ begin Pascal_xref;
+ if next_control="|" then bal:=skip_comment(bal)
+ else bal:=0; {an error will be reported in phase two}
+ end;
+ end;
+end;
+
+@ In the \TeX\ part of a module, cross reference entries are made only for
+the identifiers in \PASCAL\ texts enclosed in \pb, or for control texts
+enclosed in \.{@@\^}$\,\ldots\,$\.{@@>} or \.{@@.}$\,\ldots\,$\.{@@>}
+or \.{@@:}$\,\ldots\,$\.{@@>}.
+
+@<Store cross references in the \T...@>=
+repeat next_control:=skip_TeX;
+case next_control of
+underline: xref_switch:=def_flag;
+no_underline: xref_switch:=0;
+"|": Pascal_xref;
+xref_roman, xref_wildcard, xref_typewriter, module_name:
+ begin loc:=loc-2; next_control:=get_next; {scan to \.{@@>}}
+ if next_control<>module_name then
+ new_xref(id_lookup(next_control-identifier));
+ end;
+othercases do_nothing
+endcases;
+until next_control>=format
+
+@ During the definition and \PASCAL\ parts of a module, cross references
+are made for all identifiers except reserved words; however, the
+identifiers in a format definition are referenced even if they are
+reserved. The \TeX\ code in comments is, of course, ignored, except for
+\PASCAL\ portions enclosed in \pb; the text of a module name is skipped
+entirely, even if it contains \pb\ constructions.
+
+The variables |lhs| and |rhs| point to the respective identifiers involved
+in a format definition.
+
+@<Global...@>=
+@!lhs,@!rhs:name_pointer; {indices into |byte_start| for format identifiers}
+
+@ When we get to the following code we have |next_control>=format|.
+
+@<Store cross references in the \(d...@>=
+while next_control<=definition do {|format| or |definition|}
+ begin xref_switch:=def_flag; {implied \.{@@!}}
+ if next_control=definition then next_control:=get_next
+ else @<Process a format definition@>;
+ outer_xref;
+ end
+
+@ Error messages for improper format definitions will be issued in phase
+two. Our job in phase one is to define the |ilk| of a properly formatted
+identifier, and to fool the |new_xref| routine into thinking that the
+identifier on the right-hand side of the format definition is not a
+reserved word.
+
+@<Process a form...@>=
+begin next_control:=get_next;
+if next_control=identifier then
+ begin lhs:=id_lookup(normal); ilk[lhs]:=normal; new_xref(lhs);
+ next_control:=get_next;
+ if next_control=equivalence_sign then
+ begin next_control:=get_next;
+ if next_control=identifier then
+ begin rhs:=id_lookup(normal);
+ ilk[lhs]:=ilk[rhs]; ilk[rhs]:=normal; new_xref(rhs);
+ ilk[rhs]:=ilk[lhs]; next_control:=get_next;
+ end;
+ end;
+ end;
+end
+
+@ Finally, when the \TeX\ and definition parts have been treated, we have
+|next_control>=begin_Pascal|.
+
+@<Store cross references in the \P...@>=
+if next_control<=module_name then {|begin_Pascal| or |module_name|}
+ begin if next_control=begin_Pascal then mod_xref_switch:=0
+ else mod_xref_switch:=def_flag;
+ repeat if next_control=module_name then new_mod_xref(cur_module);
+ next_control:=get_next; outer_xref;
+ until next_control>module_name;
+ end
+
+@ After phase one has looked at everything, we want to check that each
+module name was both defined and used.
+The variable |cur_xref| will point to cross references for the
+current module name of interest.
+
+@<Glob...@>=@!cur_xref:xref_number; {temporary cross reference pointer}
+
+@ The following recursive procedure
+walks through the tree of module names and prints out anomalies.
+@^recursion@>
+
+@p procedure mod_check(@!p:name_pointer); {print anomalies in subtree |p|}
+begin if p>0 then
+ begin mod_check(llink[p]);@/
+ cur_xref:=xref[p];
+ if num(cur_xref)<def_flag then
+ begin print_nl('! Never defined: <'); print_id(p);
+@.Never defined: <section name>@>
+ print('>'); mark_harmless;
+ end;
+ while num(cur_xref)>=def_flag do cur_xref:=xlink(cur_xref);
+ if cur_xref=0 then
+ begin print_nl('! Never used: <'); print_id(p); print('>');
+@.Never used: <section name>@>
+ mark_harmless;
+ end;
+ mod_check(rlink[p]);
+ end;
+end;
+
+@ @<Print error messages about un...@>=@+mod_check(root)
+
+@* Low-level output routines.
+The \TeX\ output is supposed to appear in lines at most |line_length|
+characters long, so we place it into an output buffer. During the output
+process, |out_line| will hold the current line number of the line about to
+be output.
+
+@<Glo...@>=
+@!out_buf:array[0..line_length] of ASCII_code; {assembled characters}
+@!out_ptr:0..line_length; {number of characters in |out_buf|}
+@!out_line: integer; {coordinates of next line to be output}
+
+@ The |flush_buffer| routine empties the buffer up to a given breakpoint,
+and moves any remaining characters to the beginning of the next line.
+If the |per_cent| parameter is |true|, a |"%"| is appended to the line
+that is being output; in this case the breakpoint |b| should be strictly
+less than |line_length|. If the |per_cent| parameter is |false|,
+trailing blanks are suppressed.
+The characters emptied from the buffer form a new line of output;
+if the |carryover| parameter is true, a |"%"| in that line will be
+carried over to the next line (so that \TeX\ will ignore the completion
+of commented-out text).
+
+@p procedure flush_buffer(@!b:eight_bits;@!per_cent,@!carryover:boolean);
+ {outputs |out_buf[1..b]|, where |b<=out_ptr|}
+label done,found;
+var j,@!k:0..line_length;
+begin j:=b;
+if not per_cent then {remove trailing blanks}
+ loop@+ begin if j=0 then goto done;
+ if out_buf[j]<>" " then goto done;
+ decr(j);
+ end;
+done: for k:=1 to j do write(tex_file,xchr[out_buf[k]]);
+if per_cent then write(tex_file,xchr["%"]);
+write_ln(tex_file); incr(out_line);
+if carryover then
+ for k:=1 to j do
+ if out_buf[k]="%" then
+ if (k=1)or(out_buf[k-1]<>"\") then {comment mode should be preserved}
+ begin out_buf[b]:="%"; decr(b); goto found;
+ end;
+found: if (b<out_ptr) then
+ for k:=b+1 to out_ptr do out_buf[k-b]:=out_buf[k];
+out_ptr:=out_ptr-b;
+end;
+
+@ When we are copying \TeX\ source material, we retain line breaks
+that occur in the input, except that an empty line is not
+output when the \TeX\ source line was nonempty. For example, a line
+of the \TeX\ file that contains only an index cross-reference entry
+will not be copied. The |finish_line| routine is called just before
+|get_line| inputs a new line, and just after a line break token has
+been emitted during the output of translated \PASCAL\ text.
+
+@p procedure finish_line; {do this at the end of a line}
+label exit;
+var k:0..buf_size; {index into |buffer|}
+begin if out_ptr>0 then flush_buffer(out_ptr,false,false)
+else begin for k:=0 to limit do
+ if (buffer[k]<>" ")and(buffer[k]<>tab_mark) then return;
+ flush_buffer(0,false,false);
+ end;
+exit:end;
+
+@ In particular, the |finish_line| procedure is called near the very
+beginning of phase two. We initialize the output variables in a slightly
+tricky way so that the first line of the output file will be
+`\.{\\input webmac}'.
+@.\\input webmac@>
+@.webmac@>
+
+@<Set init...@>=
+out_ptr:=1; out_line:=1; out_buf[1]:="c"; write(tex_file,'\input webma');
+
+@ When we wish to append the character |c| to the output buffer, we write
+`$|out|(c)$'; this will cause the buffer to be emptied if it was already
+full. Similarly, `$|out2|(c_1)(c_2)$' appends a pair of characters.
+A line break will occur at a space or after a single-nonletter
+\TeX\ control sequence.
+
+@d oot(#)==@;@/
+ if out_ptr=line_length then break_out;
+ incr(out_ptr); out_buf[out_ptr]:=#;
+@d oot1(#)==oot(#)@+end
+@d oot2(#)==oot(#)@,oot1
+@d oot3(#)==oot(#)@,oot2
+@d oot4(#)==oot(#)@,oot3
+@d oot5(#)==oot(#)@,oot4
+@d out==@+begin oot1
+@d out2==@+begin oot2
+@d out3==@+begin oot3
+@d out4==@+begin oot4
+@d out5==@+begin oot5
+
+@ The |break_out| routine is called just before the output buffer is about
+to overflow. To make this routine a little faster, we initialize position
+0 of the output buffer to `\.\\'; this character isn't really output.
+
+@<Set init...@>=
+out_buf[0]:="\";
+
+@ A long line is broken at a blank space or just before a backslash that isn't
+preceded by another backslash. In the latter case, a |"%"| is output at
+the break.
+
+@p procedure break_out; {finds a way to break the output line}
+label exit;
+var k:0..line_length; {index into |out_buf|}
+@!d:ASCII_code; {character from the buffer}
+begin k:=out_ptr;
+loop@+ begin if k=0 then
+ @<Print warning message, break the line, |return|@>;
+ d:=out_buf[k];
+ if d=" " then
+ begin flush_buffer(k,false,true); return;
+ end;
+ if (d="\")and(out_buf[k-1]<>"\") then {in this case |k>1|}
+ begin flush_buffer(k-1,true,true); return;
+ end;
+ decr(k);
+ end;
+exit:end;
+
+@ We get to this module only in unusual cases that the entire output line
+consists of a string of backslashes followed by a string of nonblank
+non-backslashes. In such cases it is almost always safe to break the
+line by putting a |"%"| just before the last character.
+
+@<Print warning message...@>=
+begin print_nl('! Line had to be broken (output l.',out_line:1);
+@.Line had to be broken@>
+print_ln('):');
+for k:=1 to out_ptr-1 do print(xchr[out_buf[k]]);
+new_line; mark_harmless;
+flush_buffer(out_ptr-1,true,true); return;
+end
+
+@ Here is a procedure that outputs a module number in decimal notation.
+
+@<Glob...@>=@!dig:array[0..4] of 0..9; {digits to output}
+
+@ The number to be converted by |out_mod| is known to be less than
+|def_flag|, so it cannot have more than five decimal digits. If
+the module is changed, we output `\.{\\*}' just after the number.
+
+@p procedure out_mod(@!m:integer); {output a module number}
+var k:0..5; {index into |dig|}
+@!a:integer; {accumulator}
+begin k:=0; a:=m;
+repeat dig[k]:=a mod 10; a:=a div 10; incr(k);
+until a=0;
+repeat decr(k); out(dig[k]+"0");
+until k=0;
+if changed_module[m] then out2("\")("*");
+@.\\*@>
+end;
+
+@ The |out_name| subroutine is used to output an identifier or index
+entry, enclosing it in braces.
+
+@p procedure out_name(@!p:name_pointer); {outputs a name}
+var k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {row of |byte_mem|}
+begin out("{"); w:=p mod ww;
+for k:=byte_start[p] to byte_start[p+ww]-1 do
+ begin if byte_mem[w,k]="_" then out("\");
+@.\\_@>
+ out(byte_mem[w,k]);
+ end;
+out("}");
+end;
+
+@* Routines that copy \TeX\ material.
+During phase two, we use the subroutines |copy_limbo|, |copy_TeX|, and
+|copy_comment| in place of the analogous |skip_limbo|, |skip_TeX|, and
+|skip_comment| that were used in phase one.
+
+The |copy_limbo| routine, for example, takes \TeX\ material that is not
+part of any module and transcribes it almost verbatim to the output file.
+No `\.{@@}' signs should occur in such material except in `\.{@@@@}'
+pairs; such pairs are replaced by singletons.
+
+@p procedure copy_limbo; {copy \TeX\ code until the next module begins}
+label exit;
+var c:ASCII_code; {character following \.{@@} sign}
+begin loop if loc>limit then
+ begin finish_line; get_line;
+ if input_has_ended then return;
+ end
+ else begin buffer[limit+1]:="@@";
+ @<Copy up to control code, |return| if finished@>;
+ end;
+exit:end;
+
+@ @<Copy up to control...@>=
+while buffer[loc]<>"@@" do
+ begin out(buffer[loc]); incr(loc);
+ end;
+if loc<=limit then
+ begin loc:=loc+2; c:=buffer[loc-1];
+ if (c=" ")or(c=tab_mark)or(c="*") then return;
+ if (c<>"z")and(c<>"Z") then
+ begin out("@@");
+ if c<>"@@" then err_print('! Double @@ required outside of sections');
+@.Double \AT! required...@>
+ end;
+ end
+
+@ The |copy_TeX| routine processes the \TeX\ code at the beginning of a
+module; for example, the words you are now reading were copied in this
+way. It returns the next control code or `\v' found in the input.
+
+@p function copy_TeX:eight_bits; {copy pure \TeX\ material}
+label done;
+var c:eight_bits; {control code found}
+begin loop begin if loc>limit then
+ begin finish_line; get_line;
+ if input_has_ended then
+ begin c:=new_module; goto done;
+ end;
+ end;
+ buffer[limit+1]:="@@";
+ @<Copy up to `\v' or control code, |goto done| if finished@>;
+ end;
+done:copy_TeX:=c;
+end;
+
+@ We don't copy spaces or tab marks into the beginning of a line. This
+makes the test for empty lines in |finish_line| work.
+
+@<Copy up to `\v'...@>=
+repeat c:=buffer[loc]; incr(loc);
+if c="|" then goto done;
+if c<>"@@" then
+ begin out(c);
+ if (out_ptr=1)and((c=" ")or(c=tab_mark)) then decr(out_ptr);
+ end;
+until c="@@";
+if loc<=limit then
+ begin c:=control_code(buffer[loc]); incr(loc);
+ goto done;
+ end
+
+@ The |copy_comment| uses and returns a brace-balance value, following the
+conventions of |skip_comment| above. Instead of copying the \TeX\ material
+into the output buffer, this procedure copies it into the token memory.
+The abbreviation |app_tok(t)| is used to append token |t| to the current
+token list, and it also makes sure that it is possible to append at least
+one further token without overflow.
+
+@d app_tok(#)==begin if tok_ptr+2>max_toks then overflow('token');
+ tok_mem[tok_ptr]:=#; incr(tok_ptr);
+ end
+
+@p function copy_comment(@!bal:eight_bits):eight_bits; {copies \TeX\ code in
+ comments}
+label done;
+var c:ASCII_code; {current character being copied}
+begin loop begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin err_print('! Input ended in mid-comment');
+@.Input ended in mid-comment@>
+ loc:=1; @<Clear |bal| and |goto done|@>;
+ end;
+ end;
+ c:=buffer[loc]; incr(loc);
+ if c="|" then goto done;
+ app_tok(c);
+ @<Copy special things when |c="@@", "\", "{", "}"|;
+ |goto done| at end@>;
+ end;
+done: copy_comment:=bal;
+end;
+
+@ @<Copy special things when |c="@@"...@>=
+if c="@@" then
+ begin incr(loc);
+ if buffer[loc-1]<>"@@" then
+ begin err_print('! Illegal use of @@ in comment');
+@.Illegal use of \AT!...@>
+ loc:=loc-2; decr(tok_ptr); @<Clear |bal|...@>;
+ end;
+ end
+else if (c="\")and(buffer[loc]<>"@@") then
+ begin app_tok(buffer[loc]); incr(loc);
+ end
+else if c="{" then incr(bal)
+else if c="}" then
+ begin decr(bal);
+ if bal=0 then goto done;
+ end
+
+@ When the comment has terminated abruptly due to an error, we output
+enough right braces to keep \TeX\ happy.
+
+@<Clear |bal|...@>=
+app_tok(" "); {this is done in case the previous character was `\.\\'}
+repeat app_tok("}"); decr(bal);
+until bal=0;
+goto done;
+
+@* Parsing.
+The most intricate part of \.{WEAVE} is its mechanism for converting
+\PASCAL-like code into \TeX\ code, and we might as well plunge into this
+aspect of the program now. A ``bottom up'' approach is used to parse the
+\PASCAL-like material, since \.{WEAVE} must deal with fragmentary
+constructions whose overall ``part of speech'' is not known.
+
+At the lowest level, the input is represented as a sequence of entities
+that we shall call {\it scraps}, where each scrap of information consists
+of two parts, its {\it category} and its {\it translation}. The category
+is essentially a syntactic class, and the translation is a token list that
+represents \TeX\ code. Rules of syntax and semantics tell us how to
+combine adjacent scraps into larger ones, and if we are lucky an entire
+\PASCAL\ text that starts out as hundreds of small scraps will join
+together into one gigantic scrap whose translation is the desired \TeX\
+code. If we are unlucky, we will be left with several scraps that don't
+combine; their translations will simply be output, one by one.
+
+The combination rules are given as context-sensitive productions that are
+applied from left to right. Suppose that we are currently working on the
+sequence of scraps $s_1\,s_2\ldots s_n$. We try first to find the longest
+production that applies to an initial substring $s_1\,s_2\ldots\,$; but if
+no such productions exist, we find to find the longest production
+applicable to the next substring $s_2\,s_3\ldots\,$; and if that fails, we
+try to match $s_3\,s_4\ldots\,$, etc.
+
+A production applies if the category codes have a given pattern. For
+example, one of the productions is
+$$|open|\;|math|\;|semi|\;\RA\;|open|\;|math|$$
+and it means that three consecutive scraps whose respective categories are
+|open|, |math|, and |semi| are con\-verted to two scraps whose categories
+are |open| and |math|. This production also has an associated rule that
+tells how to combine the translation parts:
+$$\eqalign{O_2&=O_1\cr
+M_2&=M_1\,S\,\.{\\,}\,\hbox{|opt|\thinspace\tt5}\cr}$$
+This means that the |open| scrap has not changed, while the new |math| scrap
+has a translation $M_2$ composed of the translation $M_1$ of the original
+|math| scrap followed by the translation |S| of the |semi| scrap followed
+by `\.{\\,}' followed by `|opt|' followed by `\.5'. (In the \TeX\ file,
+this will specify an additional thin space after the semicolon, followed
+by an optional line break with penalty 50.) Translation rules use subscripts
+to distinguish between translations of scraps whose categories have the
+same initial letter; these subscripts are assigned from left to right.
+
+$\.{WEAVE}$ also has the production rule
+$$|semi|\;\RA\;|terminator|$$
+(meaning that a semicolon can terminate a \PASCAL\ statement). Since
+productions are applied from left to right, this rule will be activated
+only if the |semi| is not preceded by scraps that match other productions;
+in particular, a |semi| that is preceded by `|open| |math|' will have
+disappeared because of the production above, and such semicolons do not
+act as statement terminators. This incidentally is how \.{WEAVE} is able
+to treat semicolons in two distinctly different ways, the first of which
+is intended for semicolons in the parameter list of a procedure
+declaration.
+
+The translation rule corresponding to $|semi|\;\RA\;|terminator|$ is
+$$T=S$$
+but we shall not mention translation rules in the common case that the
+translation of the new scrap on the right-hand side is simply the
+concatenation of the disappearing scraps on the left-hand side.
+
+@ Here is a list of the category codes that scraps can have.
+
+@d simp=1 {the translation can be used both in horizontal mode
+ and in math mode of \TeX}
+@d math=2 {the translation should be used only in \TeX\ math mode}
+@d intro=3 {a statement is expected to follow this, after a space and
+ an optional break}
+@d open=4 {denotes an incomplete parenthesized quantity to be used in
+ math mode}
+@d beginning=5 {denotes an incomplete compound statement to be used in
+ horizontal mode}
+@d close=6 {ends a parenthesis or compound statement}
+@d alpha=7 {denotes the beginning of a clause}
+@d omega=8 {denotes the ending of a clause and possible comment following}
+@d semi=9 {denotes a semicolon and possible comment following it}
+@d terminator=10 {something that ends a statement or declaration}
+@d stmt=11 {denotes a statement or declaration including its terminator}
+@d cond=12 {precedes an \&{if} clause that might have a matching \&{else}}
+@d clause=13 {precedes a statement after which indentation ends}
+@d colon=14 {denotes a colon}
+@d exp=15 {stands for the E in a floating point constant}
+@d proc=16 {denotes a procedure or program or function heading}
+@d case_head=17 {denotes a case statement or record heading}
+@d record_head=18 {denotes a record heading without indentation}
+@d var_head=19 {denotes a variable declaration heading}
+@d elsie=20 {\&{else}}
+@d casey=21 {\&{case}}
+@d mod_scrap=22 {denotes a module name}
+
+@p @!debug procedure print_cat(@!c:eight_bits);
+ {symbolic printout of a category}
+begin case c of
+simp: print('simp');
+math: print('math');
+intro: print('intro');
+open: print('open');
+beginning: print('beginning');
+close: print('close');
+alpha: print('alpha');
+omega: print('omega');
+semi: print('semi');
+terminator: print('terminator');
+stmt: print('stmt');
+cond: print('cond');
+clause: print('clause');
+colon: print('colon');
+exp: print('exp');
+proc: print('proc');
+case_head: print('casehead');
+record_head: print('recordhead');
+var_head: print('varhead');
+elsie: print('elsie');
+casey: print('casey');
+mod_scrap: print('module');
+othercases print('UNKNOWN')
+endcases;
+end;
+gubed
+
+@ The token lists for translated \TeX\ output contain some special control
+symbols as well as ordinary characters. These control symbols are
+interpreted by \.{WEAVE} before they are written to the output file.
+
+\yskip\hang |break_space| denotes an optional line break or an en space;
+
+\yskip\hang |force| denotes a line break;
+
+\yskip\hang |big_force| denotes a line break with additional vertical space;
+
+\yskip\hang |opt| denotes an optional line break (with the continuation
+line indented two ems with respect to the normal starting position)---this
+code is followed by an integer |n|, and the break will occur with penalty
+$10n$;
+
+\yskip\hang |backup| denotes a backspace of one em;
+
+\yskip\hang |cancel| obliterates any |break_space| or |force| or |big_force|
+tokens that immediately precede or follow it and also cancels any
+|backup| tokens that follow it;
+
+\yskip\hang |indent| causes future lines to be indented one more em;
+
+\yskip\hang |outdent| causes future lines to be indented one less em.
+
+\yskip\noindent All of these tokens are removed from the \TeX\ output that
+comes from \PASCAL\ text between \pb\ signs; |break_space| and |force| and
+|big_force| become single spaces in this mode. The translation of other
+\PASCAL\ texts results in \TeX\ control sequences \.{\\1}, \.{\\2},
+\.{\\3}, \.{\\4}, \.{\\5}, \.{\\6}, \.{\\7} corresponding respectively to
+|indent|, |outdent|, |opt|, |backup|, |break_space|, |force|, and
+|big_force|. However, a sequence of consecutive `\.\ ', |break_space|,
+|force|, and/or |big_force| tokens is first replaced by a single token
+(the maximum of the given ones).
+
+The tokens |math_rel|, |math_bin|, |math_op| will be translated into
+\.{\\mathrel\{}, \.{\\mathbin\{}, and \.{\\mathop\{}, respectively.
+Other control sequences in the \TeX\ output will be `\.{\\\\\{}$\,\ldots\,$\.\}'
+surrounding identifiers, `\.{\\\&\{}$\,\ldots\,$\.\}' surrounding
+reserved words, `\.{\\.\{}$\,\ldots\,$\.\}' surrounding strings,
+`\.{\\C\{}$\,\ldots\,$\.\}$\,$|force|' surrounding comments, and
+`\.{\\X$n$:}$\,\ldots\,$\.{\\X}' surrounding module names, where
+|n| is the module number.
+
+@d math_bin=@'203
+@d math_rel=@'204
+@d math_op=@'205
+@d big_cancel=@'206 {like |cancel|, also overrides spaces}
+@d cancel=@'207 {overrides |backup|, |break_space|, |force|, |big_force|}
+@d indent=cancel+1 {one more tab (\.{\\1})}
+@d outdent=cancel+2 {one less tab (\.{\\2})}
+@d opt=cancel+3 {optional break in mid-statement (\.{\\3})}
+@d backup=cancel+4 {stick out one unit to the left (\.{\\4})}
+@d break_space=cancel+5 {optional break between statements (\.{\\5})}
+@d force=cancel+6 {forced break between statements (\.{\\6})}
+@d big_force=cancel+7 {forced break with additional space (\.{\\7})}
+@d end_translation=big_force+1 {special sentinel token at end of list}
+
+@ The raw input is converted into scraps according to the following table,
+which gives category codes followed by the translations. Sometimes a single
+item of input produces more than one scrap.
+\def\stars {\.{**}}%
+(The symbol `\stars' stands for `\.{\\\&\{{\rm identifier}\}}',
+i.e., the identifier itself treated as a reserved word. In a few cases the
+category is given as `|@!comment|'; this is not an actual category code, it
+means that the translation will be treated as a comment, as explained
+below.)
+
+\yskip\halign{\quad#\hfil&\quad#\hfil\cr
+\.{<>}&|math:|\.{\\I}\cr
+\.{<=}&|math:|\.{\\L}\cr
+\.{>=}&|math:|\.{\\G}\cr
+\.{:=}&|math:|\.{\\K}\cr
+\.{==}&|math:|\.{\\S}\cr
+\.{(*}&|math:|\.{\\B}\cr
+\.{*)}&|math:|\.{\\T}\cr
+\.{(.}&|open:|\.[\cr
+\.{.)}&|close:|\.]\cr
+\."$\,$string$\,$\."&|simp:|\.{\\.\{"{\rm$\,$modified string$\,$}"\}}\cr
+\.\'$\,$string$\,$\.\'&|simp:|\.{\\.\{\\\'{\rm$\,$modified
+ string$\,$}\\\'\}}\cr
+\.{@@=}$\,$string$\,$\.{@@>}&|simp:|\.{\\=\{{\rm$\,$modified string$\,$}\}}\cr
+\#&|math:|\.{\\\#}\cr
+\.\$&|math:|\.{\\\$}\cr
+\.\_&|math:|\.{\\\_}\cr
+\.\%&|math:|\.{\\\%}\cr
+\.\^&|math:|\.{\\\^}\cr
+\.(&|open:|\.(\cr
+\.)&|close:|\.)\cr
+\.[&|open:|\.[\cr
+\.]&|close:|\.]\cr
+\.*&|math:|\.{\\ast}\cr
+\.,&|math:|\.,|@,opt@,|\.9\cr
+\.{..}&|math:|\.{\\to}\cr
+\..&|simp:|\..\cr
+\.:&|colon:|\.:\cr
+\.;&|semi:|\.;\cr
+identifier&|simp:|\.{\\\\\{{\rm$\,$identifier$\,$}\}}\cr
+\.E in constant&|exp:|\.{\\E\{}\cr
+digit $d$&|simp:|$d$\cr
+other character $c$&|math:|$c$\cr
+\.{and}&|math:|\.{\\W}\cr
+\.{array}&|alpha:|\stars\cr
+\.{begin}&|beginning:|$|force|\,\stars\,|cancel|$\qquad|intro:|\cr
+\.{case}&|casey:|\qquad|alpha:|$|force|\,\stars$\cr
+\.{const}&|intro:|$|force|\,|backup|\,\stars$\cr
+\.{div}&|math:|$|math_bin|\,\stars\,\.\}$\cr
+\.{do}&|omega:|\stars\cr
+\.{downto}&|math:|$|math_rel|\,\stars\,\.\}$\cr
+\.{else}&|terminator:|\qquad|elsie:|$|force|\,|backup|\,\stars$\cr
+\.{end}&|terminator:|\qquad|close:|$|force|\,\stars$\cr
+\.{file}&|alpha:|\stars\cr
+\.{for}&|alpha:|$|force|\,\stars$\cr
+\.{function}&|proc:|$|force|\,|backup|\,\stars\,|cancel|$\qquad
+ |intro:|$|indent|\,\.{\\\ }$\cr
+\.{goto}&|intro:|\stars\cr
+\.{if}&|cond:|\qquad|alpha:|$|force|\,\stars$\cr
+\.{in}&|math:|\.{\\in}\cr
+\.{label}&|intro:|$|force|\,|backup|\,\stars$\cr
+\.{mod}&|math:|$|math_bin|\,\stars\,\.\}$\cr
+\.{nil}&|simp:|\stars\cr
+\.{not}&|math:|\.{\\R}\cr
+\.{of}&|omega:|\stars\cr
+\.{or}&|math:|\.{\\V}\cr
+\.{packed}&|intro:|\stars\cr
+\.{procedure}&|proc:|$|force|\,|backup|\,\stars\,|cancel|$\qquad
+ |intro:|$|indent|\,\.{\\\ }$\cr
+\.{program}&|proc:|$|force|\,|backup|\,\stars\,|cancel|$\qquad
+ |intro:|$|indent|\,\.{\\\ }$\cr
+\.{record}&|record_head:|\stars\qquad|intro:|\cr
+\.{repeat}&|beginning:|$|force|\,|indent|\,\stars\,|cancel|$\qquad|intro:|\cr
+\.{set}&|alpha:|\stars\cr
+\.{then}&|omega:|\stars\cr
+\.{to}&|math:|$|math_rel|\,\stars\,\.\}$\cr
+\.{type}&|intro:|$|force|\,|backup|\,\stars$\cr
+\.{until}&|terminator:|\qquad|close:|$|force|\,|backup|\,\stars$\qquad
+ |clause:|\cr
+\.{var}&|var_head:|$|force|\,|backup|\,\stars\,|cancel|$\qquad|intro:|\cr
+\.{while}&|alpha:|$|force|\,\stars$\cr
+\.{with}&|alpha:|$|force|\,\stars$\cr
+\.{xclause}&|alpha:|$|force|\,\.{\\\~}$\qquad|omega:|\stars\cr
+\.{@@\'}$\,$const&|simp:|\.{\\O\{}\hbox{const}\.\}\cr
+\.{@@"}$\,$const&|simp:|\.{\\H\{}\hbox{const}\.\}\cr
+\.{@@\$}&|simp:|\.{\\)}\cr
+\.{@@\\}&|simp:|\.{\\]}\cr
+\.{@@,}&|math:|\.{\\,}\cr
+\.{@@t}$\,$stuff$\,$\.{@@>}&|simp:|\.{\\hbox\{{\rm$\,$stuff$\,$}\}}\cr
+\.{@@<}$\,$module$\,$\.{@@>}&|mod_scrap:|\.{\\X$n$:{\rm$\,$module$\,$}\\X}\cr
+\.{@@\#}&|comment:||big_force|\cr
+\.{@@/}&|comment:||force|\cr
+\.{@@\char'174}&|simp:|$|opt|\,\.0$\cr
+\.{@@+}&|comment:|$|big_cancel|\,\.{\\\ }\,|big_cancel|$\cr
+\.{@@;}&|semi:|\cr
+\.{@@\&}&|math:|\.{\\J}\cr
+\.{@@\{}&|math:|\.{\\B}\cr
+\.{@@\}}&|math:|\.{\\T}\cr}
+\yskip\noindent When a string is output, certain characters are preceded by
+`\.\\' signs so that they will print properly.
+
+A comment in the input will be combined with the preceding
+|omega| or |semi| scrap, or with the following |terminator| scrap, if
+possible; otherwise it will be inserted as a separate |terminator| scrap.
+An additional ``comment'' is effectively appended at the end of the
+\PASCAL\ text, just before translation begins; this consists of a |cancel|
+token in the case of \PASCAL\ text in \pb, otherwise it consists of a
+|force| token.
+
+From this table it is evident that \.{WEAVE} will parse a lot of non-\PASCAL\
+programs. For example, the reserved words `\.{for}' and `\.{array}' are
+treated in an identical way by \.{WEAVE} from a syntactic standpoint,
+and semantically they are equivalent except that a forced line break occurs
+just before `\&{for}'; \PASCAL\ programmers may well be surprised at this
+similarity. The idea is to keep \.{WEAVE}'s rules as simple as possible,
+consistent with doing a reasonable job on syntactically correct \PASCAL\
+programs. The production rules below have been formulated in the same
+spirit of ``almost anything goes.''
+
+@ Here is a table of all the productions. The reader can best get a feel for
+@^productions, table of@>
+how they work by trying them out by hand on small examples; no amount of
+explanation will be as effective as watching the rules in action.
+Parsing can also be watched by debugging with `\.{@@2}'.
+
+\def\[#1]{\quad$\dleft#1\dright$}
+\def\sp{\.{\ }}
+\yskip
+\halign to\the\hsize{\hfil\it# &
+ #\hfil\hskip-200pt\tabskip 0pt plus 100pt&
+ #\hfil\tabskip0pt\cr
+&Production categories\[\hbox{translations}]&Remarks\cr
+\noalign{\yskip}
+1&|alpha@,math@,colon| $\RA$ |alpha@,math|&e.g., |case v:boolean of|\cr
+2&|alpha@,math@,omega| $\RA$ |clause|\[C=A\,\sp\,\.\$\,M\,\.\$\,\sp\,|indent|\,
+O]&e.g., |while x>0 do|\cr
+3&|alpha@,omega| $\RA$ |clause|\[C=A\,\sp\,|indent|\,O]&e.g., |file of|\cr
+4&|alpha@,simp| $\RA$ |alpha@,math|&convert to math mode\cr
+5&|beginning@,close@,(terminator@t or @>stmt)| $\RA$ |stmt|&compound statement
+ends\cr
+6&|beginning@,stmt| $\RA$ |beginning|\[B_2=B_1\,|break_space|\,S]&compound
+statement grows\cr
+7&|case_head@,casey@,clause| $\RA$ |case_head|\[C_4=C_1\,|outdent|\,C_2\,C_3]&
+variant records\cr
+8&|case_head@,close@,terminator| $\RA$ |stmt|\[S=C_1\,|cancel|\,|outdent|\,
+C_2\,T]&end of case statement\cr
+9&|case_head@,stmt| $\RA$ |case_head|\[C_2=C_1\,|force|\,S]&case statement
+grows\cr
+10&|casey@,clause| $\RA$ |case_head|&beginning of case statement\cr
+11&|clause@,stmt| $\RA$ |stmt|\[S_2=C\,|break_space|\,S_1\,|cancel|\,|outdent|\,
+|force|]&end of controlled statement\cr
+12&|cond@,clause@,stmt@,elsie| $\RA$ |clause|\[C_3=C_1\,C_2\,|break_space|\,S\,
+E\,\sp\,|cancel|]&complete conditional\cr
+13&|cond@,clause@,stmt| $\RA$ |stmt|\cr
+&\qquad\[S_2=C_1\,C_2\,|break_space|\,S_1\,
+|cancel|\,|outdent|\,|force|]&incomplete conditional\cr
+14&|elsie| $\RA$ |intro|&unmatched else\cr
+15&|exp@,math@,simp|* $\RA$ |math|\[M_2=E\,M_1\,S\,\.\}]&signed exponent\cr
+16&|exp@,simp|* $\RA$ |math|\[M=E\,S\,\.\}]&unsigned exponent\cr
+17&|intro@,stmt| $\RA$ |stmt|\[S_2=I\,\sp\,|opt|\,\.7\,|cancel|\,S_1]&labeled
+statement, etc.\cr
+18&|math@,close| $\RA$ |stmt@,close|\[S=\.\$\,M\,\.\$]&end of field list\cr
+19&|math@,colon| $\RA$ |intro|\[I=|force|\,|backup|\,\.\$\,M\,\.\$\,C]&compound
+label\cr
+20&|math@,math| $\RA$ |math|&simple concatenation\cr
+21&|math@,simp| $\RA$ |math|&simple concatenation\cr
+22&|math@,stmt| $\RA$ |stmt|\cr
+&\qquad\[S_2=\.\$\,M\,\.\$\,|indent|\,|break_space|\,
+S_1\,|cancel|\,|outdent|\,|force|]&macro or type definition\cr
+23&|math@,terminator| $\RA$ |stmt|\[S=\.\$\,M\,\.\$\,T]&statement involving
+math\cr
+24&|mod_scrap@,(terminator@t or @>semi)| $\RA$ |stmt|\[S=M\,T\,|force|]&module
+like a statement\cr
+25&|mod_scrap| $\RA$ |simp|&module unlike a statement\cr
+26&|open@,case_head@,close| $\RA$ |math|\[M=O\,\.\$\,|cancel|\,C_1\,
+|cancel|\,|outdent|\,\.\$\,C_2]&case in field list\cr
+27&|open@,close| $\RA$ |math|\[M=O\,\.\\\,\.,\,C]&empty set |[]|\cr
+28&|open@,math@,case_head@,close| $\RA$ |math|\cr
+&\qquad\[M_2=O\,M_1\,\.\$\,|cancel|\,
+C_1\,|cancel|\,|outdent|\,\.\$\,C_2]&case in field list\cr
+29&|open@,math@,close| $\RA$ |math|&parenthesized group\cr
+30&|open@,math@,colon| $\RA$ |open@,math|&colon in parentheses\cr
+31&|open@,math@,proc@,intro| $\RA$ |open@,math|\[M_2=M_1\,|math_op|\,|cancel|\,
+P\,\.\}]&|procedure| in parentheses\cr
+32&|open@,math@,semi| $\RA$ |open@,math|\[M_2=M_1\,S\,\.\\\,\.,\,|opt|\,
+\.5]&semicolon in parentheses\cr
+33&|open@,math@,var_head@,intro| $\RA$ |open@,math|\[M_2=M_1\,|math_op|\,
+|cancel|\,V\,\.\}]&|var| in parentheses\cr
+34&|open@,proc@,intro| $\RA$ |open@,math|\[M=|math_op|\,|cancel|\,
+P\,\.\}]&|procedure| in parentheses\cr
+35&|open@,simp| $\RA$ |open@,math|&convert to math mode\cr
+36&|open@,stmt@,close| $\RA$ |math|\[M=O\,\.\$\,|cancel|\,S\,|cancel|\,
+\.\$\,C]&field list\cr
+37&|open@,var_head@,intro| $\RA$ |open@,math|\[M=|math_op|\,|cancel|\,V\,
+\.\}]&|var| in parentheses\cr
+38&|proc@,beginning@,close@,terminator| $\RA$ |stmt|\[S=P\,|cancel|\,
+|outdent|\,B\,C\,T]&end of procedure declaration\cr
+39&|proc@,stmt| $\RA$ |proc|\[P_2=P_1\,|break_space|\,S]&procedure declaration
+grows\cr
+40&|record_head@,intro@,casey| $\RA$ |casey|\[C_2=R\,I\,\sp\,|cancel|\,C_1]&
+\&{record case} $\ldots$\cr
+41&|record_head| $\RA$ |case_head|\[C=|indent|\,R\,|cancel|]&other \&{record}
+structures\cr
+42&|semi| $\RA$ |terminator|&semicolon after statement\cr
+43&|simp@,close| $\RA$ |stmt@,close|&end of field list\cr
+44&|simp@,colon| $\RA$ |intro|\[I=|force|\,|backup|\,S\,C]&simple label\cr
+45&|simp@,math| $\RA$ |math|&simple concatenation\cr
+46&|simp@,mod_scrap| $\RA$ |mod_scrap|&in emergencies\cr
+47&|simp@,simp| $\RA$ |simp|&simple concatenation\cr
+48&|simp@,terminator| $\RA$ |stmt|&simple statement\cr
+49&|stmt@,stmt| $\RA$ |stmt|\[S_3=S_1\,|break_space|\,S_2]&adjacent
+statements\cr
+50&|terminator| $\RA$ |stmt|&empty statement\cr
+51&|var_head@,beginning| $\RA$ |stmt@,beginning|&end of variable
+declarations\cr
+52&|var_head@,math@,colon| $\RA$ |var_head@,intro|\[I=\.\$\,M\,\.\$\,C]&
+variable declaration\cr
+53&|var_head@,simp@,colon| $\RA$ |var_head@,intro|&variable declaration\cr
+54&|var_head@,stmt| $\RA$ |var_head|\[V_2=V_1\,|break_space|\,S]&variable
+declarations grow\cr}
+\yskip\noindent
+Translations are not specified here when they are simple concatenations
+of the scraps that change. For example, the full translation of
+`|open@,math@,colon| $\RA$ |open@,math|' is $O_2=O_1$, $M_2=M_1C$.
+
+The notation `|simp|*', in the |exp|-related productions above,
+stands for a |simp| scrap that isn't followed by another |simp|.
+
+@* Implementing the productions.
+When \PASCAL\ text is to be processed with the grammar above, we put its
+initial scraps $s_1\ldots s_n$ into two arrays |cat[1..n]| and |trans[1..n]|.
+The value of |cat[k]| is simply a category code from the list above; the
+value of |trans[k]| is a text pointer, i.e., an index into |tok_start|.
+Our production rules have the nice property that the right-hand side is never
+longer than the left-hand side. Therefore it is convenient to use sequential
+allocation for the current sequence of scraps. Five pointers are used to
+manage the parsing:
+
+\yskip\hang |pp| (the parsing pointer) is such that we are trying to match
+the category codes |cat[pp]@,cat[pp+1]|$\,\ldots\,$ to the left-hand sides
+of productions.
+
+\yskip\hang |scrap_base|, |lo_ptr|, |hi_ptr|, and |scrap_ptr| are such that
+the current sequence of scraps appears in positions |scrap_base| through
+|lo_ptr| and |hi_ptr| through |scrap_ptr|, inclusive, in the |cat| and
+|trans| arrays. Scraps located between |scrap_base| and |lo_ptr| have
+been examined, while those in positions |>=hi_ptr| have not yet been
+looked at by the parsing process.
+
+\yskip\noindent Initially |scrap_ptr| is set to the position of the final
+scrap to be parsed, and it doesn't change its value. The parsing process
+makes sure that |lo_ptr>=pp+3|, since productions have as many as four terms,
+by moving scraps from |hi_ptr| to |lo_ptr|. If there are
+fewer than |pp+3| scraps left, the positions up to |pp+3| are filled with
+blanks that will not match in any productions. Parsing stops when
+|pp=lo_ptr+1| and |hi_ptr=scrap_ptr+1|.
+
+The |trans| array elements are declared to be of type |0..10239| instead
+of type |text_pointer|, because the final sorting phase of \.{WEAVE}
+uses this array to contain elements of type |name_pointer|. Both
+of these types are subranges of |0..10239|.
+
+@<Glo...@>=
+@!cat:array[0..max_scraps] of eight_bits; {category codes of scraps}
+@!trans:array[0..max_scraps] of 0..10239; {translation texts of scraps}
+@!pp:0..max_scraps; {current position for reducing productions}
+@!scrap_base:0..max_scraps; {beginning of the current scrap sequence}
+@!scrap_ptr:0..max_scraps; {ending of the current scrap sequence}
+@!lo_ptr:0..max_scraps; {last scrap that has been examined}
+@!hi_ptr:0..max_scraps; {first scrap that has not been examined}
+stat@!max_scr_ptr:0..max_scraps; {largest value assumed by |scrap_ptr|}
+tats
+
+@ @<Set init...@>=
+scrap_base:=1; scrap_ptr:=0;
+stat max_scr_ptr:=0; @+tats
+
+@ Token lists in |@!tok_mem| are composed of the following kinds of
+items for \TeX\ output.
+
+\yskip\item{$\bullet$}ASCII codes and special codes like |force| and
+|math_rel| represent themselves;
+
+\item{$\bullet$}|id_flag+p| represents \.{\\\\\{{\rm identifier $p$}\}};
+
+\item{$\bullet$}|res_flag+p| represents \.{\\\&\{{\rm identifier $p$}\}};
+
+\item{$\bullet$}|mod_flag+p| represents module name |p|;
+
+\item{$\bullet$}|tok_flag+p| represents token list number |p|;
+
+\item{$\bullet$}|inner_tok_flag+p| represents token list number |p|, to be
+translated without line-break controls.
+
+@d id_flag=10240 {signifies an identifier}
+@d res_flag=id_flag+id_flag {signifies a reserved word}
+@d mod_flag=res_flag+id_flag {signifies a module name}
+@d tok_flag==mod_flag+id_flag {signifies a token list}
+@d inner_tok_flag==tok_flag+id_flag {signifies a token list in `\pb'}
+@#
+@d lbrace==xchr["{"] {this avoids possible \PASCAL\ compiler confusion}
+@d rbrace==xchr["}"] {because these braces might occur within comments}
+
+@p @!debug procedure print_text(@!p:text_pointer); {prints a token list}
+var j:0..max_toks; {index into |tok_mem|}
+@!r:0..id_flag-1; {remainder of token after the flag has been stripped off}
+begin if p>=text_ptr then print('BAD')
+else for j:=tok_start[p] to tok_start[p+1]-1 do
+ begin r:=tok_mem[j] mod id_flag;
+ case tok_mem[j] div id_flag of
+ 1: begin print('\\',lbrace); print_id(r); print(rbrace);
+ end; {|id_flag|}
+ 2: begin print('\&',lbrace); print_id(r); print(rbrace);
+ end; {|res_flag|}
+ 3: begin print('<'); print_id(r); print('>');
+ end; {|mod_flag|}
+ 4: print('[[',r:1,']]'); {|tok_flag|}
+ 5: print('|[[',r:1,']]|'); {|inner_tok_flag|}
+ othercases @<Print token |r| in symbolic form@>
+ endcases;
+ end;
+end;
+gubed
+
+@ @<Print token |r|...@>=
+case r of
+math_bin: print('\mathbin',lbrace);
+math_rel: print('\mathrel',lbrace);
+math_op: print('\mathop',lbrace);
+big_cancel: print('[ccancel]');
+cancel: print('[cancel]');
+indent: print('[indent]');
+outdent: print('[outdent]');
+backup: print('[backup]');
+opt: print('[opt]');
+break_space: print('[break]');
+force: print('[force]');
+big_force: print('[fforce]');
+end_translation: print('[quit]');
+othercases print(xchr[r])
+endcases
+
+@ The production rules listed above are embedded directly into the \.{WEAVE}
+program, since it is easier to do this than to write an interpretive system
+that would handle production systems in general. Several macros are defined
+here so that the program for each production is fairly short.
+
+All of our productions conform to the general notion that some |k|
+consecutive scraps starting at some position |j| are to be replaced by a
+single scrap of some category |c| whose translation is composed from the
+translations of the disappearing scraps. After this production has been
+applied, the production pointer |pp| should change by an amount |d|. Such
+a production can be represented by the quadruple $(j,k,c,d)$. For example,
+the production `|simp@,math| $\RA$ |math|' would be represented by
+`$(|pp|,2,|math|,-1)$'; in this case the pointer $pp$ should decrease by 1
+after the production has been applied, because some productions with
+|math| in their second positions might now match, but no productions have
+|math| in the third or fourth position of their left-hand sides. Note that
+the value of |d| is determined by the whole collection of productions, not
+by an individual one. Consider the further example
+`|var_head@,math@,colon| $\RA$ |var_head@,intro|', which is represented by
+`$(|pp|+1,2,|intro|,+1)$'; the $+1$ here is deduced by looking at the
+grammar and seeing that no matches could possibly occur at positions |<=pp|
+after this production has been applied. The determination of |d| has been
+done by hand in each case, based on the full set of productions but not on
+the grammar of \PASCAL\ or on the rules for constructing the initial
+scraps.
+
+We also attach a serial number to each production, so that additional
+information is available when debugging. For example, the program below
+contains the statement `|reduce(pp+1,2,intro,+1)(52)|' when it implements
+the production just mentioned.
+
+Before calling |reduce|, the program should have appended the tokens of
+the new translation to the |tok_mem| array. We commonly want to append
+copies of several existing translations, and macros are defined to
+simplify these common cases. For example, |app2(pp)| will append the
+translations of two consecutive scraps, |trans[pp]| and |trans[pp+1]|, to
+the current token list. If the entire new translation is formed in this
+way, we write `$|squash|(j,k,c,d)$' instead of `$|reduce|(j,k,c,d)$'. For
+example, `|squash(pp,2,math,-1)|' is an abbreviation for `|app2(pp);
+reduce(pp,2,math,-1)|'.
+
+The code below is an exact translation of the production rules into
+\PASCAL, using such macros, and the reader should have no difficulty
+understanding the format by comparing the code with the symbolic
+productions as they were listed earlier.
+
+{\sl Caution:\/} The macros |app|, |app1|, |app2|, and |app3| are
+sequences of statements that are not enclosed with |begin| and $|end|$,
+because such delimiters would make the \PASCAL\ program much longer. This
+means that it is necessary to write |begin| and |end| explicitly when such
+a macro is used as a single statement. Several mysterious bugs in the
+original programming of \.{WEAVE} were caused by a failure to remember
+this fact. Next time the author will know better.
+
+@d production(#)==@!debug prod(#) gubed; goto found
+@d reduce(#)==red(#); production
+@d production_end(#)==@!debug prod(#) gubed; goto found;
+ end
+@d squash(#)==begin sq(#); production_end
+@d app(#)==tok_mem[tok_ptr]:=#; incr(tok_ptr) {this is like |app_tok|,
+ but it doesn't test for overflow}
+@d app1(#)==tok_mem[tok_ptr]:=tok_flag+trans[#]; incr(tok_ptr)
+@d app2(#)==app1(#);app1(#+1)
+@d app3(#)==app2(#);app1(#+2)
+
+@ Let us consider the big case statement for productions now, before looking
+at its context. We want to design the program so that this case statement
+works, so we might as well not keep ourselves in suspense about exactly what
+code needs to be provided with a proper environment.
+
+The code here is more complicated than it need be, since some popular
+\PASCAL\ compilers are unable to deal with procedures that contain a lot
+of program text. The |translate| procedure, which incorporates the |case|
+statement here, would become too long for those compilers if we did
+not do something to split the cases into parts. Therefore
+a separate procedure called |five_cases| has been introduced.
+@^split procedures@>
+This auxiliary procedure contains approximately half of the program text
+that |translate| would otherwise have had. There's also a procedure
+called |alpha_cases|, which turned out to be necessary because the best
+two-way split wasn't good enough. The procedure could be split further
+in an analogous manner, but the present scheme works on all compilers
+known to the author.
+
+@<Match a production at |pp|, or increase |pp| if there is no match@>=
+if cat[pp]<=alpha then
+ if cat[pp]<alpha then five_cases@+else alpha_cases
+else begin case cat[pp] of
+ case_head: @<Cases for |case_head|@>;
+ casey: @<Cases for |casey|@>;
+ clause: @<Cases for |clause|@>;
+ cond: @<Cases for |cond|@>;
+ elsie: @<Cases for |elsie|@>;
+ exp: @<Cases for |exp|@>;
+ mod_scrap: @<Cases for |mod_scrap|@>;
+ proc: @<Cases for |proc|@>;
+ record_head: @<Cases for |record_head|@>;
+ semi: @<Cases for |semi|@>;
+ stmt: @<Cases for |stmt|@>;
+ terminator: @<Cases for |terminator|@>;
+ var_head: @<Cases for |var_head|@>;
+ othercases do_nothing
+ endcases;@/
+ incr(pp); {if no match was found, we move to the right}
+ found: end
+
+@ Here are the procedures that need to be present for the reason just
+explained.
+
+@<Declaration of subprocedures for |translate|@>=
+procedure five_cases; {handles almost half of the syntax}
+label found;
+begin case cat[pp] of
+beginning: @<Cases for |beginning|@>;
+intro: @<Cases for |intro|@>;
+math: @<Cases for |math|@>;
+open: @<Cases for |open|@>;
+simp: @<Cases for |simp|@>;
+othercases do_nothing
+endcases;@/
+incr(pp); {if no match was found, we move to the right}
+found: end;
+@#
+procedure alpha_cases;
+label found;
+begin @<Cases for |alpha|@>;
+incr(pp); {if no match was found, we move to the right}
+found: end;
+
+@ Now comes the code that tries to match each production starting
+with a particular type of scrap. Whenever a match is discovered,
+the |squash| or |reduce| macro will cause the appropriate action
+to be performed, followed by |goto found|.
+
+@<Cases for |alpha|@>=
+if cat[pp+1]=math then
+ begin if cat[pp+2]=colon then squash(pp+1,2,math,0)(1)
+ else if cat[pp+2]=omega then
+ begin app1(pp); app(" "); app("$"); app1(pp+1);
+ app("$"); app(" "); app(indent); app1(pp+2);
+ reduce(pp,3,clause,-2)(2);
+ end;
+ end
+else if cat[pp+1]=omega then
+ begin app1(pp); app(" "); app(indent); app1(pp+1);
+ reduce(pp,2,clause,-2)(3);
+ end
+else if cat[pp+1]=simp then squash(pp+1,1,math,0)(4)
+
+@ @<Cases for |beginning|@>=
+if cat[pp+1]=close then
+ begin if (cat[pp+2]=terminator)or(cat[pp+2]=stmt) then
+ squash(pp,3,stmt,-2)(5);
+ end
+else if cat[pp+1]=stmt then
+ begin app1(pp); app(break_space); app1(pp+1);
+ reduce(pp,2,beginning,-1)(6);
+ end
+
+@ @<Cases for |case_head|@>=
+if cat[pp+1]=casey then
+ begin if cat[pp+2]=clause then
+ begin app1(pp); app(outdent); app2(pp+1);
+ reduce(pp,3,case_head,0)(7);
+ end;
+ end
+else if cat[pp+1]=close then
+ begin if cat[pp+2]=terminator then
+ begin app1(pp); app(cancel); app(outdent); app2(pp+1);
+ reduce(pp,3,stmt,-2)(8);
+ end;
+ end
+else if cat[pp+1]=stmt then
+ begin app1(pp); app(force); app1(pp+1);
+ reduce(pp,2,case_head,0)(9);
+ end
+
+@ @<Cases for |casey|@>=
+if cat[pp+1]=clause then squash(pp,2,case_head,0)(10)
+
+@ @<Cases for |clause|@>=
+if cat[pp+1]=stmt then
+ begin app1(pp); app(break_space); app1(pp+1);
+ app(cancel); app(outdent);
+ app(force); reduce(pp,2,stmt,-2)(11);
+ end
+
+@ @<Cases for |cond|@>=
+if (cat[pp+1]=clause)and(cat[pp+2]=stmt) then
+ if cat[pp+3]=elsie then
+ begin app2(pp); app(break_space); app2(pp+2); app(" ");
+ app(cancel); reduce(pp,4,clause,-2)(12);
+ end
+ else begin app2(pp); app(break_space); app1(pp+2); app(cancel);
+ app(outdent); app(force); reduce(pp,3,stmt,-2)(13);
+ end
+
+@ @<Cases for |elsie|@>=
+squash(pp,1,intro,-3)(14)
+
+@ @<Cases for |exp|@>=
+if cat[pp+1]=math then
+ begin if cat[pp+2]=simp then if cat[pp+3]<>simp then
+ begin app3(pp); app("}"); reduce(pp,3,math,-1)(15);
+ end;
+ end
+else if cat[pp+1]=simp then if cat[pp+2]<>simp then
+ begin app2(pp); app("}"); reduce(pp,2,math,-1)(16);
+ end
+
+@ @<Cases for |intro|@>=
+if cat[pp+1]=stmt then
+ begin app1(pp); app(" "); app(opt); app("7");
+ app(cancel); app1(pp+1); reduce(pp,2,stmt,-2)(17);
+ end
+
+@ @<Cases for |math|@>=
+if cat[pp+1]=close then
+ begin app("$"); app1(pp); app("$"); reduce(pp,1,stmt,-2)(18);
+ end
+else if cat[pp+1]=colon then
+ begin app(force); app(backup); app("$"); app1(pp);
+ app("$"); app1(pp+1); reduce(pp,2,intro,-3)(19);
+ end
+else if cat[pp+1]=math then squash(pp,2,math,-1)(20)
+else if cat[pp+1]=simp then squash(pp,2,math,-1)(21)
+else if cat[pp+1]=stmt then
+ begin app("$"); app1(pp); app("$"); app(indent);
+ app(break_space); app1(pp+1); app(cancel); app(outdent);
+ app(force); reduce(pp,2,stmt,-2)(22);
+ end
+else if cat[pp+1]=terminator then
+ begin app("$"); app1(pp); app("$"); app1(pp+1);
+ reduce(pp,2,stmt,-2)(23);
+ end
+
+@ @<Cases for |mod_scrap|@>=
+if (cat[pp+1]=terminator)or(cat[pp+1]=semi) then
+ begin app2(pp); app(force); reduce(pp,2,stmt,-2)(24);
+ end
+else squash(pp,1,simp,-2)(25)
+
+@ @<Cases for |open|@>=
+if (cat[pp+1]=case_head)and(cat[pp+2]=close) then
+ begin app1(pp); app("$"); app(cancel); app1(pp+1); app(cancel);
+ app(outdent); app("$"); app1(pp+2); reduce(pp,3,math,-1)(26);
+ end
+else if cat[pp+1]=close then
+ begin app1(pp); app("\"); app(","); app1(pp+1);
+@.\\,@>
+ reduce(pp,2,math,-1)(27);
+ end
+else if cat[pp+1]=math then @<Cases for |open@,math|@>
+else if cat[pp+1]=proc then
+ begin if cat[pp+2]=intro then
+ begin app(math_op); app(cancel); app1(pp+1); app("}");
+ reduce(pp+1,2,math,0)(34);
+ end;
+ end
+else if cat[pp+1]=simp then squash(pp+1,1,math,0)(35)
+else if (cat[pp+1]=stmt)and(cat[pp+2]=close) then
+ begin app1(pp); app("$"); app(cancel); app1(pp+1); app(cancel);
+ app("$"); app1(pp+2); reduce(pp,3,math,-1)(36);
+ end
+else if cat[pp+1]=var_head then
+ begin if cat[pp+2]=intro then
+ begin app(math_op); app(cancel); app1(pp+1); app("}");
+ reduce(pp+1,2,math,0)(37);
+ end;
+ end
+
+@ @<Cases for |open@,math|@>=
+begin if (cat[pp+2]=case_head)and(cat[pp+3]=close) then
+ begin app2(pp); app("$"); app(cancel); app1(pp+2); app(cancel);
+ app(outdent); app("$"); app1(pp+3); reduce(pp,4,math,-1)(28);
+ end
+else if cat[pp+2]=close then squash(pp,3,math,-1)(29)
+else if cat[pp+2]=colon then squash(pp+1,2,math,0)(30)
+else if cat[pp+2]=proc then
+ begin if cat[pp+3]=intro then
+ begin app1(pp+1); app(math_op); app(cancel);
+ app1(pp+2); app("}"); reduce(pp+1,3,math,0)(31);
+ end;
+ end
+else if cat[pp+2]=semi then
+ begin app2(pp+1); app("\"); app(","); app(opt); app("5");
+@.\\,@>
+ reduce(pp+1,2,math,0)(32);
+ end
+else if cat[pp+2]=var_head then
+ begin if cat[pp+3]=intro then
+ begin app1(pp+1); app(math_op); app(cancel);
+ app1(pp+2); app("}"); reduce(pp+1,3,math,0)(31);
+ end;
+ end;
+end
+
+@ @<Cases for |proc|@>=
+if cat[pp+1]=beginning then
+ begin if (cat[pp+2]=close)and(cat[pp+3]=terminator) then
+ begin app1(pp); app(cancel); app(outdent); app3(pp+1);
+ reduce(pp,4,stmt,-2)(38);
+ end;
+ end
+else if cat[pp+1]=stmt then
+ begin app1(pp); app(break_space); app1(pp+1);
+ reduce(pp,2,proc,-2)(39);
+ end
+
+@ @<Cases for |record_head|@>=
+if (cat[pp+1]=intro)and(cat[pp+2]=casey) then
+ begin app2(pp); app(" "); app(cancel); app1(pp+2);
+ reduce(pp,3,casey,-2)(40);
+ end
+else begin app(indent); app1(pp); app(cancel);
+ reduce(pp,1,case_head,0)(41);
+ end
+
+@ @<Cases for |semi|@>=
+squash(pp,1,terminator,-3)(42)
+
+@ @<Cases for |simp|@>=
+if cat[pp+1]=close then squash(pp,1,stmt,-2)(43)
+else if cat[pp+1]=colon then
+ begin app(force); app(backup); app2(pp); reduce(pp,2,intro,-3)(44);
+ end
+else if cat[pp+1]=math then squash(pp,2,math,-1)(45)
+else if cat[pp+1]=mod_scrap then squash(pp,2,mod_scrap,0)(46)
+else if cat[pp+1]=simp then squash(pp,2,simp,-2)(47)
+else if cat[pp+1]=terminator then squash(pp,2,stmt,-2)(48)
+
+@ @<Cases for |stmt|@>=
+if cat[pp+1]=stmt then
+ begin app1(pp); app(break_space); app1(pp+1);
+ reduce(pp,2,stmt,-2)(49);
+ end
+
+@ @<Cases for |terminator|@>=
+squash(pp,1,stmt,-2)(50)
+
+@ @<Cases for |var_head|@>=
+if cat[pp+1]=beginning then squash(pp,1,stmt,-2)(51)
+else if cat[pp+1]=math then
+ begin if cat[pp+2]=colon then
+ begin app("$"); app1(pp+1); app("$"); app1(pp+2);
+ reduce(pp+1,2,intro,+1)(52);
+ end;
+ end
+else if cat[pp+1]=simp then
+ begin if cat[pp+2]=colon then squash(pp+1,2,intro,+1)(53);
+ end
+else if cat[pp+1]=stmt then
+ begin app1(pp); app(break_space); app1(pp+1);
+ reduce(pp,2,var_head,-2)(54);
+ end
+
+@ The `|freeze_text|' macro is used to give official status to a token list.
+Before saying |freeze_text|, items are appended to the current token list,
+and we know that the eventual number of this token list will be the current
+value of |text_ptr|. But no list of that number really exists as yet,
+because no ending point for the current list has been
+stored in the |tok_start| array. After saying |freeze_text|, the
+old current token list becomes legitimate, and its number is the current
+value of |text_ptr-1| since |text_ptr| has been increased. The new
+current token list is empty and ready to be appended to.
+Note that |freeze_text| does not check to see that |text_ptr| hasn't gotten
+too large, since it is assumed that this test was done beforehand.
+
+@d freeze_text==incr(text_ptr); tok_start[text_ptr]:=tok_ptr
+
+@ The `|reduce|' macro used in our code for productions actually calls on
+a procedure named `|red|', which makes the appropriate changes to the
+scrap list.
+
+@p procedure red(@!j:sixteen_bits; @!k:eight_bits; @!c:eight_bits;
+ @!d:integer);
+var i:0..max_scraps; {index into scrap memory}
+begin cat[j]:=c; trans[j]:=text_ptr; freeze_text;
+if k>1 then
+ begin for i:=j+k to lo_ptr do
+ begin cat[i-k+1]:=cat[i]; trans[i-k+1]:=trans[i];
+ end;
+ lo_ptr:=lo_ptr-k+1;
+ end;
+@<Change |pp| to $\max(|scrap_base|,|pp+d|)$@>;
+end;
+
+@ @<Change |pp| to $\max(|scrap_base|,|pp+d|)$@>=
+if pp+d>=scrap_base then pp:=pp+d
+else pp:=scrap_base
+
+@ Similarly, the `|squash|' macro invokes a procedure called `|sq|'. This
+procedure takes advantage of the simplification that occurs when |k=1|.
+
+@p procedure sq(@!j:sixteen_bits; @!k:eight_bits; @!c:eight_bits;
+ @!d:integer);
+var i:0..max_scraps; {index into scrap memory}
+begin if k=1 then
+ begin cat[j]:=c; @<Change |pp|...@>;
+ end
+else begin for i:=j to j+k-1 do
+ begin app1(i);
+ end;
+ red(j,k,c,d);
+ end;
+end;
+
+@ Here now is the code that applies productions as long as possible. It
+requires two local labels (|found| and |done|), as well as a local
+variable (|i|).
+
+@<Reduce the scraps using the productions until no more rules apply@>=
+loop@+begin @<Make sure the entries |cat[pp..(pp+3)]| are defined@>;
+ if (tok_ptr+8>max_toks)or(text_ptr+4>max_texts) then
+ begin stat if tok_ptr>max_tok_ptr then max_tok_ptr:=tok_ptr;
+ if text_ptr>max_txt_ptr then max_txt_ptr:=text_ptr;
+ tats@;@/
+ overflow('token/text');
+ end;
+ if pp>lo_ptr then goto done;
+ @<Match a production...@>;
+ end;
+done:
+
+@ If we get to the end of the scrap list, category codes equal to zero are
+stored, since zero does not match anything in a production.
+
+@<Make sure the entries...@>=
+if lo_ptr<pp+3 then
+ begin repeat if hi_ptr<=scrap_ptr then
+ begin incr(lo_ptr);@/
+ cat[lo_ptr]:=cat[hi_ptr]; trans[lo_ptr]:=trans[hi_ptr];@/
+ incr(hi_ptr);
+ end;
+ until (hi_ptr>scrap_ptr)or(lo_ptr=pp+3);
+ for i:=lo_ptr+1 to pp+3 do cat[i]:=0;
+ end
+
+@ If \.{WEAVE} is being run in debugging mode, the production numbers and
+current stack categories will be printed out when |tracing| is set to 2;
+a sequence of two or more irreducible scraps will be printed out when
+|tracing| is set to 1.
+@.\AT!2@>
+@.\AT!1@>
+
+@<Glo...@>=
+@!debug@!tracing:0..2; {can be used to show parsing details}
+gubed
+
+@ The |prod| procedure is called in debugging mode just after |reduce| or
+|squash|; its parameter is the number of the production that has just
+been applied.
+
+@p @!debug procedure prod(@!n:eight_bits); {shows current categories}
+var k:1..max_scraps; {index into |cat|}
+begin if tracing=2 then
+ begin print_nl(n:1,':');
+ for k:=scrap_base to lo_ptr do
+ begin if k=pp then print('*') @+ else print(' ');
+ print_cat(cat[k]);
+ end;
+ if hi_ptr<=scrap_ptr then print('...'); {indicate that more is coming}
+ end;
+end;
+gubed
+
+@ The |translate| function assumes that scraps have been stored in
+positions |scrap_base| through |scrap_ptr| of |cat| and |trans|. It
+appends a |terminator| scrap and begins to apply productions as much as
+possible. The result is a token list containing the translation of
+the given sequence of scraps.
+
+After calling |translate|, we will have |text_ptr+3<=max_texts| and
+|tok_ptr+6<=max_toks|, so it will be possible to create up to three token
+lists with up to six tokens without checking for overflow. Before calling
+|translate|, we should have |text_ptr<max_texts| and |scrap_ptr<max_scraps|,
+since |translate| might add a new text and a new scrap before it checks
+for overflow.
+
+@p @<Declaration of subprocedures for |translate|@>@;
+function translate:text_pointer; {converts a sequence of scraps}
+label done,found;
+var i: 1..max_scraps; {index into |cat|}
+@!j:0..max_scraps; {runs through final scraps}
+@!k:0..long_buf_size; {index into |buffer|}
+begin pp:=scrap_base; lo_ptr:=pp-1; hi_ptr:=pp;
+@<If tracing, print an indication of where we are@>;
+@<Reduce the scraps...@>;
+if (lo_ptr=scrap_base)and(cat[lo_ptr]<>math) then translate:=trans[lo_ptr]
+else @<Combine the irreducible scraps that remain@>;
+end;
+
+@ If the initial sequence of scraps does not reduce to a single scrap,
+we concatenate the translations of all remaining scraps, separated by
+blank spaces, with dollar signs surrounding the translations of |math|
+scraps.
+
+@<Combine the irreducible...@>=
+begin @<If semi-tracing, show the irreducible scraps@>;
+for j:=scrap_base to lo_ptr do
+ begin if j<>scrap_base then
+ begin app(" ");
+ end;
+ if cat[j]=math then
+ begin app("$");
+ end;
+ app1(j);
+ if cat[j]=math then
+ begin app("$");
+ end;
+ if tok_ptr+6>max_toks then overflow('token');
+ end;
+freeze_text; translate:=text_ptr-1;
+end
+
+@ @<If semi-tracing, show the irreducible scraps@>=
+@!debug if (lo_ptr>scrap_base)and(tracing=1) then
+ begin print_nl('Irreducible scrap sequence in section ',module_count:1);
+ print_ln(':'); mark_harmless;
+ for j:=scrap_base to lo_ptr do
+ begin print(' '); print_cat(cat[j]);
+ end;
+ end;
+gubed
+
+@ @<If tracing,...@>=
+@!debug if tracing=2 then
+ begin print_nl('Tracing after l.',line:1,':'); mark_harmless;
+ if loc>50 then
+ begin print('...');
+ for k:=loc-50 to loc do print(xchr[buffer[k-1]]);
+ end
+ else for k:=1 to loc do print(xchr[buffer[k-1]]);
+ end
+gubed
+
+@* Initializing the scraps.
+If we are going to use the powerful production mechanism just developed, we
+must get the scraps set up in the first place, given a \PASCAL\ text. A table
+of the initial scraps corresponding to \PASCAL\ tokens appeared above in the
+section on parsing; our goal now is to implement that table. We shall do this
+by implementing a subroutine called |Pascal_parse| that is analogous to the
+|Pascal_xref| routine used during phase one.
+
+Like |Pascal_xref|, the |Pascal_parse| procedure starts with the current
+value of |next_control| and it uses the operation |next_control:=get_next|
+repeatedly to read \PASCAL\ text until encountering the next `\v' or
+`\.\{', or until |next_control>=format|. The scraps corresponding to what
+it reads are appended into the |cat| and |trans| arrays, and |scrap_ptr|
+is advanced.
+
+Like |prod|, this procedure has to split into pieces so that each
+part is short enough to be handled by \PASCAL\ compilers that discriminate
+against long subroutines. This time there are two split-off routines,
+called |easy_cases| and |sub_cases|.
+@^split procedures@>
+
+After studying |Pascal_parse|, we will look at the sub-procedures
+|app_comment|, |app_octal|, and |app_hex| that are used in some of its
+branches.
+
+@p @<Declaration of the |app_comment| procedure@>@;
+@<Declaration of the |app_octal| and |app_hex| procedures@>@;
+@<Declaration of the |easy_cases| procedure@>@;
+@<Declaration of the |sub_cases| procedure@>@;
+procedure Pascal_parse; {creates scraps from \PASCAL\ tokens}
+label reswitch, exit;
+var j:0..long_buf_size; {index into |buffer|}
+@!p:name_pointer; {identifier designator}
+begin while next_control<format do
+ begin @<Append the scrap appropriate to |next_control|@>;
+ next_control:=get_next;
+ if (next_control="|")or(next_control="{") then return;
+ end;
+exit:end;
+
+@ The macros defined here are helpful abbreviations for the operations
+needed when generating the scraps. A scrap of category |c| whose
+translation has three tokens $t_1$, $t_2$, $t_3$ is generated by
+|sc3|$(t_1)(t_2)(t_3)(c)$, etc.
+
+@d s0(#)==incr(scrap_ptr); cat[scrap_ptr]:=#; trans[scrap_ptr]:=text_ptr;
+ freeze_text;
+ end
+@d s1(#)==app(#);s0
+@d s2(#)==app(#);s1
+@d s3(#)==app(#);s2
+@d s4(#)==app(#);s3
+@d sc4==@+begin s4
+@d sc3==@+begin s3
+@d sc2==@+begin s2
+@d sc1==@+begin s1
+@d sc0(#)==begin incr(scrap_ptr); cat[scrap_ptr]:=#; trans[scrap_ptr]:=0;
+ end
+@d comment_scrap(#)==begin app(#); app_comment;
+ end
+
+@ @<Append the scr...@>=
+@<Make sure that there is room for at least four more scraps, six more
+tokens, and four more texts@>;
+reswitch: case next_control of
+string,verbatim: @<Append a \(string scrap@>;
+identifier: @<Append an identifier scrap@>;
+TeX_string: @<Append a \TeX\ string scrap@>;
+othercases easy_cases
+endcases
+
+@ The |easy_cases| each result in straightforward scraps.
+
+@<Declaration of the |easy_cases| procedure@>=
+procedure easy_cases; {a subprocedure of |Pascal_parse|}
+begin case next_control of
+set_element_sign: sc3("\")("i")("n")(math);
+@.\\in@>
+double_dot: sc3("\")("t")("o")(math);
+@.\\to@>
+"#","$","%","^","_": sc2("\")(next_control)(math);
+@.\\\#@>
+@.\\\$@>
+@.\\\%@>
+@.\\\^@>
+ignore,"|",xref_roman,xref_wildcard,xref_typewriter: do_nothing;
+"(","[": sc1(next_control)(open);
+")","]": sc1(next_control)(close);
+"*": sc4("\")("a")("s")("t")(math);
+@.\\ast@>
+",": sc3(",")(opt)("9")(math);
+".","0","1","2","3","4","5","6","7","8","9": sc1(next_control)(simp);
+";": sc1(";")(semi);
+":": sc1(":")(colon);
+@t\4@> @<Cases involving nonstandard ASCII characters@>@;
+exponent: sc3("\")("E")("{")(exp);
+@.\\E@>
+begin_comment: sc2("\")("B")(math);
+@.\\B@>
+end_comment: sc2("\")("T")(math);
+@.\\T@>
+octal: app_octal;
+hex: app_hex;
+check_sum: sc2("\")(")")(simp);
+@.\\)@>
+force_line: sc2("\")("]")(simp);
+@.\\]@>
+thin_space: sc2("\")(",")(math);
+@.\\,@>
+math_break: sc2(opt)("0")(simp);
+line_break: comment_scrap(force);
+big_line_break: comment_scrap(big_force);
+no_line_break: begin app(big_cancel); app("\"); app(" ");
+@.\\\ @>
+ comment_scrap(big_cancel);
+ end;
+pseudo_semi: sc0(semi);
+join: sc2("\")("J")(math);
+@.\\J@>
+othercases sc1(next_control)(math)
+endcases;
+end;
+
+@ @<Make sure that there is room for at least four...@>=
+if (scrap_ptr+4>max_scraps)or(tok_ptr+6>max_toks)or(text_ptr+4>max_texts) then
+ begin stat if scrap_ptr>max_scr_ptr then max_scr_ptr:=scrap_ptr;
+ if tok_ptr>max_tok_ptr then max_tok_ptr:=tok_ptr;
+ if text_ptr>max_txt_ptr then max_txt_ptr:=text_ptr;
+ tats@;@/
+ overflow('scrap/token/text');
+ end
+
+@ Some nonstandard ASCII characters may have entered \.{WEAVE} by means of
+standard ones. They are converted to \TeX\ control sequences so that it is
+possible to keep \.{WEAVE} from stepping beyond standard ASCII.
+
+@<Cases involving nonstandard...@>=
+not_equal: sc2("\")("I")(math);
+@.\\I@>
+less_or_equal: sc2("\")("L")(math);
+@.\\L@>
+greater_or_equal: sc2("\")("G")(math);
+@.\\G@>
+equivalence_sign: sc2("\")("S")(math);
+@.\\S@>
+and_sign: sc2("\")("W")(math);
+@.\\W@>
+or_sign: sc2("\")("V")(math);
+@.\\V@>
+not_sign: sc2("\")("R")(math);
+@.\\R@>
+left_arrow: sc2("\")("K")(math);
+@.\\K@>
+
+@ The following code must use |app_tok| instead of |app| in order to
+protect against overflow. Note that |tok_ptr+1<=max_toks| after |app_tok|
+has been used, so another |app| is legitimate before testing again.
+
+Many of the special characters in a string must be prefixed by `\.\\' so that
+\TeX\ will print them properly.
+@^special string characters@>
+
+@<Append a \(string scrap@>=
+begin app("\");
+if next_control=verbatim then
+ begin app("=");
+@.\\=@>
+ end
+else begin app(".");
+@.\\.@>
+ end;
+app("{"); j:=id_first;
+while j<id_loc do
+ begin case buffer[j] of
+ " ","\","#","%","$","^","'","`","{","}","~","&","_":
+ begin app("\");
+ end;
+@.\\\ @>
+@.\\\\@>
+@.\\\#@>
+@.\\\%@>
+@.\\\$@>
+@.\\\^@>
+@.\\\'@>
+@.\\\`@>
+@.\\\{@>
+@.\\\}@>
+@.\\\~@>
+@.\\\&@>
+@.\\_@>
+ "@@": if buffer[j+1]="@@" then incr(j)
+ else err_print('! Double @@ should be used in strings');
+@.Double \AT! should be used...@>
+ othercases do_nothing
+ endcases;@/
+ app_tok(buffer[j]); incr(j);
+ end;
+sc1("}")(simp);
+end
+
+@ @<Append a \TeX\ string scrap@>=
+begin app("\"); app("h"); app("b"); app("o"); app("x");
+app("{");
+for j:=id_first to id_loc-1 do app_tok(buffer[j]);
+sc1("}")(simp);
+end
+
+@ @<Append an identifier scrap@>=
+begin p:=id_lookup(normal);
+case ilk[p] of
+normal,array_like,const_like,div_like,
+ do_like,for_like,goto_like,nil_like,to_like: sub_cases(p);
+@t\4@>@<Cases that generate more than one scrap@>@;
+othercases begin next_control:=ilk[p]-char_like; goto reswitch;
+ end {\&{and}, \&{in}, \&{not}, \&{or}}
+endcases;
+end
+
+@ The |sub_cases| also result in straightforward scraps.
+
+@<Declaration of the |sub_cases| procedure@>=
+procedure sub_cases(@!p:name_pointer); {a subprocedure of |Pascal_parse|}
+begin case ilk[p] of
+normal: sc1(id_flag+p)(simp); {not a reserved word}
+array_like: sc1(res_flag+p)(alpha); {\&{array}, \&{file}, \&{set}}
+const_like: sc3(force)(backup)(res_flag+p)(intro);
+ {\&{const}, \&{label}, \&{type}}
+div_like: sc3(math_bin)(res_flag+p)("}")(math); {\&{div}, \&{mod}}
+do_like: sc1(res_flag+p)(omega); {\&{do}, \&{of}, \&{then}}
+for_like: sc2(force)(res_flag+p)(alpha); {\&{for}, \&{while}, \&{with}}
+goto_like: sc1(res_flag+p)(intro); {\&{goto}, \&{packed}}
+nil_like: sc1(res_flag+p)(simp); {\&{nil}}
+to_like: sc3(math_rel)(res_flag+p)("}")(math); {\&{downto}, \&{to}}
+end;
+end;
+
+@ @<Cases that generate more than one scrap@>=
+begin_like: begin sc3(force)(res_flag+p)(cancel)(beginning); sc0(intro);
+ end; {\&{begin}}
+case_like: begin sc0(casey); sc2(force)(res_flag+p)(alpha);
+ end; {\&{case}}
+else_like: begin @<Append |terminator| if not already present@>;
+ sc3(force)(backup)(res_flag+p)(elsie);
+ end; {\&{else}}
+end_like: begin @<Append |term...@>;
+ sc2(force)(res_flag+p)(close);
+ end; {\&{end}}
+if_like: begin sc0(cond); sc2(force)(res_flag+p)(alpha);
+ end; {\&{if}}
+loop_like: begin sc3(force)("\")("~")(alpha);
+@.\\\~@>
+ sc1(res_flag+p)(omega);
+ end; {\&{xclause}}
+proc_like: begin sc4(force)(backup)(res_flag+p)(cancel)(proc);
+ sc3(indent)("\")(" ")(intro);
+@.\\\ @>
+ end; {\&{function}, \&{procedure}, \&{program}}
+record_like: begin sc1(res_flag+p)(record_head); sc0(intro);
+ end; {\&{record}}
+repeat_like: begin sc4(force)(indent)(res_flag+p)(cancel)(beginning);
+ sc0(intro);
+ end; {\&{repeat}}
+until_like: begin @<Append |term...@>;
+ sc3(force)(backup)(res_flag+p)(close); sc0(clause);
+ end; {\&{until}}
+var_like: begin sc4(force)(backup)(res_flag+p)(cancel)(var_head); sc0(intro);
+ end; {\&{var}}
+
+@ If a comment or semicolon appears before the reserved words \&{end},
+\&{else}, or \&{until}, the |semi| or |terminator| scrap that is already
+present overrides the |terminator| scrap belonging to this reserved word.
+
+@<Append |termin...@>=
+if (scrap_ptr<scrap_base)or((cat[scrap_ptr]<>terminator)and
+ (cat[scrap_ptr]<>semi)) then sc0(terminator)
+
+@ A comment is incorporated into the previous scrap if that scrap is of type
+|omega| or |semi| or |terminator|. (These three categories have consecutive
+category codes.) Otherwise the comment is entered as a separate scrap
+of type |terminator|, and it will combine with a |terminator| scrap that
+immediately follows~it.
+
+The |app_comment| procedure takes care of placing a comment at the end of the
+current scrap list. When |app_comment| is called, we assume that the current
+token list is the translation of the comment involved.
+
+@<Declaration of the |app_comment|...@>=
+procedure app_comment; {append a comment to the scrap list}
+begin freeze_text;
+if (scrap_ptr<scrap_base)or(cat[scrap_ptr]<omega)or
+ (cat[scrap_ptr]>terminator) then sc0(terminator)
+else begin app1(scrap_ptr); {|cat[scrap_ptr]| is
+ |omega| or |semi| or |terminator|}
+ end;
+app(text_ptr-1+tok_flag); trans[scrap_ptr]:=text_ptr; freeze_text;
+end;
+
+@ We are now finished with |Pascal_parse|, except for two relatively
+trivial subprocedures that convert constants into tokens.
+
+@<Declaration of the |app_octal| and...@>=
+procedure app_octal;
+begin app("\"); app("O"); app("{");
+@.\\O@>
+while (buffer[loc]>="0")and(buffer[loc]<="7") do
+ begin app_tok(buffer[loc]); incr(loc);
+ end;
+sc1("}")(simp);
+end;
+@#
+procedure app_hex;
+begin app("\"); app("H"); app("{");
+@.\\H@>
+while ((buffer[loc]>="0")and(buffer[loc]<="9"))or@|
+ ((buffer[loc]>="A")and(buffer[loc]<="F")) do
+ begin app_tok(buffer[loc]); incr(loc);
+ end;
+sc1("}")(simp);
+end;
+
+
+@ When the `\v' that introduces \PASCAL\ text is sensed, a call on
+|Pascal_translate| will return a pointer to the \TeX\ translation of
+that text. If scraps exist in the |cat| and |trans| arrays, they are
+unaffected by this translation process.
+
+@p function Pascal_translate: text_pointer;
+var p:text_pointer; {points to the translation}
+@!save_base:0..max_scraps; {holds original value of |scrap_base|}
+begin save_base:=scrap_base; scrap_base:=scrap_ptr+1;
+Pascal_parse; {get the scraps together}
+if next_control<>"|" then err_print('! Missing "|" after Pascal text');
+@.Missing "|"...@>
+app_tok(cancel); app_comment; {place a |cancel| token as a final ``comment''}
+p:=translate; {make the translation}
+stat if scrap_ptr>max_scr_ptr then max_scr_ptr:=scrap_ptr;@;@+tats@;@/
+scrap_ptr:=scrap_base-1; scrap_base:=save_base; {scrap the scraps}
+Pascal_translate:=p;
+end;
+
+@ The |outer_parse| routine is to |Pascal_parse| as |outer_xref|
+is to |Pascal_xref|: It constructs a sequence of scraps for \PASCAL\ text
+until |next_control>=format|. Thus, it takes care of embedded comments.
+
+@p procedure outer_parse; {makes scraps from \PASCAL\ tokens and comments}
+var bal:eight_bits; {brace level in comment}
+@!p,@!q:text_pointer; {partial comments}
+begin while next_control<format do
+ if next_control<>"{" then Pascal_parse
+ else begin @<Make sure that there is room for at least seven more
+ tokens, three more texts, and one more scrap@>;
+ app("\"); app("C"); app("{");
+@.\\C@>
+ bal:=copy_comment(1); next_control:="|";
+ while bal>0 do
+ begin p:=text_ptr; freeze_text; q:=Pascal_translate;
+ {at this point we have |tok_ptr+6<=max_toks|}
+ app(tok_flag+p); app(inner_tok_flag+q);
+ if next_control="|" then bal:=copy_comment(bal)
+ else bal:=0; {an error has been reported}
+ end;
+ app(force); app_comment; {the full comment becomes a scrap}
+ end;
+end;
+
+@ @<Make sure that there is room for at least seven more...@>=
+if (tok_ptr+7>max_toks)or(text_ptr+3>max_texts)or(scrap_ptr>=max_scraps) then
+ begin stat if scrap_ptr>max_scr_ptr then max_scr_ptr:=scrap_ptr;
+ if tok_ptr>max_tok_ptr then max_tok_ptr:=tok_ptr;
+ if text_ptr>max_txt_ptr then max_txt_ptr:=text_ptr;
+ tats@;@/
+ overflow('token/text/scrap');
+ end
+
+@* Output of tokens.
+So far our programs have only built up multi-layered token lists in
+\.{WEAVE}'s internal memory; we have to figure out how to get them into
+the desired final form. The job of converting token lists to characters in
+the \TeX\ output file is not difficult, although it is an implicitly
+recursive process. Four main considerations had to be kept in mind when
+this part of \.{WEAVE} was designed. (a) There are two modes of output:
+|outer| mode, which translates tokens like |force| into line-breaking
+control sequences, and |inner| mode, which ignores them except that blank
+spaces take the place of line breaks. (b) The |cancel| instruction applies
+to adjacent token or tokens that are output, and this cuts across levels
+of recursion since `|cancel|' occurs at the beginning or end of a token
+list on one level. (c) The \TeX\ output file will be semi-readable if line
+breaks are inserted after the result of tokens like |break_space| and
+|force|. (d) The final line break should be suppressed, and there should
+be no |force| token output immediately after `\.{\\Y\\P}'.
+
+@ The output process uses a stack to keep track of what is going on at
+different ``levels'' as the token lists are being written out. Entries on
+this stack have three parts:
+
+\yskip\hang |end_field| is the |tok_mem| location where the token list of a
+particular level will end;
+
+\yskip\hang |tok_field| is the |tok_mem| location from which the next token
+on a particular level will be read;
+
+\yskip\hang |mode_field| is the current mode, either |inner| or |outer|.
+
+\yskip\noindent The current values of these quantities are referred to
+quite frequently, so they are stored in a separate place instead of in the
+|stack| array. We call the current values |cur_end|, |cur_tok|, and
+|cur_mode|.
+
+The global variable |stack_ptr| tells how many levels of output are
+currently in progress. The end of output occurs when an |end_translation|
+token is found, so the stack is never empty except when we first begin the
+output process.
+
+@d inner=0 {value of |mode| for \PASCAL\ texts within \TeX\ texts}
+@d outer=1 {value of |mode| for \PASCAL\ texts in modules}
+
+@<Types...@>=
+@!mode=inner..outer;@/
+@!output_state=record@!end_field:sixteen_bits; {ending location of token list}
+ @!tok_field:sixteen_bits; {present location within token list}
+ @!mode_field:mode; {interpretation of control tokens}
+ end;
+
+@ @d cur_end==cur_state.end_field {current ending location in |tok_mem|}
+@d cur_tok==cur_state.tok_field {location of next output token in |tok_mem|}
+@d cur_mode==cur_state.mode_field {current mode of interpretation}
+@d init_stack==stack_ptr:=0;cur_mode:=outer {do this to initialize the stack}
+
+@<Glob...@>=
+@!cur_state:output_state; {|cur_end|, |cur_tok|, |cur_mode|}
+@!stack:array[1..stack_size] of output_state; {info for non-current levels}
+@!stack_ptr:0..stack_size; {first unused location in the output state stack}
+stat@!max_stack_ptr:0..stack_size; {largest value assumed by |stack_ptr|}
+tats
+
+@ @<Set init...@>=stat max_stack_ptr:=0;@+tats
+
+@ To insert token-list |p| into the output, the |push_level| subroutine
+is called; it saves the old level of output and gets a new one going.
+The value of |cur_mode| is not changed.
+
+@p procedure push_level(@!p:text_pointer); {suspends the current level}
+begin if stack_ptr=stack_size then overflow('stack')
+else begin if stack_ptr>0 then
+ stack[stack_ptr]:=cur_state; {save |cur_end|$\,\ldots\,$|cur_mode|}
+ incr(stack_ptr);
+ stat if stack_ptr>max_stack_ptr then
+ max_stack_ptr:=stack_ptr;@;@+tats@;@/
+ cur_tok:=tok_start[p]; cur_end:=tok_start[p+1];
+ end;
+end;
+
+@ Conversely, the |pop_level| routine restores the conditions that were in
+force when the current level was begun. This subroutine will never be
+called when |stack_ptr=1|. It is so simple, we declare it as a macro:
+
+@d pop_level==begin decr(stack_ptr); cur_state:=stack[stack_ptr];
+ end {do this when |cur_tok| reaches |cur_end|}
+
+@ The |get_output| function returns the next byte of output that is not a
+reference to a token list. It returns the values |identifier| or |res_word|
+or |mod_name| if the next token is to be an identifier (typeset in
+italics), a reserved word (typeset in boldface) or a module name (typeset
+by a complex routine that might generate additional levels of output).
+In these cases |cur_name| points to the identifier or module name in
+question.
+
+@d res_word=@'201 {returned by |get_output| for reserved words}
+@d mod_name=@'200 {returned by |get_output| for module names}
+
+@p function get_output:eight_bits; {returns the next token of output}
+label restart;
+var a:sixteen_bits; {current item read from |tok_mem|}
+begin restart: while cur_tok=cur_end do pop_level;
+a:=tok_mem[cur_tok]; incr(cur_tok);
+if a>=@'400 then
+ begin cur_name:=a mod id_flag;
+ case a div id_flag of
+ 2: a:=res_word; {|a=res_flag+cur_name|}
+ 3: a:=mod_name; {|a=mod_flag+cur_name|}
+ 4: begin push_level(cur_name); goto restart;
+ end; {|a=tok_flag+cur_name|}
+ 5: begin push_level(cur_name); cur_mode:=inner; goto restart;
+ end; {|a=inner_tok_flag+cur_name|}
+ othercases a:=identifier {|a=id_flag+cur_name|}
+ endcases;
+ end;
+@!debug if trouble_shooting then debug_help; @+ gubed@/
+get_output:=a;
+end;
+
+@ The real work associated with token output is done by |make_output|.
+This procedure appends an |end_translation| token to the current token list,
+and then it repeatedly calls |get_output| and feeds characters to the output
+buffer until reaching the |end_translation| sentinel. It is possible for
+|make_output| to
+be called recursively, since a module name may include embedded \PASCAL\
+text; however, the depth of recursion never exceeds one level, since
+module names cannot be inside of module names.
+
+A procedure called |output_Pascal| does the scanning, translation, and
+output of \PASCAL\ text within `\pb' brackets, and this procedure uses
+|make_output| to output the current token list. Thus, the recursive call
+of |make_output| actually occurs when |make_output| calls |output_Pascal|
+while outputting the name of a module.
+@^recursion@>
+
+@p procedure make_output; forward; @t\2@>@#
+procedure output_Pascal; {outputs the current token list}
+var save_tok_ptr,@!save_text_ptr,@!save_next_control:sixteen_bits;
+ {values to be restored}
+p:text_pointer; {translation of the \PASCAL\ text}
+begin save_tok_ptr:=tok_ptr; save_text_ptr:=text_ptr;
+save_next_control:=next_control; next_control:="|"; p:=Pascal_translate;
+app(p+inner_tok_flag);
+make_output; {output the list}
+stat if text_ptr>max_txt_ptr then max_txt_ptr:=text_ptr;
+if tok_ptr>max_tok_ptr then max_tok_ptr:=tok_ptr;@;@+tats@;@/
+text_ptr:=save_text_ptr; tok_ptr:=save_tok_ptr; {forget the tokens}
+next_control:=save_next_control; {restore |next_control| to original state}
+end;
+
+@ Here is \.{WEAVE}'s major output handler.
+
+@p procedure make_output; {outputs the equivalents of tokens}
+label reswitch,exit,found;
+var a:eight_bits; {current output byte}
+@!b:eight_bits; {next output byte}
+@!k,@!k_limit:0..max_bytes; {indices into |byte_mem|}
+@!w:0..ww-1; {row of |byte_mem|}
+@!j:0..long_buf_size; {index into |buffer|}
+@!string_delimiter:ASCII_code; {first and last character of
+ string being copied}
+@!save_loc,@!save_limit:0..long_buf_size; {|loc| and |limit| to be restored}
+@!cur_mod_name:name_pointer; {name of module being output}
+@!save_mode:mode; {value of |cur_mode| before a sequence of breaks}
+begin app(end_translation); {append a sentinel}
+freeze_text; push_level(text_ptr-1);
+loop@+ begin a:=get_output;
+reswitch: case a of
+ end_translation: return;
+ identifier,res_word:@<Output an identifier@>;
+ mod_name:@<Output a module name@>;
+ math_bin,math_op,math_rel:@<Output a \.{\\math} operator@>;
+ cancel: begin repeat a:=get_output;
+ until (a<backup)or(a>big_force);
+ goto reswitch;
+ end;
+ big_cancel: begin repeat a:=get_output;
+ until ((a<backup)and(a<>" "))or(a>big_force);
+ goto reswitch;
+ end;
+ indent,outdent,opt,backup,break_space,force,big_force:@<Output a
+ \(control, look ahead in case of line breaks,
+ possibly |goto reswitch|@>;
+ othercases out(a) {otherwise |a| is an ASCII character}
+ endcases;
+ end;
+exit:end;
+
+@ An identifier of length one does not have to be enclosed in braces, and it
+looks slightly better if set in a math-italic font instead of a (slightly
+narrower) text-italic font. Thus we output `\.{\\\char'174a}' but
+`\.{\\\\\{aa\}}'.
+
+@<Output an identifier@>=
+begin out("\");
+if a=identifier then
+ if length(cur_name)=1 then out("|")
+@.\\|@>
+ else out("\")
+@.\\\\@>
+else out("&"); {|a=res_word|}
+@.\\\&@>
+if length(cur_name)=1 then out(byte_mem[cur_name mod ww,byte_start[cur_name]])
+else out_name(cur_name);
+end
+
+@ @<Output a \....@>=
+begin out5("\")("m")("a")("t")("h");
+if a=math_bin then out3("b")("i")("n")
+else if a=math_rel then out3("r")("e")("l")
+else out2("o")("p");
+out("{");
+end
+
+@ The current mode does not affect the behavior of \.{WEAVE}'s output routine
+except when we are outputting control tokens.
+
+@<Output a \(control...@>=
+if a<break_space then
+ begin if cur_mode=outer then
+ begin out2("\")(a-cancel+"0");
+@.\\1@>
+@.\\2@>
+@.\\3@>
+@.\\4@>
+@.\\5@>
+@.\\6@>
+@.\\7@>
+ if a=opt then out(get_output) {|opt| is followed by a digit}
+ end
+ else if a=opt then b:=get_output {ignore digit following |opt|}
+ end
+else @<Look ahead for strongest line break, |goto reswitch|@>
+
+@ If several of the tokens |break_space|, |force|, |big_force| occur in a
+row, possibly mixed with blank spaces (which are ignored),
+the largest one is used. A line break also occurs in the output file,
+except at the very end of the translation. The very first line break
+is suppressed (i.e., a line break that follows `\.{\\Y\\P}').
+
+@<Look ahead for st...@>=
+begin b:=a; save_mode:=cur_mode;
+loop@+ begin a:=get_output;
+ if (a=cancel)or(a=big_cancel) then goto reswitch;
+ {|cancel| overrides everything}
+ if ((a<>" ")and(a<break_space))or(a>big_force) then
+ begin if save_mode=outer then
+ begin if out_ptr>3 then
+ if (out_buf[out_ptr]="P")and
+ (out_buf[out_ptr-1]="\")and
+@.\\P@>
+@.\\Y@>
+ (out_buf[out_ptr-2]="Y")and
+ (out_buf[out_ptr-3]="\") then
+ goto reswitch;
+@.\\1@>
+@.\\2@>
+@.\\3@>
+@.\\4@>
+@.\\5@>
+@.\\6@>
+@.\\7@>
+ out2("\")(b-cancel+"0");
+ if a<>end_translation then finish_line;
+ end
+ else if (a<>end_translation)and(cur_mode=inner) then out(" ");
+ goto reswitch;
+ end;
+ if a>b then b:=a; {if |a=" "| we have |a<b|}
+ end;
+end
+
+@ The remaining part of |make_output| is somewhat more complicated. When we
+output a module name, we may need to enter the parsing and translation
+routines, since the name may contain \PASCAL\ code embedded in
+\pb\ constructions. This \PASCAL\ code is placed at the end of the active
+input buffer and the translation process uses the end of the active
+|tok_mem| area.
+
+@<Output a module name@>=
+begin out2("\")("X");
+@.\\X@>
+cur_xref:=xref[cur_name];
+if num(cur_xref)>=def_flag then
+ begin out_mod(num(cur_xref)-def_flag);
+ if phase_three then
+ begin cur_xref:=xlink(cur_xref);
+ while num(cur_xref)>=def_flag do
+ begin out2(",")(" ");
+ out_mod(num(cur_xref)-def_flag);
+ cur_xref:=xlink(cur_xref);
+ end;
+ end;
+ end
+else out("0"); {output the module number, or zero if it was undefined}
+out(":"); @<Output the text of the module name@>;
+out2("\")("X");
+end
+
+@ @<Output the text...@>=
+k:=byte_start[cur_name]; w:=cur_name mod ww; k_limit:=byte_start[cur_name+ww];
+cur_mod_name:=cur_name;
+while k<k_limit do
+ begin b:=byte_mem[w,k]; incr(k);
+ if b="@@" then @<Skip next character, give error if not `\.{@@}'@>;
+ if b<>"|" then out(b)
+ else begin @<Copy the \PASCAL\ text into |buffer[(limit+1)..j]|@>;
+ save_loc:=loc; save_limit:=limit; loc:=limit+2; limit:=j+1;
+ buffer[limit]:="|"; output_Pascal;
+ loc:=save_loc; limit:=save_limit;
+ end;
+ end
+
+@ @<Skip next char...@>=
+begin if byte_mem[w,k]<>"@@" then
+ begin print_nl('! Illegal control code in section name:');
+@.Illegal control code...@>
+ print_nl('<'); print_id(cur_mod_name); print('> '); mark_error;
+ end;
+incr(k);
+end
+
+@ The \PASCAL\ text enclosed in \pb\ should not contain `\v' characters,
+except within strings. We put a `\v' at the front of the buffer, so that an
+error message that displays the whole buffer will look a little bit sensible.
+The variable |string_delimiter| is zero outside of strings, otherwise it
+equals the delimiter that began the string being copied.
+
+@<Copy the \PASCAL\ text into...@>=
+j:=limit+1; buffer[j]:="|"; string_delimiter:=0;
+loop@+ begin if k>=k_limit then
+ begin print_nl('! Pascal text in section name didn''t end:');
+@.Pascal text...didn't end@>
+ print_nl('<'); print_id(cur_mod_name); print('> '); mark_error;
+ goto found;
+ end;
+ b:=byte_mem[w,k]; incr(k);
+ if b="@@" then @<Copy a control code into the buffer@>
+ else begin if (b="""")or(b="'") then
+ if string_delimiter=0 then string_delimiter:=b
+ else if string_delimiter=b then string_delimiter:=0;
+ if (b<>"|")or(string_delimiter<>0) then
+ begin if j>long_buf_size-3 then overflow('buffer');
+ incr(j); buffer[j]:=b;
+ end
+ else goto found;
+ end;
+ end;
+found:
+
+@ @<Copy a control code into the buffer@>=
+begin if j>long_buf_size-4 then overflow('buffer');
+buffer[j+1]:="@@"; buffer[j+2]:=byte_mem[w,k]; j:=j+2; incr(k);
+end
+
+@* Phase two processing.
+We have assembled enough pieces of the puzzle in order to be ready to specify
+the processing in \.{WEAVE}'s main pass over the source file. Phase two
+is analogous to phase one, except that more work is involved because we must
+actually output the \TeX\ material instead of merely looking at the
+\.{WEB} specifications.
+
+@<Phase II: Read all the text again and translate it to \TeX\ form@>=
+reset_input; print_nl('Writing the output file...');
+module_count:=0;
+copy_limbo;
+finish_line; flush_buffer(0,false,false); {insert a blank line, it looks nice}
+while not input_has_ended do @<Translate the \(current module@>
+
+@ The output file will contain the control sequence \.{\\Y} between non-null
+sections of a module, e.g., between the \TeX\ and definition parts if both
+are nonempty. This puts a little white space between the parts when they are
+printed. However, we don't want \.{\\Y} to occur between two definitions
+within a single module. The variables |out_line| or |out_ptr| will
+change if a section is non-null, so the following macros `|save_position|'
+and `|emit_space_if_needed|' are able to handle the situation:
+
+@d save_position==save_line:=out_line; save_place:=out_ptr
+@d emit_space_if_needed==if (save_line<>out_line)or(save_place<>out_ptr) then
+ out2("\")("Y")
+@.\\Y@>
+
+@<Glo...@>=
+@!save_line:integer; {former value of |out_line|}
+@!save_place:sixteen_bits; {former value of |out_ptr|}
+
+@ @<Translate the \(current module@>=
+begin incr(module_count);@/
+@<Output the code for the beginning of a new module@>;
+save_position;@/
+@<Translate the \TeX\ part of the current module@>;
+@<Translate the \(definition part of the current module@>;
+@<Translate the \PASCAL\ part of the current module@>;
+@<Show cross references to this module@>;
+@<Output the code for the end of a module@>;
+end
+
+@ Modules beginning with the \.{WEB} control sequence `\.{@@\ }' start in the
+output with the \TeX\ control sequence `\.{\\M}', followed by the module
+number. Similarly, `\.{@@*}' modules lead to the control sequence `\.{\\N}'.
+If this is a changed module, we put \.{*} just before the module number.
+
+@<Output the code for the beginning...@>=
+out("\");
+if buffer[loc-1]<>"*" then out("M")
+@.\\M@>
+else begin out("N"); print('*',module_count:1);
+@.\\N@>
+ update_terminal; {print a progress report}
+ end;
+out_mod(module_count); out2(".")(" ")
+
+@ In the \TeX\ part of a module, we simply copy the source text, except that
+index entries are not copied and \PASCAL\ text within \pb\ is translated.
+
+@<Translate the \T...@>=
+repeat next_control:=copy_TeX;
+case next_control of
+"|": begin init_stack; output_Pascal;
+ end;
+"@@": out("@@");
+octal: @<Translate an octal constant appearing in \TeX\ text@>;
+hex: @<Translate a hexadecimal constant appearing in \TeX\ text@>;
+TeX_string,xref_roman,xref_wildcard,xref_typewriter,module_name:
+ begin loc:=loc-2; next_control:=get_next; {skip to \.{@@>}}
+ if next_control=TeX_string then
+ err_print('! TeX string should be in Pascal text only');
+@.TeX string should be...@>
+ end;
+begin_comment,end_comment,check_sum,thin_space,math_break,line_break,
+ big_line_break,no_line_break,join,pseudo_semi:
+ err_print('! You can''t do that in TeX text');
+@.You can't do that...@>
+othercases do_nothing
+endcases;
+until next_control>=format
+
+@ @<Translate an octal constant appearing in \TeX\ text@>=
+begin out3("\")("O")("{");
+@.\\O@>
+while (buffer[loc]>="0")and(buffer[loc]<="7") do
+ begin out(buffer[loc]); incr(loc);
+ end; {since |buffer[limit]=" "|, this loop will end}
+out("}");
+end
+
+@ @<Translate a hexadecimal constant appearing in \TeX\ text@>=
+begin out3("\")("H")("{");
+@.\\H@>
+while ((buffer[loc]>="0")and(buffer[loc]<="9"))or@|
+ ((buffer[loc]>="A")and(buffer[loc]<="F")) do
+ begin out(buffer[loc]); incr(loc);
+ end;
+out("}");
+end
+@ When we get to the following code we have |next_control>=format|, and
+the token memory is in its initial empty state.
+
+@<Translate the \(d...@>=
+if next_control<=definition then {definition part non-empty}
+ begin emit_space_if_needed; save_position;
+ end;
+while next_control<=definition do {|format| or |definition|}
+ begin init_stack;
+ if next_control=definition then @<Start a macro definition@>
+ else @<Start a format definition@>;
+ outer_parse; finish_Pascal;
+ end
+
+@ The |finish_Pascal| procedure outputs the translation of the current
+scraps, preceded by the control sequence `\.{\\P}' and followed by the
+control sequence `\.{\\par}'. It also restores the token and scrap
+memories to their initial empty state.
+
+A |force| token is appended to the current scraps before translation
+takes place, so that the translation will normally end with \.{\\6} or
+\.{\\7} (the \TeX\ macros for |force| and |big_force|). This \.{\\6} or
+\.{\\7} is replaced by the concluding \.{\\par} or by \.{\\Y\\par}.
+
+@p procedure finish_Pascal; {finishes a definition or a \PASCAL\ part}
+var p:text_pointer; {translation of the scraps}
+begin out2("\")("P"); app_tok(force); app_comment; p:=translate;
+@.\\P@>
+app(p+tok_flag); make_output; {output the list}
+if out_ptr>1 then
+ if out_buf[out_ptr-1]="\" then
+@.\\6@>
+@.\\7@>
+@.\\Y@>
+ if out_buf[out_ptr]="6" then out_ptr:=out_ptr-2
+ else if out_buf[out_ptr]="7" then out_buf[out_ptr]:="Y";
+out4("\")("p")("a")("r"); finish_line;
+stat if text_ptr>max_txt_ptr then max_txt_ptr:=text_ptr;
+if tok_ptr>max_tok_ptr then max_tok_ptr:=tok_ptr;
+if scrap_ptr>max_scr_ptr then max_scr_ptr:=scrap_ptr;
+tats@;@/
+tok_ptr:=1; text_ptr:=1; scrap_ptr:=0; {forget the tokens and the scraps}
+end;
+
+@ @<Start a macro...@>=
+begin sc2("\")("D")(intro); {this will produce `\&{define }'}
+@.\\D@>
+next_control:=get_next;
+if next_control<>identifier then err_print('! Improper macro definition')
+@.Improper macro definition@>
+else sc1(id_flag+id_lookup(normal))(math);
+next_control:=get_next;
+end
+
+@ @<Start a format...@>=
+begin sc2("\")("F")(intro); {this will produce `\&{format }'}
+@.\\F@>
+next_control:=get_next;
+if next_control=identifier then
+ begin sc1(id_flag+id_lookup(normal))(math);
+ next_control:=get_next;
+ if next_control=equivalence_sign then
+ begin sc2("\")("S")(math); {output an equivalence sign}
+@.\\S@>
+ next_control:=get_next;
+ if next_control=identifier then
+ begin sc1(id_flag+id_lookup(normal))(math);
+ sc0(semi); {insert an invisible semicolon}
+ next_control:=get_next;
+ end;
+ end;
+ end;
+if scrap_ptr<>5 then err_print('! Improper format definition');
+@.Improper format definition@>
+end
+
+@ Finally, when the \TeX\ and definition parts have been treated, we have
+|next_control>=begin_Pascal|. We will make the global variable |this_module|
+point to the current module name, if it has a name.
+
+@<Glob...@>=@!this_module:name_pointer; {the current module name, or zero}
+
+@ @<Translate the \P...@>=
+this_module:=0;
+if next_control<=module_name then
+ begin emit_space_if_needed; init_stack;
+ if next_control=begin_Pascal then next_control:=get_next
+ else begin this_module:=cur_module;
+ @<Check that |=| or |==| follows this module name, and
+ emit the scraps to start the module definition@>;
+ end;
+ while next_control<=module_name do
+ begin outer_parse;
+ @<Emit the scrap for a module name if present@>;
+ end;
+ finish_Pascal;
+ end
+
+@ @<Check that |=|...@>=
+repeat next_control:=get_next;
+until next_control<>"+"; {allow optional `\.{+=}'}
+if (next_control<>"=")and(next_control<>equivalence_sign) then
+ err_print('! You need an = sign after the section name')
+@.You need an = sign...@>
+else next_control:=get_next;
+if out_ptr>1 then
+ if (out_buf[out_ptr]="Y")and(out_buf[out_ptr-1]="\") then
+@.\\Y@>
+ begin app(backup); {the module name will be flush left}
+ end;
+sc1(mod_flag+this_module)(mod_scrap);
+cur_xref:=xref[this_module];
+if num(cur_xref)<>module_count+def_flag then
+ begin sc3(math_rel)("+")("}")(math);
+ {module name is multiply defined}
+ this_module:=0; {so we won't give cross-reference info here}
+ end;
+sc2("\")("S")(math); {output an equivalence sign}
+@.\\S@>
+sc1(force)(semi); {this forces a line break unless `\.{@@+}' follows}
+
+@ @<Emit the scrap...@>=
+if next_control<module_name then
+ begin err_print('! You can''t do that in Pascal text');
+@.You can't do that...@>
+ next_control:=get_next;
+ end
+else if next_control=module_name then
+ begin sc1(mod_flag+cur_module)(mod_scrap); next_control:=get_next;
+ end
+
+@ Cross references relating to a named module are given after the module ends.
+
+@<Show cross...@>=
+if this_module>0 then
+ begin @<Rearrange the list pointed to by |cur_xref|@>;
+ footnote(def_flag); footnote(0);
+ end
+
+@ To rearrange the order of the linked list of cross references, we need
+four more variables that point to cross reference entries. We'll end up
+with a list pointed to by |cur_xref|.
+
+@<Glob...@>=
+@!next_xref,@!this_xref,@!first_xref,@!mid_xref:xref_number;
+ {pointer variables for rearranging a list}
+
+@ We want to rearrange the cross reference list so that all the entries with
+|def_flag| come first, in ascending order; then come all the other
+entries, in ascending order. There may be no entries in either one or both
+of these categories.
+
+@<Rearrange the list...@>=
+first_xref:=xref[this_module];
+this_xref:=xlink(first_xref); {bypass current module number}
+if num(this_xref)>def_flag then
+ begin mid_xref:=this_xref; cur_xref:=0; {this value doesn't matter}
+ repeat next_xref:=xlink(this_xref); xlink(this_xref):=cur_xref;
+ cur_xref:=this_xref; this_xref:=next_xref;
+ until num(this_xref)<=def_flag;
+ xlink(first_xref):=cur_xref;
+ end
+else mid_xref:=0; {first list null}
+cur_xref:=0;
+while this_xref<>0 do
+ begin next_xref:=xlink(this_xref); xlink(this_xref):=cur_xref;
+ cur_xref:=this_xref; this_xref:=next_xref;
+ end;
+if mid_xref>0 then xlink(mid_xref):=cur_xref
+else xlink(first_xref):=cur_xref;
+cur_xref:=xlink(first_xref)
+
+@ The |footnote| procedure gives cross reference information about
+multiply defined module names (if the |flag| parameter is |def_flag|), or about
+the uses of a module name (if the |flag| parameter is zero). It assumes that
+|cur_xref| points to the first cross-reference entry of interest, and it
+leaves |cur_xref| pointing to the first element not printed. Typical outputs:
+`\.{\\A101.}'; `\.{\\Us370\\ET1009.}'; `\.{\\As8, 27\\*, 51\\ETs64.}'.
+
+@p procedure footnote(@!flag:sixteen_bits); {outputs module cross-references}
+label done,exit;
+var q:xref_number; {cross-reference pointer variable}
+begin if num(cur_xref)<=flag then return;
+finish_line; out("\");
+@.\\A@>
+@.\\U@>
+if flag=0 then out("U")@+else out("A");
+@<Output all the module numbers on the reference list |cur_xref|@>;
+out(".");
+exit:end;
+
+@ The following code distinguishes three cases, according as the number
+of cross references is one, two, or more than two. Variable |q| points
+to the first cross reference, and the last link is a zero.
+
+@<Output all the module numbers...@>=
+q:=cur_xref; if num(xlink(q))>flag then out("s"); {plural}
+@.\\As@>
+@.\\Us@>
+loop@+ begin out_mod(num(cur_xref)-flag);
+ cur_xref:=xlink(cur_xref); {point to the next cross reference to output}
+ if num(cur_xref)<=flag then goto done;
+ if num(xlink(cur_xref))>flag then out2(",")(" ") {not the last}
+ else begin out3("\")("E")("T"); {the last}
+@.\\ET@>
+ if cur_xref<>xlink(q) then out("s"); {the last of more than two}
+@.\\ETs@>
+ end;
+ end;
+done:
+
+@ @<Output the code for the end of a module@>=
+out3("\")("f")("i"); finish_line;
+flush_buffer(0,false,false); {insert a blank line, it looks nice}
+@.\\fi@>
+
+@* Phase three processing.
+We are nearly finished! \.{WEAVE}'s only remaining task is to write out the
+index, after sorting the identifiers and index entries.
+
+@<Phase III: Output the cross-reference index@>=
+phase_three:=true; print_nl('Writing the index...');
+if change_exists then
+ begin finish_line; @<Tell about changed modules@>;
+ end;
+finish_line; out4("\")("i")("n")("x"); finish_line;
+@.\\inx@>
+@<Do the first pass of sorting@>;
+@<Sort and output the index@>;
+out4("\")("f")("i")("n"); finish_line;
+@.\\fin@>
+@<Output all the module names@>;
+out4("\")("c")("o")("n"); finish_line;
+@.\\con@>
+print('Done.');
+
+@ Just before the index comes a list of all the changed modules, including
+the index module itself.
+
+@<Glob...@>=
+@!k_module:0..max_modules; {runs through the modules}
+
+@ @<Tell about changed modules@>=
+begin {remember that the index is already marked as changed}
+k_module:=1;
+out4("\")("c")("h")(" ");
+while k_module<module_count do
+ begin if changed_module[k_module] then
+ begin out_mod(k_module); out2(",")(" ");
+ end;
+ incr(k_module);
+ end;
+out_mod(k_module);
+out(".");
+end
+
+@ A left-to-right radix sorting method is used, since this makes it easy to
+adjust the collating sequence and since the running time will be at worst
+proportional to the total length of all entries in the index. We put the
+identifiers into 230 different lists based on their first characters.
+(Uppercase letters are put into the same list as the corresponding lowercase
+letters, since we want to have `$t<\\{TeX}<\&{to}$'.) The
+list for character |c| begins at location |bucket[c]| and continues through
+the |blink| array.
+
+@<Glob...@>=
+@!bucket:array[ASCII_code] of name_pointer;
+@!next_name: name_pointer; {successor of |cur_name| when sorting}
+@!c:ASCII_code; {index into |bucket|}
+@!h:0..hash_size; {index into |hash|}
+@!blink:array[0..max_names] of sixteen_bits; {links in the buckets}
+
+@ To begin the sorting, we go through all the hash lists and put each entry
+having a nonempty cross-reference list into the proper bucket.
+
+@<Do the first pass...@>=
+for c:=0 to 255 do bucket[c]:=0;
+for h:=0 to hash_size-1 do
+ begin next_name:=hash[h];
+ while next_name<>0 do
+ begin cur_name:=next_name; next_name:=link[cur_name];
+ if xref[cur_name]<>0 then
+ begin c:=byte_mem[cur_name mod ww,byte_start[cur_name]];
+ if (c<="Z")and(c>="A") then c:=c+@'40;
+ blink[cur_name]:=bucket[c]; bucket[c]:=cur_name;
+ end;
+ end;
+ end
+
+@ During the sorting phase we shall use the |cat| and |trans| arrays from
+\.{WEAVE}'s parsing algorithm and rename them |depth| and |head|. They now
+represent a stack of identifier lists for all the index entries that have
+not yet been output. The variable |sort_ptr| tells how many such lists are
+present; the lists are output in reverse order (first |sort_ptr|, then
+|sort_ptr-1|, etc.). The |j|th list starts at |head[j]|, and if the first
+|k| characters of all entries on this list are known to be equal we have
+|depth[j]=k|.
+
+@d depth==cat {reclaims memory that is no longer needed for parsing}
+@d head==trans {ditto}
+@d sort_ptr==scrap_ptr {ditto}
+@d max_sorts==max_scraps {ditto}
+
+@<Globals...@>=
+@!cur_depth:eight_bits; {depth of current buckets}
+@!cur_byte:0..max_bytes; {index into |byte_mem|}
+@!cur_bank:0..ww-1; {row of |byte_mem|}
+@!cur_val:sixteen_bits; {current cross reference number}
+stat@!max_sort_ptr:0..max_sorts;@+tats {largest value of |sort_ptr|}
+
+@ @<Set init...@>=stat max_sort_ptr:=0;@+tats
+
+@ The desired alphabetic order is specified by the |collate| array; namely,
+|collate[0]<collate[1]<@t$\cdots$@><collate[229]|.
+
+@<Glob...@>=@!collate:array[0..229] of ASCII_code; {collation order}
+
+@ @<Local variables for init...@>=
+@!c:ASCII_code; {used to initialize |collate|}
+
+@ We use the order $\hbox{null}<\.\ <\hbox{other characters}<\.\_<
+\.A=\.a<\cdots<\.Z=\.z<\.0<\cdots<\.9.$
+
+@<Set init...@>=
+collate[0]:=0; collate[1]:=" ";
+for c:=1 to " "-1 do collate[c+1]:=c;
+for c:=" "+1 to "0"-1 do collate[c]:=c;
+for c:="9"+1 to "A"-1 do collate[c-10]:=c;
+for c:="Z"+1 to "_"-1 do collate[c-36]:=c;
+collate["_"-36]:="_"+1;
+for c:="z"+1 to 255 do collate[c-63]:=c;
+collate[193]:="_";
+for c:="a" to "z" do collate[c-"a"+194]:=c;
+for c:="0" to "9" do collate[c-"0"+220]:=c;
+
+@ Procedure |unbucket| goes through the buckets and adds nonempty lists
+to the stack, using the collating sequence specified in the |collate| array.
+The parameter to |unbucket| tells the current depth in the buckets.
+Any two sequences that agree in their first 255 character positions are
+regarded as identical.
+
+@d infinity=255 {$\infty$ (approximately)}
+
+@p procedure unbucket(@!d:eight_bits); {empties buckets having depth |d|}
+var c:ASCII_code; {index into |bucket|}
+begin for c:=229 downto 0 do if bucket[collate[c]]>0 then
+ begin if sort_ptr>max_sorts then overflow('sorting');
+ incr(sort_ptr);
+ stat if sort_ptr>max_sort_ptr then max_sort_ptr:=sort_ptr;@;@+tats@;@/
+ if c=0 then depth[sort_ptr]:=infinity else depth[sort_ptr]:=d;
+ head[sort_ptr]:=bucket[collate[c]]; bucket[collate[c]]:=0;
+ end;
+end;
+
+@ @<Sort and output...@>=
+sort_ptr:=0; unbucket(1);
+while sort_ptr>0 do
+ begin cur_depth:=cat[sort_ptr];
+ if (blink[head[sort_ptr]]=0)or(cur_depth=infinity) then
+ @<Output index entries for the list at |sort_ptr|@>
+ else @<Split the list at |sort_ptr| into further lists@>;
+ end
+
+@ @<Split the list...@>=
+begin next_name:=head[sort_ptr];
+repeat cur_name:=next_name; next_name:=blink[cur_name];
+ cur_byte:=byte_start[cur_name]+cur_depth; cur_bank:=cur_name mod ww;
+ if cur_byte=byte_start[cur_name+ww] then c:=0 {we hit the end of the name}
+ else begin c:=byte_mem[cur_bank,cur_byte];
+ if (c<="Z")and(c>="A") then c:=c+@'40;
+ end;
+ blink[cur_name]:=bucket[c]; bucket[c]:=cur_name;
+until next_name=0;
+decr(sort_ptr); unbucket(cur_depth+1);
+end
+
+@ @<Output index...@>=
+begin cur_name:=head[sort_ptr];
+@!debug if trouble_shooting then debug_help;@;@+gubed@/
+repeat out2("\")(":");
+@.\\:@>
+ @<Output the name at |cur_name|@>;
+ @<Output the cross-references at |cur_name|@>;
+ cur_name:=blink[cur_name];
+until cur_name=0;
+decr(sort_ptr);
+end
+
+@ @<Output the name...@>=
+case ilk[cur_name] of
+normal: if length(cur_name)=1 then out2("\")("|")@+else out2("\")("\");
+@.\\|@>
+@.\\\\@>
+roman: do_nothing;
+wildcard: out2("\")("9");
+@.\\9@>
+typewriter: out2("\")(".");
+@.\\.@>
+othercases out2("\")("&")
+@.\\\&@>
+endcases;@/
+out_name(cur_name)
+
+@ Section numbers that are to be underlined are enclosed in
+`\.{\\[}$\,\ldots\,$\.]'.
+
+@<Output the cross-references...@>=
+@<Invert the cross-reference list at |cur_name|, making |cur_xref| the head@>;
+repeat out2(",")(" "); cur_val:=num(cur_xref);
+if cur_val<def_flag then out_mod(cur_val)
+else begin out2("\")("["); out_mod(cur_val-def_flag); out("]");
+@.\\[@>
+ end;
+cur_xref:=xlink(cur_xref);
+until cur_xref=0;
+out("."); finish_line
+
+@ List inversion is best thought of as popping elements off one stack and
+pushing them onto another. In this case |cur_xref| will be the head of
+the stack that we push things onto.
+
+@<Invert the cross-reference list at |cur_name|, making |cur_xref| the head@>=
+this_xref:=xref[cur_name]; cur_xref:=0;
+repeat next_xref:=xlink(this_xref); xlink(this_xref):=cur_xref;
+cur_xref:=this_xref; this_xref:=next_xref;
+until this_xref=0
+
+@ The following recursive procedure walks through the tree of module names and
+prints them.
+@^recursion@>
+
+@p procedure mod_print(p:name_pointer); {print all module names in subtree |p|}
+begin if p>0 then
+ begin mod_print(llink[p]);@/
+ out2("\")(":");@/
+@.\\:@>
+ tok_ptr:=1; text_ptr:=1; scrap_ptr:=0; init_stack;
+ app(p+mod_flag); make_output;
+ footnote(0); {|cur_xref| was set by |make_output|}
+ finish_line;@/
+ mod_print(rlink[p]);
+ end;
+end;
+
+@ @<Output all the module names@>=@+mod_print(root)
+
+@* Debugging.
+The \PASCAL\ debugger with which \.{WEAVE} was developed allows breakpoints
+to be set, and variables can be read and changed, but procedures cannot be
+executed. Therefore a `|debug_help|' procedure has been inserted in the main
+loops of each phase of the program; when |ddt| and |dd| are set to appropriate
+values, symbolic printouts of various tables will appear.
+
+The idea is to set a breakpoint inside the |debug_help| routine, at the
+place of `\ignorespaces|breakpoint:|\unskip' below. Then when
+|debug_help| is to be activated, set |trouble_shooting| equal to |true|.
+The |debug_help| routine will prompt you for values of |ddt| and |dd|,
+discontinuing this when |ddt<=0|; thus you type $2n+1$ integers, ending
+with zero or a negative number. Then control either passes to the
+breakpoint, allowing you to look at and/or change variables (if you typed
+zero), or to exit the routine (if you typed a negative value).
+
+Another global variable, |debug_cycle|, can be used to skip silently
+past calls on |debug_help|. If you set |debug_cycle>1|, the program stops
+only every |debug_cycle| times |debug_help| is called; however,
+any error stop will set |debug_cycle| to zero.
+
+@<Globals...@>=
+@!debug@!trouble_shooting:boolean; {is |debug_help| wanted?}
+@!ddt:integer; {operation code for the |debug_help| routine}
+@!dd:integer; {operand in procedures performed by |debug_help|}
+@!debug_cycle:integer; {threshold for |debug_help| stopping}
+@!debug_skipped:integer; {we have skipped this many |debug_help| calls}
+@!term_in:text_file; {the user's terminal as an input file}
+gubed
+
+@ The debugging routine needs to read from the user's terminal.
+@^system dependencies@>
+@<Set init...@>=
+@!debug trouble_shooting:=true; debug_cycle:=1; debug_skipped:=0; tracing:=0;@/
+trouble_shooting:=false; debug_cycle:=99999; {use these when it almost works}
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+gubed
+
+@ @d breakpoint=888 {place where a breakpoint is desirable}
+@^system dependencies@>
+
+@p @!debug procedure debug_help; {routine to display various things}
+label breakpoint,exit;
+var k:integer; {index into various arrays}
+begin incr(debug_skipped);
+if debug_skipped<debug_cycle then return;
+debug_skipped:=0;
+loop@+ begin print_nl('#'); update_terminal; {prompt}
+ read(term_in,ddt); {read a debug-command code}
+ if ddt<0 then return
+ else if ddt=0 then
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: ddt:=0;@\
+ end
+ else begin read(term_in,dd);
+ case ddt of
+ 1: print_id(dd);
+ 2: print_text(dd);
+ 3: for k:=1 to dd do print(xchr[buffer[k]]);
+ 4: for k:=1 to dd do print(xchr[mod_text[k]]);
+ 5: for k:=1 to out_ptr do print(xchr[out_buf[k]]);
+ 6: for k:=1 to dd do
+ begin print_cat(cat[k]); print(' ');
+ end;
+ othercases print('?')
+ endcases;
+ end;
+ end;
+exit:end;
+gubed
+
+@* The main program.
+Let's put it all together now: \.{WEAVE} starts and ends here.
+@^system dependencies@>
+
+The main procedure has been split into three sub-procedures in order to
+keep certain \PASCAL\ compilers from overflowing their capacity.
+@^split procedures@>
+
+@p procedure Phase_I;
+begin @<Phase I:...@>;
+end;
+@#
+procedure Phase_II;
+begin @<Phase II:...@>;
+end;
+@#
+begin initialize; {beginning of the main program}
+print_ln(banner); {print a ``banner line''}
+@<Store all the reserved words@>;
+Phase_I; Phase_II;@/
+@<Phase III:...@>;
+@<Check that all changes have been read@>;
+end_of_WEAVE:
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@t\4\4@>{here files should be closed if the operating system requires it}
+@<Print the job |history|@>;
+end.
+
+@ @<Print statistics about memory usage@>=
+print_nl('Memory usage statistics: ',
+ name_ptr:1,' names, ', xref_ptr:1,' cross references, ',
+ byte_ptr[0]:1);
+for cur_bank:=1 to ww-1 do print('+',byte_ptr[cur_bank]:1);
+ print(' bytes;');
+print_nl('parsing required ',max_scr_ptr:1,' scraps, ',max_txt_ptr:1,
+ ' texts, ',max_tok_ptr:1,' tokens, ', max_stack_ptr:1,' levels;');
+print_nl('sorting required ',max_sort_ptr:1, ' levels.')
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_nl('(No errors were found.)');
+harmless_message: print_nl('(Did you see the warning message above?)');
+error_message: print_nl('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_nl('(That was a fatal error, my friend.)');
+end {there are no other cases}
+
+@* System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{WEAVE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+
+@* Index.
+If you have read and understood the code for Phase III above, you know what
+is in this index and how it got here. All modules in which an identifier is
+used are listed with that identifier, except that reserved words are
+indexed only when they appear in format definitions, and the appearances
+of identifiers in module names are not indexed. Underlined entries
+correspond to where the identifier was declared. Error messages, control
+sequences put into the output, and a few
+other things like ``recursion'' are indexed here too.
diff --git a/Build/source/texk/web2c/web2c/ChangeLog b/Build/source/texk/web2c/web2c/ChangeLog
new file mode 100644
index 00000000000..b6cdad03723
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/ChangeLog
@@ -0,0 +1,1108 @@
+2005-07-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * convert.bat: New file, .bat version of convert script.
+
+ * texmf.defines: Add secondsandmicros defn. From Martin Schröder
+ <martin@oneiros.de>.
+
+ * coerce.h: Remove support for pdfxtex. From Martin Schröder
+ <martin@oneiros.de>.
+
+ * common.defines: Remove support for pdfxtex. From Martin
+ Schröder <martin@oneiros.de>.
+
+ * splitup.c: Remove support for pdfxtex. From Martin Schröder
+ <martin@oneiros.de>.
+
+ * convert: Remove support for pdfxtex. From Martin Schröder
+ <martin@oneiros.de>.
+
+2005-06-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Replace ac_include with kpse_include. From Peter
+ Breitenlohner.
+
+2005-06-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * common.defines: Add xreallocarray(). Requested by Hartmut
+ Henkel <hartmut_henkel@gmx.de>.
+
+2005-06-21 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * kps.c: Instead of using an implicit definition of toupper,
+ include extra headers and use TOUPPER. Reported by Albert Chin
+ <china@thewrittenword.com>.
+
+2005-04-12 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * coerce.h (getjobname): Take a strnumber parameter, the string to
+ return if the --jobname switch wasn't given.
+ * texmf.defines (getjobname): Accepts a parameter now.
+ This is part of a group of changes that fix pdftex bug 302.
+ http://sarovar.org/tracker/?func=detail&atid=493&aid=302&group_id=106
+
+2004-07-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines (print): Remove forward declaration.
+ (setupcharset): Remove declaration, function has been removed.
+ (readtcxfile): Add declaration, new function.
+
+2004-07-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Remove redundant -o $@ from rules using
+ $(build_link_command). From Thomas Esser.
+
+2004-07-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Include ../make/cross.mk. Add explicit rules to
+ cross-build the objects we used. We could define a suffix rule
+ instead, but there aren't that many.
+
+ * kps.c (uppercasify): Fix.
+
+2004-06-29 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Remove use of ../lib/lib.a and of libkpathsea.
+
+ * main.c (main): Remove use of kpse_set_progname.
+ (yyerror): Moved to web2c.l.
+
+ * splitup.c: Remove use of kpse_set_progname. Clean up
+ comma-expression at end.
+
+ * web2c.h: Add declarations of get_string_literal(),
+ get_single_char(), get_result_type(), remove declaration of yytext
+ and its #ifdefs.
+
+ * web2c.l (get_string_literal): New function, helper for code in
+ web2c.y.
+ (get_single_char): New function, helper for code in web2c.y.
+ (get_result_type): New function, helper for code in web2c.y.
+ (yyerror): Define here, so it can reference yytext.
+
+ * web2c.y: Use get_string_literal(), get_single_char(),
+ get_result_type() to replace references to yytext. This way, this
+ file doesn't need to know the exact type of yytext.
+
+ * fixwrites.c: Change uexit to exit.
+
+ * kps.c: New file, with helper functions so that we don't have to
+ link with libkpathsea.
+
+2004-05-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * fixwrites.c: Remove code related to -oem option.
+
+2004-05-08 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: Change TEXPOOLNAME, TEXENGINENAME to
+ TEXMFPOOLNAME, TEXMFENGINENAME.
+
+2004-04-17 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * fixwrites.c (main): Take argument of stringcast into account
+ (otherwise the format string is incomplete).
+
+2004-04-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: Add TEXENGINENAME to constants.
+
+ * fixwrites.c (main): Recognize 'poolname', 'formatengine', and
+ 'stringcast...' as strings.
+
+2004-04-08 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * cvtbib.sed: Break init of jmp9998 out from init of jmp32. The
+ former is needed earlier in the program. Reported by Sven Luther
+ <luther@dpt-info.u-strasbg.fr>.
+
+2004-03-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * common.defines: Add declaration of floor for dvitomp. From
+ Hartmut Henkel <hartmut_henkel@gmx.de>.
+
+2004-03-22 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: "forward" declaration of print.
+
+2004-03-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * convert: Add aleph.
+
+ * splitup.c: Modifications for Aleph.
+
+ * common.defines: Add ALEPHHELP, EOMEGAHELP.
+
+2004-02-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * splitup.c: Add support for pdfxTeX.
+
+ * convert: Add support for pdfxTeX.
+
+ * common.defines: Add PDFXTEXHELP.
+
+ * common.defines: Add kpsefontmapformat.
+
+ * coerce.h: Add support for pdfxTeX.
+
+2003-02-17 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * convert: We no longer have more than 10 basefiles.
+
+2003-02-16 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * web2c.l: Compensate for the possibility that a linebreak can
+ happen between the ( and ' of ifdef('FOO') and friends.
+
+2003-02-07 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * splitup.c: e-Omega support.
+
+ * convert: e-Omega support.
+
+2002-11-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * splitup.c: Include kpathsea/getopt.h for the option parsing.
+
+2002-11-11 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * common.defines: Add kpseresetprogramname.
+
+2002-10-20 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: Add define for getjobname.
+
+ * coerce.h: Correct declaration of makefullnamestring, add
+ declaration for getjobname.
+
+2002-10-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * web2c.y (PROGRAM_HEAD): Rule was missing terminating ';'.
+
+ * Makefile.in: Disable parallel makes. TeXlive merge.
+
+2002-04-01 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * convert: Add options to splitup to retain the current behaviour.
+
+ * splitup.c: Make the number of lines at which we split and
+ whether a *ini.c file is generated controlled by options.
+
+2002-03-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * splitup.c: Generate a temporary filename from the name of the
+ program we're splitting, as we do for all other output files.
+ This allows parallel makes. Reported by Martin Schröder
+ <ms@artcom-gmbh.de>.
+
+2001-11-18 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * web2c.y: Changes to keep C++ compilers from choking.
+
+ * web2c.l: Changes to keep C++ compilers from choking.
+
+ * web2c.h: Changes to keep C++ compilers from choking.
+
+ * main.c: Changes to keep C++ compilers from choking.
+
+ * common.defines: Add support for filename recorder.
+
+2001-11-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * common.defines (stringcast): Added since it was added to
+ cpascal.h.
+
+ * common.defines (xmallocarray): Added.
+
+ * texmf.defines (xmallocarray): Removed.
+
+2001-10-30 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: Add defines for source-specials supporting
+ functions.
+
+ * coerce.h [TeX]: Prototypes for some source-specials supporting
+ functions in texmfmp.c. These functions should probably be moved
+ into tex.ch, though.
+
+2001-10-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * fixwrites.c [OEM]: Append "Oem" to emitted putc, Fputs, fprintf.
+
+ * common.defines: Add kpsesetprogramname.
+
+2001-10-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * common.defines (kpsewebformat, usagehelp): Defines added.
+
+2001-09-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: Remove vfbopenin, define in pdftex.defines.
+
+2000-08-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * fixwrites.c (main): Prevent cp from pointing outside buf.
+ Found by Greg McGary <greg@mcgary.org>.
+
+2000-05-03 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * coerce.h [MP]: MP uses poolASCIIcode where everything else uses
+ packedASCIIcode. Sigh. After "C.M. Connelly" <c@eskimo.com>.
+
+1999-02-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: Add translatefilename to the variables.
+
+ * convert: We do need to specify the names of the tex/mf family
+ members.
+
+1999-02-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * coerce.h: New file, combines coerce.mf and coerce.tex. Also
+ contains some declarations.
+
+ * coerce.mf, coerce.tex: Removed.
+
+ * convert: Account for unification of coerce.tex and coerce.mf
+ into coerce.h.
+
+1999-02-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * splitup.c (main): Remove __cdecl, from Fabrice.
+
+ * fixwrites.c (main): Remove __cdecl, from Fabrice.
+
+1999-01-27 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: Add definition for getrandomseed.
+
+ * splitup.c (main): Add __cdecl, from Fabrice.
+
+ * fixwrites.c (main): Add __cdecl, from Fabrice.
+
+1999-01-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * splitup.c: Add support for pdfTeX, from Thomas Esser.
+
+ * convert: Add support for pdfetex, from Thomas Esser.
+
+ * common.defines: Define PDFETEXHELP to support pdfeTeX. From
+ Thomas Esser.
+
+1999-01-14 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: Remove opennameok, add openinnameok,
+ openoutnameok.
+
+1999-01-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Rename kpathsea.make to kpathsea.mk.
+
+1999-01-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Change of ../make/*.make to ../make/*.mk.
+
+1998-12-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * fixwrites.c: Correct parsion of -t option (use STREQ).
+
+1998-09-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * fixwrites.c: Fix parsing of '-t' option, found by Fabrice
+ Popineau.
+
+1998-07-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * texmf.defines: Rename openoutnameok to opennameok.
+
+Sun May 31 17:11:26 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * common.defines: Rename toint to intcast, because SCO usurped the
+ former. Spotted by Jonathan Chen <jonc@pinnacle.co.nz>.
+
+Fri Feb 20 17:14:08 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * fixwrites.c (main): Use kpse_set_program_name instead of
+ kpse_set_progname.
+
+Tue Feb 10 17:55:48 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * web2c.h: Add prototypes for most functions being declared.
+ Spotted by Andreas Scherer <Andreas.Scherer@Pobox.Com>
+
+Sat Dec 13 23:04:50 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmf.defines: Add define for flushdvi.
+
+Fri Dec 12 10:20:08 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in (y_tab.c y_tab.h): Don't abort make if the 'test -f'
+ fails.
+
+ * web2c.y (gen_function_head): Switch to using HAVE_PROTOTYPES
+ from __STDC__.
+
+Fri Nov 21 15:20:10 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * convert: Conversion of tex results in at least tex2.c, similar
+ for the others.
+
+ * web2c.y (do_proc_args, gen_function_head): Generating different
+ C files depending on whether __STDC__ is defined is not a good
+ idea, it makes the number of files produced by splitup
+ unpredictable.
+
+Sat Nov 15 21:19:25 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmf.defines: Remove the additions for PDFTeX. These will now
+ be picked up from an external file.
+
+ * splitup.c (main): Add support for Omega.
+
+ * fixwrites.c (main): Changes for Omega.
+
+ * convert: Adapt for Omega. When converting footex, convert now
+ looks for footexdir/footex.defines, and adds this to the usual
+ defines if found.
+
+ * common.defines: Add some definitions for Omega.
+
+Fri Nov 14 16:46:03 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * texmf.defines: Additional defines for PDFTeX.
+
+ * splitup.c (main): define PDFTeX when splitting PDFTeX.
+
+ * common.defines: Add PDFTEXHELP.
+
+Tue Oct 21 23:36:53 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in: Correction to handling of y.tab.[hc].
+
+Mon Oct 20 08:42:48 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * splitup.c: Add e-TeX and pdftex support.
+
+ * common.defines: Include e-TeX support.
+
+ * Makefile.in, main.c, web2c.l: Replace y.tab.* with y_tab.* for
+ MS-DOS' sake. From Fabrice Popineau.
+
+Fri Oct 17 14:28:46 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * convert: Adapt for etex/pdftex.
+
+Thu Oct 16 21:30:47 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * convert: After the last changes to tex.ch, we no longer have a
+ tex2.c.
+
+ * convert: Remove reference to cvttex.sed.
+ * cvttex.sed: Obsolete. From Peter Breitenlohner
+ <peb@mppmu.mpg.de>.
+
+Thu Oct 2 12:56:41 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * common.defines (isprint): New function, used in tex.ch. From
+ Bernd Raichle <raichle@informatik.uni-stuttgart.de>.
+
+ * web2c.y (do_proc_args, gen_function_head): Use prototyped
+ function declarations and definitions when __STDC__ is defined.
+ After the patch by Ezra Peisach <epeisach@auriga.rose.brandeis.edu>.
+
+Tue Sep 30 11:12:47 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * web2c.h: Fix for the unsigned char yytext[] bug. (From
+ Thomas Esser <te@informatik.uni-hannover.de>)
+
+Sun Feb 16 16:06:10 1997 Karl Berry <karl@cs.umb.edu>
+
+ * fixwrites.c: Replace matching bracket, not first one.
+ From: John Plaice <plaice@iad.ift.ulaval.ca>.
+
+Mon Jan 20 17:30:21 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Version 7.0.
+
+Sun Dec 29 17:12:17 1996 Karl Berry <karl@cs.umb.edu>
+
+ * convert: Don't assume . is in PATH for finding the web2c programs.
+ From Fabrice.
+
+Sun Dec 8 16:39:09 1996 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.l (yywrap): Give a prototype, just in case.
+ (YY_SKIP_YYWRAP): Define, to avoid flex declaring it.
+
+ * common.defines (FOPENRBINMODE): New define for WIN32.
+ (standardinput, standardoutput): Remove, these are in bibtex.ch now.
+ From: Fabrice POPINEAU <popineau@esemetz.ese-metz.fr>.
+
+Fri Dec 6 17:47:51 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines ({ocp,ofm}openin): New functions for Omega.
+ From: John Plaice <plaice@iad.ift.ulaval.ca>.
+
+Tue Dec 3 15:05:11 1996 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.l (yywrap): Give our own definition.
+
+Mon Oct 14 17:33:27 1996 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.h (max): #undef before defining.
+
+ * splitup.c: Use stdin instead of in.
+
+ * common.defines (makebinaryfile): New function.
+
+Sat Aug 10 15:29:47 1996 Karl Berry <karl@cs.umb.edu>
+
+ * fixwrites.c: Have to have another special case for
+ kpathseaversionstring a la versionstring.
+
+Sun Aug 4 15:59:48 1996 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (kpathseaversionstring): A new ``var''.
+
+Sat Aug 3 17:30:22 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (web2c): Use $(kpathsea_link).
+
+Fri Jul 26 15:47:44 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Remove co.make.
+
+Sun Jun 9 13:33:34 1996 K. Berry <kb@cs.umb.edu>
+
+ * Makefile.in (fixwrites, splitup, regfix): Use $(kpathsea_link).
+
+Wed Feb 21 09:47:05 1996 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (kpseopenfile): Rename from xopenfile.
+
+Sat Feb 17 15:25:51 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines (openoutnameok): Declare this new function.
+
+Fri Dec 29 17:15:54 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: misc.make is now clean.make.
+
+Sun Dec 10 15:36:59 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (kpsefindmft): New decl.
+
+Fri Dec 1 19:17:37 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (MFTHELP): Oops, restore this, it was MFHELP that
+ was supposed to go away.
+
+Fri Nov 24 17:33:36 1995 Karl Berry <karl@cs.umb.edu>
+
+ * main.c (yyerror): Print last token as a character as well as a
+ number.
+
+ * convert: For tex, replace xl(r)paren with ()), for mltex.
+ * cvttex.sed: New file.
+
+Fri Nov 17 13:42:19 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (libcfree): Rename from cfree. From Ulrik.
+ (TEXHELP, MFHELP): These aren't needed, since used in texmfmp.c.
+
+Sun Nov 12 16:02:24 1995 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.h (YYTEXT_ARRAY): This should really be
+ YYTEXT_POINTER. Found by Tim Pattison et al.
+
+Sat Sep 30 15:05:32 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines (system): Add this.
+
+Sat Sep 23 15:20:41 1995 Karl Berry <karl@cs.umb.edu>
+
+ * main.c (indent_line): May as well toss this. Just call `new_line'.
+ * web2c.y: Change calls here too.
+
+ * web2c.y (CONST_DEC): Ensure #define ends up in column 1.
+
+Sat Sep 9 16:21:44 1995 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.l (endifn): Add `not' to the comment.
+
+Thu Aug 31 17:46:38 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mfmp.defines: New file.
+ * convert (more_defines): Use it for mf and mp.
+
+Tue Aug 22 14:11:40 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Include rdepend.make and depend.make.
+
+Mon Aug 21 16:43:33 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (FOPENRMODE, fopen): Define this.
+
+Sun Aug 6 19:33:28 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (xfclose): Declare this.
+
+Sat Jul 29 13:14:39 1995 Karl Berry <karl@cs.umb.edu>
+
+ * convert: Use new name texmfmp.h.
+
+ * common.defines (DVITOMPHELP): New constant.
+
+Fri Jul 28 15:07:50 1995 Karl Berry <karl@cs.umb.edu>
+
+ * convert: If $pascalfile is not readable, look for it in srcdir.
+ * Makefile.in: Use ac_include ../../make, not /w/make.
+ From Greg.
+
+ * web2c.y: Use yyerror instead of FATAL directly.
+
+Sat Jul 22 17:01:25 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines: Move all the kpse_*_format's here.
+
+ * texmf.defines (kpsempformat, etc.): Define these new file formats.
+ * splitup.c: Can split mp now.
+ * convert: mp is mostly like mf.
+
+Fri Jul 21 15:46:36 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines (undumpuppercheckthings): Add this procedure.
+
+Thu Jul 20 14:24:07 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines (put[24]bytes): Declare these.
+
+ * web2c.y (SUBRANGE_CONSTANT): Allow even an undefined identifier
+ as a bound, so we don't even have to change type definitions.
+
+Wed Jul 19 15:42:44 1995 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.y (SUBRANGE_CONSTANT): Allow a variable as a
+ bound. (Translates to the integer type.)
+ (compute_array_bounds): But complain here if a bound is a variable.
+
+ * main.c, splitup.c, fixwrites.c: Call kpse_set_progname.
+
+Thu Jul 13 17:36:44 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines (setupcharset): Rename from below.
+
+Sun Jul 9 17:33:58 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines (setupxchrandisprintable): New procedure.
+
+Sat Jul 8 13:47:29 1995 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.y (CONSTANT_EXPRESS, CONSTANT_FACTOR): New nonterminals to
+ allow expressions as const values. From Nelson.
+
+ * common.defines (XTALLOC): New function.
+ (BIBXRETALLOC): New procedure.
+
+Wed Jun 21 15:36:45 1995 Karl Berry <karl@cs.umb.edu>
+
+ * fixwrites.c (remove_newline): If we lose a newline, output the
+ magic @error@ string.
+
+ * common.defines (fprintf, printf): Remove these.
+
+ * texmf.defines (undumpcheckedthings): New procedure.
+
+Fri Jun 16 11:46:45 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines (ipcpage): New procedure.
+
+Sat Jun 10 19:25:52 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines (fmemoryword): New type.
+
+Sun Jun 4 14:57:28 1995 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.y: ANSIfy output in coerce file.
+ * *.c: ANSIfy functions.
+ From Andreas Scherer.
+
+Fri Jun 2 19:42:58 1995 Karl Berry <karl@cs.umb.edu>
+
+ * texmf.defines (setupboundvariable): Declare this.
+
+Mon May 29 16:25:44 1995 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.l (ifndef, endifn): Add support for this. Remove void casts.
+ From: Giuseppe Ghibo' <ghibo@galileo.polito.it>.
+ * splitup.c: Check for #ifndef here as well.
+
+Sat May 27 13:51:09 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (atou, strtol): Add these.
+
+Fri May 26 17:38:45 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (addressofint): Rename to addressof.
+
+Fri May 19 19:26:38 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (findsuffix): Add this.
+
+Tue May 16 19:49:20 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (removesuffix): Add this.
+
+Sun May 14 10:59:23 1995 Karl Berry <karl@fosse>
+
+ * texmf.defines (bytefile, wordfile): The original Pascal
+ definitions will work, so remove.
+
+ * fixwrites.c: Include c-pathmx.h.
+
+Tue May 9 15:58:08 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (*HELP): Define all of these.
+
+Sat May 6 11:16:47 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (parsearguments): Remove this.
+
+Fri May 5 16:01:18 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (usage): Add this.
+
+ * web2c.y: Restore old token order, since - and + depend on it.
+
+Thu May 4 19:30:27 1995 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.y (PROGRAM): Output a #define of the program name,
+ uppercased, before anything else.
+ * main.c (main): Remember the program name.
+ * common.defines (POOLTYPE_HELP): Define this.
+
+ * main.c: Use fputs where appropriate.
+ (initialize): Use xfopen.
+
+Fri Apr 28 11:51:42 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (alphafile): No longer needed.
+ * web2c.y (FILE_TYPE): Use `text' instead of file_ptr.
+
+ * cvtbib.sed: Insert the setjmp stuff before line 1, instead of
+ appending after. (The first line of bibtex.c is an #ifdef now.)
+
+ * web2c.y (PROGRAM_FILE_PART): Allow no file list at all.
+
+ * convert: Echo the mv, so they can see exactly what the dregs are.
+
+Tue Apr 25 15:53:25 1995 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.y (PROGRAM_FILE{,_LIST}): Define these to ignore the files
+ in the Pascal program statement.
+
+Sat Apr 22 13:23:22 1995 Karl Berry <karl@cs.umb.edu>
+
+ * cvtbib.sed: main_body is now mainbody.
+
+ * fixwrites.c: Print nameoffile as a string, not a character.
+
+ * web2c.y (BODY): Use mainbody instead of main_body, for the sake
+ of tex, where the main program is procedurized.
+ (BLOCK): Never output `coerce.h'. What is this left over from?
+ Also, do output a newline after the {.
+ (IF_STATEMENT): Don't output a newline after the condition.
+
+ * texmf.defines (kpsetexpoolformat): Define this.
+ (xmallocarray): And this.
+
+Fri Apr 21 11:19:27 1995 Karl Berry <karl@cs.umb.edu>
+
+ * splitup.c: Use `mfini' instead of `imf', etc.
+
+ * Makefile.in (programs): Remove regfix.
+
+ * splitup.c: Define INI and INIMF and INITEX in the output.
+
+Tue Apr 18 13:44:37 1995 Karl Berry <karl@cs.umb.edu>
+
+ * splitup.c (MAXLINES): Increase to 10000.
+
+ * common.defines (cfree): Declare this.
+
+ * splitup.c (main): Don't output forever if input is malformed.
+
+Mon Apr 17 11:09:42 1995 Karl Berry <karl@cs.umb.edu>
+
+ * convert: Add rules for mf.
+
+Sun Apr 16 11:10:04 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (xstrdup): Define this.
+
+Fri Apr 14 15:32:21 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (tfmtemp): Define this.
+
+Tue Apr 4 17:01:28 1995 Karl Berry <karl@cs.umb.edu>
+
+ * main.c (initialize): exit 1 if the coerce file can't be opened.
+
+ * convert (midcmd): Add extra command for bibtex.
+
+ * common.defines (kpse{bib,bst}format): Define these.
+
+Sat Mar 18 17:24:10 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (input): Define this as a const.
+ (kpsefindvf): Also use this in dvicopy.
+
+Fri Mar 17 14:22:18 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (web2c.[co]): Rename to main.[co], to avoid GNU make
+ trying to make web2c.c from web2c.y.
+
+Tue Feb 21 13:42:45 1995 Karl Berry <karl@cs.umb.edu>
+
+ * convert: Mention that the bad cfile was preserved.
+
+ * common.defines (output): New variable.
+
+Mon Feb 20 15:24:54 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (xopenfile, kpsefind{mf,tex}): Define these.
+
+Sat Jan 7 14:52:24 1995 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (testreadaccess, etc.): Remove obsolete definitions.
+ (kpseinitprog): Add this.
+
+Mon Dec 19 13:21:39 1994 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (kpsefindfile): Add this.
+ (kpse{pk,vf}format): And these.
+
+Sun Dec 18 16:51:07 1994 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (flush): Remove this, add fflush.
+
+Sat Dec 17 15:36:38 1994 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.c (my_output): Try omitting spaces after (, too.
+
+Tue Nov 15 11:47:11 1994 Karl Berry <karl@cs.umb.edu>
+
+ * web2c.c (my_output): Don't output an extra space after [.
+
+ * common.defines (kpsesetprogname): Add this.
+
+Mon Nov 14 11:42:10 1994 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines (argv): Variable now.
+ (cmdline): New function.
+ (basename, makesuffix, makesuffixchar): Add these.
+ (cstring): Rename from ccharpointer;
+ (strcat, strcpy): Use these instead of v...
+
+ * Makefile.in (web2c.o): Depend on web2c.c.
+
+ * web2c.c (yyerror): Put @error@ in the output file on error.
+ * convert: If the output file contains @error@, delete it.
+
+Sun Nov 13 16:19:12 1994 Karl Berry <karl@cs.umb.edu>
+
+ * common.defines: Remove the ...PATH and ...PATHBIT constants.
+
+Mon Oct 10 15:32:40 1994 Karl Berry <karl@cs.umb.edu>
+
+ * convert: Check if the output file is nonempty, rather than the
+ exit status of the pipeline. Rewrite argument parsing.
+
+ * Makefile.in (prog_cflags): Define this.
+ (web2c): Include LEXLIB here.
+
+Sun Sep 25 16:51:32 1994 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: ac_include changes, etc.
+
+Thu May 26 20:28:26 1994 Karl Berry (karl@cs.umb.edu)
+
+ * regfix.c (main) [!REGFIX]: Use getchar and putchar instead of
+ fgets and fputs.
+
+Mon Apr 18 17:34:50 1994 Karl Berry (karl@ra.cs.umb.edu)
+
+ * web2c.h (DECLARE_YYTEXT): No need for this.
+
+Mon Feb 21 14:14:30 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: srcdir changes from simon.
+
+ * web2c.h (alloca): Do not declare, since whatever uses it (i.e.,
+ bison output) should declare it, and we want to avoid conflicts.
+
+Wed Feb 2 11:00:09 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Mon Jan 24 07:34:29 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Sat Dec 4 17:25:08 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (web2c): Must link with the flex library now.
+
+Sat Nov 6 13:40:20 1993 Karl Berry (karl@cs.umb.edu)
+
+ * fixwrites.c (main): Output strings for xdig, xext, and xhyf.
+ From alonz@cs.Technion.AC.IL.
+
+Sun Oct 3 13:28:56 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (commono): kpathsea.a has its own variable now.
+ (*clean): Include standard targets.
+ (program): New variable.
+ (all): Use it.
+
+Tue May 25 14:38:40 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Most files: Change exit calls to use EXIT_SUCCESS and EXIT_FAILURE.
+
+Fri May 21 11:58:47 1993 Karl Berry (karl@cs.umb.edu)
+
+ * fixwrites.c (main): Return EXIT_SUCCESS_CODE instead of using uexit.
+ * splitup.c (main): Likewise.
+ * regfix.c (main) [!REGFIX]: Likewise.
+
+ * fixwrites.c (whole): Declare return type.
+
+ * web2c.lex (ifdef): Remove unused variable `my_routine'.
+
+ * web2c.yacc (fixup_var_list): Add parens to avoid gcc warning.
+
+ * web2c.c (main): Declare as void, since we have to use uexit here.
+
+Fri May 14 14:23:01 1993 Karl Berry (karl@cs.umb.edu)
+
+ * web2c.yacc (gen_function_head, PROC): Output the return type on
+ a line of its own, so that we can make TAGS files.
+
+ * web2c.yacc: Omit some needless parentheses and casts to void in
+ the web2c output.
+
+Thu May 13 16:53:47 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Not quite all of Bill's changes below have been merged (not the
+ new descrip.mms or convert.com files, in particular), but just to
+ get the gist, I'll include the whole log.
+
+Tue Mar 23 10:13:17 1993 Bill Barabash (barabash@ops5.lmo.dec.com)
+
+ * descrip.mms : new file. This is the VMS equivalent of a
+ makefile.
+
+ * web2c.h : added function declarations for add_to_table,
+ search_table, yyerror, yylex, yyparse, and alloca.
+
+ * web2c.c, fixreg.c, regfix.c, splitup.c : declare argc and gargv,
+ which are referenced by config.h, to prevent VMS linker warnings.
+
+ * web2c.c, web2c.lex : On VMS, include "y_tab.h" instead of "y.tab.h"
+ since on VMS a file basename cannot contain a '.'.
+
+ * splitup.c : On VMS use run-time library routine "delete" instead
+ of "unlink"; declare function read_line; initialize file-pointer "in"
+ dynamically.
+
+ * fixwrites.c : Fix translation of xchr. It was translating
+ "xchr [ vector [ element ] ]" to "Xchr ( vector [ element ) ]"
+ in BibTeX; the fix is to ensure that open/close brackets are
+ balanced.
+
+ Sun Feb 21 08:28:39 1993 Karl Berry (karl@cs.umb.edu)
+
+Sun May 9 10:10:58 1993 Karl Berry (karl@cs.umb.edu)
+
+ * fixwrites.c (main): Exit with EXIT_SUCCESS_CODE, not zero.
+
+ * Makefile.in (commonh): Remove $(srcdir) for paths.h.
+ (commono): Add kpathsea library.
+
+Fri Apr 30 15:21:33 1993 Karl Berry (karl@cs.umb.edu)
+
+ * fixwrites.c: Do %c for patgen uses of `buf'.
+
+Sun Apr 18 13:46:50 1993 Karl Berry (karl@cs.umb.edu)
+
+ * web2c.yacc (P_F_DEC_PART): Remove empty case.
+ * Makefile.in (y.tab.c): Only one s/r conflict now,
+
+Fri Apr 16 19:29:56 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (LEX_OUTPUT_ROOT): New variable, so DOS people can
+ get lexyy automatically. Change targets.
+
+Sat Mar 13 12:11:02 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (CPPFLAGS): Add @DEFS@, for -DHAVE_CONFIG_H.
+
+Sun Feb 28 10:58:12 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (clean): Remove lex/yacc output here, instead of at
+ distclean.
+
+Sun Feb 21 08:28:39 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Version 5.851d.
+
+Tue Feb 16 17:57:37 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (install-exec, install-data): New targets.
+
+Fri Feb 12 07:35:56 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Don't remove y.* and lex.*, that loses
+ the dist files.
+
+Tue Feb 9 17:02:53 1993 Karl Berry (karl@red.cs.umb.edu)
+
+ * web2c.h (yyerror): Don't bother to declare this.
+
+Tue Feb 9 08:49:18 1993 Karl Berry (karl@cs.umb.edu)
+
+ * web2c.c (yyerror): Declare as int, not void.
+ Remove various casts to void.
+
+Fri Jan 29 11:38:41 1993 Karl Berry (karl@cs.umb.edu)
+
+ * fixwrites.c (main): Don't look for the rest of the supposed
+ string constant if we're doing versionstring, and allow it to be
+ first in the write statement.
+
+Thu Jan 28 09:24:10 1993 Karl Berry (karl@cs.umb.edu)
+
+ * fixwrites.c: Remove casts to void, both in the output and in the
+ source.
+ (main): If the arg is versionstring, use %s instead of %ld.
+
+Mon Jan 25 10:11:40 1993 Karl Berry (karl@cs.umb.edu)
+
+ * web2c.yacc (SIMPLE_TYPE): On reflection, cast to unsigned long;
+ rewrite to use signed types in preference to unsigned. Sigh.
+
+Sun Jan 24 11:39:43 1993 Karl Berry (karl@cs.umb.edu)
+
+ * web2c.yacc (SIMPLE_TYPE): Cast upper_bound to unsigned to avoid
+ compiler bugs.
+
+Sat Jan 16 08:42:07 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (realclean): Same as distclean again; remove lex and
+ yacc output here.
+
+Sun Jan 3 13:35:27 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Remove Makefile.
+
+Fri Jan 1 15:48:26 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (web2c): Use shell variable lexlib, not make variable.
+
+Sun Dec 13 13:53:38 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (web2c): Don't bother to link with the flex library.
+
+ * Makefile.in (realclean): Remove the lex and yacc output here.
+
+Sat Dec 12 15:27:50 1992 Karl Berry (karl@cs.umb.edu)
+
+ * web2c.c: Include y.tab.h instead of web2cy.h.
+
+ * Makefile.in: Rewrite from Makefile.
+
+Sat Dec 5 15:29:38 1992 Karl Berry (karl@cs.umb.edu)
+
+ * web2c.yacc (SIMPLE_TYPE): Rewrite to use unsigned types where
+ possible; in particular, `small_number' being defined as `schar'
+ can produce unportable .fmt files.
+
+Fri Sep 4 09:05:33 1992 Karl Berry (karl@hayley)
+
+ * Makefile (extraclean): new target.
+ (distclean): don't remove backup files etc. here.
+
+Fri Jul 24 16:56:12 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Makefile (fixwrites, splitup, regfix): include CPPFLAGS.
+
+Thu Jul 2 16:10:37 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CPPFLAGS): new variable
+ (.c.o): use it.
+ (cflags): change to CFLAGS.
+
+Tue Jun 23 10:18:00 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CC): default is gcc -posix again.
+
+Thu May 14 19:22:45 1992 Karl Berry (karl@claude.cs.umb.edu)
+
+ * Version 5.851c.
+
+Sat Apr 25 09:15:13 1992 Karl Berry (karl@hayley)
+
+ * Makefile (libs): new variable to abbreviate `../lib/lib.a ($LIBS)'.
+
+Thu Apr 23 08:17:14 1992 Karl Berry (karl@hayley)
+
+ * Makefile (web2cy.h): new target, depends on web2cy.c (from Andreas).
+
+ * web2c.c (main): fclose coerce.h.
+
+Thu Apr 16 13:49:36 1992 Karl Berry (karl@ra.cs.umb.edu)
+
+ * Version 5.851b.
+
+Wed Apr 8 15:38:41 1992 Karl Berry (karl@hayley)
+
+ * Makefile (regfix,fixwrites,splitup): link with lib.a.
+ * {regfix,fixwrites,splitup,web2c}.c: use uexit, not exit.
+
+Fri Apr 3 09:56:27 1992 Karl Berry (karl at hayley)
+
+ * Version 5.851a.
+
+Thu Apr 2 16:32:56 1992 Karl Berry (karl@hal)
+
+ * Makefile (.SUFFIXES): add rule for .c.o.
+
+Thu Apr 2 13:38:45 1992 Karl Berry (karl at ds1.cs.umb.edu)
+
+ * web2c.yacc (labs): rename to `my_labs', to avoid conflict with
+ system `labs'.
+
+Sat Mar 28 16:36:58 1992 Karl Berry (karl at hayley)
+
+ * fixwrites.c, regfix.c, splitup.c, web2c.c (main): return int,
+ use EXIT_SUCCESS_CODE instead of zero.
+
+Fri Mar 20 16:43:17 1992 Karl Berry (karl at hayley)
+
+ * Makefile (mostlyclean): new name for `clean'.
+ (clean): what `realclean' used to be.
+ (realclean): nothing to do anymore.
+ (install): install the program.
+
+Fri Jan 24 09:19:24 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+Sat Jan 11 17:33:14 1992 Karl Berry (karl at hayley)
+
+ * web2c.lex: #undef read after the #include's, since the scanner
+ does a system call.
+
+ * Makefile: rearrange for new configuration.
+
+ * splitup.c (FILENAMESIZE): rename to `PATH_MAX'.
diff --git a/Build/source/texk/web2c/web2c/Makefile.in b/Build/source/texk/web2c/web2c/Makefile.in
new file mode 100644
index 00000000000..e5a3d427151
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/Makefile.in
@@ -0,0 +1,71 @@
+# Makefile for TeX-project WEB sources to C conversion programs.
+
+# This makefile uses static rules with many targets (to be compatible to
+# non-gnu make) and will not work correctly when parallelized.
+# So we switch off parallel makes with gnu make.
+.NOTPARALLEL:
+
+# These get expanded from the parent directory, not this one.
+kpse_include ../make/common.mk
+kpse_include ../make/programs.mk
+kpse_include ../make/cross.mk
+kpse_include kpathsea.mk
+
+LEX = @LEX@
+LEXLIB = @LEXLIB@
+LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@
+YACC = @YACC@
+
+programs = web2c fixwrites splitup
+
+web2c_objects = kps.o main.o y_tab.o $(LEX_OUTPUT_ROOT).o
+all: $(programs)
+web2c: $(web2c_objects)
+ $(build_link_command) $(web2c_objects) $(LEXLIB)
+
+# We use y_tab.* for the sake of MS-DOS.
+main.o: main.c y_tab.h
+y_tab.c y_tab.h: web2c.y
+ @echo Expect one shift/reduce conflict.
+ $(YACC) -d -v $(srcdir)/web2c.y
+ -test -f y.tab.c && mv -f y.tab.c y_tab.c
+ -test -f y.tab.h && mv -f y.tab.h y_tab.h
+$(LEX_OUTPUT_ROOT).o: y_tab.h
+$(LEX_OUTPUT_ROOT).c: web2c.l
+ $(LEX) $(srcdir)/web2c.l
+
+fixwrites: fixwrites.o kps.o
+ $(build_link_command) fixwrites.o kps.o
+splitup: splitup.o kps.o
+ $(build_link_command) splitup.o kps.o
+regfix: regfix.o kps.o
+ $(build_link_command) regfix.o kps.o
+
+$(programs):
+
+main.o: main.c
+ $(build_compile) -c $<
+kps.o: kps.c
+ $(build_compile) -c $<
+y_tab.o: y_tab.c
+ $(build_compile) -c $<
+$(LEX_OUTPUT_ROOT).o: $(LEX_OUTPUT_ROOT).c
+ $(build_compile) -c $<
+fixwrites.o: fixwrites.c
+ $(build_compile) -c $<
+splitup.o: splitup.c
+ $(build_compile) -c $<
+regfix.o: regfix.c
+ $(build_compile) -c $<
+
+Makefile: Makefile.in ../config.status
+ cd .. && $(SHELL) config.status
+
+kpse_include ../make/tkpathsea.mk
+kpse_include ../make/clean.mk
+
+clean::
+ rm -f y_tab.c y_tab.h y.out* yacc.* $(LEX_OUTPUT_ROOT).c
+
+kpse_include ../make/rdepend.mk
+kpse_include web2c/depend.mk
diff --git a/Build/source/texk/web2c/web2c/README b/Build/source/texk/web2c/web2c/README
new file mode 100644
index 00000000000..3471cac9798
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/README
@@ -0,0 +1,18 @@
+This directory contains the programs that convert the original web
+sources to C.
+
+The convert shell script is the thing that actually gets invoked from
+the Makefile. It runs web2c, fixwrites, and splitup in turn, plus
+various sed nonsense. web2c parses Pascal and outputs C; fixwrites
+shouldn't be necessary, it converts multiple-argument writes into C;
+splitup splits the output file into pieces for the sake of broken
+compilers.
+
+To define a new symbol (e.g., a function) to be used in the change
+files, it's necessary to add it to texmf.defines (if it's only used in
+TeX/MF/MP) or common.defines (otherwise) here, as well as making the
+actual definition. New functions in the libraryshould be declared
+somewhere, probably cpascal.h. Of course no underscores are allowed,
+since tangle removes them.
+
+
diff --git a/Build/source/texk/web2c/web2c/coerce.h b/Build/source/texk/web2c/web2c/coerce.h
new file mode 100644
index 00000000000..dfe8e38927e
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/coerce.h
@@ -0,0 +1,54 @@
+/* Some definitions that get appended to the `coerce.h' file that web2c
+ outputs. */
+
+/* The C compiler ignores most unnecessary casts (i.e., casts of
+ something to its own type). However, for structures, it doesn't.
+ Therefore, we have to redefine these macros so they don't cast
+ cast their argument (of type memoryword or fourquarters,
+ respectively). */
+#ifdef printword
+#undef printword
+#define printword(x) zprintword (x)
+#endif
+
+#ifdef tfmqqqq
+#undef tfmqqqq
+#define tfmqqqq(x) ztfmqqqq (x)
+#endif
+
+#ifdef eqdestroy
+#undef eqdestroy
+#define eqdestroy(x) zeqdestroy(x)
+#endif
+
+/* And we use the opportunity to declare a few functions that could not be
+ declared in texmfmp.h, because they need typedefs not yet known at that
+ point. */
+extern strnumber getjobname P1H(strnumber);
+
+#ifdef MP
+/* MP defined poolASCIIcode instead of packedASCIIcode, sigh. */
+typedef poolASCIIcode packedASCIIcode;
+#endif
+extern void calledit P4H(packedASCIIcode *, poolpointer, integer, integer);
+
+#ifdef MF
+extern void blankrectangle P4H(screencol, screencol, screenrow, screenrow);
+extern void paintrow P4H(screenrow, pixelcolor, transspec, screencol);
+#endif
+
+#ifdef TeX
+/* Prototypes for source-specials functions... */
+extern strnumber makefullnamestring();
+extern boolean isnewsource P2H(strnumber, int);
+extern poolpointer makesrcspecial P2H(strnumber, int);
+extern void remembersourceinfo P2H(strnumber, int);
+#endif
+
+#ifdef pdfTeX
+#include <pdftexdir/pdftex.h>
+#endif /* pdfTeX */
+
+#ifdef pdfeTeX
+#include <pdfetexdir/pdfetex.h>
+#endif /* pdfeTeX */
diff --git a/Build/source/texk/web2c/web2c/common.defines b/Build/source/texk/web2c/web2c/common.defines
new file mode 100644
index 00000000000..1fc6998791f
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/common.defines
@@ -0,0 +1,208 @@
+{This file is concatenated by ./convert to the beginning of the Pascal
+ code that tangle outputs. The idea is to put all these symbols, which
+ can be defined as macros or functions, or as part of standard C, into
+ web2c's symbol table, so that we can access them from a change file.
+ Some are standard Pascal functions, others are simply used in our
+ implementation.
+
+ web2c.yacc can parse these @define statements.}
+
+{The fields in the memory_word structure, defined in
+ `mfware/gftodmem.h' and `common/texmf.h'.}
+@define @field qqqq;
+@define @field sc;
+
+{These fields are the ones defined by the getopt library.}
+@define @field name;
+@define @field hasarg;
+@define @field flag;
+@define @field val;
+
+{This is used by \TeX--XeT.}
+{@define @field rh;}
+
+@define const false;
+@define const FOPENRBINMODE;
+@define const FOPENRMODE;
+@define const input;
+@define const kpsebibformat;
+@define const kpsebstformat;
+@define const kpsedvipsconfigformat;
+@define const kpsefontmapformat;
+@define const kpselastformat;
+@define const kpsegfformat;
+@define const kpsemfformat;
+@define const kpsemfpoolformat;
+@define const kpsemftformat;
+@define const kpsempformat;
+@define const kpsemppoolformat;
+@define const kpseocpformat;
+@define const kpseofmformat;
+@define const kpseoplformat;
+@define const kpseotpformat;
+@define const kpseovfformat;
+@define const kpseovpformat;
+@define const kpsepkformat;
+@define const kpsetexformat;
+@define const kpsetexpoolformat;
+@define const kpsetfmformat;
+@define const kpsevfformat;
+@define const kpsewebformat;
+@define const kpsesrccmdline;
+@define const maxint;
+@define const nil;
+@define const output;
+@define const stderr;
+@define const stdin;
+@define const stdout;
+@define const true;
+
+@define const ALEPHHELP;
+@define const BIBTEXHELP;
+@define const DVICOPYHELP;
+@define const DVITOMPHELP;
+@define const DVITYPEHELP;
+@define const EOMEGAHELP;
+@define const ETEXHELP;
+@define const GFTODVIHELP;
+@define const GFTOPKHELP;
+@define const GFTYPEHELP;
+@define const MFTHELP;
+@define const ODVICOPYHELP;
+@define const ODVITYPEHELP;
+@define const OFM2OPLHELP;
+@define const OMEGAHELP;
+@define const OPL2OFMHELP;
+@define const OTANGLEHELP;
+@define const OVP2OVFHELP;
+@define const OVF2OVPHELP;
+@define const PATGENHELP;
+@define const PDFTEXHELP;
+@define const PDFETEXHELP;
+@define const PKTOGFHELP;
+@define const PKTYPEHELP;
+@define const PLTOTFHELP;
+@define const POOLTYPEHELP;
+@define const TANGLEHELP;
+@define const TFTOPLHELP;
+@define const VFTOVPHELP;
+@define const VPTOVFHELP;
+@define const WEAVEHELP;
+
+@define function abs ();
+@define function addressof ();
+@define function aopenin ();
+@define function aopenout ();
+@define function atof ();
+@define function atoi ();
+@define function atou ();
+@define function basename ();
+@define function basenamechangesuffix ();
+@define function casttobytepointer ();
+@define function chartostring ();
+@define function chr ();
+@define function cmdline ();
+@define function eof ();
+@define function eoln ();
+@define function extendfilename ();
+@define function fabs ();
+@define function feof ();
+@define function findsuffix ();
+@define function floor ();
+@define function ftell ();
+@define function fopen ();
+@define function getc ();
+@define function getoptlongonly ();
+@define function ISDIRSEP ();
+@define function kpsefindfile ();
+@define function kpsefindmf ();
+@define function kpsefindmft ();
+@define function kpsefindofm ();
+@define function kpsefindovf ();
+@define function kpsefindtex ();
+@define function kpsefindtfm ();
+@define function kpsefindvf ();
+@define function kpseopenfile ();
+@define function kpsevarvalue ();
+@define function inputint ();
+@define function intcast ();
+@define function isprint ();
+@define function makebinaryfile ();
+@define function makesuffix ();
+@define function odd ();
+@define function ord ();
+@define function removesuffix ();
+@define function round ();
+@define function strcmp ();
+@define function stringcast ();
+@define function strlen ();
+@define function strtol ();
+@define function trunc ();
+@define function xftell ();
+@define function xmalloc ();
+@define function xmallocarray ();
+@define function xrealloc ();
+@define function xreallocarray ();
+@define function xstrdup ();
+@define function XTALLOC ();
+
+@define procedure aclose ();
+@define procedure BIBXRETALLOC (); {For BibTeX.}
+@define procedure decr ();
+@define procedure fflush (); {can't keep |break|, since it's a reserved word}
+@define procedure free ();
+@define procedure fprintreal ();
+@define procedure fputs ();
+@define procedure incr ();
+@define procedure input2ints ();
+@define procedure input3ints ();
+@define procedure kpseinitprog ();
+@define procedure kpsesetprogname ();
+@define procedure kpsesetprogramname ();
+@define procedure kpseresetprogramname ();
+@define procedure kpsesetprogramenabled ();
+@define procedure libcfree ();
+@define procedure printreal ();
+@define procedure printversionandexit ();
+@define procedure putbyte ();
+@define procedure read ();
+@define procedure readln ();
+@define procedure recorderchangefilename ();
+@define procedure reset ();
+@define procedure resetbin ();
+@define procedure rewrite ();
+@define procedure rewritebin ();
+@define procedure setpaths ();
+@define procedure strcat ();
+@define procedure strcpy ();
+@define procedure usage ();
+@define procedure usagehelp ();
+@define procedure uexit ();
+@define procedure vgetc ();
+@define procedure write ();
+@define procedure writechunk ();
+@define procedure writeln ();
+@define procedure xfclose ();
+@define procedure xfseek ();
+
+@define type boolean = 0..1;
+@define type cinttype;
+@define type cstring;
+@define type char = 0..255;
+@define type getoptstruct;
+@define type integer;
+@define type memoryword; {for gftodvi, TeX, and Metafont}
+@define type pointertobyte;
+@define type real;
+@define type text;
+
+@define var argc;
+@define var argv;
+@define var kpathseaversionstring;
+@define var versionstring;
+@define var recorderenabled;
+
+{These are all set by getopt. optiontable is really _getopt_long_options.}
+@define var optarg;
+@define var optind;
+@define var optiontable;
diff --git a/Build/source/texk/web2c/web2c/convert b/Build/source/texk/web2c/web2c/convert
new file mode 100755
index 00000000000..0adee29cecf
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/convert
@@ -0,0 +1,116 @@
+#!/bin/sh
+# Convert WEB programs not needing special treatment to C.
+#
+# $1 is the Pascal file to be converted.
+# $2 is the C file to be created.
+# $3, if present, is extended with .h, and #included in the C file, and
+# extended with .defines, and prepended along with the common
+# definitions.
+
+: ${srcdir=.}
+
+usage="Usage: $0 <basefile>."
+basefile=
+while test $# -gt 0; do
+ case $1 in
+ -*) echo "$1?" >&2; echo "$usage" >&2; exit 1;;
+ *) if test -n "$basefile"; then
+ echo "$1?" >&2; echo "$usage" >&2; exit 1; fi
+ basefile=$1;;
+ esac
+ shift
+done
+if test -z "$basefile"; then
+ echo "Missing basefile argument." >&2
+ echo "$usage" >&2
+ exit 1
+fi
+
+pascalfile=$basefile.p
+cfile=$basefile.c
+
+# This is for tangleboot if the build and source directories are different.
+test -r $pascalfile || pascalfile=$srcdir/$pascalfile
+
+# We use cpascal.h by default instead of config.h because straight C
+# routines can only be confused by the definitions for `chr', etc.
+hfile=cpascal.h
+more_defines=
+web2c_options=-c$basefile
+precmd=
+midcmd=
+fixwrites_options=
+splitup_options="-i -l 10000"
+postcmd=
+output="> $cfile"
+output_files="$cfile $basefile.h"
+
+case $basefile in
+ bibtex)
+ midcmd="| sed -f $srcdir/web2c/cvtbib.sed";;
+ mf|mp) # MF and MP are almost the same.
+ more_defines="$srcdir/web2c/texmf.defines $srcdir/web2c/mfmp.defines"
+ precmd="| sed -f $srcdir/web2c/cvtmf1.sed"
+ web2c_options="-m -c${basefile}coerce"
+ hfile=texmfmp.h
+ midcmd="| sed -f $srcdir/web2c/cvtmf2.sed"
+ postcmd="| ./web2c/splitup $splitup_options $basefile"
+ cfile=${basefile}2.c # last output file, or thereabouts
+ output=
+ output_files="$basefile[0-9].c ${basefile}ini.c ${basefile}d.h \
+${basefile}coerce.h"
+ ;;
+ tex|eomega|etex|pdftex|pdfetex|omega|aleph)
+ more_defines="$srcdir/web2c/texmf.defines"
+ prog_defines="$srcdir/${basefile}dir/$basefile.defines"
+ if test -f $prog_defines; then
+ more_defines="$more_defines $prog_defines"
+ fi
+ web2c_options="-t -c${basefile}coerce"
+ hfile=texmfmp.h
+ fixwrites_options=-t
+ postcmd="| ./web2c/splitup $splitup_options ${basefile}"
+ cfile=${basefile}2.c # last output file, or thereabouts
+ output=
+ output_files="$basefile[0-9].c ${basefile}ini.c ${basefile}d.h \
+${basefile}coerce.h"
+ ;;
+esac
+
+# Do it.
+eval "cat $srcdir/web2c/common.defines $more_defines $pascalfile \
+ $precmd \
+ | ./web2c/web2c -h$hfile $web2c_options \
+ $midcmd \
+ | ./web2c/fixwrites $fixwrites_options $basefile \
+ $postcmd \
+ $output"
+
+# Using the above pipeline as the condition of an if does no good, since
+# typical sh's use the status of the first command as the pipeline result.
+# So check for an empty output file, or one with the error marker we put in.
+if test ! -s $cfile || grep @error@ $output_files >/dev/null; then
+ : ${TMPDIR=/tmp}
+ # Don't just delete it, since it may be useful for debugging.
+ echo "$0: conversion of $pascalfile failed, moving dregs:" >&2
+ cmd="mv $output_files $TMPDIR"
+ (cd $TMPDIR && rm -f $output_files)
+ echo "$0: $cmd" >&2
+ $cmd
+ exit 1
+fi
+
+case $basefile in
+ bibtex)
+ sed -e 's/(buftype)//g' -e 's/(pdstype)//g' <bibtex.h >xbibtex.h
+ mv xbibtex.h bibtex.h
+ ;;
+ tex|eomega|etex|pdftex|pdfetex|omega|aleph|mf|mp)
+ sleep 2 # so timestamps are definitely later, to avoid make weirdness
+ cat ${basefile}coerce.h $srcdir/web2c/coerce.h >x${basefile}coerce.h
+ mv x${basefile}coerce.h ${basefile}coerce.h
+ touch ${basefile}d.h
+ ;;
+esac
+
+exit 0
diff --git a/Build/source/texk/web2c/web2c/convert.bat b/Build/source/texk/web2c/web2c/convert.bat
new file mode 100644
index 00000000000..7cd54b1429e
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/convert.bat
@@ -0,0 +1,77 @@
+@echo off
+set objdir=%1
+set srcdir=.
+set win32seddir=%srcdir%\..\msvc
+set perldir=%srcdir%\..\msvc
+rem set PATH=%srcdir%\..\kpathsea\%objdir%;%srcdir%\..\..\gnu\bin;%PATH%
+if NOT %2==bibtex goto mfmp
+ cat %srcdir%\web2c\common.defines %2.p | %srcdir%\web2c\%objdir%\web2c -hcpascal.h -c%2 | sed -f %srcdir%/web2c/cvtbib.sed | %srcdir%\web2c\%objdir%\fixwrites %2 > %2.c
+ cat %srcdir%\bibtex.h | sed -e "1,$s/(buftype)//g" | sed -e "1,$s/(pdstype)//g" > %srcdir%\bibtex.h.new
+ copy %srcdir%\bibtex.h.new %srcdir%\bibtex.h && del /f %srcdir%\bibtex.h.new
+ goto exit
+:mfmp
+if NOT %2==mf goto mp
+ cat %srcdir%\web2c\common.defines %srcdir%\web2c\texmf.defines %srcdir%\web2c\mfmp.defines %2.p | sed -f %srcdir%/web2c/cvtmf1.sed | %srcdir%\web2c\%objdir%\web2c -htexmfmp.h -m -c%2coerce | sed -f %srcdir%/web2c/cvtmf2.sed | %srcdir%\web2c\%objdir%\fixwrites %2 | perl %perldir%\splitup.pl --name=%2 --dfile > %2.c
+rem so timestamps are definitely later, to avoid make weirdness
+ copy %srcdir%\%2coerce.h+%srcdir%\web2c\coerce.h %srcdir%\x%2coerce.h
+ sed -f %win32seddir%\mfmp.sed %srcdir%\x%2coerce.h > %srcdir%\%2coerce.h
+ del /f %srcdir%\x%2coerce.h
+ goto exit
+:mp
+if NOT %2==mp goto omega
+ cat %srcdir%\web2c\common.defines %srcdir%\web2c\texmf.defines %srcdir%\web2c\mfmp.defines %2.p | sed -f %srcdir%/web2c/cvtmf1.sed | %srcdir%\web2c\%objdir%\web2c -htexmfmp.h -m -c%2coerce | sed -f %srcdir%/web2c/cvtmf2.sed | %srcdir%\web2c\%objdir%\fixwrites %2 | perl %perldir%\splitup.pl --name=%2 --dfile > %2.c
+ copy %srcdir%\%2coerce.h+%srcdir%\web2c\coerce.h %srcdir%\x%2coerce.h
+ sed -f %win32seddir%\mfmp.sed %srcdir%\x%2coerce.h > %srcdir%\%2coerce.h
+ del /f %srcdir%\x%2coerce.h
+ goto exit
+:omega
+if NOT %2==omega goto eomega
+goto omega_or_eomega_or_aleph
+:eomega
+if NOT %2==eomega goto aleph
+goto omega_or_eomega_or_aleph
+:aleph
+if NOT %2==aleph goto pdf
+:omega_or_eomega_or_aleph
+ cat %srcdir%\web2c\common.defines %srcdir%\web2c\texmf.defines %srcdir%\%2dir\%2.defines %2.p | %srcdir%\web2c\%objdir%\web2c -htexmfmp.h -t -c%2coerce | %srcdir%\web2c\%objdir%\fixwrites -t %2 | perl %perldir%\splitup.pl --name=%2 --dfile > %2.c
+ copy .\%2coerce.h+%srcdir%\web2c\coerce.h .\x%2coerce.h
+ copy .\x%2coerce.h .\%2coerce.h
+rem sed -f %win32seddir%\tex-deopt.sed < %srcdir%\%2.c > %srcdir%\%2.c.opt
+rem copy %srcdir%\%2.c.opt %srcdir%\%2.c && del /f %srcdir%\%2.c.opt
+ del /f .\x%2coerce.h
+ goto exit
+:pdf
+if NOT %2==pdftex goto pdfetex
+goto pdftex_or_pdfetex
+:pdfetex
+goto pdftex_or_pdfetex
+:pdftex_or_pdfetex
+ cat %srcdir%\web2c\common.defines %srcdir%\web2c\texmf.defines %srcdir%\%2dir\%2.defines %2.p | %srcdir%\web2c\%objdir%\web2c -htexmfmp.h -t -c%2coerce | %srcdir%\web2c\%objdir%\fixwrites -t %2 | perl %perldir%\splitup.pl --name=%2 --dfile > %2.c
+ copy %srcdir%\%2coerce.h+%srcdir%\web2c\coerce.h %srcdir%\x%2coerce.h
+ copy %srcdir%\x%2coerce.h %srcdir%\%2coerce.h
+ del /f %srcdir%\x%2coerce.h
+rem sed -f %win32seddir%\tex-deopt.sed < %srcdir%\%2.c > %srcdir%\%2.c.opt
+rem copy %srcdir%\%2.c.opt %srcdir%\%2.c && del /f %srcdir%\%2.c.opt
+ goto exit
+:tex
+if NOT %2==tex goto etex
+goto tex_or_etex
+:etex
+if NOT %2==etex goto vftovp
+:tex_or_etex
+ cat %srcdir%\web2c\common.defines %srcdir%\web2c\texmf.defines %2.p | %srcdir%\web2c\%objdir%\web2c -htexmfmp.h -t -c%2coerce | %srcdir%\web2c\%objdir%\fixwrites -t %2 | perl %perldir%\splitup.pl --name=%2 --dfile > %2.c
+ copy %srcdir%\%2coerce.h+%srcdir%\web2c\coerce.h %srcdir%\x%2coerce.h
+ copy %srcdir%\x%2coerce.h %srcdir%\%2coerce.h
+ del /f %srcdir%\x%2coerce.h
+rem sed -f %win32seddir%\tex-deopt.sed < %srcdir%\%2.c > %srcdir%\%2.c.opt
+rem copy %srcdir%\%2.c.opt %srcdir%\%2.c && del /f %srcdir%\%2.c.opt
+ goto exit
+:vftovp
+REM if NOT %2==vftovp goto else
+REM cat %srcdir%\web2c\common.defines %2.p | %srcdir%\web2c\%objdir%\web2c -hcpascal.h -c%2 | sed -f %srcdir%/web2c/cvtvf2vp.sed | %srcdir%\web2c\%objdir%\fixwrites %2 > %2.c
+REM goto exit:
+:else
+ cat %srcdir%\web2c\common.defines %2.p | %srcdir%\web2c\%objdir%\web2c -hcpascal.h -c%2 | %srcdir%\web2c\%objdir%\fixwrites %2 > %2.c
+:exit
+ if EXIST %2d.h touch %2d.h
+ echo 'Conversion done !'
diff --git a/Build/source/texk/web2c/web2c/cvtbib.sed b/Build/source/texk/web2c/web2c/cvtbib.sed
new file mode 100644
index 00000000000..037a158e835
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/cvtbib.sed
@@ -0,0 +1,12 @@
+1i\
+\#include \<setjmp.h\> \
+jmp_buf jmp9998, jmp32; int lab31=0;
+s/goto lab31 ; */{lab31=1; return;}/
+s/goto lab32/longjmp(jmp32,1)/
+s/goto lab9998/longjmp(jmp9998,1)/g
+s/lab31://
+s/lab32://
+s/hack0 () ;/if(setjmp(jmp9998)==1) goto lab9998;/
+s/hack1 () ;/if(setjmp(jmp32)==0)for(;;)/
+s/hack2 ()/break/
+/^void mainbody/,$s/while ( true/while (lab31==0/
diff --git a/Build/source/texk/web2c/web2c/cvtmf1.sed b/Build/source/texk/web2c/web2c/cvtmf1.sed
new file mode 100644
index 00000000000..164b173d240
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/cvtmf1.sed
@@ -0,0 +1,9 @@
+ : again
+ /\.$/{
+ N
+ s/\.\n/\
+./
+ t again
+ }
+ s/\.hh/.hhfield/g
+ s/\.lh/.lhfield/g
diff --git a/Build/source/texk/web2c/web2c/cvtmf2.sed b/Build/source/texk/web2c/web2c/cvtmf2.sed
new file mode 100644
index 00000000000..c3e1c91797a
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/cvtmf2.sed
@@ -0,0 +1,6 @@
+ s/else write/else\
+write/
+ s/ maxcoef\( *[^( ]\)/ lmaxcoef\1/g
+ s/ b1/ lb1/g
+ s/ b2/ lb2/g
+ s/ b3/ lb3/g
diff --git a/Build/source/texk/web2c/web2c/depend.mak b/Build/source/texk/web2c/web2c/depend.mak
new file mode 100644
index 00000000000..f88eb05752b
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/depend.mak
@@ -0,0 +1,133 @@
+$(objdir)/y_tab.obj: \
+ web2c.h \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/fixwrites.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/c-pathmx.h
+
+$(objdir)/main.obj: \
+ web2c.h \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ y_tab.h
+
+$(objdir)/splitup.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ $(kpathseadir)/getopt.h
+
+$(objdir)/regfix.obj: \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h
+
+$(objdir)/$(LEX_OUTPUT_ROOT).obj: \
+ web2c.h \
+ ../config.h \
+ $(kpathseadir)/config.h \
+ $(kpathseadir)/c-auto.h \
+ $(kpathseadir)/c-std.h \
+ $(kpathseadir)/c-unistd.h \
+ $(kpathseadir)/systypes.h \
+ $(kpathseadir)/c-memstr.h \
+ $(kpathseadir)/c-errno.h \
+ $(kpathseadir)/c-minmax.h \
+ $(kpathseadir)/c-limits.h \
+ $(kpathseadir)/c-proto.h \
+ $(gnuw32dir)/win32lib.h \
+ $(kpathseadir)/debug.h \
+ $(kpathseadir)/types.h \
+ $(kpathseadir)/lib.h \
+ $(kpathseadir)/progname.h \
+ $(kpathseadir)/../web2c/c-auto.h \
+ $(kpathseadir)/c-vararg.h \
+ $(kpathseadir)/c-fopen.h \
+ y_tab.h
+
diff --git a/Build/source/texk/web2c/web2c/depend.mk b/Build/source/texk/web2c/web2c/depend.mk
new file mode 100644
index 00000000000..7365029b9d4
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/depend.mk
@@ -0,0 +1,70 @@
+fixwrites.o: fixwrites.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/c-pathmx.h
+kps.o: kps.c web2c.h ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/c-ctype.h
+$(LEX_OUTPUT_ROOT).o: $(LEX_OUTPUT_ROOT).c \
+ web2c.h \
+ ../config.h $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h \
+ $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ y_tab.h
+main.o: main.c web2c.h ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ y_tab.h
+regfix.o: regfix.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
+splitup.o: splitup.c ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h
+y_tab.o: y_tab.c web2c.h ../config.h $(kpathsea_srcdir)/config.h \
+ $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h
diff --git a/Build/source/texk/web2c/web2c/fixwrites.c b/Build/source/texk/web2c/web2c/fixwrites.c
new file mode 100644
index 00000000000..7a7e6a2aa1e
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/fixwrites.c
@@ -0,0 +1,450 @@
+/* fixwrites -- convert Pascal write/writeln's into fprintf's or putc's.
+ Originally by Tim Morgan, October 10, 1987. */
+
+#include "config.h"
+#include <kpathsea/c-pathmx.h>
+
+int argc;
+char **gargv;
+
+char buf[BUFSIZ], filename[PATH_MAX], args[100];
+char *file, *argp, *as, *cmd;
+
+int tex = false;
+
+/* Replace the last (should be only) newline in S with a null. */
+
+static void
+remove_newline P1C(string, s)
+{
+ char *temp = strrchr (s, '\n');
+ if (temp == NULL)
+ {
+ fprintf (stderr, "Lost newline somehow.\n");
+ /* This is so the convert script can delete the output file on error. */
+ puts ("@error@");
+ exit (1);
+ }
+
+ *temp = 0;
+}
+
+
+static char *
+insert_long P1C(string, cp)
+{
+ char tbuf[BUFSIZ];
+ register int i;
+
+ for (i = 0; &buf[i] < cp; ++i)
+ tbuf[i] = buf[i];
+ strcpy (&tbuf[i], "(long)");
+ strcpy (&tbuf[i + 6], cp);
+ strcpy (buf, tbuf);
+ return cp + 6;
+}
+
+
+static void
+join P1C(string, cp)
+{
+ char temp[BUFSIZ], *tp;
+
+ if (!fgets (temp, BUFSIZ, stdin))
+ return;
+ remove_newline (temp);
+
+ *cp++ = ' ';
+ for (tp = temp; *tp == ' '; ++tp)
+ ;
+
+ strcpy (cp, tp);
+}
+
+
+static void
+do_blanks P1C(int, indent)
+{
+ register int i;
+
+ for (i = 0; i < indent / 8; i++)
+ putchar ('\t');
+ indent %= 8;
+ for (i = 0; i < indent; i++)
+ putchar (' ');
+}
+
+
+/* Return true if we have a whole write/writeln statement. We determine
+ this by matching parens, ignoring those within strings. */
+static int
+whole P1C(string, cp)
+{
+ register int depth = 0;
+
+ while (cp && *cp)
+ {
+ switch (*cp)
+ {
+ case '(':
+ ++depth;
+ break;
+ case ')':
+ --depth;
+ break;
+ case '"':
+ for (++cp; cp && *cp && *cp != '"'; ++cp)
+ if (*cp == '\\')
+ ++cp;
+ break;
+ case '\'':
+ ++cp;
+ if (*cp == '\\') ++cp;
+ ++cp;
+ break;
+ }
+ ++cp;
+ }
+ return depth <= 0;
+}
+
+
+/* Skips to the next , or ), skipping over balanced paren pairs. */
+
+static char *
+skip_balanced P1C(string, cp)
+{
+ register int depth = 0;
+
+ while (depth > 0 || (*cp != ',' && *cp != ')'))
+ {
+ switch (*cp)
+ {
+ case '(':
+ ++depth;
+ break;
+ case ')':
+ --depth;
+ break;
+ }
+ ++cp;
+ }
+ return cp;
+}
+
+
+/* Return true if c appears, except inside a quoted string */
+
+static int
+bare P2C(string, cp, char, c)
+{
+ for (; *cp && *cp != c; ++cp)
+ {
+ if (*cp == '"')
+ {
+ ++cp; /* skip over initial quotation mark */
+ while (*cp && *cp != '"')
+ { /* skip to closing double quote */
+ if (*cp == '\\')
+ ++cp;
+ ++cp;
+ }
+ }
+ else if (*cp == '\'')
+ {
+ ++cp; /* skip to contained char */
+ if (*cp == '\'')
+ ++cp; /* if backslashed, it's double */
+ ++cp; /* skip to closing single-quote mark */
+ }
+ }
+ return *cp;
+}
+
+
+/* xchr[...] is supposed to be replaced by Xchr(...) when characters
+ take more than a single octet each, as is the case in Omega. Now
+ there are several occurrences of xchr[...[...]...], which are
+ translated into Xchr(...[...)...], and the compiler dies on syntax
+ errors. Ensures that it is the matching bracket that is replaced,
+ not the first one. */
+
+char *
+advance_cp P2C(char *, cp, int, lefts)
+{
+ char *cp1;
+ char *cp2;
+
+ cp1 = strchr (cp + 1, ']');
+ cp2 = strchr (cp + 1, '[');
+ if (cp2 && cp2 < cp1)
+ return advance_cp (cp2, lefts + 1);
+ if (lefts == 1)
+ return cp1;
+ return advance_cp (cp1, lefts - 1);
+}
+
+int
+main P2C(int, argc, string *, argv)
+{
+ register char *cp;
+ int blanks_done, indent, i;
+ char *program_name = "";
+
+ for (i = 1; i < argc; i++)
+ {
+ if (STREQ(argv[i],"-t"))
+ tex = true;
+ else
+ program_name = argv[i];
+ }
+
+ while (fgets (buf, BUFSIZ, stdin))
+ {
+ remove_newline (buf);
+ blanks_done = false;
+
+ for (cp = buf; *cp; ++cp) ;
+
+ while (cp != buf && *--cp == ' ') ;
+
+ while (*cp == '.')
+ {
+ join (cp + 1);
+ while (*cp)
+ ++cp;
+ while (*--cp == ' ') ;
+ }
+
+ for (cp = buf, indent = 0; *cp == ' ' || *cp == '\t'; ++cp)
+ {
+ if (*cp == ' ')
+ indent++;
+ else
+ indent += 8;
+ }
+
+ if (!*cp)
+ { /* All blanks, possibly with "{" */
+ puts (buf);
+ continue;
+ }
+ if (*cp == '{')
+
+ {
+ do_blanks (indent);
+ putchar ('{');
+ ++cp;
+ while (*cp == ' ' || *cp == '\t')
+ ++cp;
+ blanks_done = true;
+ if (!*cp)
+ {
+ putchar ('\n');
+ continue;
+ }
+ }
+
+ if (!blanks_done)
+ do_blanks (indent);
+
+ if (strncmp (cp, "read ( input", 12) == 0)
+ {
+ char variable_name[20];
+ if (sscanf (cp, "read ( input , %s )", variable_name) != 1)
+ {
+ fprintf (stderr, "sscanf failed\n");
+ exit (1);
+ }
+ printf ("%s = getint();\n", variable_name);
+ continue;
+ }
+
+ if (strncmp (cp, "lab", 3) == 0 && strchr (cp, ':'))
+ {
+ do
+ {
+ putchar (*cp);
+ }
+ while (*cp++ != ':');
+
+ while (*cp == ' ')
+ ++cp;
+ putchar (' ');
+ }
+
+ if (strncmp (cp, "else write", 10) == 0)
+ {
+ puts ("else");
+ do_blanks (indent);
+ cp += 5;
+ while (*cp == ' ')
+ ++cp;
+ }
+
+ if (bare (cp, '{'))
+ {
+ while (*cp != '{')
+ {
+ putchar (*cp);
+ ++cp;
+ }
+ ++cp;
+ puts ("{");
+ indent += 4;
+ do_blanks (indent);
+ while (*cp == ' ')
+ ++cp;
+ }
+
+ if (strncmp (cp, "write (", 7) && strncmp (cp, "writeln (", 9))
+ {
+ /* if not a write/writeln, just copy it to stdout and continue */
+ puts (cp);
+ continue;
+ }
+ cmd = cp;
+ while (!whole (buf)) /* make sure we have whole stmt */
+ {
+ fgets (&buf[strlen (buf)], BUFSIZ - strlen (buf), stdin);
+ remove_newline (buf);
+ }
+
+ while (*cp != '(')
+ ++cp;
+ ++cp;
+ while (*(cp + 1) == ' ')
+ ++cp;
+
+ /* Some writes start with a variable, instead of a file. */
+ if (*(cp + 1) == '"' || *(cp + 1) == '\''
+ || strncmp (cp + 1, "buffer", 6) == 0
+ || strncmp (cp + 1, "xchr", 4) == 0
+ || strncmp (cp + 1, "k ,", 3) == 0
+ || strncmp (cp + 1, "s ,", 3) == 0
+ || strncmp (cp + 1, "dig", 3) == 0
+ || strncmp (cp + 1, "HEX", 3) == 0
+ || strncmp (cp + 1, "versionstring", 13) == 0
+ || strncmp (cp + 1, "kpathseaversionstring", 21) == 0
+ )
+ strcpy (filename, "stdout");
+ else
+ {
+ file = filename;
+ while (*cp != ',' && *cp != ')')
+ *file++ = *cp++;
+ *file = '\0';
+ }
+ if (*cp == ')')
+ {
+ printf ("putc ('\\n', %s);\n", filename);
+ continue;
+ }
+ argp = ++cp;
+ as = args;
+ while (*cp == ' ')
+ ++cp;
+ while (*cp != ')')
+ {
+ if (*cp == '\'' || strncmp (cp, "xchr", 4) == 0
+ || (strncmp (cp ,"HEX", 3) == 0
+ && (STREQ (program_name, "ofm2opl")
+ || STREQ (program_name, "opl2ofm")
+ || STREQ (program_name, "ovp2ovf")
+ || STREQ (program_name, "ovf2ovp")))
+ || strncmp (cp, "ASCII04", 7) == 0
+ || strncmp (cp, "ASCII1", 6) == 0
+ || strncmp (cp, "ASCIIall", 8) == 0
+ || strncmp (cp, "months", 6) == 0
+ || strncmp (cp, "nameoffile", 10) == 0
+ || (strncmp (cp, "buffer", 6) == 0
+ && (STREQ (program_name, "vptovf")
+ || STREQ (program_name, "pltotf")
+ || STREQ (program_name, "ovp2ovf")
+ || STREQ (program_name, "ofm2opl")))
+ || (((strncmp (cp, "buf", 3) == 0
+ || strncmp (cp, "xdig", 4) == 0
+ || strncmp (cp, "xext", 4) == 0
+ || strncmp (cp, "xhyf", 4) == 0)
+ && STREQ (program_name, "patgen")))
+ )
+ {
+ *as++ = '%';
+ *as++ = 'c';
+ if (tex && strncmp (cp, "xchr", 4) == 0)
+ {
+ *cp = 'X';
+ cp = strchr (cp, '[');
+ *cp = '(';
+ cp = advance_cp(cp,1);
+ *cp++ = ')';
+ }
+ else if (*cp == '\'')
+ cp += 2;
+ }
+
+ else if (*cp == '"')
+ {
+ *as++ = '%';
+ *as++ = 's';
+ while (*++cp != '"') /* skip to end of string */
+ if (*cp == '\\')
+ ++cp; /* allow \" in string */
+ }
+
+ /* More kludges -- recognize some things as strings and use %s:
+ - versionstring
+ - poolname
+ - formatengine */
+ else if (strncmp (cp, "versionstring", 13) == 0
+ || strncmp (cp, "poolname", 8) == 0
+ || strncmp (cp, "formatengine", 12) == 0)
+ {
+ *as++ = '%';
+ *as++ = 's';
+ }
+
+ /* And yet another kludge, to handle stringcast (<whatever>) */
+ else if (strncmp (cp, "stringcast", 10) == 0)
+ {
+ *as++ = '%';
+ *as++ = 's';
+ cp = skip_balanced (cp); /* Skip cast expression */
+ }
+
+ else
+ {
+ *as++ = '%';
+ *as++ = 'l';
+ *as++ = 'd';
+ cp = insert_long (cp);
+ cp = skip_balanced (cp); /* It's a numeric expression */
+ }
+ while (*cp != ',' && *cp != ')')
+ ++cp;
+ while (*cp == ',' || *cp == ' ')
+ ++cp;
+ }
+
+ if (strncmp (cmd, "writeln", 7) == 0)
+ {
+ *as++ = '\\';
+ *as++ = 'n';
+ }
+
+ *as = '\0';
+ if (strcmp (args, "%c") == 0)
+ {
+ for (as = argp; *as; ++as) ;
+ while (*--as != ')') ;
+ *as = '\0';
+ printf ("putc (%s, %s);\n", argp, filename);
+ }
+ else if (STREQ (args, "%s"))
+ printf ("Fputs (%s, %s\n", filename, argp);
+ else
+ printf ("fprintf (%s, \"%s\", %s\n", filename, args, argp);
+ }
+
+ return EXIT_SUCCESS;
+}
diff --git a/Build/source/texk/web2c/web2c/kps.c b/Build/source/texk/web2c/web2c/kps.c
new file mode 100644
index 00000000000..369c5ea9059
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/kps.c
@@ -0,0 +1,78 @@
+/* Functions copied over from kpathsea library.
+
+Original uppercasify is
+ Copyright 1993 Karl Berry.
+
+Original xfopen/xfclose are
+ Copyright 1992, 93, 95 Free Software Foundation, Inc.
+
+Further modifications
+ Copyright 2004 Olaf Weber.
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#include "web2c.h"
+#include <kpathsea/c-ctype.h>
+/* Get rid of kpathsea debug definitions. */
+#undef fopen
+#undef fclose
+
+string
+uppercasify P1C(const_string, s)
+{
+ string target;
+ string ret = malloc (strlen(s) + 1);
+
+ target = ret;
+ while (*s) {
+ *target = TOUPPER(*s);
+ target++;
+ s++;
+ }
+ *target = '\0';
+
+ return ret;
+}
+
+/* These routines just check the return status from standard library
+ routines and abort if an error happens. */
+
+FILE *
+xfopen P2C(const_string, filename, const_string, mode)
+{
+ FILE *f;
+
+ assert (filename && mode);
+
+ f = fopen (filename, mode);
+ if (f == NULL) {
+ perror(filename);
+ exit(EXIT_FAILURE);
+ }
+
+ return f;
+}
+
+
+void
+xfclose P2C(FILE *, f, const_string, filename)
+{
+ assert (f);
+
+ if (fclose (f) == EOF) {
+ perror(filename);
+ exit(EXIT_FAILURE);
+ }
+}
diff --git a/Build/source/texk/web2c/web2c/lex.yy.c-dist b/Build/source/texk/web2c/web2c/lex.yy.c-dist
new file mode 100644
index 00000000000..546c9ad2ace
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/lex.yy.c-dist
@@ -0,0 +1,2492 @@
+
+#line 3 "lex.yy.c"
+
+#define YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 31
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t;
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else /* ! __cplusplus */
+
+#if __STDC__
+
+#define YY_USE_CONST
+
+#endif /* __STDC__ */
+#endif /* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index. If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition. This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state. The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE yyrestart(yyin )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+extern int yyleng;
+
+extern FILE *yyin, *yyout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+ /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires
+ * access to the local variable yy_act. Since yyless() is a macro, it would break
+ * existing scanners that call yyless() from OUTSIDE yylex.
+ * One obvious solution it to make yy_act a global. I tried that, and saw
+ * a 5% performance hit in a non-yylineno scanner, because yy_act is
+ * normally declared as a register variable-- so it is not worth it.
+ */
+ #define YY_LESS_LINENO(n) \
+ do { \
+ int yyl;\
+ for ( yyl = n; yyl < yyleng; ++yyl )\
+ if ( yytext[yyl] == '\n' )\
+ --yylineno;\
+ }while(0)
+
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ *yy_cp = (yy_hold_char); \
+ YY_RESTORE_YY_MORE_OFFSET \
+ (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+ YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+ } \
+ while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr) )
+
+/* The following is because we cannot portably get our hands on size_t
+ * (without autoconf's help, which isn't available because we want
+ * flex-generated scanners to compile on their own).
+ */
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef unsigned int yy_size_t;
+#endif
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+ {
+ FILE *yy_input_file;
+
+ char *yy_ch_buf; /* input buffer */
+ char *yy_buf_pos; /* current position in input buffer */
+
+ /* Size of input buffer in bytes, not including room for EOB
+ * characters.
+ */
+ yy_size_t yy_buf_size;
+
+ /* Number of characters read into yy_ch_buf, not including EOB
+ * characters.
+ */
+ int yy_n_chars;
+
+ /* Whether we "own" the buffer - i.e., we know we created it,
+ * and can realloc() it to grow it, and should free() it to
+ * delete it.
+ */
+ int yy_is_our_buffer;
+
+ /* Whether this is an "interactive" input source; if so, and
+ * if we're using stdio for input, then we want to use getc()
+ * instead of fread(), to make sure we stop fetching input after
+ * each newline.
+ */
+ int yy_is_interactive;
+
+ /* Whether we're considered to be at the beginning of a line.
+ * If so, '^' rules will be active on the next match, otherwise
+ * not.
+ */
+ int yy_at_bol;
+
+ int yy_bs_lineno; /**< The line count. */
+ int yy_bs_column; /**< The column count. */
+
+ /* Whether to try to fill the input buffer when we reach the
+ * end of it.
+ */
+ int yy_fill_buffer;
+
+ int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+ /* When an EOF's been seen but there's still some text to process
+ * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+ * shouldn't try reading from the input source any more. We might
+ * still have a bunch of tokens to match, though, because of
+ * possible backing-up.
+ *
+ * When we actually see the EOF, we change the status to "new"
+ * (via yyrestart()), so that the user can continue scanning by
+ * just pointing yyin at a new input file.
+ */
+#define YY_BUFFER_EOF_PENDING 2
+
+ };
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+ ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+ : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when yytext is formed. */
+static char yy_hold_char;
+static int yy_n_chars; /* number of characters read into yy_ch_buf */
+int yyleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 1; /* whether we need to initialize */
+static int yy_start = 0; /* start state number */
+
+/* Flag which is used to allow yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin. A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void yyrestart (FILE *input_file );
+void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer );
+YY_BUFFER_STATE yy_create_buffer (FILE *file,int size );
+void yy_delete_buffer (YY_BUFFER_STATE b );
+void yy_flush_buffer (YY_BUFFER_STATE b );
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer );
+void yypop_buffer_state (void );
+
+static void yyensure_buffer_stack (void );
+static void yy_load_buffer_state (void );
+static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file );
+
+#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size );
+YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str );
+YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,int len );
+
+void *yyalloc (yy_size_t );
+void *yyrealloc (void *,yy_size_t );
+void yyfree (void * );
+
+#define yy_new_buffer yy_create_buffer
+
+#define yy_set_interactive(is_interactive) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){ \
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+ }
+
+#define yy_set_bol(at_bol) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){\
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+ }
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+typedef unsigned char YY_CHAR;
+
+FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+
+typedef int yy_state_type;
+
+#define YY_FLEX_LEX_COMPAT
+extern int yylineno;
+
+int yylineno = 1;
+
+extern char yytext[];
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[] );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up yytext.
+ */
+#define YY_DO_BEFORE_ACTION \
+ (yytext_ptr) = yy_bp; \
+ yyleng = (size_t) (yy_cp - yy_bp); \
+ (yy_hold_char) = *yy_cp; \
+ *yy_cp = '\0'; \
+ if ( yyleng + (yy_more_offset) >= YYLMAX ) \
+ YY_FATAL_ERROR( "token too large, exceeds YYLMAX" ); \
+ yy_flex_strncpy( &yytext[(yy_more_offset)], (yytext_ptr), yyleng + 1 ); \
+ yyleng += (yy_more_offset); \
+ (yy_prev_more_offset) = (yy_more_offset); \
+ (yy_more_offset) = 0; \
+ (yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 73
+#define YY_END_OF_BUFFER 74
+/* This struct is not used in this scanner,
+ but its presence is necessary. */
+struct yy_trans_info
+ {
+ flex_int32_t yy_verify;
+ flex_int32_t yy_nxt;
+ };
+static yyconst flex_int16_t yy_acclist[312] =
+ { 0,
+ 74, 72, 73, 1, 72, 73, 1, 73, 3, 72,
+ 73, 72, 73, 60, 72, 73, 61, 72, 73, 52,
+ 72, 73, 50, 72, 73, 67, 72, 73, 51, 72,
+ 73, 66, 72, 73, 53, 72, 73, 47, 72, 73,
+ 69, 72, 73, 68, 72, 73, 56, 72, 73, 54,
+ 72, 73, 57, 72, 73, 72, 73, 71, 72, 73,
+ 62, 72, 73, 63, 72, 73, 70, 72, 73, 71,
+ 72, 73, 71, 72, 73, 71, 72, 73, 71, 72,
+ 73, 71, 72, 73, 71, 72, 73, 71, 72, 73,
+ 71, 72, 73, 71, 72, 73, 71, 72, 73, 71,
+
+ 72, 73, 71, 72, 73, 71, 72, 73, 71, 72,
+ 73, 71, 72, 73, 71, 72, 73, 71, 72, 73,
+ 71, 72, 73, 71, 72, 73, 2, 72, 73, 1,
+ 49, 65, 47, 64, 58, 55, 59, 71, 71, 71,
+ 71, 71, 71, 71, 71, 19, 71, 71, 71, 71,
+ 71, 71, 71, 71, 27, 71, 71, 71, 71, 31,
+ 71, 32, 71, 71, 71, 71, 71, 71, 40, 71,
+ 71, 71, 71, 71, 48, 49, 46, 46, 12, 71,
+ 71, 71, 71, 71, 71, 17, 71, 71, 71, 22,
+ 71, 71, 24, 71, 71, 71, 71, 71, 71, 71,
+
+ 29, 71, 30, 71, 71, 71, 71, 71, 71, 71,
+ 71, 71, 43, 71, 71, 49, 71, 71, 71, 15,
+ 71, 71, 71, 21, 71, 71, 23, 71, 71, 26,
+ 71, 71, 71, 71, 71, 71, 71, 71, 71, 71,
+ 71, 39, 71, 41, 71, 71, 71, 46, 13, 71,
+ 14, 71, 18, 71, 16, 71, 71, 71, 71, 37,
+ 38, 71, 71, 71, 28, 71, 71, 71, 71, 71,
+ 71, 71, 42, 71, 44, 71, 11, 20, 71, 5,
+ 71, 71, 71, 4, 71, 45, 71, 71, 71, 71,
+ 35, 71, 36, 71, 10, 7, 71, 71, 6, 1,
+
+ 71, 34, 71, 25, 71, 71, 71, 33, 71, 9,
+ 8
+ } ;
+
+static yyconst flex_int16_t yy_accept[273] =
+ { 0,
+ 1, 1, 1, 2, 4, 7, 9, 12, 14, 17,
+ 20, 23, 26, 29, 32, 35, 38, 41, 44, 47,
+ 50, 53, 56, 58, 61, 64, 67, 70, 73, 76,
+ 79, 82, 85, 88, 91, 94, 97, 100, 103, 106,
+ 109, 112, 115, 118, 121, 124, 127, 130, 131, 131,
+ 131, 132, 133, 133, 134, 134, 135, 136, 137, 138,
+ 138, 138, 139, 140, 141, 142, 143, 144, 145, 146,
+ 148, 149, 150, 151, 152, 153, 154, 155, 157, 158,
+ 159, 160, 162, 164, 165, 166, 167, 168, 169, 171,
+ 172, 173, 174, 175, 175, 175, 177, 178, 178, 179,
+
+ 179, 179, 181, 182, 183, 184, 185, 186, 188, 189,
+ 190, 192, 193, 195, 196, 197, 197, 197, 197, 198,
+ 198, 199, 200, 201, 203, 205, 206, 207, 208, 209,
+ 210, 211, 212, 213, 215, 216, 216, 217, 217, 217,
+ 217, 218, 219, 220, 222, 223, 224, 226, 227, 229,
+ 230, 232, 232, 232, 232, 232, 232, 232, 232, 233,
+ 233, 233, 234, 235, 236, 237, 238, 239, 240, 241,
+ 242, 244, 246, 247, 248, 248, 248, 249, 249, 249,
+ 251, 253, 255, 257, 258, 259, 260, 260, 260, 260,
+ 260, 261, 262, 262, 262, 262, 263, 264, 265, 267,
+
+ 268, 269, 270, 271, 272, 273, 275, 277, 277, 277,
+ 278, 280, 281, 282, 283, 283, 283, 283, 283, 284,
+ 285, 286, 288, 289, 290, 291, 293, 295, 295, 296,
+ 297, 298, 298, 298, 299, 300, 301, 302, 304, 306,
+ 306, 306, 307, 308, 308, 308, 308, 310, 310, 310,
+ 310, 310, 310, 310, 310, 310, 310, 310, 310, 310,
+ 310, 310, 310, 310, 310, 310, 310, 310, 311, 311,
+ 312, 312
+ } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 4, 1, 1, 5, 1, 1, 1, 6, 7,
+ 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
+ 17, 17, 17, 17, 17, 17, 17, 18, 19, 20,
+ 21, 22, 1, 23, 24, 24, 24, 24, 24, 24,
+ 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+ 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+ 25, 1, 26, 27, 1, 1, 28, 29, 30, 31,
+
+ 32, 33, 34, 35, 36, 37, 38, 39, 40, 41,
+ 42, 43, 37, 44, 45, 46, 47, 48, 49, 37,
+ 50, 37, 51, 1, 52, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1
+ } ;
+
+static yyconst flex_int32_t yy_meta[53] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 2, 2, 1, 1,
+ 2, 1, 1, 1, 3, 3, 3, 2, 1, 1,
+ 1, 1, 1, 3, 1, 1, 1, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
+ 1, 1
+ } ;
+
+static yyconst flex_int16_t yy_base[281] =
+ { 0,
+ 0, 0, 396, 397, 51, 54, 397, 389, 397, 397,
+ 397, 397, 397, 397, 381, 397, 46, 372, 397, 43,
+ 397, 371, 35, 0, 397, 397, 397, 26, 28, 41,
+ 35, 34, 38, 349, 355, 356, 360, 345, 344, 43,
+ 51, 353, 46, 343, 355, 347, 397, 88, 353, 374,
+ 373, 397, 83, 88, 96, 397, 397, 397, 397, 346,
+ 341, 0, 345, 331, 340, 341, 327, 330, 322, 320,
+ 323, 336, 327, 321, 323, 317, 112, 76, 333, 330,
+ 314, 0, 0, 324, 328, 315, 79, 324, 0, 312,
+ 308, 309, 316, 321, 344, 343, 111, 117, 120, 315,
+
+ 315, 0, 318, 309, 316, 311, 297, 0, 300, 308,
+ 303, 306, 0, 307, 294, 137, 326, 144, 306, 281,
+ 300, 300, 298, 0, 0, 297, 290, 52, 285, 294,
+ 284, 292, 287, 0, 283, 283, 314, 142, 283, 279,
+ 267, 275, 277, 0, 268, 267, 0, 279, 0, 265,
+ 0, 282, 300, 162, 299, 108, 279, 254, 275, 252,
+ 168, 270, 270, 262, 256, 267, 266, 253, 252, 267,
+ 0, 0, 255, 261, 260, 145, 161, 250, 259, 0,
+ 0, 0, 0, 247, 77, 252, 257, 277, 277, 275,
+ 397, 397, 253, 230, 194, 243, 272, 217, 0, 204,
+
+ 217, 216, 216, 212, 196, 0, 0, 210, 208, 397,
+ 0, 397, 232, 194, 197, 225, 224, 193, 198, 397,
+ 222, 0, 224, 180, 186, 0, 0, 221, 397, 397,
+ 177, 182, 180, 179, 397, 181, 162, 0, 196, 168,
+ 163, 189, 160, 0, 186, 185, 182, 163, 0, 200,
+ 160, 205, 132, 213, 124, 218, 125, 107, 109, 121,
+ 96, 98, 110, 99, 85, 102, 79, 397, 83, 397,
+ 397, 251, 253, 257, 261, 265, 269, 273, 276, 89
+ } ;
+
+static yyconst flex_int16_t yy_def[281] =
+ { 0,
+ 271, 1, 271, 271, 271, 271, 271, 272, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 273, 271, 271, 271, 273, 273, 273,
+ 273, 273, 273, 273, 273, 273, 273, 273, 273, 273,
+ 273, 273, 273, 273, 273, 273, 271, 271, 271, 274,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 273, 273, 273, 273, 273, 273, 273, 273, 273,
+ 273, 273, 273, 273, 273, 273, 273, 273, 273, 273,
+ 273, 273, 273, 273, 273, 273, 273, 273, 273, 273,
+ 273, 273, 273, 271, 274, 271, 271, 271, 271, 271,
+
+ 271, 273, 273, 273, 273, 273, 273, 273, 273, 273,
+ 273, 273, 273, 273, 273, 271, 271, 271, 273, 275,
+ 273, 273, 273, 273, 273, 273, 273, 273, 273, 273,
+ 273, 273, 273, 273, 273, 271, 271, 271, 271, 271,
+ 273, 273, 273, 273, 273, 273, 273, 273, 273, 273,
+ 273, 271, 276, 271, 271, 271, 271, 277, 273, 275,
+ 271, 273, 273, 273, 273, 273, 273, 273, 273, 273,
+ 273, 273, 273, 273, 271, 271, 271, 271, 271, 273,
+ 273, 273, 273, 273, 273, 273, 271, 276, 276, 278,
+ 271, 271, 271, 277, 271, 273, 273, 273, 273, 273,
+
+ 273, 273, 273, 273, 273, 273, 273, 271, 271, 271,
+ 273, 271, 273, 273, 271, 278, 278, 271, 273, 271,
+ 273, 273, 273, 273, 273, 273, 273, 271, 271, 271,
+ 273, 271, 271, 273, 271, 271, 273, 273, 273, 271,
+ 271, 273, 273, 279, 271, 271, 273, 279, 280, 271,
+ 280, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 0, 271, 271, 271, 271, 271, 271, 271, 271, 271
+ } ;
+
+static yyconst flex_int16_t yy_nxt[450] =
+ { 0,
+ 4, 5, 6, 5, 7, 8, 9, 10, 11, 12,
+ 13, 14, 15, 16, 17, 17, 17, 18, 19, 20,
+ 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
+ 31, 32, 33, 34, 35, 36, 24, 24, 37, 38,
+ 39, 40, 41, 42, 24, 43, 44, 45, 46, 24,
+ 47, 4, 48, 48, 48, 48, 48, 48, 53, 65,
+ 54, 54, 54, 57, 58, 60, 63, 61, 67, 64,
+ 69, 66, 71, 73, 72, 82, 70, 55, 85, 74,
+ 88, 167, 68, 212, 75, 168, 83, 89, 84, 48,
+ 48, 48, 251, 49, 86, 90, 49, 97, 97, 97,
+
+ 53, 270, 54, 54, 54, 98, 121, 98, 129, 269,
+ 99, 99, 99, 116, 116, 116, 122, 213, 117, 55,
+ 268, 130, 191, 192, 118, 97, 97, 97, 267, 266,
+ 49, 99, 99, 99, 99, 99, 99, 265, 116, 116,
+ 116, 264, 138, 117, 263, 154, 154, 154, 262, 118,
+ 155, 176, 261, 176, 119, 260, 177, 177, 177, 177,
+ 177, 177, 120, 154, 154, 154, 259, 258, 155, 116,
+ 116, 116, 156, 255, 117, 177, 177, 177, 254, 152,
+ 118, 250, 48, 48, 48, 249, 157, 120, 195, 161,
+ 156, 247, 161, 246, 158, 154, 154, 154, 245, 244,
+
+ 155, 252, 252, 252, 157, 243, 252, 252, 252, 242,
+ 152, 241, 158, 240, 256, 256, 256, 239, 120, 256,
+ 256, 256, 156, 49, 236, 238, 237, 236, 235, 234,
+ 233, 195, 253, 217, 232, 231, 157, 253, 230, 229,
+ 228, 227, 226, 225, 158, 257, 224, 223, 222, 221,
+ 257, 50, 50, 50, 50, 62, 62, 95, 95, 95,
+ 95, 160, 160, 160, 160, 188, 188, 188, 188, 194,
+ 194, 194, 194, 216, 216, 216, 216, 248, 220, 248,
+ 219, 195, 218, 217, 161, 189, 215, 214, 211, 210,
+ 209, 208, 207, 206, 205, 204, 203, 202, 201, 200,
+
+ 199, 198, 197, 161, 196, 195, 193, 190, 189, 187,
+ 186, 185, 184, 183, 182, 181, 180, 179, 178, 95,
+ 175, 174, 173, 172, 171, 170, 169, 166, 165, 164,
+ 163, 162, 161, 159, 153, 151, 150, 149, 148, 147,
+ 146, 145, 144, 143, 142, 141, 140, 139, 95, 137,
+ 136, 135, 134, 133, 132, 131, 128, 127, 126, 125,
+ 124, 123, 115, 114, 113, 112, 111, 110, 109, 108,
+ 107, 106, 105, 104, 103, 102, 101, 100, 50, 96,
+ 94, 93, 92, 91, 87, 81, 80, 79, 78, 77,
+ 76, 59, 56, 52, 51, 271, 3, 271, 271, 271,
+
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271
+ } ;
+
+static yyconst flex_int16_t yy_chk[450] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 5, 5, 5, 6, 6, 6, 17, 29,
+ 17, 17, 17, 20, 20, 23, 28, 23, 30, 28,
+ 31, 29, 32, 33, 32, 40, 31, 17, 41, 33,
+ 43, 128, 30, 185, 33, 128, 40, 43, 40, 48,
+ 48, 48, 280, 5, 41, 43, 6, 53, 53, 53,
+
+ 54, 269, 54, 54, 54, 55, 78, 55, 87, 267,
+ 55, 55, 55, 77, 77, 77, 78, 185, 77, 54,
+ 266, 87, 156, 156, 77, 97, 97, 97, 265, 264,
+ 48, 98, 98, 98, 99, 99, 99, 263, 116, 116,
+ 116, 262, 97, 116, 261, 118, 118, 118, 260, 116,
+ 118, 138, 259, 138, 77, 258, 138, 138, 138, 176,
+ 176, 176, 77, 154, 154, 154, 257, 255, 154, 161,
+ 161, 161, 118, 253, 161, 177, 177, 177, 251, 116,
+ 161, 248, 236, 236, 236, 247, 118, 116, 246, 245,
+ 154, 243, 242, 241, 118, 195, 195, 195, 240, 239,
+
+ 195, 250, 250, 250, 154, 237, 252, 252, 252, 234,
+ 161, 233, 154, 232, 254, 254, 254, 231, 161, 256,
+ 256, 256, 195, 236, 228, 225, 224, 223, 221, 219,
+ 218, 217, 250, 216, 215, 214, 195, 252, 213, 209,
+ 208, 205, 204, 203, 195, 254, 202, 201, 200, 198,
+ 256, 272, 272, 272, 272, 273, 273, 274, 274, 274,
+ 274, 275, 275, 275, 275, 276, 276, 276, 276, 277,
+ 277, 277, 277, 278, 278, 278, 278, 279, 197, 279,
+ 196, 194, 193, 190, 189, 188, 187, 186, 184, 179,
+ 178, 175, 174, 173, 170, 169, 168, 167, 166, 165,
+
+ 164, 163, 162, 160, 159, 158, 157, 155, 153, 152,
+ 150, 148, 146, 145, 143, 142, 141, 140, 139, 137,
+ 136, 135, 133, 132, 131, 130, 129, 127, 126, 123,
+ 122, 121, 120, 119, 117, 115, 114, 112, 111, 110,
+ 109, 107, 106, 105, 104, 103, 101, 100, 96, 95,
+ 94, 93, 92, 91, 90, 88, 86, 85, 84, 81,
+ 80, 79, 76, 75, 74, 73, 72, 71, 70, 69,
+ 68, 67, 66, 65, 64, 63, 61, 60, 51, 50,
+ 49, 46, 45, 44, 42, 39, 38, 37, 36, 35,
+ 34, 22, 18, 15, 8, 3, 271, 271, 271, 271,
+
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271, 271,
+ 271, 271, 271, 271, 271, 271, 271, 271, 271
+ } ;
+
+/* Table of booleans, true if rule could match eol. */
+static yyconst flex_int32_t yy_rule_can_match_eol[74] =
+ { 0,
+1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, };
+
+extern int yy_flex_debug;
+int yy_flex_debug = 0;
+
+static yy_state_type *yy_state_buf=0, *yy_state_ptr=0;
+static char *yy_full_match;
+static int yy_lp;
+#define REJECT \
+{ \
+*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ \
+yy_cp = (yy_full_match); /* restore poss. backed-over text */ \
+++(yy_lp); \
+goto find_rule; \
+}
+
+static int yy_more_offset = 0;
+static int yy_prev_more_offset = 0;
+#define yymore() ((yy_more_offset) = yy_flex_strlen( yytext ))
+#define YY_NEED_STRLEN
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET \
+ { \
+ (yy_more_offset) = (yy_prev_more_offset); \
+ yyleng -= (yy_more_offset); \
+ }
+#ifndef YYLMAX
+#define YYLMAX 8192
+#endif
+
+char yytext[YYLMAX];
+char *yytext_ptr;
+#line 1 "./web2c.l"
+#line 2 "./web2c.l"
+/* web2c.l -- lexical analysis for Tangle output. Public domain. */
+
+#include "web2c.h"
+#include "y_tab.h"
+
+/* Hack to make it possible to compile the generated code with C++
+ Required if you use flex. */
+#ifdef __cplusplus
+#define webinput yyinput
+#else
+#define webinput input
+#endif
+
+/* For some reason flex wants to do a system call, so we must lose our
+ definition of the Pascal read. */
+#undef read
+
+char conditional[20], negbuf[2], temp[20];
+extern boolean doing_statements;
+
+
+/* We only read one input file. This is the default definition, but
+ giving it ourselves avoids the need to find -lfl or -ll at link time.
+ This is a good thing, since libfl.a is often installed somewhere that
+ the linker doesn't search by default. */
+int
+yywrap P1H(void)
+{
+ return 1;
+}
+#define YY_SKIP_YYWRAP /* not that it matters */
+#line 743 "lex.yy.c"
+
+#define INITIAL 0
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int yywrap (void );
+#else
+extern int yywrap (void );
+#endif
+#endif
+
+ static void yyunput (int c,char *buf_ptr );
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO (void) fwrite( yytext, yyleng, 1, yyout )
+#endif
+
+/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+ { \
+ int c = '*'; \
+ size_t n; \
+ for ( n = 0; n < max_size && \
+ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+ buf[n] = (char) c; \
+ if ( c == '\n' ) \
+ buf[n++] = (char) c; \
+ if ( c == EOF && ferror( yyin ) ) \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ result = n; \
+ } \
+ else \
+ { \
+ errno=0; \
+ while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \
+ { \
+ if( errno != EINTR) \
+ { \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ break; \
+ } \
+ errno=0; \
+ clearerr(yyin); \
+ } \
+ }\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int yylex (void);
+
+#define YY_DECL int yylex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after yytext and yyleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+ YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp, *yy_bp;
+ register int yy_act;
+
+#line 49 "./web2c.l"
+
+#line 896 "lex.yy.c"
+
+ if ( (yy_init) )
+ {
+ (yy_init) = 0;
+
+#ifdef YY_USER_INIT
+ YY_USER_INIT;
+#endif
+
+ if ( ! (yy_state_buf) )
+ (yy_state_buf) = (yy_state_type *)yyalloc(YY_BUF_SIZE + 2 );
+
+ if ( ! (yy_start) )
+ (yy_start) = 1; /* first start state */
+
+ if ( ! yyin )
+ yyin = stdin;
+
+ if ( ! yyout )
+ yyout = stdout;
+
+ if ( ! YY_CURRENT_BUFFER ) {
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_load_buffer_state( );
+ }
+
+ while ( 1 ) /* loops until end-of-file is reached */
+ {
+ yy_cp = (yy_c_buf_p);
+
+ /* Support of yytext. */
+ *yy_cp = (yy_hold_char);
+
+ /* yy_bp points to the position in yy_ch_buf of the start of
+ * the current run.
+ */
+ yy_bp = yy_cp;
+
+ yy_current_state = (yy_start);
+
+ (yy_state_ptr) = (yy_state_buf);
+ *(yy_state_ptr)++ = yy_current_state;
+
+yy_match:
+ do
+ {
+ register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 272 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *(yy_state_ptr)++ = yy_current_state;
+ ++yy_cp;
+ }
+ while ( yy_base[yy_current_state] != 397 );
+
+yy_find_action:
+ yy_current_state = *--(yy_state_ptr);
+ (yy_lp) = yy_accept[yy_current_state];
+find_rule: /* we branch to this label when backing up */
+ for ( ; ; ) /* until we find what rule we matched */
+ {
+ if ( (yy_lp) && (yy_lp) < yy_accept[yy_current_state + 1] )
+ {
+ yy_act = yy_acclist[(yy_lp)];
+ {
+ (yy_full_match) = yy_cp;
+ break;
+ }
+ }
+ --yy_cp;
+ yy_current_state = *--(yy_state_ptr);
+ (yy_lp) = yy_accept[yy_current_state];
+ }
+
+ YY_DO_BEFORE_ACTION;
+
+ if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] )
+ {
+ int yyl;
+ for ( yyl = (yy_prev_more_offset); yyl < yyleng; ++yyl )
+ if ( yytext[yyl] == '\n' )
+
+ yylineno++;
+;
+ }
+
+do_action: /* This label is used only to access EOF actions. */
+
+ switch ( yy_act )
+ { /* beginning of action switch */
+case 1:
+/* rule 1 can match eol */
+YY_RULE_SETUP
+#line 50 "./web2c.l"
+;
+ YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 51 "./web2c.l"
+{ while (webinput() != '}'); }
+ YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 53 "./web2c.l"
+{
+ register int c;
+ putc('#', out);
+ while ((c = webinput()) && c != ';')
+ putc(c, out);
+ putc('\n', out);
+ }
+ YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 61 "./web2c.l"
+{register int c;
+ register char *cp=conditional;
+ new_line();
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ *cp++ = c;
+ *cp = '\0';
+ (void) webinput();
+ if (doing_statements) fputs("\t;\n", out);
+ fprintf(out, "#ifdef %s\n", conditional);
+ }
+ YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 74 "./web2c.l"
+{register int c;
+ new_line();
+ fputs("#endif /* ", out);
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ (void) putc(c, out);
+ (void) webinput();
+ conditional[0] = '\0';
+ fputs(" */\n", out);
+ }
+ YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 86 "./web2c.l"
+{register int c;
+ register char *cp=conditional;
+ new_line();
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ *cp++ = c;
+ *cp = '\0';
+ (void) webinput();
+ if (doing_statements) fputs("\t;\n", out);
+ fprintf(out, "#ifndef %s\n", conditional);
+ }
+ YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 99 "./web2c.l"
+{register int c;
+ new_line();
+ fputs("#endif /* not ", out);
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ putc(c, out);
+ (void) webinput();
+ conditional[0] = '\0';
+ fputs(" */\n", out);
+ }
+ YY_BREAK
+case 8:
+/* rule 8 can match eol */
+YY_RULE_SETUP
+#line 112 "./web2c.l"
+;
+ YY_BREAK
+case 9:
+/* rule 9 can match eol */
+YY_RULE_SETUP
+#line 114 "./web2c.l"
+;
+ YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 116 "./web2c.l"
+return last_tok=define_tok;
+ YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 117 "./web2c.l"
+return last_tok=field_tok;
+ YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 118 "./web2c.l"
+return last_tok=and_tok;
+ YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 119 "./web2c.l"
+return last_tok=array_tok;
+ YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 120 "./web2c.l"
+return last_tok=begin_tok;
+ YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 121 "./web2c.l"
+return last_tok=case_tok;
+ YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 122 "./web2c.l"
+return last_tok=const_tok;
+ YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 123 "./web2c.l"
+return last_tok=div_tok;
+ YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 124 "./web2c.l"
+return last_tok=break_tok;
+ YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 125 "./web2c.l"
+return last_tok=do_tok;
+ YY_BREAK
+case 20:
+YY_RULE_SETUP
+#line 126 "./web2c.l"
+return last_tok=downto_tok;
+ YY_BREAK
+case 21:
+YY_RULE_SETUP
+#line 127 "./web2c.l"
+return last_tok=else_tok;
+ YY_BREAK
+case 22:
+YY_RULE_SETUP
+#line 128 "./web2c.l"
+return last_tok=end_tok;
+ YY_BREAK
+case 23:
+YY_RULE_SETUP
+#line 129 "./web2c.l"
+return last_tok=file_tok;
+ YY_BREAK
+case 24:
+YY_RULE_SETUP
+#line 130 "./web2c.l"
+return last_tok=for_tok;
+ YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 131 "./web2c.l"
+return last_tok=function_tok;
+ YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 132 "./web2c.l"
+return last_tok=goto_tok;
+ YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 133 "./web2c.l"
+return last_tok=if_tok;
+ YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 134 "./web2c.l"
+return last_tok=label_tok;
+ YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 135 "./web2c.l"
+return last_tok=mod_tok;
+ YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 136 "./web2c.l"
+return last_tok=not_tok;
+ YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 137 "./web2c.l"
+return last_tok=of_tok;
+ YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 138 "./web2c.l"
+return last_tok=or_tok;
+ YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 139 "./web2c.l"
+return last_tok=procedure_tok;
+ YY_BREAK
+case 34:
+YY_RULE_SETUP
+#line 140 "./web2c.l"
+return last_tok=program_tok;
+ YY_BREAK
+case 35:
+YY_RULE_SETUP
+#line 141 "./web2c.l"
+return last_tok=record_tok;
+ YY_BREAK
+case 36:
+YY_RULE_SETUP
+#line 142 "./web2c.l"
+return last_tok=repeat_tok;
+ YY_BREAK
+case 37:
+/* rule 37 can match eol */
+YY_RULE_SETUP
+#line 143 "./web2c.l"
+return last_tok=hhb0_tok;
+ YY_BREAK
+case 38:
+/* rule 38 can match eol */
+YY_RULE_SETUP
+#line 144 "./web2c.l"
+return last_tok=hhb1_tok;
+ YY_BREAK
+case 39:
+YY_RULE_SETUP
+#line 145 "./web2c.l"
+return last_tok=then_tok;
+ YY_BREAK
+case 40:
+YY_RULE_SETUP
+#line 146 "./web2c.l"
+return last_tok=to_tok;
+ YY_BREAK
+case 41:
+YY_RULE_SETUP
+#line 147 "./web2c.l"
+return last_tok=type_tok;
+ YY_BREAK
+case 42:
+YY_RULE_SETUP
+#line 148 "./web2c.l"
+return last_tok=until_tok;
+ YY_BREAK
+case 43:
+YY_RULE_SETUP
+#line 149 "./web2c.l"
+return last_tok=var_tok;
+ YY_BREAK
+case 44:
+YY_RULE_SETUP
+#line 150 "./web2c.l"
+return last_tok=while_tok;
+ YY_BREAK
+case 45:
+YY_RULE_SETUP
+#line 151 "./web2c.l"
+return last_tok=others_tok;
+ YY_BREAK
+case 46:
+YY_RULE_SETUP
+#line 153 "./web2c.l"
+{
+ sprintf (temp, "%s%s", negbuf, yytext);
+ negbuf[0] = '\0';
+ return last_tok=r_num_tok;
+ }
+ YY_BREAK
+case 47:
+YY_RULE_SETUP
+#line 159 "./web2c.l"
+{
+ sprintf (temp, "%s%s", negbuf, yytext);
+ negbuf[0] = '\0';
+ return last_tok=i_num_tok;
+ }
+ YY_BREAK
+case 48:
+/* rule 48 can match eol */
+YY_RULE_SETUP
+#line 165 "./web2c.l"
+return last_tok=single_char_tok;
+ YY_BREAK
+case 49:
+/* rule 49 can match eol */
+YY_RULE_SETUP
+#line 167 "./web2c.l"
+return last_tok=string_literal_tok;
+ YY_BREAK
+case 50:
+YY_RULE_SETUP
+#line 169 "./web2c.l"
+{ if ((last_tok>=undef_id_tok &&
+ last_tok<=field_id_tok) ||
+ last_tok==i_num_tok ||
+ last_tok==r_num_tok ||
+ last_tok==')' ||
+ last_tok==']')
+ return last_tok='+';
+ else return last_tok=unary_plus_tok; }
+ YY_BREAK
+case 51:
+YY_RULE_SETUP
+#line 178 "./web2c.l"
+{ if ((last_tok>=undef_id_tok &&
+ last_tok<=field_id_tok) ||
+ last_tok==i_num_tok ||
+ last_tok==r_num_tok ||
+ last_tok==')' ||
+ last_tok==']')
+ return last_tok='-';
+ else {
+ int c;
+ while ((c = webinput()) == ' ' || c == '\t')
+ ;
+ unput(c);
+ if (c < '0' || c > '9') {
+ return last_tok = unary_minus_tok;
+ }
+ negbuf[0] = '-';
+ }}
+ YY_BREAK
+case 52:
+YY_RULE_SETUP
+#line 196 "./web2c.l"
+return last_tok='*';
+ YY_BREAK
+case 53:
+YY_RULE_SETUP
+#line 197 "./web2c.l"
+return last_tok='/';
+ YY_BREAK
+case 54:
+YY_RULE_SETUP
+#line 198 "./web2c.l"
+return last_tok='=';
+ YY_BREAK
+case 55:
+YY_RULE_SETUP
+#line 199 "./web2c.l"
+return last_tok=not_eq_tok;
+ YY_BREAK
+case 56:
+YY_RULE_SETUP
+#line 200 "./web2c.l"
+return last_tok='<';
+ YY_BREAK
+case 57:
+YY_RULE_SETUP
+#line 201 "./web2c.l"
+return last_tok='>';
+ YY_BREAK
+case 58:
+YY_RULE_SETUP
+#line 202 "./web2c.l"
+return last_tok=less_eq_tok;
+ YY_BREAK
+case 59:
+YY_RULE_SETUP
+#line 203 "./web2c.l"
+return last_tok=great_eq_tok;
+ YY_BREAK
+case 60:
+YY_RULE_SETUP
+#line 204 "./web2c.l"
+return last_tok='(';
+ YY_BREAK
+case 61:
+YY_RULE_SETUP
+#line 205 "./web2c.l"
+return last_tok=')';
+ YY_BREAK
+case 62:
+YY_RULE_SETUP
+#line 206 "./web2c.l"
+return last_tok='[';
+ YY_BREAK
+case 63:
+YY_RULE_SETUP
+#line 207 "./web2c.l"
+return last_tok=']';
+ YY_BREAK
+case 64:
+YY_RULE_SETUP
+#line 208 "./web2c.l"
+return last_tok=assign_tok;
+ YY_BREAK
+case 65:
+YY_RULE_SETUP
+#line 209 "./web2c.l"
+return last_tok=two_dots_tok;
+ YY_BREAK
+case 66:
+YY_RULE_SETUP
+#line 210 "./web2c.l"
+return last_tok='.';
+ YY_BREAK
+case 67:
+YY_RULE_SETUP
+#line 211 "./web2c.l"
+return last_tok=',';
+ YY_BREAK
+case 68:
+YY_RULE_SETUP
+#line 212 "./web2c.l"
+return last_tok=';';
+ YY_BREAK
+case 69:
+YY_RULE_SETUP
+#line 213 "./web2c.l"
+return last_tok=':';
+ YY_BREAK
+case 70:
+YY_RULE_SETUP
+#line 214 "./web2c.l"
+return last_tok='^';
+ YY_BREAK
+case 71:
+YY_RULE_SETUP
+#line 216 "./web2c.l"
+{ strcpy (last_id, yytext);
+ l_s = search_table (last_id);
+ return
+ last_tok = (l_s == -1 ? undef_id_tok : sym_table[l_s].typ);
+ }
+ YY_BREAK
+case 72:
+YY_RULE_SETUP
+#line 223 "./web2c.l"
+{ /* Any bizarre token will do. */
+ return last_tok = two_dots_tok; }
+ YY_BREAK
+case 73:
+YY_RULE_SETUP
+#line 225 "./web2c.l"
+ECHO;
+ YY_BREAK
+#line 1451 "lex.yy.c"
+ case YY_STATE_EOF(INITIAL):
+ yyterminate();
+
+ case YY_END_OF_BUFFER:
+ {
+ /* Amount of text matched not including the EOB char. */
+ int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+ /* Undo the effects of YY_DO_BEFORE_ACTION. */
+ *yy_cp = (yy_hold_char);
+ YY_RESTORE_YY_MORE_OFFSET
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+ {
+ /* We're scanning a new file or input source. It's
+ * possible that this happened because the user
+ * just pointed yyin at a new source and called
+ * yylex(). If so, then we have to assure
+ * consistency between YY_CURRENT_BUFFER and our
+ * globals. Here is the right place to do so, because
+ * this is the first action (other than possibly a
+ * back-up) that will match for the new input source.
+ */
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+ }
+
+ /* Note that here we test for yy_c_buf_p "<=" to the position
+ * of the first EOB in the buffer, since yy_c_buf_p will
+ * already have been incremented past the NUL character
+ * (since all states make transitions on EOB to the
+ * end-of-buffer state). Contrast this with the test
+ * in input().
+ */
+ if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ { /* This was really a NUL. */
+ yy_state_type yy_next_state;
+
+ (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ /* Okay, we're now positioned to make the NUL
+ * transition. We couldn't have
+ * yy_get_previous_state() go ahead and do it
+ * for us because it doesn't know how to deal
+ * with the possibility of jamming (and we don't
+ * want to build jamming into it because then it
+ * will run more slowly).
+ */
+
+ yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+ if ( yy_next_state )
+ {
+ /* Consume the NUL. */
+ yy_cp = ++(yy_c_buf_p);
+ yy_current_state = yy_next_state;
+ goto yy_match;
+ }
+
+ else
+ {
+ yy_cp = (yy_c_buf_p);
+ goto yy_find_action;
+ }
+ }
+
+ else switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ (yy_did_buffer_switch_on_eof) = 0;
+
+ if ( yywrap( ) )
+ {
+ /* Note: because we've taken care in
+ * yy_get_next_buffer() to have set up
+ * yytext, we can now set up
+ * yy_c_buf_p so that if some total
+ * hoser (like flex itself) wants to
+ * call the scanner after we return the
+ * YY_NULL, it'll still work - another
+ * YY_NULL will get returned.
+ */
+ (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+ yy_act = YY_STATE_EOF(YY_START);
+ goto do_action;
+ }
+
+ else
+ {
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+ }
+ break;
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) =
+ (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_match;
+
+ case EOB_ACT_LAST_MATCH:
+ (yy_c_buf_p) =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_find_action;
+ }
+ break;
+ }
+
+ default:
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--no action found" );
+ } /* end of action switch */
+ } /* end of scanning one token */
+} /* end of yylex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ * EOB_ACT_LAST_MATCH -
+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ * EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+ register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+ register char *source = (yytext_ptr);
+ register int number_to_move, i;
+ int ret_val;
+
+ if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--end of buffer missed" );
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+ { /* Don't try to fill the buffer, so this is an EOF. */
+ if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+ {
+ /* We matched a single character, the EOB, so
+ * treat this as a final EOF.
+ */
+ return EOB_ACT_END_OF_FILE;
+ }
+
+ else
+ {
+ /* We matched some text prior to the EOB, first
+ * process it.
+ */
+ return EOB_ACT_LAST_MATCH;
+ }
+ }
+
+ /* Try to read more data. */
+
+ /* First move last chars to start of buffer. */
+ number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+ for ( i = 0; i < number_to_move; ++i )
+ *(dest++) = *(source++);
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+ /* don't do the read, it's not guaranteed to return an EOF,
+ * just force an EOF
+ */
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+ else
+ {
+ size_t num_to_read =
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+ while ( num_to_read <= 0 )
+ { /* Not enough room in the buffer - grow it. */
+
+ YY_FATAL_ERROR(
+"input buffer overflow, can't enlarge buffer because scanner uses REJECT" );
+
+ }
+
+ if ( num_to_read > YY_READ_BUF_SIZE )
+ num_to_read = YY_READ_BUF_SIZE;
+
+ /* Read in more data. */
+ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+ (yy_n_chars), num_to_read );
+
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ if ( (yy_n_chars) == 0 )
+ {
+ if ( number_to_move == YY_MORE_ADJ )
+ {
+ ret_val = EOB_ACT_END_OF_FILE;
+ yyrestart(yyin );
+ }
+
+ else
+ {
+ ret_val = EOB_ACT_LAST_MATCH;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+ YY_BUFFER_EOF_PENDING;
+ }
+ }
+
+ else
+ ret_val = EOB_ACT_CONTINUE_SCAN;
+
+ (yy_n_chars) += number_to_move;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+ (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+ return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+ static yy_state_type yy_get_previous_state (void)
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp;
+
+ yy_current_state = (yy_start);
+
+ (yy_state_ptr) = (yy_state_buf);
+ *(yy_state_ptr)++ = yy_current_state;
+
+ for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+ {
+ register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 272 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *(yy_state_ptr)++ = yy_current_state;
+ }
+
+ return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ * next_state = yy_try_NUL_trans( current_state );
+ */
+ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state )
+{
+ register int yy_is_jam;
+
+ register YY_CHAR yy_c = 1;
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 272 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ yy_is_jam = (yy_current_state == 271);
+ if ( ! yy_is_jam )
+ *(yy_state_ptr)++ = yy_current_state;
+
+ return yy_is_jam ? 0 : yy_current_state;
+}
+
+ static void yyunput (int c, register char * yy_bp )
+{
+ register char *yy_cp;
+
+ yy_cp = (yy_c_buf_p);
+
+ /* undo effects of setting up yytext */
+ *yy_cp = (yy_hold_char);
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ { /* need to shift things up to make room */
+ /* +2 for EOB chars. */
+ register int number_to_move = (yy_n_chars) + 2;
+ register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+ register char *source =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+ while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ *--dest = *--source;
+
+ yy_cp += (int) (dest - source);
+ yy_bp += (int) (dest - source);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ YY_FATAL_ERROR( "flex scanner push-back overflow" );
+ }
+
+ *--yy_cp = (char) c;
+
+ if ( c == '\n' ){
+ --yylineno;
+ }
+
+ (yytext_ptr) = yy_bp;
+ (yy_hold_char) = *yy_cp;
+ (yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+ static int yyinput (void)
+#else
+ static int input (void)
+#endif
+
+{
+ int c;
+
+ *(yy_c_buf_p) = (yy_hold_char);
+
+ if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+ {
+ /* yy_c_buf_p now points to the character we want to return.
+ * If this occurs *before* the EOB characters, then it's a
+ * valid NUL; if not, then we've hit the end of the buffer.
+ */
+ if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ /* This was really a NUL. */
+ *(yy_c_buf_p) = '\0';
+
+ else
+ { /* need more input */
+ int offset = (yy_c_buf_p) - (yytext_ptr);
+ ++(yy_c_buf_p);
+
+ switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_LAST_MATCH:
+ /* This happens because yy_g_n_b()
+ * sees that we've accumulated a
+ * token and flags that we need to
+ * try matching the token before
+ * proceeding. But for input(),
+ * there's no matching to consider.
+ * So convert the EOB_ACT_LAST_MATCH
+ * to EOB_ACT_END_OF_FILE.
+ */
+
+ /* Reset buffer status. */
+ yyrestart(yyin );
+
+ /*FALLTHROUGH*/
+
+ case EOB_ACT_END_OF_FILE:
+ {
+ if ( yywrap( ) )
+ return EOF;
+
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+#ifdef __cplusplus
+ return yyinput();
+#else
+ return input();
+#endif
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) = (yytext_ptr) + offset;
+ break;
+ }
+ }
+ }
+
+ c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */
+ *(yy_c_buf_p) = '\0'; /* preserve yytext */
+ (yy_hold_char) = *++(yy_c_buf_p);
+
+ if ( c == '\n' )
+
+ yylineno++;
+;
+
+ return c;
+}
+#endif /* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ *
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+ void yyrestart (FILE * input_file )
+{
+
+ if ( ! YY_CURRENT_BUFFER ){
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_init_buffer(YY_CURRENT_BUFFER,input_file );
+ yy_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ *
+ */
+ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer )
+{
+
+ /* TODO. We should be able to replace this entire function body
+ * with
+ * yypop_buffer_state();
+ * yypush_buffer_state(new_buffer);
+ */
+ yyensure_buffer_stack ();
+ if ( YY_CURRENT_BUFFER == new_buffer )
+ return;
+
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+ yy_load_buffer_state( );
+
+ /* We don't actually know whether we did this switch during
+ * EOF (yywrap()) processing, but the only time this flag
+ * is looked at is after yywrap() is called, so it's safe
+ * to go ahead and always set it.
+ */
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void yy_load_buffer_state (void)
+{
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+ yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+ (yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ *
+ * @return the allocated buffer state.
+ */
+ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size )
+{
+ YY_BUFFER_STATE b;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_buf_size = size;
+
+ /* yy_ch_buf has to be 2 characters longer than the size given because
+ * we need to put in 2 end-of-buffer characters.
+ */
+ b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2 );
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_is_our_buffer = 1;
+
+ yy_init_buffer(b,file );
+
+ return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with yy_create_buffer()
+ *
+ */
+ void yy_delete_buffer (YY_BUFFER_STATE b )
+{
+
+ if ( ! b )
+ return;
+
+ if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+ if ( b->yy_is_our_buffer )
+ yyfree((void *) b->yy_ch_buf );
+
+ yyfree((void *) b );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a yyrestart() or at EOF.
+ */
+ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file )
+
+{
+ int oerrno = errno;
+
+ yy_flush_buffer(b );
+
+ b->yy_input_file = file;
+ b->yy_fill_buffer = 1;
+
+ /* If b is the current buffer, then yy_init_buffer was _probably_
+ * called from yyrestart() or through yy_get_next_buffer.
+ * In that case, we don't want to reset the lineno or column.
+ */
+ if (b != YY_CURRENT_BUFFER){
+ b->yy_bs_lineno = 1;
+ b->yy_bs_column = 0;
+ }
+
+ b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+
+ errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ *
+ */
+ void yy_flush_buffer (YY_BUFFER_STATE b )
+{
+ if ( ! b )
+ return;
+
+ b->yy_n_chars = 0;
+
+ /* We always need two end-of-buffer characters. The first causes
+ * a transition to the end-of-buffer state. The second causes
+ * a jam in that state.
+ */
+ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+ b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+ b->yy_buf_pos = &b->yy_ch_buf[0];
+
+ b->yy_at_bol = 1;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ if ( b == YY_CURRENT_BUFFER )
+ yy_load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ * the current state. This function will allocate the stack
+ * if necessary.
+ * @param new_buffer The new state.
+ *
+ */
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+ if (new_buffer == NULL)
+ return;
+
+ yyensure_buffer_stack();
+
+ /* This block is copied from yy_switch_to_buffer. */
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ /* Only push if top exists. Otherwise, replace top. */
+ if (YY_CURRENT_BUFFER)
+ (yy_buffer_stack_top)++;
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+ /* copied from yy_switch_to_buffer. */
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ * The next element becomes the new top.
+ *
+ */
+void yypop_buffer_state (void)
+{
+ if (!YY_CURRENT_BUFFER)
+ return;
+
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ if ((yy_buffer_stack_top) > 0)
+ --(yy_buffer_stack_top);
+
+ if (YY_CURRENT_BUFFER) {
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+ }
+}
+
+/* Allocates the stack if it does not exist.
+ * Guarantees space for at least one push.
+ */
+static void yyensure_buffer_stack (void)
+{
+ int num_to_alloc;
+
+ if (!(yy_buffer_stack)) {
+
+ /* First allocation is just for 2 elements, since we don't know if this
+ * scanner will even need a stack. We use 2 instead of 1 to avoid an
+ * immediate realloc on the next call.
+ */
+ num_to_alloc = 1;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
+ (num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+
+ memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+
+ (yy_buffer_stack_max) = num_to_alloc;
+ (yy_buffer_stack_top) = 0;
+ return;
+ }
+
+ if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+ /* Increase the buffer to prepare for a possible push. */
+ int grow_size = 8 /* arbitrary grow size */;
+
+ num_to_alloc = (yy_buffer_stack_max) + grow_size;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
+ ((yy_buffer_stack),
+ num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+
+ /* zero only the new slots.*/
+ memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+ (yy_buffer_stack_max) = num_to_alloc;
+ }
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )
+{
+ YY_BUFFER_STATE b;
+
+ if ( size < 2 ||
+ base[size-2] != YY_END_OF_BUFFER_CHAR ||
+ base[size-1] != YY_END_OF_BUFFER_CHAR )
+ /* They forgot to leave room for the EOB's. */
+ return 0;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+
+ b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */
+ b->yy_buf_pos = b->yy_ch_buf = base;
+ b->yy_is_our_buffer = 0;
+ b->yy_input_file = 0;
+ b->yy_n_chars = b->yy_buf_size;
+ b->yy_is_interactive = 0;
+ b->yy_at_bol = 1;
+ b->yy_fill_buffer = 0;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ yy_switch_to_buffer(b );
+
+ return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to yylex() will
+ * scan from a @e copy of @a str.
+ * @param str a NUL-terminated string to scan
+ *
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ * yy_scan_bytes() instead.
+ */
+YY_BUFFER_STATE yy_scan_string (yyconst char * yy_str )
+{
+
+ return yy_scan_bytes(yy_str,strlen(yy_str) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_bytes (yyconst char * bytes, int len )
+{
+ YY_BUFFER_STATE b;
+ char *buf;
+ yy_size_t n;
+ int i;
+
+ /* Get memory for full buffer, including space for trailing EOB's. */
+ n = len + 2;
+ buf = (char *) yyalloc(n );
+ if ( ! buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+
+ for ( i = 0; i < len; ++i )
+ buf[i] = bytes[i];
+
+ buf[len] = buf[len+1] = YY_END_OF_BUFFER_CHAR;
+
+ b = yy_scan_buffer(buf,n );
+ if ( ! b )
+ YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+
+ /* It's okay to grow etc. this buffer, and we should throw it
+ * away when we're done.
+ */
+ b->yy_is_our_buffer = 1;
+
+ return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+ (void) fprintf( stderr, "%s\n", msg );
+ exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ yytext[yyleng] = (yy_hold_char); \
+ (yy_c_buf_p) = yytext + yyless_macro_arg; \
+ (yy_hold_char) = *(yy_c_buf_p); \
+ *(yy_c_buf_p) = '\0'; \
+ yyleng = yyless_macro_arg; \
+ } \
+ while ( 0 )
+
+/* Accessor methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ *
+ */
+int yyget_lineno (void)
+{
+
+ return yylineno;
+}
+
+/** Get the input stream.
+ *
+ */
+FILE *yyget_in (void)
+{
+ return yyin;
+}
+
+/** Get the output stream.
+ *
+ */
+FILE *yyget_out (void)
+{
+ return yyout;
+}
+
+/** Get the length of the current token.
+ *
+ */
+int yyget_leng (void)
+{
+ return yyleng;
+}
+
+/** Get the current token.
+ *
+ */
+
+char *yyget_text (void)
+{
+ return yytext;
+}
+
+/** Set the current line number.
+ * @param line_number
+ *
+ */
+void yyset_lineno (int line_number )
+{
+
+ yylineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ *
+ * @see yy_switch_to_buffer
+ */
+void yyset_in (FILE * in_str )
+{
+ yyin = in_str ;
+}
+
+void yyset_out (FILE * out_str )
+{
+ yyout = out_str ;
+}
+
+int yyget_debug (void)
+{
+ return yy_flex_debug;
+}
+
+void yyset_debug (int bdebug )
+{
+ yy_flex_debug = bdebug ;
+}
+
+/* yylex_destroy is for both reentrant and non-reentrant scanners. */
+int yylex_destroy (void)
+{
+
+ /* Pop the buffer stack, destroying each element. */
+ while(YY_CURRENT_BUFFER){
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ yypop_buffer_state();
+ }
+
+ /* Destroy the stack itself. */
+ yyfree((yy_buffer_stack) );
+ (yy_buffer_stack) = NULL;
+
+ yyfree ( (yy_state_buf) );
+
+ return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+ register int i;
+ for ( i = 0; i < n; ++i )
+ s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+ register int n;
+ for ( n = 0; s[n]; ++n )
+ ;
+
+ return n;
+}
+#endif
+
+void *yyalloc (yy_size_t size )
+{
+ return (void *) malloc( size );
+}
+
+void *yyrealloc (void * ptr, yy_size_t size )
+{
+ /* The cast to (char *) in the following accommodates both
+ * implementations that use char* generic pointers, and those
+ * that use void* generic pointers. It works with the latter
+ * because both ANSI C and C++ allow castless assignment from
+ * any pointer type to void*, and deal with argument conversions
+ * as though doing an assignment.
+ */
+ return (void *) realloc( (char *) ptr, size );
+}
+
+void yyfree (void * ptr )
+{
+ free( (char *) ptr ); /* see yyrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#undef YY_NEW_FILE
+#undef YY_FLUSH_BUFFER
+#undef yy_set_bol
+#undef yy_new_buffer
+#undef yy_set_interactive
+#undef yytext_ptr
+#undef YY_DO_BEFORE_ACTION
+
+#ifdef YY_DECL_IS_OURS
+#undef YY_DECL_IS_OURS
+#undef YY_DECL
+#endif
+#line 225 "./web2c.l"
+
+
+/* Some helper routines. Defining these here means we don't have references
+ to yytext outside of this file. Which means we can omit one of the more
+ troublesome autoconf tests. */
+void
+get_string_literal P1C(char *, s)
+{
+ int i, j;
+ j = 1;
+ s[0] = '"';
+ for (i=1; yytext[i-1] != 0; i++) {
+ if (yytext[i] == '\\' || yytext[i] == '"')
+ s[j++] = '\\';
+ else if (yytext[i] == '\'')
+ i++;
+ s[j++] = yytext[i];
+ }
+ s[j-1] = '"';
+ s[j] = 0;
+}
+
+void
+get_single_char P1C(char *, s)
+{
+ s[0]='\'';
+ if (yytext[1] == '\\' || yytext[1] == '\'') {
+ s[1] = '\\';
+ s[2] = yytext[1];
+ s[3] = '\'';
+ s[4] = 0;
+ } else {
+ s[1] = yytext[1];
+ s[2] = '\'';
+ s[3] = 0;
+ }
+}
+
+void
+get_result_type P1C(char *, s)
+{
+ strcpy(s, yytext);
+}
+
+
+/* Since a syntax error can never be recovered from, we exit here with
+ bad status. */
+
+int
+yyerror P1C(string, s)
+{
+ /* This is so the convert script can delete the output file on error. */
+ puts ("@error@");
+ fflush (stdout);
+ fputs (s, stderr);
+ fprintf (stderr, ": Last token = %d (%c), ", last_tok, last_tok);
+ fprintf (stderr, "error buffer = `%s',\n\t", yytext);
+ fprintf (stderr, "last id = `%s' (", last_id);
+ ii = search_table (last_id);
+ if (ii == -1)
+ fputs ("not in symbol table", stderr);
+ else
+ switch (sym_table[ii].typ)
+ {
+ case undef_id_tok:
+ fputs ("undefined", stderr);
+ break;
+ case var_id_tok:
+ fputs ("variable", stderr);
+ break;
+ case const_id_tok:
+ fputs ("constant", stderr);
+ break;
+ case type_id_tok:
+ fputs ("type", stderr);
+ break;
+ case proc_id_tok:
+ fputs ("parameterless procedure", stderr);
+ break;
+ case proc_param_tok:
+ fputs ("procedure with parameters", stderr);
+ break;
+ case fun_id_tok:
+ fputs ("parameterless function", stderr);
+ break;
+ case fun_param_tok:
+ fputs ("function with parameters", stderr);
+ break;
+ default:
+ fputs ("unknown!", stderr);
+ break;
+ }
+ fputs (").\n", stderr);
+ exit (1);
+
+ /* Avoid silly warnings. */
+ return 0;
+}
+
diff --git a/Build/source/texk/web2c/web2c/main.c b/Build/source/texk/web2c/web2c/main.c
new file mode 100644
index 00000000000..b57a36277a9
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/main.c
@@ -0,0 +1,273 @@
+/* web2c -- convert the pseudo-Pascal generated by Tangle to C.
+ The output depends on many C macros and some postprocessing by other
+ programs.
+
+ Arguments:
+ -f: force strict interpretation of semantics of for stmt
+ (never used with TeX and friends)
+ -t: special optimizations for tex.p->tex*.c
+ -m: special optimizations for mf.p->mf*.c
+ -c: supply the base part of the name of the coerce.h file
+ -h: supply the name of the standard header file
+ -d: generate some additional debugging output
+
+ The majority of this program (which includes ptoc.yacc and ptoc.lex)
+ was written by Tomas Rokicki, with modifications by Tim Morgan, et al. */
+
+#include "web2c.h"
+#include "y_tab.h"
+
+
+/* Changing this value will probably stimulate bugs in some
+ preprocessors -- those which want to put the expansion of a macro
+ entirely on one line. */
+#define max_line_length 78
+
+#define max_strings 20000
+#define hash_prime 101
+#define sym_table_size 3000
+#define unused 271828
+
+/* Says whether to give voluminous progress reports. */
+boolean debug = false;
+int indent = 0;
+int line_pos = 0;
+int last_brace = 0;
+int block_level = 0;
+int last_tok;
+int tex = 0, strict_for = 0, mf = 0;
+
+char safe_string[80];
+char var_list[200];
+char field_list[200];
+char last_id[80];
+char z_id[80];
+char next_temp[] = "zzzaa";
+char coerce_name[100] = "coerce.h";
+string program_name;
+
+long last_i_num;
+int ii, l_s;
+long lower_bound, upper_bound;
+FILE *out;
+FILE *coerce;
+int pf_count = 1;
+
+char *std_header = "null.h"; /* Default include filename */
+
+char strings[max_strings];
+int hash_list[hash_prime];
+short global = 1;
+struct sym_entry sym_table[sym_table_size];
+int next_sym_free = -1, next_string_free = 0;
+int mark_sym_free, mark_string_free;
+
+int argc;
+char **gargv;
+
+extern int yyleng;
+
+void
+find_next_temp P1H(void)
+{
+ next_temp[4]++;
+ if (next_temp[4] > 'z')
+ {
+ next_temp[4] = 'a';
+ next_temp[3]++;
+ }
+}
+
+void
+normal P1H(void)
+{
+ out = stdout;
+}
+
+void
+new_line P1H(void)
+{
+ if (!out)
+ return;
+ if (line_pos > 0)
+ {
+ putc ('\n', out);
+ line_pos = 0;
+ }
+}
+
+
+/* Output the string S to the file `out'. */
+
+void
+my_output P1C(string, s)
+{
+ int len = strlen (s);
+ int less_indent = 0;
+
+ if (!out)
+ return;
+
+ if (line_pos + len > max_line_length)
+ new_line ();
+
+ if (indent > 1 && (strcmp (s, "case") == 0 || strcmp (s, "default") == 0))
+ less_indent = 2;
+
+ while (line_pos < indent * 2 - less_indent) {
+ fputs (" ", out);
+ line_pos += 2;
+ }
+
+ /* Output the token. */
+ fputs (s, out);
+
+ /* Omitting the space for parentheses makes fixwrites lose. Sigh.
+ What a kludge. */
+ if (!(len == 1 && (*s == ';' || *s == '[' || *s == ']')))
+ putc (' ', out);
+ line_pos += len + 1;
+
+ last_brace = (s[0] == '}');
+}
+
+void
+semicolon P1H(void)
+{
+ if (!last_brace) {
+ my_output (";");
+ new_line ();
+ last_brace = 1;
+ }
+}
+
+int
+hash P1C(const_string, id)
+{
+ register int i = 0, j;
+ for (j = 0; id[j] != 0; j++)
+ i = (i + i + id[j]) % hash_prime;
+ return i;
+}
+
+int
+search_table P1C(const_string, id)
+{
+ int ptr;
+ ptr = hash_list[hash (id)];
+ while (ptr != -1)
+ {
+ if (strcmp (id, sym_table[ptr].id) == 0)
+ return (ptr);
+ else
+ ptr = sym_table[ptr].next;
+ }
+ return -1;
+}
+
+
+/* Add ID to the symbol table. Leave it up to the caller to assign to
+ the `typ' field. Return the index into the `sym_table' array. */
+int
+add_to_table P1C(string, id)
+{
+ int h, ptr;
+ h = hash (id);
+ ptr = hash_list[h];
+ hash_list[h] = ++next_sym_free;
+ sym_table[next_sym_free].next = ptr;
+ sym_table[next_sym_free].val = unused;
+ sym_table[next_sym_free].id = strings + next_string_free;
+ sym_table[next_sym_free].var_formal = false;
+ sym_table[next_sym_free].var_not_needed = false;
+ strcpy (strings + next_string_free, id);
+ next_string_free += strlen (id) + 1;
+ return next_sym_free;
+}
+
+void
+remove_locals P1H(void)
+{
+ int h, ptr;
+ for (h = 0; h < hash_prime; h++)
+ {
+ next_sym_free = mark_sym_free;
+ next_string_free = mark_string_free;
+ ptr = hash_list[h];
+ while (ptr > next_sym_free)
+ ptr = sym_table[ptr].next;
+ hash_list[h] = ptr;
+ }
+ global = 1;
+}
+
+void
+mark P1H(void)
+{
+ mark_sym_free = next_sym_free;
+ mark_string_free = next_string_free;
+ global = 0;
+}
+
+
+void
+initialize P1H(void)
+{
+ register int i;
+
+ for (i = 0; i < hash_prime; hash_list[i++] = -1)
+ ;
+
+ normal ();
+
+ coerce = xfopen (coerce_name, FOPEN_W_MODE);
+}
+
+int
+main P2C(int, argc, string *, argv)
+{
+ int error, i;
+
+ for (i = 1; i < argc; i++)
+ if (argv[i][0] == '-')
+ switch (argv[i][1])
+ {
+ case 't':
+ tex = true;
+ break;
+ case 'm':
+ mf = true;
+ break;
+ case 'f':
+ strict_for = true;
+ break;
+ case 'h':
+ std_header = &argv[i][2];
+ break;
+ case 'd':
+ debug = true;
+ break;
+ case 'c':
+ program_name = &argv[i][2];
+ sprintf (coerce_name, "%s.h", program_name);
+ break;
+ default:
+ fprintf (stderr, "web2c: Unknown option %s, ignored\n", argv[i]);
+ break;
+ }
+ else
+ {
+ fprintf (stderr, "web2c: Unknown argument %s, ignored\n", argv[i]);
+ }
+
+ initialize ();
+ error = yyparse ();
+ new_line ();
+
+ xfclose (coerce, coerce_name);
+
+ if (debug)
+ fprintf (stderr, "%d symbols.\n", next_sym_free);
+
+ return EXIT_SUCCESS;
+}
diff --git a/Build/source/texk/web2c/web2c/mfmp.defines b/Build/source/texk/web2c/web2c/mfmp.defines
new file mode 100644
index 00000000000..4efca780c71
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/mfmp.defines
@@ -0,0 +1,5 @@
+{We optimize these functions with C definitions (in cpascal.h) for
+ Metafont and MetaPost, but TeX's definition is different, and it's not
+ worth dealing with. But then we can't @define half when we process TeX.}
+@define function half ();
+@define function halfp ();
diff --git a/Build/source/texk/web2c/web2c/regfix.c b/Build/source/texk/web2c/web2c/regfix.c
new file mode 100644
index 00000000000..470803abe67
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/regfix.c
@@ -0,0 +1,133 @@
+/* regfix -- change locals to be register declarations. This
+ produces code which runs 10% faster on some systems (e.g., Vax-11/750,
+ Sequent Balance). Don't try to use this program with other than TeX
+ and Metafont in C.
+
+ Tim Morgan February 25, 1988. */
+
+#include "config.h"
+
+#ifdef REGFIX /* REST OF FILE (almost) */
+
+#define BUFFER_SIZE 10240
+char line[BUFFER_SIZE];
+
+
+
+/* Replace the last (should be only) newline in S with a null. */
+
+void
+remove_newline P1C(string, s)
+{
+ char *temp = strrchr (s, '\n');
+ if (temp == NULL)
+ {
+ fprintf (stderr, "regfix: Lost newline somehow.\n");
+ exit (EXIT_FAILURE);
+ }
+
+ *temp = 0;
+}
+
+
+
+#define Puts(s) fputs(s, stdout)
+
+char *types[] = {"ASCIIcode ", "schar ", "eightbits ", "scaled ",
+ "glueord ", "halfword ", "hyphpointer ", "internalfontnumber ",
+ "nonnegativeinteger ", "poolpointer ", "quarterword ", "smallnumber ",
+ "strnumber ", "triepointer ", "integer ", "short "};
+#define NUMTYPES (sizeof(types)/sizeof(types[0]))
+int lens[NUMTYPES];
+
+
+char *
+matchestype P1H(void)
+{
+ register int i;
+
+ if (line[0] != ' ' || line[1] != ' ')
+ return 0;
+
+ for (i = 0; i < NUMTYPES; i++)
+ {
+ if (strncmp (&line[2], types[i], lens[i]) == 0
+ && strchr (line, '[') == 0)
+ return line + 2 + lens[i];
+ }
+
+ return 0;
+}
+
+
+int
+main P1H(void)
+{
+ register int i;
+#ifdef vax
+ register char *cp;
+#endif
+
+ for (i=0; i<NUMTYPES; i++)
+ lens[i] = strlen(types[i]);
+
+ /* Copy the declarations. */
+ while (fgets (line, BUFFER_SIZE, stdin)
+ && strncmp (&line[10], "coerce", 6) != 0)
+ {
+ remove_newline (line);
+ puts (line);
+ }
+
+ puts (line);
+
+ while (fgets (line, BUFFER_SIZE, stdin))
+ {
+ remove_newline (line);
+
+#ifdef vax
+ if (cp = matchestype() ) {
+ Puts(" register long ");
+ puts(cp);
+#else
+ if ( matchestype() ) {
+ Puts(" register");
+ puts(line+1);
+#endif
+ } else
+ puts(line);
+ }
+
+ fclose (stdout);
+ uexit (0);
+}
+
+#else /* not REGFIX */
+
+/* If we don't want to use register variables, we just copy stdin to
+ stdout. If writing or reading fail, exit with bad status. */
+
+int
+main ()
+{
+ int c;
+
+ while ((c = getchar ()) != EOF)
+ {
+ if (putchar (c) == EOF)
+ {
+ perror ("regfix");
+ exit (EXIT_FAILURE);
+ }
+ }
+
+ if (!feof (stdin))
+ {
+ perror ("regfix");
+ exit (EXIT_FAILURE);
+ }
+
+ return EXIT_SUCCESS;
+}
+
+#endif /* not REGFIX */
diff --git a/Build/source/texk/web2c/web2c/splitup.c b/Build/source/texk/web2c/web2c/splitup.c
new file mode 100644
index 00000000000..7f4a11a7aed
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/splitup.c
@@ -0,0 +1,215 @@
+/* splitup -- take TeX or MF in C as a single stream on stdin,
+ and it produces several .c and .h files in the current directory
+ as its output.
+
+ Tim Morgan September 19, 1987. */
+
+#include "config.h"
+#include <kpathsea/getopt.h>
+
+#ifdef VMS
+#define unlink delete
+#endif
+
+char *program_invocation_name;
+int filenumber = 0, ifdef_nesting = 0, lines_in_file = 0;
+char *output_name = NULL;
+boolean has_ini;
+
+/* This used to be a fixed 2000, but since bibtex.c is almost 10000 lines
+ (200+K), we may as well decrease the number of split files we create.
+ Probably faster for the compiler, definitely faster for the linker,
+ simpler for the Makefiles, and generally better. Now we specify this
+ in 'convert'. */
+long int max_lines;
+
+/* Do we split out a separate *ini.c file? */
+boolean do_ini;
+
+/* Don't need long filenames, since we generate them all. */
+char buffer[1024], tempfile[100], filename[100], ini_name[100];
+
+FILE *out, *ini, *temp;
+
+/*
+ * Read a line of input into the buffer, returning `false' on EOF.
+ * If the line is of the form "#ifdef INI...", we set "has_ini"
+ * `true' else `false'. We also keep up with the #ifdef/#endif nesting
+ * so we know when it's safe to finish writing the current file.
+ */
+int
+read_line P1H(void)
+{
+ if (fgets (buffer, sizeof (buffer), stdin) == NULL)
+ return false;
+ if (strncmp (buffer, "#ifdef", 6) == 0
+ || strncmp (buffer, "#ifndef", 7) == 0)
+ {
+ ++ifdef_nesting;
+ if (strncmp (&buffer[7], "INI", 3) == 0)
+ has_ini = true;
+ }
+ else if (strncmp (buffer, "#endif", 6) == 0)
+ --ifdef_nesting;
+ return true;
+}
+
+int
+main P2C(int, argc, string *, argv)
+{
+ string coerce;
+ unsigned coerce_len;
+ int option;
+
+ program_invocation_name = argv[0];
+
+ while ((option = getopt(argc, argv, "il:")) != -1) {
+ switch (option) {
+ case 'i':
+ do_ini = true;
+ break;
+ case 'l':
+ max_lines = atoi(optarg);
+ if (max_lines <= 0)
+ FATAL("[-i] [-l lines] name");
+ break;
+ default:
+ FATAL("[-i] [-l lines] name");
+ break;
+ }
+ }
+ if (optind + 1 != argc)
+ FATAL("[-i] [-l lines] name");
+ output_name = argv[optind];
+
+ sprintf (filename, "%sd.h", output_name);
+ sprintf (tempfile, "%s.tmp", output_name);
+ out = xfopen (filename, FOPEN_W_MODE);
+ fputs ("#undef TRIP\n#undef TRAP\n", out);
+ /* We have only one binary that can do both ini stuff and vir stuff. */
+ fputs ("#define STAT\n#define INI\n", out);
+
+ if (STREQ (output_name, "mf")) {
+ fputs ("#define INIMF\n#define MF\n", out);
+ coerce = "mfcoerce.h";
+ } else if (STREQ (output_name, "tex")) {
+ fputs ("#define INITEX\n#define TeX\n", out);
+ coerce = "texcoerce.h";
+ } else if (STREQ (output_name, "aleph")) {
+ fputs ("#define INITEX\n#define TeX\n#define Aleph\n", out);
+ coerce = "alephcoerce.h";
+ } else if (STREQ (output_name, "eomega")) {
+ fputs ("#define INITEX\n#define TeX\n#define eOmega\n", out);
+ coerce = "eomegacoerce.h";
+ } else if (STREQ (output_name, "etex")) {
+ fputs ("#define INITEX\n#define TeX\n#define eTeX\n", out);
+ coerce = "etexcoerce.h";
+ } else if (STREQ (output_name, "omega")) {
+ fputs ("#define INITEX\n#define TeX\n#define Omega\n", out);
+ coerce = "omegacoerce.h";
+ } else if (STREQ (output_name, "pdftex")) {
+ fputs ("#define INITEX\n#define TeX\n#define pdfTeX\n", out);
+ coerce = "pdftexcoerce.h";
+ } else if (STREQ (output_name, "pdfetex")) {
+ fputs ("#define INITEX\n#define TeX\n#define pdfeTeX\n", out);
+ coerce = "pdfetexcoerce.h";
+ } else if (STREQ (output_name, "mp")) {
+ fputs ("#define INIMP\n#define MP\n", out);
+ coerce = "mpcoerce.h";
+ } else
+ FATAL1 ("Can only split mf, mp, tex, etex, omega, eomega, aleph, or pdf[ex]tex,\n not %s", output_name);
+
+ coerce_len = strlen (coerce);
+
+ /* Read everything up to coerce.h. */
+ while (fgets (buffer, sizeof (buffer), stdin))
+ {
+ if (strncmp (&buffer[10], coerce, coerce_len) == 0)
+ break;
+
+ if (buffer[0] == '#' || buffer[0] == '\n' || buffer[0] == '}'
+ || buffer[0] == '/' || buffer[0] == ' '
+ || strncmp (buffer, "typedef", 7) == 0)
+ /*nothing */ ;
+ else
+ fputs ("EXTERN ", out);
+
+ fputs (buffer, out);
+ }
+
+ if (strncmp (&buffer[10], coerce, coerce_len) != 0)
+ FATAL1 ("No #include %s line", coerce);
+
+ fputs (buffer, out);
+ xfclose (out, filename);
+
+ if (do_ini) {
+ sprintf (ini_name, "%sini.c", output_name);
+ ini = xfopen (ini_name, FOPEN_W_MODE);
+ fputs ("#define EXTERN extern\n", ini);
+ fprintf (ini, "#include \"%sd.h\"\n\n", output_name);
+ }
+
+ sprintf (filename, "%s0.c", output_name);
+ out = xfopen (filename, FOPEN_W_MODE);
+ fputs ("#define EXTERN extern\n", out);
+ fprintf (out, "#include \"%sd.h\"\n\n", output_name);
+
+ do
+ {
+ /* Read one routine into a temp file */
+ has_ini = false;
+ temp = xfopen (tempfile, "w+");
+
+ while (read_line ())
+ {
+ fputs (buffer, temp);
+ if (buffer[0] == '}')
+ break; /* End of procedure */
+ }
+ while (ifdef_nesting > 0 && read_line ())
+ fputs (buffer, temp);
+ rewind (temp);
+
+ if (do_ini && has_ini)
+ { /* Contained "#ifdef INI..." */
+ while (fgets (buffer, sizeof (buffer), temp))
+ fputs (buffer, ini);
+ }
+ else
+ { /* Doesn't contain "#ifdef INI..." */
+ while (fgets (buffer, sizeof (buffer), temp))
+ {
+ fputs (buffer, out);
+ lines_in_file++;
+ }
+ }
+ xfclose (temp, tempfile);
+
+ /* Switch to new output file. */
+ if (max_lines && lines_in_file > max_lines)
+ {
+ xfclose (out, filename);
+ sprintf (filename, "%s%d.c", output_name, ++filenumber);
+ out = xfopen (filename, FOPEN_W_MODE);
+ fputs ("#define EXTERN extern\n", out);
+ fprintf (out, "#include \"%sd.h\"\n\n", output_name);
+ lines_in_file = 0;
+ }
+ }
+ while (!feof (stdin));
+
+ xfclose (out, filename);
+ if (lines_in_file == 0)
+ unlink (filename);
+
+ if (do_ini)
+ xfclose (ini, ini_name);
+
+ if (unlink (tempfile)) {
+ perror (tempfile);
+ exit (EXIT_FAILURE);
+ }
+
+ return EXIT_SUCCESS;
+}
diff --git a/Build/source/texk/web2c/web2c/texmf.defines b/Build/source/texk/web2c/web2c/texmf.defines
new file mode 100644
index 00000000000..2d16c3394bb
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/texmf.defines
@@ -0,0 +1,87 @@
+{This file defines symbols in addition to those in `common.defines',
+ for use in the TeX, Metafont, and MetaPost change files. Public domain.}
+
+@define const TEXMFPOOLNAME;
+@define const TEXMFENGINENAME;
+
+@define @field b0;
+@define @field b1;
+@define @field b2;
+@define @field b3;
+@define @field gr;
+@define @field hh;
+@define @field hhfield;
+@define @field int;
+@define @field lh;
+@define @field lhfield;
+@define @field rh;
+{`qqqq' is already defined, in ./common.defines, because of gftodvi.}
+
+@define function bopenin ();
+@define function bopenout ();
+@define function callmakempx ();
+@define function floorscaled ();
+@define function floorunscaled ();
+@define function getjobname ();
+@define function getrandomseed;
+@define function initscreen;
+@define function inputln ();
+@define function isnewsource ();
+@define function makefullnamestring;
+@define function makesrcspecial ();
+@define function ocpopenin ();
+@define function ofmopenin ();
+@define function openinnameok ();
+@define function openoutnameok ();
+@define function roundfraction ();
+@define function roundunscaled ();
+@define function wopenin ();
+@define function wopenout ();
+
+@define procedure bclose ();
+@define procedure blankrectangle ();
+@define procedure calledit ();
+@define procedure clearterminal;
+@define procedure dateandtime ();
+@define procedure secondsandmicros ();
+@define procedure dumpcore;
+@define procedure dumphh ();
+@define procedure dumpint ();
+@define procedure dumpqqqq ();
+@define procedure dumpthings ();
+@define procedure dumpwd ();
+@define procedure flushdvi;
+@define procedure ipcpage ();
+@define procedure paintrow ();
+@define procedure put2bytes ();
+@define procedure put4bytes ();
+@define procedure readtcxfile;
+@define procedure remembersourceinfo ();
+@define procedure setupboundvariable ();
+@define procedure system ();
+@define procedure topenin;
+@define procedure undumphh ();
+@define procedure undumpint ();
+@define procedure undumpqqqq ();
+@define procedure undumpthings ();
+@define procedure undumpcheckedthings ();
+@define procedure undumpuppercheckthings ();
+@define procedure undumpwd ();
+@define procedure updatescreen;
+@define procedure wakeupterminal;
+@define procedure wclose ();
+@define procedure writedvi ();
+@define procedure writegf ();
+
+@define type fourquarters;
+@define type twohalves;
+@define type fmemoryword;
+
+@define var eqtb;
+@define var mem;
+@define var kpsemaketexdiscarderrors;
+@define var translatefilename;
+
+{For TeX; see openclose.c.}
+@define var tfmtemp;
+@define var texinputtype;
diff --git a/Build/source/texk/web2c/web2c/web2c.h b/Build/source/texk/web2c/web2c/web2c.h
new file mode 100644
index 00000000000..c67bc2ea4ea
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/web2c.h
@@ -0,0 +1,72 @@
+/* web2c.h: general includes for the Web2c program itself. Public domain. */
+
+#include "config.h"
+
+#define ex_32 2
+#define ex_real 3
+
+#undef max
+#define max(a,b) ((a>b)?a:b)
+
+extern int indent;
+extern int line_pos;
+extern int last_brace;
+extern int block_level;
+extern int ii;
+extern int last_tok;
+
+extern char safe_string[80];
+extern char var_list[200];
+extern char field_list[200];
+extern char last_id[80];
+extern char z_id[80];
+extern char next_temp[];
+
+extern long last_i_num;
+extern int ii, l_s;
+extern long lower_bound, upper_bound;
+extern FILE *out;
+extern int pf_count;
+
+/* A symbol table entry. */
+struct sym_entry {
+ char *id; /* points to the identifier */
+ int typ; /* token type */
+ int next; /* next symbol entry */
+ long val; /* constant : value
+ subrange type : lower bound */
+ long upper; /* subrange type : upper bound
+ variable, function, type or field : type length */
+ int val_sym, upper_sym; /* Sym table entries of symbols for lower
+ and upper bounds
+ */
+ boolean var_formal; /* Is this a formal parameter by reference? */
+ boolean var_not_needed;
+ /* True if VAR token should be ignored for this type */
+};
+
+extern char strings[];
+extern int hash_list[];
+extern short global;
+extern struct sym_entry sym_table[];
+extern int next_sym_free, next_string_free;
+extern int mark_sym_free, mark_string_free;
+
+extern void find_next_temp P1H(void);
+extern void normal P1H(void);
+extern void new_line P1H(void);
+extern void my_output P1H(string);
+extern void semicolon P1H(void);
+extern void remove_locals P1H(void);
+extern void mark P1H(void);
+extern void initialize P1H(void);
+extern int add_to_table P1H(string);
+extern int search_table P1H(const_string);
+extern int yyerror P1H(string);
+
+extern void get_string_literal P1H(char*);
+extern void get_single_char P1H(char*);
+extern void get_return_type P1H(char*);
+
+/* No prototypes for these two. As used, neither takes arguments. */
+extern int yylex(), yyparse();
diff --git a/Build/source/texk/web2c/web2c/web2c.l b/Build/source/texk/web2c/web2c/web2c.l
new file mode 100644
index 00000000000..8f0194c49aa
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/web2c.l
@@ -0,0 +1,321 @@
+%{
+/* web2c.l -- lexical analysis for Tangle output. Public domain. */
+
+#include "web2c.h"
+#include "y_tab.h"
+
+/* Hack to make it possible to compile the generated code with C++
+ Required if you use flex. */
+#ifdef __cplusplus
+#define webinput yyinput
+#else
+#define webinput input
+#endif
+
+/* For some reason flex wants to do a system call, so we must lose our
+ definition of the Pascal read. */
+#undef read
+
+char conditional[20], negbuf[2], temp[20];
+extern boolean doing_statements;
+
+
+/* We only read one input file. This is the default definition, but
+ giving it ourselves avoids the need to find -lfl or -ll at link time.
+ This is a good thing, since libfl.a is often installed somewhere that
+ the linker doesn't search by default. */
+int
+yywrap P1H(void)
+{
+ return 1;
+}
+#define YY_SKIP_YYWRAP /* not that it matters */
+%}
+DIGIT [0-9]
+ALPHA [a-zA-Z]
+ALPHANUM ({DIGIT}|{ALPHA})
+IDENTIFIER ({ALPHA}{ALPHANUM}*)
+NUMBER ({DIGIT}+)
+SIGN ("+"|"-")
+SIGNED ({SIGN}?{NUMBER})
+WHITE [ \n\t]+
+REAL ({NUMBER}"."{NUMBER}("e"{SIGNED})?)|({NUMBER}"e"{SIGNED})
+COMMENT (("{"[^}]*"}")|("(*"([^*]|"*"[^)])*"*)"))
+W ({WHITE}|"packed ")+
+WW ({WHITE}|{COMMENT}|"packed ")*
+HHB0 ("hh"{WW}"."{WW}"b0")
+HHB1 ("hh"{WW}"."{WW}"b1")
+
+%%
+{W} ;
+"{" { while (webinput() != '}'); }
+
+"#" {
+ register int c;
+ putc('#', out);
+ while ((c = webinput()) && c != ';')
+ putc(c, out);
+ putc('\n', out);
+ }
+
+"ifdef(" {register int c;
+ register char *cp=conditional;
+ new_line();
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ *cp++ = c;
+ *cp = '\0';
+ (void) webinput();
+ if (doing_statements) fputs("\t;\n", out);
+ fprintf(out, "#ifdef %s\n", conditional);
+ }
+
+"endif(" {register int c;
+ new_line();
+ fputs("#endif /* ", out);
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ (void) putc(c, out);
+ (void) webinput();
+ conditional[0] = '\0';
+ fputs(" */\n", out);
+ }
+
+"ifndef(" {register int c;
+ register char *cp=conditional;
+ new_line();
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ *cp++ = c;
+ *cp = '\0';
+ (void) webinput();
+ if (doing_statements) fputs("\t;\n", out);
+ fprintf(out, "#ifndef %s\n", conditional);
+ }
+
+"endifn(" {register int c;
+ new_line();
+ fputs("#endif /* not ", out);
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ putc(c, out);
+ (void) webinput();
+ conditional[0] = '\0';
+ fputs(" */\n", out);
+ }
+
+
+"procedure "[a-z]+";"[ \n\t]*"forward;" ;
+
+"function "[(),:a-z]+";"[ \n\t]*"forward;" ;
+
+"@define" return last_tok=define_tok;
+"@field" return last_tok=field_tok;
+"and" return last_tok=and_tok;
+"array" return last_tok=array_tok;
+"begin" return last_tok=begin_tok;
+"case" return last_tok=case_tok;
+"const" return last_tok=const_tok;
+"div" return last_tok=div_tok;
+"break" return last_tok=break_tok;
+"do" return last_tok=do_tok;
+"downto" return last_tok=downto_tok;
+"else" return last_tok=else_tok;
+"end" return last_tok=end_tok;
+"file" return last_tok=file_tok;
+"for" return last_tok=for_tok;
+"function" return last_tok=function_tok;
+"goto" return last_tok=goto_tok;
+"if" return last_tok=if_tok;
+"label" return last_tok=label_tok;
+"mod" return last_tok=mod_tok;
+"not" return last_tok=not_tok;
+"of" return last_tok=of_tok;
+"or" return last_tok=or_tok;
+"procedure" return last_tok=procedure_tok;
+"program" return last_tok=program_tok;
+"record" return last_tok=record_tok;
+"repeat" return last_tok=repeat_tok;
+{HHB0} return last_tok=hhb0_tok;
+{HHB1} return last_tok=hhb1_tok;
+"then" return last_tok=then_tok;
+"to" return last_tok=to_tok;
+"type" return last_tok=type_tok;
+"until" return last_tok=until_tok;
+"var" return last_tok=var_tok;
+"while" return last_tok=while_tok;
+"others" return last_tok=others_tok;
+
+{REAL} {
+ sprintf (temp, "%s%s", negbuf, yytext);
+ negbuf[0] = '\0';
+ return last_tok=r_num_tok;
+ }
+
+{NUMBER} {
+ sprintf (temp, "%s%s", negbuf, yytext);
+ negbuf[0] = '\0';
+ return last_tok=i_num_tok;
+ }
+
+("'"([^']|"''")"'") return last_tok=single_char_tok;
+
+("'"([^']|"''")*"'") return last_tok=string_literal_tok;
+
+"+" { if ((last_tok>=undef_id_tok &&
+ last_tok<=field_id_tok) ||
+ last_tok==i_num_tok ||
+ last_tok==r_num_tok ||
+ last_tok==')' ||
+ last_tok==']')
+ return last_tok='+';
+ else return last_tok=unary_plus_tok; }
+
+"-" { if ((last_tok>=undef_id_tok &&
+ last_tok<=field_id_tok) ||
+ last_tok==i_num_tok ||
+ last_tok==r_num_tok ||
+ last_tok==')' ||
+ last_tok==']')
+ return last_tok='-';
+ else {
+ int c;
+ while ((c = webinput()) == ' ' || c == '\t')
+ ;
+ unput(c);
+ if (c < '0' || c > '9') {
+ return last_tok = unary_minus_tok;
+ }
+ negbuf[0] = '-';
+ }}
+
+"*" return last_tok='*';
+"/" return last_tok='/';
+"=" return last_tok='=';
+"<>" return last_tok=not_eq_tok;
+"<" return last_tok='<';
+">" return last_tok='>';
+"<=" return last_tok=less_eq_tok;
+">=" return last_tok=great_eq_tok;
+"(" return last_tok='(';
+")" return last_tok=')';
+"[" return last_tok='[';
+"]" return last_tok=']';
+":=" return last_tok=assign_tok;
+".." return last_tok=two_dots_tok;
+"." return last_tok='.';
+"," return last_tok=',';
+";" return last_tok=';';
+":" return last_tok=':';
+"^" return last_tok='^';
+
+{IDENTIFIER} { strcpy (last_id, yytext);
+ l_s = search_table (last_id);
+ return
+ last_tok = (l_s == -1 ? undef_id_tok : sym_table[l_s].typ);
+ }
+
+
+. { /* Any bizarre token will do. */
+ return last_tok = two_dots_tok; }
+%%
+/* Some helper routines. Defining these here means we don't have references
+ to yytext outside of this file. Which means we can omit one of the more
+ troublesome autoconf tests. */
+void
+get_string_literal P1C(char *, s)
+{
+ int i, j;
+ j = 1;
+ s[0] = '"';
+ for (i=1; yytext[i-1] != 0; i++) {
+ if (yytext[i] == '\\' || yytext[i] == '"')
+ s[j++] = '\\';
+ else if (yytext[i] == '\'')
+ i++;
+ s[j++] = yytext[i];
+ }
+ s[j-1] = '"';
+ s[j] = 0;
+}
+
+void
+get_single_char P1C(char *, s)
+{
+ s[0]='\'';
+ if (yytext[1] == '\\' || yytext[1] == '\'') {
+ s[1] = '\\';
+ s[2] = yytext[1];
+ s[3] = '\'';
+ s[4] = 0;
+ } else {
+ s[1] = yytext[1];
+ s[2] = '\'';
+ s[3] = 0;
+ }
+}
+
+void
+get_result_type P1C(char *, s)
+{
+ strcpy(s, yytext);
+}
+
+
+/* Since a syntax error can never be recovered from, we exit here with
+ bad status. */
+
+int
+yyerror P1C(string, s)
+{
+ /* This is so the convert script can delete the output file on error. */
+ puts ("@error@");
+ fflush (stdout);
+ fputs (s, stderr);
+ fprintf (stderr, ": Last token = %d (%c), ", last_tok, last_tok);
+ fprintf (stderr, "error buffer = `%s',\n\t", yytext);
+ fprintf (stderr, "last id = `%s' (", last_id);
+ ii = search_table (last_id);
+ if (ii == -1)
+ fputs ("not in symbol table", stderr);
+ else
+ switch (sym_table[ii].typ)
+ {
+ case undef_id_tok:
+ fputs ("undefined", stderr);
+ break;
+ case var_id_tok:
+ fputs ("variable", stderr);
+ break;
+ case const_id_tok:
+ fputs ("constant", stderr);
+ break;
+ case type_id_tok:
+ fputs ("type", stderr);
+ break;
+ case proc_id_tok:
+ fputs ("parameterless procedure", stderr);
+ break;
+ case proc_param_tok:
+ fputs ("procedure with parameters", stderr);
+ break;
+ case fun_id_tok:
+ fputs ("parameterless function", stderr);
+ break;
+ case fun_param_tok:
+ fputs ("function with parameters", stderr);
+ break;
+ default:
+ fputs ("unknown!", stderr);
+ break;
+ }
+ fputs (").\n", stderr);
+ exit (1);
+
+ /* Avoid silly warnings. */
+ return 0;
+}
diff --git a/Build/source/texk/web2c/web2c/web2c.rc b/Build/source/texk/web2c/web2c/web2c.rc
new file mode 100644
index 00000000000..62ca08d9b02
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/web2c.rc
@@ -0,0 +1,34 @@
+/* web2c.rc: web2c resources -*- C++ -*-
+
+ Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ This file is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 2, or (at your
+ option) any later version.
+
+ This file is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this file; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " web2c 7.4.4"
+
+#define VER_INTERNALNAME_STR "web2c"
+#define VER_ORIGINALFILENAME_STR "web2c.exe"
+
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#define VER_FILEDESCRIPTION_STR "Web2C Translator"
+
+#include <texlive.version>
+
+/* web2c.rc ends here */
diff --git a/Build/source/texk/web2c/web2c/web2c.y b/Build/source/texk/web2c/web2c/web2c.y
new file mode 100644
index 00000000000..1a1e04df7da
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/web2c.y
@@ -0,0 +1,1405 @@
+/* web2c.y -- parse some of Pascal, and output C, sort of.
+
+ This grammar has one shift/reduce conflict, from the
+ if-then[-else] rules, which is unresolvable. */
+
+/* The order of some of the tokens here is significant. See the rules
+ for - and + in web2c.l. */
+%token array_tok begin_tok case_tok const_tok do_tok downto_tok else_tok
+ end_tok file_tok for_tok function_tok goto_tok if_tok label_tok
+ of_tok procedure_tok program_tok record_tok repeat_tok then_tok
+ to_tok type_tok until_tok var_tok while_tok
+ others_tok r_num_tok i_num_tok string_literal_tok single_char_tok
+ assign_tok two_dots_tok undef_id_tok var_id_tok
+ proc_id_tok proc_param_tok fun_id_tok fun_param_tok const_id_tok
+ type_id_tok hhb0_tok hhb1_tok field_id_tok define_tok field_tok
+ break_tok
+
+%nonassoc '=' not_eq_tok '<' '>' less_eq_tok great_eq_tok
+%left '+' '-' or_tok
+%right unary_plus_tok unary_minus_tok
+%left '*' '/' div_tok mod_tok and_tok
+%right not_tok
+
+%{
+#include "web2c.h"
+
+#define YYDEBUG 1
+
+#define symbol(x) sym_table[x].id
+#define MAX_ARGS 50
+
+static char fn_return_type[50], for_stack[300], control_var[50],
+ relation[3];
+static char arg_type[MAX_ARGS][30];
+static int last_type = -1, ids_typed;
+char my_routine[100]; /* Name of routine being parsed, if any */
+static char array_bounds[80], array_offset[80];
+static int uses_mem, uses_eqtb, lower_sym, upper_sym;
+static FILE *orig_out;
+boolean doing_statements = false;
+static boolean var_formals = false;
+static int param_id_list[MAX_ARGS], ids_paramed=0;
+
+extern char conditional[], temp[], *std_header;
+extern int tex, mf, strict_for;
+extern FILE *coerce;
+extern char coerce_name[];
+extern string program_name;
+extern boolean debug;
+
+static long my_labs P1H(long);
+static void compute_array_bounds P1H(void);
+static void fixup_var_list P1H(void);
+static void do_proc_args P1H(void);
+static void gen_function_head P1H(void);
+static boolean doreturn P1H(string);
+%}
+
+%start PROGRAM
+
+%%
+PROGRAM:
+ DEFS
+ PROGRAM_HEAD
+ {
+ printf ("#define %s\n", uppercasify (program_name));
+ block_level++;
+ printf ("#include \"%s\"\n", std_header);
+ }
+ LABEL_DEC_PART CONST_DEC_PART TYPE_DEC_PART
+ VAR_DEC_PART
+ { printf ("\n#include \"%s\"\n", coerce_name); }
+ P_F_DEC_PART
+ BODY
+ { YYACCEPT; }
+ ;
+
+/* The @define statements we use to populate the symbol table. */
+DEFS:
+ /* empty */
+ | DEFS DEF
+ ;
+DEF:
+ define_tok field_tok undef_id_tok ';'
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = field_id_tok;
+ }
+ | define_tok function_tok undef_id_tok ';'
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = fun_id_tok;
+ }
+ | define_tok const_tok undef_id_tok ';'
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = const_id_tok;
+ }
+ | define_tok function_tok undef_id_tok '(' ')' ';'
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = fun_param_tok;
+ }
+ | define_tok procedure_tok undef_id_tok ';'
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = proc_id_tok;
+ }
+ | define_tok procedure_tok undef_id_tok '(' ')' ';'
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = proc_param_tok;
+ }
+ | define_tok type_tok undef_id_tok ';'
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = type_id_tok;
+ }
+ | define_tok type_tok undef_id_tok '=' SUBRANGE_TYPE ';'
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = type_id_tok;
+ sym_table[ii].val = lower_bound;
+ sym_table[ii].val_sym = lower_sym;
+ sym_table[ii].upper = upper_bound;
+ sym_table[ii].upper_sym = upper_sym;
+ }
+ | define_tok var_tok undef_id_tok ';'
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = var_id_tok;
+ }
+ ;
+
+/* program statement. Ignore any files. */
+PROGRAM_HEAD:
+ program_tok undef_id_tok PROGRAM_FILE_PART ';'
+ ;
+
+PROGRAM_FILE_PART:
+ '(' PROGRAM_FILE_LIST ')'
+ | /* empty */
+ ;
+
+PROGRAM_FILE_LIST:
+ PROGRAM_FILE
+ | PROGRAM_FILE_LIST ',' PROGRAM_FILE
+ ;
+
+PROGRAM_FILE:
+ const_id_tok /* input and output are constants */
+ | undef_id_tok
+ ;
+
+BLOCK:
+ { if (block_level > 0) my_output("{\n ");
+ indent++; block_level++;
+ }
+ LABEL_DEC_PART
+ CONST_DEC_PART TYPE_DEC_PART
+ { if (block_level == 2) {
+ if (strcmp(fn_return_type, "void")) {
+ my_output("register");
+ my_output(fn_return_type);
+ my_output("Result;");
+ }
+ if (tex) {
+ sprintf(safe_string, "%s_regmem", my_routine);
+ my_output(safe_string);
+ new_line();
+ }
+ }
+ }
+ VAR_DEC_PART
+ { doing_statements = true; }
+ STAT_PART
+ {
+ if (block_level == 2) {
+ if (strcmp(fn_return_type,"void")) {
+ my_output("return Result");
+ semicolon();
+ }
+ if (tex) {
+ if (uses_mem && uses_eqtb)
+ fprintf(coerce,
+ "#define %s_regmem register memoryword *mem=zmem, *eqtb=zeqtb;\n",
+ my_routine);
+ else if (uses_mem)
+ fprintf(coerce, "#define %s_regmem register memoryword *mem=zmem;\n",
+ my_routine);
+ else if (uses_eqtb)
+ fprintf(coerce, "#define %s_regmem register memoryword *eqtb=zeqtb;\n",
+ my_routine);
+ else
+ fprintf(coerce, "#define %s_regmem\n", my_routine);
+ }
+ my_routine[0] = '\0';
+ }
+ indent--; block_level--;
+ my_output("}"); new_line();
+ doing_statements = false;
+ }
+ ;
+
+LABEL_DEC_PART: /* empty */
+ | label_tok
+ { my_output("/*"); }
+ LABEL_LIST ';'
+ { my_output("*/"); }
+ ;
+
+LABEL_LIST: LABEL
+ | LABEL_LIST ',' LABEL
+ ;
+
+LABEL:
+ i_num_tok { my_output(temp); }
+ ;
+
+CONST_DEC_PART:
+ /* empty */
+ | const_tok CONST_DEC_LIST
+ { new_line(); }
+ ;
+
+CONST_DEC_LIST:
+ CONST_DEC
+ | CONST_DEC_LIST CONST_DEC
+ ;
+
+CONST_DEC:
+ { /* `#define' must be in column 1 for pcc. */
+ unsigned save = indent;
+ new_line ();
+ indent = 0;
+ my_output ("#define");
+ indent = save;
+ }
+ undef_id_tok
+ { ii = add_to_table (last_id);
+ sym_table[ii].typ = const_id_tok;
+ my_output (last_id);
+ }
+ '=' { my_output ("("); }
+ CONSTANT_EXPRESS { my_output (")"); }
+ ';' { sym_table[ii].val = last_i_num; new_line(); }
+ ;
+
+CONSTANT:
+ i_num_tok
+ {
+ sscanf (temp, "%ld", &last_i_num);
+ if (my_labs ((long) last_i_num) > 32767)
+ strcat (temp, "L");
+ my_output (temp);
+ $$ = ex_32;
+ }
+ | r_num_tok { my_output(temp); $$ = ex_real; }
+ | STRING { $$ = 0; }
+ | CONSTANT_ID { $$ = ex_32; }
+ ;
+
+CONSTANT_EXPRESS:
+ UNARY_OP CONSTANT_EXPRESS %prec '*'
+ { $$ = $2; }
+ | CONSTANT_EXPRESS '+' { my_output ("+"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS '-' { my_output ("-"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS '*' { my_output ("*"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS div_tok { my_output ("/"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS '=' { my_output ("=="); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS not_eq_tok { my_output ("!="); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS mod_tok { my_output ("%"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS '<' { my_output ("<"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS '>' { my_output (">"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS less_eq_tok { my_output ("<="); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS great_eq_tok { my_output (">="); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS and_tok { my_output ("&&"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS or_tok { my_output ("||"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); }
+ | CONSTANT_EXPRESS '/' { my_output ("/ ((double)"); }
+ CONSTANT_EXPRESS { $$ = max ($1, $4); my_output (")"); }
+ | CONST_FACTOR { $$ = $1; }
+ ;
+
+CONST_FACTOR:
+ '('
+ { my_output ("("); }
+ CONSTANT_EXPRESS ')'
+ { my_output (")"); $$ = $1; }
+ | CONSTANT
+ ;
+
+STRING:
+ string_literal_tok
+ {
+ char s[132];
+ get_string_literal(s);
+ my_output (s);
+ }
+ | single_char_tok
+ {
+ char s[5];
+ get_single_char(s);
+ my_output (s);
+ }
+ ;
+
+CONSTANT_ID:
+ const_id_tok { my_output (last_id); }
+ ;
+
+TYPE_DEC_PART: /* empty */
+ | type_tok TYPE_DEF_LIST
+ ;
+
+TYPE_DEF_LIST: TYPE_DEF
+ | TYPE_DEF_LIST TYPE_DEF
+ ;
+
+TYPE_DEF:
+ { my_output ("typedef"); }
+ undef_id_tok
+ {
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = type_id_tok;
+ strcpy(safe_string, last_id);
+ last_type = ii;
+ }
+ '='
+ {
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ }
+ TYPE ';'
+ {
+ if (*array_offset) {
+ yyerror ("Cannot typedef arrays with offsets");
+ }
+ my_output (safe_string);
+ my_output (array_bounds);
+ semicolon ();
+ last_type = -1;
+ }
+ ;
+
+TYPE:
+ SIMPLE_TYPE
+ | STRUCTURED_TYPE
+ ;
+
+SIMPLE_TYPE:
+ SUBRANGE_TYPE
+ {
+ if (last_type >= 0)
+ {
+ sym_table[ii].val = lower_bound;
+ sym_table[ii].val_sym = lower_sym;
+ sym_table[ii].upper = upper_bound;
+ sym_table[ii].upper_sym = upper_sym;
+ ii= -1;
+ }
+
+ /* If the bounds on an integral type are known at
+ translation time, select the smallest ANSI C type which
+ can represent it. We avoid using unsigned char and
+ unsigned short where possible, as ANSI compilers
+ (typically) convert them to int, while traditional
+ compilers convert them to unsigned int. We also avoid
+ schar if possible, since it also is different on
+ different compilers (see config.h). */
+ if (lower_sym == -1 && upper_sym == -1) {
+ if (0 <= lower_bound && upper_bound <= SCHAR_MAX)
+ my_output ("char");
+ else if (SCHAR_MIN <= lower_bound && upper_bound <= SCHAR_MAX)
+ my_output ("schar");
+ else if (0 <= lower_bound && upper_bound <= UCHAR_MAX)
+ my_output ("unsigned char");
+ else if (SHRT_MIN <= lower_bound && upper_bound <= SHRT_MAX)
+ my_output ("short");
+ else if (0 <= lower_bound && upper_bound <= USHRT_MAX)
+ my_output ("unsigned short");
+ else
+ my_output ("integer");
+ } else {
+ my_output ("integer");
+ }
+ }
+ | TYPE_ID
+ ;
+
+SUBRANGE_TYPE:
+ SUBRANGE_CONSTANT two_dots_tok SUBRANGE_CONSTANT
+ ;
+
+POSSIBLE_PLUS:
+ /* empty */
+ | unary_plus_tok
+ ;
+
+SUBRANGE_CONSTANT:
+ POSSIBLE_PLUS i_num_tok
+ {
+ lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ sscanf (temp, "%ld", &upper_bound);
+ upper_sym = -1; /* no sym table entry */
+ }
+ | const_id_tok
+ {
+ lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ upper_bound = sym_table[l_s].val;
+ upper_sym = l_s;
+ }
+ | var_id_tok
+ { /* We've changed some constants into dynamic variables.
+ To avoid changing all the subrange decls, just use integer.
+ This does not work for arrays, for which we check later. */
+ lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ upper_bound = 0;
+ upper_sym = 0; /* Translate to integer. */
+ }
+ | undef_id_tok
+ { /* Same as var_id_tok, to avoid changing type definitions.
+ Should keep track of the variables we use in this way
+ and make sure they're all eventually defined. */
+ lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ upper_bound = 0;
+ upper_sym = 0;
+ }
+ ;
+
+TYPE_ID:
+ type_id_tok
+ {
+ if (last_type >= 0) {
+ sym_table[last_type].var_not_needed = sym_table[l_s].var_not_needed;
+ sym_table[last_type].upper = sym_table[l_s].upper;
+ sym_table[last_type].upper_sym = sym_table[l_s].upper_sym;
+ sym_table[last_type].val = sym_table[l_s].val;
+ sym_table[last_type].val_sym = sym_table[l_s].val_sym;
+ }
+ my_output (last_id);
+ }
+ ;
+
+STRUCTURED_TYPE:
+ ARRAY_TYPE
+ { if (last_type >= 0)
+ sym_table[last_type].var_not_needed = true;
+ }
+ | RECORD_TYPE
+ | FILE_TYPE
+ { if (last_type >= 0)
+ sym_table[last_type].var_not_needed = true;
+ }
+ | POINTER_TYPE
+ { if (last_type >= 0)
+ sym_table[last_type].var_not_needed = true;
+ }
+ ;
+
+POINTER_TYPE:
+ '^' type_id_tok
+ {
+ if (last_type >= 0) {
+ sym_table[last_type].var_not_needed = sym_table[l_s].var_not_needed;
+ sym_table[last_type].upper = sym_table[l_s].upper;
+ sym_table[last_type].upper_sym = sym_table[l_s].upper_sym;
+ sym_table[last_type].val = sym_table[l_s].val;
+ sym_table[last_type].val_sym = sym_table[l_s].val_sym;
+ }
+ my_output (last_id);
+ my_output ("*");
+ }
+ ;
+
+ARRAY_TYPE:
+ array_tok '[' INDEX_TYPE ']' of_tok COMPONENT_TYPE
+ | array_tok '[' INDEX_TYPE ',' INDEX_TYPE ']' of_tok COMPONENT_TYPE
+ ;
+
+INDEX_TYPE:
+ SUBRANGE_TYPE
+ { compute_array_bounds(); }
+ | type_id_tok
+ {
+ lower_bound = sym_table[l_s].val;
+ lower_sym = sym_table[l_s].val_sym;
+ upper_bound = sym_table[l_s].upper;
+ upper_sym = sym_table[l_s].upper_sym;
+ compute_array_bounds();
+ }
+ ;
+
+COMPONENT_TYPE: TYPE ;
+
+RECORD_TYPE:
+ record_tok
+ { my_output ("struct"); my_output ("{"); indent++; }
+ FIELD_LIST end_tok
+ { indent--; my_output ("}"); semicolon(); }
+ ;
+
+FIELD_LIST: RECORD_SECTION
+ | FIELD_LIST ';' RECORD_SECTION
+ ;
+
+RECORD_SECTION:
+ { field_list[0] = 0; }
+ FIELD_ID_LIST ':'
+ {
+ /*array_bounds[0] = 0;
+ array_offset[0] = 0;*/
+ }
+ TYPE
+ { int i=0, j; char ltemp[80];
+ while(field_list[i++] == '!') {
+ j = 0;
+ while (field_list[i])
+ ltemp[j++] = field_list[i++];
+ i++;
+ if (field_list[i] == '!')
+ ltemp[j++] = ',';
+ ltemp[j] = 0;
+ my_output (ltemp);
+ }
+ semicolon();
+ }
+ | /* empty */
+ ;
+
+FIELD_ID_LIST: FIELD_ID
+ | FIELD_ID_LIST ',' FIELD_ID
+ ;
+
+FIELD_ID: undef_id_tok
+ { int i=0, j=0;
+ while (field_list[i] == '!')
+ while(field_list[i++]);
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = field_id_tok;
+ field_list[i++] = '!';
+ while (last_id[j])
+ field_list[i++] = last_id[j++];
+ field_list[i++] = 0;
+ field_list[i++] = 0;
+ }
+ | field_id_tok
+ { int i=0, j=0;
+ while (field_list[i] == '!')
+ while(field_list[i++]);
+ field_list[i++] = '!';
+ while (last_id[j])
+ field_list[i++] = last_id[j++];
+ field_list[i++] = 0;
+ field_list[i++] = 0;
+ }
+ ;
+
+FILE_TYPE:
+ file_tok of_tok
+ { my_output ("text /* of "); }
+ TYPE
+ { my_output ("*/"); }
+ ;
+
+VAR_DEC_PART:
+ /* empty */
+ | var_tok VAR_DEC_LIST
+ ;
+
+VAR_DEC_LIST:
+ VAR_DEC
+ | VAR_DEC_LIST VAR_DEC
+ ;
+
+VAR_DEC:
+ {
+ var_list[0] = 0;
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ var_formals = false;
+ ids_paramed = 0;
+ }
+ VAR_ID_DEC_LIST ':'
+ {
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ }
+ TYPE ';'
+ { fixup_var_list(); }
+ ;
+
+VAR_ID_DEC_LIST: VAR_ID
+ | VAR_ID_DEC_LIST ',' VAR_ID
+ ;
+
+VAR_ID: undef_id_tok
+ { int i=0, j=0;
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = var_id_tok;
+ sym_table[ii].var_formal = var_formals;
+ param_id_list[ids_paramed++] = ii;
+ while (var_list[i] == '!')
+ while(var_list[i++]);
+ var_list[i++] = '!';
+ while (last_id[j])
+ var_list[i++] = last_id[j++];
+ var_list[i++] = 0;
+ var_list[i++] = 0;
+ }
+ | var_id_tok
+ { int i=0, j=0;
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = var_id_tok;
+ sym_table[ii].var_formal = var_formals;
+ param_id_list[ids_paramed++] = ii;
+ while (var_list[i] == '!')
+ while (var_list[i++]);
+ var_list[i++] = '!';
+ while (last_id[j])
+ var_list[i++] = last_id[j++];
+ var_list[i++] = 0;
+ var_list[i++] = 0;
+ }
+ | field_id_tok
+ { int i=0, j=0;
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = var_id_tok;
+ sym_table[ii].var_formal = var_formals;
+ param_id_list[ids_paramed++] = ii;
+ while (var_list[i] == '!')
+ while(var_list[i++]);
+ var_list[i++] = '!';
+ while (last_id[j])
+ var_list[i++] = last_id[j++];
+ var_list[i++] = 0;
+ var_list[i++] = 0;
+ }
+ ;
+
+BODY:
+ /* empty */
+ | begin_tok
+ { my_output ("void mainbody() {");
+ indent++;
+ new_line ();
+ }
+ STAT_LIST end_tok '.'
+ { indent--;
+ my_output ("}");
+ new_line ();
+ }
+ ;
+
+P_F_DEC_PART:
+ P_F_DEC
+ | P_F_DEC_PART P_F_DEC
+ ;
+
+P_F_DEC: PROCEDURE_DEC ';'
+ { new_line(); remove_locals(); }
+ | FUNCTION_DEC ';'
+ { new_line(); remove_locals(); }
+ ;
+
+PROCEDURE_DEC:
+ PROCEDURE_HEAD BLOCK ;
+
+PROCEDURE_HEAD:
+ procedure_tok undef_id_tok
+ { ii = add_to_table(last_id);
+ if (debug)
+ fprintf(stderr, "%3d Procedure %s\n", pf_count++, last_id);
+ sym_table[ii].typ = proc_id_tok;
+ strcpy(my_routine, last_id);
+ uses_eqtb = uses_mem = false;
+ my_output ("void");
+ new_line ();
+ orig_out = out;
+ out = 0;
+ }
+ PARAM ';'
+ { strcpy(fn_return_type, "void");
+ do_proc_args();
+ gen_function_head(); }
+ | procedure_tok DECLARED_PROC
+ { ii = l_s;
+ if (debug)
+ fprintf(stderr, "%3d Procedure %s\n", pf_count++, last_id);
+ strcpy(my_routine, last_id);
+ my_output ("void");
+ new_line ();
+ }
+ PARAM ';'
+ { strcpy(fn_return_type, "void");
+ do_proc_args();
+ gen_function_head();
+ }
+ ;
+
+PARAM:
+ /* empty */
+ {
+ strcpy (z_id, last_id);
+ mark ();
+ ids_paramed = 0;
+ }
+ | '('
+ { sprintf (z_id, "z%s", last_id);
+ ids_paramed = 0;
+ if (sym_table[ii].typ == proc_id_tok)
+ sym_table[ii].typ = proc_param_tok;
+ else if (sym_table[ii].typ == fun_id_tok)
+ sym_table[ii].typ = fun_param_tok;
+ mark();
+ }
+ FORM_PAR_SEC_L ')'
+ ;
+
+FORM_PAR_SEC_L: FORM_PAR_SEC
+ | FORM_PAR_SEC_L ';' FORM_PAR_SEC
+ ;
+
+FORM_PAR_SEC1:
+ { ids_typed = ids_paramed; }
+ VAR_ID_DEC_LIST ':' type_id_tok
+ { int i, need_var;
+ i = search_table(last_id);
+ need_var = !sym_table[i].var_not_needed;
+ for (i=ids_typed; i<ids_paramed; i++)
+ {
+ strcpy(arg_type[i], last_id);
+ if (need_var && sym_table[param_id_list[i]].var_formal)
+ strcat(arg_type[i], " *");
+ else
+ sym_table[param_id_list[i]].var_formal = false;
+ }
+ }
+ ;
+
+FORM_PAR_SEC: {var_formals = 0; } FORM_PAR_SEC1
+ | var_tok {var_formals = 1; } FORM_PAR_SEC1
+ ;
+
+DECLARED_PROC:
+ proc_id_tok
+ | proc_param_tok
+ ;
+
+FUNCTION_DEC: FUNCTION_HEAD BLOCK ;
+
+FUNCTION_HEAD:
+ function_tok undef_id_tok
+ {
+ orig_out = out;
+ out = 0;
+ ii = add_to_table(last_id);
+ if (debug)
+ fprintf(stderr, "%3d Function %s\n", pf_count++, last_id);
+ sym_table[ii].typ = fun_id_tok;
+ strcpy (my_routine, last_id);
+ uses_eqtb = uses_mem = false;
+ }
+ PARAM ':'
+ {
+ normal();
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ }
+ RESULT_TYPE
+ {
+ get_result_type(fn_return_type);
+ do_proc_args();
+ gen_function_head();
+ }
+ ';'
+ | function_tok DECLARED_FUN
+ {
+ orig_out = out;
+ out = 0;
+ ii = l_s;
+ if (debug)
+ fprintf(stderr, "%3d Function %s\n", pf_count++, last_id);
+ strcpy(my_routine, last_id);
+ uses_eqtb = uses_mem = false;
+ }
+ PARAM ':'
+ { normal();
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ }
+ RESULT_TYPE
+ { get_result_type(fn_return_type);
+ do_proc_args();
+ gen_function_head();
+ }
+ ';'
+ ;
+
+DECLARED_FUN: fun_id_tok
+ | fun_param_tok
+ ;
+
+RESULT_TYPE: TYPE
+ ;
+
+STAT_PART: begin_tok STAT_LIST end_tok
+ ;
+
+COMPOUND_STAT: begin_tok
+ { my_output ("{"); indent++; new_line(); }
+ STAT_LIST end_tok
+ { indent--; my_output ("}"); new_line(); }
+ ;
+
+STAT_LIST: STATEMENT
+ | STAT_LIST ';' STATEMENT
+ ;
+
+STATEMENT: UNLAB_STAT
+ | S_LABEL ':'
+ UNLAB_STAT
+ ;
+
+S_LABEL: i_num_tok
+ {if (!doreturn(temp)) {
+ sprintf(safe_string, "lab%s:", temp);
+ my_output (safe_string);
+ }
+ }
+ ;
+
+UNLAB_STAT: SIMPLE_STAT
+ { semicolon(); }
+ | STRUCT_STAT
+ { semicolon(); }
+ ;
+
+SIMPLE_STAT: ASSIGN_STAT
+ | PROC_STAT
+ | GO_TO_STAT
+ | EMPTY_STAT
+ | break_tok
+ { my_output ("break"); }
+ ;
+
+ASSIGN_STAT: VARIABLE assign_tok
+ { my_output ("="); }
+ EXPRESS
+ | FUNC_ID_AS assign_tok
+ { my_output ("Result ="); }
+ EXPRESS
+ ;
+
+VARIABLE: var_id_tok
+ { if (strcmp(last_id, "mem") == 0)
+ uses_mem = 1;
+ else if (strcmp(last_id, "eqtb") == 0)
+ uses_eqtb = 1;
+ if (sym_table[l_s].var_formal)
+ putchar('*');
+ my_output (last_id);
+ $$ = ex_32;
+ }
+ VAR_DESIG_LIST
+ | var_id_tok
+ { if (sym_table[l_s].var_formal)
+ putchar('*');
+ my_output (last_id); $$ = ex_32; }
+ ;
+
+FUNC_ID_AS: fun_id_tok
+ { $$ = ex_32; }
+ | fun_param_tok
+ { $$ = ex_32; }
+ ;
+
+VAR_DESIG_LIST: VAR_DESIG
+ | VAR_DESIG_LIST VAR_DESIG
+ ;
+
+VAR_DESIG: '['
+ { my_output ("["); }
+ EXPRESS VAR_DESIG1
+ { my_output ("]"); }
+ | '.' field_id_tok
+ {if (tex || mf) {
+ if (strcmp(last_id, "int")==0)
+ my_output (".cint");
+ else if (strcmp(last_id, "lh")==0)
+ my_output (".v.LH");
+ else if (strcmp(last_id, "rh")==0)
+ my_output (".v.RH");
+ else {
+ sprintf(safe_string, ".%s", last_id);
+ my_output (safe_string);
+ }
+ }
+ else {
+ sprintf(safe_string, ".%s", last_id);
+ my_output (safe_string);
+ }
+ }
+ | '.' hhb0_tok
+ { my_output (".hh.b0"); }
+ | '.' hhb1_tok
+ { my_output (".hh.b1"); }
+ ;
+
+VAR_DESIG1: ']'
+ | ','
+ { my_output ("]["); }
+ EXPRESS ']'
+ ;
+
+EXPRESS: UNARY_OP EXPRESS %prec '*'
+ { $$ = $2; }
+ | EXPRESS '+' { my_output ("+"); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS '-' { my_output ("-"); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS '*' { my_output ("*"); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS div_tok { my_output ("/"); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS '=' { my_output ("=="); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS not_eq_tok { my_output ("!="); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS mod_tok { my_output ("%"); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS '<' { my_output ("<"); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS '>' { my_output (">"); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS less_eq_tok { my_output ("<="); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS great_eq_tok { my_output (">="); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS and_tok { my_output ("&&"); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS or_tok { my_output ("||"); } EXPRESS
+ { $$ = max ($1, $4); }
+ | EXPRESS '/'
+ { my_output ("/ ((double)"); }
+ EXPRESS
+ { $$ = max ($1, $4); my_output (")"); }
+ | FACTOR
+ { $$ = $1; }
+ ;
+
+UNARY_OP:
+ unary_plus_tok
+ | unary_minus_tok
+ { my_output ("- (integer)"); }
+ | not_tok
+ { my_output ("!"); }
+ ;
+
+FACTOR:
+ '('
+ { my_output ("("); }
+ EXPRESS ')'
+ { my_output (")"); $$ = $1; }
+ | VARIABLE
+ | CONSTANT
+ | fun_id_tok
+ { my_output (last_id); my_output ("()"); }
+ | fun_param_tok
+ { my_output (last_id); }
+ PARAM_LIST
+ ;
+
+PARAM_LIST:
+ '(' { my_output ("("); }
+ ACTUAL_PARAM_L ')' { my_output (")"); }
+ ;
+
+ACTUAL_PARAM_L:
+ ACTUAL_PARAM
+ | ACTUAL_PARAM_L ',' { my_output (","); }
+ ACTUAL_PARAM
+ ;
+
+ACTUAL_PARAM:
+ EXPRESS WIDTH_FIELD
+ | type_id_tok /* So we can pass type names to C macros. */
+ { my_output (last_id); }
+ ;
+
+WIDTH_FIELD:
+ ':' i_num_tok
+ | /* empty */
+ ;
+
+PROC_STAT: proc_id_tok
+ { my_output (last_id); my_output ("()"); }
+ | undef_id_tok
+ { my_output (last_id);
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = proc_id_tok;
+ my_output ("()");
+ }
+ | proc_param_tok
+ { my_output (last_id); }
+ PARAM_LIST
+ ;
+
+GO_TO_STAT: goto_tok i_num_tok
+ {if (doreturn(temp)) {
+ if (strcmp(fn_return_type,"void"))
+ my_output ("return Result");
+ else
+ my_output ("return");
+ } else {
+ sprintf(safe_string, "goto lab%s",
+ temp);
+ my_output (safe_string);
+ }
+ }
+ ;
+
+EMPTY_STAT: /* empty */
+ ;
+
+STRUCT_STAT: COMPOUND_STAT
+ | CONDIT_STAT
+ | REPETIT_STAT
+ ;
+
+CONDIT_STAT: IF_STATEMENT
+ | CASE_STATEMENT
+ ;
+
+IF_STATEMENT: BEGIN_IF_STAT
+ | BEGIN_IF_STAT ELSE_STAT
+ ;
+
+BEGIN_IF_STAT: if_tok
+ { my_output ("if"); my_output ("("); }
+ EXPRESS
+ { my_output (")"); new_line (); }
+ then_tok STATEMENT
+ ;
+
+ELSE_STAT: else_tok
+ { my_output ("else"); }
+ STATEMENT
+ ;
+
+CASE_STATEMENT: case_tok
+ { my_output ("switch"); my_output ("("); }
+ EXPRESS of_tok
+ { my_output (")"); new_line();
+ my_output ("{"); indent++;
+ }
+ CASE_EL_LIST END_CASE
+ { indent--; my_output ("}"); new_line(); }
+ ;
+
+CASE_EL_LIST: CASE_ELEMENT
+ | CASE_EL_LIST ';' CASE_ELEMENT
+ ;
+
+CASE_ELEMENT: CASE_LAB_LIST ':' UNLAB_STAT
+ { my_output ("break"); semicolon(); }
+ ;
+
+CASE_LAB_LIST: CASE_LAB
+ | CASE_LAB_LIST ',' CASE_LAB
+ ;
+
+CASE_LAB: i_num_tok
+ { my_output ("case");
+ my_output (temp);
+ my_output (":"); new_line();
+ }
+ | others_tok
+ { my_output ("default:"); new_line(); }
+ ;
+
+END_CASE: end_tok
+ | ';' end_tok
+ ;
+
+REPETIT_STAT: WHILE_STATEMENT
+ | REP_STATEMENT
+ | FOR_STATEMENT
+ ;
+
+WHILE_STATEMENT: while_tok
+ { my_output ("while");
+ my_output ("(");
+ }
+ EXPRESS
+ { my_output (")"); }
+ do_tok STATEMENT
+ ;
+
+REP_STATEMENT: repeat_tok
+ { my_output ("do"); my_output ("{"); indent++; }
+ STAT_LIST until_tok
+ { indent--; my_output ("}");
+ my_output ("while"); my_output ("( ! (");
+ }
+ EXPRESS
+ { my_output (") )"); }
+ ;
+
+FOR_STATEMENT: for_tok
+ {
+ my_output ("{");
+ my_output ("register");
+ my_output ("integer");
+ if (strict_for)
+ my_output ("for_begin,");
+ my_output ("for_end;");
+ }
+ CONTROL_VAR assign_tok
+ { if (strict_for)
+ my_output ("for_begin");
+ else
+ my_output (control_var);
+ my_output ("="); }
+ FOR_LIST do_tok
+ { my_output ("; if (");
+ if (strict_for) my_output ("for_begin");
+ else my_output (control_var);
+ my_output (relation);
+ my_output ("for_end)");
+ if (strict_for) {
+ my_output ("{");
+ my_output (control_var);
+ my_output ("=");
+ my_output ("for_begin");
+ semicolon();
+ }
+ my_output ("do");
+ indent++;
+ new_line();
+ }
+ STATEMENT
+ {
+ char *top = strrchr (for_stack, '#');
+ indent--;
+ new_line();
+ my_output ("while");
+ my_output ("(");
+ my_output (top+1);
+ my_output (")");
+ my_output (";");
+ my_output ("}");
+ if (strict_for)
+ my_output ("}");
+ *top=0;
+ new_line();
+ }
+ ;
+
+CONTROL_VAR: var_id_tok
+ { strcpy(control_var, last_id); }
+ ;
+
+FOR_LIST: EXPRESS
+ { my_output (";"); }
+ to_tok
+ {
+ strcpy(relation, "<=");
+ my_output ("for_end");
+ my_output ("="); }
+ EXPRESS
+ {
+ sprintf(for_stack + strlen(for_stack),
+ "#%s++ < for_end", control_var);
+ }
+ | EXPRESS
+ { my_output (";"); }
+ downto_tok
+ {
+ strcpy(relation, ">=");
+ my_output ("for_end");
+ my_output ("="); }
+ EXPRESS
+ {
+ sprintf(for_stack + strlen(for_stack),
+ "#%s-- > for_end", control_var);
+ }
+ ;
+%%
+
+static void
+compute_array_bounds P1H(void)
+{
+ long lb;
+ char tmp[200];
+
+ if (lower_sym == 0 || upper_sym == 0) {
+ yyerror ("Cannot handle variable subrange in array decl");
+ }
+ else if (lower_sym == -1) { /* lower is a constant */
+ lb = lower_bound - 1;
+ if (lb==0) lb = -1; /* Treat lower_bound==1 as if lower_bound==0 */
+ if (upper_sym == -1) /* both constants */
+ sprintf(tmp, "[%ld]", upper_bound - lb);
+ else { /* upper a symbol, lower constant */
+ if (lb < 0)
+ sprintf(tmp, "[%s + %ld]",
+ symbol(upper_sym), (-lb));
+ else
+ sprintf(tmp, "[%s - %ld]",
+ symbol(upper_sym), lb);
+ }
+ if (lower_bound < 0 || lower_bound > 1) {
+ if (*array_bounds) {
+ yyerror ("Cannot handle offset in second dimension");
+ }
+ if (lower_bound < 0) {
+ sprintf(array_offset, "+%ld", -lower_bound);
+ } else {
+ sprintf(array_offset, "-%ld", lower_bound);
+ }
+ }
+ strcat(array_bounds, tmp);
+ } else { /* lower is a symbol */
+ if (upper_sym != -1) /* both are symbols */
+ sprintf(tmp, "[%s - %s + 1]", symbol(upper_sym),
+ symbol(lower_sym));
+ else { /* upper constant, lower symbol */
+ sprintf(tmp, "[%ld - %s]", upper_bound + 1,
+ symbol(lower_sym));
+ }
+ if (*array_bounds) {
+ yyerror ("Cannot handle symbolic offset in second dimension");
+ }
+ sprintf(array_offset, "- (int)(%s)", symbol(lower_sym));
+ strcat(array_bounds, tmp);
+ }
+}
+
+
+/* Kludge around negative lower array bounds. */
+
+static void
+fixup_var_list ()
+{
+ int i, j;
+ char output_string[100], real_symbol[100];
+
+ for (i = 0; var_list[i++] == '!'; )
+ {
+ for (j = 0; (real_symbol[j++] = var_list[i++]); )
+ ;
+ if (*array_offset)
+ {
+ fprintf (out, "\n#define %s (%s %s)\n ",
+ real_symbol, next_temp, array_offset);
+ strcpy (real_symbol, next_temp);
+ /* Add the temp to the symbol table, so that change files can
+ use it later on if necessary. */
+ j = add_to_table (next_temp);
+ sym_table[j].typ = var_id_tok;
+ find_next_temp ();
+ }
+ sprintf (output_string, "%s%s%c", real_symbol, array_bounds,
+ var_list[i] == '!' ? ',' : ' ');
+ my_output (output_string);
+ }
+ semicolon ();
+}
+
+
+/* If we're not processing TeX, we return false. Otherwise,
+ return true if the label is "10" and we're not in one of four TeX
+ routines where the line labeled "10" isn't the end of the routine.
+ Otherwise, return 0. */
+
+static boolean
+doreturn P1C(string, label)
+{
+ return
+ tex
+ && STREQ (label, "10")
+ && !STREQ (my_routine, "macrocall")
+ && !STREQ (my_routine, "hpack")
+ && !STREQ (my_routine, "vpackage")
+ && !STREQ (my_routine, "trybreak");
+}
+
+
+/* Return the absolute value of a long. */
+static long
+my_labs P1C(long, x)
+{
+ if (x < 0L) return(-x);
+ return(x);
+}
+
+
+/* Output current function declaration to coerce file. */
+
+static void
+do_proc_args P1H(void)
+{
+ /* If we want ANSI code and one of the parameters is a var
+ parameter, then use the #define to add the &. We do this by
+ adding a 'z' at the front of the name. gen_function_head will do
+ the real work. */
+ int i;
+ int var = 0;
+ for (i = 0; i < ids_paramed; ++i)
+ var += sym_table[param_id_list[i]].var_formal;
+ if (var) {
+ for (i = strlen (z_id); i >= 0; --i)
+ z_id[i+1] = z_id[i];
+ z_id[0] = 'z';
+ }
+
+ /* We can't use our P?H macros here, since there might be an arbitrary
+ number of function arguments. */
+ fprintf (coerce, "%s %s AA((", fn_return_type, z_id);
+ if (ids_paramed == 0) fprintf (coerce, "void");
+ for (i = 0; i < ids_paramed; i++) {
+ if (i > 0)
+ putc (',', coerce);
+ fprintf (coerce, "%s %s", arg_type[i], symbol (param_id_list[i]));
+ }
+ fprintf (coerce, "));\n");
+}
+
+static void
+gen_function_head P1H(void)
+{
+ int i;
+
+ if (strcmp(my_routine, z_id)) {
+ fprintf(coerce, "#define %s(", my_routine);
+ for (i=0; i<ids_paramed; i++) {
+ if (i > 0)
+ fprintf(coerce, ", %s", symbol(param_id_list[i]));
+ else
+ fprintf(coerce, "%s", symbol(param_id_list[i]));
+ }
+ fprintf(coerce, ") %s(", z_id);
+ for (i=0; i<ids_paramed; i++) {
+ if (i > 0)
+ fputs(", ", coerce);
+ fprintf(coerce, "(%s) ", arg_type[i]);
+ fprintf(coerce, "%s(%s)",
+ sym_table[param_id_list[i]].var_formal?"&":"",
+ symbol(param_id_list[i]));
+ }
+ fprintf(coerce, ")\n");
+ }
+ out = orig_out;
+ new_line ();
+ /* We can't use our P?C macros here, since there might be an arbitrary
+ number of function arguments. We have to include the #ifdef in the
+ generated code, or we'd generate different code with and without
+ prototypes, which might cause splitup to create different numbers
+ of files in each case. */
+ fputs ("#ifdef HAVE_PROTOTYPES\n", out);
+ my_output (z_id);
+ my_output ("(");
+ if (ids_paramed == 0) my_output ("void");
+ for (i=0; i<ids_paramed; i++) {
+ if (i > 0) my_output (",");
+ my_output (arg_type[i]);
+ my_output (symbol (param_id_list[i]));
+ }
+ my_output (")");
+ new_line ();
+ fputs ("#else\n", out);
+ my_output (z_id);
+ my_output ("(");
+ for (i=0; i<ids_paramed; i++) {
+ if (i > 0) my_output (",");
+ my_output (symbol (param_id_list[i]));
+ }
+ my_output (")");
+ new_line ();
+ indent++;
+ for (i=0; i<ids_paramed; i++) {
+ my_output (arg_type[i]);
+ my_output (symbol(param_id_list[i]));
+ semicolon ();
+ }
+ indent--;
+ fputs ("#endif\n", out);
+}
diff --git a/Build/source/texk/web2c/web2c/win32.mak b/Build/source/texk/web2c/web2c/win32.mak
new file mode 100644
index 00000000000..4f7f3799868
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/win32.mak
@@ -0,0 +1,99 @@
+################################################################################
+#
+# Makefile : Web2C / Web2C converter
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/01/07 11:12:14 popineau>
+#
+################################################################################
+root_srcdir = ..\..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+USE_KPATHSEA = 1
+USE_GNUW32 = 1
+
+!include <msvc/common.mak>
+
+LEX_OUTPUT_ROOT = lex_yy
+
+DEFS = -I.. $(DEFS) -DHAVE_CONFIG_H -DOEM
+
+proglib = ..\lib\$(objdir)\lib.lib
+programs = $(objdir)\web2c.exe \
+ $(objdir)\fixwrites.exe \
+# $(objdir)\splitup.exe
+
+web2c_objects = \
+ $(objdir)\y_tab.obj \
+ $(objdir)\$(LEX_OUTPUT_ROOT).obj \
+ $(objdir)\main.obj
+
+lib_sources = \
+ ..\lib\basechsuffix.c \
+ ..\lib\oem.c \
+ ..\lib\chartostring.c \
+ ..\lib\coredump.c \
+ ..\lib\eofeoln.c \
+ ..\lib\fprintreal.c \
+ ..\lib\inputint.c \
+ ..\lib\input2int.c \
+ ..\lib\main.c \
+ ..\lib\openclose.c \
+ ..\lib\printversion.c \
+ ..\lib\uexit.c \
+ ..\lib\usage.c \
+ ..\lib\version.c \
+ ..\lib\zround.c \
+ ..\c-auto.h
+
+default: all
+
+all: $(objdir) $(programs)
+
+$(objdir)\web2c.exe: $(web2c_objects) $(objdir)\web2c.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+
+# We use y_tab.* for the sake of MS-DOS.
+$(objdir)\main.obj: main.c y_tab.h
+
+y_tab.c y_tab.h: web2c.y
+ @echo Expect one shift/reduce conflict.
+# @set BISON_SIMPLE=$(gnushare)/bison.simple
+ $(yacc) -d -v web2c.y -o y_tab.c
+
+$(objdir)\$(LEX_OUTPUT_ROOT).obj: y_tab.h
+
+$(LEX_OUTPUT_ROOT).c: web2c.l
+ $(lex) -t web2c.l | $(sed) "/^extern int isatty YY/d" > $(LEX_OUTPUT_ROOT).c
+
+$(objdir)\fixwrites.exe: $(objdir)\fixwrites.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+
+$(objdir)\splitup.exe: $(objdir)\splitup.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+
+$(objdir)\regfix.exe: $(objdir)\regfix.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+
+$(proglib): $(lib_sources)
+ pushd ..\lib & $(make) all & popd
+
+!include <msvc/config.mak>
+!include <msvc/install.mak>
+!include <msvc/clean.mak>
+
+clean::
+ -@echo $(verbose) & ( \
+ for %%i in (y_tab.c y_tab.h y.output yacc.* $(LEX_OUTPUT_ROOT).c) do $(del) %%i $(redir_stderr) \
+ )
+
+!include <msvc/rdepend.mak>
+!include "./depend.mak"
+
+# Local Variables:
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/web2c/y_tab.c-dist b/Build/source/texk/web2c/web2c/y_tab.c-dist
new file mode 100644
index 00000000000..294f1976ee7
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/y_tab.c-dist
@@ -0,0 +1,3530 @@
+/* A Bison parser, made by GNU Bison 1.875a. */
+
+/* Skeleton parser for Yacc-like parsing with Bison,
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+/* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+/* Written by Richard Stallman by simplifying the original so called
+ ``semantic'' parser. */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+ infringing on user name space. This should be done even for local
+ variables, as they might otherwise be expanded by user macros.
+ There are some unavoidable exceptions within include files to
+ define necessary library symbols; they are noted "INFRINGES ON
+ USER NAME SPACE" below. */
+
+/* Identify Bison output. */
+#define YYBISON 1
+
+/* Skeleton name. */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers. */
+#define YYPURE 0
+
+/* Using locations. */
+#define YYLSP_NEEDED 0
+
+
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ array_tok = 258,
+ begin_tok = 259,
+ case_tok = 260,
+ const_tok = 261,
+ do_tok = 262,
+ downto_tok = 263,
+ else_tok = 264,
+ end_tok = 265,
+ file_tok = 266,
+ for_tok = 267,
+ function_tok = 268,
+ goto_tok = 269,
+ if_tok = 270,
+ label_tok = 271,
+ of_tok = 272,
+ procedure_tok = 273,
+ program_tok = 274,
+ record_tok = 275,
+ repeat_tok = 276,
+ then_tok = 277,
+ to_tok = 278,
+ type_tok = 279,
+ until_tok = 280,
+ var_tok = 281,
+ while_tok = 282,
+ others_tok = 283,
+ r_num_tok = 284,
+ i_num_tok = 285,
+ string_literal_tok = 286,
+ single_char_tok = 287,
+ assign_tok = 288,
+ two_dots_tok = 289,
+ undef_id_tok = 290,
+ var_id_tok = 291,
+ proc_id_tok = 292,
+ proc_param_tok = 293,
+ fun_id_tok = 294,
+ fun_param_tok = 295,
+ const_id_tok = 296,
+ type_id_tok = 297,
+ hhb0_tok = 298,
+ hhb1_tok = 299,
+ field_id_tok = 300,
+ define_tok = 301,
+ field_tok = 302,
+ break_tok = 303,
+ great_eq_tok = 304,
+ less_eq_tok = 305,
+ not_eq_tok = 306,
+ or_tok = 307,
+ unary_minus_tok = 308,
+ unary_plus_tok = 309,
+ and_tok = 310,
+ mod_tok = 311,
+ div_tok = 312,
+ not_tok = 313
+ };
+#endif
+#define array_tok 258
+#define begin_tok 259
+#define case_tok 260
+#define const_tok 261
+#define do_tok 262
+#define downto_tok 263
+#define else_tok 264
+#define end_tok 265
+#define file_tok 266
+#define for_tok 267
+#define function_tok 268
+#define goto_tok 269
+#define if_tok 270
+#define label_tok 271
+#define of_tok 272
+#define procedure_tok 273
+#define program_tok 274
+#define record_tok 275
+#define repeat_tok 276
+#define then_tok 277
+#define to_tok 278
+#define type_tok 279
+#define until_tok 280
+#define var_tok 281
+#define while_tok 282
+#define others_tok 283
+#define r_num_tok 284
+#define i_num_tok 285
+#define string_literal_tok 286
+#define single_char_tok 287
+#define assign_tok 288
+#define two_dots_tok 289
+#define undef_id_tok 290
+#define var_id_tok 291
+#define proc_id_tok 292
+#define proc_param_tok 293
+#define fun_id_tok 294
+#define fun_param_tok 295
+#define const_id_tok 296
+#define type_id_tok 297
+#define hhb0_tok 298
+#define hhb1_tok 299
+#define field_id_tok 300
+#define define_tok 301
+#define field_tok 302
+#define break_tok 303
+#define great_eq_tok 304
+#define less_eq_tok 305
+#define not_eq_tok 306
+#define or_tok 307
+#define unary_minus_tok 308
+#define unary_plus_tok 309
+#define and_tok 310
+#define mod_tok 311
+#define div_tok 312
+#define not_tok 313
+
+
+
+
+/* Copy the first part of user declarations. */
+#line 24 "./web2c.y"
+
+#include "web2c.h"
+
+#define YYDEBUG 1
+
+#define symbol(x) sym_table[x].id
+#define MAX_ARGS 50
+
+static char fn_return_type[50], for_stack[300], control_var[50],
+ relation[3];
+static char arg_type[MAX_ARGS][30];
+static int last_type = -1, ids_typed;
+char my_routine[100]; /* Name of routine being parsed, if any */
+static char array_bounds[80], array_offset[80];
+static int uses_mem, uses_eqtb, lower_sym, upper_sym;
+static FILE *orig_out;
+boolean doing_statements = false;
+static boolean var_formals = false;
+static int param_id_list[MAX_ARGS], ids_paramed=0;
+
+extern char conditional[], temp[], *std_header;
+extern int tex, mf, strict_for;
+extern FILE *coerce;
+extern char coerce_name[];
+extern string program_name;
+extern boolean debug;
+
+static long my_labs P1H(long);
+static void compute_array_bounds P1H(void);
+static void fixup_var_list P1H(void);
+static void do_proc_args P1H(void);
+static void gen_function_head P1H(void);
+static boolean doreturn P1H(string);
+
+
+/* Enabling traces. */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+
+/* Enabling verbose error messages. */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
+typedef int YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+
+
+/* Copy the second part of user declarations. */
+
+
+/* Line 214 of yacc.c. */
+#line 238 "y.tab.c"
+
+#if ! defined (yyoverflow) || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols. */
+
+# if YYSTACK_USE_ALLOCA
+# define YYSTACK_ALLOC alloca
+# else
+# ifndef YYSTACK_USE_ALLOCA
+# if defined (alloca) || defined (_ALLOCA_H)
+# define YYSTACK_ALLOC alloca
+# else
+# ifdef __GNUC__
+# define YYSTACK_ALLOC __builtin_alloca
+# endif
+# endif
+# endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+ /* Pacify GCC's `empty if-body' warning. */
+# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
+# else
+# if defined (__STDC__) || defined (__cplusplus)
+# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
+# endif
+# define YYSTACK_ALLOC malloc
+# define YYSTACK_FREE free
+# endif
+#endif /* ! defined (yyoverflow) || YYERROR_VERBOSE */
+
+
+#if (! defined (yyoverflow) \
+ && (! defined (__cplusplus) \
+ || (YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member. */
+union yyalloc
+{
+ short yyss;
+ YYSTYPE yyvs;
+ };
+
+/* The size of the maximum gap between one aligned stack and the next. */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+ N elements. */
+# define YYSTACK_BYTES(N) \
+ ((N) * (sizeof (short) + sizeof (YYSTYPE)) \
+ + YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO. The source and destination do
+ not overlap. */
+# ifndef YYCOPY
+# if 1 < __GNUC__
+# define YYCOPY(To, From, Count) \
+ __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+# else
+# define YYCOPY(To, From, Count) \
+ do \
+ { \
+ register YYSIZE_T yyi; \
+ for (yyi = 0; yyi < (Count); yyi++) \
+ (To)[yyi] = (From)[yyi]; \
+ } \
+ while (0)
+# endif
+# endif
+
+/* Relocate STACK from its old location to the new one. The
+ local variables YYSIZE and YYSTACKSIZE give the old and new number of
+ elements in the stack, and YYPTR gives the new location of the
+ stack. Advance YYPTR to a properly aligned location for the next
+ stack. */
+# define YYSTACK_RELOCATE(Stack) \
+ do \
+ { \
+ YYSIZE_T yynewbytes; \
+ YYCOPY (&yyptr->Stack, Stack, yysize); \
+ Stack = &yyptr->Stack; \
+ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+ yyptr += yynewbytes / sizeof (*yyptr); \
+ } \
+ while (0)
+
+#endif
+
+#if defined (__STDC__) || defined (__cplusplus)
+ typedef signed char yysigned_char;
+#else
+ typedef short yysigned_char;
+#endif
+
+/* YYFINAL -- State number of the termination state. */
+#define YYFINAL 3
+/* YYLAST -- Last index in YYTABLE. */
+#define YYLAST 608
+
+/* YYNTOKENS -- Number of terminals. */
+#define YYNTOKENS 75
+/* YYNNTS -- Number of nonterminals. */
+#define YYNNTS 187
+/* YYNRULES -- Number of rules. */
+#define YYNRULES 307
+/* YYNRULES -- Number of states. */
+#define YYNSTATES 481
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */
+#define YYUNDEFTOK 2
+#define YYMAXUTOK 313
+
+#define YYTRANSLATE(YYX) \
+ ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */
+static const unsigned char yytranslate[] =
+{
+ 0, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 67, 68, 60, 55, 69, 56, 74, 61, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 73, 66,
+ 50, 49, 51, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 71, 2, 72, 70, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 1, 2, 3, 4,
+ 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
+ 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, 40, 41, 42, 43, 44,
+ 45, 46, 47, 48, 52, 53, 54, 57, 58, 59,
+ 62, 63, 64, 65
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+ YYRHS. */
+static const unsigned short yyprhs[] =
+{
+ 0, 0, 3, 4, 5, 16, 17, 20, 25, 30,
+ 35, 42, 47, 54, 59, 66, 71, 76, 80, 81,
+ 83, 87, 89, 91, 92, 93, 94, 103, 104, 105,
+ 110, 112, 116, 118, 119, 122, 124, 127, 128, 129,
+ 130, 131, 140, 142, 144, 146, 148, 151, 152, 157,
+ 158, 163, 164, 169, 170, 175, 176, 181, 182, 187,
+ 188, 193, 194, 199, 200, 205, 206, 211, 212, 217,
+ 218, 223, 224, 229, 230, 235, 237, 238, 243, 245,
+ 247, 249, 251, 252, 255, 257, 260, 261, 262, 263,
+ 271, 273, 275, 277, 279, 283, 284, 286, 289, 291,
+ 293, 295, 297, 299, 301, 303, 305, 308, 315, 324,
+ 326, 328, 330, 331, 336, 338, 342, 343, 344, 350,
+ 351, 353, 357, 359, 361, 362, 367, 368, 371, 373,
+ 376, 377, 378, 385, 387, 391, 393, 395, 397, 398,
+ 399, 405, 407, 410, 413, 416, 419, 420, 426, 427,
+ 433, 434, 435, 440, 442, 446, 447, 452, 453, 456,
+ 457, 461, 463, 465, 468, 469, 470, 471, 481, 482,
+ 483, 484, 494, 496, 498, 500, 504, 505, 510, 512,
+ 516, 518, 522, 524, 526, 528, 530, 532, 534, 536,
+ 538, 539, 544, 545, 550, 551, 555, 557, 559, 561,
+ 563, 566, 567, 572, 575, 578, 581, 583, 584, 589,
+ 592, 593, 598, 599, 604, 605, 610, 611, 616, 617,
+ 622, 623, 628, 629, 634, 635, 640, 641, 646, 647,
+ 652, 653, 658, 659, 664, 665, 670, 671, 676, 678,
+ 680, 682, 684, 685, 690, 692, 694, 696, 697, 701,
+ 702, 707, 709, 710, 715, 718, 720, 723, 724, 726,
+ 728, 729, 733, 736, 737, 739, 741, 743, 745, 747,
+ 749, 752, 753, 754, 761, 762, 766, 767, 768, 776,
+ 778, 782, 786, 788, 792, 794, 796, 798, 801, 803,
+ 805, 807, 808, 809, 816, 817, 818, 825, 826, 827,
+ 828, 838, 840, 841, 842, 848, 849, 850
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS. */
+static const short yyrhs[] =
+{
+ 76, 0, -1, -1, -1, 79, 81, 77, 89, 93,
+ 120, 147, 78, 156, 154, -1, -1, 79, 80, -1,
+ 46, 47, 35, 66, -1, 46, 13, 35, 66, -1,
+ 46, 6, 35, 66, -1, 46, 13, 35, 67, 68,
+ 66, -1, 46, 18, 35, 66, -1, 46, 18, 35,
+ 67, 68, 66, -1, 46, 24, 35, 66, -1, 46,
+ 24, 35, 49, 128, 66, -1, 46, 26, 35, 66,
+ -1, 19, 35, 82, 66, -1, 67, 83, 68, -1,
+ -1, 84, -1, 83, 69, 84, -1, 41, -1, 35,
+ -1, -1, -1, -1, 86, 89, 93, 120, 87, 147,
+ 88, 181, -1, -1, -1, 16, 90, 91, 66, -1,
+ 92, -1, 91, 69, 92, -1, 30, -1, -1, 6,
+ 94, -1, 95, -1, 94, 95, -1, -1, -1, -1,
+ -1, 96, 35, 97, 49, 98, 101, 99, 66, -1,
+ 30, -1, 29, -1, 118, -1, 119, -1, 215, 101,
+ -1, -1, 101, 55, 102, 101, -1, -1, 101, 56,
+ 103, 101, -1, -1, 101, 60, 104, 101, -1, -1,
+ 101, 64, 105, 101, -1, -1, 101, 49, 106, 101,
+ -1, -1, 101, 54, 107, 101, -1, -1, 101, 63,
+ 108, 101, -1, -1, 101, 50, 109, 101, -1, -1,
+ 101, 51, 110, 101, -1, -1, 101, 53, 111, 101,
+ -1, -1, 101, 52, 112, 101, -1, -1, 101, 62,
+ 113, 101, -1, -1, 101, 57, 114, 101, -1, -1,
+ 101, 61, 115, 101, -1, 116, -1, -1, 67, 117,
+ 101, 68, -1, 100, -1, 31, -1, 32, -1, 41,
+ -1, -1, 24, 121, -1, 122, -1, 121, 122, -1,
+ -1, -1, -1, 123, 35, 124, 49, 125, 126, 66,
+ -1, 127, -1, 132, -1, 128, -1, 131, -1, 130,
+ 34, 130, -1, -1, 59, -1, 129, 30, -1, 41,
+ -1, 36, -1, 35, -1, 42, -1, 134, -1, 137,
+ -1, 145, -1, 133, -1, 70, 42, -1, 3, 71,
+ 135, 72, 17, 136, -1, 3, 71, 135, 69, 135,
+ 72, 17, 136, -1, 128, -1, 42, -1, 126, -1,
+ -1, 20, 138, 139, 10, -1, 140, -1, 139, 66,
+ 140, -1, -1, -1, 141, 143, 73, 142, 126, -1,
+ -1, 144, -1, 143, 69, 144, -1, 35, -1, 45,
+ -1, -1, 11, 17, 146, 126, -1, -1, 26, 148,
+ -1, 149, -1, 148, 149, -1, -1, -1, 150, 152,
+ 73, 151, 126, 66, -1, 153, -1, 152, 69, 153,
+ -1, 35, -1, 36, -1, 45, -1, -1, -1, 4,
+ 155, 184, 10, 74, -1, 157, -1, 156, 157, -1,
+ 158, 66, -1, 171, 66, -1, 159, 85, -1, -1,
+ 18, 35, 160, 162, 66, -1, -1, 18, 170, 161,
+ 162, 66, -1, -1, -1, 67, 163, 164, 68, -1,
+ 167, -1, 164, 66, 167, -1, -1, 166, 152, 73,
+ 42, -1, -1, 168, 165, -1, -1, 26, 169, 165,
+ -1, 37, -1, 38, -1, 172, 85, -1, -1, -1,
+ -1, 13, 35, 173, 162, 73, 174, 180, 175, 66,
+ -1, -1, -1, -1, 13, 179, 176, 162, 73, 177,
+ 180, 178, 66, -1, 39, -1, 40, -1, 126, -1,
+ 4, 184, 10, -1, -1, 4, 183, 184, 10, -1,
+ 185, -1, 184, 66, 185, -1, 187, -1, 186, 73,
+ 187, -1, 30, -1, 188, -1, 229, -1, 189, -1,
+ 225, -1, 227, -1, 228, -1, 48, -1, -1, 192,
+ 33, 190, 200, -1, -1, 194, 33, 191, 200, -1,
+ -1, 36, 193, 195, -1, 36, -1, 39, -1, 40,
+ -1, 196, -1, 195, 196, -1, -1, 71, 197, 200,
+ 198, -1, 74, 45, -1, 74, 43, -1, 74, 44,
+ -1, 72, -1, -1, 69, 199, 200, 72, -1, 215,
+ 200, -1, -1, 200, 55, 201, 200, -1, -1, 200,
+ 56, 202, 200, -1, -1, 200, 60, 203, 200, -1,
+ -1, 200, 64, 204, 200, -1, -1, 200, 49, 205,
+ 200, -1, -1, 200, 54, 206, 200, -1, -1, 200,
+ 63, 207, 200, -1, -1, 200, 50, 208, 200, -1,
+ -1, 200, 51, 209, 200, -1, -1, 200, 53, 210,
+ 200, -1, -1, 200, 52, 211, 200, -1, -1, 200,
+ 62, 212, 200, -1, -1, 200, 57, 213, 200, -1,
+ -1, 200, 61, 214, 200, -1, 216, -1, 59, -1,
+ 58, -1, 65, -1, -1, 67, 217, 200, 68, -1,
+ 192, -1, 100, -1, 39, -1, -1, 40, 218, 219,
+ -1, -1, 67, 220, 221, 68, -1, 223, -1, -1,
+ 221, 69, 222, 223, -1, 200, 224, -1, 42, -1,
+ 73, 30, -1, -1, 37, -1, 35, -1, -1, 38,
+ 226, 219, -1, 14, 30, -1, -1, 182, -1, 230,
+ -1, 245, -1, 231, -1, 237, -1, 232, -1, 232,
+ 235, -1, -1, -1, 15, 233, 200, 234, 22, 185,
+ -1, -1, 9, 236, 185, -1, -1, -1, 5, 238,
+ 200, 17, 239, 240, 244, -1, 241, -1, 240, 66,
+ 241, -1, 242, 73, 187, -1, 243, -1, 242, 69,
+ 243, -1, 30, -1, 28, -1, 10, -1, 66, 10,
+ -1, 246, -1, 249, -1, 252, -1, -1, -1, 27,
+ 247, 200, 248, 7, 185, -1, -1, -1, 21, 250,
+ 184, 25, 251, 200, -1, -1, -1, -1, 12, 253,
+ 256, 33, 254, 257, 7, 255, 185, -1, 36, -1,
+ -1, -1, 200, 258, 23, 259, 200, -1, -1, -1,
+ 200, 260, 8, 261, 200, -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
+static const unsigned short yyrline[] =
+{
+ 0, 65, 65, 72, 63, 79, 81, 84, 89, 94,
+ 99, 104, 109, 114, 119, 128, 137, 141, 142, 146,
+ 147, 151, 152, 156, 161, 175, 156, 205, 207, 206,
+ 212, 213, 217, 220, 222, 227, 228, 232, 240, 244,
+ 245, 232, 250, 258, 259, 260, 264, 266, 266, 268,
+ 268, 270, 270, 272, 272, 274, 274, 276, 276, 278,
+ 278, 280, 280, 282, 282, 284, 284, 286, 286, 288,
+ 288, 290, 290, 292, 292, 294, 299, 298, 302, 306,
+ 312, 321, 324, 325, 328, 329, 333, 335, 342, 333,
+ 359, 360, 364, 400, 404, 407, 409, 413, 420, 427,
+ 436, 448, 462, 466, 467, 471, 478, 493, 494, 498,
+ 500, 510, 514, 513, 519, 520, 524, 526, 524, 544,
+ 547, 548, 551, 563, 577, 576, 582, 584, 588, 589,
+ 593, 601, 593, 609, 610, 613, 627, 641, 657, 660,
+ 659, 672, 673, 676, 678, 683, 687, 686, 703, 702,
+ 719, 725, 724, 736, 737, 741, 741, 757, 757, 758,
+ 758, 762, 763, 766, 770, 781, 787, 769, 794, 804,
+ 809, 793, 816, 817, 820, 823, 827, 826, 832, 833,
+ 836, 837, 841, 849, 851, 855, 856, 857, 858, 859,
+ 864, 863, 867, 866, 872, 871, 882, 888, 890, 894,
+ 895, 899, 898, 902, 920, 922, 926, 928, 927, 932,
+ 934, 934, 936, 936, 938, 938, 940, 940, 942, 942,
+ 944, 944, 946, 946, 948, 948, 950, 950, 952, 952,
+ 954, 954, 956, 956, 958, 958, 961, 960, 964, 969,
+ 970, 972, 978, 977, 981, 982, 983, 986, 985, 991,
+ 991, 996, 997, 997, 1002, 1003, 1008, 1009, 1012, 1014,
+ 1021, 1020, 1025, 1039, 1042, 1043, 1044, 1047, 1048, 1051,
+ 1052, 1056, 1058, 1055, 1063, 1062, 1068, 1070, 1067, 1077,
+ 1078, 1081, 1085, 1086, 1089, 1094, 1098, 1099, 1102, 1103,
+ 1104, 1108, 1112, 1107, 1117, 1119, 1116, 1127, 1136, 1142,
+ 1126, 1176, 1181, 1183, 1180, 1193, 1195, 1192
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE
+/* YYTNME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+ First, the terminals, then, starting at YYNTOKENS, nonterminals. */
+static const char *const yytname[] =
+{
+ "$end", "error", "$undefined", "array_tok", "begin_tok", "case_tok",
+ "const_tok", "do_tok", "downto_tok", "else_tok", "end_tok", "file_tok",
+ "for_tok", "function_tok", "goto_tok", "if_tok", "label_tok", "of_tok",
+ "procedure_tok", "program_tok", "record_tok", "repeat_tok", "then_tok",
+ "to_tok", "type_tok", "until_tok", "var_tok", "while_tok", "others_tok",
+ "r_num_tok", "i_num_tok", "string_literal_tok", "single_char_tok",
+ "assign_tok", "two_dots_tok", "undef_id_tok", "var_id_tok",
+ "proc_id_tok", "proc_param_tok", "fun_id_tok", "fun_param_tok",
+ "const_id_tok", "type_id_tok", "hhb0_tok", "hhb1_tok", "field_id_tok",
+ "define_tok", "field_tok", "break_tok", "'='", "'<'", "'>'",
+ "great_eq_tok", "less_eq_tok", "not_eq_tok", "'+'", "'-'", "or_tok",
+ "unary_minus_tok", "unary_plus_tok", "'*'", "'/'", "and_tok", "mod_tok",
+ "div_tok", "not_tok", "';'", "'('", "')'", "','", "'^'", "'['", "']'",
+ "':'", "'.'", "$accept", "PROGRAM", "@1", "@2", "DEFS", "DEF",
+ "PROGRAM_HEAD", "PROGRAM_FILE_PART", "PROGRAM_FILE_LIST",
+ "PROGRAM_FILE", "BLOCK", "@3", "@4", "@5", "LABEL_DEC_PART", "@6",
+ "LABEL_LIST", "LABEL", "CONST_DEC_PART", "CONST_DEC_LIST", "CONST_DEC",
+ "@7", "@8", "@9", "@10", "CONSTANT", "CONSTANT_EXPRESS", "@11", "@12",
+ "@13", "@14", "@15", "@16", "@17", "@18", "@19", "@20", "@21", "@22",
+ "@23", "@24", "CONST_FACTOR", "@25", "STRING", "CONSTANT_ID",
+ "TYPE_DEC_PART", "TYPE_DEF_LIST", "TYPE_DEF", "@26", "@27", "@28",
+ "TYPE", "SIMPLE_TYPE", "SUBRANGE_TYPE", "POSSIBLE_PLUS",
+ "SUBRANGE_CONSTANT", "TYPE_ID", "STRUCTURED_TYPE", "POINTER_TYPE",
+ "ARRAY_TYPE", "INDEX_TYPE", "COMPONENT_TYPE", "RECORD_TYPE", "@29",
+ "FIELD_LIST", "RECORD_SECTION", "@30", "@31", "FIELD_ID_LIST",
+ "FIELD_ID", "FILE_TYPE", "@32", "VAR_DEC_PART", "VAR_DEC_LIST",
+ "VAR_DEC", "@33", "@34", "VAR_ID_DEC_LIST", "VAR_ID", "BODY", "@35",
+ "P_F_DEC_PART", "P_F_DEC", "PROCEDURE_DEC", "PROCEDURE_HEAD", "@36",
+ "@37", "PARAM", "@38", "FORM_PAR_SEC_L", "FORM_PAR_SEC1", "@39",
+ "FORM_PAR_SEC", "@40", "@41", "DECLARED_PROC", "FUNCTION_DEC",
+ "FUNCTION_HEAD", "@42", "@43", "@44", "@45", "@46", "@47",
+ "DECLARED_FUN", "RESULT_TYPE", "STAT_PART", "COMPOUND_STAT", "@48",
+ "STAT_LIST", "STATEMENT", "S_LABEL", "UNLAB_STAT", "SIMPLE_STAT",
+ "ASSIGN_STAT", "@49", "@50", "VARIABLE", "@51", "FUNC_ID_AS",
+ "VAR_DESIG_LIST", "VAR_DESIG", "@52", "VAR_DESIG1", "@53", "EXPRESS",
+ "@54", "@55", "@56", "@57", "@58", "@59", "@60", "@61", "@62", "@63",
+ "@64", "@65", "@66", "@67", "UNARY_OP", "FACTOR", "@68", "@69",
+ "PARAM_LIST", "@70", "ACTUAL_PARAM_L", "@71", "ACTUAL_PARAM",
+ "WIDTH_FIELD", "PROC_STAT", "@72", "GO_TO_STAT", "EMPTY_STAT",
+ "STRUCT_STAT", "CONDIT_STAT", "IF_STATEMENT", "BEGIN_IF_STAT", "@73",
+ "@74", "ELSE_STAT", "@75", "CASE_STATEMENT", "@76", "@77",
+ "CASE_EL_LIST", "CASE_ELEMENT", "CASE_LAB_LIST", "CASE_LAB", "END_CASE",
+ "REPETIT_STAT", "WHILE_STATEMENT", "@78", "@79", "REP_STATEMENT", "@80",
+ "@81", "FOR_STATEMENT", "@82", "@83", "@84", "CONTROL_VAR", "FOR_LIST",
+ "@85", "@86", "@87", "@88", 0
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+ token YYLEX-NUM. */
+static const unsigned short yytoknum[] =
+{
+ 0, 256, 257, 258, 259, 260, 261, 262, 263, 264,
+ 265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
+ 275, 276, 277, 278, 279, 280, 281, 282, 283, 284,
+ 285, 286, 287, 288, 289, 290, 291, 292, 293, 294,
+ 295, 296, 297, 298, 299, 300, 301, 302, 303, 61,
+ 60, 62, 304, 305, 306, 43, 45, 307, 308, 309,
+ 42, 47, 310, 311, 312, 313, 59, 40, 41, 44,
+ 94, 91, 93, 58, 46
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
+static const unsigned short yyr1[] =
+{
+ 0, 75, 77, 78, 76, 79, 79, 80, 80, 80,
+ 80, 80, 80, 80, 80, 80, 81, 82, 82, 83,
+ 83, 84, 84, 86, 87, 88, 85, 89, 90, 89,
+ 91, 91, 92, 93, 93, 94, 94, 96, 97, 98,
+ 99, 95, 100, 100, 100, 100, 101, 102, 101, 103,
+ 101, 104, 101, 105, 101, 106, 101, 107, 101, 108,
+ 101, 109, 101, 110, 101, 111, 101, 112, 101, 113,
+ 101, 114, 101, 115, 101, 101, 117, 116, 116, 118,
+ 118, 119, 120, 120, 121, 121, 123, 124, 125, 122,
+ 126, 126, 127, 127, 128, 129, 129, 130, 130, 130,
+ 130, 131, 132, 132, 132, 132, 133, 134, 134, 135,
+ 135, 136, 138, 137, 139, 139, 141, 142, 140, 140,
+ 143, 143, 144, 144, 146, 145, 147, 147, 148, 148,
+ 150, 151, 149, 152, 152, 153, 153, 153, 154, 155,
+ 154, 156, 156, 157, 157, 158, 160, 159, 161, 159,
+ 162, 163, 162, 164, 164, 166, 165, 168, 167, 169,
+ 167, 170, 170, 171, 173, 174, 175, 172, 176, 177,
+ 178, 172, 179, 179, 180, 181, 183, 182, 184, 184,
+ 185, 185, 186, 187, 187, 188, 188, 188, 188, 188,
+ 190, 189, 191, 189, 193, 192, 192, 194, 194, 195,
+ 195, 197, 196, 196, 196, 196, 198, 199, 198, 200,
+ 201, 200, 202, 200, 203, 200, 204, 200, 205, 200,
+ 206, 200, 207, 200, 208, 200, 209, 200, 210, 200,
+ 211, 200, 212, 200, 213, 200, 214, 200, 200, 215,
+ 215, 215, 217, 216, 216, 216, 216, 218, 216, 220,
+ 219, 221, 222, 221, 223, 223, 224, 224, 225, 225,
+ 226, 225, 227, 228, 229, 229, 229, 230, 230, 231,
+ 231, 233, 234, 232, 236, 235, 238, 239, 237, 240,
+ 240, 241, 242, 242, 243, 243, 244, 244, 245, 245,
+ 245, 247, 248, 246, 250, 251, 249, 253, 254, 255,
+ 252, 256, 258, 259, 257, 260, 261, 257
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */
+static const unsigned char yyr2[] =
+{
+ 0, 2, 0, 0, 10, 0, 2, 4, 4, 4,
+ 6, 4, 6, 4, 6, 4, 4, 3, 0, 1,
+ 3, 1, 1, 0, 0, 0, 8, 0, 0, 4,
+ 1, 3, 1, 0, 2, 1, 2, 0, 0, 0,
+ 0, 8, 1, 1, 1, 1, 2, 0, 4, 0,
+ 4, 0, 4, 0, 4, 0, 4, 0, 4, 0,
+ 4, 0, 4, 0, 4, 0, 4, 0, 4, 0,
+ 4, 0, 4, 0, 4, 1, 0, 4, 1, 1,
+ 1, 1, 0, 2, 1, 2, 0, 0, 0, 7,
+ 1, 1, 1, 1, 3, 0, 1, 2, 1, 1,
+ 1, 1, 1, 1, 1, 1, 2, 6, 8, 1,
+ 1, 1, 0, 4, 1, 3, 0, 0, 5, 0,
+ 1, 3, 1, 1, 0, 4, 0, 2, 1, 2,
+ 0, 0, 6, 1, 3, 1, 1, 1, 0, 0,
+ 5, 1, 2, 2, 2, 2, 0, 5, 0, 5,
+ 0, 0, 4, 1, 3, 0, 4, 0, 2, 0,
+ 3, 1, 1, 2, 0, 0, 0, 9, 0, 0,
+ 0, 9, 1, 1, 1, 3, 0, 4, 1, 3,
+ 1, 3, 1, 1, 1, 1, 1, 1, 1, 1,
+ 0, 4, 0, 4, 0, 3, 1, 1, 1, 1,
+ 2, 0, 4, 2, 2, 2, 1, 0, 4, 2,
+ 0, 4, 0, 4, 0, 4, 0, 4, 0, 4,
+ 0, 4, 0, 4, 0, 4, 0, 4, 0, 4,
+ 0, 4, 0, 4, 0, 4, 0, 4, 1, 1,
+ 1, 1, 0, 4, 1, 1, 1, 0, 3, 0,
+ 4, 1, 0, 4, 2, 1, 2, 0, 1, 1,
+ 0, 3, 2, 0, 1, 1, 1, 1, 1, 1,
+ 2, 0, 0, 6, 0, 3, 0, 0, 7, 1,
+ 3, 3, 1, 3, 1, 1, 1, 2, 1, 1,
+ 1, 0, 0, 6, 0, 0, 6, 0, 0, 0,
+ 9, 1, 0, 0, 5, 0, 0, 5
+};
+
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+ STATE-NUM when YYTABLE doesn't specify something else to do. Zero
+ means the default is an error. */
+static const unsigned short yydefact[] =
+{
+ 5, 0, 0, 1, 0, 0, 6, 2, 18, 0,
+ 0, 0, 0, 0, 0, 27, 0, 0, 0, 0,
+ 0, 0, 0, 0, 28, 33, 22, 21, 0, 19,
+ 16, 9, 8, 0, 11, 0, 95, 13, 15, 7,
+ 0, 37, 82, 17, 0, 0, 0, 100, 99, 98,
+ 96, 0, 0, 0, 32, 0, 30, 34, 35, 0,
+ 86, 126, 20, 10, 12, 14, 97, 95, 29, 0,
+ 36, 38, 83, 84, 0, 130, 3, 94, 31, 0,
+ 85, 87, 127, 128, 0, 0, 39, 0, 129, 135,
+ 136, 137, 0, 133, 0, 0, 138, 141, 0, 23,
+ 0, 23, 0, 88, 0, 131, 164, 172, 173, 168,
+ 146, 161, 162, 148, 139, 4, 142, 143, 145, 27,
+ 144, 163, 43, 42, 79, 80, 81, 240, 239, 241,
+ 76, 78, 40, 75, 44, 45, 0, 95, 134, 95,
+ 150, 150, 150, 150, 263, 33, 0, 55, 61, 63,
+ 67, 65, 57, 47, 49, 71, 51, 73, 69, 59,
+ 53, 0, 46, 0, 0, 112, 101, 0, 0, 90,
+ 92, 93, 91, 105, 102, 103, 104, 0, 151, 0,
+ 0, 0, 0, 176, 276, 297, 0, 271, 294, 291,
+ 182, 259, 196, 258, 260, 197, 198, 189, 264, 0,
+ 178, 0, 180, 183, 185, 0, 0, 186, 187, 188,
+ 184, 265, 267, 269, 268, 266, 288, 289, 290, 82,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 41, 95, 124, 116, 106,
+ 89, 132, 157, 165, 169, 147, 149, 263, 0, 0,
+ 262, 0, 263, 0, 0, 0, 0, 263, 263, 190,
+ 192, 274, 270, 24, 77, 56, 62, 64, 68, 66,
+ 58, 48, 50, 72, 52, 74, 70, 60, 54, 110,
+ 109, 0, 95, 0, 114, 0, 159, 0, 153, 155,
+ 95, 95, 0, 246, 247, 242, 245, 244, 0, 0,
+ 238, 301, 0, 272, 0, 292, 201, 0, 195, 199,
+ 249, 261, 140, 179, 181, 0, 0, 263, 126, 95,
+ 0, 125, 113, 116, 122, 123, 0, 120, 155, 157,
+ 152, 158, 0, 174, 166, 170, 177, 0, 0, 277,
+ 218, 224, 226, 230, 228, 220, 210, 212, 234, 214,
+ 236, 232, 222, 216, 209, 298, 0, 295, 0, 0,
+ 204, 205, 203, 200, 0, 191, 193, 275, 25, 0,
+ 95, 115, 0, 117, 160, 154, 0, 0, 0, 248,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 263, 0, 263,
+ 0, 255, 257, 0, 251, 0, 0, 111, 107, 121,
+ 95, 0, 167, 171, 243, 285, 284, 0, 279, 0,
+ 282, 219, 225, 227, 231, 229, 221, 211, 213, 235,
+ 215, 237, 233, 223, 217, 302, 0, 273, 296, 293,
+ 207, 206, 202, 0, 254, 250, 252, 263, 26, 95,
+ 118, 156, 286, 0, 278, 0, 263, 0, 0, 299,
+ 0, 256, 0, 0, 108, 287, 280, 283, 281, 303,
+ 306, 263, 0, 253, 175, 0, 0, 300, 208, 304,
+ 307
+};
+
+/* YYDEFGOTO[NTERM-NUM]. */
+static const short yydefgoto[] =
+{
+ -1, 1, 15, 85, 2, 6, 7, 17, 28, 29,
+ 118, 119, 318, 405, 25, 40, 55, 56, 42, 57,
+ 58, 59, 79, 102, 161, 296, 132, 227, 228, 230,
+ 234, 221, 226, 233, 222, 223, 225, 224, 232, 229,
+ 231, 133, 146, 134, 135, 61, 72, 73, 74, 87,
+ 137, 333, 169, 170, 52, 53, 171, 172, 173, 174,
+ 281, 408, 175, 238, 283, 284, 285, 410, 326, 327,
+ 176, 282, 76, 82, 83, 84, 139, 92, 93, 115,
+ 144, 96, 97, 98, 99, 142, 143, 179, 242, 287,
+ 331, 332, 288, 289, 328, 113, 100, 101, 140, 290,
+ 377, 141, 291, 378, 109, 334, 448, 198, 247, 199,
+ 200, 201, 202, 203, 204, 315, 316, 297, 254, 206,
+ 308, 309, 359, 442, 460, 402, 388, 389, 391, 395,
+ 382, 387, 394, 383, 384, 386, 385, 393, 390, 392,
+ 299, 300, 338, 337, 311, 364, 403, 462, 404, 444,
+ 207, 255, 208, 209, 210, 211, 212, 213, 251, 356,
+ 262, 317, 214, 248, 381, 417, 418, 419, 420, 454,
+ 215, 216, 253, 358, 217, 252, 398, 218, 249, 396,
+ 471, 302, 436, 457, 475, 458, 476
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+ STATE-NUM. */
+#define YYPACT_NINF -254
+static const short yypact[] =
+{
+ -254, 47, 12, -254, -13, 10, -254, -254, -15, 71,
+ 106, 109, 112, 128, 131, 64, 37, 122, 129, 9,
+ 45, -12, 132, 139, -254, 210, -254, -254, 103, -254,
+ -254, -254, -254, 145, -254, 161, -6, -254, -254, -254,
+ 200, -254, 208, -254, 37, 165, 169, -254, -254, -254,
+ -254, 172, 214, 206, -254, -45, -254, 211, -254, 212,
+ -254, 222, -254, -254, -254, -254, -254, -6, -254, 200,
+ -254, -254, 215, -254, 216, -254, -254, -254, -254, 203,
+ -254, -254, 38, -254, 51, 27, -254, 205, -254, -254,
+ -254, -254, -10, -254, 53, 72, 66, -254, 183, -254,
+ 199, -254, 364, -254, 51, -254, -254, -254, -254, -254,
+ -254, -254, -254, -254, -254, -254, -254, -254, -254, 64,
+ -254, -254, -254, -254, -254, -254, -254, -254, -254, -254,
+ -254, -254, 496, -254, -254, -254, 364, 7, -254, 7,
+ 209, 209, 209, 209, 337, 210, 364, -254, -254, -254,
+ -254, -254, -254, -254, -254, -254, -254, -254, -254, -254,
+ -254, 213, -254, 195, 255, -254, -254, 231, 217, -254,
+ -254, -254, -254, -254, -254, -254, -254, 218, -254, 202,
+ 204, 235, 236, -254, -254, -254, 248, -254, -254, -254,
+ -254, -254, 31, -254, -254, -254, -254, -254, -254, -4,
+ -254, 232, -254, -254, -254, 247, 249, -254, -254, -254,
+ -254, -254, -254, 272, -254, -254, -254, -254, -254, 208,
+ 456, 364, 364, 364, 364, 364, 364, 364, 364, 364,
+ 364, 364, 364, 364, 364, -254, -3, -254, -2, -254,
+ -254, -254, 278, -254, -254, -254, -254, 337, 178, 270,
+ -254, 178, 337, 178, 69, 240, 234, 337, 185, -254,
+ -254, -254, -254, -254, -254, 512, 512, 512, 512, 512,
+ 512, 55, 55, 55, -254, -254, -254, -254, -254, -254,
+ -254, 73, 7, 1, -254, 15, -254, 32, -254, -254,
+ 7, 7, 2, -254, -254, -254, -254, -254, 283, 178,
+ -254, -254, 276, 528, -5, 528, -254, 125, 69, -254,
+ -254, -254, -254, -254, -254, 178, 178, 337, 222, -3,
+ 293, -254, -254, -2, -254, -254, 21, -254, -254, 278,
+ -254, -254, 51, -254, -254, -254, -254, 240, 178, -254,
+ -254, -254, -254, -254, -254, -254, -254, -254, -254, -254,
+ -254, -254, -254, -254, -254, -254, 289, -254, 307, 178,
+ -254, -254, -254, -254, 350, 528, 528, -254, -254, 243,
+ 7, -254, 15, -254, -254, -254, 22, 250, 251, -254,
+ 476, 166, 178, 178, 178, 178, 178, 178, 178, 178,
+ 178, 178, 178, 178, 178, 178, 178, 337, 178, 337,
+ 408, -254, 383, 159, -254, 314, 302, -254, -254, -254,
+ 7, 279, -254, -254, -254, -254, -254, 3, -254, 28,
+ -254, 544, 544, 544, 544, 544, 544, 60, 60, 60,
+ -254, -254, -254, -254, -254, 207, 313, -254, 528, -254,
+ -254, -254, -254, 292, -254, -254, -254, 337, -254, 7,
+ -254, -254, -254, 16, -254, 166, 185, 300, 316, -254,
+ 178, -254, 350, 5, -254, -254, -254, -254, -254, -254,
+ -254, 337, 432, -254, -254, 178, 178, -254, -254, 528,
+ 528
+};
+
+/* YYPGOTO[NTERM-NUM]. */
+static const short yypgoto[] =
+{
+ -254, -254, -254, -254, -254, -254, -254, -254, -254, 281,
+ 225, -254, -254, -254, 229, -254, -254, 259, 184, -254,
+ 273, -254, -254, -254, -254, -95, 65, -254, -254, -254,
+ -254, -254, -254, -254, -254, -254, -254, -254, -254, -254,
+ -254, -254, -254, -254, -254, 134, -254, 282, -254, -254,
+ -254, -136, -254, -34, -254, 264, -254, -254, -254, -254,
+ 36, -99, -254, -254, -254, 33, -254, -254, -254, -11,
+ -254, -254, 39, -254, 277, -254, -254, 30, 256, -254,
+ -254, -254, 267, -254, -254, -254, -254, 50, -254, -254,
+ 40, -254, 41, -254, -254, -254, -254, -254, -254, -254,
+ -254, -254, -254, -254, -254, 74, -254, -254, -254, -243,
+ -232, -254, -253, -254, -254, -254, -254, -144, -254, -254,
+ -254, 58, -254, -254, -254, -234, -254, -254, -254, -254,
+ -254, -254, -254, -254, -254, -254, -254, -254, -254, -254,
+ -47, -254, -254, -254, 34, -254, -254, -254, -93, -254,
+ -254, -254, -254, -254, -254, -254, -254, -254, -254, -254,
+ -254, -254, -254, -254, -254, -254, -75, -254, -72, -254,
+ -254, -254, -254, -254, -254, -254, -254, -254, -254, -254,
+ -254, -254, -254, -254, -254, -254, -254
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If
+ positive, shift that token. If negative, reduce the rule which
+ number is the opposite. If zero, do what YYDEFACT says.
+ If YYTABLE_NINF, syntax error. */
+#define YYTABLE_NINF -306
+static const short yytable[] =
+{
+ 205, 168, 51, 177, 292, 314, 256, 131, -119, 304,
+ 163, 322, 336, 452, 298, 474, 9, 303, 164, 305,
+ 357, 68, 8, 10, 69, 313, 465, 165, 11, 47,
+ 48, 4, 47, 48, 12, 49, 13, 36, 49, 279,
+ 94, 131, 47, 48, 415, 95, 416, 3, 49, 166,
+ 324, 131, 16, 50, 37, 136, 50, 14, 5, 104,
+ 325, 257, 257, 105, -119, 354, 50, 323, 257, 453,
+ 114, 257, 26, -130, -130, 32, 33, 167, 27, 94,
+ 24, 365, 366, -130, 95, 367, 89, 90, 106, 136,
+ 372, 104, 107, 108, 373, 411, 91, 455, 329, 136,
+ 330, 456, -194, 205, 380, -194, 18, 110, 205, 111,
+ 112, 34, 35, 205, 205, 156, 157, 158, 159, 160,
+ 349, 350, 351, 352, 353, 400, 131, 131, 131, 131,
+ 131, 131, 131, 131, 131, 131, 131, 131, 131, 131,
+ 306, 19, 319, 307, 20, 320, 321, 21, 421, 422,
+ 423, 424, 425, 426, 427, 428, 429, 430, 431, 432,
+ 433, 434, 435, 22, 438, 437, 23, 439, 360, 361,
+ 362, 43, 44, 205, 136, 136, 136, 136, 136, 136,
+ 136, 136, 136, 136, 136, 136, 136, 136, 30, 183,
+ 184, 180, 181, 182, 415, 31, 416, 185, 38, 186,
+ 187, 162, 280, 468, 463, 39, 188, 122, 123, 124,
+ 125, 220, 189, 45, 192, -305, 41, 293, 294, 126,
+ 191, 192, 193, 194, 195, 196, 472, 445, 446, 46,
+ 54, 63, 60, 197, 407, 64, 127, 128, 65, 477,
+ 67, 479, 480, 129, 66, 295, -37, 71, 75, 117,
+ -86, 81, 86, 205, 103, 205, 340, 341, 342, 343,
+ 344, 345, 346, 347, 348, 120, 236, 349, 350, 351,
+ 352, 353, 237, 239, 450, 243, 178, 244, 250, 235,
+ 259, 261, 260, 240, 241, 280, 265, 266, 267, 268,
+ 269, 270, 271, 272, 273, 274, 275, 276, 277, 278,
+ 339, 245, 246, 205, 286, 258, 301, 310, 312, 355,
+ 370, 397, 205, 407, 399, 406, 412, 413, 447, 449,
+ 459, 451, 461, 469, 470, 62, 121, 205, 78, 219,
+ 70, 77, 340, 341, 342, 343, 344, 345, 346, 347,
+ 348, 183, 184, 349, 350, 351, 352, 353, 145, 185,
+ 464, 186, 187, 263, 80, 369, 371, 368, 188, 88,
+ 138, 409, 376, 116, 189, 335, 363, 190, 374, 473,
+ 375, 379, 191, 192, 193, 194, 195, 196, 466, 122,
+ 123, 124, 125, 467, 0, 197, 192, 0, 0, 293,
+ 294, 126, 401, 122, 123, 124, 125, 0, 0, 0,
+ 0, 0, 0, 0, 0, 126, 0, 0, 127, 128,
+ 0, 0, 0, 0, 0, 129, 0, 295, 0, 0,
+ 0, 0, 127, 128, 0, 0, 0, 0, 0, 129,
+ 0, 130, 340, 341, 342, 343, 344, 345, 346, 347,
+ 348, 0, 0, 349, 350, 351, 352, 353, 0, 0,
+ 0, 0, 0, 0, 0, 0, 443, 340, 341, 342,
+ 343, 344, 345, 346, 347, 348, 0, 0, 349, 350,
+ 351, 352, 353, 0, 0, 0, 0, 440, 0, 0,
+ 441, 340, 341, 342, 343, 344, 345, 346, 347, 348,
+ 0, 0, 349, 350, 351, 352, 353, 0, 0, 0,
+ 0, 0, 0, 0, 478, 147, 148, 149, 150, 151,
+ 152, 153, 154, 155, 0, 0, 156, 157, 158, 159,
+ 160, 0, 0, 0, 264, 340, 341, 342, 343, 344,
+ 345, 346, 347, 348, 0, 0, 349, 350, 351, 352,
+ 353, 0, 0, 0, 414, 147, 148, 149, 150, 151,
+ 152, 153, 154, 155, 0, 0, 156, 157, 158, 159,
+ 160, -306, -306, -306, -306, -306, -306, 153, 154, 155,
+ 0, 0, 156, 157, 158, 159, 160, 340, 341, 342,
+ 343, 344, 345, 346, 347, 348, 0, 0, 349, 350,
+ 351, 352, 353, -306, -306, -306, -306, -306, -306, 346,
+ 347, 348, 0, 0, 349, 350, 351, 352, 353
+};
+
+static const short yycheck[] =
+{
+ 144, 137, 36, 139, 247, 258, 10, 102, 10, 252,
+ 3, 10, 10, 10, 248, 10, 6, 251, 11, 253,
+ 25, 66, 35, 13, 69, 257, 10, 20, 18, 35,
+ 36, 19, 35, 36, 24, 41, 26, 49, 41, 42,
+ 13, 136, 35, 36, 28, 18, 30, 0, 41, 42,
+ 35, 146, 67, 59, 66, 102, 59, 47, 46, 69,
+ 45, 66, 66, 73, 66, 299, 59, 66, 66, 66,
+ 4, 66, 35, 35, 36, 66, 67, 70, 41, 13,
+ 16, 315, 316, 45, 18, 317, 35, 36, 35, 136,
+ 69, 69, 39, 40, 73, 73, 45, 69, 66, 146,
+ 68, 73, 71, 247, 338, 74, 35, 35, 252, 37,
+ 38, 66, 67, 257, 258, 60, 61, 62, 63, 64,
+ 60, 61, 62, 63, 64, 359, 221, 222, 223, 224,
+ 225, 226, 227, 228, 229, 230, 231, 232, 233, 234,
+ 71, 35, 69, 74, 35, 72, 282, 35, 382, 383,
+ 384, 385, 386, 387, 388, 389, 390, 391, 392, 393,
+ 394, 395, 396, 35, 398, 397, 35, 399, 43, 44,
+ 45, 68, 69, 317, 221, 222, 223, 224, 225, 226,
+ 227, 228, 229, 230, 231, 232, 233, 234, 66, 4,
+ 5, 141, 142, 143, 28, 66, 30, 12, 66, 14,
+ 15, 136, 236, 456, 447, 66, 21, 29, 30, 31,
+ 32, 146, 27, 68, 36, 8, 6, 39, 40, 41,
+ 35, 36, 37, 38, 39, 40, 460, 68, 69, 68,
+ 30, 66, 24, 48, 370, 66, 58, 59, 66, 471,
+ 34, 475, 476, 65, 30, 67, 35, 35, 26, 66,
+ 35, 35, 49, 397, 49, 399, 49, 50, 51, 52,
+ 53, 54, 55, 56, 57, 66, 71, 60, 61, 62,
+ 63, 64, 17, 42, 410, 73, 67, 73, 30, 66,
+ 33, 9, 33, 66, 66, 319, 221, 222, 223, 224,
+ 225, 226, 227, 228, 229, 230, 231, 232, 233, 234,
+ 17, 66, 66, 447, 26, 73, 36, 67, 74, 33,
+ 17, 22, 456, 449, 7, 72, 66, 66, 4, 17,
+ 7, 42, 30, 23, 8, 44, 101, 471, 69, 145,
+ 57, 67, 49, 50, 51, 52, 53, 54, 55, 56,
+ 57, 4, 5, 60, 61, 62, 63, 64, 119, 12,
+ 449, 14, 15, 219, 72, 319, 323, 318, 21, 82,
+ 104, 372, 332, 96, 27, 291, 308, 30, 328, 462,
+ 329, 337, 35, 36, 37, 38, 39, 40, 453, 29,
+ 30, 31, 32, 455, -1, 48, 36, -1, -1, 39,
+ 40, 41, 42, 29, 30, 31, 32, -1, -1, -1,
+ -1, -1, -1, -1, -1, 41, -1, -1, 58, 59,
+ -1, -1, -1, -1, -1, 65, -1, 67, -1, -1,
+ -1, -1, 58, 59, -1, -1, -1, -1, -1, 65,
+ -1, 67, 49, 50, 51, 52, 53, 54, 55, 56,
+ 57, -1, -1, 60, 61, 62, 63, 64, -1, -1,
+ -1, -1, -1, -1, -1, -1, 73, 49, 50, 51,
+ 52, 53, 54, 55, 56, 57, -1, -1, 60, 61,
+ 62, 63, 64, -1, -1, -1, -1, 69, -1, -1,
+ 72, 49, 50, 51, 52, 53, 54, 55, 56, 57,
+ -1, -1, 60, 61, 62, 63, 64, -1, -1, -1,
+ -1, -1, -1, -1, 72, 49, 50, 51, 52, 53,
+ 54, 55, 56, 57, -1, -1, 60, 61, 62, 63,
+ 64, -1, -1, -1, 68, 49, 50, 51, 52, 53,
+ 54, 55, 56, 57, -1, -1, 60, 61, 62, 63,
+ 64, -1, -1, -1, 68, 49, 50, 51, 52, 53,
+ 54, 55, 56, 57, -1, -1, 60, 61, 62, 63,
+ 64, 49, 50, 51, 52, 53, 54, 55, 56, 57,
+ -1, -1, 60, 61, 62, 63, 64, 49, 50, 51,
+ 52, 53, 54, 55, 56, 57, -1, -1, 60, 61,
+ 62, 63, 64, 49, 50, 51, 52, 53, 54, 55,
+ 56, 57, -1, -1, 60, 61, 62, 63, 64
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+ symbol of state STATE-NUM. */
+static const unsigned short yystos[] =
+{
+ 0, 76, 79, 0, 19, 46, 80, 81, 35, 6,
+ 13, 18, 24, 26, 47, 77, 67, 82, 35, 35,
+ 35, 35, 35, 35, 16, 89, 35, 41, 83, 84,
+ 66, 66, 66, 67, 66, 67, 49, 66, 66, 66,
+ 90, 6, 93, 68, 69, 68, 68, 35, 36, 41,
+ 59, 128, 129, 130, 30, 91, 92, 94, 95, 96,
+ 24, 120, 84, 66, 66, 66, 30, 34, 66, 69,
+ 95, 35, 121, 122, 123, 26, 147, 130, 92, 97,
+ 122, 35, 148, 149, 150, 78, 49, 124, 149, 35,
+ 36, 45, 152, 153, 13, 18, 156, 157, 158, 159,
+ 171, 172, 98, 49, 69, 73, 35, 39, 40, 179,
+ 35, 37, 38, 170, 4, 154, 157, 66, 85, 86,
+ 66, 85, 29, 30, 31, 32, 41, 58, 59, 65,
+ 67, 100, 101, 116, 118, 119, 215, 125, 153, 151,
+ 173, 176, 160, 161, 155, 89, 117, 49, 50, 51,
+ 52, 53, 54, 55, 56, 57, 60, 61, 62, 63,
+ 64, 99, 101, 3, 11, 20, 42, 70, 126, 127,
+ 128, 131, 132, 133, 134, 137, 145, 126, 67, 162,
+ 162, 162, 162, 4, 5, 12, 14, 15, 21, 27,
+ 30, 35, 36, 37, 38, 39, 40, 48, 182, 184,
+ 185, 186, 187, 188, 189, 192, 194, 225, 227, 228,
+ 229, 230, 231, 232, 237, 245, 246, 249, 252, 93,
+ 101, 106, 109, 110, 112, 111, 107, 102, 103, 114,
+ 104, 115, 113, 108, 105, 66, 71, 17, 138, 42,
+ 66, 66, 163, 73, 73, 66, 66, 183, 238, 253,
+ 30, 233, 250, 247, 193, 226, 10, 66, 73, 33,
+ 33, 9, 235, 120, 68, 101, 101, 101, 101, 101,
+ 101, 101, 101, 101, 101, 101, 101, 101, 101, 42,
+ 128, 135, 146, 139, 140, 141, 26, 164, 167, 168,
+ 174, 177, 184, 39, 40, 67, 100, 192, 200, 215,
+ 216, 36, 256, 200, 184, 200, 71, 74, 195, 196,
+ 67, 219, 74, 185, 187, 190, 191, 236, 87, 69,
+ 72, 126, 10, 66, 35, 45, 143, 144, 169, 66,
+ 68, 165, 166, 126, 180, 180, 10, 218, 217, 17,
+ 49, 50, 51, 52, 53, 54, 55, 56, 57, 60,
+ 61, 62, 63, 64, 200, 33, 234, 25, 248, 197,
+ 43, 44, 45, 196, 220, 200, 200, 185, 147, 135,
+ 17, 140, 69, 73, 165, 167, 152, 175, 178, 219,
+ 200, 239, 205, 208, 209, 211, 210, 206, 201, 202,
+ 213, 203, 214, 212, 207, 204, 254, 22, 251, 7,
+ 200, 42, 200, 221, 223, 88, 72, 126, 136, 144,
+ 142, 73, 66, 66, 68, 28, 30, 240, 241, 242,
+ 243, 200, 200, 200, 200, 200, 200, 200, 200, 200,
+ 200, 200, 200, 200, 200, 200, 257, 185, 200, 185,
+ 69, 72, 198, 73, 224, 68, 69, 4, 181, 17,
+ 126, 42, 10, 66, 244, 69, 73, 258, 260, 7,
+ 199, 30, 222, 184, 136, 10, 241, 243, 187, 23,
+ 8, 255, 200, 223, 10, 259, 261, 185, 72, 200,
+ 200
+};
+
+#if ! defined (YYSIZE_T) && defined (__SIZE_TYPE__)
+# define YYSIZE_T __SIZE_TYPE__
+#endif
+#if ! defined (YYSIZE_T) && defined (size_t)
+# define YYSIZE_T size_t
+#endif
+#if ! defined (YYSIZE_T)
+# if defined (__STDC__) || defined (__cplusplus)
+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
+# endif
+#endif
+#if ! defined (YYSIZE_T)
+# define YYSIZE_T unsigned int
+#endif
+
+#define yyerrok (yyerrstatus = 0)
+#define yyclearin (yychar = YYEMPTY)
+#define YYEMPTY (-2)
+#define YYEOF 0
+
+#define YYACCEPT goto yyacceptlab
+#define YYABORT goto yyabortlab
+#define YYERROR goto yyerrlab1
+
+
+/* Like YYERROR except do call yyerror. This remains here temporarily
+ to ease the transition to the new meaning of YYERROR, for GCC.
+ Once GCC version 2 has supplanted version 1, this can go. */
+
+#define YYFAIL goto yyerrlab
+
+#define YYRECOVERING() (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value) \
+do \
+ if (yychar == YYEMPTY && yylen == 1) \
+ { \
+ yychar = (Token); \
+ yylval = (Value); \
+ yytoken = YYTRANSLATE (yychar); \
+ YYPOPSTACK; \
+ goto yybackup; \
+ } \
+ else \
+ { \
+ yyerror ("syntax error: cannot back up");\
+ YYERROR; \
+ } \
+while (0)
+
+#define YYTERROR 1
+#define YYERRCODE 256
+
+/* YYLLOC_DEFAULT -- Compute the default location (before the actions
+ are run). */
+
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N) \
+ Current.first_line = Rhs[1].first_line; \
+ Current.first_column = Rhs[1].first_column; \
+ Current.last_line = Rhs[N].last_line; \
+ Current.last_column = Rhs[N].last_column;
+#endif
+
+/* YYLEX -- calling `yylex' with the right arguments. */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested. */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+# include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+# define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args) \
+do { \
+ if (yydebug) \
+ YYFPRINTF Args; \
+} while (0)
+
+# define YYDSYMPRINT(Args) \
+do { \
+ if (yydebug) \
+ yysymprint Args; \
+} while (0)
+
+# define YYDSYMPRINTF(Title, Token, Value, Location) \
+do { \
+ if (yydebug) \
+ { \
+ YYFPRINTF (stderr, "%s ", Title); \
+ yysymprint (stderr, \
+ Token, Value); \
+ YYFPRINTF (stderr, "\n"); \
+ } \
+} while (0)
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (cinluded). |
+`------------------------------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yy_stack_print (short *bottom, short *top)
+#else
+static void
+yy_stack_print (bottom, top)
+ short *bottom;
+ short *top;
+#endif
+{
+ YYFPRINTF (stderr, "Stack now");
+ for (/* Nothing. */; bottom <= top; ++bottom)
+ YYFPRINTF (stderr, " %d", *bottom);
+ YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top) \
+do { \
+ if (yydebug) \
+ yy_stack_print ((Bottom), (Top)); \
+} while (0)
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced. |
+`------------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yy_reduce_print (int yyrule)
+#else
+static void
+yy_reduce_print (yyrule)
+ int yyrule;
+#endif
+{
+ int yyi;
+ unsigned int yylineno = yyrline[yyrule];
+ YYFPRINTF (stderr, "Reducing stack by rule %d (line %u), ",
+ yyrule - 1, yylineno);
+ /* Print the symbols being reduced, and their result. */
+ for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
+ YYFPRINTF (stderr, "%s ", yytname [yyrhs[yyi]]);
+ YYFPRINTF (stderr, "-> %s\n", yytname [yyr1[yyrule]]);
+}
+
+# define YY_REDUCE_PRINT(Rule) \
+do { \
+ if (yydebug) \
+ yy_reduce_print (Rule); \
+} while (0)
+
+/* Nonzero means print parse trace. It is left uninitialized so that
+ multiple parsers can coexist. */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YYDSYMPRINT(Args)
+# define YYDSYMPRINTF(Title, Token, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks. */
+#ifndef YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+ if the built-in stack extension method is used).
+
+ Do not make this value too large; the results are undefined if
+ SIZE_MAX < YYSTACK_BYTES (YYMAXDEPTH)
+ evaluated with infinite-precision integer arithmetic. */
+
+#if YYMAXDEPTH == 0
+# undef YYMAXDEPTH
+#endif
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+# if defined (__GLIBC__) && defined (_STRING_H)
+# define yystrlen strlen
+# else
+/* Return the length of YYSTR. */
+static YYSIZE_T
+# if defined (__STDC__) || defined (__cplusplus)
+yystrlen (const char *yystr)
+# else
+yystrlen (yystr)
+ const char *yystr;
+# endif
+{
+ register const char *yys = yystr;
+
+ while (*yys++ != '\0')
+ continue;
+
+ return yys - yystr - 1;
+}
+# endif
+# endif
+
+# ifndef yystpcpy
+# if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
+# define yystpcpy stpcpy
+# else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+ YYDEST. */
+static char *
+# if defined (__STDC__) || defined (__cplusplus)
+yystpcpy (char *yydest, const char *yysrc)
+# else
+yystpcpy (yydest, yysrc)
+ char *yydest;
+ const char *yysrc;
+# endif
+{
+ register char *yyd = yydest;
+ register const char *yys = yysrc;
+
+ while ((*yyd++ = *yys++) != '\0')
+ continue;
+
+ return yyd - 1;
+}
+# endif
+# endif
+
+#endif /* !YYERROR_VERBOSE */
+
+
+
+#if YYDEBUG
+/*--------------------------------.
+| Print this symbol on YYOUTPUT. |
+`--------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yysymprint (FILE *yyoutput, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yysymprint (yyoutput, yytype, yyvaluep)
+ FILE *yyoutput;
+ int yytype;
+ YYSTYPE *yyvaluep;
+#endif
+{
+ /* Pacify ``unused variable'' warnings. */
+ (void) yyvaluep;
+
+ if (yytype < YYNTOKENS)
+ {
+ YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+# ifdef YYPRINT
+ YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# endif
+ }
+ else
+ YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+ switch (yytype)
+ {
+ default:
+ break;
+ }
+ YYFPRINTF (yyoutput, ")");
+}
+
+#endif /* ! YYDEBUG */
+/*-----------------------------------------------.
+| Release the memory associated to this symbol. |
+`-----------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yydestruct (int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yytype, yyvaluep)
+ int yytype;
+ YYSTYPE *yyvaluep;
+#endif
+{
+ /* Pacify ``unused variable'' warnings. */
+ (void) yyvaluep;
+
+ switch (yytype)
+ {
+
+ default:
+ break;
+ }
+}
+
+
+/* Prevent warnings from -Wmissing-prototypes. */
+
+#ifdef YYPARSE_PARAM
+# if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void *YYPARSE_PARAM);
+# else
+int yyparse ();
+# endif
+#else /* ! YYPARSE_PARAM */
+#if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The lookahead symbol. */
+int yychar;
+
+/* The semantic value of the lookahead symbol. */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far. */
+int yynerrs;
+
+
+
+/*----------.
+| yyparse. |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+# if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void *YYPARSE_PARAM)
+# else
+int yyparse (YYPARSE_PARAM)
+ void *YYPARSE_PARAM;
+# endif
+#else /* ! YYPARSE_PARAM */
+#if defined (__STDC__) || defined (__cplusplus)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+
+ register int yystate;
+ register int yyn;
+ int yyresult;
+ /* Number of tokens to shift before error messages enabled. */
+ int yyerrstatus;
+ /* Lookahead token as an internal (translated) token number. */
+ int yytoken = 0;
+
+ /* Three stacks and their tools:
+ `yyss': related to states,
+ `yyvs': related to semantic values,
+ `yyls': related to locations.
+
+ Refer to the stacks thru separate pointers, to allow yyoverflow
+ to reallocate them elsewhere. */
+
+ /* The state stack. */
+ short yyssa[YYINITDEPTH];
+ short *yyss = yyssa;
+ register short *yyssp;
+
+ /* The semantic value stack. */
+ YYSTYPE yyvsa[YYINITDEPTH];
+ YYSTYPE *yyvs = yyvsa;
+ register YYSTYPE *yyvsp;
+
+
+
+#define YYPOPSTACK (yyvsp--, yyssp--)
+
+ YYSIZE_T yystacksize = YYINITDEPTH;
+
+ /* The variables used to return semantic value and location from the
+ action routines. */
+ YYSTYPE yyval;
+
+
+ /* When reducing, the number of symbols on the RHS of the reduced
+ rule. */
+ int yylen;
+
+ YYDPRINTF ((stderr, "Starting parse\n"));
+
+ yystate = 0;
+ yyerrstatus = 0;
+ yynerrs = 0;
+ yychar = YYEMPTY; /* Cause a token to be read. */
+
+ /* Initialize stack pointers.
+ Waste one element of value and location stack
+ so that they stay on the same level as the state stack.
+ The wasted elements are never initialized. */
+
+ yyssp = yyss;
+ yyvsp = yyvs;
+
+ goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate. |
+`------------------------------------------------------------*/
+ yynewstate:
+ /* In all cases, when you get here, the value and location stacks
+ have just been pushed. so pushing a state here evens the stacks.
+ */
+ yyssp++;
+
+ yysetstate:
+ *yyssp = yystate;
+
+ if (yyss + yystacksize - 1 <= yyssp)
+ {
+ /* Get the current used size of the three stacks, in elements. */
+ YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+ {
+ /* Give user a chance to reallocate the stack. Use copies of
+ these so that the &'s don't force the real ones into
+ memory. */
+ YYSTYPE *yyvs1 = yyvs;
+ short *yyss1 = yyss;
+
+
+ /* Each stack pointer address is followed by the size of the
+ data in use in that stack, in bytes. This used to be a
+ conditional around just the two extra args, but that might
+ be undefined if yyoverflow is a macro. */
+ yyoverflow ("parser stack overflow",
+ &yyss1, yysize * sizeof (*yyssp),
+ &yyvs1, yysize * sizeof (*yyvsp),
+
+ &yystacksize);
+
+ yyss = yyss1;
+ yyvs = yyvs1;
+ }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+ goto yyoverflowlab;
+# else
+ /* Extend the stack our own way. */
+ if (YYMAXDEPTH <= yystacksize)
+ goto yyoverflowlab;
+ yystacksize *= 2;
+ if (YYMAXDEPTH < yystacksize)
+ yystacksize = YYMAXDEPTH;
+
+ {
+ short *yyss1 = yyss;
+ union yyalloc *yyptr =
+ (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+ if (! yyptr)
+ goto yyoverflowlab;
+ YYSTACK_RELOCATE (yyss);
+ YYSTACK_RELOCATE (yyvs);
+
+# undef YYSTACK_RELOCATE
+ if (yyss1 != yyssa)
+ YYSTACK_FREE (yyss1);
+ }
+# endif
+#endif /* no yyoverflow */
+
+ yyssp = yyss + yysize - 1;
+ yyvsp = yyvs + yysize - 1;
+
+
+ YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+ (unsigned long int) yystacksize));
+
+ if (yyss + yystacksize - 1 <= yyssp)
+ YYABORT;
+ }
+
+ YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+ goto yybackup;
+
+/*-----------.
+| yybackup. |
+`-----------*/
+yybackup:
+
+/* Do appropriate processing given the current state. */
+/* Read a lookahead token if we need one and don't already have one. */
+/* yyresume: */
+
+ /* First try to decide what to do without reference to lookahead token. */
+
+ yyn = yypact[yystate];
+ if (yyn == YYPACT_NINF)
+ goto yydefault;
+
+ /* Not known => get a lookahead token if don't already have one. */
+
+ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
+ if (yychar == YYEMPTY)
+ {
+ YYDPRINTF ((stderr, "Reading a token: "));
+ yychar = YYLEX;
+ }
+
+ if (yychar <= YYEOF)
+ {
+ yychar = yytoken = YYEOF;
+ YYDPRINTF ((stderr, "Now at end of input.\n"));
+ }
+ else
+ {
+ yytoken = YYTRANSLATE (yychar);
+ YYDSYMPRINTF ("Next token is", yytoken, &yylval, &yylloc);
+ }
+
+ /* If the proper action on seeing token YYTOKEN is to reduce or to
+ detect an error, take that action. */
+ yyn += yytoken;
+ if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+ goto yydefault;
+ yyn = yytable[yyn];
+ if (yyn <= 0)
+ {
+ if (yyn == 0 || yyn == YYTABLE_NINF)
+ goto yyerrlab;
+ yyn = -yyn;
+ goto yyreduce;
+ }
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ /* Shift the lookahead token. */
+ YYDPRINTF ((stderr, "Shifting token %s, ", yytname[yytoken]));
+
+ /* Discard the token being shifted unless it is eof. */
+ if (yychar != YYEOF)
+ yychar = YYEMPTY;
+
+ *++yyvsp = yylval;
+
+
+ /* Count tokens shifted since error; after three, turn off error
+ status. */
+ if (yyerrstatus)
+ yyerrstatus--;
+
+ yystate = yyn;
+ goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state. |
+`-----------------------------------------------------------*/
+yydefault:
+ yyn = yydefact[yystate];
+ if (yyn == 0)
+ goto yyerrlab;
+ goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction. |
+`-----------------------------*/
+yyreduce:
+ /* yyn is the number of a rule to reduce with. */
+ yylen = yyr2[yyn];
+
+ /* If YYLEN is nonzero, implement the default value of the action:
+ `$$ = $1'.
+
+ Otherwise, the following line sets YYVAL to garbage.
+ This behavior is undocumented and Bison
+ users should not rely upon it. Assigning to YYVAL
+ unconditionally makes the parser a bit smaller, and it avoids a
+ GCC warning that YYVAL may be used uninitialized. */
+ yyval = yyvsp[1-yylen];
+
+
+ YY_REDUCE_PRINT (yyn);
+ switch (yyn)
+ {
+ case 2:
+#line 65 "./web2c.y"
+ {
+ printf ("#define %s\n", uppercasify (program_name));
+ block_level++;
+ printf ("#include \"%s\"\n", std_header);
+ }
+ break;
+
+ case 3:
+#line 72 "./web2c.y"
+ { printf ("\n#include \"%s\"\n", coerce_name); }
+ break;
+
+ case 4:
+#line 75 "./web2c.y"
+ { YYACCEPT; }
+ break;
+
+ case 7:
+#line 85 "./web2c.y"
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = field_id_tok;
+ }
+ break;
+
+ case 8:
+#line 90 "./web2c.y"
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = fun_id_tok;
+ }
+ break;
+
+ case 9:
+#line 95 "./web2c.y"
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = const_id_tok;
+ }
+ break;
+
+ case 10:
+#line 100 "./web2c.y"
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = fun_param_tok;
+ }
+ break;
+
+ case 11:
+#line 105 "./web2c.y"
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = proc_id_tok;
+ }
+ break;
+
+ case 12:
+#line 110 "./web2c.y"
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = proc_param_tok;
+ }
+ break;
+
+ case 13:
+#line 115 "./web2c.y"
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = type_id_tok;
+ }
+ break;
+
+ case 14:
+#line 120 "./web2c.y"
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = type_id_tok;
+ sym_table[ii].val = lower_bound;
+ sym_table[ii].val_sym = lower_sym;
+ sym_table[ii].upper = upper_bound;
+ sym_table[ii].upper_sym = upper_sym;
+ }
+ break;
+
+ case 15:
+#line 129 "./web2c.y"
+ {
+ ii = add_to_table (last_id);
+ sym_table[ii].typ = var_id_tok;
+ }
+ break;
+
+ case 23:
+#line 156 "./web2c.y"
+ { if (block_level > 0) my_output("{\n ");
+ indent++; block_level++;
+ }
+ break;
+
+ case 24:
+#line 161 "./web2c.y"
+ { if (block_level == 2) {
+ if (strcmp(fn_return_type, "void")) {
+ my_output("register");
+ my_output(fn_return_type);
+ my_output("Result;");
+ }
+ if (tex) {
+ sprintf(safe_string, "%s_regmem", my_routine);
+ my_output(safe_string);
+ new_line();
+ }
+ }
+ }
+ break;
+
+ case 25:
+#line 175 "./web2c.y"
+ { doing_statements = true; }
+ break;
+
+ case 26:
+#line 177 "./web2c.y"
+ {
+ if (block_level == 2) {
+ if (strcmp(fn_return_type,"void")) {
+ my_output("return Result");
+ semicolon();
+ }
+ if (tex) {
+ if (uses_mem && uses_eqtb)
+ fprintf(coerce,
+ "#define %s_regmem register memoryword *mem=zmem, *eqtb=zeqtb;\n",
+ my_routine);
+ else if (uses_mem)
+ fprintf(coerce, "#define %s_regmem register memoryword *mem=zmem;\n",
+ my_routine);
+ else if (uses_eqtb)
+ fprintf(coerce, "#define %s_regmem register memoryword *eqtb=zeqtb;\n",
+ my_routine);
+ else
+ fprintf(coerce, "#define %s_regmem\n", my_routine);
+ }
+ my_routine[0] = '\0';
+ }
+ indent--; block_level--;
+ my_output("}"); new_line();
+ doing_statements = false;
+ }
+ break;
+
+ case 28:
+#line 207 "./web2c.y"
+ { my_output("/*"); }
+ break;
+
+ case 29:
+#line 209 "./web2c.y"
+ { my_output("*/"); }
+ break;
+
+ case 32:
+#line 217 "./web2c.y"
+ { my_output(temp); }
+ break;
+
+ case 34:
+#line 223 "./web2c.y"
+ { new_line(); }
+ break;
+
+ case 37:
+#line 232 "./web2c.y"
+ { /* `#define' must be in column 1 for pcc. */
+ unsigned save = indent;
+ new_line ();
+ indent = 0;
+ my_output ("#define");
+ indent = save;
+ }
+ break;
+
+ case 38:
+#line 240 "./web2c.y"
+ { ii = add_to_table (last_id);
+ sym_table[ii].typ = const_id_tok;
+ my_output (last_id);
+ }
+ break;
+
+ case 39:
+#line 244 "./web2c.y"
+ { my_output ("("); }
+ break;
+
+ case 40:
+#line 245 "./web2c.y"
+ { my_output (")"); }
+ break;
+
+ case 41:
+#line 246 "./web2c.y"
+ { sym_table[ii].val = last_i_num; new_line(); }
+ break;
+
+ case 42:
+#line 251 "./web2c.y"
+ {
+ sscanf (temp, "%ld", &last_i_num);
+ if (my_labs ((long) last_i_num) > 32767)
+ strcat (temp, "L");
+ my_output (temp);
+ yyval = ex_32;
+ }
+ break;
+
+ case 43:
+#line 258 "./web2c.y"
+ { my_output(temp); yyval = ex_real; }
+ break;
+
+ case 44:
+#line 259 "./web2c.y"
+ { yyval = 0; }
+ break;
+
+ case 45:
+#line 260 "./web2c.y"
+ { yyval = ex_32; }
+ break;
+
+ case 46:
+#line 265 "./web2c.y"
+ { yyval = yyvsp[0]; }
+ break;
+
+ case 47:
+#line 266 "./web2c.y"
+ { my_output ("+"); }
+ break;
+
+ case 48:
+#line 267 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 49:
+#line 268 "./web2c.y"
+ { my_output ("-"); }
+ break;
+
+ case 50:
+#line 269 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 51:
+#line 270 "./web2c.y"
+ { my_output ("*"); }
+ break;
+
+ case 52:
+#line 271 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 53:
+#line 272 "./web2c.y"
+ { my_output ("/"); }
+ break;
+
+ case 54:
+#line 273 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 55:
+#line 274 "./web2c.y"
+ { my_output ("=="); }
+ break;
+
+ case 56:
+#line 275 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 57:
+#line 276 "./web2c.y"
+ { my_output ("!="); }
+ break;
+
+ case 58:
+#line 277 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 59:
+#line 278 "./web2c.y"
+ { my_output ("%"); }
+ break;
+
+ case 60:
+#line 279 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 61:
+#line 280 "./web2c.y"
+ { my_output ("<"); }
+ break;
+
+ case 62:
+#line 281 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 63:
+#line 282 "./web2c.y"
+ { my_output (">"); }
+ break;
+
+ case 64:
+#line 283 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 65:
+#line 284 "./web2c.y"
+ { my_output ("<="); }
+ break;
+
+ case 66:
+#line 285 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 67:
+#line 286 "./web2c.y"
+ { my_output (">="); }
+ break;
+
+ case 68:
+#line 287 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 69:
+#line 288 "./web2c.y"
+ { my_output ("&&"); }
+ break;
+
+ case 70:
+#line 289 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 71:
+#line 290 "./web2c.y"
+ { my_output ("||"); }
+ break;
+
+ case 72:
+#line 291 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 73:
+#line 292 "./web2c.y"
+ { my_output ("/ ((double)"); }
+ break;
+
+ case 74:
+#line 293 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); my_output (")"); }
+ break;
+
+ case 75:
+#line 294 "./web2c.y"
+ { yyval = yyvsp[0]; }
+ break;
+
+ case 76:
+#line 299 "./web2c.y"
+ { my_output ("("); }
+ break;
+
+ case 77:
+#line 301 "./web2c.y"
+ { my_output (")"); yyval = yyvsp[-3]; }
+ break;
+
+ case 79:
+#line 307 "./web2c.y"
+ {
+ char s[132];
+ get_string_literal(s);
+ my_output (s);
+ }
+ break;
+
+ case 80:
+#line 313 "./web2c.y"
+ {
+ char s[5];
+ get_single_char(s);
+ my_output (s);
+ }
+ break;
+
+ case 81:
+#line 321 "./web2c.y"
+ { my_output (last_id); }
+ break;
+
+ case 86:
+#line 333 "./web2c.y"
+ { my_output ("typedef"); }
+ break;
+
+ case 87:
+#line 335 "./web2c.y"
+ {
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = type_id_tok;
+ strcpy(safe_string, last_id);
+ last_type = ii;
+ }
+ break;
+
+ case 88:
+#line 342 "./web2c.y"
+ {
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ }
+ break;
+
+ case 89:
+#line 347 "./web2c.y"
+ {
+ if (*array_offset) {
+ yyerror ("Cannot typedef arrays with offsets");
+ }
+ my_output (safe_string);
+ my_output (array_bounds);
+ semicolon ();
+ last_type = -1;
+ }
+ break;
+
+ case 92:
+#line 365 "./web2c.y"
+ {
+ if (last_type >= 0)
+ {
+ sym_table[ii].val = lower_bound;
+ sym_table[ii].val_sym = lower_sym;
+ sym_table[ii].upper = upper_bound;
+ sym_table[ii].upper_sym = upper_sym;
+ ii= -1;
+ }
+
+ /* If the bounds on an integral type are known at
+ translation time, select the smallest ANSI C type which
+ can represent it. We avoid using unsigned char and
+ unsigned short where possible, as ANSI compilers
+ (typically) convert them to int, while traditional
+ compilers convert them to unsigned int. We also avoid
+ schar if possible, since it also is different on
+ different compilers (see config.h). */
+ if (lower_sym == -1 && upper_sym == -1) {
+ if (0 <= lower_bound && upper_bound <= SCHAR_MAX)
+ my_output ("char");
+ else if (SCHAR_MIN <= lower_bound && upper_bound <= SCHAR_MAX)
+ my_output ("schar");
+ else if (0 <= lower_bound && upper_bound <= UCHAR_MAX)
+ my_output ("unsigned char");
+ else if (SHRT_MIN <= lower_bound && upper_bound <= SHRT_MAX)
+ my_output ("short");
+ else if (0 <= lower_bound && upper_bound <= USHRT_MAX)
+ my_output ("unsigned short");
+ else
+ my_output ("integer");
+ } else {
+ my_output ("integer");
+ }
+ }
+ break;
+
+ case 97:
+#line 414 "./web2c.y"
+ {
+ lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ sscanf (temp, "%ld", &upper_bound);
+ upper_sym = -1; /* no sym table entry */
+ }
+ break;
+
+ case 98:
+#line 421 "./web2c.y"
+ {
+ lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ upper_bound = sym_table[l_s].val;
+ upper_sym = l_s;
+ }
+ break;
+
+ case 99:
+#line 428 "./web2c.y"
+ { /* We've changed some constants into dynamic variables.
+ To avoid changing all the subrange decls, just use integer.
+ This does not work for arrays, for which we check later. */
+ lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ upper_bound = 0;
+ upper_sym = 0; /* Translate to integer. */
+ }
+ break;
+
+ case 100:
+#line 437 "./web2c.y"
+ { /* Same as var_id_tok, to avoid changing type definitions.
+ Should keep track of the variables we use in this way
+ and make sure they're all eventually defined. */
+ lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ upper_bound = 0;
+ upper_sym = 0;
+ }
+ break;
+
+ case 101:
+#line 449 "./web2c.y"
+ {
+ if (last_type >= 0) {
+ sym_table[last_type].var_not_needed = sym_table[l_s].var_not_needed;
+ sym_table[last_type].upper = sym_table[l_s].upper;
+ sym_table[last_type].upper_sym = sym_table[l_s].upper_sym;
+ sym_table[last_type].val = sym_table[l_s].val;
+ sym_table[last_type].val_sym = sym_table[l_s].val_sym;
+ }
+ my_output (last_id);
+ }
+ break;
+
+ case 102:
+#line 463 "./web2c.y"
+ { if (last_type >= 0)
+ sym_table[last_type].var_not_needed = true;
+ }
+ break;
+
+ case 104:
+#line 468 "./web2c.y"
+ { if (last_type >= 0)
+ sym_table[last_type].var_not_needed = true;
+ }
+ break;
+
+ case 105:
+#line 472 "./web2c.y"
+ { if (last_type >= 0)
+ sym_table[last_type].var_not_needed = true;
+ }
+ break;
+
+ case 106:
+#line 479 "./web2c.y"
+ {
+ if (last_type >= 0) {
+ sym_table[last_type].var_not_needed = sym_table[l_s].var_not_needed;
+ sym_table[last_type].upper = sym_table[l_s].upper;
+ sym_table[last_type].upper_sym = sym_table[l_s].upper_sym;
+ sym_table[last_type].val = sym_table[l_s].val;
+ sym_table[last_type].val_sym = sym_table[l_s].val_sym;
+ }
+ my_output (last_id);
+ my_output ("*");
+ }
+ break;
+
+ case 109:
+#line 499 "./web2c.y"
+ { compute_array_bounds(); }
+ break;
+
+ case 110:
+#line 501 "./web2c.y"
+ {
+ lower_bound = sym_table[l_s].val;
+ lower_sym = sym_table[l_s].val_sym;
+ upper_bound = sym_table[l_s].upper;
+ upper_sym = sym_table[l_s].upper_sym;
+ compute_array_bounds();
+ }
+ break;
+
+ case 112:
+#line 514 "./web2c.y"
+ { my_output ("struct"); my_output ("{"); indent++; }
+ break;
+
+ case 113:
+#line 516 "./web2c.y"
+ { indent--; my_output ("}"); semicolon(); }
+ break;
+
+ case 116:
+#line 524 "./web2c.y"
+ { field_list[0] = 0; }
+ break;
+
+ case 117:
+#line 526 "./web2c.y"
+ {
+ /*array_bounds[0] = 0;
+ array_offset[0] = 0;*/
+ }
+ break;
+
+ case 118:
+#line 531 "./web2c.y"
+ { int i=0, j; char ltemp[80];
+ while(field_list[i++] == '!') {
+ j = 0;
+ while (field_list[i])
+ ltemp[j++] = field_list[i++];
+ i++;
+ if (field_list[i] == '!')
+ ltemp[j++] = ',';
+ ltemp[j] = 0;
+ my_output (ltemp);
+ }
+ semicolon();
+ }
+ break;
+
+ case 122:
+#line 552 "./web2c.y"
+ { int i=0, j=0;
+ while (field_list[i] == '!')
+ while(field_list[i++]);
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = field_id_tok;
+ field_list[i++] = '!';
+ while (last_id[j])
+ field_list[i++] = last_id[j++];
+ field_list[i++] = 0;
+ field_list[i++] = 0;
+ }
+ break;
+
+ case 123:
+#line 564 "./web2c.y"
+ { int i=0, j=0;
+ while (field_list[i] == '!')
+ while(field_list[i++]);
+ field_list[i++] = '!';
+ while (last_id[j])
+ field_list[i++] = last_id[j++];
+ field_list[i++] = 0;
+ field_list[i++] = 0;
+ }
+ break;
+
+ case 124:
+#line 577 "./web2c.y"
+ { my_output ("text /* of "); }
+ break;
+
+ case 125:
+#line 579 "./web2c.y"
+ { my_output ("*/"); }
+ break;
+
+ case 130:
+#line 593 "./web2c.y"
+ {
+ var_list[0] = 0;
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ var_formals = false;
+ ids_paramed = 0;
+ }
+ break;
+
+ case 131:
+#line 601 "./web2c.y"
+ {
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ }
+ break;
+
+ case 132:
+#line 606 "./web2c.y"
+ { fixup_var_list(); }
+ break;
+
+ case 135:
+#line 614 "./web2c.y"
+ { int i=0, j=0;
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = var_id_tok;
+ sym_table[ii].var_formal = var_formals;
+ param_id_list[ids_paramed++] = ii;
+ while (var_list[i] == '!')
+ while(var_list[i++]);
+ var_list[i++] = '!';
+ while (last_id[j])
+ var_list[i++] = last_id[j++];
+ var_list[i++] = 0;
+ var_list[i++] = 0;
+ }
+ break;
+
+ case 136:
+#line 628 "./web2c.y"
+ { int i=0, j=0;
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = var_id_tok;
+ sym_table[ii].var_formal = var_formals;
+ param_id_list[ids_paramed++] = ii;
+ while (var_list[i] == '!')
+ while (var_list[i++]);
+ var_list[i++] = '!';
+ while (last_id[j])
+ var_list[i++] = last_id[j++];
+ var_list[i++] = 0;
+ var_list[i++] = 0;
+ }
+ break;
+
+ case 137:
+#line 642 "./web2c.y"
+ { int i=0, j=0;
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = var_id_tok;
+ sym_table[ii].var_formal = var_formals;
+ param_id_list[ids_paramed++] = ii;
+ while (var_list[i] == '!')
+ while(var_list[i++]);
+ var_list[i++] = '!';
+ while (last_id[j])
+ var_list[i++] = last_id[j++];
+ var_list[i++] = 0;
+ var_list[i++] = 0;
+ }
+ break;
+
+ case 139:
+#line 660 "./web2c.y"
+ { my_output ("void mainbody() {");
+ indent++;
+ new_line ();
+ }
+ break;
+
+ case 140:
+#line 665 "./web2c.y"
+ { indent--;
+ my_output ("}");
+ new_line ();
+ }
+ break;
+
+ case 143:
+#line 677 "./web2c.y"
+ { new_line(); remove_locals(); }
+ break;
+
+ case 144:
+#line 679 "./web2c.y"
+ { new_line(); remove_locals(); }
+ break;
+
+ case 146:
+#line 687 "./web2c.y"
+ { ii = add_to_table(last_id);
+ if (debug)
+ fprintf(stderr, "%3d Procedure %s\n", pf_count++, last_id);
+ sym_table[ii].typ = proc_id_tok;
+ strcpy(my_routine, last_id);
+ uses_eqtb = uses_mem = false;
+ my_output ("void");
+ new_line ();
+ orig_out = out;
+ out = 0;
+ }
+ break;
+
+ case 147:
+#line 699 "./web2c.y"
+ { strcpy(fn_return_type, "void");
+ do_proc_args();
+ gen_function_head(); }
+ break;
+
+ case 148:
+#line 703 "./web2c.y"
+ { ii = l_s;
+ if (debug)
+ fprintf(stderr, "%3d Procedure %s\n", pf_count++, last_id);
+ strcpy(my_routine, last_id);
+ my_output ("void");
+ new_line ();
+ }
+ break;
+
+ case 149:
+#line 711 "./web2c.y"
+ { strcpy(fn_return_type, "void");
+ do_proc_args();
+ gen_function_head();
+ }
+ break;
+
+ case 150:
+#line 719 "./web2c.y"
+ {
+ strcpy (z_id, last_id);
+ mark ();
+ ids_paramed = 0;
+ }
+ break;
+
+ case 151:
+#line 725 "./web2c.y"
+ { sprintf (z_id, "z%s", last_id);
+ ids_paramed = 0;
+ if (sym_table[ii].typ == proc_id_tok)
+ sym_table[ii].typ = proc_param_tok;
+ else if (sym_table[ii].typ == fun_id_tok)
+ sym_table[ii].typ = fun_param_tok;
+ mark();
+ }
+ break;
+
+ case 155:
+#line 741 "./web2c.y"
+ { ids_typed = ids_paramed; }
+ break;
+
+ case 156:
+#line 743 "./web2c.y"
+ { int i, need_var;
+ i = search_table(last_id);
+ need_var = !sym_table[i].var_not_needed;
+ for (i=ids_typed; i<ids_paramed; i++)
+ {
+ strcpy(arg_type[i], last_id);
+ if (need_var && sym_table[param_id_list[i]].var_formal)
+ strcat(arg_type[i], " *");
+ else
+ sym_table[param_id_list[i]].var_formal = false;
+ }
+ }
+ break;
+
+ case 157:
+#line 757 "./web2c.y"
+ {var_formals = 0; }
+ break;
+
+ case 159:
+#line 758 "./web2c.y"
+ {var_formals = 1; }
+ break;
+
+ case 164:
+#line 770 "./web2c.y"
+ {
+ orig_out = out;
+ out = 0;
+ ii = add_to_table(last_id);
+ if (debug)
+ fprintf(stderr, "%3d Function %s\n", pf_count++, last_id);
+ sym_table[ii].typ = fun_id_tok;
+ strcpy (my_routine, last_id);
+ uses_eqtb = uses_mem = false;
+ }
+ break;
+
+ case 165:
+#line 781 "./web2c.y"
+ {
+ normal();
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ }
+ break;
+
+ case 166:
+#line 787 "./web2c.y"
+ {
+ get_result_type(fn_return_type);
+ do_proc_args();
+ gen_function_head();
+ }
+ break;
+
+ case 168:
+#line 794 "./web2c.y"
+ {
+ orig_out = out;
+ out = 0;
+ ii = l_s;
+ if (debug)
+ fprintf(stderr, "%3d Function %s\n", pf_count++, last_id);
+ strcpy(my_routine, last_id);
+ uses_eqtb = uses_mem = false;
+ }
+ break;
+
+ case 169:
+#line 804 "./web2c.y"
+ { normal();
+ array_bounds[0] = 0;
+ array_offset[0] = 0;
+ }
+ break;
+
+ case 170:
+#line 809 "./web2c.y"
+ { get_result_type(fn_return_type);
+ do_proc_args();
+ gen_function_head();
+ }
+ break;
+
+ case 176:
+#line 827 "./web2c.y"
+ { my_output ("{"); indent++; new_line(); }
+ break;
+
+ case 177:
+#line 829 "./web2c.y"
+ { indent--; my_output ("}"); new_line(); }
+ break;
+
+ case 182:
+#line 842 "./web2c.y"
+ {if (!doreturn(temp)) {
+ sprintf(safe_string, "lab%s:", temp);
+ my_output (safe_string);
+ }
+ }
+ break;
+
+ case 183:
+#line 850 "./web2c.y"
+ { semicolon(); }
+ break;
+
+ case 184:
+#line 852 "./web2c.y"
+ { semicolon(); }
+ break;
+
+ case 189:
+#line 860 "./web2c.y"
+ { my_output ("break"); }
+ break;
+
+ case 190:
+#line 864 "./web2c.y"
+ { my_output ("="); }
+ break;
+
+ case 192:
+#line 867 "./web2c.y"
+ { my_output ("Result ="); }
+ break;
+
+ case 194:
+#line 872 "./web2c.y"
+ { if (strcmp(last_id, "mem") == 0)
+ uses_mem = 1;
+ else if (strcmp(last_id, "eqtb") == 0)
+ uses_eqtb = 1;
+ if (sym_table[l_s].var_formal)
+ putchar('*');
+ my_output (last_id);
+ yyval = ex_32;
+ }
+ break;
+
+ case 196:
+#line 883 "./web2c.y"
+ { if (sym_table[l_s].var_formal)
+ putchar('*');
+ my_output (last_id); yyval = ex_32; }
+ break;
+
+ case 197:
+#line 889 "./web2c.y"
+ { yyval = ex_32; }
+ break;
+
+ case 198:
+#line 891 "./web2c.y"
+ { yyval = ex_32; }
+ break;
+
+ case 201:
+#line 899 "./web2c.y"
+ { my_output ("["); }
+ break;
+
+ case 202:
+#line 901 "./web2c.y"
+ { my_output ("]"); }
+ break;
+
+ case 203:
+#line 903 "./web2c.y"
+ {if (tex || mf) {
+ if (strcmp(last_id, "int")==0)
+ my_output (".cint");
+ else if (strcmp(last_id, "lh")==0)
+ my_output (".v.LH");
+ else if (strcmp(last_id, "rh")==0)
+ my_output (".v.RH");
+ else {
+ sprintf(safe_string, ".%s", last_id);
+ my_output (safe_string);
+ }
+ }
+ else {
+ sprintf(safe_string, ".%s", last_id);
+ my_output (safe_string);
+ }
+ }
+ break;
+
+ case 204:
+#line 921 "./web2c.y"
+ { my_output (".hh.b0"); }
+ break;
+
+ case 205:
+#line 923 "./web2c.y"
+ { my_output (".hh.b1"); }
+ break;
+
+ case 207:
+#line 928 "./web2c.y"
+ { my_output ("]["); }
+ break;
+
+ case 209:
+#line 933 "./web2c.y"
+ { yyval = yyvsp[0]; }
+ break;
+
+ case 210:
+#line 934 "./web2c.y"
+ { my_output ("+"); }
+ break;
+
+ case 211:
+#line 935 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 212:
+#line 936 "./web2c.y"
+ { my_output ("-"); }
+ break;
+
+ case 213:
+#line 937 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 214:
+#line 938 "./web2c.y"
+ { my_output ("*"); }
+ break;
+
+ case 215:
+#line 939 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 216:
+#line 940 "./web2c.y"
+ { my_output ("/"); }
+ break;
+
+ case 217:
+#line 941 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 218:
+#line 942 "./web2c.y"
+ { my_output ("=="); }
+ break;
+
+ case 219:
+#line 943 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 220:
+#line 944 "./web2c.y"
+ { my_output ("!="); }
+ break;
+
+ case 221:
+#line 945 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 222:
+#line 946 "./web2c.y"
+ { my_output ("%"); }
+ break;
+
+ case 223:
+#line 947 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 224:
+#line 948 "./web2c.y"
+ { my_output ("<"); }
+ break;
+
+ case 225:
+#line 949 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 226:
+#line 950 "./web2c.y"
+ { my_output (">"); }
+ break;
+
+ case 227:
+#line 951 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 228:
+#line 952 "./web2c.y"
+ { my_output ("<="); }
+ break;
+
+ case 229:
+#line 953 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 230:
+#line 954 "./web2c.y"
+ { my_output (">="); }
+ break;
+
+ case 231:
+#line 955 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 232:
+#line 956 "./web2c.y"
+ { my_output ("&&"); }
+ break;
+
+ case 233:
+#line 957 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 234:
+#line 958 "./web2c.y"
+ { my_output ("||"); }
+ break;
+
+ case 235:
+#line 959 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); }
+ break;
+
+ case 236:
+#line 961 "./web2c.y"
+ { my_output ("/ ((double)"); }
+ break;
+
+ case 237:
+#line 963 "./web2c.y"
+ { yyval = max (yyvsp[-3], yyvsp[0]); my_output (")"); }
+ break;
+
+ case 238:
+#line 965 "./web2c.y"
+ { yyval = yyvsp[0]; }
+ break;
+
+ case 240:
+#line 971 "./web2c.y"
+ { my_output ("- (integer)"); }
+ break;
+
+ case 241:
+#line 973 "./web2c.y"
+ { my_output ("!"); }
+ break;
+
+ case 242:
+#line 978 "./web2c.y"
+ { my_output ("("); }
+ break;
+
+ case 243:
+#line 980 "./web2c.y"
+ { my_output (")"); yyval = yyvsp[-3]; }
+ break;
+
+ case 246:
+#line 984 "./web2c.y"
+ { my_output (last_id); my_output ("()"); }
+ break;
+
+ case 247:
+#line 986 "./web2c.y"
+ { my_output (last_id); }
+ break;
+
+ case 249:
+#line 991 "./web2c.y"
+ { my_output ("("); }
+ break;
+
+ case 250:
+#line 992 "./web2c.y"
+ { my_output (")"); }
+ break;
+
+ case 252:
+#line 997 "./web2c.y"
+ { my_output (","); }
+ break;
+
+ case 255:
+#line 1004 "./web2c.y"
+ { my_output (last_id); }
+ break;
+
+ case 258:
+#line 1013 "./web2c.y"
+ { my_output (last_id); my_output ("()"); }
+ break;
+
+ case 259:
+#line 1015 "./web2c.y"
+ { my_output (last_id);
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = proc_id_tok;
+ my_output ("()");
+ }
+ break;
+
+ case 260:
+#line 1021 "./web2c.y"
+ { my_output (last_id); }
+ break;
+
+ case 262:
+#line 1026 "./web2c.y"
+ {if (doreturn(temp)) {
+ if (strcmp(fn_return_type,"void"))
+ my_output ("return Result");
+ else
+ my_output ("return");
+ } else {
+ sprintf(safe_string, "goto lab%s",
+ temp);
+ my_output (safe_string);
+ }
+ }
+ break;
+
+ case 271:
+#line 1056 "./web2c.y"
+ { my_output ("if"); my_output ("("); }
+ break;
+
+ case 272:
+#line 1058 "./web2c.y"
+ { my_output (")"); new_line (); }
+ break;
+
+ case 274:
+#line 1063 "./web2c.y"
+ { my_output ("else"); }
+ break;
+
+ case 276:
+#line 1068 "./web2c.y"
+ { my_output ("switch"); my_output ("("); }
+ break;
+
+ case 277:
+#line 1070 "./web2c.y"
+ { my_output (")"); new_line();
+ my_output ("{"); indent++;
+ }
+ break;
+
+ case 278:
+#line 1074 "./web2c.y"
+ { indent--; my_output ("}"); new_line(); }
+ break;
+
+ case 281:
+#line 1082 "./web2c.y"
+ { my_output ("break"); semicolon(); }
+ break;
+
+ case 284:
+#line 1090 "./web2c.y"
+ { my_output ("case");
+ my_output (temp);
+ my_output (":"); new_line();
+ }
+ break;
+
+ case 285:
+#line 1095 "./web2c.y"
+ { my_output ("default:"); new_line(); }
+ break;
+
+ case 291:
+#line 1108 "./web2c.y"
+ { my_output ("while");
+ my_output ("(");
+ }
+ break;
+
+ case 292:
+#line 1112 "./web2c.y"
+ { my_output (")"); }
+ break;
+
+ case 294:
+#line 1117 "./web2c.y"
+ { my_output ("do"); my_output ("{"); indent++; }
+ break;
+
+ case 295:
+#line 1119 "./web2c.y"
+ { indent--; my_output ("}");
+ my_output ("while"); my_output ("( ! (");
+ }
+ break;
+
+ case 296:
+#line 1123 "./web2c.y"
+ { my_output (") )"); }
+ break;
+
+ case 297:
+#line 1127 "./web2c.y"
+ {
+ my_output ("{");
+ my_output ("register");
+ my_output ("integer");
+ if (strict_for)
+ my_output ("for_begin,");
+ my_output ("for_end;");
+ }
+ break;
+
+ case 298:
+#line 1136 "./web2c.y"
+ { if (strict_for)
+ my_output ("for_begin");
+ else
+ my_output (control_var);
+ my_output ("="); }
+ break;
+
+ case 299:
+#line 1142 "./web2c.y"
+ { my_output ("; if (");
+ if (strict_for) my_output ("for_begin");
+ else my_output (control_var);
+ my_output (relation);
+ my_output ("for_end)");
+ if (strict_for) {
+ my_output ("{");
+ my_output (control_var);
+ my_output ("=");
+ my_output ("for_begin");
+ semicolon();
+ }
+ my_output ("do");
+ indent++;
+ new_line();
+ }
+ break;
+
+ case 300:
+#line 1159 "./web2c.y"
+ {
+ char *top = strrchr (for_stack, '#');
+ indent--;
+ new_line();
+ my_output ("while");
+ my_output ("(");
+ my_output (top+1);
+ my_output (")");
+ my_output (";");
+ my_output ("}");
+ if (strict_for)
+ my_output ("}");
+ *top=0;
+ new_line();
+ }
+ break;
+
+ case 301:
+#line 1177 "./web2c.y"
+ { strcpy(control_var, last_id); }
+ break;
+
+ case 302:
+#line 1181 "./web2c.y"
+ { my_output (";"); }
+ break;
+
+ case 303:
+#line 1183 "./web2c.y"
+ {
+ strcpy(relation, "<=");
+ my_output ("for_end");
+ my_output ("="); }
+ break;
+
+ case 304:
+#line 1188 "./web2c.y"
+ {
+ sprintf(for_stack + strlen(for_stack),
+ "#%s++ < for_end", control_var);
+ }
+ break;
+
+ case 305:
+#line 1193 "./web2c.y"
+ { my_output (";"); }
+ break;
+
+ case 306:
+#line 1195 "./web2c.y"
+ {
+ strcpy(relation, ">=");
+ my_output ("for_end");
+ my_output ("="); }
+ break;
+
+ case 307:
+#line 1200 "./web2c.y"
+ {
+ sprintf(for_stack + strlen(for_stack),
+ "#%s-- > for_end", control_var);
+ }
+ break;
+
+
+ }
+
+/* Line 999 of yacc.c. */
+#line 3135 "y.tab.c"
+
+ yyvsp -= yylen;
+ yyssp -= yylen;
+
+
+ YY_STACK_PRINT (yyss, yyssp);
+
+ *++yyvsp = yyval;
+
+
+ /* Now `shift' the result of the reduction. Determine what state
+ that goes to, based on the state we popped back to and the rule
+ number reduced by. */
+
+ yyn = yyr1[yyn];
+
+ yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+ if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+ yystate = yytable[yystate];
+ else
+ yystate = yydefgoto[yyn - YYNTOKENS];
+
+ goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+ /* If not already recovering from an error, report this error. */
+ if (!yyerrstatus)
+ {
+ ++yynerrs;
+#if YYERROR_VERBOSE
+ yyn = yypact[yystate];
+
+ if (YYPACT_NINF < yyn && yyn < YYLAST)
+ {
+ YYSIZE_T yysize = 0;
+ int yytype = YYTRANSLATE (yychar);
+ char *yymsg;
+ int yyx, yycount;
+
+ yycount = 0;
+ /* Start YYX at -YYN if negative to avoid negative indexes in
+ YYCHECK. */
+ for (yyx = yyn < 0 ? -yyn : 0;
+ yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ yysize += yystrlen (yytname[yyx]) + 15, yycount++;
+ yysize += yystrlen ("syntax error, unexpected ") + 1;
+ yysize += yystrlen (yytname[yytype]);
+ yymsg = (char *) YYSTACK_ALLOC (yysize);
+ if (yymsg != 0)
+ {
+ char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
+ yyp = yystpcpy (yyp, yytname[yytype]);
+
+ if (yycount < 5)
+ {
+ yycount = 0;
+ for (yyx = yyn < 0 ? -yyn : 0;
+ yyx < (int) (sizeof (yytname) / sizeof (char *));
+ yyx++)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ {
+ const char *yyq = ! yycount ? ", expecting " : " or ";
+ yyp = yystpcpy (yyp, yyq);
+ yyp = yystpcpy (yyp, yytname[yyx]);
+ yycount++;
+ }
+ }
+ yyerror (yymsg);
+ YYSTACK_FREE (yymsg);
+ }
+ else
+ yyerror ("syntax error; also virtual memory exhausted");
+ }
+ else
+#endif /* YYERROR_VERBOSE */
+ yyerror ("syntax error");
+ }
+
+
+
+ if (yyerrstatus == 3)
+ {
+ /* If just tried and failed to reuse lookahead token after an
+ error, discard it. */
+
+ /* Return failure if at end of input. */
+ if (yychar == YYEOF)
+ {
+ /* Pop the error token. */
+ YYPOPSTACK;
+ /* Pop the rest of the stack. */
+ while (yyss < yyssp)
+ {
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
+ yydestruct (yystos[*yyssp], yyvsp);
+ YYPOPSTACK;
+ }
+ YYABORT;
+ }
+
+ YYDSYMPRINTF ("Error: discarding", yytoken, &yylval, &yylloc);
+ yydestruct (yytoken, &yylval);
+ yychar = YYEMPTY;
+
+ }
+
+ /* Else will try to reuse lookahead token after shifting the error
+ token. */
+ goto yyerrlab1;
+
+
+/*----------------------------------------------------.
+| yyerrlab1 -- error raised explicitly by an action. |
+`----------------------------------------------------*/
+yyerrlab1:
+ yyerrstatus = 3; /* Each real token shifted decrements this. */
+
+ for (;;)
+ {
+ yyn = yypact[yystate];
+ if (yyn != YYPACT_NINF)
+ {
+ yyn += YYTERROR;
+ if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+ {
+ yyn = yytable[yyn];
+ if (0 < yyn)
+ break;
+ }
+ }
+
+ /* Pop the current state because it cannot handle the error token. */
+ if (yyssp == yyss)
+ YYABORT;
+
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
+ yydestruct (yystos[yystate], yyvsp);
+ yyvsp--;
+ yystate = *--yyssp;
+
+ YY_STACK_PRINT (yyss, yyssp);
+ }
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ YYDPRINTF ((stderr, "Shifting error token, "));
+
+ *++yyvsp = yylval;
+
+
+ yystate = yyn;
+ goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here. |
+`-------------------------------------*/
+yyacceptlab:
+ yyresult = 0;
+ goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here. |
+`-----------------------------------*/
+yyabortlab:
+ yyresult = 1;
+ goto yyreturn;
+
+#ifndef yyoverflow
+/*----------------------------------------------.
+| yyoverflowlab -- parser overflow comes here. |
+`----------------------------------------------*/
+yyoverflowlab:
+ yyerror ("parser stack overflow");
+ yyresult = 2;
+ /* Fall through. */
+#endif
+
+yyreturn:
+#ifndef yyoverflow
+ if (yyss != yyssa)
+ YYSTACK_FREE (yyss);
+#endif
+ return yyresult;
+}
+
+
+#line 1205 "./web2c.y"
+
+
+static void
+compute_array_bounds P1H(void)
+{
+ long lb;
+ char tmp[200];
+
+ if (lower_sym == 0 || upper_sym == 0) {
+ yyerror ("Cannot handle variable subrange in array decl");
+ }
+ else if (lower_sym == -1) { /* lower is a constant */
+ lb = lower_bound - 1;
+ if (lb==0) lb = -1; /* Treat lower_bound==1 as if lower_bound==0 */
+ if (upper_sym == -1) /* both constants */
+ sprintf(tmp, "[%ld]", upper_bound - lb);
+ else { /* upper a symbol, lower constant */
+ if (lb < 0)
+ sprintf(tmp, "[%s + %ld]",
+ symbol(upper_sym), (-lb));
+ else
+ sprintf(tmp, "[%s - %ld]",
+ symbol(upper_sym), lb);
+ }
+ if (lower_bound < 0 || lower_bound > 1) {
+ if (*array_bounds) {
+ yyerror ("Cannot handle offset in second dimension");
+ }
+ if (lower_bound < 0) {
+ sprintf(array_offset, "+%ld", -lower_bound);
+ } else {
+ sprintf(array_offset, "-%ld", lower_bound);
+ }
+ }
+ strcat(array_bounds, tmp);
+ } else { /* lower is a symbol */
+ if (upper_sym != -1) /* both are symbols */
+ sprintf(tmp, "[%s - %s + 1]", symbol(upper_sym),
+ symbol(lower_sym));
+ else { /* upper constant, lower symbol */
+ sprintf(tmp, "[%ld - %s]", upper_bound + 1,
+ symbol(lower_sym));
+ }
+ if (*array_bounds) {
+ yyerror ("Cannot handle symbolic offset in second dimension");
+ }
+ sprintf(array_offset, "- (int)(%s)", symbol(lower_sym));
+ strcat(array_bounds, tmp);
+ }
+}
+
+
+/* Kludge around negative lower array bounds. */
+
+static void
+fixup_var_list ()
+{
+ int i, j;
+ char output_string[100], real_symbol[100];
+
+ for (i = 0; var_list[i++] == '!'; )
+ {
+ for (j = 0; (real_symbol[j++] = var_list[i++]); )
+ ;
+ if (*array_offset)
+ {
+ fprintf (out, "\n#define %s (%s %s)\n ",
+ real_symbol, next_temp, array_offset);
+ strcpy (real_symbol, next_temp);
+ /* Add the temp to the symbol table, so that change files can
+ use it later on if necessary. */
+ j = add_to_table (next_temp);
+ sym_table[j].typ = var_id_tok;
+ find_next_temp ();
+ }
+ sprintf (output_string, "%s%s%c", real_symbol, array_bounds,
+ var_list[i] == '!' ? ',' : ' ');
+ my_output (output_string);
+ }
+ semicolon ();
+}
+
+
+/* If we're not processing TeX, we return false. Otherwise,
+ return true if the label is "10" and we're not in one of four TeX
+ routines where the line labeled "10" isn't the end of the routine.
+ Otherwise, return 0. */
+
+static boolean
+doreturn P1C(string, label)
+{
+ return
+ tex
+ && STREQ (label, "10")
+ && !STREQ (my_routine, "macrocall")
+ && !STREQ (my_routine, "hpack")
+ && !STREQ (my_routine, "vpackage")
+ && !STREQ (my_routine, "trybreak");
+}
+
+
+/* Return the absolute value of a long. */
+static long
+my_labs P1C(long, x)
+{
+ if (x < 0L) return(-x);
+ return(x);
+}
+
+
+/* Output current function declaration to coerce file. */
+
+static void
+do_proc_args P1H(void)
+{
+ /* If we want ANSI code and one of the parameters is a var
+ parameter, then use the #define to add the &. We do this by
+ adding a 'z' at the front of the name. gen_function_head will do
+ the real work. */
+ int i;
+ int var = 0;
+ for (i = 0; i < ids_paramed; ++i)
+ var += sym_table[param_id_list[i]].var_formal;
+ if (var) {
+ for (i = strlen (z_id); i >= 0; --i)
+ z_id[i+1] = z_id[i];
+ z_id[0] = 'z';
+ }
+
+ /* We can't use our P?H macros here, since there might be an arbitrary
+ number of function arguments. */
+ fprintf (coerce, "%s %s AA((", fn_return_type, z_id);
+ if (ids_paramed == 0) fprintf (coerce, "void");
+ for (i = 0; i < ids_paramed; i++) {
+ if (i > 0)
+ putc (',', coerce);
+ fprintf (coerce, "%s %s", arg_type[i], symbol (param_id_list[i]));
+ }
+ fprintf (coerce, "));\n");
+}
+
+static void
+gen_function_head P1H(void)
+{
+ int i;
+
+ if (strcmp(my_routine, z_id)) {
+ fprintf(coerce, "#define %s(", my_routine);
+ for (i=0; i<ids_paramed; i++) {
+ if (i > 0)
+ fprintf(coerce, ", %s", symbol(param_id_list[i]));
+ else
+ fprintf(coerce, "%s", symbol(param_id_list[i]));
+ }
+ fprintf(coerce, ") %s(", z_id);
+ for (i=0; i<ids_paramed; i++) {
+ if (i > 0)
+ fputs(", ", coerce);
+ fprintf(coerce, "(%s) ", arg_type[i]);
+ fprintf(coerce, "%s(%s)",
+ sym_table[param_id_list[i]].var_formal?"&":"",
+ symbol(param_id_list[i]));
+ }
+ fprintf(coerce, ")\n");
+ }
+ out = orig_out;
+ new_line ();
+ /* We can't use our P?C macros here, since there might be an arbitrary
+ number of function arguments. We have to include the #ifdef in the
+ generated code, or we'd generate different code with and without
+ prototypes, which might cause splitup to create different numbers
+ of files in each case. */
+ fputs ("#ifdef HAVE_PROTOTYPES\n", out);
+ my_output (z_id);
+ my_output ("(");
+ if (ids_paramed == 0) my_output ("void");
+ for (i=0; i<ids_paramed; i++) {
+ if (i > 0) my_output (",");
+ my_output (arg_type[i]);
+ my_output (symbol (param_id_list[i]));
+ }
+ my_output (")");
+ new_line ();
+ fputs ("#else\n", out);
+ my_output (z_id);
+ my_output ("(");
+ for (i=0; i<ids_paramed; i++) {
+ if (i > 0) my_output (",");
+ my_output (symbol (param_id_list[i]));
+ }
+ my_output (")");
+ new_line ();
+ indent++;
+ for (i=0; i<ids_paramed; i++) {
+ my_output (arg_type[i]);
+ my_output (symbol(param_id_list[i]));
+ semicolon ();
+ }
+ indent--;
+ fputs ("#endif\n", out);
+}
+
diff --git a/Build/source/texk/web2c/web2c/y_tab.h-dist b/Build/source/texk/web2c/web2c/y_tab.h-dist
new file mode 100644
index 00000000000..fc37395b142
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/y_tab.h-dist
@@ -0,0 +1,160 @@
+/* A Bison parser, made by GNU Bison 1.875a. */
+
+/* Skeleton parser for Yacc-like parsing with Bison,
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+/* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ array_tok = 258,
+ begin_tok = 259,
+ case_tok = 260,
+ const_tok = 261,
+ do_tok = 262,
+ downto_tok = 263,
+ else_tok = 264,
+ end_tok = 265,
+ file_tok = 266,
+ for_tok = 267,
+ function_tok = 268,
+ goto_tok = 269,
+ if_tok = 270,
+ label_tok = 271,
+ of_tok = 272,
+ procedure_tok = 273,
+ program_tok = 274,
+ record_tok = 275,
+ repeat_tok = 276,
+ then_tok = 277,
+ to_tok = 278,
+ type_tok = 279,
+ until_tok = 280,
+ var_tok = 281,
+ while_tok = 282,
+ others_tok = 283,
+ r_num_tok = 284,
+ i_num_tok = 285,
+ string_literal_tok = 286,
+ single_char_tok = 287,
+ assign_tok = 288,
+ two_dots_tok = 289,
+ undef_id_tok = 290,
+ var_id_tok = 291,
+ proc_id_tok = 292,
+ proc_param_tok = 293,
+ fun_id_tok = 294,
+ fun_param_tok = 295,
+ const_id_tok = 296,
+ type_id_tok = 297,
+ hhb0_tok = 298,
+ hhb1_tok = 299,
+ field_id_tok = 300,
+ define_tok = 301,
+ field_tok = 302,
+ break_tok = 303,
+ great_eq_tok = 304,
+ less_eq_tok = 305,
+ not_eq_tok = 306,
+ or_tok = 307,
+ unary_minus_tok = 308,
+ unary_plus_tok = 309,
+ and_tok = 310,
+ mod_tok = 311,
+ div_tok = 312,
+ not_tok = 313
+ };
+#endif
+#define array_tok 258
+#define begin_tok 259
+#define case_tok 260
+#define const_tok 261
+#define do_tok 262
+#define downto_tok 263
+#define else_tok 264
+#define end_tok 265
+#define file_tok 266
+#define for_tok 267
+#define function_tok 268
+#define goto_tok 269
+#define if_tok 270
+#define label_tok 271
+#define of_tok 272
+#define procedure_tok 273
+#define program_tok 274
+#define record_tok 275
+#define repeat_tok 276
+#define then_tok 277
+#define to_tok 278
+#define type_tok 279
+#define until_tok 280
+#define var_tok 281
+#define while_tok 282
+#define others_tok 283
+#define r_num_tok 284
+#define i_num_tok 285
+#define string_literal_tok 286
+#define single_char_tok 287
+#define assign_tok 288
+#define two_dots_tok 289
+#define undef_id_tok 290
+#define var_id_tok 291
+#define proc_id_tok 292
+#define proc_param_tok 293
+#define fun_id_tok 294
+#define fun_param_tok 295
+#define const_id_tok 296
+#define type_id_tok 297
+#define hhb0_tok 298
+#define hhb1_tok 299
+#define field_id_tok 300
+#define define_tok 301
+#define field_tok 302
+#define break_tok 303
+#define great_eq_tok 304
+#define less_eq_tok 305
+#define not_eq_tok 306
+#define or_tok 307
+#define unary_minus_tok 308
+#define unary_plus_tok 309
+#define and_tok 310
+#define mod_tok 311
+#define div_tok 312
+#define not_tok 313
+
+
+
+
+#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
+typedef int YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+extern YYSTYPE yylval;
+
+
+
diff --git a/Build/source/texk/web2c/win32.mak b/Build/source/texk/web2c/win32.mak
new file mode 100644
index 00000000000..23faf10db6c
--- /dev/null
+++ b/Build/source/texk/web2c/win32.mak
@@ -0,0 +1,1259 @@
+################################################################################
+#
+# Makefile : Web2C
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <04/03/20 16:25:18 popineau>
+#
+################################################################################
+
+# Makefile for web2c --kb@mail.tug.org. Public domain.
+version = 7.5.1
+
+# These lines define the memory dumps that fmts/bases/mems will make and
+# install-fmts/install-bases/install-mems will install. plain.* is
+# created automatically (as a link). See the Formats node in
+# doc/web2c.texi for details on the fmts.
+#FMU fmts = olatex.fmt # amstex.fmt eplain.fmt texinfo.fmt
+#FMU efmts = latex.efmt
+#FMU pdffmts = pdfolatex.fmt
+#FMU pdfefmts = pdflatex.efmt
+#FMU pdfxfmts = pdflatex.xfmt
+#FMU ofmts = lambda.oft
+#FMU eofmts = elambda.eoft
+#FMU bases = # I do not recommend building cmmf.base.
+#FMU mems = # mfplain.mem is probably not generally useful.
+
+# The name of the file that defines your local devices for Metafont.
+# (Only relevant during `make bases'.) I recommend `modes.mf', which
+# defines all known modes, plus useful definitions for all fonts. It's
+# available from ftp://ftp.tug.org/tex/modes.mf, among other places.
+localmodes = modes
+
+# Used for triptrap.
+DIFF = diff
+DIFFFLAGS =
+
+root_srcdir=..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+USE_KPATHSEA = 1
+USE_GETURL = 1
+USE_GNUW32 = 1
+USE_ZLIB = 1
+USE_PNG=1
+USE_JPEG = 1
+USE_XPDF = 1
+USE_TEX = 1
+MAKE_TEX = 1
+
+!include <msvc/common.mak>
+
+# omegaversion = -1.15
+!ifdef omegaversion
+DEFS = $(DEFS) -DOLD_OMEGA
+!endif
+
+# Compilation options.
+DEFS = -I. $(DEFS) -DHAVE_CONFIG_H -DOEM -DJOBTIME -DTIME_STATS \
+ -DOUTPUT_DIR -DHALT_ON_ERROR
+
+!ifdef TEX_DLL
+DEFS = $(DEFS) -DMAKE_TEX_DLL
+!endif
+
+# With --enable-ipc, TeX may need to link with -lsocket.
+socketlibs = delayimp.lib /delayload:wsock32.dll # @socketlibs@
+
+proglib = lib\$(objdir)\lib.lib
+windowlib = window\$(objdir)\window.lib
+pdflib = pdftexdir\$(objdir)\libpdf.lib
+pdftexlibs = $(pdflib) $(pnglib) $(zliblib) $(xpdflib)
+pdftexlibsdep = $(pdflib) $(png) $(zlib) $(xpdf)
+
+# The .bat script that does the conversion:
+web2c = web2c\convert.bat $(objdir)
+# Additional dependencies:
+web2c_common = web2c\convert.bat web2c\common.defines
+web2c_programs = web2c\$(objdir)\fixwrites.exe \
+# $(msvcdir)\splitup.pl \
+# web2c\$(objdir)\splitup.exe \
+ web2c\$(objdir)\web2c.exe
+web2c_texmf = $(web2c_common) $(web2c_programs) web2c\texmf.defines web2c\coerce.h
+
+# Calling tangle
+# tangle = WEBINPUTS=$(srcdir) ./tangle
+tangle = $(objdir)\tangle.exe
+
+# The environment for making dumps.
+# dumpenv = TEXMFCNF=../kpathsea TEXMF=$(texmf)
+
+# Unfortunately, suffix rules can't have dependencies, or multiple
+# targets, and we can't assume all makes supports pattern rules.
+.SUFFIXES: .p .c .ch .p .res .rc
+.p.c: # really depends on $(web2c_programs), and generates .h.
+ $(web2c) $*
+.ch.p: # really depends on ./tangle; for mf/mp/tex, also generates .pool
+ .\$(objdir)\tangle $*.web $<
+
+# Prevent Make from deleting the intermediate forms.
+.PRECIOUS: %.ch %.p %.c
+
+mf = $(objdir)\mf.exe
+mfn = $(objdir)\mf-nowin.exe
+mpost = $(objdir)\mpost.exe
+tex = $(objdir)\tex.exe
+!ifdef TEX_DLL
+mf = $(mf) $(objdir)\$(library_prefix)mf.dll
+mfn = $(mfn) $(objdir)\$(library_prefix)mf-nowin.dll
+mpost = $(mpost) $(objdir)\$(library_prefix)mpost.dll
+tex = $(tex) $(objdir)\$(library_prefix)tex.dll
+!endif
+
+mpware = mpware\$(objdir)\dmp.exe ..\contrib\$(objdir)\makempx.exe mpware\$(objdir)\mpto.exe mpware\$(objdir)\newer.exe
+mpware_sources = mpware\dmp.c ..\contrib\makempx.c mpware\mpto.c mpware\newer.c
+
+#
+default all: programs manpages doc\web2c.info #FMU dumps
+check: dumps
+
+$(objdir)\bibtex.exe: $(objdir)\bibtex.obj $(objdir)\bibtex.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+bibtex.c bibtex.h: $(web2c_common) $(web2c_programs) web2c\cvtbib.sed bibtex.p
+ $(web2c) bibtex
+bibtex.p: $(tangle) bibtex.web bibtex.ch
+ $(tangle) bibtex bibtex
+check: bibtex-check
+bibtex-check: $(objdir)\bibtex.exe
+# if not exist tests\exampl.aux $(copy) $(srcdir)\tests\exampl.aux tests\exampl.aux
+ @set BSTINPUTS=$(srcdir)\tests
+ @set TEXMFCNF=..\kpathsea\texmf.cnf
+ .\$(objdir)\bibtex tests\exampl
+ @set TEXMFCNF=
+ @set BSTINPUTS=
+clean:: bibtex-clean
+bibtex-clean:
+# $(LIBTOOL) --mode=clean $(del) bibtex
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\bibtex.obj bibtex.c bibtex.h bibtex.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\exampl.blg tests\exampl.bbl $(redir_stderr)
+
+$(objdir)\cweave.exe: $(objdir)\cweave.obj $(objdir)\cweb.obj
+ $(link) $(**) $(conlibs)
+cweave.c: $(objdir)\ctangle.exe cwebdir\cweave.w cwebdir\cweav-w2c.ch
+ @set CWEBINPUTS=$(srcdir)\cwebdir
+ .\$(objdir)\ctangle cweave cweav-w2c
+ @set CWEBINPUTS=
+check: cweave-check
+cweave-check: $(objdir)\cweave.exe
+ @set CWEBINPUTS=$(srcdir)\cwebdir
+ .\$(objdir)\cweave common.w
+ @set CWEBINPUTS=
+clean:: cweave-clean
+cweave-clean:
+# $(LIBTOOL) --mode=clean $(del) cweave
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\cweave.obj cweave.c) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) common.tex common.scn common.idx $(redir_stderr)
+
+$(objdir)\dvicopy.exe: $(objdir)\dvicopy.obj $(objdir)\dvicopy.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+dvicopy.c dvicopy.h: $(web2c_common) $(web2c_programs) dvicopy.p
+ $(web2c) dvicopy
+dvicopy.p: $(tangle) dvicopy.web dvicopy.ch
+ $(tangle) dvicopy dvicopy
+check: dvicopy-check
+dvicopy-check: $(objdir)\dvicopy.exe
+ .\$(objdir)\dvicopy $(srcdir)\tests\story tests\xstory.dvi
+# Redirect stderr so the terminal output will end up in the log file.
+ @set TFMFONTS=$(srcdir)\tests
+ @set VFFONTS=$(srcdir)\tests
+ .\$(objdir)\dvicopy < $(srcdir)\tests\pplr.dvi > tests\xpplr.dvi
+ @set VFFONTS=
+ @set TFMFONTS=
+clean:: dvicopy-clean
+dvicopy-clean:
+# $(LIBTOOL) --mode=clean $(del) dvicopy
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\dvicopy.obj dvicopy.c dvicopy.h dvicopy.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xstory.dvi tests\xpplr.dvi $(redir_stderr)
+
+$(objdir)\dvitomp.exe: $(objdir)\dvitomp.obj $(objdir)\dvitomp.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+dvitomp.c dvitomp.h: $(web2c_common) $(web2c_programs) dvitomp.p
+ $(web2c) dvitomp
+dvitomp.p: $(tangle) dvitomp.web dvitomp.ch
+ $(tangle) dvitomp dvitomp
+check: dvitomp-check
+dvitomp-check: $(objdir)\dvitomp.exe
+ @set TFMFONTS=$(srcdir)\tests
+ @set VFFONTS=$(srcdir)\tests
+ .\$(objdir)\dvitomp $(srcdir)\tests\story.dvi tests\xstory.mpx
+ .\$(objdir)\dvitomp $(srcdir)\tests\ptmr
+ $(move) ptmr.mpx tests\xptmr.mpx
+ @set TFMFONTS=
+ @set VFFONTS=
+clean:: dvitomp-clean
+dvitomp-clean:
+# $(LIBTOOL) --mode=clean $(del) dvitomp
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\dvitomp.obj dvitomp.c dvitomp.h dvitomp.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xstory.mpx tests\xptmr.mpx $(redir_stderr)
+
+$(objdir)\dvitype.exe: $(objdir)\dvitype.obj $(objdir)\dvitype.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+dvitype.c dvitype.h: $(web2c_common) $(web2c_programs) dvitype.p
+ $(web2c) dvitype
+dvitype.p: $(tangle) dvitype.web dvitype.ch
+ $(tangle) dvitype dvitype
+check: dvitype-check
+dvitype-check: $(objdir)\dvitype.exe
+ .\$(objdir)\dvitype -show-opcodes $(srcdir)\tests\story >tests\xstory.dvityp
+ .\$(objdir)\dvitype -p=*.*.2 $(srcdir)\tests\pagenum.dvi >tests\xpagenum.typ
+clean:: dvitype-clean
+dvitype-clean:
+# $(LIBTOOL) --mode=clean $(del) dvitype
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\dvitype.obj dvitype.c dvitype.h dvitype.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xstory.dvityp tests\xpagenum.typ $(redir_stderr)
+
+$(objdir)\gftodvi.exe: $(objdir)\gftodvi.obj $(objdir)\gftodvi.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+gftodvi.c gftodvi.h: $(web2c_common) $(web2c_programs) gftodvi.p
+ $(web2c) gftodvi
+gftodvi.p: $(tangle) gftodvi.web gftodvi.ch
+ $(tangle) gftodvi gftodvi
+check: gftodvi-check
+gftodvi-check: $(objdir)\gftodvi.exe
+ set TFMFONTS=$(srcdir)\tests
+ .\$(objdir)\gftodvi -verbose $(srcdir)\tests\cmr10.600gf
+ $(move) cmr10.dvi tests\xcmr10.dvi
+clean:: gftodvi-clean
+gftodvi-clean:
+# $(LIBTOOL) --mode=clean $(del) gftodvi
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\gftodvi.obj gftodvi.c gftodvi.h gftodvi.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xcmr10.dvi $(redir_stderr)
+
+$(objdir)\gftopk.exe: $(objdir)\gftopk.obj $(objdir)\gftopk.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+gftopk.c gftopk.h: $(web2c_common) $(web2c_programs) gftopk.p
+ $(web2c) gftopk
+gftopk.p: $(tangle) gftopk.web gftopk.ch
+ $(tangle) gftopk gftopk
+check: gftopk-check
+gftopk-check: $(objdir)\gftopk.exe
+ .\$(objdir)\gftopk -verbose $(srcdir)\tests\cmr10.600gf tests\xcmr10.pk
+ .\$(objdir)\gftopk $(srcdir)\tests\cmr10.600gf cmr10.pk & $(del) cmr10.pk
+clean:: gftopk-clean
+gftopk-clean:
+# $(LIBTOOL) --mode=clean $(del) gftopk
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\gftopk.obj gftopk.c gftopk.h gftopk.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xcmr10.pk $(redir_stderr)
+
+$(objdir)\gftype.exe: $(objdir)\gftype.obj $(objdir)\gftype.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+gftype.c gftype.h: $(web2c_common) $(web2c_programs) gftype.p
+ $(web2c) gftype
+gftype.p: $(tangle) gftype.web gftype.ch
+ $(tangle) gftype gftype
+check: gftype-check
+gftype-check: $(objdir)\gftype.exe
+ .\$(objdir)\gftype $(srcdir)\tests\cmr10.600gf >tests\xcmr10.gft1
+ .\$(objdir)\gftype -m -i $(srcdir)\tests\cmr10.600gf >tests\xcmr10.gft2
+clean:: gftype-clean
+gftype-clean:
+# $(LIBTOOL) --mode=clean $(del) gftype
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\gftype.obj gftype.c gftype.h gftype.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xcmr10.gft1 tests\xcmr10.gft2 $(redir_stderr)
+
+$(objdir)\mft.exe: $(objdir)\mft.obj $(objdir)\mft.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+mft.c mft.h: $(web2c_common) $(web2c_programs) mft.p
+ $(web2c) mft
+mft.p: $(tangle) mft.web mft.ch
+ $(tangle) mft mft
+check: mft-check
+mft-check: $(objdir)\mft.exe
+ .\$(objdir)\mft $(srcdir)\tests\io & $(move) io.tex tests\io.tex
+clean:: mft-clean
+mft-clean:
+# $(LIBTOOL) --mode=clean $(del) mft
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\mft.obj mft.c mft.h mft.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\io.tex $(redir_stderr)
+
+$(objdir)\patgen.exe: $(objdir)\patgen.obj $(objdir)\patgen.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+patgen.c patgen.h: $(web2c_common) $(web2c_programs) patgen.p
+ $(web2c) patgen
+patgen.p: $(tangle) patgen.web patgen.ch
+ $(tangle) patgen patgen
+check: patgen-check
+patgen-check: $(objdir)\patgen.exe
+ .\$(objdir)\patgen $(srcdir)\tests\dict $(srcdir)\tests\patterns tests\xout \
+ $(srcdir)\tests\translate <$(srcdir)\tests\patgen.in
+clean:: patgen-clean
+patgen-clean:
+# $(LIBTOOL) --mode=clean $(del) patgen
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\patgen.obj patgen.c patgen.h patgen.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xout pattmp.1 $(redir_stderr)
+
+$(objdir)\pktogf.exe: $(objdir)\pktogf.obj $(objdir)\pktogf.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+pktogf.c pktogf.h: $(web2c_common) $(web2c_programs) pktogf.p
+ $(web2c) pktogf
+pktogf.p: $(tangle) pktogf.web pktogf.ch
+ $(tangle) pktogf pktogf
+check: pktogf-check
+pktogf-check: $(objdir)\pktogf.exe
+ .\$(objdir)\pktogf -verbose $(srcdir)\tests\cmr10.pk tests\xcmr10.600gf
+ .\$(objdir)\pktogf $(srcdir)\tests\cmr10.pk & rm cmr10.gf
+clean:: pktogf-clean
+pktogf-clean:
+# $(LIBTOOL) --mode=clean $(del) pktogf
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\pktogf.obj pktogf.c pktogf.h pktogf.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xcmr10.600gf $(redir_stderr)
+
+$(objdir)\pktype.exe: $(objdir)\pktype.obj $(objdir)\pktype.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+pktype.c pktype.h: $(web2c_common) $(web2c_programs) pktype.p
+ $(web2c) pktype
+pktype.p: $(tangle) pktype.web pktype.ch
+ $(tangle) pktype pktype
+check: pktype-check
+pktype-check: $(objdir)\pktype.exe
+ .\$(objdir)\pktype $(srcdir)\tests\cmr10.pk >tests\xcmr10.pktyp
+clean:: pktype-clean
+pktype-clean:
+# $(LIBTOOL) --mode=clean $(del) pktype
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\pktype.obj pktype.c pktype.h pktype.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xcmr10.pktyp $(redir_stderr)
+
+$(objdir)\pltotf.exe: $(objdir)\pltotf.obj $(objdir)\pltotf.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+pltotf.c pltotf.h: $(web2c_common) $(web2c_programs) pltotf.p
+ $(web2c) pltotf
+pltotf.p: $(tangle) pltotf.web pltotf.ch
+ $(tangle) pltotf pltotf
+check: pltotf-check
+pltotf-check: $(objdir)\pltotf.exe
+ .\$(objdir)\pltotf -verbose $(srcdir)\tests\cmr10 tests\xcmr10
+clean:: pltotf-clean
+pltotf-clean:
+# $(LIBTOOL) --mode=clean $(del) pltotf
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\pltotf.obj pltotf.c pltotf.h pltotf.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xcmr10.tfm $(redir_stderr)
+
+$(objdir)\pooltype.exe: $(objdir)\pooltype.obj $(objdir)\pooltype.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+pooltype.c pooltype.h: $(web2c_common) $(web2c_programs) pooltype.p
+ $(web2c) pooltype
+pooltype.p: $(tangle) pooltype.web pooltype.ch
+ $(tangle) pooltype pooltype
+check: pooltype-check
+pooltype-check: tex.pool
+pooltype-check: $(objdir)\pooltype.exe
+ .\$(objdir)\pooltype tex.pool >tests\xtexpool.typ
+clean:: pooltype-clean
+pooltype-clean:
+# $(LIBTOOL) --mode=clean $(del) pooltype
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\pooltype.obj pooltype.c pooltype.h pooltype.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xtexpool.typ $(redir_stderr)
+
+$(objdir)\tie.exe: $(objdir)\tie.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+tie.c: $(objdir)\ctangle.exe tiedir\tie.w tiedir\tie-w2c.ch
+ @set CWEBINPUTS=$(srcdir)\tiedir
+ .\$(objdir)\ctangle tie.w tie-w2c.ch
+ @set CWEBINPUTS=
+clean:: tie-clean
+tie-clean:
+# $(LIBTOOL) --mode=clean $(del) tie
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\tie.obj tie.c) do $(del) %%i $(redir_stderr) \
+ )
+
+$(objdir)\tftopl.exe: $(objdir)\tftopl.obj $(objdir)\tftopl.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+tftopl.c tftopl.h: $(web2c_common) $(web2c_programs) tftopl.p
+ $(web2c) tftopl
+tftopl.p: $(tangle) tftopl.web tftopl.ch
+ $(tangle) tftopl tftopl
+check: tftopl-check
+tftopl-check: $(objdir)\tftopl.exe
+ .\$(objdir)\tftopl -verbose $(srcdir)\tests\cmr10 tests\xcmr10
+clean:: tftopl-clean
+tftopl-clean:
+# $(LIBTOOL) --mode=clean $(del) tftopl
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\tftopl.obj tftopl.c tftopl.h tftopl.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xcmr10.pl $(redir_stderr)
+
+$(objdir)\vftovp.exe: $(objdir)\vftovp.obj $(objdir)\vftovp.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+vftovp.c vftovp.h: $(web2c_common) $(web2c_programs) vftovp.p
+ $(web2c) vftovp
+vftovp.p: $(tangle) vftovp.web vftovp.ch
+ $(tangle) vftovp vftovp
+check: vftovp-check
+vftovp-check: $(objdir)\vftovp.exe
+ @set TFMFONTS=$(srcdir)\tests
+ .\$(objdir)\vftovp -verbose $(srcdir)\tests\ptmr ptmr tests\xptmr
+ @set TFMFONTS=
+clean:: vftovp-clean
+vftovp-clean:
+# $(LIBTOOL) --mode=clean $(del) vftovp
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\vftop.obj vftovp.c vftovp.h vftovp.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xptmr.vpl $(redir_stderr)
+
+$(objdir)\vptovf.exe: $(objdir)\vptovf.obj $(objdir)\vptovf.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+vptovf.c vptovf.h: $(web2c_common) $(web2c_programs) vptovf.p
+ $(web2c) vptovf
+vptovf.p: $(tangle) vptovf.web vptovf.ch
+ $(tangle) vptovf vptovf
+check: vptovf-check
+vptovf-check: $(objdir)\vptovf.exe
+ .\$(objdir)\vptovf $(srcdir)\tests\ptmr tests\xptmr tests\xptmr
+clean:: vptovf-clean
+vptovf-clean:
+# $(LIBTOOL) --mode=clean $(del) vptovf
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\vptovf.obj vptovf.c vptovf.h vptovf.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) tests\xptmr.vf tests\xptmr.tfm $(redir_stderr)
+
+$(objdir)\weave.exe: $(objdir)\weave.obj $(objdir)\weave.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+weave.c weave.h: $(web2c_common) $(web2c_programs) weave.p
+ $(web2c) weave
+weave.p: $(tangle) weave.web weave.ch
+ $(tangle) weave weave
+check: weave-check
+weave-check: $(objdir)\weave.exe
+ .\$(objdir)\weave $(srcdir)\pooltype
+clean:: weave-clean
+weave-clean:
+# $(LIBTOOL) --mode=clean $(del) weave
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\weave.obj weave.c weave.h weave.p) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(del) pooltype.tex $(redir_stderr)
+
+#
+# Defines that are common to the texmf programs.
+
+trip = trip
+etrip = etrip
+triptrap: $(trip) trap mptrap $(etrip)
+testdir = $(srcdir)\triptrap
+testenv = TEXMFCNF=$(testdir)
+dvitype_args = -output-level=2 -dpi=72.27 -page-start="*.*.*.*.*.*.*.*.*.*"
+
+#
+# Metafont
+mf_c = mf.c
+mf_o = $(objdir)\mf.obj
+mfn_o = $(objdir)\mfnowin.obj
+!ifdef TEX_DLL
+$(objdir)\$(library_prefix)mf.exp: $(objdir)\$(library_prefix)mf.lib
+
+$(objdir)\$(library_prefix)mf.lib: $(mf_o)
+ $(archive) /DEF $(mf_o)
+
+$(objdir)\$(library_prefix)mf.dll: $(mf_o) $(objdir)\$(library_prefix)mf.exp $(objdir)\mf.res $(windowlib) $(kpathsealib) $(proglib)
+ $(link_dll) $(**) gdi32.lib $(conlibs)
+
+$(objdir)\mf.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)mf.lib $(proglib)
+ $(link) $(**) $(conlibs)
+!else
+$(objdir)\mf.exe: $(mf_o) $(objdir)\win32main.obj $(windowlib) $(objdir)\mf.res $(kpathsealib) $(proglib)
+ $(link) $(**) gdi32.lib $(conlibs)
+!endif
+
+!ifdef TEX_DLL
+$(objdir)\$(library_prefix)mf-nowin.exp: $(objdir)\$(library_prefix)mf-nowin.lib
+
+$(objdir)\$(library_prefix)mf-nowin.lib: $(mf_o)
+ $(archive) /DEF $(mf_o)
+
+$(objdir)\$(library_prefix)mf-nowin.dll: $(mfn_o) window\$(objdir)\trap.obj $(objdir)\$(library_prefix)mf-nowin.exp $(objdir)\mf.res $(kpathsealib) $(proglib)
+ $(link_dll) $(**) gdi32.lib $(conlibs)
+
+$(objdir)\mf-nowin.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)mf-nowin.lib $(proglib)
+ $(link) $(**) $(conlibs)
+!else
+$(objdir)\mf-nowin.exe: $(mfn_o) window\$(objdir)\trap.obj $(objdir)\win32main.obj $(objdir)\mf.res $(kpathsealib) $(proglib)
+ $(link) $(**) gdi32.lib $(conlibs)
+!endif
+
+$(objdir)\mfnowin.obj: mf.c
+ $(compile) -DMFNOWIN mf.c
+$(mf_c) mfcoerce.h mfd.h: mf.p $(web2c_texmf) web2c\cvtmf1.sed web2c\cvtmf2.sed
+ $(web2c) mf
+mf.p mf.pool: $(tangle) mf.web mf-w32.ch
+ $(tangle) mf.web mf-w32.ch
+mf-w32.ch: $(objdir)\tie.exe mf.ch mf-supp-w32.ch
+ $(objdir)\tie.exe -c mf-w32.ch mf.web mf.ch mf-supp-w32.ch
+check: mf-check
+mf-check: trap mf.base
+ .\$(objdir)\mf --progname=mf "&./mf \tracingstats:=1; end."
+ .\$(objdir)\mf --progname=mf "&./mf $(srcdir)\tests\online"
+ .\$(objdir)\mf --progname=mf "&./mf $(srcdir)\tests\one.two"
+ .\$(objdir)\mf --progname=mf "&./mf $(srcdir)\tests\uno.dos"
+clean:: mf-clean
+mf-clean: trap-clean
+ -@echo $(verbose) & ( \
+ for %%i in ($(mf_c) mfcoerce.h mfd.h mf.p mf.pool \
+ $(mfw_o) mfextra.c $(mfn_o) mfnowin.c \
+ mf.base mf.log mfput.log online.2602gf \
+ online.log one.two.log uno.log) do $(del) %%i $(redir_stderr) \
+ )
+# $(LIBTOOL) --mode=clean $(del) mf
+# $(LIBTOOL) --mode=clean $(del) mfw
+# $(LIBTOOL) --mode=clean $(del) mf-nowin
+
+# Can't run trap and mptrap in parallel, because both write trap.{log,tfm}.
+trap: mf tftopl gftype trap-clean
+trap: $(objdir)\mf.exe $(objdir)\tftopl.exe $(objdir)\gftype.exe
+ @echo ">>> See $(testdir)\mftrap.diffs for example of acceptable diffs."
+ set TEXMFCNFOLD=$(TEXMFCNF)
+ set TEXMFCNF=$(testdir)
+# get same filename in log
+ -@$(del) trap.mf & $(copy) $(testdir)\trap.mf . $(redir_stderr)
+ -.\$(objdir)\mf -progname=inimf < $(testdir)\mftrap1.in > mftrapin.fot
+ $(move) trap.log mftrapin.log
+ -$(diff) $(testdir)\mftrapin.log mftrapin.log
+ -.\$(objdir)\mf -progname=inimf <$(testdir)\mftrap2.in >mftrap.fot
+ $(move) trap.log mftrap.log
+ $(move) trap.tfm mftrap.tfm
+ -$(diff) $(testdir)\mftrap.fot mftrap.fot
+ -$(diff) $(testdir)\mftrap.log mftrap.log
+ .\$(objdir)\tftopl .\mftrap.tfm mftrap.pl
+ -$(diff) $(testdir)\mftrap.pl mftrap.pl
+ -.\$(objdir)\gftype -m -i .\trap.72270gf >trap.typ
+ -$(diff) $(testdir)\trap.typ trap.typ
+ set TEXMFCNF=$(TEXMFCNFOLD)
+
+trap-clean:
+ -@echo $(verbose) & ( \
+ for %%i in (trap.mf trap.base mftrapin.fot mftrapin.log \
+ mftrap.fot mftrap.log mftrap.tfm mftrap.pl \
+ trap.72270gf trap.typ) do $(del) %%i $(redir_stderr) \
+ )
+#
+# MetaPost
+mp_c = mp.c
+mp_o = $(objdir)\mp.obj
+!ifdef TEX_DLL
+$(objdir)\$(library_prefix)mpost.exp: $(objdir)\$(library_prefix)mpost.lib
+
+$(objdir)\$(library_prefix)mpost.lib: $(mp_o)
+ $(archive) /DEF $(mp_o)
+
+$(objdir)\$(library_prefix)mpost.dll: $(mp_o) $(objdir)\$(library_prefix)mpost.lib $(objdir)\$(library_prefix)mpost.exp $(objdir)\mpost.res $(kpathsealib) $(proglib)
+ $(link_dll) $(**) $(conlibs)
+
+$(objdir)\mpost.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)mpost.lib $(proglib)
+ $(link) $(**) $(conlibs)
+!else
+$(objdir)\mpost.exe: $(mp_o) $(objdir)\win32main.obj $(objdir)\mpost.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+!endif
+$(mp_c) mpcoerce.h mpd.h: mp.p $(web2c_texmf) web2c\cvtmf1.sed web2c\cvtmf2.sed
+ $(web2c) mp
+mp.p mp.pool: $(tangle) mp.web mp-w32.ch
+ $(tangle) mp.web mp-w32.ch
+mp-w32.ch: $(objdir)\tie.exe mp.ch mp-supp-w32.ch
+ $(objdir)\tie.exe -c mp-w32.ch mp.web mp.ch mp-supp-w32.ch
+check: mpost-check
+mpost-check: mptrap mpost.mem $(mpware)
+ .\$(objdir)\mpost --progname=mpost "&./mpost \tracingstats:=1 ; end."
+ set MAKEMPX_BINDIR=.;..\contrib\$(objdir)
+ set MPXCOMMAND=..\contrib\$(objdir)\makempx.exe
+ .\$(objdir)\mpost --progname=mpost $(srcdir)\tests\mptest
+ set MAKEMPX_BINDIR=
+ set MPXCOMMAND=
+ .\$(objdir)\mpost --progname=mpost $(srcdir)\tests\one.two
+ .\$(objdir)\mpost --progname=mpost $(srcdir)\tests\uno.dos
+clean:: mpost-clean
+mpost-clean: mptrap-clean
+ -@echo $(verbose) & ( \
+ for %%i in ($(mp_o) $(mp_c) mpextra.c mpcoerce.h mpd.h \
+ mp.p mp.pool mpost.mem mpost.log mpout.log \
+ mptest.log one.two.log uno.log) do $(del) %%i $(redir_stderr) \
+ )
+# $(LIBTOOL) --mode=clean $(del) mpost
+
+# Can't run trap and mptrap in parallel, because both write trap.{log,tfm}.
+mptrap: mpost pltotf tftopl mptrap-clean
+mptrap: $(objdir)\mpost.exe $(objdir)\pltotf.exe $(objdir)\tftopl.exe mptrap-clean
+ @echo ">>> See $(testdir)\mptrap.diffs for example of acceptable diffs." >&2
+ set TEXMFCNFOLD=$(TEXMFCNF)
+ set TEXMFCNF=$(testdir)
+# get same filename in log
+ -@$(del) mtrap.mp & $(copy) $(testdir)\mtrap.mp . $(redir_stderr)
+ .\$(objdir)\pltotf $(testdir)\trapf.pl trapf.tfm
+ -.\$(objdir)\mpost -progname=inimpost mtrap
+ -$(diff) $(testdir)\mtrap.log mtrap.log
+ -$(diff) $(testdir)\mtrap.0 mtrap.0
+ -$(diff) $(testdir)\mtrap.1 mtrap.1
+ -$(diff) $(testdir)\writeo writeo
+ -$(diff) $(testdir)\writeo.2 writeo.2
+ -@$(del) trap.mp & $(copy) $(testdir)\trap.mp . $(redir_stderr)
+ -@$(del) trap.mpx & $(copy) $(testdir)\trap.mpx . $(redir_stderr)
+ -.\$(objdir)\mpost -progname=inimpost<$(testdir)\mptrap1.in >mptrapin.fot
+ -$(move) trap.log mptrapin.log
+ -$(diff) $(testdir)\mptrapin.log mptrapin.log
+# Must run inimp or font_name[null_font] is not initialized, leading to diffs.
+ -.\$(objdir)\mpost -progname=inimpost<$(testdir)\mptrap2.in >mptrap.fot
+ -$(move) trap.log mptrap.log
+ -$(move) trap.tfm mptrap.tfm
+ -$(diff) $(testdir)\mptrap.fot mptrap.fot
+ -$(diff) $(testdir)\mptrap.log mptrap.log
+ -$(diff) $(testdir)\trap.5 trap.5
+ -$(diff) $(testdir)\trap.6 trap.6
+ -$(diff) $(testdir)\trap.148 trap.148
+ -$(diff) $(testdir)\trap.149 trap.149
+ -$(diff) $(testdir)\trap.150 trap.150
+ -$(diff) $(testdir)\trap.151 trap.151
+ -$(diff) $(testdir)\trap.197 trap.197
+ -$(diff) $(testdir)\trap.200 trap.200
+ .\$(objdir)\tftopl .\mptrap.tfm mptrap.pl
+ -$(diff) $(testdir)\mptrap.pl mptrap.pl
+ set TEXMFCNF=$(TEXMFCNFOLD)
+mptrap-clean:
+ -@echo $(verbose) & ( \
+ for %%i in (mtrap.mp mtrap.mem trapf.tfm \
+ mtrap.log mtrap.0 mtrap.1 writeo writeo.log writeo.2 \
+ trap.mp trap.mpx mptrapin.fot mptrapin.log \
+ mptrap.fot mptrap.log mptrap.tfm \
+ trap.ps trap.mem trap.0 trap.5 trap.6 trap.95 trap.96 trap.97 \
+ trap.98 trap.99 trap.100 trap.101 trap.102 trap.103 trap.104 \
+ trap.105 trap.106 trap.107 trap.108 trap.109 trap.148 \
+ trap.149 trap.150 trap.151 trap.197 trap.200 \
+ mptrap.pl) do $(del) %%i $(redir_stderr) \
+ )
+#
+# TeX
+tex_c = tex.c
+tex_o = $(objdir)\tex.obj
+!ifdef TEX_DLL
+$(objdir)\$(library_prefix)tex.exp: $(objdir)\$(library_prefix)tex.lib
+
+$(objdir)\$(library_prefix)tex.lib: $(tex_o)
+ $(archive) /DEF $(tex_o)
+
+$(objdir)\$(library_prefix)tex.dll: $(tex_o) $(objdir)\$(library_prefix)tex.exp $(objdir)\tex.res $(kpathsealib) $(proglib)
+ $(link_dll) $(**) $(socketlibs) $(conlibs)
+
+$(objdir)\tex.exe: $(objdir)\win32main.obj $(objdir)\$(library_prefix)tex.lib $(proglib)
+ $(link) $(**) $(conlibs)
+!else
+$(objdir)\tex.exe: $(tex_o) $(objdir)\win32main.obj $(objdir)\tex.res $(kpathsealib) $(proglib)
+ $(link) $(**) $(socketlibs) $(conlibs)
+!endif
+$(tex_c) texcoerce.h texd.h: tex.p $(web2c_texmf)
+ $(web2c) tex
+tex.p tex.pool: $(tangle) tex.web tex-w32.ch
+ $(tangle) tex.web tex-w32.ch
+tex-w32.ch: $(objdir)\tie.exe tex.ch tex-supp-w32.ch
+ $(objdir)\tie.exe -c tex-w32.ch tex.web tex.ch tex-supp-w32.ch
+check: tex-check
+tex-check: trip tex.fmt
+ @echo <<.\tex-check.bat
+PATH = .\$(objdir);$(kpathseadir)\$(objdir);$(geturldir)\$(objdir);c:\windows\system32;C:\WINDOWS\system32\wbem;c:\windows
+rem Test truncation (but don't bother showing the warning msg).
+.\$(objdir)\tex --progname=tex --output-comment=$(outcom) $(srcdir)\tests\hello > nul \
+ & .\$(objdir)\dvitype hello.dvi | grep olaf@infovore.xs4all.nl > nul
+rem \openout should show up in \write's.
+.\$(objdir)\tex --progname=tex $(srcdir)\tests\openout & grep xfoo openout.log
+rem one.two.tex -> one.two.log
+.\$(objdir)\tex --progname=tex $(srcdir)\tests\one.two & dir /n one.two.log
+rem uno.dos -> uno.log
+.\$(objdir)\tex --progname=tex $(srcdir)\tests\uno.dos & dir /n uno.log
+.\$(objdir)\tex --progname=tex $(srcdir)\tests\just.texi & dir /n just.log
+.\$(objdir)\tex --progname=tex $(srcdir)\tests\batch.tex
+.\$(objdir)\tex --progname=tex --shell $(srcdir)\tests\write18 | grep echo
+.\$(objdir)\tex --mltex --progname=initex $(srcdir)\tests\mltextst
+.\$(objdir)\tex --progname=tex <nul
+set WEB2C=$(kpathsea_srcdir)
+set TMPDIR=..
+.\$(objdir)\tex --progname=tex "\nonstopmode\font\foo=nonesuch\end"
+<<NOKEEP
+ .\tex-check.bat
+
+clean:: tex-clean
+tex-clean: trip-clean
+# $(LIBTOOL) --mode=clean $(del) tex
+ -@echo $(verbose) & ( \
+ for %%i in ($(tex_o) $(tex_c) texextra.c texcoerce.h texd.h \
+ tex.p tex.pool tex.fmt tex.log \
+ hello.dvi hello.log xfoo.out openout.log on.two.log uno.log \
+ just.log batch.log write18.log mltextst.log texput.log \
+ missfont.log) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(deldir) tfm $(redir_stderr)
+
+trip: $(objdir)\dvitype.exe $(objdir)\pltotf.exe $(objdir)\tftopl.exe $(objdir)\tex.exe trip-clean
+ @echo ">>> See $(testdir)\trip.diffs for example of acceptable diffs."
+ @echo <<.\trip.bat
+set TEXMFCNF=$(testdir)
+PATH = .\$(objdir);$(kpathseadir)\$(objdir);$(geturldir)\$(objdir);c:\windows\system32;C:\WINDOWS\system32\wbem;c:\windows
+.\$(objdir)\pltotf $(testdir)\trip.pl trip.tfm
+.\$(objdir)\tftopl .\trip.tfm trip.pl
+$(diff) $(testdir)\trip.pl trip.pl
+rem get same filename in log
+$(del) trip.tex & $(copy) $(testdir)\trip.tex . $(redir_stderr)
+.\$(objdir)\tex -progname=initex < $(testdir)\trip1.in >tripin.fot
+$(move) trip.log tripin.log
+$(diff) $(testdir)\tripin.log tripin.log
+rem May as well test non-ini second time through.
+.\$(objdir)\tex < $(testdir)\trip2.in >trip.fot
+$(diff) $(testdir)\trip.fot trip.fot
+rem We use $(diff) instead of `diff' only for those files where there
+rem might actually be legitimate numerical differences.
+$(diff) $(diffflags) $(testdir)\trip.log trip.log
+.\$(objdir)\dvitype $(dvitype_args) trip.dvi >trip.typ
+$(diff) $(diffflags) $(testdir)\trip.typ trip.typ
+<<NOKEEP
+ .\trip.bat
+
+trip-clean:
+ -@echo $(verbose) & ( \
+ for %%i in (trip.tfm trip.pl trip.tex trip.fmt tripin.fot tripin.log \
+ trip.fot trip.log trip.dvi trip.typ tripos.tex 8terminal.tex \
+ ) do $(del) %%i $(redir_stderr) \
+ )
+ -@$(deldir) tfm $(redir_stderr)
+
+# The stub with main() for win32
+$(objdir)\win32main.obj: $(objdir) .\lib\win32main.c config.h
+ $(compile) -UMAKE_TEX_DLL .\lib\win32main.c
+
+#
+# Makefile fragments:
+!include <etexdir/etex.mak>
+!include <omegadir$(omegaversion)/omega.mak>
+!include <eomegadir/eomega.mak>
+!include <alephdir/aleph.mak>
+!include <pdftexdir/pdftex.mak>
+!include <pdfetexdir/pdfetex.mak>
+#!include <pdfxtexdir/pdfxtex.mak>
+#
+# Common
+programs = $(objdir)\bibtex.exe $(objdir)\ctangle.exe $(objdir)\cweave.exe \
+ $(objdir)\dvicopy.exe $(objdir)\dvitomp.exe $(objdir)\dvitype.exe \
+ $(objdir)\gftodvi.exe $(objdir)\gftopk.exe $(objdir)\gftype.exe \
+ $(objdir)\mft.exe $(odvicopy) $(odvitype) $(otangle) $(objdir)\patgen.exe \
+ $(objdir)\pktogf.exe $(objdir)\pktype.exe $(objdir)\pltotf.exe \
+ $(objdir)\pooltype.exe $(objdir)\tangle.exe $(objdir)\tftopl.exe \
+ $(objdir)\tie.exe $(ttf2afm) $(objdir)\vftovp.exe $(objdir)\vptovf.exe \
+ $(objdir)\weave.exe \
+ $(pdftosrc) $(ttf2afm) $(tex) \
+ $(omega) $(aleph) \
+ $(pdfetex) $(pdfxtex) \
+ $(mf) $(mfn) $(mpost)
+# $(etex) $(eomega) $(pdftex)
+
+programs: $(objdir) $(programs) $(mpware) $(omegafonts_programs) $(otps_programs) $(pdftosrc)
+
+# We put some programs (written directly in C) in a subdirectory.
+$(mpware): $(mpware_sources)
+ cd mpware & $(make)
+
+# Additional dependencies for relinking.
+$(web2c_programs) $(programs) $(objdir)\tangleboot.exe $(objdir)\ctangleboot.exe: $(kpathsealib) $(proglib)
+
+#
+# Bootstrapping tangle requires making it with itself. We use the opportunity
+# to create an up-to-date tangleboot as well.
+$(tangle): $(objdir)\tangle.obj $(objdir)\tangle.res
+ $(link) $(objdir)\tangle.obj $(objdir)\tangle.res $(kpathsealib) $(proglib) $(conlibs)
+ $(make) tangleboot.p
+tangle.c tangle.h: tangle.p
+ $(web2c) tangle
+# tangle.p is a special case, since it is needed to compile itself. We
+# convert and compile the (distributed) tangleboot.p to make a tangle
+# which we use to make the other programs.
+tangle.p: $(objdir)\tangleboot.exe tangle.web tangle.ch
+ @set WEBINPUTS=$(srcdir)
+ .\$(objdir)\tangleboot tangle tangle
+ @set WEBINPUTS=
+tangle.web:
+ @echo $(verbose) & ( \
+ echo "You seem to be missing tangle.web, perhaps because you" & \
+ echo "didn't retrieve web.tar.gz, only web2c.tar.gz." & \
+ echo "You need both." & \
+ echo & \
+ echo "web.tar.gz should be available from the" & \
+ echo "same place that you got web2c.tar.gz." & \
+ echo "In any case, you can get it from" & \
+ echo "ftp://ftp.tug.org/tex/web.tar.gz." & \
+ )
+ false
+clean:: tangle-clean
+tangle-clean:
+# $(LIBTOOL) --mode=clean $(del) tangle
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\tangle.obj tangle.c tangle.h tangle.p) do $(del) %%i $(redir_stderr) \
+ )
+
+$(objdir)\tangleboot.exe: $(objdir) $(objdir)\tangleboot.obj
+ $(link) $(objdir)\tangleboot.obj $(kpathsealib) $(proglib) $(conlibs)
+tangleboot.c tangleboot.h: stamp-tangle $(web2c_programs) $(web2c_common)
+ $(web2c) tangleboot
+# tangleboot.p is in the distribution
+stamp-tangle: tangleboot.p
+ date /t >stamp-tangle & time /t >>stamp-tangle
+# This is not run unless tangle.web or tangle.ch is changed.
+# Only try to run ./tangle if it actually exists, otherwise
+# just touch tangleboot.p and build tangle.
+tangleboot.p: tangle.web tangle.ch
+ set WEBINPUTS=$(srcdir)
+ if exist $(objdir)\tangle.exe ( \
+ $(objdir)\tangle tangle tangle \
+ & $(move) tangle.p tangleboot.p \
+ & del cweb.c \
+ ) else if exist tangleboot.p ( \
+ touch tangleboot.p \
+ ) \
+ else ( \
+ $(copy) $(srcdir)\tangleboot.p . \
+ )
+ date /t >stamp-ctangle & time /t >>stamp-ctangle
+ $(make) $(objdir)\tangle.exe
+# $(objdir)\tangle $(srcdir)\tangle.web $(srcdir)\tangle.ch
+# copy tangle.p tangleboot.p & $(del) tangle.p
+# date /t >stamp-tangle & time /t >>stamp-tangle
+# $(make) $(tangle)
+clean:: tangleboot-clean
+tangleboot-clean:
+# $(LIBTOOL) --mode=clean $(del) tangleboot
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\tangleboot.obj tangleboot.c tangleboot.h ) do $(del) %%i $(redir_stderr) \
+ )
+
+# Bootstrapping ctangle requires making it with itself. We use the opportunity
+# to create an up-to-date ctangleboot as well.
+$(objdir)\ctangle.exe: $(objdir)\ctangle.obj $(objdir)\cweb.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+ $(make) ctangleboot.c
+ $(make) cwebboot.c
+# ctangle.c is a special case, since it is needed to compile itself.
+ctangle.c: $(objdir)\ctangleboot.exe cwebdir\ctangle.w cwebdir\ctang-w2c.ch
+ @set CWEBINPUTS=.;$(srcdir)\cwebdir
+ .\$(objdir)\ctangleboot ctangle.w ctang-w2c.ch
+cweb.c: $(objdir)\ctangleboot.exe cwebdir\common.w cwebdir\comm-w2c.ch
+ @set CWEBINPUTS=.;$(srcdir)\cwebdir
+ .\$(objdir)\ctangleboot common.w comm-w2c.ch cweb.c
+clean:: ctangle-clean
+clean:: cweb-clean
+ctangle-clean:
+# $(LIBTOOL) --mode=clean $(del) ctangle
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\ctangle.obj ctangle.c) do $(del) %%i $(redir_stderr) \
+ )
+cweb-clean:
+ -@echo $(verbose) & ( \
+ for %%i in ($(objdir)\cweb.obj cweb.c) do $(del) %%i $(redir_stderr) \
+ )
+
+$(objdir)\ctangleboot.exe: $(objdir)\ctangleboot.obj $(objdir)\cwebboot.obj $(kpathsealib) $(proglib)
+ $(link) $(**) $(conlibs)
+# ctangleboot.c is in the distribution
+stamp-ctangle: ctangleboot.c cwebboot.c
+ctangleboot.c: cwebdir\ctangle.w cwebdir\ctang-w2c.ch
+ @set CWEBINPUTS=.;$(srcdir)\cwebdir
+ if exist $(objdir)\ctangle.exe ( \
+ .\$(objdir)\ctangle ctangle.w ctang-w2c.ch \
+ & copy ctangle.c ctangleboot.c \
+ & del ctangle.c \
+ ) else ( \
+ touch ctangleboot.c \
+ )
+ date /t >stamp-ctangle & time /t >>stamp-ctangle
+ $(make) $(objdir)\ctangle.exe
+cwebboot.c: cwebdir\common.w cwebdir\comm-w2c.ch
+ set CWEBINPUTS=.;$(srcdir)\cwebdir
+ if exist $(objdir)\ctangle.exe ( \
+ $(objdir)\ctangle common.w comm-w2c.ch cweb.c \
+ & copy cweb.c cwebboot.c \
+ & del cweb.c \
+ ) else ( \
+ touch cwebboot.c \
+ )
+ date /t >stamp-ctangle & time /t >>stamp-ctangle
+ $(make) $(objdir)\ctangle.exe
+clean:: ctangleboot-clean
+clean:: cwebboot-clean
+ctangleboot-clean:
+# $(LIBTOOL) --mode=clean $(del) ctangleboot
+ -@$(del) $(objdir)\ctangleboot.obj $(redir_stderr)
+cwebboot-clean:
+ -@$(del) $(objdir)\cwebboot.obj $(redir_stderr)
+
+# Even web2c itself uses the library.
+# It's annoying to have to give all the filenames here,
+# but texmfmp.c is an exception.
+lib_sources = lib\alloca.c lib\basechsuffix.c lib\chartostring.c \
+ lib\eofeoln.c lib\fprintreal.c lib\input2int.c lib\inputint.c lib\main.c \
+ lib\openclose.c lib\printversion.c lib\uexit.c lib\usage.c lib\version.c \
+ lib\zround.c lib\oem.c
+$(proglib): $(lib_sources) stamp-auto
+ -@echo $(verbose) & ( \
+ pushd lib & $(make) all & popd \
+ )
+
+stamp-auto: $(kpathseadir)\..\web2c\c-auto.h
+
+$(kpathseadir)\..\web2c\c-auto.h: c-auto.h
+
+# No exceptions in this library.
+window_sources = $(srcdir)\window\*.c
+$(windowlib): mfd.h $(window_sources)
+ -@echo $(verbose) & ( \
+ pushd window & $(make) all & popd \
+ )
+window\$(objdir)\trap.obj: $(srcdir)\window\trap.c
+ -@echo $(verbose) & ( \
+ pushd window & $(make) all & popd \
+ )
+pdflib_sources = $(srcdir)\pdftexdir\*.c $(srcdir)\pdftexdir\*.cc \
+ $(srcdir)\pdftexdir\*.h
+$(pdflib): $(pdflib_sources)
+ -@echo $(verbose) & ( \
+ pushd pdftexdir & $(make) all & popd \
+ )
+
+# The web2c program consists of several executables.
+web2c\$(objdir)\fixwrites.exe: web2c\fixwrites.c
+ cd web2c & $(make) all
+# web2c\$(objdir)\splitup.exe: web2c\splitup.c
+# cd web2c & $(make) $(objdir)\splitup.exe
+web2c\$(objdir)\web2c.exe: web2c\main.c web2c\web2c.h web2c\web2c.l web2c\web2c.y
+ cd web2c & $(make) all
+
+# !include <msvc/tkpathsea.mak>
+
+#
+# Making dumps.
+# all_fmts = tex.fmt $(fmts)
+# all_formats = $(all_fmts) $(all_efmts) $(all_ofmts) $(all_pdffmts) $(all_pdfefmts) $(all_pdfxfmts)
+# all_bases = mf.base $(bases)
+# all_mems = mpost.mem $(mems)
+
+dumps:
+ @echo Dumps are generated by fmtutil!
+# set TEXMFMAIN
+# ..\contrib\$(objdir)\fmtutil --cnffile="$(texmf)\web2c\fmtutil.cnf" --all --dolinks
+# fmts: $(all_fmts)
+# bases: $(all_bases)
+# mems: $(all_mems)
+#
+# tex.fmt: $(tex)
+# $(dumpenv) $(make) progname=tex files="plain.tex cmr10.tfm" prereq-check
+# $(dumpenv) .\$(objdir)\tex --progname=tex --jobname=tex --ini "\input plain \dump" <nul
+#
+# latex.fmt: $(tex)
+# $(dumpenv) $(make) progname=latex files="latex.ltx" prereq-check
+# $(dumpenv) .\$(objdir)\tex --progname=latex --jobname=latex --ini "\input latex.ltx" <nul
+#
+# olatex.fmt: $(tex)
+# $(dumpenv) $(make) progname=olatex files="latex.ltx" prereq-check
+# $(dumpenv) .\$(objdir)\tex --progname=olatex --jobname=olatex --ini "\input latex.ltx" <nul
+#
+# mltex.fmt: $(tex)
+# $(dumpenv) $(make) progname=mltex files="plain.tex cmr10.tfm" prereq-check
+# $(dumpenv) .\$(objdir)\tex --mltex --progname=mltex --jobname=mltex --ini "\input plain \dump" <nul
+#
+# mllatex.fmt: $(tex)
+# $(dumpenv) $(make) progname=mllatex files="latex.ltx" prereq-check
+# $(dumpenv) .\$(objdir)\tex --mltex --progname=mllatex --jobname=mllatex --ini "\input latex.ltx" <nul
+#
+# mf.base: $(mf)
+# $(dumpenv) $(make) progname=mf files="plain.mf cmr10.mf $(localmodes).mf" prereq-check
+# $(dumpenv) .\$(objdir)\mf --progname=mf --jobname=mf --ini "\input plain input $(localmodes) dump" <nul
+#
+# mpost.mem: $(mpost)
+# $(dumpenv) $(make) progname=mpost files=plain.mp prereq-check
+# $(dumpenv) .\$(objdir)\mpost --progname=mpost --jobname=mpost --ini "\input plain dump" <nul
+
+# This is meant to be called recursively, with $(files) set.
+prereq-check: $(kpathseadir)\$(objdir)\kpsewhich.exe
+ -$(kpathseadir)\$(objdir)\kpsewhich $(files) > nul
+ if ERRORLEVEL 1 $(make) prereq-lose
+
+prereq-lose:
+ @echo $(verbose) & ( \
+ @echo "You seem to be missing input files necessary to make the"
+ @echo "basic formats (some or all of: $(files))."
+ @echo "Perhaps you've defined the default paths incorrectly, or"
+ @echo "perhaps you have environment variables set pointing"
+ @echo "to an incorrect location. See ../kpathsea/BUGS."
+ @echo
+ @echo "If you simply do not have the files, you can"
+ @echo "retrieve a minimal set of input files from"
+ @echo "ftp://ftp.tug.org/tex/texklib.tar.gz, mirrored on"
+ @echo "CTAN hosts in systems/web2c."
+ )
+
+$(kpathsea_dir)\$(objdir)\kpsewhich.exe: $(kpathsea)
+
+amstex.fmt: $(tex)
+ $(dumpenv) .\$(objdir)\tex.exe --progname=amstex --jobname=amstex --ini amstex.ini <nul
+
+# Texinfo changes the escape character from `\' to `@'.
+texinfo.fmt: tex.fmt
+ $(dumpenv) .\$(objdir)\tex --progname=texinfo --jobname=texinfo --ini texinfo "@dump" <nul
+
+eplain.fmt: tex.fmt
+ touch eplain.aux # Makes cross-reference warnings work right.
+ $(dumpenv) .\$(objdir)\tex --progname=eplain --jobname=eplain --ini "&./tex eplain \dump" <nul
+
+#
+!include <msvc/install.mak>
+
+install:: install-exec install-data install-doc
+install-exec:: install-links
+install-data::
+# FIXME!!! I hate to do this, but all this stuff relies more heavily
+# on fmtutil than on mere makefiles.
+install-dumps:
+ @echo <<install-dumps.bat
+@echo off
+set TEXMFCNF=$(TEXMFCNF)
+set TEXMFMAIN=$(TEXMFMAIN)
+set TEXMFDIST=$(TEXMFDIST)
+set VARTEXMF=$(VARTEXMF)
+xcopy /d ..\contrib\$(objdir)\fmtutil.exe $(bindir)\fmtutil.exe
+$(bindir)\fmtutil --cnffile="$(texmf)\web2c\fmtutil.cnf" --all --dolinks --force
+<<NOKEEP
+ -@.\install-dumps.bat
+
+# Installation directories.
+$(bindir)::
+ @if not exist $(bindir) $(mkdir) $(bindir)
+$(texpooldir)::
+ @if not exist $(texpooldir) $(mkdir) $(texpooldir)
+$(mfpooldir)::
+ @if not exist $(mfpooldir) $(mkdir) $(mfpooldir)
+$(mppooldir)::
+ @if not exist $(mppooldir) $(mkdir) $(mppooldir)
+$(fmtdir)::
+ @if not exist $(fmtdir) $(mkdir) $(fmtdir)
+$(basedir)::
+ @if not exist $(basedir) $(mkdir) $(basedir)
+$(memdir)::
+ @if not exist $(memdir) $(mkdir) $(memdir)
+$(web2cdir)::
+ @if not exist $(web2cdir) $(mkdir) $(web2cdir)
+
+# The actual binary executables and pool files.
+install-programs: $(programs)
+ pushd mpware & $(make) install-exec & popd
+ -@echo $(verbose) & ( \
+ for %%p in ($(programs)) do $(copy) %%p $(bindir) \
+ ) $(redir_stdout)
+
+# The links to {mf,mp,tex} for each format and for {ini,vir}{mf,mp,tex},
+# plus the equivalents for e-TeX, Omega, and pdf[ex]TeX.
+install-links: install-programs install-dumps
+#FMU -@echo $(verbose) & ( \
+#FMU pushd $(bindir) & \
+#FMU $(del) .\initex.exe .\virtex.exe & \
+#FMU $(lnexe) .\tex.exe $(bindir)\initex.exe & \
+#FMU $(lnexe) .\tex.exe $(bindir)\virtex.exe & \
+#FMU popd \
+#FMU ) $(redir_stdout)
+#FMU -@echo $(verbose) & ( \
+#FMU pushd $(bindir) & \
+#FMU $(del) .\inimf.exe .\virmf.exe & \
+#FMU $(lnexe) .\mf.exe $(bindir)\inimf.exe & \
+#FMU $(lnexe) .\mf.exe $(bindir)\virmf.exe & \
+#FMU # $(lnexe) .\mf.exe $(bindir)\mfw.exe & \
+#FMU popd \
+#FMU ) $(redir_stdout)
+#FMU -@echo $(verbose) & ( \
+#FMU pushd $(bindir) & \
+#FMU $(del) .\inimpost.exe .\virmpost.exe & \
+#FMU $(lnexe) .\mpost.exe $(bindir)\inimpost.exe & \
+#FMU $(lnexe) .\mpost.exe $(bindir)\virmpost.exe & \
+#FMU popd \
+#FMU ) $(redir_stdout)
+# -@echo $(verbose) & ( \
+# if NOT "$(fmts)"=="" \
+# for %%i in ($(fmts)) do \
+# pushd $(bindir) & \
+# $(del) .\%%~ni.exe & \
+# $(lnexe) .\tex.exe $(bindir)\%%~ni.exe & \
+# popd \
+# ) $(redir_stdout)
+# -@echo $(verbose) & ( \
+# if not "$(bases)"=="" \
+# for %%i in ($(bases)) do \
+# pushd $(bindir) & \
+# $(del) .\%%~ni.exe & \
+# $(lnexe) .\mf.exe $(bindir)\%%~ni.exe & \
+# popd \
+# ) $(redir_stdout)
+# -@echo $(verbose) & ( \
+# if not "$(mems)"=="" \
+# for %%i in ($(mems)) do \
+# pushd $(bindir) & \
+# $(del) .\%%~ni.exe & \
+# $(lnexe) .\mpost.exe $(bindir)\%%~ni.exe & \
+# popd \
+# ) $(redir_stdout)
+
+# Always do plain.*, so examples from the TeXbook (etc.) will work.
+# install-fmts: $(all_fmts)
+# -@echo $(verbose) & ( \
+# for %%f in ($(all_fmts)) do $(copy) %%f $(fmtdir)\%%f \
+# ) $(redir_stdout)
+# -@$(del) -f $(fmtdir)\plain.fmt & $(LN) tex.fmt $(fmtdir)\plain.fmt $(redir_stderr)
+#
+# install-bases: $(all_bases)
+# -@echo $(verbose) & ( \
+# for %%f in ($(all_bases)) do $(copy) %%f $(basedir)\%%f \
+# ) $(redir_stdout)
+# -@$(del) -f $(basedir)\plain.base & $(LN) mf.base $(basedir)\plain.base $(redir_stderr)
+#
+# install-mems: $(all_mems)
+# -@echo $(verbose) & ( \
+# for %%f in ($(all_mems)) do $(copy) %%f $(memdir)\%%f \
+# ) $(redir_stdout)
+# -@$(del) -f $(memdir)\plain.mem & $(LN) mpost.mem $(memdir)\plain.mem $(redir_stderr)
+
+# Auxiliary files.
+install-data:: $(texpooldir) $(mfpooldir) $(mppooldir)
+ @$(copy) tex.pool $(texpooldir)\tex.pool $(redir_stdout)
+ @$(copy) mf.pool $(mfpooldir)\mf.pool $(redir_stdout)
+ @$(copy) mp.pool $(mppooldir)\mp.pool $(redir_stdout)
+ cd doc & $(make) $(install_makeargs) install-data
+ cd man & $(make) $(install_makeargs) install-data
+ @$(copy) $(srcdir)\tiedir\tie.1 $(man1dir)\tie.$(manext) $(redir_stdout)
+ @$(copy) $(srcdir)\cwebdir\cweb.1 $(man1dir)\cweb.$(manext) $(redir_stdout)
+# @$(copy) fmtutil.cnf $(web2cdir)\fmtutil.cnf $(redir_stdout)
+
+install-doc::
+ -@echo $(verbose) & ( \
+ for %d in (doc man) do \
+ echo Entering %d for install & \
+ pushd %d & $(make) install & popd \
+ )
+
+# The distribution comes with up-to-date .info* files,
+# so this should never be used unless something goes wrong
+# with the unpacking, or you modify the manual.
+doc\web2c.info:
+ cd doc & $(make) info
+info dvi:
+ cd doc & $(make) $@
+
+# Manual pages
+manpages:
+ cd man & $(make) all
+
+# !include <msvc/dist.mak>
+
+!include <msvc/config.mak>
+
+#
+
+installcheck:
+ pushd $(srcdir)\tests & bibtex allbib & popd
+ mf "\mode:=ljfour; input logo10" & tftopl logo10.tfm >nul
+ tex "\nonstopmode \tracingstats=1 \input story \bye"
+#
+# Cleaning.
+all_subdirs = doc lib man mpware web2c window $(omegafonts) $(otps) pdftexdir # pdfetexdir pdfxtexdir
+
+# Having a multiple-target rule with the subdir loop fails because of
+# the dependencies introduced by clean.mk. Yet, we want the
+# dependencies here at the top level so that distclean will run the
+# clean rules, etc. So, sigh, put the subdir loop in each target and
+# only run it if we have a Makefile. Alternatively, we could do as
+# Automake does.
+
+mostlyclean:: tangleboot-clean ctangleboot-clean
+ -@echo $(verbose) & ( \
+ for %d in ($(all_subdirs)) do \
+ echo Entering %d for $@ & \
+ pushd %d & $(make) $@ & popd \
+ )
+clean::
+ -@echo $(verbose) & ( \
+ for %d in ($(all_subdirs)) do \
+ echo Entering %d for $@ & \
+ pushd %d & $(make) $@ & popd \
+ )
+ -@echo $(verbose) & ( \
+ for %%i in (*.log *.fmt *.efmt *.oft *.eoft *.base *.mem *.fls *.ofl *.aux \
+ mf-w32.ch mp-w32.ch tex-w32.ch) do $(del) %%i $(redir_stderr) \
+ )
+distclean::
+ -@echo $(verbose) & ( \
+ for %d in ($(all_subdirs)) do \
+ echo Entering %d for $@ & \
+ pushd %d & $(make) $@ & popd \
+ )
+ -@$(del) fmtutil.cnf $(redir_stderr)
+extraclean::
+ -@echo $(verbose) & ( \
+ for %d in ($(all_subdirs)) do \
+ echo Entering %d for $@ & \
+ pushd %d & $(make) $@ & popd \
+ )
+maintainer-clean::
+ -@echo $(verbose) & ( \
+ for %d in ($(all_subdirs)) do \
+ echo Entering %d for $@ & \
+ pushd %d & $(make) $@ & popd \
+ )
+
+!include <msvc/clean.mak>
+
+depend::
+ -@echo $(verbose) & ( \
+ for %%d in (lib mpware web2c window $(otps)) do \
+ pushd %%d & $(make) depend & popd \
+ )
+
+!include <msvc/rdepend.mak>
+!include "./depend.mak"
+
+#
+# Local variables:
+# page-delimiter: "^# \f"
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/window/ChangeLog b/Build/source/texk/web2c/window/ChangeLog
new file mode 100644
index 00000000000..912afb29899
--- /dev/null
+++ b/Build/source/texk/web2c/window/ChangeLog
@@ -0,0 +1,313 @@
+2005-06-26 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Replace ac_include with kpse_include. From Peter
+ Breitenlohner.
+
+2003-01-24 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mftalk.c: Use SIGCHLD, not SIGCLD (but fall back if necessary).
+ Reported by hubertf@netbsd.org.
+
+2001-11-25 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * x11-Xt.c (mf_checkextent): Add prototype.
+ (mf_optiondesclist): The pointers in the argument list are XPointers,
+ not XtPointers.
+
+2001-11-19 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * x11-Xt.c (mf_newpixmap): Add prototype to declaration.
+
+1999-02-06 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * trap.c (mf_trap_initscreen, mf_trap_updatescreen): Use P1H macro
+ in definition.
+
+ * win32.c (InitGui): Oops, removed one __cdecl too many. From
+ Fabrice.
+
+1999-02-04 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * win32.c (InitGui, LoopMsg): Remove __cdecl, from Fabrice.
+
+1999-01-13 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * Makefile.in: Rename kpathsea.make to kpathsea.mk.
+
+1999-01-10 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * x11-Xlib.c: Do not define input and output because of conflicts.
+
+ * tek.c: Don't redefine TRUE and FALSE.
+
+ * mftalk.c: Include kpathsea/variable.h.
+
+ * Makefile.in: Change of ../make/*.make to ../make/*.mk.
+
+Tue Jun 30 19:47:37 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * uniterm.c (mf_uniterm_paintrow): transspect -> transspec.
+
+Mon Mar 23 19:04:03 1998 Olaf Weber <olaf@infovore.xs4all.nl>
+
+ * mftalk.c (mf_mftalk_initscreen): Correction from Mathias
+ Herberts.
+
+Wed Feb 11 17:19:54 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * epsf.c: New version from Mathias Herberts.
+
+Tue Feb 10 21:10:20 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * mftalk.c: Patches to improve handling of pipes, after Mathias
+ Herberts.
+
+ * epsf.c: Pseudo-window EPS server contributed by Mathias Herberts
+ <herberts@infini.fr>
+
+ * Makefile.in: Add epsf.o to objects.
+
+Fri Jan 23 14:59:22 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * win32.c: Patches from Fabrice Popineau.
+
+Sat Jan 17 09:45:20 1998 Olaf Weber <infovore@xs4all.nl>
+
+ * mftalk.c (app_type): Wrong prototype.
+ (mf_talk_initscreen): We use the calling sequence of execl, not
+ execve. Undefine input and output, as these are macros on some
+ machines. From Mathias Herberts <Mathias.Herberts@irisa.fr>
+
+Thu Nov 13 19:17:42 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * next.c (mf_next_paintrow): Forgot to add the P4C macro name.
+
+Fri Oct 24 13:42:15 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * trap.c: By way of boilerplating, cast to long, not int, for
+ printing.
+
+ * win32.c, x11-Xlib.c, x11-Xt.c, uniterm.c trap.c, tek.c,
+ suntools.c, regis.c, next.c, mftalk.c, hp2627.c, amiga.c:
+ Prototypes for the mf_*_{blankrectangle,paintrow} functions.
+
+Mon Oct 20 08:48:51 1997 Olaf Weber <infovore@xs4all.nl>
+
+ * Makefile.in [objects]: Add win32.o.
+
+ * trap.c: Insert casts to ensure that the arguments to fprintf
+ match the format.
+
+ * win32.c: Nef file, adds support for win32 graphical output.
+ From Fabrice Popineau.
+
+Thu Feb 13 16:13:13 1997 Karl Berry <karl@cs.umb.edu>
+
+ * x11-Xt.c (wchar_t) [FOIL_X_WCHAR_T]: Had polarity of #if test wrong.
+ From: Olaf Weber <Olaf.Weber@cwi.nl>.
+
+Mon Jan 20 17:30:15 1997 Karl Berry <karl@cs.umb.edu>
+
+ * Version 7.0.
+
+Tue Dec 3 15:10:13 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * Makefile.in (prog_cflags): Oops, the previous change didn't work.
+ Have to set this to -I.. -I$(srcdir)/.. $(x_cppflags).
+
+Tue Dec 3 00:19:27 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * Makefile.in (prog_cflags): Set this to $(x_cppflags) so that
+ the X include path will eventually end up in ALL_CPPFLAGS.
+
+Tue Dec 3 00:19:27 1996 Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
+
+ * Makefile.in (prog_cflags): Set this to $(x_cppflags) so that
+ the X include path will eventually end up in ALL_CPPFLAGS.
+
+Mon Aug 5 16:30:17 1996 Karl Berry <karl@cs.umb.edu>
+
+ * x11-Xlib.c (mf_x11_initscreen): tvect - 1 should be just tvect.
+ From DEK et al.
+
+Fri Jul 26 15:47:50 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: Remove co.make.
+
+Wed May 15 16:58:01 1996 Karl Berry <karl@cs.umb.edu>
+
+ * mftalk.c: Doc fix.
+
+Tue Feb 13 16:10:54 1996 Karl Berry <karl@cs.umb.edu>
+
+ * x11-Xt.c: Missing close-comment.
+
+ * Makefile.in: Include rdepend.make.
+
+Fri Dec 29 17:15:38 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in: misc.make is now clean.make.
+
+Sat Nov 18 17:11:26 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (distclean): New target to remove x11.c. From Peter
+ Dyballa.
+
+Thu Nov 16 16:28:22 1995 Karl Berry <karl@cs.umb.edu>
+
+ * amiga.c: Replacement file.
+ * trap.c (EXTERN): Define as extern, just as with the rest of the
+ modules. From Andreas Scherer.
+
+Mon Oct 9 16:51:17 1995 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (x11.c): Use $(srcdir). From Simon.
+
+Fri Jul 21 15:48:25 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mftalk.c: The FSF has a new address.
+
+Tue Jul 18 15:16:15 1995 Karl Berry <karl@cs.umb.edu>
+
+ * mftalk.c (app_type): Don't just fail under Unix.
+
+Tue Jun 13 11:37:37 1995 Karl Berry <karl@cs.umb.edu>
+
+ * x11-Xt.c (mf_x11_paintrow): Use tvect, not tvect - 1.
+ From: FUKUI Rei <fkr@tooyoo1.l.u-tokyo.ac.jp>.
+
+MFwindow:
+Fri Jul 29 11:50:19 1994 Karl Berry (karl@cs.umb.edu)
+
+ * x11-Xt.c: Make the default be to *not* foil X's wchar_t.
+
+Mon Feb 21 17:49:30 1994 Karl Berry (karl@cs.umb.edu)
+
+ * x11-Xt.c: Include systypes.h for still more wchar_t kludgery.
+
+Wed Feb 2 11:01:09 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.1.
+
+Tue Feb 1 11:24:11 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Change ../../$(srcdir) to $(srcdir)/../.. throughout.
+
+Mon Jan 24 07:28:00 1994 Karl Berry (karl@cs.umb.edu)
+
+ * Version 6.0.
+
+Sun Jan 23 16:25:58 1994 Karl Berry (karl@cs.umb.edu)
+
+ * x11-Xt.c (wchar_t): No, remove that condition.
+
+Fri Dec 24 13:15:07 1993 Karl Berry (karl@sorrel.hq.ileaf.com)
+
+ * x11.c (wchar_t) [! __INT_WCHAR_T_H]: Conditionalize for aviion.
+
+|Tue Dec 21 19:33:59 1993 Karl Berry (karl@cs.umb.edu)
+
+ * x11-Xt.c (X_WCHAR): Define.
+
+Sat Dec 18 14:55:59 1993 Karl Berry (karl@cs.umb.edu)
+
+ * x11.c (wchar_t): Define this to a nonsense symbol, to avoid
+ redefinitions.
+
+Sat Dec 4 11:42:36 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (xincludedir): This is now x_include_flags.
+
+Sun Nov 14 16:19:13 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Don't need kpathsea definitions?
+
+Thu Nov 11 15:51:55 1993 Karl Berry (karl@cs.umb.edu)
+
+ * x11-Xt.c: Merge changes from Rainer for the Alpha and reformat.
+
+Sat Nov 6 13:18:07 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (objs): Add next.o and regis.o.
+ * next.c, regis.c: New file from joe@rilgp.tamri.com.
+
+Sun Oct 3 13:27:35 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (*clean): Include standard targets.
+
+Fri May 21 14:23:06 1993 Karl Berry (karl@cs.umb.edu)
+
+ * x11-Xt.c (mf_x11_updatescreen): Remove unused variable `event'.
+ (mf_max_x, etc.) [MF_XT_DEBUG]: Conditionalize declaration.
+
+Sun May 9 10:44:35 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (CPPFLAGS): Add -I for kpathsea.
+
+Fri Apr 9 16:22:17 1993 Karl Berry (karl@cs.umb.edu)
+
+ * x11-Xt.c (_GCC_WCHAR_T): Define.
+
+Sat Mar 13 11:26:57 1993 Karl Berry (karl@cs.umb.edu)
+
+ * uniterm.c (tek_dummy): Rename to uniterm_dummy, to avoid warning.
+
+Fri Feb 12 07:29:19 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (xincludedir): Include $(xincludedir).
+
+Sun Jan 3 13:30:10 1993 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (distclean): Remove Makefile.
+
+Sat Dec 19 18:57:02 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in ({sun,x11}.c): New targets.
+
+Sun Dec 13 14:27:15 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in (c-sources): New target.
+
+Sat Dec 12 15:10:49 1992 Karl Berry (karl@cs.umb.edu)
+
+ * Makefile.in: Rewrite from Makefile.
+
+Sun Oct 18 13:48:49 1992 Karl Berry (karl@cs.umb.edu)
+
+ * tek.c (bcopy, bzero) [SYSV]: Remove these; they're already
+ defined in c-memstr.h.
+
+Sun Jul 5 07:29:40 1992 Karl Berry (karl@hayley)
+
+ * sun-sunview.c: give return types to all fns.
+
+ * sun-sunview.c (mf_sun_initscreen): avoid line >= 80 chars.
+ * uniterm.c (mf_uniterm_paintrow): likewise.
+ * sun-xview.c (mf_xview_updatescreen): likewise.
+
+Fri Jul 3 11:22:47 1992 Karl Berry (karl@hayley)
+
+ * Makefile (CFLAGS): define as -g.
+ (CPPFLAGS): new var.
+ (.c.o): use it.
+ (distclean): synonym for realclean.
+
+ * sun-sunview.c: changes from Pierre (like the following).
+ * sun-gfx.c: rename from sun-suntools.c.
+ * sun-xview.c: new file.
+ * sun.c: remove and remake as a link to sun-sunview.c.
+
+Fri Mar 20 16:53:52 1992 Karl Berry (karl at hayley)
+
+ * Makefile (mostlyclean): new name for `clean'.
+ (clean): what `realclean' used to be.
+ (realclean): nothing to do anymore.
+ (install): install the program.
+
+Fri Jan 24 09:21:15 1992 Karl Berry (karl at hayley)
+
+ * Makefile (cflags): don't include -I../config.
+
+Sun Jan 12 12:53:24 1992 Karl Berry (karl at hayley)
+
+ * Makefile (CFLAGS): include config, two levels up.
diff --git a/Build/source/texk/web2c/window/Makefile.in b/Build/source/texk/web2c/window/Makefile.in
new file mode 100644
index 00000000000..0dade114ab2
--- /dev/null
+++ b/Build/source/texk/web2c/window/Makefile.in
@@ -0,0 +1,37 @@
+# Makefile for the Metafont window support library.
+
+kpse_include ../make/common.mk
+kpse_include ../make/library.mk
+kpse_include kpathsea.mk
+
+x_cppflags = @X_CFLAGS@
+library = window
+
+# Extra library-specific compiler options.
+prog_cflags = -I.. -I$(srcdir)/.. $(x_cppflags)
+
+objects = amiga.o epsf.o hp2627.o mftalk.o next.o regis.o suntools.o tek.o \
+trap.o uniterm.o win32.o x11.o
+
+default all: $(library).a
+$(library).a: $(objects)
+ rm -f $@
+ $(AR) $(ARFLAGS) $@ $(objects)
+ $(RANLIB) $@
+
+# It doesn't matter much what this default is, since if anything was
+# enabled configure would hopefully have found it.
+x11.c:
+ rm -f $@
+ $(LN) $(srcdir)/x11-Xt.c $@
+
+Makefile: Makefile.in ../config.status
+ cd .. && $(SHELL) config.status
+
+kpse_include ../make/clean.mk
+
+distclean::
+ rm -f x11.c
+
+kpse_include ../make/rdepend.mk
+kpse_include window/depend.mk
diff --git a/Build/source/texk/web2c/window/README b/Build/source/texk/web2c/window/README
new file mode 100644
index 00000000000..5384bc8b59e
--- /dev/null
+++ b/Build/source/texk/web2c/window/README
@@ -0,0 +1,2 @@
+This directory contains the support for Metafont's online graphics.
+The various pieces are used and invoked from lib/texmfmp.c.
diff --git a/Build/source/texk/web2c/window/amiga.c b/Build/source/texk/web2c/window/amiga.c
new file mode 100644
index 00000000000..ec686795066
--- /dev/null
+++ b/Build/source/texk/web2c/window/amiga.c
@@ -0,0 +1,363 @@
+/*
+ * AMIGA.C: This is the Graphics Window interface to MetaFont for online
+ * displays on the Commodore Amiga. This file was written by Edmund Mergl
+ * for his Amiga port of TeX 3.1 and MetaFont 2.7 from the original Unix
+ * sources (see Fish Disks 611-616).
+ *
+ * Some modifications and improvements were made since 1993 by Andreas and
+ * Stefan Scherer, Abt-Wolf-Strasse 17, 96215 Lichtenfels, Germany. The
+ * most recent entries from top to bottom always superseed their ancestors,
+ * just read this as a bit of history:
+ *
+ * August 12, 1993:
+ *
+ * - We use the `memory hack', so the values for `screenwidth'
+ * and `screendepth' are to be found in `mfmemory.config'. The
+ * display height should be set to an InterLace value, this will
+ * be dealt with by `lacefactor' (see below).
+ *
+ * - The display window is no longer resizeable, because no
+ * `screenupdate' is called and the picture is destroyed.
+ *
+ * - Based on ideas by Stefan Becker used in his famous MetaFont port
+ * to the Amiga of 1991 (see Fish Disk 486) there is a variable
+ * `scalefactor', which can be set to a (small) positiv integer in
+ * `mfmemory.config'. This results in a reduced size of the displayed
+ * characters, so that large font pictures can be drawn on
+ * small-sized screens (although some distortions are possible).
+ *
+ * - By replacing `Move' and `Draw' with `WritePixelLine' and friends
+ * the speed of the display was heavily increased.
+ *
+ * - The display screen is totally controlled by `screenwidth' and
+ * `screendepth' from `mfmemory.config', when you set `screen_rows'
+ * and `screen_cols' both to the maximum value `4095' in your local
+ * device modes file. MetaFont takes the smaller of these pairs.
+ *
+ * - `blankrectangle' *always* set the complete display window to the
+ * background color, not only the area specified by `left', `right',
+ * `top', and `bottom'. These MetaFont coordinates are now obeyed.
+ *
+ * September 11, 1993:
+ *
+ * - The changes for `Computers and Typesetting -- Volume A-E' provided
+ * by Addison-Wesley Publishing Company resulted in MetaFont 2.71.
+ * This caused a change in the window title.
+ *
+ * October 22, 1993:
+ *
+ * - The official version 2.71 has the same window title. :-)
+ *
+ * January 28, 1994:
+ *
+ * - Although SAS/C has an AutoOpen feature for Amiga libraries,
+ * it is better to define the library bases explicitly.
+ *
+ * February 15, 1995:
+ *
+ * - Here's my new address:
+ * Andreas Scherer, Rolandstraße 16, 52070 Aachen, Germany.
+ * <scherer@genesis.informatik.rwth-aachen.de> (Internet).
+ * - Make `amiga.c' compliant with the syntax of the other modules
+ * in the Web2C 6.1 distribution.
+ *
+ * February 19, 1995:
+ *
+ * - `close_all()' must not have arguments, because we want to
+ * link it into the `atexit()' function list.
+ * - To distinguish this version from the old distribution, the
+ * window title is modified.
+ *
+ * March 23, 1995:
+ *
+ * - MetaFont has the new version number 2.718.
+ *
+ * April 9, 1995:
+ *
+ * - rename `screenheight' to `screendepth' for consistency.
+ *
+ * October 10, 1995:
+ *
+ * - Yet another change in my address, now it's a UNIX CIP pool:
+ * <scherer@physik.rwth-aachen.de>
+ * - Cleanup for the new web2c release.
+ */
+
+#define EXTERN extern
+
+#include "../mfd.h"
+
+#ifdef AMIGAWIN /* Whole file */
+
+#include <proto/exec.h>
+#include <proto/graphics.h>
+#include <proto/intuition.h>
+
+struct GfxBase *GfxBase;
+struct IntuitionBase *IntuitionBase;
+
+struct Screen *Scr;
+struct Window *Win;
+
+struct BitMap tempbm;
+struct RastPort temprp;
+
+UBYTE *linearray;
+
+int scaledwidth = 0;
+int scaledheight = 0;
+
+#ifndef scalefactor
+#define scalefactor 1
+#endif
+
+/*
+ * The configuration `mf.mcf' of AmiWeb2C holds values for `screenwidth'
+ * and `screendepth' that always refer to an InterLace screen. In case
+ * you open the display on a non-InterLaced screen, only half the lines
+ * are shown to you. This is automatically done by reading the screen
+ * information and setting `lacefactor'.
+ */
+int lacefactor;
+
+#define BACKGROUNDCOLOR 0
+#define PENCOLOR 1
+
+#define PUBSCREEN 0
+
+/*
+ * Allocating memory for the array used in `WritePixelLine' needs
+ * WORD-aligned arguments.
+ */
+#define ALIGN_SIXTEEN_BIT(A) ((((A)+15)/16)*16)
+#ifndef min
+#define min(a,b) ((a)<(b)?(a):(b))
+#endif
+
+/*
+ * CLOSE_ALL: Clean up on MetaFont termination. This routine has to be
+ * called just before leaving the program, which is done automatically
+ * when it gets entered into the `atexit' function list. (See below.)
+ */
+void close_all(void)
+{
+ if (linearray) free(linearray);
+ if (tempbm.Planes[0]) FreeRaster(tempbm.Planes[0], scaledwidth, 1);
+ if (Win) CloseWindow(Win);
+ if (GfxBase) CloseLibrary((struct Library *)GfxBase);
+ if (IntuitionBase) CloseLibrary((struct Library *)IntuitionBase);
+
+} /* close_all() */
+
+/*
+ * INITSCREEN: Initialize the physical display window on the WorkBench
+ * screen of the Commodore Amiga. Open the necessary libraries and open
+ * the window according to `screenwidth' and `screendepth' as given in
+ * the configuration file `mf.mcf'. For this purpose, the
+ * `OpenWindowTagList' routine was replaced with `OpenWindowTags'.
+ * The `WFLG_SIZEGADGET' window flag has been removed; resizing the
+ * window kills the picture and never triggered an `updatescreen'.
+ */
+boolean mf_amiga_initscreen(void)
+{
+#ifdef DEBUG
+ printf("\ninitscreen()\n");
+#endif
+
+ /*
+ * Make sure the resources are correctly returned to the system
+ * when leaving the program.
+ */
+ if(atexit(&close_all)) { /* Can't happen. */
+ fprintf(stderr, "Exit trap failure! (close_all)\n");
+ uexit(1);
+ }
+
+ if (!(IntuitionBase = (struct IntuitionBase *)
+ OpenLibrary((unsigned char *)"intuition.library",(unsigned long)37L)))
+ {
+ fprintf(stderr,"\nCan't open intuition library. V37 required.\n");
+ close_all();
+ return(FALSE);
+ }
+
+ if (!(GfxBase = (struct GfxBase *)
+ OpenLibrary((unsigned char *)"graphics.library",(unsigned long)37L)))
+ {
+ fprintf(stderr,"\nCan't open intuition library. V37 required.\n");
+ close_all();
+ return(FALSE);
+ }
+
+ if (!(Scr = LockPubScreen(PUBSCREEN)))
+ {
+ fprintf(stderr,
+ "\nCan't get lock on public screen (%d).\n", PUBSCREEN);
+ close_all();
+ return(FALSE);
+ }
+
+ scaledwidth = screenwidth/scalefactor;
+ scaledheight = screendepth/scalefactor;
+
+ lacefactor = ((Scr->ViewPort.Modes & LACE) ? 1 : 2);
+
+ if (!(Win = (struct Window *)OpenWindowTags( NULL,
+ WA_InnerWidth, scaledwidth,
+ WA_InnerHeight, scaledheight/lacefactor,
+ WA_Flags, WFLG_DRAGBAR|WFLG_DEPTHGADGET,
+ WA_AutoAdjust, FALSE,
+ WA_Title, (ULONG)" MetaFont V2.718 Online Display",
+ WA_PubScreen, (ULONG)Scr,
+ TAG_DONE)))
+ {
+
+ fprintf(stderr,
+ "\nCan't open online display window at size %d times %d.\n"
+#ifdef VARMEM
+ "Change your configuration file.\n",
+#else
+ "If you really absolutely need more capacity,\n"
+ "you can ask a wizard to enlarge me.\n",
+#endif
+ screenwidth,screendepth);
+
+ close_all();
+ return(FALSE);
+ }
+
+ InitBitMap(&tempbm, 1, scaledwidth, 1);
+
+ tempbm.Planes[0] = NULL;
+
+ if(!(tempbm.Planes[0] = (PLANEPTR)AllocRaster(scaledwidth, 1)))
+ return(FALSE);
+
+ InitRastPort(&temprp);
+
+ temprp.BitMap = &tempbm;
+
+ if(!(linearray = (UBYTE *)
+ calloc(ALIGN_SIXTEEN_BIT(scaledwidth),sizeof(UBYTE))))
+ return(FALSE);
+
+ UnlockPubScreen(NULL, Scr);
+
+#ifdef DEBUG
+ printf("initscreen() ok\n");
+#endif
+
+ return(TRUE);
+
+} /* mf_amiga_initscreen() */
+
+/*
+ * UPDATESCREEN: I really don't know what this function is supposed
+ * to do.
+ */
+void mf_amiga_updatescreen(void)
+{
+#ifdef DEBUG
+ printf("updatescreen()\n");
+#endif
+} /* mf_amiga_update_screen() */
+
+/*
+ * BLANKRECTANGLE: Reset the drawing rectangle bounded by
+ * ([left,right],[top,bottom]) to the background color.
+ */
+void mf_amiga_blankrectangle(screencol left, screencol right,
+ screenrow top, screenrow bottom)
+{
+#ifdef DEBUG
+ printf("blankrectangle() - left: %d right: %d top: %d bottom: %d\n",
+ left, right, top, bottom);
+#endif
+
+ SetAPen (Win->RPort, BACKGROUNDCOLOR);
+ RectFill(Win->RPort,
+ (SHORT)(Win->BorderLeft + left/scalefactor),
+ (SHORT)(Win->BorderTop + top/(scalefactor*lacefactor)),
+ (SHORT)(Win->BorderLeft + right/scalefactor - 1),
+ (SHORT)(Win->BorderTop + bottom/(scalefactor*lacefactor) - 1));
+} /* mf_amiga_blankrectangle() */
+
+/*
+ * PAINTROW: Paint a `row' starting with color `init_color', up to the
+ * next transition specified by `transition_vector', switch colors, and
+ * continue for `vector_size' transitions. It now only
+ * draws into the display window when a new raster line will be affected.
+ * A lot of pre-drawing and inter-drawing calculations and conditionals
+ * are evaluated to prepare a fast and clean drawing under the most
+ * circumstances to be expected on the Amiga. InterLace/Lace is taken
+ * care of and the sizes are set appropriately not to clobber the borders.
+ * (Don't ask me why this works; at least on my machine with my config.)
+ */
+void mf_amiga_paintrow(screenrow row, pixelcolor init_color,
+ transspec transition_vector, screencol vector_size)
+{
+ int start, scaledstart, scaledrow, scaledlaced;
+ register int i=0, j=0, col, color;
+
+#ifdef DEBUG
+ printf("paintrow() - vector size: %d\n", vector_size);
+#endif
+
+ color = ((0 == init_color) ? BACKGROUNDCOLOR : PENCOLOR);
+ scaledlaced = scalefactor * lacefactor;
+ start = *transition_vector++;
+ scaledstart = start / scalefactor;
+ scaledrow = row / scaledlaced;
+
+ ReadPixelLine8(Win->RPort, Win->BorderLeft + scaledstart,
+ Win->BorderTop + scaledrow, scaledwidth - scaledstart,
+ linearray, &temprp);
+
+ if(scalefactor>1) {
+
+ do {
+ for(col = *transition_vector++; i<col-start; i++) {
+ linearray[j] |= color;
+ if((i%scalefactor)==0) j++;
+ }
+
+ color = PENCOLOR - color;
+
+#ifdef DEBUG
+ printf("move col: %d row: %d ", col, row);
+ printf("draw col: %d row: %d\n", (*transition_vector)-1, row);
+#endif
+
+ } while (--vector_size);
+
+ if(i >= col-start) linearray[++j] |= color;
+
+ } else {
+
+ do {
+ for(col = *transition_vector++; j<col-start; j++) {
+ linearray[j] |= color;
+ }
+
+ color = PENCOLOR - color;
+
+#ifdef DEBUG
+ printf("move col: %d row: %d ", col, row);
+ printf("draw col: %d row: %d\n", (*transition_vector)-1, row);
+#endif
+
+ } while (--vector_size);
+ }
+
+ if( ( Win->BorderTop + scaledrow ) <
+ ( Win->Height - Win->BorderBottom ) )
+ WritePixelLine8(Win->RPort, Win->BorderLeft + scaledstart,
+ Win->BorderTop + scaledrow,
+ min(Win->Width - Win->BorderLeft - Win->BorderRight - scaledstart,j),
+ linearray, &temprp);
+
+} /* mf_amiga_paintrow() */
+
+#else
+int amiga_dummy;
+#endif /* AMIGAWIN */
diff --git a/Build/source/texk/web2c/window/depend.mak b/Build/source/texk/web2c/window/depend.mak
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Build/source/texk/web2c/window/depend.mak
diff --git a/Build/source/texk/web2c/window/depend.mk b/Build/source/texk/web2c/window/depend.mk
new file mode 100644
index 00000000000..c9a3225569d
--- /dev/null
+++ b/Build/source/texk/web2c/window/depend.mk
@@ -0,0 +1,182 @@
+amiga.o: amiga.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+epsf.o: epsf.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+hp2627.o: hp2627.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+mftalk.o: mftalk.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+next.o: next.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+regis.o: regis.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+suntools.o: suntools.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+tek.o: tek.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+trap.o: trap.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+uniterm.o: uniterm.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+win32.o: win32.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+x11.o: x11.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+x11-Xlib.o: x11-Xlib.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
+x11-Xt.o: x11-Xt.c ../mfd.h ../texmfmp.h ../cpascal.h ../config.h \
+ $(kpathsea_srcdir)/config.h $(kpathsea_dir)/c-auto.h $(kpathsea_srcdir)/c-std.h \
+ $(kpathsea_srcdir)/c-unistd.h $(kpathsea_srcdir)/systypes.h \
+ $(kpathsea_srcdir)/c-memstr.h \
+ $(kpathsea_srcdir)/c-errno.h \
+ $(kpathsea_srcdir)/c-minmax.h $(kpathsea_srcdir)/c-limits.h \
+ $(kpathsea_srcdir)/c-proto.h $(kpathsea_srcdir)/debug.h \
+ $(kpathsea_srcdir)/types.h $(kpathsea_srcdir)/lib.h $(kpathsea_srcdir)/progname.h \
+ ../../web2c/c-auto.h $(kpathsea_srcdir)/c-vararg.h $(kpathsea_srcdir)/c-fopen.h \
+ $(kpathsea_srcdir)/getopt.h \
+ $(kpathsea_srcdir)/proginit.h $(kpathsea_srcdir)/tex-file.h ../help.h \
+ $(kpathsea_srcdir)/c-pathch.h $(kpathsea_srcdir)/c-ctype.h \
+ $(kpathsea_srcdir)/tex-make.h ../texmfmem.h ../mfcoerce.h
diff --git a/Build/source/texk/web2c/window/epsf.c b/Build/source/texk/web2c/window/epsf.c
new file mode 100644
index 00000000000..05211a59970
--- /dev/null
+++ b/Build/source/texk/web2c/window/epsf.c
@@ -0,0 +1,176 @@
+/*
+ * epsf.c -- Encapsulated PostScript window server.
+ * Copyright (C) 1998 Mathias Herberts <herberts@infini.fr>
+ *
+ * These functions generate an Encapsulated PostScript File
+ * representing the graphics normally shown online. They are
+ * selected by setting MFTERM to epsf.
+ *
+ * The name of the file defaults to metafont.eps but can be
+ * changed by setting the MFEPSF environment variable.
+ *
+ * The file is closed when the program exits.
+ */
+
+/*
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation; either version 2 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */
+
+
+
+#define EXTERN extern
+
+#include "../mfd.h"
+
+#ifdef EPSFWIN
+
+#include <stdio.h>
+
+static FILE * psout = NULL;
+
+/*
+ * Arrays epsf_{left,right,top,bottom} hold the coordinates of
+ * open windows.
+ *
+ * When a new window is opened, i.e. when blankrectangle is
+ * called, we check the arrays to see if the blank rectangle
+ * clears an open window. If it is the case a showpage and an %%EOF is
+ * appended To the PostScript file and a new header is output thus
+ * making it easy to separate the pages.
+ *
+ * The last page of the file is not terminated by a showpage and
+ * an %%EOF, the user should add them himself.
+ *
+ */
+
+static screencol epsf_left[16];
+static screencol epsf_right[16];
+static screenrow epsf_top[16];
+static screenrow epsf_bottom[16];
+
+static short epsf_window = 0;
+static unsigned int epsf_page = 1;
+
+void
+mf_epsf_header ()
+{
+ fprintf (psout, "%%!PS-Adobe-3.0 EPSF-3.0\n");
+ fprintf (psout, "%%%%BoundingBox: -1 -1 %d %d\n", screenwidth, screendepth);
+ fprintf (psout, "%%%%Creator: METAFONT\n");
+ fprintf (psout, "%%%%Page: %d %d\n\n", epsf_page, epsf_page);
+ fprintf (psout, "1 dup scale\n");
+ fprintf (psout, "1 setlinewidth\n\n");
+
+ epsf_page++;
+}
+
+boolean
+mf_epsf_initscreen P1H(void)
+{
+ if (getenv ("MFEPSF") != (char *) NULL)
+ {
+ psout = fopen ((char *) getenv ("MFEPSF"), "w");
+ }
+ else
+ {
+ psout = fopen ("metafont.eps", "w");
+ }
+
+ if (psout == (FILE *) NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ mf_epsf_header ();
+ epsf_window = 0;
+ return 1;
+ }
+}
+
+void
+mf_epsf_updatescreen P1H(void)
+{
+ fflush (psout);
+}
+
+void
+mf_epsf_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ int i;
+
+ for (i = 0; i < epsf_window; i++)
+ {
+ if (! ((right - 1 < epsf_left[i]) || (epsf_right[i] < left)) ) /* new window is neither left nor right of window i */
+ if ( ! ((top > epsf_bottom[i]) || (epsf_top[i] > bottom - 1))) /* new window is neither below nor above window i */
+ {
+ fprintf (psout, "\nshowpage\n%%%%EOF\n");
+ mf_epsf_header ();
+ epsf_window = 0;
+ break;
+ }
+ }
+
+ epsf_left[epsf_window] = left;
+ epsf_right[epsf_window] = right - 1;
+ epsf_top[epsf_window] = top;
+ epsf_bottom[epsf_window] = bottom - 1;
+
+ epsf_window++;
+
+ fprintf (psout, "1 setgray %d %d %d %d rectfill 0 setgray\n", left, screendepth - 1 - bottom, right - left, bottom - top);
+
+ fflush (psout);
+}
+
+
+void
+mf_epsf_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, transition_vector,
+ screencol, vector_size)
+{
+ int col;
+ int color;
+
+ color = (init_color == 0) ? 1 : 0;
+
+ do
+ {
+ col = *transition_vector++;
+
+ if (!color)
+ {
+ fprintf (psout, "newpath %d %d moveto %d %d lineto stroke\n",
+ col,
+ screendepth - 1 - row,
+ *transition_vector,
+ screendepth - 1 - row);
+ }
+
+ color = (color == 0) ? 1 : 0;
+ }
+ while (--vector_size > 0);
+}
+
+
+#else /* !EPSFWIN */
+
+int epsf_dummy;
+
+#endif /* !EPSFWIN */
diff --git a/Build/source/texk/web2c/window/hp2627.c b/Build/source/texk/web2c/window/hp2627.c
new file mode 100644
index 00000000000..2734bb36a02
--- /dev/null
+++ b/Build/source/texk/web2c/window/hp2627.c
@@ -0,0 +1,252 @@
+/*
+ * HP2627 Terminal Window interface to Unix Metafont.
+ */
+
+#define EXTERN extern
+#include "../mfd.h"
+
+#ifdef HP2627WIN
+
+#include <stdio.h>
+
+/*
+ * HP2627a Color Graphics Terminal: Escape code definitions
+ *
+ * Drawing pen colors
+ */
+#define HP2627_BLACK '0'
+#define HP2627_RED '1'
+#define HP2627_GREEN '2'
+#define HP2627_YELLOW '3'
+#define HP2627_BLUE '4'
+#define HP2627_MAGENTA '5'
+#define HP2627_CYAN '6'
+#define HP2627_WHITE '7'
+
+/*
+ * Initialization: just do a hard graphics reset
+ * (then we can depend on the defaults
+ * being as we want them)
+ */
+#define HP2627_INITSTRING "\033*wR"
+#define HP2627_INITSTRINGLEN 4
+
+/*
+ * We want the text to be visible over both background and forground
+ * graphics data; the best color combination I found for this
+ * was to set the background RED and then paint with BLUE,
+ * although the eye doesn't focus on BLUE very well (black
+ * might be better? Or green? [to get in the holiday mood])
+ */
+#define HP2627_BACKGROUNDPEN HP2627_RED
+#define HP2627_FOREGROUNDPEN HP2627_BLUE
+
+static char mf_hp2627_pencolors[2] = {
+ HP2627_BACKGROUNDPEN, /* white */
+ HP2627_FOREGROUNDPEN /* black */
+};
+
+/*
+ * Screen dimensions: Note the origin is at the lower-left corner,
+ * not the upper left as MF expects - hence we need to translate.
+ */
+#define HP2627_MAXX 511
+#define HP2627_MAXY 389
+
+/*
+ * The actual Graphics routines. Note that these are highly tty
+ * dependent so I can minimize the number of characters that
+ * need to be sent to paint an image, since we only talk to
+ * the HP at 9.6Kb.
+ */
+
+/*
+ * function init_screen: boolean;
+ *
+ * Return true if window operations legal.
+ * We always return true (I suppose we could try to
+ * sense status or something masochistic like that)
+ */
+
+int mf_hp2627_initscreen()
+{
+ (void) fflush(stdout); /* make sure pascal-level output flushed */
+ (void) write(fileno(stdout), HP2627_INITSTRING, HP2627_INITSTRINGLEN);
+ return(1);
+}
+
+/*
+ * procedure updatescreen;
+ *
+ * Just make sure screen is ready to view
+ * (since we do Unix-level WRITE()s,
+ * we don't really need to flush stdio,
+ * but why not?)
+ */
+
+void mf_hp2627_updatescreen()
+{
+ (void) fflush(stdout);
+}
+
+/*
+ * procedure blankrectangle(left, right, top, bottom: integer);
+ *
+ * reset rectangle bounded by ([left,right],[top,bottom])
+ * to background color
+ */
+
+void mf_hp2627_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ char sprbuf[128];
+
+ (void) sprintf(sprbuf, "\033*m%cx%d,%d %d,%dE", HP2627_BACKGROUNDPEN,
+ left, HP2627_MAXY-bottom,
+ right, HP2627_MAXY-top);
+ (void) write(fileno(stdout), sprbuf, strlen(sprbuf));
+}
+
+/*
+ * procedure paintrow(
+ * row: screenrow;
+ * init_color: pixelcolor;
+ * var trans_vector: transspec;
+ * vector_size: screencol );
+ *
+ * Paint "row" starting with color "init_color", up to next
+ * transition specified by "transition_vector", switch colors,
+ * and continue for "vector_size" transitions.
+ */
+
+/*
+ * First some useful definitions:
+ */
+#define ASCIILABS 0 /* plot cmd format: ASCII long abs */
+#define BINLABS 1 /* plot cmd format: BINARY long abs */
+#define BINSINC 2 /* plot cmd format: BINARY short incr */
+
+#define ABS(x) ((x>=0)?x:-x) /* absolute value */
+
+/*
+ * An optimized "move to (x,y), with current pen lowered unless UP is
+ * true" function. Takes advantage of short commands for short
+ * movements to minimize character traffic to term.
+ *
+ * Note: the "x -= 1;" fudge is because we only want to DRAW
+ * to the next transition_vector entry - 1, but if we
+ * have the pen raised, we want to move to exactly the
+ * next point.
+ */
+#define MOVETO(x,y,up) \
+ if (up) *op++ = 'a'; \
+ else x -= 1; \
+ if (ABS(x-oldx) < 16 && ABS(y-oldy) < 16) { \
+ if (currentformat != BINSINC) { \
+ *op++ = 'j'; \
+ currentformat = BINSINC; \
+ } \
+ *op++ = (((x-oldx) & 0x1f) + ' '); \
+ *op++ = (((y-oldy) & 0x1f) + ' '); \
+ } else { \
+ if (currentformat != BINLABS) { \
+ *op++ = 'i'; \
+ currentformat = BINLABS; \
+ } \
+ *op++ = (((x&0x3e0)>>5)+' '); \
+ *op++ = ((x&0x01f) +' '); \
+ *op++ = (((y&0x3e0)>>5)+' '); \
+ *op++ = ((y&0x01f) +' '); \
+ } \
+ oldx = x; \
+ oldy = y;
+
+void mf_hp2627_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, transition_vector,
+ screencol, vector_size)
+{
+ register color;
+ char outbuf[512*6]; /* enough to hold an alternate color */
+ /* in each column */
+ register char *op;
+ register x, y, oldx, oldy;
+ int currentformat;
+
+ color = (init_color == 0)? 0 : 1;
+
+ /*
+ * We put all escape sequences in a buffer so the write
+ * has a chance of being atomic, and not interrupted by
+ * other independent output to our TTY. Also to avoid
+ * (literally millions) of stdio calls.
+ */
+ op = outbuf;
+ /*
+ * Select current pen to be the color of the first segment:
+ *
+ * our strategy here is to paint a long line from the first
+ * transition_vector value (left edge of row) to the last
+ * transition_vector entry (right edge of row). Then we switch
+ * colors to the contrasting color, and paint alternate
+ * segments with that color. Would that the HP2627 would provide
+ * a mode to paint the "background" color while the PEN is lifted.
+ * However, this is faster than using rectangular area fills.
+ */
+
+ *op++ = '\033'; *op++ = '*'; *op++ = 'm';
+ *op++ = mf_hp2627_pencolors[color];
+ *op++ = 'X';
+
+ /*
+ * Reset our "remembered" state for (X,Y) positioning and plot
+ * command format
+ */
+ oldx = oldy = -999;
+ currentformat = ASCIILABS;
+
+ /*
+ * Now, paint across the entire width of this row, make it the
+ * initial segment color.
+ */
+ x = *transition_vector;
+ y = HP2627_MAXY-row;
+ *op++ = '\033'; *op++ = '*'; *op++ = 'p';
+ MOVETO(x,y,1);
+ x = transition_vector[vector_size];
+ MOVETO(x,y,0);
+ *op++ = 'Z';
+
+ /*
+ * If there remain other segments (of contrasting color) to paint,
+ * switch pens colors and draw them
+ */
+ if (--vector_size > 0) {
+ *op++ = '\033'; *op++ = '*'; *op++ = 'm';
+ *op++ = mf_hp2627_pencolors[1-color]; *op++ = 'X';
+ color = 1-color;
+
+ oldx = oldy = -999;
+ currentformat = ASCIILABS;
+ *op++ = '\033'; *op++ = '*'; *op++ = 'p';
+ x = *++transition_vector;
+ MOVETO(x,y,1);
+ while (vector_size-- > 0) {
+ x = *++transition_vector;
+ MOVETO(x,y,(color==init_color));
+ color = 1 - color;
+ };
+ *op++ = 'Z';
+ };
+
+ /*
+ * Write the resulting plot commands, hopefully atomically
+ */
+ (void) write(fileno(stdout), outbuf, op-outbuf);
+}
+
+#else
+int hp2627_dummy;
+#endif /* HP2627WIN */
diff --git a/Build/source/texk/web2c/window/mftalk.c b/Build/source/texk/web2c/window/mftalk.c
new file mode 100644
index 00000000000..25554e05831
--- /dev/null
+++ b/Build/source/texk/web2c/window/mftalk.c
@@ -0,0 +1,273 @@
+/* mftalk.c -- generic Metafont window server.
+ Copyright (C) 1994 Ralph Schleicher
+ Slightly modified for Web2c 7.0 by kb@mail.tug.org.
+ Further modifications for Web2C 7.2 by Mathias.Herberts@irisa.fr */
+
+/* This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of
+ the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+/* Please remember the following for porting to UNIX:
+
+ pid = fork ();
+ if (pid == 0)
+ execve (...); pid = spawnve (mode, ...);
+ else if (pid == -1) if (pid == -1)
+ error (); error ();
+ else else
+ success (); success ();
+
+ Spawnve(2) has many different modes and a `session' is indicated by
+ running on an extra terminal. */
+
+
+#define EXTERN extern
+#include "../mfd.h"
+
+#ifdef MFTALKWIN
+
+#undef input
+#undef output
+#undef read
+#undef write
+#ifdef OS2
+#include <sys/param.h>
+#include <process.h>
+extern int close (int);
+extern int pipe (int *);
+extern int read (int, void *, size_t);
+extern int setmode (int, int);
+extern int write (int, const void *, size_t);
+#endif
+#include <fcntl.h>
+#include <signal.h>
+#include <kpathsea/variable.h>
+#include "mftalk.h"
+
+/* We use SIGCHLD, but fall back on SIGCLD if that's all we have. */
+#if !defined (SIGCHLD) && defined (SIGCLD)
+#define SIGCHLD SIGCLD
+#endif
+
+#define fatal(func, cond) do { if (cond) FATAL_PERROR ("perror"); } while (0)
+
+static RETSIGTYPE child_died P1H(int sig);
+static string app_type P2H(char *prog, int *app);
+
+static int pid = -1; /* Process ID of our child. */
+static int win = -1; /* Write handle to the `window'. */
+static int buf[8]; /* Temporary buffer. */
+static RETSIGTYPE (*old) (); /* Old signal handler. */
+
+
+boolean
+mf_mftalk_initscreen P1H(void)
+{
+ int app; /* Client application type. */
+ char *prog, *name; /* Client program name. */
+ /* Size of METAFONT window. */
+ char height[MAX_INT_LENGTH], width[MAX_INT_LENGTH];
+ /* Inherited pipe handles. */
+ char input[MAX_INT_LENGTH], output[MAX_INT_LENGTH];
+ char parent[MAX_INT_LENGTH]; /* My own process ID. */
+ int sc_pipe[2]; /* Server->Client pipe. */
+ int cs_pipe[2]; /* Client->Server pipe. */
+ int res, ack; /* Wait until child is ready. */
+
+ prog = kpse_var_value ("MFTALK");
+ if (prog == NULL)
+ prog = "mftalk.exe";
+
+ name = app_type (prog, &app);
+ if (!name)
+ return 0;
+
+ if (pipe (sc_pipe) == -1)
+ return 0;
+ if (pipe (cs_pipe) == -1)
+ {
+ close (sc_pipe[0]);
+ close (sc_pipe[1]);
+ return 0;
+ }
+#ifdef OS2
+ fatal (setmode, setmode (sc_pipe[0], O_BINARY) == -1);
+ fatal (setmode, setmode (sc_pipe[1], O_BINARY) == -1);
+ fatal (setmode, setmode (cs_pipe[0], O_BINARY) == -1);
+ fatal (setmode, setmode (cs_pipe[1], O_BINARY) == -1);
+#endif
+
+ old = signal (SIGCHLD, child_died);
+ fatal (old, old == SIG_ERR);
+
+ sprintf (height, "-h%d", screendepth);
+ sprintf (width, "-w%d", screenwidth);
+ sprintf (input, "-i%d", sc_pipe[0]);
+ sprintf (output, "-o%d", cs_pipe[1]);
+ sprintf (parent, "-p%d", getpid ());
+
+#ifdef OS2
+ pid = spawnl (app, name, prog, height, width, input, output, parent, NULL);
+#else
+ pid = fork ();
+ if (pid == 0)
+ {
+ fatal (close, close (0) == -1);
+ fatal (dup, dup (sc_pipe[0]) != 0);
+ fatal (close, close (sc_pipe[0]) == -1);
+ fatal (close, close (sc_pipe[1]) == -1);
+ fatal (close, close (1) == -1);
+ fatal (dup, dup (cs_pipe[1]) != 1);
+ fatal (close, close (cs_pipe[0]) == -1);
+ fatal (close, close (cs_pipe[1]) == -1);
+
+ /* We still pass the file handles as parameters for
+ * backward compatibility. instead of sc_pipe[0] and
+ * cs_pipe[1] we just pass 0 (stdin) and 1 (stdout).
+ */
+
+ sprintf (input, "-i0");
+ sprintf (output, "-o1");
+
+ execl (name, prog, height, width, input, output, parent, NULL);
+ }
+#endif /* not OS2 */
+ switch (pid)
+ {
+ case -1:
+ failure:
+ fatal (close, close (sc_pipe[0]) == -1);
+ fatal (close, close (sc_pipe[1]) == -1);
+ fatal (close, close (cs_pipe[0]) == -1);
+ fatal (close, close (cs_pipe[1]) == -1);
+ fatal (signal, signal (SIGCHLD, old) == SIG_ERR);
+ break;
+ default:
+ res = read (cs_pipe[0], &ack, sizeof (int));
+ if (res != sizeof (int) || ack != MF_ACK)
+ goto failure;
+ fatal (close, close (cs_pipe[0]) == -1);
+ win = sc_pipe[1];
+ break;
+ }
+
+ return (win == -1) ? 0 : 1;
+}
+
+
+void
+mf_mftalk_updatescreen P1H(void)
+{
+ buf[0] = MF_FLUSH;
+ write (win, buf, sizeof (int));
+}
+
+
+void
+mf_mftalk_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ buf[0] = MF_RECT;
+ buf[1] = MF_WHITE;
+ buf[2] = left;
+ buf[3] = bottom;
+ buf[4] = right;
+ buf[5] = top;
+
+ write (win, buf, 6 * sizeof (int));
+}
+
+
+void
+mf_mftalk_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, transition_vector,
+ screencol, vector_size)
+{
+ buf[0] = MF_LINE;
+ buf[1] = init_color == 0 ? MF_WHITE : MF_BLACK;
+ buf[2] = *transition_vector++;
+ buf[3] = row;
+ buf[4] = --vector_size;
+
+ write (win, buf, 5 * sizeof (int));
+ write (win, transition_vector, vector_size * sizeof (int));
+}
+
+
+static string
+app_type P2C(string, prog, int *, app)
+{
+#ifdef OS2
+ int res, app;
+
+ res = DosSearchPath (0x02 | 0x01, "PATH", prog, buf, len);
+ if (res != 0)
+ return -1;
+
+ res = DosQueryAppType (buf, &app);
+ if (res != 0)
+ return -1;
+
+ switch (app & 0x07) /* Quick guess. */
+ {
+ case 0x00: return (P_SESSION | P_DEFAULT);
+ case 0x01: return (P_SESSION | P_FULLSCREEN);
+ case 0x02: return (P_SESSION | P_WINDOWED);
+ case 0x03: return (P_PM);
+ }
+#endif /* OS2 */
+
+ *app = 0; /* Irrelevant. */
+ return prog;
+}
+
+
+static RETSIGTYPE
+child_died (int sig)
+{
+#ifdef OS2
+ fatal (signal, signal (sig, SIG_ACK) == SIG_ERR);
+#endif
+ fatal (signal, signal (sig, SIG_IGN) == SIG_ERR);
+
+ if (pid == -1 || kill (-pid, 0) == 0) /* This was not our child. */
+ {
+ if (old != SIG_IGN)
+ {
+ fatal (signal, signal (sig, old) == SIG_ERR);
+ fatal (raise, raise (sig) == -1);
+ }
+ fatal (signal, signal (sig, child_died) == SIG_ERR);
+ }
+ else
+ {
+ close (win); /* This may fail. */
+ win = -1;
+
+ pid = -1;
+
+ screenstarted = false; /* METAFONT variables. */
+ screenOK = false;
+
+ fatal (signal, signal (sig, old) == SIG_ERR);
+ }
+}
+
+#else /* !MFTALKWIN */
+
+int mftalk_dummy;
+
+#endif /* !MFTALKWIN */
diff --git a/Build/source/texk/web2c/window/next.c b/Build/source/texk/web2c/window/next.c
new file mode 100644
index 00000000000..c3f6d4203e6
--- /dev/null
+++ b/Build/source/texk/web2c/window/next.c
@@ -0,0 +1,177 @@
+/* next.c: display interface for the NeXT, joe@rilgp.tamri.com.
+
+This device code requires a second program ("DrawingServant") to
+act as the interface between sm and the WindowServer. The second program
+just serves to listen for commands on a pipe, but otherwise
+send everything else with a DPSPrintf to the WindowServer. The servant can
+also do things like implement it's own event loop and handle things
+like printing, saving .eps and the like. This seems (to me) to be the
+best way to put a multiplatform program into a NeXT application.
+
+You can get DrawingServant from sonata.cc.purdue.edu.
+*/
+
+/* with not too much work, the client side of things probably
+could be on another machine */
+#define EXTERN extern
+#include "../mfd.h"
+
+#ifdef NEXTWIN /* the whole file */
+#define DRAWSERVER "DrawingServant"
+#define DEFWIDTH 400 /* default width and height */
+#define DEFHEIGHT 500
+
+/*these default values are taken from plain.mf
+and are used if we can't see anything better */
+static int nextheight=DEFHEIGHT;
+static int nextwidth=DEFWIDTH;
+static int outpipe[2],inpipe[2];
+static int pid;
+static int nextscreenlooksOK = 0;
+char outstring[1024]; /* the longest string pushed though a pipe */
+/* these are used a lot, so macro-ize these two lines */
+#define SENDPS write(outpipe[1],outstring,strlen(outstring)+1)
+#define GETACK do{\
+ read(inpipe[0],outstring,sizeof(outstring)-1);\
+ } while(strncmp(outstring,"Ok",2))
+#ifdef read
+#undef read
+#endif
+
+int mf_next_initscreen()
+{
+ int i;
+ void mf_next_closescreen();
+ /* strings for height, width, in and out pipes */
+ char hstr[20],wstr[20],instr[20],outstr[20];
+
+ /* I should figure out how to use screen_rows and screen_cols
+ to size the window. what I think I need is one of leftcol,rightcol
+ toprow and botrow. Let's find the first which is non-zero,
+ at least until someone tells me what the real answer is.*/
+
+ for(i=0;i<16;i++) {
+ if((leftcol[i]-rightcol[i]) && (toprow[i]-botrow[i])) {
+ nextwidth = rightcol[i]-leftcol[i];
+ nextheight = botrow[i]-toprow[i];
+ break;
+ }
+ }
+
+ /* fork a process and assign some pipes. return if unsuccessful */
+ if( pipe(outpipe)== -1)
+ return 0;
+ if( pipe(inpipe)== -1)
+ return 0;
+ if( (pid=fork())== -1)
+ return 0;
+
+ if(pid==0) {
+ /* things done by the child. we pass it height,width and
+ input and output pipes */
+ sprintf(hstr,"h %d ",nextheight);
+ sprintf(wstr,"w %d ",nextwidth);
+ sprintf(outstr,"i %d",outpipe[0]);
+ sprintf(instr,"o %d",inpipe[1]);
+ execl(DRAWSERVER,DRAWSERVER,hstr,wstr,instr,outstr,0);
+ exit(0);
+ }
+ sprintf(outstring,"initgraphics\n");
+ SENDPS;
+ GETACK;
+ nextscreenlooksOK = 1;
+
+ /* The prior version used a hacked version of uexit to kill the
+ server...at the urging of karl berry, here is a more legit way to
+ kill the server */
+ atexit(*mf_next_closescreen);
+
+ return 1;
+}
+/*
+ * void updatescreen;
+ * does nothing
+ *
+ */
+void mf_next_updatescreen()
+{
+}
+/*
+ * void blankrectangle(int left,int right,int top,int bottom);
+ *
+ * blank out a port of the screen.
+ */
+void mf_next_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+
+ if(left==0 && top==nextheight && right==nextwidth && bottom==0 ) {
+ /* clear and forgets PS strings */
+ sprintf(outstring,"DSclear");
+ } else {
+ sprintf(outstring,
+ " 1 setgray %d %d %d %d rectfill 0 setgray \n",
+ left+1,top+1,right,bottom+1);
+ }
+ SENDPS;
+ GETACK;
+}
+
+/*
+ * void paintrow(int row,int init_color,int transition_vector,
+ * int vector_size);
+ *
+ * Paint "row" starting with color "init_color", up to next
+ * transition specified by "transition_vector", switch colors,
+ * and continue for "vector_size" transitions.
+ */
+void mf_next_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, transition_vector,
+ screencol, vector_size)
+{
+ int i,whereami;
+ if(init_color) {
+ init_color = 1;
+ } else {
+ init_color = 0;
+ }
+ whereami = 0;
+
+ for(i=0;i<vector_size;i++) {
+ if(init_color) {
+ sprintf(outstring+whereami,
+ "newpath %d %d moveto %d %d lineto stroke ",
+ transition_vector[i],nextheight-row,
+ transition_vector[i+1],nextheight-row);
+ whereami = strlen(outstring);
+ /* buffering is good. perhaps. */
+ if(whereami > 500) {
+ SENDPS;
+ GETACK;
+ *outstring = 0;
+ whereami = 0;
+ }
+ }
+ init_color = 1-init_color;
+ }
+ if(whereami) {
+ SENDPS;
+ GETACK;
+ }
+}
+/* this isn't part of the online display routines. We need it to
+kill DrawingServant. This is called during exit */
+void mf_next_closescreen()
+{
+ if(nextscreenlooksOK) {
+ sprintf(outstring,"DSquit");
+ SENDPS;
+ }
+}
+
+#else
+int next_dummy;
+#endif /* NEXTWIN */
diff --git a/Build/source/texk/web2c/window/regis.c b/Build/source/texk/web2c/window/regis.c
new file mode 100644
index 00000000000..c23abce4ce4
--- /dev/null
+++ b/Build/source/texk/web2c/window/regis.c
@@ -0,0 +1,105 @@
+/* Regis terminal window interface for Metafont, joe@rilgp.tamri.com.
+ screen_rows is 480; screen_cols is 800. */
+
+#define EXTERN extern
+#include "../mfd.h"
+
+#ifdef REGISWIN /* Whole file */
+
+#define ESCAPE 27
+
+/* set this up in one of two ways. if defined, display is white characters
+on a black background; undefined is the opposite */
+#undef WRITEWHITE
+
+/*
+ * int init_screen
+ * Put screen in graphics mode:<ESC>Pp
+ * Write no or both planes for the background black:S(I0)
+ * Write both or no planes for the forground white:W(I3)
+ * Erase screen:S(E)
+ * Return to alpha mode: <ESC>\
+ *
+ * Assuming that the speed limitation is a serial line to the
+ * terminal, we want to define macros for the most common
+ * character combinations.
+ * Define macros for ,+0]P[ (call this "p") and
+ * ,+0]V[ (this one is called "v").
+ * drawing a line is 4+(2 to 6) characters
+ * We always return true.
+ */
+
+int mf_regis_initscreen()
+{
+#ifdef WRITEWHITE
+ printf("%cPpS(I0)W(I3)S(E)%c",ESCAPE,ESCAPE);
+#else
+ printf("%cPpS(I3)W(I0)S(E)%c",ESCAPE,ESCAPE);
+#endif
+ printf("%cPp@:p,+0]P[@;@:v,+0]V[@;",ESCAPE);
+ return 1;
+}
+/*
+ * procedure updatescreen;
+ *
+ */
+void mf_regis_updatescreen()
+{
+}
+ /* void blankrectangle(int left,int right,int top,int bottom);
+ *
+ * Go to graphics mode: <ESC>Pp
+ * Move to lower left: P[%d,%d]
+ * Write no or both planes: W(I0)
+ * Turn on shading: W(S1)
+ * Vector to lower right, upper right, upper left, lower left: V's
+ * Turn off shading: W(S0)
+ * Write both or no planes: W(I3)
+ * Return to alpha mode: <ESC>\
+ */
+void mf_regis_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ printf(
+#ifdef WRITEWHITE
+ "%cPpP[%d,%d]W(I0)W(S1)V[%d,%d]V[%d,%d]V[%d,%d]V[%d,%d]W(S0)W(I3)%c\\",
+#else
+ "%cPpP[%d,%d]W(I3)W(S1)V[%d,%d]V[%d,%d]V[%d,%d]V[%d,%d]W(S0)W(I0)%c\\",
+#endif
+ ESCAPE,left,bottom,right,bottom,right,top,left,top,
+ left,bottom,ESCAPE);
+}
+
+/*
+ * void paintrow(int row, int init_color, int* transition_vector,
+ * int vector_size);
+ * Paint "row" starting with color "init_color", up to next
+ * transition specified by "transition_vector", switch colors,
+ * and continue for "vector_size" transitions.
+ */
+void mf_regis_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, transition_vector,
+ screencol, vector_size)
+{
+ int i;
+ if(init_color) {
+ init_color = 1;
+ } else {
+ init_color = 0;
+ }
+ printf("%cPpP[0,%d]P[",ESCAPE,row);
+ for(i=0;i<vector_size;i++) {
+ if(init_color)
+ printf("%d@v%d@p",transition_vector[i],
+ transition_vector[i+1]);
+ init_color = 1-init_color;
+ }
+ printf("+0,+0]%c\\",ESCAPE);
+}
+
+#else
+int regis_dummy;
+#endif /* REGISWIN */
diff --git a/Build/source/texk/web2c/window/suntools.c b/Build/source/texk/web2c/window/suntools.c
new file mode 100644
index 00000000000..b0cf48f0af1
--- /dev/null
+++ b/Build/source/texk/web2c/window/suntools.c
@@ -0,0 +1,214 @@
+/* Link this to sun.c if you are running on a SunView system */
+
+/*
+ * author = "Pierre MacKay (from the original by Paul Richards)"
+ * version = "0.5",
+ * date = "5 May 1991 - June 1992"
+ * filename = "sun_sunview.c",
+ * contact = "Pierre MacKay",
+ * email = "mackay@cs.washington.edu"
+ * Graphics window interface to Metafont for Suns running
+ * SunView (Sun Unix release 3.n)
+ * This code is essentially a translation from the old
+ * sun.c which used <suntool/gfxsw.h>. The model for the
+ * translation is the example in Appendix C (C.2.) of the
+ * Sunview 1 Programmer's guide as applied to bouncedemo.c
+ * There are nice additional benefits, such as a moveable
+ * and scalable graphics window, and the chance to see
+ * the controlling window while METAFONT is at work
+ *
+ * Destroy checking is bogus, and SunView does not clean up the mess
+ * if you "quit" from the pulldown menu. You will be left with
+ * an hysterical orphaned process screaming for a window that isn't
+ * there. You will have to go elsewhere and KILL that process.
+ * Otherwise it seems clean.
+ *
+ * For the moment this and the XView interface seem to be
+ * mutually exclusive, since they use library routines with
+ * the same names, which mightily confuses the loader.
+ * It doesn't help much to change the name of MFTERM since
+ * XView wants to name its own terminal "sun" just like
+ * the SunView terminal
+ */
+
+#define EXTERN extern
+#include "../mfd.h"
+
+#undef _POSIX_SOURCE
+#ifdef SUNTOOLSWIN
+
+/* <sundev/cg9reg.h> wants to have a field named `reset'. Since we
+ don't need the WEB(2C) reset, no problem. */
+#undef reset
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <suntool/sunview.h>
+#include <suntool/canvas.h>
+
+static void repaint_proc();
+static void resize_proc();
+
+static Notify_value mf_notice_destroy();
+extern Notify_error notify_dispatch();
+
+static int destroy_ready; /* could be used for tighter control */
+
+/*
+ * global handle on the graphics subwindow
+ */
+
+struct MFsubwindow {
+ int mf_flags;
+#define MF_RESTART 0x01
+ struct pixwin *mf_pixwin;
+ struct rect mf_rect;
+ } sun_mf_subwin; /* Make sure that names storage is allocated. */
+
+static struct MFsubwindow *metafont_sw = &sun_mf_subwin; /* window handle */
+
+/*
+ * Gray background for graphics area
+ */
+
+static short mf_graybackground_image[] = {0x5555, 0xaaaa};
+ mpr_static(mf_sunview_gray_bkgr, 2, 2, 1, mf_graybackground_image);
+
+
+Rect *rect;
+Frame frame;
+Canvas canvas;
+Pixwin *pw;
+
+/*
+ * init_screen: boolean; return true if window operations legal
+ */
+
+int
+mf_sun_initscreen()
+{
+ frame = window_create(NULL,FRAME,
+ FRAME_LABEL, "METAFONT",
+ FRAME_SHOW_LABEL, TRUE,
+ WIN_ERROR_MSG, "! Window access requires METAFONT to run under suntools\n",
+ 0);
+ canvas = window_create(frame, CANVAS,
+ CANVAS_RESIZE_PROC, resize_proc,
+ CANVAS_FAST_MONO, TRUE,
+ WIN_ERROR_MSG, "Can't creat canvas",
+ 0);
+ pw = canvas_pixwin(canvas);
+
+ metafont_sw->mf_pixwin = canvas_pixwin(canvas);
+
+ /* interpose a destroy procedure so we can shut down cleanly */
+ (void) notify_interpose_destroy_func(frame, mf_notice_destroy);
+
+ /*
+ * Instead of using window_main_loop, just show the frame.
+ * Metafont's procedures will be in control, not the notifier.
+ */
+ window_set(frame,WIN_SHOW, TRUE, 0);
+
+ rect = (Rect *)window_get(canvas, WIN_RECT); /* Get current dimensions */
+ pw_replrop(pw,
+ 0, 0,
+ rect->r_width,
+ rect->r_height,
+ PIX_SRC,
+ &mf_sunview_gray_bkgr, 0, 0); /* clear subwindow */
+
+ return(1); /* Caller expects a TRUE value */
+}
+
+/*
+ * updatescreen; -- just make sure screen is ready to view
+ */
+
+void
+mf_sun_updatescreen()
+{
+ (void)notify_dispatch();
+/* if (destroy_ready != 0) return; */
+ rect = (Rect *)window_get(canvas, WIN_RECT); /* Get current dimensions */
+ if (metafont_sw->mf_flags & MF_RESTART) {
+ metafont_sw->mf_flags &= ~MF_RESTART;
+ pw_replrop(pw,
+ 0, 0,
+ rect->r_width,
+ rect->r_height,
+ PIX_SRC,
+ &mf_sunview_gray_bkgr, 0, 0); /* clear subwindow */
+ }
+}
+
+/*
+ * blankrectangle: reset rectangle bounded by ([left,right],[top,bottom])
+ * to background color
+ */
+
+void
+mf_sun_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ pw_writebackground(pw, left, top,
+ right-left+1, bottom-top+1, PIX_CLR);
+}
+
+/*
+ * paintrow -- paint "row" starting with color "init_color", up to next
+ * transition specified by "transition_vector", switch colors,
+ * and continue for "vector_size" transitions.
+ */
+
+void
+mf_sun_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, transition_vector,
+ screencol, vector_size)
+{
+ register col;
+ register color;
+
+ (void)notify_dispatch();
+ color = (init_color == 0)? 0 : 1;
+
+ do {
+ col = *transition_vector++;
+ pw_vector(pw,
+ col, row, (*transition_vector)-1, row,
+ PIX_SRC, color);
+ color = 1 - color;
+ } while (--vector_size);
+}
+
+static void
+repaint_proc( /* Ignore args */ )
+{
+ /* if repainting is required, just restart */
+ metafont_sw->mf_flags |= MF_RESTART;
+}
+
+static void
+resize_proc( /* Ignore args */ )
+{
+ metafont_sw->mf_flags |= MF_RESTART;
+}
+
+static Notify_value
+mf_notice_destroy(frame, status)
+ Frame frame;
+ Destroy_status status;
+{
+ if (status != DESTROY_CHECKING) {
+ destroy_ready = TRUE;
+ (void)notify_stop();
+ }
+ return(notify_next_destroy_func(frame,status));
+}
+
+#else
+int sunview_dummy;
+#endif /* SUNTOOLSWIN */
diff --git a/Build/source/texk/web2c/window/tek.c b/Build/source/texk/web2c/window/tek.c
new file mode 100644
index 00000000000..78dbae26bd6
--- /dev/null
+++ b/Build/source/texk/web2c/window/tek.c
@@ -0,0 +1,143 @@
+/* Tektronix terminal window interface for Metafont. */
+
+#define EXTERN extern
+#include "../mfd.h"
+
+#ifdef TEKTRONIXWIN /* Whole file */
+
+#define FORMFEED 12
+#define ESCAPE 27
+#define GS 29
+#define US 31
+#ifndef TRUE
+#define TRUE 1
+#endif
+#ifndef FALSE
+#define FALSE 0
+#endif
+#define WIDTH 1024 /* Screen width */
+#define HEIGHT 780 /* Screen height */
+#define WIDTHINBYTES (WIDTH/8) /* Only works if WIDTH % 8 == 0 */
+#define SETBIT(row,col) screen_pixel[row*WIDTHINBYTES+col/8] |= 1 << 7-col%8
+#define CLEARBIT(row,col) screen_pixel[row*WIDTHINBYTES+col/8] &= \
+ ~(1 << 7-col%8)
+#define ISSET(row,col) (screen_pixel[row*WIDTHINBYTES+col/8] & 1 << 7-col%8)
+
+char screen_pixel[WIDTHINBYTES*HEIGHT];
+char zero_array[WIDTHINBYTES];
+
+/*
+ * function init_screen: boolean;
+ *
+ * Return true if window operations legal.
+ * We always return true.
+ */
+
+int mf_tektronix_initscreen()
+{
+ bzero(zero_array, sizeof(zero_array));
+ return 1;
+}
+
+/*
+ * procedure updatescreen;
+ *
+ * Print out the screen bitmap.
+ */
+void mf_tektronix_updatescreen()
+{
+ int r, c, startc, makingline;
+
+ printf("%c%c", ESCAPE, FORMFEED);
+ for (r = 0; r < HEIGHT; r++) {
+ makingline = FALSE;
+ if (bcmp(&screen_pixel[r*WIDTHINBYTES],zero_array,WIDTHINBYTES) == 0)
+ continue;
+ for (c = 0; c < WIDTH; c++) {
+ if (ISSET(r, c)) {
+ if (!makingline) {
+ makingline = TRUE;
+ startc = c;
+ }
+ } else if (makingline) {
+ putchar(GS);
+ putchar(0x20|((HEIGHT-1)-r)>>5);
+ putchar(0x60|((HEIGHT-1)-r)&0x1F);
+ putchar(0x20|startc>>5);
+ putchar(0x40|startc&0x1F);
+ putchar(0x60|((HEIGHT-1)-r)&0x1F); /* Don't send high y */
+ putchar(0x20|c>>5);
+ putchar(0x40|c&0x1F);
+ makingline = FALSE;
+ }
+ }
+ if (makingline) {
+ putchar(GS);
+ putchar(0x20|((HEIGHT-1)-r)>>5);
+ putchar(0x60|((HEIGHT-1)-r)&0x1F);
+ putchar(0x20|startc>>5);
+ putchar(0x40|startc&0x1F);
+ putchar(0x60|((HEIGHT-1)-r)&0x1F); /* Don't send high y */
+ putchar(0x20|c>>5);
+ putchar(0x40|c&0x1F);
+ }
+ }
+ printf("%c%c%c%c%c", GS, 0x23, 0x66, 0x20, 0x40);
+ putchar(US);
+ fflush(stdout);
+}
+
+/*
+ * procedure blankrectangle(left, right, top, bottom: integer);
+ *
+ * Blanks out a port of the screen.
+ */
+void mf_tektronix_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ int r, c;
+
+ if (left == 0 && right == WIDTH && top == 0 && bottom == HEIGHT)
+ bzero(screen_pixel, sizeof(screen_pixel));
+ else
+ for (r = top; r < bottom; r++)
+ for (c = left; c < right; c++)
+ CLEARBIT(r, c);
+}
+
+/*
+ * procedure paintrow(
+ * row: screenrow;
+ * init_color: pixelcolor;
+ * var trans_vector: transspec;
+ * vector_size: screencol);
+ *
+ * Paint "row" starting with color "init_color", up to next
+ * transition specified by "transition_vector", switch colors,
+ * and continue for "vector_size" transitions.
+ */
+void mf_tektronix_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, transition_vector,
+ screencol, vector_size)
+{
+ int k = 0;
+ int c = transition_vector[0];
+
+ do {
+ k++;
+ do {
+ if (init_color)
+ SETBIT(row, c);
+ else
+ CLEARBIT(row, c);
+ } while (++c != transition_vector[k]);
+ init_color = !init_color;
+ } while (k != vector_size);
+}
+
+#else
+int tek_dummy;
+#endif /* TEKTRONIXWIN */
diff --git a/Build/source/texk/web2c/window/trap.c b/Build/source/texk/web2c/window/trap.c
new file mode 100644
index 00000000000..45d7f833fec
--- /dev/null
+++ b/Build/source/texk/web2c/window/trap.c
@@ -0,0 +1,50 @@
+/* trap.c -- generate output for the trap test. See comments in
+ lib/texmf.c for what each routine does. */
+
+#define EXTERN extern
+#include "../mfd.h"
+
+
+/* No #ifdef for the whole file, because we always want to support this. */
+
+
+/* This returns true if we can do window operations, else false. */
+
+boolean
+mf_trap_initscreen P1H(void)
+{
+ return 1;
+}
+
+void
+mf_trap_updatescreen P1H(void)
+{
+ fputs ("Calling UPDATESCREEN\n", logfile);
+}
+
+void
+mf_trap_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ fprintf (logfile, "\nCalling BLANKRECTANGLE(%ld,%ld,%ld,%ld)\n",
+ (long)left, (long)right, (long)top, (long)bottom);
+}
+
+void
+mf_trap_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, transition_vector,
+ screencol, vector_size)
+{
+ unsigned k;
+
+ fprintf (logfile, "Calling PAINTROW(%ld,%ld;", (long)row, (long)init_color);
+ for (k = 0; k <= vector_size; k++) {
+ fprintf (logfile, "%ld", (long)transition_vector[k]);
+ if (k != vector_size)
+ putc (',', logfile);
+ }
+ fputs (")\n", logfile);
+}
diff --git a/Build/source/texk/web2c/window/uniterm.c b/Build/source/texk/web2c/window/uniterm.c
new file mode 100644
index 00000000000..197bff77367
--- /dev/null
+++ b/Build/source/texk/web2c/window/uniterm.c
@@ -0,0 +1,184 @@
+/*
+ * title: uni.c
+ * abstract: Uniterm Terminal Window interface for Metafont.
+ * author: T.R.Hageman, Groningen, The Netherlands.
+ * created: May 1990
+ * modified:
+ * description:
+ * Uniterm (Simon Poole's terminal emulator for the Atari ST)
+ * emulates a `smart' Tektronix 4014 graphics terminal,
+ * and allows selective erasing of the graphics screen.
+ * (I do not know whether this is a standard feature of smart Teks
+ * or an invention of Mr. Poole)
+ *
+ * This file is offered as an alternative to the "standard"
+ * tektronix driver (which I find rather slow...)
+ *
+ * {{a possible way to improve the standard TEK driver would be to
+ * remember the (merged) transition lists instead converting to
+ * a bit map and back again.}}
+ *---*/
+
+#define EXTERN extern
+#include "../mfd.h"
+
+#ifdef UNITERMWIN /* Whole file */
+
+#define WIDTH 1024
+#define HEIGHT 780
+/*
+ * Send a vector to the graphics terminal
+ * (in a slightly optimized way).
+ */
+static void
+sendvector(x, y)
+register unsigned x, y;
+{
+ static int Hi_Y, Lo_Y, Hi_X; /* remembered values */
+ register int Lo_Y_sent = 0;
+ register int t;
+#ifdef DEBUG
+ if (x >= WIDTH) /* clip... */
+ x = WIDTH - 1;
+ if (y >= HEIGHT)
+ y = HEIGHT - 1;
+#endif
+ /*
+ * Send Hi_Y only if it has changed.
+ */
+ if ((t = 0x20|(y >> 5)) != Hi_Y) {
+ Hi_Y = t, putchar(t);
+ }
+ /*
+ * Likewise, send Lo_Y only if it has changed.
+ * (and remember that it has been sent)
+ */
+ if ((t = 0x60|(y & 0x1f)) != Lo_Y) {
+ Lo_Y_sent = 1;
+ Lo_Y = t, putchar(t);
+ }
+ /*
+ * A slight complication here. If Hi_X has changed,
+ * we must send Lo_Y too, but only if we didn't already send it.
+ */
+ if ((t = 0x20|(x >> 5)) != Hi_X) {
+ if (!Lo_Y_sent)
+ putchar(Lo_Y);
+ Hi_X = t, putchar(t);
+ }
+ /*
+ * Lo_X is always sent, so don't bother to remember it.
+ */
+ t = 0x40|(x & 0x1f), putchar(t);
+}
+/*
+ * Tektronix has origin in lower-left corner, whereas MetaFont
+ * has its origin in the upper-left corner.
+ * The next macro hides this.
+ */
+#define VECTOR(col,row) sendvector((unsigned)(col),(unsigned)(HEIGHT-1-(row)))
+/*
+ * GS - `Dark' vectors are in fact invisible, i.e., a move.
+ * (Also switches from text- to graphics screen.)
+ */
+#define DARK() putchar('\35')
+/*
+ * CAN - Switch from graphics- to text screen.
+ */
+#define TEXT_SCREEN() putchar('\30')
+/*
+ * ESC STX(ETX) - Enable(disable) block-fill mode.
+ */
+#define BLOCK(on) (putchar('\33'),putchar(2+!(on)))
+/*
+ * ESC / 0(1) d - Set black(white) ink.
+ */
+#define INK(on) (putchar('\33'), putchar('\57'), \
+ putchar('\61'-(on)), putchar('\144'))
+/*
+ * US - Switch to `alpha mode'
+ */
+#define ALPHA_MODE() putchar('\37')
+/*
+ * ESC FF - clear graphics&alpha screen.
+ */
+#define ALPHA_CLS(); (putchar('\33'), putchar('\14'))
+int mf_uniterm_initscreen()
+{
+ ALPHA_CLS();
+ TEXT_SCREEN();
+ return 1;
+}
+void mf_uniterm_updatescreen()
+{
+ DARK();
+ VECTOR(0,HEIGHT-1);
+ fflush(stdout);
+ TEXT_SCREEN(); /* switch to text mode */
+}
+void mf_uniterm_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ if (top==0 && left==0 && bottom>=HEIGHT-1 && right>=WIDTH-1) {
+ ALPHA_CLS();
+ return;
+ }
+ DARK();
+ VECTOR(left, top);
+ BLOCK(1); /* setup block erase mode */
+ INK(0); /* use white ink */
+ VECTOR(right-1, bottom-1); /* this draws the block */
+ BLOCK(0); /* back to (black) linedraw mode */
+ INK(1); /* black ink */
+}
+void mf_uniterm_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ register transspec, transition_vector,
+ register screencol, vector_size)
+{
+ register int blank = !init_color;
+#if 0
+ /* This is the basic */
+ DARK();
+ VECTOR(*transition_vector++, row); /* move to first transition */
+ do {
+ INK(blank ^= 1);
+ VECTOR(*transition_vector++ - 1, row);
+ } while (--vector_size > 0);
+#endif
+ register screencol col;
+ /* However, we optimize the amount of output a bit by blanking
+ out the row first (since each INK command takes 4 bytes) */
+ DARK();
+ if (blank) {
+ VECTOR(transition_vector[((vector_size-1)&~1)+1] - 1, row);
+ INK(0);
+ VECTOR(*transition_vector++, row);
+ INK(1);
+ if (vector_size==1)
+ return;
+ }
+ else {
+ if (vector_size > 1) {
+ VECTOR(transition_vector[vector_size & ~1] - 1, row);
+ INK(0);
+ VECTOR(transition_vector[1], row);
+ INK(1);
+ DARK();
+ }
+ VECTOR(*transition_vector++, row);
+ }
+ do {
+ col = *transition_vector++;
+ if ((blank ^= 1) == 0)
+ DARK(); /* white -> black; move to first black pixel */
+ else
+ col--; /* black -> white; blacken to col-1 */
+ VECTOR(col, row);
+ } while (--vector_size > 0);
+}
+#else
+int uniterm_dummy;
+#endif /* UNITERMWIN */
diff --git a/Build/source/texk/web2c/window/win32.c b/Build/source/texk/web2c/window/win32.c
new file mode 100644
index 00000000000..1e85d8ba861
--- /dev/null
+++ b/Build/source/texk/web2c/window/win32.c
@@ -0,0 +1,415 @@
+/*
+
+ Win32 interface for Metafont.
+ Author: Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+
+ */
+
+#define EXTERN extern
+#include "../mfd.h"
+
+#ifdef WIN32WIN
+#include <windows.h>
+
+/*
+ The following constant enables some hack that should allow the
+ window to process its messages. Basically, the principle is to
+ create a thread which will do the message loop. Unfortunately,
+ it does not seem to work very well :-)
+ */
+#undef LOOPMSG
+#define LOOPMSG 1
+
+#undef DEBUG
+/* #define DEBUG 1 */
+
+static char szAppName[] = "MF";
+static char szTitle[] = " MetaFont V2.718 Online Display";
+static HWND my_window;
+static HDC my_dc;
+static HDC drawing_dc;
+static HBITMAP hbm;
+static RGBQUAD black = {0,0,0,0};
+static RGBQUAD white = {255,255,255,0};
+static MSG msg;
+static HANDLE hAccelTable;
+static HANDLE hMutex;
+/* Scrollbars' variables */
+static SCROLLINFO si;
+static int xMinScroll;
+static int xMaxScroll;
+static int xCurrentScroll;
+static int yMinScroll;
+static int yMaxScroll;
+static int yCurrentScroll;
+static BOOL fScroll;
+static BOOL fSize;
+
+#ifdef LOOPMSG
+void __cdecl InitGui(void*);
+#endif
+LRESULT CALLBACK WndProc(HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM lParam);
+
+int
+mf_win32_initscreen()
+{
+ int ret;
+ if ((ret = _beginthread(InitGui, 0, NULL)) == -1) {
+ fprintf(stderr, "_beginthread returned with %d\n", ret);
+ return 0;
+ }
+ else
+ return 1;
+}
+
+ /* This window should be registered into a class. And maybe the
+ message loop could run into a separate thread. */
+
+void __cdecl InitGui(void *param)
+{
+ HWND hparentwnd;
+ HANDLE hinst;
+ WNDCLASSEX wndclass;
+ char szFile[80];
+
+ hinst = GetModuleHandle(NULL);
+ GetModuleFileName (hinst, szFile, sizeof(szFile));
+#ifdef DEBUG
+ printf ("hinst = %x\n", hinst);
+ printf ("File = %s\n", szFile);
+#endif
+ /* Fill in window class structure with parameters that describe
+ the main window. */
+ /* CS_OWNDC : un DC pour chaque fenêtre de la classe */
+ wndclass.cbSize = sizeof(wndclass);
+ wndclass.style = CS_HREDRAW | CS_VREDRAW | CS_OWNDC;
+ wndclass.lpfnWndProc = (WNDPROC)WndProc;
+ wndclass.cbClsExtra = 0;
+ wndclass.cbWndExtra = 0;
+ wndclass.hInstance = hinst;
+ wndclass.hIcon = LoadIcon (NULL, IDI_APPLICATION);
+ wndclass.hIconSm = LoadIcon (NULL, IDI_APPLICATION);
+ wndclass.hCursor = LoadCursor(NULL, IDC_ARROW);
+ wndclass.hbrBackground = GetStockObject(WHITE_BRUSH);
+ wndclass.lpszClassName = szFile;
+ wndclass.lpszMenuName = NULL;
+
+ if (!RegisterClassEx(&wndclass))
+ Win32Error("Register class");
+
+ hparentwnd = GetFocus();
+ my_window = CreateWindow(szFile, szTitle,
+ WS_OVERLAPPEDWINDOW | WS_HSCROLL | WS_VSCROLL,
+ CW_USEDEFAULT, 0,
+ CW_USEDEFAULT, 0,
+ /* screenwidth, screendepth, */
+ hparentwnd, NULL, hinst, NULL);
+ if (!my_window) {
+ Win32Error("Create window");
+ }
+#ifdef DEBUG
+ fprintf(stderr, "my_window = %x\n", my_window);
+#endif
+
+#ifdef LOOPMSG
+ /* Acknowledge for UpdateWindow() (WM_PAINT message generated) */
+ hMutex = CreateMutex(NULL, FALSE, "DrawingMutex");
+ my_dc = GetDC(my_window);
+ /* Device context for drawing and the associated bitmap. */
+ drawing_dc = CreateCompatibleDC(my_dc);
+ hbm = CreateCompatibleBitmap(my_dc, screenwidth, screendepth);
+ SelectObject(drawing_dc, hbm);
+ /* Blank the bitmap */
+ SelectObject(drawing_dc, GetStockObject(WHITE_BRUSH));
+ PatBlt(drawing_dc, 0, 0, screenwidth, screendepth, PATCOPY);
+ hAccelTable = LoadAccelerators (hinst, szTitle);
+
+ ShowWindow(my_window, SW_SHOWNORMAL);
+ UpdateWindow(my_window);
+
+ /* Running the message loop */
+ while (GetMessage(&msg, my_window, 0, 0)) {
+ TranslateMessage(&msg);
+ DispatchMessage(&msg);
+ }
+
+#else
+ drawing_dc = my_dc = GetDC(my_window);
+#endif
+}
+
+/* Make sure the screen is up to date. (section 8.6 Handling the output
+buffer) */
+
+void
+mf_win32_updatescreen()
+{
+ RECT r;
+ r.left = 0;
+ r.top = 0;
+ r.right = screenwidth;
+ r.bottom = screendepth;
+
+ /* Send a WM_PAINT message to the window.
+ The rectangle should be invalidated for the message being sent. */
+ InvalidateRect(my_window, &r, FALSE);
+ UpdateWindow(my_window);
+}
+
+
+/* Blank the rectangular inside the given coordinates. We don't need to
+reset the foreground to black because we always set it at the beginning
+of paintrow (below). */
+
+void mf_win32_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ RECT r;
+ r.left = left;
+ r.top = top;
+ r.right = right+1; /* FIXME: must we fill the last row/column ? */
+ r.bottom = bottom+1;
+ /* Fixme : should synchronize with message processing. */
+ WaitForSingleObject(hMutex, INFINITE);
+ FillRect(drawing_dc, &r, GetStockObject(WHITE_BRUSH));
+ ReleaseMutex(hMutex);
+}
+
+
+/* Paint a row with the given ``transition specifications''. We might be
+able to do something here with drawing many lines. */
+
+void
+mf_win32_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, tvect,
+ register screencol, vector_size)
+{
+ register int col;
+ HGDIOBJ CurrentPen;
+ HGDIOBJ WhitePen = GetStockObject(WHITE_PEN);
+ HGDIOBJ BlackPen = GetStockObject(BLACK_PEN);
+ /* FIXME: should sync with msg processing */
+ WaitForSingleObject(hMutex, INFINITE);
+ CurrentPen = (init_color == 0) ? WhitePen : BlackPen;
+ do {
+ col = *tvect++;
+ MoveToEx(drawing_dc, col, (int) row, NULL);
+ SelectObject(drawing_dc, CurrentPen);
+
+ /* (section 6.3.2 Drawing single and multiple lines)
+ */
+ LineTo(drawing_dc, (int) *tvect, (int) row);
+ CurrentPen = (CurrentPen == WhitePen) ? BlackPen : WhitePen;
+ } while (--vector_size > 0);
+ SelectObject(drawing_dc, GetStockObject(NULL_PEN));
+ ReleaseMutex(hMutex);
+}
+
+#if 0
+void Win32Error(char *caller)
+{
+ LPVOID lpMsgBuf;
+
+ FormatMessage(
+ FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL,
+ GetLastError(),
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), /* Default language */
+ (LPTSTR) &lpMsgBuf,
+ 0,
+ NULL
+ );
+ /* Display the string. */
+ MessageBox( NULL, lpMsgBuf, caller, MB_OK|MB_ICONINFORMATION );
+ /* Free the buffer. */
+ LocalFree( lpMsgBuf );
+}
+#endif
+
+LRESULT APIENTRY WndProc(HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM lParam)
+{
+ PAINTSTRUCT ps;
+ int retval;
+
+#ifdef DEBUG
+ fprintf(stderr, "Message %x\n", iMsg);
+#endif
+#ifdef LOOPMSG
+ WaitForSingleObject(hMutex, INFINITE);
+ switch (iMsg) {
+ case WM_CREATE:
+ xMinScroll = 0;
+ xMaxScroll = screenwidth;
+ xCurrentScroll = 0;
+
+ yMinScroll = 0;
+ yMaxScroll = screendepth;
+ yCurrentScroll = 0;
+
+ fScroll = FALSE;
+ fSize = FALSE;
+
+ break;
+ case WM_SIZE:
+ {
+ int xNewSize, yNewSize;
+ xNewSize = LOWORD(lParam);
+ yNewSize = HIWORD(lParam);
+
+ fSize = TRUE;
+
+ xMaxScroll = max(screenwidth, xNewSize);
+ xCurrentScroll = min(xCurrentScroll, xMaxScroll);
+
+ si.cbSize = sizeof(si);
+ si.fMask = SIF_RANGE | SIF_PAGE | SIF_POS;
+ si.nMin = xMinScroll;
+ si.nMax = xMaxScroll;
+ si.nPage = xNewSize;
+ si.nPos = xCurrentScroll;
+ SetScrollInfo(my_window, SB_HORZ, &si, TRUE);
+
+ yMaxScroll = max(screendepth, yNewSize);
+ yCurrentScroll = min(yCurrentScroll, yMaxScroll);
+
+ si.cbSize = sizeof(si);
+ si.fMask = SIF_RANGE | SIF_PAGE | SIF_POS;
+ si.nMin = yMinScroll;
+ si.nMax = yMaxScroll;
+ si.nPage = yNewSize;
+ si.nPos = yCurrentScroll;
+ SetScrollInfo(my_window, SB_VERT, &si, TRUE);
+ }
+ case WM_PAINT:
+ {
+#ifdef DEBUG
+ fprintf(stderr, "WM_PAINT message hbm = %x\n", hbm);
+#endif
+ BeginPaint(my_window, &ps);
+ /* Shouldn't repaint all the screen, but so easy! */
+ if (!BitBlt(my_dc,
+ 0, 0,
+ screenwidth, screendepth,
+ drawing_dc,
+ xCurrentScroll,
+ yCurrentScroll, SRCCOPY))
+ Win32Error("Bitblt");
+ EndPaint(my_window, &ps);
+ retval = 0;
+ break;
+ }
+ case WM_HSCROLL:
+ {
+ int xDelta;
+ int xNewPos;
+ int yDelta = 0;
+ switch (LOWORD(wParam)) {
+ case SB_PAGEUP:
+ xNewPos = xCurrentScroll - 50;
+ break;
+ case SB_PAGEDOWN:
+ xNewPos = xCurrentScroll + 50;
+ break;
+ case SB_LINEUP:
+ xNewPos = xCurrentScroll - 5;
+ break;
+ case SB_LINEDOWN:
+ xNewPos = xCurrentScroll + 5;
+ break;
+ case SB_THUMBPOSITION:
+ xNewPos = HIWORD(wParam);
+ break;
+ default:
+ xNewPos = xCurrentScroll;
+ }
+ xNewPos = max(0, xNewPos);
+ xNewPos = min(xMaxScroll, xNewPos);
+
+ if (xNewPos == xCurrentScroll)
+ break;
+
+ fScroll = TRUE;
+
+ xDelta = xNewPos - xCurrentScroll;
+ xCurrentScroll = xNewPos;
+
+ ScrollWindowEx(my_window, -xDelta, -yDelta, (CONST RECT *)NULL,
+ (CONST RECT *)NULL, (HRGN)NULL, (LPRECT)NULL,
+ SW_INVALIDATE);
+ UpdateWindow(my_window);
+
+ si.cbSize = sizeof(si);
+ si.fMask = SIF_POS;
+ si.nPos = xCurrentScroll;
+ SetScrollInfo(my_window, SB_HORZ, &si, TRUE);
+ }
+ break;
+
+ case WM_VSCROLL:
+ {
+ int xDelta = 0;
+ int yNewPos;
+ int yDelta;
+ switch (LOWORD(wParam)) {
+ case SB_PAGEUP:
+ yNewPos = yCurrentScroll - 50;
+ break;
+ case SB_PAGEDOWN:
+ yNewPos = yCurrentScroll + 50;
+ break;
+ case SB_LINEUP:
+ yNewPos = yCurrentScroll - 5;
+ break;
+ case SB_LINEDOWN:
+ yNewPos = yCurrentScroll + 5;
+ break;
+ case SB_THUMBPOSITION:
+ yNewPos = HIWORD(wParam);
+ break;
+ default:
+ yNewPos = yCurrentScroll;
+ }
+ yNewPos = max(0, yNewPos);
+ yNewPos = min(yMaxScroll, yNewPos);
+
+ if (yNewPos == yCurrentScroll)
+ break;
+
+ fScroll = TRUE;
+
+ yDelta = yNewPos - yCurrentScroll;
+ yCurrentScroll = yNewPos;
+
+ ScrollWindowEx(my_window, -xDelta, -yDelta, (CONST RECT *)NULL,
+ (CONST RECT *)NULL, (HRGN)NULL, (LPRECT)NULL,
+ SW_INVALIDATE);
+ UpdateWindow(my_window);
+
+ si.cbSize = sizeof(si);
+ si.fMask = SIF_POS;
+ si.nPos = yCurrentScroll;
+ SetScrollInfo(my_window, SB_VERT, &si, TRUE);
+ }
+ break;
+
+ case WM_DESTROY:
+ PostQuitMessage(0);
+ retval = 0;
+ break;
+ default:
+ retval = DefWindowProc(hwnd, iMsg, wParam, lParam);
+ break;
+ }
+ ReleaseMutex(hMutex);
+ return retval;
+#else
+ return DefWindowProc(hwnd, iMsg, wParam, lParam);
+#endif
+}
+
+#else
+int win32_dummy;
+#endif /* WIN32WIN */
diff --git a/Build/source/texk/web2c/window/win32.mak b/Build/source/texk/web2c/window/win32.mak
new file mode 100644
index 00000000000..8922108ffc8
--- /dev/null
+++ b/Build/source/texk/web2c/window/win32.mak
@@ -0,0 +1,48 @@
+################################################################################
+#
+# Makefile : Web2C / window metafont support
+# Author : Fabrice Popineau <Fabrice.Popineau@supelec.fr>
+# Platform : Win32, Microsoft VC++ 6.0, depends upon fpTeX 0.5 sources
+# Time-stamp: <01/12/14 19:41:51 popineau>
+#
+################################################################################
+root_srcdir = ..\..\..
+!ifdef DEVELOPMENT
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk.development
+!else
+INCLUDE=$(INCLUDE);$(root_srcdir)\texk
+!endif
+
+USE_KPATHSEA = 1
+USE_GNUW32 = 1
+
+!include <msvc/common.mak>
+
+DEFS = -I.. $(DEFS) -DHAVE_CONFIG_H
+library = window
+
+#objects = $(objdir)\amiga.obj $(objdir)\hp2627.obj $(objdir)\mftalk.obj \
+# $(objdir)\next.obj $(objdir)\regis.obj $(objdir)\suntools.obj \
+# $(objdir)\tek.obj $(objdir)\trap.obj $(objdir)\uniterm.obj \
+# $(objdir)\x11.obj
+
+objects = $(objdir)\epsf.obj $(objdir)\win32.obj $(objdir)\trap.obj
+
+default: all
+
+all: $(objdir) $(objdir)\$(library).lib
+
+$(objdir)\$(library).lib: $(objects)
+ $(archive) $(objects)
+
+!include <msvc/config.mak>
+!include <msvc/install.mak>
+
+!include <msvc/clean.mak>
+
+!include <msvc/rdepend.mak>
+!include "./depend.mak"
+
+# Local Variables:
+# mode: Makefile
+# End:
diff --git a/Build/source/texk/web2c/window/x11-Xlib.c b/Build/source/texk/web2c/window/x11-Xlib.c
new file mode 100644
index 00000000000..52612cbf840
--- /dev/null
+++ b/Build/source/texk/web2c/window/x11-Xlib.c
@@ -0,0 +1,280 @@
+/*
+X Window System version 11 (release 3 et al.) interface for Metafont.
+
+Modified from Tim Morgan's X Version 11 routines by Richard Johnson.
+Modified from that by Karl Berry <karl@umb.edu>. 8/3/89
+
+MF can now understand geometry (sort of, at least on a Sun running 3.4
+and using uwm) in the resource database, as in the following in
+.Xdefaults to put a window of width 500 and height 600 at (200,50):
+
+Metafont*geometry: 500x600+200+200
+
+You cannot give the geometry on the command line (who would want to)?
+
+The width and height specified in the resource must not be larger than
+the screenwidth and screendepth defined in ../mf/cmf.ch.
+If they are, then I reset them to the maximum.
+
+We don't handle Expose events in general. This means that the window
+cannot be moved, resized, or obscured. The problem is that I don't know
+when we can look for such events. Adding a check to the main loop of
+Metafont was more than I wanted to do. Another problem is that Metafont
+does not keep track of the contents of the screen, and so I don't see
+how to know what to redraw. The right way to do this is probably to fork
+a process, and keep a Pixmap around of the contents of the window.
+
+I could never have done this without David Rosenthal's Hello World
+program for X. See $X/mit/doc/HelloWorld.
+
+All section numbers refer to Xlib -- C Language X Interface. */
+
+
+#define EXTERN extern
+#include "../mfd.h"
+
+
+#ifdef X11WIN
+
+#undef input /* the XWMHints structure has a field named `input' */
+#undef output
+
+#include <X11/Xatom.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+
+
+/* Variables for communicating between the routines we'll write. */
+
+static Display *my_display;
+static int my_screen;
+static Window my_window;
+static GC my_gc;
+static int white, black;
+
+
+/* Window manager hints. */
+
+static XWMHints wm_hints = {
+ (InputHint|StateHint), /* flags telling which values are set */
+ False, /* We don't expect input. */
+ NormalState, /* Initial state. */
+ 0, /* icon pixmap */
+ 0, /* icon window */
+ 0, 0, /* icon location (should get from resource?) */
+ 0, /* icon mask */
+ 0 /* window group */
+};
+
+
+/* Some constants for the resource database, etc. */
+#define PROGRAM_NAME "Metafont"
+#define ARG_GEOMETRY "geometry"
+#define BORDER_WIDTH 1 /* Should get this from resource. */
+#define DEFAULT_X_POSITION 0
+#define DEFAULT_Y_POSITION 0
+
+
+/* Return 1 (i.e., true) if display opened successfully, else 0. */
+
+int
+mf_x11_initscreen()
+{
+ char *geometry;
+ int geometry_found = 0;
+ char default_geometry[100];
+ XSizeHints sizehints;
+ XGCValues gcvalues;
+
+ /* We want the default display. (section 2.1 Opening the display) */
+ my_display = XOpenDisplay(NULL);
+ if (my_display == NULL) return 0;
+
+ /* Given a display, we can get the screen and the ``black'' and
+ ``white'' pixels. (section 2.2.1 Display macros) */
+ my_screen = DefaultScreen(my_display);
+ white = WhitePixel(my_display, my_screen);
+ black = BlackPixel(my_display, my_screen);
+
+
+ sizehints.x = DEFAULT_X_POSITION;
+ sizehints.y = DEFAULT_Y_POSITION;
+ sizehints.width = screenwidth;
+ sizehints.height = screendepth;
+ sizehints.flags = PPosition|PSize;
+
+ sprintf (default_geometry, "%ux%u+%u+%u", screenwidth, screendepth,
+ DEFAULT_X_POSITION, DEFAULT_Y_POSITION);
+
+ /* Look up the geometry for this window. (Section 10.2 Obtaining X
+ environment defaults) */
+ geometry = XGetDefault(my_display, PROGRAM_NAME, ARG_GEOMETRY);
+
+ if (geometry != NULL) {
+ /* (section 10.3 Parsing window geometry) */
+ int bitmask = XGeometry(my_display, my_screen,
+ geometry, default_geometry,
+ BORDER_WIDTH,
+ 1, 1, /* ``Font'' width and height. */
+ 0, 0, /* Interior padding. */
+ &(sizehints.x), &(sizehints.y),
+ &(sizehints.width), &(sizehints.height));
+
+ /* (section 9.1.6 Setting and getting window sizing hints) */
+ if (bitmask & (XValue|YValue)) {
+ sizehints.flags |= USPosition;
+ geometry_found = 1;
+ }
+
+ if (bitmask & (WidthValue|HeightValue)) {
+ sizehints.flags |= USSize;
+ if (sizehints.width > screenwidth) sizehints.width = screenwidth;
+ if (sizehints.height > screendepth) sizehints.height = screendepth;
+ geometry_found = 1;
+ }
+ }
+
+
+ /* Our window is pretty simple. (section 3.3 Creating windows) */
+ my_window = XCreateSimpleWindow(my_display,
+ DefaultRootWindow(my_display), /* parent */
+ sizehints.x, sizehints.y, /* upper left */
+ sizehints.width, sizehints.height,
+ BORDER_WIDTH,
+ black, /* border color */
+ white); /* background color */
+
+ /* (section 9.1.1 Setting standard properties) */
+ XSetStandardProperties(my_display, my_window,
+ PROGRAM_NAME, /* window name */
+ PROGRAM_NAME, /* icon name */
+ None, /* pixmap for icon */
+ 0, 0, /* argv and argc for restarting */
+ &sizehints);
+ XSetWMHints(my_display, my_window, &wm_hints);
+
+
+ /* We need a graphics context if we're going to draw anything.
+ (section 5.3 Manipulating graphics context/state) */
+ gcvalues.foreground = black;
+ gcvalues.background = white;
+ /* A ``thin'' line. This is much faster than a line of length 1,
+ although the manual cautions that the results might be less
+ consistent across screens. */
+ gcvalues.line_width = 0;
+
+ my_gc = XCreateGC(my_display, my_window,
+ GCForeground|GCBackground|GCLineWidth,
+ &gcvalues);
+
+ /* (section 3.5 Mapping windows) This is the confusing part of the
+ program, at least to me. If no geometry spec was found, then the
+ window manager puts up the blinking rectangle, and the user clicks,
+ all before the following call returns. But if a geometry spec was
+ found, then we want to do a whole mess of other things, because the
+ window manager is going to send us an expose event so that we can
+ bring our window up -- and this is one expose event we have to
+ handle. */
+ XMapWindow(my_display, my_window);
+
+ if (geometry_found) {
+ /* The window manager sends us an Expose event. Yuck.
+ */
+ XEvent my_event;
+ /* We certainly don't want to handle anything else.
+ (section 8.5 Selecting events)
+ */
+ XSelectInput(my_display, my_window, ExposureMask);
+
+ /* We also want to do this right now. This is the confusion. From
+ stepping through the program under the debugger, it appears
+ that it is this call to XSync (given the previous call to
+ XSelectInput) that actually brings the window up -- and yet
+ without the remaining code, the thing doesn't work right. Very
+ strange. (section 8.6 Handling the output buffer)
+ */
+ XSync(my_display, 0);
+
+ /* Now get the event. (section 8.8.1 Returning the next event)
+ */
+ XNextEvent(my_display, &my_event);
+
+ /* Ignore all but the last of the Expose events.
+ (section 8.4.5.1 Expose event processing)
+ */
+ if (my_event.type == Expose && my_event.xexpose.count == 0) {
+ /* Apparently the network might STILL have my_events coming in.
+ Let's throw away Expose my_events again. (section 8.8.3
+ Selecting my_events using a window or my_event mask)
+ */
+ while (XCheckTypedEvent(my_display, Expose, &my_event)) ;
+
+ /* Finally, let's draw the blank screen.
+ */
+ XClearWindow(my_display, my_window);
+ }
+ }
+
+ /* That's it. */
+ return 1;
+}
+
+
+/* Make sure the screen is up to date. (section 8.6 Handling the output
+buffer) */
+
+void
+mf_x11_updatescreen()
+{
+ XFlush(my_display);
+}
+
+
+/* Blank the rectangular inside the given coordinates. We don't need to
+reset the foreground to black because we always set it at the beginning
+of paintrow (below). */
+
+void
+mf_x11_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ XSetForeground(my_display, my_gc, white);
+ XFillRectangle(my_display, my_window, my_gc,
+ (int) left,
+ (int) top,
+ (unsigned) (right - left + 1),
+ (unsigned) (bottom - top + 1));
+}
+
+
+/* Paint a row with the given ``transition specifications''. We might be
+able to do something here with drawing many lines. */
+
+void
+mf_x11_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, tvect,
+ register screencol, vector_size)
+{
+ register int color, col;
+
+ color = (init_color == 0) ? white : black;
+
+ do {
+ col = *tvect++;
+ XSetForeground(my_display, my_gc, color);
+
+ /* (section 6.3.2 Drawing single and multiple lines)
+ */
+ XDrawLine(my_display, my_window, my_gc, col, (int) row,
+ (int) *tvect, (int) row);
+
+ color = (color == white) ? black : white;
+ } while (--vector_size > 0);
+}
+
+#else
+int x11_dummy;
+#endif /* X11WIN */
diff --git a/Build/source/texk/web2c/window/x11-Xt.c b/Build/source/texk/web2c/window/x11-Xt.c
new file mode 100644
index 00000000000..c22a586fb92
--- /dev/null
+++ b/Build/source/texk/web2c/window/x11-Xt.c
@@ -0,0 +1,370 @@
+/* x11.c: X11 window interface for Metafont, using Xt. Original by
+ rusty@garnet.berkeley.edu. */
+
+#define EXTERN extern
+#include "../mfd.h"
+
+#ifdef X11WIN /* almost whole file */
+
+/* For wchar_t et al., that the X files might want. */
+#include <kpathsea/systypes.h>
+
+/* See xdvik/xdvi.h for the purpose of the FOIL... */
+#ifdef FOIL_X_WCHAR_T
+#define wchar_t foil_x_defining_wchar_t
+#define X_WCHAR
+#endif
+#undef input /* the XWMHints structure has a field named `input' */
+#undef output
+#include <X11/Xlib.h>
+#include <X11/Intrinsic.h>
+#include <X11/StringDefs.h>
+#undef wchar_t
+
+#define PLANE 0
+
+static unsigned int mf_defwidth = 0;
+static unsigned int mf_defheight = 0;
+
+static Display *mf_display;
+static Window mf_window;
+
+static Pixmap mf_pixmap;
+
+static XtAppContext mf_app;
+
+static GC mf_dgc; /* draw gc */
+static GC mf_egc; /* erase gc */
+static GC mf_cgc; /* copy plane gc */
+
+typedef struct
+{
+ unsigned int mf_width, mf_height;
+ Pixel mf_fg, mf_bg;
+} mf_resources_struct;
+
+static mf_resources_struct mf_x11_resources;
+
+
+/* Don't paint anything until we're mapped. */
+static Boolean mf_mapped;
+
+#ifdef MF_XT_DEBUG
+static int mf_max_x, mf_max_y;
+static int mf_min_x, mf_min_y;
+
+static void mf_checkextent ();
+#endif
+
+static XtResource mf_resources[]
+ = { { "width", "Width", XtRInt, sizeof (int),
+ XtOffset (mf_resources_struct *, mf_width), XtRInt,
+ (XtPointer) & mf_defwidth },
+
+ { "height", "Height", XtRInt, sizeof (int),
+ XtOffset (mf_resources_struct *, mf_height), XtRInt,
+ (XtPointer) &mf_defheight },
+
+ { "foreground", "Foreground", XtRPixel, sizeof (Pixel),
+ XtOffset (mf_resources_struct *, mf_fg),
+ XtRString, (XtPointer) "Black" },
+
+ { "background", "Background", XtRPixel, sizeof (Pixel),
+ XtOffset (mf_resources_struct *, mf_bg), XtRString,
+ (XtPointer) "White" },
+};
+
+/* Maybe someday we'll read options, until then, this is just here for
+ the resources. */
+static XrmOptionDescRec mf_optiondesclist[]
+= { { "-width", "width", XrmoptionSepArg, (XPointer) NULL },
+ { "-height", "height", XrmoptionSepArg, (XPointer) NULL },
+ { "-fg", "foreground", XrmoptionSepArg, (XPointer) NULL },
+ { "-bg", "background", XrmoptionSepArg, (XPointer) NULL },
+};
+
+static void mf_events ();
+static void mf_mapstatus ();
+static void mf_newpixmap P2H(unsigned int, unsigned int);
+static void mf_redraw ();
+static void mf_repaint ();
+
+/* Return 1 if display opened successfully, else 0. */
+
+int
+mf_x11_initscreen ()
+{
+ XSetWindowAttributes xwa;
+ Widget mf_toplevel;
+ Widget mf_canvas;
+ XGCValues gcv;
+ Arg args[1];
+ int mf_argc;
+ char *mf_argv[2];
+
+ mf_argv[0] = "mf";
+ mf_argv[1] = NULL;
+ mf_argc = 1;
+
+ mf_toplevel = XtInitialize ("mf", "Metafont",
+ mf_optiondesclist,
+ XtNumber (mf_optiondesclist),
+ &mf_argc, mf_argv);
+
+ XtGetApplicationResources (mf_toplevel, (XtPointer) & mf_x11_resources,
+ mf_resources, XtNumber (mf_resources),
+ NULL, 0);
+
+ if (mf_argc != 1)
+ {
+ fprintf (stderr, "Usage: %s\n", mf_argv[0]);
+ return 0;
+ }
+
+ /* If nothing specified in their resources (e.g., .Xdefaults)
+ then use the values of Metafont's "screen". */
+ if (mf_x11_resources.mf_width == 0)
+ mf_x11_resources.mf_width = screenwidth;
+ if (mf_x11_resources.mf_height == 0)
+ mf_x11_resources.mf_height = screendepth;
+
+ mf_canvas = XtCreateManagedWidget ("canvas", widgetClass, mf_toplevel,
+ NULL, 0);
+
+ XtSetArg (args[0], XtNwidth, mf_x11_resources.mf_width);
+ XtSetValues (mf_canvas, args, 1);
+ XtSetArg (args[0], XtNheight, mf_x11_resources.mf_height);
+ XtSetValues (mf_canvas, args, 1);
+
+ /* for mf_x11_updatescreen() */
+ mf_app = XtWidgetToApplicationContext (mf_canvas);
+
+ XtAddEventHandler (mf_canvas, (Cardinal) ExposureMask, True,
+ mf_repaint, NULL);
+ XtAddEventHandler (mf_canvas, (Cardinal) StructureNotifyMask, True,
+ mf_mapstatus, NULL);
+
+ XtRealizeWidget (mf_toplevel);
+
+ mf_display = XtDisplay (mf_canvas);
+ mf_window = XtWindow (mf_canvas);
+
+ /* Since Metafont isn't your typical x window program that
+ sits in XTMainLoop, if the server supports backing store
+ and save unders this will help keep the output looking
+ nice. */
+ xwa.backing_store = Always;
+ xwa.save_under = True;
+ XChangeWindowAttributes (mf_display, mf_window,
+ CWBackingStore | CWSaveUnder, &xwa);
+
+ gcv.background = mf_x11_resources.mf_bg;
+ gcv.foreground = mf_x11_resources.mf_fg;
+ gcv.function = GXcopy;
+
+ /* copy plane gc */
+ mf_cgc = XCreateGC (mf_display, mf_window,
+ GCForeground | GCBackground | GCFunction, &gcv);
+
+ mf_newpixmap (screenwidth > mf_x11_resources.mf_width
+ ? screenwidth : mf_x11_resources.mf_width,
+ screendepth > mf_x11_resources.mf_height
+ ? screendepth : mf_x11_resources.mf_height);
+
+ return 1;
+}
+
+void
+mf_x11_updatescreen ()
+{
+ mf_events ();
+ mf_redraw ();
+
+#ifdef MF_XT_DEBUG
+ printf ("max_x=%d, min_x=%d, max_y=%d, min_y=%d\n",
+ mf_max_x, mf_min_x,
+ mf_max_y, mf_min_y);
+#endif
+}
+
+
+void
+mf_x11_blankrectangle P4C(screencol, left,
+ screencol, right,
+ screenrow, top,
+ screenrow, bottom)
+{
+ XFillRectangle (mf_display, mf_pixmap, mf_egc, (int) left, (int) top,
+ (int) (right - left + 1), (int) (bottom - top + 1));
+ mf_events ();
+}
+
+void
+mf_x11_paintrow P4C(screenrow, row,
+ pixelcolor, init_color,
+ transspec, tvect,
+ register screencol, vector_size)
+{
+ GC gc;
+ int col;
+
+ gc = (init_color == 0) ? mf_egc : mf_dgc;
+
+ do
+ {
+ col = *tvect++;
+
+#ifdef MF_XT_DEBUG
+ mf_checkextent (col, *tvect, row);
+#endif /* MF_XT_DEBUG */
+
+ XDrawLine (mf_display, mf_pixmap, gc, col, (int) row,
+ (int) *tvect, (int) row);
+
+ gc = (gc == mf_egc) ? mf_dgc : mf_egc;
+ }
+ while (--vector_size > 0);
+
+ mf_events ();
+}
+
+#ifdef MF_XT_DEBUG
+static void
+mf_checkextent P3C(int, x1, int, x2, int, y)
+{
+ if (x1 < mf_min_x)
+ mf_min_x = x1;
+ if (x1 > mf_max_x)
+ mf_max_x = x1;
+
+ if (x2 < mf_min_x)
+ mf_min_x = x2;
+ if (x2 > mf_max_x)
+ mf_max_x = x2;
+
+ if (y > mf_max_y)
+ mf_max_y = y;
+ if (y < mf_min_y)
+ mf_min_y = y;
+}
+#endif /* MF_XT_DEBUG */
+
+static void
+mf_events ()
+{
+ XEvent event;
+
+ if (XtAppPending (mf_app) != 0)
+ {
+ while (XtAppPending (mf_app) != 0)
+ {
+ XtAppNextEvent (mf_app, &event);
+ XtDispatchEvent (&event);
+ }
+ }
+}
+
+static void
+mf_newpixmap P2C(unsigned int, width, unsigned int, height)
+{
+ XGCValues gcv;
+ Pixmap newpixmap;
+
+ /* width == mf_width and height == mf_height
+ the first time mf_newpixmap() is called.
+ */
+ if (width < mf_x11_resources.mf_width && height < mf_x11_resources.mf_height)
+ return;
+
+ newpixmap = XCreatePixmap (mf_display, mf_window, width, height, 1);
+
+ gcv.background = 0;
+ gcv.foreground = 1;
+
+ if (mf_dgc != 0)
+ XFreeGC (mf_display, mf_dgc);
+
+ /* draw gc */
+ gcv.line_width = 1;
+ mf_dgc = XCreateGC (mf_display, newpixmap,
+ GCForeground | GCBackground | GCLineWidth, &gcv);
+
+ if (mf_egc != 0)
+ XFreeGC (mf_display, mf_egc);
+
+ /* erase gc */
+ gcv.foreground = 0;
+ mf_egc = XCreateGC (mf_display, newpixmap,
+ GCForeground | GCBackground | GCLineWidth, &gcv);
+
+ XFillRectangle (mf_display, newpixmap, mf_egc, 0, 0, width, height);
+
+ if (mf_pixmap != 0)
+ {
+ XCopyArea (mf_display, mf_pixmap, newpixmap, mf_dgc, 0, 0,
+ mf_x11_resources.mf_width,
+ mf_x11_resources.mf_height, 0, 0);
+
+ XFreePixmap (mf_display, mf_pixmap);
+ }
+
+ mf_pixmap = newpixmap;
+
+ mf_x11_resources.mf_width = width;
+ mf_x11_resources.mf_height = height;
+}
+
+static void
+mf_repaint P3C(Widget, w, XtPointer, data, XEvent*, ev)
+{
+ if (!mf_mapped || !ev || ev->type != Expose)
+ return;
+
+ /* We are a ``simple application''. */
+ if (ev->xexpose.count == 0)
+ {
+ XEvent event;
+
+ /* skip all excess redraws */
+ while (XCheckTypedEvent (mf_display, Expose, &event) != False)
+ continue;
+
+ mf_redraw ();
+ }
+}
+
+
+static void
+mf_mapstatus P3C(Widget, w, XtPointer, data, XEvent*, ev)
+{
+ switch (ev->type)
+ {
+ case MapNotify:
+ mf_mapped = True;
+ break;
+
+ case UnmapNotify:
+ mf_mapped = False;
+ break;
+
+ case ConfigureNotify:
+ mf_newpixmap (ev->xconfigure.width, ev->xconfigure.height);
+ mf_redraw ();
+ break;
+ }
+}
+
+
+static void
+mf_redraw ()
+{
+ XCopyPlane (mf_display, mf_pixmap, mf_window, mf_cgc, 0, 0,
+ mf_x11_resources.mf_width, mf_x11_resources.mf_height,
+ 0, 0, (unsigned long) 1);
+
+ XFlush (mf_display);
+}
+
+#else
+int x11_dummy;
+#endif /* X11WIN */
diff --git a/Build/source/texk/web2c/withenable.ac b/Build/source/texk/web2c/withenable.ac
new file mode 100644
index 00000000000..d777f71fac9
--- /dev/null
+++ b/Build/source/texk/web2c/withenable.ac
@@ -0,0 +1,152 @@
+dnl withenable.ac: --with and --enable options.
+
+dnl The implementation of the defaults for the next three options is found
+dnl in configure.in.
+
+dnl Do we compile e-TeX?
+dnl We default to yes if the sources are available.
+AC_ARG_WITH([etex],
+[ --without-etex don't compile and install e-TeX])
+
+dnl Do we compile Omega?
+dnl We default to yes if the sources are available.
+AC_ARG_WITH([omega],
+[ --without-omega don't compile and install Omega])
+
+dnl Do we compile Aleph?
+dnl We default to yes if the sources are available.
+AC_ARG_WITH([aleph],
+[ --without-aleph don't compile and install Aleph])
+
+dnl Do we compile pdfTeX?
+dnl We default to yes if the sources are available.
+AC_ARG_WITH([pdftex],
+[ --without-pdftex don't compile and install pdfTeX])
+
+dnl Do we compile pdfeTeX?
+dnl We default to yes if the sources are available.
+AC_ARG_WITH([pdfetex],
+[ --without-pdfetex don't compile and install pdfeTeX])
+
+dnl Try to link C++ runtime statically?
+dnl Only important, if you want to create binaries which are slightly
+dnl more portable.
+AC_ARG_WITH([cxx-runtime-hack],
+[ --with-cxx-runtime-hack link C++ runtime statically])
+
+AC_ARG_WITH([editor],
+[ --with-editor=CMD invoke CMD from the e option [vi +%d %s]],
+ [AC_DEFINE_UNQUOTED(EDITOR, "$with_editor")
+])
+
+AC_ARG_ENABLE([ipc],
+[ --enable-ipc enable TeX's --ipc option, i.e., pipe to a program],
+[if test "x$enableval" = xyes; then
+ AC_DEFINE(IPC)
+ # -lsocket is needed on Solaris, at least. Maybe -lnsl on SCO, too?
+ # See ac_path_xtra.
+ AC_CHECK_FUNC(connect)
+ if test x$ac_cv_func_connect = xno; then
+ AC_CHECK_LIB(socket, connect, socketlibs="-lsocket $socketlibs")
+ fi
+fi
+])
+AC_SUBST(socketlibs)
+
+AC_ARG_ENABLE([auto-core],
+[ --enable-auto-core cause TeX&MF to dump core given a certain filename],
+ [AC_DEFINE(FUNNY_CORE_DUMP)])
+
+AC_ARG_ENABLE([dump-share],
+[ --disable-dump-share make fmt/base/mem files architecture-dependent],
+[if test "x$enableval" = xno; then
+ AC_DEFINE(NO_DUMP_SHARE)
+fi
+])
+
+AC_ARG_ENABLE([fmtutil],
+[ --enable-fmtutil use fmtutil for build dumps])
+
+dnl Do we include Window system support in MF?
+dnl Here we have three choices: yes, no, and as a separate executable mfw.
+dnl We default to mf.
+AC_ARG_WITH([mf-nowin],
+[ --with-mf-nowin build a separate non-windows-capable METAFONT])
+
+# Window system support for Metafont.
+AC_ARG_WITH([epsfwin],
+ [ --with-epsfwin include EPSF pseudo-window support],
+[if test "x$withval" = xyes; then
+ AC_DEFINE(EPSFWIN)
+fi
+])
+AC_ARG_WITH([hp2627win],
+ [ --with-hp2627win include HP 2627 window support in Metafont],
+[if test "x$withval" = xyes; then
+ AC_DEFINE(HP2627WIN)
+fi
+])
+AC_ARG_WITH([mftalkwin],
+ [ --with-mftalkwin include mftalk (generic server) window support],
+[if test "x$withval" = xyes; then
+ AC_DEFINE(MFTALKWIN)
+fi
+])
+AC_ARG_WITH([nextwin],
+ [ --with-nextwin include NeXT window support],
+[if test "x$withval" = xyes; then
+ AC_DEFINE(NEXTWIN)
+fi
+])
+AC_ARG_WITH([regiswin],
+ [ --with-regiswin include Regis window support],
+[if test "x$withval" = xyes; then
+ AC_DEFINE(REGISWIN)
+fi
+])
+AC_ARG_WITH([suntoolswin],
+ [ --with-suntoolswin include old Suntools window support (this is not X)],
+[if test "x$withval" = xyes; then
+ wlibs="-lsuntool -lsunwindow -lpixrect $wlibs"
+ AC_DEFINE(SUNWIN)
+fi
+])
+AC_ARG_WITH([tektronixwin],
+ [ --with-tektronixwin include Tektronix window support],
+[if test "x$withval" = xyes; then
+ AC_DEFINE(TEKTRONIXWIN)
+fi
+])
+AC_ARG_WITH([unitermwin],
+ [ --with-unitermwin include Uniterm window support],
+[if test "x$withval" = xyes; then
+ AC_DEFINE(UNITERMWIN)
+fi
+])
+
+sinclude(../kpathsea/xt.ac)
+
+AC_ARG_WITH([x11win],
+ [ --with-x11win same as --with-x],
+ [with_x="$withval"])
+AC_ARG_WITH([x11],
+ [ --with-x11 same as --with-x],
+ [with_x="$withval"])
+
+dnl This defines --with-x implicitly (which is why we use that package
+dnl name below), so put it here, so it comes first in the --help output.
+dnl This reads best.
+
+dnl Remember to add AC_PATH_XTRA when actually using X.
+
+AC_ARG_WITH([mf-x-toolkit],
+[ --with-mf-x-toolkit Use X toolkit for mf.],
+[ case "${withval}" in
+ y | ye | yes ) val=yes ;;
+ n | no ) val=no ;;
+ * )
+AC_MSG_WARN([unknown --with-mf-x-toolkit argument \`$withval'; using yes.])
+ val=yes;;
+ esac
+ with_mf_x_toolkit=$val
+])